Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/LES
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/LES	(revision 2744)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/LES	(revision 2744)
@@ -0,0 +1,1 @@
+link WRF.COMMON/WRFV3
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2	(revision 2744)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2	(revision 2744)
@@ -0,0 +1,1 @@
+link WRF.COMMON/WRFV2
Index: trunk/WRF.COMMON/WRFV2/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Makefile	(revision 2744)
@@ -0,0 +1,357 @@
+#	Top level Makefile for wrf system
+
+LN      =       ln -s
+MAKE    =       make -i -r
+MV	=	/bin/mv
+RM      =       /bin/rm -f
+
+deflt :
+		@ echo Please compile the code using ./compile
+
+include ./configure.wrf
+
+EM_MODULE_DIR = -I../dyn_em
+EM_MODULES =  $(EM_MODULE_DIR)
+
+
+#### 3.d.   add macros to specify the modules for this core
+
+#EXP_MODULE_DIR = -I../dyn_exp
+#EXP_MODULES =  $(EXP_MODULE_DIR)
+
+
+NMM_MODULE_DIR = -I../dyn_nmm
+NMM_MODULES =  $(NMM_MODULE_DIR)
+
+ALL_MODULES =                           \
+               $(EM_MODULE_DIR)         \
+               $(NMM_MODULES)           \
+               $(EXP_MODULES)           \
+               $(INCLUDE_MODULES)
+
+configcheck:
+	@if [ "$(A2DCASE)" -a "$(DMPARALLEL)" ] ; then \
+	 echo "------------------------------------------------------------------------------" ; \
+	 echo "WRF CONFIGURATION ERROR                                                       " ; \
+	 echo "The $(A2DCASE) case cannot be used on distributed memory parallel systems." ; \
+	 echo "Only 3D WRF cases will run on these systems." ; \
+	 echo "Please chose a different case or rerun configure and chose a different option."  ; \
+	 echo "------------------------------------------------------------------------------" ; \
+         exit 2 ; \
+	fi
+
+framework_only : configcheck
+	$(MAKE) MODULE_DIRS="$(ALL_MODULES)" ext
+	$(MAKE) MODULE_DIRS="$(ALL_MODULES)" toolsdir
+	/bin/rm -f main/libwrflib.a
+	$(MAKE) MODULE_DIRS="$(ALL_MODULES)" framework
+	$(MAKE) MODULE_DIRS="$(ALL_MODULES)" shared
+
+wrf : framework_only
+	$(MAKE) MODULE_DIRS="$(ALL_MODULES)" physics
+	if [ $(WRF_CHEM) -eq 1 ]    ; then $(MAKE) MODULE_DIRS="$(ALL_MODULES)" chemics ; fi
+	if [ $(WRF_EM_CORE) -eq 1 ]    ; then $(MAKE) MODULE_DIRS="$(ALL_MODULES)" em_core ; fi
+	if [ $(WRF_NMM_CORE) -eq 1 ]   ; then $(MAKE) MODULE_DIRS="$(ALL_MODULES)" nmm_core ; fi
+	if [ $(WRF_EXP_CORE) -eq 1 ]   ; then $(MAKE) MODULE_DIRS="$(ALL_MODULES)" exp_core ; fi
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em em_wrf )
+	( cd run ; /bin/rm -f wrf.exe ; ln -s ../main/wrf.exe . )
+	if [ $(ESMF_COUPLING) -eq 1 ] ; then \
+	  ( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em em_wrf_ESMFApp ) ; \
+	fi
+
+### 3.a.  rules to build the framework and then the experimental core
+
+exp_wrf : configcheck
+	$(MAKE) MODULE_DIRS="$(ALL_MODULES)" ext
+	$(MAKE) MODULE_DIRS="$(ALL_MODULES)" toolsdir
+	$(MAKE) MODULE_DIRS="$(ALL_MODULES)" framework
+	$(MAKE) MODULE_DIRS="$(ALL_MODULES)" shared
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=exp exp_wrf )
+
+
+nmm_wrf : wrf
+
+
+#  Eulerian mass coordinate initializations
+
+em_quarter_ss : wrf
+	@ echo '--------------------------------------'
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=quarter_ss em_ideal )
+	( cd test/em_quarter_ss ; /bin/rm -f wrf.exe ; ln -s ../../main/wrf.exe . )
+	( cd test/em_quarter_ss ; /bin/rm -f ideal.exe ; ln -s ../../main/ideal.exe . )
+	( cd test/em_quarter_ss ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd test/em_quarter_ss ; /bin/rm -f gribmap.txt ; ln -s ../../run/gribmap.txt . )
+	( cd test/em_quarter_ss ; /bin/rm -f grib2map.tbl ; ln -s ../../run/grib2map.tbl . )
+	( cd run ; /bin/rm -f ideal.exe ; ln -s ../main/ideal.exe . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/em_quarter_ss/namelist.input . )
+	( cd run ; /bin/rm -f input_sounding ; ln -s ../test/em_quarter_ss/input_sounding . )
+
+em_squall2d_x : wrf
+	@ echo '--------------------------------------'
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=squall2d_x em_ideal )
+	( cd test/em_squall2d_x ; /bin/rm -f wrf.exe ; ln -s ../../main/wrf.exe . )
+	( cd test/em_squall2d_x ; /bin/rm -f ideal.exe ; ln -s ../../main/ideal.exe . )
+	( cd test/em_squall2d_x ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd test/em_squall2d_x ; /bin/rm -f gribmap.txt ; ln -s ../../run/gribmap.txt . )
+	( cd test/em_squall2d_x ; /bin/rm -f grib2map.tbl ; ln -s ../../run/grib2map.tbl . )
+	( cd run ; /bin/rm -f ideal.exe ; ln -s ../main/ideal.exe . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/em_squall2d_x/namelist.input . )
+	( cd run ; /bin/rm -f input_sounding ; ln -s ../test/em_squall2d_x/input_sounding . )
+
+em_squall2d_y : wrf
+	@ echo '--------------------------------------'
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=squall2d_y em_ideal )
+	( cd test/em_squall2d_y ; /bin/rm -f wrf.exe ; ln -s ../../main/wrf.exe . )
+	( cd test/em_squall2d_y ; /bin/rm -f ideal.exe ; ln -s ../../main/ideal.exe . )
+	( cd test/em_squall2d_y ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd test/em_squall2d_y ; /bin/rm -f gribmap.txt ; ln -s ../../run/gribmap.txt . )
+	( cd test/em_squall2d_y ; /bin/rm -f grib2map.tbl ; ln -s ../../run/grib2map.tbl . )
+	( cd run ; /bin/rm -f ideal.exe ; ln -s ../main/ideal.exe . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/em_squall2d_y/namelist.input . )
+	( cd run ; /bin/rm -f input_sounding ; ln -s ../test/em_squall2d_y/input_sounding . )
+
+em_b_wave : wrf
+	@ echo '--------------------------------------'
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=b_wave em_ideal )
+	( cd test/em_b_wave ; /bin/rm -f wrf.exe ; ln -s ../../main/wrf.exe . )
+	( cd test/em_b_wave ; /bin/rm -f ideal.exe ; ln -s ../../main/ideal.exe . )
+	( cd test/em_b_wave ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd test/em_b_wave ; /bin/rm -f gribmap.txt ; ln -s ../../run/gribmap.txt . )
+	( cd test/em_b_wave ; /bin/rm -f grib2map.tbl ; ln -s ../../run/grib2map.tbl . )
+	( cd run ; /bin/rm -f ideal.exe ; ln -s ../main/ideal.exe . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/em_b_wave/namelist.input . )
+	( cd run ; /bin/rm -f input_jet ; ln -s ../test/em_b_wave/input_jet . )
+
+convert_em : framework_only
+	if [ $(WRF_CONVERT) -eq 1 ] ; then \
+            ( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" convert_em ) ; \
+        fi
+
+#TBH:  For now, link wrf.exe, wrf_ESMFApp.exe, and wrf_SST_ESMF.exe into 
+#TBH:  test/em_esmf_exp when ESMF_COUPLING is set.  Either wrf.exe or 
+#TBH:  wrf_ESMFApp.exe can be used for stand-alone testing in this case.  
+#TBH:  wrf_SST_ESMF.exe is a coupled application.  Note that single make 
+#TBH:  target $(SOLVER)_wrf_ESMFApp builds both wrf_ESMFApp.exe and 
+#TBH:  wrf_SST_ESMF.exe.  
+#TBH:  Is this a clear violation of the DRY principle?  Oh yeah, you bet.  
+em_real : wrf
+	@ echo '--------------------------------------'
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=real em_real )
+	( cd test/em_real ; /bin/rm -f wrf.exe ; ln -s ../../main/wrf.exe . )
+	if [ $(ESMF_COUPLING) -eq 1 ] ; then \
+	  ( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=real em_wrf_ESMFApp ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f wrf.exe ; ln -s ../../main/wrf.exe . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f wrf_ESMFApp.exe ; ln -s ../../main/wrf_ESMFApp.exe . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f wrf_SST_ESMF.exe ; ln -s ../../main/wrf_SST_ESMF.exe . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f real.exe ; ln -s ../../main/real.exe . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f ETAMPNEW_DATA RRTM_DATA ; \
+               ln -sf ../../run/ETAMPNEW_DATA . ;                      \
+               ln -sf ../../run/RRTM_DATA . ;                          \
+               ln -sf ../../run/CAM_ABS_DATA . ;                       \
+               ln -sf ../../run/CAM_AEROPT_DATA . ;                    \
+               ln -sf ../../run/ozone.formatted . ;                    \
+               ln -sf ../../run/ozone_lat.formatted . ;                \
+               ln -sf ../../run/ozone_plev.formatted . ;               \
+               if [ $(RWORDSIZE) -eq 8 ] ; then                        \
+                  ln -sf ../../run/ETAMPNEW_DATA_DBL ETAMPNEW_DATA ;   \
+                  ln -sf ../../run/RRTM_DATA_DBL RRTM_DATA ;           \
+               fi ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f GENPARM.TBL ; ln -s ../../run/GENPARM.TBL . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f LANDUSE.TBL ; ln -s ../../run/LANDUSE.TBL . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f SOILPARM.TBL ; ln -s ../../run/SOILPARM.TBL . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f urban_param.tbl ; ln -s ../../run/urban_param.tbl . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f VEGPARM.TBL ; ln -s ../../run/VEGPARM.TBL . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f tr49t67 ; ln -s ../../run/tr49t67 . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f tr49t85 ; ln -s ../../run/tr49t85 . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f tr67t85 ; ln -s ../../run/tr67t85 . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f gribmap.txt ; ln -s ../../run/gribmap.txt . ) ; \
+	  ( cd test/em_esmf_exp ; /bin/rm -f grib2map.tbl ; ln -s ../../run/grib2map.tbl . ) ; \
+	fi
+	( cd test/em_real ; /bin/rm -f real.exe ; ln -s ../../main/real.exe . )
+	( cd test/em_real ; /bin/rm -f ndown.exe ; ln -s ../../main/ndown.exe . )
+	( cd test/em_real ; /bin/rm -f nup.exe ; ln -s ../../main/nup.exe . )
+	( cd test/em_real ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd test/em_real ; /bin/rm -f ETAMPNEW_DATA RRTM_DATA ;    \
+             ln -sf ../../run/ETAMPNEW_DATA . ;                     \
+             ln -sf ../../run/RRTM_DATA . ;                         \
+             ln -sf ../../run/CAM_ABS_DATA . ;                         \
+             ln -sf ../../run/CAM_AEROPT_DATA . ;                         \
+             ln -sf ../../run/ozone.formatted . ;                         \
+             ln -sf ../../run/ozone_lat.formatted . ;                         \
+             ln -sf ../../run/ozone_plev.formatted . ;                         \
+             if [ $(RWORDSIZE) -eq 8 ] ; then                       \
+                ln -sf ../../run/ETAMPNEW_DATA_DBL ETAMPNEW_DATA ;  \
+                ln -sf ../../run/RRTM_DATA_DBL RRTM_DATA ;          \
+             fi )
+	( cd test/em_real ; /bin/rm -f GENPARM.TBL ; ln -s ../../run/GENPARM.TBL . )
+	( cd test/em_real ; /bin/rm -f LANDUSE.TBL ; ln -s ../../run/LANDUSE.TBL . )
+	( cd test/em_real ; /bin/rm -f SOILPARM.TBL ; ln -s ../../run/SOILPARM.TBL . )
+	( cd test/em_real ; /bin/rm -f urban_param.tbl ; ln -s ../../run/urban_param.tbl . )
+	( cd test/em_real ; /bin/rm -f VEGPARM.TBL ; ln -s ../../run/VEGPARM.TBL . )
+	( cd test/em_real ; /bin/rm -f tr49t67 ; ln -s ../../run/tr49t67 . )
+	( cd test/em_real ; /bin/rm -f tr49t85 ; ln -s ../../run/tr49t85 . )
+	( cd test/em_real ; /bin/rm -f tr67t85 ; ln -s ../../run/tr67t85 . )
+	( cd test/em_real ; /bin/rm -f gribmap.txt ; ln -s ../../run/gribmap.txt . )
+	( cd test/em_real ; /bin/rm -f grib2map.tbl ; ln -s ../../run/grib2map.tbl . )
+	( cd run ; /bin/rm -f real.exe ; ln -s ../main/real.exe . )
+	( cd run ; /bin/rm -f ndown.exe ; ln -s ../main/ndown.exe . )
+	( cd run ; /bin/rm -f nup.exe ; ln -s ../main/nup.exe . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/em_real/namelist.input . )
+
+
+em_hill2d_x : wrf
+	@ echo '--------------------------------------'
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=hill2d_x em_ideal )
+	( cd test/em_hill2d_x ; /bin/rm -f wrf.exe ; ln -s ../../main/wrf.exe . )
+	( cd test/em_hill2d_x ; /bin/rm -f ideal.exe ; ln -s ../../main/ideal.exe . )
+	( cd test/em_hill2d_x ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd test/em_hill2d_x ; /bin/rm -f gribmap.txt ; ln -s ../../run/gribmap.txt . )
+	( cd test/em_hill2d_x ; /bin/rm -f grib2map.tbl ; ln -s ../../run/grib2map.tbl . )
+	( cd run ; /bin/rm -f ideal.exe ; ln -s ../main/ideal.exe . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/em_hill2d_x/namelist.input . )
+	( cd run ; /bin/rm -f input_sounding ; ln -s ../test/em_hill2d_x/input_sounding . )
+
+em_grav2d_x : wrf
+	@ echo '--------------------------------------'
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=grav2d_x em_ideal )
+	( cd test/em_grav2d_x ; /bin/rm -f wrf.exe ; ln -s ../../main/wrf.exe . )
+	( cd test/em_grav2d_x ; /bin/rm -f ideal.exe ; ln -s ../../main/ideal.exe . )
+	( cd test/em_grav2d_x ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd test/em_grav2d_x ; /bin/rm -f gribmap.txt ; ln -s ../../run/gribmap.txt . )
+	( cd test/em_grav2d_x ; /bin/rm -f grib2map.tbl ; ln -s ../../run/grib2map.tbl . )
+	( cd run ; /bin/rm -f ideal.exe ; ln -s ../main/ideal.exe . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/em_grav2d_x/namelist.input . )
+	( cd run ; /bin/rm -f input_sounding ; ln -s ../test/em_grav2d_x/input_sounding . )
+
+#### anthropogenic emissions converter
+
+emi_conv : wrf
+	@ echo '--------------------------------------'
+	( cd chem ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=real convert_emiss )
+	( cd test/em_real ; /bin/rm -f convert_emiss.exe ; ln -s ../../chem/convert_emiss.exe . )
+	( cd test/em_real ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/em_real/namelist.input . )
+
+#### biogenic emissions converter
+
+bio_conv : wrf
+	@ echo '--------------------------------------'
+	( cd chem ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=em IDEAL_CASE=real convert_bioemiss )
+	( cd test/em_real ; /bin/rm -f convert_bioemiss.exe ; ln -s ../../chem/convert_bioemiss.exe . )
+	( cd test/em_real ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/em_real/namelist.input . )
+
+#### nmm converter
+
+nmm_real : nmm_wrf
+	@ echo '--------------------------------------'
+	( cd main ; $(MAKE) MODULE_DIRS="$(ALL_MODULES)" SOLVER=nmm IDEAL_CASE=real real_nmm )
+	( cd test/nmm_real ; /bin/rm -f wrf.exe ; ln -s ../../main/wrf.exe . )
+	( cd test/nmm_real ; /bin/rm -f real_nmm.exe ; ln -s ../../main/real_nmm.exe . )
+	( cd test/nmm_real ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
+	( cd test/nmm_real ; /bin/rm -f ETAMPNEW_DATA RRTM_DATA ;    \
+	     ln -sf ../../run/ETAMPNEW_DATA . ;                     \
+	     ln -sf ../../run/RRTM_DATA . ;                         \
+	     if [ $(RWORDSIZE) -eq 8 ] ; then                       \
+	        ln -sf ../../run/ETAMPNEW_DATA_DBL ETAMPNEW_DATA ;  \
+	        ln -sf ../../run/RRTM_DATA_DBL RRTM_DATA ;          \
+	     fi )
+	( cd test/nmm_real ; /bin/rm -f GENPARM.TBL ; ln -s ../../run/GENPARM.TBL . )
+	( cd test/nmm_real ; /bin/rm -f LANDUSE.TBL ; ln -s ../../run/LANDUSE.TBL . )
+	( cd test/nmm_real ; /bin/rm -f SOILPARM.TBL ; ln -s ../../run/SOILPARM.TBL . )
+	( cd test/nmm_real ; /bin/rm -f VEGPARM.TBL ; ln -s ../../run/VEGPARM.TBL . )
+	( cd test/nmm_real ; /bin/rm -f tr49t67 ; ln -s ../../run/tr49t67 . )
+	( cd test/nmm_real ; /bin/rm -f tr49t85 ; ln -s ../../run/tr49t85 . )
+	( cd test/nmm_real ; /bin/rm -f tr67t85 ; ln -s ../../run/tr67t85 . )
+	( cd test/nmm_real ; /bin/rm -f gribmap.txt ; ln -s ../../run/gribmap.txt . )
+	( cd test/nmm_real ; /bin/rm -f grib2map.txt ; ln -s ../../run/grib2map.txt . )
+	( cd run ; /bin/rm -f real_nmm.exe ; ln -s ../main/real_nmm.exe . )
+	( cd run ; if test -f namelist.input ; then \
+		/bin/cp -f namelist.input namelist.input.backup ; fi ; \
+		/bin/rm -f namelist.input ; ln -s ../test/nmm_real/namelist.input . )
+
+
+
+# semi-Lagrangian initializations
+
+
+ext :
+	@ echo '--------------------------------------'
+	( cd frame ; $(MAKE) externals )
+
+framework :
+	@ echo '--------------------------------------'
+	( cd frame ; $(MAKE) framework; \
+	cd ../external/io_netcdf ; make NETCDFPATH="$(NETCDFPATH)" FC="$(SFC) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" LDFLAGS="$(LDFLAGS)" ESMF_IO_LIB_EXT="$(ESMF_IO_LIB_EXT)" ESMF_MOD_DEPENDENCE="../$(ESMF_MOD_DEPENDENCE)" diffwrf; \
+	cd ../io_int ; $(MAKE) SFC="$(SFC) $(FCBASEOPTS)" FC="$(SFC) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" ESMF_IO_LIB_EXT="$(ESMF_IO_LIB_EXT)" ESMF_MOD_DEPENDENCE="../$(ESMF_MOD_DEPENDENCE)" diffwrf ; cd ../../frame )
+
+shared :
+	@ echo '--------------------------------------'
+	( cd share ; $(MAKE) )
+
+chemics :
+	@ echo '--------------------------------------'
+	( cd chem ; $(MAKE) )
+
+physics :
+	@ echo '--------------------------------------'
+	( cd phys ; $(MAKE) )
+
+em_core :
+	@ echo '--------------------------------------'
+	( cd dyn_em ; $(MAKE) )
+
+# rule used by configure to test if this will compile with MPI 2 calls MPI_Comm_f2c and _c2f
+mpi2_test :
+	@ cd tools ; /bin/rm -f mpi2_test ; $(CC) -c mpi2_test.c ; cd ..
+
+# rule used by configure to test if fseeko and fseeko64 are supported (for share/landread.c to work right)
+fseek_test :
+	@ cd tools ; /bin/rm -f fseeko_test ; $(SCC) -DTEST_FSEEKO -o fseeko_test fseek_test.c ; cd ..
+	@ cd tools ; /bin/rm -f fseeko64_test ; $(SCC) -DTEST_FSEEKO64 -o fseeko64_test fseek_test.c ; cd ..
+
+### 3.b.  sub-rule to build the expimental core
+
+# uncomment the two lines after exp_core for EXP
+exp_core :
+	@ echo '--------------------------------------'
+	( cd dyn_exp ; $(MAKE) )
+
+# uncomment the two lines after nmm_core for NMM
+nmm_core :
+	@ echo '--------------------------------------'
+	( cd dyn_nmm ; $(MAKE) )
+
+toolsdir :
+	@ echo '--------------------------------------'
+	( cd tools ; $(MAKE) CC="$(CC_TOOLS)" )
+
+# Use this target to build stand-alone tests of esmf_time_f90.  
+# Only touches external/esmf_time_f90/.  
+esmf_time_f90_only :
+	@ echo '--------------------------------------'
+	( cd external/esmf_time_f90 ; $(MAKE) FC="$(FC) $(FCFLAGS)" CPP="$(CPP) -DTIME_F90_ONLY" tests )
+
+clean :
+		@ echo 'Use the clean script'
+
+# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV2/README
===================================================================
--- trunk/WRF.COMMON/WRFV2/README	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/README	(revision 2744)
@@ -0,0 +1,219 @@
+WRF Model Version 2.2 (December 2006)
+http://www.mmm.ucar.edu/wrf/users/
+
+------------------------
+WRF PUBLIC DOMAIN NOTICE
+------------------------
+
+WRF was developed at the National Center for Atmospheric Research
+(NCAR) which is operated by the University Corporation for
+Atmospheric Research (UCAR). NCAR and UCAR make no proprietary
+claims, either statutory or otherwise, to this version and
+release of WRF and consider WRF to be in the public domain for
+use by any person or entity for any purpose without any fee or
+charge. UCAR requests that any WRF user include this notice on
+any partial or full copies of WRF. WRF is provided on an "AS
+IS" basis and any warranties, either express or implied,
+including but not limited to implied warranties of
+non-infringement, originality, merchantability and fitness for a
+particular purpose, are disclaimed. In no event shall
+UCAR be liable for any damages, whatsoever, whether direct,
+indirect, consequential or special, that arise out of or in
+connection with the access, use or performance of WRF, including
+infringement actions.
+
+
+======================================
+This is the main directory for the WRF Version 2 source code release.
+======================================
+
+V2.2 Release Notes:
+------------------
+
+- For directions on compiling WRF, see below or Users Web page.
+- For more information on WRF V2.2 release, visit WRF Users home page
+  http://www.mmm.ucar.edu/wrf/users/
+- WRF V2.2 works with both WPS (new WRF Preprocessing System) and SI.
+  Please see User' Guide for WPS.
+- WRF V2.2 executable works with wrfinput/wrfbdy produced by previous version,
+  but pre-V2.2 WRF will NOT work with V2.2 wrfinput/wrfbdy files.
+- WRF V2.2's namelist has new additions. Edit with caution.
+
+For questions, send mail to wrfhelp@ucar.edu
+
+======================================
+
+V2.1 Release Notes:
+------------------
+
+- For directions on compiling WRF, see below or Users Web page.
+- For more information on WRF V2.1 release, visit WRF Users home page
+  http://www.mmm.ucar.edu/wrf/users/
+- Use WRFSI 2.0.3 or 2.1 (http://wrfsi.noaa.gov) for real-data preparation.
+- Must rerun real.exe to generate new wrfbdy_d01/wrfinput_d01 for wrf.exe.
+- WRF V2.1's namelist has some changes from 2.0.3.1. Edit with caution.
+- Need to have gribmap.txt in your run directory.
+
+======================================
+
+V2 update history:
+
+- V2.0.1: May 21, 2004
+- V2.0.2: June 3, 2004
+- V2.0.3: Nov 12, 2004 
+  V2.0.3.1: Dec 3, 2004
+- V2.1: August 4, 2005
+- V2.1.1: Nov 8, 2005
+- V2.1.2: Jan 27, 2006
+- V2.2: Dec 21, 2006
+
+======================================
+
+How to compile and run?
+-----------------------
+
+- In WRFV2 directory, type 'configure' - this will create a configure.wrf
+  file that has appropriate compile options for the supported computers.
+
+  Note: WRF requires netCDF library. If your netCDF library is installed in
+        some odd directory, set environment variable NETCDF before you type
+        'configure'. For example, 
+
+        setenv NETCDF /usr/local/lib32/r4i4
+
+- Type 'compile case_name' where you can find the case_names by simply typing
+  compile. The following are available:
+
+        compile em_b_wave
+        compile em_hill2d_x
+        compile em_grav2d_x
+        compile em_quarter_ss
+        compile em_real
+        compile em_squall2d_x
+        compile em_squall2d_y
+
+- If sucessfully, this will create either real.exe or ideal.exe and wrf.exe
+  in directory main/, and the appropriate executables will be linked into
+  the test directoires under test/case_name, or run/.
+
+- cd to the appropriate test or run direcotry to run ideal/real/wrf.
+
+- If it is one of the idealized cases (b_wave, hill2d_x, grav2d_x, quarter_ss,
+  squall2d_x or squall2d_y), cd the the appropriate directory, type
+
+  ideal.exe 
+
+  to produce wrfinput_d01 file for wrf model. Then type
+
+  wrf.exe 
+
+  to run. 
+
+- If it is real-data case (real), place files from SI (wrf_real_input_em.*)
+  in the appropriate directory, type
+
+  real.exe
+
+  to produce wrfbdy_d01 and wrfinput_d01. Then type
+
+  wrf.exe
+
+  to run.
+
+- If you use mpich, type
+
+  mpirun -np number-of-processors wrf.exe
+
+- For information on how to make nested runs, visit
+  http://www.mmm.ucar.edu/wrf/users/
+
+
+======================================
+
+What is in WRF V2?
+
+- Advanced Research WRF (ARW) solver: Eulerian mass, hydrostatic and non-hydrostatic
+  * Arakawa C-grid staggering
+  * Runge-Kutta 2nd and 3rd order timestep options
+  * scalar-conserving flux form for prognostic variables
+  * 2nd to 6th order advection options (horizontal and vertical)
+  * time-split small step for acoustic modes
+  * small step horizontally explicit, vertically implicit
+  * divergence damping option and vertical time off-centering
+  * external-mode filtering option for mass model
+  * hydrostatic option via namelist option
+  * positive-definite advection for moisture, scalar, tke and chemical tracers (since 2.2)
+
+- Two-way nesting:
+  * multiple domains and multiple nest levels
+  * supports integer nest grid ratio
+  * feedback option for both odd and even nest grid ratios (since 2.0.3)
+  * smoothing options
+
+- One-way nesting (since 2.0.2)
+
+- Moving nest (since 2.1)
+  * Specified move.
+  * Automatic move using a mid-level vortex-following algorithm.
+
+- Physics options:
+  * microphysics (Kessler/ WRF Single Moment 3, 5 and 6 class / Lin et al./
+    Eta Ferrier / Thompson [a new version in 2.2])
+  * cumulus parameterization (Kain-Fritsch with shallow convection / 
+    Betts-Miller-Janjic / Grell-Devenyi ensemble)
+  * planetary boundary layer (Yosei University (S. Korea) / Mellor-Yamada-Janjic)
+  * surface layer (similarity theory MM5 / Eta)
+  * slab soil model (5-layer thermal diffusion / Noah land-surface model (4-level) /
+    RUC LSM (6-level) )
+  * Urban canopy model (works with Noah LSM) (since 2.2)
+  * longwave radiation (RRTM, CAM)
+  * shortwave radiation (simple MM5 scheme / Goddard / CAM)
+  * sub-grid turbulence (constant K diffusion/ 2-D Smagorinsky/ predicted TKE /
+    2-D, 6th order diffusion)
+  * land-use categories determine surface properties
+  * three-dimensional analysis nudging (since 2.2)
+  * observation nudging (since 2.2)
+
+- Software
+
+  * Hierarchical software architecture that insulates scientific code
+    (Model Layer) from computer architecture (Driver Layer)
+  * Multi-level parallelism supporting shared-memory (OpenMP), distributed-memory (MPI), 
+    and hybrid share/distributed modes of execution
+  * Active data registry: defines and manages model state fields, I/O,
+    nesting, configuration, and numerous other aspects of WRF through a single file, 
+    called the Registry
+  * Two-way nesting:
+      Easy to extend: forcing and feedback of new fields specified by
+        editing a single table in the Registry
+      Efficient: 5-8% overhead on 64 processes of IBM
+      Moving nests.
+  * Enhanced I/O options:
+      NetCDF and Parallel HDF5 formats
+      Five auxiliary history output streams separately controllable through the namelist
+      Output file names and time-stamps specifiable through namelist
+      Special output stream for 3DVAR
+  * Efficient execution on a range of computing platforms:
+      IBM SP systems, (e.g. NCAR "bluesky" Power4-based system)
+      HP/Compaq Alpha/OSF workstation, SMP, and MPP systems (e.g. Pittsburgh 
+         Supercomputing Center TCS)
+      SGI Origin and Altix
+      Linux/Intel
+         IA64 MPP (HP Superdome, SGI Altix, NCSA Teragrid systems)
+         IA64 SMP
+         Pentium 3/4 SMP and SMP clusters (NOAA/FSL iJet system)
+	 PGI and Intel compilers supported
+      Alpha Linux (NOAA/FSL Jet system)
+      Sun Solaris (single threaded and SMP)
+      Cray X1, X1e (vector), X1D (Opteron)
+      Mac G5, xlf compiler (no DM-parallel yet)
+      HP-UX
+      Other ports under development:
+         NEC SX/6
+         Fujitsu VPP 5000
+  * RSL_LITE: optional new communication layer, scalable to very
+    large domains, support nesting.
+  * ESMF Time Management, including exact arithmetic for fractional
+    time steps (no drift).
+  * ESMF integration - WRF can be run as an ESMF component.
+  * Improved documentation, both on-line (web based browsing tools) and in-line
Index: trunk/WRF.COMMON/WRFV2/README.NMM
===================================================================
--- trunk/WRF.COMMON/WRFV2/README.NMM	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/README.NMM	(revision 2744)
@@ -0,0 +1,202 @@
+
+WRF-NMM Model Version 2 (June 2005)
+
+----------------------------
+WRF-NMM PUBLIC DOMAIN NOTICE
+----------------------------
+
+WRF-NMM was developed at National Centers for
+Environmental Prediction (NCEP), which is part of
+NOAA's National Weather Service.  As a government
+entity, NCEP makes no proprietary claims, either
+statutory or otherwise, to this version and release of
+WRF-NMM and consider WRF-NMM to be in the public
+domain for use by any person or entity for any purpose
+without any fee or charge. NCEP requests that any WRF
+user include this notice on any partial or full copies
+of WRF-NMM. WRF-NMM is provided on an "AS IS" basis
+and any warranties, either express or implied,
+including but not limited to implied warranties of
+non-infringement, originality, merchantability and
+fitness for a particular purpose, are disclaimed. In
+no event shall NOAA, NWS or NCEP be liable for any
+damages, whatsoever, whether direct, indirect,
+consequential or special, that arise out of or in
+connection with the access, use or performance of
+WRF-NMM, including infringement actions.
+
+================================================
+
+V2 Release Notes:
+-----------------
+
+This is the main directory for the WRF Version 2 source code release.
+
+- For directions on compiling WRF for NMM, see below or the WRF-NMM Users' Web page.
+- If you have used WRF software before, you must re-run WRF-SI/NMM 
+  (set namelist variable OUTPUT_FILE_TYPE = 'WRF') preferably using
+  the recent WRF-NMM SI release).
+- Read the README.namelist file in the run/ directory (or on the WRF-NMM Users' page), 
+  and make changes carefully.
+
+For questions, send mail to wrfhelp@ucar.edu
+
+======================================
+
+The ./compile script at the top level has been updated to all for easy
+selection of NMM and ARW cores of WRF at compile time. 
+
+   - Specify your WRF-NMM option by setting the appropriate environment variable:
+
+           setenv WRF_NMM_CORE 1
+
+   - The Registry files for NMM and ARW are not integrated
+     yet. There are separate versions:
+
+          Registry/Registry.NMM       <-- for NMM
+          Registry/Registry.EM        <-- for ARW (formerly known as Eulerian Mass)
+
+
+How to configure, compile and run?
+----------------------------------
+
+- In WRFV2 directory, type:
+
+   configure
+
+  this will create a configure.wrf file that has appropriate compile 
+  options for the supported computers. Edit your configure.wrf file as needed.
+
+  Note: WRF requires netCDF library. If your netCDF library is installed in
+        some odd directory, set environment variable NETCDF before you type
+        'configure'. For example: 
+
+        setenv NETCDF /usr/local/lib32/r4i4
+
+- Type: 
+        compile nmm_real
+       
+- If sucessful, this command will create nmm_real.exe and wrf.exe
+  in directory main/, and the appropriate executables will be linked into
+  the test directories under test/nmm_real, or run/.
+
+- cd to the appropriate test or run direcotry to run "nmm_real.exe" and "wrf.exe".
+
+- Place files from WRF-NMM SI (wrf_real_input_nm.*)
+  in the appropriate directory, type
+
+  real_nmm.exe
+
+  to produce wrfbdy_d01 and wrfinput_d01. Then type
+
+  wrf.exe
+
+  to run.
+
+- If you use mpich, type
+
+  mpirun -np number-of-processors wrf.exe
+
+=============================================================================
+
+What is in WRF-NMM V2.1?
+
+* Dynamics:
+
+  - The WRF-NMM model is a fully compressible, non-hydrostatic model with a
+    hydrostatic option. 
+  
+  - The terrain following hybrid pressure sigma vertical coordinate is used. 
+  
+  - The grid staggering is the Arakawa E-grid. 
+  
+  - The same time step is used for all terms.  
+
+  - Time stepping:
+     - Horizontally propagating fast-waves: Forward-backward scheme
+     - Veryically propagating sound waves: Implicit scheme
+
+  - Advection (time):
+     T,U,V:
+      - Horizontal: The Adams-Bashforth scheme
+      - Vertical:   The Crank-Nicholson scheme
+     TKE, water species: Forward, flux-corrected (called every two timesteps).
+
+  - Advection (space):
+     T,U,V:
+      - Horizontal: Energy and enstrophy conserving, 
+      quadratic conservative,second order
+      
+      - Vertical: Quadratic conservative,second order TKE, 
+        
+      - Water species: Upstream, flux-corrected, positive definite, conservative
+
+  - Horizontal diffusion: Forward, second order "Smagorinsky-type" 
+
+  - Vertical Diffusion:
+     See "Free atmosphere turbulence above surface layer" section
+     in "Physics" section given in below. 
+
+* Physics:
+
+  - Explicit Microphysics: Ferrier (Used operationally at NCEP.)
+
+  - Cumulus parameterizations: Betts-Miller-Janjic, (Used operationally at NCEP.)
+          Kain-Fritsch with shallow convection 
+  
+  - Free atmosphere turbulence above surface layer: Mellor-Yamada-Janjic (Used operationally at NCEP.)
+  
+  - Planetary boundary layer: Mellor-Yamada-Janjic (Used operationally at NCEP.)
+  
+  - Surface layer: Similarity theory scheme with viscous sublayers 
+                   over both solid surfaces and water points (Janjic).
+  - Radiation:
+    - Longwave radiation: GFDL Scheme  (Fels-Schwarzkopf) (Used operationally at NCEP.)
+    - Shortwave radiation: GFDL-scheme (Lacis-Hansen) (Used operationally at NCEP.)
+
+  - Gravity wave drag: none
+
+
+* WRF Software:
+
+  - Hierarchical software architecture that insulates scientific code
+    (Model Layer) from computer architecture (Driver Layer)
+  - Multi-level parallelism supporting shared-memory (OpenMP), distributed-memory (MPI), 
+    and hybrid share/distributed modes of execution
+  - Active data registry: defines and manages model state fields, I/O,
+    configuration, and numerous other aspects of WRF through a single file, 
+    called the Registry
+  - Enhanced I/O options:
+      NetCDF and Parallel HDF5 formats
+      Five auxiliary history output streams separately controllable through the namelist
+      Output file names and time-stamps specifiable through namelist
+
+  - Testing: Various regression tests are performed on HP/Compaq systems at
+    NCAR/MMM whenever a change is introduced into WRF cores. 
+
+  - Efficient execution on a range of computing platforms:
+      IBM SP systems, (e.g. NCAR "bluesky" and NCEP's "blue", Power4-based system)
+      HP/Compaq Alpha/OSF workstation, SMP, and MPP systems (e.g. Pittsburgh 
+         Supercomputing Center TCS)
+      SGI Origin and Altix
+      Linux/Intel
+         IA64 MPP (HP Superdome, SGI Altix, NCSA Teragrid systems)
+         IA64 SMP
+         Pentium 3/4 SMP and SMP clusters (NOAA/FSL iJet system)
+      PGI and Intel compilers supported
+      Alpha Linux (NOAA/FSL Jet system)
+      Sun Solaris (single threaded and SMP)
+      Cray X1
+      HP-UX
+      Other ports under development:
+         NEC SX/6
+         Fujitsu VPP 5000
+  - RSL_LITE: optional new communication layer, scalable to very
+    large domains (limited to single domain in 2.0)
+  - ESMF Time Management, including exact arithmetic for fractional
+    time steps (no drift); model start, stop, run length and I/O frequencies are
+    now specified as times and time intervals in 2.0
+  - Improved documentation, both on-line (web based browsing tools) and in-line
+
+--------------------------------------------------------------------------
+
Index: trunk/WRF.COMMON/WRFV2/README_test_cases
===================================================================
--- trunk/WRF.COMMON/WRFV2/README_test_cases	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/README_test_cases	(revision 2744)
@@ -0,0 +1,84 @@
+WRFV2 (Weather Research and Forecast) model.   
+
+Contents:
+
+A) Directions for running a test case.
+B) List of available test cases
+
+---------------------------------------
+
+(A)  Directions for running a test case
+
+A suite of tests for the WRF model ARW (Advanced Research WRF) core 
+can be found in the directory "test".  Each subdirectory in /test 
+contains the necessary data (except for the real data case) and 
+input files to run the test specific to that directory.  
+To run specific test, builld the WRF model
+and the necessary initialization routine by typing
+
+-> compile "test_name"
+
+in the top directory (the directory containing this README file).
+For example, to build the executables for the 2D (x,z) squall line
+example for Eulerian mass coordinate model, you would type the command 
+"compile em_squall2d_x".
+
+after a successful build, go the the specific test directory:
+
+-> cd test/"test_name"
+
+run the initialization code
+
+-> ideal.exe
+
+and then run the simulation
+
+-> wrf.exe
+
+---------------------------------------
+
+(B) Available Test Cases
+
+The available test cases are
+
+1) squall2d_x (test/em_squall2d_x)
+
+   2D squall line (x,z) using Kessler microphysics
+   and a fixed 300 m^2/s viscosity.  periodicity 
+   condition used in y so that 3D model produces
+   2D simulation.  v velocity  should be zero and there 
+   should be no variation in y in the results.
+
+2) squall2d_y (test/em_squall2d_y)
+
+   Same as squall2d_x, except with (x) rotated to (y).
+   u velocity  should be zero and there 
+   should be no variation in x in the results.
+
+3) 3D quarter-circle shear supercell simulation 
+   (test/em_quarter_ss).
+
+   Left and right moving supercells are produced.
+   See the README.quarter_ss file in the test directory
+   for more information.
+
+4) 2D flow over a bell-shaped hill (x,z) (test/em_hill2d_x) 
+
+   10 km half-width, 2 km grid-length, 100 m high hill, 
+   10 m/s flow, N=0.01/s, 30 km high domain, 80 levels,
+   open radiative boundaries, absorbing upper boundary. 
+   Case is in linear hydrostatic regime, so vertical tilted 
+   waves with ~6km vertical wavelength.
+
+5) 3D baroclinic waves (test/em_b_wave)
+
+   Baroclinically unstable jet u(y,z) on an
+   f-plane.  Symmetric north and south, periodic east and west 
+   boundaries.  100 km grid size 16 km top with 4 km damping layer. 
+   41x81 points in (x,y), 64 layers.
+
+6) 2D gravity current (test/em_grav2d_x)
+
+   Test case is described in Straka et al,
+   INT J NUMER METH FL 17 (1): 1-22 JUL 15 1993.
+   See the README.grav2d_x file in the test directory.
Index: trunk/WRF.COMMON/WRFV2/Registry.EM.sed
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry.EM.sed	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry.EM.sed	(revision 2744)
@@ -0,0 +1,6 @@
+/tsoil_gc/ a\
+state  real   isoil_gc       igj   dyn_em  1  Z  i1  "ISOIL"            "soil thermal inertia"    "tiu"\nstate  real   dsoil_gc       igj   dyn_em  1  Z  i1  "DSOIL"            "soil depths"             "m"
+
+/mars_tsoil/ a\
+state  real   mars_isoil     ilj   misc  1  -  i012rd  "MARS_ISOIL"  "soil thermal inertia"    "tiu"\nstate  real   mars_dsoil     ilj   misc  1  -  i012rd  "MARS_DSOIL"  "soil depths"             "m"
+
Index: trunk/WRF.COMMON/WRFV2/Registry/Registry.EM
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/Registry.EM	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/Registry.EM	(revision 2744)
@@ -0,0 +1,1631 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+#### --- please indicate #SAVEMARS2 for 2D fields and #SAVEMARS3 for 3D fields
+####
+############ name in WRF !!!!! ############# name in NETCDF !!!! ############################################## name in meso_physiq !!!!!
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg m-2"  #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd   "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWNZ   ij   misc  1  -  rhd   "SWDOWNZ"   "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWNZ   ij   misc  1  -  rhd   "LWDOWNZ"   "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rd   "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rd   "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rhd   "MTOT"      "TOTAL MASS WATER VAPOR in pmic"  "pmic"    #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rhd   "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rhd   "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+state  real  HR_SW     ikj  misc  1  -  rd   "HR_SW"     "HEATING RATE SW"                 "K/s"     #SAVEMARS3 zdtsw
+state  real  HR_LW     ikj  misc  1  -  rd   "HR_LW"     "HEATING RATE LW"                 "K/s"     #SAVEMARS3 zdtlw
+state  real  HR_SH     ikj  misc  1  -  rd   "HR_SH"     "HEATING RATE sens. heat"         "K/s"     #SAVEMARS3 zdtdif
+state  real  QSURFICE  ij   misc  1  -  rhd   "QSURFICE"  "WATER ICE AT SURFACE"            "kg m-2"  #SAVEMARS2 qsurfice
+state  real  QSURFDUST ij   misc  1  -  rd   "QSURFDUST" "DUST MASS AT SURFACE"            "kg m-2"  #SAVEMARS2 qsurfdust
+state  real  RDUST     ikj  misc  1  -  rd   "RDUST"     "DUST RADIUS"                     "m"       #SAVEMARS3 rdust
+state  real  HR_NIR    ikj  misc  1  -  rd   "HR_NIR"    "HEATING RATE nirco2"             "K/s"     #SAVEMARS3 zdtnirco2
+state  real  HR_NLTE   ikj  misc  1  -  rd   "HR_NLTE"   "HEATING RATE nlte"               "K/s"     #SAVEMARS3 zdtnlte
+state  real  ALBBARE   ij   misc  1  -  rhd   "ALBBARE"   "SOIL ALBEDO"                     ""        #SAVEMARS2 albedodat
+state  real  VMR_ICE   ikj  misc  1  -  rhd   "VMR_ICE"   "VOL. MIXING RATIO ICE"           "ppm"     #SAVEMARS3 vmr
+state  real  TAU_ICE   ij   misc  1  -  rhd   "TAU_ICE"   "CLOUD OD at 825 cm-1 TES"        ""        #SAVEMARS2 tauTES
+state  real  PDTZ      ikj  misc  1  -  rd   "PDT"       "TEMP TENDENCY"                   "K s-1"   #SAVEMARS3 pdt
+state  real  ZMAX_TH   ij   misc  1  -  rd   "ZMAX_TH"   "MAXIMUM LEVEL REACHED IN TH"     "m"       #SAVEMARS2 zmax_th
+state  real  HFMAX_TH  ij   misc  1  -  rd   "HFMAX_TH"  "MAXIMUM TH HEAT FLUX"            "m.K/s"   #SAVEMARS2 hfmax_th
+state  real  WSTAR     ij   misc  1  -  rd   "WSTAR"     "FREE CONVECTION VELOCITY FROM TH" "m/s"    #SAVEMARS2 wstar
+state  real  Z0SET     ij   misc  1  -  rd   "Z0SET"     "SET SURFACE ROUGHNESS"           "m"       #SAVEMARS2 z0
+state  real  HR_DYN     ikj   misc  1  -  -  "HR_DYN"     "HEATING RATE DYN"                 "K/s"
+state  real  DDT     ikj   misc  1  -  -  "DDT"     "TEMPERATURE TENDENCY"                 "K/s"
+state  real  DT_RAD     ikj   misc  1  -  -  "DT_RAD"     "RADIATIVE TEMPERATURE TENDENCY"                 "K/s"
+state  real  DT_VDF     ikj   misc  1  -  -  "DT_VDF"     "PBL CLMAIN TEMPERATURE TENDENCY"                 "K/s"
+state  real  DT_AJS     ikj   misc  1  -  -  "DT_AJS"     "AJUSTEMENT SEC TEMPERATURE TENDENCY"                 "K/s"
+state  real  CLOUDFRAC  ikj  misc  1  -  -  "CLOUDFRAC"     "CLOUD FRACTION"           ""
+state  real  TOTCLOUDFRAC  ij  misc  1  -  -  "TOTCLOUDFRAC"     "COLUMN CLOUD FRACTION"           ""
+state  real  GRAIN  ikj  misc  1  -  -  "RAIN"     "RAIN kg/kg.s-1"           ""
+state  real  GSNOW  ikj  misc  1  -  -  "SNOW"     "SNOW kg/kg.s-1"           ""
+state  real  ALBEQ  ij misc  1  -  -  "ALBEQ"    "ALBEDO EQUIVALENT"   ""
+state  real  FLUXTOP_DN ij misc  1  -  - "FLUXTOP_DN"   "Incoming SW radiation at the TOA" "W.m-2"
+state  real  FLUXABS_SW ij misc  1  -  - "FLUXABS_SW"  "Absorbed SW flux" "W.m-2"
+state  real  FLUXTOP_LW ij misc  1  -  - "FLUXTOP_LW"  "Outgoing LW flux TOA" "W.m-2"
+state  real  FLUXSURF_SW ij misc  1  -  - "FLUXSURF_SW" "SW Surface flux" "W.m-2"
+state  real  FLUXSURF_LW ij misc  1  -  -  "FLUXSURF_LW" "LW Surface flux" "W.m-2"
+state  real  FLXGRD ij misc  1  -  - "FLXGRD" "heat flux from ground"  "W.m-2"
+state  real  LSCEZ ikj misc  1  -  - "LSCEZ" "heat from largescale" "W.m-2"
+state  real  H2OICE_REFF ikj misc  1  -  -  "H2OICE_REFF" "Radii of H2O ice" "m"
+state  real  LATENT_HF ij misc  1  -  -  "LATENT_HF" "latent heat flux" "W.m-2"
+state  real  REEVAP    ij misc  1  -  -  "REEVAP" "re-evaporation flux of precipitation (integrated over the atmospheric column)"
+state  real  SURFRAIN  ij misc  1  -  -  "SURFRAIN" "Rainfall" "kg m-2 s-1"
+
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: l'ordre dans SCALAR est defini plus bas dans les options mars)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                         -
+state  real  qh2o      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O"          "Water vapor mixing ratio"   "kg kg-1"
+state  real  qh2o_ice  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O_ICE"      "Water ice mixing ratio"     "kg kg-1"
+state  real  qdust     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QDUST"         "Dust mixing ratio"          "kg kg-1"
+state  real  qdustn    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QDUSTN"        "Dust_number mixing ratio"   "kg kg-1"
+state  real  qccn      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCN"         "CCN mixing ratio"          "kg kg-1"
+state  real  qccnn     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCNN"        "CCN number mixing ratio"   "kg kg-1"
+state  real  qco2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCO2"          "CO2 mixing ratio"           "kg kg-1"
+state  real  chem_co   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_co"     ""   ""
+state  real  chem_o    ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_o"      ""   ""
+state  real  chem_o1d  ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_o1d"    ""   ""
+state  real  chem_o2   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_o2"     ""   ""
+state  real  chem_o3   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_o3"     ""   ""
+state  real  chem_h    ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_h"      ""   ""
+state  real  chem_h2   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_h2"     ""   ""
+state  real  chem_oh   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_oh"     ""   ""
+state  real  chem_ho2  ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_ho2"    ""   ""
+state  real  chem_h2o2 ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_h2o2"   ""   ""
+state  real  chem_ch4  ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_ch4"    ""   ""
+state  real  chem_n2   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_n2"     ""   ""
+state  real  chem_ar   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_ar"     ""   ""
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+###VENUS TRACER
+state  real  qco       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCO"        "CO number mixing ratio"   "kg kg-1"
+state  real  qh2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2"        "H2 number mixing ratio"   "kg kg-1"
+state  real  qo1d      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO1D"        "O1d number mixing ratio"   "kg kg-1"
+state  real  qo        ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO"        "O number mixing ratio"   "kg kg-1"
+state  real  qo2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO2"        "O2 number mixing ratio"   "kg kg-1"
+state  real  qo2dg     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO2dg"        "O2dg number mixing ratio"   "kg kg-1"
+state  real  qo3       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO3"        "O3 number mixing ratio"   "kg kg-1"
+state  real  qh        ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH"        "H number mixing ratio"   "kg kg-1"
+state  real  qoh       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOH"        "OH number mixing ratio"   "kg kg-1"
+state  real  qho2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHO2"        "HO2 number mixing ratio"   "kg kg-1"
+state  real  qh2o2     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O2"        "H2O2 number mixing ratio"   "kg kg-1"
+state  real  qcl       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCL"        "Cl number mixing ratio"   "kg kg-1"
+state  real  qclo      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLO"        "ClO number mixing ratio"   "kg kg-1"
+state  real  qcl2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCL2"        "Cl2 number mixing ratio"   "kg kg-1"
+state  real  qhcl      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHCL"        "HCl number mixing ratio"   "kg kg-1"
+state  real  qhocl     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHOCL"        "HOCl number mixing ratio"   "kg kg-1"
+state  real  qclco     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLCO"        "ClCO number mixing ratio"   "kg kg-1"
+state  real  qclco3    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLCO3"        "ClCO3 number mixing ratio"   "kg kg-1"
+state  real  qcocl2    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCOCL2"        "COCl2 number mixing ratio"   "kg kg-1"
+state  real  qss       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS"        "S number mixing ratio"   "kg kg-1"
+state  real  qso       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO"        "SO number mixing ratio"   "kg kg-1"
+state  real  qso2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO2"        "SO2 number mixing ratio"   "kg kg-1"
+state  real  qso3      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO3"        "SO3 number mixing ratio"   "kg kg-1"
+state  real  qs2o2     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS2O2"        "S2O2 number mixing ratio"   "kg kg-1"
+state  real  qocs      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOCS"        "OCS number mixing ratio"   "kg kg-1"
+state  real  qhso3     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHSO3"        "HSO3 number mixing ratio"   "kg kg-1"
+state  real  qh2so4    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2SO4"        "H2SO4 number mixing ratio"   "kg kg-1"
+state  real  qs2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS2"        "S2 number mixing ratio"   "kg kg-1"
+state  real  qclso2    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLSO2"        "ClSO2 number mixing ratio"   "kg kg-1"
+state  real  qoscl     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOSCL"        "OSCl number mixing ratio"   "kg kg-1"
+state  real  qh2oliq   ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2OLIQ"        "H2O liq number mixing ratio"   "kg kg-1"
+state  real  qh2so4liq ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2SO4LIQ"        "H2SO4 liq number mixing ratio"   "kg kg-1"
+
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+#### -- si on change le nom on doit le changer jusque readmeteo !
+####
+############# in module_initialize ################# in geo_em.d**.nc ############################################
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   z0_gc           ij   dyn_em  1  -  i1  "SURF_ROUGHNESS"   "surface roughness"       "cm"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+state  real   isoil_gc       igj   dyn_em  1  Z  i1  "ISOIL"            "soil thermal inertia"    "tiu"
+state  real   dsoil_gc       igj   dyn_em  1  Z  i1  "DSOIL"            "soil depths"             "m"
+state  real   co2_gc         igj   dyn_em  1  Z  i1  "CO2"              "co2 mixing ratio"        "kg/kg"
+state  real   dustq_gc       igj   dyn_em  1  Z  i1  "DUSTQ"            "dust mixing ratio"       "kg/kg"
+state  real   dustn_gc       igj   dyn_em  1  Z  i1  "DUSTN"            "dust number density"     "part/kg"
+state  real   ccnq_gc        igj   dyn_em  1  Z  i1  "CCNQ"             "ccn mixing ratio"        "kg/kg"
+state  real   ccnn_gc        igj   dyn_em  1  Z  i1  "CCNN"             "ccn number density"      "part/kg"
+####
+#### variables dans wrf
+####
+#### 'm_' prefix is to avoid redundancies with possible existing terrestrial variables
+####
+####          vvvv nom pour module_initialize, solve_em, lmd_driver (interne fortran)
+####                                                vvvv nom fichier netCDF (important initialisation
+################################################################################################################
+state  real   m_albedo     ij   misc  1  -  i012rd  "MARS_ALB"     "albedo of naked ground"   "0 - 1 fraction"
+state  real   m_ti         ij   misc  1  -  i012rd  "MARS_TI"      "thermal inertia"          "J/m2/K/s0.5"
+state  real   m_z0         ij   misc  1  -  i012rd  "MARS_Z0"      "surface roughness"        "m"
+state  real   slpx         ij   misc  1  -  i012rd  "SLOPEX"       "slope x direction"        "rad"
+state  real   slpy         ij   misc  1  -  i012rd  "SLOPEY"       "slope y direction"        "rad"
+state  real   m_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"   "emissivity"               "0 - 1 fraction"
+state  real   m_co2ice     ij   misc  1  -  i012rd  "MARS_CICE"    "co2 ground ice"           "kg/m2"
+state  real   m_h2oice     ij   misc  1  -  i012rd  "MARS_WICE"    "h2o ground ice"           "kg/m2"
+state  real   m_fluxrad    ij   misc  1  -  i012rd  "MARS_FLUXRAD" "net rad flux at surf"     "W.m-2"
+state  real   m_wstar      ij   misc  1  -  i012rd  "MARS_WSTAR"   "free convection velocity" "m.s-1"
+state  real   m_tsurf      ij   misc  1  -  i012rd  "MARS_TSURF"   "surface temperature"      "K"
+state  real   m_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"   "soil temperatures"        "K"
+state  real   m_q2        ikj   misc  1  Z  i012rd  "MARS_Q2"      "parameterized TKE"        "kg.m-3"
+state  real   m_isoil     ilj   misc  1  -  i012rd  "MARS_ISOIL"   "soil thermal inertia"     "tiu"
+state  real   m_dsoil     ilj   misc  1  -  i012rd  "MARS_DSOIL"   "soil depths"              "m"
+state  real   m_gw        ilj   misc  1  -  i012rd  "MARS_GW"      "gwparam"                  " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWN           ij      misc        1         -      rd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"
+state    real  SWDOWNC          ij      misc        1         -      -       "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  w_phy           ikj      misc        1         -
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+##### LES mettre h pour les deux variables ci-dessous
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+state    real  USTM             ij      misc        1         -      rh       "USTM"                  "U* IN SIMILARITY THEORY - LES MODE"           "m s-1"     #SAVEMARS2 ustar 
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -      r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"     #SAVEMARS2 sensheat
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .true.  irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              8       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains      max_domains   5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  character planet   namelist,physics  1            "mars"   -    "planet"    "selection of the planet" ""
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_Z0   namelist,physics  max_domains  0        irh  "init_Z0"   "surface roughness"       ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.   ir   "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    1       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh   "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh   "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh   "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh   "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.2     h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    2      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh   "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    6       h    "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+#rconfig   logical     pd_scalar           namelist,dynamics     max_domains    .false. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    tiso                    namelist,dynamics     1             140.     h    "tiso"    "Mars isothermal value for high alt, real only"  "K"
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGES TRACER REFERENCES WITHOUT ANY NEED TO RECOMPILE ENTIRELY LMD_MM 
+## --> EVEN IF FIELDS ARE SCHEDULED FOR OUTPUTS ABOVE [WITH h], THESE ARE NOT IN wrfout* FILES
+##       UNLESS THE CORRESPONDING mars OPTION IS SELECTED 
+## --> HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+##       AND PROBABLY YOU'LL ALSO HAVE TO CHANGE callphys.def
+## --> IF mars IS CHANGED IN THE NAMELIST, YOU HAVE TO RE-RUN real.exe
+##
+## IF YOU ADD A mars REFERENCE BELOW, YOU HAVE TO RECOMPILE ENTIRELY THE MODEL
+##
+## THE ORDER of TRACERS IN EACH OPTION IS VERY IMPORTANT
+##
+package   default      mars==0                      -              -
+package   water        mars==1                      -              scalar:qh2o,qh2o_ice
+package   dust1        mars==2                      -              scalar:qdust
+package   dust2eq      mars==3                      -              scalar:qdust,qdustn
+package   newbasis     mars==10                     -              scalar:qco2
+package   newwater     mars==11                     -              scalar:qh2o,qh2o_ice,qdust,qdustn
+package   newwatersca  mars==12                     -              scalar:qh2o,qh2o_ice,qdust,qdustn,qccn,qccnn
+package   VenusPC      mars==34                     -              scalar:qco2,qco,qh2,qh2o,qo1d,qo,qo2,qo2dg,qo3,qh,qoh,qho2,qh2o2,qcl,qclo,qcl2,qhcl,qhocl,qclco,qclco3,qcocl2,qss,qso,qso2,qso3,qs2o2,qocs,qhso3,qh2so4,qs2,qclso2,qoscl,qh2oliq,qh2so4liq
+package   photochem    mars==42                     -              scalar:qco2,chem_co,chem_o,chem_o1d,chem_o2,chem_o3,chem_h,chem_h2,chem_oh,chem_ho2,chem_h2o2,chem_ch4,chem_n2,chem_ar,qh2o_ice,qh2o,qdust,qdustn
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson      mp_physics==8                -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/Registry.EM.newphys
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/Registry.EM.newphys	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/Registry.EM.newphys	(revision 2744)
@@ -0,0 +1,1615 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+####
+####
+#### RADIATIVE TRANSFER
+state  real  HR_SW     ikj   misc  1  -  h  "HR_SW"     "HEATING RATE SW"                 "K/s"
+state  real  HR_LW     ikj   misc  1  -  h  "HR_LW"     "HEATING RATE LW"                 "K/s"
+state  real  HR_DYN    ikj   misc  1  -  -  "HR_DYN"    "HEATING RATE DYN"                "K/s"
+state  real  DDT       ikj   misc  1  -  -  "DDT"       "TEMPERATURE TENDENCY"            "K/s"
+state  real  DT_RAD    ikj   misc  1  -  -  "DT_RAD"    "RADIATIVE TEMPERATURE TENDENCY"  "K/s"
+state  real  DT_VDF    ikj   misc  1  -  -  "DT_VDF"    "PBL CLMAIN TEMPERATURE TENDENCY" "K/s"
+state  real  DT_AJS    ikj   misc  1  -  -  "DT_AJS"    "AJUSTSEC TEMPERATURE TENDENCY"   "K/s"
+state  real  SWDOWNZ    ij   misc  1  -  h  "SWDOWNZ"   "DOWNWARD SW FLUX AT SURFACE"     "W m-2"
+#### DUST CYCLE
+state  real  TAU_DUST   ij   misc  1  -  h  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""
+state  real  RDUST     ikj   misc  1  -  h  "RDUST"     "DUST RADIUS"                     "m"
+state  real  QSURFDUST  ij   misc  1  -  h  "QSURFDUST" "DUST MASS AT SURFACE"            "kg m-2"
+#### CLOUDS
+state  real  MTOT       ij   misc  1  -  h  "MTOT"      "TOTAL MASS WATER VAPOR in pmic"  "pmic"
+state  real  ICETOT     ij   misc  1  -  h  "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"
+state  real  VMR_ICE   ikj   misc  1  -  h  "VMR_ICE"   "VOL. MIXING RATIO ICE"           "ppm"
+state  real  TAU_ICE    ij   misc  1  -  h  "TAU_ICE"   "CLOUD OD at 825 cm-1 TES"        ""
+state  real  RICE      ikj   misc  1  -  h  "RICE"      "ICE RADIUS"                      "m"
+#### THERMALS
+state  real  ZMAX       ij   misc  1  -  h  "ZMAX"      "MAXIMUM LEVEL THERMALS"          "m"    
+state  real  HFMAX      ij   misc  1  -  h  "HFMAX"     "MAXIMUM PBL HEAT FLUX"           "m.K/s"
+#### GENERIC OUTPUTS
+state  real  CLOUDFRAC  ikj  misc  1  -  -  "CLOUDFRAC"     "CLOUD FRACTION"           ""
+state  real  TOTCLOUDFRAC  ij  misc  1  -  -  "TOTCLOUDFRAC"     "COLUMN CLOUD FRACTION"           ""
+state  real  GRAIN  ikj  misc  1  -  -  "RAIN"     "RAIN kg/kg.s-1"           ""
+state  real  GSNOW  ikj  misc  1  -  -  "SNOW"     "SNOW kg/kg.s-1"           ""
+state  real  ALBEQ  ij misc  1  -  -  "ALBEQ"    "ALBEDO EQUIVALENT"   ""
+state  real  FLUXTOP_DN ij misc  1  -  - "FLUXTOP_DN"   "Incoming SW radiation at the TOA" "W.m-2"
+state  real  FLUXABS_SW ij misc  1  -  - "FLUXABS_SW"  "Absorbed SW flux" "W.m-2"
+state  real  FLUXTOP_LW ij misc  1  -  - "FLUXTOP_LW"  "Outgoing LW flux TOA" "W.m-2"
+state  real  FLUXSURF_SW ij misc  1  -  - "FLUXSURF_SW" "SW Surface flux" "W.m-2"
+state  real  FLUXSURF_LW ij misc  1  -  -  "FLUXSURF_LW" "LW Surface flux" "W.m-2"
+state  real  FLXGRD ij misc  1  -  - "FLXGRD" "heat flux from ground"  "W.m-2"
+state  real  LSCEZ ikj misc  1  -  - "LSCEZ" "heat from largescale" "W.m-2"
+state  real  H2OICE_REFF ikj misc  1  -  -  "H2OICE_REFF" "Radii of H2O ice" "m"
+state  real  LATENT_HF ij misc  1  -  -  "LATENT_HF" "Latent heat flux" "W.m-2"
+state  real  REEVAP    ij misc  1  -  -  "REEVAP" "Re-evaporation flux of precipitation (integrated over the atmospheric column)"
+state  real  SURFRAIN  ij misc  1  -  -  "SURFRAIN" "Rainfall" "kg m-2 s-1"
+
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: l'ordre dans SCALAR est defini plus bas dans les options mars)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -          ikjftb  scalar  1  -  -                         -
+state  real  qh2o       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O"          "Water vapor mixing ratio"    "kg kg-1"
+state  real  qh2o_ice   ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O_ICE"      "Water ice mixing ratio"      "kg kg-1"
+state  real  qdust      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QDUST"         "Dust mixing ratio"           "kg kg-1"
+state  real  qdustn     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QDUSTN"        "Dust_number mixing ratio"    "kg kg-1"
+state  real  qccn       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCN"          "CCN mixing ratio"            "kg kg-1"
+state  real  qccnn      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCNN"         "CCN number mixing ratio"     "kg kg-1"
+state  real  qco2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCO2"          "CO2 mixing ratio"            "kg kg-1"
+state  real  qco2_ice   ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCO2_ICE"      "CO2 ice mixing ratio"        "kg kg-1"
+state  real  qccn_co2   ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCN_CO2"      "CO2 CCN mixing ratio"        "kg kg-1"
+state  real  qccnn_co2  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCNN_CO2"     "CO2 CCN number mixing ratio" "kg kg-1"
+state  real  chem_co   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_co"     ""   ""
+state  real  chem_o    ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_o"      ""   ""
+state  real  chem_o1d  ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_o1d"    ""   ""
+state  real  chem_o2   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_o2"     ""   ""
+state  real  chem_o3   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_o3"     ""   ""
+state  real  chem_h    ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_h"      ""   ""
+state  real  chem_h2   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_h2"     ""   ""
+state  real  chem_oh   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_oh"     ""   ""
+state  real  chem_ho2  ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_ho2"    ""   ""
+state  real  chem_h2o2 ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_h2o2"   ""   ""
+state  real  chem_ch4  ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_ch4"    ""   ""
+state  real  chem_n2   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_n2"     ""   ""
+state  real  chem_ar   ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "chem_ar"     ""   ""
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+###VENUS TRACER
+state  real  qco       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCO"        "CO number mixing ratio"   "kg kg-1"
+state  real  qh2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2"        "H2 number mixing ratio"   "kg kg-1"
+state  real  qo1d      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO1D"        "O1d number mixing ratio"   "kg kg-1"
+state  real  qo        ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO"        "O number mixing ratio"   "kg kg-1"
+state  real  qo2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO2"        "O2 number mixing ratio"   "kg kg-1"
+state  real  qo2dg     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO2dg"        "O2dg number mixing ratio"   "kg kg-1"
+state  real  qo3       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO3"        "O3 number mixing ratio"   "kg kg-1"
+state  real  qh        ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH"        "H number mixing ratio"   "kg kg-1"
+state  real  qoh       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOH"        "OH number mixing ratio"   "kg kg-1"
+state  real  qho2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHO2"        "HO2 number mixing ratio"   "kg kg-1"
+state  real  qh2o2     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O2"        "H2O2 number mixing ratio"   "kg kg-1"
+state  real  qcl       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCL"        "Cl number mixing ratio"   "kg kg-1"
+state  real  qclo      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLO"        "ClO number mixing ratio"   "kg kg-1"
+state  real  qcl2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCL2"        "Cl2 number mixing ratio"   "kg kg-1"
+state  real  qhcl      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHCL"        "HCl number mixing ratio"   "kg kg-1"
+state  real  qhocl     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHOCL"        "HOCl number mixing ratio"   "kg kg-1"
+state  real  qclco     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLCO"        "ClCO number mixing ratio"   "kg kg-1"
+state  real  qclco3    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLCO3"        "ClCO3 number mixing ratio"   "kg kg-1"
+state  real  qcocl2    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCOCL2"        "COCl2 number mixing ratio"   "kg kg-1"
+state  real  qss       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS"        "S number mixing ratio"   "kg kg-1"
+state  real  qso       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO"        "SO number mixing ratio"   "kg kg-1"
+state  real  qso2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO2"        "SO2 number mixing ratio"   "kg kg-1"
+state  real  qso3      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO3"        "SO3 number mixing ratio"   "kg kg-1"
+state  real  qs2o2     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS2O2"        "S2O2 number mixing ratio"   "kg kg-1"
+state  real  qocs      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOCS"        "OCS number mixing ratio"   "kg kg-1"
+state  real  qhso3     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHSO3"        "HSO3 number mixing ratio"   "kg kg-1"
+state  real  qh2so4    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2SO4"        "H2SO4 number mixing ratio"   "kg kg-1"
+state  real  qs2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS2"        "S2 number mixing ratio"   "kg kg-1"
+state  real  qclso2    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLSO2"        "ClSO2 number mixing ratio"   "kg kg-1"
+state  real  qoscl     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOSCL"        "OSCl number mixing ratio"   "kg kg-1"
+state  real  qh2oliq   ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2OLIQ"        "H2O liq number mixing ratio"   "kg kg-1"
+state  real  qh2so4liq ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2SO4LIQ"        "H2SO4 liq number mixing ratio"   "kg kg-1"
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+#### -- si on change le nom on doit le changer jusque readmeteo !
+####
+############# in module_initialize ################# in geo_em.d**.nc ############################################
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   z0_gc           ij   dyn_em  1  -  i1  "SURF_ROUGHNESS"   "surface roughness"       "cm"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+state  real   isoil_gc       igj   dyn_em  1  Z  i1  "ISOIL"            "soil thermal inertia"    "tiu"
+state  real   dsoil_gc       igj   dyn_em  1  Z  i1  "DSOIL"            "soil depths"             "m"
+state  real   co2_gc         igj   dyn_em  1  Z  i1  "CO2"              "co2 mixing ratio"        "kg/kg"
+state  real   dustq_gc       igj   dyn_em  1  Z  i1  "DUSTQ"            "dust mixing ratio"       "kg/kg"
+state  real   dustn_gc       igj   dyn_em  1  Z  i1  "DUSTN"            "dust number density"     "part/kg"
+state  real   ccnq_gc        igj   dyn_em  1  Z  i1  "CCNQ"             "ccn mixing ratio"        "kg/kg"
+state  real   ccnn_gc        igj   dyn_em  1  Z  i1  "CCNN"             "ccn number density"      "part/kg"
+####
+#### variables dans wrf
+####
+#### 'm_' prefix is to avoid redundancies with possible existing terrestrial variables
+####
+####          vvvv nom pour module_initialize, solve_em, lmd_driver (interne fortran)
+####                                                vvvv nom fichier netCDF (important initialisation
+################################################################################################################
+state  real   m_albedo     ij   misc  1  -  i012rd  "MARS_ALB"     "albedo of naked ground"   "0 - 1 fraction"
+state  real   m_ti         ij   misc  1  -  i012rd  "MARS_TI"      "thermal inertia"          "J/m2/K/s0.5"
+state  real   m_z0         ij   misc  1  -  i012rd  "MARS_Z0"      "surface roughness"        "m"
+state  real   slpx         ij   misc  1  -  i012rd  "SLOPEX"       "slope x direction"        "rad"
+state  real   slpy         ij   misc  1  -  i012rd  "SLOPEY"       "slope y direction"        "rad"
+state  real   m_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"   "emissivity"               "0 - 1 fraction"
+state  real   m_co2ice     ij   misc  1  -  i012rhd "MARS_CICE"    "CO2 GROUND ICE"           "kg/m2"
+state  real   m_h2oice     ij   misc  1  -  i012rhd "MARS_WICE"    "H2O GROUND ICE"           "kg/m2"
+state  real   m_fluxrad    ij   misc  1  -  i012rhd "MARS_FLUXRAD" "net rad flux at surf"     "W.m-2"
+state  real   m_wstar      ij   misc  1  -  i012rhd "MARS_WSTAR"   "FREE CONVECTION VELOCITY" "m.s-1"
+state  real   m_tsurf      ij   misc  1  -  i012rhd "MARS_TSURF"   "SURFACE TEMPERATURE"      "K"
+state  real   m_tsoil     ilj   misc  1  -  i012rhd "MARS_TSOIL"   "SOIL TEMPERATURES"        "K"
+state  real   m_q2        ikj   misc  1  Z  i012rhd "MARS_Q2"      "parameterized TKE"        "kg.m-3"
+state  real   m_isoil     ilj   misc  1  -  i012rd  "MARS_ISOIL"   "soil thermal inertia"     "tiu"
+state  real   m_dsoil     ilj   misc  1  -  i012rd  "MARS_DSOIL"   "soil depths"              "m"
+state  real   m_gw        ilj   misc  1  -  i012rd  "MARS_GW"      "gwparam"                  " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWN           ij      misc        1         -      rd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"
+state    real  SWDOWNC          ij      misc        1         -      -       "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  w_phy           ikj      misc        1         -
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+##### LES mettre h pour les deux variables ci-dessous
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+state    real  USTM             ij      misc        1         -      rh       "USTM"                  "U* IN SIMILARITY THEORY - LES MODE"           "m s-1"     #SAVEMARS2 ustar 
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -      r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"     #SAVEMARS2 sensheat
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .true.  irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              8       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains      max_domains   5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  character planet   namelist,physics  1            "mars"   -    "planet"    "selection of the planet" ""
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_Z0   namelist,physics  max_domains  0        irh  "init_Z0"   "surface roughness"       ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.   ir   "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    1       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh   "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh   "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh   "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh   "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.2     h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    2      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh   "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    6       h    "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+#rconfig   logical     pd_scalar           namelist,dynamics     max_domains    .false. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    tiso                    namelist,dynamics     1             140.     h    "tiso"    "Mars isothermal value for high alt, real only"  "K"
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGES TRACER REFERENCES WITHOUT ANY NEED TO RECOMPILE ENTIRELY LMD_MM 
+## --> EVEN IF FIELDS ARE SCHEDULED FOR OUTPUTS ABOVE [WITH h], THESE ARE NOT IN wrfout* FILES
+##       UNLESS THE CORRESPONDING mars OPTION IS SELECTED 
+## --> HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+##       AND PROBABLY YOU'LL ALSO HAVE TO CHANGE callphys.def
+## --> IF mars IS CHANGED IN THE NAMELIST, YOU HAVE TO RE-RUN real.exe
+##
+## IF YOU ADD A mars REFERENCE BELOW, YOU HAVE TO RECOMPILE ENTIRELY THE MODEL
+##
+## THE ORDER of TRACERS IN EACH OPTION IS VERY IMPORTANT
+##
+package   default      mars==0                      -              -
+package   water        mars==1                      -              scalar:qh2o,qh2o_ice
+package   dust1        mars==2                      -              scalar:qdust
+package   dust2eq      mars==3                      -              scalar:qdust,qdustn
+package   newbasis     mars==10                     -              scalar:qco2
+package   newwater     mars==11                     -              scalar:qh2o,qh2o_ice,qdust,qdustn
+package   newwatersca  mars==12                     -              scalar:qh2o,qh2o_ice,qdust,qdustn,qccn,qccnn
+package   cloudco2     mars==32                     -              scalar:qh2o,qh2o_ice,qdust,qdustn,qccn,qccnn,qco2,qco2_ice,qccn_co2,qccnn_co2
+package   VenusPC      mars==34                     -              scalar:qco2,qco,qh2,qh2o,qo1d,qo,qo2,qo2dg,qo3,qh,qoh,qho2,qh2o2,qcl,qclo,qcl2,qhcl,qhocl,qclco,qclco3,qcocl2,qss,qso,qso2,qso3,qs2o2,qocs,qhso3,qh2so4,qs2,qclso2,qoscl,qh2oliq,qh2so4liq
+package   photochem    mars==42                     -              scalar:qco2,chem_co,chem_o,chem_o1d,chem_o2,chem_o3,chem_h,chem_h2,chem_oh,chem_ho2,chem_h2o2,chem_ch4,chem_n2,chem_ar,qh2o_ice,qh2o,qdust,qdustn
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson      mp_physics==8                -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/Registry.bash
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/Registry.bash	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/Registry.bash	(revision 2744)
@@ -0,0 +1,194 @@
+#! /bin/bash
+#
+# This is a script to generate FORTRAN code from registry
+#
+# A. Spiga - 17/03/08
+#
+
+
+#
+#
+#
+echo AUTOMATIC FILE GENERATION
+grep '#SAVEMARS2' Registry.EM | grep 'rh' > fromregistry2
+grep '#SAVEMARS3' Registry.EM | grep 'rh' > fromregistry3
+yeah2=$(awk 'END {print NR}' fromregistry2)
+yeah3=$(awk 'END {print NR}' fromregistry3)
+echo save ${yeah2} 2D arrays
+echo save ${yeah3} 3D arrays
+
+
+#
+#
+#
+\rm wrf_output_2d.h 2> /dev/null
+touch wrf_output_2d.h
+
+echo '!-------------------' >> test_include
+echo '! INCLUDE 'wrf_output_2d.h'' >> test_include
+echo '!-------------------' >> test_include
+if [ ${yeah2} -ne 0 ]
+then
+awk '{print "      INTEGER, PARAMETER :: ind_"$3" = " NR}' fromregistry2 >> test_include
+awk 'END {print "      INTEGER, PARAMETER :: n2d = " NR}' fromregistry2 >> test_include
+mv test_include wrf_output_2d.h
+else
+echo '           INTEGER, PARAMETER :: n2d = 1' >> test_include
+mv test_include wrf_output_2d.h
+fi
+
+\rm wrf_output_3d.h 2> /dev/null
+touch wrf_output_3d.h
+
+echo '!-------------------' >> test_include
+echo '! INCLUDE 'wrf_output_3d.h'' >> test_include
+echo '!-------------------' >> test_include
+if [ ${yeah3} -ne 0 ]
+then
+awk '{print "      INTEGER, PARAMETER :: ind_"$3" = " NR}' fromregistry3 >> test_include
+awk 'END {print "      INTEGER, PARAMETER :: n3d = " NR}' fromregistry3 >> test_include
+mv test_include wrf_output_3d.h
+else
+echo '           INTEGER, PARAMETER :: n3d = 1' >> test_include
+mv test_include wrf_output_3d.h
+fi
+
+
+#
+#
+#
+\rm fill_save_2d.F90 2> /dev/null
+#if [ ${yeah2} -ne 0 ]
+#then
+echo 'SUBROUTINE fill_save_2d( &' >> test_subroutine
+awk '{print $NF ",&"}' fromregistry2 >> test_subroutine
+echo 'ngrid,&' >> test_subroutine
+echo 'output_tab2d)' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'IMPLICIT NONE' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'include "wrf_output_2d.h"' >> test_subroutine
+#echo 'include "dimension.h"' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'INTEGER :: ngrid' >> test_subroutine
+awk '{print "REAL, DIMENSION(ngrid) :: " $NF}' fromregistry2 >> test_subroutine
+echo 'REAL, DIMENSION(ngrid,n2d) :: output_tab2d' >> test_subroutine
+echo '   ' >> test_subroutine
+awk '{print "output_tab2d(:,ind_"$3")="$NF"(:)"}' fromregistry2 >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'END SUBROUTINE fill_save_2d' >> test_subroutine
+mv test_subroutine fill_save_2d.F90
+#fi
+
+\rm fill_save_3d.F90 2> /dev/null
+#if [ ${yeah3} -ne 0 ]
+#then
+echo 'SUBROUTINE fill_save_3d( &' >> test_subroutine
+awk '{print $NF ",&"}' fromregistry3 >> test_subroutine
+echo 'ngrid,&' >> test_subroutine
+echo 'nlayer,&' >> test_subroutine
+echo 'output_tab3d)' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'IMPLICIT NONE' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'include "wrf_output_3d.h"' >> test_subroutine
+#echo 'include "dimension.h"' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'INTEGER :: ngrid' >> test_subroutine
+echo 'INTEGER :: nlayer' >> test_subroutine
+awk '{print "REAL, DIMENSION(ngrid,nlayer) :: " $NF}' fromregistry3 >> test_subroutine
+echo 'REAL, DIMENSION(ngrid,nlayer,n3d) :: output_tab3d' >> test_subroutine
+echo '   ' >> test_subroutine
+awk '{print "output_tab3d(:,:,ind_"$3")="$NF"(:,:)"}' fromregistry3 >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'END SUBROUTINE fill_save_3d' >> test_subroutine
+mv test_subroutine fill_save_3d.F90
+#fi
+
+
+#
+#
+#
+\rm fill_save.inc 2> /dev/null
+
+#if [ ${yeah2} -ne 0 ]
+#then
+echo '      CALL fill_save_2d(' >> fill_save.inc
+awk '{print "     . "$NF ","}' fromregistry2 >> fill_save.inc
+echo '     . ngrid,' >> fill_save.inc
+echo '     . output_tab2d)' >> fill_save.inc
+#fi
+
+#if [ ${yeah3} -ne 0 ]
+#then
+echo '      CALL fill_save_3d(' >> fill_save.inc
+awk '{print "     . "$NF ","}' fromregistry3 >> fill_save.inc
+echo '     . ngrid,' >> fill_save.inc
+echo '     . nlayer,' >> fill_save.inc
+echo '     . output_tab3d)' >> fill_save.inc
+#fi
+
+
+
+#
+#
+#
+\rm module_lmd_driver_output1.inc 2> /dev/null
+touch module_lmd_driver_output1.inc
+\rm module_lmd_driver_output2.inc 2> /dev/null
+touch module_lmd_driver_output2.inc
+\rm module_lmd_driver_output3.inc 2> /dev/null
+touch module_lmd_driver_output3.inc
+
+echo 'REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &' >> module_lmd_driver_output2.inc
+
+if [ ${yeah2} -ne 0 ]
+then
+awk '{print "       " $3 ",&"}' fromregistry2 >> module_lmd_driver_output1.inc
+#more module_lmd_driver_output1.inc >> module_lmd_driver_output2.inc
+cat module_lmd_driver_output1.inc >> module_lmd_driver_output2.inc
+awk '{print $3"(i,j) = output_tab2d(subs,ind_"$3")"}' fromregistry2 >> module_lmd_driver_output3.inc
+fi
+
+echo '   PSFC,TSK' >> module_lmd_driver_output2.inc
+echo 'REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(OUT)  :: &' >> module_lmd_driver_output2.inc
+
+if [ ${yeah3} -ne 0 ]
+then
+awk '{print "        " $3 ",&"}' fromregistry3 >> module_lmd_driver_output1.inc
+awk '{print "        " $3 ",&"}' fromregistry3 >> module_lmd_driver_output2.inc
+echo 'DO k = kps,kpe' >> module_lmd_driver_output3.inc
+awk '{print $3"(i,k,j) = output_tab3d(subs,k,ind_"$3")"}' fromregistry3 >> module_lmd_driver_output3.inc
+echo 'ENDDO' >> module_lmd_driver_output3.inc
+fi
+
+echo '   RTHBLTEN,RUBLTEN,RVBLTEN' >> module_lmd_driver_output2.inc
+
+
+
+#
+#
+#
+\rm module_lmd_driver_output4.inc 2> /dev/null
+touch module_lmd_driver_output4.inc
+awk '{print "  &    ,"$3"=grid%"$3"   &"}' fromregistry2 >> module_lmd_driver_output4.inc
+awk '{print "  &    ,"$3"=grid%"$3"   &"}' fromregistry3 >> module_lmd_driver_output4.inc
+
+
+
+#
+#
+#
+\rm fromregistry2
+\rm fromregistry3
+mv module_lmd_driver_output?.inc ../inc/
+\rm ../mars_lmd/libf/phymars/fill_save_?d.F90 2> /dev/null
+\rm ../mars_lmd/libf/phymars/wrf_output_?d.h 2> /dev/null
+mv fill_save.inc fill_save_?d.F90 wrf_output_?d.h ../mars_lmd/libf/phymars/
+
+#
+#
+#
+echo END of AUTOMATIC FILE GENERATION
+echo I guess you modified 'Registry.EM' ... 
+echo ... so remove the file 'Registry' and recompile the model
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.CONVERT
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.CONVERT	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.CONVERT	(revision 2744)
@@ -0,0 +1,555 @@
+# Registry file, EM_CONVERT
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+
+
+################################################################################
+################################################################################
+################################################################################
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        X     i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        Y     i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        -     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        -     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        -     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        -     i1  "P"     "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        -     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        -     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        -     -   "PD"    "dry pressure"        "Pa"
+state    real   qv_gc           igj      dyn_em      1        -    i1   "QV"     "mixing ratio"        "kg kg-1"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+#state    real   qr_gc          igj      dyn_em      1        -     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        -     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        -     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        -     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        -     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikj     dyn_em     1         X     ih       "U"      "x-wind component"   "m s-1"
+#                                               
+# V Vel
+state    real   v              ikj     dyn_em     1         Y     ih       "V"      "y-wind component"   "m s-1"
+#                                               
+# Vertical Vel                                          
+state    real   w              ikj     dyn_em     1         Z     ih       "W"      "z-wind component"   "m s-1"
+# Geopotential
+state    real   ph             ikj     dyn_em     1         Z     ih       "PH"     "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em     1         Z     ih       "PHB"    "base-state geopotential"  "m2 s-2"
+# Potential Temperature
+state    real   t              ikj     dyn_em     1         -     ih       "T"      "perturbation potential temperature (theta-t0)" "K"
+# Mass
+state    real   mu              ij     dyn_em     1         -     ih       "MU"     "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -    ih       "MUB"    "base state dry air mass in column" "Pa"
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      ih     "p"      "perturbation pressure"         "Pa"
+state    real   pb             ikj     dyn_em      1         -      ih     "pb"     "BASE STATE PRESSURE "          "Pa"
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ih     "Q2"     "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ih     "T2"     "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ih     "TH2"    "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     ih     "PSFC"   "SFC PRESSURE"      "Pa"
+state    real   U10              ij     misc        1         -     ih     "U10"    "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ih     "V10"    "V at 10 M"         "m s-1"
+
+# Scalar (4D) arrays
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     ih  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     ih  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     ih  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     ih  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     ih  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     ih  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+state   real    -              ikjftb   chem        1         -     -   -
+
+state   real    -              ikjftb  scalar      1          -     -   -
+state   real    qni            ikjftb  scalar      1          -     ih  "QNICE"         "Ice Number concentration" "# kg(-1)"
+
+
+state   real    ht             ij      misc         1         -     ih  "HGT"              "Terrain Height"                "m"
+state   real    TSK            ij      misc         1         -     ih  "TSK"              "SURFACE SKIN TEMPERATURE"      "K"
+
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     ih  "p_top"            "PRESSURE TOP OF THE MODEL"  "Pa"
+                                                
+state    real  RAINC            ij      misc        1         -     ih  "RAINC"            "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -     ih  "RAINNC"           "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  SNOWC            ij      misc        1         -     ih  "SNOWC"            "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1993    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      03    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      13    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      12    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1993    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      03    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      14    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      12    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains      1              27      irh    "num_metgrid_levels"                ""      ""
+rconfig   integer interp_type             namelist,domains	1              1       irh    "interp_type"                ""      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              0       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              500     irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       rh     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       rh     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1000.
+
+# Physics
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1             5       irh    "num_soil_layers"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "GFDL radiation co2 flag"  ""   ""
+
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.      h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    .1      h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    0       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient      namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      ""
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      ""
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# a few entries that need to be in the registry for stuff in share to compile, but that you probably do not want converted
+
+
+# State for derived time quantities.  
+state   real    xtime          -        -          -         -     -        "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -        "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+# input file descriptor for lbcs on parent domain
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""
+# indicates if tiling has been computed
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""
+# indicates if patches have been computed
+state   logical patched        -        -          -         -     -         "patched"               ""         ""
+# indicates whether to read input from file or generate
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY
+
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     -   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     -   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     -   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+state   real    lat_ll_t       -       dyn_em       -         -     -       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     -       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     -       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     -       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     -       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     -       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     -       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     -       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     -       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     -       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     -       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     -       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     -       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     -       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     -       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     -       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     -       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     -       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     -       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     -       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     -       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     -       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     -       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     -       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     -       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     -       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     -       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     -       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     -       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     -       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     -       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     -       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+
+
+
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+
+#package   passivec1     chem_opt==0                  -             
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   gfdllwscheme  ra_lw_physics==99            -             moist:qv,qc,qr,qi
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_CHEM
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_CHEM	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_CHEM	(revision 2744)
@@ -0,0 +1,1853 @@
+# Registry file, EM_CHEM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    o      3     namelist=ne_area             z          emissions dimension
+dimspec    n      2     namelist=kemit               z          emissions_zdim
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+
+################################################################################
+################################################################################
+################################################################################
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     irh01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irhusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irhdus "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irhusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irhdus       "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      rh        "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      rh        "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rhdus     "pb"          "BASE STATE PRESSURE "          "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+state    real   sr             ij      dyn_em      1         -      irh         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -        h         "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -        h         "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -        h         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     irhd      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     irhd      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     irhd      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     irh01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     irh01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+state   integer emissframes    -        -          -         -     -         "emissframes"           ""         ""
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Chemistry Variables  (all shared at this point)
+# emissions first
+state    real  e_iso          inj     misc        1         Z      i5h      "E_ISO"               "Isoprene EMISSIONS (Anth. for RADM/RACM, Anth+Bio for CBMZ)"         "mol km^-2 hr^-1"
+state    real  e_so2          inj     misc        1         Z      i5h      "E_SO2"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_no           inj     misc        1         Z      i5      "E_NO"                "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_co           inj     misc        1         Z      i5h      "E_CO"                "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_eth          inj     misc        1         Z      i5      "E_ETH"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_hc3          inj     misc        1         Z      i5      "E_HC3"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_hc5          inj     misc        1         Z      i5      "E_HC5"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_hc8          inj     misc        1         Z      i5      "E_HC8"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_xyl          inj     misc        1         Z      i5      "E_XYL"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_ol2          inj     misc        1         Z      i5      "E_OL2"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_olt          inj     misc        1         Z      i5      "E_OLT"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_oli          inj     misc        1         Z      i5      "E_OLI"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_tol          inj     misc        1         Z      i5      "E_TOL"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_csl          inj     misc        1         Z      i5      "E_CSL"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_hcho         inj     misc        1         Z      i5      "E_HCHO"              "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_ald          inj     misc        1         Z      i5      "E_ALD"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_ket          inj     misc        1         Z      i5      "E_KET"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_ora2         inj     misc        1         Z      i5      "E_ORA2"              "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_nh3          inj     misc        1         Z      i5      "E_NH3"               "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_pm25         inj     misc        1         Z      i5      "E_PM25"              "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_pm10         inj     misc        1         Z      i5      "E_PM10"              "EMISSIONS"          "mol km^-2 hr^-1"
+state    real  e_pm25i        inj     misc        1         Z      i5      "E_PM25I"             "EMISSION RATE OF UNIDEN. PM2.5 MASS"  "ug/m3 m/s"
+state    real  e_pm25j        inj     misc        1         Z      i5      "E_PM25J"             "EMISSION RATE OF J-MODE UNIDEN. PM2.5 MASS"   "ug/m3 m/s"
+state    real  e_eci          inj     misc        1         Z      i5      "E_ECI"               "EMISSION RATE OF I-MODE EC"          "ug/m3 m/s"
+state    real  e_ecj          inj     misc        1         Z      i5      "E_ECJ"               "EMISSION RATE OF J-MODE EC"          "ug/m3 m/s"
+state    real  e_orgi         inj     misc        1         Z      i5      "E_ORGI"              "EMISSION RATE OF I-MODE ORG. AER."   "ug/m3 m/s"
+state    real  e_orgj         inj     misc        1         Z      i5      "E_ORGJ"              "EMISSION RATE OF J-MODE ORG. AER."   "ug/m3 m/s"
+state    real  e_so4i         inj     misc        1         Z      i5      "E_SO4I"              "EMISSION RATE OF I-MODE ORG. AER."   "ug/m3 m/s"
+state    real  e_so4j         inj     misc        1         Z      i5      "E_SO4J"              "EMISSION RATE OF J-MODE ORG. AER."   "ug/m3 m/s"
+state    real  e_no3i         inj     misc        1         Z      i5     "E_NO3I"              "EMISSION RATE OF I-MODE ORG. AER."   "ug/m3 m/s"
+state    real  e_no3j         inj     misc        1         Z      i5      "E_NO3J"              "EMISSION RATE OF J-MODE ORG. AER."   "ug/m3 m/s"
+
+# Additional CBMZ and MOSAIC emission variables...
+state    real  e_no2          inj     misc        1         Z      i5     "E_NO2"                "EMISSIONS NO2"                 "mol km^-2 hr^-1"
+state    real  e_ch3oh        inj     misc        1         Z      i5     "E_CH3OH"              "EMISSIONS CH3OH"               "mol km^-2 hr^-1"
+state    real  e_c2h5oh       inj     misc        1         Z      i5     "E_C2H5OH"             "EMISSIONS C2H5OH"              "mol km^-2 hr^-1"
+state    real  e_so4c         inj     misc        1         Z      i5     "E_SO4C"               "EMISSIONS COARSE SO4 AER"      "ug/m3 m/s"
+state    real  e_no3c         inj     misc        1         Z      i5     "E_NO3C"               "EMISSIONS COARSE NO3 AER"      "ug/m3 m/s"
+state    real  e_orgc         inj     misc        1         Z      i5     "E_ORGC"               "EMISSIONS COARSE ORG AER"      "ug/m3 m/s"
+state    real  e_ecc          inj     misc        1         Z      i5     "E_ECC"                "EMISSIONS COARSE EC AER"       "ug/m3 m/s"
+
+state    real  e_bio          ijo     misc        1         -      -        "E_BIO"               "EMISSIONS"          "ppm m/min"
+state    real  sebio_iso      ij      misc        1         -      i04      "sebio_iso"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_oli      ij      misc        1         -      i04      "sebio_oli"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_api      ij      misc        1         -      i04      "sebio_api"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_lim      ij      misc        1         -      i04      "sebio_lim"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_xyl      ij      misc        1         -      i04      "sebio_xyl"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_hc3      ij      misc        1         -      i04      "sebio_hc3"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_ete      ij      misc        1         -      i04      "sebio_ete"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_olt      ij      misc        1         -      i04      "sebio_olt"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_ket      ij      misc        1         -      i04      "sebio_ket"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_ald      ij      misc        1         -      i04      "sebio_ald"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_hcho     ij      misc        1         -      i04      "sebio_hcho"        "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_eth      ij      misc        1         -      i04      "sebio_eth"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_ora2     ij      misc        1         -      i04      "sebio_ora2"        "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_co       ij      misc        1         -      i04      "sebio_co"          "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  sebio_nr       ij      misc        1         -      i04      "sebio_nr"          "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  noag_grow      ij      misc        1         -      i04      "noag_grow"         "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  noag_nongrow   ij      misc        1         -      i04      "noag_nongrow"      "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  nononag        ij      misc        1         -      i04      "nononag"           "Reference biog emiss"  "mol km^-2 hr^-1"
+state    real  slai           ij      misc        1         -      i04      "slai"              "Leaf area index isop"  ""
+state    real  ebio_iso       ij      misc        1         -      h        "EBIO_ISO"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_oli       ij      misc        1         -      -        "ebio_oli"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_api       ij      misc        1         -      -        "ebio_api"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_lim       ij      misc        1         -      -        "ebio_lim"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_xyl       ij      misc        1         -      -        "ebio_xyl"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_hc3       ij      misc        1         -      -        "ebio_hc3"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_ete       ij      misc        1         -      -        "ebio_ete"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_olt       ij      misc        1         -      -        "ebio_olt"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_ket       ij      misc        1         -      -        "ebio_ket"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_ald       ij      misc        1         -      -        "ebio_ald"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_hcho      ij      misc        1         -      -        "ebio_hcho"        "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_eth       ij      misc        1         -      -        "ebio_eth"         "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_ora2      ij      misc        1         -      -        "ebio_ora2"        "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_co        ij      misc        1         -      -        "ebio_co"          "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_nr        ij      misc        1         -      -        "ebio_nr"          "Actual biog emiss"  "mol km^-2 hr^-1"
+state    real  ebio_no        ij      misc        1         -      -        "ebio_no"          "Actual biog emiss"  "mol km^-2 hr^-1"
+#
+# following used for output to look at all kinds of stuff
+state    real  dep_vel_o3     ij      misc        1         -      -        "DEP_VEL"               "deposition velocities for o3"        "?"
+state    real  cu_co_ten      ikj     misc        1         -      h        "CU_CO_TEN"             "CONV. TRANSPORT FOR CO"              "?"
+# aerosol stuff
+state    real  aerwrf         ikj     misc        1         -      r        "AERWRF"                "STANDARD AEROSOL PROFILE"            "?"
+
+state    real  pm2_5_dry      ikj     misc        1         -      hr       "PM2_5_DRY"             "pm2.5 aerosol dry mass"              "ug m^-3"
+state    real  pm2_5_dry_ec   ikj     misc        1         -      r        "PM2_5_EC_DRY"          "dry ec aerosol mass"                 "ug m^-3"
+state    real  pm2_5_water    ikj     misc        1         -      r        "PM2_5_WATER"           "pm2.5 aerosol liquid water content"  "ug m^-3"
+state    real  pm10           ikj     misc        1         -      h        "pm10 "                 "pm10 dry mass"                       "ug m^-3"
+state    real  uvrad          ij      misc        1         -      h        "uv_rad "               "uvb net-radiation"                   "W m^-2"
+
+# photolysis rates
+state    real  ph_o31d         ikj     misc        1         -      rh       "PHOTR2"                "O31D Photolysis Rate" "min{-1}"
+state    real  ph_o33p         ikj     misc        1         -      r        "PHOTR3"                "O33P Photolysis Rate" "min{-1}"
+state    real  ph_no2          ikj     misc        1         -      rh       "PHOTR4"                "NO2 Photolysis Rate" "min{-1}"
+state    real  ph_no3o2        ikj     misc        1         -      r        "PHOTR5"                "NO3O2 Photolysis Rate" "min{-1}"
+state    real  ph_no3o         ikj     misc        1         -      r        "PHOTR6"                "NO3O Photolysis Rate" "min{-1}"
+state    real  ph_hno2         ikj     misc        1         -      r        "PHOTR7"                "HNO2 Photolysis Rate" "min{-1}"
+state    real  ph_hno3         ikj     misc        1         -      r        "PHOTR8"                "HNO3 Photolysis Rate" "min{-1}"
+state    real  ph_hno4         ikj     misc        1         -      r        "PHOTR9"                "HNO4 Photolysis Rate" "min{-1}"
+state    real  ph_h2o2         ikj     misc        1         -      r        "PHOTR10"               "H2O2 Photolysis Rate" "min{-1}"
+state    real  ph_ch2or        ikj     misc        1         -      r        "PHOTR11"               "CH2OR Photolysis Rate" "min{-1}"
+state    real  ph_ch2om        ikj     misc        1         -      r        "PHOTR12"               "CH2OM Photolysis Rate" "min{-1}"
+state    real  ph_ch3cho       ikj     misc        1         -      r        "PHOTR13"               "CH3CHO Photolysis Rate" "min{-1}"
+state    real  ph_ch3coch3     ikj     misc        1         -      r        "PHOTR14"               "CH3COCH3 Photolysis Rate" "min{-1}"
+state    real  ph_ch3coc2h5    ikj     misc        1         -      r        "PHOTR15"               "CH3COC2H5 Photolysis Rate" "min{-1}"
+state    real  ph_hcocho       ikj     misc        1         -      r        "PHOTR16"               "HCOCHO Photolysis Rate" "min{-1}"
+state    real  ph_ch3cocho     ikj     misc        1         -      r        "PHOTR17"               "CH3COCHO Photolysis Rate" "min{-1}"
+state    real  ph_hcochest     ikj     misc        1         -      r        "PHOTR18"               "HCOCHEST Photolysis Rate" "min{-1}"
+state    real  ph_ch3o2h       ikj     misc        1         -      r        "PHOTR19"               "CH3O2H Photolysis Rate" "min{-1}"
+state    real  ph_ch3coo2h     ikj     misc        1         -      r        "PHOTR20"               "CH3COO2H Photolysis Rate" "min{-1}"
+state    real  ph_ch3ono2      ikj     misc        1         -      r        "PHOTR21"               "CH3ONO2 Photolysis Rate" "min{-1}"
+state    real  ph_hcochob      ikj     misc        1         -      r        "PHOTR22"               "HCOCHOB Photolysis Rate" "min{-1}"
+state    real  ph_macr         ikj     misc        1         -      r        "PHOTR1"                "MACR Photolysis Rate" "min{-1}"
+state    real  ph_n2o5         ikj     misc        1         -      r        "PHOTR23"               "N2O5 Photolysis Rate" "min{-1}"
+state    real  ph_o2           ikj     misc        1         -      r        "PHOTR24"               "O2 Photolysis Rate" "min{-1}"
+# Aerosol optical properties from Mie code
+state    real  tauaer1         ikj     misc        1         -      r        "TAUAER1"               "bin 1 layer optical thickness" "?"
+state    real  tauaer2         ikj     misc        1         -      r        "TAUAER2"               "bin 2 layer optical thickness" "?"
+state    real  tauaer3         ikj     misc        1         -      r        "TAUAER3"               "bin 3 layer optical thickness" "?"
+state    real  tauaer4         ikj     misc        1         -      r        "TAUAER4"               "bin 4 layer optical thickness" "?"
+state    real  gaer1           ikj     misc        1         -      r        "GAER1"                 "bin 1 layer assymetry parameter" "?"
+state    real  gaer2           ikj     misc        1         -      r        "GAER2"                 "bin 2 layer assymetry parameter" "?"
+state    real  gaer3           ikj     misc        1         -      r        "GAER3"                 "bin 3 layer assymetry parameter" "?"
+state    real  gaer4           ikj     misc        1         -      r        "GAER4"                 "bin 4 layer assymetry parameter" "?"
+state    real  waer1           ikj     misc        1         -      r        "WAER1"                 "bin 1 layer single-scattering albedo" "?"
+state    real  waer2           ikj     misc        1         -      r        "WAER2"                 "bin 2 layer single-scattering albedo" "?"
+state    real  waer3           ikj     misc        1         -      r        "WAER3"                 "bin 3 layer single-scattering albedo" "?"
+state    real  waer4           ikj     misc        1         -      r        "WAER4"                 "bin 4 layer single-scattering albedo" "?"
+
+# non-transported aerosol variables
+state    real  h2oaj           ikj     misc        1         -      r        "h2oaj"                 "Aerosol water conc. Acc.mode"         "?"
+state    real  h2oai           ikj     misc        1         -      r        "h2oai"                 "Aerosol water conc. Aitken mode"      "?"
+state    real  nu3             ikj     misc        1         -      r        "nu3"                   "3rd moment Aitken mode"               "?"
+state    real  ac3             ikj     misc        1         -      r        "ac3"                   "3rd moment Acc. mode"                 "?"
+state    real  cor3            ikj     misc        1         -      r        "cor3"                  "3rd moment coarse mode"               "?"
+state    real  asulf           ikj     misc        1         -      r        "asulf"                 "sulfuric acid vapor deposition"       "?"
+state    real  ahno3           ikj     misc        1         -      r        "ahno3"                 "nitric acid vapor deposition"         "?"
+state    real  anh3            ikj     misc        1         -      r        "anh3"                  "amonia gas concentration"             "?"
+state    real  cvaro1          ikj     misc        1         -      r        "cvaro1"                "cond.vapor from aromatics"            "?"
+state    real  cvaro2          ikj     misc        1         -      r        "cvaro2"                "cond.vapor from aromatics"            "?"
+state    real  cvalk1          ikj     misc        1         -      r        "cvalk1"                "cond.vapor from alkanes"              "?"
+state    real  cvole1          ikj     misc        1         -      r        "cvole1"                "cond.vapor from olefines"             "?"
+state    real  cvapi1          ikj     misc        1         -      r        "cvapi1"                "cond.vapor from biogenics"            "?"
+state    real  cvapi2          ikj     misc        1         -      r        "cvapi2"                "cond.vapor from biogenics"            "?"
+state    real  cvlim1          ikj     misc        1         -      r        "cvlim1"                "cond.vapor from biogenics"            "?"
+state    real  cvlim2          ikj     misc        1         -      r        "cvlim2"                "cond.vapor from biogenics"            "?"
+# non-transported radical species for RACM
+state    real  addt         ikj     misc        1         -      r        "addt"                "Radicals" "ppm"
+state    real  addx         ikj     misc        1         -      r        "addx"                "Radicals" "ppm"
+state    real  addc         ikj     misc        1         -      r        "addc"                "Radicals" "ppm"
+state    real  etep         ikj     misc        1         -      r        "etep"                "Radicals" "ppm"
+state    real  oltp         ikj     misc        1         -      r        "oltp"                "Radicals" "ppm"
+state    real  olip         ikj     misc        1         -      r        "olip"                "Radicals" "ppm"
+state    real  cslp         ikj     misc        1         -      r        "cslp"                "Radicals" "ppm"
+state    real  limp         ikj     misc        1         -      r        "limp"                "Radicals" "ppm"
+state    real  hc5p         ikj     misc        1         -      r        "hc5p"                "Radicals" "ppm"
+state    real  hc8p         ikj     misc        1         -      r        "hc8p"                "Radicals" "ppm"
+state    real  tolp         ikj     misc        1         -      r        "tolp"                "Radicals" "ppm"
+state    real  xylp         ikj     misc        1         -      r        "xylp"                "Radicals" "ppm"
+state    real  apip         ikj     misc        1         -      r        "apip"                "Radicals" "ppm"
+state    real  isop         ikj     misc        1         -      r        "isop"                "Radicals" "ppm"
+state    real  hc3p         ikj     misc        1         -      r        "hc3p"                "Radicals" "ppm"
+state    real  ethp         ikj     misc        1         -      r        "ethp"                "Radicals" "ppm"
+state    real  o3p          ikj     misc        1         -      r        "o3p"                 "Radicals" "ppm"
+state    real  tco3         ikj     misc        1         -      r        "tco3"                "Radicals" "ppm"
+state    real  mo2          ikj     misc        1         -      r        "mo2"                 "Radicals" "ppm"
+state    real  o1d          ikj     misc        1         -      r        "o1d"                 "Radicals" "ppm"
+state    real  olnn         ikj     misc        1         -      r        "olnn"                "Radicals" "ppm"
+state    real  olnd         ikj     misc        1         -      r        "olnd"                "Radicals" "ppm"
+state    real  rpho         ikj     misc        1         -      r        "rpho"                "Radicals" "ppm"
+state    real  xo2          ikj     misc        1         -      r        "xo2"                 "Radicals" "ppm"
+state    real  ketp         ikj     misc        1         -      r        "ketp"                "Radicals" "ppm"
+#cms++ radicals from RADM2-KPP, RACM-MIM
+state    real  xno2          ikj     misc        1         -      r        "xno2"                 "Radicals" "ppm"
+state    real  ol2p          ikj     misc        1         -      r        "ol2p"                 "Radicals" "ppm"
+state    real  oln           ikj     misc        1         -      r        "oln"                "Radicals" "ppm"
+state    real  macp         ikj     misc        1         -      r        "macp"                "Radicals" "ppm"
+#cms--
+
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+state   real   so2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so2"           "SO2 concentration"         "ppmv"
+state   real   sulf        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "sulf"          "SULF concentration"        "ppmv"
+state   real   no2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no2"           "NO2 concentration"         "ppmv"
+state   real   no          ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no"            "NO concentration"          "ppmv"
+state   real   o3          ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "o3"            "O3 concentration"          "ppmv"
+state   real   hno3        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hno3"          "HNO3 concentration"        "ppmv"
+state   real   h2o2        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "h2o2"          "H2O2 concentration"        "ppmv"
+state   real   ald         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ald"           "ALD concentration"         "ppmv"
+state   real   hcho        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hcho"          "HCHO concentration"        "ppmv"
+state   real   op1         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "op1"           "OP1 concentration"         "ppmv"
+state   real   op2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "op2"           "OP2 concentration"         "ppmv"
+state   real   paa         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "paa"           "PAA concentration"         "ppmv"
+state   real   ora1        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ora1"          "ORA1 concentration"        "ppmv"
+state   real   ora2        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ora2"          "ORA2 concentration"        "ppmv"
+state   real   nh3         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh3"           "NH3 concentration"         "ppmv"
+state   real   n2o5        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "n2o5"          "N2O5 concentration"        "ppmv"
+state   real   no3         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3"           "NO3 concentration"         "ppmv"
+state   real   pan         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "pan"           "PAN concentration"         "ppmv"
+state   real   hc3         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hc3"           "HC3 concentration"         "ppmv"
+state   real   hc5         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hc5"           "HC5 concentration"         "ppmv"
+state   real   hc8         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hc8"           "HC8 concentration"         "ppmv"
+state   real   eth         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "eth"           "ETH concentration"         "ppmv"
+state   real   co          ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co"            "CO concentration"          "ppmv"
+state   real   ol2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ol2"           "OL2 concentration"         "ppmv"
+state   real   olt         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "olt"           "OLT concentration"         "ppmv"
+state   real   oli         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oli"           "OLI concentration"         "ppmv"
+state   real   tol         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "tol"           "TOL concentration"         "ppmv"
+state   real   xyl         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "xyl"           "XYL concentration"         "ppmv"
+state   real   aco3        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "aco3"          "ACO3 concentration"        "ppmv"
+state   real   tpan        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "tpan"          "TPAN concentration"        "ppmv"
+state   real   hono        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hono"          "HONO concentration"        "ppmv"
+state   real   hno4        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hno4"          "HNO4 concentration"        "ppmv"
+state   real   ket         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ket"           "KET concentration"         "ppmv"
+state   real   gly         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "gly"           "GLY concentration"         "ppmv"
+state   real   mgly        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "mgly"          "MGLY concentration"        "ppmv"
+state   real   dcb         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "dcb"           "DCB concentration"         "ppmv"
+state   real   onit        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "onit"          "ONIT concentration"        "ppmv"
+state   real   csl         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "csl"           "CSL concentration"         "ppmv"
+state   real   iso         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "iso"           "ISO concentration"         "ppmv"
+state   real   ho          ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ho"            "HO concentration"          "ppmv"
+state   real   ho2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ho2"           "HO2 concentration"         "ppmv"
+
+#RACM has a few more variables to those of RADM2 (ETE is equivilant to OL2 from RADM2)
+
+state   real   ete         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ete"           "ETE concentration"         "ppmv"
+state   real   co2         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "co2"           "CO2 concentration"         "ppmv"
+state   real   ch4         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ch4"           "CH4 concentration"         "ppmv"
+state   real   udd         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "udd"           "UDD concentration"         "ppmv"
+state   real   hket        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hket"          "HKET concentration"        "ppmv"
+state   real   api         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "api"           "API concentration"         "ppmv"
+state   real   lim         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "lim"           "LIM concentration"         "ppmv"
+state   real   dien        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "dien"          "DIEN concentration"        "ppmv"
+state   real   macr        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "macr"          "MACR concentration"        "ppmv"
+
+#Additional CBMZ gas variables inside the chem array...
+
+state   real   hcl         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hcl"           "HCL concentration"         "ppmv"
+state   real   ch3o2       ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ch3o2"         "CH3O2 concentration"       "ppmv"
+state   real   ethp        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ethp"          "ETHP concentration"        "ppmv"
+state   real   ch3oh       ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ch3oh"         "CH3OH concentration"       "ppmv"
+state   real   c2h5oh      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "c2h5oh"        "C2H5OH concentration"      "ppmv"
+state   real   par         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "par"           "PAR concentration"         "ppmv"
+state   real   to2         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "to2"           "TO2 concentration"         "ppmv"
+state   real   cro         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "cro"           "CRO concentration"         "ppmv"
+state   real   open        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "open"          "OPEN concentration"        "ppmv"
+state   real   op3         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "op3"           "OP3 concentration"         "ppmv"
+state   real   c2o3        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "c2o3"          "C2O3 concentration"        "ppmv"
+state   real   ro2         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ro2"           "RO2 concentration"         "ppmv"
+state   real   ano2        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ano2"          "ANO2 concentration"        "ppmv"
+state   real   nap         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "nap"           "NAP concentration"         "ppmv"
+state   real   xo2         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "xo2"           "XO2 concentration"         "ppmv"
+state   real   xpar        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "xpar"          "XPAR concentration"        "ppmv"
+state   real   isoprd      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "isoprd"        "ISOPRD concentration"      "ppmv"
+state   real   isopp       ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "isopp"         "ISOPP concentration"       "ppmv"
+state   real   isopn       ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "isopn"         "ISOPN concentration"       "ppmv"
+state   real   isopo2      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "isopo2"        "ISOPO2 concentration"      "ppmv"
+state   real   dms         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "dms"           "DMS concentration"         "ppmv"
+state   real   msa         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "msa"           "MSA concentration"         "ppmv"
+state   real   dmso        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "dmso"          "DMSO concentration"        "ppmv"
+state   real   dmso2       ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "dmso2"         "DMSO2 concentration"       "ppmv"
+state   real   ch3so2h     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ch3so2h"       "CH3SO2H concentration"     "ppmv"
+state   real   ch3sch2oo   ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ch3sch2oo"     "CH3SCH2OO concentration"   "ppmv"
+state   real   ch3so2      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ch3so2"        "CH3SO2 concentration"      "ppmv"
+state   real   ch3so3      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ch3so3"        "CH3SO3 concentration"      "ppmv"
+state   real   ch3so2oo    ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ch3so2oo"      "CH3SO2OO concentration"    "ppmv"
+state   real   ch3so2ch2oo ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ch3so2ch2oo"   "CH3SO2CH2OO concentration" "ppmv"
+state   real   mtf         ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "mtf"           "MTF concentration"         "ppmv"
+
+#Aerosol variables inside the chem array...
+
+state   real   so4aj       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4aj"         "Sulfate conc. Acc. mode"       "ug/kg-dryair"
+state   real   so4ai       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4ai"         "Sulfate conc. Aitken mode"       "ug/kg-dryair"
+state   real   nh4aj       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4aj"         "Ammonium conc. Acc. mode"       "ug/kg-dryair"
+state   real   nh4ai       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4ai"         "Ammonium  conc. Aitken mode"       "ug/kg-dryair"
+state   real   no3aj       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3aj"         "Nitrate  conc. Acc. mode"       "ug/kg-dryair"
+state   real   no3ai       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3ai"         "Nitrate  conc. Aitken mode"       "ug/kg-dryair"
+state   real   orgaro1j    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgaro1j"      "SOA Anth. org. conc. from aromatics Acc. mode"    "ug/kg-dryair"
+state   real   orgaro1i    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgaro1i"      "SOA Anth. org. conc. from aromatics Aitken mode"    "ug/kg-dryair"
+state   real   orgaro2j    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgaro2j"      "SOA Anth. org. conc. from aromatics Acc. mode"    "ug/kg-dryair"
+state   real   orgaro2i    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgaro2i"      "SOA Anth. org. conc. from aromatics Aitken mode"    "ug/kg-dryair"
+state   real   orgalk1j    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgalk1j"      "SOA Anth. org. conc. from alkanes and others except aromatics Acc. mode"    "ug/kg-dryair"
+state   real   orgalk1i    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgalk1i"      "SOA Anth. org. conc. from alkanes and others except aromatics Aitken mode"    "ug/kg-dryair"
+state   real   orgole1j    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgole1j"      "SOA Anth. org. conc. from alkenes and others except aromatics Acc. mode"    "ug/kg-dryair"
+state   real   orgole1i    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgole1i"      "SOA Anth. org. conc. from alkenes and others except aromatics Aitken mode"    "ug/kg-dryair"
+state   real   orgba1j     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba1j"       "SOA Biog. org. conc. from aromatics Acc. mode"     "ug/kg-dryair"
+state   real   orgba1i     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba1i"       "SOA Biog. org. conc. from aromatics Aitken mode"     "ug/kg-dryair"
+state   real   orgba2j     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba2j"       "SOA Biog. org. conc. from aromatics Acc. mode"     "ug/kg-dryair"
+state   real   orgba2i     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba2i"       "SOA Biog. org. conc. from aromatics Aitken mode"     "ug/kg-dryair"
+state   real   orgba3j     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba3j"       "SOA Biog. org. conc. from aromatics Acc. mode"     "ug/kg-dryair"
+state   real   orgba3i     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba3i"       "SOA Biog. org. conc. from aromatics Aitken mode"     "ug/kg-dryair"
+state   real   orgba4j     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba4j"       "SOA Biog. org. conc. from aromatics Acc. mode"     "ug/kg-dryair"
+state   real   orgba4i     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba4i"       "SOA Biog. org. conc. from aromatics Aitken mode"     "ug/kg-dryair"
+state   real   orgpaj      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgpaj"        "Prim. anth. org. conc. from aromatics Acc. mode"      "ug/kg-dryair"
+state   real   orgpai      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgpai"        "Prim. anth. org. conc. from aromatics Aitken mode"      "ug/kg-dryair"
+state   real   ecj         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ecj"           "Elemental carbon Acc. mode"         "ug/kg-dryair"
+state   real   eci         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "eci"           "Elemental carbon Aitken mode"         "ug/kg-dryair"
+state   real   p25j        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "p25j"          "Primary PM2.5 Acc. mode"        "ug/kg-dryair"
+state   real   p25i        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "p25i"          "Primary PM2.5 Aitken mode"        "ug/kg-dryair"
+state   real   antha       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "antha"         "Coarse anthropogenic aerosols"       "ug/kg-dryair"
+state   real   seas        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "seas"          "Coarse marine aerosols"        "ug/kg-dryair"
+state   real   soila       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "soila"         "Coarse soil-derived aerosols"       "ug/kg-dryair"
+state   real   nu0         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nu0"           "Aitken mode number"         "#/kg-dryair"
+state   real   ac0         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ac0"           "Accumulation mode number"         "#/kg-dryair"
+state   real   corn        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "corn"          "Coarse mode number"        "#/kg-dryair"
+#cms++ additional species from RACM-MIM (Geiger et al., Atmos. Env., 2003)
+state   real   hace        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "HACE"              "HACE concentration"      "ppm"
+state   real   ishp        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "ISHP"              "ISHP concentration"      "ppm"
+state   real   ison        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "ISON"              "ISON concentration"      "ppm"
+state   real   mahp        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "MAHP"              "MAHP concentration"      "ppm"
+state   real   mpan        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "MPAN"              "MPAN concentration"      "ppm"
+state   real   nald        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "NALD"              "NALD concentration"      "ppm"
+#cms-- note: ison is probably quite soluble 
+
+
+
+#Additional MOSAIC aerosol variables inside the chem array...
+
+state   real   so4_a01     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "so4_a01"       "Sulfate, aerosol bin 01"     "ug/kg-dryair"
+state   real   no3_a01     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "no3_a01"       "Nitrate, aerosol bin 01"     "ug/kg-dryair"
+state   real   cl_a01      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "cl_a01"        "Chloride, aerosol bin 01"      "ug/kg-dryair"
+state   real   msa_a01     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "msa_a01"       "MSA, aerosol bin 01"     "ug/kg-dryair"
+state   real   co3_a01     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "co3_a01"       "Carbonate, aerosol bin 01"     "ug/kg-dryair"
+state   real   nh4_a01     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "nh4_a01"       "Ammonium, aerosol bin 01"     "ug/kg-dryair"
+state   real   na_a01      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "na_a01"        "Sodium, aerosol bin 01"      "ug/kg-dryair"
+state   real   ca_a01      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ca_a01"        "Calcium, aerosol bin 01"      "ug/kg-dryair"
+state   real   oin_a01     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oin_a01"       "Other inorganics, aerosol bin 01"     "ug/kg-dryair"
+state   real   oc_a01      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oc_a01"        "Organic carbon, aerosol bin 01"      "ug/kg-dryair"
+state   real   bc_a01      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "bc_a01"        "Black carbon, aerosol bin 01"      "ug/kg-dryair"
+state   real   hysw_a01    ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hysw_a01"      "Hysteresis water, aerosol bin 01"    "ug/kg-dryair"
+state   real   water_a01   ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "water_a01"     "Water, aerosol bin 01"   "ug/kg-dryair"
+state   real   num_a01     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "num_a01"       "Number, aerosol bin 01"     "#/kg-dryair"
+state   real   so4_a02     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "so4_a02"       "Sulfate, aerosol bin 02"     "ug/kg-dryair"
+state   real   no3_a02     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "no3_a02"       "Nitrate, aerosol bin 02"     "ug/kg-dryair"
+state   real   cl_a02      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "cl_a02"        "Chloride, aerosol bin 02"      "ug/kg-dryair"
+state   real   msa_a02     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "msa_a02"       "MSA, aerosol bin 02"     "ug/kg-dryair"
+state   real   co3_a02     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "co3_a02"       "Carbonate, aerosol bin 02"     "ug/kg-dryair"
+state   real   nh4_a02     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "nh4_a02"       "Ammonium, aerosol bin 02"     "ug/kg-dryair"
+state   real   na_a02      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "na_a02"        "Sodium, aerosol bin 02"      "ug/kg-dryair"
+state   real   ca_a02      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ca_a02"        "Calcium, aerosol bin 02"      "ug/kg-dryair"
+state   real   oin_a02     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oin_a02"       "Other inorganics, aerosol bin 02"     "ug/kg-dryair"
+state   real   oc_a02      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oc_a02"        "Organic carbon, aerosol bin 02"      "ug/kg-dryair"
+state   real   bc_a02      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "bc_a02"        "Black carbon, aerosol bin 02"      "ug/kg-dryair"
+state   real   hysw_a02    ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hysw_a02"      "Hysteresis water, aerosol bin 02"    "ug/kg-dryair"
+state   real   water_a02   ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "water_a02"     "Water, aerosol bin 02"   "ug/kg-dryair"
+state   real   num_a02     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "num_a02"       "Number, aerosol bin 02"     "#/kg-dryair"
+state   real   so4_a03     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "so4_a03"       "Sulfate, aerosol bin 03"     "ug/kg-dryair"
+state   real   no3_a03     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "no3_a03"       "Nitrate, aerosol bin 03"     "ug/kg-dryair"
+state   real   cl_a03      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "cl_a03"        "Chloride, aerosol bin 03"      "ug/kg-dryair"
+state   real   msa_a03     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "msa_a03"       "MSA, aerosol bin 03"     "ug/kg-dryair"
+state   real   co3_a03     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "co3_a03"       "Carbonate, aerosol bin 03"     "ug/kg-dryair"
+state   real   nh4_a03     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "nh4_a03"       "Ammonium, aerosol bin 03"     "ug/kg-dryair"
+state   real   na_a03      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "na_a03"        "Sodium, aerosol bin 03"      "ug/kg-dryair"
+state   real   ca_a03      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ca_a03"        "Calcium, aerosol bin 03"      "ug/kg-dryair"
+state   real   oin_a03     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oin_a03"       "Other inorganics, aerosol bin 03"     "ug/kg-dryair"
+state   real   oc_a03      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oc_a03"        "Organic carbon, aerosol bin 03"      "ug/kg-dryair"
+state   real   bc_a03      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "bc_a03"        "Black carbon, aerosol bin 03"      "ug/kg-dryair"
+state   real   hysw_a03    ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hysw_a03"      "Hysteresis water, aerosol bin 03"    "ug/kg-dryair"
+state   real   water_a03   ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "water_a03"     "Water, aerosol bin 03"   "ug/kg-dryair"
+state   real   num_a03     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "num_a03"       "Number, aerosol bin 03"     "#/kg-dryair"
+state   real   so4_a04     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "so4_a04"       "Sulfate, aerosol bin 04"     "ug/kg-dryair"
+state   real   no3_a04     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "no3_a04"       "Nitrate, aerosol bin 04"     "ug/kg-dryair"
+state   real   cl_a04      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "cl_a04"        "Chloride, aerosol bin 04"      "ug/kg-dryair"
+state   real   msa_a04     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "msa_a04"       "MSA, aerosol bin 04"     "ug/kg-dryair"
+state   real   co3_a04     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "co3_a04"       "Carbonate, aerosol bin 04"     "ug/kg-dryair"
+state   real   nh4_a04     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "nh4_a04"       "Ammonium, aerosol bin 04"     "ug/kg-dryair"
+state   real   na_a04      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "na_a04"        "Sodium, aerosol bin 04"      "ug/kg-dryair"
+state   real   ca_a04      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ca_a04"        "Calcium, aerosol bin 04"      "ug/kg-dryair"
+state   real   oin_a04     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oin_a04"       "Other inorganics, aerosol bin 04"     "ug/kg-dryair"
+state   real   oc_a04      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oc_a04"        "Organic carbon, aerosol bin 04"      "ug/kg-dryair"
+state   real   bc_a04      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "bc_a04"        "Black carbon, aerosol bin 04"      "ug/kg-dryair"
+state   real   hysw_a04    ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hysw_a04"      "Hysteresis water, aerosol bin 04"    "ug/kg-dryair"
+state   real   water_a04   ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "water_a04"     "Water, aerosol bin 04"   "ug/kg-dryair"
+state   real   num_a04     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "num_a04"       "Number, aerosol bin 04"     "#/kg-dryair"
+state   real   so4_a05     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "so4_a05"       "Sulfate, aerosol bin 05"     "ug/kg-dryair"
+state   real   no3_a05     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "no3_a05"       "Nitrate, aerosol bin 05"     "ug/kg-dryair"
+state   real   cl_a05      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "cl_a05"        "Chloride, aerosol bin 05"      "ug/kg-dryair"
+state   real   msa_a05     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "msa_a05"       "MSA, aerosol bin 05"     "ug/kg-dryair"
+state   real   co3_a05     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "co3_a05"       "Carbonate, aerosol bin 05"     "ug/kg-dryair"
+state   real   nh4_a05     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "nh4_a05"       "Ammonium, aerosol bin 05"     "ug/kg-dryair"
+state   real   na_a05      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "na_a05"        "Sodium, aerosol bin 05"      "ug/kg-dryair"
+state   real   ca_a05      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ca_a05"        "Calcium, aerosol bin 05"      "ug/kg-dryair"
+state   real   oin_a05     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oin_a05"       "Other inorganics, aerosol bin 05"     "ug/kg-dryair"
+state   real   oc_a05      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oc_a05"        "Organic carbon, aerosol bin 05"      "ug/kg-dryair"
+state   real   bc_a05      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "bc_a05"        "Black carbon, aerosol bin 05"      "ug/kg-dryair"
+state   real   hysw_a05    ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hysw_a05"      "Hysteresis water, aerosol bin 05"    "ug/kg-dryair"
+state   real   water_a05   ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "water_a05"     "Water, aerosol bin 05"   "ug/kg-dryair"
+state   real   num_a05     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "num_a05"       "Number, aerosol bin 05"     "#/kg-dryair"
+state   real   so4_a06     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "so4_a06"       "Sulfate, aerosol bin 06"     "ug/kg-dryair"
+state   real   no3_a06     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "no3_a06"       "Nitrate, aerosol bin 06"     "ug/kg-dryair"
+state   real   cl_a06      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "cl_a06"        "Chloride, aerosol bin 06"      "ug/kg-dryair"
+state   real   msa_a06     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "msa_a06"       "MSA, aerosol bin 06"     "ug/kg-dryair"
+state   real   co3_a06     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "co3_a06"       "Carbonate, aerosol bin 06"     "ug/kg-dryair"
+state   real   nh4_a06     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "nh4_a06"       "Ammonium, aerosol bin 06"     "ug/kg-dryair"
+state   real   na_a06      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "na_a06"        "Sodium, aerosol bin 06"      "ug/kg-dryair"
+state   real   ca_a06      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ca_a06"        "Calcium, aerosol bin 06"      "ug/kg-dryair"
+state   real   oin_a06     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oin_a06"       "Other inorganics, aerosol bin 06"     "ug/kg-dryair"
+state   real   oc_a06      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oc_a06"        "Organic carbon, aerosol bin 06"      "ug/kg-dryair"
+state   real   bc_a06      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "bc_a06"        "Black carbon, aerosol bin 06"      "ug/kg-dryair"
+state   real   hysw_a06    ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hysw_a06"      "Hysteresis water, aerosol bin 06"    "ug/kg-dryair"
+state   real   water_a06   ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "water_a06"     "Water, aerosol bin 06"   "ug/kg-dryair"
+state   real   num_a06     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "num_a06"       "Number, aerosol bin 06"     "#/kg-dryair"
+state   real   so4_a07     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "so4_a07"       "Sulfate, aerosol bin 07"     "ug/kg-dryair"
+state   real   no3_a07     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "no3_a07"       "Nitrate, aerosol bin 07"     "ug/kg-dryair"
+state   real   cl_a07      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "cl_a07"        "Chloride, aerosol bin 07"      "ug/kg-dryair"
+state   real   msa_a07     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "msa_a07"       "MSA, aerosol bin 07"     "ug/kg-dryair"
+state   real   co3_a07     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "co3_a07"       "Carbonate, aerosol bin 07"     "ug/kg-dryair"
+state   real   nh4_a07     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "nh4_a07"       "Ammonium, aerosol bin 07"     "ug/kg-dryair"
+state   real   na_a07      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "na_a07"        "Sodium, aerosol bin 07"      "ug/kg-dryair"
+state   real   ca_a07      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ca_a07"        "Calcium, aerosol bin 07"      "ug/kg-dryair"
+state   real   oin_a07     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oin_a07"       "Other inorganics, aerosol bin 07"     "ug/kg-dryair"
+state   real   oc_a07      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oc_a07"        "Organic carbon, aerosol bin 07"      "ug/kg-dryair"
+state   real   bc_a07      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "bc_a07"        "Black carbon, aerosol bin 07"      "ug/kg-dryair"
+state   real   hysw_a07    ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hysw_a07"      "Hysteresis water, aerosol bin 07"    "ug/kg-dryair"
+state   real   water_a07   ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "water_a07"     "Water, aerosol bin 07"   "ug/kg-dryair"
+state   real   num_a07     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "num_a07"       "Number, aerosol bin 07"     "#/kg-dryair"
+state   real   so4_a08     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "so4_a08"       "Sulfate, aerosol bin 08"     "ug/kg-dryair"
+state   real   no3_a08     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "no3_a08"       "Nitrate, aerosol bin 08"     "ug/kg-dryair"
+state   real   cl_a08      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "cl_a08"        "Chloride, aerosol bin 08"      "ug/kg-dryair"
+state   real   msa_a08     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "msa_a08"       "MSA, aerosol bin 08"     "ug/kg-dryair"
+state   real   co3_a08     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "co3_a08"       "Carbonate, aerosol bin 08"     "ug/kg-dryair"
+state   real   nh4_a08     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "nh4_a08"       "Ammonium, aerosol bin 08"     "ug/kg-dryair"
+state   real   na_a08      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "na_a08"        "Sodium, aerosol bin 08"      "ug/kg-dryair"
+state   real   ca_a08      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "ca_a08"        "Calcium, aerosol bin 08"      "ug/kg-dryair"
+state   real   oin_a08     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oin_a08"       "Other inorganics, aerosol bin 08"     "ug/kg-dryair"
+state   real   oc_a08      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "oc_a08"        "Organic carbon, aerosol bin 08"      "ug/kg-dryair"
+state   real   bc_a08      ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "bc_a08"        "Black carbon, aerosol bin 08"      "ug/kg-dryair"
+state   real   hysw_a08    ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "hysw_a08"      "Hysteresis water, aerosol bin 08"    "ug/kg-dryair"
+state   real   water_a08   ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "water_a08"     "Water, aerosol bin 08"   "ug/kg-dryair"
+state   real   num_a08     ikjftb   chem        1         -   irusdf=(bdy_interp:dt)  "num_a08"       "Number, aerosol bin 08"     "#/kg-dryair"
+
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -   -
+state   real    qni            ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rhd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rhd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rhd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rhd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i012rhd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"   "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+#
+#
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables***25Aug 2002*****
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+
+# Other Misc State Variables                                            
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+state   real    TSK            ij      misc         1         -     i012rhdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+state    real  RAINC            ij      misc        1         -      rhdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rhdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      rh       "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rhdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rhdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      rh      "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      rh      "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      rh      "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      rh      "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      rh      "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      rh      "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      rh      "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      rh      "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  GD_CLOUD        ikj      misc        1         -      rh      "GD_CLOUD"              "CLOUD WATER/ICE MIXING RAIO IN GD CLOUD"         "kg kg-1"
+state    real  GD_CLOUD2        ikj      misc        1         -      rh      "GD_CLOUD2"              "TEST for GD CLOUD"         "kg kg-1"
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+state integer  STEPBIOE          -        misc     1         -      r        "STEPBIOE"              "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN BIOGENIC EMIS CALLS"             "NA"
+state integer  STEPPHOT          -        misc     1         -      r        "STEPPHOT"              "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PHOTOLYSIS CALLS"             "NA"
+state integer  STEPCHEM          -        misc     1         -      r        "STEPCHEM"              "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CHEM MECH CALLS"             "NA"
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""      
+                                                
+state    real  SWDOWN           ij      misc        1         -      rhd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rhd      "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GLW              ij      misc        1         -      rhd      "GLW"                   "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE"            "W m-2"      
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      rh        "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      rh          "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rhd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      rh       "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      rh       "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      rh       "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      rh       "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      i4r      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      i4r      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      i4r      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      i4r      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      i4r      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      i4r      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      i4r      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      i4r      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      i4r      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      i4r      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      i4r      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      i4r      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1993    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      03    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      13    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      12    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1993    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      03    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      14    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      12    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  emi_inname        namelist,time_control		1  "wrfchemi_d<domain>_<date>"   -     "name of chem emissions infile"  ""    ""
+rconfig   character  emi_outname       namelist,time_control		1  "wrfchemi_d<domain>_<date>"   -     "name of chem emissions outfile" ""    ""
+rconfig   character  input_chem_inname       namelist,time_control		1  "wrf_chem_input_d<domain>_<date>"   -     "name of chem infile"  ""    ""
+rconfig   character  input_chem_outname      namelist,time_control		1  "wrf_chem_input_d<domain>_<date>"   -     "name of chem outfile" ""    ""
+rconfig   integer frames_per_emissfile    namelist,time_control         1              12      h     "frames_per_emissfile"          ""      ""
+rconfig   integer io_style_emissions      namelist,time_control     1              1       -     "io_style_emissions"    ""      ""
+rconfig   integer     io_form_emissions   namelist,time_control         1              2       h        "io_form_emissions"              ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains      1              27      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              5000    irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              1       irh    "interp_type"                ""      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              1       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              500     irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .false. irh    "afcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       rh     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       rh     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1000.
+
+# Physics
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   real    BIOEMDT                 namelist,physics      max_domains    0       h    "BIOEMDT"          "" ""
+rconfig   real    PHOTDT                  namelist,physics      max_domains    0       h    "PHOTDT"          ""  ""
+rconfig   real    CHEMDT                  namelist,physics      max_domains    0       h    "CHEMDT"          ""  ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1             5       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer ne_area                 namelist,physics      1           41       irh    "ne_area"               ""      ""
+rconfig   integer kemit                   namelist,physics      1             9       irh   "kemit"                 ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics      1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics      1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.      h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    .1      h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    0       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .false. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   integer     chem_in_opt         namelist,dynamics     max_domains    0       rh       "chem_in_opt"     ""      ""
+rconfig   integer     phot_opt            namelist,dynamics     max_domains    0       rh       "phot_opt"        ""      ""
+rconfig   integer     drydep_opt          namelist,dynamics     max_domains    0       rh       "drydep_opt"      ""      ""
+rconfig   integer     bio_emiss_opt       namelist,dynamics     max_domains    0       rh       "bio_emiss_opt"   ""      ""
+rconfig   integer     emiss_inpt_opt      namelist,dynamics     max_domains    0       rh       "emiss_inpt_opt"  ""      ""
+rconfig   integer     gas_bc_opt          namelist,dynamics     max_domains    1       rh       "gas_bc_opt"      ""      ""
+rconfig   integer     gas_ic_opt          namelist,dynamics     max_domains    1       rh       "gas_ic_opt"      ""      ""
+rconfig   integer     aer_bc_opt          namelist,dynamics     max_domains    1       rh       "aer_bc_opt"      ""      ""
+rconfig   integer     aer_ic_opt          namelist,dynamics     max_domains    1       rh       "aer_ic_opt"      ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   logical have_bcs_chem           namelist,bdy_control	max_domains    .false. rh    "have_bcs_chem"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2                1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2                1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2                1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2                1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   real    emifrq                  derived                  max_domains    0       -        "emifrq"               "chem emissions input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+
+#package   passivec1     chem_opt==0                  -             
+package   radm2         chem_opt==1                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2
+package   radm2sorg     chem_opt==2                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,so4aj,so4ai,nh4aj,nh4ai,no3aj,no3ai,orgaro1j,orgaro1i,orgaro2j,orgaro2i,orgalk1j,orgalk1i,orgole1j,orgole1i,orgba1j,orgba1i,orgba2j,orgba2i,orgba3j,orgba3i,orgba4j,orgba4i,orgpaj,orgpai,ecj,eci,p25j,p25i,antha,seas,soila,nu0,ac0,corn
+package   racm          chem_opt==3                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,ho,ho2
+package   racmsorg      chem_opt==4                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,ho,ho2,so4aj,so4ai,nh4aj,nh4ai,no3aj,no3ai,orgaro1j,orgaro1i,orgaro2j,orgaro2i,orgalk1j,orgalk1i,orgole1j,orgole1i,orgba1j,orgba1i,orgba2j,orgba2i,orgba3j,orgba3i,orgba4j,orgba4i,orgpaj,orgpai,ecj,eci,p25j,p25i,antha,seas,soila,nu0,ac0,corn
+package   cbmz          chem_opt==5                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,hcl,ch3o2,ethp,ch3oh,c2h5oh,par,to2,cro,open,op3,c2o3,ro2,ano2,nap,xo2,xpar,isoprd,isopp,isopn,isopo2,dms,msa,dmso,dmso2,ch3so2h,ch3sch2oo,ch3so2,ch3so3,ch3so2oo,ch3so2ch2oo,mtf
+package   cbmz_bb       chem_opt==6                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,hcl,ch3o2,ethp,ch3oh,c2h5oh,par,to2,cro,open,op3,c2o3,ro2,ano2,nap,xo2,xpar,isoprd,isopp,isopn,isopo2
+package   cbmz_mosaic_aa  chem_opt==7                -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,hcl,ch3o2,ethp,ch3oh,c2h5oh,par,to2,cro,open,op3,c2o3,ro2,ano2,nap,xo2,xpar,isoprd,isopp,isopn,isopo2,so4_a01,no3_a01,cl_a01,nh4_a01,na_a01,oin_a01,oc_a01,bc_a01,hysw_a01,water_a01,num_a01,so4_a02,no3_a02,cl_a02,nh4_a02,na_a02,oin_a02,oc_a02,bc_a02,hysw_a02,water_a02,num_a02,so4_a03,no3_a03,cl_a03,nh4_a03,na_a03,oin_a03,oc_a03,bc_a03,hysw_a03,water_a03,num_a03,so4_a04,no3_a04,cl_a04,nh4_a04,na_a04,oin_a04,oc_a04,bc_a04,hysw_a04,water_a04,num_a04
+package   cbmz_mosaic_bb  chem_opt==8                -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,hcl,ch3o2,ethp,ch3oh,c2h5oh,par,to2,cro,open,op3,c2o3,ro2,ano2,nap,xo2,xpar,isoprd,isopp,isopn,isopo2,so4_a01,no3_a01,cl_a01,nh4_a01,na_a01,oin_a01,oc_a01,bc_a01,hysw_a01,water_a01,num_a01,so4_a02,no3_a02,cl_a02,nh4_a02,na_a02,oin_a02,oc_a02,bc_a02,hysw_a02,water_a02,num_a02,so4_a03,no3_a03,cl_a03,nh4_a03,na_a03,oin_a03,oc_a03,bc_a03,hysw_a03,water_a03,num_a03,so4_a04,no3_a04,cl_a04,nh4_a04,na_a04,oin_a04,oc_a04,bc_a04,hysw_a04,water_a04,num_a04,so4_a05,no3_a05,cl_a05,nh4_a05,na_a05,oin_a05,oc_a05,bc_a05,hysw_a05,water_a05,num_a05,so4_a06,no3_a06,cl_a06,nh4_a06,na_a06,oin_a06,oc_a06,bc_a06,hysw_a06,water_a06,num_a06,so4_a07,no3_a07,cl_a07,nh4_a07,na_a07,oin_a07,oc_a07,bc_a07,hysw_a07,water_a07,num_a07,so4_a08,no3_a08,cl_a08,nh4_a08,na_a08,oin_a08,oc_a08,bc_a08,hysw_a08,water_a08,num_a08
+package   chem_tracer   chem_opt==13                 -             chem:so2,no,ald,hcho,ora2,co
+
+
+#cms++
+package   radm2_kpp        chem_opt==101                 -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,ho,ho2
+
+package   racm_mim_kpp      chem_opt==102                  -            chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,hace,ishp,ison,mahp,mpan,nald,ho,ho2  
+
+package   racm_kpp      chem_opt==103                -            chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,ho,ho2
+
+package   racmsorg_kpp      chem_opt==104                  -            chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,ho,ho2,so4aj,so4ai,nh4aj,nh4ai,no3aj,no3ai,orgaro1j,orgaro1i,orgaro2j,orgaro2i,orgalk1j,orgalk1i,orgole1j,orgole1i,orgba1j,orgba1i,orgba2j,orgba2i,orgba3j,orgba3i,orgba4j,orgba4i,orgpaj,orgpai,ecj,eci,p25j,p25i,antha,seas,soila,nu0,ac0,corn
+
+package   radm2sorg_kpp     chem_opt==105                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,so4aj,so4ai,nh4aj,nh4ai,no3aj,no3ai,orgaro1j,orgaro1i,orgaro2j,orgaro2i,orgalk1j,orgalk1i,orgole1j,orgole1i,orgba1j,orgba1i,orgba2j,orgba2i,orgba3j,orgba3i,orgba4j,orgba4i,orgpaj,orgpai,ecj,eci,p25j,p25i,antha,seas,soila,nu0,ac0,corn
+
+
+
+#cms--
+
+package   photmad       phot_opt==1                  -             -
+package   photfastj     phot_opt==2                  -             -
+package   wesely        drydep_opt==1                -             -
+package   gunther1      bio_emiss_opt==1             -             -
+package   beis311       bio_emiss_opt==2             -             -
+
+# emiss_inpt_default        = radm2-sorgam emissions in "standard(=grell)" wrf-chem
+# emiss_inpt_pnnl_cm        = cbmz-mosaic  emissions in "PNNL" format
+# emiss_inpt_pnnl_rs        = radm2-sorgam emissions in "PNNL" format (same as default except isoprene added)
+package   emiss_inpt_default          emiss_inpt_opt==1            -             -
+package   emiss_inpt_pnnl_cm          emiss_inpt_opt==101          -             -
+package   emiss_inpt_pnnl_rs          emiss_inpt_opt==102          -             -
+
+# gas/aer_bc/ic_default     = bc/ic in "standard(=grell)" wrf-chem for radm2-sorgam species,
+#                                   and first-cut implementation for cbmz-mosaic species
+# gas/aer_bc/ic_pnnl        = bc/ic for PNNL simulations
+package   gas_bc_default              gas_bc_opt==1                -             -
+package   gas_bc_pnnl                 gas_bc_opt==101              -             -
+package   gas_ic_default              gas_ic_opt==1                -             -
+package   gas_ic_pnnl                 gas_ic_opt==101              -             -
+package   aer_bc_default              aer_bc_opt==1                -             -
+package   aer_bc_pnnl                 aer_bc_opt==101              -             -
+package   aer_ic_default              aer_ic_opt==1                -             -
+package   aer_ic_pnnl                 aer_ic_opt==101              -             -
+
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+                                                
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten 
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes)
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS	(revision 2744)
@@ -0,0 +1,1497 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWN    ij   misc  1  -  rhd  "SWDOWN"    "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWN    ij   misc  1  -  rhd  "LWDOWN"    "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rhd  "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rhd  "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rhd  "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rhd  "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rhd  "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                          -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state  real  PHTOT  ikj   dyn_em   1   -   rh   "PHTOT"  "total geopotential"  "m2 s-2"
+state  real  PTOT   ikj   dyn_em   1   -   rh   "PTOT"   "total pressure"      "Pa"
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+####
+#### variables dans wrf
+####
+state  real   albedo_gcm      ij   misc  1  -  i012r  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012r  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012r  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012r  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012r  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012r  "MARS_CICE"   "co2 ice"                 "kg"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      r        "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              0       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    0       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1             5       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             0       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    4       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS0
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS0	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS0	(revision 2744)
@@ -0,0 +1,1503 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rhd  "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWN    ij   misc  1  -  rhd  "SWDOWN"    "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWN    ij   misc  1  -  rhd  "LWDOWN"    "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rhd  "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rhd  "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rd   "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rd   "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rd   "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                          -
+state  real  QH2O      ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+####
+#### variables dans wrf - d pour que le grand domaine passe au petit (si input_file=F)
+####
+state  real   albedo_gcm      ij   misc  1  -  i012rd  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012rd  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012rd  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012rd  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012rd  "MARS_CICE"   "co2 ice"                 "kg"
+state  real   mars_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"  "soil temperatures"       "K"
+state  real   mars_gw        ilj   misc  1  -  i012rd  "MARS_GW"     "gwparam"                 " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      r        "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              0       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    0       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.  ir    "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             0       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    4       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS1
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS1	(revision 2744)
@@ -0,0 +1,1504 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWN    ij   misc  1  -  rhd  "SWDOWN"    "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWN    ij   misc  1  -  rhd  "LWDOWN"    "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rhd  "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rhd  "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rhd  "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rhd  "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rhd  "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rhd  "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                          -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+####
+#### variables dans wrf
+####
+state  real   albedo_gcm      ij   misc  1  -  i012rd  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012rd  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012rd  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012rd  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012rd  "MARS_CICE"   "co2 ice"                 "kg"
+state  real   mars_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"  "soil temperatures"       "K"
+state  real   mars_gw        ilj   misc  1  -  i012rd  "MARS_GW"     "gwparam"                 " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      r        "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              0       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    0       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.  ir    "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             0       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    4       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS1_watercycle
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS1_watercycle	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS1_watercycle	(revision 2744)
@@ -0,0 +1,1503 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWN    ij   misc  1  -  rhd  "SWDOWN"    "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWN    ij   misc  1  -  rhd  "LWDOWN"    "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rhd  "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rhd  "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rhd  "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rhd  "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rhd  "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rhd  "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                          -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+####
+#### variables dans wrf
+####
+state  real   albedo_gcm      ij   misc  1  -  i012rd  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012rd  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012rd  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012rd  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012rd  "MARS_CICE"   "co2 ice"                 "kg"
+state  real   mars_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"  "soil temperatures"       "K"
+state  real   mars_gw        ilj   misc  1  -  i012rd  "MARS_GW"     "gwparam"                 " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      r        "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              0       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    0       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             0       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    4       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS2
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_MARS2	(revision 2744)
@@ -0,0 +1,1506 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWN    ij   misc  1  -  rhd  "SWDOWN"    "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWN    ij   misc  1  -  rhd  "LWDOWN"    "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rhd  "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rhd  "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rd   "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rd   "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rd   "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                          -
+state  real  QH2O      ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rusdf=(bdy_interp:dt)  "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+state  real  QDUST     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUST"      "Dust mixing ratio"          "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+####
+#### variables dans wrf
+####
+state  real   albedo_gcm      ij   misc  1  -  i012rd  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012rd  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012rd  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012rd  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012rd  "MARS_CICE"   "co2 ice"                 "kg"
+state  real   mars_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"  "soil temperatures"       "K"
+state  real   mars_gw        ilj   misc  1  -  i012rd  "MARS_GW"     "gwparam"                 " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      r        "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              0       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    0       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.  ir    "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             0       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    4       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+package   dust         mars==2                      -              moist:qv;scalar:qdust 
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_SST
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_SST	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_SST	(revision 2744)
@@ -0,0 +1,1350 @@
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     irh01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irhusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irhdus "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irhusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irhdus       "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      rh        "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rhdus     "pb"          "BASE STATE PRESSURE "          "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+state    real   sr             ij      dyn_em      1         -      irh         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -        h         "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -        h         "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -        h         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     irhd      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     irhd      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     irhd      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     irh01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     irh01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -   -
+state   real    qni            ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+# Couple landmask via auxinput5 and auxhist5 for ESMF testing with a "dummy"
+# ocean model that reads SSTs from a file.  Note that the auxhist part is
+# only for self-test -- the dummy ocean model does not read this field.
+state   real   landmask            ij    misc          1     -     i0125rh05d=(interp_fcnm)u=(copy_fcnm) "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rhd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rhd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rhd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rhd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rhd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      rh                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+state    real   SNOW             ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+# Couple SST via auxinput5 and auxhist5 for ESMF testing with a "dummy"
+# ocean model that reads SSTs from a file.  Note that the auxhist part is only
+# for self-test -- the dummy ocean model does not read this field.
+state    real   SST              ij     misc        1         -     i0125rh05d=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"   "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables                                            
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+state   real    TSK            ij      misc         1         -     i012rhdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+state    real  RAINC            ij      misc        1         -      rhdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rhdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rhdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rhdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+
+state    real  SWDOWN           ij      misc        1         -      rhd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GLW              ij      misc        1         -      rhd      "GLW"                   "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE"            "W m-2"      
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      rh        "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      rh          "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rhd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      rh       "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      rh       "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      rh       "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      rh       "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     irhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics 
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec" 
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1993    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      03    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      13    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      12    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1993    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      03    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      14    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      12    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains      1              27      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              5000    irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              1       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              1       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              500     irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .false. irh    "afcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       rh     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       rh     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1000.
+
+# Physics
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1             5       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.      h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    .1      h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    0       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .false. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+
+#package   passivec1     chem_opt==0                  -             
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes)
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_dust
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_dust	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_dust	(revision 2744)
@@ -0,0 +1,1370 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     irh01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+#
+# Variables from WPS - Specific to Mars
+#
+state    real   albedo_gcm      ij       dyn_em      1        -     i1  "ALBEDO_GCM"  "albedo of naked ground"  "0 - 1 fraction"
+state    real   therm_inert     ij       dyn_em      1        -     i1  "THERMAL_INERTIA"  "thermal inertia"  "J/m2/K/s0.5"
+#
+# End variables from WPS - Specific to Mars
+#
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irhusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irhdus "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irhusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irhdus       "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      rh        "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rhdus     "pb"          "BASE STATE PRESSURE "          "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+state    real   sr             ij      dyn_em      1         -      irh         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -        h         "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -        h         "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -        h         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     irhd      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     irhd      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     irhd      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     irh01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     irh01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -   -
+######## MARS TRACERS
+state   real	qdust            ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "QDUST"           "Dust mixing ratio"      "kg kg-1"            
+######## MARS TRACERS
+state   real    qni            ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rhd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rhd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rhd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rhd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rhd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rhd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      rh                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+state    real   SNOW             ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rhd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables                                            
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+##
+## Variables specific to Mars
+##
+#state    real   mars_alb      ij       misc      1        -     irh  "MARS_ALB" "albedo of naked ground"  "0 - 1 fraction"
+#state    real   mars_ti       ij       misc      1        -     irh  "MARS_TI"  "thermal inertia"  "J/m2/K/s0.5"
+##
+## End variables specific to Mars
+##
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+state   real    TSK            ij      misc         1         -     i012rhdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+state    real  RAINC            ij      misc        1         -      rhdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rhdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rhdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rhdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+
+state    real  SWDOWN           ij      misc        1         -      rhd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GLW              ij      misc        1         -      rhd      "GLW"                   "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE"            "W m-2"      
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      rh        "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      rh          "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rhd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      rh       "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      rh       "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      rh       "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      rh       "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     irhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1993    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      03    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      13    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      12    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1993    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      03    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      14    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      12    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              27      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              5000    irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              1       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              1       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              500     irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .false. irh    "afcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       rh     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       rh     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1000.
+
+# Physics
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1             5       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.      h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    .1      h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    0       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .false. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+
+#package   passivec1     chem_opt==0                  -             
+##### MARS MODIFIED
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE
+package   passiveqv     mp_physics==0                -             moist:qv;scalar:qdust
+#moist:qv
+##### MARS MODIFIED
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_water
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_water	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EM_water	(revision 2744)
@@ -0,0 +1,1491 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rhd  "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rhd  "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWN    ij   misc  1  -  rhd  "SWDOWN"    "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWN    ij   misc  1  -  rhd  "LWDOWN"    "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rhd  "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rhd  "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rhd  "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rhd  "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rhd  "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                          -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+####
+#### variables dans wrf
+####
+state  real   albedo_gcm      ij   misc  1  -  i012r  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012r  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012r  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012r  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012r  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012r  "MARS_CICE"   "co2 ice"                 "kg"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irhusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irhdus "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus       "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      rh        "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rhdus     "pb"          "BASE STATE PRESSURE "          "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      r        "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              0       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    0       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1             5       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             0       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    4       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EMoldphys
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EMoldphys	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EMoldphys	(revision 2744)
@@ -0,0 +1,1525 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWNZ   ij   misc  1  -  rhd  "SWDOWNZ"   "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWNZ   ij   misc  1  -  rhd  "LWDOWNZ"   "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rd   "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rd   "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rd   "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rd   "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rd   "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+state  real  HR_SW     ikj  misc  1  -  rd   "HR_SW"     "HEATING RATE SW"                 "K/s"     #SAVEMARS3 zdtsw
+state  real  HR_LW     ikj  misc  1  -  rd   "HR_LW"     "HEATING RATE LW"                 "K/s"     #SAVEMARS3 zdtlw
+state  real  HR_SH     ikj  misc  1  -  rd   "HR_SH"     "HEATING RATE sens. heat"         "K/s"     #SAVEMARS3 zdtdif
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                         -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+state  real  QDUST     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUST"      "Dust mixing ratio"          "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+####
+#### variables dans wrf
+####
+state  real   albedo_gcm      ij   misc  1  -  i012rd  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012rd  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012rd  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012rd  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012rd  "MARS_CICE"   "co2 ice"                 "kg"
+state  real   mars_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"  "soil temperatures"       "K"
+state  real   mars_gw        ilj   misc  1  -  i012rd  "MARS_GW"     "gwparam"                 " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+####### if you choose h here, you will probably want not to output u,v,w,t,etc...
+state    real   uave           ikj     dyn_em      1         -      ir       "UAVE"        "average zonal wind"  "m/s"
+state    real   ustd           ikj     dyn_em      1         -      ir       "USTD"        "std dev zonal wind"  "m/s"
+state    real   vave           ikj     dyn_em      1         -      ir       "VAVE"        "average meridional wind"  "m/s"
+state    real   vstd           ikj     dyn_em      1         -      ir       "VSTD"        "std dev meridional wind"  "m/s"
+state    real   wave           ikj     dyn_em      1         -      ir       "WAVE"        "average vertical wind"  "m/s"
+state    real   wstd           ikj     dyn_em      1         -      ir       "WSTD"        "std dev vertical wind"  "m/s"
+state    real   tave           ikj     dyn_em      1         -      ir       "TAVE"        "average pert. potential temperature"  "K"
+state    real   tstd           ikj     dyn_em      1         -      ir       "TSTD"        "std dev pert. potential temperature"  "K"
+#######
+## ajouter tk, ptot, phtot ??? les deux derniers sont assez smooth...
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWN           ij      misc        1         -      rd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"
+state    real  SWDOWNC          ij      misc        1         -      -       "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  w_phy           ikj      misc        1         -
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+##### LES mettre h pour les deux variables ci-dessous
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+state    real  USTM             ij      misc        1         -      rh       "USTM"                  "U* IN SIMILARITY THEORY - LES MODE"           "m s-1"     #SAVEMARS2 ust 
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -      r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"     #SAVEMARS2 hfx
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .true.  irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              8       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains      max_domains   5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    0       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.   ir   "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    1       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh   "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh   "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh   "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh   "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.2     h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    2      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh   "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    6       h    "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+#rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics     max_domains    .false. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    tiso                    namelist,dynamics     1             140.     h    "tiso"    "Mars isothermal value for high alt, real only"  "K"
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+package   dust         mars==2                      -              moist:qv;scalar:qdust 
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EMref
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EMref	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.EMref	(revision 2744)
@@ -0,0 +1,1506 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWN    ij   misc  1  -  rhd  "SWDOWN"    "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWN    ij   misc  1  -  rhd  "LWDOWN"    "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rhd  "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rhd  "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rd   "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rd   "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rd   "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                         -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+state  real  QDUST     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUST"      "Dust mixing ratio"          "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+####
+#### variables dans wrf
+####
+state  real   albedo_gcm      ij   misc  1  -  i012rd  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012rd  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012rd  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012rd  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012rd  "MARS_CICE"   "co2 ice"                 "kg"
+state  real   mars_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"  "soil temperatures"       "K"
+state  real   mars_gw        ilj   misc  1  -  i012rd  "MARS_GW"     "gwparam"                 " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      r        "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              0       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains     max_domains    5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    0       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.  ir    "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             0       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    4       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+package   dust         mars==2                      -              moist:qv;scalar:qdust 
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.NMM
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.NMM	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.NMM	(revision 2744)
@@ -0,0 +1,1011 @@
+# Registry file NMM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain           x          west_east
+dimspec    j      3     standard_domain           y          south_north
+dimspec    k      2     standard_domain           z          bottom_top
+dimspec    l      2     namelist=num_soil_layers  z          soil_layers
+dimspec    w      -     namelist=spec_bdy_width   c          spec_bdy_width
+dimspec    u      2     namelist=num_land_cat     z          land_cat
+dimspec    s      2     namelist=num_soil_cat     z          soil_cat
+dimspec    e      3     namelist=ensdim           z          gd ensemble dimension
+dimspec    p      -     constant=7501             c          microphysics_rstrt_state
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    g      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    o      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+
+
+#### 7. Edit the Registry file and create the state data assocaited with this
+####    solver.  Single entry:
+state real x ikj dyn_exp 2 - ih "TOYVAR"
+####
+
+################################################################################
+################################################################################
+################################################################################
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#
+# It is reauired that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+#
+state    real  LU_INDEX         ij      misc        1         -     irh01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+################################################################################
+################################################################################
+
+# Variables for nmm dynamics                                            
+#
+# module_BC
+#
+# pdb is only 2d but registry doesn't support 2d bdy arrays right now...
+#definitions for NMM slab arrays
+dimspec    q      -     constant=2600             c  # a little crude right now
+dimspec    v      -     constant=1             c  # a little crude right now
+
+#
+# module_LOOPS
+#
+state integer  lmh      ij     dyn_nmm     1      -      irh      "LMH"     "Lowest model layer at mass points from domain top"       ""
+state integer  lmv      ij     dyn_nmm     1      -      irh      "LMV"     "Lowest model layer at velocity points from domain top"   ""
+#
+# module_MASKS
+#
+state  real   hbm2      ij     dyn_nmm     1      -      irh     "HBM2"    "Height boundary mask; =0 outer 2 rows on H points"       "" 
+state  real   hbm3      ij     dyn_nmm     1      -      irh     "HBM3"    "Height boundary mask; =0 outer 3 rows on H points"       ""
+state  real   vbm2      ij     dyn_nmm     1      -      irh     "VBM2"    "Velocity boundary mask; =0 outer 2 rows on V points"     ""
+state  real   vbm3      ij     dyn_nmm     1      -      irh     "VBM3"    "Velocity boundary mask; =0 outer 3 rows on V points"     ""
+state  real   sm        ij     dyn_nmm     1      -      i01rh   "SM"      "Sea mask; =1 for sea, =0 for land"                       ""
+state  real   sice      ij     dyn_nmm     1      -      irh     "SICE"    "Sea ice mask; =1 for sea ice, =0 for no sea ice"         ""
+state  real   htm       ikj    dyn_nmm     1      -      rh      "HTM"     "Height mask; =1 at all mass points above ground"         ""
+state  real   vtm       ikj    dyn_nmm     1      -      rh      "VTM"     "Velocity mask; =1 at all velocity points above ground"   ""
+#
+# module_VRBLS
+#
+state  integer ntsd     -       dyn_nmm    -      -      r       "NTSD"    "Number of timesteps done"                      ""
+state  integer nstart_hour  -   dyn_nmm    -      -      r       "NSTART_HOUR"   "Forecast hour at start of integration"   ""
+state  real   pd        ijb     dyn_nmm    1      -      i01rh   "PD"      "Mass at I,J in the sigma domain"               "Pa"
+state  real   fis       ij      dyn_nmm    1      -      i01rh   "FIS"     "Surface geopotential"                          "m2 s-2"
+state  real   res       ij      dyn_nmm    1      -      irh     "RES"     "Reciprocal of surface sigma"                   ""
+state  real   t         ikjb    dyn_nmm    1      -      i01rh   "T"       "Sensible temperature"                          "K"
+state  real   q         ikjb    dyn_nmm    1      -      i01rh   "Q"       "Specific humidity"                             "kg kg-1"
+state  real   u         ikjb    dyn_nmm    1      -      i01rh   "U"       "U component of wind"                           "m s-1"
+state  real   v         ikjb    dyn_nmm    1      -      i01rh   "V"       "V component of wind"                           "m s-1"
+state  real   told      ikj     dyn_nmm    1      -      r       "TOLD"    "T from previous timestep"                      "K"
+state  real   uold      ikj     dyn_nmm    1      -      r       "UOLD"    "U from previous timestep"                      "m s-1"
+state  real   vold      ikj     dyn_nmm    1      -      r       "VOLD"    "V from previous timestep"                      "m s-1"
+#
+# module_DYNAM
+#
+state  real   dx_nmm    ij     dyn_nmm     1      -      irh     "DX_NMM"  "East-west distance H-to-V points"              "m"
+state  real   wpdar     ij     dyn_nmm     1      -      ir             
+state  real   cpgfu     ij     dyn_nmm     1      -      ir
+state  real   curv      ij     dyn_nmm     1      -      ir      "CURV"    "Curvature term= .5*DT*TAN(phi)/RadEarth"       "s m-1"
+state  real   fcp       ij     dyn_nmm     1      -      ir
+state  real   fdiv      ij     dyn_nmm     1      -      ir
+state  real   f         ij     dyn_nmm     1      -      ir      "F"       "Coriolis * DT/2"                               ""
+state  real   fad       ij     dyn_nmm     1      -      ir
+state  real   ddmpu     ij     dyn_nmm     1      -      ir      "DDMPU"   "Divergence damping term for U"                 "m"
+state  real   ddmpv     ij     dyn_nmm     1      -      ir      "DDMPV"   "Divergence damping term for V"                 "m"
+state  real   deta      k      dyn_nmm     1      -      i01r    "DETA"    "Delta sigma in sigma domain"                   ""
+state  real   rdeta     k      dyn_nmm     1      -      ir      "RDETA"   "Reciprocal of DETA"                            ""
+state  real   aeta      k      dyn_nmm     1      -      i01r   
+state  real   f4q2      k      dyn_nmm     1      -      ir    
+state  real   etax      k      dyn_nmm     1      -      i01r
+state  real   dfl       k      dyn_nmm     1      Z      i01r    "DFL"     "Standard atmosphere geopotential"              "m2 s-2"
+state  real   deta1     k      dyn_nmm     1      -      i01r    "DETA1"   "Delta sigma in pressure domain"                ""
+state  real   aeta1     k      dyn_nmm     1      -      i01r    "AETA1"   "Midlayer sigma value in pressure domain"       ""
+state  real   eta1      k      dyn_nmm     1      -      i01rh   "ETA1"    "Interface sigma value in pressure domain"      ""
+state  real   deta2     k      dyn_nmm     1      -      i01r    "DETA2"   "Delta sigma in sigma domain"                   ""
+state  real   aeta2     k      dyn_nmm     1      -      i01r    "AETA2"   "Midlayer sigma value in sigma domain"          ""
+state  real   eta2      k      dyn_nmm     1      -      i01rh   "ETA2"    "Interface sigma value in sigma domain"         ""
+state  real   em        q      dyn_nmm     1      -      ir
+state  real   emt       q      dyn_nmm     1      -      ir
+state  real   adt       ikj    dyn_nmm     1      -      -       "ADT"     "Change of T due to advection"                  "K"
+state  real   adu       ikj    dyn_nmm     1      -      -       "ADU"     "Change of U due to advection"                  "m s-1"
+state  real   adv       ikj    dyn_nmm     1      -      -       "ADV"     "Change of V due to advection"                  "m s-1"
+state  real   em_loc    q      dyn_nmm     1      -      r
+state  real   emt_loc   q      dyn_nmm     1      -      r
+state  real   dy_nmm    -      dyn_nmm     -      -      ir      "DY_NMM"  "North-south distance H-to-V points"            "m"
+state  real   cpgfv     -      dyn_nmm     -      -      ir
+state  real   en        -      dyn_nmm     -      -      ir
+state  real   ent       -      dyn_nmm     -      -      ir
+state  real   f4d       -      dyn_nmm     -      -      ir
+state  real   f4q       -      dyn_nmm     -      -      ir
+state  real   ef4t      -      dyn_nmm     -      -      ir
+state  logical upstrm   -      dyn_nmm     -      -      -       "UPSTRM"  ".TRUE. => In upstream advec region of grid"    ""
+state  real   dlmd      -      dyn_nmm     -      -      ir      "DLMD"    "East-west angular distance H-to-V points"      "degrees"
+state  real   dphd      -      dyn_nmm     -      -      ir      "DPHD"    "North-south angular distance H-to-V points"    "degrees"
+state  real   pdtop     -      dyn_nmm     -      -      i01rh   "PDTOP"   "Mass at I,J in pressure domain"                "Pa"
+state  real   pt        -      dyn_nmm     -      -      i01rh   "PT"      "Pressure at top of domain"                     "Pa"
+#
+# module_CONTIN
+#
+state  real   pdsl      ij     dyn_nmm     1      -      -       "PDSL"    "Sigma-domain pressure at sigma=1"           "Pa"
+state  real   pdslo     ij     dyn_nmm     1      -      -       "PDSLO"   "PDSL from previous timestep"                "Pa"
+state  real   psdt      ij     dyn_nmm     1      -      r       "PSDT"    "Surface pressure tendency"                  "Pa s-1"
+state  real   div       ikj    dyn_nmm     1      -      r       "DIV"     "Divergence"                                 "Pa s-1"
+state  real   few       ikj    dyn_nmm     1      -      -       "FEW"     "Integrated east-west mass flux"             "Pa m2 s-1"
+state  real   fne       ikj    dyn_nmm     1      -      -       "FNE"     "Integrated northeast-southwest mass flux"   "Pa m2 s-1"
+state  real   fns       ikj    dyn_nmm     1      -      -       "FNS"     "Integrated north-south mass flux"           "Pa m2 s-1"
+state  real   fse       ikj    dyn_nmm     1      -      -       "FSE"     "Integrated southeast-northwest mass flux"   "Pa m2 s-1"
+state  real   omgalf    ikj    dyn_nmm     1      -      r       "OMGALF"  "Omega-alpha"                                "K"
+state  real   petdt     ikj    dyn_nmm     1      -      -       "PETDT"   "Vertical mass flux"                         "Pa s-1"
+state  real   rtop      ikj    dyn_nmm     1      -      r       "RTOP"    "Rd * Tv / P"                                "m3 kg-1"
+#
+# module_PVRBLS
+#
+state real  pblh        ij    dyn_nmm   1    -     rh       "PBLH"     "PBL Height"                           "m"
+state integer lpbl      ij    dyn_nmm   1    -     ir       "LPBL"     "Model layer of PBL top"               ""
+state  real   ustar     ij    dyn_nmm   1    -     irh      "USTAR"    "Friction velocity"                    "m s-1"
+state  real   z0        ij    dyn_nmm   1    -     i01rh    "Z0"       "Roughness height"                     "m"
+state  real   z0base    ij    dyn_nmm   1    -     ir       "Z0BASE"   "Base roughness height"                "m"
+state  real   ths       ij    dyn_nmm   1    -     irh      "THS"      "Surface potential temperature"        "K"
+state  real   mavail    ij    dyn_nmm   1    -     i
+state  real   qsh       ij    dyn_nmm   1    -     irh      "QS"       "Surface specific humidity"            "kg kg-1"
+state  real   twbs      ij    dyn_nmm   1    -     irh      "TWBS"     "Instantaneous sensible heat flux"     "W m-2"
+state  real   qwbs      ij    dyn_nmm   1    -     irh      "QWBS"     "Instantaneous latent heat flux"       "W m-2"
+state  real   prec      ij    dyn_nmm   1    -     rh       "PREC"     "Precipitation in physics timestep"    "m"
+state  real   aprec     ij    dyn_nmm   1    -     rh
+state  real   acprec    ij    dyn_nmm   1    -     rh       "ACPREC"   "Accumulated total precipitation"      "m"
+state  real   cuprec    ij    dyn_nmm   1    -     rh       "CUPREC"   "Accumulated convective precipitation" "m"
+state  real   lspa      ij    dyn_nmm   1    -     h        "LSPA"     "Land Surface Precipitation Accumulation"   "kg m-2"
+state  real   ddata     ij    dyn_nmm   1    -     -        "DDATA"    "Observed precip to each physics timestep"  "kg m-2"
+state  real   accliq    ij    dyn_nmm   1    -     r
+state  real   sno       ij    dyn_nmm   1    -     irh      "SNO"      "Liquid water snow amount"             "m"
+state  real   si        ij    dyn_nmm   1    -     irh      "SI"       "Snow depth"                           "m"
+state  real   cldefi    ij    dyn_nmm   1    -     rh       "CLDEFI"   "Convective cloud efficiency"          ""
+state  real   deep      ij    dyn_nmm   1    -     r        "DEEP"     "Deep convection =>.TRUE."             ""
+state  real   rf        ij    dyn_nmm   1    -     r
+state  real   th10      ij    dyn_nmm   1    -     irh      "TH10"     "10-m potential temperature"           "K"
+state  real   q10       ij    dyn_nmm   1    -     irh      "Q10"      "10-m specific humidity"               "kg kg-1"
+state  real   pshltr    ij    dyn_nmm   1    -     irh      "PSHLTR"   "2-m pressure"                         "Pa"
+state  real   tshltr    ij    dyn_nmm   1    -     irh      "TSHLTR"   "2-m sensible temperature"             "K"
+state  real   qshltr    ij    dyn_nmm   1    -     irh      "QSHLTR"   "2-m specific humidity"                "kg kg-1"
+state  real   q2        ikjb  dyn_nmm   1    -     irh      "Q2"       "2 * Turbulence kinetic energy"        "m2 s-2"
+state  real   t_adj     ikj   dyn_nmm   1    -     r        "T_ADJ"    "T change due to precip in phys step"  "K"
+state  real   t_old     ikj   dyn_nmm   1    -     r        "T_OLD"    "T before last call to precip"         "K"
+state  real   zero_3d   ikj   dyn_nmm   1    -     r
+state  real   W0AVG     ikj   dyn_nmm   1    -     r        "W0AVG" "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"  "m s-1"
+state  real   AKHS_OUT  ij    dyn_nmm   1    -     h        "AKHS_OUT"  "Output sfc exch coeff for heat"               "m2 s-1"
+state  real   AKMS_OUT  ij    dyn_nmm   1    -     h        "AKMS_OUT"  "Output sfc exch coeff for momentum"           "m2 s-1"    
+#
+# module_PHYS
+#
+state  real   albase    ij    dyn_nmm   1    -     i01rh    "ALBASE"    "Base albedo"            ""
+state  real   albedo    ij    dyn_nmm   1    -     irh      "ALBEDO"    "Dynamic albedo"         ""
+state  real   cnvbot    ij    dyn_nmm   1    -     irh      "CNVBOT"    "Lowest convec cloud bottom lyr between outputs"  ""
+state  real   cnvtop    ij    dyn_nmm   1    -     irh      "CNVTOP"    "Highest convec cloud top lyr between outputs"    ""
+state  real   czen      ij    dyn_nmm   1    -     irh      "CZEN"      "Cosine of solar zenith angle"                    ""
+state  real   czmean    ij    dyn_nmm   1    -     irh      "CZMEAN"    "Mean CZEN between SW radiation calls"            ""
+state  real   epsr      ij    dyn_nmm   1    -     ir       "EPSR"      "Radiative emissivity"                            ""
+state  real   gffc      ij    dyn_nmm   1    -     ir
+state  real   glat      ij    dyn_nmm   1    -     i01rh    "GLAT"      "Geographic latitude, radians"                    ""
+state  real   glon      ij    dyn_nmm   1    -     i01rh    "GLON"      "Geographic longitude, radians"                   ""
+state  real   NMM_TSK   ij    dyn_nmm   1    -     i01r     "TSK"       "Skin temperature"                                "K"
+state  real   hdac      ij    dyn_nmm   1    -     ir       "HDAC"      "Composite diffusion coeff for mass points"       "s m-1"
+state  real   hdacv     ij    dyn_nmm   1    -     ir       "HDACV"     "Composite diffusion coeff for velocity points"   "s m-1"
+state  real   mxsnal    ij    dyn_nmm   1    -     i01rh    "MXSNAL"    "Maximum deep snow albedo"                        ""
+state  real   radin     ij    dyn_nmm   1    -     r                        
+state  real   radot     ij    dyn_nmm   1    -     rh       "RADOT"     "Radiative emission from surface"                 "W m-2"
+state  real   sigt4     ij    dyn_nmm   1    -     rh       "SIGT4"     "Stefan-Boltzmann * T**4"                         "W m-2"
+state  real   tg        ij    dyn_nmm   1    -     i01rh    "TGROUND"   "Deep ground soil temperature"                    "K"
+state  real   dfrlg     k     dyn_nmm   1    Z     i01r     "DFRLG"     "Std atmosphere height of model layer interfaces" "m"
+state integer lvl       ij    dyn_nmm   1    -     ir
+#
+# module_CLDWTR.F
+#
+state  real   cwm       ikjb  dyn_nmm   1    -     rh       "CWM"       "Total condensate"                     "kg kg-1"
+state  real   f_ice     ikj   dyn_nmm   1    -     rh       "F_ICE"     "Frozen fraction of CWM"               ""
+state  real   f_rain    ikj   dyn_nmm   1    -     rh       "F_RAIN"    "Rain fraction of liquid part of CWM"  ""
+state  real   f_rimef   ikj   dyn_nmm   1    -     rh       "F_RIMEF"   "Rime factor"                          ""
+state  real   cldfra    ikj   dyn_nmm   1    -     rh       "CLDFRA"    "Cloud fraction"                       ""
+state  real   sr        ij    dyn_nmm   1    -     irh      "SR"        "Timestep mass ratio of snow:precip"   ""
+state  real   cfrach    ij    dyn_nmm   1    -     rh       "CFRACH"    "High cloud fraction"                  ""
+state  real   cfracl    ij    dyn_nmm   1    -     rh       "CFRACL"    "Low cloud fraction"                   ""
+state  real   cfracm    ij    dyn_nmm   1    -     rh       "CFRACM"    "Middle cloud fraction"                ""
+state logical micro_start        -     dyn_nmm   -    -     -
+#
+# module_SOIL.F
+#
+state integer islope    ij    dyn_nmm   1    -     i01rh
+state  real   dzsoil    k     dyn_nmm   1    -     ir       "DZSOIL"    "Thickness of soil layers"         "m"
+state  real   rtdpth    k     dyn_nmm   1    -     i01r 
+state  real   sldpth    k     dyn_nmm   1    -     i01rh    "SLDPTH"    "Thickness of soil layers"         "m"
+state  real   cmc       ij    dyn_nmm   1    -     i01rh    "CMC"       "Canopy moisture"                  "m"
+state  real   grnflx    ij    dyn_nmm   1    -     irh      "GRNFLX"    "Deep soil heat flux"              "W m-2"
+state  real   pctsno    ij    dyn_nmm   1    -     irh
+state  real   soiltb    ij    dyn_nmm   1    -     i01rh    "SOILTB"    "Deep ground soil temperature"     "K"
+state  real   vegfrc    ij    dyn_nmm   1    -     i01rh    "VEGFRC"    "Vegetation fraction"              ""
+state  real   shdmin    ij    dyn_nmm   1    -     -
+state  real   shdmax    ij    dyn_nmm   1    -     -
+state  real   sh2o      ilj   dyn_nmm   1    Z     irh      "SH2O"      "Unfrozen soil moisture volume fraction"  ""
+state  real   smc       ilj   dyn_nmm   1    Z     irh      "SMC"       "Soil moisture volume fraction"    ""
+state  real   stc       ilj   dyn_nmm   1    Z     irh      "STC"       "Soil temperature"                 "K"
+#
+# module_NHYDRO.F
+#
+state logical hydro     -     dyn_nmm   -    -     -        "HYDRO"     ".FALSE. => nonhydrostatic"        ""
+state  real   dwdtmn    ij    dyn_nmm   1    -     -        "DWDTMN"    "Minimum value for DWDT"           "m s-2"
+state  real   dwdtmx    ij    dyn_nmm   1    -     -        "DWDTMX"    "Maximum value for DWDT"           "m s-2"
+state  real   dwdt      ikj   dyn_nmm   1    -     r        "DWDT"      "dwdt and 1+(dwdt)/g"              "m s-2"
+state  real   pdwdt     ikj   dyn_nmm   1    -     r   
+state  real   pint      ikj   dyn_nmm   1    Z     rh       "PINT"      "Model layer interface pressure"   "Pa"
+state  real   w         ikj   dyn_nmm   1    Z     rh       "W"         "Vertical velocity"                "m s-1"
+state  real   z         ikj   dyn_nmm   1    Z     -        "Z"         "Distance from ground"             "m"
+#
+# module_ACCUM.F
+#
+state  real   acfrcv    ij    dyn_nmm     1    -    h     "ACFRCV"    "Accum convective cloud fraction"   ""
+state  real   acfrst    ij    dyn_nmm     1    -    h     "ACFRST"    "Accum stratiform cloud fraction"   ""
+state  real   ssroff    ij    dyn_nmm     1    -    h     "SSROFF"    "Surface runoff"                    "mm"                  
+state  real   bgroff    ij    dyn_nmm     1    -    h     "BGROFF"    "Subsurface runoff"                 "mm"
+state  real   rlwin     ij    dyn_nmm     1    -    rh    "RLWIN"     "Downward longwave at surface"      "W m-2"
+state  real   rlwout    ij    dyn_nmm     1    -    -
+state  real   rlwtoa    ij    dyn_nmm     1    -    rh    "RLWTOA"    "Outgoing LW flux at top of atmos"  "W m-2"
+state  real   alwin     ij    dyn_nmm     1    -    h     "ALWIN"     "Accum LW down at surface"          "W m-2"
+state  real   alwout    ij    dyn_nmm     1    -    h     "ALWOUT"    "Accum RADOT (see above)"           "W m-2"
+state  real   alwtoa    ij    dyn_nmm     1    -    h     "ALWTOA"    "Accum RLWTOA"                      "W m-2"
+state  real   rswin     ij    dyn_nmm     1    -    rh    "RSWIN"     "Downward shortwave at surface"     "W m-2"
+state  real   rswinc    ij    dyn_nmm     1    -    rh    "RSWINC"    "Clear-sky equivalent of RSWIN"     "W m-2"
+state  real   rswout    ij    dyn_nmm     1    -    rh    "RSWOUT"    "Upward shortwave at surface"       "W m-2"
+state  real   rswtoa    ij    dyn_nmm     1    -    -     "RSWTOA"    "Outgoing SW flux at top of atmos"  "W m-2"
+state  real   aswin     ij    dyn_nmm     1    -    h     "ASWIN"     "Accum SW down at surface"          "W m-2"
+state  real   aswout    ij    dyn_nmm     1    -    h     "ASWOUT"    "Accum RSWOUT"                      "W m-2"
+state  real   aswtoa    ij    dyn_nmm     1    -    h     "ASWTOA"    "Accum RSWTOA"                      "W m-2"
+state  real   sfcshx    ij    dyn_nmm     1    -    rh    "SFCSHX"    "Accum sfc sensible heat flux"      "W m-2"
+state  real   sfclhx    ij    dyn_nmm     1    -    rh    "SFCLHX"    "Accum sfc latent heat flux"        "W m-2"
+state  real   subshx    ij    dyn_nmm     1    -    rh    "SUBSHX"    "Accum deep soil heat flux"         "W m-2"
+state  real   snopcx    ij    dyn_nmm     1    -    rh    "SNOPCX"    "Snow phase change heat flux"       "W m-2"
+state  real   sfcuvx    ij    dyn_nmm     1    -    rh
+state  real   potevp    ij    dyn_nmm     1    -    rh    "POTEVP"    "Accum potential evaporation"       "m"
+state  real   potflx    ij    dyn_nmm     1    -    rh    "POTFLX"    "Energy equivalent of POTEVP"       "W m-2"
+state  real   tlmin     ij    dyn_nmm     1    -    h
+state  real   tlmax     ij    dyn_nmm     1    -    h
+state  real   rlwtt     ikj   dyn_nmm     1    -    rh    "RLWTT"     "Longwave temperature tendency"     "K s-1"
+state  real   rswtt     ikj   dyn_nmm     1    -    rh    "RSWTT"     "Shortwave temperature tendency"    "K s-1"
+state  real   tcucn     ikj   dyn_nmm     1    -    h     "TCUCN"     "Accum convec temperature tendency" "K s-1"
+state  real   train     ikj   dyn_nmm     1    -    h     "TRAIN"     "Accum stratiform temp tendency"    "K s-1"
+state integer ncfrcv    ij    dyn_nmm     1    -    irh   "NCFRCV"    "# times convec cloud >0 between rad calls"  ""
+state integer ncfrst    ij    dyn_nmm     1    -    irh   "NCFRST"    "# times stratiform cloud >0 between rad calls"  ""
+state integer nphs0     -     dyn_nmm     -    -    rh
+state integer nprec     -     dyn_nmm     -    -    irh   "NPREC"     "# timesteps between resetting precip bucket"  ""
+state integer nclod     -     dyn_nmm     -    -    irh   "NCLOD"     "# timesteps between resetting cloud frac accum"    ""
+state integer nheat     -     dyn_nmm     -    -    irh   "NHEAT"     "# timesteps between resetting latent heat accum"   ""
+state integer nrdlw     -     dyn_nmm     -    -    irh   "NRDLW"     "# timesteps between resetting longwave accums"   ""
+state integer nrdsw     -     dyn_nmm     -    -    irh   "NRDSW"     "# timesteps between resetting shortwave accums"   ""
+state integer nsrfc     -     dyn_nmm     -    -    irh   "NSRFC"     "# timesteps between resetting sfcflux accums"   ""
+state  real   avrain    -     dyn_nmm     -    -    irh   "AVRAIN"    "# of times gridscale precip called in NHEAT steps"   ""
+state  real   avcnvc    -     dyn_nmm     -    -    irh   "AVCNVC"    "# of times convective precip called in NHEAT steps"   ""
+state  real   aratim    -     dyn_nmm     -    -    ir
+state  real   acutim    -     dyn_nmm     -    -    irh
+state  real   ardlw     -     dyn_nmm     -    -    irh   "ARDLW"     "# of times LW fluxes summed before resetting"   ""
+state  real   ardsw     -     dyn_nmm     -    -    irh   "ARDSW"     "# of times SW fluxes summed before resetting"   ""
+state  real   asrfc     -     dyn_nmm     -    -    irh   "ASRFC"     "# of times sfc fluxes summed before resetting"   ""  
+state  real   aphtim    -     dyn_nmm     -    -    irh
+#
+# module_INDX.F
+#
+state integer ihe       j    dyn_nmm     1    -    -      "IHE"   "0 or +1 to obtain I index of V point east of H point"  ""
+state integer ihw       j    dyn_nmm     1    -    -      "IHW"   "0 or -1 to obtain I index of V point west of H point"  ""
+state integer ive       j    dyn_nmm     1    -    -      "IVE"   "0 or +1 to obtain I index of H point east of V point"  ""
+state integer ivw       j    dyn_nmm     1    -    -      "IVW"   "0 or -1 to obtain I index of H point west of V point"  ""
+state integer irad      i    dyn_nmm     1    -    -
+#definitions for NMM east-west orientation on E grid
+state integer iheg      q    dyn_nmm     1    -    -
+state integer ihwg      q    dyn_nmm     1    -    -
+state integer iveg      q    dyn_nmm     1    -    -
+state integer ivwg      q    dyn_nmm     1    -    -
+dimspec    r      -     constant=2000             c  # a little crude right now
+state integer iradg     r    dyn_nmm     1    -    -
+dimspec    m      -     constant=(-3:3)            c
+dimspec    n      -     constant=(0:6)             c
+state integer indx3_wrk mqn  dyn_nmm     1    -    -      "INDX3_WRK"  "Array of 3rd (J) indices for local arrays"  ""
+state integer n_iup_h   j    dyn_nmm     1    -    -      "N_IUP_H"    "# mass points needed in each row for upstream advection"  ""
+state integer n_iup_v   j    dyn_nmm     1    -    -      "N_IUP_V"    "# velocity points needed in each row for upstream advection"  ""
+state integer n_iup_adh j    dyn_nmm     1    -    -      "N_IUP_ADH"  "# mass points in each row of upstream advection"  ""
+state integer n_iup_adv j    dyn_nmm     1    -    -      "N_IUP_ADV"  "# velocity points in each row of upstream advection"  ""
+state integer iup_h     ij   dyn_nmm     1    -    -
+state integer iup_v     ij   dyn_nmm     1    -    -
+state integer iup_adh   ij   dyn_nmm     1    -    -
+state integer iup_adv   ij   dyn_nmm     1    -    -
+state integer imicrogram -   misc        -    -    r   "imicrogram"  "flag 0/1 0=mixratio, 1=mcrograms/m3"  ""
+
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     -
+state    integer imask_xstag          ij      misc     X
+state    integer imask_ystag          ij      misc     Y
+state    integer imask_xystag         ij      misc     XY
+#                                               
+#---------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#---------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "description"  "units"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "description"  "units"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "description"  "units"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "description"  "units"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "description"  "units"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "description"  "units"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "description"  "units"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "description"  "units"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "description"  "units"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "description"  "units"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "description"  "units"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "description"  "units"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "description"  "units"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "description"  "units"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "description"  "units"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "description"  "units"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "description"  "units"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "description"  "units"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "description"  "units"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "description"  "units"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "description"  "units"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "description"  "units"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "description"  "units"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "description"  "units"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "description"  "units"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "description"  "units"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "description"  "units"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "description"  "units"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "description"  "units"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "description"  "units"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "description"  "units"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "description"  "units"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "description"  "units"
+state   real   landmask            ij    misc          1     -     i01rh   "LANDMASK"      "description"  "units"
+state   real   topostdv            ij    misc          1     -     i1      "TOPOSTDV"      "description"  "units"
+state   real   toposlpx            ij    misc          1     -     i1      "TOPOSLPX"      "description"  "units"
+state   real   toposlpy            ij    misc          1     -     i1      "TOPOSLPY"      "description"  "units"
+state   real   greenmax            ij    misc          1     -     i1      "GREENMAX"      "description"  "units"
+state   real   greenmin            ij    misc          1     -     i1      "GREENMIN"      "description"  "units"
+state   real   albedomx            ij    misc          1     -     i1      "ALBEDOMX"      "description"  "units"
+state   real   slopecat            ij    misc          1     -     i1      "SLOPECAT"      "description"  "units"
+state   real   toposoil            ij    misc          1     -     i1      "TOPOSOIL"      "description"  "units"
+state   real   landusef            iuj   misc          1     Z     i1      "LANDUSEF"      "description"  "units"
+state   real   soilctop            isj   misc          1     Z     i1      "SOILCTOP"      "description"  "units"
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "description"  "units"
+
+#-------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#-------------------------------------------------------------------------------------------------------------------------------
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+
+# Moist Scalars  - both height and mass coordinate models
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjft   moist       1         -     -    -                                       
+state   real    qv             ikjft   moist       1         -     r       "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjft   moist       1         -     r       "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjft   moist       1         -     r       "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjft   moist       1         -     r       "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjft   moist       1         -     rh      "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjft   moist       1         -     r       "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+#                                               
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -    -
+state   real    qni            ikjftb  scalar      1         -     i01rusdf=(bdy_interp:dt)       "QNI"              "Ice Number concentration" "# kg(-1)"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+## Chem Scalars  - both height and mass coordinate models                                       
+#                                               
+state   real    -              ikjft   chem        1         -     -    -                                       
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# specified LBC arrays, first, Eulerian height coordinate model
+
+
+# specified LBC arrays, next, Eulerian mass coordinate model
+
+
+# specified LBC  variables shared between the mass and height coordinate models
+
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+
+
+# 2m and 10m output diagnostics
+
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     rh       "SMOIS"                "SOIL MOISTURE" ""
+state    real   TSLB             ilj     -          1         Z     r       "TSLB" "SOIL TEMPERATURE" ""
+
+
+# MYJ PBL variables
+
+
+# gfdl (eta) radiation State Variables
+
+# eta microphpysics State Variables
+
+
+# new eta microphpysics State Variables
+
+#  some mass-coordinate-model-specific variables
+
+
+
+
+
+
+# was em_only
+
+#################################################################
+# Physics Variables (em core)
+                                                
+                                                
+                                                
+#################################################################
+# Physics Variables (eh core) ; should be same as em
+                                                
+                                                
+
+                                                
+#################################################################
+# variables added for CHEMISTRY compatibility with ARW core - kludge
+#################################################################
+state    real   GSW             ij     misc        1         -      -       ""                 ""
+state    real   XLAT            ij     misc        1         -      -       ""                 ""
+state    real   XLONG           ij     misc        1         -      -       ""                 ""
+state    real   XLAND           ij     misc        1         -      -       ""                 ""
+state    real   RAINCV          ij     misc        1         -      -       ""                 ""
+
+#################################################################
+# other misc variables (all cores)
+#################################################################
+
+# added for surface_driver
+state    real   PSFC             ij     misc        1         -      rh       "PSFC"                 "SFC PRESSURE"
+state    real   dtbc            -       misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+state    real   TH2              ij     misc        1         -     irh       "TH2"                  "POT TEMP at 2 M" ""
+state    real   T2               ij     misc        1         -     ir        "T2"                  "TEMP at 2 M" ""
+state    real   U10              ij     misc        1         -     irh       "U10"                  "U at 10 M"         " "
+state    real   V10              ij     misc        1         -     irh       "V10"                  "V at 10 M"         " "
+state    real   XICE             ij     misc        1         -     i01r      "XICE"                 "SEA ICE"         ""
+state    real   SMSTAV           ij     misc        1         -     irh       "SMSTAV"               "MOISTURE VARIBILITY" ""
+state    real   SMSTOT           ij     misc        1         -     irh     "SMSTOT"               "TOTAL SOIL MOISTURE" ""
+state    real   SFCRUNOFF        ij     misc        1         -     rh       "SFROFF"               "SURFACE RUNOFF" ""
+state    real   UDRUNOFF         ij     misc        1         -     rh       "UDROFF"               "UNDERGROUND RUNOFF" ""
+state  integer  IVGTYP           ij     misc        1         -     irh       "IVGTYP"               "VEGETATION TYPE" ""
+state  integer  ISLTYP           ij     misc        1         -     irh       "ISLTYP"               "SOIL TYPE"         " "
+state    real   VEGFRA           ij     misc        1         -     i01rh       "VEGFRA"               "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -     irh     "SFCEVP"               "SURFACE EVAPORATION" ""
+state    real   GRDFLX           ij     misc        1         -     irh     "GRDFLX"               "GROUND HEAT FLUX" ""
+state    real   ALBBCK           ij     misc        1         -     i012r   "ALBBCK"          "BACKGROUND ALBEDO"        "NA"
+state    real   SFCEXC           ij     misc        1         -     irh     "SFCEXC "              "SURFACE EXCHANGE COEFFICIENT"         ""
+state    real   ACSNOW           ij     misc        1         -     irh       "ACSNOW"               "ACCUMULATED SNOW" ""
+state    real   ACSNOM           ij     misc        1         -     irh       "ACSNOM"               "ACCUMULATED MELTED SNOW"         ""
+state    real   RMOL             ij     misc        1         -     ir       "RMOL"               ""         ""
+state    real   SNOW             ij     misc        1         -     i01rh       "SNOW"                 "SNOW WATER EQUIVALENT"         ""
+state    real   CANWAT           ij     misc        1         -     i01rh       "CANWAT"               "CANOPY WATER" ""
+state    real   SST              ij     misc        1         -     i01rh       "SST"                  "SEA SURFACE TEMPERATURE" "K"
+state    real   WEASD            ij     misc        1         -     i01rh       "WEASD"                "WATER EQUIVALENT OF ACCUMULATED SNOW" ""
+state    real  ZNT              ij      misc        1         -     ir        "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"
+state    real  MOL              ij      misc        1         -     ir        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"
+
+state    real   tke_myj         ikj     misc        1         -     rh        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"     "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -      h        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H         ikj     misc        1         -     rh         "EXCH_H"               "EXCHANGE COEFFICIENTS FOR HEAT"               "m2 s-1"
+state   real   THZ0             ij     misc        1         -     irh       "THZ0"        "POT. TEMPERATURE AT TOP OF VISC. SUBLYR"       "K"
+state   real   QZ0              ij     misc        1         -     irh       "QZ0"         "SPECIFIC HUMIDITY AT TOP OF VISC. SUBLYR"      "kg kg-1"
+state   real   UZ0              ij     misc        1         -     irh       "UZ0"         "U WIND COMPONENT AT TOP OF VISC. SUBLYR"       "m s-1"
+state   real   VZ0              ij     misc        1         -     irh       "VZ0"         "V WIND COMPONENT AT TOP OF VISC. SUBLYR"       "m s-1"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+# added as state for HALO_NMM_TURBL, jm
+state   real   UZ0h              ij     misc        1         -     -       
+state   real   VZ0h              ij     misc        1         -     -       
+state   real   dudt              ikj     misc        1         -     -      
+state   real   dvdt              ikj     misc        1         -     -      
+
+state   real   QSFC             ij     misc        1         -     irh       "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -     ir        "AKHS"                  "SFC EXCH COEFF FOR HEAT /DELTA Z"             "m s-1"
+state   real   AKMS             ij     misc        1         -     ir        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM /DELTA Z"         "m s-1"    
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+state    real    HTOP            ij     misc        1         -     irh       "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -     irh       "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -     ir       "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"         ""
+state    real    HBOTR           ij     misc        1         -     ir       "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"         ""
+state    real    HTOPD           ij     misc        1         -     rh        "HTOPD"                "TOP DEEP CONVECTION LEVEL"         ""
+state    real    HBOTD           ij     misc        1         -     rh        "HBOTD"                "BOT DEEP CONVECTION LEVEL"         ""
+state    real    HTOPS           ij     misc        1         -     rh        "HTOPS"                "TOP SHALLOW CONVECTION LEVEL"         ""
+state    real    HBOTS           ij     misc        1         -     rh        "HBOTS"                "BOT SHALLOW CONVECTION LEVEL"         ""
+state    REAL      CUPPT         ij     misc        1         -     rh        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINCE LAST CALL TO THE RADIATION"         ""
+state    REAL      CPRATE        ij     misc        1         -     rh         "CPRATE"               "INSTANTANEOUS CONVECTIVE PRECIPITATION RATE"      ""   #  1-17-06a
+state    real    F_ICE_PHY       ikj    misc        1         -      -        "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      -        "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      -        "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"           "mb/hour"
+state    real  apr_gr           ij      misc        1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL "           "mm/hour"
+state    real  apr_w            ij      misc        1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W "           "mm/hour"
+state    real  apr_mc           ij      misc        1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"           "mm/hour"
+state    real  apr_st           ij      misc        1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY "           "mm/hour"
+state    real  apr_as           ij      misc        1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE "           "mm/hour"
+state    real  apr_capma        ij      misc        1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"           "mm/hour"
+state    real  apr_capme        ij      misc        1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"           "mm/hour"
+state    real  apr_capmi        ij      misc        1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"           "mm/hour"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1"
+
+state    real  RTHFTEN          ikj     misc        1         -      r       "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"         "K/sec"
+state    real  RQVFTEN          ikj     misc        1         -      r       "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"            "kg/sec"
+state    real   SNOWH            ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)      "SNOWH"                 "PHYSICAL SNOW DEPTH"  ""
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3"
+state    real   SMFR3D           ilj    misc        1         Z      rh       "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r         "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# added state for etampnew microphysics (needed for restarts)
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state       p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state      p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because the are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     -
+state    integer  landuse_lucats  -      misc       -          -     -
+state    integer  landuse_luseas  -      misc       -          -     -
+state    integer  landuse_isn     -      misc       -          -     -
+state    real     lu_state        p      misc       -          -     -
+
+
+#################################################################
+#                                               
+                                                
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     h         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     h         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -         "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+                                                
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+                                                
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1993    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      03    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      13    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      12    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1993    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      03    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      14    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      12    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control         max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+rconfig   real    tstart                  namelist,time_control     max_domains       0.       irh   "tstart"  "forecast hour at the start of the NMM integration"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       h     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       h     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+
+# Physics
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics      1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1             5       irh    "num_soil_layers"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics      1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics      1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+
+
+# nmm variables
+rconfig   integer idtad                   namelist,physics     max_domains    2       irh    "idtad"  "fundamental timesteps between calls to NMM passive advection scheme"
+rconfig   integer nsoil                   namelist,physics     max_domains    4       irh    "nsoil"  "number of soil layers"
+rconfig   integer nphs                    namelist,physics     max_domains   10       irh    "nphs"  "fundamental timesteps between calls to NMM turbulence"
+rconfig   integer ncnvc                   namelist,physics     max_domains   10       irh    "ncnvc"  "fundamental timesteps between calls to NMM convection"
+rconfig   integer nrads                   namelist,physics     max_domains  200       irh    "nrads"  "fundamental timesteps between calls to NMM shortwave radiation"
+rconfig   integer nradl                   namelist,physics     max_domains  200       irh    "nradl"  "fundamental timesteps between calls to NMM longwave radiation"
+rconfig   real    tprec                   namelist,physics     max_domains    3.      irh    "tprec"  "number of hours in bucket for total precipitation"
+rconfig   real    theat                   namelist,physics     max_domains    6.      irh    "theat"  "number of hours in bucket for gridscale and convective heating rates"
+rconfig   real    tclod                   namelist,physics     max_domains    6.      irh    "tclod"  "number of hours in bucket for cloud amounts"
+rconfig   real    trdsw                   namelist,physics     max_domains    6.      irh    "trdsw"  "number of hours in bucket for short wave fluxes"
+rconfig   real    trdlw                   namelist,physics     max_domains    6.      irh    "trdlw"  "number of hours in bucket for long wave fluxes"
+rconfig   real    tsrfc                   namelist,physics     max_domains    6.      irh    "tsrfc"  "number of hours in bucket for evaporation / sfc fluxes"
+rconfig   logical pcpflg                  namelist,physics     max_domains   .false.  irh    "pcpflg"  "logical switch that turns on/off the precipitation assimilation"
+rconfig   integer sigma                   namelist,physics     max_domains    1       irh    "sigma"  "logical switch for NMM vertical coordinate (sigma or hybrid)"
+rconfig   integer co2tf                   namelist,physics     1              0       -      "co2tf"  "GFDL radiation co2 flag"
+rconfig   integer ra_call_offset          namelist,physics     1             -1       -      "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             1       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             1       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    base_pres               namelist,dynamics     1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics     1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics     1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.2     h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.      h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.      h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    .1      h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    10      h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    3       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    3       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    100.    h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient      namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      ""
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      ""
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn     dyn_opt==0                   -             -
+package   dyn_nmm       dyn_opt==4                   -             -
+
+
+#### 9. Edit the Registry file to set up '5' as the value of the
+**** namelist variable dyn_opt that means to select our exp dyncore.
+package   dyn_exp       dyn_opt==5                   -             -
+
+#package   passivec1     chem_opt==0                  -
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qs
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             -
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             -
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   nmmlsmscheme   sf_surface_physics==99      -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# NMM communications
+
+#halo HALO_NMM_INIT_1	dyn_nmm 120:LMH,LMV,HBM2
+halo HALO_NMM_INIT_1	dyn_nmm 120:HBM2
+halo HALO_NMM_INIT_2	dyn_nmm 120:HBM3,VBM2,VBM3
+halo HALO_NMM_INIT_3	dyn_nmm 120:SM,SICE,HTM
+halo HALO_NMM_INIT_4	dyn_nmm 120:VTM,DX_NMM,WPDAR
+halo HALO_NMM_INIT_5	dyn_nmm 120:CPGFU,CURV,FCP
+halo HALO_NMM_INIT_6	dyn_nmm 120:FDIV,FAD,F
+halo HALO_NMM_INIT_7	dyn_nmm 120:DDMPU,DDMPV,GLAT
+halo HALO_NMM_INIT_8	dyn_nmm 120:GLON,EPSR,TG
+halo HALO_NMM_INIT_9	dyn_nmm 120:GFFC,SST,ALBASE
+#halo HALO_NMM_INIT_10	dyn_nmm 120:HDAC,HDACV,IVGTYP
+halo HALO_NMM_INIT_10	dyn_nmm 120:HDAC,HDACV
+#halo HALO_NMM_INIT_11	dyn_nmm 120:ISLTYP,ISLOPE,VEGFRC
+halo HALO_NMM_INIT_11	dyn_nmm 120:VEGFRC
+halo HALO_NMM_INIT_12	dyn_nmm 120:DIV,OMGALF,PD,RES
+halo HALO_NMM_INIT_13	dyn_nmm 120:FIS,T,U
+halo HALO_NMM_INIT_14	dyn_nmm 120:V,Q,Q2
+halo HALO_NMM_INIT_15	dyn_nmm 120:CWM,TRAIN,TCUCN
+halo HALO_NMM_INIT_15B	dyn_nmm 120:moist,scalar
+halo HALO_NMM_INIT_16	dyn_nmm 120:RSWIN,RSWOUT,TG
+halo HALO_NMM_INIT_17	dyn_nmm 120:Z0,AKMS,CZEN
+halo HALO_NMM_INIT_18	dyn_nmm 120:AKHS,THS,QSH
+halo HALO_NMM_INIT_19	dyn_nmm 120:TWBS,QWBS,HBOT
+halo HALO_NMM_INIT_20	dyn_nmm 120:CFRACL,THZ0,QZ0
+halo HALO_NMM_INIT_21	dyn_nmm 120:UZ0,VZ0,USTAR
+halo HALO_NMM_INIT_22	dyn_nmm 120:HTOP,CFRACM,SNO
+halo HALO_NMM_INIT_23	dyn_nmm 120:SI,CLDEFI,RF
+halo HALO_NMM_INIT_24	dyn_nmm 120:CUPPT,CFRACH,SOILTB
+halo HALO_NMM_INIT_25	dyn_nmm 120:SFCEXC,SMSTAV,SMSTOT
+halo HALO_NMM_INIT_26	dyn_nmm 120:GRNFLX,PCTSNO,RLWIN
+halo HALO_NMM_INIT_27	dyn_nmm 120:RADOT,CZMEAN,SIGT4
+halo HALO_NMM_INIT_28	dyn_nmm 120:SR
+halo HALO_NMM_INIT_29	dyn_nmm 120:PREC,ACPREC,ACCLIQ
+halo HALO_NMM_INIT_30	dyn_nmm 120:ACFRST,ACSNOW
+halo HALO_NMM_INIT_31	dyn_nmm 120:ACSNOM,SSROFF,BGROFF
+halo HALO_NMM_INIT_32	dyn_nmm 120:SFCSHX,SFCLHX,SUBSHX
+halo HALO_NMM_INIT_33	dyn_nmm 120:SNOPCX,SFCUVX,SFCEVP
+halo HALO_NMM_INIT_34	dyn_nmm 120:POTEVP,ASWIN,ASWOUT
+halo HALO_NMM_INIT_35	dyn_nmm 120:ASWTOA,ALWIN,ALWOUT
+halo HALO_NMM_INIT_36	dyn_nmm 120:ALWTOA,SMC,CMC
+halo HALO_NMM_INIT_37	dyn_nmm 120:STC,SH2O,ALBEDO
+halo HALO_NMM_INIT_38   dyn_nmm 120:PINT,Z,DWDT
+halo HALO_NMM_INIT_39	dyn_nmm 120:TOLD,UOLD,VOLD
+
+halo      HALO_NMM_A  dyn_nmm 24:pd,t,u,v,q,cwm,dwdt,div;24:pint                          
+halo      HALO_NMM_A_3  dyn_nmm 24:moist,scalar
+halo      HALO_NMM_B  dyn_nmm 24:div                   
+halo      HALO_NMM_C  dyn_nmm 8:u,v                    
+halo      HALO_NMM_D  dyn_nmm 24:pd          
+halo      HALO_NMM_E  dyn_nmm 24:petdt
+halo      HALO_NMM_F  dyn_nmm 24:t,u,v
+halo      HALO_NMM_F1 dyn_nmm 80:pdslo          
+halo      HALO_NMM_G  dyn_nmm 24:u,v;24:z                    
+halo      HALO_NMM_H  dyn_nmm 24:w,lmh
+halo      HALO_NMM_I  dyn_nmm 48:q,q2,cwm                    
+halo      HALO_NMM_I_3  dyn_nmm 48:moist,scalar
+halo      HALO_NMM_J  dyn_nmm 8:pd,uz0,vz0,t,q,cwm                    
+halo      HALO_NMM_J_3  dyn_nmm 8:moist,scalar                    
+halo      HALO_NMM_K  dyn_nmm 8:q2;24:t,u,v,q,w,z
+halo      HALO_NMM_L  dyn_nmm 8:pd,t,q,cwm,q2                    
+halo      HALO_NMM_L_3  dyn_nmm 8:moist,scalar
+
+halo      HALO_NMM_TURBL_A  dyn_nmm 8:uz0h,vz0h,hbm2
+halo      HALO_NMM_TURBL_B  dyn_nmm 8:dudt,dvdt
+
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.NMM_CHEM
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.NMM_CHEM	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.NMM_CHEM	(revision 2744)
@@ -0,0 +1,1504 @@
+# Registry file NMM_CHEM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain           x          west_east
+dimspec    j      3     standard_domain           y          south_north
+dimspec    k      2     standard_domain           z          bottom_top
+dimspec    l      2     namelist=num_soil_layers  z          soil_layers
+dimspec    w      -     namelist=spec_bdy_width   c          spec_bdy_width
+dimspec    u      2     namelist=num_land_cat     z          land_cat
+dimspec    s      2     namelist=num_soil_cat     z          soil_cat
+dimspec    e      3     namelist=ensdim           z          gd ensemble dimension
+dimspec    p      -     constant=7501             c          microphysics_rstrt_state
+dimspec    o      3     namelist=ne_area          z          emissions dimension
+dimspec    h      2     namelist=kemit            z          emissions_zdim
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    g      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    d      2     namelist=paerlev          z          paerlev
+
+
+#### 7. Edit the Registry file and create the state data assocaited with this
+####    solver.  Single entry:
+state real x ikj dyn_exp 2 - ih "TOYVAR"
+####
+
+################################################################################
+################################################################################
+################################################################################
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#
+# It is reauired that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+#
+state    real  LU_INDEX         ij      misc        1         -     irh01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+################################################################################
+################################################################################
+
+# Variables for nmm dynamics                                            
+#
+# module_BC
+#
+# pdb is only 2d but registry doesn't support 2d bdy arrays right now...
+#definitions for NMM slab arrays
+dimspec    q      -     constant=2600             c  # a little crude right now
+dimspec    v      -     constant=1             c  # a little crude right now
+
+#
+# module_LOOPS
+#
+state integer  lmh      ij     dyn_nmm     1      -      irh      "LMH"     "Lowest model layer at mass points from domain top"       ""
+state integer  lmv      ij     dyn_nmm     1      -      irh      "LMV"     "Lowest model layer at velocity points from domain top"   ""
+#
+# module_MASKS
+#
+state  real   hbm2      ij     dyn_nmm     1      -      irh     "HBM2"    "Height boundary mask; =0 outer 2 rows on H points"       "" 
+state  real   hbm3      ij     dyn_nmm     1      -      irh     "HBM3"    "Height boundary mask; =0 outer 3 rows on H points"       ""
+state  real   vbm2      ij     dyn_nmm     1      -      irh     "VBM2"    "Velocity boundary mask; =0 outer 2 rows on V points"     ""
+state  real   vbm3      ij     dyn_nmm     1      -      irh     "VBM3"    "Velocity boundary mask; =0 outer 3 rows on V points"     ""
+state  real   sm        ij     dyn_nmm     1      -      i01rh   "SM"      "Sea mask; =1 for sea, =0 for land"                       ""
+state  real   sice      ij     dyn_nmm     1      -      irh     "SICE"    "Sea ice mask; =1 for sea ice, =0 for no sea ice"         ""
+state  real   htm       ikj    dyn_nmm     1      -      rh      "HTM"     "Height mask; =1 at all mass points above ground"         ""
+state  real   vtm       ikj    dyn_nmm     1      -      rh      "VTM"     "Velocity mask; =1 at all velocity points above ground"   ""
+#
+# module_VRBLS
+#
+state  integer ntsd     -       dyn_nmm    -      -      r       "NTSD"    "Number of timesteps done"                      ""
+state  integer nstart_hour  -   dyn_nmm    -      -      r       "NSTART_HOUR"   "Forecast hour at start of integration"   ""
+state  real   pd        ijb     dyn_nmm    1      -      i01rh   "PD"      "Mass at I,J in the sigma domain"               "Pa"
+state  real   fis       ij      dyn_nmm    1      -      i01rh   "FIS"     "Surface geopotential"                          "m2 s-2"
+state  real   res       ij      dyn_nmm    1      -      irh     "RES"     "Reciprocal of surface sigma"                   ""
+state  real   t         ikjb    dyn_nmm    1      -      i01rh   "T"       "Sensible temperature"                          "K"
+state  real   q         ikjb    dyn_nmm    1      -      i01rh   "Q"       "Specific humidity"                             "kg kg-1"
+state  real   u         ikjb    dyn_nmm    1      -      i01rh   "U"       "U component of wind"                           "m s-1"
+state  real   v         ikjb    dyn_nmm    1      -      i01rh   "V"       "V component of wind"                           "m s-1"
+state  real   told      ikj     dyn_nmm    1      -      r       "TOLD"    "T from previous timestep"                      "K"
+state  real   uold      ikj     dyn_nmm    1      -      r       "UOLD"    "U from previous timestep"                      "m s-1"
+state  real   vold      ikj     dyn_nmm    1      -      r       "VOLD"    "V from previous timestep"                      "m s-1"
+#
+# module_DYNAM
+#
+state  real   dx_nmm    ij     dyn_nmm     1      -      irh     "DX_NMM"  "East-west distance H-to-V points"              "m"
+state  real   wpdar     ij     dyn_nmm     1      -      ir             
+state  real   cpgfu     ij     dyn_nmm     1      -      ir
+state  real   curv      ij     dyn_nmm     1      -      ir      "CURV"    "Curvature term= .5*DT*TAN(phi)/RadEarth"       "s m-1"
+state  real   fcp       ij     dyn_nmm     1      -      ir
+state  real   fdiv      ij     dyn_nmm     1      -      ir
+state  real   f         ij     dyn_nmm     1      -      ir      "F"       "Coriolis * DT/2"                               ""
+state  real   fad       ij     dyn_nmm     1      -      ir
+state  real   ddmpu     ij     dyn_nmm     1      -      ir      "DDMPU"   "Divergence damping term for U"                 "m"
+state  real   ddmpv     ij     dyn_nmm     1      -      ir      "DDMPV"   "Divergence damping term for V"                 "m"
+state  real   deta      k      dyn_nmm     1      -      i01r    "DETA"    "Delta sigma in sigma domain"                   ""
+state  real   rdeta     k      dyn_nmm     1      -      ir      "RDETA"   "Reciprocal of DETA"                            ""
+state  real   aeta      k      dyn_nmm     1      -      i01r   
+state  real   f4q2      k      dyn_nmm     1      -      ir    
+state  real   etax      k      dyn_nmm     1      -      i01r
+state  real   dfl       k      dyn_nmm     1      Z      i01r    "DFL"     "Standard atmosphere geopotential"              "m2 s-2"
+state  real   deta1     k      dyn_nmm     1      -      i01r    "DETA1"   "Delta sigma in pressure domain"                ""
+state  real   aeta1     k      dyn_nmm     1      -      i01r    "AETA1"   "Midlayer sigma value in pressure domain"       ""
+state  real   eta1      k      dyn_nmm     1      -      i01rh   "ETA1"    "Interface sigma value in pressure domain"      ""
+state  real   deta2     k      dyn_nmm     1      -      i01r    "DETA2"   "Delta sigma in sigma domain"                   ""
+state  real   aeta2     k      dyn_nmm     1      -      i01r    "AETA2"   "Midlayer sigma value in sigma domain"          ""
+state  real   eta2      k      dyn_nmm     1      -      i01rh   "ETA2"    "Interface sigma value in sigma domain"         ""
+state  real   em        q      dyn_nmm     1      -      ir
+state  real   emt       q      dyn_nmm     1      -      ir
+state  real   adt       ikj    dyn_nmm     1      -      -       "ADT"     "Change of T due to advection"                  "K"
+state  real   adu       ikj    dyn_nmm     1      -      -       "ADU"     "Change of U due to advection"                  "m s-1"
+state  real   adv       ikj    dyn_nmm     1      -      -       "ADV"     "Change of V due to advection"                  "m s-1"
+state  real   em_loc    q      dyn_nmm     1      -      r
+state  real   emt_loc   q      dyn_nmm     1      -      r
+state  real   dy_nmm    -      dyn_nmm     -      -      ir      "DY_NMM"  "North-south distance H-to-V points"            "m"
+state  real   cpgfv     -      dyn_nmm     -      -      ir
+state  real   en        -      dyn_nmm     -      -      ir
+state  real   ent       -      dyn_nmm     -      -      ir
+state  real   f4d       -      dyn_nmm     -      -      ir
+state  real   f4q       -      dyn_nmm     -      -      ir
+state  real   ef4t      -      dyn_nmm     -      -      ir
+state  logical upstrm   -      dyn_nmm     -      -      -       "UPSTRM"  ".TRUE. => In upstream advec region of grid"    ""
+state  real   dlmd      -      dyn_nmm     -      -      ir      "DLMD"    "East-west angular distance H-to-V points"      "degrees"
+state  real   dphd      -      dyn_nmm     -      -      ir      "DPHD"    "North-south angular distance H-to-V points"    "degrees"
+state  real   pdtop     -      dyn_nmm     -      -      i01rh   "PDTOP"   "Mass at I,J in pressure domain"                "Pa"
+state  real   pt        -      dyn_nmm     -      -      i01rh   "PT"      "Pressure at top of domain"                     "Pa"
+#
+# module_CONTIN
+#
+state  real   pdsl      ij     dyn_nmm     1      -      -       "PDSL"    "Sigma-domain pressure at sigma=1"           "Pa"
+state  real   pdslo     ij     dyn_nmm     1      -      -       "PDSLO"   "PDSL from previous timestep"                "Pa"
+state  real   psdt      ij     dyn_nmm     1      -      r       "PSDT"    "Surface pressure tendency"                  "Pa s-1"
+state  real   div       ikj    dyn_nmm     1      -      r       "DIV"     "Divergence"                                 "Pa s-1"
+state  real   few       ikj    dyn_nmm     1      -      -       "FEW"     "Integrated east-west mass flux"             "Pa m2 s-1"
+state  real   fne       ikj    dyn_nmm     1      -      -       "FNE"     "Integrated northeast-southwest mass flux"   "Pa m2 s-1"
+state  real   fns       ikj    dyn_nmm     1      -      -       "FNS"     "Integrated north-south mass flux"           "Pa m2 s-1"
+state  real   fse       ikj    dyn_nmm     1      -      -       "FSE"     "Integrated southeast-northwest mass flux"   "Pa m2 s-1"
+state  real   omgalf    ikj    dyn_nmm     1      -      r       "OMGALF"  "Omega-alpha"                                "K"
+state  real   petdt     ikj    dyn_nmm     1      -      -       "PETDT"   "Vertical mass flux"                         "Pa s-1"
+state  real   rtop      ikj    dyn_nmm     1      -      r       "RTOP"    "Rd * Tv / P"                                "m3 kg-1"
+#
+# module_PVRBLS
+#
+state real  pblh        ij    dyn_nmm   1    -     rh       "PBLH"     "PBL Height"                           "m"
+state integer lpbl      ij    dyn_nmm   1    -     ir       "LPBL"     "Model layer of PBL top"               ""
+state  real   ustar     ij    dyn_nmm   1    -     irh      "USTAR"    "Friction velocity"                    "m s-1"
+state  real   z0        ij    dyn_nmm   1    -     i01rh    "Z0"       "Roughness height"                     "m"
+state  real   z0base    ij    dyn_nmm   1    -     ir       "Z0BASE"   "Base roughness height"                "m"
+state  real   ths       ij    dyn_nmm   1    -     irh      "THS"      "Surface potential temperature"        "K"
+state  real   mavail    ij    dyn_nmm   1    -     irh
+state  real   qsh       ij    dyn_nmm   1    -     irh      "QS"       "Surface specific humidity"            "kg kg-1"
+state  real   twbs      ij    dyn_nmm   1    -     irh      "TWBS"     "Instantaneous sensible heat flux"     "W m-2"
+state  real   qwbs      ij    dyn_nmm   1    -     irh      "QWBS"     "Instantaneous latent heat flux"       "W m-2"
+state  real   prec      ij    dyn_nmm   1    -     rh       "PREC"     "Precipitation in physics timestep"    "m"
+state  real   aprec     ij    dyn_nmm   1    -     rh
+state  real   acprec    ij    dyn_nmm   1    -     rh       "ACPREC"   "Accumulated total precipitation"      "m"
+state  real   cuprec    ij    dyn_nmm   1    -     rh       "CUPREC"   "Accumulated convective precipitation" "m"
+state  real   lspa      ij    dyn_nmm   1    -     h        "LSPA"     "Land Surface Precipitation Accumulation"   "kg m-2"
+state  real   ddata     ij    dyn_nmm   1    -     -        "DDATA"    "Observed precip to each physics timestep"  "kg m-2"
+state  real   accliq    ij    dyn_nmm   1    -     r
+state  real   sno       ij    dyn_nmm   1    -     irh      "SNO"      "Liquid water snow amount"             "m"
+state  real   si        ij    dyn_nmm   1    -     irh      "SI"       "Snow depth"                           "m"
+state  real   cldefi    ij    dyn_nmm   1    -     rh       "CLDEFI"   "Convective cloud efficiency"          ""
+state  real   deep      ij    dyn_nmm   1    -     r        "DEEP"     "Deep convection =>.TRUE."             ""
+state  real   rf        ij    dyn_nmm   1    -     r
+state  real   th10      ij    dyn_nmm   1    -     irh      "TH10"     "10-m potential temperature"           "K"
+state  real   q10       ij    dyn_nmm   1    -     irh      "Q10"      "10-m specific humidity"               "kg kg-1"
+state  real   pshltr    ij    dyn_nmm   1    -     irh      "PSHLTR"   "2-m pressure"                         "Pa"
+state  real   tshltr    ij    dyn_nmm   1    -     irh      "TSHLTR"   "2-m sensible temperature"             "K"
+state  real   qshltr    ij    dyn_nmm   1    -     irh      "QSHLTR"   "2-m specific humidity"                "kg kg-1"
+state  real   q2        ikjb  dyn_nmm   1    -     irh      "Q2"       "2 * Turbulence kinetic energy"        "m2 s-2"
+state  real   t_adj     ikj   dyn_nmm   1    -     r        "T_ADJ"    "T change due to precip in phys step"  "K"
+state  real   t_old     ikj   dyn_nmm   1    -     r        "T_OLD"    "T before last call to precip"         "K"
+state  real   zero_3d   ikj   dyn_nmm   1    -     r
+state  real   W0AVG     ikj   dyn_nmm   1    -     r        "W0AVG" "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"  "m s-1"
+state  real   AKHS_OUT  ij    dyn_nmm   1    -     h        "AKHS_OUT"  "Output sfc exch coeff for heat"               "m2 s-1"
+state  real   AKMS_OUT  ij    dyn_nmm   1    -     h        "AKMS_OUT"  "Output sfc exch coeff for momentum"           "m2 s-1"    
+#
+# module_PHYS
+#
+state  real   albase    ij    dyn_nmm   1    -     i01rh    "ALBASE"    "Base albedo"            ""
+state  real   albedo    ij    dyn_nmm   1    -     irh      "ALBEDO"    "Dynamic albedo"         ""
+state  real   cnvbot    ij    dyn_nmm   1    -     irh      "CNVBOT"    "Lowest convec cloud bottom lyr between outputs"  ""
+state  real   cnvtop    ij    dyn_nmm   1    -     irh      "CNVTOP"    "Highest convec cloud top lyr between outputs"    ""
+state  real   czen      ij    dyn_nmm   1    -     irh      "CZEN"      "Cosine of solar zenith angle"                    ""
+state  real   czmean    ij    dyn_nmm   1    -     irh      "CZMEAN"    "Mean CZEN between SW radiation calls"            ""
+state  real   epsr      ij    dyn_nmm   1    -     ir       "EPSR"      "Radiative emissivity"                            ""
+state  real   gffc      ij    dyn_nmm   1    -     ir
+state  real   glat      ij    dyn_nmm   1    -     i01rh    "GLAT"      "Geographic latitude, radians"                    ""
+state  real   glon      ij    dyn_nmm   1    -     i01rh    "GLON"      "Geographic longitude, radians"                   ""
+state  real   NMM_TSK   ij    dyn_nmm   1    -     i01r     "TSK"       "Skin temperature"                                "K"
+state  real   hdac      ij    dyn_nmm   1    -     ir       "HDAC"      "Composite diffusion coeff for mass points"       "s m-1"
+state  real   hdacv     ij    dyn_nmm   1    -     ir       "HDACV"     "Composite diffusion coeff for velocity points"   "s m-1"
+state  real   mxsnal    ij    dyn_nmm   1    -     i01rh    "MXSNAL"    "Maximum deep snow albedo"                        ""
+state  real   radin     ij    dyn_nmm   1    -     r                        
+state  real   radot     ij    dyn_nmm   1    -     rh       "RADOT"     "Radiative emission from surface"                 "W m-2"
+state  real   sigt4     ij    dyn_nmm   1    -     rh       "SIGT4"     "Stefan-Boltzmann * T**4"                         "W m-2"
+state  real   tg        ij    dyn_nmm   1    -     i01rh    "TGROUND"   "Deep ground soil temperature"                    "K"
+state  real   dfrlg     k     dyn_nmm   1    Z     i01r     "DFRLG"     "Std atmosphere height of model layer interfaces" "m"
+state integer lvl       ij    dyn_nmm   1    -     ir
+#
+# module_CLDWTR.F
+#
+state  real   cwm       ikjb  dyn_nmm   1    -     rh       "CWM"       "Total condensate"                     "kg kg-1"
+state  real   f_ice     ikj   dyn_nmm   1    -     rh       "F_ICE"     "Frozen fraction of CWM"               ""
+state  real   f_rain    ikj   dyn_nmm   1    -     rh       "F_RAIN"    "Rain fraction of liquid part of CWM"  ""
+state  real   f_rimef   ikj   dyn_nmm   1    -     rh       "F_RIMEF"   "Rime factor"                          ""
+state  real   cldfra    ikj   dyn_nmm   1    -     rh       "CLDFRA"    "Cloud fraction"                       ""
+state  real   sr        ij    dyn_nmm   1    -     irh      "SR"        "Timestep mass ratio of snow:precip"   ""
+state  real   cfrach    ij    dyn_nmm   1    -     rh       "CFRACH"    "High cloud fraction"                  ""
+state  real   cfracl    ij    dyn_nmm   1    -     rh       "CFRACL"    "Low cloud fraction"                   ""
+state  real   cfracm    ij    dyn_nmm   1    -     rh       "CFRACM"    "Middle cloud fraction"                ""
+state logical micro_start        -     dyn_nmm   -    -     -
+#
+# module_SOIL.F
+#
+state integer islope    ij    dyn_nmm   1    -     i01rh
+state  real   dzsoil    k     dyn_nmm   1    -     ir       "DZSOIL"    "Thickness of soil layers"         "m"
+state  real   rtdpth    k     dyn_nmm   1    -     i01r 
+state  real   sldpth    k     dyn_nmm   1    -     i01rh    "SLDPTH"    "Thickness of soil layers"         "m"
+state  real   cmc       ij    dyn_nmm   1    -     i01rh    "CMC"       "Canopy moisture"                  "m"
+state  real   grnflx    ij    dyn_nmm   1    -     irh      "GRNFLX"    "Deep soil heat flux"              "W m-2"
+state  real   pctsno    ij    dyn_nmm   1    -     irh
+state  real   soiltb    ij    dyn_nmm   1    -     i01rh    "SOILTB"    "Deep ground soil temperature"     "K"
+state  real   vegfrc    ij    dyn_nmm   1    -     i01rh    "VEGFRC"    "Vegetation fraction"              ""
+state  real   shdmin    ij    dyn_nmm   1    -     -
+state  real   shdmax    ij    dyn_nmm   1    -     -
+state  real   sh2o      ilj   dyn_nmm   1    Z     irh      "SH2O"      "Unfrozen soil moisture volume fraction"  ""
+state  real   smc       ilj   dyn_nmm   1    Z     irh      "SMC"       "Soil moisture volume fraction"    ""
+state  real   stc       ilj   dyn_nmm   1    Z     irh      "STC"       "Soil temperature"                 "K"
+#
+# module_NHYDRO.F
+#
+state logical hydro     -     dyn_nmm   -    -     -        "HYDRO"     ".FALSE. => nonhydrostatic"        ""
+state  real   dwdtmn    ij    dyn_nmm   1    -     -        "DWDTMN"    "Minimum value for DWDT"           "m s-2"
+state  real   dwdtmx    ij    dyn_nmm   1    -     -        "DWDTMX"    "Maximum value for DWDT"           "m s-2"
+state  real   dwdt      ikj   dyn_nmm   1    -     r        "DWDT"      "dwdt and 1+(dwdt)/g"              "m s-2"
+state  real   pdwdt     ikj   dyn_nmm   1    -     r   
+state  real   pint      ikj   dyn_nmm   1    Z     rh       "PINT"      "Model layer interface pressure"   "Pa"
+state  real   w         ikj   dyn_nmm   1    Z     rh       "W"         "Vertical velocity"                "m s-1"
+state  real   z         ikj   dyn_nmm   1    Z     -        "Z"         "Distance from ground"             "m"
+#
+# module_ACCUM.F
+#
+state  real   acfrcv    ij    dyn_nmm     1    -    h     "ACFRCV"    "Accum convective cloud fraction"   ""
+state  real   acfrst    ij    dyn_nmm     1    -    h     "ACFRST"    "Accum stratiform cloud fraction"   ""
+state  real   ssroff    ij    dyn_nmm     1    -    h     "SSROFF"    "Surface runoff"                    "mm"                  
+state  real   bgroff    ij    dyn_nmm     1    -    h     "BGROFF"    "Subsurface runoff"                 "mm"
+state  real   rlwin     ij    dyn_nmm     1    -    rh    "RLWIN"     "Downward longwave at surface"      "W m-2"
+state  real   rlwout    ij    dyn_nmm     1    -    -
+state  real   rlwtoa    ij    dyn_nmm     1    -    rh    "RLWTOA"    "Outgoing LW flux at top of atmos"  "W m-2"
+state  real   alwin     ij    dyn_nmm     1    -    h     "ALWIN"     "Accum LW down at surface"          "W m-2"
+state  real   alwout    ij    dyn_nmm     1    -    h     "ALWOUT"    "Accum RADOT (see above)"           "W m-2"
+state  real   alwtoa    ij    dyn_nmm     1    -    h     "ALWTOA"    "Accum RLWTOA"                      "W m-2"
+state  real   rswin     ij    dyn_nmm     1    -    rh    "RSWIN"     "Downward shortwave at surface"     "W m-2"
+state  real   rswinc    ij    dyn_nmm     1    -    rh    "RSWINC"    "Clear-sky equivalent of RSWIN"     "W m-2"
+state  real   rswout    ij    dyn_nmm     1    -    rh    "RSWOUT"    "Upward shortwave at surface"       "W m-2"
+state  real   rswtoa    ij    dyn_nmm     1    -    -     "RSWTOA"    "Outgoing SW flux at top of atmos"  "W m-2"
+state  real   aswin     ij    dyn_nmm     1    -    h     "ASWIN"     "Accum SW down at surface"          "W m-2"
+state  real   aswout    ij    dyn_nmm     1    -    h     "ASWOUT"    "Accum RSWOUT"                      "W m-2"
+state  real   aswtoa    ij    dyn_nmm     1    -    h     "ASWTOA"    "Accum RSWTOA"                      "W m-2"
+state  real   sfcshx    ij    dyn_nmm     1    -    rh    "SFCSHX"    "Accum sfc sensible heat flux"      "W m-2"
+state  real   sfclhx    ij    dyn_nmm     1    -    rh    "SFCLHX"    "Accum sfc latent heat flux"        "W m-2"
+state  real   subshx    ij    dyn_nmm     1    -    rh    "SUBSHX"    "Accum deep soil heat flux"         "W m-2"
+state  real   snopcx    ij    dyn_nmm     1    -    rh    "SNOPCX"    "Snow phase change heat flux"       "W m-2"
+state  real   sfcuvx    ij    dyn_nmm     1    -    rh
+state  real   potevp    ij    dyn_nmm     1    -    rh    "POTEVP"    "Accum potential evaporation"       "m"
+state  real   potflx    ij    dyn_nmm     1    -    rh    "POTFLX"    "Energy equivalent of POTEVP"       "W m-2"
+state  real   tlmin     ij    dyn_nmm     1    -    h
+state  real   tlmax     ij    dyn_nmm     1    -    h
+state  real   rlwtt     ikj   dyn_nmm     1    -    rh    "RLWTT"     "Longwave temperature tendency"     "K s-1"
+state  real   rswtt     ikj   dyn_nmm     1    -    rh    "RSWTT"     "Shortwave temperature tendency"    "K s-1"
+state  real   tcucn     ikj   dyn_nmm     1    -    h     "TCUCN"     "Accum convec temperature tendency" "K s-1"
+state  real   train     ikj   dyn_nmm     1    -    h     "TRAIN"     "Accum stratiform temp tendency"    "K s-1"
+state integer ncfrcv    ij    dyn_nmm     1    -    irh   "NCFRCV"    "# times convec cloud >0 between rad calls"  ""
+state integer ncfrst    ij    dyn_nmm     1    -    irh   "NCFRST"    "# times stratiform cloud >0 between rad calls"  ""
+state integer nphs0     -     dyn_nmm     -    -    rh
+state integer nprec     -     dyn_nmm     -    -    irh   "NPREC"     "# timesteps between resetting precip bucket"  ""
+state integer nclod     -     dyn_nmm     -    -    irh   "NCLOD"     "# timesteps between resetting cloud frac accum"    ""
+state integer nheat     -     dyn_nmm     -    -    irh   "NHEAT"     "# timesteps between resetting latent heat accum"   ""
+state integer nrdlw     -     dyn_nmm     -    -    irh   "NRDLW"     "# timesteps between resetting longwave accums"   ""
+state integer nrdsw     -     dyn_nmm     -    -    irh   "NRDSW"     "# timesteps between resetting shortwave accums"   ""
+state integer nsrfc     -     dyn_nmm     -    -    irh   "NSRFC"     "# timesteps between resetting sfcflux accums"   ""
+state  real   avrain    -     dyn_nmm     -    -    irh   "AVRAIN"    "# of times gridscale precip called in NHEAT steps"   ""
+state  real   avcnvc    -     dyn_nmm     -    -    irh   "AVCNVC"    "# of times convective precip called in NHEAT steps"   ""
+state  real   aratim    -     dyn_nmm     -    -    ir
+state  real   acutim    -     dyn_nmm     -    -    irh
+state  real   ardlw     -     dyn_nmm     -    -    irh   "ARDLW"     "# of times LW fluxes summed before resetting"   ""
+state  real   ardsw     -     dyn_nmm     -    -    irh   "ARDSW"     "# of times SW fluxes summed before resetting"   ""
+state  real   asrfc     -     dyn_nmm     -    -    irh   "ASRFC"     "# of times sfc fluxes summed before resetting"   ""  
+state  real   aphtim    -     dyn_nmm     -    -    irh
+#
+# module_INDX.F
+#
+state integer ihe       j    dyn_nmm     1    -    -      "IHE"   "0 or +1 to obtain I index of V point east of H point"  ""
+state integer ihw       j    dyn_nmm     1    -    -      "IHW"   "0 or -1 to obtain I index of V point west of H point"  ""
+state integer ive       j    dyn_nmm     1    -    -      "IVE"   "0 or +1 to obtain I index of H point east of V point"  ""
+state integer ivw       j    dyn_nmm     1    -    -      "IVW"   "0 or -1 to obtain I index of H point west of V point"  ""
+state integer irad      i    dyn_nmm     1    -    -
+#definitions for NMM east-west orientation on E grid
+state integer iheg      q    dyn_nmm     1    -    -
+state integer ihwg      q    dyn_nmm     1    -    -
+state integer iveg      q    dyn_nmm     1    -    -
+state integer ivwg      q    dyn_nmm     1    -    -
+dimspec    r      -     constant=2000             c  # a little crude right now
+state integer iradg     r    dyn_nmm     1    -    -
+dimspec    m      -     constant=(-3:3)            c
+dimspec    n      -     constant=(0:6)             c
+state integer indx3_wrk mqn  dyn_nmm     1    -    -      "INDX3_WRK"  "Array of 3rd (J) indices for local arrays"  ""
+state integer n_iup_h   j    dyn_nmm     1    -    -      "N_IUP_H"    "# mass points needed in each row for upstream advection"  ""
+state integer n_iup_v   j    dyn_nmm     1    -    -      "N_IUP_V"    "# velocity points needed in each row for upstream advection"  ""
+state integer n_iup_adh j    dyn_nmm     1    -    -      "N_IUP_ADH"  "# mass points in each row of upstream advection"  ""
+state integer n_iup_adv j    dyn_nmm     1    -    -      "N_IUP_ADV"  "# velocity points in each row of upstream advection"  ""
+state integer iup_h     ij   dyn_nmm     1    -    -
+state integer iup_v     ij   dyn_nmm     1    -    -
+state integer iup_adh   ij   dyn_nmm     1    -    -
+state integer iup_adv   ij   dyn_nmm     1    -    -
+state integer imicrogram -   misc        -    -    r   "imicrogram"  "flag 0/1 0=mixratio, 1=mcrograms/m3"  ""
+
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     -
+state    integer imask_xstag          ij      misc     X
+state    integer imask_ystag          ij      misc     Y
+state    integer imask_xystag         ij      misc     XY
+#---------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#---------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "description"  "units"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "description"  "units"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "description"  "units"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "description"  "units"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "description"  "units"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "description"  "units"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "description"  "units"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "description"  "units"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "description"  "units"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "description"  "units"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "description"  "units"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "description"  "units"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "description"  "units"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "description"  "units"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "description"  "units"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "description"  "units"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "description"  "units"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "description"  "units"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "description"  "units"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "description"  "units"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "description"  "units"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "description"  "units"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "description"  "units"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "description"  "units"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "description"  "units"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "description"  "units"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "description"  "units"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "description"  "units"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "description"  "units"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "description"  "units"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "description"  "units"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "description"  "units"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "description"  "units"
+state   real   landmask            ij    misc          1     -     i01rh   "LANDMASK"      "description"  "units"
+state   real   topostdv            ij    misc          1     -     i1      "TOPOSTDV"      "description"  "units"
+state   real   toposlpx            ij    misc          1     -     i1      "TOPOSLPX"      "description"  "units"
+state   real   toposlpy            ij    misc          1     -     i1      "TOPOSLPY"      "description"  "units"
+state   real   greenmax            ij    misc          1     -     i1      "GREENMAX"      "description"  "units"
+state   real   greenmin            ij    misc          1     -     i1      "GREENMIN"      "description"  "units"
+state   real   albedomx            ij    misc          1     -     i1      "ALBEDOMX"      "description"  "units"
+state   real   slopecat            ij    misc          1     -     i1      "SLOPECAT"      "description"  "units"
+state   real   toposoil            ij    misc          1     -     i1      "TOPOSOIL"      "description"  "units"
+state   real   landusef            iuj   misc          1     Z     i1      "LANDUSEF"      "description"  "units"
+state   real   soilctop            isj   misc          1     Z     i1      "SOILCTOP"      "description"  "units"
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "description"  "units"
+
+#-------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#------------------------------------------------------------------------------------------------------------------------------
+#                                               
+#---------------------------------------------------------------------------------------------------------------------------------
+# emissions first
+state    real  e_iso          ihj     misc        1         -      i5       "E_ISO"               "Isoprene EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_so2          ihj     misc        1         -      i5h      "E_SO2"               "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_no           ihj     misc        1         -      i5       "E_NO"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_co           ihj     misc        1         -      i5       "E_CO"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_eth          ihj     misc        1         -      i5       "E_ETH"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_hc3          ihj     misc        1         -      i5       "E_HC3"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_hc5          ihj     misc        1         -      i5       "E_HC5"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_hc8          ihj     misc        1         -      i5       "E_HC8"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_xyl          ihj     misc        1         -      i5       "E_XYL"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_ol2          ihj     misc        1         -      i5       "E_OL2"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_olt          ihj     misc        1         -      i5       "E_OLT"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_oli          ihj     misc        1         -      i5       "E_OLI"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_tol          ihj     misc        1         -      i5       "E_TOL"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_csl          ihj     misc        1         -      i5       "E_CSL"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_hcho         ihj     misc        1         -      i5       "E_HCHO"              "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_ald          ihj     misc        1         -      i5       "E_ALD"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_ket          ihj     misc        1         -      i5       "E_KET"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_ora2         ihj     misc        1         -      i5       "E_ORA2"               "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_nh3          ihj     misc        1         -      i5       "E_NH3"                "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_pm25         ihj     misc        1         -      i5       "E_PM25"              "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_pm10         ihj     misc        1         -      i5       "E_PM10"              "EMISSIONS"          "mol km**-2 hr-1"
+state    real  e_pm25i        ihj     misc        1         -      i5       "E_PM25I"     "EMISSION RATE OF UNIDEN. PM2.5 MASS"  "ug m**-3 s**-1"
+state    real  e_pm25j        ihj     misc        1         -      i5       "E_PM25J"     "EMISSION RATE OF J-MODE UNIDEN. PM2.5 MASS"   "ug m**-3 s**-1"
+state    real  e_eci          ihj     misc        1         -      i5       "E_ECI"                "EMISSION RATE OF I-MO DE EC"          "ug m**-3 s**-1"
+state    real  e_ecj          ihj     misc        1         -      i5       "E_ECJ"                "EMISSION RATE OF J-MO DE EC"          "ug m**-3 s**-1"
+state    real  e_orgi         ihj     misc        1         -      i5h      "E_ORGI"               "EMISSION RATE OF I- MODE ORG. AER."   "ug m**-3 s**-1"
+state    real  e_orgj         ihj     misc        1         -      i5       "E_ORGJ"               "EMISSION RATE OF J- MODE ORG. AER."   "ug m**-3 s**-1"
+state    real  e_so4i         ihj     misc        1         -      i5       "E_SO4I"               "EMISSION RATE OF i- MODE ORG. AER."   "ug m**-3 s**-1"
+state    real  e_so4j         ihj     misc        1         -      i5       "E_SO4J"               "EMISSION RATE OF J- MODE ORG. AER."   "ug m**-3 s**-1"
+state    real  e_no3i         ihj     misc        1         -      i5       "E_NO3I"               "EMISSION RATE OF i- MODE ORG. AER."   "ug m**-3 s**-1"
+state    real  e_no3j         ihj     misc        1         -      i5       "E_NO3J"               "EMISSION RATE OF J- MODE ORG. AER."   "ug m**-3 s**-1"
+# Additional CBMZ and MOSAIC emhssion variables...
+state    real  e_no2          ihj     misc         1         -      i5     "E_NO2"                "EMISSIONS NO2"                 "mol km^-2 hr^-1"
+state    real  e_ch3oh        ihj     misc         1         -      i5     "E_CH3OH"              "EMISSIONS CH3OH"               "mol km^-2 hr^-1"
+state    real  e_c2h5oh       ihj     misc         1         -      i5     "E_C2H5OH"             "EMISSIONS C2H5OH"              "mol km^-2 hr^-1"
+state    real  e_so4c         ihj     misc         1         -      i5     "E_SO4C"               "EMISSIONS COARSE SO4 AER"      "ug/m3 m/s"
+state    real  e_no3c         ihj     misc         1         -      i5     "E_NO3C"               "EMISSIONS COARSE NO3 AER"      "ug/m3 m/s"
+state    real  e_orgc         ihj     misc         1         -      i5     "E_ORGC"               "EMISSIONS COARSE ORG AER"      "ug/m3 m/s"
+state    real  e_ecc          ihj     misc         1         -      i5     "E_ECC"                "EMISSIONS COARSE EC AER"       "ug/m3 m/s" 
+state    real  e_bio          ijo     misc         1         -      -        "E_BIO"               "EMISSIONS"          "ppm m/min"        
+state    real  sebio_iso      ij      misc        1         -      i04       "sebio_iso"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_oli      ij      misc        1         -      i04       "sebio_oli"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_api      ij      misc        1         -      i04       "sebio_api"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_lim      ij      misc        1         -      i04       "sebio_lim"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_xyl      ij      misc        1         -      i04       "sebio_xyl"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_hc3      ij      misc        1         -      i04       "sebio_hc3"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_ete      ij      misc        1         -      i04       "sebio_ete"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_olt      ij      misc        1         -      i04       "sebio_olt"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_ket      ij      misc        1         -      i04       "sebio_ket"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_ald      ij      misc        1         -      i04       "sebio_ald"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_hcho     ij      misc        1         -      i04       "sebio_hcho"        "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_eth      ij      misc        1         -      i04       "sebio_eth"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_ora2     ij      misc        1         -      i04       "sebio_ora2"        "Reference biog emiss"  "mol km**-2 hr-1"
+ state    real  sebio_co       ij      misc        1         -      i04       "sebio_co"          "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  sebio_nr       ij      misc        1         -      i04       "sebio_nr"          "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  noag_grow      ij      misc        1         -      i04       "noag_grow"         "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  noag_nongrow   ij      misc        1         -      i04       "noag_nongrow"      "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  nononag        ij      misc        1         -      i04       "nononag"           "Reference biog emiss"  "mol km**-2 hr-1"
+state    real  slai           ij      misc        1         -      i04       "slai"              "Leaf area index isop"  ""
+state    real  ebio_iso       ij      misc        1         -      -        "EBIO_ISO"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_oli       ij      misc        1         -      -        "ebio_oli"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_api       ij      misc        1         -      -        "ebio_api"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_lim       ij      misc        1         -      -        "ebio_lim"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_xyl       ij      misc        1         -      -        "ebio_xyl"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_hc3       ij      misc        1         -      -        "ebio_hc3"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_ete       ij      misc        1         -      -        "ebio_ete"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_olt       ij      misc        1         -      -        "ebio_olt"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_ket       ij      misc        1         -      -        "ebio_ket"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_ald       ij      misc        1         -      -        "ebio_ald"         "Actual biog emiss"  "mol km**-2 hr-1" 
+state    real  ebio_hcho      ij      misc        1         -      -        "ebio_hcho"        "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_eth       ij      misc        1         -      -        "ebio_eth"         "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_ora2      ij      misc        1         -      -        "ebio_ora2"        "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_co        ij      misc        1         -      -        "ebio_co"          "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_nr        ij      misc        1         -      -        "ebio_nr"          "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  ebio_no        ij      misc        1         -      -        "ebio_no"          "Actual biog emiss"  "mol km**-2 hr-1"
+state    real  uvrad          ij      misc        1         -      -        "uvrad"           "UV radiation"
+#
+# following used for output to look at all kinds of stuff
+state    real  dep_vel_o3     ij     misc        1         -      -        "DEP_VEL"                "deposition velocit ies for o3"        "?"
+state    real  cu_co_ten      ikj     misc        1         -      h        "CU_CO_TEN"                "CONV. TRANSPORT FOR CO"            "?"
+# aerosol stuff
+state    real  aerwrf         ikj     misc         1         -      r        "AERWRF"                "STANDARD AEROSOL P ROFILE"            "?"
+state    real  pm2_5_dry      ikj     misc         1         -      hr       "PM2_5_DRY"             "pm2.5 aerosol dry mass"              "ug m^-3"
+state    real  pm2_5_dry_ec   ikj     misc         1         -      r        "PM2_5_EC_DRY"          "dry ec aerosol mass"                 "ug m^-3"
+state    real  pm2_5_water    ikj     misc         1         -      r        "PM2_5_WATER"           "pm2.5 aerosol liquid water content"  "ug m^-3"
+state    real  pm10           ikj     misc         1         -      hr       "pm10 "                 "pm10 dry mass"                       "ug m^-3"
+
+# photolysis rates
+state    real  ph_o31d         ikj     misc        1         -      r         "PHOTR2"                "Photolysis Rates" "?"
+state    real  ph_o33p         ikj     misc        1         -      r        "PHOTR3"                "Photolysis Rates" "?"
+state    real  ph_no2          ikj     misc        1         -      rh         "PHOTR4"                "Photolysis Rates "                 "?"
+state    real  ph_no3o2        ikj     misc        1         -      r        "PHOTR5"                "Photolysis Rates" "?"
+state    real  ph_no3o         ikj     misc        1         -      r        "PHOTR6"                "Photolysis Rates" "?"
+state    real  ph_hno2         ikj     misc        1         -      r        "PHOTR7"                "Photolysis Rates" "?" 
+state    real  ph_hno3         ikj     misc        1         -      r        "PHOTR8"                "Photolysis Rates" "?" 
+state    real  ph_hno4         ikj     misc        1         -      r        "PHOTR9"                "Photolysis Rates" "?"
+state    real  ph_h2o2         ikj     misc        1         -      r        "PHOTR10"                "Photolysis Rates" "?"
+state    real  ph_ch2or        ikj     misc        1         -      r        "PHOTR11"                "Photolysis Rates" "?"
+state    real  ph_ch2om        ikj     misc        1         -      r        "PHOTR12"                "Photolysis Rates" "?"               
+state    real  ph_ch3cho       ikj     misc        1         -      r        "PHOTR13"                "Photolysis Rates" "?"
+state    real  ph_ch3coch3     ikj     misc        1         -      r        "PHOTR14"                "Photolysis Rates" "?"               
+state    real  ph_ch3coc2h5    ikj     misc        1         -      r        "PHOTR15"                "Photolysis Rates" "?"
+state    real  ph_hcocho       ikj     misc        1         -      r        "PHOTR16"                "Photolysis Rates" "?"
+state    real  ph_ch3cocho     ikj     misc        1         -      r        "PHOTR17"                "Photolysis Rates" "?"
+state    real  ph_hcochest     ikj     misc        1         -      r        "PHOTR18"                "Photolysis Rates" "?"
+state    real  ph_ch3o2h       ikj     misc        1         -      r        "PHOTR19"                "Photolysis Rates" "?"
+state    real  ph_ch3coo2h     ikj     misc        1         -      r        "PHOTR20"                "Photolysis Rates" "?"
+state    real  ph_ch3ono2      ikj     misc        1         -      r        "PHOTR21"                "Photolysis Rates" "?"
+state    real  ph_hcochob      ikj     misc        1         -      r        "PHOTR22"                "Photolysis Rates" "?"
+state    real  ph_macr         ikj     misc        1         -      r        "PHOTR1"                "Photolysis Rates" "?"
+state    real  ph_n2o5         ikj     misc        1         -      r       "PHOTR23"               "N2O5 Photolysis Rate" "min{-1}"
+state    real  ph_o2           ikj     misc        1         -      r       "PHOTR24"               "O2 Photolysis Rate" "min{-1}"
+# Aerosol optical properties from Mie code
+state    real  tauaer1         ikj     misc         1         -      r       "TAUAER1"               "bin 1 layer optical thickness" "?"
+state    real  tauaer2         ikj     misc         1         -      r       "TAUAER2"               "bin 2 layer optical thickness" "?"
+state    real  tauaer3         ikj     misc         1         -      r       "TAUAER3"               "bin 3 layer optical thickness" "?"
+state    real  tauaer4         ikj     misc         1         -      r       "TAUAER4"               "bin 4 layer optical thickness" "?"
+state    real  gaer1           ikj     misc         1         -      r       "GAER1"                 "bin 1 layer assymetry parameter" "?"
+state    real  gaer2           ikj     misc         1         -      r       "GAER2"                 "bin 2 layer assymetry parameter" "?"
+state    real  gaer3           ikj     misc         1         -      r       "GAER3"                 "bin 3 layer assymetry parameter" "?"
+state    real  gaer4           ikj     misc         1         -      r       "GAER4"                 "bin 4 layer assymetry parameter" "?"
+state    real  waer1           ikj     misc         1         -      r       "WAER1"                 "bin 1 layer single-scattering albedo" "?"
+state    real  waer2           ikj     misc         1         -      r       "WAER2"                 "bin 2 layer single-scattering albedo" "?"
+state    real  waer3           ikj     misc         1         -      r       "WAER3"                 "bin 3 layer single-scattering albedo" "?"
+state    real  waer4           ikj     misc         1         -      r       "WAER4"                 "bin 4 layer single-scattering albedo" "?"
+# non-transported aerosol variables    
+state    real  h2oaj           ikj     misc        1         -      r        "h2oaj"                 "Aerosol water conc . Acc.mode"         "?"
+state    real  h2oai           ikj     misc        1         -      r        "h2oai"                 "Aerosol water conc . Aitken mode"      "?"
+state    real  nu3             ikj     misc        1         -      r        "nu3"                   "3rd moment Aitken mode"               "?"
+state    real  ac3             ikj     misc        1         -      r        "ac3"                   "3rd moment Acc. mo de"                 "?"
+state    real  cor3            ikj     misc        1         -      r        "cor3"                  "3rd moment coarse mode"               "?"
+state    real  asulf           ikj     misc        1         -      r        "asulf"                 "sulfuric acid vapo r deposition"       "?"
+state    real  ahno3           ikj     misc        1         -      r        "ahno3"                 "nitric acid vapor deposition"         "?"
+state    real  anh3            ikj     misc        1         -      r        "anh3"                  "amonia gas concent ration"             "?"
+state    real  cvaro1          ikj     misc        1         -      r        "cvaro1"                "cond.vapor from ar omatics"            "?"
+state    real  cvaro2          ikj     misc        1         -      r        "cvaro2"                "cond.vapor from ar omatics"            "?"
+state    real  cvalk1          ikj     misc        1         -      r        "cvalk1"                "cond.vapor from al kanes"              "?"
+state    real  cvole1          ikj     misc        1         -      r        "cvole1"                "cond.vapor from ol efines"             "?"
+state    real  cvapi1          ikj     misc        1         -      r        "cvapi1"                "cond.vapor from bi ogenics"            "?"
+state    real  cvapi2          ikj     misc        1         -      r        "cvapi2"                "cond.vapor from bi ogenics"            "?"
+state    real  cvlim1          ikj     misc        1         -      r        "cvlim1"                "cond.vapor from bi ogenics"            "?"
+state    real  cvlim2          ikj     misc        1         -      r        "cvlim2"                "cond.vapor from bi ogenics"            "?"
+# non-transported radical species for RACM
+state    real  addt         ikj     misc        1         -      r        "addt"                "Radicals" "ppm"
+state    real  addx         ikj     misc        1         -      r        "addx"                "Radicals" "ppm"
+state    real  addc         ikj     misc        1         -      r        "addc"                "Radicals" "ppm"
+state    real  etep         ikj     misc        1         -      r        "etep"                "Radicals" "ppm"
+state    real  oltp         ikj     misc        1         -      r        "oltp"                "Radicals" "ppm" 
+state    real  olip         ikj     misc        1         -      r        "olip"                "Radicals" "ppm"
+state    real  cslp         ikj     misc        1         -      r        "cslp"                "Radicals" "ppm"
+state    real  limp         ikj     misc        1         -      r        "limp"                "Radicals" "ppm"
+state    real  hc5p         ikj     misc        1         -      r        "hc5p"                "Radicals" "ppm"
+state    real  hc8p         ikj     misc        1         -      r        "hc8p"                "Radicals" "ppm"
+state    real  tolp         ikj     misc        1         -      r        "tolp"                "Radicals" "ppm"
+state    real  xylp         ikj     misc        1         -      r        "xylp"                "Radicals" "ppm"
+state    real  apip         ikj     misc        1         -      r        "apip"                "Radicals" "ppm"
+state    real  isop         ikj     misc        1         -      r        "isop"                "Radicals" "ppm"
+state    real  hc3p         ikj     misc        1         -      r        "hc3p"                "Radicals" "ppm"
+state    real  ethp         ikj     misc        1         -      r        "ethp"                "Radicals" "ppm"
+state    real  o3p          ikj     misc        1         -      r        "o3p"                 "Radicals" "ppm"
+state    real  tco3         ikj     misc        1         -      r        "tco3"                "Radicals" "ppm"
+state    real  mo2          ikj     misc        1         -      r        "mo2"                 "Radicals" "ppm"
+state    real  o1d          ikj     misc        1         -      r        "o1d"                 "Radicals" "ppm"
+state    real  olnn         ikj     misc        1         -      r        "olnn"                "Radicals" "ppm"
+state    real  olnd         ikj     misc        1         -      r        "olnd"                "Radicals" "ppm"
+state    real  rpho         ikj     misc        1         -      r        "rpho"                "Radicals" "ppm"
+state    real  xo2          ikj     misc        1         -      r        "xo2"                 "Radicals" "ppm"
+state    real  ketp         ikj     misc        1         -      r        "ketp"                "Radicals" "ppm"
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+
+# Moist Scalars  - both height and mass coordinate models
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjft   moist       1         -     -    -                                       
+state   real    qv             ikjft   moist       1         -     i01rhusdf=(bdy_interp:dt)       "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjft   moist       1         -     i01rhusdf=(bdy_interp:dt)       "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjft   moist       1         -     i01rhusdf=(bdy_interp:dt)       "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjft   moist       1         -     i01rhusdf=(bdy_interp:dt)       "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjft   moist       1         -     i01rhusdf=(bdy_interp:dt)       "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjft   moist       1         -     i01rhusdf=(bdy_interp:dt)       "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+#                                               
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -    -
+state   real    qni            ikjftb  scalar      1         -     i01rhusdf=(bdy_interp:dt)       "QNI"              "Ice Number concentration" "# kg(-1)"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+## Chem Scalars  - both height and mass coordinate models                                       
+#                                               
+state   real    -              ikjft   chem        1         -     -    -                                       
+state   real   so2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so2"           "SO2 concentration"         "ppmv"
+state   real   sulf        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "sulf"          "SULF concentration"        "ppmv"
+state   real   no2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no2"           "NO2 concentration"         "ppmv"
+state   real   no          ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no"            "NO concentration"          "ppmv"
+state   real   o3          ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "o3"            "O3 concentration"          "ppmv"
+state   real   hno3        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hno3"          "HNO3 concentration"        "ppmv"
+state   real   h2o2        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "h2o2"          "H2O2 concentration"        "ppmv"
+state   real   ald         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ald"           "ALD concentration"         "ppmv"
+state   real   hcho        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hcho"          "HCHO concentration"        "ppmv"
+state   real   op1         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "op1"           "OP1 concentration"         "ppmv"
+state   real   op2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "op2"           "OP2 concentration"         "ppmv"
+state   real   paa         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "paa"           "PAA concentration"         "ppmv"
+state   real   ora1        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ora1"          "ORA1 concentration"        "ppmv"
+state   real   ora2        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ora2"          "ORA2 concentration"        "ppmv"
+state   real   nh3         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh3"           "NH3 concentration"         "ppmv"
+state   real   n2o5        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "n2o5"          "N2O5 concentration"        "ppmv"
+state   real   no3         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3"           "NO3 concentration"         "ppmv"
+state   real   pan         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "pan"           "PAN concentration"         "ppmv"
+state   real   hc3         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hc3"           "HC3 concentration"         "ppmv"
+state   real   hc5         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hc5"           "HC5 concentration"         "ppmv"
+state   real   hc8         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hc8"           "HC8 concentration"         "ppmv"
+state   real   eth         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "eth"           "ETH concentration"         "ppmv"
+state   real   co          ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co"            "CO concentration"          "ppmv"
+state   real   ol2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ol2"           "OL2 concentration"         "ppmv"
+state   real   olt         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "olt"           "OLT concentration"         "ppmv"
+state   real   oli         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oli"           "OLI concentration"         "ppmv"
+state   real   tol         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "tol"           "TOL concentration"         "ppmv"
+state   real   xyl         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "xyl"           "XYL concentration"         "ppmv"
+state   real   aco3        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "aco3"          "ACO3 concentration"        "ppmv"
+state   real   tpan        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "tpan"          "TPAN concentration"        "ppmv"
+state   real   hono        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hono"          "HONO concentration"        "ppmv"
+state   real   hno4        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hno4"          "HNO4 concentration"        "ppmv"
+state   real   ket         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ket"           "KET concentration"         "ppmv"
+state   real   gly         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "gly"           "GLY concentration"         "ppmv"
+state   real   mgly        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "mgly"          "MGLY concentration"        "ppmv"
+state   real   dcb         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "dcb"           "DCB concentration"         "ppmv"
+state   real   onit        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "onit"          "ONIT concentration"        "ppmv"
+state   real   csl         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "csl"           "CSL concentration"         "ppmv"
+state   real   iso         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "iso"           "ISO concentration"         "ppmv"
+state   real   ho          ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ho"            "HO concentration"          "ppmv"
+state   real   ho2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ho2"           "HO2 concentration"         "ppmv"
+#RACM has a few more variables to those of RADM2 (ETE is equivilant to OL2 from RADM2)
+
+state   real   ete         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ete"           "ETE concentration"         "ppmv"
+state   real   co2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co2"           "CO2 concentration"         "ppmv"
+state   real   ch4         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ch4"           "CH4 concentration"         "ppmv"
+state   real   udd         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "udd"           "UDD concentration"         "ppmv"
+state   real   hket        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hket"          "HKET concentration"        "ppmv"
+state   real   api         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "api"           "API concentration"         "ppmv"
+state   real   lim         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "lim"           "LIM concentration"         "ppmv"
+state   real   dien        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "dien"          "DIEN concentration"        "ppmv"
+state   real   macr        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "macr"          "MACR concentration"        "ppmv"
+
+#Additional CBMZ gas variables inside the chem array...
+
+state   real   hcl         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hcl"           "HCL concentration"         "ppmv"
+state   real   ch3o2       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ch3o2"         "CH3O2 concentration"       "ppmv"
+state   real   ethp        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ethp"          "ETHP concentration"        "ppmv"
+state   real   ch3oh       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ch3oh"         "CH3OH concentration"       "ppmv"
+state   real   c2h5oh      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "c2h5oh"        "C2H5OH concentration"      "ppmv"
+state   real   par         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "par"           "PAR concentration"         "ppmv"
+state   real   to2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "to2"           "TO2 concentration"         "ppmv"
+state   real   cro         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "cro"           "CRO concentration"         "ppmv"
+state   real   open        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "open"          "OPEN concentration"        "ppmv"
+state   real   op3         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "op3"           "OP3 concentration"         "ppmv"
+state   real   c2o3        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "c2o3"          "C2O3 concentration"        "ppmv"
+state   real   ro2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ro2"           "RO2 concentration"         "ppmv"
+state   real   ano2        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ano2"          "ANO2 concentration"        "ppmv"
+state   real   nap         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nap"           "NAP concentration"         "ppmv"
+state   real   xo2         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "xo2"           "XO2 concentration"         "ppmv"
+state   real   xpar        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "xpar"          "XPAR concentration"        "ppmv"
+state   real   isoprd      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "isoprd"        "ISOPRD concentration"      "ppmv"
+state   real   isopp       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "isopp"         "ISOPP concentration"       "ppmv"
+state   real   isopn       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "isopn"         "ISOPN concentration"       "ppmv"
+state   real   isopo2      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "isopo2"        "ISOPO2 concentration"      "ppmv"
+state   real   dms         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "dms"           "DMS concentration"         "ppmv"
+state   real   msa         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "msa"           "MSA concentration"         "ppmv"
+state   real   dmso        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "dmso"          "DMSO concentration"        "ppmv"
+state   real   dmso2       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "dmso2"         "DMSO2 concentration"       "ppmv"
+state   real   ch3so2h     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ch3so2h"       "CH3SO2H concentration"     "ppmv"
+state   real   ch3sch2oo   ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ch3sch2oo"     "CH3SCH2OO concentration"   "ppmv"
+state   real   ch3so2      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ch3so2"        "CH3SO2 concentration"      "ppmv"
+state   real   ch3so3      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ch3so3"        "CH3SO3 concentration"      "ppmv"
+state   real   ch3so2oo    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ch3so2oo"      "CH3SO2OO concentration"    "ppmv"
+state   real   ch3so2ch2oo ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ch3so2ch2oo"   "CH3SO2CH2OO concentration" "ppmv"
+state   real   mtf         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "mtf"           "MTF concentration"         "ppmv"
+
+#cms++ additional species from RACM-MIM (Geiger et al., Atmos. Env., 2003)
+state   real   hace        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "HACE"              "HACE concentration"      "ppm"
+state   real   ishp        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "ISHP"              "ISHP concentration"      "ppm"
+state   real   ison        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "ISON"              "ISON concentration"      "ppm"
+state   real   mahp        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "MAHP"              "MAHP concentration"      "ppm"
+state   real   mpan        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "MPAN"              "MPAN concentration"      "ppm"
+state   real   nald        ikjftb   chem        1         -   irusdf=(bdy_interp:dt)        "NALD"              "NALD concentration"      "ppm"
+#cms-- note: ison is probably quite soluble
+#Aerosol variables inside the chem array...
+
+state   real   so4aj       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4aj"         "Sulfate conc. Acc. mode"       "ug/kg-dryair"
+state   real   so4ai       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4ai"         "Sulfate conc. Aitken mode"       "ug/kg-dryair"
+state   real   nh4aj       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4aj"         "Ammonium conc. Acc. mode"       "ug/kg-dryair"
+state   real   nh4ai       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4ai"         "Ammonium  conc. Aitken mode"       "ug/kg-dryair"
+state   real   no3aj       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3aj"         "Nitrate  conc. Acc. mode"       "ug/kg-dryair"
+state   real   no3ai       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3ai"         "Nitrate  conc. Aitken mode"       "ug/kg-dryair"
+state   real   orgaro1j    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgaro1j"      "SOA Anth. org. conc. from aromatics Acc. mode"    "ug/kg-dryair "
+state   real   orgaro1i    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgaro1i"      "SOA Anth. org. conc. from aromatics Aitken mode"    "ug/kg-drya ir"
+state   real   orgaro2j    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgaro2j"      "SOA Anth. org. conc. from aromatics Acc. mode"    "ug/kg-dryair "
+state   real   orgaro2i    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgaro2i"      "SOA Anth. org. conc. from aromatics Aitken mode"    "ug/kg-dryair"
+state   real   orgalk1j    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgalk1j"      "SOA Anth. org. conc. from alkanes and others except aromatics Acc. mode"    "ug/kg-dryair"
+state   real   orgalk1i    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgalk1i"      "SOA Anth. org. conc. from alkanes and others except aromatics Aitken mode"    "ug/kg-dryair"
+state   real   orgole1j    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgole1j"      "SOA Anth. org. conc. from alkenes and others except aromatics Acc. mode"    "ug/kg-dryair"
+state   real   orgole1i    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgole1i"      "SOA Anth. org. conc. from alkenes and others except aromatics Aitken mode"    "ug/kg-dryair"
+state   real   orgba1j     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba1j"       "SOA Biog. org. conc. from aromatics Acc. mode"     "ug/kg-dryair"
+state   real   orgba1i     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba1i"       "SOA Biog. org. conc. from aromatics Aitken mode"     "ug/kg-dryair"
+state   real   orgba2j     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba2j"       "SOA Biog. org. conc. from aromatics Acc. mode"     "ug/kg-dryair"
+state   real   orgba2i     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba2i"       "SOA Biog. org. conc. from aromatics Aitken mode"     "ug/kg-dryair"
+state   real   orgba3j     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba3j"       "SOA Biog. org. conc. from aromatics Acc. mode"     "ug/kg-dryair"
+state   real   orgba3i     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba3i"       "SOA Biog. org. conc. from aromatics Aitken mode"     "ug/kg-dryair"
+state   real   orgba4j     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba4j"       "SOA Biog. org. conc. from aromatics Acc. mode"     "ug/kg-dryair"
+state   real   orgba4i     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgba4i"       "SOA Biog. org. conc. from aromatics Aitken mode"     "ug/kg-dryair"
+state   real   orgpaj      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgpaj"        "Prim. anth. org. conc. from aromatics Acc. mode"      "ug/kg-dryair"
+state   real   orgpai      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "orgpai"        "Prim. anth. org. conc. from aromatics Aitken mode"      "ug/kg-dryair"
+state   real   ecj         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ecj"           "Elemental carbon Acc. mode"         "ug/kg-dryair"
+state   real   eci         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "eci"           "Elemental carbon Aitken mode"         "ug/kg-dryair"
+state   real   p25j        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "p25j"          "Primary PM2.5 Acc. mode"        "ug/kg-dryair"
+state   real   p25i        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "p25i"          "Primary PM2.5 Aitken mode"        "ug/kg-dryair"
+state   real   antha       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "antha"         "Coarse anthropogenic aerosols"       "ug/kg-dryair"
+state   real   seas        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "seas"          "Coarse marine aerosols"        "ug/kg-dryair"
+state   real   soila       ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "soila"         "Coarse soil-derived aerosols"       "ug/kg-dryair"
+state   real   nu0         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nu0"           "Aitken mode number"         "#/kg-dryair"
+state   real   ac0         ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ac0"           "Accumulation mode number"         "#/kg-dryair"    
+state   real   corn        ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "corn"          "Coarse mode number"        "#/kg-dryair"
+
+#Additional MOSAIC aerosol variables inside the chem array... 
+
+state   real   so4_a01     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4_a01"       "Sulfate, aerosol bin 01"     "ug/kg-dryair"
+state   real   no3_a01     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3_a01"       "Nitrate, aerosol bin 01"     "ug/kg-dryair"
+state   real   cl_a01      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "cl_a01"        "Chloride, aerosol bin 01"      "ug/kg-dryair"
+state   real   msa_a01     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "msa_a01"       "MSA, aerosol bin 01"     "ug/kg-dryair"
+state   real   co3_a01     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co3_a01"       "Carbonate, aerosol bin 01"     "ug/kg-dryair"
+state   real   nh4_a01     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4_a01"       "Ammonium, aerosol bin 01"     "ug/kg-dryair" 
+state   real   na_a01      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "na_a01"        "Sodium, aerosol bin 01"      "ug/kg-dryair"
+state   real   ca_a01      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ca_a01"        "Calcium, aerosol bin 01"      "ug/kg-dryair"
+state   real   oin_a01     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oin_a01"       "Other inorganics, aerosol bin 01"     "ug/kg-dryair"
+ state   real   oc_a01      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oc_a01"        "Organic carbon, aerosol bin 01"      "ug/kg-dryair"
+state   real   bc_a01      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "bc_a01"        "Black carbon, aerosol bin 01"      "ug/kg-dryair"
+state   real   hysw_a01    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hysw_a01"      "Hysteresis water, aerosol bin 01"    "ug/kg-dryair"
+state   real   water_a01   ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "water_a01"     "Water, aerosol bin 01"   "ug/kg-dryair"
+state   real   num_a01     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "num_a01"       "Number, aerosol bin 01"     "#/kg-dryair"
+state   real   so4_a02     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4_a02"       "Sulfate, aerosol bin 02"     "ug/kg-dryair"
+state   real   no3_a02     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3_a02"       "Nitrate, aerosol bin 02"     "ug/kg-dryair"
+state   real   cl_a02      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "cl_a02"        "Chloride, aerosol bin 02"      "ug/kg-dryair"
+state   real   msa_a02     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "msa_a02"       "MSA, aerosol bin 02"     "ug/kg-dryair"
+state   real   co3_a02     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co3_a02"       "Carbonate, aerosol bin 02"     "ug/kg-dryair"
+state   real   nh4_a02     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4_a02"       "Ammonium, aerosol bin 02"     "ug/kg-dryair"
+state   real   na_a02      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "na_a02"        "Sodium, aerosol bin 02"      "ug/kg-dryair"
+state   real   ca_a02      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ca_a02"        "Calcium, aerosol bin 02"      "ug/kg-dryair"
+state   real   oin_a02     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oin_a02"       "Other inorganics, aerosol bin 02"     "ug/kg-dryair"
+state   real   oc_a02      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oc_a02"        "Organic carbon, aerosol bin 02"      "ug/kg-dryair"
+state   real   bc_a02      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "bc_a02"        "Black carbon, aerosol bin 02"      "ug/kg-dryair"
+state   real   hysw_a02    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hysw_a02"      "Hysteresis water, aerosol bin 02"    "ug/kg-dryair"
+state   real   water_a02   ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "water_a02"     "Water, aerosol bin 02"   "ug/kg-dryair"
+state   real   num_a02     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "num_a02"       "Number, aerosol bin 02"     "#/kg-dryair"
+state   real   so4_a03     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4_a03"       "Sulfate, aerosol bin 03"     "ug/kg-dryair"
+state   real   no3_a03     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3_a03"       "Nitrate, aerosol bin 03"     "ug/kg-dryair"
+state   real   cl_a03      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "cl_a03"        "Chloride, aerosol bin 03"      "ug/kg-dryair"
+state   real   msa_a03     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "msa_a03"       "MSA, aerosol bin 03"     "ug/kg-dryair"
+state   real   co3_a03     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co3_a03"       "Carbonate, aerosol bin 03"     "ug/kg-dryair"
+state   real   nh4_a03     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4_a03"       "Ammonium, aerosol bin 03"     "ug/kg-dryair"
+state   real   na_a03      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "na_a03"        "Sodium, aerosol bin 03"      "ug/kg-dryair"
+state   real   ca_a03      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ca_a03"        "Calcium, aerosol bin 03"      "ug/kg-dryair"
+state   real   oin_a03     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oin_a03"       "Other inorganics, aerosol bin 03"     "ug/kg-dryair"
+state   real   oc_a03      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oc_a03"        "Organic carbon, aerosol bin 03"      "ug/kg-dryair"
+state   real   bc_a03      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "bc_a03"        "Black carbon, aerosol bin 03"      "ug/kg-dryair"
+state   real   hysw_a03    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hysw_a03"      "Hysteresis water, aerosol bin 03"    "ug/kg-dryair"
+state   real   water_a03   ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "water_a03"     "Water, aerosol bin 03"   "ug/kg-dryair"
+state   real   num_a03     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "num_a03"       "Number, aerosol bin 03"     "#/kg-dryair"
+state   real   so4_a04     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4_a04"       "Sulfate, aerosol bin 04"     "ug/kg-dryair"
+state   real   no3_a04     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3_a04"       "Nitrate, aerosol bin 04"     "ug/kg-dryair"
+state   real   cl_a04      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "cl_a04"        "Chloride, aerosol bin 04"      "ug/kg-dryair"
+state   real   msa_a04     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "msa_a04"       "MSA, aerosol bin 04"     "ug/kg-dryair"
+state   real   co3_a04     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co3_a04"       "Carbonate, aerosol bin 04"     "ug/kg-dryair"
+state   real   nh4_a04     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4_a04"       "Ammonium, aerosol bin 04"     "ug/kg-dryair"
+state   real   na_a04      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "na_a04"        "Sodium, aerosol bin 04"      "ug/kg-dryair"
+state   real   ca_a04      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ca_a04"        "Calcium, aerosol bin 04"      "ug/kg-dryair"
+state   real   oin_a04     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oin_a04"       "Other inorganics, aerosol bin 04"     "ug/kg-dryair"
+state   real   oc_a04      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oc_a04"        "Organic carbon, aerosol bin 04"      "ug/kg-dryair"
+state   real   bc_a04      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "bc_a04"        "Black carbon, aerosol bin 04"      "ug/kg-dryair"
+state   real   hysw_a04    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hysw_a04"      "Hysteresis water, aerosol bin 04"    "ug/kg-dryair"
+state   real   water_a04   ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "water_a04"     "Water, aerosol bin 04"   "ug/kg-dryair"
+state   real   num_a04     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "num_a04"       "Number, aerosol bin 04"     "#/kg-dryair"
+state   real   so4_a05     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4_a05"       "Sulfate, aerosol bin 05"     "ug/kg-dryair"
+state   real   no3_a05     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3_a05"       "Nitrate, aerosol bin 05"     "ug/kg-dryair"
+state   real   cl_a05      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "cl_a05"        "Chloride, aerosol bin 05"      "ug/kg-dryair"
+state   real   msa_a05     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "msa_a05"       "MSA, aerosol bin 05"     "ug/kg-dryair"
+state   real   co3_a05     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co3_a05"       "Carbonate, aerosol bin 05"     "ug/kg-dryair"
+state   real   nh4_a05     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4_a05"       "Ammonium, aerosol bin 05"     "ug/kg-dryair"
+state   real   na_a05      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "na_a05"        "Sodium, aerosol bin 05"      "ug/kg-dryair"
+state   real   ca_a05      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ca_a05"        "Calcium, aerosol bin 05"      "ug/kg-dryair"
+state   real   oin_a05     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oin_a05"       "Other inorganics, aerosol bin 05"     "ug/kg-dryair"
+state   real   oc_a05      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oc_a05"        "Organic carbon, aerosol bin 05"      "ug/kg-dryair"
+state   real   bc_a05      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "bc_a05"        "Black carbon, aerosol bin 05"      "ug/kg-dryair"
+state   real   hysw_a05    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hysw_a05"      "Hysteresis water, aerosol bin 05"    "ug/kg-dryair"
+state   real   water_a05   ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "water_a05"     "Water, aerosol bin 05"   "ug/kg-dryair"
+state   real   num_a05     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "num_a05"       "Number, aerosol bin 05"     "#/kg-dryair"
+state   real   so4_a06     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4_a06"       "Sulfate, aerosol bin 06"     "ug/kg-dryair"
+state   real   no3_a06     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3_a06"       "Nitrate, aerosol bin 06"     "ug/kg-dryair"
+state   real   cl_a06      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "cl_a06"        "Chloride, aerosol bin 06"      "ug/kg-dryair"
+state   real   msa_a06     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "msa_a06"       "MSA, aerosol bin 06"     "ug/kg-dryair"
+state   real   co3_a06     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co3_a06"       "Carbonate, aerosol bin 06"     "ug/kg-dryair"
+state   real   nh4_a06     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4_a06"       "Ammonium, aerosol bin 06"     "ug/kg-dryair"
+state   real   na_a06      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "na_a06"        "Sodium, aerosol bin 06"      "ug/kg-dryair"
+state   real   ca_a06      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ca_a06"        "Calcium, aerosol bin 06"      "ug/kg-dryair"
+state   real   oin_a06     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oin_a06"       "Other inorganics, aerosol bin 06"     "ug/kg-dryair"
+state   real   oc_a06      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oc_a06"        "Organic carbon, aerosol bin 06"      "ug/kg-dryair"
+state   real   bc_a06      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "bc_a06"        "Black carbon, aerosol bin 06"      "ug/kg-dryair"
+state   real   hysw_a06    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hysw_a06"      "Hysteresis water, aerosol bin 06"    "ug/kg-dryair"
+state   real   water_a06   ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "water_a06"     "Water, aerosol bin 06"   "ug/kg-dryair"
+state   real   num_a06     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "num_a06"       "Number, aerosol bin 06"     "#/kg-dryair"
+state   real   so4_a07     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4_a07"       "Sulfate, aerosol bin 07"     "ug/kg-dryair"
+state   real   no3_a07     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3_a07"       "Nitrate, aerosol bin 07"     "ug/kg-dryair"
+state   real   cl_a07      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "cl_a07"        "Chloride, aerosol bin 07"      "ug/kg-dryair"
+state   real   msa_a07     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "msa_a07"       "MSA, aerosol bin 07"     "ug/kg-dryair"
+state   real   co3_a07     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co3_a07"       "Carbonate, aerosol bin 07"     "ug/kg-dryair"
+state   real   nh4_a07     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4_a07"       "Ammonium, aerosol bin 07"     "ug/kg-dryair"
+state   real   na_a07      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "na_a07"        "Sodium, aerosol bin 07"      "ug/kg-dryair"
+state   real   ca_a07      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ca_a07"        "Calcium, aerosol bin 07"      "ug/kg-dryair"
+state   real   oin_a07     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oin_a07"       "Other inorganics, aerosol bin 07"     "ug/kg-dryair"
+state   real   oc_a07      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oc_a07"        "Organic carbon, aerosol bin 07"      "ug/kg-dryair"
+state   real   bc_a07      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "bc_a07"        "Black carbon, aerosol bin 07"      "ug/kg-dryair"
+state   real   hysw_a07    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hysw_a07"      "Hysteresis water, aerosol bin 07"    "ug/kg-dryair"
+state   real   water_a07   ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "water_a07"     "Water, aerosol bin 07"   "ug/kg-dryair"
+state   real   num_a07     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "num_a07"       "Number, aerosol bin 07"     "#/kg-dryair"
+state   real   so4_a08     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "so4_a08"       "Sulfate, aerosol bin 08"     "ug/kg-dryair"
+state   real   no3_a08     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "no3_a08"       "Nitrate, aerosol bin 08"     "ug/kg-dryair"
+state   real   cl_a08      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "cl_a08"        "Chloride, aerosol bin 08"      "ug/kg-dryair"
+state   real   msa_a08     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "msa_a08"       "MSA, aerosol bin 08"     "ug/kg-dryair"
+state   real   co3_a08     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "co3_a08"       "Carbonate, aerosol bin 08"     "ug/kg-dryair"
+state   real   nh4_a08     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "nh4_a08"       "Ammonium, aerosol bin 08"     "ug/kg-dryair"
+state   real   na_a08      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "na_a08"        "Sodium, aerosol bin 08"      "ug/kg-dryair"
+state   real   ca_a08      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "ca_a08"        "Calcium, aerosol bin 08"      "ug/kg-dryair"
+state   real   oin_a08     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oin_a08"       "Other inorganics, aerosol bin 08"     "ug/kg-dryair"
+state   real   oc_a08      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "oc_a08"        "Organic carbon, aerosol bin 08"      "ug/kg-dryair"
+state   real   bc_a08      ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "bc_a08"        "Black carbon, aerosol bin 08"      "ug/kg-dryair"
+state   real   hysw_a08    ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "hysw_a08"      "Hysteresis water, aerosol bin 08"    "ug/kg-dryair"
+state   real   water_a08   ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "water_a08"     "Water, aerosol bin 08"   "ug/kg-dryair"
+state   real   num_a08     ikjftb   chem        1         -   irhusdf=(bdy_interp:dt)  "num_a08"       "Number, aerosol bin 08"     "#/kg-dryair"
+
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# specified LBC arrays, first, Eulerian height coordinate model
+
+
+# specified LBC arrays, next, Eulerian mass coordinate model
+
+
+# specified LBC  variables shared between the mass and height coordinate models
+
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+
+
+# 2m and 10m output diagnostics
+
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     rh       "SMOIS"                "SOIL MOISTURE" ""
+state    real   TSLB             ilj     -          1         Z     rh       "TSLB" "SOIL TEMPERATURE" ""
+
+
+# MYJ PBL variables
+
+
+# gfdl (eta) radiation State Variables
+
+# eta microphpysics State Variables
+
+
+# new eta microphpysics State Variables
+
+#  some mass-coordinate-model-specific variables
+
+
+
+
+
+
+# was em_only
+
+#################################################################
+# Physics Variables (em core)
+                                                
+                                                
+                                                
+#################################################################
+# Physics Variables (eh core) ; should be same as em
+                                                
+                                                
+
+                                                
+#################################################################
+# variables added for CHEMISTRY compatibility with ARW core - kludge
+#################################################################
+state    real   GSW             ij     misc        1         -      -       ""                 ""
+state    real   XLAT            ij     misc        1         -      -       ""                 ""
+state    real   XLONG           ij     misc        1         -      -       ""                 ""
+state    real   XLAND           ij     misc        1         -      -       ""                 ""
+state    real   TSK             ij     misc        1         -      -       ""                 ""
+state    real   UST             ij     misc        1         -      -       ""                 ""
+state    real   RAINCV          ij     misc        1         -      -       ""                 ""
+
+#################################################################
+# other misc variables (all cores)
+#################################################################
+
+# added for surface_driver
+state    real   PSFC             ij     misc        1         -      rh       "PSFC"                 "SFC PRESSURE"
+state    real   dtbc            -       misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+state    real   TH2              ij     misc        1         -     irh       "TH2"                  "POT TEMP at 2 M" ""
+state    real   T2               ij     misc        1         -     irh       "T2"                  "TEMP at 2 M" ""
+state    real   U10              ij     misc        1         -     irh       "U10"                  "U at 10 M"         " "
+state    real   V10              ij     misc        1         -     irh       "V10"                  "V at 10 M"         " "
+state    real   XICE             ij     misc        1         -     i01r      "XICE"                 "SEA ICE"         ""
+state    real   SMSTAV           ij     misc        1         -     irh       "SMSTAV"               "MOISTURE VARIBILITY" ""
+state    real   SMSTOT           ij     misc        1         -     irh     "SMSTOT"               "TOTAL SOIL MOISTURE" ""
+state    real   SFCRUNOFF        ij     misc        1         -     rh       "SFROFF"               "SURFACE RUNOFF" ""
+state    real   UDRUNOFF         ij     misc        1         -     rh       "UDROFF"               "UNDERGROUND RUNOFF" ""
+state  integer  IVGTYP           ij     misc        1         -     irh       "IVGTYP"               "VEGETATION TYPE" ""
+state  integer  ISLTYP           ij     misc        1         -     irh       "ISLTYP"               "SOIL TYPE"         " "
+state    real   VEGFRA           ij     misc        1         -     i01rh       "VEGFRA"               "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -     irh     "SFCEVP"               "SURFACE EVAPORATION" ""
+state    real   GRDFLX           ij     misc        1         -     irh     "GRDFLX"               "GROUND HEAT FLUX" ""
+state    real   ALBBCK           ij     misc        1         -     i012r   "ALBBCK"          "BACKGROUND ALBEDO"        "NA"
+state    real   SFCEXC           ij     misc        1         -     irh     "SFCEXC "              "SURFACE EXCHANGE COEFFICIENT"         ""
+state    real   ACSNOW           ij     misc        1         -     irh       "ACSNOW"               "ACCUMULATED SNOW" ""
+state    real   ACSNOM           ij     misc        1         -     irh       "ACSNOM"               "ACCUMULATED MELTED SNOW"         ""
+state    real   RMOL             ij     misc        1         -     irh      "RMOL"               ""         ""
+state    real   SNOW             ij     misc        1         -     i01rh       "SNOW"                 "SNOW WATER EQUIVALENT"         ""
+state    real   CANWAT           ij     misc        1         -     i01rh       "CANWAT"               "CANOPY WATER" ""
+state    real   SST              ij     misc        1         -     i01rh       "SST"                  "SEA SURFACE TEMPERATURE" "K"
+state    real   WEASD            ij     misc        1         -     i01rh       "WEASD"                "WATER EQUIVALENT OF ACCUMULATED SNOW" ""
+state    real  ZNT              ij      misc        1         -     ir        "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"
+state    real  MOL              ij      misc        1         -     ir        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"
+
+state    real   tke_myj         ikj     misc        1         -     rh        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"     "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -      h        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H         ikj     misc        1         -     rh         "EXCH_H"               "EXCHANGE COEFFICIENTS FOR HEAT"               "m2 s-1"
+state   real   THZ0             ij     misc        1         -     irh       "THZ0"        "POT. TEMPERATURE AT TOP OF VISC. SUBLYR"       "K"
+state   real   QZ0              ij     misc        1         -     irh       "QZ0"         "SPECIFIC HUMIDITY AT TOP OF VISC. SUBLYR"      "kg kg-1"
+state   real   UZ0              ij     misc        1         -     irh       "UZ0"         "U WIND COMPONENT AT TOP OF VISC. SUBLYR"       "m s-1"
+state   real   VZ0              ij     misc        1         -     irh       "VZ0"         "V WIND COMPONENT AT TOP OF VISC. SUBLYR"       "m s-1"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"  "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+# added as state for HALO_NMM_TURBL, jm
+state   real   UZ0h              ij     misc        1         -     -       
+state   real   VZ0h              ij     misc        1         -     -       
+state   real   dudt              ikj     misc        1         -     -      
+state   real   dvdt              ikj     misc        1         -     -      
+
+state   real   QSFC             ij     misc        1         -     irh       "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -     ir        "AKHS"                  "SFC EXCH COEFF FOR HEAT /DELTA Z"             "m s-1"
+state   real   AKMS             ij     misc        1         -     ir        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM /DELTA Z"         "m s-1"    
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+state    real    HTOP            ij     misc        1         -     irh       "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -     irh       "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -     irh       "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"         ""
+state    real    HBOTR           ij     misc        1         -     irh       "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"         ""
+state    real    HTOPD           ij     misc        1         -     rh        "HTOPD"                "TOP DEEP CONVECTION LEVEL"         ""
+state    real    HBOTD           ij     misc        1         -     rh        "HBOTD"                "BOT DEEP CONVECTION LEVEL"         ""
+state    real    HTOPS           ij     misc        1         -     rh        "HTOPS"                "TOP SHALLOW CONVECTION LEVEL"         ""
+state    real    HBOTS           ij     misc        1         -     rh        "HBOTS"                "BOT SHALLOW CONVECTION LEVEL"         ""
+state    REAL      CUPPT         ij     misc        1         -     rh        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINCE LAST CALL TO THE RADIATION"         ""
+state    REAL      CPRATE        ij     misc        1         -     rh         "CPRATE"               "INSTANTANEOUS CONVECTIVE PRECIPITATION RATE"      ""   #  1-17-06a
+state    real    F_ICE_PHY       ikj    misc        1         -      -        "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      -        "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      -        "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"           "mb/hour"
+state    real  apr_gr           ij      misc        1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL "           "mm/hour"
+state    real  apr_w            ij      misc        1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W "           "mm/hour"
+state    real  apr_mc           ij      misc        1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"           "mm/hour"
+state    real  apr_st           ij      misc        1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY "           "mm/hour"
+state    real  apr_as           ij      misc        1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE "           "mm/hour"
+state    real  apr_capma        ij      misc        1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"           "mm/hour"
+state    real  apr_capme        ij      misc        1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"           "mm/hour"
+state    real  apr_capmi        ij      misc        1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"           "mm/hour"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  GD_CLOUD        ikj      misc        1         -      rh      "GD_CLOUD"              "CLOUD WATER/ICE MIXING RAIO IN GD CLOUD"         "kg kg-1"
+state    real  GD_CLOUD2        ikj      misc        1         -      rh      "GD_CLOUD2"              "TEST for GD CLOUD"         "kg kg-1"
+state    real  RTHFTEN          ikj     misc        1         -      r       "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"         "K/sec"
+state    real  RQVFTEN          ikj     misc        1         -      r       "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"            "kg/sec"
+state integer  STEPBIOE          -      misc        1         -      r        "STEPBIOE"                "NUMBER OF FUN DAMENTAL TIMESTEPS BETWEEN BIOGENIC EMIS CALLS"             "NA"
+state integer  STEPPHOT          -      misc        1         -      r        "STEPPHOT"                "NUMBER OF FUN DAMENTAL TIMESTEPS BETWEEN PHOTOLYSIS CALLS"             "NA"
+state integer  STEPCHEM          -      misc        1         -      r        "STEPCHEM"                "NUMBER OF FUN DAMENTAL TIMESTEPS BETWEEN CHEM MECH CALLS"             "NA"
+state    real   SNOWH            ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)      "SNOWH"                 "PHYSICAL SNOW DEPTH"  ""
+state    real   RHOSN            ij     misc        1         -     i01rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3"
+state    real   SMFR3D           ilj    misc        1         Z      rh       "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r         "KEEPFR3DFLAG"         "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# added state for etampnew microphysics (needed for restarts)
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state       p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state      p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because the are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     -
+state    integer  landuse_lucats  -      misc       -          -     -
+state    integer  landuse_luseas  -      misc       -          -     -
+state    integer  landuse_isn     -      misc       -          -     -
+state    real     lu_state        p      misc       -          -     -
+
+
+#################################################################
+#                                               
+                                                
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     h         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     h         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -         "julian"                "day of year"         ""      
+                                                
+state   integer emissframes    -        -          -         -     -         "emissframes"           ""         ""
+# input file descriptor for lbcs on parent domain                                               
+        had2chem_tim=had2chem_tim+timef()-btimx
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+                                                
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1993    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      03    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      13    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      12    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1993    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      03    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      14    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      12    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control         max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  emi_inname        namelist,time_control            1  "wrfchemi_d<domain>_<date>"   -     "name of chem emissions infile"  ""    ""
+rconfig   character  emi_outname       namelist,time_control            1  "wrfchemi_d<domain>_<date>"   -     "name of chem emissions outfile" ""    ""
+rconfig   integer frames_per_emissfile    namelist,time_control         1              12      h     "frames_per_emissfile"          ""      ""
+rconfig   integer io_style_emissions      namelist,time_control     1              1       -     "io_style_emissions"    ""      ""
+rconfig   integer     io_form_emissions   namelist,time_control         1              2       h        "io_form_emissions"              ""      ""
+rconfig   character  input_chem_inname       namelist,time_control              1  "wrf_chem_input_d<domain>_<date>"   -     "name of chem infile"  ""    ""
+rconfig   character  input_chem_outname      namelist,time_control              1  "wrf_chem_input_d<domain>_<date>"   -     "name of chem outfile" ""    ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+rconfig   real    tstart                  namelist,time_control     max_domains       0       rh   "tstart"  "forecast hour at the start of the NMM integration"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       h     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       h     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+
+# Physics
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   real    BIOEMDT                 namelist,physics      max_domains    0       h    "BIOEMDT"          "" ""
+rconfig   real    PHOTDT                  namelist,physics      max_domains    0       h    "PHOTDT"          ""  ""
+rconfig   real    CHEMDT                  namelist,physics      max_domains    0       h    "CHEMDT"          ""  ""
+rconfig   integer ne_area                 namelist,physics      1           41       irh    "ne_area"               ""      ""
+rconfig   integer kemit                   namelist,physics      1             9       irh   "kemit"                 ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics      1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1             5       irh    "num_soil_layers"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics      1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics      1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+
+# nmm variables
+rconfig   integer idtad                   namelist,physics     max_domains    2       irh    "idtad"  "fundamental timesteps between calls to NMM passive advection scheme"
+rconfig   integer nsoil                   namelist,physics     max_domains    4       irh    "nsoil"  "number of soil layers"
+rconfig   integer nphs                    namelist,physics     max_domains   10       irh    "nphs"  "fundamental timesteps between calls to NMM turbulence"
+rconfig   integer ncnvc                   namelist,physics     max_domains   10       irh    "ncnvc"  "fundamental timesteps between calls to NMM convection"
+rconfig   integer nrads                   namelist,physics     max_domains  200       irh    "nrads"  "fundamental timesteps between calls to NMM shortwave radiation"
+rconfig   integer nradl                   namelist,physics     max_domains  200       irh    "nradl"  "fundamental timesteps between calls to NMM longwave radiation"
+rconfig   real    tprec                   namelist,physics     max_domains    3.       rh    "tprec"  "number of hours in bucket for total precipitation"
+rconfig   real    theat                   namelist,physics     max_domains    6.       rh    "theat"  "number of hours in bucket for gridscale and convective heating rates"
+rconfig   real    tclod                   namelist,physics     max_domains    6.       rh    "tclod"  "number of hours in bucket for cloud amounts"
+rconfig   real    trdsw                   namelist,physics     max_domains    6.       rh    "trdsw"  "number of hours in bucket for short wave fluxes"
+rconfig   real    trdlw                   namelist,physics     max_domains    6.       rh    "trdlw"  "number of hours in bucket for long wave fluxes"
+rconfig   real    tsrfc                   namelist,physics     max_domains    6.       rh    "tsrfc"  "number of hours in bucket for evaporation / sfc fluxes"
+rconfig   logical pcpflg                  namelist,physics     max_domains   .false.   rh    "pcpflg"  "logical switch that turns on/off the precipitation assimilation"
+rconfig   integer sigma                   namelist,physics     max_domains    1       irh    "sigma"  "logical switch for NMM vertical coordinate (sigma or hybrid)"
+rconfig   integer co2tf                   namelist,physics     1              0       -      "co2tf"  "GFDL radiation co2 flag"
+rconfig   integer ra_call_offset          namelist,physics     1             -1       -      "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback         namelist,physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             1       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             1       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    base_pres               namelist,dynamics     1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics     1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics     1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.2     h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.      h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.      h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    .1      h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    10      h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    3       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    3       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    100.    h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient      namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      ""
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      ""
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   integer     chem_in_opt         namelist,dynamics     max_domains    0       rh       "chem_in_opt"     ""      ""
+rconfig   integer     phot_opt            namelist,dynamics     max_domains    0       rh       "phot_opt"        ""      ""
+rconfig   integer     drydep_opt          namelist,dynamics     max_domains    0       rh       "drydep_opt"      ""      "" 
+rconfig   integer     bio_emiss_opt       namelist,dynamics     max_domains    0       rh       "bio_emiss_opt"   ""      ""    
+rconfig   integer     emiss_inpt_opt      namelist,dynamics     max_domains    0       rh       "emiss_inpt_opt"  ""      ""
+rconfig   integer     gas_bc_opt          namelist,dynamics     max_domains    1       rh       "gas_bc_opt"      ""      ""
+rconfig   integer     gas_ic_opt          namelist,dynamics     max_domains    1       rh       "gas_ic_opt"      ""      ""
+rconfig   integer     aer_bc_opt          namelist,dynamics     max_domains    1       rh       "aer_bc_opt"      ""      ""
+rconfig   integer     aer_ic_opt          namelist,dynamics     max_domains    1       rh       "aer_ic_opt"      ""      ""
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   logical have_bcs_chem           namelist,bdy_control  max_domains    .false. rh    "have_bcs_chem"                "" ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   real    emifrq                  derived                  max_domains    0       -        "emifrq"               "chem emissions input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn     dyn_opt==0                   -             -
+package   dyn_nmm       dyn_opt==4                   -             -
+
+
+#### 9. Edit the Registry file to set up '5' as the value of the
+**** namelist variable dyn_opt that means to select our exp dyncore.
+package   dyn_exp       dyn_opt==5                   -             -
+
+#package   passivec1     chem_opt==0                  -
+package   radm2         chem_opt==1                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2
+package   radm2sorg     chem_opt==2                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,so4aj,so4ai,nh4aj,nh4ai,no3aj,no3ai,orgaro1j,orgaro1i,orgaro2j,orgaro2i,orgalk1j,orgalk1i,orgole1j,orgole1i,orgba1j,orgba1i,orgba2j,orgba2i,orgba3j,orgba3i,orgba4j,orgba4i,orgpaj,orgpai,ecj,eci,p25j,p25i,antha,seas,soila,nu0,ac0,corn
+package   racm          chem_opt==3                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,ho,ho2
+package   racmsorg      chem_opt==4                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,ho,ho2,so4aj,so4ai,nh4aj,nh4ai,no3aj,no3ai,orgaro1j,orgaro1i,orgaro2j,orgaro2i,orgalk1j,orgalk1i,orgole1j,orgole1i,orgba1j,orgba1i,orgba2j,orgba2i,orgba3j,orgba3i,orgba4j,orgba4i,orgpaj,orgpai,ecj,eci,p25j,p25i,antha,seas,soila,nu0,ac0,corn
+package   cbmz          chem_opt==5                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,hcl,ch3o2,ethp,ch3oh,c2h5oh,par,to2,cro,open,op3,c2o3,ro2,ano2,nap,xo2,xpar,isoprd,isopp,isopn,isopo2,dms,msa,dmso,dmso2,ch3so2h,ch3sch2oo,ch3so2,ch3so3,ch3so2oo,ch3so2ch2oo,mtf
+package   cbmz_bb       chem_opt==6                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,hcl,ch3o2,ethp,ch3oh,c2h5oh,par,to2,cro,open,op3,c2o3,ro2,ano2,nap,xo2,xpar,isoprd,isopp,isopn,isopo2
+package   cbmz_mosaic_aa  chem_opt==7                -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,hcl,ch3o2,ethp,ch3oh,c2h5oh,par,to2,cro,open,op3,c2o3,ro2,ano2,nap,xo2,xpar,isoprd,isopp,isopn,isopo2,so4_a01,no3_a01,cl_a01,nh4_a01,na_a01,oin_a01,oc_a01,bc_a01,hysw_a01,water_a01,num_a01,so4_a02,no3_a02,cl_a02,nh4_a02,na_a02,oin_a02,oc_a02,bc_a02,hysw_a02,water_a02,num_a02,so4_a03,no3_a03,cl_a03,nh4_a03,na_a03,oin_a03,oc_a03,bc_a03,hysw_a03,water_a03,num_a03,so4_a04,no3_a04,cl_a04,nh4_a04,na_a04,oin_a04,oc_a04,bc_a04,hysw_a04,water_a04,num_a04
+package   cbmz_mosaic_bb  chem_opt==8                -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,hcl,ch3o2,ethp,ch3oh,c2h5oh,par,to2,cro,open,op3,c2o3,ro2,ano2,nap,xo2,xpar,isoprd,isopp,isopn,isopo2,so4_a01,no3_a01,cl_a01,nh4_a01,na_a01,oin_a01,oc_a01,bc_a01,hysw_a01,water_a01,num_a01,so4_a02,no3_a02,cl_a02,nh4_a02,na_a02,oin_a02,oc_a02,bc_a02,hysw_a02,water_a02,num_a02,so4_a03,no3_a03,cl_a03,nh4_a03,na_a03,oin_a03,oc_a03,bc_a03,hysw_a03,water_a03,num_a03,so4_a04,no3_a04,cl_a04,nh4_a04,na_a04,oin_a04,oc_a04,bc_a04,hysw_a04,water_a04,num_a04,so4_a05,no3_a05,cl_a05,nh4_a05,na_a05,oin_a05,oc_a05,bc_a05,hysw_a05,water_a05,num_a05,so4_a06,no3_a06,cl_a06,nh4_a06,na_a06,oin_a06,oc_a06,bc_a06,hysw_a06,water_a06,num_a06,so4_a07,no3_a07,cl_a07,nh4_a07,na_a07,oin_a07,oc_a07,bc_a07,hysw_a07,water_a07,num_a07,so4_a08,no3_a08,cl_a08,nh4_a08,na_a08,oin_a08,oc_a08,bc_a08,hysw_a08,water_a08,num_a08
+package   chem_tracer   chem_opt==13                 -             chem:so2,co
+#cms++
+package   radm2_kpp        chem_opt==101                 -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,ho,ho2
+
+package   racm_mim_kpp      chem_opt==102                  -            chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,hace,ishp,ison,mahp,mpan,nald,ho,ho2  
+
+package   racm_kpp      chem_opt==103                -            chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,ho,ho2
+
+package   racmsorg_kpp      chem_opt==104                  -            chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ete,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,co2,ch4,udd,hket,api,lim,dien,macr,ho,ho2,so4aj,so4ai,nh4aj,nh4ai,no3aj,no3ai,orgaro1j,orgaro1i,orgaro2j,orgaro2i,orgalk1j,orgalk1i,orgole1j,orgole1i,orgba1j,orgba1i,orgba2j,orgba2i,orgba3j,orgba3i,orgba4j,orgba4i,orgpaj,orgpai,ecj,eci,p25j,p25i,antha,seas,soila,nu0,ac0,corn
+
+package   radm2sorg_kpp     chem_opt==105                  -             chem:so2,sulf,no2,no,o3,hno3,h2o2,ald,hcho,op1,op2,paa,ora1,ora2,nh3,n2o5,no3,pan,hc3,hc5,hc8,eth,co,ol2,olt,oli,tol,xyl,aco3,tpan,hono,hno4,ket,gly,mgly,dcb,onit,csl,iso,ho,ho2,so4aj,so4ai,nh4aj,nh4ai,no3aj,no3ai,orgaro1j,orgaro1i,orgaro2j,orgaro2i,orgalk1j,orgalk1i,orgole1j,orgole1i,orgba1j,orgba1i,orgba2j,orgba2i,orgba3j,orgba3i,orgba4j,orgba4i,orgpaj,orgpai,ecj,eci,p25j,p25i,antha,seas,soila,nu0,ac0,corn
+
+package   photmad       phot_opt==1                  -             -
+package   photfastj     phot_opt==2                  -             -
+package   wesely        drydep_opt==1                -             -
+package   gunther1      bio_emiss_opt==1             -             -
+package   beis311       bio_emiss_opt==2             -             -
+
+# emiss_inpt_default        = radm2-sorgam emissions in "standard(=grell)" wrf-chem
+# emiss_inpt_pnnl_cm        = cbmz-mosaic  emissions in "PNNL" format
+# emiss_inpt_pnnl_rs        = radm2-sorgam emissions in "PNNL" format (same as default except isoprene added)
+package   emiss_inpt_default          emiss_inpt_opt==1            -             -
+package   emiss_inpt_pnnl_cm          emiss_inpt_opt==101          -             -
+package   emiss_inpt_pnnl_rs          emiss_inpt_opt==102          -             -
+
+# gas/aer_bc/ic_default     = bc/ic in "standard(=grell)" wrf-chem for radm2-sorgam species,
+#                                   and first-cut implementation for cbmz-mosaic species
+# gas/aer_bc/ic_pnnl        = bc/ic for PNNL simulations
+package   gas_bc_default              gas_bc_opt==1                -             -
+package   gas_bc_pnnl                 gas_bc_opt==101              -             -
+package   gas_ic_default              gas_ic_opt==1                -             -
+package   gas_ic_pnnl                 gas_ic_opt==101              -             -
+package   aer_bc_default              aer_bc_opt==1                -             -
+package   aer_bc_pnnl                 aer_bc_opt==101              -             -
+package   aer_ic_default              aer_ic_opt==1                -             -
+package   aer_ic_pnnl                 aer_ic_opt==101              -             -
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             -
+package   gfdllwscheme  ra_lw_physics==99            -             moist:qv,qc,qr,qi
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             -
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   nmmlsmscheme   sf_surface_physics==99      -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# NMM communications
+
+#halo HALO_NMM_INIT_1	dyn_nmm 120:LMH,LMV,HBM2
+halo HALO_NMM_INIT_1	dyn_nmm 120:HBM2
+halo HALO_NMM_INIT_2	dyn_nmm 120:HBM3,VBM2,VBM3
+halo HALO_NMM_INIT_3	dyn_nmm 120:SM,SICE,HTM
+halo HALO_NMM_INIT_4	dyn_nmm 120:VTM,DX_NMM,WPDAR
+halo HALO_NMM_INIT_5	dyn_nmm 120:CPGFU,CURV,FCP
+halo HALO_NMM_INIT_6	dyn_nmm 120:FDIV,FAD,F
+halo HALO_NMM_INIT_7	dyn_nmm 120:DDMPU,DDMPV,GLAT
+halo HALO_NMM_INIT_8	dyn_nmm 120:GLON,EPSR,TG
+halo HALO_NMM_INIT_9	dyn_nmm 120:GFFC,SST,ALBASE
+#halo HALO_NMM_INIT_10	dyn_nmm 120:HDAC,HDACV,IVGTYP
+halo HALO_NMM_INIT_10	dyn_nmm 120:HDAC,HDACV
+#halo HALO_NMM_INIT_11	dyn_nmm 120:ISLTYP,ISLOPE,VEGFRC
+halo HALO_NMM_INIT_11	dyn_nmm 120:VEGFRC
+halo HALO_NMM_INIT_12	dyn_nmm 120:DIV,OMGALF,PD,RES
+halo HALO_NMM_INIT_13	dyn_nmm 120:FIS,T,U
+halo HALO_NMM_INIT_14	dyn_nmm 120:V,Q,Q2,CHEM
+halo HALO_NMM_INIT_15	dyn_nmm 120:CWM,TRAIN,TCUCN
+halo HALO_NMM_INIT_15B	dyn_nmm 120:moist,scalar
+halo HALO_NMM_INIT_16	dyn_nmm 120:RSWIN,RSWOUT,TG
+halo HALO_NMM_INIT_17	dyn_nmm 120:Z0,AKMS,CZEN
+halo HALO_NMM_INIT_18	dyn_nmm 120:AKHS,THS,QSH
+halo HALO_NMM_INIT_19	dyn_nmm 120:TWBS,QWBS,HBOT
+halo HALO_NMM_INIT_20	dyn_nmm 120:CFRACL,THZ0,QZ0
+halo HALO_NMM_INIT_21	dyn_nmm 120:UZ0,VZ0,USTAR
+halo HALO_NMM_INIT_22	dyn_nmm 120:HTOP,CFRACM,SNO
+halo HALO_NMM_INIT_23	dyn_nmm 120:SI,CLDEFI,RF
+halo HALO_NMM_INIT_24	dyn_nmm 120:CUPPT,CFRACH,SOILTB
+halo HALO_NMM_INIT_25	dyn_nmm 120:SFCEXC,SMSTAV,SMSTOT
+halo HALO_NMM_INIT_26	dyn_nmm 120:GRNFLX,PCTSNO,RLWIN
+halo HALO_NMM_INIT_27	dyn_nmm 120:RADOT,CZMEAN,SIGT4
+halo HALO_NMM_INIT_28	dyn_nmm 120:SR
+halo HALO_NMM_INIT_29	dyn_nmm 120:PREC,ACPREC,ACCLIQ
+halo HALO_NMM_INIT_30	dyn_nmm 120:ACFRST,ACSNOW
+halo HALO_NMM_INIT_31	dyn_nmm 120:ACSNOM,SSROFF,BGROFF
+halo HALO_NMM_INIT_32	dyn_nmm 120:SFCSHX,SFCLHX,SUBSHX
+halo HALO_NMM_INIT_33	dyn_nmm 120:SNOPCX,SFCUVX,SFCEVP
+halo HALO_NMM_INIT_34	dyn_nmm 120:POTEVP,ASWIN,ASWOUT
+halo HALO_NMM_INIT_35	dyn_nmm 120:ASWTOA,ALWIN,ALWOUT
+halo HALO_NMM_INIT_36	dyn_nmm 120:ALWTOA,SMC,CMC
+halo HALO_NMM_INIT_37	dyn_nmm 120:STC,SH2O,ALBEDO
+halo HALO_NMM_INIT_38   dyn_nmm 120:PINT,Z,DWDT
+halo HALO_NMM_INIT_39	dyn_nmm 120:TOLD,UOLD,VOLD
+
+halo      HALO_NMM_A  dyn_nmm 24:pd,t,u,v,q,cwm,dwdt,div;24:pint                          
+halo      HALO_NMM_A_2  dyn_nmm 24:CHEM
+halo      HALO_NMM_A_3  dyn_nmm 24:moist,scalar
+halo      HALO_NMM_B  dyn_nmm 24:div                   
+halo      HALO_NMM_C  dyn_nmm 8:u,v                    
+halo      HALO_NMM_D  dyn_nmm 24:pd          
+halo      HALO_NMM_E  dyn_nmm 24:petdt
+halo      HALO_NMM_F  dyn_nmm 24:t,u,v
+halo      HALO_NMM_F1 dyn_nmm 80:pdslo          
+halo      HALO_NMM_G  dyn_nmm 24:u,v;24:z                    
+halo      HALO_NMM_H  dyn_nmm 24:w,lmh
+halo      HALO_NMM_I  dyn_nmm 48:q,q2,cwm                    
+halo      HALO_NMM_I_2  dyn_nmm 48:CHEM
+halo      HALO_NMM_I_3  dyn_nmm 48:moist,scalar
+halo      HALO_NMM_J  dyn_nmm 8:pd,uz0,vz0,t,q,cwm                    
+halo      HALO_NMM_J_2  dyn_nmm 8:CHEM
+halo      HALO_NMM_J_3  dyn_nmm 8:moist,scalar                    
+halo      HALO_NMM_K  dyn_nmm 8:q2;24:t,u,v,q,w,z
+halo      HALO_NMM_L  dyn_nmm 8:pd,t,q,cwm,q2                    
+halo      HALO_NMM_L_2  dyn_nmm 8:CHEM
+halo      HALO_NMM_L_3  dyn_nmm 8:moist,scalar
+
+halo      HALO_NMM_TURBL_A  dyn_nmm 8:uz0h,vz0h,hbm2
+halo      HALO_NMM_TURBL_B  dyn_nmm 8:dudt,dvdt
+
Index: trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.NMM_NEST
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.NMM_NEST	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/archive/Registry.NMM_NEST	(revision 2744)
@@ -0,0 +1,1091 @@
+# Registry file NMM_NEST
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain           x          west_east
+dimspec    j      3     standard_domain           y          south_north
+dimspec    k      2     standard_domain           z          bottom_top
+dimspec    l      2     namelist=num_soil_layers  z          soil_layers
+dimspec    w      -     namelist=spec_bdy_width   c          spec_bdy_width
+dimspec    u      2     namelist=num_land_cat     z          land_cat
+dimspec    s      2     namelist=num_soil_cat     z          soil_cat
+dimspec    e      3     namelist=ensdim           z          gd ensemble dimension
+dimspec    p      -     constant=7501             c          microphysics_rstrt_state
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    g      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    o      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+ 
+
+#### 7. Edit the Registry file and create the state data assocaited with this
+####    solver.  Single entry:
+state real x ikj dyn_exp 2 - ih "TOYVAR"
+####
+
+################################################################################
+################################################################################
+################################################################################
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#
+# It is reauired that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+#
+state    real  LU_INDEX         ij      misc        1         -     irh01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+################################################################################
+################################################################################
+
+# Variables for nmm dynamics                                            
+#
+# module_BC
+#
+# pdb is only 2d but registry doesn't support 2d bdy arrays right now...
+#definitions for NMM slab arrays
+dimspec    q      -     constant=2600             c  # a little crude right now
+dimspec    v      -     constant=1             c  # a little crude right now
+
+# The following arrays were added to avoid using _b and _bt arrays for nesting.
+# This is gopal' doing:
+
+state  real    pdnest_b     ij      dyn_nmm     1      -      -
+state  real    pdnest_bt    ij      dyn_nmm     1      -      -
+state  real    tnest_b      ikj     dyn_nmm     1      -      -
+state  real    tnest_bt     ikj     dyn_nmm     1      -      -
+state  real    qnest_b      ikj     dyn_nmm     1      -      -
+state  real    qnest_bt     ikj     dyn_nmm     1      -      -
+state  real    unest_b      ikj     dyn_nmm     1      -      -
+state  real    unest_bt     ikj     dyn_nmm     1      -      -
+state  real    vnest_b      ikj     dyn_nmm     1      -      -
+state  real    vnest_bt     ikj     dyn_nmm     1      -      -
+state  real    q2nest_b     ikj     dyn_nmm     1      -      -
+state  real    q2nest_bt    ikj     dyn_nmm     1      -      -
+state  real    cwmnest_b    ikj     dyn_nmm     1      -      -
+state  real    cwmnest_bt   ikj     dyn_nmm     1      -      -
+
+#
+# For the moving nest. This is gopal's doing
+#
+
+state  real   pdyn       ij     dyn_nmm     1      -    r  "PDYN"  "DYNAMIC PRESSURE USED FOR TRACKING GRID MOTION" 
+state  real   mslp       ij     dyn_nmm     1      -    r  "MSLP"  "MSLP USED TO DETERMINE STORM LOCATION" 
+state  real   sqws       ij     dyn_nmm     1      -    r  "SQWS"  "SQUARE OF WIND SPEED AT LEVEL 10"
+state integer xloc         -    dyn_nmm     2      -    r  "XLOC"  "I-LOCATION OF MINIMUM DYNAMIC PRESSURE"
+state integer yloc         -    dyn_nmm     2      -    r  "YLOC"  "J-LOCATION OF MINIMUM DYNAMIC PRESSURE"
+state logical mvnest       -    dyn_nmm     1      -    rm  "MVNEST" "LOGICAL SWITCH FOR NMM GRID MOTION" 
+# flag for nest movement
+state  logical moved       -     misc       1      -     -
+
+# Location of the SOUTH-WEST nested pointed in terms of parent grid 
+
+state integer  IIH      ij     dyn_nmm     1      -      -
+state integer  JJH      ij     dyn_nmm     1      -      -
+state integer  IIV      ij     dyn_nmm     1      -      -
+state integer  JJV      ij     dyn_nmm     1      -      -
+
+# Bi-linear weights
+
+state  real   HBWGT1       ij     dyn_nmm     1      -      -
+state  real   HBWGT2       ij     dyn_nmm     1      -      -
+state  real   HBWGT3       ij     dyn_nmm     1      -      -
+state  real   HBWGT4       ij     dyn_nmm     1      -      -
+state  real   VBWGT1       ij     dyn_nmm     1      -      -
+state  real   VBWGT2       ij     dyn_nmm     1      -      -
+state  real   VBWGT3       ij     dyn_nmm     1      -      -
+state  real   VBWGT4       ij     dyn_nmm     1      -      -
+
+#
+state  real   HLON        ij     dyn_nmm     1      -      d=(test_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)
+state  real   HLAT        ij     dyn_nmm     1      -      d=(test_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)
+state  real   VLON        ij     dyn_nmm     1      -      -
+state  real   VLAT        ij     dyn_nmm     1      -      -
+
+#
+rconfig  real wbd0    derived   max_domains    0       - "wbd0"                  "western boundary of the domain"
+rconfig  real sbd0    derived   max_domains    0       - "sbd0"                  "southern boundary of the domain"
+
+state  real   PSTD      k      dyn_nmm     1      Z      -
+state  integer KZMAX    -      dyn_nmm     -      -      r
+state  real   Z3D       ikj    dyn_nmm     1      Z      rd=(nmm_copy:IIH,JJH)f=(nmm_copy:IIH,JJH) "Z3D" "HEIGHT ARRAY FIELD VALID FOR PARENT ONLY"
+state  real   T3D       ikj    dyn_nmm     1      -      rd=(nmm_copy:IIH,JJH)f=(nmm_copy:IIH,JJH) "T3D" "TEMPERATURE ARRAY ON STANDARD PRESSURE LEVELS"
+state  real   Q3D       ikj    dyn_nmm     1      -      rd=(nmm_copy:IIH,JJH)f=(nmm_copy:IIH,JJH) "Q3D" "SP HUMIDITY ARRAY ON STANDARD PRESSURE LEVELS"
+state  real HRES_FIS    ij     dyn_nmm     1      -      r  "HRES_FIS" "HIGH RESOLUTION TERRAIN DATA FOR NESTED DOMAIN"
+
+
+#
+# module_LOOPS
+#
+state integer  lmh      ij     dyn_nmm     1      -      irh      "LMH"     "Lowest model layer at mass points from domain top"       ""
+state integer  lmv      ij     dyn_nmm     1      -      irh      "LMV"     "Lowest model layer at velocity points from domain top"   ""
+#
+# module_MASKS
+#
+state  real   hbm2      ij     dyn_nmm     1      -      irh     "HBM2"    "Height boundary mask; =0 outer 2 rows on H points"       ""
+state  real   hbm3      ij     dyn_nmm     1      -      irh     "HBM3"    "Height boundary mask; =0 outer 3 rows on H points"       ""
+state  real   vbm2      ij     dyn_nmm     1      -      irh     "VBM2"    "Velocity boundary mask; =0 outer 2 rows on V points"     ""
+state  real   vbm3      ij     dyn_nmm     1      -      irh     "VBM3"    "Velocity boundary mask; =0 outer 3 rows on V points"     ""
+state  real   sm        ij     dyn_nmm     1      -      i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "SM"      "Sea mask; =1 for sea, =0 for land"
+state  real   sice      ij     dyn_nmm     1      -      irh     "SICE"    "Sea ice mask; =1 for sea ice, =0 for no sea ice"         ""
+state  real   htm       ikj    dyn_nmm     1      -      rh      "HTM"     "Height mask; =1 at all mass points above ground"         ""
+state  real   vtm       ikj    dyn_nmm     1      -      rh      "VTM"     "Velocity mask; =1 at all velocity points above ground"   ""
+#
+# module_VRBLS
+#
+state  integer ntsd     -       dyn_nmm     -      -      r       "NTSD"    "Number of timesteps done"                      ""
+state  integer nstart_hour  -   dyn_nmm     -      -      r       "NSTART_HOUR"   "Forecast hour at start of integration"   ""
+state  real   pd        ijb     dyn_nmm     1      -      i01rhu=(nmm_feedback:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)d=(interp_mass_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4,Z3D,HRES_FIS,SM,PDTOP,PT,PSTD,KZMAX)f=(nmm_bdymass_hinterp:dt,pdnest_b,pdnest_bt,IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4,Z3D,HRES_FIS,SM,PDTOP,PT,PSTD,KZMAX)  "PD"      "Mass at I,J in the sigma domain"               "Pa"
+state  real   fis       ij     dyn_nmm     1      -      i01rh   "FIS"     "Surface geopotential"                          "m2 s-2"
+state  real   res       ij     dyn_nmm     1      -      irh     "RES"     "Reciprocal of surface sigma"                   ""
+#state  real   q         ikjb    dyn_nmm     1      -      i01rhu=(nmm_feedback:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)d=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)f=(nmm_bdy_hinterp:dt,qnest_b,qnest_bt,IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)   "Q"       "Specific humidity"                             "kg kg-1"
+#state  real   t         ikjb    dyn_nmm     1      -      i01rhu=(nmm_feedback:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)d=(interp_p2hyb_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4,Z3D,Q,HRES_FIS,PD,PSTD,PDTOP,PT,ETA1,ETA2,DETA1,DETA2)f=(nmm_bdy_p2hyb:dt,tnest_b,tnest_bt,Z3D,qnest_b,HRES_FIS,pdnest_b,PSTD,PDTOP,PT,ETA1,ETA2,DETA1,DETA2)   "T"       "Sensible temperature"                          "K"
+state  real   t         ikjb    dyn_nmm     1      -      i01rhu=(nmm_feedback:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)d=(interp_scalar_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4,T3D,PD,PSTD,PDTOP,PT,ETA1,ETA2)f=(nmm_bdy_scalar:dt,tnest_b,tnest_bt,IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4,T3d,PD,PSTD,PDTOP,PT,ETA1,ETA2)  "T"       "Sensible temperature"                          "K"
+state  real   q         ikjb    dyn_nmm     1      -      i01rhu=(nmm_feedback:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)d=(interp_scalar_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4,Q3D,PD,PSTD,PDTOP,PT,ETA1,ETA2)f=(nmm_bdy_scalar:dt,qnest_b,qnest_bt,IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4,Q3d,PD,PSTD,PDTOP,PT,ETA1,ETA2)  "Q"       "Specific humidity"                             "kg kg-1"
+state  real   u         ikjb    dyn_nmm     1      -      i01rhu=(nmm_vfeedback:IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4)d=(interp_v_nmm:IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4)f=(nmm_bdy_vinterp:dt,unest_b,unest_bt,IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4)   "U"       "U component of wind"                           "m s-1"
+state  real   v         ikjb    dyn_nmm     1      -      i01rhu=(nmm_vfeedback:IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4)d=(interp_v_nmm:IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4)f=(nmm_bdy_vinterp:dt,vnest_b,vnest_bt,IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4)   "V"       "V component of wind"                           "m s-1"
+state  real   told      ikj    dyn_nmm     1      -      r       "TOLD"    "T from previous timestep"                      "K"
+state  real   uold      ikj    dyn_nmm     1      -      r       "UOLD"    "U from previous timestep"                      "m s-1"
+state  real   vold      ikj    dyn_nmm     1      -      r       "VOLD"    "V from previous timestep"                      "m s-1"
+#
+# module_DYNAM
+#
+state  real   dx_nmm    ij     dyn_nmm     1      -      irh     "DX_NMM"  "East-west distance H-to-V points"              "m"
+state  real   wpdar     ij     dyn_nmm     1      -      ir
+state  real   cpgfu     ij     dyn_nmm     1      -      ir
+state  real   curv      ij     dyn_nmm     1      -      ir      "CURV"    "Curvature term= .5*DT*TAN(phi)/RadEarth"       "s m-1"
+state  real   fcp       ij     dyn_nmm     1      -      ir
+state  real   fdiv      ij     dyn_nmm     1      -      ir
+state  real   f         ij     dyn_nmm     1      -      ir      "F"       "Coriolis * DT/2"                               ""
+state  real   fad       ij     dyn_nmm     1      -      ir
+state  real   ddmpu     ij     dyn_nmm     1      -      ir      "DDMPU"   "Divergence damping term for U"                 "m"
+state  real   ddmpv     ij     dyn_nmm     1      -      ir      "DDMPV"   "Divergence damping term for V"                 "m"
+state  real   deta      k      dyn_nmm     1      -      i01r    "DETA"    "Delta sigma in sigma domain"                   ""
+state  real   rdeta     k      dyn_nmm     1      -      ir      "RDETA"   "Reciprocal of DETA"
+state  real   aeta      k      dyn_nmm     1      -      i01r
+state  real   f4q2      k      dyn_nmm     1      -      ir
+state  real   etax      k      dyn_nmm     1      -      i01r
+state  real   dfl       k      dyn_nmm     1      Z      i01r    "DFL"     "Standard atmosphere geopotential"              "m2 s-2"
+state  real   deta1     k      dyn_nmm     1      -      i01r    "DETA1"   "Delta sigma in pressure domain"                ""
+state  real   aeta1     k      dyn_nmm     1      -      i01r    "AETA1"   "Midlayer sigma value in pressure domain"       ""
+state  real   eta1      k      dyn_nmm     1      -      i01rh   "ETA1"    "Interface sigma value in pressure domain"      ""
+state  real   deta2     k      dyn_nmm     1      -      i01r    "DETA2"   "Delta sigma in sigma domain"                   ""
+state  real   aeta2     k      dyn_nmm     1      -      i01r    "AETA2"   "Midlayer sigma value in sigma domain"          ""
+state  real   eta2      k      dyn_nmm     1      -      i01rh   "ETA2"    "Interface sigma value in sigma domain"         ""
+state  real   em        q      dyn_nmm     1      -      ir
+state  real   emt       q      dyn_nmm     1      -      ir
+state  real   adt       ikj    dyn_nmm     1      -      -       "ADT"     "Change of T due to advection"                  "K"
+state  real   adu       ikj    dyn_nmm     1      -      -       "ADU"     "Change of U due to advection"                  "m s-1"
+state  real   adv       ikj    dyn_nmm     1      -      -       "ADV"     "Change of V due to advection"                  "m s-1"
+state  real   em_loc    q      dyn_nmm     1      -      r
+state  real   emt_loc   q      dyn_nmm     1      -      r
+state  real   dy_nmm    -      dyn_nmm     -      -      ir      "DY_NMM"  "North-south distance H-to-V points"            "m"
+state  real   cpgfv     -      dyn_nmm     -      -      ir
+state  real   en        -      dyn_nmm     -      -      ir
+state  real   ent       -      dyn_nmm     -      -      ir
+state  real   f4d       -      dyn_nmm     -      -      ir
+state  real   f4q       -      dyn_nmm     -      -      ir
+state  real   ef4t      -      dyn_nmm     -      -      ir
+state  logical upstrm   -      dyn_nmm     -      -      -       "UPSTRM"  ".TRUE. => In upstream advec region of grid"    ""
+state  real   dlmd      -      dyn_nmm     -      -      ir      "DLMD"    "East-west angular distance H-to-V points"      "degrees"
+state  real   dphd      -      dyn_nmm     -      -      ir      "DPHD"    "North-south angular distance H-to-V points"    "degrees"
+state  real   pdtop     -      dyn_nmm     -      -      i01rh   "PDTOP"   "Mass at I,J in pressure domain"                "Pa"
+state  real   pt        -      dyn_nmm     -      -      i01rh   "PT"      "Pressure at top of domain"                     "Pa"
+#
+# module_CONTIN
+#
+state  real   pdsl      ij     dyn_nmm     1      -      -       "PDSL"    "Sigma-domain pressure at sigma=1"           "Pa"
+state  real   pdslo     ij     dyn_nmm     1      -      -       "PDSLO"   "PDSL from previous timestep"                "Pa"
+state  real   psdt      ij     dyn_nmm     1      -      r       "PSDT"    "Surface pressure tendency"                  "Pa s-1"
+state  real   div       ikj    dyn_nmm     1      -      r       "DIV"     "Divergence"                                 "Pa s-1"
+state  real   few       ikj    dyn_nmm     1      -      -       "FEW"     "Integrated east-west mass flux"             "Pa m2 s-1"
+state  real   fne       ikj    dyn_nmm     1      -      -       "FNE"     "Integrated northeast-southwest mass flux"   "Pa m2 s-1"
+state  real   fns       ikj    dyn_nmm     1      -      -       "FNS"     "Integrated north-south mass flux"           "Pa m2 s-1"
+state  real   fse       ikj    dyn_nmm     1      -      -       "FSE"     "Integrated southeast-northwest mass flux"   "Pa m2 s-1"
+state  real   omgalf    ikj    dyn_nmm     1      -      r       "OMGALF"  "Omega-alpha"                                "K"
+state  real   petdt     ikj    dyn_nmm     1      -      -       "PETDT"   "Vertical mass flux"                         "Pa s-1"
+state  real   rtop      ikj    dyn_nmm     1      -      r       "RTOP"    "Rd * Tv / P"                                "m3 kg-1"
+#
+# module_PVRBLS
+#
+state real  pblh        ij    dyn_nmm   1    -     rh       "PBLH"     "PBL Height"                           "m"
+state integer lpbl      ij    dyn_nmm   1    -     ir       "LPBL"     "Model layer of PBL top"               ""
+state  real   ustar     ij    dyn_nmm   1    -     irhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "USTAR"    "Friction velocity"                    "m s-1"
+state  real   z0        ij    dyn_nmm   1    -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "Z0"       "Roughness height"                     "m"
+state  real   z0base    ij    dyn_nmm   1    -     ir       "Z0BASE"   "Base roughness height"                "m"
+state  real   ths       ij    dyn_nmm   1    -     irhd=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "THS"      "Surface potential temperature"        "K"
+state  real   mavail    ij    dyn_nmm   1    -     i
+state  real   qsh       ij    dyn_nmm   1    -     irhd=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "QS"       "Surface specific humidity"            "kg kg-1"
+state  real   twbs      ij    dyn_nmm   1    -     irh      "TWBS"     "Instantaneous sensible heat flux"     "W m-2"
+state  real   qwbs      ij    dyn_nmm   1    -     irh      "QWBS"     "Instantaneous latent heat flux"       "W m-2"
+state  real   prec      ij    dyn_nmm   1    -     rh       "PREC"     "Precipitation in physics timestep"    "m"
+state  real   aprec     ij    dyn_nmm   1    -     rh
+state  real   acprec    ij    dyn_nmm   1    -     rhd=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "ACPREC"   "Accumulated total precipitation"      "m"
+state  real   cuprec    ij    dyn_nmm   1    -     r        "CUPREC"   "Accumulated convective precipitation" "m"
+state  real   lspa      ij    dyn_nmm   1    -     h        "LSPA"     "Land Surface Precipitation Accumulation"   "kg m-2"
+state  real   ddata     ij    dyn_nmm   1    -     -        "DDATA"    "Observed precip to each physics timestep"  "kg m-2"
+state  real   accliq    ij    dyn_nmm   1    -     r
+state  real   sno       ij    dyn_nmm   1    -     irh      "SNO"      "Liquid water snow amount"             "m"
+state  real   si        ij    dyn_nmm   1    -     irh      "SI"       "Snow depth"                           "m"
+state  real   cldefi    ij    dyn_nmm   1    -     rhd=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "CLDEFI"   "Convective cloud efficiency"          ""
+state  real   deep      ij    dyn_nmm   1    -     r        "DEEP"     "Deep convection =>.TRUE."             ""
+state  real   rf        ij    dyn_nmm   1    -     r
+state  real   th10      ij    dyn_nmm   1    -     irh      "TH10"     "10-m potential temperature"           "K"
+state  real   q10       ij    dyn_nmm   1    -     irh      "Q10"      "10-m specific humidity"               "kg kg-1"
+state  real   pshltr    ij    dyn_nmm   1    -     irh      "PSHLTR"   "2-m pressure"                         "Pa"
+state  real   tshltr    ij    dyn_nmm   1    -     irh      "TSHLTR"   "2-m sensible temperature"             "K"
+state  real   qshltr    ij    dyn_nmm   1    -     irh      "QSHLTR"   "2-m specific humidity"                "kg kg-1"
+state  real   q2        ikjb   dyn_nmm   1    -     irhu=(nmm_feedback:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)d=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)f=(nmm_bdy_hinterp:dt,q2nest_b,q2nest_bt,IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)   "Q2"       "2 * Turbulence kinetic energy"        "m2 s-2"
+state  real   t_adj     ikj   dyn_nmm   1    -     rd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "T_ADJ"    "T change due to precip in phys step"  "K"
+state  real   t_old     ikj   dyn_nmm   1    -     r        "T_OLD"    "T before last call to precip"         "K"
+state  real   zero_3d   ikj   dyn_nmm   1    -     r
+state  real   W0AVG     ikj   dyn_nmm   1    -     r        "W0AVG" "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+state  real   AKHS_OUT  ij    dyn_nmm   1    -     h        "AKHS_OUT"  "OUTPUT SFC EXCH COEFF FOR HEAT"                      "m^2 s-1"
+state  real   AKMS_OUT  ij    dyn_nmm   1    -     h        "AKMS_OUT"  "OUTPUT SFC EXCH COEFF FOR MOMENTUM"                  "m^2 s-1"    
+#
+# module_PHYS
+#
+state  real   albase    ij    dyn_nmm   1    -     i01rhd=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "ALBASE"    "Base albedo"            ""
+state  real   albedo    ij    dyn_nmm   1    -     irh      "ALBEDO"    "Dynamic albedo"         ""
+state  real   cnvbot    ij    dyn_nmm   1    -     irh      "CNVBOT"    "Lowest convec cloud bottom lyr between outputs"  ""
+state  real   cnvtop    ij    dyn_nmm   1    -     irh      "CNVTOP"    "Highest convec cloud top lyr between outputs"    ""
+state  real   czen      ij    dyn_nmm   1    -     irh      "CZEN"      "Cosine of solar zenith angle"                    ""
+state  real   czmean    ij    dyn_nmm   1    -     irh      "CZMEAN"    "Mean CZEN between SW radiation calls"            ""
+state  real   epsr      ij    dyn_nmm   1    -     ir       "EPSR"      "Radiative emissivity"
+state  real   gffc      ij    dyn_nmm   1    -     ir
+state  real   glat      ij    dyn_nmm   1    -     i01rh    "GLAT"      "Geographic latitude, radians"                    ""
+state  real   glon      ij    dyn_nmm   1    -     i01rh    "GLON"      "Geographic longitude, radians"                   ""
+state  real   NMM_TSK   ij    dyn_nmm   1    -     i01rd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)     "TSK"       "Skin temperature"                                "K"
+state  real   hdac      ij    dyn_nmm   1    -     ir       "HDAC"      "Composite diffusion coeff for mass points"       "s m-1"
+state  real   hdacv     ij    dyn_nmm   1    -     ir       "HDACV"     "Composite diffusion coeff for velocity points"   "s m-1"
+state  real   mxsnal    ij    dyn_nmm   1    -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "MXSNAL"    "Maximum deep snow albedo"                        ""
+state  real   radin     ij    dyn_nmm   1    -     -
+state  real   radot     ij    dyn_nmm   1    -     rh       "RADOT"     "Radiative emission from surface"                 "W m-2"
+state  real   sigt4     ij    dyn_nmm   1    -     rh       "SIGT4"     "Stefan-Boltzmann * T**4"                         "W m-2"
+state  real   tg        ij    dyn_nmm   1    -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "TGROUND"   "Deep ground soil temperature"                    "K"
+state  real   dfrlg     k     dyn_nmm   1    Z     i01r     "DFRLG"     "Std atmosphere height of model layer interfaces" "m"
+state integer lvl       ij    dyn_nmm   1    -     ir
+#
+# module_CLDWTR.F
+#
+state  real   cwm       ikjb   dyn_nmm   1    -     rhu=(nmm_feedback:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)d=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)f=(nmm_bdy_hinterp:dt,cwmnest_b,cwmnest_bt,IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "CWM"       "Total condensate"                     "kg kg-1"
+state  real   f_ice     ikj   dyn_nmm   1    -     rhd=(interp_int_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "F_ICE"     "Frozen fraction of CWM"               ""
+state  real   f_rain    ikj   dyn_nmm   1    -     rhd=(interp_int_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "F_RAIN"    "Rain fraction of liquid part of CWM"  ""
+state  real   f_rimef   ikj   dyn_nmm   1    -     rhd=(interp_int_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "F_RIMEF"   "Rime factor"                          ""
+state  real   cldfra    ikj   dyn_nmm   1    -     rh       "CLDFRA"    "Cloud fraction"                       ""
+state  real   sr        ij    dyn_nmm   1    -     irh      "SR"        "Timestep mass ratio of snow:precip"   ""
+state  real   cfrach    ij    dyn_nmm   1    -     rh       "CFRACH"    "High cloud fraction"                  ""
+state  real   cfracl    ij    dyn_nmm   1    -     rh       "CFRACL"    "Low cloud fraction"                   ""
+state  real   cfracm    ij    dyn_nmm   1    -     rh       "CFRACM"    "Middle cloud fraction"                ""
+state logical micro_start        -     dyn_nmm   -    -     -
+#
+# module_SOIL.F
+#
+state integer islope    ij    dyn_nmm   1    -     i01rhd=(interp_int_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "ISLOPE"
+state  real   dzsoil    k     dyn_nmm   1    -     ir       "DZSOIL"    "Thickness of soil layers"         "m"
+state  real   rtdpth    k     dyn_nmm   1    -     i01r
+state  real   sldpth    k     dyn_nmm   1    -     i01rh    "SLDPTH"    "Thickness of soil layers"         "m"
+state  real   cmc       ij    dyn_nmm   1    -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "CMC"       "Canopy moisture"                  "m"
+state  real   grnflx    ij    dyn_nmm   1    -     irh      "GRNFLX"    "Deep soil heat flux"              "W m-2"
+state  real   pctsno    ij    dyn_nmm   1    -     irh
+state  real   soiltb    ij    dyn_nmm   1    -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "SOILTB"    "Deep ground soil temperature"     "K"
+state  real   vegfrc    ij    dyn_nmm   1    -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4) "VEGFRC"    "Vegetation fraction"              ""
+state  real   shdmin    ij    dyn_nmm   1    -     -
+state  real   shdmax    ij    dyn_nmm   1    -     -
+state  real   sh2o      ilj   dyn_nmm   1    Z     irhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)   "SH2O"      "Unfrozen soil moisture volume fraction"  ""
+state  real   smc       ilj   dyn_nmm   1    Z     irhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)   "SMC"       "Soil moisture volume fraction"    ""
+state  real   stc       ilj   dyn_nmm   1    Z     irhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)   "STC"       "Soil temperature"                 "K"
+#
+# module_NHYDRO.F
+#
+state logical hydro     -     dyn_nmm   -    -     -        "HYDRO"     ".FALSE. => nonhydrostatic"        ""
+state  real   dwdtmn    ij    dyn_nmm   1    -     -        "DWDTMN"    "Minimum value for DWDT"           "m s-2"
+state  real   dwdtmx    ij    dyn_nmm   1    -     -        "DWDTMX"    "Maximum value for DWDT"           "m s-2"
+state  real   dwdt      ikj   dyn_nmm   1    -     rd=(interp_v_nmm:IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4) "DWDT"      "dwdt and 1+(dwdt)/g"              "m s-2"
+state  real   pdwdt     ikj   dyn_nmm   1    -     r
+state  real   pint      ikj   dyn_nmm   1    Z     rh       "PINT"      "Model layer interface pressure"   "Pa"
+state  real   w         ikj   dyn_nmm   1    Z     rh       "W"         "Vertical velocity"                "m s-1"
+state  real   z         ikj   dyn_nmm   1    Z     -        "Z"         "Distance from ground"             "m"
+#
+# module_ACCUM.F
+#
+state  real   acfrcv    ij    dyn_nmm     1    -    h     "ACFRCV"    "Accum convective cloud fraction"   ""
+state  real   acfrst    ij    dyn_nmm     1    -    h     "ACFRST"    "Accum stratiform cloud fraction"   ""
+state  real   ssroff    ij    dyn_nmm     1    -    h     "SSROFF"    "Surface runoff"                    "mm"
+state  real   bgroff    ij    dyn_nmm     1    -    h     "BGROFF"    "Subsurface runoff"                 "mm"
+state  real   rlwin     ij    dyn_nmm     1    -    rh    "RLWIN"     "Downward longwave at surface"      "W m-2"
+state  real   rlwout    ij    dyn_nmm     1    -    -
+state  real   rlwtoa    ij    dyn_nmm     1    -    rh    "RLWTOA"    "Outgoing LW flux at top of atmos"  "W m-2"
+state  real   alwin     ij    dyn_nmm     1    -    h     "ALWIN"     "Accum LW down at surface"          "W m-2"
+state  real   alwout    ij    dyn_nmm     1    -    h     "ALWOUT"    "Accum RADOT (see above)"           "W m-2"
+state  real   alwtoa    ij    dyn_nmm     1    -    h     "ALWTOA"    "Accum RLWTOA"                      "W m-2"
+state  real   rswin     ij    dyn_nmm     1    -    rh    "RSWIN"     "Downward shortwave at surface"     "W m-2"
+state  real   rswinc    ij    dyn_nmm     1    -    rh    "RSWINC"    "Clear-sky equivalent of RSWIN"     "W m-2"
+state  real   rswout    ij    dyn_nmm     1    -    rh    "RSWOUT"    "Upward shortwave at surface"       "W m-2"
+state  real   rswtoa    ij    dyn_nmm     1    -    -     "RSWTOA"    "Outgoing SW flux at top of atmos"  "W m-2"
+state  real   aswin     ij    dyn_nmm     1    -    h     "ASWIN"     "Accum SW down at surface"          "W m-2"
+state  real   aswout    ij    dyn_nmm     1    -    h     "ASWOUT"    "Accum RSWOUT"                      "W m-2"
+state  real   aswtoa    ij    dyn_nmm     1    -    h     "ASWTOA"    "Accum RSWTOA"                      "W m-2"
+state  real   sfcshx    ij    dyn_nmm     1    -    rh    "SFCSHX"    "Accum sfc sensible heat flux"      "W m-2"
+state  real   sfclhx    ij    dyn_nmm     1    -    rh    "SFCLHX"    "Accum sfc latent heat flux"        "W m-2"
+state  real   subshx    ij    dyn_nmm     1    -    rh    "SUBSHX"    "Accum deep soil heat flux"         "W m-2"
+state  real   snopcx    ij    dyn_nmm     1    -    rh    "SNOPCX"    "Snow phase change heat flux"       "W m-2"
+state  real   sfcuvx    ij    dyn_nmm     1    -    rh
+state  real   potevp    ij    dyn_nmm     1    -    rh    "POTEVP"    "Accum potential evaporation"       "m"
+state  real   potflx    ij    dyn_nmm     1    -    rh    "POTFLX"    "Energy equivalent of POTEVP"       "W m-2"
+state  real   tlmin     ij    dyn_nmm     1    -    -
+state  real   tlmax     ij    dyn_nmm     1    -    -
+state  real   rlwtt     ikj   dyn_nmm     1    -    rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "RLWTT"     "Longwave temperature tendency"     "K s-1"
+state  real   rswtt     ikj   dyn_nmm     1    -    rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)  "RSWTT"     "Shortwave temperature tendency"    "K s-1"
+state  real   tcucn     ikj   dyn_nmm     1    -    h     "TCUCN"     "Accum convec temperature tendency" "K s-1"
+state  real   train     ikj   dyn_nmm     1    -    h     "TRAIN"     "Accum stratiform temp tendency"    "K s-1"
+state integer ncfrcv    ij    dyn_nmm     1    -    irh   "NCFRCV"    "# times convec cloud >0 between rad calls"  ""
+state integer ncfrst    ij    dyn_nmm     1    -    irh   "NCFRST"    "# times stratiform cloud >0 between rad calls"  ""
+state integer nphs0     -     dyn_nmm     -    -    rh
+state integer nprec     -     dyn_nmm     -    -    irh   "NPREC"     "# timesteps between resetting precip bucket"  ""
+state integer nclod     -     dyn_nmm     -    -    irh   "NCLOD"     "# timesteps between resetting cloud frac accum"    ""
+state integer nheat     -     dyn_nmm     -    -    irh   "NHEAT"     "# timesteps between resetting latent heat accum"   ""
+state integer nrdlw     -     dyn_nmm     -    -    irh   "NRDLW"     "# timesteps between resetting longwave accums"   ""
+state integer nrdsw     -     dyn_nmm     -    -    irh   "NRDSW"     "# timesteps between resetting shortwave accums"   ""
+state integer nsrfc     -     dyn_nmm     -    -    irh   "NSRFC"     "# timesteps between resetting sfcflux accums"   ""
+state  real   avrain    -     dyn_nmm     -    -    irh   "AVRAIN"    "# of times gridscale precip called in NHEAT steps"   ""
+state  real   avcnvc    -     dyn_nmm     -    -    irh   "AVCNVC"    "# of times convective precip called in NHEAT steps"   ""
+state  real   aratim    -     dyn_nmm     -    -    ir
+state  real   acutim    -     dyn_nmm     -    -    ir
+state  real   ardlw     -     dyn_nmm     -    -    irh   "ARDLW"     "# of times LW fluxes summed before resetting"   ""
+state  real   ardsw     -     dyn_nmm     -    -    irh   "ARDSW"     "# of times SW fluxes summed before resetting"   ""
+state  real   asrfc     -     dyn_nmm     -    -    irh   "ASRFC"     "# of times sfc fluxes summed before resetting"   ""
+state  real   aphtim    -     dyn_nmm     -    -    irh
+#
+# module_INDX.F
+#
+state integer ihe       j    dyn_nmm     1    -    -      "IHE"   "0 or +1 to obtain I index of V point east of H point"  ""
+state integer ihw       j    dyn_nmm     1    -    -      "IHW"   "0 or -1 to obtain I index of V point west of H point"  ""
+state integer ive       j    dyn_nmm     1    -    -      "IVE"   "0 or +1 to obtain I index of H point east of V point"  ""
+state integer ivw       j    dyn_nmm     1    -    -      "IVW"   "0 or -1 to obtain I index of H point west of V point"  ""
+state integer irad      i    dyn_nmm     1    -    -
+#definitions for NMM east-west orientation on E grid
+state integer iheg      q    dyn_nmm     1    -    -
+state integer ihwg      q    dyn_nmm     1    -    -
+state integer iveg      q    dyn_nmm     1    -    -
+state integer ivwg      q    dyn_nmm     1    -    -
+dimspec    r      -     constant=2000             c  # a little crude right now
+state integer iradg     r    dyn_nmm     1    -    -
+dimspec    m      -     constant=(-3:3)            c
+dimspec    n      -     constant=(0:6)             c
+state integer indx3_wrk mqn  dyn_nmm     1    -    -      "INDX3_WRK"  "Array of 3rd (J) indices for local arrays"  ""
+state integer n_iup_h   j    dyn_nmm     1    -    -      "N_IUP_H"    "# mass points needed in each row for upstream advection"  ""
+state integer n_iup_v   j    dyn_nmm     1    -    -      "N_IUP_V"    "# velocity points needed in each row for upstream advection"  ""
+state integer n_iup_adh j    dyn_nmm     1    -    -      "N_IUP_ADH"  "# mass points in each row of upstream advection"  ""
+state integer n_iup_adv j    dyn_nmm     1    -    -      "N_IUP_ADV"  "# velocity points in each row of upstream advection"  ""
+state integer iup_h     ij   dyn_nmm     1    -    -
+state integer iup_v     ij   dyn_nmm     1    -    -
+state integer iup_adh   ij   dyn_nmm     1    -    -
+state integer iup_adv   ij   dyn_nmm     1    -    -
+state integer imicrogram -   misc        -    -    r   "imicrogram"  "flag 0/1 0=mixratio, 1=mcrograms/m3"  ""
+
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     -
+state    integer imask_xstag          ij      misc     X
+state    integer imask_ystag          ij      misc     Y
+state    integer imask_xystag         ij      misc     XY
+#                                               
+#---------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#---------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "description"  "units"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "description"  "units"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "description"  "units"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "description"  "units"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "description"  "units"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "description"  "units"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "description"  "units"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "description"  "units"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "description"  "units"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "description"  "units"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "description"  "units"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "description"  "units"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "description"  "units"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "description"  "units"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "description"  "units"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "description"  "units"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "description"  "units"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "description"  "units"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "description"  "units"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "description"  "units"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "description"  "units"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "description"  "units"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "description"  "units"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "description"  "units"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "description"  "units"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "description"  "units"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "description"  "units"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "description"  "units"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "description"  "units"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "description"  "units"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "description"  "units"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "description"  "units"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "description"  "units"
+state   real   landmask            ij    misc          1     -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)   "LANDMASK"      "description"  "units"
+state   real   topostdv            ij    misc          1     -     i1      "TOPOSTDV"      "description"  "units"
+state   real   toposlpx            ij    misc          1     -     i1      "TOPOSLPX"      "description"  "units"
+state   real   toposlpy            ij    misc          1     -     i1      "TOPOSLPY"      "description"  "units"
+state   real   greenmax            ij    misc          1     -     i1      "GREENMAX"      "description"  "units"
+state   real   greenmin            ij    misc          1     -     i1      "GREENMIN"      "description"  "units"
+state   real   albedomx            ij    misc          1     -     i1      "ALBEDOMX"      "description"  "units"
+state   real   slopecat            ij    misc          1     -     i1      "SLOPECAT"      "description"  "units"
+state   real   toposoil            ij    misc          1     -     i1d=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)      "TOPOSOIL"      "description"  "units"
+state   real   landusef            iuj   misc          1     Z     i1      "LANDUSEF"      "description"  "units"
+state   real   soilctop            isj   misc          1     Z     i1      "SOILCTOP"      "description"  "units"
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "description"  "units"
+
+#-------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#-------------------------------------------------------------------------------------------------------------------------------
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+
+# Moist Scalars  - both height and mass coordinate models
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjft   moist       1         -     -    -                                       
+state   real    qv             ikjft   moist       1         -     r       "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjft   moist       1         -     r       "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjft   moist       1         -     r       "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjft   moist       1         -     r       "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjft   moist       1         -     rh      "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjft   moist       1         -     r       "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+#                                               
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -    -
+state   real    qni            ikjftb  scalar      1         -     i01rusdf=(bdy_interp:dt)       "QNI"              "Ice Number concentration" "# kg(-1)"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+## Chem Scalars  - both height and mass coordinate models                                       
+#                                               
+state   real    -              ikjft   chem        1         -     -    -                                       
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# specified LBC arrays, first, Eulerian height coordinate model
+
+
+# specified LBC arrays, next, Eulerian mass coordinate model
+
+
+# specified LBC  variables shared between the mass and height coordinate models
+
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+
+
+# 2m and 10m output diagnostics
+
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     rh       "SMOIS"                "SOIL MOISTURE" ""
+
+# MYJ PBL variables
+
+
+# gfdl (eta) radiation State Variables
+
+# eta microphpysics State Variables
+
+
+# new eta microphpysics State Variables
+
+#  some mass-coordinate-model-specific variables
+
+
+
+
+
+
+# was em_only
+
+#################################################################
+# Physics Variables (em core)
+                                                
+                                                
+                                                
+#################################################################
+# Physics Variables (eh core) ; should be same as em
+                                                
+                                                
+
+                                                
+#################################################################
+# variables added for CHEMISTRY compatibility with ARW core - kludge
+#################################################################
+state    real   GSW             ij     misc        1         -      -       ""                 ""
+state    real   XLAT            ij     misc        1         -      -       ""                 ""
+state    real   XLONG           ij     misc        1         -      -       ""                 ""
+state    real   XLAND           ij     misc        1         -      -       ""                 ""
+state    real   RAINCV          ij     misc        1         -      -       ""                 ""
+
+
+#################################################################
+# other misc variables (all cores)
+#################################################################
+
+# added for surface_driver
+state    real   PSFC             ij     misc        1         -      rh       "PSFC"                 "SFC PRESSURE"
+state    real   dtbc            -       misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+state    real   TH2              ij     misc        1         -     irh       "TH2"                  "POT TEMP at 2 M" ""
+state    real   T2               ij     misc        1         -     ir        "T2"                  "TEMP at 2 M" ""
+state    real   U10              ij     misc        1         -     irh       "U10"                  "U at 10 M"         " "
+state    real   V10              ij     misc        1         -     irh       "V10"                  "V at 10 M"         " "
+state    real   XICE             ij     misc        1         -     i01rd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)      "XICE"                 "SEA ICE"         ""
+state    real   SMSTAV           ij     misc        1         -     irh       "SMSTAV"               "MOISTURE VARIBILITY" ""
+state    real   SMSTOT           ij     misc        1         -     irh     "SMSTOT"               "TOTAL SOIL MOISTURE" ""
+state    real   SFCRUNOFF        ij     misc        1         -     rh       "SFROFF"               "SURFACE RUNOFF" ""
+state    real   UDRUNOFF         ij     misc        1         -     rh       "UDROFF"               "UNDERGROUND RUNOFF" ""
+state  integer  IVGTYP           ij     misc        1         -     irhd=(interp_int_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)       "IVGTYP"               "VEGETATION TYPE" ""
+state  integer  ISLTYP           ij     misc        1         -     irhd=(interp_int_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)       "ISLTYP"               "SOIL TYPE"         " "
+state    real   VEGFRA           ij     misc        1         -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)       "VEGFRA"               "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -     irh     "SFCEVP"               "SURFACE EVAPORATION" ""
+state    real   GRDFLX           ij     misc        1         -     irh     "GRDFLX"               "GROUND HEAT FLUX" ""
+state    real   ALBBCK           ij     misc        1         -     i012r   "ALBBCK"          "BACKGROUND ALBEDO"        "NA"
+state    real   SFCEXC           ij     misc        1         -     irh     "SFCEXC "              "SURFACE EXCHANGE COEFFICIENT"         ""
+state    real   ACSNOW           ij     misc        1         -     irh       "ACSNOW"               "ACCUMULATED SNOW" ""
+state    real   ACSNOM           ij     misc        1         -     irh       "ACSNOM"               "ACCUMULATED MELTED SNOW"         ""
+state    real   RMOL             ij     misc        1         -     ir       "RMOL"               ""         ""
+state    real   SNOW             ij     misc        1         -     irh       "SNOW"                 "SNOW WATER EQUIVALENT"         ""
+state    real   CANWAT           ij     misc        1         -     irh       "CANWAT"               "CANOPY WATER" ""
+state    real   SST              ij     misc        1         -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4       "SST"                  "SEA SURFACE TEMPERATURE" "K"
+state    real   WEASD            ij     misc        1         -     i01rhd=(interp_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)       "WEASD"                "WATER EQUIVALENT OF ACCUMULATED SNOW" ""
+state    real  ZNT              ij      misc        1         -     ir        "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"
+state    real  MOL              ij      misc        1         -     ir        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"
+
+state    real   tke_myj         ikj     misc        1         -     rh        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"     "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -      h        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H         ikj     misc        1         -     rh         "EXCH_H"               "EXCHANGE COEFFICIENTS FOR HEAT"               "m2 s-1"
+state   real   THZ0             ij     misc        1         -     irhd=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)       "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state   real   QZ0              ij     misc        1         -     irhd=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)       "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -     irhd=(interp_v_nmm:IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4)       "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -     irhd=(interp_v_nmm:IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4)       "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+# added as state for HALO_NMM_TURBL, jm
+state   real   UZ0h              ij     misc        1         -     -       
+state   real   VZ0h              ij     misc        1         -     -       
+state   real   dudt              ikj     misc        1         -     -      
+state   real   dvdt              ikj     misc        1         -     -      
+
+state   real   QSFC             ij     misc        1         -     irh       "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -     ir        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -     ir        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+state    real    HTOP            ij     misc        1         -     irhd=(interp_int_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)       "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -     irhd=(interp_int_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)       "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPD           ij     misc        1         -     rh        "HTOPD"                "TOP DEEP CONVECTION LEVEL"         ""
+state    real    HBOTD           ij     misc        1         -     rh        "HBOTD"                "BOT DEEP CONVECTION LEVEL"         ""
+state    real    HTOPS           ij     misc        1         -     rh        "HTOPS"                "TOP SHALLOW CONVECTION LEVEL"         ""
+state    real    HBOTS           ij     misc        1         -     rh        "HBOTS"                "BOT SHALLOW CONVECTION LEVEL"         ""
+state    REAL      CUPPT         ij     misc        1         -     rhd=(interp_int_hnear_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINCE LAST CALL TO THE RADIATION"         ""
+state    REAL      CPRATE        ij     misc        1         -     rh         "CPRATE"               "INSTANTANEOUS CONVECTIVE PRECIPITATION RATE"      ""   #  1-17-06a
+state    real    F_ICE_PHY       ikj    misc        1         -      -        "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      -        "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      -        "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"           "mb/hour"
+state    real  apr_gr           ij      misc        1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL "           "mm/hour"
+state    real  apr_w            ij      misc        1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W "           "mm/hour"
+state    real  apr_mc           ij      misc        1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"           "mm/hour"
+state    real  apr_st           ij      misc        1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY "           "mm/hour"
+state    real  apr_as           ij      misc        1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE "           "mm/hour"
+state    real  apr_capma        ij      misc        1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"           "mm/hour"
+state    real  apr_capme        ij      misc        1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"           "mm/hour"
+state    real  apr_capmi        ij      misc        1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"           "mm/hour"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1"
+
+state    real  RTHFTEN          ikj     misc        1         -      r       "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"         "K/sec"
+state    real  RQVFTEN          ikj     misc        1         -      r       "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"            "kg/sec"
+state    real   SNOWH            ij     misc        1         -     i01rhd=(interp_h_nmm:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4)      "SNOWH"                 "PHYSICAL SNOW DEPTH"  ""
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3"
+state    real   SMFR3D           ilj    misc        1         Z      rh       "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r         "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# added state for etampnew microphysics (needed for restarts)
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state       p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state      p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because the are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     -
+state    integer  landuse_lucats  -      misc       -          -     -
+state    integer  landuse_luseas  -      misc       -          -     -
+state    integer  landuse_isn     -      misc       -          -     -
+state    real     lu_state        p      misc       -          -     -
+
+
+#################################################################
+#                                               
+                                                
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     h         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     h         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -         "julian"                "day of year"         ""      
+                                                
+# output file descriptor for a domain                                           
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+                                                
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1993    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      03    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      13    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      12    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1993    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      03    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      14    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      12    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control         max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+rconfig   real    tstart                  namelist,time_control     max_domains       0       rh   "tstart"  "forecast hour at the start of the NMM integration"
+
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       h     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       h     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+
+# Physics
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics      1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1             5       irh    "num_soil_layers"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics      1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics      1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+
+
+# nmm variables
+rconfig   integer idtad                   namelist,physics     max_domains    2       irh    "idtad"  "fundamental timesteps between calls to NMM passive advection scheme"
+rconfig   integer nsoil                   namelist,physics     max_domains    4       irh    "nsoil"  "number of soil layers"
+rconfig   integer nphs                    namelist,physics     max_domains   10       irh    "nphs"  "fundamental timesteps between calls to NMM turbulence"
+rconfig   integer ncnvc                   namelist,physics     max_domains   10       irh    "ncnvc"  "fundamental timesteps between calls to NMM convection"
+rconfig   integer nrads                   namelist,physics     max_domains  200       irh    "nrads"  "fundamental timesteps between calls to NMM shortwave radiation"
+rconfig   integer nradl                   namelist,physics     max_domains  200       irh    "nradl"  "fundamental timesteps between calls to NMM longwave radiation"
+rconfig   real    tprec                   namelist,physics     max_domains    3.       rh    "tprec"  "number of hours in bucket for total precipitation"
+rconfig   real    theat                   namelist,physics     max_domains    6.       rh    "theat"  "number of hours in bucket for gridscale and convective heating rates"
+rconfig   real    tclod                   namelist,physics     max_domains    6.       rh    "tclod"  "number of hours in bucket for cloud amounts"
+rconfig   real    trdsw                   namelist,physics     max_domains    6.       rh    "trdsw"  "number of hours in bucket for short wave fluxes"
+rconfig   real    trdlw                   namelist,physics     max_domains    6.       rh    "trdlw"  "number of hours in bucket for long wave fluxes"
+rconfig   real    tsrfc                   namelist,physics     max_domains    6.       rh    "tsrfc"  "number of hours in bucket for evaporation / sfc fluxes"
+rconfig   logical pcpflg                  namelist,physics     max_domains   .false.   rh    "pcpflg"  "logical switch that turns on/off the precipitation assimilation"
+rconfig   integer sigma                   namelist,physics     max_domains    1       irh    "sigma"  "logical switch for NMM vertical coordinate (sigma or hybrid)"
+rconfig   integer co2tf                   namelist,physics     1              0       -      "co2tf"  "GFDL radiation co2 flag"
+rconfig   integer ra_call_offset          namelist,physics     1             -1       -      "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             1       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             1       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    base_pres               namelist,dynamics     1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics     1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics     1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.2     h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.      h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.      h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    .1      h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    10      h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    3       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    3       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    100.    h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient      namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      ""
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      ""
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       h        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       h        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       h        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       h        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       h        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       h        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn     dyn_opt==0                   -             -
+package   dyn_nmm       dyn_opt==4                   -             -
+
+
+#### 9. Edit the Registry file to set up '5' as the value of the
+**** namelist variable dyn_opt that means to select our exp dyncore.
+package   dyn_exp       dyn_opt==5                   -             -
+
+#package   passivec1     chem_opt==0                  -
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qs
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             -
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             -
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   nmmlsmscheme   sf_surface_physics==99      -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+
+                                                
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# NMM communications
+
+#halo HALO_NMM_INIT_1	dyn_nmm 120:LMH,LMV,HBM2
+halo HALO_NMM_INIT_1	dyn_nmm 120:HBM2
+halo HALO_NMM_INIT_2	dyn_nmm 120:HBM3,VBM2,VBM3
+halo HALO_NMM_INIT_3	dyn_nmm 120:SM,SICE,HTM
+halo HALO_NMM_INIT_4	dyn_nmm 120:VTM,DX_NMM,WPDAR
+halo HALO_NMM_INIT_5	dyn_nmm 120:CPGFU,CURV,FCP
+halo HALO_NMM_INIT_6	dyn_nmm 120:FDIV,FAD,F
+halo HALO_NMM_INIT_7	dyn_nmm 120:DDMPU,DDMPV,GLAT
+halo HALO_NMM_INIT_8	dyn_nmm 120:GLON,EPSR,TG
+halo HALO_NMM_INIT_9	dyn_nmm 120:GFFC,SST,ALBASE
+#halo HALO_NMM_INIT_10	dyn_nmm 120:HDAC,HDACV,IVGTYP
+halo HALO_NMM_INIT_10	dyn_nmm 120:HDAC,HDACV
+#halo HALO_NMM_INIT_11	dyn_nmm 120:ISLTYP,ISLOPE,VEGFRC
+halo HALO_NMM_INIT_11	dyn_nmm 120:VEGFRC
+halo HALO_NMM_INIT_12	dyn_nmm 120:DIV,OMGALF,PD,RES
+halo HALO_NMM_INIT_13	dyn_nmm 120:FIS,T,U
+halo HALO_NMM_INIT_14	dyn_nmm 120:V,Q,Q2
+halo HALO_NMM_INIT_15	dyn_nmm 120:CWM,TRAIN,TCUCN
+halo HALO_NMM_INIT_15B  dyn_nmm 120:moist,scalar
+halo HALO_NMM_INIT_16	dyn_nmm 120:RSWIN,RSWOUT,TG
+halo HALO_NMM_INIT_17	dyn_nmm 120:Z0,AKMS,CZEN
+halo HALO_NMM_INIT_18	dyn_nmm 120:AKHS,THS,QSH
+halo HALO_NMM_INIT_19	dyn_nmm 120:TWBS,QWBS,HBOT
+halo HALO_NMM_INIT_20	dyn_nmm 120:CFRACL,THZ0,QZ0
+halo HALO_NMM_INIT_21	dyn_nmm 120:UZ0,VZ0,USTAR
+halo HALO_NMM_INIT_22	dyn_nmm 120:HTOP,CFRACM,SNO
+halo HALO_NMM_INIT_23	dyn_nmm 120:SI,CLDEFI,RF
+halo HALO_NMM_INIT_24	dyn_nmm 120:CUPPT,CFRACH,SOILTB
+halo HALO_NMM_INIT_25	dyn_nmm 120:SFCEXC,SMSTAV,SMSTOT
+halo HALO_NMM_INIT_26	dyn_nmm 120:GRNFLX,PCTSNO,RLWIN
+halo HALO_NMM_INIT_27	dyn_nmm 120:RADOT,CZMEAN,SIGT4
+halo HALO_NMM_INIT_28	dyn_nmm 120:SR
+halo HALO_NMM_INIT_29	dyn_nmm 120:PREC,ACPREC,ACCLIQ
+halo HALO_NMM_INIT_30	dyn_nmm 120:ACFRST,ACSNOW
+halo HALO_NMM_INIT_31	dyn_nmm 120:ACSNOM,SSROFF,BGROFF
+halo HALO_NMM_INIT_32	dyn_nmm 120:SFCSHX,SFCLHX,SUBSHX
+halo HALO_NMM_INIT_33	dyn_nmm 120:SNOPCX,SFCUVX,SFCEVP
+halo HALO_NMM_INIT_34	dyn_nmm 120:POTEVP,ASWIN,ASWOUT
+halo HALO_NMM_INIT_35	dyn_nmm 120:ASWTOA,ALWIN,ALWOUT
+halo HALO_NMM_INIT_36	dyn_nmm 120:ALWTOA,SMC,CMC
+halo HALO_NMM_INIT_37	dyn_nmm 120:STC,SH2O,ALBEDO
+halo HALO_NMM_INIT_38   dyn_nmm 120:PINT,Z,DWDT
+halo HALO_NMM_INIT_39	dyn_nmm 120:TOLD,UOLD,VOLD
+
+halo      HALO_NMM_A  dyn_nmm 24:pd,t,u,v,q,cwm,dwdt,div;24:pint                          
+halo      HALO_NMM_A_3  dyn_nmm 24:moist,scalar
+halo      HALO_NMM_B  dyn_nmm 24:div                   
+halo      HALO_NMM_C  dyn_nmm 8:u,v                    
+halo      HALO_NMM_D  dyn_nmm 24:pd          
+halo      HALO_NMM_E  dyn_nmm 24:petdt
+halo      HALO_NMM_F  dyn_nmm 24:t,u,v
+halo      HALO_NMM_F1 dyn_nmm 80:pdslo          
+halo      HALO_NMM_G  dyn_nmm 24:u,v;24:z                    
+halo      HALO_NMM_H  dyn_nmm 24:w,lmh
+halo      HALO_NMM_I  dyn_nmm 48:q,q2,cwm                    
+halo      HALO_NMM_I_3  dyn_nmm 48:moist,scalar
+halo      HALO_NMM_J  dyn_nmm 8:pd,uz0,vz0,t,q,cwm                    
+halo      HALO_NMM_J_3  dyn_nmm 8:moist,scalar
+halo      HALO_NMM_K  dyn_nmm 8:q2;24:t,u,v,q,w,z
+halo      HALO_NMM_L  dyn_nmm 8:pd,t,q,cwm,q2                    
+halo      HALO_NMM_L_3  dyn_nmm 8:moist,scalar
+
+halo      HALO_NMM_TURBL_A  dyn_nmm 8:uz0h,vz0h,hbm2
+halo      HALO_NMM_TURBL_B  dyn_nmm 8:dudt,dvdt
+
+# following halos added for nesting purpose  (gopal's doing):
+
+halo HALO_NMM_ZZ  dyn_nmm 8:pdnest_b,unest_b,vnest_b,tnest_b,qnest_b,cwmnest_b,q2nest_b,pdnest_bt,unest_bt,vnest_bt,tnest_bt,qnest_bt,cwmnest_bt,q2nest_bt
+halo HALO_NMM_TRACK dyn_nmm 120:sm,pdyn,mslp,sqws
+halo HALO_NMM_INTERP_DOWN1 dyn_nmm 120:sm,fis,t,u,v,q,q2,z3d,q3d,t3d,pd,albase,nmm_tsk,mxsnal,tg,islope,cmc,soiltb,vegfrc,sh2o,smc,stc,toposoil,xice,ivgtyp,isltyp,vegfra,sst,weasd,snowh,hlat,hlon,z0,landmask,cwm,ustar,ths,qsh,cldefi,pshltr,dwdt,acprec,thz0,qz0,uz0,vz0,htop,hbot,cuppt,rlwtt,rswtt,t_adj,f_ice,f_rain,f_rimef
+halo HALO_NMM_FORCE_DOWN1 dyn_nmm 120:t,u,v,q,q2,cwm,z3d,q3d,t3d  #,qv,qc,qr,qi,qs,qg
+halo HALO_NMM_WEIGHTS dyn_nmm 48:IIH,JJH,HBWGT1,HBWGT2,HBWGT3,HBWGT4,IIV,JJV,VBWGT1,VBWGT2,VBWGT3,VBWGT4
+
Index: trunk/WRF.COMMON/WRFV2/Registry/registry.io_boilerplate
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry/registry.io_boilerplate	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry/registry.io_boilerplate	(revision 2744)
@@ -0,0 +1,649 @@
+
+#  registry.io_boilerplate
+#
+#  Included by registry program 
+#
+#  Contains a number of standard state variables associated with I/O
+#
+#
+
+# Output file descriptor for a domain                                           
+state   integer oid            -        -          -         -     -         "oid"                   ""         ""      
+state   integer auxhist1_oid   -        -          -         -     -         "auxhist1_oid"          ""         ""
+state   integer auxhist2_oid   -        -          -         -     -         "auxhist2_oid"          ""         ""
+state   integer auxhist3_oid   -        -          -         -     -         "auxhist3_oid"          ""         ""
+state   integer auxhist4_oid   -        -          -         -     -         "auxhist4_oid"          ""         ""
+state   integer auxhist5_oid   -        -          -         -     -         "auxhist5_oid"          ""         ""
+state   integer auxhist6_oid   -        -          -         -     -         "auxhist6_oid"          ""         ""
+state   integer auxhist7_oid   -        -          -         -     -         "auxhist7_oid"          ""         ""
+state   integer auxhist8_oid   -        -          -         -     -         "auxhist8_oid"          ""         ""
+state   integer auxhist9_oid   -        -          -         -     -         "auxhist9_oid"          ""         ""
+state   integer auxhist10_oid   -        -          -         -     -         "auxhist10_oid"          ""         ""
+state   integer auxhist11_oid   -        -          -         -     -         "auxhist11_oid"          ""         ""
+
+state   integer auxinput1_oid  -        -          -         -     -         "auxinput1_oid"         ""         ""
+state   integer auxinput2_oid  -        -          -         -     -         "auxinput2_oid"         ""         ""
+state   integer auxinput3_oid  -        -          -         -     -         "auxinput3_oid"         ""         ""
+state   integer auxinput4_oid  -        -          -         -     -         "auxinput4_oid"         ""         ""
+state   integer auxinput5_oid  -        -          -         -     -         "auxinput5_oid"         ""         ""
+state   integer auxinput6_oid  -        -          -         -     -         "auxinput6_oid"         ""         ""
+state   integer auxinput7_oid  -        -          -         -     -         "auxinput7_oid"         ""         ""
+state   integer auxinput8_oid  -        -          -         -     -         "auxinput8_oid"         ""         ""
+state   integer auxinput9_oid  -        -          -         -     -         "auxinput9_oid"         ""         ""
+state   integer auxinput10_oid  -        -          -         -     -         "auxinput10_oid"         ""         ""
+state   integer auxinput11_oid  -        -          -         -     -         "auxinput11_oid"         ""         ""
+
+rconfig   integer history_interval        namelist,time_control		max_domains    0       h     "history_interval"       ""      "MINUTES"
+rconfig   integer frames_per_outfile      namelist,time_control		max_domains    10      h     "frames_per_outfile"            ""      ""
+rconfig   integer frames_per_auxhist1     namelist,time_control		max_domains    10      h     "frames_per_auxhist1"            ""      ""
+rconfig   integer frames_per_auxhist2     namelist,time_control		max_domains    10      h     "frames_per_auxhist2"            ""      ""
+rconfig   integer frames_per_auxhist3     namelist,time_control		max_domains    10      h     "frames_per_auxhist3"            ""      ""
+rconfig   integer frames_per_auxhist4     namelist,time_control		max_domains    10      h     "frames_per_auxhist4"            ""      ""
+rconfig   integer frames_per_auxhist5     namelist,time_control		max_domains    10      h     "frames_per_auxhist5"            ""      ""
+rconfig   integer frames_per_auxhist6     namelist,time_control		max_domains    10      h     "frames_per_auxhist6"            ""      ""
+rconfig   integer frames_per_auxhist7     namelist,time_control		max_domains    10      h     "frames_per_auxhist7"            ""      ""
+rconfig   integer frames_per_auxhist8     namelist,time_control		max_domains    10      h     "frames_per_auxhist8"            ""      ""
+rconfig   integer frames_per_auxhist9     namelist,time_control		max_domains    10      h     "frames_per_auxhist9"            ""      ""
+rconfig   integer frames_per_auxhist10 namelist,time_control	max_domains    10      h     "frames_per_auxhist10"            ""      ""
+rconfig   integer frames_per_auxhist11 namelist,time_control	max_domains    10      h     "frames_per_auxhist11"            ""      ""
+rconfig   logical restart                 namelist,time_control		1             .false. h    "restart"              ""      ""
+rconfig   integer restart_interval        namelist,time_control		1              0       h     "restart_interval"       ""      "MINUTES"
+rconfig   integer     io_form_input       namelist,time_control		1              2       h        "io_form_input"                 ""      ""
+rconfig   integer     io_form_history     namelist,time_control		1              2       h        "io_form_history"               ""      ""
+rconfig   integer     io_form_restart     namelist,time_control		1              2       h        "io_form_restart"               ""      ""
+rconfig   integer     io_form_boundary    namelist,time_control		1              2       h        "io_form_boundary"               ""      ""
+rconfig   integer debug_level             namelist,time_control		1             0       -      "debug_level"           ""      ""
+rconfig   logical self_test_domain        namelist,time_control		1              .false. -      "self_test_domain"           ""      ""
+
+
+rconfig   character  history_outname   namelist,time_control		1  "wrfout_d<domain>_<date>"     -     "name of history outfile"  ""      ""
+rconfig   character  auxhist1_outname  namelist,time_control		1  "auxhist1_d<domain>_<date>"   -     "name of auxhist1 outfile" ""      ""
+rconfig   character  auxhist2_outname  namelist,time_control		1  "auxhist2_d<domain>_<date>"   -     "name of auxhist2 outfile" ""      ""
+rconfig   character  auxhist3_outname  namelist,time_control		1  "auxhist3_d<domain>_<date>"   -     "name of auxhist3 outfile" ""      ""
+rconfig   character  auxhist4_outname  namelist,time_control		1  "auxhist4_d<domain>_<date>"   -     "name of auxhist4 outfile" ""      ""
+rconfig   character  auxhist5_outname  namelist,time_control		1  "auxhist5_d<domain>_<date>"   -     "name of auxhist5 outfile" ""      ""
+rconfig   character  auxhist6_outname  namelist,time_control		1  "auxhist6_d<domain>_<date>"   -     "name of auxhist6 outfile" ""      ""
+rconfig   character  auxhist7_outname  namelist,time_control		1  "auxhist7_d<domain>_<date>"   -     "name of auxhist7 outfile" ""      ""
+rconfig   character  auxhist8_outname  namelist,time_control		1  "auxhist8_d<domain>_<date>"   -     "name of auxhist8 outfile" ""      ""
+rconfig   character  auxhist9_outname  namelist,time_control		1  "auxhist9_d<domain>_<date>"   -     "name of auxhist9 outfile" ""      ""
+rconfig   character  auxhist10_outname  namelist,time_control       	1  "auxhist10_d<domain>_<date>"   -     "name of auxhist10 outfile" ""      ""
+rconfig   character  auxhist11_outname  namelist,time_control	        1  "auxhist11_d<domain>_<date>"   -     "name of auxhist11 outfile" ""      ""
+
+rconfig   character  history_inname    namelist,time_control		1  "wrfhist_d<domain>_<date>"    -     "name of history infile"  ""      ""
+rconfig   character  auxhist1_inname   namelist,time_control		1  "auxhist1_d<domain>_<date>"   -     "name of auxhist1 infile" ""      ""
+rconfig   character  auxhist2_inname   namelist,time_control		1  "auxhist2_d<domain>_<date>"   -     "name of auxhist2 infile" ""      ""
+rconfig   character  auxhist3_inname   namelist,time_control		1  "auxhist3_d<domain>_<date>"   -     "name of auxhist3 infile" ""      ""
+rconfig   character  auxhist4_inname   namelist,time_control		1  "auxhist4_d<domain>_<date>"   -     "name of auxhist4 infile" ""      ""
+rconfig   character  auxhist5_inname   namelist,time_control		1  "auxhist5_d<domain>_<date>"   -     "name of auxhist5 infile" ""      ""
+rconfig   character  auxhist6_inname   namelist,time_control		1  "auxhist6_d<domain>_<date>"   -     "name of auxhist6 infile" ""      ""
+rconfig   character  auxhist7_inname   namelist,time_control		1  "auxhist7_d<domain>_<date>"   -     "name of auxhist7 infile" ""      ""
+rconfig   character  auxhist8_inname   namelist,time_control		1  "auxhist8_d<domain>_<date>"   -     "name of auxhist8 infile" ""      ""
+rconfig   character  auxhist9_inname   namelist,time_control		1  "auxhist9_d<domain>_<date>"   -     "name of auxhist9 infile" ""      ""
+rconfig   character  auxhist10_inname   namelist,time_control      	1  "auxhist10_d<domain>_<date>"   -     "name of auxhist10 infile" ""      ""
+rconfig   character  auxhist11_inname   namelist,time_control   	1  "auxhist11_d<domain>_<date>"   -     "name of auxhist11 infile" ""      ""
+
+rconfig   character  auxinput1_outname  namelist,time_control            1  "auxinput1_d<domain>_<date>"   -     "name of auxinput1 outfile" ""      ""
+rconfig   character  auxinput2_outname  namelist,time_control            1  "auxinput2_d<domain>_<date>"   -     "name of auxinput2 outfile" ""      ""
+rconfig   character  auxinput3_outname  namelist,time_control            1  "auxinput3_d<domain>_<date>"   -     "name of auxinput3 outfile" ""      ""
+rconfig   character  auxinput4_outname  namelist,time_control            1  "auxinput4_d<domain>_<date>"   -     "name of auxinput4 outfile" ""      ""
+rconfig   character  auxinput5_outname  namelist,time_control            1  "auxinput5_d<domain>_<date>"   -     "name of auxinput5 outfile" ""      ""
+rconfig   character  auxinput6_outname  namelist,time_control            1  "auxinput6_d<domain>_<date>"   -     "name of auxinput6 outfile" ""      ""
+rconfig   character  auxinput7_outname  namelist,time_control            1  "auxinput7_d<domain>_<date>"   -     "name of auxinput7 outfile" ""      ""
+rconfig   character  auxinput8_outname  namelist,time_control            1  "auxinput8_d<domain>_<date>"   -     "name of auxinput8 outfile" ""      ""
+rconfig   character  auxinput9_outname  namelist,time_control            1  "auxinput9_d<domain>_<date>"   -     "name of auxinput9 outfile" ""      ""
+rconfig   character  auxinput10_outname  namelist,time_control           1  "auxinput10_d<domain>_<date>"  - "name of auxinput10 outfile" ""      ""
+rconfig   character  auxinput11_outname  namelist,time_control           1  "auxinput11_d<domain>_<date>"  - "name of auxinput11 outfile" ""      ""
+
+#rconfig   character  auxinput1_inname   namelist,time_control            1  "wrf_real_input_em.d<domain>.<date>"   -     "name of auxinput1 infile" ""      ""
+rconfig   character  auxinput1_inname   namelist,time_control            1  "met_em.d<domain>.<date>"   -     "name of auxinput1 infile" ""      ""
+rconfig   character  auxinput2_inname   namelist,time_control            1  "auxinput2_d<domain>"   -     "name of auxinput2 infile" ""      ""
+rconfig   character  auxinput3_inname   namelist,time_control            1  "auxinput3_d<domain>"   -     "name of auxinput3 infile" ""      ""
+rconfig   character  auxinput4_inname   namelist,time_control            1  "auxinput4_d<domain>"   -     "name of auxinput4 infile" ""      ""
+rconfig   character  auxinput5_inname   namelist,time_control            1  "auxinput5_d<domain>"   -     "name of auxinput5 infile" ""      ""
+rconfig   character  auxinput6_inname   namelist,time_control            1  "auxinput6_d<domain>"   -     "name of auxinput6 infile" ""      ""
+rconfig   character  auxinput7_inname   namelist,time_control            1  "auxinput7_d<domain>"   -     "name of auxinput7 infile" ""      ""
+rconfig   character  auxinput8_inname   namelist,time_control            1  "auxinput8_d<domain>"   -     "name of auxinput8 infile" ""      ""
+rconfig   character  auxinput9_inname   namelist,time_control            1  "auxinput9_d<domain>"   -     "name of auxinput9 infile" ""      ""
+rconfig   character  gfdda_inname   	namelist,fdda          	         1  "gfdda_d<domain>"       -     "name of gfdda infile" ""      ""
+rconfig   character  auxinput11_inname   namelist,time_control           1  "auxinput11_d<domain>"   -  "name of auxinput11 infile" ""      ""
+
+rconfig   integer history_interval_mo     namelist,time_control		max_domains    0       h     "history_interval_mo"       ""      "MONTHS"
+rconfig   integer history_interval_d      namelist,time_control		max_domains    0       h     "history_interval_d"       ""      "DAYS"
+rconfig   integer history_interval_h      namelist,time_control		max_domains    0       h     "history_interval_h"       ""      "HOURS"
+rconfig   integer history_interval_m      namelist,time_control		max_domains    0       h     "history_interval_m"       ""      "MINUTES"
+rconfig   integer history_interval_s      namelist,time_control		max_domains    0       h     "history_interval_s"       ""      "SECONDS"
+
+rconfig   integer inputout_interval_mo      namelist,time_control	max_domains    0       h     "inputout_interval_mo"       ""      "MONTHS"
+rconfig   integer inputout_interval_d      namelist,time_control	max_domains    0       h     "inputout_interval_d"       ""      "DAYS"
+rconfig   integer inputout_interval_h      namelist,time_control	max_domains    0       h     "inputout_interval_h"       ""      "HOURS"
+rconfig   integer inputout_interval_m      namelist,time_control	max_domains    0       h     "inputout_interval_m"       ""      "MINUTES"
+rconfig   integer inputout_interval_s      namelist,time_control	max_domains    0       h     "inputout_interval_s"       ""      "SECONDS"
+rconfig   integer inputout_interval        namelist,time_control	max_domains    0       h     "inputout_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist1_interval_mo      namelist,time_control	max_domains    0       h     "auxhist1_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist1_interval_d      namelist,time_control	max_domains    0       h     "auxhist1_interval_d"       ""      "DAYS"
+rconfig   integer auxhist1_interval_h      namelist,time_control	max_domains    0       h     "auxhist1_interval_h"       ""      "HOURS"
+rconfig   integer auxhist1_interval_m      namelist,time_control	max_domains    0       h     "auxhist1_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist1_interval_s      namelist,time_control	max_domains    0       h     "auxhist1_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist1_interval        namelist,time_control	max_domains    0       h     "auxhist1_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist2_interval_mo      namelist,time_control	max_domains    0       h     "auxhist2_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist2_interval_d      namelist,time_control	max_domains    0       h     "auxhist2_interval_d"       ""      "DAYS"
+rconfig   integer auxhist2_interval_h      namelist,time_control	max_domains    0       h     "auxhist2_interval_h"       ""      "HOURS"
+rconfig   integer auxhist2_interval_m      namelist,time_control	max_domains    0       h     "auxhist2_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist2_interval_s      namelist,time_control	max_domains    0       h     "auxhist2_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist2_interval        namelist,time_control	max_domains    0       h     "auxhist2_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist3_interval_mo      namelist,time_control	max_domains    0       h     "auxhist3_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist3_interval_d      namelist,time_control	max_domains    0       h     "auxhist3_interval_d"       ""      "DAYS"
+rconfig   integer auxhist3_interval_h      namelist,time_control	max_domains    0       h     "auxhist3_interval_h"       ""      "HOURS"
+rconfig   integer auxhist3_interval_m      namelist,time_control	max_domains    0       h     "auxhist3_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist3_interval_s      namelist,time_control	max_domains    0       h     "auxhist3_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist3_interval        namelist,time_control	max_domains    0       h     "auxhist3_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist4_interval_mo     namelist,time_control	max_domains    0       h     "auxhist4_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist4_interval_d      namelist,time_control	max_domains    0       h     "auxhist4_interval_d"       ""      "DAYS"
+rconfig   integer auxhist4_interval_h      namelist,time_control	max_domains    0       h     "auxhist4_interval_h"       ""      "HOURS"
+rconfig   integer auxhist4_interval_m      namelist,time_control	max_domains    0       h     "auxhist4_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist4_interval_s      namelist,time_control	max_domains    0       h     "auxhist4_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist4_interval        namelist,time_control	max_domains    0       h     "auxhist4_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist5_interval_mo     namelist,time_control	max_domains    0       h     "auxhist5_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist5_interval_d      namelist,time_control	max_domains    0       h     "auxhist5_interval_d"       ""      "DAYS"
+rconfig   integer auxhist5_interval_h      namelist,time_control	max_domains    0       h     "auxhist5_interval_h"       ""      "HOURS"
+rconfig   integer auxhist5_interval_m      namelist,time_control	max_domains    0       h     "auxhist5_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist5_interval_s      namelist,time_control	max_domains    0       h     "auxhist5_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist5_interval        namelist,time_control	max_domains    0       h     "auxhist5_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist6_interval_mo     namelist,time_control	max_domains    0       h     "auxhist6_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist6_interval_d      namelist,time_control	max_domains    0       h     "auxhist6_interval_d"       ""      "DAYS"
+rconfig   integer auxhist6_interval_h      namelist,time_control	max_domains    0       h     "auxhist6_interval_h"       ""      "HOURS"
+rconfig   integer auxhist6_interval_m      namelist,time_control	max_domains    0       h     "auxhist6_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist6_interval_s      namelist,time_control	max_domains    0       h     "auxhist6_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist6_interval        namelist,time_control	max_domains    0       h     "auxhist6_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist7_interval_mo     namelist,time_control	max_domains    0       h     "auxhist7_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist7_interval_d      namelist,time_control	max_domains    0       h     "auxhist7_interval_d"       ""      "DAYS"
+rconfig   integer auxhist7_interval_h      namelist,time_control	max_domains    0       h     "auxhist7_interval_h"       ""      "HOURS"
+rconfig   integer auxhist7_interval_m      namelist,time_control	max_domains    0       h     "auxhist7_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist7_interval_s      namelist,time_control	max_domains    0       h     "auxhist7_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist7_interval        namelist,time_control	max_domains    0       h     "auxhist7_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist8_interval_mo     namelist,time_control	max_domains    0       h     "auxhist8_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist8_interval_d      namelist,time_control	max_domains    0       h     "auxhist8_interval_d"       ""      "DAYS"
+rconfig   integer auxhist8_interval_h      namelist,time_control	max_domains    0       h     "auxhist8_interval_h"       ""      "HOURS"
+rconfig   integer auxhist8_interval_m      namelist,time_control	max_domains    0       h     "auxhist8_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist8_interval_s      namelist,time_control	max_domains    0       h     "auxhist8_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist8_interval        namelist,time_control	max_domains    0       h     "auxhist8_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist9_interval_mo     namelist,time_control	max_domains    0       h     "auxhist9_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist9_interval_d      namelist,time_control	max_domains    0       h     "auxhist9_interval_d"       ""      "DAYS"
+rconfig   integer auxhist9_interval_h      namelist,time_control	max_domains    0       h     "auxhist9_interval_h"       ""      "HOURS"
+rconfig   integer auxhist9_interval_m      namelist,time_control	max_domains    0       h     "auxhist9_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist9_interval_s      namelist,time_control	max_domains    0       h     "auxhist9_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist9_interval        namelist,time_control	max_domains    0       h     "auxhist9_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist10_interval_mo     namelist,time_control	max_domains    0       h     "auxhist10_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist10_interval_d      namelist,time_control	max_domains    0       h     "auxhist10_interval_d"       ""      "DAYS"
+rconfig   integer auxhist10_interval_h      namelist,time_control	max_domains    0       h     "auxhist10_interval_h"       ""      "HOURS"
+rconfig   integer auxhist10_interval_m      namelist,time_control	max_domains    0       h     "auxhist10_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist10_interval_s      namelist,time_control	max_domains    0       h     "auxhist10_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist10_interval        namelist,time_control	max_domains    0       h     "auxhist10_interval"       ""      "MINUTES"
+
+rconfig   integer auxhist11_interval_mo     namelist,time_control	max_domains    0       h     "auxhist11_interval_mo"       ""      "MONTHS"
+rconfig   integer auxhist11_interval_d      namelist,time_control	max_domains    0       h     "auxhist11_interval_d"       ""      "DAYS"
+rconfig   integer auxhist11_interval_h      namelist,time_control	max_domains    0       h     "auxhist11_interval_h"       ""      "HOURS"
+rconfig   integer auxhist11_interval_m      namelist,time_control	max_domains    0       h     "auxhist11_interval_m"       ""      "MINUTES"
+rconfig   integer auxhist11_interval_s      namelist,time_control	max_domains    0       h     "auxhist11_interval_s"       ""      "SECONDS"
+rconfig   integer auxhist11_interval        namelist,time_control	max_domains    0       h     "auxhist11_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput1_interval_mo     namelist,time_control	max_domains    0       h     "auxinput1_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput1_interval_d      namelist,time_control	max_domains    0       h     "auxinput1_interval_d"       ""      "DAYS"
+rconfig   integer auxinput1_interval_h      namelist,time_control	max_domains    0       h     "auxinput1_interval_h"       ""      "HOURS"
+rconfig   integer auxinput1_interval_m      namelist,time_control	max_domains    0       h     "auxinput1_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput1_interval_s      namelist,time_control	max_domains    0       h     "auxinput1_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput1_interval        namelist,time_control	max_domains    0       h     "auxinput1_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput2_interval_mo     namelist,time_control	max_domains    0       h     "auxinput2_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput2_interval_d      namelist,time_control	max_domains    0       h     "auxinput2_interval_d"       ""      "DAYS"
+rconfig   integer auxinput2_interval_h      namelist,time_control	max_domains    0       h     "auxinput2_interval_h"       ""      "HOURS"
+rconfig   integer auxinput2_interval_m      namelist,time_control	max_domains    0       h     "auxinput2_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput2_interval_s      namelist,time_control	max_domains    0       h     "auxinput2_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput2_interval        namelist,time_control	max_domains    0       h     "auxinput2_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput3_interval_mo     namelist,time_control	max_domains    0       h     "auxinput3_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput3_interval_d      namelist,time_control	max_domains    0       h     "auxinput3_interval_d"       ""      "DAYS"
+rconfig   integer auxinput3_interval_h      namelist,time_control	max_domains    0       h     "auxinput3_interval_h"       ""      "HOURS"
+rconfig   integer auxinput3_interval_m      namelist,time_control	max_domains    0       h     "auxinput3_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput3_interval_s      namelist,time_control	max_domains    0       h     "auxinput3_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput3_interval        namelist,time_control	max_domains    0       h     "auxinput3_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput4_interval_mo     namelist,time_control	max_domains    0       h     "auxinput4_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput4_interval_d      namelist,time_control	max_domains    0       h     "auxinput4_interval_d"       ""      "DAYS"
+rconfig   integer auxinput4_interval_h      namelist,time_control	max_domains    0       h     "auxinput4_interval_h"       ""      "HOURS"
+rconfig   integer auxinput4_interval_m      namelist,time_control	max_domains    0       h     "auxinput4_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput4_interval_s      namelist,time_control	max_domains    0       h     "auxinput4_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput4_interval        namelist,time_control	max_domains    0       h     "auxinput4_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput5_interval_mo     namelist,time_control	max_domains    0       h     "auxinput5_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput5_interval_d      namelist,time_control	max_domains    0       h     "auxinput5_interval_d"       ""      "DAYS"
+rconfig   integer auxinput5_interval_h      namelist,time_control	max_domains    0       h     "auxinput5_interval_h"       ""      "HOURS"
+rconfig   integer auxinput5_interval_m      namelist,time_control	max_domains    0       h     "auxinput5_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput5_interval_s      namelist,time_control	max_domains    0       h     "auxinput5_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput5_interval        namelist,time_control	max_domains    0       h     "auxinput5_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput6_interval_mo     namelist,time_control	max_domains    0       h     "auxinput6_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput6_interval_d      namelist,time_control	max_domains    0       h     "auxinput6_interval_d"       ""      "DAYS"
+rconfig   integer auxinput6_interval_h      namelist,time_control	max_domains    0       h     "auxinput6_interval_h"       ""      "HOURS"
+rconfig   integer auxinput6_interval_m      namelist,time_control	max_domains    0       h     "auxinput6_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput6_interval_s      namelist,time_control	max_domains    0       h     "auxinput6_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput6_interval        namelist,time_control	max_domains    0       h     "auxinput6_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput7_interval_mo     namelist,time_control	max_domains    0       h     "auxinput7_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput7_interval_d      namelist,time_control	max_domains    0       h     "auxinput7_interval_d"       ""      "DAYS"
+rconfig   integer auxinput7_interval_h      namelist,time_control	max_domains    0       h     "auxinput7_interval_h"       ""      "HOURS"
+rconfig   integer auxinput7_interval_m      namelist,time_control	max_domains    0       h     "auxinput7_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput7_interval_s      namelist,time_control	max_domains    0       h     "auxinput7_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput7_interval        namelist,time_control	max_domains    0       h     "auxinput7_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput8_interval_mo     namelist,time_control	max_domains    0       h     "auxinput8_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput8_interval_d      namelist,time_control	max_domains    0       h     "auxinput8_interval_d"       ""      "DAYS"
+rconfig   integer auxinput8_interval_h      namelist,time_control	max_domains    0       h     "auxinput8_interval_h"       ""      "HOURS"
+rconfig   integer auxinput8_interval_m      namelist,time_control	max_domains    0       h     "auxinput8_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput8_interval_s      namelist,time_control	max_domains    0       h     "auxinput8_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput8_interval        namelist,time_control	max_domains    0       h     "auxinput8_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput9_interval_mo     namelist,time_control	max_domains    0       h     "auxinput9_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput9_interval_d      namelist,time_control	max_domains    0       h     "auxinput9_interval_d"       ""      "DAYS"
+rconfig   integer auxinput9_interval_h      namelist,time_control	max_domains    0       h     "auxinput9_interval_h"       ""      "HOURS"
+rconfig   integer auxinput9_interval_m      namelist,time_control	max_domains    0       h     "auxinput9_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput9_interval_s      namelist,time_control	max_domains    0       h     "auxinput9_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput9_interval        namelist,time_control	max_domains    0       h     "auxinput9_interval"       ""      "MINUTES"
+
+rconfig   integer gfdda_interval_mo         namelist,fdda	        max_domains    0       h     "gfdda_interval_mo"       ""      "MONTHS"
+rconfig   integer gfdda_interval_d          namelist,fdda	        max_domains    0       h     "gfdda_interval_d"       ""      "DAYS"
+rconfig   integer gfdda_interval_h          namelist,fdda	        max_domains    0       h     "gfdda_interval_h"       ""      "HOURS"
+rconfig   integer gfdda_interval_m          namelist,fdda	        max_domains    0       h     "gfdda_interval_m"       ""      "MINUTES"
+rconfig   integer gfdda_interval_s          namelist,fdda	        max_domains    0       h     "gfdda_interval_s"       ""      "SECONDS"
+rconfig   integer gfdda_interval            namelist,fdda	        max_domains    0       h     "gfdda_interval"       ""      "MINUTES"
+
+rconfig   integer auxinput11_interval_mo     namelist,time_control	max_domains    0       h     "auxinput11_interval_mo"       ""      "MONTHS"
+rconfig   integer auxinput11_interval_d      namelist,time_control	max_domains    0       h     "auxinput11_interval_d"       ""      "DAYS"
+rconfig   integer auxinput11_interval_h      namelist,time_control	max_domains    0       h     "auxinput11_interval_h"       ""      "HOURS"
+rconfig   integer auxinput11_interval_m      namelist,time_control	max_domains    0       h     "auxinput11_interval_m"       ""      "MINUTES"
+rconfig   integer auxinput11_interval_s      namelist,time_control	max_domains    0       h     "auxinput11_interval_s"       ""      "SECONDS"
+rconfig   integer auxinput11_interval        namelist,time_control	max_domains    0       h     "auxinput11_interval"       ""      "MINUTES"
+
+
+rconfig   integer restart_interval_mo     namelist,time_control		1              0       h     "restart_interval_mo"       ""      "MONTHS"
+rconfig   integer restart_interval_d      namelist,time_control		1              0       h     "restart_interval_d"       ""      "DAYS"
+rconfig   integer restart_interval_h      namelist,time_control		1              0       h     "restart_interval_h"       ""      "HOURS"
+rconfig   integer restart_interval_m      namelist,time_control		1              0       h     "restart_interval_m"       ""      "MINUTES"
+rconfig   integer restart_interval_s      namelist,time_control		1              0       h     "restart_interval_s"       ""      "SECONDS"
+
+
+rconfig  integer history_begin_y  namelist,time_control		max_domains    0     h   "history_begin_y"    ""   "YEARS from start of run"
+rconfig  integer history_begin_mo  namelist,time_control	max_domains    0     h   "history_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer history_begin_d   namelist,time_control	max_domains    0     h   "history_begin_d"    ""   "DAYS from start of run"
+rconfig  integer history_begin_h   namelist,time_control	max_domains    0     h   "history_begin_h"    ""   "HOURS from start of run"
+rconfig  integer history_begin_m   namelist,time_control	max_domains    0     h   "history_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer history_begin_s   namelist,time_control	max_domains    0     h   "history_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer inputout_begin_y   namelist,time_control	max_domains    0     h   "inputout_begin_y"    ""   "YEARS from start of run"
+rconfig  integer inputout_begin_mo   namelist,time_control	max_domains    0     h   "inputout_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer inputout_begin_d   namelist,time_control	max_domains    0     h   "inputout_begin_d"    ""   "DAYS from start of run"
+rconfig  integer inputout_begin_h   namelist,time_control	max_domains    0     h   "inputout_begin_h"    ""   "HOURS from start of run"
+rconfig  integer inputout_begin_m   namelist,time_control	max_domains    0     h   "inputout_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer inputout_begin_s   namelist,time_control	max_domains    0     h   "inputout_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist1_begin_y   namelist,time_control	max_domains    0     h   "auxhist1_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist1_begin_mo   namelist,time_control	max_domains    0     h   "auxhist1_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist1_begin_d   namelist,time_control	max_domains    0     h   "auxhist1_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist1_begin_h   namelist,time_control	max_domains    0     h   "auxhist1_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist1_begin_m   namelist,time_control	max_domains    0     h   "auxhist1_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist1_begin_s   namelist,time_control	max_domains    0     h   "auxhist1_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist2_begin_y   namelist,time_control	max_domains    0     h   "auxhist2_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist2_begin_mo   namelist,time_control	max_domains    0     h   "auxhist2_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist2_begin_d   namelist,time_control	max_domains    0     h   "auxhist2_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist2_begin_h   namelist,time_control	max_domains    0     h   "auxhist2_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist2_begin_m   namelist,time_control	max_domains    0     h   "auxhist2_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist2_begin_s   namelist,time_control	max_domains    0     h   "auxhist2_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist3_begin_y   namelist,time_control	max_domains    0     h   "auxhist3_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist3_begin_mo   namelist,time_control	max_domains    0     h   "auxhist3_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist3_begin_d   namelist,time_control	max_domains    0     h   "auxhist3_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist3_begin_h   namelist,time_control	max_domains    0     h   "auxhist3_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist3_begin_m   namelist,time_control	max_domains    0     h   "auxhist3_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist3_begin_s   namelist,time_control	max_domains    0     h   "auxhist3_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist4_begin_y  namelist,time_control	max_domains    0     h   "auxhist4_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist4_begin_mo  namelist,time_control	max_domains    0     h   "auxhist4_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist4_begin_d   namelist,time_control	max_domains    0     h   "auxhist4_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist4_begin_h   namelist,time_control	max_domains    0     h   "auxhist4_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist4_begin_m   namelist,time_control	max_domains    0     h   "auxhist4_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist4_begin_s   namelist,time_control	max_domains    0     h   "auxhist4_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist5_begin_y  namelist,time_control	max_domains    0     h   "auxhist5_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist5_begin_mo  namelist,time_control	max_domains    0     h   "auxhist5_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist5_begin_d   namelist,time_control	max_domains    0     h   "auxhist5_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist5_begin_h   namelist,time_control	max_domains    0     h   "auxhist5_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist5_begin_m   namelist,time_control	max_domains    0     h   "auxhist5_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist5_begin_s   namelist,time_control	max_domains    0     h   "auxhist5_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist6_begin_y  namelist,time_control	max_domains    0     h   "auxhist6_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist6_begin_mo  namelist,time_control	max_domains    0     h   "auxhist6_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist6_begin_d   namelist,time_control	max_domains    0     h   "auxhist6_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist6_begin_h   namelist,time_control	max_domains    0     h   "auxhist6_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist6_begin_m   namelist,time_control	max_domains    0     h   "auxhist6_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist6_begin_s   namelist,time_control	max_domains    0     h   "auxhist6_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist7_begin_y  namelist,time_control	max_domains    0     h   "auxhist7_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist7_begin_mo  namelist,time_control	max_domains    0     h   "auxhist7_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist7_begin_d   namelist,time_control	max_domains    0     h   "auxhist7_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist7_begin_h   namelist,time_control	max_domains    0     h   "auxhist7_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist7_begin_m   namelist,time_control	max_domains    0     h   "auxhist7_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist7_begin_s   namelist,time_control	max_domains    0     h   "auxhist7_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist8_begin_y  namelist,time_control	max_domains    0     h   "auxhist8_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist8_begin_mo  namelist,time_control	max_domains    0     h   "auxhist8_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist8_begin_d   namelist,time_control	max_domains    0     h   "auxhist8_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist8_begin_h   namelist,time_control	max_domains    0     h   "auxhist8_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist8_begin_m   namelist,time_control	max_domains    0     h   "auxhist8_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist8_begin_s   namelist,time_control	max_domains    0     h   "auxhist8_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist9_begin_y  namelist,time_control	max_domains    0     h   "auxhist9_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist9_begin_mo  namelist,time_control	max_domains    0     h   "auxhist9_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist9_begin_d   namelist,time_control	max_domains    0     h   "auxhist9_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist9_begin_h   namelist,time_control	max_domains    0     h   "auxhist9_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist9_begin_m   namelist,time_control	max_domains    0     h   "auxhist9_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist9_begin_s   namelist,time_control	max_domains    0     h   "auxhist9_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist10_begin_y  namelist,time_control	max_domains    0     h   "auxhist10_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist10_begin_mo  namelist,time_control	max_domains    0     h   "auxhist10_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist10_begin_d   namelist,time_control	max_domains    0     h   "auxhist10_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist10_begin_h   namelist,time_control	max_domains    0     h   "auxhist10_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist10_begin_m   namelist,time_control	max_domains    0     h   "auxhist10_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist10_begin_s   namelist,time_control	max_domains    0     h   "auxhist10_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxhist11_begin_y  namelist,time_control	max_domains    0     h   "auxhist11_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxhist11_begin_mo  namelist,time_control	max_domains    0     h   "auxhist11_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxhist11_begin_d   namelist,time_control	max_domains    0     h   "auxhist11_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxhist11_begin_h   namelist,time_control	max_domains    0     h   "auxhist11_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxhist11_begin_m   namelist,time_control	max_domains    0     h   "auxhist11_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxhist11_begin_s   namelist,time_control	max_domains    0     h   "auxhist11_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput1_begin_y  namelist,time_control	max_domains    0     h   "auxinput1_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput1_begin_mo  namelist,time_control	max_domains    0     h   "auxinput1_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput1_begin_d   namelist,time_control	max_domains    0     h   "auxinput1_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput1_begin_h   namelist,time_control	max_domains    0     h   "auxinput1_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput1_begin_m   namelist,time_control	max_domains    0     h   "auxinput1_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput1_begin_s   namelist,time_control	max_domains    0     h   "auxinput1_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput2_begin_y  namelist,time_control	max_domains    0     h   "auxinput2_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput2_begin_mo  namelist,time_control	max_domains    0     h   "auxinput2_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput2_begin_d   namelist,time_control	max_domains    0     h   "auxinput2_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput2_begin_h   namelist,time_control	max_domains    0     h   "auxinput2_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput2_begin_m   namelist,time_control	max_domains    0     h   "auxinput2_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput2_begin_s   namelist,time_control	max_domains    0     h   "auxinput2_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput3_begin_y  namelist,time_control	max_domains    0     h   "auxinput3_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput3_begin_mo  namelist,time_control	max_domains    0     h   "auxinput3_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput3_begin_d   namelist,time_control	max_domains    0     h   "auxinput3_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput3_begin_h   namelist,time_control	max_domains    0     h   "auxinput3_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput3_begin_m   namelist,time_control	max_domains    0     h   "auxinput3_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput3_begin_s   namelist,time_control	max_domains    0     h   "auxinput3_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput4_begin_y  namelist,time_control	max_domains    0     h   "auxinput4_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput4_begin_mo  namelist,time_control	max_domains    0     h   "auxinput4_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput4_begin_d   namelist,time_control	max_domains    0     h   "auxinput4_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput4_begin_h   namelist,time_control	max_domains    0     h   "auxinput4_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput4_begin_m   namelist,time_control	max_domains    0     h   "auxinput4_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput4_begin_s   namelist,time_control	max_domains    0     h   "auxinput4_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput5_begin_y  namelist,time_control	max_domains    0     h   "auxinput5_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput5_begin_mo  namelist,time_control	max_domains    0     h   "auxinput5_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput5_begin_d   namelist,time_control	max_domains    0     h   "auxinput5_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput5_begin_h   namelist,time_control	max_domains    0     h   "auxinput5_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput5_begin_m   namelist,time_control	max_domains    0     h   "auxinput5_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput5_begin_s   namelist,time_control	max_domains    0     h   "auxinput5_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput6_begin_y  namelist,time_control	max_domains    0     h   "auxinput6_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput6_begin_mo  namelist,time_control	max_domains    0     h   "auxinput6_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput6_begin_d   namelist,time_control	max_domains    0     h   "auxinput6_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput6_begin_h   namelist,time_control	max_domains    0     h   "auxinput6_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput6_begin_m   namelist,time_control	max_domains    0     h   "auxinput6_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput6_begin_s   namelist,time_control	max_domains    0     h   "auxinput6_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput7_begin_y  namelist,time_control	max_domains    0     h   "auxinput7_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput7_begin_mo  namelist,time_control	max_domains    0     h   "auxinput7_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput7_begin_d   namelist,time_control	max_domains    0     h   "auxinput7_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput7_begin_h   namelist,time_control	max_domains    0     h   "auxinput7_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput7_begin_m   namelist,time_control	max_domains    0     h   "auxinput7_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput7_begin_s   namelist,time_control	max_domains    0     h   "auxinput7_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput8_begin_y  namelist,time_control	max_domains    0     h   "auxinput8_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput8_begin_mo  namelist,time_control	max_domains    0     h   "auxinput8_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput8_begin_d   namelist,time_control	max_domains    0     h   "auxinput8_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput8_begin_h   namelist,time_control	max_domains    0     h   "auxinput8_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput8_begin_m   namelist,time_control	max_domains    0     h   "auxinput8_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput8_begin_s   namelist,time_control	max_domains    0     h   "auxinput8_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput9_begin_y  namelist,time_control	max_domains    0     h   "auxinput9_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput9_begin_mo  namelist,time_control	max_domains    0     h   "auxinput9_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput9_begin_d   namelist,time_control	max_domains    0     h   "auxinput9_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput9_begin_h   namelist,time_control	max_domains    0     h   "auxinput9_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput9_begin_m   namelist,time_control	max_domains    0     h   "auxinput9_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput9_begin_s   namelist,time_control	max_domains    0     h   "auxinput9_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer gfdda_begin_y   namelist,fdda	                max_domains    0     h   "gfdda_begin_y"    ""   "YEARS from start of run"
+rconfig  integer gfdda_begin_mo  namelist,fdda	                max_domains    0     h   "gfdda_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer gfdda_begin_d   namelist,fdda	                max_domains    0     h   "gfdda_begin_d"    ""   "DAYS from start of run"
+rconfig  integer gfdda_begin_h   namelist,fdda	                max_domains    0     h   "gfdda_begin_h"    ""   "HOURS from start of run"
+rconfig  integer gfdda_begin_m   namelist,fdda	                max_domains    0     h   "gfdda_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer gfdda_begin_s   namelist,fdda	                max_domains    0     h   "gfdda_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer auxinput11_begin_y  namelist,time_control	max_domains    0     h   "auxinput11_begin_y"    ""   "YEARS from start of run"
+rconfig  integer auxinput11_begin_mo  namelist,time_control	max_domains    0     h   "auxinput11_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer auxinput11_begin_d   namelist,time_control	max_domains    0     h   "auxinput11_begin_d"    ""   "DAYS from start of run"
+rconfig  integer auxinput11_begin_h   namelist,time_control	max_domains    0     h   "auxinput11_begin_h"    ""   "HOURS from start of run"
+rconfig  integer auxinput11_begin_m   namelist,time_control	max_domains    0     h   "auxinput11_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer auxinput11_begin_s   namelist,time_control	max_domains    0     h   "auxinput11_begin_s"    ""   "SECONDS from start of run"
+
+rconfig  integer restart_begin_y  namelist,time_control		1              0     h   "restart_begin_y"    ""   "YEARS from start of run"
+rconfig  integer restart_begin_mo  namelist,time_control	1              0     h   "restart_begin_mo"    ""   "MONTHS from start of run"
+rconfig  integer restart_begin_d   namelist,time_control	1              0     h   "restart_begin_d"    ""   "DAYS from start of run"
+rconfig  integer restart_begin_h   namelist,time_control	1              0     h   "restart_begin_h"    ""   "HOURS from start of run"
+rconfig  integer restart_begin_m   namelist,time_control	1              0     h   "restart_begin_m"    ""   "MINUTES from start of run"
+rconfig  integer restart_begin_s   namelist,time_control	1              0     h   "restart_begin_s"    ""   "SECONDS from start of run"
+
+rconfig integer history_end_y      namelist,time_control	max_domains    0    h  "history_end_y"       ""      "YEARS from start of run"
+rconfig integer history_end_mo     namelist,time_control	max_domains    0    h  "history_end_mo"       ""      "MONTHS from start of run"
+rconfig integer history_end_d      namelist,time_control	max_domains    0    h  "history_end_d"       ""      "DAYS from start of run"
+rconfig integer history_end_h      namelist,time_control	max_domains    0    h  "history_end_h"       ""      "HOURS from start of run"
+rconfig integer history_end_m      namelist,time_control	max_domains    0    h  "history_end_m"       ""      "MINUTES from start of run"
+rconfig integer history_end_s      namelist,time_control	max_domains    0    h  "history_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer inputout_end_y      namelist,time_control     max_domains    0    h  "inputout_end_y"       ""      "YEARS from start of run"
+rconfig integer inputout_end_mo      namelist,time_control     max_domains    0    h  "inputout_end_mo"       ""      "MONTHS from start of run"
+rconfig integer inputout_end_d      namelist,time_control     max_domains    0    h  "inputout_end_d"       ""      "DAYS from start of run"
+rconfig integer inputout_end_h      namelist,time_control     max_domains    0    h  "inputout_end_h"       ""      "HOURS from start of run"
+rconfig integer inputout_end_m      namelist,time_control     max_domains    0    h  "inputout_end_m"       ""      "MINUTES from start of run"
+rconfig integer inputout_end_s      namelist,time_control     max_domains    0    h  "inputout_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist1_end_y      namelist,time_control     max_domains    0    h  "auxhist1_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist1_end_mo      namelist,time_control     max_domains    0    h  "auxhist1_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist1_end_d      namelist,time_control     max_domains    0    h  "auxhist1_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist1_end_h      namelist,time_control     max_domains    0    h  "auxhist1_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist1_end_m      namelist,time_control     max_domains    0    h  "auxhist1_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist1_end_s      namelist,time_control     max_domains    0    h  "auxhist1_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist2_end_y      namelist,time_control     max_domains    0    h  "auxhist2_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist2_end_mo      namelist,time_control     max_domains    0    h  "auxhist2_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist2_end_d      namelist,time_control     max_domains    0    h  "auxhist2_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist2_end_h      namelist,time_control     max_domains    0    h  "auxhist2_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist2_end_m      namelist,time_control     max_domains    0    h  "auxhist2_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist2_end_s      namelist,time_control     max_domains    0    h  "auxhist2_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist3_end_y      namelist,time_control     max_domains    0    h  "auxhist3_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist3_end_mo      namelist,time_control     max_domains    0    h  "auxhist3_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist3_end_d      namelist,time_control     max_domains    0    h  "auxhist3_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist3_end_h      namelist,time_control     max_domains    0    h  "auxhist3_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist3_end_m      namelist,time_control     max_domains    0    h  "auxhist3_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist3_end_s      namelist,time_control     max_domains    0    h  "auxhist3_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist4_end_y     namelist,time_control     max_domains    0    h  "auxhist4_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist4_end_mo     namelist,time_control     max_domains    0    h  "auxhist4_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist4_end_d      namelist,time_control     max_domains    0    h  "auxhist4_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist4_end_h      namelist,time_control     max_domains    0    h  "auxhist4_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist4_end_m      namelist,time_control     max_domains    0    h  "auxhist4_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist4_end_s      namelist,time_control     max_domains    0    h  "auxhist4_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist5_end_y     namelist,time_control     max_domains    0    h  "auxhist5_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist5_end_mo     namelist,time_control     max_domains    0    h  "auxhist5_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist5_end_d      namelist,time_control     max_domains    0    h  "auxhist5_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist5_end_h      namelist,time_control     max_domains    0    h  "auxhist5_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist5_end_m      namelist,time_control     max_domains    0    h  "auxhist5_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist5_end_s      namelist,time_control     max_domains    0    h  "auxhist5_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist6_end_y     namelist,time_control     max_domains    0    h  "auxhist6_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist6_end_mo     namelist,time_control     max_domains    0    h  "auxhist6_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist6_end_d      namelist,time_control     max_domains    0    h  "auxhist6_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist6_end_h      namelist,time_control     max_domains    0    h  "auxhist6_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist6_end_m      namelist,time_control     max_domains    0    h  "auxhist6_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist6_end_s      namelist,time_control     max_domains    0    h  "auxhist6_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist7_end_y     namelist,time_control     max_domains    0    h  "auxhist7_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist7_end_mo     namelist,time_control     max_domains    0    h  "auxhist7_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist7_end_d      namelist,time_control     max_domains    0    h  "auxhist7_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist7_end_h      namelist,time_control     max_domains    0    h  "auxhist7_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist7_end_m      namelist,time_control     max_domains    0    h  "auxhist7_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist7_end_s      namelist,time_control     max_domains    0    h  "auxhist7_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist8_end_y     namelist,time_control     max_domains    0    h  "auxhist8_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist8_end_mo     namelist,time_control     max_domains    0    h  "auxhist8_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist8_end_d      namelist,time_control     max_domains    0    h  "auxhist8_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist8_end_h      namelist,time_control     max_domains    0    h  "auxhist8_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist8_end_m      namelist,time_control     max_domains    0    h  "auxhist8_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist8_end_s      namelist,time_control     max_domains    0    h  "auxhist8_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist9_end_y     namelist,time_control     max_domains    0    h  "auxhist9_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist9_end_mo     namelist,time_control     max_domains    0    h  "auxhist9_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist9_end_d      namelist,time_control     max_domains    0    h  "auxhist9_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist9_end_h      namelist,time_control     max_domains    0    h  "auxhist9_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist9_end_m      namelist,time_control     max_domains    0    h  "auxhist9_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist9_end_s      namelist,time_control     max_domains    0    h  "auxhist9_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist10_end_y     namelist,time_control     max_domains    0    h  "auxhist10_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist10_end_mo     namelist,time_control     max_domains    0    h  "auxhist10_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist10_end_d      namelist,time_control     max_domains    0    h  "auxhist10_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist10_end_h      namelist,time_control     max_domains    0    h  "auxhist10_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist10_end_m      namelist,time_control     max_domains    0    h  "auxhist10_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist10_end_s      namelist,time_control     max_domains    0    h  "auxhist10_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxhist11_end_y     namelist,time_control     max_domains    0    h  "auxhist11_end_y"       ""      "YEARS from start of run"
+rconfig integer auxhist11_end_mo     namelist,time_control     max_domains    0    h  "auxhist11_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxhist11_end_d      namelist,time_control     max_domains    0    h  "auxhist11_end_d"       ""      "DAYS from start of run"
+rconfig integer auxhist11_end_h      namelist,time_control     max_domains    0    h  "auxhist11_end_h"       ""      "HOURS from start of run"
+rconfig integer auxhist11_end_m      namelist,time_control     max_domains    0    h  "auxhist11_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxhist11_end_s      namelist,time_control     max_domains    0    h  "auxhist11_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput1_end_y     namelist,time_control     max_domains    0    h  "auxinput1_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput1_end_mo     namelist,time_control     max_domains    0    h  "auxinput1_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput1_end_d      namelist,time_control     max_domains    0    h  "auxinput1_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput1_end_h      namelist,time_control     max_domains    0    h  "auxinput1_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput1_end_m      namelist,time_control     max_domains    0    h  "auxinput1_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput1_end_s      namelist,time_control     max_domains    0    h  "auxinput1_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput2_end_y     namelist,time_control     max_domains    0    h  "auxinput2_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput2_end_mo     namelist,time_control     max_domains    0    h  "auxinput2_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput2_end_d      namelist,time_control     max_domains    0    h  "auxinput2_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput2_end_h      namelist,time_control     max_domains    0    h  "auxinput2_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput2_end_m      namelist,time_control     max_domains    0    h  "auxinput2_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput2_end_s      namelist,time_control     max_domains    0    h  "auxinput2_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput3_end_y     namelist,time_control     max_domains    0    h  "auxinput3_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput3_end_mo     namelist,time_control     max_domains    0    h  "auxinput3_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput3_end_d      namelist,time_control     max_domains    0    h  "auxinput3_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput3_end_h      namelist,time_control     max_domains    0    h  "auxinput3_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput3_end_m      namelist,time_control     max_domains    0    h  "auxinput3_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput3_end_s      namelist,time_control     max_domains    0    h  "auxinput3_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput4_end_y     namelist,time_control     max_domains    0    h  "auxinput4_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput4_end_mo     namelist,time_control     max_domains    0    h  "auxinput4_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput4_end_d      namelist,time_control     max_domains    0    h  "auxinput4_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput4_end_h      namelist,time_control     max_domains    0    h  "auxinput4_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput4_end_m      namelist,time_control     max_domains    0    h  "auxinput4_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput4_end_s      namelist,time_control     max_domains    0    h  "auxinput4_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput5_end_y     namelist,time_control     max_domains    0    h  "auxinput5_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput5_end_mo     namelist,time_control     max_domains    0    h  "auxinput5_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput5_end_d      namelist,time_control     max_domains    0    h  "auxinput5_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput5_end_h      namelist,time_control     max_domains    0    h  "auxinput5_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput5_end_m      namelist,time_control     max_domains    0    h  "auxinput5_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput5_end_s      namelist,time_control     max_domains    0    h  "auxinput5_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput6_end_y     namelist,time_control     max_domains    0    h  "auxinput6_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput6_end_mo     namelist,time_control     max_domains    0    h  "auxinput6_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput6_end_d      namelist,time_control     max_domains    0    h  "auxinput6_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput6_end_h      namelist,time_control     max_domains    0    h  "auxinput6_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput6_end_m      namelist,time_control     max_domains    0    h  "auxinput6_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput6_end_s      namelist,time_control     max_domains    0    h  "auxinput6_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput7_end_y     namelist,time_control     max_domains    0    h  "auxinput7_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput7_end_mo     namelist,time_control     max_domains    0    h  "auxinput7_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput7_end_d      namelist,time_control     max_domains    0    h  "auxinput7_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput7_end_h      namelist,time_control     max_domains    0    h  "auxinput7_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput7_end_m      namelist,time_control     max_domains    0    h  "auxinput7_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput7_end_s      namelist,time_control     max_domains    0    h  "auxinput7_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput8_end_y     namelist,time_control     max_domains    0    h  "auxinput8_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput8_end_mo     namelist,time_control     max_domains    0    h  "auxinput8_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput8_end_d      namelist,time_control     max_domains    0    h  "auxinput8_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput8_end_h      namelist,time_control     max_domains    0    h  "auxinput8_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput8_end_m      namelist,time_control     max_domains    0    h  "auxinput8_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput8_end_s      namelist,time_control     max_domains    0    h  "auxinput8_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput9_end_y     namelist,time_control     max_domains    0    h  "auxinput9_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput9_end_mo     namelist,time_control     max_domains    0    h  "auxinput9_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput9_end_d      namelist,time_control     max_domains    0    h  "auxinput9_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput9_end_h      namelist,time_control     max_domains    0    h  "auxinput9_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput9_end_m      namelist,time_control     max_domains    0    h  "auxinput9_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput9_end_s      namelist,time_control     max_domains    0    h  "auxinput9_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer gfdda_end_y          namelist,fdda             max_domains    0    h  "gfdda_end_y"       ""      "YEARS from start of run"
+rconfig integer gfdda_end_mo         namelist,fdda             max_domains    0    h  "gfdda_end_mo"       ""      "MONTHS from start of run"
+rconfig integer gfdda_end_d          namelist,fdda             max_domains    0    h  "gfdda_end_d"       ""      "DAYS from start of run"
+rconfig integer gfdda_end_h          namelist,fdda             max_domains    0    h  "gfdda_end_h"       ""      "HOURS from start of run"
+rconfig integer gfdda_end_m          namelist,fdda             max_domains    0    h  "gfdda_end_m"       ""      "MINUTES from start of run"
+rconfig integer gfdda_end_s          namelist,fdda             max_domains    0    h  "gfdda_end_s"       ""      "SECONDS from start of run"
+
+rconfig integer auxinput11_end_y     namelist,time_control     max_domains    0    h  "auxinput11_end_y"       ""      "YEARS from start of run"
+rconfig integer auxinput11_end_mo     namelist,time_control     max_domains    0    h  "auxinput11_end_mo"       ""      "MONTHS from start of run"
+rconfig integer auxinput11_end_d      namelist,time_control     max_domains    0    h  "auxinput11_end_d"       ""      "DAYS from start of run"
+rconfig integer auxinput11_end_h      namelist,time_control     max_domains    0    h  "auxinput11_end_h"       ""      "HOURS from start of run"
+rconfig integer auxinput11_end_m      namelist,time_control     max_domains    0    h  "auxinput11_end_m"       ""      "MINUTES from start of run"
+rconfig integer auxinput11_end_s      namelist,time_control     max_domains    0    h  "auxinput11_end_s"       ""      "SECONDS from start of run"
+
+rconfig   integer     io_form_auxinput1   namelist,time_control		1              2       h        "io_form_auxinput1"                 ""      ""
+rconfig   integer     io_form_auxinput2   namelist,time_control		1              2       h        "io_form_auxinput2"                 ""      ""
+rconfig   integer     io_form_auxinput3   namelist,time_control		1              2       h        "io_form_auxinput3"                 ""      ""
+rconfig   integer     io_form_auxinput4   namelist,time_control		1              2       h        "io_form_auxinput4"                 ""      ""
+rconfig   integer     io_form_auxinput5   namelist,time_control		1              2       h        "io_form_auxinput5"                 ""      ""
+rconfig   integer     io_form_auxinput6   namelist,time_control		1              2       h        "io_form_auxinput6"                 ""      ""
+rconfig   integer     io_form_auxinput7   namelist,time_control		1              2       h        "io_form_auxinput7"                 ""      ""
+rconfig   integer     io_form_auxinput8   namelist,time_control		1              2       h        "io_form_auxinput8"                 ""      ""
+rconfig   integer     io_form_auxinput9   namelist,time_control		1              2       h        "io_form_auxinput9"                 ""      ""
+rconfig   integer     io_form_gfdda       namelist,fdda        	        1              2       h        "io_form_gfdda"                 ""      ""
+rconfig   integer     io_form_auxinput11   namelist,time_control	1              2       h        "io_form_auxinput11"                 ""      ""
+rconfig   integer     io_form_auxhist1    namelist,time_control		1              2       h        "io_form_auxhist1"               ""      ""
+rconfig   integer     io_form_auxhist2    namelist,time_control		1              2       h        "io_form_auxhist2"               ""      ""
+rconfig   integer     io_form_auxhist3    namelist,time_control		1              2       h        "io_form_auxhist3"               ""      ""
+rconfig   integer     io_form_auxhist4    namelist,time_control		1              2       h        "io_form_auxhist4"               ""      ""
+rconfig   integer     io_form_auxhist5    namelist,time_control		1              2       h        "io_form_auxhist5"               ""      ""
+rconfig   integer     io_form_auxhist6    namelist,time_control		1              2       h        "io_form_auxhist6"               ""      ""
+rconfig   integer     io_form_auxhist7    namelist,time_control		1              2       h        "io_form_auxhist7"               ""      ""
+rconfig   integer     io_form_auxhist8    namelist,time_control		1              2       h        "io_form_auxhist8"               ""      ""
+rconfig   integer     io_form_auxhist9    namelist,time_control		1              2       h        "io_form_auxhist9"               ""      ""
+rconfig   integer     io_form_auxhist10    namelist,time_control	1              2       h        "io_form_auxhist10"               ""      ""
+rconfig   integer     io_form_auxhist11    namelist,time_control	1              2       h        "io_form_auxhist11"               ""      ""
Index: trunk/WRF.COMMON/WRFV2/Registry_save
===================================================================
--- trunk/WRF.COMMON/WRFV2/Registry_save	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/Registry_save	(revision 2744)
@@ -0,0 +1,10 @@
+mkdir save/Registry
+cp -rf Registry/diff save/Registry
+cp -rf Registry/Registry.EM save/Registry
+cp -rf Registry/Registry.EMref save/Registry
+cp -rf Registry/Registry.EM_MARS* save/Registry
+cp -rf Registry/Registry.EM_dust save/Registry
+cp -rf Registry/Registry.EM_water save/Registry
+cp -rf Registry/Registry.bash save/Registry
+#cp -rf Registry/Registry.meso* save/Registry
+
Index: trunk/WRF.COMMON/WRFV2/arch/Config.pl
===================================================================
--- trunk/WRF.COMMON/WRFV2/arch/Config.pl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/arch/Config.pl	(revision 2744)
@@ -0,0 +1,320 @@
+#!/usr/bin/perl
+#
+# Configuration script for WRF prototype code
+# 
+# Be sure to run as ./configure (to avoid getting a system configure command by mistake)
+#
+
+$sw_perl_path = perl ;
+$sw_netcdf_path = "" ;
+$sw_pnetcdf_path = "" ;
+$sw_phdf5_path=""; 
+$sw_jasperlib_path=""; 
+$sw_jasperinc_path=""; 
+$sw_esmflib_path="";
+$sw_esmfinc_path="";
+$sw_ldflags=""; 
+$sw_compileflags=""; 
+$WRFCHEM = 0 ;
+$sw_os = "ARCH" ;           # ARCH will match any
+$sw_mach = "ARCH" ;         # ARCH will match any
+
+while ( substr( $ARGV[0], 0, 1 ) eq "-" )
+ {
+  if ( substr( $ARGV[0], 1, 5 ) eq "perl=" )
+  {
+    $sw_perl_path = substr( $ARGV[0], 6 ) ;
+  }
+  if ( substr( $ARGV[0], 1, 7 ) eq "netcdf=" )
+  {
+    $sw_netcdf_path = substr( $ARGV[0], 8 ) ;
+  }
+  if ( substr( $ARGV[0], 1, 8 ) eq "pnetcdf=" )
+  {
+    $sw_pnetcdf_path = substr( $ARGV[0], 9 ) ;
+  }
+  if ( substr( $ARGV[0], 1, 6 ) eq "phdf5=" )
+  {
+    $sw_phdf5_path = substr( $ARGV[0], 7 ) ;
+  }
+  if ( substr( $ARGV[0], 1, 3 ) eq "os=" )
+  {
+    $sw_os = substr( $ARGV[0], 4 ) ;
+  }
+  if ( substr( $ARGV[0], 1, 5 ) eq "mach=" )
+  {
+    $sw_mach = substr( $ARGV[0], 6 ) ;
+  }
+  if ( substr( $ARGV[0], 1, 8 ) eq "ldflags=" )
+  {
+    $sw_ldflags = substr( $ARGV[0], 9 ) ;
+# multiple options separated by spaces are passed in from sh script
+# separated by ! instead. Replace with spaces here.
+    $sw_ldflags =~ s/!/ /g ;
+  }
+  if ( substr( $ARGV[0], 1, 13 ) eq "compileflags=" )
+  {
+    $sw_compileflags = substr( $ARGV[0], 14 ) ;
+    $sw_compileflags =~ s/!/ /g ;
+#   look for each known option
+    $where_index = index ( $sw_compileflags , "-DWRF_CHEM" ) ;
+    if ( $where_index eq -1 ) 
+    {
+      $WRFCHEM = 0 ;
+    }
+    else
+    {
+      $WRFCHEM = 1 ;
+    } 
+  }
+  shift @ARGV ;
+ }
+
+# The jasper library is required to build Grib2 I/O.  User must set 
+# environment variables JASPERLIB and JASPERINC to paths to library and 
+# include files to enable this feature prior to running configure.  
+ if ( $ENV{JASPERLIB} && $ENV{JASPERINC} )
+   {
+   printf "Configuring to use jasper library to build Grib2 I/O...\n" ;
+   printf("  \$JASPERLIB = %s\n",$ENV{JASPERLIB});
+   printf("  \$JASPERINC = %s\n",$ENV{JASPERINC});
+   $sw_jasperlib_path = $ENV{JASPERLIB}; 
+   $sw_jasperinc_path = $ENV{JASPERINC}; 
+   }
+ else
+   {
+   printf "\$JASPERLIB or \$JASPERINC not found in environment, configuring to build without grib2 I/O...\n" ;
+   }
+
+# A separately-installed ESMF library is required to build the ESMF 
+# implementation of WRF IOAPI in external/io_esmf.  This is needed 
+# to couple WRF with other ESMF components.  User must set environment 
+# variables ESMFLIB and ESMFINC to paths ESMF to library and include 
+# files to enable this feature prior to running configure.
+ if ( $ENV{ESMFLIB} && $ENV{ESMFINC} )
+   {
+   printf "Configuring to use ESMF library to build WRF...\n" ;
+   printf "WARNING-WARNING-WARNING-WARNING-WARNING-WARNING-WARNING-WARNING\n" ;
+   printf "WARNING:  THIS IS AN EXPERIMENTAL CONFIGURATION\n" ;
+   printf "WARNING:  IT DOES NOT WORK WITH NESTING\n" ;
+   printf "WARNING-WARNING-WARNING-WARNING-WARNING-WARNING-WARNING-WARNING\n" ;
+   printf("  \$ESMFLIB = %s\n",$ENV{ESMFLIB});
+   printf("  \$ESMFINC = %s\n",$ENV{ESMFINC});
+   $sw_esmflib_path = $ENV{ESMFLIB};
+   $sw_esmfinc_path = $ENV{ESMFINC};
+   }
+
+# parse the configure.wrf file
+
+$validresponse = 0 ;
+
+# Display the choices to the user and get selection
+until ( $validresponse ) {
+  printf "------------------------------------------------------------------------\n" ;
+  printf "Please select from among the following supported platforms.\n\n" ;
+
+  $opt = 1 ;
+  open CONFIGURE_DEFAULTS, "< ./arch/configure.defaults" 
+      or die "Cannot open ./arch/configure.defaults for reading" ;
+  while ( <CONFIGURE_DEFAULTS> )
+  {
+    if ( substr( $_, 0, 5 ) eq "#ARCH" && ( index( $_, $sw_os ) >= 0 ) && ( index( $_, $sw_mach ) >= 0 ) )
+    {
+      $optstr[$opt] = substr($_,6) ;
+      $optstr[$opt] =~ s/^[ 	]*// ;
+      if ( substr( $optstr[$opt], 0,4 ) ne "NULL" )
+      {
+        printf "  %2d.  %s",$opt,$optstr[$opt] ;
+        $opt++ ;
+      }
+    }
+  }
+  close CONFIGURE_DEFAULTS ;
+
+  $opt -- ;
+
+  printf "\nEnter selection [%d-%d] : ",1,$opt ;
+  $response = <STDIN> ;
+
+  if ( $response == -1 ) { exit ; }
+
+  if ( $response >= 1 && $response <= $opt ) 
+  { $validresponse = 1 ; }
+  else
+  { printf("\nInvalid response (%d)\n",$response);}
+}
+printf "------------------------------------------------------------------------\n" ;
+
+$optchoice = $response ;
+
+open CONFIGURE_DEFAULTS, "< ./arch/configure.defaults" 
+      or die "Cannot open ./arch/configure.defaults for reading" ;
+$latchon = 0 ;
+while ( <CONFIGURE_DEFAULTS> )
+{
+  if ( substr( $_, 0, 5 ) eq "#ARCH" && $latchon == 1 )
+  {
+    $latchon = 0 ;
+  }
+  if ( $latchon == 1 )
+  {
+    $_ =~ s/CONFIGURE_PERL_PATH/$sw_perl_path/g ;
+    $_ =~ s/CONFIGURE_NETCDF_PATH/$sw_netcdf_path/g ;
+    $_ =~ s/CONFIGURE_PNETCDF_PATH/$sw_pnetcdf_path/g ;
+    $_ =~ s/CONFIGURE_PHDF5_PATH/$sw_phdf5_path/g ;
+    $_ =~ s/CONFIGURE_LDFLAGS/$sw_ldflags/g ;
+    $_ =~ s/CONFIGURE_COMPILEFLAGS/$sw_compileflags/g ;
+    if ( $sw_netcdf_path ) 
+      { $_ =~ s/CONFIGURE_WRFIO_NF/wrfio_nf/g ;
+	$_ =~ s:CONFIGURE_NETCDF_FLAG:-DNETCDF: ;
+	$_ =~ s:CONFIGURE_NETCDF_LIB_PATH:-L../external/io_netcdf -lwrfio_nf -L$sw_netcdf_path/lib -lnetcdf: ;
+	 }
+    else                   
+      { $_ =~ s/CONFIGURE_WRFIO_NF//g ;
+	$_ =~ s:CONFIGURE_NETCDF_FLAG::g ;
+	$_ =~ s:CONFIGURE_NETCDF_LIB_PATH::g ;
+	 }
+
+    if ( $sw_pnetcdf_path ) 
+      { $_ =~ s/CONFIGURE_WRFIO_PNF/wrfio_pnf/g ;
+	$_ =~ s:CONFIGURE_PNETCDF_FLAG:-DPNETCDF: ;
+	$_ =~ s:CONFIGURE_PNETCDF_LIB_PATH:-L../external/io_pnetcdf -lwrfio_pnf -L$sw_pnetcdf_path/lib -lpnetcdf: ;
+	 }
+    else                   
+      { $_ =~ s/CONFIGURE_WRFIO_PNF//g ;
+	$_ =~ s:CONFIGURE_PNETCDF_FLAG::g ;
+	$_ =~ s:CONFIGURE_PNETCDF_LIB_PATH::g ;
+	 }
+
+    if ( $sw_phdf5_path ) 
+
+      { $_ =~ s/CONFIGURE_WRFIO_PHDF5/wrfio_phdf5/g ;
+	$_ =~ s:CONFIGURE_PHDF5_FLAG:-DPHDF5: ;
+	$_ =~ s:CONFIGURE_PHDF5_LIB_PATH:-L../external/io_phdf5 -lwrfio_phdf5 -L$sw_phdf5_path/lib -lhdf5_fortran -lhdf5 -lm -lz -L$sw_phdf5_path/lib -lsz: ;
+	 }
+    else                   
+      { $_ =~ s/CONFIGURE_WRFIO_PHDF5//g ;
+	$_ =~ s:CONFIGURE_PHDF5_FLAG::g ;
+	$_ =~ s:CONFIGURE_PHDF5_LIB_PATH::g ;
+	 }
+
+    if ( $sw_jasperlib_path && $sw_jasperinc_path ) 
+      { $_ =~ s/CONFIGURE_WRFIO_GRIB2/wrfio_grib2/g ;
+        $_ =~ s:CONFIGURE_GRIB2_FLAG:-DGRIB2:g ;
+        $_ =~ s:CONFIGURE_GRIB2_INC:-I$sw_jasperinc_path:g ;
+        $_ =~ s:CONFIGURE_GRIB2_LIB:-L../external/io_grib2 -lio_grib2 -L$sw_jasperlib_path -ljasper:g ;
+      }
+    else                   
+      { $_ =~ s/CONFIGURE_WRFIO_GRIB2//g ;
+        $_ =~ s:CONFIGURE_GRIB2_FLAG::g ;
+        $_ =~ s:CONFIGURE_GRIB2_INC::g ;
+        $_ =~ s:CONFIGURE_GRIB2_LIB::g ;
+      }
+
+
+    # ESMF substitutions in configure.defaults
+    if ( $sw_esmflib_path && $sw_esmfinc_path )
+      {
+      $_ =~ s:ESMFIOLIB:-L$sw_esmflib_path -lesmf -L../external/io_esmf -lwrfio_esmf \$\(ESMF_LIB_FLAGS\):g ;
+      $_ =~ s:ESMFIOEXTLIB:-L$sw_esmflib_path -lesmf -L../../external/io_esmf -lwrfio_esmf \$\(ESMF_LIB_FLAGS\):g ;
+      }
+    else
+      {
+      $_ =~ s:ESMFIOLIB:-L../external/esmf_time_f90 -lesmf_time:g ;
+      $_ =~ s:ESMFIOEXTLIB:-L../../external/esmf_time_f90 -lesmf_time:g ;
+      }
+
+    @machopts = ( @machopts, $_ ) ;
+    if ( substr( $_, 0, 10 ) eq "ENVCOMPDEF" )
+    {
+      @machopts = ( @machopts, "WRF_CHEM\t=\t$WRFCHEM \n" ) ;
+    }
+  }
+  if ( substr( $_, 0, 5 ) eq "#ARCH" && $latchon == 0 )
+  {
+    $x=substr($_,6) ;
+    $x=~s/^[     ]*// ;
+    if ( $x eq $optstr[$optchoice] )
+    {
+      $latchon = 1 ;
+    }
+  }
+}
+close CONFIGURE_DEFAULTS ;
+
+#printf "------------------------------------------------------------------------\n" ;
+#foreach $f ( @machopts )
+#{
+#  if ( substr( $f , 0 , 8 ) eq "external" ) { last ; }
+#  print $f ;
+#}
+#printf "------------------------------------------------------------------------\n" ;
+#printf "\nYou have chosen: %s",$optstr[$optchoice] ;
+#printf "Listed above are the default options for this platform.\n" ;
+#printf "Settings are written to the file configure.wrf here in the top-level\n" ;
+#printf "directory.  If you wish to change settings, please edit that file.\n" ;
+#printf "If you wish to change the default options, edit the file:\n\n" ;
+#printf "     arch/configure.defaults\n" ;
+#printf "\n" ;
+
+open CONFIGURE_WRF, "> configure.wrf" or die "cannot append configure.wrf" ;
+open ARCH_PREAMBLE, "< arch/preamble" or die "cannot open arch/preamble" ;
+my @preamble;
+# apply substitutions to the preamble...
+while ( <ARCH_PREAMBLE> )
+  {
+  # ESMF substitutions in preamble
+  if ( $sw_esmflib_path && $sw_esmfinc_path )
+    {
+    $_ =~ s/ESMFCOUPLING/1/g ;
+    $_ =~ s:ESMFMODDEPENDENCE:../external/io_esmf/module_utility.o:g ;
+    $_ =~ s:ESMFMODINC:-I$sw_esmfinc_path -I../main:g ;
+    $_ =~ s:ESMFIOINC:-I../external/io_esmf:g ;
+    $_ =~ s:ESMFIODEFS:-DESMFIO:g ;
+    $_ =~ s:ESMFTARGET:wrfio_esmf:g ;
+    }
+  else
+    {
+    $_ =~ s/ESMFCOUPLING/0/g ;
+    $_ =~ s:ESMFMODDEPENDENCE:../external/esmf_time_f90/module_utility.o:g ;
+    $_ =~ s:ESMFMODINC::g ;
+    $_ =~ s:ESMFIOINC:-I../external/esmf_time_f90:g ;
+    $_ =~ s:ESMFIODEFS::g ;
+    $_ =~ s:ESMFTARGET:esmf_time:g ;
+    }
+  @preamble = ( @preamble, $_ ) ;
+  }
+close ARCH_PREAMBLE ;
+print CONFIGURE_WRF @preamble  ;
+close ARCH_PREAMBLE ;
+printf CONFIGURE_WRF "# Settings for %s", $optstr[$optchoice] ;
+print CONFIGURE_WRF @machopts  ;
+open ARCH_POSTAMBLE, "< arch/postamble" or die "cannot open arch/postamble" ;
+while ( <ARCH_POSTAMBLE> ) { print CONFIGURE_WRF } ;
+close ARCH_POSTAMBLE ;
+close CONFIGURE_WRF ;
+
+# Die if attempting to configure with both RSL_LITE and a separately-installed ESMF library
+if ( $sw_esmflib_path && $sw_esmfinc_path )
+  {
+  my $RSL_LITE_plus_ESMF = "";
+  open CONFIGURE_WRF, "< configure.wrf" or die "cannot open configure.wrf for reading" ;
+  while ( <CONFIGURE_WRF> )
+    {
+    if ( $_ =~ /DRSL_LITE/ )
+      {
+      $RSL_LITE_plus_ESMF = "TRUE";
+      }
+    }
+  close CONFIGURE_WRF ;
+  if ( $RSL_LITE_plus_ESMF )
+    {
+    unlink("configure.wrf") ;
+    die "\nCONFIGURATION FAILED:  cannot use a separately-installed ESMF library with RSL_LITE.  Please reconfigure to use RSL instead.\n\n" ;
+    }
+  }
+
+printf "Configuration successful. To build the model type compile . \n" ;
+printf "------------------------------------------------------------------------\n" ;
+
+
Index: trunk/WRF.COMMON/WRFV2/arch/configure.defaults
===================================================================
--- trunk/WRF.COMMON/WRFV2/arch/configure.defaults	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/arch/configure.defaults	(revision 2744)
@@ -0,0 +1,10947 @@
+###########################################################
+#ARCH	SGI 32 bit machine IRIX
+
+FC		=	f90
+SFC		=	$(FC)
+LD		=	f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -w
+FCFLAGS		=	$(FCBASEOPTS)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS		=
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS
+LDFLAGS		=       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(FC) $(PROMOTION) -freeform -I." RANLIB="$(RANLIB)" CPP="$(CPP)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH	SGI 32 bit machine, sycamore IRIX
+
+FC		=	f90
+SFC		=	$(FC)
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -w
+FCFLAGS		=	-freeform -I. -w
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS		=
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../frame -I../share -I../phys -I../chem  \
+                       	-I../external/esmf_time_f90 -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS
+LDFLAGS		=       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(FC) $(PROMOTION) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       SGI 64 bit machine IRIX64     (single-threaded, no nesting)
+
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+CFLAGS          =       -64 -DLANDREAD_STUB -DNCARIBM_NOC99
+FCOPTIM         =       -O3
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -64 -cpp -OPT:Olimit=5269 $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+                        -DINTIO -DLIMIT_ARGS -DLANDREAD_STUB
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -64 -OPT:Olimit=5269       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(FC) $(PROMOTION) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_configure.o : module_configure.F
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -freeform -I. -64 -cpp -OPT:Olimit=5269 -w $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	SGI O2K IRIX
+
+FC              =       f90 -n32 -mips4 -w
+SFC		=	$(FC)
+LD              =       f90 -n32 -mips4 -w
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -n32 -mips4
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -w
+FCFLAGS         =       -freeform -I. -O3 -OPT:roundoff=3:IEEE_arithmetic=3 -OPT:fold_arith_limit=2001
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../frame -I../share \
+                        -I../phys -I../chem -I../inc -I../external/esmf_time_f90
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+AR              =       ar ru
+M4              =       m4 -B14000
+LDFLAGS         =       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -C -P $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       SGI 64 bit machine IRIX64     (OpenMP, no nesting)
+
+OMP             =       -mp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -64 -DLANDREAD_STUB -DNCARIBM_NOC99
+FCOPTIM         =       -O3
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -64 -cpp -OPT:Olimit=5269 $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+                        -DINTIO -DLIMIT_ARGS -DLANDREAD_STUB
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH $(OMP) \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -64 -OPT:Olimit=5269       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	SGI O2K DM IRIX64     DM-Parallel        (RSL, SGI-MPI, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+OMP             =       #-mp
+OMPCPP          =       #-D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -w -64 -mips4 -DWRF_RSL_IO -DMAXDOM_MAKE=$(MAX_DOMAINS) \
+                        -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -DDM_PARALLEL -DLANDREAD_STUB -DNCARIBM_NOC99
+FCDEBUG         =       # -g
+FCOPTIM         =       -O3 -OPT:roundoff=3:IEEE_arithmetic=3
+FCBASEOPTS	=	-freeform -I. -64 -mips4 -w $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DINTIO -DGRIB1 CONFIGURE_GRIB2_FLAG -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 \
+                        -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../frame -I../external/esmf_time_f90 \
+                        -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl -lmpi \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS		=       -64 $(OMP)       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+               LEARN_BCAST=-DLEARN_BCAST o2k )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS      (single-threaded, no nesting)
+#
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =	-DNCARIBM_NOC99
+FCOPTIM		=	-O2 # -O4 -xlibmopt
+FCDEBUG		=	#-g
+FCBASEOPTS	=	-fnonstd -free -xpp=cpp $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+			-M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+			-M../frame -M../share -M../phys -M../inc -M../chem \
+			-M../dyn_em 
+ARCHFLAGS       =       -DINTIO -DGRIB1 CONFIGURE_GRIB2_FLAG -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCOPTIM)       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+#CPP            =       /opt/SUNWspro/bin/fpp
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c $(FCBASEOPTS) -I. $(PROMOTION) $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+shift_domain_em.o                                              \
+wrf_bdyin.o wrf_bdyout.o  \
+wrf_histin.o wrf_histout.o  \
+wrf_inputin.o wrf_inputout.o  \
+wrf_restartin.o wrf_restartout.o  \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o mediation_interp_domain.o \
+mediation_force_domain.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS      (single-threaded, nesting using RSL and no MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP             =       
+OMPCPP          =       
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DSTUBMPI
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL -DNCARIBM_NOC99
+FCOPTIM         =       -O2 # -O4 -xlibmopt
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -fnonstd -free -xpp=cpp $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+                        -M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+                        -M../frame -M../share -M../phys -M../inc -M../chem \
+                        -M../dyn_em
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP)        CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-w -DSUN -DSTUBS -O' FC="$(FC) $(PROMOTION)" FFLAGS='-w -O' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+wrf_bdyin.o wrf_bdyout.o  \
+wrf_histin.o wrf_histout.o  \
+wrf_inputin.o wrf_inputout.o  \
+wrf_restartin.o wrf_restartout.o  \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS SM   (OpenMP, no nesting)
+#
+OMP		=	-mp=openmp -explicitpar -stackvar
+OMPCPP          =       -D_OPENMP
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =	-DNCARIBM_NOC99
+FCOPTIM		=	-O3 -xlibmopt
+FCDEBUG		=	#-g
+FCBASEOPTS	=	-fnonstd -free -xpp=cpp $(FCDEBUG) $(OMP) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+			-M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+			-M../frame -M../share -M../phys -M../inc -M../chem \
+			-M../dyn_em 
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+#CPP            =       /opt/SUNWspro/bin/fpp
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c $(FCBASEOPTS) -I. $(PROMOTION) $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS SM   (OpenMP, nesting using RSL and no MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP		=	-mp=openmp -explicitpar -stackvar
+OMPCPP          =       -D_OPENMP
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DSTUBMPI
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL -DNCARIBM_NOC99
+FCOPTIM         =       -O3 -xlibmopt
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -fnonstd -free -xpp=cpp $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+                        -M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+                        -M../frame -M../share -M../phys -M../inc -M../chem \ 
+                        -M../dyn_em
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -cpp -free" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-w -DSUN -DSTUBS -O' FC="$(FC) $(PROMOTION)" FFLAGS='-w -O' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH   AIX             (single-threaded, no nesting)
+#
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+CC              =       cc_r
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -qspill=20000 $(FCDEBUG) -qmaxmem=32767 -w #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFIXED         =       -qfixed
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_interface.o : solve_interface.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+module_integrate.o : module_integrate.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o							\
+solve_nmm.o                                                     \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+# to prevent having to call our service representative
+mediation_feedback_domain.o \
+mediation_force_domain.o start_domain.o module_integrate.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH   AIX SM          (OpenMP, no nesting)
+#
+OMP             =       -qsmp=noauto:noopt
+OMPCPP          =       -D_OPENMP
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+CC              =       cc_r
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv -lxlsmp \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+module_sm.o 	: module_sm.F
+module_tiles.o	: module_tiles.F
+solve_em.o	: solve_em.F
+solve_exp.o	: solve_exp.F
+convert_nmm.o   : convert_nmm.F
+
+module_sm.o module_tiles.o solve_em.o solve_exp.o convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(OMP) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+#	Compiled WITHOUT ANY SMP, needed Mar 2005
+module_domain.o : module_domain.F
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_interface.o : solve_interface.F
+module_integrate.o : module_integrate.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL_LITE, IBM-MPI, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE  -I../external/RSL_LITE -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_pnetcdf \
+                        -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DRSL_LITE -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PNETCDF_FLAG \
+                        -DTRIEDNTRUE -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DNMM_NEST=$(WRF_NMM_NEST)
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH \
+                        -L../external/RSL_LITE -lrsl_lite -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+PNETCDFPATH	=	CONFIGURE_PNETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_pnf : 
+	( cd ../external/io_pnetcdf ; make NETCDFPATH=CONFIGURE_PNETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CFLAGS="$(CFLAGS)" CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL, IBM-MPI, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFIXED         =       -qfixed
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/io_pnetcdf $(ESMF_IO_INC) \
+                        -I../frame -I../share -I../phys -I../chem -I../inc $(ESMF_MOD_INC)
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PNETCDF_FLAG \
+                        -DTRIEDNTRUE   -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV $(ESMF_IO_DEFS)
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH \
+                        -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o $(ESMF_IO_LIB)
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+PNETCDFPATH     =       CONFIGURE_PNETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F $(ESMF_TARGET)
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_pnf : 
+	( cd ../external/io_pnetcdf ; make NETCDFPATH=CONFIGURE_PNETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+start_domain_nmm.o : start_domain_nmm.F
+couple_or_uncouple_em.o : couple_or_uncouple_em.F
+nest_init_utils.o : nest_init_utils.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+start_domain_nmm.o                                     \
+couple_or_uncouple_em.o                                              \
+nest_init_utils.o                                              \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL, IBM-MPI, allows nesting )(PARALLEL HDF5)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto 
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=-1 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf  -I../external/io_phdf5 -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PHDF5_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PHDF5_LIB_PATH -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 CONFIGURE_WRFIO_PHDF5 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_phdf5 : 
+	( cd ../external/io_phdf5 ; make PHDF5PATH=CONFIGURE_PHDF5_PATH FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qfree=F90 -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL_LITE, IBM-MPI, Allows nesting )(PARALLEL HDF5)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE  -I../external/RSL_LITE -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto 
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=-1 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf  -I../external/io_phdf5 -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DRSL_LITE -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PHDF5_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PHDF5_LIB_PATH -L../external/RSL_LITE -lrsl_lite -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 CONFIGURE_WRFIO_PHDF5 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_phdf5 : 
+	( cd ../external/io_phdf5 ; make PHDF5PATH=CONFIGURE_PHDF5_PATH FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qfree=F90 -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" CFLAGS="$(CFLAGS)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel/SM-Parallel (not recommended)  (RSL, IBM-MPI, OpenMP, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+OMP             =       -qsmp=noauto:noopt
+OMPCPP          =       -D_OPENMP
+SFC		=	xlf90_r
+SCC             =       cc_r
+FC		=	mpxlf90_r
+LD		=	mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lxlsmp -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+MAX_PROC        =       1024
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+convert_nmm.o \
+module_configure.o                                             \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+mediation_integrate.o \
+mediation_interp_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+# to prevent having to call our service representative
+mediation_feedback_domain.o \
+mediation_force_domain.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+#	Compiled WITHOUT ANY SMP, needed Mar 2005
+module_domain.o : module_domain.F
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL, IBM-MPI, MCEL)   May 2003, EXPERIMENTAL
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpCC_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+MCELHOME        =       /home/bluesky/bettenc/disttest
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../../inc -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DMCELIO -DLIMIT_ARGS \
+                        -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        -L../external/RSL/RSL -lrsl -lmass -lmassv -lxlsmp \
+                        -L../external/io_mcel -lwrfio_mcel  \
+-L$(MCELHOME)/MCELSystem/MCEL -lMCEL  \
+-L$(MCELHOME)/lib -lomniORB4  \
+-lomnithread -lomniDynamic4  -lnetcdf_c++ -lnetcdf  -lxlf90 -lxlopt  \
+                        -lxlf -lxlomp_ser -lm -lc -lpthread \
+                        -L../external/io_int -lwrfio_int  \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int wrfio_mcel gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( cat ../tools/gen_comms_warning ../external/RSL/gen_comms.c > ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( cat module_dm_warning ../external/RSL/module_dm.F > module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+wrfio_mcel : 
+	( cd ../external/io_mcel ; \
+          make CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -I../../inc -I../io_netcdf -I../../frame -I../../share \
+               -I$(MCELHOME)/MCELSystem/MCEL -qfree=f90" all )
+
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX                      (single-threaded, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       xlf90_r
+LD              =       xlf90_r
+CC              =       cc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DSTUBMPI
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ;  \
+          make CC="$(CC)" CFLAGS='-DSTUBS -O -DNOUNDERSCORE' FC="$(FC) $(PROMOTION)" FFLAGS='-O -qfixed' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+couple_or_uncouple_em.o : couple_or_uncouple_em.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+couple_or_uncouple_em.o \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX                      (OpenMP, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =       -qsmp=noauto:noopt
+OMPCPP          =       -D_OPENMP
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       xlf90_r
+LD              =       xlf90_r
+CC              =       cc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DSTUBMPI
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ;  \
+          make CC="$(CC)" CFLAGS='-DSTUBS -O -DNOUNDERSCORE' FC="$(FC) $(PROMOTION)" FFLAGS='-O -qfixed' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+start_domain.o : start_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+start_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(OMP) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+#	Compiled WITHOUT ANY SMP, needed Mar 2005
+module_domain.o : module_domain.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+module_initialize_real.o : module_initialize_real.F
+
+module_domain.o \
+module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_force_domain.o \
+mediation_feedback_domain.o \
+module_initialize_real.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH       Linux ppc64 BG (Blue Gene, RSL_LITE, IBM-MPI) 
+#
+# from sheeba
+BGL_SYS         =       /bgl/BlueLight/ppcfloor/bglsys
+MPI_INC         =       -I$(BGL_SYS)/include
+MPI_LIB         =       -L$(BGL_SYS)/lib -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts
+TRACE_LIB       =       -L/contrib/bgl/mpi_trace  -lmpitrace_c
+
+SFC              =      blrts_xlf90
+SCC             =       blrts_xlc
+DMPARALLEL      =       1
+FC              =       $(SFC)
+LD              =       $(FC)
+CC              =       $(SCC)
+
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DNCARIBM_NOC99 $(MPI_INC) -I../external/RSL_LITE -DLANDREAD_STUB
+FCOPTIM         =       -O2 -qarch=440
+FCDEBUG         =       # -qnoopt -qfullpath -qarch=440
+
+FCBASEOPTS      =       -qspill=20000 $(FCDEBUG) -qmaxmem=64000  $(MPI_INC) -w #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_pnetcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc 
+
+ARCHFLAGS       =       -DDM_PARALLEL -DRSL_LITE -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG CONFIGURE_PNETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DLANDREAD_STUB
+
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH \
+                        -L../external/RSL_LITE -lrsl_lite -L/bgl/local/lib -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+			$(TRACE_LIB) $(MPI_LIB)
+
+LDFLAGS         =	-Wl,--allow-multiple-definition -qstatic
+ENVCOMPDEFS	=	
+WRF_CHEM	=	0 
+CPP             =       /opt/ibmcmp/xlf/9.1/exe/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DF90_STANDALONE -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+#### this is a hand installed version of m4 on frost.ucar.edu
+#### a copy is available at http://www.mmm.ucar.edu/wrf/WG2/BG/m4
+M4              =       /home/janicec/m4 -B 12000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+PNETCDFPATH     =       CONFIGURE_PNETCDF_PATH
+CC_TOOLS        =       cc
+WRF_CONVERT = 0
+
+externals : wrf_ioapi_includes ../external/RSL_LITE/librsl_lite.a CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF wrfio_int module_dm.F esmf_time gen_comms.c
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH="$(NETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_pnf :
+	( cd ../external/io_pnetcdf ; make NETCDFPATH=CONFIGURE_PNETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(MPI_INC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CFLAGS="$(CFLAGS)" CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -qfree=f90 -qspillsize=32767 -I. $(PROMOTION) $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_em.o : solve_em.F
+start_em.o : start_em.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_em.o                                              \
+start_em.o                                              \
+shift_domain_em.o                                              \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+# to prevent having to call our service representative
+mediation_feedback_domain.o \
+mediation_force_domain.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -qnoopt $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha          (single-threaded, no nesting)
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS)
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha          (single-threaded, nesting using RSL without MPI )
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-DSTUBS -DSWAPBYTES -O' FC="$(FC) $(PROMOTION)" FFLAGS='-O -convert big_endian' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha SM       (OpenMP, no nesting)
+#
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS)
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha SM-Parallel       (OpenMP, nesting using RSL without MPI )
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-DSTUBS -DSWAPBYTES -O' FC="$(FC) $(PROMOTION)" FFLAGS="-O -convert big_endian $(FCREAL8OMP)" \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH     Compaq OSF1 alpha DM-Parallel       (RSL_LITE, MPICH, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL_LITE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL_LITE
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       #-g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL_LITE -lrsl_lite  \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL_LITE/librsl_lite.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+module_IGWAVE_ADJUST.o : module_IGWAVE_ADJUST.F
+
+nest_init_utils.o module_optional_si_input.o module_IGWAVE_ADJUST.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+solve_em.o : solve_em.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o start_domain_nmm.o solve_em.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel       (RSL, MPICH, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+start_em.o : start_em.F
+start_domain_nmm.o : start_domain_nmm.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o start_em.o start_domain_nmm.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel/SM-Parallel    (RSL, MPICH, OpenMP, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCREAL8OMP)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel/SM-Parallel    (RSL, DECMPI, OpenMP, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl -lmpi \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC=cc FC="$(SFC) $(PROMOTION) $(FCREAL8OMP)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel       (RSL, MPICH, MCEL EXPERIMENTAL)
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90 -f90=cxx
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DMCELIO
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+-L../external/io_mcel -lwrfio_mcel  \
+-L/users/bettenc/MCELSystem/MCEL -lMCEL \
+-L/users/bettenc/lib -lOB -lJTC -lrt -lpthread \
+-lfor -lm -lnetcdf_c++ -lnetcdf -lpthread -lc -L/users/michalak/mpich/lib -lfmpich -lmpichfsup \
+/usr/lib/cmplrs/fortrtl/libUfor.a -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -pthread -ieee -ptr /users/bettenc/ptr -L/users/bettenc/MCELSystem/MCEL -lMCEL -L/users/bettenc/lib -lOB -lJTC -lrt -lpthread -lfor -lm -lnetcdf_c++ -lnetcdf -lpthread -lc CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a wrfio_mcel gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+wrfio_mcel :
+	( cd ../external/io_mcel ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -I../io_netcdf -I../../frame -I../../share \
+          -I/users/bettenc/MCELSystem/MCEL -convert big_endian -automatic -cpp -free" all )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM/SM    (BUILD FOR AUTODOC ONLY -- DO NOT USE TO COMPILE CODE)
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       echo # mpif90
+SFC             =       echo # mpif90
+LD              =       echo # mpif90
+CC              =       echo # mpicc
+SCC		=	echo # cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DAUTODOC_BUILD CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL="'<b>DM_PARALLEL</b>'" -DRSL="'<b>RSL</b>'" \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DMOVE_NESTS
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH     Compaq OSF1 alpha DM-Parallel       (RSL_LITE, MPICH, allows nesting, UNOPT shift_domain)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL_LITE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL_LITE
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       #-g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL_LITE -lrsl_lite  \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL_LITE/librsl_lite.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+module_IGWAVE_ADJUST.o : module_IGWAVE_ADJUST.F
+
+nest_init_utils.o module_optional_si_input.o module_IGWAVE_ADJUST.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+solve_em.o : solve_em.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+shift_domain_em.o : shift_domain_em.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+shift_domain_em.o \
+module_initialize_real.o start_domain.o start_domain_nmm.o solve_em.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Alpha Linux alpha DM  (single-threaded, no nesting)
+#
+FC              =       fort
+SFC		=	$(FC)
+LD              =       fort
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DF2CSTYLE 
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCBASENOINL     =       -convert big_endian -O1 -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. \
+                        -arch host $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o  -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -traditional  $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat  module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASENOINL) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASENOINL) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       Alpha Linux alpha SM  (DOES NOT WORK ON JET! No nesting)
+#
+FC              =       fort
+SFC		=	$(FC)
+LD              =       fort
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DF2CSTYLE 
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCBASENOINL     =       -convert big_endian -O1 -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. \
+                        -arch host $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o  -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -traditional -C -P `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          /bin/cp module_dm_warning module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASENOINL) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASENOINL) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       Alpha Linux alpha DM-Parallel  (RSL, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO -DF2CSTYLE \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) \
+                        -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCBASENOINL     =       -convert big_endian -O1 -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. \
+                        -arch host $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o \
+			-L../external/io_int -lwrfio_int -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -traditional -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ;                   \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASENOINL) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" \
+          MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+          UNDERSCORE=-DF2CSTYLE LEARN_BCAST=-DLEARN_BCAST alpha )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASENOINL) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       VPP UNIX_System_V F300 5000
+#
+FC              =       frt
+SFC		=	$(FC)
+LD              =       frt
+CC              =       vcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCFLAGS         =       -Free -X9 -Am
+FCFLAGS         =       -Free -X9 -Sw -Wv,-Of,-te,-ilfunc,-noalias,-m3,-P255 -Oe,-P -Kfast -Am
+FCDEBUG         =       # -g
+FCBASEOPTS      =       $(FCFLAGS)
+ARCHFLAGS       = CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             = 	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =      -Wl,-P -J CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+LDFLAGS         =      -J CONFIGURE_LDFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2  module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Free -X9" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Free -X9" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Free -X9" archive )
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -Free -X9" archive )
+
+###########################################################
+#ARCH	Cray
+#
+FC		=	f90
+SFC		=	$(FC)
+CC              =       cc
+SCC		=	$(CC)
+NATIVE_RWORDSIZE =      8
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+# does this PROMOTION flag work on Cray?  
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCFLAGS		=	-f free -N 255 -I.
+FCDEBUG         =       # -g
+FCBASEOPTS	=	$(FCFLAGS)
+ARCHFLAGS       =       -DCRAY CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DIWORDSIZE=8 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=8 \
+			-DLIMIT_ARGS
+LDFLAGS		= CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/opt/ctl/bin/cpp
+POUND_DEF	=	-DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+#LIB             =       CONFIGURE_NETCDF_LIB_PATH 
+LIB             = 	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2  esmf_time
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive )
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" archive )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -O 0 $(PROMOTION) $(FCFLAGS) $*.f90
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  (Single-threaded, no nesting)
+#
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+#FCBASEOPTS      =       -w -byteswapio -Mfree -Mipa=fast,inline,safe  $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  (single threaded, allows nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='-byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH   PC Linux i486 i586 i686, PGI compiler  SM-Parallel (OpenMP, no nesting)
+#
+OMP             =       -mp
+OMPCPP          =       -D_OPENMP
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(OMPCPP) -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  SM-Parallel (OpenMP, allows nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =       -mp
+OMPCPP          =       -D_OPENMP
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(OMPCPP) -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='-byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  DM-Parallel (RSL, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=pgf90
+LD              =       mpif90 -f90=pgf90
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH     PC Linux i486 i586 i686, PGI compiler  DM-Parallel (RSL_LITE, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=pgf90
+LD              =       mpif90 -f90=pgf90
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+#FCOPTIM		=	-fastsse 
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+#Options for Debian Sarge systems
+#FCBASEOPTS      =       -w -byteswapio -Mfree -Mipa=fast,inline,safe  $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNMM_NEST=$(WRF_NMM_NEST)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(FCFLAGS) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    Intel Itanium2 ia64 madison Linux DM-Parallel (e.g. mpp2 at PNNL), efc71 compiler (RSL, MPICH, nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL = 1
+MAX_PROC = 2000
+FC = mpif90
+LD = mpif90
+CC = mpicc
+SCC = cc
+SFC = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS = -DDM_PARALLEL -DWRF_RSL_IO -w \
+         -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -size_lp64 \
+         -I/usr/lib/mpi/mpi_intel/include
+FCOPTIM = -O2 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -w -cm 
+FCNOOPTS = -O0 $(FCDEBUG) -FR -I$(INCLUDE) -w -cm 
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64 
+ARCHFLAGS = -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+            -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+            -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_int -I../external/esmf_time_f90 \
+                  -I../external -I../frame -I../share -I../phys -I../chem -I../inc \
+                  -I/usr/lib/mpi/mpi_intel/include
+PERL = perl
+REGISTRY = Registry
+LIB = -L../external/io_netcdf -lwrfio_nf $(OMP) -LCONFIGURE_NETCDF_PATH/lib -lnetcdf \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+      -L../external/RSL/RSL -lrsl ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+      -L../external/esmf_time_f90 -lesmf_time -lmpifarg -lmpi -lelan -lintrins -lPEPCF90 \
+      -limf -lguide -lunwind -lpthread -L/opt/mlib/lib/linux -lveclib8
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =  /lib/cpp -traditional -C -P
+POUND_DEF	=  -DNO_RRTM_PHYSICS \
+                   -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -I$(LIBINCLUDE) $(ARCHFLAGS) $(COREDEFS) $(OMPCPP)  \
+           -I../external/RSL/RSL -C -EP `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC='mpicc -w -I. '\
+	  FC="$(FC) $(PROMOTION) -cm -w " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH      Intel Itanium2 ia64 Linux (eg. Jacaranda), ifort compiler (RSL, no-MPI, allows nesting)
+#
+#          On Jacaranda, setenv NETCDF /jacaranda/users/michalak/netcdf-3.5.1
+#          Built this netcdf by first setenv FC efc and CPPFLAGS '-DNDEBUG -DpgiFortran'
+#          before typing configure and make and make install   20040506. JM
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL = 1
+MAX_PROC = 1
+# for multithreading, uncomment the following
+#OMP =    -openmp
+#OMPCPP = -DOPEN_MP
+FC = ifort
+LD = ifort
+CC = cc
+SCC = $(CC)
+SFC = ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+CFLAGS = -DDM_PARALLEL -DWRF_RSL_IO -cm -w \
+         -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -size_lp64
+FCOPTIM = -O2 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -cm -convert big_endian -mp
+FCNOOPTS = -O0 $(FCDEBUG) -FR -I$(INCLUDE) -w -cm 
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64 
+ARCHFLAGS = -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+            -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+            -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS -DSTUBMPI -DIFORT_KLUDGE
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_int -I../external/esmf_time_f90 \
+                  -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL = perl
+REGISTRY = Registry
+LIB = -L../external/io_netcdf -lwrfio_nf $(OMP) -LCONFIGURE_NETCDF_PATH/lib -lnetcdf \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+      -L../external/RSL/RSL -lrsl ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+      -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS = $(OMP) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =  /lib/cpp -traditional -C -P
+POUND_DEF	=  -DNO_RRTM_PHYSICS \
+                   -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -I$(LIBINCLUDE) $(ARCHFLAGS) $(COREDEFS) $(OMPCPP)  \
+           -I../external/RSL/RSL -C `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS="-DSTUBS -O" \
+	  FC="$(FC) $(PROMOTION)" FCFLAGS="$(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+mediation_interp_domain.o : mediation_interp_domain.F 
+mediation_force_domain.o : mediation_force_domain.F 
+mediation_feedback_domain.o : mediation_feedback_domain.F 
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI compiler 5.2 or higher  (Single-threaded, no nesting)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DLANDREAD_STUB
+FCOPTIM		=	-fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI 5.2 or higher, DM-Parallel  (RSL, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL \
+                        -DLANDREAD_STUB
+FCOPTIM         =       -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI 5.2 or higher DM-Parallel   (RSL_LITE, MPICH, Allows nesting, No periodic LBCs)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE \
+                        -DLANDREAD_STUB
+FCOPTIM         =       -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI compiler 5.2 or higher  (Single-threaded, RSL, Allows nesting)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=	-fastsse # -Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DLANDREADSTUB -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib1 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='-byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#	if [ ! -e $@ ] ; then \
+#	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+
+###########################################################
+#ARCH    Intel Itanium2 ia64 madison Linux  (e.g. mpp2 at PNNL) , efc71 compiler DM-Parallel (RSL_LITE, MPICH, Allows nesting )
+# Notes for running on PNNL cluster:
+# 
+# 1. source /home/oehmen/.mycshrc
+# 2. source /home/mscf/intel7.1/compiler70/ia64/bin/efcvars.csh
+# 
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL = 1
+MAX_PROC   = 2000
+FC         = mpif90
+LD         = mpif90
+CC         = mpicc
+SCC        = gcc
+SFC        = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS     = -DDM_PARALLEL -w -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) \
+             -I../external/RSL_LITE -size_lp64 -I/usr/lib/mpi/mpi_intel/include
+FCOPTIM = -O2 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -cm 
+FCNOOPTS = -O0 $(FCDEBUG) -FR -I$(INCLUDE) -w -cm 
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64 
+ARCHFLAGS = -DDM_PARALLEL \
+            -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+            -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_int -I../external/esmf_time_f90 \
+                  -I../external -I../frame -I../share -I../phys -I../inc  -I../chem \
+                  -I/usr/lib/mpi/mpi_intel/include
+PERL = perl
+REGISTRY = Registry
+LIB = -L../external/io_netcdf -lwrfio_nf $(OMP) -LCONFIGURE_NETCDF_PATH/lib -lnetcdf -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+      ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+      -lmpifarg -lmpi -lelan -lintrins -lPEPCF90 -limf -lguide -lunwind -lpthread -L/opt/mlib/lib/linux -lveclib8
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP        = /lib/cpp -traditional -C -P -traditional
+POUND_DEF  = -DNO_RRTM_PHYSICS -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) \
+             -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS   = -I$(LIBINCLUDE) $(ARCHFLAGS) $(COREDEFS) $(OMPCPP) -I$(INCLUDE) \
+             -I../external/RSL_LITE -C -EP `cat ../inc/dm_comm_cpp_flags` $(POUND_DEF)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='mpicc -w -I.' \
+	  FC="$(FC) $(PROMOTION) $(FCFLAGS) -cm -w " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH titan.ncsa.uiuc.edu specific Intel Itanium2 ia64 mckinley Linux, efc compiler DM-Parallel (RSL, VMI, allows nesting) 
+#
+# Consider 'setenv F_UFMTENDIAN big' in your run scripts for big-endian output
+# Note hard-coded paths to Mark Straka's accounts and ecc6 libs
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL = 1
+#OMP = -openmp
+#OMPCPP = -D_OPENMP
+INCLUDE = ../external/io_netcdf/
+MAX_PROC = 256
+FC = efc -I.. -I/usr/local/vmi/mpich/include
+LD = efc
+CC = ecc -I. -I/usr/local/vmi/mpich/include
+SCC		=	$(CC)
+SFC = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS = -DDM_PARALLEL -DWRF_RSL_IO \
+-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -size_lp64
+FCOPTIM = -O3 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -I. -cm
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64
+ARCHFLAGS = -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+-DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+-DGRIB1 CONFIGURE_GRIB2_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+-I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL = perl
+REGISTRY = Registry
+LIB = -Vaxlib -L../external/io_netcdf -lwrfio_nf $(OMP) -L/u/ncsa/straka/AUGUST.test/WRFV1/netcdfintel7/lib -lnetcdf -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+-L../external/io_int -lwrfio_int \
+../frame/module_internal_header_util.o ../frame/pack_utils.o -L/usr/local/vmi/mpich/lib/ecc6 -lmpich -lfmpich -lvmi -ldl -lpthread -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP = /lib/cpp -C -P -traditional
+POUND_DEF = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -traditional -I$(LIBINCLUDE) -C -P $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) -I$(INCLUDE) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) $(COREDEFS)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time io_grib1
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Vaxlib -I../.. $(FCFLAGS) -w" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="efc -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+#../external/RSL/RSL/librsl.a :
+#	( cd ../external/RSL/RSL ; \
+#          make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+#               LEARN_BCAST=-DLEARN_BCAST o2k )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC='ecc -Vaxlib -I. -cm -w -I/usr/local/vmi/mpich/include '\
+	  FC="$(SFC) $(PROMOTION) -cm -w -Vaxlib -I../../.. " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH titan.ncsa.uiuc.edu specific Intel Itanium2 ia64 mckinley Linux, efc compiler DM-Parallel (RSL_LITE, VMI, allows nesting)
+#
+# Consider 'setenv F_UFMTENDIAN big' in your run scripts for big-endian output
+# Note hard-coded paths to Mark Straka's accounts and ecc6 libs
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL = 1
+INCLUDE = ../external/io_netcdf/
+MAX_PROC = 256
+FC = efc -I.. -I/usr/local/vmi/mpich/include
+LD = efc
+CC = ecc -I. -I/usr/local/vmi/mpich/include
+SCC		=	$(CC)
+SFC = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS = -DDM_PARALLEL -I../external/RSL_LITE \
+-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -size_lp64
+FCOPTIM = -O3 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -I. -cm
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64
+ARCHFLAGS = -DRSL_LITE -DDM_PARALLEL \
+-DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+-DGRIB1 CONFIGURE_GRIB2_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+-I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL = perl
+REGISTRY = Registry
+LIB = -Vaxlib -L../external/io_netcdf -lwrfio_nf $(OMP) -L/u/ncsa/straka/AUGUST.test/WRFV1/netcdfintel7/lib -lnetcdf -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+-L../external/io_int -lwrfio_int \
+../frame/module_internal_header_util.o ../frame/pack_utils.o -L/usr/local/vmi/mpich/lib/ecc6 -lmpich -lfmpich -lvmi -ldl -lpthread -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP = /lib/cpp -C -P -traditional
+POUND_DEF = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -traditional -I$(LIBINCLUDE) -C -P $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) -I$(INCLUDE) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) $(COREDEFS)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Vaxlib -I../.. $(FCFLAGS) -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" RANLIB="$(RANLIB)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" RANLIB="$(RANLIB)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='ecc -Vaxlib -I. -cm -w -I/usr/local/vmi/mpich/include' \
+	FC="$(SFC) $(PROMOTION) $(FCFLAGS) -cm -w -Vaxlib -I../../.. " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler (single-threaded, no nesting)
+#
+OMP             =
+OMPCPP          =
+FC		=	ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC		=	$(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -w -FR -cm -I. -Vaxlib -convert big_endian -mp
+FCOPTIM		=	-O2
+FCFLAGS		=	$(FCOPTIM) $(FCBASEOPTS) $(OMP)
+CFLAGS		=       -w
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =        -DLIMIT_ARGS -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DIFORT_KLUDGE
+LD		=	$(FC)
+LDFLAGS		=	$(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -traditional
+POUND_DEF	=	$(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM \
+                        -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =	CONFIGURE_NETCDF_LIB_PATH ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                        -L../external/esmf_time_f90 -lesmf_time \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -FR -I. -w" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+
+wrf_bdyin.o wrf_bdyout.o  \
+wrf_histin.o wrf_histout.o  \
+wrf_inputin.o wrf_inputout.o  \
+wrf_restartin.o wrf_restartout.o  \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler  (single threaded, allows nesting using RSL without MPI)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =
+OMPCPP          =
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       ifort
+LD              =       ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI -DIFORT_KLUDGE
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS $(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" \
+	  CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+	  CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" CFLAGS="-DSTUBS $(CFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH   AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler (OpenMP)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+#
+OMP             =       -openmp -fpp -auto
+OMPCPP          =       -D_OPENMP
+FC              =       ifort
+LD              =       ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+CFLAGS          =
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DIFORT_KLUDGE
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCFLAGS) $(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	$(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler SM-Parallel (OpenMP, allows nesting using RSL without MPI)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+OMP             =       -openmp -fpp -auto
+OMPCPP          =       -D_OPENMP
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       ifort
+LD              =       ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI -DIFORT_KLUDGE
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time $(OMP)
+LDFLAGS         =       $(FCOPTIM) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS $(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" CFLAGS="-DSTUBS $(CFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort+icc compiler  DM-Parallel (RSL, MPICH, allows nesting)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=ifort
+LD              =       mpif90 -f90=ifort
+CC              =       mpicc -cc=icc
+SCC		=	gcc
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DMPI  \
+			-DLIMIT_ARGS -DIFORT_KLUDGE 
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO $(ARCHFLAGS) \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort+gcc compiler  DM-Parallel (RSL, MPICH, allows nesting)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=ifort
+LD              =       mpif90 -f90=ifort
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DMPI  \
+			-DLIMIT_ARGS -DIFORT_KLUDGE 
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO $(ARCHFLAGS) \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       $(FCOPTIM) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+
+#ARCH NEC SUPER-UX SX-6 (serial)
+
+#***** some sx f90 compiler options***********
+# -V : version # of f90 command to stderr
+#-EP : activate cpp preprocessor to perform conditional compiling: output as i.[filename]
+#-Ep: activate cpp preprocessor to perfomr conditional compiling
+   #****However, cpp also activated by using .F or .F90 suffixes...
+# -Wf: specifies option string of the f90/sx detailed options
+#-g: debug info generated in object file for dbx symbolic debugging
+# -ew : all numbers size=8bytes
+#-eW: 4 bytes
+# -float0: default and only -float(number) option for sx6
+# -USX: unname the prev. defined reserved symbol SX of the preprocessor
+   # -U overrides -D, so '-USX  -D$(RUNTIMESYSTEM)'  might be redundant
+# -p: object file in execution format corresp. to 'prof' command be generated
+# -f4: input source program is described in F90 standard free format
+# -w: only syntax diagnostic messages at the fatal level are output
+# -C: specifies compile mode
+#   ssafe: only safe optimization in scalar mode (minimize side effects of 
+#          opt. no loop unrolling, etc
+# -init : init stack and heap areas
+# -L fmtlist summary stdout: formatted list, transformation lists, summary list are output to stdout
+
+RUNTIME_SYSTEM	=	sx
+MPP_TARGET	=	$(RUNTIME_SYSTEM)
+FC		=	f90
+SFC		=	$(FC)
+CC		=	cc
+SCC		=	$(CC)
+LD		=	$(FC)
+NATIVE_RWORDSIZE =      8
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS	=	-DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DIWORDSIZE=8 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=8 -DLIMIT_ARGS -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+		##for DM compilation	-DDM_PARALLEL -DRSL 
+# note:  -ew already does this for SX6, see comments above
+PROMOTION	=	
+CFLAGS		=	$(ARCHFLAGS)
+#CFLAGS		=	$(ARCHFLAGS) -DMPI -Dvpp -I../external/RSL/RSL
+
+FCFLAGS		=	-w -Ep -C ssafe \
+			-sx6 -USX -ew -D$(RUNTIME_SYSTEM) -I$(LIBINCLUDE) -I../inc -f4 
+		#	-Wf"-init stack=zero heap=zero" 
+		#         -Wf"-L transform fmtlist summary stdout" -g
+FCDEBUG         =       # -g
+FCBASEOPTS	=	$(FCFLAGS) -w
+
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  \
+                        -I../external/esmf_time_f90 -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       -L../external/io_netcdf -lwrfio_nf -L/usr/local/netcdf/current/lib -lnetcdf -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                     #   -L../external/RSL/RSL -lrsl \
+			-L../external/esmf_time_f90 -lesmf_time \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o
+
+#-lmpi for 4byte storage, -lmpiw for 8 byte storage 
+#LDOPTIONS	=	-lmpiw -ew 
+CPP		=	/lib/cpp 
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF) $(ARCHFLAGS)
+#CPPFLAGS = -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL  `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) -DSYSTEM_CALL_OK -DMPI -Dvpp
+
+MAX_PROC = 8
+MAKE = make -i -r
+AWK = awk
+SED = sed
+CAT = cat
+CUT = cut
+EXPAND = expand
+AR = ar ru
+M4 = m4 -B14000
+RANLIB = ar ru     
+NETCDFPATH = /usr/local/netcdf/current
+CC_TOOLS        =       $(CC)
+ARCH_OBJS = milliclock.o
+ASSUME_HOMOGENEOUS_ENVIRONMENT = 1
+FLIC_MACROS = LMvpp.m4 -B 14000
+VECTOR = 1
+
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int  esmf_time  module_dm.F
+	( /sbin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F:
+	( /sbin/cp module_dm_warning module_dm.F ; \
+	  cat module_dm_stubs.F  >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=/usr/local/netcdf/current FC="$(FC) $(PROMOTION) $(FCFLAGS)"  )
+
+
+wrfio_int :
+	( cd ../external/io_int ; \
+	  make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" archive)
+
+esmf_time :
+	( cd ../external/esmf_time_f90 ;\
+ 	make FC="$(FC) $(PROMOTION) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) $(CPPFLAGS) -I../../inc " )
+
+#sx : uses makefile.sx in the directory
+#../external/RSL/RSL/librsl.a :
+#	(cd ../external/RSL/RSL ; \
+#	make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sx )
+#
+#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+   
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL, SGI MPI, Intel MKL, allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#  Change MKL_HOME if Intel's MKL is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_DOMAINS       = 7
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+MKL_HOME          = /usr/lib
+# MKL_HOME          = /sw/sdev/mkl/7.2.008/mkl72/lib/64
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -no-gcc -DDM_PARALLEL -DWRF_RSL_IO \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL  -DDM_PARALLEL -DIWORDSIZE=4 \
+                    -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                    -DLIMIT_ARGS -DIFORT_KLUDGE -DINTELMKL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL/RSL -lrsl \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time \
+                    -L$(MKL_HOME) -lvml -lmkl_ipf
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" \
+          FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make IDIR="-I$(MPI_HOME)/include" \
+	 MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+	 LEARN_BCAST=-DLEARN_BCAST altix )
+
+# compile these without high optimization to speed compile
+module_configure.o : module_configure.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+
+module_configure.o \
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL_LITE, VMI, SGI MPI, Intel MKL, Allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#  Change MKL_HOME if Intel's MKL is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+MKL_HOME          = /usr/lib
+# MKL_HOME          = /sw/sdev/mkl/7.2.008/mkl72/lib/64
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -DDM_PARALLEL -I../external/RSL_LITE \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DRSL_LITE -DDM_PARALLEL \
+                    -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF \
+                    -DINTELMKL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL_LITE -lrsl_lite \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time \
+                    -L$(MKL_HOME) -lvml -lmkl_ipf
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='icc -I. -w -O3 -DMPI2_SUPPORT -I$(MPI_HOME)/include '\
+	 FC='ifort -w -O3 -I../../.. ' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_dm.o : module_dm.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL, SGI MPI, allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_DOMAINS       = 7
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -no-gcc -DDM_PARALLEL -DWRF_RSL_IO \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM           = -O3 -unroll0 
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL  -DDM_PARALLEL -DIWORDSIZE=4 \
+                    -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                    -DLIMIT_ARGS -DIFORT_KLUDGE
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL/RSL -lrsl \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" \
+          FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)"\
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)"\
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)"\
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make IDIR="-I$(MPI_HOME)/include" \
+	 MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+	 LEARN_BCAST=-DLEARN_BCAST altix )
+
+# compile these without high optimization to speed compile
+module_configure.o : module_configure.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+
+module_configure.o \
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL_LITE, VMI, SGI MPI, Allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -DDM_PARALLEL -I../external/RSL_LITE \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DRSL_LITE -DDM_PARALLEL \
+                    -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL_LITE -lrsl_lite \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='icc -I. -w -O3 -DMPI2_SUPPORT -I$(MPI_HOME)/include '\
+	 FC='ifort -w -O3 -I../../.. ' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_wrf.o : module_io_wrf.F
+module_dm.o : module_dm.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort compiler (OpenMP, no nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+# Set up only for idealized experiments
+#
+OMP               = -openmp
+OMPCPP            = -D_OPENMP
+INCLUDE           = ../external/io_netcdf/
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz 
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/io_int -lwrfio_int \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF wrfio_int module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc )
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../io_phdf5 ; \
+#	/bin/cp wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_dm.o : module_dm.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+module_bl_mrf.o: module_bl_mrf.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o module_bl_mrf.o                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort compiler (Single-processor, no nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+INCLUDE           = ../external/io_netcdf/
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz 
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/io_int -lwrfio_int \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip  CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) \
+                    -I$(INCLUDE) -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF wrfio_int module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc )
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../io_phdf5 ; \
+#	/bin/cp wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_dm.o : module_dm.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   UNICOS/mp  machine crayx1 (RSL_LITE, MPI, MSP mode)
+#
+#  Cray X1 (RSL_LITE, MPI, MSP mode)
+#  For CSD mode set numtiles=4 in &domains section
+#  in namelist.input for best MSP efficiency.
+#
+DMPARALLEL      =       1
+MAX_PROC         =       1024
+FC              =       ftn
+SFC		=	$(FC)
+LD              =       ftn
+CC              =       cc
+SCC		=	$(CC)
+
+#### Override default sed command and script for Fortran source files ####
+#### This sed script converts !$OMP directives to !csd$ directives ####
+SED_FTN = sed -f ../arch/cray_csd.sed
+
+## Use these for X1 cross compiler to build Registry
+##X1_CROSS_COMP = "gcc"
+##X1_CROSS_CFLG = ""
+## Use these for X1 native (trigger) compiler
+X1_CROSS_COMP = "cc"
+X1_CROSS_CFLG = "-hcommand"
+CC_TOOLS        = 	$(X1_CROSS_COMP) $(X1_CROSS_CFLG)
+
+RWORDSIZE         = $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -f free -N 255 -I. -x omp -dy
+FCFLAGS_LOWOPT  =       $(FCBASEOPTS) -O1
+FCFLAGS         =       $(FCBASEOPTS) -Ofp3 -O3 -Ogen_private_callee
+#if using 64bit precision
+#PROMOTION	=	-sreal64 -dp -sinteger32
+CFLAGS          =       -I../external/RSL_LITE -DMAXDOM_MAKE=$(MAX_DOMAINS) \
+                        -DMAXPROC_MAKE=$(MAX_PROC) -DDM_PARALLEL -UCRAY -DLANDREAD_STUB -Dcrayx1
+
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../inc \
+			-p./ -p../external/io_netcdf -p../external/io_int -p../frame \
+                        -p../frame -p../share -p../phys -p../chem \
+                        -p../dyn_em -p ../external/esmf_time_f90
+ARCHFLAGS       =       -DRSL_LITE -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -Dcrayx1
+
+PERL            =       perl
+REGISTRY        =       Registry
+
+LIB             =       -L../external/io_netcdf -lwrfio_nf CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o \
+			-L../external/esmf_time_f90 -lesmf_time -lmalloc
+
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+LDFLAGS         =       
+
+CPP		=	cpp -C -P -Dcrayx1
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) # -DNO_NAMELIST_PRINT
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP) -Dcrayx1" FC="$(FC) $(PROMOTION) -f free -N 255 " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) -f free -N 255" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP) -Dcrayx1" FC="$(FC) $(PROMOTION) -f free -N 255" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC) -UCRAY" CPP="$(CPP) -Dcrayx1" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) -f free -N 255" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC) -UCRAY" CPP="$(CPP) CONFIGURE_GRIB2_INC -Dcrayx1" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) -f free -N 255" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) -f free -N 255" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CFLAGS="$(CFLAGS)" CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" \
+                                     MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_em.o : solve_em.F
+solve_interface.o : solve_interface.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+input_wrf.o : input_wrf.F
+output_wrf.o : output_wrf.F
+
+module_io_mm5.o module_si_io.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_interp_domain.o \
+mediation_force_domain.o \
+module_configure.o solve_em.o \
+input_wrf.o output_wrf.o \
+solve_interface.o wrf_restartout.o wrf_restartin.o \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS_LOWOPT) $(MODULE_DIRS)  $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600	32bit   (single-threaded, no nesting)
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600	32bit   (single-threaded, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL	=	1
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DWRF_RSL_IO -DRSL -DINTIO -DLIMIT_ARGS \
+                        -DDM_PARALLEL -DFLOATSAFE -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL/ -lrsl -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC	=	1
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time 
+
+gen_comms.c : ../external/RSL/gen_comms.c
+		( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+		  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS=" -DSTUBS +O3 " FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	Itanium2	(single-threaded, no nesting)
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DSitanium2 -DNOUNDERSCORE
+FCOPTIM         =       +O3 +Odataprefetch +Olibcalls +DO11.23 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DSitanium2 +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	Itanium2	(single-threaded, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DWRF_RSL_IO -DRSL -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DSitanium2 -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +DSitanium2 +Odataprefetch +Olibcalls +DO11.23 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DSitanium2 +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600		32bit   (openmp, no nesting)
+#
+OMP             =      	+Oopenmp 
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600	 DM-Parallel	(RSL, MPICH, nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL	=	1
+MAX_PROC	=	1024
+OMP             =       
+OMPCPP          =       
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4  -DDM_PARALLEL -DRSL \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST hp )
+
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	Itanium2    DM-Parallel	(RSL, MPICH, nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL	=	1
+MAX_PROC	=	1024
+OMP             =       
+OMPCPP          =       
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4  -DDM_PARALLEL -DRSL \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DSitanium2 -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +Odataprefetch +Olibcalls +DO11.23 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DSitanium2 +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST hp )
+
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH Darwin		(single-threaded, no nesting)
+#     
+#     Using -qfloat=nomaf option can result in identical results with
+#           non-optimized and optimized results (suggested by Fovell of UCLA)
+#           One may turn on by uncommenting it in FCOPTIM line
+#
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+#CC              =       cc_r
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       = $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DLANDREAD_STUB -I /usr/include/sys -DMACOS
+FCOPTIM         =       -O3 -qarch=auto #-qfloat=nomaf
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 -w 
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DLANDREAD_STUB -DMAC_KLUDGE
+#			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DMACOS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+#LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv 
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+
+LDFLAGS         =	 -Wl,-stack_size,10000000,-stack_addr,0xc0000000 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+#CPP             =       /opt/ibmcmp/xlf/8.1/exe/cpp -C -P
+CPP             =       /usr/bin/cpp  -C -P -xassembler-with-cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF) 
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -qfree=f90 -qspillsize=32767 -I. $(PROMOTION) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+solve_em.o : solve_em.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+shift_domain_em.o                                              \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_em.o \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+###########################################################
+#ARCH Darwin		(OpenMP, no nesting)
+#     
+#     Using -qfloat=nomaf option can result in identical results with
+#           non-optimized and optimized results (suggested by Fovell of UCLA)
+#           One may turn on by uncommenting it in FCOPTIM line
+#
+OMP             =       -qsmp=noauto
+OMPCPP          =       -D_OPENMP
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       = $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DLANDREAD_STUB -I /usr/include/sys -DMACOS
+FCOPTIM         =       -O2 -qarch=auto -qunroll=yes #-qfloat=nomaf
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DLANDREAD_STUB -DMACOS -DMAC_KLUDGE
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -lxlsmp \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) -Wl,-stack_size,10000000,-stack_addr,0xc0000000  CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /usr/bin/cpp -C -P -xassembler-with-cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+
+module_configure.o : module_configure.F
+module_domain.o   : module_domain.F
+module_sm.o 	: module_sm.F
+module_tiles.o	: module_tiles.F
+solve_em.o	: solve_em.F
+solve_exp.o	: solve_exp.F
+convert_nmm.o   : convert_nmm.F
+
+module_configure.o module_sm.o module_tiles.o solve_em.o solve_exp.o convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(OMP) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt -qnohot $*.f90
+
+module_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F90 > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt -qnohot $*.f90
+
+###########################################################
+#ARCH Darwin		(single-threaded, no nesting, USES: gcc-3.3, xlf cpp, SystemStubs)
+#     
+#     Using -qfloat=nomaf option can result in identical results with
+#           non-optimized and optimized results (suggested by Fovell of UCLA)
+#           One may turn on by uncommenting it in FCOPTIM line
+#
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+#CC              =       cc_r
+CC              =       gcc-3.3
+SCC		=	$(CC)
+RWORDSIZE       = $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DLANDREAD_STUB -I /usr/include/sys -DMACOS
+FCOPTIM         =       -O3 -qarch=auto #-qfloat=nomaf
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 -w 
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DLANDREAD_STUB -DMAC_KLUDGE
+#			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DMACOS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+#LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv 
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+
+LDFLAGS         =	 -Wl,-stack_size,10000000,-stack_addr,0xc0000000 CONFIGURE_LDFLAGS -L/usr/lib -lSystemStubs
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /opt/ibmcmp/xlf/8.1/exe/cpp -C -P
+#CPP             =       /usr/bin/cpp  -C -P -xassembler-with-cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF) 
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -qfree=f90 -qspillsize=32767 -I. $(PROMOTION) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+solve_em.o : solve_em.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+shift_domain_em.o                                              \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_em.o \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PathScale 2.1 or higher (Single-threaded, no nesting)
+#
+FC              =       pathf90
+LD              =       pathf90
+CC              =       pathcc
+SCC             =       $(CC)
+NATIVE_RWORDSIZE=       4
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION       =       -r$(RWORDSIZE) -i4
+CFLAGS          =       
+FCOPTIM         =       -O3 -OPT:Ofast:Olimit=5000
+FCDEBUG         =       #-g
+FCBASEOPTS      =       -w -byteswapio -freeform -fno-second-underscore $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+                        -DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       $(FCFLAGS) -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS     =       CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF       =       $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+                                                                                
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+                                                                                
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w -fno-second-underscore" TRADFLAG="-traditional" )
+                                                                                
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" archive )
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+	make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+	make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_int :
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+	TRADFLAG="-traditional" all )
+                                                                                
+esmf_time :
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+                                                                                
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_configure.o : module_configure.F
+                                                                                
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_fddaobs_rtfdda.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PathScale 2.1 or higher DM-Parallel   (RSL_LITE, PathScale MPICH, No periodic LBCs)
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=pathf90
+LD              =       mpif90 -f90=pathf90
+CC              =       mpicc  -cc=pathcc
+SCC             =       pathcc
+SFC             =       pathf90
+NATIVE_RWORDSIZE=	4
+RWORDSIZE	=	$(NATIVE_RWORDSIZE)
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM         =       -O3 -OPT:Ofast:Olimit=5000
+FCDEBUG         =       #-g
+FCBASEOPTS      =       -w -byteswapio -freeform -fno-second-underscore $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+EXTRAMODULES    =
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        -L../external/io_int -lwrfio_int \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       -byteswapio
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF       =       -DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       pathcc
+                                                                                
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+                                                                                
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+                                                                                
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+                                                                                
+#io_flags:
+#	( cd ../external/io_netcdf ; make flags_only ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../io_phdf5 )
+                                                                                
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC)" TRADFLAG="-traditional" \
+	FFLAGS='$(FCFLAGS) -I../../inc -ICONFIGURE_NETCDF_PATH/include -w -fno-second-underscore' RANLIB=$(RANLIB) )
+                                                                                
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" TRADFLAG="-traditional" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" archive )
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+	make CC="$(CC)" CPP="$(CPP)" FC="$(SFC) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" RANLIB=$(RANLIB) archive )
+                                                                                
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+	make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" FC="$(SFC) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" RM="$(RM)" RANLIB=$(RANLIB) archive )
+                                                                                
+wrfio_int : 
+	( cd ../external/io_int ; \
+	make CC="$(CC)" CPP="$(CPP)" FC="$(SFC) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" RANLIB=$(RANLIB) all )
+                                                                                
+esmf_time :
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(FCDEBUG) $(FCBASEOPTS) " CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+                                                                                
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC='mpif90 $(FCFLAGS) -byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+                                                                                
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_configure.o : module_configure.F
+                                                                                
+solve_interface.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_fddaobs_rtfdda.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    Cray XT3 Catamount/Linux x86_64 (Opteron), PGI 5.2 or higher DM-Parallel (RSL_LITE, MPICH, Allows nesting, Periodic in X only )
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       ftn
+LD              =       ftn
+CC              =       gcc -DMPI2_SUPPORT
+SCC		=	gcc
+SFC             =       mpif90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE \
+                        -DLANDREAD_STUB -DXT3_Catamount -I$(MPICH_DIR)/include
+FCOPTIM         =       -O3 -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB -DNO_NAMELIST_PRINT -DXT3_Catamount
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                        -L../external/esmf_time_f90 -lesmf_time 
+# add this to LIB to use XT3 iobuf library after loading iobuf module, also requires
+# properly built netCDF library that includes iobuf
+#                       $(IOBUF_POST_LINK_OPTS)
+LDFLAGS         =       -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC) $(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+solve_em.o : solve_em.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+solve_em.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    NEC SX-8, NEC SX cross compiler DM-Parallel (RSL, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       sxmpif90
+LD              =       sxmpif90
+CC              =       sxmpic++
+SCC		=	sxmpic++
+SFC             =       sxmpif90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	
+CFLAGS          =       -DNCARIBM_NOC99 -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM		=	
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -f4 -Wf,-P i $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time -L$(SX_BASE_CPLUS)/lib -lcpp
+LDFLAGS         =       $(FCFLAGS) -Wl,-h nodefs CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) -DNEC
+AR_BASE         =       sxar
+AR              =       $(AR_BASE) ru
+M4              =       m4 -B 14000
+RANLIB          =       sxar rs
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib1 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" AR="$(AR_BASE)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sx )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#	if [ ! -e $@ ] ; then \
+#	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+
+###########################################################
+#ARCH    NEC SX-8, NEC SX cross compiler DM-Parallel (RSL_LITE, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       sxmpif90
+LD              =       sxmpif90
+CC              =       sxmpic++
+SCC		=	sxmpic++
+SFC             =       sxmpif90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	
+CFLAGS          =       -DNCARIBM_NOC99 -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM		=	
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -f4 -Wf,-P i $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time -L$(SX_BASE_CPLUS)/lib -lcpp
+LDFLAGS         =       $(FCFLAGS) -Wl,-h nodefs CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) -DNEC
+AR_BASE         =       sxar
+AR              =       $(AR_BASE) ru
+M4              =       m4 -B 14000
+RANLIB          =       sxar rs
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib1 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" AR="$(AR_BASE)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST AR="$(AR_BASE)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#	if [ ! -e $@ ] ; then \
+#	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+
+
+###########################################################
+#ARCH    CYGWIN_NT-5.1 Cygwin i486 i586 i686, g95 compiler  (Single-threaded, no nesting)
+#
+FC              =       g95
+LD              =       g95
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+# g95 does not like -r8. if you want -r8, just add it to PROMOTION below
+#PROMOTION	=	-r$(RWORDSIZE) -i4
+PROMOTION	=	-i4
+CFLAGS          =
+FCOPTIM		=	-O2
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -Wno=101,139,155,158 -fno-second-underscore -fendian=big -ffree-form $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DG95
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -fmod=../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, g95 compiler  (Single-threaded, no nesting)
+#
+FC              =       g95
+LD              =       g95
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+# g95 does not like -r4. if you want promotion to -r8 add it to PROMOTION below
+#PROMOTION	=	-r$(RWORDSIZE) -i4
+PROMOTION	=	-i4
+CFLAGS          =       
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g -O0
+FCBASEOPTS      =       -Wno=101,139,155,158 -fno-second-underscore -fendian=big -ffree-form -ffree-line-length-huge $(FCDEBUG) # -DF2CSTYLE # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DG95 #-DF2CSTYLE -DNONSTANDARD_SYSTEM_SUBR
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -fmod=../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH     PC Linux i486 i586 i686, g95 compiler  DM-Parallel (RSL_LITE, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=g95
+LD              =       mpif90 -f90=g95
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       g95
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+# g95 does not like -r4. if you want promotion to -r8 add it to PROMOTION below
+#PROMOTION      =       -r$(RWORDSIZE) -i4
+PROMOTION       =       -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g -O0
+FCBASEOPTS      =       -Wno=101,139,155,158 -fno-second-underscore -fendian=big -ffree-form $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNMM_NEST=$(WRF_NMM_NEST) -DG95
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -fmod=../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(FCFLAGS) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+##################################################################
+#ARCH  NULL
Index: trunk/WRF.COMMON/WRFV2/arch/cray_csd.sed
===================================================================
--- trunk/WRF.COMMON/WRFV2/arch/cray_csd.sed	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/arch/cray_csd.sed	(revision 2744)
@@ -0,0 +1,12 @@
+#### This sed script converts !$OMP directives to Cray !csd$ directives ####
+#
+# get rid of single quotes after comments
+# WARNING:  This will break if a quoted string is followed by a comment that has 
+#           a single quote.  
+/\!.*'/s/'//g
+# Automatically add cpp __LINE__ and __FILE__ to calls to wrf_error_fatal().  
+s/[Cc][Aa][Ll][Ll] *[Ww][Rr][Ff]_[Ee][Rr][Rr][Oo][Rr]_[Ff][Aa][Tt][Aa][Ll] *(/CALL wrf_error_fatal3 ( __FILE__ , __LINE__ , /
+# convert !$OMP directives to Cray !csd$ directives
+/\!\$[Oo][Mm][Pp]/s/\!\$[Oo][Mm][Pp]/\!csd\$/
+/\!csd\$.*[Pp][Rr][Ii][Vv][Aa][Tt][Ee]/a\
+!csd$& schedule(static,1)
Index: trunk/WRF.COMMON/WRFV2/arch/no_file_line.sed
===================================================================
--- trunk/WRF.COMMON/WRFV2/arch/no_file_line.sed	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/arch/no_file_line.sed	(revision 2744)
@@ -0,0 +1,10 @@
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### Use this when the Fortran compiler complains about long source lines,    ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+#
+# get rid of single quotes after comments
+# WARNING:  This will break if a quoted string is followed by a comment that has 
+#           a single quote.  
+/\!.*'/s/'//g
+# DO NOT Automatically add cpp __LINE__ and __FILE__ to calls to wrf_error_fatal().  
+# s/[Cc][Aa][Ll][Ll] *[Ww][Rr][Ff]_[Ee][Rr][Rr][Oo][Rr]_[Ff][Aa][Tt][Aa][Ll] *(/& __FILE__ , __LINE__ , /
Index: trunk/WRF.COMMON/WRFV2/arch/postamble
===================================================================
--- trunk/WRF.COMMON/WRFV2/arch/postamble	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/arch/postamble	(revision 2744)
@@ -0,0 +1,59 @@
+
+# These sub-directory builds are identical across all architectures
+wrfio_esmf :
+	( cd ../external/io_esmf ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " )
+
+
+#
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+#	There is probably no reason to modify these rules
+
+wrf_ioapi_includes :
+	( cd ../external/ioapi_share ; \
+	$(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" )
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.c.o:
+	$(RM) $@
+	$(CC) -c $(CFLAGS) $*.c
+
Index: trunk/WRF.COMMON/WRFV2/arch/preamble
===================================================================
--- trunk/WRF.COMMON/WRFV2/arch/preamble	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/arch/preamble	(revision 2744)
@@ -0,0 +1,79 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	16384
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+SED_FTN = sed -f ../arch/standard.sed
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = ESMFCOUPLING
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = ESMFMODDEPENDENCE
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        = ESMFMODINC
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = ESMFIOINC
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = ESMFIODEFS
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = ESMFTARGET
+
+##############################################################################
+
+
+#### Architecture specific settings ####
+
Index: trunk/WRF.COMMON/WRFV2/arch/standard.sed
===================================================================
--- trunk/WRF.COMMON/WRFV2/arch/standard.sed	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/arch/standard.sed	(revision 2744)
@@ -0,0 +1,8 @@
+#### Standard sed script ####
+#
+# get rid of single quotes after comments
+# WARNING:  This will break if a quoted string is followed by a comment that has 
+#           a single quote.  
+/\!.*'/s/'//g
+# Automatically add cpp __LINE__ and __FILE__ to calls to wrf_error_fatal().  
+s/[Cc][Aa][Ll][Ll] *[Ww][Rr][Ff]_[Ee][Rr][Rr][Oo][Rr]_[Ff][Aa][Tt][Aa][Ll] *(/CALL wrf_error_fatal3 ( __FILE__ , __LINE__ , /
Index: trunk/WRF.COMMON/WRFV2/call_meso_inifis1.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_inifis1.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_inifis1.inc	(revision 2744)
@@ -0,0 +1,30 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+       CALL inifis(ngrid,nlayer,         &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                &
+               wappel_phys,                     &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
Index: trunk/WRF.COMMON/WRFV2/call_meso_inifis2.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_inifis2.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_inifis2.inc	(revision 2744)
@@ -0,0 +1,67 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+SELECT CASE (id)
+
+       CASE(1)
+       CALL inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                &
+               wappel_phys,                     &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+
+       CASE(2)
+       CALL d2_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+!
+!       CASE(3:)
+!       print *, '** Mars ** Not supported ...'
+!       stop
+!
+END SELECT
Index: trunk/WRF.COMMON/WRFV2/call_meso_inifis3.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_inifis3.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_inifis3.inc	(revision 2744)
@@ -0,0 +1,93 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+SELECT CASE (id)
+
+       CASE(1)
+       CALL inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                &
+               wappel_phys,                     &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+       CASE(2)
+       CALL d2_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+       CASE(3)
+       CALL d3_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+
+!
+!       CASE(3:)
+!       print *, '** Mars ** Not supported ...'
+!       stop
+!
+END SELECT
Index: trunk/WRF.COMMON/WRFV2/call_meso_inifis4.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_inifis4.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_inifis4.inc	(revision 2744)
@@ -0,0 +1,120 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+SELECT CASE (id)
+
+       CASE(1)
+       CALL inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                &
+               wappel_phys,                     &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+       CASE(2)
+       CALL d2_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+       CASE(3)
+       CALL d3_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+       CASE(4)
+       CALL d4_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+
+
+!
+!       CASE(3:)
+!       print *, '** Mars ** Not supported ...'
+!       stop
+!
+END SELECT
Index: trunk/WRF.COMMON/WRFV2/call_meso_inifis5.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_inifis5.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_inifis5.inc	(revision 2744)
@@ -0,0 +1,146 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+SELECT CASE (id)
+
+       CASE(1)
+       CALL inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                &
+               wappel_phys,                     &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+       CASE(2)
+       CALL d2_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+       CASE(3)
+       CALL d3_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+       CASE(4)
+       CALL d4_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+       CASE(5)
+       CALL d5_inifis(ngrid,nlayer, &
+#ifdef NEWPHYS
+               nq,  &
+#endif
+               wday_ini,wdaysec,                   &
+               wappel_phys,                        &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+#ifdef NEWPHYS
+               dt,                                                     &
+#else
+               nq,dt,                                                &
+#endif
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+#ifdef NEWPHYS
+               walbedodat, wphisfi, wvolcapa, wz0tab,                  &
+#else
+               walbedodat, winertiedat, wphisfi,                       &
+#endif
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta, wpsi)
+
+
+
+!
+!       CASE(3:)
+!       print *, '** Mars ** Not supported ...'
+!       stop
+!
+END SELECT
Index: trunk/WRF.COMMON/WRFV2/call_meso_physiq1.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_physiq1.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_physiq1.inc	(revision 2744)
@@ -0,0 +1,22 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+       CALL physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+	       output_tab2d, output_tab3d,    &
+               flag_LES)
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/call_meso_physiq2.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_physiq2.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_physiq2.inc	(revision 2744)
@@ -0,0 +1,43 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+SELECT CASE (id)
+
+       CASE(1)
+       CALL physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(2)
+       CALL d2_physiq (ngrid,nlayer,nq,                           &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+!       CASE(3:)
+!       print *, '** Mars ** Not supported ...'
+!       stop
+!
+END SELECT
+
+
Index: trunk/WRF.COMMON/WRFV2/call_meso_physiq3.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_physiq3.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_physiq3.inc	(revision 2744)
@@ -0,0 +1,57 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+SELECT CASE (id)
+
+       CASE(1)
+       CALL physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(2)
+       CALL d2_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(3)
+       CALL d3_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+!       CASE(3:)
+!       print *, '** Mars ** Not supported ...'
+!       stop
+!
+END SELECT
+
+
Index: trunk/WRF.COMMON/WRFV2/call_meso_physiq4.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_physiq4.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_physiq4.inc	(revision 2744)
@@ -0,0 +1,71 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+SELECT CASE (id)
+
+       CASE(1)
+       CALL physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(2)
+       CALL d2_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(3)
+       CALL d3_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(4)
+       CALL d4_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+!       CASE(3:)
+!       print *, '** Mars ** Not supported ...'
+!       stop
+!
+END SELECT
+
+
Index: trunk/WRF.COMMON/WRFV2/call_meso_physiq5.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/call_meso_physiq5.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/call_meso_physiq5.inc	(revision 2744)
@@ -0,0 +1,86 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+SELECT CASE (id)
+
+       CASE(1)
+       CALL physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(2)
+       CALL d2_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(3)
+       CALL d3_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(4)
+       CALL d4_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+       CASE(5)
+       CALL d5_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,pday,ptime,ptimestep,                &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+#ifdef NEWPHYS
+               wtnom, wisoil, wdsoil, &
+               wfluxrad,wwstar,               &
+#endif
+               wday_ini,                      &
+               output_tab2d, output_tab3d,    &
+               flag_LES)
+
+
+!       CASE(3:)
+!       print *, '** Mars ** Not supported ...'
+!       stop
+!
+END SELECT
+
+
Index: trunk/WRF.COMMON/WRFV2/clean
===================================================================
--- trunk/WRF.COMMON/WRFV2/clean	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/clean	(revision 2744)
@@ -0,0 +1,48 @@
+#!/bin/csh -f
+
+set nonomatch
+
+
+foreach dir ( frame chem share dyn_em dyn_exp dyn_nmm phys main tools )
+( cd $dir ; echo $dir ; /bin/rm -f core wrf *.f90 *.exe *.kmo *.mod *.o *.inc *.F90 *.a \
+                      db_* Warnings module_state_description.F module_dm.F gmeta \
+                      wrfdata whatiread rsl.* show_domain* )
+end
+
+
+( cd tools/CodeBase ; make clean )
+
+( cd inc ; /bin/rm -f *.inc namelist.default )
+
+
+if ( "$1" == '-a' ) then
+  if ( -f configure.wrf ) then
+    /bin/cp configure.wrf configure.wrf.backup
+    /bin/rm -f configure.wrf
+  endif
+  if ( -f Registry/Registry ) then
+    /bin/cp Registry/Registry Registry/Registry.backup
+    /bin/rm -f Registry/Registry
+  endif
+  /bin/rm -fr ./netcdf_links
+  /bin/rm -fr tools/code_dbase
+  ( cd external ; make -i superclean )
+  ( cd external/io_grib1/WGRIB ; make clean )
+  ( cd tools ; /bin/rm -f registry gen_comms.c fseeko_test fseeko64_test )
+  ( cd inc; /bin/rm -f dm_comm_cpp_flags wrf_io_flags.h wrf_status_codes.h )
+  ( cd run ; /bin/rm -f gm* out* fort* ideal* *.exe ; \
+	/bin/cp -f namelist.input namelist.input.backup ; \
+	/bin/rm -f namelist.input ) >& /dev/null
+  ( cd test/exp_real ; /bin/rm -f gm* out* fort* real* )
+  ( cd test ; rm -f */*.exe */ETAMPNEW_DATA */GENPARM.TBL */LANDUSE.TBL */README.namelist \
+	*/RRTM_DATA */SOILPARM.TBL */VEGPARM.TBL */urban_param.tbl */grib2map.tbl \
+	*/CAM_ABS_DATA */CAM_AEROPT_DATA \
+	*/ozone.formatted */ozone_lat.formatted */ozone_plev.formatted \
+	*/gribmap.txt */tr??t?? ) >& /dev/null
+endif
+
+#cms++
+if ( -e chem/KPP )then
+  ( cd chem/KPP; ./clean_kpp ) 
+endif
+#cms--
Index: trunk/WRF.COMMON/WRFV2/compile
===================================================================
--- trunk/WRF.COMMON/WRFV2/compile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/compile	(revision 2744)
@@ -0,0 +1,261 @@
+#!/bin/csh -f
+
+cont1:
+
+if ( !  -e configure.wrf  ) then
+   ./configure $1
+   set dontask
+endif
+
+
+#----------------------------------
+if ( ! $?WRF_KPP )   setenv WRF_KPP  0
+if ( $WRF_KPP == 1 ) then
+chem/KPP/compile_wkc
+endif
+
+
+
+
+#---------------------------------
+
+if ( ! $?dontask && $?prompt ) then
+  echo "This script assumes you have configured the code already."
+  echo "You only need to configure once."
+  echo "If you wish to reconfigure, type c at the prompt below"
+  echo " "
+  echo "Ready to compile? [ync]"
+  set resp=$<
+
+  if ( "$resp" == "c" ) then
+    ./configure
+    goto cont1
+  endif
+
+  if ( "$resp" == "n" ) then
+    exit 2
+  endif
+endif
+
+set arglist=""
+foreach a ( $argv )
+  if ( "$a" == "-h" ) then
+    goto hlp
+  else
+    if ( "$a" != "-d" ) then
+      set arglist = ( $arglist $a )
+    endif
+  endif
+end
+
+if ( $arglist == "" ) then
+  goto hlp
+else
+  unsetenv A2DCASE
+  setenv A2DCASE `echo $arglist | grep 2d`
+
+  if ( ! (   $?WRF_EM_CORE  || $?WRF_NMM_CORE \
+          ||  $?WRF_COAMPS_CORE || $?WRF_EXP_CORE )) then 
+    echo 'None of WRF_EM_CORE, WRF_NMM_CORE, '
+#    echo '        WRF_COAMPS_CORE, or WRF_EXP_CORE '
+    echo '        specified in shell environment.... '
+    setenv WRF_EM_CORE 1
+    setenv WRF_NMM_CORE 0
+    setenv WRF_COAMPS_CORE 0
+    setenv WRF_EXP_CORE 0
+  endif
+
+# these settings get passed down through the environment in the
+# calls to Make
+  if ( ! $?WRF_EM_CORE )     setenv WRF_EM_CORE 0
+  if ( ! $?WRF_NMM_CORE )    setenv WRF_NMM_CORE 0
+  if ( ! $?WRF_NMM_NEST )    setenv WRF_NMM_NEST 0
+  if ( ! $?WRF_COAMPS_CORE ) setenv WRF_COAMPS_CORE 0
+  if ( ! $?WRF_EXP_CORE )    setenv WRF_EXP_CORE 0
+  if ( ! $?WRF_CHEM )        setenv WRF_CHEM 0
+  if ( ! $?WRF_CONVERT ) then
+     if ( "$arglist" == "convert_em" ) then
+       setenv WRF_CONVERT 1
+       setenv WRF_EM_CORE 0
+     else
+       setenv WRF_CONVERT 0
+     endif
+  endif
+
+  set overwrite=0
+  if ($WRF_NMM_CORE == 1 && $WRF_CHEM == 1 ) then
+    echo "Chemistry not yet supported in NMM core, set WRF_CHEM to 0 "
+    grep -q DM_PARALLEL configure.wrf
+    if ( $status == 1 ) then
+      echo NMM_CORE must be configured for DM parallel
+      echo Please rerun the configure script and chose a DM parallel option
+      exit 3
+    endif
+    if ( ! -f Registry/Registry ) then
+      echo Registry file does not exist
+      set overwrite=1
+    else
+      head -2 Registry/Registry | tail -1 | grep NMM_CHEM > /dev/null
+      if ( $status ) then
+        set overwrite=1
+      else 
+        set nmm_time=`ls -1tr Registry | cat -n | grep -w 'Registry\.NMM_CHEM' | grep -v 'Registry.NMM_CHEM.' | awk '{print $1}'`
+        set rg_time=`ls -1tr Registry | cat -n | grep -w 'Registry' | grep -v 'Registry.' | awk '{print $1}'`
+        if ( $nmm_time > $rg_time ) set overwrite=1
+      endif
+    endif
+    if ( $overwrite ) then
+      echo copying Registry/Registry.NMM_CHEM to Registry/Registry
+      echo '## WARNING: this file is autogenerated from Registry/Registry.NMM_CHEM. Changes may be lost' > Registry/Registry
+      /bin/cat Registry/Registry.NMM_CHEM >> Registry/Registry
+    endif
+#   exit 2
+  endif
+
+
+  if ($WRF_EM_CORE == 1 && $WRF_NMM_CORE == 1 ) then
+    echo "Cannot compile both EM and NMM cores in same executable yet."
+    exit 2
+  endif
+  if ($WRF_EM_CORE == 0 && $WRF_NMM_CORE == 0 && ! $WRF_CONVERT == 1 ) then
+    echo "Cannot compile because both EM and NMM cores are set to 0."
+    exit 2
+  endif
+  if (($WRF_EM_CORE == 1)&&($WRF_CHEM == 0 )&&($WRF_CONVERT == 0))  then
+    if ( ! -f Registry/Registry ) then
+      set overwrite=1
+    else
+      head -2 Registry/Registry | tail -1 | grep EM > /dev/null
+      if ( $status ) then
+        set overwrite=1
+      else
+        set em_time=`ls -1tr Registry | cat -n | grep -w 'Registry\.EM' | grep -v 'Registry.EM.' | awk '{print $1}'`
+        set rg_time=`ls -1tr Registry | cat -n | grep -w 'Registry' | grep -v 'Registry.' | awk '{print $1}'`
+        if ( $em_time > $rg_time ) set overwrite=1
+      endif
+    endif
+    if ( $overwrite ) then
+      echo copying Registry/Registry.EM to Registry/Registry
+      echo '## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost' > Registry/Registry
+      /bin/cat Registry/Registry.EM >> Registry/Registry
+    endif
+  else if (($WRF_EM_CORE == 1)&&($WRF_CHEM == 1 ))  then
+    if ( ! -f Registry/Registry ) then
+      set overwrite=1
+    else
+      head -2 Registry/Registry | tail -1 | grep EM_CHEM > /dev/null
+      if ( $status ) then
+        set overwrite=1
+      else
+        set em_time=`ls -1tr Registry | cat -n | grep -w 'Registry\.EM_CHEM' | grep -v 'Registry.EM_CHEM.' | awk '{print $1}'`
+        set rg_time=`ls -1tr Registry | cat -n | grep -w 'Registry' | grep -v 'Registry.' | awk '{print $1}'`
+        if ( $em_time > $rg_time ) set overwrite=1
+      endif
+    endif
+    if ( $overwrite ) then
+      echo copying Registry/Registry.EM_CHEM to Registry/Registry
+      echo '## WARNING: this file is autogenerated from Registry/Registry.EM_CHEM. Changes may be lost' > Registry/Registry
+      /bin/cat Registry/Registry.EM_CHEM >> Registry/Registry
+    endif
+  else if (($WRF_EM_CORE == 0)&&($WRF_CONVERT == 1 ))  then
+    if ( ! -f Registry/Registry ) then
+      set overwrite=1
+    else
+      head -2 Registry/Registry | tail -1 | grep EM_CONVERT > /dev/null
+      if ( $status ) then
+        set overwrite=1
+      else
+        set em_time=`ls -1tr Registry | cat -n | grep -w 'Registry\.EM_CONVERT' | grep -v 'Registry.EM_CONVERT.' | awk '{print $1}'`
+        set rg_time=`ls -1tr Registry | cat -n | grep -w 'Registry' | grep -v 'Registry.' | awk '{print $1}'`
+        if ( $em_time > $rg_time ) set overwrite=1
+      endif
+    endif
+    if ( $overwrite ) then
+      echo copying Registry/Registry.CONVERT to Registry/Registry
+      echo '## WARNING: this file is autogenerated from Registry/Registry.CONVERT. Changes may be lost' > Registry/Registry
+      /bin/cat Registry/Registry.CONVERT >> Registry/Registry
+    endif
+
+
+  endif
+  if (($WRF_NMM_CORE == 1)&&($WRF_CHEM == 0 )) then
+    grep -q DM_PARALLEL configure.wrf
+    if ( $status == 1 ) then
+      echo NMM_CORE must be configured for DM parallel
+      echo Please rerun the configure script and chose a DM parallel option
+      exit 3
+    endif
+    if ( ! -f Registry/Registry ) then
+      set overwrite=1
+    else
+      head -2 Registry/Registry | tail -1 | grep NMM > /dev/null
+      if ( $status ) then
+        set overwrite=1
+      else
+        set nmm_time=`ls -1tr Registry | cat -n | grep -w 'Registry\.NMM' | grep -v 'Registry.NMM.' | awk '{print $1}'`
+        set rg_time=`ls -1tr Registry | cat -n | grep -w 'Registry' | grep -v 'Registry.' | awk '{print $1}'`
+        if ( $nmm_time > $rg_time ) set overwrite=1
+      endif
+    endif
+    if ( $overwrite ) then
+      if (($WRF_NMM_CORE == 1)&&($WRF_NMM_NEST == 1)) then
+        echo copying Registry/Registry.NMM_NEST to Registry/Registry
+        echo '## WARNING: this file is autogenerated from Registry/Registry.NMM_NEST. Changes may be lost' > Registry/Registry
+        /bin/cat Registry/Registry.NMM_NEST >> Registry/Registry
+      else
+        echo copying Registry/Registry.NMM to Registry/Registry
+        echo '## WARNING: this file is autogenerated from Registry/Registry.NMM. Changes may be lost' > Registry/Registry
+        /bin/cat Registry/Registry.NMM >> Registry/Registry
+      endif
+    endif
+# integrity check for a kludge where a hard coded value in the 
+# registry must match the same value in arch/preamble
+    set registryvalue=`grep 'dimspec.* q ' Registry/Registry.NMM | sed -e 's/..*constant=//' -e 's/ ..*$//'`
+    set preamblevalue=`grep 'DNMM_MAX_DIM=.*' arch/preamble | sed -e 's/..*-DNMM_MAX_DIM=//' -e 's/ ..*$//'`
+    if ( $registryvalue != $preamblevalue ) then
+      echo "Harded coded value of dimspec q in Registry ($registryvalue) does not"
+      echo "equal the hard coded value of NMM_MAX_DIM in arch/preamble ($preamblevalue)"
+      echo "Please fix and try again."
+      exit 2
+    endif
+  endif
+
+  echo " "
+  echo -n "**** Compiling: "
+  if ( $WRF_EM_CORE ) echo -n "WRF_EM_CORE "
+  if ( $WRF_NMM_CORE ) echo -n "WRF_NMM_CORE "
+  if ( $WRF_COAMPS_CORE ) echo -n "WRF_COAMPS_CORE "
+  if ( $WRF_EXP_CORE ) echo -n "WRF_EXP_CORE "
+  echo "."
+  echo " "
+
+  # This incredible hackery due to OSF1 $(PWD) not changing during 
+  # build via regtest.csh ...  
+  # Note that $WRF_SRC_ROOT_DIR is only used by the OSF1 build.  
+  if ( $?WRF_SRC_ROOT_DIR ) then
+    make $arglist A2DCASE="$A2DCASE" WRF_SRC_ROOT_DIR="$WRF_SRC_ROOT_DIR"
+  else
+    make $arglist A2DCASE="$A2DCASE" WRF_SRC_ROOT_DIR="$PWD"
+  endif
+
+endif
+
+exit 0
+
+hlp:
+
+echo ' '
+echo 'Usage:'
+echo ' '
+echo '   compile wrf           compile wrf in run dir (NOTE: no real.exe, ndown.exe, or ideal.exe generated)'
+echo ' '
+echo '   or choose a test case (see README_test_cases for details) :'
+foreach d ( `/bin/ls test` )
+  if ( "$d" != "CVS" ) then
+    echo "      compile $d"
+  endif
+end
+echo ' '
+echo '  compile -h                 help message'
+
+
Index: trunk/WRF.COMMON/WRFV2/configure
===================================================================
--- trunk/WRF.COMMON/WRFV2/configure	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/configure	(revision 2744)
@@ -0,0 +1,374 @@
+#!/bin/sh
+
+arg1=$1
+
+# lifted from the configure file for mpich; 00/03/10 jm
+#
+# Check for perl and perl version
+for p in perl5 perl
+do
+  # Extract the first word of "$p", so it can be a program name with args.
+  set dummy $p; ac_word=$2
+  if test -z "$ac_echo_n" ; then
+    ac_echo_n=yes
+    if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+      # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+      if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+    ac_n= ac_c='
+' ac_t='        '
+      else
+        ac_n=-n ac_c= ac_t=
+      fi
+    else
+      ac_n= ac_c='\c' ac_t=
+    fi
+    ac_echo_test=`echo foo 1>&1`
+    if test -z "$ac_echo_test" ; then
+       print_error "Your sh shell does not handle the output redirection"
+       print_error "1>&1 correctly.  Configure will work around this problem,"
+       print_error "but you should report the problem to your vendor."
+    fi
+  fi
+  if test -z "$ac_echo_test" -a 1 = 1 ; then
+    echo $ac_n "checking for $ac_word""... $ac_c"
+  else
+    echo $ac_n "checking for $ac_word""... $ac_c" 1>&1
+  fi
+  ac_prog_where=""
+  if test -n "$PERL"; then
+    ac_pg_PERL="$PERL" # Let the user override the test.
+  else
+    ac_first_char=`expr "$p" : "\(.\)"`
+    if test "$ac_first_char" = "/" -a -x "$p" ; then
+         ac_pg_PERL="$p"
+         ac_prog_where=$p
+    else
+        IFS="${IFS=     }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+        for ac_dir in $PATH; do
+          test -z "$ac_dir" && ac_dir=.
+          if test -f $ac_dir/$ac_word; then
+            ac_pg_PERL="$p"
+            ac_prog_where=$ac_dir/$ac_word
+            break
+          fi
+        done
+        IFS="$ac_save_ifs"
+    fi
+  fi;PERL="$ac_pg_PERL"
+  if test -n "$ac_prog_where" ; then
+    if test -z "$ac_echo_test" -a 1 = 1 ; then
+      echo "$ac_t""found $ac_prog_where ($PERL)"
+    else
+      echo "$ac_t""found $ac_prog_where ($PERL)" 1>&1
+    fi
+    PERLFULLPATH=$ac_prog_where  
+  else
+    if test -z "$ac_echo_test" -a 1 = 1 ; then
+      echo "$ac_t""no"
+    else
+      echo "$ac_t""no" 1>&1
+    fi
+  fi
+  test -n "$PERL" && break
+done
+
+if test -z "$PERL" ; then
+    # We have to set this outside of the loop lest the first failure in 
+    # PROGRAM_CHECK set the value (which then terminates the effect of the
+    # loop, since autoconf macros only set values that are null, they 
+    # don't override them
+    PERL=""
+fi
+
+if test -n "$PERL" ; then
+    PERL="$PERL"
+    
+    perlversion=`$PERL -v | grep 'This is perl' | \
+       sed -e 's/^.*v[a-z ]*\([0-9]\).*$/\1/'`
+
+    # Should do a test first for ch_p4 etc.
+    if test "$perlversion" -lt 5 ; then
+        echo "WRF build requires perl version 5, which configure did not find."
+        echo "You can set the environment variable PERL to contain the "
+        echo "location of perl version 5."
+        echo "Configure believes that $PERL is version $perlversion ."
+        PERL=""
+    fi
+    
+fi
+
+# Look for netcdf
+if test -z "$NETCDF" ; then
+  for p in /usr/local/netcdf
+  do
+    if test -d $p ; then
+      NETCDF=$p
+      break
+    fi
+  done
+fi
+if  test -z "$NETCDF"  ; then
+ 
+  if [ `hostname | cut -c 1-2` = "bs" -o \
+       `hostname | cut -c 1-2` = "bd" -o \
+       `hostname` = "tempest" -o `hostname` = "ute" ] ; then
+    echo 'Compiling on an NCAR system with weird paths to NetCDF'
+    echo 'Setting up a local NetCDF directory with symlinks'
+    if ( test -d ./netcdf_links ) ; then
+      echo 'A directory ./netcdf_links already exists. Continuing.'
+    else
+      mkdir ./netcdf_links
+      if [ -z "$OBJECT_MODE" ] ; then
+         OBJECT_MODE=32 
+         export OBJECT_MODE
+      fi
+      if [ $OBJECT_MODE -ne 64 -a \( `hostname | cut -c 1-2` = "bd" -o `hostname | cut -c 1-2` = "bs" \) ] ; then
+        ( cd ./netcdf_links ; ln -s /usr/local/lib32/r4i4 ./lib ; \
+                              ln -s /usr/local/include ./include )
+      else
+        ( cd ./netcdf_links ; ln -s /usr/local/lib64/r4i4 ./lib ; \
+                              ln -s /usr/local/include ./include )
+      fi
+    fi
+    NETCDF=`pwd`/netcdf_links
+    export NETCDF
+
+
+  else
+    bedone=""
+    if [ -d ./netcdf_links ] ; then
+      echo '** There is an existing ./netcdf_links file. Should I use? [y]'
+      read resp
+      if [ "$resp" = "y" ] ; then
+        NETCDF=`pwd`/netcdf_links
+        bedone="yes"
+      else
+        echo 'Removing existing ./netcdf_links directory'
+        /bin/rm -fr ./netcdf_links
+      fi
+    else
+      echo '** WARNING: No path to NETCDF and environment variable NETCDF not set.'
+      echo '** would you like me to try to fix? [y]'
+    fi
+    netcdfipath=""
+    netcdflpath=""
+    while [ -z "$bedone" ] ; do 
+      read resp
+      if [ "$resp" = "y" -o -z "$resp" ]  ; then
+        if [ -d ./netcdf_links ] ; then
+          echo 'There is already a ./netcdf_links directory. Okay to use links'
+          echo 'in this directory for NetCDF include and lib dirs? [y]'
+          read resp
+          if [ "$resp" = "y" ] ; then
+            NETCDF=`pwd`/netcdf_links
+            export NETCDF
+            bedone="yes"
+            continue
+          fi
+        fi
+        if [ -z "$netcdfipath" ] ; then
+          echo 'Enter full path to NetCDF include directory on your system'
+          read resp
+          if [ ! -d "$resp" ] ; then
+            echo "invalid path: $resp. Try again? [y]" ; continue
+          fi
+          netcdfipath=$resp
+        fi
+        if  [ -z "$netcdflpath" ] ; then
+          echo 'Enter full path to NetCDF library directory on your system'
+          read resp
+          if [ ! -d "$resp" ] ; then
+            echo "invalid path: $resp. Try again? [y]" ; continue
+          fi
+          netcdflpath=$resp
+        fi
+
+        if [ -n "$netcdflpath" -a -n "$netcdfipath" ] ; then
+          if [ -d ./netcdf_links ] ; then
+            echo 'Existing ./netcdf_links directory. Okay to remove. [y]'
+            read resp
+            if [ "$resp" = "y" ]  ; then
+              /bin/rm -fr ./netcdf_links
+            fi
+          fi
+          mkdir ./netcdf_links
+          cd ./netcdf_links 
+            ln -s "$netcdfipath" include
+            ln -s "$netcdflpath" lib
+          cd ..
+          echo created new ./netcdf_links directory
+          /bin/ls -lF ./netcdf_links
+          NETCDF=`pwd`/netcdf_links
+          export NETCDF
+          bedone="yes"
+        fi
+      else
+        bedone="yes"
+      fi
+    done
+  fi
+fi
+
+if test -z "$PDHF5" ; then 
+  if [ `hostname | cut -c 1-2` = "bb" -o `hostname | cut -c 1-2` = "bf" -o `hostname | cut -c 1-2` = "bs" -o \
+       `hostname` = "dataproc" -o `hostname` = "ute" ] ; then
+      if [ -d ~michalak/hdf5pbin ] ; then
+        PHDF5=~michalak/hdf5pbin
+        export PHDF5
+      fi
+      if [ "$OBJECT_MODE" -eq 64 ] ; then
+            if [ -d ~michalak/hdf5pbin-64 ] ; then
+              PHDF5=~michalak/hdf5pbin-64
+              export PHDF5
+            fi
+      fi
+  fi
+fi
+
+if [ -n "$NETCDF" ] ; then
+  echo "Will use NETCDF in dir: $NETCDF"
+else
+  echo "Will configure for use without NetCDF"
+fi
+
+if [ -n "$PNETCDF" ] ; then
+  echo "Will use PNETCDF in dir: $PNETCDF"
+# experimental, so don't tease the user if it is not there
+#else
+#  echo "Will configure for use without NetCDF"
+fi
+
+if [ -n "$PHDF5" ] ; then
+  echo "Will use PHDF5 in dir: $PHDF5"
+else
+  echo "PHDF5 not set in environment. Will configure WRF for use without."
+fi
+
+# Users who are cross-compiling can set environment variable 
+# $WRF_OS to override the value normally obtained from `uname`.  
+# If $WRF_OS is set, then $WRF_MACH can also be set to override 
+# the value normally obtained from `uname -m`.  If $WRF_OS is 
+# set and $WRF_MACH is not set, then $WRF_MACH defaults to "ARCH".  
+# If $WRF_OS is not set then $WRF_MACH is ignored.  
+if [ -n "$WRF_OS" ] ; then
+  echo "${0}:  WRF operating system set to \"${WRF_OS}\" via environment variable \$WRF_OS"
+  os=$WRF_OS
+  mach="ARCH"
+  if [ -n "$WRF_MACH" ] ; then
+    echo "${0}:  WRF machine set to \"${WRF_MACH}\" via environment variable \$WRF_MACH"
+    mach=$WRF_MACH
+  fi
+else
+  # if the uname command exists, give it a shot and see if
+  # we can narrow the choices; otherwise, spam 'em
+  os="ARCH"
+  mach="ARCH"
+  type uname > /dev/null
+  if [ $? -eq 0 ] ; then
+    os=`uname`
+    if [ "$os" = "AIX" -o "$os" = "IRIX" -o "$os" = "IRIX64" -o "$os" = "SunOS" -o "$os" = "HP-UX"  -o "$os" = "Darwin" ] ; then
+      mach="ARCH"
+    else
+      if [ "$os" = "OSF1" -o "$os" = "Linux" -o "$os" = "UNICOS/mp" -o "$os" = "UNIX_System_V" -o "$os" = "CYGWIN_NT-5.1" ] ; then
+        mach=`uname -m`
+      else
+        os="ARCH"
+        mach="ARCH"
+      fi
+    fi
+  fi
+fi
+
+# an IBM specific hack to adjust the bmaxstack and bmaxdata options if addressing is 32-bit
+if [ "$os" = "AIX" ] ; then
+      if [ -z "$OBJECT_MODE" ] ; then
+         OBJECT_MODE=32
+         export OBJECT_MODE
+      fi
+      if [ "$OBJECT_MODE" = "32" ] ; then
+# the bang means nothing to sh in this context; use to represent spaces (perl will unbang)
+         ldflags=-bmaxstack:256000000!-bmaxdata:2048000000
+      fi
+fi
+
+# compile options that come from the environment, such as chemistry
+# the "!" is removed by Config.pl
+if [ -n "$WRF_CHEM" ] ; then
+  if [ $WRF_CHEM = 1 ] ; then
+    echo building WRF with chemistry option
+    compileflags="${compileflags}!-DWRF_CHEM"
+  else
+    compileflags=" "
+  fi
+else
+  compileflags=" "
+fi
+
+# Found perl, so proceed with configuration
+if test -n "$PERL" ; then
+   $PERL arch/Config.pl -perl=$PERL -netcdf=$NETCDF -pnetcdf=$PNETCDF -phdf5=$PHDF5 -os=$os -mach=$mach -ldflags=$ldflags \
+   -compileflags=$compileflags
+  if test ! -f configure.wrf ; then
+    exit 1
+  fi
+fi
+
+if [ "$arg1" = "-d" ] ; then
+ls -l configure.wrf
+   if [ -e configure.wrf ] ; then
+     sed -e 's/FCOPTIM[	  ]*=/& # /' -e '/FCDEBUG[ 	]*=/s/#//g' configure.wrf > configure.wrf.edit
+     /bin/mv configure.wrf.edit configure.wrf
+   fi
+fi
+
+# new feb 2005.  test whether MPI-2
+if test -f configure.wrf ; then
+  grep 'DMPARALLEL .*=.*1' configure.wrf > /dev/null
+  if [ $? = 0 ] ; then
+    echo testing for MPI_Comm_f2c and MPI_Comm_c2f 
+    /bin/rm -f tools/mpi2_test
+    ( make mpi2_test 2> /dev/null ) 1> /dev/null
+    if test -e tools/mpi2_test.o ; then
+      echo "  " MPI_Comm_f2c and MPI_Comm_c2f are supported
+      sed '/^CC .*=/s/$/ -DMPI2_SUPPORT/' configure.wrf > xx$$ ; /bin/mv xx$$ configure.wrf
+    else
+      echo "  " MPI_Comm_f2c and MPI_Comm_c2f are not supported
+    fi
+  fi
+# new dec 2005.  test what fseek is supported (needed for share/landread.c to work correctly)
+  echo testing for fseeko and fseeko64
+  /bin/rm -f tools/fseeko_test tools/fseeko64_test
+  ( make fseek_test 2> /dev/null ) 1> /dev/null
+  if test -x tools/fseeko64_test ; then
+    ( tools/fseeko64_test 2> /dev/null ) 1> /dev/null
+    if [ $? = 0 ] ; then
+       echo fseeko64 is supported
+       sed '/^CC .*=/s/$/ -DFSEEKO64_OK /' configure.wrf > xx$$ ; /bin/mv xx$$ configure.wrf
+    fi
+  else
+    if test -x tools/fseeko_test ; then
+      ( tools/fseeko_test 2> /dev/null ) 1> /dev/null
+      if [ $? = 0 ] ; then
+        echo fseeko is supported and handles 64 bit offsets
+        sed '/^CC .*=/s/$/ -DFSEEKO_OK /' configure.wrf > xx$$ ; /bin/mv xx$$ configure.wrf
+      else
+        echo neither fseeko64 nor fseeko with 64 bit offsets works, landread will be compiled with fseek
+        echo but may not work correctly for very high resolution terrain datasets
+      fi
+    else
+      echo neither fseeko64 nor fseeko with 64 bit offsets works, landread will be compiled with fseek
+      echo but may not work correctly for very high resolution terrain datasets
+    fi
+  fi
+fi
+
+echo "------------------------------------------------------------------------"
+sed -e '1,/#### Architecture specific settings ####/d' -e '/^externals/,$d' configure.wrf
+
+echo "------------------------------------------------------------------------"
+echo "Settings listed above are written to configure.wrf."
+echo "If you wish to change settings, please edit that file."
+echo "If you wish to change the default options, edit the file:"
+echo "     arch/configure.defaults"
+echo " "
+
Index: trunk/WRF.COMMON/WRFV2/configure.defaults.fix64nest
===================================================================
--- trunk/WRF.COMMON/WRFV2/configure.defaults.fix64nest	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/configure.defaults.fix64nest	(revision 2744)
@@ -0,0 +1,10947 @@
+###########################################################
+#ARCH	SGI 32 bit machine IRIX
+
+FC		=	f90
+SFC		=	$(FC)
+LD		=	f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -w
+FCFLAGS		=	$(FCBASEOPTS)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS		=
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS
+LDFLAGS		=       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(FC) $(PROMOTION) -freeform -I." RANLIB="$(RANLIB)" CPP="$(CPP)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH	SGI 32 bit machine, sycamore IRIX
+
+FC		=	f90
+SFC		=	$(FC)
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -w
+FCFLAGS		=	-freeform -I. -w
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS		=
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../frame -I../share -I../phys -I../chem  \
+                       	-I../external/esmf_time_f90 -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS
+LDFLAGS		=       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(FC) $(PROMOTION) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       SGI 64 bit machine IRIX64     (single-threaded, no nesting)
+
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+CFLAGS          =       -64 -DLANDREAD_STUB -DNCARIBM_NOC99
+FCOPTIM         =       -O3
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -64 -cpp -OPT:Olimit=5269 $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+                        -DINTIO -DLIMIT_ARGS -DLANDREAD_STUB
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -64 -OPT:Olimit=5269       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(FC) $(PROMOTION) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_configure.o : module_configure.F
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -freeform -I. -64 -cpp -OPT:Olimit=5269 -w $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	SGI O2K IRIX
+
+FC              =       f90 -n32 -mips4 -w
+SFC		=	$(FC)
+LD              =       f90 -n32 -mips4 -w
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -n32 -mips4
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -w
+FCFLAGS         =       -freeform -I. -O3 -OPT:roundoff=3:IEEE_arithmetic=3 -OPT:fold_arith_limit=2001
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../frame -I../share \
+                        -I../phys -I../chem -I../inc -I../external/esmf_time_f90
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+AR              =       ar ru
+M4              =       m4 -B14000
+LDFLAGS         =       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -C -P $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       SGI 64 bit machine IRIX64     (OpenMP, no nesting)
+
+OMP             =       -mp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -64 -DLANDREAD_STUB -DNCARIBM_NOC99
+FCOPTIM         =       -O3
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -64 -cpp -OPT:Olimit=5269 $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+                        -DINTIO -DLIMIT_ARGS -DLANDREAD_STUB
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH $(OMP) \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -64 -OPT:Olimit=5269       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	SGI O2K DM IRIX64     DM-Parallel        (RSL, SGI-MPI, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+OMP             =       #-mp
+OMPCPP          =       #-D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -w -64 -mips4 -DWRF_RSL_IO -DMAXDOM_MAKE=$(MAX_DOMAINS) \
+                        -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -DDM_PARALLEL -DLANDREAD_STUB -DNCARIBM_NOC99
+FCDEBUG         =       # -g
+FCOPTIM         =       -O3 -OPT:roundoff=3:IEEE_arithmetic=3
+FCBASEOPTS	=	-freeform -I. -64 -mips4 -w $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DINTIO -DGRIB1 CONFIGURE_GRIB2_FLAG -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 \
+                        -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../frame -I../external/esmf_time_f90 \
+                        -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl -lmpi \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS		=       -64 $(OMP)       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+               LEARN_BCAST=-DLEARN_BCAST o2k )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS      (single-threaded, no nesting)
+#
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =	-DNCARIBM_NOC99
+FCOPTIM		=	-O2 # -O4 -xlibmopt
+FCDEBUG		=	#-g
+FCBASEOPTS	=	-fnonstd -free -xpp=cpp $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+			-M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+			-M../frame -M../share -M../phys -M../inc -M../chem \
+			-M../dyn_em 
+ARCHFLAGS       =       -DINTIO -DGRIB1 CONFIGURE_GRIB2_FLAG -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCOPTIM)       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+#CPP            =       /opt/SUNWspro/bin/fpp
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c $(FCBASEOPTS) -I. $(PROMOTION) $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+shift_domain_em.o                                              \
+wrf_bdyin.o wrf_bdyout.o  \
+wrf_histin.o wrf_histout.o  \
+wrf_inputin.o wrf_inputout.o  \
+wrf_restartin.o wrf_restartout.o  \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o mediation_interp_domain.o \
+mediation_force_domain.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS      (single-threaded, nesting using RSL and no MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP             =       
+OMPCPP          =       
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DSTUBMPI
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL -DNCARIBM_NOC99
+FCOPTIM         =       -O2 # -O4 -xlibmopt
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -fnonstd -free -xpp=cpp $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+                        -M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+                        -M../frame -M../share -M../phys -M../inc -M../chem \
+                        -M../dyn_em
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP)        CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-w -DSUN -DSTUBS -O' FC="$(FC) $(PROMOTION)" FFLAGS='-w -O' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+wrf_bdyin.o wrf_bdyout.o  \
+wrf_histin.o wrf_histout.o  \
+wrf_inputin.o wrf_inputout.o  \
+wrf_restartin.o wrf_restartout.o  \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS SM   (OpenMP, no nesting)
+#
+OMP		=	-mp=openmp -explicitpar -stackvar
+OMPCPP          =       -D_OPENMP
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =	-DNCARIBM_NOC99
+FCOPTIM		=	-O3 -xlibmopt
+FCDEBUG		=	#-g
+FCBASEOPTS	=	-fnonstd -free -xpp=cpp $(FCDEBUG) $(OMP) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+			-M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+			-M../frame -M../share -M../phys -M../inc -M../chem \
+			-M../dyn_em 
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+#CPP            =       /opt/SUNWspro/bin/fpp
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c $(FCBASEOPTS) -I. $(PROMOTION) $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS SM   (OpenMP, nesting using RSL and no MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP		=	-mp=openmp -explicitpar -stackvar
+OMPCPP          =       -D_OPENMP
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DSTUBMPI
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL -DNCARIBM_NOC99
+FCOPTIM         =       -O3 -xlibmopt
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -fnonstd -free -xpp=cpp $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+                        -M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+                        -M../frame -M../share -M../phys -M../inc -M../chem \ 
+                        -M../dyn_em
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -cpp -free" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-w -DSUN -DSTUBS -O' FC="$(FC) $(PROMOTION)" FFLAGS='-w -O' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH   AIX             (single-threaded, no nesting)
+#
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+CC              =       cc_r
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -qspill=20000 $(FCDEBUG) -qmaxmem=32767 -w #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFIXED         =       -qfixed
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_interface.o : solve_interface.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+module_integrate.o : module_integrate.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o							\
+solve_nmm.o                                                     \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+# to prevent having to call our service representative
+mediation_feedback_domain.o \
+mediation_force_domain.o start_domain.o module_integrate.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH   AIX SM          (OpenMP, no nesting)
+#
+OMP             =       -qsmp=noauto:noopt
+OMPCPP          =       -D_OPENMP
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+CC              =       cc_r
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv -lxlsmp \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+module_sm.o 	: module_sm.F
+module_tiles.o	: module_tiles.F
+solve_em.o	: solve_em.F
+solve_exp.o	: solve_exp.F
+convert_nmm.o   : convert_nmm.F
+
+module_sm.o module_tiles.o solve_em.o solve_exp.o convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(OMP) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+#	Compiled WITHOUT ANY SMP, needed Mar 2005
+module_domain.o : module_domain.F
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_interface.o : solve_interface.F
+module_integrate.o : module_integrate.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL_LITE, IBM-MPI, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE  -I../external/RSL_LITE -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_pnetcdf \
+                        -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DRSL_LITE -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PNETCDF_FLAG \
+                        -DTRIEDNTRUE -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DNMM_NEST=$(WRF_NMM_NEST)
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH \
+                        -L../external/RSL_LITE -lrsl_lite -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+PNETCDFPATH	=	CONFIGURE_PNETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_pnf : 
+	( cd ../external/io_pnetcdf ; make NETCDFPATH=CONFIGURE_PNETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CFLAGS="$(CFLAGS)" CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL, IBM-MPI, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFIXED         =       -qfixed
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/io_pnetcdf $(ESMF_IO_INC) \
+                        -I../frame -I../share -I../phys -I../chem -I../inc $(ESMF_MOD_INC)
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PNETCDF_FLAG \
+                        -DTRIEDNTRUE   -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV $(ESMF_IO_DEFS)
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH \
+                        -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o $(ESMF_IO_LIB)
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+PNETCDFPATH     =       CONFIGURE_PNETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F $(ESMF_TARGET)
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_pnf : 
+	( cd ../external/io_pnetcdf ; make NETCDFPATH=CONFIGURE_PNETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+start_domain_nmm.o : start_domain_nmm.F
+couple_or_uncouple_em.o : couple_or_uncouple_em.F
+nest_init_utils.o : nest_init_utils.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+start_domain_nmm.o                                     \
+couple_or_uncouple_em.o                                              \
+nest_init_utils.o                                              \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL, IBM-MPI, allows nesting )(PARALLEL HDF5)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto 
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=-1 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf  -I../external/io_phdf5 -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PHDF5_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PHDF5_LIB_PATH -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 CONFIGURE_WRFIO_PHDF5 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_phdf5 : 
+	( cd ../external/io_phdf5 ; make PHDF5PATH=CONFIGURE_PHDF5_PATH FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qfree=F90 -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL_LITE, IBM-MPI, Allows nesting )(PARALLEL HDF5)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE  -I../external/RSL_LITE -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto 
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=-1 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf  -I../external/io_phdf5 -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DRSL_LITE -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PHDF5_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PHDF5_LIB_PATH -L../external/RSL_LITE -lrsl_lite -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 CONFIGURE_WRFIO_PHDF5 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_phdf5 : 
+	( cd ../external/io_phdf5 ; make PHDF5PATH=CONFIGURE_PHDF5_PATH FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qfree=F90 -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" CFLAGS="$(CFLAGS)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel/SM-Parallel (not recommended)  (RSL, IBM-MPI, OpenMP, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+OMP             =       -qsmp=noauto:noopt
+OMPCPP          =       -D_OPENMP
+SFC		=	xlf90_r
+SCC             =       cc_r
+FC		=	mpxlf90_r
+LD		=	mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lxlsmp -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+MAX_PROC        =       1024
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+convert_nmm.o \
+module_configure.o                                             \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+mediation_integrate.o \
+mediation_interp_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+# to prevent having to call our service representative
+mediation_feedback_domain.o \
+mediation_force_domain.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+#	Compiled WITHOUT ANY SMP, needed Mar 2005
+module_domain.o : module_domain.F
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL, IBM-MPI, MCEL)   May 2003, EXPERIMENTAL
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpCC_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+MCELHOME        =       /home/bluesky/bettenc/disttest
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../../inc -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DMCELIO -DLIMIT_ARGS \
+                        -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        -L../external/RSL/RSL -lrsl -lmass -lmassv -lxlsmp \
+                        -L../external/io_mcel -lwrfio_mcel  \
+-L$(MCELHOME)/MCELSystem/MCEL -lMCEL  \
+-L$(MCELHOME)/lib -lomniORB4  \
+-lomnithread -lomniDynamic4  -lnetcdf_c++ -lnetcdf  -lxlf90 -lxlopt  \
+                        -lxlf -lxlomp_ser -lm -lc -lpthread \
+                        -L../external/io_int -lwrfio_int  \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int wrfio_mcel gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( cat ../tools/gen_comms_warning ../external/RSL/gen_comms.c > ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( cat module_dm_warning ../external/RSL/module_dm.F > module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+wrfio_mcel : 
+	( cd ../external/io_mcel ; \
+          make CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -I../../inc -I../io_netcdf -I../../frame -I../../share \
+               -I$(MCELHOME)/MCELSystem/MCEL -qfree=f90" all )
+
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX                      (single-threaded, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       xlf90_r
+LD              =       xlf90_r
+CC              =       cc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DSTUBMPI
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ;  \
+          make CC="$(CC)" CFLAGS='-DSTUBS -O -DNOUNDERSCORE' FC="$(FC) $(PROMOTION)" FFLAGS='-O -qfixed' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+couple_or_uncouple_em.o : couple_or_uncouple_em.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+couple_or_uncouple_em.o \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX                      (OpenMP, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =       -qsmp=noauto:noopt
+OMPCPP          =       -D_OPENMP
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       xlf90_r
+LD              =       xlf90_r
+CC              =       cc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DSTUBMPI
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ;  \
+          make CC="$(CC)" CFLAGS='-DSTUBS -O -DNOUNDERSCORE' FC="$(FC) $(PROMOTION)" FFLAGS='-O -qfixed' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+start_domain.o : start_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+start_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(OMP) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+#	Compiled WITHOUT ANY SMP, needed Mar 2005
+module_domain.o : module_domain.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+module_initialize_real.o : module_initialize_real.F
+
+module_domain.o \
+module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_force_domain.o \
+mediation_feedback_domain.o \
+module_initialize_real.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH       Linux ppc64 BG (Blue Gene, RSL_LITE, IBM-MPI) 
+#
+# from sheeba
+BGL_SYS         =       /bgl/BlueLight/ppcfloor/bglsys
+MPI_INC         =       -I$(BGL_SYS)/include
+MPI_LIB         =       -L$(BGL_SYS)/lib -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts
+TRACE_LIB       =       -L/contrib/bgl/mpi_trace  -lmpitrace_c
+
+SFC              =      blrts_xlf90
+SCC             =       blrts_xlc
+DMPARALLEL      =       1
+FC              =       $(SFC)
+LD              =       $(FC)
+CC              =       $(SCC)
+
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DNCARIBM_NOC99 $(MPI_INC) -I../external/RSL_LITE -DLANDREAD_STUB
+FCOPTIM         =       -O2 -qarch=440
+FCDEBUG         =       # -qnoopt -qfullpath -qarch=440
+
+FCBASEOPTS      =       -qspill=20000 $(FCDEBUG) -qmaxmem=64000  $(MPI_INC) -w #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_pnetcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc 
+
+ARCHFLAGS       =       -DDM_PARALLEL -DRSL_LITE -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG CONFIGURE_PNETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DLANDREAD_STUB
+
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH \
+                        -L../external/RSL_LITE -lrsl_lite -L/bgl/local/lib -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+			$(TRACE_LIB) $(MPI_LIB)
+
+LDFLAGS         =	-Wl,--allow-multiple-definition -qstatic
+ENVCOMPDEFS	=	
+WRF_CHEM	=	0 
+CPP             =       /opt/ibmcmp/xlf/9.1/exe/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DF90_STANDALONE -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+#### this is a hand installed version of m4 on frost.ucar.edu
+#### a copy is available at http://www.mmm.ucar.edu/wrf/WG2/BG/m4
+M4              =       /home/janicec/m4 -B 12000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+PNETCDFPATH     =       CONFIGURE_PNETCDF_PATH
+CC_TOOLS        =       cc
+WRF_CONVERT = 0
+
+externals : wrf_ioapi_includes ../external/RSL_LITE/librsl_lite.a CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF wrfio_int module_dm.F esmf_time gen_comms.c
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH="$(NETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_pnf :
+	( cd ../external/io_pnetcdf ; make NETCDFPATH=CONFIGURE_PNETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(MPI_INC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CFLAGS="$(CFLAGS)" CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -qfree=f90 -qspillsize=32767 -I. $(PROMOTION) $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_em.o : solve_em.F
+start_em.o : start_em.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_em.o                                              \
+start_em.o                                              \
+shift_domain_em.o                                              \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+# to prevent having to call our service representative
+mediation_feedback_domain.o \
+mediation_force_domain.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -qnoopt $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha          (single-threaded, no nesting)
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS)
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha          (single-threaded, nesting using RSL without MPI )
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-DSTUBS -DSWAPBYTES -O' FC="$(FC) $(PROMOTION)" FFLAGS='-O -convert big_endian' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha SM       (OpenMP, no nesting)
+#
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS)
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha SM-Parallel       (OpenMP, nesting using RSL without MPI )
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-DSTUBS -DSWAPBYTES -O' FC="$(FC) $(PROMOTION)" FFLAGS="-O -convert big_endian $(FCREAL8OMP)" \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH     Compaq OSF1 alpha DM-Parallel       (RSL_LITE, MPICH, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL_LITE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL_LITE
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       #-g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL_LITE -lrsl_lite  \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL_LITE/librsl_lite.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+module_IGWAVE_ADJUST.o : module_IGWAVE_ADJUST.F
+
+nest_init_utils.o module_optional_si_input.o module_IGWAVE_ADJUST.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o start_domain_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel       (RSL, MPICH, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+start_em.o : start_em.F
+start_domain_nmm.o : start_domain_nmm.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o start_em.o start_domain_nmm.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel/SM-Parallel    (RSL, MPICH, OpenMP, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCREAL8OMP)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel/SM-Parallel    (RSL, DECMPI, OpenMP, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl -lmpi \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC=cc FC="$(SFC) $(PROMOTION) $(FCREAL8OMP)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel       (RSL, MPICH, MCEL EXPERIMENTAL)
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90 -f90=cxx
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DMCELIO
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+-L../external/io_mcel -lwrfio_mcel  \
+-L/users/bettenc/MCELSystem/MCEL -lMCEL \
+-L/users/bettenc/lib -lOB -lJTC -lrt -lpthread \
+-lfor -lm -lnetcdf_c++ -lnetcdf -lpthread -lc -L/users/michalak/mpich/lib -lfmpich -lmpichfsup \
+/usr/lib/cmplrs/fortrtl/libUfor.a -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -pthread -ieee -ptr /users/bettenc/ptr -L/users/bettenc/MCELSystem/MCEL -lMCEL -L/users/bettenc/lib -lOB -lJTC -lrt -lpthread -lfor -lm -lnetcdf_c++ -lnetcdf -lpthread -lc CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a wrfio_mcel gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+wrfio_mcel :
+	( cd ../external/io_mcel ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -I../io_netcdf -I../../frame -I../../share \
+          -I/users/bettenc/MCELSystem/MCEL -convert big_endian -automatic -cpp -free" all )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM/SM    (BUILD FOR AUTODOC ONLY -- DO NOT USE TO COMPILE CODE)
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       echo # mpif90
+SFC             =       echo # mpif90
+LD              =       echo # mpif90
+CC              =       echo # mpicc
+SCC		=	echo # cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DAUTODOC_BUILD CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL="'<b>DM_PARALLEL</b>'" -DRSL="'<b>RSL</b>'" \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DMOVE_NESTS
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH     Compaq OSF1 alpha DM-Parallel       (RSL_LITE, MPICH, allows nesting, UNOPT shift_domain)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL_LITE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL_LITE
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       #-g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL_LITE -lrsl_lite  \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL_LITE/librsl_lite.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+module_IGWAVE_ADJUST.o : module_IGWAVE_ADJUST.F
+
+nest_init_utils.o module_optional_si_input.o module_IGWAVE_ADJUST.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+shift_domain_em.o : shift_domain_em.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+shift_domain_em.o \
+module_initialize_real.o start_domain.o start_domain_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Alpha Linux alpha DM  (single-threaded, no nesting)
+#
+FC              =       fort
+SFC		=	$(FC)
+LD              =       fort
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DF2CSTYLE 
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCBASENOINL     =       -convert big_endian -O1 -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. \
+                        -arch host $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o  -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -traditional  $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat  module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASENOINL) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASENOINL) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       Alpha Linux alpha SM  (DOES NOT WORK ON JET! No nesting)
+#
+FC              =       fort
+SFC		=	$(FC)
+LD              =       fort
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DF2CSTYLE 
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCBASENOINL     =       -convert big_endian -O1 -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. \
+                        -arch host $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o  -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -traditional -C -P `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          /bin/cp module_dm_warning module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASENOINL) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASENOINL) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       Alpha Linux alpha DM-Parallel  (RSL, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO -DF2CSTYLE \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) \
+                        -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCBASENOINL     =       -convert big_endian -O1 -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. \
+                        -arch host $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o \
+			-L../external/io_int -lwrfio_int -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -traditional -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ;                   \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASENOINL) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" \
+          MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+          UNDERSCORE=-DF2CSTYLE LEARN_BCAST=-DLEARN_BCAST alpha )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASENOINL) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       VPP UNIX_System_V F300 5000
+#
+FC              =       frt
+SFC		=	$(FC)
+LD              =       frt
+CC              =       vcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCFLAGS         =       -Free -X9 -Am
+FCFLAGS         =       -Free -X9 -Sw -Wv,-Of,-te,-ilfunc,-noalias,-m3,-P255 -Oe,-P -Kfast -Am
+FCDEBUG         =       # -g
+FCBASEOPTS      =       $(FCFLAGS)
+ARCHFLAGS       = CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             = 	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =      -Wl,-P -J CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+LDFLAGS         =      -J CONFIGURE_LDFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2  module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Free -X9" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Free -X9" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Free -X9" archive )
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -Free -X9" archive )
+
+###########################################################
+#ARCH	Cray
+#
+FC		=	f90
+SFC		=	$(FC)
+CC              =       cc
+SCC		=	$(CC)
+NATIVE_RWORDSIZE =      8
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+# does this PROMOTION flag work on Cray?  
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCFLAGS		=	-f free -N 255 -I.
+FCDEBUG         =       # -g
+FCBASEOPTS	=	$(FCFLAGS)
+ARCHFLAGS       =       -DCRAY CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DIWORDSIZE=8 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=8 \
+			-DLIMIT_ARGS
+LDFLAGS		= CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/opt/ctl/bin/cpp
+POUND_DEF	=	-DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+#LIB             =       CONFIGURE_NETCDF_LIB_PATH 
+LIB             = 	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2  esmf_time
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive )
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" archive )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -O 0 $(PROMOTION) $(FCFLAGS) $*.f90
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  (Single-threaded, no nesting)
+#
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+#FCBASEOPTS      =       -w -byteswapio -Mfree -Mipa=fast,inline,safe  $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  (single threaded, allows nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='-byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH   PC Linux i486 i586 i686, PGI compiler  SM-Parallel (OpenMP, no nesting)
+#
+OMP             =       -mp
+OMPCPP          =       -D_OPENMP
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(OMPCPP) -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  SM-Parallel (OpenMP, allows nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =       -mp
+OMPCPP          =       -D_OPENMP
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(OMPCPP) -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='-byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  DM-Parallel (RSL, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=pgf90
+LD              =       mpif90 -f90=pgf90
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH     PC Linux i486 i586 i686, PGI compiler  DM-Parallel (RSL_LITE, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=pgf90
+LD              =       mpif90 -f90=pgf90
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+#FCOPTIM		=	-fastsse 
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+#Options for Debian Sarge systems
+#FCBASEOPTS      =       -w -byteswapio -Mfree -Mipa=fast,inline,safe  $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNMM_NEST=$(WRF_NMM_NEST)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(FCFLAGS) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    Intel Itanium2 ia64 madison Linux DM-Parallel (e.g. mpp2 at PNNL), efc71 compiler (RSL, MPICH, nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL = 1
+MAX_PROC = 2000
+FC = mpif90
+LD = mpif90
+CC = mpicc
+SCC = cc
+SFC = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS = -DDM_PARALLEL -DWRF_RSL_IO -w \
+         -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -size_lp64 \
+         -I/usr/lib/mpi/mpi_intel/include
+FCOPTIM = -O2 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -w -cm 
+FCNOOPTS = -O0 $(FCDEBUG) -FR -I$(INCLUDE) -w -cm 
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64 
+ARCHFLAGS = -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+            -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+            -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_int -I../external/esmf_time_f90 \
+                  -I../external -I../frame -I../share -I../phys -I../chem -I../inc \
+                  -I/usr/lib/mpi/mpi_intel/include
+PERL = perl
+REGISTRY = Registry
+LIB = -L../external/io_netcdf -lwrfio_nf $(OMP) -LCONFIGURE_NETCDF_PATH/lib -lnetcdf \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+      -L../external/RSL/RSL -lrsl ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+      -L../external/esmf_time_f90 -lesmf_time -lmpifarg -lmpi -lelan -lintrins -lPEPCF90 \
+      -limf -lguide -lunwind -lpthread -L/opt/mlib/lib/linux -lveclib8
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =  /lib/cpp -traditional -C -P
+POUND_DEF	=  -DNO_RRTM_PHYSICS \
+                   -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -I$(LIBINCLUDE) $(ARCHFLAGS) $(COREDEFS) $(OMPCPP)  \
+           -I../external/RSL/RSL -C -EP `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC='mpicc -w -I. '\
+	  FC="$(FC) $(PROMOTION) -cm -w " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH      Intel Itanium2 ia64 Linux (eg. Jacaranda), ifort compiler (RSL, no-MPI, allows nesting)
+#
+#          On Jacaranda, setenv NETCDF /jacaranda/users/michalak/netcdf-3.5.1
+#          Built this netcdf by first setenv FC efc and CPPFLAGS '-DNDEBUG -DpgiFortran'
+#          before typing configure and make and make install   20040506. JM
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL = 1
+MAX_PROC = 1
+# for multithreading, uncomment the following
+#OMP =    -openmp
+#OMPCPP = -DOPEN_MP
+FC = ifort
+LD = ifort
+CC = cc
+SCC = $(CC)
+SFC = ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+CFLAGS = -DDM_PARALLEL -DWRF_RSL_IO -cm -w \
+         -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -size_lp64
+FCOPTIM = -O2 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -cm -convert big_endian -mp
+FCNOOPTS = -O0 $(FCDEBUG) -FR -I$(INCLUDE) -w -cm 
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64 
+ARCHFLAGS = -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+            -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+            -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS -DSTUBMPI -DIFORT_KLUDGE
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_int -I../external/esmf_time_f90 \
+                  -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL = perl
+REGISTRY = Registry
+LIB = -L../external/io_netcdf -lwrfio_nf $(OMP) -LCONFIGURE_NETCDF_PATH/lib -lnetcdf \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+      -L../external/RSL/RSL -lrsl ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+      -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS = $(OMP) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =  /lib/cpp -traditional -C -P
+POUND_DEF	=  -DNO_RRTM_PHYSICS \
+                   -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -I$(LIBINCLUDE) $(ARCHFLAGS) $(COREDEFS) $(OMPCPP)  \
+           -I../external/RSL/RSL -C `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS="-DSTUBS -O" \
+	  FC="$(FC) $(PROMOTION)" FCFLAGS="$(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+mediation_interp_domain.o : mediation_interp_domain.F 
+mediation_force_domain.o : mediation_force_domain.F 
+mediation_feedback_domain.o : mediation_feedback_domain.F 
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI compiler 5.2 or higher  (Single-threaded, no nesting)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DLANDREAD_STUB
+FCOPTIM		=	-fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI 5.2 or higher, DM-Parallel  (RSL, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL \
+                        -DLANDREAD_STUB
+FCOPTIM         =       -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI 5.2 or higher DM-Parallel   (RSL_LITE, MPICH, Allows nesting, No periodic LBCs)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE \
+                        -DLANDREAD_STUB
+FCOPTIM         =       -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI compiler 5.2 or higher  (Single-threaded, RSL, Allows nesting)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=	-fastsse # -Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DLANDREADSTUB -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='-byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#	if [ ! -e $@ ] ; then \
+#	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+
+###########################################################
+#ARCH    Intel Itanium2 ia64 madison Linux  (e.g. mpp2 at PNNL) , efc71 compiler DM-Parallel (RSL_LITE, MPICH, Allows nesting )
+# Notes for running on PNNL cluster:
+# 
+# 1. source /home/oehmen/.mycshrc
+# 2. source /home/mscf/intel7.1/compiler70/ia64/bin/efcvars.csh
+# 
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL = 1
+MAX_PROC   = 2000
+FC         = mpif90
+LD         = mpif90
+CC         = mpicc
+SCC        = gcc
+SFC        = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS     = -DDM_PARALLEL -w -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) \
+             -I../external/RSL_LITE -size_lp64 -I/usr/lib/mpi/mpi_intel/include
+FCOPTIM = -O2 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -cm 
+FCNOOPTS = -O0 $(FCDEBUG) -FR -I$(INCLUDE) -w -cm 
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64 
+ARCHFLAGS = -DDM_PARALLEL \
+            -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+            -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_int -I../external/esmf_time_f90 \
+                  -I../external -I../frame -I../share -I../phys -I../inc  -I../chem \
+                  -I/usr/lib/mpi/mpi_intel/include
+PERL = perl
+REGISTRY = Registry
+LIB = -L../external/io_netcdf -lwrfio_nf $(OMP) -LCONFIGURE_NETCDF_PATH/lib -lnetcdf -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+      ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+      -lmpifarg -lmpi -lelan -lintrins -lPEPCF90 -limf -lguide -lunwind -lpthread -L/opt/mlib/lib/linux -lveclib8
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP        = /lib/cpp -traditional -C -P -traditional
+POUND_DEF  = -DNO_RRTM_PHYSICS -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) \
+             -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS   = -I$(LIBINCLUDE) $(ARCHFLAGS) $(COREDEFS) $(OMPCPP) -I$(INCLUDE) \
+             -I../external/RSL_LITE -C -EP `cat ../inc/dm_comm_cpp_flags` $(POUND_DEF)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='mpicc -w -I.' \
+	  FC="$(FC) $(PROMOTION) $(FCFLAGS) -cm -w " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH titan.ncsa.uiuc.edu specific Intel Itanium2 ia64 mckinley Linux, efc compiler DM-Parallel (RSL, VMI, allows nesting) 
+#
+# Consider 'setenv F_UFMTENDIAN big' in your run scripts for big-endian output
+# Note hard-coded paths to Mark Straka's accounts and ecc6 libs
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL = 1
+#OMP = -openmp
+#OMPCPP = -D_OPENMP
+INCLUDE = ../external/io_netcdf/
+MAX_PROC = 256
+FC = efc -I.. -I/usr/local/vmi/mpich/include
+LD = efc
+CC = ecc -I. -I/usr/local/vmi/mpich/include
+SCC		=	$(CC)
+SFC = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS = -DDM_PARALLEL -DWRF_RSL_IO \
+-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -size_lp64
+FCOPTIM = -O3 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -I. -cm
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64
+ARCHFLAGS = -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+-DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+-DGRIB1 CONFIGURE_GRIB2_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+-I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL = perl
+REGISTRY = Registry
+LIB = -Vaxlib -L../external/io_netcdf -lwrfio_nf $(OMP) -L/u/ncsa/straka/AUGUST.test/WRFV1/netcdfintel7/lib -lnetcdf -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+-L../external/io_int -lwrfio_int \
+../frame/module_internal_header_util.o ../frame/pack_utils.o -L/usr/local/vmi/mpich/lib/ecc6 -lmpich -lfmpich -lvmi -ldl -lpthread -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP = /lib/cpp -C -P -traditional
+POUND_DEF = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -traditional -I$(LIBINCLUDE) -C -P $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) -I$(INCLUDE) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) $(COREDEFS)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time io_grib1
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Vaxlib -I../.. $(FCFLAGS) -w" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="efc -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+#../external/RSL/RSL/librsl.a :
+#	( cd ../external/RSL/RSL ; \
+#          make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+#               LEARN_BCAST=-DLEARN_BCAST o2k )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC='ecc -Vaxlib -I. -cm -w -I/usr/local/vmi/mpich/include '\
+	  FC="$(SFC) $(PROMOTION) -cm -w -Vaxlib -I../../.. " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH titan.ncsa.uiuc.edu specific Intel Itanium2 ia64 mckinley Linux, efc compiler DM-Parallel (RSL_LITE, VMI, allows nesting)
+#
+# Consider 'setenv F_UFMTENDIAN big' in your run scripts for big-endian output
+# Note hard-coded paths to Mark Straka's accounts and ecc6 libs
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL = 1
+INCLUDE = ../external/io_netcdf/
+MAX_PROC = 256
+FC = efc -I.. -I/usr/local/vmi/mpich/include
+LD = efc
+CC = ecc -I. -I/usr/local/vmi/mpich/include
+SCC		=	$(CC)
+SFC = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS = -DDM_PARALLEL -I../external/RSL_LITE \
+-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -size_lp64
+FCOPTIM = -O3 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -I. -cm
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64
+ARCHFLAGS = -DRSL_LITE -DDM_PARALLEL \
+-DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+-DGRIB1 CONFIGURE_GRIB2_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+-I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL = perl
+REGISTRY = Registry
+LIB = -Vaxlib -L../external/io_netcdf -lwrfio_nf $(OMP) -L/u/ncsa/straka/AUGUST.test/WRFV1/netcdfintel7/lib -lnetcdf -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+-L../external/io_int -lwrfio_int \
+../frame/module_internal_header_util.o ../frame/pack_utils.o -L/usr/local/vmi/mpich/lib/ecc6 -lmpich -lfmpich -lvmi -ldl -lpthread -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP = /lib/cpp -C -P -traditional
+POUND_DEF = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -traditional -I$(LIBINCLUDE) -C -P $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) -I$(INCLUDE) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) $(COREDEFS)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Vaxlib -I../.. $(FCFLAGS) -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" RANLIB="$(RANLIB)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" RANLIB="$(RANLIB)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='ecc -Vaxlib -I. -cm -w -I/usr/local/vmi/mpich/include' \
+	FC="$(SFC) $(PROMOTION) $(FCFLAGS) -cm -w -Vaxlib -I../../.. " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler (single-threaded, no nesting)
+#
+OMP             =
+OMPCPP          =
+FC		=	ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC		=	$(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -w -FR -cm -I. -Vaxlib -convert big_endian -mp
+FCOPTIM		=	-O2
+FCFLAGS		=	$(FCOPTIM) $(FCBASEOPTS) $(OMP)
+CFLAGS		=       -w
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =        -DLIMIT_ARGS -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DIFORT_KLUDGE
+LD		=	$(FC)
+LDFLAGS		=	$(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -traditional
+POUND_DEF	=	$(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM \
+                        -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =	CONFIGURE_NETCDF_LIB_PATH ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                        -L../external/esmf_time_f90 -lesmf_time \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -FR -I. -w" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+
+wrf_bdyin.o wrf_bdyout.o  \
+wrf_histin.o wrf_histout.o  \
+wrf_inputin.o wrf_inputout.o  \
+wrf_restartin.o wrf_restartout.o  \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler  (single threaded, allows nesting using RSL without MPI)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =
+OMPCPP          =
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       ifort
+LD              =       ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI -DIFORT_KLUDGE
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS $(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" \
+	  CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+	  CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" CFLAGS="-DSTUBS $(CFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH   AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler (OpenMP)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+#
+OMP             =       -openmp -fpp -auto
+OMPCPP          =       -D_OPENMP
+FC              =       ifort
+LD              =       ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+CFLAGS          =
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DIFORT_KLUDGE
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCFLAGS) $(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	$(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler SM-Parallel (OpenMP, allows nesting using RSL without MPI)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+OMP             =       -openmp -fpp -auto
+OMPCPP          =       -D_OPENMP
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       ifort
+LD              =       ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI -DIFORT_KLUDGE
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time $(OMP)
+LDFLAGS         =       $(FCOPTIM) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS $(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" CFLAGS="-DSTUBS $(CFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort+icc compiler  DM-Parallel (RSL, MPICH, allows nesting)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=ifort
+LD              =       mpif90 -f90=ifort
+CC              =       mpicc -cc=icc
+SCC		=	gcc
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DMPI  \
+			-DLIMIT_ARGS -DIFORT_KLUDGE 
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO $(ARCHFLAGS) \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort+gcc compiler  DM-Parallel (RSL, MPICH, allows nesting)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=ifort
+LD              =       mpif90 -f90=ifort
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DMPI  \
+			-DLIMIT_ARGS -DIFORT_KLUDGE 
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO $(ARCHFLAGS) \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       $(FCOPTIM) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+
+#ARCH NEC SUPER-UX SX-6 (serial)
+
+#***** some sx f90 compiler options***********
+# -V : version # of f90 command to stderr
+#-EP : activate cpp preprocessor to perform conditional compiling: output as i.[filename]
+#-Ep: activate cpp preprocessor to perfomr conditional compiling
+   #****However, cpp also activated by using .F or .F90 suffixes...
+# -Wf: specifies option string of the f90/sx detailed options
+#-g: debug info generated in object file for dbx symbolic debugging
+# -ew : all numbers size=8bytes
+#-eW: 4 bytes
+# -float0: default and only -float(number) option for sx6
+# -USX: unname the prev. defined reserved symbol SX of the preprocessor
+   # -U overrides -D, so '-USX  -D$(RUNTIMESYSTEM)'  might be redundant
+# -p: object file in execution format corresp. to 'prof' command be generated
+# -f4: input source program is described in F90 standard free format
+# -w: only syntax diagnostic messages at the fatal level are output
+# -C: specifies compile mode
+#   ssafe: only safe optimization in scalar mode (minimize side effects of 
+#          opt. no loop unrolling, etc
+# -init : init stack and heap areas
+# -L fmtlist summary stdout: formatted list, transformation lists, summary list are output to stdout
+
+RUNTIME_SYSTEM	=	sx
+MPP_TARGET	=	$(RUNTIME_SYSTEM)
+FC		=	f90
+SFC		=	$(FC)
+CC		=	cc
+SCC		=	$(CC)
+LD		=	$(FC)
+NATIVE_RWORDSIZE =      8
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS	=	-DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DIWORDSIZE=8 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=8 -DLIMIT_ARGS -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+		##for DM compilation	-DDM_PARALLEL -DRSL 
+# note:  -ew already does this for SX6, see comments above
+PROMOTION	=	
+CFLAGS		=	$(ARCHFLAGS)
+#CFLAGS		=	$(ARCHFLAGS) -DMPI -Dvpp -I../external/RSL/RSL
+
+FCFLAGS		=	-w -Ep -C ssafe \
+			-sx6 -USX -ew -D$(RUNTIME_SYSTEM) -I$(LIBINCLUDE) -I../inc -f4 
+		#	-Wf"-init stack=zero heap=zero" 
+		#         -Wf"-L transform fmtlist summary stdout" -g
+FCDEBUG         =       # -g
+FCBASEOPTS	=	$(FCFLAGS) -w
+
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  \
+                        -I../external/esmf_time_f90 -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       -L../external/io_netcdf -lwrfio_nf -L/usr/local/netcdf/current/lib -lnetcdf -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                     #   -L../external/RSL/RSL -lrsl \
+			-L../external/esmf_time_f90 -lesmf_time \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o
+
+#-lmpi for 4byte storage, -lmpiw for 8 byte storage 
+#LDOPTIONS	=	-lmpiw -ew 
+CPP		=	/lib/cpp 
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF) $(ARCHFLAGS)
+#CPPFLAGS = -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL  `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) -DSYSTEM_CALL_OK -DMPI -Dvpp
+
+MAX_PROC = 8
+MAKE = make -i -r
+AWK = awk
+SED = sed
+CAT = cat
+CUT = cut
+EXPAND = expand
+AR = ar ru
+M4 = m4 -B14000
+RANLIB = ar ru     
+NETCDFPATH = /usr/local/netcdf/current
+CC_TOOLS        =       $(CC)
+ARCH_OBJS = milliclock.o
+ASSUME_HOMOGENEOUS_ENVIRONMENT = 1
+FLIC_MACROS = LMvpp.m4 -B 14000
+VECTOR = 1
+
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int  esmf_time  module_dm.F
+	( /sbin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F:
+	( /sbin/cp module_dm_warning module_dm.F ; \
+	  cat module_dm_stubs.F  >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=/usr/local/netcdf/current FC="$(FC) $(PROMOTION) $(FCFLAGS)"  )
+
+
+wrfio_int :
+	( cd ../external/io_int ; \
+	  make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" archive)
+
+esmf_time :
+	( cd ../external/esmf_time_f90 ;\
+ 	make FC="$(FC) $(PROMOTION) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) $(CPPFLAGS) -I../../inc " )
+
+#sx : uses makefile.sx in the directory
+#../external/RSL/RSL/librsl.a :
+#	(cd ../external/RSL/RSL ; \
+#	make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sx )
+#
+#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+   
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL, SGI MPI, Intel MKL, allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#  Change MKL_HOME if Intel's MKL is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_DOMAINS       = 7
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+MKL_HOME          = /usr/lib
+# MKL_HOME          = /sw/sdev/mkl/7.2.008/mkl72/lib/64
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -no-gcc -DDM_PARALLEL -DWRF_RSL_IO \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL  -DDM_PARALLEL -DIWORDSIZE=4 \
+                    -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                    -DLIMIT_ARGS -DIFORT_KLUDGE -DINTELMKL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL/RSL -lrsl \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time \
+                    -L$(MKL_HOME) -lvml -lmkl_ipf
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" \
+          FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make IDIR="-I$(MPI_HOME)/include" \
+	 MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+	 LEARN_BCAST=-DLEARN_BCAST altix )
+
+# compile these without high optimization to speed compile
+module_configure.o : module_configure.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+
+module_configure.o \
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL_LITE, VMI, SGI MPI, Intel MKL, Allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#  Change MKL_HOME if Intel's MKL is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+MKL_HOME          = /usr/lib
+# MKL_HOME          = /sw/sdev/mkl/7.2.008/mkl72/lib/64
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -DDM_PARALLEL -I../external/RSL_LITE \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DRSL_LITE -DDM_PARALLEL \
+                    -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF \
+                    -DINTELMKL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL_LITE -lrsl_lite \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time \
+                    -L$(MKL_HOME) -lvml -lmkl_ipf
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='icc -I. -w -O3 -DMPI2_SUPPORT -I$(MPI_HOME)/include '\
+	 FC='ifort -w -O3 -I../../.. ' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_dm.o : module_dm.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL, SGI MPI, allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_DOMAINS       = 7
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -no-gcc -DDM_PARALLEL -DWRF_RSL_IO \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM           = -O3 -unroll0 
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL  -DDM_PARALLEL -DIWORDSIZE=4 \
+                    -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                    -DLIMIT_ARGS -DIFORT_KLUDGE
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL/RSL -lrsl \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" \
+          FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)"\
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)"\
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)"\
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make IDIR="-I$(MPI_HOME)/include" \
+	 MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+	 LEARN_BCAST=-DLEARN_BCAST altix )
+
+# compile these without high optimization to speed compile
+module_configure.o : module_configure.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+
+module_configure.o \
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL_LITE, VMI, SGI MPI, Allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -DDM_PARALLEL -I../external/RSL_LITE \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DRSL_LITE -DDM_PARALLEL \
+                    -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL_LITE -lrsl_lite \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='icc -I. -w -O3 -DMPI2_SUPPORT -I$(MPI_HOME)/include '\
+	 FC='ifort -w -O3 -I../../.. ' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_wrf.o : module_io_wrf.F
+module_dm.o : module_dm.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort compiler (OpenMP, no nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+# Set up only for idealized experiments
+#
+OMP               = -openmp
+OMPCPP            = -D_OPENMP
+INCLUDE           = ../external/io_netcdf/
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz 
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/io_int -lwrfio_int \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF wrfio_int module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc )
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../io_phdf5 ; \
+#	/bin/cp wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_dm.o : module_dm.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+module_bl_mrf.o: module_bl_mrf.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o module_bl_mrf.o                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort compiler (Single-processor, no nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+INCLUDE           = ../external/io_netcdf/
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz 
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/io_int -lwrfio_int \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip  CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) \
+                    -I$(INCLUDE) -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF wrfio_int module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc )
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../io_phdf5 ; \
+#	/bin/cp wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_dm.o : module_dm.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   UNICOS/mp  machine crayx1 (RSL_LITE, MPI, MSP mode)
+#
+#  Cray X1 (RSL_LITE, MPI, MSP mode)
+#  For CSD mode set numtiles=4 in &domains section
+#  in namelist.input for best MSP efficiency.
+#
+DMPARALLEL      =       1
+MAX_PROC         =       1024
+FC              =       ftn
+SFC		=	$(FC)
+LD              =       ftn
+CC              =       cc
+SCC		=	$(CC)
+
+#### Override default sed command and script for Fortran source files ####
+#### This sed script converts !$OMP directives to !csd$ directives ####
+SED_FTN = sed -f ../arch/cray_csd.sed
+
+## Use these for X1 cross compiler to build Registry
+##X1_CROSS_COMP = "gcc"
+##X1_CROSS_CFLG = ""
+## Use these for X1 native (trigger) compiler
+X1_CROSS_COMP = "cc"
+X1_CROSS_CFLG = "-hcommand"
+CC_TOOLS        = 	$(X1_CROSS_COMP) $(X1_CROSS_CFLG)
+
+RWORDSIZE         = $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -f free -N 255 -I. -x omp -dy
+FCFLAGS_LOWOPT  =       $(FCBASEOPTS) -O1
+FCFLAGS         =       $(FCBASEOPTS) -Ofp3 -O3 -Ogen_private_callee
+#if using 64bit precision
+#PROMOTION	=	-sreal64 -dp -sinteger32
+CFLAGS          =       -I../external/RSL_LITE -DMAXDOM_MAKE=$(MAX_DOMAINS) \
+                        -DMAXPROC_MAKE=$(MAX_PROC) -DDM_PARALLEL -UCRAY -DLANDREAD_STUB -Dcrayx1
+
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../inc \
+			-p./ -p../external/io_netcdf -p../external/io_int -p../frame \
+                        -p../frame -p../share -p../phys -p../chem \
+                        -p../dyn_em -p ../external/esmf_time_f90
+ARCHFLAGS       =       -DRSL_LITE -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -Dcrayx1
+
+PERL            =       perl
+REGISTRY        =       Registry
+
+LIB             =       -L../external/io_netcdf -lwrfio_nf CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o \
+			-L../external/esmf_time_f90 -lesmf_time -lmalloc
+
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+LDFLAGS         =       
+
+CPP		=	cpp -C -P -Dcrayx1
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) # -DNO_NAMELIST_PRINT
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP) -Dcrayx1" FC="$(FC) $(PROMOTION) -f free -N 255 " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) -f free -N 255" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP) -Dcrayx1" FC="$(FC) $(PROMOTION) -f free -N 255" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC) -UCRAY" CPP="$(CPP) -Dcrayx1" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) -f free -N 255" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC) -UCRAY" CPP="$(CPP) CONFIGURE_GRIB2_INC -Dcrayx1" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) -f free -N 255" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) -f free -N 255" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CFLAGS="$(CFLAGS)" CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" \
+                                     MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_em.o : solve_em.F
+solve_interface.o : solve_interface.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+input_wrf.o : input_wrf.F
+output_wrf.o : output_wrf.F
+
+module_io_mm5.o module_si_io.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_interp_domain.o \
+mediation_force_domain.o \
+module_configure.o solve_em.o \
+input_wrf.o output_wrf.o \
+solve_interface.o wrf_restartout.o wrf_restartin.o \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS_LOWOPT) $(MODULE_DIRS)  $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600	32bit   (single-threaded, no nesting)
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600	32bit   (single-threaded, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL	=	1
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DWRF_RSL_IO -DRSL -DINTIO -DLIMIT_ARGS \
+                        -DDM_PARALLEL -DFLOATSAFE -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL/ -lrsl -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC	=	1
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time 
+
+gen_comms.c : ../external/RSL/gen_comms.c
+		( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+		  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS=" -DSTUBS +O3 " FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	Itanium2	(single-threaded, no nesting)
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DSitanium2 -DNOUNDERSCORE
+FCOPTIM         =       +O3 +Odataprefetch +Olibcalls +DO11.23 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DSitanium2 +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	Itanium2	(single-threaded, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DWRF_RSL_IO -DRSL -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DSitanium2 -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +DSitanium2 +Odataprefetch +Olibcalls +DO11.23 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DSitanium2 +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600		32bit   (openmp, no nesting)
+#
+OMP             =      	+Oopenmp 
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600	 DM-Parallel	(RSL, MPICH, nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL	=	1
+MAX_PROC	=	1024
+OMP             =       
+OMPCPP          =       
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4  -DDM_PARALLEL -DRSL \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST hp )
+
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	Itanium2    DM-Parallel	(RSL, MPICH, nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL	=	1
+MAX_PROC	=	1024
+OMP             =       
+OMPCPP          =       
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4  -DDM_PARALLEL -DRSL \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DSitanium2 -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +Odataprefetch +Olibcalls +DO11.23 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DSitanium2 +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST hp )
+
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH Darwin		(single-threaded, no nesting)
+#     
+#     Using -qfloat=nomaf option can result in identical results with
+#           non-optimized and optimized results (suggested by Fovell of UCLA)
+#           One may turn on by uncommenting it in FCOPTIM line
+#
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+#CC              =       cc_r
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       = $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DLANDREAD_STUB -I /usr/include/sys -DMACOS
+FCOPTIM         =       -O3 -qarch=auto #-qfloat=nomaf
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 -w 
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DLANDREAD_STUB -DMAC_KLUDGE
+#			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DMACOS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+#LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv 
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+
+LDFLAGS         =	 -Wl,-stack_size,10000000,-stack_addr,0xc0000000 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+#CPP             =       /opt/ibmcmp/xlf/8.1/exe/cpp -C -P
+CPP             =       /usr/bin/cpp  -C -P -xassembler-with-cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF) 
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -qfree=f90 -qspillsize=32767 -I. $(PROMOTION) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+solve_em.o : solve_em.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+shift_domain_em.o                                              \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_em.o \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+###########################################################
+#ARCH Darwin		(OpenMP, no nesting)
+#     
+#     Using -qfloat=nomaf option can result in identical results with
+#           non-optimized and optimized results (suggested by Fovell of UCLA)
+#           One may turn on by uncommenting it in FCOPTIM line
+#
+OMP             =       -qsmp=noauto
+OMPCPP          =       -D_OPENMP
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       = $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DLANDREAD_STUB -I /usr/include/sys -DMACOS
+FCOPTIM         =       -O2 -qarch=auto -qunroll=yes #-qfloat=nomaf
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DLANDREAD_STUB -DMACOS -DMAC_KLUDGE
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -lxlsmp \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) -Wl,-stack_size,10000000,-stack_addr,0xc0000000  CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /usr/bin/cpp -C -P -xassembler-with-cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+
+module_configure.o : module_configure.F
+module_domain.o   : module_domain.F
+module_sm.o 	: module_sm.F
+module_tiles.o	: module_tiles.F
+solve_em.o	: solve_em.F
+solve_exp.o	: solve_exp.F
+convert_nmm.o   : convert_nmm.F
+
+module_configure.o module_sm.o module_tiles.o solve_em.o solve_exp.o convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(OMP) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt -qnohot $*.f90
+
+module_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F90 > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt -qnohot $*.f90
+
+###########################################################
+#ARCH Darwin		(single-threaded, no nesting, USES: gcc-3.3, xlf cpp, SystemStubs)
+#     
+#     Using -qfloat=nomaf option can result in identical results with
+#           non-optimized and optimized results (suggested by Fovell of UCLA)
+#           One may turn on by uncommenting it in FCOPTIM line
+#
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+#CC              =       cc_r
+CC              =       gcc-3.3
+SCC		=	$(CC)
+RWORDSIZE       = $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DLANDREAD_STUB -I /usr/include/sys -DMACOS
+FCOPTIM         =       -O3 -qarch=auto #-qfloat=nomaf
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 -w 
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DLANDREAD_STUB -DMAC_KLUDGE
+#			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DMACOS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+#LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv 
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+
+LDFLAGS         =	 -Wl,-stack_size,10000000,-stack_addr,0xc0000000 CONFIGURE_LDFLAGS -L/usr/lib -lSystemStubs
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /opt/ibmcmp/xlf/8.1/exe/cpp -C -P
+#CPP             =       /usr/bin/cpp  -C -P -xassembler-with-cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF) 
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -qfree=f90 -qspillsize=32767 -I. $(PROMOTION) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+solve_em.o : solve_em.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+shift_domain_em.o                                              \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_em.o \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PathScale 2.1 or higher (Single-threaded, no nesting)
+#
+FC              =       pathf90
+LD              =       pathf90
+CC              =       pathcc
+SCC             =       $(CC)
+NATIVE_RWORDSIZE=       4
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION       =       -r$(RWORDSIZE) -i4
+CFLAGS          =       
+FCOPTIM         =       -O3 -OPT:Ofast:Olimit=5000
+FCDEBUG         =       #-g
+FCBASEOPTS      =       -w -byteswapio -freeform -fno-second-underscore $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+                        -DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       $(FCFLAGS) -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS     =       CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF       =       $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+                                                                                
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+                                                                                
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w -fno-second-underscore" TRADFLAG="-traditional" )
+                                                                                
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" archive )
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+	make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+	make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_int :
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+	TRADFLAG="-traditional" all )
+                                                                                
+esmf_time :
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+                                                                                
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_configure.o : module_configure.F
+                                                                                
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_fddaobs_rtfdda.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PathScale 2.1 or higher DM-Parallel   (RSL_LITE, PathScale MPICH, No periodic LBCs)
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=pathf90
+LD              =       mpif90 -f90=pathf90
+CC              =       mpicc  -cc=pathcc
+SCC             =       pathcc
+SFC             =       pathf90
+NATIVE_RWORDSIZE=	4
+RWORDSIZE	=	$(NATIVE_RWORDSIZE)
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM         =       -O3 -OPT:Ofast:Olimit=5000
+FCDEBUG         =       #-g
+FCBASEOPTS      =       -w -byteswapio -freeform -fno-second-underscore $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+EXTRAMODULES    =
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        -L../external/io_int -lwrfio_int \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       -byteswapio
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF       =       -DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       pathcc
+                                                                                
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+                                                                                
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+                                                                                
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+                                                                                
+#io_flags:
+#	( cd ../external/io_netcdf ; make flags_only ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../io_phdf5 )
+                                                                                
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC)" TRADFLAG="-traditional" \
+	FFLAGS='$(FCFLAGS) -I../../inc -ICONFIGURE_NETCDF_PATH/include -w -fno-second-underscore' RANLIB=$(RANLIB) )
+                                                                                
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" TRADFLAG="-traditional" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" archive )
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+	make CC="$(CC)" CPP="$(CPP)" FC="$(SFC) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" RANLIB=$(RANLIB) archive )
+                                                                                
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+	make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" FC="$(SFC) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" RM="$(RM)" RANLIB=$(RANLIB) archive )
+                                                                                
+wrfio_int : 
+	( cd ../external/io_int ; \
+	make CC="$(CC)" CPP="$(CPP)" FC="$(SFC) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" RANLIB=$(RANLIB) all )
+                                                                                
+esmf_time :
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(FCDEBUG) $(FCBASEOPTS) " CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+                                                                                
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC='mpif90 $(FCFLAGS) -byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+                                                                                
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_configure.o : module_configure.F
+                                                                                
+solve_interface.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_fddaobs_rtfdda.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    Cray XT3 Catamount/Linux x86_64 (Opteron), PGI 5.2 or higher DM-Parallel (RSL_LITE, MPICH, Allows nesting, Periodic in X only )
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       ftn
+LD              =       ftn
+CC              =       gcc -DMPI2_SUPPORT
+SCC		=	gcc
+SFC             =       mpif90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE \
+                        -DLANDREAD_STUB -DXT3_Catamount -I$(MPICH_DIR)/include
+FCOPTIM         =       -O3 -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB -DNO_NAMELIST_PRINT -DXT3_Catamount
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                        -L../external/esmf_time_f90 -lesmf_time 
+# add this to LIB to use XT3 iobuf library after loading iobuf module, also requires
+# properly built netCDF library that includes iobuf
+#                       $(IOBUF_POST_LINK_OPTS)
+LDFLAGS         =       -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC) $(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+solve_em.o : solve_em.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+solve_em.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    NEC SX-8, NEC SX cross compiler DM-Parallel (RSL, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       sxmpif90
+LD              =       sxmpif90
+CC              =       sxmpic++
+SCC		=	sxmpic++
+SFC             =       sxmpif90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	
+CFLAGS          =       -DNCARIBM_NOC99 -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM		=	
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -f4 -Wf,-P i $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time -L$(SX_BASE_CPLUS)/lib -lcpp
+LDFLAGS         =       $(FCFLAGS) -Wl,-h nodefs CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) -DNEC
+AR_BASE         =       sxar
+AR              =       $(AR_BASE) ru
+M4              =       m4 -B 14000
+RANLIB          =       sxar rs
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" AR="$(AR_BASE)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sx )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#	if [ ! -e $@ ] ; then \
+#	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+
+###########################################################
+#ARCH    NEC SX-8, NEC SX cross compiler DM-Parallel (RSL_LITE, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       sxmpif90
+LD              =       sxmpif90
+CC              =       sxmpic++
+SCC		=	sxmpic++
+SFC             =       sxmpif90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	
+CFLAGS          =       -DNCARIBM_NOC99 -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM		=	
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -f4 -Wf,-P i $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time -L$(SX_BASE_CPLUS)/lib -lcpp
+LDFLAGS         =       $(FCFLAGS) -Wl,-h nodefs CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) -DNEC
+AR_BASE         =       sxar
+AR              =       $(AR_BASE) ru
+M4              =       m4 -B 14000
+RANLIB          =       sxar rs
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib1 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" AR="$(AR_BASE)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST AR="$(AR_BASE)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#	if [ ! -e $@ ] ; then \
+#	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+
+
+###########################################################
+#ARCH    CYGWIN_NT-5.1 Cygwin i486 i586 i686, g95 compiler  (Single-threaded, no nesting)
+#
+FC              =       g95
+LD              =       g95
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+# g95 does not like -r8. if you want -r8, just add it to PROMOTION below
+#PROMOTION	=	-r$(RWORDSIZE) -i4
+PROMOTION	=	-i4
+CFLAGS          =
+FCOPTIM		=	-O2
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -Wno=101,139,155,158 -fno-second-underscore -fendian=big -ffree-form $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DG95
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -fmod=../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, g95 compiler  (Single-threaded, no nesting)
+#
+FC              =       g95
+LD              =       g95
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+# g95 does not like -r4. if you want promotion to -r8 add it to PROMOTION below
+#PROMOTION	=	-r$(RWORDSIZE) -i4
+PROMOTION	=	-i4
+CFLAGS          =       
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g -O0
+FCBASEOPTS      =       -Wno=101,139,155,158 -fno-second-underscore -fendian=big -ffree-form $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DG95
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -fmod=../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH     PC Linux i486 i586 i686, g95 compiler  DM-Parallel (RSL_LITE, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=g95
+LD              =       mpif90 -f90=g95
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       g95
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+# g95 does not like -r4. if you want promotion to -r8 add it to PROMOTION below
+#PROMOTION      =       -r$(RWORDSIZE) -i4
+PROMOTION       =       -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g -O0
+FCBASEOPTS      =       -Wno=101,139,155,158 -fno-second-underscore -fendian=big -ffree-form $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNMM_NEST=$(WRF_NMM_NEST) -DG95
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -fmod=../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(FCFLAGS) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+##################################################################
+#ARCH  NULL
Index: trunk/WRF.COMMON/WRFV2/configure.defaults.gfortran64
===================================================================
--- trunk/WRF.COMMON/WRFV2/configure.defaults.gfortran64	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/configure.defaults.gfortran64	(revision 2744)
@@ -0,0 +1,11300 @@
+###########################################################
+#ARCH	SGI 32 bit machine IRIX
+
+FC		=	f90
+SFC		=	$(FC)
+LD		=	f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -w
+FCFLAGS		=	$(FCBASEOPTS)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS		=
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS
+LDFLAGS		=       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(FC) $(PROMOTION) -freeform -I." RANLIB="$(RANLIB)" CPP="$(CPP)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH	SGI 32 bit machine, sycamore IRIX
+
+FC		=	f90
+SFC		=	$(FC)
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -w
+FCFLAGS		=	-freeform -I. -w
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS		=
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../frame -I../share -I../phys -I../chem  \
+                       	-I../external/esmf_time_f90 -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS
+LDFLAGS		=       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(FC) $(PROMOTION) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       SGI 64 bit machine IRIX64     (single-threaded, no nesting)
+
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+CFLAGS          =       -64 -DLANDREAD_STUB -DNCARIBM_NOC99
+FCOPTIM         =       -O3
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -64 -cpp -OPT:Olimit=5269 $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+                        -DINTIO -DLIMIT_ARGS -DLANDREAD_STUB
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -64 -OPT:Olimit=5269       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(FC) $(PROMOTION) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_configure.o : module_configure.F
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -freeform -I. -64 -cpp -OPT:Olimit=5269 -w $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	SGI O2K IRIX
+
+FC              =       f90 -n32 -mips4 -w
+SFC		=	$(FC)
+LD              =       f90 -n32 -mips4 -w
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -n32 -mips4
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -w
+FCFLAGS         =       -freeform -I. -O3 -OPT:roundoff=3:IEEE_arithmetic=3 -OPT:fold_arith_limit=2001
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../frame -I../share \
+                        -I../phys -I../chem -I../inc -I../external/esmf_time_f90
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+AR              =       ar ru
+M4              =       m4 -B14000
+LDFLAGS         =       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -C -P $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       SGI 64 bit machine IRIX64     (OpenMP, no nesting)
+
+OMP             =       -mp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -64 -DLANDREAD_STUB -DNCARIBM_NOC99
+FCOPTIM         =       -O3
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -freeform -I. -64 -cpp -OPT:Olimit=5269 $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+                        -DINTIO -DLIMIT_ARGS -DLANDREAD_STUB
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH $(OMP) \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -64 -OPT:Olimit=5269       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	SGI O2K DM IRIX64     DM-Parallel        (RSL, SGI-MPI, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+OMP             =       #-mp
+OMPCPP          =       #-D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -w -64 -mips4 -DWRF_RSL_IO -DMAXDOM_MAKE=$(MAX_DOMAINS) \
+                        -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -DDM_PARALLEL -DLANDREAD_STUB -DNCARIBM_NOC99
+FCDEBUG         =       # -g
+FCOPTIM         =       -O3 -OPT:roundoff=3:IEEE_arithmetic=3
+FCBASEOPTS	=	-freeform -I. -64 -mips4 -w $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DINTIO -DGRIB1 CONFIGURE_GRIB2_FLAG -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 \
+                        -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../frame -I../external/esmf_time_f90 \
+                        -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl -lmpi \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS		=       -64 $(OMP)       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the SGI Fortran compiler complains about long source lines.      ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+               LEARN_BCAST=-DLEARN_BCAST o2k )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_configure.o : module_configure.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS      (single-threaded, no nesting)
+#
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =	-DNCARIBM_NOC99
+FCOPTIM		=	-O2 # -O4 -xlibmopt
+FCDEBUG		=	#-g
+FCBASEOPTS	=	-fnonstd -free -xpp=cpp $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+			-M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+			-M../frame -M../share -M../phys -M../inc -M../chem \
+			-M../dyn_em 
+ARCHFLAGS       =       -DINTIO -DGRIB1 CONFIGURE_GRIB2_FLAG -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCOPTIM)       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+#CPP            =       /opt/SUNWspro/bin/fpp
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c $(FCBASEOPTS) -I. $(PROMOTION) $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+shift_domain_em.o                                              \
+wrf_bdyin.o wrf_bdyout.o  \
+wrf_histin.o wrf_histout.o  \
+wrf_inputin.o wrf_inputout.o  \
+wrf_restartin.o wrf_restartout.o  \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o mediation_interp_domain.o \
+mediation_force_domain.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS      (single-threaded, nesting using RSL and no MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP             =       
+OMPCPP          =       
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DSTUBMPI
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL -DNCARIBM_NOC99
+FCOPTIM         =       -O2 # -O4 -xlibmopt
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -fnonstd -free -xpp=cpp $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+                        -M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+                        -M../frame -M../share -M../phys -M../inc -M../chem \
+                        -M../dyn_em
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP)        CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-w -DSUN -DSTUBS -O' FC="$(FC) $(PROMOTION)" FFLAGS='-w -O' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+wrf_bdyin.o wrf_bdyout.o  \
+wrf_histin.o wrf_histout.o  \
+wrf_inputin.o wrf_inputout.o  \
+wrf_restartin.o wrf_restartout.o  \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS SM   (OpenMP, no nesting)
+#
+OMP		=	-mp=openmp -explicitpar -stackvar
+OMPCPP          =       -D_OPENMP
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =	-DNCARIBM_NOC99
+FCOPTIM		=	-O3 -xlibmopt
+FCDEBUG		=	#-g
+FCBASEOPTS	=	-fnonstd -free -xpp=cpp $(FCDEBUG) $(OMP) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+			-M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+			-M../frame -M../share -M../phys -M../inc -M../chem \
+			-M../dyn_em 
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+#CPP            =       /opt/SUNWspro/bin/fpp
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c $(FCBASEOPTS) -I. $(PROMOTION) $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	Sun  SunOS SM   (OpenMP, nesting using RSL and no MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP		=	-mp=openmp -explicitpar -stackvar
+OMPCPP          =       -D_OPENMP
+FC              =       f95
+SFC		=	$(FC)
+LD              =       f95
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DSTUBMPI
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-xtypemap=real:$(RSIZEBITS),integer:32
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL -DNCARIBM_NOC99
+FCOPTIM         =       -O3 -xlibmopt
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -fnonstd -free -xpp=cpp $(FCDEBUG) -w
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem \
+                        -M../external/io_netcdf -M../external/io_int -M../external/esmf_time_f90 \
+                        -M../frame -M../share -M../phys -M../inc -M../chem \ 
+                        -M../dyn_em
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/ccs/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Sun Fortran compiler complains about long source lines,      ####
+#### usually due to cpp translating __FILE__ to a full pathname.              ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -cpp -free" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" FC="$(SFC) $(PROMOTION) $(FCBASEOPTS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-w -DSUN -DSTUBS -O' FC="$(FC) $(PROMOTION)" FFLAGS='-w -O' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH   AIX             (single-threaded, no nesting)
+#
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+CC              =       cc_r
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -qspill=20000 $(FCDEBUG) -qmaxmem=32767 -w #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFIXED         =       -qfixed
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_interface.o : solve_interface.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+module_integrate.o : module_integrate.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o							\
+solve_nmm.o                                                     \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+# to prevent having to call our service representative
+mediation_feedback_domain.o \
+mediation_force_domain.o start_domain.o module_integrate.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH   AIX SM          (OpenMP, no nesting)
+#
+OMP             =       -qsmp=noauto:noopt
+OMPCPP          =       -D_OPENMP
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+CC              =       cc_r
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv -lxlsmp \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+module_sm.o 	: module_sm.F
+module_tiles.o	: module_tiles.F
+solve_em.o	: solve_em.F
+solve_exp.o	: solve_exp.F
+convert_nmm.o   : convert_nmm.F
+
+module_sm.o module_tiles.o solve_em.o solve_exp.o convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(OMP) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+#	Compiled WITHOUT ANY SMP, needed Mar 2005
+module_domain.o : module_domain.F
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_interface.o : solve_interface.F
+module_integrate.o : module_integrate.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL_LITE, IBM-MPI, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE  -I../external/RSL_LITE -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_pnetcdf \
+                        -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DRSL_LITE -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PNETCDF_FLAG \
+                        -DTRIEDNTRUE -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DNMM_NEST=$(WRF_NMM_NEST)
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH \
+                        -L../external/RSL_LITE -lrsl_lite -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+PNETCDFPATH	=	CONFIGURE_PNETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_pnf : 
+	( cd ../external/io_pnetcdf ; make NETCDFPATH=CONFIGURE_PNETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CFLAGS="$(CFLAGS)" CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL, IBM-MPI, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFIXED         =       -qfixed
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int -I../external/io_pnetcdf $(ESMF_IO_INC) \
+                        -I../frame -I../share -I../phys -I../chem -I../inc $(ESMF_MOD_INC)
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PNETCDF_FLAG \
+                        -DTRIEDNTRUE   -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV $(ESMF_IO_DEFS)
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH \
+                        -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o $(ESMF_IO_LIB)
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+PNETCDFPATH     =       CONFIGURE_PNETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F $(ESMF_TARGET)
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_pnf : 
+	( cd ../external/io_pnetcdf ; make NETCDFPATH=CONFIGURE_PNETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+start_domain_nmm.o : start_domain_nmm.F
+couple_or_uncouple_em.o : couple_or_uncouple_em.F
+nest_init_utils.o : nest_init_utils.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+start_domain_nmm.o                                     \
+couple_or_uncouple_em.o                                              \
+nest_init_utils.o                                              \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL, IBM-MPI, allows nesting )(PARALLEL HDF5)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto 
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=-1 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf  -I../external/io_phdf5 -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PHDF5_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PHDF5_LIB_PATH -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 CONFIGURE_WRFIO_PHDF5 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_phdf5 : 
+	( cd ../external/io_phdf5 ; make PHDF5PATH=CONFIGURE_PHDF5_PATH FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qfree=F90 -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL_LITE, IBM-MPI, Allows nesting )(PARALLEL HDF5)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE  -I../external/RSL_LITE -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto 
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=-1 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf  -I../external/io_phdf5 -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DRSL_LITE -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PHDF5_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PHDF5_LIB_PATH -L../external/RSL_LITE -lrsl_lite -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 CONFIGURE_WRFIO_PHDF5 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_phdf5 : 
+	( cd ../external/io_phdf5 ; make PHDF5PATH=CONFIGURE_PHDF5_PATH FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qfree=F90 -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" CFLAGS="$(CFLAGS)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel/SM-Parallel (not recommended)  (RSL, IBM-MPI, OpenMP, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+OMP             =       -qsmp=noauto:noopt
+OMPCPP          =       -D_OPENMP
+SFC		=	xlf90_r
+SCC             =       cc_r
+FC		=	mpxlf90_r
+LD		=	mpxlf90_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lxlsmp -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+MAX_PROC        =       1024
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+convert_nmm.o \
+module_configure.o                                             \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+mediation_integrate.o \
+mediation_interp_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+# to prevent having to call our service representative
+mediation_feedback_domain.o \
+mediation_force_domain.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+#	Compiled WITHOUT ANY SMP, needed Mar 2005
+module_domain.o : module_domain.F
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX DM-Parallel          (RSL, IBM-MPI, MCEL)   May 2003, EXPERIMENTAL
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       mpxlf90_r
+LD              =       mpCC_r
+CC              =       mpcc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+MCELHOME        =       /home/bluesky/bettenc/disttest
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../../inc -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DMCELIO -DLIMIT_ARGS \
+                        -DNO_NAMELIST_PRINT -DNATIVE_MASSV
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        -L../external/RSL/RSL -lrsl -lmass -lmassv -lxlsmp \
+                        -L../external/io_mcel -lwrfio_mcel  \
+-L$(MCELHOME)/MCELSystem/MCEL -lMCEL  \
+-L$(MCELHOME)/lib -lomniORB4  \
+-lomnithread -lomniDynamic4  -lnetcdf_c++ -lnetcdf  -lxlf90 -lxlopt  \
+                        -lxlf -lxlomp_ser -lm -lc -lpthread \
+                        -L../external/io_int -lwrfio_int  \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int wrfio_mcel gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( cat ../tools/gen_comms_warning ../external/RSL/gen_comms.c > ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( cat module_dm_warning ../external/RSL/module_dm.F > module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+wrfio_mcel : 
+	( cd ../external/io_mcel ; \
+          make CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -I../../inc -I../io_netcdf -I../../frame -I../../share \
+               -I$(MCELHOME)/MCELSystem/MCEL -qfree=f90" all )
+
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX                      (single-threaded, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       xlf90_r
+LD              =       xlf90_r
+CC              =       cc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DSTUBMPI
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ;  \
+          make CC="$(CC)" CFLAGS='-DSTUBS -O -DNOUNDERSCORE' FC="$(FC) $(PROMOTION)" FFLAGS='-O -qfixed' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+couple_or_uncouple_em.o : couple_or_uncouple_em.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_force_domain.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_feedback_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+couple_or_uncouple_em.o \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH	AIX                      (OpenMP, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =       -qsmp=noauto:noopt
+OMPCPP          =       -D_OPENMP
+DMPARALLEL      =       1
+SFC             =       xlf90_r
+SCC             =       cc_r
+FC              =       xlf90_r
+LD              =       xlf90_r
+CC              =       cc_r
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI -DNCARIBM_NOC99
+FCOPTIM         =       -O2 -qarch=auto
+#FCOPTIM         =       -O3 -qhot
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qspill=20000 $(FCDEBUG) -qmaxmem=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       -lC
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DSTUBMPI
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ;  \
+          make CC="$(CC)" CFLAGS='-DSTUBS -O -DNOUNDERSCORE' FC="$(FC) $(PROMOTION)" FFLAGS='-O -qfixed' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+start_domain.o : start_domain.F
+convert_nmm.o : convert_nmm.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+solve_em.o : solve_em.F
+solve_nmm.o : solve_nmm.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+start_domain.o \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+solve_em.o                                              \
+solve_nmm.o                                                     \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(OMP) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+#	Compiled WITHOUT ANY SMP, needed Mar 2005
+module_domain.o : module_domain.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+module_initialize_real.o : module_initialize_real.F
+
+module_domain.o \
+module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+mediation_force_domain.o \
+mediation_feedback_domain.o \
+module_initialize_real.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt $*.f90
+
+###########################################################
+#ARCH       Linux ppc64 BG (Blue Gene, RSL_LITE, IBM-MPI) 
+#
+# from sheeba
+BGL_SYS         =       /bgl/BlueLight/ppcfloor/bglsys
+MPI_INC         =       -I$(BGL_SYS)/include
+MPI_LIB         =       -L$(BGL_SYS)/lib -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts
+TRACE_LIB       =       -L/contrib/bgl/mpi_trace  -lmpitrace_c
+
+SFC              =      blrts_xlf90
+SCC             =       blrts_xlc
+DMPARALLEL      =       1
+FC              =       $(SFC)
+LD              =       $(FC)
+CC              =       $(SCC)
+
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DNCARIBM_NOC99 $(MPI_INC) -I../external/RSL_LITE -DLANDREAD_STUB
+FCOPTIM         =       -O2 -qarch=440
+FCDEBUG         =       # -qnoopt -qfullpath -qarch=440
+
+FCBASEOPTS      =       -qspill=20000 $(FCDEBUG) -qmaxmem=64000  $(MPI_INC) -w #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_pnetcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc 
+
+ARCHFLAGS       =       -DDM_PARALLEL -DRSL_LITE -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG CONFIGURE_PNETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DLANDREAD_STUB
+
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH \
+                        -L../external/RSL_LITE -lrsl_lite -L/bgl/local/lib -lmass -lmassv \
+                        -L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+			$(TRACE_LIB) $(MPI_LIB)
+
+LDFLAGS         =	-Wl,--allow-multiple-definition -qstatic
+ENVCOMPDEFS	=	
+WRF_CHEM	=	0 
+CPP             =       /opt/ibmcmp/xlf/9.1/exe/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DF90_STANDALONE -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+#### this is a hand installed version of m4 on frost.ucar.edu
+#### a copy is available at http://www.mmm.ucar.edu/wrf/WG2/BG/m4
+M4              =       /home/janicec/m4 -B 12000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+PNETCDFPATH     =       CONFIGURE_PNETCDF_PATH
+CC_TOOLS        =       cc
+WRF_CONVERT = 0
+
+externals : wrf_ioapi_includes ../external/RSL_LITE/librsl_lite.a CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF wrfio_int module_dm.F esmf_time gen_comms.c
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH="$(NETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_pnf :
+	( cd ../external/io_pnetcdf ; make NETCDFPATH=CONFIGURE_PNETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(MPI_INC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CFLAGS="$(CFLAGS)" CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -qfree=f90 -qspillsize=32767 -I. $(PROMOTION) $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+wrf_bdyout.o : wrf_bdyout.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_em.o : solve_em.F
+start_em.o : start_em.F
+
+wrf_bdyout.o wrf_bdyin.o \
+wrf_restartout.o wrf_restartin.o wrf_inputin.o wrf_inputout.o wrf_histin.o wrf_histout.o \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+mediation_integrate.o \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_em.o                                              \
+start_em.o                                              \
+shift_domain_em.o                                              \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+# to prevent having to call our service representative
+mediation_feedback_domain.o \
+mediation_force_domain.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -qnoopt $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha          (single-threaded, no nesting)
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS)
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha          (single-threaded, nesting using RSL without MPI )
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-DSTUBS -DSWAPBYTES -O' FC="$(FC) $(PROMOTION)" FFLAGS='-O -convert big_endian' \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha SM       (OpenMP, no nesting)
+#
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS)
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha SM-Parallel       (OpenMP, nesting using RSL without MPI )
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DM_PARALLEL     =       1
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        -DLIMIT_ARGS -DFLOATSAFE \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) $(OMP) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS='-DSTUBS -DSWAPBYTES -O' FC="$(FC) $(PROMOTION)" FFLAGS="-O -convert big_endian $(FCREAL8OMP)" \
+               MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH     Compaq OSF1 alpha DM-Parallel       (RSL_LITE, MPICH, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL_LITE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL_LITE
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       #-g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL_LITE -lrsl_lite  \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL_LITE/librsl_lite.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+module_IGWAVE_ADJUST.o : module_IGWAVE_ADJUST.F
+
+nest_init_utils.o module_optional_si_input.o module_IGWAVE_ADJUST.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+solve_em.o : solve_em.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o start_domain_nmm.o solve_em.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel       (RSL, MPICH, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+start_em.o : start_em.F
+start_domain_nmm.o : start_domain_nmm.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o start_em.o start_domain_nmm.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel/SM-Parallel    (RSL, MPICH, OpenMP, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCREAL8OMP)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel/SM-Parallel    (RSL, DECMPI, OpenMP, allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+OMP             =       -omp
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCREAL8OMP	=	-align records -align dcommons -granularity quadword
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG) $(FCREAL8OMP)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF) $(FCREAL8OMP)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl -lmpi \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCREAL8OMP) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC=cc FC="$(SFC) $(PROMOTION) $(FCREAL8OMP)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM-Parallel       (RSL, MPICH, MCEL EXPERIMENTAL)
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90 -f90=cxx
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL -DRSL -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DMCELIO
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+-L../external/io_mcel -lwrfio_mcel  \
+-L/users/bettenc/MCELSystem/MCEL -lMCEL \
+-L/users/bettenc/lib -lOB -lJTC -lrt -lpthread \
+-lfor -lm -lnetcdf_c++ -lnetcdf -lpthread -lc -L/users/michalak/mpich/lib -lfmpich -lmpichfsup \
+/usr/lib/cmplrs/fortrtl/libUfor.a -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -pthread -ieee -ptr /users/bettenc/ptr -L/users/bettenc/MCELSystem/MCEL -lMCEL -L/users/bettenc/lib -lOB -lJTC -lrt -lpthread -lfor -lm -lnetcdf_c++ -lnetcdf -lpthread -lc CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a wrfio_mcel gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+wrfio_mcel :
+	( cd ../external/io_mcel ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -I../io_netcdf -I../../frame -I../../share \
+          -I/users/bettenc/MCELSystem/MCEL -convert big_endian -automatic -cpp -free" all )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+
+nest_init_utils.o module_optional_si_input.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Compaq OSF1 alpha DM/SM    (BUILD FOR AUTODOC ONLY -- DO NOT USE TO COMPILE CODE)
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       echo # mpif90
+SFC             =       echo # mpif90
+LD              =       echo # mpif90
+CC              =       echo # mpicc
+SCC		=	echo # cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DAUTODOC_BUILD CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO \
+                        -DDM_PARALLEL="'<b>DM_PARALLEL</b>'" -DRSL="'<b>RSL</b>'" \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DMOVE_NESTS
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST alpha )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH     Compaq OSF1 alpha DM-Parallel       (RSL_LITE, MPICH, allows nesting, UNOPT shift_domain)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+OMP             =
+OMPCPP          =
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+ARCHFLAGS       =       -DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+                        -DDM_PARALLEL -DRSL_LITE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS -DFLOATSAFE \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-real_size $(RSIZEBITS) -integer_size `expr 4 \* 8`
+CFLAGS          =       $(ARCHFLAGS) -I../external/RSL_LITE
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       #-g
+FCDEBUG_ESMF    =       # -O0
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS_ESMF =       -w -convert big_endian -automatic -cpp -free -I. -arch host $(FCDEBUG_ESMF)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+FCFLAGS_ESMF    =       $(FCOPTIM) $(FCBASEOPTS_ESMF) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/RSL_LITE -lrsl_lite  \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /usr/bin/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC        =       1024
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL_LITE/librsl_lite.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make IO_GRIB_SHARE_DIR="$(WRF_SRC_ROOT_DIR)/external/io_grib_share/" CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -convert big_endian -automatic -cpp -free -w " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCFLAGS_ESMF)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+nest_init_utils.o : nest_init_utils.F
+module_optional_si_input.o : module_optional_si_input.F
+module_IGWAVE_ADJUST.o : module_IGWAVE_ADJUST.F
+
+nest_init_utils.o module_optional_si_input.o module_IGWAVE_ADJUST.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) -w -convert big_endian -automatic -cpp -free -I. -arch host $(MODULE_DIRS) $*.f90
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+solve_em.o : solve_em.F
+module_configure.o : module_configure.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+shift_domain_em.o : shift_domain_em.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+shift_domain_em.o \
+module_initialize_real.o start_domain.o start_domain_nmm.o solve_em.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -O0 $*.f90
+
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+mediation_wrfmain.o : mediation_wrfmain.F
+solve_em.o : solve_em.F
+
+mediation_integrate.o module_dm.o mediation_wrfmain.o solve_em.o : 
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS_ESMF) $(MODULE_DIRS) -O0 $*.f90
+
+###########################################################
+#ARCH       Alpha Linux alpha DM  (single-threaded, no nesting)
+#
+FC              =       fort
+SFC		=	$(FC)
+LD              =       fort
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DF2CSTYLE 
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCBASENOINL     =       -convert big_endian -O1 -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. \
+                        -arch host $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o  -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -traditional  $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; \
+	  cat  module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASENOINL) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASENOINL) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       Alpha Linux alpha SM  (DOES NOT WORK ON JET! No nesting)
+#
+FC              =       fort
+SFC		=	$(FC)
+LD              =       fort
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DF2CSTYLE 
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCBASENOINL     =       -convert big_endian -O1 -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. \
+                        -arch host $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o  -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -traditional -C -P `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          /bin/cp module_dm_warning module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASENOINL) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASENOINL) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       Alpha Linux alpha DM-Parallel  (RSL, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO -DF2CSTYLE \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) \
+                        -I../external/RSL/RSL
+FCOPTIM         =       -fast -O4
+FCDEBUG         =       # -g
+FCBASENOINL     =       -convert big_endian -O1 -automatic -cpp -free -I. -arch host $(FCDEBUG)
+FCBASEOPTS      =       -w -convert big_endian -automatic -cpp -free -I. \
+                        -arch host $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o \
+			-L../external/io_int -lwrfio_int -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -automatic -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DDEC_ALPHA -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -traditional -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ;                   \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCBASENOINL) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASENOINL) -w" \
+          TRADFLAG="-traditional" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" \
+          MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+          UNDERSCORE=-DF2CSTYLE LEARN_BCAST=-DLEARN_BCAST alpha )
+
+# compile these without high optimization to speed compile
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASENOINL) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH       VPP UNIX_System_V F300 5000
+#
+FC              =       frt
+SFC		=	$(FC)
+LD              =       frt
+CC              =       vcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCFLAGS         =       -Free -X9 -Am
+FCFLAGS         =       -Free -X9 -Sw -Wv,-Of,-te,-ilfunc,-noalias,-m3,-P255 -Oe,-P -Kfast -Am
+FCDEBUG         =       # -g
+FCBASEOPTS      =       $(FCFLAGS)
+ARCHFLAGS       = CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DLIMIT_ARGS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             = 	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+LDFLAGS         =      -Wl,-P -J CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+LDFLAGS         =      -J CONFIGURE_LDFLAGS
+CPP             =       /lib/cpp -C -P
+POUND_DEF	=	-DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2  module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Free -X9" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Free -X9" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Free -X9" archive )
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -Free -X9" archive )
+
+###########################################################
+#ARCH	Cray
+#
+FC		=	f90
+SFC		=	$(FC)
+CC              =       cc
+SCC		=	$(CC)
+NATIVE_RWORDSIZE =      8
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+# does this PROMOTION flag work on Cray?  
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCFLAGS		=	-f free -N 255 -I.
+FCDEBUG         =       # -g
+FCBASEOPTS	=	$(FCFLAGS)
+ARCHFLAGS       =       -DCRAY CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DIWORDSIZE=8 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=8 \
+			-DLIMIT_ARGS
+LDFLAGS		= CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/opt/ctl/bin/cpp
+POUND_DEF	=	-DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+#LIB             =       CONFIGURE_NETCDF_LIB_PATH 
+LIB             = 	../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2  esmf_time
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive )
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" archive )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -O 0 $(PROMOTION) $(FCFLAGS) $*.f90
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  (Single-threaded, no nesting)
+#
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+#FCBASEOPTS      =       -w -byteswapio -Mfree -Mipa=fast,inline,safe  $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  (single threaded, allows nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='-byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH   PC Linux i486 i586 i686, PGI compiler  SM-Parallel (OpenMP, no nesting)
+#
+OMP             =       -mp
+OMPCPP          =       -D_OPENMP
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(OMPCPP) -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  SM-Parallel (OpenMP, allows nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =       -mp
+OMPCPP          =       -D_OPENMP
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(OMPCPP) -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='-byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, PGI compiler  DM-Parallel (RSL, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=pgf90
+LD              =       mpif90 -f90=pgf90
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH     PC Linux i486 i586 i686, PGI compiler  DM-Parallel (RSL_LITE, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=pgf90
+LD              =       mpif90 -f90=pgf90
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+#FCOPTIM		=	-fastsse 
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+#Options for Debian Sarge systems
+#FCBASEOPTS      =       -w -byteswapio -Mfree -Mipa=fast,inline,safe  $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNMM_NEST=$(WRF_NMM_NEST)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(FCFLAGS) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+#ARCH    Intel Itanium2 ia64 madison Linux DM-Parallel (e.g. mpp2 at PNNL), efc71 compiler (RSL, MPICH, nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL = 1
+MAX_PROC = 2000
+FC = mpif90
+LD = mpif90
+CC = mpicc
+SCC = cc
+SFC = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS = -DDM_PARALLEL -DWRF_RSL_IO -w \
+         -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -size_lp64 \
+         -I/usr/lib/mpi/mpi_intel/include
+FCOPTIM = -O2 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -w -cm 
+FCNOOPTS = -O0 $(FCDEBUG) -FR -I$(INCLUDE) -w -cm 
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64 
+ARCHFLAGS = -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+            -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+            -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_int -I../external/esmf_time_f90 \
+                  -I../external -I../frame -I../share -I../phys -I../chem -I../inc \
+                  -I/usr/lib/mpi/mpi_intel/include
+PERL = perl
+REGISTRY = Registry
+LIB = -L../external/io_netcdf -lwrfio_nf $(OMP) -LCONFIGURE_NETCDF_PATH/lib -lnetcdf \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+      -L../external/RSL/RSL -lrsl ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+      -L../external/esmf_time_f90 -lesmf_time -lmpifarg -lmpi -lelan -lintrins -lPEPCF90 \
+      -limf -lguide -lunwind -lpthread -L/opt/mlib/lib/linux -lveclib8
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =  /lib/cpp -traditional -C -P
+POUND_DEF	=  -DNO_RRTM_PHYSICS \
+                   -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -I$(LIBINCLUDE) $(ARCHFLAGS) $(COREDEFS) $(OMPCPP)  \
+           -I../external/RSL/RSL -C -EP `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC='mpicc -w -I. '\
+	  FC="$(FC) $(PROMOTION) -cm -w " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH      Intel Itanium2 ia64 Linux (eg. Jacaranda), ifort compiler (RSL, no-MPI, allows nesting)
+#
+#          On Jacaranda, setenv NETCDF /jacaranda/users/michalak/netcdf-3.5.1
+#          Built this netcdf by first setenv FC efc and CPPFLAGS '-DNDEBUG -DpgiFortran'
+#          before typing configure and make and make install   20040506. JM
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL = 1
+MAX_PROC = 1
+# for multithreading, uncomment the following
+#OMP =    -openmp
+#OMPCPP = -DOPEN_MP
+FC = ifort
+LD = ifort
+CC = cc
+SCC = $(CC)
+SFC = ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+CFLAGS = -DDM_PARALLEL -DWRF_RSL_IO -cm -w \
+         -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -size_lp64
+FCOPTIM = -O2 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -cm -convert big_endian -mp
+FCNOOPTS = -O0 $(FCDEBUG) -FR -I$(INCLUDE) -w -cm 
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64 
+ARCHFLAGS = -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+            -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+            -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS -DSTUBMPI -DIFORT_KLUDGE
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_int -I../external/esmf_time_f90 \
+                  -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL = perl
+REGISTRY = Registry
+LIB = -L../external/io_netcdf -lwrfio_nf $(OMP) -LCONFIGURE_NETCDF_PATH/lib -lnetcdf \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+      -L../external/RSL/RSL -lrsl ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+      -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS = $(OMP) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =  /lib/cpp -traditional -C -P
+POUND_DEF	=  -DNO_RRTM_PHYSICS \
+                   -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -I$(LIBINCLUDE) $(ARCHFLAGS) $(COREDEFS) $(OMPCPP)  \
+           -I../external/RSL/RSL -C `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS="-DSTUBS -O" \
+	  FC="$(FC) $(PROMOTION)" FCFLAGS="$(FCFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+mediation_interp_domain.o : mediation_interp_domain.F 
+mediation_force_domain.o : mediation_force_domain.F 
+mediation_feedback_domain.o : mediation_feedback_domain.F 
+mediation_integrate.o : mediation_integrate.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+mediation_interp_domain.o  \
+mediation_force_domain.o  \
+mediation_feedback_domain.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI compiler 5.2 or higher  (Single-threaded, no nesting)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DLANDREAD_STUB
+FCOPTIM		=	-fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI 5.2 or higher, DM-Parallel  (RSL, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL \
+                        -DLANDREAD_STUB
+FCOPTIM         =       -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI 5.2 or higher DM-Parallel   (RSL_LITE, MPICH, Allows nesting, No periodic LBCs)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE \
+                        -DLANDREAD_STUB
+FCOPTIM         =       -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PGI compiler 5.2 or higher  (Single-threaded, RSL, Allows nesting)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=	-fastsse # -Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DLANDREADSTUB -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       -byteswapio $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib1 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='-byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#	if [ ! -e $@ ] ; then \
+#	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+
+###########################################################
+#ARCH    Intel Itanium2 ia64 madison Linux  (e.g. mpp2 at PNNL) , efc71 compiler DM-Parallel (RSL_LITE, MPICH, Allows nesting )
+# Notes for running on PNNL cluster:
+# 
+# 1. source /home/oehmen/.mycshrc
+# 2. source /home/mscf/intel7.1/compiler70/ia64/bin/efcvars.csh
+# 
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL = 1
+MAX_PROC   = 2000
+FC         = mpif90
+LD         = mpif90
+CC         = mpicc
+SCC        = gcc
+SFC        = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS     = -DDM_PARALLEL -w -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) \
+             -I../external/RSL_LITE -size_lp64 -I/usr/lib/mpi/mpi_intel/include
+FCOPTIM = -O2 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -cm 
+FCNOOPTS = -O0 $(FCDEBUG) -FR -I$(INCLUDE) -w -cm 
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64 
+ARCHFLAGS = -DDM_PARALLEL \
+            -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+            -DGRIB1 CONFIGURE_GRIB2_FLAG -DLIMIT_ARGS 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_int -I../external/esmf_time_f90 \
+                  -I../external -I../frame -I../share -I../phys -I../inc  -I../chem \
+                  -I/usr/lib/mpi/mpi_intel/include
+PERL = perl
+REGISTRY = Registry
+LIB = -L../external/io_netcdf -lwrfio_nf $(OMP) -LCONFIGURE_NETCDF_PATH/lib -lnetcdf -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+      ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+      -lmpifarg -lmpi -lelan -lintrins -lPEPCF90 -limf -lguide -lunwind -lpthread -L/opt/mlib/lib/linux -lveclib8
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP        = /lib/cpp -traditional -C -P -traditional
+POUND_DEF  = -DNO_RRTM_PHYSICS -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) \
+             -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS   = -I$(LIBINCLUDE) $(ARCHFLAGS) $(COREDEFS) $(OMPCPP) -I$(INCLUDE) \
+             -I../external/RSL_LITE -C -EP `cat ../inc/dm_comm_cpp_flags` $(POUND_DEF)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='mpicc -w -I.' \
+	  FC="$(FC) $(PROMOTION) $(FCFLAGS) -cm -w " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH titan.ncsa.uiuc.edu specific Intel Itanium2 ia64 mckinley Linux, efc compiler DM-Parallel (RSL, VMI, allows nesting) 
+#
+# Consider 'setenv F_UFMTENDIAN big' in your run scripts for big-endian output
+# Note hard-coded paths to Mark Straka's accounts and ecc6 libs
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL = 1
+#OMP = -openmp
+#OMPCPP = -D_OPENMP
+INCLUDE = ../external/io_netcdf/
+MAX_PROC = 256
+FC = efc -I.. -I/usr/local/vmi/mpich/include
+LD = efc
+CC = ecc -I. -I/usr/local/vmi/mpich/include
+SCC		=	$(CC)
+SFC = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS = -DDM_PARALLEL -DWRF_RSL_IO \
+-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL -size_lp64
+FCOPTIM = -O3 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -I. -cm
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64
+ARCHFLAGS = -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+-DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+-DGRIB1 CONFIGURE_GRIB2_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+-I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL = perl
+REGISTRY = Registry
+LIB = -Vaxlib -L../external/io_netcdf -lwrfio_nf $(OMP) -L/u/ncsa/straka/AUGUST.test/WRFV1/netcdfintel7/lib -lnetcdf -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+-L../external/io_int -lwrfio_int \
+../frame/module_internal_header_util.o ../frame/pack_utils.o -L/usr/local/vmi/mpich/lib/ecc6 -lmpich -lfmpich -lvmi -ldl -lpthread -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP = /lib/cpp -C -P -traditional
+POUND_DEF = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -traditional -I$(LIBINCLUDE) -C -P $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) -I$(INCLUDE) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) $(COREDEFS)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time io_grib1
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Vaxlib -I../.. $(FCFLAGS) -w" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="efc -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+#../external/RSL/RSL/librsl.a :
+#	( cd ../external/RSL/RSL ; \
+#          make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+#               LEARN_BCAST=-DLEARN_BCAST o2k )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC='ecc -Vaxlib -I. -cm -w -I/usr/local/vmi/mpich/include '\
+	  FC="$(SFC) $(PROMOTION) -cm -w -Vaxlib -I../../.. " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH titan.ncsa.uiuc.edu specific Intel Itanium2 ia64 mckinley Linux, efc compiler DM-Parallel (RSL_LITE, VMI, allows nesting)
+#
+# Consider 'setenv F_UFMTENDIAN big' in your run scripts for big-endian output
+# Note hard-coded paths to Mark Straka's accounts and ecc6 libs
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL = 1
+INCLUDE = ../external/io_netcdf/
+MAX_PROC = 256
+FC = efc -I.. -I/usr/local/vmi/mpich/include
+LD = efc
+CC = ecc -I. -I/usr/local/vmi/mpich/include
+SCC		=	$(CC)
+SFC = efc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS = -DDM_PARALLEL -I../external/RSL_LITE \
+-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -size_lp64
+FCOPTIM = -O3 -ftz
+FCDEBUG = #-g
+FCBASEOPTS = $(FCDEBUG) -w -FR -I$(INCLUDE) -I. -cm
+FCFLAGS = $(FCOPTIM) $(FCBASEOPTS) $(OMP) -size_lp64
+ARCHFLAGS = -DRSL_LITE -DDM_PARALLEL \
+-DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+-DGRIB1 CONFIGURE_GRIB2_FLAG 
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES = ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+-I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL = perl
+REGISTRY = Registry
+LIB = -Vaxlib -L../external/io_netcdf -lwrfio_nf $(OMP) -L/u/ncsa/straka/AUGUST.test/WRFV1/netcdfintel7/lib -lnetcdf -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+-L../external/io_int -lwrfio_int \
+../frame/module_internal_header_util.o ../frame/pack_utils.o -L/usr/local/vmi/mpich/lib/ecc6 -lmpich -lfmpich -lvmi -ldl -lpthread -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS = $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP = /lib/cpp -C -P -traditional
+POUND_DEF = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS = -traditional -I$(LIBINCLUDE) -C -P $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) -I$(INCLUDE) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) $(COREDEFS)
+AR = ar ru
+M4 = m4 -B 14000
+RANLIB = ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       ecc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -Vaxlib -I../.. $(FCFLAGS) -w" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" RANLIB="$(RANLIB)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" RANLIB="$(RANLIB)" FC="$(SFC) $(PROMOTION) -Vaxlib -I/usr/local/vmi/mpich/include $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='ecc -Vaxlib -I. -cm -w -I/usr/local/vmi/mpich/include' \
+	FC="$(SFC) $(PROMOTION) $(FCFLAGS) -cm -w -Vaxlib -I../../.. " MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler (single-threaded, no nesting)
+#
+OMP             =
+OMPCPP          =
+FC		=	ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC		=	$(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -w -FR -cm -I. -Vaxlib -convert big_endian -mp
+FCOPTIM		=	-O2
+FCFLAGS		=	$(FCOPTIM) $(FCBASEOPTS) $(OMP)
+CFLAGS		=       -w
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =        -DLIMIT_ARGS -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DIFORT_KLUDGE
+LD		=	$(FC)
+LDFLAGS		=	$(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP		=	/lib/cpp -traditional
+POUND_DEF	=	$(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM \
+                        -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =	CONFIGURE_NETCDF_LIB_PATH ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                        -L../external/esmf_time_f90 -lesmf_time \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -FR -I. -w" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -w" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+
+wrf_bdyin.o wrf_bdyout.o  \
+wrf_histin.o wrf_histout.o  \
+wrf_inputin.o wrf_inputout.o  \
+wrf_restartin.o wrf_restartout.o  \
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler  (single threaded, allows nesting using RSL without MPI)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =
+OMPCPP          =
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       ifort
+LD              =       ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI -DIFORT_KLUDGE
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS $(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" \
+	  CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+	  CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" CFLAGS="-DSTUBS $(CFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH   AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler (OpenMP)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+#
+OMP             =       -openmp -fpp -auto
+OMPCPP          =       -D_OPENMP
+FC              =       ifort
+LD              =       ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+CFLAGS          =
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DIFORT_KLUDGE
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(FCFLAGS) $(FCFLAGS) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	$(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort compiler SM-Parallel (OpenMP, allows nesting using RSL without MPI)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+OMP             =       -openmp -fpp -auto
+OMPCPP          =       -D_OPENMP
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       ifort
+LD              =       ifort
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI -DIFORT_KLUDGE
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time $(OMP)
+LDFLAGS         =       $(FCOPTIM) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS $(OMPCPP) $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+          make CC="$(CC)" FC="$(FC) $(PROMOTION)" CFLAGS="-DSTUBS $(CFLAGS)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort+icc compiler  DM-Parallel (RSL, MPICH, allows nesting)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=ifort
+LD              =       mpif90 -f90=ifort
+CC              =       mpicc -cc=icc
+SCC		=	gcc
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DMPI  \
+			-DLIMIT_ARGS -DIFORT_KLUDGE 
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO $(ARCHFLAGS) \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+#ARCH    AMD x86_64 Intel xeon i686 ia32 Xeon Linux, ifort+gcc compiler  DM-Parallel (RSL, MPICH, allows nesting)
+#
+# Note: if you use ifort 8.0, please remove option -xW (for vectorization). This option 
+#       has been identified to produce wrong results occationally.
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=ifort
+LD              =       mpif90 -f90=ifort
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       ifort
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+RSIZEBITS	=	`expr $(RWORDSIZE) \* 8`
+PROMOTION	=	-real_size $(RSIZEBITS)
+FCOPTIM		=	-O3 # -xW
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -FR -cm -w -I. $(FCDEBUG) -convert big_endian -mp
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DMPI  \
+			-DLIMIT_ARGS -DIFORT_KLUDGE 
+CFLAGS          =       -w -DDM_PARALLEL -DWRF_RSL_IO $(ARCHFLAGS) \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       $(FCOPTIM) -convert big_endian CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) -DGRIB1 CONFIGURE_GRIB2_FLAG
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share : 
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+	  FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" archive)
+
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCFLAGS) -w" FIXED="-fixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS="$(CFLAGS)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_initialize_real.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+module_dm.o : module_dm.F
+module_configure.o : module_configure.F
+
+module_configure.o \
+module_dm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) -g -O0 $*.f90
+
+###########################################################
+
+#ARCH NEC SUPER-UX SX-6 (serial)
+
+#***** some sx f90 compiler options***********
+# -V : version # of f90 command to stderr
+#-EP : activate cpp preprocessor to perform conditional compiling: output as i.[filename]
+#-Ep: activate cpp preprocessor to perfomr conditional compiling
+   #****However, cpp also activated by using .F or .F90 suffixes...
+# -Wf: specifies option string of the f90/sx detailed options
+#-g: debug info generated in object file for dbx symbolic debugging
+# -ew : all numbers size=8bytes
+#-eW: 4 bytes
+# -float0: default and only -float(number) option for sx6
+# -USX: unname the prev. defined reserved symbol SX of the preprocessor
+   # -U overrides -D, so '-USX  -D$(RUNTIMESYSTEM)'  might be redundant
+# -p: object file in execution format corresp. to 'prof' command be generated
+# -f4: input source program is described in F90 standard free format
+# -w: only syntax diagnostic messages at the fatal level are output
+# -C: specifies compile mode
+#   ssafe: only safe optimization in scalar mode (minimize side effects of 
+#          opt. no loop unrolling, etc
+# -init : init stack and heap areas
+# -L fmtlist summary stdout: formatted list, transformation lists, summary list are output to stdout
+
+RUNTIME_SYSTEM	=	sx
+MPP_TARGET	=	$(RUNTIME_SYSTEM)
+FC		=	f90
+SFC		=	$(FC)
+CC		=	cc
+SCC		=	$(CC)
+LD		=	$(FC)
+NATIVE_RWORDSIZE =      8
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS	=	-DNETCDF -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DIWORDSIZE=8 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=8 -DLIMIT_ARGS -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+		##for DM compilation	-DDM_PARALLEL -DRSL 
+# note:  -ew already does this for SX6, see comments above
+PROMOTION	=	
+CFLAGS		=	$(ARCHFLAGS)
+#CFLAGS		=	$(ARCHFLAGS) -DMPI -Dvpp -I../external/RSL/RSL
+
+FCFLAGS		=	-w -Ep -C ssafe \
+			-sx6 -USX -ew -D$(RUNTIME_SYSTEM) -I$(LIBINCLUDE) -I../inc -f4 
+		#	-Wf"-init stack=zero heap=zero" 
+		#         -Wf"-L transform fmtlist summary stdout" -g
+FCDEBUG         =       # -g
+FCBASEOPTS	=	$(FCFLAGS) -w
+
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  \
+                        -I../external/esmf_time_f90 -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       -L../external/io_netcdf -lwrfio_nf -L/usr/local/netcdf/current/lib -lnetcdf -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                     #   -L../external/RSL/RSL -lrsl \
+			-L../external/esmf_time_f90 -lesmf_time \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o
+
+#-lmpi for 4byte storage, -lmpiw for 8 byte storage 
+#LDOPTIONS	=	-lmpiw -ew 
+CPP		=	/lib/cpp 
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF) $(ARCHFLAGS)
+#CPPFLAGS = -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL  `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) -DSYSTEM_CALL_OK -DMPI -Dvpp
+
+MAX_PROC = 8
+MAKE = make -i -r
+AWK = awk
+SED = sed
+CAT = cat
+CUT = cut
+EXPAND = expand
+AR = ar ru
+M4 = m4 -B14000
+RANLIB = ar ru     
+NETCDFPATH = /usr/local/netcdf/current
+CC_TOOLS        =       $(CC)
+ARCH_OBJS = milliclock.o
+ASSUME_HOMOGENEOUS_ENVIRONMENT = 1
+FLIC_MACROS = LMvpp.m4 -B 14000
+VECTOR = 1
+
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int  esmf_time  module_dm.F
+	( /sbin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F:
+	( /sbin/cp module_dm_warning module_dm.F ; \
+	  cat module_dm_stubs.F  >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=/usr/local/netcdf/current FC="$(FC) $(PROMOTION) $(FCFLAGS)"  )
+
+
+wrfio_int :
+	( cd ../external/io_int ; \
+	  make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" archive)
+
+esmf_time :
+	( cd ../external/esmf_time_f90 ;\
+ 	make FC="$(FC) $(PROMOTION) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) $(CPPFLAGS) -I../../inc " )
+
+#sx : uses makefile.sx in the directory
+#../external/RSL/RSL/librsl.a :
+#	(cd ../external/RSL/RSL ; \
+#	make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sx )
+#
+#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+   
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                             \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o  start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL, SGI MPI, Intel MKL, allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#  Change MKL_HOME if Intel's MKL is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_DOMAINS       = 7
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+MKL_HOME          = /usr/lib
+# MKL_HOME          = /sw/sdev/mkl/7.2.008/mkl72/lib/64
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -no-gcc -DDM_PARALLEL -DWRF_RSL_IO \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL  -DDM_PARALLEL -DIWORDSIZE=4 \
+                    -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                    -DLIMIT_ARGS -DIFORT_KLUDGE -DINTELMKL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL/RSL -lrsl \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time \
+                    -L$(MKL_HOME) -lvml -lmkl_ipf
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" \
+          FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make IDIR="-I$(MPI_HOME)/include" \
+	 MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+	 LEARN_BCAST=-DLEARN_BCAST altix )
+
+# compile these without high optimization to speed compile
+module_configure.o : module_configure.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+
+module_configure.o \
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL_LITE, VMI, SGI MPI, Intel MKL, Allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#  Change MKL_HOME if Intel's MKL is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+MKL_HOME          = /usr/lib
+# MKL_HOME          = /sw/sdev/mkl/7.2.008/mkl72/lib/64
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -DDM_PARALLEL -I../external/RSL_LITE \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DRSL_LITE -DDM_PARALLEL \
+                    -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF \
+                    -DINTELMKL
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL_LITE -lrsl_lite \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time \
+                    -L$(MKL_HOME) -lvml -lmkl_ipf
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='icc -I. -w -O3 -DMPI2_SUPPORT -I$(MPI_HOME)/include '\
+	 FC='ifort -w -O3 -I../../.. ' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_dm.o : module_dm.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL, SGI MPI, allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_DOMAINS       = 7
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -no-gcc -DDM_PARALLEL -DWRF_RSL_IO \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM           = -O3 -unroll0 
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL  -DDM_PARALLEL -DIWORDSIZE=4 \
+                    -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                    -DLIMIT_ARGS -DIFORT_KLUDGE
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL/RSL -lrsl \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" \
+          FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)"\
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)"\
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)"\
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make IDIR="-I$(MPI_HOME)/include" \
+	 MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) \
+	 LEARN_BCAST=-DLEARN_BCAST altix )
+
+# compile these without high optimization to speed compile
+module_configure.o : module_configure.F
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+
+module_configure.o \
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort DM-Parallel (RSL_LITE, VMI, SGI MPI, Allows nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#  Change MPI_HOME if SGI's MPI is not in the default directories
+#
+#  Process pinning should be used -- set the environment
+#  variable MPI_DSM_DISTRIBUTE on a dedicated system, when
+#  running through the cpuset command, or when using a batch
+#  scheduler that has dynamic cpuset support enabled.  In
+#  other cases, if specific processors are known to be free,
+#  the environment variable MPI_DSM_CPULIST may be used
+#  (details in 'man mpi').
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL        = 1
+INCLUDE           = ../external/io_netcdf/
+MAX_PROC          = 1024
+MPI_HOME          = /usr
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz -DDM_PARALLEL -I../external/RSL_LITE \
+                    -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DRSL_LITE -DDM_PARALLEL \
+                    -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/RSL_LITE -lrsl_lite \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    -L../external/io_int -lwrfio_int \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L$(MPI_HOME)/lib -lmpi -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../io_phdf5 ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC='icc -I. -w -O3 -DMPI2_SUPPORT -I$(MPI_HOME)/include '\
+	 FC='ifort -w -O3 -I../../.. ' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_wrf.o : module_io_wrf.F
+module_dm.o : module_dm.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort compiler (OpenMP, no nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+# Set up only for idealized experiments
+#
+OMP               = -openmp
+OMPCPP            = -D_OPENMP
+INCLUDE           = ../external/io_netcdf/
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz 
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf $(OMP) \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/io_int -lwrfio_int \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip $(OMP) CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) $(OMPCPP) \
+                    -I$(INCLUDE) -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF wrfio_int module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc )
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../io_phdf5 ; \
+#	/bin/cp wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_dm.o : module_dm.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+module_bl_mrf.o: module_bl_mrf.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o module_bl_mrf.o                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH   SGI Altix, Intel Itanium2 ia64 Linux, ifort compiler (Single-processor, no nesting)
+#
+#  'setenv F_UFMTENDIAN big' in run scripts not necessary
+#  since -convert big_endian is in FCBASEOPTS
+#
+#  Adding -mP3OPT_ecg_lra_switch=T to the compiler options for
+#  modules/routines that take a long time to compile but do not
+#  significantly contribute to the total runtime performance is 
+#  appropriate.  Temporary suggestion for 2.1.1, Nov 2005.
+#
+# Contributed settings from Gerardo Cisneros, SGI
+#
+INCLUDE           = ../external/io_netcdf/
+FC                = ifort -I..
+LD                = ifort
+CC                = icc -I.
+SCC                = icc -I.
+CC_TOOLS          = cc
+SFC               = ifort
+CFLAGS            = -w -O3 -unroll0 -ip -tpp2 -c -ftz 
+FCOPTIM           = -O3 -unroll0
+FCDEBUG           = # -g
+FCBASEOPTS        = -w -ip -tpp2 -ftz -FR -convert big_endian $(FCDEBUG) \
+                     -fno-alias -fno-fnalias -align all -IPF_fp_relaxed \
+                     -I$(INCLUDE) -I. 
+FCFLAGS           = $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS         = -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES   = -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                    -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL              = perl
+REGISTRY          = Registry
+LIB               = -L../external/io_netcdf -lwrfio_nf \
+                    CONFIGURE_NETCDF_LIB_PATH \
+                    -L../external/io_int -lwrfio_int \
+                    -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                    -L../external/io_grib_share -lio_grib_share \
+                    ../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                    -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS           = -O3 -ip  CONFIGURE_LDFLAGS
+CPP               = /lib/cpp -C -P -traditional
+POUND_DEF         = -DNO_RRTM_PHYSICS  -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS          = -I$(LIBINCLUDE) -C -P -traditional $(COREDEFS) $(ARCHFLAGS) \
+                    -I$(INCLUDE) -C -P `cat ../inc/dm_comm_cpp_flags` \
+                    $(POUND_DEF) $(COREDEFS)
+AR                = ar ru
+M4                = m4 -B 14000
+RANLIB            = ranlib
+NETCDFPATH	  = CONFIGURE_NETCDF_PATH
+
+externals : CONFIGURE_WRFIO_NF wrfio_int module_dm.F wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; \
+          cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+          make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC) -I../.. $(FCFLAGS)" \
+          TRADFLAG="-traditional" RANLIB="$(RANLIB)" ; \
+	/bin/cp ../ioapi_share/wrf_io_flags.h ../ioapi_share/wrf_status_codes.h ../../inc )
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../io_phdf5 ; \
+#	/bin/cp wrf_io_flags.h ../io_quilt )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" TRADFLAG="-traditional" RANLIB="$(RANLIB)" \
+          FC="ifort -I$(MPI_HOME)/include $(FCDEBUG) $(FCFLAGS)" FIXED="-fixed" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(FCDEBUG) $(FCFLAGS)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+mediation_integrate.o : mediation_integrate.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_histout.o : wrf_histout.F
+wrf_restartout.o : wrf_restartout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_histin.o : wrf_histin.F
+wrf_restartin.o : wrf_restartin.F
+module_initialize_real.o: module_initialize_real.F
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_dm.o : module_dm.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+start_domain.o : start_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+module_configure.o : module_configure.F
+
+mediation_integrate.o mediation_interp_domain.o mediation_feedback_domain.o \
+module_configure.o                                              \
+wrf_auxinput1out.o wrf_histout.o wrf_restartout.o wrf_inputin.o \
+wrf_auxinput1in.o wrf_histin.o wrf_restartin.o module_initialize_real.o \
+module_domain.o module_dm.o module_io_wrf.o start_domain.o solve_interface.o \
+shift_domain_em.o                                              \
+mediation_force_domain.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) -O0 $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH   UNICOS/mp  machine crayx1 (RSL_LITE, MPI, MSP mode)
+#
+#  Cray X1 (RSL_LITE, MPI, MSP mode)
+#  For CSD mode set numtiles=4 in &domains section
+#  in namelist.input for best MSP efficiency.
+#
+DMPARALLEL      =       1
+MAX_PROC         =       1024
+FC              =       ftn
+SFC		=	$(FC)
+LD              =       ftn
+CC              =       cc
+SCC		=	$(CC)
+
+#### Override default sed command and script for Fortran source files ####
+#### This sed script converts !$OMP directives to !csd$ directives ####
+SED_FTN = sed -f ../arch/cray_csd.sed
+
+## Use these for X1 cross compiler to build Registry
+##X1_CROSS_COMP = "gcc"
+##X1_CROSS_CFLG = ""
+## Use these for X1 native (trigger) compiler
+X1_CROSS_COMP = "cc"
+X1_CROSS_CFLG = "-hcommand"
+CC_TOOLS        = 	$(X1_CROSS_COMP) $(X1_CROSS_CFLG)
+
+RWORDSIZE         = $(NATIVE_RWORDSIZE)
+FCDEBUG         =       # -g
+FCBASEOPTS      =       -f free -N 255 -I. -x omp -dy
+FCFLAGS_LOWOPT  =       $(FCBASEOPTS) -O1
+FCFLAGS         =       $(FCBASEOPTS) -Ofp3 -O3 -Ogen_private_callee
+#if using 64bit precision
+#PROMOTION	=	-sreal64 -dp -sinteger32
+CFLAGS          =       -I../external/RSL_LITE -DMAXDOM_MAKE=$(MAX_DOMAINS) \
+                        -DMAXPROC_MAKE=$(MAX_PROC) -DDM_PARALLEL -UCRAY -DLANDREAD_STUB -Dcrayx1
+
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../inc \
+			-p./ -p../external/io_netcdf -p../external/io_int -p../frame \
+                        -p../frame -p../share -p../phys -p../chem \
+                        -p../dyn_em -p ../external/esmf_time_f90
+ARCHFLAGS       =       -DRSL_LITE -DDM_PARALLEL -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) \
+                        -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO \
+			-DLIMIT_ARGS -Dcrayx1
+
+PERL            =       perl
+REGISTRY        =       Registry
+
+LIB             =       -L../external/io_netcdf -lwrfio_nf CONFIGURE_NETCDF_LIB_PATH \
+			-L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_int -lwrfio_int  \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o \
+			-L../external/esmf_time_f90 -lesmf_time -lmalloc
+
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+LDFLAGS         =       
+
+CPP		=	cpp -C -P -Dcrayx1
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS) # -DNO_NAMELIST_PRINT
+CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE `cat ../inc/dm_comm_cpp_flags` $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP) -Dcrayx1" FC="$(FC) $(PROMOTION) -f free -N 255 " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) -f free -N 255" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP) -Dcrayx1" FC="$(FC) $(PROMOTION) -f free -N 255" archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC) -UCRAY" CPP="$(CPP) -Dcrayx1" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) -f free -N 255" archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC) -UCRAY" CPP="$(CPP) CONFIGURE_GRIB2_INC -Dcrayx1" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) -f free -N 255" archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) -f free -N 255" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CFLAGS="$(CFLAGS)" CC="$(CC)" FC="$(SFC) $(PROMOTION) $(FCFLAGS)" \
+                                     MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+solve_em.o : solve_em.F
+solve_interface.o : solve_interface.F
+wrf_restartout.o : wrf_restartout.F
+wrf_restartin.o : wrf_restartin.F
+input_wrf.o : input_wrf.F
+output_wrf.o : output_wrf.F
+
+module_io_mm5.o module_si_io.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o start_domain.o \
+mediation_interp_domain.o \
+mediation_force_domain.o \
+module_configure.o solve_em.o \
+input_wrf.o output_wrf.o \
+solve_interface.o wrf_restartout.o wrf_restartin.o \
+convert_nmm.o    :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS_LOWOPT) $(MODULE_DIRS)  $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600	32bit   (single-threaded, no nesting)
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600	32bit   (single-threaded, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL	=	1
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DWRF_RSL_IO -DRSL -DINTIO -DLIMIT_ARGS \
+                        -DDM_PARALLEL -DFLOATSAFE -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL/ -lrsl -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+MAX_PROC	=	1
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a gen_comms.c wrfio_int module_dm.F esmf_time 
+
+gen_comms.c : ../external/RSL/gen_comms.c
+		( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+		  cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	  make CC="$(CC)" CFLAGS=" -DSTUBS +O3 " FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	Itanium2	(single-threaded, no nesting)
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DSitanium2 -DNOUNDERSCORE
+FCOPTIM         =       +O3 +Odataprefetch +Olibcalls +DO11.23 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DSitanium2 +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	Itanium2	(single-threaded, nesting using RSL without MPI)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+OMP             =       
+OMPCPP          =       
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DWRF_RSL_IO -DRSL -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DSTUBMPI
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DSitanium2 -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +DSitanium2 +Odataprefetch +Olibcalls +DO11.23 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DSitanium2 +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600		32bit   (openmp, no nesting)
+#
+OMP             =      	+Oopenmp 
+OMPCPP          =       -D_OPENMP
+FC              =       f90
+SFC		=	$(FC)
+LD              =       f90
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	PA8600	 DM-Parallel	(RSL, MPICH, nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL	=	1
+MAX_PROC	=	1024
+OMP             =       
+OMPCPP          =       
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4  -DDM_PARALLEL -DRSL \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DS2.0a -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +DA2.0N +DS2.0a +Odataprefetch +Olibcalls +DO11.0EP9806 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DS2.0a +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST hp )
+
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH	HP-UX	Itanium2    DM-Parallel	(RSL, MPICH, nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL	=	1
+MAX_PROC	=	1024
+OMP             =       
+OMPCPP          =       
+FC              =       mpif90
+SFC		=	f90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	cc
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+ARCHFLAGS       =       CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DLIMIT_ARGS -DFLOATSAFE \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4  -DDM_PARALLEL -DRSL \
+			-DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       $(ARCHFLAGS) +DSitanium2 -DNOUNDERSCORE -I../external/RSL/RSL
+FCOPTIM         =       +O3 +Odataprefetch +Olibcalls +DO11.23 +noppu \
+			+save +fastallocatable +Ofltacc +extend_source +source=free +FPD
+FCDEBUG         =       # -g
+FCBASEOPTS      =       +U77 +source=free -I. +DSitanium2 +noppu +Onoopenmp $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/io_int -lwrfio_int -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCOPTIM) $(OMP) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /lib/cpp -C -P
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B14000
+RANLIB          =       echo
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int ../external/RSL/RSL/librsl.a gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; \
+	cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) " )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(CC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive)
+
+wrfio_grib1 : 
+	( cd ../external/io_grib1 ; \
+          make CC="$(CC)" CPP="$(CPP)" RANLIB="$(RANLIB)" \
+          FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+wrfio_grib2 : 
+	( cd ../external/io_grib2 ; \
+          make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS) -I../../inc " archive )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; \
+	make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST hp )
+
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+mediation_integrate.o : mediation_integrate.F
+start_domain.o : start_domain.F
+module_configure.o : module_configure.F
+
+solve_interface.o \
+shift_domain_em.o                                              \
+module_configure.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o \
+module_initialize_real.o module_dm.o mediation_integrate.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCFLAGS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH Darwin		(single-threaded, no nesting)
+#     
+#     Using -qfloat=nomaf option can result in identical results with
+#           non-optimized and optimized results (suggested by Fovell of UCLA)
+#           One may turn on by uncommenting it in FCOPTIM line
+#
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+#CC              =       cc_r
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       = $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DLANDREAD_STUB -I /usr/include/sys -DMACOS
+FCOPTIM         =       -O3 -qarch=auto #-qfloat=nomaf
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 -w 
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DLANDREAD_STUB -DMAC_KLUDGE
+#			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DMACOS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+#LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv 
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+
+LDFLAGS         =	 -Wl,-stack_size,10000000,-stack_addr,0xc0000000 CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+#CPP             =       /opt/ibmcmp/xlf/8.1/exe/cpp -C -P
+CPP             =       /usr/bin/cpp  -C -P -xassembler-with-cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF) 
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -qfree=f90 -qspillsize=32767 -I. $(PROMOTION) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+solve_em.o : solve_em.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+shift_domain_em.o                                              \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_em.o \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+###########################################################
+#ARCH Darwin		(OpenMP, no nesting)
+#     
+#     Using -qfloat=nomaf option can result in identical results with
+#           non-optimized and optimized results (suggested by Fovell of UCLA)
+#           One may turn on by uncommenting it in FCOPTIM line
+#
+OMP             =       -qsmp=noauto
+OMPCPP          =       -D_OPENMP
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+CC              =       cc
+SCC		=	$(CC)
+RWORDSIZE       = $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DLANDREAD_STUB -I /usr/include/sys -DMACOS
+FCOPTIM         =       -O2 -qarch=auto -qunroll=yes #-qfloat=nomaf
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -w -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 #-qflttrap=zerodivide:invalid:enable -qsigtrap
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DLANDREAD_STUB -DMACOS -DMAC_KLUDGE
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -lxlsmp \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =	$(OMP) -Wl,-stack_size,10000000,-stack_addr,0xc0000000  CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =        /usr/bin/cpp -C -P -xassembler-with-cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(OMPCPP) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+
+module_configure.o : module_configure.F
+module_domain.o   : module_domain.F
+module_sm.o 	: module_sm.F
+module_tiles.o	: module_tiles.F
+solve_em.o	: solve_em.F
+solve_exp.o	: solve_exp.F
+convert_nmm.o   : convert_nmm.F
+
+module_configure.o module_sm.o module_tiles.o solve_em.o solve_exp.o convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(OMP) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt -qnohot $*.f90
+
+module_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F90 > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c -g $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) -qnoopt -qnohot $*.f90
+
+###########################################################
+#ARCH Darwin		(single-threaded, no nesting, USES: gcc-3.3, xlf cpp, SystemStubs)
+#     
+#     Using -qfloat=nomaf option can result in identical results with
+#           non-optimized and optimized results (suggested by Fovell of UCLA)
+#           One may turn on by uncommenting it in FCOPTIM line
+#
+FC              =       xlf90_r
+SFC		=	$(FC)
+LD              =       xlf90_r
+#CC              =       cc_r
+CC              =       gcc-3.3
+SCC		=	$(CC)
+RWORDSIZE       = $(NATIVE_RWORDSIZE)
+PROMOTION	=	-qrealsize=$(RWORDSIZE) -qintsize=4
+CFLAGS          =       -DNOUNDERSCORE -DLANDREAD_STUB -I /usr/include/sys -DMACOS
+FCOPTIM         =       -O3 -qarch=auto #-qfloat=nomaf
+FCDEBUG         =       # -qnoopt -qfullpath
+FCBASEOPTS      =       -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 -w 
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+FCSUFFIX        =       -qsuffix=f=f90
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                        CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DLANDREAD_STUB -DMAC_KLUDGE
+#			-DLIMIT_ARGS -DNO_NAMELIST_PRINT -DNATIVE_MASSV -DMACOS
+PERL            =       CONFIGURE_PERL_PATH
+REGISTRY        =       Registry
+#LIB             =       CONFIGURE_NETCDF_LIB_PATH -lmass -lmassv 
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_int -lwrfio_int \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+
+LDFLAGS         =	 -Wl,-stack_size,10000000,-stack_addr,0xc0000000 CONFIGURE_LDFLAGS -L/usr/lib -lSystemStubs
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /opt/ibmcmp/xlf/8.1/exe/cpp -C -P
+#CPP             =       /usr/bin/cpp  -C -P -xassembler-with-cpp
+POUND_DEF	=	-DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(COREDEFS) $(ENVCOMPDEFS) $(POUND_DEF) 
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) -qarch=auto -qzerosize" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC -qcpluscmt" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCSUFFIX) -qarch=auto -qzerosize" FREE="" FIXED="-qfixed" archive)
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+solve_interface.o : solve_interface.F
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $*.f90
+	$(FC) -c -qfree=f90 -qspillsize=32767 -I. $(PROMOTION) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+# compile these without high optimization to speed compile
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+solve_em.o : solve_em.F
+mediation_interp_domain.o : mediation_interp_domain.F
+mediation_force_domain.o : mediation_force_domain.F
+mediation_feedback_domain.o : mediation_feedback_domain.F
+convert_nmm.o : convert_nmm.F
+module_configure.o : module_configure.F
+
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_initialize_real.o module_dm.o \
+shift_domain_em.o                                              \
+mediation_interp_domain.o \
+module_configure.o                                             \
+solve_em.o \
+convert_nmm.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PathScale 2.1 or higher (Single-threaded, no nesting)
+#
+FC              =       pathf90
+LD              =       pathf90
+CC              =       pathcc
+SCC             =       $(CC)
+NATIVE_RWORDSIZE=       4
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION       =       -r$(RWORDSIZE) -i4
+CFLAGS          =       
+FCOPTIM         =       -O3 -OPT:Ofast:Olimit=5000
+FCDEBUG         =       #-g
+FCBASEOPTS      =       -w -byteswapio -freeform -fno-second-underscore $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+                        -DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       $(FCFLAGS) -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS     =       CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF       =       $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+                                                                                
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+                                                                                
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w -fno-second-underscore" TRADFLAG="-traditional" )
+                                                                                
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" archive )
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+	make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+	make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_int :
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+	TRADFLAG="-traditional" all )
+                                                                                
+esmf_time :
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+                                                                                
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_configure.o : module_configure.F
+                                                                                
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_fddaobs_rtfdda.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), PathScale 2.1 or higher DM-Parallel   (RSL_LITE, PathScale MPICH, No periodic LBCs)
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=pathf90
+LD              =       mpif90 -f90=pathf90
+CC              =       mpicc  -cc=pathcc
+SCC             =       pathcc
+SFC             =       pathf90
+NATIVE_RWORDSIZE=	4
+RWORDSIZE	=	$(NATIVE_RWORDSIZE)
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM         =       -O3 -OPT:Ofast:Olimit=5000
+FCDEBUG         =       #-g
+FCBASEOPTS      =       -w -byteswapio -freeform -fno-second-underscore $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+EXTRAMODULES    =
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        -L../external/io_int -lwrfio_int \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       -byteswapio
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF       =       -DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       pathcc
+                                                                                
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+                                                                                
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+                                                                                
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+                                                                                
+#io_flags:
+#	( cd ../external/io_netcdf ; make flags_only ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc ; \
+#	/bin/cp wrf_io_flags.h wrf_status_codes.h ../io_phdf5 )
+                                                                                
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH CPP="$(CPP)" FC="$(FC)" TRADFLAG="-traditional" \
+	FFLAGS='$(FCFLAGS) -I../../inc -ICONFIGURE_NETCDF_PATH/include -w -fno-second-underscore' RANLIB=$(RANLIB) )
+                                                                                
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" TRADFLAG="-traditional" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" archive )
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+	make CC="$(CC)" CPP="$(CPP)" FC="$(SFC) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" RANLIB=$(RANLIB) archive )
+                                                                                
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+	make CC="$(CC)" CPP="$(CPP) CONFIGURE_GRIB2_INC" FC="$(SFC) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" RM="$(RM)" RANLIB=$(RANLIB) archive )
+                                                                                
+wrfio_int : 
+	( cd ../external/io_int ; \
+	make CC="$(CC)" CPP="$(CPP)" FC="$(SFC) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" RANLIB=$(RANLIB) all )
+                                                                                
+esmf_time :
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(FCDEBUG) $(FCBASEOPTS) " CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+                                                                                
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC='mpif90 $(FCFLAGS) -byteswapio' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+                                                                                
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_configure.o : module_configure.F
+                                                                                
+solve_interface.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_fddaobs_rtfdda.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    Cray XT3 Catamount/Linux x86_64 (Opteron), PGI 5.2 or higher DM-Parallel (RSL_LITE, MPICH, Allows nesting, Periodic in X only )
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       ftn
+LD              =       ftn
+CC              =       gcc -DMPI2_SUPPORT
+SCC		=	gcc
+SFC             =       mpif90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE \
+                        -DLANDREAD_STUB -DXT3_Catamount -I$(MPICH_DIR)/include
+FCOPTIM         =       -O3 -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DLANDREAD_STUB -DNO_NAMELIST_PRINT -DXT3_Catamount
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o \
+                        -L../external/esmf_time_f90 -lesmf_time 
+# add this to LIB to use XT3 iobuf library after loading iobuf module, also requires
+# properly built netCDF library that includes iobuf
+#                       $(IOBUF_POST_LINK_OPTS)
+LDFLAGS         =       -byteswapio CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       gcc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC) $(CFLAGS)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+solve_em.o : solve_em.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+solve_em.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    NEC SX-8, NEC SX cross compiler DM-Parallel (RSL, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       sxmpif90
+LD              =       sxmpif90
+CC              =       sxmpic++
+SCC		=	sxmpic++
+SFC             =       sxmpif90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	
+CFLAGS          =       -DNCARIBM_NOC99 -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL
+FCOPTIM		=	
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -f4 -Wf,-P i $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time -L$(SX_BASE_CPLUS)/lib -lcpp
+LDFLAGS         =       $(FCFLAGS) -Wl,-h nodefs CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) -DNEC
+AR_BASE         =       sxar
+AR              =       $(AR_BASE) ru
+M4              =       m4 -B 14000
+RANLIB          =       sxar rs
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib1 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" AR="$(AR_BASE)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sx )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#	if [ ! -e $@ ] ; then \
+#	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+
+###########################################################
+#ARCH    NEC SX-8, NEC SX cross compiler DM-Parallel (RSL_LITE, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       sxmpif90
+LD              =       sxmpif90
+CC              =       sxmpic++
+SCC		=	sxmpic++
+SFC             =       sxmpif90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	
+CFLAGS          =       -DNCARIBM_NOC99 -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM		=	
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -f4 -Wf,-P i $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time -L$(SX_BASE_CPLUS)/lib -lcpp
+LDFLAGS         =       $(FCFLAGS) -Wl,-h nodefs CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF) -DNEC
+AR_BASE         =       sxar
+AR              =       $(AR_BASE) ru
+M4              =       m4 -B 14000
+RANLIB          =       sxar rs
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib1 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" AR="$(AR_BASE)" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" AR="$(AR_BASE)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST AR="$(AR_BASE)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#	if [ ! -e $@ ] ; then \
+#	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+#	if [ ! -e $@ ] ; then \
+#	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#	fi
+
+
+###########################################################
+#ARCH    CYGWIN_NT-5.1 Cygwin i486 i586 i686, g95 compiler  (Single-threaded, no nesting)
+#
+FC              =       g95
+LD              =       g95
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+# g95 does not like -r8. if you want -r8, just add it to PROMOTION below
+#PROMOTION	=	-r$(RWORDSIZE) -i4
+PROMOTION	=	-i4
+CFLAGS          =
+FCOPTIM		=	-O2
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -Wno=101,139,155,158 -fno-second-underscore -fendian=big -ffree-form $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DG95
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -fmod=../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux i486 i586 i686, g95 compiler  (Single-threaded, no nesting)
+#
+FC              =       g95
+LD              =       g95
+CC              =       gcc
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+# g95 does not like -r4. if you want promotion to -r8 add it to PROMOTION below
+#PROMOTION	=	-r$(RWORDSIZE) -i4
+PROMOTION	=	-i4
+CFLAGS          =       
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g -O0
+FCBASEOPTS      =       -Wno=101,139,155,158 -fno-second-underscore -fendian=big -ffree-form $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         CONFIGURE_NETCDF_FLAG -DGRIB1 CONFIGURE_GRIB2_FLAG \
+			-DLIMIT_ARGS -DG95
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -fmod=../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       $(CC)
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH     PC Linux i486 i586 i686, g95 compiler  DM-Parallel (RSL_LITE, MPICH, Allows nesting)
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90 -f90=g95
+LD              =       mpif90 -f90=g95
+CC              =       mpicc -cc=gcc
+SCC		=	gcc
+SFC             =       g95
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+# g95 does not like -r4. if you want promotion to -r8 add it to PROMOTION below
+#PROMOTION      =       -r$(RWORDSIZE) -i4
+PROMOTION       =       -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g -O0
+FCBASEOPTS      =       -Wno=101,139,155,158 -fno-second-underscore -fendian=big -ffree-form $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNMM_NEST=$(WRF_NMM_NEST) -DG95
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -fmod=../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+#### Override default sed command and script for Fortran source files         ####
+#### This sed script does not pass __FILE__ and __LINE__ to wrf_error_fatal() ####
+#### because the Fortran compiler complains about long source lines.          ####
+SED_FTN = sed -f ../arch/no_file_line.sed
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(FCFLAGS) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and AMD Opteron), GNU Fortran compiler, DM-Parallel  (RSL, MPICH, Allows nesting)
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+LD              =       mpif90
+CC              =       mpicc
+SCC             =       gcc
+SFC             =       gfortran -cpp
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION       =       
+CFLAGS          =       -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL \
+                        -DLANDREAD_STUB
+FCOPTIM         =       #-Mipa=fast
+FCDEBUG         =       #-g
+FCBASEOPTS      =       -w $(FCDEBUG) -ffree-form -ffree-line-length-none
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+                        -DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -J../main -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+                        -L../external/io_int -lwrfio_int \
+                        ../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time
+LDFLAGS         =       CONFIGURE_LDFLAGS
+ENVCOMPDEFS     =       CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF       =       -DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH      =       CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+	cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_int :
+	( cd ../external/io_int ; \
+	make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+	make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+	make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+	make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+esmf_time :
+	( cd ../external/esmf_time_f90 ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" FC="$(FC) $(PROMOTION)" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST linux )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH    PC Linux x86_64 (IA64 and Opteron), GNU Fortran compiler   (Single-threaded, RSL, Allows nesting)
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       gfortran -cpp
+LD              =       gfortran -cpp
+CC              =       gcc
+SCC		=	$(CC)
+SFC             =       gfortran -cpp
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+FCOPTIM		=       #-O3 -funroll-loops #-ftree-vectorize -ftree-loop-linear
+FCDEBUG		=	#-g
+FCBASEOPTS      =       -fno-second-underscore -w $(FCDEBUG) -ffree-form -ffree-line-length-none -fconvert=big-endian -frecord-marker=4
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 -DINTIO -DWRF_RSL_IO -DRSL -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DSTUBMPI
+PROMOTION	=
+CFLAGS          =       -DLANDREADSTUB -DDM_PARALLEL -DWRF_RSL_IO \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL/RSL $(ARCHFLAGS)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -J../main -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl \
+                        -L../external/io_grib1 -lio_grib1 \
+			-L../external/io_int -lwrfio_int \
+			-L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS -fconvert=big-endian
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH  -lnetcdf  -lnetcdff 
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 ../external/RSL/RSL/librsl.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL/RSL/librsl.a :
+	( cd ../external/RSL/RSL ; make CC="$(CC)" CFLAGS='-DSTUBS' FC="$(FC) $(PROMOTION)" FFLAGS='' MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST stub )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+
+###########################################################
+#ARCH     PC Linux x86_64 (IA64 and Opteron), GNU Fortran compiler  DM-Parallel (RSL_LITE, OpenMPI, Allows nesting)
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       mpif90
+LD              =       mpif90
+CC              =       mpicc
+SCC		=	gcc
+SFC             =       gfortran -cpp
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE
+FCOPTIM		=	
+FCDEBUG		=	
+FCBASEOPTS      =       -w $(FCDEBUG) -ffree-form -ffree-line-length-none -fconvert=big-endian -frecord-marker=4
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1 CONFIGURE_GRIB2_FLAG -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG \
+			-DLIMIT_ARGS -DNMM_NEST=$(WRF_NMM_NEST)
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       ESMFIOLIB
+ESMF_IO_LIB_EXT =       ESMFIOEXTLIB
+INCLUDE_MODULES =       -J../main -I../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                        CONFIGURE_GRIB2_LIB \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time 
+LDFLAGS         =       $(FCFLAGS) CONFIGURE_LDFLAGS -fconvert=big-endian
+ENVCOMPDEFS	=	CONFIGURE_COMPILEFLAGS
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	CONFIGURE_NETCDF_PATH
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes CONFIGURE_WRFIO_NF wrfio_grib_share wrfio_grib1 CONFIGURE_WRFIO_GRIB2 ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=CONFIGURE_NETCDF_PATH RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) CONFIGURE_GRIB2_INC" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(FCFLAGS) $(PROMOTION) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+module_configure.o                                             \
+mediation_integrate.o \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+##################################################################
+#ARCH  NULL
Index: trunk/WRF.COMMON/WRFV2/configure.wrf.backup
===================================================================
--- trunk/WRF.COMMON/WRFV2/configure.wrf.backup	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/configure.wrf.backup	(revision 2744)
@@ -0,0 +1,250 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	16384
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+SED_FTN = sed -f ../arch/standard.sed
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = 0
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = ../external/esmf_time_f90/module_utility.o
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        = 
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = -I../external/esmf_time_f90
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = 
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = esmf_time
+
+##############################################################################
+
+
+#### Architecture specific settings ####
+
+# Settings for PC Linux x86_64 (IA64 and Opteron), PGI compiler 5.2 or higher  (Single-threaded, no nesting)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc -DFSEEKO64_OK 
+SCC		=	$(CC)
+SFC             =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DLANDREAD_STUB
+FCOPTIM		=	-fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         -DNETCDF -DGRIB1  \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       -L../external/esmf_time_f90 -lesmf_time
+ESMF_IO_LIB_EXT =       -L../../external/esmf_time_f90 -lesmf_time
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       -L../external/io_netcdf -lwrfio_nf -L/donnees/emlmd/netcdf64/netcdf-3.6.1/lib -lnetcdf \
+                        -L../external/io_grib1 -lio_grib1 \
+                         \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../mars_lmd/libo -llmd
+# *** last line is the library for the LMD physics (must be prepared prior to the WRF compilation) ***
+LDFLAGS         =       
+ENVCOMPDEFS	=	
+WRF_CHEM	=	0 
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	/donnees/emlmd/netcdf64/netcdf-3.6.1
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes wrfio_nf wrfio_grib_share wrfio_grib1  wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=/donnees/emlmd/netcdf64/netcdf-3.6.1 RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) " RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+
+# These sub-directory builds are identical across all architectures
+wrfio_esmf :
+	( cd ../external/io_esmf ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " )
+
+
+#
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+#	There is probably no reason to modify these rules
+
+wrf_ioapi_includes :
+	( cd ../external/ioapi_share ; \
+	$(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" )
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.c.o:
+	$(RM) $@
+	$(CC) -c $(CFLAGS) $*.c
+
Index: trunk/WRF.COMMON/WRFV2/configure.wrf_MPICH
===================================================================
--- trunk/WRF.COMMON/WRFV2/configure.wrf_MPICH	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/configure.wrf_MPICH	(revision 2744)
@@ -0,0 +1,263 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	16384
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+SED_FTN = sed -f ../arch/standard.sed
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = 0
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = ../external/esmf_time_f90/module_utility.o
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        = 
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = -I../external/esmf_time_f90
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = 
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = esmf_time
+
+##############################################################################
+
+
+#### Architecture specific settings ####
+
+# Settings for PC Linux x86_64 (IA64 and Opteron), PGI 5.2 or higher DM-Parallel   (RSL_LITE, MPICH, Allows nesting, No periodic LBCs)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       $(WHERE_MPI)/mpif90
+LD              =       $(WHERE_MPI)/mpif90
+CC              =       $(WHERE_MPI)/mpicc -DMPI2_SUPPORT -DFSEEKO64_OK 
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE \
+                        -DLANDREAD_STUB
+FCOPTIM         =       -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1  -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       -L../external/esmf_time_f90 -lesmf_time
+ESMF_IO_LIB_EXT =       -L../../external/esmf_time_f90 -lesmf_time
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       -L../external/io_netcdf -lwrfio_nf -L/donnees/emlmd/netcdf64/netcdf-3.6.1/lib -lnetcdf -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                         \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time -L../mars_lmd/libo -llmd 
+LDFLAGS         =       -byteswapio 
+ENVCOMPDEFS	=	
+WRF_CHEM	=	0 
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	/donnees/emlmd/netcdf64/netcdf-3.6.1
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes wrfio_nf wrfio_grib_share wrfio_grib1  ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=/donnees/emlmd/netcdf64/netcdf-3.6.1 RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) " RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+
+
+# These sub-directory builds are identical across all architectures
+wrfio_esmf :
+	( cd ../external/io_esmf ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " )
+
+
+#
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+#	There is probably no reason to modify these rules
+
+wrf_ioapi_includes :
+	( cd ../external/ioapi_share ; \
+	$(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" )
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.c.o:
+	$(RM) $@
+	$(CC) -c $(CFLAGS) $*.c
+
Index: trunk/WRF.COMMON/WRFV2/configure.wrf_Mars
===================================================================
--- trunk/WRF.COMMON/WRFV2/configure.wrf_Mars	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/configure.wrf_Mars	(revision 2744)
@@ -0,0 +1,260 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	16384
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+SED_FTN = sed -f ../arch/standard.sed
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = 0
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = ../external/esmf_time_f90/module_utility.o
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        = 
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = -I../external/esmf_time_f90
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = 
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = esmf_time
+
+##############################################################################
+
+
+#### Architecture specific settings ####
+
+# Settings for PC Linux i486 i586 i686, PGI compiler  (Single-threaded, no nesting)
+#
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc -DFSEEKO64_OK 
+SCC		=	$(CC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+SFC             =       $(FC)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =
+FCOPTIM		=	-O2 # -fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG) # -Mlfs
+#FCBASEOPTS      =       -w -byteswapio -Mfree -Mipa=fast,inline,safe  $(FCDEBUG) # -Mlfs
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         -DNETCDF -DGRIB1  \
+			-DLIMIT_ARGS
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       -L../external/esmf_time_f90 -lesmf_time
+ESMF_IO_LIB_EXT =       -L../../external/esmf_time_f90 -lesmf_time
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../chem -I../inc
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       -L../external/io_netcdf -lwrfio_nf -L/home/aymeric/Software/netcdf_pgi/lib -lnetcdf \
+                        -L../external/io_grib1 -lio_grib1 \
+                         \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../mars_lmd/libo -llmd
+# *** last line is the library for the LMD physics (must be prepared prior to the WRF compilation) ***
+LDFLAGS         =       $(FCFLAGS) -byteswapio 
+ENVCOMPDEFS	=	
+WRF_CHEM	=	0 
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	$(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	/home/aymeric/Software/netcdf_pgi
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes wrfio_nf wrfio_grib_share wrfio_grib1  wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf : 
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=/home/aymeric/Software/netcdf_pgi RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive )
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) " RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive )
+
+wrfio_int : 
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 30 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 300 ; $(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 ; \
+#PGI	fi
+
+###########################################################
+
+# These sub-directory builds are identical across all architectures
+wrfio_esmf :
+	( cd ../external/io_esmf ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " )
+
+
+#
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+#	There is probably no reason to modify these rules
+
+wrf_ioapi_includes :
+	( cd ../external/ioapi_share ; \
+	$(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" )
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.c.o:
+	$(RM) $@
+	$(CC) -c $(CFLAGS) $*.c
+
Index: trunk/WRF.COMMON/WRFV2/configure.wrf_regular
===================================================================
--- trunk/WRF.COMMON/WRFV2/configure.wrf_regular	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/configure.wrf_regular	(revision 2744)
@@ -0,0 +1,250 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	16384
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+SED_FTN = sed -f ../arch/standard.sed
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = 0
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = ../external/esmf_time_f90/module_utility.o
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        = 
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = -I../external/esmf_time_f90
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = 
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = esmf_time
+
+##############################################################################
+
+
+#### Architecture specific settings ####
+
+# Settings for PC Linux x86_64 (IA64 and Opteron), PGI compiler 5.2 or higher  (Single-threaded, no nesting)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+FC              =       pgf90
+LD              =       pgf90
+CC              =       gcc -DFSEEKO64_OK 
+SCC		=	$(CC)
+SFC             =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DLANDREAD_STUB
+FCOPTIM		=	-fastsse #-Mipa=fast
+FCDEBUG		=	#-g 
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                         -DNETCDF -DGRIB1  \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       -L../external/esmf_time_f90 -lesmf_time
+ESMF_IO_LIB_EXT =       -L../../external/esmf_time_f90 -lesmf_time
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       -L../external/io_netcdf -lwrfio_nf -L/donnees/emlmd/netcdf64/netcdf-3.6.1/lib -lnetcdf \
+                        -L../external/io_grib1 -lio_grib1 \
+                         \
+                        -L../external/io_grib_share -lio_grib_share \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time \
+                        -L../mars_lmd/libo -llmd
+# *** last line is the library for the LMD physics (must be prepared prior to the WRF compilation) ***
+LDFLAGS         =       
+ENVCOMPDEFS	=	
+WRF_CHEM	=	0 
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	/donnees/emlmd/netcdf64/netcdf-3.6.1
+CC_TOOLS        =       $(CC)
+
+externals : wrf_ioapi_includes wrfio_nf wrfio_grib_share wrfio_grib1  wrfio_int module_dm.F esmf_time
+
+module_dm.F :
+	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=/donnees/emlmd/netcdf64/netcdf-3.6.1 RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) " RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" \
+          TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+
+# These sub-directory builds are identical across all architectures
+wrfio_esmf :
+	( cd ../external/io_esmf ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " )
+
+
+#
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+#	There is probably no reason to modify these rules
+
+wrf_ioapi_includes :
+	( cd ../external/ioapi_share ; \
+	$(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" )
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.c.o:
+	$(RM) $@
+	$(CC) -c $(CFLAGS) $*.c
+
Index: trunk/WRF.COMMON/WRFV2/custom_user.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/custom_user.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/custom_user.inc	(revision 2744)
@@ -0,0 +1,184 @@
+!---------------------------------------------
+!
+! custom_user.inc
+!
+! TOUTE MODIFICATION IMPLIQUE DE RECOMPILER
+! EN N'OUBLIANT PAS DE PRECEDER LA
+! COMPILATION DE :
+! "touch dyn_em/module_initialize_real.F"
+!
+!---------------------------------------------
+! cas où config_flags%adjust_heights est true
+!---------------------------------------------
+print *,  '**********************************'
+print *,  'PLEASE NOTE YOU ARE IN CUSTOM MODE'
+print *,  '**********************************'
+
+
+!!
+!! stuff for LES
+!!
+!
+!	 print *, 'setting uniform values and profiles'
+!        print *, 'u'
+!        print *, grid%em_u_gc(its+1,:,jts+1)
+!        print *, 'v'
+!        print *, grid%em_v_gc(its+1,:,jts+1)
+!        print *, 't'
+!        print *, grid%em_t_gc(its+1,:,jts+1)
+!        print *, 'p'
+!        print *, grid%em_rh_gc(its+1,:,jts+1)
+!        print *, 'geop'
+!        print *, grid%em_ght_gc(its+1,:,jts+1)
+!        print *, 'albedo'
+!        print *, grid%u10(its+1,jts+1)
+!        print *, 'thermal inertia'
+!        print *, grid%v10(its+1,jts+1)
+!        print *, 'topography'
+!        print *, grid%ht(its+1,jts+1)
+!        print *, 'toposoil'
+!        print *, grid%toposoil(its+1,jts+1)
+!        print *, 'surface temperature'
+!        print *, grid%tsk(its+1,jts+1)
+!        print *, 'surface pressure'
+!        print *, grid%psfc(its+1,jts+1)
+!        print *, grid%em_psfc_gc(its+1,jts+1)
+!
+!        DO j = jts, MIN(jte,jde-1)
+!         DO i = its, MIN(ite,ide-1)
+!                grid%em_u_gc(i,:,j)=grid%em_u_gc(its+1,:,jts+1)
+!                grid%em_v_gc(i,:,j)=grid%em_v_gc(its+1,:,jts+1)
+!                grid%em_t_gc(i,:,j)=grid%em_t_gc(its+1,:,jts+1)
+!                grid%em_rh_gc(i,:,j)=grid%em_rh_gc(its+1,:,jts+1)
+!                grid%em_ght_gc(i,:,j) = grid%em_ght_gc(its+1,:,jts+1)
+!                grid%u10(i,j) = grid%u10(its+1,jts+1)
+!                grid%v10(i,j) = grid%v10(its+1,jts+1)
+!                grid%ht(i,j) = grid%ht(its+1,jts+1)
+!                grid%toposoil(i,j) = grid%toposoil(its+1,jts+1)
+!                grid%tsk(i,j) = grid%tsk(its+1,jts+1)
+!                grid%psfc(i,j) = grid%psfc(its+1,jts+1)
+!                grid%em_psfc_gc(i,j) = grid%em_psfc_gc(its+1,jts+1)
+!          ENDDO
+!        ENDDO
+!
+!!!
+!!!
+!print *, 'u divided by 10'
+!grid%em_u_gc=grid%em_u_gc/10.
+!grid%em_v_gc=grid%em_v_gc/10.
+!!!
+!!!
+
+
+!!****************************
+!! CONSTANT THERMAL INERTIA
+!!****************************
+print *, 'fixed thermal inertia'
+
+DO j = jts, MIN(jte,jde-1)
+DO i = its, MIN(ite,ide-1)
+
+       grid%v10(i,j) = 85.    ! thermal inertia
+
+ENDDO
+ENDDO
+
+
+
+
+!!!******************************
+!!! IDEALIZED CRATER SIMULATION
+!!!******************************
+!print *, 'fixed albedo, thermal inertia, zonal and meridional wind'
+!
+!DO j = jts, MIN(jte,jde-1)
+!DO i = its, MIN(ite,ide-1)
+!
+!	grid%u10(i,j) = 0.19	! albedo
+!	grid%v10(i,j) = 315.	! thermal inertia
+!
+!	!! INPUT: LIKE A "SOUNDING"
+!	grid%em_u_gc(i,:,j)=grid%em_u_gc(int((MIN(ite,ide-1)-its)/2),:,int((MIN(jte,jde-1)-jts)/2))	! zonal wind
+!	grid%em_v_gc(i,:,j)=0.
+!!!grid%em_v_gc(int((MIN(ite,ide-1)-its)/2),:,int((MIN(jte,jde-1)-jts)/2))	! meridional wind
+!	!! INPUT: LIKE A "SOUNDING"
+!
+!ENDDO
+!ENDDO
+!
+!!!!!INVERSE WIND
+!!!grid%em_u_gc = -grid%em_u_gc
+!
+!
+!!! FIX for the STAGGERED SPECIFICITY
+!grid%em_u_gc(MIN(ite,ide-1)+1,:,:)=grid%em_u_gc(MIN(ite,ide-1),:,:)
+!grid%em_v_gc(:,:,MIN(jte,jde-1)+1)=grid%em_v_gc(:,:,MIN(jte,jde-1))
+!
+!
+!!! CHECK
+!print *, 'wind profile'
+!print *, 'took at ...', int((MIN(ite,ide-1)-its)/2), int((MIN(jte,jde-1)-jts)/2)
+!print *, '--zonal'
+!print *, grid%em_u_gc(int((MIN(ite,ide-1)-its)/2),:,int((MIN(jte,jde-1)-jts)/2))
+!print *, '--meridional'
+!print *, grid%em_v_gc(int((MIN(ite,ide-1)-its)/2),:,int((MIN(jte,jde-1)-jts)/2))
+!
+
+!!
+!! Later, sigma levels are changed to avoid extrapolation
+!! ... so no change in the pressure arrays is needed
+!!
+
+
+
+!!grid%u10 = grid%u10*0. + 0.19	! albedo
+!!grid%v10 = grid%v10*0. + 315.	! thermal inertia
+!!grid%em_u_gc = grid%em_u_gc*0. - 15.	! zonal wind
+!!grid%em_v_gc = grid%em_v_gc*0. 		! meridional wind
+!!
+!!grid%em_u_gc(:,1,:)=0.
+!!grid%em_v_gc(:,1,:)=0.
+
+
+!! TEST TRACERS
+!grid%scalar(its+10,1:10,jts+10,:)=10.
+
+
+!!!!!!!!!!!!!!!!!!!
+!!! READ PROFILE !!
+!!!!!!!!!!!!!!!!!!!
+!
+!open(unit=10,file='input_sounding',form='formatted',status='old')
+!rewind(10)
+!read(10,*) grid%em_u_gc(1,:,1)
+!
+!DO j = jts, MIN(jte,jde-1)
+!DO i = its, MIN(ite,ide-1)
+!
+!!!        grid%u10(i,j) = 0.19    ! albedo
+!!!        grid%v10(i,j) = 315.    ! thermal inertia
+!
+!        grid%u10(i,j) = 0.29    ! albedo
+!        grid%v10(i,j) = 100.    ! thermal inertia
+!
+!        grid%em_u_gc(i,:,j)=grid%em_u_gc(1,:,1)     ! zonal wind
+!        grid%em_v_gc(i,:,j)=0.			    ! meridional wind
+!
+!ENDDO
+!ENDDO
+!
+!
+!!! FIX for the STAGGERED SPECIFICITY
+!grid%em_u_gc(MIN(ite,ide-1)+1,:,:)=grid%em_u_gc(MIN(ite,ide-1),:,:)
+!grid%em_v_gc(:,:,MIN(jte,jde-1)+1)=grid%em_v_gc(:,:,MIN(jte,jde-1))
+!
+!
+!print *, 'wind profile'
+!print *, '--zonal'
+!print *, grid%em_u_gc(int((MIN(ite,ide-1)-its)/2),:,int((MIN(jte,jde-1)-jts)/2))
+!print *, '--meridional'
+!print *, grid%em_v_gc(int((MIN(ite,ide-1)-its)/2),:,int((MIN(jte,jde-1)-jts)/2))
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/Makefile	(revision 2744)
@@ -0,0 +1,206 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+
+MODULES =                 		\
+        module_advect_em.o   		\
+	module_diffusion_em.o  		\
+	module_small_step_em.o 		\
+        module_big_step_utilities_em.o  \
+        module_em.o         		\
+        module_solvedebug_em.o    	\
+        module_bc_em.o                  \
+        module_init_utilities.o         \
+	$(CASE_MODULE)
+
+# possible CASE_MODULE settings
+#	module_initialize_b_wave.o      \
+#	module_initialize_grav2d_x.o   \
+#	module_initialize_hill2d_x.o    \
+#	module_initialize_quarter_ss.o  \
+#	module_initialize_real.o        \
+#	module_initialize_lsm_x.o  \
+#	module_initialize_squall2d_x.o  \
+#	module_initialize_squall2d_y.o 
+
+OBJS    = 		        \
+	init_modules_em.o       \
+	solve_em.o              \
+        start_em.o              \
+        shift_domain_em.o       \
+        couple_or_uncouple_em.o \
+        nest_init_utils.o	\
+        interp_domain_em.o
+ 
+
+LIBTARGET    =  dyn_em
+TARGETDIR    =  ./
+$(LIBTARGET) :  $(MODULES) $(OBJS)
+		$(AR) ../main/libwrflib.a $(MODULES) $(OBJS)
+
+include ../configure.wrf
+
+clean:
+	@ echo 'use the clean script'
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+couple_or_uncouple_em.o: ../frame/module_domain.o \
+		../frame/module_configure.o \
+		../frame/module_driver_constants.o \
+		../frame/module_machine.o \
+		../frame/module_tiles.o \
+		../frame/module_dm.o \
+		../frame/module_state_description.o
+
+init_modules_em.o: module_big_step_utilities_em.o
+
+interp_domain_em.o: ../frame/module_domain.o \
+		../frame/module_configure.o 
+
+module_advect_em.o: ../share/module_bc.o \
+		../share/module_model_constants.o \
+		../frame/module_wrf_error.o
+
+module_bc_em.o: ../share/module_bc.o ../frame/module_configure.o \
+		../frame/module_wrf_error.o
+
+module_big_step_utilities_em.o: \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../share/module_model_constants.o 
+
+module_diffusion_em.o:  module_big_step_utilities_em.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		../frame/module_wrf_error.o
+
+module_em.o:    module_big_step_utilities_em.o module_advect_em.o \
+		../frame/module_state_description.o \
+		../share/module_model_constants.o 
+
+module_small_step_em.o: \
+		../frame/module_configure.o  \
+		../share/module_model_constants.o 
+
+module_initialize_b_wave.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_grav2d_x.o: \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_hill2d_x.o: \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_quarter_ss.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_real.o :  ../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		../share/module_soil_pre.o \
+		../share/module_optional_si_input.o
+
+module_initialize_squall2d_x.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_squall2d_y.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+nest_init_utils.o: \
+		../frame/module_domain.o \
+		../frame/module_configure.o
+
+start_em.o: module_bc_em.o \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		../share/module_date_time.o \
+		../phys/module_physics_init.o 
+
+solve_em.o:     module_small_step_em.o \
+		module_em.o            \
+		module_solvedebug_em.o \
+                module_bc_em.o         \
+		module_diffusion_em.o  \
+		module_big_step_utilities_em.o \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_driver_constants.o \
+		../frame/module_state_description.o \
+		../frame/module_machine.o \
+		../frame/module_tiles.o \
+		../frame/module_dm.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		../phys/module_lmd_driver.o \
+		../phys/module_physics_addtendc.o
+
+#		../chem/module_chem_utilities.o \
+# 		../chem/module_input_chem_data.o
+
+# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV2/dyn_em/couple_or_uncouple_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/couple_or_uncouple_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/couple_or_uncouple_em.F	(revision 2744)
@@ -0,0 +1,425 @@
+!WRF:MEDIATION_LAYER:couple_uncouple_utility
+
+SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+
+
+!  #undef DM_PARALLEL
+
+! Driver layer modules
+   USE module_domain
+   USE module_configure
+   USE module_driver_constants
+   USE module_machine
+   USE module_tiles
+   USE module_dm
+   USE module_bc
+! Mediation layer modules
+! Registry generated module
+   USE module_state_description
+
+   IMPLICIT NONE
+
+   !  Subroutine interface block.
+
+   TYPE(domain) , TARGET         :: grid
+
+   !  Definitions of dummy arguments to solve
+#include <em_dummy_new_decl.inc>
+
+   !  WRF state bcs
+   TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
+
+   LOGICAL, INTENT(   IN) :: couple
+
+   ! Local data
+
+   INTEGER                         :: k_start , k_end
+   INTEGER                         :: ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      ips , ipe , jps , jpe , kps , kpe
+
+   INTEGER                         :: i,j,k, im
+   INTEGER                         :: num_3d_c, num_3d_m, num_3d_s
+   REAL                            :: mu_factor
+
+   REAL, DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: mut_2, muut_2, muvt_2, muwt_2
+
+!  De-reference dimension information stored in the grid data structure.
+
+   CALL get_ijk_from_grid (  grid ,                   &
+                             ids, ide, jds, jde, kds, kde,    &
+                             ims, ime, jms, jme, kms, kme,    &
+                             ips, ipe, jps, jpe, kps, kpe    )
+
+   num_3d_m        = num_moist
+   num_3d_c        = num_chem
+   num_3d_s        = num_scalar
+
+   !  couple or uncouple mass-point variables
+   !  first, compute mu or its reciprical as necessary
+
+!   write(6,*) ' in couple '
+!   write(6,*) ' x,y memory ', grid%sm31,grid%em31,grid%sm33,grid%em33
+!   write(6,*) ' x,y patch ', ips, ipe, jps, jpe
+
+
+!   if(couple) then
+!      write(6,*) ' coupling variables for grid ',grid%id
+!      write(6,*) ' ips, ipe, jps, jpe ',ips,ipe,jps,jpe
+!   else
+!      write(6,*) ' uncoupling variables for grid ',grid%id
+!      write(6,*) ' ips, ipe, jps, jpe ',ips,ipe,jps,jpe
+!      write(6,*) ' x, y, size ',size(mu_2,1),size(mu_2,2)
+!   end if
+
+#ifdef DM_PARALLEL
+#      include <em_data_calls.inc>
+#endif
+
+
+   IF ( config_flags%periodic_x .OR. config_flags%periodic_y ) THEN
+     CALL set_physical_bc2d( grid%em_mub, 't',  &
+                             config_flags,           &
+                             ids,ide, jds,jde,   & ! domain dims
+                             ims,ime, jms,jme,   & ! memory dims
+                             ips,ipe, jps,jpe,   & ! patch  dims
+                             ips,ipe, jps,jpe   )
+     CALL set_physical_bc2d( grid%em_mu_1, 't',  &
+                             config_flags,           &
+                             ids,ide, jds,jde,   & ! domain dims
+                             ims,ime, jms,jme,   & ! memory dims
+                             ips,ipe, jps,jpe,   & ! patch  dims
+                             ips,ipe, jps,jpe   )
+     CALL set_physical_bc2d( grid%em_mu_2, 't',  &
+                             config_flags,           &
+                             ids,ide, jds,jde,   & ! domain dims
+                             ims,ime, jms,jme,   & ! memory dims
+                             ips,ipe, jps,jpe,   & ! patch  dims
+                             ips,ipe, jps,jpe   )
+   ENDIF
+
+
+#ifdef DM_PARALLEL
+# include "HALO_EM_COUPLE_A.inc"
+# include "PERIOD_EM_COUPLE_A.inc"
+#endif
+
+   !  computations go out one row and column to avoid having to communicate before solver
+
+   IF( couple ) THEN
+
+!     write(6,*) ' coupling: setting mu arrays '
+
+     DO j = max(jds,jps),min(jde-1,jpe)
+     DO i = max(ids,ips),min(ide-1,ipe)
+       mut_2(i,j) = grid%em_mub(i,j) + grid%em_mu_2(i,j)
+       muwt_2(i,j) = (grid%em_mub(i,j) + grid%em_mu_2(i,j))/grid%msft(i,j)
+     ENDDO
+     ENDDO
+
+!  need boundary condition fixes for u and v ???
+
+!     write(6,*) ' coupling: setting muv and muv arrays '
+
+     DO j = max(jds,jps),min(jde-1,jpe)
+     DO i = max(ids,ips),min(ide-1,ipe)
+       muut_2(i,j) = 0.5*(grid%em_mub(i,j)+grid%em_mub(i-1,j) + grid%em_mu_2(i,j) + grid%em_mu_2(i-1,j))/grid%msfu(i,j)
+       muvt_2(i,j) = 0.5*(grid%em_mub(i,j)+grid%em_mub(i,j-1) + grid%em_mu_2(i,j) + grid%em_mu_2(i,j-1))/grid%msfv(i,j)
+     ENDDO
+     ENDDO
+
+     IF ( config_flags%nested .or. config_flags%specified ) THEN
+
+       IF ( jpe .eq. jde ) THEN
+         j = jde
+         DO i = max(ids,ips),min(ide-1,ipe)
+           muvt_2(i,j) = (grid%em_mub(i,j-1) + grid%em_mu_2(i,j-1))/grid%msfv(i,j)
+         ENDDO
+       ENDIF
+       IF ( ipe .eq. ide .AND. .NOT. config_flags%periodic_x ) THEN
+         i = ide
+         DO j = max(jds,jps),min(jde-1,jpe)
+           muut_2(i,j) = (grid%em_mub(i-1,j) + grid%em_mu_2(i-1,j))/grid%msfu(i,j)
+         ENDDO
+       ENDIF
+
+     ELSE
+
+       IF ( jpe .eq. jde ) THEN
+         j = jde
+         DO i = max(ids,ips),min(ide-1,ipe)
+           muvt_2(i,j) = 0.5*(grid%em_mub(i,j)+grid%em_mub(i,j-1) + grid%em_mu_2(i,j) + grid%em_mu_2(i,j-1))/grid%msfv(i,j)
+         ENDDO
+       ENDIF
+       IF ( ipe .eq. ide ) THEN
+         i = ide       
+         DO j = max(jds,jps),min(jde-1,jpe)
+           muut_2(i,j) = 0.5*(grid%em_mub(i,j)+grid%em_mub(i-1,j) + grid%em_mu_2(i,j) + grid%em_mu_2(i-1,j))/grid%msfu(i,j)
+         ENDDO
+       ENDIF
+
+     END IF
+
+   ELSE
+   
+!     write(6,*) ' uncoupling: setting mu arrays '
+
+     DO j = max(jds,jps),min(jde-1,jpe)
+     DO i = max(ids,ips),min(ide-1,ipe)
+       mut_2(i,j) = 1./(grid%em_mub(i,j) + grid%em_mu_2(i,j))
+       muwt_2(i,j) = grid%msft(i,j)/(grid%em_mub(i,j) + grid%em_mu_2(i,j))
+     ENDDO
+     ENDDO
+
+!     write(6,*) ' uncoupling: setting muv arrays '
+
+     DO j = max(jds,jps),min(jde-1,jpe)
+     DO i = max(ids,ips),min(ide-1,ipe)
+       muut_2(i,j) = 2.*grid%msfu(i,j)/(grid%em_mub(i,j)+grid%em_mub(i-1,j) + grid%em_mu_2(i,j) + grid%em_mu_2(i-1,j))
+     ENDDO
+     ENDDO
+
+     DO j = max(jds,jps),min(jde-1,jpe)
+     DO i = max(ids,ips),min(ide-1,ipe)
+       muvt_2(i,j) = 2.*grid%msfv(i,j)/(grid%em_mub(i,j)+grid%em_mub(i,j-1) + grid%em_mu_2(i,j) + grid%em_mu_2(i,j-1))
+     ENDDO
+     ENDDO
+
+     IF ( config_flags%nested .or. config_flags%specified ) THEN
+
+       IF ( jpe .eq. jde ) THEN
+         j = jde 
+         DO i = max(ids,ips),min(ide-1,ipe)
+           muvt_2(i,j) = grid%msfv(i,j)/(grid%em_mub(i,j-1) + grid%em_mu_2(i,j-1))
+         ENDDO
+       ENDIF
+       IF ( ipe .eq. ide .AND. .NOT. config_flags%periodic_x ) THEN
+         i = ide
+         DO j = max(jds,jps),min(jde-1,jpe)
+           muut_2(i,j) = grid%msfu(i,j)/(grid%em_mub(i-1,j) + grid%em_mu_2(i-1,j))
+         ENDDO
+       ENDIF
+
+     ELSE
+
+       IF ( jpe .eq. jde ) THEN
+         j = jde
+         DO i = max(ids,ips),min(ide-1,ipe)
+           muvt_2(i,j) = 2.*grid%msfv(i,j)/(grid%em_mub(i,j)+grid%em_mub(i,j-1) + grid%em_mu_2(i,j) + grid%em_mu_2(i,j-1))
+         ENDDO
+       ENDIF
+       IF ( ipe .eq. ide ) THEN
+         i = ide       
+         DO j = max(jds,jps),min(jde-1,jpe)
+           muut_2(i,j) = 2.*grid%msfu(i,j)/(grid%em_mub(i,j)+grid%em_mub(i-1,j) + grid%em_mu_2(i,j) + grid%em_mu_2(i-1,j))
+         ENDDO
+       ENDIF
+
+     END IF
+
+   END IF
+
+   !  couple/uncouple mu point variables
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( i,j,k,im )
+   DO j = max(jds,jps),min(jde-1,jpe)
+
+     DO k = kps,kpe
+     DO i = max(ids,ips),min(ide-1,ipe)
+       grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k,j)*mut_2(i,j)
+       grid%em_w_2(i,k,j)  =  grid%em_w_2(i,k,j)*muwt_2(i,j)
+     ENDDO
+     ENDDO
+
+     DO k = kps,kpe-1
+     DO i = max(ids,ips),min(ide-1,ipe)
+       grid%em_t_2(i,k,j)  =  grid%em_t_2(i,k,j)*mut_2(i,j)
+     ENDDO
+     ENDDO
+
+     IF (num_3d_m >= PARAM_FIRST_SCALAR )  THEN
+       DO im = PARAM_FIRST_SCALAR, num_3d_m
+         DO k = kps,kpe-1
+         DO i = max(ids,ips),min(ide-1,ipe)
+           moist(i,k,j,im)  =  moist(i,k,j,im)*mut_2(i,j)
+         ENDDO
+         ENDDO
+       ENDDO
+     END IF
+
+     IF (num_3d_c >= PARAM_FIRST_SCALAR )  THEN
+       DO im = PARAM_FIRST_SCALAR, num_3d_c
+         DO k = kps,kpe-1
+         DO i = max(ids,ips),min(ide-1,ipe)
+           chem(i,k,j,im)  =  chem(i,k,j,im)*mut_2(i,j)
+         ENDDO
+         ENDDO
+       ENDDO
+     END IF
+
+     IF (num_3d_s >= PARAM_FIRST_SCALAR )  THEN
+       DO im = PARAM_FIRST_SCALAR, num_3d_s
+         DO k = kps,kpe-1
+         DO i = max(ids,ips),min(ide-1,ipe)
+           scalar(i,k,j,im)  =  scalar(i,k,j,im)*mut_2(i,j)
+         ENDDO
+         ENDDO
+       ENDDO
+     END IF
+
+!  do u and v
+
+     DO k = kps,kpe-1
+     DO i = max(ids,ips),min(ide,ipe)
+       grid%em_u_2(i,k,j)  =  grid%em_u_2(i,k,j)*muut_2(i,j)
+     ENDDO
+     ENDDO
+
+   ENDDO   ! j loop
+   !$OMP END PARALLEL DO
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( i,j,k )
+   DO j = max(jds,jps),min(jde,jpe)
+     DO k = kps,kpe-1
+     DO i = max(ids,ips),min(ide-1,ipe)
+       grid%em_v_2(i,k,j)  =  grid%em_v_2(i,k,j)*muvt_2(i,j)
+     ENDDO
+     ENDDO
+   ENDDO
+   !$OMP END PARALLEL DO
+
+   IF ( config_flags%periodic_x .OR. config_flags%periodic_y ) THEN
+     CALL set_physical_bc3d( grid%em_ph_1, 'w',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     CALL set_physical_bc3d( grid%em_ph_2, 'w',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     CALL set_physical_bc3d( grid%em_w_1, 'w',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     CALL set_physical_bc3d( grid%em_w_2, 'w',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     CALL set_physical_bc3d( grid%em_t_1, 't',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     CALL set_physical_bc3d( grid%em_t_2, 't',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     CALL set_physical_bc3d( grid%em_u_1, 'u',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     CALL set_physical_bc3d( grid%em_u_2, 'u',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     CALL set_physical_bc3d( grid%em_v_1, 'v',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     CALL set_physical_bc3d( grid%em_v_2, 'v',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+
+     IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+       DO im = PARAM_FIRST_SCALAR , num_3d_m
+
+     CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+       ENDDO
+     ENDIF
+
+
+     IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
+       DO im = PARAM_FIRST_SCALAR , num_3d_c
+
+     CALL set_physical_bc3d( chem(ims,kms,jms,im), 'p',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     ENDDO
+     ENDIF
+
+     IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
+       DO im = PARAM_FIRST_SCALAR , num_3d_s
+
+     CALL set_physical_bc3d( scalar(ims,kms,jms,im), 'p',        &
+                             config_flags,                   &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             ips,ipe, jps,jpe, kps,kpe )
+     ENDDO
+     ENDIF
+
+   ENDIF
+
+#ifdef DM_PARALLEL
+# include "HALO_EM_COUPLE_B.inc"
+# include "PERIOD_EM_COUPLE_B.inc"
+#endif
+
+END SUBROUTINE couple_or_uncouple_em
+
+LOGICAL FUNCTION em_cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, xstag, ystag )
+   USE module_configure
+   IMPLICIT NONE
+   INTEGER, INTENT(IN) :: pig, ips_save, ipe_save , pjg, jps_save, jpe_save
+   LOGICAL, INTENT(IN) :: xstag, ystag
+
+   INTEGER ioff, joff, spec_zone
+
+   CALL nl_get_spec_zone( 1, spec_zone )
+   ioff = 0 ; joff = 0 
+   IF ( xstag  ) ioff = 1
+   IF ( ystag  ) joff = 1
+
+   em_cd_feedback_mask = ( pig .ge. ips_save+spec_zone        .and.      &
+                           pjg .ge. jps_save+spec_zone        .and.      &
+                           pig .le. ipe_save-spec_zone  +ioff .and.      &
+                           pjg .le. jpe_save-spec_zone  +joff           )
+
+
+END FUNCTION em_cd_feedback_mask
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/diff_Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/diff_Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/diff_Makefile	(revision 2744)
@@ -0,0 +1,2 @@
+200a201
+> 		../phys/module_lmd_driver.o \
Index: trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_big_step_utilities_em
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_big_step_utilities_em	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_big_step_utilities_em	(revision 2744)
@@ -0,0 +1,14 @@
+4265c4265,4270
+<    IF (config_flags%bl_pbl_physics .gt. 0) THEN
+---
+> !   IF (config_flags%bl_pbl_physics .gt. 0) THEN
+> !****MARS
+> !****TODO:
+> !utiliser d'autres variables que les BL, afin de pouvoir utiliser
+> !un schéma de couche limite alternatif à la physique EuroMars ?
+> !****TODO:
+4307c4312,4313
+<     ENDIF
+---
+> !    ENDIF
+> !****MARS
Index: trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_diffusion_em
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_diffusion_em	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_diffusion_em	(revision 2744)
@@ -0,0 +1,12 @@
+4196c4196,4199
+<    IF(config_flags%bl_pbl_physics .GT. 0) THEN
+---
+> !   IF(config_flags%bl_pbl_physics .GT. 0) THEN
+> !
+> !****MARS: Always do that
+> 
+4210c4213,4214
+<    ENDIF
+---
+> !   ENDIF
+> !****MARS
Index: trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_em
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_em	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_em	(revision 2744)
@@ -0,0 +1,48 @@
+681,684d680
+< 
+< !IF (ru_tendf(i,k,j).NE.0) THEN 
+< !!!caca caca
+< !PRINT *, 'dynamics tendencies (compare)', ru_tend(i,k,j)
+687,688c683,685
+< !!!caca
+< !PRINT *, 'physics tendencies / mF (compare)', ru_tendf(i,k,j)/msfu(i,j)
+---
+> !!!!caca
+> !IF (ru_tendf(i,k,j).NE.0) THEN
+> !PRINT *, 'u physics tendencies / mF (compare)', ru_tendf(i,k,j)/msfu(i,j)
+691,692d687
+< 
+< 
+700,703d694
+< 
+< !IF (rv_tendf(i,k,j).NE.0) THEN 
+< !!!caca caca
+< !PRINT *, 'dynamics tendencies (compare)', rv_tend(i,k,j)
+706,707c697,699
+< !!!caca
+< !PRINT *, 'physics tendencies / mF (compare)', rv_tendf(i,k,j)/msfv(i,j)
+---
+> !!!!caca
+> !IF (rv_tendf(i,k,j).NE.0) THEN
+> !PRINT *, 'v physics tendencies / mF (compare)', rv_tendf(i,k,j)/msfv(i,j)
+710d701
+< 
+729,732d719
+< 
+< !IF (t_tendf(i,k,j).NE.0) THEN 
+< !!!caca caca
+< !PRINT *, 'dynamics tendencies (compare)', t_tend(i,k,j)
+736,737c723,725
+< !!!caca
+< !PRINT *, 'physics tendencies / mF (compare)', t_tendf(i,k,j)/msft(i,j)
+---
+> !!!!caca
+> !IF (t_tendf(i,k,j).NE.0) THEN
+> !PRINT *, 't physics tendencies / mF (compare)', t_tendf(i,k,j)/msft(i,j)
+739,740c727
+< !ENDIF
+< 
+---
+> !ENDIF 
+898a886
+> 
Index: trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_initialize_hill2d_x
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_initialize_hill2d_x	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_initialize_hill2d_x	(revision 2744)
@@ -0,0 +1,79 @@
+101c101,103
+< 
+---
+> !****Mars
+>     REAL    :: x_param,y_param,rho_param,dilat
+> !****Mars
+171,172c173,180
+<    hm = 100.
+<    xa = 5.0
+---
+> !   hm = 100.
+> !   xa = 5.0
+> !****Mars
+> !!   hm = 4000.
+> !!   xa = 5.0
+>    hm = 2000.
+>    xa = 6.0 
+> !****Mars
+174a183,191
+> !****Mars
+>    jcm = jde/2
+> !
+> !   xa1  = 5000./500.
+> !   xal1 = 4000./500.
+> !   pii  = 2.*asin(1.0)
+> !   hm1  = 250.
+> !!   hm1  = 1000.
+> !****Mars
+177,184c194,197
+<    xa1  = 5000./500.
+<    xal1 = 4000./500.
+<    pii  = 2.*asin(1.0)
+<    hm1  = 250.
+< !   hm1  = 1000.
+< 
+< 
+<    stretch_grid = .true.
+---
+> !****Mars
+> !   stretch_grid = .true.
+>    stretch_grid = .false.
+> !****Mars
+301a315,336
+> 
+> !****Mars
+> !!3D hill    
+> !        grid%ht(i,j) = hm/(1.+(float(i-icm)/xa)**2+(float(j-jcm)/xa)**2)
+> !!3D crater    
+> !	 grid%ht(i,j) = hm - hm/(1.+(float(i-icm)/xa)**2+(float(j-jcm)/xa)**2)
+> !!3D crater w/ rims
+>      x_param = float(i-icm)
+>      y_param = float(j-jcm)
+>      dilat = xa/2
+>      rho_param = sqrt(x_param**2 + y_param**2)
+>      
+>      ! revolution surface ; seed is a fourth order polynom
+>      grid%ht(i,j) = (rho_param+6*dilat)*(rho_param+10*dilat)
+>      grid%ht(i,j) = (rho_param-6*dilat)*(rho_param-10*dilat)*grid%ht(i,j)
+>          ! flat terrain elsewhere - smooth gradient (no abrupt fall)
+>          grid%ht(i,j) = grid%ht(i,j)*(tanh(rho_param+7*dilat)/2 - tanh(rho_param-7*dilat)/2)
+>          grid%ht(i,j) = hm - (hm*.4/1500)*grid%ht(i,j)/(dilat**4)    
+>      
+>          !if (rho_param .GE. dilat*10) ht(i,j) = hm
+> 
+> 
+580c615,618
+<       parameter( debug = .false.)
+---
+> 
+> !      parameter( debug = .false.)
+> !****Mars
+>       parameter( debug = .true.)
+596c634,637
+<       parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+---
+> !****Mars
+> !      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+>       parameter (p1000mb = 610, r = 192, cp = 845., cv = cp-r, cvpm = -cv/cp,g=3.72)
+> !****Mars
Index: trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_initialize_real
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_initialize_real	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/diff_module_initialize_real	(revision 2744)
@@ -0,0 +1,1761 @@
+9,11d8
+< !****MARS: modified May 2007
+< 
+< 
+224,225d220
+< read (20+grid%id) grid%em_albedo_gcm
+< read (20+grid%id) grid%em_therm_inert
+243,244d237
+< write (20+grid%id) grid%em_albedo_gcm
+< write (20+grid%id) grid%em_therm_inert
+258d250
+<               !!****MARS: tsk is surface temperature           
+264,268d255
+< !!****MARS
+< !!un peu artificiel, mais u10 et v10 sont des bons intermediaires (facultatifs de plus)
+<               grid%u10(i,j) = grid%em_albedo_gcm(i,j)
+<               grid%v10(i,j) = grid%em_therm_inert(i,j)
+< !!****MARS
+272d258
+< 
+275,286d260
+< !!****MARS
+< !!fix pour être certain d'être avec les bons flag
+< print *,flag_psfc
+< flag_psfc=1
+< print *,flag_soilhgt
+< flag_soilhgt=1
+< print *,flag_metgrid
+< flag_metgrid=1
+< !!**** TODO: trouver quand même pourquoi ça donne 0 :)
+< !!****MARS
+< 
+< 
+317,330c291,302
+< !****MARS
+< !         DO j = jts, min(jde-1,jte)
+< !            DO i = its, min(ide,ite)
+< !               grid%u10(i,j)=grid%em_u_gc(i,1,j)
+< !            END DO
+< !         END DO
+< !   
+< !         DO j = jts, min(jde,jte)
+< !            DO i = its, min(ide-1,ite)
+< !               grid%v10(i,j)=grid%em_v_gc(i,1,j)
+< !            END DO
+< !         END DO
+< !****MARS   
+< 
+---
+>          DO j = jts, min(jde-1,jte)
+>             DO i = its, min(ide,ite)
+>                grid%u10(i,j)=grid%em_u_gc(i,1,j)
+>             END DO
+>          END DO
+>    
+>          DO j = jts, min(jde,jte)
+>             DO i = its, min(ide-1,ite)
+>                grid%v10(i,j)=grid%em_v_gc(i,1,j)
+>             END DO
+>          END DO
+>    
+467,477c439,443
+< !!****MARS: decide to switch off this option 
+< !!****MARS: --> cf sfcprs2 and geopotential function at 500mb
+< !         IF ( config_flags%adjust_heights ) THEN
+< !            we_have_tavgsfc = ( flag_tavgsfc == 1 ) 
+< !         ELSE
+< !            we_have_tavgsfc = .FALSE.
+< !         END IF
+< !****MARS:
+< we_have_tavgsfc = .FALSE.
+< 
+< 
+---
+>          IF ( config_flags%adjust_heights ) THEN
+>             we_have_tavgsfc = ( flag_tavgsfc == 1 ) 
+>          ELSE
+>             we_have_tavgsfc = .FALSE.
+>          END IF
+479d444
+< !****MARS: hi-res psfc is done if the flag 'sfcp_to_sfcp' is active
+482d446
+< 	    print *,'compute psfc from hi-res topography'
+488,497c452,457
+< 
+< !****MARS: no sea-level pressure inputs possible
+< !         ELSE
+< !            CALL sfcprs (grid%em_t_gc, grid%em_qv_gc, grid%em_ght_gc, grid%em_pslv_gc, grid%ht, &
+< !                         grid%em_tavgsfc, grid%em_p_gc, grid%psfc, we_have_tavgsfc, &
+< !                         ids , ide , jds , jde , 1   , num_metgrid_levels , &
+< !                         ims , ime , jms , jme , 1   , num_metgrid_levels , &
+< !                         its , ite , jts , jte , 1   , num_metgrid_levels )
+< !****MARS: no sea-level pressure inputs possible
+< 
+---
+>          ELSE
+>             CALL sfcprs (grid%em_t_gc, grid%em_qv_gc, grid%em_ght_gc, grid%em_pslv_gc, grid%ht, &
+>                          grid%em_tavgsfc, grid%em_p_gc, grid%psfc, we_have_tavgsfc, &
+>                          ids , ide , jds , jde , 1   , num_metgrid_levels , &
+>                          ims , ime , jms , jme , 1   , num_metgrid_levels , &
+>                          its , ite , jts , jte , 1   , num_metgrid_levels )
+509d468
+< 
+533,534d491
+< !****MARS: em_dhs seems OK
+< 
+567d523
+< 
+580,583c536
+< 	 !****MARS: normalement c'est vert_interp
+<          !****MARS: mais les résultats sont trop discontinus > retour à une
+<          !****MARS: interpolation plus classique
+<          CALL vert_interp_old ( grid%em_qv_gc , grid%em_pd_gc , moist(:,:,:,P_QV) , grid%em_pb , &
+---
+>          CALL vert_interp ( grid%em_qv_gc , grid%em_pd_gc , moist(:,:,:,P_QV) , grid%em_pb , &
+590,592c543,544
+< 
+<          !****MARS: normalement c'est vert_interp
+<          CALL vert_interp_old ( grid%em_t_gc , grid%em_pd_gc , grid%em_t_2               , grid%em_pb , &
+---
+>    
+>          CALL vert_interp ( grid%em_t_gc , grid%em_pd_gc , grid%em_t_2               , grid%em_pb , &
+599d550
+< 
+686,688c637,638
+< 
+< 	!****MARS: normalement c'est vert_interp   
+<          CALL vert_interp_old ( grid%em_u_gc , grid%em_pd_gc , grid%em_u_2               , grid%em_pb , &
+---
+>    
+>          CALL vert_interp ( grid%em_u_gc , grid%em_pd_gc , grid%em_u_2               , grid%em_pb , &
+695,696c645,646
+< 	!****MARS: normalement c'est vert_interp   
+<          CALL vert_interp_old ( grid%em_v_gc , grid%em_pd_gc , grid%em_v_2               , grid%em_pb , &
+---
+>    
+>          CALL vert_interp ( grid%em_v_gc , grid%em_pd_gc , grid%em_v_2               , grid%em_pb , &
+705a656,657
+>       !  Protect against bad grid%em_tsk values over water by supplying grid%sst (if it is 
+>       !  available, and if the grid%sst is reasonable).
+707,951c659,666
+< !****MARS: no need
+< !      !  Protect against bad grid%em_tsk values over water by supplying grid%sst (if it is 
+< !      !  available, and if the grid%sst is reasonable).
+< !
+< !      DO j = jts, MIN(jde-1,jte)
+< !         DO i = its, MIN(ide-1,ite)
+< !            IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+< !                 ( grid%sst(i,j) .GT. 200. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+< !               grid%tsk(i,j) = grid%sst(i,j)
+< !            ENDIF            
+< !         END DO
+< !      END DO
+< !
+< !      !  Save the grid%em_tsk field for later use in the sea ice surface temperature
+< !      !  for the Noah LSM scheme.
+< !
+< !       DO j = jts, MIN(jte,jde-1)
+< !         DO i = its, MIN(ite,ide-1)
+< !            grid%tsk_save(i,j) = grid%tsk(i,j)
+< !         END DO
+< !      END DO
+< !
+< !!****MARS: no need
+< !      !  Take the data from the input file and store it in the variables that
+< !      !  use the WRF naming and ordering conventions.
+< !
+< !       DO j = jts, MIN(jte,jde-1)
+< !         DO i = its, MIN(ite,ide-1)
+< !            IF ( grid%snow(i,j) .GE. 10. ) then
+< !               grid%snowc(i,j) = 1.
+< !            ELSE
+< !               grid%snowc(i,j) = 0.0
+< !            END IF
+< !         END DO
+< !      END DO
+< !
+< !      !  Set flag integers for presence of snowh and soilw fields
+< !
+< !      grid%ifndsnowh = flag_snowh
+< !      IF (num_sw_levels_input .GE. 1) THEN
+< !         grid%ifndsoilw = 1
+< !      ELSE
+< !         grid%ifndsoilw = 0
+< !      END IF
+< !
+< !****MARS: no need
+< !      !  We require input data for the various LSM schemes.
+< !
+< !      enough_data : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+< !
+< !         CASE (LSMSCHEME)
+< !            IF ( num_st_levels_input .LT. 2 ) THEN
+< !               CALL wrf_error_fatal ( 'Not enough soil temperature data for Noah LSM scheme.')
+< !            END IF
+< !
+< !         CASE (RUCLSMSCHEME)
+< !            IF ( num_st_levels_input .LT. 2 ) THEN
+< !               CALL wrf_error_fatal ( 'Not enough soil temperature data for RUC LSM scheme.')
+< !            END IF
+< !
+< !      END SELECT enough_data
+< !
+< !      !  For sf_surface_physics = 1, we want to use close to a 30 cm value
+< !      !  for the bottom level of the soil temps.
+< !
+< !      fix_bottom_level_for_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+< !
+< !         CASE (SLABSCHEME)
+< !            IF      ( flag_tavgsfc  .EQ. 1 ) THEN
+< !               DO j = jts , MIN(jde-1,jte)
+< !                  DO i = its , MIN(ide-1,ite)
+< !                     grid%tmn(i,j) = grid%em_tavgsfc(i,j)
+< !                  END DO
+< !               END DO
+< !            ELSE IF ( flag_st010040 .EQ. 1 ) THEN
+< !               DO j = jts , MIN(jde-1,jte)
+< !                  DO i = its , MIN(ide-1,ite)
+< !                     grid%tmn(i,j) = grid%st010040(i,j)
+< !                  END DO
+< !               END DO
+< !            ELSE IF ( flag_st000010 .EQ. 1 ) THEN
+< !               DO j = jts , MIN(jde-1,jte)
+< !                  DO i = its , MIN(ide-1,ite)
+< !                     grid%tmn(i,j) = grid%st000010(i,j)
+< !                  END DO
+< !               END DO
+< !            ELSE IF ( flag_soilt020 .EQ. 1 ) THEN
+< !               DO j = jts , MIN(jde-1,jte)
+< !                  DO i = its , MIN(ide-1,ite)
+< !                     grid%tmn(i,j) = grid%soilt020(i,j)
+< !                  END DO
+< !               END DO
+< !            ELSE IF ( flag_st007028 .EQ. 1 ) THEN
+< !               DO j = jts , MIN(jde-1,jte)
+< !                  DO i = its , MIN(ide-1,ite)
+< !                     grid%tmn(i,j) = grid%st007028(i,j)
+< !                  END DO
+< !               END DO
+< !            ELSE
+< !               CALL wrf_debug ( 0 , 'No 10-40 cm, 0-10 cm, 7-28, or 20 cm soil temperature data for grid%em_tmn')
+< !               CALL wrf_debug ( 0 , 'Using 1 degree static annual mean temps' )
+< !            END IF
+< !
+< !         CASE (LSMSCHEME)
+< !
+< !         CASE (RUCLSMSCHEME)
+< !
+< !      END SELECT fix_bottom_level_for_temp
+< !
+< !      !  Adjustments for the seaice field PRIOR to the grid%tslb computations.  This is
+< !      !  is for the 5-layer scheme.
+< !
+< !      num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+< !      num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+< !      num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+< !      CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+< !      CALL nl_get_isice ( grid%id , grid%isice )
+< !      CALL nl_get_iswater ( grid%id , grid%iswater )
+< !      CALL adjust_for_seaice_pre ( grid%xice , grid%landmask , grid%tsk , grid%ivgtyp , grid%vegcat , grid%lu_index , &
+< !                                   grid%xland , grid%landusef , grid%isltyp , grid%soilcat , grid%soilctop , &
+< !                                   grid%soilcbot , grid%tmn , &
+< !                                   grid%seaice_threshold , &
+< !                                   num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+< !                                   grid%iswater , grid%isice , &
+< !                                   model_config_rec%sf_surface_physics(grid%id) , & 
+< !                                   ids , ide , jds , jde , kds , kde , & 
+< !                                   ims , ime , jms , jme , kms , kme , & 
+< !                                   its , ite , jts , jte , kts , kte ) 
+< !
+< !      !  surface_input_source=1 => use data from static file (fractional category as input)
+< !      !  surface_input_source=2 => use data from grib file (dominant category as input)
+< !  
+< !      IF ( config_flags%surface_input_source .EQ. 1 ) THEN
+< !         grid%vegcat (its,jts) = 0
+< !         grid%soilcat(its,jts) = 0
+< !      END IF
+< !
+< !      !  Generate the vegetation and soil category information from the fractional input
+< !      !  data, or use the existing dominant category fields if they exist.
+< !
+< !      IF ( ( grid%soilcat(its,jts) .LT. 0.5 ) .AND. ( grid%vegcat(its,jts) .LT. 0.5 ) ) THEN
+< !
+< !         num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+< !         num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+< !         num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+< !   
+< !         CALL process_percent_cat_new ( grid%landmask , &               
+< !                                    grid%landusef , grid%soilctop , grid%soilcbot , &
+< !                                    grid%isltyp , grid%ivgtyp , &
+< !                                    num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+< !                                    ids , ide , jds , jde , kds , kde , &
+< !                                    ims , ime , jms , jme , kms , kme , &
+< !                                    its , ite , jts , jte , kts , kte , &
+< !                                    model_config_rec%iswater(grid%id) )
+< !
+< !         !  Make all the veg/soil parms the same so as not to confuse the developer.
+< !
+< !         DO j = jts , MIN(jde-1,jte)
+< !            DO i = its , MIN(ide-1,ite)
+< !               grid%vegcat(i,j)  = grid%ivgtyp(i,j)
+< !               grid%soilcat(i,j) = grid%isltyp(i,j)
+< !            END DO
+< !         END DO
+< !
+< !      ELSE
+< !
+< !         !  Do we have dominant soil and veg data from the input already?
+< !   
+< !         IF ( grid%soilcat(its,jts) .GT. 0.5 ) THEN
+< !            DO j = jts, MIN(jde-1,jte)
+< !               DO i = its, MIN(ide-1,ite)
+< !                  grid%isltyp(i,j) = NINT( grid%soilcat(i,j) )
+< !               END DO
+< !            END DO
+< !         END IF
+< !         IF ( grid%vegcat(its,jts) .GT. 0.5 ) THEN
+< !            DO j = jts, MIN(jde-1,jte)
+< !               DO i = its, MIN(ide-1,ite)
+< !                  grid%ivgtyp(i,j) = NINT( grid%vegcat(i,j) )
+< !               END DO
+< !            END DO
+< !         END IF
+< !
+< !      END IF
+< !         
+< !      !  Land use assignment.
+< !
+< !      DO j = jts, MIN(jde-1,jte)
+< !         DO i = its, MIN(ide-1,ite)
+< !            grid%lu_index(i,j) = grid%ivgtyp(i,j)
+< !            IF ( grid%lu_index(i,j) .NE. model_config_rec%iswater(grid%id) ) THEN
+< !               grid%landmask(i,j) = 1
+< !               grid%xland(i,j)    = 1
+< !            ELSE
+< !               grid%landmask(i,j) = 0
+< !               grid%xland(i,j)    = 2
+< !            END IF
+< !         END DO
+< !      END DO
+< !
+< !      !  Adjust the various soil temperature values depending on the difference in
+< !      !  in elevation between the current model's elevation and the incoming data's
+< !      !  orography.
+< !         
+< !      IF ( flag_soilhgt .EQ. 1 ) THEN
+< !         adjust_soil : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+< !
+< !            CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+< !               CALL adjust_soil_temp_new ( grid%tmn , model_config_rec%sf_surface_physics(grid%id) , &
+< !                                           grid%tsk , grid%ht , grid%toposoil , grid%landmask , flag_soilhgt , &
+< !                                           grid%st000010 , grid%st010040 , grid%st040100 , grid%st100200 , grid%st010200 , &
+< !                                           flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
+< !                                           grid%st000007 , grid%st007028 , grid%st028100 , grid%st100255 , &
+< !                                           flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
+< !                                           grid%soilt000 , grid%soilt005 , grid%soilt020 , grid%soilt040 , grid%soilt160 , &
+< !                                           grid%soilt300 , &
+< !                                           flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , &
+< !                                           flag_soilt160 , flag_soilt300 , &
+< !                                           ids , ide , jds , jde , kds , kde , &
+< !                                           ims , ime , jms , jme , kms , kme , &
+< !                                           its , ite , jts , jte , kts , kte )
+< !
+< !         END SELECT adjust_soil
+< !      END IF
+< !
+< !      !  Fix grid%em_tmn and grid%em_tsk.
+< !
+< !      fix_tsk_tmn : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+< !
+< !         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+< !            DO j = jts, MIN(jde-1,jte)
+< !               DO i = its, MIN(ide-1,ite)
+< !                  IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+< !                       ( grid%sst(i,j) .GT. 240. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+< !                     grid%tmn(i,j) = grid%sst(i,j)
+< !                     grid%tsk(i,j) = grid%sst(i,j)
+< !                  ELSE IF ( grid%landmask(i,j) .LT. 0.5 ) THEN
+< !                     grid%tmn(i,j) = grid%tsk(i,j)
+< !                  END IF
+< !               END DO
+< !            END DO
+< !      END SELECT fix_tsk_tmn
+< !    
+< !      !  Is the grid%em_tsk reasonable?
+< !
+---
+>       DO j = jts, MIN(jde-1,jte)
+>          DO i = its, MIN(ide-1,ite)
+>             IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+>                  ( grid%sst(i,j) .GT. 200. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+>                grid%tsk(i,j) = grid%sst(i,j)
+>             ENDIF            
+>          END DO
+>       END DO
+952a668,669
+>       !  Save the grid%em_tsk field for later use in the sea ice surface temperature
+>       !  for the Noah LSM scheme.
+954c671,898
+< !!**** MARS
+---
+>        DO j = jts, MIN(jte,jde-1)
+>          DO i = its, MIN(ite,ide-1)
+>             grid%tsk_save(i,j) = grid%tsk(i,j)
+>          END DO
+>       END DO
+> 
+>       !  Take the data from the input file and store it in the variables that
+>       !  use the WRF naming and ordering conventions.
+> 
+>        DO j = jts, MIN(jte,jde-1)
+>          DO i = its, MIN(ite,ide-1)
+>             IF ( grid%snow(i,j) .GE. 10. ) then
+>                grid%snowc(i,j) = 1.
+>             ELSE
+>                grid%snowc(i,j) = 0.0
+>             END IF
+>          END DO
+>       END DO
+> 
+>       !  Set flag integers for presence of snowh and soilw fields
+> 
+>       grid%ifndsnowh = flag_snowh
+>       IF (num_sw_levels_input .GE. 1) THEN
+>          grid%ifndsoilw = 1
+>       ELSE
+>          grid%ifndsoilw = 0
+>       END IF
+> 
+>       !  We require input data for the various LSM schemes.
+> 
+>       enough_data : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+> 
+>          CASE (LSMSCHEME)
+>             IF ( num_st_levels_input .LT. 2 ) THEN
+>                CALL wrf_error_fatal ( 'Not enough soil temperature data for Noah LSM scheme.')
+>             END IF
+> 
+>          CASE (RUCLSMSCHEME)
+>             IF ( num_st_levels_input .LT. 2 ) THEN
+>                CALL wrf_error_fatal ( 'Not enough soil temperature data for RUC LSM scheme.')
+>             END IF
+> 
+>       END SELECT enough_data
+> 
+>       !  For sf_surface_physics = 1, we want to use close to a 30 cm value
+>       !  for the bottom level of the soil temps.
+> 
+>       fix_bottom_level_for_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+> 
+>          CASE (SLABSCHEME)
+>             IF      ( flag_tavgsfc  .EQ. 1 ) THEN
+>                DO j = jts , MIN(jde-1,jte)
+>                   DO i = its , MIN(ide-1,ite)
+>                      grid%tmn(i,j) = grid%em_tavgsfc(i,j)
+>                   END DO
+>                END DO
+>             ELSE IF ( flag_st010040 .EQ. 1 ) THEN
+>                DO j = jts , MIN(jde-1,jte)
+>                   DO i = its , MIN(ide-1,ite)
+>                      grid%tmn(i,j) = grid%st010040(i,j)
+>                   END DO
+>                END DO
+>             ELSE IF ( flag_st000010 .EQ. 1 ) THEN
+>                DO j = jts , MIN(jde-1,jte)
+>                   DO i = its , MIN(ide-1,ite)
+>                      grid%tmn(i,j) = grid%st000010(i,j)
+>                   END DO
+>                END DO
+>             ELSE IF ( flag_soilt020 .EQ. 1 ) THEN
+>                DO j = jts , MIN(jde-1,jte)
+>                   DO i = its , MIN(ide-1,ite)
+>                      grid%tmn(i,j) = grid%soilt020(i,j)
+>                   END DO
+>                END DO
+>             ELSE IF ( flag_st007028 .EQ. 1 ) THEN
+>                DO j = jts , MIN(jde-1,jte)
+>                   DO i = its , MIN(ide-1,ite)
+>                      grid%tmn(i,j) = grid%st007028(i,j)
+>                   END DO
+>                END DO
+>             ELSE
+>                CALL wrf_debug ( 0 , 'No 10-40 cm, 0-10 cm, 7-28, or 20 cm soil temperature data for grid%em_tmn')
+>                CALL wrf_debug ( 0 , 'Using 1 degree static annual mean temps' )
+>             END IF
+> 
+>          CASE (LSMSCHEME)
+> 
+>          CASE (RUCLSMSCHEME)
+> 
+>       END SELECT fix_bottom_level_for_temp
+> 
+>       !  Adjustments for the seaice field PRIOR to the grid%tslb computations.  This is
+>       !  is for the 5-layer scheme.
+> 
+>       num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+>       num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+>       num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+>       CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+>       CALL nl_get_isice ( grid%id , grid%isice )
+>       CALL nl_get_iswater ( grid%id , grid%iswater )
+>       CALL adjust_for_seaice_pre ( grid%xice , grid%landmask , grid%tsk , grid%ivgtyp , grid%vegcat , grid%lu_index , &
+>                                    grid%xland , grid%landusef , grid%isltyp , grid%soilcat , grid%soilctop , &
+>                                    grid%soilcbot , grid%tmn , &
+>                                    grid%seaice_threshold , &
+>                                    num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+>                                    grid%iswater , grid%isice , &
+>                                    model_config_rec%sf_surface_physics(grid%id) , & 
+>                                    ids , ide , jds , jde , kds , kde , & 
+>                                    ims , ime , jms , jme , kms , kme , & 
+>                                    its , ite , jts , jte , kts , kte ) 
+> 
+>       !  surface_input_source=1 => use data from static file (fractional category as input)
+>       !  surface_input_source=2 => use data from grib file (dominant category as input)
+>   
+>       IF ( config_flags%surface_input_source .EQ. 1 ) THEN
+>          grid%vegcat (its,jts) = 0
+>          grid%soilcat(its,jts) = 0
+>       END IF
+> 
+>       !  Generate the vegetation and soil category information from the fractional input
+>       !  data, or use the existing dominant category fields if they exist.
+> 
+>       IF ( ( grid%soilcat(its,jts) .LT. 0.5 ) .AND. ( grid%vegcat(its,jts) .LT. 0.5 ) ) THEN
+> 
+>          num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+>          num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+>          num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+>    
+>          CALL process_percent_cat_new ( grid%landmask , &               
+>                                     grid%landusef , grid%soilctop , grid%soilcbot , &
+>                                     grid%isltyp , grid%ivgtyp , &
+>                                     num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+>                                     ids , ide , jds , jde , kds , kde , &
+>                                     ims , ime , jms , jme , kms , kme , &
+>                                     its , ite , jts , jte , kts , kte , &
+>                                     model_config_rec%iswater(grid%id) )
+> 
+>          !  Make all the veg/soil parms the same so as not to confuse the developer.
+> 
+>          DO j = jts , MIN(jde-1,jte)
+>             DO i = its , MIN(ide-1,ite)
+>                grid%vegcat(i,j)  = grid%ivgtyp(i,j)
+>                grid%soilcat(i,j) = grid%isltyp(i,j)
+>             END DO
+>          END DO
+> 
+>       ELSE
+> 
+>          !  Do we have dominant soil and veg data from the input already?
+>    
+>          IF ( grid%soilcat(its,jts) .GT. 0.5 ) THEN
+>             DO j = jts, MIN(jde-1,jte)
+>                DO i = its, MIN(ide-1,ite)
+>                   grid%isltyp(i,j) = NINT( grid%soilcat(i,j) )
+>                END DO
+>             END DO
+>          END IF
+>          IF ( grid%vegcat(its,jts) .GT. 0.5 ) THEN
+>             DO j = jts, MIN(jde-1,jte)
+>                DO i = its, MIN(ide-1,ite)
+>                   grid%ivgtyp(i,j) = NINT( grid%vegcat(i,j) )
+>                END DO
+>             END DO
+>          END IF
+> 
+>       END IF
+>          
+>       !  Land use assignment.
+> 
+>       DO j = jts, MIN(jde-1,jte)
+>          DO i = its, MIN(ide-1,ite)
+>             grid%lu_index(i,j) = grid%ivgtyp(i,j)
+>             IF ( grid%lu_index(i,j) .NE. model_config_rec%iswater(grid%id) ) THEN
+>                grid%landmask(i,j) = 1
+>                grid%xland(i,j)    = 1
+>             ELSE
+>                grid%landmask(i,j) = 0
+>                grid%xland(i,j)    = 2
+>             END IF
+>          END DO
+>       END DO
+> 
+>       !  Adjust the various soil temperature values depending on the difference in
+>       !  in elevation between the current model's elevation and the incoming data's
+>       !  orography.
+>          
+>       IF ( flag_soilhgt .EQ. 1 ) THEN
+>          adjust_soil : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+> 
+>             CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+>                CALL adjust_soil_temp_new ( grid%tmn , model_config_rec%sf_surface_physics(grid%id) , &
+>                                            grid%tsk , grid%ht , grid%toposoil , grid%landmask , flag_soilhgt , &
+>                                            grid%st000010 , grid%st010040 , grid%st040100 , grid%st100200 , grid%st010200 , &
+>                                            flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
+>                                            grid%st000007 , grid%st007028 , grid%st028100 , grid%st100255 , &
+>                                            flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
+>                                            grid%soilt000 , grid%soilt005 , grid%soilt020 , grid%soilt040 , grid%soilt160 , &
+>                                            grid%soilt300 , &
+>                                            flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , &
+>                                            flag_soilt160 , flag_soilt300 , &
+>                                            ids , ide , jds , jde , kds , kde , &
+>                                            ims , ime , jms , jme , kms , kme , &
+>                                            its , ite , jts , jte , kts , kte )
+> 
+>          END SELECT adjust_soil
+>       END IF
+> 
+>       !  Fix grid%em_tmn and grid%em_tsk.
+> 
+>       fix_tsk_tmn : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+> 
+>          CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+>             DO j = jts, MIN(jde-1,jte)
+>                DO i = its, MIN(ide-1,ite)
+>                   IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+>                        ( grid%sst(i,j) .GT. 240. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+>                      grid%tmn(i,j) = grid%sst(i,j)
+>                      grid%tsk(i,j) = grid%sst(i,j)
+>                   ELSE IF ( grid%landmask(i,j) .LT. 0.5 ) THEN
+>                      grid%tmn(i,j) = grid%tsk(i,j)
+>                   END IF
+>                END DO
+>             END DO
+>       END SELECT fix_tsk_tmn
+>     
+>       !  Is the grid%em_tsk reasonable?
+> 
+>       IF ( internal_time_loop .NE. 1 ) THEN
+957,1248c901,1036
+<                 !!grid%tsk(i,j)=200
+<                 grid%tmn(i,j)=0  
+<                 grid%sst(i,j)=0  !!no use on Mars!!
+<                 grid%tslb(i,j)=0
+<                END DO
+<             END DO
+< !!**** MARS
+< 
+< !      IF ( internal_time_loop .NE. 1 ) THEN
+< !         DO j = jts, MIN(jde-1,jte)
+< !            DO i = its, MIN(ide-1,ite)
+< !               IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+< !                  grid%tsk(i,j) = grid%em_t_2(i,1,j)
+< !               END IF
+< !            END DO
+< !         END DO
+< !      ELSE
+< !         DO j = jts, MIN(jde-1,jte)
+< !            DO i = its, MIN(ide-1,ite)
+< !               IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+< !                  print *,'error in the grid%em_tsk'
+< !                  print *,'i,j=',i,j
+< !                  print *,'grid%landmask=',grid%landmask(i,j)
+< !                  print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+< !                  if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+< !                     grid%tsk(i,j)=grid%tmn(i,j)
+< !                  else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+< !                     grid%tsk(i,j)=grid%sst(i,j)
+< !                  else
+< !                     CALL wrf_error_fatal ( 'grid%em_tsk unreasonable' )
+< !                  end if
+< !               END IF
+< !            END DO
+< !         END DO
+< !      END IF
+< !
+< !      !  Is the grid%em_tmn reasonable?
+< !
+< !      DO j = jts, MIN(jde-1,jte)
+< !         DO i = its, MIN(ide-1,ite)
+< !            IF ( ( ( grid%tmn(i,j) .LT. 170. ) .OR. ( grid%tmn(i,j) .GT. 400. ) ) &
+< !               .AND. ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+< !               IF ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME ) THEN
+< !                  print *,'error in the grid%em_tmn'
+< !                  print *,'i,j=',i,j
+< !                  print *,'grid%landmask=',grid%landmask(i,j)
+< !                  print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+< !               END IF
+< !
+< !               if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+< !                  grid%tmn(i,j)=grid%tsk(i,j)
+< !               else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+< !                  grid%tmn(i,j)=grid%sst(i,j)
+< !               else
+< !                  CALL wrf_error_fatal ( 'grid%em_tmn unreasonable' )
+< !               endif
+< !            END IF
+< !         END DO
+< !      END DO
+< !   
+< !      interpolate_soil_tmw : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+< !
+< !         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+< !            CALL process_soil_real ( grid%tsk , grid%tmn , &
+< !                                  grid%landmask , grid%sst , &
+< !                                  st_input , sm_input , sw_input , st_levels_input , sm_levels_input , sw_levels_input , &
+< !                                  grid%zs , grid%dzs , grid%tslb , grid%smois , grid%sh2o , &
+< !                                  flag_sst , flag_soilt000, flag_soilm000, &
+< !                                  ids , ide , jds , jde , kds , kde , &
+< !                                  ims , ime , jms , jme , kms , kme , &
+< !                                  its , ite , jts , jte , kts , kte , &
+< !                                  model_config_rec%sf_surface_physics(grid%id) , &
+< !                                  model_config_rec%num_soil_layers , &
+< !                                  model_config_rec%real_data_init_type , &
+< !                                  num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+< !                                  num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc )
+< !
+< !      END SELECT interpolate_soil_tmw
+< !
+< !      !  Minimum soil values, residual, from RUC LSM scheme.  For input from Noah and using
+< !      !  RUC LSM scheme, this must be subtracted from the input total soil moisture.  For
+< !      !  input RUC data and using the Noah LSM scheme, this value must be added to the soil
+< !      !  moisture input.
+< !
+< !      lqmi(1:num_soil_top_cat) = &
+< !      (/0.045, 0.057, 0.065, 0.067, 0.034, 0.078, 0.10,     &
+< !        0.089, 0.095, 0.10,  0.070, 0.068, 0.078, 0.0,      &
+< !        0.004, 0.065 /)
+< !!       0.004, 0.065, 0.020, 0.004, 0.008 /)  !  has extra levels for playa, lava, and white sand
+< !
+< !      !  At the initial time we care about values of soil moisture and temperature, other times are
+< !      !  ignored by the model, so we ignore them, too.  
+< !
+< !      IF ( domain_ClockIsStartTime(grid) ) THEN
+< !         account_for_zero_soil_moisture : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+< !   
+< !            CASE ( LSMSCHEME )
+< !               iicount = 0
+< !               IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+< !                  DO j = jts, MIN(jde-1,jte)
+< !                     DO i = its, MIN(ide-1,ite)
+< !                        IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+< !                             ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+< !                           print *,'Noah -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+< !                           iicount = iicount + 1
+< !                           grid%smois(i,:,j) = 0.005
+< !                        END IF
+< !                     END DO
+< !                  END DO
+< !                  IF ( iicount .GT. 0 ) THEN
+< !                     print *,'Noah -> Noah: total number of small soil moisture locations = ',iicount
+< !                  END IF
+< !               ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+< !                  DO j = jts, MIN(jde-1,jte)
+< !                     DO i = its, MIN(ide-1,ite)
+< !                        grid%smois(i,:,j) = grid%smois(i,:,j) + lqmi(grid%isltyp(i,j))
+< !                     END DO
+< !                  END DO
+< !                  DO j = jts, MIN(jde-1,jte)
+< !                     DO i = its, MIN(ide-1,ite)
+< !                        IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+< !                             ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+< !                           print *,'RUC -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+< !                           iicount = iicount + 1
+< !                           grid%smois(i,:,j) = 0.005
+< !                        END IF
+< !                     END DO
+< !                  END DO
+< !                  IF ( iicount .GT. 0 ) THEN
+< !                     print *,'RUC -> Noah: total number of small soil moisture locations = ',iicount
+< !                  END IF
+< !               END IF
+< !   
+< !            CASE ( RUCLSMSCHEME )
+< !               iicount = 0
+< !               IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+< !                  DO j = jts, MIN(jde-1,jte)
+< !                     DO i = its, MIN(ide-1,ite)
+< !                        grid%smois(i,:,j) = MAX ( grid%smois(i,:,j) - lqmi(grid%isltyp(i,j)) , 0. )
+< !                     END DO
+< !                  END DO
+< !               ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+< !                  ! no op
+< !               END IF
+< !   
+< !         END SELECT account_for_zero_soil_moisture
+< !      END IF
+< !
+< !      !  Is the grid%tslb reasonable?
+< !
+< !      IF ( internal_time_loop .NE. 1 ) THEN
+< !         DO j = jts, MIN(jde-1,jte)
+< !            DO ns = 1 , model_config_rec%num_soil_layers
+< !               DO i = its, MIN(ide-1,ite)
+< !                  IF ( grid%tslb(i,ns,j) .LT. 170 .or. grid%tslb(i,ns,j) .GT. 400. ) THEN
+< !                     grid%tslb(i,ns,j) = grid%em_t_2(i,1,j)
+< !                     grid%smois(i,ns,j) = 0.3
+< !                  END IF
+< !               END DO
+< !            END DO
+< !         END DO
+< !      ELSE
+< !         DO j = jts, MIN(jde-1,jte)
+< !            DO i = its, MIN(ide-1,ite)
+< !               IF ( ( ( grid%tslb(i,1,j) .LT. 170. ) .OR. ( grid%tslb(i,1,j) .GT. 400. ) ) .AND. &
+< !                       ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+< !                     IF ( ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME    ) .AND. &
+< !                          ( model_config_rec%sf_surface_physics(grid%id) .NE. RUCLSMSCHEME ) ) THEN
+< !                        print *,'error in the grid%tslb'
+< !                        print *,'i,j=',i,j
+< !                        print *,'grid%landmask=',grid%landmask(i,j)
+< !                        print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+< !                        print *,'grid%tslb = ',grid%tslb(i,:,j)
+< !                        print *,'old grid%smois = ',grid%smois(i,:,j)
+< !                        grid%smois(i,1,j) = 0.3
+< !                        grid%smois(i,2,j) = 0.3
+< !                        grid%smois(i,3,j) = 0.3
+< !                        grid%smois(i,4,j) = 0.3
+< !                     END IF
+< !   
+< !                     IF ( (grid%tsk(i,j).GT.170. .AND. grid%tsk(i,j).LT.400.) .AND. &
+< !                          (grid%tmn(i,j).GT.170. .AND. grid%tmn(i,j).LT.400.) ) THEN
+< !                        fake_soil_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+< !                           CASE ( SLABSCHEME )
+< !                              DO ns = 1 , model_config_rec%num_soil_layers
+< !                                 grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+< !                                                       grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+< !                              END DO
+< !                           CASE ( LSMSCHEME , RUCLSMSCHEME )
+< !                              CALL wrf_error_fatal ( 'Assigning constant soil moisture, bad idea')
+< !                              DO ns = 1 , model_config_rec%num_soil_layers
+< !                                 grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+< !                                                       grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+< !                              END DO
+< !                        END SELECT fake_soil_temp
+< !                     else if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+< !                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 1' )
+< !                        DO ns = 1 , model_config_rec%num_soil_layers
+< !                           grid%tslb(i,ns,j)=grid%tsk(i,j)
+< !                        END DO
+< !                     else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+< !                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 2' )
+< !                        DO ns = 1 , model_config_rec%num_soil_layers
+< !                           grid%tslb(i,ns,j)=grid%sst(i,j)
+< !                        END DO
+< !                     else if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+< !                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 3' )
+< !                        DO ns = 1 , model_config_rec%num_soil_layers
+< !                           grid%tslb(i,ns,j)=grid%tmn(i,j)
+< !                        END DO
+< !                     else
+< !                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 4' )
+< !                     endif
+< !               END IF
+< !            END DO
+< !         END DO
+< !      END IF
+< !
+< !      !  Adjustments for the seaice field AFTER the grid%tslb computations.  This is
+< !      !  is for the Noah LSM scheme.
+< !
+< !      num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+< !      num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+< !      num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+< !      CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+< !      CALL nl_get_isice ( grid%id , grid%isice )
+< !      CALL nl_get_iswater ( grid%id , grid%iswater )
+< !      CALL adjust_for_seaice_post ( grid%xice , grid%landmask , grid%tsk , grid%tsk_save , &
+< !                                    grid%ivgtyp , grid%vegcat , grid%lu_index , &
+< !                                    grid%xland , grid%landusef , grid%isltyp , grid%soilcat ,  &
+< !                                    grid%soilctop , &
+< !                                    grid%soilcbot , grid%tmn , grid%vegfra , &
+< !                                    grid%tslb , grid%smois , grid%sh2o , &
+< !                                    grid%seaice_threshold , &
+< !                                    num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+< !                                    model_config_rec%num_soil_layers , &
+< !                                    grid%iswater , grid%isice , &
+< !                                    model_config_rec%sf_surface_physics(grid%id) , & 
+< !                                    ids , ide , jds , jde , kds , kde , & 
+< !                                    ims , ime , jms , jme , kms , kme , & 
+< !                                    its , ite , jts , jte , kts , kte ) 
+< !
+< !      !  Let us make sure (again) that the grid%landmask and the veg/soil categories match.
+< !
+< !oops1=0
+< !oops2=0
+< !      DO j = jts, MIN(jde-1,jte)
+< !         DO i = its, MIN(ide-1,ite)
+< !            IF ( ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. &
+< !                   ( grid%ivgtyp(i,j) .NE. config_flags%iswater .OR. grid%isltyp(i,j) .NE. 14 ) ) .OR. &
+< !                 ( ( grid%landmask(i,j) .GT. 0.5 ) .AND. &
+< !                   ( grid%ivgtyp(i,j) .EQ. config_flags%iswater .OR. grid%isltyp(i,j) .EQ. 14 ) ) ) THEN
+< !               IF ( grid%tslb(i,1,j) .GT. 1. ) THEN
+< !oops1=oops1+1
+< !                  grid%ivgtyp(i,j) = 5
+< !                  grid%isltyp(i,j) = 8
+< !                  grid%landmask(i,j) = 1
+< !                  grid%xland(i,j) = 1
+< !               ELSE IF ( grid%sst(i,j) .GT. 1. ) THEN
+< !oops2=oops2+1
+< !                  grid%ivgtyp(i,j) = config_flags%iswater
+< !                  grid%isltyp(i,j) = 14
+< !                  grid%landmask(i,j) = 0
+< !                  grid%xland(i,j) = 2
+< !               ELSE
+< !                  print *,'the grid%landmask and soil/veg cats do not match'
+< !                  print *,'i,j=',i,j
+< !                  print *,'grid%landmask=',grid%landmask(i,j)
+< !                  print *,'grid%ivgtyp=',grid%ivgtyp(i,j)
+< !                  print *,'grid%isltyp=',grid%isltyp(i,j)
+< !                  print *,'iswater=', config_flags%iswater
+< !                  print *,'grid%tslb=',grid%tslb(i,:,j)
+< !                  print *,'grid%sst=',grid%sst(i,j)
+< !                  CALL wrf_error_fatal ( 'mismatch_landmask_ivgtyp' )
+< !               END IF
+< !            END IF
+< !         END DO
+< !      END DO
+< !if (oops1.gt.0) then
+< !print *,'points artificially set to land : ',oops1
+< !endif
+< !if(oops2.gt.0) then
+< !print *,'points artificially set to water: ',oops2
+< !endif
+< !! fill grid%sst array with grid%em_tsk if missing in real input (needed for time-varying grid%sst in wrf)
+< !      DO j = jts, MIN(jde-1,jte)
+< !         DO i = its, MIN(ide-1,ite)
+< !           IF ( flag_sst .NE. 1 ) THEN
+< !             grid%sst(i,j) = grid%tsk(i,j)
+< !           ENDIF
+< !         END DO
+< !      END DO
+---
+>                IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+>                   grid%tsk(i,j) = grid%em_t_2(i,1,j)
+>                END IF
+>             END DO
+>          END DO
+>       ELSE
+>          DO j = jts, MIN(jde-1,jte)
+>             DO i = its, MIN(ide-1,ite)
+>                IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+>                   print *,'error in the grid%em_tsk'
+>                   print *,'i,j=',i,j
+>                   print *,'grid%landmask=',grid%landmask(i,j)
+>                   print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+>                   if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+>                      grid%tsk(i,j)=grid%tmn(i,j)
+>                   else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+>                      grid%tsk(i,j)=grid%sst(i,j)
+>                   else
+>                      CALL wrf_error_fatal ( 'grid%em_tsk unreasonable' )
+>                   end if
+>                END IF
+>             END DO
+>          END DO
+>       END IF
+> 
+>       !  Is the grid%em_tmn reasonable?
+> 
+>       DO j = jts, MIN(jde-1,jte)
+>          DO i = its, MIN(ide-1,ite)
+>             IF ( ( ( grid%tmn(i,j) .LT. 170. ) .OR. ( grid%tmn(i,j) .GT. 400. ) ) &
+>                .AND. ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+>                IF ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME ) THEN
+>                   print *,'error in the grid%em_tmn'
+>                   print *,'i,j=',i,j
+>                   print *,'grid%landmask=',grid%landmask(i,j)
+>                   print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+>                END IF
+> 
+>                if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+>                   grid%tmn(i,j)=grid%tsk(i,j)
+>                else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+>                   grid%tmn(i,j)=grid%sst(i,j)
+>                else
+>                   CALL wrf_error_fatal ( 'grid%em_tmn unreasonable' )
+>                endif
+>             END IF
+>          END DO
+>       END DO
+>    
+>       interpolate_soil_tmw : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+> 
+>          CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+>             CALL process_soil_real ( grid%tsk , grid%tmn , &
+>                                   grid%landmask , grid%sst , &
+>                                   st_input , sm_input , sw_input , st_levels_input , sm_levels_input , sw_levels_input , &
+>                                   grid%zs , grid%dzs , grid%tslb , grid%smois , grid%sh2o , &
+>                                   flag_sst , flag_soilt000, flag_soilm000, &
+>                                   ids , ide , jds , jde , kds , kde , &
+>                                   ims , ime , jms , jme , kms , kme , &
+>                                   its , ite , jts , jte , kts , kte , &
+>                                   model_config_rec%sf_surface_physics(grid%id) , &
+>                                   model_config_rec%num_soil_layers , &
+>                                   model_config_rec%real_data_init_type , &
+>                                   num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+>                                   num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc )
+> 
+>       END SELECT interpolate_soil_tmw
+> 
+>       !  Minimum soil values, residual, from RUC LSM scheme.  For input from Noah and using
+>       !  RUC LSM scheme, this must be subtracted from the input total soil moisture.  For
+>       !  input RUC data and using the Noah LSM scheme, this value must be added to the soil
+>       !  moisture input.
+> 
+>       lqmi(1:num_soil_top_cat) = &
+>       (/0.045, 0.057, 0.065, 0.067, 0.034, 0.078, 0.10,     &
+>         0.089, 0.095, 0.10,  0.070, 0.068, 0.078, 0.0,      &
+>         0.004, 0.065 /)
+> !       0.004, 0.065, 0.020, 0.004, 0.008 /)  !  has extra levels for playa, lava, and white sand
+> 
+>       !  At the initial time we care about values of soil moisture and temperature, other times are
+>       !  ignored by the model, so we ignore them, too.  
+> 
+>       IF ( domain_ClockIsStartTime(grid) ) THEN
+>          account_for_zero_soil_moisture : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+>    
+>             CASE ( LSMSCHEME )
+>                iicount = 0
+>                IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+>                   DO j = jts, MIN(jde-1,jte)
+>                      DO i = its, MIN(ide-1,ite)
+>                         IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+>                              ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+>                            print *,'Noah -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+>                            iicount = iicount + 1
+>                            grid%smois(i,:,j) = 0.005
+>                         END IF
+>                      END DO
+>                   END DO
+>                   IF ( iicount .GT. 0 ) THEN
+>                      print *,'Noah -> Noah: total number of small soil moisture locations = ',iicount
+>                   END IF
+>                ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+>                   DO j = jts, MIN(jde-1,jte)
+>                      DO i = its, MIN(ide-1,ite)
+>                         grid%smois(i,:,j) = grid%smois(i,:,j) + lqmi(grid%isltyp(i,j))
+>                      END DO
+>                   END DO
+>                   DO j = jts, MIN(jde-1,jte)
+>                      DO i = its, MIN(ide-1,ite)
+>                         IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+>                              ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+>                            print *,'RUC -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+>                            iicount = iicount + 1
+>                            grid%smois(i,:,j) = 0.005
+>                         END IF
+>                      END DO
+>                   END DO
+>                   IF ( iicount .GT. 0 ) THEN
+>                      print *,'RUC -> Noah: total number of small soil moisture locations = ',iicount
+>                   END IF
+>                END IF
+>    
+>             CASE ( RUCLSMSCHEME )
+>                iicount = 0
+>                IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+>                   DO j = jts, MIN(jde-1,jte)
+>                      DO i = its, MIN(ide-1,ite)
+>                         grid%smois(i,:,j) = MAX ( grid%smois(i,:,j) - lqmi(grid%isltyp(i,j)) , 0. )
+>                      END DO
+>                   END DO
+>                ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+>                   ! no op
+>                END IF
+>    
+>          END SELECT account_for_zero_soil_moisture
+>       END IF
+1249a1038,1181
+>       !  Is the grid%tslb reasonable?
+> 
+>       IF ( internal_time_loop .NE. 1 ) THEN
+>          DO j = jts, MIN(jde-1,jte)
+>             DO ns = 1 , model_config_rec%num_soil_layers
+>                DO i = its, MIN(ide-1,ite)
+>                   IF ( grid%tslb(i,ns,j) .LT. 170 .or. grid%tslb(i,ns,j) .GT. 400. ) THEN
+>                      grid%tslb(i,ns,j) = grid%em_t_2(i,1,j)
+>                      grid%smois(i,ns,j) = 0.3
+>                   END IF
+>                END DO
+>             END DO
+>          END DO
+>       ELSE
+>          DO j = jts, MIN(jde-1,jte)
+>             DO i = its, MIN(ide-1,ite)
+>                IF ( ( ( grid%tslb(i,1,j) .LT. 170. ) .OR. ( grid%tslb(i,1,j) .GT. 400. ) ) .AND. &
+>                        ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+>                      IF ( ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME    ) .AND. &
+>                           ( model_config_rec%sf_surface_physics(grid%id) .NE. RUCLSMSCHEME ) ) THEN
+>                         print *,'error in the grid%tslb'
+>                         print *,'i,j=',i,j
+>                         print *,'grid%landmask=',grid%landmask(i,j)
+>                         print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+>                         print *,'grid%tslb = ',grid%tslb(i,:,j)
+>                         print *,'old grid%smois = ',grid%smois(i,:,j)
+>                         grid%smois(i,1,j) = 0.3
+>                         grid%smois(i,2,j) = 0.3
+>                         grid%smois(i,3,j) = 0.3
+>                         grid%smois(i,4,j) = 0.3
+>                      END IF
+>    
+>                      IF ( (grid%tsk(i,j).GT.170. .AND. grid%tsk(i,j).LT.400.) .AND. &
+>                           (grid%tmn(i,j).GT.170. .AND. grid%tmn(i,j).LT.400.) ) THEN
+>                         fake_soil_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+>                            CASE ( SLABSCHEME )
+>                               DO ns = 1 , model_config_rec%num_soil_layers
+>                                  grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+>                                                        grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+>                               END DO
+>                            CASE ( LSMSCHEME , RUCLSMSCHEME )
+>                               CALL wrf_error_fatal ( 'Assigning constant soil moisture, bad idea')
+>                               DO ns = 1 , model_config_rec%num_soil_layers
+>                                  grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+>                                                        grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+>                               END DO
+>                         END SELECT fake_soil_temp
+>                      else if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+>                         CALL wrf_error_fatal ( 'grid%tslb unreasonable 1' )
+>                         DO ns = 1 , model_config_rec%num_soil_layers
+>                            grid%tslb(i,ns,j)=grid%tsk(i,j)
+>                         END DO
+>                      else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+>                         CALL wrf_error_fatal ( 'grid%tslb unreasonable 2' )
+>                         DO ns = 1 , model_config_rec%num_soil_layers
+>                            grid%tslb(i,ns,j)=grid%sst(i,j)
+>                         END DO
+>                      else if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+>                         CALL wrf_error_fatal ( 'grid%tslb unreasonable 3' )
+>                         DO ns = 1 , model_config_rec%num_soil_layers
+>                            grid%tslb(i,ns,j)=grid%tmn(i,j)
+>                         END DO
+>                      else
+>                         CALL wrf_error_fatal ( 'grid%tslb unreasonable 4' )
+>                      endif
+>                END IF
+>             END DO
+>          END DO
+>       END IF
+> 
+>       !  Adjustments for the seaice field AFTER the grid%tslb computations.  This is
+>       !  is for the Noah LSM scheme.
+> 
+>       num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+>       num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+>       num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+>       CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+>       CALL nl_get_isice ( grid%id , grid%isice )
+>       CALL nl_get_iswater ( grid%id , grid%iswater )
+>       CALL adjust_for_seaice_post ( grid%xice , grid%landmask , grid%tsk , grid%tsk_save , &
+>                                     grid%ivgtyp , grid%vegcat , grid%lu_index , &
+>                                     grid%xland , grid%landusef , grid%isltyp , grid%soilcat ,  &
+>                                     grid%soilctop , &
+>                                     grid%soilcbot , grid%tmn , grid%vegfra , &
+>                                     grid%tslb , grid%smois , grid%sh2o , &
+>                                     grid%seaice_threshold , &
+>                                     num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+>                                     model_config_rec%num_soil_layers , &
+>                                     grid%iswater , grid%isice , &
+>                                     model_config_rec%sf_surface_physics(grid%id) , & 
+>                                     ids , ide , jds , jde , kds , kde , & 
+>                                     ims , ime , jms , jme , kms , kme , & 
+>                                     its , ite , jts , jte , kts , kte ) 
+> 
+>       !  Let us make sure (again) that the grid%landmask and the veg/soil categories match.
+> 
+> oops1=0
+> oops2=0
+>       DO j = jts, MIN(jde-1,jte)
+>          DO i = its, MIN(ide-1,ite)
+>             IF ( ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. &
+>                    ( grid%ivgtyp(i,j) .NE. config_flags%iswater .OR. grid%isltyp(i,j) .NE. 14 ) ) .OR. &
+>                  ( ( grid%landmask(i,j) .GT. 0.5 ) .AND. &
+>                    ( grid%ivgtyp(i,j) .EQ. config_flags%iswater .OR. grid%isltyp(i,j) .EQ. 14 ) ) ) THEN
+>                IF ( grid%tslb(i,1,j) .GT. 1. ) THEN
+> oops1=oops1+1
+>                   grid%ivgtyp(i,j) = 5
+>                   grid%isltyp(i,j) = 8
+>                   grid%landmask(i,j) = 1
+>                   grid%xland(i,j) = 1
+>                ELSE IF ( grid%sst(i,j) .GT. 1. ) THEN
+> oops2=oops2+1
+>                   grid%ivgtyp(i,j) = config_flags%iswater
+>                   grid%isltyp(i,j) = 14
+>                   grid%landmask(i,j) = 0
+>                   grid%xland(i,j) = 2
+>                ELSE
+>                   print *,'the grid%landmask and soil/veg cats do not match'
+>                   print *,'i,j=',i,j
+>                   print *,'grid%landmask=',grid%landmask(i,j)
+>                   print *,'grid%ivgtyp=',grid%ivgtyp(i,j)
+>                   print *,'grid%isltyp=',grid%isltyp(i,j)
+>                   print *,'iswater=', config_flags%iswater
+>                   print *,'grid%tslb=',grid%tslb(i,:,j)
+>                   print *,'grid%sst=',grid%sst(i,j)
+>                   CALL wrf_error_fatal ( 'mismatch_landmask_ivgtyp' )
+>                END IF
+>             END IF
+>          END DO
+>       END DO
+> if (oops1.gt.0) then
+> print *,'points artificially set to land : ',oops1
+> endif
+> if(oops2.gt.0) then
+> print *,'points artificially set to water: ',oops2
+> endif
+> ! fill grid%sst array with grid%em_tsk if missing in real input (needed for time-varying grid%sst in wrf)
+>       DO j = jts, MIN(jde-1,jte)
+>          DO i = its, MIN(ide-1,ite)
+>            IF ( flag_sst .NE. 1 ) THEN
+>              grid%sst(i,j) = grid%tsk(i,j)
+>            ENDIF
+>          END DO
+>       END DO
+1348,1351d1279
+< 
+< !****MARS         
+< !TODO: étudier si une meilleure formule n'existe pas pour Mars
+< !****MARS
+1357c1285
+<         
+---
+> 
+1457,1469c1385,1391
+< !!---------------------------------------------------------------
+< !!****MARS: no 500mb adjustment needed
+< !!****MARS: must keep however the hydrostatic equation integration performed in this loop !
+< !!****MARS: the DO WHILE loop is deactivated, since we will always be in the case
+< !!****MARS: ... of "ELSE dpmu = 0."
+< !!---------------------------------------------------------------
+< !            dpmu = 10001.
+< !            loop_count = 0
+< !
+< !            DO WHILE ( ( ABS(dpmu) .GT. 10. ) .AND. &
+< !                       ( loop_count .LT. 5 ) )  
+< !
+< !               loop_count = loop_count + 1
+---
+>             dpmu = 10001.
+>             loop_count = 0
+> 
+>             DO WHILE ( ( ABS(dpmu) .GT. 10. ) .AND. &
+>                        ( loop_count .LT. 5 ) )  
+> 
+>                loop_count = loop_count + 1
+1490c1412
+<                 DO k=kte-2,1,-1
+---
+>                DO k=kte-2,1,-1
+1509a1432,1495
+>    
+>                !  Adjust the column pressure so that the computed 500 mb height is close to the
+>                !  input value (of course, not when we are doing hybrid input).
+>    
+>                IF ( ( flag_metgrid .EQ. 1 ) .AND. ( i .EQ. its ) .AND. ( j .EQ. jts ) ) THEN
+>                   DO k = 1 , num_metgrid_levels
+>                      IF ( ABS ( grid%em_p_gc(i,k,j) - 50000. ) .LT. 1. ) THEN
+>                         lev500 = k
+>                         EXIT
+>                      END IF
+>                   END DO
+>                END IF
+>            
+>                !  We only do the adjustment of height if we have the input data on pressure
+>                !  surfaces, and folks have asked to do this option.
+>    
+>                IF ( ( flag_metgrid .EQ. 1 ) .AND. &
+>                     ( config_flags%adjust_heights ) .AND. &
+>                     ( lev500 .NE. 0 ) ) THEN
+>    
+>                   DO k = 2 , kte-1
+>       
+>                      !  Get the pressures on the full eta levels (grid%em_php is defined above as 
+>                      !  the full-lev base pressure, an easy array to use for 3d space).
+>       
+>                      pl = grid%em_php(i,k  ,j) + &
+>                           ( grid%em_p(i,k-1  ,j) * ( grid%em_znw(k    ) - grid%em_znu(k  ) ) + &             
+>                             grid%em_p(i,k    ,j) * ( grid%em_znu(k-1  ) - grid%em_znw(k  ) ) ) / &
+>                           ( grid%em_znu(k-1  ) - grid%em_znu(k  ) )
+>                      pu = grid%em_php(i,k+1,j) + &
+>                           ( grid%em_p(i,k-1+1,j) * ( grid%em_znw(k  +1) - grid%em_znu(k+1) ) + &             
+>                             grid%em_p(i,k  +1,j) * ( grid%em_znu(k-1+1) - grid%em_znw(k+1) ) ) / &
+>                           ( grid%em_znu(k-1+1) - grid%em_znu(k+1) )
+>                    
+>                      !  If these pressure levels trap 500 mb, use them to interpolate
+>                      !  to the 500 mb level of the computed height.
+>        
+>                      IF ( ( pl .GE. 50000. ) .AND. ( pu .LT. 50000. ) ) THEN
+>                         zl = ( grid%em_ph_2(i,k  ,j) + grid%em_phb(i,k  ,j) ) / g
+>                         zu = ( grid%em_ph_2(i,k+1,j) + grid%em_phb(i,k+1,j) ) / g
+>       
+>                         z500 = ( zl * ( LOG(50000.) - LOG(pu    ) ) + &
+>                                  zu * ( LOG(pl    ) - LOG(50000.) ) ) / &
+>                                ( LOG(pl) - LOG(pu) ) 
+> !                       z500 = ( zl * (    (50000.) -    (pu    ) ) + &
+> !                                zu * (    (pl    ) -    (50000.) ) ) / &
+> !                              (    (pl) -    (pu) ) 
+>       
+>                         !  Compute the difference of the 500 mb heights (computed minus input), and
+>                         !  then the change in grid%em_mu_2.  The grid%em_php is still full-levels, base pressure.
+>       
+>                         dz500 = z500 - grid%em_ght_gc(i,lev500,j)
+>                         tvsfc = ((grid%em_t_2(i,1,j)+t0)*((grid%em_p(i,1,j)+grid%em_php(i,1,j))/p1000mb)**(r_d/cp)) * &
+>                                 (1.+0.6*moist(i,1,j,P_QV))
+>                         dpmu = ( grid%em_php(i,1,j) + grid%em_p(i,1,j) ) * EXP ( g * dz500 / ( r_d * tvsfc ) )
+>                         dpmu = dpmu - ( grid%em_php(i,1,j) + grid%em_p(i,1,j) )
+>                         grid%em_mu_2(i,j) = grid%em_mu_2(i,j) - dpmu
+>                         EXIT
+>                      END IF
+>       
+>                   END DO
+>                ELSE
+>                   dpmu = 0.
+>                END IF
+1511,1575c1497
+< !               !  Adjust the column pressure so that the computed 500 mb height is close to the
+< !               !  input value (of course, not when we are doing hybrid input).
+< !   
+< !               IF ( ( flag_metgrid .EQ. 1 ) .AND. ( i .EQ. its ) .AND. ( j .EQ. jts ) ) THEN
+< !                  DO k = 1 , num_metgrid_levels
+< !                     IF ( ABS ( grid%em_p_gc(i,k,j) - 50000. ) .LT. 1. ) THEN
+< !                        lev500 = k
+< !                        EXIT
+< !                     END IF
+< !                  END DO
+< !               END IF
+< !           
+< !               !  We only do the adjustment of height if we have the input data on pressure
+< !               !  surfaces, and folks have asked to do this option.
+< !   
+< !               IF ( ( flag_metgrid .EQ. 1 ) .AND. &
+< !                    ( config_flags%adjust_heights ) .AND. &
+< !                    ( lev500 .NE. 0 ) ) THEN
+< !   
+< !                  DO k = 2 , kte-1
+< !      
+< !                     !  Get the pressures on the full eta levels (grid%em_php is defined above as 
+< !                     !  the full-lev base pressure, an easy array to use for 3d space).
+< !      
+< !                     pl = grid%em_php(i,k  ,j) + &
+< !                          ( grid%em_p(i,k-1  ,j) * ( grid%em_znw(k    ) - grid%em_znu(k  ) ) + &             
+< !                            grid%em_p(i,k    ,j) * ( grid%em_znu(k-1  ) - grid%em_znw(k  ) ) ) / &
+< !                          ( grid%em_znu(k-1  ) - grid%em_znu(k  ) )
+< !                     pu = grid%em_php(i,k+1,j) + &
+< !                          ( grid%em_p(i,k-1+1,j) * ( grid%em_znw(k  +1) - grid%em_znu(k+1) ) + &             
+< !                            grid%em_p(i,k  +1,j) * ( grid%em_znu(k-1+1) - grid%em_znw(k+1) ) ) / &
+< !                          ( grid%em_znu(k-1+1) - grid%em_znu(k+1) )
+< !                   
+< !                     !  If these pressure levels trap 500 mb, use them to interpolate
+< !                     !  to the 500 mb level of the computed height.
+< !!**** PB on MARS .... ?       
+< !                     IF ( ( pl .GE. 50000. ) .AND. ( pu .LT. 50000. ) ) THEN
+< !                        zl = ( grid%em_ph_2(i,k  ,j) + grid%em_phb(i,k  ,j) ) / g
+< !                        zu = ( grid%em_ph_2(i,k+1,j) + grid%em_phb(i,k+1,j) ) / g
+< !      
+< !                        z500 = ( zl * ( LOG(50000.) - LOG(pu    ) ) + &
+< !                                 zu * ( LOG(pl    ) - LOG(50000.) ) ) / &
+< !                               ( LOG(pl) - LOG(pu) ) 
+< !!                       z500 = ( zl * (    (50000.) -    (pu    ) ) + &
+< !!                                zu * (    (pl    ) -    (50000.) ) ) / &
+< !!                              (    (pl) -    (pu) ) 
+< !      
+< !                        !  Compute the difference of the 500 mb heights (computed minus input), and
+< !                        !  then the change in grid%em_mu_2.  The grid%em_php is still full-levels, base pressure.
+< !      
+< !                        dz500 = z500 - grid%em_ght_gc(i,lev500,j)
+< !                        tvsfc = ((grid%em_t_2(i,1,j)+t0)*((grid%em_p(i,1,j)+grid%em_php(i,1,j))/p1000mb)**(r_d/cp)) * &
+< !                                (1.+0.6*moist(i,1,j,P_QV))
+< !                        dpmu = ( grid%em_php(i,1,j) + grid%em_p(i,1,j) ) * EXP ( g * dz500 / ( r_d * tvsfc ) )
+< !                        dpmu = dpmu - ( grid%em_php(i,1,j) + grid%em_p(i,1,j) )
+< !                        grid%em_mu_2(i,j) = grid%em_mu_2(i,j) - dpmu
+< !                        EXIT
+< !                     END IF
+< !      
+< !                  END DO
+< !               ELSE
+< !                  dpmu = 0.
+< !               END IF
+< !
+< !            END DO
+---
+>             END DO
+1580,1619c1502,1537
+< !!****MARS: we use WPS
+< !
+< !      !  If this is data from the SI, then we probably do not have the original
+< !      !  surface data laying around.  Note that these are all the lowest levels
+< !      !  of the respective 3d arrays.  For surface pressure, we assume that the
+< !      !  vertical gradient of grid%em_p prime is zilch.  This is not all that important.
+< !      !  These are filled in so that the various plotting routines have something
+< !      !  to play with at the initial time for the model.
+< !
+< !      IF ( flag_metgrid .NE. 1 ) THEN
+< !         DO j = jts, min(jde-1,jte)
+< !            DO i = its, min(ide,ite)
+< !               grid%u10(i,j)=grid%em_u_2(i,1,j)
+< !            END DO
+< !         END DO
+< !   
+< !         DO j = jts, min(jde,jte)
+< !            DO i = its, min(ide-1,ite)
+< !               grid%v10(i,j)=grid%em_v_2(i,1,j)
+< !            END DO
+< !         END DO
+< !
+< !         DO j = jts, min(jde-1,jte)
+< !            DO i = its, min(ide-1,ite)
+< !               p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+< !               grid%psfc(i,j)=p_surf + grid%em_p(i,1,j)
+< !               grid%q2(i,j)=moist(i,1,j,P_QV)
+< !               grid%th2(i,j)=grid%em_t_2(i,1,j)+300.
+< !               grid%t2(i,j)=grid%th2(i,j)*(((grid%em_p(i,1,j)+grid%em_pb(i,1,j))/p00)**(r_d/cp))
+< !            END DO
+< !         END DO
+< !
+< !      !  If this data is from WPS, then we have previously assigned the surface
+< !      !  data for u, v, and t.  If we have an input qv, welp, we assigned that one,
+< !      !  too.  Now we pick up the left overs, and if RH came in - we assign the 
+< !      !  mixing ratio.
+< !
+< !      ELSE IF ( flag_metgrid .EQ. 1 ) THEN
+< !
+< !!****MARS: we use WPS
+---
+>       !  If this is data from the SI, then we probably do not have the original
+>       !  surface data laying around.  Note that these are all the lowest levels
+>       !  of the respective 3d arrays.  For surface pressure, we assume that the
+>       !  vertical gradient of grid%em_p prime is zilch.  This is not all that important.
+>       !  These are filled in so that the various plotting routines have something
+>       !  to play with at the initial time for the model.
+> 
+>       IF ( flag_metgrid .NE. 1 ) THEN
+>          DO j = jts, min(jde-1,jte)
+>             DO i = its, min(ide,ite)
+>                grid%u10(i,j)=grid%em_u_2(i,1,j)
+>             END DO
+>          END DO
+>    
+>          DO j = jts, min(jde,jte)
+>             DO i = its, min(ide-1,ite)
+>                grid%v10(i,j)=grid%em_v_2(i,1,j)
+>             END DO
+>          END DO
+> 
+>          DO j = jts, min(jde-1,jte)
+>             DO i = its, min(ide-1,ite)
+>                p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+>                grid%psfc(i,j)=p_surf + grid%em_p(i,1,j)
+>                grid%q2(i,j)=moist(i,1,j,P_QV)
+>                grid%th2(i,j)=grid%em_t_2(i,1,j)+300.
+>                grid%t2(i,j)=grid%th2(i,j)*(((grid%em_p(i,1,j)+grid%em_pb(i,1,j))/p00)**(r_d/cp))
+>             END DO
+>          END DO
+> 
+>       !  If this data is from WPS, then we have previously assigned the surface
+>       !  data for u, v, and t.  If we have an input qv, welp, we assigned that one,
+>       !  too.  Now we pick up the left overs, and if RH came in - we assign the 
+>       !  mixing ratio.
+> 
+>       ELSE IF ( flag_metgrid .EQ. 1 ) THEN
+1636c1554
+< !      END IF
+---
+>       END IF
+2186,2192d2103
+< !****MARS
+< !big problems ... discontinuity in the interpolated fields ...
+< print *, '25/05/2007: decided to use simple linear interpolations'
+< stop
+< !****MARS
+< 
+< 
+2616d2526
+< !****MARS
+2619d2528
+< !****MARS
+2621c2530
+<       !  Horizontal loop bounds for different variable types.
+---
+>       !  Horiontal loop bounds for different variable types.
+2765d2673
+< 
+2778d2685
+< 
+2782,2794d2688
+< !!****MARS
+< !!
+< !! Pressure level may be OK, however data from the diagfi is possibly missing
+< IF (forig(i,ko,j) .EQ. -1.0e+30) THEN
+<         ko_above_sfc(i) = -1
+< END IF
+<         !! Once the right start level is found, check that it is OK
+<         !! >> first column should be 1e30 or so, second column should be a realistic value
+<         !IF ( ko_above_sfc(i) .NE. -1 ) THEN
+<         !        print *, 'verif', forig(i,ko-1,j), forig(i,ko,j), forig(i,ko+1,j), ko
+<         !END IF
+< !!
+< !!****MARS
+2797d2690
+< 
+2843,2844d2735
+< !****MARS
+< !the possible issue is fixed later in the code ...
+2847d2737
+< !****MARS
+2882,2885d2771
+< !!****MARS
+< !!check: values are usually quite close
+< !print *,porig(i,1,j),pnew(i,kn,j)
+< !!****MARS
+2905,2910d2790
+< !!****MARS
+< k_above(i,kn) = 1
+< ks(i) = 1
+< !!"Hopefully, we are not extrapolating too far"
+< !!>> true on Mars ?? 
+< !!****MARS
+2941,2958d2820
+< !!****MARS
+< !!ne doit pas arriver avec la temperature si l'on definit bien le champ au sol
+< IF (forig(i,1,j) .EQ. -1.0e+30) THEN
+<         print *,'no data here - surface - var is ...',var_type,i,j,1
+<         print *,'setting to first level with data...',ko_above_sfc(i),porig(i,ko_above_sfc(i),j)
+<         forig(i,1,j) = forig(i,ko_above_sfc(i),j)
+<         !IF      ( ( var_type .EQ. 'U' ) .OR. &
+<         !    ( var_type .EQ. 'V' ) .OR. &
+<         !    ( var_type .EQ. 'Q' ) ) THEN
+<         !    print *,'zero wind at the ground'
+<         !    forig(i,1,j) = 0
+<         !ENDIF
+<                 IF (forig(i,1,j) .EQ. -1.0e+30) THEN
+<                 print *,'well ... are you sure ?'
+<                 stop
+<                 ENDIF
+< END IF
+< !!****MARS
+2966,2979d2827
+< !!****MARS
+< IF (forig(i,k2,j) .EQ. -1.0e+30) THEN
+<         print *,'no data here - level above - you_d better stop',i,j,k2
+<         stop        
+< END IF
+< IF (forig(i,k1,j) .EQ. -1.0e+30) THEN
+<         print *,'no data here - level below - var is ...',var_type,i,j,k1
+<         print *,'setting to first level with data...',ko_above_sfc(i),porig(i,ko_above_sfc(i),j)
+<         forig(i,k1,j) = forig(i,ko_above_sfc(i),j)
+<         !!!VERIFIER QUE LA TEMPERATURE AU SOL N'EST PAS CONCERNEE
+<         !!!(montagnes=sources locales de chaleur)
+<         !!!normalement, pas de souci, et lors de l'exécution rien ne s'affiche
+< END IF
+< !!****MARS
+3026d2873
+< print *,'finished with ... ', var_type
+3062d2908
+< 
+3089,3097d2934
+< !****MARS: check if no errors here
+< !print *,'interpolating ... ',var_type
+< !       print *,'i,j = ',i,j
+< !       print *,'target pressure and value = ',target_x(target_loop),target_y(target_loop)
+< !       DO loop = 1 , all_dim
+< !         print *,'column of pressure and value = ',all_x(loop),all_y(loop)
+< !       END DO
+< !END IF  
+< !****MARS
+3118,3119d2954
+< !****MARS: normally, no errors here (otherwise, keep this part commented ?)
+<             print *, var_type
+3125,3126c2960
+<            CALL wrf_error_fatal ( 'troubles, could not find trapping x locations' )
+< !****MARS: end of 'keep this part commented'
+---
+>             CALL wrf_error_fatal ( 'troubles, could not find trapping x locations' )
+3313,3317c3147,3149
+< !****MARS ....
+<       REAL , PARAMETER :: Rd = 192.
+<       REAL , PARAMETER :: g  =   3.72
+< print *,'compute dry, hydrostatic surface pressure'
+< !****MARS ....
+---
+> 
+>       REAL , PARAMETER :: Rd = 287.
+>       REAL , PARAMETER :: g  =   9.8
+3325,3334d3156
+< !****MARS
+< !****MARS cette formule est-elle juste sur Mars ?
+< !****MARS >> a première vue, ne donne pas de résultats absurdes
+< !****TODO: il y a peut être meilleur !
+< !****MARS
+< 
+< !print *,pdhs
+< !stop
+< 
+< 
+3408,3412c3230,3233
+< !****MARS 
+<       REAL , PARAMETER :: Rd = 192.
+<       REAL , PARAMETER :: Cp = 844.6
+< !****MARS
+<       
+---
+> 
+>       REAL , PARAMETER :: Rd = 287.
+>       REAL , PARAMETER :: Cp = 1004.
+> 
+3456,3460c3277,3278
+< !****MARS
+<       REAL , PARAMETER :: Rd = 192.
+<       REAL , PARAMETER :: g  =   3.72
+< !****MARS
+<       
+---
+>       REAL , PARAMETER :: Rd = 287.
+>       REAL , PARAMETER :: g  =   9.8
+3597,3605d3414
+< 
+< !!****MARS: no water vapor pressure
+< !    DO k = level_above_sfc(i)-1,kts+1,-1
+< !         pd(i,k) = p(i,k)
+< !    END DO
+< !    pd(i,kts) = psfc(i,j)
+< !!****MARS
+< 
+< 
+3632,3633c3441
+< !****MARS .... à régler si besoin ....
+< !****MARS
+---
+> 
+3663,3665d3470
+< !****MARS
+< !****MARS
+< 
+3743,3749d3547
+< !****MARS
+< !****TEMPORARY
+< !****TEMPORARY
+< !TODO: change once tracers are activated ?
+< q=0.
+< !****MARS
+< 
+3788,3796d3585
+< !****MARS      
+< !****MARS
+< print *, 'check Mars: p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0' 
+< print *, p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0
+< !-----solution alternative: définir dans la namelist les niveaux verticaux
+< !****MARS
+< !****MARS
+< 
+< 
+3823,3843c3612,3613
+< !         znw_prac = (/ 1.000 , 0.993 , 0.983 , 0.970 , 0.954 , 0.934 , 0.909 , &
+< !                       0.88 , 0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+< 
+< !****MARS
+< !****MARS
+< ! on Mars, this is important to correctly resolve the surface
+< ! -- levels were changed to get closer to the surface
+< ! -- values were chosen as done typically in LMD GCM simulations
+< !TODO: better repartition ?
+<         znw_prac = (/ 1.000 , &
+<                         0.9995 , &  
+<                         0.9980 , &
+<                         0.9950 , &
+<                         0.9850 , &
+<                         0.9700 , &
+<                         0.9400 , &
+<                         0.9000 , &
+<                         0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+< !****MARS
+< !****MARS
+< 
+---
+>          znw_prac = (/ 1.000 , 0.993 , 0.983 , 0.970 , 0.954 , 0.934 , 0.909 , &
+>                        0.88 , 0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+3876a3647
+> 
+3901d3671
+< 
+3911,3920d3680
+< !!****MARS
+< !!attention 'base_lapse' ne doit pas être trop grand
+< !!sinon ... des NaN car températures négatives en haut
+< !IF ( ( loop1 .EQ. 5 ) .AND. ( loop .EQ. 10 ) ) THEN
+< !	IF (k .EQ. 8) THEN
+< !		print *, 'p,t,z,k'
+< !	END IF
+< !	print *,  pb,temp,znw(k+1),k 
+< !END IF
+< !****MARS
+3950,3960d3709
+< 
+< ! ****MARS
+< ! Display the computed levels
+< print *,'WRF levels are:'
+< print *,'z (m)            = ',phb(1)/g
+< do k = 2 ,kte
+< print *,'z (m) and dz (m) = ',phb(k)/g,(phb(k)-phb(k-1))/g
+< end do
+< ! ****MARS
+< 
+< 
+4108,4115c3857
+< !****MARS
+<       REAL , PARAMETER :: Rd = 192.
+<       REAL , PARAMETER :: Cp = 844.6
+<       REAL, PARAMETER    :: g = 3.72
+<       REAL, PARAMETER    :: pconst = 610.
+< !****MARS
+<       
+< !****MARS .... to be changed if used
+---
+>       REAL, PARAMETER    :: g         = 9.8
+4116a3859,3860
+>       REAL, PARAMETER    :: pconst    = 10000.0
+>       REAL, PARAMETER    :: Rd        = 287.
+4117a3862
+> 
+4120d3864
+< !****MARS .... to be changed if used
+4158,4163d3901
+< !****MARS ....
+< !****MARS .... the mean sea level method is abandoned
+< print *, 'no sea level pressure on Mars, please'
+< stop
+< !****MARS ....
+< 
+4412,4415c4150,4151
+< !****MARS
+<       REAL , PARAMETER :: Rd = 192.
+<       REAL, PARAMETER    :: g = 3.72
+< !****MARS
+---
+>       REAL, PARAMETER    :: g         = 9.8
+>       REAL, PARAMETER    :: Rd        = 287.
+4435,4444c4171,4172
+< 
+< !****MARS: as is done in MCD/pres0 with the MOLA topography :)
+< 
+< 
+<         !!  del_z = diff in surface topo, lo-res vs hi-res
+<         !grid%em_ght_gc - grid%ht
+<         !!* em_ght_gc: surface geopotential height from the GCM 
+<         !!* ht: hi-res altimetry
+<         !  psfc = psfc_in * exp ( g del_z / (Rd Tv_sfc ) )
+< 
+---
+>       !  del_z = diff in surface topo, lo-res vs hi-res
+>       !  psfc = psfc_in * exp ( g del_z / (Rd Tv_sfc ) )
+4448,4450d4175
+< !!
+< !!****MARS: 'ez_method' is 'we_have_tavgsfc', hard-coded as false
+< !!
+4459,4462d4183
+< !!****MARS .... here is what is done
+< !!****TODO:
+< !!****MARS .... toujours 0.608 ???
+< !!****MARS .... changer pour la température à 1 km ??? 
+4468,4478d4188
+< !	       !****MARS .... check of the altimetry differences
+< !	       print *,del_z, tv_sfc
+< 
+< 
+< !****MARS
+< !****MARS .... which temperature is used in the Laplace formula ?
+< !!****TODO: change the 220K value ??
+< !!****NB: pas d'influence énorme cependant de la valeur de T 
+< psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * 220 ) )
+< 
+< 
Index: trunk/WRF.COMMON/WRFV2/dyn_em/diff_solve_em
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/diff_solve_em	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/diff_solve_em	(revision 2744)
@@ -0,0 +1,91 @@
+37a38,43
+> !****MARS
+> ! in the dyn_em folder physics driver are only used here
+> !#ifdef WRF_Mars
+>    USE module_lmd_driver
+> !#endif  
+> !****MARS
+66a73,76
+> !****MARS
+>    INTEGER                         :: ngrid,nlayer,nq
+> !****MARS
+> 
+666a677,678
+> !!****MARS: must set config_flags%bl_pbl_physics to 0
+> 
+798a811,871
+> 
+> !****MARS
+> !!!!!!!!!!!!!!!!!!!!!!!
+> ! call to LMD physics !
+> !!!!!!!!!!!!!!!!!!!!!!!
+> 
+>           CALL wrf_debug ( 200 , ' call lmd_driver' )
+> 
+> !BENCH_START(lmd_driver_tim)
+> 
+>          CALL lmd_driver(                                                 &
+>            ! structure
+>      &         DT=grid%dt,HBOT=grid%hbot,HTOP=grid%htop                   &
+>      &        ,ITIMESTEP=grid%itimestep                                   &
+>            ! position
+>      &        ,XLAT=grid%xlat,XLONG=grid%xlong                            &
+>      &        ,DX=grid%dx         ,DY=grid%dy                             &
+>      &        ,MSFT=grid%msft,MSFU=grid%msfu,MSFV=grid%msfv               &
+>            ! indexes
+>      &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+>      &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+>      &        ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1)          &
+>      &        ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1)          &
+>      &        ,kts=k_start, kte=min(k_end,kde-1)                          &
+>      &        ,num_tiles=grid%num_tiles                                   &
+>            ! time variables
+>      &        ,GMT=grid%gmt       ,JULYR=grid%julyr   ,JULDAY=grid%julday &
+>            ! output from phy_prep
+>      &        ,P8W=p8w            ,DZ8W=dz8w          ,T8W=t8w            &
+>            ! Prognostic variables at p points
+>      &        ,Z=grid%em_z                                                &
+>                         ! z is the geopotential height at p points 
+>                         ! ... (cf phy_prep in module_big_step_utilities_em)
+>      &        ,HT=grid%ht                                                 &
+>      &        ,U=u_phy            ,V=v_phy                                &
+>      &        ,TH=th_phy          ,T=t_phy                                &
+>      &        ,P=p_phy            ,EXNER=pi_phy               ,RHO=rho    &
+>            ! flags
+> !     &       ,LW_PHYSICS=config_flags%ra_lw_physics                      &
+> !     &       ,SW_PHYSICS=config_flags%ra_sw_physics                      &
+>      &        ,ICLOUD=config_flags%icloud                                 &
+>            ! radiation
+>      &        ,EMISS=grid%emiss,GLW=grid%glw,GSW=grid%gsw                 &
+>      &        ,ALBEDO=grid%albedo,RADT=grid%radt,SWDOWN=grid%swdown       &
+>            ! surface temperature and surface pressure
+>      &        ,TSK=grid%tsk,PSFC=grid%psfc                                &
+>            ! tendencies for the dynamics
+>      &        ,RTHRATEN=grid%rthraten                                     &
+> !    &        ,RTHRATENLW=grid%rthratenlw,RTHRATENSW=grid%rthratensw &
+>      &        ,RQCBLTEN=grid%rqcblten,RQIBLTEN=grid%rqiblten,RQVBLTEN=grid%rqvblten  &
+>      &        ,RTHBLTEN=grid%rthblten  ,RUBLTEN=grid%rublten,RVBLTEN=grid%rvblten    &
+>            ! added variables
+> !     &        ,MARS_ALB=grid%mars_alb,MARS_TI=grid%mars_ti	&
+> !     &        ,MARS_ALB=grid%em_al_gc,THERM_INERT=grid%em_ti_gc  &
+>      &        ,MARS_ALB=grid%u10,MARS_TI=grid%v10  &
+> !     &        ,MARS_ALB=grid%st000010,MARS_TI=grid%st010040	&
+>            ! end
+>      &                                                              )
+> !BENCH_END(lmd_driver_tim)
+> !****MARS
+> 
+1020c1093,1095
+<       IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN
+---
+> 
+> !!****MARS: you never know ...
+> !      IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN
+1022c1097,1099
+<       ENDIF
+---
+> !      ENDIF
+> 
+> 
+1097a1175
+> !****MARS: OK if diff_opt ne 2
Index: trunk/WRF.COMMON/WRFV2/dyn_em/diff_start_em
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/diff_start_em	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/diff_start_em	(revision 2744)
@@ -0,0 +1,17 @@
+475a476,481
+> !!****MARS   
+> !!****
+> !!**** second line: special Mars stuff
+> !!****
+> !!****MARS
+> 
+476a483
+>                       grid%em_albedo_gcm,grid%em_therm_inert,                 & 
+523c530,531
+<                       itimestep=grid%itimestep, fdob=grid%fdob             &
+---
+>                       itimestep=grid%itimestep,  &
+> 			fdob=grid%fdob	&
+525a534,535
+> 
+> 
Index: trunk/WRF.COMMON/WRFV2/dyn_em/init_modules_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/init_modules_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/init_modules_em.F	(revision 2744)
@@ -0,0 +1,5 @@
+!WRF:MEDIATION_LAYER
+!
+SUBROUTINE init_modules_em
+END SUBROUTINE init_modules_em
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/interp_domain_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/interp_domain_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/interp_domain_em.F	(revision 2744)
@@ -0,0 +1,59 @@
+#ifdef DM_PARALLEL
+
+subroutine dummy_interp_em
+! these routines will be provided the module_dm from the appropriate external package
+! this dummy routine is just here for compilers that complain if they do not see 
+! some fortran
+end
+
+#else
+
+! Note: since nesting is not supported single-processor except with
+! the non-MPI configurations using RSL, this is basically dead-code.
+! Needs to be here for linking purposes only.
+
+SUBROUTINE interp_domain_em_part1 ( grid, ngrid, config_flags   &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid , ngrid
+#include <em_dummy_new_decl.inc>
+
+      INTEGER nlev
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+      ! code here to interpolate the data into the nested domain
+#  include "em_nest_interpdown_interp.inc"
+
+      RETURN
+
+END SUBROUTINE interp_domain_em_part1
+
+! Stub ... not used in serial code
+SUBROUTINE interp_domain_em_part2
+END SUBROUTINE interp_domain_em_part2
+
+#endif
+
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_advect_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_advect_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_advect_em.F	(revision 2744)
@@ -0,0 +1,8124 @@
+!WRF:MODEL_LAYER:DYNAMICS
+!
+MODULE module_advect_em
+
+  USE module_bc
+  USE module_model_constants
+  USE module_wrf_error
+
+CONTAINS
+
+
+SUBROUTINE mass_flux_divergence ( field, field_old, tendency,    &
+                                  ru, rv, rom,                   &
+                                  mut, config_flags,             &
+                                  msfu, msfv, msft,              &
+                                  fzm, fzp,                      &
+                                  rdx, rdy, rdzw,                &
+                                  ids, ide, jds, jde, kds, kde,  &
+                                  ims, ime, jms, jme, kms, kme,  &
+                                  its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field,     &
+                                                                      field_old, &
+                                                                      ru,        &
+                                                                      rv,        &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: imin, imax, jmin, jmax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw
+   REAL , DIMENSION(its:ite,kts:kte) :: vflux
+
+   LOGICAL :: specified
+
+!--------------- horizontal flux
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end
+      mrdx=msft(i,j)*rdx
+      tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5 &
+                      *(ru(i+1,k,j)*(field(i+1,k,j)+field(i  ,k,j)) &
+                       -ru(i  ,k,j)*(field(i  ,k,j)+field(i-1,k,j)))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end
+      mrdy=msft(i,j)*rdy
+      tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5 &
+                      *(rv(i,k,j+1)*(field(i,k,j+1)+field(i,k,j  )) &
+                       -rv(i,k,j  )*(field(i,k,j  )+field(i,k,j-1))) 
+   ENDDO
+   ENDDO
+   ENDDO
+   
+!----------------  vertical flux divergence
+
+
+   DO i = i_start, i_end
+      vflux(i,kts)=0.
+      vflux(i,kte)=0.
+   ENDDO
+
+   DO j = j_start, j_end
+
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+         vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+      ENDDO
+      ENDDO
+
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+      ENDDO
+      ENDDO
+
+   ENDDO
+   
+END SUBROUTINE mass_flux_divergence
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE advect_u   ( u, u_old, tendency,            &
+                        ru, rv, rom,                   &
+                        mut, time_step, config_flags,  &
+                        msfu ,        msfv ,           &
+                        msft ,                         &
+                        fzm, fzp,                      &
+                        rdx, rdy, rdzw,                &
+                        ids, ide, jds, jde, kds, kde,  &
+                        ims, ime, jms, jme, kms, kme,  &
+                        its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: u,     &
+                                                                      u_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+   INTEGER ,                                     INTENT(IN   ) :: time_step
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax, im, ip
+   INTEGER :: jp1, jp0, jtmp
+
+   INTEGER :: horz_order, vert_order
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw, dvm, dvp
+   REAL , DIMENSION(its:ite, kts:kte) :: vflux
+
+
+   REAL,  DIMENSION( its-1:ite+1, kts:kte ) :: fqx
+   REAL,  DIMENSION( its:ite, kts:kte, 2) :: fqy
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
+
+   flux4(q_im2, q_im1, q_i, q_ip1, ua) =                         &
+          ( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+
+   flux3(q_im2, q_im1, q_i, q_ip1, ua) =                         &
+            flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+            sign(1,time_step)*sign(1.,ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
+
+   flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =           &
+                      ( 37.*(q_i+q_im1) - 8.*(q_ip1+q_im2)       &
+                     +(q_ip2+q_im3) )/60.0
+
+   flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =           &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)     &
+            -sign(1,time_step)*sign(1.,ua)*(                     &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )/60.0
+
+
+   LOGICAL :: specified
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+!  set order for vertical and horzontal flux operators
+
+   horz_order = config_flags%h_mom_adv_order
+   vert_order = config_flags%v_mom_adv_order
+
+   ktf=MIN(kte,kde-1)
+
+!  begin with horizontal flux divergence
+
+   horizontal_order_test : IF( horz_order == 6 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-4)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = ite
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN  ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+          fqy( i, k, jp1 ) = vel*flux6(               &
+                  u(i,k,j-3), u(i,k,j-2), u(i,k,j-1),       &
+                  u(i,k,j  ), u(i,k,j+1), u(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+!  we must be close to some boundary where we need to reduce the order of the stencil
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))  &
+                                     *(u(i,k,j)+u(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+              fqy( i, k, jp1 ) = vel*flux4(      &
+                   u(i,k,j-2),u(i,k,j-1), u(i,k,j),u(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))    &
+                     *(u(i,k,j)+u(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+              fqy( i, k, jp1 ) = vel*flux4(     &
+                   u(i,k,j-2),u(i,k,j-1),    &
+                   u(i,k,j),u(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+      END IF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msfu(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+   ENDDO j_loop_y_flux_6
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = ids+3
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-1,ite)
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i,k ) = vel*flux6( u(i-3,k,j), u(i-2,k,j),  &
+                                         u(i-1,k,j), u(i  ,k,j),  &
+                                         u(i+1,k,j), u(i+2,k,j),  &
+                                         vel                     )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+!  specified uses upstream normal wind at boundaries
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+              ub = u(i-1,k,j)
+              IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i,k,j)+ub)
+            ENDDO
+          END IF
+
+          i = ids+2
+          DO k=kts,ktf
+            vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+            fqx( i, k  ) = vel*flux4( u(i-2,k,j), u(i-1,k,j),  &
+                                           u(i  ,k,j), u(i+1,k,j),  &
+                                           vel                     )
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-1 ) THEN ! second order flux next to the boundary
+            i = ide
+            DO k=kts,ktf
+              ub = u(i,k,j)
+              IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i-1,k,j)+ub)
+            ENDDO
+          ENDIF
+
+          DO k=kts,ktf
+          i = ide-1
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i,k ) = vel*flux4( u(i-2,k,j), u(i-1,k,j),  &
+                                         u(i  ,k,j), u(i+1,k,j),  &
+                                         vel                     )
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msfu(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 5 ) THEN
+
+!  5th order horizontal flux calculation
+!  This code is EXACTLY the same as the 6th order code
+!  EXCEPT the 5th order and 3rd operators are used in
+!  place of the 6th and 4th order operators
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-4)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = ite
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN  ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+          fqy( i, k, jp1 ) = vel*flux5(               &
+                  u(i,k,j-3), u(i,k,j-2), u(i,k,j-1),       &
+                  u(i,k,j  ), u(i,k,j+1), u(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+!  we must be close to some boundary where we need to reduce the order of the stencil
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))  &
+                                     *(u(i,k,j)+u(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+              fqy( i, k, jp1 ) = vel*flux3(      &
+                   u(i,k,j-2),u(i,k,j-1), u(i,k,j),u(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))    &
+                     *(u(i,k,j)+u(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+              fqy( i, k, jp1 ) = vel*flux3(     &
+                   u(i,k,j-2),u(i,k,j-1),    &
+                   u(i,k,j),u(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+      END IF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msfu(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+   ENDDO j_loop_y_flux_5
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = ids+3
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-1,ite)
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i,k ) = vel*flux5( u(i-3,k,j), u(i-2,k,j),  &
+                                         u(i-1,k,j), u(i  ,k,j),  &
+                                         u(i+1,k,j), u(i+2,k,j),  &
+                                         vel                     )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+!  specified uses upstream normal wind at boundaries
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+              ub = u(i-1,k,j)
+              IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i,k,j)+ub)
+            ENDDO
+          END IF
+
+          i = ids+2
+          DO k=kts,ktf
+            vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+            fqx( i, k  ) = vel*flux3( u(i-2,k,j), u(i-1,k,j),  &
+                                           u(i  ,k,j), u(i+1,k,j),  &
+                                           vel                     )
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-1 ) THEN ! second order flux next to the boundary
+            i = ide
+            DO k=kts,ktf
+              ub = u(i,k,j)
+              IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i-1,k,j)+ub)
+            ENDDO
+          ENDIF
+
+          DO k=kts,ktf
+          i = ide-1
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i,k ) = vel*flux3( u(i-2,k,j), u(i-1,k,j),  &
+                                         u(i  ,k,j), u(i+1,k,j),  &
+                                         vel                     )
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msfu(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 4 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-1)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- x - advection first
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-1
+        i_end_f = ide-1
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i, k ) = vel*flux4( u(i-2,k,j), u(i-1,k,j),      &
+                                   u(i  ,k,j), u(i+1,k,j), vel )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+!  specified uses upstream normal wind at boundaries
+
+        IF( degrade_xs ) THEN
+          i = i_start
+          DO k=kts,ktf
+              ub = u(i-1,k,j)
+              IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i,k,j)+ub)
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          i = i_end+1
+          DO k=kts,ktf
+              ub = u(i,k,j)
+              IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i-1,k,j)+ub)
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msfu(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+!  y flux divergence
+
+      i_start = its
+      i_end   = ite
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!CJM these may not work with tiling because they define j_start and end in terms of domain dim
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+
+!  j flux loop for v flux of u momentum
+
+     jp1 = 2
+     jp0 = 1
+
+   DO j = j_start, j_end+1
+
+     IF ( (j < j_start_f) .and. degrade_ys) THEN
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         fqy(i, k, jp1) = 0.25*(rv(i,k,j_start)+rv(i-1,k,j_start))  &
+               *(u(i,k,j_start)+u(i,k,j_start-1))
+       ENDDO
+       ENDDO
+     ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         ! Assumes j>j_end_f is ONLY j_end+1 ...
+!         fqy(i, k, jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))    &
+!                *(u(i,k,j_end+1)+u(i,k,j_end))
+         fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))    &
+                *(u(i,k,j)+u(i,k,j-1))
+       ENDDO
+       ENDDO
+     ELSE
+!  3rd or 4th order flux
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+         fqy( i, k, jp1 ) = vel*flux4( u(i,k,j-2), u(i,k,j-1),  &
+                                       u(i,k,j  ), u(i,k,j+1),  &
+                                            vel                )
+       ENDDO
+       ENDDO
+
+     END IF
+
+!  y flux-divergence into tendency
+
+     IF (j > j_start) THEN
+
+       DO k=kts,ktf
+       DO i = i_start, i_end
+          mrdy=msfu(i,j-1)*rdy
+          tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+       ENDDO
+       ENDDO
+
+     END IF
+
+
+     jtmp = jp1
+     jp1 = jp0
+     jp0 = jtmp
+
+  ENDDO
+
+  ELSE IF ( horz_order == 3 ) THEN
+
+!  As with the 5th and 6th order flux chioces, the 3rd and 4th order
+!  code is EXACTLY the same EXCEPT for the flux operator.
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-1)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- x - advection first
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-1
+        i_end_f = ide-1
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i, k ) = vel*flux3( u(i-2,k,j), u(i-1,k,j),      &
+                                   u(i  ,k,j), u(i+1,k,j), vel )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+!  specified uses upstream normal wind at boundaries
+
+        IF( degrade_xs ) THEN
+          i = i_start
+          DO k=kts,ktf
+              ub = u(i-1,k,j)
+              IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i,k,j)+ub)
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          i = i_end+1
+          DO k=kts,ktf
+              ub = u(i,k,j)
+              IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i-1,k,j)+ub)
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+          mrdx=msfu(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+      ENDDO
+
+!  y flux divergence
+
+      i_start = its
+      i_end   = ite
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!CJM these may not work with tiling because they define j_start and end in terms of domain dim
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+
+!  j flux loop for v flux of u momentum
+
+     jp1 = 2
+     jp0 = 1
+
+   DO j = j_start, j_end+1
+
+     IF ( (j < j_start_f) .and. degrade_ys) THEN
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         fqy(i, k, jp1) = 0.25*(rv(i,k,j_start)+rv(i-1,k,j_start))  &
+               *(u(i,k,j_start)+u(i,k,j_start-1))
+       ENDDO
+       ENDDO
+     ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         ! Assumes j>j_end_f is ONLY j_end+1 ...
+!         fqy(i, k, jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))    &
+!                *(u(i,k,j_end+1)+u(i,k,j_end))
+         fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))    &
+                *(u(i,k,j)+u(i,k,j-1))
+       ENDDO
+       ENDDO
+     ELSE
+!  3rd or 4th order flux
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+         fqy( i, k, jp1 ) = vel*flux3( u(i,k,j-2), u(i,k,j-1),  &
+                                       u(i,k,j  ), u(i,k,j+1),  &
+                                            vel                )
+       ENDDO
+       ENDDO
+
+     END IF
+
+!  y flux-divergence into tendency
+
+     IF (j > j_start) THEN
+
+       DO k=kts,ktf
+       DO i = i_start, i_end
+          mrdy=msfu(i,j-1)*rdy
+          tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+       ENDDO
+       ENDDO
+
+     END IF
+
+
+     jtmp = jp1
+     jp1 = jp0
+     jp0 = jtmp
+
+  ENDDO
+
+  ELSE IF ( horz_order == 2 ) THEN
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe ) i_end   = MIN(ide-1,ite)
+      IF ( specified ) i_start = MAX(ids+2,its)
+      IF ( specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+         mrdx=msfu(i,j)*rdx
+         tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
+                *((ru(i+1,k,j)+ru(i,k,j))*(u(i+1,k,j)+u(i,k,j)) &
+                -(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+u(i-1,k,j)))
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF ( specified .AND. its .LE. ids+1 .AND. .NOT. config_flags%periodic_x ) THEN
+        DO j = j_start, j_end
+        DO k=kts,ktf
+           i = ids+1
+           mrdx=msfu(i,j)*rdx
+           ub = u(i-1,k,j)
+           IF (u(i,k,j) .LT. 0.) ub = u(i,k,j)
+           tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
+                  *((ru(i+1,k,j)+ru(i,k,j))*(u(i+1,k,j)+u(i,k,j)) &
+                  -(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+ub))
+        ENDDO
+        ENDDO
+      ENDIF
+      IF ( specified .AND. ite .GE. ide-1 .AND. .NOT. config_flags%periodic_x ) THEN
+        DO j = j_start, j_end
+        DO k=kts,ktf
+           i = ide-1
+           mrdx=msfu(i,j)*rdx
+           ub = u(i+1,k,j)
+           IF (u(i,k,j) .GT. 0.) ub = u(i,k,j)
+           tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
+                  *((ru(i+1,k,j)+ru(i,k,j))*(ub+u(i,k,j)) &
+                  -(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+u(i-1,k,j)))
+        ENDDO
+        ENDDO
+      ENDIF
+
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+         mrdy=msfu(i,j)*rdy
+            tendency(i,k,j)=tendency(i,k,j)-mrdy*0.25 &
+                *((rv(i,k,j+1)+rv(i-1,k,j+1))*(u(i,k,j+1)+u(i,k,j)) &
+                 -(rv(i,k,j)+rv(i-1,k,j))*(u(i,k,j)+u(i,k,j-1)))
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF ( horz_order == 0 ) THEN
+
+      ! Just in case we want to turn horizontal advection off, we can do it
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_u_6a:  h_order not known ',horz_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF horizontal_order_test
+
+!  radiative lateral boundary condition in x for normal velocity (u)
+
+      IF ( (config_flags%open_xs) .and. its == ids ) THEN
+
+        j_start = jts
+        j_end   = MIN(jte,jde-1)
+
+        DO j = j_start, j_end
+        DO k = kts, ktf
+          ub = MIN(ru(its,k,j)-cb*mut(its,j), 0.)
+          tendency(its,k,j) = tendency(its,k,j)                    &
+                      - rdx*ub*(u_old(its+1,k,j) - u_old(its,k,j))
+        ENDDO
+        ENDDO
+
+      ENDIF
+
+      IF ( (config_flags%open_xe) .and. ite == ide ) THEN
+
+        j_start = jts
+        j_end   = MIN(jte,jde-1)
+
+        DO j = j_start, j_end
+        DO k = kts, ktf
+          ub = MAX(ru(ite,k,j)+cb*mut(ite-1,j), 0.)
+          tendency(ite,k,j) = tendency(ite,k,j)                    &
+                      - rdx*ub*(u_old(ite,k,j) - u_old(ite-1,k,j))
+        ENDDO
+        ENDDO
+
+      ENDIF
+
+!  pick up the rest of the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb')
+!  first, set to index ranges
+
+      i_start = its
+      i_end   = MIN(ite,ide)
+      imin    = ids
+      imax    = ide-1
+
+      IF (config_flags%open_xs) THEN
+        i_start = MAX(ids+1, its)
+        imin = ids
+      ENDIF
+      IF (config_flags%open_xe) THEN
+        i_end = MIN(ite,ide-1)
+        imax = ide-1
+      ENDIF
+
+   IF( (config_flags%open_ys) .and. (jts == jds)) THEN
+
+      DO i = i_start, i_end
+
+         mrdy=msfu(i,jts)*rdy
+         ip = MIN( imax, i   )
+         im = MAX( imin, i-1 )
+
+         DO k=kts,ktf
+
+          vw = 0.5*(rv(ip,k,jts)+rv(im,k,jts))
+          vb = MIN( vw, 0. )
+          dvm =  rv(ip,k,jts+1)-rv(ip,k,jts)
+          dvp =  rv(im,k,jts+1)-rv(im,k,jts)
+          tendency(i,k,jts)=tendency(i,k,jts)-mrdy*(                &
+                            vb*(u_old(i,k,jts+1)-u_old(i,k,jts))    &
+                           +0.5*u(i,k,jts)*(dvm+dvp))
+         ENDDO
+      ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ye) .and. (jte == jde)) THEN
+
+      DO i = i_start, i_end
+
+         mrdy=msfu(i,jte-1)*rdy
+         ip = MIN( imax, i   )
+         im = MAX( imin, i-1 )
+
+         DO k=kts,ktf
+
+          vw = 0.5*(rv(ip,k,jte)+rv(im,k,jte))
+          vb = MAX( vw, 0. )
+          dvm =  rv(ip,k,jte)-rv(ip,k,jte-1)
+          dvp =  rv(im,k,jte)-rv(im,k,jte-1)
+          tendency(i,k,jte-1)=tendency(i,k,jte-1)-mrdy*(              &
+                              vb*(u_old(i,k,jte-1)-u_old(i,k,jte-2))  &
+                             +0.5*u(i,k,jte-1)*(dvm+dvp))
+         ENDDO
+      ENDDO
+
+   ENDIF
+
+!-------------------- vertical advection
+
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = min(jte,jde-1)
+
+!   IF ( config_flags%open_xs ) i_start = MAX(ids+1,its)
+!   IF ( config_flags%open_xe ) i_end   = MIN(ide-1,ite)
+
+   IF ( config_flags%open_ys .or. specified ) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_ye .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+   DO i = i_start, i_end
+     vflux(i,kts)=0.
+     vflux(i,kte)=0.
+   ENDDO
+
+   vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
+           vflux(i,k) = vel*flux6(                     &
+                   u(i,k-3,j), u(i,k-2,j), u(i,k-1,j),       &
+                   u(i,k  ,j), u(i,k+1,j), u(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j))  &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i-1,k,j)) 
+           vflux(i,k) = vel*flux4(       &
+                   u(i,k-2,j), u(i,k-1,j),   &
+                   u(i,k  ,j), u(i,k+1,j), -vel )
+           k = ktf-1
+           vel=0.5*(rom(i,k,j)+rom(i-1,k,j)) 
+           vflux(i,k) = vel*flux4(       &
+                   u(i,k-2,j), u(i,k-1,j),   &
+                   u(i,k  ,j), u(i,k+1,j), -vel )
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+
+         ENDDO
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+      ENDDO
+
+    ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
+           vflux(i,k) = vel*flux5(                     &
+                   u(i,k-3,j), u(i,k-2,j), u(i,k-1,j),       &
+                   u(i,k  ,j), u(i,k+1,j), u(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j))  &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i-1,k,j)) 
+           vflux(i,k) = vel*flux3(       &
+                   u(i,k-2,j), u(i,k-1,j),   &
+                   u(i,k  ,j), u(i,k+1,j), -vel )
+           k = ktf-1
+           vel=0.5*(rom(i,k,j)+rom(i-1,k,j)) 
+           vflux(i,k) = vel*flux3(       &
+                   u(i,k-2,j), u(i,k-1,j),   &
+                   u(i,k  ,j), u(i,k+1,j), -vel )
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+
+         ENDDO
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+      ENDDO
+
+    ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
+           vflux(i,k) = vel*flux4(               &
+                   u(i,k-2,j), u(i,k-1,j),       &
+                   u(i,k  ,j), u(i,k+1,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j))  &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+
+         ENDDO
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+      ENDDO
+
+    ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
+           vflux(i,k) = vel*flux3(               &
+                   u(i,k-2,j), u(i,k-1,j),       &
+                   u(i,k  ,j), u(i,k+1,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j))  &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+
+         ENDDO
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+      ENDDO
+
+    ELSE IF (vert_order == 2) THEN    
+
+      DO j = j_start, j_end
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+               vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+         ENDDO
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+               tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_u_6a: v_order not known ',vert_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF vert_order_test
+
+END SUBROUTINE advect_u
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE advect_v   ( v, v_old, tendency,            &
+                        ru, rv, rom,                   &
+                        mut, time_step, config_flags,  &
+                        msfu, msfv, msft,              &
+                        fzm, fzp,                      &
+                        rdx, rdy, rdzw,                &
+                        ids, ide, jds, jde, kds, kde,  &
+                        ims, ime, jms, jme, kms, kme,  &
+                        its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: v,     &
+                                                                      v_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+   INTEGER ,                                     INTENT(IN   ) :: time_step
+
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw, dup, dum
+   REAL , DIMENSION(its:ite, kts:kte) :: vflux
+
+
+   REAL,  DIMENSION( its:ite+1, kts:kte ) :: fqx
+   REAL,  DIMENSION( its:ite, kts:kte, 2 ) :: fqy
+
+   INTEGER :: horz_order
+   INTEGER :: vert_order
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+   INTEGER :: jp1, jp0, jtmp
+
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
+
+   flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+          ( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+
+   flux3(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+           flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+           sign(1,time_step)*sign(1.,ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
+
+   flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+                      ( 37.*(q_i+q_im1) - 8.*(q_ip1+q_im2)   &
+                     +(q_ip2+q_im3) )/60.0
+
+   flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)    &
+            -sign(1,time_step)*sign(1.,ua)*(                    &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )/60.0
+
+
+
+   LOGICAL :: specified
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+! set order for the advection schemes
+
+   ktf=MIN(kte,kde-1)
+   horz_order = config_flags%h_mom_adv_order
+   vert_order = config_flags%v_mom_adv_order
+
+
+!  here is the choice of flux operators
+
+
+   horizontal_order_test : IF( horz_order == 6 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-1)
+        j_end_f = jde-2
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+          fqy( i, k, jp1 ) = vel*flux6(               &
+                  v(i,k,j-3), v(i,k,j-2), v(i,k,j-1),       &
+                  v(i,k,j  ), v(i,k,j+1), v(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+!  we must be close to some boundary where we need to reduce the order of the stencil
+!  specified uses upstream normal wind at boundaries
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vb = v(i,k,j-1)
+                IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))  &
+                                 *(v(i,k,j)+vb)
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+              fqy( i, k, jp1 ) = vel*flux4(      &
+                   v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+
+     ELSE IF ( j == jde ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vb = v(i,k,j)
+                IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))    &
+                                 *(vb+v(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+              fqy( i, k, jp1 ) = vel*flux4(     &
+                   v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+      END IF
+
+!  y flux-divergence into tendency
+
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msfv(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+   ENDDO j_loop_y_flux_6
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = jte
+
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+!        i_start_f = i_start+2
+        i_start_f = MIN(i_start+2,ids+3)
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+          fqx( i, k ) = vel*flux6( v(i-3,k,j), v(i-2,k,j),  &
+                                         v(i-1,k,j), v(i  ,k,j),  &
+                                         v(i+1,k,j), v(i+2,k,j),  &
+                                         vel                     )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          DO i=i_start,i_start_f-1
+
+            IF(i == ids+1) THEN ! second order
+              DO k=kts,ktf
+                fqx(i,k) = 0.25*(ru(i,k,j)+ru(i,k,j-1)) &
+                                *(v(i,k,j)+v(i-1,k,j))
+              ENDDO
+            ENDIF
+
+            IF(i == ids+2) THEN  ! third order
+              DO k=kts,ktf
+                vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+                fqx( i,k ) = vel*flux4( v(i-2,k,j), v(i-1,k,j),  &
+                                        v(i  ,k,j), v(i+1,k,j),  &
+                                        vel                     )
+              ENDDO
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          DO i = i_end_f+1, i_end+1
+
+            IF( i == ide-1 ) THEN ! second order flux next to the boundary
+              DO k=kts,ktf
+                fqx(i,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))      &
+                                *(v(i_end+1,k,j)+v(i_end,k,j))
+              ENDDO
+            ENDIF
+
+            IF( i == ide-2 ) THEN ! third order flux one in from the boundary
+              DO k=kts,ktf
+                vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+                fqx( i,k ) = vel*flux4( v(i-2,k,j), v(i-1,k,j),  &
+                                        v(i  ,k,j), v(i+1,k,j),  &
+                                        vel                     )
+              ENDDO
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msfv(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 5 ) THEN
+
+!  5th order horizontal flux calculation
+!  This code is EXACTLY the same as the 6th order code
+!  EXCEPT the 5th order and 3rd operators are used in
+!  place of the 6th and 4th order operators
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-1)
+        j_end_f = jde-2
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+          fqy( i, k, jp1 ) = vel*flux5(               &
+                  v(i,k,j-3), v(i,k,j-2), v(i,k,j-1),       &
+                  v(i,k,j  ), v(i,k,j+1), v(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+!  we must be close to some boundary where we need to reduce the order of the stencil
+!  specified uses upstream normal wind at boundaries
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vb = v(i,k,j-1)
+                IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))  &
+                                 *(v(i,k,j)+vb)
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+              fqy( i, k, jp1 ) = vel*flux3(      &
+                   v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+
+     ELSE IF ( j == jde ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vb = v(i,k,j)
+                IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))    &
+                                 *(vb+v(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+              fqy( i, k, jp1 ) = vel*flux3(     &
+                   v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+      END IF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msfv(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+   ENDDO j_loop_y_flux_5
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = jte
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+!        i_start_f = i_start+2
+        i_start_f = MIN(i_start+2,ids+3)
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+          fqx( i, k ) = vel*flux5( v(i-3,k,j), v(i-2,k,j),  &
+                                         v(i-1,k,j), v(i  ,k,j),  &
+                                         v(i+1,k,j), v(i+2,k,j),  &
+                                         vel                     )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          DO i=i_start,i_start_f-1
+
+            IF(i == ids+1) THEN ! second order
+              DO k=kts,ktf
+                fqx(i,k) = 0.25*(ru(i,k,j)+ru(i,k,j-1)) &
+                                *(v(i,k,j)+v(i-1,k,j))
+              ENDDO
+            ENDIF
+
+            IF(i == ids+2) THEN  ! third order
+              DO k=kts,ktf
+                vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+                fqx( i,k ) = vel*flux3( v(i-2,k,j), v(i-1,k,j),  &
+                                        v(i  ,k,j), v(i+1,k,j),  &
+                                        vel                     )
+              ENDDO
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          DO i = i_end_f+1, i_end+1
+
+            IF( i == ide-1 ) THEN ! second order flux next to the boundary
+              DO k=kts,ktf
+                fqx(i,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))      &
+                                *(v(i_end+1,k,j)+v(i_end,k,j))
+              ENDDO
+            ENDIF
+
+            IF( i == ide-2 ) THEN ! third order flux one in from the boundary
+              DO k=kts,ktf
+                vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+                fqx( i,k ) = vel*flux3( v(i-2,k,j), v(i-1,k,j),  &
+                                        v(i  ,k,j), v(i+1,k,j),  &
+                                        vel                     )
+              ENDDO
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msfv(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 4 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!CJM May not work with tiling because defined in terms of domain dims
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-1
+        j_end_f = jde-1
+      ENDIF
+
+!  compute fluxes
+!  specified uses upstream normal wind at boundaries
+
+    jp0 = 1
+    jp1 = 2
+
+    DO j = j_start, j_end+1
+
+      IF ((j == j_start) .and. degrade_ys) THEN
+        DO k = kts,ktf
+        DO i = i_start, i_end
+                vb = v(i,k,j-1)
+                IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))  &
+                                 *(v(i,k,j)+vb)
+        ENDDO
+        ENDDO
+      ELSE IF ((j == j_end+1) .and. degrade_ye) THEN
+        DO k = kts, ktf
+        DO i = i_start, i_end
+                vb = v(i,k,j)
+                IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))    &
+                                 *(vb+v(i,k,j-1))
+        ENDDO
+        ENDDO
+      ELSE
+        DO k = kts, ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+          fqy( i,k,jp1 ) = vel*flux4( v(i,k,j-2), v(i,k,j-1),  &
+                                     v(i,k,j  ), v(i,k,j+1),  &
+                                      vel                        )
+        ENDDO
+        ENDDO
+      END IF
+
+      IF( j > j_start) THEN
+        DO k = kts, ktf
+        DO i = i_start, i_end
+            mrdy=msfv(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+        ENDDO
+        ENDDO
+
+
+      END IF
+
+      jtmp = jp1
+      jp1 = jp0
+      jp0 = jtmp
+
+   ENDDO
+
+!  next, x - flux divergence
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = jte
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  3rd or 4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+          fqx( i, k ) = vel*flux4( v(i-2,k,j), v(i-1,k,j),  &
+                                  v(i  ,k,j), v(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts,ktf
+            fqx(i_start,k) = 0.25*(ru(i_start,k,j)+ru(i_start,k,j-1)) &
+                   *(v(i_start,k,j)+v(i_start-1,k,j))
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts,ktf
+            fqx(i_end+1,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))      &
+                   *(v(i_end+1,k,j)+v(i_end,k,j))
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+            mrdx=msfv(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 3 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!CJM May not work with tiling because defined in terms of domain dims
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-1
+        j_end_f = jde-1
+      ENDIF
+
+!  compute fluxes
+!  specified uses upstream normal wind at boundaries
+
+    jp0 = 1
+    jp1 = 2
+
+    DO j = j_start, j_end+1
+
+      IF ((j == j_start) .and. degrade_ys) THEN
+        DO k = kts,ktf
+        DO i = i_start, i_end
+                vb = v(i,k,j-1)
+                IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))  &
+                                 *(v(i,k,j)+vb)
+        ENDDO
+        ENDDO
+      ELSE IF ((j == j_end+1) .and. degrade_ye) THEN
+        DO k = kts, ktf
+        DO i = i_start, i_end
+                vb = v(i,k,j)
+                IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))    &
+                                 *(vb+v(i,k,j-1))
+        ENDDO
+        ENDDO
+      ELSE
+        DO k = kts, ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+          fqy( i,k,jp1 ) = vel*flux3( v(i,k,j-2), v(i,k,j-1),  &
+                                     v(i,k,j  ), v(i,k,j+1),  &
+                                      vel                        )
+        ENDDO
+        ENDDO
+      END IF
+
+      IF( j > j_start) THEN
+        DO k = kts, ktf
+        DO i = i_start, i_end
+            mrdy=msfv(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+        ENDDO
+        ENDDO
+
+
+      END IF
+
+      jtmp = jp1
+      jp1 = jp0
+      jp0 = jtmp
+
+   ENDDO
+
+!  next, x - flux divergence
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = jte
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  3rd or 4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+          fqx( i, k ) = vel*flux3( v(i-2,k,j), v(i-1,k,j),  &
+                                  v(i  ,k,j), v(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts,ktf
+            fqx(i_start,k) = 0.25*(ru(i_start,k,j)+ru(i_start,k,j-1)) &
+                   *(v(i_start,k,j)+v(i_start-1,k,j))
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts,ktf
+            fqx(i_end+1,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))      &
+                   *(v(i_end+1,k,j)+v(i_end,k,j))
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+            mrdx=msfv(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 2 ) THEN
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+      IF ( config_flags%open_ys ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye ) j_end   = MIN(jde-1,jte)
+      IF ( specified ) j_start = MAX(jds+2,jts)
+      IF ( specified ) j_end   = MIN(jde-2,jte)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mrdy=msfv(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j) -mrdy*0.25 &
+                            *((rv(i,k,j+1)+rv(i,k,j  ))*(v(i,k,j+1)+v(i,k,j  )) &
+                             -(rv(i,k,j  )+rv(i,k,j-1))*(v(i,k,j  )+v(i,k,j-1)))
+
+      ENDDO
+      ENDDO
+      ENDDO
+!  specified uses upstream normal wind at boundaries
+
+      IF ( specified .AND. jts .LE. jds+1 ) THEN
+        j = jds+1
+        DO k=kts,ktf
+        DO i = i_start, i_end
+           mrdy=msfv(i,j)*rdy
+           vb = v(i,k,j-1)
+           IF (v(i,k,j) .LT. 0.) vb = v(i,k,j)
+
+              tendency(i,k,j)=tendency(i,k,j) -mrdy*0.25 &
+                              *((rv(i,k,j+1)+rv(i,k,j  ))*(v(i,k,j+1)+v(i,k,j  )) &
+                               -(rv(i,k,j  )+rv(i,k,j-1))*(v(i,k,j  )+vb))
+
+        ENDDO
+        ENDDO
+      ENDIF
+
+      IF ( specified .AND. jte .GE. jde-1 ) THEN
+        j = jde-1
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+           mrdy=msfv(i,j)*rdy
+           vb = v(i,k,j+1)
+           IF (v(i,k,j) .GT. 0.) vb = v(i,k,j)
+
+              tendency(i,k,j)=tendency(i,k,j) -mrdy*0.25 &
+                              *((rv(i,k,j+1)+rv(i,k,j  ))*(vb+v(i,k,j  )) &
+                               -(rv(i,k,j  )+rv(i,k,j-1))*(v(i,k,j  )+v(i,k,j-1)))
+
+        ENDDO
+        ENDDO
+      ENDIF
+
+      IF ( .NOT. config_flags%periodic_x ) THEN
+        IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+        IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      ENDIF
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mrdx=msfv(i,j)*rdx
+
+            tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
+                            *((ru(i+1,k,j)+ru(i+1,k,j-1))*(v(i+1,k,j)+v(i  ,k,j)) &
+                             -(ru(i  ,k,j)+ru(i  ,k,j-1))*(v(i  ,k,j)+v(i-1,k,j)))
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF ( horz_order == 0 ) THEN
+
+      ! Just in case we want to turn horizontal advection off, we can do it
+
+  ELSE
+
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_v_6a: h_order not known ',horz_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF horizontal_order_test
+
+!  radiative lateral boundary condition in y for normal velocity (v)
+
+      IF ( (config_flags%open_ys) .and. jts == jds ) THEN
+
+        i_start = its
+        i_end   = MIN(ite,ide-1)
+
+        DO i = i_start, i_end
+        DO k = kts, ktf
+          vb = MIN(rv(i,k,jts)-cb*mut(i,jts), 0.)
+          tendency(i,k,jts) = tendency(i,k,jts)                    &
+                      - rdy*vb*(v_old(i,k,jts+1) - v_old(i,k,jts))
+        ENDDO
+        ENDDO
+
+      ENDIF
+
+      IF ( (config_flags%open_ye) .and. jte == jde ) THEN
+
+        i_start = its
+        i_end   = MIN(ite,ide-1)
+
+        DO i = i_start, i_end
+        DO k = kts, ktf
+          vb = MAX(rv(i,k,jte)+cb*mut(i,jte-1), 0.)
+          tendency(i,k,jte) = tendency(i,k,jte)                    &
+                      - rdy*vb*(v_old(i,k,jte) - v_old(i,k,jte-1))
+        ENDDO
+        ENDDO
+
+      ENDIF
+
+!  pick up the rest of the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb'.
+!  first, set to index ranges
+
+      j_start = jts
+      j_end   = MIN(jte,jde)
+
+      jmin    = jds
+      jmax    = jde-1
+
+      IF (config_flags%open_ys) THEN
+          j_start = MAX(jds+1, jts)
+          jmin = jds
+      ENDIF
+      IF (config_flags%open_ye) THEN
+          j_end = MIN(jte,jde-1)
+          jmax = jde-1
+      ENDIF
+
+!  compute x (u) conditions for v, w, or scalar
+
+   IF( (config_flags%open_xs) .and. (its == ids)) THEN
+
+      DO j = j_start, j_end
+
+         mrdx=msfv(its,j)*rdx
+         jp = MIN( jmax, j   )
+         jm = MAX( jmin, j-1 )
+
+         DO k=kts,ktf
+
+          uw = 0.5*(ru(its,k,jp)+ru(its,k,jm))
+          ub = MIN( uw, 0. )
+          dup =  ru(its+1,k,jp)-ru(its,k,jp)
+          dum =  ru(its+1,k,jm)-ru(its,k,jm)
+          tendency(its,k,j)=tendency(its,k,j)-mrdx*(               &
+                            ub*(v_old(its+1,k,j)-v_old(its,k,j))   &
+                           +0.5*v(its,k,j)*(dup+dum))
+         ENDDO
+      ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
+      DO j = j_start, j_end
+
+         mrdx=msfv(ite-1,j)*rdx
+         jp = MIN( jmax, j   )
+         jm = MAX( jmin, j-1 )
+
+         DO k=kts,ktf
+
+          uw = 0.5*(ru(ite,k,jp)+ru(ite,k,jm))
+          ub = MAX( uw, 0. )
+          dup = ru(ite,k,jp)-ru(ite-1,k,jp)
+          dum = ru(ite,k,jm)-ru(ite-1,k,jm)
+
+!          tendency(ite-1,k,j)=tendency(ite-1,k,j)-mrdx*(              &
+!                            ub*(v_old(ite-1,k,j)-v_old(ite-2,k,j))    &
+!                           +0.5*v(ite-1,k,j)*                         &
+!                                  ( ru(ite,k,jp)-ru(ite-1,k,jp)       &
+!                                   +ru(ite,k,jm)-ru(ite-1,k,jm))     )
+          tendency(ite-1,k,j)=tendency(ite-1,k,j)-mrdx*(              &
+                            ub*(v_old(ite-1,k,j)-v_old(ite-2,k,j))    &
+                           +0.5*v(ite-1,k,j)*(dup+dum))
+
+         ENDDO
+      ENDDO
+
+   ENDIF
+
+!-------------------- vertical advection
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+      DO i = i_start, i_end
+         vflux(i,kts)=0.
+         vflux(i,kte)=0.
+      ENDDO
+
+      !
+      !
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+    vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
+           vflux(i,k) = vel*flux6(                       &
+                   v(i,k-3,j), v(i,k-2,j), v(i,k-1,j),       &
+                   v(i,k  ,j), v(i,k+1,j), v(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1))  &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1)) 
+           vflux(i,k) = vel*flux4(       &
+                   v(i,k-2,j), v(i,k-1,j),   &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+           k = ktf-1
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1)) 
+           vflux(i,k) = vel*flux4(       &
+                   v(i,k-2,j), v(i,k-1,j),   &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            !
+            !
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
+           vflux(i,k) = vel*flux5(                       &
+                   v(i,k-3,j), v(i,k-2,j), v(i,k-1,j),       &
+                   v(i,k  ,j), v(i,k+1,j), v(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1))  &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1)) 
+           vflux(i,k) = vel*flux3(       &
+                   v(i,k-2,j), v(i,k-1,j),   &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+           k = ktf-1
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1)) 
+           vflux(i,k) = vel*flux3(       &
+                   v(i,k-2,j), v(i,k-1,j),   &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            !
+            !
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
+           vflux(i,k) = vel*flux4(               &
+                   v(i,k-2,j), v(i,k-1,j),       &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1))  &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            !
+            !
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
+           vflux(i,k) = vel*flux3(               &
+                   v(i,k-2,j), v(i,k-1,j),       &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1))  &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            !
+            !
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+
+    ELSE IF (vert_order == 2) THEN    
+
+   DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+            vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                    *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+      ENDDO
+      ENDDO
+
+      DO k=kts,ktf
+      DO i = i_start, i_end
+            !
+            !
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+      ENDDO
+      ENDDO
+   ENDDO
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_v_6a: v_order not known ',vert_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF vert_order_test
+
+END SUBROUTINE advect_v
+
+!-------------------------------------------------------------------
+
+SUBROUTINE advect_scalar   ( field, field_old, tendency,    &
+                             ru, rv, rom,                   &
+                             mut, time_step, config_flags,  &
+                             msfu, msfv, msft,              &
+                             fzm, fzp,                      &
+                             rdx, rdy, rdzw,                &
+                             ids, ide, jds, jde, kds, kde,  &
+                             ims, ime, jms, jme, kms, kme,  &
+                             its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field,     &
+                                                                      field_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+   INTEGER ,                                     INTENT(IN   ) :: time_step
+
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw
+   REAL , DIMENSION(its:ite, kts:kte) :: vflux
+
+
+   REAL,  DIMENSION( its:ite+1, kts:kte  ) :: fqx
+   REAL,  DIMENSION( its:ite, kts:kte, 2 ) :: fqy
+
+   INTEGER :: horz_order, vert_order
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+   INTEGER :: jp1, jp0, jtmp
+
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
+
+      flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+          ( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+
+      flux3(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+           flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+           sign(1,time_step)*sign(1.,ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
+
+      flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+          ( 37.*(q_i+q_im1) - 8.*(q_ip1+q_im2)                  &
+            +(q_ip2+q_im3) )/60.0
+
+      flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)    &
+            -sign(1,time_step)*sign(1.,ua)*(                    &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )/60.0
+
+
+   LOGICAL :: specified
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+! set order for the advection schemes
+
+  ktf=MIN(kte,kde-1)
+  horz_order = config_flags%h_sca_adv_order
+  vert_order = config_flags%v_sca_adv_order
+
+!  begin with horizontal flux divergence
+!  here is the choice of flux operators
+
+
+  horizontal_order_test : IF( horz_order == 6 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-4)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      ktf=MIN(kte,kde-1)
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = rv(i,k,j)
+          fqy( i, k, jp1 ) = vel*flux6(                                &
+                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
+                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i,k, jp1) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = rv(i,k,j)
+              fqy( i, k, jp1 ) = vel*flux4(              &
+                   field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = rv(i,k,j)
+              fqy( i, k, jp1) = vel*flux4(             &
+                   field(i,k,j-2),field(i,k,j-1),    &
+                   field(i,k,j),field(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ENDIF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+      ENDDO j_loop_y_flux_6
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+!        i_start_f = i_start+2
+        i_start_f = MIN(i_start+2,ids+3)
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = ru(i,k,j)
+          fqx( i,k ) = vel*flux6( field(i-3,k,j), field(i-2,k,j),  &
+                                         field(i-1,k,j), field(i  ,k,j),  &
+                                         field(i+1,k,j), field(i+2,k,j),  &
+                                         vel                             )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          DO i=i_start,i_start_f-1
+
+            IF(i == ids+1) THEN ! second order
+              DO k=kts,ktf
+                fqx(i,k) = 0.5*(ru(i,k,j)) &
+                       *(field(i,k,j)+field(i-1,k,j))
+              ENDDO
+            ENDIF
+
+            IF(i == ids+2) THEN  ! third order
+              DO k=kts,ktf
+                vel = ru(i,k,j)
+                fqx( i,k ) = vel*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                              field(i  ,k,j), field(i+1,k,j),  &
+                                              vel                     )
+              ENDDO
+            END IF
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          DO i = i_end_f+1, i_end+1
+
+            IF( i == ide-1 ) THEN ! second order flux next to the boundary
+              DO k=kts,ktf
+                fqx(i,k) = 0.5*(ru(i,k,j))      &
+                       *(field(i,k,j)+field(i-1,k,j))
+              ENDDO
+           ENDIF
+
+           IF( i == ide-2 ) THEN ! third order flux one in from the boundary
+             DO k=kts,ktf
+               vel = ru(i,k,j)
+               fqx( i,k ) = vel*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                       field(i  ,k,j), field(i+1,k,j),  &
+                                       vel                             )
+             ENDDO
+           ENDIF
+
+         ENDDO
+
+       ENDIF
+
+!  x flux-divergence into tendency
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msft(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+          ENDDO
+
+      ENDDO
+
+  ELSE IF( horz_order == 5 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-4)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      ktf=MIN(kte,kde-1)
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = rv(i,k,j)
+          fqy( i, k, jp1 ) = vel*flux5(                                &
+                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
+                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i,k, jp1) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = rv(i,k,j)
+              fqy( i, k, jp1 ) = vel*flux3(              &
+                   field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = rv(i,k,j)
+              fqy( i, k, jp1) = vel*flux3(             &
+                   field(i,k,j-2),field(i,k,j-1),    &
+                   field(i,k,j),field(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ENDIF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+      ENDDO j_loop_y_flux_5
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+!        i_start_f = i_start+2
+        i_start_f = MIN(i_start+2,ids+3)
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = ru(i,k,j)
+          fqx( i,k ) = vel*flux5( field(i-3,k,j), field(i-2,k,j),  &
+                                         field(i-1,k,j), field(i  ,k,j),  &
+                                         field(i+1,k,j), field(i+2,k,j),  &
+                                         vel                             )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          DO i=i_start,i_start_f-1
+
+            IF(i == ids+1) THEN ! second order
+              DO k=kts,ktf
+                fqx(i,k) = 0.5*(ru(i,k,j)) &
+                       *(field(i,k,j)+field(i-1,k,j))
+              ENDDO
+            ENDIF
+
+            IF(i == ids+2) THEN  ! third order
+              DO k=kts,ktf
+                vel = ru(i,k,j)
+                fqx( i,k ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                              field(i  ,k,j), field(i+1,k,j),  &
+                                              vel                     )
+              ENDDO
+            END IF
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          DO i = i_end_f+1, i_end+1
+
+            IF( i == ide-1 ) THEN ! second order flux next to the boundary
+              DO k=kts,ktf
+                fqx(i,k) = 0.5*(ru(i,k,j))      &
+                       *(field(i,k,j)+field(i-1,k,j))
+              ENDDO
+           ENDIF
+
+           IF( i == ide-2 ) THEN ! third order flux one in from the boundary
+             DO k=kts,ktf
+               vel = ru(i,k,j)
+               fqx( i,k ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                       field(i  ,k,j), field(i+1,k,j),  &
+                                       vel                             )
+             ENDDO
+           ENDIF
+
+         ENDDO
+
+       ENDIF
+
+!  x flux-divergence into tendency
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msft(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+          ENDDO
+
+      ENDDO
+
+
+   ELSE IF( horz_order == 4 ) THEN
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!  begin flux computations
+!  start with x flux divergence
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  3rd or 4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          fqx( i, k) = ru(i,k,j)*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                        field(i  ,k,j), field(i+1,k,j),  &
+                                        ru(i,k,j)                       )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts,ktf
+            fqx(i_start, k) = 0.5*ru(i_start,k,j)             &
+                   *(field(i_start,k,j)+field(i_start-1,k,j))
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts,ktf
+            fqx(i_end+1,k ) = 0.5*ru(i_end+1,k,j)          &
+                   *(field(i_end+1,k,j)+field(i_end,k,j))
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          mrdx=msft(i,j)*rdx
+          tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+
+!  next -> y flux divergence calculation
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+
+    jp1 = 2
+    jp0 = 1
+
+  DO j = j_start, j_end+1
+
+    IF ((j < j_start_f) .and. degrade_ys) THEN
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy(i,k,jp1) = 0.5*rv(i,k,j_start)             &
+                *(field(i,k,j_start)+field(i,k,j_start-1))
+      ENDDO
+      ENDDO
+    ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         ! Assumes j>j_end_f is ONLY j_end+1 ...
+!         fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1)          &
+!                *(field(i,k,j_end+1)+field(i,k,j_end))
+         fqy(i,k,jp1) = 0.5*rv(i,k,j)          &
+                *(field(i,k,j)+field(i,k,j-1))
+      ENDDO
+      ENDDO
+    ELSE
+!  3rd or 4th order flux
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy( i, k, jp1 ) = rv(i,k,j)*flux4( field(i,k,j-2), field(i,k,j-1),  &
+                                            field(i,k,j  ), field(i,k,j+1),  &
+                                            rv(i,k,j)                       )
+      ENDDO
+      ENDDO
+    END IF
+
+!  y flux-divergence into tendency
+    IF ( j > j_start ) THEN
+
+      DO k=kts,ktf
+      DO i = i_start, i_end
+        mrdy=msft(i,j-1)*rdy
+        tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+      ENDDO
+      ENDDO
+
+
+    END IF
+
+    jtmp = jp1
+    jp1 = jp0
+    jp0 = jtmp
+
+  ENDDO
+
+
+   ELSE IF( horz_order == 3 ) THEN
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!  begin flux computations
+!  start with x flux divergence
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  3rd or 4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          fqx( i, k) = ru(i,k,j)*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                        field(i  ,k,j), field(i+1,k,j),  &
+                                        ru(i,k,j)                       )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts,ktf
+            fqx(i_start, k) = 0.5*ru(i_start,k,j)             &
+                   *(field(i_start,k,j)+field(i_start-1,k,j))
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts,ktf
+            fqx(i_end+1,k ) = 0.5*ru(i_end+1,k,j)          &
+                   *(field(i_end+1,k,j)+field(i_end,k,j))
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          mrdx=msft(i,j)*rdx
+          tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+
+!  next -> y flux divergence calculation
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+
+    jp1 = 2
+    jp0 = 1
+
+  DO j = j_start, j_end+1
+
+    IF ((j < j_start_f) .and. degrade_ys) THEN
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy(i,k,jp1) = 0.5*rv(i,k,j_start)             &
+                *(field(i,k,j_start)+field(i,k,j_start-1))
+      ENDDO
+      ENDDO
+    ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         ! Assumes j>j_end_f is ONLY j_end+1 ...
+!         fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1)          &
+!                *(field(i,k,j_end+1)+field(i,k,j_end))
+         fqy(i,k,jp1) = 0.5*rv(i,k,j)          &
+                *(field(i,k,j)+field(i,k,j-1))
+      ENDDO
+      ENDDO
+    ELSE
+!  3rd or 4th order flux
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy( i, k, jp1 ) = rv(i,k,j)*flux3( field(i,k,j-2), field(i,k,j-1),  &
+                                            field(i,k,j  ), field(i,k,j+1),  &
+                                            rv(i,k,j)                       )
+      ENDDO
+      ENDDO
+    END IF
+
+!  y flux-divergence into tendency
+    IF ( j > j_start ) THEN
+
+      DO k=kts,ktf
+      DO i = i_start, i_end
+        mrdy=msft(i,j-1)*rdy
+        tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+      ENDDO
+      ENDDO
+
+
+    END IF
+
+    jtmp = jp1
+    jp1 = jp0
+    jp0 = jtmp
+
+  ENDDO
+
+   ELSE IF( horz_order == 2 ) THEN
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( .NOT. config_flags%periodic_x ) THEN
+        IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+        IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      ENDIF
+
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         mrdx=msft(i,j)*rdx
+         tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5 &
+                         *(ru(i+1,k,j)*(field(i+1,k,j)+field(i  ,k,j)) &
+                          -ru(i  ,k,j)*(field(i  ,k,j)+field(i-1,k,j)))
+      ENDDO
+      ENDDO
+      ENDDO
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      !
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         mrdy=msft(i,j)*rdy
+         tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5 &
+                         *(rv(i,k,j+1)*(field(i,k,j+1)+field(i,k,j  )) &
+                          -rv(i,k,j  )*(field(i,k,j  )+field(i,k,j-1))) 
+      ENDDO
+      ENDDO
+      ENDDO
+   
+
+   ELSE IF ( horz_order == 0 ) THEN
+
+      ! Just in case we want to turn horizontal advection off, we can do it
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_scalar_6a, h_order not known ',horz_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF horizontal_order_test
+
+!  pick up the rest of the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb'.
+!  first, set to index ranges
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  compute x (u) conditions for v, w, or scalar
+
+   IF( (config_flags%open_xs) .and. (its == ids) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MIN( 0.5*(ru(its,k,j)+ru(its+1,k,j)), 0. )
+         tendency(its,k,j) = tendency(its,k,j)                     &
+               - rdx*(                                             &
+                       ub*(   field_old(its+1,k,j)                 &
+                            - field_old(its  ,k,j)   ) +           &
+                       field(its,k,j)*(ru(its+1,k,j)-ru(its,k,j))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MAX( 0.5*(ru(ite-1,k,j)+ru(ite,k,j)), 0. )
+         tendency(i_end,k,j) = tendency(i_end,k,j)                   &
+               - rdx*(                                               &
+                       ub*(  field_old(i_end  ,k,j)                  &
+                           - field_old(i_end-1,k,j) ) +              &
+                       field(i_end,k,j)*(ru(ite,k,j)-ru(ite-1,k,j))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MIN( 0.5*(rv(i,k,jts)+rv(i,k,jts+1)), 0. )
+         tendency(i,k,jts) = tendency(i,k,jts)                     &
+               - rdy*(                                             &
+                       vb*(  field_old(i,k,jts+1)                  &
+                           - field_old(i,k,jts  ) ) +              &
+                       field(i,k,jts)*(rv(i,k,jts+1)-rv(i,k,jts))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ye) .and. (jte == jde)) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MAX( 0.5*(rv(i,k,jte-1)+rv(i,k,jte)), 0. )
+         tendency(i,k,j_end) = tendency(i,k,j_end)                   &
+               - rdy*(                                               &
+                       vb*(   field_old(i,k,j_end  )                 &
+                            - field_old(i,k,j_end-1) ) +             &
+                       field(i,k,j_end)*(rv(i,k,jte)-rv(i,k,jte-1))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+
+!-------------------- vertical advection
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      DO i = i_start, i_end
+         vflux(i,kts)=0.
+         vflux(i,kte)=0.
+      ENDDO
+
+    vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux6(                                 &
+                   field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),       &
+                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+                                   
+           k = kts+2
+           vel=rom(i,k,j) 
+           vflux(i,k) = vel*flux4(               &
+                   field(i,k-2,j), field(i,k-1,j),   &
+                   field(i,k  ,j), field(i,k+1,j), -vel )
+           k = ktf-1
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux4(               &
+                   field(i,k-2,j), field(i,k-1,j),   &
+                   field(i,k  ,j), field(i,k+1,j), -vel )
+
+           k=ktf
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+         ENDDO
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux5(                                 &
+                   field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),       &
+                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+                                   
+           k = kts+2
+           vel=rom(i,k,j) 
+           vflux(i,k) = vel*flux3(               &
+                   field(i,k-2,j), field(i,k-1,j),   &
+                   field(i,k  ,j), field(i,k+1,j), -vel )
+           k = ktf-1
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux3(               &
+                   field(i,k-2,j), field(i,k-1,j),   &
+                   field(i,k  ,j), field(i,k+1,j), -vel )
+
+           k=ktf
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+         ENDDO
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux4(                                 &
+                   field(i,k-2,j), field(i,k-1,j),       &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           k=ktf
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+         ENDDO
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux3(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           k=ktf
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+         ENDDO
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 2) THEN    
+
+  DO j = j_start, j_end
+     DO k = kts+1, ktf
+     DO i = i_start, i_end
+            vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+     ENDDO
+     ENDDO
+
+     DO k = kts, ktf
+     DO i = i_start, i_end
+       tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+     ENDDO
+     ENDDO
+
+  ENDDO
+
+   ELSE
+
+      WRITE (wrf_err_message,*) ' advect_scalar_6a, v_order not known ',vert_order
+      CALL wrf_error_fatal ( wrf_err_message )
+
+   ENDIF vert_order_test
+
+END SUBROUTINE advect_scalar
+
+!---------------------------------------------------------------------------------
+
+SUBROUTINE advect_w    ( w, w_old, tendency,            &
+                         ru, rv, rom,                   &
+                         mut, time_step, config_flags,  &
+                         msfu, msfv, msft,              &
+                         fzm, fzp,                      &
+                         rdx, rdy, rdzu,                &
+                         ids, ide, jds, jde, kds, kde,  &
+                         ims, ime, jms, jme, kms, kme,  &
+                         its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: w,     &
+                                                                      w_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzu
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+   INTEGER ,                                     INTENT(IN   ) :: time_step
+
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw
+   REAL , DIMENSION(its:ite, kts:kte) :: vflux
+
+   INTEGER :: horz_order, vert_order
+
+   REAL,  DIMENSION( its:ite+1, kts:kte ) :: fqx
+   REAL,  DIMENSION( its:ite, kts:kte, 2 ) :: fqy
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+   INTEGER :: jp1, jp0, jtmp
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
+
+      flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+          ( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+
+      flux3(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+           flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+           sign(1,time_step)*sign(1.,ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
+
+      flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+                      ( 37.*(q_i+q_im1) - 8.*(q_ip1+q_im2)      &
+                     +(q_ip2+q_im3) )/60.0
+
+      flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)    &
+            -sign(1,time_step)*sign(1.,ua)*(                    &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )/60.0
+
+
+   LOGICAL :: specified
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+!  set order for the advection scheme
+
+  ktf=MIN(kte,kde-1)
+  horz_order = config_flags%h_sca_adv_order
+  vert_order = config_flags%v_sca_adv_order
+
+!  here is the choice of flux operators
+
+!  begin with horizontal flux divergence
+
+  horizontal_order_test : IF( horz_order == 6 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-4)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
+
+        DO k=kts+1,ktf
+        DO i = i_start, i_end
+          vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+          fqy( i, k, jp1 ) = vel*flux6(                     &
+                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
+                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start, i_end
+          vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+          fqy( i, k, jp1 ) = vel*flux6(                     &
+                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
+                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*          &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*          &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+              fqy( i, k, jp1 ) = vel*flux4(              &
+                   w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+              fqy( i, k, jp1 ) = vel*flux4(              &
+                   w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*      &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*      &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+              fqy( i, k, jp1 ) = vel*flux4(             &
+                   w(i,k,j-2),w(i,k,j-1),    &
+                   w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+              fqy( i, k, jp1 ) = vel*flux4(             &
+                   w(i,k,j-2),w(i,k,j-1),    &
+                   w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+
+     ENDIF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts+1,ktf+1
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+       ENDIF
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+      ENDDO j_loop_y_flux_6
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+!        i_start_f = i_start+2
+        i_start_f = MIN(i_start+2,ids+3)
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts+1,ktf
+        DO i = i_start_f, i_end_f
+          vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+          fqx( i,k ) = vel*flux6( w(i-3,k,j), w(i-2,k,j),  &
+                                  w(i-1,k,j), w(i  ,k,j),  &
+                                  w(i+1,k,j), w(i+2,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start_f, i_end_f
+          vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+          fqx( i,k ) = vel*flux6( w(i-3,k,j), w(i-2,k,j),  &
+                                  w(i-1,k,j), w(i  ,k,j),  &
+                                  w(i+1,k,j), w(i+2,k,j),  &
+                                  vel                     )
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          DO i=i_start,i_start_f-1
+
+            IF(i == ids+1) THEN ! second order
+              DO k=kts+1,ktf
+                fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)) &
+                                *(w(i,k,j)+w(i-1,k,j))
+              ENDDO
+              k = ktf+1
+              fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)) &
+                     *(w(i,k,j)+w(i-1,k,j))
+            ENDIF
+
+            IF(i == ids+2) THEN  ! third order
+              DO k=kts+1,ktf
+                vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+                fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                        w(i  ,k,j), w(i+1,k,j),  &
+                                        vel                     )
+              ENDDO
+              k = ktf+1
+              vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+              fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                      w(i  ,k,j), w(i+1,k,j),  &
+                                      vel                     )
+            END IF
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          DO i = i_end_f+1, i_end+1
+
+            IF( i == ide-1 ) THEN ! second order flux next to the boundary
+              DO k=kts+1,ktf
+                fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))      &
+                                  *(w(i,k,j)+w(i-1,k,j))
+              ENDDO
+              k = ktf+1
+              fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))      &
+                     *(w(i,k,j)+w(i-1,k,j))
+            ENDIF
+
+            IF( i == ide-2 ) THEN ! third order flux one in from the boundary
+              DO k=kts+1,ktf
+                vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+                fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                        w(i  ,k,j), w(i+1,k,j),  &
+                                        vel                     )
+              ENDDO
+              k = ktf+1
+              vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+              fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                      w(i  ,k,j), w(i+1,k,j),  &
+                                      vel                     )
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts+1,ktf+1
+          DO i = i_start, i_end
+            mrdx=msft(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+ELSE IF (horz_order == 5 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-4)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
+
+        DO k=kts+1,ktf
+        DO i = i_start, i_end
+          vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+          fqy( i, k, jp1 ) = vel*flux5(                     &
+                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
+                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start, i_end
+          vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+          fqy( i, k, jp1 ) = vel*flux5(                     &
+                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
+                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*          &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*          &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+              fqy( i, k, jp1 ) = vel*flux3(              &
+                   w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+              fqy( i, k, jp1 ) = vel*flux3(              &
+                   w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*      &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*      &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+              fqy( i, k, jp1 ) = vel*flux3(             &
+                   w(i,k,j-2),w(i,k,j-1),    &
+                   w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+              fqy( i, k, jp1 ) = vel*flux3(             &
+                   w(i,k,j-2),w(i,k,j-1),    &
+                   w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+
+     ENDIF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts+1,ktf+1
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+       ENDIF
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+      ENDDO j_loop_y_flux_5
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+!        i_start_f = i_start+2
+        i_start_f = MIN(i_start+2,ids+3)
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts+1,ktf
+        DO i = i_start_f, i_end_f
+          vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+          fqx( i,k ) = vel*flux5( w(i-3,k,j), w(i-2,k,j),  &
+                                  w(i-1,k,j), w(i  ,k,j),  &
+                                  w(i+1,k,j), w(i+2,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start_f, i_end_f
+          vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+          fqx( i,k ) = vel*flux5( w(i-3,k,j), w(i-2,k,j),  &
+                                  w(i-1,k,j), w(i  ,k,j),  &
+                                  w(i+1,k,j), w(i+2,k,j),  &
+                                  vel                     )
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          DO i=i_start,i_start_f-1
+
+            IF(i == ids+1) THEN ! second order
+              DO k=kts+1,ktf
+                fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)) &
+                                *(w(i,k,j)+w(i-1,k,j))
+              ENDDO
+              k = ktf+1
+              fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)) &
+                     *(w(i,k,j)+w(i-1,k,j))
+            ENDIF
+
+            IF(i == ids+2) THEN  ! third order
+              DO k=kts+1,ktf
+                vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+                fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                        w(i  ,k,j), w(i+1,k,j),  &
+                                        vel                     )
+              ENDDO
+              k = ktf+1
+              vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+              fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                      w(i  ,k,j), w(i+1,k,j),  &
+                                      vel                     )
+            END IF
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          DO i = i_end_f+1, i_end+1
+
+            IF( i == ide-1 ) THEN ! second order flux next to the boundary
+              DO k=kts+1,ktf
+                fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))      &
+                                  *(w(i,k,j)+w(i-1,k,j))
+              ENDDO
+              k = ktf+1
+              fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))      &
+                     *(w(i,k,j)+w(i-1,k,j))
+            ENDIF
+
+            IF( i == ide-2 ) THEN ! third order flux one in from the boundary
+              DO k=kts+1,ktf
+                vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+                fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                        w(i  ,k,j), w(i+1,k,j),  &
+                                        vel                     )
+              ENDDO
+              k = ktf+1
+              vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+              fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                      w(i  ,k,j), w(i+1,k,j),  &
+                                      vel                     )
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts+1,ktf+1
+          DO i = i_start, i_end
+            mrdx=msft(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+ELSE IF ( horz_order == 4 ) THEN
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!  begin flux computations
+!  start with x flux divergence
+
+!---------------
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+        DO k=kts+1,ktf
+        DO i = i_start_f, i_end_f
+          vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+          fqx( i, k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                  w(i  ,k,j), w(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start_f, i_end_f
+          vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+          fqx( i, k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                  w(i  ,k,j), w(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts+1,ktf
+            fqx(i_start, k) =                            &
+               0.5*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))  &
+                   *(w(i_start,k,j)+w(i_start-1,k,j))
+          ENDDO
+            k = ktf+1
+            fqx(i_start, k) =                            &
+               0.5*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))  &
+                   *(w(i_start,k,j)+w(i_start-1,k,j))
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts+1,ktf
+            fqx(i_end+1, k) =                            &
+               0.5*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))  &
+                   *(w(i_end+1,k,j)+w(i_end,k,j))
+          ENDDO
+            k = ktf+1
+            fqx(i_end+1, k) =                            &
+               0.5*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))  &
+                   *(w(i_end+1,k,j)+w(i_end,k,j))
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts+1,ktf+1
+        DO i = i_start, i_end
+          mrdx=msft(i,j)*rdx
+          tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+!  next -> y flux divergence calculation
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+
+        jp1 = 2
+        jp0 = 1
+
+      DO j = j_start, j_end+1
+
+       IF ((j < j_start_f) .and. degrade_ys)  THEN
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))   &
+                   *(w(i,k,j_start)+w(i,k,j_start-1))
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))   &
+                   *(w(i,k,j_start)+w(i,k,j_start-1))
+          ENDDO
+       ELSE IF ((j > j_end_f) .and. degrade_ye)  THEN
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            ! Assumes j>j_end_f is ONLY j_end+1 ...
+!            fqy(i, k, jp1) =                             &
+!               0.5*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))     &
+!                   *(w(i,k,j_end+1)+w(i,k,j_end))
+            fqy(i, k, jp1) =                             &
+               0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))     &
+                   *(w(i,k,j)+w(i,k,j-1))
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            ! Assumes j>j_end_f is ONLY j_end+1 ...
+!            fqy(i, k, jp1) =                                         &
+!               0.5*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))     &
+!                   *(w(i,k,j_end+1)+w(i,k,j_end))
+            fqy(i, k, jp1) =                                         &
+               0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))     &
+                   *(w(i,k,j)+w(i,k,j-1))
+          ENDDO
+       ELSE
+!  3rd or 4th order flux
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+            fqy( i, k, jp1 ) = vel*flux4( w(i,k,j-2), w(i,k,j-1),  &
+                                    w(i,k,j  ), w(i,k,j+1),  &
+                                    vel                     )
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+            fqy( i, k, jp1 ) = vel*flux4( w(i,k,j-2), w(i,k,j-1),  &
+                                    w(i,k,j  ), w(i,k,j+1),  &
+                                    vel                     )
+          ENDDO
+       END IF
+
+!  y flux-divergence into tendency
+       IF( j > j_start ) THEN
+
+          DO k = kts+1, ktf+1
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+
+       END IF
+
+       jtmp = jp1
+       jp1 = jp0
+       jp0 = jtmp
+
+    ENDDO
+
+ELSE IF ( horz_order == 3 ) THEN
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!  begin flux computations
+!  start with x flux divergence
+
+!---------------
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+        DO k=kts+1,ktf
+        DO i = i_start_f, i_end_f
+          vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+          fqx( i, k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                  w(i  ,k,j), w(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+        k = ktf+1
+        DO i = i_start_f, i_end_f
+          vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+          fqx( i, k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                  w(i  ,k,j), w(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts+1,ktf
+            fqx(i_start, k) =                            &
+               0.5*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))  &
+                   *(w(i_start,k,j)+w(i_start-1,k,j))
+          ENDDO
+            k = ktf+1
+            fqx(i_start, k) =                            &
+               0.5*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))  &
+                   *(w(i_start,k,j)+w(i_start-1,k,j))
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts+1,ktf
+            fqx(i_end+1, k) =                            &
+               0.5*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))  &
+                   *(w(i_end+1,k,j)+w(i_end,k,j))
+          ENDDO
+            k = ktf+1
+            fqx(i_end+1, k) =                            &
+               0.5*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))  &
+                   *(w(i_end+1,k,j)+w(i_end,k,j))
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts+1,ktf+1
+        DO i = i_start, i_end
+          mrdx=msft(i,j)*rdx
+          tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+!  next -> y flux divergence calculation
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+
+        jp1 = 2
+        jp0 = 1
+
+      DO j = j_start, j_end+1
+
+       IF ((j < j_start_f) .and. degrade_ys)  THEN
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))   &
+                   *(w(i,k,j_start)+w(i,k,j_start-1))
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))   &
+                   *(w(i,k,j_start)+w(i,k,j_start-1))
+          ENDDO
+       ELSE IF ((j > j_end_f) .and. degrade_ye)  THEN
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            ! Assumes j>j_end_f is ONLY j_end+1 ...
+!            fqy(i, k, jp1) =                             &
+!               0.5*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))     &
+!                   *(w(i,k,j_end+1)+w(i,k,j_end))
+            fqy(i, k, jp1) =                             &
+               0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))     &
+                   *(w(i,k,j)+w(i,k,j-1))
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            ! Assumes j>j_end_f is ONLY j_end+1 ...
+!            fqy(i, k, jp1) =                             &
+!               0.5*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))     &
+!                   *(w(i,k,j_end+1)+w(i,k,j_end))
+            fqy(i, k, jp1) =                             &
+               0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))     &
+                   *(w(i,k,j)+w(i,k,j-1))
+          ENDDO
+       ELSE
+!  3rd or 4th order flux
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+            fqy( i, k, jp1 ) = vel*flux3( w(i,k,j-2), w(i,k,j-1),  &
+                                    w(i,k,j  ), w(i,k,j+1),  &
+                                    vel                     )
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+            fqy( i, k, jp1 ) = vel*flux3( w(i,k,j-2), w(i,k,j-1),  &
+                                    w(i,k,j  ), w(i,k,j+1),  &
+                                    vel                     )
+          ENDDO
+       END IF
+
+!  y flux-divergence into tendency
+       IF( j > j_start ) THEN
+
+          DO k = kts+1, ktf+1
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+
+       END IF
+
+       jtmp = jp1
+       jp1 = jp0
+       jp0 = jtmp
+
+    ENDDO
+
+ELSE IF (horz_order == 2 ) THEN
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( .NOT. config_flags%periodic_x ) THEN
+        IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+        IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      ENDIF
+
+      DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+         mrdx=msft(i,j)*rdx
+
+            tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5            &
+                   *((fzm(k)*ru(i+1,k,j)+fzp(k)*ru(i+1,k-1,j))  &
+                                *(w(i+1,k,j)+w(i,k,j))          &
+                    -(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))      &
+                               *(w(i,k,j)+w(i-1,k,j)))
+
+      ENDDO
+      ENDDO
+
+      k = ktf+1
+      DO i = i_start, i_end
+
+         mrdx=msft(i,j)*rdx
+
+            tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5            &
+                   *(((2.-fzm(k-1))*ru(i+1,k-1,j)-fzp(k-1)*ru(i+1,k-2,j))      &
+                                *(w(i+1,k,j)+w(i,k,j))          &
+                    -((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))         &
+                               *(w(i,k,j)+w(i-1,k,j)))
+
+      ENDDO
+
+      ENDDO
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      !
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+
+      DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+         mrdy=msft(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5           &
+                   *((fzm(k)*rv(i,k,j+1)+fzp(k)*rv(i,k-1,j+1))* &
+                                 (w(i,k,j+1)+w(i,k,j))          &
+                    -(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))      &
+                                 *(w(i,k,j)+w(i,k,j-1))) 
+
+      ENDDO
+      ENDDO
+
+      k = ktf+1
+      DO i = i_start, i_end
+
+         mrdy=msft(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5       &
+                   *(((2.-fzm(k-1))*rv(i,k-1,j+1)-fzp(k-1)*rv(i,k-2,j+1))* &
+                                 (w(i,k,j+1)+w(i,k,j))      &
+                    -((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))      &
+                                 *(w(i,k,j)+w(i,k,j-1))) 
+
+      ENDDO
+
+      ENDDO
+
+   ELSE IF ( horz_order == 0 ) THEN
+
+      ! Just in case we want to turn horizontal advection off, we can do it
+
+   ELSE
+
+      WRITE ( wrf_err_message ,*) ' advect_w_6a, h_order not known ',horz_order
+      CALL wrf_error_fatal ( wrf_err_message )
+
+   ENDIF horizontal_order_test
+
+
+!  pick up the the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb'.
+!  first, set to index ranges
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+   IF( (config_flags%open_xs) .and. (its == ids)) THEN
+
+       DO j = j_start, j_end
+       DO k = kts+1, ktf
+
+         uw = 0.5*(fzm(k)*(ru(its,k  ,j)+ru(its+1,k  ,j)) +  &
+                   fzp(k)*(ru(its,k-1,j)+ru(its+1,k-1,j))   )
+         ub = MIN( uw, 0. )
+
+         tendency(its,k,j) = tendency(its,k,j)                     &
+               - rdx*(                                             &
+                       ub*(w_old(its+1,k,j) - w_old(its,k,j)) +    &
+                       w(its,k,j)*(                                &
+                       fzm(k)*(ru(its+1,k  ,j)-ru(its,k  ,j))+     &
+                       fzp(k)*(ru(its+1,k-1,j)-ru(its,k-1,j)))     &
+                                                                  )
+       ENDDO
+       ENDDO
+
+       k = ktf+1
+       DO j = j_start, j_end
+
+         uw = 0.5*( (2.-fzm(k-1))*(ru(its,k-1,j)+ru(its+1,k-1,j))   &
+                   -fzp(k-1)*(ru(its,k-2,j)+ru(its+1,k-2,j))   )
+         ub = MIN( uw, 0. )
+
+         tendency(its,k,j) = tendency(its,k,j)                     &
+               - rdx*(                                             &
+                       ub*(w_old(its+1,k,j) - w_old(its,k,j)) +    &
+                       w(its,k,j)*(                                &
+                             (2.-fzm(k-1))*(ru(its+1,k-1,j)-ru(its,k-1,j))-  &
+                             fzp(k-1)*(ru(its+1,k-2,j)-ru(its,k-2,j)))  &
+                                                                  )
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_xe) .and. (ite == ide)) THEN
+
+       DO j = j_start, j_end
+       DO k = kts+1, ktf
+
+         uw = 0.5*(fzm(k)*(ru(ite-1,k  ,j)+ru(ite,k  ,j)) +  &
+                   fzp(k)*(ru(ite-1,k-1,j)+ru(ite,k-1,j))   )
+         ub = MAX( uw, 0. )
+
+         tendency(i_end,k,j) = tendency(i_end,k,j)                     &
+               - rdx*(                                                 &
+                       ub*(w_old(i_end,k,j) - w_old(i_end-1,k,j)) +    &
+                       w(i_end,k,j)*(                                  &
+                            fzm(k)*(ru(ite,k  ,j)-ru(ite-1,k  ,j)) +   &
+                            fzp(k)*(ru(ite,k-1,j)-ru(ite-1,k-1,j)))    &
+                                                                    )
+       ENDDO
+       ENDDO
+
+       k = ktf+1
+       DO j = j_start, j_end
+
+         uw = 0.5*( (2.-fzm(k-1))*(ru(ite-1,k-1,j)+ru(ite,k-1,j))    &
+                   -fzp(k-1)*(ru(ite-1,k-2,j)+ru(ite,k-2,j))   )
+         ub = MAX( uw, 0. )
+
+         tendency(i_end,k,j) = tendency(i_end,k,j)                     &
+               - rdx*(                                                 &
+                       ub*(w_old(i_end,k,j) - w_old(i_end-1,k,j)) +    &
+                       w(i_end,k,j)*(                                  &
+                               (2.-fzm(k-1))*(ru(ite,k-1,j)-ru(ite-1,k-1,j)) -   &
+                               fzp(k-1)*(ru(ite,k-2,j)-ru(ite-1,k-2,j)))    &
+                                                                    )
+       ENDDO
+
+   ENDIF
+
+
+   IF( (config_flags%open_ys) .and. (jts == jds)) THEN
+
+       DO i = i_start, i_end
+       DO k = kts+1, ktf
+
+         vw = 0.5*( fzm(k)*(rv(i,k  ,jts)+rv(i,k  ,jts+1)) +  &
+                    fzp(k)*(rv(i,k-1,jts)+rv(i,k-1,jts+1))   )
+         vb = MIN( vw, 0. )
+
+         tendency(i,k,jts) = tendency(i,k,jts)                     &
+               - rdy*(                                             &
+                       vb*(w_old(i,k,jts+1) - w_old(i,k,jts)) +    &
+                       w(i,k,jts)*(                                &
+                       fzm(k)*(rv(i,k  ,jts+1)-rv(i,k  ,jts))+     &
+                       fzp(k)*(rv(i,k-1,jts+1)-rv(i,k-1,jts)))     &
+                                                                )
+       ENDDO
+       ENDDO
+
+       k = ktf+1
+       DO i = i_start, i_end
+         vw = 0.5*( (2.-fzm(k-1))*(rv(i,k-1,jts)+rv(i,k-1,jts+1))    &
+                   -fzp(k-1)*(rv(i,k-2,jts)+rv(i,k-2,jts+1))   )
+         vb = MIN( vw, 0. )
+
+         tendency(i,k,jts) = tendency(i,k,jts)                     &
+               - rdy*(                                             &
+                       vb*(w_old(i,k,jts+1) - w_old(i,k,jts)) +    &
+                       w(i,k,jts)*(                                &
+                          (2.-fzm(k-1))*(rv(i,k-1,jts+1)-rv(i,k-1,jts))-     &
+                          fzp(k-1)*(rv(i,k-2,jts+1)-rv(i,k-2,jts)))     &
+                                                                )
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ye) .and. (jte == jde) ) THEN
+
+       DO i = i_start, i_end
+       DO k = kts+1, ktf
+
+         vw = 0.5*( fzm(k)*(rv(i,k  ,jte-1)+rv(i,k  ,jte)) +  &
+                    fzp(k)*(rv(i,k-1,jte-1)+rv(i,k-1,jte))   )
+         vb = MAX( vw, 0. )
+
+         tendency(i,k,j_end) = tendency(i,k,j_end)                     &
+               - rdy*(                                                 &
+                       vb*(w_old(i,k,j_end) - w_old(i,k,j_end-1)) +    &
+                       w(i,k,j_end)*(                                  &
+                            fzm(k)*(rv(i,k  ,jte)-rv(i,k  ,jte-1))+    &
+                            fzp(k)*(rv(i,k-1,jte)-rv(i,k-1,jte-1)))    &
+                                                                      )
+       ENDDO
+       ENDDO
+
+       k = ktf+1
+       DO i = i_start, i_end
+
+         vw = 0.5*( (2.-fzm(k-1))*(rv(i,k-1,jte-1)+rv(i,k-1,jte))    &
+                   -fzp(k-1)*(rv(i,k-2,jte-1)+rv(i,k-2,jte))   )
+         vb = MAX( vw, 0. )
+
+         tendency(i,k,j_end) = tendency(i,k,j_end)                     &
+               - rdy*(                                                 &
+                       vb*(w_old(i,k,j_end) - w_old(i,k,j_end-1)) +    &
+                       w(i,k,j_end)*(                                  &
+                               (2.-fzm(k-1))*(rv(i,k-1,jte)-rv(i,k-1,jte-1))-    &
+                               fzp(k-1)*(rv(i,k-2,jte)-rv(i,k-2,jte-1)))    &
+                                                                      )
+       ENDDO
+
+   ENDIF
+
+!-------------------- vertical advection
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      DO i = i_start, i_end
+         vflux(i,kts)=0.
+         vflux(i,kte)=0.
+      ENDDO
+
+    vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux6(                                   &
+                   w(i,k-3,j), w(i,k-2,j), w(i,k-1,j),       &
+                   w(i,k  ,j), w(i,k+1,j), w(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux4(               &
+                   w(i,k-2,j), w(i,k-1,j),   &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+
+           k = ktf
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux4(               &
+                   w(i,k-2,j), w(i,k-1,j),   &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+
+           k=ktf+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+! pick up flux contribution for w at the lid. wcs, 13 march 2004
+         k = ktf+1
+         DO i = i_start, i_end
+           tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+         ENDDO
+
+      ENDDO
+
+ ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux5(                                   &
+                   w(i,k-3,j), w(i,k-2,j), w(i,k-1,j),       &
+                   w(i,k  ,j), w(i,k+1,j), w(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+                                   
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux3(               &
+                   w(i,k-2,j), w(i,k-1,j),   &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+           k = ktf
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux3(               &
+                   w(i,k-2,j), w(i,k-1,j),   &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+
+           k=ktf+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+! pick up flux contribution for w at the lid, wcs. 13 march 2004
+         k = ktf+1
+         DO i = i_start, i_end
+           tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+         ENDDO
+
+      ENDDO
+
+ ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux4(              &
+                   w(i,k-2,j), w(i,k-1,j),      &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+           k=ktf+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+! pick up flux contribution for w at the lid, wcs. 13 march 2004
+         k = ktf+1
+         DO i = i_start, i_end
+           tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+         ENDDO
+
+      ENDDO
+
+ ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux3(              &
+                   w(i,k-2,j), w(i,k-1,j),      &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+           k=ktf+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+! pick up flux contribution for w at the lid, wcs. 13 march 2004
+         k = ktf+1
+         DO i = i_start, i_end
+           tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+         ENDDO
+
+      ENDDO
+
+ ELSE IF (vert_order == 2) THEN    
+
+  DO j = j_start, j_end
+     DO k=kts+1,ktf+1
+     DO i = i_start, i_end
+
+            vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+     ENDDO
+     ENDDO
+     DO k=kts+1,ktf
+     DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+
+     ENDDO
+     ENDDO
+
+! pick up flux contribution for w at the lid, wcs. 13 march 2004
+     k = ktf+1
+     DO i = i_start, i_end
+       tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+     ENDDO
+
+  ENDDO
+
+   ELSE
+
+      WRITE (wrf_err_message ,*) ' advect_w, v_order not known ',vert_order
+      CALL wrf_error_fatal ( wrf_err_message )
+
+   ENDIF vert_order_test
+
+END SUBROUTINE advect_w
+
+!----------------------------------------------------------------
+
+SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
+                                ru, rv, rom,                   &
+                                mut, mub, mu_old,              &
+                                config_flags,                  &
+                                msfu, msfv, msft,              &
+                                fzm, fzp,                      &
+                                rdx, rdy, rdzw, dt,            &
+                                ids, ide, jds, jde, kds, kde,  &
+                                ims, ime, jms, jme, kms, kme,  &
+                                its, ite, jts, jte, kts, kte  )
+
+!  this is a first cut at a positive definite advection option
+!  for scalars in WRF.  This version is memory intensive ->
+!  we save 3d arrays of x, y and z both high and low order fluxes
+!  (six in all).  Alternatively, we could sweep in a direction 
+!  and lower the cost considerably.
+
+!  uses the Smolarkiewicz MWR 1989 approach, with addition of first-order
+!  fluxes initially
+
+!  WCS, 3 December 2002, 24 February 2003
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field,     &
+                                                                      field_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut, mub, mu_old
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy,  &
+                                                                  dt
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw, mu
+
+!  storage for high and low order fluxes
+
+   REAL,  DIMENSION( its-1:ite+2, kts:kte, jts-1:jte+2  ) :: fqx, fqy, fqz
+   REAL,  DIMENSION( its-1:ite+2, kts:kte, jts-1:jte+2  ) :: fqxl, fqyl, fqzl
+
+   INTEGER :: horz_order, vert_order
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+   INTEGER :: jp1, jp0, jtmp
+
+   REAL :: flux_out, ph_low, scale
+   REAL, PARAMETER :: eps=1.e-20
+
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6, flux_upwind
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel, cr
+
+      flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+            (7./12.)*(q_i + q_im1) - (1./12.)*(q_ip1 + q_im2)
+
+      flux3(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+           flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+           sign(1.,ua)*(1./12.)*((q_ip1 - q_im2)-3.*(q_i-q_im1))
+
+      flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+            (37./60.)*(q_i+q_im1) - (2./15.)*(q_ip1+q_im2)      &
+            +(1./60.)*(q_ip2+q_im3)
+
+      flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)    &
+            -sign(1.,ua)*(1./60.)*(                             &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )
+
+      flux_upwind(q_im1, q_i, cr ) = 0.5*min( 1.0,(cr+abs(cr)))*q_im1 &
+                                    +0.5*max(-1.0,(cr-abs(cr)))*q_i
+
+!      flux_upwind(q_im1, q_i, cr ) = 0.5*(1.+sign(1.,cr))*q_im1 &
+!                                    +0.5*(1.-sign(1.,cr))*q_i
+!      flux_upwind(q_im1, q_i, cr ) = 0.
+
+    REAL     :: dx,dy,dz
+
+    LOGICAL, PARAMETER :: pd_limit = .true.
+
+! set order for the advection schemes
+
+!  write(6,*) ' in pd advection routine '
+
+  ktf=MIN(kte,kde-1)
+  horz_order = config_flags%h_sca_adv_order
+  vert_order = config_flags%v_sca_adv_order
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+!  begin with horizontal flux divergence
+!  here is the choice of flux operators
+
+
+  horizontal_order_test : IF( horz_order == 6 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-4)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-4)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!--  modify loop bounds if open or specified
+
+!      IF(degrade_xs) i_start = MAX(its-1,ids-1)
+!      IF(degrade_xe) i_end   = MIN(ite+1,ide-2)
+      IF(degrade_xs) i_start = MAX(its-1,ids)
+      IF(degrade_xe) i_end   = MIN(ite+1,ide-1)
+
+      IF(degrade_ys) then
+        j_start = MAX(jts-1,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte+1,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 6th order
+
+      j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+          dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+          mu = 0.5*(mut(i,j)+mut(i,j-1))
+          vel = rv(i,k,j)
+          cr = vel*dt/dy/mu
+          fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+          fqy( i, k, j  ) = vel*flux6(                                  &
+                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
+                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
+
+          fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j ) = vel*flux4(              &
+                   field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i, k, j ) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j) = vel*flux4(             &
+                   field(i,k,j-2),field(i,k,j-1),    &
+                   field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ENDIF
+
+   ENDDO j_loop_y_flux_6
+
+!  next, x flux
+
+!--  these bounds are for periodic and sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds for open and specified b.c
+
+!      IF(degrade_ys) j_start = MAX(jts-1,jds+1)
+!      IF(degrade_ye) j_end   = MIN(jte+1,jde-2)
+      IF(degrade_ys) j_start = MAX(jts-1,jds)
+      IF(degrade_ye) j_end   = MIN(jte+1,jde-1)
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its-1)
+        i_start_f = ids+3
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite+1)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+          mu = 0.5*(mut(i,j)+mut(i-1,j))
+          vel = ru(i,k,j)
+          cr = vel*dt/dx/mu
+          fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+          fqx( i,k,j ) = vel*flux6( field(i-3,k,j), field(i-2,k,j),  &
+                                         field(i-1,k,j), field(i  ,k,j),  &
+                                         field(i+1,k,j), field(i+2,k,j),  &
+                                         vel                             )
+          fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          DO i=i_start,i_start_f-1
+
+            IF(i == ids+1) THEN ! second order
+              DO k=kts,ktf
+                dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+                mu = 0.5*(mut(i,j)+mut(i-1,j))
+                vel = ru(i,k,j)/mu
+                cr = vel*dt/dx
+                fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx(i,k,j) = 0.5*(ru(i,k,j)) &
+                       *(field(i,k,j)+field(i-1,k,j))
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+              ENDDO
+            ENDIF
+
+            IF(i == ids+2) THEN  ! fourth order
+              DO k=kts,ktf
+                dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+                mu = 0.5*(mut(i,j)+mut(i-1,j))
+                vel = ru(i,k,j)
+                cr = vel*dt/dx/mu
+                fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx( i,k,j ) = vel*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+              ENDDO
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          DO i = i_end_f+1, i_end+1
+
+            IF( i == ide-1 ) THEN ! second order flux next to the boundary
+              DO k=kts,ktf
+                dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+                mu = 0.5*(mut(i,j)+mut(i-1,j))
+                vel = ru(i,k,j)
+                cr = vel*dt/dx/mu
+                fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx(i,k,j) = 0.5*(ru(i,k,j))      &
+                       *(field(i,k,j)+field(i-1,k,j))
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+              ENDDO
+            ENDIF
+
+
+            IF( i == ide-2 ) THEN ! fourth order flux one in from the boundary
+              DO k=kts,ktf
+                dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+                mu = 0.5*(mut(i,j)+mut(i-1,j))
+                vel = ru(i,k,j)
+                cr = vel*dt/dx/mu
+                fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx( i,k,j ) = vel*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+              ENDDO
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+      ENDDO  ! enddo for outer J loop
+
+!--- end of 6th order horizontal flux calculation
+
+    ELSE IF( horz_order == 5 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-4)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-4)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!--  modify loop bounds if open or specified
+
+!      IF(degrade_xs) i_start = MAX(its-1,ids-1)
+!      IF(degrade_xe) i_end   = MIN(ite+1,ide-2)
+      IF(degrade_xs) i_start = MAX(its-1,ids)
+      IF(degrade_xe) i_end   = MIN(ite+1,ide-1)
+
+      IF(degrade_ys) then
+        j_start = MAX(jts-1,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte+1,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 5th order
+
+      j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+          dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+          mu = 0.5*(mut(i,j)+mut(i,j-1))
+          vel = rv(i,k,j)
+          cr = vel*dt/dy/mu
+          fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+          fqy( i, k, j  ) = vel*flux5(                                  &
+                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
+                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
+
+          fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j ) = vel*flux3(              &
+                   field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i, k, j ) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j) = vel*flux3(             &
+                   field(i,k,j-2),field(i,k,j-1),    &
+                   field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ENDIF
+
+   ENDDO j_loop_y_flux_5
+
+!  next, x flux
+
+!--  these bounds are for periodic and sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds for open and specified b.c
+
+!      IF(degrade_ys) j_start = MAX(jts-1,jds+1)
+!      IF(degrade_ye) j_end   = MIN(jte+1,jde-2)
+      IF(degrade_ys) j_start = MAX(jts-1,jds)
+      IF(degrade_ye) j_end   = MIN(jte+1,jde-1)
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its-1)
+        i_start_f = ids+3
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite+1)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+          mu = 0.5*(mut(i,j)+mut(i-1,j))
+          vel = ru(i,k,j)
+          cr = vel*dt/dx/mu
+          fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+          fqx( i,k,j ) = vel*flux5( field(i-3,k,j), field(i-2,k,j),  &
+                                         field(i-1,k,j), field(i  ,k,j),  &
+                                         field(i+1,k,j), field(i+2,k,j),  &
+                                         vel                             )
+          fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          DO i=i_start,i_start_f-1
+
+            IF(i == ids+1) THEN ! second order
+              DO k=kts,ktf
+                dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+                mu = 0.5*(mut(i,j)+mut(i-1,j))
+                vel = ru(i,k,j)/mu
+                cr = vel*dt/dx
+                fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx(i,k,j) = 0.5*(ru(i,k,j)) &
+                       *(field(i,k,j)+field(i-1,k,j))
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+              ENDDO
+            ENDIF
+
+            IF(i == ids+2) THEN  ! third order
+              DO k=kts,ktf
+                dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+                mu = 0.5*(mut(i,j)+mut(i-1,j))
+                vel = ru(i,k,j)
+                cr = vel*dt/dx/mu
+                fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+              ENDDO
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          DO i = i_end_f+1, i_end+1
+
+            IF( i == ide-1 ) THEN ! second order flux next to the boundary
+              DO k=kts,ktf
+                dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+                mu = 0.5*(mut(i,j)+mut(i-1,j))
+                vel = ru(i,k,j)
+                cr = vel*dt/dx/mu
+                fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx(i,k,j) = 0.5*(ru(i,k,j))      &
+                       *(field(i,k,j)+field(i-1,k,j))
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+              ENDDO
+            ENDIF
+
+
+            IF( i == ide-2 ) THEN ! third order flux one in from the boundary
+              DO k=kts,ktf
+                dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+                mu = 0.5*(mut(i,j)+mut(i-1,j))
+                vel = ru(i,k,j)
+                cr = vel*dt/dx/mu
+                fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+              ENDDO
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+      ENDDO  ! enddo for outer J loop
+
+!--- end of 5th order horizontal flux calculation
+
+    ELSE IF( horz_order == 4 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!--  modify loop bounds if open or specified
+
+      IF(degrade_xs) i_start = its
+      IF(degrade_xe) i_end   = MIN(ite,ide-1)
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+2
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-2
+      ENDIF
+
+!  compute fluxes, 4th order
+
+      j_loop_y_flux_4 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+          dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+          mu = 0.5*(mut(i,j)+mut(i,j-1))
+          vel = rv(i,k,j)
+          cr = vel*dt/dy/mu
+          fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+          fqy( i, k, j  ) = vel*flux4(  field(i,k,j-2), field(i,k,j-1),       &
+                                        field(i,k,j  ), field(i,k,j+1), vel )
+
+          fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i, k, j ) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ENDIF
+
+   ENDDO j_loop_y_flux_4
+
+!  next, x flux
+
+!--  these bounds are for periodic and sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds for open and specified b.c
+
+      IF(degrade_ys) j_start = jts
+      IF(degrade_ye) j_end   = MIN(jte,jde-1)
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+          mu = 0.5*(mut(i,j)+mut(i-1,j))
+          vel = ru(i,k,j)
+          cr = vel*dt/dx/mu
+          fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+          fqx( i,k,j ) = vel*flux4( field(i-2,k,j), field(i-1,k,j), &
+                                    field(i  ,k,j), field(i+1,k,j), vel )
+          fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)/mu
+              cr = vel*dt/dx
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+              fqx(i,k,j) = 0.5*(ru(i,k,j)) &
+                     *(field(i,k,j)+field(i-1,k,j))
+
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts,ktf
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)
+              cr = vel*dt/dx/mu
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+              fqx(i,k,j) = 0.5*(ru(i,k,j))      &
+                     *(field(i,k,j)+field(i-1,k,j))
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+        ENDIF
+
+      ENDDO  ! enddo for outer J loop
+
+!--- end of 4th order horizontal flux calculation
+
+   ELSE IF( horz_order == 3 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-1)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-1)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!--  modify loop bounds if open or specified
+
+      IF(degrade_xs) i_start = its
+      IF(degrade_xe) i_end   = MIN(ite,ide-1)
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+2
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-2
+      ENDIF
+
+!  compute fluxes, 3rd order
+
+      j_loop_y_flux_3 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+          dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+          mu = 0.5*(mut(i,j)+mut(i,j-1))
+          vel = rv(i,k,j)
+          cr = vel*dt/dy/mu
+          fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+          fqy( i, k, j  ) = vel*flux3(  field(i,k,j-2), field(i,k,j-1),       &
+                                        field(i,k,j  ), field(i,k,j+1), vel )
+
+          fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i, k, j ) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ENDIF
+
+   ENDDO j_loop_y_flux_3
+
+!  next, x flux
+
+!--  these bounds are for periodic and sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds for open and specified b.c
+
+      IF(degrade_ys) j_start = jts
+      IF(degrade_ye) j_end   = MIN(jte,jde-1)
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+          mu = 0.5*(mut(i,j)+mut(i-1,j))
+          vel = ru(i,k,j)
+          cr = vel*dt/dx/mu
+          fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+          fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j), &
+                                    field(i  ,k,j), field(i+1,k,j), vel )
+          fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)/mu
+              cr = vel*dt/dx
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+              fqx(i,k,j) = 0.5*(ru(i,k,j)) &
+                     *(field(i,k,j)+field(i-1,k,j))
+
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts,ktf
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)
+              cr = vel*dt/dx/mu
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+              fqx(i,k,j) = 0.5*(ru(i,k,j))      &
+                     *(field(i,k,j)+field(i-1,k,j))
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+        ENDIF
+
+      ENDDO  ! enddo for outer J loop
+
+!--- end of 3rd order horizontal flux calculation
+
+
+   ELSE IF( horz_order == 2 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds if open or specified
+
+      IF(degrade_xs) i_start = its
+      IF(degrade_xe) i_end   = MIN(ite,ide-1)
+      IF(degrade_ys) j_start = MAX(jts,jds+1)
+      IF(degrade_ye) j_end = MIN(jte,jde-2)
+
+!  compute fluxes, 2nd order, y flux
+
+      DO j = j_start, j_end+1
+        DO k=kts,ktf
+        DO i = i_start, i_end
+           dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+           mu = 0.5*(mut(i,j)+mut(i,j-1))
+           vel = rv(i,k,j)
+           cr = vel*dt/dy/mu
+           fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+           fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                  (field(i,k,j)+field(i,k,j-1))
+
+           fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+        ENDDO
+        ENDDO
+      ENDDO
+
+!  next, x flux
+
+      DO j = j_start, j_end
+        DO k=kts,ktf
+        DO i = i_start, i_end+1
+            dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+            mu = 0.5*(mut(i,j)+mut(i-1,j))
+            vel = ru(i,k,j)
+            cr = vel*dt/dx/mu
+            fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+            fqx( i,k,j ) = 0.5*ru(i,k,j)*          &
+                  (field(i,k,j)+field(i-1,k,j))
+
+            fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+        ENDDO
+        ENDDO
+      ENDDO
+
+!--- end of 2nd order horizontal flux calculation
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_scalar_pd, h_order not known ',horz_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF horizontal_order_test
+
+!  pick up the rest of the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb'.
+!  first, set to index ranges
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  compute x (u) conditions for v, w, or scalar
+
+   IF( (config_flags%open_xs) .and. (its == ids) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MIN( 0.5*(ru(its,k,j)+ru(its+1,k,j)), 0. )
+         tendency(its,k,j) = tendency(its,k,j)                     &
+               - rdx*(                                             &
+                       ub*(   field_old(its+1,k,j)                 &
+                            - field_old(its  ,k,j)   ) +           &
+                       field(its,k,j)*(ru(its+1,k,j)-ru(its,k,j))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MAX( 0.5*(ru(ite-1,k,j)+ru(ite,k,j)), 0. )
+         tendency(i_end,k,j) = tendency(i_end,k,j)                   &
+               - rdx*(                                               &
+                       ub*(  field_old(i_end  ,k,j)                  &
+                           - field_old(i_end-1,k,j) ) +              &
+                       field(i_end,k,j)*(ru(ite,k,j)-ru(ite-1,k,j))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MIN( 0.5*(rv(i,k,jts)+rv(i,k,jts+1)), 0. )
+         tendency(i,k,jts) = tendency(i,k,jts)                     &
+               - rdy*(                                             &
+                       vb*(  field_old(i,k,jts+1)                  &
+                           - field_old(i,k,jts  ) ) +              &
+                       field(i,k,jts)*(rv(i,k,jts+1)-rv(i,k,jts))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ye) .and. (jte == jde)) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MAX( 0.5*(rv(i,k,jte-1)+rv(i,k,jte)), 0. )
+         tendency(i,k,j_end) = tendency(i,k,j_end)                   &
+               - rdy*(                                               &
+                       vb*(   field_old(i,k,j_end  )                 &
+                            - field_old(i,k,j_end-1) ) +             &
+                       field(i,k,j_end)*(rv(i,k,jte)-rv(i,k,jte-1))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+!-------------------- vertical advection
+
+!-- loop bounds for periodic or sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!-- loop bounds for open or specified conditions
+
+    IF(degrade_xs) i_start = MAX(its-1,ids)
+    IF(degrade_xe) i_end   = MIN(ite+1,ide-1)
+    IF(degrade_ys) j_start = MAX(jts-1,jds)
+    IF(degrade_ye) j_end   = MIN(jte+1,jde-1)
+
+    vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux6( field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),      &
+                                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=kts+2
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux4(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf-1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux4(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux5( field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),      &
+                                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=kts+2
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux3(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf-1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux3(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux4(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux3(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 2) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE
+
+      WRITE (wrf_err_message,*) ' advect_scalar_pd, v_order not known ',vert_order
+      CALL wrf_error_fatal ( wrf_err_message )
+
+   ENDIF vert_order_test
+
+   IF (pd_limit) THEN
+
+! positive definite filter
+
+   i_start = its-1
+   i_end   = MIN(ite,ide-1)+1
+   j_start = jts-1
+   j_end   = MIN(jte,jde-1)+1
+
+!-- loop bounds for open or specified conditions
+
+   IF(degrade_xs) i_start = MAX(its-1,ids)
+   IF(degrade_xe) i_end   = MIN(ite+1,ide-1)
+   IF(degrade_ys) j_start = MAX(jts-1,jds)
+   IF(degrade_ye) j_end   = MIN(jte+1,jde-1)
+
+   IF(config_flags%specified .or. config_flags%nested) THEN
+     IF (degrade_xs) i_start = MAX(its-1,ids+1)
+     IF (degrade_xe) i_end   = MIN(ite+1,ide-2)
+     IF (degrade_ys) j_start = MAX(jts-1,jds+1)
+     IF (degrade_ye) j_end   = MIN(jte+1,jde-2)
+   END IF
+
+   IF(config_flags%open_xs) THEN
+     IF (degrade_xs) i_start = MAX(its-1,ids+1)
+   END IF
+   IF(config_flags%open_xe) THEN
+     IF (degrade_xe) i_end   = MIN(ite+1,ide-2)
+   END IF
+   IF(config_flags%open_ys) THEN
+     IF (degrade_ys) j_start = MAX(jts-1,jds+1)
+   END IF
+   IF(config_flags%open_ye) THEN
+     IF (degrade_ye) j_end   = MIN(jte+1,jde-2)
+   END IF
+
+!-- here is the limiter...
+
+   DO j=j_start, j_end
+   DO k=kts, ktf
+   DO i=i_start, i_end
+
+     ph_low = (mub(i,j)+mu_old(i,j))*field_old(i,k,j)        &
+                - dt*( msft(i,j)*(                           & 
+                       rdx*(fqxl(i+1,k,j)-fqxl(i,k,j)) +     &
+                       rdy*(fqyl(i,k,j+1)-fqyl(i,k,j))  )    &
+                      +         rdzw(k)*(fqzl(i,k+1,j)-fqzl(i,k,j)) )
+
+     flux_out = dt*(  msft(i,j)             *(                    &
+                                rdx*(  max(0.,fqx (i+1,k,j))      &
+                                      -min(0.,fqx (i  ,k,j)) )    &
+                               +rdy*(  max(0.,fqy (i,k,j+1))      &
+                                      -min(0.,fqy (i,k,j  )) ) )  &
+                +           rdzw(k)*(  min(0.,fqz (i,k+1,j))      &
+                                      -max(0.,fqz (i,k  ,j)) )   )
+
+     IF( flux_out .gt. ph_low ) THEN
+
+       scale = max(0.,ph_low/(flux_out+eps))
+       IF( fqx (i+1,k,j) .gt. 0.) fqx(i+1,k,j) = scale*fqx(i+1,k,j)
+       IF( fqx (i  ,k,j) .lt. 0.) fqx(i  ,k,j) = scale*fqx(i  ,k,j)
+       IF( fqy (i,k,j+1) .gt. 0.) fqy(i,k,j+1) = scale*fqy(i,k,j+1)
+       IF( fqy (i,k,j  ) .lt. 0.) fqy(i,k,j  ) = scale*fqy(i,k,j  )
+!  note: z flux is opposite sign in mass coordinate because 
+!  vertical coordinate decreases with increasing k
+       IF( fqz (i,k+1,j) .lt. 0.) fqz(i,k+1,j) = scale*fqz(i,k+1,j)
+       IF( fqz (i,k  ,j) .gt. 0.) fqz(i,k  ,j) = scale*fqz(i,k  ,j)
+
+     END IF
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+   END IF
+
+! add in the pd-limited flux divergence
+
+  i_start = its
+  i_end   = MIN(ite,ide-1)
+  j_start = jts
+  j_end   = MIN(jte,jde-1)
+
+  DO j = j_start, j_end
+  DO k = kts, ktf
+  DO i = i_start, i_end
+
+     tendency (i,k,j) = tendency(i,k,j)                           &
+                            -rdzw(k)*( fqz (i,k+1,j)-fqz (i,k,j)  &
+                                      +fqzl(i,k+1,j)-fqzl(i,k,j))
+
+  ENDDO
+  ENDDO
+  ENDDO
+
+! x flux divergence
+!
+  IF(degrade_xs) i_start = MAX(its,ids+1)
+  IF(degrade_xe) i_end   = MIN(ite,ide-2)
+
+  DO j = j_start, j_end
+  DO k = kts, ktf
+  DO i = i_start, i_end
+
+     tendency (i,k,j) = tendency(i,k,j)                           &
+               - msft(i,j)*( rdx*( fqx (i+1,k,j)-fqx (i,k,j)     &
+                                   +fqxl(i+1,k,j)-fqxl(i,k,j))   )
+
+  ENDDO
+  ENDDO
+  ENDDO
+
+! y flux divergence
+!
+  i_start = its
+  i_end   = MIN(ite,ide-1)
+  IF(degrade_ys) j_start = MAX(jts,jds+1)
+  IF(degrade_ye) j_end   = MIN(jte,jde-2)
+
+  DO j = j_start, j_end
+  DO k = kts, ktf
+  DO i = i_start, i_end
+
+     tendency (i,k,j) = tendency(i,k,j)                           &
+               - msft(i,j)*( rdy*( fqy (i,k,j+1)-fqy (i,k,j)     &
+                                   +fqyl(i,k,j+1)-fqyl(i,k,j))   )
+
+  ENDDO
+  ENDDO
+  ENDDO
+
+END SUBROUTINE advect_scalar_pd
+
+!----------------------------------------------------------------
+
+SUBROUTINE advect_scalar_mono   ( field, field_old, tendency,    &
+                                  ru, rv, rom,                   &
+                                  mut, mub, mu_old,              &
+                                  config_flags,                  &
+                                  msfu, msfv,                    &
+                                  msft,                          &
+                                  fzm, fzp,                      &
+                                  rdx, rdy, rdzw, dt,            &
+                                  ids, ide, jds, jde, kds, kde,  &
+                                  ims, ime, jms, jme, kms, kme,  &
+                                  its, ite, jts, jte, kts, kte  )
+
+!  monotonic advection option
+!  for scalars in WRF RK3 advection.  This version is memory intensive ->
+!  we save 3d arrays of x, y and z both high and low order fluxes
+!  (six in all).  Alternatively, we could sweep in a direction 
+!  and lower the cost considerably.
+
+!  uses the Smolarkiewicz MWR 1989 approach, with addition of first-order
+!  fluxes initially
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field,     &
+                                                                      field_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut, mub, mu_old
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy,  &
+                                                                  dt
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw, mu
+   REAL , DIMENSION(its:ite, kts:kte) :: vflux
+
+
+!  storage for high and low order fluxes
+
+   REAL,  DIMENSION( its-2:ite+2, kts:kte, jts-2:jte+2  ) :: fqx, fqy, fqz
+   REAL,  DIMENSION( its-2:ite+2, kts:kte, jts-2:jte+2  ) :: fqxl, fqyl, fqzl
+   REAL,  DIMENSION( its-2:ite+2, kts:kte, jts-2:jte+2  ) :: qmin, qmax
+   REAL,  DIMENSION( its-2:ite+2, kts:kte, jts-2:jte+2  ) :: scale_in, scale_out
+   REAL :: ph_upwind
+
+   INTEGER :: horz_order, vert_order
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+   INTEGER :: jp1, jp0, jtmp
+
+   REAL :: flux_out, ph_low, flux_in, ph_hi, scale
+   REAL, PARAMETER :: eps=1.e-20
+
+
+! definition of flux operators, 3rd, 4rth, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6, flux_upwind
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel, cr
+
+      flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+            (7./12.)*(q_i + q_im1) - (1./12.)*(q_ip1 + q_im2)
+
+      flux3(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+           flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+           sign(1.,ua)*(1./12.)*((q_ip1 - q_im2)-3.*(q_i-q_im1))
+
+      flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+            (37./60.)*(q_i+q_im1) - (2./15.)*(q_ip1+q_im2)      &
+            +(1./60.)*(q_ip2+q_im3)
+
+      flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)    &
+            -sign(1.,ua)*(1./60.)*(                             &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )
+
+!      flux_upwind(q_im1, q_i, cr ) = 0.
+      flux_upwind(q_im1, q_i, cr ) = 0.5*(1.+sign(1.,cr))*q_im1 &
+                                    +0.5*(1.-sign(1.,cr))*q_i
+
+    LOGICAL, PARAMETER :: mono_limit = .true.
+
+! set order for the advection schemes
+
+  ktf=MIN(kte,kde-1)
+  horz_order = config_flags%h_sca_adv_order
+  vert_order = config_flags%v_sca_adv_order
+
+  do j=jts-2,jte+2
+  do k=kts,kte
+  do i=its-2,ite+2
+    qmin(i,k,j) = field_old(i,k,j)
+    qmax(i,k,j) = field_old(i,k,j)
+    scale_in(i,k,j) = 1.
+    scale_out(i,k,j) = 1.
+    fqx(i,k,j) = 0.
+    fqy(i,k,j) = 0.
+    fqz(i,k,j) = 0.
+    fqxl(i,k,j) = 0.
+    fqyl(i,k,j) = 0.
+    fqzl(i,k,j) = 0.
+  enddo
+  enddo
+  enddo
+
+!  begin with horizontal flux divergence
+!  here is the choice of flux operators
+
+
+  horizontal_order_test : IF( horz_order == 5 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4rth order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+3)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-4)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+3)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-4)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!--  modify loop bounds if open or specified
+
+!  WCS 20090218
+!      IF(degrade_xs) i_start = its
+!      IF(degrade_xe) i_end   = MIN(ite,ide-1)
+      IF(degrade_xs) i_start = MAX(its-1,ids)
+      IF(degrade_xe) i_end   = MIN(ite+1,ide-1)
+
+!  WCS 20090218
+!      IF(degrade_ys) then
+!        j_start = MAX(jts,jds+1)
+!        j_start_f = jds+3
+!      ENDIF
+!
+!      IF(degrade_ye) then
+!        j_end = MIN(jte,jde-2)
+!        j_end_f = jde-3
+!      ENDIF
+
+      IF(degrade_ys) then
+        j_start = MAX(jts-1,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte+1,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 5th order
+
+      j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+          vel = rv(i,k,j)
+          cr = vel
+          fqyl(i,k,j) = vel*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), vel)
+
+          fqy( i, k, j  ) = vel*flux5(                                  &
+                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
+                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
+
+          fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+          if(cr.gt. 0) then
+             qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i,k,j-1))
+             qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i,k,j-1))
+          else
+             qmax(i,k,j-1)  = amax1(qmax(i,k,j-1),field_old(i,k,j))
+             qmin(i,k,j-1)  = amin1(qmin(i,k,j-1),field_old(i,k,j))
+          end if
+
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              vel = rv(i,k,j)
+              cr = vel
+              fqyl(i,k,j) = vel*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+          if(cr.gt. 0) then
+             qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i,k,j-1))
+             qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i,k,j-1))
+          else
+             qmax(i,k,j-1)  = amax1(qmax(i,k,j-1),field_old(i,k,j))
+             qmin(i,k,j-1)  = amin1(qmin(i,k,j-1),field_old(i,k,j))
+          end if
+
+            ENDDO
+            ENDDO
+
+      ELSE IF  ( j == jds+2 ) THEN  ! third of 4rth order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              vel = rv(i,k,j)
+              cr = vel
+              fqyl(i,k,j) = vel*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j ) = vel*flux3(              &
+                   field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+          if(cr.gt. 0) then
+             qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i,k,j-1))
+             qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i,k,j-1))
+          else
+             qmax(i,k,j-1)  = amax1(qmax(i,k,j-1),field_old(i,k,j))
+             qmin(i,k,j-1)  = amin1(qmin(i,k,j-1),field_old(i,k,j))
+          end if
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              vel = rv(i,k,j)
+              cr = vel
+              fqyl(i,k,j) = vel*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i, k, j ) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+          if(cr.gt. 0) then
+             qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i,k,j-1))
+             qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i,k,j-1))
+          else
+             qmax(i,k,j-1)  = amax1(qmax(i,k,j-1),field_old(i,k,j))
+             qmin(i,k,j-1)  = amin1(qmin(i,k,j-1),field_old(i,k,j))
+          end if
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4rth order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              vel = rv(i,k,j)
+              cr = vel
+              fqyl(i,k,j) = vel*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j) = vel*flux3(             &
+                   field(i,k,j-2),field(i,k,j-1),    &
+                   field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+          if(cr.gt. 0) then
+             qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i,k,j-1))
+             qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i,k,j-1))
+          else
+             qmax(i,k,j-1)  = amax1(qmax(i,k,j-1),field_old(i,k,j))
+             qmin(i,k,j-1)  = amin1(qmin(i,k,j-1),field_old(i,k,j))
+          end if
+
+            ENDDO
+            ENDDO
+
+      ENDIF
+
+   ENDDO j_loop_y_flux_5
+
+!  next, x flux
+
+!--  these bounds are for periodic and sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds for open and specified b.c
+
+!  WCS 20090218
+!      IF(degrade_ys) j_start = jts
+!      IF(degrade_ye) j_end   = MIN(jte,jde-1)
+      IF(degrade_ys) j_start = MAX(jts-1,jds)
+      IF(degrade_ye) j_end   = MIN(jte+1,jde-1)
+
+!  WCS 20090218
+!      IF(degrade_xs) then
+!        i_start = MAX(ids+1,its)
+!        i_start_f = i_start+2
+!      ENDIF
+
+!      IF(degrade_xe) then
+!        i_end = MIN(ide-2,ite)
+!        i_end_f = ide-3
+!      ENDIF
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its-1)
+        i_start_f = ids+3
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite+1)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          vel = ru(i,k,j)
+          cr = vel
+          fqxl(i,k,j) = vel*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+          fqx( i,k,j ) = vel*flux5( field(i-3,k,j), field(i-2,k,j),  &
+                                         field(i-1,k,j), field(i  ,k,j),  &
+                                         field(i+1,k,j), field(i+2,k,j),  &
+                                         vel                             )
+          fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+          if(cr.gt. 0) then
+             qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i-1,k,j))
+             qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i-1,k,j))
+          else
+             qmax(i-1,k,j)  = amax1(qmax(i-1,k,j),field_old(i,k,j))
+             qmin(i-1,k,j)  = amin1(qmin(i-1,k,j),field_old(i,k,j))
+          end if
+
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+!  WCS 20090218 degrade_xs and xe recoded
+
+        IF( degrade_xs ) THEN
+
+          DO i=i_start,i_start_f-1
+
+            IF(i == ids+1) THEN ! second order
+              DO k=kts,ktf
+                vel = ru(i,k,j)
+                cr = vel
+                fqxl(i,k,j) = vel*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+                fqx(i,k,j) = 0.5*(ru(i,k,j)) &
+                       *(field(i,k,j)+field(i-1,k,j))
+
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+                if(cr.gt. 0) then
+                  qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i-1,k,j))
+                  qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i-1,k,j))
+                else
+                  qmax(i-1,k,j)  = amax1(qmax(i-1,k,j),field_old(i,k,j))
+                  qmin(i-1,k,j)  = amin1(qmin(i-1,k,j),field_old(i,k,j))
+                end if
+              ENDDO
+            ENDIF
+
+            IF(i == ids+2) THEN  ! third order
+              DO k=kts,ktf
+                vel = ru(i,k,j)
+                cr = vel
+                fqxl(i,k,j) = vel*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+                if(cr.gt. 0) then
+                  qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i-1,k,j))
+                  qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i-1,k,j))
+                else
+                  qmax(i-1,k,j)  = amax1(qmax(i-1,k,j),field_old(i,k,j))
+                  qmin(i-1,k,j)  = amin1(qmin(i-1,k,j),field_old(i,k,j))
+                end if
+              ENDDO
+            ENDIF
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          DO i = i_end_f+1, i_end+1
+
+            IF( i == ide-1 ) THEN ! second order flux next to the boundary
+              DO k=kts,ktf
+                vel = ru(i,k,j)
+                cr = vel
+                fqxl(i,k,j) = vel*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx(i,k,j) = 0.5*(ru(i,k,j))      &
+                       *(field(i,k,j)+field(i-1,k,j))
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+                if(cr.gt. 0) then
+                  qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i-1,k,j))
+                  qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i-1,k,j))
+                else
+                  qmax(i-1,k,j)  = amax1(qmax(i-1,k,j),field_old(i,k,j))
+                  qmin(i-1,k,j)  = amin1(qmin(i-1,k,j),field_old(i,k,j))
+                end if
+              ENDDO
+            ENDIF
+
+            IF( i == ide-2 ) THEN ! third order flux one in from the boundary
+              DO k=kts,ktf
+                vel = ru(i,k,j)
+                cr = vel
+                fqxl(i,k,j) = vel*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+                fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+                fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+                if(cr.gt. 0) then
+                  qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i-1,k,j))
+                  qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i-1,k,j))
+                else
+                  qmax(i-1,k,j)  = amax1(qmax(i-1,k,j),field_old(i,k,j))
+                  qmin(i-1,k,j)  = amin1(qmin(i-1,k,j),field_old(i,k,j))
+                end if
+              ENDDO
+            ENDIF
+          ENDDO
+        ENDIF
+
+      ENDDO  ! enddo for outer J loop
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_scalar_mono, h_order not known ',horz_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF horizontal_order_test
+
+!  pick up the rest of the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb'.
+!  first, set to index ranges
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  compute x (u) conditions for v, w, or scalar
+
+   IF( (config_flags%open_xs) .and. (its == ids) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MIN( 0.5*(ru(its,k,j)+ru(its+1,k,j)), 0. )
+         tendency(its,k,j) = tendency(its,k,j)                     &
+               - rdx*(                                             &
+                       ub*(   field_old(its+1,k,j)                 &
+                            - field_old(its  ,k,j)   ) +           &
+                       field(its,k,j)*(ru(its+1,k,j)-ru(its,k,j))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MAX( 0.5*(ru(ite-1,k,j)+ru(ite,k,j)), 0. )
+         tendency(i_end,k,j) = tendency(i_end,k,j)                   &
+               - rdx*(                                               &
+                       ub*(  field_old(i_end  ,k,j)                  &
+                           - field_old(i_end-1,k,j) ) +              &
+                       field(i_end,k,j)*(ru(ite,k,j)-ru(ite-1,k,j))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MIN( 0.5*(rv(i,k,jts)+rv(i,k,jts+1)), 0. )
+         tendency(i,k,jts) = tendency(i,k,jts)                     &
+               - rdy*(                                             &
+                       vb*(  field_old(i,k,jts+1)                  &
+                           - field_old(i,k,jts  ) ) +              &
+                       field(i,k,jts)*(rv(i,k,jts+1)-rv(i,k,jts))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ye) .and. (jte == jde)) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MAX( 0.5*(rv(i,k,jte-1)+rv(i,k,jte)), 0. )
+         tendency(i,k,j_end) = tendency(i,k,j_end)                   &
+               - rdy*(                                               &
+                       vb*(   field_old(i,k,j_end  )                 &
+                            - field_old(i,k,j_end-1) ) +             &
+                       field(i,k,j_end)*(rv(i,k,jte)-rv(i,k,jte-1))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+!-------------------- vertical advection
+
+!-- loop bounds for periodic or sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!-- loop bounds for open or specified conditions
+
+!  WCS 20090218
+!    IF(degrade_xs) i_start = its
+!    IF(degrade_xe) i_end   = MIN(ite,ide-1)
+!    IF(degrade_ys) j_start = jts
+!    IF(degrade_ye) j_end   = MIN(jte,jde-1)
+
+    IF(degrade_xs) i_start = MAX(its-1,ids)
+    IF(degrade_xe) i_end   = MIN(ite+1,ide-1)
+    IF(degrade_ys) j_start = MAX(jts-1,jds)
+    IF(degrade_ye) j_end   = MIN(jte+1,jde-1)
+
+
+    vert_order_test : IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+
+           vel = rom(i,k,j)
+           cr = -vel
+           fqzl(i,k,j) = vel*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux3(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+          if(cr.gt. 0) then
+             qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i,k-1,j))
+             qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i,k-1,j))
+          else
+             qmax(i,k-1,j)  = amax1(qmax(i,k-1,j),field_old(i,k,j))
+             qmin(i,k-1,j)  = amin1(qmin(i,k-1,j),field_old(i,k,j))
+          end if
+
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vel = rom(i,k,j)
+           cr = -vel
+           fqzl(i,k,j) = vel*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+          if(cr.gt. 0) then
+             qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i,k-1,j))
+             qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i,k-1,j))
+          else
+             qmax(i,k-1,j)  = amax1(qmax(i,k-1,j),field_old(i,k,j))
+             qmin(i,k-1,j)  = amin1(qmin(i,k-1,j),field_old(i,k,j))
+          end if
+
+           k=ktf
+           vel = rom(i,k,j)
+           cr = -vel
+           fqzl(i,k,j) = vel*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+          if(cr.gt. 0) then
+             qmax(i,k,j)  = amax1(qmax(i,k,j),field_old(i,k-1,j))
+             qmin(i,k,j)  = amin1(qmin(i,k,j),field_old(i,k-1,j))
+          else
+             qmax(i,k-1,j)  = amax1(qmax(i,k-1,j),field_old(i,k,j))
+             qmin(i,k-1,j)  = amin1(qmin(i,k-1,j),field_old(i,k,j))
+          end if
+         ENDDO
+
+      ENDDO
+
+   ELSE
+
+      WRITE (wrf_err_message,*) ' advect_scalar_mono, v_order not known ',vert_order
+      CALL wrf_error_fatal ( wrf_err_message )
+
+   ENDIF vert_order_test
+
+   IF (mono_limit) THEN
+
+! montonic filter
+
+   i_start = its-1
+   i_end   = MIN(ite,ide-1)+1
+   j_start = jts-1
+   j_end   = MIN(jte,jde-1)+1
+
+! WCS 20090218
+
+!-- loop bounds for open or specified conditions
+!
+!   IF(degrade_xs) i_start = its
+!   IF(degrade_xe) i_end   = MIN(ite,ide-1)
+!   IF(degrade_ys) j_start = jts
+!   IF(degrade_ye) j_end   = MIN(jte,jde-1)
+!
+!   IF(config_flags%specified .or. config_flags%nested) THEN
+!     IF (degrade_xs) i_start = MAX(its,ids+1)
+!     IF (degrade_xe) i_end   = MIN(ite,ide-2)
+!     IF (degrade_ys) j_start = MAX(jts,jds+1)
+!     IF (degrade_ye) j_end   = MIN(jte,jde-2)
+!   END IF
+!
+!   IF(config_flags%open_xs) THEN
+!     IF (degrade_xs) i_start = MAX(its,ids+1)
+!   END IF
+!   IF(config_flags%open_xe) THEN
+!     IF (degrade_xe) i_end   = MIN(ite,ide-2)
+!   END IF
+!   IF(config_flags%open_ys) THEN
+!     IF (degrade_ys) j_start = MAX(jts,jds+1)
+!   END IF
+!   IF(config_flags%open_ye) THEN
+!     IF (degrade_ye) j_end   = MIN(jte,jde-2)
+!   END IF
+
+   IF(degrade_xs) i_start = MAX(its-1,ids)
+   IF(degrade_xe) i_end   = MIN(ite+1,ide-1)
+   IF(degrade_ys) j_start = MAX(jts-1,jds)
+   IF(degrade_ye) j_end   = MIN(jte+1,jde-1)
+
+   IF(config_flags%specified .or. config_flags%nested) THEN
+     IF (degrade_xs) i_start = MAX(its-1,ids+1)
+     IF (degrade_xe) i_end   = MIN(ite+1,ide-2)
+     IF (degrade_ys) j_start = MAX(jts-1,jds+1)
+     IF (degrade_ye) j_end   = MIN(jte+1,jde-2)
+   END IF
+
+   IF(config_flags%open_xs) THEN
+     IF (degrade_xs) i_start = MAX(its-1,ids+1)
+   END IF
+   IF(config_flags%open_xe) THEN
+     IF (degrade_xe) i_end   = MIN(ite+1,ide-2)
+   END IF
+   IF(config_flags%open_ys) THEN
+     IF (degrade_ys) j_start = MAX(jts-1,jds+1)
+   END IF
+   IF(config_flags%open_ye) THEN
+     IF (degrade_ye) j_end   = MIN(jte+1,jde-2)
+   END IF
+
+!-- here is the limiter...
+
+   DO j=j_start, j_end
+   DO k=kts, ktf
+   DO i=i_start, i_end
+
+     ph_upwind = (mub(i,j)+mu_old(i,j))*field_old(i,k,j)        &
+                   - dt*( msft(i,j)            *(               &
+                          rdx*(fqxl(i+1,k,j)-fqxl(i,k,j)) +     &
+                          rdy*(fqyl(i,k,j+1)-fqyl(i,k,j))  )    &
+                         +           rdzw(k)*(fqzl(i,k+1,j)-fqzl(i,k,j)) )
+
+     flux_in = -dt*(  msft(i,j)             *(                   &
+                               rdx*(  min(0.,fqx (i+1,k,j))      &
+                                     -max(0.,fqx (i  ,k,j)) )    &
+                              +rdy*(  min(0.,fqy (i,k,j+1))      &
+                                     -max(0.,fqy (i,k,j  )) ) )  &
+               +           rdzw(k)*(  max(0.,fqz (i,k+1,j))      &
+                                     -min(0.,fqz (i,k  ,j)) )   )
+
+     ph_hi = mut(i,j)*qmax(i,k,j) - ph_upwind
+     IF( flux_in .gt. ph_hi ) scale_in(i,k,j) = max(0.,ph_hi/(flux_in+eps))
+
+
+     flux_out = dt*( msft(i,j)*(                    &
+                                rdx*(  max(0.,fqx (i+1,k,j))      &
+                                      -min(0.,fqx (i  ,k,j)) )    &
+                               +rdy*(  max(0.,fqy (i,k,j+1))      &
+                                      -min(0.,fqy (i,k,j  )) ) )  &
+                +           rdzw(k)*(  min(0.,fqz (i,k+1,j))      &
+                                      -max(0.,fqz (i,k  ,j)) )   )
+
+     ph_low = ph_upwind - mut(i,j)*qmin(i,k,j)
+     IF( flux_out .gt. ph_low ) scale_out(i,k,j) = max(0.,ph_low/(flux_out+eps))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j=j_start, j_end
+   DO k=kts, ktf
+   DO i=i_start, i_end+1
+       IF( fqx (i,k,j) .gt. 0.) then
+         fqx(i,k,j) = min(scale_in(i,k,j),scale_out(i-1,k,j))*fqx(i,k,j)
+       ELSE
+         fqx(i,k,j) = min(scale_out(i,k,j),scale_in(i-1,k,j))*fqx(i,k,j)
+       ENDIF
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j=j_start, j_end+1
+   DO k=kts, ktf
+   DO i=i_start, i_end
+       IF( fqy (i,k,j) .gt. 0.) then
+         fqy(i,k,j) = min(scale_in(i,k,j),scale_out(i,k,j-1))*fqy(i,k,j)
+       ELSE
+         fqy(i,k,j) = min(scale_out(i,k,j),scale_in(i,k,j-1))*fqy(i,k,j)
+       ENDIF
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j=j_start, j_end
+   DO k=kts+1, ktf
+   DO i=i_start, i_end
+       IF( fqz (i,k,j) .lt. 0.) then
+         fqz(i,k,j) = min(scale_in(i,k,j),scale_out(i,k-1,j))*fqz(i,k,j)
+       ELSE
+         fqz(i,k,j) = min(scale_out(i,k,j),scale_in(i,k-1,j))*fqz(i,k,j)
+       ENDIF
+   ENDDO
+   ENDDO
+   ENDDO
+
+   END IF
+
+! add in the mono-limited flux divergence
+! we need to fix this for open b.c set ***********
+
+  i_start = its
+  i_end   = MIN(ite,ide-1)
+  j_start = jts
+  j_end   = MIN(jte,jde-1)
+
+  DO j = j_start, j_end
+  DO k = kts, ktf
+  DO i = i_start, i_end
+
+     tendency (i,k,j) = tendency(i,k,j)                           &
+                            -rdzw(k)*( fqz (i,k+1,j)-fqz (i,k,j)  &
+                                      +fqzl(i,k+1,j)-fqzl(i,k,j))
+
+  ENDDO
+  ENDDO
+  ENDDO
+
+! x flux divergence
+!
+
+! WCS 20090218
+!  IF(degrade_xs) i_start = i_start + 1
+!  IF(degrade_xe) i_end   = i_end   - 1
+
+  IF(degrade_xs) i_start = MAX(its,ids+1)
+  IF(degrade_xe) i_end   = MIN(ite,ide-2)
+
+  DO j = j_start, j_end
+  DO k = kts, ktf
+  DO i = i_start, i_end
+
+     ! Un-"canceled" map scale factor, ADT Eq. 48
+     tendency (i,k,j) = tendency(i,k,j)                           &
+               - msft(i,j)*( rdx*( fqx (i+1,k,j)-fqx (i,k,j)     &
+                                   +fqxl(i+1,k,j)-fqxl(i,k,j))   )
+
+  ENDDO
+  ENDDO
+  ENDDO
+
+! y flux divergence
+!
+  i_start = its
+  i_end   = MIN(ite,ide-1)
+
+! WCS 20090218
+!  IF(degrade_ys) j_start = j_start + 1
+!  IF(degrade_ye) j_end   = j_end   - 1
+
+  IF(degrade_ys) j_start = MAX(jts,jds+1)
+  IF(degrade_ye) j_end   = MIN(jte,jde-2)
+
+  DO j = j_start, j_end
+  DO k = kts, ktf
+  DO i = i_start, i_end
+
+     ! Un-"canceled" map scale factor, ADT Eq. 48
+     tendency (i,k,j) = tendency(i,k,j)                           &
+               - msft(i,j)*( rdy*( fqy (i,k,j+1)-fqy (i,k,j)     &
+                                   +fqyl(i,k,j+1)-fqyl(i,k,j))   )
+
+  ENDDO
+  ENDDO
+  ENDDO
+
+END SUBROUTINE advect_scalar_mono
+
+!-----------------------------------------------------------
+
+END MODULE module_advect_em
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_advect_em.F.v2
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_advect_em.F.v2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_advect_em.F.v2	(revision 2744)
@@ -0,0 +1,7056 @@
+!WRF:MODEL_LAYER:DYNAMICS
+!
+MODULE module_advect_em
+
+  USE module_bc
+  USE module_model_constants
+  USE module_wrf_error
+
+CONTAINS
+
+
+SUBROUTINE mass_flux_divergence ( field, field_old, tendency,    &
+                                  ru, rv, rom,                   &
+                                  mut, config_flags,             &
+                                  msfu, msfv, msft,              &
+                                  fzm, fzp,                      &
+                                  rdx, rdy, rdzw,                &
+                                  ids, ide, jds, jde, kds, kde,  &
+                                  ims, ime, jms, jme, kms, kme,  &
+                                  its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field,     &
+                                                                      field_old, &
+                                                                      ru,        &
+                                                                      rv,        &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: imin, imax, jmin, jmax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw
+   REAL , DIMENSION(its:ite,kts:kte) :: vflux
+
+   LOGICAL :: specified
+
+!--------------- horizontal flux
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end
+      mrdx=msft(i,j)*rdx
+      tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5 &
+                      *(ru(i+1,k,j)*(field(i+1,k,j)+field(i  ,k,j)) &
+                       -ru(i  ,k,j)*(field(i  ,k,j)+field(i-1,k,j)))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end
+      mrdy=msft(i,j)*rdy
+      tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5 &
+                      *(rv(i,k,j+1)*(field(i,k,j+1)+field(i,k,j  )) &
+                       -rv(i,k,j  )*(field(i,k,j  )+field(i,k,j-1))) 
+   ENDDO
+   ENDDO
+   ENDDO
+   
+!----------------  vertical flux divergence
+
+
+   DO i = i_start, i_end
+      vflux(i,kts)=0.
+      vflux(i,kte)=0.
+   ENDDO
+
+   DO j = j_start, j_end
+
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+         vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+      ENDDO
+      ENDDO
+
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+      ENDDO
+      ENDDO
+
+   ENDDO
+   
+END SUBROUTINE mass_flux_divergence
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE advect_u   ( u, u_old, tendency,            &
+                        ru, rv, rom,                   &
+                        mut, config_flags,             &
+                        msfu, msfv, msft,              &
+                        fzm, fzp,                      &
+                        rdx, rdy, rdzw,                &
+                        ids, ide, jds, jde, kds, kde,  &
+                        ims, ime, jms, jme, kms, kme,  &
+                        its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: u,     &
+                                                                      u_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax, im, ip
+   INTEGER :: jp1, jp0, jtmp
+
+   INTEGER :: horz_order, vert_order
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw, dvm, dvp
+   REAL , DIMENSION(its:ite, kts:kte) :: vflux
+
+
+   REAL,  DIMENSION( its-1:ite+1, kts:kte ) :: fqx
+   REAL,  DIMENSION( its:ite, kts:kte, 2) :: fqy
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
+
+   flux4(q_im2, q_im1, q_i, q_ip1, ua) =                         &
+          ( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+
+   flux3(q_im2, q_im1, q_i, q_ip1, ua) =                         &
+            flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+            sign(1.,ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
+
+   flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =           &
+                      ( 37.*(q_i+q_im1) - 8.*(q_ip1+q_im2)       &
+                     +(q_ip2+q_im3) )/60.0
+
+   flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =           &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)     &
+            -sign(1.,ua)*(                              &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )/60.0
+
+
+   LOGICAL :: specified
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+!  set order for vertical and horzontal flux operators
+
+   horz_order = config_flags%h_mom_adv_order
+   vert_order = config_flags%v_mom_adv_order
+
+   ktf=MIN(kte,kde-1)
+
+!  begin with horizontal flux divergence
+
+   horizontal_order_test : IF( horz_order == 6 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+      degrade_xs = .true.
+      degrade_xe = .true.
+      degrade_ys = .true.
+      degrade_ye = .true.
+
+      IF( config_flags%periodic_x   .or. &
+          config_flags%symmetric_xs .or. &
+          (its > ids+2)                ) degrade_xs = .false.
+      IF( config_flags%periodic_x   .or. &
+          config_flags%symmetric_xe .or. &
+          (ite < ide-2)                ) degrade_xe = .false.
+      IF( config_flags%periodic_y   .or. &
+          config_flags%symmetric_ys .or. &
+          (jts > jds+2)                ) degrade_ys = .false.
+      IF( config_flags%periodic_y   .or. &
+          config_flags%symmetric_ye .or. &
+          (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = ite
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+        IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN  ! use full stencil
+
+           DO k=kts,ktf
+           DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+              fqy( i, k, jp1 ) = vel*flux6(                                &
+                                 u(i,k,j-3), u(i,k,j-2), u(i,k,j-1),       &
+                                 u(i,k,j  ), u(i,k,j+1), u(i,k,j+2),  vel )
+           ENDDO
+           ENDDO
+
+!  we must be close to some boundary where we need to reduce the order of the stencil
+
+        ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+           DO k=kts,ktf
+           DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))  &
+                                    *(u(i,k,j)+u(i,k,j-1))
+           ENDDO
+           ENDDO
+
+        ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+           DO k=kts,ktf
+           DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+              fqy( i, k, jp1 ) = vel*flux4(      &
+                   u(i,k,j-2),u(i,k,j-1), u(i,k,j),u(i,k,j+1),vel )
+           ENDDO
+           ENDDO
+
+        ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+           DO k=kts,ktf
+           DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))    &
+                     *(u(i,k,j)+u(i,k,j-1))
+           ENDDO
+           ENDDO
+
+        ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+           DO k=kts,ktf
+           DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+              fqy( i, k, jp1 ) = vel*flux4(     &
+                   u(i,k,j-2),u(i,k,j-1),    &
+                   u(i,k,j),u(i,k,j+1),vel )
+           ENDDO
+           ENDDO
+
+        END IF
+
+!stopped
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msfu(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+   ENDDO j_loop_y_flux_6
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = ids+3
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-1,ite)
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i,k ) = vel*flux6( u(i-3,k,j), u(i-2,k,j),  &
+                                         u(i-1,k,j), u(i  ,k,j),  &
+                                         u(i+1,k,j), u(i+2,k,j),  &
+                                         vel                     )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+!  specified uses upstream normal wind at boundaries
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+              ub = u(i-1,k,j)
+              IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i,k,j)+ub)
+            ENDDO
+          END IF
+
+          i = ids+2
+          DO k=kts,ktf
+            vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+            fqx( i, k  ) = vel*flux4( u(i-2,k,j), u(i-1,k,j),  &
+                                           u(i  ,k,j), u(i+1,k,j),  &
+                                           vel                     )
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-1 ) THEN ! second order flux next to the boundary
+            i = ide
+            DO k=kts,ktf
+              ub = u(i,k,j)
+              IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i-1,k,j)+ub)
+            ENDDO
+          ENDIF
+
+          DO k=kts,ktf
+          i = ide-1
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i,k ) = vel*flux4( u(i-2,k,j), u(i-1,k,j),  &
+                                         u(i  ,k,j), u(i+1,k,j),  &
+                                         vel                     )
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msfu(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 5 ) THEN
+
+!  5th order horizontal flux calculation
+!  This code is EXACTLY the same as the 6th order code
+!  EXCEPT the 5th order and 3rd operators are used in
+!  place of the 6th and 4th order operators
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = ite
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN  ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+          fqy( i, k, jp1 ) = vel*flux5(               &
+                  u(i,k,j-3), u(i,k,j-2), u(i,k,j-1),       &
+                  u(i,k,j  ), u(i,k,j+1), u(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+!  we must be close to some boundary where we need to reduce the order of the stencil
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))  &
+                                     *(u(i,k,j)+u(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+              fqy( i, k, jp1 ) = vel*flux3(      &
+                   u(i,k,j-2),u(i,k,j-1), u(i,k,j),u(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))    &
+                     *(u(i,k,j)+u(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+              fqy( i, k, jp1 ) = vel*flux3(     &
+                   u(i,k,j-2),u(i,k,j-1),    &
+                   u(i,k,j),u(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+      END IF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msfu(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+   ENDDO j_loop_y_flux_5
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = ids+3
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-1,ite)
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i,k ) = vel*flux5( u(i-3,k,j), u(i-2,k,j),  &
+                                         u(i-1,k,j), u(i  ,k,j),  &
+                                         u(i+1,k,j), u(i+2,k,j),  &
+                                         vel                     )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+!  specified uses upstream normal wind at boundaries
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+              ub = u(i-1,k,j)
+              IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i,k,j)+ub)
+            ENDDO
+          END IF
+
+          i = ids+2
+          DO k=kts,ktf
+            vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+            fqx( i, k  ) = vel*flux3( u(i-2,k,j), u(i-1,k,j),  &
+                                           u(i  ,k,j), u(i+1,k,j),  &
+                                           vel                     )
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-1 ) THEN ! second order flux next to the boundary
+            i = ide
+            DO k=kts,ktf
+              ub = u(i,k,j)
+              IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i-1,k,j)+ub)
+            ENDDO
+          ENDIF
+
+          DO k=kts,ktf
+          i = ide-1
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i,k ) = vel*flux3( u(i-2,k,j), u(i-1,k,j),  &
+                                         u(i  ,k,j), u(i+1,k,j),  &
+                                         vel                     )
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msfu(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 4 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-1)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!--------------- x - advection first
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-1
+        i_end_f = ide-1
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i, k ) = vel*flux4( u(i-2,k,j), u(i-1,k,j),      &
+                                   u(i  ,k,j), u(i+1,k,j), vel )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+!  specified uses upstream normal wind at boundaries
+
+        IF( degrade_xs ) THEN
+          i = i_start
+          DO k=kts,ktf
+              ub = u(i-1,k,j)
+              IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i,k,j)+ub)
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          i = i_end+1
+          DO k=kts,ktf
+              ub = u(i,k,j)
+              IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i-1,k,j)+ub)
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msfu(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+!  y flux divergence
+
+      i_start = its
+      i_end   = ite
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!CJM these may not work with tiling because they define j_start and end in terms of domain dim
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+!  j flux loop for v flux of u momentum
+
+     jp1 = 2
+     jp0 = 1
+
+   DO j = j_start, j_end+1
+
+     IF ( (j < j_start_f) .and. degrade_ys) THEN
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         fqy(i, k, jp1) = 0.25*(rv(i,k,j_start)+rv(i-1,k,j_start))  &
+               *(u(i,k,j_start)+u(i,k,j_start-1))
+       ENDDO
+       ENDDO
+     ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         fqy(i, k, jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))    &
+                *(u(i,k,j_end+1)+u(i,k,j_end))
+       ENDDO
+       ENDDO
+     ELSE
+!  3rd or 4th order flux
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+         fqy( i, k, jp1 ) = vel*flux4( u(i,k,j-2), u(i,k,j-1),  &
+                                       u(i,k,j  ), u(i,k,j+1),  &
+                                            vel                )
+       ENDDO
+       ENDDO
+
+     END IF
+
+     IF (j > j_start) THEN
+
+!  y flux-divergence into tendency
+
+       DO k=kts,ktf
+       DO i = i_start, i_end
+          mrdy=msfu(i,j-1)*rdy
+          tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+       ENDDO
+       ENDDO
+
+     END IF
+
+     jtmp = jp1
+     jp1 = jp0
+     jp0 = jtmp
+
+  ENDDO
+
+  ELSE IF ( horz_order == 3 ) THEN
+
+!  As with the 5th and 6th order flux chioces, the 3rd and 4th order
+!  code is EXACTLY the same EXCEPT for the flux operator.
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-1)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!--------------- x - advection first
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-1
+        i_end_f = ide-1
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
+          fqx( i, k ) = vel*flux3( u(i-2,k,j), u(i-1,k,j),      &
+                                   u(i  ,k,j), u(i+1,k,j), vel )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+!  specified uses upstream normal wind at boundaries
+
+        IF( degrade_xs ) THEN
+          i = i_start
+          DO k=kts,ktf
+              ub = u(i-1,k,j)
+              IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i,k,j)+ub)
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          i = i_end+1
+          DO k=kts,ktf
+              ub = u(i,k,j)
+              IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
+              fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
+                     *(u(i-1,k,j)+ub)
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+          mrdx=msfu(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+      ENDDO
+
+!  y flux divergence
+
+      i_start = its
+      i_end   = ite
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!CJM these may not work with tiling because they define j_start and end in terms of domain dim
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+!  j flux loop for v flux of u momentum
+
+     jp1 = 2
+     jp0 = 1
+
+   DO j = j_start, j_end+1
+
+     IF ( (j < j_start_f) .and. degrade_ys) THEN
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         fqy(i, k, jp1) = 0.25*(rv(i,k,j_start)+rv(i-1,k,j_start))  &
+               *(u(i,k,j_start)+u(i,k,j_start-1))
+       ENDDO
+       ENDDO
+     ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         fqy(i, k, jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))    &
+                *(u(i,k,j_end+1)+u(i,k,j_end))
+       ENDDO
+       ENDDO
+     ELSE
+!  3rd or 4th order flux
+       DO k = kts, ktf
+       DO i = i_start, i_end
+         vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
+         fqy( i, k, jp1 ) = vel*flux3( u(i,k,j-2), u(i,k,j-1),  &
+                                       u(i,k,j  ), u(i,k,j+1),  &
+                                            vel                )
+       ENDDO
+       ENDDO
+
+     END IF
+
+     IF (j > j_start) THEN
+
+!  y flux-divergence into tendency
+
+       DO k=kts,ktf
+       DO i = i_start, i_end
+          mrdy=msfu(i,j-1)*rdy
+          tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+       ENDDO
+       ENDDO
+
+     END IF
+
+     jtmp = jp1
+     jp1 = jp0
+     jp0 = jtmp
+
+  ENDDO
+
+  ELSE IF ( horz_order == 2 ) THEN
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe ) i_end   = MIN(ide-1,ite)
+      IF ( specified ) i_start = MAX(ids+2,its)
+      IF ( specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+         mrdx=msfu(i,j)*rdx
+         tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
+                *((ru(i+1,k,j)+ru(i,k,j))*(u(i+1,k,j)+u(i,k,j)) &
+                -(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+u(i-1,k,j)))
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF ( specified .AND. its .LE. ids+1 .AND. .NOT. config_flags%periodic_x ) THEN
+        DO j = j_start, j_end
+        DO k=kts,ktf
+           i = ids+1
+           mrdx=msfu(i,j)*rdx
+           ub = u(i-1,k,j)
+           IF (u(i,k,j) .LT. 0.) ub = u(i,k,j)
+           tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
+                  *((ru(i+1,k,j)+ru(i,k,j))*(u(i+1,k,j)+u(i,k,j)) &
+                  -(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+ub))
+        ENDDO
+        ENDDO
+      ENDIF
+      IF ( specified .AND. ite .GE. ide-1 .AND. .NOT. config_flags%periodic_x ) THEN
+        DO j = j_start, j_end
+        DO k=kts,ktf
+           i = ide-1
+           mrdx=msfu(i,j)*rdx
+           ub = u(i+1,k,j)
+           IF (u(i,k,j) .GT. 0.) ub = u(i,k,j)
+           tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
+                  *((ru(i+1,k,j)+ru(i,k,j))*(ub+u(i,k,j)) &
+                  -(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+u(i-1,k,j)))
+        ENDDO
+        ENDDO
+      ENDIF
+
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+         mrdy=msfu(i,j)*rdy
+            tendency(i,k,j)=tendency(i,k,j)-mrdy*0.25 &
+                *((rv(i,k,j+1)+rv(i-1,k,j+1))*(u(i,k,j+1)+u(i,k,j)) &
+                 -(rv(i,k,j)+rv(i-1,k,j))*(u(i,k,j)+u(i,k,j-1)))
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_u_6a:  h_order not known ',horz_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF horizontal_order_test
+
+!  radiative lateral boundary condition in x for normal velocity (u)
+
+      IF ( (config_flags%open_xs) .and. its == ids ) THEN
+
+        j_start = jts
+        j_end   = MIN(jte,jde-1)
+
+        DO j = j_start, j_end
+        DO k = kts, ktf
+          ub = MIN(ru(its,k,j)-cb*mut(its,j), 0.)
+          tendency(its,k,j) = tendency(its,k,j)                    &
+                      - rdx*ub*(u_old(its+1,k,j) - u_old(its,k,j))
+        ENDDO
+        ENDDO
+
+      ENDIF
+
+      IF ( (config_flags%open_xe) .and. ite == ide ) THEN
+
+        j_start = jts
+        j_end   = MIN(jte,jde-1)
+
+        DO j = j_start, j_end
+        DO k = kts, ktf
+          ub = MAX(ru(ite,k,j)+cb*mut(ite-1,j), 0.)
+          tendency(ite,k,j) = tendency(ite,k,j)                    &
+                      - rdx*ub*(u_old(ite,k,j) - u_old(ite-1,k,j))
+        ENDDO
+        ENDDO
+
+      ENDIF
+
+!  pick up the rest of the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb')
+!  first, set to index ranges
+
+      i_start = its
+      i_end   = MIN(ite,ide)
+      imin    = ids
+      imax    = ide-1
+
+      IF (config_flags%open_xs) THEN
+        i_start = MAX(ids+1, its)
+        imin = ids
+      ENDIF
+      IF (config_flags%open_xe) THEN
+        i_end = MIN(ite,ide-1)
+        imax = ide-1
+      ENDIF
+
+   IF( (config_flags%open_ys) .and. (jts == jds)) THEN
+
+      DO i = i_start, i_end
+
+         mrdy=msfu(i,jts)*rdy
+         ip = MIN( imax, i   )
+         im = MAX( imin, i-1 )
+
+         DO k=kts,ktf
+
+          vw = 0.5*(rv(ip,k,jts)+rv(im,k,jts))
+          vb = MIN( vw, 0. )
+          dvm =  rv(ip,k,jts+1)-rv(ip,k,jts)
+          dvp =  rv(im,k,jts+1)-rv(im,k,jts)
+          tendency(i,k,jts)=tendency(i,k,jts)-mrdy*(                &
+                            vb*(u_old(i,k,jts+1)-u_old(i,k,jts))    &
+                           +0.5*u(i,k,jts)*(dvm+dvp))
+         ENDDO
+      ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ye) .and. (jte == jde)) THEN
+
+      DO i = i_start, i_end
+
+         mrdy=msfu(i,jte-1)*rdy
+         ip = MIN( imax, i   )
+         im = MAX( imin, i-1 )
+
+         DO k=kts,ktf
+
+          vw = 0.5*(rv(ip,k,jte)+rv(im,k,jte))
+          vb = MAX( vw, 0. )
+          dvm =  rv(ip,k,jte)-rv(ip,k,jte-1)
+          dvp =  rv(im,k,jte)-rv(im,k,jte-1)
+          tendency(i,k,jte-1)=tendency(i,k,jte-1)-mrdy*(              &
+                              vb*(u_old(i,k,jte-1)-u_old(i,k,jte-2))  &
+                             +0.5*u(i,k,jte-1)*(dvm+dvp))
+         ENDDO
+      ENDDO
+
+   ENDIF
+
+!-------------------- vertical advection
+
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = min(jte,jde-1)
+
+!   IF ( config_flags%open_xs ) i_start = MAX(ids+1,its)
+!   IF ( config_flags%open_xe ) i_end   = MIN(ide-1,ite)
+
+   IF ( config_flags%open_ys .or. specified ) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_ye .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+   DO i = i_start, i_end
+     vflux(i,kts)=0.
+     vflux(i,kte)=0.
+   ENDDO
+
+   vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
+           vflux(i,k) = vel*flux6(                     &
+                   u(i,k-3,j), u(i,k-2,j), u(i,k-1,j),       &
+                   u(i,k  ,j), u(i,k+1,j), u(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j))  &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i-1,k,j)) 
+           vflux(i,k) = vel*flux4(       &
+                   u(i,k-2,j), u(i,k-1,j),   &
+                   u(i,k  ,j), u(i,k+1,j), -vel )
+           k = ktf-1
+           vel=0.5*(rom(i,k,j)+rom(i-1,k,j)) 
+           vflux(i,k) = vel*flux4(       &
+                   u(i,k-2,j), u(i,k-1,j),   &
+                   u(i,k  ,j), u(i,k+1,j), -vel )
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+
+         ENDDO
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+      ENDDO
+
+    ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
+           vflux(i,k) = vel*flux5(                     &
+                   u(i,k-3,j), u(i,k-2,j), u(i,k-1,j),       &
+                   u(i,k  ,j), u(i,k+1,j), u(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j))  &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i-1,k,j)) 
+           vflux(i,k) = vel*flux3(       &
+                   u(i,k-2,j), u(i,k-1,j),   &
+                   u(i,k  ,j), u(i,k+1,j), -vel )
+           k = ktf-1
+           vel=0.5*(rom(i,k,j)+rom(i-1,k,j)) 
+           vflux(i,k) = vel*flux3(       &
+                   u(i,k-2,j), u(i,k-1,j),   &
+                   u(i,k  ,j), u(i,k+1,j), -vel )
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+
+         ENDDO
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+      ENDDO
+
+    ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
+           vflux(i,k) = vel*flux4(               &
+                   u(i,k-2,j), u(i,k-1,j),       &
+                   u(i,k  ,j), u(i,k+1,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j))  &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+
+         ENDDO
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+      ENDDO
+
+    ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
+           vflux(i,k) = vel*flux3(               &
+                   u(i,k-2,j), u(i,k-1,j),       &
+                   u(i,k  ,j), u(i,k+1,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j))  &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                   *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+
+         ENDDO
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+      ENDDO
+
+    ELSE IF (vert_order == 2) THEN    
+
+      DO j = j_start, j_end
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+               vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
+                                *(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
+         ENDDO
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+               tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_u_6a: v_order not known ',vert_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF vert_order_test
+
+END SUBROUTINE advect_u
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE advect_v   ( v, v_old, tendency,            &
+                        ru, rv, rom,                   &
+                        mut, config_flags,             &
+                        msfu, msfv, msft,              &
+                        fzm, fzp,                      &
+                        rdx, rdy, rdzw,                &
+                        ids, ide, jds, jde, kds, kde,  &
+                        ims, ime, jms, jme, kms, kme,  &
+                        its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: v,     &
+                                                                      v_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw, dup, dum
+   REAL , DIMENSION(its:ite, kts:kte) :: vflux
+
+
+   REAL,  DIMENSION( its:ite+1, kts:kte ) :: fqx
+   REAL,  DIMENSION( its:ite, kts:kte, 2 ) :: fqy
+
+   INTEGER :: horz_order
+   INTEGER :: vert_order
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+   INTEGER :: jp1, jp0, jtmp
+
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
+
+   flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+          ( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+
+   flux3(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+           flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+           sign(1.,ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
+
+   flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+                      ( 37.*(q_i+q_im1) - 8.*(q_ip1+q_im2)   &
+                     +(q_ip2+q_im3) )/60.0
+
+   flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)    &
+            -sign(1.,ua)*(                             &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )/60.0
+
+
+
+   LOGICAL :: specified
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+! set order for the advection schemes
+
+   ktf=MIN(kte,kde-1)
+   horz_order = config_flags%h_mom_adv_order
+   vert_order = config_flags%v_mom_adv_order
+
+
+!  here is the choice of flux operators
+
+
+   horizontal_order_test : IF( horz_order == 6 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+      degrade_xs = .true.
+      degrade_xe = .true.
+      degrade_ys = .true.
+      degrade_ye = .true.
+
+      IF( config_flags%periodic_x   .or. &
+          config_flags%symmetric_xs .or. &
+          (its > ids+2)                ) degrade_xs = .false.
+      IF( config_flags%periodic_x   .or. &
+          config_flags%symmetric_xe .or. &
+          (ite < ide-3)                ) degrade_xe = .false.
+      IF( config_flags%periodic_y   .or. &
+          config_flags%symmetric_ys .or. &
+          (jts > jds+2)                ) degrade_ys = .false.
+      IF( config_flags%periodic_y   .or. &
+          config_flags%symmetric_ye .or. &
+          (jte < jde-2)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+         j_start = MAX(jts,jds+1)
+         j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+         j_end = MIN(jte,jde-1)
+         j_end_f = jde-2
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+      jp1 = 2
+      jp0 = 1
+
+      j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+         IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+               vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+               fqy( i, k, jp1 ) = vel*flux6(                                &
+                                  v(i,k,j-3), v(i,k,j-2), v(i,k,j-1),       &
+                                  v(i,k,j  ), v(i,k,j+1), v(i,k,j+2),  vel )
+            ENDDO
+            ENDDO
+
+!  we must be close to some boundary where we need to reduce the order of the stencil
+!  specified uses upstream normal wind at boundaries
+
+         ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vb = v(i,k,j-1)
+                IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))  &
+                                 *(v(i,k,j)+vb)
+            ENDDO
+            ENDDO
+
+         ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+                fqy( i, k, jp1 ) = vel*flux4(      &
+                                   v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+
+         ELSE IF ( j == jde ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vb = v(i,k,j)
+                IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))    &
+                                 *(vb+v(i,k,j-1))
+            ENDDO
+            ENDDO
+
+         ELSE IF ( j == jde-1 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+                fqy( i, k, jp1 ) = vel*flux4(     &
+                                   v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+         END IF
+
+!  y flux-divergence into tendency
+
+         IF(j > j_start) THEN
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+               mrdy=msfv(i,j-1)*rdy
+               tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+            ENDDO
+            ENDDO
+
+         ENDIF
+
+         jtmp = jp1
+         jp1 = jp0
+         jp0 = jtmp
+
+      ENDDO j_loop_y_flux_6
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = jte
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+         i_start = MAX(ids+1,its)
+         i_start_f = i_start+2
+      ENDIF
+
+      IF(degrade_xe) then
+         i_end = MIN(ide-2,ite)
+         i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+         DO k=kts,ktf
+         DO i = i_start_f, i_end_f
+            vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+            fqx( i, k ) = vel*flux6( v(i-3,k,j), v(i-2,k,j),  &
+                                     v(i-1,k,j), v(i  ,k,j),  &
+                                     v(i+1,k,j), v(i+2,k,j),  &
+                                     vel                     )
+         ENDDO
+         ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+         IF( degrade_xs ) THEN
+
+            IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+               i = ids+1
+               DO k=kts,ktf
+                  fqx(i,k) = 0.25*(ru(i,k,j)+ru(i,k,j-1)) &
+                                 *(v(i,k,j)+v(i-1,k,j))
+               ENDDO
+            ENDIF
+
+            i = ids+2
+            DO k=kts,ktf
+               vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+               fqx( i,k ) = vel*flux4( v(i-2,k,j), v(i-1,k,j),  &
+                                       v(i  ,k,j), v(i+1,k,j),  &
+                                       vel                     )
+            ENDDO
+
+         ENDIF
+
+         IF( degrade_xe ) THEN
+
+            IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+               i = ide-1
+               DO k=kts,ktf
+                  fqx(i,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))      &
+                                 *(v(i_end+1,k,j)+v(i_end,k,j))
+               ENDDO
+            ENDIF
+
+            i = ide-2
+            DO k=kts,ktf
+               vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+               fqx( i,k ) = vel*flux4( v(i-2,k,j), v(i-1,k,j),  &
+                                       v(i  ,k,j), v(i+1,k,j),  &
+                                       vel                     )
+            ENDDO
+
+         ENDIF
+
+!  x flux-divergence into tendency
+
+         DO k=kts,ktf
+            DO i = i_start, i_end
+            mrdx=msfv(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+         ENDDO
+      ENDDO
+
+   ENDDO
+
+   ELSE IF( horz_order == 5 ) THEN
+
+!  5th order horizontal flux calculation
+!  This code is EXACTLY the same as the 6th order code
+!  EXCEPT the 5th order and 3rd operators are used in
+!  place of the 6th and 4th order operators
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-1)
+        j_end_f = jde-2
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+          fqy( i, k, jp1 ) = vel*flux5(               &
+                  v(i,k,j-3), v(i,k,j-2), v(i,k,j-1),       &
+                  v(i,k,j  ), v(i,k,j+1), v(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+!  we must be close to some boundary where we need to reduce the order of the stencil
+!  specified uses upstream normal wind at boundaries
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vb = v(i,k,j-1)
+                IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))  &
+                                 *(v(i,k,j)+vb)
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+              fqy( i, k, jp1 ) = vel*flux3(      &
+                   v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+
+     ELSE IF ( j == jde ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+                vb = v(i,k,j)
+                IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))    &
+                                 *(vb+v(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+              fqy( i, k, jp1 ) = vel*flux3(     &
+                   v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+      END IF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msfv(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+   ENDDO j_loop_y_flux_5
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = jte
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+2
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+          fqx( i, k ) = vel*flux5( v(i-3,k,j), v(i-2,k,j),  &
+                                         v(i-1,k,j), v(i  ,k,j),  &
+                                         v(i+1,k,j), v(i+2,k,j),  &
+                                         vel                     )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+            fqx(i,k) = 0.25*(ru(i,k,j)+ru(i,k,j-1)) &
+                   *(v(i,k,j)+v(i-1,k,j))
+            ENDDO
+         ENDIF
+
+          i = ids+2
+          DO k=kts,ktf
+            vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+            fqx( i,k ) = vel*flux3( v(i-2,k,j), v(i-1,k,j),  &
+                                          v(i  ,k,j), v(i+1,k,j),  &
+                                          vel                     )
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts,ktf
+              fqx(i,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))      &
+                              *(v(i_end+1,k,j)+v(i_end,k,j))
+            ENDDO
+          ENDIF
+
+          i = ide-2
+          DO k=kts,ktf
+          vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+          fqx( i,k ) = vel*flux3( v(i-2,k,j), v(i-1,k,j),  &
+                                        v(i  ,k,j), v(i+1,k,j),  &
+                                        vel                     )
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msfv(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 4 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-1)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!CJM May not work with tiling because defined in terms of domain dims
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-1
+        j_end_f = jde-1
+      ENDIF
+
+!  compute fluxes
+!  specified uses upstream normal wind at boundaries
+
+    jp0 = 1
+    jp1 = 2
+
+    DO j = j_start, j_end+1
+
+      IF ((j == j_start) .and. degrade_ys) THEN
+        DO k = kts,ktf
+        DO i = i_start, i_end
+                vb = v(i,k,j-1)
+                IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))  &
+                                 *(v(i,k,j)+vb)
+        ENDDO
+        ENDDO
+      ELSE IF ((j == j_end+1) .and. degrade_ye) THEN
+        DO k = kts, ktf
+        DO i = i_start, i_end
+                vb = v(i,k,j)
+                IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))    &
+                                 *(vb+v(i,k,j-1))
+        ENDDO
+        ENDDO
+      ELSE
+        DO k = kts, ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+          fqy( i,k,jp1 ) = vel*flux4( v(i,k,j-2), v(i,k,j-1),  &
+                                     v(i,k,j  ), v(i,k,j+1),  &
+                                      vel                        )
+        ENDDO
+        ENDDO
+      END IF
+
+      IF( j > j_start) THEN
+        DO k = kts, ktf
+        DO i = i_start, i_end
+            mrdy=msfv(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+        ENDDO
+        ENDDO
+      END IF
+
+      jtmp = jp1
+      jp1 = jp0
+      jp0 = jtmp
+
+   ENDDO
+
+!  next, x - flux divergence
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = jte
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  3rd or 4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+          fqx( i, k ) = vel*flux4( v(i-2,k,j), v(i-1,k,j),  &
+                                  v(i  ,k,j), v(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts,ktf
+            fqx(i_start,k) = 0.25*(ru(i_start,k,j)+ru(i_start,k,j-1)) &
+                   *(v(i_start,k,j)+v(i_start-1,k,j))
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts,ktf
+            fqx(i_end+1,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))      &
+                   *(v(i_end+1,k,j)+v(i_end,k,j))
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+            mrdx=msfv(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 3 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-1)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!CJM May not work with tiling because defined in terms of domain dims
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-1
+        j_end_f = jde-1
+      ENDIF
+
+!  compute fluxes
+!  specified uses upstream normal wind at boundaries
+
+    jp0 = 1
+    jp1 = 2
+
+    DO j = j_start, j_end+1
+
+      IF ((j == j_start) .and. degrade_ys) THEN
+        DO k = kts,ktf
+        DO i = i_start, i_end
+                vb = v(i,k,j-1)
+                IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))  &
+                                 *(v(i,k,j)+vb)
+        ENDDO
+        ENDDO
+      ELSE IF ((j == j_end+1) .and. degrade_ye) THEN
+        DO k = kts, ktf
+        DO i = i_start, i_end
+                vb = v(i,k,j)
+                IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
+                fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))    &
+                                 *(vb+v(i,k,j-1))
+        ENDDO
+        ENDDO
+      ELSE
+        DO k = kts, ktf
+        DO i = i_start, i_end
+          vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
+          fqy( i,k,jp1 ) = vel*flux3( v(i,k,j-2), v(i,k,j-1),  &
+                                     v(i,k,j  ), v(i,k,j+1),  &
+                                      vel                        )
+        ENDDO
+        ENDDO
+      END IF
+
+      IF( j > j_start) THEN
+        DO k = kts, ktf
+        DO i = i_start, i_end
+            mrdy=msfv(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+        ENDDO
+        ENDDO
+      END IF
+
+      jtmp = jp1
+      jp1 = jp0
+      jp0 = jtmp
+
+   ENDDO
+
+!  next, x - flux divergence
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = jte
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  3rd or 4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
+          fqx( i, k ) = vel*flux3( v(i-2,k,j), v(i-1,k,j),  &
+                                  v(i  ,k,j), v(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts,ktf
+            fqx(i_start,k) = 0.25*(ru(i_start,k,j)+ru(i_start,k,j-1)) &
+                   *(v(i_start,k,j)+v(i_start-1,k,j))
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts,ktf
+            fqx(i_end+1,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))      &
+                   *(v(i_end+1,k,j)+v(i_end,k,j))
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+            mrdx=msfv(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE IF( horz_order == 2 ) THEN
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+      IF ( config_flags%open_ys ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye ) j_end   = MIN(jde-1,jte)
+      IF ( specified ) j_start = MAX(jds+2,jts)
+      IF ( specified ) j_end   = MIN(jde-2,jte)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mrdy=msfv(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j) -mrdy*0.25 &
+                            *((rv(i,k,j+1)+rv(i,k,j  ))*(v(i,k,j+1)+v(i,k,j  )) &
+                             -(rv(i,k,j  )+rv(i,k,j-1))*(v(i,k,j  )+v(i,k,j-1)))
+
+      ENDDO
+      ENDDO
+      ENDDO
+!  specified uses upstream normal wind at boundaries
+
+      IF ( specified .AND. jts .LE. jds+1 ) THEN
+        j = jds+1
+        DO k=kts,ktf
+        DO i = i_start, i_end
+           mrdy=msfv(i,j)*rdy
+           vb = v(i,k,j-1)
+           IF (v(i,k,j) .LT. 0.) vb = v(i,k,j)
+
+              tendency(i,k,j)=tendency(i,k,j) -mrdy*0.25 &
+                              *((rv(i,k,j+1)+rv(i,k,j  ))*(v(i,k,j+1)+v(i,k,j  )) &
+                               -(rv(i,k,j  )+rv(i,k,j-1))*(v(i,k,j  )+vb))
+
+        ENDDO
+        ENDDO
+      ENDIF
+
+      IF ( specified .AND. jte .GE. jde-1 ) THEN
+        j = jde-1
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+           mrdy=msfv(i,j)*rdy
+           vb = v(i,k,j+1)
+           IF (v(i,k,j) .GT. 0.) vb = v(i,k,j)
+
+              tendency(i,k,j)=tendency(i,k,j) -mrdy*0.25 &
+                              *((rv(i,k,j+1)+rv(i,k,j  ))*(vb+v(i,k,j  )) &
+                               -(rv(i,k,j  )+rv(i,k,j-1))*(v(i,k,j  )+v(i,k,j-1)))
+
+        ENDDO
+        ENDDO
+      ENDIF
+
+      IF ( .NOT. config_flags%periodic_x ) THEN
+        IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+        IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      ENDIF
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mrdx=msfv(i,j)*rdx
+
+            tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
+                            *((ru(i+1,k,j)+ru(i+1,k,j-1))*(v(i+1,k,j)+v(i  ,k,j)) &
+                             -(ru(i  ,k,j)+ru(i  ,k,j-1))*(v(i  ,k,j)+v(i-1,k,j)))
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+  ELSE
+
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_v_6a: h_order not known ',horz_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF horizontal_order_test
+
+!  radiative lateral boundary condition in y for normal velocity (v)
+
+      IF ( (config_flags%open_ys) .and. jts == jds ) THEN
+
+        i_start = its
+        i_end   = MIN(ite,ide-1)
+
+        DO i = i_start, i_end
+        DO k = kts, ktf
+          vb = MIN(rv(i,k,jts)-cb*mut(i,jts), 0.)
+          tendency(i,k,jts) = tendency(i,k,jts)                    &
+                      - rdy*vb*(v_old(i,k,jts+1) - v_old(i,k,jts))
+        ENDDO
+        ENDDO
+
+      ENDIF
+
+      IF ( (config_flags%open_ye) .and. jte == jde ) THEN
+
+        i_start = its
+        i_end   = MIN(ite,ide-1)
+
+        DO i = i_start, i_end
+        DO k = kts, ktf
+          vb = MAX(rv(i,k,jte)+cb*mut(i,jte-1), 0.)
+          tendency(i,k,jte) = tendency(i,k,jte)                    &
+                      - rdy*vb*(v_old(i,k,jte) - v_old(i,k,jte-1))
+        ENDDO
+        ENDDO
+
+      ENDIF
+
+!  pick up the rest of the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb'.
+!  first, set to index ranges
+
+      j_start = jts
+      j_end   = MIN(jte,jde)
+
+      jmin    = jds
+      jmax    = jde-1
+
+      IF (config_flags%open_ys) THEN
+          j_start = MAX(jds+1, jts)
+          jmin = jds
+      ENDIF
+      IF (config_flags%open_ye) THEN
+          j_end = MIN(jte,jde-1)
+          jmax = jde-1
+      ENDIF
+
+!  compute x (u) conditions for v, w, or scalar
+
+   IF( (config_flags%open_xs) .and. (its == ids)) THEN
+
+      DO j = j_start, j_end
+
+         mrdx=msfv(its,j)*rdx
+         jp = MIN( jmax, j   )
+         jm = MAX( jmin, j-1 )
+
+         DO k=kts,ktf
+
+          uw = 0.5*(ru(its,k,jp)+ru(its,k,jm))
+          ub = MIN( uw, 0. )
+          dup =  ru(its+1,k,jp)-ru(its,k,jp)
+          dum =  ru(its+1,k,jm)-ru(its,k,jm)
+          tendency(its,k,j)=tendency(its,k,j)-mrdx*(               &
+                            ub*(v_old(its+1,k,j)-v_old(its,k,j))   &
+                           +0.5*v(its,k,j)*(dup+dum))
+         ENDDO
+      ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
+      DO j = j_start, j_end
+
+         mrdx=msfv(ite-1,j)*rdx
+         jp = MIN( jmax, j   )
+         jm = MAX( jmin, j-1 )
+
+         DO k=kts,ktf
+
+          uw = 0.5*(ru(ite,k,jp)+ru(ite,k,jm))
+          ub = MAX( uw, 0. )
+          dup = ru(ite,k,jp)-ru(ite-1,k,jp)
+          dum = ru(ite,k,jm)-ru(ite-1,k,jm)
+
+!          tendency(ite-1,k,j)=tendency(ite-1,k,j)-mrdx*(              &
+!                            ub*(v_old(ite-1,k,j)-v_old(ite-2,k,j))    &
+!                           +0.5*v(ite-1,k,j)*                         &
+!                                  ( ru(ite,k,jp)-ru(ite-1,k,jp)       &
+!                                   +ru(ite,k,jm)-ru(ite-1,k,jm))     )
+          tendency(ite-1,k,j)=tendency(ite-1,k,j)-mrdx*(              &
+                            ub*(v_old(ite-1,k,j)-v_old(ite-2,k,j))    &
+                           +0.5*v(ite-1,k,j)*(dup+dum))
+
+         ENDDO
+      ENDDO
+
+   ENDIF
+
+!-------------------- vertical advection
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+      DO i = i_start, i_end
+         vflux(i,kts)=0.
+         vflux(i,kte)=0.
+      ENDDO
+
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+    vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
+           vflux(i,k) = vel*flux6(                       &
+                   v(i,k-3,j), v(i,k-2,j), v(i,k-1,j),       &
+                   v(i,k  ,j), v(i,k+1,j), v(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1))  &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1)) 
+           vflux(i,k) = vel*flux4(       &
+                   v(i,k-2,j), v(i,k-1,j),   &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+           k = ktf-1
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1)) 
+           vflux(i,k) = vel*flux4(       &
+                   v(i,k-2,j), v(i,k-1,j),   &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
+           vflux(i,k) = vel*flux5(                       &
+                   v(i,k-3,j), v(i,k-2,j), v(i,k-1,j),       &
+                   v(i,k  ,j), v(i,k+1,j), v(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1))  &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1)) 
+           vflux(i,k) = vel*flux3(       &
+                   v(i,k-2,j), v(i,k-1,j),   &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+           k = ktf-1
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1)) 
+           vflux(i,k) = vel*flux3(       &
+                   v(i,k-2,j), v(i,k-1,j),   &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
+           vflux(i,k) = vel*flux4(               &
+                   v(i,k-2,j), v(i,k-1,j),       &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1))  &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
+           vflux(i,k) = vel*flux3(               &
+                   v(i,k-2,j), v(i,k-1,j),       &
+                   v(i,k  ,j), v(i,k+1,j), -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+           k=kts+1
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1))  &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+           k=ktf
+           vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                   *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+
+         ENDDO
+
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+
+    ELSE IF (vert_order == 2) THEN    
+
+   DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+            vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
+                                    *(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
+      ENDDO
+      ENDDO
+
+      DO k=kts,ktf
+      DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+
+      ENDDO
+      ENDDO
+   ENDDO
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_v_6a: v_order not known ',vert_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF vert_order_test
+
+END SUBROUTINE advect_v
+
+!-------------------------------------------------------------------
+
+SUBROUTINE advect_scalar   ( field, field_old, tendency,    &
+                             ru, rv, rom,                   &
+                             mut, config_flags,             &
+                             msfu, msfv, msft,              &
+                             fzm, fzp,                      &
+                             rdx, rdy, rdzw,                &
+                             ids, ide, jds, jde, kds, kde,  &
+                             ims, ime, jms, jme, kms, kme,  &
+                             its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field,     &
+                                                                      field_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw
+   REAL , DIMENSION(its:ite, kts:kte) :: vflux
+
+
+   REAL,  DIMENSION( its:ite+1, kts:kte  ) :: fqx
+   REAL,  DIMENSION( its:ite, kts:kte, 2 ) :: fqy
+
+   INTEGER :: horz_order, vert_order
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+   INTEGER :: jp1, jp0, jtmp
+
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
+
+      flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+          ( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+
+      flux3(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+           flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+           sign(1.,ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
+
+      flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+          ( 37.*(q_i+q_im1) - 8.*(q_ip1+q_im2)                  &
+            +(q_ip2+q_im3) )/60.0
+
+      flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)    &
+            -sign(1.,ua)*(                             &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )/60.0
+
+
+   LOGICAL :: specified
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+! set order for the advection schemes
+
+  ktf=MIN(kte,kde-1)
+  horz_order = config_flags%h_sca_adv_order
+  vert_order = config_flags%v_sca_adv_order
+
+!  begin with horizontal flux divergence
+!  here is the choice of flux operators
+
+
+  horizontal_order_test : IF( horz_order == 6 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      ktf=MIN(kte,kde-1)
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = rv(i,k,j)
+          fqy( i, k, jp1 ) = vel*flux6(                                &
+                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
+                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i,k, jp1) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = rv(i,k,j)
+              fqy( i, k, jp1 ) = vel*flux4(              &
+                   field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = rv(i,k,j)
+              fqy( i, k, jp1) = vel*flux4(             &
+                   field(i,k,j-2),field(i,k,j-1),    &
+                   field(i,k,j),field(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ENDIF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+      ENDDO j_loop_y_flux_6
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+2
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = ru(i,k,j)
+          fqx( i,k ) = vel*flux6( field(i-3,k,j), field(i-2,k,j),  &
+                                         field(i-1,k,j), field(i  ,k,j),  &
+                                         field(i+1,k,j), field(i+2,k,j),  &
+                                         vel                             )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+              fqx(i,k) = 0.5*(ru(i,k,j)) &
+                     *(field(i,k,j)+field(i-1,k,j))
+
+            ENDDO
+          ENDIF
+
+          i = ids+2
+          DO k=kts,ktf
+            vel = ru(i,k,j)
+            fqx( i,k ) = vel*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                     )
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts,ktf
+              fqx(i,k) = 0.5*(ru(i,k,j))      &
+                     *(field(i,k,j)+field(i-1,k,j))
+            ENDDO
+         ENDIF
+
+          i = ide-2
+          DO k=kts,ktf
+            vel = ru(i,k,j)
+            fqx( i,k ) = vel*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msft(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+          ENDDO
+
+      ENDDO
+
+  ELSE IF( horz_order == 5 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      ktf=MIN(kte,kde-1)
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          vel = rv(i,k,j)
+          fqy( i, k, jp1 ) = vel*flux5(                                &
+                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
+                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i,k, jp1) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+            ENDDO
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = rv(i,k,j)
+              fqy( i, k, jp1 ) = vel*flux3(              &
+                   field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+            ENDDO
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+              vel = rv(i,k,j)
+              fqy( i, k, jp1) = vel*flux3(             &
+                   field(i,k,j-2),field(i,k,j-1),    &
+                   field(i,k,j),field(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+     ENDIF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+        ENDIF
+
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+      ENDDO j_loop_y_flux_5
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+2
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+          vel = ru(i,k,j)
+          fqx( i,k ) = vel*flux5( field(i-3,k,j), field(i-2,k,j),  &
+                                         field(i-1,k,j), field(i  ,k,j),  &
+                                         field(i+1,k,j), field(i+2,k,j),  &
+                                         vel                             )
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+              fqx(i,k) = 0.5*(ru(i,k,j)) &
+                     *(field(i,k,j)+field(i-1,k,j))
+
+            ENDDO
+          ENDIF
+
+          i = ids+2
+          DO k=kts,ktf
+            vel = ru(i,k,j)
+            fqx( i,k ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                     )
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts,ktf
+              fqx(i,k) = 0.5*(ru(i,k,j))      &
+                     *(field(i,k,j)+field(i-1,k,j))
+            ENDDO
+         ENDIF
+
+          i = ide-2
+          DO k=kts,ktf
+            vel = ru(i,k,j)
+            fqx( i,k ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+          ENDDO
+
+        ENDIF
+
+!  x flux-divergence into tendency
+
+          DO k=kts,ktf
+          DO i = i_start, i_end
+            mrdx=msft(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+          ENDDO
+
+      ENDDO
+
+
+   ELSE IF( horz_order == 4 ) THEN
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!  begin flux computations
+!  start with x flux divergence
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  3rd or 4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          fqx( i, k) = ru(i,k,j)*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                        field(i  ,k,j), field(i+1,k,j),  &
+                                        ru(i,k,j)                       )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts,ktf
+            fqx(i_start, k) = 0.5*ru(i_start,k,j)             &
+                   *(field(i_start,k,j)+field(i_start-1,k,j))
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts,ktf
+            fqx(i_end+1,k ) = 0.5*ru(i_end+1,k,j)          &
+                   *(field(i_end+1,k,j)+field(i_end,k,j))
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          mrdx=msft(i,j)*rdx
+          tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+
+!  next -> y flux divergence calculation
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+    jp1 = 2
+    jp0 = 1
+
+  DO j = j_start, j_end+1
+
+    IF ((j < j_start_f) .and. degrade_ys) THEN
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy(i,k,jp1) = 0.5*rv(i,k,j_start)             &
+                *(field(i,k,j_start)+field(i,k,j_start-1))
+      ENDDO
+      ENDDO
+    ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1)          &
+                *(field(i,k,j_end+1)+field(i,k,j_end))
+      ENDDO
+      ENDDO
+    ELSE
+!  3rd or 4th order flux
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy( i, k, jp1 ) = rv(i,k,j)*flux4( field(i,k,j-2), field(i,k,j-1),  &
+                                            field(i,k,j  ), field(i,k,j+1),  &
+                                            rv(i,k,j)                       )
+      ENDDO
+      ENDDO
+    END IF
+
+    IF ( j > j_start ) THEN
+!  y flux-divergence into tendency
+
+      DO k=kts,ktf
+      DO i = i_start, i_end
+        mrdy=msft(i,j-1)*rdy
+        tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+      ENDDO
+      ENDDO
+    END IF
+
+    jtmp = jp1
+    jp1 = jp0
+    jp0 = jtmp
+
+  ENDDO
+
+
+   ELSE IF( horz_order == 3 ) THEN
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!  begin flux computations
+!  start with x flux divergence
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  3rd or 4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          fqx( i, k) = ru(i,k,j)*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                        field(i  ,k,j), field(i+1,k,j),  &
+                                        ru(i,k,j)                       )
+        ENDDO
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts,ktf
+            fqx(i_start, k) = 0.5*ru(i_start,k,j)             &
+                   *(field(i_start,k,j)+field(i_start-1,k,j))
+          ENDDO
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts,ktf
+            fqx(i_end+1,k ) = 0.5*ru(i_end+1,k,j)          &
+                   *(field(i_end+1,k,j)+field(i_end,k,j))
+          ENDDO
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+          mrdx=msft(i,j)*rdx
+          tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+
+!  next -> y flux divergence calculation
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+    jp1 = 2
+    jp0 = 1
+
+  DO j = j_start, j_end+1
+
+    IF ((j < j_start_f) .and. degrade_ys) THEN
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy(i,k,jp1) = 0.5*rv(i,k,j_start)             &
+                *(field(i,k,j_start)+field(i,k,j_start-1))
+      ENDDO
+      ENDDO
+    ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1)          &
+                *(field(i,k,j_end+1)+field(i,k,j_end))
+      ENDDO
+      ENDDO
+    ELSE
+!  3rd or 4th order flux
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         fqy( i, k, jp1 ) = rv(i,k,j)*flux3( field(i,k,j-2), field(i,k,j-1),  &
+                                            field(i,k,j  ), field(i,k,j+1),  &
+                                            rv(i,k,j)                       )
+      ENDDO
+      ENDDO
+    END IF
+
+    IF ( j > j_start ) THEN
+!  y flux-divergence into tendency
+
+      DO k=kts,ktf
+      DO i = i_start, i_end
+        mrdy=msft(i,j-1)*rdy
+        tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+      ENDDO
+      ENDDO
+    END IF
+
+    jtmp = jp1
+    jp1 = jp0
+    jp0 = jtmp
+
+  ENDDO
+
+   ELSE IF( horz_order == 2 ) THEN
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( .NOT. config_flags%periodic_x ) THEN
+        IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+        IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      ENDIF
+
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         mrdx=msft(i,j)*rdx
+         tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5 &
+                         *(ru(i+1,k,j)*(field(i+1,k,j)+field(i  ,k,j)) &
+                          -ru(i  ,k,j)*(field(i  ,k,j)+field(i-1,k,j)))
+      ENDDO
+      ENDDO
+      ENDDO
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         mrdy=msft(i,j)*rdy
+         tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5 &
+                         *(rv(i,k,j+1)*(field(i,k,j+1)+field(i,k,j  )) &
+                          -rv(i,k,j  )*(field(i,k,j  )+field(i,k,j-1))) 
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_scalar_6a, h_order not known ',horz_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF horizontal_order_test
+
+!  pick up the rest of the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb'.
+!  first, set to index ranges
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  compute x (u) conditions for v, w, or scalar
+
+   IF( (config_flags%open_xs) .and. (its == ids) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MIN( 0.5*(ru(its,k,j)+ru(its+1,k,j)), 0. )
+         tendency(its,k,j) = tendency(its,k,j)                     &
+               - rdx*(                                             &
+                       ub*(   field_old(its+1,k,j)                 &
+                            - field_old(its  ,k,j)   ) +           &
+                       field(its,k,j)*(ru(its+1,k,j)-ru(its,k,j))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MAX( 0.5*(ru(ite-1,k,j)+ru(ite,k,j)), 0. )
+         tendency(i_end,k,j) = tendency(i_end,k,j)                   &
+               - rdx*(                                               &
+                       ub*(  field_old(i_end  ,k,j)                  &
+                           - field_old(i_end-1,k,j) ) +              &
+                       field(i_end,k,j)*(ru(ite,k,j)-ru(ite-1,k,j))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MIN( 0.5*(rv(i,k,jts)+rv(i,k,jts+1)), 0. )
+         tendency(i,k,jts) = tendency(i,k,jts)                     &
+               - rdy*(                                             &
+                       vb*(  field_old(i,k,jts+1)                  &
+                           - field_old(i,k,jts  ) ) +              &
+                       field(i,k,jts)*(rv(i,k,jts+1)-rv(i,k,jts))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ye) .and. (jte == jde)) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MAX( 0.5*(rv(i,k,jte-1)+rv(i,k,jte)), 0. )
+         tendency(i,k,j_end) = tendency(i,k,j_end)                   &
+               - rdy*(                                               &
+                       vb*(   field_old(i,k,j_end  )                 &
+                            - field_old(i,k,j_end-1) ) +             &
+                       field(i,k,j_end)*(rv(i,k,jte)-rv(i,k,jte-1))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+
+!-------------------- vertical advection
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      DO i = i_start, i_end
+         vflux(i,kts)=0.
+         vflux(i,kte)=0.
+      ENDDO
+
+    vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux6(                                 &
+                   field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),       &
+                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+                                   
+           k = kts+2
+           vel=rom(i,k,j) 
+           vflux(i,k) = vel*flux4(               &
+                   field(i,k-2,j), field(i,k-1,j),   &
+                   field(i,k  ,j), field(i,k+1,j), -vel )
+           k = ktf-1
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux4(               &
+                   field(i,k-2,j), field(i,k-1,j),   &
+                   field(i,k  ,j), field(i,k+1,j), -vel )
+
+           k=ktf
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+         ENDDO
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux5(                                 &
+                   field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),       &
+                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+                                   
+           k = kts+2
+           vel=rom(i,k,j) 
+           vflux(i,k) = vel*flux3(               &
+                   field(i,k-2,j), field(i,k-1,j),   &
+                   field(i,k  ,j), field(i,k+1,j), -vel )
+           k = ktf-1
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux3(               &
+                   field(i,k-2,j), field(i,k-1,j),   &
+                   field(i,k  ,j), field(i,k+1,j), -vel )
+
+           k=ktf
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+         ENDDO
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux4(                                 &
+                   field(i,k-2,j), field(i,k-1,j),       &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           k=ktf
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+         ENDDO
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+           vel=rom(i,k,j)
+           vflux(i,k) = vel*flux3(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           k=ktf
+           vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+         ENDDO
+
+         DO k=kts,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+
+   ELSE IF (vert_order == 2) THEN    
+
+  DO j = j_start, j_end
+     DO k = kts+1, ktf
+     DO i = i_start, i_end
+            vflux(i,k)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+     ENDDO
+     ENDDO
+
+     DO k = kts, ktf
+     DO i = i_start, i_end
+       tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
+     ENDDO
+     ENDDO
+
+  ENDDO
+
+   ELSE
+
+      WRITE (wrf_err_message,*) ' advect_scalar_6a, v_order not known ',vert_order
+      CALL wrf_error_fatal ( wrf_err_message )
+
+   ENDIF vert_order_test
+
+END SUBROUTINE advect_scalar
+
+!---------------------------------------------------------------------------------
+
+SUBROUTINE advect_w    ( w, w_old, tendency,            &
+                         ru, rv, rom,                   &
+                         mut, config_flags,             &
+                         msfu, msfv, msft,              &
+                         fzm, fzp,                      &
+                         rdx, rdy, rdzu,                &
+                         ids, ide, jds, jde, kds, kde,  &
+                         ims, ime, jms, jme, kms, kme,  &
+                         its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: w,     &
+                                                                      w_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzu
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw
+   REAL , DIMENSION(its:ite, kts:kte) :: vflux
+
+   INTEGER :: horz_order, vert_order
+
+   REAL,  DIMENSION( its:ite+1, kts:kte ) :: fqx
+   REAL,  DIMENSION( its:ite, kts:kte, 2 ) :: fqy
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+   INTEGER :: jp1, jp0, jtmp
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
+
+      flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+          ( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+
+      flux3(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+           flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+           sign(1.,ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
+
+      flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+                      ( 37.*(q_i+q_im1) - 8.*(q_ip1+q_im2)      &
+                     +(q_ip2+q_im3) )/60.0
+
+      flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)    &
+            -sign(1.,ua)*(                             &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )/60.0
+
+
+   LOGICAL :: specified
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+!  set order for the advection scheme
+
+  ktf=MIN(kte,kde-1)
+  horz_order = config_flags%h_sca_adv_order
+  vert_order = config_flags%v_sca_adv_order
+
+!  here is the choice of flux operators
+
+!  begin with horizontal flux divergence
+
+  horizontal_order_test : IF( horz_order == 6 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
+
+        DO k=kts+1,ktf
+        DO i = i_start, i_end
+          vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+          fqy( i, k, jp1 ) = vel*flux6(                     &
+                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
+                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start, i_end
+          vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+          fqy( i, k, jp1 ) = vel*flux6(                     &
+                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
+                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*          &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))* &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+              fqy( i, k, jp1 ) = vel*flux4(              &
+                   w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+              fqy( i, k, jp1 ) = vel*flux4(              &
+                   w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*      &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*      &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+              fqy( i, k, jp1 ) = vel*flux4(             &
+                   w(i,k,j-2),w(i,k,j-1),    &
+                   w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+              fqy( i, k, jp1 ) = vel*flux4(             &
+                   w(i,k,j-2),w(i,k,j-1),    &
+                   w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+
+     ENDIF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts+1,ktf+1
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+       ENDIF
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+      ENDDO j_loop_y_flux_6
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+2
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts+1,ktf
+        DO i = i_start_f, i_end_f
+          vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+          fqx( i,k ) = vel*flux6( w(i-3,k,j), w(i-2,k,j),  &
+                                         w(i-1,k,j), w(i  ,k,j),  &
+                                         w(i+1,k,j), w(i+2,k,j),  &
+                                         vel                             )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start_f, i_end_f
+          vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+          fqx( i,k ) = vel*flux6( w(i-3,k,j), w(i-2,k,j),  &
+                                         w(i-1,k,j), w(i  ,k,j),  &
+                                         w(i+1,k,j), w(i+2,k,j),  &
+                                         vel                             )
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts+1,ktf
+              fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)) &
+                     *(w(i,k,j)+w(i-1,k,j))
+            ENDDO
+              k = ktf+1
+              fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)) &
+                     *(w(i,k,j)+w(i-1,k,j))
+          ENDIF
+
+          DO k=kts+1,ktf
+            i = i_start+1
+            vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+            fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                          w(i  ,k,j), w(i+1,k,j),  &
+                                          vel                     )
+          ENDDO
+
+            k = ktf+1
+            vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+            fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                          w(i  ,k,j), w(i+1,k,j),  &
+                                          vel                     )
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts+1,ktf
+              fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))      &
+                     *(w(i,k,j)+w(i-1,k,j))
+            ENDDO
+              k = ktf+1
+              fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))      &
+                     *(w(i,k,j)+w(i-1,k,j))
+          ENDIF
+
+          i = ide-2
+          DO k=kts+1,ktf
+            vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+            fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                          w(i  ,k,j), w(i+1,k,j),  &
+                                          vel                             )
+          ENDDO
+
+            k = ktf+1
+            vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+            fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                          w(i  ,k,j), w(i+1,k,j),  &
+                                          vel                             )
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts+1,ktf+1
+          DO i = i_start, i_end
+            mrdx=msft(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+
+ELSE IF (horz_order == 5 ) THEN
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 5th or 6th order
+
+     jp1 = 2
+     jp0 = 1
+
+     j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
+
+        DO k=kts+1,ktf
+        DO i = i_start, i_end
+          vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+          fqy( i, k, jp1 ) = vel*flux5(                     &
+                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
+                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start, i_end
+          vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+          fqy( i, k, jp1 ) = vel*flux5(                     &
+                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
+                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*          &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*          &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+
+     ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+              fqy( i, k, jp1 ) = vel*flux3(              &
+                   w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+              fqy( i, k, jp1 ) = vel*flux3(              &
+                   w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+
+     ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*      &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*      &
+                     (w(i,k,j)+w(i,k,j-1))
+            ENDDO
+
+     ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts+1,ktf
+            DO i = i_start, i_end
+              vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+              fqy( i, k, jp1 ) = vel*flux3(             &
+                   w(i,k,j-2),w(i,k,j-1),    &
+                   w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+            ENDDO
+
+            k = ktf+1
+            DO i = i_start, i_end
+              vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+              fqy( i, k, jp1 ) = vel*flux3(             &
+                   w(i,k,j-2),w(i,k,j-1),    &
+                   w(i,k,j),w(i,k,j+1),vel )
+            ENDDO
+
+     ENDIF
+
+!  y flux-divergence into tendency
+
+        IF(j > j_start) THEN
+
+          DO k=kts+1,ktf+1
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+
+       ENDIF
+
+        jtmp = jp1
+        jp1 = jp0
+        jp0 = jtmp
+
+      ENDDO j_loop_y_flux_5
+
+!  next, x - flux divergence
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  higher order flux has a 5 or 7 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+2
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th or 6th order flux
+
+        DO k=kts+1,ktf
+        DO i = i_start_f, i_end_f
+          vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+          fqx( i,k ) = vel*flux5( w(i-3,k,j), w(i-2,k,j),  &
+                                  w(i-1,k,j), w(i  ,k,j),  &
+                                  w(i+1,k,j), w(i+2,k,j),  &
+                          vel                             )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start_f, i_end_f
+          vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+          fqx( i,k ) = vel*flux5( w(i-3,k,j), w(i-2,k,j),  &
+                                  w(i-1,k,j), w(i  ,k,j),  &
+                                  w(i+1,k,j), w(i+2,k,j),  &
+                          vel                             )
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts+1,ktf
+              fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)) &
+                     *(w(i,k,j)+w(i-1,k,j))
+            ENDDO
+              k = ktf+1
+              fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)) &
+                     *(w(i,k,j)+w(i-1,k,j))
+          ENDIF
+
+          i = i_start+1
+          DO k=kts+1,ktf
+            vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+            fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                    w(i  ,k,j), w(i+1,k,j),  &
+                                          vel                     )
+          ENDDO
+            k = ktf+1
+            vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+            fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                    w(i  ,k,j), w(i+1,k,j),  &
+                                          vel                     )
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts+1,ktf
+              fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))      &
+                     *(w(i,k,j)+w(i-1,k,j))
+            ENDDO
+              k = ktf+1
+              fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))      &
+                     *(w(i,k,j)+w(i-1,k,j))
+          ENDIF
+
+          i = ide-2
+          DO k=kts+1,ktf
+            vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+            fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                          w(i  ,k,j), w(i+1,k,j),  &
+                                          vel                             )
+          ENDDO
+            k = ktf+1
+            vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+            fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                          w(i  ,k,j), w(i+1,k,j),  &
+                                          vel                             )
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts+1,ktf+1
+          DO i = i_start, i_end
+            mrdx=msft(i,j)*rdx
+            tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+          ENDDO
+        ENDDO
+
+      ENDDO
+
+ELSE IF ( horz_order == 4 ) THEN
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!  begin flux computations
+!  start with x flux divergence
+
+!---------------
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+        DO k=kts+1,ktf
+        DO i = i_start_f, i_end_f
+          vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+          fqx( i, k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                  w(i  ,k,j), w(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+
+        k = ktf+1
+        DO i = i_start_f, i_end_f
+          vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+          fqx( i, k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j),  &
+                                  w(i  ,k,j), w(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts+1,ktf
+            fqx(i_start, k) =                            &
+               0.5*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))  &
+                   *(w(i_start,k,j)+w(i_start-1,k,j))
+          ENDDO
+            k = ktf+1
+            fqx(i_start, k) =                            &
+               0.5*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))  &
+                   *(w(i_start,k,j)+w(i_start-1,k,j))
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts+1,ktf
+            fqx(i_end+1, k) =                            &
+               0.5*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))  &
+                   *(w(i_end+1,k,j)+w(i_end,k,j))
+          ENDDO
+            k = ktf+1
+            fqx(i_end+1, k) =                            &
+               0.5*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))  &
+                   *(w(i_end+1,k,j)+w(i_end,k,j))
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts+1,ktf+1
+        DO i = i_start, i_end
+          mrdx=msft(i,j)*rdx
+          tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+!  next -> y flux divergence calculation
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+        jp1 = 2
+        jp0 = 1
+
+      DO j = j_start, j_end+1
+
+       IF ((j < j_start_f) .and. degrade_ys)  THEN
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))   &
+                   *(w(i,k,j_start)+w(i,k,j_start-1))
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))   &
+                   *(w(i,k,j_start)+w(i,k,j_start-1))
+          ENDDO
+       ELSE IF ((j > j_end_f) .and. degrade_ye)  THEN
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))     &
+                   *(w(i,k,j_end+1)+w(i,k,j_end))
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                                         &
+               0.5*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))     &
+                   *(w(i,k,j_end+1)+w(i,k,j_end))
+          ENDDO
+       ELSE
+!  3rd or 4th order flux
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+            fqy( i, k, jp1 ) = vel*flux4( w(i,k,j-2), w(i,k,j-1),  &
+                                    w(i,k,j  ), w(i,k,j+1),  &
+                                    vel                     )
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+            fqy( i, k, jp1 ) = vel*flux4( w(i,k,j-2), w(i,k,j-1),  &
+                                    w(i,k,j  ), w(i,k,j+1),  &
+                                    vel                     )
+          ENDDO
+       END IF
+
+       IF( j > j_start ) THEN
+!  y flux-divergence into tendency
+          DO k = kts+1, ktf+1
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+       END IF
+
+       jtmp = jp1
+       jp1 = jp0
+       jp0 = jtmp
+
+    ENDDO
+
+ELSE IF ( horz_order == 3 ) THEN
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!  begin flux computations
+!  start with x flux divergence
+
+!---------------
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      IF(degrade_xs) then
+        i_start = ids+1
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = ide-2
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+        DO k=kts+1,ktf
+        DO i = i_start_f, i_end_f
+          vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
+          fqx( i, k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                  w(i  ,k,j), w(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+        ENDDO
+        k = ktf+1
+        DO i = i_start_f, i_end_f
+          vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
+          fqx( i, k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j),  &
+                                  w(i  ,k,j), w(i+1,k,j),  &
+                                  vel                     )
+        ENDDO
+
+!  second order flux close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          DO k=kts+1,ktf
+            fqx(i_start, k) =                            &
+               0.5*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))  &
+                   *(w(i_start,k,j)+w(i_start-1,k,j))
+          ENDDO
+            k = ktf+1
+            fqx(i_start, k) =                            &
+               0.5*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))  &
+                   *(w(i_start,k,j)+w(i_start-1,k,j))
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          DO k=kts+1,ktf
+            fqx(i_end+1, k) =                            &
+               0.5*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))  &
+                   *(w(i_end+1,k,j)+w(i_end,k,j))
+          ENDDO
+            k = ktf+1
+            fqx(i_end+1, k) =                            &
+               0.5*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))  &
+                   *(w(i_end+1,k,j)+w(i_end,k,j))
+        ENDIF
+
+!  x flux-divergence into tendency
+
+        DO k=kts+1,ktf+1
+        DO i = i_start, i_end
+          mrdx=msft(i,j)*rdx
+          tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+!  next -> y flux divergence calculation
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+
+!  3rd or 4th order flux has a 5 point stencil, so compute
+!  bounds so we can switch to second order flux close to the boundary
+
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+      IF(degrade_ys) then
+        j_start = jds+1
+        j_start_f = j_start+1
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = jde-2
+        j_end_f = jde-2
+      ENDIF
+
+        jp1 = 2
+        jp0 = 1
+
+      DO j = j_start, j_end+1
+
+       IF ((j < j_start_f) .and. degrade_ys)  THEN
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))   &
+                   *(w(i,k,j_start)+w(i,k,j_start-1))
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))   &
+                   *(w(i,k,j_start)+w(i,k,j_start-1))
+          ENDDO
+       ELSE IF ((j > j_end_f) .and. degrade_ye)  THEN
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))     &
+                   *(w(i,k,j_end+1)+w(i,k,j_end))
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            fqy(i, k, jp1) =                             &
+               0.5*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))     &
+                   *(w(i,k,j_end+1)+w(i,k,j_end))
+          ENDDO
+       ELSE
+!  3rd or 4th order flux
+          DO k = kts+1, ktf
+          DO i = i_start, i_end
+            vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
+            fqy( i, k, jp1 ) = vel*flux3( w(i,k,j-2), w(i,k,j-1),  &
+                                    w(i,k,j  ), w(i,k,j+1),  &
+                                    vel                     )
+          ENDDO
+          ENDDO
+          k = ktf+1
+          DO i = i_start, i_end
+            vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
+            fqy( i, k, jp1 ) = vel*flux3( w(i,k,j-2), w(i,k,j-1),  &
+                                    w(i,k,j  ), w(i,k,j+1),  &
+                                    vel                     )
+          ENDDO
+       END IF
+
+       IF( j > j_start ) THEN
+!  y flux-divergence into tendency
+          DO k = kts+1, ktf+1
+          DO i = i_start, i_end
+            mrdy=msft(i,j-1)*rdy
+            tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
+          ENDDO
+          ENDDO
+       END IF
+
+       jtmp = jp1
+       jp1 = jp0
+       jp0 = jtmp
+
+    ENDDO
+
+ELSE IF (horz_order == 2 ) THEN
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( .NOT. config_flags%periodic_x ) THEN
+        IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+        IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      ENDIF
+
+      DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+         mrdx=msft(i,j)*rdx
+
+            tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5            &
+                   *((fzm(k)*ru(i+1,k,j)+fzp(k)*ru(i+1,k-1,j))  &
+                                *(w(i+1,k,j)+w(i,k,j))          &
+                    -(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))      &
+                               *(w(i,k,j)+w(i-1,k,j)))
+
+      ENDDO
+      ENDDO
+
+      k = ktf+1
+      DO i = i_start, i_end
+
+         mrdx=msft(i,j)*rdx
+
+            tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5            &
+                   *(((2.-fzm(k-1))*ru(i+1,k-1,j)-fzp(k-1)*ru(i+1,k-2,j))      &
+                                *(w(i+1,k,j)+w(i,k,j))          &
+                    -((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))         &
+                               *(w(i,k,j)+w(i-1,k,j)))
+
+      ENDDO
+
+      ENDDO
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+
+      DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+         mrdy=msft(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5           &
+                   *((fzm(k)*rv(i,k,j+1)+fzp(k)*rv(i,k-1,j+1))* &
+                                 (w(i,k,j+1)+w(i,k,j))          &
+                    -(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))      &
+                                 *(w(i,k,j)+w(i,k,j-1))) 
+
+      ENDDO
+      ENDDO
+
+      k = ktf+1
+      DO i = i_start, i_end
+
+         mrdy=msft(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5       &
+                   *(((2.-fzm(k-1))*rv(i,k-1,j+1)-fzp(k-1)*rv(i,k-2,j+1))* &
+                                 (w(i,k,j+1)+w(i,k,j))      &
+                    -((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))      &
+                                 *(w(i,k,j)+w(i,k,j-1))) 
+
+      ENDDO
+
+      ENDDO
+
+   ELSE
+
+      WRITE ( wrf_err_message ,*) ' advect_w_6a, h_order not known ',horz_order
+      CALL wrf_error_fatal ( wrf_err_message )
+
+   ENDIF horizontal_order_test
+
+
+!  pick up the the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb'.
+!  first, set to index ranges
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+   IF( (config_flags%open_xs) .and. (its == ids)) THEN
+
+       DO j = j_start, j_end
+       DO k = kts+1, ktf
+
+         uw = 0.5*(fzm(k)*(ru(its,k  ,j)+ru(its+1,k  ,j)) +  &
+                   fzp(k)*(ru(its,k-1,j)+ru(its+1,k-1,j))   )
+         ub = MIN( uw, 0. )
+
+         tendency(its,k,j) = tendency(its,k,j)                     &
+               - rdx*(                                             &
+                       ub*(w_old(its+1,k,j) - w_old(its,k,j)) +    &
+                       w(its,k,j)*(                                &
+                       fzm(k)*(ru(its+1,k  ,j)-ru(its,k  ,j))+     &
+                       fzp(k)*(ru(its+1,k-1,j)-ru(its,k-1,j)))     &
+                                                                  )
+       ENDDO
+       ENDDO
+
+       k = ktf+1
+       DO j = j_start, j_end
+
+         uw = 0.5*( (2.-fzm(k-1))*(ru(its,k-1,j)+ru(its+1,k-1,j))   &
+                   -fzp(k-1)*(ru(its,k-2,j)+ru(its+1,k-2,j))   )
+         ub = MIN( uw, 0. )
+
+         tendency(its,k,j) = tendency(its,k,j)                     &
+               - rdx*(                                             &
+                       ub*(w_old(its+1,k,j) - w_old(its,k,j)) +    &
+                       w(its,k,j)*(                                &
+                             (2.-fzm(k-1))*(ru(its+1,k-1,j)-ru(its,k-1,j))-  &
+                             fzp(k-1)*(ru(its+1,k-2,j)-ru(its,k-2,j)))  &
+                                                                  )
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_xe) .and. (ite == ide)) THEN
+
+       DO j = j_start, j_end
+       DO k = kts+1, ktf
+
+         uw = 0.5*(fzm(k)*(ru(ite-1,k  ,j)+ru(ite,k  ,j)) +  &
+                   fzp(k)*(ru(ite-1,k-1,j)+ru(ite,k-1,j))   )
+         ub = MAX( uw, 0. )
+
+         tendency(i_end,k,j) = tendency(i_end,k,j)                     &
+               - rdx*(                                                 &
+                       ub*(w_old(i_end,k,j) - w_old(i_end-1,k,j)) +    &
+                       w(i_end,k,j)*(                                  &
+                            fzm(k)*(ru(ite,k  ,j)-ru(ite-1,k  ,j)) +   &
+                            fzp(k)*(ru(ite,k-1,j)-ru(ite-1,k-1,j)))    &
+                                                                    )
+       ENDDO
+       ENDDO
+
+       k = ktf+1
+       DO j = j_start, j_end
+
+         uw = 0.5*( (2.-fzm(k-1))*(ru(ite-1,k-1,j)+ru(ite,k-1,j))    &
+                   -fzp(k-1)*(ru(ite-1,k-2,j)+ru(ite,k-2,j))   )
+         ub = MAX( uw, 0. )
+
+         tendency(i_end,k,j) = tendency(i_end,k,j)                     &
+               - rdx*(                                                 &
+                       ub*(w_old(i_end,k,j) - w_old(i_end-1,k,j)) +    &
+                       w(i_end,k,j)*(                                  &
+                               (2.-fzm(k-1))*(ru(ite,k-1,j)-ru(ite-1,k-1,j)) -   &
+                               fzp(k-1)*(ru(ite,k-2,j)-ru(ite-1,k-2,j)))    &
+                                                                    )
+       ENDDO
+
+   ENDIF
+
+
+   IF( (config_flags%open_ys) .and. (jts == jds)) THEN
+
+       DO i = i_start, i_end
+       DO k = kts+1, ktf
+
+         vw = 0.5*( fzm(k)*(rv(i,k  ,jts)+rv(i,k  ,jts+1)) +  &
+                    fzp(k)*(rv(i,k-1,jts)+rv(i,k-1,jts+1))   )
+         vb = MIN( vw, 0. )
+
+         tendency(i,k,jts) = tendency(i,k,jts)                     &
+               - rdy*(                                             &
+                       vb*(w_old(i,k,jts+1) - w_old(i,k,jts)) +    &
+                       w(i,k,jts)*(                                &
+                       fzm(k)*(rv(i,k  ,jts+1)-rv(i,k  ,jts))+     &
+                       fzp(k)*(rv(i,k-1,jts+1)-rv(i,k-1,jts)))     &
+                                                                )
+       ENDDO
+       ENDDO
+
+       k = ktf+1
+       DO i = i_start, i_end
+         vw = 0.5*( (2.-fzm(k-1))*(rv(i,k-1,jts)+rv(i,k-1,jts+1))    &
+                   -fzp(k-1)*(rv(i,k-2,jts)+rv(i,k-2,jts+1))   )
+         vb = MIN( vw, 0. )
+
+         tendency(i,k,jts) = tendency(i,k,jts)                     &
+               - rdy*(                                             &
+                       vb*(w_old(i,k,jts+1) - w_old(i,k,jts)) +    &
+                       w(i,k,jts)*(                                &
+                          (2.-fzm(k-1))*(rv(i,k-1,jts+1)-rv(i,k-1,jts))-     &
+                          fzp(k-1)*(rv(i,k-2,jts+1)-rv(i,k-2,jts)))     &
+                                                                )
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ye) .and. (jte == jde) ) THEN
+
+       DO i = i_start, i_end
+       DO k = kts+1, ktf
+
+         vw = 0.5*( fzm(k)*(rv(i,k  ,jte-1)+rv(i,k  ,jte)) +  &
+                    fzp(k)*(rv(i,k-1,jte-1)+rv(i,k-1,jte))   )
+         vb = MAX( vw, 0. )
+
+         tendency(i,k,j_end) = tendency(i,k,j_end)                     &
+               - rdy*(                                                 &
+                       vb*(w_old(i,k,j_end) - w_old(i,k,j_end-1)) +    &
+                       w(i,k,j_end)*(                                  &
+                            fzm(k)*(rv(i,k  ,jte)-rv(i,k  ,jte-1))+    &
+                            fzp(k)*(rv(i,k-1,jte)-rv(i,k-1,jte-1)))    &
+                                                                      )
+       ENDDO
+       ENDDO
+
+       k = ktf+1
+       DO i = i_start, i_end
+
+         vw = 0.5*( (2.-fzm(k-1))*(rv(i,k-1,jte-1)+rv(i,k-1,jte))    &
+                   -fzp(k-1)*(rv(i,k-2,jte-1)+rv(i,k-2,jte))   )
+         vb = MAX( vw, 0. )
+
+         tendency(i,k,j_end) = tendency(i,k,j_end)                     &
+               - rdy*(                                                 &
+                       vb*(w_old(i,k,j_end) - w_old(i,k,j_end-1)) +    &
+                       w(i,k,j_end)*(                                  &
+                               (2.-fzm(k-1))*(rv(i,k-1,jte)-rv(i,k-1,jte-1))-    &
+                               fzp(k-1)*(rv(i,k-2,jte)-rv(i,k-2,jte-1)))    &
+                                                                      )
+       ENDDO
+
+   ENDIF
+
+!-------------------- vertical advection
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      DO i = i_start, i_end
+         vflux(i,kts)=0.
+         vflux(i,kte)=0.
+      ENDDO
+
+    vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux6(                                   &
+                   w(i,k-3,j), w(i,k-2,j), w(i,k-1,j),       &
+                   w(i,k  ,j), w(i,k+1,j), w(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux4(               &
+                   w(i,k-2,j), w(i,k-1,j),   &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+
+           k = ktf
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux4(               &
+                   w(i,k-2,j), w(i,k-1,j),   &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+
+           k=ktf+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+! pick up flux contribution for w at the lid. wcs, 13 march 2004
+         k = ktf+1
+         DO i = i_start, i_end
+           tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+         ENDDO
+
+      ENDDO
+
+ ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+3,ktf-1
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux5(                                   &
+                   w(i,k-3,j), w(i,k-2,j), w(i,k-1,j),       &
+                   w(i,k  ,j), w(i,k+1,j), w(i,k+2,j),  -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+                                   
+           k = kts+2
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux3(               &
+                   w(i,k-2,j), w(i,k-1,j),   &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+           k = ktf
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux3(               &
+                   w(i,k-2,j), w(i,k-1,j),   &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+
+           k=ktf+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+! pick up flux contribution for w at the lid, wcs. 13 march 2004
+         k = ktf+1
+         DO i = i_start, i_end
+           tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+         ENDDO
+
+      ENDDO
+
+ ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux4(              &
+                   w(i,k-2,j), w(i,k-1,j),      &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+           k=ktf+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+! pick up flux contribution for w at the lid, wcs. 13 march 2004
+         k = ktf+1
+         DO i = i_start, i_end
+           tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+         ENDDO
+
+      ENDDO
+
+ ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+         DO k=kts+2,ktf
+         DO i = i_start, i_end
+           vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
+           vflux(i,k) = vel*flux3(              &
+                   w(i,k-2,j), w(i,k-1,j),      &
+                   w(i,k  ,j), w(i,k+1,j), -vel )
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+           k=ktf+1
+           vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+         ENDDO
+         ENDDO
+
+! pick up flux contribution for w at the lid, wcs. 13 march 2004
+         k = ktf+1
+         DO i = i_start, i_end
+           tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+         ENDDO
+
+      ENDDO
+
+ ELSE IF (vert_order == 2) THEN    
+
+  DO j = j_start, j_end
+     DO k=kts+1,ktf+1
+     DO i = i_start, i_end
+
+            vflux(i,k)=0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
+     ENDDO
+     ENDDO
+     DO k=kts+1,ktf
+     DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
+
+     ENDDO
+     ENDDO
+
+! pick up flux contribution for w at the lid, wcs. 13 march 2004
+     k = ktf+1
+     DO i = i_start, i_end
+       tendency(i,k,j)=tendency(i,k,j)+2.*rdzu(k-1)*(vflux(i,k))
+     ENDDO
+
+  ENDDO
+
+   ELSE
+
+      WRITE (wrf_err_message ,*) ' advect_w, v_order not known ',vert_order
+      CALL wrf_error_fatal ( wrf_err_message )
+
+   ENDIF vert_order_test
+
+END SUBROUTINE advect_w
+
+!----------------------------------------------------------------
+
+SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
+                                ru, rv, rom,                   &
+                                mut, mub, mu_old,              &
+                                config_flags,                  &
+                                msfu, msfv, msft,              &
+                                fzm, fzp,                      &
+                                rdx, rdy, rdzw, dt,            &
+                                ids, ide, jds, jde, kds, kde,  &
+                                ims, ime, jms, jme, kms, kme,  &
+                                its, ite, jts, jte, kts, kte  )
+
+!  this is a first cut at a positive definite advection option
+!  for scalars in WRF.  This version is memory intensive ->
+!  we save 3d arrays of x, y and z both high and low order fluxes
+!  (six in all).  Alternatively, we could sweep in a direction 
+!  and lower the cost considerably.
+
+!  uses the Smolarkiewicz MWR 1989 approach, with addition of first-order
+!  fluxes initially
+
+!  WCS, 3 December 2002, 24 February 2003
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field,     &
+                                                                      field_old, &
+                                                                      ru,    &
+                                                                      rv,    &
+                                                                      rom
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mut, mub, mu_old
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,  &
+                                                                    msfv,  &
+                                                                    msft
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,  &
+                                                                  fzp,  &
+                                                                  rdzw
+
+   REAL ,                                        INTENT(IN   ) :: rdx,  &
+                                                                  rdy,  &
+                                                                  dt
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
+   INTEGER :: jmin, jmax, jp, jm, imin, imax
+
+   REAL    :: mrdx, mrdy, ub, vb, uw, vw, mu
+
+!  storage for high and low order fluxes
+
+   REAL,  DIMENSION( its-1:ite+2, kts:kte, jts-1:jte+2  ) :: fqx, fqy, fqz
+   REAL,  DIMENSION( its-1:ite+2, kts:kte, jts-1:jte+2  ) :: fqxl, fqyl, fqzl
+
+   INTEGER :: horz_order, vert_order
+   
+   LOGICAL :: degrade_xs, degrade_ys
+   LOGICAL :: degrade_xe, degrade_ye
+
+   INTEGER :: jp1, jp0, jtmp
+
+   REAL :: flux_out, ph_low, scale
+   REAL, PARAMETER :: eps=1.e-20
+
+
+! definition of flux operators, 3rd, 4th, 5th or 6th order
+
+   REAL    :: flux3, flux4, flux5, flux6, flux_upwind
+   REAL    :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel, cr
+
+      flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+            (7./12.)*(q_i + q_im1) - (1./12.)*(q_ip1 + q_im2)
+
+      flux3(q_im2, q_im1, q_i, q_ip1, ua) =                     &
+           flux4(q_im2, q_im1, q_i, q_ip1, ua) +                &
+           sign(1.,ua)*(1./12.)*((q_ip1 - q_im2)-3.*(q_i-q_im1))
+
+      flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+            (37./60.)*(q_i+q_im1) - (2./15.)*(q_ip1+q_im2)      &
+            +(1./60.)*(q_ip2+q_im3)
+
+      flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) =       &
+           flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua)    &
+            -sign(1.,ua)*(1./60.)*(                             &
+              (q_ip2-q_im3)-5.*(q_ip1-q_im2)+10.*(q_i-q_im1) )
+
+      flux_upwind(q_im1, q_i, cr ) = 0.5*min( 1.0,(cr+abs(cr)))*q_im1 &
+                                    +0.5*max(-1.0,(cr-abs(cr)))*q_i
+!      flux_upwind(q_im1, q_i, cr ) = 0.
+
+    REAL     :: dx,dy,dz
+
+    LOGICAL, PARAMETER :: pd_limit = .true.
+
+! set order for the advection schemes
+
+!  write(6,*) ' in pd advection routine '
+
+  ktf=MIN(kte,kde-1)
+  horz_order = config_flags%h_sca_adv_order
+  vert_order = config_flags%v_sca_adv_order
+
+!  determine boundary mods for flux operators
+!  We degrade the flux operators from 3rd/4th order
+!   to second order one gridpoint in from the boundaries for
+!   all boundary conditions except periodic and symmetry - these
+!   conditions have boundary zone data fill for correct application
+!   of the higher order flux stencils
+
+   degrade_xs = .true.
+   degrade_xe = .true.
+   degrade_ys = .true.
+   degrade_ye = .true.
+
+!  begin with horizontal flux divergence
+!  here is the choice of flux operators
+
+
+  horizontal_order_test : IF( horz_order == 6 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!--  modify loop bounds if open or specified
+
+      IF(degrade_xs) i_start = its
+      IF(degrade_xe) i_end   = MIN(ite,ide-1)
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 6th order
+
+      j_loop_y_flux_6 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+          dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+          mu = 0.5*(mut(i,j)+mut(i,j-1))
+          vel = rv(i,k,j)
+          cr = vel*dt/dy/mu
+          fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+          fqy( i, k, j  ) = vel*flux6(                                  &
+                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
+                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
+
+          fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j ) = vel*flux4(              &
+                   field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i, k, j ) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-2 ) THEN  ! 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j) = vel*flux4(             &
+                   field(i,k,j-2),field(i,k,j-1),    &
+                   field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ENDIF
+
+    ENDDO j_loop_y_flux_6
+
+!  next, x flux
+
+!--  these bounds are for periodic and sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds for open and specified b.c
+
+      IF(degrade_ys) j_start = jts
+      IF(degrade_ye) j_end   = MIN(jte,jde-1)
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+2
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  6th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+          mu = 0.5*(mut(i,j)+mut(i-1,j))
+          vel = ru(i,k,j)
+          cr = vel*dt/dx/mu
+          fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+          fqx( i,k,j ) = vel*flux6( field(i-3,k,j), field(i-2,k,j),  &
+                                         field(i-1,k,j), field(i  ,k,j),  &
+                                         field(i+1,k,j), field(i+2,k,j),  &
+                                         vel                             )
+          fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)/mu
+              cr = vel*dt/dx
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+              fqx(i,k,j) = 0.5*(ru(i,k,j)) &
+                     *(field(i,k,j)+field(i-1,k,j))
+
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+
+          i = ids+2
+          DO k=kts,ktf
+            dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+            mu = 0.5*(mut(i,j)+mut(i-1,j))
+            vel = ru(i,k,j)
+            cr = vel*dt/dx/mu
+            fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+            fqx( i,k,j ) = vel*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                     )
+            fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts,ktf
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)
+              cr = vel*dt/dx/mu
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+              fqx(i,k,j) = 0.5*(ru(i,k,j))      &
+                     *(field(i,k,j)+field(i-1,k,j))
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+
+          i = ide-2
+          DO k=kts,ktf
+
+            dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+            mu = 0.5*(mut(i,j)+mut(i-1,j))
+            vel = ru(i,k,j)
+            cr = vel*dt/dx/mu
+            fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+            fqx( i,k,j ) = vel*flux4( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+            fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+          ENDDO
+
+        ENDIF
+
+      ENDDO  ! enddo for outer J loop
+
+!--- end of 6th order horizontal flux calculation
+
+    ELSE IF( horz_order == 5 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+2)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-3)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+2)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-3)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!--  modify loop bounds if open or specified
+
+      IF(degrade_xs) i_start = its
+      IF(degrade_xe) i_end   = MIN(ite,ide-1)
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+3
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-3
+      ENDIF
+
+!  compute fluxes, 5th order
+
+      j_loop_y_flux_5 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+          dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+          mu = 0.5*(mut(i,j)+mut(i,j-1))
+          vel = rv(i,k,j)
+          cr = vel*dt/dy/mu
+          fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+          fqy( i, k, j  ) = vel*flux5(                                  &
+                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
+                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
+
+          fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF  ( j == jds+2 ) THEN  ! third of 4th order flux 2 in from south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j ) = vel*flux3(              &
+                   field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i, k, j ) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-2 ) THEN  ! 3rd or 4th order flux 2 in from north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy( i, k, j) = vel*flux3(             &
+                   field(i,k,j-2),field(i,k,j-1),    &
+                   field(i,k,j),field(i,k,j+1),vel )
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ENDIF
+
+   ENDDO j_loop_y_flux_5
+
+!  next, x flux
+
+!--  these bounds are for periodic and sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds for open and specified b.c
+
+      IF(degrade_ys) j_start = jts
+      IF(degrade_ye) j_end   = MIN(jte,jde-1)
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+2
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-3
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  5th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+          mu = 0.5*(mut(i,j)+mut(i-1,j))
+          vel = ru(i,k,j)
+          cr = vel*dt/dx/mu
+          fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+          fqx( i,k,j ) = vel*flux5( field(i-3,k,j), field(i-2,k,j),  &
+                                         field(i-1,k,j), field(i  ,k,j),  &
+                                         field(i+1,k,j), field(i+2,k,j),  &
+                                         vel                             )
+          fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)/mu
+              cr = vel*dt/dx
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+              fqx(i,k,j) = 0.5*(ru(i,k,j)) &
+                     *(field(i,k,j)+field(i-1,k,j))
+
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+
+          i = ids+2
+          DO k=kts,ktf
+            dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+            mu = 0.5*(mut(i,j)+mut(i-1,j))
+            vel = ru(i,k,j)
+            cr = vel*dt/dx/mu
+            fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+            fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                     )
+            fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+          ENDDO
+
+        ENDIF
+
+        IF( degrade_xe ) THEN
+
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts,ktf
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)
+              cr = vel*dt/dx/mu
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+              fqx(i,k,j) = 0.5*(ru(i,k,j))      &
+                     *(field(i,k,j)+field(i-1,k,j))
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+
+          i = ide-2
+          DO k=kts,ktf
+
+            dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+            mu = 0.5*(mut(i,j)+mut(i-1,j))
+            vel = ru(i,k,j)
+            cr = vel*dt/dx/mu
+            fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+            fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+            fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+          ENDDO
+
+        ENDIF
+
+      ENDDO  ! enddo for outer J loop
+
+!--- end of 5th order horizontal flux calculation
+
+    ELSE IF( horz_order == 4 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!--  modify loop bounds if open or specified
+
+      IF(degrade_xs) i_start = its
+      IF(degrade_xe) i_end   = MIN(ite,ide-1)
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+2
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-2
+      ENDIF
+
+!  compute fluxes, 4th order
+
+      j_loop_y_flux_4 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+          dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+          mu = 0.5*(mut(i,j)+mut(i,j-1))
+          vel = rv(i,k,j)
+          cr = vel*dt/dy/mu
+          fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+          fqy( i, k, j  ) = vel*flux4(  field(i,k,j-2), field(i,k,j-1),       &
+                                        field(i,k,j  ), field(i,k,j+1), vel )
+
+          fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i, k, j ) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ENDIF
+
+   ENDDO j_loop_y_flux_4
+
+!  next, x flux
+
+!--  these bounds are for periodic and sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds for open and specified b.c
+
+      IF(degrade_ys) j_start = jts
+      IF(degrade_ye) j_end   = MIN(jte,jde-1)
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+          mu = 0.5*(mut(i,j)+mut(i-1,j))
+          vel = ru(i,k,j)
+          cr = vel*dt/dx/mu
+          fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+          fqx( i,k,j ) = vel*flux4( field(i-2,k,j), field(i-1,k,j), &
+                                    field(i  ,k,j), field(i+1,k,j), vel )
+          fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)/mu
+              cr = vel*dt/dx
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+              fqx(i,k,j) = 0.5*(ru(i,k,j)) &
+                     *(field(i,k,j)+field(i-1,k,j))
+
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts,ktf
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)
+              cr = vel*dt/dx/mu
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+              fqx(i,k,j) = 0.5*(ru(i,k,j))      &
+                     *(field(i,k,j)+field(i-1,k,j))
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+        ENDIF
+
+      ENDDO  ! enddo for outer J loop
+
+!--- end of 4th order horizontal flux calculation
+
+   ELSE IF( horz_order == 3 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids+1)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-2)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds+1)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-2)                ) degrade_ye = .false.
+
+!--------------- y - advection first
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+      j_start_f = j_start
+      j_end_f   = j_end+1
+
+!--  modify loop bounds if open or specified
+
+      IF(degrade_xs) i_start = its
+      IF(degrade_xe) i_end   = MIN(ite,ide-1)
+
+      IF(degrade_ys) then
+        j_start = MAX(jts,jds+1)
+        j_start_f = jds+2
+      ENDIF
+
+      IF(degrade_ye) then
+        j_end = MIN(jte,jde-2)
+        j_end_f = jde-2
+      ENDIF
+
+!  compute fluxes, 3rd order
+
+      j_loop_y_flux_3 : DO j = j_start, j_end+1
+
+      IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
+
+        DO k=kts,ktf
+        DO i = i_start, i_end
+
+          dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+          mu = 0.5*(mut(i,j)+mut(i,j-1))
+          vel = rv(i,k,j)
+          cr = vel*dt/dy/mu
+          fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+          fqy( i, k, j  ) = vel*flux3(  field(i,k,j-2), field(i,k,j-1),       &
+                                        field(i,k,j  ), field(i,k,j+1), vel )
+
+          fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ELSE IF ( j == jds+1 ) THEN   ! 2nd order flux next to south boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                     (field(i,k,j)+field(i,k,j-1))
+
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ELSE IF ( j == jde-1 ) THEN  ! 2nd order flux next to north boundary
+
+            DO k=kts,ktf
+            DO i = i_start, i_end
+
+              dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+              mu = 0.5*(mut(i,j)+mut(i,j-1))
+              vel = rv(i,k,j)
+              cr = vel*dt/dy/mu
+              fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+              fqy(i, k, j ) = 0.5*rv(i,k,j)*      &
+                     (field(i,k,j)+field(i,k,j-1))
+              fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+
+            ENDDO
+            ENDDO
+
+      ENDIF
+
+   ENDDO j_loop_y_flux_3
+
+!  next, x flux
+
+!--  these bounds are for periodic and sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      i_start_f = i_start
+      i_end_f   = i_end+1
+
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds for open and specified b.c
+
+      IF(degrade_ys) j_start = jts
+      IF(degrade_ye) j_end   = MIN(jte,jde-1)
+
+      IF(degrade_xs) then
+        i_start = MAX(ids+1,its)
+        i_start_f = i_start+1
+      ENDIF
+
+      IF(degrade_xe) then
+        i_end = MIN(ide-2,ite)
+        i_end_f = ide-2
+      ENDIF
+
+!  compute fluxes
+
+      DO j = j_start, j_end
+
+!  4th order flux
+
+        DO k=kts,ktf
+        DO i = i_start_f, i_end_f
+
+          dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+          mu = 0.5*(mut(i,j)+mut(i-1,j))
+          vel = ru(i,k,j)
+          cr = vel*dt/dx/mu
+          fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+          fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j), &
+                                    field(i  ,k,j), field(i+1,k,j), vel )
+          fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+!  lower order fluxes close to boundaries (if not periodic or symmetric)
+
+        IF( degrade_xs ) THEN
+
+          IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
+            i = ids+1
+            DO k=kts,ktf
+
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)/mu
+              cr = vel*dt/dx
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+
+              fqx(i,k,j) = 0.5*(ru(i,k,j)) &
+                     *(field(i,k,j)+field(i-1,k,j))
+
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+        ENDIF
+
+        IF( degrade_xe ) THEN
+          IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
+            i = ide-1
+            DO k=kts,ktf
+              dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+              mu = 0.5*(mut(i,j)+mut(i-1,j))
+              vel = ru(i,k,j)
+              cr = vel*dt/dx/mu
+              fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+              fqx(i,k,j) = 0.5*(ru(i,k,j))      &
+                     *(field(i,k,j)+field(i-1,k,j))
+              fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+
+            ENDDO
+          ENDIF
+        ENDIF
+
+      ENDDO  ! enddo for outer J loop
+
+!--- end of 3rd order horizontal flux calculation
+
+
+   ELSE IF( horz_order == 2 ) THEN
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xs .or. &
+       (its > ids)                ) degrade_xs = .false.
+   IF( config_flags%periodic_x   .or. &
+       config_flags%symmetric_xe .or. &
+       (ite < ide-1)                ) degrade_xe = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ys .or. &
+       (jts > jds)                ) degrade_ys = .false.
+   IF( config_flags%periodic_y   .or. &
+       config_flags%symmetric_ye .or. &
+       (jte < jde-1)                ) degrade_ye = .false.
+
+!--  y flux compute; these bounds are for periodic and sym b.c.
+
+      ktf=MIN(kte,kde-1)
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!--  modify loop bounds if open or specified
+
+      IF(degrade_xs) i_start = its
+      IF(degrade_xe) i_end   = MIN(ite,ide-1)
+      IF(degrade_ys) j_start = MAX(jts,jds+1)
+      IF(degrade_ye) j_end = MIN(jte,jde-2)
+
+!  compute fluxes, 2nd order, y flux
+
+      DO j = j_start, j_end+1
+        DO k=kts,ktf
+        DO i = i_start, i_end
+           dy = 2./(msft(i,j)+msft(i,j-1))/rdy
+           mu = 0.5*(mut(i,j)+mut(i,j-1))
+           vel = rv(i,k,j)
+           cr = vel*dt/dy/mu
+           fqyl(i,k,j) = mu*(dy/dt)*flux_upwind(field_old(i,k,j-1), field_old(i,k,j  ), cr)
+
+           fqy(i,k, j) = 0.5*rv(i,k,j)*          &
+                  (field(i,k,j)+field(i,k,j-1))
+
+           fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
+        ENDDO
+        ENDDO
+      ENDDO
+
+!  next, x flux
+
+      DO j = j_start, j_end
+        DO k=kts,ktf
+        DO i = i_start, i_end+1
+            dx = 2./(msft(i,j)+msft(i-1,j))/rdx
+            mu = 0.5*(mut(i,j)+mut(i-1,j))
+            vel = ru(i,k,j)
+            cr = vel*dt/dx/mu
+            fqxl(i,k,j) = mu*(dx/dt)*flux_upwind(field_old(i-1,k,j), field_old(i,k,j  ), cr)
+            fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j),  &
+                                          field(i  ,k,j), field(i+1,k,j),  &
+                                          vel                             )
+            fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
+        ENDDO
+        ENDDO
+      ENDDO
+
+!--- end of 3nd order horizontal flux calculation
+
+   ELSE
+
+      WRITE ( wrf_err_message , * ) 'module_advect: advect_scalar_pd, h_order not known ',horz_order
+      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
+
+   ENDIF horizontal_order_test
+
+!  pick up the rest of the horizontal radiation boundary conditions.
+!  (these are the computations that don't require 'cb'.
+!  first, set to index ranges
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+!  compute x (u) conditions for v, w, or scalar
+
+   IF( (config_flags%open_xs) .and. (its == ids) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MIN( 0.5*(ru(its,k,j)+ru(its+1,k,j)), 0. )
+         tendency(its,k,j) = tendency(its,k,j)                     &
+               - rdx*(                                             &
+                       ub*(   field_old(its+1,k,j)                 &
+                            - field_old(its  ,k,j)   ) +           &
+                       field(its,k,j)*(ru(its+1,k,j)-ru(its,k,j))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
+
+       DO j = j_start, j_end
+       DO k = kts, ktf
+         ub = MAX( 0.5*(ru(ite-1,k,j)+ru(ite,k,j)), 0. )
+         tendency(i_end,k,j) = tendency(i_end,k,j)                   &
+               - rdx*(                                               &
+                       ub*(  field_old(i_end  ,k,j)                  &
+                           - field_old(i_end-1,k,j) ) +              &
+                       field(i_end,k,j)*(ru(ite,k,j)-ru(ite-1,k,j))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MIN( 0.5*(rv(i,k,jts)+rv(i,k,jts+1)), 0. )
+         tendency(i,k,jts) = tendency(i,k,jts)                     &
+               - rdy*(                                             &
+                       vb*(  field_old(i,k,jts+1)                  &
+                           - field_old(i,k,jts  ) ) +              &
+                       field(i,k,jts)*(rv(i,k,jts+1)-rv(i,k,jts))  &
+                                                                )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+   IF( (config_flags%open_ye) .and. (jte == jde)) THEN
+
+       DO i = i_start, i_end
+       DO k = kts, ktf
+         vb = MAX( 0.5*(rv(i,k,jte-1)+rv(i,k,jte)), 0. )
+         tendency(i,k,j_end) = tendency(i,k,j_end)                   &
+               - rdy*(                                               &
+                       vb*(   field_old(i,k,j_end  )                 &
+                            - field_old(i,k,j_end-1) ) +             &
+                       field(i,k,j_end)*(rv(i,k,jte)-rv(i,k,jte-1))  &
+                                                                    )
+       ENDDO
+       ENDDO
+
+   ENDIF
+
+!-------------------- vertical advection
+
+!-- loop bounds for periodic or sym conditions
+
+      i_start = its-1
+      i_end   = MIN(ite,ide-1)+1
+      j_start = jts-1
+      j_end   = MIN(jte,jde-1)+1
+
+!-- loop bounds for open or specified conditions
+
+    IF(degrade_xs) i_start = its
+    IF(degrade_xe) i_end   = MIN(ite,ide-1)
+    IF(degrade_ys) j_start = jts
+    IF(degrade_ye) j_end   = MIN(jte,jde-1)
+
+    vert_order_test : IF (vert_order == 6) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux6( field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),      &
+                                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=kts+2
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux4(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf-1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux4(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 5) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+3,ktf-2
+         DO i = i_start, i_end
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux5( field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),      &
+                                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=kts+2
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux3(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf-1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux3(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 4) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux4(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+         ENDDO
+
+      ENDDO
+
+    ELSE IF (vert_order == 3) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+2,ktf-1
+         DO i = i_start, i_end
+
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+
+           fqz(i,k,j) = vel*flux3(                      &
+                   field(i,k-2,j), field(i,k-1,j),      &
+                   field(i,k  ,j), field(i,k+1,j),  -vel )
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+         ENDDO
+
+         DO i = i_start, i_end
+
+           k=kts+1
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+           k=ktf
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+         ENDDO
+
+      ENDDO
+
+   ELSE IF (vert_order == 2) THEN    
+
+      DO j = j_start, j_end
+
+         DO i = i_start, i_end
+           fqz(i,1,j)  = 0.
+           fqzl(i,1,j) = 0.
+           fqz(i,kde,j)  = 0.
+           fqzl(i,kde,j) = 0.
+         ENDDO
+
+         DO k=kts+1,ktf
+         DO i = i_start, i_end
+
+           dz = 2./(rdzw(k)+rdzw(k-1))
+           mu = 0.5*(mut(i,j)+mut(i,j))
+           vel = rom(i,k,j)
+           cr = vel*dt/dz/mu
+           fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
+           fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
+           fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+
+        ENDDO
+        ENDDO
+
+      ENDDO
+
+   ELSE
+
+      WRITE (wrf_err_message,*) ' advect_scalar_pd, v_order not known ',vert_order
+      CALL wrf_error_fatal ( wrf_err_message )
+
+   ENDIF vert_order_test
+
+   IF (pd_limit) THEN
+
+! positive definite filter
+
+   i_start = its-1
+   i_end   = MIN(ite,ide-1)+1
+   j_start = jts-1
+   j_end   = MIN(jte,jde-1)+1
+
+!-- loop bounds for open or specified conditions
+
+   IF(degrade_xs) i_start = its
+   IF(degrade_xe) i_end   = MIN(ite,ide-1)
+   IF(degrade_ys) j_start = jts
+   IF(degrade_ye) j_end   = MIN(jte,jde-1)
+
+   IF(config_flags%specified .or. config_flags%nested) THEN
+     IF (degrade_xs) i_start = MAX(its,ids+1)
+     IF (degrade_xe) i_end   = MIN(ite,ide-2)
+     IF (degrade_ys) j_start = MAX(jts,jds+1)
+     IF (degrade_ye) j_end   = MIN(jte,jde-2)
+   END IF
+
+   IF(config_flags%open_xs) THEN
+     IF (degrade_xs) i_start = MAX(its,ids+1)
+   END IF
+   IF(config_flags%open_xe) THEN
+     IF (degrade_xe) i_end   = MIN(ite,ide-2)
+   END IF
+   IF(config_flags%open_ys) THEN
+     IF (degrade_ys) j_start = MAX(jts,jds+1)
+   END IF
+   IF(config_flags%open_ye) THEN
+     IF (degrade_ye) j_end   = MIN(jte,jde-2)
+   END IF
+
+!-- here is the limiter...
+
+   DO j=j_start, j_end
+   DO k=kts, ktf
+   DO i=i_start, i_end
+
+     ph_low = (mub(i,j)+mu_old(i,j))*field_old(i,k,j)                   &
+                - dt*( msft(i,j)*( rdx*(fqxl(i+1,k,j)-fqxl(i,k,j))      &
+                                  +rdy*(fqyl(i,k,j+1)-fqyl(i,k,j)) )    &
+                              +rdzw(k)*(fqzl(i,k+1,j)-fqzl(i,k,j))   )  
+
+     flux_out = dt*(msft(i,j)*( rdx*(  max(0.,fqx (i+1,k,j))      &
+                                      -min(0.,fqx (i  ,k,j)) )    &
+                               +rdy*(  max(0.,fqy (i,k,j+1))      &
+                                      -min(0.,fqy (i,k,j  )) ) )  &
+                           +rdzw(k)*(  min(0.,fqz (i,k+1,j))      &
+                                      -max(0.,fqz (i,k  ,j)) )   )
+
+     IF( flux_out .gt. ph_low ) THEN
+
+       scale = max(0.,ph_low/(flux_out+eps))
+       IF( fqx (i+1,k,j) .gt. 0.) fqx(i+1,k,j) = scale*fqx(i+1,k,j)
+       IF( fqx (i  ,k,j) .lt. 0.) fqx(i  ,k,j) = scale*fqx(i  ,k,j)
+       IF( fqy (i,k,j+1) .gt. 0.) fqy(i,k,j+1) = scale*fqy(i,k,j+1)
+       IF( fqy (i,k,j  ) .lt. 0.) fqy(i,k,j  ) = scale*fqy(i,k,j  )
+!  note: z flux is opposite sign in mass coordinate because 
+!  vertical coordinate decreases with increasing k
+       IF( fqz (i,k+1,j) .lt. 0.) fqz(i,k+1,j) = scale*fqz(i,k+1,j)
+       IF( fqz (i,k  ,j) .gt. 0.) fqz(i,k  ,j) = scale*fqz(i,k  ,j)
+
+     END IF
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+   END IF
+
+! add in the pd-limited flux divergence
+
+  i_start = its
+  i_end   = MIN(ite,ide-1)
+  j_start = jts
+  j_end   = MIN(jte,jde-1)
+
+  DO j = j_start, j_end
+  DO k = kts, ktf
+  DO i = i_start, i_end
+
+     tendency (i,k,j) = tendency(i,k,j)                           &
+                            -rdzw(k)*( fqz (i,k+1,j)-fqz (i,k,j)  &
+                                      +fqzl(i,k+1,j)-fqzl(i,k,j))
+
+  ENDDO
+  ENDDO
+  ENDDO
+
+! x flux divergence
+!
+  IF(degrade_xs) i_start = i_start + 1
+  IF(degrade_xe) i_end   = i_end   - 1
+
+  DO j = j_start, j_end
+  DO k = kts, ktf
+  DO i = i_start, i_end
+
+     tendency (i,k,j) = tendency(i,k,j)                           &
+                - msft(i,j)*( rdx*( fqx (i+1,k,j)-fqx (i,k,j)     &
+                                   +fqxl(i+1,k,j)-fqxl(i,k,j))   )
+
+  ENDDO
+  ENDDO
+  ENDDO
+
+! y flux divergence
+!
+  i_start = its
+  i_end   = MIN(ite,ide-1)
+  IF(degrade_ys) j_start = j_start + 1
+  IF(degrade_ye) j_end   = j_end   - 1
+
+  DO j = j_start, j_end
+  DO k = kts, ktf
+  DO i = i_start, i_end
+
+     tendency (i,k,j) = tendency(i,k,j)                           &
+                - msft(i,j)*( rdy*( fqy (i,k,j+1)-fqy (i,k,j)     &
+                                   +fqyl(i,k,j+1)-fqyl(i,k,j))   )
+
+  ENDDO
+  ENDDO
+  ENDDO
+
+END SUBROUTINE advect_scalar_pd
+
+!----------------------------------------------------------------
+
+END MODULE module_advect_em
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_bc_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_bc_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_bc_em.F	(revision 2744)
@@ -0,0 +1,997 @@
+!WRF:MODEL_LAYER:BOUNDARY
+!
+MODULE module_bc_em
+
+   USE module_bc
+   USE module_configure
+   USE module_wrf_error
+
+CONTAINS
+
+!------------------------------------------------------------------------
+
+   SUBROUTINE spec_bdyupdate_ph( ph_save, field,      &
+                               field_tend, mu_tend, muts, dt,     &
+                               variable_in, config_flags, & 
+                               spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+!  This subroutine adds the tendencies in the boundary specified region.
+!  spec_zone is the width of the outer specified b.c.s that are set here.
+!  (JD August 2000)
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+      INTEGER,      INTENT(IN   )    :: spec_zone
+      CHARACTER,    INTENT(IN   )    :: variable_in
+      REAL,         INTENT(IN   )    :: dt
+
+
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: field_tend, ph_save
+      REAL,  DIMENSION( ims:ime , jms:jme ), INTENT(IN   ) :: mu_tend, muts
+      TYPE( grid_config_rec_type ) config_flags
+
+      CHARACTER  :: variable
+      INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
+      INTEGER    :: b_dist, b_limit
+
+!     Local array
+
+      REAL,  DIMENSION( its:ite , jts:jte ) :: mu_old
+      LOGICAL    :: periodic_x
+
+      periodic_x = config_flags%periodic_x
+
+      variable = variable_in
+
+      IF (variable == 'U') variable = 'u'
+      IF (variable == 'V') variable = 'v'
+      IF (variable == 'M') variable = 'm'
+      IF (variable == 'H') variable = 'h'
+
+      ibs = ids
+      ibe = ide-1
+      itf = min(ite,ide-1)
+      jbs = jds
+      jbe = jde-1
+      jtf = min(jte,jde-1)
+      ktf = kde-1
+      IF (variable == 'u') ibe = ide
+      IF (variable == 'u') itf = min(ite,ide)
+      IF (variable == 'v') jbe = jde
+      IF (variable == 'v') jtf = min(jte,jde)
+      IF (variable == 'm') ktf = kte
+      IF (variable == 'h') ktf = kte
+
+      IF (jts - jbs .lt. spec_zone) THEN
+! Y-start boundary
+        DO j = jts, min(jtf,jbs+spec_zone-1)
+          b_dist = j - jbs
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+
+              mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
+
+              field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
+                   dt*field_tend(i,k,j)/muts(i,j) +               &
+                   ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
+
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+      IF (jbe - jtf .lt. spec_zone) THEN 
+! Y-end boundary 
+        DO j = max(jts,jbe-spec_zone+1), jtf 
+          b_dist = jbe - j 
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf 
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+
+              mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
+
+              field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
+                   dt*field_tend(i,k,j)/muts(i,j) +               &
+                   ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
+
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+    IF(.NOT.periodic_x)THEN
+      IF (its - ibs .lt. spec_zone) THEN
+! X-start boundary
+        DO i = its, min(itf,ibs+spec_zone-1)
+          b_dist = i - ibs
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+
+              mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
+
+              field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
+                   dt*field_tend(i,k,j)/muts(i,j) +               &
+                   ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
+
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+      IF (ibe - itf .lt. spec_zone) THEN
+! X-end boundary
+        DO i = max(its,ibe-spec_zone+1), itf
+          b_dist = ibe - i
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+
+              mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
+
+              field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
+                   dt*field_tend(i,k,j)/muts(i,j) +               &
+                   ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
+
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+    ENDIF
+
+   END SUBROUTINE spec_bdyupdate_ph
+
+!------------------------------------------------------------------------
+
+   SUBROUTINE relax_bdy_dry ( config_flags,                                    &
+                              ru_tendf, rv_tendf, ph_tendf, t_tendf,           &
+                              rw_tendf, mu_tend,                               &
+                              ru, rv, ph, t,                                   &
+                              w, mu, mut,                                      &
+                              u_b, v_b, ph_b, t_b,                             &
+                              w_b, mu_b,                                       &
+                              u_bt, v_bt, ph_bt, t_bt,                         &
+                              w_bt, mu_bt,                                     &
+                              spec_bdy_width, spec_zone, relax_zone,           &
+                              dtbc, fcx, gcx,             &
+                              ijds, ijde,                 & ! min/max(id,jd)
+                              ids,ide, jds,jde, kds,kde,  & ! domain dims
+                              ims,ime, jms,jme, kms,kme,  & ! memory dims
+                              ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                              its, ite, jts, jte, kts, kte)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE( grid_config_rec_type ) config_flags
+
+   INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            ips, ipe, jps, jpe, kps, kpe, & 
+                                            its, ite, jts, jte, kts, kte
+   INTEGER ,               INTENT(IN   ) :: ijds, ijde
+   INTEGER ,               INTENT(IN   ) :: spec_bdy_width, spec_zone, relax_zone
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(IN   ) :: ru,     &
+                                                                      rv,     &
+                                                                      ph,     &
+                                                                      w,      &
+                                                                      t
+   REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(IN   )          :: mu  , &
+                                                                      mut
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) :: ru_tendf, &
+                                                                      rv_tendf, &
+                                                                      ph_tendf, &
+                                                                      rw_tendf, &
+                                                                      t_tendf
+   REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(INOUT)          :: mu_tend
+   REAL , DIMENSION( spec_bdy_width) , INTENT(IN   ) :: fcx, gcx
+
+   REAL,  DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN   ) :: u_b, &
+                                                                                 v_b, &
+                                                                                 ph_b, &
+                                                                                  w_b, &
+                                                                                 t_b, &
+                                                                                 u_bt, &
+                                                                                 v_bt, &
+                                                                                 ph_bt, &
+                                                                                  w_bt, &
+                                                                                 t_bt
+
+   REAL,  DIMENSION( ijds:ijde , 1:1     , spec_bdy_width, 4 ), INTENT(IN   ) :: mu_b, &
+                                                                                 mu_bt
+   REAL, INTENT(IN   ) :: dtbc
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) :: rfield
+   INTEGER :: i_start, i_end, j_start, j_end, i, j, k
+
+           CALL relax_bdytend ( ru, ru_tendf,             &
+                               u_b, u_bt,       &
+                               'u'        , config_flags, &
+                               spec_bdy_width, spec_zone, relax_zone, &
+                               dtbc, fcx, gcx,             &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+           CALL relax_bdytend ( rv, rv_tendf,             &
+                               v_b, v_bt,       &
+                               'v'        , config_flags, &
+                               spec_bdy_width, spec_zone, relax_zone, &
+                               dtbc, fcx, gcx,             &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+! rfield will be calculated beyond tile limits because relax_bdytend
+!   requires a 5-point stencil, and this avoids need for inter-tile/patch 
+!   communication here
+           i_start = max(its-1, ids)
+           i_end = min(ite+1, ide-1)
+           j_start = max(jts-1, jds)
+           j_end = min(jte+1, jde-1)
+
+           DO j=j_start,j_end
+           DO k=kts,kte
+           DO i=i_start,i_end
+              rfield(i,k,j) = ph(i,k,j)*mut(i,j)
+           ENDDO
+           ENDDO
+           ENDDO
+           
+           CALL relax_bdytend ( rfield, ph_tendf,             &
+                               ph_b, ph_bt,       &
+                               'h'        , config_flags, &
+                               spec_bdy_width, spec_zone, relax_zone, &
+                               dtbc, fcx, gcx,             &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+           DO j=j_start,j_end
+           DO k=kts,kte-1
+           DO i=i_start,i_end
+              rfield(i,k,j) = t(i,k,j)*mut(i,j)
+           ENDDO
+           ENDDO
+           ENDDO
+           CALL relax_bdytend ( rfield, t_tendf,              &
+                               t_b, t_bt,       &
+                               't'        , config_flags, &
+                               spec_bdy_width, spec_zone, relax_zone, &
+                               dtbc, fcx, gcx,             &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+           CALL relax_bdytend ( mu, mu_tend,               &
+                               mu_b, mu_bt,                &
+                               'm'        , config_flags,  &
+                               spec_bdy_width, spec_zone, relax_zone, &
+                               dtbc, fcx, gcx,             &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
+                               ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
+                               ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
+                               its,ite, jts,jte, 1  ,1   )
+
+         IF( config_flags%nested) THEN
+
+           i_start = max(its-1, ids)
+           i_end = min(ite+1, ide-1)
+           j_start = max(jts-1, jds)
+           j_end = min(jte+1, jde-1)
+
+           DO j=j_start,j_end
+           DO k=kts,kte
+           DO i=i_start,i_end
+              rfield(i,k,j) = w(i,k,j)*mut(i,j)
+           ENDDO
+           ENDDO
+           ENDDO
+           
+           CALL relax_bdytend ( rfield, rw_tendf,             &
+                               w_b, w_bt,       &
+                               'h'        , config_flags, &
+                               spec_bdy_width, spec_zone, relax_zone, &
+                               dtbc, fcx, gcx,             &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+        END IF
+
+   END SUBROUTINE relax_bdy_dry 
+!------------------------------------------------------------------------
+   SUBROUTINE relax_bdy_scalar ( scalar_tend,                &
+                                 scalar, mu,                 &
+                                 scalar_b, scalar_bt,        &
+                                 spec_bdy_width, spec_zone, relax_zone,       &
+                                 dtbc, fcx, gcx,             &
+                                 config_flags,               &
+                                 ijds, ijde,                 & ! min/max(id,jd)
+                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                 its, ite, jts, jte, kts, kte)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE( grid_config_rec_type ) config_flags
+
+   INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            ips, ipe, jps, jpe, kps, kpe, & 
+                                            its, ite, jts, jte, kts, kte
+   INTEGER ,               INTENT(IN   ) :: ijds, ijde
+   INTEGER ,               INTENT(IN   ) :: spec_bdy_width, spec_zone, relax_zone
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(IN   ) :: scalar
+   REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(IN   ) :: mu
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) :: scalar_tend
+   REAL , DIMENSION( spec_bdy_width) , INTENT(IN   ) :: fcx, gcx
+
+   REAL,  DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN   ) :: scalar_b, &
+                                                                                 scalar_bt
+   REAL, INTENT(IN   ) :: dtbc
+!Local
+   INTEGER :: i,j,k, i_start, i_end, j_start, j_end
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) :: rscalar
+
+! rscalar will be calculated beyond tile limits because relax_bdytend
+!   requires a 5-point stencil, and this avoids need for inter-tile/patch 
+!   communication here
+           i_start = max(its-1, ids)
+           i_end = min(ite+1, ide-1)
+           j_start = max(jts-1, jds)
+           j_end = min(jte+1, jde-1)
+
+           DO j=j_start,j_end
+           DO k=kts,min(kte,kde-1)
+           DO i=i_start,i_end
+              rscalar(i,k,j) = scalar(i,k,j)*mu(i,j)
+           ENDDO
+           ENDDO
+           ENDDO
+
+           CALL relax_bdytend (rscalar, scalar_tend,             &
+                               scalar_b, scalar_bt,       &
+                               'q'        , config_flags, &
+                               spec_bdy_width, spec_zone, relax_zone, &
+                               dtbc, fcx, gcx,             &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+
+   END SUBROUTINE relax_bdy_scalar 
+
+!------------------------------------------------------------------------
+   SUBROUTINE spec_bdy_dry ( config_flags,                        &
+                             ru_tend, rv_tend, ph_tend, t_tend,   &
+                             rw_tend, mu_tend,                    &
+                             u_b, v_b, ph_b, t_b,                 &
+                             w_b, mu_b,                           &
+                             u_bt, v_bt, ph_bt, t_bt,             &
+                             w_bt, mu_bt,                         &
+                             spec_bdy_width, spec_zone,           &
+                             ijds, ijde,                 & ! min/max(id,jd)
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             its, ite, jts, jte, kts, kte)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE( grid_config_rec_type ) config_flags
+
+
+   INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            ips, ipe, jps, jpe, kps, kpe, & 
+                                            its, ite, jts, jte, kts, kte
+   INTEGER ,               INTENT(IN   ) :: ijds, ijde
+   INTEGER ,               INTENT(IN   ) :: spec_bdy_width, spec_zone
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(OUT  ) :: ru_tend, &
+                                                                      rv_tend, &
+                                                                      ph_tend, &
+                                                                      rw_tend, &
+                                                                      t_tend
+   REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(OUT  )          :: mu_tend
+   REAL,  DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN   ) :: u_b,  &
+                                                                                 v_b,  &
+                                                                                 ph_b, &
+                                                                                  w_b, &
+                                                                                 t_b,  &
+                                                                                 u_bt, &
+                                                                                 v_bt, &
+                                                                                ph_bt, &
+                                                                                 w_bt, &
+                                                                                 t_bt
+
+   REAL,  DIMENSION( ijds:ijde , 1:1 ,     spec_bdy_width, 4 ), INTENT(IN   ) :: mu_b, &
+                                                                                 mu_bt
+
+         CALL spec_bdytend (   ru_tend,                &
+                               u_b, u_bt,    &
+                               'u'     , config_flags, &
+                               spec_bdy_width, spec_zone, &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+         CALL spec_bdytend (   rv_tend,                &
+                               v_b, v_bt,    &
+                               'v'     , config_flags, &
+                               spec_bdy_width, spec_zone, &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+         CALL spec_bdytend (   ph_tend,                &
+                               ph_b, ph_bt,    &
+                               'h'     , config_flags, &
+                               spec_bdy_width, spec_zone, &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+         CALL spec_bdytend (   t_tend,                &
+                               t_b, t_bt,    &
+                               't'     , config_flags, &
+                               spec_bdy_width, spec_zone, &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+         CALL spec_bdytend (   mu_tend,                &
+                               mu_b, mu_bt,       &
+                               'm'     , config_flags, &
+                               spec_bdy_width, spec_zone, &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
+                               ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
+                               ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
+                               its,ite, jts,jte, 1  ,1   )
+
+         if(config_flags%nested)                           &
+         CALL spec_bdytend (   rw_tend,                    &
+                               w_b, w_bt,                  &
+                               'h'     , config_flags,     &
+                               spec_bdy_width, spec_zone,  &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+   END SUBROUTINE spec_bdy_dry 
+
+!------------------------------------------------------------------------
+   SUBROUTINE spec_bdy_scalar ( scalar_tend,    &
+                                scalar_b, scalar_bt,             &
+                          spec_bdy_width, spec_zone,                   &
+                          config_flags,               &
+                          ijds, ijde,                 & ! min/max(id,jd)
+                          ids,ide, jds,jde, kds,kde,  & ! domain dims
+                          ims,ime, jms,jme, kms,kme,  & ! memory dims
+                          ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                          its, ite, jts, jte, kts, kte)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE( grid_config_rec_type ) config_flags
+
+
+   INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            ips, ipe, jps, jpe, kps, kpe, & 
+                                            its, ite, jts, jte, kts, kte
+   INTEGER ,               INTENT(IN   ) :: ijds, ijde
+   INTEGER ,               INTENT(IN   ) :: spec_bdy_width, spec_zone
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(OUT  ) :: scalar_tend
+   REAL,  DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN   ) :: scalar_b, &
+                                                                                 scalar_bt
+!Local
+   INTEGER :: i,j,k
+
+
+         CALL spec_bdytend (   scalar_tend,                &
+                               scalar_b, scalar_bt,    &
+!                              scalar_xbdy, scalar_ybdy,       &
+                               'q'     , config_flags, &
+                               spec_bdy_width, spec_zone, &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+
+   END SUBROUTINE spec_bdy_scalar 
+
+!------------------------------------------------------------------------
+
+   SUBROUTINE set_phys_bc_dry_1( config_flags, u_1, u_2, v_1, v_2,   &
+                                 rw_1, rw_2, w_1, w_2,           &
+                                 t_1, t_2, tp_1, tp_2, pp, pip,  &
+                                 ids,ide, jds,jde, kds,kde,      &
+                                 ims,ime, jms,jme, kms,kme,      &
+                                 ips,ipe, jps,jpe, kps,kpe,      &
+                                 its,ite, jts,jte, kts,kte      )
+
+!
+!  this is just a wraper to call the boundary condition routines
+!  for each variable
+!
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+      TYPE( grid_config_rec_type ) config_flags
+
+      REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
+           u_1,u_2, v_1, v_2, rw_1, rw_2, w_1, w_2,                  &
+           t_1, t_2, tp_1, tp_2, pp, pip
+
+
+
+      CALL set_physical_bc3d( u_1  , 'u', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( u_2  , 'u', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( v_1  , 'v', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( v_2  , 'v', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( rw_1 , 'w', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( rw_2 , 'w', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( w_1  , 'w', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( w_2  , 'w', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( t_1, 'p', config_flags,                 &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( t_2, 'p', config_flags,                 &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( tp_1, 'p', config_flags,                &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( tp_2, 'p', config_flags,                &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( pp , 'p', config_flags,                 &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( pip , 'p', config_flags,                &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+
+  END SUBROUTINE set_phys_bc_dry_1
+
+!--------------------------------------------------------------
+
+   SUBROUTINE set_phys_bc_dry_2( config_flags,                     &
+                                 u_1, u_2, v_1, v_2, w_1, w_2,     &
+                                 t_1, t_2, ph_1, ph_2, mu_1, mu_2, &
+                                 ids,ide, jds,jde, kds,kde,        &
+                                 ims,ime, jms,jme, kms,kme,        &
+                                 ips,ipe, jps,jpe, kps,kpe,        &
+                                 its,ite, jts,jte, kts,kte        )
+
+!
+!  this is just a wraper to call the boundary condition routines
+!  for each variable
+!
+
+      IMPLICIT NONE
+
+      TYPE( grid_config_rec_type ) config_flags
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+      REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
+         u_1, u_2, v_1, v_2, w_1, w_2,                       &
+         t_1, t_2, ph_1, ph_2
+
+      REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
+                             mu_1, mu_2
+
+
+      CALL set_physical_bc3d( u_1, 'U', config_flags,           &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc3d( u_2, 'U', config_flags,           &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc3d( v_1 , 'V', config_flags,          &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( v_2 , 'V', config_flags,          &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc3d( w_1, 'w', config_flags,           &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( w_2, 'w', config_flags,           &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc3d( t_1, 'p', config_flags,           &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc3d( t_2, 'p', config_flags,           &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc3d( ph_1 , 'w', config_flags,         &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc3d( ph_2 , 'w', config_flags,         &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc2d( mu_1, 't', config_flags, &
+                              ids, ide, jds, jde,  &
+                              ims, ime, jms, jme,  &
+                              ips, ipe, jps, jpe,  &
+                              its, ite, jts, jte  )
+
+      CALL set_physical_bc2d( mu_2, 't', config_flags, &
+                              ids, ide, jds, jde,  &
+                              ims, ime, jms, jme,  &
+                              ips, ipe, jps, jpe,  &
+                              its, ite, jts, jte  )
+
+   END SUBROUTINE set_phys_bc_dry_2
+
+!------------------------------------------------------------------------
+
+   SUBROUTINE set_phys_bc_smallstep_1( config_flags, ru_1, du, rv_1, dv,   &
+                                       ids,ide, jds,jde, kds,kde,      &
+                                       ims,ime, jms,jme, kms,kme,      &
+                                       ips,ipe, jps,jpe, kps,kpe,      &
+                                       its,ite, jts,jte, kts,kte      )
+
+!
+!  this is just a wraper to call the boundary condition routines
+!  for each variable
+!
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+      TYPE( grid_config_rec_type ) config_flags
+
+      REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
+           ru_1,du, rv_1, dv
+
+      CALL set_physical_bc3d( ru_1  , 'u', config_flags,              &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kde )
+      CALL set_physical_bc3d( du , 'u', config_flags,                 &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kde )
+      CALL set_physical_bc3d( rv_1  , 'v', config_flags,              &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kde )
+      CALL set_physical_bc3d( dv  , 'v', config_flags,                &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kde )
+
+  END SUBROUTINE set_phys_bc_smallstep_1
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE rk_phys_bc_dry_1( config_flags, u, v, rw, w,  &
+                                muu, muv, mut, php, alt, p, &
+                                ids,ide, jds,jde, kds,kde,  &
+                                ims,ime, jms,jme, kms,kme,  &
+                                ips,ipe, jps,jpe, kps,kpe,  &
+                                its,ite, jts,jte, kts,kte  )
+
+!
+!  this is just a wraper to call the boundary condition routines
+!  for each variable
+!
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+      TYPE( grid_config_rec_type ) config_flags
+
+      REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                    &
+                                INTENT(INOUT) ::  u, v, rw, w, php, alt, p
+      REAL, DIMENSION( ims:ime, jms:jme ),                             &
+                                INTENT(INOUT) ::    muu, muv, mut
+
+      CALL set_physical_bc3d( u  , 'u', config_flags,             &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( v  , 'v', config_flags,             &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d(rw , 'w', config_flags,              &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( w , 'w', config_flags,              &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( php , 'w', config_flags,            &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( alt, 't', config_flags,             &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc3d( p, 'p', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc2d( muu, 'u', config_flags,  &
+                              ids, ide, jds, jde,      &
+                              ims, ime, jms, jme,      &
+                              ips, ipe, jps, jpe,      &
+                              its, ite, jts, jte  )
+
+      CALL set_physical_bc2d( muv, 'v', config_flags,  &
+                              ids, ide, jds, jde,      &
+                              ims, ime, jms, jme,      &
+                              ips, ipe, jps, jpe,      &
+                              its, ite, jts, jte  )
+
+      CALL set_physical_bc2d( mut, 't', config_flags,  &
+                              ids, ide, jds, jde,      &
+                              ims, ime, jms, jme,      &
+                              ips, ipe, jps, jpe,      &
+                              its, ite, jts, jte  )
+
+  END SUBROUTINE rk_phys_bc_dry_1
+
+!------------------------------------------------------------------------
+
+  SUBROUTINE rk_phys_bc_dry_2( config_flags, u, v, w,      &
+                               t, ph, mu,                  &
+                               ids,ide, jds,jde, kds,kde,  &
+                               ims,ime, jms,jme, kms,kme,  &
+                               ips,ipe, jps,jpe, kps,kpe,  &
+                               its,ite, jts,jte, kts,kte  )
+
+!
+!  this is just a wraper to call the boundary condition routines
+!  for each variable
+!
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+      TYPE( grid_config_rec_type ) config_flags
+
+      REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
+                             u, v, w, t, ph
+
+      REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
+                             mu
+
+      CALL set_physical_bc3d( u   , 'U', config_flags,            &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( v   , 'V', config_flags,            &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( w  , 'w', config_flags,             &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( t, 'p', config_flags,               &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+      CALL set_physical_bc3d( ph  , 'w', config_flags,            &
+                              ids, ide, jds, jde, kds, kde,       &
+                              ims, ime, jms, jme, kms, kme,       &
+                              ips, ipe, jps, jpe, kps, kpe,       &
+                              its, ite, jts, jte, kts, kte )
+
+      CALL set_physical_bc2d( mu, 't', config_flags, &
+                              ids, ide, jds, jde,    &
+                              ims, ime, jms, jme,    &
+                              ips, ipe, jps, jpe,    &
+                              its, ite, jts, jte    )
+
+  END SUBROUTINE rk_phys_bc_dry_2
+
+!---------------------------------------------------------------------
+
+  SUBROUTINE set_w_surface( config_flags,                                &
+                            w, ht, u, v, cf1, cf2, cf3, rdx, rdy, msft,  &
+                            ids, ide, jds, jde, kds, kde,                &
+                            ips, ipe, jps, jpe, kps, kpe,                &
+                            its, ite, jts, jte, kts, kte,                &
+                            ims, ime, jms, jme, kms, kme                )
+  implicit none
+
+  TYPE( grid_config_rec_type ) config_flags
+
+  INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   ips, ipe, jps, jpe, kps, kpe
+
+   REAL :: cf1, cf2, cf3, rdx, rdy
+
+
+   REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
+                                               INTENT(IN   ) ::  u,       &
+                                                                 v
+
+   REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
+                                               INTENT(INOUT) ::  w
+
+   REAL , DIMENSION(  ims:ime , jms:jme ) , INTENT(IN   ) ::  ht, msft
+
+   INTEGER :: i,j
+   INTEGER :: ip1,im1,jp1,jm1
+
+!  set kinematic lower boundary condition on W
+
+     DO j = jts,min(jte,jde-1)
+       jm1 = max(j-1,jds)
+       jp1 = min(j+1,jde-1)
+     DO i = its,min(ite,ide-1)
+       im1 = max(i-1,ids)
+       ip1 = min(i+1,ide-1)
+
+         w(i,1,j)=  msft(i,j)*(                            &
+                  .5*rdy*(                                   &
+                           (ht(i,jp1)-ht(i,j  ))             &
+          *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1))    &
+                          +(ht(i,j  )-ht(i,jm1))             &
+          *(cf1*v(i,1,j  )+cf2*v(i,2,j  )+cf3*v(i,3,j  ))  ) &
+                 +.5*rdx*(                                   &
+                           (ht(ip1,j)-ht(i,j  ))             &
+          *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j))    &
+                          +(ht(i  ,j)-ht(im1,j))             &
+          *(cf1*u(i  ,1,j)+cf2*u(i  ,2,j)+cf3*u(i  ,3,j))  ) &
+                                                            )
+      ENDDO
+      ENDDO
+
+  END SUBROUTINE set_w_surface
+
+END MODULE module_bc_em
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_big_step_utilities_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_big_step_utilities_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_big_step_utilities_em.F	(revision 2744)
@@ -0,0 +1,5228 @@
+!WRF:MODEL_LAYER:DYNAMICS
+!
+
+#if (RWORDSIZE == 4)
+#   define VPOWX vspowx
+#   define VPOW  vspow
+#else
+#   define VPOWX vpowx
+#   define VPOW  vpow
+#endif
+
+
+MODULE module_big_step_utilities_em
+
+   USE module_domain
+   USE module_model_constants
+   USE module_state_description
+   USE module_configure
+   USE module_wrf_error
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE calc_mu_uv ( config_flags,                 &
+                        mu, mub, muu, muv,            &
+                        ids, ide, jds, jde, kds, kde, &
+                        ims, ime, jms, jme, kms, kme, &
+                        its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(  OUT) :: muu, muv
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu, mub
+
+   !  local stuff
+
+   INTEGER :: i, j, itf, jtf, im, jm
+
+!<DESCRIPTION>
+!
+!  calc_mu_uv calculates the full column dry-air mass at the staggered
+!  horizontal velocity points (u,v) and places the results in muu and muv.
+!  This routine uses the reference state (mub) and perturbation state (mu)
+!
+!</DESCRIPTION>
+
+
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      IF      ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         im = its
+         if(config_flags%periodic_x) im = its-1
+         DO j=jts,jtf
+!            muu(i,j) =      mu(i,j)          +mub(i,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+            muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j))
+         ENDDO
+      ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=ite
+         im = ite-1
+         if(config_flags%periodic_x) im = ite
+         DO j=jts,jtf
+!            muu(i,j) =      mu(i-1,j)        +mub(i-1,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+            muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j))
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         im = its
+         if(config_flags%periodic_x) im = its-1
+         DO j=jts,jtf
+!            muu(i,j) =      mu(i,j)          +mub(i,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+            muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j))
+         ENDDO
+         i=ite
+         im = ite-1
+         if(config_flags%periodic_x) im = ite
+         DO j=jts,jtf
+!            muu(i,j) =      mu(i-1,j)        +mub(i-1,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+            muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j))
+         ENDDO
+      END IF
+
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      IF      ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts+1,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         jm = jts
+         if(config_flags%periodic_y) jm = jts-1
+         DO i=its,itf
+!             muv(i,j) =      mu(i,j)          +mub(i,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm))
+         ENDDO
+      ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jte
+         jm = jte-1
+         if(config_flags%periodic_y) jm = jte
+         DO i=its,itf
+             muv(i,j) =      mu(i,j-1)        +mub(i,j-1)
+!  fix for periodic b.c., 13 march 2004, wcs
+             muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm))
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts+1,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         jm = jts
+         if(config_flags%periodic_y) jm = jts-1
+         DO i=its,itf
+!             muv(i,j) =      mu(i,j)          +mub(i,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm))
+         ENDDO
+         j=jte
+         jm = jte-1
+         if(config_flags%periodic_y) jm = jte
+         DO i=its,itf
+!             muv(i,j) =      mu(i,j-1)        +mub(i,j-1)
+!  fix for periodic b.c., 13 march 2004, wcs
+             muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm))
+         ENDDO
+      END IF
+
+END SUBROUTINE calc_mu_uv
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE calc_mu_uv_1 ( config_flags,                 &
+                          mu, muu, muv,                 &
+                          ids, ide, jds, jde, kds, kde, &
+                          ims, ime, jms, jme, kms, kme, &
+                          its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(  OUT) :: muu, muv
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu
+
+   !  local stuff
+
+   INTEGER :: i, j, itf, jtf, im, jm
+
+!<DESCRIPTION>
+!
+!  calc_mu_uv calculates the full column dry-air mass at the staggered
+!  horizontal velocity points (u,v) and places the results in muu and muv.
+!  This routine uses the full state (mu)
+!
+!</DESCRIPTION>
+   
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      IF      ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         im = its
+         if(config_flags%periodic_x) im = its-1
+         DO j=jts,jtf
+            muu(i,j) = 0.5*(mu(i,j)+mu(im,j))
+         ENDDO
+      ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
+         ENDDO
+         ENDDO
+         i=ite
+         im = ite-1
+         if(config_flags%periodic_x) im = ite
+         DO j=jts,jtf
+            muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j))
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         im = its
+         if(config_flags%periodic_x) im = its-1
+         DO j=jts,jtf
+            muu(i,j) = 0.5*(mu(i,j)+mu(im,j))
+         ENDDO
+         i=ite
+         im = ite-1
+         if(config_flags%periodic_x) im = ite
+         DO j=jts,jtf
+            muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j))
+         ENDDO
+      END IF
+
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      IF      ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts+1,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         jm = jts
+         if(config_flags%periodic_y) jm = jts-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,jm))
+         ENDDO
+      ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
+         ENDDO
+         ENDDO
+         j=jte
+         jm = jte-1
+         if(config_flags%periodic_y) jm = jte
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm))
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts+1,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         jm = jts
+         if(config_flags%periodic_y) jm = jts-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,jm))
+         ENDDO
+         j=jte
+         jm = jte-1
+         if(config_flags%periodic_y) jm = jte
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm))
+         ENDDO
+      END IF
+
+END SUBROUTINE calc_mu_uv_1
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE couple_momentum ( muu, ru, u, msfu,              &
+                             muv, rv, v, msfv,              &
+                             mut, rw, w, msft,              &
+                             ids, ide, jds, jde, kds, kde,  &
+                             ims, ime, jms, jme, kms, kme,  &
+                             its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+   INTEGER ,             INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                          ims, ime, jms, jme, kms, kme, &
+                                          its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(  OUT) :: ru, rv, rw
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: muu, muv, mut
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: msfu, msfv, msft
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: u, v, w
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   
+!<DESCRIPTION>
+!
+! couple_momentum couples the velocities to the full column mass and
+! the map factors.
+!
+!</DESCRIPTION>
+
+   ktf=MIN(kte,kde-1)
+   
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         ru(i,k,j)=u(i,k,j)*muu(i,j)/msfu(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+           rv(i,k,j)=v(i,k,j)*muv(i,j)/msfv(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+
+      DO j=jts,jtf
+      DO k=kts,kte
+      DO i=its,itf
+         rw(i,k,j)=w(i,k,j)*mut(i,j)/msft(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE couple_momentum
+
+!-------------------------------------------------------------------
+
+SUBROUTINE calc_mu_staggered ( mu, mub, muu, muv,            &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(  OUT) :: muu, muv
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu, mub
+
+   !  local stuff
+
+   INTEGER :: i, j, itf, jtf
+
+!<DESCRIPTION>
+!
+! calc_mu_staggered calculates the full dry air mass at the staggered
+! velocity points (u,v).
+!
+!</DESCRIPTION>
+   
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      IF      ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         DO j=jts,jtf
+            muu(i,j) =      mu(i,j)          +mub(i,j)
+         ENDDO
+      ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=ite
+         DO j=jts,jtf
+            muu(i,j) =      mu(i-1,j)        +mub(i-1,j)
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         DO j=jts,jtf
+            muu(i,j) =      mu(i,j)          +mub(i,j)
+         ENDDO
+         i=ite
+         DO j=jts,jtf
+            muu(i,j) =      mu(i-1,j)        +mub(i-1,j)
+         ENDDO
+      END IF
+
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      IF      ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts+1,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         DO i=its,itf
+             muv(i,j) =      mu(i,j)          +mub(i,j)
+         ENDDO
+      ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jte
+         DO i=its,itf
+             muv(i,j) =      mu(i,j-1)        +mub(i,j-1)
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts+1,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         DO i=its,itf
+             muv(i,j) =      mu(i,j)          +mub(i,j)
+         ENDDO
+         j=jte
+         DO i=its,itf
+             muv(i,j) =      mu(i,j-1)        +mub(i,j-1)
+         ENDDO
+      END IF
+
+END SUBROUTINE calc_mu_staggered
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE couple ( mu, mub, rfield, field, name, &
+                    msf,                          &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+   INTEGER ,             INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                          ims, ime, jms, jme, kms, kme, &
+                                          its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,     INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(  OUT) :: rfield
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu, mub, msf
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   REAL , DIMENSION(ims:ime,jms:jme) :: muu , muv
+
+!<DESCRIPTION>
+!
+! subroutine couple couples the input variable with the dry-air 
+! column mass (mu).  
+!
+!</DESCRIPTION>
+
+   
+   ktf=MIN(kte,kde-1)
+   
+   IF (name .EQ. 'u')THEN
+
+      CALL calc_mu_staggered ( mu, mub, muu, muv,            &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte )
+
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         rfield(i,k,j)=field(i,k,j)*muu(i,j)/msf(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'v')THEN
+
+      CALL calc_mu_staggered ( mu, mub, muu, muv,            &
+                               ids, ide, jds, jde, kds, kde, &
+                               ims, ime, jms, jme, kms, kme, &
+                               its, ite, jts, jte, kts, kte )
+
+      itf=ite
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+           rfield(i,k,j)=field(i,k,j)*muv(i,j)/msf(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'w')THEN
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      DO j=jts,jtf
+      DO k=kts,kte
+      DO i=its,itf
+         rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j))/msf(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'h')THEN
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      DO j=jts,jtf
+      DO k=kts,kte
+      DO i=its,itf
+         rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j))
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE 
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j))
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ENDIF
+
+END SUBROUTINE couple
+
+!-----------------------------------------------------------------------
+
+SUBROUTINE calc_ww ( mu, ru, rv, ww,               &
+                     rdx, rdy, msft, dnw,          &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+
+   INTEGER ,                                   INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                                                ims, ime, jms, jme, kms, kme, &
+                                                                its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: ru, rv
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu, msft
+   REAL , DIMENSION( kms:kme ) , INTENT(IN   ) :: dnw
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT  ) :: ww
+   REAL , INTENT(IN   )  :: rdx, rdy
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   REAL , DIMENSION( its:ite ) :: dmdt
+
+!<DESCRIPTION>
+!
+!  calc_ww calculates omega using the mass-coupled velocities mu*u, mu*v.
+!  The algorithm integrates the continuity equation through the column
+!  followed by a diagnosis of omega.
+!
+!</DESCRIPTION>
+
+
+    jtf=MIN(jte,jde-1)
+    ktf=MIN(kte,kde-1)  
+    itf=MIN(ite,ide-1)
+
+      DO j=jts,jtf
+
+        DO i=its,ite
+          dmdt(i) = 0.
+          ww(i,1,j) = 0.
+          ww(i,kte,j) = 0.
+        ENDDO
+
+!!        DO k=kts,ktf+1
+
+        DO k=kts,ktf
+        DO i=its,itf
+
+          dmdt(i) = dmdt(i) + dnw(k)* ( rdx*(ru(i+1,k,j)-ru(i,k,j))  &
+                                       +rdy*(rv(i,k,j+1)-rv(i,k,j))   )
+
+        ENDDO
+        ENDDO
+
+!               DO K=2,NZ-1
+!                  ww(K,I)=ww(K-1,I)-DNW(K-1)*
+!     &                  (DMDT+RDX*( xmu(i  )*u(K,I  ) 
+!     &                             -xmu(im1)*u(k,im1)) )
+!               END DO
+
+        DO k=2,ktf
+        DO i=its,itf
+
+           ww(i,k,j)=ww(i,k-1,j)                                       &
+                        - dnw(k-1)* ( dmdt(i)                          &
+                                     +rdx*(ru(i+1,k-1,j)-ru(i,k-1,j))  &
+                                     +rdy*(rv(i,k-1,j+1)-rv(i,k-1,j)) )
+        ENDDO
+        ENDDO
+     ENDDO
+
+END SUBROUTINE calc_ww
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE calc_ww_cp ( u, v, mup, mub, ww,              &
+                        rdx, rdy, msft, msfu, msfv, dnw, &
+                        ids, ide, jds, jde, kds, kde,    &
+                        ims, ime, jms, jme, kms, kme,    &
+                        its, ite, jts, jte, kts, kte    )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: u, v
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mup, mub, &
+                                                            msft, msfu, msfv
+   REAL , DIMENSION( kms:kme ) , INTENT(IN   ) :: dnw
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT  ) :: ww
+   REAL , INTENT(IN   )  :: rdx, rdy
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   REAL , DIMENSION( its:ite ) :: dmdt
+   REAL , DIMENSION( its:ite, kts:kte ) :: divv
+   REAL , DIMENSION( its:ite+1, jts:jte+1 ) :: muu, muv
+
+!<DESCRIPTION>
+!
+!  calc_ww calculates omega using the velocities (u,v) and the dry-air 
+!  column mass (mup+mub).
+!  The algorithm integrates the continuity equation through the column
+!  followed by a diagnosis of omega.
+!
+!</DESCRIPTION>
+
+!<DESCRIPTION>
+!
+!  calc_ww_cp calculates omega using the velocities (u,v) and the 
+!  column mass mu.
+!
+!</DESCRIPTION>
+
+    jtf=MIN(jte,jde-1)
+    ktf=MIN(kte,kde-1)  
+    itf=MIN(ite,ide-1)
+
+!  mu coupled with the appropriate map factor
+
+      DO j=jts,jtf
+      DO i=its,min(ite+1,ide)
+        muu(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i-1,j)+mub(i-1,j))/msfu(i,j)
+      ENDDO
+      ENDDO
+
+      DO j=jts,min(jte+1,jde)
+      DO i=its,itf
+        muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))/msfv(i,j)
+      ENDDO
+      ENDDO
+
+      DO j=jts,jtf
+
+        DO i=its,ite
+          dmdt(i) = 0.
+          ww(i,1,j) = 0.
+          ww(i,kte,j) = 0.
+        ENDDO
+
+        DO k=kts,ktf
+        DO i=its,itf
+
+          divv(i,k) = msft(i,j)*dnw(k)*( rdx*(muu(i+1,j)*u(i+1,k,j)-muu(i,j)*u(i,k,j))  &
+                                        +rdy*(muv(i,j+1)*v(i,k,j+1)-muv(i,j)*v(i,k,j))   )
+
+!          dmdt(i) = dmdt(i) + dnw(k)* ( rdx*(ru(i+1,k,j)-ru(i,k,j))  &
+!                                       +rdy*(rv(i,k,j+1)-rv(i,k,j))   )
+
+          dmdt(i) = dmdt(i) + divv(i,k)
+
+
+        ENDDO
+        ENDDO
+
+        DO k=2,ktf
+        DO i=its,itf
+
+!           ww(i,k,j)=ww(i,k-1,j)                                       &
+!                        - dnw(k-1)* ( dmdt(i)                          &
+!                                     +rdx*(ru(i+1,k-1,j)-ru(i,k-1,j))  &
+!                                     +rdy*(rv(i,k-1,j+1)-rv(i,k-1,j)) )
+
+           ww(i,k,j)=ww(i,k-1,j) - dnw(k-1)*dmdt(i) - divv(i,k-1)
+
+        ENDDO
+        ENDDO
+     ENDDO
+
+
+END SUBROUTINE calc_ww_cp
+
+
+!-------------------------------------------------------------------------------
+ 
+SUBROUTINE calc_cq ( moist, cqu, cqv, cqw, n_moist, &
+                     ids, ide, jds, jde, kds, kde,  &
+                     ims, ime, jms, jme, kms, kme,  &
+                     its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   INTEGER ,          INTENT(IN   ) :: n_moist
+   
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme , n_moist ), INTENT(IN   ) :: moist
+                                              
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(  OUT) :: cqu, cqv, cqw
+
+   ! Local stuff
+
+   REAL :: qtot
+   
+   INTEGER :: i, j, k, itf, jtf, ktf, ispe
+
+!<DESCRIPTION>
+!
+!  calc_cq calculates moist coefficients for the momentum equations.
+!
+!</DESCRIPTION>
+
+      itf=ite
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+
+      IF(  n_moist >= PARAM_FIRST_SCALAR ) THEN
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+          qtot = 0.
+!DEC$ loop count(3)
+          DO ispe=PARAM_FIRST_SCALAR,n_moist
+            qtot = qtot + moist(i,k,j,ispe) + moist(i-1,k,j,ispe)
+          ENDDO
+!           qtot = 0.5*( moist(i  ,k,j,1)+moist(i  ,k,j,2)+moist(i  ,k,j,3)+  &
+!     &                  moist(i-1,k,j,1)+moist(i-1,k,j,2)+moist(i-1,k,j,3) )
+!           cqu(i,k,j) = 1./(1.+qtot)
+           cqu(i,k,j) = 1./(1.+0.5*qtot)
+        ENDDO
+        ENDDO
+        ENDDO
+
+        itf=MIN(ite,ide-1)
+        jtf=jte
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+          qtot = 0.
+!DEC$ loop count(3)
+          DO ispe=PARAM_FIRST_SCALAR,n_moist
+            qtot = qtot + moist(i,k,j,ispe) + moist(i,k,j-1,ispe)
+          ENDDO
+!           qtot = 0.5*( moist(i,k,j  ,1)+moist(i,k,j  ,2)+moist(i,k,j  ,3)+  &
+!     &                  moist(i,k,j-1,1)+moist(i,k,j-1,2)+moist(i,k,j-1,3) )
+!           cqv(i,k,j) = 1./(1.+qtot)
+           cqv(i,k,j) = 1./(1.+0.5*qtot)
+        ENDDO
+        ENDDO
+        ENDDO
+
+        itf=MIN(ite,ide-1)
+        jtf=MIN(jte,jde-1)
+        DO j=jts,jtf
+        DO k=kts+1,ktf
+        DO i=its,itf
+          qtot = 0.
+!DEC$ loop count(3)
+          DO ispe=PARAM_FIRST_SCALAR,n_moist
+            qtot = qtot + moist(i,k,j,ispe) + moist(i,k-1,j,ispe)
+          ENDDO
+!           qtot = 0.5*( moist(i,k  ,j,1)+moist(i,k  ,j,2)+moist(i,k-1,j,3)+  &
+!     &                  moist(i,k-1,j,1)+moist(i,k-1,j,2)+moist(i,k  ,j,3) )
+!           cqw(i,k,j) = qtot
+           cqw(i,k,j) = 0.5*qtot
+        ENDDO
+        ENDDO
+        ENDDO
+
+      ELSE
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           cqu(i,k,j) = 1.
+        ENDDO
+        ENDDO
+        ENDDO
+
+        itf=MIN(ite,ide-1)
+        jtf=jte
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           cqv(i,k,j) = 1.
+        ENDDO
+        ENDDO
+        ENDDO
+
+        itf=MIN(ite,ide-1)
+        jtf=MIN(jte,jde-1)
+        DO j=jts,jtf
+        DO k=kts+1,ktf
+        DO i=its,itf
+           cqw(i,k,j) = 0.
+        ENDDO
+        ENDDO
+        ENDDO
+
+      END IF
+
+END SUBROUTINE calc_cq
+
+!----------------------------------------------------------------------
+
+SUBROUTINE calc_alt ( alt, al, alb,                  &
+                      ids, ide, jds, jde, kds, kde,  &
+                      ims, ime, jms, jme, kms, kme,  &
+                      its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: alb, al
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(  OUT) :: alt
+
+   ! Local stuff
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+!<DESCRIPTION>
+!
+! calc_alt computes the full inverse density
+!
+!</DESCRIPTION>
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+        alt(i,k,j) = al(i,k,j)+alb(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+
+END SUBROUTINE calc_alt
+
+!----------------------------------------------------------------------
+
+SUBROUTINE calc_p_rho_phi ( moist, n_moist,                &
+                            al, alb, mu, muts, ph, p, pb,  &
+                            t, p0, t0, znu, dnw, rdnw,     &
+                            rdn, non_hydrostatic,          &
+                            ids, ide, jds, jde, kds, kde,  &
+                            ims, ime, jms, jme, kms, kme,  &
+                            its, ite, jts, jte, kts, kte  )
+
+  IMPLICIT NONE
+   
+   ! Input data
+
+  LOGICAL ,          INTENT(IN   ) :: non_hydrostatic
+
+  INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                      ims, ime, jms, jme, kms, kme, &
+                                      its, ite, jts, jte, kts, kte 
+
+  INTEGER ,          INTENT(IN   ) :: n_moist
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: alb,  &
+                                                                   pb,   &
+                                                                   t
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme, n_moist ), INTENT(IN   ) :: moist
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(  OUT) :: al, p
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: ph
+
+  REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN   ) :: mu, muts
+
+  REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: znu, dnw, rdnw, rdn
+
+  REAL,   INTENT(IN   ) :: t0, p0
+
+  ! Local stuff
+
+  INTEGER :: i, j, k, itf, jtf, ktf, ispe
+  REAL    :: qvf, qtot, qf1, qf2
+  REAL, DIMENSION( its:ite) :: temp,cpovcv_v
+
+
+!<DESCRIPTION>
+!
+! For the nonhydrostatic option, calc_p_rho_phi calculates the
+! diagnostic quantities pressure and (inverse) density from the
+! prognostic variables using the equation of state.
+!
+! For the hydrostatic option, calc_p_rho_phi calculates the
+! diagnostic quantities (inverse) density and geopotential from the
+! prognostic variables using the equation of state and the hydrostatic 
+! equation.
+!
+!</DESCRIPTION>
+
+  itf=MIN(ite,ide-1)
+  jtf=MIN(jte,jde-1)
+  ktf=MIN(kte,kde-1)
+
+#ifndef INTELMKL
+  cpovcv_v = cpovcv
+#endif
+
+  IF (non_hydrostatic) THEN
+
+      IF (n_moist >= PARAM_FIRST_SCALAR ) THEN  
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+          qvf = 1.+rvovrd*moist(i,k,j,P_QV)
+          al(i,k,j)=-1./muts(i,j)*(alb(i,k,j)*mu(i,j)  &
+                     +rdnw(k)*(ph(i,k+1,j)-ph(i,k,j)))
+          temp(i)=(r_d*(t0+t(i,k,j))*qvf)/                 &
+                        (p0*(al(i,k,j)+alb(i,k,j)))
+        ENDDO
+#ifdef INTELMKL
+        CALL VPOWX ( itf-its+1, temp(its), cpovcv, p(its,k,j) )
+#else
+! use vector version from libmassv or from compat lib in frame/libmassv.F
+        CALL VPOW  ( p(its,k,j), temp(its), cpovcv_v(its), itf-its+1 )
+#endif
+        DO i=its,itf
+           p(i,k,j)= p(i,k,j)*p0-pb(i,k,j)
+        ENDDO
+        ENDDO
+        ENDDO
+
+      ELSE
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+          al(i,k,j)=-1./muts(i,j)*(alb(i,k,j)*mu(i,j)  &
+                     +rdnw(k)*(ph(i,k+1,j)-ph(i,k,j)))
+          p(i,k,j)=p0*( (r_d*(t0+t(i,k,j)))/                     &
+                        (p0*(al(i,k,j)+alb(i,k,j))) )**cpovcv  &
+                           -pb(i,k,j)
+        ENDDO
+        ENDDO
+        ENDDO
+
+      END IF
+
+   ELSE
+
+!  hydrostatic pressure, al, and ph1 calc; WCS, 5 sept 2001
+
+
+      IF (n_moist >= PARAM_FIRST_SCALAR ) THEN  
+
+        DO j=jts,jtf
+
+          k=ktf          ! top layer
+          DO i=its,itf
+
+            qtot = 0.
+            DO ispe=PARAM_FIRST_SCALAR,n_moist
+              qtot = qtot + moist(i,k,j,ispe)
+            ENDDO
+            qf2 = 1./(1.+qtot)
+            qf1 = qtot*qf2
+
+            p(i,k,j) = - 0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2
+            qvf = 1.+rvovrd*moist(i,k,j,P_QV)
+            al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* &
+                (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j)
+
+          ENDDO
+
+          DO k=ktf-1,kts,-1  ! remaining layers, integrate down
+            DO i=its,itf
+
+            qtot = 0.
+            DO ispe=PARAM_FIRST_SCALAR,n_moist
+              qtot = qtot + 0.5*(  moist(i,k  ,j,ispe) + moist(i,k+1,j,ispe) )
+            ENDDO
+            qf2 = 1./(1.+qtot)
+            qf1 = qtot*qf2
+
+            p(i,k,j) = p(i,k+1,j) - (mu(i,j) + qf1*muts(i,j))/qf2/rdn(k+1)
+            qvf = 1.+rvovrd*moist(i,k,j,P_QV)
+            al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* &
+                        (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j)
+            ENDDO
+          ENDDO
+
+          DO k=2,ktf+1  ! integrate hydrostatic equation for geopotential
+            DO i=its,itf
+
+!              ph(i,k,j) = ph(i,k-1,j) - (1./rdnw(k-1))*(       &
+!                           (muts(i,j)+mu(i,j))*al(i,k-1,j)+    &
+!                            mu(i,j)*alb(i,k-1,j)  )
+              ph(i,k,j) = ph(i,k-1,j) - (dnw(k-1))*(           &
+                           (muts(i,j))*al(i,k-1,j)+            &
+                            mu(i,j)*alb(i,k-1,j)  )
+                                                   
+
+            ENDDO
+          ENDDO
+
+        ENDDO
+
+      ELSE
+
+        DO j=jts,jtf
+
+          k=ktf          ! top layer
+          DO i=its,itf
+
+            qtot = 0.
+            qf2 = 1./(1.+qtot)
+            qf1 = qtot*qf2
+
+            p(i,k,j) = - 0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2
+            qvf = 1.
+            al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* &
+                (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j)
+
+          ENDDO
+
+          DO k=ktf-1,kts,-1  ! remaining layers, integrate down
+            DO i=its,itf
+
+            qtot = 0.
+            qf2 = 1./(1.+qtot)
+            qf1 = qtot*qf2
+
+            p(i,k,j) = p(i,k+1,j) - (mu(i,j) + qf1*muts(i,j))/qf2/rdn(k+1)
+            qvf = 1.
+            al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* &
+                        (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j)
+            ENDDO
+          ENDDO
+
+          DO k=2,ktf+1  ! integrate hydrostatic equation for geopotential
+            DO i=its,itf
+
+!              ph(i,k,j) = ph(i,k-1,j) - (1./rdnw(k-1))*(       &
+!                           (muts(i,j)+mu(i,j))*al(i,k-1,j)+    &
+!                            mu(i,j)*alb(i,k-1,j)  )
+              ph(i,k,j) = ph(i,k-1,j) - (dnw(k-1))*(           &
+                           (muts(i,j))*al(i,k-1,j)+            &
+                            mu(i,j)*alb(i,k-1,j)  )
+                                                   
+
+            ENDDO
+          ENDDO
+
+        ENDDO
+
+     END IF
+
+   END IF
+
+END SUBROUTINE calc_p_rho_phi
+
+!----------------------------------------------------------------------
+
+SUBROUTINE calc_php ( php, ph, phb,                  &
+                      ids, ide, jds, jde, kds, kde,  &
+                      ims, ime, jms, jme, kms, kme,  &
+                      its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) :: phb, ph
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(  OUT) :: php
+
+   ! Local stuff
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+!<DESCRIPTION>
+!
+!  calc_php calculates the full geopotential from the reference state
+!  geopotential and the perturbation geopotential (phb_ph).
+!
+!</DESCRIPTION>
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+        php(i,k,j) = 0.5*(phb(i,k,j)+phb(i,k+1,j)+ph(i,k,j)+ph(i,k+1,j))
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE calc_php
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE diagnose_w( ph_tend, ph_new, ph_old, w, mu, dt,  &
+                       u, v, ht,                            &
+                       cf1, cf2, cf3, rdx, rdy, msft,       &
+                       ids, ide, jds, jde, kds, kde,        &
+                       ims, ime, jms, jme, kms, kme,        &
+                       its, ite, jts, jte, kts, kte        )
+
+   IMPLICIT NONE
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::   ph_tend, &
+                                                                     ph_new,  &
+                                                                     ph_old,  &
+                                                                     u,       &
+                                                                     v
+
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(  OUT) :: w
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: mu, ht, msft
+
+   REAL, INTENT(IN   ) :: dt, cf1, cf2, cf3, rdx, rdy
+
+   INTEGER :: i, j, k, itf, jtf
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+!<DESCRIPTION>
+!
+! diagnose_w diagnoses the vertical velocity from the geopoential equation.
+! Used with the hydrostatic option.
+!
+!</DESCRIPTION>
+
+   DO j = jts, jtf
+
+!  lower b.c. on w
+
+     DO i = its, itf
+         w(i,1,j)=  msft(i,j)*(                              &
+                  .5*rdy*(                                   &
+                           (ht(i,j+1)-ht(i,j  ))             &
+          *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1))    &
+                          +(ht(i,j  )-ht(i,j-1))             &
+          *(cf1*v(i,1,j  )+cf2*v(i,2,j  )+cf3*v(i,3,j  ))  ) &
+                 +.5*rdx*(                                   &
+                           (ht(i+1,j)-ht(i,j  ))             &
+          *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j))    &
+                          +(ht(i,j  )-ht(i-1,j))             &
+          *(cf1*u(i  ,1,j)+cf2*u(i  ,2,j)+cf3*u(i  ,3,j))  ) &
+                                                            )
+     ENDDO
+
+!  use geopotential equation to diagnose w
+
+     DO k = 2, kte
+     DO i = its, itf
+       w(i,k,j) =  msft(i,j)*(  (ph_new(i,k,j)-ph_old(i,k,j))/dt       &
+                               - ph_tend(i,k,j)/mu(i,j)        )/g 
+
+     ENDDO
+     ENDDO
+
+   ENDDO
+
+END SUBROUTINE diagnose_w
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rhs_ph( ph_tend, u, v, ww,               &
+                   ph, ph_old, phb, w,              &
+                   mut, muu, muv,                   &
+                   fnm, fnp,                        &
+                   rdnw, cfn, cfn1, rdx, rdy, msft, &
+                   non_hydrostatic,                 &
+                   config_flags,                    &
+                   ids, ide, jds, jde, kds, kde,    &
+                   ims, ime, jms, jme, kms, kme,    &
+                   its, ite, jts, jte, kts, kte    )
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::        &
+                                                                     u,   &
+                                                                     v,   &
+                                                                     ww,  &
+                                                                     ph,  &
+                                                                     ph_old, &
+                                                                     phb, & 
+                                                                    w
+
+! pjj/cray
+!  REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(  OUT) :: ph_tend
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: ph_tend
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: muu, muv, mut, msft
+
+   REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: rdnw, fnm, fnp
+
+   REAL,  INTENT(IN   ) :: cfn, cfn1, rdx, rdy
+
+   LOGICAL,  INTENT(IN   )  ::  non_hydrostatic
+
+   ! Local stuff
+
+   INTEGER :: i, j, k, itf, jtf, ktf, kz, i_start, j_start
+   REAL    :: ur, ul, ub, vr, vl, vb
+   REAL, DIMENSION(its:ite,kts:kte) :: wdwn
+
+   INTEGER :: advective_order
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+! rhs_ph calculates the large-timestep tendency terms for the geopotential
+! equation.  These terms include the advection and "gw".  The geopotential
+! equation is cast in advective form, so we don't use the flux form advection
+! algorithms here.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   advective_order = config_flags%h_sca_adv_order 
+!   advective_order = 2  !  original configuration (pre Oct 2001)
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+   ktf=MIN(kte,kde-1)
+
+! advective form for the geopotential equation
+
+   DO j = jts, jtf
+
+     DO k = 2, kte
+     DO i = its, itf
+          wdwn(i,k) = .5*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)               &
+                        *(ph(i,k,j)-ph(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))
+     ENDDO
+     ENDDO
+
+     DO k = 2, kte-1
+     DO i = its, itf
+           ph_tend(i,k,j) = ph_tend(i,k,j)                           &
+                             - (fnm(k)*wdwn(i,k+1)+fnp(k)*wdwn(i,k))
+     ENDDO
+     ENDDO
+
+   ENDDO
+
+   IF (non_hydrostatic) THEN  ! add in "gw" term.
+   DO j = jts, jtf            ! in hydrostatic mode, "gw" will be diagnosed
+                              ! after the timestep to give us "w"
+     DO i = its, itf
+        ph_tend(i,kde,j) = 0.
+     ENDDO
+
+     DO k = 2, kte
+     DO i = its, itf
+        ph_tend(i,k,j) = ph_tend(i,k,j) + mut(i,j)*g*w(i,k,j)/msft(i,j)
+     ENDDO
+     ENDDO
+
+   ENDDO
+
+   END IF
+
+   IF (advective_order <= 2) THEN
+
+!  y (v) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1
+   IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdy*                       &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*               &
+                  (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))  &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*               &
+                  (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1)) )
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdy*                         &
+                  ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*    &
+                   (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))  &
+                   +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*    &
+                   (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1)) )
+     ENDDO
+
+   ENDDO
+
+!  x (u) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+1
+   IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-1
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdx*                        &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*                &
+                  (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))   &
+                  +muu(i  ,j)*(u(i  ,k,j)+u(i  ,k-1,j))*                &
+                  (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j)) )
+     ENDDO
+     ENDDO
+ 
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdx*                         &
+                  ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*    &
+                   (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))  &
+                   +muu(i  ,j)*(cfn*u(i  ,k-1,j)+cfn1*u(i  ,k-2,j))*    &
+                   (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j)) )
+     ENDDO
+
+   ENDDO
+
+   ELSE IF (advective_order <= 4) THEN
+
+!  y (v) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1
+   IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdy*           (          &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))               &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  )) )* (1./12.)*( &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                      &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                      &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                    &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdy*           (                      &
+                 ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))               &
+                  +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  )) )* (1./12.)*( &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                                 &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                                 &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                               &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+     ENDDO
+
+   ENDDO
+
+
+!  x (u) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+1
+   IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-1
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdx*(                     &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))               &
+                  +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  )) )* (1./12.)*( &
+                    8.*(ph(i+1,k,j)-ph(i-1,k,j))                      &
+                      -(ph(i+2,k,j)-ph(i-2,k,j))                      &
+                   +8.*(phb(i+1,k,j)-phb(i-1,k,j))                    &
+                      -(phb(i+2,k,j)-phb(i-2,k,j))  )   )                
+     ENDDO
+     ENDDO
+ 
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdx*(                                 &
+                 ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))               &
+                  +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j)) )* (1./12.)*(   &
+                    8.*(ph(i+1,k,j)-ph(i-1,k,j))                                 &
+                      -(ph(i+2,k,j)-ph(i-2,k,j))                                 &
+                   +8.*(phb(i+1,k,j)-phb(i-1,k,j))                               &
+                      -(phb(i+2,k,j)-phb(i-2,k,j))  )     )
+     ENDDO
+
+   ENDDO
+
+   ELSE IF (advective_order <= 6) THEN
+
+!  y (v) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+!   IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1
+!   IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1
+
+   IF (config_flags%open_ys .or. specified ) j_start = max(jts,jds+2)
+   IF (config_flags%open_ye .or. specified ) jtf     = min(jtf,jde-3)
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdy* (                    &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))               &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  )) )* (1./60.)*( &
+                   45.*(ph(i,k,j+1)-ph(i,k,j-1))                      &
+                   -9.*(ph(i,k,j+2)-ph(i,k,j-2))                      &
+                      +(ph(i,k,j+3)-ph(i,k,j-3))                      &
+                  +45.*(phb(i,k,j+1)-phb(i,k,j-1))                    &
+                   -9.*(phb(i,k,j+2)-phb(i,k,j-2))                    &
+                      +(phb(i,k,j+3)-phb(i,k,j-3))  )   )                
+
+
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdy* (                                &
+                 ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))               &
+                  +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  )) )* (1./60.)*( &
+                   45.*(ph(i,k,j+1)-ph(i,k,j-1))                                 &
+                   -9.*(ph(i,k,j+2)-ph(i,k,j-2))                                 &
+                      +(ph(i,k,j+3)-ph(i,k,j-3))                                 &
+                  +45.*(phb(i,k,j+1)-phb(i,k,j-1))                               &
+                   -9.*(phb(i,k,j+2)-phb(i,k,j-2))                               &
+                      +(phb(i,k,j+3)-phb(i,k,j-3))  )   )                
+
+     ENDDO
+
+   ENDDO
+
+
+!  pick up near boundary rows using 4th order stencil 
+!  (open bc copy only goes out to jds-1 and jde, hence 4rth is ok but 6th is too big)
+
+   IF ( (config_flags%open_ys) .and. jts <= jds+1 )  THEN
+
+     j = jds+1
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdy* (                    &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))               &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  )) )* (1./12.)*( &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                      &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                      &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                    &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdy* (                                &
+                 ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))               &
+                  +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  )) )* (1./12.)*( &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                                 &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                                 &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                               &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+     ENDDO
+
+   END IF
+
+   IF ( (config_flags%open_ye) .and. jte >= jde-2 )  THEN
+
+     j = jde-2
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdy* (                    &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))               &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  )) )* (1./12.)*( &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                      &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                      &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                    &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdy* (                                &
+                 ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))               &
+                  +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  )) )* (1./12.)*( &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                                 &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                                 &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                               &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+     ENDDO
+
+   END IF
+
+!  x (u) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF (config_flags%open_xs .or. specified ) i_start = max(its,ids+2)
+   IF (config_flags%open_xe .or. specified ) itf     = min(itf,ide-3)
+   IF ( config_flags%periodic_x ) i_start = its
+   IF ( config_flags%periodic_x ) itf=MIN(ite,ide-1)
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdx*(                     &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))               &
+                  +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  )) )* (1./60.)*( &
+                   45.*(ph(i+1,k,j)-ph(i-1,k,j))                      &
+                   -9.*(ph(i+2,k,j)-ph(i-2,k,j))                      &
+                      +(ph(i+3,k,j)-ph(i-3,k,j))                      &
+                  +45.*(phb(i+1,k,j)-phb(i-1,k,j))                    &
+                   -9.*(phb(i+2,k,j)-phb(i-2,k,j))                    &
+                      +(phb(i+3,k,j)-phb(i-3,k,j))  )   )                
+     ENDDO
+     ENDDO
+ 
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdx*(                                 &
+                 ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))               &
+                  +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j)) )* (1./60.)*(   &
+                   45.*(ph(i+1,k,j)-ph(i-1,k,j))                                 &
+                   -9.*(ph(i+2,k,j)-ph(i-2,k,j))                                 &
+                      +(ph(i+3,k,j)-ph(i-3,k,j))                                 &
+                  +45.*(phb(i+1,k,j)-phb(i-1,k,j))                               &
+                   -9.*(phb(i+2,k,j)-phb(i-2,k,j))                               &
+                      +(phb(i+3,k,j)-phb(i-3,k,j))  )     )
+     ENDDO
+
+   ENDDO
+
+   IF ( (config_flags%open_xs) .and. its <= ids+1 ) THEN
+     i = ids + 1
+     DO j = j_start, jtf
+       DO k = 2, kte-1
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdx*(                     &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))               &
+                  +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  )) )* (1./12.)*( &
+                    8.*(ph(i+1,k,j)-ph(i-1,k,j))                      &
+                      -(ph(i+2,k,j)-ph(i-2,k,j))                      &
+                   +8.*(phb(i+1,k,j)-phb(i-1,k,j))                    &
+                      -(phb(i+2,k,j)-phb(i-2,k,j))  )   )                
+       ENDDO
+       k = kte
+       ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdx*(                                 &
+                ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))               &
+                 +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j)) )* (1./12.)*(   &
+                   8.*(ph(i+1,k,j)-ph(i-1,k,j))                                 &
+                     -(ph(i+2,k,j)-ph(i-2,k,j))                                 &
+                  +8.*(phb(i+1,k,j)-phb(i-1,k,j))                               &
+                     -(phb(i+2,k,j)-phb(i-2,k,j))  )     )
+
+     ENDDO
+   END IF
+
+   IF ( (config_flags%open_xe) .and. ite >= ide-2 ) THEN
+     i = ide-2
+     DO j = j_start, jtf
+       DO k = 2, kte-1
+        ph_tend(i,k,j)=ph_tend(i,k,j) - .25*rdx*(                     &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))               &
+                  +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  )) )* (1./12.)*( &
+                    8.*(ph(i+1,k,j)-ph(i-1,k,j))                      &
+                      -(ph(i+2,k,j)-ph(i-2,k,j))                      &
+                   +8.*(phb(i+1,k,j)-phb(i-1,k,j))                    &
+                      -(phb(i+2,k,j)-phb(i-2,k,j))  )   )                
+       ENDDO
+       k = kte
+       ph_tend(i,k,j)=ph_tend(i,k,j) - .5*rdx*(                                 &
+                ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))               &
+                 +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j)) )* (1./12.)*(   &
+                   8.*(ph(i+1,k,j)-ph(i-1,k,j))                                 &
+                     -(ph(i+2,k,j)-ph(i-2,k,j))                                 &
+                  +8.*(phb(i+1,k,j)-phb(i-1,k,j))                               &
+                     -(phb(i+2,k,j)-phb(i-2,k,j))  )     )
+
+     ENDDO
+   END IF
+
+   END IF
+
+!  lateral open boundary conditions,
+!  start with north and south (y) boundaries
+
+   i_start = its
+   itf=MIN(ite,ide-1)
+
+   !  south
+
+   IF ( (config_flags%open_ys) .and. jts == jds ) THEN
+
+     j=jts
+
+     DO k=2,kde
+       kz = min(k,kde-1)
+       DO i = its,itf
+         vb =.5*( fnm(kz)*(v(i,kz  ,j+1)+v(i,kz  ,j  ))    &
+                 +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j  )) )
+         vl=amin1(vb,0.)
+         ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*(      &
+                              +vl*(ph_old(i,k,j+1)-ph_old(i,k,j)))
+       ENDDO
+     ENDDO
+
+   END IF
+
+   ! north
+
+   IF ( (config_flags%open_ye) .and. jte == jde ) THEN
+
+     j=jte-1
+
+     DO k=2,kde
+       kz = min(k,kde-1)
+       DO i = its,itf
+        vb=.5*( fnm(kz)*(v(i,kz  ,j+1)+v(i,kz  ,j))   &
+               +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j)) )
+        vr=amax1(vb,0.)
+        ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*(      &
+                   +vr*(ph_old(i,k,j)-ph_old(i,k,j-1)))
+       ENDDO
+     ENDDO
+
+   END IF
+
+   !  now the east and west (y) boundaries
+
+   j_start = its
+   jtf=MIN(jte,jde-1)
+
+   !  west
+
+   IF ( (config_flags%open_xs) .and. its == ids ) THEN
+
+     i=its
+
+     DO j = jts,jtf
+       DO k=2,kde-1
+         kz = k
+         ub =.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i  ,kz  ,j))     &
+                 +fnp(kz)*(u(i+1,kz-1,j)+u(i  ,kz-1,j)) )
+         ul=amin1(ub,0.)
+         ph_tend(i,k,j)=ph_tend(i,k,j)-rdx*mut(i,j)*(       &
+                              +ul*(ph_old(i+1,k,j)-ph_old(i,k,j)))
+       ENDDO
+
+         k = kde
+         kz = k
+         ub =.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i  ,kz  ,j))     &
+                 +fnp(kz)*(u(i+1,kz-1,j)+u(i  ,kz-1,j)) )
+         ul=amin1(ub,0.)
+         ph_tend(i,k,j)=ph_tend(i,k,j)-rdx*mut(i,j)*(       &
+                              +ul*(ph_old(i+1,k,j)-ph_old(i,k,j)))
+     ENDDO
+
+   END IF
+
+   ! east
+
+   IF ( (config_flags%open_xe) .and. ite == ide ) THEN
+
+     i = ite-1
+
+     DO j = jts,jtf
+       DO k=2,kde-1
+        kz = k
+        ub=.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i,kz  ,j))  &
+               +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) )
+        ur=amax1(ub,0.)
+        ph_tend(i,k,j)=ph_tend(i,k,j)-rdx*mut(i,j)*( &
+                   +ur*(ph_old(i,k,j)-ph_old(i-1,k,j)))
+       ENDDO
+
+        k = kde    
+        kz = k-1
+        ub=.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i,kz  ,j))   &
+               +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) )
+        ur=amax1(ub,0.)
+        ph_tend(i,k,j)=ph_tend(i,k,j)-rdx*mut(i,j)*(  &
+                   +ur*(ph_old(i,k,j)-ph_old(i-1,k,j)))
+
+     ENDDO
+
+   END IF
+
+  END SUBROUTINE rhs_ph
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE horizontal_pressure_gradient( ru_tend,rv_tend,                &
+                                         ph,alt,p,pb,al,php,cqu,cqv,     &
+                                         muu,muv,mu,fnm,fnp,rdnw,        &
+                                         cf1,cf2,cf3,rdx,rdy,msft,       &
+                                         config_flags, non_hydrostatic,  &
+                                         ids, ide, jds, jde, kds, kde,   &
+                                         ims, ime, jms, jme, kms, kme,   &
+                                         its, ite, jts, jte, kts, kte   )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   LOGICAL, INTENT (IN   ) :: non_hydrostatic
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::        &
+                                                                     ph,  &
+                                                                     alt, &
+                                                                     al,  &
+                                                                     p,   &
+                                                                     pb,  &
+                                                                     php, &
+                                                                     cqu, &
+                                                                     cqv
+
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) ::           &
+                                                                    ru_tend, &
+                                                                    rv_tend
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: muu, muv, mu, msft
+
+   REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: rdnw, fnm, fnp
+
+   REAL,  INTENT(IN   ) :: rdx, rdy, cf1, cf2, cf3
+
+   INTEGER :: i,j,k, itf, jtf, ktf, i_start, j_start
+   REAL, DIMENSION( ims:ime, kms:kme ) :: dpn
+   REAL :: dpx, dpy
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  horizontal_pressure_gradient calculates the 
+!  horizontal pressure gradient terms for the large-timestep tendency 
+!  in the horizontal momentum equations (u,v).
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+! start with the north-south (y) pressure gradient
+
+   itf=MIN(ite,ide-1)
+   jtf=jte
+   ktf=MIN(kte,kde-1)
+   i_start = its
+   j_start = jts
+   IF ( (config_flags%open_ys .or. specified .or. &
+           config_flags%nested ) .and. jts == jds ) j_start = jts+1
+   IF ( (config_flags%open_ye .or. specified .or. &
+           config_flags%nested ) .and. jte == jde ) jtf = jtf-1
+
+   DO j = j_start, jtf
+
+     IF ( non_hydrostatic )  THEN
+
+        k=1
+
+        DO i = i_start, itf
+          dpn(i,k) = .5*( cf1*(p(i,k  ,j-1)+p(i,k  ,j))   &
+                         +cf2*(p(i,k+1,j-1)+p(i,k+1,j))   &
+                         +cf3*(p(i,k+2,j-1)+p(i,k+2,j))  )
+          dpn(i,kde) = 0.
+        ENDDO
+               
+        DO k=2,ktf
+          DO i = i_start, itf
+            dpn(i,k) = .5*( fnm(k)*(p(i,k  ,j-1)+p(i,k  ,j))  &
+                           +fnp(k)*(p(i,k-1,j-1)+p(i,k-1,j)) )
+          END DO
+        END DO
+
+        DO K=1,ktf
+          DO i = i_start, itf
+            dpy = .5*rdy*muv(i,j)*(                                            &
+                     (ph (i,k+1,j)-ph (i,k+1,j-1) + ph(i,k,j)-ph(i,k,j-1))  &
+                    +(alt(i,k  ,j)+alt(i,k  ,j-1))*(p (i,k,j)-p (i,k,j-1))  &
+                    +(al (i,k  ,j)+al (i,k  ,j-1))*(pb(i,k,j)-pb(i,k,j-1)) )
+            dpy = dpy + rdy*(php(i,k,j)-php(i,k,j-1))*              &
+                (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i,j-1)+mu(i,j)))
+            rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy
+          END DO
+        END DO
+
+     ELSE
+
+        DO K=1,ktf
+          DO i = i_start, itf
+            dpy = .5*rdy*muv(i,j)*(                                            &
+                     (ph (i,k+1,j)-ph (i,k+1,j-1) + ph(i,k,j)-ph(i,k,j-1))  &
+                    +(alt(i,k  ,j)+alt(i,k  ,j-1))*(p (i,k,j)-p (i,k,j-1))  &
+                    +(al (i,k  ,j)+al (i,k  ,j-1))*(pb(i,k,j)-pb(i,k,j-1)) )
+            rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy
+          END DO
+        END DO
+
+     END IF
+
+   ENDDO
+
+!  now the east-west (x) pressure gradient
+
+   itf=ite
+   jtf=MIN(jte,jde-1)
+   ktf=MIN(kte,kde-1)
+   i_start = its
+   j_start = jts
+   IF ( (config_flags%open_xs .or. specified .or. &
+           config_flags%nested ) .and. its == ids ) i_start = its+1
+   IF ( (config_flags%open_xe .or. specified .or. &
+           config_flags%nested ) .and. ite == ide ) itf = itf-1
+   IF ( config_flags%periodic_x ) i_start = its
+   IF ( config_flags%periodic_x ) itf=ite
+
+   DO j = j_start, jtf
+
+     IF ( non_hydrostatic )  THEN
+
+        k=1
+
+        DO i = i_start, itf
+          dpn(i,k) = .5*( cf1*(p(i-1,k  ,j)+p(i,k  ,j))   &
+                         +cf2*(p(i-1,k+1,j)+p(i,k+1,j))   &
+                         +cf3*(p(i-1,k+2,j)+p(i,k+2,j))  )
+          dpn(i,kde) = 0.
+        ENDDO
+               
+        DO k=2,ktf
+          DO i = i_start, itf
+            dpn(i,k) = .5*( fnm(k)*(p(i-1,k  ,j)+p(i,k  ,j))  &
+                           +fnp(k)*(p(i-1,k-1,j)+p(i,k-1,j)) )
+          END DO
+        END DO
+
+        DO K=1,ktf
+          DO i = i_start, itf
+            dpx = .5*rdx*muu(i,j)*(                                            &
+                        (ph (i,k+1,j)-ph (i-1,k+1,j) + ph(i,k,j)-ph(i-1,k,j))  &
+                       +(alt(i,k  ,j)+alt(i-1,k  ,j))*(p (i,k,j)-p (i-1,k,j))  &
+                       +(al (i,k  ,j)+al (i-1,k  ,j))*(pb(i,k,j)-pb(i-1,k,j)) )
+            dpx = dpx + rdx*(php(i,k,j)-php(i-1,k,j))*              &
+                (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i-1,j)+mu(i,j)))
+            ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx
+          END DO
+        END DO
+
+     ELSE
+
+        DO K=1,ktf
+          DO i = i_start, itf
+            dpx = .5*rdx*muu(i,j)*(                                            &
+                        (ph (i,k+1,j)-ph (i-1,k+1,j) + ph(i,k,j)-ph(i-1,k,j))  &
+                       +(alt(i,k  ,j)+alt(i-1,k  ,j))*(p (i,k,j)-p (i-1,k,j))  &
+                       +(al (i,k  ,j)+al (i-1,k  ,j))*(pb(i,k,j)-pb(i-1,k,j)) )
+            ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx
+          END DO
+        END DO
+
+     END IF
+
+   ENDDO
+
+END SUBROUTINE horizontal_pressure_gradient
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE pg_buoy_w( rw_tend, p, cqw, mu, mub,       &
+                      rdnw, rdn, g, msft,             &
+                      ids, ide, jds, jde, kds, kde,   &
+                      ims, ime, jms, jme, kms, kme,   &
+                      its, ite, jts, jte, kts, kte   )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::   p
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) ::   cqw
+
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) ::  rw_tend
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: mub, mu, msft
+
+   REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: rdnw, rdn
+
+   REAL,  INTENT(IN   ) :: g
+
+   INTEGER :: itf, jtf, i, j, k
+   REAL    :: cq1, cq2
+
+
+!<DESCRIPTION>
+!
+!  pg_buoy_w calculates the 
+!  vertical pressure gradient and buoyancy terms for the large-timestep 
+!  tendency in the vertical momentum equation.
+!
+!</DESCRIPTION>
+
+!  BUOYANCY AND PRESSURE GRADIENT TERM IN W EQUATION AT TIME T
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   DO j = jts,jtf
+
+     k=kde
+     DO i=its,itf
+       cq1 = 1./(1.+cqw(i,k-1,j))
+       cq2 = cqw(i,k-1,j)*cq1
+       rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msft(i,j))*g*(      &
+                        cq1*2.*rdnw(k-1)*(  -p(i,k-1,j))  &
+                        -mu(i,j)-cq2*mub(i,j)            )
+     END DO
+
+     DO k = 2, kde-1
+     DO i = its,itf
+      cq1 = 1./(1.+cqw(i,k,j))
+      cq2 = cqw(i,k,j)*cq1
+      cqw(i,k,j) = cq1
+      rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msft(i,j))*g*(      &
+                       cq1*rdn(k)*(p(i,k,j)-p(i,k-1,j))  &
+                       -mu(i,j)-cq2*mub(i,j)            )
+     END DO
+     ENDDO           
+
+
+   ENDDO
+
+END SUBROUTINE pg_buoy_w
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE w_damp( rw_tend, ww, w, mut, rdnw, dt,     &
+                      w_damping,                      &
+                      ids, ide, jds, jde, kds, kde,   &
+                      ims, ime, jms, jme, kms, kme,   &
+                      its, ite, jts, jte, kts, kte   )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: w_damping
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::   ww, w
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) ::  rw_tend
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: mut
+
+   REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: rdnw
+
+   REAL, INTENT(IN)    :: dt
+   REAL                :: cfl, cf_n, cf_d, maxcfl, maxdub, maxdeta
+
+   INTEGER :: itf, jtf, i, j, k, maxi, maxj, maxk
+   INTEGER :: some
+   CHARACTER*512 :: temp
+   CHARACTER (LEN=256) :: time_str
+   CHARACTER (LEN=256) :: grid_str
+
+!<DESCRIPTION>
+!
+!  w_damp computes a damping term for the vertical velocity when the
+!  vertical Courant number is too large.  This was found to be preferable to 
+!  decreasing the timestep or increasing the diffusion in real-data applications
+!  that produced potentially-unstable large vertical velocities because of
+!  unphysically large heating rates coming from the cumulus parameterization 
+!  schemes run at moderately high resolutions (dx ~ O(10) km).
+!
+!</DESCRIPTION>
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   some = 0
+   maxcfl = 0.
+
+   IF ( w_damping == 1 ) THEN
+     DO j = jts,jtf
+
+     DO k = 2, kde-1
+     DO i = its,itf
+#if 0
+        cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt)
+        if(cfl .gt. w_beta)then
+#else
+! restructure to get rid of divide
+        cf_n = abs(ww(i,k,j)*rdnw(k)*dt)
+        cf_d = abs(mut(i,j))
+        if(cf_n .gt. cf_d*w_beta )then
+#endif
+           cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt)
+           IF ( cfl > maxcfl ) THEN
+             maxcfl = cfl ; maxi = i ; maxj = j ; maxk = k 
+             maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k)
+           ENDIF
+           WRITE(temp,*)i,j,k,' cfl,w,d(eta)=',cfl,w(i,k,j),-1./rdnw(k)
+           CALL wrf_debug ( 100 , TRIM(temp) )
+           if ( cfl > 2. ) some = some + 1
+           rw_tend(i,k,j) = rw_tend(i,k,j)-sign(1.,w(i,k,j))*w_alpha*(cfl-w_beta)*mut(i,j)
+        endif
+     END DO
+     ENDDO
+     ENDDO
+   ELSE
+! just print
+     DO j = jts,jtf
+
+     DO k = 2, kde-1
+     DO i = its,itf
+        cf_n = abs(ww(i,k,j)*rdnw(k)*dt)
+        cf_d = abs(mut(i,j))
+        if(cf_n .gt. cf_d*w_beta )then
+           cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt)
+           IF ( cfl > maxcfl ) THEN
+             maxcfl = cfl ; maxi = i ; maxj = j ; maxk = k 
+             maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k)
+           ENDIF
+           WRITE(temp,*)i,j,k,' cfl,w,d(eta)=',cfl,w(i,k,j),-1./rdnw(k)
+           CALL wrf_debug ( 100 , TRIM(temp) )
+           if ( cfl > 2. ) some = some + 1
+        endif
+     END DO
+     ENDDO
+     ENDDO
+   ENDIF
+   IF ( some .GT. 0 ) THEN
+     CALL get_current_time_string( time_str )
+     CALL get_current_grid_name( grid_str )
+     WRITE(wrf_err_message,*)some,                                            &
+            ' points exceeded cfl=2 in domain '//TRIM(grid_str)//' at time '//TRIM(time_str)//' hours'
+     CALL wrf_debug ( 0 , TRIM(wrf_err_message) )
+     WRITE(wrf_err_message,*)'MAX AT i,j,k: ',maxi,maxj,maxk,' cfl,w,d(eta)=',maxcfl, &
+                             maxdub,maxdeta
+     CALL wrf_debug ( 0 , TRIM(wrf_err_message) )
+   ENDIF
+
+END SUBROUTINE w_damp
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE horizontal_diffusion ( name, field, tendency, mu,           &
+                                  config_flags,                        &
+                                  msfu, msfv, msft, khdif, xkmhd, rdx, rdy,   &
+                                  ids, ide, jds, jde, kds, kde,        &
+                                  ims, ime, jms, jme, kms, kme,        &
+                                  its, ite, jts, jte, kts, kte        )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,                          INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field, xkmhd
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,      &
+                                                                msfv,      &
+                                                                msft
+
+   REAL ,                                      INTENT(IN   ) :: rdx,       &
+                                                                rdy,       &
+                                                                khdif
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL :: mrdx, mkrdxm, mkrdxp, &
+           mrdy, mkrdym, mkrdyp
+   REAL :: pr_inv
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  horizontal_diffusion computes the horizontal diffusion tendency
+!  on model horizontal coordinate surfaces.
+!
+!</DESCRIPTION>
+
+   pr_inv = 1./prandtl
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+   IF (name .EQ. 'u') THEN
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mkrdxm=msft(i-1,j)*mu(i-1,j)*xkmhd(i-1,k,j)*rdx
+         mkrdxp=msft(i,j)*mu(i,j)*xkmhd(i,k,j)*rdx
+         mrdx=msfu(i,j)*rdx
+         mkrdym=0.5*(msfu(i,j)+msfu(i,j-1))*    &
+                0.25*(mu(i,j)+mu(i,j-1)+mu(i-1,j-1)+mu(i-1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdy
+         mkrdyp=0.5*(msfu(i,j)+msfu(i,j+1))*    &
+                0.25*(mu(i,j)+mu(i,j+1)+mu(i-1,j+1)+mu(i-1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j+1)+xkmhd(i-1,k,j+1)+xkmhd(i-1,k,j))*rdy
+         mrdy=msfu(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j)+( &
+                            mrdx*(mkrdxp*(field(i+1,k,j)-field(i  ,k,j))  &
+                                 -mkrdxm*(field(i  ,k,j)-field(i-1,k,j))) &
+                           +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j  ))  &
+                                 -mkrdym*(field(i,k,j  )-field(i,k,j-1))))
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ELSE IF (name .EQ. 'v')THEN
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mkrdxm=0.5*(msfv(i,j)+msfv(i-1,j))*    &
+                0.25*(mu(i,j)+mu(i,j-1)+mu(i-1,j-1)+mu(i-1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdx
+         mkrdxp=0.5*(msfv(i,j)+msfv(i+1,j))*    &
+                0.25*(mu(i,j)+mu(i,j-1)+mu(i+1,j-1)+mu(i+1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i+1,k,j-1)+xkmhd(i+1,k,j))*rdx
+         mrdx=msfv(i,j)*rdx
+         mkrdym=msft(i,j-1)*xkmhd(i,k,j-1)*rdy
+         mkrdyp=msft(i,j)*xkmhd(i,k,j)*rdy
+         mrdy=msfv(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j)+( &
+                            mrdx*(mkrdxp*(field(i+1,k,j)-field(i  ,k,j))  &
+                                 -mkrdxm*(field(i  ,k,j)-field(i-1,k,j))) &
+                           +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j  ))  &
+                                 -mkrdym*(field(i,k,j  )-field(i,k,j-1))))
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ELSE IF (name .EQ. 'w')THEN
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+      DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+         mkrdxm=msfu(i,j)*   &
+                0.25*(mu(i,j)+mu(i-1,j)+mu(i,j)+mu(i-1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i-1,k,j)+xkmhd(i,k-1,j)+xkmhd(i-1,k-1,j))*rdx
+         mkrdxp=msfu(i+1,j)*   &
+                0.25*(mu(i+1,j)+mu(i,j)+mu(i+1,j)+mu(i,j))* &
+                0.25*(xkmhd(i+1,k,j)+xkmhd(i,k,j)+xkmhd(i+1,k-1,j)+xkmhd(i,k-1,j))*rdx
+         mrdx=msft(i,j)*rdx
+         mkrdym=msfv(i,j)*   &
+                0.25*(mu(i,j)+mu(i,j-1)+mu(i,j)+mu(i,j-1))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i,k-1,j)+xkmhd(i,k-1,j-1))*rdy
+         mkrdyp=msfv(i,j+1)*   &
+                0.25*(mu(i,j+1)+mu(i,j)+mu(i,j+1)+mu(i,j))* &
+                0.25*(xkmhd(i,k,j+1)+xkmhd(i,k,j)+xkmhd(i,k-1,j+1)+xkmhd(i,k-1,j))*rdy
+         mrdy=msft(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j)+( &
+                            mrdx*(mkrdxp*(field(i+1,k,j)-field(i  ,k,j)) &
+                                 -mkrdxm*(field(i  ,k,j)-field(i-1,k,j))) &
+                           +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j  )) &
+                                 -mkrdym*(field(i,k,j  )-field(i,k,j-1))))
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ELSE
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mkrdxm=msfu(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(mu(i,j)+mu(i-1,j))*rdx*pr_inv
+         mkrdxp=msfu(i+1,j)*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*0.5*(mu(i+1,j)+mu(i,j))*rdx*pr_inv
+         mrdx=msft(i,j)*rdx
+         mkrdym=msfv(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy*pr_inv
+         mkrdyp=msfv(i,j+1)*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy*pr_inv
+         mrdy=msft(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j)+( &
+                            mrdx*(mkrdxp*(field(i+1,k,j)-field(i  ,k,j))  &
+                                 -mkrdxm*(field(i  ,k,j)-field(i-1,k,j))) &
+                           +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j  ))  &
+                                 -mkrdym*(field(i,k,j  )-field(i,k,j-1))))
+      ENDDO
+      ENDDO
+      ENDDO
+           
+   ENDIF
+
+END SUBROUTINE horizontal_diffusion
+
+!-----------------------------------------------------------------------------------------
+
+SUBROUTINE horizontal_diffusion_3dmp ( name, field, tendency, mu,           &
+                                       config_flags, base_3d,               &
+                                       msfu, msfv, msft, khdif, xkmhd, rdx, rdy,   &
+                                       ids, ide, jds, jde, kds, kde,        &
+                                       ims, ime, jms, jme, kms, kme,        &
+                                       its, ite, jts, jte, kts, kte        )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,                          INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field, &
+                                                                      xkmhd, &
+                                                                      base_3d
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,      &
+                                                                    msfv,      &
+                                                                    msft
+
+   REAL ,                                      INTENT(IN   ) :: rdx,       &
+                                                                rdy,       &
+                                                                khdif
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL :: mrdx, mkrdxm, mkrdxp, &
+           mrdy, mkrdym, mkrdyp
+   REAL :: pr_inv
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  horizontal_diffusion_3dmp computes the horizontal diffusion tendency
+!  on model horizontal coordinate surfaces.  This routine computes diffusion
+!  a perturbation scalar (field-base_3d).
+!
+!</DESCRIPTION>
+
+   pr_inv = 1./prandtl
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mkrdxm=msfu(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(mu(i,j)+mu(i-1,j))*rdx*pr_inv
+         mkrdxp=msfu(i+1,j)*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*0.5*(mu(i+1,j)+mu(i,j))*rdx*pr_inv
+         mrdx=msft(i,j)*rdx
+         mkrdym=msfv(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy*pr_inv
+         mkrdyp=msfv(i,j+1)*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy*pr_inv
+         mrdy=msft(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j)+(                        &
+                    mrdx*( mkrdxp*(   field(i+1,k,j)  -field(i  ,k,j)      &
+                                   -base_3d(i+1,k,j)+base_3d(i  ,k,j) )    &
+                          -mkrdxm*(   field(i  ,k,j)  -field(i-1,k,j)      &
+                                   -base_3d(i  ,k,j)+base_3d(i-1,k,j) )  ) &
+                   +mrdy*( mkrdyp*(   field(i,k,j+1)  -field(i,k,j  )      &
+                                   -base_3d(i,k,j+1)+base_3d(i,k,j  ) )    &
+                          -mkrdym*(   field(i,k,j  )  -field(i,k,j-1)      &
+                                   -base_3d(i,k,j  )+base_3d(i,k,j-1) )  ) &
+                                                                         ) 
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE horizontal_diffusion_3dmp
+
+!-----------------------------------------------------------------------------------------
+
+SUBROUTINE vertical_diffusion ( name, field, tendency,        &
+                                config_flags,                 &
+                                alt, mut, rdn, rdnw, kvdif,   &
+                                ids, ide, jds, jde, kds, kde, &
+                                ims, ime, jms, jme, kms, kme, &
+                                its, ite, jts, jte, kts, kte )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,                          INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: mut
+
+   REAL , DIMENSION( kms:kme ) ,                   INTENT(IN   ) :: rdn, rdnw
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, jts:jte) :: vfluxm, vfluxp, zz
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion
+!  computes vertical diffusion tendency.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+   IF (name .EQ. 'w')THEN
+
+   
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+j_loop_w : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+          vflux(i,k)= (kvdif/alt(i,k,j))*rdnw(k)*(field(i,k+1,j)-field(i,k,j))
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts+1,ktf
+       DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)                                         &
+                              +rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j)))  &
+                                         *(vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+    ENDDO j_loop_w
+
+   ELSE IF(name .EQ. 'm')THEN
+
+     i_start = its
+     i_end   = MIN(ite,ide-1)
+     j_start = jts
+     j_end   = MIN(jte,jde-1)
+
+j_loop_s : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))   &
+                  *(field(i,k+1,j)-field(i,k,j))
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf
+       DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)  &
+                *rdnw(k)*(vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_s
+
+   ENDIF
+
+END SUBROUTINE vertical_diffusion
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE vertical_diffusion_mp ( field, tendency, config_flags, &
+                                   base,                          &
+                                   alt, mut, rdn, rdnw, kvdif,    &
+                                   ids, ide, jds, jde, kds, kde,  &
+                                   ims, ime, jms, jme, kms, kme,  &
+                                   its, ite, jts, jte, kts, kte  )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: mut
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: rdn,  &
+                                                                  rdnw, &
+                                                                  base
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion_mp
+!  computes vertical diffusion tendency of a perturbation variable
+!  (field-base).  Note that base as a 1D (k) field.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+     i_start = its
+     i_end   = MIN(ite,ide-1)
+     j_start = jts
+     j_end   = MIN(jte,jde-1)
+
+j_loop_s : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))   &
+                    *(field(i,k+1,j)-field(i,k,j)-base(k+1)+base(k))
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf
+       DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)  &
+                *rdnw(k)*(vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_s
+
+END SUBROUTINE vertical_diffusion_mp
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE vertical_diffusion_3dmp ( field, tendency, config_flags, &
+                                     base_3d,                       &
+                                     alt, mut, rdn, rdnw, kvdif,    &
+                                     ids, ide, jds, jde, kds, kde,  &
+                                     ims, ime, jms, jme, kms, kme,  &
+                                     its, ite, jts, jte, kts, kte  )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt,      &
+                                                                base_3d
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: mut
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: rdn,  &
+                                                                  rdnw
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion_3dmp
+!  computes vertical diffusion tendency of a perturbation variable
+!  (field-base_3d).  
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+     i_start = its
+     i_end   = MIN(ite,ide-1)
+     j_start = jts
+     j_end   = MIN(jte,jde-1)
+
+j_loop_s : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))   &
+                    *(   field(i,k+1,j)  -field(i,k,j)               &
+                      -base_3d(i,k+1,j)+base_3d(i,k,j) )
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf
+       DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)  &
+                *rdnw(k)*(vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_s
+
+END SUBROUTINE vertical_diffusion_3dmp
+
+
+!-------------------------------------------------------------------------------
+
+
+SUBROUTINE vertical_diffusion_u ( field, tendency,              &
+                                  config_flags, u_base,         &
+                                  alt, muu, rdn, rdnw, kvdif,   &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: muu
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: rdn, rdnw, u_base
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz, zz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion_u computes vertical diffusion tendency for 
+!  the u momentum equation.  This routine assumes a constant eddy
+!  viscosity kvdif.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+
+j_loop_u : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i  ,k  ,j)      &
+                                        +alt(i-1,k  ,j)      &
+                                        +alt(i  ,k+1,j)      &
+                                        +alt(i-1,k+1,j) ) )  &
+                             *(field(i,k+1,j)-field(i,k,j)   &
+                               -u_base(k+1)   +u_base(k)  )
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)+                             &
+                g*g*rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j)))* &
+                              (vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_u
+   
+END SUBROUTINE vertical_diffusion_u
+
+!-------------------------------------------------------------------------------
+
+
+SUBROUTINE vertical_diffusion_v ( field, tendency,              &
+                                  config_flags, v_base,         &
+                                  alt, muv, rdn, rdnw, kvdif,   &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: rdn, rdnw, v_base
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: muv
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf, jm1
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz, zz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion_v computes vertical diffusion tendency for 
+!  the v momentum equation.  This routine assumes a constant eddy
+!  viscosity kvdif.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+j_loop_v : DO j = j_start, j_end
+!     jm1 = max(j-1,1)
+     jm1 = j-1
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i,k  ,j  )      &
+                                        +alt(i,k  ,jm1)      &
+                                        +alt(i,k+1,j  )      &
+                                        +alt(i,k+1,jm1) ) )  &
+                             *(field(i,k+1,j)-field(i,k,j)   &
+                               -v_base(k+1)   +v_base(k)  )
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end 
+         tendency(i,k,j)=tendency(i,k,j)+                              &
+                g*g*rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j)))*  &
+                              (vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_v
+   
+END SUBROUTINE vertical_diffusion_v
+
+!***************  end new mass coordinate routines
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE calculate_full ( rfield, rfieldb, rfieldp,     &
+                            ids, ide, jds, jde, kds, kde, &
+                            ims, ime, jms, jme, kms, kme, &
+                            its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   INTEGER ,      INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte 
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: rfieldb, &
+                                                                      rfieldp
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT  ) :: rfield
+   
+   ! Local indices.
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   
+!<DESCRIPTION>
+!
+!  calculate_full
+!  calculates full 3D field from pertubation and base field.
+!
+!</DESCRIPTION>
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+   ktf=MIN(kte,kde-1)
+
+   DO j=jts,jtf
+   DO k=kts,ktf
+   DO i=its,itf
+      rfield(i,k,j)=rfieldb(i,k,j)+rfieldp(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE calculate_full
+
+!------------------------------------------------------------------------------
+
+SUBROUTINE coriolis ( ru, rv, rw, ru_tend, rv_tend, rw_tend, &
+                      config_flags,                          &
+                      f, e, sina, cosa, fzm, fzp,            &
+                      ids, ide, jds, jde, kds, kde,          &
+                      ims, ime, jms, jme, kms, kme,          &
+                      its, ite, jts, jte, kts, kte          )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type) ,           INTENT(IN   ) :: config_flags   
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: ru_tend, &
+                                                                rv_tend, &
+                                                                rw_tend
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: ru, &
+                                                                rv, &
+                                                                rw
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: f,    &
+                                                                    e,    &
+                                                                    sina, &
+                                                                    cosa
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm, &
+                                                                  fzp
+   
+   ! Local indices.
+   
+   INTEGER :: i, j , k, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  coriolis calculates the large timestep tendency terms in the 
+!  u, v, and w momentum equations arise from the coriolis force.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+
+! coriolis for u-momentum equation
+
+   i_start = its
+   i_end   = ite
+   IF ( config_flags%open_xs .or. specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+   DO j = jts, MIN(jte,jde-1)
+
+   DO k=kts,ktf
+   DO i = i_start, i_end
+   
+     ru_tend(i,k,j)=ru_tend(i,k,j) + 0.5*(f(i,j)+f(i-1,j)) &
+       *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) &
+           - 0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j)) &
+       *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
+
+   ENDDO
+   ENDDO
+
+   IF ( (config_flags%open_xs) .and. (its == ids) ) THEN
+
+     DO k=kts,ktf
+   
+       ru_tend(its,k,j)=ru_tend(its,k,j) + 0.5*(f(its,j)+f(its,j))   &
+         *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j)) &
+             - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j)) &
+         *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j))
+
+     ENDDO
+
+   ENDIF
+
+   IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN
+
+     DO k=kts,ktf
+   
+       ru_tend(ite,k,j)=ru_tend(ite,k,j) + 0.5*(f(ite-1,j)+f(ite-1,j)) &
+         *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j)) &
+             - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j)) &
+         *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j))
+
+     ENDDO
+
+   ENDIF
+
+   ENDDO
+
+!  coriolis term for v-momentum equation
+
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+
+   IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN
+
+     DO k=kts,ktf
+     DO i=its,MIN(ide-1,ite)
+   
+        rv_tend(i,k,jts)=rv_tend(i,k,jts) - 0.5*(f(i,jts)+f(i,jts))    &
+         *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts))   &
+             + 0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts))   &
+             *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) 
+
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   DO j=j_start, j_end
+   DO k=kts,ktf
+   DO i=its,MIN(ide-1,ite)
+   
+      rv_tend(i,k,j)=rv_tend(i,k,j) - 0.5*(f(i,j)+f(i,j-1))    &
+       *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) &
+           + 0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)+sina(i,j-1)) &
+           *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) 
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+
+   IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN
+
+     DO k=kts,ktf
+     DO i=its,MIN(ide-1,ite)
+   
+        rv_tend(i,k,jte)=rv_tend(i,k,jte) - 0.5*(f(i,jte-1)+f(i,jte-1))        &
+         *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1))   &
+             + 0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1))   &
+             *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) 
+
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+! coriolis term for w-mometum 
+
+   DO j=jts,MIN(jte, jde-1)
+   DO k=kts+1,ktf
+   DO i=its,MIN(ite, ide-1)
+
+       rw_tend(i,k,j)=rw_tend(i,k,j) + e(i,j)*           &
+          (cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j)) &
+          +fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))           &
+          -sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1)) & 
+          +fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE coriolis
+
+!------------------------------------------------------------------------------
+
+SUBROUTINE perturbation_coriolis ( ru_in, rv_in, rw, ru_tend, rv_tend, rw_tend, &
+                                   config_flags,                                &
+                                   u_base, v_base, z_base,                      &
+                                   muu, muv, phb, ph,                           &
+                                   f, e, sina, cosa, fzm, fzp,                  &
+                                   ids, ide, jds, jde, kds, kde,                &
+                                   ims, ime, jms, jme, kms, kme,                &
+                                   its, ite, jts, jte, kts, kte                )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type) ,           INTENT(IN   ) :: config_flags   
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: ru_tend, &
+                                                                rv_tend, &
+                                                                rw_tend
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: ru_in, &
+                                                                      rv_in, &
+                                                                      rw,    &
+                                                                      ph,    &
+                                                                      phb
+
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: f,    &
+                                                                    e,    &
+                                                                    sina, &
+                                                                    cosa
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: muu, &
+                                                                    muv
+                                                                    
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm, &
+                                                                  fzp
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: u_base,  &
+                                                                  v_base,  &
+                                                                  z_base
+   
+   ! Local storage
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: ru, &
+                                                      rv
+
+   REAL  :: z_at_u, z_at_v, wkp1, wk, wkm1
+
+   ! Local indices.
+   
+   INTEGER :: i, j , k, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  perturbation_coriolis calculates the large timestep tendency terms in the 
+!  u, v, and w momentum equations arise from the coriolis force.  This version
+!  subtracts off the horizontal velocities from the initial sounding when
+!  computing the forcing terms, hence "perturbation" coriolis.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+
+! coriolis for u-momentum equation
+
+   i_start = its
+   i_end   = ite
+   IF ( config_flags%open_xs .or. specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+!  compute perturbation mu*v for use in u momentum equation
+
+   DO j = jts, MIN(jte,jde-1)+1
+   DO k=kts+1,ktf-1
+   DO i = i_start-1, i_end
+     z_at_v = 0.25*( phb(i,k,j  )+phb(i,k+1,j  )  &
+                    +phb(i,k,j-1)+phb(i,k+1,j-1)  &
+                    +ph(i,k,j  )+ph(i,k+1,j  )    &
+                    +ph(i,k,j-1)+ph(i,k+1,j-1))/g
+     wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
+     wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
+     wk   = 1.-wkp1-wkm1
+     rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*(            &
+                                  wkm1*v_base(k-1)    &
+                                 +wk  *v_base(k  )    &
+                                 +wkp1*v_base(k+1)   )
+   ENDDO
+   ENDDO
+   ENDDO
+
+
+!  pick up top and bottom v 
+
+   DO j = jts, MIN(jte,jde-1)+1
+   DO i = i_start-1, i_end
+
+     k = kts
+     z_at_v = 0.25*( phb(i,k,j  )+phb(i,k+1,j  )  &
+                    +phb(i,k,j-1)+phb(i,k+1,j-1)  &
+                    +ph(i,k,j  )+ph(i,k+1,j  )    &
+                    +ph(i,k,j-1)+ph(i,k+1,j-1))/g
+     wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
+     wk   = 1.-wkp1
+     rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*(            &
+                                 +wk  *v_base(k  )    &
+                                 +wkp1*v_base(k+1)   )
+
+     k = ktf
+     z_at_v = 0.25*( phb(i,k,j  )+phb(i,k+1,j  )  &
+                    +phb(i,k,j-1)+phb(i,k+1,j-1)  &
+                    +ph(i,k,j  )+ph(i,k+1,j  )    &
+                    +ph(i,k,j-1)+ph(i,k+1,j-1))/g
+     wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
+     wk   = 1.-wkm1
+     rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*(            &
+                                  wkm1*v_base(k-1)    &
+                                 +wk  *v_base(k  )   )
+
+   ENDDO
+   ENDDO
+
+!  compute coriolis forcing for u
+
+   DO j = jts, MIN(jte,jde-1)
+
+   DO k=kts,ktf
+     DO i = i_start, i_end
+       ru_tend(i,k,j)=ru_tend(i,k,j) + 0.5*(f(i,j)+f(i-1,j)) &
+         *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) &
+             - 0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j)) &
+         *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
+     ENDDO
+   ENDDO
+
+   IF ( (config_flags%open_xs) .and. (its == ids) ) THEN
+
+     DO k=kts,ktf
+   
+       ru_tend(its,k,j)=ru_tend(its,k,j) + 0.5*(f(its,j)+f(its,j))   &
+         *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j)) &
+             - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j)) &
+         *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j))
+
+     ENDDO
+
+   ENDIF
+
+   IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN
+
+     DO k=kts,ktf
+   
+       ru_tend(ite,k,j)=ru_tend(ite,k,j) + 0.5*(f(ite-1,j)+f(ite-1,j)) &
+         *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j)) &
+             - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j)) &
+         *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j))
+
+     ENDDO
+
+   ENDIF
+
+   ENDDO
+
+!  coriolis term for v-momentum equation
+
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+
+!  compute perturbation mu*u for use in v momentum equation
+
+   DO j = j_start-1,j_end
+   DO k=kts+1,ktf-1
+   DO i = its, MIN(ite,ide-1)+1
+     z_at_u = 0.25*( phb(i  ,k,j)+phb(i  ,k+1,j)  &
+                    +phb(i-1,k,j)+phb(i-1,k+1,j)  &
+                    +ph(i  ,k,j)+ph(i  ,k+1,j)    &
+                    +ph(i-1,k,j)+ph(i-1,k+1,j))/g
+     wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
+     wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
+     wk   = 1.-wkp1-wkm1
+     ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*(            &
+                                  wkm1*u_base(k-1)    &
+                                 +wk  *u_base(k  )    &
+                                 +wkp1*u_base(k+1)   )
+   ENDDO
+   ENDDO
+   ENDDO
+
+!  pick up top and bottom u
+
+   DO j = j_start-1,j_end
+   DO i = its, MIN(ite,ide-1)+1
+
+     k = kts
+     z_at_u = 0.25*( phb(i  ,k,j)+phb(i  ,k+1,j)  &
+                    +phb(i-1,k,j)+phb(i-1,k+1,j)  &
+                    +ph(i  ,k,j)+ph(i  ,k+1,j)    &
+                    +ph(i-1,k,j)+ph(i-1,k+1,j))/g
+     wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
+     wk   = 1.-wkp1
+     ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*(            &
+                                 +wk  *u_base(k  )    &
+                                 +wkp1*u_base(k+1)   )
+
+
+     k = ktf
+     z_at_u = 0.25*( phb(i  ,k,j)+phb(i  ,k+1,j)  &
+                    +phb(i-1,k,j)+phb(i-1,k+1,j)  &
+                    +ph(i  ,k,j)+ph(i  ,k+1,j)    &
+                    +ph(i-1,k,j)+ph(i-1,k+1,j))/g
+     wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
+     wk   = 1.-wkm1
+     ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*(            &
+                                  wkm1*u_base(k-1)    &
+                                 +wk  *u_base(k  )   )
+
+   ENDDO
+   ENDDO
+
+!  compute coriolis forcing for v momentum equation
+
+   IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN
+
+     DO k=kts,ktf
+     DO i=its,MIN(ide-1,ite)
+   
+        rv_tend(i,k,jts)=rv_tend(i,k,jts) - 0.5*(f(i,jts)+f(i,jts))    &
+         *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts))   &
+             + 0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts))   &
+             *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) 
+
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   DO j=j_start, j_end
+   DO k=kts,ktf
+   DO i=its,MIN(ide-1,ite)
+   
+      rv_tend(i,k,j)=rv_tend(i,k,j) - 0.5*(f(i,j)+f(i,j-1))    &
+       *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) &
+           + 0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)+sina(i,j-1)) &
+           *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) 
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+
+   IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN
+
+     DO k=kts,ktf
+     DO i=its,MIN(ide-1,ite)
+   
+        rv_tend(i,k,jte)=rv_tend(i,k,jte) - 0.5*(f(i,jte-1)+f(i,jte-1))        &
+         *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1))   &
+             + 0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1))   &
+             *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) 
+
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+! coriolis term for w-mometum 
+
+   DO j=jts,MIN(jte, jde-1)
+   DO k=kts+1,ktf
+   DO i=its,MIN(ite, ide-1)
+
+       rw_tend(i,k,j)=rw_tend(i,k,j) + e(i,j)*           &
+          (cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j)) &
+          +fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))           &
+          -sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1)) & 
+          +fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE perturbation_coriolis
+
+!------------------------------------------------------------------------------
+
+SUBROUTINE curvature ( ru, rv, rw, u, v, w, ru_tend, rv_tend, rw_tend, &
+                        config_flags,                                       &
+                        msfu, msfv, fzm, fzp, rdx, rdy,                 &
+                        ids, ide, jds, jde, kds, kde,                   &
+                        ims, ime, jms, jme, kms, kme,                   &
+                        its, ite, jts, jte, kts, kte                   )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   TYPE(grid_config_rec_type) ,           INTENT(IN   ) :: config_flags   
+
+   INTEGER ,                  INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                               ims, ime, jms, jme, kms, kme, &
+                                               its, ite, jts, jte, kts, kte
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                     &
+                                               INTENT(INOUT) :: ru_tend, &
+                                                                rv_tend, &
+                                                                rw_tend
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                     &
+                                               INTENT(IN   ) :: ru,      &
+                                                                rv,      &
+                                                                rw,      &
+                                                                u,       &
+                                                                v,       &
+                                                                w
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,    &
+                                                                msfv
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,     &
+                                                                fzp
+
+   REAL ,                                      INTENT(IN   ) :: rdx,     &
+                                                                rdy
+   
+   ! Local data
+   
+!   INTEGER :: i, j, k, itf, jtf, ktf, kp1, im, ip, jm, jp
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+!   INTEGER :: irmin, irmax, jrmin, jrmax
+
+   REAL , DIMENSION( its-1:ite , kts:kte, jts-1:jte ) :: vxgm
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  curvature calculates the large timestep tendency terms in the 
+!  u, v, and w momentum equations arise from the curvature terms.  
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+
+!   irmin = ims
+!   irmax = ime
+!   jrmin = jms
+!   jrmax = jme
+!   IF ( config_flags%open_xs ) irmin = ids
+!   IF ( config_flags%open_xe ) irmax = ide-1
+!   IF ( config_flags%open_ys ) jrmin = jds
+!   IF ( config_flags%open_ye ) jrmax = jde-1
+   
+! Define v cross grad m at scalar points - vxgm(i,j)
+
+   i_start = its-1
+   i_end   = ite
+   j_start = jts-1
+   j_end   = jte
+
+   IF ( ( config_flags%open_xs .or. specified .or. &
+        config_flags%nested) .and. (its == ids) ) i_start = its
+   IF ( ( config_flags%open_xe .or. specified .or. &
+        config_flags%nested) .and. (ite == ide) ) i_end   = ite-1
+   IF ( ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested) .and. (jts == jds) ) j_start = jts
+   IF ( ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested) .and. (jte == jde) ) j_end   = jte-1
+      IF ( config_flags%periodic_x ) i_start = its-1
+      IF ( config_flags%periodic_x ) i_end = ite
+
+   DO j=j_start, j_end
+   DO k=kts,ktf
+   DO i=i_start, i_end
+      vxgm(i,k,j)=0.5*(u(i,k,j)+u(i+1,k,j))*(msfv(i,j+1)-msfv(i,j))*rdy - &
+                  0.5*(v(i,k,j)+v(i,k,j+1))*(msfu(i+1,j)-msfu(i,j))*rdx
+   ENDDO
+   ENDDO
+   ENDDO
+
+!  Pick up the boundary rows for open (radiation) lateral b.c.
+!  Rather crude at present, we are assuming there is no
+!    variation in this term at the boundary.
+
+   IF ( ( config_flags%open_xs .or. (specified .AND. .NOT. config_flags%periodic_x) .or. &
+        config_flags%nested) .and. (its == ids) ) THEN
+
+     DO j = jts-1, jte
+     DO k = kts, ktf
+       vxgm(its-1,k,j) =  vxgm(its,k,j)
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   IF ( ( config_flags%open_xe .or. (specified .AND. .NOT. config_flags%periodic_x) .or. &
+        config_flags%nested) .and. (ite == ide) ) THEN
+
+     DO j = jts-1, jte
+     DO k = kts, ktf
+       vxgm(ite,k,j) =  vxgm(ite-1,k,j)
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   IF ( ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested) .and. (jts == jds) ) THEN
+
+     DO k = kts, ktf
+     DO i = its-1, ite
+       vxgm(i,k,jts-1) =  vxgm(i,k,jts)
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   IF ( ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested) .and. (jte == jde) ) THEN
+
+     DO k = kts, ktf
+     DO i = its-1, ite
+       vxgm(i,k,jte) =  vxgm(i,k,jte-1)
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+!  curvature term for u momentum eqn.
+
+   i_start = its
+   IF ( config_flags%open_xs .or. specified .or. &
+        config_flags%nested) i_start = MAX ( ids+1 , its )
+   IF ( config_flags%open_xe .or. specified .or. &
+        config_flags%nested) i_end   = MIN ( ide-1 , ite )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+   DO j=jts,MIN(jde-1,jte)
+   DO k=kts,ktf
+   DO i=i_start,i_end
+
+      ru_tend(i,k,j)=ru_tend(i,k,j) + 0.5*(vxgm(i,k,j)+vxgm(i-1,k,j)) &
+              *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) &
+               - u(i,k,j)*reradius &
+              *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+!  curvature term for v momentum eqn.
+
+   j_start = jts
+   IF ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested) j_start = MAX ( jds+1 , jts )
+   IF ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested) j_end   = MIN ( jde-1 , jte ) 
+
+   DO j=j_start,j_end
+   DO k=kts,ktf
+   DO i=its,MIN(ite,ide-1)
+
+      rv_tend(i,k,j)=rv_tend(i,k,j) - 0.5*(vxgm(i,k,j)+vxgm(i,k,j-1)) &
+              *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) &
+                    - v(i,k,j)*reradius                               &
+              *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j))
+
+!
+! correction version 2.2.1
+!
+
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+!  curvature term for vertical momentum eqn.
+
+   DO j=jts,MIN(jte,jde-1)
+   DO k=MAX(2,kts),ktf
+   DO i=its,MIN(ite,ide-1)
+
+      rw_tend(i,k,j)=rw_tend(i,k,j) + reradius*                              &
+    (0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j))) &
+    *0.5*(fzm(k)*( u(i,k,j) +u(i+1,k,j))+fzp(k)*( u(i,k-1,j) +u(i+1,k-1,j)))     &
+    +0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))) &
+    *0.5*(fzm(k)*( v(i,k,j) +v(i,k,j+1))+fzp(k)*( v(i,k-1,j) +v(i,k-1,j+1))))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE curvature
+
+!------------------------------------------------------------------------------
+
+SUBROUTINE decouple ( rr, rfield, field, name, config_flags, &
+                      fzm, fzp,                          &
+                      ids, ide, jds, jde, kds, kde,      &
+                      ims, ime, jms, jme, kms, kme,      &
+                      its, ite, jts, jte, kts, kte      )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+   TYPE(grid_config_rec_type) ,           INTENT(IN   ) :: config_flags   
+
+   INTEGER ,                                   INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                                                ims, ime, jms, jme, kms, kme, &
+                                                                its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,                          INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: rfield
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: rr
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT  ) :: field
+   
+   REAL , DIMENSION( kms:kme ) , INTENT(IN   ) :: fzm, fzp
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   
+!<DESCRIPTION>
+!
+!  decouple decouples a variable from the column dry-air mass.
+!
+!</DESCRIPTION>
+
+   ktf=MIN(kte,kde-1)
+   
+   IF (name .EQ. 'u')THEN
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         field(i,k,j)=rfield(i,k,j)/(0.5*(rr(i,k,j)+rr(i-1,k,j)))
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'v')THEN
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+        DO i=its,itf
+             field(i,k,j)=rfield(i,k,j)/(0.5*(rr(i,k,j)+rr(i,k,j-1)))
+        ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'w')THEN
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      DO j=jts,jtf
+      DO k=kts+1,ktf
+      DO i=its,itf
+         field(i,k,j)=rfield(i,k,j)/(fzm(k)*rr(i,k,j)+fzp(k)*rr(i,k-1,j))
+      ENDDO
+      ENDDO
+      ENDDO
+
+      DO j=jts,jtf
+      DO i=its,itf
+        field(i,kte,j) = 0.
+      ENDDO
+      ENDDO
+
+   ELSE 
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+   ! For theta we will decouple tb and tp and add them to give t afterwards
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         field(i,k,j)=rfield(i,k,j)/rr(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ENDIF
+
+END SUBROUTINE decouple
+
+!-------------------------------------------------------------------------------
+
+
+SUBROUTINE zero_tend ( tendency,                     &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   INTEGER ,                                   INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                                                ims, ime, jms, jme, kms, kme, &
+                                                                its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+!<DESCRIPTION>
+!
+!  zero_tend sets the input tendency array to zero.
+!
+!</DESCRIPTION>
+
+      DO j = jts, jte
+      DO k = kts, kte
+      DO i = its, ite
+        tendency(i,k,j) = 0.
+      ENDDO
+      ENDDO
+      ENDDO
+
+      END SUBROUTINE zero_tend
+
+!======================================================================
+!   physics prep routines
+!======================================================================
+
+   SUBROUTINE phy_prep ( config_flags,                                &  ! input
+                         mu, muu, muv, u, v, w, p, pb, alt, ph,       &  ! input
+                         phb, t, tsk, moist, n_moist,                 &  ! input
+                         mu_3d, rho, th_phy, p_phy , pi_phy ,         &  ! output
+                         u_phy, v_phy, w_phy, p8w, t_phy, t8w,        &  ! output
+                         z, z_at_w, dz8w,                             &  ! output
+                         fzm, fzp,                                    &  ! params
+                         RTHRATEN,                                    &
+                         RTHBLTEN, RUBLTEN, RVBLTEN,                  &
+                         RQVBLTEN, RQCBLTEN, RQIBLTEN,                &
+                         RTHCUTEN, RQVCUTEN, RQCCUTEN,                &
+                         RQRCUTEN, RQICUTEN, RQSCUTEN,                &
+                         RTHFTEN,  RQVFTEN,                           &
+                         RUNDGDTEN, RVNDGDTEN, RTHNDGDTEN,            &
+                         RQVNDGDTEN, RMUNDGDTEN,                      &
+                         ids, ide, jds, jde, kds, kde,                &
+                         ims, ime, jms, jme, kms, kme,                &
+                         its, ite, jts, jte, kts, kte                )
+!----------------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------------
+
+   TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::   ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte
+   INTEGER ,          INTENT(IN   ) :: n_moist
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme , n_moist ), INTENT(IN) :: moist
+
+
+   REAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN   )   ::     TSK, mu, muu, muv
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                 &
+          INTENT(  OUT)                                  ::   u_phy, &
+                                                              v_phy, &
+                                                              w_phy, &
+                                                             pi_phy, &
+                                                              p_phy, &
+                                                                p8w, &
+                                                              t_phy, &
+                                                             th_phy, &
+                                                                t8w, &
+                                                              mu_3d, &
+                                                                rho, &
+                                                                  z, &
+                                                               dz8w, &
+                                                              z_at_w 
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                 &
+          INTENT(IN   )                                  ::      pb, &
+                                                                  p, &
+                                                                  u, &
+                                                                  v, &
+                                                                  w, &
+                                                                alt, &
+                                                                 ph, &
+                                                                phb, &
+                                                                  t
+
+
+   REAL , DIMENSION( kms:kme ) ,           INTENT(IN   ) ::     fzm,   &
+                                                                fzp
+
+   REAL,  DIMENSION( ims:ime , kms:kme, jms:jme ),                   &
+          INTENT(INOUT)   ::                               RTHRATEN  
+
+   REAL,  DIMENSION( ims:ime , kms:kme, jms:jme ),                   &
+          INTENT(INOUT)   ::                               RTHCUTEN, &
+                                                           RQVCUTEN, &
+                                                           RQCCUTEN, &
+                                                           RQRCUTEN, &
+                                                           RQICUTEN, &
+                                                           RQSCUTEN
+
+   REAL,  DIMENSION( ims:ime, kms:kme, jms:jme )                   , &
+          INTENT(INOUT)   ::                                RUBLTEN, &
+                                                            RVBLTEN, &
+                                                           RTHBLTEN, &
+                                                           RQVBLTEN, &
+                                                           RQCBLTEN, &
+                                                           RQIBLTEN
+
+   REAL,  DIMENSION( ims:ime, kms:kme, jms:jme )                   , &
+          INTENT(INOUT)   ::                                RTHFTEN, &
+                                                            RQVFTEN
+
+   REAL,  DIMENSION( ims:ime, kms:kme, jms:jme )                   , &
+          INTENT(INOUT)   ::                                RUNDGDTEN, &
+                                                            RVNDGDTEN, &
+                                                           RTHNDGDTEN, &
+                                                           RQVNDGDTEN, &
+                                                           RMUNDGDTEN
+
+   INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end, i_startu, j_startv
+   INTEGER :: i, j, k
+   REAL    :: w1, w2, z0, z1, z2
+
+!-----------------------------------------------------------------------
+
+!<DESCRIPTION>
+!
+!  phys_prep calculates a number of diagnostic quantities needed by
+!  the physics routines.  It also decouples the physics tendencies from
+!  the column dry-air mass (the physics routines expect to see/update the
+!  uncoupled tendencies).
+!
+!</DESCRIPTION>
+
+!  set up loop bounds for this grid's boundary conditions
+
+    i_start = its
+    i_end   = min( ite,ide-1 )
+    j_start = jts
+    j_end   = min( jte,jde-1 )
+
+    k_start = kts
+    k_end = min( kte, kde-1 )
+
+!  compute thermodynamics and velocities at pressure points
+
+    do j = j_start,j_end
+    do k = k_start, k_end
+    do i = i_start, i_end
+
+      th_phy(i,k,j) = t(i,k,j) + t0
+      p_phy(i,k,j) = p(i,k,j) + pb(i,k,j)
+      pi_phy(i,k,j) = (p_phy(i,k,j)/p1000mb)**rcp
+      !! TAKE INTO ACCOUNT cp=f(T) on Venus
+      IF (planet .eq. "venus" ) THEN
+        t_phy(i,k,j)= (th_phy(i,k,j)**nu - nu*(TT00**nu)*log((p1000mb/p_phy(i,k,j))**rcp))**(1/nu)
+      ELSE
+        t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j)
+      ENDIF
+      rho(i,k,j) = 1./alt(i,k,j)*(1.+moist(i,k,j,P_QV))
+      mu_3d(i,k,j) = mu(i,j)
+      u_phy(i,k,j) = 0.5*(u(i,k,j)+u(i+1,k,j))
+      v_phy(i,k,j) = 0.5*(v(i,k,j)+v(i,k,j+1))
+
+    enddo
+    enddo
+    enddo
+
+!  compute z at w points
+
+    do j = j_start,j_end
+    do k = k_start, kte
+    do i = i_start, i_end
+      z_at_w(i,k,j) = (phb(i,k,j)+ph(i,k,j))/g
+    enddo
+    enddo
+    enddo
+
+    do j = j_start,j_end
+    do k = k_start, kte-1
+    do i = i_start, i_end
+      dz8w(i,k,j) = z_at_w(i,k+1,j)-z_at_w(i,k,j)
+    enddo
+    enddo
+    enddo
+
+    do j = j_start,j_end
+    do i = i_start, i_end
+      dz8w(i,kte,j) = 0.
+    enddo
+    enddo
+
+!  compute z at p points (average of z at w points)
+
+    do j = j_start,j_end
+    do k = k_start, k_end
+    do i = i_start, i_end
+      z(i,k,j) = 0.5*(z_at_w(i,k,j) + z_at_w(i,k+1,j) )
+!!!! MARS MARS ajout aymeric (ainsi que les arguments de cette routine)
+      w_phy(i,k,j) = 0.5*(w(i,k,j) + w(i,k+1,j) )
+    enddo
+    enddo
+    enddo
+
+!  interp t and p at w points
+
+    do j = j_start,j_end
+    do k = 2, k_end
+    do i = i_start, i_end
+      p8w(i,k,j) = fzm(k)*p_phy(i,k,j)+fzp(k)*p_phy(i,k-1,j)
+      t8w(i,k,j) = fzm(k)*t_phy(i,k,j)+fzp(k)*t_phy(i,k-1,j)
+    enddo
+    enddo
+    enddo
+
+!  extrapolate p and t to surface and top.
+!  we'll use an extrapolation in z for now
+
+    do j = j_start,j_end
+    do i = i_start, i_end
+
+! bottom
+
+      z0 = z_at_w(i,1,j)
+      z1 = z(i,1,j)
+      z2 = z(i,2,j)
+      w1 = (z0 - z2)/(z1 - z2)
+      w2 = 1. - w1
+      p8w(i,1,j) = w1*p_phy(i,1,j)+w2*p_phy(i,2,j)
+      t8w(i,1,j) = w1*t_phy(i,1,j)+w2*t_phy(i,2,j)
+
+! top
+
+      z0 = z_at_w(i,kte,j)
+      z1 = z(i,k_end,j)
+      z2 = z(i,k_end-1,j)
+      w1 = (z0 - z2)/(z1 - z2)
+      w2 = 1. - w1
+
+!      p8w(i,kde,j) = w1*p_phy(i,kde-1,j)+w2*p_phy(i,kde-2,j)
+!!!  bug fix      extrapolate ln(p) so p is positive definite
+      p8w(i,kde,j) = exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,kde-2,j)))
+      t8w(i,kde,j) = w1*t_phy(i,kde-1,j)+w2*t_phy(i,kde-2,j)
+
+    enddo
+    enddo
+
+! decouple all physics tendencies
+
+   IF (config_flags%ra_lw_physics .gt. 0 .or. config_flags%ra_sw_physics .gt. 0) THEN
+
+      DO J=j_start,j_end
+      DO K=k_start,k_end
+      DO I=i_start,i_end
+         RTHRATEN(I,K,J)=RTHRATEN(I,K,J)/mu(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ENDIF
+
+   IF (config_flags%cu_physics .gt. 0) THEN
+
+      DO J=j_start,j_end
+      DO I=i_start,i_end
+      DO K=k_start,k_end
+         RTHCUTEN(I,K,J)=RTHCUTEN(I,K,J)/mu(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQVCUTEN(I,K,J)=RQVCUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQCCUTEN(I,K,J)=RQCCUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQRCUTEN(I,K,J)=RQRCUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQICUTEN(I,K,J)=RQICUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQSCUTEN(I,K,J)=RQSCUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+   ENDIF
+
+   IF ( (config_flags%bl_pbl_physics .gt. 0) &
+        .OR. (config_flags%modif_wrf) ) THEN
+!****MARS
+      DO J=j_start,j_end
+      DO K=k_start,k_end
+      DO I=i_start,i_end
+         RUBLTEN(I,K,J) =RUBLTEN(I,K,J)/mu(I,J)
+         RVBLTEN(I,K,J) =RVBLTEN(I,K,J)/mu(I,J)
+         RTHBLTEN(I,K,J)=RTHBLTEN(I,K,J)/mu(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=j_start,j_end
+         DO K=k_start,k_end
+         DO I=i_start,i_end
+            RQVBLTEN(I,K,J)=RQVBLTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QC .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=j_start,j_end
+         DO K=k_start,k_end
+         DO I=i_start,i_end
+           RQCBLTEN(I,K,J)=RQCBLTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=j_start,j_end
+         DO K=k_start,k_end
+         DO I=i_start,i_end
+            RQIBLTEN(I,K,J)=RQIBLTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+    ENDIF
+
+!  decouple advective forcing required by Grell-Devenyi scheme
+
+   if ( config_flags%cu_physics == GDSCHEME ) then
+
+      DO J=j_start,j_end
+      DO I=i_start,i_end
+         DO K=k_start,k_end
+            RTHFTEN(I,K,J)=RTHFTEN(I,K,J)/mu(I,J)
+         ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+            DO K=k_start,k_end
+               RQVFTEN(I,K,J)=RQVFTEN(I,K,J)/mu(I,J)
+            ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+   END IF
+
+! fdda
+! note fdda u and v tendencies are staggered, also only interior points have muu/muv,
+!   so only decouple those
+
+   IF (config_flags%grid_fdda .gt. 0) THEN
+
+      i_startu=MAX(its,ids+1)
+      j_startv=MAX(jts,jds+1)
+
+      DO J=j_start,j_end
+      DO K=k_start,k_end
+      DO I=i_startu,i_end
+         RUNDGDTEN(I,K,J) =RUNDGDTEN(I,K,J)/muu(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+      DO J=j_startv,j_end
+      DO K=k_start,k_end
+      DO I=i_start,i_end
+         RVNDGDTEN(I,K,J) =RVNDGDTEN(I,K,J)/muv(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+      DO J=j_start,j_end
+      DO K=k_start,k_end
+      DO I=i_start,i_end
+         RTHNDGDTEN(I,K,J)=RTHNDGDTEN(I,K,J)/mu(I,J)
+!        RMUNDGDTEN(I,J) - no coupling
+      ENDDO
+      ENDDO
+      ENDDO
+      IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=j_start,j_end
+         DO K=k_start,k_end
+         DO I=i_start,i_end
+            RQVNDGDTEN(I,K,J)=RQVNDGDTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+    ENDIF
+
+END SUBROUTINE phy_prep
+
+!------------------------------------------------------------
+
+   SUBROUTINE moist_physics_prep_em( t_new, t_old, t0, rho, al, alb, &
+                                     p, p8w, p0, pb, ph, phb,        &
+                                     th_phy, pii, pf,                &
+                                     z, z_at_w, dz8w,                &
+                                     dt,h_diabatic,                  &
+                                     config_flags,fzm, fzp,          &
+                                     ids,ide, jds,jde, kds,kde,      &
+                                     ims,ime, jms,jme, kms,kme,      &
+                                     its,ite, jts,jte, kts,kte      )
+
+   IMPLICIT NONE
+
+! Here we construct full fields
+! needed by the microphysics
+
+   TYPE(grid_config_rec_type),    INTENT(IN   )    :: config_flags
+
+   INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+   INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+   INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+   REAL, INTENT(IN   )  ::  dt
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),        &
+         INTENT(IN   ) ::                           al,  &
+                                                    alb, &
+                                                    p,   &
+                                                    pb,  &
+                                                    ph,  &
+                                                    phb
+
+
+   REAL , DIMENSION( kms:kme ) ,           INTENT(IN   ) ::   fzm, &
+                                                              fzp
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),       &
+         INTENT(  OUT) ::                         rho,  &
+                                               th_phy,  &
+                                                  pii,  &
+                                                  pf,   &
+                                                    z,  &
+                                               z_at_w,  &
+                                                 dz8w,  &
+                                                  p8w
+! pjj/cray
+!                                                 p8w,  &
+!                                          h_diabatic
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),       &
+         INTENT(INOUT) ::                         h_diabatic
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),        &
+         INTENT(INOUT) ::                         t_new, &
+                                                  t_old
+
+   REAL, INTENT(IN   ) :: t0, p0
+   REAL                :: z0,z1,z2,w1,w2
+
+   INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
+   INTEGER :: i, j, k
+
+!--------------------------------------------------------------------
+
+!<DESCRIPTION>
+!
+!  moist_phys_prep_em calculates a number of diagnostic quantities needed by
+!  the microphysics routines.
+!
+!</DESCRIPTION>
+
+!  set up loop bounds for this grid's boundary conditions
+
+    i_start = its    
+    i_end   = min( ite,ide-1 )
+    j_start = jts    
+    j_end   = min( jte,jde-1 )
+
+    k_start = kts
+    k_end = min( kte, kde-1 )
+
+     DO j = j_start, j_end
+     DO k = k_start, kte
+     DO i = i_start, i_end
+       z_at_w(i,k,j) = (ph(i,k,j)+phb(i,k,j))/g
+     ENDDO
+     ENDDO
+     ENDDO
+
+    do j = j_start,j_end
+    do k = k_start, kte-1
+    do i = i_start, i_end
+      dz8w(i,k,j) = z_at_w(i,k+1,j)-z_at_w(i,k,j)
+    enddo
+    enddo
+    enddo
+
+    do j = j_start,j_end
+    do i = i_start, i_end
+      dz8w(i,kte,j) = 0.
+    enddo
+    enddo
+
+
+           !  compute full pii, rho, and z at the new time-level
+           !  (needed for physics).
+           !  convert perturbation theta to full theta (th_phy)
+           !  use h_diabatic to temporarily save pre-microphysics full theta
+
+     DO j = j_start, j_end
+     DO k = k_start, k_end
+     DO i = i_start, i_end
+
+#ifdef REVERT
+       t_new(i,k,j) = t_new(i,k,j)-h_diabatic(i,k,j)*dt
+#endif
+       th_phy(i,k,j) = t_new(i,k,j) + t0
+       h_diabatic(i,k,j) = th_phy(i,k,j)
+       rho(i,k,j)  = 1./(al(i,k,j)+alb(i,k,j))
+       pii(i,k,j) = ((p(i,k,j)+pb(i,k,j))/p0)**rcp
+       z(i,k,j) = 0.5*(z_at_w(i,k,j) +z_at_w(i,k+1,j) )
+       pf(i,k,j) = p(i,k,j)+pb(i,k,j)
+
+     ENDDO
+     ENDDO
+     ENDDO
+
+!  interp t and p at w points
+
+    do j = j_start,j_end
+    do k = 2, k_end
+    do i = i_start, i_end
+      p8w(i,k,j) = fzm(k)*pf(i,k,j)+fzp(k)*pf(i,k-1,j)
+    enddo
+    enddo
+    enddo
+
+!  extrapolate p and t to surface and top.
+!  we'll use an extrapolation in z for now
+
+    do j = j_start,j_end
+    do i = i_start, i_end
+
+! bottom
+
+      z0 = z_at_w(i,1,j)
+      z1 = z(i,1,j)
+      z2 = z(i,2,j)
+      w1 = (z0 - z2)/(z1 - z2)
+      w2 = 1. - w1
+      p8w(i,1,j) = w1*pf(i,1,j)+w2*pf(i,2,j)
+
+! top
+
+      z0 = z_at_w(i,kte,j)
+      z1 = z(i,k_end,j)
+      z2 = z(i,k_end-1,j)
+      w1 = (z0 - z2)/(z1 - z2)
+      w2 = 1. - w1
+!      p8w(i,kde,j) = w1*pf(i,kde-1,j)+w2*pf(i,kde-2,j)
+      p8w(i,kde,j) = exp(w1*log(pf(i,kde-1,j))+w2*log(pf(i,kde-2,j)))
+
+    enddo
+    enddo
+
+   END SUBROUTINE moist_physics_prep_em
+
+!------------------------------------------------------------------------------
+
+   SUBROUTINE moist_physics_finish_em( t_new, t_old, t0, mut,     &
+                                       th_phy, h_diabatic, dt,    &
+                                       config_flags,              &
+                                       ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte )
+
+   IMPLICIT NONE
+
+! Here we construct full fields
+! needed by the microphysics
+
+   TYPE(grid_config_rec_type),    INTENT(IN   )    :: config_flags
+
+   INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+   INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+   INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),        &
+         INTENT(INOUT) ::                         t_new, &
+                                                  t_old, &
+                                                 th_phy, &
+                                                  h_diabatic
+
+   REAL, DIMENSION( ims:ime , jms:jme ),  INTENT(INOUT) ::  mut
+
+
+   REAL, INTENT(IN   ) :: t0, dt
+
+   INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
+   INTEGER :: i, j, k
+
+!--------------------------------------------------------------------
+
+!<DESCRIPTION>
+!
+!  moist_phys_finish_em resets theta to its perturbation value and
+!  computes and stores the microphysics diabatic heating term.
+!
+!</DESCRIPTION>
+
+!  set up loop bounds for this grid's boundary conditions
+
+
+    i_start = its    
+    i_end   = min( ite,ide-1 )
+    j_start = jts    
+    j_end   = min( jte,jde-1 )
+
+    k_start = kts
+    k_end = min( kte, kde-1 )
+
+!  add microphysics theta diff to perturbation theta, set h_diabatic
+
+     DO j = j_start, j_end
+     DO k = k_start, k_end
+     DO i = i_start, i_end
+
+       t_new(i,k,j) = t_new(i,k,j) + (th_phy(i,k,j)-h_diabatic(i,k,j))
+       h_diabatic(i,k,j) = (th_phy(i,k,j)-h_diabatic(i,k,j))/dt
+!       h_diabatic(i,k,j) = 0.
+
+     ENDDO
+     ENDDO
+     ENDDO
+
+   END SUBROUTINE moist_physics_finish_em
+
+!----------------------------------------------------------------
+
+
+   SUBROUTINE init_module_big_step
+   END SUBROUTINE init_module_big_step
+
+SUBROUTINE set_tend ( field, field_adv_tend, msf,       &
+                      ids, ide, jds, jde, kds, kde,     &
+                      ims, ime, jms, jme, kms, kme,     &
+                      its, ite, jts, jte, kts, kte       )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+   INTEGER ,  INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                               ims, ime, jms, jme, kms, kme, &
+                               its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: field
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN)  :: field_adv_tend
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN)  :: msf
+
+   ! Local data
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+!<DESCRIPTION>
+!
+!  set_tend copies the advective tendency array into the tendency array.
+!
+!</DESCRIPTION>
+
+      jtf = MIN(jte,jde-1)
+      ktf = MIN(kte,kde-1)
+      itf = MIN(ite,ide-1)
+      DO j = jts, jtf
+      DO k = kts, ktf
+      DO i = its, itf
+         field(i,k,j) = field_adv_tend(i,k,j)*msf(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE set_tend
+
+!------------------------------------------------------------------------------
+
+    SUBROUTINE rk_rayleigh_damp( ru_tendf, rv_tendf,              &
+                                 rw_tendf, t_tendf,               &
+                                 u, v, w, t, t_init,              &
+                                 mut, muu, muv, ph, phb,          &
+                                 u_base, v_base, t_base, z_base,  &
+                                 dampcoef, zdamp,                 &
+                                 ids, ide, jds, jde, kds, kde,    &
+                                 ims, ime, jms, jme, kms, kme,    &
+                                 its, ite, jts, jte, kts, kte   )
+
+! History:     Apr 2005  Modifications by George Bryan, NCAR:
+!                  - Generalized the code in a way that allows for
+!                    simulations with steep terrain.
+!
+!              Jul 2004  Modifications by George Bryan, NCAR:
+!                  - Modified the code to use u_base, v_base, and t_base
+!                    arrays for the background state.  Removed the hard-wired
+!                    base-state values.
+!                  - Modified the code to use dampcoef, zdamp, and damp_opt,
+!                    i.e., the upper-level damper variables in namelist.input.
+!                    Removed the hard-wired variables in the older version.
+!                    This damper is used when damp_opt = 2.
+!                  - Modified the code to account for the movement of the
+!                    model surfaces with time.  The code now obtains a base-
+!                    state value by interpolation using the "_base" arrays.
+
+!              Nov 2003  Bug fix by Jason Knievel, NCAR
+
+!              Aug 2003  Meridional dimension, some comments, and
+!                        changes in layout of the code added by
+!                        Jason Knievel, NCAR
+
+!              Jul 2003  Original code by Bill Skamarock, NCAR
+
+! Purpose:     This routine applies Rayleigh damping to a layer at top
+!              of the model domain.
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: ru_tendf, rv_tendf, rw_tendf, t_tendf
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: u, v, w, t, t_init, ph, phb
+
+    REAL, DIMENSION( ims:ime, jms:jme ),  INTENT( IN )  &
+    :: mut, muu, muv
+
+    REAL, DIMENSION( kms:kme ) ,  INTENT(IN   )  &
+    :: u_base, v_base, t_base, z_base
+
+    REAL, INTENT(IN   )   &
+    :: dampcoef, zdamp
+
+! Local variables.
+
+    INTEGER  &
+    :: i_start, i_end, j_start, j_end, k_start, k_end, i, j, k, ktf, k1, k2
+
+    REAL  &
+    :: pii, dcoef, z, ztop
+
+    REAL :: wkp1, wk, wkm1
+
+    REAL, DIMENSION( kms:kme ) :: z00, u00, v00, t00
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    pii = 2.0 * asin(1.0)
+
+    ktf = MIN( kte,   kde-1 )
+
+!-----------------------------------------------------------------------
+! Adjust u to base state.
+
+    DO j = jts, MIN( jte, jde-1 )
+    DO i = its, MIN( ite, ide   )
+
+      ! Get height at top of model
+      ztop = 0.5*( phb(i  ,kde,j)+phb(i-1,kde,j)   &
+                  +ph(i  ,kde,j)+ph(i-1,kde,j) )/g
+
+      ! Find bottom of damping layer
+      k1 = ktf
+      z = ztop
+      DO WHILE( z >= (ztop-zdamp) )
+        z = 0.25*( phb(i  ,k1,j)+phb(i  ,k1+1,j)  &
+                  +phb(i-1,k1,j)+phb(i-1,k1+1,j)  &
+                  +ph(i  ,k1,j)+ph(i  ,k1+1,j)    &
+                  +ph(i-1,k1,j)+ph(i-1,k1+1,j))/g
+        z00(k1) = z
+        k1 = k1 - 1
+      ENDDO
+      k1 = k1 + 2
+
+      ! Get reference state at model levels
+      DO k = k1, ktf
+        k2 = ktf
+        DO WHILE( z_base(k2) .gt. z00(k) )
+          k2 = k2 - 1
+        ENDDO
+        if(k2+1.gt.ktf)then
+          u00(k) = u_base(k2) + ( u_base(k2) - u_base(k2-1) )   &
+                              * (     z00(k) - z_base(k2)   )   &
+                              / ( z_base(k2) - z_base(k2-1) )
+        else
+          u00(k) = u_base(k2) + ( u_base(k2+1) - u_base(k2) )   &
+                              * (       z00(k) - z_base(k2) )   &
+                              / ( z_base(k2+1) - z_base(k2) )
+        endif
+      ENDDO
+
+      ! Apply the Rayleigh damper
+      DO k = k1, ktf
+        dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp )
+        dcoef = (SIN( 0.5 * pii * dcoef ) )**2
+        ru_tendf(i,k,j) = ru_tendf(i,k,j) -                    &
+                          muu(i,j) * ( dcoef * dampcoef ) *    &
+                          ( u(i,k,j) - u00(k) )
+      END DO
+
+    END DO
+    END DO
+
+! End adjustment of u.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Adjust v to base state.
+
+    DO j = jts, MIN( jte, jde   )
+    DO i = its, MIN( ite, ide-1 )
+
+      ! Get height at top of model
+      ztop = 0.5*( phb(i,kde,j  )+phb(i,kde,j-1)   &
+                  +ph(i,kde,j  )+ph(i,kde,j-1) )/g
+
+      ! Find bottom of damping layer
+      k1 = ktf
+      z = ztop
+      DO WHILE( z >= (ztop-zdamp) )
+        z = 0.25*( phb(i,k1,j  )+phb(i,k1+1,j  )  &
+                  +phb(i,k1,j-1)+phb(i,k1+1,j-1)  &
+                  +ph(i,k1,j  )+ph(i,k1+1,j  )    &
+                  +ph(i,k1,j-1)+ph(i,k1+1,j-1))/g
+        z00(k1) = z
+        k1 = k1 - 1
+      ENDDO
+      k1 = k1 + 2
+
+      ! Get reference state at model levels
+      DO k = k1, ktf
+        k2 = ktf
+        DO WHILE( z_base(k2) .gt. z00(k) )
+          k2 = k2 - 1
+        ENDDO
+        if(k2+1.gt.ktf)then
+          v00(k) = v_base(k2) + ( v_base(k2) - v_base(k2-1) )   &
+                              * (     z00(k) - z_base(k2)   )   &
+                              / ( z_base(k2) - z_base(k2-1) )
+        else
+          v00(k) = v_base(k2) + ( v_base(k2+1) - v_base(k2) )   &
+                              * (       z00(k) - z_base(k2) )   &
+                              / ( z_base(k2+1) - z_base(k2) )
+        endif
+      ENDDO
+
+      ! Apply the Rayleigh damper
+      DO k = k1, ktf
+        dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp )
+        dcoef = (SIN( 0.5 * pii * dcoef ) )**2
+        rv_tendf(i,k,j) = rv_tendf(i,k,j) -                    &
+                          muv(i,j) * ( dcoef * dampcoef ) *    &
+                          ( v(i,k,j) - v00(k) )
+      END DO
+
+    END DO
+    END DO
+
+! End adjustment of v.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Adjust w to base state.
+
+    DO j = jts, MIN( jte,   jde-1 )
+    DO i = its, MIN( ite,   ide-1 )
+      ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g
+      DO k = kts, MIN( kte,   kde   )
+        z = ( phb(i,k,j) + ph(i,k,j) ) / g
+        IF ( z >= (ztop-zdamp) ) THEN
+          dcoef = 1.0 - MIN( 1.0, ( ztop - z ) / zdamp )
+          dcoef = ( SIN( 0.5 * pii * dcoef ) )**2
+          rw_tendf(i,k,j) = rw_tendf(i,k,j) -  &
+                            mut(i,j) * ( dcoef * dampcoef ) * w(i,k,j)
+        END IF
+      END DO
+    END DO
+    END DO
+
+! End adjustment of w.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Adjust potential temperature to base state.
+
+    DO j = jts, MIN( jte,   jde-1 )
+    DO i = its, MIN( ite,   ide-1 )
+
+      ! Get height at top of model
+      ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g
+
+      ! Find bottom of damping layer
+      k1 = ktf
+      z = ztop
+      DO WHILE( z >= (ztop-zdamp) )
+        z = 0.5 * ( phb(i,k1,j) + phb(i,k1+1,j) +  &
+                     ph(i,k1,j) +  ph(i,k1+1,j) ) / g
+        z00(k1) = z
+        k1 = k1 - 1
+      ENDDO
+      k1 = k1 + 2
+
+      ! Get reference state at model levels
+      DO k = k1, ktf
+        k2 = ktf
+        DO WHILE( z_base(k2) .gt. z00(k) )
+          k2 = k2 - 1
+        ENDDO
+        if(k2+1.gt.ktf)then
+          t00(k) = t_base(k2) + ( t_base(k2) - t_base(k2-1) )   &
+                              * (     z00(k) - z_base(k2)   )   &
+                              / ( z_base(k2) - z_base(k2-1) )
+        else
+          t00(k) = t_base(k2) + ( t_base(k2+1) - t_base(k2) )   &
+                              * (       z00(k) - z_base(k2) )   &
+                              / ( z_base(k2+1) - z_base(k2) )
+        endif
+      ENDDO
+
+      ! Apply the Rayleigh damper
+      DO k = k1, ktf
+        dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp )
+        dcoef = (SIN( 0.5 * pii * dcoef ) )**2
+        t_tendf(i,k,j) = t_tendf(i,k,j) -                      &
+                         mut(i,j) * ( dcoef * dampcoef )  *    &
+                         ( t(i,k,j) - t00(k) )
+      END DO
+
+    END DO
+    END DO
+
+! End adjustment of potential temperature.
+!-----------------------------------------------------------------------
+
+    END SUBROUTINE rk_rayleigh_damp
+
+!==============================================================================
+!==============================================================================
+                                                                                
+      SUBROUTINE sixth_order_diffusion( name, field, tendency, mu, dt,  &
+                                        config_flags,                   &
+                                        diff_6th_opt, diff_6th_factor,  &
+                                        ids, ide, jds, jde, kds, kde,   &
+                                        ims, ime, jms, jme, kms, kme,   &
+                                        its, ite, jts, jte, kts, kte )
+                                                                                
+! History:       14 Nov 2006   Name of variable changed by Jason Knievel
+!                07 Jun 2006   Revised and generalized by Jason Knievel  
+!                25 Apr 2005   Original code by Jason Knievel, NCAR
+                                                                                
+! Purpose:       Apply 6th-order, monotonic (flux-limited), numerical
+!                diffusion to 3-d velocity and to scalars.
+                                                                                
+! References:    Ming Xue (MWR Aug 2000)
+!                Durran ("Numerical Methods for Wave Equations..." 1999)
+!                George Bryan (personal communication)
+ 
+!------------------------------------------------------------------------------
+! Begin: Declarations.
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(IN)  &
+    :: ids, ide, jds, jde, kds, kde,   &
+       ims, ime, jms, jme, kms, kme,   &
+       its, ite, jts, jte, kts, kte
+ 
+    TYPE(grid_config_rec_type), INTENT(IN)  &
+    :: config_flags
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT)  &
+    :: tendency
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN)  &
+    :: field
+ 
+    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  &
+    :: mu
+ 
+    REAL, INTENT(IN)  &
+    :: dt
+
+    REAL, INTENT(IN)  &
+    :: diff_6th_factor
+
+    INTEGER, INTENT(IN)  &
+    :: diff_6th_opt
+
+    CHARACTER(LEN=1) , INTENT(IN)  &
+    :: name
+
+    INTEGER  &
+    :: i, j, k,         &
+       i_start, i_end,  &
+       j_start, j_end,  &
+       k_start, k_end,  &
+       ktf
+ 
+    REAL  &
+    :: dflux_x_p0, dflux_y_p0,  &
+       dflux_x_p1, dflux_y_p1,  &
+       tendency_x, tendency_y,  &
+       mu_avg_p0, mu_avg_p1,    &
+       diff_6th_coef
+
+    LOGICAL  &
+    :: specified
+ 
+! End: Declarations.
+!------------------------------------------------------------------------------
+
+!------------------------------------------------------------------------------
+! Begin: Translate the diffusion factor into a diffusion coefficient.  See
+! Durran's text, section 2.4.3, then adjust for sixth-order diffusion (not
+! fourth) and for diffusion in two dimensions (not one).  For reference, a
+! factor of 1.0 would mean complete diffusion of a 2dx wave in one time step,
+! although application of the flux limiter reduces somewhat the effects of
+! diffusion for a given coefficient.
+
+    diff_6th_coef = diff_6th_factor * 0.015625 / ( 2.0 * dt )  
+
+! End: Translate diffusion factor.
+!------------------------------------------------------------------------------
+
+!------------------------------------------------------------------------------
+! Begin: Assign limits of spatial loops depending on variable to be diffused.
+! The halo regions are already filled with values by the time this subroutine
+! is called, which allows the stencil to extend beyond the domains' edges.
+
+    ktf = MIN( kte, kde-1 )
+
+    IF ( name .EQ. 'u' ) THEN
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jde-1,jte)
+      k_start = kts
+      k_end   = ktf
+
+    ELSE IF ( name .EQ. 'v' ) THEN
+ 
+      i_start = its
+      i_end   = MIN(ide-1,ite)
+      j_start = jts
+      j_end   = jte
+      k_start = kts
+      k_end   = ktf
+ 
+    ELSE IF ( name .EQ. 'w' ) THEN
+
+      i_start = its
+      i_end   = MIN(ide-1,ite)
+      j_start = jts
+      j_end   = MIN(jde-1,jte)
+      k_start = kts+1
+      k_end   = ktf
+
+    ELSE
+
+      i_start = its
+      i_end   = MIN(ide-1,ite)
+      j_start = jts
+      j_end   = MIN(jde-1,jte)
+      k_start = kts
+      k_end   = ktf
+ 
+    ENDIF
+
+! End: Assignment of limits of spatial loops.
+!------------------------------------------------------------------------------
+
+!------------------------------------------------------------------------------
+! Begin: Loop across spatial dimensions.
+
+    DO j = j_start, j_end
+    DO k = k_start, k_end
+    DO i = i_start, i_end
+
+!------------------------------------------------------------------------------
+! Begin: Diffusion in x (i index).
+ 
+! Calculate the diffusive flux in x direction (from Xue's eq. 3).
+ 
+      dflux_x_p0 = (  10.0 * ( field(i,  k,j) - field(i-1,k,j) )    &
+                     - 5.0 * ( field(i+1,k,j) - field(i-2,k,j) )    &
+                     +       ( field(i+2,k,j) - field(i-3,k,j) ) )
+ 
+      dflux_x_p1 = (  10.0 * ( field(i+1,k,j) - field(i  ,k,j) )    &
+                     - 5.0 * ( field(i+2,k,j) - field(i-1,k,j) )    &
+                     +       ( field(i+3,k,j) - field(i-2,k,j) ) )
+ 
+! If requested in the namelist (diff_6th_opt=2), prohibit up-gradient diffusion
+! (variation on Xue's eq. 10).
+
+      IF ( diff_6th_opt .EQ. 2 ) THEN
+ 
+        IF ( dflux_x_p0 * ( field(i  ,k,j)-field(i-1,k,j) ) .LE. 0.0 ) THEN
+          dflux_x_p0 = 0.0
+        END IF
+ 
+        IF ( dflux_x_p1 * ( field(i+1,k,j)-field(i  ,k,j) ) .LE. 0.0 ) THEN
+          dflux_x_p1 = 0.0
+        END IF
+
+      END IF
+
+! Apply 6th-order diffusion in x direction.
+ 
+      IF      ( name .EQ. 'u' ) THEN
+        mu_avg_p0 = mu(i-1,j)
+        mu_avg_p1 = mu(i  ,j)
+      ELSE IF ( name .EQ. 'v' ) THEN
+        mu_avg_p0 = 0.25 * (       &
+                    mu(i-1,j-1) +  &
+                    mu(i  ,j-1) +  &
+                    mu(i-1,j  ) +  &
+                    mu(i  ,j  ) )
+        mu_avg_p1 = 0.25 * (       &
+                    mu(i  ,j-1) +  &
+                    mu(i+1,j-1) +  &
+                    mu(i  ,j  ) +  &
+                    mu(i+1,j  ) )
+      ELSE
+        mu_avg_p0 = 0.5 * (        &
+                    mu(i-1,j) +    &
+                    mu(i  ,j) )
+        mu_avg_p1 = 0.5 * (        &
+                    mu(i  ,j) +    &
+                    mu(i+1,j) )
+      END IF
+ 
+      tendency_x = diff_6th_coef *  &
+                 ( ( mu_avg_p1 * dflux_x_p1 ) - ( mu_avg_p0 * dflux_x_p0 ) )
+ 
+! End: Diffusion in x.
+!------------------------------------------------------------------------------
+ 
+!------------------------------------------------------------------------------
+! Begin: Diffusion in y (j index).
+ 
+! Calculate the diffusive flux in y direction (from Xue's eq. 3).
+ 
+      dflux_y_p0 = (  10.0 * ( field(i,k,j  ) - field(i,k,j-1) )    &
+                     - 5.0 * ( field(i,k,j+1) - field(i,k,j-2) )    &
+                     +       ( field(i,k,j+2) - field(i,k,j-3) ) )
+ 
+      dflux_y_p1 = (  10.0 * ( field(i,k,j+1) - field(i,k,j  ) )    &
+                     - 5.0 * ( field(i,k,j+2) - field(i,k,j-1) )    &
+                     +       ( field(i,k,j+3) - field(i,k,j-2) ) )
+ 
+! If requested in the namelist (diff_6th_opt=2), prohibit up-gradient diffusion
+! (variation on Xue's eq. 10).
+
+      IF ( diff_6th_opt .EQ. 2 ) THEN
+ 
+        IF ( dflux_y_p0 * ( field(i,k,j  )-field(i,k,j-1) ) .LE. 0.0 ) THEN
+          dflux_y_p0 = 0.0
+        END IF
+ 
+        IF ( dflux_y_p1 * ( field(i,k,j+1)-field(i,k,j  ) ) .LE. 0.0 ) THEN
+          dflux_y_p1 = 0.0
+        END IF
+
+      END IF
+ 
+! Apply 6th-order diffusion in y direction.
+ 
+      IF      ( name .EQ. 'u' ) THEN
+        mu_avg_p0 = 0.25 * (       &
+                    mu(i-1,j-1) +  &
+                    mu(i  ,j-1) +  &
+                    mu(i-1,j  ) +  &
+                    mu(i  ,j  ) )
+        mu_avg_p1 = 0.25 * (       &
+                    mu(i-1,j  ) +  &
+                    mu(i  ,j  ) +  &
+                    mu(i-1,j+1) +  &
+                    mu(i  ,j+1) )
+      ELSE IF ( name .EQ. 'v' ) THEN
+        mu_avg_p0 = mu(i,j-1)
+        mu_avg_p1 = mu(i,j  )
+      ELSE
+        mu_avg_p0 = 0.5 * (      &
+                    mu(i,j-1) +  &
+                    mu(i,j  ) )
+        mu_avg_p1 = 0.5 * (      &
+                    mu(i,j  ) +  &
+                    mu(i,j+1) )
+      END IF
+ 
+      tendency_y = diff_6th_coef *  &
+                 ( ( mu_avg_p1 * dflux_y_p1 ) - ( mu_avg_p0 * dflux_y_p0 ) )
+ 
+! End: Diffusion in y.
+!------------------------------------------------------------------------------
+ 
+!------------------------------------------------------------------------------
+! Begin: Combine diffusion in x and y.
+     
+      tendency(i,k,j) = tendency(i,k,j) + tendency_x + tendency_y
+ 
+! End: Combine diffusion in x and y.
+!------------------------------------------------------------------------------
+
+    ENDDO
+    ENDDO
+    ENDDO
+
+! End: Loop across spatial dimensions.
+!------------------------------------------------------------------------------
+ 
+    END SUBROUTINE sixth_order_diffusion
+ 
+!==============================================================================
+!==============================================================================
+
+END MODULE module_big_step_utilities_em
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_diffusion_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_diffusion_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_diffusion_em.F	(revision 2744)
@@ -0,0 +1,5235 @@
+! WRF:MODEL_LAYER:PHYSICS
+ 
+    MODULE module_diffusion_em
+
+    USE module_configure
+    USE module_bc
+    USE module_state_description
+    USE module_big_step_utilities_em
+    USE module_model_constants    
+    USE module_wrf_error
+
+!!!******MARS MARS
+!!!******MARS MARS
+!!! mixing coefficients are defined here so that
+!!! module_model_constants can be common btw WRFV2&3 
+                                      ! proportionality constants for eddy viscosity coefficient calc
+   REAL    , PARAMETER ::  c_s = .25  ! turbulence parameterization constant, for smagorinsky
+!   REAL    , PARAMETER ::  c_s = .1  ! turbulence parameterization constant, for smagorinsky
+   REAL    , PARAMETER ::  c_k = .15  ! turbulence parameterization constant, for TKE
+!!!******MARS MARS
+!!!******MARS MARS
+
+    CONTAINS
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div,       &
+                                   defor11, defor22, defor33,        &
+                                   defor12, defor13, defor23,        &
+                                   u_base, v_base,msfu, msfv, msft,  &
+                                   rdx, rdy, dn, dnw, rdz, rdzw,     &
+                                   fnm, fnp, cf1, cf2, cf3, zx, zy,  &
+                                   ids, ide, jds, jde, kds, kde,     &
+                                   ims, ime, jms, jme, kms, kme,     &
+                                   its, ite, jts, jte, kts, kte      )
+
+! History:     Sep 2003  Changes by Jason Knievel and George Bryan, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              ...        ...
+
+! Purpose:     This routine calculates deformation and 3-d divergence.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde, &
+       ims, ime, jms, jme, kms, kme, &
+       its, ite, jts, jte, kts, kte
+
+    REAL, INTENT( IN )  &
+    :: rdx, rdy, cf1, cf2, cf3
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp, dn, dnw, u_base, v_base
+
+    REAL, DIMENSION( ims:ime , jms:jme ),  INTENT( IN )  &
+    :: msfu, msfv, msft
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    ::  u, v, w, zx, zy, rdz, rdzw
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: defor11, defor22, defor33, defor12, defor13, defor23, div 
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, ktes1, ktes2, i_start, i_end, j_start, j_end
+
+    REAL  &
+    :: tmp, tmpzx, tmpzy, tmpzeta_z, cft1, cft2
+
+    REAL, DIMENSION( its:ite, jts:jte )  &
+    :: mm, zzavg, zeta_zd12
+
+    REAL, DIMENSION( its-2:ite+2, kts:kte, jts-2:jte+2 )  &
+    :: tmp1, hat, hatavg
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+!=======================================================================
+! In the following section, calculate 3-d divergence and the first three
+! (defor11, defor22, defor33) of six deformation terms.
+
+    ktes1   = kte-1
+    ktes2   = kte-2
+
+    cft2    = - 0.5 * dnw(ktes1) / dn(ktes1)
+    cft1    = 1.0 - cft2
+
+    ktf     = MIN( kte, kde-1 )
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+! Square the map scale factor.
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      mm(i,j) = msft(i,j) * msft(i,j)
+    END DO
+    END DO
+
+!-----------------------------------------------------------------------
+! Calculate du/dx.
+
+! Apply a coordinate transformation to zonal velocity, u.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end+1
+      hat(i,k,j) = u(i,k,j) / msfu(i,j)
+    END DO
+    END DO
+    END DO
+
+! Average in x and z.
+
+    DO j=j_start,j_end
+    DO k=kts+1,ktf
+    DO i=i_start,i_end
+      hatavg(i,k,j) = 0.5 *  &
+                    ( fnm(k) * ( hat(i,k  ,j) + hat(i+1,  k,j) ) +  &
+                      fnp(k) * ( hat(i,k-1,j) + hat(i+1,k-1,j) ) )
+    END DO
+    END DO
+    END DO
+
+! Extrapolate to top and bottom of domain (to w levels).
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      hatavg(i,1,j)   =  0.5 * (  &
+                         cf1 * hat(i  ,1,j) +  &
+                         cf2 * hat(i  ,2,j) +  &
+                         cf3 * hat(i  ,3,j) +  &
+                         cf1 * hat(i+1,1,j) +  &
+                         cf2 * hat(i+1,2,j) +  &
+                         cf3 * hat(i+1,3,j) )
+      hatavg(i,kte,j) =  0.5 * (  &
+                        cft1 * ( hat(i,ktes1,j) + hat(i+1,ktes1,j) )  +  &
+                        cft2 * ( hat(i,ktes2,j) + hat(i+1,ktes2,j) ) )
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmpzx       = 0.25 * (  &
+                    zx(i,k  ,j) + zx(i+1,k  ,j) +  &
+                    zx(i,k+1,j) + zx(i+1,k+1,j) )
+      tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *tmpzx * rdzw(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = mm(i,j) * ( rdx * ( hat(i+1,k,j) - hat(i,k,j) ) -  &
+                    tmp1(i,k,j))
+    END DO
+    END DO
+    END DO
+
+! End calculation of du/dx.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate defor11 (2*du/dx).
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor11(i,k,j) = 2.0 * tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of defor11.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate zonal divergence (du/dx) and add it to the divergence array.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      div(i,k,j) = tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of zonal divergence.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dv/dy.
+
+! Apply a coordinate transformation to meridional velocity, v.
+
+    DO j = j_start, j_end+1
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      hat(i,k,j) = v(i,k,j) / msfv(i,j)
+    END DO
+    END DO
+    END DO
+
+! Account for the slope in y of eta surfaces.
+
+    DO j=j_start,j_end
+    DO k=kts+1,ktf
+    DO i=i_start,i_end
+      hatavg(i,k,j) = 0.5 * (  &
+                      fnm(k) * ( hat(i,k  ,j) + hat(i,k  ,j+1) ) +  &
+                      fnp(k) * ( hat(i,k-1,j) + hat(i,k-1,j+1) ) )
+    END DO
+    END DO
+    END DO
+
+! Extrapolate to top and bottom of domain (to w levels).
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      hatavg(i,1,j)   =  0.5 * (  &
+                         cf1 * hat(i,1,j  ) +  &
+                         cf2 * hat(i,2,j  ) +  &
+                         cf3 * hat(i,3,j  ) +  &
+                         cf1 * hat(i,1,j+1) +  &
+                         cf2 * hat(i,2,j+1) +  &
+                         cf3 * hat(i,3,j+1) )
+      hatavg(i,kte,j) =  0.5 * (  &
+                        cft1 * ( hat(i,ktes1,j) + hat(i,ktes1,j+1) ) +  &
+                        cft2 * ( hat(i,ktes2,j) + hat(i,ktes2,j+1) ) )
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmpzy       =  0.25 * (  &
+                     zy(i,k  ,j) + zy(i,k  ,j+1) +  &
+                     zy(i,k+1,j) + zy(i,k+1,j+1)  )
+      tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) * tmpzy * rdzw(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = mm(i,j) * (  &
+                    rdy * ( hat(i,k,j+1) - hat(i,k,j) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of dv/dy.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate defor22 (2*dv/dy).
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor22(i,k,j) = 2.0 * tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of defor22.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate meridional divergence (dv/dy) and add it to the divergence
+! array.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      div(i,k,j) = div(i,k,j) + tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of meridional divergence.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dw/dz.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = ( w(i,k+1,j) - w(i,k,j) ) * rdzw(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of dw/dz.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate defor33 (2*dw/dz).
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor33(i,k,j) = 2.0 * tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of defor33.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate vertical divergence (dw/dz) and add it to the divergence
+! array.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      div(i,k,j) = div(i,k,j) + tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of vertical divergence. 
+!-----------------------------------------------------------------------
+
+! Three-dimensional divergence is now finished and values are in array
+! "div."  Also, the first three (defor11, defor22, defor33) of six
+! deformation terms are now calculated at pressure points.
+!=======================================================================
+
+!=======================================================================
+! Calculate the final three deformations (defor12, defor13, defor23) at 
+! vorticity points.
+
+    i_start = its
+    i_end   = ite
+    j_start = jts
+    j_end   = jte
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. & 
+         config_flags%nested) i_end   = MIN( ide-1, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-1, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+
+!-----------------------------------------------------------------------
+! Calculate du/dy.
+
+! First, calculate an average mapscale factor.
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      mm(i,j) = 0.25 * ( msfu(i,j-1) + msfu(i,j) ) * ( msfv(i-1,j) + msfv(i,j) )
+    END DO
+    END DO
+
+! Apply a coordinate transformation to zonal velocity, u.
+
+    DO j =j_start-1, j_end
+    DO k =kts, ktf
+    DO i =i_start, i_end
+      hat(i,k,j) = u(i,k,j) / msfu(i,j)
+    END DO
+    END DO
+    END DO
+
+! Average in y and z.
+
+    DO j=j_start,j_end
+    DO k=kts+1,ktf
+    DO i=i_start,i_end
+      hatavg(i,k,j) = 0.5 * (  &
+                      fnm(k) * ( hat(i,k  ,j-1) + hat(i,k  ,j) ) +  &
+                      fnp(k) * ( hat(i,k-1,j-1) + hat(i,k-1,j) ) )
+    END DO
+    END DO
+    END DO
+
+! Extrapolate to top and bottom of domain (to w levels).
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      hatavg(i,1,j)   =  0.5 * (  &
+                         cf1 * hat(i,1,j-1) +  &
+                         cf2 * hat(i,2,j-1) +  &
+                         cf3 * hat(i,3,j-1) +  &
+                         cf1 * hat(i,1,j  ) +  &
+                         cf2 * hat(i,2,j  ) +  &
+                         cf3 * hat(i,3,j  ) )
+      hatavg(i,kte,j) =  0.5 * (  &
+                        cft1 * ( hat(i,ktes1,j-1) + hat(i,ktes1,j) ) +  &
+                        cft2 * ( hat(i,ktes2,j-1) + hat(i,ktes2,j) ) )
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmpzy       = 0.25 * (  &
+                    zy(i-1,k  ,j) + zy(i,k  ,j) +  &
+                    zy(i-1,k+1,j) + zy(i,k+1,j) )
+      tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *  &
+                    0.5 * tmpzy * ( rdzw(i,k,j) + rdzw(i-1,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of du/dy.
+!---------------------------------------------------------------------- 
+
+!-----------------------------------------------------------------------
+! Add the first term to defor12 (du/dy+dv/dx) at vorticity points.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor12(i,k,j) = mm(i,j) * (  &
+                       rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End addition of the first term to defor12.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dv/dx.
+
+! Apply a coordinate transformation to meridional velocity, v.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start-1, i_end
+       hat(i,k,j) = v(i,k,j) / msfv(i,j)
+    END DO
+    END DO
+    END DO
+
+! Account for the slope in x of eta surfaces.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      hatavg(i,k,j) = 0.5 * (  &
+                      fnm(k) * ( hat(i-1,k  ,j) + hat(i,k  ,j) ) +  &
+                      fnp(k) * ( hat(i-1,k-1,j) + hat(i,k-1,j) ) )
+    END DO
+    END DO
+    END DO
+
+! Extrapolate to top and bottom of domain (to w levels).
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+       hatavg(i,1,j)   =  0.5 * (  &
+                          cf1 * hat(i-1,1,j) +  &
+                          cf2 * hat(i-1,2,j) +  &
+                          cf3 * hat(i-1,3,j) +  &
+                          cf1 * hat(i  ,1,j) +  &
+                          cf2 * hat(i  ,2,j) +  &
+                          cf3 * hat(i  ,3,j) )
+       hatavg(i,kte,j) =  0.5 * (  &
+                         cft1 * ( hat(i,ktes1,j) + hat(i-1,ktes1,j) ) +  &
+                         cft2 * ( hat(i,ktes2,j) + hat(i-1,ktes2,j) ) )
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmpzx       = 0.25 * (  &
+                    zx(i,k  ,j-1) + zx(i,k  ,j) +  &
+                    zx(i,k+1,j-1) + zx(i,k+1,j) )
+      tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *  &
+                    0.5 * tmpzx * ( rdzw(i,k,j) + rdzw(i,k,j-1) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of dv/dx.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add the second term to defor12 (du/dy+dv/dx) at vorticity points.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor12(i,k,j) = defor12(i,k,j) +  &
+                       mm(i,j) * (  &
+                       rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End addition of the second term to defor12.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Update the boundary for defor12 (might need to change later).
+ 
+    IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN
+      DO j = jts, jte
+      DO k = kts, kte
+        defor12(ids,k,j) = defor12(ids+1,k,j)
+      END DO
+      END DO
+    END IF
+ 
+    IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
+      DO k = kts, kte
+      DO i = its, ite
+        defor12(i,k,jds) = defor12(i,k,jds+1)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
+      DO j = jts, jte
+      DO k = kts, kte
+        defor12(ide,k,j) = defor12(ide-1,k,j)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
+      DO k = kts, kte
+      DO i = its, ite
+        defor12(i,k,jde) = defor12(i,k,jde-1)
+      END DO
+      END DO
+    END IF
+
+! End update of boundary for defor12.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dw/dx.
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+
+    IF ( config_flags%periodic_x ) i_start = its
+    IF ( config_flags%periodic_x ) i_end = MIN( ite, ide )
+    IF ( config_flags%periodic_y ) j_end = MIN( jte, jde )
+
+! Square the mapscale factor.
+
+    DO j = jts, jte
+    DO i = its, ite
+      mm(i,j) = msfu(i,j) * msfu(i,j)
+    END DO
+    END DO
+
+! Apply a coordinate transformation to vertical velocity, w.  This is for both
+! defor13 and defor23.
+
+    DO j = j_start, j_end
+    DO k = kts, kte
+    DO i = i_start, i_end
+      hat(i,k,j) = w(i,k,j) / msft(i,j)
+    END DO
+    END DO
+    END DO
+
+    i = i_start-1
+    DO j = j_start, MIN( jte, jde-1 )
+    DO k = kts, kte
+      hat(i,k,j) = w(i,k,j) / msft(i,j)
+    END DO
+    END DO
+
+    j = j_start-1
+    DO k = kts, kte
+    DO i = i_start, MIN( ite, ide-1 )
+      hat(i,k,j) = w(i,k,j) / msft(i,j)
+    END DO
+    END DO
+
+! QUESTION: What is this for?
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      hatavg(i,k,j) = 0.25 * (  &
+                      hat(i  ,k  ,j) +  &
+                      hat(i  ,k+1,j) +  &
+                      hat(i-1,k  ,j) +  &
+                      hat(i-1,k+1,j) )
+    END DO
+    END DO
+    END DO
+
+! Calculate dw/dx.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zx(i,k,j) *  &
+                    0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of dw/dx.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add the first term (dw/dx) to defor13 (dw/dx+du/dz) at vorticity
+! points.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      defor13(i,k,j) = mm(i,j) * (  &
+                       rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      defor13(i,kts,j  ) = 0.0
+      defor13(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+! End addition of the first term to defor13.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate du/dz.
+
+    IF ( config_flags%mix_full_fields ) THEN
+
+      DO j = j_start, j_end
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+        tmp1(i,k,j) = ( u(i,k,j) - u(i,k-1,j) ) *  &
+                      0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) )
+      END DO
+      END DO
+      END DO
+
+    ELSE
+
+      DO j = j_start, j_end
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+        tmp1(i,k,j) = ( u(i,k,j) - u_base(k) - u(i,k-1,j) + u_base(k-1) ) *  &
+                      0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) )
+      END DO
+      END DO
+      END DO
+
+    END IF
+
+!-----------------------------------------------------------------------
+! Add the second term (du/dz) to defor13 (dw/dx+du/dz) at vorticity
+! points.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      defor13(i,k,j) = defor13(i,k,j) + tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End addition of the second term to defor13.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dw/dy.
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%periodic_y ) j_end = MIN( jte, jde )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+! Square mapscale factor.
+
+    DO j = jts, jte
+    DO i = its, ite
+      mm(i,j) = msfv(i,j) * msfv(i,j)
+    END DO
+    END DO
+
+! QUESTION: What is this for?
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      hatavg(i,k,j) = 0.25 * (  &
+                      hat(i,k  ,j  ) +  &
+                      hat(i,k+1,j  ) +  &
+                      hat(i,k  ,j-1) +  &
+                      hat(i,k+1,j-1) )
+    END DO
+    END DO
+    END DO
+
+! Calculate dw/dy and store in tmp1.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zy(i,k,j) *  &
+                    0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of dw/dy.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add the first term (dw/dy) to defor23 (dw/dy+dv/dz) at vorticity
+! points.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      defor23(i,k,j) = mm(i,j) * (  &
+                       rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      defor23(i,kts,j  ) = 0.0
+      defor23(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+! End addition of the first term to defor23.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dv/dz.
+
+    IF ( config_flags%mix_full_fields ) THEN
+
+      DO j = j_start, j_end
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+        tmp1(i,k,j) = ( v(i,k,j) - v(i,k-1,j) ) *  &
+                      0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) )
+      END DO
+      END DO
+      END DO
+
+    ELSE
+
+      DO j = j_start, j_end
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+        tmp1(i,k,j) = ( v(i,k,j) - v_base(k) - v(i,k-1,j) + v_base(k-1) ) *  &
+                      0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) )
+      END DO
+      END DO
+      END DO
+
+    END IF
+
+! End calculation of dv/dz.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add the second term (dv/dz) to defor23 (dw/dy+dv/dz) at vorticity
+! points.
+
+! Add tmp1 to defor23.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      defor23(i,k,j) = defor23(i,k,j) + tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End addition of the second term to defor23.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Update the boundary for defor13 and defor23 (might need to change
+! later).
+
+    IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN
+      DO j = jts, jte
+      DO k = kts, kte
+        defor13(ids,k,j) = defor13(ids+1,k,j)
+        defor23(ids,k,j) = defor23(ids+1,k,j)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
+      DO k = kts, kte
+      DO i = its, ite
+        defor13(i,k,jds) = defor13(i,k,jds+1)
+        defor23(i,k,jds) = defor23(i,k,jds+1)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
+      DO j = jts, jte
+      DO k = kts, kte
+        defor13(ide,k,j) = defor13(ide-1,k,j)
+        defor23(ide,k,j) = defor23(ide-1,k,j)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
+      DO k = kts, kte
+      DO i = its, ite
+        defor13(i,k,jde) = defor13(i,k,jde-1)
+        defor23(i,k,jde) = defor23(i,k,jde-1)
+      END DO
+      END DO
+    END IF
+
+! End update of boundary for defor13 and defor23.
+!-----------------------------------------------------------------------
+
+! The second three (defor12, defor13, defor23) of six deformation terms
+! are now calculated at vorticity points.
+!=======================================================================
+
+    END SUBROUTINE cal_deform_and_div
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE calculate_km_kh( config_flags, dt,                        &
+                                dampcoef, zdamp, damp_opt,               &
+                                xkmh, xkmhd, xkmv, xkhh, xkhv,           &
+                                BN2, khdif, kvdif, div,                  &
+                                defor11, defor22, defor33,               &
+                                defor12, defor13, defor23,               &
+                                tke, p8w, t8w, theta, t, p, moist,       &
+                                dn, dnw, dx, dy, rdz, rdzw, cr_len,      &
+                                n_moist, cf1, cf2, cf3, warm_rain,       &
+                                kh_tke_upper_bound, kv_tke_upper_bound,  &
+                                ids, ide, jds, jde, kds, kde,            &
+                                ims, ime, jms, jme, kms, kme,            &
+                                its, ite, jts, jte, kts, kte             )
+
+! History:     Sep 2003  Changes by George Bryan and Jason Knievel, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              ...       ...
+
+! Purpose:     This routine calculates exchange coefficients for the TKE
+!              scheme.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags   
+
+    INTEGER, INTENT( IN )  &
+    :: n_moist, damp_opt,             & 
+       ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte 
+
+    LOGICAL, INTENT( IN )  &
+    :: warm_rain
+
+    REAL, INTENT( IN )  &
+    :: cr_len, dx, dy, zdamp, dt, dampcoef, cf1, cf2, cf3, khdif, kvdif
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: dnw, dn
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), INTENT( INOUT )  &
+    :: moist
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: xkmv, xkmh, xkmhd, xkhv, xkhh, BN2  
+
+    REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),  INTENT( IN )  &
+    :: defor11, defor22, defor33, defor12, defor13, defor23,      &
+       div, rdz, rdzw, p8w, t8w, theta, t, p
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tke
+
+    REAL, INTENT( IN )  &
+    :: kh_tke_upper_bound, kv_tke_upper_bound
+
+! Local variables.
+
+    INTEGER  &
+    :: i_start, i_end, j_start, j_end, ktf, i, j, k
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    CALL calculate_N2( config_flags, BN2, moist,           &
+                       theta, t, p, p8w, t8w,              &
+                       dnw, dn, rdz, rdzw,                 &
+                       n_moist, cf1, cf2, cf3, warm_rain,  &
+                       ids, ide, jds, jde, kds, kde,       &
+                       ims, ime, jms, jme, kms, kme,       &
+                       its, ite, jts, jte, kts, kte        )
+
+! Select a scheme for calculating diffusion coefficients.
+
+    km_coef: SELECT CASE( config_flags%km_opt )
+
+      CASE (1)
+            CALL isotropic_km( config_flags, xkmh, xkmhd, xkmv,         &
+                               xkhh, xkhv, khdif, kvdif,                &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               its, ite, jts, jte, kts, kte             )
+      CASE (2)  
+            CALL tke_km(       config_flags, xkmh, xkmhd, xkmv,         &
+                               xkhh, xkhv, BN2, tke, p8w, t8w, theta,   &
+                               rdz, rdzw, dx, dy, cr_len,               &
+                               kh_tke_upper_bound, kv_tke_upper_bound,  &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               its, ite, jts, jte, kts, kte             )
+      CASE (3)  
+            CALL smag_km(      config_flags, xkmh, xkmhd, xkmv,         &
+                               xkhh, xkhv, BN2, div,                    &
+                               defor11, defor22, defor33,               &
+                               defor12, defor13, defor23,               &
+                               rdzw, dx, dy, cr_len,                    &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               its, ite, jts, jte, kts, kte             )
+      CASE (4)  
+            CALL smag2d_km(    config_flags, xkmh, xkmhd, xkmv,         &
+                               xkhh, xkhv, defor11, defor22, defor12,   &
+                               rdzw, dx, dy,                            &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               its, ite, jts, jte, kts, kte             )
+      CASE DEFAULT
+            CALL wrf_error_fatal( 'Please choose diffusion coefficient scheme' )
+
+    END SELECT km_coef
+
+    IF ( damp_opt .eq. 1 ) THEN
+      CALL cal_dampkm( config_flags, xkmhd, xkmh, xkhh, xkmv, xkhv,   &
+                       dx, dy, dt, dampcoef, rdz, rdzw, zdamp,  &
+                       ids, ide, jds, jde, kds, kde,            &
+                       ims, ime, jms, jme, kms, kme,            &
+                       its, ite, jts, jte, kts, kte             )
+    END IF
+
+    END SUBROUTINE calculate_km_kh
+
+!=======================================================================
+
+SUBROUTINE cal_dampkm( config_flags,xkmhd,xkmh,xkhh,xkmv,xkhv,                 &
+                       dx,dy,dt,dampcoef,                                      &
+                       rdz, rdzw ,zdamp,                                       &
+                       ids,ide, jds,jde, kds,kde,                              &
+                       ims,ime, jms,jme, kms,kme,                              &
+                       its,ite, jts,jte, kts,kte                              )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type) , INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   )           :: ids, ide, jds, jde, kds, kde, &
+                                                 ims, ime, jms, jme, kms, kme, &
+                                                 its, ite, jts, jte, kts, kte
+
+   REAL    ,          INTENT(IN   )           :: zdamp,dx,dy,dt,dampcoef
+
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT)    ::    xkmhd, &
+                                                                         xkmh , &
+                                                                         xkhh , &
+                                                                         xkmv , &
+                                                                         xkhv 
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   )    ::     rdz,   &
+                                                                         rdzw
+! LOCAL VARS
+
+   INTEGER :: i_start, i_end, j_start, j_end, ktf, ktfm1, i, j, k
+   REAL    :: kmmax,kmmvmax,degrad90,dz,tmp
+   REAL ,     DIMENSION( its:ite )                                ::   deltaz
+   REAL , DIMENSION( its:ite, kts:kte, jts:jte)                   ::   dampk,dampkv
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf = min(kte,kde-1)
+   ktfm1 = ktf-1
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+! keep upper damping diffusion away from relaxation zones at boundaries if used
+   IF(config_flags%specified .OR. config_flags%nested)THEN
+     i_start = MAX(i_start,ids+config_flags%spec_bdy_width-1)
+     i_end   = MIN(i_end,ide-config_flags%spec_bdy_width)
+     j_start = MAX(j_start,jds+config_flags%spec_bdy_width-1)
+     j_end   = MIN(j_end,jde-config_flags%spec_bdy_width)
+   ENDIF
+
+   kmmax=dx*dx/dt
+   degrad90=DEGRAD*90.
+   DO j = j_start, j_end
+
+      k=ktf
+      DO i = i_start, i_end
+
+!         deltaz(i)=0.5*dnw(k)/zeta_z(i,j)
+!         dz=dnw(k)/zeta_z(i,j)
+         dz = 1./rdzw(i,k,j)
+         deltaz(i) = 0.5*dz
+
+         kmmvmax=dz*dz/dt
+         tmp=min(deltaz(i)/zdamp,1.)
+         dampk(i,k,j)=cos(degrad90*tmp)*kmmax*dampcoef
+         dampkv(i,k,j)=cos(degrad90*tmp)*kmmvmax*dampcoef
+! set upper limit on vertical K (based on horizontal K)
+         dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j))
+
+      ENDDO
+
+      DO k = ktfm1,kts,-1
+      DO i = i_start, i_end
+
+!         deltaz(i)=deltaz(i)+dn(k)/zeta_z(i,j)
+!         dz=dnw(k)/zeta_z(i,j)
+         dz = 1./rdz(i,k,j)
+         deltaz(i) = deltaz(i) + dz
+         dz = 1./rdzw(i,k,j)
+
+         kmmvmax=dz*dz/dt
+         tmp=min(deltaz(i)/zdamp,1.)
+         dampk(i,k,j)=cos(degrad90*tmp)*kmmax*dampcoef
+         dampkv(i,k,j)=cos(degrad90*tmp)*kmmvmax*dampcoef
+! set upper limit on vertical K (based on horizontal K)
+         dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j))
+      ENDDO
+      ENDDO
+
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+      xkmhd(i,k,j)=max(xkmhd(i,k,j),dampk(i,k,j))
+      xkmh(i,k,j)=max(xkmh(i,k,j),dampk(i,k,j))
+      xkhh(i,k,j)=max(xkhh(i,k,j),dampk(i,k,j))
+      xkmv(i,k,j)=max(xkmv(i,k,j),dampkv(i,k,j))
+      xkhv(i,k,j)=max(xkhv(i,k,j),dampkv(i,k,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE cal_dampkm
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE calculate_N2( config_flags, BN2, moist,           &
+                             theta, t, p, p8w, t8w,              &
+                             dnw, dn, rdz, rdzw,                 &
+                             n_moist, cf1, cf2, cf3, warm_rain,  &
+                             ids, ide, jds, jde, kds, kde,       &
+                             ims, ime, jms, jme, kms, kme,       &
+                             its, ite, jts, jte, kts, kte        )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: n_moist,  &
+       ids, ide, jds, jde, kds, kde, &
+       ims, ime, jms, jme, kms, kme, &
+       its, ite, jts, jte, kts, kte
+
+    LOGICAL, INTENT( IN )  &
+    :: warm_rain
+
+    REAL, INTENT( IN )  &
+    :: cf1, cf2, cf3
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: BN2
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: rdz, rdzw, theta, t, p, p8w, t8w 
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: dnw, dn
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), INTENT( INOUT )  &
+    :: moist
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, ispe, ktes1, ktes2,  &
+       i_start, i_end, j_start, j_end
+
+    REAL  &
+    :: coefa, thetaep1, thetaem1, qc_cr, es, tc, qlpqi, qsw, qsi,  &
+       tmpdz, xlvqv, thetaesfc, thetasfc, qvtop, qvsfc, thetatop, thetaetop
+
+    REAL, DIMENSION( its:ite, jts:jte )  &
+    :: tmp1sfc, tmp1top
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: tmp1, qvs, qctmp
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    qc_cr   = 0.00001  ! in Kg/Kg
+
+    ktf     = MIN( kte, kde-1 )
+    ktes1   = kte-1
+    ktes2   = kte-2
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-2 ,jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+ 
+    IF ( P_QC .GT. PARAM_FIRST_SCALAR) THEN
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        qctmp(i,k,j) = moist(i,k,j,P_QC)
+      END DO
+      END DO
+      END DO
+    ELSE
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         qctmp(i,k,j) = 0.0
+      END DO
+      END DO
+      END DO
+    END IF
+ 
+    DO j = jts, jte
+    DO k = kts, kte
+    DO i = its, ite
+      tmp1(i,k,j) = 0.0
+    END DO
+    END DO
+    END DO
+ 
+    DO j = jts,jte
+    DO i = its,ite
+      tmp1sfc(i,j) = 0.0
+      tmp1top(i,j) = 0.0
+    END DO
+    END DO
+ 
+    DO ispe = PARAM_FIRST_SCALAR, n_moist
+      IF ( ispe .EQ. P_QV .OR. ispe .EQ. P_QC .OR. ispe .EQ. P_QI) THEN
+        DO j = j_start, j_end
+        DO k = kts, ktf
+        DO i = i_start, i_end
+          tmp1(i,k,j) = tmp1(i,k,j) + moist(i,k,j,ispe)
+        END DO
+        END DO
+        END DO
+ 
+        DO j = j_start, j_end
+        DO i = i_start, i_end
+          tmp1sfc(i,j) = tmp1sfc(i,j) +  &
+                         cf1 * moist(i,1,j,ispe) +  &
+                         cf2 * moist(i,2,j,ispe) +  &
+                         cf3 * moist(i,3,j,ispe)
+          tmp1top(i,j) = tmp1top(i,j) +  &
+                         moist(i,ktes1,j,ispe) + &
+                         ( moist(i,ktes1,j,ispe) - moist(i,ktes2,j,ispe) ) *  &
+                         0.5 * dnw(ktes1) / dn(ktes1)
+        END DO
+        END DO
+      END IF
+    END DO
+
+! Calculate saturation mixing ratio.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tc         = t(i,k,j) - SVPT0
+      es         = 1000.0 * SVP1 * EXP( SVP2 * tc / ( t(i,k,j) - SVP3 ) )
+      qvs(i,k,j) = EP_2 * es / ( p(i,k,j) - es )
+    END DO
+    END DO
+    END DO
+ 
+    DO j = j_start, j_end
+    DO k = kts+1, ktf-1
+    DO i = i_start, i_end
+      tmpdz = 1.0 / rdz(i,k,j) + 1.0 / rdz(i,k+1,j)
+      IF ( moist(i,k,j,P_QV) .GE. qvs(i,k,j) .OR. qctmp(i,k,j) .GE. qc_cr) THEN
+        xlvqv      = XLV * moist(i,k,j,P_QV)
+        coefa      = ( 1.0 + xlvqv / R_d / t(i,k,j) ) / &
+                     ( 1.0 + XLV * xlvqv / Cp / R_v / t(i,k,j) / t(i,k,j) ) /  &
+                     theta(i,k,j)
+        thetaep1   = theta(i,k+1,j) *  &
+                     ( 1.0 + XLV * qvs(i,k+1,j) / Cp / t(i,k+1,j) )
+        thetaem1   = theta(i,k-1,j) *  &
+                     ( 1.0 + XLV * qvs(i,k-1,j) / Cp / t(i,k-1,j) )
+        BN2(i,k,j) = g * ( coefa * ( thetaep1 - thetaem1 ) / tmpdz -  &
+                     ( tmp1(i,k+1,j) - tmp1(i,k-1,j) ) / tmpdz )
+      ELSE
+        BN2(i,k,j) = g * ( (theta(i,k+1,j) - theta(i,k-1,j) ) /  &
+                     theta(i,k,j) / tmpdz +  &
+                     1.61 * ( moist(i,k+1,j,P_QV) - moist(i,k-1,j,P_QV) ) / &
+                     tmpdz -   &
+                     ( tmp1(i,k+1,j) - tmp1(i,k-1,j) ) / tmpdz )
+      ENDIF
+    END DO
+    END DO
+    END DO
+
+    k = kts
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      tmpdz     = 1.0 / rdz(i,k+1,j) + 0.5 / rdzw(i,k,j)
+      thetasfc  = T8w(i,kts,j) / ( p8w(i,k,j) / p1000mb )**( R_d / Cp )
+      IF ( moist(i,k,j,P_QV) .GE. qvs(i,k,j) .OR. qctmp(i,k,j) .GE. qc_cr) THEN
+        qvsfc     = cf1 * qvs(i,1,j) +  &
+                    cf2 * qvs(i,2,j) +  &
+                    cf3 * qvs(i,3,j)
+        xlvqv      = XLV * moist(i,k,j,P_QV)
+        coefa      = ( 1.0 + xlvqv / R_d / t(i,k,j) ) /  &
+                     ( 1.0 + XLV * xlvqv / Cp / R_v / t(i,k,j) / t(i,k,j) ) /  &
+                     theta(i,k,j)
+        thetaep1   = theta(i,k+1,j) *  &
+                     ( 1.0 + XLV * qvs(i,k+1,j) / Cp / t(i,k+1,j) )
+        thetaesfc  = thetasfc *  &
+                     ( 1.0 + XLV * qvsfc / Cp / t8w(i,kts,j) )
+        BN2(i,k,j) = g * ( coefa * ( thetaep1 - thetaesfc ) / tmpdz -  &
+                     ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz )
+      ELSE
+        qvsfc     = cf1 * moist(i,1,j,P_QV) +  &
+                    cf2 * moist(i,2,j,P_QV) +  &
+                    cf3 * moist(i,3,j,P_QV)
+!        BN2(i,k,j) = g * ( ( theta(i,k+1,j) - thetasfc ) /  &
+!                     theta(i,k,j) / tmpdz +  &
+!                     1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) /  &
+!                     tmpdz -  &
+!                     ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz  )
+!...... MARTA: change in computation of BN2 at the surface, WCS 040331
+
+        tmpdz= 1./rdzw(i,k,j) ! controlare come calcola rdzw
+        BN2(i,k,j) = g * ( ( theta(i,k+1,j) - theta(i,k,j)) /  &
+                     theta(i,k,j) / tmpdz +  &
+                     1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) /  &
+                     tmpdz -  &
+                     ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz  )
+! end of MARTA/WCS change
+
+      ENDIF
+    END DO
+    END DO
+ 
+
+!...... MARTA: change in computation of BN2 at the top, WCS 040331
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+       BN2(i,ktf,j)=BN2(i,ktf-1,j)
+    END DO
+    END DO   
+! end of MARTA/WCS change
+
+    END SUBROUTINE calculate_N2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE isotropic_km( config_flags,                                         &
+                         xkmh,xkmhd,xkmv,xkhh,xkhv,khdif,kvdif,                &
+                         ids,ide, jds,jde, kds,kde,                            &
+                         ims,ime, jms,jme, kms,kme,                            &
+                         its,ite, jts,jte, kts,kte                            )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type) , INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   )           :: ids, ide, jds, jde, kds, kde, &
+                                                 ims, ime, jms, jme, kms, kme, &
+                                                 its, ite, jts, jte, kts, kte
+
+   REAL    ,          INTENT(IN   )           :: khdif,kvdif               
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::     xkmh, &
+                                                                        xkmhd, &
+                                                                         xkmv, &
+                                                                         xkhh, &
+                                                                         xkhv
+! LOCAL VARS
+
+   INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k
+   REAL    :: khdif3,kvdif3
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf = kte
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+!   khdif3=khdif*3.
+!   kvdif3=kvdif*3.
+   khdif3=khdif/prandtl
+   kvdif3=kvdif/prandtl
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end
+      xkmh(i,k,j)=khdif
+      xkmhd(i,k,j)=khdif
+      xkmv(i,k,j)=kvdif
+      xkhh(i,k,j)=khdif3
+      xkhv(i,k,j)=kvdif3
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE isotropic_km
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE smag_km( config_flags,xkmh,xkmhd,xkmv,xkhh,xkhv,BN2,                &
+                    div,defor11,defor22,defor33,defor12,                       &
+                    defor13,defor23,                                           &
+                    rdzw,dx,dy,cr_len_in,                                      &
+                    ids,ide, jds,jde, kds,kde,                                 &
+                    ims,ime, jms,jme, kms,kme,                                 &
+                    its,ite, jts,jte, kts,kte                                  )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type) , INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   )           :: ids, ide, jds, jde, kds, kde, &
+                                                 ims, ime, jms, jme, kms, kme, &
+                                                 its, ite, jts, jte, kts, kte
+
+   REAL    ,          INTENT(IN   )           :: cr_len_in, dx, dy
+
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) ::      BN2, &
+                                                                         rdzw
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::     xkmh, &
+                                                                        xkmhd, &
+                                                                         xkmv, &
+                                                                         xkhh, &
+                                                                         xkhv
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ),  INTENT(IN   )      ::      &    
+                                                                      defor11, &
+                                                                      defor22, &
+                                                                      defor33, &
+                                                                      defor12, &
+                                                                      defor13, &
+                                                                      defor23, &
+                                                                          div
+
+! LOCAL VARS
+
+   INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k
+   REAL    :: deltas, tmp, pr, mlen_h, mlen_v, cr_len
+
+   REAL, DIMENSION( its:ite , kts:kte , jts:jte )                 ::     def2
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf = min(kte,kde-1)
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+   pr = prandtl
+   cr_len = cr_len_in
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      def2(i,k,j)=0.5*(defor11(i,k,j)*defor11(i,k,j) + &
+                       defor22(i,k,j)*defor22(i,k,j) + &
+                       defor33(i,k,j)*defor33(i,k,j))
+   enddo
+   enddo
+   enddo
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      tmp=0.25*(defor12(i  ,k,j)+defor12(i  ,k,j+1)+ &
+                defor12(i+1,k,j)+defor12(i+1,k,j+1))
+      def2(i,k,j)=def2(i,k,j)+tmp*tmp
+   enddo
+   enddo
+   enddo
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      tmp=0.25*(defor13(i  ,k+1,j)+defor13(i  ,k,j)+ &
+                defor13(i+1,k+1,j)+defor13(i+1,k,j))
+      def2(i,k,j)=def2(i,k,j)+tmp*tmp
+   enddo
+   enddo
+   enddo
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      tmp=0.25*(defor23(i,k+1,j  )+defor23(i,k,j  )+ &
+                defor23(i,k+1,j+1)+defor23(i,k,j+1))
+      def2(i,k,j)=def2(i,k,j)+tmp*tmp
+   enddo
+   enddo
+   enddo
+!
+   cr_len = dx + 1.  !  hardwire for mixing length = (dx*dy*dz)**(1/3).
+                     !  remove this for the alternate formulation
+
+   IF (dx .gt. cr_len) THEN
+      mlen_h=sqrt(dx*dy)
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         mlen_v= 1./rdzw(i,k,j)
+         tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr)
+         tmp=tmp**0.5
+         xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h )
+         xkmh(i,k,j)=min(xkmh(i,k,j), 10.*mlen_h )
+         xkmhd(i,k,j)=xkmh(i,k,j)
+         xkmv(i,k,j)=max(c_s*c_s*mlen_v*mlen_v*tmp, 1.0E-6*mlen_v*mlen_v )
+         xkmv(i,k,j)=min(xkmv(i,k,j), 10.*mlen_v )
+         xkhh(i,k,j)=xkmh(i,k,j)/pr
+         xkhv(i,k,j)=xkmv(i,k,j)/pr
+      ENDDO
+      ENDDO
+      ENDDO
+   ELSE
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         deltas=(dx*dy/rdzw(i,k,j))**0.33333333
+         tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr)
+         tmp=tmp**0.5
+         xkmh(i,k,j)=max(c_s*c_s*deltas*deltas*tmp, 1.0E-6*deltas*deltas )
+         xkmh(i,k,j)=min(xkmh(i,k,j), 10.*deltas )
+         xkmhd(i,k,j)=xkmh(i,k,j)
+         xkmv(i,k,j)=xkmh(i,k,j)
+         xkhh(i,k,j)=xkmh(i,k,j)/pr
+         xkhv(i,k,j)=xkmv(i,k,j)/pr
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+END SUBROUTINE smag_km
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE smag2d_km( config_flags,xkmh,xkmhd,xkmv,xkhh,xkhv,                  &
+                    defor11,defor22,defor12,                                   &
+                    rdzw,dx,dy,                                                &
+                    ids,ide, jds,jde, kds,kde,                                 &
+                    ims,ime, jms,jme, kms,kme,                                 &
+                    its,ite, jts,jte, kts,kte                                  )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type) , INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   )           :: ids, ide, jds, jde, kds, kde, &
+                                                 ims, ime, jms, jme, kms, kme, &
+                                                 its, ite, jts, jte, kts, kte
+
+   REAL    ,          INTENT(IN   )           :: dx, dy
+
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) ::     rdzw
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::     xkmh, &
+                                                                        xkmhd, &
+                                                                         xkmv, &
+                                                                         xkhh, &
+                                                                         xkhv
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ),  INTENT(IN   )      ::      &    
+                                                                      defor11, &
+                                                                      defor22, &
+                                                                      defor12
+
+! LOCAL VARS
+
+   INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k
+   REAL    :: deltas, tmp, pr, mlen_h
+
+   REAL, DIMENSION( its:ite , kts:kte , jts:jte )                 ::     def2
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf = min(kte,kde-1)
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+   pr=prandtl
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      def2(i,k,j)=0.25*((defor11(i,k,j)-defor22(i,k,j))*(defor11(i,k,j)-defor22(i,k,j)))
+      tmp=0.25*(defor12(i  ,k,j)+defor12(i  ,k,j+1)+ &
+                defor12(i+1,k,j)+defor12(i+1,k,j+1))
+      def2(i,k,j)=def2(i,k,j)+tmp*tmp
+   enddo
+   enddo
+   enddo
+!
+      mlen_h=sqrt(dx*dy)
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         tmp=sqrt(def2(i,k,j))
+!        xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h )
+         xkmh(i,k,j)=c_s*c_s*mlen_h*mlen_h*tmp
+         xkmh(i,k,j)=min(xkmh(i,k,j), 10.*mlen_h )
+         xkmhd(i,k,j)=xkmh(i,k,j)
+         xkmv(i,k,j)=0.
+         xkhh(i,k,j)=xkmh(i,k,j)/pr
+         xkhv(i,k,j)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE smag2d_km
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_km( config_flags, xkmh, xkmhd, xkmv, xkhh, xkhv,  &
+                       bn2, tke, p8w, t8w, theta,                    &
+                       rdz, rdzw, dx,dy, cr_len_in,                  &
+                       kh_tke_upper_bound, kv_tke_upper_bound,       &
+                       ids, ide, jds, jde, kds, kde,                 &
+                       ims, ime, jms, jme, kms, kme,                 &
+                       its, ite, jts, jte, kts, kte                  )
+
+! History:     Sep 2003   Changes by Jason Knievel and George Bryan, NCAR
+!              Oct 2001   Converted to mass core by Bill Skamarock, NCAR
+!              ...        ...
+
+! Purpose:     This routine calculates the exchange coefficients for the
+!              TKE turbulence parameterization.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, INTENT( IN )  &
+    :: cr_len_in, dx, dy
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: tke, p8w, t8w, theta, rdz, rdzw, bn2
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: xkmh, xkmhd, xkmv, xkhh, xkhv
+
+    REAL, INTENT( IN )  &
+    :: kh_tke_upper_bound, kv_tke_upper_bound
+
+! Local variables.
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: l_scale
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: dthrdn
+
+    REAL  &
+    :: deltas, tmp, mlen_s, mlen_h, mlen_v, tmpdz,  &
+       thetasfc, thetatop, minkx, pr_inv, pr_inv_h, pr_inv_v, cr_len
+
+    INTEGER  &
+    :: i_start, i_end, j_start, j_end, ktf, i, j, k
+
+    REAL, PARAMETER :: tke_seed_value = 1.e-06
+    REAL            :: tke_seed
+    REAL, PARAMETER :: epsilon = 1.e-10
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-2, jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+! in the absence of surface drag or a surface heat flux, there
+! is no way to generate tke without pre-existing tke.  Use
+! tke_seed if the drag and flux are off.
+
+    cr_len = cr_len_in
+    tke_seed = tke_seed_value
+    if( (config_flags%tke_drag_coefficient .gt. epsilon) .or.  &
+        (config_flags%tke_heat_flux .gt. epsilon)  ) tke_seed = 0.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf-1
+    DO i = i_start, i_end
+      tmpdz         = 1.0 / ( rdz(i,k+1,j) + rdz(i,k,j) )
+      dthrdn(i,k,j) = ( theta(i,k+1,j) - theta(i,k-1,j) ) / tmpdz
+    END DO
+    END DO
+    END DO
+
+    k = kts
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      tmpdz         = 1.0 / ( rdzw(i,k+1,j) + rdzw(i,k,j) )
+      thetasfc      = T8w(i,kts,j) / ( p8w(i,k,j) / p1000mb )**( R_d / Cp )
+      dthrdn(i,k,j) = ( theta(i,k+1,j) - thetasfc ) / tmpdz
+    END DO
+    END DO
+
+    k = ktf
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      tmpdz         = 1.0 / rdz(i,k,j) + 0.5 / rdzw(i,k,j)
+      thetatop      = T8w(i,kde,j) / ( p8w(i,kde,j) / p1000mb )**( R_d / Cp )
+      dthrdn(i,k,j) = ( thetatop - theta(i,k-1,j) ) / tmpdz
+    END DO
+    END DO
+
+    cr_len = dx + 1.0 !  hardwire for mixing length = (dx*dy*dz)**(1/3).
+                      !  remove this for the alternate formulation
+
+    IF ( dx .gt. cr_len ) THEN
+      mlen_h = SQRT( dx * dy )
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        tmp    = SQRT( MAX( tke(i,k,j), tke_seed ) )
+        deltas = 1.0 / rdzw(i,k,j)
+        mlen_v = deltas
+        IF ( dthrdn(i,k,j) .GT. 0.) THEN
+          mlen_s = 0.76 * tmp / ( ABS( g / theta(i,k,j) * dthrdn(i,k,j) ) )**0.5
+          mlen_v = MIN( mlen_v, mlen_s )
+        END IF
+        xkmh(i,k,j)  = MAX( c_k * tmp * mlen_h, 1.0E-6 * mlen_h * mlen_h )
+        xkmh(i,k,j)  = MIN( xkmh(i,k,j), 10.0 * mlen_h )
+        xkmhd(i,k,j) = xkmh(i,k,j)
+        xkmv(i,k,j)  = MAX( c_k * tmp * mlen_v, 1.0E-6 * deltas * deltas )
+        xkmv(i,k,j)  = MIN( xkmv(i,k,j), 10.0 * deltas )
+        pr_inv_h     = 1./prandtl
+        pr_inv_v     = 1.0 + 2.0 * mlen_v / deltas
+        xkhh(i,k,j)  = xkmh(i,k,j) * pr_inv_h
+        xkhv(i,k,j)  = xkmv(i,k,j) * pr_inv_v
+      END DO
+      END DO
+      END DO
+    ELSE
+      CALL calc_l_scale( config_flags, tke, BN2, l_scale,      &
+                         i_start, i_end, ktf, j_start, j_end,  &
+                         dx, dy, rdzw,                         &
+                         ids, ide, jds, jde, kds, kde,         &
+                         ims, ime, jms, jme, kms, kme,         &
+                         its, ite, jts, jte, kts, kte          )
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        tmp          = SQRT( MAX( tke(i,k,j), tke_seed ) )
+        deltas       = ( dx * dy / rdzw(i,k,j) )**0.33333333
+        xkmh(i,k,j)  = c_k * tmp * l_scale(i,k,j)
+        xkmh(i,k,j)  = MIN( kh_tke_upper_bound,  xkmh(i,k,j) )
+        xkmhd(i,k,j) = xkmh(i,k,j)
+        xkmv(i,k,j)  = c_k * tmp * l_scale(i,k,j)
+        xkmv(i,k,j)  = MIN( kv_tke_upper_bound,  xkmv(i,k,j) )
+        pr_inv       = 1.0 + 2.0 * l_scale(i,k,j) / deltas
+        xkhh(i,k,j)  = MIN( kh_tke_upper_bound*pr_inv, xkmh(i,k,j) * pr_inv )
+        xkhv(i,k,j)  = MIN( kv_tke_upper_bound*pr_inv, xkmv(i,k,j) * pr_inv )
+      END DO
+      END DO
+      END DO
+    END IF
+
+    END SUBROUTINE tke_km
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE calc_l_scale( config_flags, tke, BN2, l_scale,      &
+                             i_start, i_end, ktf, j_start, j_end,  &
+                             dx, dy, rdzw,                         &
+                             ids, ide, jds, jde, kds, kde,         &
+                             ims, ime, jms, jme, kms, kme,         &
+                             its, ite, jts, jte, kts, kte          )
+
+! History:     Sep 2003   Written by Bryan and Knievel, NCAR
+
+! Purpose:     This routine calculates the length scale, based on stability,
+!              for TKE parameterization of subgrid-scale turbulence.
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: i_start, i_end, ktf, j_start, j_end,  &
+       ids, ide, jds, jde, kds, kde,         &
+       ims, ime, jms, jme, kms, kme,         &
+       its, ite, jts, jte, kts, kte
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: BN2, tke, rdzw
+
+    REAL, INTENT( IN )  &
+    :: dx, dy
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte ), INTENT( OUT )  &
+    :: l_scale
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k
+
+    REAL  &
+    :: deltas, tmp
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      deltas         = ( dx * dy / rdzw(i,k,j) )**0.33333333
+      l_scale(i,k,j) = deltas
+
+      IF ( BN2(i,k,j) .gt. 1.0e-6 ) THEN
+        tmp            = SQRT( MAX( tke(i,k,j), 1.0e-6 ) )
+        l_scale(i,k,j) = 0.76 * tmp / SQRT( BN2(i,k,j) )
+        l_scale(i,k,j) = MIN( l_scale(i,k,j), deltas)
+        l_scale(i,k,j) = MAX( l_scale(i,k,j), 0.001 * deltas )
+      END IF
+
+    END DO
+    END DO
+    END DO
+
+    END SUBROUTINE calc_l_scale
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf,    &
+                                    tke_tendf,                                 &
+                                    moist_tendf, n_moist,                      &
+                                    chem_tendf, n_chem,                        &
+                                    scalar_tendf, n_scalar,                    &
+                                    thp, theta, mu, tke, config_flags,         &
+                                    defor11, defor22, defor12,                 &
+                                    defor13, defor23, div,                     &
+                                    moist, chem, scalar,                       &
+                                    msfu, msfv, msft, xkmh, xkhh,km_opt,       &
+                                    rdx, rdy, rdz, rdzw, fnm, fnp,             &
+                                    cf1, cf2, cf3, zx, zy, dn, dnw,            &
+                                    ids, ide, jds, jde, kds, kde,              &
+                                    ims, ime, jms, jme, kms, kme,              &
+                                    its, ite, jts, jte, kts, kte               )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   INTEGER ,        INTENT(IN   ) ::        n_moist, n_chem, n_scalar, km_opt
+
+   REAL ,           INTENT(IN   ) ::        cf1, cf2, cf3
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: dnw
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  dn
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfu, &
+                                                                    msfv, &
+                                                                    msft, &
+                                                                      mu
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::rt_tendf,&
+                                                                 ru_tendf,&
+                                                                 rv_tendf,&
+                                                                 rw_tendf,&
+                                                                tke_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist),                 &
+          INTENT(INOUT) ::                                    moist_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem),                  &
+          INTENT(INOUT) ::                                     chem_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar),                &
+          INTENT(INOUT) ::                                   scalar_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist),                 &
+          INTENT(IN   ) ::                                          moist
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem),                  &
+          INTENT(IN   ) ::                                          chem 
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) ,               &
+          INTENT(IN   ) ::                                         scalar 
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor11, &
+                                                                 defor22, &
+                                                                 defor12, &
+                                                                 defor13, &
+                                                                 defor23, &
+                                                                     div, &
+                                                                    xkmh, &
+                                                                    xkhh, &
+                                                                      zx, &
+                                                                      zy, &
+                                                                   theta, &
+                                                                     thp, &
+                                                                     tke, &
+                                                                     rdz, &
+                                                                    rdzw
+
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+
+! LOCAL VARS
+   
+   INTEGER :: im, ic, is
+
+!  REAL , DIMENSION(its-1:ite+1, kts:kte, jts-1:jte+1)       ::     xkhh
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Call diffusion subroutines.
+
+    CALL horizontal_diffusion_u_2( ru_tendf, mu, config_flags,             &
+                                   defor11, defor12, div,                  &
+                                   tke(ims,kms,jms),                       &
+                                   msfu, xkmh, rdx, rdy, fnm, fnp,         &
+                                   zx, zy, rdzw,                           &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    CALL horizontal_diffusion_v_2( rv_tendf, mu, config_flags,             &
+                                   defor12, defor22, div,                  &
+                                   tke(ims,kms,jms),                       &
+                                   msfv, xkmh, rdx, rdy, fnm, fnp,         &
+                                   zx, zy, rdzw,                           &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    CALL horizontal_diffusion_w_2( rw_tendf, mu, config_flags,             &
+                                   defor13, defor23, div,                  &
+                                   tke(ims,kms,jms),                       &
+                                   msft, xkmh, rdx, rdy, fnm, fnp,         &
+                                   zx, zy, rdz,                            &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    CALL horizontal_diffusion_s  ( rt_tendf, mu, config_flags, thp,        &
+                                   msft, msfu, msfv, xkhh, rdx, rdy,       &
+                                   fnm, fnp, cf1, cf2, cf3,                &
+                                   zx, zy, rdz, rdzw, dnw, dn,             &
+                                   .false.,                                &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    IF (km_opt .eq. 2)                                                     &
+    CALL horizontal_diffusion_s  ( tke_tendf(ims,kms,jms),                 &
+                                   mu, config_flags,                       &
+                                   tke(ims,kms,jms),                       &
+                                   msft, msfu, msfv, xkhh, rdx, rdy,       &
+                                   fnm, fnp, cf1, cf2, cf3,                &
+                                   zx, zy, rdz, rdzw, dnw, dn,             &
+                                   .true.,                                 &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN 
+
+      moist_loop: do im = PARAM_FIRST_SCALAR, n_moist
+
+          CALL horizontal_diffusion_s( moist_tendf(ims,kms,jms,im),       &
+                                       mu, config_flags,                  &
+                                       moist(ims,kms,jms,im),             &
+                                       msft, msfu, msfv, xkhh, rdx, rdy,  &
+                                       fnm, fnp, cf1, cf2, cf3,           &
+                                       zx, zy, rdz, rdzw, dnw, dn,        &
+                                       .false.,                           &
+                                       ids, ide, jds, jde, kds, kde,      &
+                                       ims, ime, jms, jme, kms, kme,      &
+                                       its, ite, jts, jte, kts, kte      )
+
+      ENDDO moist_loop
+
+    ENDIF
+
+    IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN 
+
+      chem_loop: do ic = PARAM_FIRST_SCALAR, n_chem
+
+        CALL horizontal_diffusion_s( chem_tendf(ims,kms,jms,ic),     &
+                                     mu, config_flags,                 &
+                                     chem(ims,kms,jms,ic),           &
+                                     msft, msfu, msfv, xkhh, rdx, rdy, &
+                                     fnm, fnp, cf1, cf2, cf3,          &
+                                     zx, zy, rdz, rdzw, dnw, dn,       &
+                                     .false.,                          &
+                                     ids, ide, jds, jde, kds, kde,     &
+                                     ims, ime, jms, jme, kms, kme,     &
+                                     its, ite, jts, jte, kts, kte     )
+
+      ENDDO chem_loop
+
+    ENDIF
+    IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN 
+
+      scalar_loop: do is = PARAM_FIRST_SCALAR, n_scalar
+
+        CALL horizontal_diffusion_s( scalar_tendf(ims,kms,jms,is),     &
+                                     mu, config_flags,                 &
+                                     scalar(ims,kms,jms,is),           &
+                                     msft, msfu, msfv, xkhh, rdx, rdy, &
+                                     fnm, fnp, cf1, cf2, cf3,          &
+                                     zx, zy, rdz, rdzw, dnw, dn,       &
+                                     .false.,                          &
+                                     ids, ide, jds, jde, kds, kde,     &
+                                     ims, ime, jms, jme, kms, kme,     &
+                                     its, ite, jts, jte, kts, kte     )
+
+      ENDDO scalar_loop
+
+    ENDIF
+
+    END SUBROUTINE horizontal_diffusion_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_u_2( tendency, mu, config_flags,          &
+                                     defor11, defor12, div, tke,          &
+                                     msfu, xkmh, rdx, rdy, fnm, fnp,      &
+                                     zx, zy, rdzw,                        &
+                                     ids, ide, jds, jde, kds, kde,        &
+                                     ims, ime, jms, jme, kms, kme,        &
+                                     its, ite, jts, jte, kts, kte        )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfu, &
+                                                                      mu
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::   rdzw  
+                                                                    
+ 
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor11, &
+                                                                 defor12, &
+                                                                     div, &   
+                                                                     tke, &   
+                                                                    xkmh, &
+                                                                      zx, &
+                                                                      zy
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+! Local data
+   
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)    :: titau1avg, &
+                                                              titau2avg, &
+                                                                 titau1, & 
+                                                                 titau2, & 
+                                                                 xkxavg, & 
+                                                                  rravg
+! new
+!                                                                 zxavg, & 
+!                                                                 zyavg
+   REAL :: mrdx, mrdy, rcoup
+
+   REAL :: tmpzy, tmpzeta_z
+
+   REAL :: term1, term2, term3
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+ 
+!-----------------------------------------------------------------------
+! u :   p (.), u(|), w(-)
+!       
+!       p  u  p  u                                  u     u
+!
+! p  |  .  |  .  |  .  |   k+1                |  .  |  .  |  .  |   k+1
+!           
+! w     - 13  -     -      k+1                     13               k+1 
+!
+! p  |  11 O 11  |  .  |   k                  |  12 O 12  |  .  |   k      
+!
+! w     - 13  -     -      k                       13               k  
+!
+! p  |  .  |  .  |  .  |   k-1                |  .  |  .  |  .  |   k-1
+!
+!      i-1 i  i i+1                          j-1 j  j j+1 j+1         
+!
+
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+! titau1 = titau11 
+   is_ext=1
+   ie_ext=0
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_11_22_33( config_flags, titau1,            &
+                            mu, tke, xkmh, defor11,          &
+                            is_ext, ie_ext, js_ext, je_ext,  &
+                            ids, ide, jds, jde, kds, kde,    &
+                            ims, ime, jms, jme, kms, kme,    &
+                            its, ite, jts, jte, kts, kte     )
+
+! titau2 = titau12
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=1
+   CALL cal_titau_12_21( config_flags, titau2,            &
+                         mu, xkmh, defor12,               &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+
+! titau1avg = titau11avg
+! titau2avg = titau12avg 
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+      titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i-1,k  ,j)+titau1(i,k  ,j))+ &
+                            fnp(k)*(titau1(i-1,k-1,j)+titau1(i,k-1,j)))
+      titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k  ,j+1)+titau2(i,k  ,j))+ &
+                            fnp(k)*(titau2(i,k-1,j+1)+titau2(i,k-1,j)))
+      tmpzy = 0.25*( zy(i-1,k,j  )+zy(i,k,j  )+ &
+                     zy(i-1,k,j+1)+zy(i,k,j+1)  )
+!      tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i-1,j))
+!      titau1avg(i,k,j)=titau1avg(i,k,j)*zx(i,k,j)*tmpzeta_z
+!      titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy    *tmpzeta_z
+
+      titau1avg(i,k,j)=titau1avg(i,k,j)*zx(i,k,j)
+      titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy    
+
+   ENDDO
+   ENDDO
+   ENDDO
+!
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      titau1avg(i,kts,j)=0.
+      titau1avg(i,ktf+1,j)=0.
+      titau2avg(i,kts,j)=0.
+      titau2avg(i,ktf+1,j)=0.
+   ENDDO
+   ENDDO
+!
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+
+      mrdx=msfu(i,j)*rdx
+      mrdy=msfu(i,j)*rdy
+      tendency(i,k,j)=tendency(i,k,j)-                                    &
+           (mrdx*(titau1(i,k,j  )-titau1(i-1,k,j))+                       &
+            mrdy*(titau2(i,k,j+1)-titau2(i,k,j  ))-                       &
+            msfu(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+ &
+                                   (titau2avg(i,k+1,j)-titau2avg(i,k,j))  &
+                                  )                                      )
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE horizontal_diffusion_u_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_v_2( tendency, mu, config_flags,          &
+                                     defor12, defor22, div, tke,          &
+                                     msfv, xkmh, rdx, rdy, fnm, fnp,      &
+                                     zx, zy, rdzw,                        &
+                                     ids, ide, jds, jde, kds, kde,        &
+                                     ims, ime, jms, jme, kms, kme,        &
+                                     its, ite, jts, jte, kts, kte        )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfv, &
+                                                                      mu
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor12, &
+                                                                 defor22, &
+                                                                     div, &
+                                                                     tke, &
+                                                                    xkmh, &
+                                                                      zx, &
+                                                                      zy, &
+                                                                    rdzw
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+
+! Local data
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)    :: titau1avg, &
+                                                              titau2avg, &
+                                                                 titau1, &
+                                                                 titau2, &
+                                                                 xkxavg, &
+                                                                  rravg
+! new
+!                                                                 zxavg, &
+!                                                                 zyavg
+
+   REAL :: mrdx, mrdy, rcoup
+
+   REAL :: tmpzx, tmpzeta_z
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+ 
+!-----------------------------------------------------------------------
+! v :   p (.), v(+), w(-)
+!       
+!       p  v  p  v                                  v     v
+!
+! p  +  .  +  .  +  .  +   k+1                +  .  +  .  +  .  +   k+1
+!           
+! w     - 23  -     -      k+1                     23               k+1 
+!
+! p  +  22 O 22  +  .  +   k                  +  21 O 21  +  .  +   k      
+!
+! w     - 23  -     -      k                       23               k  
+!
+! p  +  .  +  .  +  .  +   k-1                +  .  +  .  +  .  +   k-1
+!
+!      j-1 j  j j+1                          i-1 i  i i+1 i+1         
+!
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! titau1 = titau21
+   is_ext=0
+   ie_ext=1
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_12_21( config_flags, titau1,          &
+                         mu, xkmh, defor12,             &
+                         is_ext,ie_ext,js_ext,je_ext,   &
+                         ids, ide, jds, jde, kds, kde,  &
+                         ims, ime, jms, jme, kms, kme,  &
+                         its, ite, jts, jte, kts, kte   )
+
+! titau2 = titau22
+   is_ext=0
+   ie_ext=0
+   js_ext=1
+   je_ext=0
+   CALL cal_titau_11_22_33( config_flags, titau2,           &
+                            mu, tke, xkmh, defor22,         &
+                            is_ext, ie_ext, js_ext, je_ext, &
+                            ids, ide, jds, jde, kds, kde,   &
+                            ims, ime, jms, jme, kms, kme,   &
+                            its, ite, jts, jte, kts, kte    )
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+      titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i+1,k  ,j)+titau1(i,k  ,j))+ &
+                            fnp(k)*(titau1(i+1,k-1,j)+titau1(i,k-1,j)))
+      titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k  ,j-1)+titau2(i,k  ,j))+ &
+                            fnp(k)*(titau2(i,k-1,j-1)+titau2(i,k-1,j)))
+
+      tmpzx = 0.25*( zx(i,k,j  )+zx(i+1,k,j  )+ &
+                     zx(i,k,j-1)+zx(i+1,k,j-1)  )
+
+
+      titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx
+      titau2avg(i,k,j)=titau2avg(i,k,j)*zy(i,k,j)
+
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      titau1avg(i,kts,j)=0.
+      titau1avg(i,ktf+1,j)=0.
+      titau2avg(i,kts,j)=0.
+      titau2avg(i,ktf+1,j)=0.
+   ENDDO
+   ENDDO
+!
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+       
+      mrdx=msfv(i,j)*rdx
+      mrdy=msfv(i,j)*rdy
+      tendency(i,k,j)=tendency(i,k,j)-                                    &
+           (mrdy*(titau2(i  ,k,j)-titau2(i,k,j-1))+                       &
+            mrdx*(titau1(i+1,k,j)-titau1(i,k,j  ))-                       &
+            msfv(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+ &
+                                   (titau2avg(i,k+1,j)-titau2avg(i,k,j))  &
+                                )			                  &
+           )
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE horizontal_diffusion_v_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_w_2( tendency, mu, config_flags,          &
+                                     defor13, defor23, div, tke,          &
+                                     msft, xkmh, rdx, rdy, fnm, fnp,      &
+                                     zx, zy, rdz,                         &
+                                     ids, ide, jds, jde, kds, kde,        &
+                                     ims, ime, jms, jme, kms, kme,        &
+                                     its, ite, jts, jte, kts, kte        )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msft, &
+                                                                      mu
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor13, &
+                                                                 defor23, &
+                                                                     div, &
+                                                                     tke, &
+                                                                    xkmh, &
+                                                                      zx, &
+                                                                      zy, &
+                                                                     rdz
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+
+! Local data
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)    :: titau1avg, &
+                                                              titau2avg, &
+                                                                 titau1, &
+                                                                 titau2, &
+                                                                 xkxavg, &
+                                                                  rravg
+! new
+!                                                                 zxavg, &
+!                                                                 zyavg
+
+   REAL :: mrdx, mrdy, rcoup
+
+   REAL :: tmpzx, tmpzy, tmpzeta_z
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+ 
+!-----------------------------------------------------------------------
+! w :   p (.), u(|), v(+), w(-)
+!       
+!       p  u  p  u                               p  v  p  v 
+!
+! w     -     -     -      k+1             w     -     -     -      k+1 
+!
+! p     .  | 33  |  .      k               p     .  + 33  +  .      k      
+!
+! w     -  31 O 31  -      k               w     -  32 O 32  -      k   
+!
+! p     .  | 33  |  .      k-1             p     .  | 33  |  .      k-1 
+!
+! w     -     -     -      k-1             w     -     -     -      k-1 
+!
+!      i-1 i  i i+1                             j-1 j  j j+1         
+!
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! titau1 = titau31
+   is_ext=0
+   ie_ext=1
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_13_31( config_flags, titau1, defor13,   &
+                         mu, xkmh, fnm, fnp,              &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+
+! titau2 = titau32
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=1
+   CALL cal_titau_23_32( config_flags, titau2, defor23,   &
+                         mu, xkmh, fnm, fnp,              &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+
+! titau1avg = titau31avg * zx * zeta_z = titau13avg * zx * zeta_z
+! titau2avg = titau32avg * zy * zeta_z = titau23avg * zy * zeta_z
+
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+      titau1avg(i,k,j)=0.25*(titau1(i+1,k+1,j)+titau1(i,k+1,j)+ &
+                             titau1(i+1,k  ,j)+titau1(i,k  ,j))
+      titau2avg(i,k,j)=0.25*(titau2(i,k+1,j+1)+titau2(i,k+1,j)+ &
+                             titau2(i,k  ,j+1)+titau2(i,k  ,j))
+! new
+      tmpzx  =0.25*( zx(i,k  ,j)+zx(i+1,k  ,j)+ &
+                     zx(i,k+1,j)+zx(i+1,k+1,j)  )
+      tmpzy  =0.25*( zy(i,k  ,j)+zy(i,k  ,j+1)+ &
+                     zy(i,k+1,j)+zy(i,k+1,j+1)  )
+
+      titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx
+      titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy
+!      titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx*zeta_z(i,j)
+!      titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy*zeta_z(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      titau1avg(i,kts  ,j)=0.
+      titau2avg(i,kts  ,j)=0.
+      titau1avg(i,ktf+1,j)=0.
+      titau2avg(i,ktf+1,j)=0.
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+
+      mrdx=msft(i,j)*rdx
+      mrdy=msft(i,j)*rdy
+
+      tendency(i,k,j)=tendency(i,k,j)-                                 &
+           (mrdx*(titau1(i+1,k,j)-titau1(i,k,j))+                      &
+            mrdy*(titau2(i,k,j+1)-titau2(i,k,j))-                      &
+            msft(i,j)*rdz(i,k,j)*(titau1avg(i,k,j)-titau1avg(i,k-1,j)+ &
+                                  titau2avg(i,k,j)-titau2avg(i,k-1,j)  &
+                               )				       &
+           )
+!            msft(i,j)/dn(k)*(titau1avg(i,k,j)-titau1avg(i,k-1,j)+ &
+!                                titau2avg(i,k,j)-titau2avg(i,k-1,j)  &
+!                               )				     &
+!           )
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE horizontal_diffusion_w_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_s (tendency, mu, config_flags, var,       &
+                                   msft, msfu, msfv, xkhh, rdx, rdy,      &
+                                   fnm, fnp, cf1, cf2, cf3,               &
+                                   zx, zy, rdz, rdzw, dn, dnw,            &
+                                   doing_tke,                             &
+                                   ids, ide, jds, jde, kds, kde,          &
+                                   ims, ime, jms, jme, kms, kme,          &
+                                   its, ite, jts, jte, kts, kte           )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   LOGICAL,         INTENT(IN   ) ::        doing_tke
+
+   REAL , INTENT(IN   )           ::        cf1, cf2, cf3
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::     dn
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    dnw
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfu
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfv
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msft
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   mu
+
+!  REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1),                 &
+!         INTENT(IN   ) ::                                         xkhh
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::         &
+                                                                    xkhh, &
+                                                                     rdz, &
+                                                                     rdzw
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::    var, &
+                                                                      zx, &
+                                                                      zy
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+
+! Local data
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)    ::     H1avg, &
+                                                                  H2avg, &
+                                                                     H1, &
+                                                                     H2, &
+                                                                 xkxavg
+! new
+!                                                                 zxavg, &
+!                                                                 zyavg
+
+   REAL , DIMENSION( its:ite, kts:kte, jts:jte)            ::  tmptendf
+
+   REAL    :: mrdx, mrdy, rcoup
+   REAL    :: tmpzx, tmpzy, tmpzeta_z
+   INTEGER :: ktes1,ktes2
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+ 
+!-----------------------------------------------------------------------
+! scalars:   t (.), u(|), v(+), w(-)
+!       
+!       t  u  t  u                               t  v  t  v 
+!
+! w     -     3     -      k+1             w     -     3     -      k+1 
+!
+! t     .  1  O  1  .      k               t     .  2  O  2  .      k      
+!
+! w     -     3     -      k               w     -     3     -      k   
+!
+! t     .  |  .  |  .      k-1             t     .  +  .  +  .      k-1 
+!
+! w     -     -     -      k-1             w     -     -     -      k-1 
+!
+! t    i-1 i  i i+1                             j-1 j  j j+1         
+!
+
+   ktes1=kte-1
+   ktes2=kte-2
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! diffusion of the TKE needs mutiple 2
+
+   IF ( doing_tke ) THEN
+      DO j = j_start, j_end
+      DO k = kts,ktf
+      DO i = i_start, i_end
+         tmptendf(i,k,j)=tendency(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+! H1 = partial var over partial x
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end + 1
+! new
+!     zxavg(i,k,j) =0.5*( zx(i-1,k,j)+ zx(i,k,j))
+      xkxavg(i,k,j)=0.5*(xkhh(i-1,k,j)+xkhh(i,k,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts+1, ktf
+   DO i = i_start, i_end + 1
+      H1avg(i,k,j)=0.5*(fnm(k)*(var(i-1,k  ,j)+var(i,k  ,j))+  &
+                        fnp(k)*(var(i-1,k-1,j)+var(i,k-1,j)))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO i = i_start, i_end + 1
+      H1avg(i,kts  ,j)=0.5*(cf1*var(i  ,1,j)+cf2*var(i  ,2,j)+ &
+                            cf3*var(i  ,3,j)+cf1*var(i-1,1,j)+  &
+                            cf2*var(i-1,2,j)+cf3*var(i-1,3,j))
+      H1avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)- &
+                            var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+ &
+                            var(i-1,ktes1,j)+(var(i-1,ktes1,j)- &
+                            var(i-1,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1))
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end + 1
+! new
+      tmpzx = 0.5*( zx(i,k,j)+ zx(i,k+1,j))
+      H1(i,k,j)=-msfu(i,j)*xkxavg(i,k,j)*(                      &
+                 rdx*(var(i,k,j)-var(i-1,k,j)) - tmpzx*         &
+                     (H1avg(i,k+1,j)-H1avg(i,k,j))*rdzw(i,k,j) )
+
+!      tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i-1,j))
+!      H1(i,k,j)=-msfu(i,j)*xkxavg(i,k,j)*(                         &
+!                 rdx*(var(i,k,j)-var(i-1,k,j)) - tmpzx*tmpzeta_z*  &
+!                     (H1avg(i,k+1,j)-H1avg(i,k,j))/dnw(k))
+   ENDDO
+   ENDDO
+   ENDDO
+
+! H2 = partial var over partial y
+
+   DO j = j_start, j_end + 1
+   DO k = kts, ktf
+   DO i = i_start, i_end
+! new
+!     zyavg(i,k,j) =0.5*( zy(i,k,j-1)+ zy(i,k,j))
+      xkxavg(i,k,j)=0.5*(xkhh(i,k,j-1)+xkhh(i,k,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end + 1
+   DO k = kts+1,   ktf
+   DO i = i_start, i_end
+! new
+      H2avg(i,k,j)=0.5*(fnm(k)*(var(i,k  ,j-1)+var(i,k  ,j))+  &
+                        fnp(k)*(var(i,k-1,j-1)+var(i,k-1,j)))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end + 1
+   DO i = i_start, i_end
+      H2avg(i,kts  ,j)=0.5*(cf1*var(i,1,j  )+cf2*var(i  ,2,j)+ &
+                            cf3*var(i,3,j  )+cf1*var(i,1,j-1)+  &
+                            cf2*var(i,2,j-1)+cf3*var(i,3,j-1))
+      H2avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)- &
+                            var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+ &
+                            var(i,ktes1,j-1)+(var(i,ktes1,j-1)- &
+                            var(i,ktes2,j-1))*0.5*dnw(ktes1)/dn(ktes1))
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end + 1
+   DO k = kts, ktf
+   DO i = i_start, i_end
+! new
+      tmpzy = 0.5*( zy(i,k,j)+ zy(i,k+1,j))
+
+      H2(i,k,j)=-msfv(i,j)*xkxavg(i,k,j)*(                       &
+                 rdy*(var(i,k,j)-var(i,k,j-1)) - tmpzy*          &
+                     (H2avg(i ,k+1,j)-H2avg(i,k,j))*rdzw(i,k,j))
+
+!      tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i,j-1))
+!      H2(i,k,j)=-msfv(i,j)*xkxavg(i,k,j)*(                         &
+!                 rdy*(var(i,k,j)-var(i,k,j-1)) - tmpzy*tmpzeta_z*  &
+!                     (H2avg(i ,k+1,j)-H2avg(i,k,j))/dnw(k))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts+1, ktf
+   DO i = i_start, i_end
+      H1avg(i,k,j)=0.5*(fnm(k)*(H1(i+1,k  ,j)+H1(i,k  ,j))+  &
+                        fnp(k)*(H1(i+1,k-1,j)+H1(i,k-1,j)))
+      H2avg(i,k,j)=0.5*(fnm(k)*(H2(i,k  ,j+1)+H2(i,k  ,j))+  &
+                        fnp(k)*(H2(i,k-1,j+1)+H2(i,k-1,j)))
+! new
+!     zxavg(i,k,j)=fnm(k)*zx(i,k,j)+fnp(k)*zx(i,k-1,j)
+!     zyavg(i,k,j)=fnm(k)*zy(i,k,j)+fnp(k)*zy(i,k-1,j)
+
+! H1avg(i,k,j)=zx*H1avg*zeta_z
+! H2avg(i,k,j)=zy*H2avg*zeta_z
+
+      tmpzx = 0.5*( zx(i,k,j)+ zx(i+1,k,j  ))
+      tmpzy = 0.5*( zy(i,k,j)+ zy(i  ,k,j+1))
+
+      H1avg(i,k,j)=H1avg(i,k,j)*tmpzx
+      H2avg(i,k,j)=H2avg(i,k,j)*tmpzy
+
+!      H1avg(i,k,j)=H1avg(i,k,j)*tmpzx*zeta_z(i,j)
+!      H2avg(i,k,j)=H2avg(i,k,j)*tmpzy*zeta_z(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+ 
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      H1avg(i,kts  ,j)=0.
+      H1avg(i,ktf+1,j)=0.
+      H2avg(i,kts  ,j)=0.
+      H2avg(i,ktf+1,j)=0.
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+
+      mrdx=msft(i,j)*rdx
+      mrdy=msft(i,j)*rdy
+
+      tendency(i,k,j)=tendency(i,k,j)-                      &
+           (mrdx*0.5*((mu(i+1,j)+mu(i,j))*H1(i+1,k,j)-      &
+                      (mu(i-1,j)+mu(i,j))*H1(i  ,k,j))+     &
+            mrdy*0.5*((mu(i,j+1)+mu(i,j))*H2(i,k,j+1)-      &
+                      (mu(i,j-1)+mu(i,j))*H2(i,k,j  ))-     &
+            msft(i,j)*mu(i,j)*(H1avg(i,k+1,j)-H1avg(i,k,j)+ &
+                       H2avg(i,k+1,j)-H2avg(i,k,j)          &
+                                )*rdzw(i,k,j)               &
+                                                          )
+
+   ENDDO
+   ENDDO
+   ENDDO
+           
+   IF ( doing_tke ) THEN
+      DO j = j_start, j_end
+      DO k = kts,ktf
+      DO i = i_start, i_end
+          tendency(i,k,j)=tmptendf(i,k,j)+2.* &
+                          (tendency(i,k,j)-tmptendf(i,k,j))
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+END SUBROUTINE horizontal_diffusion_s
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_2   ( ru_tendf, rv_tendf, rw_tendf, rt_tendf,   &
+                                    tke_tendf, moist_tendf, n_moist,          &
+                                    chem_tendf, n_chem,                       &
+                                    scalar_tendf, n_scalar,                   &
+                                    u_2, v_2,                                 &
+                                    thp,u_base,v_base,t_base,qv_base,mu,tke,  &
+                                    config_flags,defor13,defor23,defor33,div, &
+                                    moist, chem, scalar, xkmv, xkhv,km_opt,   &
+                                    fnm, fnp, dn, dnw, rdz, rdzw,             &
+                                    ids, ide, jds, jde, kds, kde,             &
+                                    ims, ime, jms, jme, kms, kme,             &
+                                    its, ite, jts, jte, kts, kte             )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   INTEGER ,        INTENT(IN   ) ::        n_moist, n_chem, n_scalar, km_opt
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnp
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: dnw
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  dn
+   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      ::  mu
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: qv_base
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  u_base
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  v_base
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  t_base
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::ru_tendf,&
+                                                                 rv_tendf,&
+                                                                 rw_tendf,&
+                                                                tke_tendf,&
+                                                                rt_tendf  
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist),                 &
+          INTENT(INOUT) ::                                    moist_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem),                  &
+          INTENT(INOUT) ::                                     chem_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) ,               &
+          INTENT(INOUT) ::                                   scalar_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist),                 &
+          INTENT(INOUT) ::                                          moist
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem),                  &
+          INTENT(INOUT) ::                                           chem
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) ,               &
+          INTENT(IN   ) ::                                         scalar
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor13, &
+                                                                 defor23, &
+                                                                 defor33, &
+                                                                     div, &
+                                                                    xkmv, &
+                                                                    xkhv, &
+                                                                     tke, &
+                                                                     rdz, &
+                                                                     u_2, &
+                                                                     v_2, &
+                                                                    rdzw
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::    thp
+
+! LOCAL VAR
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme)  ::    var_mix
+
+   INTEGER :: im, i,j,k
+   INTEGER :: i_start, i_end, j_start, j_end
+
+!  REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: xkhv
+
+!***************************************************************************
+!***************************************************************************
+!MODIFICA VARIABILI PER I FLUSSI
+!
+    REAL , DIMENSION( ims:ime, jms:jme) :: Cd
+    REAL :: V0_u,V0_v,tao_xz,tao_yz,ustar,cd0
+    REAL :: xsfc,psi1,vk2,zrough,lnz
+    REAL :: heat_flux
+!
+!FINE MODIFICA VARIABILI PER I FLUSSI
+!***************************************************************************
+!
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+!
+!-----------------------------------------------------------------------
+
+      CALL vertical_diffusion_u_2( ru_tendf, config_flags, mu,    &
+                                   defor13, xkmv,                 &
+                                   dnw, rdzw, fnm, fnp,           &
+                                   ids, ide, jds, jde, kds, kde,  &
+                                   ims, ime, jms, jme, kms, kme,  &
+                                   its, ite, jts, jte, kts, kte  )
+
+
+      CALL vertical_diffusion_v_2( rv_tendf, config_flags, mu,    &
+                                   defor23, xkmv,                 &
+                                   dnw, rdzw, fnm, fnp,           &
+                                   ids, ide, jds, jde, kds, kde,  &
+                                   ims, ime, jms, jme, kms, kme,  &
+                                   its, ite, jts, jte, kts, kte  )
+
+      CALL vertical_diffusion_w_2( rw_tendf, config_flags, mu,    &
+                                   defor33, tke(ims,kms,jms),     &
+                                   div, xkmv,                     &
+                                   dn, rdz,                       &  
+                                   ids, ide, jds, jde, kds, kde,  &
+                                   ims, ime, jms, jme, kms, kme,  &
+                                   its, ite, jts, jte, kts, kte  )
+
+!*****************************************
+!*****************************************
+!  MODIFICA al flusso di momento alla parete
+!
+    cd0 = config_flags%tke_drag_coefficient  ! constant drag coefficient
+                                             ! set in namelist.input
+    DO j = j_start, j_end+1
+    DO i = i_start, i_end+1
+       Cd(i,j)=  cd0
+    ENDDO
+    ENDDO
+!
+!calcolo del modulo della velocita
+    DO j = j_start, j_end
+    DO i = i_start, i_end+1
+       V0_u=0.
+       tao_xz=0.
+       V0_u=    sqrt((u_2(i,kts,j)**2) +         &
+                        (((v_2(i  ,kts,j  )+          &
+                           v_2(i  ,kts,j+1)+          &
+                           v_2(i-1,kts,j  )+          &
+                           v_2(i-1,kts,j+1))/4)**2))+epsilon
+       tao_xz=Cd(i,j)*V0_u*u_2(i,kts,j)
+       ru_tendf(i,kts,j)=ru_tendf(i,kts,j)            &
+                         -0.25*(mu(i,j)+mu(i-1,j))*tao_xz*(rdzw(i,kts,j)+rdzw(i-1,kts,j))
+    ENDDO
+    ENDDO
+ 
+!
+    DO j = j_start, j_end+1
+    DO i = i_start, i_end
+       V0_v=0.
+       tao_yz=0.
+       V0_v=    sqrt((v_2(i,kts,j)**2) +         &
+                        (((u_2(i  ,kts,j  )+          &
+                           u_2(i  ,kts,j-1)+          &
+                           u_2(i+1,kts,j  )+          &
+                           u_2(i+1,kts,j-1))/4)**2))+epsilon
+       tao_yz=Cd(i,j)*V0_v*v_2(i,kts,j)
+       rv_tendf(i,kts,j)=rv_tendf(i,kts,j)            &
+                         -0.25*(mu(i,j)+mu(i,j-1))*tao_yz*(rdzw(i,kts,j)+rdzw(i,kts,j-1))
+    ENDDO
+    ENDDO
+!
+!  FINE MODIFICA al flusso di momento alla parete
+!*****************************************
+!*****************************************
+
+   IF ( config_flags%mix_full_fields ) THEN
+
+     DO j=jts,min(jte,jde-1)
+     DO k=kts,kte-1
+     DO i=its,min(ite,ide-1)
+       var_mix(i,k,j) = thp(i,k,j)
+     ENDDO
+     ENDDO
+     ENDDO
+
+   ELSE
+
+     DO j=jts,min(jte,jde-1)
+     DO k=kts,kte-1
+     DO i=its,min(ite,ide-1)
+       var_mix(i,k,j) = thp(i,k,j) - t_base(k)
+     ENDDO
+     ENDDO
+     ENDDO
+
+   END IF
+
+   CALL vertical_diffusion_s( rt_tendf, config_flags, var_mix, mu, xkhv, &
+                              dn, dnw, rdz, rdzw, fnm, fnp,          &
+                              .false.,                               &
+                              ids, ide, jds, jde, kds, kde,          &
+                              ims, ime, jms, jme, kms, kme,          &
+                              its, ite, jts, jte, kts, kte          )
+
+
+!*****************************************
+!*****************************************
+!MODIFICA al flusso di calore
+!
+!
+    heat_flux = config_flags%tke_heat_flux  ! constant heat flux value
+                                            ! set in namelist.input
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+
+       rt_tendf(i,kts,j)=rt_tendf(i,kts,j)  &
+            +mu(i,j)*heat_flux*rdzw(i,kts,j)
+
+    ENDDO
+    ENDDO
+!
+! FINE MODIFICA al flusso di calore
+!*****************************************
+!*****************************************
+
+   If (km_opt .eq. 2) then
+   CALL vertical_diffusion_s( tke_tendf(ims,kms,jms),               &
+                              config_flags, tke(ims,kms,jms),       &
+                              mu, xkhv,                             &
+                              dn, dnw, rdz, rdzw, fnm, fnp,         &
+                              .true.,                               &
+                              ids, ide, jds, jde, kds, kde,         &
+                              ims, ime, jms, jme, kms, kme,         &
+                              its, ite, jts, jte, kts, kte         )
+   endif
+ 
+   IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN 
+
+     moist_loop: do im = PARAM_FIRST_SCALAR, n_moist
+
+       IF ( (.not. config_flags%mix_full_fields) .and. (im == P_QV) ) THEN
+
+         DO j=jts,min(jte,jde-1)
+         DO k=kts,kte-1
+         DO i=its,min(ite,ide-1)
+          var_mix(i,k,j) = moist(i,k,j,im) - qv_base(k)
+         ENDDO
+         ENDDO
+         ENDDO
+
+       ELSE
+
+         DO j=jts,min(jte,jde-1)
+         DO k=kts,kte-1
+         DO i=its,min(ite,ide-1)
+          var_mix(i,k,j) = moist(i,k,j,im)
+         ENDDO
+         ENDDO
+         ENDDO
+
+       END IF
+
+
+          CALL vertical_diffusion_s( moist_tendf(ims,kms,jms,im),         &
+                                     config_flags, var_mix,               &
+                                     mu, xkhv,                            &
+                                     dn, dnw, rdz, rdzw, fnm, fnp,        &
+                                     .false.,                             &
+                                     ids, ide, jds, jde, kds, kde,        &
+                                     ims, ime, jms, jme, kms, kme,        &
+                                     its, ite, jts, jte, kts, kte        )
+
+     ENDDO moist_loop
+
+   ENDIF
+
+   IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN 
+
+     chem_loop: do im = PARAM_FIRST_SCALAR, n_chem
+
+          CALL vertical_diffusion_s( chem_tendf(ims,kms,jms,im),         &
+                                     config_flags, chem(ims,kms,jms,im), &
+                                     mu, xkhv,                             &
+                                     dn, dnw, rdz, rdzw, fnm, fnp,         &
+                                     .false.,                              &
+                                     ids, ide, jds, jde, kds, kde,         &
+                                     ims, ime, jms, jme, kms, kme,         &
+                                     its, ite, jts, jte, kts, kte         )
+     ENDDO chem_loop
+
+   ENDIF
+
+
+   IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN 
+
+     scalar_loop: do im = PARAM_FIRST_SCALAR, n_scalar
+
+          CALL vertical_diffusion_s( scalar_tendf(ims,kms,jms,im),         &
+                                     config_flags, scalar(ims,kms,jms,im), &
+                                     mu, xkhv,                             &
+                                     dn, dnw, rdz, rdzw, fnm, fnp,         &
+                                     .false.,                              &
+                                     ids, ide, jds, jde, kds, kde,         &
+                                     ims, ime, jms, jme, kms, kme,         &
+                                     its, ite, jts, jte, kts, kte         )
+     ENDDO scalar_loop
+
+   ENDIF
+
+END SUBROUTINE vertical_diffusion_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu,            &
+                                   defor13, xkmv,                         &
+                                   dnw, rdzw, fnm, fnp,                   &
+                                   ids, ide, jds, jde, kds, kde,          &
+                                   ims, ime, jms, jme, kms, kme,          &
+                                   its, ite, jts, jte, kts, kte          )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,         INTENT(IN   ) ::       ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      :: dnw
+!   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      :: zeta_z
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) ,                       &
+                                            INTENT(IN   )      ::defor13, &
+                                                                    xkmv, &
+                                                                      rdzw
+   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      :: mu
+
+! LOCAL VARS
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)        :: titau3
+
+   REAL , DIMENSION( its:ite, jts:jte)                         ::  zzavg
+
+   REAL :: rdzu
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+  
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+! titau3 = titau13
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_13_31( config_flags, titau3, defor13,   &
+                         mu, xkmv, fnm, fnp,              &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+!
+      DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+         rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j))
+         tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j)-titau3(i,k,j))
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+! ******** MODIF...
+!  we will pick up the surface drag (titau3(i,kts,j)) later
+!
+       DO j = j_start, j_end
+       k=kts
+       DO i = i_start, i_end
+ 
+          rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j))
+          tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j))
+       ENDDO
+       ENDDO
+! ******** MODIF...
+
+END SUBROUTINE vertical_diffusion_u_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu,            &
+                                   defor23, xkmv,                         &
+                                   dnw, rdzw, fnm, fnp,                   &
+                                   ids, ide, jds, jde, kds, kde,          &
+                                   ims, ime, jms, jme, kms, kme,          &
+                                   its, ite, jts, jte, kts, kte          )
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,         INTENT(IN   ) ::       ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      :: dnw
+!   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      :: zeta_z
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) ,                       &
+                                            INTENT(IN   )      ::defor23, &
+                                                                    xkmv, &
+                                                                    rdzw
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      :: mu
+
+! LOCAL VARS
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)        :: titau3
+
+   REAL , DIMENSION( its:ite, jts:jte)                         ::  zzavg
+
+   REAL  :: rdzv
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+  
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! titau3 = titau23
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_23_32( config_flags, titau3, defor23,   &
+                         mu, xkmv, fnm, fnp,              &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+
+      rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1))
+      tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j)-titau3(i,k,j))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+! ******** MODIF...
+!  we will pick up the surface drag (titau3(i,kts,j)) later
+!
+       DO j = j_start, j_end
+       k=kts
+       DO i = i_start, i_end
+ 
+          rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1))
+          tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j))
+ 
+       ENDDO
+       ENDDO
+! ******** MODIF...
+
+END SUBROUTINE vertical_diffusion_v_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu,             &
+                                defor33, tke, div, xkmv,                  &
+                                dn, rdz,                                  &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                its, ite, jts, jte, kts, kte              )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,         INTENT(IN   ) ::       ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      ::  dn
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) ,                       &
+                                            INTENT(IN   )      ::defor33, &
+                                                                     tke, &
+                                                                     div, &
+                                                                    xkmv, &
+                                                                     rdz
+
+   REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN   ) :: mu
+
+! LOCAL VARS
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)        :: titau3
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+  
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! titau3 = titau33
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_11_22_33( config_flags, titau3,            &
+                            mu, tke, xkmv, defor33,          &
+                            is_ext, ie_ext, js_ext, je_ext,  &
+                            ids, ide, jds, jde, kds, kde,    &
+                            ims, ime, jms, jme, kms, kme,    &
+                            its, ite, jts, jte, kts, kte     )
+
+!   DO j = j_start, j_end
+!   DO k = kts+1, ktf
+!   DO i = i_start, i_end
+!      titau3(i,k,j)=titau3(i,k,j)*zeta_z(i,j)
+!   ENDDO
+!   ENDDO
+!   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts+1, ktf
+   DO i = i_start, i_end
+      tendency(i,k,j)=tendency(i,k,j)-rdz(i,k,j)*(titau3(i,k,j)-titau3(i,k-1,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE vertical_diffusion_w_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, xkhv,   &
+                                 dn, dnw, rdz, rdzw, fnm, fnp,            &
+                                 doing_tke,                               &
+                                 ids, ide, jds, jde, kds, kde,            &
+                                 ims, ime, jms, jme, kms, kme,            &
+                                 its, ite, jts, jte, kts, kte            )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,         INTENT(IN   ) ::       ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   LOGICAL,         INTENT(IN   ) ::        doing_tke
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      ::  dn
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      :: dnw
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN) ::   xkhv
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::   mu
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) ,                       &
+                                            INTENT(IN   )      ::    var, &
+                                                                     rdz, &
+                                                                    rdzw
+! LOCAL VARS
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION( its:ite, kts:kte, jts:jte)            ::        H3, &
+                                                                 xkxavg, &
+                                                                  rravg
+
+   REAL , DIMENSION( its:ite, kts:kte, jts:jte)            ::  tmptendf
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+  
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+   IF (doing_tke) THEN
+      DO j = j_start, j_end
+      DO k = kts,ktf
+      DO i = i_start, i_end
+         tmptendf(i,k,j)=tendency(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+! H3
+
+   xkxavg = 0.
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+      xkxavg(i,k,j)=fnm(k)*xkhv(i,k,j)+fnp(k)*xkhv(i,k-1,j)
+      H3(i,k,j)=-xkxavg(i,k,j)*(var(i,k,j)-var(i,k-1,j))*rdz(i,k,j)
+!      H3(i,k,j)=-xkxavg(i,k,j)*zeta_z(i,j)* &
+!                 (var(i,k,j)-var(i,k-1,j))/dn(k)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      H3(i,kts,j)=0.
+      H3(i,ktf+1,j)=0.
+!      H3(i,kts,j)=H3(i,kts+1,j)
+!      H3(i,ktf+1,j)=H3(i,ktf,j)
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+      tendency(i,k,j)=tendency(i,k,j)  &
+                       -mu(i,j)*(H3(i,k+1,j)-H3(i,k,j))*rdzw(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   IF (doing_tke) THEN
+      DO j = j_start, j_end
+      DO k = kts,ktf
+      DO i = i_start, i_end
+          tendency(i,k,j)=tmptendf(i,k,j)+2.* &
+                          (tendency(i,k,j)-tmptendf(i,k,j))
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+END SUBROUTINE vertical_diffusion_s
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE cal_titau_11_22_33( config_flags, titau,              &
+                                   mu, tke, xkx, defor,              &
+                                   is_ext, ie_ext, js_ext, je_ext,   &
+                                   ids, ide, jds, jde, kds, kde,     &
+                                   ims, ime, jms, jme, kms, kme,     &
+                                   its, ite, jts, jte, kts, kte      )
+
+! History:     Sep 2003  Changes by George Bryan and Jason Knievel, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000  Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates stress terms (taus) for use in
+!              the calculation of production of TKE by sheared wind
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  &
+    :: is_ext, ie_ext, js_ext, je_ext  
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT )  &
+    :: titau 
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: defor, xkx, tke
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf = MIN( kte, kde-1 )
+
+    i_start = its
+    i_end   = ite
+    j_start = jts
+    j_end   = jte
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-1, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-1, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+    i_start = i_start - is_ext
+    i_end   = i_end   + ie_ext   
+    j_start = j_start - js_ext
+    j_end   = j_end   + je_ext   
+
+    IF ( config_flags%km_opt .EQ. 2) THEN
+      DO j = j_start,j_end
+      DO k = kts,ktf
+      DO i = i_start,i_end  
+        titau(i,k,j) = mu(i,j) * ( - xkx(i,k,j) * ( defor(i,k,j) ) )       
+      END DO
+      END DO
+      END DO
+    ELSE
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        titau(i,k,j) = - mu(i,j) * xkx(i,k,j) * defor(i,k,j)
+      END DO
+      END DO
+      END DO
+    END IF
+
+    END SUBROUTINE cal_titau_11_22_33
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE cal_titau_12_21( config_flags, titau,             &
+                                mu, xkx, defor,                  &
+                                is_ext, ie_ext, js_ext, je_ext,  &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                its, ite, jts, jte, kts, kte     )
+
+! History:     Sep 2003   Modifications by George Bryan and Jason Knievel, NCAR
+!              Oct 2001   Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000   Original code by Shu-Hua Chen, UC-Davis
+
+! Pusrpose     This routine calculates the stress terms (taus) for use in
+!              the calculation of production of TKE by sheared wind
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  &
+    :: is_ext, ie_ext, js_ext, je_ext  
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT )  &
+    :: titau 
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: defor, xkx
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 )  &
+    :: xkxavg  
+
+    REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 )  &
+    :: muavg
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf = MIN( kte, kde-1 )
+
+! Needs one more point in the x and y directions.
+
+    i_start = its
+    i_end   = ite
+    j_start = jts
+    j_end   = jte
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_end   = MIN( ide-1, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_end   = MIN( jde-1, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+    i_start = i_start - is_ext
+    i_end   = i_end   + ie_ext   
+    j_start = j_start - js_ext
+    j_end   = j_end   + je_ext   
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      xkxavg(i,k,j) = 0.25 * ( xkx(i-1,k,j  ) + xkx(i,k,j  ) +  &
+                               xkx(i-1,k,j-1) + xkx(i,k,j-1) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      muavg(i,j) = 0.25 * ( mu(i-1,j  ) + mu(i,j  ) +  &
+                            mu(i-1,j-1) + mu(i,j-1) )
+    END DO
+    END DO
+
+! titau12 or titau21
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    END SUBROUTINE cal_titau_12_21
+
+!=======================================================================
+
+    SUBROUTINE cal_titau_13_31( config_flags, titau,             &
+                                defor, mu, xkx, fnm, fnp,        &
+                                is_ext, ie_ext, js_ext, je_ext,  &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                its, ite, jts, jte, kts, kte     )
+
+! History:     Sep 2003   Modifications by George Bryan and Jason Knievel, NCAR
+!              Oct 2001   Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000   Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates the stress terms (taus) for use in
+!              the calculation of production of TKE by sheared wind
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  &
+    :: is_ext, ie_ext, js_ext, je_ext  
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT )  &
+    :: titau 
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT( IN )  &
+    :: defor, xkx
+
+    REAL, DIMENSION( ims:ime, jms:jme), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 )  &
+    :: xkxavg 
+
+    REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 )  &
+    :: muavg
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf = MIN( kte, kde-1 )
+
+! Find ide-1 and jde-1 for averaging to p point.
+
+    i_start = its
+    i_end   = ite
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-1, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-2, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+    i_start = i_start - is_ext
+    i_end   = i_end   + ie_ext   
+    j_start = j_start - js_ext
+    j_end   = j_end   + je_ext   
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k  ,j) + xkx(i-1,k  ,j) ) +  &
+                              fnp(k) * ( xkx(i,k-1,j) + xkx(i-1,k-1,j) ) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      muavg(i,j) = 0.5 * ( mu(i,j) + mu(i-1,j) )
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
+    ENDDO
+    ENDDO
+    ENDDO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      titau(i,kts  ,j) = 0.0
+      titau(i,ktf+1,j) = 0.0
+    ENDDO
+    ENDDO
+
+    END SUBROUTINE cal_titau_13_31
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE cal_titau_23_32( config_flags, titau, defor,      &
+                                mu, xkx, fnm, fnp,               &
+                                is_ext, ie_ext, js_ext, je_ext,  &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                its, ite, jts, jte, kts, kte     )
+
+! History:     Sep 2003  Changes by George Bryan and Jason Knievel, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000  Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates stress terms (taus) for use in
+!              the calculation of production of TKE by sheared wind
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  &
+    :: is_ext,ie_ext,js_ext,je_ext  
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT )  &  
+    :: titau 
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: defor, xkx
+  
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    ::  mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 )  &
+    :: xkxavg 
+                                                                   
+    REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 )  &
+    :: muavg
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+     ktf = MIN( kte, kde-1 )
+
+! Find ide-1 and jde-1 for averaging to p point.
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = jte
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-1, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+    i_start = i_start - is_ext
+    i_end   = i_end   + ie_ext   
+    j_start = j_start - js_ext
+    j_end   = j_end   + je_ext   
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k  ,j) + xkx(i,k  ,j-1) ) +  &
+                              fnp(k) * ( xkx(i,k-1,j) + xkx(i,k-1,j-1) ) )
+    END DO
+    END DO
+    END DO
+ 
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      muavg(i,j) = 0.5 * ( mu(i,j) + mu(i,j-1) )
+    END DO
+    END DO
+ 
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+       titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      titau(i,kts  ,j) = 0.0
+      titau(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+    END SUBROUTINE cal_titau_23_32
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE phy_bc ( config_flags,div,defor11,defor22,defor33,              &
+                    defor12,defor13,defor23,xkmh,xkmhd,xkmv,xkhh,xkhv,tke, &
+                    RUBLTEN, RVBLTEN,                                      &
+                    ids, ide, jds, jde, kds, kde,                          &
+                    ims, ime, jms, jme, kms, kme,                          &
+                    ips, ipe, jps, jpe, kps, kpe,                          &
+                    its, ite, jts, jte, kts, kte                           )
+
+!------------------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            ips, ipe, jps, jpe, kps, kpe, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::RUBLTEN, &
+                                                                 RVBLTEN, &
+                                                                 defor11, &
+                                                                 defor22, &
+                                                                 defor33, &
+                                                                 defor12, &
+                                                                 defor13, &
+                                                                 defor23, &
+                                                                    xkmh, &
+                                                                   xkmhd, &
+                                                                    xkmv, &
+                                                                    xkhh, &
+                                                                    xkhv, &
+                                                                     tke, &
+                                                                     div
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   IF ( (config_flags%bl_pbl_physics .GT. 0) &
+        .OR. (config_flags%modif_wrf) ) THEN
+!****MARS: Always do that ?? > yes, for periodic simu -- grep in share
+        CALL set_physical_bc3d( RUBLTEN , 't', config_flags,              &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+        CALL set_physical_bc3d( RVBLTEN , 't', config_flags,              &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+   ENDIF
+
+   ! move out of the conditional, below; this one is needed for 
+   ! all diff_opt cases.  JM
+   CALL set_physical_bc3d( xkmhd   , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   IF(config_flags%diff_opt .eq. 2) THEN
+
+   CALL set_physical_bc3d( xkmh    , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+
+   CALL set_physical_bc3d( xkmv    , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( xkhh    , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( xkhv    , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( tke     , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( div     , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor11 , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor22 , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor33 , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor12 , 'd', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor13 , 'e', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor23 , 'f', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   ENDIF
+
+END SUBROUTINE phy_bc 
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_rhs( tendency, BN2, config_flags,            &
+                        defor11, defor22, defor33,              &
+                        defor12, defor13, defor23,              &
+                        u, v, w, div, tke, mu,                  &
+                        theta, p, p8w, t8w, z, fnm, fnp,        &
+                        cf1, cf2, cf3, msft, xkmh, xkmv, xkhv,  &
+                        rdx, rdy, dx, dy, dt, zx, zy,           &
+                        rdz, rdzw, dn, dnw, cr_len,             &
+                        ids, ide, jds, jde, kds, kde,           &
+                        ims, ime, jms, jme, kms, kme,           &
+                        its, ite, jts, jte, kts, kte            )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, INTENT( IN )  &
+    :: cf1, cf2, cf3, dt, rdx, rdy, dx, dy, cr_len
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp, dnw, dn
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: msft
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tendency
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: defor11, defor22, defor33, defor12, defor13, defor23,  &
+       div, BN2, tke, xkmh, xkmv, xkhv, zx, zy, u, v, w, theta,  &
+       p, p8w, t8w, z, rdz, rdzw
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    CALL tke_shear(    tendency, config_flags,                &
+                       defor11, defor22, defor33,             &
+                       defor12, defor13, defor23,             &
+                       u, v, w, tke, mu, fnm, fnp,            &
+                       cf1, cf2, cf3, msft, xkmh, xkmv,       &
+                       rdx, rdy, zx, zy, rdz, rdzw, dnw, dn,  &
+                       ids, ide, jds, jde, kds, kde,          &
+                       ims, ime, jms, jme, kms, kme,          &
+                       its, ite, jts, jte, kts, kte           )
+
+    CALL tke_buoyancy( tendency, config_flags, mu,            &
+                       tke, xkhv, BN2, theta, dt,             &
+                       ids, ide, jds, jde, kds, kde,          &
+                       ims, ime, jms, jme, kms, kme,          &
+                       its, ite, jts, jte, kts, kte           )
+
+    CALL tke_dissip(   tendency, config_flags,                &
+                       mu, tke, bn2, theta, p8w, t8w, z,      &
+                       dx, dy,rdz, rdzw, cr_len,              &
+                       ids, ide, jds, jde, kds, kde,          &
+                       ims, ime, jms, jme, kms, kme,          &
+                       its, ite, jts, jte, kts, kte           )
+
+! Set a lower limit on TKE.
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .or. config_flags%specified .or. &
+         config_flags%nested) i_start = MAX(ids+1,its)
+    IF ( config_flags%open_xe .or. config_flags%specified .or. &
+         config_flags%nested) i_end   = MIN(ide-2,ite)
+    IF ( config_flags%open_ys .or. config_flags%specified .or. &
+         config_flags%nested) j_start = MAX(jds+1,jts)
+    IF ( config_flags%open_ye .or. config_flags%specified .or. &
+         config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+ 
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = max( tendency(i,k,j), -mu(i,j) * max( 0.0 , tke(i,k,j) ) / dt )
+    END DO
+    END DO
+    END DO
+
+    END SUBROUTINE tke_rhs
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_buoyancy( tendency, config_flags, mu,    &
+                             tke, xkhv, BN2, theta, dt,     &
+                             ids, ide, jds, jde, kds, kde,  &
+                             ims, ime, jms, jme, kms, kme,  &
+                             its, ite, jts, jte, kts, kte   )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, INTENT( IN )  &
+    :: dt
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tendency
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: xkhv, tke, BN2, theta 
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf
+
+    INTEGER  &
+    :: i_start, i_end, j_start, j_end
+
+    REAL :: heat_flux
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add to the TKE tendency the term that accounts for production of TKE
+! due to buoyant motions.
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_end   = MIN( jde-2, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+ 
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) - mu(i,j) * xkhv(i,k,j) * BN2(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! MARTA: change in the computation of the tke's tendency  at the surface.
+!  the buoyancy flux is the average of the surface heat flux (0.06) and the
+!   flux at the first w level
+!
+! WCS 040331
+
+   heat_flux = config_flags%tke_heat_flux  ! constant heat flux value
+                                           ! set in namelist.input
+ IF(abs(heat_flux).lt.1.0e-6)THEN
+   K=KTS
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      tendency(i,k,j)= tendency(i,k,j) - &
+                   mu(i,j)*xkhv(i,k,j)*BN2(i,k,j)
+   ENDDO
+   ENDDO   
+ ELSE
+   K=KTS
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      tendency(i,k,j)= tendency(i,k,j) - &
+                   mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2.
+
+   ENDDO
+   ENDDO   
+ ENDIF
+! end of MARTA/WCS change
+
+! The tendency array now includes production of TKE from buoyant
+! motions.
+!-----------------------------------------------------------------------
+
+    END SUBROUTINE tke_buoyancy
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_dissip( tendency, config_flags,            &
+                           mu, tke, bn2, theta, p8w, t8w, z,  &
+                           dx, dy, rdz, rdzw, cr_len_in,      &
+                           ids, ide, jds, jde, kds, kde,      &
+                           ims, ime, jms, jme, kms, kme,      &
+                           its, ite, jts, jte, kts, kte       )
+
+! History:     Sep 2003  Changes by George Bryan and Jason Knievel, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000  Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates dissipation of turbulent kinetic
+!              energy.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    ::  ids, ide, jds, jde, kds, kde,  &
+        ims, ime, jms, jme, kms, kme,  &
+        its, ite, jts, jte, kts, kte
+
+    REAL, INTENT( IN )  &
+    :: dx, dy, cr_len_in
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tendency
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: tke, bn2, theta, p8w, t8w, z, rdz, rdzw
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: dthrdn
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: l_scale
+
+    REAL, DIMENSION( its:ite )  & 
+    :: sumtke,  sumtkez
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+    REAL  &
+    :: disp_len, deltas, coefc, tmpdz, len_s, thetasfc,  &
+       thetatop, len_0, tketmp, tmp, cr_len, ce1, ce2
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ce1 = ( c_k / 0.10 ) * 0.19
+    ce2 = max( 0.0 , 0.93 - ce1 )
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN(ite,ide-1)
+    j_start = jts
+    j_end   = MIN(jte,jde-1)
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-2, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+    cr_len = cr_len_in
+    cr_len = dx + 1.0 !  hardwire for mixing length = (dx*dy*dz)**(1/3).
+                      !  remove this for the alternate formulation
+
+    IF (dx .gt. cr_len) THEN
+
+      DO j = j_start, j_end
+        DO i = i_start, i_end
+          sumtke(i)  = 0.0
+          sumtkez(i) = 0.0
+        END DO
+        DO k = kts, ktf
+        DO i = i_start, i_end
+          tketmp     = MAX( tke(i,k,j), 0.0 )
+          sumtke(i)  = sumtke(i) + SQRT(tketmp) / rdzw(i,k,j)
+          sumtkez(i) = sumtkez(i)+ sumtke(i) * z(i,k,j)
+          IF ( ABS( sumtke(i) ) .gt. 0.01 ) THEN
+            len_0 = 0.2 * sumtkez(i) / sumtke(i)
+          ELSE
+            len_0 = 80.0
+          ENDIF
+          len_0 = MIN( 80.0, len_0)
+          l_scale(i,k,j)  = KARMAN * z(i,k,j) /  &
+                            ( 1.0 + KARMAN * z(i,k,j) / len_0 )
+          tendency(i,k,j) = tendency(i,k,j) -                     &
+                            mu(i,j) * 2.0 * SQRT( 2.0 ) / 15.0 *  &
+                            tketmp**1.5 / l_scale(i,k,j)
+        END DO
+        END DO
+      END DO
+    ELSE
+      CALL calc_l_scale( config_flags, tke, BN2, l_scale,      &
+                         i_start, i_end, ktf, j_start, j_end,  &
+                         dx, dy, rdzw,                         &
+                         ids, ide, jds, jde, kds, kde,         &
+                         ims, ime, jms, jme, kms, kme,         &
+                         its, ite, jts, jte, kts, kte          )
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        deltas  = ( dx * dy / rdzw(i,k,j) )**0.33333333
+        tketmp  = MAX( tke(i,k,j), 1.0e-6 )
+
+! Apply Deardorff's (1980) "wall effect" at the bottom of the domain. 
+
+        IF ( k .eq. kts .or. k .eq. ktf ) then
+          coefc = 3.9
+        ELSE
+          coefc = ce1 + ce2 * l_scale(i,k,j) / deltas
+        END IF
+
+        tendency(i,k,j) = tendency(i,k,j) - &
+                          mu(i,j) * coefc * tketmp**1.5 / l_scale(i,k,j)
+      END DO
+      END DO
+      END DO
+    ENDIF
+
+    END SUBROUTINE tke_dissip
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_shear( tendency, config_flags,                &
+                          defor11, defor22, defor33,             &
+                          defor12, defor13, defor23,             &
+                          u, v, w, tke, mu, fnm, fnp,            &
+                          cf1, cf2, cf3, msft, xkmh, xkmv,       &
+                          rdx, rdy, zx, zy, rdz, rdzw, dn, dnw,  &
+                          ids, ide, jds, jde, kds, kde,          &
+                          ims, ime, jms, jme, kms, kme,          &
+                          its, ite, jts, jte, kts, kte           )
+
+! History:     Sep 2003   Rewritten by George Bryan and Jason Knievel,
+!                         NCAR
+!              Oct 2001   Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000   Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates the production of turbulent
+!              kinetic energy by stresses due to sheared wind.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980) 
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+! avg          temporary working array
+! cf1          
+! cf2         
+! cf3
+! defor11      deformation term ( du/dx + du/dx )
+! defor12      deformation term ( dv/dx + du/dy ); same as defor21
+! defor13      deformation term ( dw/dx + du/dz ); same as defor31
+! defor22      deformation term ( dv/dy + dv/dy )
+! defor23      deformation term ( dw/dy + dv/dz ); same as defor32
+! defor33      deformation term ( dw/dz + dw/dz )
+! div          3-d divergence
+! dn
+! dnw
+! fnm
+! fnp
+! msft
+! rdx
+! rdy
+! tendency
+! titau        tau (stress tensor) with a tilde, indicating division by
+!              a map-scale factor and the fraction of the total modeled
+!              atmosphere beneath a given altitude (titau = tau/m/zeta)
+! tke          turbulent kinetic energy
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, INTENT( IN )  &
+    :: cf1, cf2, cf3, rdx, rdy
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp, dn, dnw
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: msft
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tendency
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &  
+    :: defor11, defor22, defor33, defor12, defor13, defor23,    &
+       tke, xkmh, xkmv, zx, zy, u, v, w, rdz, rdzw
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, ktes1, ktes2,      &
+       i_start, i_end, j_start, j_end,  &
+       is_ext, ie_ext, js_ext, je_ext   
+
+    REAL  &
+    :: mtau
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 )  &
+    :: avg, titau, tmp2
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: titau12, tmp1, zxavg, zyavg
+
+    REAL :: absU, cd0
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf    = MIN( kte, kde-1 )
+    ktes1  = kte-1
+    ktes2  = kte-2
+   
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_end   = MIN( jde-2, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      zxavg(i,k,j) = 0.25 * ( zx(i,k  ,j) + zx(i+1,k  ,j) + &
+                              zx(i,k+1,j) + zx(i+1,k+1,j)  )
+      zyavg(i,k,j) = 0.25 * ( zy(i,k  ,j) + zy(i,k  ,j+1) + &
+                              zy(i,k+1,j) + zy(i,k+1,j+1)  )
+    END DO
+    END DO
+    END DO
+
+! Begin calculating production of turbulence due to shear.  The approach
+! is to add together contributions from six terms, each of which is the
+! square of a deformation that is then multiplied by an exchange
+! coefficiant.  The same exchange coefficient is assumed for horizontal
+! and vertical coefficients for some of the terms (the vertical value is
+! the one used). 
+
+! For defor11.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + 0.5 *  &
+                        mu(i,j) * xkmh(i,k,j) * ( ( defor11(i,k,j) )**2 )
+    END DO
+    END DO
+    END DO
+
+! For defor22.
+
+    DO j = j_start, j_end 
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + 0.5 *  &
+                        mu(i,j) * xkmh(i,k,j) * ( ( defor22(i,k,j) )**2 )
+    END DO
+    END DO
+    END DO
+
+! For defor33.
+
+    DO j = j_start, j_end 
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + 0.5 *  &
+                        mu(i,j) * xkmv(i,k,j) * ( ( defor33(i,k,j) )**2 )
+    END DO
+    END DO
+    END DO
+
+! For defor12.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      avg(i,k,j) = 0.25 *  &
+                   ( ( defor12(i  ,k,j)**2 ) + ( defor12(i  ,k,j+1)**2 ) +  &
+                     ( defor12(i+1,k,j)**2 ) + ( defor12(i+1,k,j+1)**2 ) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmh(i,k,j) * avg(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! For defor13.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end+1
+      tmp2(i,k,j) = defor13(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end+1
+      tmp2(i,kts  ,j) = 0.0
+      tmp2(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      avg(i,k,j) = 0.25 *  &
+                   ( ( tmp2(i  ,k+1,j)**2 ) + ( tmp2(i  ,k,j)**2 ) +  &
+                     ( tmp2(i+1,k+1,j)**2 ) + ( tmp2(i+1,k,j)**2 ) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j)
+    END DO
+    END DO
+    END DO
+
+!MARTA: add the drag at the surface; WCS 040331
+    K=KTS
+
+    cd0 = config_flags%tke_drag_coefficient  ! drag coefficient set 
+                                             ! in namelist.input
+    DO j = j_start, j_end   
+    DO i = i_start, i_end
+
+      absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)
+
+      tendency(i,k,j) = tendency(i,k,j) +       &
+           mu(i,j)*( (u(i,k,j)+u(i+1,k,j))*0.5* &
+                     cd0*absU*defor13(i,kts+1,j))
+
+    END DO
+    END DO
+! end of MARTA/WCS change
+
+! For defor23.
+
+    DO j = j_start, j_end+1
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      tmp2(i,k,j) = defor23(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end+1
+    DO i = i_start, i_end
+      tmp2(i,kts,  j) = 0.0
+      tmp2(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      avg(i,k,j) = 0.25 *  &
+                   ( ( tmp2(i,k+1,j  )**2 ) + ( tmp2(i,k,j  )**2) +  &
+                     ( tmp2(i,k+1,j+1)**2 ) + ( tmp2(i,k,j+1)**2) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j)
+    END DO
+    END DO
+    END DO
+
+!MARTA: add the drag at the surface; WCS 040331
+    K=KTS
+
+    cd0 = config_flags%tke_drag_coefficient   ! constant drag coefficient 
+                                              ! set in namelist.input
+    DO j = j_start, j_end   
+    DO i = i_start, i_end
+
+      absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)
+
+      tendency(i,k,j) = tendency(i,k,j) +       &
+           mu(i,j)*( (v(i,k,j)+v(i,k,j+1))*0.5* &
+                     cd0*absU*defor23(i,kts+1,j))
+
+    END DO
+    END DO
+! end of MARTA/WCS change
+
+    END SUBROUTINE tke_shear
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE compute_diff_metrics( config_flags, ph, phb, z, rdz, rdzw,  &
+                                     zx, zy, rdx, rdy,                     &
+                                     ids, ide, jds, jde, kds, kde,         &
+                                     ims, ime, jms, jme, kms, kme,         &
+                                     its, ite, jts, jte, kts, kte         )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: ph, phb
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( OUT )  &
+    :: rdz, rdzw, zx, zy, z
+
+    REAL, INTENT( IN )  &
+    :: rdx, rdy
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, i_start, i_end, j_start, j_end, ktf
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf = MIN( kte, kde-1 )
+
+! Bug fix, WCS, 22 april 2002.
+
+! We need rdzw in halo for average to u and v points.
+
+    j_start = jts-1
+    j_end   = jte
+
+! Begin with dz computations.
+
+    DO j = j_start, j_end
+
+      IF ( ( j_start >= jts ) .AND. ( j_end <= MIN( jte, jde-1 ) ) ) THEN
+        i_start = its-1
+        i_end   = ite
+      ELSE
+        i_start = its
+        i_end   = MIN( ite, ide-1 )
+      END IF
+
+! Compute z at w points for rdz and rdzw computations.  We'll switch z
+! to z at p points before returning
+
+      DO k = 1, kte
+
+! Bug fix, WCS, 22 april 2002
+
+      DO i = i_start, i_end
+        z(i,k,j) = ( ph(i,k,j) + phb(i,k,j) ) / g
+      END DO
+      END DO
+
+      DO k = 1, ktf
+      DO i = i_start, i_end
+        rdzw(i,k,j) = 1.0 / ( z(i,k+1,j) - z(i,k,j) )
+      END DO
+      END DO
+
+      DO k = 2, ktf
+      DO i = i_start, i_end
+        rdz(i,k,j) = 2.0 / ( z(i,k+1,j) - z(i,k-1,j) )
+      END DO
+      END DO
+
+! Bug fix, WCS, 22 april 2002; added the following code
+
+      DO i = i_start, i_end
+        rdz(i,1,j) = 2./(z(i,2,j)-z(i,1,j))
+      END DO
+
+    END DO
+
+! End bug fix.
+
+! Now compute zx and zy; we'll assume that the halo for ph and phb is
+! properly filled.
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    DO j = j_start, j_end
+    DO k = 1, kte
+    DO i = MAX( ids+1, its ), i_end
+      zx(i,k,j) = rdx * ( phb(i,k,j) - phb(i-1,k,j) ) / g
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = 1, kte
+    DO i = MAX( ids+1, its ), i_end
+      zx(i,k,j) = zx(i,k,j) + rdx * ( ph(i,k,j) - ph(i-1,k,j) ) / g
+    END DO
+    END DO
+    END DO
+
+    DO j = MAX( jds+1, jts ), j_end
+    DO k = 1, kte
+    DO i = i_start, i_end
+      zy(i,k,j) = rdy * ( phb(i,k,j) - phb(i,k,j-1) ) / g
+    END DO
+    END DO
+    END DO
+
+    DO j = MAX( jds+1, jts ), j_end
+    DO k = 1, kte
+    DO i = i_start, i_end
+      zy(i,k,j) = zy(i,k,j) + rdy * ( ph(i,k,j) - ph(i,k,j-1) ) / g
+    END DO
+    END DO
+    END DO
+
+! Some b.c. on zx and zy.
+
+    IF ( .NOT. config_flags%periodic_x ) THEN
+
+      IF ( ite == ide ) THEN
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zx(ide,k,j) = 0.0
+        END DO
+        END DO
+      END IF
+
+      IF ( its == ids ) THEN
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zx(ids,k,j) = 0.0
+        END DO
+        END DO
+      END IF
+
+    ELSE
+
+      IF ( ite == ide ) THEN
+        DO j=j_start,j_end
+        DO k=1,ktf
+         zx(ide,k,j) = rdx * ( phb(ide,k,j) - phb(ide-1,k,j) ) / g
+        END DO
+        END DO
+
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zx(ide,k,j) = zx(ide,k,j) + rdx * ( ph(ide,k,j) - ph(ide-1,k,j) ) / g
+        END DO
+        END DO
+      END IF
+
+      IF ( its == ids ) THEN
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zx(ids,k,j) = rdx * ( phb(ids,k,j) - phb(ids-1,k,j) ) / g
+        END DO
+        END DO
+
+        DO j =j_start,j_end
+        DO k =1,ktf
+          zx(ids,k,j) = zx(ids,k,j) + rdx * ( ph(ids,k,j) - ph(ids-1,k,j) ) / g
+        END DO
+        END DO
+      END IF
+
+    END IF
+
+    IF ( .NOT. config_flags%periodic_y ) THEN
+
+      IF ( jte == jde ) THEN
+        DO k =1, ktf
+        DO i =i_start, i_end
+          zy(i,k,jde) = 0.0
+        END DO
+        END DO
+      END IF
+
+      IF ( jts == jds ) THEN
+        DO k =1, ktf
+        DO i =i_start, i_end
+          zy(i,k,jds) = 0.0
+        END DO
+        END DO
+      END IF
+
+    ELSE
+
+      IF ( jte == jde ) THEN
+        DO j=j_start, j_end
+        DO k=1, ktf
+          zy(i,k,jde) = rdy * ( phb(i,k,jde) - phb(i,k,jde-1) ) / g
+        END DO
+        END DO
+
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zy(i,k,jde) = zy(i,k,jde) + rdy * ( ph(i,k,jde) - ph(i,k,jde-1) ) / g
+        END DO
+        END DO
+      END IF
+
+      IF ( jts == jds ) THEN
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zy(i,k,jds) = rdy * ( phb(i,k,jds) - phb(i,k,jds-1) ) / g
+        END DO
+        END DO
+
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zy(i,k,jds) = zy(i,k,jds) + rdy * ( ph(i,k,jds) - ph(i,k,jds-1) ) / g
+        END DO
+        END DO
+      END IF
+
+    END IF
+      
+! Calculate z at p points.
+
+    DO j = j_start, j_end
+      DO k = 1, ktf
+      DO i = i_start, i_end
+        z(i,k,j) = 0.5 *  &
+                   ( ph(i,k,j) + phb(i,k,j) + ph(i,k+1,j) + phb(i,k+1,j) ) / g
+      END DO
+      END DO
+    END DO
+
+    END SUBROUTINE compute_diff_metrics
+
+!=======================================================================
+!=======================================================================
+
+    END MODULE module_diffusion_em
+
+!=======================================================================
+!=======================================================================
+
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_em.F	(revision 2744)
@@ -0,0 +1,1719 @@
+!WRF:MODEL_LAYER:DYNAMICS
+!
+
+MODULE module_em
+
+   USE module_model_constants
+   USE module_advect_em
+   USE module_big_step_utilities_em
+   USE module_state_description
+
+CONTAINS
+
+!------------------------------------------------------------------------
+
+SUBROUTINE rk_step_prep  ( config_flags, rk_step,           &
+                           u, v, w, t, ph, mu,              &
+                           moist,                           &
+                           ru, rv, rw, ww, php, alt,        &
+                           muu, muv,                        &
+                           mub, mut, phb, pb, p, al, alb,   &
+                           cqu, cqv, cqw,                   &
+                           msfu, msfv, msft,                &
+                           fnm, fnp, dnw, rdx, rdy,         &
+                           n_moist,                         &
+                           ids, ide, jds, jde, kds, kde,    &
+                           ims, ime, jms, jme, kms, kme,    &
+                           its, ite, jts, jte, kts, kte    )
+
+   IMPLICIT NONE
+
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte
+
+   INTEGER ,       INTENT(IN   ) :: n_moist, rk_step
+
+   REAL ,          INTENT(IN   ) :: rdx, rdy
+
+   REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
+                                               INTENT(IN   ) ::  u,       &
+                                                                 v,       &
+                                                                 w,       &
+                                                                 t,       &
+                                                                 ph,      &
+                                                                 phb,     &
+                                                                 pb,      &
+                                                                 al,      &
+                                                                 alb
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme  ) ,                     &
+                                               INTENT(  OUT) ::  ru,      &
+                                                                 rv,      &
+                                                                 rw,      &
+                                                                 ww,      &
+                                                                 php,     &
+                                                                 cqu,     &
+                                                                 cqv,     &
+                                                                 cqw,     &
+                                                                 alt
+
+   REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
+                                               INTENT(IN   ) ::  p
+                                                                 
+
+
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), INTENT(   IN) :: &
+                                                           moist
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,    INTENT(IN   ) :: msft,   &
+                                                               msfu,   &
+                                                               msfv,   &
+                                                               mu,     &
+                                                               mub
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,    INTENT(  OUT) :: muu,    &
+                                                               muv,    &
+                                                               mut
+
+   REAL , DIMENSION( kms:kme ) ,    INTENT(IN   ) :: fnm, fnp, dnw
+
+   integer :: k
+
+
+!<DESCRIPTION>
+!
+!  rk_step_prep prepares a number of diagnostic quantities 
+!  in preperation for a Runge-Kutta timestep.  subroutines called
+!  by rk_step_prep calculate
+!
+!  (1) total column dry air mass (mut, call to calculate_full)
+!
+!  (2) total column dry air mass at u and v points 
+!      (muu, muv, call to calculate_mu_uv)
+!
+!  (3) mass-coupled velocities for advection
+!      (ru, rv, and rw, call to couple_momentum)
+!
+!  (4) omega (call to calc_ww_cp)
+!
+!  (5) moisture coefficients (cqu, cqv, cqw, call to calc_cq)
+!
+!  (6) inverse density (alt, call to calc_alt)
+!
+!  (7) geopotential at pressure points (php, call to calc_php)
+!
+!</DESCRIPTION>
+
+   CALL calculate_full( mut, mub, mu,             &
+                        ids, ide, jds, jde, 1, 2, &
+                        ims, ime, jms, jme, 1, 1, &
+                        its, ite, jts, jte, 1, 1 )
+
+   CALL calc_mu_uv ( config_flags,                  &
+                     mu, mub, muu, muv,             &
+                     ids, ide, jds, jde, kds, kde,  &
+                     ims, ime, jms, jme, kms, kme,  &
+                     its, ite, jts, jte, kts, kte  )
+
+   CALL couple_momentum( muu, ru, u, msfu,              &
+                         muv, rv, v, msfv,              &
+                         mut, rw, w, msft,              &
+                         ids, ide, jds, jde, kds, kde,  &
+                         ims, ime, jms, jme, kms, kme,  &
+                         its, ite, jts, jte, kts, kte  )
+
+!  new call, couples V with mu, also has correct map factors.  WCS, 3 june 2001
+   CALL calc_ww_cp ( u, v, mu, mub, ww,               &
+                     rdx, rdy, msft, msfu, msfv, dnw, &
+                     ids, ide, jds, jde, kds, kde,    &
+                     ims, ime, jms, jme, kms, kme,    &
+                     its, ite, jts, jte, kts, kte    )
+
+   CALL calc_cq ( moist, cqu, cqv, cqw, n_moist, &
+                  ids, ide, jds, jde, kds, kde,  &
+                  ims, ime, jms, jme, kms, kme,  &
+                  its, ite, jts, jte, kts, kte  )
+
+   CALL calc_alt ( alt, al, alb,                 &
+                   ids, ide, jds, jde, kds, kde, &
+                   ims, ime, jms, jme, kms, kme, &
+                   its, ite, jts, jte, kts, kte )
+
+   CALL calc_php ( php, ph, phb,                 &
+                   ids, ide, jds, jde, kds, kde, &
+                   ims, ime, jms, jme, kms, kme, &
+                   its, ite, jts, jte, kts, kte )
+
+END SUBROUTINE rk_step_prep
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_tendency ( config_flags, rk_step,                           &
+                         ru_tend, rv_tend, rw_tend, ph_tend, t_tend,      &
+                         ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
+                         mu_tend, u_save, v_save, w_save, ph_save,        &
+                         t_save, mu_save, RTHFTEN,                        &
+                         ru, rv, rw, ww,                                  &
+                         u, v, w, t, ph,                                  &
+                         u_old, v_old, w_old, t_old, ph_old,              &
+                         h_diabatic, phb,t_init,                          &
+                         mu, mut, muu, muv, mub,                          &
+                         al, alt, p, pb, php, cqu, cqv, cqw,              &
+                         u_base, v_base, t_base, qv_base, z_base,         &
+                         msfu, msfv, msft, f, e, sina, cosa,              &
+                         fnm, fnp, rdn, rdnw,                             &
+                         dt, rdx, rdy, khdif, kvdif, xkmhd,               &
+                         diff_6th_opt, diff_6th_factor,                   &
+                         dampcoef,zdamp,damp_opt,                         &
+                         cf1, cf2, cf3, cfn, cfn1, n_moist,               &
+                         non_hydrostatic,                                 &
+                         ids, ide, jds, jde, kds, kde,                    &
+                         ims, ime, jms, jme, kms, kme,                    &
+                         its, ite, jts, jte, kts, kte                    )
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type)    ,           INTENT(IN   ) :: config_flags
+
+   INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   LOGICAL ,               INTENT(IN   ) :: non_hydrostatic
+
+   INTEGER ,               INTENT(IN   ) :: n_moist, rk_step
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,              &
+                                        INTENT(IN   ) :: ru,      &
+                                                         rv,      &
+                                                         rw,      &
+                                                         ww,      & 
+                                                         u,       &
+                                                         v,       &
+                                                         w,       &
+                                                         t,       &
+                                                         ph,      &
+                                                         u_old,   &
+                                                         v_old,   &
+                                                         w_old,   &
+                                                         t_old,   &
+                                                         ph_old,  &
+                                                         phb,     &
+                                                         al,      &
+                                                         alt,     &
+                                                         p,       &
+                                                         pb,      &
+                                                         php,     &
+                                                         cqu,     &
+                                                         cqv,     &
+                                                         t_init,  &
+                                                         xkmhd,  &
+                                                         h_diabatic
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,              &
+                                        INTENT(OUT  ) :: ru_tend, &
+                                                         rv_tend, &
+                                                         rw_tend, &
+                                                         t_tend,  &
+                                                         ph_tend, &
+                                                         RTHFTEN, &
+                                                          u_save, &
+                                                          v_save, &
+                                                          w_save, &
+                                                         ph_save, &
+                                                          t_save
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,               &
+                                        INTENT(INOUT) :: ru_tendf, &
+                                                         rv_tendf, &
+                                                         rw_tendf, &
+                                                         t_tendf,  &
+                                                         ph_tendf, &
+                                                         cqw
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(  OUT) :: mu_tend, &
+                                                                    mu_save
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfu,    &
+                                                                    msfv,    &
+                                                                    msft,    &
+                                                                    f,       &
+                                                                    e,       &
+                                                                    sina,    &
+                                                                    cosa,    &
+                                                                    mu,      &
+                                                                    mut,     &
+                                                                    mub,     &
+                                                                    muu,     &
+                                                                    muv
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnm,     &
+                                                                  fnp,     &
+                                                                  rdn,     &
+                                                                  rdnw,    &
+                                                                  u_base,  &
+                                                                  v_base,  &
+                                                                  t_base,  &
+                                                                  qv_base, &
+                                                                  z_base
+
+   REAL ,                                      INTENT(IN   ) :: rdx,     &
+                                                                rdy,     &
+                                                                dt,      &
+                                                                khdif,   &
+                                                                kvdif
+   INTEGER, INTENT( IN ) :: diff_6th_opt
+   REAL,    INTENT( IN ) :: diff_6th_factor
+
+   INTEGER, INTENT( IN ) :: damp_opt
+
+   REAL, INTENT( IN ) :: zdamp, dampcoef
+
+   REAL    :: kdift, khdq, kvdq, cfn, cfn1, cf1, cf2, cf3
+   INTEGER :: i,j,k
+   INTEGER :: time_step
+
+!<DESCRIPTION>
+!
+!  rk_tendency computes the large-timestep tendency terms in the 
+!  momentum, thermodynamic (theta), and geopotential equations.  
+!  These terms include:
+!
+!  (1) advection (for u, v, w, theta - calls to advect_u, advect_v,
+!                 advect_w, and advact_scalar).
+!
+!  (2) geopotential equation terms (advection and "gw" - call to rhs_ph).
+!
+!  (3) buoyancy term in vertical momentum equation (call to pg_buoy_w).
+!
+!  (4) Coriolis and curvature terms in u,v,w momentum equations
+!      (calls to subroutines coriolis, curvature)
+!
+!  (5) 3D diffusion on coordinate surfaces.
+!
+!</DESCRIPTION>
+
+   CALL zero_tend ( ru_tend,                      &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( rv_tend,                      &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( rw_tend,                      &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( t_tend,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( ph_tend,                      &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( u_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( v_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( w_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( ph_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( t_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( mu_tend,                  &
+                    ids, ide, jds, jde, 1, 1, &
+                    ims, ime, jms, jme, 1, 1, &
+                    its, ite, jts, jte, 1, 1 )
+
+   CALL zero_tend ( mu_save,                  &
+                    ids, ide, jds, jde, 1, 1, &
+                    ims, ime, jms, jme, 1, 1, &
+                    its, ite, jts, jte, 1, 1 )
+
+     !  advection tendencies
+     CALL nl_get_time_step ( 1, time_step )
+
+     CALL advect_u ( u, u , ru_tend, ru, rv, ww,   &
+                     mut, time_step, config_flags, &
+                     msfu, msfv, msft,             &
+                     fnm, fnp, rdx, rdy, rdnw,     &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+
+     CALL advect_v ( v, v , rv_tend, ru, rv, ww,   &
+                     mut, time_step, config_flags, &
+                     msfu, msfv, msft,             &
+                     fnm, fnp, rdx, rdy, rdnw,     &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+
+     IF (non_hydrostatic)                          &
+     CALL advect_w ( w, w, rw_tend, ru, rv, ww,    &
+                     mut, time_step, config_flags, &
+                     msfu, msfv, msft,             &
+                     fnm, fnp, rdx, rdy, rdn,      &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+
+!  theta flux divergence
+
+     CALL advect_scalar ( t, t, t_tend, ru, rv, ww,     &
+                          mut, time_step, config_flags, &
+                          msfu, msfv, msft, fnm, fnp,   &
+                          rdx, rdy, rdnw,               &
+                          ids, ide, jds, jde, kds, kde, &
+                          ims, ime, jms, jme, kms, kme, &
+                          its, ite, jts, jte, kts, kte ) 
+
+     IF ( config_flags%cu_physics == GDSCHEME ) THEN
+
+     ! theta advection only:
+
+         CALL set_tend( RTHFTEN, t_tend, msft,           &
+                        ids, ide, jds, jde, kds, kde,    &
+                        ims, ime, jms, jme, kms, kme,    &
+                        its, ite, jts, jte, kts, kte     )
+
+     END IF
+
+     CALL rhs_ph( ph_tend, u, v, ww, ph, ph, phb, w, &
+                  mut, muu, muv,                     &
+                  fnm, fnp,                          &
+                  rdnw, cfn, cfn1, rdx, rdy, msft,   &
+                  non_hydrostatic,                   &
+                  config_flags,                      &
+                  ids, ide, jds, jde, kds, kde,      &
+                  ims, ime, jms, jme, kms, kme,      &
+                  its, ite, jts, jte, kts, kte      )
+
+  CALL horizontal_pressure_gradient( ru_tend,rv_tend,                &
+                                     ph,alt,p,pb,al,php,cqu,cqv,     &
+                                     muu,muv,mu,fnm,fnp,rdnw,        &
+                                     cf1,cf2,cf3,rdx,rdy,msft,       &
+                                     config_flags, non_hydrostatic,  &
+                                     ids, ide, jds, jde, kds, kde,   &
+                                     ims, ime, jms, jme, kms, kme,   &
+                                     its, ite, jts, jte, kts, kte   )
+
+  IF (non_hydrostatic)                            &
+  CALL pg_buoy_w( rw_tend, p, cqw, mu, mub,       &
+                  rdnw, rdn, g, msft,             &
+                  ids, ide, jds, jde, kds, kde,   &
+                  ims, ime, jms, jme, kms, kme,   &
+                  its, ite, jts, jte, kts, kte   )
+
+  CALL w_damp   ( rw_tend, ww, w, mut, rdnw, dt,    &
+                    config_flags%w_damping,         &
+                    ids, ide, jds, jde, kds, kde,   &
+                    ims, ime, jms, jme, kms, kme,   &
+                    its, ite, jts, jte, kts, kte   )
+
+  IF(config_flags%pert_coriolis) THEN
+
+    CALL perturbation_coriolis ( ru, rv, rw,                   &
+                                 ru_tend,  rv_tend,  rw_tend,  &
+                                 config_flags,                 &
+                                 u_base, v_base, z_base,       &
+                                 muu, muv, phb, ph,            &
+                                 f, e, sina, cosa, fnm, fnp,   &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte )
+  ELSE
+    CALL coriolis ( ru, rv, rw,                   &
+                    ru_tend,  rv_tend,  rw_tend,  &
+                    config_flags,                 &
+                    f, e, sina, cosa, fnm, fnp,   &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+  END IF
+
+  CALL curvature ( ru, rv, rw, u, v, w,            &
+                   ru_tend,  rv_tend,  rw_tend,    &
+                   config_flags,                   &
+                   msfu, msfv, fnm, fnp, rdx, rdy, &
+                   ids, ide, jds, jde, kds, kde,   &
+                   ims, ime, jms, jme, kms, kme,   &
+                   its, ite, jts, jte, kts, kte   )
+
+!**************************************************************
+!
+!  Next, the terms that we integrate only with forward-in-time
+!  (evaluate with time t variables).
+!
+!**************************************************************
+
+  forward_step: IF( rk_step == 1 ) THEN
+
+    diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
+   
+        CALL horizontal_diffusion ('u', u, ru_tendf, mut, config_flags, &
+                                        msfu, msfv, msft,               &
+                                        khdif, xkmhd, rdx, rdy,         &
+                                        ids, ide, jds, jde, kds, kde,   &
+                                        ims, ime, jms, jme, kms, kme,   &
+                                        its, ite, jts, jte, kts, kte   )
+
+        CALL horizontal_diffusion ('v', v, rv_tendf, mut, config_flags, &
+                                        msfu, msfv, msft,               &
+                                        khdif, xkmhd, rdx, rdy,         &
+                                        ids, ide, jds, jde, kds, kde,   &
+                                        ims, ime, jms, jme, kms, kme,   &
+                                        its, ite, jts, jte, kts, kte   )
+
+        CALL horizontal_diffusion ('w', w, rw_tendf, mut, config_flags, &
+                                        msfu, msfv, msft,               &
+                                        khdif, xkmhd, rdx, rdy,         &
+                                        ids, ide, jds, jde, kds, kde,   &
+                                        ims, ime, jms, jme, kms, kme,   &
+                                        its, ite, jts, jte, kts, kte   )
+
+        khdq = 3.*khdif
+        CALL horizontal_diffusion_3dmp ( 'm', t, t_tendf, mut,         &
+                                         config_flags, t_init,         &
+                                         msfu, msfv, msft,             &
+                                         khdq , xkmhd, rdx, rdy,       &
+                                         ids, ide, jds, jde, kds, kde, &
+                                         ims, ime, jms, jme, kms, kme, &
+                                         its, ite, jts, jte, kts, kte )
+
+
+!!!****MARS: vertical diffusion is done in the physics (TODO: consider the nonhydrostatic case ?)
+        pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) &
+                        .AND. (.not. config_flags%modif_wrf) ) THEN
+
+          CALL vertical_diffusion_u ( u, ru_tendf, config_flags,      &
+                                      u_base,                         &
+                                      alt, muu, rdn, rdnw, kvdif,     &
+                                      ids, ide, jds, jde, kds, kde,   &
+                                      ims, ime, jms, jme, kms, kme,   &
+                                      its, ite, jts, jte, kts, kte   )
+
+          CALL vertical_diffusion_v ( v, rv_tendf, config_flags,      &
+                                      v_base,                         &
+                                      alt, muv, rdn, rdnw, kvdif,     &
+                                      ids, ide, jds, jde, kds, kde,   &
+                                      ims, ime, jms, jme, kms, kme,   &
+                                      its, ite, jts, jte, kts, kte   )
+
+          IF (non_hydrostatic)                                           &
+          CALL vertical_diffusion ( 'w', w, rw_tendf, config_flags,      &
+                                    alt, mut, rdn, rdnw, kvdif,          &
+                                    ids, ide, jds, jde, kds, kde,        &
+                                    ims, ime, jms, jme, kms, kme,        &
+                                    its, ite, jts, jte, kts, kte        )
+
+          kvdq = 3.*kvdif
+          CALL vertical_diffusion_3dmp ( t, t_tendf, config_flags, t_init,     &
+                                         alt, mut, rdn, rdnw, kvdq ,           &
+                                         ids, ide, jds, jde, kds, kde,         &
+                                         ims, ime, jms, jme, kms, kme,         &
+                                         its, ite, jts, jte, kts, kte         )
+
+        ENDIF pbl_test
+
+   !  Theta tendency computations.
+
+    END IF diff_opt1
+
+    IF ( diff_6th_opt .NE. 0 ) THEN
+
+      CALL sixth_order_diffusion( 'u', u, ru_tendf, mut, dt,          &
+                                       config_flags,                  &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+      CALL sixth_order_diffusion( 'v', v, rv_tendf, mut, dt,          &
+                                       config_flags,                  &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+      IF (non_hydrostatic)                                            & 
+      CALL sixth_order_diffusion( 'w', w, rw_tendf, mut, dt,          &
+                                       config_flags,                  &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+      CALL sixth_order_diffusion( 'm', t,  t_tendf, mut, dt,          &
+                                       config_flags,                  &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+    ENDIF
+
+    IF( damp_opt .eq. 2 )                                      &
+       CALL rk_rayleigh_damp( ru_tendf, rv_tendf,              &
+                              rw_tendf, t_tendf,               &
+                              u, v, w, t, t_init,              &
+                              mut, muu, muv, ph, phb,          &
+                              u_base, v_base, t_base, z_base,  &
+                              dampcoef, zdamp,                 &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              its, ite, jts, jte, kts, kte   )
+
+  END IF forward_step
+
+END SUBROUTINE rk_tendency
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_addtend_dry ( ru_tend, rv_tend, rw_tend, ph_tend, t_tend,      &
+                            ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
+                            u_save, v_save, w_save, ph_save, t_save,         &
+                            mu_tend, mu_tendf, rk_step,                      &
+                            h_diabatic, mut, msft, msfu, msfv,               &
+                            ids,ide, jds,jde, kds,kde,                       &
+                            ims,ime, jms,jme, kms,kme,                       &
+                            ips,ipe, jps,jpe, kps,kpe,                       &
+                            its,ite, jts,jte, kts,kte                       )
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            ips, ipe, jps, jpe, kps, kpe, &
+                                            its, ite, jts, jte, kts, kte
+   INTEGER ,               INTENT(IN   ) :: rk_step
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) :: ru_tend, &
+                                                                      rv_tend, &
+                                                                      rw_tend, &
+                                                                      ph_tend, &
+                                                                      t_tend,  &
+                                                                      ru_tendf, &
+                                                                      rv_tendf, &
+                                                                      rw_tendf, &
+                                                                      ph_tendf, &
+                                                                      t_tendf
+
+   REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(INOUT) :: mu_tend, &
+                                                             mu_tendf
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(IN   ) ::  u_save,  &
+                                                                       v_save,  &
+                                                                       w_save,  &
+                                                                      ph_save,  &
+                                                                       t_save,  &
+                                                                      h_diabatic
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: mut, &
+                                                                    msft, &
+                                                                    msfu, &
+                                                                    msfv
+
+
+! Local
+   INTEGER :: i, j, k
+
+!<DESCRIPTION>
+!
+! rk_addtend_dry constructs the full large-timestep tendency terms for
+! momentum (u,v,w), theta and geopotential equations.   This is accomplished
+! by combining the physics tendencies (in *tendf; these are computed 
+! the first RK substep, held fixed thereafter) with the RK tendencies 
+! (in *tend, these include advection, pressure gradient, etc; 
+! these change each rk substep).  Output is in *tend.
+!
+!</DESCRIPTION>
+
+!  Finally, add the forward-step tendency to the rk_tendency
+
+! u/v/w/save contain bc tendency that needs to be multiplied by msf
+!  before adding it to physics tendency (*tendf)
+! For momentum we need the final tendency to include an inverse msf
+! physics/bc tendency needs to be divided, advection tendency already has it
+
+! For scalars we need the final tendency to include an inverse msf
+! advection tendency is OK, physics/bc tendency needs to be divided by msf
+
+   DO j = jts,MIN(jte,jde-1)
+   DO k = kts,kte-1
+   DO i = its,ite
+     ! multiply by m to uncouple u
+     IF(rk_step == 1)ru_tendf(i,k,j) = ru_tendf(i,k,j) +  u_save(i,k,j)*msfu(i,j)
+     ! divide by m to couple u
+     ru_tend(i,k,j) = ru_tend(i,k,j) + ru_tendf(i,k,j)/msfu(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = jts,jte
+   DO k = kts,kte-1
+   DO i = its,MIN(ite,ide-1)
+     ! multiply by m to uncouple v
+     IF(rk_step == 1)rv_tendf(i,k,j) = rv_tendf(i,k,j) +  v_save(i,k,j)*msfv(i,j)
+     ! divide by m to couple v
+     rv_tend(i,k,j) = rv_tend(i,k,j) + rv_tendf(i,k,j)/msfv(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = jts,MIN(jte,jde-1)
+   DO k = kts,kte
+   DO i = its,MIN(ite,ide-1)
+     ! multiply by m to uncouple w
+     IF(rk_step == 1)rw_tendf(i,k,j) = rw_tendf(i,k,j) +  w_save(i,k,j)*msft(i,j)
+     ! divide by m to couple w
+     rw_tend(i,k,j) = rw_tend(i,k,j) + rw_tendf(i,k,j)/msft(i,j)
+     IF(rk_step == 1)ph_tendf(i,k,j) = ph_tendf(i,k,j) +  ph_save(i,k,j)
+     ! divide by m to couple scalar
+     ph_tend(i,k,j) = ph_tend(i,k,j) + ph_tendf(i,k,j)/msft(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = jts,MIN(jte,jde-1)
+   DO k = kts,kte-1
+   DO i = its,MIN(ite,ide-1)
+     IF(rk_step == 1)t_tendf(i,k,j) = t_tendf(i,k,j) +  t_save(i,k,j)
+     ! divide by m to couple theta
+      t_tend(i,k,j) =  t_tend(i,k,j) +  t_tendf(i,k,j)/msft(i,j)  &
+                                     +  mut(i,j)*h_diabatic(i,k,j)/msft(i,j)
+     ! divide by m to couple heating
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = jts,MIN(jte,jde-1)
+   DO i = its,MIN(ite,ide-1)
+! mu tendencies not coupled with 1/msf
+      mu_tend(i,j) =  mu_tend(i,j) +  mu_tendf(i,j)
+   ENDDO
+   ENDDO
+
+END SUBROUTINE rk_addtend_dry
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_scalar_tend ( scs, sce, config_flags,       &
+                            rk_step, dt,                  &
+                            ru, rv, ww, mut, mub, mu_old, &
+                            alt,                          &
+                            scalar_old, scalar,           &
+                            scalar_tends, advect_tend,    &
+                            RQVFTEN,                      &
+                            base, moist_step, fnm, fnp,   &
+                            msfu, msfv, msft,             &
+                            rdx, rdy, rdn, rdnw,          &
+                            khdif, kvdif, xkmhd,          &
+                            diff_6th_opt, diff_6th_factor,&
+                            pd_advection,                 &
+                            ids, ide, jds, jde, kds, kde, &
+                            ims, ime, jms, jme, kms, kme, &
+                            its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,                INTENT(IN   ) :: rk_step, scs, sce
+   INTEGER ,                INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                             ims, ime, jms, jme, kms, kme, &
+                                             its, ite, jts, jte, kts, kte
+
+   LOGICAL , INTENT(IN   ) :: moist_step
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ),                &
+                                         INTENT(IN   )  :: scalar, scalar_old
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ),                      &
+                                         INTENT(INOUT)  :: scalar_tends
+                                                    
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(INOUT) :: advect_tend
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(OUT  ) :: RQVFTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(IN   ) ::     ru,  &
+                                                                      rv,  &
+                                                                      ww,  &
+                                                                      xkmhd,  &
+                                                                      alt
+
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnm,  &
+                                                                  fnp,  &
+                                                                  rdn,  &
+                                                                  rdnw, &
+                                                                  base
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,       INTENT(IN   ) :: msfu,    &
+                                                                  msfv,    &
+                                                                  msft,    &
+                                                                  mub,     &
+                                                                  mut,     &
+                                                                  mu_old
+
+   REAL ,                                        INTENT(IN   ) :: rdx,     &
+                                                                  rdy,     &
+                                                                  khdif,   &
+                                                                  kvdif
+
+   INTEGER, INTENT( IN ) :: diff_6th_opt
+   REAL,    INTENT( IN ) :: diff_6th_factor
+
+   REAL ,                                        INTENT(IN   ) :: dt
+
+   LOGICAL, INTENT(IN   ) :: pd_advection
+
+   ! Local data
+  
+   INTEGER :: im, i,j,k
+   INTEGER :: time_step
+
+   REAL    :: khdq, kvdq, tendency
+
+!<DESCRIPTION>
+!
+! rk_scalar_tend calls routines that computes scalar tendency from advection 
+! and 3D mixing (TKE or fixed eddy viscosities).
+!
+!</DESCRIPTION>
+
+
+   khdq = khdif/prandtl
+   kvdq = kvdif/prandtl
+
+   scalar_loop : DO im = scs, sce
+
+     CALL zero_tend ( advect_tend(ims,kms,jms),     &
+                      ids, ide, jds, jde, kds, kde, &
+                      ims, ime, jms, jme, kms, kme, &
+                      its, ite, jts, jte, kts, kte )
+
+     CALL nl_get_time_step ( 1, time_step )
+
+      IF( (rk_step == 3) .and. pd_advection ) THEN
+
+!        CALL advect_scalar_pd       ( scalar(ims,kms,jms,im),             &
+!                                      scalar_old(ims,kms,jms,im),         &
+!                                      advect_tend(ims,kms,jms),           &
+!                                      ru, rv, ww, mut, mub, mu_old,       &
+!                                      config_flags,                       &
+!                                      msfu, msfv, msft, fnm, fnp,         &
+!                                      rdx, rdy, rdnw,dt,                  &
+!                                      ids, ide, jds, jde, kds, kde,       &
+!                                      ims, ime, jms, jme, kms, kme,       &
+!                                      its, ite, jts, jte, kts, kte     )
+
+
+        CALL advect_scalar_mono       ( scalar(ims,kms,jms,im),             &
+                                        scalar_old(ims,kms,jms,im),         &
+                                        advect_tend(ims,kms,jms),           &
+                                        ru, rv, ww, mut, mub, mu_old,       &
+                                        config_flags,                       &
+                                        msfu, msfv, msft, fnm, fnp,         &
+                                        rdx, rdy, rdnw,dt,                  &
+                                        ids, ide, jds, jde, kds, kde,       &
+                                        ims, ime, jms, jme, kms, kme,       &
+                                        its, ite, jts, jte, kts, kte     )
+      ELSE
+
+        CALL advect_scalar     ( scalar(ims,kms,jms,im),        &
+                                 scalar(ims,kms,jms,im),        &
+                                 advect_tend(ims,kms,jms),      &
+                                 ru, rv, ww, mut, time_step,    &
+                                 config_flags,                  &
+                                 msfu, msfv, msft, fnm, fnp,    &
+                                 rdx, rdy, rdnw,                &
+                                 ids, ide, jds, jde, kds, kde,  &
+                                 ims, ime, jms, jme, kms, kme,  &
+                                 its, ite, jts, jte, kts, kte  )
+      END IF
+
+     IF( config_flags%cu_physics == GDSCHEME .and. moist_step .and. ( im == P_QV) ) THEN
+
+        CALL set_tend( RQVFTEN, advect_tend, msft,     &
+                       ids, ide, jds, jde, kds, kde,   &
+                       ims, ime, jms, jme, kms, kme,   &
+                       its, ite, jts, jte, kts, kte      )
+     ENDIF
+
+     rk_step_1: IF( rk_step == 1 ) THEN
+
+       diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
+
+       CALL horizontal_diffusion ( 'm', scalar(ims,kms,jms,im),            &
+                                        scalar_tends(ims,kms,jms,im), mut, &
+                                        config_flags,                      &
+                                        msfu, msfv, msft,                  & 
+                                        khdq , xkmhd, rdx, rdy,            &
+                                        ids, ide, jds, jde, kds, kde,      &
+                                        ims, ime, jms, jme, kms, kme,      &
+                                        its, ite, jts, jte, kts, kte      )
+
+!!!****MARS: done in the physics 
+       pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) &
+                       .AND. (.not. config_flags%modif_wrf) ) THEN
+
+         IF( (moist_step) .and. ( im == P_QV)) THEN
+
+            CALL vertical_diffusion_mp ( scalar(ims,kms,jms,im),       &
+                                         scalar_tends(ims,kms,jms,im), &
+                                         config_flags, base,           &
+                                         alt, mut, rdn, rdnw, kvdq ,   &
+                                         ids, ide, jds, jde, kds, kde, &
+                                         ims, ime, jms, jme, kms, kme, &
+                                         its, ite, jts, jte, kts, kte )
+
+         ELSE 
+
+            CALL vertical_diffusion (  'm', scalar(ims,kms,jms,im),       &
+                                            scalar_tends(ims,kms,jms,im), &
+                                            config_flags,                 &
+                                            alt, mut, rdn, rdnw, kvdq,    &
+                                            ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte )
+
+         END IF
+
+      ENDIF pbl_test
+
+    ENDIF diff_opt1
+
+    IF ( diff_6th_opt .NE. 0 )                                        &
+      CALL sixth_order_diffusion( 'm', scalar(ims,kms,jms,im),        &
+                                       scalar_tends(ims,kms,jms,im),  &
+                                       mut, dt, config_flags,         &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+  ENDIF rk_step_1
+
+ END DO scalar_loop
+
+END SUBROUTINE rk_scalar_tend
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_update_scalar( scs, sce,                      &
+                             scalar_1, scalar_2, sc_tend,   &
+                             advect_tend, msft,             &
+                             mu_old, mu_new, mu_base,       &
+                             rk_step, dt, spec_zone,        &
+                             config_flags,                  &
+                             ids, ide, jds, jde, kds, kde,  &
+                             ims, ime, jms, jme, kms, kme,  &
+                             its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,                INTENT(IN   ) :: scs, sce, rk_step, spec_zone
+   INTEGER ,                INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                             ims, ime, jms, jme, kms, kme, &
+                                             its, ite, jts, jte, kts, kte
+
+   REAL,                    INTENT(IN   ) :: dt
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
+         INTENT(INOUT)                                  :: scalar_1,    &
+                                                           scalar_2
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
+         INTENT(IN)                                     :: sc_tend
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme ),                &
+         INTENT(IN)                                  :: advect_tend
+
+   REAL, DIMENSION(ims:ime, jms:jme  ), INTENT(IN   ) ::  mu_old,  &
+                                                          mu_new,  &
+                                                          mu_base, &
+                                                          msft
+
+   INTEGER :: i,j,k,im
+   REAL    :: sc_middle, msfsq
+   REAL, DIMENSION(its:ite) :: muold, r_munew
+
+   REAL, DIMENSION(its:ite, kts:kte, jts:jte  ) :: tendency
+
+   INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
+   INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
+
+!<DESCRIPTION>
+!
+!  rk_scalar_update advances the scalar equation given the time t value
+!  of the scalar and the scalar tendency.  
+!
+!</DESCRIPTION>
+
+
+!
+!  set loop limits.
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = jte
+      k_start = kts
+      k_end   = kte-1
+      IF(j_end == jde) j_end = j_end - 1
+      IF(i_end == ide) i_end = i_end - 1
+
+      i_start_spc = i_start
+      i_end_spc   = i_end
+      j_start_spc = j_start
+      j_end_spc   = j_end
+      k_start_spc = k_start
+      k_end_spc   = k_end
+
+    IF( config_flags%nested .or. config_flags%specified ) THEN
+      IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
+      IF( .NOT. config_flags%periodic_x)i_end   = min( ite,ide-spec_zone-1 )
+      j_start = max( jts,jds+spec_zone )
+      j_end   = min( jte,jde-spec_zone-1 )
+      k_start = kts
+      k_end   = min( kte, kde-1 )
+    ENDIF
+
+    IF ( rk_step == 1 ) THEN
+
+      !  replace t-dt values (in scalar_1) with t values scalar_2,
+      !  then compute new values by adding tendency to values at t
+
+      DO  im = scs,sce
+
+       DO  j = jts, min(jte,jde-1)
+       DO  k = kts, min(kte,kde-1)
+       DO  i = its, min(ite,ide-1)
+           tendency(i,k,j) = 0.
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start,j_end
+       DO  k = k_start,k_end
+       DO  i = i_start,i_end
+          ! scalar was coupled with m
+           tendency(i,k,j) = advect_tend(i,k,j) * msft(i,j)
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start_spc,j_end_spc
+       DO  k = k_start_spc,k_end_spc
+       DO  i = i_start_spc,i_end_spc
+           tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
+       ENDDO
+       ENDDO
+       ENDDO
+   
+      DO  j = jts, min(jte,jde-1)
+
+      DO  i = its, min(ite,ide-1)
+        muold(i) = mu_old(i,j) + mu_base(i,j)
+        r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
+      ENDDO
+
+      DO  k = kts, min(kte,kde-1)
+      DO  i = its, min(ite,ide-1)
+
+        scalar_1(i,k,j,im) = scalar_2(i,k,j,im)
+        scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im)   &
+                             + dt*tendency(i,k,j))*r_munew(i)
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+      ENDDO
+
+    ELSE
+
+      !  just compute new values, scalar_1 already at time t.
+
+      DO  im = scs, sce
+
+       DO  j = jts, min(jte,jde-1)
+       DO  k = kts, min(kte,kde-1)
+       DO  i = its, min(ite,ide-1)
+           tendency(i,k,j) = 0.
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start,j_end
+       DO  k = k_start,k_end
+       DO  i = i_start,i_end
+           ! scalar was coupled with m
+           tendency(i,k,j) = advect_tend(i,k,j) * msft(i,j)
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start_spc,j_end_spc
+       DO  k = k_start_spc,k_end_spc
+       DO  i = i_start_spc,i_end_spc
+           tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
+       ENDDO
+       ENDDO
+       ENDDO
+
+      DO  j = jts, min(jte,jde-1)
+
+      DO  i = its, min(ite,ide-1)
+        muold(i) = mu_old(i,j) + mu_base(i,j)
+        r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
+      ENDDO
+
+      DO  k = kts, min(kte,kde-1)
+      DO  i = its, min(ite,ide-1)
+
+        scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im)   &
+                             + dt*tendency(i,k,j))*r_munew(i)
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+      ENDDO
+
+    END IF
+
+END SUBROUTINE rk_update_scalar
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_update_scalar_pd( scs, sce,                      &
+                                scalar, sc_tend,               &
+                                mu_old, mu_new, mu_base,       &
+                                rk_step, dt, spec_zone,        &
+                                config_flags,                  &
+                                ids, ide, jds, jde, kds, kde,  &
+                                ims, ime, jms, jme, kms, kme,  &
+                                its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,                INTENT(IN   ) :: scs, sce, rk_step, spec_zone
+   INTEGER ,                INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                             ims, ime, jms, jme, kms, kme, &
+                                             its, ite, jts, jte, kts, kte
+
+   REAL,                    INTENT(IN   ) :: dt
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
+         INTENT(INOUT)                                  :: scalar,      &
+                                                           sc_tend
+
+   REAL, DIMENSION(ims:ime, jms:jme  ), INTENT(IN   ) ::  mu_old,  &
+                                                          mu_new,  &
+                                                          mu_base
+
+   INTEGER :: i,j,k,im
+   REAL    :: sc_middle, msfsq
+   REAL, DIMENSION(its:ite) :: muold, r_munew
+
+   REAL, DIMENSION(its:ite, kts:kte, jts:jte  ) :: tendency
+
+   INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
+   INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
+
+!<DESCRIPTION>
+!
+!  rk_scalar_update advances the scalar equation given the time t value
+!  of the scalar and the scalar tendency.  
+!
+!</DESCRIPTION>
+
+
+!
+!  set loop limits.
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = jte
+      k_start = kts
+      k_end   = kte-1
+      IF(j_end == jde) j_end = j_end - 1
+      IF(i_end == ide) i_end = i_end - 1
+
+      i_start_spc = i_start
+      i_end_spc   = i_end
+      j_start_spc = j_start
+      j_end_spc   = j_end
+      k_start_spc = k_start
+      k_end_spc   = k_end
+
+    IF( config_flags%nested .or. config_flags%specified ) THEN
+      IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
+      IF( .NOT. config_flags%periodic_x)i_end   = min( ite,ide-spec_zone-1 )
+      j_start = max( jts,jds+spec_zone )
+      j_end   = min( jte,jde-spec_zone-1 )
+      k_start = kts
+      k_end   = min( kte, kde-1 )
+    ENDIF
+
+      DO  im = scs, sce
+
+       DO  j = jts, min(jte,jde-1)
+       DO  k = kts, min(kte,kde-1)
+       DO  i = its, min(ite,ide-1)
+           tendency(i,k,j) = 0.
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start_spc,j_end_spc
+       DO  k = k_start_spc,k_end_spc
+       DO  i = i_start_spc,i_end_spc
+           tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
+           sc_tend(i,k,j,im) = 0.
+       ENDDO
+       ENDDO
+       ENDDO
+
+      DO  j = jts, min(jte,jde-1)
+
+      DO  i = its, min(ite,ide-1)
+        muold(i) = mu_old(i,j) + mu_base(i,j)
+        r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
+      ENDDO
+
+      DO  k = kts, min(kte,kde-1)
+      DO  i = its, min(ite,ide-1)
+
+        scalar(i,k,j,im) = (muold(i)*scalar(i,k,j,im)   &
+                             + dt*tendency(i,k,j))*r_munew(i)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      ENDDO
+
+END SUBROUTINE rk_update_scalar_pd
+
+!------------------------------------------------------------
+
+SUBROUTINE init_zero_tendency(ru_tendf, rv_tendf, rw_tendf, ph_tendf,  &
+                              t_tendf,  tke_tendf, mu_tendf,           &
+                              moist_tendf,chem_tendf,scalar_tendf,     &
+                              n_moist,n_chem,n_scalar,rk_step,         &
+                              ids, ide, jds, jde, kds, kde,            &
+                              ims, ime, jms, jme, kms, kme,            &
+                              its, ite, jts, jte, kts, kte             )
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+
+   INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte
+
+   INTEGER ,       INTENT(IN   ) :: n_moist,n_chem,n_scalar,rk_step
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) ::  &
+                                                             ru_tendf, &
+                                                             rv_tendf, &
+                                                             rw_tendf, &
+                                                             ph_tendf, &
+                                                              t_tendf, &
+                                                            tke_tendf
+
+   REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(INOUT) ::  mu_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),INTENT(INOUT)::&
+                                                          moist_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_chem ),INTENT(INOUT)::&
+                                                          chem_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar ),INTENT(INOUT)::&
+                                                          scalar_tendf
+
+! LOCAL VARS
+
+   INTEGER :: im, ic, is
+
+!<DESCRIPTION>
+!
+! init_zero_tendency 
+! sets tendency arrays to zero for all prognostic variables.
+!
+!</DESCRIPTION>
+
+
+   CALL zero_tend ( ru_tendf,                        &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( rv_tendf,                        &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( rw_tendf,                        &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( ph_tendf,                        &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( t_tendf,                         &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( tke_tendf,                       &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( mu_tendf,                        &
+                    ids, ide, jds, jde, kds, kds,    &
+                    ims, ime, jms, jme, kms, kms,    &
+                    its, ite, jts, jte, kts, kts     )
+
+!   DO im=PARAM_FIRST_SCALAR,n_moist
+   DO im=1,n_moist                      ! make sure first one is zero too
+      CALL zero_tend ( moist_tendf(ims,kms,jms,im),  &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte  )
+   ENDDO
+
+!   DO ic=PARAM_FIRST_SCALAR,n_chem
+   DO ic=1,n_chem                       ! make sure first one is zero too
+      CALL zero_tend ( chem_tendf(ims,kms,jms,ic),   &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte  )
+   ENDDO
+
+!   DO ic=PARAM_FIRST_SCALAR,n_scalar
+   DO ic=1,n_scalar                       ! make sure first one is zero too
+      CALL zero_tend ( scalar_tendf(ims,kms,jms,ic),   &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte  )
+   ENDDO
+
+END SUBROUTINE init_zero_tendency
+
+!===================================================================
+
+
+SUBROUTINE dump_data( a, field, io_unit,            &
+                      ims, ime, jms, jme, kms, kme, &
+                      ids, ide, jds, jde, kds, kde )
+implicit none
+integer ::  ims, ime, jms, jme, kms, kme, &
+            ids, ide, jds, jde, kds, kde 
+real, dimension(ims:ime, kms:kme, jds:jde) :: a
+character :: field
+integer :: io_unit
+
+integer :: is,ie,js,je,ks,ke
+
+!<DESCRIPTION
+!
+! quick and dirty debug io utility
+!
+!</DESCRIPTION
+
+is = ids
+ie = ide-1
+js = jds
+je = jde-1
+ks = kds
+ke = kde-1
+
+if(field == 'u') ie = ide
+if(field == 'v') je = jde
+if(field == 'w') ke = kde
+
+write(io_unit) is,ie,ks,ke,js,je
+write(io_unit) a(is:ie, ks:ke, js:je)
+
+end subroutine dump_data
+
+!-----------------------------------------------------------------------
+
+SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d,           &
+                     RTHRATEN,                                         &
+                     RUBLTEN,RVBLTEN,RTHBLTEN,                         &
+                     RQVBLTEN,RQCBLTEN,RQIBLTEN,                       &
+                     RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,              &
+                     RQICUTEN,RQSCUTEN,                                &
+                     RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,        &
+                     RMUNDGDTEN,                                       &
+                     ids,ide, jds,jde, kds,kde,                        &
+                     ims,ime, jms,jme, kms,kme,                        &
+                     its,ite, jts,jte, kts,kte                         )
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      TYPE(grid_config_rec_type), INTENT(IN)     ::      config_flags
+
+      INTEGER,  INTENT(IN   )   ::          ids,ide, jds,jde, kds,kde, &
+                                            ims,ime, jms,jme, kms,kme, &
+                                            its,ite, jts,jte, kts,kte
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )               , &
+                INTENT(IN   )   ::                               pi3d
+                                                                 
+      REAL,     DIMENSION( ims:ime, jms:jme )                        , &
+                INTENT(IN   )   ::                                 mu, &
+                                                                  muu, &
+                                                                  muv
+      
+                                                           
+! radiation
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme ),                &
+                INTENT(INOUT)   ::                           RTHRATEN
+
+! cumulus
+
+      REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ),              &
+                INTENT(INOUT)   ::                                     &
+                                                             RTHCUTEN, &
+                                                             RQVCUTEN, &
+                                                             RQCCUTEN, &
+                                                             RQRCUTEN, &
+                                                             RQICUTEN, &
+                                                             RQSCUTEN
+! pbl
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )               , &
+                INTENT(INOUT)   ::                            RUBLTEN, &
+                                                              RVBLTEN, &
+                                                             RTHBLTEN, &
+                                                             RQVBLTEN, &
+                                                             RQCBLTEN, &
+                                                             RQIBLTEN
+
+! fdda
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )               , &
+                INTENT(INOUT)   ::                            RUNDGDTEN, &
+                                                              RVNDGDTEN, &
+                                                             RTHNDGDTEN, &
+                                                             RQVNDGDTEN
+      REAL,     DIMENSION( ims:ime, jms:jme )               , &
+                INTENT(INOUT)   ::                           RMUNDGDTEN
+
+      INTEGER :: i,k,j
+      INTEGER :: itf,ktf,jtf,itsu,jtsv
+
+!-----------------------------------------------------------------------
+
+!<DESCRIPTION>
+!
+!  calculate_phy_tend couples the physics tendencies to the column mass (mu),
+!  because prognostic equations are in flux form, but physics tendencies are
+!  computed for uncoupled variables.
+!
+!</DESCRIPTION>
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+      itsu=MAX(its,ids+1)
+      jtsv=MAX(jts,jds+1)
+
+! radiation
+
+   IF (config_flags%ra_lw_physics .gt. 0 .or. config_flags%ra_sw_physics .gt. 0) THEN
+
+      DO J=jts,jtf
+      DO K=kts,ktf
+      DO I=its,itf
+         RTHRATEN(I,K,J)=mu(I,J)*RTHRATEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ENDIF
+
+! cumulus
+
+   IF (config_flags%cu_physics .gt. 0) THEN
+
+      DO J=jts,jtf
+      DO I=its,itf
+      DO K=kts,ktf
+         RTHCUTEN(I,K,J)=mu(I,J)*RTHCUTEN(I,K,J)
+         RQVCUTEN(I,K,J)=mu(I,J)*RQVCUTEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=jts,jtf
+         DO I=its,itf
+         DO K=kts,ktf
+            RQCCUTEN(I,K,J)=mu(I,J)*RQCCUTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=jts,jtf
+         DO I=its,itf
+         DO K=kts,ktf
+            RQRCUTEN(I,K,J)=mu(I,J)*RQRCUTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=jts,jtf
+         DO I=its,itf
+         DO K=kts,ktf
+            RQICUTEN(I,K,J)=mu(I,J)*RQICUTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=jts,jtf
+         DO I=its,itf
+         DO K=kts,ktf
+            RQSCUTEN(I,K,J)=mu(I,J)*RQSCUTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+   ENDIF
+
+! pbl
+!!****MARS
+   IF ( (config_flags%bl_pbl_physics .gt. 0) .OR. (config_flags%modif_wrf) ) THEN
+
+      DO J=jts,jtf
+      DO K=kts,ktf
+      DO I=its,itf
+         RUBLTEN(I,K,J) =mu(I,J)*RUBLTEN(I,K,J)
+         RVBLTEN(I,K,J) =mu(I,J)*RVBLTEN(I,K,J)
+         RTHBLTEN(I,K,J)=mu(I,J)*RTHBLTEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=jts,jtf
+         DO K=kts,ktf
+         DO I=its,itf
+            RQVBLTEN(I,K,J)=mu(I,J)*RQVBLTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QC .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=jts,jtf
+         DO K=kts,ktf
+         DO I=its,itf
+           RQCBLTEN(I,K,J)=mu(I,J)*RQCBLTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=jts,jtf
+         DO K=kts,ktf
+         DO I=its,itf
+            RQIBLTEN(I,K,J)=mu(I,J)*RQIBLTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+    ENDIF
+
+! fdda
+! note fdda u and v tendencies are staggered, also only interior points have muu/muv,
+!   so only couple those
+
+   IF (config_flags%grid_fdda .gt. 0) THEN
+
+      DO J=jts,jtf
+      DO K=kts,ktf
+      DO I=itsu,itf
+!     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
+!     write(*,'(a,3i6,e15.5)') 'u_ten before=',i,k,j, RUNDGDTEN(i,k,j)
+         RUNDGDTEN(I,K,J) =muu(I,J)*RUNDGDTEN(I,K,J)
+!        if( i == itf/2 .AND. j == jtf/2 .AND. k==ktf/2 ) &
+!          write(*,'(a,2f15.5)') 'mu, muu=',mu(i,j), muu(i,j)
+!     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
+!     write(*,'(a,3i6,e15.5)') 'u_ten after=',i,k,j, RUNDGDTEN(i,k,j)
+!     if( RUNDGDTEN(i,k,j) > 30.0 ) write(*,*) 'IKJ=',i,k,j
+      ENDDO
+      ENDDO
+      ENDDO
+!     write(*,'(a,e15.5)') 'u_ten MAXIMUM after=', maxval(RUNDGDTEN)
+      DO J=jtsv,jtf
+      DO K=kts,ktf
+      DO I=its,itf
+         RVNDGDTEN(I,K,J) =muv(I,J)*RVNDGDTEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+      DO J=jts,jtf
+      DO K=kts,ktf
+      DO I=its,itf
+!     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
+!     write(*,'(a,3i6,e15.5)') 'th before=',i,k,j, RTHNDGDTEN(I,K,J)
+         RTHNDGDTEN(I,K,J)=mu(I,J)*RTHNDGDTEN(I,K,J)
+!        RMUNDGDTEN(I,J) - no coupling
+!     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
+!     write(*,'(a,3i6,e15.5)') 'th after=',i,k,j, RTHNDGDTEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=jts,jtf
+         DO K=kts,ktf
+         DO I=its,itf
+            RQVNDGDTEN(I,K,J)=mu(I,J)*RQVNDGDTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+    ENDIF
+
+END SUBROUTINE calculate_phy_tend
+
+!-----------------------------------------------------------------------
+
+SUBROUTINE positive_definite_filter ( a,                          &
+                                      ids,ide, jds,jde, kds,kde,  &
+                                      ims,ime, jms,jme, kms,kme,  &
+                                      its,ite, jts,jte, kts,kte  )
+
+  IMPLICIT NONE
+
+  INTEGER,  INTENT(IN   )   ::          ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme  ), INTENT(INOUT) :: a
+
+  INTEGER :: i,k,j
+
+!<DESCRIPTION>
+!
+! debug and testing code for bounding a variable
+!
+!</DESCRIPTION>
+
+  DO j=jts,min(jte,jde-1)
+  DO k=kts,kte-1
+  DO i=its,min(ite,ide-1)
+!    a(i,k,j) = max(a(i,k,j),0.)
+    a(i,k,j) = min(1000.,max(a(i,k,j),0.))
+  ENDDO
+  ENDDO
+  ENDDO
+
+  END SUBROUTINE positive_definite_filter
+
+!-----------------------------------------------------------------------
+
+SUBROUTINE bound_tke ( tke, tke_upper_bound,       &
+                       ids,ide, jds,jde, kds,kde,  &
+                       ims,ime, jms,jme, kms,kme,  &
+                       its,ite, jts,jte, kts,kte  )
+
+  IMPLICIT NONE
+
+  INTEGER,  INTENT(IN   )   ::          ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme  ), INTENT(INOUT) :: tke
+  REAL, INTENT(   IN) :: tke_upper_bound
+
+  INTEGER :: i,k,j
+
+!<DESCRIPTION>
+!
+! bounds tke between zero and tke_upper_bound.
+!
+!</DESCRIPTION>
+
+  DO j=jts,min(jte,jde-1)
+  DO k=kts,kte-1
+  DO i=its,min(ite,ide-1)
+    tke(i,k,j) = min(tke_upper_bound,max(tke(i,k,j),0.))
+  ENDDO
+  ENDDO
+  ENDDO
+
+  END SUBROUTINE bound_tke
+
+
+
+END MODULE module_em
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_init_utilities.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_init_utilities.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_init_utilities.F	(revision 2744)
@@ -0,0 +1,272 @@
+MODULE module_init_utilities
+
+CONTAINS
+
+ real function interp_0( v_in,  &
+                         z_in, z_out, nz_in  )
+ implicit none
+ integer nz_in, nz_out
+ real    v_in(nz_in), z_in(nz_in)
+ real    z_out
+
+ integer kp, k, im, ip
+ logical interp, increasing_z 
+ real    height, w1, w2
+ logical debug
+ parameter ( debug = .false. )
+
+! does vertical coordinate increase or decrease with increasing k?
+! set offset appropriately
+
+ height = z_out
+
+ if(debug) write(6,*) ' height in interp_0 ',height
+
+ if (z_in(nz_in) .gt. z_in(1)) then
+
+    if(debug) write(6,*) ' monotonic increase in z in interp_0 '
+    IF (height > z_in(nz_in)) then
+      if(debug) write(6,*) ' point 1 in interp_0 '
+      w2 = (z_in(nz_in)-height)/(z_in(nz_in)-z_in(nz_in-1))
+      w1 = 1.-w2
+      interp_0 = w1*v_in(nz_in) + w2*v_in(nz_in-1)
+    ELSE IF (height < z_in(1)) then
+      if(debug) write(6,*) ' point 2 in interp_0 '
+      w2 = (z_in(2)-height)/(z_in(2)-z_in(1))
+      w1 = 1.-w2
+      interp_0 = w1*v_in(2) + w2*v_in(1)
+    ELSE
+      if(debug) write(6,*) ' point 3 in interp_0 '
+      interp = .false.
+      kp = nz_in
+      DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) )
+        IF(   ((z_in(kp)   .ge. height) .and.     &
+               (z_in(kp-1) .le. height))        )   THEN
+          w2 = (height-z_in(kp))/(z_in(kp-1)-z_in(kp))
+          w1 = 1.-w2
+          interp_0 = w1*v_in(kp) + w2*v_in(kp-1)
+          if(debug) write(6,*) ' interp data, kp, w1, w2 ',kp, w1, w2
+          if(debug) write(6,*) ' interp data, v_in(kp), v_in(kp-1), interp_0 ', &
+                     v_in(kp), v_in(kp-1), interp_0
+          interp = .true.
+        END IF
+        kp = kp-1
+      ENDDO
+    ENDIF
+
+ else
+
+    if(debug) write(6,*) ' monotonic decrease in z in interp_0 '
+
+    IF (height < z_in(nz_in)) then
+      if(debug) write(6,*) ' point 1 in interp_0 '
+      w2 = (z_in(nz_in)-height)/(z_in(nz_in)-z_in(nz_in-1))
+      w1 = 1.-w2
+      interp_0 = w1*v_in(nz_in) + w2*v_in(nz_in-1)
+    ELSE IF (height > z_in(1)) then
+      if(debug) write(6,*) ' point 2 in interp_0 '
+      w2 = (z_in(2)-height)/(z_in(2)-z_in(1))
+      w1 = 1.-w2
+      interp_0 = w1*v_in(2) + w2*v_in(1)
+    ELSE
+      if(debug) write(6,*) ' point 3 in interp_0 '
+      interp = .false.
+      kp = nz_in
+      height = z_out
+      DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) )
+        IF(   ((z_in(kp)   .le. height) .and.     &
+               (z_in(kp-1) .ge. height))             )   THEN
+          w2 = (height-z_in(kp))/(z_in(kp-1)-z_in(kp))
+          w1 = 1.-w2
+          interp_0 = w1*v_in(kp) + w2*v_in(kp-1)
+          interp = .true.
+        END IF
+        kp = kp-1
+      ENDDO
+    ENDIF
+
+ end if
+
+ return
+ END FUNCTION interp_0
+
+ real function interp_0_log( v_in,  &
+                         p_in, p_out, nz_in  )
+ implicit none
+ integer nz_in, nz_out
+ real    v_in(nz_in), p_in(nz_in)
+ real    p_out
+
+ integer kp, k, im, ip
+ logical interp, increasing_z 
+ real    height, w1, w2
+ logical debug
+ parameter ( debug = .false. )
+
+! does vertical coordinate increase or decrease with increasing k?
+! set offset appropriately
+
+ height = p_out
+
+ if(debug) write(6,*) ' height in interp_0 ',height
+
+ if (p_in(nz_in) .gt. p_in(1)) then
+
+    if(debug) write(6,*) ' monotonic increase in z in interp_0 '
+    IF (height > p_in(nz_in)) then
+      if(debug) write(6,*) ' point 1 in interp_0 '
+      w2 = log(p_in(nz_in)/height)/log(p_in(nz_in)/p_in(nz_in-1))
+      w1 = 1.-w2
+      interp_0_log = w1*v_in(nz_in) + w2*v_in(nz_in-1)
+    ELSE IF (height < p_in(1)) then
+      if(debug) write(6,*) ' point 2 in interp_0 '
+      w2 = log(p_in(2)/height)/log(p_in(2)/p_in(1))
+      w1 = 1.-w2
+      interp_0_log = w1*v_in(2) + w2*v_in(1)
+    ELSE
+      if(debug) write(6,*) ' point 3 in interp_0 '
+      interp = .false.
+      kp = nz_in
+      DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) )
+        IF(   ((p_in(kp)   .ge. height) .and.     &
+               (p_in(kp-1) .le. height))        )   THEN
+          w2 = log(height/p_in(kp))/log(p_in(kp-1)/p_in(kp))
+          w1 = 1.-w2
+          interp_0_log = w1*v_in(kp) + w2*v_in(kp-1)
+          if(debug) write(6,*) ' interp data, kp, w1, w2 ',kp, w1, w2
+          if(debug) write(6,*) ' interp data, v_in(kp), v_in(kp-1), interp_0_p ', &
+                     v_in(kp), v_in(kp-1), interp_0_log
+          interp = .true.
+        END IF
+        kp = kp-1
+      ENDDO
+    ENDIF
+
+ else
+
+    if(debug) write(6,*) ' monotonic decrease in z in interp_0 '
+
+    IF (height < p_in(nz_in)) then
+      if(debug) write(6,*) ' point 1 in interp_0 '
+      w2 = log(p_in(nz_in)/height)/log(p_in(nz_in)/p_in(nz_in-1))
+      w1 = 1.-w2
+      interp_0_log = w1*v_in(nz_in) + w2*v_in(nz_in-1)
+    ELSE IF (height > p_in(1)) then
+      if(debug) write(6,*) ' point 2 in interp_0 '
+      w2 = log(p_in(2)/height)/log(p_in(2)/p_in(1))
+      w1 = 1.-w2
+      interp_0_log = w1*v_in(2) + w2*v_in(1)
+    ELSE
+      if(debug) write(6,*) ' point 3 in interp_0 '
+      interp = .false.
+      kp = nz_in
+      height = p_out
+      DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) )
+        IF(   ((p_in(kp)   .le. height) .and.     &
+               (p_in(kp-1) .ge. height))             )   THEN
+          w2 = log(height/p_in(kp))/log(p_in(kp-1)/p_in(kp))
+          w1 = 1.-w2
+          interp_0_log = w1*v_in(kp) + w2*v_in(kp-1)
+          interp = .true.
+        END IF
+        kp = kp-1
+      ENDDO
+    ENDIF
+
+ end if
+
+ return
+ END FUNCTION interp_0_log
+
+ real function interp_0_log2( v_in,  &
+                         p_in, p_out, nz_in  )
+ implicit none
+ integer nz_in, nz_out
+ real*8  v_in(nz_in)
+ real*8  p_in(nz_in)
+ real*8  p_out
+
+ integer kp, k, im, ip
+ logical interp, increasing_z 
+ real    height, w1, w2
+ logical debug
+ parameter ( debug = .false. )
+
+! does vertical coordinate increase or decrease with increasing k?
+! set offset appropriately
+
+ height = p_out
+
+ if(debug) write(6,*) ' height in interp_0 ',height
+
+ if (p_in(nz_in) .gt. p_in(1)) then
+
+    if(debug) write(6,*) ' monotonic increase in z in interp_0 '
+    IF (height > p_in(nz_in)) then
+      if(debug) write(6,*) ' point 1 in interp_0 '
+      w2 = log(p_in(nz_in)/height)/log(p_in(nz_in)/p_in(nz_in-1))
+      w1 = 1.-w2
+      interp_0_log2 = w1*v_in(nz_in) + w2*v_in(nz_in-1)
+    ELSE IF (height < p_in(1)) then
+      if(debug) write(6,*) ' point 2 in interp_0 '
+      w2 = log(p_in(2)/height)/log(p_in(2)/p_in(1))
+      w1 = 1.-w2
+      interp_0_log2 = w1*v_in(2) + w2*v_in(1)
+    ELSE
+      if(debug) write(6,*) ' point 3 in interp_0 '
+      interp = .false.
+      kp = nz_in
+      DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) )
+        IF(   ((p_in(kp)   .ge. height) .and.     &
+               (p_in(kp-1) .le. height))        )   THEN
+          w2 = log(height/p_in(kp))/log(p_in(kp-1)/p_in(kp))
+          w1 = 1.-w2
+          interp_0_log2 = w1*v_in(kp) + w2*v_in(kp-1)
+          if(debug) write(6,*) ' interp data, kp, w1, w2 ',kp, w1, w2
+          if(debug) write(6,*) ' interp data, v_in(kp), v_in(kp-1), interp_0_p', &
+                     v_in(kp), v_in(kp-1), interp_0_log2
+          interp = .true.
+        END IF
+        kp = kp-1
+      ENDDO
+    ENDIF
+
+ else
+
+    if(debug) write(6,*) ' monotonic decrease in z in interp_0 '
+
+    IF (height < p_in(nz_in)) then
+      if(debug) write(6,*) ' point 1 in interp_0 '
+      w2 = log(p_in(nz_in)/height)/log(p_in(nz_in)/p_in(nz_in-1))
+      w1 = 1.-w2
+      interp_0_log2 = w1*v_in(nz_in) + w2*v_in(nz_in-1)
+    ELSE IF (height > p_in(1)) then
+      if(debug) write(6,*) ' point 2 in interp_0 '
+      w2 = log(p_in(2)/height)/log(p_in(2)/p_in(1))
+      w1 = 1.-w2
+      interp_0_log2 = w1*v_in(2) + w2*v_in(1)
+    ELSE
+      if(debug) write(6,*) ' point 3 in interp_0 '
+      interp = .false.
+      kp = nz_in
+      height = p_out
+      DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) )
+        IF(   ((p_in(kp)   .le. height) .and.     &
+               (p_in(kp-1) .ge. height))             )   THEN
+          w2 = log(height/p_in(kp))/log(p_in(kp-1)/p_in(kp))
+          w1 = 1.-w2
+          interp_0_log2 = w1*v_in(kp) + w2*v_in(kp-1)
+          interp = .true.
+        END IF
+        kp = kp-1
+      ENDDO
+    ENDIF
+
+ end if
+
+ return
+ END FUNCTION interp_0_log2
+
+END MODULE module_init_utilities
+
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_b_wave.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_b_wave.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_b_wave.F	(revision 2744)
@@ -0,0 +1,955 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize
+
+   USE module_domain
+   USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_timing
+   USE module_configure
+   USE module_init_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER                :: dyn_opt 
+   INTEGER :: idum1, idum2
+
+   CALL nl_get_dyn_opt( 1, dyn_opt )
+   
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF (      dyn_opt .eq. 1 &
+        .or. dyn_opt .eq. 2 &
+        .or. dyn_opt .eq. 3 &
+                                       ) THEN
+     CALL init_domain_rk( grid &
+!
+#include <em_actual_new_args.inc>
+!
+                        )
+
+   ELSE
+     WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     call wrf_error_fatal ( ' init_domain: unknown or unimplemented dyn_opt ' )
+   ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+# include <em_dummy_new_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <em_dummy_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+   ! Local data
+
+   INTEGER, PARAMETER :: nl_max = 1000
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in
+   INTEGER :: nl_in
+
+   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
+   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
+   REAL    :: z_scale, xrad, yrad, zrad, rad, delt, cof1, cof2
+!   REAL, EXTERNAL :: interp_0
+   REAL    :: hm
+   REAL    :: pi
+
+!  stuff from original initialization that has been dropped from the Registry 
+   REAL    :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt
+   REAL    :: qvf1, qvf2, pd_surf
+   INTEGER :: it
+
+   LOGICAL :: moisture_init
+   LOGICAL :: stretch_grid, dry_sounding, debug
+
+!  kludge space for initial jet
+
+   INTEGER, parameter :: nz_jet=64, ny_jet=80
+   REAL, DIMENSION(nz_jet, ny_jet) :: u_jet, rho_jet, th_jet, z_jet
+
+!  perturbation parameters
+
+   REAL, PARAMETER :: htbub=8000., radbub=2000000., radz=8000., tpbub=1.0
+   REAL :: piov2, tp
+   INTEGER :: icen, jcen
+   real :: thtmp, ptmp, temp(3)
+
+#ifdef DM_PARALLEL
+#    include <em_data_calls.inc>
+#endif
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+   piov2 = 2.*atan(1.0)
+   icen = ide/4
+   jcen = jde/2
+
+   stretch_grid = .true.
+   delt = 0.
+   z_scale = .50
+   pi = 2.*asin(1.0)
+   write(6,*) ' pi is ',pi
+   nxc = (ide-ids)/4
+   nyc = (jde-jds)/2
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+   moisture_init = .true.
+
+    grid%itimestep=0
+
+#ifdef DM_PARALLEL
+   CALL wrf_dm_bcast_bytes( icm , IWORDSIZE )
+   CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE )
+#endif
+
+    CALL nl_set_mminlu(1,'    ')
+    CALL nl_set_iswater(1,0)
+    CALL nl_set_cen_lat(1,40.)
+    CALL nl_set_cen_lon(1,-105.)
+    CALL nl_set_truelat1(1,0.)
+    CALL nl_set_truelat2(1,0.)
+    CALL nl_set_moad_cen_lat (1,0.)
+    CALL nl_set_stand_lon (1,0.)
+    CALL nl_set_map_proj(1,0)
+
+
+!  here we initialize data we currently is not initialized 
+!  in the input data
+
+    DO j = jts, jte
+      DO i = its, ite
+
+         grid%ht(i,j)       = 0.
+         grid%msft(i,j)     = 1.
+         grid%msfu(i,j)     = 1.
+         grid%msfv(i,j)     = 1.
+         grid%sina(i,j)     = 0.
+         grid%cosa(i,j)     = 1.
+         grid%e(i,j)        = 0.
+         grid%f(i,j)        = 1.e-04
+
+      END DO
+   END DO
+
+    DO j = jts, jte
+    DO k = kts, kte
+      DO i = its, ite
+         grid%em_ww(i,k,j)     = 0.
+      END DO
+   END DO
+   END DO
+
+   grid%step_number = 0
+
+! set up the grid
+
+   IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz)
+     DO k=1, kde
+      grid%em_znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+                                (1.-exp(-1./z_scale))
+     ENDDO
+   ELSE
+     DO k=1, kde
+      grid%em_znw(k) = 1. - float(k-1)/float(kde-1)
+     ENDDO
+   ENDIF
+
+   DO k=1, kde-1
+    grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+    grid%em_rdnw(k) = 1./grid%em_dnw(k)
+    grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+   ENDDO
+   DO k=2, kde-1
+    grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+    grid%em_rdn(k) = 1./grid%em_dn(k)
+    grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+    grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+   ENDDO
+
+   cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+   cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+   grid%cf1  = grid%em_fnp(2) + cof1
+   grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+   grid%cf3  = cof2       
+
+   grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+   grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+   grid%rdx = 1./config_flags%dx
+   grid%rdy = 1./config_flags%dy
+
+!  get the sounding from the ascii sounding file, first get dry sounding and 
+!  calculate base state
+
+  write(6,*) ' reading input jet sounding '
+  call read_input_jet( u_jet, rho_jet, th_jet, z_jet, nz_jet, ny_jet )
+
+  write(6,*) ' getting dry sounding for base state '
+  write(6,*) ' using middle column in jet sounding, j = ',ny_jet/2
+  dry_sounding = .true.
+
+  dry_sounding   = .true.
+  debug = .true.  !  this will produce print of the sounding
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, &
+                      nl_max, nl_in, u_jet, rho_jet, th_jet, z_jet,      &
+                      nz_jet, ny_jet, ny_jet/2, debug                   )
+
+  write(6,*) ' returned from reading sounding, nl_in is ',nl_in
+
+!  find ptop for the desired ztop (ztop is input from the namelist),
+!  and find surface pressure
+
+!  For the jet, using the middle column for the base state means that
+!  we will be extrapolating above the highest height data to the south
+!  of the centerline.
+
+  grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in )
+
+  DO j=jts,jte
+  DO i=its,ite  ! flat surface
+    grid%em_phb(i,1,j) = 0.
+    grid%em_php(i,1,j) = 0.
+    grid%em_ph0(i,1,j) = 0.
+    grid%ht(i,j) = 0.
+  ENDDO
+  ENDDO
+
+  DO J = jts, jte
+  DO I = its, ite
+
+    p_surf = interp_0( p_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+    grid%em_mub(i,j) = p_surf-grid%p_top
+
+!  this is dry hydrostatic sounding (base state), so given grid%em_p (coordinate),
+!  interp theta (from interp) and compute 1/rho from eqn. of state
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_pb(i,k,j) = p_level
+      grid%em_t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
+      grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+    ENDDO
+
+!  calc hydrostatic balance (alternatively we could interp the geopotential from the
+!  sounding, but this assures that the base state is in exact hydrostatic balance with
+!  respect to the model eqns.
+
+    DO k  = 2,kte
+      grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+  write(6,*) ' ptop is ',grid%p_top
+  write(6,*) ' base state grid%em_mub(1,1), p_surf is ',grid%em_mub(1,1),grid%em_mub(1,1)+grid%p_top
+
+!  calculate full state for each column - this includes moisture.
+
+  write(6,*) ' getting grid%moist sounding for full state '
+
+  dry_sounding = .true.
+  IF (config_flags%mp_physics /= 0)  dry_sounding = .false.
+
+  DO J = jts, min(jde-1,jte)
+
+!  get sounding for this point
+
+  debug = .false.  !  this will turn off print of the sounding
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, &
+                      nl_max, nl_in, u_jet, rho_jet, th_jet, z_jet,      &
+                      nz_jet, ny_jet, j, debug                          )
+
+  DO I = its, min(ide-1,ite)
+
+!   we could just do the first point in "i" and copy from there, but we'll
+!   be lazy and do all the points as if they are all, independent
+
+!   At this point grid%p_top is already set. find the DRY mass in the column 
+!   by interpolating the DRY pressure.  
+
+    pd_surf = interp_0( pd_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+
+!   compute the perturbation mass and the full mass
+
+    grid%em_mu_1(i,j) = pd_surf-grid%p_top - grid%em_mub(i,j)
+    grid%em_mu_2(i,j) = grid%em_mu_1(i,j)
+    grid%em_mu0(i,j) = grid%em_mu_1(i,j) + grid%em_mub(i,j)
+
+!   given the dry pressure and coordinate system, interp the potential
+!   temperature and qv
+
+    do k=1,kde-1
+
+      p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+
+      grid%moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%em_t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
+      grid%em_t_2(i,k,j)          = grid%em_t_1(i,k,j)
+      
+
+    enddo
+
+!   integrate the hydrostatic equation (from the RHS of the bigstep
+!   vertical momentum equation) down from the top to get grid%em_p.
+!   first from the top of the model to the top pressure
+
+    k = kte-1  ! top level
+
+    qvf1 = 0.5*(grid%moist(i,k,j,P_QV)+grid%moist(i,k,j,P_QV))
+    qvf2 = 1./(1.+qvf1)
+    qvf1 = qvf1*qvf2
+
+!    grid%em_p(i,k,j) = - 0.5*grid%em_mu_1(i,j)/grid%em_rdnw(k)
+    grid%em_p(i,k,j) = - 0.5*(grid%em_mu_1(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+    qvf = 1. + rvovrd*grid%moist(i,k,j,P_QV)
+    grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+    grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+
+!  down the column
+
+    do k=kte-2,1,-1
+      qvf1 = 0.5*(grid%moist(i,k,j,P_QV)+grid%moist(i,k+1,j,P_QV))
+      qvf2 = 1./(1.+qvf1)
+      qvf1 = qvf1*qvf2
+      grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_1(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+      qvf = 1. + rvovrd*grid%moist(i,k,j,P_QV)
+      grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                  (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+      grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+    enddo
+
+!  this is the hydrostatic equation used in the model after the
+!  small timesteps.  In the model, grid%em_al (inverse density)
+!  is computed from the geopotential.
+
+
+    grid%em_ph_1(i,1,j) = 0.
+    DO k  = 2,kte
+      grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                   (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                    grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+      grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+      grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+    ENDDO
+
+! interp u
+
+    DO K = 1, kte
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
+      grid%em_u_2(i,k,j) = grid%em_u_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  thermal perturbation to kick off convection
+
+  write(6,*) ' nxc, nyc for perturbation ',nxc,nyc
+  write(6,*) ' delt for perturbation ',tpbub
+
+  DO J = jts, min(jde-1,jte)
+    yrad = config_flags%dy*float(j-jde/2-1)/radbub
+    DO I = its, min(ide-1,ite)
+      xrad = float(i-1)/float(ide-ids)
+
+      DO K = 1, kte-1
+
+!  put in preturbation theta (bubble) and recalc density.  note,
+!  the mass in the column is not changing, so when theta changes,
+!  we recompute density and geopotential
+
+        zrad = 0.5*(grid%em_ph_1(i,k,j)+grid%em_ph_1(i,k+1,j)  &
+                   +grid%em_phb(i,k,j)+grid%em_phb(i,k+1,j))/g
+        zrad = (zrad-htbub)/radz
+        RAD=SQRT(yrad*yrad+zrad*zrad)
+        IF(RAD <= 1.) THEN
+           tp = tpbub*cos(rad*piov2)*cos(rad*piov2)*cos(xrad*2*pi+pi)
+           grid%em_t_1(i,k,j)=grid%em_t_1(i,k,j)+tp
+           grid%em_t_2(i,k,j)=grid%em_t_1(i,k,j)
+           qvf = 1. + rvovrd*grid%moist(i,k,j,P_QV)
+           grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                        (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+           grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+        ENDIF
+      ENDDO
+
+!  rebalance hydrostatically
+
+      DO k  = 2,kte
+        grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                     (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                      grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+        grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+        grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+      ENDDO
+
+    ENDDO
+  ENDDO
+
+!#endif
+
+   write(6,*) ' grid%em_mu_1 from comp ', grid%em_mu_1(1,1)
+   write(6,*) ' pert state sounding from comp, grid%em_ph_1, pp, grid%em_al, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1),grid%em_p(1,k,1), grid%em_al(1,k,1), &
+                     grid%em_t_1(1,k,1), grid%moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' grid%em_mu_1 from comp ', grid%em_mu_1(1,1)
+   write(6,*) ' full state sounding from comp, ph, grid%em_p, grid%em_al, grid%em_t_1, qv '
+   write(6,*) ' at j = 1 '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1)+grid%em_phb(1,k,1), &
+                     grid%em_p(1,k,1)+grid%em_pb(1,k,1), grid%em_al(1,k,1)+grid%em_alb(1,k,1), &
+                     grid%em_t_1(1,k,1)+t0, grid%moist(1,k,1,P_QV)
+   enddo
+
+
+   write(6,*) ' full state sounding from comp, ph, grid%em_p, grid%em_al, grid%em_t_1, qv '
+   write(6,*) ' at j = jde/2 '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,jde/2)+grid%em_phb(1,k,jde/2), &
+                     grid%em_p(1,k,jde/2)+grid%em_pb(1,k,jde/2), grid%em_al(1,k,jde/2)+grid%em_alb(1,k,jde/2), &
+                     grid%em_t_1(1,k,jde/2)+t0, grid%moist(1,k,jde/2,P_QV)
+   enddo
+
+   write(6,*) ' full state sounding from comp, ph, grid%em_p, grid%em_al, grid%em_t_1, qv '
+   write(6,*) ' at j = jde-1 '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,jde-1)+grid%em_phb(1,k,jde-1), &
+                     grid%em_p(1,k,jde-1)+grid%em_pb(1,k,jde-1), grid%em_al(1,k,jde-1)+grid%em_alb(1,k,jde-1), &
+                     grid%em_t_1(1,k,jde-1)+t0, grid%moist(1,k,jde-1,P_QV)
+   enddo
+
+! set v
+
+  DO J = jts, jte
+  DO I = its, min(ide-1,ite)
+
+    DO K = 1, kte
+      grid%em_v_1(i,k,j) = 0.
+      grid%em_v_2(i,k,j) = grid%em_v_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  fill out last i row for u
+
+  DO J = jts, min(jde-1,jte)
+  DO I = ite, ite
+
+    DO K = 1, kte
+      grid%em_u_1(i,k,j) = grid%em_u_1(its,k,j)
+      grid%em_u_2(i,k,j) = grid%em_u_2(its,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  set w
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte
+  DO I = its, min(ide-1,ite)
+    grid%em_w_1(i,k,j) = 0.
+    grid%em_w_2(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+!  set a few more things
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%h_diabatic(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+  DO k=1,kte-1
+    grid%em_t_base(k) = grid%em_t_1(1,k,1)
+    grid%qv_base(k) = grid%moist(1,k,1,P_QV)
+    grid%u_base(k) = grid%em_u_1(1,k,1)
+    grid%v_base(k) = grid%em_v_1(1,k,1)
+  ENDDO
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+     thtmp   = grid%em_t_2(i,1,j)+t0
+     ptmp    = grid%em_p(i,1,j)+grid%em_pb(i,1,j)
+     temp(1) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,2,j)+t0
+     ptmp    = grid%em_p(i,2,j)+grid%em_pb(i,2,j)
+     temp(2) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,3,j)+t0
+     ptmp    = grid%em_p(i,3,j)+grid%em_pb(i,3,j)
+     temp(3) = thtmp * (ptmp/p1000mb)**rcp
+
+     grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)
+     if (i .eq. 1) print*,'sfctem',j,temp(1),temp(2),temp(3),grid%tsk(I,J)
+     grid%tmn(I,J)=grid%tsk(I,J)-0.5
+  ENDDO
+  ENDDO
+
+  RETURN
+
+ END SUBROUTINE init_domain_rk
+
+!---------------------------------------------------------------------
+
+ SUBROUTINE init_module_initialize
+ END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+#if 0
+! TEST DRIVER FOR "read_input_jet" and "get_sounding"
+  implicit none 
+  integer, parameter :: nz_jet=64, ny_jet=80
+  real, dimension(nz_jet,ny_jet) :: u_jet, rho_jet, &
+                                    th_jet, z_jet
+
+  real, dimension(nz_jet,ny_jet) :: zk,p,p_dry,theta,rho,u,v,qv
+  logical :: dry, debug
+  integer :: j, nl
+
+  call read_input_jet( u_jet, rho_jet, th_jet, z_jet, nz_jet, ny_jet )
+
+  call opngks
+  call parray( u_jet, nz_jet, ny_jet)
+  call parray( rho_jet, nz_jet, ny_jet)
+  call parray( th_jet, nz_jet, ny_jet)
+!  call clsgks
+
+!  set up initial jet
+
+  debug = .true.
+  dry = .true.
+  do j=1,ny_jet
+
+    call get_sounding( zk(:,j),p(:,j),p_dry(:,j),theta(:,j),      &
+                       rho(:,j),u(:,j), v(:,j),  qv(:,j),        &
+                       dry, nz_jet, nl, u_jet, rho_jet, th_jet,  &
+                       z_jet, nz_jet, ny_jet, j, debug          )
+    debug = .false.
+
+  enddo
+
+  write(6,*) ' lowest level p, th, and rho, highest level p '
+
+  do j=1,ny_jet
+    write(6,*) j, p(1,j),theta(1,j),rho(1,j), p(nz_jet,j)
+!    write(6,*) j, p(1,j),theta(1,j)-th_jet(1,j),rho(1,j)-rho_jet(1,j)
+  enddo
+
+  call parray( p, nz_jet, ny_jet)
+  call parray( p_dry, nz_jet, ny_jet)
+  call parray( theta, nz_jet, ny_jet)
+
+  call clsgks
+
+  end
+
+!---------------------------------
+
+      subroutine parray(a,m,n)
+      dimension a(m,n)
+      dimension b(n,m)
+
+    do i=1,m
+    do j=1,n
+      b(j,i) = a(i,j)
+    enddo
+    enddo
+      
+      write(6,'(''  dimensions m,n  '',2i6)')m,n
+        call set(.05,.95,.05,.95,0.,1.,0.,1.,1)
+        call perim(4,5,4,5)
+        call setusv('LW',2000)
+!        CALL CONREC(a,m,m,n,cmax,cmin,cinc,-1,-638,-922)
+        CALL CONREC(b,n,n,m,0.,0.,0.,-1,-638,-922)
+        call frame
+      return
+      end
+
+! END TEST DRIVER FOR "read_input_jet" and "get_sounding"
+#endif
+
+!------------------------------------------------------------------
+
+    subroutine get_sounding( zk, p, p_dry, theta, rho,       &
+                             u, v, qv, dry, nl_max, nl_in,  &
+                             u_jet, rho_jet, th_jet, z_jet, &
+                             nz_jet, ny_jet, j_point, debug )
+    implicit none
+
+    integer nl_max, nl_in
+    real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), &
+         u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
+    logical dry
+
+    integer nz_jet, ny_jet, j_point
+    real, dimension(nz_jet, ny_jet) :: u_jet, rho_jet, th_jet, z_jet
+
+    integer n
+    parameter(n=1000)
+    logical debug
+
+! input sounding data
+
+    real p_surf, th_surf, qv_surf
+    real pi_surf, pi(n)
+    real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n)
+
+! diagnostics
+
+    real rho_surf, p_input(n), rho_input(n)
+    real pm_input(n)  !  this are for full moist sounding
+
+! local data
+
+    real p1000mb,cv,cp,r,cvpm,g
+    parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+    integer k, it, nl
+    real qvf, qvf1, dz
+
+!  first, read the sounding
+
+!    call read_sounding( p_surf, th_surf, qv_surf, &
+!                          h_input, th_input, qv_input, u_input, v_input,n, nl, debug )
+
+   call calc_jet_sounding( p_surf, th_surf, qv_surf,                             &
+                           h_input, th_input, qv_input, u_input, v_input,        &
+                           n, nl, debug, u_jet, rho_jet, th_jet, z_jet, j_point, &
+                           nz_jet, ny_jet, dry                                  )
+
+   nl = nz_jet
+
+    if(dry) then
+     do k=1,nl
+       qv_input(k) = 0.
+     enddo
+    endif
+
+    if(debug) write(6,*) ' number of input levels = ',nl
+
+      nl_in = nl
+      if(nl_in .gt. nl_max ) then
+        write(6,*) ' too many levels for input arrays ',nl_in,nl_max
+        call wrf_error_fatal ( ' too many levels for input arrays ' )
+      end if
+
+!  compute diagnostics,
+!  first, convert qv(g/kg) to qv(g/g)
+!
+!      do k=1,nl
+!        qv_input(k) = 0.001*qv_input(k)
+!      enddo
+!      p_surf = 100.*p_surf  ! convert to pascals
+
+    qvf = 1. + rvovrd*qv_input(1) 
+    rho_surf = 1./((r/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
+    pi_surf = (p_surf/p1000mb)**(r/cp)
+
+    if(debug) then
+      write(6,*) ' surface density is ',rho_surf
+      write(6,*) ' surface pi is    ',pi_surf
+    end if
+
+
+!  integrate moist sounding hydrostatically, starting from the
+!  specified surface pressure
+!  -> first, integrate from surface to lowest level
+
+        qvf = 1. + rvovrd*qv_input(1) 
+        qvf1 = 1. + qv_input(1)
+        rho_input(1) = rho_surf
+        dz = h_input(1)
+        do it=1,10
+          pm_input(1) = p_surf &
+                  - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1
+          rho_input(1) = 1./((r/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm))
+        enddo
+
+! integrate up the column
+
+        do k=2,nl
+          rho_input(k) = rho_input(k-1)
+          dz = h_input(k)-h_input(k-1)
+          qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k)))
+          qvf = 1. + rvovrd*qv_input(k)   ! qv is in g/kg here
+ 
+          do it=1,10
+            pm_input(k) = pm_input(k-1) &
+                    - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
+            rho_input(k) = 1./((r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
+          enddo
+        enddo
+
+!  we have the moist sounding
+
+!  next, compute the dry sounding using p at the highest level from the
+!  moist sounding and integrating down.
+
+        p_input(nl) = pm_input(nl)
+
+          do k=nl-1,1,-1
+            dz = h_input(k+1)-h_input(k)
+            p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g
+          enddo
+
+
+        do k=1,nl
+
+          zk(k) = h_input(k)
+          p(k) = pm_input(k)
+          p_dry(k) = p_input(k)
+          theta(k) = th_input(k)
+          rho(k) = rho_input(k)
+          u(k) = u_input(k)
+          v(k) = v_input(k)
+          qv(k) = qv_input(k)
+
+        enddo
+
+     if(debug) then
+      write(6,*) ' sounding '
+      write(6,*) '  k  height(m)  press (Pa)   pd(Pa)   theta (K)  den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+      do k=1,nl
+        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k)
+      enddo
+
+     end if
+
+     end subroutine get_sounding
+
+!------------------------------------------------------------------
+
+  subroutine calc_jet_sounding( p_surf, th_surf, qv_surf,      &
+                                h, th, qv, u, v, n, nl, debug, &
+                                u_jet, rho_jet, th_jet, z_jet, &
+                                jp, nz_jet, ny_jet, dry       )
+  implicit none
+  integer :: n, nl, jp, nz_jet, ny_jet
+
+  real, dimension(nz_jet, ny_jet) :: u_jet, rho_jet, th_jet, z_jet
+  real, dimension(n) :: h,th,qv,u,v
+  real :: p_surf, th_surf, qv_surf
+  logical :: debug, dry
+
+  real, dimension(1:nz_jet) :: rho, rel_hum, p
+  integer :: k
+
+!  some local stuff
+
+  real :: tmppi, es, qvs, temperature
+  real, parameter :: p1000mb=1.e+05, rcp=287./1004.5, svpt0=273.15, &
+                     svp3 = 29.65, ep_2=287./461.6, r_d = 287., &
+                     cpovcv = 1004./(1004.-287.),               &
+                     svp1 = 0.6112, svp2 = 17.67
+
+!  get sounding from column jp
+
+   do k=1,nz_jet
+     h(k)  = z_jet(k,jp)
+     th(k) = th_jet(k,jp)
+     qv(k) = 0.
+     rho(k) = rho_jet(k,jp)
+     u(k) = u_jet(k,jp)
+     v(k) = 0.
+   enddo
+
+   if (.not.dry) then
+     DO k=1,nz_jet
+       if(h(k) .gt. 8000.) then
+         rel_hum(k)=0.1
+       else
+         rel_hum(k)=(1.-0.90*(h(k)/8000.)**1.25)
+       end if
+       rel_hum(k) = min(0.7,rel_hum(k))
+     ENDDO
+   else
+     do k=1,nz_jet
+       rel_hum(k) = 0.
+     enddo
+   endif
+
+!  next, compute pressure
+
+   do k=1,nz_jet
+     p(k) = p1000mb*(R_d*rho(k)*th(k)/p1000mb)**cpovcv
+   enddo
+
+!  here we adjust for fixed moisture profile
+
+     IF (.not.dry)  THEN
+
+!  here we assume the input theta is th_v, so we reset theta accordingly
+
+       DO k=1,nz_jet
+         tmppi=(p(k)/p1000mb)**rcp
+         temperature = tmppi*th(k)
+         if (temperature .gt. svpt0) then
+            es  = 1000.*svp1*exp(svp2*(temperature-svpt0)/(temperature-svp3))
+            qvs = ep_2*es/(p(k)-es)
+         else
+            es  = 1000.*svp1*exp( 21.8745584*(temperature-273.16)/(temperature-7.66) )
+            qvs = ep_2*es/(p(k)-es)
+         endif
+         qv(k) = rel_hum(k)*qvs
+         th(k) = th(k)/(1.+.61*qv(k))
+       ENDDO
+ 
+     ENDIF
+
+!  finally, set the surface data. We'll just do a simple extrapolation
+
+   p_surf = 1.5*p(1) - 0.5*p(2)
+   th_surf = 1.5*th(1) - 0.5*th(2)
+   qv_surf = 1.5*qv(1) - 0.5*qv(2)
+
+   end subroutine calc_jet_sounding
+
+!---------------------------------------------------------------------
+
+ SUBROUTINE read_input_jet( u, r, t, zk, nz, ny )
+ implicit none
+
+ integer, intent(in) :: nz,ny
+ real, dimension(nz,ny), intent(out) :: u,r,t,zk
+ integer :: ny_in, nz_in, j,k
+ real, dimension(ny,nz) :: field_in
+
+! this code assumes it is called on processor 0 only
+
+   OPEN(unit=10, file='input_jet', form='unformatted', status='old' )
+   REWIND(10) 
+   read(10) ny_in,nz_in
+   if((ny_in /= ny ) .or. (nz_in /= nz)) then
+     write(0,*) ' error in input jet dimensions '
+     write(0,*) ' ny, ny_input, nz, nz_input ', ny, ny_in, nz,nz_in
+     write(0,*) ' error exit '
+     call wrf_error_fatal ( ' error in input jet dimensions ' )
+   end if
+   read(10) field_in
+   do j=1,ny
+   do k=1,nz
+     u(k,j) = field_in(j,k)
+   enddo
+   enddo
+   read(10) field_in
+   do j=1,ny
+   do k=1,nz
+     t(k,j) = field_in(j,k)
+   enddo
+   enddo
+
+   read(10) field_in
+   do j=1,ny
+   do k=1,nz
+     r(k,j) = field_in(j,k)
+   enddo
+   enddo
+
+   do j=1,ny
+   do k=1,nz
+     zk(k,j) = 125. + 250.*float(k-1)
+   enddo
+   enddo
+
+ end subroutine read_input_jet
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_grav2d_x.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_grav2d_x.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_grav2d_x.F	(revision 2744)
@@ -0,0 +1,840 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!  This MODULE CONTAINS the following routines:
+
+!  initialize_field_test - 1. Set different fields to different constant
+!                             values.  This is only a test.  If the correct
+!                             domain is not found (based upon the "id")
+!                             then a fatal error is issued.               
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize
+
+   USE module_domain
+   USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_timing
+   USE module_configure
+   USE module_init_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER                :: dyn_opt 
+   INTEGER :: idum1, idum2
+
+   CALL nl_get_dyn_opt( 1, dyn_opt )
+   
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF (      dyn_opt .eq. 1 &
+        .or. dyn_opt .eq. 2 &
+        .or. dyn_opt .eq. 3 &
+                                       ) THEN
+     CALL init_domain_rk( grid &
+!
+#include <em_actual_new_args.inc>
+!
+                        )
+
+   ELSE
+     WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     CALL wrf_error_fatal ( ' init_domain: unknown or unimplemented dyn_opt ' )
+   ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+# include <em_dummy_new_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <em_dummy_new_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+   ! Local data
+
+   INTEGER, PARAMETER :: nl_max = 1000
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in
+   INTEGER :: nl_in
+
+
+   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
+   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
+   REAL    :: z_scale, xrad, yrad, zrad, rad, delt, cof1, cof2, t_min, t_max
+!   REAL, EXTERNAL :: interp_0
+   REAL    :: hm, xa, xpos, xposml, xpospl
+   REAL    :: pi
+
+!  stuff from original initialization that has been dropped from the Registry 
+   REAL    :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt
+   REAL    :: qvf1, qvf2, pd_surf
+   INTEGER :: it
+   real :: thtmp, ptmp, temp(3)
+
+   LOGICAL :: moisture_init
+   LOGICAL :: stretch_grid, dry_sounding
+
+   REAL    :: xa1, xal1,pii,hm1  !  data for intercomparison setup from dale
+
+#ifdef DM_PARALLEL
+#    include <em_data_calls.inc>
+#endif
+
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+
+   hm = 000.
+   xa = 5.0
+
+   icm = ide/2
+
+
+   xa1  = 5000./500.
+   xal1 = 4000./500.
+   pii  = 2.*asin(1.0)
+   hm1  = 250.
+!   hm1  = 1000.
+
+
+   stretch_grid = .true.
+!   z_scale = .50
+   z_scale = 1.675
+   pi = 2.*asin(1.0)
+   write(6,*) ' pi is ',pi
+   nxc = (ide-ids)/2
+   nyc = (jde-jds)/2
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+   moisture_init = .true.
+
+    grid%itimestep=0
+
+#ifdef DM_PARALLEL
+   CALL wrf_dm_bcast_bytes( icm , IWORDSIZE )
+   CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE )
+#endif
+
+    CALL nl_set_mminlu(1, '    ')
+    CALL nl_set_iswater(1,0)
+    CALL nl_set_cen_lat(1,40.)
+    CALL nl_set_cen_lon(1,-105.)
+    CALL nl_set_truelat1(1,0.)
+    CALL nl_set_truelat2(1,0.)
+    CALL nl_set_moad_cen_lat (1,0.)
+    CALL nl_set_stand_lon (1,0.)
+    CALL nl_set_map_proj(1,0)
+
+
+!  here we initialize data we currently is not initialized 
+!  in the input data
+
+    DO j = jts, jte
+      DO i = its, ite
+         grid%msft(i,j)     = 1.
+         grid%msfu(i,j)     = 1.
+         grid%msfv(i,j)     = 1.
+         grid%sina(i,j)     = 0.
+         grid%cosa(i,j)     = 1.
+         grid%e(i,j)        = 0.
+         grid%f(i,j)        = 0.
+
+      END DO
+   END DO
+
+    DO j = jts, jte
+    DO k = kts, kte
+      DO i = its, ite
+         grid%em_ww(i,k,j)     = 0.
+      END DO
+   END DO
+   END DO
+
+   grid%step_number = 0
+
+! set up the grid
+
+   IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz)
+     DO k=1, kde
+      grid%em_znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+                                (1.-exp(-1./z_scale))
+     ENDDO
+   ELSE
+     DO k=1, kde
+      grid%em_znw(k) = 1. - float(k-1)/float(kde-1)
+     ENDDO
+   ENDIF
+
+   DO k=1, kde-1
+    grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+    grid%em_rdnw(k) = 1./grid%em_dnw(k)
+    grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+   ENDDO
+   DO k=2, kde-1
+    grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+    grid%em_rdn(k) = 1./grid%em_dn(k)
+    grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+    grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+   ENDDO
+
+   cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+   cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+   grid%cf1  = grid%em_fnp(2) + cof1
+   grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+   grid%cf3  = cof2       
+
+   grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+   grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+   grid%rdx = 1./config_flags%dx
+   grid%rdy = 1./config_flags%dy
+
+!  get the sounding from the ascii sounding file, first get dry sounding and 
+!  calculate base state
+
+  write(6,*) ' getting dry sounding for base state '
+  dry_sounding = .true.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, &
+                     nl_max, nl_in, .true.)
+
+  write(6,*) ' returned from reading sounding, nl_in is ',nl_in
+
+
+!  find ptop for the desired ztop (ztop is input from the namelist),
+!  and find surface pressure
+
+  grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in )
+
+  DO j=jts,jte
+  DO i=its,ite  ! flat surface
+!!    grid%ht(i,j) = 0.
+    grid%ht(i,j) = hm/(1.+(float(i-icm)/xa)**2)
+!    grid%ht(i,j) = hm1*exp(-(( float(i-icm)/xa1)**2))   &
+!               *( (cos(pii*float(i-icm)/xal1))**2 )
+    grid%em_phb(i,1,j) = g*grid%ht(i,j)
+    grid%em_php(i,1,j) = 0.
+    grid%em_ph0(i,1,j) = grid%em_phb(i,1,j)
+  ENDDO
+  ENDDO
+
+  DO J = jts, jte
+  DO I = its, ite
+
+    p_surf = interp_0( p_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+    grid%em_mub(i,j) = p_surf-grid%p_top
+
+!  this is dry hydrostatic sounding (base state), so given p (coordinate),
+!  interp theta (from interp) and compute 1/rho from eqn. of state
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_pb(i,k,j) = p_level
+      grid%em_t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
+      grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+    ENDDO
+
+!  calc hydrostatic balance (alternatively we could interp the geopotential from the
+!  sounding, but this assures that the base state is in exact hydrostatic balance with
+!  respect to the model eqns.
+
+    DO k  = 2,kte
+      grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+  write(6,*) ' ptop is ',grid%p_top
+  write(6,*) ' base state mub(1,1), p_surf is ',grid%em_mub(1,1),grid%em_mub(1,1)+grid%p_top
+
+!  calculate full state for each column - this includes moisture.
+
+  write(6,*) ' getting moist sounding for full state '
+  dry_sounding = .false.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, &
+                     nl_max, nl_in, .false. )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+
+!  At this point grid%p_top is already set. find the DRY mass in the column 
+!  by interpolating the DRY pressure.  
+
+   pd_surf = interp_0( pd_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+
+!  compute the perturbation mass and the full mass
+
+    grid%em_mu_1(i,j) = pd_surf-grid%p_top - grid%em_mub(i,j)
+    grid%em_mu_2(i,j) = grid%em_mu_1(i,j)
+    grid%em_mu0(i,j) = grid%em_mu_1(i,j) + grid%em_mub(i,j)
+
+! given the dry pressure and coordinate system, interp the potential
+! temperature and qv
+
+    do k=1,kde-1
+
+      p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+
+      grid%moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%em_t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
+      grid%em_t_2(i,k,j)          = grid%em_t_1(i,k,j)
+      
+
+    enddo
+
+!  integrate the hydrostatic equation (from the RHS of the bigstep
+!  vertical momentum equation) down from the top to get p.
+!  first from the top of the model to the top pressure
+
+    k = kte-1  ! top level
+
+    qvf1 = 0.5*(grid%moist(i,k,j,P_QV)+grid%moist(i,k,j,P_QV))
+    qvf2 = 1./(1.+qvf1)
+    qvf1 = qvf1*qvf2
+
+!    grid%em_p(i,k,j) = - 0.5*grid%em_mu_1(i,j)/grid%em_rdnw(k)
+    grid%em_p(i,k,j) = - 0.5*(grid%em_mu_1(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+    qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+    grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+    grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+
+!  down the column
+
+    do k=kte-2,1,-1
+      qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+      qvf2 = 1./(1.+qvf1)
+      qvf1 = qvf1*qvf2
+      grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_1(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+      qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+      grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                  (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+      grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+    enddo
+
+!  this is the hydrostatic equation used in the model after the
+!  small timesteps.  In the model, al (inverse density)
+!  is computed from the geopotential.
+
+
+    grid%em_ph_1(i,1,j) = 0.
+    DO k  = 2,kte
+      grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                   (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                    grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+      grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+      grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+    ENDDO
+
+    if((i==2) .and. (j==2)) then
+     write(6,*) ' ph_1 calc ',grid%em_ph_1(2,1,2),grid%em_ph_1(2,2,2),&
+                              grid%em_mu_1(2,2)+grid%em_mub(2,2),grid%em_mu_1(2,2), &
+                              grid%em_alb(2,1,2),grid%em_al(1,2,1),grid%em_rdnw(1)
+    endif
+
+  ENDDO
+  ENDDO
+
+!  cold bubble input  (from straka et al, IJNMF, vol 17, 1993 pp 1-22)
+
+  t_min = grid%em_t_1(its,kts,jts)
+  t_max = t_min
+  u_mean = 00.
+
+  xpos = config_flags%dx*nxc - u_mean*900.
+  xposml = xpos - config_flags%dx*(ide-1)
+  xpospl = xpos + config_flags%dx*(ide-1)
+
+  DO J = jts, min(jde-1,jte)
+    DO I = its, min(ide-1,ite)
+!      xrad = config_flags%dx*float(i-nxc)/4000.  !  4000 meter horizontal radius
+!                                    !  centered in the domain
+
+       xrad = min( abs(config_flags%dx*float(i)-xpos),   &
+                   abs(config_flags%dx*float(i)-xposml), &
+                   abs(config_flags%dx*float(i)-xpospl))/4000.
+
+      DO K = 1, kte-1
+
+!  put in preturbation theta (bubble) and recalc density.  note,
+!  the mass in the column is not changing, so when theta changes,
+!  we recompute density and geopotential
+
+        zrad = 0.5*(grid%em_ph_1(i,k,j)+grid%em_ph_1(i,k+1,j)  &
+                   +grid%em_phb(i,k,j)+grid%em_phb(i,k+1,j))/g
+        zrad = (zrad-3000.)/2000. !  2000 meter vertical radius, 
+                                  !  centered at z=3000,
+        RAD=SQRT(xrad*xrad+zrad*zrad)
+        IF(RAD <= 1.) THEN
+
+           !  perturbation temperature is 15 C, convert to potential temperature
+
+           delt = -15.0 / ((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**rcp
+
+           grid%em_T_1(i,k,j)=grid%em_T_1(i,k,j)+delt*(COS(PI*RAD)+1.0)/2.
+           grid%em_T_2(i,k,j)=grid%em_T_1(i,k,j)
+           qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+           grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                        (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+           grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+        ENDIF
+
+        t_min = min(t_min, grid%em_t_1(i,k,j))
+        t_max = max(t_max, grid%em_t_1(i,k,j))
+      ENDDO
+
+!  rebalance hydrostatically
+
+      DO k  = 2,kte
+        grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                     (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                      grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+        grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+        grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+      ENDDO
+
+    ENDDO
+  ENDDO
+
+  write(6,*) ' min and max theta perturbation ',t_min,t_max
+
+
+
+
+! -- end bubble insert
+
+   write(6,*) ' mu_1 from comp ', grid%em_mu_1(1,1)
+   write(6,*) ' full state sounding from comp, ph, p, al, t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1)+grid%em_phb(1,k,1), &
+                                      grid%em_p(1,k,1)+grid%em_pb(1,k,1), grid%em_alt(1,k,1), &
+                                      grid%em_t_1(1,k,1)+t0, moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' pert state sounding from comp, ph_1, pp, alp, t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1), &
+                                      grid%em_p(1,k,1), grid%em_al(1,k,1), &
+                                      grid%em_t_1(1,k,1), moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' '
+   write(6,*) ' k, model level, dz '
+   do k=1,kde-1
+     write(6,'(i3,1x,e12.5,1x,f10.2)') k,  &
+      .5*(grid%em_ph_1(1,k,1)+grid%em_phb(1,k,1)+grid%em_ph_1(1,k+1,1)+grid%em_phb(1,k+1,1))/g, &
+      (grid%em_ph_1(1,k+1,1)+grid%em_phb(1,k+1,1)-grid%em_ph_1(1,k,1)-grid%em_phb(1,k,1))/g
+   enddo
+   write(6,*) ' model top (m) is ', (grid%em_ph_1(1,kde,1)+grid%em_phb(1,kde,1))/g
+
+
+! interp v
+
+  DO J = jts, jte
+  DO I = its, min(ide-1,ite)
+
+    IF (j == jds) THEN
+      z_at_v = grid%em_phb(i,1,j)/g
+    ELSE IF (j == jde) THEN
+      z_at_v = grid%em_phb(i,1,j-1)/g
+    ELSE
+      z_at_v = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i,1,j-1))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_v, nl_in )
+
+    DO K = 1, kte
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in )
+      grid%em_v_2(i,k,j) = grid%em_v_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+! interp u
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, ite
+
+    IF (i == ids) THEN
+      z_at_u = grid%em_phb(i,1,j)/g
+    ELSE IF (i == ide) THEN
+      z_at_u = grid%em_phb(i-1,1,j)/g
+    ELSE
+      z_at_u = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i-1,1,j))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_u, nl_in )
+
+    DO K = 1, kte
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
+      grid%em_u_2(i,k,j) = grid%em_u_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  set w
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte
+  DO I = its, min(ide-1,ite)
+    grid%em_w_1(i,k,j) = 0.
+    grid%em_w_2(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+!  set a few more things
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%h_diabatic(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+  DO k=1,kte-1
+    grid%em_t_base(k) = grid%em_t_1(1,k,1)
+    grid%qv_base(k) = moist(1,k,1,P_QV)
+    grid%u_base(k) = grid%em_u_1(1,k,1)
+    grid%v_base(k) = grid%em_v_1(1,k,1)
+    grid%z_base(k) = 0.5*(grid%em_phb(1,k,1)+grid%em_phb(1,k+1,1)+grid%em_ph_1(1,k,1)+grid%em_ph_1(1,k+1,1))/g
+  ENDDO
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+     thtmp   = grid%em_t_2(i,1,j)+t0
+     ptmp    = grid%em_p(i,1,j)+grid%em_pb(i,1,j)
+     temp(1) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,2,j)+t0
+     ptmp    = grid%em_p(i,2,j)+grid%em_pb(i,2,j)
+     temp(2) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,3,j)+t0
+     ptmp    = grid%em_p(i,3,j)+grid%em_pb(i,3,j)
+     temp(3) = thtmp * (ptmp/p1000mb)**rcp
+
+     grid%TSK(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)
+     grid%TMN(I,J)=grid%TSK(I,J)-0.5
+  ENDDO
+  ENDDO
+
+  RETURN
+
+ END SUBROUTINE init_domain_rk
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+
+!  test driver for get_sounding
+!
+!      implicit none
+!      integer n
+!      parameter(n = 1000)
+!      real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n)
+!      logical dry
+!      integer nl,k
+!
+!      dry = .false.
+!      dry = .true.
+!      call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl )
+!      write(6,*) ' input levels ',nl
+!      write(6,*) ' sounding '
+!      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+!      do k=1,nl
+!        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k)
+!      enddo
+!      end
+!
+!---------------------------------------------------------------------------
+
+      subroutine get_sounding( zk, p, p_dry, theta, rho, &
+                               u, v, qv, dry, nl_max, nl_in, base_state )
+      implicit none
+
+      integer nl_max, nl_in
+      real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), &
+           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
+      logical dry
+      logical base_state
+
+      integer n, iz
+      parameter(n=1000)
+      logical debug
+      parameter( debug = .false.)
+
+! input sounding data
+
+      real p_surf, th_surf, qv_surf
+      real pi_surf, pi(n)
+      real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n)
+
+! diagnostics
+
+      real rho_surf, p_input(n), rho_input(n)
+      real pm_input(n)  !  this are for full moist sounding
+
+! local data
+
+      real p1000mb,cv,cp,r,cvpm,g
+      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+      integer k, it, nl
+      real qvf, qvf1, dz
+
+!  first, read the sounding
+
+      call read_sounding( p_surf, th_surf, qv_surf, &
+                          h_input, th_input, qv_input, u_input, v_input,n, nl, debug )
+
+!        iz = 1
+!        do k=2,nl
+!          if(h_input(k) .lt. 12000.) iz = k
+!        enddo
+!        write(6,*) " tropopause ",iz,h_input(iz)
+!        if(dry) then
+!        write(6,*) ' nl is ',nl
+!        do k=1,nl
+!          th_input(k) = th_input(k)+10.+10*float(k)/nl
+!        enddo
+!        write(6,*) ' finished adjusting theta '
+!        endif
+
+!        do k=1,nl
+!          u_input(k) = 2*u_input(k)
+!        enddo
+!
+!      end if
+
+      if(dry) then
+       do k=1,nl
+         qv_input(k) = 0.
+       enddo
+      endif
+
+      if(debug) write(6,*) ' number of input levels = ',nl
+
+        nl_in = nl
+        if(nl_in .gt. nl_max ) then
+          write(6,*) ' too many levels for input arrays ',nl_in,nl_max
+          call wrf_error_fatal ( ' too many levels for input arrays ' )
+        end if
+
+!  compute diagnostics,
+!  first, convert qv(g/kg) to qv(g/g)
+
+      do k=1,nl
+        qv_input(k) = 0.001*qv_input(k)
+      enddo
+
+      p_surf = 100.*p_surf  ! convert to pascals
+      qvf = 1. + rvovrd*qv_input(1) 
+      rho_surf = 1./((r/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
+      pi_surf = (p_surf/p1000mb)**(r/cp)
+
+      if(debug) then
+        write(6,*) ' surface density is ',rho_surf
+        write(6,*) ' surface pi is      ',pi_surf
+      end if
+
+
+!  integrate moist sounding hydrostatically, starting from the
+!  specified surface pressure
+!  -> first, integrate from surface to lowest level
+
+          qvf = 1. + rvovrd*qv_input(1) 
+          qvf1 = 1. + qv_input(1)
+          rho_input(1) = rho_surf
+          dz = h_input(1)
+          do it=1,10
+            pm_input(1) = p_surf &
+                    - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1
+            rho_input(1) = 1./((r/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm))
+          enddo
+
+! integrate up the column
+
+          do k=2,nl
+            rho_input(k) = rho_input(k-1)
+            dz = h_input(k)-h_input(k-1)
+            qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k)))
+            qvf = 1. + rvovrd*qv_input(k)   ! qv is in g/kg here
+ 
+            do it=1,20
+              pm_input(k) = pm_input(k-1) &
+                      - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
+              rho_input(k) = 1./((r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
+            enddo
+          enddo
+
+!  we have the moist sounding
+
+!  next, compute the dry sounding using p at the highest level from the
+!  moist sounding and integrating down.
+
+        p_input(nl) = pm_input(nl)
+
+          do k=nl-1,1,-1
+            dz = h_input(k+1)-h_input(k)
+            p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g
+          enddo
+
+!      write(6,*) ' zeroing u input '
+
+        do k=1,nl
+
+          zk(k) = h_input(k)
+          p(k) = pm_input(k)
+          p_dry(k) = p_input(k)
+          theta(k) = th_input(k)
+          rho(k) = rho_input(k)
+          u(k) = u_input(k)
+!          u(k) = 0.
+          v(k) = v_input(k)
+          qv(k) = qv_input(k)
+
+        enddo
+
+     if(debug) then
+      write(6,*) ' sounding '
+      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+      do k=1,nl
+        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k)
+      enddo
+
+     end if
+
+      end subroutine get_sounding
+
+!-------------------------------------------------------
+
+      subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,n,nl,debug )
+      implicit none
+      integer n,nl
+      real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n)
+      logical end_of_file
+      logical debug
+
+      integer k
+
+      open(unit=10,file='input_sounding',form='formatted',status='old')
+      rewind(10)
+      read(10,*) ps, ts, qvs
+      if(debug) then
+        write(6,*) ' input sounding surface parameters '
+        write(6,*) ' surface pressure (mb) ',ps
+        write(6,*) ' surface pot. temp (K) ',ts
+        write(6,*) ' surface mixing ratio (g/kg) ',qvs
+      end if
+
+      end_of_file = .false.
+      k = 0
+
+      do while (.not. end_of_file)
+
+        read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1)
+        k = k+1
+        if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k)
+        go to 110
+ 100    end_of_file = .true.
+ 110    continue
+      enddo
+
+      nl = k
+
+      close(unit=10,status = 'keep')
+
+      end subroutine read_sounding
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_hill2d_x.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_hill2d_x.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_hill2d_x.F	(revision 2744)
@@ -0,0 +1,805 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!  This MODULE CONTAINS the following routines:
+
+!  initialize_field_test - 1. Set different fields to different constant
+!                             values.  This is only a test.  If the correct
+!                             domain is not found (based upon the "id")
+!                             then a fatal error is issued.               
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize
+
+   USE module_domain
+   USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_timing
+   USE module_configure
+   USE module_init_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+! NOTE:  Modified to remove all but arrays of rank 4 or more from the 
+!        argument list.  Arrays with rank>3 are still problematic due to the 
+!        above-noted fie- and pox-ities.  TBH 20061129.  
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER                :: dyn_opt 
+   INTEGER :: idum1, idum2
+
+   CALL nl_get_dyn_opt( 1,dyn_opt )
+   
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF (      dyn_opt .eq. 1 &
+        .or. dyn_opt .eq. 2 &
+        .or. dyn_opt .eq. 3 &
+                                       ) THEN
+     CALL init_domain_rk( grid &
+!
+#include <em_actual_new_args.inc>
+!
+                        )
+
+   ELSE
+     WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     CALL wrf_error_fatal ( ' init_domain: unknown or unimplemented dyn_opt ' )
+   ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+# include <em_dummy_new_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <em_dummy_new_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+   ! Local data
+!****Mars
+    REAL    :: x_param,y_param,rho_param,dilat
+!****Mars
+   INTEGER, PARAMETER :: nl_max = 1000
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in
+   INTEGER :: nl_in
+
+
+   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
+   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
+   REAL    :: z_scale, xrad, yrad, zrad, rad, delt, cof1, cof2
+!   REAL, EXTERNAL :: interp_0
+   REAL    :: hm, xa
+   REAL    :: pi
+
+!  stuff from original initialization that has been dropped from the Registry 
+   REAL    :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt
+   REAL    :: qvf1, qvf2, pd_surf
+   INTEGER :: it
+   real :: thtmp, ptmp, temp(3)
+
+   LOGICAL :: moisture_init
+   LOGICAL :: stretch_grid, dry_sounding
+
+   REAL    :: xa1, xal1,pii,hm1  !  data for intercomparison setup from dale
+
+#ifdef DM_PARALLEL
+#    include <em_data_calls.inc>
+#endif
+
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+
+!   hm = 100.
+!   xa = 5.0
+!****Mars
+!!   hm = 4000.
+!!   xa = 5.0
+   hm = 2000.
+   xa = 6.0 
+!****Mars
+
+   icm = ide/2
+!****Mars
+   jcm = jde/2
+!
+!   xa1  = 5000./500.
+!   xal1 = 4000./500.
+!   pii  = 2.*asin(1.0)
+!   hm1  = 250.
+!!   hm1  = 1000.
+!****Mars
+
+
+!****Mars
+!   stretch_grid = .true.
+   stretch_grid = .false.
+!****Mars
+!   z_scale = .50
+   z_scale = .40
+   pi = 2.*asin(1.0)
+   write(6,*) ' pi is ',pi
+   nxc = (ide-ids)/4
+   nyc = (jde-jds)/2
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+   moisture_init = .true.
+
+    grid%itimestep=0
+
+#ifdef DM_PARALLEL
+   CALL wrf_dm_bcast_bytes( icm , IWORDSIZE )
+   CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE )
+#endif
+
+    CALL nl_set_mminlu(1,'    ')
+    CALL nl_set_iswater(1,0)
+    CALL nl_set_cen_lat(1,40.)
+    CALL nl_set_cen_lon(1,-105.)
+    CALL nl_set_truelat1(1,0.)
+    CALL nl_set_truelat2(1,0.)
+    CALL nl_set_moad_cen_lat (1,0.)
+    CALL nl_set_stand_lon (1,0.)
+    CALL nl_set_map_proj(1,0)
+
+
+!  here we initialize data we currently is not initialized 
+!  in the input data
+
+    DO j = jts, jte
+      DO i = its, ite
+         grid%msft(i,j)     = 1.
+         grid%msfu(i,j)     = 1.
+         grid%msfv(i,j)     = 1.
+         grid%sina(i,j)     = 0.
+         grid%cosa(i,j)     = 1.
+         grid%e(i,j)        = 0.
+         grid%f(i,j)        = 0.
+
+      END DO
+   END DO
+
+    DO j = jts, jte
+    DO k = kts, kte
+      DO i = its, ite
+         grid%em_ww(i,k,j)     = 0.
+      END DO
+   END DO
+   END DO
+
+   grid%step_number = 0
+
+! set up the grid
+
+   IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz)
+     DO k=1, kde
+      grid%em_znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+                                (1.-exp(-1./z_scale))
+     ENDDO
+   ELSE
+     DO k=1, kde
+      grid%em_znw(k) = 1. - float(k-1)/float(kde-1)
+     ENDDO
+   ENDIF
+
+   DO k=1, kde-1
+    grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+    grid%em_rdnw(k) = 1./grid%em_dnw(k)
+    grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+   ENDDO
+   DO k=2, kde-1
+    grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+    grid%em_rdn(k) = 1./grid%em_dn(k)
+    grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+    grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+   ENDDO
+
+   cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+   cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+   grid%cf1  = grid%em_fnp(2) + cof1
+   grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+   grid%cf3  = cof2       
+
+   grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+   grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+   grid%rdx = 1./config_flags%dx
+   grid%rdy = 1./config_flags%dy
+
+!  get the sounding from the ascii sounding file, first get dry sounding and 
+!  calculate base state
+
+  write(6,*) ' getting dry sounding for base state '
+  dry_sounding = .true.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, &
+                     nl_max, nl_in, .true.)
+
+  write(6,*) ' returned from reading sounding, nl_in is ',nl_in
+
+
+!  find ptop for the desired ztop (ztop is input from the namelist),
+!  and find surface pressure
+
+  grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in )
+
+  DO j=jts,jte
+  DO i=its,ite  ! flat surface
+!!    grid%ht(i,j) = 0.
+    grid%ht(i,j) = hm/(1.+(float(i-icm)/xa)**2)
+!    grid%ht(i,j) = hm1*exp(-(( float(i-icm)/xa1)**2))   &
+!               *( (cos(pii*float(i-icm)/xal1))**2 )
+
+!****Mars
+!!3D hill    
+!        grid%ht(i,j) = hm/(1.+(float(i-icm)/xa)**2+(float(j-jcm)/xa)**2)
+!!3D crater    
+!	 grid%ht(i,j) = hm - hm/(1.+(float(i-icm)/xa)**2+(float(j-jcm)/xa)**2)
+!!3D crater w/ rims
+     x_param = float(i-icm)
+     y_param = float(j-jcm)
+     dilat = xa/2
+     rho_param = sqrt(x_param**2 + y_param**2)
+     
+     ! revolution surface ; seed is a fourth order polynom
+     grid%ht(i,j) = (rho_param+6*dilat)*(rho_param+10*dilat)
+     grid%ht(i,j) = (rho_param-6*dilat)*(rho_param-10*dilat)*grid%ht(i,j)
+         ! flat terrain elsewhere - smooth gradient (no abrupt fall)
+         grid%ht(i,j) = grid%ht(i,j)*(tanh(rho_param+7*dilat)/2 - tanh(rho_param-7*dilat)/2)
+         grid%ht(i,j) = hm - (hm*.4/1500)*grid%ht(i,j)/(dilat**4)    
+     
+         !if (rho_param .GE. dilat*10) ht(i,j) = hm
+
+
+    grid%em_phb(i,1,j) = g*grid%ht(i,j)
+    grid%em_php(i,1,j) = 0.
+    grid%em_ph0(i,1,j) = grid%em_phb(i,1,j)
+  ENDDO
+  ENDDO
+
+  DO J = jts, jte
+  DO I = its, ite
+
+    p_surf = interp_0( p_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+    grid%em_mub(i,j) = p_surf-grid%p_top
+
+!  this is dry hydrostatic sounding (base state), so given grid%em_p (coordinate),
+!  interp theta (from interp) and compute 1/rho from eqn. of state
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_pb(i,k,j) = p_level
+      grid%em_t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
+      grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+    ENDDO
+
+!  calc hydrostatic balance (alternatively we could interp the geopotential from the
+!  sounding, but this assures that the base state is in exact hydrostatic balance with
+!  respect to the model eqns.
+
+    DO k  = 2,kte
+      grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+  write(6,*) ' ptop is ',grid%p_top
+  write(6,*) ' base state grid%em_mub(1,1), p_surf is ',grid%em_mub(1,1),grid%em_mub(1,1)+grid%p_top
+
+!  calculate full state for each column - this includes moisture.
+
+  write(6,*) ' getting moist sounding for full state '
+  dry_sounding = .false.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, &
+                     nl_max, nl_in, .false. )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+
+!  At this point grid%p_top is already set. find the DRY mass in the column 
+!  by interpolating the DRY pressure.  
+
+   pd_surf = interp_0( pd_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+
+!  compute the perturbation mass and the full mass
+
+    grid%em_mu_1(i,j) = pd_surf-grid%p_top - grid%em_mub(i,j)
+    grid%em_mu_2(i,j) = grid%em_mu_1(i,j)
+    grid%em_mu0(i,j) = grid%em_mu_1(i,j) + grid%em_mub(i,j)
+
+! given the dry pressure and coordinate system, interp the potential
+! temperature and qv
+
+    do k=1,kde-1
+
+      p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+
+      moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%em_t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
+      grid%em_t_2(i,k,j)          = grid%em_t_1(i,k,j)
+      
+
+    enddo
+
+!  integrate the hydrostatic equation (from the RHS of the bigstep
+!  vertical momentum equation) down from the top to get grid%em_p.
+!  first from the top of the model to the top pressure
+
+    k = kte-1  ! top level
+
+    qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+    qvf2 = 1./(1.+qvf1)
+    qvf1 = qvf1*qvf2
+
+!    grid%em_p(i,k,j) = - 0.5*grid%em_mu_1(i,j)/grid%em_rdnw(k)
+    grid%em_p(i,k,j) = - 0.5*(grid%em_mu_1(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+    qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+    grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+    grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+
+!  down the column
+
+    do k=kte-2,1,-1
+      qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+      qvf2 = 1./(1.+qvf1)
+      qvf1 = qvf1*qvf2
+      grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_1(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+      qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+      grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                  (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+      grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+    enddo
+
+!  this is the hydrostatic equation used in the model after the
+!  small timesteps.  In the model, grid%em_al (inverse density)
+!  is computed from the geopotential.
+
+
+    grid%em_ph_1(i,1,j) = 0.
+    DO k  = 2,kte
+      grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                   (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                    grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+      grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+      grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+    ENDDO
+
+    if((i==2) .and. (j==2)) then
+     write(6,*) ' grid%em_ph_1 calc ',grid%em_ph_1(2,1,2),grid%em_ph_1(2,2,2),&
+                              grid%em_mu_1(2,2)+grid%em_mub(2,2),grid%em_mu_1(2,2), &
+                              grid%em_alb(2,1,2),grid%em_al(1,2,1),grid%em_rdnw(1)
+    endif
+
+  ENDDO
+  ENDDO
+
+   write(6,*) ' grid%em_mu_1 from comp ', grid%em_mu_1(1,1)
+   write(6,*) ' full state sounding from comp, ph, grid%em_p, grid%em_al, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1)+grid%em_phb(1,k,1), &
+                                      grid%em_p(1,k,1)+grid%em_pb(1,k,1), grid%em_alt(1,k,1), &
+                                      grid%em_t_1(1,k,1)+t0, moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' pert state sounding from comp, grid%em_ph_1, pp, alp, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1), &
+                                      grid%em_p(1,k,1), grid%em_al(1,k,1), &
+                                      grid%em_t_1(1,k,1), moist(1,k,1,P_QV)
+   enddo
+
+! interp v
+
+  DO J = jts, jte
+  DO I = its, min(ide-1,ite)
+
+    IF (j == jds) THEN
+      z_at_v = grid%em_phb(i,1,j)/g
+    ELSE IF (j == jde) THEN
+      z_at_v = grid%em_phb(i,1,j-1)/g
+    ELSE
+      z_at_v = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i,1,j-1))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_v, nl_in )
+
+    DO K = 1, kte
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in )
+      grid%em_v_2(i,k,j) = grid%em_v_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+! interp u
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, ite
+
+    IF (i == ids) THEN
+      z_at_u = grid%em_phb(i,1,j)/g
+    ELSE IF (i == ide) THEN
+      z_at_u = grid%em_phb(i-1,1,j)/g
+    ELSE
+      z_at_u = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i-1,1,j))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_u, nl_in )
+
+    DO K = 1, kte
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
+      grid%em_u_2(i,k,j) = grid%em_u_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  set w
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte
+  DO I = its, min(ide-1,ite)
+    grid%em_w_1(i,k,j) = 0.
+    grid%em_w_2(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+!  set a few more things
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%h_diabatic(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+  DO k=1,kte-1
+    grid%em_t_base(k) = grid%em_t_1(1,k,1)
+    grid%qv_base(k) = moist(1,k,1,P_QV)
+    grid%u_base(k) = grid%em_u_1(1,k,1)
+    grid%v_base(k) = grid%em_v_1(1,k,1)
+    grid%z_base(k) = 0.5*(grid%em_phb(1,k,1)+grid%em_phb(1,k+1,1)+grid%em_ph_1(1,k,1)+grid%em_ph_1(1,k+1,1))/g
+  ENDDO
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+     thtmp   = grid%em_t_2(i,1,j)+t0
+     ptmp    = grid%em_p(i,1,j)+grid%em_pb(i,1,j)
+     temp(1) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,2,j)+t0
+     ptmp    = grid%em_p(i,2,j)+grid%em_pb(i,2,j)
+     temp(2) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,3,j)+t0
+     ptmp    = grid%em_p(i,3,j)+grid%em_pb(i,3,j)
+     temp(3) = thtmp * (ptmp/p1000mb)**rcp
+
+     grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)
+     grid%tmn(I,J)=grid%tsk(I,J)-0.5
+  ENDDO
+  ENDDO
+
+  RETURN
+
+ END SUBROUTINE init_domain_rk
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+
+!  test driver for get_sounding
+!
+!      implicit none
+!      integer n
+!      parameter(n = 1000)
+!      real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n)
+!      logical dry
+!      integer nl,k
+!
+!      dry = .false.
+!      dry = .true.
+!      call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl )
+!      write(6,*) ' input levels ',nl
+!      write(6,*) ' sounding '
+!      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+!      do k=1,nl
+!        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k)
+!      enddo
+!      end
+!
+!---------------------------------------------------------------------------
+
+      subroutine get_sounding( zk, p, p_dry, theta, rho, &
+                               u, v, qv, dry, nl_max, nl_in, base_state )
+      implicit none
+
+      integer nl_max, nl_in
+      real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), &
+           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
+      logical dry
+      logical base_state
+
+      integer n, iz
+      parameter(n=1000)
+      logical debug
+
+!      parameter( debug = .false.)
+!****Mars
+      parameter( debug = .true.)
+
+! input sounding data
+
+      real p_surf, th_surf, qv_surf
+      real pi_surf, pi(n)
+      real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n)
+
+! diagnostics
+
+      real rho_surf, p_input(n), rho_input(n)
+      real pm_input(n)  !  this are for full moist sounding
+
+! local data
+
+      real p1000mb,cv,cp,r,cvpm,g
+!****Mars
+!      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+      parameter (p1000mb = 610, r = 192, cp = 845., cv = cp-r, cvpm = -cv/cp,g=3.72)
+!****Mars
+      integer k, it, nl
+      real qvf, qvf1, dz
+
+!  first, read the sounding
+
+      call read_sounding( p_surf, th_surf, qv_surf, &
+                          h_input, th_input, qv_input, u_input, v_input,n, nl, debug )
+
+!        iz = 1
+!        do k=2,nl
+!          if(h_input(k) .lt. 12000.) iz = k
+!        enddo
+!        write(6,*) " tropopause ",iz,h_input(iz)
+!        if(dry) then
+!        write(6,*) ' nl is ',nl
+!        do k=1,nl
+!          th_input(k) = th_input(k)+10.+10*float(k)/nl
+!        enddo
+!        write(6,*) ' finished adjusting theta '
+!        endif
+
+!        do k=1,nl
+!          u_input(k) = 2*u_input(k)
+!        enddo
+!
+!      end if
+
+      if(dry) then
+       do k=1,nl
+         qv_input(k) = 0.
+       enddo
+      endif
+
+      if(debug) write(6,*) ' number of input levels = ',nl
+
+        nl_in = nl
+        if(nl_in .gt. nl_max ) then
+          write(6,*) ' too many levels for input arrays ',nl_in,nl_max
+          call wrf_error_fatal ( ' too many levels for input arrays ' )
+        end if
+
+!  compute diagnostics,
+!  first, convert qv(g/kg) to qv(g/g)
+
+      do k=1,nl
+        qv_input(k) = 0.001*qv_input(k)
+      enddo
+
+      p_surf = 100.*p_surf  ! convert to pascals
+      qvf = 1. + rvovrd*qv_input(1) 
+      rho_surf = 1./((r/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
+      pi_surf = (p_surf/p1000mb)**(r/cp)
+
+      if(debug) then
+        write(6,*) ' surface density is ',rho_surf
+        write(6,*) ' surface pi is      ',pi_surf
+      end if
+
+
+!  integrate moist sounding hydrostatically, starting from the
+!  specified surface pressure
+!  -> first, integrate from surface to lowest level
+
+          qvf = 1. + rvovrd*qv_input(1) 
+          qvf1 = 1. + qv_input(1)
+          rho_input(1) = rho_surf
+          dz = h_input(1)
+          do it=1,10
+            pm_input(1) = p_surf &
+                    - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1
+            rho_input(1) = 1./((r/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm))
+          enddo
+
+! integrate up the column
+
+          do k=2,nl
+            rho_input(k) = rho_input(k-1)
+            dz = h_input(k)-h_input(k-1)
+            qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k)))
+            qvf = 1. + rvovrd*qv_input(k)   ! qv is in g/kg here
+ 
+            do it=1,20
+              pm_input(k) = pm_input(k-1) &
+                      - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
+              rho_input(k) = 1./((r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
+            enddo
+          enddo
+
+!  we have the moist sounding
+
+!  next, compute the dry sounding using p at the highest level from the
+!  moist sounding and integrating down.
+
+        p_input(nl) = pm_input(nl)
+
+          do k=nl-1,1,-1
+            dz = h_input(k+1)-h_input(k)
+            p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g
+          enddo
+
+!      write(6,*) ' zeroing u input '
+
+        do k=1,nl
+
+          zk(k) = h_input(k)
+          p(k) = pm_input(k)
+          p_dry(k) = p_input(k)
+          theta(k) = th_input(k)
+          rho(k) = rho_input(k)
+          u(k) = u_input(k)
+!          u(k) = 0.
+          v(k) = v_input(k)
+          qv(k) = qv_input(k)
+
+        enddo
+
+     if(debug) then
+      write(6,*) ' sounding '
+      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+      do k=1,nl
+        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k)
+      enddo
+
+     end if
+
+      end subroutine get_sounding
+
+!-------------------------------------------------------
+
+      subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,n,nl,debug )
+      implicit none
+      integer n,nl
+      real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n)
+      logical end_of_file
+      logical debug
+
+      integer k
+
+      open(unit=10,file='input_sounding',form='formatted',status='old')
+      rewind(10)
+      read(10,*) ps, ts, qvs
+      if(debug) then
+        write(6,*) ' input sounding surface parameters '
+        write(6,*) ' surface pressure (mb) ',ps
+        write(6,*) ' surface pot. temp (K) ',ts
+        write(6,*) ' surface mixing ratio (g/kg) ',qvs
+      end if
+
+      end_of_file = .false.
+      k = 0
+
+      do while (.not. end_of_file)
+
+        read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1)
+        k = k+1
+        if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k)
+        go to 110
+ 100    end_of_file = .true.
+ 110    continue
+      enddo
+
+      nl = k
+
+      close(unit=10,status = 'keep')
+
+      end subroutine read_sounding
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_quarter_ss.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_quarter_ss.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_quarter_ss.F	(revision 2744)
@@ -0,0 +1,1233 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!  This MODULE CONTAINS the following routines:
+
+!  initialize_field_test - 1. Set different fields to different constant
+!                             values.  This is only a test.  If the correct
+!                             domain is not found (based upon the "id")
+!                             then a fatal error is issued.               
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize
+
+   USE module_domain
+   USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_timing
+   USE module_configure
+   USE module_init_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER                :: dyn_opt 
+   INTEGER :: idum1, idum2
+
+   CALL nl_get_dyn_opt( 1,dyn_opt )
+   
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF (      dyn_opt .eq. 1 &
+        .or. dyn_opt .eq. 2 &
+        .or. dyn_opt .eq. 3 &
+                                       ) THEN
+     CALL init_domain_rk( grid &
+!
+#include <em_actual_new_args.inc>
+!
+                        )
+
+   ELSE
+     WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     CALL wrf_error_fatal ( ' init_domain: unknown or unimplemented dyn_opt ' )
+   ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+# include <em_dummy_new_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <em_dummy_new_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+   ! Local data
+!****Mars
+    REAL    :: x_param,y_param,rho_param,dilat
+    REAL    :: mulu, mulv, addu, addv
+!****Mars
+   INTEGER, PARAMETER :: nl_max = 1000
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, tk, rho, u, v, qv, pd_in
+   INTEGER :: nl_in
+
+
+   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
+   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
+   REAL    :: xrad, yrad, zrad, rad, delt, cof1, cof2
+!   REAL, EXTERNAL :: interp_0
+   REAL    :: hm, xa
+   REAL    :: pi
+
+!  stuff from original initialization that has been dropped from the Registry 
+   REAL    :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt
+   REAL    :: qvf1, qvf2, pd_surf
+   INTEGER :: it
+   real :: thtmp, ptmp, temp(3)
+
+   LOGICAL :: moisture_init
+   LOGICAL :: stretch_grid, dry_sounding
+
+  INTEGER :: xs , xe , ys , ye
+  REAL :: mtn_ht
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+!!MARS
+ REAL :: lon_input, lat_input, alt_input, tsurf_input
+ INTEGER :: ierr
+!!MARS
+ REAL, DIMENSION(nl_max) :: profdustq,profdustn
+ REAL, DIMENSION(nl_max) :: prescribed_sw,prescribed_lw
+
+      REAL :: pfu, pfd, phm
+      INTEGER :: hypsometric_opt = 1 ! classic
+      !INTEGER :: hypsometric_opt = 2 ! Wee et al. 2012 correction
+
+#ifdef DM_PARALLEL
+#    include <em_data_calls.inc>
+#endif
+
+   call init_module_model_constants
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!MARS : NOFILE      === no mountain
+!!MARS : FILE xa=0.  === a linear slope with elevation hm
+!!MARS : FILE        === mountain height hm, width xa
+  open(unit=22,file='ze_hill',form='formatted',status='old',iostat=ierr)
+  IF (ierr .eq. 0) THEN
+    rewind(22) 
+    read(22,*) hm, xa
+    write(6,*) 'hm, xa ', hm, xa
+    close(22)
+  ENDIF
+!!MARS
+!!MARS
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+   icm = ide/2
+!****Mars
+   jcm = jde/2
+!
+!   xa1  = 5000./500.
+!   xal1 = 4000./500.
+!   pii  = 2.*asin(1.0)
+!   hm1  = 250.
+!!   hm1  = 1000.
+!****Mars
+
+   delt = 3.
+!   delt = 10.
+
+!****Mars
+   stretch_grid = .true.
+!   stretch_grid = .false.
+!****Mars
+!   z_scale = .50
+   z_scale = .40
+   pi = 2.*asin(1.0)
+   write(6,*) ' pi is ',pi
+   nxc = (ide-ids)/2
+   nyc = (jde-jds)/2
+
+!!!MARS
+!!!MARS
+!  open(unit=16,file='input_vert',form='formatted',status='old')
+!  rewind(16) 
+!  read(16,*) delt, z_scale
+!  write(6,*) 'delt, z_scale are  ', delt, z_scale
+!  close(16)
+!!!MARS
+!!!MARS
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+   moisture_init = .true.
+
+    grid%itimestep=0
+
+#ifdef DM_PARALLEL
+   CALL wrf_dm_bcast_bytes( icm , IWORDSIZE )
+   CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE )
+#endif
+
+    CALL nl_set_mminlu(1,'    ')
+    CALL nl_set_iswater(1,0)
+    CALL nl_set_cen_lat(1,40.)
+    CALL nl_set_cen_lon(1,-105.)
+    CALL nl_set_truelat1(1,0.)
+    CALL nl_set_truelat2(1,0.)
+    CALL nl_set_moad_cen_lat (1,0.)
+    CALL nl_set_stand_lon (1,0.)
+    CALL nl_set_map_proj(1,0)
+
+
+!  here we initialize data we currently is not initialized 
+!  in the input data
+
+    DO j = jts, jte
+      DO i = its, ite
+         grid%msft(i,j)     = 1.
+         grid%msfu(i,j)     = 1.
+         grid%msfv(i,j)     = 1.
+         grid%sina(i,j)     = 0.
+         grid%cosa(i,j)     = 1.
+         grid%e(i,j)        = 0.
+         grid%f(i,j)        = 0.
+
+      END DO
+   END DO
+
+    DO j = jts, jte
+    DO k = kts, kte
+      DO i = its, ite
+         grid%em_ww(i,k,j)     = 0.
+      END DO
+   END DO
+   END DO
+
+   grid%step_number = 0
+
+!! set up the grid
+!
+!   IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz)
+!     DO k=1, kde
+!      grid%em_znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+!                                (1.-exp(-1./z_scale))
+!     ENDDO
+!   ELSE
+!     DO k=1, kde
+!      grid%em_znw(k) = 1. - float(k-1)/float(kde-1)
+!     ENDDO
+!   ENDIF
+
+!!MARS
+!!MARS
+  open(unit=12,file='levels',form='formatted',status='old')
+  rewind(12)
+  DO k=1, kde
+  read(12,*) grid%em_znw(k)
+  write(6,*) 'read level ', k,grid%em_znw(k)
+  ENDDO
+  close(12)
+!!MARS
+!!MARS
+   
+
+   DO k=1, kde-1
+    grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+    grid%em_rdnw(k) = 1./grid%em_dnw(k)
+    grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+   ENDDO
+   DO k=2, kde-1
+    grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+    grid%em_rdn(k) = 1./grid%em_dn(k)
+    grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+    grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+   ENDDO
+
+   cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+   cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+   grid%cf1  = grid%em_fnp(2) + cof1
+   grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+   grid%cf3  = cof2       
+
+   grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+   grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+   grid%rdx = 1./config_flags%dx
+   grid%rdy = 1./config_flags%dy
+
+!  get the sounding from the ascii sounding file, first get dry sounding and 
+!  calculate base state
+
+     !!!!
+     !!!! user-modified wind speed
+     !!!!
+     mulu = 1.  !! default 
+     mulv = 1.  !! default
+     addu = 0.  !! default
+     addv = 0.  !! default
+     IF (config_flags%init_MU .ne. 0.) mulu = config_flags%init_MU
+     IF (config_flags%init_MV .ne. 0.) mulv = config_flags%init_MV
+     IF (config_flags%init_U  .ne. 0.) addu = config_flags%init_U
+     IF (config_flags%init_V  .ne. 0.) addv = config_flags%init_V
+     write(6,*) ' coeff for winds: ', mulu, mulv, addu, addv
+
+  dry_sounding = .true.
+  IF ( wrf_dm_on_monitor() ) THEN
+  write(6,*) ' getting dry sounding for base state '
+
+  CALL get_sounding( zk, p_in, pd_in, theta, tk, rho, u, v, qv, dry_sounding, nl_max, nl_in, &
+                        mulu, mulv, addu, addv )
+  ENDIF
+  CALL wrf_dm_bcast_real( zk , nl_max )
+  CALL wrf_dm_bcast_real( p_in , nl_max )
+  CALL wrf_dm_bcast_real( pd_in , nl_max )
+  CALL wrf_dm_bcast_real( theta , nl_max )
+  CALL wrf_dm_bcast_real( tk , nl_max )
+  CALL wrf_dm_bcast_real( rho , nl_max )
+  CALL wrf_dm_bcast_real( u , nl_max )
+  CALL wrf_dm_bcast_real( v , nl_max )
+  CALL wrf_dm_bcast_real( qv , nl_max )
+  CALL wrf_dm_bcast_integer ( nl_in , 1 ) 
+
+  write(6,*) ' returned from reading sounding, nl_in is ',nl_in
+
+!  find ptop for the desired ztop (ztop is input from the namelist),
+!  and find surface pressure
+
+  grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in )
+
+!!MARS
+!!MARS
+  open(unit=14,file='input_coord',form='formatted',status='old')
+  rewind(14)
+  read(14,*) lon_input
+  read(14,*) lat_input
+  close(14)
+  write(6,*) ' lon is ',lon_input
+  write(6,*) ' lat is ',lat_input
+!!MARS
+!!MARS
+
+!!MARS
+!!MARS
+  open(unit=18,file='input_more',form='formatted',status='old')
+  rewind(18)
+  read(18,*) alt_input, tsurf_input
+  close(18)
+  write(6,*) ' alt is ',alt_input
+  write(6,*) ' tsurf is ',tsurf_input
+!!MARS
+!!MARS
+
+  DO j=jts,jte
+  DO i=its,ite
+!!MARS
+IF (ierr .eq. 0) THEN
+  write(6,*) ' IDEALIZED TOPOGRAPHY '
+  IF (xa .ne. 0.) THEN
+      !!!2D hill
+      !grid%ht(i,j) = alt_input + hm/(1.+(float(i-icm)/xa)**2)
+      !    grid%ht(i,j) = hm1*exp(-(( float(i-icm)/xa1)**2))   &
+      !               *( (cos(pii*float(i-icm)/xal1))**2 )
+    IF (hm .gt. 0.) THEN
+      write(6,*) '3D hill. height, width: ',hm,xa
+      write(6,*) 'input sounding is out of the mountain'
+      grid%ht(i,j) = alt_input + hm/(1.+(float(i-icm)/xa)**2+(float(j-jcm)/xa)**2)
+    ELSE IF (hm .lt. 0.) THEN
+      write(6,*) '3D crater. height, width: ',hm,xa
+      write(6,*) 'input sounding is at the bottom of crater'
+      grid%ht(i,j) = (alt_input - hm) + hm/(1.+(float(i-icm)/xa)**2+(float(j-jcm)/xa)**2)
+      !! AS: cannot use same formula as hill because it would force ideal.exe to extrapolate
+      !!       which is not possible given how interp_0 is written
+    ELSE
+      write(6,*) 'Nothing. Height is 0. Flat topography'
+      grid%ht(i,j) = alt_input
+    ENDIF
+  ELSE
+    write(6,*) 'linear slope '
+    write(6,*) 'height ',hm
+    IF (hm .gt. 0.) THEN  
+      grid%ht(i,j) = alt_input + hm * float(i)  
+    ELSE IF (hm .lt. 0.) THEN
+      !! see above, crater case
+      grid%ht(i,j) = (alt_input - hm) + hm * float(i)
+    ELSE
+      write(6,*) 'Nothing. Height is 0. Flat topography'
+      grid%ht(i,j) = alt_input
+    ENDIF
+  ENDIF
+      !!!3D crater    
+      !!        grid%ht(i,j) = hm - hm/(1.+(float(i-icm)/xa)**2+(float(j-jcm)/xa)**2)
+      !!3D crater w/ rims
+      !  x_param = float(i-icm)
+      !  y_param = float(j-jcm)
+      !  dilat = xa/2
+      !  rho_param = sqrt(x_param**2 + y_param**2)
+      !  ! revolution surface ; seed is a fourth order polynom
+      !  grid%ht(i,j) = (rho_param+6*dilat)*(rho_param+10*dilat)
+      !  grid%ht(i,j) = (rho_param-6*dilat)*(rho_param-10*dilat)*grid%ht(i,j)
+      !  ! flat terrain elsewhere - smooth gradient (no abrupt fall)
+      !  grid%ht(i,j) = grid%ht(i,j)*(tanh(rho_param+7*dilat)/2 - tanh(rho_param-7*dilat)/2)
+      !  grid%ht(i,j) = hm - (hm*.4/1500)*grid%ht(i,j)/(dilat**4)
+      !           !NONONONONON  
+      !           !grid%ht(i,j) = grid%ht(i,j) + alt_input  
+      !   !if (rho_param .GE. dilat*10) ht(i,j) = hm
+ELSE
+    write(6,*) ' FLAT SURFACE '
+    grid%ht(i,j) = alt_input
+    !grid%ht(i,j) = 0.
+ENDIF
+    grid%tsk(i,j) = tsurf_input
+    grid%m_tsurf(i,j) = tsurf_input
+!!MARS
+    grid%xlat(i,j) = lat_input
+    grid%xlong(i,j) = lon_input!+float(i)*config_flags%dx/59000.
+    grid%m_emiss(i,j)=0.95
+    grid%m_co2ice(i,j)=0.
+    grid%m_h2oice(i,j)=0.
+!! >> Used for restarts only:
+    grid%m_q2(i,:,j)=0.
+    grid%m_fluxrad(i,j)=0.
+    grid%m_wstar(i,j)=0.
+!! <<
+    write(6,*) 'NOTE TO SELF. slpx and slpy set to 0 which means no slope insolation.'
+    grid%slpx(i,j) = 0.
+    grid%slpy(i,j) = 0.
+   DO k=1,config_flags%num_soil_layers
+    grid%m_tsoil(i,k,j) = 0.
+   ENDDO
+    !!! COMMENT THE LINES BELOW IF YOU DON'T WANT CORIOLIS TERMS
+    !!! cf. doc WRF2008 page 11 for e and f expressions
+    grid%e(i,j) = 2. * EOMEG * COS(pi*lat_input/180.)
+    grid%f(i,j) = 2. * EOMEG * SIN(pi*lat_input/180.)
+    write(6,*) 'CALCULATE CORIOLIS TERM', grid%f(i,j),grid%e(i,j)
+!!MARS
+  ENDDO
+  ENDDO
+
+  xs=ide/2 -3
+  xs=ids   -3
+  xe=xs + 6
+  ys=jde/2 -3
+  ye=ys + 6
+  mtn_ht = 500
+#ifdef MTN
+  DO j=max(ys,jds),min(ye,jde-1)
+  DO i=max(xs,ids),min(xe,ide-1)
+     grid%ht(i,j) = mtn_ht * 0.25 * &
+               ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) * &
+               ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+#ifdef EW_RIDGE
+  DO j=max(ys,jds),min(ye,jde-1)
+  DO i=ids,ide
+     grid%ht(i,j) = mtn_ht * 0.50 * &
+               ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+#ifdef NS_RIDGE
+  DO j=jds,jde
+  DO i=max(xs,ids),min(xe,ide-1)
+     grid%ht(i,j) = mtn_ht * 0.50 * &
+               ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+  DO j=jts,jte
+  DO i=its,ite
+    grid%em_phb(i,1,j) = g * grid%ht(i,j)
+    grid%em_ph0(i,1,j) = g * grid%ht(i,j)
+  ENDDO
+  ENDDO
+
+!!!dans hill_2d OK
+!    grid%em_phb(i,1,j) = g*grid%ht(i,j)
+!    grid%em_php(i,1,j) = 0.
+!    grid%em_ph0(i,1,j) = grid%em_phb(i,1,j)
+
+  DO J = jts, jte
+  DO I = its, ite
+
+    p_surf = interp_0( p_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+    grid%em_mub(i,j) = p_surf-grid%p_top
+
+!  this is dry hydrostatic sounding (base state), so given grid%em_p (coordinate),
+!  interp theta (from interp) and compute 1/rho from eqn. of state
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_pb(i,k,j) = p_level
+
+! OLD METHOD
+!      grid%em_t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
+! NEW METHOD: Wee et al. 2012
+! interpolate temperature. then convert to potential temperature.
+      grid%em_t_init(i,k,j) = interp_0( tk, p_in, p_level, nl_in )
+      !! l un ou l autre pareil
+      grid%em_t_init(i,k,j) = - t0 + (grid%em_t_init(i,k,j) * ((p1000mb/p_level)**rcp))
+      !grid%em_t_init(i,k,j) = - t0 + (grid%em_t_init(i,k,j) * ((610./p_level)**(1.0/3.9)))
+      grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+    ENDDO
+
+!  calc hydrostatic balance (alternatively we could interp the geopotential from the
+!  sounding, but this assures that the base state is in exact hydrostatic balance with
+!  respect to the model eqns.
+
+   IF (hypsometric_opt == 1) THEN
+    DO k  = 2,kte
+      grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+    ENDDO
+   ELSE IF (hypsometric_opt == 2) THEN
+    DO k = 2,kte
+      pfu = grid%em_mub(i,j)*grid%em_znw(k)   + grid%p_top
+      pfd = grid%em_mub(i,j)*grid%em_znw(k-1)   + grid%p_top
+      phm = grid%em_mub(i,j)*grid%em_znu(k-1)   + grid%p_top
+      grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) + grid%em_alb(i,k-1,j)*phm*LOG(pfd/pfu)
+    END DO
+   END IF
+
+
+  ENDDO
+  ENDDO
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    write(6,*) ' ptop is ',grid%p_top
+    write(6,*) ' base state grid%em_mub(1,1), p_surf is ',grid%em_mub(1,1),grid%em_mub(1,1)+grid%p_top
+  ENDIF
+
+!  calculate full state for each column - this includes moisture.
+
+!!!!!MARS MARS
+!  write(6,*) ' getting moist sounding for full state '
+!  dry_sounding = .false.
+  dry_sounding = .true.
+  CALL get_sounding( zk, p_in, pd_in, theta, tk, rho, u, v, qv, dry_sounding, nl_max, nl_in, &
+                              mulu, mulv, addu, addv )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+
+!  At this point grid%p_top is already set. find the DRY mass in the column 
+!  by interpolating the DRY pressure.  
+
+   pd_surf = interp_0( pd_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+
+!  compute the perturbation mass and the full mass
+
+    grid%em_mu_1(i,j) = pd_surf-grid%p_top - grid%em_mub(i,j)
+    grid%em_mu_2(i,j) = grid%em_mu_1(i,j)
+    grid%em_mu0(i,j) = grid%em_mu_1(i,j) + grid%em_mub(i,j)
+
+! given the dry pressure and coordinate system, interp the potential
+! temperature and qv
+
+    do k=1,kde-1
+
+      p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+
+      moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%em_t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
+      grid%em_t_2(i,k,j)          = grid%em_t_1(i,k,j)
+      
+
+    enddo
+
+!  integrate the hydrostatic equation (from the RHS of the bigstep
+!  vertical momentum equation) down from the top to get grid%em_p.
+!  first from the top of the model to the top pressure
+
+    k = kte-1  ! top level
+
+    qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+    qvf2 = 1./(1.+qvf1)
+    qvf1 = qvf1*qvf2
+
+!    grid%em_p(i,k,j) = - 0.5*grid%em_mu_1(i,j)/grid%em_rdnw(k)
+    grid%em_p(i,k,j) = - 0.5*(grid%em_mu_1(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+    qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+    grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+    grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+
+!  down the column
+
+    do k=kte-2,1,-1
+      qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+      qvf2 = 1./(1.+qvf1)
+      qvf1 = qvf1*qvf2
+      grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_1(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+      qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+      grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                  (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+      grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+    enddo
+
+!  this is the hydrostatic equation used in the model after the
+!  small timesteps.  In the model, grid%em_al (inverse density)
+!  is computed from the geopotential.
+
+
+    grid%em_ph_1(i,1,j) = 0.
+   IF (hypsometric_opt == 1) THEN
+    DO k  = 2,kte
+      grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                   (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                    grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+      grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+      grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+    ENDDO
+   ELSE IF (hypsometric_opt == 2) THEN
+
+             ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure.
+             ! Note that al*p approximates Rd*T and dLOG(p) does z.
+             ! Here T varies mostly linear with z, the first-order integration produces better result.
+
+               grid%em_ph_2(i,1,j) = grid%em_phb(i,1,j)
+               DO k = 2,kte
+                  pfu = grid%em_mu0(i,j)*grid%em_znw(k)   + grid%p_top
+                  pfd = grid%em_mu0(i,j)*grid%em_znw(k-1) + grid%p_top
+                  phm = grid%em_mu0(i,j)*grid%em_znu(k-1) + grid%p_top
+                  grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) + grid%em_alt(i,k-1,j)*phm*LOG(pfd/pfu)
+               END DO
+
+               DO k = 1,kte
+                  grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k,j) - grid%em_phb(i,k,j)
+                  grid%em_ph_1(i,k,j) = grid%em_ph_2(i,k,j)
+               END DO
+
+   END IF
+
+
+
+    IF ( wrf_dm_on_monitor() ) THEN
+    if((i==2) .and. (j==2)) then
+     write(6,*) ' grid%em_ph_1 calc ',grid%em_ph_1(2,1,2),grid%em_ph_1(2,2,2),&
+                              grid%em_mu_1(2,2)+grid%em_mub(2,2),grid%em_mu_1(2,2), &
+                              grid%em_alb(2,1,2),grid%em_al(1,2,1),grid%em_rdnw(1)
+    endif
+    ENDIF
+
+  ENDDO
+  ENDDO
+
+!#if 0
+
+!  thermal perturbation to kick off convection
+
+  write(6,*) ' nxc, nyc for perturbation ',nxc,nyc
+  write(6,*) ' delt for perturbation ',delt
+
+  DO J = jts, min(jde-1,jte)
+    yrad = config_flags%dy*float(j-nyc)/10000.
+yrad = 0.
+    DO I = its, min(ide-1,ite)
+      xrad = config_flags%dx*float(i-nxc)/10000.
+xrad = 0.
+      DO K = 1, kte-1
+
+!  put in preturbation theta (bubble) and recalc density.  note,
+!  the mass in the column is not changing, so when theta changes,
+!  we recompute density and geopotential
+
+        zrad = 0.5*(grid%em_ph_1(i,k,j)+grid%em_ph_1(i,k+1,j)  &
+                   +grid%em_phb(i,k,j)+grid%em_phb(i,k+1,j))/g
+        zrad = (zrad-1500.)/1500.
+        RAD=SQRT(xrad*xrad+yrad*yrad+zrad*zrad)
+        IF(RAD <= 1.) THEN
+           grid%em_t_1(i,k,j)=grid%em_t_1(i,k,j)+delt*COS(.5*PI*RAD)**2
+           grid%em_t_2(i,k,j)=grid%em_t_1(i,k,j)
+           qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+           grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                        (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+           grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+        ENDIF
+      ENDDO
+
+!  rebalance hydrostatically
+
+   IF (hypsometric_opt == 1) THEN
+
+      DO k  = 2,kte
+        grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                     (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                      grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+        grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+        grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+      ENDDO
+
+   ELSE IF (hypsometric_opt == 2) THEN
+
+             ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure.
+             ! Note that al*p approximates Rd*T and dLOG(p) does z.
+             ! Here T varies mostly linear with z, the first-order integration produces better result.
+
+               grid%em_ph_2(i,1,j) = grid%em_phb(i,1,j)
+               DO k = 2,kte
+                  pfu = grid%em_mu0(i,j)*grid%em_znw(k)   + grid%p_top
+                  pfd = grid%em_mu0(i,j)*grid%em_znw(k-1) + grid%p_top
+                  phm = grid%em_mu0(i,j)*grid%em_znu(k-1) + grid%p_top
+                  grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) + grid%em_alt(i,k-1,j)*phm*LOG(pfd/pfu)
+               END DO
+
+               DO k = 1,kte
+                  grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k,j) - grid%em_phb(i,k,j)
+                  grid%em_ph_1(i,k,j) = grid%em_ph_2(i,k,j)
+               END DO
+
+   END IF
+
+
+    ENDDO
+  ENDDO
+
+!#endif
+
+   IF ( wrf_dm_on_monitor() ) THEN
+   write(6,*) ' grid%em_mu_1 from comp ', grid%em_mu_1(1,1)
+   write(6,*) ' full state sounding from comp, ph, grid%em_p, grid%em_al, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1)+grid%em_phb(1,k,1), &
+                                      grid%em_p(1,k,1)+grid%em_pb(1,k,1), grid%em_alt(1,k,1), &
+                                      grid%em_t_1(1,k,1)+t0, moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' pert state sounding from comp, grid%em_ph_1, pp, alp, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1), &
+                                      grid%em_p(1,k,1), grid%em_al(1,k,1), &
+                                      grid%em_t_1(1,k,1), moist(1,k,1,P_QV)
+   enddo
+   ENDIF
+
+! interp v
+
+  DO J = jts, jte
+  DO I = its, min(ide-1,ite)
+
+    IF (j == jds) THEN
+      z_at_v = grid%em_phb(i,1,j)/g
+    ELSE IF (j == jde) THEN
+      z_at_v = grid%em_phb(i,1,j-1)/g
+    ELSE
+      z_at_v = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i,1,j-1))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_v, nl_in )
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in )
+      grid%em_v_2(i,k,j) = grid%em_v_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+! interp u
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, ite
+
+    IF (i == ids) THEN
+      z_at_u = grid%em_phb(i,1,j)/g
+    ELSE IF (i == ide) THEN
+      z_at_u = grid%em_phb(i-1,1,j)/g
+    ELSE
+      z_at_u = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i-1,1,j))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_u, nl_in )
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
+      grid%em_u_2(i,k,j) = grid%em_u_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  set w
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte
+  DO I = its, min(ide-1,ite)
+    grid%em_w_1(i,k,j) = 0.
+    grid%em_w_2(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+!  set a few more things
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%h_diabatic(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+  IF ( wrf_dm_on_monitor() ) THEN
+  DO k=1,kte-1
+    grid%em_t_base(k) = grid%em_t_1(1,k,1)
+    grid%qv_base(k) = moist(1,k,1,P_QV)
+    grid%u_base(k) = grid%em_u_1(1,k,1)
+    grid%v_base(k) = grid%em_v_1(1,k,1)
+    grid%z_base(k) = 0.5*(grid%em_phb(1,k,1)+grid%em_phb(1,k+1,1)+grid%em_ph_1(1,k,1)+grid%em_ph_1(1,k+1,1))/g
+  ENDDO
+  ENDIF
+  CALL wrf_dm_bcast_real( grid%em_t_base , kte )
+  CALL wrf_dm_bcast_real( grid%qv_base , kte )
+  CALL wrf_dm_bcast_real( grid%u_base , kte )
+  CALL wrf_dm_bcast_real( grid%v_base , kte )
+  CALL wrf_dm_bcast_real( grid%z_base , kte )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+     thtmp   = grid%em_t_2(i,1,j)+t0
+     ptmp    = grid%em_p(i,1,j)+grid%em_pb(i,1,j)
+     temp(1) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,2,j)+t0
+     ptmp    = grid%em_p(i,2,j)+grid%em_pb(i,2,j)
+     temp(2) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,3,j)+t0
+     ptmp    = grid%em_p(i,3,j)+grid%em_pb(i,3,j)
+     temp(3) = thtmp * (ptmp/p1000mb)**rcp
+
+!!MARS
+!     grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)
+     grid%tmn(I,J)=grid%tsk(I,J)-0.5
+!!!MARS
+!!TODO: passer la valeur a partir des donnees
+!grid%mars_tsoil(I,:,J)=grid%tsk(I,J)
+!!!MARS
+  ENDDO
+  ENDDO
+    IF (planet.eq."prescribed") Then
+      call read_hr(profdustq,profdustn,nl_in)
+      open(unit=17,file="prescribed_sw.txt",action="write")
+      open(unit=18,file="prescribed_lw.txt",action="write")
+      DO k=1,kte!-1
+        p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+        prescribed_sw(k) = interp_0( profdustq, pd_in, p_level, nl_in )
+        prescribed_lw(k) = interp_0( profdustn, pd_in, p_level, nl_in )
+        write (17,*) prescribed_sw(k)
+        write (18,*) prescribed_lw(k)
+      ENDDO
+      close(unit=17)
+      close(unit=18)
+    ENDIF
+
+    if (      ( config_flags%mars == 1  ) &
+         .OR. ( config_flags%mars == 11 ) &
+         .OR. ( config_flags%mars == 12 ) ) then
+      print *, '**** INTERPOLATE HV **** RANK 2 in SCALAR'
+      DO k=1,kte-1
+         p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+         scalar(its:ite,k,jts:jte,2) = interp_0( qv, pd_in, p_level, nl_in )
+         scalar(its:ite,k,jts:jte,3) = 0.
+           !! water ice is set to 0 (was put into water vapor when building prof
+           !from MCD)
+      ENDDO
+      print *, "WATER VAPOR",scalar(its,:,jts,2)
+    endif
+
+ END SUBROUTINE init_domain_rk
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+
+!  test driver for get_sounding
+!
+!      implicit none
+!      integer n
+!      parameter(n = 1000)
+!      real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n)
+!      logical dry
+!      integer nl,k
+!
+!      dry = .false.
+!      dry = .true.
+!      call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl )
+!      write(6,*) ' input levels ',nl
+!      write(6,*) ' sounding '
+!      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+!      do k=1,nl
+!        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k)
+!      enddo
+!      end
+!
+!---------------------------------------------------------------------------
+
+      subroutine get_sounding( zk, p, p_dry, theta, tk, rho, &
+                               u, v, qv, dry, nl_max, nl_in, &
+                               mulu, mulv, addu, addv )
+      implicit none
+
+      integer nl_max, nl_in
+      real zk(nl_max), p(nl_max), theta(nl_max), tk(nl_max), rho(nl_max), &
+           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
+      logical dry
+
+      integer n
+      parameter(n=1000)
+      logical debug
+
+!      parameter( debug = .false.)
+!****Mars
+      parameter( debug = .true.)
+      real mulu, mulv, addu, addv
+
+
+! input sounding data
+
+      real p_surf, th_surf, qv_surf
+      real pi_surf, pi(n)
+      real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n)
+
+      !! special MARS
+      real r_input(n)
+      real cp_input(n)
+      real cv_input(n)
+      real cvpm_input(n)
+      real pfile_input(n)
+      real t_input(n)
+      real rhofile_input(n)
+      !! special MARS
+
+! diagnostics
+
+      real rho_surf, p_input(n), rho_input(n)
+      real pm_input(n)  !  this are for full moist sounding
+
+! local data
+
+      !real p1000mb,cv,cp,r,cvpm,g
+!****Mars
+!      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+!      parameter (p1000mb = 610., r = 192., cp = 844.6, cv = cp-r, cvpm = -cv/cp, g=3.72)
+!      parameter (p1000mb = 610., r = 191., cp = 744.5, cv = cp-r, cvpm = -cv/cp, g=3.72)
+!****Mars
+      integer k, it, nl
+      real qvf, qvf1, dz
+
+!  first, read the sounding
+
+      call read_sounding( p_surf, th_surf, qv_surf, &
+                          h_input, th_input, qv_input, &
+                          u_input, v_input, r_input, cp_input, &
+                          pfile_input, t_input, rhofile_input, n, nl, debug )
+
+
+      !! special MARS
+      do k=1,nl
+        cv_input(k) = cp_input(k) - r_input(k)
+        cvpm_input(k) = - cv_input(k) / cp_input(k)
+      enddo
+      !! special MARS
+
+      if(dry) then
+       do k=1,nl
+         qv_input(k) = 0.
+       enddo
+      endif
+
+      if(debug) write(6,*) ' number of input levels = ',nl
+
+        nl_in = nl
+        if(nl_in .gt. nl_max ) then
+          write(6,*) ' too many levels for input arrays ',nl_in,nl_max
+          call wrf_error_fatal ( ' too many levels for input arrays ' )
+        end if
+
+!  compute diagnostics,
+!  first, convert qv(g/kg) to qv(g/g)
+
+      do k=1,nl
+        qv_input(k) = 0.001*qv_input(k)
+      enddo
+
+      p_surf = 100.*p_surf  ! convert to pascals
+      qvf = 1. + rvovrd*qv_input(1) 
+      rho_surf = 1./((r_d/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
+      pi_surf = (p_surf/p1000mb)**(rcp)
+          !!!!!! rcp variable
+          !rho_surf =  1./((r_input(1)/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm_input(1)))
+          !pi_surf = (p_surf/p1000mb)**(r_input(1)/cp_input(1))
+
+
+      if(debug) then
+        write(6,*) ' surface density is ',rho_surf
+        write(6,*) ' surface pi is      ',pi_surf
+      end if
+
+
+!  integrate moist sounding hydrostatically, starting from the
+!  specified surface pressure
+!  -> first, integrate from surface to lowest level
+
+          qvf = 1. + rvovrd*qv_input(1) 
+          qvf1 = 1. + qv_input(1)
+          rho_input(1) = rho_surf
+          dz = h_input(1)
+          do it=1,10
+!!MARS MARS
+            pm_input(1) = p_surf !&
+!                    - dz*(0.25*rho_surf+0.75*rho_input(1))*g*qvf1  !!! BEURK
+!                    - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1  !! parce que couche 1 tres proche
+            rho_input(1) = 1./((r_d/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm))
+               !!!!!!! rcp variable
+               !rho_input(1) = 1./((r_input(1)/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm_input(1)))
+          enddo
+
+! integrate up the column
+
+          do k=2,nl
+            rho_input(k) = rho_input(k-1)
+            dz = h_input(k)-h_input(k-1)
+               !!!!!!! rcp variable
+               !dz = r_input(k) * t_input(k) * (- p_input(k) + p_input(k-1)) / p_input(k) / g
+               !!dz = - cp_input(k) * (- t_input(k) + t_input(k-1)) / g
+            qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k)))
+            qvf = 1. + rvovrd*qv_input(k)   ! qv is in g/kg here
+
+print *, 'input', pfile_input(k), rhofile_input(k)  
+
+            do it=1,10 !!ou moins??? non. !! trop de rho(k-1) donne une pression trop faible puis crash
+                                          !! mais coeff ci-dessous vont varier la pression calculÃe
+              pm_input(k) = pm_input(k-1) &
+                      - dz*(0.75*rho_input(k)+0.25*rho_input(k-1))*g*qvf1
+                      !- 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
+              rho_input(k) = 1./((r_d/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
+!!
+!! marche pas 
+!!
+!pm_input(k) = pm_input(k-1) &
+!        - 0.5*dz*(1./rho_input(k)+1./rho_input(k-1))*g*qvf1
+!rho_input(k) = (r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm)
+              !!!!!!! rcp variable
+              !rho_input(k) = 1./((r_input(k)/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm_input(k)))
+              !print *, p_input(k), pm_input(k),((r_input(k)/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm_input(k))),k
+print *, it, pm_input(k), rho_input(k), dz
+            enddo
+          enddo
+
+
+!  we have the moist sounding
+
+!  next, compute the dry sounding using p at the highest level from the
+!  moist sounding and integrating down.
+
+        p_input(nl) = pm_input(nl)
+
+          do k=nl-1,1,-1
+            dz = h_input(k+1)-h_input(k)
+            p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g
+          enddo
+
+
+        do k=1,nl
+
+          zk(k) = h_input(k)
+          p(k) = pm_input(k)
+          p_dry(k) = p_input(k)
+          theta(k) = th_input(k)
+          tk(k) = t_input(k)
+          rho(k) = rho_input(k)
+          u(k) = mulu*u_input(k) + addu
+          v(k) = mulv*v_input(k) + addv
+          qv(k) = qv_input(k)
+
+         !!!! direct input from file
+         write(6,*) '*** DIRECT INPUT FROM FILE ***' 
+         p(k) = pfile_input(k)
+         p_dry(k) = pfile_input(k)
+         rho(k) = rhofile_input(k)
+
+        enddo
+
+     if(debug) then
+      write(6,*) ' sounding '
+      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+      do k=1,nl
+        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k)
+      enddo
+
+     end if
+
+      end subroutine get_sounding
+
+!-------------------------------------------------------
+
+      subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,r,cp,p,t,rho,n,nl,debug )
+      implicit none
+      integer n,nl
+      real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n),r(n),cp(n),p(n),t(n),rho(n) 
+      logical end_of_file
+      logical debug
+
+      integer k
+
+      open(unit=10,file='input_sounding',form='formatted',status='old')
+      rewind(10)
+      read(10,*) ps, ts, qvs
+      if(debug) then
+        write(6,*) ' input sounding surface parameters '
+        write(6,*) ' surface pressure (mb) ',ps
+        write(6,*) ' surface pot. temp (K) ',ts
+        write(6,*) ' surface mixing ratio (g/kg) ',qvs
+      end if
+
+      end_of_file = .false.
+      k = 0
+
+      do while (.not. end_of_file)
+
+        read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1)
+        k = k+1
+        if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k)
+        go to 110
+ 100    end_of_file = .true.
+ 110    continue
+      enddo
+
+
+      !!! special MARS
+      open(unit=11,file='input_therm',form='formatted',status='old')
+      rewind(11)
+      end_of_file = .false.
+      k = 0
+      do while (.not. end_of_file)
+
+        read(11,*,end=101) r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1) 
+        write(*,*) k, r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1)
+        k = k+1
+        go to 112
+ 101    end_of_file = .true.
+ 112    continue
+      enddo
+      !!! special MARS
+
+
+
+      nl = k
+
+      close(unit=10,status = 'keep')
+
+      end subroutine read_sounding
+
+      subroutine read_hr(hr_sw,hr_lw,n)
+      implicit none
+      integer n
+      real hr_sw(n),hr_lw(n)
+      logical end_of_file
+
+      integer k
+
+! first element is the surface
+
+      open(unit=11,file='input_hr',form='formatted',status='old')
+      rewind(11)
+      end_of_file = .false.
+      k = 0
+      do while (.not. end_of_file)
+
+        read(11,*,end=102) hr_sw(k+1),hr_lw(k+1)
+        write(*,*) k,hr_sw(k+1),hr_lw(k+1)
+        k = k+1
+        go to 113
+ 102    end_of_file = .true.
+ 113    continue
+      enddo
+
+      close(unit=11,status = 'keep')
+
+      end subroutine read_hr
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_quarter_ss.F_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_quarter_ss.F_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_quarter_ss.F_gcm	(revision 2744)
@@ -0,0 +1,1056 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!  This MODULE CONTAINS the following routines:
+
+!  initialize_field_test - 1. Set different fields to different constant
+!                             values.  This is only a test.  If the correct
+!                             domain is not found (based upon the "id")
+!                             then a fatal error is issued.               
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize
+
+   USE module_domain
+   USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_timing
+   USE module_configure
+   USE module_init_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER                :: dyn_opt 
+   INTEGER :: idum1, idum2
+
+   CALL nl_get_dyn_opt( 1,dyn_opt )
+   
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF (      dyn_opt .eq. 1 &
+        .or. dyn_opt .eq. 2 &
+        .or. dyn_opt .eq. 3 &
+                                       ) THEN
+     CALL init_domain_rk( grid &
+!
+#include <em_actual_new_args.inc>
+!
+                        )
+
+   ELSE
+     WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     CALL wrf_error_fatal ( ' init_domain: unknown or unimplemented dyn_opt ' )
+   ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+# include <em_dummy_new_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <em_dummy_new_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+   ! Local data
+!****Mars
+    REAL    :: x_param,y_param,rho_param,dilat
+    REAL    :: mulu, mulv, addu, addv
+!****Mars
+   INTEGER, PARAMETER :: nl_max = 1000
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in
+   INTEGER :: nl_in
+
+
+   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
+   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
+   REAL    :: z_scale, xrad, yrad, zrad, rad, delt, cof1, cof2
+!   REAL, EXTERNAL :: interp_0
+   REAL    :: hm, xa
+   REAL    :: pi
+
+!  stuff from original initialization that has been dropped from the Registry 
+   REAL    :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt
+   REAL    :: qvf1, qvf2, pd_surf
+   INTEGER :: it
+   real :: thtmp, ptmp, temp(3)
+
+   LOGICAL :: moisture_init
+   LOGICAL :: stretch_grid, dry_sounding
+
+  INTEGER :: xs , xe , ys , ye
+  REAL :: mtn_ht
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+!!MARS
+ REAL :: lon_input, lat_input, alt_input, tsurf_input
+!!MARS
+
+
+#ifdef DM_PARALLEL
+#    include <em_data_calls.inc>
+#endif
+
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!MARS : mountain
+!!MARS : mountain ex. hm = 2000. xa = 6.0
+  open(unit=22,file='ze_hill',form='formatted',status='old')
+  rewind(22) 
+  read(22,*) hm, xa
+  write(6,*) 'height, width ', hm, xa
+  close(22)
+!!MARS
+!!MARS
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+   icm = ide/2
+!****Mars
+   jcm = jde/2
+!
+!   xa1  = 5000./500.
+!   xal1 = 4000./500.
+!   pii  = 2.*asin(1.0)
+!   hm1  = 250.
+!!   hm1  = 1000.
+!****Mars
+
+   delt = 3.
+!   delt = 10.
+
+!****Mars
+   stretch_grid = .true.
+!   stretch_grid = .false.
+!****Mars
+!   z_scale = .50
+   z_scale = .40
+   pi = 2.*asin(1.0)
+   write(6,*) ' pi is ',pi
+   nxc = (ide-ids)/2
+   nyc = (jde-jds)/2
+
+!!!MARS
+!!!MARS
+!  open(unit=16,file='input_vert',form='formatted',status='old')
+!  rewind(16) 
+!  read(16,*) delt, z_scale
+!  write(6,*) 'delt, z_scale are  ', delt, z_scale
+!  close(16)
+!!!MARS
+!!!MARS
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+   moisture_init = .true.
+
+    grid%itimestep=0
+
+#ifdef DM_PARALLEL
+   CALL wrf_dm_bcast_bytes( icm , IWORDSIZE )
+   CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE )
+#endif
+
+    CALL nl_set_mminlu(1,'    ')
+    CALL nl_set_iswater(1,0)
+    CALL nl_set_cen_lat(1,40.)
+    CALL nl_set_cen_lon(1,-105.)
+    CALL nl_set_truelat1(1,0.)
+    CALL nl_set_truelat2(1,0.)
+    CALL nl_set_moad_cen_lat (1,0.)
+    CALL nl_set_stand_lon (1,0.)
+    CALL nl_set_map_proj(1,0)
+
+
+!  here we initialize data we currently is not initialized 
+!  in the input data
+
+    DO j = jts, jte
+      DO i = its, ite
+         grid%msft(i,j)     = 1.
+         grid%msfu(i,j)     = 1.
+         grid%msfv(i,j)     = 1.
+         grid%sina(i,j)     = 0.
+         grid%cosa(i,j)     = 1.
+         grid%e(i,j)        = 0.
+         grid%f(i,j)        = 0.         !! MARS: put coriolis here if needed
+
+      END DO
+   END DO
+
+    DO j = jts, jte
+    DO k = kts, kte
+      DO i = its, ite
+         grid%em_ww(i,k,j)     = 0.
+      END DO
+   END DO
+   END DO
+
+   grid%step_number = 0
+
+!! set up the grid
+!
+!   IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz)
+!     DO k=1, kde
+!      grid%em_znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+!                                (1.-exp(-1./z_scale))
+!     ENDDO
+!   ELSE
+!     DO k=1, kde
+!      grid%em_znw(k) = 1. - float(k-1)/float(kde-1)
+!     ENDDO
+!   ENDIF
+
+!!MARS
+!!MARS
+  open(unit=12,file='levels',form='formatted',status='old')
+  rewind(12)
+  DO k=1, kde
+  read(12,*) grid%em_znw(k)
+  write(6,*) 'read level ', k,grid%em_znw(k)
+  ENDDO
+  close(12)
+!!MARS
+!!MARS
+   
+
+   DO k=1, kde-1
+    grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+    grid%em_rdnw(k) = 1./grid%em_dnw(k)
+    grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+   ENDDO
+   DO k=2, kde-1
+    grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+    grid%em_rdn(k) = 1./grid%em_dn(k)
+    grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+    grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+   ENDDO
+
+   cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+   cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+   grid%cf1  = grid%em_fnp(2) + cof1
+   grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+   grid%cf3  = cof2       
+
+   grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+   grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+   grid%rdx = 1./config_flags%dx
+   grid%rdy = 1./config_flags%dy
+
+!  get the sounding from the ascii sounding file, first get dry sounding and 
+!  calculate base state
+
+     !!!!
+     !!!! user-modified wind speed
+     !!!!
+     mulu = 1.  !! default 
+     mulv = 1.  !! default
+     addu = 0.  !! default
+     addv = 0.  !! default
+     IF (config_flags%init_MU .ne. 0.) mulu = config_flags%init_MU
+     IF (config_flags%init_MV .ne. 0.) mulv = config_flags%init_MV
+     IF (config_flags%init_U  .ne. 0.) addu = config_flags%init_U
+     IF (config_flags%init_V  .ne. 0.) addv = config_flags%init_V
+     write(6,*) ' coeff for winds: ', mulu, mulv, addu, addv
+
+  dry_sounding = .true.
+  IF ( wrf_dm_on_monitor() ) THEN
+  write(6,*) ' getting dry sounding for base state '
+
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in, &
+                        mulu, mulv, addu, addv )
+  ENDIF
+  CALL wrf_dm_bcast_real( zk , nl_max )
+  CALL wrf_dm_bcast_real( p_in , nl_max )
+  CALL wrf_dm_bcast_real( pd_in , nl_max )
+  CALL wrf_dm_bcast_real( theta , nl_max )
+  CALL wrf_dm_bcast_real( rho , nl_max )
+  CALL wrf_dm_bcast_real( u , nl_max )
+  CALL wrf_dm_bcast_real( v , nl_max )
+  CALL wrf_dm_bcast_real( qv , nl_max )
+  CALL wrf_dm_bcast_integer ( nl_in , 1 ) 
+
+  write(6,*) ' returned from reading sounding, nl_in is ',nl_in
+
+!  find ptop for the desired ztop (ztop is input from the namelist),
+!  and find surface pressure
+
+  grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in )
+
+!!MARS
+!!MARS
+  open(unit=14,file='input_coord',form='formatted',status='old')
+  rewind(14)
+  read(14,*) lon_input
+  read(14,*) lat_input
+  close(14)
+  write(6,*) ' lon is ',lon_input
+  write(6,*) ' lat is ',lat_input
+!!MARS
+!!MARS
+
+!!MARS
+!!MARS
+  open(unit=18,file='input_more',form='formatted',status='old')
+  rewind(18)
+  read(18,*) alt_input, tsurf_input
+  close(18)
+  write(6,*) ' alt is ',alt_input
+  write(6,*) ' tsurf is ',tsurf_input
+!!MARS
+!!MARS
+
+  DO j=jts,jte
+  DO i=its,ite
+!!MARS
+    grid%ht(i,j) = alt_input
+      ! flat surface
+      !!    grid%ht(i,j) = 0.
+      !    grid%ht(i,j) = hm1*exp(-(( float(i-icm)/xa1)**2))   &
+      !               *( (cos(pii*float(i-icm)/xal1))**2 )
+      !****Mars
+      !!3D hill
+      !        grid%ht(i,j) = hm/(1.+(float(i-icm)/xa)**2+(float(j-jcm)/xa)**2)
+
+!!2D hill
+grid%ht(i,j) = alt_input + hm/(1.+(float(i-icm)/xa)**2)
+
+      !!!3D crater    
+      !!        grid%ht(i,j) = hm - hm/(1.+(float(i-icm)/xa)**2+(float(j-jcm)/xa)**2)
+      !!3D crater w/ rims
+      !  x_param = float(i-icm)
+      !  y_param = float(j-jcm)
+      !  dilat = xa/2
+      !  rho_param = sqrt(x_param**2 + y_param**2)
+      !  ! revolution surface ; seed is a fourth order polynom
+      !  grid%ht(i,j) = (rho_param+6*dilat)*(rho_param+10*dilat)
+      !  grid%ht(i,j) = (rho_param-6*dilat)*(rho_param-10*dilat)*grid%ht(i,j)
+      !  ! flat terrain elsewhere - smooth gradient (no abrupt fall)
+      !  grid%ht(i,j) = grid%ht(i,j)*(tanh(rho_param+7*dilat)/2 - tanh(rho_param-7*dilat)/2)
+      !  grid%ht(i,j) = hm - (hm*.4/1500)*grid%ht(i,j)/(dilat**4)
+      !           !NONONONONON  
+      !           !grid%ht(i,j) = grid%ht(i,j) + alt_input  
+      !   !if (rho_param .GE. dilat*10) ht(i,j) = hm
+
+    grid%tsk(i,j) = tsurf_input
+!!MARS
+    grid%xlat(i,j) = lat_input
+    grid%xlong(i,j) = lon_input!+float(i)*config_flags%dx/59000.
+    grid%mars_emiss(i,j)=0.95
+    grid%mars_cice(i,j)=0.
+    grid%slpx(i,j) = 0.
+    grid%slpy(i,j) = 0.
+!!MARS
+  ENDDO
+  ENDDO
+
+  xs=ide/2 -3
+  xs=ids   -3
+  xe=xs + 6
+  ys=jde/2 -3
+  ye=ys + 6
+  mtn_ht = 500
+#ifdef MTN
+  DO j=max(ys,jds),min(ye,jde-1)
+  DO i=max(xs,ids),min(xe,ide-1)
+     grid%ht(i,j) = mtn_ht * 0.25 * &
+               ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) * &
+               ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+#ifdef EW_RIDGE
+  DO j=max(ys,jds),min(ye,jde-1)
+  DO i=ids,ide
+     grid%ht(i,j) = mtn_ht * 0.50 * &
+               ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+#ifdef NS_RIDGE
+  DO j=jds,jde
+  DO i=max(xs,ids),min(xe,ide-1)
+     grid%ht(i,j) = mtn_ht * 0.50 * &
+               ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+  DO j=jts,jte
+  DO i=its,ite
+    grid%em_phb(i,1,j) = g * grid%ht(i,j)
+    grid%em_ph0(i,1,j) = g * grid%ht(i,j)
+  ENDDO
+  ENDDO
+
+!!!dans hill_2d OK
+!    grid%em_phb(i,1,j) = g*grid%ht(i,j)
+!    grid%em_php(i,1,j) = 0.
+!    grid%em_ph0(i,1,j) = grid%em_phb(i,1,j)
+
+  DO J = jts, jte
+  DO I = its, ite
+
+    p_surf = interp_0( p_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+    grid%em_mub(i,j) = p_surf-grid%p_top
+
+!  this is dry hydrostatic sounding (base state), so given grid%em_p (coordinate),
+!  interp theta (from interp) and compute 1/rho from eqn. of state
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_pb(i,k,j) = p_level
+      grid%em_t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
+      grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+    ENDDO
+
+!  calc hydrostatic balance (alternatively we could interp the geopotential from the
+!  sounding, but this assures that the base state is in exact hydrostatic balance with
+!  respect to the model eqns.
+
+    DO k  = 2,kte
+      grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    write(6,*) ' ptop is ',grid%p_top
+    write(6,*) ' base state grid%em_mub(1,1), p_surf is ',grid%em_mub(1,1),grid%em_mub(1,1)+grid%p_top
+  ENDIF
+
+!  calculate full state for each column - this includes moisture.
+
+!!!!!MARS MARS
+!  write(6,*) ' getting moist sounding for full state '
+!  dry_sounding = .false.
+  dry_sounding = .true.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in, &
+                              mulu, mulv, addu, addv )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+
+!  At this point grid%p_top is already set. find the DRY mass in the column 
+!  by interpolating the DRY pressure.  
+
+   pd_surf = interp_0( pd_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+
+!  compute the perturbation mass and the full mass
+
+    grid%em_mu_1(i,j) = pd_surf-grid%p_top - grid%em_mub(i,j)
+    grid%em_mu_2(i,j) = grid%em_mu_1(i,j)
+    grid%em_mu0(i,j) = grid%em_mu_1(i,j) + grid%em_mub(i,j)
+
+! given the dry pressure and coordinate system, interp the potential
+! temperature and qv
+
+    do k=1,kde-1
+
+      p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+
+      moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%em_t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
+      grid%em_t_2(i,k,j)          = grid%em_t_1(i,k,j)
+      
+
+    enddo
+
+!  integrate the hydrostatic equation (from the RHS of the bigstep
+!  vertical momentum equation) down from the top to get grid%em_p.
+!  first from the top of the model to the top pressure
+
+    k = kte-1  ! top level
+
+    qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+    qvf2 = 1./(1.+qvf1)
+    qvf1 = qvf1*qvf2
+
+!    grid%em_p(i,k,j) = - 0.5*grid%em_mu_1(i,j)/grid%em_rdnw(k)
+    grid%em_p(i,k,j) = - 0.5*(grid%em_mu_1(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+    qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+    grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+    grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+
+!  down the column
+
+    do k=kte-2,1,-1
+      qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+      qvf2 = 1./(1.+qvf1)
+      qvf1 = qvf1*qvf2
+      grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_1(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+      qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+      grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                  (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+      grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+    enddo
+
+!  this is the hydrostatic equation used in the model after the
+!  small timesteps.  In the model, grid%em_al (inverse density)
+!  is computed from the geopotential.
+
+
+    grid%em_ph_1(i,1,j) = 0.
+    DO k  = 2,kte
+      grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                   (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                    grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+      grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+      grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+    ENDDO
+
+    IF ( wrf_dm_on_monitor() ) THEN
+    if((i==2) .and. (j==2)) then
+     write(6,*) ' grid%em_ph_1 calc ',grid%em_ph_1(2,1,2),grid%em_ph_1(2,2,2),&
+                              grid%em_mu_1(2,2)+grid%em_mub(2,2),grid%em_mu_1(2,2), &
+                              grid%em_alb(2,1,2),grid%em_al(1,2,1),grid%em_rdnw(1)
+    endif
+    ENDIF
+
+  ENDDO
+  ENDDO
+
+!#if 0
+
+!  thermal perturbation to kick off convection
+
+  write(6,*) ' nxc, nyc for perturbation ',nxc,nyc
+  write(6,*) ' delt for perturbation ',delt
+
+  DO J = jts, min(jde-1,jte)
+    yrad = config_flags%dy*float(j-nyc)/10000.
+yrad = 0.
+    DO I = its, min(ide-1,ite)
+      xrad = config_flags%dx*float(i-nxc)/10000.
+xrad = 0.
+      DO K = 1, kte-1
+
+!  put in preturbation theta (bubble) and recalc density.  note,
+!  the mass in the column is not changing, so when theta changes,
+!  we recompute density and geopotential
+
+        zrad = 0.5*(grid%em_ph_1(i,k,j)+grid%em_ph_1(i,k+1,j)  &
+                   +grid%em_phb(i,k,j)+grid%em_phb(i,k+1,j))/g
+        zrad = (zrad-1500.)/1500.
+        RAD=SQRT(xrad*xrad+yrad*yrad+zrad*zrad)
+        IF(RAD <= 1.) THEN
+           grid%em_t_1(i,k,j)=grid%em_t_1(i,k,j)+delt*COS(.5*PI*RAD)**2
+           grid%em_t_2(i,k,j)=grid%em_t_1(i,k,j)
+           qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+           grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                        (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+           grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+        ENDIF
+      ENDDO
+
+!  rebalance hydrostatically
+
+      DO k  = 2,kte
+        grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                     (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                      grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+        grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+        grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+      ENDDO
+
+    ENDDO
+  ENDDO
+
+!#endif
+
+   IF ( wrf_dm_on_monitor() ) THEN
+   write(6,*) ' grid%em_mu_1 from comp ', grid%em_mu_1(1,1)
+   write(6,*) ' full state sounding from comp, ph, grid%em_p, grid%em_al, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1)+grid%em_phb(1,k,1), &
+                                      grid%em_p(1,k,1)+grid%em_pb(1,k,1), grid%em_alt(1,k,1), &
+                                      grid%em_t_1(1,k,1)+t0, moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' pert state sounding from comp, grid%em_ph_1, pp, alp, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1), &
+                                      grid%em_p(1,k,1), grid%em_al(1,k,1), &
+                                      grid%em_t_1(1,k,1), moist(1,k,1,P_QV)
+   enddo
+   ENDIF
+
+! interp v
+
+  DO J = jts, jte
+  DO I = its, min(ide-1,ite)
+
+    IF (j == jds) THEN
+      z_at_v = grid%em_phb(i,1,j)/g
+    ELSE IF (j == jde) THEN
+      z_at_v = grid%em_phb(i,1,j-1)/g
+    ELSE
+      z_at_v = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i,1,j-1))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_v, nl_in )
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in )
+      grid%em_v_2(i,k,j) = grid%em_v_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+! interp u
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, ite
+
+    IF (i == ids) THEN
+      z_at_u = grid%em_phb(i,1,j)/g
+    ELSE IF (i == ide) THEN
+      z_at_u = grid%em_phb(i-1,1,j)/g
+    ELSE
+      z_at_u = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i-1,1,j))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_u, nl_in )
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
+      grid%em_u_2(i,k,j) = grid%em_u_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  set w
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte
+  DO I = its, min(ide-1,ite)
+    grid%em_w_1(i,k,j) = 0.
+    grid%em_w_2(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+!  set a few more things
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%h_diabatic(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+  IF ( wrf_dm_on_monitor() ) THEN
+  DO k=1,kte-1
+    grid%em_t_base(k) = grid%em_t_1(1,k,1)
+    grid%qv_base(k) = moist(1,k,1,P_QV)
+    grid%u_base(k) = grid%em_u_1(1,k,1)
+    grid%v_base(k) = grid%em_v_1(1,k,1)
+    grid%z_base(k) = 0.5*(grid%em_phb(1,k,1)+grid%em_phb(1,k+1,1)+grid%em_ph_1(1,k,1)+grid%em_ph_1(1,k+1,1))/g
+  ENDDO
+  ENDIF
+  CALL wrf_dm_bcast_real( grid%em_t_base , kte )
+  CALL wrf_dm_bcast_real( grid%qv_base , kte )
+  CALL wrf_dm_bcast_real( grid%u_base , kte )
+  CALL wrf_dm_bcast_real( grid%v_base , kte )
+  CALL wrf_dm_bcast_real( grid%z_base , kte )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+     thtmp   = grid%em_t_2(i,1,j)+t0
+     ptmp    = grid%em_p(i,1,j)+grid%em_pb(i,1,j)
+     temp(1) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,2,j)+t0
+     ptmp    = grid%em_p(i,2,j)+grid%em_pb(i,2,j)
+     temp(2) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,3,j)+t0
+     ptmp    = grid%em_p(i,3,j)+grid%em_pb(i,3,j)
+     temp(3) = thtmp * (ptmp/p1000mb)**rcp
+
+!!MARS
+!     grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)
+     grid%tmn(I,J)=grid%tsk(I,J)-0.5
+!!!MARS
+!!TODO: passer la valeur a partir des donnees
+!grid%mars_tsoil(I,:,J)=grid%tsk(I,J)
+!!!MARS
+  ENDDO
+  ENDDO
+
+ END SUBROUTINE init_domain_rk
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+
+!  test driver for get_sounding
+!
+!      implicit none
+!      integer n
+!      parameter(n = 1000)
+!      real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n)
+!      logical dry
+!      integer nl,k
+!
+!      dry = .false.
+!      dry = .true.
+!      call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl )
+!      write(6,*) ' input levels ',nl
+!      write(6,*) ' sounding '
+!      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+!      do k=1,nl
+!        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k)
+!      enddo
+!      end
+!
+!---------------------------------------------------------------------------
+
+      subroutine get_sounding( zk, p, p_dry, theta, rho, &
+                               u, v, qv, dry, nl_max, nl_in, &
+                               mulu, mulv, addu, addv )
+      implicit none
+
+      integer nl_max, nl_in
+      real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), &
+           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
+      logical dry
+
+      integer n
+      parameter(n=1000)
+      logical debug
+
+!      parameter( debug = .false.)
+!****Mars
+      parameter( debug = .true.)
+      real mulu, mulv, addu, addv
+
+
+! input sounding data
+
+      real p_surf, th_surf, qv_surf
+      real pi_surf, pi(n)
+      real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n)
+
+      !! special MARS
+      real r_input(n)
+      real cp_input(n)
+      real cv_input(n)
+      real cvpm_input(n)
+      real pfile_input(n)
+      real t_input(n)
+      real rhofile_input(n)
+      !! special MARS
+
+! diagnostics
+
+      real rho_surf, p_input(n), rho_input(n)
+      real pm_input(n)  !  this are for full moist sounding
+
+! local data
+
+      real p1000mb,cv,cp,r,cvpm,g
+!****Mars
+!      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+!      parameter (p1000mb = 610., r = 192., cp = 844.6, cv = cp-r, cvpm = -cv/cp, g=3.72)
+      parameter (p1000mb = 610., r = 191., cp = 744.5, cv = cp-r, cvpm = -cv/cp, g=3.72)
+!****Mars
+      integer k, it, nl
+      real qvf, qvf1, dz
+
+!  first, read the sounding
+
+      call read_sounding( p_surf, th_surf, qv_surf, &
+                          h_input, th_input, qv_input, u_input, v_input, r_input, cp_input, pfile_input, t_input, rhofile_input, n, nl, debug )
+
+
+      !! special MARS
+      do k=1,nl
+        cv_input(k) = cp_input(k) - r_input(k)
+        cvpm_input(k) = - cv_input(k) / cp_input(k)
+      enddo
+      !! special MARS
+
+      if(dry) then
+       do k=1,nl
+         qv_input(k) = 0.
+       enddo
+      endif
+
+      if(debug) write(6,*) ' number of input levels = ',nl
+
+        nl_in = nl
+        if(nl_in .gt. nl_max ) then
+          write(6,*) ' too many levels for input arrays ',nl_in,nl_max
+          call wrf_error_fatal ( ' too many levels for input arrays ' )
+        end if
+
+!  compute diagnostics,
+!  first, convert qv(g/kg) to qv(g/g)
+
+      do k=1,nl
+        qv_input(k) = 0.001*qv_input(k)
+      enddo
+
+      p_surf = 100.*p_surf  ! convert to pascals
+      qvf = 1. + rvovrd*qv_input(1) 
+      rho_surf = 1./((r/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
+      pi_surf = (p_surf/p1000mb)**(r/cp)
+          !!!!!! rcp variable
+          !rho_surf =  1./((r_input(1)/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm_input(1)))
+          !pi_surf = (p_surf/p1000mb)**(r_input(1)/cp_input(1))
+
+
+      if(debug) then
+        write(6,*) ' surface density is ',rho_surf
+        write(6,*) ' surface pi is      ',pi_surf
+      end if
+
+
+!  integrate moist sounding hydrostatically, starting from the
+!  specified surface pressure
+!  -> first, integrate from surface to lowest level
+
+          qvf = 1. + rvovrd*qv_input(1) 
+          qvf1 = 1. + qv_input(1)
+          rho_input(1) = rho_surf
+          dz = h_input(1)
+          do it=1,10
+!!MARS MARS
+            pm_input(1) = p_surf !&
+!                    - dz*(0.25*rho_surf+0.75*rho_input(1))*g*qvf1  !!! BEURK
+!                    - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1  !! parce que couche 1 tres proche
+            rho_input(1) = 1./((r/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm))
+               !!!!!!! rcp variable
+               !rho_input(1) = 1./((r_input(1)/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm_input(1)))
+          enddo
+
+! integrate up the column
+
+          do k=2,nl
+            rho_input(k) = rho_input(k-1)
+            dz = h_input(k)-h_input(k-1)
+               !!!!!!! rcp variable
+               !dz = r_input(k) * t_input(k) * (- p_input(k) + p_input(k-1)) / p_input(k) / g
+               !!dz = - cp_input(k) * (- t_input(k) + t_input(k-1)) / g
+            qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k)))
+            qvf = 1. + rvovrd*qv_input(k)   ! qv is in g/kg here
+
+print *, 'input', pfile_input(k), rhofile_input(k)  
+
+            do it=1,10 !!ou moins??? non. !! trop de rho(k-1) donne une pression trop faible puis crash
+                                          !! mais coeff ci-dessous vont varier la pression calculÃe
+              pm_input(k) = pm_input(k-1) &
+                      - dz*(0.75*rho_input(k)+0.25*rho_input(k-1))*g*qvf1
+                      !- 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
+              rho_input(k) = 1./((r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
+!!
+!! marche pas 
+!!
+!pm_input(k) = pm_input(k-1) &
+!        - 0.5*dz*(1./rho_input(k)+1./rho_input(k-1))*g*qvf1
+!rho_input(k) = (r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm)
+              !!!!!!! rcp variable
+              !rho_input(k) = 1./((r_input(k)/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm_input(k)))
+              !print *, p_input(k), pm_input(k),((r_input(k)/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm_input(k))),k
+print *, it, pm_input(k), rho_input(k), dz
+            enddo
+          enddo
+
+
+!  we have the moist sounding
+
+!  next, compute the dry sounding using p at the highest level from the
+!  moist sounding and integrating down.
+
+        p_input(nl) = pm_input(nl)
+
+          do k=nl-1,1,-1
+            dz = h_input(k+1)-h_input(k)
+            p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g
+          enddo
+
+
+        do k=1,nl
+
+          zk(k) = h_input(k)
+          p(k) = pm_input(k)
+          p_dry(k) = p_input(k)
+          theta(k) = th_input(k)
+          rho(k) = rho_input(k)
+          u(k) = mulu*u_input(k) + addu
+          v(k) = mulv*v_input(k) + addv
+          qv(k) = qv_input(k)
+
+         !!!! direct input from file
+         write(6,*) '*** DIRECT INPUT FROM FILE ***' 
+         p(k) = pfile_input(k)
+         p_dry(k) = pfile_input(k)
+         rho(k) = rhofile_input(k)
+
+        enddo
+
+     if(debug) then
+      write(6,*) ' sounding '
+      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+      do k=1,nl
+        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k)
+      enddo
+
+     end if
+
+      end subroutine get_sounding
+
+!-------------------------------------------------------
+
+      subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,r,cp,p,t,rho,n,nl,debug )
+      implicit none
+      integer n,nl
+      real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n),r(n),cp(n),p(n),t(n),rho(n) 
+      logical end_of_file
+      logical debug
+
+      integer k
+
+      open(unit=10,file='input_sounding',form='formatted',status='old')
+      rewind(10)
+      read(10,*) ps, ts, qvs
+      if(debug) then
+        write(6,*) ' input sounding surface parameters '
+        write(6,*) ' surface pressure (mb) ',ps
+        write(6,*) ' surface pot. temp (K) ',ts
+        write(6,*) ' surface mixing ratio (g/kg) ',qvs
+      end if
+
+      end_of_file = .false.
+      k = 0
+
+      do while (.not. end_of_file)
+
+        read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1)
+        k = k+1
+        if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k)
+        go to 110
+ 100    end_of_file = .true.
+ 110    continue
+      enddo
+
+
+      !!! special MARS
+      open(unit=11,file='input_therm',form='formatted',status='old')
+      rewind(11)
+      end_of_file = .false.
+      k = 0
+      do while (.not. end_of_file)
+
+        read(11,*,end=101) r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1) 
+        write(*,*) k, r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1)
+        k = k+1
+        go to 112
+ 101    end_of_file = .true.
+ 112    continue
+      enddo
+      !!! special MARS
+
+
+
+      nl = k
+
+      close(unit=10,status = 'keep')
+
+      end subroutine read_sounding
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_quarter_ss.F_ref
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_quarter_ss.F_ref	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_quarter_ss.F_ref	(revision 2744)
@@ -0,0 +1,904 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!  This MODULE CONTAINS the following routines:
+
+!  initialize_field_test - 1. Set different fields to different constant
+!                             values.  This is only a test.  If the correct
+!                             domain is not found (based upon the "id")
+!                             then a fatal error is issued.               
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize
+
+   USE module_domain
+   USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_timing
+   USE module_configure
+   USE module_init_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER                :: dyn_opt 
+   INTEGER :: idum1, idum2
+
+   CALL nl_get_dyn_opt( 1, dyn_opt )
+   
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF (      dyn_opt .eq. 1 &
+        .or. dyn_opt .eq. 2 &
+        .or. dyn_opt .eq. 3 &
+                                       ) THEN
+     CALL init_domain_rk( grid &
+!
+#include <em_actual_new_args.inc>
+!
+                        )
+
+   ELSE
+     WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     CALL wrf_error_fatal ( ' init_domain: unknown or unimplemented dyn_opt ' )
+   ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+# include <em_dummy_new_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <em_dummy_new_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+   ! Local data
+
+   INTEGER, PARAMETER :: nl_max = 1000
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in
+   INTEGER :: nl_in
+
+
+   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
+   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
+   REAL    :: z_scale, xrad, yrad, zrad, rad, delt, cof1, cof2
+!   REAL, EXTERNAL :: interp_0
+   REAL    :: hm
+   REAL    :: pi
+
+!  stuff from original initialization that has been dropped from the Registry 
+   REAL    :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt
+   REAL    :: qvf1, qvf2, pd_surf
+   INTEGER :: it
+   real :: thtmp, ptmp, temp(3)
+
+   LOGICAL :: moisture_init
+   LOGICAL :: stretch_grid, dry_sounding
+
+  INTEGER :: xs , xe , ys , ye
+  REAL :: mtn_ht
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+!!MARS
+ REAL :: lon_input, lat_input, alt_input, tsurf_input
+!!MARS
+
+
+#ifdef DM_PARALLEL
+#    include <em_data_calls.inc>
+#endif
+
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+
+   stretch_grid = .true.
+!   stretch_grid = .false.
+
+   delt = 3.
+!   delt = 10.
+!   z_scale = .50
+   z_scale = .40
+
+!!!MARS
+!!!MARS
+!  open(unit=16,file='input_vert',form='formatted',status='old')
+!  rewind(16) 
+!  read(16,*) delt, z_scale
+!  write(6,*) 'delt, z_scale are  ', delt, z_scale
+!  close(16)
+!!!MARS
+!!!MARS
+
+   pi = 2.*asin(1.0)
+   write(6,*) ' pi is ',pi
+   nxc = (ide-ids)/2
+   nyc = (jde-jds)/2
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+   moisture_init = .true.
+
+    grid%itimestep=0
+
+#ifdef DM_PARALLEL
+   CALL wrf_dm_bcast_bytes( icm , IWORDSIZE )
+   CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE )
+#endif
+
+    CALL nl_set_mminlu(1, '    ')
+    CALL nl_set_iswater(1,0)
+    CALL nl_set_cen_lat(1,40.)
+    CALL nl_set_cen_lon(1,-105.)
+    CALL nl_set_truelat1(1,0.)
+    CALL nl_set_truelat2(1,0.)
+    CALL nl_set_moad_cen_lat (1,0.)
+    CALL nl_set_stand_lon (1,0.)
+    CALL nl_set_map_proj(1,0)
+
+
+!  here we initialize data we currently is not initialized 
+!  in the input data
+
+    DO j = jts, jte
+      DO i = its, ite
+         grid%msft(i,j)     = 1.
+         grid%msfu(i,j)     = 1.
+         grid%msfv(i,j)     = 1.
+         grid%sina(i,j)     = 0.
+         grid%cosa(i,j)     = 1.
+         grid%e(i,j)        = 0.
+         grid%f(i,j)        = 0.         !! MARS: put coriolis here if needed
+
+      END DO
+   END DO
+
+    DO j = jts, jte
+    DO k = kts, kte
+      DO i = its, ite
+         grid%em_ww(i,k,j)     = 0.
+      END DO
+   END DO
+   END DO
+
+   grid%step_number = 0
+
+! set up the grid
+
+   IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz)
+     DO k=1, kde
+      grid%em_znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+                                (1.-exp(-1./z_scale))
+     ENDDO
+   ELSE
+     DO k=1, kde
+      grid%em_znw(k) = 1. - float(k-1)/float(kde-1)
+     ENDDO
+   ENDIF
+
+!!!MARS
+!!!MARS
+!  open(unit=12,file='levels',form='formatted',status='old')
+!  rewind(12)
+!  DO k=1, kde
+!  read(12,*) grid%em_znw(k)
+!  write(6,*) 'read level ', k,grid%em_znw(k)
+!  ENDDO
+!  close(12)
+!!!MARS
+!!!MARS
+   
+
+   DO k=1, kde-1
+    grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+    grid%em_rdnw(k) = 1./grid%em_dnw(k)
+    grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+   ENDDO
+   DO k=2, kde-1
+    grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+    grid%em_rdn(k) = 1./grid%em_dn(k)
+    grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+    grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+   ENDDO
+
+   cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+   cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+   grid%cf1  = grid%em_fnp(2) + cof1
+   grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+   grid%cf3  = cof2       
+
+   grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+   grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+   grid%rdx = 1./config_flags%dx
+   grid%rdy = 1./config_flags%dy
+
+!  get the sounding from the ascii sounding file, first get dry sounding and 
+!  calculate base state
+
+  dry_sounding = .true.
+  IF ( wrf_dm_on_monitor() ) THEN
+  write(6,*) ' getting dry sounding for base state '
+
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+  ENDIF
+  CALL wrf_dm_bcast_real( zk , nl_max )
+  CALL wrf_dm_bcast_real( p_in , nl_max )
+  CALL wrf_dm_bcast_real( pd_in , nl_max )
+  CALL wrf_dm_bcast_real( theta , nl_max )
+  CALL wrf_dm_bcast_real( rho , nl_max )
+  CALL wrf_dm_bcast_real( u , nl_max )
+  CALL wrf_dm_bcast_real( v , nl_max )
+  CALL wrf_dm_bcast_real( qv , nl_max )
+  CALL wrf_dm_bcast_integer ( nl_in , 1 ) 
+
+  write(6,*) ' returned from reading sounding, nl_in is ',nl_in
+
+!  find ptop for the desired ztop (ztop is input from the namelist),
+!  and find surface pressure
+
+  grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in )
+
+!!MARS
+!!MARS
+  open(unit=14,file='input_coord',form='formatted',status='old')
+  rewind(14)
+  read(14,*) lon_input
+  read(14,*) lat_input
+  close(14)
+  write(6,*) ' lon is ',lon_input
+  write(6,*) ' lat is ',lat_input
+!!MARS
+!!MARS
+
+!!MARS
+!!MARS
+  open(unit=18,file='input_more',form='formatted',status='old')
+  rewind(18)
+  read(18,*) alt_input, tsurf_input
+  close(18)
+  write(6,*) ' alt is ',alt_input
+  write(6,*) ' tsurf is ',tsurf_input
+!!MARS
+!!MARS
+
+  DO j=jts,jte
+  DO i=its,ite
+!!MARS
+    grid%ht(i,j) = alt_input
+    grid%tsk(i,j) = tsurf_input
+!!MARS
+    grid%xlat(i,j) = lat_input
+    grid%xlong(i,j) = lon_input!+float(i)*config_flags%dx/59000.
+    grid%mars_emiss(i,j)=0.95
+    grid%mars_cice(i,j)=0.
+    grid%slpx(i,j) = 0.
+    grid%slpy(i,j) = 0.
+!!MARS
+  ENDDO
+  ENDDO
+
+  xs=ide/2 -3
+  xs=ids   -3
+  xe=xs + 6
+  ys=jde/2 -3
+  ye=ys + 6
+  mtn_ht = 500
+#ifdef MTN
+  DO j=max(ys,jds),min(ye,jde-1)
+  DO i=max(xs,ids),min(xe,ide-1)
+     grid%ht(i,j) = mtn_ht * 0.25 * &
+               ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) * &
+               ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+#ifdef EW_RIDGE
+  DO j=max(ys,jds),min(ye,jde-1)
+  DO i=ids,ide
+     grid%ht(i,j) = mtn_ht * 0.50 * &
+               ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+#ifdef NS_RIDGE
+  DO j=jds,jde
+  DO i=max(xs,ids),min(xe,ide-1)
+     grid%ht(i,j) = mtn_ht * 0.50 * &
+               ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+  DO j=jts,jte
+  DO i=its,ite
+    grid%em_phb(i,1,j) = g * grid%ht(i,j)
+    grid%em_ph0(i,1,j) = g * grid%ht(i,j)
+  ENDDO
+  ENDDO
+
+  DO J = jts, jte
+  DO I = its, ite
+
+    p_surf = interp_0( p_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+    grid%em_mub(i,j) = p_surf-grid%p_top
+
+!  this is dry hydrostatic sounding (base state), so given grid%em_p (coordinate),
+!  interp theta (from interp) and compute 1/rho from eqn. of state
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_pb(i,k,j) = p_level
+      grid%em_t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
+      grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+    ENDDO
+
+!  calc hydrostatic balance (alternatively we could interp the geopotential from the
+!  sounding, but this assures that the base state is in exact hydrostatic balance with
+!  respect to the model eqns.
+
+    DO k  = 2,kte
+      grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    write(6,*) ' ptop is ',grid%p_top
+    write(6,*) ' base state grid%em_mub(1,1), p_surf is ',grid%em_mub(1,1),grid%em_mub(1,1)+grid%p_top
+  ENDIF
+
+!  calculate full state for each column - this includes moisture.
+
+!!!!!MARS MARS
+!  write(6,*) ' getting moist sounding for full state '
+!  dry_sounding = .false.
+  dry_sounding = .true.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+
+!  At this point grid%p_top is already set. find the DRY mass in the column 
+!  by interpolating the DRY pressure.  
+
+   pd_surf = interp_0( pd_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+
+!  compute the perturbation mass and the full mass
+
+    grid%em_mu_1(i,j) = pd_surf-grid%p_top - grid%em_mub(i,j)
+    grid%em_mu_2(i,j) = grid%em_mu_1(i,j)
+    grid%em_mu0(i,j) = grid%em_mu_1(i,j) + grid%em_mub(i,j)
+
+! given the dry pressure and coordinate system, interp the potential
+! temperature and qv
+
+    do k=1,kde-1
+
+      p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+
+      moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%em_t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
+      grid%em_t_2(i,k,j)          = grid%em_t_1(i,k,j)
+      
+
+    enddo
+
+!  integrate the hydrostatic equation (from the RHS of the bigstep
+!  vertical momentum equation) down from the top to get grid%em_p.
+!  first from the top of the model to the top pressure
+
+    k = kte-1  ! top level
+
+    qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+    qvf2 = 1./(1.+qvf1)
+    qvf1 = qvf1*qvf2
+
+!    grid%em_p(i,k,j) = - 0.5*grid%em_mu_1(i,j)/grid%em_rdnw(k)
+    grid%em_p(i,k,j) = - 0.5*(grid%em_mu_1(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+    qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+    grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+    grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+
+!  down the column
+
+    do k=kte-2,1,-1
+      qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+      qvf2 = 1./(1.+qvf1)
+      qvf1 = qvf1*qvf2
+      grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_1(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+      qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+      grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                  (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+      grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+    enddo
+
+!  this is the hydrostatic equation used in the model after the
+!  small timesteps.  In the model, grid%em_al (inverse density)
+!  is computed from the geopotential.
+
+
+    grid%em_ph_1(i,1,j) = 0.
+    DO k  = 2,kte
+      grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                   (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                    grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+      grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+      grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+    ENDDO
+
+    IF ( wrf_dm_on_monitor() ) THEN
+    if((i==2) .and. (j==2)) then
+     write(6,*) ' grid%em_ph_1 calc ',grid%em_ph_1(2,1,2),grid%em_ph_1(2,2,2),&
+                              grid%em_mu_1(2,2)+grid%em_mub(2,2),grid%em_mu_1(2,2), &
+                              grid%em_alb(2,1,2),grid%em_al(1,2,1),grid%em_rdnw(1)
+    endif
+    ENDIF
+
+  ENDDO
+  ENDDO
+
+!#if 0
+
+!  thermal perturbation to kick off convection
+
+  write(6,*) ' nxc, nyc for perturbation ',nxc,nyc
+  write(6,*) ' delt for perturbation ',delt
+
+  DO J = jts, min(jde-1,jte)
+    yrad = config_flags%dy*float(j-nyc)/10000.
+!   yrad = 0.
+    DO I = its, min(ide-1,ite)
+      xrad = config_flags%dx*float(i-nxc)/10000.
+!     xrad = 0.
+      DO K = 1, kte-1
+
+!  put in preturbation theta (bubble) and recalc density.  note,
+!  the mass in the column is not changing, so when theta changes,
+!  we recompute density and geopotential
+
+        zrad = 0.5*(grid%em_ph_1(i,k,j)+grid%em_ph_1(i,k+1,j)  &
+                   +grid%em_phb(i,k,j)+grid%em_phb(i,k+1,j))/g
+        zrad = (zrad-1500.)/1500.
+        RAD=SQRT(xrad*xrad+yrad*yrad+zrad*zrad)
+        IF(RAD <= 1.) THEN
+           grid%em_t_1(i,k,j)=grid%em_t_1(i,k,j)+delt*COS(.5*PI*RAD)**2
+           grid%em_t_2(i,k,j)=grid%em_t_1(i,k,j)
+           qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+           grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                        (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+           grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+        ENDIF
+      ENDDO
+
+!  rebalance hydrostatically
+
+      DO k  = 2,kte
+        grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                     (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                      grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+        grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+        grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+      ENDDO
+
+    ENDDO
+  ENDDO
+
+!#endif
+
+   IF ( wrf_dm_on_monitor() ) THEN
+   write(6,*) ' grid%em_mu_1 from comp ', grid%em_mu_1(1,1)
+   write(6,*) ' full state sounding from comp, ph, grid%em_p, grid%em_al, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1)+grid%em_phb(1,k,1), &
+                                      grid%em_p(1,k,1)+grid%em_pb(1,k,1), grid%em_alt(1,k,1), &
+                                      grid%em_t_1(1,k,1)+t0, moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' pert state sounding from comp, grid%em_ph_1, pp, alp, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1), &
+                                      grid%em_p(1,k,1), grid%em_al(1,k,1), &
+                                      grid%em_t_1(1,k,1), moist(1,k,1,P_QV)
+   enddo
+   ENDIF
+
+! interp v
+
+  DO J = jts, jte
+  DO I = its, min(ide-1,ite)
+
+    IF (j == jds) THEN
+      z_at_v = grid%em_phb(i,1,j)/g
+    ELSE IF (j == jde) THEN
+      z_at_v = grid%em_phb(i,1,j-1)/g
+    ELSE
+      z_at_v = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i,1,j-1))/g
+    END IF
+    p_surf = interp_0( p_in, zk, z_at_v, nl_in )
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in )
+      grid%em_v_2(i,k,j) = grid%em_v_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+! interp u
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, ite
+
+    IF (i == ids) THEN
+      z_at_u = grid%em_phb(i,1,j)/g
+    ELSE IF (i == ide) THEN
+      z_at_u = grid%em_phb(i-1,1,j)/g
+    ELSE
+      z_at_u = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i-1,1,j))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_u, nl_in )
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
+      grid%em_u_2(i,k,j) = grid%em_u_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  set w
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte
+  DO I = its, min(ide-1,ite)
+    grid%em_w_1(i,k,j) = 0.
+    grid%em_w_2(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+!  set a few more things
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%h_diabatic(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+  IF ( wrf_dm_on_monitor() ) THEN
+  DO k=1,kte-1
+    grid%em_t_base(k) = grid%em_t_1(1,k,1)
+    grid%qv_base(k) = moist(1,k,1,P_QV)
+    grid%u_base(k) = grid%em_u_1(1,k,1)
+    grid%v_base(k) = grid%em_v_1(1,k,1)
+    grid%z_base(k) = 0.5*(grid%em_phb(1,k,1)+grid%em_phb(1,k+1,1)+grid%em_ph_1(1,k,1)+grid%em_ph_1(1,k+1,1))/g
+  ENDDO
+  ENDIF
+  CALL wrf_dm_bcast_real( grid%em_t_base , kte )
+  CALL wrf_dm_bcast_real( grid%qv_base , kte )
+  CALL wrf_dm_bcast_real( grid%u_base , kte )
+  CALL wrf_dm_bcast_real( grid%v_base , kte )
+  CALL wrf_dm_bcast_real( grid%z_base , kte )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+     thtmp   = grid%em_t_2(i,1,j)+t0
+     ptmp    = grid%em_p(i,1,j)+grid%em_pb(i,1,j)
+     temp(1) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,2,j)+t0
+     ptmp    = grid%em_p(i,2,j)+grid%em_pb(i,2,j)
+     temp(2) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,3,j)+t0
+     ptmp    = grid%em_p(i,3,j)+grid%em_pb(i,3,j)
+     temp(3) = thtmp * (ptmp/p1000mb)**rcp
+
+!!MARS
+!     grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)
+     grid%tmn(I,J)=grid%tsk(I,J)-0.5
+!!!MARS
+!!TODO: passer la valeur a partir des donnees
+!grid%mars_tsoil(I,:,J)=grid%tsk(I,J)
+!!!MARS
+  ENDDO
+  ENDDO
+
+ END SUBROUTINE init_domain_rk
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+
+!  test driver for get_sounding
+!
+!      implicit none
+!      integer n
+!      parameter(n = 1000)
+!      real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n)
+!      logical dry
+!      integer nl,k
+!
+!      dry = .false.
+!      dry = .true.
+!      call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl )
+!      write(6,*) ' input levels ',nl
+!      write(6,*) ' sounding '
+!      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+!      do k=1,nl
+!        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k)
+!      enddo
+!      end
+!
+!---------------------------------------------------------------------------
+
+      subroutine get_sounding( zk, p, p_dry, theta, rho, &
+                               u, v, qv, dry, nl_max, nl_in )
+      implicit none
+
+      integer nl_max, nl_in
+      real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), &
+           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
+      logical dry
+
+      integer n
+      parameter(n=1000)
+      logical debug
+      parameter( debug = .true.)
+
+! input sounding data
+
+      real p_surf, th_surf, qv_surf
+      real pi_surf, pi(n)
+      real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n)
+
+! diagnostics
+
+      real rho_surf, p_input(n), rho_input(n)
+      real pm_input(n)  !  this are for full moist sounding
+
+! local data
+
+      real p1000mb,cv,cp,r,cvpm,g
+!      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+      parameter (p1000mb = 610., r = 192., cp = 844.6, cv = cp-r, cvpm = -cv/cp, g=3.72)
+      integer k, it, nl
+      real qvf, qvf1, dz
+
+!  first, read the sounding
+
+      call read_sounding( p_surf, th_surf, qv_surf, &
+                          h_input, th_input, qv_input, u_input, v_input,n, nl, debug )
+
+      if(dry) then
+       do k=1,nl
+         qv_input(k) = 0.
+       enddo
+      endif
+
+      if(debug) write(6,*) ' number of input levels = ',nl
+
+        nl_in = nl
+        if(nl_in .gt. nl_max ) then
+          write(6,*) ' too many levels for input arrays ',nl_in,nl_max
+          call wrf_error_fatal ( ' too many levels for input arrays ' )
+        end if
+
+!  compute diagnostics,
+!  first, convert qv(g/kg) to qv(g/g)
+
+      do k=1,nl
+        qv_input(k) = 0.001*qv_input(k)
+      enddo
+
+      p_surf = 100.*p_surf  ! convert to pascals
+      qvf = 1. + rvovrd*qv_input(1) 
+      rho_surf = 1./((r/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
+      pi_surf = (p_surf/p1000mb)**(r/cp)
+
+      if(debug) then
+        write(6,*) ' surface density is ',rho_surf
+        write(6,*) ' surface pi is      ',pi_surf
+      end if
+
+
+!  integrate moist sounding hydrostatically, starting from the
+!  specified surface pressure
+!  -> first, integrate from surface to lowest level
+
+          qvf = 1. + rvovrd*qv_input(1) 
+          qvf1 = 1. + qv_input(1)
+          rho_input(1) = rho_surf
+          dz = h_input(1)
+          do it=1,10
+!            pm_input(1) = p_surf &
+!                    - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1
+!!!MARS MARS MARS
+            pm_input(1) = p_surf 
+            rho_input(1) = 1./((r/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm))
+          enddo
+
+! integrate up the column
+
+          do k=2,nl
+            rho_input(k) = rho_input(k-1)
+            dz = h_input(k)-h_input(k-1)
+            qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k)))
+            qvf = 1. + rvovrd*qv_input(k)   ! qv is in g/kg here
+ 
+            do it=1,10
+              pm_input(k) = pm_input(k-1) &
+                      - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
+              rho_input(k) = 1./((r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
+            enddo
+          enddo
+
+!  we have the moist sounding
+
+!  next, compute the dry sounding using p at the highest level from the
+!  moist sounding and integrating down.
+
+        p_input(nl) = pm_input(nl)
+
+          do k=nl-1,1,-1
+            dz = h_input(k+1)-h_input(k)
+            p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g
+          enddo
+
+
+        do k=1,nl
+
+          zk(k) = h_input(k)
+          p(k) = pm_input(k)
+          p_dry(k) = p_input(k)
+          theta(k) = th_input(k)
+          rho(k) = rho_input(k)
+          u(k) = u_input(k)
+          v(k) = v_input(k)
+          qv(k) = qv_input(k)
+
+        enddo
+
+     if(debug) then
+      write(6,*) ' sounding '
+      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+      do k=1,nl
+        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k)
+      enddo
+
+     end if
+
+      end subroutine get_sounding
+
+!-------------------------------------------------------
+
+      subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,n,nl,debug )
+      implicit none
+      integer n,nl
+      real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n)
+      logical end_of_file
+      logical debug
+
+      integer k
+
+      open(unit=10,file='input_sounding',form='formatted',status='old')
+      rewind(10)
+      read(10,*) ps, ts, qvs
+      if(debug) then
+        write(6,*) ' input sounding surface parameters '
+        write(6,*) ' surface pressure (mb) ',ps
+        write(6,*) ' surface pot. temp (K) ',ts
+        write(6,*) ' surface mixing ratio (g/kg) ',qvs
+      end if
+
+      end_of_file = .false.
+      k = 0
+
+      do while (.not. end_of_file)
+
+        read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1)
+        k = k+1
+        if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k)
+        go to 110
+ 100    end_of_file = .true.
+ 110    continue
+      enddo
+
+      nl = k
+
+      close(unit=10,status = 'keep')
+
+      end subroutine read_sounding
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_real.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_real.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_real.F	(revision 2744)
@@ -0,0 +1,6034 @@
+!REAL:MODEL_LAYER:INITIALIZATION
+
+#ifndef VERT_UNIT
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains, specifically for the Eulerian, mass-based coordinate.
+
+!-----------------------------------------------------------------------
+
+!****MARS: modified May 2007
+
+
+MODULE module_initialize
+
+   USE module_bc
+   USE module_configure
+   USE module_domain
+   USE module_io_domain
+   USE module_model_constants
+   USE module_state_description
+   USE module_timing
+   USE module_soil_pre
+   USE module_date_time
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+   REAL , SAVE :: p_top_save
+   INTEGER :: internal_time_loop
+
+CONTAINS
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain ( grid )
+
+      IMPLICIT NONE
+
+      !  Input space and data.  No gridded meteorological data has been stored, though.
+
+!     TYPE (domain), POINTER :: grid 
+      TYPE (domain)          :: grid 
+
+      !  Local data.
+
+      INTEGER :: dyn_opt 
+      INTEGER :: idum1, idum2
+
+      CALL nl_get_dyn_opt ( 1, dyn_opt )
+      
+      CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+      IF (      dyn_opt .eq. 1 &
+           .or. dyn_opt .eq. 2 &
+           .or. dyn_opt .eq. 3 &
+                                          ) THEN
+        CALL init_domain_rk( grid &
+!
+#include "em_actual_new_args.inc"
+!
+      )
+
+      ELSE
+         WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+         CALL wrf_error_fatal ( 'ERROR-dyn_opt-wrong-in-namelist' )
+      ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+#include "em_dummy_new_args.inc"
+!
+   )
+
+      USE module_optional_si_input
+      IMPLICIT NONE
+
+      !  Input space and data.  No gridded meteorological data has been stored, though.
+
+!     TYPE (domain), POINTER :: grid
+      TYPE (domain)          :: grid
+
+#include "em_dummy_new_decl.inc"
+
+      TYPE (grid_config_rec_type)              :: config_flags
+
+      !  Local domain indices and counters.
+
+      INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+      INTEGER :: loop , num_seaice_changes
+
+      INTEGER                             ::                       &
+                                     ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte, &
+                                     ips, ipe, jps, jpe, kps, kpe, &
+                                     i, j, k
+      INTEGER :: ns
+
+      !  Local data
+
+      INTEGER :: error
+      REAL    :: p_surf, p_level
+      REAL    :: cof1, cof2
+      REAL    :: qvf , qvf1 , qvf2 , pd_surf
+      REAL    :: p00 , t00 , a
+      REAL    :: hold_znw
+      LOGICAL :: were_bad
+
+      LOGICAL :: stretch_grid, dry_sounding, debug
+      INTEGER IICOUNT
+
+      REAL :: p_top_requested , temp
+      INTEGER :: num_metgrid_levels
+      REAL , DIMENSION(max_eta) :: eta_levels
+      REAL :: max_dz
+
+!     INTEGER , PARAMETER :: nl_max = 1000
+!      REAL , DIMENSION(nl_max) :: grid%em_dn
+
+integer::oops1,oops2
+
+      REAL    :: zap_close_levels
+      INTEGER :: force_sfc_in_vinterp
+      INTEGER :: interp_type , lagrange_order
+      LOGICAL :: lowest_lev_from_sfc
+      LOGICAL :: we_have_tavgsfc
+
+      INTEGER :: lev500 , loop_count
+      REAL    :: zl , zu , pl , pu , z500 , dz500 , tvsfc , dpmu
+
+!-- Carsel and Parrish [1988]
+        REAL , DIMENSION(100) :: lqmi
+
+
+!****MARS
+      INTEGER :: sizegcm, kold, knew,inew,jnew
+      REAL :: pa, indic, p1, p2, pn
+      REAL, ALLOCATABLE, DIMENSION (:,:,:) :: sig, ap, bp, box
+      REAL :: randnum 
+      REAL :: tiso 
+      REAl :: yeah, yeahc, yeah2
+!****MARS
+      INTEGER :: hypsometric_opt = 1 ! classic
+      LOGICAL :: interp_theta = .true. ! classic
+      !INTEGER :: hypsometric_opt = 2 ! Wee et al. 2012 correction
+      !LOGICAL :: interp_theta = .false. ! Wee et al. 2012 correction
+      REAL :: pfu, pfd, phm
+      REAL :: tpot
+
+#ifdef DM_PARALLEL
+#    include "em_data_calls.inc"
+#endif
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+            kds = grid%sd31 ; kde = grid%ed31 ;
+            ids = grid%sd32 ; ide = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            kms = grid%sm31 ; kme = grid%em31 ;
+            ims = grid%sm32 ; ime = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+            its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XYZ )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            jds = grid%sd32 ; jde = grid%ed32 ;
+            kds = grid%sd33 ; kde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            jms = grid%sm32 ; jme = grid%em32 ;
+            kms = grid%sm33 ; kme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+            kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XZY )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            kds = grid%sd32 ; kde = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            kms = grid%sm32 ; kme = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+      END SELECT
+
+      CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+      !  Check to see if the boundary conditions are set properly in the namelist file.
+      !  This checks for sufficiency and redundancy.
+
+      CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+      !  Some sort of "this is the first time" initialization.  Who knows.
+
+      grid%step_number = 0
+      grid%itimestep=0
+
+      !  Pull in the info in the namelist to compare it to the input data.
+
+      grid%real_data_init_type = model_config_rec%real_data_init_type
+   
+      !  To define the base state, we call a USER MODIFIED routine to set the three
+      !  necessary constants:  p00 (sea level pressure, Pa), t00 (sea level temperature, K), 
+      !  and A (temperature difference, from 1000 mb to 300 mb, K).
+   
+      CALL const_module_initialize ( p00 , t00 , a , tiso ) 
+
+#if 0
+!KLUDGE, this is for testing only
+if ( flag_metgrid .eq. 1 ) then
+read (20+grid%id) grid%em_ht_gc
+read (20+grid%id) grid%em_xlat_gc
+read (20+grid%id) grid%em_xlong_gc
+read (20+grid%id) msft
+read (20+grid%id) msfu
+read (20+grid%id) msfv
+read (20+grid%id) f
+read (20+grid%id) e
+read (20+grid%id) sina
+read (20+grid%id) cosa
+read (20+grid%id) grid%landmask
+read (20+grid%id) grid%landusef
+read (20+grid%id) grid%soilctop
+read (20+grid%id) grid%soilcbot
+read (20+grid%id) grid%vegcat
+read (20+grid%id) grid%soilcat
+else
+write (20+grid%id) grid%em_ht
+write (20+grid%id) grid%em_xlat
+write (20+grid%id) grid%em_xlong
+write (20+grid%id) msft
+write (20+grid%id) msfu
+write (20+grid%id) msfv
+write (20+grid%id) f
+write (20+grid%id) e
+write (20+grid%id) sina
+write (20+grid%id) cosa
+write (20+grid%id) grid%landmask
+write (20+grid%id) grid%landusef
+write (20+grid%id) grid%soilctop
+write (20+grid%id) grid%soilcbot
+write (20+grid%id) grid%vegcat
+write (20+grid%id) grid%soilcat
+endif
+#endif
+
+
+      !  Is there any vertical interpolation to do?  The "old" data comes in on the correct
+      !  vertical locations already.
+
+      IF ( flag_metgrid .EQ. 1 ) THEN  !   <----- START OF VERTICAL INTERPOLATION PART ---->
+
+         !  Variables that are named differently between SI and WPS.
+
+         DO j = jts, MIN(jte,jde-1)
+           DO i = its, MIN(ite,ide-1)
+              grid%tmn(i,j) = grid%em_tmn_gc(i,j)
+              grid%xlat(i,j) = grid%em_xlat_gc(i,j)
+              grid%xlong(i,j) = grid%em_xlong_gc(i,j)
+              grid%ht(i,j) = grid%em_ht_gc(i,j)
+!!****MARS
+              grid%m_tsurf(i,j) = grid%em_tsk_gc(i,j)
+              grid%m_albedo(i,j) = grid%em_albedo_gcm_gc(i,j)
+              grid%m_ti(i,j) = grid%em_therm_inert_gc(i,j)
+              grid%slpx(i,j) = grid%em_slpx_gc(i,j)
+              grid%slpy(i,j) = grid%em_slpy_gc(i,j)
+              grid%m_emiss(i,j) = grid%st000010(i,j)
+              grid%m_co2ice(i,j) = grid%st010040(i,j)
+              grid%m_h2oice(i,j) = grid%sm100200(i,j)
+              grid%m_q2(i,:,j) = 0.
+                  !! one more security ... co2ice cannot be negative
+                  IF (grid%m_co2ice(i,j) .lt. 0.) grid%m_co2ice(i,j)=0.
+                  IF (grid%m_h2oice(i,j) .lt. 0.) grid%m_h2oice(i,j)=0.
+
+              DO k = 1, config_flags%num_soil_layers  
+                grid%m_tsoil(i,k,j)=grid%em_tsoil_gc(i,k+1,j) !!ici k+1, because em_tsoil_gc dim is num_metgrid_levels !!
+              ENDDO  
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+#ifdef NEWPHYS
+
+              grid%m_wstar(i,j)=0. 
+              grid%m_fluxrad(i,j)=0.
+
+              grid%m_z0(i,j) = 0.
+              grid%m_z0(i,j) = grid%em_z0_gc(i,j)*0.01  !! in cm in surface.nc but in m in physiq.F
+              !IF (config_flags%init_Z0 .ne. 0.) THEN 
+              !   grid%z0 = grid%z0*0. + config_flags%init_Z0
+              !ENDIF
+
+              ! here, that bit is necessary for new soil model !          
+              IF (config_flags%init_TI .ne. 0.) THEN
+                  grid%m_ti = grid%m_ti*0. + config_flags%init_TI
+                  print *, 'constant thermal inertia ', config_flags%init_TI
+              ENDIF
+
+              DO k = 1, config_flags%num_soil_layers  
+                grid%m_isoil(i,k,j)=grid%em_isoil_gc(i,k+1,j)
+                grid%m_dsoil(i,k,j)=grid%em_dsoil_gc(i,k+1,j)
+              ENDDO
+
+              DO k = 1, config_flags%num_soil_layers
+                !!!!!!!!!!!!!!!!! DONE in soil_setting.F
+                IF (grid%m_dsoil(i,k,j) == -999.) THEN  !! old soil depths (or) no info in files
+                   grid%m_dsoil(i,k,j) = sqrt(887.75/3.14)*((2.**(k-0.5))-1.) * grid%m_ti(i,j) / wvolcapa 
+                       !!! ATTENTION il faut interpoler si le nombre de niveaux change
+                       !!! voir soil_setting.F (olddepthdef=.true. ; interpol=.true.)
+                       !!! mais: en meso-echelle on a juste a prendre le mm nombre de niveaux que le GCM   
+                ENDIF
+                IF (grid%m_isoil(i,k,j) == -999.) THEN  !! old soil model (or) no 3D thermal inertia   
+                   grid%m_isoil(i,k,j) = grid%m_ti(i,j)
+                ELSE             
+                   IF (grid%m_dsoil(i,k,j) .le. sqrt(88775./3.14) * grid%m_ti(i,j) / wvolcapa) THEN
+                           grid%m_isoil(i,k,j) = grid%m_ti(i,j)  !! if depth < skin depth, we use hi-res TI
+                   ELSE  !! if depth > skin depth, we use low-res (GCM) TI
+                         !! except for a transition layer
+                         !!   EM: and, well, it would be wrong to sum up TI values
+                         !!   EM: (cf. last page of soil model technical document)
+                           IF (grid%m_dsoil(i,k-1,j) .le. sqrt(88775./3.14) * grid%m_ti(i,j) / wvolcapa) THEN
+                                   grid%m_isoil(i,k,j) = &
+                                   sqrt( &
+                                         ( grid%m_dsoil(i,k+1,j) - grid%m_dsoil(i,k-1,j) ) &
+                                         / &
+                                         ( ( (grid%m_dsoil(i,k,j) - grid%m_dsoil(i,k-1,j)) &
+                                              / (grid%m_isoil(i,k-1,j)*grid%m_isoil(i,k-1,j)) ) &
+                                           + &
+                                           ( (grid%m_dsoil(i,k+1,j) - grid%m_dsoil(i,k,j)) &
+                                              / (grid%m_isoil(i,k+1,j)*grid%m_isoil(i,k+1,j)) ) &
+                                         ) &
+                                       ) 
+                           ENDIF       !! grid%m_isoil(i,k-1,j) was changed at previous step to value grid%m_ti(i,j)
+                                       !! grid%m_isoil(i,k+1,j) is defined to large-scale value grid%em_isoil_gc   
+                   ENDIF        
+                ENDIF
+                IF (grid%m_tsoil(i,k,j) .lt. 20.) THEN  !!! une securite pour les anciens diagfi qui n'ont que 10 niveaux
+                   IF (k .ne. 1) grid%m_tsoil(i,k,j) = grid%m_tsoil(i,k-1,j)
+                ENDIF
+                !!!!!!!!!!!!!!!!! DONE in soil_setting.F
+
+              ENDDO  
+#endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+grid%m_gw(i,1,j)=grid%st040100(i,j)  !!ZMEA
+grid%m_gw(i,2,j)=grid%st100200(i,j)  !!ZSTD
+grid%m_gw(i,3,j)=grid%sm000010(i,j)  !!ZSIG
+grid%m_gw(i,4,j)=grid%sm010040(i,j)  !!ZGAM
+grid%m_gw(i,5,j)=grid%sm040100(i,j)  !!ZTHE
+
+           END DO
+         END DO
+
+
+!!****MARS
+!!****MARS
+!! User-defined constants initialisations
+!! defined by the namelist entries
+!!	init_TI : fixed value for thermal inertia
+!!	init_AL : fixed value for albedo
+!!	init_U : fixed value for zonal wind
+!!	init_V : fixed value for meridional wind 
+!!	init_WX & init_WY : fixed wind profile taken at these coordinates
+!!      init_MU : multiply zonal wind by a constant
+!!      init_MV : multiply meridional wind by a constant
+!!	init_LES : LES mode (LOGICAL)
+
+IF (config_flags%init_TI .ne. 0.) THEN
+
+    !DO j = jts, MIN(jte,jde-1)
+    !DO i = its, MIN(ite,ide-1)
+    !	grid%m_ti(i,j) = config_flags%init_TI 
+    !ENDDO
+    !ENDDO
+  grid%m_ti = grid%m_ti*0. + config_flags%init_TI 
+  print *, 'constant thermal inertia ', config_flags%init_TI
+
+!yeah2=0.
+!yeahc=0.
+!DO j = jts, MIN(jte,jde-1)
+!DO i = its, MIN(ite,ide-1)
+!yeah2 = grid%tsk(i,j) + yeah2
+!yeahc = yeahc + 1.
+!ENDDO
+!ENDDO
+!print *, 'constant skin temperature ', yeah2 / yeahc
+!DO j = jts, MIN(jte,jde-1)
+!DO i = its, MIN(ite,ide-1)
+!grid%tsk(i,j) = yeah2 / yeahc
+!ENDDO
+!ENDDO
+!
+!  DO k = 1, config_flags%num_soil_layers
+!yeah=0.
+!yeahc=0.
+!DO j = jts, MIN(jte,jde-1)
+!DO i = its, MIN(ite,ide-1)
+!yeah = grid%m_tsoil(i,k,j) + yeah
+!yeahc = yeahc + 1.
+!ENDDO
+!ENDDO
+!print *, 'constant soil temperature ', k, yeah / yeahc 
+!DO j = jts, MIN(jte,jde-1)
+!DO i = its, MIN(ite,ide-1)
+!grid%m_tsoil(i,k,j) = yeah / yeahc
+!ENDDO
+!ENDDO
+!  ENDDO
+  
+ENDIF
+
+IF (config_flags%init_AL .ne. 0.) THEN
+
+  grid%m_albedo = grid%m_albedo*0. + config_flags%init_AL
+  print *, 'constant albedo ', config_flags%init_AL
+
+ENDIF
+
+IF ( (config_flags%init_WX .ne. 0) .and. (config_flags%init_WY .ne. 0) )  THEN
+
+  DO j = jts, MIN(jte,jde-1)
+  DO i = its, MIN(ite,ide-1)
+     grid%em_u_gc(i,:,j)=grid%em_u_gc(config_flags%init_WX,:,config_flags%init_WY) ! zonal wind
+     grid%em_v_gc(i,:,j)=grid%em_v_gc(config_flags%init_WX,:,config_flags%init_WY) ! meridional wind
+  ENDDO
+  ENDDO
+  !! FIX for the STAGGERED SPECIFICITY
+  grid%em_u_gc(MIN(ite,ide-1)+1,:,:)=grid%em_u_gc(MIN(ite,ide-1),:,:)
+  grid%em_v_gc(:,:,MIN(jte,jde-1)+1)=grid%em_v_gc(:,:,MIN(jte,jde-1))
+
+  !! CHECK
+  print *, 'wind profile'
+  print *, 'took at ...', config_flags%init_WX, config_flags%init_WY 
+  print *, '--zonal'
+  print *, grid%em_u_gc(config_flags%init_WX,:,config_flags%init_WY)
+  print *, '--meridional'
+  print *, grid%em_v_gc(config_flags%init_WX,:,config_flags%init_WY)
+
+ENDIF
+
+IF (config_flags%init_MU .ne. 0.) THEN
+
+  grid%em_u_gc = grid%em_u_gc*config_flags%init_MU
+  print *, 'multiply zonal wind ', config_flags%init_MU
+
+ENDIF
+
+IF (config_flags%init_MV .ne. 0.) THEN
+
+  grid%em_v_gc = grid%em_v_gc*config_flags%init_MV
+  print *, 'multiply meridional wind ', config_flags%init_MV
+
+ENDIF
+
+IF (config_flags%init_LES) THEN
+
+        print *, '*** LES MODE ***'
+        print *, 'setting uniform values and profiles'
+        print *, 'u', grid%em_u_gc(its+1,:,jts+1)
+        print *, 'v', grid%em_v_gc(its+1,:,jts+1)
+        print *, 't', grid%em_t_gc(its+1,:,jts+1)
+        print *, 'p', grid%em_rh_gc(its+1,:,jts+1)
+        print *, 'geop', grid%em_ght_gc(its+1,:,jts+1)
+        print *, 'albedo', grid%m_albedo(its+1,jts+1)
+        print *, 'thermal inertia', grid%m_ti(its+1,jts+1)
+        print *, 'topography', grid%ht(its+1,jts+1)
+        print *, 'toposoil', grid%toposoil(its+1,jts+1)
+        print *, 'surface temperature', grid%m_tsurf(its+1,jts+1)
+        print *, 'surface pressure', grid%psfc(its+1,jts+1), grid%em_psfc_gc(its+1,jts+1)
+
+        DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+                grid%em_u_gc(i,:,j)=grid%em_u_gc(its+1,:,jts+1)
+                grid%em_v_gc(i,:,j)=grid%em_v_gc(its+1,:,jts+1)
+                grid%em_t_gc(i,:,j)=grid%em_t_gc(its+1,:,jts+1)
+                grid%em_rh_gc(i,:,j)=grid%em_rh_gc(its+1,:,jts+1)
+                grid%em_ght_gc(i,:,j) = grid%em_ght_gc(its+1,:,jts+1)
+grid%m_albedo(i,j) = grid%m_albedo(its+1,jts+1)
+grid%m_ti(i,j) = grid%m_ti(its+1,jts+1)
+                grid%ht(i,j) = grid%ht(its+1,jts+1)
+                grid%toposoil(i,j) = grid%toposoil(its+1,jts+1)
+                grid%m_tsurf(i,j) = grid%m_tsurf(its+1,jts+1)
+                grid%psfc(i,j) = grid%psfc(its+1,jts+1)
+                grid%em_psfc_gc(i,j) = grid%em_psfc_gc(its+1,jts+1)
+grid%slpx(i,j) = 0.
+grid%slpy(i,j) = 0.
+grid%m_emiss(i,j) = 0.95
+grid%m_co2ice(i,j) = 0.
+grid%m_h2oice(i,j) = 0.
+grid%m_tsoil(i,:,j)=grid%m_tsoil(its+1,:,jts+1)
+
+!!! 
+grid%m_isoil(i,:,j)=grid%m_isoil(its+1,:,jts+1)
+grid%m_dsoil(i,:,j)=grid%m_dsoil(its+1,:,jts+1)
+
+!! T.Michaels trick to break symmetry
+CALL RANDOM_NUMBER(randnum)
+grid%em_t_gc(i,1,j)=grid%em_t_gc(its+1,1,jts+1) + 0.1*2.*(0.5-randnum)
+CALL RANDOM_NUMBER(randnum)
+grid%em_t_gc(i,2,j)=grid%em_t_gc(its+1,2,jts+1) + 0.1*2.*(0.5-randnum)
+!CALL RANDOM_NUMBER(randnum)
+!grid%em_t_gc(i,3,j)=grid%em_t_gc(its+1,3,jts+1) + 0.1*2.*(0.5-randnum)
+!CALL RANDOM_NUMBER(randnum)
+!grid%em_t_gc(i,4,j)=grid%em_t_gc(its+1,4,jts+1) + 0.1*2.*(0.5-randnum)
+!CALL RANDOM_NUMBER(randnum)
+!grid%em_t_gc(i,5,j)=grid%em_t_gc(its+1,5,jts+1) + 0.1*2.*(0.5-randnum)
+
+
+         ENDDO
+         ENDDO
+
+ENDIF
+
+IF (config_flags%init_U .ne. 0.) THEN
+  grid%em_u_gc = grid%em_u_gc*0. + config_flags%init_U
+  print *, 'constant zonal wind ', config_flags%init_U
+ENDIF
+IF (config_flags%init_V .ne. 0.) THEN
+  grid%em_v_gc = grid%em_v_gc*0. + config_flags%init_V
+  print *, 'constant meridional wind ', config_flags%init_V
+ENDIF
+
+
+
+!!!!!!!!!!!!!!!!!!!
+!!! READ PROFILE !!
+!!!!!!!!!!!!!!!!!!!
+!
+!open(unit=10,file='input_sounding',form='formatted',status='old')
+!rewind(10)
+!read(10,*) grid%em_u_gc(1,:,1)
+!!****MARS
+!!
+!! case with idealized topography
+!!
+!!CALL ideal_topo ( grid%ht , 2000., 6., &
+!CALL ideal_topo ( grid%ht , 2000., 3., &
+!           ids , ide , jds , jde , kds , kde , &
+!           ims , ime , jms , jme , kms , kme , &
+!           its , ite , jts , jte , kts , kte )
+!!****MARS
+
+
+
+
+         !  If we have any input low-res surface pressure, we store it.
+
+!!****MARS
+!!fix pour être certain d'être avec les bons flag
+print *,flag_psfc
+print *,flag_soilhgt
+print *,flag_metgrid
+
+flag_psfc=1
+flag_soilhgt=1
+flag_metgrid=1
+!!**** TODO: trouver quand même pourquoi donne 0 :)
+pa=999999.
+!!****MARS
+
+         IF ( flag_psfc .EQ. 1 ) THEN
+            DO j = jts, MIN(jte,jde-1)
+              DO i = its, MIN(ite,ide-1)
+                 grid%em_psfc_gc(i,j) = grid%psfc(i,j)
+!!!****MARS: em_p_gc is only a way to count vertical levels in WPS :)
+!!!****MARS: is filled here with real pressure levels
+grid%em_p_gc(i,:,j) = grid%em_rh_gc(i,:,j)
+!!!****MARS
+                 grid%em_p_gc(i,1,j) = grid%psfc(i,j)
+!!!****MARS
+IF (pa .gt. grid%em_p_gc(i,1,j)) pa=grid%em_p_gc(i,1,j)
+!!!****MARS
+              END DO
+            END DO
+         END IF
+print *, 'found minimum pressure (Pa) :',pa
+
+
+!!!!****MARS
+!!!!****MARS
+!!!! define new hybrid coordinate levels
+!!!! with transition level between sigma and pressure
+!!!! lower than input data
+!
+!
+!        !--get vertical size of the GCM input array
+!        sizegcm=SIZE(grid%em_rh_gc(1,:,1))
+!        ALLOCATE(sig(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+!        ALLOCATE(ap(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+!        ALLOCATE(bp(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+!        !ALLOCATE(box(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+!
+!
+!
+!        !--define sigma levels, 
+!        !--then derive new sigma levels, and new pressure levels
+!        DO j = jts, MIN(jte,jde-1)
+!          DO i = its, MIN(ite,ide-1)
+!
+!                ! old sigma levels
+!                sig(i,:,j)=grid%em_p_gc(i,:,j)/grid%em_psfc_gc(i,j)
+!!                sig(i,:,j)=grid%em_p_gc(20,:,20)/grid%em_psfc_gc(20,20)
+!                ! new pressure levels
+!                ! - pressure_new = ap_new + bp_new * ps_gcm
+!                ! - bp_new is converging more rapidly than bp
+!                !   ... while conserving the same structure near the surface
+!                !
+!                ! NB: grid%zap_close_levels ne sert pas dans vert_interp_old :)
+!                ! NB: peut donc servir pour préciser une constante reelle
+!                ! NB: qui permet de rehausser la zone de transition
+!                !
+!                bp(i,:,j)=sqrt(sqrt(exp(1.-1./(sig(i,:,j)**4))))
+!                ap(i,:,j)=pa*exp(-grid%zap_close_levels/10.)*(sig(i,:,j)-bp(i,:,j))
+!                grid%em_rh_gc(i,:,j)=ap(i,:,j)+bp(i,:,j)*grid%em_psfc_gc(i,j)
+!
+!                ! avoid extrapolation at the top 
+!                ! -- the last level is thus unsignificant
+!                grid%em_p_gc(i,sizegcm,j)=grid%em_p_gc(i,sizegcm,j)/100.
+!!                grid%em_p_gc(i,sizegcm,j)=grid%em_p_gc(i,sizegcm,j)/10000.
+!
+!          ENDDO
+!        ENDDO
+!
+!
+!
+!
+!        !-- check that the biggest differences are higher
+!        print *, 'sigma levels'
+!        print *, sig(its+1,:,jts+1)
+!        print *, 'old pressure levels'
+!        print *, grid%em_p_gc(its+1,:,jts+1)
+!        print *, 'new pressure levels'
+!        print *, grid%em_rh_gc(its+1,:,jts+1)
+!
+!!print *, 't_gc', SIZE(grid%em_t_gc(1,:,1))
+!!print *, 'p_gc', SIZE(grid%em_p_gc(1,:,1))
+!!print *, 't_2', SIZE(grid%em_t_2(1,:,1))
+!!print *, 'rh_gc', SIZE(grid%em_rh_gc(1,:,1))
+!
+!
+!!--------
+!!-- interpolate on the new pressure levels
+!!--------
+!
+!        DO j = jts, MIN(jte,jde-1)
+!          DO i = its, MIN(ite,ide-1)
+!
+!DO knew = 1,sizegcm     ! loop on each level of the new grid
+!
+!        DO kold = 1,sizegcm-1   ! find the two enclosing levels
+!
+!                ! indic becomes negative when the two levels are found
+!                indic=(grid%em_p_gc(i,kold,j)-grid%em_rh_gc(i,knew,j))&
+!                        *(grid%em_p_gc(i,kold+1,j)-grid%em_rh_gc(i,knew,j))
+!
+!                ! 1. the two levels are found - define p1,p2,pn and exit the loop
+!                IF (indic < 0.) THEN 
+!                        !IF ((i == its) .AND. (j == jts)) THEN   !just a check
+!                        !        print *, 'new level', grid%em_rh_gc(i,knew,j)
+!                        !        print *, 'interp levels', grid%em_p_gc(i,kold,j), &
+!                        !                grid%em_p_gc(i,kold+1,j)
+!                        !ENDIF
+!                p1 = ALOG(grid%em_p_gc(i,kold,j))
+!                p2 = ALOG(grid%em_p_gc(i,kold+1,j))
+!                pn = ALOG(grid%em_rh_gc(i,knew,j))
+!                EXIT
+!
+!                ! 2. must handle the case (usually close to the surface) 
+!                ! of similar new/old levels - then exit with the right kold value
+!                ELSE IF (1-abs(grid%em_rh_gc(i,knew,j)/grid%em_p_gc(i,kold,j)) .lt. 1e-8) THEN
+!                        !print *,grid%em_p_gc(i,kold,j),grid%em_rh_gc(i,knew,j)  
+!                EXIT
+!                ELSE IF (1-abs(grid%em_rh_gc(i,knew,j)/grid%em_p_gc(i,kold+1,j)) .lt. 1e-8) THEN
+!                        !print *,grid%em_p_gc(i,kold+1,j),grid%em_rh_gc(i,knew,j)
+!                        kold=kold+1
+!                EXIT
+!
+!                ! 3. continue looping if the two levels are not found ....
+!                ENDIF 
+!        ENDDO
+!
+!        ! this is an initialization, useful for case 2 (and erased just below if case 1)
+!        grid%em_t_2(i,knew,j)= grid%em_t_gc(i,kold,j)
+!        grid%em_u_2(i,knew,j)= grid%em_u_gc(i,kold,j)
+!        grid%em_v_2(i,knew,j)= grid%em_v_gc(i,kold,j)
+!
+!        ! case 1: OK, in the previous loop, the two levels were found, and stored in p1 and p2
+!        ! ... thus interpolation can be performed
+!        IF (indic < 0.) THEN
+!        grid%em_t_2(i,knew,j)= ( grid%em_t_gc(i,kold,j) * ( p2 - pn )   + &
+!                                 grid%em_t_gc(i,kold+1,j) * ( pn - p1 ) ) / &
+!                                 ( p2 - p1 )
+!        grid%em_u_2(i,knew,j)= ( grid%em_u_gc(i,kold,j) * ( p2 - pn )   + &
+!                                 grid%em_u_gc(i,kold+1,j) * ( pn - p1 ) ) / &
+!                                 ( p2 - p1 )
+!        grid%em_v_2(i,knew,j)= ( grid%em_v_gc(i,kold,j) * ( p2 - pn )   + &
+!                                 grid%em_v_gc(i,kold+1,j) * ( pn - p1 ) ) / &
+!                                 ( p2 - p1 )
+!        ENDIF
+!
+!
+!ENDDO
+!
+!          ENDDO
+!        ENDDO
+!grid%em_u_2(MIN(ite,ide-1)+1,:,:)=grid%em_u_2(MIN(ite,ide-1),:,:)
+!grid%em_v_2(:,:,MIN(jte,jde-1)+1)=grid%em_v_2(:,:,MIN(jte,jde-1))
+!!--------
+!!-- end - interpolate on the new pressure levels
+!!--------
+
+
+!        !-- interpolate on the new pressure levels
+!        CALL vert_interp_old ( grid%em_t_gc , &         ! --- interpolate this field
+!                               grid%em_p_gc, &          ! --- with coordinates
+!                               grid%em_t_2, &           ! --- to obtain the new field
+!                               grid%em_rh_gc, &         ! --- on coordinates
+!                               sizegcm, &
+!                               'T', &           ! --- no staggering (will be done later)
+!                               2, &             ! --- log p interpolation   
+!                               1, &             ! --- (0) lagrange_order
+!                               .false., &       ! --- (0) lowest_lev_from_sfc
+!                               0., &            ! --- (0) zap_close_levels
+!                               0, &             ! --- (0) force_sfc_in_vinterp
+!                               ids , ide , jds , jde , kds , kde , &
+!                               ims , ime , jms , jme , kms , kme , &
+!                               its , ite , jts , jte , kts , kte )
+!        CALL vert_interp_old ( grid%em_u_gc , &         ! --- interpolate this field
+!                               grid%em_p_gc, &          ! --- with coordinates
+!                               grid%em_u_2 , &          ! --- to obtain the new field
+!                               grid%em_rh_gc, &         ! --- on coordinates
+!                               sizegcm, &
+!                               'U', &           ! --- no staggering (will be done later)
+!                               2, &             ! --- log p interpolation
+!                               1, &             ! --- (0) lagrange_order
+!                               .false., &       ! --- (0) lowest_lev_from_sfc
+!                               0., &            ! --- (0) zap_close_levels
+!                               0, &             ! --- (0) force_sfc_in_vinterp
+!                               ids , ide , jds , jde , kds , kde , &
+!                               ims , ime , jms , jme , kms , kme , &
+!                               its , ite , jts , jte , kts , kte )
+!        CALL vert_interp_old ( grid%em_v_gc , &         ! --- interpolate this field
+!                               grid%em_p_gc, &          ! --- with coordinates
+!                               grid%em_v_2 , &          ! --- to obtain the new field
+!                               grid%em_rh_gc, &         ! --- on coordinates
+!                               sizegcm, &
+!                               'V', &           ! --- no staggering (will be done later)
+!                               2, &             ! --- log p interpolation
+!                               1, &             ! --- (0) lagrange_order
+!                               .false., &       ! --- (0) lowest_lev_from_sfc
+!                               0., &            ! --- (0) zap_close_levels
+!                               0, &             ! --- (0) force_sfc_in_vinterp
+!                               !ids , ide , jds , jde , kds , sizegcm , &
+!                               !ims , ime , jms , jme , kms , sizegcm , &
+!                               !its , ite , jts , jte , kts , sizegcm )
+!                               ids , ide , jds , jde , kds , kde , &
+!                               ims , ime , jms , jme , kms , kme , &
+!                               its , ite , jts , jte , kts , kte )
+!
+!
+!        !-- save the new field and the new pressure coordinates
+!        !-- these will be regarded now as the inputs from the GCM
+!        grid%em_t_gc=grid%em_t_2
+!        grid%em_t_2(:,:,:)=0.
+!        grid%em_u_gc=grid%em_u_2
+!        grid%em_u_2(:,:,:)=0.
+!        grid%em_v_gc=grid%em_v_2
+!        grid%em_v_2(:,:,:)=0.
+!        grid%em_p_gc=grid%em_rh_gc      
+!        grid%em_rh_gc(:,:,:)=0.
+!!!!****MARS
+!!!****MARS
+
+
+
+
+         !  If we have the low-resolution surface elevation, stick that in the
+         !  "input" locations of the 3d height.  We still have the "hi-res" topo
+         !  stuck in the grid%em_ht array.  The grid%landmask if test is required as some sources
+         !  have ZERO elevation over water (thank you very much).
+
+         IF ( flag_soilhgt .EQ. 1) THEN
+            DO j = jts, MIN(jte,jde-1)
+               DO i = its, MIN(ite,ide-1)
+                  IF ( grid%landmask(i,j) .GT. 0.5 ) THEN
+                     grid%em_ght_gc(i,1,j) = grid%toposoil(i,j)
+                     grid%em_ht_gc(i,j)= grid%toposoil(i,j)
+                  END IF
+               END DO
+           END DO
+         END IF
+
+         !  Assign surface fields with original input values.  If this is hybrid data, 
+         !  the values are not exactly representative.  However - this is only for
+         !  plotting purposes and such at the 0h of the forecast, so we are not all that
+         !  worried.
+
+!****MARS
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide,ite)
+!               grid%u10(i,j)=grid%em_u_gc(i,1,j)
+!            END DO
+!         END DO
+!   
+!         DO j = jts, min(jde,jte)
+!            DO i = its, min(ide-1,ite)
+!               grid%v10(i,j)=grid%em_v_gc(i,1,j)
+!            END DO
+!         END DO
+!****MARS   
+
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide-1,ite)
+!               grid%t2(i,j)=grid%em_t_gc(i,1,j)
+!            END DO
+!         END DO
+
+  
+         !  The number of vertical levels in the input data.  There is no staggering for
+         !  different variables.
+   
+         num_metgrid_levels = grid%num_metgrid_levels
+
+         !  The requested ptop for real data cases.
+
+         p_top_requested = grid%p_top_requested
+
+         !  Compute the top pressure, grid%p_top.  For isobaric data, this is just the
+         !  top level.  For the generalized vertical coordinate data, we find the
+         !  max pressure on the top level.  We have to be careful of two things:
+         !  1) the value has to be communicated, 2) the value can not increase
+         !  at subsequent times from the initial value.
+
+         IF ( internal_time_loop .EQ. 1 ) THEN
+
+                CALL find_p_top ( grid%em_p_gc , grid%p_top , &
+                              ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                              ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                              its , ite , jts , jte , 1   , num_metgrid_levels )
+
+!! ^---- equivalent to:
+!!grid%ptop=MINVAL(grid%em_p_gc(:,:,:))
+
+
+
+!!!!obsolete
+!print *,'ptop GCM',grid%em_rh_gc(2,1,2)
+!IF (grid%em_rh_gc(2,1,2) == 0) THEN
+!        print *,'ptop cannot be 0' 
+!        stop        
+!ENDIF  
+!grid%p_top=grid%em_rh_gc(2,1,2)
+!!!!obsolete
+
+
+#ifdef DM_PARALLEL
+            grid%p_top = wrf_dm_max_real ( grid%p_top )
+#endif
+
+            !  Compare the requested grid%p_top with the value available from the input data.
+
+               print *,'p_top_requested = ',p_top_requested
+               print *,'allowable grid%p_top in data   = ',grid%p_top
+            IF ( p_top_requested .LT. grid%p_top ) THEN   
+               CALL wrf_error_fatal ( 'p_top_requested < grid%p_top possible from data' )
+            END IF
+
+            !  The grid%p_top valus is the max of what is available from the data and the
+            !  requested value.  We have already compared <, so grid%p_top is directly set to
+            !  the value in the namelist.
+
+            grid%p_top = p_top_requested
+
+            !  For subsequent times, we have to remember what the grid%p_top for the first
+            !  time was.  Why?  If we have a generalized vert coordinate, the grid%p_top value
+            !  could fluctuate.
+
+            p_top_save = grid%p_top
+
+         ELSE
+            CALL find_p_top ( grid%em_p_gc , grid%p_top , &
+                              ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                              ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                              its , ite , jts , jte , 1   , num_metgrid_levels )
+
+#ifdef DM_PARALLEL
+            grid%p_top = wrf_dm_max_real ( grid%p_top )
+#endif
+            IF ( grid%p_top .GT. p_top_save ) THEN
+               print *,'grid%p_top from last time period = ',p_top_save
+               print *,'grid%p_top from this time period = ',grid%p_top
+               CALL wrf_error_fatal ( 'grid%p_top > previous value' )
+            END IF
+            grid%p_top = p_top_save
+         ENDIF
+
+
+!****MARS
+!****MARS
+print *,'ptop GCM', grid%p_top
+print *,'sample: pressure at its jts'
+print *,grid%em_p_gc(its,:,jts)
+!****MARS
+!****MARS
+
+  
+
+!****MARS: useless 
+!****MARS: 
+!         !  Get the monthly values interpolated to the current date for the traditional monthly
+!         !  fields of green-ness fraction and background albedo.
+!   
+!         CALL monthly_interp_to_date ( grid%em_greenfrac , current_date , grid%vegfra , &
+!                                       ids , ide , jds , jde , kds , kde , &
+!                                       ims , ime , jms , jme , kms , kme , &
+!                                       its , ite , jts , jte , kts , kte )
+!  
+!         CALL monthly_interp_to_date ( grid%em_albedo12m , current_date , grid%albbck , &
+!                                       ids , ide , jds , jde , kds , kde , &
+!                                       ims , ime , jms , jme , kms , kme , &
+!                                       its , ite , jts , jte , kts , kte )
+!   
+!         !  Get the min/max of each i,j for the monthly green-ness fraction.
+!   
+!         CALL monthly_min_max ( grid%em_greenfrac , grid%shdmin , grid%shdmax , &
+!                                ids , ide , jds , jde , kds , kde , &
+!                                ims , ime , jms , jme , kms , kme , &
+!                                its , ite , jts , jte , kts , kte )
+!
+!          !  The model expects the green-ness values in percent, not fraction.
+!
+!         DO j = jts, MIN(jte,jde-1)
+!           DO i = its, MIN(ite,ide-1)
+!              grid%vegfra(i,j) = grid%vegfra(i,j) * 100.
+!              grid%shdmax(i,j) = grid%shdmax(i,j) * 100.
+!              grid%shdmin(i,j) = grid%shdmin(i,j) * 100.
+!           END DO
+!         END DO
+!
+!         !  The model expects the albedo fields as a fraction, not a percent.  Set the
+!         !  water values to 8%.
+!
+!         DO j = jts, MIN(jte,jde-1)
+!           DO i = its, MIN(ite,ide-1)   
+!		grid%albbck(i,j) = grid%albbck(i,j) / 100.
+!              grid%snoalb(i,j) = grid%snoalb(i,j) / 100.
+!              IF ( grid%landmask(i,j) .LT. 0.5 ) THEN
+!                 grid%albbck(i,j) = 0.08
+!                 grid%snoalb(i,j) = 0.08
+!              END IF
+!           END DO
+!         END DO
+!!****MARS:
+!!****MARS: useless 
+
+
+ 
+
+!!****MARS:  
+!         !  Compute the mixing ratio from the input relative humidity.
+!   
+!         IF ( flag_qv .NE. 1 ) THEN
+!            CALL rh_to_mxrat (grid%em_rh_gc, grid%em_t_gc, grid%em_p_gc, grid%em_qv_gc , .TRUE. , &
+!                              ids , ide , jds , jde , 1   , num_metgrid_levels , &
+!                              ims , ime , jms , jme , 1   , num_metgrid_levels , &
+!                              its , ite , jts , jte , 1   , num_metgrid_levels )
+!         END IF
+!!****MARS:
+!!grid%em_rh_gc are GCM equivalent eta_levels
+!!****MARS
+
+
+
+
+         !  Two ways to get the surface pressure.  1) If we have the low-res input surface
+         !  pressure and the low-res topography, then we can do a simple hydrostatic
+         !  relation.  2) Otherwise we compute the surface pressure from the sea-level
+         !  pressure.
+         !  Note that on output, grid%em_psfc is now hi-res.  The low-res surface pressure and 
+         !  elevation are grid%em_psfc_gc and grid%em_ht_gc (same as grid%em_ght_gc(k=1)).
+
+!!****MARS: switch off this option 
+!!****MARS: --> cf sfcprs2 and geopotential function at 500mb
+!         IF ( config_flags%adjust_heights ) THEN
+!            we_have_tavgsfc = ( flag_tavgsfc == 1 ) 
+!         ELSE
+!            we_have_tavgsfc = .FALSE.
+!         END IF
+!****MARS:
+we_have_tavgsfc = .FALSE.
+
+
+
+!****MARS: hi-res psfc is done if the flag 'sfcp_to_sfcp' is active (recommended)
+         IF ( ( flag_psfc .EQ. 1 ) .AND. ( flag_soilhgt .EQ. 1 ) .AND. &
+              ( config_flags%sfcp_to_sfcp ) ) THEN
+            print *,'compute psfc from hi-res topography'
+            CALL sfcprs2(grid%em_t_gc, grid%em_qv_gc, grid%em_ght_gc, grid%em_psfc_gc, grid%ht, &
+                         grid%em_tavgsfc, grid%em_p_gc, grid%psfc, we_have_tavgsfc, &
+                         ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                         ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                         its , ite , jts , jte , 1   , num_metgrid_levels )
+                         !****MARS: here, in reality, grid%em_p_gc is not used
+
+!****MARS: no sea-level pressure inputs possible
+!         ELSE
+!            CALL sfcprs (grid%em_t_gc, grid%em_qv_gc, grid%em_ght_gc, grid%em_pslv_gc, grid%ht, &
+!                         grid%em_tavgsfc, grid%em_p_gc, grid%psfc, we_have_tavgsfc, &
+!                         ids , ide , jds , jde , 1   , num_metgrid_levels , &
+!                         ims , ime , jms , jme , 1   , num_metgrid_levels , &
+!                         its , ite , jts , jte , 1   , num_metgrid_levels )
+!****MARS: no sea-level pressure inputs possible
+
+ 
+            !  If we have no input surface pressure, we'd better stick something in there.
+
+            IF ( flag_psfc .NE. 1 ) THEN
+               DO j = jts, MIN(jte,jde-1)
+                 DO i = its, MIN(ite,ide-1)
+                    grid%em_psfc_gc(i,j) = grid%psfc(i,j)
+                    grid%em_p_gc(i,1,j) = grid%psfc(i,j)
+                 END DO
+               END DO
+            END IF
+
+         END IF
+
+
+!!!****MARS: 
+!!!****MARS: old stuff
+!!! grid%em_p_gc is needed ... so it is computed from eta_gcm
+!
+!print *,'computing pressure levels for input data...'
+!
+!        !! pressure is computed from eta_gcm and hi-res topography
+!        DO j = jts, MIN(jte,jde-1)
+!        DO i = its, MIN(ite,ide-1)  
+!!!psfc ou em_psfc_gc ? em_psfc_gc, sinon c'est faux et déclenche instabilités 
+!grid%em_p_gc(i,:,j)=grid%em_rh_gc(i,:,j)*(grid%em_psfc_gc(i,j)-grid%em_rh_gc(2,1,2))+grid%em_rh_gc(2,1,2)
+!grid%em_p_gc(i,1,j)=grid%em_psfc_gc(i,j)
+!
+!
+!        END DO
+!        END DO
+!!
+!!****MARS: 
+
+
+
+         !!  Integrate the mixing ratio to get the vapor pressure.
+         !
+         !CALL integ_moist ( grid%em_qv_gc , grid%em_p_gc , grid%em_pd_gc , grid%em_t_gc , grid%em_ght_gc , grid%em_intq_gc , &
+         !                   ids , ide , jds , jde , 1   , num_metgrid_levels , &
+         !                   ims , ime , jms , jme , 1   , num_metgrid_levels , &
+         !                   its , ite , jts , jte , 1   , num_metgrid_levels )
+
+
+!!****MARS
+!!****MARS
+!! and now, convert the GCM sigma levels into WRF sigma levels using hi-res surface pressure 
+!!DO j = jts , MIN ( jde-1 , jte )
+!!DO i = its , MIN (ide-1 , ite )
+!!
+!!   grid%em_pd_gc(i,:,j)=ap(i,:,j)+bp(i,:,j)*grid%psfc(i,j)
+!!
+!!END DO
+!!END DO
+
+IF ( planet == "mars" ) then
+!--get vertical size of the GCM input array and allocate new stuff
+  sizegcm=SIZE(grid%em_rh_gc(1,:,1))
+  ALLOCATE(sig(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+  !ALLOCATE(ap(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+  ALLOCATE(bp(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+
+  DO j = jts , MIN ( jde-1 , jte )
+  DO i = its , MIN (ide-1 , ite )
+
+!!! Define old sigma levels for each column
+          sig(i,:,j)=grid%em_p_gc(i,:,j)/grid%em_psfc_gc(i,j)
+
+!!! Compute new sigma levels from old sigma levels with GCM (low-res) and WRF (hi-res) surface pressure 
+!!!                        (dimlevs,sigma_gcm, ps_gcm,                ps_hr,         sigma_hr)
+          CALL build_sigma_hr(sizegcm,sig(i,:,j),grid%em_psfc_gc(i,j),grid%psfc(i,j),bp(i,:,j))
+
+!!! Calculate new pressure levels
+          grid%em_pd_gc(i,:,j)=bp(i,:,j)*grid%psfc(i,j)
+
+  END DO
+  END DO
+
+  DEALLOCATE(sig)
+  DEALLOCATE(bp)
+
+!!****MARS who knows...
+  grid%em_rh_gc(:,:,:)=0.
+
+
+!!****MARS
+!grid%em_pd_gc=grid%em_p_gc
+!!****MARS
+ELSE ! VENUS
+
+
+   
+         !!  Compute the difference between the dry, total surface pressure (input) and the 
+         !!  dry top pressure (constant).
+         !
+           CALL p_dts ( grid%em_mu0 , grid%em_intq_gc , grid%psfc , grid%p_top , &
+                        ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                        ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                        its , ite , jts , jte , 1   , num_metgrid_levels )
+ENDIF
+IF ( planet == "mars" ) then
+!!****MARS
+  DO j = jts , MIN ( jde-1 , jte )
+  DO i = its , MIN (ide-1 , ite )
+
+     grid%em_mu0(i,j) = grid%psfc(i,j) - grid%p_top
+
+  END DO
+  END DO
+!!****MARS
+ELSE ! VENUS
+   
+         !!  Compute the dry, hydrostatic surface pressure.
+         !
+           CALL p_dhs ( grid%em_pdhs , grid%ht , p00 , t00 , a , &
+                        ids , ide , jds , jde , kds , kde , &
+                        ims , ime , jms , jme , kms , kme , &
+                        its , ite , jts , jte , kts , kte )
+ENDIF
+!!****MARS: voir remarques dans la routine
+!!****MARS: dry hydrostatic pressure comes from the GCM ...
+!        DO j = jts , MIN ( jde-1 , jte )
+!        DO i = its , MIN (ide-1 , ite )
+!              grid%em_pdhs(i,j) = grid%psfc(i,j)
+!        END DO
+!      	 END DO
+!!****MARS: em_pdhs ne sert qu'ici !         
+
+   
+         !  Compute the eta levels if not defined already.
+
+!!TODO: pb when ptop<1Pa
+         
+         IF ( grid%em_znw(1) .NE. 1.0 ) THEN
+   
+            eta_levels(1:kde) = model_config_rec%eta_levels(1:kde)
+            max_dz            = model_config_rec%max_dz
+
+!!****MARS
+IF (grid%force_sfc_in_vinterp == 0) grid%force_sfc_in_vinterp = 8
+!!default choice
+!!****MARS
+
+            CALL compute_eta ( grid%em_znw , &
+                               eta_levels , max_eta , max_dz , &
+grid%force_sfc_in_vinterp, &    !!ne sert pas par ailleurs
+                               grid%p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0 , &
+tiso, &
+                               ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte )
+         END IF
+  
+IF ( interp_theta ) THEN 
+         !  The input field is temperature, we want potential temp.
+!****MARS: here em_p_gc is really needed ! 
+         CALL t_to_theta ( grid%em_t_gc , grid%em_p_gc , p00 , &
+                           ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                           ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                           its , ite , jts , jte , 1   , num_metgrid_levels )
+ENDIF   
+
+
+
+         !  On the eta surfaces, compute the dry pressure = mu eta, stored in 
+         !  grid%em_pb, since it is a pressure, and we don't need another kms:kme 3d
+         !  array floating around.  The grid%em_pb array is re-computed as the base pressure
+         !  later after the vertical interpolations are complete.
+         CALL p_dry ( grid%em_mu0 , grid%em_znw , grid%p_top , grid%em_pb , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+print *, 'test sample' 
+print *, grid%em_pb(its+10,:,jts+10)
+print *, 'test sample 2' 
+print *, grid%em_pb(its,:,jts)
+
+
+!****MARS
+!****MARS: old stuff
+!****MARS
+!!! and now eta levels from the GCM are computed with the WRF ptop and GCM psfc
+!!! and em_pb is filled with WRF eta levels to prepare interpolation
+!print *,'computing eta levels for input data...'
+!        DO j = jts, MIN(jte,jde-1)
+!        DO i = its, MIN(ite,ide-1)
+!
+!!grid%em_psfc_gc: pb en haut!!!!
+!!!!valeurs plus grandes que 1 et extrapolation
+!!grid%em_p_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%psfc(i,j)-grid%p_top)
+!!!!utile si l'on est proche de la surface, mais pb plus haut !
+!grid%em_p_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%em_psfc_gc(i,j)-grid%p_top)
+!grid%em_pb(i,:,j)=grid%em_znw(:)
+!
+!!
+!!!!manage negative values
+!!DO k=1,num_metgrid_levels
+!!        grid%em_p_gc(i,k,j)=MAX(0.,grid%em_p_gc(i,k,j))
+!!END DO
+!!
+!
+!        END DO
+!        END DO
+!!
+!!print *,'sample: eta GCM at its jts'
+!!print *,grid%em_p_gc(its,:,jts)
+!!print *,'sample: eta WRF at its jts'
+!!print *,grid%em_pb(its,:,jts)
+!!
+!!print *,grid%em_p_gc(:,2,:)
+!!print *, 'yeah yeah'
+!!grid%em_pd_gc(:,:,:)=grid%em_p_gc(:,:,:)
+!!
+!****MARS
+!****MARS: old stuff
+!****MARS
+
+
+
+
+         !  All of the vertical interpolations are done in dry-pressure space.  The
+         !  input data has had the moisture removed (grid%em_pd_gc).  The target levels (grid%em_pb)
+         !  had the vapor pressure removed from the surface pressure, then they were
+         !  scaled by the eta levels.
+
+         interp_type = grid%interp_type
+         lagrange_order = grid%lagrange_order
+         lowest_lev_from_sfc = grid%lowest_lev_from_sfc
+         zap_close_levels = grid%zap_close_levels
+         force_sfc_in_vinterp = grid%force_sfc_in_vinterp
+
+         !!****MARS: normalement c'est vert_interp
+         !!****MARS: mais les résultats sont trop discontinus > retour à une
+         !!****MARS: interpolation plus classique
+         CALL vert_interp_old ( grid%em_qv_gc , grid%em_pd_gc , moist(:,:,:,P_QV) , grid%em_pb , &
+                            num_metgrid_levels , 'Q' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+         !  Depending on the setting of interp_theta = T/F, t_gc is is either theta Xor 
+         !  temperature, and that means that the t_2 field is also the associated field.
+         !  It is better to interpolate temperature and potential temperature in LOG(p),
+         !  regardless of requested default.
+
+         !!****MARS: normalement c'est vert_interp
+         CALL vert_interp_old ( grid%em_t_gc , grid%em_pd_gc , grid%em_t_2               , grid%em_pb , &
+                            num_metgrid_levels , 'T' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+         IF ( .NOT. interp_theta ) THEN
+
+            !! correction Wee et al. 2012 
+            !! first interpolate temperature (see above)
+            !! then interpolate pressure
+            !! and in the end compute potential temperature
+
+            !! scalar just an intermediate thing for interpolated pressure 
+            !! -- it is reinitialized afterwards
+            !! It is better to interpolate pressure in p regardless default options
+            CALL vert_interp_old ( grid%em_p_gc , grid%em_pd_gc , scalar(:,:,:,1)         , grid%em_pb , &
+                            num_metgrid_levels , 'T' , &
+                            1, lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+            CALL t_to_theta ( grid%em_t_2 , scalar(:,:,:,1) , p00 , &
+                              ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte )
+      
+            scalar(:,:,:,1) = 0.
+         END IF
+
+
+                        
+!!!!!!****MARS****!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!! ****MARS MARS MARS for order in rank for each option, check in REGISTRY.EM
+!!!!!!       [a little bit too hardcoded here unfortunately... but e.g. P_QH2O must be known]
+!!!!!!       [there is a more flexible option with flags in metgrid.tbl, TBD?]
+!!!!!! NB: real_em.F must also be modified 
+!!!!!! NB2: qvapor is not used to avoid collision with earth-related calculations
+if ( ( config_flags%mars == 2 ) .OR. ( config_flags%mars == 3 ) ) then
+       print *, '**** INTERPOLATE DUSTQ **** RANK 2 in SCALAR'
+       CALL vert_interp_old ( grid%em_dustq_gc , grid%em_pd_gc , scalar(:,:,:,2) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+endif        
+if ( ( config_flags%mars == 3 ) ) then
+       print *, '**** INTERPOLATE DUSTN **** RANK 3 in SCALAR'
+       CALL vert_interp_old ( grid%em_dustn_gc , grid%em_pd_gc , scalar(:,:,:,3) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+endif        
+if ( ( config_flags%mars == 1 ) .OR. ( config_flags%mars == 11 ) .OR. ( config_flags%mars == 12 ) .OR. ( config_flags%mars == 32 ) ) then
+       print *, '**** INTERPOLATE HV **** RANK 2 in SCALAR'
+       !print *, size(scalar(0,0,0,:)), P_QH2O, P_QH2O_ICE
+       CALL vert_interp_old ( grid%em_hv_gc , grid%em_pd_gc , scalar(:,:,:,2) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+       print *, '**** INTERPOLATE HI **** RANK 3 in SCALAR'
+       CALL vert_interp_old ( grid%em_hi_gc , grid%em_pd_gc , scalar(:,:,:,3) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+endif
+#ifdef NEWPHYS
+if ( (config_flags%mars == 10) ) then
+       print *, '**** INTERPOLATE CO2 **** RANK 2 in SCALAR'
+       CALL vert_interp_old ( grid%em_co2_gc , grid%em_pd_gc , scalar(:,:,:,2) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+endif
+if ( (config_flags%mars == 11) .OR. (config_flags%mars == 12) .OR. (config_flags%mars == 32) ) then
+       print *, '**** INTERPOLATE DUSTQ **** RANK 4 in SCALAR'             
+       CALL vert_interp_old ( grid%em_dustq_gc , grid%em_pd_gc , scalar(:,:,:,4) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+       print *, '**** INTERPOLATE DUSTN **** RANK 5 in SCALAR'
+       CALL vert_interp_old ( grid%em_dustn_gc , grid%em_pd_gc , scalar(:,:,:,5) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+endif
+if ( (config_flags%mars == 12) .OR. (config_flags%mars == 32) ) then
+       print *, '**** INTERPOLATE CCNQ **** RANK 6 in SCALAR'
+       CALL vert_interp_old ( grid%em_ccnq_gc , grid%em_pd_gc , scalar(:,:,:,6) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+       print *, '**** INTERPOLATE CCNN **** RANK 7 in SCALAR'
+       CALL vert_interp_old ( grid%em_ccnn_gc , grid%em_pd_gc , scalar(:,:,:,7) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+endif
+if ( (config_flags%mars == 32) ) then
+       print *, '**** INTERPOLATE CO2 **** RANK 8 in SCALAR'
+       CALL vert_interp_old ( grid%em_co2_gc , grid%em_pd_gc , scalar(:,:,:,8) , grid%em_pb , &
+                                    num_metgrid_levels , 'Q' , &
+                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                    zap_close_levels , force_sfc_in_vinterp , &
+                                    ids , ide , jds , jde , kds , kde , &
+                                    ims , ime , jms , jme , kms , kme , &
+                                    its , ite , jts , jte , kts , kte )
+       print *, '**** set other CO2 tracers to 0'
+       scalar(:,:,:,9) = 0.
+       scalar(:,:,:,10) = 0.
+       scalar(:,:,:,11) = 0.
+endif
+#endif
+
+!#ifdef NEWPHYS
+!!VENUS photochemistry
+!if ( config_flags%mars == 34 ) then
+!       print*,'grid%em_qco2_gc',grid%em_qco2_gc(0,:,0)
+!       CALL vert_interp_old ( grid%em_qco2_gc , grid%em_pd_gc , scalar(:,:,:,2) , grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order , lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qco_gc , grid%em_pd_gc , scalar(:,:,:,3), grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order ,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qh2_gc , grid%em_pd_gc , scalar(:,:,:,4),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qh2o_gc , grid%em_pd_gc , scalar(:,:,:,5),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qo1d_gc , grid%em_pd_gc , scalar(:,:,:,6),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qo_gc , grid%em_pd_gc , scalar(:,:,:,7),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qo2_gc , grid%em_pd_gc , scalar(:,:,:,8),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qo2dg_gc , grid%em_pd_gc , scalar(:,:,:,9),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qo3_gc , grid%em_pd_gc , scalar(:,:,:,10),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qh_gc , grid%em_pd_gc , scalar(:,:,:,11),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qoh_gc , grid%em_pd_gc , scalar(:,:,:,12), grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qho2_gc , grid%em_pd_gc , scalar(:,:,:,13),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qh2o2_gc , grid%em_pd_gc , scalar(:,:,:,14),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qcl_gc , grid%em_pd_gc , scalar(:,:,:,15),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order ,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qclo_gc , grid%em_pd_gc , scalar(:,:,:,16),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qcl2_gc , grid%em_pd_gc , scalar(:,:,:,17),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qhcl_gc , grid%em_pd_gc , scalar(:,:,:,18),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qhocl_gc , grid%em_pd_gc , scalar(:,:,:,19),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qclco_gc , grid%em_pd_gc , scalar(:,:,:,20),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qclco3_gc , grid%em_pd_gc , scalar(:,:,:,21),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qcocl2_gc , grid%em_pd_gc , scalar(:,:,:,22),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qs_gc , grid%em_pd_gc , scalar(:,:,:,23), grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order ,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qso_gc , grid%em_pd_gc , scalar(:,:,:,24),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qso2_gc , grid%em_pd_gc , scalar(:,:,:,25), grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order ,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qo3_gc , grid%em_pd_gc , scalar(:,:,:,26),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order ,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qs2o2_gc , grid%em_pd_gc , scalar(:,:,:,27),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qocs_gc , grid%em_pd_gc , scalar(:,:,:,28),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qhso3_gc , grid%em_pd_gc , scalar(:,:,:,29),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qh2so4_gc , grid%em_pd_gc , scalar(:,:,:,30),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qs2_gc , grid%em_pd_gc , scalar(:,:,:,31),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qclso2_gc , grid%em_pd_gc , scalar(:,:,:,32),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qoscl_gc , grid%em_pd_gc , scalar(:,:,:,33),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qh2oliq_gc , grid%em_pd_gc , scalar(:,:,:,34),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!       CALL vert_interp_old ( grid%em_qh2so4liq_gc , grid%em_pd_gc , scalar(:,:,:,35),grid%em_pb , &
+!                                    num_metgrid_levels , 'Q' , &
+!                                    interp_type , lagrange_order,lowest_lev_from_sfc , &
+!                                    zap_close_levels , force_sfc_in_vinterp , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte )
+!
+!endif
+!#endif
+
+!!! we want any scalar (i.e. tracer) to be positive
+!!! and because of interpolation it is possible that negative values occur...
+WHERE( scalar < 0. )  scalar = 0.
+
+!!!!!!****MARS****!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+#if 0
+         !  Uncomment the Registry entries to activate these.  This adds
+         !  noticeably to the allocated space for the model.
+
+         IF ( flag_qr .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QR ) THEN
+                  CALL vert_interp_old ( qr_gc , grid%em_pd_gc , moist(:,:,:,P_QR) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+    
+         IF ( flag_qc .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QC ) THEN
+                  CALL vert_interp_old ( qc_gc , grid%em_pd_gc , moist(:,:,:,P_QC) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+   
+         IF ( flag_qi .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QI ) THEN
+                  CALL vert_interp_old ( qi_gc , grid%em_pd_gc , moist(:,:,:,P_QI) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+   
+         IF ( flag_qs .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QS ) THEN
+                  CALL vert_interp_old ( qs_gc , grid%em_pd_gc , moist(:,:,:,P_QS) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+   
+         IF ( flag_qg .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QG ) THEN
+                  CALL vert_interp_old ( qg_gc , grid%em_pd_gc , moist(:,:,:,P_QG) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+#endif
+   
+#ifdef DM_PARALLEL
+         ips = its ; ipe = ite ; jps = jts ; jpe = jte ; kps = kts ; kpe = kte
+
+         !  For the U and V vertical interpolation, we need the pressure defined
+         !  at both the locations for the horizontal momentum, which we get by
+         !  averaging two pressure values (i and i-1 for U, j and j-1 for V).  The
+         !  pressure field on input (grid%em_pd_gc) and the pressure of the new coordinate
+         !  (grid%em_pb) are both communicated with an 8 stencil.
+
+#   include "HALO_EM_VINTERP_UV_1.inc"
+#endif
+
+        !!****MARS: normalement c'est vert_interp
+        CALL vert_interp_old ( grid%em_u_gc , grid%em_pd_gc , grid%em_u_2, grid%em_pb , &
+                            num_metgrid_levels , 'U' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+        !!****MARS: normalement c'est vert_interp   
+        CALL vert_interp_old ( grid%em_v_gc , grid%em_pd_gc , grid%em_v_2, grid%em_pb , &
+                        num_metgrid_levels , 'V' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+
+!!****MARS
+!!****MARS
+!!
+!! old obsolete method
+!! -------------------
+!!
+!!! and now eta levels from the GCM are computed with the WRF ptop and GCM psfc
+!!! and em_pb is filled with WRF eta levels to prepare interpolation
+!print *,'computing eta levels for input data...'
+!
+!        DO j = jts, MIN(jte,jde-1)
+!        DO i = its, MIN(ite,ide-1)
+!
+!!       grid%em_psfc_gc: pb en haut!!!!
+!!!!valeurs plus grandes que 1 et extrapolation
+!!       grid%em_p_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%psfc(i,j)-grid%p_top)
+!!!!utile si l'on est proche de la surface, mais pb plus haut !
+!grid%em_pd_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%em_psfc_gc(i,j)-grid%p_top)
+!grid%em_pb(i,:,j)=grid%em_znw(:)
+!
+!!
+!!!!manage negative values
+!!DO k=1,num_metgrid_levels
+!!        grid%em_p_gc(i,k,j)=MAX(0.,grid%em_p_gc(i,k,j))
+!!END DO
+!!
+!
+!        END DO
+!        END DO
+!
+!print *,'sample: eta GCM at its jts'
+!print *,grid%em_pd_gc(its,:,jts)
+!print *,'sample: eta WRF at its jts'
+!print *,grid%em_pb(its,:,jts)
+!!
+!!!****MARS
+!
+!
+!
+!!!!****MARS
+!!!!
+!!!!grid%force_sfc_in_vinterp ne sert pas dans vert_interp_old :)
+!!!!peut donc servir pour préciser le nombre de niveaux
+!!!!pris à partir de l'interpolation eta
+!
+!IF (grid%force_sfc_in_vinterp .NE. 0) THEN
+!
+!         !!!save in an array that is now unused
+!         !!!the previously performed pressure interpolation
+!         grid%em_qv_gc(:,:,:)=grid%em_t_2(:,:,:)
+!
+!
+!         !!!perform interpolation on eta levels
+!         print *, 'interpolate on eta levels for near-surface fields' 
+!         CALL vert_interp_old ( grid%em_t_gc , grid%em_pd_gc , grid%em_t_2, grid%em_pb , &
+!                            num_metgrid_levels , 'T' , &
+!                            interp_type , lagrange_order , lowest_lev_from_sfc ,&
+!                            zap_close_levels , force_sfc_in_vinterp , &
+!                            ids , ide , jds , jde , kds , kde , &
+!                            ims , ime , jms , jme , kms , kme , &
+!                            its , ite , jts , jte , kts , kte )
+!
+!         !!!take the first layers from the eta interpolation
+!         print *, 'the first ', &
+!                grid%force_sfc_in_vinterp, &
+!                'layers will be taken from eta interpolation'
+!         grid%em_qv_gc(:,1:grid%force_sfc_in_vinterp,:)=grid%em_t_2(:,1:grid%force_sfc_in_vinterp,:)
+!
+!         !!!fix the possible little discontinuity at the limit
+!         !!!between the two interpolation methods
+!         grid%em_qv_gc(:,grid%force_sfc_in_vinterp+1,:)=  &
+!                0.5*(grid%em_t_2(:,grid%force_sfc_in_vinterp,:) + &     !!eta interpolation below
+!                        grid%em_qv_gc(:,grid%force_sfc_in_vinterp+2,:))  !!pressure interpolation above
+!         
+!
+!         !!!assign the final result in t_2
+!         grid%em_t_2(:,:,:)=grid%em_qv_gc(:,:,:)
+!         grid%em_qv_gc(:,:,:)=0.
+!
+!
+!ELSE
+!
+!
+!ENDIF
+!!****MARS
+!!****MARS
+
+
+      END IF     !   <----- END OF VERTICAL INTERPOLATION PART ---->
+
+
+
+!****MARS: no need
+!      !  Protect against bad grid%em_tsk values over water by supplying grid%sst (if it is 
+!      !  available, and if the grid%sst is reasonable).
+!
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+!                 ( grid%sst(i,j) .GT. 200. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+!               grid%tsk(i,j) = grid%sst(i,j)
+!            ENDIF            
+!         END DO
+!      END DO
+!
+!      !  Save the grid%em_tsk field for later use in the sea ice surface temperature
+!      !  for the Noah LSM scheme.
+!
+!       DO j = jts, MIN(jte,jde-1)
+!         DO i = its, MIN(ite,ide-1)
+!            grid%tsk_save(i,j) = grid%tsk(i,j)
+!         END DO
+!      END DO
+!
+!!****MARS: no need
+!      !  Take the data from the input file and store it in the variables that
+!      !  use the WRF naming and ordering conventions.
+!
+!       DO j = jts, MIN(jte,jde-1)
+!         DO i = its, MIN(ite,ide-1)
+!            IF ( grid%snow(i,j) .GE. 10. ) then
+!               grid%snowc(i,j) = 1.
+!            ELSE
+!               grid%snowc(i,j) = 0.0
+!            END IF
+!         END DO
+!      END DO
+!
+!      !  Set flag integers for presence of snowh and soilw fields
+!
+!      grid%ifndsnowh = flag_snowh
+!      IF (num_sw_levels_input .GE. 1) THEN
+!         grid%ifndsoilw = 1
+!      ELSE
+!         grid%ifndsoilw = 0
+!      END IF
+!
+!****MARS: no need
+!      !  We require input data for the various LSM schemes.
+!
+!      enough_data : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE (LSMSCHEME)
+!            IF ( num_st_levels_input .LT. 2 ) THEN
+!               CALL wrf_error_fatal ( 'Not enough soil temperature data for Noah LSM scheme.')
+!            END IF
+!
+!         CASE (RUCLSMSCHEME)
+!            IF ( num_st_levels_input .LT. 2 ) THEN
+!               CALL wrf_error_fatal ( 'Not enough soil temperature data for RUC LSM scheme.')
+!            END IF
+!
+!      END SELECT enough_data
+!
+!      !  For sf_surface_physics = 1, we want to use close to a 30 cm value
+!      !  for the bottom level of the soil temps.
+!
+!      fix_bottom_level_for_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE (SLABSCHEME)
+!            IF      ( flag_tavgsfc  .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%em_tavgsfc(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_st010040 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%st010040(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_st000010 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%st000010(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_soilt020 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%soilt020(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_st007028 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%st007028(i,j)
+!                  END DO
+!               END DO
+!            ELSE
+!               CALL wrf_debug ( 0 , 'No 10-40 cm, 0-10 cm, 7-28, or 20 cm soil temperature data for grid%em_tmn')
+!               CALL wrf_debug ( 0 , 'Using 1 degree static annual mean temps' )
+!            END IF
+!
+!         CASE (LSMSCHEME)
+!
+!         CASE (RUCLSMSCHEME)
+!
+!      END SELECT fix_bottom_level_for_temp
+!
+!      !  Adjustments for the seaice field PRIOR to the grid%tslb computations.  This is
+!      !  is for the 5-layer scheme.
+!
+!      num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+!      num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+!      num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+!      CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+!      CALL nl_get_isice ( grid%id , grid%isice )
+!      CALL nl_get_iswater ( grid%id , grid%iswater )
+!      CALL adjust_for_seaice_pre ( grid%xice , grid%landmask , grid%tsk , grid%ivgtyp , grid%vegcat , grid%lu_index , &
+!                                   grid%xland , grid%landusef , grid%isltyp , grid%soilcat , grid%soilctop , &
+!                                   grid%soilcbot , grid%tmn , &
+!                                   grid%seaice_threshold , &
+!                                   num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+!                                   grid%iswater , grid%isice , &
+!                                   model_config_rec%sf_surface_physics(grid%id) , & 
+!                                   ids , ide , jds , jde , kds , kde , & 
+!                                   ims , ime , jms , jme , kms , kme , & 
+!                                   its , ite , jts , jte , kts , kte ) 
+!
+!      !  surface_input_source=1 => use data from static file (fractional category as input)
+!      !  surface_input_source=2 => use data from grib file (dominant category as input)
+!  
+!      IF ( config_flags%surface_input_source .EQ. 1 ) THEN
+!         grid%vegcat (its,jts) = 0
+!         grid%soilcat(its,jts) = 0
+!      END IF
+!
+!      !  Generate the vegetation and soil category information from the fractional input
+!      !  data, or use the existing dominant category fields if they exist.
+!
+!      IF ( ( grid%soilcat(its,jts) .LT. 0.5 ) .AND. ( grid%vegcat(its,jts) .LT. 0.5 ) ) THEN
+!
+!         num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+!         num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+!         num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+!   
+!         CALL process_percent_cat_new ( grid%landmask , &               
+!                                    grid%landusef , grid%soilctop , grid%soilcbot , &
+!                                    grid%isltyp , grid%ivgtyp , &
+!                                    num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte , &
+!                                    model_config_rec%iswater(grid%id) )
+!
+!         !  Make all the veg/soil parms the same so as not to confuse the developer.
+!
+!         DO j = jts , MIN(jde-1,jte)
+!            DO i = its , MIN(ide-1,ite)
+!               grid%vegcat(i,j)  = grid%ivgtyp(i,j)
+!               grid%soilcat(i,j) = grid%isltyp(i,j)
+!            END DO
+!         END DO
+!
+!      ELSE
+!
+!         !  Do we have dominant soil and veg data from the input already?
+!   
+!         IF ( grid%soilcat(its,jts) .GT. 0.5 ) THEN
+!            DO j = jts, MIN(jde-1,jte)
+!               DO i = its, MIN(ide-1,ite)
+!                  grid%isltyp(i,j) = NINT( grid%soilcat(i,j) )
+!               END DO
+!            END DO
+!         END IF
+!         IF ( grid%vegcat(its,jts) .GT. 0.5 ) THEN
+!            DO j = jts, MIN(jde-1,jte)
+!               DO i = its, MIN(ide-1,ite)
+!                  grid%ivgtyp(i,j) = NINT( grid%vegcat(i,j) )
+!               END DO
+!            END DO
+!         END IF
+!
+!      END IF
+!         
+!      !  Land use assignment.
+!
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            grid%lu_index(i,j) = grid%ivgtyp(i,j)
+!            IF ( grid%lu_index(i,j) .NE. model_config_rec%iswater(grid%id) ) THEN
+!               grid%landmask(i,j) = 1
+!               grid%xland(i,j)    = 1
+!            ELSE
+!               grid%landmask(i,j) = 0
+!               grid%xland(i,j)    = 2
+!            END IF
+!         END DO
+!      END DO
+!
+!      !  Adjust the various soil temperature values depending on the difference in
+!      !  in elevation between the current model's elevation and the incoming data's
+!      !  orography.
+!         
+!      IF ( flag_soilhgt .EQ. 1 ) THEN
+!         adjust_soil : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!            CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+!               CALL adjust_soil_temp_new ( grid%tmn , model_config_rec%sf_surface_physics(grid%id) , &
+!                                           grid%tsk , grid%ht , grid%toposoil , grid%landmask , flag_soilhgt , &
+!                                           grid%st000010 , grid%st010040 , grid%st040100 , grid%st100200 , grid%st010200 , &
+!                                           flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
+!                                           grid%st000007 , grid%st007028 , grid%st028100 , grid%st100255 , &
+!                                           flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
+!                                           grid%soilt000 , grid%soilt005 , grid%soilt020 , grid%soilt040 , grid%soilt160 , &
+!                                           grid%soilt300 , &
+!                                           flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , &
+!                                           flag_soilt160 , flag_soilt300 , &
+!                                           ids , ide , jds , jde , kds , kde , &
+!                                           ims , ime , jms , jme , kms , kme , &
+!                                           its , ite , jts , jte , kts , kte )
+!
+!         END SELECT adjust_soil
+!      END IF
+!
+!      !  Fix grid%em_tmn and grid%em_tsk.
+!
+!      fix_tsk_tmn : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+!            DO j = jts, MIN(jde-1,jte)
+!               DO i = its, MIN(ide-1,ite)
+!                  IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+!                       ( grid%sst(i,j) .GT. 240. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+!                     grid%tmn(i,j) = grid%sst(i,j)
+!                     grid%tsk(i,j) = grid%sst(i,j)
+!                  ELSE IF ( grid%landmask(i,j) .LT. 0.5 ) THEN
+!                     grid%tmn(i,j) = grid%tsk(i,j)
+!                  END IF
+!               END DO
+!            END DO
+!      END SELECT fix_tsk_tmn
+!    
+!      !  Is the grid%em_tsk reasonable?
+!
+
+
+!!**** MARS
+         DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+                !!grid%tsk(i,j)=200
+                grid%tmn(i,j)=0  
+                grid%sst(i,j)=0  !!no use on Mars!!
+                grid%tslb(i,:,j)=0  !!tslb is 3D field 
+               END DO
+            END DO
+!!**** MARS
+
+!      IF ( internal_time_loop .NE. 1 ) THEN
+!         DO j = jts, MIN(jde-1,jte)
+!            DO i = its, MIN(ide-1,ite)
+!               IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+!                  grid%tsk(i,j) = grid%em_t_2(i,1,j)
+!               END IF
+!            END DO
+!         END DO
+!      ELSE
+!         DO j = jts, MIN(jde-1,jte)
+!            DO i = its, MIN(ide-1,ite)
+!               IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+!                  print *,'error in the grid%em_tsk'
+!                  print *,'i,j=',i,j
+!                  print *,'grid%landmask=',grid%landmask(i,j)
+!                  print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+!                  if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+!                     grid%tsk(i,j)=grid%tmn(i,j)
+!                  else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+!                     grid%tsk(i,j)=grid%sst(i,j)
+!                  else
+!                     CALL wrf_error_fatal ( 'grid%em_tsk unreasonable' )
+!                  end if
+!               END IF
+!            END DO
+!         END DO
+!      END IF
+!
+!      !  Is the grid%em_tmn reasonable?
+!
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            IF ( ( ( grid%tmn(i,j) .LT. 170. ) .OR. ( grid%tmn(i,j) .GT. 400. ) ) &
+!               .AND. ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+!               IF ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME ) THEN
+!                  print *,'error in the grid%em_tmn'
+!                  print *,'i,j=',i,j
+!                  print *,'grid%landmask=',grid%landmask(i,j)
+!                  print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+!               END IF
+!
+!               if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+!                  grid%tmn(i,j)=grid%tsk(i,j)
+!               else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+!                  grid%tmn(i,j)=grid%sst(i,j)
+!               else
+!                  CALL wrf_error_fatal ( 'grid%em_tmn unreasonable' )
+!               endif
+!            END IF
+!         END DO
+!      END DO
+!   
+!      interpolate_soil_tmw : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+!            CALL process_soil_real ( grid%tsk , grid%tmn , &
+!                                  grid%landmask , grid%sst , &
+!                                  st_input , sm_input , sw_input , st_levels_input , sm_levels_input , sw_levels_input , &
+!                                  grid%zs , grid%dzs , grid%tslb , grid%smois , grid%sh2o , &
+!                                  flag_sst , flag_soilt000, flag_soilm000, &
+!                                  ids , ide , jds , jde , kds , kde , &
+!                                  ims , ime , jms , jme , kms , kme , &
+!                                  its , ite , jts , jte , kts , kte , &
+!                                  model_config_rec%sf_surface_physics(grid%id) , &
+!                                  model_config_rec%num_soil_layers , &
+!                                  model_config_rec%real_data_init_type , &
+!                                  num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+!                                  num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc )
+!
+!      END SELECT interpolate_soil_tmw
+!
+!      !  Minimum soil values, residual, from RUC LSM scheme.  For input from Noah and using
+!      !  RUC LSM scheme, this must be subtracted from the input total soil moisture.  For
+!      !  input RUC data and using the Noah LSM scheme, this value must be added to the soil
+!      !  moisture input.
+!
+!      lqmi(1:num_soil_top_cat) = &
+!      (/0.045, 0.057, 0.065, 0.067, 0.034, 0.078, 0.10,     &
+!        0.089, 0.095, 0.10,  0.070, 0.068, 0.078, 0.0,      &
+!        0.004, 0.065 /)
+!!       0.004, 0.065, 0.020, 0.004, 0.008 /)  !  has extra levels for playa, lava, and white sand
+!
+!      !  At the initial time we care about values of soil moisture and temperature, other times are
+!      !  ignored by the model, so we ignore them, too.  
+!
+!      IF ( domain_ClockIsStartTime(grid) ) THEN
+!         account_for_zero_soil_moisture : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!   
+!            CASE ( LSMSCHEME )
+!               iicount = 0
+!               IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+!                             ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+!                           print *,'Noah -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+!                           iicount = iicount + 1
+!                           grid%smois(i,:,j) = 0.005
+!                        END IF
+!                     END DO
+!                  END DO
+!                  IF ( iicount .GT. 0 ) THEN
+!                     print *,'Noah -> Noah: total number of small soil moisture locations = ',iicount
+!                  END IF
+!               ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        grid%smois(i,:,j) = grid%smois(i,:,j) + lqmi(grid%isltyp(i,j))
+!                     END DO
+!                  END DO
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+!                             ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+!                           print *,'RUC -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+!                           iicount = iicount + 1
+!                           grid%smois(i,:,j) = 0.005
+!                        END IF
+!                     END DO
+!                  END DO
+!                  IF ( iicount .GT. 0 ) THEN
+!                     print *,'RUC -> Noah: total number of small soil moisture locations = ',iicount
+!                  END IF
+!               END IF
+!   
+!            CASE ( RUCLSMSCHEME )
+!               iicount = 0
+!               IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        grid%smois(i,:,j) = MAX ( grid%smois(i,:,j) - lqmi(grid%isltyp(i,j)) , 0. )
+!                     END DO
+!                  END DO
+!               ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+!                  ! no op
+!               END IF
+!   
+!         END SELECT account_for_zero_soil_moisture
+!      END IF
+!
+!      !  Is the grid%tslb reasonable?
+!
+!      IF ( internal_time_loop .NE. 1 ) THEN
+!         DO j = jts, MIN(jde-1,jte)
+!            DO ns = 1 , model_config_rec%num_soil_layers
+!               DO i = its, MIN(ide-1,ite)
+!                  IF ( grid%tslb(i,ns,j) .LT. 170 .or. grid%tslb(i,ns,j) .GT. 400. ) THEN
+!                     grid%tslb(i,ns,j) = grid%em_t_2(i,1,j)
+!                     grid%smois(i,ns,j) = 0.3
+!                  END IF
+!               END DO
+!            END DO
+!         END DO
+!      ELSE
+!         DO j = jts, MIN(jde-1,jte)
+!            DO i = its, MIN(ide-1,ite)
+!               IF ( ( ( grid%tslb(i,1,j) .LT. 170. ) .OR. ( grid%tslb(i,1,j) .GT. 400. ) ) .AND. &
+!                       ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+!                     IF ( ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME    ) .AND. &
+!                          ( model_config_rec%sf_surface_physics(grid%id) .NE. RUCLSMSCHEME ) ) THEN
+!                        print *,'error in the grid%tslb'
+!                        print *,'i,j=',i,j
+!                        print *,'grid%landmask=',grid%landmask(i,j)
+!                        print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+!                        print *,'grid%tslb = ',grid%tslb(i,:,j)
+!                        print *,'old grid%smois = ',grid%smois(i,:,j)
+!                        grid%smois(i,1,j) = 0.3
+!                        grid%smois(i,2,j) = 0.3
+!                        grid%smois(i,3,j) = 0.3
+!                        grid%smois(i,4,j) = 0.3
+!                     END IF
+!   
+!                     IF ( (grid%tsk(i,j).GT.170. .AND. grid%tsk(i,j).LT.400.) .AND. &
+!                          (grid%tmn(i,j).GT.170. .AND. grid%tmn(i,j).LT.400.) ) THEN
+!                        fake_soil_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!                           CASE ( SLABSCHEME )
+!                              DO ns = 1 , model_config_rec%num_soil_layers
+!                                 grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+!                                                       grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+!                              END DO
+!                           CASE ( LSMSCHEME , RUCLSMSCHEME )
+!                              CALL wrf_error_fatal ( 'Assigning constant soil moisture, bad idea')
+!                              DO ns = 1 , model_config_rec%num_soil_layers
+!                                 grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+!                                                       grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+!                              END DO
+!                        END SELECT fake_soil_temp
+!                     else if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 1' )
+!                        DO ns = 1 , model_config_rec%num_soil_layers
+!                           grid%tslb(i,ns,j)=grid%tsk(i,j)
+!                        END DO
+!                     else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 2' )
+!                        DO ns = 1 , model_config_rec%num_soil_layers
+!                           grid%tslb(i,ns,j)=grid%sst(i,j)
+!                        END DO
+!                     else if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 3' )
+!                        DO ns = 1 , model_config_rec%num_soil_layers
+!                           grid%tslb(i,ns,j)=grid%tmn(i,j)
+!                        END DO
+!                     else
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 4' )
+!                     endif
+!               END IF
+!            END DO
+!         END DO
+!      END IF
+!
+!      !  Adjustments for the seaice field AFTER the grid%tslb computations.  This is
+!      !  is for the Noah LSM scheme.
+!
+!      num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+!      num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+!      num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+!      CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+!      CALL nl_get_isice ( grid%id , grid%isice )
+!      CALL nl_get_iswater ( grid%id , grid%iswater )
+!      CALL adjust_for_seaice_post ( grid%xice , grid%landmask , grid%tsk , grid%tsk_save , &
+!                                    grid%ivgtyp , grid%vegcat , grid%lu_index , &
+!                                    grid%xland , grid%landusef , grid%isltyp , grid%soilcat ,  &
+!                                    grid%soilctop , &
+!                                    grid%soilcbot , grid%tmn , grid%vegfra , &
+!                                    grid%tslb , grid%smois , grid%sh2o , &
+!                                    grid%seaice_threshold , &
+!                                    num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+!                                    model_config_rec%num_soil_layers , &
+!                                    grid%iswater , grid%isice , &
+!                                    model_config_rec%sf_surface_physics(grid%id) , & 
+!                                    ids , ide , jds , jde , kds , kde , & 
+!                                    ims , ime , jms , jme , kms , kme , & 
+!                                    its , ite , jts , jte , kts , kte ) 
+!
+!      !  Let us make sure (again) that the grid%landmask and the veg/soil categories match.
+!
+!oops1=0
+!oops2=0
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            IF ( ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. &
+!                   ( grid%ivgtyp(i,j) .NE. config_flags%iswater .OR. grid%isltyp(i,j) .NE. 14 ) ) .OR. &
+!                 ( ( grid%landmask(i,j) .GT. 0.5 ) .AND. &
+!                   ( grid%ivgtyp(i,j) .EQ. config_flags%iswater .OR. grid%isltyp(i,j) .EQ. 14 ) ) ) THEN
+!               IF ( grid%tslb(i,1,j) .GT. 1. ) THEN
+!oops1=oops1+1
+!                  grid%ivgtyp(i,j) = 5
+!                  grid%isltyp(i,j) = 8
+!                  grid%landmask(i,j) = 1
+!                  grid%xland(i,j) = 1
+!               ELSE IF ( grid%sst(i,j) .GT. 1. ) THEN
+!oops2=oops2+1
+!                  grid%ivgtyp(i,j) = config_flags%iswater
+!                  grid%isltyp(i,j) = 14
+!                  grid%landmask(i,j) = 0
+!                  grid%xland(i,j) = 2
+!               ELSE
+!                  print *,'the grid%landmask and soil/veg cats do not match'
+!                  print *,'i,j=',i,j
+!                  print *,'grid%landmask=',grid%landmask(i,j)
+!                  print *,'grid%ivgtyp=',grid%ivgtyp(i,j)
+!                  print *,'grid%isltyp=',grid%isltyp(i,j)
+!                  print *,'iswater=', config_flags%iswater
+!                  print *,'grid%tslb=',grid%tslb(i,:,j)
+!                  print *,'grid%sst=',grid%sst(i,j)
+!                  CALL wrf_error_fatal ( 'mismatch_landmask_ivgtyp' )
+!               END IF
+!            END IF
+!         END DO
+!      END DO
+!if (oops1.gt.0) then
+!print *,'points artificially set to land : ',oops1
+!endif
+!if(oops2.gt.0) then
+!print *,'points artificially set to water: ',oops2
+!endif
+!! fill grid%sst array with grid%em_tsk if missing in real input (needed for time-varying grid%sst in wrf)
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!           IF ( flag_sst .NE. 1 ) THEN
+!             grid%sst(i,j) = grid%tsk(i,j)
+!           ENDIF
+!         END DO
+!      END DO
+
+
+      !  From the full level data, we can get the half levels, reciprocals, and layer
+      !  thicknesses.  These are all defined at half level locations, so one less level.
+      !  We allow the vertical coordinate to *accidently* come in upside down.  We want
+      !  the first full level to be the ground surface.
+
+      !  Check whether grid%em_znw (full level) data are truly full levels. If not, we need to adjust them
+      !  to be full levels.
+      !  in this test, we check if grid%em_znw(1) is neither 0 nor 1 (within a tolerance of 10**-5)
+
+      were_bad = .false.
+      IF ( ( (grid%em_znw(1).LT.(1-1.E-5) ) .OR. ( grid%em_znw(1).GT.(1+1.E-5) ) ).AND. &
+           ( (grid%em_znw(1).LT.(0-1.E-5) ) .OR. ( grid%em_znw(1).GT.(0+1.E-5) ) ) ) THEN
+         were_bad = .true.
+         print *,'Your grid%em_znw input values are probably half-levels. '
+         print *,grid%em_znw
+         print *,'WRF expects grid%em_znw values to be full levels. '
+         print *,'Adjusting now to full levels...'
+         !  We want to ignore the first value if it's negative
+         IF (grid%em_znw(1).LT.0) THEN
+            grid%em_znw(1)=0
+         END IF
+         DO k=2,kde
+            grid%em_znw(k)=2*grid%em_znw(k)-grid%em_znw(k-1)
+         END DO
+      END IF
+
+      !  Let's check our changes
+
+      IF ( ( ( grid%em_znw(1) .LT. (1-1.E-5) ) .OR. ( grid%em_znw(1) .GT. (1+1.E-5) ) ).AND. &
+           ( ( grid%em_znw(1) .LT. (0-1.E-5) ) .OR. ( grid%em_znw(1) .GT. (0+1.E-5) ) ) ) THEN
+         print *,'The input grid%em_znw height values were half-levels or erroneous. '
+         print *,'Attempts to treat the values as half-levels and change them '
+         print *,'to valid full levels failed.'
+         CALL wrf_error_fatal("bad grid%em_znw values from input files")
+      ELSE IF ( were_bad ) THEN
+         print *,'...adjusted. grid%em_znw array now contains full eta level values. '
+      ENDIF
+
+      IF ( grid%em_znw(1) .LT. grid%em_znw(kde) ) THEN
+         DO k=1, kde/2
+            hold_znw = grid%em_znw(k)
+            grid%em_znw(k)=grid%em_znw(kde+1-k)
+            grid%em_znw(kde+1-k)=hold_znw
+         END DO
+      END IF
+
+      DO k=1, kde-1
+         grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+         grid%em_rdnw(k) = 1./grid%em_dnw(k)
+         grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+      END DO
+
+      !  Now the same sort of computations with the half eta levels, even ANOTHER
+      !  level less than the one above.
+
+      DO k=2, kde-1
+         grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+         grid%em_rdn(k) = 1./grid%em_dn(k)
+         grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+         grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+      END DO
+
+      !  Scads of vertical coefficients.
+
+      cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+      cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+
+      grid%cf1  = grid%em_fnp(2) + cof1
+      grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+      grid%cf3  = cof2       
+
+      grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+      grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+
+      !  Inverse grid distances.
+
+      grid%rdx = 1./config_flags%dx
+      grid%rdy = 1./config_flags%dy
+
+      !  Some of the many weird geopotential initializations that we'll see today: grid%em_ph0 is total, 
+      !  and grid%em_ph_2 is a perturbation from the base state geopotential.  We set the base geopotential 
+      !  at the lowest level to terrain elevation * gravity.
+
+      DO j=jts,jte
+         DO i=its,ite
+            grid%em_ph0(i,1,j) = grid%ht(i,j) * g
+            grid%em_ph_2(i,1,j) = 0.
+         END DO
+      END DO
+
+      !  Base state potential temperature and inverse density (alpha = 1/rho) from
+      !  the half eta levels and the base-profile surface pressure.  Compute 1/rho 
+      !  from equation of state.  The potential temperature is a perturbation from t0.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+
+
+!****MARS         
+!TODO: etudier si une meilleure formule n'existe pas pour Mars
+!TODO: mais il s'agit juste d'un etat de base ...
+!****MARS
+            !  Base state pressure is a function of eta level and terrain, only, plus
+            !  the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
+            !  temperature, K), and A (temperature difference, from 1000 mb to 300 mb, K).
+
+!!****MARS
+!!ici il s'agit de definir un etat de base, de reference
+!!- on ne peut prendre le profil de temperature du modele
+!!  qui conduit a des instabilites
+!!      grid%em_t_init(i,k,j)=grid%em_t_2(i,k,j) - t0 est a eviter donc.
+!!- pour la pression de surface, aucune information
+!!  sur un profil de temperature variable et non equilibre
+!!  ne doit transparaitre
+!!      p_surf = grid%psfc(i,j) pourquoi pas ... mais t y est utilisee ...
+!!
+!!>> l'etat de base ne doit dependre "geographiquement" que de la topographie
+!!
+!!****MARS
+            p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+
+            DO k = 1, kte-1
+               grid%em_php(i,k,j) = grid%em_znw(k)*(p_surf - grid%p_top) + grid%p_top ! temporary, full lev base pressure
+               grid%em_pb(i,k,j) = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+!              temp = MAX ( 200., t00 + A*LOG(grid%em_pb(i,k,j)/p00) )
+!              temp =             t00 + A*LOG(grid%em_pb(i,k,j)/p00)
+!!! MODIF WRFV3.1 - parameter tiso
+!!! have to change as well in start_em
+temp = MAX ( tiso, t00 + A*LOG(grid%em_pb(i,k,j)/p00) )
+IF (( i .EQ. its ) .AND. ( j .EQ. jts )) print *, temp, k
+!!! MODIF WRFV3.1 - parameter tiso
+               IF (planet .eq. "mars" ) THEN
+                 grid%em_t_init(i,k,j) = temp*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
+               ELSE
+                 grid%em_t_init(i,k,j) = (temp**nu + nu*(TT00**nu)*log((p00/grid%em_pb(i,k,j))**rcp))**(1/nu) -t0
+               ENDIF
+               grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+            END DO
+       
+            !  Base state mu is defined as base state surface pressure minus grid%p_top
+
+            grid%em_mub(i,j) = p_surf - grid%p_top
+       
+            !  Dry surface pressure is defined as the following (this mu is from the input file
+            !  computed from the dry pressure).  Here the dry pressure is just reconstituted.
+
+            pd_surf = grid%em_mu0(i,j) + grid%p_top
+
+            !  Integrate base geopotential, starting at terrain elevation.  This assures that 
+            !  the base state is in exact hydrostatic balance with respect to the model equations.
+            !  This field is on full levels.
+
+            grid%em_phb(i,1,j) = grid%ht(i,j) * g
+            IF (hypsometric_opt == 1) THEN
+               DO k  = 2,kte
+                  grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+               END DO
+            ELSE IF (hypsometric_opt == 2) THEN
+               DO k = 2,kte
+                  pfu = grid%em_mub(i,j)*grid%em_znw(k)   + grid%p_top
+                  pfd = grid%em_mub(i,j)*grid%em_znw(k-1)   + grid%p_top
+                  phm = grid%em_mub(i,j)*grid%em_znu(k-1)   + grid%p_top
+                  grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) + grid%em_alb(i,k-1,j)*phm*LOG(pfd/pfu)
+               END DO
+            END IF
+
+         END DO
+      END DO
+
+      !  Fill in the outer rows and columns to allow us to be sloppy.
+
+      IF ( ite .EQ. ide ) THEN
+      i = ide
+      DO j = jts, MIN(jde-1,jte)
+         grid%em_mub(i,j) = grid%em_mub(i-1,j)
+         grid%em_mu_2(i,j) = grid%em_mu_2(i-1,j)
+         DO k = 1, kte-1
+            grid%em_pb(i,k,j) = grid%em_pb(i-1,k,j)
+            grid%em_t_init(i,k,j) = grid%em_t_init(i-1,k,j)
+            grid%em_alb(i,k,j) = grid%em_alb(i-1,k,j)
+         END DO
+         DO k = 1, kte
+            grid%em_phb(i,k,j) = grid%em_phb(i-1,k,j)
+         END DO
+      END DO
+      END IF
+
+      IF ( jte .EQ. jde ) THEN
+      j = jde
+      DO i = its, ite
+         grid%em_mub(i,j) = grid%em_mub(i,j-1)
+         grid%em_mu_2(i,j) = grid%em_mu_2(i,j-1)
+         DO k = 1, kte-1
+            grid%em_pb(i,k,j) = grid%em_pb(i,k,j-1)
+            grid%em_t_init(i,k,j) = grid%em_t_init(i,k,j-1)
+            grid%em_alb(i,k,j) = grid%em_alb(i,k,j-1)
+         END DO
+         DO k = 1, kte
+            grid%em_phb(i,k,j) = grid%em_phb(i,k,j-1)
+         END DO
+      END DO
+      END IF
+       
+      !  Compute the perturbation dry pressure (grid%em_mub + grid%em_mu_2 + ptop = dry grid%em_psfc).
+
+      DO j = jts, min(jde-1,jte)
+         DO i = its, min(ide-1,ite)
+            grid%em_mu_2(i,j) = grid%em_mu0(i,j) - grid%em_mub(i,j)
+         END DO
+      END DO
+
+      !  Fill in the outer rows and columns to allow us to be sloppy.
+
+      IF ( ite .EQ. ide ) THEN
+      i = ide
+      DO j = jts, MIN(jde-1,jte)
+         grid%em_mu_2(i,j) = grid%em_mu_2(i-1,j)
+      END DO
+      END IF
+
+      IF ( jte .EQ. jde ) THEN
+      j = jde
+      DO i = its, ite
+         grid%em_mu_2(i,j) = grid%em_mu_2(i,j-1)
+      END DO
+      END IF
+
+      lev500 = 0 
+      DO j = jts, min(jde-1,jte)
+         DO i = its, min(ide-1,ite)
+
+            !  Assign the potential temperature (perturbation from t0) and qv on all the mass
+            !  point locations.
+
+            DO k =  1 , kde-1
+               grid%em_t_2(i,k,j)          = grid%em_t_2(i,k,j) - t0
+            END DO
+
+!!---------------------------------------------------------------
+!!****MARS: no 500mb adjustment needed
+!!****MARS: must keep however the hydrostatic equation integration performed in this loop !
+!!****MARS: the DO WHILE loop is deactivated, since we will always be in the case
+!!****MARS: ... of "ELSE dpmu = 0."
+!!---------------------------------------------------------------
+!            dpmu = 10001.
+!            loop_count = 0
+!
+!            DO WHILE ( ( ABS(dpmu) .GT. 10. ) .AND. &
+!                       ( loop_count .LT. 5 ) )  
+!
+!               loop_count = loop_count + 1
+      
+               !  Integrate the hydrostatic equation (from the RHS of the bigstep vertical momentum 
+               !  equation) down from the top to get the pressure perturbation.  First get the pressure
+               !  perturbation, moisture, and inverse density (total and perturbation) at the top-most level.
+         
+               k = kte-1
+         
+               qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+               qvf2 = 1./(1.+qvf1)
+               qvf1 = qvf1*qvf2
+         
+               grid%em_p(i,k,j) = - 0.5*(grid%em_mu_2(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+               qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+               grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf&
+                                 *(((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+               grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+         
+               !  Now, integrate down the column to compute the pressure perturbation, and diagnose the two
+               !  inverse density fields (total and perturbation).
+         
+                DO k=kte-2,1,-1
+                  qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+                  qvf2 = 1./(1.+qvf1)
+                  qvf1 = qvf1*qvf2
+                  grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_2(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+                  qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+                  grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf* &
+                              (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+                  grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+               END DO
+        
+               !  This is the hydrostatic equation used in the model after the small timesteps.  In 
+               !  the model, grid%em_al (inverse density) is computed from the geopotential.
+         
+               IF (hypsometric_opt == 1) THEN
+                  DO k  = 2,kte
+                     grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) - &
+                                   grid%em_dnw(k-1) * ( (grid%em_mub(i,j)+grid%em_mu_2(i,j))*grid%em_al(i,k-1,j) &
+                                 + grid%em_mu_2(i,j)*grid%em_alb(i,k-1,j) )
+                     grid%em_ph0(i,k,j) = grid%em_ph_2(i,k,j) + grid%em_phb(i,k,j)
+                  END DO
+               ELSE IF (hypsometric_opt == 2) THEN
+                  ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure.
+                  ! Note that al*p approximates Rd*T and dLOG(p) does z.
+                  ! Here T varies mostly linear with z, the first-order integration produces better result.
+                  PRINT*,"WEE ET AL. 2012 CORRECTION."
+                  grid%em_ph_2(i,1,j) = grid%em_phb(i,1,j)
+                  DO k = 2,kte
+                     pfu = grid%em_mu0(i,j)*grid%em_znw(k)   + grid%p_top
+                     pfd = grid%em_mu0(i,j)*grid%em_znw(k-1) + grid%p_top
+                     phm = grid%em_mu0(i,j)*grid%em_znu(k-1) + grid%p_top
+                     grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) + grid%em_alt(i,k-1,j)*phm*LOG(pfd/pfu)
+                  END DO
+
+                  DO k = 1,kte
+                     grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k,j) - grid%em_phb(i,k,j)
+                  END DO
+               END IF
+
+
+!               !  Adjust the column pressure so that the computed 500 mb height is close to the
+!               !  input value (of course, not when we are doing hybrid input).
+!   
+!               IF ( ( flag_metgrid .EQ. 1 ) .AND. ( i .EQ. its ) .AND. ( j .EQ. jts ) ) THEN
+!                  DO k = 1 , num_metgrid_levels
+!                     IF ( ABS ( grid%em_p_gc(i,k,j) - 50000. ) .LT. 1. ) THEN
+!                        lev500 = k
+!                        EXIT
+!                     END IF
+!                  END DO
+!               END IF
+!           
+!               !  We only do the adjustment of height if we have the input data on pressure
+!               !  surfaces, and folks have asked to do this option.
+!   
+!               IF ( ( flag_metgrid .EQ. 1 ) .AND. &
+!                    ( config_flags%adjust_heights ) .AND. &
+!                    ( lev500 .NE. 0 ) ) THEN
+!   
+!                  DO k = 2 , kte-1
+!      
+!                     !  Get the pressures on the full eta levels (grid%em_php is defined above as 
+!                     !  the full-lev base pressure, an easy array to use for 3d space).
+!      
+!                     pl = grid%em_php(i,k  ,j) + &
+!                          ( grid%em_p(i,k-1  ,j) * ( grid%em_znw(k    ) - grid%em_znu(k  ) ) + &             
+!                            grid%em_p(i,k    ,j) * ( grid%em_znu(k-1  ) - grid%em_znw(k  ) ) ) / &
+!                          ( grid%em_znu(k-1  ) - grid%em_znu(k  ) )
+!                     pu = grid%em_php(i,k+1,j) + &
+!                          ( grid%em_p(i,k-1+1,j) * ( grid%em_znw(k  +1) - grid%em_znu(k+1) ) + &             
+!                            grid%em_p(i,k  +1,j) * ( grid%em_znu(k-1+1) - grid%em_znw(k+1) ) ) / &
+!                          ( grid%em_znu(k-1+1) - grid%em_znu(k+1) )
+!                   
+!                     !  If these pressure levels trap 500 mb, use them to interpolate
+!                     !  to the 500 mb level of the computed height.
+!!**** PB on MARS .... ?       
+!                     IF ( ( pl .GE. 50000. ) .AND. ( pu .LT. 50000. ) ) THEN
+!                        zl = ( grid%em_ph_2(i,k  ,j) + grid%em_phb(i,k  ,j) ) / g
+!                        zu = ( grid%em_ph_2(i,k+1,j) + grid%em_phb(i,k+1,j) ) / g
+!      
+!                        z500 = ( zl * ( LOG(50000.) - LOG(pu    ) ) + &
+!                                 zu * ( LOG(pl    ) - LOG(50000.) ) ) / &
+!                               ( LOG(pl) - LOG(pu) ) 
+!!                       z500 = ( zl * (    (50000.) -    (pu    ) ) + &
+!!                                zu * (    (pl    ) -    (50000.) ) ) / &
+!!                              (    (pl) -    (pu) ) 
+!      
+!                        !  Compute the difference of the 500 mb heights (computed minus input), and
+!                        !  then the change in grid%em_mu_2.  The grid%em_php is still full-levels, base pressure.
+!      
+!                        dz500 = z500 - grid%em_ght_gc(i,lev500,j)
+!                        tvsfc = ((grid%em_t_2(i,1,j)+t0)*((grid%em_p(i,1,j)+grid%em_php(i,1,j))/p1000mb)**(r_d/cp)) * &
+!                                (1.+0.6*moist(i,1,j,P_QV))
+!                        dpmu = ( grid%em_php(i,1,j) + grid%em_p(i,1,j) ) * EXP ( g * dz500 / ( r_d * tvsfc ) )
+!                        dpmu = dpmu - ( grid%em_php(i,1,j) + grid%em_p(i,1,j) )
+!                        grid%em_mu_2(i,j) = grid%em_mu_2(i,j) - dpmu
+!                        EXIT
+!                     END IF
+!      
+!                  END DO
+!               ELSE
+!                  dpmu = 0.
+!               END IF
+!
+!            END DO
+       
+         END DO
+      END DO
+
+!!****MARS: we use WPS
+!
+!      !  If this is data from the SI, then we probably do not have the original
+!      !  surface data laying around.  Note that these are all the lowest levels
+!      !  of the respective 3d arrays.  For surface pressure, we assume that the
+!      !  vertical gradient of grid%em_p prime is zilch.  This is not all that important.
+!      !  These are filled in so that the various plotting routines have something
+!      !  to play with at the initial time for the model.
+!
+!      IF ( flag_metgrid .NE. 1 ) THEN
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide,ite)
+!               grid%u10(i,j)=grid%em_u_2(i,1,j)
+!            END DO
+!         END DO
+!   
+!         DO j = jts, min(jde,jte)
+!            DO i = its, min(ide-1,ite)
+!               grid%v10(i,j)=grid%em_v_2(i,1,j)
+!            END DO
+!         END DO
+!
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide-1,ite)
+!               p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+!               grid%psfc(i,j)=p_surf + grid%em_p(i,1,j)
+!               grid%q2(i,j)=moist(i,1,j,P_QV)
+!               grid%th2(i,j)=grid%em_t_2(i,1,j)+300.
+!               grid%t2(i,j)=grid%th2(i,j)*(((grid%em_p(i,1,j)+grid%em_pb(i,1,j))/p00)**(r_d/cp))
+!            END DO
+!         END DO
+!
+!      !  If this data is from WPS, then we have previously assigned the surface
+!      !  data for u, v, and t.  If we have an input qv, welp, we assigned that one,
+!      !  too.  Now we pick up the left overs, and if RH came in - we assign the 
+!      !  mixing ratio.
+!
+!      ELSE IF ( flag_metgrid .EQ. 1 ) THEN
+!
+!!****MARS: we use WPS
+
+         DO j = jts, min(jde-1,jte)
+            DO i = its, min(ide-1,ite)
+                p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+                ! recompute the value of surface pressure as calculated by sfcprs2
+                grid%psfc(i,j)=p_surf + grid%em_p(i,1,j)
+                !!grid%th2 is used for other purpose
+                !grid%th2(i,j)=grid%t2(i,j)*(p00/(grid%em_p(i,1,j)+grid%em_pb(i,1,j)))**(r_d/cp)
+                grid%th2(i,j)=0.        !!TODO TODO TODO - waiting for an input
+            END DO
+         END DO
+
+!!NB: q2 is used for other purpose ...
+         !IF ( flag_qv .NE. 1 ) THEN
+         !   DO j = jts, min(jde-1,jte)
+         !      DO i = its, min(ide-1,ite)
+         !         grid%q2(i,j)=moist(i,1,j,P_QV)
+         !      END DO
+         !   END DO
+         !END IF
+!!NB: q2 is used for other purpose ...
+
+
+!      END IF
+
+!!!!MARS
+!!!!
+!!!! useful for history files @ first step
+!!!!
+grid%em_phtot = grid%em_ph0
+grid%em_ptot  = grid%em_p + grid%em_pb
+print *, 'OK OK OK OK' 
+!!!!
+!!!!MARS
+
+      ips = its ; ipe = ite ; jps = jts ; jpe = jte ; kps = kts ; kpe = kte
+#ifdef DM_PARALLEL
+#   include "HALO_EM_INIT_1.inc"
+#   include "HALO_EM_INIT_2.inc"
+#   include "HALO_EM_INIT_3.inc"
+#   include "HALO_EM_INIT_4.inc"
+#   include "HALO_EM_INIT_5.inc"
+#endif
+
+      RETURN
+
+   END SUBROUTINE init_domain_rk
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE const_module_initialize ( p00 , t00 , a, tiso ) 
+      USE module_configure
+      IMPLICIT NONE
+      !  For the real-data-cases only.
+      REAL , INTENT(OUT) :: p00 , t00 , a, tiso
+      CALL nl_get_base_pres  ( 1 , p00 )
+      CALL nl_get_base_temp  ( 1 , t00 )
+      CALL nl_get_base_lapse ( 1 , a   )
+      CALL nl_get_tiso ( 1 , tiso )
+   END SUBROUTINE const_module_initialize
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE rebalance_driver ( grid ) 
+
+      IMPLICIT NONE
+
+      TYPE (domain)          :: grid 
+
+      CALL rebalance( grid &
+!
+#include "em_actual_new_args.inc"
+!
+      )
+
+   END SUBROUTINE rebalance_driver
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE rebalance ( grid  &
+!
+#include "em_dummy_new_args.inc"
+!
+                        )
+      IMPLICIT NONE
+
+      TYPE (domain)          :: grid
+
+#include "em_dummy_new_decl.inc"
+
+      TYPE (grid_config_rec_type)              :: config_flags
+
+      REAL :: p_surf ,  pd_surf, p_surf_int , pb_int , ht_hold
+      REAL :: qvf , qvf1 , qvf2
+      REAL :: p00 , t00 , a, tiso, temp1, temp2
+      REAL , DIMENSION(:,:,:) , ALLOCATABLE :: t_init_int
+
+      !  Local domain indices and counters.
+
+      INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+
+      INTEGER                             ::                       &
+                                     ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte, &
+                                     ips, ipe, jps, jpe, kps, kpe, &
+                                     i, j, k
+
+      REAL :: pfu, pfd, phm
+      INTEGER :: hypsometric_opt = 1 ! classic
+      !INTEGER :: hypsometric_opt = 2 ! Wee et al. 2012 correction
+
+
+
+#ifdef DM_PARALLEL
+#    include "em_data_calls.inc"
+#endif
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+            kds = grid%sd31 ; kde = grid%ed31 ;
+            ids = grid%sd32 ; ide = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            kms = grid%sm31 ; kme = grid%em31 ;
+            ims = grid%sm32 ; ime = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+            its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XYZ )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            jds = grid%sd32 ; jde = grid%ed32 ;
+            kds = grid%sd33 ; kde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            jms = grid%sm32 ; jme = grid%em32 ;
+            kms = grid%sm33 ; kme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+            kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XZY )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            kds = grid%sd32 ; kde = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            kms = grid%sm32 ; kme = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+      END SELECT
+
+      ALLOCATE ( t_init_int(ims:ime,kms:kme,jms:jme) )
+
+      !  Some of the many weird geopotential initializations that we'll see today: grid%em_ph0 is total, 
+      !  and grid%em_ph_2 is a perturbation from the base state geopotential.  We set the base geopotential 
+      !  at the lowest level to terrain elevation * gravity.
+
+      DO j=jts,jte
+         DO i=its,ite
+            grid%em_ph0(i,1,j) = grid%ht_fine(i,j) * g
+            grid%em_ph_2(i,1,j) = 0.
+         END DO
+      END DO
+      
+      !  To define the base state, we call a USER MODIFIED routine to set the three
+      !  necessary constants:  p00 (sea level pressure, Pa), t00 (sea level temperature, K), 
+      !  and A (temperature difference, from 1000 mb to 300 mb, K).
+
+      CALL const_module_initialize ( p00 , t00 , a , tiso ) 
+
+      !  Base state potential temperature and inverse density (alpha = 1/rho) from
+      !  the half eta levels and the base-profile surface pressure.  Compute 1/rho 
+      !  from equation of state.  The potential temperature is a perturbation from t0.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+
+            !  Base state pressure is a function of eta level and terrain, only, plus
+            !  the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
+            !  temperature, K), and A (temperature difference, from 1000 mb to 300 mb, K).
+            !  The fine grid terrain is ht_fine, the interpolated is grid%em_ht.
+
+            p_surf     = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht_fine(i,j)/a/r_d ) **0.5 ) 
+            p_surf_int = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)     /a/r_d ) **0.5 ) 
+
+            DO k = 1, kte-1
+               grid%em_pb(i,k,j) = grid%em_znu(k)*(p_surf     - grid%p_top) + grid%p_top
+               pb_int    = grid%em_znu(k)*(p_surf_int - grid%p_top) + grid%p_top
+!               grid%em_t_init(i,k,j)    = (t00 + A*LOG(grid%em_pb(i,k,j)/p00))*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
+!               t_init_int(i,k,j)= (t00 + A*LOG(pb_int   /p00))*(p00/pb_int   )**(r_d/cp) - t0
+temp1 = MAX(tiso,t00+A*LOG(grid%em_pb(i,k,j)/p00))
+temp2 = MAX(tiso,t00+A*LOG(           pb_int/p00))
+IF (planet .eq. "mars" ) THEN
+  grid%em_t_init(i,k,j) = temp1*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
+  t_init_int(i,k,j)     = temp2*(p00/pb_int           )**(r_d/cp) - t0
+ELSE
+  grid%em_t_init(i,k,j) = (temp1**nu + nu*(TT00**nu)*log((p00/grid%em_pb(i,k,j))**(rcp)))**(1/nu) - t0
+  t_init_int(i,k,j)     = (temp2**nu + nu*(TT00**nu)*log((p00/pb_int)**(rcp)))**(1/nu) - t0
+ENDIF
+               grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+            END DO
+       
+            !  Base state mu is defined as base state surface pressure minus grid%p_top
+
+            grid%em_mub(i,j) = p_surf - grid%p_top
+       
+            !  Dry surface pressure is defined as the following (this mu is from the input file
+            !  computed from the dry pressure).  Here the dry pressure is just reconstituted.
+
+            pd_surf = ( grid%em_mub(i,j) + grid%em_mu_2(i,j) ) + grid%p_top
+       
+            !  Integrate base geopotential, starting at terrain elevation.  This assures that 
+            !  the base state is in exact hydrostatic balance with respect to the model equations.
+            !  This field is on full levels.
+
+            grid%em_phb(i,1,j) = grid%ht_fine(i,j) * g
+            IF (hypsometric_opt == 1) THEN
+              DO k  = 2,kte
+                 grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+              END DO
+            ELSE IF (hypsometric_opt == 2) THEN
+              DO k = 2,kte
+                 pfu = grid%em_mub(i,j)*grid%em_znw(k)   + grid%p_top
+                 pfd = grid%em_mub(i,j)*grid%em_znw(k-1) + grid%p_top
+                 phm = grid%em_mub(i,j)*grid%em_znu(k-1) + grid%p_top
+                 grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) + grid%em_alb(i,k-1,j)*phm*LOG(pfd/pfu)
+              END DO
+            END IF
+         END DO
+      END DO
+
+      !  Replace interpolated terrain with fine grid values.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+            grid%ht(i,j) = grid%ht_fine(i,j)
+         END DO
+      END DO
+
+      !  Perturbation fields.
+
+      DO j = jts, min(jde-1,jte)
+         DO i = its, min(ide-1,ite)
+
+            !  The potential temperature is THETAnest = THETAinterp + ( TBARnest - TBARinterp)
+
+            DO k =  1 , kde-1
+               grid%em_t_2(i,k,j) = grid%em_t_2(i,k,j) + ( grid%em_t_init(i,k,j) - t_init_int(i,k,j) ) 
+            END DO
+      
+            !  Integrate the hydrostatic equation (from the RHS of the bigstep vertical momentum 
+            !  equation) down from the top to get the pressure perturbation.  First get the pressure
+            !  perturbation, moisture, and inverse density (total and perturbation) at the top-most level.
+      
+            k = kte-1
+      
+            qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+            qvf2 = 1./(1.+qvf1)
+            qvf1 = qvf1*qvf2
+      
+            grid%em_p(i,k,j) = - 0.5*(grid%em_mu_2(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+            qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+            grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf* &
+                                 (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+            grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+      
+            !  Now, integrate down the column to compute the pressure perturbation, and diagnose the two
+            !  inverse density fields (total and perturbation).
+      
+            DO k=kte-2,1,-1
+               qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+               qvf2 = 1./(1.+qvf1)
+               qvf1 = qvf1*qvf2
+               grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_2(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+               qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+               grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf* &
+                           (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+               grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+            END DO
+      
+            !  This is the hydrostatic equation used in the model after the small timesteps.  In
+            !  the model, grid%al (inverse density) is computed from the geopotential.
+
+            IF (hypsometric_opt == 1) THEN
+               DO k  = 2,kte
+                  grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) - &
+                                grid%em_dnw(k-1) * ( (grid%em_mub(i,j)+grid%em_mu_2(i,j))*grid%em_al(i,k-1,j) &
+                              + grid%em_mu_2(i,j)*grid%em_alb(i,k-1,j) )
+                  grid%em_ph0(i,k,j) = grid%em_ph_2(i,k,j) + grid%em_phb(i,k,j)
+               END DO
+            ELSE IF (hypsometric_opt == 2) THEN
+
+             ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure.
+             ! Note that al*p approximates Rd*T and dLOG(p) does z.
+             ! Here T varies mostly linear with z, the first-order integration produces better result.
+
+               grid%em_ph_2(i,1,j) = grid%em_phb(i,1,j)
+               DO k = 2,kte
+                  pfu = grid%em_mu0(i,j)*grid%em_znw(k)   + grid%p_top
+                  pfd = grid%em_mu0(i,j)*grid%em_znw(k-1) + grid%p_top
+                  phm = grid%em_mu0(i,j)*grid%em_znu(k-1) + grid%p_top
+                  grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) + grid%em_alt(i,k-1,j)*phm*LOG(pfd/pfu)
+               END DO
+
+               DO k = 1,kte
+                  grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k,j) - grid%em_phb(i,k,j)
+               END DO
+
+            END IF
+
+         END DO
+      END DO
+
+      DEALLOCATE ( t_init_int ) 
+
+      ips = its ; ipe = ite ; jps = jts ; jpe = jte ; kps = kts ; kpe = kte
+#ifdef DM_PARALLEL
+#   include "HALO_EM_INIT_1.inc"
+#   include "HALO_EM_INIT_2.inc"
+#   include "HALO_EM_INIT_3.inc"
+#   include "HALO_EM_INIT_4.inc"
+#   include "HALO_EM_INIT_5.inc"
+#endif
+   END SUBROUTINE rebalance
+
+!---------------------------------------------------------------------
+
+   RECURSIVE SUBROUTINE find_my_parent ( grid_ptr_in , grid_ptr_out , id_i_am , id_wanted , found_the_id )
+
+      USE module_domain
+
+      TYPE(domain) , POINTER :: grid_ptr_in , grid_ptr_out
+      TYPE(domain) , POINTER :: grid_ptr_sibling
+      INTEGER :: id_wanted , id_i_am
+      LOGICAL :: found_the_id
+
+      found_the_id = .FALSE.
+      grid_ptr_sibling => grid_ptr_in
+      DO WHILE ( ASSOCIATED ( grid_ptr_sibling ) )
+
+         IF ( grid_ptr_sibling%grid_id .EQ. id_wanted ) THEN
+            found_the_id = .TRUE.
+            grid_ptr_out => grid_ptr_sibling
+            RETURN
+         ELSE IF ( grid_ptr_sibling%num_nests .GT. 0 ) THEN
+            grid_ptr_sibling => grid_ptr_sibling%nests(1)%ptr
+            CALL find_my_parent ( grid_ptr_sibling , grid_ptr_out , id_i_am , id_wanted , found_the_id )
+         ELSE
+            grid_ptr_sibling => grid_ptr_sibling%sibling
+         END IF
+
+      END DO
+
+   END SUBROUTINE find_my_parent
+
+#endif
+
+!---------------------------------------------------------------------
+
+#ifdef VERT_UNIT
+
+!This is a main program for a small unit test for the vertical interpolation.
+
+program vint
+
+   implicit none 
+
+   integer , parameter :: ij = 3
+   integer , parameter :: keta = 30
+   integer , parameter :: kgen =20 
+
+   integer :: ids , ide , jds , jde , kds , kde , &
+              ims , ime , jms , jme , kms , kme , &
+              its , ite , jts , jte , kts , kte
+
+   integer :: generic
+
+   real , dimension(1:ij,kgen,1:ij) :: fo , po
+   real , dimension(1:ij,1:keta,1:ij) :: fn_calc , fn_interp , pn
+
+   integer, parameter :: interp_type          = 1 ! 2
+!  integer, parameter :: lagrange_order       = 2 ! 1
+   integer            :: lagrange_order
+   logical, parameter :: lowest_lev_from_sfc  = .FALSE. ! .TRUE.
+   real   , parameter :: zap_close_levels     = 500. ! 100.
+   integer, parameter :: force_sfc_in_vinterp = 0 ! 6
+
+   integer :: k 
+
+   ids = 1 ; ide = ij ; jds = 1 ; jde = ij ; kds = 1 ; kde = keta
+   ims = 1 ; ime = ij ; jms = 1 ; jme = ij ; kms = 1 ; kme = keta
+   its = 1 ; ite = ij ; jts = 1 ; jte = ij ; kts = 1 ; kte = keta
+
+   generic = kgen
+
+   print *,' '
+   print *,'------------------------------------'
+   print *,'UNIT TEST FOR VERTICAL INTERPOLATION'
+   print *,'------------------------------------'
+   print *,' '
+   do lagrange_order = 1 , 2
+      print *,' '
+      print *,'------------------------------------'
+      print *,'Lagrange Order = ',lagrange_order
+      print *,'------------------------------------'
+      print *,' '
+      call fillitup ( fo , po , fn_calc , pn , &
+                    ids , ide , jds , jde , kds , kde , &
+                    ims , ime , jms , jme , kms , kme , &
+                    its , ite , jts , jte , kts , kte , &
+                    generic , lagrange_order )
+   
+      print *,' ' 
+      print *,'Level   Pressure     Field'
+      print *,'          (Pa)      (generic)'
+      print *,'------------------------------------'
+      print *,' ' 
+      do k = 1 , generic
+      write (*,fmt='(i2,2x,f12.3,1x,g15.8)' ) &
+         k,po(2,k,2),fo(2,k,2)
+      end do
+      print *,' '
+   
+      call vert_interp ( fo , po , fn_interp , pn , &
+                         generic , 'T' , &
+                         interp_type , lagrange_order , lowest_lev_from_sfc , &
+                         zap_close_levels , force_sfc_in_vinterp , &
+                         ids , ide , jds , jde , kds , kde , &
+                         ims , ime , jms , jme , kms , kme , &
+                         its , ite , jts , jte , kts , kte )
+   
+      print *,'Multi-Order Interpolator'
+      print *,'------------------------------------'
+      print *,' '
+      print *,'Level  Pressure      Field           Field         Field'
+      print *,'         (Pa)        Calc            Interp        Diff'
+      print *,'------------------------------------'
+      print *,' '
+      do k = kts , kte-1
+      write (*,fmt='(i2,2x,f12.3,1x,3(g15.7))' ) &
+         k,pn(2,k,2),fn_calc(2,k,2),fn_interp(2,k,2),fn_calc(2,k,2)-fn_interp(2,k,2)
+      end do
+   
+      call vert_interp_old ( fo , po , fn_interp , pn , &
+                         generic , 'T' , &
+                         interp_type , lagrange_order , lowest_lev_from_sfc , &
+                         zap_close_levels , force_sfc_in_vinterp , &
+                         ids , ide , jds , jde , kds , kde , &
+                         ims , ime , jms , jme , kms , kme , &
+                         its , ite , jts , jte , kts , kte )
+   
+      print *,'Linear Interpolator'
+      print *,'------------------------------------'
+      print *,' '
+      print *,'Level  Pressure      Field           Field         Field'
+      print *,'         (Pa)        Calc            Interp        Diff'
+      print *,'------------------------------------'
+      print *,' '
+      do k = kts , kte-1
+      write (*,fmt='(i2,2x,f12.3,1x,3(g15.7))' ) &
+         k,pn(2,k,2),fn_calc(2,k,2),fn_interp(2,k,2),fn_calc(2,k,2)-fn_interp(2,k,2)
+      end do
+   end do
+
+end program vint
+
+subroutine wrf_error_fatal (string)
+   character (len=*) :: string
+   print *,string
+   stop
+end subroutine wrf_error_fatal
+
+subroutine fillitup ( fo , po , fn , pn , &
+                    ids , ide , jds , jde , kds , kde , &
+                    ims , ime , jms , jme , kms , kme , &
+                    its , ite , jts , jte , kts , kte , &
+                    generic , lagrange_order )
+
+   implicit none
+
+   integer , intent(in) :: ids , ide , jds , jde , kds , kde , &
+              ims , ime , jms , jme , kms , kme , &
+              its , ite , jts , jte , kts , kte
+
+   integer , intent(in) :: generic , lagrange_order
+
+   real , dimension(ims:ime,generic,jms:jme) , intent(out) :: fo , po
+   real , dimension(ims:ime,kms:kme,jms:jme) , intent(out) :: fn , pn
+
+   integer :: i , j , k
+   
+   real , parameter :: piov2 = 3.14159265358 / 2.
+
+   k = 1
+   do j = jts , jte
+   do i = its , ite
+      po(i,k,j) = 102000.
+   end do
+   end do
+   
+   do k = 2 , generic
+   do j = jts , jte
+   do i = its , ite
+      po(i,k,j) = ( 5000. * ( 1 - (k-1) ) + 100000. * ( (k-1) - (generic-1) ) ) / (1. - real(generic-1) )
+   end do
+   end do
+   end do
+
+   if ( lagrange_order .eq. 1 ) then
+      do k = 1 , generic
+      do j = jts , jte
+      do i = its , ite
+         fo(i,k,j) = po(i,k,j)
+!        fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   else if ( lagrange_order .eq. 2 ) then
+      do k = 1 , generic
+      do j = jts , jte
+      do i = its , ite
+         fo(i,k,j) = (((po(i,k,j)-5000.)/102000.)*((102000.-po(i,k,j))/102000.))*102000.
+!        fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   end if
+
+!!!!!!!!!!!!
+   
+   do k = kts , kte
+   do j = jts , jte
+   do i = its , ite
+      pn(i,k,j) = ( 5000. * ( 0 - (k-1) ) + 102000. * ( (k-1) - (kte-1) ) ) / (-1. *  real(kte-1) )
+   end do
+   end do
+   end do
+   
+   do k = kts , kte-1
+   do j = jts , jte
+   do i = its , ite
+      pn(i,k,j) = ( pn(i,k,j) + pn(i,k+1,j) ) /2.
+   end do
+   end do
+   end do
+
+
+   if ( lagrange_order .eq. 1 ) then
+      do k = kts , kte-1
+      do j = jts , jte
+      do i = its , ite
+         fn(i,k,j) = pn(i,k,j)
+!        fn(i,k,j) = sin(pn(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   else if ( lagrange_order .eq. 2 ) then
+      do k = kts , kte-1
+      do j = jts , jte
+      do i = its , ite
+         fn(i,k,j) = (((pn(i,k,j)-5000.)/102000.)*((102000.-pn(i,k,j))/102000.))*102000.
+!        fn(i,k,j) = sin(pn(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   end if
+
+end subroutine fillitup
+
+#endif
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE vert_interp ( fo , po , fnew , pnu , &
+                            generic , var_type , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+   !  Vertically interpolate the new field.  The original field on the original
+   !  pressure levels is provided, and the new pressure surfaces to interpolate to.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: interp_type , lagrange_order
+      LOGICAL , INTENT(IN)        :: lowest_lev_from_sfc
+      REAL    , INTENT(IN)        :: zap_close_levels
+      INTEGER , INTENT(IN)        :: force_sfc_in_vinterp
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+      INTEGER , INTENT(IN)        :: generic
+
+      CHARACTER (LEN=1) :: var_type 
+
+      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(IN)     :: fo , po
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: pnu
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: fnew
+
+      REAL , DIMENSION(ims:ime,generic,jms:jme)                  :: forig , porig
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme)                  :: pnew
+
+      !  Local vars
+
+      INTEGER :: i , j , k , ko , kn , k1 , k2 , ko_1 , ko_2 , knext
+      INTEGER :: istart , iend , jstart , jend , kstart , kend 
+      INTEGER , DIMENSION(ims:ime,kms:kme        )               :: k_above , k_below
+      INTEGER , DIMENSION(ims:ime                )               :: ks
+      INTEGER , DIMENSION(ims:ime                )               :: ko_above_sfc
+      INTEGER :: count , zap , kst
+
+      LOGICAL :: any_below_ground
+
+      REAL :: p1 , p2 , pn, hold
+      REAL , DIMENSION(1:generic) :: ordered_porig , ordered_forig
+      REAL , DIMENSION(kts:kte) :: ordered_pnew , ordered_fnew
+
+!****MARS
+!big problems ... discontinuity in the interpolated fields ...
+print *, '25/05/2007: decided to use simple linear interpolations'
+print *, 'use that one at your own risk'
+!stop
+!****MARS
+
+
+      !  Horiontal loop bounds for different variable types.
+
+      IF      ( var_type .EQ. 'U' ) THEN
+         istart = its
+         iend   = ite
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  porig(i,k,j) = ( po(i,k,j) + po(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = 1,generic
+                  porig(its,k,j) =  po(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = 1,generic
+                  porig(ite,k,j) =  po(ite-1,k,j)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = kstart,kend
+                  pnew(its,k,j) =  pnu(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = kstart,kend
+                  pnew(ite,k,j) =  pnu(ite-1,k,j)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( var_type .EQ. 'V' ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = jte
+         kstart = kts
+         kend   = kte-1
+         DO i = istart,iend
+            DO k = 1,generic
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  porig(i,k,j) = ( po(i,k,j) + po(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = 1,generic
+                  porig(i,k,jts) =  po(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+               DO k = 1,generic
+                  porig(i,k,jte) =  po(i,k,jte-1)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = kstart,kend
+                  pnew(i,k,jts) =  pnu(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+              DO k = kstart,kend
+                  pnew(i,k,jte) =  pnu(i,k,jte-1)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( ( var_type .EQ. 'W' ) .OR.  ( var_type .EQ. 'Z' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE IF ( ( var_type .EQ. 'T' ) .OR. ( var_type .EQ. 'Q' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      END IF
+
+      DO j = jstart , jend
+
+         !  The lowest level is the surface.  Levels 2 through "generic" are supposed to
+         !  be "bottom-up".  Flip if they are not.  This is based on the input pressure 
+         !  array.
+
+         IF      ( porig(its,2,j) .LT. porig(its,generic,j) ) THEN
+            DO kn = 2 , ( generic + 1 ) / 2
+               DO i = istart , iend
+                  hold                    = porig(i,kn,j) 
+                  porig(i,kn,j)           = porig(i,generic+2-kn,j)
+                  porig(i,generic+2-kn,j) = hold
+                  forig(i,kn,j)           = fo   (i,generic+2-kn,j)
+                  forig(i,generic+2-kn,j) = fo   (i,kn,j)
+               END DO
+               DO i = istart , iend
+                  forig(i,1,j)           = fo   (i,1,j)
+               END DO
+            END DO
+         ELSE
+            DO kn = 1 , generic
+               DO i = istart , iend
+                  forig(i,kn,j)          = fo   (i,kn,j)
+               END DO
+            END DO
+         END IF
+    
+         !  Skip all of the levels below ground in the original data based upon the surface pressure.
+         !  The ko_above_sfc is the index in the pressure array that is above the surface.  If there
+         !  are no levels underground, this is index = 2.  The remaining levels are eligible for use
+         !  in the vertical interpolation.
+   
+         DO i = istart , iend
+            ko_above_sfc(i) = -1
+         END DO
+         DO ko = kstart+1 , kend
+            DO i = istart , iend
+               IF ( ko_above_sfc(i) .EQ. -1 ) THEN
+                  IF ( porig(i,1,j) .GT. porig(i,ko,j) ) THEN
+                     ko_above_sfc(i) = ko
+                  END IF
+               END IF
+            END DO
+         END DO
+
+         !  Piece together columns of the original input data.  Pass the vertical columns to
+         !  the iterpolator.
+
+         DO i = istart , iend
+
+            !  If the surface value is in the middle of the array, three steps: 1) do the
+            !  values below the ground (this is just to catch the occasional value that is
+            !  inconsistently below the surface based on input data), 2) do the surface level, then 
+            !  3) add in the levels that are above the surface.  For the levels next to the surface,
+            !  we check to remove any levels that are "too close".  When building the column of input
+            !  pressures, we also attend to the request for forcing the surface analysis to be used
+            !  in a few lower eta-levels.
+
+            !  How many levels have we skipped in the input column.
+
+            zap = 0
+
+            !  Fill in the column from up to the level just below the surface with the input
+            !  presssure and the input field (orig or old, which ever).  For an isobaric input
+            !  file, this data is isobaric.
+
+            IF (  ko_above_sfc(i) .GT. 2 ) THEN
+               count = 1
+               DO ko = 2 , ko_above_sfc(i)-1
+                  ordered_porig(count) = porig(i,ko,j)
+                  ordered_forig(count) = forig(i,ko,j)
+                  count = count + 1
+               END DO
+
+               !  Make sure the pressure just below the surface is not "too close", this
+               !  will cause havoc with the higher order interpolators.  In case of a "too close"
+               !  instance, we toss out the offending level (NOT the surface one) by simply
+               !  decrementing the accumulating loop counter.
+
+               IF ( ordered_porig(count-1) - porig(i,1,j) .LT. zap_close_levels ) THEN
+                  count = count -1
+                  zap = 1
+               END IF
+
+               !  Add in the surface values.
+   
+               ordered_porig(count) = porig(i,1,j)
+               ordered_forig(count) = forig(i,1,j)
+               count = count + 1
+
+               !  A usual way to do the vertical interpolation is to pay more attention to the 
+               !  surface data.  Why?  Well it has about 20x the density as the upper air, so we 
+               !  hope the analysis is better there.  We more strongly use this data by artificially
+               !  tossing out levels above the surface that are beneath a certain number of prescribed
+               !  eta levels at this (i,j).  The "zap" value is how many levels of input we are 
+               !  removing, which is used to tell the interpolator how many valid values are in 
+               !  the column.  The "count" value is the increment to the index of levels, and is
+               !  only used for assignments.
+
+               IF ( force_sfc_in_vinterp .GT. 0 ) THEN
+
+                  !  Get the pressure at the eta level.  We want to remove all input pressure levels
+                  !  between the level above the surface to the pressure at this eta surface.  That 
+                  !  forces the surface value to be used through the selected eta level.  Keep track
+                  !  of two things: the level to use above the eta levels, and how many levels we are
+                  !  skipping.
+
+                  knext = ko_above_sfc(i)
+                  find_level : DO ko = ko_above_sfc(i) , generic
+                     IF ( porig(i,ko,j) .LE. pnew(i,force_sfc_in_vinterp,j) ) THEN
+                        knext = ko
+                        exit find_level
+                     ELSE
+                        zap = zap + 1
+                     END IF
+                  END DO find_level
+
+               !  No request for special interpolation, so we just assign the next level to use
+               !  above the surface as, ta da, the first level above the surface.  I know, wow.
+
+               ELSE
+                  knext = ko_above_sfc(i)
+               END IF
+
+               !  One more time, make sure the pressure just above the surface is not "too close", this
+               !  will cause havoc with the higher order interpolators.  In case of a "too close"
+               !  instance, we toss out the offending level above the surface (NOT the surface one) by simply
+               !  incrementing the loop counter.  Here, count-1 is the surface level and knext is either
+               !  the next level up OR it is the level above the prescribed number of eta surfaces.
+
+               IF ( ordered_porig(count-1) - porig(i,knext,j) .LT. zap_close_levels ) THEN
+                  kst = knext+1
+                  zap = zap + 1
+               ELSE
+                  kst = knext
+               END IF
+   
+               DO ko = kst , generic
+                  ordered_porig(count) = porig(i,ko,j)
+                  ordered_forig(count) = forig(i,ko,j)
+                  count = count + 1
+               END DO
+
+            !  This is easy, the surface is the lowest level, just stick them in, in this order.  OK,
+            !  there are a couple of subtleties.  We have to check for that special interpolation that
+            !  skips some input levels so that the surface is used for the lowest few eta levels.  Also,
+            !  we must macke sure that we still do not have levels that are "too close" together.
+            
+            ELSE
+        
+               !  Initialize no input levels have yet been removed from consideration.
+
+               zap = 0
+
+               !  The surface is the lowest level, so it gets set right away to location 1.
+
+               ordered_porig(1) = porig(i,1,j)
+               ordered_forig(1) = forig(i,1,j)
+
+               !  We start filling in the array at loc 2, as in just above the level we just stored.
+
+               count = 2
+
+               !  Are we forcing the interpolator to skip valid input levels so that the
+               !  surface data is used through more levels?  Essentially as above.
+
+               IF ( force_sfc_in_vinterp .GT. 0 ) THEN
+                  knext = 2
+                  find_level2: DO ko = 2 , generic
+                     IF ( porig(i,ko,j) .LE. pnew(i,force_sfc_in_vinterp,j) ) THEN
+                        knext = ko
+                        exit find_level2
+                     ELSE
+                        zap = zap + 1
+                     END IF
+                  END DO find_level2
+               ELSE
+                  knext = 2
+               END IF
+
+               !  Fill in the data above the surface.  The "knext" index is either the one
+               !  just above the surface OR it is the index associated with the level that
+               !  is just above the pressure at this (i,j) of the top eta level that is to
+               !  be directly impacted with the surface level in interpolation.
+
+               DO ko = knext , generic
+                  IF ( ordered_porig(count-1) - porig(i,ko,j) .LT. zap_close_levels ) THEN
+                     zap = zap + 1
+                     CYCLE
+                  END IF
+                  ordered_porig(count) = porig(i,ko,j)
+                  ordered_forig(count) = forig(i,ko,j)
+                  count = count + 1
+               END DO
+
+            END IF
+
+            !  Now get the column of the "new" pressure data.  So, this one is easy.
+
+            DO kn = kstart , kend
+               ordered_pnew(kn) = pnew(i,kn,j)
+            END DO
+
+            !  The polynomials are either in pressure or LOG(pressure).
+
+            IF ( interp_type .EQ. 1 ) THEN
+               CALL lagrange_setup ( var_type , &
+                   ordered_porig                 , ordered_forig , generic-zap   , lagrange_order , &
+                   ordered_pnew                  , ordered_fnew  , kend-kstart+1 ,i,j)
+            ELSE
+               CALL lagrange_setup ( var_type , &
+               LOG(ordered_porig(1:generic-zap)) , ordered_forig , generic-zap   , lagrange_order , &
+               LOG(ordered_pnew(kstart:kend))    , ordered_fnew  , kend-kstart+1 ,i,j)
+            END IF
+
+            !  Save the computed data.
+
+            DO kn = kstart , kend
+               fnew(i,kn,j) = ordered_fnew(kn)
+            END DO
+
+            !  There may have been a request to have the surface data from the input field
+            !  to be assigned as to the lowest eta level.  This assumes thin layers (usually
+            !  the isobaric original field has the surface from 2-m T and RH, and 10-m U and V).
+
+            IF ( lowest_lev_from_sfc ) THEN
+               fnew(i,1,j) = forig(i,ko_above_sfc(i)-1,j)
+            END IF
+
+         END DO
+
+      END DO
+
+   END SUBROUTINE vert_interp
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE vert_interp_old ( forig , po , fnew , pnu , &
+                            generic , var_type , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+   !  Vertically interpolate the new field.  The original field on the original
+   !  pressure levels is provided, and the new pressure surfaces to interpolate to.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: interp_type , lagrange_order
+      LOGICAL , INTENT(IN)        :: lowest_lev_from_sfc
+      REAL    , INTENT(IN)        :: zap_close_levels
+      INTEGER , INTENT(IN)        :: force_sfc_in_vinterp
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+      INTEGER , INTENT(IN)        :: generic
+
+      CHARACTER (LEN=1) :: var_type 
+
+!      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(IN)     :: forig , po
+!****MARS
+!error with g95 and warning with pgf90
+      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(IN)     :: po
+      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(INOUT)  :: forig
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: pnu
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: fnew
+
+      REAL , DIMENSION(ims:ime,generic,jms:jme)                  :: porig
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme)                  :: pnew
+
+      !  Local vars
+
+      INTEGER :: i , j , k , ko , kn , k1 , k2 , ko_1 , ko_2
+      INTEGER :: istart , iend , jstart , jend , kstart , kend 
+      INTEGER , DIMENSION(ims:ime,kms:kme        )               :: k_above , k_below
+      INTEGER , DIMENSION(ims:ime                )               :: ks
+      INTEGER , DIMENSION(ims:ime                )               :: ko_above_sfc
+
+      LOGICAL :: any_below_ground
+
+      REAL :: p1 , p2 , pn
+!****MARS
+integer vert_extrap
+integer kn_save
+vert_extrap = 0
+kn_save = 0
+!****MARS
+
+      !  Horizontal loop bounds for different variable types.
+
+      IF      ( var_type .EQ. 'U' ) THEN
+         istart = its
+         iend   = ite
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  porig(i,k,j) = ( po(i,k,j) + po(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = 1,generic
+                  porig(its,k,j) =  po(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = 1,generic
+                  porig(ite,k,j) =  po(ite-1,k,j)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = kstart,kend
+                  pnew(its,k,j) =  pnu(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = kstart,kend
+                  pnew(ite,k,j) =  pnu(ite-1,k,j)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( var_type .EQ. 'V' ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = jte
+         kstart = kts
+         kend   = kte-1
+         DO i = istart,iend
+            DO k = 1,generic
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  porig(i,k,j) = ( po(i,k,j) + po(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = 1,generic
+                  porig(i,k,jts) =  po(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+               DO k = 1,generic
+                  porig(i,k,jte) =  po(i,k,jte-1)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = kstart,kend
+                  pnew(i,k,jts) =  pnu(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+              DO k = kstart,kend
+                  pnew(i,k,jte) =  pnu(i,k,jte-1)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( ( var_type .EQ. 'W' ) .OR.  ( var_type .EQ. 'Z' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE IF ( ( var_type .EQ. 'T' ) .OR. ( var_type .EQ. 'Q' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      END IF
+
+
+      DO j = jstart , jend
+    
+         !  Skip all of the levels below ground in the original data based upon the surface pressure.
+         !  The ko_above_sfc is the index in the pressure array that is above the surface.  If there
+         !  are no levels underground, this is index = 2.  The remaining levels are eligible for use
+         !  in the vertical interpolation.
+   
+         DO i = istart , iend
+            ko_above_sfc(i) = -1
+         END DO
+         DO ko = kstart+1 , kend
+            DO i = istart , iend
+
+               IF ( ko_above_sfc(i) .EQ. -1 ) THEN
+                  IF ( porig(i,1,j) .GT. porig(i,ko,j) ) THEN
+                     ko_above_sfc(i) = ko
+!!****MARS
+!!old stuff
+!!
+!! Pressure level may be OK, however data from the diagfi is possibly missing
+!IF (forig(i,ko,j) .EQ. -1.0e+30) THEN
+!        ko_above_sfc(i) = -1
+!END IF
+!        !! Once the right start level is found, check that it is OK
+!        !! >> first column should be 1e30 or so, second column should be a realistic value
+!        !IF ( ko_above_sfc(i) .NE. -1 ) THEN
+!        !        print *, 'verif', forig(i,ko-1,j), forig(i,ko,j), forig(i,ko+1,j), ko
+!        !END IF
+!!
+!!****MARS
+                  END IF
+               END IF
+
+            END DO
+         END DO
+
+         !  Initialize interpolation location.  These are the levels in the original pressure
+         !  data that are physically below and above the targeted new pressure level.
+   
+         DO kn = kts , kte
+            DO i = its , ite
+               k_above(i,kn) = -1
+               k_below(i,kn) = -2
+            END DO
+         END DO
+    
+         !  Starting location is no lower than previous found location.  This is for O(n logn)
+         !  and not O(n^2), where n is the number of vertical levels to search.
+   
+         DO i = its , ite
+            ks(i) = 1
+         END DO
+
+         !  Find trapping layer for interpolation.  The kn index runs through all of the "new"
+         !  levels of data.
+   
+         DO kn = kstart , kend
+
+            DO i = istart , iend
+
+               !  For each "new" level (kn), we search to find the trapping levels in the "orig"
+               !  data.  Most of the time, the "new" levels are the eta surfaces, and the "orig"
+               !  levels are the input pressure levels.
+
+               found_trap_above : DO ko = ks(i) , generic-1
+
+                  !  Because we can have levels in the interpolation that are not valid,
+                  !  let's toss out any candidate orig pressure values that are below ground
+                  !  based on the surface pressure.  If the level =1, then this IS the surface
+                  !  level, so we HAVE to keep that one, but maybe not the ones above.  If the
+                  !  level (ks) is NOT=1, then we have to just CYCLE our loop to find a legit
+                  !  below-pressure value.  If we are not below ground, then we choose two
+                  !  neighboring levels to test whether they surround the new pressure level.
+
+                  !  The input trapping levels that we are trying is the surface and the first valid
+                  !  level above the surface.
+
+                  IF      ( ( ko .LT. ko_above_sfc(i) ) .AND. ( ko .EQ. 1 ) ) THEN
+                     ko_1 = ko
+                     ko_2 = ko_above_sfc(i)
+!!****MARS
+!!old remark: the possible issue is fixed later in the code ...
+!!****MARS
+     
+                  !  The "below" level is underground, cycle until we get to a valid pressure
+                  !  above ground.
+ 
+                  ELSE IF ( ( ko .LT. ko_above_sfc(i) ) .AND. ( ko .NE. 1 ) ) THEN
+                     CYCLE found_trap_above
+
+                  !  The "below" level is above the surface, so we are in the clear to test these
+                  !  two levels out.
+
+                  ELSE
+                     ko_1 = ko
+                     ko_2 = ko+1
+
+                  END IF
+
+
+                  !  The test of the candidate levels: "below" has to have a larger pressure, and
+                  !  "above" has to have a smaller pressure. 
+
+                  !  OK, we found the correct two surrounding levels.  The locations are saved for use in the
+                  !  interpolation.
+
+                  IF      ( ( porig(i,ko_1,j) .GE. pnew(i,kn,j) ) .AND. &
+                            ( porig(i,ko_2,j) .LT. pnew(i,kn,j) ) ) THEN
+                     k_above(i,kn) = ko_2
+                     k_below(i,kn) = ko_1
+                     ks(i) = ko_1
+                     EXIT found_trap_above
+
+                  !  What do we do is we need to extrapolate the data underground?  This happens when the
+                  !  lowest pressure that we have is physically "above" the new target pressure.  Our
+                  !  actions depend on the type of variable we are interpolating.
+
+                  ELSE IF   ( porig(i,1,j) .LT. pnew(i,kn,j) ) THEN
+!!****MARS
+!!old stuff
+!!check: values are usually quite close
+!print *,porig(i,1,j),pnew(i,kn,j)
+!!****MARS
+
+                     !  For horizontal winds and moisture, we keep a constant value under ground.
+
+                     IF      ( ( var_type .EQ. 'U' ) .OR. &
+                               ( var_type .EQ. 'V' ) .OR. &
+                               ( var_type .EQ. 'Q' ) ) THEN
+                        k_above(i,kn) = 1
+                        ks(i) = 1
+
+                     !  For temperature and height, we extrapolate the data.  Hopefully, we are not
+                     !  extrapolating too far.  For pressure level input, the eta levels are always
+                     !  contained within the surface to p_top levels, so no extrapolation is ever
+                     !  required.  
+
+                     ELSE IF ( ( var_type .EQ. 'Z' ) .OR. &
+                               ( var_type .EQ. 'T' ) ) THEN
+                        k_above(i,kn) = ko_above_sfc(i)
+                        k_below(i,kn) = 1
+                        ks(i) = 1
+!!!****MARS
+!!old stuff
+!k_above(i,kn) = 1
+!ks(i) = 1
+!!!"Hopefully, we are not extrapolating too far"
+!!!>> true on Mars ?? 
+!!!****MARS
+
+                     !  Just a catch all right now.
+
+                     ELSE
+                        k_above(i,kn) = 1
+                        ks(i) = 1
+                     END IF
+
+                     EXIT found_trap_above
+
+                  !  The other extrapolation that might be required is when we are going above the
+                  !  top level of the input data.  Usually this means we chose a P_PTOP value that
+                  !  was inappropriate, and we should stop and let someone fix this mess.  
+
+                  ELSE IF   ( porig(i,generic,j) .GT. pnew(i,kn,j) ) THEN
+                     print *,'data is too high, try a lower p_top'
+                     print *,'pnew=',pnew(i,kn,j),'i',i,'j',j,'kn',kn
+                        print *,'pnew=',pnew(i,:,j)
+                     print *,'porig=',porig(i,:,j)
+                     CALL wrf_error_fatal ('requested p_top is higher than input data, lower p_top')
+
+                  END IF
+               END DO found_trap_above
+            END DO
+         END DO
+
+         !  Linear vertical interpolation.
+
+         DO kn = kstart , kend
+            DO i = istart , iend
+               IF ( k_above(i,kn) .EQ. 1 ) THEN
+!!!****MARS
+!!old stuff
+!!!ne doit pas arriver avec la temperature si l'on definit bien le champ au sol
+!IF (forig(i,1,j) .EQ. -1.0e+30) THEN
+!        print *,'no data here - surface - var is ...',var_type,i,j,1
+!        print *,'setting to first level with data...',ko_above_sfc(i),porig(i,ko_above_sfc(i),j)
+!        forig(i,1,j) = forig(i,ko_above_sfc(i),j)
+!        !IF      ( ( var_type .EQ. 'U' ) .OR. &
+!        !    ( var_type .EQ. 'V' ) .OR. &
+!        !    ( var_type .EQ. 'Q' ) ) THEN
+!        !    print *,'zero wind at the ground'
+!        !    forig(i,1,j) = 0
+!        !ENDIF
+!               IF (forig(i,1,j) .EQ. -1.0e+30) THEN
+!                print *,'well ... are you sure ?'
+!                stop
+!                ENDIF
+!END IF
+!!!****MARS
+                  fnew(i,kn,j) = forig(i,1,j)
+               ELSE
+                  k2 = MAX ( k_above(i,kn) , 2)
+                  k1 = MAX ( k_below(i,kn) , 1)
+                  IF ( k1 .EQ. k2 ) THEN
+                     CALL wrf_error_fatal ( 'identical values in the interp, bad for divisions' )
+                  END IF
+!!!****MARS
+!!old stuff
+!IF (forig(i,k2,j) .EQ. -1.0e+30) THEN
+!        print *,'no data here - level above - you_d better stop',i,j,k2
+!        stop        
+!END IF
+!IF (forig(i,k1,j) .EQ. -1.0e+30) THEN
+!        print *,'no data here - level below - var is ...',var_type,i,j,k1
+!        print *,'setting to first level with data...',ko_above_sfc(i),porig(i,ko_above_sfc(i),j)
+!        forig(i,k1,j) = forig(i,ko_above_sfc(i),j)
+!        !!!VERIFIER QUE LA TEMPERATURE AU SOL N'EST PAS CONCERNEE
+!        !!!(montagnes=sources locales de chaleur)
+!        !!!normalement, pas de souci, et lors de l'exécution rien ne s'affiche
+!END IF
+!!!****MARS
+                  IF      ( interp_type .EQ. 1 ) THEN
+                     p1 = porig(i,k1,j)
+                     p2 = porig(i,k2,j)
+                     pn = pnew(i,kn,j)  
+                  ELSE IF ( interp_type .EQ. 2 ) THEN
+                     p1 = ALOG(porig(i,k1,j))
+                     p2 = ALOG(porig(i,k2,j))
+                     pn = ALOG(pnew(i,kn,j))
+                  END IF
+                  IF ( ( p1-pn) * (p2-pn) > 0. ) THEN
+!                    CALL wrf_error_fatal ( 'both trapping pressures are on the same side of the new pressure' )
+!                    CALL wrf_debug ( 0 , 'both trapping pressures are on the same side of the new pressure' )
+!!!****MARS
+vert_extrap = vert_extrap + 1
+!print *, 'extrapolate', pnew(i,kn,j)-porig(i,k1,j), 'for WRF level', kn
+IF (kn_save < kn) kn_save=kn
+!!!****MARS
+                  END IF
+                  fnew(i,kn,j) = ( forig(i,k1,j) * ( p2 - pn )   + &
+                                   forig(i,k2,j) * ( pn - p1 ) ) / &
+                                   ( p2 - p1 )
+               END IF 
+            END DO
+         END DO
+
+         search_below_ground : DO kn = kstart , kend
+            any_below_ground = .FALSE.
+            DO i = istart , iend
+               IF ( k_above(i,kn) .EQ. 1 ) THEN 
+                  fnew(i,kn,j) = forig(i,1,j)
+                  any_below_ground = .TRUE.
+               END IF
+            END DO
+            IF ( .NOT. any_below_ground ) THEN
+               EXIT search_below_ground
+            END IF
+         END DO search_below_ground
+
+         !  There may have been a request to have the surface data from the input field
+         !  to be assigned as to the lowest eta level.  This assumes thin layers (usually
+         !  the isobaric original field has the surface from 2-m T and RH, and 10-m U and V).
+
+
+         DO i = istart , iend
+            IF ( lowest_lev_from_sfc ) THEN
+               fnew(i,1,j) = forig(i,ko_above_sfc(i),j)
+            END IF
+         END DO
+
+      END DO
+print *,'VERT EXTRAP = ', vert_extrap
+print *,'finished with ... ', var_type
+print *,'max WRF eta level where extrap. occurs: ',kn_save
+
+   END SUBROUTINE vert_interp_old
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE lagrange_setup ( var_type , all_x , all_y , all_dim , n , target_x , target_y , target_dim ,i,j)
+
+      !  We call a Lagrange polynomial interpolator.  The parallel concerns are put off as this
+      !  is initially set up for vertical use.  The purpose is an input column of pressure (all_x),
+      !  and the associated pressure level data (all_y).  These are assumed to be sorted (ascending
+      !  or descending, no matter).  The locations to be interpolated to are the pressures in
+      !  target_x, probably the new vertical coordinate values.  The field that is output is the
+      !  target_y, which is defined at the target_x location.  Mostly we expect to be 2nd order
+      !  overlapping polynomials, with only a single 2nd order method near the top and bottom.
+      !  When n=1, this is linear; when n=2, this is a second order interpolator.
+
+      IMPLICIT NONE
+
+      CHARACTER (LEN=1) :: var_type
+      INTEGER , INTENT(IN) :: all_dim , n , target_dim
+      REAL, DIMENSION(all_dim) , INTENT(IN) :: all_x , all_y
+      REAL , DIMENSION(target_dim) , INTENT(IN) :: target_x
+      REAL , DIMENSION(target_dim) , INTENT(OUT) :: target_y
+
+      !  Brought in for debug purposes, all of the computations are in a single column.
+
+      INTEGER , INTENT(IN) :: i,j
+
+      !  Local vars
+
+      REAL , DIMENSION(n+1) :: x , y 
+      REAL :: target_y_1 , target_y_2
+      LOGICAL :: found_loc
+      INTEGER :: loop , loc_center_left , loc_center_right , ist , iend , target_loop
+
+
+      IF ( all_dim .LT. n+1 ) THEN
+print *,'all_dim = ',all_dim
+print *,'order = ',n
+print *,'i,j = ',i,j
+print *,'p array = ',all_x
+print *,'f array = ',all_y
+print *,'p target= ',target_x
+         CALL wrf_error_fatal ( 'troubles, the interpolating order is too large for this few input values' )
+      END IF
+
+      IF ( n .LT. 1 ) THEN
+         CALL wrf_error_fatal ( 'pal, linear is about as low as we go' )
+      END IF
+
+      !  Loop over the list of target x and y values.
+
+      DO target_loop = 1 , target_dim
+
+         !  Find the two trapping x values, and keep the indices.
+   
+         found_loc = .FALSE.
+         find_trap : DO loop = 1 , all_dim -1
+            IF ( ( target_x(target_loop) - all_x(loop) ) * ( target_x(target_loop) - all_x(loop+1) ) .LE. 0.0 ) THEN
+               loc_center_left  = loop
+               loc_center_right = loop+1
+               found_loc = .TRUE.
+!****MARS: check if no errors here
+!print *,'interpolating ... ',var_type
+!       print *,'i,j = ',i,j
+!       print *,'target pressure and value = ',target_x(target_loop),target_y(target_loop)
+!       DO loop = 1 , all_dim
+!         print *,'column of pressure and value = ',all_x(loop),all_y(loop)
+!       END DO
+!END IF  
+!****MARS
+               EXIT find_trap
+            END IF
+         END DO find_trap
+   
+         IF ( ( .NOT. found_loc ) .AND. ( target_x(target_loop) .GT. all_x(1) ) ) THEN
+            IF ( var_type .EQ. 'T' ) THEN
+write(6,fmt='(A,2i5,2f11.3)') &
+' --> extrapolating TEMPERATURE near sfc: i,j,psfc, p target = ',&
+i,j,all_x(1),target_x(target_loop)
+               target_y(target_loop) = ( all_y(1) * ( target_x(target_loop) - all_x(2) ) + &
+                                         all_y(2) * ( all_x(1) - target_x(target_loop) ) ) / &
+                                       ( all_x(1) - all_x(2) ) 
+            ELSE 
+!write(6,fmt='(A,2i5,2f11.3)') &
+!' --> extrapolating zero gradient near sfc: i,j,psfc, p target = ',&
+!i,j,all_x(1),target_x(target_loop)
+               target_y(target_loop) = all_y(1)
+            END IF
+            CYCLE
+         ELSE IF ( .NOT. found_loc ) THEN
+!****MARS: normally, no errors here (otherwise, keep this part commented ?)
+            print *, var_type
+            print *,'i,j = ',i,j
+            print *,'target pressure and value = ',target_x(target_loop),target_y(target_loop)
+            DO loop = 1 , all_dim
+               print *,'column of pressure and value = ',all_x(loop),all_y(loop)
+            END DO
+           CALL wrf_error_fatal ( 'troubles, could not find trapping x locations' )
+!****MARS: end of 'keep this part commented'
+         END IF
+   
+         !  Even or odd order?  We can put the value in the middle if this is
+         !  an odd order interpolator.  For the even guys, we'll do it twice
+         !  and shift the range one index, then get an average.
+   
+         IF      ( MOD(n,2) .NE. 0 ) THEN
+            IF ( ( loc_center_left -(((n+1)/2)-1) .GE.       1 ) .AND. &
+                 ( loc_center_right+(((n+1)/2)-1) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n+1)/2)-1)
+               iend = iend + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y(target_loop) )
+            ELSE
+               IF ( .NOT. found_loc ) THEN
+                  CALL wrf_error_fatal ( 'I doubt this will happen, I will only do 2nd order for now' )
+               END IF
+            END IF
+   
+         ELSE IF ( MOD(n,2) .EQ. 0 ) THEN
+            IF      ( ( loc_center_left -(((n  )/2)-1) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)  ) .LE. all_dim ) .AND. &
+                      ( loc_center_left -(((n  )/2)  ) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)-1) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n  )/2)-1)
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y_1              )
+               ist  = loc_center_left -(((n  )/2)  )
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y_2              )
+               target_y(target_loop) = ( target_y_1 + target_y_2 ) * 0.5
+   
+            ELSE IF ( ( loc_center_left -(((n  )/2)-1) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)  ) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n  )/2)-1)
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y(target_loop)   )
+            ELSE IF ( ( loc_center_left -(((n  )/2)  ) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)-1) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n  )/2)  )
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y(target_loop)   )
+            ELSE
+               CALL wrf_error_fatal ( 'unauthorized area, you should not be here' )
+            END IF
+               
+         END IF
+
+      END DO
+
+   END SUBROUTINE lagrange_setup 
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE lagrange_interp ( x , y , n , target_x , target_y )
+
+      !  Interpolation using Lagrange polynomials.
+      !  P(x) = f(x0)Ln0(x) + ... + f(xn)Lnn(x)
+      !  where Lnk(x) = (x -x0)(x -x1)...(x -xk-1)(x -xk+1)...(x -xn)
+      !                 ---------------------------------------------
+      !                 (xk-x0)(xk-x1)...(xk-xk-1)(xk-xk+1)...(xk-xn)
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: n
+      REAL , DIMENSION(0:n) , INTENT(IN) :: x , y
+      REAL , INTENT(IN) :: target_x
+
+      REAL , INTENT(OUT) :: target_y
+
+      !  Local vars
+
+      INTEGER :: i , k
+      REAL :: numer , denom , Px
+      REAL , DIMENSION(0:n) :: Ln
+
+      Px = 0.
+      DO i = 0 , n
+         numer = 1.         
+         denom = 1.         
+         DO k = 0 , n
+            IF ( k .EQ. i ) CYCLE
+            numer = numer * ( target_x  - x(k) )
+            denom = denom * ( x(i)  - x(k) )
+         END DO
+         Ln(i) = y(i) * numer / denom
+         Px = Px + Ln(i)
+      END DO
+      target_y = Px
+
+   END SUBROUTINE lagrange_interp
+
+#ifndef VERT_UNIT
+!---------------------------------------------------------------------
+
+   SUBROUTINE p_dry ( mu0 , eta , pdht , pdry , &
+                             ids , ide , jds , jde , kds , kde , &
+                             ims , ime , jms , jme , kms , kme , &
+                             its , ite , jts , jte , kts , kte )
+
+   !  Compute reference pressure and the reference mu.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(IN)     :: mu0
+      REAL , DIMENSION(        kms:kme        ) , INTENT(IN)     :: eta
+      REAL                                                       :: pdht
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: pdry
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+      REAL , DIMENSION(        kms:kme        )                  :: eta_h
+
+      DO k = kts , kte-1
+         eta_h(k) = ( eta(k) + eta(k+1) ) * 0.5
+      END DO
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO k = kts , kte-1
+            DO i = its , MIN (ide-1 , ite )
+                  pdry(i,k,j) = eta_h(k) * mu0(i,j) + pdht
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE p_dry
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE p_dts ( pdts , intq , psfc , p_top , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Compute difference between the dry, total surface pressure and the top pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , INTENT(IN) :: p_top
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN)     :: psfc
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN)     :: intq
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(OUT)    :: pdts
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+               pdts(i,j) = psfc(i,j) - intq(i,j) - p_top
+         END DO
+      END DO
+
+   END SUBROUTINE p_dts
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE p_dhs ( pdhs , ht , p0 , t0 , a , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Compute dry, hydrostatic surface pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(IN)     :: ht
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(OUT)    :: pdhs
+
+      REAL , INTENT(IN) :: p0 , t0 , a
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+!****MARS ....
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: g  =   3.72
+print *,'compute dry, hydrostatic surface pressure'
+!****MARS ....
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+               pdhs(i,j) = p0 * EXP ( -t0/a + SQRT ( (t0/a)**2 - 2. * g * ht(i,j)/(a * Rd) ) )
+         END DO
+      END DO
+
+!****MARS
+!****MARS cette formule est-elle juste sur Mars ?
+!****MARS >> a premiere vue, ne donne pas de resultats absurdes
+!****TODO: il y a peut etre meilleur !
+!****MARS
+
+!print *,pdhs
+!stop
+
+
+   END SUBROUTINE p_dhs
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE find_p_top ( p , p_top , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte )
+
+   !  Find the largest pressure in the top level.  This is our p_top.  We are
+   !  assuming that the top level is the location where the pressure is a minimum
+   !  for each column.  In cases where the top surface is not isobaric, a 
+   !  communicated value must be shared in the calling routine.  Also in cases
+   !  where the top surface is not isobaric, care must be taken that the new
+   !  maximum pressure is not greater than the previous value.  This test is
+   !  also handled in the calling routine.
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL :: p_top
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: p
+
+      !  Local vars
+
+      INTEGER :: i , j , k, min_lev
+
+      i = its
+      j = jts
+      p_top = p(i,2,j)
+      min_lev = 2
+      DO k = 2 , kte
+         IF ( p_top .GT. p(i,k,j) ) THEN
+            p_top = p(i,k,j)
+            min_lev = k
+         END IF
+      END DO
+
+      k = min_lev
+      p_top = p(its,k,jts)
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+            p_top = MAX ( p_top , p(i,k,j) )
+         END DO
+      END DO
+
+   END SUBROUTINE find_p_top
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE t_to_theta ( t , p , p00 , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Compute dry, hydrostatic surface pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , INTENT(IN) :: p00
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: p
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT)  :: t
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+!****MARS warning warning hardcoded !!!!
+!      REAL , PARAMETER :: Rd = 192.
+!      REAL , PARAMETER :: Cp = 844.6
+   REAL    , PARAMETER :: Rd          = 191.
+   REAL    , PARAMETER :: Cp           = 744.5
+!****MARS
+      
+      DO j = jts , MIN ( jde-1 , jte )
+         DO k = kts , kte
+            DO i = its , MIN (ide-1 , ite )
+               t(i,k,j) = t(i,k,j) * ( p00 / p(i,k,j) ) ** (Rd / Cp)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE t_to_theta
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE integ_moist ( q_in , p_in , pd_out , t_in , ght_in , intq , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+   !  Integrate the moisture field vertically.  Mostly used to get the total
+   !  vapor pressure, which can be subtracted from the total pressure to get
+   !  the dry pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: q_in , p_in , t_in , ght_in
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: pd_out
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(OUT)    :: intq
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+      INTEGER , DIMENSION(ims:ime) :: level_above_sfc
+      REAL , DIMENSION(ims:ime,jms:jme) :: psfc , tsfc , qsfc, zsfc
+      REAL , DIMENSION(ims:ime,kms:kme) :: q , p , t , ght, pd
+
+      REAL :: rhobar , qbar , dz
+      REAL :: p1 , p2 , t1 , t2 , q1 , q2 , z1, z2
+  
+      LOGICAL :: upside_down
+
+!****MARS
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: g  =   3.72
+!****MARS
+      
+
+      !  Get a surface value, always the first level of a 3d field.
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+            psfc(i,j) = p_in(i,kts,j)
+            tsfc(i,j) = t_in(i,kts,j)
+            qsfc(i,j) = q_in(i,kts,j)
+            zsfc(i,j) = ght_in(i,kts,j)
+         END DO
+      END DO
+
+      IF ( p_in(its,kts+1,jts) .LT. p_in(its,kte,jts) ) THEN
+         upside_down = .TRUE.
+      ELSE
+         upside_down = .FALSE.
+      END IF
+
+      DO j = jts , MIN ( jde-1 , jte )
+
+         !  Initialize the integrated quantity of moisture to zero.
+
+         DO i = its , MIN (ide-1 , ite )
+            intq(i,j) = 0.
+         END DO
+
+         IF ( upside_down ) THEN
+            DO i = its , MIN (ide-1 , ite )
+               p(i,kts) = p_in(i,kts,j)
+               t(i,kts) = t_in(i,kts,j)
+               q(i,kts) = q_in(i,kts,j)
+               ght(i,kts) = ght_in(i,kts,j)
+               DO k = kts+1,kte
+                  p(i,k) = p_in(i,kte+2-k,j)
+                  t(i,k) = t_in(i,kte+2-k,j)
+                  q(i,k) = q_in(i,kte+2-k,j)
+                  ght(i,k) = ght_in(i,kte+2-k,j)
+               END DO
+            END DO
+         ELSE
+            DO i = its , MIN (ide-1 , ite )
+               DO k = kts,kte
+                  p(i,k) = p_in(i,k      ,j)
+                  t(i,k) = t_in(i,k      ,j)
+                  q(i,k) = q_in(i,k      ,j)
+                  ght(i,k) = ght_in(i,k      ,j)
+               END DO
+            END DO
+         END IF
+
+         !  Find the first level above the ground.  If all of the levels are above ground, such as
+         !  a terrain following lower coordinate, then the first level above ground is index #2.
+
+         DO i = its , MIN (ide-1 , ite )
+            level_above_sfc(i) = -1
+            IF ( p(i,kts+1) .LT. psfc(i,j) ) THEN
+               level_above_sfc(i) = kts+1
+            ELSE
+               find_k : DO k = kts+1,kte-1
+                  IF ( ( p(i,k  )-psfc(i,j) .GE. 0. ) .AND. &
+                       ( p(i,k+1)-psfc(i,j) .LT. 0. ) ) THEN 
+                     level_above_sfc(i) = k+1
+                     EXIT find_k
+                  END IF
+               END DO find_k
+               IF ( level_above_sfc(i) .EQ. -1 ) THEN
+print *,'i,j = ',i,j
+print *,'p = ',p(i,:)
+print *,'p sfc = ',psfc(i,j)
+                  CALL wrf_error_fatal ( 'Could not find level above ground')
+               END IF
+            END IF
+         END DO
+
+         DO i = its , MIN (ide-1 , ite )
+
+            !  Account for the moisture above the ground.
+
+            pd(i,kte) = p(i,kte)
+            DO k = kte-1,level_above_sfc(i),-1
+                  rhobar = ( p(i,k  ) / ( Rd * t(i,k  ) ) + &
+                             p(i,k+1) / ( Rd * t(i,k+1) ) ) * 0.5
+                  qbar   = ( q(i,k  ) + q(i,k+1) ) * 0.5
+                  dz     = ght(i,k+1) - ght(i,k)
+                  intq(i,j) = intq(i,j) + g * qbar * rhobar / (1. + qbar) * dz
+                  pd(i,k) = p(i,k) - intq(i,j)
+            END DO
+
+            !  Account for the moisture between the surface and the first level up.
+
+            IF ( ( p(i,level_above_sfc(i)-1)-psfc(i,j) .GE. 0. ) .AND. &
+                 ( p(i,level_above_sfc(i)  )-psfc(i,j) .LT. 0. ) .AND. &
+                 ( level_above_sfc(i) .GT. kts ) ) THEN
+               p1 = psfc(i,j)
+               p2 = p(i,level_above_sfc(i))
+               t1 = tsfc(i,j)
+               t2 = t(i,level_above_sfc(i))
+               q1 = qsfc(i,j)
+               q2 = q(i,level_above_sfc(i))
+               z1 = zsfc(i,j)
+               z2 = ght(i,level_above_sfc(i))
+               rhobar = ( p1 / ( Rd * t1 ) + &
+                          p2 / ( Rd * t2 ) ) * 0.5
+               qbar   = ( q1 + q2 ) * 0.5
+               dz     = z2 - z1
+               IF ( dz .GT. 0.1 ) THEN
+                  intq(i,j) = intq(i,j) + g * qbar * rhobar / (1. + qbar) * dz
+               END IF
+              
+               !  Fix the underground values.
+
+               DO k = level_above_sfc(i)-1,kts+1,-1
+                  pd(i,k) = p(i,k) - intq(i,j)
+               END DO
+            END IF
+            pd(i,kts) = psfc(i,j) - intq(i,j)
+
+         END DO
+
+         IF ( upside_down ) THEN
+            DO i = its , MIN (ide-1 , ite )
+               pd_out(i,kts,j) = pd(i,kts)
+               DO k = kts+1,kte
+                  pd_out(i,kte+2-k,j) = pd(i,k)
+               END DO
+            END DO
+         ELSE
+            DO i = its , MIN (ide-1 , ite )
+               DO k = kts,kte
+                  pd_out(i,k,j) = pd(i,k)
+               END DO
+            END DO
+         END IF
+
+      END DO
+
+
+!!!****MARS: no water vapor pressure
+!!    DO k = level_above_sfc(i)-1,kts+1,-1
+!!         pd(i,k) = p(i,k)
+!!    END DO
+!!    pd(i,kts) = psfc(i,j)
+!!!****MARS
+
+
+   END SUBROUTINE integ_moist
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE rh_to_mxrat (rh, t, p, q , wrt_liquid , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte )
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      LOGICAL , INTENT(IN)        :: wrt_liquid
+
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: p , t
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT)  :: rh
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: q
+
+      !  Local vars
+
+      INTEGER                     :: i , j , k 
+
+      REAL                        :: ew , q1 , t1
+!****MARS ....  regler si besoin ....
+!****MARS
+      REAL,         PARAMETER     :: T_REF       = 0.0
+      REAL,         PARAMETER     :: MW_AIR      = 28.966
+      REAL,         PARAMETER     :: MW_VAP      = 18.0152
+
+      REAL,         PARAMETER     :: A0       = 6.107799961
+      REAL,         PARAMETER     :: A1       = 4.436518521e-01
+      REAL,         PARAMETER     :: A2       = 1.428945805e-02
+      REAL,         PARAMETER     :: A3       = 2.650648471e-04
+      REAL,         PARAMETER     :: A4       = 3.031240396e-06
+      REAL,         PARAMETER     :: A5       = 2.034080948e-08
+      REAL,         PARAMETER     :: A6       = 6.136820929e-11
+
+      REAL,         PARAMETER     :: ES0 = 6.1121
+
+      REAL,         PARAMETER     :: C1       = 9.09718
+      REAL,         PARAMETER     :: C2       = 3.56654
+      REAL,         PARAMETER     :: C3       = 0.876793
+      REAL,         PARAMETER     :: EIS      = 6.1071
+      REAL                        :: RHS
+      REAL,         PARAMETER     :: TF       = 273.16
+      REAL                        :: TK
+
+      REAL                        :: ES
+      REAL                        :: QS
+      REAL,         PARAMETER     :: EPS         = 0.622
+      REAL,         PARAMETER     :: SVP1        = 0.6112
+      REAL,         PARAMETER     :: SVP2        = 17.67
+      REAL,         PARAMETER     :: SVP3        = 29.65
+      REAL,         PARAMETER     :: SVPT0       = 273.15
+!****MARS
+!****MARS
+
+
+      !  This subroutine computes mixing ratio (q, kg/kg) from basic variables
+      !  pressure (p, Pa), temperature (t, K) and relative humidity (rh, 1-100%).
+      !  The reference temperature (t_ref, C) is used to describe the temperature 
+      !  at which the liquid and ice phase change occurs.
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO k = kts , kte
+            DO i = its , MIN (ide-1 , ite )
+                  rh(i,k,j) = MIN ( MAX ( rh(i,k,j) ,  1. ) , 100. ) 
+            END DO
+         END DO
+      END DO
+
+      IF ( wrt_liquid ) THEN
+         DO j = jts , MIN ( jde-1 , jte )
+            DO k = kts , kte
+               DO i = its , MIN (ide-1 , ite )
+                  es=svp1*10.*EXP(svp2*(t(i,k,j)-svpt0)/(t(i,k,j)-svp3))
+                  qs=eps*es/(p(i,k,j)/100.-es)
+                  q(i,k,j)=MAX(.01*rh(i,k,j)*qs,0.0)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+         DO j = jts , MIN ( jde-1 , jte )
+            DO k = kts , kte
+               DO i = its , MIN (ide-1 , ite )
+
+                  t1 = t(i,k,j) - 273.16
+
+                  !  Obviously dry.
+
+                  IF ( t1 .lt. -200. ) THEN
+                     q(i,k,j) = 0
+
+                  ELSE
+
+                     !  First compute the ambient vapor pressure of water
+
+                     IF ( ( t1 .GE. t_ref ) .AND. ( t1 .GE. -47.) ) THEN    ! liq phase ESLO
+                        ew = a0 + t1 * (a1 + t1 * (a2 + t1 * (a3 + t1 * (a4 + t1 * (a5 + t1 * a6)))))
+
+                     ELSE IF ( ( t1 .GE. t_ref ) .AND. ( t1 .LT. -47. ) ) then !liq phas poor ES
+                        ew = es0 * exp(17.67 * t1 / ( t1 + 243.5))
+
+                     ELSE
+                        tk = t(i,k,j)
+                        rhs = -c1 * (tf / tk - 1.) - c2 * alog10(tf / tk) +  &
+                               c3 * (1. - tk / tf) +      alog10(eis)
+                        ew = 10. ** rhs
+
+                     END IF
+
+                     !  Now sat vap pres obtained compute local vapor pressure
+  
+                     ew = MAX ( ew , 0. ) * rh(i,k,j) * 0.01
+
+                     !  Now compute the specific humidity using the partial vapor
+                     !  pressures of water vapor (ew) and dry air (p-ew).  The
+                     !  constants assume that the pressure is in hPa, so we divide
+                     !  the pressures by 100.
+
+                     q1 = mw_vap * ew
+                     q1 = q1 / (q1 + mw_air * (p(i,k,j)/100. - ew))
+
+                     q(i,k,j) = q1 / (1. - q1 )
+
+                  END IF
+
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+!!****MARS
+!!TODO: change once tracers are activated ?
+!q=0.
+!!****MARS
+
+   END SUBROUTINE rh_to_mxrat
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE compute_eta ( znw , &
+                           eta_levels , max_eta , max_dz , &
+fixedpbl, &
+                           p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0 , &
+tiso, &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte )
+   
+      !  Compute eta levels, either using given values from the namelist (hardly
+      !  a computation, yep, I know), or assuming a constant dz above the PBL,
+      !  knowing p_top and the number of eta levels.
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+      REAL , INTENT(IN)           :: max_dz
+      REAL , INTENT(IN)           :: p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0
+      INTEGER , INTENT(IN)        :: max_eta
+      REAL , DIMENSION (max_eta) , INTENT(IN)  :: eta_levels
+
+      REAL , DIMENSION (kts:kte) , INTENT(OUT) :: znw
+
+      !  Local vars
+
+      INTEGER :: k 
+      REAL :: mub , t_init , p_surf , pb, ztop, ztop_pbl , dz , temp
+      REAL , DIMENSION(kts:kte) :: dnw
+
+      INTEGER , PARAMETER :: prac_levels = 17
+      INTEGER :: loop , loop1
+      REAL , DIMENSION(prac_levels) :: znw_prac , znu_prac , dnw_prac
+      REAL , DIMENSION(kts:kte) :: alb , phb
+
+REAL :: z_scale 
+REAL, INTENT(IN) :: tiso
+
+!****MARS      
+!****MARS
+INTEGER :: fixedpbl   ! usually, 8 first layers are fixed
+                    ! change this parameter if the top is very
+                    ! low     
+print *, 'check Mars: p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0' 
+print *, p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0
+!-----solution alternative: definir dans la namelist les niveaux verticaux
+!****MARS
+!****MARS
+
+
+      !  Gee, do the eta levels come in from the namelist?
+
+      IF ( ABS(eta_levels(1)+1.) .GT. 0.0000001 ) THEN
+
+         IF ( ( ABS(eta_levels(1  )-1.) .LT. 0.0000001 ) .AND. &
+              ( ABS(eta_levels(kde)-0.) .LT. 0.0000001 ) ) THEN
+            DO k = kds+1 , kde-1
+               znw(k) = eta_levels(k)
+            END DO
+            znw(  1) = 1.
+            znw(kde) = 0.
+
+         ELSE
+            !CALL wrf_error_fatal ( 'First eta level should be 1.0 and the last 0.0 in namelist' )
+
+print *, 'ok that s bad so I read the file, got it'
+!!MARS
+!!MARS
+  open(unit=12,file='levels',form='formatted',status='old')
+  rewind(12) 
+   DO k = kds, kde-1
+    read(12,*) znw(k)
+    write(6,*) 'read level ', k, znw(k)
+   ENDDO
+  close(12)  
+  znw(  1) = 1.
+  znw(kde) = 0.
+
+!   z_scale = .40
+!   DO k=1, kde
+!      znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+!                                (1.-exp(-1./z_scale))
+!   ENDDO
+!        znw(1) = 1.0000
+!        znw(2) = 0.9995
+!        znw(3) = 0.9980
+!        znw(4) = 0.9950
+!        znw(5) = 0.9850
+!        znw(6) = 0.9700
+!        znw(7) = 0.9400
+!        znw(8) = 0.9000
+
+!!MARS
+!!MARS
+
+
+         END IF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+p_surf=p00
+print *, 'prescribed levels'
+DO k = 1, kde
+        pb = znw(k) * (p_surf - p_top) + p_top
+        print *, 'level', k, &
+                 ', pressure (Pa)', pb, &
+                 ', logp height (m)', -10000.*log(pb/p00)
+END DO
+!mub = p_surf - p_top
+!DO k = 1, kde-1
+!    pb = (znw(k)+znw(k+1))*0.5 * (p_surf - p_top) + p_top
+!    !temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+!    temp =             t00 + A*LOG(pb/p00)
+!    t_init = temp*(p00/pb)**(r_d/cp) - t0
+!    alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+!END DO
+!phb(1) = 0.
+!DO k  = 2,kde
+!    phb(k) = phb(k-1) - (znw(k)-znw(k-1)) * mub*alb(k-1)
+!END DO
+!ztop = phb(kde)/g
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      !  Compute eta levels assuming a constant delta z above the PBL.
+
+      ELSE
+
+         !  Compute top of the atmosphere with some silly levels.  We just want to
+         !  integrate to get a reasonable value for ztop.  We use the planned PBL-esque
+         !  levels, and then just coarse resolution above that.  We know p_top, and we
+         !  have the base state vars.
+
+         p_surf = p00 
+
+!         znw_prac = (/ 1.000 , 0.993 , 0.983 , 0.970 , 0.954 , 0.934 , 0.909 , &
+!                       0.88 , 0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+
+!****MARS
+!****MARS
+! on Mars, this is important to correctly resolve the surface
+! -- levels were changed to get closer to the surface
+! -- values were chosen as done typically in LMD GCM simulations
+!TODO: better repartition ?
+
+!        znw_prac = (/ 1.000 , &
+!                        0.9999 , & !1m
+!                        0.9995 , & !5m
+!                        0.9980 , & !20m
+!                        0.9950 , & !55m
+!                        0.9850 , & !166m
+!                        0.9550 , & !504m  0.9700 , & !334m  0.9400 , & !676m
+!                        0.9000 , &
+!                        0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+
+
+        znw_prac = (/ 1.000 , &         
+                        0.9995 , &      !5m
+                        0.9980 , &      !20m
+                        0.9950 , &      !55m
+                        0.9850 , &      !166m
+                        0.9700 , &      !334m
+                        0.9400 , &      !676m
+                        0.9000 , &
+                        0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+
+!****MARS
+!****MARS
+
+
+         DO k = 1 , prac_levels - 1
+            znu_prac(k) = ( znw_prac(k) + znw_prac(k+1) ) * 0.5
+            dnw_prac(k) = znw_prac(k+1) - znw_prac(k)
+         END DO
+
+         DO k = 1, prac_levels-1
+            pb = znu_prac(k)*(p_surf - p_top) + p_top
+!!           temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+!            temp =             t00 + A*LOG(pb/p00)
+temp = MAX ( tiso, t00 + A*LOG(pb/p00) )
+           IF (planet .eq. "mars" ) THEN
+              t_init = temp*(p00/pb)**(r_d/cp) - t0
+            ELSE
+              t_init = (temp**nu + nu*(TT00**nu)*log((p00/pb)**(rcp)))**(1/nu) - t0
+            ENDIF
+            alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+         END DO
+       
+         !  Base state mu is defined as base state surface pressure minus p_top
+
+         mub = p_surf - p_top
+       
+         !  Integrate base geopotential, starting at terrain elevation.
+
+         phb(1) = 0.
+         DO k  = 2,prac_levels
+               phb(k) = phb(k-1) - dnw_prac(k-1)*mub*alb(k-1)
+         END DO
+
+         !  So, now we know the model top in meters.  Get the average depth above the PBL
+         !  of each of the remaining levels.  We are going for a constant delta z thickness.
+
+         ztop     = phb(prac_levels) / g
+         ztop_pbl = phb(fixedpbl) / g
+         dz = ( ztop - ztop_pbl ) / REAL ( kde - fixedpbl )
+
+         !  Standard levels near the surface so no one gets in trouble.
+         DO k = 1 , fixedpbl
+            znw(k) = znw_prac(k)
+         END DO
+
+         !  Using d phb(k)/ d eta(k) = -mub * alb(k), eqn 2.9 
+         !  Skamarock et al, NCAR TN 468.  Use full levels, so
+         !  use twice the thickness.
+
+         DO k = fixedpbl, kte-1
+            pb = znw(k) * (p_surf - p_top) + p_top
+!!           temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+!            temp =             t00 + A*LOG(pb/p00)
+temp = MAX ( tiso, t00 + A*LOG(pb/p00) )
+           IF (planet .eq. "mars" ) THEN
+              t_init = temp*(p00/pb)**(r_d/cp) - t0
+            ELSE
+              t_init = (temp**nu + nu*(TT00**nu)*log((p00/pb)**(rcp)))**(1/nu) -t0
+            ENDIF
+            alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+            znw(k+1) = znw(k) - dz*g / ( mub*alb(k) )
+         END DO
+         znw(kte) = 0.000
+
+         !  There is some iteration.  We want the top level, ztop, to be
+         !  consistent with the delta z, and we want the half level values
+         !  to be consistent with the eta levels.  The inner loop to 10 gets
+         !  the eta levels very accurately, but has a residual at the top, due
+         !  to dz changing.  We reset dz five times, and then things seem OK.
+
+
+         DO loop1 = 1 , 5
+            DO loop = 1 , 10
+               DO k = fixedpbl, kte-1
+                  pb = (znw(k)+znw(k+1))*0.5 * (p_surf - p_top) + p_top
+!!                 temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+!                  temp =             t00 + A*LOG(pb/p00)
+temp = MAX ( tiso, t00 + A*LOG(pb/p00) )
+           IF (planet .eq. "mars" ) THEN
+              t_init = temp*(p00/pb)**(r_d/cp) - t0
+            ELSE
+              t_init = (temp**nu + nu*(TT00**nu)*log((p00/pb)**(rcp)))**(1/nu) -t0
+            ENDIF
+                  alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+                  znw(k+1) = znw(k) - dz*g / ( mub*alb(k) )
+!!****MARS
+!!attention 'base_lapse' ne doit pas etre trop grand
+!!sinon ... des NaN car temperatures negatives en haut
+!IF ( ( loop1 .EQ. 5 ) .AND. ( loop .EQ. 10 ) ) THEN
+!	IF (k .EQ. 8) THEN
+!		print *, 'p,t,z,k'
+!	END IF
+!	print *,  pb,temp,znw(k+1),k 
+!END IF
+!****MARS
+               END DO
+               IF ( ( loop1 .EQ. 5 ) .AND. ( loop .EQ. 10 ) ) THEN
+                  print *,'Converged znw(kte) should be 0.0 = ',znw(kte)
+               END IF
+               znw(kte) = 0.000
+            END DO
+
+            !  Here is where we check the eta levels values we just computed.
+
+            DO k = 1, kde-1
+               pb = (znw(k)+znw(k+1))*0.5 * (p_surf - p_top) + p_top
+!!              temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+!               temp =             t00 + A*LOG(pb/p00)
+temp = MAX ( tiso, t00 + A*LOG(pb/p00) )
+           IF (planet .eq. "mars" ) THEN
+              t_init = temp*(p00/pb)**(r_d/cp) - t0
+            ELSE
+              t_init = (temp**nu + nu*(TT00**nu)*log((p00/pb)**(rcp)))**(1/nu) -t0
+            ENDIF
+               alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+            END DO
+
+            phb(1) = 0.
+            DO k  = 2,kde
+                  phb(k) = phb(k-1) - (znw(k)-znw(k-1)) * mub*alb(k-1)
+            END DO
+
+            !  Reset the model top and the dz, and iterate.
+
+            ztop = phb(kde)/g
+            ztop_pbl = phb(fixedpbl)/g
+            dz = ( ztop - ztop_pbl ) / REAL ( kde - fixedpbl ) 
+         END DO
+
+
+! ****MARS
+
+print *, 'eta_levels= ', znw
+
+
+! Display the computed levels
+print *,'WRF levels are:'
+print *,'z (m)            = ',phb(1)/g
+do k = 2 ,kte
+print *,'z (m) and dz (m) = ',phb(k)/g,(phb(k)-phb(k-1))/g
+
+
+                !! little check of the repartition
+                if (k>2) then
+                if ((phb(k)-2.*phb(k-1)+phb(k-2))/g < -1.e-2) then
+                        print *, 'problem on the repartition' 
+                        print *, '>> try to decrease force_sfc_in_vinterp (<8)'
+                        print *, '>> or increase model top (i.e. lower ptop)'
+                        print *,  (phb(k)-2.*phb(k-1)+phb(k-2))/g
+                        stop
+                endif
+                endif
+end do
+! ****MARS
+
+
+         IF ( dz .GT. max_dz ) THEN
+print *,'z (m)            = ',phb(1)/g
+do k = 2 ,kte
+print *,'z (m) and dz (m) = ',phb(k)/g,(phb(k)-phb(k-1))/g
+end do
+print *,'dz (m) above fixed eta levels = ',dz
+print *,'namelist max_dz (m) = ',max_dz
+print *,'namelist p_top (Pa) = ',p_top
+            CALL wrf_debug ( 0, 'You need one of three things:' )
+            CALL wrf_debug ( 0, '1) More eta levels to reduce the dz: e_vert' )
+            CALL wrf_debug ( 0, '2) A lower p_top so your total height is reduced: p_top_requested')
+            CALL wrf_debug ( 0, '3) Increase the maximum allowable eta thickness: max_dz')
+            CALL wrf_debug ( 0, 'All are namelist options')
+            CALL wrf_error_fatal ( 'dz above fixed eta levels is too large')
+         END IF
+
+      END IF
+
+   END SUBROUTINE compute_eta
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE monthly_min_max ( field_in , field_min , field_max , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Plow through each month, find the max, min values for each i,j.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,12,jms:jme) , INTENT(IN)  :: field_in
+      REAL , DIMENSION(ims:ime,   jms:jme) , INTENT(OUT) :: field_min , field_max
+
+      !  Local vars
+
+      INTEGER :: i , j , l
+      REAL :: minner , maxxer
+
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            minner = field_in(i,1,j)
+            maxxer = field_in(i,1,j)
+            DO l = 2 , 12
+               IF ( field_in(i,l,j) .LT. minner ) THEN
+                  minner = field_in(i,l,j)
+               END IF
+               IF ( field_in(i,l,j) .GT. maxxer ) THEN
+                  maxxer = field_in(i,l,j)
+               END IF
+            END DO
+            field_min(i,j) = minner
+            field_max(i,j) = maxxer
+         END DO
+      END DO
+   
+   END SUBROUTINE monthly_min_max
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE monthly_interp_to_date ( field_in , date_str , field_out , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Linrarly in time interpolate data to a current valid time.  The data is
+   !  assumed to come in "monthly", valid at the 15th of every month.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      CHARACTER (LEN=24) , INTENT(IN) :: date_str
+      REAL , DIMENSION(ims:ime,12,jms:jme) , INTENT(IN)  :: field_in
+      REAL , DIMENSION(ims:ime,   jms:jme) , INTENT(OUT) :: field_out
+
+      !  Local vars
+
+      INTEGER :: i , j , l
+      INTEGER , DIMENSION(0:13) :: middle
+      INTEGER :: target_julyr , target_julday , target_date
+      INTEGER :: julyr , julday , int_month , month1 , month2
+      REAL :: gmt
+      CHARACTER (LEN=4) :: yr
+      CHARACTER (LEN=2) :: mon , day15
+
+
+      WRITE(day15,FMT='(I2.2)') 15
+      DO l = 1 , 12
+         WRITE(mon,FMT='(I2.2)') l
+         CALL get_julgmt ( date_str(1:4)//'-'//mon//'-'//day15//'_'//'00:00:00.0000' , julyr , julday , gmt )
+         middle(l) = julyr*1000 + julday
+      END DO
+
+      l = 0
+      middle(l) = middle( 1) - 31
+
+      l = 13
+      middle(l) = middle(12) + 31
+
+      CALL get_julgmt ( date_str , target_julyr , target_julday , gmt )
+      target_date = target_julyr * 1000 + target_julday
+      find_month : DO l = 0 , 12
+         IF ( ( middle(l) .LT. target_date ) .AND. ( middle(l+1) .GE. target_date ) ) THEN
+            DO j = jts , MIN ( jde-1 , jte )
+               DO i = its , MIN (ide-1 , ite )
+                  int_month = l
+                  IF ( ( int_month .EQ. 0 ) .OR. ( int_month .EQ. 12 ) ) THEN
+                     month1 = 12
+                     month2 =  1
+                  ELSE
+                     month1 = int_month
+                     month2 = month1 + 1
+                  END IF
+                  field_out(i,j) =  ( field_in(i,month2,j) * ( target_date - middle(l)   ) + &
+                                      field_in(i,month1,j) * ( middle(l+1) - target_date ) ) / &
+                                    ( middle(l+1) - middle(l) )
+               END DO
+            END DO
+            EXIT find_month
+         END IF
+      END DO find_month
+
+   END SUBROUTINE monthly_interp_to_date
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE sfcprs (t, q, height, pslv, ter, avgsfct, p, &
+                      psfc, ez_method, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      !  Computes the surface pressure using the input height,
+      !  temperature and q (already computed from relative
+      !  humidity) on p surfaces.  Sea level pressure is used
+      !  to extrapolate a first guess.
+
+      IMPLICIT NONE
+
+!****MARS: ok not used
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: Cp = 844.6
+      REAL, PARAMETER    :: g = 3.72
+      REAL, PARAMETER    :: pconst = 610.
+!****MARS
+      
+!****MARS .... to be changed if used
+      REAL, PARAMETER    :: gamma     = 6.5E-3
+      REAL, PARAMETER    :: TC        = 273.15 + 17.5
+      REAL, PARAMETER    :: gammarg   = gamma * Rd / g
+      REAL, PARAMETER    :: rov2      = Rd / 2.
+!****MARS .... to be changed if used
+
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte 
+      LOGICAL , INTENT ( IN ) :: ez_method
+
+      REAL , DIMENSION (ims:ime,kms:kme,jms:jme) , INTENT(IN ):: t, q, height, p
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(IN ):: pslv ,  ter, avgsfct 
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(OUT):: psfc
+      
+      INTEGER                     :: i
+      INTEGER                     :: j
+      INTEGER                     :: k
+      INTEGER , DIMENSION (its:ite,jts:jte) :: k500 , k700 , k850
+
+      LOGICAL                     :: l1
+      LOGICAL                     :: l2
+      LOGICAL                     :: l3
+      LOGICAL                     :: OK
+
+      REAL                        :: gamma78     ( its:ite,jts:jte )
+      REAL                        :: gamma57     ( its:ite,jts:jte )
+      REAL                        :: ht          ( its:ite,jts:jte )
+      REAL                        :: p1          ( its:ite,jts:jte )
+      REAL                        :: t1          ( its:ite,jts:jte )
+      REAL                        :: t500        ( its:ite,jts:jte )
+      REAL                        :: t700        ( its:ite,jts:jte )
+      REAL                        :: t850        ( its:ite,jts:jte )
+      REAL                        :: tfixed      ( its:ite,jts:jte )
+      REAL                        :: tsfc        ( its:ite,jts:jte )
+      REAL                        :: tslv        ( its:ite,jts:jte )
+
+      !  We either compute the surface pressure from a time averaged surface temperature
+      !  (what we will call the "easy way"), or we try to remove the diurnal impact on the
+      !  surface temperature (what we will call the "other way").  Both are essentially 
+      !  corrections to a sea level pressure with a high-resolution topography field.
+
+!****MARS ....
+!****MARS .... the mean sea level method is abandoned
+print *, 'no sea level pressure on Mars, please'
+stop
+!****MARS ....
+
+      IF ( ez_method ) THEN
+
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               psfc(i,j) = pslv(i,j) * ( 1.0 + gamma * ter(i,j) / avgsfct(i,j) ) ** ( - g / ( Rd * gamma ) )
+            END DO
+         END DO
+
+      ELSE
+
+         !  Find the locations of the 850, 700 and 500 mb levels.
+   
+         k850 = 0                              ! find k at: P=850
+         k700 = 0                              !            P=700
+         k500 = 0                              !            P=500
+   
+         i = its
+         j = jts
+         DO k = kts+1 , kte
+            IF      (NINT(p(i,k,j)) .EQ. 85000) THEN
+               k850(i,j) = k
+            ELSE IF (NINT(p(i,k,j)) .EQ. 70000) THEN
+               k700(i,j) = k
+            ELSE IF (NINT(p(i,k,j)) .EQ. 50000) THEN
+               k500(i,j) = k
+            END IF
+         END DO
+   
+         IF ( ( k850(i,j) .EQ. 0 ) .OR. ( k700(i,j) .EQ. 0 ) .OR. ( k500(i,j) .EQ. 0 ) ) THEN
+
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  psfc(i,j) = pslv(i,j) * ( 1.0 + gamma * ter(i,j) / t(i,1,j) ) ** ( - g / ( Rd * gamma ) )
+               END DO
+            END DO
+            
+            RETURN
+#if 0
+
+            !  Possibly it is just that we have a generalized vertical coord, so we do not
+            !  have the values exactly.  Do a simple assignment to a close vertical level.
+
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  DO k = kts+1 , kte-1
+                     IF ( ( p(i,k,j) - 85000. )  * ( p(i,k+1,j) - 85000. ) .LE. 0.0 ) THEN
+                        k850(i,j) = k
+                     END IF
+                     IF ( ( p(i,k,j) - 70000. )  * ( p(i,k+1,j) - 70000. ) .LE. 0.0 ) THEN
+                        k700(i,j) = k
+                     END IF
+                     IF ( ( p(i,k,j) - 50000. )  * ( p(i,k+1,j) - 50000. ) .LE. 0.0 ) THEN
+                        k500(i,j) = k
+                     END IF
+                  END DO
+               END DO
+            END DO
+
+            !  If we *still* do not have the k levels, punt.  I mean, we did try.
+
+            OK = .TRUE.
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( ( k850(i,j) .EQ. 0 ) .OR. ( k700(i,j) .EQ. 0 ) .OR. ( k500(i,j) .EQ. 0 ) ) THEN
+                     OK = .FALSE.
+                     PRINT '(A)','(i,j) = ',i,j,'  Error in finding p level for 850, 700 or 500 hPa.'
+                     DO K = kts+1 , kte
+                        PRINT '(A,I3,A,F10.2,A)','K = ',k,'  PRESSURE = ',p(i,k,j),' Pa'
+                     END DO
+                     PRINT '(A)','Expected 850, 700, and 500 mb values, at least.'
+                  END IF
+               END DO
+            END DO
+            IF ( .NOT. OK ) THEN
+               CALL wrf_error_fatal ( 'wrong pressure levels' )
+            END IF
+#endif
+
+         !  We are here if the data is isobaric and we found the levels for 850, 700,
+         !  and 500 mb right off the bat.
+
+         ELSE
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  k850(i,j) = k850(its,jts)
+                  k700(i,j) = k700(its,jts)
+                  k500(i,j) = k500(its,jts)
+               END DO
+            END DO
+         END IF
+       
+         !  The 850 hPa level of geopotential height is called something special.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               ht(i,j) = height(i,k850(i,j),j)
+            END DO
+         END DO
+   
+         !  The variable ht is now -ter/ht(850 hPa).  The plot thickens.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               ht(i,j) = -ter(i,j) / ht(i,j)
+            END DO
+         END DO
+   
+         !  Make an isothermal assumption to get a first guess at the surface
+         !  pressure.  This is to tell us which levels to use for the lapse
+         !  rates in a bit.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               psfc(i,j) = pslv(i,j) * (pslv(i,j) / p(i,k850(i,j),j)) ** ht(i,j)
+            END DO
+         END DO
+   
+         !  Get a pressure more than pconst Pa above the surface - p1.  The
+         !  p1 is the top of the level that we will use for our lapse rate
+         !  computations.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF      ( ( psfc(i,j) - 95000. ) .GE. 0. ) THEN
+                  p1(i,j) = 85000.
+               ELSE IF ( ( psfc(i,j) - 70000. ) .GE. 0. ) THEN
+                  p1(i,j) = psfc(i,j) - pconst
+               ELSE
+                  p1(i,j) = 50000.
+               END IF
+            END DO
+         END DO
+   
+         !  Compute virtual temperatures for k850, k700, and k500 layers.  Now
+         !  you see why we wanted Q on pressure levels, it all is beginning   
+         !  to make sense.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               t850(i,j) = t(i,k850(i,j),j) * (1. + 0.608 * q(i,k850(i,j),j))
+               t700(i,j) = t(i,k700(i,j),j) * (1. + 0.608 * q(i,k700(i,j),j))
+               t500(i,j) = t(i,k500(i,j),j) * (1. + 0.608 * q(i,k500(i,j),j))
+            END DO
+         END DO
+   
+         !  Compute lapse rates between these three levels.  These are
+         !  environmental values for each (i,j).
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               gamma78(i,j) = ALOG(t850(i,j) / t700(i,j))  / ALOG (p(i,k850(i,j),j) / p(i,k700(i,j),j) )
+               gamma57(i,j) = ALOG(t700(i,j) / t500(i,j))  / ALOG (p(i,k700(i,j),j) / p(i,k500(i,j),j) )
+            END DO
+         END DO
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF      ( ( psfc(i,j) - 95000. ) .GE. 0. ) THEN
+                  t1(i,j) = t850(i,j)
+               ELSE IF ( ( psfc(i,j) - 85000. ) .GE. 0. ) THEN
+                  t1(i,j) = t700(i,j) * (p1(i,j) / (p(i,k700(i,j),j))) ** gamma78(i,j)
+               ELSE IF ( ( psfc(i,j) - 70000. ) .GE. 0.) THEN 
+                  t1(i,j) = t500(i,j) * (p1(i,j) / (p(i,k500(i,j),j))) ** gamma57(i,j)
+               ELSE
+                  t1(i,j) = t500(i,j)
+               ENDIF
+            END DO 
+         END DO 
+   
+         !  From our temperature way up in the air, we extrapolate down to
+         !  the sea level to get a guess at the sea level temperature.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tslv(i,j) = t1(i,j) * (pslv(i,j) / p1(i,j)) ** gammarg
+            END DO 
+         END DO 
+   
+         !  The new surface temperature is computed from the with new sea level 
+         !  temperature, just using the elevation and a lapse rate.  This lapse 
+         !  rate is -6.5 K/km.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tsfc(i,j) = tslv(i,j) - gamma * ter(i,j)
+            END DO 
+         END DO 
+   
+         !  A small correction to the sea-level temperature, in case it is too warm.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tfixed(i,j) = tc - 0.005 * (tsfc(i,j) - tc) ** 2
+            END DO 
+         END DO 
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               l1 = tslv(i,j) .LT. tc
+               l2 = tsfc(i,j) .LE. tc
+               l3 = .NOT. l1
+               IF      ( l2 .AND. l3 ) THEN
+                  tslv(i,j) = tc
+               ELSE IF ( ( .NOT. l2 ) .AND. l3 ) THEN
+                  tslv(i,j) = tfixed(i,j)
+               END IF
+            END DO
+         END DO
+   
+         !  Finally, we can get to the surface pressure.
+
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+            p1(i,j) = - ter(i,j) * g / ( rov2 * ( tsfc(i,j) + tslv(i,j) ) )
+            psfc(i,j) = pslv(i,j) * EXP ( p1(i,j) )
+            END DO
+         END DO
+
+      END IF
+
+      !  Surface pressure and sea-level pressure are the same at sea level.
+
+!     DO j = jts , MIN(jde-1,jte)
+!        DO i = its , MIN(ide-1,ite)
+!           IF ( ABS ( ter(i,j) )  .LT. 0.1 ) THEN
+!              psfc(i,j) = pslv(i,j)
+!           END IF
+!        END DO
+!     END DO
+
+   END SUBROUTINE sfcprs
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE sfcprs2(t, q, height, psfc_in, ter, avgsfct, p, &
+                      psfc, ez_method, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      !  Computes the surface pressure using the input height,
+      !  temperature and q (already computed from relative
+      !  humidity) on p surfaces.  Sea level pressure is used
+      !  to extrapolate a first guess.
+
+      IMPLICIT NONE
+
+!****MARS: beware, hardcoded !!!
+!      REAL , PARAMETER :: Rd = 192.
+      REAL, PARAMETER    :: Rd = 191.
+      REAL, PARAMETER    :: g = 3.72
+!****MARS
+
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte 
+      LOGICAL , INTENT ( IN ) :: ez_method
+
+      REAL , DIMENSION (ims:ime,kms:kme,jms:jme) , INTENT(IN ):: t, q, height, p
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(IN ):: psfc_in ,  ter, avgsfct 
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(OUT):: psfc
+      
+      INTEGER                     :: i
+      INTEGER                     :: j
+      INTEGER                     :: k
+
+      REAL :: tv_sfc_avg , tv_sfc , del_z
+
+      !  Compute the new surface pressure from the old surface pressure, and a
+      !  known change in elevation at the surface.
+
+
+!****MARS: as is done in MCD/pres0 with the MOLA topography :)
+
+        !!---------
+        !!  del_z = diff in surface topo, lo-res vs hi-res
+        !grid%em_ght_gc - grid%ht
+        !!---------
+        !!* em_ght_gc: surface geopotential height from the GCM 
+        !!* ht: hi-res altimetry
+        !  psfc = psfc_in * exp ( g del_z / (Rd Tv_sfc ) )
+        !!---------
+
+
+      IF ( ez_method ) THEN
+!!
+!!****MARS: 'ez_method' is 'we_have_tavgsfc', hard-coded as false
+!!
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tv_sfc_avg = avgsfct(i,j) * (1. + 0.608 * q(i,1,j))
+               del_z = height(i,1,j) - ter(i,j)
+               psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * tv_sfc_avg ) )
+            END DO
+         END DO
+      ELSE
+!!              
+!!****MARS .... here is what is done for Mars
+!!
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+!               tv_sfc = t(i,1,j) * (1. + 0.608 * q(i,1,j))
+!!****MARS: 0.608 >> nonsense on Mars 
+tv_sfc = t(i,1,j)
+!!****MARS .... changer pour t_1km - 7e couche GCM
+!!****MARS .... spiga et al. (2007)
+tv_sfc = t(i,8,j)
+               del_z = height(i,1,j) - ter(i,j)
+               psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * tv_sfc     ) )
+!****MARS
+!****MARS .... which temperature is used in the Laplace formula ?
+!!****MARS: hardcoded as 220K (t0)
+!!****MARS: pas une enorme influence
+!psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * 220 ) )
+
+               
+!	       !****MARS .... check of the altimetry differences
+!	       print *,del_z, tv_sfc
+
+            END DO
+         END DO
+print *, '1 km temperatures - max'         
+print *, MAXVAL(t(:,8,:))         
+      END IF
+
+   END SUBROUTINE sfcprs2
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+   SUBROUTINE constante3(field, field_custom, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      IMPLICIT NONE
+
+      REAL :: field_custom
+      REAL, DIMENSION (ims:ime,kms:kme,jms:jme), INTENT(INOUT):: field
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte
+
+
+!!****MARS: set the 3D field to a constant value
+field(:,:,:)=field_custom
+
+  END SUBROUTINE constante3
+!---------------------------------------------------------------------
+   SUBROUTINE constante2(field, field_custom, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      IMPLICIT NONE
+
+      REAL :: field_custom
+      REAL, DIMENSION (ims:ime,jms:jme), INTENT(INOUT):: field
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte
+
+
+!!****MARS: set the 3D field to a constant value
+field(:,:)=field_custom
+
+  END SUBROUTINE constante2
+!---------------------------------------------------------------------
+
+      subroutine build_sigma_hr(dimlevs,sigma_gcm,ps_gcm,ps_hr,sigma_hr) !,p_pgcm)
+
+      implicit none
+!      include "constants_mcd.inc"
+
+!---------------------------------------
+! written by E. Millour and F. Forget
+! Mars Climate Database v4.2
+! see DDD page 27 and following
+!---------------------------------------
+
+        INTEGER , INTENT(IN) :: dimlevs
+
+!     inputs
+      real sigma_gcm(dimlevs) ! GCM sigma levels
+      real ps_gcm             ! GCM surface pressure
+      real ps_hr              ! High res surface pressure
+!     outputs
+      real sigma_hr(dimlevs)  ! High res sigma levels
+!      real p_pgcm(dimlevs)    ! high res to GCM pressure ratios
+
+!     local variables
+      integer l
+      real x  ! lower layer compression (-0.9<x<0) or dilatation (0.<x<0.9)
+      real rp     ! surface pressure ratio ps_hr/ps_gcm
+      real deltaz   ! corresponding pseudo-altitude difference (km)
+      real f  ! coefficient f= p_hr / p_gcm
+      real z  ! altitude of transition of p_hr toward p_gcm (km)
+      real p_pgcm(dimlevs)    ! high res to GCM pressure ratios
+
+! 1. Coefficients
+      rp=ps_hr/ps_gcm
+      deltaz=-10.*log(rp)
+      x = min(max(0.12*(abs(deltaz)-1.),0.),0.8)
+      if(deltaz.gt.0) x=-x
+      z=max(deltaz + 3.,3.)
+
+      do l=1,dimlevs
+        f=rp*sigma_gcm(l)**x
+!        f=f+(1-f)*0.5*(1+tanh(6.*(-10.*log(sigma_gcm(l))-z)/z))
+!        sigma_hr(l)=f*sigma_gcm(l)/rp
+        p_pgcm(l)=f+(1-f)*0.5*(1+tanh(6.*(-10.*log(sigma_gcm(l))-z)/z))
+        sigma_hr(l)=p_pgcm(l)*sigma_gcm(l)/rp
+      enddo
+
+      end subroutine build_sigma_hr
+
+
+
+
+
+END MODULE module_initialize
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_real_method1_2interp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_real_method1_2interp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_real_method1_2interp.F	(revision 2744)
@@ -0,0 +1,5146 @@
+!REAL:MODEL_LAYER:INITIALIZATION
+
+#ifndef VERT_UNIT
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains, specifically for the Eulerian, mass-based coordinate.
+
+!-----------------------------------------------------------------------
+
+!****MARS: modified May 2007
+
+
+MODULE module_initialize
+
+   USE module_bc
+   USE module_configure
+   USE module_domain
+   USE module_io_domain
+   USE module_model_constants
+   USE module_state_description
+   USE module_timing
+   USE module_soil_pre
+   USE module_date_time
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+   REAL , SAVE :: p_top_save
+   INTEGER :: internal_time_loop
+
+CONTAINS
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain ( grid )
+
+      IMPLICIT NONE
+
+      !  Input space and data.  No gridded meteorological data has been stored, though.
+
+!     TYPE (domain), POINTER :: grid 
+      TYPE (domain)          :: grid 
+
+      !  Local data.
+
+      INTEGER :: dyn_opt 
+      INTEGER :: idum1, idum2
+
+      CALL nl_get_dyn_opt ( 1, dyn_opt )
+      
+      CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+      IF (      dyn_opt .eq. 1 &
+           .or. dyn_opt .eq. 2 &
+           .or. dyn_opt .eq. 3 &
+                                          ) THEN
+        CALL init_domain_rk( grid &
+!
+#include "em_actual_new_args.inc"
+!
+      )
+
+      ELSE
+         WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+         CALL wrf_error_fatal ( 'ERROR-dyn_opt-wrong-in-namelist' )
+      ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+#include "em_dummy_new_args.inc"
+!
+   )
+
+      USE module_optional_si_input
+      IMPLICIT NONE
+
+      !  Input space and data.  No gridded meteorological data has been stored, though.
+
+!     TYPE (domain), POINTER :: grid
+      TYPE (domain)          :: grid
+
+#include "em_dummy_new_decl.inc"
+
+      TYPE (grid_config_rec_type)              :: config_flags
+
+      !  Local domain indices and counters.
+
+      INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+      INTEGER :: loop , num_seaice_changes
+
+      INTEGER                             ::                       &
+                                     ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte, &
+                                     ips, ipe, jps, jpe, kps, kpe, &
+                                     i, j, k
+      INTEGER :: ns
+
+      !  Local data
+
+      INTEGER :: error
+      REAL    :: p_surf, p_level
+      REAL    :: cof1, cof2
+      REAL    :: qvf , qvf1 , qvf2 , pd_surf
+      REAL    :: p00 , t00 , a
+      REAL    :: hold_znw
+      LOGICAL :: were_bad
+
+      LOGICAL :: stretch_grid, dry_sounding, debug
+      INTEGER IICOUNT
+
+      REAL :: p_top_requested , temp
+      INTEGER :: num_metgrid_levels
+      REAL , DIMENSION(max_eta) :: eta_levels
+      REAL :: max_dz
+
+!      INTEGER , PARAMETER :: nl_max = 1000
+!      REAL , DIMENSION(nl_max) :: grid%em_dn
+
+integer::oops1,oops2
+
+      REAL    :: zap_close_levels
+      INTEGER :: force_sfc_in_vinterp
+      INTEGER :: interp_type , lagrange_order
+      LOGICAL :: lowest_lev_from_sfc
+      LOGICAL :: we_have_tavgsfc
+
+      INTEGER :: lev500 , loop_count
+      REAL    :: zl , zu , pl , pu , z500 , dz500 , tvsfc , dpmu
+
+!-- Carsel and Parrish [1988]
+        REAL , DIMENSION(100) :: lqmi
+
+
+!****MARS
+      INTEGER :: sizegcm, kold, knew,inew,jnew
+      REAL :: pa, indic, p1, p2, pn
+      REAL, ALLOCATABLE, DIMENSION (:,:,:) :: sig, ap, bp, box
+!****MARS
+
+
+#ifdef DM_PARALLEL
+#    include "em_data_calls.inc"
+#endif
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+            kds = grid%sd31 ; kde = grid%ed31 ;
+            ids = grid%sd32 ; ide = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            kms = grid%sm31 ; kme = grid%em31 ;
+            ims = grid%sm32 ; ime = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+            its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XYZ )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            jds = grid%sd32 ; jde = grid%ed32 ;
+            kds = grid%sd33 ; kde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            jms = grid%sm32 ; jme = grid%em32 ;
+            kms = grid%sm33 ; kme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+            kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XZY )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            kds = grid%sd32 ; kde = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            kms = grid%sm32 ; kme = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+      END SELECT
+
+      CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+      !  Check to see if the boundary conditions are set properly in the namelist file.
+      !  This checks for sufficiency and redundancy.
+
+      CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+      !  Some sort of "this is the first time" initialization.  Who knows.
+
+      grid%step_number = 0
+      grid%itimestep=0
+
+      !  Pull in the info in the namelist to compare it to the input data.
+
+      grid%real_data_init_type = model_config_rec%real_data_init_type
+   
+      !  To define the base state, we call a USER MODIFIED routine to set the three
+      !  necessary constants:  p00 (sea level pressure, Pa), t00 (sea level temperature, K), 
+      !  and A (temperature difference, from 1000 mb to 300 mb, K).
+   
+      CALL const_module_initialize ( p00 , t00 , a ) 
+
+#if 0
+!KLUDGE, this is for testing only
+if ( flag_metgrid .eq. 1 ) then
+read (20+grid%id) grid%em_ht_gc
+read (20+grid%id) grid%em_xlat_gc
+read (20+grid%id) grid%em_xlong_gc
+read (20+grid%id) msft
+read (20+grid%id) msfu
+read (20+grid%id) msfv
+read (20+grid%id) f
+read (20+grid%id) e
+read (20+grid%id) sina
+read (20+grid%id) cosa
+read (20+grid%id) grid%landmask
+read (20+grid%id) grid%landusef
+read (20+grid%id) grid%soilctop
+read (20+grid%id) grid%soilcbot
+read (20+grid%id) grid%vegcat
+read (20+grid%id) grid%soilcat
+read (20+grid%id) grid%em_albedo_gcm
+read (20+grid%id) grid%em_therm_inert
+else
+write (20+grid%id) grid%em_ht
+write (20+grid%id) grid%em_xlat
+write (20+grid%id) grid%em_xlong
+write (20+grid%id) msft
+write (20+grid%id) msfu
+write (20+grid%id) msfv
+write (20+grid%id) f
+write (20+grid%id) e
+write (20+grid%id) sina
+write (20+grid%id) cosa
+write (20+grid%id) grid%landmask
+write (20+grid%id) grid%landusef
+write (20+grid%id) grid%soilctop
+write (20+grid%id) grid%soilcbot
+write (20+grid%id) grid%vegcat
+write (20+grid%id) grid%soilcat
+write (20+grid%id) grid%em_albedo_gcm
+write (20+grid%id) grid%em_therm_inert
+endif
+#endif
+
+
+      !  Is there any vertical interpolation to do?  The "old" data comes in on the correct
+      !  vertical locations already.
+
+      IF ( flag_metgrid .EQ. 1 ) THEN  !   <----- START OF VERTICAL INTERPOLATION PART ---->
+
+         !  Variables that are named differently between SI and WPS.
+
+         DO j = jts, MIN(jte,jde-1)
+           DO i = its, MIN(ite,ide-1)
+!!****MARS: tsk is surface temperature           
+              grid%tsk(i,j) = grid%em_tsk_gc(i,j)
+              grid%tmn(i,j) = grid%em_tmn_gc(i,j)
+              grid%xlat(i,j) = grid%em_xlat_gc(i,j)
+              grid%xlong(i,j) = grid%em_xlong_gc(i,j)
+              grid%ht(i,j) = grid%em_ht_gc(i,j)
+!!****MARS
+!!un peu artificiel, mais u10 et v10 sont des bons intermediaires (facultatifs de plus)
+              grid%u10(i,j) = grid%em_albedo_gcm(i,j)
+              grid%v10(i,j) = grid%em_therm_inert(i,j)
+include "../custom_static.inc"
+!!****MARS
+           END DO
+         END DO
+
+
+!!****MARS
+!!
+!! case with idealized topography
+!!
+!!CALL ideal_topo ( grid%ht , 2000., 6., &
+!CALL ideal_topo ( grid%ht , 2000., 3., &
+!           ids , ide , jds , jde , kds , kde , &
+!           ims , ime , jms , jme , kms , kme , &
+!           its , ite , jts , jte , kts , kte )
+!!****MARS
+!****MARS
+!!
+!! idealized atmospheric state
+!!
+!!
+!! adjust_heights ne sert pas :)
+print *,config_flags%adjust_heights
+IF (config_flags%adjust_heights) THEN
+        print *, 'setting uniform values and profiles'
+        print *, 'u'
+        print *, grid%em_u_gc(its+1,:,jts+1)
+        print *, 'v'
+        print *, grid%em_v_gc(its+1,:,jts+1)
+        print *, 't'
+        print *, grid%em_t_gc(its+1,:,jts+1)
+        print *, 'p'
+        print *, grid%em_rh_gc(its+1,:,jts+1)
+        print *, 'geop'
+        print *, grid%em_ght_gc(its+1,:,jts+1)
+        print *, 'albedo'
+        print *, grid%u10(its+1,jts+1)
+        print *, 'thermal inertia'
+        print *, grid%v10(its+1,jts+1)
+        print *, 'topography'
+        print *, grid%ht(its+1,jts+1)
+        print *, 'toposoil'
+        print *, grid%toposoil(its+1,jts+1) 
+        print *, 'surface temperature'
+        print *, grid%tsk(its+1,jts+1)
+        print *, 'surface pressure'
+        print *, grid%psfc(its+1,jts+1)
+        print *, grid%em_psfc_gc(its+1,jts+1)
+
+        DO j = jts, MIN(jte,jde-1)
+          DO i = its, MIN(ite,ide-1)
+                grid%em_u_gc(i,:,j)=grid%em_u_gc(its+1,:,jts+1)
+                grid%em_v_gc(i,:,j)=grid%em_v_gc(its+1,:,jts+1)
+                grid%em_t_gc(i,:,j)=grid%em_t_gc(its+1,:,jts+1)
+                grid%em_rh_gc(i,:,j)=grid%em_rh_gc(its+1,:,jts+1)
+                grid%em_ght_gc(i,:,j) = grid%em_ght_gc(its+1,:,jts+1)
+                grid%u10(i,j) = grid%u10(its+1,jts+1)
+                grid%v10(i,j) = grid%v10(its+1,jts+1)
+                grid%ht(i,j) = grid%ht(its+1,jts+1)
+                grid%toposoil(i,j) = grid%toposoil(its+1,jts+1)
+                grid%tsk(i,j) = grid%tsk(its+1,jts+1)
+                grid%psfc(i,j) = grid%psfc(its+1,jts+1)
+                grid%em_psfc_gc(i,j) = grid%em_psfc_gc(its+1,jts+1)
+          ENDDO
+        ENDDO
+
+!!
+!!
+print *, 'u divided by 10'
+grid%em_u_gc=grid%em_u_gc/10.
+grid%em_v_gc=grid%em_v_gc/10.
+!!
+!!
+
+
+ENDIF
+!!
+!!
+!! idealized atmospheric state
+!!
+!****MARS
+
+
+!!!!caca caca
+!print *, 'u multiplied by 3'
+!grid%em_u_gc=grid%em_u_gc*3.
+!grid%em_v_gc=grid%em_v_gc*3.
+!!!!caca caca
+
+
+
+
+         !  If we have any input low-res surface pressure, we store it.
+
+!!****MARS
+!!fix pour être certain d'être avec les bons flag
+print *,flag_psfc
+print *,flag_soilhgt
+print *,flag_metgrid
+
+flag_psfc=1
+flag_soilhgt=1
+flag_metgrid=1
+!!**** TODO: trouver quand même pourquoi ça donne 0 :)
+pa=999999.
+!!****MARS
+
+         IF ( flag_psfc .EQ. 1 ) THEN
+            DO j = jts, MIN(jte,jde-1)
+              DO i = its, MIN(ite,ide-1)
+                 grid%em_psfc_gc(i,j) = grid%psfc(i,j)
+!!!****MARS: em_p_gc is only a way to count vertical levels in WPS :)
+!!!****MARS: is filled here with real pressure levels
+grid%em_p_gc(i,:,j) = grid%em_rh_gc(i,:,j)
+!!!****MARS
+                 grid%em_p_gc(i,1,j) = grid%psfc(i,j)
+!!!****MARS
+IF (pa .gt. grid%em_p_gc(i,1,j)) pa=grid%em_p_gc(i,1,j)
+!!!****MARS
+              END DO
+            END DO
+         END IF
+print *, 'found minimum pressure (Pa) :',pa
+
+
+!!!****MARS
+!!!****MARS
+!!! define new hybrid coordinate levels
+!!! with transition level between sigma and pressure
+!!! lower than input data
+
+
+        !--get vertical size of the GCM input array
+        sizegcm=SIZE(grid%em_rh_gc(1,:,1))
+        ALLOCATE(sig(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+        ALLOCATE(ap(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+        ALLOCATE(bp(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+        !ALLOCATE(box(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+
+
+
+        !--define sigma levels, 
+        !--then derive new sigma levels, and new pressure levels
+        DO j = jts, MIN(jte,jde-1)
+          DO i = its, MIN(ite,ide-1)
+
+                ! old sigma levels
+                sig(i,:,j)=grid%em_p_gc(i,:,j)/grid%em_psfc_gc(i,j)
+
+                ! new pressure levels
+                ! - pressure_new = ap_new + bp_new * ps_gcm
+                ! - bp_new is converging more rapidly than bp
+                !   ... while conserving the same structure near the surface
+                !
+                ! NB: grid%zap_close_levels ne sert pas dans vert_interp_old :)
+                ! NB: peut donc servir pour préciser une constante reelle
+                ! NB: qui permet de rehausser la zone de transition
+                !
+                bp(i,:,j)=sqrt(sqrt(exp(1.-1./(sig(i,:,j)**4))))
+                ap(i,:,j)=pa*exp(-grid%zap_close_levels/10.)*(sig(i,:,j)-bp(i,:,j))
+                grid%em_rh_gc(i,:,j)=ap(i,:,j)+bp(i,:,j)*grid%em_psfc_gc(i,j)
+
+                ! avoid extrapolation at the top 
+                ! -- the last level is thus unsignificant
+                grid%em_p_gc(i,sizegcm,j)=grid%em_p_gc(i,sizegcm,j)/100.
+!                grid%em_p_gc(i,sizegcm,j)=grid%em_p_gc(i,sizegcm,j)/10000.
+
+          ENDDO
+        ENDDO
+
+
+
+
+        !-- check that the biggest differences are higher
+        print *, 'sigma levels'
+        print *, sig(its+1,:,jts+1)
+        print *, 'old pressure levels'
+        print *, grid%em_p_gc(its+1,:,jts+1)
+        print *, 'new pressure levels'
+        print *, grid%em_rh_gc(its+1,:,jts+1)
+
+!print *, 't_gc', SIZE(grid%em_t_gc(1,:,1))
+!print *, 'p_gc', SIZE(grid%em_p_gc(1,:,1))
+!print *, 't_2', SIZE(grid%em_t_2(1,:,1))
+!print *, 'rh_gc', SIZE(grid%em_rh_gc(1,:,1))
+
+
+!--------
+!-- interpolate on the new pressure levels
+!--------
+
+        DO j = jts, MIN(jte,jde-1)
+          DO i = its, MIN(ite,ide-1)
+
+DO knew = 1,sizegcm     ! loop on each level of the new grid
+
+        DO kold = 1,sizegcm-1   ! find the two enclosing levels
+
+                ! indic becomes negative when the two levels are found
+                indic=(grid%em_p_gc(i,kold,j)-grid%em_rh_gc(i,knew,j))&
+                        *(grid%em_p_gc(i,kold+1,j)-grid%em_rh_gc(i,knew,j))
+
+                ! 1. the two levels are found - define p1,p2,pn and exit the loop
+                IF (indic < 0.) THEN 
+                        !IF ((i == its) .AND. (j == jts)) THEN   !just a check
+                        !        print *, 'new level', grid%em_rh_gc(i,knew,j)
+                        !        print *, 'interp levels', grid%em_p_gc(i,kold,j), &
+                        !                grid%em_p_gc(i,kold+1,j)
+                        !ENDIF
+                p1 = ALOG(grid%em_p_gc(i,kold,j))
+                p2 = ALOG(grid%em_p_gc(i,kold+1,j))
+                pn = ALOG(grid%em_rh_gc(i,knew,j))
+                EXIT
+
+                ! 2. must handle the case (usually close to the surface) 
+                ! of similar new/old levels - then exit with the right kold value
+                ELSE IF (1-abs(grid%em_rh_gc(i,knew,j)/grid%em_p_gc(i,kold,j)) .lt. 1e-8) THEN
+                        !print *,grid%em_p_gc(i,kold,j),grid%em_rh_gc(i,knew,j)  
+                EXIT
+                ELSE IF (1-abs(grid%em_rh_gc(i,knew,j)/grid%em_p_gc(i,kold+1,j)) .lt. 1e-8) THEN
+                        !print *,grid%em_p_gc(i,kold+1,j),grid%em_rh_gc(i,knew,j)
+                        kold=kold+1
+                EXIT
+
+                ! 3. continue looping if the two levels are not found ....
+                ENDIF 
+        ENDDO
+
+        ! this is an initialization, useful for case 2 (and erased just below if case 1)
+        grid%em_t_2(i,knew,j)= grid%em_t_gc(i,kold,j)
+        grid%em_u_2(i,knew,j)= grid%em_u_gc(i,kold,j)
+        grid%em_v_2(i,knew,j)= grid%em_v_gc(i,kold,j)
+
+        ! case 1: OK, in the previous loop, the two levels were found, and stored in p1 and p2
+        ! ... thus interpolation can be performed
+        IF (indic < 0.) THEN
+        grid%em_t_2(i,knew,j)= ( grid%em_t_gc(i,kold,j) * ( p2 - pn )   + &
+                                 grid%em_t_gc(i,kold+1,j) * ( pn - p1 ) ) / &
+                                 ( p2 - p1 )
+        grid%em_u_2(i,knew,j)= ( grid%em_u_gc(i,kold,j) * ( p2 - pn )   + &
+                                 grid%em_u_gc(i,kold+1,j) * ( pn - p1 ) ) / &
+                                 ( p2 - p1 )
+        grid%em_v_2(i,knew,j)= ( grid%em_v_gc(i,kold,j) * ( p2 - pn )   + &
+                                 grid%em_v_gc(i,kold+1,j) * ( pn - p1 ) ) / &
+                                 ( p2 - p1 )
+        ENDIF
+
+
+ENDDO
+
+          ENDDO
+        ENDDO
+grid%em_u_2(MIN(ite,ide-1)+1,:,:)=grid%em_u_2(MIN(ite,ide-1),:,:)
+grid%em_v_2(:,:,MIN(jte,jde-1)+1)=grid%em_v_2(:,:,MIN(jte,jde-1))
+!--------
+!-- end - interpolate on the new pressure levels
+!--------
+
+! then replace the GCM fields with the newly calculated fields
+        grid%em_t_gc=grid%em_t_2(:,1:sizegcm,:)
+        grid%em_t_2(:,:,:)=0.
+        grid%em_u_gc=grid%em_u_2(:,1:sizegcm,:)
+        grid%em_u_2(:,:,:)=0.
+        grid%em_v_gc=grid%em_v_2(:,1:sizegcm,:)
+        grid%em_v_2(:,:,:)=0.
+        grid%em_p_gc=grid%em_rh_gc(:,1:sizegcm,:)
+        grid%em_rh_gc(:,:,:)=0.
+
+
+
+
+!        !-- interpolate on the new pressure levels
+!        CALL vert_interp_old ( grid%em_t_gc , &         ! --- interpolate this field
+!                               grid%em_p_gc, &          ! --- with coordinates
+!                               grid%em_t_2, &           ! --- to obtain the new field
+!                               grid%em_rh_gc, &         ! --- on coordinates
+!                               sizegcm, &
+!                               'T', &           ! --- no staggering (will be done later)
+!                               2, &             ! --- log p interpolation   
+!                               1, &             ! --- (0) lagrange_order
+!                               .false., &       ! --- (0) lowest_lev_from_sfc
+!                               0., &            ! --- (0) zap_close_levels
+!                               0, &             ! --- (0) force_sfc_in_vinterp
+!                               ids , ide , jds , jde , kds , kde , &
+!                               ims , ime , jms , jme , kms , kme , &
+!                               its , ite , jts , jte , kts , kte )
+!        CALL vert_interp_old ( grid%em_u_gc , &         ! --- interpolate this field
+!                               grid%em_p_gc, &          ! --- with coordinates
+!                               grid%em_u_2 , &          ! --- to obtain the new field
+!                               grid%em_rh_gc, &         ! --- on coordinates
+!                               sizegcm, &
+!                               'U', &           ! --- no staggering (will be done later)
+!                               2, &             ! --- log p interpolation
+!                               1, &             ! --- (0) lagrange_order
+!                               .false., &       ! --- (0) lowest_lev_from_sfc
+!                               0., &            ! --- (0) zap_close_levels
+!                               0, &             ! --- (0) force_sfc_in_vinterp
+!                               ids , ide , jds , jde , kds , kde , &
+!                               ims , ime , jms , jme , kms , kme , &
+!                               its , ite , jts , jte , kts , kte )
+!        CALL vert_interp_old ( grid%em_v_gc , &         ! --- interpolate this field
+!                               grid%em_p_gc, &          ! --- with coordinates
+!                               grid%em_v_2 , &          ! --- to obtain the new field
+!                               grid%em_rh_gc, &         ! --- on coordinates
+!                               sizegcm, &
+!                               'V', &           ! --- no staggering (will be done later)
+!                               2, &             ! --- log p interpolation
+!                               1, &             ! --- (0) lagrange_order
+!                               .false., &       ! --- (0) lowest_lev_from_sfc
+!                               0., &            ! --- (0) zap_close_levels
+!                               0, &             ! --- (0) force_sfc_in_vinterp
+!                               !ids , ide , jds , jde , kds , sizegcm , &
+!                               !ims , ime , jms , jme , kms , sizegcm , &
+!                               !its , ite , jts , jte , kts , sizegcm )
+!                               ids , ide , jds , jde , kds , kde , &
+!                               ims , ime , jms , jme , kms , kme , &
+!                               its , ite , jts , jte , kts , kte )
+!
+!
+!        !-- save the new field and the new pressure coordinates
+!        !-- these will be regarded now as the inputs from the GCM
+!        grid%em_t_gc=grid%em_t_2
+!        grid%em_t_2(:,:,:)=0.
+!        grid%em_u_gc=grid%em_u_2
+!        grid%em_u_2(:,:,:)=0.
+!        grid%em_v_gc=grid%em_v_2
+!        grid%em_v_2(:,:,:)=0.
+!        grid%em_p_gc=grid%em_rh_gc      
+!        grid%em_rh_gc(:,:,:)=0.
+!!!!****MARS
+!!!****MARS
+
+
+
+
+         !  If we have the low-resolution surface elevation, stick that in the
+         !  "input" locations of the 3d height.  We still have the "hi-res" topo
+         !  stuck in the grid%em_ht array.  The grid%landmask if test is required as some sources
+         !  have ZERO elevation over water (thank you very much).
+
+         IF ( flag_soilhgt .EQ. 1) THEN
+            DO j = jts, MIN(jte,jde-1)
+               DO i = its, MIN(ite,ide-1)
+                  IF ( grid%landmask(i,j) .GT. 0.5 ) THEN
+                     grid%em_ght_gc(i,1,j) = grid%toposoil(i,j)
+                     grid%em_ht_gc(i,j)= grid%toposoil(i,j)
+                  END IF
+               END DO
+           END DO
+         END IF
+
+         !  Assign surface fields with original input values.  If this is hybrid data, 
+         !  the values are not exactly representative.  However - this is only for
+         !  plotting purposes and such at the 0h of the forecast, so we are not all that
+         !  worried.
+
+!****MARS
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide,ite)
+!               grid%u10(i,j)=grid%em_u_gc(i,1,j)
+!            END DO
+!         END DO
+!   
+!         DO j = jts, min(jde,jte)
+!            DO i = its, min(ide-1,ite)
+!               grid%v10(i,j)=grid%em_v_gc(i,1,j)
+!            END DO
+!         END DO
+!****MARS   
+
+         DO j = jts, min(jde-1,jte)
+            DO i = its, min(ide-1,ite)
+               grid%t2(i,j)=grid%em_t_gc(i,1,j)
+            END DO
+         END DO
+
+         IF ( flag_qv .EQ. 1 ) THEN
+            DO j = jts, min(jde-1,jte)
+               DO i = its, min(ide-1,ite)
+                  grid%q2(i,j)=grid%em_qv_gc(i,1,j)
+               END DO
+            END DO
+         END IF
+   
+         !  The number of vertical levels in the input data.  There is no staggering for
+         !  different variables.
+   
+         num_metgrid_levels = grid%num_metgrid_levels
+
+         !  The requested ptop for real data cases.
+
+         p_top_requested = grid%p_top_requested
+
+         !  Compute the top pressure, grid%p_top.  For isobaric data, this is just the
+         !  top level.  For the generalized vertical coordinate data, we find the
+         !  max pressure on the top level.  We have to be careful of two things:
+         !  1) the value has to be communicated, 2) the value can not increase
+         !  at subsequent times from the initial value.
+
+         IF ( internal_time_loop .EQ. 1 ) THEN
+
+                CALL find_p_top ( grid%em_p_gc , grid%p_top , &
+                              ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                              ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                              its , ite , jts , jte , 1   , num_metgrid_levels )
+
+!! ^---- equivalent to:
+!!grid%ptop=MINVAL(grid%em_p_gc(:,:,:))
+
+
+
+!!!!obsolete
+!print *,'ptop GCM',grid%em_rh_gc(2,1,2)
+!IF (grid%em_rh_gc(2,1,2) == 0) THEN
+!        print *,'ptop cannot be 0' 
+!        stop        
+!ENDIF  
+!grid%p_top=grid%em_rh_gc(2,1,2)
+!!!!obsolete
+
+
+#ifdef DM_PARALLEL
+            grid%p_top = wrf_dm_max_real ( grid%p_top )
+#endif
+
+            !  Compare the requested grid%p_top with the value available from the input data.
+
+               print *,'p_top_requested = ',p_top_requested
+               print *,'allowable grid%p_top in data   = ',grid%p_top
+            IF ( p_top_requested .LT. grid%p_top ) THEN   
+               CALL wrf_error_fatal ( 'p_top_requested < grid%p_top possible from data' )
+            END IF
+
+            !  The grid%p_top valus is the max of what is available from the data and the
+            !  requested value.  We have already compared <, so grid%p_top is directly set to
+            !  the value in the namelist.
+
+            grid%p_top = p_top_requested
+
+            !  For subsequent times, we have to remember what the grid%p_top for the first
+            !  time was.  Why?  If we have a generalized vert coordinate, the grid%p_top value
+            !  could fluctuate.
+
+            p_top_save = grid%p_top
+
+         ELSE
+            CALL find_p_top ( grid%em_p_gc , grid%p_top , &
+                              ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                              ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                              its , ite , jts , jte , 1   , num_metgrid_levels )
+
+#ifdef DM_PARALLEL
+            grid%p_top = wrf_dm_max_real ( grid%p_top )
+#endif
+            IF ( grid%p_top .GT. p_top_save ) THEN
+               print *,'grid%p_top from last time period = ',p_top_save
+               print *,'grid%p_top from this time period = ',grid%p_top
+               CALL wrf_error_fatal ( 'grid%p_top > previous value' )
+            END IF
+            grid%p_top = p_top_save
+         ENDIF
+
+
+!****MARS
+!****MARS
+print *,'ptop GCM', grid%p_top
+print *,'sample: pressure at its jts'
+print *,grid%em_p_gc(its,:,jts)
+!****MARS
+!****MARS
+
+  
+
+!****MARS: useless 
+!****MARS: 
+!         !  Get the monthly values interpolated to the current date for the traditional monthly
+!         !  fields of green-ness fraction and background albedo.
+!   
+!         CALL monthly_interp_to_date ( grid%em_greenfrac , current_date , grid%vegfra , &
+!                                       ids , ide , jds , jde , kds , kde , &
+!                                       ims , ime , jms , jme , kms , kme , &
+!                                       its , ite , jts , jte , kts , kte )
+!  
+!         CALL monthly_interp_to_date ( grid%em_albedo12m , current_date , grid%albbck , &
+!                                       ids , ide , jds , jde , kds , kde , &
+!                                       ims , ime , jms , jme , kms , kme , &
+!                                       its , ite , jts , jte , kts , kte )
+!   
+!         !  Get the min/max of each i,j for the monthly green-ness fraction.
+!   
+!         CALL monthly_min_max ( grid%em_greenfrac , grid%shdmin , grid%shdmax , &
+!                                ids , ide , jds , jde , kds , kde , &
+!                                ims , ime , jms , jme , kms , kme , &
+!                                its , ite , jts , jte , kts , kte )
+!
+!          !  The model expects the green-ness values in percent, not fraction.
+!
+!         DO j = jts, MIN(jte,jde-1)
+!           DO i = its, MIN(ite,ide-1)
+!              grid%vegfra(i,j) = grid%vegfra(i,j) * 100.
+!              grid%shdmax(i,j) = grid%shdmax(i,j) * 100.
+!              grid%shdmin(i,j) = grid%shdmin(i,j) * 100.
+!           END DO
+!         END DO
+!
+!         !  The model expects the albedo fields as a fraction, not a percent.  Set the
+!         !  water values to 8%.
+!
+!         DO j = jts, MIN(jte,jde-1)
+!           DO i = its, MIN(ite,ide-1)   
+!		grid%albbck(i,j) = grid%albbck(i,j) / 100.
+!              grid%snoalb(i,j) = grid%snoalb(i,j) / 100.
+!              IF ( grid%landmask(i,j) .LT. 0.5 ) THEN
+!                 grid%albbck(i,j) = 0.08
+!                 grid%snoalb(i,j) = 0.08
+!              END IF
+!           END DO
+!         END DO
+!!****MARS:
+!!****MARS: useless 
+
+
+ 
+
+!!****MARS:  
+!         !  Compute the mixing ratio from the input relative humidity.
+!   
+!         IF ( flag_qv .NE. 1 ) THEN
+!            CALL rh_to_mxrat (grid%em_rh_gc, grid%em_t_gc, grid%em_p_gc, grid%em_qv_gc , .TRUE. , &
+!                              ids , ide , jds , jde , 1   , num_metgrid_levels , &
+!                              ims , ime , jms , jme , 1   , num_metgrid_levels , &
+!                              its , ite , jts , jte , 1   , num_metgrid_levels )
+!         END IF
+!!****MARS:
+!!grid%em_rh_gc are GCM equivalent eta_levels
+!!****MARS
+
+
+
+
+         !  Two ways to get the surface pressure.  1) If we have the low-res input surface
+         !  pressure and the low-res topography, then we can do a simple hydrostatic
+         !  relation.  2) Otherwise we compute the surface pressure from the sea-level
+         !  pressure.
+         !  Note that on output, grid%em_psfc is now hi-res.  The low-res surface pressure and 
+         !  elevation are grid%em_psfc_gc and grid%em_ht_gc (same as grid%em_ght_gc(k=1)).
+
+!!****MARS: switch off this option 
+!!****MARS: --> cf sfcprs2 and geopotential function at 500mb
+!         IF ( config_flags%adjust_heights ) THEN
+!            we_have_tavgsfc = ( flag_tavgsfc == 1 ) 
+!         ELSE
+!            we_have_tavgsfc = .FALSE.
+!         END IF
+!****MARS:
+we_have_tavgsfc = .FALSE.
+
+
+
+!****MARS: hi-res psfc is done if the flag 'sfcp_to_sfcp' is active (recommended)
+         IF ( ( flag_psfc .EQ. 1 ) .AND. ( flag_soilhgt .EQ. 1 ) .AND. &
+              ( config_flags%sfcp_to_sfcp ) ) THEN
+            print *,'compute psfc from hi-res topography'
+            CALL sfcprs2(grid%em_t_gc, grid%em_qv_gc, grid%em_ght_gc, grid%em_psfc_gc, grid%ht, &
+                         grid%em_tavgsfc, grid%em_p_gc, grid%psfc, we_have_tavgsfc, &
+                         ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                         ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                         its , ite , jts , jte , 1   , num_metgrid_levels )
+                         !****MARS: here, in reality, grid%em_p_gc is not used
+
+!****MARS: no sea-level pressure inputs possible
+!         ELSE
+!            CALL sfcprs (grid%em_t_gc, grid%em_qv_gc, grid%em_ght_gc, grid%em_pslv_gc, grid%ht, &
+!                         grid%em_tavgsfc, grid%em_p_gc, grid%psfc, we_have_tavgsfc, &
+!                         ids , ide , jds , jde , 1   , num_metgrid_levels , &
+!                         ims , ime , jms , jme , 1   , num_metgrid_levels , &
+!                         its , ite , jts , jte , 1   , num_metgrid_levels )
+!****MARS: no sea-level pressure inputs possible
+
+ 
+            !  If we have no input surface pressure, we'd better stick something in there.
+
+            IF ( flag_psfc .NE. 1 ) THEN
+               DO j = jts, MIN(jte,jde-1)
+                 DO i = its, MIN(ite,ide-1)
+                    grid%em_psfc_gc(i,j) = grid%psfc(i,j)
+                    grid%em_p_gc(i,1,j) = grid%psfc(i,j)
+                 END DO
+               END DO
+            END IF
+
+         END IF
+
+
+!!!****MARS: 
+!!!****MARS: old stuff
+!!! grid%em_p_gc is needed ... so it is computed from eta_gcm
+!
+!print *,'computing pressure levels for input data...'
+!
+!        !! pressure is computed from eta_gcm and hi-res topography
+!        DO j = jts, MIN(jte,jde-1)
+!        DO i = its, MIN(ite,ide-1)  
+!!!psfc ou em_psfc_gc ? em_psfc_gc, sinon c'est faux et déclenche instabilités 
+!grid%em_p_gc(i,:,j)=grid%em_rh_gc(i,:,j)*(grid%em_psfc_gc(i,j)-grid%em_rh_gc(2,1,2))+grid%em_rh_gc(2,1,2)
+!grid%em_p_gc(i,1,j)=grid%em_psfc_gc(i,j)
+!
+!
+!        END DO
+!        END DO
+!!
+!!****MARS: 
+
+
+
+         !!  Integrate the mixing ratio to get the vapor pressure.
+         !
+         !CALL integ_moist ( grid%em_qv_gc , grid%em_p_gc , grid%em_pd_gc , grid%em_t_gc , grid%em_ght_gc , grid%em_intq_gc , &
+         !                   ids , ide , jds , jde , 1   , num_metgrid_levels , &
+         !                   ims , ime , jms , jme , 1   , num_metgrid_levels , &
+         !                   its , ite , jts , jte , 1   , num_metgrid_levels )
+
+
+!!****MARS
+!!****MARS
+!! and now, convert the GCM sigma levels into WRF sigma levels using hi-res surface pressure 
+DO j = jts , MIN ( jde-1 , jte )
+DO i = its , MIN (ide-1 , ite )
+
+   grid%em_pd_gc(i,:,j)=ap(i,:,j)+bp(i,:,j)*grid%psfc(i,j)
+
+END DO
+END DO
+!!****MARS
+!grid%em_pd_gc=grid%em_p_gc
+!!****MARS
+
+
+
+   
+         !!  Compute the difference between the dry, total surface pressure (input) and the 
+         !!  dry top pressure (constant).
+         !
+         !CALL p_dts ( grid%em_mu0 , grid%em_intq_gc , grid%psfc , grid%p_top , &
+         !             ids , ide , jds , jde , 1   , num_metgrid_levels , &
+         !             ims , ime , jms , jme , 1   , num_metgrid_levels , &
+         !             its , ite , jts , jte , 1   , num_metgrid_levels )
+
+!!****MARS
+DO j = jts , MIN ( jde-1 , jte )
+DO i = its , MIN (ide-1 , ite )
+
+   grid%em_mu0(i,j) = grid%psfc(i,j) - grid%p_top
+
+END DO
+END DO
+!!****MARS
+
+   
+         !!  Compute the dry, hydrostatic surface pressure.
+         !
+         !CALL p_dhs ( grid%em_pdhs , grid%ht , p00 , t00 , a , &
+         !             ids , ide , jds , jde , kds , kde , &
+         !             ims , ime , jms , jme , kms , kme , &
+         !             its , ite , jts , jte , kts , kte )
+!!****MARS: voir remarques dans la routine
+!!****MARS: dry hydrostatic pressure comes from the GCM ...
+!        DO j = jts , MIN ( jde-1 , jte )
+!        DO i = its , MIN (ide-1 , ite )
+!              grid%em_pdhs(i,j) = grid%psfc(i,j)
+!        END DO
+!      	 END DO
+!!****MARS: em_pdhs ne sert qu'ici !         
+
+   
+         !  Compute the eta levels if not defined already.
+
+!!TODO: pb when ptop<1Pa
+         
+         IF ( grid%em_znw(1) .NE. 1.0 ) THEN
+   
+            eta_levels(1:kde) = model_config_rec%eta_levels(1:kde)
+            max_dz            = model_config_rec%max_dz
+
+!!****MARS
+IF (grid%force_sfc_in_vinterp == 0) grid%force_sfc_in_vinterp = 8
+!!default choice
+!!****MARS
+
+            CALL compute_eta ( grid%em_znw , &
+                               eta_levels , max_eta , max_dz , &
+grid%force_sfc_in_vinterp, &    !!ne sert pas par ailleurs
+                               grid%p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0 , &
+                               ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte )
+         END IF
+   
+         !  The input field is temperature, we want potential temp.
+!****MARS: here em_p_gc is really needed ! 
+         CALL t_to_theta ( grid%em_t_gc , grid%em_p_gc , p00 , &
+                           ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                           ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                           its , ite , jts , jte , 1   , num_metgrid_levels )
+   
+
+
+         !  On the eta surfaces, compute the dry pressure = mu eta, stored in 
+         !  grid%em_pb, since it is a pressure, and we don't need another kms:kme 3d
+         !  array floating around.  The grid%em_pb array is re-computed as the base pressure
+         !  later after the vertical interpolations are complete.
+         CALL p_dry ( grid%em_mu0 , grid%em_znw , grid%p_top , grid%em_pb , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+!****MARS
+!****MARS: old stuff
+!****MARS
+!!! and now eta levels from the GCM are computed with the WRF ptop and GCM psfc
+!!! and em_pb is filled with WRF eta levels to prepare interpolation
+!print *,'computing eta levels for input data...'
+!        DO j = jts, MIN(jte,jde-1)
+!        DO i = its, MIN(ite,ide-1)
+!
+!!grid%em_psfc_gc: pb en haut!!!!
+!!!!valeurs plus grandes que 1 et extrapolation
+!!grid%em_p_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%psfc(i,j)-grid%p_top)
+!!!!utile si l'on est proche de la surface, mais pb plus haut !
+!grid%em_p_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%em_psfc_gc(i,j)-grid%p_top)
+!grid%em_pb(i,:,j)=grid%em_znw(:)
+!
+!!
+!!!!manage negative values
+!!DO k=1,num_metgrid_levels
+!!        grid%em_p_gc(i,k,j)=MAX(0.,grid%em_p_gc(i,k,j))
+!!END DO
+!!
+!
+!        END DO
+!        END DO
+!!
+!!print *,'sample: eta GCM at its jts'
+!!print *,grid%em_p_gc(its,:,jts)
+!!print *,'sample: eta WRF at its jts'
+!!print *,grid%em_pb(its,:,jts)
+!!
+!!print *,grid%em_p_gc(:,2,:)
+!!print *, 'yeah yeah'
+!!grid%em_pd_gc(:,:,:)=grid%em_p_gc(:,:,:)
+!!
+!****MARS
+!****MARS: old stuff
+!****MARS
+
+
+
+
+         !  All of the vertical interpolations are done in dry-pressure space.  The
+         !  input data has had the moisture removed (grid%em_pd_gc).  The target levels (grid%em_pb)
+         !  had the vapor pressure removed from the surface pressure, then they were
+         !  scaled by the eta levels.
+
+         interp_type = grid%interp_type
+         lagrange_order = grid%lagrange_order
+         lowest_lev_from_sfc = grid%lowest_lev_from_sfc
+         zap_close_levels = grid%zap_close_levels
+         force_sfc_in_vinterp = grid%force_sfc_in_vinterp
+
+         !!****MARS: normalement c'est vert_interp
+         !!****MARS: mais les résultats sont trop discontinus > retour à une
+         !!****MARS: interpolation plus classique
+         CALL vert_interp_old ( grid%em_qv_gc , grid%em_pd_gc , moist(:,:,:,P_QV) , grid%em_pb , &
+                            num_metgrid_levels , 'Q' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+ 
+         !!****MARS: normalement c'est vert_interp
+         CALL vert_interp_old ( grid%em_t_gc , grid%em_pd_gc , grid%em_t_2               , grid%em_pb , &
+                            num_metgrid_levels , 'T' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+
+#if 0
+         !  Uncomment the Registry entries to activate these.  This adds
+         !  noticeably to the allocated space for the model.
+ 
+         IF ( flag_qr .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QR ) THEN
+                  CALL vert_interp_old ( qr_gc , grid%em_pd_gc , moist(:,:,:,P_QR) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+    
+         IF ( flag_qc .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QC ) THEN
+                  CALL vert_interp_old ( qc_gc , grid%em_pd_gc , moist(:,:,:,P_QC) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+   
+         IF ( flag_qi .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QI ) THEN
+                  CALL vert_interp_old ( qi_gc , grid%em_pd_gc , moist(:,:,:,P_QI) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+   
+         IF ( flag_qs .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QS ) THEN
+                  CALL vert_interp_old ( qs_gc , grid%em_pd_gc , moist(:,:,:,P_QS) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+   
+         IF ( flag_qg .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QG ) THEN
+                  CALL vert_interp_old ( qg_gc , grid%em_pd_gc , moist(:,:,:,P_QG) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+#endif
+   
+#ifdef DM_PARALLEL
+         ips = its ; ipe = ite ; jps = jts ; jpe = jte ; kps = kts ; kpe = kte
+
+         !  For the U and V vertical interpolation, we need the pressure defined
+         !  at both the locations for the horizontal momentum, which we get by
+         !  averaging two pressure values (i and i-1 for U, j and j-1 for V).  The
+         !  pressure field on input (grid%em_pd_gc) and the pressure of the new coordinate
+         !  (grid%em_pb) are both communicated with an 8 stencil.
+
+#   include "HALO_EM_VINTERP_UV_1.inc"
+#endif
+
+        !!****MARS: normalement c'est vert_interp
+        CALL vert_interp_old ( grid%em_u_gc , grid%em_pd_gc , grid%em_u_2, grid%em_pb , &
+                            num_metgrid_levels , 'U' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+        !!****MARS: normalement c'est vert_interp   
+        CALL vert_interp_old ( grid%em_v_gc , grid%em_pd_gc , grid%em_v_2, grid%em_pb , &
+                        num_metgrid_levels , 'V' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+
+!!****MARS
+!!****MARS
+!!
+!! old obsolete method
+!! -------------------
+!!
+!!! and now eta levels from the GCM are computed with the WRF ptop and GCM psfc
+!!! and em_pb is filled with WRF eta levels to prepare interpolation
+!print *,'computing eta levels for input data...'
+!
+!        DO j = jts, MIN(jte,jde-1)
+!        DO i = its, MIN(ite,ide-1)
+!
+!!       grid%em_psfc_gc: pb en haut!!!!
+!!!!valeurs plus grandes que 1 et extrapolation
+!!       grid%em_p_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%psfc(i,j)-grid%p_top)
+!!!!utile si l'on est proche de la surface, mais pb plus haut !
+!grid%em_pd_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%em_psfc_gc(i,j)-grid%p_top)
+!grid%em_pb(i,:,j)=grid%em_znw(:)
+!
+!!
+!!!!manage negative values
+!!DO k=1,num_metgrid_levels
+!!        grid%em_p_gc(i,k,j)=MAX(0.,grid%em_p_gc(i,k,j))
+!!END DO
+!!
+!
+!        END DO
+!        END DO
+!
+!print *,'sample: eta GCM at its jts'
+!print *,grid%em_pd_gc(its,:,jts)
+!print *,'sample: eta WRF at its jts'
+!print *,grid%em_pb(its,:,jts)
+!!
+!!!****MARS
+!
+!
+!
+!!!!****MARS
+!!!!
+!!!!grid%force_sfc_in_vinterp ne sert pas dans vert_interp_old :)
+!!!!peut donc servir pour préciser le nombre de niveaux
+!!!!pris à partir de l'interpolation eta
+!
+!IF (grid%force_sfc_in_vinterp .NE. 0) THEN
+!
+!         !!!save in an array that is now unused
+!         !!!the previously performed pressure interpolation
+!         grid%em_qv_gc(:,:,:)=grid%em_t_2(:,:,:)
+!
+!
+!         !!!perform interpolation on eta levels
+!         print *, 'interpolate on eta levels for near-surface fields' 
+!         CALL vert_interp_old ( grid%em_t_gc , grid%em_pd_gc , grid%em_t_2, grid%em_pb , &
+!                            num_metgrid_levels , 'T' , &
+!                            interp_type , lagrange_order , lowest_lev_from_sfc ,&
+!                            zap_close_levels , force_sfc_in_vinterp , &
+!                            ids , ide , jds , jde , kds , kde , &
+!                            ims , ime , jms , jme , kms , kme , &
+!                            its , ite , jts , jte , kts , kte )
+!
+!         !!!take the first layers from the eta interpolation
+!         print *, 'the first ', &
+!                grid%force_sfc_in_vinterp, &
+!                'layers will be taken from eta interpolation'
+!         grid%em_qv_gc(:,1:grid%force_sfc_in_vinterp,:)=grid%em_t_2(:,1:grid%force_sfc_in_vinterp,:)
+!
+!         !!!fix the possible little discontinuity at the limit
+!         !!!between the two interpolation methods
+!         grid%em_qv_gc(:,grid%force_sfc_in_vinterp+1,:)=  &
+!                0.5*(grid%em_t_2(:,grid%force_sfc_in_vinterp,:) + &     !!eta interpolation below
+!                        grid%em_qv_gc(:,grid%force_sfc_in_vinterp+2,:))  !!pressure interpolation above
+!         
+!
+!         !!!assign the final result in t_2
+!         grid%em_t_2(:,:,:)=grid%em_qv_gc(:,:,:)
+!         grid%em_qv_gc(:,:,:)=0.
+!
+!
+!ELSE
+!
+!
+!ENDIF
+!!****MARS
+!!****MARS
+
+
+      END IF     !   <----- END OF VERTICAL INTERPOLATION PART ---->
+
+
+
+!****MARS: no need
+!      !  Protect against bad grid%em_tsk values over water by supplying grid%sst (if it is 
+!      !  available, and if the grid%sst is reasonable).
+!
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+!                 ( grid%sst(i,j) .GT. 200. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+!               grid%tsk(i,j) = grid%sst(i,j)
+!            ENDIF            
+!         END DO
+!      END DO
+!
+!      !  Save the grid%em_tsk field for later use in the sea ice surface temperature
+!      !  for the Noah LSM scheme.
+!
+!       DO j = jts, MIN(jte,jde-1)
+!         DO i = its, MIN(ite,ide-1)
+!            grid%tsk_save(i,j) = grid%tsk(i,j)
+!         END DO
+!      END DO
+!
+!!****MARS: no need
+!      !  Take the data from the input file and store it in the variables that
+!      !  use the WRF naming and ordering conventions.
+!
+!       DO j = jts, MIN(jte,jde-1)
+!         DO i = its, MIN(ite,ide-1)
+!            IF ( grid%snow(i,j) .GE. 10. ) then
+!               grid%snowc(i,j) = 1.
+!            ELSE
+!               grid%snowc(i,j) = 0.0
+!            END IF
+!         END DO
+!      END DO
+!
+!      !  Set flag integers for presence of snowh and soilw fields
+!
+!      grid%ifndsnowh = flag_snowh
+!      IF (num_sw_levels_input .GE. 1) THEN
+!         grid%ifndsoilw = 1
+!      ELSE
+!         grid%ifndsoilw = 0
+!      END IF
+!
+!****MARS: no need
+!      !  We require input data for the various LSM schemes.
+!
+!      enough_data : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE (LSMSCHEME)
+!            IF ( num_st_levels_input .LT. 2 ) THEN
+!               CALL wrf_error_fatal ( 'Not enough soil temperature data for Noah LSM scheme.')
+!            END IF
+!
+!         CASE (RUCLSMSCHEME)
+!            IF ( num_st_levels_input .LT. 2 ) THEN
+!               CALL wrf_error_fatal ( 'Not enough soil temperature data for RUC LSM scheme.')
+!            END IF
+!
+!      END SELECT enough_data
+!
+!      !  For sf_surface_physics = 1, we want to use close to a 30 cm value
+!      !  for the bottom level of the soil temps.
+!
+!      fix_bottom_level_for_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE (SLABSCHEME)
+!            IF      ( flag_tavgsfc  .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%em_tavgsfc(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_st010040 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%st010040(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_st000010 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%st000010(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_soilt020 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%soilt020(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_st007028 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%st007028(i,j)
+!                  END DO
+!               END DO
+!            ELSE
+!               CALL wrf_debug ( 0 , 'No 10-40 cm, 0-10 cm, 7-28, or 20 cm soil temperature data for grid%em_tmn')
+!               CALL wrf_debug ( 0 , 'Using 1 degree static annual mean temps' )
+!            END IF
+!
+!         CASE (LSMSCHEME)
+!
+!         CASE (RUCLSMSCHEME)
+!
+!      END SELECT fix_bottom_level_for_temp
+!
+!      !  Adjustments for the seaice field PRIOR to the grid%tslb computations.  This is
+!      !  is for the 5-layer scheme.
+!
+!      num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+!      num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+!      num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+!      CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+!      CALL nl_get_isice ( grid%id , grid%isice )
+!      CALL nl_get_iswater ( grid%id , grid%iswater )
+!      CALL adjust_for_seaice_pre ( grid%xice , grid%landmask , grid%tsk , grid%ivgtyp , grid%vegcat , grid%lu_index , &
+!                                   grid%xland , grid%landusef , grid%isltyp , grid%soilcat , grid%soilctop , &
+!                                   grid%soilcbot , grid%tmn , &
+!                                   grid%seaice_threshold , &
+!                                   num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+!                                   grid%iswater , grid%isice , &
+!                                   model_config_rec%sf_surface_physics(grid%id) , & 
+!                                   ids , ide , jds , jde , kds , kde , & 
+!                                   ims , ime , jms , jme , kms , kme , & 
+!                                   its , ite , jts , jte , kts , kte ) 
+!
+!      !  surface_input_source=1 => use data from static file (fractional category as input)
+!      !  surface_input_source=2 => use data from grib file (dominant category as input)
+!  
+!      IF ( config_flags%surface_input_source .EQ. 1 ) THEN
+!         grid%vegcat (its,jts) = 0
+!         grid%soilcat(its,jts) = 0
+!      END IF
+!
+!      !  Generate the vegetation and soil category information from the fractional input
+!      !  data, or use the existing dominant category fields if they exist.
+!
+!      IF ( ( grid%soilcat(its,jts) .LT. 0.5 ) .AND. ( grid%vegcat(its,jts) .LT. 0.5 ) ) THEN
+!
+!         num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+!         num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+!         num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+!   
+!         CALL process_percent_cat_new ( grid%landmask , &               
+!                                    grid%landusef , grid%soilctop , grid%soilcbot , &
+!                                    grid%isltyp , grid%ivgtyp , &
+!                                    num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte , &
+!                                    model_config_rec%iswater(grid%id) )
+!
+!         !  Make all the veg/soil parms the same so as not to confuse the developer.
+!
+!         DO j = jts , MIN(jde-1,jte)
+!            DO i = its , MIN(ide-1,ite)
+!               grid%vegcat(i,j)  = grid%ivgtyp(i,j)
+!               grid%soilcat(i,j) = grid%isltyp(i,j)
+!            END DO
+!         END DO
+!
+!      ELSE
+!
+!         !  Do we have dominant soil and veg data from the input already?
+!   
+!         IF ( grid%soilcat(its,jts) .GT. 0.5 ) THEN
+!            DO j = jts, MIN(jde-1,jte)
+!               DO i = its, MIN(ide-1,ite)
+!                  grid%isltyp(i,j) = NINT( grid%soilcat(i,j) )
+!               END DO
+!            END DO
+!         END IF
+!         IF ( grid%vegcat(its,jts) .GT. 0.5 ) THEN
+!            DO j = jts, MIN(jde-1,jte)
+!               DO i = its, MIN(ide-1,ite)
+!                  grid%ivgtyp(i,j) = NINT( grid%vegcat(i,j) )
+!               END DO
+!            END DO
+!         END IF
+!
+!      END IF
+!         
+!      !  Land use assignment.
+!
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            grid%lu_index(i,j) = grid%ivgtyp(i,j)
+!            IF ( grid%lu_index(i,j) .NE. model_config_rec%iswater(grid%id) ) THEN
+!               grid%landmask(i,j) = 1
+!               grid%xland(i,j)    = 1
+!            ELSE
+!               grid%landmask(i,j) = 0
+!               grid%xland(i,j)    = 2
+!            END IF
+!         END DO
+!      END DO
+!
+!      !  Adjust the various soil temperature values depending on the difference in
+!      !  in elevation between the current model's elevation and the incoming data's
+!      !  orography.
+!         
+!      IF ( flag_soilhgt .EQ. 1 ) THEN
+!         adjust_soil : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!            CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+!               CALL adjust_soil_temp_new ( grid%tmn , model_config_rec%sf_surface_physics(grid%id) , &
+!                                           grid%tsk , grid%ht , grid%toposoil , grid%landmask , flag_soilhgt , &
+!                                           grid%st000010 , grid%st010040 , grid%st040100 , grid%st100200 , grid%st010200 , &
+!                                           flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
+!                                           grid%st000007 , grid%st007028 , grid%st028100 , grid%st100255 , &
+!                                           flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
+!                                           grid%soilt000 , grid%soilt005 , grid%soilt020 , grid%soilt040 , grid%soilt160 , &
+!                                           grid%soilt300 , &
+!                                           flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , &
+!                                           flag_soilt160 , flag_soilt300 , &
+!                                           ids , ide , jds , jde , kds , kde , &
+!                                           ims , ime , jms , jme , kms , kme , &
+!                                           its , ite , jts , jte , kts , kte )
+!
+!         END SELECT adjust_soil
+!      END IF
+!
+!      !  Fix grid%em_tmn and grid%em_tsk.
+!
+!      fix_tsk_tmn : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+!            DO j = jts, MIN(jde-1,jte)
+!               DO i = its, MIN(ide-1,ite)
+!                  IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+!                       ( grid%sst(i,j) .GT. 240. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+!                     grid%tmn(i,j) = grid%sst(i,j)
+!                     grid%tsk(i,j) = grid%sst(i,j)
+!                  ELSE IF ( grid%landmask(i,j) .LT. 0.5 ) THEN
+!                     grid%tmn(i,j) = grid%tsk(i,j)
+!                  END IF
+!               END DO
+!            END DO
+!      END SELECT fix_tsk_tmn
+!    
+!      !  Is the grid%em_tsk reasonable?
+!
+
+
+!!**** MARS
+         DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+                !!grid%tsk(i,j)=200
+                grid%tmn(i,j)=0  
+                grid%sst(i,j)=0  !!no use on Mars!!
+                grid%tslb(i,:,j)=0  !!tslb is 3D field 
+               END DO
+            END DO
+!!**** MARS
+
+!      IF ( internal_time_loop .NE. 1 ) THEN
+!         DO j = jts, MIN(jde-1,jte)
+!            DO i = its, MIN(ide-1,ite)
+!               IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+!                  grid%tsk(i,j) = grid%em_t_2(i,1,j)
+!               END IF
+!            END DO
+!         END DO
+!      ELSE
+!         DO j = jts, MIN(jde-1,jte)
+!            DO i = its, MIN(ide-1,ite)
+!               IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+!                  print *,'error in the grid%em_tsk'
+!                  print *,'i,j=',i,j
+!                  print *,'grid%landmask=',grid%landmask(i,j)
+!                  print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+!                  if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+!                     grid%tsk(i,j)=grid%tmn(i,j)
+!                  else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+!                     grid%tsk(i,j)=grid%sst(i,j)
+!                  else
+!                     CALL wrf_error_fatal ( 'grid%em_tsk unreasonable' )
+!                  end if
+!               END IF
+!            END DO
+!         END DO
+!      END IF
+!
+!      !  Is the grid%em_tmn reasonable?
+!
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            IF ( ( ( grid%tmn(i,j) .LT. 170. ) .OR. ( grid%tmn(i,j) .GT. 400. ) ) &
+!               .AND. ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+!               IF ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME ) THEN
+!                  print *,'error in the grid%em_tmn'
+!                  print *,'i,j=',i,j
+!                  print *,'grid%landmask=',grid%landmask(i,j)
+!                  print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+!               END IF
+!
+!               if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+!                  grid%tmn(i,j)=grid%tsk(i,j)
+!               else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+!                  grid%tmn(i,j)=grid%sst(i,j)
+!               else
+!                  CALL wrf_error_fatal ( 'grid%em_tmn unreasonable' )
+!               endif
+!            END IF
+!         END DO
+!      END DO
+!   
+!      interpolate_soil_tmw : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+!            CALL process_soil_real ( grid%tsk , grid%tmn , &
+!                                  grid%landmask , grid%sst , &
+!                                  st_input , sm_input , sw_input , st_levels_input , sm_levels_input , sw_levels_input , &
+!                                  grid%zs , grid%dzs , grid%tslb , grid%smois , grid%sh2o , &
+!                                  flag_sst , flag_soilt000, flag_soilm000, &
+!                                  ids , ide , jds , jde , kds , kde , &
+!                                  ims , ime , jms , jme , kms , kme , &
+!                                  its , ite , jts , jte , kts , kte , &
+!                                  model_config_rec%sf_surface_physics(grid%id) , &
+!                                  model_config_rec%num_soil_layers , &
+!                                  model_config_rec%real_data_init_type , &
+!                                  num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+!                                  num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc )
+!
+!      END SELECT interpolate_soil_tmw
+!
+!      !  Minimum soil values, residual, from RUC LSM scheme.  For input from Noah and using
+!      !  RUC LSM scheme, this must be subtracted from the input total soil moisture.  For
+!      !  input RUC data and using the Noah LSM scheme, this value must be added to the soil
+!      !  moisture input.
+!
+!      lqmi(1:num_soil_top_cat) = &
+!      (/0.045, 0.057, 0.065, 0.067, 0.034, 0.078, 0.10,     &
+!        0.089, 0.095, 0.10,  0.070, 0.068, 0.078, 0.0,      &
+!        0.004, 0.065 /)
+!!       0.004, 0.065, 0.020, 0.004, 0.008 /)  !  has extra levels for playa, lava, and white sand
+!
+!      !  At the initial time we care about values of soil moisture and temperature, other times are
+!      !  ignored by the model, so we ignore them, too.  
+!
+!      IF ( domain_ClockIsStartTime(grid) ) THEN
+!         account_for_zero_soil_moisture : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!   
+!            CASE ( LSMSCHEME )
+!               iicount = 0
+!               IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+!                             ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+!                           print *,'Noah -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+!                           iicount = iicount + 1
+!                           grid%smois(i,:,j) = 0.005
+!                        END IF
+!                     END DO
+!                  END DO
+!                  IF ( iicount .GT. 0 ) THEN
+!                     print *,'Noah -> Noah: total number of small soil moisture locations = ',iicount
+!                  END IF
+!               ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        grid%smois(i,:,j) = grid%smois(i,:,j) + lqmi(grid%isltyp(i,j))
+!                     END DO
+!                  END DO
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+!                             ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+!                           print *,'RUC -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+!                           iicount = iicount + 1
+!                           grid%smois(i,:,j) = 0.005
+!                        END IF
+!                     END DO
+!                  END DO
+!                  IF ( iicount .GT. 0 ) THEN
+!                     print *,'RUC -> Noah: total number of small soil moisture locations = ',iicount
+!                  END IF
+!               END IF
+!   
+!            CASE ( RUCLSMSCHEME )
+!               iicount = 0
+!               IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        grid%smois(i,:,j) = MAX ( grid%smois(i,:,j) - lqmi(grid%isltyp(i,j)) , 0. )
+!                     END DO
+!                  END DO
+!               ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+!                  ! no op
+!               END IF
+!   
+!         END SELECT account_for_zero_soil_moisture
+!      END IF
+!
+!      !  Is the grid%tslb reasonable?
+!
+!      IF ( internal_time_loop .NE. 1 ) THEN
+!         DO j = jts, MIN(jde-1,jte)
+!            DO ns = 1 , model_config_rec%num_soil_layers
+!               DO i = its, MIN(ide-1,ite)
+!                  IF ( grid%tslb(i,ns,j) .LT. 170 .or. grid%tslb(i,ns,j) .GT. 400. ) THEN
+!                     grid%tslb(i,ns,j) = grid%em_t_2(i,1,j)
+!                     grid%smois(i,ns,j) = 0.3
+!                  END IF
+!               END DO
+!            END DO
+!         END DO
+!      ELSE
+!         DO j = jts, MIN(jde-1,jte)
+!            DO i = its, MIN(ide-1,ite)
+!               IF ( ( ( grid%tslb(i,1,j) .LT. 170. ) .OR. ( grid%tslb(i,1,j) .GT. 400. ) ) .AND. &
+!                       ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+!                     IF ( ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME    ) .AND. &
+!                          ( model_config_rec%sf_surface_physics(grid%id) .NE. RUCLSMSCHEME ) ) THEN
+!                        print *,'error in the grid%tslb'
+!                        print *,'i,j=',i,j
+!                        print *,'grid%landmask=',grid%landmask(i,j)
+!                        print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+!                        print *,'grid%tslb = ',grid%tslb(i,:,j)
+!                        print *,'old grid%smois = ',grid%smois(i,:,j)
+!                        grid%smois(i,1,j) = 0.3
+!                        grid%smois(i,2,j) = 0.3
+!                        grid%smois(i,3,j) = 0.3
+!                        grid%smois(i,4,j) = 0.3
+!                     END IF
+!   
+!                     IF ( (grid%tsk(i,j).GT.170. .AND. grid%tsk(i,j).LT.400.) .AND. &
+!                          (grid%tmn(i,j).GT.170. .AND. grid%tmn(i,j).LT.400.) ) THEN
+!                        fake_soil_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!                           CASE ( SLABSCHEME )
+!                              DO ns = 1 , model_config_rec%num_soil_layers
+!                                 grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+!                                                       grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+!                              END DO
+!                           CASE ( LSMSCHEME , RUCLSMSCHEME )
+!                              CALL wrf_error_fatal ( 'Assigning constant soil moisture, bad idea')
+!                              DO ns = 1 , model_config_rec%num_soil_layers
+!                                 grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+!                                                       grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+!                              END DO
+!                        END SELECT fake_soil_temp
+!                     else if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 1' )
+!                        DO ns = 1 , model_config_rec%num_soil_layers
+!                           grid%tslb(i,ns,j)=grid%tsk(i,j)
+!                        END DO
+!                     else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 2' )
+!                        DO ns = 1 , model_config_rec%num_soil_layers
+!                           grid%tslb(i,ns,j)=grid%sst(i,j)
+!                        END DO
+!                     else if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 3' )
+!                        DO ns = 1 , model_config_rec%num_soil_layers
+!                           grid%tslb(i,ns,j)=grid%tmn(i,j)
+!                        END DO
+!                     else
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 4' )
+!                     endif
+!               END IF
+!            END DO
+!         END DO
+!      END IF
+!
+!      !  Adjustments for the seaice field AFTER the grid%tslb computations.  This is
+!      !  is for the Noah LSM scheme.
+!
+!      num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+!      num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+!      num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+!      CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+!      CALL nl_get_isice ( grid%id , grid%isice )
+!      CALL nl_get_iswater ( grid%id , grid%iswater )
+!      CALL adjust_for_seaice_post ( grid%xice , grid%landmask , grid%tsk , grid%tsk_save , &
+!                                    grid%ivgtyp , grid%vegcat , grid%lu_index , &
+!                                    grid%xland , grid%landusef , grid%isltyp , grid%soilcat ,  &
+!                                    grid%soilctop , &
+!                                    grid%soilcbot , grid%tmn , grid%vegfra , &
+!                                    grid%tslb , grid%smois , grid%sh2o , &
+!                                    grid%seaice_threshold , &
+!                                    num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+!                                    model_config_rec%num_soil_layers , &
+!                                    grid%iswater , grid%isice , &
+!                                    model_config_rec%sf_surface_physics(grid%id) , & 
+!                                    ids , ide , jds , jde , kds , kde , & 
+!                                    ims , ime , jms , jme , kms , kme , & 
+!                                    its , ite , jts , jte , kts , kte ) 
+!
+!      !  Let us make sure (again) that the grid%landmask and the veg/soil categories match.
+!
+!oops1=0
+!oops2=0
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            IF ( ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. &
+!                   ( grid%ivgtyp(i,j) .NE. config_flags%iswater .OR. grid%isltyp(i,j) .NE. 14 ) ) .OR. &
+!                 ( ( grid%landmask(i,j) .GT. 0.5 ) .AND. &
+!                   ( grid%ivgtyp(i,j) .EQ. config_flags%iswater .OR. grid%isltyp(i,j) .EQ. 14 ) ) ) THEN
+!               IF ( grid%tslb(i,1,j) .GT. 1. ) THEN
+!oops1=oops1+1
+!                  grid%ivgtyp(i,j) = 5
+!                  grid%isltyp(i,j) = 8
+!                  grid%landmask(i,j) = 1
+!                  grid%xland(i,j) = 1
+!               ELSE IF ( grid%sst(i,j) .GT. 1. ) THEN
+!oops2=oops2+1
+!                  grid%ivgtyp(i,j) = config_flags%iswater
+!                  grid%isltyp(i,j) = 14
+!                  grid%landmask(i,j) = 0
+!                  grid%xland(i,j) = 2
+!               ELSE
+!                  print *,'the grid%landmask and soil/veg cats do not match'
+!                  print *,'i,j=',i,j
+!                  print *,'grid%landmask=',grid%landmask(i,j)
+!                  print *,'grid%ivgtyp=',grid%ivgtyp(i,j)
+!                  print *,'grid%isltyp=',grid%isltyp(i,j)
+!                  print *,'iswater=', config_flags%iswater
+!                  print *,'grid%tslb=',grid%tslb(i,:,j)
+!                  print *,'grid%sst=',grid%sst(i,j)
+!                  CALL wrf_error_fatal ( 'mismatch_landmask_ivgtyp' )
+!               END IF
+!            END IF
+!         END DO
+!      END DO
+!if (oops1.gt.0) then
+!print *,'points artificially set to land : ',oops1
+!endif
+!if(oops2.gt.0) then
+!print *,'points artificially set to water: ',oops2
+!endif
+!! fill grid%sst array with grid%em_tsk if missing in real input (needed for time-varying grid%sst in wrf)
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!           IF ( flag_sst .NE. 1 ) THEN
+!             grid%sst(i,j) = grid%tsk(i,j)
+!           ENDIF
+!         END DO
+!      END DO
+
+
+      !  From the full level data, we can get the half levels, reciprocals, and layer
+      !  thicknesses.  These are all defined at half level locations, so one less level.
+      !  We allow the vertical coordinate to *accidently* come in upside down.  We want
+      !  the first full level to be the ground surface.
+
+      !  Check whether grid%em_znw (full level) data are truly full levels. If not, we need to adjust them
+      !  to be full levels.
+      !  in this test, we check if grid%em_znw(1) is neither 0 nor 1 (within a tolerance of 10**-5)
+
+      were_bad = .false.
+      IF ( ( (grid%em_znw(1).LT.(1-1.E-5) ) .OR. ( grid%em_znw(1).GT.(1+1.E-5) ) ).AND. &
+           ( (grid%em_znw(1).LT.(0-1.E-5) ) .OR. ( grid%em_znw(1).GT.(0+1.E-5) ) ) ) THEN
+         were_bad = .true.
+         print *,'Your grid%em_znw input values are probably half-levels. '
+         print *,grid%em_znw
+         print *,'WRF expects grid%em_znw values to be full levels. '
+         print *,'Adjusting now to full levels...'
+         !  We want to ignore the first value if it's negative
+         IF (grid%em_znw(1).LT.0) THEN
+            grid%em_znw(1)=0
+         END IF
+         DO k=2,kde
+            grid%em_znw(k)=2*grid%em_znw(k)-grid%em_znw(k-1)
+         END DO
+      END IF
+
+      !  Let's check our changes
+
+      IF ( ( ( grid%em_znw(1) .LT. (1-1.E-5) ) .OR. ( grid%em_znw(1) .GT. (1+1.E-5) ) ).AND. &
+           ( ( grid%em_znw(1) .LT. (0-1.E-5) ) .OR. ( grid%em_znw(1) .GT. (0+1.E-5) ) ) ) THEN
+         print *,'The input grid%em_znw height values were half-levels or erroneous. '
+         print *,'Attempts to treat the values as half-levels and change them '
+         print *,'to valid full levels failed.'
+         CALL wrf_error_fatal("bad grid%em_znw values from input files")
+      ELSE IF ( were_bad ) THEN
+         print *,'...adjusted. grid%em_znw array now contains full eta level values. '
+      ENDIF
+
+      IF ( grid%em_znw(1) .LT. grid%em_znw(kde) ) THEN
+         DO k=1, kde/2
+            hold_znw = grid%em_znw(k)
+            grid%em_znw(k)=grid%em_znw(kde+1-k)
+            grid%em_znw(kde+1-k)=hold_znw
+         END DO
+      END IF
+
+      DO k=1, kde-1
+         grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+         grid%em_rdnw(k) = 1./grid%em_dnw(k)
+         grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+      END DO
+
+      !  Now the same sort of computations with the half eta levels, even ANOTHER
+      !  level less than the one above.
+
+      DO k=2, kde-1
+         grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+         grid%em_rdn(k) = 1./grid%em_dn(k)
+         grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+         grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+      END DO
+
+      !  Scads of vertical coefficients.
+
+      cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+      cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+
+      grid%cf1  = grid%em_fnp(2) + cof1
+      grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+      grid%cf3  = cof2       
+
+      grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+      grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+
+      !  Inverse grid distances.
+
+      grid%rdx = 1./config_flags%dx
+      grid%rdy = 1./config_flags%dy
+
+      !  Some of the many weird geopotential initializations that we'll see today: grid%em_ph0 is total, 
+      !  and grid%em_ph_2 is a perturbation from the base state geopotential.  We set the base geopotential 
+      !  at the lowest level to terrain elevation * gravity.
+
+      DO j=jts,jte
+         DO i=its,ite
+            grid%em_ph0(i,1,j) = grid%ht(i,j) * g
+            grid%em_ph_2(i,1,j) = 0.
+         END DO
+      END DO
+
+      !  Base state potential temperature and inverse density (alpha = 1/rho) from
+      !  the half eta levels and the base-profile surface pressure.  Compute 1/rho 
+      !  from equation of state.  The potential temperature is a perturbation from t0.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+
+
+!****MARS         
+!TODO: etudier si une meilleure formule n'existe pas pour Mars
+!TODO: mais il s'agit juste d'un etat de base ...
+!****MARS
+            !  Base state pressure is a function of eta level and terrain, only, plus
+            !  the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
+            !  temperature, K), and A (temperature difference, from 1000 mb to 300 mb, K).
+
+!!****MARS
+!!ici il s'agit de definir un etat de base, de reference
+!!- on ne peut prendre le profil de temperature du modele
+!!  qui conduit a des instabilites
+!!      grid%em_t_init(i,k,j)=grid%em_t_2(i,k,j) - t0 est a eviter donc.
+!!- pour la pression de surface, aucune information
+!!  sur un profil de temperature variable et non equilibre
+!!  ne doit transparaitre
+!!      p_surf = grid%psfc(i,j) pourquoi pas ... mais t y est utilisee ...
+!!
+!!>> l'etat de base ne doit dependre "geographiquement" que de la topographie
+!!
+!!****MARS
+            p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+
+            DO k = 1, kte-1
+               grid%em_php(i,k,j) = grid%em_znw(k)*(p_surf - grid%p_top) + grid%p_top ! temporary, full lev base pressure
+               grid%em_pb(i,k,j) = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+!              temp = MAX ( 200., t00 + A*LOG(grid%em_pb(i,k,j)/p00) )
+               temp =             t00 + A*LOG(grid%em_pb(i,k,j)/p00)
+               grid%em_t_init(i,k,j) = temp*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
+               grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+            END DO
+       
+            !  Base state mu is defined as base state surface pressure minus grid%p_top
+
+            grid%em_mub(i,j) = p_surf - grid%p_top
+       
+            !  Dry surface pressure is defined as the following (this mu is from the input file
+            !  computed from the dry pressure).  Here the dry pressure is just reconstituted.
+
+            pd_surf = grid%em_mu0(i,j) + grid%p_top
+
+            !  Integrate base geopotential, starting at terrain elevation.  This assures that 
+            !  the base state is in exact hydrostatic balance with respect to the model equations.
+            !  This field is on full levels.
+
+            grid%em_phb(i,1,j) = grid%ht(i,j) * g
+            DO k  = 2,kte
+               grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+            END DO
+         END DO
+      END DO
+
+      !  Fill in the outer rows and columns to allow us to be sloppy.
+
+      IF ( ite .EQ. ide ) THEN
+      i = ide
+      DO j = jts, MIN(jde-1,jte)
+         grid%em_mub(i,j) = grid%em_mub(i-1,j)
+         grid%em_mu_2(i,j) = grid%em_mu_2(i-1,j)
+         DO k = 1, kte-1
+            grid%em_pb(i,k,j) = grid%em_pb(i-1,k,j)
+            grid%em_t_init(i,k,j) = grid%em_t_init(i-1,k,j)
+            grid%em_alb(i,k,j) = grid%em_alb(i-1,k,j)
+         END DO
+         DO k = 1, kte
+            grid%em_phb(i,k,j) = grid%em_phb(i-1,k,j)
+         END DO
+      END DO
+      END IF
+
+      IF ( jte .EQ. jde ) THEN
+      j = jde
+      DO i = its, ite
+         grid%em_mub(i,j) = grid%em_mub(i,j-1)
+         grid%em_mu_2(i,j) = grid%em_mu_2(i,j-1)
+         DO k = 1, kte-1
+            grid%em_pb(i,k,j) = grid%em_pb(i,k,j-1)
+            grid%em_t_init(i,k,j) = grid%em_t_init(i,k,j-1)
+            grid%em_alb(i,k,j) = grid%em_alb(i,k,j-1)
+         END DO
+         DO k = 1, kte
+            grid%em_phb(i,k,j) = grid%em_phb(i,k,j-1)
+         END DO
+      END DO
+      END IF
+       
+      !  Compute the perturbation dry pressure (grid%em_mub + grid%em_mu_2 + ptop = dry grid%em_psfc).
+
+      DO j = jts, min(jde-1,jte)
+         DO i = its, min(ide-1,ite)
+            grid%em_mu_2(i,j) = grid%em_mu0(i,j) - grid%em_mub(i,j)
+         END DO
+      END DO
+
+      !  Fill in the outer rows and columns to allow us to be sloppy.
+
+      IF ( ite .EQ. ide ) THEN
+      i = ide
+      DO j = jts, MIN(jde-1,jte)
+         grid%em_mu_2(i,j) = grid%em_mu_2(i-1,j)
+      END DO
+      END IF
+
+      IF ( jte .EQ. jde ) THEN
+      j = jde
+      DO i = its, ite
+         grid%em_mu_2(i,j) = grid%em_mu_2(i,j-1)
+      END DO
+      END IF
+
+      lev500 = 0 
+      DO j = jts, min(jde-1,jte)
+         DO i = its, min(ide-1,ite)
+
+            !  Assign the potential temperature (perturbation from t0) and qv on all the mass
+            !  point locations.
+
+            DO k =  1 , kde-1
+               grid%em_t_2(i,k,j)          = grid%em_t_2(i,k,j) - t0
+            END DO
+
+!!---------------------------------------------------------------
+!!****MARS: no 500mb adjustment needed
+!!****MARS: must keep however the hydrostatic equation integration performed in this loop !
+!!****MARS: the DO WHILE loop is deactivated, since we will always be in the case
+!!****MARS: ... of "ELSE dpmu = 0."
+!!---------------------------------------------------------------
+!            dpmu = 10001.
+!            loop_count = 0
+!
+!            DO WHILE ( ( ABS(dpmu) .GT. 10. ) .AND. &
+!                       ( loop_count .LT. 5 ) )  
+!
+!               loop_count = loop_count + 1
+      
+               !  Integrate the hydrostatic equation (from the RHS of the bigstep vertical momentum 
+               !  equation) down from the top to get the pressure perturbation.  First get the pressure
+               !  perturbation, moisture, and inverse density (total and perturbation) at the top-most level.
+         
+               k = kte-1
+         
+               qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+               qvf2 = 1./(1.+qvf1)
+               qvf1 = qvf1*qvf2
+         
+               grid%em_p(i,k,j) = - 0.5*(grid%em_mu_2(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+               qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+               grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf&
+                                 *(((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+               grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+         
+               !  Now, integrate down the column to compute the pressure perturbation, and diagnose the two
+               !  inverse density fields (total and perturbation).
+         
+                DO k=kte-2,1,-1
+                  qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+                  qvf2 = 1./(1.+qvf1)
+                  qvf1 = qvf1*qvf2
+                  grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_2(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+                  qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+                  grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf* &
+                              (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+                  grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+               END DO
+         
+               !  This is the hydrostatic equation used in the model after the small timesteps.  In 
+               !  the model, grid%em_al (inverse density) is computed from the geopotential.
+         
+               DO k  = 2,kte
+                  grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) - &
+                                grid%em_dnw(k-1) * ( (grid%em_mub(i,j)+grid%em_mu_2(i,j))*grid%em_al(i,k-1,j) &
+                              + grid%em_mu_2(i,j)*grid%em_alb(i,k-1,j) )
+                  grid%em_ph0(i,k,j) = grid%em_ph_2(i,k,j) + grid%em_phb(i,k,j)
+               END DO
+
+!               !  Adjust the column pressure so that the computed 500 mb height is close to the
+!               !  input value (of course, not when we are doing hybrid input).
+!   
+!               IF ( ( flag_metgrid .EQ. 1 ) .AND. ( i .EQ. its ) .AND. ( j .EQ. jts ) ) THEN
+!                  DO k = 1 , num_metgrid_levels
+!                     IF ( ABS ( grid%em_p_gc(i,k,j) - 50000. ) .LT. 1. ) THEN
+!                        lev500 = k
+!                        EXIT
+!                     END IF
+!                  END DO
+!               END IF
+!           
+!               !  We only do the adjustment of height if we have the input data on pressure
+!               !  surfaces, and folks have asked to do this option.
+!   
+!               IF ( ( flag_metgrid .EQ. 1 ) .AND. &
+!                    ( config_flags%adjust_heights ) .AND. &
+!                    ( lev500 .NE. 0 ) ) THEN
+!   
+!                  DO k = 2 , kte-1
+!      
+!                     !  Get the pressures on the full eta levels (grid%em_php is defined above as 
+!                     !  the full-lev base pressure, an easy array to use for 3d space).
+!      
+!                     pl = grid%em_php(i,k  ,j) + &
+!                          ( grid%em_p(i,k-1  ,j) * ( grid%em_znw(k    ) - grid%em_znu(k  ) ) + &             
+!                            grid%em_p(i,k    ,j) * ( grid%em_znu(k-1  ) - grid%em_znw(k  ) ) ) / &
+!                          ( grid%em_znu(k-1  ) - grid%em_znu(k  ) )
+!                     pu = grid%em_php(i,k+1,j) + &
+!                          ( grid%em_p(i,k-1+1,j) * ( grid%em_znw(k  +1) - grid%em_znu(k+1) ) + &             
+!                            grid%em_p(i,k  +1,j) * ( grid%em_znu(k-1+1) - grid%em_znw(k+1) ) ) / &
+!                          ( grid%em_znu(k-1+1) - grid%em_znu(k+1) )
+!                   
+!                     !  If these pressure levels trap 500 mb, use them to interpolate
+!                     !  to the 500 mb level of the computed height.
+!!**** PB on MARS .... ?       
+!                     IF ( ( pl .GE. 50000. ) .AND. ( pu .LT. 50000. ) ) THEN
+!                        zl = ( grid%em_ph_2(i,k  ,j) + grid%em_phb(i,k  ,j) ) / g
+!                        zu = ( grid%em_ph_2(i,k+1,j) + grid%em_phb(i,k+1,j) ) / g
+!      
+!                        z500 = ( zl * ( LOG(50000.) - LOG(pu    ) ) + &
+!                                 zu * ( LOG(pl    ) - LOG(50000.) ) ) / &
+!                               ( LOG(pl) - LOG(pu) ) 
+!!                       z500 = ( zl * (    (50000.) -    (pu    ) ) + &
+!!                                zu * (    (pl    ) -    (50000.) ) ) / &
+!!                              (    (pl) -    (pu) ) 
+!      
+!                        !  Compute the difference of the 500 mb heights (computed minus input), and
+!                        !  then the change in grid%em_mu_2.  The grid%em_php is still full-levels, base pressure.
+!      
+!                        dz500 = z500 - grid%em_ght_gc(i,lev500,j)
+!                        tvsfc = ((grid%em_t_2(i,1,j)+t0)*((grid%em_p(i,1,j)+grid%em_php(i,1,j))/p1000mb)**(r_d/cp)) * &
+!                                (1.+0.6*moist(i,1,j,P_QV))
+!                        dpmu = ( grid%em_php(i,1,j) + grid%em_p(i,1,j) ) * EXP ( g * dz500 / ( r_d * tvsfc ) )
+!                        dpmu = dpmu - ( grid%em_php(i,1,j) + grid%em_p(i,1,j) )
+!                        grid%em_mu_2(i,j) = grid%em_mu_2(i,j) - dpmu
+!                        EXIT
+!                     END IF
+!      
+!                  END DO
+!               ELSE
+!                  dpmu = 0.
+!               END IF
+!
+!            END DO
+       
+         END DO
+      END DO
+
+!!****MARS: we use WPS
+!
+!      !  If this is data from the SI, then we probably do not have the original
+!      !  surface data laying around.  Note that these are all the lowest levels
+!      !  of the respective 3d arrays.  For surface pressure, we assume that the
+!      !  vertical gradient of grid%em_p prime is zilch.  This is not all that important.
+!      !  These are filled in so that the various plotting routines have something
+!      !  to play with at the initial time for the model.
+!
+!      IF ( flag_metgrid .NE. 1 ) THEN
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide,ite)
+!               grid%u10(i,j)=grid%em_u_2(i,1,j)
+!            END DO
+!         END DO
+!   
+!         DO j = jts, min(jde,jte)
+!            DO i = its, min(ide-1,ite)
+!               grid%v10(i,j)=grid%em_v_2(i,1,j)
+!            END DO
+!         END DO
+!
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide-1,ite)
+!               p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+!               grid%psfc(i,j)=p_surf + grid%em_p(i,1,j)
+!               grid%q2(i,j)=moist(i,1,j,P_QV)
+!               grid%th2(i,j)=grid%em_t_2(i,1,j)+300.
+!               grid%t2(i,j)=grid%th2(i,j)*(((grid%em_p(i,1,j)+grid%em_pb(i,1,j))/p00)**(r_d/cp))
+!            END DO
+!         END DO
+!
+!      !  If this data is from WPS, then we have previously assigned the surface
+!      !  data for u, v, and t.  If we have an input qv, welp, we assigned that one,
+!      !  too.  Now we pick up the left overs, and if RH came in - we assign the 
+!      !  mixing ratio.
+!
+!      ELSE IF ( flag_metgrid .EQ. 1 ) THEN
+!
+!!****MARS: we use WPS
+
+         DO j = jts, min(jde-1,jte)
+            DO i = its, min(ide-1,ite)
+                p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+                ! recompute the value of surface pressure as calculated by sfcprs2
+                grid%psfc(i,j)=p_surf + grid%em_p(i,1,j)
+                grid%th2(i,j)=grid%t2(i,j)*(p00/(grid%em_p(i,1,j)+grid%em_pb(i,1,j)))**(r_d/cp)
+            END DO
+         END DO
+         IF ( flag_qv .NE. 1 ) THEN
+            DO j = jts, min(jde-1,jte)
+               DO i = its, min(ide-1,ite)
+                  grid%q2(i,j)=moist(i,1,j,P_QV)
+               END DO
+            END DO
+         END IF
+
+!      END IF
+
+      ips = its ; ipe = ite ; jps = jts ; jpe = jte ; kps = kts ; kpe = kte
+#ifdef DM_PARALLEL
+#   include "HALO_EM_INIT_1.inc"
+#   include "HALO_EM_INIT_2.inc"
+#   include "HALO_EM_INIT_3.inc"
+#   include "HALO_EM_INIT_4.inc"
+#   include "HALO_EM_INIT_5.inc"
+#endif
+
+      RETURN
+
+   END SUBROUTINE init_domain_rk
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE const_module_initialize ( p00 , t00 , a ) 
+      USE module_configure
+      IMPLICIT NONE
+      !  For the real-data-cases only.
+      REAL , INTENT(OUT) :: p00 , t00 , a
+      CALL nl_get_base_pres  ( 1 , p00 )
+      CALL nl_get_base_temp  ( 1 , t00 )
+      CALL nl_get_base_lapse ( 1 , a   )
+   END SUBROUTINE const_module_initialize
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE rebalance_driver ( grid ) 
+
+      IMPLICIT NONE
+
+      TYPE (domain)          :: grid 
+
+      CALL rebalance( grid &
+!
+#include "em_actual_new_args.inc"
+!
+      )
+
+   END SUBROUTINE rebalance_driver
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE rebalance ( grid  &
+!
+#include "em_dummy_new_args.inc"
+!
+                        )
+      IMPLICIT NONE
+
+      TYPE (domain)          :: grid
+
+#include "em_dummy_new_decl.inc"
+
+      TYPE (grid_config_rec_type)              :: config_flags
+
+      REAL :: p_surf ,  pd_surf, p_surf_int , pb_int , ht_hold
+      REAL :: qvf , qvf1 , qvf2
+      REAL :: p00 , t00 , a
+      REAL , DIMENSION(:,:,:) , ALLOCATABLE :: t_init_int
+
+      !  Local domain indices and counters.
+
+      INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+
+      INTEGER                             ::                       &
+                                     ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte, &
+                                     ips, ipe, jps, jpe, kps, kpe, &
+                                     i, j, k
+
+#ifdef DM_PARALLEL
+#    include "em_data_calls.inc"
+#endif
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+            kds = grid%sd31 ; kde = grid%ed31 ;
+            ids = grid%sd32 ; ide = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            kms = grid%sm31 ; kme = grid%em31 ;
+            ims = grid%sm32 ; ime = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+            its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XYZ )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            jds = grid%sd32 ; jde = grid%ed32 ;
+            kds = grid%sd33 ; kde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            jms = grid%sm32 ; jme = grid%em32 ;
+            kms = grid%sm33 ; kme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+            kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XZY )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            kds = grid%sd32 ; kde = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            kms = grid%sm32 ; kme = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+      END SELECT
+
+      ALLOCATE ( t_init_int(ims:ime,kms:kme,jms:jme) )
+
+      !  Some of the many weird geopotential initializations that we'll see today: grid%em_ph0 is total, 
+      !  and grid%em_ph_2 is a perturbation from the base state geopotential.  We set the base geopotential 
+      !  at the lowest level to terrain elevation * gravity.
+
+      DO j=jts,jte
+         DO i=its,ite
+            grid%em_ph0(i,1,j) = grid%ht_fine(i,j) * g
+            grid%em_ph_2(i,1,j) = 0.
+         END DO
+      END DO
+      
+      !  To define the base state, we call a USER MODIFIED routine to set the three
+      !  necessary constants:  p00 (sea level pressure, Pa), t00 (sea level temperature, K), 
+      !  and A (temperature difference, from 1000 mb to 300 mb, K).
+
+      CALL const_module_initialize ( p00 , t00 , a ) 
+
+      !  Base state potential temperature and inverse density (alpha = 1/rho) from
+      !  the half eta levels and the base-profile surface pressure.  Compute 1/rho 
+      !  from equation of state.  The potential temperature is a perturbation from t0.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+
+            !  Base state pressure is a function of eta level and terrain, only, plus
+            !  the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
+            !  temperature, K), and A (temperature difference, from 1000 mb to 300 mb, K).
+            !  The fine grid terrain is ht_fine, the interpolated is grid%em_ht.
+
+            p_surf     = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht_fine(i,j)/a/r_d ) **0.5 ) 
+            p_surf_int = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)     /a/r_d ) **0.5 ) 
+
+            DO k = 1, kte-1
+               grid%em_pb(i,k,j) = grid%em_znu(k)*(p_surf     - grid%p_top) + grid%p_top
+               pb_int    = grid%em_znu(k)*(p_surf_int - grid%p_top) + grid%p_top
+               grid%em_t_init(i,k,j)    = (t00 + A*LOG(grid%em_pb(i,k,j)/p00))*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
+               t_init_int(i,k,j)= (t00 + A*LOG(pb_int   /p00))*(p00/pb_int   )**(r_d/cp) - t0
+               grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+            END DO
+       
+            !  Base state mu is defined as base state surface pressure minus grid%p_top
+
+            grid%em_mub(i,j) = p_surf - grid%p_top
+       
+            !  Dry surface pressure is defined as the following (this mu is from the input file
+            !  computed from the dry pressure).  Here the dry pressure is just reconstituted.
+
+            pd_surf = ( grid%em_mub(i,j) + grid%em_mu_2(i,j) ) + grid%p_top
+       
+            !  Integrate base geopotential, starting at terrain elevation.  This assures that 
+            !  the base state is in exact hydrostatic balance with respect to the model equations.
+            !  This field is on full levels.
+
+            grid%em_phb(i,1,j) = grid%ht_fine(i,j) * g
+            DO k  = 2,kte
+               grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+            END DO
+         END DO
+      END DO
+
+      !  Replace interpolated terrain with fine grid values.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+            grid%ht(i,j) = grid%ht_fine(i,j)
+         END DO
+      END DO
+
+      !  Perturbation fields.
+
+      DO j = jts, min(jde-1,jte)
+         DO i = its, min(ide-1,ite)
+
+            !  The potential temperature is THETAnest = THETAinterp + ( TBARnest - TBARinterp)
+
+            DO k =  1 , kde-1
+               grid%em_t_2(i,k,j) = grid%em_t_2(i,k,j) + ( grid%em_t_init(i,k,j) - t_init_int(i,k,j) ) 
+            END DO
+      
+            !  Integrate the hydrostatic equation (from the RHS of the bigstep vertical momentum 
+            !  equation) down from the top to get the pressure perturbation.  First get the pressure
+            !  perturbation, moisture, and inverse density (total and perturbation) at the top-most level.
+      
+            k = kte-1
+      
+            qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+            qvf2 = 1./(1.+qvf1)
+            qvf1 = qvf1*qvf2
+      
+            grid%em_p(i,k,j) = - 0.5*(grid%em_mu_2(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+            qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+            grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf* &
+                                 (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+            grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+      
+            !  Now, integrate down the column to compute the pressure perturbation, and diagnose the two
+            !  inverse density fields (total and perturbation).
+      
+            DO k=kte-2,1,-1
+               qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+               qvf2 = 1./(1.+qvf1)
+               qvf1 = qvf1*qvf2
+               grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_2(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+               qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+               grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf* &
+                           (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+               grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+            END DO
+      
+            !  This is the hydrostatic equation used in the model after the small timesteps.  In 
+            !  the model, grid%em_al (inverse density) is computed from the geopotential.
+      
+            DO k  = 2,kte
+               grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) - &
+                             grid%em_dnw(k-1) * ( (grid%em_mub(i,j)+grid%em_mu_2(i,j))*grid%em_al(i,k-1,j) &
+                           + grid%em_mu_2(i,j)*grid%em_alb(i,k-1,j) )
+               grid%em_ph0(i,k,j) = grid%em_ph_2(i,k,j) + grid%em_phb(i,k,j)
+            END DO
+       
+         END DO
+      END DO
+
+      DEALLOCATE ( t_init_int ) 
+
+      ips = its ; ipe = ite ; jps = jts ; jpe = jte ; kps = kts ; kpe = kte
+#ifdef DM_PARALLEL
+#   include "HALO_EM_INIT_1.inc"
+#   include "HALO_EM_INIT_2.inc"
+#   include "HALO_EM_INIT_3.inc"
+#   include "HALO_EM_INIT_4.inc"
+#   include "HALO_EM_INIT_5.inc"
+#endif
+   END SUBROUTINE rebalance
+
+!---------------------------------------------------------------------
+
+   RECURSIVE SUBROUTINE find_my_parent ( grid_ptr_in , grid_ptr_out , id_i_am , id_wanted , found_the_id )
+
+      USE module_domain
+
+      TYPE(domain) , POINTER :: grid_ptr_in , grid_ptr_out
+      TYPE(domain) , POINTER :: grid_ptr_sibling
+      INTEGER :: id_wanted , id_i_am
+      LOGICAL :: found_the_id
+
+      found_the_id = .FALSE.
+      grid_ptr_sibling => grid_ptr_in
+      DO WHILE ( ASSOCIATED ( grid_ptr_sibling ) )
+
+         IF ( grid_ptr_sibling%grid_id .EQ. id_wanted ) THEN
+            found_the_id = .TRUE.
+            grid_ptr_out => grid_ptr_sibling
+            RETURN
+         ELSE IF ( grid_ptr_sibling%num_nests .GT. 0 ) THEN
+            grid_ptr_sibling => grid_ptr_sibling%nests(1)%ptr
+            CALL find_my_parent ( grid_ptr_sibling , grid_ptr_out , id_i_am , id_wanted , found_the_id )
+         ELSE
+            grid_ptr_sibling => grid_ptr_sibling%sibling
+         END IF
+
+      END DO
+
+   END SUBROUTINE find_my_parent
+
+#endif
+
+!---------------------------------------------------------------------
+
+#ifdef VERT_UNIT
+
+!This is a main program for a small unit test for the vertical interpolation.
+
+program vint
+
+   implicit none 
+
+   integer , parameter :: ij = 3
+   integer , parameter :: keta = 30
+   integer , parameter :: kgen =20 
+
+   integer :: ids , ide , jds , jde , kds , kde , &
+              ims , ime , jms , jme , kms , kme , &
+              its , ite , jts , jte , kts , kte
+
+   integer :: generic
+
+   real , dimension(1:ij,kgen,1:ij) :: fo , po
+   real , dimension(1:ij,1:keta,1:ij) :: fn_calc , fn_interp , pn
+
+   integer, parameter :: interp_type          = 1 ! 2
+!  integer, parameter :: lagrange_order       = 2 ! 1
+   integer            :: lagrange_order
+   logical, parameter :: lowest_lev_from_sfc  = .FALSE. ! .TRUE.
+   real   , parameter :: zap_close_levels     = 500. ! 100.
+   integer, parameter :: force_sfc_in_vinterp = 0 ! 6
+
+   integer :: k 
+
+   ids = 1 ; ide = ij ; jds = 1 ; jde = ij ; kds = 1 ; kde = keta
+   ims = 1 ; ime = ij ; jms = 1 ; jme = ij ; kms = 1 ; kme = keta
+   its = 1 ; ite = ij ; jts = 1 ; jte = ij ; kts = 1 ; kte = keta
+
+   generic = kgen
+
+   print *,' '
+   print *,'------------------------------------'
+   print *,'UNIT TEST FOR VERTICAL INTERPOLATION'
+   print *,'------------------------------------'
+   print *,' '
+   do lagrange_order = 1 , 2
+      print *,' '
+      print *,'------------------------------------'
+      print *,'Lagrange Order = ',lagrange_order
+      print *,'------------------------------------'
+      print *,' '
+      call fillitup ( fo , po , fn_calc , pn , &
+                    ids , ide , jds , jde , kds , kde , &
+                    ims , ime , jms , jme , kms , kme , &
+                    its , ite , jts , jte , kts , kte , &
+                    generic , lagrange_order )
+   
+      print *,' ' 
+      print *,'Level   Pressure     Field'
+      print *,'          (Pa)      (generic)'
+      print *,'------------------------------------'
+      print *,' ' 
+      do k = 1 , generic
+      write (*,fmt='(i2,2x,f12.3,1x,g15.8)' ) &
+         k,po(2,k,2),fo(2,k,2)
+      end do
+      print *,' '
+   
+      call vert_interp ( fo , po , fn_interp , pn , &
+                         generic , 'T' , &
+                         interp_type , lagrange_order , lowest_lev_from_sfc , &
+                         zap_close_levels , force_sfc_in_vinterp , &
+                         ids , ide , jds , jde , kds , kde , &
+                         ims , ime , jms , jme , kms , kme , &
+                         its , ite , jts , jte , kts , kte )
+   
+      print *,'Multi-Order Interpolator'
+      print *,'------------------------------------'
+      print *,' '
+      print *,'Level  Pressure      Field           Field         Field'
+      print *,'         (Pa)        Calc            Interp        Diff'
+      print *,'------------------------------------'
+      print *,' '
+      do k = kts , kte-1
+      write (*,fmt='(i2,2x,f12.3,1x,3(g15.7))' ) &
+         k,pn(2,k,2),fn_calc(2,k,2),fn_interp(2,k,2),fn_calc(2,k,2)-fn_interp(2,k,2)
+      end do
+   
+      call vert_interp_old ( fo , po , fn_interp , pn , &
+                         generic , 'T' , &
+                         interp_type , lagrange_order , lowest_lev_from_sfc , &
+                         zap_close_levels , force_sfc_in_vinterp , &
+                         ids , ide , jds , jde , kds , kde , &
+                         ims , ime , jms , jme , kms , kme , &
+                         its , ite , jts , jte , kts , kte )
+   
+      print *,'Linear Interpolator'
+      print *,'------------------------------------'
+      print *,' '
+      print *,'Level  Pressure      Field           Field         Field'
+      print *,'         (Pa)        Calc            Interp        Diff'
+      print *,'------------------------------------'
+      print *,' '
+      do k = kts , kte-1
+      write (*,fmt='(i2,2x,f12.3,1x,3(g15.7))' ) &
+         k,pn(2,k,2),fn_calc(2,k,2),fn_interp(2,k,2),fn_calc(2,k,2)-fn_interp(2,k,2)
+      end do
+   end do
+
+end program vint
+
+subroutine wrf_error_fatal (string)
+   character (len=*) :: string
+   print *,string
+   stop
+end subroutine wrf_error_fatal
+
+subroutine fillitup ( fo , po , fn , pn , &
+                    ids , ide , jds , jde , kds , kde , &
+                    ims , ime , jms , jme , kms , kme , &
+                    its , ite , jts , jte , kts , kte , &
+                    generic , lagrange_order )
+
+   implicit none
+
+   integer , intent(in) :: ids , ide , jds , jde , kds , kde , &
+              ims , ime , jms , jme , kms , kme , &
+              its , ite , jts , jte , kts , kte
+
+   integer , intent(in) :: generic , lagrange_order
+
+   real , dimension(ims:ime,generic,jms:jme) , intent(out) :: fo , po
+   real , dimension(ims:ime,kms:kme,jms:jme) , intent(out) :: fn , pn
+
+   integer :: i , j , k
+   
+   real , parameter :: piov2 = 3.14159265358 / 2.
+
+   k = 1
+   do j = jts , jte
+   do i = its , ite
+      po(i,k,j) = 102000.
+   end do
+   end do
+   
+   do k = 2 , generic
+   do j = jts , jte
+   do i = its , ite
+      po(i,k,j) = ( 5000. * ( 1 - (k-1) ) + 100000. * ( (k-1) - (generic-1) ) ) / (1. - real(generic-1) )
+   end do
+   end do
+   end do
+
+   if ( lagrange_order .eq. 1 ) then
+      do k = 1 , generic
+      do j = jts , jte
+      do i = its , ite
+         fo(i,k,j) = po(i,k,j)
+!        fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   else if ( lagrange_order .eq. 2 ) then
+      do k = 1 , generic
+      do j = jts , jte
+      do i = its , ite
+         fo(i,k,j) = (((po(i,k,j)-5000.)/102000.)*((102000.-po(i,k,j))/102000.))*102000.
+!        fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   end if
+
+!!!!!!!!!!!!
+   
+   do k = kts , kte
+   do j = jts , jte
+   do i = its , ite
+      pn(i,k,j) = ( 5000. * ( 0 - (k-1) ) + 102000. * ( (k-1) - (kte-1) ) ) / (-1. *  real(kte-1) )
+   end do
+   end do
+   end do
+   
+   do k = kts , kte-1
+   do j = jts , jte
+   do i = its , ite
+      pn(i,k,j) = ( pn(i,k,j) + pn(i,k+1,j) ) /2.
+   end do
+   end do
+   end do
+
+
+   if ( lagrange_order .eq. 1 ) then
+      do k = kts , kte-1
+      do j = jts , jte
+      do i = its , ite
+         fn(i,k,j) = pn(i,k,j)
+!        fn(i,k,j) = sin(pn(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   else if ( lagrange_order .eq. 2 ) then
+      do k = kts , kte-1
+      do j = jts , jte
+      do i = its , ite
+         fn(i,k,j) = (((pn(i,k,j)-5000.)/102000.)*((102000.-pn(i,k,j))/102000.))*102000.
+!        fn(i,k,j) = sin(pn(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   end if
+
+end subroutine fillitup
+
+#endif
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE vert_interp ( fo , po , fnew , pnu , &
+                            generic , var_type , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+   !  Vertically interpolate the new field.  The original field on the original
+   !  pressure levels is provided, and the new pressure surfaces to interpolate to.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: interp_type , lagrange_order
+      LOGICAL , INTENT(IN)        :: lowest_lev_from_sfc
+      REAL    , INTENT(IN)        :: zap_close_levels
+      INTEGER , INTENT(IN)        :: force_sfc_in_vinterp
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+      INTEGER , INTENT(IN)        :: generic
+
+      CHARACTER (LEN=1) :: var_type 
+
+      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(IN)     :: fo , po
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: pnu
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: fnew
+
+      REAL , DIMENSION(ims:ime,generic,jms:jme)                  :: forig , porig
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme)                  :: pnew
+
+      !  Local vars
+
+      INTEGER :: i , j , k , ko , kn , k1 , k2 , ko_1 , ko_2 , knext
+      INTEGER :: istart , iend , jstart , jend , kstart , kend 
+      INTEGER , DIMENSION(ims:ime,kms:kme        )               :: k_above , k_below
+      INTEGER , DIMENSION(ims:ime                )               :: ks
+      INTEGER , DIMENSION(ims:ime                )               :: ko_above_sfc
+      INTEGER :: count , zap , kst
+
+      LOGICAL :: any_below_ground
+
+      REAL :: p1 , p2 , pn, hold
+      REAL , DIMENSION(1:generic) :: ordered_porig , ordered_forig
+      REAL , DIMENSION(kts:kte) :: ordered_pnew , ordered_fnew
+
+!****MARS
+!big problems ... discontinuity in the interpolated fields ...
+print *, '25/05/2007: decided to use simple linear interpolations'
+print *, 'use that one at your own risk'
+!stop
+!****MARS
+
+
+      !  Horiontal loop bounds for different variable types.
+
+      IF      ( var_type .EQ. 'U' ) THEN
+         istart = its
+         iend   = ite
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  porig(i,k,j) = ( po(i,k,j) + po(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = 1,generic
+                  porig(its,k,j) =  po(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = 1,generic
+                  porig(ite,k,j) =  po(ite-1,k,j)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = kstart,kend
+                  pnew(its,k,j) =  pnu(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = kstart,kend
+                  pnew(ite,k,j) =  pnu(ite-1,k,j)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( var_type .EQ. 'V' ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = jte
+         kstart = kts
+         kend   = kte-1
+         DO i = istart,iend
+            DO k = 1,generic
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  porig(i,k,j) = ( po(i,k,j) + po(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = 1,generic
+                  porig(i,k,jts) =  po(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+               DO k = 1,generic
+                  porig(i,k,jte) =  po(i,k,jte-1)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = kstart,kend
+                  pnew(i,k,jts) =  pnu(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+              DO k = kstart,kend
+                  pnew(i,k,jte) =  pnu(i,k,jte-1)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( ( var_type .EQ. 'W' ) .OR.  ( var_type .EQ. 'Z' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE IF ( ( var_type .EQ. 'T' ) .OR. ( var_type .EQ. 'Q' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      END IF
+
+      DO j = jstart , jend
+
+         !  The lowest level is the surface.  Levels 2 through "generic" are supposed to
+         !  be "bottom-up".  Flip if they are not.  This is based on the input pressure 
+         !  array.
+
+         IF      ( porig(its,2,j) .LT. porig(its,generic,j) ) THEN
+            DO kn = 2 , ( generic + 1 ) / 2
+               DO i = istart , iend
+                  hold                    = porig(i,kn,j) 
+                  porig(i,kn,j)           = porig(i,generic+2-kn,j)
+                  porig(i,generic+2-kn,j) = hold
+                  forig(i,kn,j)           = fo   (i,generic+2-kn,j)
+                  forig(i,generic+2-kn,j) = fo   (i,kn,j)
+               END DO
+               DO i = istart , iend
+                  forig(i,1,j)           = fo   (i,1,j)
+               END DO
+            END DO
+         ELSE
+            DO kn = 1 , generic
+               DO i = istart , iend
+                  forig(i,kn,j)          = fo   (i,kn,j)
+               END DO
+            END DO
+         END IF
+    
+         !  Skip all of the levels below ground in the original data based upon the surface pressure.
+         !  The ko_above_sfc is the index in the pressure array that is above the surface.  If there
+         !  are no levels underground, this is index = 2.  The remaining levels are eligible for use
+         !  in the vertical interpolation.
+   
+         DO i = istart , iend
+            ko_above_sfc(i) = -1
+         END DO
+         DO ko = kstart+1 , kend
+            DO i = istart , iend
+               IF ( ko_above_sfc(i) .EQ. -1 ) THEN
+                  IF ( porig(i,1,j) .GT. porig(i,ko,j) ) THEN
+                     ko_above_sfc(i) = ko
+                  END IF
+               END IF
+            END DO
+         END DO
+
+         !  Piece together columns of the original input data.  Pass the vertical columns to
+         !  the iterpolator.
+
+         DO i = istart , iend
+
+            !  If the surface value is in the middle of the array, three steps: 1) do the
+            !  values below the ground (this is just to catch the occasional value that is
+            !  inconsistently below the surface based on input data), 2) do the surface level, then 
+            !  3) add in the levels that are above the surface.  For the levels next to the surface,
+            !  we check to remove any levels that are "too close".  When building the column of input
+            !  pressures, we also attend to the request for forcing the surface analysis to be used
+            !  in a few lower eta-levels.
+
+            !  How many levels have we skipped in the input column.
+
+            zap = 0
+
+            !  Fill in the column from up to the level just below the surface with the input
+            !  presssure and the input field (orig or old, which ever).  For an isobaric input
+            !  file, this data is isobaric.
+
+            IF (  ko_above_sfc(i) .GT. 2 ) THEN
+               count = 1
+               DO ko = 2 , ko_above_sfc(i)-1
+                  ordered_porig(count) = porig(i,ko,j)
+                  ordered_forig(count) = forig(i,ko,j)
+                  count = count + 1
+               END DO
+
+               !  Make sure the pressure just below the surface is not "too close", this
+               !  will cause havoc with the higher order interpolators.  In case of a "too close"
+               !  instance, we toss out the offending level (NOT the surface one) by simply
+               !  decrementing the accumulating loop counter.
+
+               IF ( ordered_porig(count-1) - porig(i,1,j) .LT. zap_close_levels ) THEN
+                  count = count -1
+                  zap = 1
+               END IF
+
+               !  Add in the surface values.
+   
+               ordered_porig(count) = porig(i,1,j)
+               ordered_forig(count) = forig(i,1,j)
+               count = count + 1
+
+               !  A usual way to do the vertical interpolation is to pay more attention to the 
+               !  surface data.  Why?  Well it has about 20x the density as the upper air, so we 
+               !  hope the analysis is better there.  We more strongly use this data by artificially
+               !  tossing out levels above the surface that are beneath a certain number of prescribed
+               !  eta levels at this (i,j).  The "zap" value is how many levels of input we are 
+               !  removing, which is used to tell the interpolator how many valid values are in 
+               !  the column.  The "count" value is the increment to the index of levels, and is
+               !  only used for assignments.
+
+               IF ( force_sfc_in_vinterp .GT. 0 ) THEN
+
+                  !  Get the pressure at the eta level.  We want to remove all input pressure levels
+                  !  between the level above the surface to the pressure at this eta surface.  That 
+                  !  forces the surface value to be used through the selected eta level.  Keep track
+                  !  of two things: the level to use above the eta levels, and how many levels we are
+                  !  skipping.
+
+                  knext = ko_above_sfc(i)
+                  find_level : DO ko = ko_above_sfc(i) , generic
+                     IF ( porig(i,ko,j) .LE. pnew(i,force_sfc_in_vinterp,j) ) THEN
+                        knext = ko
+                        exit find_level
+                     ELSE
+                        zap = zap + 1
+                     END IF
+                  END DO find_level
+
+               !  No request for special interpolation, so we just assign the next level to use
+               !  above the surface as, ta da, the first level above the surface.  I know, wow.
+
+               ELSE
+                  knext = ko_above_sfc(i)
+               END IF
+
+               !  One more time, make sure the pressure just above the surface is not "too close", this
+               !  will cause havoc with the higher order interpolators.  In case of a "too close"
+               !  instance, we toss out the offending level above the surface (NOT the surface one) by simply
+               !  incrementing the loop counter.  Here, count-1 is the surface level and knext is either
+               !  the next level up OR it is the level above the prescribed number of eta surfaces.
+
+               IF ( ordered_porig(count-1) - porig(i,knext,j) .LT. zap_close_levels ) THEN
+                  kst = knext+1
+                  zap = zap + 1
+               ELSE
+                  kst = knext
+               END IF
+   
+               DO ko = kst , generic
+                  ordered_porig(count) = porig(i,ko,j)
+                  ordered_forig(count) = forig(i,ko,j)
+                  count = count + 1
+               END DO
+
+            !  This is easy, the surface is the lowest level, just stick them in, in this order.  OK,
+            !  there are a couple of subtleties.  We have to check for that special interpolation that
+            !  skips some input levels so that the surface is used for the lowest few eta levels.  Also,
+            !  we must macke sure that we still do not have levels that are "too close" together.
+            
+            ELSE
+        
+               !  Initialize no input levels have yet been removed from consideration.
+
+               zap = 0
+
+               !  The surface is the lowest level, so it gets set right away to location 1.
+
+               ordered_porig(1) = porig(i,1,j)
+               ordered_forig(1) = forig(i,1,j)
+
+               !  We start filling in the array at loc 2, as in just above the level we just stored.
+
+               count = 2
+
+               !  Are we forcing the interpolator to skip valid input levels so that the
+               !  surface data is used through more levels?  Essentially as above.
+
+               IF ( force_sfc_in_vinterp .GT. 0 ) THEN
+                  knext = 2
+                  find_level2: DO ko = 2 , generic
+                     IF ( porig(i,ko,j) .LE. pnew(i,force_sfc_in_vinterp,j) ) THEN
+                        knext = ko
+                        exit find_level2
+                     ELSE
+                        zap = zap + 1
+                     END IF
+                  END DO find_level2
+               ELSE
+                  knext = 2
+               END IF
+
+               !  Fill in the data above the surface.  The "knext" index is either the one
+               !  just above the surface OR it is the index associated with the level that
+               !  is just above the pressure at this (i,j) of the top eta level that is to
+               !  be directly impacted with the surface level in interpolation.
+
+               DO ko = knext , generic
+                  IF ( ordered_porig(count-1) - porig(i,ko,j) .LT. zap_close_levels ) THEN
+                     zap = zap + 1
+                     CYCLE
+                  END IF
+                  ordered_porig(count) = porig(i,ko,j)
+                  ordered_forig(count) = forig(i,ko,j)
+                  count = count + 1
+               END DO
+
+            END IF
+
+            !  Now get the column of the "new" pressure data.  So, this one is easy.
+
+            DO kn = kstart , kend
+               ordered_pnew(kn) = pnew(i,kn,j)
+            END DO
+
+            !  The polynomials are either in pressure or LOG(pressure).
+
+            IF ( interp_type .EQ. 1 ) THEN
+               CALL lagrange_setup ( var_type , &
+                   ordered_porig                 , ordered_forig , generic-zap   , lagrange_order , &
+                   ordered_pnew                  , ordered_fnew  , kend-kstart+1 ,i,j)
+            ELSE
+               CALL lagrange_setup ( var_type , &
+               LOG(ordered_porig(1:generic-zap)) , ordered_forig , generic-zap   , lagrange_order , &
+               LOG(ordered_pnew(kstart:kend))    , ordered_fnew  , kend-kstart+1 ,i,j)
+            END IF
+
+            !  Save the computed data.
+
+            DO kn = kstart , kend
+               fnew(i,kn,j) = ordered_fnew(kn)
+            END DO
+
+            !  There may have been a request to have the surface data from the input field
+            !  to be assigned as to the lowest eta level.  This assumes thin layers (usually
+            !  the isobaric original field has the surface from 2-m T and RH, and 10-m U and V).
+
+            IF ( lowest_lev_from_sfc ) THEN
+               fnew(i,1,j) = forig(i,ko_above_sfc(i)-1,j)
+            END IF
+
+         END DO
+
+      END DO
+
+   END SUBROUTINE vert_interp
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE vert_interp_old ( forig , po , fnew , pnu , &
+                            generic , var_type , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+   !  Vertically interpolate the new field.  The original field on the original
+   !  pressure levels is provided, and the new pressure surfaces to interpolate to.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: interp_type , lagrange_order
+      LOGICAL , INTENT(IN)        :: lowest_lev_from_sfc
+      REAL    , INTENT(IN)        :: zap_close_levels
+      INTEGER , INTENT(IN)        :: force_sfc_in_vinterp
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+      INTEGER , INTENT(IN)        :: generic
+
+      CHARACTER (LEN=1) :: var_type 
+
+!      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(IN)     :: forig , po
+!****MARS
+!error with g95 and warning with pgf90
+      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(IN)     :: po
+      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(INOUT)  :: forig
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: pnu
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: fnew
+
+      REAL , DIMENSION(ims:ime,generic,jms:jme)                  :: porig
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme)                  :: pnew
+
+      !  Local vars
+
+      INTEGER :: i , j , k , ko , kn , k1 , k2 , ko_1 , ko_2
+      INTEGER :: istart , iend , jstart , jend , kstart , kend 
+      INTEGER , DIMENSION(ims:ime,kms:kme        )               :: k_above , k_below
+      INTEGER , DIMENSION(ims:ime                )               :: ks
+      INTEGER , DIMENSION(ims:ime                )               :: ko_above_sfc
+
+      LOGICAL :: any_below_ground
+
+      REAL :: p1 , p2 , pn
+!****MARS
+integer vert_extrap
+integer kn_save
+vert_extrap = 0
+kn_save = 0
+!****MARS
+
+      !  Horizontal loop bounds for different variable types.
+
+      IF      ( var_type .EQ. 'U' ) THEN
+         istart = its
+         iend   = ite
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  porig(i,k,j) = ( po(i,k,j) + po(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = 1,generic
+                  porig(its,k,j) =  po(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = 1,generic
+                  porig(ite,k,j) =  po(ite-1,k,j)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = kstart,kend
+                  pnew(its,k,j) =  pnu(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = kstart,kend
+                  pnew(ite,k,j) =  pnu(ite-1,k,j)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( var_type .EQ. 'V' ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = jte
+         kstart = kts
+         kend   = kte-1
+         DO i = istart,iend
+            DO k = 1,generic
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  porig(i,k,j) = ( po(i,k,j) + po(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = 1,generic
+                  porig(i,k,jts) =  po(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+               DO k = 1,generic
+                  porig(i,k,jte) =  po(i,k,jte-1)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = kstart,kend
+                  pnew(i,k,jts) =  pnu(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+              DO k = kstart,kend
+                  pnew(i,k,jte) =  pnu(i,k,jte-1)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( ( var_type .EQ. 'W' ) .OR.  ( var_type .EQ. 'Z' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE IF ( ( var_type .EQ. 'T' ) .OR. ( var_type .EQ. 'Q' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      END IF
+
+
+      DO j = jstart , jend
+    
+         !  Skip all of the levels below ground in the original data based upon the surface pressure.
+         !  The ko_above_sfc is the index in the pressure array that is above the surface.  If there
+         !  are no levels underground, this is index = 2.  The remaining levels are eligible for use
+         !  in the vertical interpolation.
+   
+         DO i = istart , iend
+            ko_above_sfc(i) = -1
+         END DO
+         DO ko = kstart+1 , kend
+            DO i = istart , iend
+
+               IF ( ko_above_sfc(i) .EQ. -1 ) THEN
+                  IF ( porig(i,1,j) .GT. porig(i,ko,j) ) THEN
+                     ko_above_sfc(i) = ko
+!!****MARS
+!!old stuff
+!!
+!! Pressure level may be OK, however data from the diagfi is possibly missing
+!IF (forig(i,ko,j) .EQ. -1.0e+30) THEN
+!        ko_above_sfc(i) = -1
+!END IF
+!        !! Once the right start level is found, check that it is OK
+!        !! >> first column should be 1e30 or so, second column should be a realistic value
+!        !IF ( ko_above_sfc(i) .NE. -1 ) THEN
+!        !        print *, 'verif', forig(i,ko-1,j), forig(i,ko,j), forig(i,ko+1,j), ko
+!        !END IF
+!!
+!!****MARS
+                  END IF
+               END IF
+
+            END DO
+         END DO
+
+         !  Initialize interpolation location.  These are the levels in the original pressure
+         !  data that are physically below and above the targeted new pressure level.
+   
+         DO kn = kts , kte
+            DO i = its , ite
+               k_above(i,kn) = -1
+               k_below(i,kn) = -2
+            END DO
+         END DO
+    
+         !  Starting location is no lower than previous found location.  This is for O(n logn)
+         !  and not O(n^2), where n is the number of vertical levels to search.
+   
+         DO i = its , ite
+            ks(i) = 1
+         END DO
+
+         !  Find trapping layer for interpolation.  The kn index runs through all of the "new"
+         !  levels of data.
+   
+         DO kn = kstart , kend
+
+            DO i = istart , iend
+
+               !  For each "new" level (kn), we search to find the trapping levels in the "orig"
+               !  data.  Most of the time, the "new" levels are the eta surfaces, and the "orig"
+               !  levels are the input pressure levels.
+
+               found_trap_above : DO ko = ks(i) , generic-1
+
+                  !  Because we can have levels in the interpolation that are not valid,
+                  !  let's toss out any candidate orig pressure values that are below ground
+                  !  based on the surface pressure.  If the level =1, then this IS the surface
+                  !  level, so we HAVE to keep that one, but maybe not the ones above.  If the
+                  !  level (ks) is NOT=1, then we have to just CYCLE our loop to find a legit
+                  !  below-pressure value.  If we are not below ground, then we choose two
+                  !  neighboring levels to test whether they surround the new pressure level.
+
+                  !  The input trapping levels that we are trying is the surface and the first valid
+                  !  level above the surface.
+
+                  IF      ( ( ko .LT. ko_above_sfc(i) ) .AND. ( ko .EQ. 1 ) ) THEN
+                     ko_1 = ko
+                     ko_2 = ko_above_sfc(i)
+!!****MARS
+!!old remark: the possible issue is fixed later in the code ...
+!!****MARS
+     
+                  !  The "below" level is underground, cycle until we get to a valid pressure
+                  !  above ground.
+ 
+                  ELSE IF ( ( ko .LT. ko_above_sfc(i) ) .AND. ( ko .NE. 1 ) ) THEN
+                     CYCLE found_trap_above
+
+                  !  The "below" level is above the surface, so we are in the clear to test these
+                  !  two levels out.
+
+                  ELSE
+                     ko_1 = ko
+                     ko_2 = ko+1
+
+                  END IF
+
+
+                  !  The test of the candidate levels: "below" has to have a larger pressure, and
+                  !  "above" has to have a smaller pressure. 
+
+                  !  OK, we found the correct two surrounding levels.  The locations are saved for use in the
+                  !  interpolation.
+
+                  IF      ( ( porig(i,ko_1,j) .GE. pnew(i,kn,j) ) .AND. &
+                            ( porig(i,ko_2,j) .LT. pnew(i,kn,j) ) ) THEN
+                     k_above(i,kn) = ko_2
+                     k_below(i,kn) = ko_1
+                     ks(i) = ko_1
+                     EXIT found_trap_above
+
+                  !  What do we do is we need to extrapolate the data underground?  This happens when the
+                  !  lowest pressure that we have is physically "above" the new target pressure.  Our
+                  !  actions depend on the type of variable we are interpolating.
+
+                  ELSE IF   ( porig(i,1,j) .LT. pnew(i,kn,j) ) THEN
+!!****MARS
+!!old stuff
+!!check: values are usually quite close
+!print *,porig(i,1,j),pnew(i,kn,j)
+!!****MARS
+
+                     !  For horizontal winds and moisture, we keep a constant value under ground.
+
+                     IF      ( ( var_type .EQ. 'U' ) .OR. &
+                               ( var_type .EQ. 'V' ) .OR. &
+                               ( var_type .EQ. 'Q' ) ) THEN
+                        k_above(i,kn) = 1
+                        ks(i) = 1
+
+                     !  For temperature and height, we extrapolate the data.  Hopefully, we are not
+                     !  extrapolating too far.  For pressure level input, the eta levels are always
+                     !  contained within the surface to p_top levels, so no extrapolation is ever
+                     !  required.  
+
+                     ELSE IF ( ( var_type .EQ. 'Z' ) .OR. &
+                               ( var_type .EQ. 'T' ) ) THEN
+                        k_above(i,kn) = ko_above_sfc(i)
+                        k_below(i,kn) = 1
+                        ks(i) = 1
+!!!****MARS
+!!old stuff
+!k_above(i,kn) = 1
+!ks(i) = 1
+!!!"Hopefully, we are not extrapolating too far"
+!!!>> true on Mars ?? 
+!!!****MARS
+
+                     !  Just a catch all right now.
+
+                     ELSE
+                        k_above(i,kn) = 1
+                        ks(i) = 1
+                     END IF
+
+                     EXIT found_trap_above
+
+                  !  The other extrapolation that might be required is when we are going above the
+                  !  top level of the input data.  Usually this means we chose a P_PTOP value that
+                  !  was inappropriate, and we should stop and let someone fix this mess.  
+
+                  ELSE IF   ( porig(i,generic,j) .GT. pnew(i,kn,j) ) THEN
+                     print *,'data is too high, try a lower p_top'
+                     print *,'pnew=',pnew(i,kn,j),'i',i,'j',j,'kn',kn
+                        print *,'pnew=',pnew(i,:,j)
+                     print *,'porig=',porig(i,:,j)
+                     CALL wrf_error_fatal ('requested p_top is higher than input data, lower p_top')
+
+                  END IF
+               END DO found_trap_above
+            END DO
+         END DO
+
+         !  Linear vertical interpolation.
+
+         DO kn = kstart , kend
+            DO i = istart , iend
+               IF ( k_above(i,kn) .EQ. 1 ) THEN
+!!!****MARS
+!!old stuff
+!!!ne doit pas arriver avec la temperature si l'on definit bien le champ au sol
+!IF (forig(i,1,j) .EQ. -1.0e+30) THEN
+!        print *,'no data here - surface - var is ...',var_type,i,j,1
+!        print *,'setting to first level with data...',ko_above_sfc(i),porig(i,ko_above_sfc(i),j)
+!        forig(i,1,j) = forig(i,ko_above_sfc(i),j)
+!        !IF      ( ( var_type .EQ. 'U' ) .OR. &
+!        !    ( var_type .EQ. 'V' ) .OR. &
+!        !    ( var_type .EQ. 'Q' ) ) THEN
+!        !    print *,'zero wind at the ground'
+!        !    forig(i,1,j) = 0
+!        !ENDIF
+!               IF (forig(i,1,j) .EQ. -1.0e+30) THEN
+!                print *,'well ... are you sure ?'
+!                stop
+!                ENDIF
+!END IF
+!!!****MARS
+                  fnew(i,kn,j) = forig(i,1,j)
+               ELSE
+                  k2 = MAX ( k_above(i,kn) , 2)
+                  k1 = MAX ( k_below(i,kn) , 1)
+                  IF ( k1 .EQ. k2 ) THEN
+                     CALL wrf_error_fatal ( 'identical values in the interp, bad for divisions' )
+                  END IF
+!!!****MARS
+!!old stuff
+!IF (forig(i,k2,j) .EQ. -1.0e+30) THEN
+!        print *,'no data here - level above - you_d better stop',i,j,k2
+!        stop        
+!END IF
+!IF (forig(i,k1,j) .EQ. -1.0e+30) THEN
+!        print *,'no data here - level below - var is ...',var_type,i,j,k1
+!        print *,'setting to first level with data...',ko_above_sfc(i),porig(i,ko_above_sfc(i),j)
+!        forig(i,k1,j) = forig(i,ko_above_sfc(i),j)
+!        !!!VERIFIER QUE LA TEMPERATURE AU SOL N'EST PAS CONCERNEE
+!        !!!(montagnes=sources locales de chaleur)
+!        !!!normalement, pas de souci, et lors de l'exécution rien ne s'affiche
+!END IF
+!!!****MARS
+                  IF      ( interp_type .EQ. 1 ) THEN
+                     p1 = porig(i,k1,j)
+                     p2 = porig(i,k2,j)
+                     pn = pnew(i,kn,j)  
+                  ELSE IF ( interp_type .EQ. 2 ) THEN
+                     p1 = ALOG(porig(i,k1,j))
+                     p2 = ALOG(porig(i,k2,j))
+                     pn = ALOG(pnew(i,kn,j))
+                  END IF
+                  IF ( ( p1-pn) * (p2-pn) > 0. ) THEN
+!                    CALL wrf_error_fatal ( 'both trapping pressures are on the same side of the new pressure' )
+!                    CALL wrf_debug ( 0 , 'both trapping pressures are on the same side of the new pressure' )
+!!!****MARS
+vert_extrap = vert_extrap + 1
+!print *, 'extrapolate', pnew(i,kn,j)-porig(i,k1,j), 'for WRF level', kn
+IF (kn_save < kn) kn_save=kn
+!!!****MARS
+                  END IF
+                  fnew(i,kn,j) = ( forig(i,k1,j) * ( p2 - pn )   + &
+                                   forig(i,k2,j) * ( pn - p1 ) ) / &
+                                   ( p2 - p1 )
+               END IF 
+            END DO
+         END DO
+
+         search_below_ground : DO kn = kstart , kend
+            any_below_ground = .FALSE.
+            DO i = istart , iend
+               IF ( k_above(i,kn) .EQ. 1 ) THEN 
+                  fnew(i,kn,j) = forig(i,1,j)
+                  any_below_ground = .TRUE.
+               END IF
+            END DO
+            IF ( .NOT. any_below_ground ) THEN
+               EXIT search_below_ground
+            END IF
+         END DO search_below_ground
+
+         !  There may have been a request to have the surface data from the input field
+         !  to be assigned as to the lowest eta level.  This assumes thin layers (usually
+         !  the isobaric original field has the surface from 2-m T and RH, and 10-m U and V).
+
+
+         DO i = istart , iend
+            IF ( lowest_lev_from_sfc ) THEN
+               fnew(i,1,j) = forig(i,ko_above_sfc(i),j)
+            END IF
+         END DO
+
+      END DO
+print *,'VERT EXTRAP = ', vert_extrap
+print *,'finished with ... ', var_type
+print *,'max WRF eta level where extrap. occurs: ',kn_save
+
+   END SUBROUTINE vert_interp_old
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE lagrange_setup ( var_type , all_x , all_y , all_dim , n , target_x , target_y , target_dim ,i,j)
+
+      !  We call a Lagrange polynomial interpolator.  The parallel concerns are put off as this
+      !  is initially set up for vertical use.  The purpose is an input column of pressure (all_x),
+      !  and the associated pressure level data (all_y).  These are assumed to be sorted (ascending
+      !  or descending, no matter).  The locations to be interpolated to are the pressures in
+      !  target_x, probably the new vertical coordinate values.  The field that is output is the
+      !  target_y, which is defined at the target_x location.  Mostly we expect to be 2nd order
+      !  overlapping polynomials, with only a single 2nd order method near the top and bottom.
+      !  When n=1, this is linear; when n=2, this is a second order interpolator.
+
+      IMPLICIT NONE
+
+      CHARACTER (LEN=1) :: var_type
+      INTEGER , INTENT(IN) :: all_dim , n , target_dim
+      REAL, DIMENSION(all_dim) , INTENT(IN) :: all_x , all_y
+      REAL , DIMENSION(target_dim) , INTENT(IN) :: target_x
+      REAL , DIMENSION(target_dim) , INTENT(OUT) :: target_y
+
+      !  Brought in for debug purposes, all of the computations are in a single column.
+
+      INTEGER , INTENT(IN) :: i,j
+
+      !  Local vars
+
+      REAL , DIMENSION(n+1) :: x , y 
+      REAL :: target_y_1 , target_y_2
+      LOGICAL :: found_loc
+      INTEGER :: loop , loc_center_left , loc_center_right , ist , iend , target_loop
+
+
+      IF ( all_dim .LT. n+1 ) THEN
+print *,'all_dim = ',all_dim
+print *,'order = ',n
+print *,'i,j = ',i,j
+print *,'p array = ',all_x
+print *,'f array = ',all_y
+print *,'p target= ',target_x
+         CALL wrf_error_fatal ( 'troubles, the interpolating order is too large for this few input values' )
+      END IF
+
+      IF ( n .LT. 1 ) THEN
+         CALL wrf_error_fatal ( 'pal, linear is about as low as we go' )
+      END IF
+
+      !  Loop over the list of target x and y values.
+
+      DO target_loop = 1 , target_dim
+
+         !  Find the two trapping x values, and keep the indices.
+   
+         found_loc = .FALSE.
+         find_trap : DO loop = 1 , all_dim -1
+            IF ( ( target_x(target_loop) - all_x(loop) ) * ( target_x(target_loop) - all_x(loop+1) ) .LE. 0.0 ) THEN
+               loc_center_left  = loop
+               loc_center_right = loop+1
+               found_loc = .TRUE.
+!****MARS: check if no errors here
+!print *,'interpolating ... ',var_type
+!       print *,'i,j = ',i,j
+!       print *,'target pressure and value = ',target_x(target_loop),target_y(target_loop)
+!       DO loop = 1 , all_dim
+!         print *,'column of pressure and value = ',all_x(loop),all_y(loop)
+!       END DO
+!END IF  
+!****MARS
+               EXIT find_trap
+            END IF
+         END DO find_trap
+   
+         IF ( ( .NOT. found_loc ) .AND. ( target_x(target_loop) .GT. all_x(1) ) ) THEN
+            IF ( var_type .EQ. 'T' ) THEN
+write(6,fmt='(A,2i5,2f11.3)') &
+' --> extrapolating TEMPERATURE near sfc: i,j,psfc, p target = ',&
+i,j,all_x(1),target_x(target_loop)
+               target_y(target_loop) = ( all_y(1) * ( target_x(target_loop) - all_x(2) ) + &
+                                         all_y(2) * ( all_x(1) - target_x(target_loop) ) ) / &
+                                       ( all_x(1) - all_x(2) ) 
+            ELSE 
+!write(6,fmt='(A,2i5,2f11.3)') &
+!' --> extrapolating zero gradient near sfc: i,j,psfc, p target = ',&
+!i,j,all_x(1),target_x(target_loop)
+               target_y(target_loop) = all_y(1)
+            END IF
+            CYCLE
+         ELSE IF ( .NOT. found_loc ) THEN
+!****MARS: normally, no errors here (otherwise, keep this part commented ?)
+            print *, var_type
+            print *,'i,j = ',i,j
+            print *,'target pressure and value = ',target_x(target_loop),target_y(target_loop)
+            DO loop = 1 , all_dim
+               print *,'column of pressure and value = ',all_x(loop),all_y(loop)
+            END DO
+           CALL wrf_error_fatal ( 'troubles, could not find trapping x locations' )
+!****MARS: end of 'keep this part commented'
+         END IF
+   
+         !  Even or odd order?  We can put the value in the middle if this is
+         !  an odd order interpolator.  For the even guys, we'll do it twice
+         !  and shift the range one index, then get an average.
+   
+         IF      ( MOD(n,2) .NE. 0 ) THEN
+            IF ( ( loc_center_left -(((n+1)/2)-1) .GE.       1 ) .AND. &
+                 ( loc_center_right+(((n+1)/2)-1) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n+1)/2)-1)
+               iend = iend + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y(target_loop) )
+            ELSE
+               IF ( .NOT. found_loc ) THEN
+                  CALL wrf_error_fatal ( 'I doubt this will happen, I will only do 2nd order for now' )
+               END IF
+            END IF
+   
+         ELSE IF ( MOD(n,2) .EQ. 0 ) THEN
+            IF      ( ( loc_center_left -(((n  )/2)-1) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)  ) .LE. all_dim ) .AND. &
+                      ( loc_center_left -(((n  )/2)  ) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)-1) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n  )/2)-1)
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y_1              )
+               ist  = loc_center_left -(((n  )/2)  )
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y_2              )
+               target_y(target_loop) = ( target_y_1 + target_y_2 ) * 0.5
+   
+            ELSE IF ( ( loc_center_left -(((n  )/2)-1) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)  ) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n  )/2)-1)
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y(target_loop)   )
+            ELSE IF ( ( loc_center_left -(((n  )/2)  ) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)-1) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n  )/2)  )
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y(target_loop)   )
+            ELSE
+               CALL wrf_error_fatal ( 'unauthorized area, you should not be here' )
+            END IF
+               
+         END IF
+
+      END DO
+
+   END SUBROUTINE lagrange_setup 
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE lagrange_interp ( x , y , n , target_x , target_y )
+
+      !  Interpolation using Lagrange polynomials.
+      !  P(x) = f(x0)Ln0(x) + ... + f(xn)Lnn(x)
+      !  where Lnk(x) = (x -x0)(x -x1)...(x -xk-1)(x -xk+1)...(x -xn)
+      !                 ---------------------------------------------
+      !                 (xk-x0)(xk-x1)...(xk-xk-1)(xk-xk+1)...(xk-xn)
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: n
+      REAL , DIMENSION(0:n) , INTENT(IN) :: x , y
+      REAL , INTENT(IN) :: target_x
+
+      REAL , INTENT(OUT) :: target_y
+
+      !  Local vars
+
+      INTEGER :: i , k
+      REAL :: numer , denom , Px
+      REAL , DIMENSION(0:n) :: Ln
+
+      Px = 0.
+      DO i = 0 , n
+         numer = 1.         
+         denom = 1.         
+         DO k = 0 , n
+            IF ( k .EQ. i ) CYCLE
+            numer = numer * ( target_x  - x(k) )
+            denom = denom * ( x(i)  - x(k) )
+         END DO
+         Ln(i) = y(i) * numer / denom
+         Px = Px + Ln(i)
+      END DO
+      target_y = Px
+
+   END SUBROUTINE lagrange_interp
+
+#ifndef VERT_UNIT
+!---------------------------------------------------------------------
+
+   SUBROUTINE p_dry ( mu0 , eta , pdht , pdry , &
+                             ids , ide , jds , jde , kds , kde , &
+                             ims , ime , jms , jme , kms , kme , &
+                             its , ite , jts , jte , kts , kte )
+
+   !  Compute reference pressure and the reference mu.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(IN)     :: mu0
+      REAL , DIMENSION(        kms:kme        ) , INTENT(IN)     :: eta
+      REAL                                                       :: pdht
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: pdry
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+      REAL , DIMENSION(        kms:kme        )                  :: eta_h
+
+      DO k = kts , kte-1
+         eta_h(k) = ( eta(k) + eta(k+1) ) * 0.5
+      END DO
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO k = kts , kte-1
+            DO i = its , MIN (ide-1 , ite )
+                  pdry(i,k,j) = eta_h(k) * mu0(i,j) + pdht
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE p_dry
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE p_dts ( pdts , intq , psfc , p_top , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Compute difference between the dry, total surface pressure and the top pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , INTENT(IN) :: p_top
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN)     :: psfc
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN)     :: intq
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(OUT)    :: pdts
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+               pdts(i,j) = psfc(i,j) - intq(i,j) - p_top
+         END DO
+      END DO
+
+   END SUBROUTINE p_dts
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE p_dhs ( pdhs , ht , p0 , t0 , a , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Compute dry, hydrostatic surface pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(IN)     :: ht
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(OUT)    :: pdhs
+
+      REAL , INTENT(IN) :: p0 , t0 , a
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+!****MARS ....
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: g  =   3.72
+print *,'compute dry, hydrostatic surface pressure'
+!****MARS ....
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+               pdhs(i,j) = p0 * EXP ( -t0/a + SQRT ( (t0/a)**2 - 2. * g * ht(i,j)/(a * Rd) ) )
+         END DO
+      END DO
+
+!****MARS
+!****MARS cette formule est-elle juste sur Mars ?
+!****MARS >> a premiere vue, ne donne pas de resultats absurdes
+!****TODO: il y a peut etre meilleur !
+!****MARS
+
+!print *,pdhs
+!stop
+
+
+   END SUBROUTINE p_dhs
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE find_p_top ( p , p_top , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte )
+
+   !  Find the largest pressure in the top level.  This is our p_top.  We are
+   !  assuming that the top level is the location where the pressure is a minimum
+   !  for each column.  In cases where the top surface is not isobaric, a 
+   !  communicated value must be shared in the calling routine.  Also in cases
+   !  where the top surface is not isobaric, care must be taken that the new
+   !  maximum pressure is not greater than the previous value.  This test is
+   !  also handled in the calling routine.
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL :: p_top
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: p
+
+      !  Local vars
+
+      INTEGER :: i , j , k, min_lev
+
+      i = its
+      j = jts
+      p_top = p(i,2,j)
+      min_lev = 2
+      DO k = 2 , kte
+         IF ( p_top .GT. p(i,k,j) ) THEN
+            p_top = p(i,k,j)
+            min_lev = k
+         END IF
+      END DO
+
+      k = min_lev
+      p_top = p(its,k,jts)
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+            p_top = MAX ( p_top , p(i,k,j) )
+         END DO
+      END DO
+
+   END SUBROUTINE find_p_top
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE t_to_theta ( t , p , p00 , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Compute dry, hydrostatic surface pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , INTENT(IN) :: p00
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: p
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT)  :: t
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+!****MARS 
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: Cp = 844.6
+!****MARS
+      
+      DO j = jts , MIN ( jde-1 , jte )
+         DO k = kts , kte
+            DO i = its , MIN (ide-1 , ite )
+               t(i,k,j) = t(i,k,j) * ( p00 / p(i,k,j) ) ** (Rd / Cp)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE t_to_theta
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE integ_moist ( q_in , p_in , pd_out , t_in , ght_in , intq , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+   !  Integrate the moisture field vertically.  Mostly used to get the total
+   !  vapor pressure, which can be subtracted from the total pressure to get
+   !  the dry pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: q_in , p_in , t_in , ght_in
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: pd_out
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(OUT)    :: intq
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+      INTEGER , DIMENSION(ims:ime) :: level_above_sfc
+      REAL , DIMENSION(ims:ime,jms:jme) :: psfc , tsfc , qsfc, zsfc
+      REAL , DIMENSION(ims:ime,kms:kme) :: q , p , t , ght, pd
+
+      REAL :: rhobar , qbar , dz
+      REAL :: p1 , p2 , t1 , t2 , q1 , q2 , z1, z2
+  
+      LOGICAL :: upside_down
+
+!****MARS
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: g  =   3.72
+!****MARS
+      
+
+      !  Get a surface value, always the first level of a 3d field.
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+            psfc(i,j) = p_in(i,kts,j)
+            tsfc(i,j) = t_in(i,kts,j)
+            qsfc(i,j) = q_in(i,kts,j)
+            zsfc(i,j) = ght_in(i,kts,j)
+         END DO
+      END DO
+
+      IF ( p_in(its,kts+1,jts) .LT. p_in(its,kte,jts) ) THEN
+         upside_down = .TRUE.
+      ELSE
+         upside_down = .FALSE.
+      END IF
+
+      DO j = jts , MIN ( jde-1 , jte )
+
+         !  Initialize the integrated quantity of moisture to zero.
+
+         DO i = its , MIN (ide-1 , ite )
+            intq(i,j) = 0.
+         END DO
+
+         IF ( upside_down ) THEN
+            DO i = its , MIN (ide-1 , ite )
+               p(i,kts) = p_in(i,kts,j)
+               t(i,kts) = t_in(i,kts,j)
+               q(i,kts) = q_in(i,kts,j)
+               ght(i,kts) = ght_in(i,kts,j)
+               DO k = kts+1,kte
+                  p(i,k) = p_in(i,kte+2-k,j)
+                  t(i,k) = t_in(i,kte+2-k,j)
+                  q(i,k) = q_in(i,kte+2-k,j)
+                  ght(i,k) = ght_in(i,kte+2-k,j)
+               END DO
+            END DO
+         ELSE
+            DO i = its , MIN (ide-1 , ite )
+               DO k = kts,kte
+                  p(i,k) = p_in(i,k      ,j)
+                  t(i,k) = t_in(i,k      ,j)
+                  q(i,k) = q_in(i,k      ,j)
+                  ght(i,k) = ght_in(i,k      ,j)
+               END DO
+            END DO
+         END IF
+
+         !  Find the first level above the ground.  If all of the levels are above ground, such as
+         !  a terrain following lower coordinate, then the first level above ground is index #2.
+
+         DO i = its , MIN (ide-1 , ite )
+            level_above_sfc(i) = -1
+            IF ( p(i,kts+1) .LT. psfc(i,j) ) THEN
+               level_above_sfc(i) = kts+1
+            ELSE
+               find_k : DO k = kts+1,kte-1
+                  IF ( ( p(i,k  )-psfc(i,j) .GE. 0. ) .AND. &
+                       ( p(i,k+1)-psfc(i,j) .LT. 0. ) ) THEN 
+                     level_above_sfc(i) = k+1
+                     EXIT find_k
+                  END IF
+               END DO find_k
+               IF ( level_above_sfc(i) .EQ. -1 ) THEN
+print *,'i,j = ',i,j
+print *,'p = ',p(i,:)
+print *,'p sfc = ',psfc(i,j)
+                  CALL wrf_error_fatal ( 'Could not find level above ground')
+               END IF
+            END IF
+         END DO
+
+         DO i = its , MIN (ide-1 , ite )
+
+            !  Account for the moisture above the ground.
+
+            pd(i,kte) = p(i,kte)
+            DO k = kte-1,level_above_sfc(i),-1
+                  rhobar = ( p(i,k  ) / ( Rd * t(i,k  ) ) + &
+                             p(i,k+1) / ( Rd * t(i,k+1) ) ) * 0.5
+                  qbar   = ( q(i,k  ) + q(i,k+1) ) * 0.5
+                  dz     = ght(i,k+1) - ght(i,k)
+                  intq(i,j) = intq(i,j) + g * qbar * rhobar / (1. + qbar) * dz
+                  pd(i,k) = p(i,k) - intq(i,j)
+            END DO
+
+            !  Account for the moisture between the surface and the first level up.
+
+            IF ( ( p(i,level_above_sfc(i)-1)-psfc(i,j) .GE. 0. ) .AND. &
+                 ( p(i,level_above_sfc(i)  )-psfc(i,j) .LT. 0. ) .AND. &
+                 ( level_above_sfc(i) .GT. kts ) ) THEN
+               p1 = psfc(i,j)
+               p2 = p(i,level_above_sfc(i))
+               t1 = tsfc(i,j)
+               t2 = t(i,level_above_sfc(i))
+               q1 = qsfc(i,j)
+               q2 = q(i,level_above_sfc(i))
+               z1 = zsfc(i,j)
+               z2 = ght(i,level_above_sfc(i))
+               rhobar = ( p1 / ( Rd * t1 ) + &
+                          p2 / ( Rd * t2 ) ) * 0.5
+               qbar   = ( q1 + q2 ) * 0.5
+               dz     = z2 - z1
+               IF ( dz .GT. 0.1 ) THEN
+                  intq(i,j) = intq(i,j) + g * qbar * rhobar / (1. + qbar) * dz
+               END IF
+              
+               !  Fix the underground values.
+
+               DO k = level_above_sfc(i)-1,kts+1,-1
+                  pd(i,k) = p(i,k) - intq(i,j)
+               END DO
+            END IF
+            pd(i,kts) = psfc(i,j) - intq(i,j)
+
+         END DO
+
+         IF ( upside_down ) THEN
+            DO i = its , MIN (ide-1 , ite )
+               pd_out(i,kts,j) = pd(i,kts)
+               DO k = kts+1,kte
+                  pd_out(i,kte+2-k,j) = pd(i,k)
+               END DO
+            END DO
+         ELSE
+            DO i = its , MIN (ide-1 , ite )
+               DO k = kts,kte
+                  pd_out(i,k,j) = pd(i,k)
+               END DO
+            END DO
+         END IF
+
+      END DO
+
+
+!!!****MARS: no water vapor pressure
+!!    DO k = level_above_sfc(i)-1,kts+1,-1
+!!         pd(i,k) = p(i,k)
+!!    END DO
+!!    pd(i,kts) = psfc(i,j)
+!!!****MARS
+
+
+   END SUBROUTINE integ_moist
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE rh_to_mxrat (rh, t, p, q , wrt_liquid , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte )
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      LOGICAL , INTENT(IN)        :: wrt_liquid
+
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: p , t
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT)  :: rh
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: q
+
+      !  Local vars
+
+      INTEGER                     :: i , j , k 
+
+      REAL                        :: ew , q1 , t1
+!****MARS ....  regler si besoin ....
+!****MARS
+      REAL,         PARAMETER     :: T_REF       = 0.0
+      REAL,         PARAMETER     :: MW_AIR      = 28.966
+      REAL,         PARAMETER     :: MW_VAP      = 18.0152
+
+      REAL,         PARAMETER     :: A0       = 6.107799961
+      REAL,         PARAMETER     :: A1       = 4.436518521e-01
+      REAL,         PARAMETER     :: A2       = 1.428945805e-02
+      REAL,         PARAMETER     :: A3       = 2.650648471e-04
+      REAL,         PARAMETER     :: A4       = 3.031240396e-06
+      REAL,         PARAMETER     :: A5       = 2.034080948e-08
+      REAL,         PARAMETER     :: A6       = 6.136820929e-11
+
+      REAL,         PARAMETER     :: ES0 = 6.1121
+
+      REAL,         PARAMETER     :: C1       = 9.09718
+      REAL,         PARAMETER     :: C2       = 3.56654
+      REAL,         PARAMETER     :: C3       = 0.876793
+      REAL,         PARAMETER     :: EIS      = 6.1071
+      REAL                        :: RHS
+      REAL,         PARAMETER     :: TF       = 273.16
+      REAL                        :: TK
+
+      REAL                        :: ES
+      REAL                        :: QS
+      REAL,         PARAMETER     :: EPS         = 0.622
+      REAL,         PARAMETER     :: SVP1        = 0.6112
+      REAL,         PARAMETER     :: SVP2        = 17.67
+      REAL,         PARAMETER     :: SVP3        = 29.65
+      REAL,         PARAMETER     :: SVPT0       = 273.15
+!****MARS
+!****MARS
+
+
+      !  This subroutine computes mixing ratio (q, kg/kg) from basic variables
+      !  pressure (p, Pa), temperature (t, K) and relative humidity (rh, 1-100%).
+      !  The reference temperature (t_ref, C) is used to describe the temperature 
+      !  at which the liquid and ice phase change occurs.
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO k = kts , kte
+            DO i = its , MIN (ide-1 , ite )
+                  rh(i,k,j) = MIN ( MAX ( rh(i,k,j) ,  1. ) , 100. ) 
+            END DO
+         END DO
+      END DO
+
+      IF ( wrt_liquid ) THEN
+         DO j = jts , MIN ( jde-1 , jte )
+            DO k = kts , kte
+               DO i = its , MIN (ide-1 , ite )
+                  es=svp1*10.*EXP(svp2*(t(i,k,j)-svpt0)/(t(i,k,j)-svp3))
+                  qs=eps*es/(p(i,k,j)/100.-es)
+                  q(i,k,j)=MAX(.01*rh(i,k,j)*qs,0.0)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+         DO j = jts , MIN ( jde-1 , jte )
+            DO k = kts , kte
+               DO i = its , MIN (ide-1 , ite )
+
+                  t1 = t(i,k,j) - 273.16
+
+                  !  Obviously dry.
+
+                  IF ( t1 .lt. -200. ) THEN
+                     q(i,k,j) = 0
+
+                  ELSE
+
+                     !  First compute the ambient vapor pressure of water
+
+                     IF ( ( t1 .GE. t_ref ) .AND. ( t1 .GE. -47.) ) THEN    ! liq phase ESLO
+                        ew = a0 + t1 * (a1 + t1 * (a2 + t1 * (a3 + t1 * (a4 + t1 * (a5 + t1 * a6)))))
+
+                     ELSE IF ( ( t1 .GE. t_ref ) .AND. ( t1 .LT. -47. ) ) then !liq phas poor ES
+                        ew = es0 * exp(17.67 * t1 / ( t1 + 243.5))
+
+                     ELSE
+                        tk = t(i,k,j)
+                        rhs = -c1 * (tf / tk - 1.) - c2 * alog10(tf / tk) +  &
+                               c3 * (1. - tk / tf) +      alog10(eis)
+                        ew = 10. ** rhs
+
+                     END IF
+
+                     !  Now sat vap pres obtained compute local vapor pressure
+  
+                     ew = MAX ( ew , 0. ) * rh(i,k,j) * 0.01
+
+                     !  Now compute the specific humidity using the partial vapor
+                     !  pressures of water vapor (ew) and dry air (p-ew).  The
+                     !  constants assume that the pressure is in hPa, so we divide
+                     !  the pressures by 100.
+
+                     q1 = mw_vap * ew
+                     q1 = q1 / (q1 + mw_air * (p(i,k,j)/100. - ew))
+
+                     q(i,k,j) = q1 / (1. - q1 )
+
+                  END IF
+
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+!!****MARS
+!!TODO: change once tracers are activated ?
+!q=0.
+!!****MARS
+
+   END SUBROUTINE rh_to_mxrat
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE compute_eta ( znw , &
+                           eta_levels , max_eta , max_dz , &
+fixedpbl, &
+                           p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0 , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte )
+   
+      !  Compute eta levels, either using given values from the namelist (hardly
+      !  a computation, yep, I know), or assuming a constant dz above the PBL,
+      !  knowing p_top and the number of eta levels.
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+      REAL , INTENT(IN)           :: max_dz
+      REAL , INTENT(IN)           :: p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0
+      INTEGER , INTENT(IN)        :: max_eta
+      REAL , DIMENSION (max_eta) , INTENT(IN)  :: eta_levels
+
+      REAL , DIMENSION (kts:kte) , INTENT(OUT) :: znw
+
+      !  Local vars
+
+      INTEGER :: k 
+      REAL :: mub , t_init , p_surf , pb, ztop, ztop_pbl , dz , temp
+      REAL , DIMENSION(kts:kte) :: dnw
+
+      INTEGER , PARAMETER :: prac_levels = 17
+      INTEGER :: loop , loop1
+      REAL , DIMENSION(prac_levels) :: znw_prac , znu_prac , dnw_prac
+      REAL , DIMENSION(kts:kte) :: alb , phb
+
+
+!****MARS      
+!****MARS
+INTEGER, fixedpbl   ! usually, 8 first layers are fixed
+                    ! change this parameter if the top is very
+                    ! low     
+print *, 'check Mars: p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0' 
+print *, p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0
+!-----solution alternative: definir dans la namelist les niveaux verticaux
+!****MARS
+!****MARS
+
+
+      !  Gee, do the eta levels come in from the namelist?
+
+      IF ( ABS(eta_levels(1)+1.) .GT. 0.0000001 ) THEN
+
+         IF ( ( ABS(eta_levels(1  )-1.) .LT. 0.0000001 ) .AND. &
+              ( ABS(eta_levels(kde)-0.) .LT. 0.0000001 ) ) THEN
+            DO k = kds+1 , kde-1
+               znw(k) = eta_levels(k)
+            END DO
+            znw(  1) = 1.
+            znw(kde) = 0.
+         ELSE
+            CALL wrf_error_fatal ( 'First eta level should be 1.0 and the last 0.0 in namelist' )
+         END IF
+
+      !  Compute eta levels assuming a constant delta z above the PBL.
+
+      ELSE
+
+         !  Compute top of the atmosphere with some silly levels.  We just want to
+         !  integrate to get a reasonable value for ztop.  We use the planned PBL-esque
+         !  levels, and then just coarse resolution above that.  We know p_top, and we
+         !  have the base state vars.
+
+         p_surf = p00 
+
+!         znw_prac = (/ 1.000 , 0.993 , 0.983 , 0.970 , 0.954 , 0.934 , 0.909 , &
+!                       0.88 , 0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+
+!****MARS
+!****MARS
+! on Mars, this is important to correctly resolve the surface
+! -- levels were changed to get closer to the surface
+! -- values were chosen as done typically in LMD GCM simulations
+!TODO: better repartition ?
+        znw_prac = (/ 1.000 , &
+                        0.9995 , &  
+                        0.9980 , &
+                        0.9950 , &
+                        0.9850 , &
+                        0.9700 , &
+                        0.9400 , &
+                        0.9000 , &
+                        0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+!****MARS
+!****MARS
+
+
+         DO k = 1 , prac_levels - 1
+            znu_prac(k) = ( znw_prac(k) + znw_prac(k+1) ) * 0.5
+            dnw_prac(k) = znw_prac(k+1) - znw_prac(k)
+         END DO
+
+         DO k = 1, prac_levels-1
+            pb = znu_prac(k)*(p_surf - p_top) + p_top
+!           temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+            temp =             t00 + A*LOG(pb/p00)
+            t_init = temp*(p00/pb)**(r_d/cp) - t0
+            alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+         END DO
+       
+         !  Base state mu is defined as base state surface pressure minus p_top
+
+         mub = p_surf - p_top
+       
+         !  Integrate base geopotential, starting at terrain elevation.
+
+         phb(1) = 0.
+         DO k  = 2,prac_levels
+               phb(k) = phb(k-1) - dnw_prac(k-1)*mub*alb(k-1)
+         END DO
+
+         !  So, now we know the model top in meters.  Get the average depth above the PBL
+         !  of each of the remaining levels.  We are going for a constant delta z thickness.
+
+         ztop     = phb(prac_levels) / g
+         ztop_pbl = phb(fixedpbl) / g
+         dz = ( ztop - ztop_pbl ) / REAL ( kde - fixedpbl )
+
+         !  Standard levels near the surface so no one gets in trouble.
+         DO k = 1 , fixedpbl
+            znw(k) = znw_prac(k)
+         END DO
+
+         !  Using d phb(k)/ d eta(k) = -mub * alb(k), eqn 2.9 
+         !  Skamarock et al, NCAR TN 468.  Use full levels, so
+         !  use twice the thickness.
+
+         DO k = fixedpbl, kte-1
+            pb = znw(k) * (p_surf - p_top) + p_top
+!           temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+            temp =             t00 + A*LOG(pb/p00)
+            t_init = temp*(p00/pb)**(r_d/cp) - t0
+            alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+            znw(k+1) = znw(k) - dz*g / ( mub*alb(k) )
+         END DO
+         znw(kte) = 0.000
+
+         !  There is some iteration.  We want the top level, ztop, to be
+         !  consistent with the delta z, and we want the half level values
+         !  to be consistent with the eta levels.  The inner loop to 10 gets
+         !  the eta levels very accurately, but has a residual at the top, due
+         !  to dz changing.  We reset dz five times, and then things seem OK.
+
+
+         DO loop1 = 1 , 5
+            DO loop = 1 , 10
+               DO k = fixedpbl, kte-1
+                  pb = (znw(k)+znw(k+1))*0.5 * (p_surf - p_top) + p_top
+!                 temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+                  temp =             t00 + A*LOG(pb/p00)
+                  t_init = temp*(p00/pb)**(r_d/cp) - t0
+                  alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+                  znw(k+1) = znw(k) - dz*g / ( mub*alb(k) )
+!!****MARS
+!!attention 'base_lapse' ne doit pas etre trop grand
+!!sinon ... des NaN car temperatures negatives en haut
+!IF ( ( loop1 .EQ. 5 ) .AND. ( loop .EQ. 10 ) ) THEN
+!	IF (k .EQ. 8) THEN
+!		print *, 'p,t,z,k'
+!	END IF
+!	print *,  pb,temp,znw(k+1),k 
+!END IF
+!****MARS
+               END DO
+               IF ( ( loop1 .EQ. 5 ) .AND. ( loop .EQ. 10 ) ) THEN
+                  print *,'Converged znw(kte) should be 0.0 = ',znw(kte)
+               END IF
+               znw(kte) = 0.000
+            END DO
+
+            !  Here is where we check the eta levels values we just computed.
+
+            DO k = 1, kde-1
+               pb = (znw(k)+znw(k+1))*0.5 * (p_surf - p_top) + p_top
+!              temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+               temp =             t00 + A*LOG(pb/p00)
+               t_init = temp*(p00/pb)**(r_d/cp) - t0
+               alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+            END DO
+
+            phb(1) = 0.
+            DO k  = 2,kde
+                  phb(k) = phb(k-1) - (znw(k)-znw(k-1)) * mub*alb(k-1)
+            END DO
+
+            !  Reset the model top and the dz, and iterate.
+
+            ztop = phb(kde)/g
+            ztop_pbl = phb(fixedpbl)/g
+            dz = ( ztop - ztop_pbl ) / REAL ( kde - fixedpbl ) 
+         END DO
+
+
+! ****MARS
+! Display the computed levels
+print *,'WRF levels are:'
+print *,'z (m)            = ',phb(1)/g
+do k = 2 ,kte
+print *,'z (m) and dz (m) = ',phb(k)/g,(phb(k)-phb(k-1))/g
+
+
+                !! little check of the repartition
+                if (k>2) then
+                if ((phb(k)-2.*phb(k-1)+phb(k-2))/g < -1.e-2) then
+                        print *, 'problem on the repartition' 
+                        print *, '>> try to decrease force_sfc_in_vinterp (<8)'
+                        print *, '>> or increase model top (i.e. lower ptop)'
+                        print *,  (phb(k)-2.*phb(k-1)+phb(k-2))/g
+                        stop
+                endif
+                endif
+end do
+! ****MARS
+
+
+         IF ( dz .GT. max_dz ) THEN
+print *,'z (m)            = ',phb(1)/g
+do k = 2 ,kte
+print *,'z (m) and dz (m) = ',phb(k)/g,(phb(k)-phb(k-1))/g
+end do
+print *,'dz (m) above fixed eta levels = ',dz
+print *,'namelist max_dz (m) = ',max_dz
+print *,'namelist p_top (Pa) = ',p_top
+            CALL wrf_debug ( 0, 'You need one of three things:' )
+            CALL wrf_debug ( 0, '1) More eta levels to reduce the dz: e_vert' )
+            CALL wrf_debug ( 0, '2) A lower p_top so your total height is reduced: p_top_requested')
+            CALL wrf_debug ( 0, '3) Increase the maximum allowable eta thickness: max_dz')
+            CALL wrf_debug ( 0, 'All are namelist options')
+            CALL wrf_error_fatal ( 'dz above fixed eta levels is too large')
+         END IF
+
+      END IF
+
+   END SUBROUTINE compute_eta
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE monthly_min_max ( field_in , field_min , field_max , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Plow through each month, find the max, min values for each i,j.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,12,jms:jme) , INTENT(IN)  :: field_in
+      REAL , DIMENSION(ims:ime,   jms:jme) , INTENT(OUT) :: field_min , field_max
+
+      !  Local vars
+
+      INTEGER :: i , j , l
+      REAL :: minner , maxxer
+
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            minner = field_in(i,1,j)
+            maxxer = field_in(i,1,j)
+            DO l = 2 , 12
+               IF ( field_in(i,l,j) .LT. minner ) THEN
+                  minner = field_in(i,l,j)
+               END IF
+               IF ( field_in(i,l,j) .GT. maxxer ) THEN
+                  maxxer = field_in(i,l,j)
+               END IF
+            END DO
+            field_min(i,j) = minner
+            field_max(i,j) = maxxer
+         END DO
+      END DO
+   
+   END SUBROUTINE monthly_min_max
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE monthly_interp_to_date ( field_in , date_str , field_out , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Linrarly in time interpolate data to a current valid time.  The data is
+   !  assumed to come in "monthly", valid at the 15th of every month.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      CHARACTER (LEN=24) , INTENT(IN) :: date_str
+      REAL , DIMENSION(ims:ime,12,jms:jme) , INTENT(IN)  :: field_in
+      REAL , DIMENSION(ims:ime,   jms:jme) , INTENT(OUT) :: field_out
+
+      !  Local vars
+
+      INTEGER :: i , j , l
+      INTEGER , DIMENSION(0:13) :: middle
+      INTEGER :: target_julyr , target_julday , target_date
+      INTEGER :: julyr , julday , int_month , month1 , month2
+      REAL :: gmt
+      CHARACTER (LEN=4) :: yr
+      CHARACTER (LEN=2) :: mon , day15
+
+
+      WRITE(day15,FMT='(I2.2)') 15
+      DO l = 1 , 12
+         WRITE(mon,FMT='(I2.2)') l
+         CALL get_julgmt ( date_str(1:4)//'-'//mon//'-'//day15//'_'//'00:00:00.0000' , julyr , julday , gmt )
+         middle(l) = julyr*1000 + julday
+      END DO
+
+      l = 0
+      middle(l) = middle( 1) - 31
+
+      l = 13
+      middle(l) = middle(12) + 31
+
+      CALL get_julgmt ( date_str , target_julyr , target_julday , gmt )
+      target_date = target_julyr * 1000 + target_julday
+      find_month : DO l = 0 , 12
+         IF ( ( middle(l) .LT. target_date ) .AND. ( middle(l+1) .GE. target_date ) ) THEN
+            DO j = jts , MIN ( jde-1 , jte )
+               DO i = its , MIN (ide-1 , ite )
+                  int_month = l
+                  IF ( ( int_month .EQ. 0 ) .OR. ( int_month .EQ. 12 ) ) THEN
+                     month1 = 12
+                     month2 =  1
+                  ELSE
+                     month1 = int_month
+                     month2 = month1 + 1
+                  END IF
+                  field_out(i,j) =  ( field_in(i,month2,j) * ( target_date - middle(l)   ) + &
+                                      field_in(i,month1,j) * ( middle(l+1) - target_date ) ) / &
+                                    ( middle(l+1) - middle(l) )
+               END DO
+            END DO
+            EXIT find_month
+         END IF
+      END DO find_month
+
+   END SUBROUTINE monthly_interp_to_date
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE sfcprs (t, q, height, pslv, ter, avgsfct, p, &
+                      psfc, ez_method, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      !  Computes the surface pressure using the input height,
+      !  temperature and q (already computed from relative
+      !  humidity) on p surfaces.  Sea level pressure is used
+      !  to extrapolate a first guess.
+
+      IMPLICIT NONE
+
+!****MARS
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: Cp = 844.6
+      REAL, PARAMETER    :: g = 3.72
+      REAL, PARAMETER    :: pconst = 610.
+!****MARS
+      
+!****MARS .... to be changed if used
+      REAL, PARAMETER    :: gamma     = 6.5E-3
+      REAL, PARAMETER    :: TC        = 273.15 + 17.5
+      REAL, PARAMETER    :: gammarg   = gamma * Rd / g
+      REAL, PARAMETER    :: rov2      = Rd / 2.
+!****MARS .... to be changed if used
+
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte 
+      LOGICAL , INTENT ( IN ) :: ez_method
+
+      REAL , DIMENSION (ims:ime,kms:kme,jms:jme) , INTENT(IN ):: t, q, height, p
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(IN ):: pslv ,  ter, avgsfct 
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(OUT):: psfc
+      
+      INTEGER                     :: i
+      INTEGER                     :: j
+      INTEGER                     :: k
+      INTEGER , DIMENSION (its:ite,jts:jte) :: k500 , k700 , k850
+
+      LOGICAL                     :: l1
+      LOGICAL                     :: l2
+      LOGICAL                     :: l3
+      LOGICAL                     :: OK
+
+      REAL                        :: gamma78     ( its:ite,jts:jte )
+      REAL                        :: gamma57     ( its:ite,jts:jte )
+      REAL                        :: ht          ( its:ite,jts:jte )
+      REAL                        :: p1          ( its:ite,jts:jte )
+      REAL                        :: t1          ( its:ite,jts:jte )
+      REAL                        :: t500        ( its:ite,jts:jte )
+      REAL                        :: t700        ( its:ite,jts:jte )
+      REAL                        :: t850        ( its:ite,jts:jte )
+      REAL                        :: tfixed      ( its:ite,jts:jte )
+      REAL                        :: tsfc        ( its:ite,jts:jte )
+      REAL                        :: tslv        ( its:ite,jts:jte )
+
+      !  We either compute the surface pressure from a time averaged surface temperature
+      !  (what we will call the "easy way"), or we try to remove the diurnal impact on the
+      !  surface temperature (what we will call the "other way").  Both are essentially 
+      !  corrections to a sea level pressure with a high-resolution topography field.
+
+!****MARS ....
+!****MARS .... the mean sea level method is abandoned
+print *, 'no sea level pressure on Mars, please'
+stop
+!****MARS ....
+
+      IF ( ez_method ) THEN
+
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               psfc(i,j) = pslv(i,j) * ( 1.0 + gamma * ter(i,j) / avgsfct(i,j) ) ** ( - g / ( Rd * gamma ) )
+            END DO
+         END DO
+
+      ELSE
+
+         !  Find the locations of the 850, 700 and 500 mb levels.
+   
+         k850 = 0                              ! find k at: P=850
+         k700 = 0                              !            P=700
+         k500 = 0                              !            P=500
+   
+         i = its
+         j = jts
+         DO k = kts+1 , kte
+            IF      (NINT(p(i,k,j)) .EQ. 85000) THEN
+               k850(i,j) = k
+            ELSE IF (NINT(p(i,k,j)) .EQ. 70000) THEN
+               k700(i,j) = k
+            ELSE IF (NINT(p(i,k,j)) .EQ. 50000) THEN
+               k500(i,j) = k
+            END IF
+         END DO
+   
+         IF ( ( k850(i,j) .EQ. 0 ) .OR. ( k700(i,j) .EQ. 0 ) .OR. ( k500(i,j) .EQ. 0 ) ) THEN
+
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  psfc(i,j) = pslv(i,j) * ( 1.0 + gamma * ter(i,j) / t(i,1,j) ) ** ( - g / ( Rd * gamma ) )
+               END DO
+            END DO
+            
+            RETURN
+#if 0
+
+            !  Possibly it is just that we have a generalized vertical coord, so we do not
+            !  have the values exactly.  Do a simple assignment to a close vertical level.
+
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  DO k = kts+1 , kte-1
+                     IF ( ( p(i,k,j) - 85000. )  * ( p(i,k+1,j) - 85000. ) .LE. 0.0 ) THEN
+                        k850(i,j) = k
+                     END IF
+                     IF ( ( p(i,k,j) - 70000. )  * ( p(i,k+1,j) - 70000. ) .LE. 0.0 ) THEN
+                        k700(i,j) = k
+                     END IF
+                     IF ( ( p(i,k,j) - 50000. )  * ( p(i,k+1,j) - 50000. ) .LE. 0.0 ) THEN
+                        k500(i,j) = k
+                     END IF
+                  END DO
+               END DO
+            END DO
+
+            !  If we *still* do not have the k levels, punt.  I mean, we did try.
+
+            OK = .TRUE.
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( ( k850(i,j) .EQ. 0 ) .OR. ( k700(i,j) .EQ. 0 ) .OR. ( k500(i,j) .EQ. 0 ) ) THEN
+                     OK = .FALSE.
+                     PRINT '(A)','(i,j) = ',i,j,'  Error in finding p level for 850, 700 or 500 hPa.'
+                     DO K = kts+1 , kte
+                        PRINT '(A,I3,A,F10.2,A)','K = ',k,'  PRESSURE = ',p(i,k,j),' Pa'
+                     END DO
+                     PRINT '(A)','Expected 850, 700, and 500 mb values, at least.'
+                  END IF
+               END DO
+            END DO
+            IF ( .NOT. OK ) THEN
+               CALL wrf_error_fatal ( 'wrong pressure levels' )
+            END IF
+#endif
+
+         !  We are here if the data is isobaric and we found the levels for 850, 700,
+         !  and 500 mb right off the bat.
+
+         ELSE
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  k850(i,j) = k850(its,jts)
+                  k700(i,j) = k700(its,jts)
+                  k500(i,j) = k500(its,jts)
+               END DO
+            END DO
+         END IF
+       
+         !  The 850 hPa level of geopotential height is called something special.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               ht(i,j) = height(i,k850(i,j),j)
+            END DO
+         END DO
+   
+         !  The variable ht is now -ter/ht(850 hPa).  The plot thickens.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               ht(i,j) = -ter(i,j) / ht(i,j)
+            END DO
+         END DO
+   
+         !  Make an isothermal assumption to get a first guess at the surface
+         !  pressure.  This is to tell us which levels to use for the lapse
+         !  rates in a bit.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               psfc(i,j) = pslv(i,j) * (pslv(i,j) / p(i,k850(i,j),j)) ** ht(i,j)
+            END DO
+         END DO
+   
+         !  Get a pressure more than pconst Pa above the surface - p1.  The
+         !  p1 is the top of the level that we will use for our lapse rate
+         !  computations.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF      ( ( psfc(i,j) - 95000. ) .GE. 0. ) THEN
+                  p1(i,j) = 85000.
+               ELSE IF ( ( psfc(i,j) - 70000. ) .GE. 0. ) THEN
+                  p1(i,j) = psfc(i,j) - pconst
+               ELSE
+                  p1(i,j) = 50000.
+               END IF
+            END DO
+         END DO
+   
+         !  Compute virtual temperatures for k850, k700, and k500 layers.  Now
+         !  you see why we wanted Q on pressure levels, it all is beginning   
+         !  to make sense.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               t850(i,j) = t(i,k850(i,j),j) * (1. + 0.608 * q(i,k850(i,j),j))
+               t700(i,j) = t(i,k700(i,j),j) * (1. + 0.608 * q(i,k700(i,j),j))
+               t500(i,j) = t(i,k500(i,j),j) * (1. + 0.608 * q(i,k500(i,j),j))
+            END DO
+         END DO
+   
+         !  Compute lapse rates between these three levels.  These are
+         !  environmental values for each (i,j).
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               gamma78(i,j) = ALOG(t850(i,j) / t700(i,j))  / ALOG (p(i,k850(i,j),j) / p(i,k700(i,j),j) )
+               gamma57(i,j) = ALOG(t700(i,j) / t500(i,j))  / ALOG (p(i,k700(i,j),j) / p(i,k500(i,j),j) )
+            END DO
+         END DO
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF      ( ( psfc(i,j) - 95000. ) .GE. 0. ) THEN
+                  t1(i,j) = t850(i,j)
+               ELSE IF ( ( psfc(i,j) - 85000. ) .GE. 0. ) THEN
+                  t1(i,j) = t700(i,j) * (p1(i,j) / (p(i,k700(i,j),j))) ** gamma78(i,j)
+               ELSE IF ( ( psfc(i,j) - 70000. ) .GE. 0.) THEN 
+                  t1(i,j) = t500(i,j) * (p1(i,j) / (p(i,k500(i,j),j))) ** gamma57(i,j)
+               ELSE
+                  t1(i,j) = t500(i,j)
+               ENDIF
+            END DO 
+         END DO 
+   
+         !  From our temperature way up in the air, we extrapolate down to
+         !  the sea level to get a guess at the sea level temperature.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tslv(i,j) = t1(i,j) * (pslv(i,j) / p1(i,j)) ** gammarg
+            END DO 
+         END DO 
+   
+         !  The new surface temperature is computed from the with new sea level 
+         !  temperature, just using the elevation and a lapse rate.  This lapse 
+         !  rate is -6.5 K/km.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tsfc(i,j) = tslv(i,j) - gamma * ter(i,j)
+            END DO 
+         END DO 
+   
+         !  A small correction to the sea-level temperature, in case it is too warm.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tfixed(i,j) = tc - 0.005 * (tsfc(i,j) - tc) ** 2
+            END DO 
+         END DO 
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               l1 = tslv(i,j) .LT. tc
+               l2 = tsfc(i,j) .LE. tc
+               l3 = .NOT. l1
+               IF      ( l2 .AND. l3 ) THEN
+                  tslv(i,j) = tc
+               ELSE IF ( ( .NOT. l2 ) .AND. l3 ) THEN
+                  tslv(i,j) = tfixed(i,j)
+               END IF
+            END DO
+         END DO
+   
+         !  Finally, we can get to the surface pressure.
+
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+            p1(i,j) = - ter(i,j) * g / ( rov2 * ( tsfc(i,j) + tslv(i,j) ) )
+            psfc(i,j) = pslv(i,j) * EXP ( p1(i,j) )
+            END DO
+         END DO
+
+      END IF
+
+      !  Surface pressure and sea-level pressure are the same at sea level.
+
+!     DO j = jts , MIN(jde-1,jte)
+!        DO i = its , MIN(ide-1,ite)
+!           IF ( ABS ( ter(i,j) )  .LT. 0.1 ) THEN
+!              psfc(i,j) = pslv(i,j)
+!           END IF
+!        END DO
+!     END DO
+
+   END SUBROUTINE sfcprs
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE sfcprs2(t, q, height, psfc_in, ter, avgsfct, p, &
+                      psfc, ez_method, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      !  Computes the surface pressure using the input height,
+      !  temperature and q (already computed from relative
+      !  humidity) on p surfaces.  Sea level pressure is used
+      !  to extrapolate a first guess.
+
+      IMPLICIT NONE
+
+!****MARS
+      REAL , PARAMETER :: Rd = 192.
+      REAL, PARAMETER    :: g = 3.72
+!****MARS
+
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte 
+      LOGICAL , INTENT ( IN ) :: ez_method
+
+      REAL , DIMENSION (ims:ime,kms:kme,jms:jme) , INTENT(IN ):: t, q, height, p
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(IN ):: psfc_in ,  ter, avgsfct 
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(OUT):: psfc
+      
+      INTEGER                     :: i
+      INTEGER                     :: j
+      INTEGER                     :: k
+
+      REAL :: tv_sfc_avg , tv_sfc , del_z
+
+      !  Compute the new surface pressure from the old surface pressure, and a
+      !  known change in elevation at the surface.
+
+
+!****MARS: as is done in MCD/pres0 with the MOLA topography :)
+
+        !!---------
+        !!  del_z = diff in surface topo, lo-res vs hi-res
+        !grid%em_ght_gc - grid%ht
+        !!---------
+        !!* em_ght_gc: surface geopotential height from the GCM 
+        !!* ht: hi-res altimetry
+        !  psfc = psfc_in * exp ( g del_z / (Rd Tv_sfc ) )
+        !!---------
+
+
+      IF ( ez_method ) THEN
+!!
+!!****MARS: 'ez_method' is 'we_have_tavgsfc', hard-coded as false
+!!
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tv_sfc_avg = avgsfct(i,j) * (1. + 0.608 * q(i,1,j))
+               del_z = height(i,1,j) - ter(i,j)
+               psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * tv_sfc_avg ) )
+            END DO
+         END DO
+      ELSE
+!!              
+!!****MARS .... here is what is done for Mars
+!!
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+!               tv_sfc = t(i,1,j) * (1. + 0.608 * q(i,1,j))
+!!****MARS: 0.608 >> nonsense on Mars 
+tv_sfc = t(i,1,j)
+!!****MARS .... changer pour t_1km - 7e couche GCM
+!!****MARS .... spiga et al. (2007)
+tv_sfc = t(i,8,j)
+               del_z = height(i,1,j) - ter(i,j)
+               psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * tv_sfc     ) )
+!****MARS
+!****MARS .... which temperature is used in the Laplace formula ?
+!!****MARS: hardcoded as 220K (t0)
+!!****MARS: pas une enorme influence
+!psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * 220 ) )
+
+               
+!	       !****MARS .... check of the altimetry differences
+!	       print *,del_z, tv_sfc
+
+            END DO
+         END DO
+print *, '1 km temperatures - max'         
+print *, MAXVAL(t(:,8,:))         
+      END IF
+
+   END SUBROUTINE sfcprs2
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+   SUBROUTINE constante3(field, field_custom, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      IMPLICIT NONE
+
+      REAL :: field_custom
+      REAL, DIMENSION (ims:ime,kms:kme,jms:jme), INTENT(INOUT):: field
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte
+
+
+!!****MARS: set the 3D field to a constant value
+field(:,:,:)=field_custom
+
+  END SUBROUTINE constante3
+!---------------------------------------------------------------------
+   SUBROUTINE constante2(field, field_custom, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      IMPLICIT NONE
+
+      REAL :: field_custom
+      REAL, DIMENSION (ims:ime,jms:jme), INTENT(INOUT):: field
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte
+
+
+!!****MARS: set the 3D field to a constant value
+field(:,:)=field_custom
+
+  END SUBROUTINE constante2
+!---------------------------------------------------------------------
+
+END MODULE module_initialize
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_real_method2_1param1interp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_real_method2_1param1interp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_real_method2_1param1interp.F	(revision 2744)
@@ -0,0 +1,5212 @@
+!REAL:MODEL_LAYER:INITIALIZATION
+
+#ifndef VERT_UNIT
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains, specifically for the Eulerian, mass-based coordinate.
+
+!-----------------------------------------------------------------------
+
+!****MARS: modified May 2007
+
+
+MODULE module_initialize
+
+   USE module_bc
+   USE module_configure
+   USE module_domain
+   USE module_io_domain
+   USE module_model_constants
+   USE module_state_description
+   USE module_timing
+   USE module_soil_pre
+   USE module_date_time
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+   REAL , SAVE :: p_top_save
+   INTEGER :: internal_time_loop
+
+CONTAINS
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain ( grid )
+
+      IMPLICIT NONE
+
+      !  Input space and data.  No gridded meteorological data has been stored, though.
+
+!     TYPE (domain), POINTER :: grid 
+      TYPE (domain)          :: grid 
+
+      !  Local data.
+
+      INTEGER :: dyn_opt 
+      INTEGER :: idum1, idum2
+
+      CALL nl_get_dyn_opt ( 1, dyn_opt )
+      
+      CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+      IF (      dyn_opt .eq. 1 &
+           .or. dyn_opt .eq. 2 &
+           .or. dyn_opt .eq. 3 &
+                                          ) THEN
+        CALL init_domain_rk( grid &
+!
+#include "em_actual_new_args.inc"
+!
+      )
+
+      ELSE
+         WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+         CALL wrf_error_fatal ( 'ERROR-dyn_opt-wrong-in-namelist' )
+      ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+#include "em_dummy_new_args.inc"
+!
+   )
+
+      USE module_optional_si_input
+      IMPLICIT NONE
+
+      !  Input space and data.  No gridded meteorological data has been stored, though.
+
+!     TYPE (domain), POINTER :: grid
+      TYPE (domain)          :: grid
+
+#include "em_dummy_new_decl.inc"
+
+      TYPE (grid_config_rec_type)              :: config_flags
+
+      !  Local domain indices and counters.
+
+      INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+      INTEGER :: loop , num_seaice_changes
+
+      INTEGER                             ::                       &
+                                     ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte, &
+                                     ips, ipe, jps, jpe, kps, kpe, &
+                                     i, j, k
+      INTEGER :: ns
+
+      !  Local data
+
+      INTEGER :: error
+      REAL    :: p_surf, p_level
+      REAL    :: cof1, cof2
+      REAL    :: qvf , qvf1 , qvf2 , pd_surf
+      REAL    :: p00 , t00 , a
+      REAL    :: hold_znw
+      LOGICAL :: were_bad
+
+      LOGICAL :: stretch_grid, dry_sounding, debug
+      INTEGER IICOUNT
+
+      REAL :: p_top_requested , temp
+      INTEGER :: num_metgrid_levels
+      REAL , DIMENSION(max_eta) :: eta_levels
+      REAL :: max_dz
+
+!      INTEGER , PARAMETER :: nl_max = 1000
+!      REAL , DIMENSION(nl_max) :: grid%em_dn
+
+integer::oops1,oops2
+
+      REAL    :: zap_close_levels
+      INTEGER :: force_sfc_in_vinterp
+      INTEGER :: interp_type , lagrange_order
+      LOGICAL :: lowest_lev_from_sfc
+      LOGICAL :: we_have_tavgsfc
+
+      INTEGER :: lev500 , loop_count
+      REAL    :: zl , zu , pl , pu , z500 , dz500 , tvsfc , dpmu
+
+!-- Carsel and Parrish [1988]
+        REAL , DIMENSION(100) :: lqmi
+
+
+!****MARS
+      INTEGER :: sizegcm, kold, knew,inew,jnew
+      REAL :: pa, indic, p1, p2, pn
+      REAL, ALLOCATABLE, DIMENSION (:,:,:) :: sig, ap, bp, box
+!****MARS
+
+
+#ifdef DM_PARALLEL
+#    include "em_data_calls.inc"
+#endif
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+            kds = grid%sd31 ; kde = grid%ed31 ;
+            ids = grid%sd32 ; ide = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            kms = grid%sm31 ; kme = grid%em31 ;
+            ims = grid%sm32 ; ime = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+            its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XYZ )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            jds = grid%sd32 ; jde = grid%ed32 ;
+            kds = grid%sd33 ; kde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            jms = grid%sm32 ; jme = grid%em32 ;
+            kms = grid%sm33 ; kme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+            kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XZY )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            kds = grid%sd32 ; kde = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            kms = grid%sm32 ; kme = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+      END SELECT
+
+      CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+      !  Check to see if the boundary conditions are set properly in the namelist file.
+      !  This checks for sufficiency and redundancy.
+
+      CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+      !  Some sort of "this is the first time" initialization.  Who knows.
+
+      grid%step_number = 0
+      grid%itimestep=0
+
+      !  Pull in the info in the namelist to compare it to the input data.
+
+      grid%real_data_init_type = model_config_rec%real_data_init_type
+   
+      !  To define the base state, we call a USER MODIFIED routine to set the three
+      !  necessary constants:  p00 (sea level pressure, Pa), t00 (sea level temperature, K), 
+      !  and A (temperature difference, from 1000 mb to 300 mb, K).
+   
+      CALL const_module_initialize ( p00 , t00 , a ) 
+
+#if 0
+!KLUDGE, this is for testing only
+if ( flag_metgrid .eq. 1 ) then
+read (20+grid%id) grid%em_ht_gc
+read (20+grid%id) grid%em_xlat_gc
+read (20+grid%id) grid%em_xlong_gc
+read (20+grid%id) msft
+read (20+grid%id) msfu
+read (20+grid%id) msfv
+read (20+grid%id) f
+read (20+grid%id) e
+read (20+grid%id) sina
+read (20+grid%id) cosa
+read (20+grid%id) grid%landmask
+read (20+grid%id) grid%landusef
+read (20+grid%id) grid%soilctop
+read (20+grid%id) grid%soilcbot
+read (20+grid%id) grid%vegcat
+read (20+grid%id) grid%soilcat
+read (20+grid%id) grid%em_albedo_gcm
+read (20+grid%id) grid%em_therm_inert
+else
+write (20+grid%id) grid%em_ht
+write (20+grid%id) grid%em_xlat
+write (20+grid%id) grid%em_xlong
+write (20+grid%id) msft
+write (20+grid%id) msfu
+write (20+grid%id) msfv
+write (20+grid%id) f
+write (20+grid%id) e
+write (20+grid%id) sina
+write (20+grid%id) cosa
+write (20+grid%id) grid%landmask
+write (20+grid%id) grid%landusef
+write (20+grid%id) grid%soilctop
+write (20+grid%id) grid%soilcbot
+write (20+grid%id) grid%vegcat
+write (20+grid%id) grid%soilcat
+write (20+grid%id) grid%em_albedo_gcm
+write (20+grid%id) grid%em_therm_inert
+endif
+#endif
+
+
+      !  Is there any vertical interpolation to do?  The "old" data comes in on the correct
+      !  vertical locations already.
+
+      IF ( flag_metgrid .EQ. 1 ) THEN  !   <----- START OF VERTICAL INTERPOLATION PART ---->
+
+         !  Variables that are named differently between SI and WPS.
+
+         DO j = jts, MIN(jte,jde-1)
+           DO i = its, MIN(ite,ide-1)
+!!****MARS: tsk is surface temperature           
+              grid%tsk(i,j) = grid%em_tsk_gc(i,j)
+              grid%tmn(i,j) = grid%em_tmn_gc(i,j)
+              grid%xlat(i,j) = grid%em_xlat_gc(i,j)
+              grid%xlong(i,j) = grid%em_xlong_gc(i,j)
+              grid%ht(i,j) = grid%em_ht_gc(i,j)
+!!****MARS
+!!un peu artificiel, mais u10 et v10 sont des bons intermediaires (facultatifs de plus)
+              grid%u10(i,j) = grid%em_albedo_gcm(i,j)
+              grid%v10(i,j) = grid%em_therm_inert(i,j)
+include "../custom_static.inc"
+!!****MARS
+           END DO
+         END DO
+
+
+!!****MARS
+!!
+!! case with idealized topography
+!!
+!!CALL ideal_topo ( grid%ht , 2000., 6., &
+!CALL ideal_topo ( grid%ht , 2000., 3., &
+!           ids , ide , jds , jde , kds , kde , &
+!           ims , ime , jms , jme , kms , kme , &
+!           its , ite , jts , jte , kts , kte )
+!!****MARS
+!****MARS
+!!
+!! idealized atmospheric state
+!!
+!!
+!! adjust_heights ne sert pas :)
+print *,config_flags%adjust_heights
+IF (config_flags%adjust_heights) THEN
+        print *, 'setting uniform values and profiles'
+        print *, 'u'
+        print *, grid%em_u_gc(its+1,:,jts+1)
+        print *, 'v'
+        print *, grid%em_v_gc(its+1,:,jts+1)
+        print *, 't'
+        print *, grid%em_t_gc(its+1,:,jts+1)
+        print *, 'p'
+        print *, grid%em_rh_gc(its+1,:,jts+1)
+        print *, 'geop'
+        print *, grid%em_ght_gc(its+1,:,jts+1)
+        print *, 'albedo'
+        print *, grid%u10(its+1,jts+1)
+        print *, 'thermal inertia'
+        print *, grid%v10(its+1,jts+1)
+        print *, 'topography'
+        print *, grid%ht(its+1,jts+1)
+        print *, 'toposoil'
+        print *, grid%toposoil(its+1,jts+1) 
+        print *, 'surface temperature'
+        print *, grid%tsk(its+1,jts+1)
+        print *, 'surface pressure'
+        print *, grid%psfc(its+1,jts+1)
+        print *, grid%em_psfc_gc(its+1,jts+1)
+
+        DO j = jts, MIN(jte,jde-1)
+          DO i = its, MIN(ite,ide-1)
+                grid%em_u_gc(i,:,j)=grid%em_u_gc(its+1,:,jts+1)
+                grid%em_v_gc(i,:,j)=grid%em_v_gc(its+1,:,jts+1)
+                grid%em_t_gc(i,:,j)=grid%em_t_gc(its+1,:,jts+1)
+                grid%em_rh_gc(i,:,j)=grid%em_rh_gc(its+1,:,jts+1)
+                grid%em_ght_gc(i,:,j) = grid%em_ght_gc(its+1,:,jts+1)
+                grid%u10(i,j) = grid%u10(its+1,jts+1)
+                grid%v10(i,j) = grid%v10(its+1,jts+1)
+                grid%ht(i,j) = grid%ht(its+1,jts+1)
+                grid%toposoil(i,j) = grid%toposoil(its+1,jts+1)
+                grid%tsk(i,j) = grid%tsk(its+1,jts+1)
+                grid%psfc(i,j) = grid%psfc(its+1,jts+1)
+                grid%em_psfc_gc(i,j) = grid%em_psfc_gc(its+1,jts+1)
+          ENDDO
+        ENDDO
+
+!!
+!!
+print *, 'u divided by 10'
+grid%em_u_gc=grid%em_u_gc/10.
+grid%em_v_gc=grid%em_v_gc/10.
+!!
+!!
+
+
+ENDIF
+!!
+!!
+!! idealized atmospheric state
+!!
+!****MARS
+
+
+!!!!caca caca
+!print *, 'u multiplied by 3'
+!grid%em_u_gc=grid%em_u_gc*3.
+!grid%em_v_gc=grid%em_v_gc*3.
+!!!!caca caca
+
+
+
+
+         !  If we have any input low-res surface pressure, we store it.
+
+!!****MARS
+!!fix pour être certain d'être avec les bons flag
+print *,flag_psfc
+print *,flag_soilhgt
+print *,flag_metgrid
+
+flag_psfc=1
+flag_soilhgt=1
+flag_metgrid=1
+!!**** TODO: trouver quand même pourquoi ça donne 0 :)
+pa=999999.
+!!****MARS
+
+         IF ( flag_psfc .EQ. 1 ) THEN
+            DO j = jts, MIN(jte,jde-1)
+              DO i = its, MIN(ite,ide-1)
+                 grid%em_psfc_gc(i,j) = grid%psfc(i,j)
+!!!****MARS: em_p_gc is only a way to count vertical levels in WPS :)
+!!!****MARS: is filled here with real pressure levels
+grid%em_p_gc(i,:,j) = grid%em_rh_gc(i,:,j)
+!!!****MARS
+                 grid%em_p_gc(i,1,j) = grid%psfc(i,j)
+!!!****MARS
+IF (pa .gt. grid%em_p_gc(i,1,j)) pa=grid%em_p_gc(i,1,j)
+!!!****MARS
+              END DO
+            END DO
+         END IF
+print *, 'found minimum pressure (Pa) :',pa
+
+
+!!!!****MARS
+!!!!****MARS
+!!!! define new hybrid coordinate levels
+!!!! with transition level between sigma and pressure
+!!!! lower than input data
+!
+!
+!        !--get vertical size of the GCM input array
+!        sizegcm=SIZE(grid%em_rh_gc(1,:,1))
+!        ALLOCATE(sig(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+!        ALLOCATE(ap(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+!        ALLOCATE(bp(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+!        !ALLOCATE(box(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+!
+!
+!
+!        !--define sigma levels, 
+!        !--then derive new sigma levels, and new pressure levels
+!        DO j = jts, MIN(jte,jde-1)
+!          DO i = its, MIN(ite,ide-1)
+!
+!                ! old sigma levels
+!                sig(i,:,j)=grid%em_p_gc(i,:,j)/grid%em_psfc_gc(i,j)
+!!                sig(i,:,j)=grid%em_p_gc(20,:,20)/grid%em_psfc_gc(20,20)
+!                ! new pressure levels
+!                ! - pressure_new = ap_new + bp_new * ps_gcm
+!                ! - bp_new is converging more rapidly than bp
+!                !   ... while conserving the same structure near the surface
+!                !
+!                ! NB: grid%zap_close_levels ne sert pas dans vert_interp_old :)
+!                ! NB: peut donc servir pour préciser une constante reelle
+!                ! NB: qui permet de rehausser la zone de transition
+!                !
+!                bp(i,:,j)=sqrt(sqrt(exp(1.-1./(sig(i,:,j)**4))))
+!                ap(i,:,j)=pa*exp(-grid%zap_close_levels/10.)*(sig(i,:,j)-bp(i,:,j))
+!                grid%em_rh_gc(i,:,j)=ap(i,:,j)+bp(i,:,j)*grid%em_psfc_gc(i,j)
+!
+!                ! avoid extrapolation at the top 
+!                ! -- the last level is thus unsignificant
+!                grid%em_p_gc(i,sizegcm,j)=grid%em_p_gc(i,sizegcm,j)/100.
+!!                grid%em_p_gc(i,sizegcm,j)=grid%em_p_gc(i,sizegcm,j)/10000.
+!
+!          ENDDO
+!        ENDDO
+!
+!
+!
+!
+!        !-- check that the biggest differences are higher
+!        print *, 'sigma levels'
+!        print *, sig(its+1,:,jts+1)
+!        print *, 'old pressure levels'
+!        print *, grid%em_p_gc(its+1,:,jts+1)
+!        print *, 'new pressure levels'
+!        print *, grid%em_rh_gc(its+1,:,jts+1)
+!
+!!print *, 't_gc', SIZE(grid%em_t_gc(1,:,1))
+!!print *, 'p_gc', SIZE(grid%em_p_gc(1,:,1))
+!!print *, 't_2', SIZE(grid%em_t_2(1,:,1))
+!!print *, 'rh_gc', SIZE(grid%em_rh_gc(1,:,1))
+!
+!
+!!--------
+!!-- interpolate on the new pressure levels
+!!--------
+!
+!        DO j = jts, MIN(jte,jde-1)
+!          DO i = its, MIN(ite,ide-1)
+!
+!DO knew = 1,sizegcm     ! loop on each level of the new grid
+!
+!        DO kold = 1,sizegcm-1   ! find the two enclosing levels
+!
+!                ! indic becomes negative when the two levels are found
+!                indic=(grid%em_p_gc(i,kold,j)-grid%em_rh_gc(i,knew,j))&
+!                        *(grid%em_p_gc(i,kold+1,j)-grid%em_rh_gc(i,knew,j))
+!
+!                ! 1. the two levels are found - define p1,p2,pn and exit the loop
+!                IF (indic < 0.) THEN 
+!                        !IF ((i == its) .AND. (j == jts)) THEN   !just a check
+!                        !        print *, 'new level', grid%em_rh_gc(i,knew,j)
+!                        !        print *, 'interp levels', grid%em_p_gc(i,kold,j), &
+!                        !                grid%em_p_gc(i,kold+1,j)
+!                        !ENDIF
+!                p1 = ALOG(grid%em_p_gc(i,kold,j))
+!                p2 = ALOG(grid%em_p_gc(i,kold+1,j))
+!                pn = ALOG(grid%em_rh_gc(i,knew,j))
+!                EXIT
+!
+!                ! 2. must handle the case (usually close to the surface) 
+!                ! of similar new/old levels - then exit with the right kold value
+!                ELSE IF (1-abs(grid%em_rh_gc(i,knew,j)/grid%em_p_gc(i,kold,j)) .lt. 1e-8) THEN
+!                        !print *,grid%em_p_gc(i,kold,j),grid%em_rh_gc(i,knew,j)  
+!                EXIT
+!                ELSE IF (1-abs(grid%em_rh_gc(i,knew,j)/grid%em_p_gc(i,kold+1,j)) .lt. 1e-8) THEN
+!                        !print *,grid%em_p_gc(i,kold+1,j),grid%em_rh_gc(i,knew,j)
+!                        kold=kold+1
+!                EXIT
+!
+!                ! 3. continue looping if the two levels are not found ....
+!                ENDIF 
+!        ENDDO
+!
+!        ! this is an initialization, useful for case 2 (and erased just below if case 1)
+!        grid%em_t_2(i,knew,j)= grid%em_t_gc(i,kold,j)
+!        grid%em_u_2(i,knew,j)= grid%em_u_gc(i,kold,j)
+!        grid%em_v_2(i,knew,j)= grid%em_v_gc(i,kold,j)
+!
+!        ! case 1: OK, in the previous loop, the two levels were found, and stored in p1 and p2
+!        ! ... thus interpolation can be performed
+!        IF (indic < 0.) THEN
+!        grid%em_t_2(i,knew,j)= ( grid%em_t_gc(i,kold,j) * ( p2 - pn )   + &
+!                                 grid%em_t_gc(i,kold+1,j) * ( pn - p1 ) ) / &
+!                                 ( p2 - p1 )
+!        grid%em_u_2(i,knew,j)= ( grid%em_u_gc(i,kold,j) * ( p2 - pn )   + &
+!                                 grid%em_u_gc(i,kold+1,j) * ( pn - p1 ) ) / &
+!                                 ( p2 - p1 )
+!        grid%em_v_2(i,knew,j)= ( grid%em_v_gc(i,kold,j) * ( p2 - pn )   + &
+!                                 grid%em_v_gc(i,kold+1,j) * ( pn - p1 ) ) / &
+!                                 ( p2 - p1 )
+!        ENDIF
+!
+!
+!ENDDO
+!
+!          ENDDO
+!        ENDDO
+!grid%em_u_2(MIN(ite,ide-1)+1,:,:)=grid%em_u_2(MIN(ite,ide-1),:,:)
+!grid%em_v_2(:,:,MIN(jte,jde-1)+1)=grid%em_v_2(:,:,MIN(jte,jde-1))
+!!--------
+!!-- end - interpolate on the new pressure levels
+!!--------
+
+
+!        !-- interpolate on the new pressure levels
+!        CALL vert_interp_old ( grid%em_t_gc , &         ! --- interpolate this field
+!                               grid%em_p_gc, &          ! --- with coordinates
+!                               grid%em_t_2, &           ! --- to obtain the new field
+!                               grid%em_rh_gc, &         ! --- on coordinates
+!                               sizegcm, &
+!                               'T', &           ! --- no staggering (will be done later)
+!                               2, &             ! --- log p interpolation   
+!                               1, &             ! --- (0) lagrange_order
+!                               .false., &       ! --- (0) lowest_lev_from_sfc
+!                               0., &            ! --- (0) zap_close_levels
+!                               0, &             ! --- (0) force_sfc_in_vinterp
+!                               ids , ide , jds , jde , kds , kde , &
+!                               ims , ime , jms , jme , kms , kme , &
+!                               its , ite , jts , jte , kts , kte )
+!        CALL vert_interp_old ( grid%em_u_gc , &         ! --- interpolate this field
+!                               grid%em_p_gc, &          ! --- with coordinates
+!                               grid%em_u_2 , &          ! --- to obtain the new field
+!                               grid%em_rh_gc, &         ! --- on coordinates
+!                               sizegcm, &
+!                               'U', &           ! --- no staggering (will be done later)
+!                               2, &             ! --- log p interpolation
+!                               1, &             ! --- (0) lagrange_order
+!                               .false., &       ! --- (0) lowest_lev_from_sfc
+!                               0., &            ! --- (0) zap_close_levels
+!                               0, &             ! --- (0) force_sfc_in_vinterp
+!                               ids , ide , jds , jde , kds , kde , &
+!                               ims , ime , jms , jme , kms , kme , &
+!                               its , ite , jts , jte , kts , kte )
+!        CALL vert_interp_old ( grid%em_v_gc , &         ! --- interpolate this field
+!                               grid%em_p_gc, &          ! --- with coordinates
+!                               grid%em_v_2 , &          ! --- to obtain the new field
+!                               grid%em_rh_gc, &         ! --- on coordinates
+!                               sizegcm, &
+!                               'V', &           ! --- no staggering (will be done later)
+!                               2, &             ! --- log p interpolation
+!                               1, &             ! --- (0) lagrange_order
+!                               .false., &       ! --- (0) lowest_lev_from_sfc
+!                               0., &            ! --- (0) zap_close_levels
+!                               0, &             ! --- (0) force_sfc_in_vinterp
+!                               !ids , ide , jds , jde , kds , sizegcm , &
+!                               !ims , ime , jms , jme , kms , sizegcm , &
+!                               !its , ite , jts , jte , kts , sizegcm )
+!                               ids , ide , jds , jde , kds , kde , &
+!                               ims , ime , jms , jme , kms , kme , &
+!                               its , ite , jts , jte , kts , kte )
+!
+!
+!        !-- save the new field and the new pressure coordinates
+!        !-- these will be regarded now as the inputs from the GCM
+!        grid%em_t_gc=grid%em_t_2
+!        grid%em_t_2(:,:,:)=0.
+!        grid%em_u_gc=grid%em_u_2
+!        grid%em_u_2(:,:,:)=0.
+!        grid%em_v_gc=grid%em_v_2
+!        grid%em_v_2(:,:,:)=0.
+!        grid%em_p_gc=grid%em_rh_gc      
+!        grid%em_rh_gc(:,:,:)=0.
+!!!!****MARS
+!!!****MARS
+
+
+
+
+         !  If we have the low-resolution surface elevation, stick that in the
+         !  "input" locations of the 3d height.  We still have the "hi-res" topo
+         !  stuck in the grid%em_ht array.  The grid%landmask if test is required as some sources
+         !  have ZERO elevation over water (thank you very much).
+
+         IF ( flag_soilhgt .EQ. 1) THEN
+            DO j = jts, MIN(jte,jde-1)
+               DO i = its, MIN(ite,ide-1)
+                  IF ( grid%landmask(i,j) .GT. 0.5 ) THEN
+                     grid%em_ght_gc(i,1,j) = grid%toposoil(i,j)
+                     grid%em_ht_gc(i,j)= grid%toposoil(i,j)
+                  END IF
+               END DO
+           END DO
+         END IF
+
+         !  Assign surface fields with original input values.  If this is hybrid data, 
+         !  the values are not exactly representative.  However - this is only for
+         !  plotting purposes and such at the 0h of the forecast, so we are not all that
+         !  worried.
+
+!****MARS
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide,ite)
+!               grid%u10(i,j)=grid%em_u_gc(i,1,j)
+!            END DO
+!         END DO
+!   
+!         DO j = jts, min(jde,jte)
+!            DO i = its, min(ide-1,ite)
+!               grid%v10(i,j)=grid%em_v_gc(i,1,j)
+!            END DO
+!         END DO
+!****MARS   
+
+         DO j = jts, min(jde-1,jte)
+            DO i = its, min(ide-1,ite)
+               grid%t2(i,j)=grid%em_t_gc(i,1,j)
+            END DO
+         END DO
+
+         IF ( flag_qv .EQ. 1 ) THEN
+            DO j = jts, min(jde-1,jte)
+               DO i = its, min(ide-1,ite)
+                  grid%q2(i,j)=grid%em_qv_gc(i,1,j)
+               END DO
+            END DO
+         END IF
+   
+         !  The number of vertical levels in the input data.  There is no staggering for
+         !  different variables.
+   
+         num_metgrid_levels = grid%num_metgrid_levels
+
+         !  The requested ptop for real data cases.
+
+         p_top_requested = grid%p_top_requested
+
+         !  Compute the top pressure, grid%p_top.  For isobaric data, this is just the
+         !  top level.  For the generalized vertical coordinate data, we find the
+         !  max pressure on the top level.  We have to be careful of two things:
+         !  1) the value has to be communicated, 2) the value can not increase
+         !  at subsequent times from the initial value.
+
+         IF ( internal_time_loop .EQ. 1 ) THEN
+
+                CALL find_p_top ( grid%em_p_gc , grid%p_top , &
+                              ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                              ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                              its , ite , jts , jte , 1   , num_metgrid_levels )
+
+!! ^---- equivalent to:
+!!grid%ptop=MINVAL(grid%em_p_gc(:,:,:))
+
+
+
+!!!!obsolete
+!print *,'ptop GCM',grid%em_rh_gc(2,1,2)
+!IF (grid%em_rh_gc(2,1,2) == 0) THEN
+!        print *,'ptop cannot be 0' 
+!        stop        
+!ENDIF  
+!grid%p_top=grid%em_rh_gc(2,1,2)
+!!!!obsolete
+
+
+#ifdef DM_PARALLEL
+            grid%p_top = wrf_dm_max_real ( grid%p_top )
+#endif
+
+            !  Compare the requested grid%p_top with the value available from the input data.
+
+               print *,'p_top_requested = ',p_top_requested
+               print *,'allowable grid%p_top in data   = ',grid%p_top
+            IF ( p_top_requested .LT. grid%p_top ) THEN   
+               CALL wrf_error_fatal ( 'p_top_requested < grid%p_top possible from data' )
+            END IF
+
+            !  The grid%p_top valus is the max of what is available from the data and the
+            !  requested value.  We have already compared <, so grid%p_top is directly set to
+            !  the value in the namelist.
+
+            grid%p_top = p_top_requested
+
+            !  For subsequent times, we have to remember what the grid%p_top for the first
+            !  time was.  Why?  If we have a generalized vert coordinate, the grid%p_top value
+            !  could fluctuate.
+
+            p_top_save = grid%p_top
+
+         ELSE
+            CALL find_p_top ( grid%em_p_gc , grid%p_top , &
+                              ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                              ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                              its , ite , jts , jte , 1   , num_metgrid_levels )
+
+#ifdef DM_PARALLEL
+            grid%p_top = wrf_dm_max_real ( grid%p_top )
+#endif
+            IF ( grid%p_top .GT. p_top_save ) THEN
+               print *,'grid%p_top from last time period = ',p_top_save
+               print *,'grid%p_top from this time period = ',grid%p_top
+               CALL wrf_error_fatal ( 'grid%p_top > previous value' )
+            END IF
+            grid%p_top = p_top_save
+         ENDIF
+
+
+!****MARS
+!****MARS
+print *,'ptop GCM', grid%p_top
+print *,'sample: pressure at its jts'
+print *,grid%em_p_gc(its,:,jts)
+!****MARS
+!****MARS
+
+  
+
+!****MARS: useless 
+!****MARS: 
+!         !  Get the monthly values interpolated to the current date for the traditional monthly
+!         !  fields of green-ness fraction and background albedo.
+!   
+!         CALL monthly_interp_to_date ( grid%em_greenfrac , current_date , grid%vegfra , &
+!                                       ids , ide , jds , jde , kds , kde , &
+!                                       ims , ime , jms , jme , kms , kme , &
+!                                       its , ite , jts , jte , kts , kte )
+!  
+!         CALL monthly_interp_to_date ( grid%em_albedo12m , current_date , grid%albbck , &
+!                                       ids , ide , jds , jde , kds , kde , &
+!                                       ims , ime , jms , jme , kms , kme , &
+!                                       its , ite , jts , jte , kts , kte )
+!   
+!         !  Get the min/max of each i,j for the monthly green-ness fraction.
+!   
+!         CALL monthly_min_max ( grid%em_greenfrac , grid%shdmin , grid%shdmax , &
+!                                ids , ide , jds , jde , kds , kde , &
+!                                ims , ime , jms , jme , kms , kme , &
+!                                its , ite , jts , jte , kts , kte )
+!
+!          !  The model expects the green-ness values in percent, not fraction.
+!
+!         DO j = jts, MIN(jte,jde-1)
+!           DO i = its, MIN(ite,ide-1)
+!              grid%vegfra(i,j) = grid%vegfra(i,j) * 100.
+!              grid%shdmax(i,j) = grid%shdmax(i,j) * 100.
+!              grid%shdmin(i,j) = grid%shdmin(i,j) * 100.
+!           END DO
+!         END DO
+!
+!         !  The model expects the albedo fields as a fraction, not a percent.  Set the
+!         !  water values to 8%.
+!
+!         DO j = jts, MIN(jte,jde-1)
+!           DO i = its, MIN(ite,ide-1)   
+!		grid%albbck(i,j) = grid%albbck(i,j) / 100.
+!              grid%snoalb(i,j) = grid%snoalb(i,j) / 100.
+!              IF ( grid%landmask(i,j) .LT. 0.5 ) THEN
+!                 grid%albbck(i,j) = 0.08
+!                 grid%snoalb(i,j) = 0.08
+!              END IF
+!           END DO
+!         END DO
+!!****MARS:
+!!****MARS: useless 
+
+
+ 
+
+!!****MARS:  
+!         !  Compute the mixing ratio from the input relative humidity.
+!   
+!         IF ( flag_qv .NE. 1 ) THEN
+!            CALL rh_to_mxrat (grid%em_rh_gc, grid%em_t_gc, grid%em_p_gc, grid%em_qv_gc , .TRUE. , &
+!                              ids , ide , jds , jde , 1   , num_metgrid_levels , &
+!                              ims , ime , jms , jme , 1   , num_metgrid_levels , &
+!                              its , ite , jts , jte , 1   , num_metgrid_levels )
+!         END IF
+!!****MARS:
+!!grid%em_rh_gc are GCM equivalent eta_levels
+!!****MARS
+
+
+
+
+         !  Two ways to get the surface pressure.  1) If we have the low-res input surface
+         !  pressure and the low-res topography, then we can do a simple hydrostatic
+         !  relation.  2) Otherwise we compute the surface pressure from the sea-level
+         !  pressure.
+         !  Note that on output, grid%em_psfc is now hi-res.  The low-res surface pressure and 
+         !  elevation are grid%em_psfc_gc and grid%em_ht_gc (same as grid%em_ght_gc(k=1)).
+
+!!****MARS: switch off this option 
+!!****MARS: --> cf sfcprs2 and geopotential function at 500mb
+!         IF ( config_flags%adjust_heights ) THEN
+!            we_have_tavgsfc = ( flag_tavgsfc == 1 ) 
+!         ELSE
+!            we_have_tavgsfc = .FALSE.
+!         END IF
+!****MARS:
+we_have_tavgsfc = .FALSE.
+
+
+
+!****MARS: hi-res psfc is done if the flag 'sfcp_to_sfcp' is active (recommended)
+         IF ( ( flag_psfc .EQ. 1 ) .AND. ( flag_soilhgt .EQ. 1 ) .AND. &
+              ( config_flags%sfcp_to_sfcp ) ) THEN
+            print *,'compute psfc from hi-res topography'
+            CALL sfcprs2(grid%em_t_gc, grid%em_qv_gc, grid%em_ght_gc, grid%em_psfc_gc, grid%ht, &
+                         grid%em_tavgsfc, grid%em_p_gc, grid%psfc, we_have_tavgsfc, &
+                         ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                         ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                         its , ite , jts , jte , 1   , num_metgrid_levels )
+                         !****MARS: here, in reality, grid%em_p_gc is not used
+
+!****MARS: no sea-level pressure inputs possible
+!         ELSE
+!            CALL sfcprs (grid%em_t_gc, grid%em_qv_gc, grid%em_ght_gc, grid%em_pslv_gc, grid%ht, &
+!                         grid%em_tavgsfc, grid%em_p_gc, grid%psfc, we_have_tavgsfc, &
+!                         ids , ide , jds , jde , 1   , num_metgrid_levels , &
+!                         ims , ime , jms , jme , 1   , num_metgrid_levels , &
+!                         its , ite , jts , jte , 1   , num_metgrid_levels )
+!****MARS: no sea-level pressure inputs possible
+
+ 
+            !  If we have no input surface pressure, we'd better stick something in there.
+
+            IF ( flag_psfc .NE. 1 ) THEN
+               DO j = jts, MIN(jte,jde-1)
+                 DO i = its, MIN(ite,ide-1)
+                    grid%em_psfc_gc(i,j) = grid%psfc(i,j)
+                    grid%em_p_gc(i,1,j) = grid%psfc(i,j)
+                 END DO
+               END DO
+            END IF
+
+         END IF
+
+
+!!!****MARS: 
+!!!****MARS: old stuff
+!!! grid%em_p_gc is needed ... so it is computed from eta_gcm
+!
+!print *,'computing pressure levels for input data...'
+!
+!        !! pressure is computed from eta_gcm and hi-res topography
+!        DO j = jts, MIN(jte,jde-1)
+!        DO i = its, MIN(ite,ide-1)  
+!!!psfc ou em_psfc_gc ? em_psfc_gc, sinon c'est faux et déclenche instabilités 
+!grid%em_p_gc(i,:,j)=grid%em_rh_gc(i,:,j)*(grid%em_psfc_gc(i,j)-grid%em_rh_gc(2,1,2))+grid%em_rh_gc(2,1,2)
+!grid%em_p_gc(i,1,j)=grid%em_psfc_gc(i,j)
+!
+!
+!        END DO
+!        END DO
+!!
+!!****MARS: 
+
+
+
+         !!  Integrate the mixing ratio to get the vapor pressure.
+         !
+         !CALL integ_moist ( grid%em_qv_gc , grid%em_p_gc , grid%em_pd_gc , grid%em_t_gc , grid%em_ght_gc , grid%em_intq_gc , &
+         !                   ids , ide , jds , jde , 1   , num_metgrid_levels , &
+         !                   ims , ime , jms , jme , 1   , num_metgrid_levels , &
+         !                   its , ite , jts , jte , 1   , num_metgrid_levels )
+
+
+!!****MARS
+!!****MARS
+!! and now, convert the GCM sigma levels into WRF sigma levels using hi-res surface pressure 
+!!DO j = jts , MIN ( jde-1 , jte )
+!!DO i = its , MIN (ide-1 , ite )
+!!
+!!   grid%em_pd_gc(i,:,j)=ap(i,:,j)+bp(i,:,j)*grid%psfc(i,j)
+!!
+!!END DO
+!!END DO
+
+
+!--get vertical size of the GCM input array and allocate new stuff
+sizegcm=SIZE(grid%em_rh_gc(1,:,1))
+ALLOCATE(sig(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+!ALLOCATE(ap(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+ALLOCATE(bp(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
+
+DO j = jts , MIN ( jde-1 , jte )
+DO i = its , MIN (ide-1 , ite )
+
+!!! Define old sigma levels for each column
+        sig(i,:,j)=grid%em_p_gc(i,:,j)/grid%em_psfc_gc(i,j)
+
+!!! Compute new sigma levels from old sigma levels with GCM (low-res) and WRF (hi-res) surface pressure 
+!!!                        (dimlevs,sigma_gcm, ps_gcm,                ps_hr,         sigma_hr)
+        CALL build_sigma_hr(sizegcm,sig(i,:,j),grid%em_psfc_gc(i,j),grid%psfc(i,j),bp(i,:,j))
+
+!!! Calculate new pressure levels
+        grid%em_pd_gc(i,:,j)=bp(i,:,j)*grid%psfc(i,j)
+
+END DO
+END DO
+
+
+
+
+!!****MARS
+!grid%em_pd_gc=grid%em_p_gc
+!!****MARS
+
+
+
+   
+         !!  Compute the difference between the dry, total surface pressure (input) and the 
+         !!  dry top pressure (constant).
+         !
+         !CALL p_dts ( grid%em_mu0 , grid%em_intq_gc , grid%psfc , grid%p_top , &
+         !             ids , ide , jds , jde , 1   , num_metgrid_levels , &
+         !             ims , ime , jms , jme , 1   , num_metgrid_levels , &
+         !             its , ite , jts , jte , 1   , num_metgrid_levels )
+
+!!****MARS
+DO j = jts , MIN ( jde-1 , jte )
+DO i = its , MIN (ide-1 , ite )
+
+   grid%em_mu0(i,j) = grid%psfc(i,j) - grid%p_top
+
+END DO
+END DO
+!!****MARS
+
+   
+         !!  Compute the dry, hydrostatic surface pressure.
+         !
+         !CALL p_dhs ( grid%em_pdhs , grid%ht , p00 , t00 , a , &
+         !             ids , ide , jds , jde , kds , kde , &
+         !             ims , ime , jms , jme , kms , kme , &
+         !             its , ite , jts , jte , kts , kte )
+!!****MARS: voir remarques dans la routine
+!!****MARS: dry hydrostatic pressure comes from the GCM ...
+!        DO j = jts , MIN ( jde-1 , jte )
+!        DO i = its , MIN (ide-1 , ite )
+!              grid%em_pdhs(i,j) = grid%psfc(i,j)
+!        END DO
+!      	 END DO
+!!****MARS: em_pdhs ne sert qu'ici !         
+
+   
+         !  Compute the eta levels if not defined already.
+
+!!TODO: pb when ptop<1Pa
+         
+         IF ( grid%em_znw(1) .NE. 1.0 ) THEN
+   
+            eta_levels(1:kde) = model_config_rec%eta_levels(1:kde)
+            max_dz            = model_config_rec%max_dz
+
+!!****MARS
+IF (grid%force_sfc_in_vinterp == 0) grid%force_sfc_in_vinterp = 8
+!!default choice
+!!****MARS
+
+            CALL compute_eta ( grid%em_znw , &
+                               eta_levels , max_eta , max_dz , &
+grid%force_sfc_in_vinterp, &    !!ne sert pas par ailleurs
+                               grid%p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0 , &
+                               ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte )
+         END IF
+   
+         !  The input field is temperature, we want potential temp.
+!****MARS: here em_p_gc is really needed ! 
+         CALL t_to_theta ( grid%em_t_gc , grid%em_p_gc , p00 , &
+                           ids , ide , jds , jde , 1   , num_metgrid_levels , &
+                           ims , ime , jms , jme , 1   , num_metgrid_levels , &
+                           its , ite , jts , jte , 1   , num_metgrid_levels )
+   
+
+
+         !  On the eta surfaces, compute the dry pressure = mu eta, stored in 
+         !  grid%em_pb, since it is a pressure, and we don't need another kms:kme 3d
+         !  array floating around.  The grid%em_pb array is re-computed as the base pressure
+         !  later after the vertical interpolations are complete.
+         CALL p_dry ( grid%em_mu0 , grid%em_znw , grid%p_top , grid%em_pb , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+!****MARS
+!****MARS: old stuff
+!****MARS
+!!! and now eta levels from the GCM are computed with the WRF ptop and GCM psfc
+!!! and em_pb is filled with WRF eta levels to prepare interpolation
+!print *,'computing eta levels for input data...'
+!        DO j = jts, MIN(jte,jde-1)
+!        DO i = its, MIN(ite,ide-1)
+!
+!!grid%em_psfc_gc: pb en haut!!!!
+!!!!valeurs plus grandes que 1 et extrapolation
+!!grid%em_p_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%psfc(i,j)-grid%p_top)
+!!!!utile si l'on est proche de la surface, mais pb plus haut !
+!grid%em_p_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%em_psfc_gc(i,j)-grid%p_top)
+!grid%em_pb(i,:,j)=grid%em_znw(:)
+!
+!!
+!!!!manage negative values
+!!DO k=1,num_metgrid_levels
+!!        grid%em_p_gc(i,k,j)=MAX(0.,grid%em_p_gc(i,k,j))
+!!END DO
+!!
+!
+!        END DO
+!        END DO
+!!
+!!print *,'sample: eta GCM at its jts'
+!!print *,grid%em_p_gc(its,:,jts)
+!!print *,'sample: eta WRF at its jts'
+!!print *,grid%em_pb(its,:,jts)
+!!
+!!print *,grid%em_p_gc(:,2,:)
+!!print *, 'yeah yeah'
+!!grid%em_pd_gc(:,:,:)=grid%em_p_gc(:,:,:)
+!!
+!****MARS
+!****MARS: old stuff
+!****MARS
+
+
+
+
+         !  All of the vertical interpolations are done in dry-pressure space.  The
+         !  input data has had the moisture removed (grid%em_pd_gc).  The target levels (grid%em_pb)
+         !  had the vapor pressure removed from the surface pressure, then they were
+         !  scaled by the eta levels.
+
+         interp_type = grid%interp_type
+         lagrange_order = grid%lagrange_order
+         lowest_lev_from_sfc = grid%lowest_lev_from_sfc
+         zap_close_levels = grid%zap_close_levels
+         force_sfc_in_vinterp = grid%force_sfc_in_vinterp
+
+         !!****MARS: normalement c'est vert_interp
+         !!****MARS: mais les résultats sont trop discontinus > retour à une
+         !!****MARS: interpolation plus classique
+         CALL vert_interp_old ( grid%em_qv_gc , grid%em_pd_gc , moist(:,:,:,P_QV) , grid%em_pb , &
+                            num_metgrid_levels , 'Q' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+ 
+         !!****MARS: normalement c'est vert_interp
+         CALL vert_interp_old ( grid%em_t_gc , grid%em_pd_gc , grid%em_t_2               , grid%em_pb , &
+                            num_metgrid_levels , 'T' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+
+#if 0
+         !  Uncomment the Registry entries to activate these.  This adds
+         !  noticeably to the allocated space for the model.
+ 
+         IF ( flag_qr .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QR ) THEN
+                  CALL vert_interp_old ( qr_gc , grid%em_pd_gc , moist(:,:,:,P_QR) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+    
+         IF ( flag_qc .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QC ) THEN
+                  CALL vert_interp_old ( qc_gc , grid%em_pd_gc , moist(:,:,:,P_QC) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+   
+         IF ( flag_qi .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QI ) THEN
+                  CALL vert_interp_old ( qi_gc , grid%em_pd_gc , moist(:,:,:,P_QI) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+   
+         IF ( flag_qs .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QS ) THEN
+                  CALL vert_interp_old ( qs_gc , grid%em_pd_gc , moist(:,:,:,P_QS) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+   
+         IF ( flag_qg .EQ. 1 ) THEN
+            DO im = PARAM_FIRST_SCALAR, num_3d_m
+               IF ( im .EQ. P_QG ) THEN
+                  CALL vert_interp_old ( qg_gc , grid%em_pd_gc , moist(:,:,:,P_QG) , grid%em_pb , &
+                                     num_metgrid_levels , 'Q' , &
+                                     interp_type , lagrange_order , lowest_lev_from_sfc , &
+                                     zap_close_levels , force_sfc_in_vinterp , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte )
+               END IF
+            END DO
+         END IF
+#endif
+   
+#ifdef DM_PARALLEL
+         ips = its ; ipe = ite ; jps = jts ; jpe = jte ; kps = kts ; kpe = kte
+
+         !  For the U and V vertical interpolation, we need the pressure defined
+         !  at both the locations for the horizontal momentum, which we get by
+         !  averaging two pressure values (i and i-1 for U, j and j-1 for V).  The
+         !  pressure field on input (grid%em_pd_gc) and the pressure of the new coordinate
+         !  (grid%em_pb) are both communicated with an 8 stencil.
+
+#   include "HALO_EM_VINTERP_UV_1.inc"
+#endif
+
+        !!****MARS: normalement c'est vert_interp
+        CALL vert_interp_old ( grid%em_u_gc , grid%em_pd_gc , grid%em_u_2, grid%em_pb , &
+                            num_metgrid_levels , 'U' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+        !!****MARS: normalement c'est vert_interp   
+        CALL vert_interp_old ( grid%em_v_gc , grid%em_pd_gc , grid%em_v_2, grid%em_pb , &
+                        num_metgrid_levels , 'V' , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+
+!!****MARS
+!!****MARS
+!!
+!! old obsolete method
+!! -------------------
+!!
+!!! and now eta levels from the GCM are computed with the WRF ptop and GCM psfc
+!!! and em_pb is filled with WRF eta levels to prepare interpolation
+!print *,'computing eta levels for input data...'
+!
+!        DO j = jts, MIN(jte,jde-1)
+!        DO i = its, MIN(ite,ide-1)
+!
+!!       grid%em_psfc_gc: pb en haut!!!!
+!!!!valeurs plus grandes que 1 et extrapolation
+!!       grid%em_p_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%psfc(i,j)-grid%p_top)
+!!!!utile si l'on est proche de la surface, mais pb plus haut !
+!grid%em_pd_gc(i,:,j)=(grid%em_p_gc(i,:,j)-grid%p_top)/(grid%em_psfc_gc(i,j)-grid%p_top)
+!grid%em_pb(i,:,j)=grid%em_znw(:)
+!
+!!
+!!!!manage negative values
+!!DO k=1,num_metgrid_levels
+!!        grid%em_p_gc(i,k,j)=MAX(0.,grid%em_p_gc(i,k,j))
+!!END DO
+!!
+!
+!        END DO
+!        END DO
+!
+!print *,'sample: eta GCM at its jts'
+!print *,grid%em_pd_gc(its,:,jts)
+!print *,'sample: eta WRF at its jts'
+!print *,grid%em_pb(its,:,jts)
+!!
+!!!****MARS
+!
+!
+!
+!!!!****MARS
+!!!!
+!!!!grid%force_sfc_in_vinterp ne sert pas dans vert_interp_old :)
+!!!!peut donc servir pour préciser le nombre de niveaux
+!!!!pris à partir de l'interpolation eta
+!
+!IF (grid%force_sfc_in_vinterp .NE. 0) THEN
+!
+!         !!!save in an array that is now unused
+!         !!!the previously performed pressure interpolation
+!         grid%em_qv_gc(:,:,:)=grid%em_t_2(:,:,:)
+!
+!
+!         !!!perform interpolation on eta levels
+!         print *, 'interpolate on eta levels for near-surface fields' 
+!         CALL vert_interp_old ( grid%em_t_gc , grid%em_pd_gc , grid%em_t_2, grid%em_pb , &
+!                            num_metgrid_levels , 'T' , &
+!                            interp_type , lagrange_order , lowest_lev_from_sfc ,&
+!                            zap_close_levels , force_sfc_in_vinterp , &
+!                            ids , ide , jds , jde , kds , kde , &
+!                            ims , ime , jms , jme , kms , kme , &
+!                            its , ite , jts , jte , kts , kte )
+!
+!         !!!take the first layers from the eta interpolation
+!         print *, 'the first ', &
+!                grid%force_sfc_in_vinterp, &
+!                'layers will be taken from eta interpolation'
+!         grid%em_qv_gc(:,1:grid%force_sfc_in_vinterp,:)=grid%em_t_2(:,1:grid%force_sfc_in_vinterp,:)
+!
+!         !!!fix the possible little discontinuity at the limit
+!         !!!between the two interpolation methods
+!         grid%em_qv_gc(:,grid%force_sfc_in_vinterp+1,:)=  &
+!                0.5*(grid%em_t_2(:,grid%force_sfc_in_vinterp,:) + &     !!eta interpolation below
+!                        grid%em_qv_gc(:,grid%force_sfc_in_vinterp+2,:))  !!pressure interpolation above
+!         
+!
+!         !!!assign the final result in t_2
+!         grid%em_t_2(:,:,:)=grid%em_qv_gc(:,:,:)
+!         grid%em_qv_gc(:,:,:)=0.
+!
+!
+!ELSE
+!
+!
+!ENDIF
+!!****MARS
+!!****MARS
+
+
+      END IF     !   <----- END OF VERTICAL INTERPOLATION PART ---->
+
+
+
+!****MARS: no need
+!      !  Protect against bad grid%em_tsk values over water by supplying grid%sst (if it is 
+!      !  available, and if the grid%sst is reasonable).
+!
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+!                 ( grid%sst(i,j) .GT. 200. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+!               grid%tsk(i,j) = grid%sst(i,j)
+!            ENDIF            
+!         END DO
+!      END DO
+!
+!      !  Save the grid%em_tsk field for later use in the sea ice surface temperature
+!      !  for the Noah LSM scheme.
+!
+!       DO j = jts, MIN(jte,jde-1)
+!         DO i = its, MIN(ite,ide-1)
+!            grid%tsk_save(i,j) = grid%tsk(i,j)
+!         END DO
+!      END DO
+!
+!!****MARS: no need
+!      !  Take the data from the input file and store it in the variables that
+!      !  use the WRF naming and ordering conventions.
+!
+!       DO j = jts, MIN(jte,jde-1)
+!         DO i = its, MIN(ite,ide-1)
+!            IF ( grid%snow(i,j) .GE. 10. ) then
+!               grid%snowc(i,j) = 1.
+!            ELSE
+!               grid%snowc(i,j) = 0.0
+!            END IF
+!         END DO
+!      END DO
+!
+!      !  Set flag integers for presence of snowh and soilw fields
+!
+!      grid%ifndsnowh = flag_snowh
+!      IF (num_sw_levels_input .GE. 1) THEN
+!         grid%ifndsoilw = 1
+!      ELSE
+!         grid%ifndsoilw = 0
+!      END IF
+!
+!****MARS: no need
+!      !  We require input data for the various LSM schemes.
+!
+!      enough_data : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE (LSMSCHEME)
+!            IF ( num_st_levels_input .LT. 2 ) THEN
+!               CALL wrf_error_fatal ( 'Not enough soil temperature data for Noah LSM scheme.')
+!            END IF
+!
+!         CASE (RUCLSMSCHEME)
+!            IF ( num_st_levels_input .LT. 2 ) THEN
+!               CALL wrf_error_fatal ( 'Not enough soil temperature data for RUC LSM scheme.')
+!            END IF
+!
+!      END SELECT enough_data
+!
+!      !  For sf_surface_physics = 1, we want to use close to a 30 cm value
+!      !  for the bottom level of the soil temps.
+!
+!      fix_bottom_level_for_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE (SLABSCHEME)
+!            IF      ( flag_tavgsfc  .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%em_tavgsfc(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_st010040 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%st010040(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_st000010 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%st000010(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_soilt020 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%soilt020(i,j)
+!                  END DO
+!               END DO
+!            ELSE IF ( flag_st007028 .EQ. 1 ) THEN
+!               DO j = jts , MIN(jde-1,jte)
+!                  DO i = its , MIN(ide-1,ite)
+!                     grid%tmn(i,j) = grid%st007028(i,j)
+!                  END DO
+!               END DO
+!            ELSE
+!               CALL wrf_debug ( 0 , 'No 10-40 cm, 0-10 cm, 7-28, or 20 cm soil temperature data for grid%em_tmn')
+!               CALL wrf_debug ( 0 , 'Using 1 degree static annual mean temps' )
+!            END IF
+!
+!         CASE (LSMSCHEME)
+!
+!         CASE (RUCLSMSCHEME)
+!
+!      END SELECT fix_bottom_level_for_temp
+!
+!      !  Adjustments for the seaice field PRIOR to the grid%tslb computations.  This is
+!      !  is for the 5-layer scheme.
+!
+!      num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+!      num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+!      num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+!      CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+!      CALL nl_get_isice ( grid%id , grid%isice )
+!      CALL nl_get_iswater ( grid%id , grid%iswater )
+!      CALL adjust_for_seaice_pre ( grid%xice , grid%landmask , grid%tsk , grid%ivgtyp , grid%vegcat , grid%lu_index , &
+!                                   grid%xland , grid%landusef , grid%isltyp , grid%soilcat , grid%soilctop , &
+!                                   grid%soilcbot , grid%tmn , &
+!                                   grid%seaice_threshold , &
+!                                   num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+!                                   grid%iswater , grid%isice , &
+!                                   model_config_rec%sf_surface_physics(grid%id) , & 
+!                                   ids , ide , jds , jde , kds , kde , & 
+!                                   ims , ime , jms , jme , kms , kme , & 
+!                                   its , ite , jts , jte , kts , kte ) 
+!
+!      !  surface_input_source=1 => use data from static file (fractional category as input)
+!      !  surface_input_source=2 => use data from grib file (dominant category as input)
+!  
+!      IF ( config_flags%surface_input_source .EQ. 1 ) THEN
+!         grid%vegcat (its,jts) = 0
+!         grid%soilcat(its,jts) = 0
+!      END IF
+!
+!      !  Generate the vegetation and soil category information from the fractional input
+!      !  data, or use the existing dominant category fields if they exist.
+!
+!      IF ( ( grid%soilcat(its,jts) .LT. 0.5 ) .AND. ( grid%vegcat(its,jts) .LT. 0.5 ) ) THEN
+!
+!         num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+!         num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+!         num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+!   
+!         CALL process_percent_cat_new ( grid%landmask , &               
+!                                    grid%landusef , grid%soilctop , grid%soilcbot , &
+!                                    grid%isltyp , grid%ivgtyp , &
+!                                    num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+!                                    ids , ide , jds , jde , kds , kde , &
+!                                    ims , ime , jms , jme , kms , kme , &
+!                                    its , ite , jts , jte , kts , kte , &
+!                                    model_config_rec%iswater(grid%id) )
+!
+!         !  Make all the veg/soil parms the same so as not to confuse the developer.
+!
+!         DO j = jts , MIN(jde-1,jte)
+!            DO i = its , MIN(ide-1,ite)
+!               grid%vegcat(i,j)  = grid%ivgtyp(i,j)
+!               grid%soilcat(i,j) = grid%isltyp(i,j)
+!            END DO
+!         END DO
+!
+!      ELSE
+!
+!         !  Do we have dominant soil and veg data from the input already?
+!   
+!         IF ( grid%soilcat(its,jts) .GT. 0.5 ) THEN
+!            DO j = jts, MIN(jde-1,jte)
+!               DO i = its, MIN(ide-1,ite)
+!                  grid%isltyp(i,j) = NINT( grid%soilcat(i,j) )
+!               END DO
+!            END DO
+!         END IF
+!         IF ( grid%vegcat(its,jts) .GT. 0.5 ) THEN
+!            DO j = jts, MIN(jde-1,jte)
+!               DO i = its, MIN(ide-1,ite)
+!                  grid%ivgtyp(i,j) = NINT( grid%vegcat(i,j) )
+!               END DO
+!            END DO
+!         END IF
+!
+!      END IF
+!         
+!      !  Land use assignment.
+!
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            grid%lu_index(i,j) = grid%ivgtyp(i,j)
+!            IF ( grid%lu_index(i,j) .NE. model_config_rec%iswater(grid%id) ) THEN
+!               grid%landmask(i,j) = 1
+!               grid%xland(i,j)    = 1
+!            ELSE
+!               grid%landmask(i,j) = 0
+!               grid%xland(i,j)    = 2
+!            END IF
+!         END DO
+!      END DO
+!
+!      !  Adjust the various soil temperature values depending on the difference in
+!      !  in elevation between the current model's elevation and the incoming data's
+!      !  orography.
+!         
+!      IF ( flag_soilhgt .EQ. 1 ) THEN
+!         adjust_soil : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!            CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+!               CALL adjust_soil_temp_new ( grid%tmn , model_config_rec%sf_surface_physics(grid%id) , &
+!                                           grid%tsk , grid%ht , grid%toposoil , grid%landmask , flag_soilhgt , &
+!                                           grid%st000010 , grid%st010040 , grid%st040100 , grid%st100200 , grid%st010200 , &
+!                                           flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
+!                                           grid%st000007 , grid%st007028 , grid%st028100 , grid%st100255 , &
+!                                           flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
+!                                           grid%soilt000 , grid%soilt005 , grid%soilt020 , grid%soilt040 , grid%soilt160 , &
+!                                           grid%soilt300 , &
+!                                           flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , &
+!                                           flag_soilt160 , flag_soilt300 , &
+!                                           ids , ide , jds , jde , kds , kde , &
+!                                           ims , ime , jms , jme , kms , kme , &
+!                                           its , ite , jts , jte , kts , kte )
+!
+!         END SELECT adjust_soil
+!      END IF
+!
+!      !  Fix grid%em_tmn and grid%em_tsk.
+!
+!      fix_tsk_tmn : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+!            DO j = jts, MIN(jde-1,jte)
+!               DO i = its, MIN(ide-1,ite)
+!                  IF ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+!                       ( grid%sst(i,j) .GT. 240. ) .AND. ( grid%sst(i,j) .LT. 350. ) ) THEN
+!                     grid%tmn(i,j) = grid%sst(i,j)
+!                     grid%tsk(i,j) = grid%sst(i,j)
+!                  ELSE IF ( grid%landmask(i,j) .LT. 0.5 ) THEN
+!                     grid%tmn(i,j) = grid%tsk(i,j)
+!                  END IF
+!               END DO
+!            END DO
+!      END SELECT fix_tsk_tmn
+!    
+!      !  Is the grid%em_tsk reasonable?
+!
+
+
+!!**** MARS
+         DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+                !!grid%tsk(i,j)=200
+                grid%tmn(i,j)=0  
+                grid%sst(i,j)=0  !!no use on Mars!!
+                grid%tslb(i,:,j)=0  !!tslb is 3D field 
+               END DO
+            END DO
+!!**** MARS
+
+!      IF ( internal_time_loop .NE. 1 ) THEN
+!         DO j = jts, MIN(jde-1,jte)
+!            DO i = its, MIN(ide-1,ite)
+!               IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+!                  grid%tsk(i,j) = grid%em_t_2(i,1,j)
+!               END IF
+!            END DO
+!         END DO
+!      ELSE
+!         DO j = jts, MIN(jde-1,jte)
+!            DO i = its, MIN(ide-1,ite)
+!               IF ( grid%tsk(i,j) .LT. 170 .or. grid%tsk(i,j) .GT. 400. ) THEN
+!                  print *,'error in the grid%em_tsk'
+!                  print *,'i,j=',i,j
+!                  print *,'grid%landmask=',grid%landmask(i,j)
+!                  print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+!                  if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+!                     grid%tsk(i,j)=grid%tmn(i,j)
+!                  else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+!                     grid%tsk(i,j)=grid%sst(i,j)
+!                  else
+!                     CALL wrf_error_fatal ( 'grid%em_tsk unreasonable' )
+!                  end if
+!               END IF
+!            END DO
+!         END DO
+!      END IF
+!
+!      !  Is the grid%em_tmn reasonable?
+!
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            IF ( ( ( grid%tmn(i,j) .LT. 170. ) .OR. ( grid%tmn(i,j) .GT. 400. ) ) &
+!               .AND. ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+!               IF ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME ) THEN
+!                  print *,'error in the grid%em_tmn'
+!                  print *,'i,j=',i,j
+!                  print *,'grid%landmask=',grid%landmask(i,j)
+!                  print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+!               END IF
+!
+!               if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+!                  grid%tmn(i,j)=grid%tsk(i,j)
+!               else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+!                  grid%tmn(i,j)=grid%sst(i,j)
+!               else
+!                  CALL wrf_error_fatal ( 'grid%em_tmn unreasonable' )
+!               endif
+!            END IF
+!         END DO
+!      END DO
+!   
+!      interpolate_soil_tmw : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!
+!         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+!            CALL process_soil_real ( grid%tsk , grid%tmn , &
+!                                  grid%landmask , grid%sst , &
+!                                  st_input , sm_input , sw_input , st_levels_input , sm_levels_input , sw_levels_input , &
+!                                  grid%zs , grid%dzs , grid%tslb , grid%smois , grid%sh2o , &
+!                                  flag_sst , flag_soilt000, flag_soilm000, &
+!                                  ids , ide , jds , jde , kds , kde , &
+!                                  ims , ime , jms , jme , kms , kme , &
+!                                  its , ite , jts , jte , kts , kte , &
+!                                  model_config_rec%sf_surface_physics(grid%id) , &
+!                                  model_config_rec%num_soil_layers , &
+!                                  model_config_rec%real_data_init_type , &
+!                                  num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+!                                  num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc )
+!
+!      END SELECT interpolate_soil_tmw
+!
+!      !  Minimum soil values, residual, from RUC LSM scheme.  For input from Noah and using
+!      !  RUC LSM scheme, this must be subtracted from the input total soil moisture.  For
+!      !  input RUC data and using the Noah LSM scheme, this value must be added to the soil
+!      !  moisture input.
+!
+!      lqmi(1:num_soil_top_cat) = &
+!      (/0.045, 0.057, 0.065, 0.067, 0.034, 0.078, 0.10,     &
+!        0.089, 0.095, 0.10,  0.070, 0.068, 0.078, 0.0,      &
+!        0.004, 0.065 /)
+!!       0.004, 0.065, 0.020, 0.004, 0.008 /)  !  has extra levels for playa, lava, and white sand
+!
+!      !  At the initial time we care about values of soil moisture and temperature, other times are
+!      !  ignored by the model, so we ignore them, too.  
+!
+!      IF ( domain_ClockIsStartTime(grid) ) THEN
+!         account_for_zero_soil_moisture : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!   
+!            CASE ( LSMSCHEME )
+!               iicount = 0
+!               IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+!                             ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+!                           print *,'Noah -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+!                           iicount = iicount + 1
+!                           grid%smois(i,:,j) = 0.005
+!                        END IF
+!                     END DO
+!                  END DO
+!                  IF ( iicount .GT. 0 ) THEN
+!                     print *,'Noah -> Noah: total number of small soil moisture locations = ',iicount
+!                  END IF
+!               ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        grid%smois(i,:,j) = grid%smois(i,:,j) + lqmi(grid%isltyp(i,j))
+!                     END DO
+!                  END DO
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        IF ( (grid%landmask(i,j).gt.0.5) .and. ( grid%tslb(i,1,j) .gt. 200 ) .and. &
+!                             ( grid%tslb(i,1,j) .lt. 400 ) .and. ( grid%smois(i,1,j) .lt. 0.005 ) ) then
+!                           print *,'RUC -> Noah: bad soil moisture at i,j = ',i,j,grid%smois(i,:,j)
+!                           iicount = iicount + 1
+!                           grid%smois(i,:,j) = 0.005
+!                        END IF
+!                     END DO
+!                  END DO
+!                  IF ( iicount .GT. 0 ) THEN
+!                     print *,'RUC -> Noah: total number of small soil moisture locations = ',iicount
+!                  END IF
+!               END IF
+!   
+!            CASE ( RUCLSMSCHEME )
+!               iicount = 0
+!               IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+!                  DO j = jts, MIN(jde-1,jte)
+!                     DO i = its, MIN(ide-1,ite)
+!                        grid%smois(i,:,j) = MAX ( grid%smois(i,:,j) - lqmi(grid%isltyp(i,j)) , 0. )
+!                     END DO
+!                  END DO
+!               ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+!                  ! no op
+!               END IF
+!   
+!         END SELECT account_for_zero_soil_moisture
+!      END IF
+!
+!      !  Is the grid%tslb reasonable?
+!
+!      IF ( internal_time_loop .NE. 1 ) THEN
+!         DO j = jts, MIN(jde-1,jte)
+!            DO ns = 1 , model_config_rec%num_soil_layers
+!               DO i = its, MIN(ide-1,ite)
+!                  IF ( grid%tslb(i,ns,j) .LT. 170 .or. grid%tslb(i,ns,j) .GT. 400. ) THEN
+!                     grid%tslb(i,ns,j) = grid%em_t_2(i,1,j)
+!                     grid%smois(i,ns,j) = 0.3
+!                  END IF
+!               END DO
+!            END DO
+!         END DO
+!      ELSE
+!         DO j = jts, MIN(jde-1,jte)
+!            DO i = its, MIN(ide-1,ite)
+!               IF ( ( ( grid%tslb(i,1,j) .LT. 170. ) .OR. ( grid%tslb(i,1,j) .GT. 400. ) ) .AND. &
+!                       ( grid%landmask(i,j) .GT. 0.5 ) ) THEN
+!                     IF ( ( model_config_rec%sf_surface_physics(grid%id) .NE. LSMSCHEME    ) .AND. &
+!                          ( model_config_rec%sf_surface_physics(grid%id) .NE. RUCLSMSCHEME ) ) THEN
+!                        print *,'error in the grid%tslb'
+!                        print *,'i,j=',i,j
+!                        print *,'grid%landmask=',grid%landmask(i,j)
+!                        print *,'grid%tsk, grid%sst, grid%tmn=',grid%tsk(i,j),grid%sst(i,j),grid%tmn(i,j)
+!                        print *,'grid%tslb = ',grid%tslb(i,:,j)
+!                        print *,'old grid%smois = ',grid%smois(i,:,j)
+!                        grid%smois(i,1,j) = 0.3
+!                        grid%smois(i,2,j) = 0.3
+!                        grid%smois(i,3,j) = 0.3
+!                        grid%smois(i,4,j) = 0.3
+!                     END IF
+!   
+!                     IF ( (grid%tsk(i,j).GT.170. .AND. grid%tsk(i,j).LT.400.) .AND. &
+!                          (grid%tmn(i,j).GT.170. .AND. grid%tmn(i,j).LT.400.) ) THEN
+!                        fake_soil_temp : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+!                           CASE ( SLABSCHEME )
+!                              DO ns = 1 , model_config_rec%num_soil_layers
+!                                 grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+!                                                       grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+!                              END DO
+!                           CASE ( LSMSCHEME , RUCLSMSCHEME )
+!                              CALL wrf_error_fatal ( 'Assigning constant soil moisture, bad idea')
+!                              DO ns = 1 , model_config_rec%num_soil_layers
+!                                 grid%tslb(i,ns,j) = ( grid%tsk(i,j)*(3.0 - grid%zs(ns)) + &
+!                                                       grid%tmn(i,j)*(0.0 - grid%zs(ns)) ) /(3.0 - 0.0)
+!                              END DO
+!                        END SELECT fake_soil_temp
+!                     else if(grid%tsk(i,j).gt.170. .and. grid%tsk(i,j).lt.400.)then
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 1' )
+!                        DO ns = 1 , model_config_rec%num_soil_layers
+!                           grid%tslb(i,ns,j)=grid%tsk(i,j)
+!                        END DO
+!                     else if(grid%sst(i,j).gt.170. .and. grid%sst(i,j).lt.400.)then
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 2' )
+!                        DO ns = 1 , model_config_rec%num_soil_layers
+!                           grid%tslb(i,ns,j)=grid%sst(i,j)
+!                        END DO
+!                     else if(grid%tmn(i,j).gt.170. .and. grid%tmn(i,j).lt.400.)then
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 3' )
+!                        DO ns = 1 , model_config_rec%num_soil_layers
+!                           grid%tslb(i,ns,j)=grid%tmn(i,j)
+!                        END DO
+!                     else
+!                        CALL wrf_error_fatal ( 'grid%tslb unreasonable 4' )
+!                     endif
+!               END IF
+!            END DO
+!         END DO
+!      END IF
+!
+!      !  Adjustments for the seaice field AFTER the grid%tslb computations.  This is
+!      !  is for the Noah LSM scheme.
+!
+!      num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+!      num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+!      num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+!      CALL nl_get_seaice_threshold ( grid%id , grid%seaice_threshold ) 
+!      CALL nl_get_isice ( grid%id , grid%isice )
+!      CALL nl_get_iswater ( grid%id , grid%iswater )
+!      CALL adjust_for_seaice_post ( grid%xice , grid%landmask , grid%tsk , grid%tsk_save , &
+!                                    grid%ivgtyp , grid%vegcat , grid%lu_index , &
+!                                    grid%xland , grid%landusef , grid%isltyp , grid%soilcat ,  &
+!                                    grid%soilctop , &
+!                                    grid%soilcbot , grid%tmn , grid%vegfra , &
+!                                    grid%tslb , grid%smois , grid%sh2o , &
+!                                    grid%seaice_threshold , &
+!                                    num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+!                                    model_config_rec%num_soil_layers , &
+!                                    grid%iswater , grid%isice , &
+!                                    model_config_rec%sf_surface_physics(grid%id) , & 
+!                                    ids , ide , jds , jde , kds , kde , & 
+!                                    ims , ime , jms , jme , kms , kme , & 
+!                                    its , ite , jts , jte , kts , kte ) 
+!
+!      !  Let us make sure (again) that the grid%landmask and the veg/soil categories match.
+!
+!oops1=0
+!oops2=0
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!            IF ( ( ( grid%landmask(i,j) .LT. 0.5 ) .AND. &
+!                   ( grid%ivgtyp(i,j) .NE. config_flags%iswater .OR. grid%isltyp(i,j) .NE. 14 ) ) .OR. &
+!                 ( ( grid%landmask(i,j) .GT. 0.5 ) .AND. &
+!                   ( grid%ivgtyp(i,j) .EQ. config_flags%iswater .OR. grid%isltyp(i,j) .EQ. 14 ) ) ) THEN
+!               IF ( grid%tslb(i,1,j) .GT. 1. ) THEN
+!oops1=oops1+1
+!                  grid%ivgtyp(i,j) = 5
+!                  grid%isltyp(i,j) = 8
+!                  grid%landmask(i,j) = 1
+!                  grid%xland(i,j) = 1
+!               ELSE IF ( grid%sst(i,j) .GT. 1. ) THEN
+!oops2=oops2+1
+!                  grid%ivgtyp(i,j) = config_flags%iswater
+!                  grid%isltyp(i,j) = 14
+!                  grid%landmask(i,j) = 0
+!                  grid%xland(i,j) = 2
+!               ELSE
+!                  print *,'the grid%landmask and soil/veg cats do not match'
+!                  print *,'i,j=',i,j
+!                  print *,'grid%landmask=',grid%landmask(i,j)
+!                  print *,'grid%ivgtyp=',grid%ivgtyp(i,j)
+!                  print *,'grid%isltyp=',grid%isltyp(i,j)
+!                  print *,'iswater=', config_flags%iswater
+!                  print *,'grid%tslb=',grid%tslb(i,:,j)
+!                  print *,'grid%sst=',grid%sst(i,j)
+!                  CALL wrf_error_fatal ( 'mismatch_landmask_ivgtyp' )
+!               END IF
+!            END IF
+!         END DO
+!      END DO
+!if (oops1.gt.0) then
+!print *,'points artificially set to land : ',oops1
+!endif
+!if(oops2.gt.0) then
+!print *,'points artificially set to water: ',oops2
+!endif
+!! fill grid%sst array with grid%em_tsk if missing in real input (needed for time-varying grid%sst in wrf)
+!      DO j = jts, MIN(jde-1,jte)
+!         DO i = its, MIN(ide-1,ite)
+!           IF ( flag_sst .NE. 1 ) THEN
+!             grid%sst(i,j) = grid%tsk(i,j)
+!           ENDIF
+!         END DO
+!      END DO
+
+
+      !  From the full level data, we can get the half levels, reciprocals, and layer
+      !  thicknesses.  These are all defined at half level locations, so one less level.
+      !  We allow the vertical coordinate to *accidently* come in upside down.  We want
+      !  the first full level to be the ground surface.
+
+      !  Check whether grid%em_znw (full level) data are truly full levels. If not, we need to adjust them
+      !  to be full levels.
+      !  in this test, we check if grid%em_znw(1) is neither 0 nor 1 (within a tolerance of 10**-5)
+
+      were_bad = .false.
+      IF ( ( (grid%em_znw(1).LT.(1-1.E-5) ) .OR. ( grid%em_znw(1).GT.(1+1.E-5) ) ).AND. &
+           ( (grid%em_znw(1).LT.(0-1.E-5) ) .OR. ( grid%em_znw(1).GT.(0+1.E-5) ) ) ) THEN
+         were_bad = .true.
+         print *,'Your grid%em_znw input values are probably half-levels. '
+         print *,grid%em_znw
+         print *,'WRF expects grid%em_znw values to be full levels. '
+         print *,'Adjusting now to full levels...'
+         !  We want to ignore the first value if it's negative
+         IF (grid%em_znw(1).LT.0) THEN
+            grid%em_znw(1)=0
+         END IF
+         DO k=2,kde
+            grid%em_znw(k)=2*grid%em_znw(k)-grid%em_znw(k-1)
+         END DO
+      END IF
+
+      !  Let's check our changes
+
+      IF ( ( ( grid%em_znw(1) .LT. (1-1.E-5) ) .OR. ( grid%em_znw(1) .GT. (1+1.E-5) ) ).AND. &
+           ( ( grid%em_znw(1) .LT. (0-1.E-5) ) .OR. ( grid%em_znw(1) .GT. (0+1.E-5) ) ) ) THEN
+         print *,'The input grid%em_znw height values were half-levels or erroneous. '
+         print *,'Attempts to treat the values as half-levels and change them '
+         print *,'to valid full levels failed.'
+         CALL wrf_error_fatal("bad grid%em_znw values from input files")
+      ELSE IF ( were_bad ) THEN
+         print *,'...adjusted. grid%em_znw array now contains full eta level values. '
+      ENDIF
+
+      IF ( grid%em_znw(1) .LT. grid%em_znw(kde) ) THEN
+         DO k=1, kde/2
+            hold_znw = grid%em_znw(k)
+            grid%em_znw(k)=grid%em_znw(kde+1-k)
+            grid%em_znw(kde+1-k)=hold_znw
+         END DO
+      END IF
+
+      DO k=1, kde-1
+         grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+         grid%em_rdnw(k) = 1./grid%em_dnw(k)
+         grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+      END DO
+
+      !  Now the same sort of computations with the half eta levels, even ANOTHER
+      !  level less than the one above.
+
+      DO k=2, kde-1
+         grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+         grid%em_rdn(k) = 1./grid%em_dn(k)
+         grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+         grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+      END DO
+
+      !  Scads of vertical coefficients.
+
+      cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+      cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+
+      grid%cf1  = grid%em_fnp(2) + cof1
+      grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+      grid%cf3  = cof2       
+
+      grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+      grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+
+      !  Inverse grid distances.
+
+      grid%rdx = 1./config_flags%dx
+      grid%rdy = 1./config_flags%dy
+
+      !  Some of the many weird geopotential initializations that we'll see today: grid%em_ph0 is total, 
+      !  and grid%em_ph_2 is a perturbation from the base state geopotential.  We set the base geopotential 
+      !  at the lowest level to terrain elevation * gravity.
+
+      DO j=jts,jte
+         DO i=its,ite
+            grid%em_ph0(i,1,j) = grid%ht(i,j) * g
+            grid%em_ph_2(i,1,j) = 0.
+         END DO
+      END DO
+
+      !  Base state potential temperature and inverse density (alpha = 1/rho) from
+      !  the half eta levels and the base-profile surface pressure.  Compute 1/rho 
+      !  from equation of state.  The potential temperature is a perturbation from t0.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+
+
+!****MARS         
+!TODO: etudier si une meilleure formule n'existe pas pour Mars
+!TODO: mais il s'agit juste d'un etat de base ...
+!****MARS
+            !  Base state pressure is a function of eta level and terrain, only, plus
+            !  the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
+            !  temperature, K), and A (temperature difference, from 1000 mb to 300 mb, K).
+
+!!****MARS
+!!ici il s'agit de definir un etat de base, de reference
+!!- on ne peut prendre le profil de temperature du modele
+!!  qui conduit a des instabilites
+!!      grid%em_t_init(i,k,j)=grid%em_t_2(i,k,j) - t0 est a eviter donc.
+!!- pour la pression de surface, aucune information
+!!  sur un profil de temperature variable et non equilibre
+!!  ne doit transparaitre
+!!      p_surf = grid%psfc(i,j) pourquoi pas ... mais t y est utilisee ...
+!!
+!!>> l'etat de base ne doit dependre "geographiquement" que de la topographie
+!!
+!!****MARS
+            p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+
+            DO k = 1, kte-1
+               grid%em_php(i,k,j) = grid%em_znw(k)*(p_surf - grid%p_top) + grid%p_top ! temporary, full lev base pressure
+               grid%em_pb(i,k,j) = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+!              temp = MAX ( 200., t00 + A*LOG(grid%em_pb(i,k,j)/p00) )
+               temp =             t00 + A*LOG(grid%em_pb(i,k,j)/p00)
+               grid%em_t_init(i,k,j) = temp*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
+               grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+            END DO
+       
+            !  Base state mu is defined as base state surface pressure minus grid%p_top
+
+            grid%em_mub(i,j) = p_surf - grid%p_top
+       
+            !  Dry surface pressure is defined as the following (this mu is from the input file
+            !  computed from the dry pressure).  Here the dry pressure is just reconstituted.
+
+            pd_surf = grid%em_mu0(i,j) + grid%p_top
+
+            !  Integrate base geopotential, starting at terrain elevation.  This assures that 
+            !  the base state is in exact hydrostatic balance with respect to the model equations.
+            !  This field is on full levels.
+
+            grid%em_phb(i,1,j) = grid%ht(i,j) * g
+            DO k  = 2,kte
+               grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+            END DO
+         END DO
+      END DO
+
+      !  Fill in the outer rows and columns to allow us to be sloppy.
+
+      IF ( ite .EQ. ide ) THEN
+      i = ide
+      DO j = jts, MIN(jde-1,jte)
+         grid%em_mub(i,j) = grid%em_mub(i-1,j)
+         grid%em_mu_2(i,j) = grid%em_mu_2(i-1,j)
+         DO k = 1, kte-1
+            grid%em_pb(i,k,j) = grid%em_pb(i-1,k,j)
+            grid%em_t_init(i,k,j) = grid%em_t_init(i-1,k,j)
+            grid%em_alb(i,k,j) = grid%em_alb(i-1,k,j)
+         END DO
+         DO k = 1, kte
+            grid%em_phb(i,k,j) = grid%em_phb(i-1,k,j)
+         END DO
+      END DO
+      END IF
+
+      IF ( jte .EQ. jde ) THEN
+      j = jde
+      DO i = its, ite
+         grid%em_mub(i,j) = grid%em_mub(i,j-1)
+         grid%em_mu_2(i,j) = grid%em_mu_2(i,j-1)
+         DO k = 1, kte-1
+            grid%em_pb(i,k,j) = grid%em_pb(i,k,j-1)
+            grid%em_t_init(i,k,j) = grid%em_t_init(i,k,j-1)
+            grid%em_alb(i,k,j) = grid%em_alb(i,k,j-1)
+         END DO
+         DO k = 1, kte
+            grid%em_phb(i,k,j) = grid%em_phb(i,k,j-1)
+         END DO
+      END DO
+      END IF
+       
+      !  Compute the perturbation dry pressure (grid%em_mub + grid%em_mu_2 + ptop = dry grid%em_psfc).
+
+      DO j = jts, min(jde-1,jte)
+         DO i = its, min(ide-1,ite)
+            grid%em_mu_2(i,j) = grid%em_mu0(i,j) - grid%em_mub(i,j)
+         END DO
+      END DO
+
+      !  Fill in the outer rows and columns to allow us to be sloppy.
+
+      IF ( ite .EQ. ide ) THEN
+      i = ide
+      DO j = jts, MIN(jde-1,jte)
+         grid%em_mu_2(i,j) = grid%em_mu_2(i-1,j)
+      END DO
+      END IF
+
+      IF ( jte .EQ. jde ) THEN
+      j = jde
+      DO i = its, ite
+         grid%em_mu_2(i,j) = grid%em_mu_2(i,j-1)
+      END DO
+      END IF
+
+      lev500 = 0 
+      DO j = jts, min(jde-1,jte)
+         DO i = its, min(ide-1,ite)
+
+            !  Assign the potential temperature (perturbation from t0) and qv on all the mass
+            !  point locations.
+
+            DO k =  1 , kde-1
+               grid%em_t_2(i,k,j)          = grid%em_t_2(i,k,j) - t0
+            END DO
+
+!!---------------------------------------------------------------
+!!****MARS: no 500mb adjustment needed
+!!****MARS: must keep however the hydrostatic equation integration performed in this loop !
+!!****MARS: the DO WHILE loop is deactivated, since we will always be in the case
+!!****MARS: ... of "ELSE dpmu = 0."
+!!---------------------------------------------------------------
+!            dpmu = 10001.
+!            loop_count = 0
+!
+!            DO WHILE ( ( ABS(dpmu) .GT. 10. ) .AND. &
+!                       ( loop_count .LT. 5 ) )  
+!
+!               loop_count = loop_count + 1
+      
+               !  Integrate the hydrostatic equation (from the RHS of the bigstep vertical momentum 
+               !  equation) down from the top to get the pressure perturbation.  First get the pressure
+               !  perturbation, moisture, and inverse density (total and perturbation) at the top-most level.
+         
+               k = kte-1
+         
+               qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+               qvf2 = 1./(1.+qvf1)
+               qvf1 = qvf1*qvf2
+         
+               grid%em_p(i,k,j) = - 0.5*(grid%em_mu_2(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+               qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+               grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf&
+                                 *(((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+               grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+         
+               !  Now, integrate down the column to compute the pressure perturbation, and diagnose the two
+               !  inverse density fields (total and perturbation).
+         
+                DO k=kte-2,1,-1
+                  qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+                  qvf2 = 1./(1.+qvf1)
+                  qvf1 = qvf1*qvf2
+                  grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_2(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+                  qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+                  grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf* &
+                              (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+                  grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+               END DO
+         
+               !  This is the hydrostatic equation used in the model after the small timesteps.  In 
+               !  the model, grid%em_al (inverse density) is computed from the geopotential.
+         
+               DO k  = 2,kte
+                  grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) - &
+                                grid%em_dnw(k-1) * ( (grid%em_mub(i,j)+grid%em_mu_2(i,j))*grid%em_al(i,k-1,j) &
+                              + grid%em_mu_2(i,j)*grid%em_alb(i,k-1,j) )
+                  grid%em_ph0(i,k,j) = grid%em_ph_2(i,k,j) + grid%em_phb(i,k,j)
+               END DO
+
+!               !  Adjust the column pressure so that the computed 500 mb height is close to the
+!               !  input value (of course, not when we are doing hybrid input).
+!   
+!               IF ( ( flag_metgrid .EQ. 1 ) .AND. ( i .EQ. its ) .AND. ( j .EQ. jts ) ) THEN
+!                  DO k = 1 , num_metgrid_levels
+!                     IF ( ABS ( grid%em_p_gc(i,k,j) - 50000. ) .LT. 1. ) THEN
+!                        lev500 = k
+!                        EXIT
+!                     END IF
+!                  END DO
+!               END IF
+!           
+!               !  We only do the adjustment of height if we have the input data on pressure
+!               !  surfaces, and folks have asked to do this option.
+!   
+!               IF ( ( flag_metgrid .EQ. 1 ) .AND. &
+!                    ( config_flags%adjust_heights ) .AND. &
+!                    ( lev500 .NE. 0 ) ) THEN
+!   
+!                  DO k = 2 , kte-1
+!      
+!                     !  Get the pressures on the full eta levels (grid%em_php is defined above as 
+!                     !  the full-lev base pressure, an easy array to use for 3d space).
+!      
+!                     pl = grid%em_php(i,k  ,j) + &
+!                          ( grid%em_p(i,k-1  ,j) * ( grid%em_znw(k    ) - grid%em_znu(k  ) ) + &             
+!                            grid%em_p(i,k    ,j) * ( grid%em_znu(k-1  ) - grid%em_znw(k  ) ) ) / &
+!                          ( grid%em_znu(k-1  ) - grid%em_znu(k  ) )
+!                     pu = grid%em_php(i,k+1,j) + &
+!                          ( grid%em_p(i,k-1+1,j) * ( grid%em_znw(k  +1) - grid%em_znu(k+1) ) + &             
+!                            grid%em_p(i,k  +1,j) * ( grid%em_znu(k-1+1) - grid%em_znw(k+1) ) ) / &
+!                          ( grid%em_znu(k-1+1) - grid%em_znu(k+1) )
+!                   
+!                     !  If these pressure levels trap 500 mb, use them to interpolate
+!                     !  to the 500 mb level of the computed height.
+!!**** PB on MARS .... ?       
+!                     IF ( ( pl .GE. 50000. ) .AND. ( pu .LT. 50000. ) ) THEN
+!                        zl = ( grid%em_ph_2(i,k  ,j) + grid%em_phb(i,k  ,j) ) / g
+!                        zu = ( grid%em_ph_2(i,k+1,j) + grid%em_phb(i,k+1,j) ) / g
+!      
+!                        z500 = ( zl * ( LOG(50000.) - LOG(pu    ) ) + &
+!                                 zu * ( LOG(pl    ) - LOG(50000.) ) ) / &
+!                               ( LOG(pl) - LOG(pu) ) 
+!!                       z500 = ( zl * (    (50000.) -    (pu    ) ) + &
+!!                                zu * (    (pl    ) -    (50000.) ) ) / &
+!!                              (    (pl) -    (pu) ) 
+!      
+!                        !  Compute the difference of the 500 mb heights (computed minus input), and
+!                        !  then the change in grid%em_mu_2.  The grid%em_php is still full-levels, base pressure.
+!      
+!                        dz500 = z500 - grid%em_ght_gc(i,lev500,j)
+!                        tvsfc = ((grid%em_t_2(i,1,j)+t0)*((grid%em_p(i,1,j)+grid%em_php(i,1,j))/p1000mb)**(r_d/cp)) * &
+!                                (1.+0.6*moist(i,1,j,P_QV))
+!                        dpmu = ( grid%em_php(i,1,j) + grid%em_p(i,1,j) ) * EXP ( g * dz500 / ( r_d * tvsfc ) )
+!                        dpmu = dpmu - ( grid%em_php(i,1,j) + grid%em_p(i,1,j) )
+!                        grid%em_mu_2(i,j) = grid%em_mu_2(i,j) - dpmu
+!                        EXIT
+!                     END IF
+!      
+!                  END DO
+!               ELSE
+!                  dpmu = 0.
+!               END IF
+!
+!            END DO
+       
+         END DO
+      END DO
+
+!!****MARS: we use WPS
+!
+!      !  If this is data from the SI, then we probably do not have the original
+!      !  surface data laying around.  Note that these are all the lowest levels
+!      !  of the respective 3d arrays.  For surface pressure, we assume that the
+!      !  vertical gradient of grid%em_p prime is zilch.  This is not all that important.
+!      !  These are filled in so that the various plotting routines have something
+!      !  to play with at the initial time for the model.
+!
+!      IF ( flag_metgrid .NE. 1 ) THEN
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide,ite)
+!               grid%u10(i,j)=grid%em_u_2(i,1,j)
+!            END DO
+!         END DO
+!   
+!         DO j = jts, min(jde,jte)
+!            DO i = its, min(ide-1,ite)
+!               grid%v10(i,j)=grid%em_v_2(i,1,j)
+!            END DO
+!         END DO
+!
+!         DO j = jts, min(jde-1,jte)
+!            DO i = its, min(ide-1,ite)
+!               p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+!               grid%psfc(i,j)=p_surf + grid%em_p(i,1,j)
+!               grid%q2(i,j)=moist(i,1,j,P_QV)
+!               grid%th2(i,j)=grid%em_t_2(i,1,j)+300.
+!               grid%t2(i,j)=grid%th2(i,j)*(((grid%em_p(i,1,j)+grid%em_pb(i,1,j))/p00)**(r_d/cp))
+!            END DO
+!         END DO
+!
+!      !  If this data is from WPS, then we have previously assigned the surface
+!      !  data for u, v, and t.  If we have an input qv, welp, we assigned that one,
+!      !  too.  Now we pick up the left overs, and if RH came in - we assign the 
+!      !  mixing ratio.
+!
+!      ELSE IF ( flag_metgrid .EQ. 1 ) THEN
+!
+!!****MARS: we use WPS
+
+         DO j = jts, min(jde-1,jte)
+            DO i = its, min(ide-1,ite)
+                p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) 
+                ! recompute the value of surface pressure as calculated by sfcprs2
+                grid%psfc(i,j)=p_surf + grid%em_p(i,1,j)
+                grid%th2(i,j)=grid%t2(i,j)*(p00/(grid%em_p(i,1,j)+grid%em_pb(i,1,j)))**(r_d/cp)
+            END DO
+         END DO
+         IF ( flag_qv .NE. 1 ) THEN
+            DO j = jts, min(jde-1,jte)
+               DO i = its, min(ide-1,ite)
+                  grid%q2(i,j)=moist(i,1,j,P_QV)
+               END DO
+            END DO
+         END IF
+
+!      END IF
+
+      ips = its ; ipe = ite ; jps = jts ; jpe = jte ; kps = kts ; kpe = kte
+#ifdef DM_PARALLEL
+#   include "HALO_EM_INIT_1.inc"
+#   include "HALO_EM_INIT_2.inc"
+#   include "HALO_EM_INIT_3.inc"
+#   include "HALO_EM_INIT_4.inc"
+#   include "HALO_EM_INIT_5.inc"
+#endif
+
+      RETURN
+
+   END SUBROUTINE init_domain_rk
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE const_module_initialize ( p00 , t00 , a ) 
+      USE module_configure
+      IMPLICIT NONE
+      !  For the real-data-cases only.
+      REAL , INTENT(OUT) :: p00 , t00 , a
+      CALL nl_get_base_pres  ( 1 , p00 )
+      CALL nl_get_base_temp  ( 1 , t00 )
+      CALL nl_get_base_lapse ( 1 , a   )
+   END SUBROUTINE const_module_initialize
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE rebalance_driver ( grid ) 
+
+      IMPLICIT NONE
+
+      TYPE (domain)          :: grid 
+
+      CALL rebalance( grid &
+!
+#include "em_actual_new_args.inc"
+!
+      )
+
+   END SUBROUTINE rebalance_driver
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE rebalance ( grid  &
+!
+#include "em_dummy_new_args.inc"
+!
+                        )
+      IMPLICIT NONE
+
+      TYPE (domain)          :: grid
+
+#include "em_dummy_new_decl.inc"
+
+      TYPE (grid_config_rec_type)              :: config_flags
+
+      REAL :: p_surf ,  pd_surf, p_surf_int , pb_int , ht_hold
+      REAL :: qvf , qvf1 , qvf2
+      REAL :: p00 , t00 , a
+      REAL , DIMENSION(:,:,:) , ALLOCATABLE :: t_init_int
+
+      !  Local domain indices and counters.
+
+      INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+
+      INTEGER                             ::                       &
+                                     ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte, &
+                                     ips, ipe, jps, jpe, kps, kpe, &
+                                     i, j, k
+
+#ifdef DM_PARALLEL
+#    include "em_data_calls.inc"
+#endif
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+            kds = grid%sd31 ; kde = grid%ed31 ;
+            ids = grid%sd32 ; ide = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            kms = grid%sm31 ; kme = grid%em31 ;
+            ims = grid%sm32 ; ime = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+            its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XYZ )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            jds = grid%sd32 ; jde = grid%ed32 ;
+            kds = grid%sd33 ; kde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            jms = grid%sm32 ; jme = grid%em32 ;
+            kms = grid%sm33 ; kme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+            kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+
+         CASE ( DATA_ORDER_XZY )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            kds = grid%sd32 ; kde = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            kms = grid%sm32 ; kme = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+            kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+      END SELECT
+
+      ALLOCATE ( t_init_int(ims:ime,kms:kme,jms:jme) )
+
+      !  Some of the many weird geopotential initializations that we'll see today: grid%em_ph0 is total, 
+      !  and grid%em_ph_2 is a perturbation from the base state geopotential.  We set the base geopotential 
+      !  at the lowest level to terrain elevation * gravity.
+
+      DO j=jts,jte
+         DO i=its,ite
+            grid%em_ph0(i,1,j) = grid%ht_fine(i,j) * g
+            grid%em_ph_2(i,1,j) = 0.
+         END DO
+      END DO
+      
+      !  To define the base state, we call a USER MODIFIED routine to set the three
+      !  necessary constants:  p00 (sea level pressure, Pa), t00 (sea level temperature, K), 
+      !  and A (temperature difference, from 1000 mb to 300 mb, K).
+
+      CALL const_module_initialize ( p00 , t00 , a ) 
+
+      !  Base state potential temperature and inverse density (alpha = 1/rho) from
+      !  the half eta levels and the base-profile surface pressure.  Compute 1/rho 
+      !  from equation of state.  The potential temperature is a perturbation from t0.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+
+            !  Base state pressure is a function of eta level and terrain, only, plus
+            !  the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
+            !  temperature, K), and A (temperature difference, from 1000 mb to 300 mb, K).
+            !  The fine grid terrain is ht_fine, the interpolated is grid%em_ht.
+
+            p_surf     = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht_fine(i,j)/a/r_d ) **0.5 ) 
+            p_surf_int = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)     /a/r_d ) **0.5 ) 
+
+            DO k = 1, kte-1
+               grid%em_pb(i,k,j) = grid%em_znu(k)*(p_surf     - grid%p_top) + grid%p_top
+               pb_int    = grid%em_znu(k)*(p_surf_int - grid%p_top) + grid%p_top
+               grid%em_t_init(i,k,j)    = (t00 + A*LOG(grid%em_pb(i,k,j)/p00))*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
+               t_init_int(i,k,j)= (t00 + A*LOG(pb_int   /p00))*(p00/pb_int   )**(r_d/cp) - t0
+               grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+            END DO
+       
+            !  Base state mu is defined as base state surface pressure minus grid%p_top
+
+            grid%em_mub(i,j) = p_surf - grid%p_top
+       
+            !  Dry surface pressure is defined as the following (this mu is from the input file
+            !  computed from the dry pressure).  Here the dry pressure is just reconstituted.
+
+            pd_surf = ( grid%em_mub(i,j) + grid%em_mu_2(i,j) ) + grid%p_top
+       
+            !  Integrate base geopotential, starting at terrain elevation.  This assures that 
+            !  the base state is in exact hydrostatic balance with respect to the model equations.
+            !  This field is on full levels.
+
+            grid%em_phb(i,1,j) = grid%ht_fine(i,j) * g
+            DO k  = 2,kte
+               grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+            END DO
+         END DO
+      END DO
+
+      !  Replace interpolated terrain with fine grid values.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+            grid%ht(i,j) = grid%ht_fine(i,j)
+         END DO
+      END DO
+
+      !  Perturbation fields.
+
+      DO j = jts, min(jde-1,jte)
+         DO i = its, min(ide-1,ite)
+
+            !  The potential temperature is THETAnest = THETAinterp + ( TBARnest - TBARinterp)
+
+            DO k =  1 , kde-1
+               grid%em_t_2(i,k,j) = grid%em_t_2(i,k,j) + ( grid%em_t_init(i,k,j) - t_init_int(i,k,j) ) 
+            END DO
+      
+            !  Integrate the hydrostatic equation (from the RHS of the bigstep vertical momentum 
+            !  equation) down from the top to get the pressure perturbation.  First get the pressure
+            !  perturbation, moisture, and inverse density (total and perturbation) at the top-most level.
+      
+            k = kte-1
+      
+            qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+            qvf2 = 1./(1.+qvf1)
+            qvf1 = qvf1*qvf2
+      
+            grid%em_p(i,k,j) = - 0.5*(grid%em_mu_2(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+            qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+            grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf* &
+                                 (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+            grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+      
+            !  Now, integrate down the column to compute the pressure perturbation, and diagnose the two
+            !  inverse density fields (total and perturbation).
+      
+            DO k=kte-2,1,-1
+               qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+               qvf2 = 1./(1.+qvf1)
+               qvf1 = qvf1*qvf2
+               grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_2(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+               qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+               grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_2(i,k,j)+t0)*qvf* &
+                           (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+               grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+            END DO
+      
+            !  This is the hydrostatic equation used in the model after the small timesteps.  In 
+            !  the model, grid%em_al (inverse density) is computed from the geopotential.
+      
+            DO k  = 2,kte
+               grid%em_ph_2(i,k,j) = grid%em_ph_2(i,k-1,j) - &
+                             grid%em_dnw(k-1) * ( (grid%em_mub(i,j)+grid%em_mu_2(i,j))*grid%em_al(i,k-1,j) &
+                           + grid%em_mu_2(i,j)*grid%em_alb(i,k-1,j) )
+               grid%em_ph0(i,k,j) = grid%em_ph_2(i,k,j) + grid%em_phb(i,k,j)
+            END DO
+       
+         END DO
+      END DO
+
+      DEALLOCATE ( t_init_int ) 
+
+      ips = its ; ipe = ite ; jps = jts ; jpe = jte ; kps = kts ; kpe = kte
+#ifdef DM_PARALLEL
+#   include "HALO_EM_INIT_1.inc"
+#   include "HALO_EM_INIT_2.inc"
+#   include "HALO_EM_INIT_3.inc"
+#   include "HALO_EM_INIT_4.inc"
+#   include "HALO_EM_INIT_5.inc"
+#endif
+   END SUBROUTINE rebalance
+
+!---------------------------------------------------------------------
+
+   RECURSIVE SUBROUTINE find_my_parent ( grid_ptr_in , grid_ptr_out , id_i_am , id_wanted , found_the_id )
+
+      USE module_domain
+
+      TYPE(domain) , POINTER :: grid_ptr_in , grid_ptr_out
+      TYPE(domain) , POINTER :: grid_ptr_sibling
+      INTEGER :: id_wanted , id_i_am
+      LOGICAL :: found_the_id
+
+      found_the_id = .FALSE.
+      grid_ptr_sibling => grid_ptr_in
+      DO WHILE ( ASSOCIATED ( grid_ptr_sibling ) )
+
+         IF ( grid_ptr_sibling%grid_id .EQ. id_wanted ) THEN
+            found_the_id = .TRUE.
+            grid_ptr_out => grid_ptr_sibling
+            RETURN
+         ELSE IF ( grid_ptr_sibling%num_nests .GT. 0 ) THEN
+            grid_ptr_sibling => grid_ptr_sibling%nests(1)%ptr
+            CALL find_my_parent ( grid_ptr_sibling , grid_ptr_out , id_i_am , id_wanted , found_the_id )
+         ELSE
+            grid_ptr_sibling => grid_ptr_sibling%sibling
+         END IF
+
+      END DO
+
+   END SUBROUTINE find_my_parent
+
+#endif
+
+!---------------------------------------------------------------------
+
+#ifdef VERT_UNIT
+
+!This is a main program for a small unit test for the vertical interpolation.
+
+program vint
+
+   implicit none 
+
+   integer , parameter :: ij = 3
+   integer , parameter :: keta = 30
+   integer , parameter :: kgen =20 
+
+   integer :: ids , ide , jds , jde , kds , kde , &
+              ims , ime , jms , jme , kms , kme , &
+              its , ite , jts , jte , kts , kte
+
+   integer :: generic
+
+   real , dimension(1:ij,kgen,1:ij) :: fo , po
+   real , dimension(1:ij,1:keta,1:ij) :: fn_calc , fn_interp , pn
+
+   integer, parameter :: interp_type          = 1 ! 2
+!  integer, parameter :: lagrange_order       = 2 ! 1
+   integer            :: lagrange_order
+   logical, parameter :: lowest_lev_from_sfc  = .FALSE. ! .TRUE.
+   real   , parameter :: zap_close_levels     = 500. ! 100.
+   integer, parameter :: force_sfc_in_vinterp = 0 ! 6
+
+   integer :: k 
+
+   ids = 1 ; ide = ij ; jds = 1 ; jde = ij ; kds = 1 ; kde = keta
+   ims = 1 ; ime = ij ; jms = 1 ; jme = ij ; kms = 1 ; kme = keta
+   its = 1 ; ite = ij ; jts = 1 ; jte = ij ; kts = 1 ; kte = keta
+
+   generic = kgen
+
+   print *,' '
+   print *,'------------------------------------'
+   print *,'UNIT TEST FOR VERTICAL INTERPOLATION'
+   print *,'------------------------------------'
+   print *,' '
+   do lagrange_order = 1 , 2
+      print *,' '
+      print *,'------------------------------------'
+      print *,'Lagrange Order = ',lagrange_order
+      print *,'------------------------------------'
+      print *,' '
+      call fillitup ( fo , po , fn_calc , pn , &
+                    ids , ide , jds , jde , kds , kde , &
+                    ims , ime , jms , jme , kms , kme , &
+                    its , ite , jts , jte , kts , kte , &
+                    generic , lagrange_order )
+   
+      print *,' ' 
+      print *,'Level   Pressure     Field'
+      print *,'          (Pa)      (generic)'
+      print *,'------------------------------------'
+      print *,' ' 
+      do k = 1 , generic
+      write (*,fmt='(i2,2x,f12.3,1x,g15.8)' ) &
+         k,po(2,k,2),fo(2,k,2)
+      end do
+      print *,' '
+   
+      call vert_interp ( fo , po , fn_interp , pn , &
+                         generic , 'T' , &
+                         interp_type , lagrange_order , lowest_lev_from_sfc , &
+                         zap_close_levels , force_sfc_in_vinterp , &
+                         ids , ide , jds , jde , kds , kde , &
+                         ims , ime , jms , jme , kms , kme , &
+                         its , ite , jts , jte , kts , kte )
+   
+      print *,'Multi-Order Interpolator'
+      print *,'------------------------------------'
+      print *,' '
+      print *,'Level  Pressure      Field           Field         Field'
+      print *,'         (Pa)        Calc            Interp        Diff'
+      print *,'------------------------------------'
+      print *,' '
+      do k = kts , kte-1
+      write (*,fmt='(i2,2x,f12.3,1x,3(g15.7))' ) &
+         k,pn(2,k,2),fn_calc(2,k,2),fn_interp(2,k,2),fn_calc(2,k,2)-fn_interp(2,k,2)
+      end do
+   
+      call vert_interp_old ( fo , po , fn_interp , pn , &
+                         generic , 'T' , &
+                         interp_type , lagrange_order , lowest_lev_from_sfc , &
+                         zap_close_levels , force_sfc_in_vinterp , &
+                         ids , ide , jds , jde , kds , kde , &
+                         ims , ime , jms , jme , kms , kme , &
+                         its , ite , jts , jte , kts , kte )
+   
+      print *,'Linear Interpolator'
+      print *,'------------------------------------'
+      print *,' '
+      print *,'Level  Pressure      Field           Field         Field'
+      print *,'         (Pa)        Calc            Interp        Diff'
+      print *,'------------------------------------'
+      print *,' '
+      do k = kts , kte-1
+      write (*,fmt='(i2,2x,f12.3,1x,3(g15.7))' ) &
+         k,pn(2,k,2),fn_calc(2,k,2),fn_interp(2,k,2),fn_calc(2,k,2)-fn_interp(2,k,2)
+      end do
+   end do
+
+end program vint
+
+subroutine wrf_error_fatal (string)
+   character (len=*) :: string
+   print *,string
+   stop
+end subroutine wrf_error_fatal
+
+subroutine fillitup ( fo , po , fn , pn , &
+                    ids , ide , jds , jde , kds , kde , &
+                    ims , ime , jms , jme , kms , kme , &
+                    its , ite , jts , jte , kts , kte , &
+                    generic , lagrange_order )
+
+   implicit none
+
+   integer , intent(in) :: ids , ide , jds , jde , kds , kde , &
+              ims , ime , jms , jme , kms , kme , &
+              its , ite , jts , jte , kts , kte
+
+   integer , intent(in) :: generic , lagrange_order
+
+   real , dimension(ims:ime,generic,jms:jme) , intent(out) :: fo , po
+   real , dimension(ims:ime,kms:kme,jms:jme) , intent(out) :: fn , pn
+
+   integer :: i , j , k
+   
+   real , parameter :: piov2 = 3.14159265358 / 2.
+
+   k = 1
+   do j = jts , jte
+   do i = its , ite
+      po(i,k,j) = 102000.
+   end do
+   end do
+   
+   do k = 2 , generic
+   do j = jts , jte
+   do i = its , ite
+      po(i,k,j) = ( 5000. * ( 1 - (k-1) ) + 100000. * ( (k-1) - (generic-1) ) ) / (1. - real(generic-1) )
+   end do
+   end do
+   end do
+
+   if ( lagrange_order .eq. 1 ) then
+      do k = 1 , generic
+      do j = jts , jte
+      do i = its , ite
+         fo(i,k,j) = po(i,k,j)
+!        fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   else if ( lagrange_order .eq. 2 ) then
+      do k = 1 , generic
+      do j = jts , jte
+      do i = its , ite
+         fo(i,k,j) = (((po(i,k,j)-5000.)/102000.)*((102000.-po(i,k,j))/102000.))*102000.
+!        fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   end if
+
+!!!!!!!!!!!!
+   
+   do k = kts , kte
+   do j = jts , jte
+   do i = its , ite
+      pn(i,k,j) = ( 5000. * ( 0 - (k-1) ) + 102000. * ( (k-1) - (kte-1) ) ) / (-1. *  real(kte-1) )
+   end do
+   end do
+   end do
+   
+   do k = kts , kte-1
+   do j = jts , jte
+   do i = its , ite
+      pn(i,k,j) = ( pn(i,k,j) + pn(i,k+1,j) ) /2.
+   end do
+   end do
+   end do
+
+
+   if ( lagrange_order .eq. 1 ) then
+      do k = kts , kte-1
+      do j = jts , jte
+      do i = its , ite
+         fn(i,k,j) = pn(i,k,j)
+!        fn(i,k,j) = sin(pn(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   else if ( lagrange_order .eq. 2 ) then
+      do k = kts , kte-1
+      do j = jts , jte
+      do i = its , ite
+         fn(i,k,j) = (((pn(i,k,j)-5000.)/102000.)*((102000.-pn(i,k,j))/102000.))*102000.
+!        fn(i,k,j) = sin(pn(i,k,j) * piov2 / 102000. )
+      end do
+      end do
+      end do
+   end if
+
+end subroutine fillitup
+
+#endif
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE vert_interp ( fo , po , fnew , pnu , &
+                            generic , var_type , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+   !  Vertically interpolate the new field.  The original field on the original
+   !  pressure levels is provided, and the new pressure surfaces to interpolate to.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: interp_type , lagrange_order
+      LOGICAL , INTENT(IN)        :: lowest_lev_from_sfc
+      REAL    , INTENT(IN)        :: zap_close_levels
+      INTEGER , INTENT(IN)        :: force_sfc_in_vinterp
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+      INTEGER , INTENT(IN)        :: generic
+
+      CHARACTER (LEN=1) :: var_type 
+
+      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(IN)     :: fo , po
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: pnu
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: fnew
+
+      REAL , DIMENSION(ims:ime,generic,jms:jme)                  :: forig , porig
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme)                  :: pnew
+
+      !  Local vars
+
+      INTEGER :: i , j , k , ko , kn , k1 , k2 , ko_1 , ko_2 , knext
+      INTEGER :: istart , iend , jstart , jend , kstart , kend 
+      INTEGER , DIMENSION(ims:ime,kms:kme        )               :: k_above , k_below
+      INTEGER , DIMENSION(ims:ime                )               :: ks
+      INTEGER , DIMENSION(ims:ime                )               :: ko_above_sfc
+      INTEGER :: count , zap , kst
+
+      LOGICAL :: any_below_ground
+
+      REAL :: p1 , p2 , pn, hold
+      REAL , DIMENSION(1:generic) :: ordered_porig , ordered_forig
+      REAL , DIMENSION(kts:kte) :: ordered_pnew , ordered_fnew
+
+!****MARS
+!big problems ... discontinuity in the interpolated fields ...
+print *, '25/05/2007: decided to use simple linear interpolations'
+print *, 'use that one at your own risk'
+!stop
+!****MARS
+
+
+      !  Horiontal loop bounds for different variable types.
+
+      IF      ( var_type .EQ. 'U' ) THEN
+         istart = its
+         iend   = ite
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  porig(i,k,j) = ( po(i,k,j) + po(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = 1,generic
+                  porig(its,k,j) =  po(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = 1,generic
+                  porig(ite,k,j) =  po(ite-1,k,j)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = kstart,kend
+                  pnew(its,k,j) =  pnu(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = kstart,kend
+                  pnew(ite,k,j) =  pnu(ite-1,k,j)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( var_type .EQ. 'V' ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = jte
+         kstart = kts
+         kend   = kte-1
+         DO i = istart,iend
+            DO k = 1,generic
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  porig(i,k,j) = ( po(i,k,j) + po(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = 1,generic
+                  porig(i,k,jts) =  po(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+               DO k = 1,generic
+                  porig(i,k,jte) =  po(i,k,jte-1)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = kstart,kend
+                  pnew(i,k,jts) =  pnu(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+              DO k = kstart,kend
+                  pnew(i,k,jte) =  pnu(i,k,jte-1)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( ( var_type .EQ. 'W' ) .OR.  ( var_type .EQ. 'Z' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE IF ( ( var_type .EQ. 'T' ) .OR. ( var_type .EQ. 'Q' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      END IF
+
+      DO j = jstart , jend
+
+         !  The lowest level is the surface.  Levels 2 through "generic" are supposed to
+         !  be "bottom-up".  Flip if they are not.  This is based on the input pressure 
+         !  array.
+
+         IF      ( porig(its,2,j) .LT. porig(its,generic,j) ) THEN
+            DO kn = 2 , ( generic + 1 ) / 2
+               DO i = istart , iend
+                  hold                    = porig(i,kn,j) 
+                  porig(i,kn,j)           = porig(i,generic+2-kn,j)
+                  porig(i,generic+2-kn,j) = hold
+                  forig(i,kn,j)           = fo   (i,generic+2-kn,j)
+                  forig(i,generic+2-kn,j) = fo   (i,kn,j)
+               END DO
+               DO i = istart , iend
+                  forig(i,1,j)           = fo   (i,1,j)
+               END DO
+            END DO
+         ELSE
+            DO kn = 1 , generic
+               DO i = istart , iend
+                  forig(i,kn,j)          = fo   (i,kn,j)
+               END DO
+            END DO
+         END IF
+    
+         !  Skip all of the levels below ground in the original data based upon the surface pressure.
+         !  The ko_above_sfc is the index in the pressure array that is above the surface.  If there
+         !  are no levels underground, this is index = 2.  The remaining levels are eligible for use
+         !  in the vertical interpolation.
+   
+         DO i = istart , iend
+            ko_above_sfc(i) = -1
+         END DO
+         DO ko = kstart+1 , kend
+            DO i = istart , iend
+               IF ( ko_above_sfc(i) .EQ. -1 ) THEN
+                  IF ( porig(i,1,j) .GT. porig(i,ko,j) ) THEN
+                     ko_above_sfc(i) = ko
+                  END IF
+               END IF
+            END DO
+         END DO
+
+         !  Piece together columns of the original input data.  Pass the vertical columns to
+         !  the iterpolator.
+
+         DO i = istart , iend
+
+            !  If the surface value is in the middle of the array, three steps: 1) do the
+            !  values below the ground (this is just to catch the occasional value that is
+            !  inconsistently below the surface based on input data), 2) do the surface level, then 
+            !  3) add in the levels that are above the surface.  For the levels next to the surface,
+            !  we check to remove any levels that are "too close".  When building the column of input
+            !  pressures, we also attend to the request for forcing the surface analysis to be used
+            !  in a few lower eta-levels.
+
+            !  How many levels have we skipped in the input column.
+
+            zap = 0
+
+            !  Fill in the column from up to the level just below the surface with the input
+            !  presssure and the input field (orig or old, which ever).  For an isobaric input
+            !  file, this data is isobaric.
+
+            IF (  ko_above_sfc(i) .GT. 2 ) THEN
+               count = 1
+               DO ko = 2 , ko_above_sfc(i)-1
+                  ordered_porig(count) = porig(i,ko,j)
+                  ordered_forig(count) = forig(i,ko,j)
+                  count = count + 1
+               END DO
+
+               !  Make sure the pressure just below the surface is not "too close", this
+               !  will cause havoc with the higher order interpolators.  In case of a "too close"
+               !  instance, we toss out the offending level (NOT the surface one) by simply
+               !  decrementing the accumulating loop counter.
+
+               IF ( ordered_porig(count-1) - porig(i,1,j) .LT. zap_close_levels ) THEN
+                  count = count -1
+                  zap = 1
+               END IF
+
+               !  Add in the surface values.
+   
+               ordered_porig(count) = porig(i,1,j)
+               ordered_forig(count) = forig(i,1,j)
+               count = count + 1
+
+               !  A usual way to do the vertical interpolation is to pay more attention to the 
+               !  surface data.  Why?  Well it has about 20x the density as the upper air, so we 
+               !  hope the analysis is better there.  We more strongly use this data by artificially
+               !  tossing out levels above the surface that are beneath a certain number of prescribed
+               !  eta levels at this (i,j).  The "zap" value is how many levels of input we are 
+               !  removing, which is used to tell the interpolator how many valid values are in 
+               !  the column.  The "count" value is the increment to the index of levels, and is
+               !  only used for assignments.
+
+               IF ( force_sfc_in_vinterp .GT. 0 ) THEN
+
+                  !  Get the pressure at the eta level.  We want to remove all input pressure levels
+                  !  between the level above the surface to the pressure at this eta surface.  That 
+                  !  forces the surface value to be used through the selected eta level.  Keep track
+                  !  of two things: the level to use above the eta levels, and how many levels we are
+                  !  skipping.
+
+                  knext = ko_above_sfc(i)
+                  find_level : DO ko = ko_above_sfc(i) , generic
+                     IF ( porig(i,ko,j) .LE. pnew(i,force_sfc_in_vinterp,j) ) THEN
+                        knext = ko
+                        exit find_level
+                     ELSE
+                        zap = zap + 1
+                     END IF
+                  END DO find_level
+
+               !  No request for special interpolation, so we just assign the next level to use
+               !  above the surface as, ta da, the first level above the surface.  I know, wow.
+
+               ELSE
+                  knext = ko_above_sfc(i)
+               END IF
+
+               !  One more time, make sure the pressure just above the surface is not "too close", this
+               !  will cause havoc with the higher order interpolators.  In case of a "too close"
+               !  instance, we toss out the offending level above the surface (NOT the surface one) by simply
+               !  incrementing the loop counter.  Here, count-1 is the surface level and knext is either
+               !  the next level up OR it is the level above the prescribed number of eta surfaces.
+
+               IF ( ordered_porig(count-1) - porig(i,knext,j) .LT. zap_close_levels ) THEN
+                  kst = knext+1
+                  zap = zap + 1
+               ELSE
+                  kst = knext
+               END IF
+   
+               DO ko = kst , generic
+                  ordered_porig(count) = porig(i,ko,j)
+                  ordered_forig(count) = forig(i,ko,j)
+                  count = count + 1
+               END DO
+
+            !  This is easy, the surface is the lowest level, just stick them in, in this order.  OK,
+            !  there are a couple of subtleties.  We have to check for that special interpolation that
+            !  skips some input levels so that the surface is used for the lowest few eta levels.  Also,
+            !  we must macke sure that we still do not have levels that are "too close" together.
+            
+            ELSE
+        
+               !  Initialize no input levels have yet been removed from consideration.
+
+               zap = 0
+
+               !  The surface is the lowest level, so it gets set right away to location 1.
+
+               ordered_porig(1) = porig(i,1,j)
+               ordered_forig(1) = forig(i,1,j)
+
+               !  We start filling in the array at loc 2, as in just above the level we just stored.
+
+               count = 2
+
+               !  Are we forcing the interpolator to skip valid input levels so that the
+               !  surface data is used through more levels?  Essentially as above.
+
+               IF ( force_sfc_in_vinterp .GT. 0 ) THEN
+                  knext = 2
+                  find_level2: DO ko = 2 , generic
+                     IF ( porig(i,ko,j) .LE. pnew(i,force_sfc_in_vinterp,j) ) THEN
+                        knext = ko
+                        exit find_level2
+                     ELSE
+                        zap = zap + 1
+                     END IF
+                  END DO find_level2
+               ELSE
+                  knext = 2
+               END IF
+
+               !  Fill in the data above the surface.  The "knext" index is either the one
+               !  just above the surface OR it is the index associated with the level that
+               !  is just above the pressure at this (i,j) of the top eta level that is to
+               !  be directly impacted with the surface level in interpolation.
+
+               DO ko = knext , generic
+                  IF ( ordered_porig(count-1) - porig(i,ko,j) .LT. zap_close_levels ) THEN
+                     zap = zap + 1
+                     CYCLE
+                  END IF
+                  ordered_porig(count) = porig(i,ko,j)
+                  ordered_forig(count) = forig(i,ko,j)
+                  count = count + 1
+               END DO
+
+            END IF
+
+            !  Now get the column of the "new" pressure data.  So, this one is easy.
+
+            DO kn = kstart , kend
+               ordered_pnew(kn) = pnew(i,kn,j)
+            END DO
+
+            !  The polynomials are either in pressure or LOG(pressure).
+
+            IF ( interp_type .EQ. 1 ) THEN
+               CALL lagrange_setup ( var_type , &
+                   ordered_porig                 , ordered_forig , generic-zap   , lagrange_order , &
+                   ordered_pnew                  , ordered_fnew  , kend-kstart+1 ,i,j)
+            ELSE
+               CALL lagrange_setup ( var_type , &
+               LOG(ordered_porig(1:generic-zap)) , ordered_forig , generic-zap   , lagrange_order , &
+               LOG(ordered_pnew(kstart:kend))    , ordered_fnew  , kend-kstart+1 ,i,j)
+            END IF
+
+            !  Save the computed data.
+
+            DO kn = kstart , kend
+               fnew(i,kn,j) = ordered_fnew(kn)
+            END DO
+
+            !  There may have been a request to have the surface data from the input field
+            !  to be assigned as to the lowest eta level.  This assumes thin layers (usually
+            !  the isobaric original field has the surface from 2-m T and RH, and 10-m U and V).
+
+            IF ( lowest_lev_from_sfc ) THEN
+               fnew(i,1,j) = forig(i,ko_above_sfc(i)-1,j)
+            END IF
+
+         END DO
+
+      END DO
+
+   END SUBROUTINE vert_interp
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE vert_interp_old ( forig , po , fnew , pnu , &
+                            generic , var_type , &
+                            interp_type , lagrange_order , lowest_lev_from_sfc , &
+                            zap_close_levels , force_sfc_in_vinterp , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+   !  Vertically interpolate the new field.  The original field on the original
+   !  pressure levels is provided, and the new pressure surfaces to interpolate to.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: interp_type , lagrange_order
+      LOGICAL , INTENT(IN)        :: lowest_lev_from_sfc
+      REAL    , INTENT(IN)        :: zap_close_levels
+      INTEGER , INTENT(IN)        :: force_sfc_in_vinterp
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+      INTEGER , INTENT(IN)        :: generic
+
+      CHARACTER (LEN=1) :: var_type 
+
+!      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(IN)     :: forig , po
+!****MARS
+!error with g95 and warning with pgf90
+      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(IN)     :: po
+      REAL , DIMENSION(ims:ime,generic,jms:jme) , INTENT(INOUT)  :: forig
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: pnu
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: fnew
+
+      REAL , DIMENSION(ims:ime,generic,jms:jme)                  :: porig
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme)                  :: pnew
+
+      !  Local vars
+
+      INTEGER :: i , j , k , ko , kn , k1 , k2 , ko_1 , ko_2
+      INTEGER :: istart , iend , jstart , jend , kstart , kend 
+      INTEGER , DIMENSION(ims:ime,kms:kme        )               :: k_above , k_below
+      INTEGER , DIMENSION(ims:ime                )               :: ks
+      INTEGER , DIMENSION(ims:ime                )               :: ko_above_sfc
+
+      LOGICAL :: any_below_ground
+
+      REAL :: p1 , p2 , pn
+!****MARS
+integer vert_extrap
+integer kn_save
+vert_extrap = 0
+kn_save = 0
+!****MARS
+
+      !  Horizontal loop bounds for different variable types.
+
+      IF      ( var_type .EQ. 'U' ) THEN
+         istart = its
+         iend   = ite
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  porig(i,k,j) = ( po(i,k,j) + po(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = 1,generic
+                  porig(its,k,j) =  po(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = 1,generic
+                  porig(ite,k,j) =  po(ite-1,k,j)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO i = MAX(ids+1,its) , MIN(ide-1,ite)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i-1,k,j) ) * 0.5
+               END DO
+            END DO
+            IF ( ids .EQ. its ) THEN
+               DO k = kstart,kend
+                  pnew(its,k,j) =  pnu(its,k,j)
+               END DO
+            END IF
+            IF ( ide .EQ. ite ) THEN
+               DO k = kstart,kend
+                  pnew(ite,k,j) =  pnu(ite-1,k,j)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( var_type .EQ. 'V' ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = jte
+         kstart = kts
+         kend   = kte-1
+         DO i = istart,iend
+            DO k = 1,generic
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  porig(i,k,j) = ( po(i,k,j) + po(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = 1,generic
+                  porig(i,k,jts) =  po(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+               DO k = 1,generic
+                  porig(i,k,jte) =  po(i,k,jte-1)
+               END DO
+            END IF
+
+            DO k = kstart,kend
+               DO j = MAX(jds+1,jts) , MIN(jde-1,jte)
+                  pnew(i,k,j) = ( pnu(i,k,j) + pnu(i,k,j-1) ) * 0.5
+               END DO
+            END DO
+            IF ( jds .EQ. jts ) THEN
+               DO k = kstart,kend
+                  pnew(i,k,jts) =  pnu(i,k,jts)
+               END DO
+            END IF
+            IF ( jde .EQ. jte ) THEN
+              DO k = kstart,kend
+                  pnew(i,k,jte) =  pnu(i,k,jte-1)
+               END DO
+            END IF
+         END DO
+      ELSE IF ( ( var_type .EQ. 'W' ) .OR.  ( var_type .EQ. 'Z' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE IF ( ( var_type .EQ. 'T' ) .OR. ( var_type .EQ. 'Q' ) ) THEN
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      ELSE
+         istart = its
+         iend   = MIN(ide-1,ite)
+         jstart = jts
+         jend   = MIN(jde-1,jte)
+         kstart = kts
+         kend   = kte-1
+         DO j = jstart,jend
+            DO k = 1,generic
+               DO i = istart,iend
+                  porig(i,k,j) = po(i,k,j)
+               END DO
+            END DO
+
+            DO k = kstart,kend
+               DO i = istart,iend
+                  pnew(i,k,j) = pnu(i,k,j)
+               END DO
+            END DO
+         END DO
+      END IF
+
+
+      DO j = jstart , jend
+    
+         !  Skip all of the levels below ground in the original data based upon the surface pressure.
+         !  The ko_above_sfc is the index in the pressure array that is above the surface.  If there
+         !  are no levels underground, this is index = 2.  The remaining levels are eligible for use
+         !  in the vertical interpolation.
+   
+         DO i = istart , iend
+            ko_above_sfc(i) = -1
+         END DO
+         DO ko = kstart+1 , kend
+            DO i = istart , iend
+
+               IF ( ko_above_sfc(i) .EQ. -1 ) THEN
+                  IF ( porig(i,1,j) .GT. porig(i,ko,j) ) THEN
+                     ko_above_sfc(i) = ko
+!!****MARS
+!!old stuff
+!!
+!! Pressure level may be OK, however data from the diagfi is possibly missing
+!IF (forig(i,ko,j) .EQ. -1.0e+30) THEN
+!        ko_above_sfc(i) = -1
+!END IF
+!        !! Once the right start level is found, check that it is OK
+!        !! >> first column should be 1e30 or so, second column should be a realistic value
+!        !IF ( ko_above_sfc(i) .NE. -1 ) THEN
+!        !        print *, 'verif', forig(i,ko-1,j), forig(i,ko,j), forig(i,ko+1,j), ko
+!        !END IF
+!!
+!!****MARS
+                  END IF
+               END IF
+
+            END DO
+         END DO
+
+         !  Initialize interpolation location.  These are the levels in the original pressure
+         !  data that are physically below and above the targeted new pressure level.
+   
+         DO kn = kts , kte
+            DO i = its , ite
+               k_above(i,kn) = -1
+               k_below(i,kn) = -2
+            END DO
+         END DO
+    
+         !  Starting location is no lower than previous found location.  This is for O(n logn)
+         !  and not O(n^2), where n is the number of vertical levels to search.
+   
+         DO i = its , ite
+            ks(i) = 1
+         END DO
+
+         !  Find trapping layer for interpolation.  The kn index runs through all of the "new"
+         !  levels of data.
+   
+         DO kn = kstart , kend
+
+            DO i = istart , iend
+
+               !  For each "new" level (kn), we search to find the trapping levels in the "orig"
+               !  data.  Most of the time, the "new" levels are the eta surfaces, and the "orig"
+               !  levels are the input pressure levels.
+
+               found_trap_above : DO ko = ks(i) , generic-1
+
+                  !  Because we can have levels in the interpolation that are not valid,
+                  !  let's toss out any candidate orig pressure values that are below ground
+                  !  based on the surface pressure.  If the level =1, then this IS the surface
+                  !  level, so we HAVE to keep that one, but maybe not the ones above.  If the
+                  !  level (ks) is NOT=1, then we have to just CYCLE our loop to find a legit
+                  !  below-pressure value.  If we are not below ground, then we choose two
+                  !  neighboring levels to test whether they surround the new pressure level.
+
+                  !  The input trapping levels that we are trying is the surface and the first valid
+                  !  level above the surface.
+
+                  IF      ( ( ko .LT. ko_above_sfc(i) ) .AND. ( ko .EQ. 1 ) ) THEN
+                     ko_1 = ko
+                     ko_2 = ko_above_sfc(i)
+!!****MARS
+!!old remark: the possible issue is fixed later in the code ...
+!!****MARS
+     
+                  !  The "below" level is underground, cycle until we get to a valid pressure
+                  !  above ground.
+ 
+                  ELSE IF ( ( ko .LT. ko_above_sfc(i) ) .AND. ( ko .NE. 1 ) ) THEN
+                     CYCLE found_trap_above
+
+                  !  The "below" level is above the surface, so we are in the clear to test these
+                  !  two levels out.
+
+                  ELSE
+                     ko_1 = ko
+                     ko_2 = ko+1
+
+                  END IF
+
+
+                  !  The test of the candidate levels: "below" has to have a larger pressure, and
+                  !  "above" has to have a smaller pressure. 
+
+                  !  OK, we found the correct two surrounding levels.  The locations are saved for use in the
+                  !  interpolation.
+
+                  IF      ( ( porig(i,ko_1,j) .GE. pnew(i,kn,j) ) .AND. &
+                            ( porig(i,ko_2,j) .LT. pnew(i,kn,j) ) ) THEN
+                     k_above(i,kn) = ko_2
+                     k_below(i,kn) = ko_1
+                     ks(i) = ko_1
+                     EXIT found_trap_above
+
+                  !  What do we do is we need to extrapolate the data underground?  This happens when the
+                  !  lowest pressure that we have is physically "above" the new target pressure.  Our
+                  !  actions depend on the type of variable we are interpolating.
+
+                  ELSE IF   ( porig(i,1,j) .LT. pnew(i,kn,j) ) THEN
+!!****MARS
+!!old stuff
+!!check: values are usually quite close
+!print *,porig(i,1,j),pnew(i,kn,j)
+!!****MARS
+
+                     !  For horizontal winds and moisture, we keep a constant value under ground.
+
+                     IF      ( ( var_type .EQ. 'U' ) .OR. &
+                               ( var_type .EQ. 'V' ) .OR. &
+                               ( var_type .EQ. 'Q' ) ) THEN
+                        k_above(i,kn) = 1
+                        ks(i) = 1
+
+                     !  For temperature and height, we extrapolate the data.  Hopefully, we are not
+                     !  extrapolating too far.  For pressure level input, the eta levels are always
+                     !  contained within the surface to p_top levels, so no extrapolation is ever
+                     !  required.  
+
+                     ELSE IF ( ( var_type .EQ. 'Z' ) .OR. &
+                               ( var_type .EQ. 'T' ) ) THEN
+                        k_above(i,kn) = ko_above_sfc(i)
+                        k_below(i,kn) = 1
+                        ks(i) = 1
+!!!****MARS
+!!old stuff
+!k_above(i,kn) = 1
+!ks(i) = 1
+!!!"Hopefully, we are not extrapolating too far"
+!!!>> true on Mars ?? 
+!!!****MARS
+
+                     !  Just a catch all right now.
+
+                     ELSE
+                        k_above(i,kn) = 1
+                        ks(i) = 1
+                     END IF
+
+                     EXIT found_trap_above
+
+                  !  The other extrapolation that might be required is when we are going above the
+                  !  top level of the input data.  Usually this means we chose a P_PTOP value that
+                  !  was inappropriate, and we should stop and let someone fix this mess.  
+
+                  ELSE IF   ( porig(i,generic,j) .GT. pnew(i,kn,j) ) THEN
+                     print *,'data is too high, try a lower p_top'
+                     print *,'pnew=',pnew(i,kn,j),'i',i,'j',j,'kn',kn
+                        print *,'pnew=',pnew(i,:,j)
+                     print *,'porig=',porig(i,:,j)
+                     CALL wrf_error_fatal ('requested p_top is higher than input data, lower p_top')
+
+                  END IF
+               END DO found_trap_above
+            END DO
+         END DO
+
+         !  Linear vertical interpolation.
+
+         DO kn = kstart , kend
+            DO i = istart , iend
+               IF ( k_above(i,kn) .EQ. 1 ) THEN
+!!!****MARS
+!!old stuff
+!!!ne doit pas arriver avec la temperature si l'on definit bien le champ au sol
+!IF (forig(i,1,j) .EQ. -1.0e+30) THEN
+!        print *,'no data here - surface - var is ...',var_type,i,j,1
+!        print *,'setting to first level with data...',ko_above_sfc(i),porig(i,ko_above_sfc(i),j)
+!        forig(i,1,j) = forig(i,ko_above_sfc(i),j)
+!        !IF      ( ( var_type .EQ. 'U' ) .OR. &
+!        !    ( var_type .EQ. 'V' ) .OR. &
+!        !    ( var_type .EQ. 'Q' ) ) THEN
+!        !    print *,'zero wind at the ground'
+!        !    forig(i,1,j) = 0
+!        !ENDIF
+!               IF (forig(i,1,j) .EQ. -1.0e+30) THEN
+!                print *,'well ... are you sure ?'
+!                stop
+!                ENDIF
+!END IF
+!!!****MARS
+                  fnew(i,kn,j) = forig(i,1,j)
+               ELSE
+                  k2 = MAX ( k_above(i,kn) , 2)
+                  k1 = MAX ( k_below(i,kn) , 1)
+                  IF ( k1 .EQ. k2 ) THEN
+                     CALL wrf_error_fatal ( 'identical values in the interp, bad for divisions' )
+                  END IF
+!!!****MARS
+!!old stuff
+!IF (forig(i,k2,j) .EQ. -1.0e+30) THEN
+!        print *,'no data here - level above - you_d better stop',i,j,k2
+!        stop        
+!END IF
+!IF (forig(i,k1,j) .EQ. -1.0e+30) THEN
+!        print *,'no data here - level below - var is ...',var_type,i,j,k1
+!        print *,'setting to first level with data...',ko_above_sfc(i),porig(i,ko_above_sfc(i),j)
+!        forig(i,k1,j) = forig(i,ko_above_sfc(i),j)
+!        !!!VERIFIER QUE LA TEMPERATURE AU SOL N'EST PAS CONCERNEE
+!        !!!(montagnes=sources locales de chaleur)
+!        !!!normalement, pas de souci, et lors de l'exécution rien ne s'affiche
+!END IF
+!!!****MARS
+                  IF      ( interp_type .EQ. 1 ) THEN
+                     p1 = porig(i,k1,j)
+                     p2 = porig(i,k2,j)
+                     pn = pnew(i,kn,j)  
+                  ELSE IF ( interp_type .EQ. 2 ) THEN
+                     p1 = ALOG(porig(i,k1,j))
+                     p2 = ALOG(porig(i,k2,j))
+                     pn = ALOG(pnew(i,kn,j))
+                  END IF
+                  IF ( ( p1-pn) * (p2-pn) > 0. ) THEN
+!                    CALL wrf_error_fatal ( 'both trapping pressures are on the same side of the new pressure' )
+!                    CALL wrf_debug ( 0 , 'both trapping pressures are on the same side of the new pressure' )
+!!!****MARS
+vert_extrap = vert_extrap + 1
+!print *, 'extrapolate', pnew(i,kn,j)-porig(i,k1,j), 'for WRF level', kn
+IF (kn_save < kn) kn_save=kn
+!!!****MARS
+                  END IF
+                  fnew(i,kn,j) = ( forig(i,k1,j) * ( p2 - pn )   + &
+                                   forig(i,k2,j) * ( pn - p1 ) ) / &
+                                   ( p2 - p1 )
+               END IF 
+            END DO
+         END DO
+
+         search_below_ground : DO kn = kstart , kend
+            any_below_ground = .FALSE.
+            DO i = istart , iend
+               IF ( k_above(i,kn) .EQ. 1 ) THEN 
+                  fnew(i,kn,j) = forig(i,1,j)
+                  any_below_ground = .TRUE.
+               END IF
+            END DO
+            IF ( .NOT. any_below_ground ) THEN
+               EXIT search_below_ground
+            END IF
+         END DO search_below_ground
+
+         !  There may have been a request to have the surface data from the input field
+         !  to be assigned as to the lowest eta level.  This assumes thin layers (usually
+         !  the isobaric original field has the surface from 2-m T and RH, and 10-m U and V).
+
+
+         DO i = istart , iend
+            IF ( lowest_lev_from_sfc ) THEN
+               fnew(i,1,j) = forig(i,ko_above_sfc(i),j)
+            END IF
+         END DO
+
+      END DO
+print *,'VERT EXTRAP = ', vert_extrap
+print *,'finished with ... ', var_type
+print *,'max WRF eta level where extrap. occurs: ',kn_save
+
+   END SUBROUTINE vert_interp_old
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE lagrange_setup ( var_type , all_x , all_y , all_dim , n , target_x , target_y , target_dim ,i,j)
+
+      !  We call a Lagrange polynomial interpolator.  The parallel concerns are put off as this
+      !  is initially set up for vertical use.  The purpose is an input column of pressure (all_x),
+      !  and the associated pressure level data (all_y).  These are assumed to be sorted (ascending
+      !  or descending, no matter).  The locations to be interpolated to are the pressures in
+      !  target_x, probably the new vertical coordinate values.  The field that is output is the
+      !  target_y, which is defined at the target_x location.  Mostly we expect to be 2nd order
+      !  overlapping polynomials, with only a single 2nd order method near the top and bottom.
+      !  When n=1, this is linear; when n=2, this is a second order interpolator.
+
+      IMPLICIT NONE
+
+      CHARACTER (LEN=1) :: var_type
+      INTEGER , INTENT(IN) :: all_dim , n , target_dim
+      REAL, DIMENSION(all_dim) , INTENT(IN) :: all_x , all_y
+      REAL , DIMENSION(target_dim) , INTENT(IN) :: target_x
+      REAL , DIMENSION(target_dim) , INTENT(OUT) :: target_y
+
+      !  Brought in for debug purposes, all of the computations are in a single column.
+
+      INTEGER , INTENT(IN) :: i,j
+
+      !  Local vars
+
+      REAL , DIMENSION(n+1) :: x , y 
+      REAL :: target_y_1 , target_y_2
+      LOGICAL :: found_loc
+      INTEGER :: loop , loc_center_left , loc_center_right , ist , iend , target_loop
+
+
+      IF ( all_dim .LT. n+1 ) THEN
+print *,'all_dim = ',all_dim
+print *,'order = ',n
+print *,'i,j = ',i,j
+print *,'p array = ',all_x
+print *,'f array = ',all_y
+print *,'p target= ',target_x
+         CALL wrf_error_fatal ( 'troubles, the interpolating order is too large for this few input values' )
+      END IF
+
+      IF ( n .LT. 1 ) THEN
+         CALL wrf_error_fatal ( 'pal, linear is about as low as we go' )
+      END IF
+
+      !  Loop over the list of target x and y values.
+
+      DO target_loop = 1 , target_dim
+
+         !  Find the two trapping x values, and keep the indices.
+   
+         found_loc = .FALSE.
+         find_trap : DO loop = 1 , all_dim -1
+            IF ( ( target_x(target_loop) - all_x(loop) ) * ( target_x(target_loop) - all_x(loop+1) ) .LE. 0.0 ) THEN
+               loc_center_left  = loop
+               loc_center_right = loop+1
+               found_loc = .TRUE.
+!****MARS: check if no errors here
+!print *,'interpolating ... ',var_type
+!       print *,'i,j = ',i,j
+!       print *,'target pressure and value = ',target_x(target_loop),target_y(target_loop)
+!       DO loop = 1 , all_dim
+!         print *,'column of pressure and value = ',all_x(loop),all_y(loop)
+!       END DO
+!END IF  
+!****MARS
+               EXIT find_trap
+            END IF
+         END DO find_trap
+   
+         IF ( ( .NOT. found_loc ) .AND. ( target_x(target_loop) .GT. all_x(1) ) ) THEN
+            IF ( var_type .EQ. 'T' ) THEN
+write(6,fmt='(A,2i5,2f11.3)') &
+' --> extrapolating TEMPERATURE near sfc: i,j,psfc, p target = ',&
+i,j,all_x(1),target_x(target_loop)
+               target_y(target_loop) = ( all_y(1) * ( target_x(target_loop) - all_x(2) ) + &
+                                         all_y(2) * ( all_x(1) - target_x(target_loop) ) ) / &
+                                       ( all_x(1) - all_x(2) ) 
+            ELSE 
+!write(6,fmt='(A,2i5,2f11.3)') &
+!' --> extrapolating zero gradient near sfc: i,j,psfc, p target = ',&
+!i,j,all_x(1),target_x(target_loop)
+               target_y(target_loop) = all_y(1)
+            END IF
+            CYCLE
+         ELSE IF ( .NOT. found_loc ) THEN
+!****MARS: normally, no errors here (otherwise, keep this part commented ?)
+            print *, var_type
+            print *,'i,j = ',i,j
+            print *,'target pressure and value = ',target_x(target_loop),target_y(target_loop)
+            DO loop = 1 , all_dim
+               print *,'column of pressure and value = ',all_x(loop),all_y(loop)
+            END DO
+           CALL wrf_error_fatal ( 'troubles, could not find trapping x locations' )
+!****MARS: end of 'keep this part commented'
+         END IF
+   
+         !  Even or odd order?  We can put the value in the middle if this is
+         !  an odd order interpolator.  For the even guys, we'll do it twice
+         !  and shift the range one index, then get an average.
+   
+         IF      ( MOD(n,2) .NE. 0 ) THEN
+            IF ( ( loc_center_left -(((n+1)/2)-1) .GE.       1 ) .AND. &
+                 ( loc_center_right+(((n+1)/2)-1) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n+1)/2)-1)
+               iend = iend + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y(target_loop) )
+            ELSE
+               IF ( .NOT. found_loc ) THEN
+                  CALL wrf_error_fatal ( 'I doubt this will happen, I will only do 2nd order for now' )
+               END IF
+            END IF
+   
+         ELSE IF ( MOD(n,2) .EQ. 0 ) THEN
+            IF      ( ( loc_center_left -(((n  )/2)-1) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)  ) .LE. all_dim ) .AND. &
+                      ( loc_center_left -(((n  )/2)  ) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)-1) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n  )/2)-1)
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y_1              )
+               ist  = loc_center_left -(((n  )/2)  )
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y_2              )
+               target_y(target_loop) = ( target_y_1 + target_y_2 ) * 0.5
+   
+            ELSE IF ( ( loc_center_left -(((n  )/2)-1) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)  ) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n  )/2)-1)
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y(target_loop)   )
+            ELSE IF ( ( loc_center_left -(((n  )/2)  ) .GE.       1 ) .AND. &
+                      ( loc_center_right+(((n  )/2)-1) .LE. all_dim ) ) THEN
+               ist  = loc_center_left -(((n  )/2)  )
+               iend = ist + n
+               CALL lagrange_interp ( all_x(ist:iend) , all_y(ist:iend) , n , target_x(target_loop) , target_y(target_loop)   )
+            ELSE
+               CALL wrf_error_fatal ( 'unauthorized area, you should not be here' )
+            END IF
+               
+         END IF
+
+      END DO
+
+   END SUBROUTINE lagrange_setup 
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE lagrange_interp ( x , y , n , target_x , target_y )
+
+      !  Interpolation using Lagrange polynomials.
+      !  P(x) = f(x0)Ln0(x) + ... + f(xn)Lnn(x)
+      !  where Lnk(x) = (x -x0)(x -x1)...(x -xk-1)(x -xk+1)...(x -xn)
+      !                 ---------------------------------------------
+      !                 (xk-x0)(xk-x1)...(xk-xk-1)(xk-xk+1)...(xk-xn)
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: n
+      REAL , DIMENSION(0:n) , INTENT(IN) :: x , y
+      REAL , INTENT(IN) :: target_x
+
+      REAL , INTENT(OUT) :: target_y
+
+      !  Local vars
+
+      INTEGER :: i , k
+      REAL :: numer , denom , Px
+      REAL , DIMENSION(0:n) :: Ln
+
+      Px = 0.
+      DO i = 0 , n
+         numer = 1.         
+         denom = 1.         
+         DO k = 0 , n
+            IF ( k .EQ. i ) CYCLE
+            numer = numer * ( target_x  - x(k) )
+            denom = denom * ( x(i)  - x(k) )
+         END DO
+         Ln(i) = y(i) * numer / denom
+         Px = Px + Ln(i)
+      END DO
+      target_y = Px
+
+   END SUBROUTINE lagrange_interp
+
+#ifndef VERT_UNIT
+!---------------------------------------------------------------------
+
+   SUBROUTINE p_dry ( mu0 , eta , pdht , pdry , &
+                             ids , ide , jds , jde , kds , kde , &
+                             ims , ime , jms , jme , kms , kme , &
+                             its , ite , jts , jte , kts , kte )
+
+   !  Compute reference pressure and the reference mu.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(IN)     :: mu0
+      REAL , DIMENSION(        kms:kme        ) , INTENT(IN)     :: eta
+      REAL                                                       :: pdht
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: pdry
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+      REAL , DIMENSION(        kms:kme        )                  :: eta_h
+
+      DO k = kts , kte-1
+         eta_h(k) = ( eta(k) + eta(k+1) ) * 0.5
+      END DO
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO k = kts , kte-1
+            DO i = its , MIN (ide-1 , ite )
+                  pdry(i,k,j) = eta_h(k) * mu0(i,j) + pdht
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE p_dry
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE p_dts ( pdts , intq , psfc , p_top , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Compute difference between the dry, total surface pressure and the top pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , INTENT(IN) :: p_top
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN)     :: psfc
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN)     :: intq
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(OUT)    :: pdts
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+               pdts(i,j) = psfc(i,j) - intq(i,j) - p_top
+         END DO
+      END DO
+
+   END SUBROUTINE p_dts
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE p_dhs ( pdhs , ht , p0 , t0 , a , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Compute dry, hydrostatic surface pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(IN)     :: ht
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(OUT)    :: pdhs
+
+      REAL , INTENT(IN) :: p0 , t0 , a
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+!****MARS ....
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: g  =   3.72
+print *,'compute dry, hydrostatic surface pressure'
+!****MARS ....
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+               pdhs(i,j) = p0 * EXP ( -t0/a + SQRT ( (t0/a)**2 - 2. * g * ht(i,j)/(a * Rd) ) )
+         END DO
+      END DO
+
+!****MARS
+!****MARS cette formule est-elle juste sur Mars ?
+!****MARS >> a premiere vue, ne donne pas de resultats absurdes
+!****TODO: il y a peut etre meilleur !
+!****MARS
+
+!print *,pdhs
+!stop
+
+
+   END SUBROUTINE p_dhs
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE find_p_top ( p , p_top , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte )
+
+   !  Find the largest pressure in the top level.  This is our p_top.  We are
+   !  assuming that the top level is the location where the pressure is a minimum
+   !  for each column.  In cases where the top surface is not isobaric, a 
+   !  communicated value must be shared in the calling routine.  Also in cases
+   !  where the top surface is not isobaric, care must be taken that the new
+   !  maximum pressure is not greater than the previous value.  This test is
+   !  also handled in the calling routine.
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL :: p_top
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: p
+
+      !  Local vars
+
+      INTEGER :: i , j , k, min_lev
+
+      i = its
+      j = jts
+      p_top = p(i,2,j)
+      min_lev = 2
+      DO k = 2 , kte
+         IF ( p_top .GT. p(i,k,j) ) THEN
+            p_top = p(i,k,j)
+            min_lev = k
+         END IF
+      END DO
+
+      k = min_lev
+      p_top = p(its,k,jts)
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+            p_top = MAX ( p_top , p(i,k,j) )
+         END DO
+      END DO
+
+   END SUBROUTINE find_p_top
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE t_to_theta ( t , p , p00 , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Compute dry, hydrostatic surface pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , INTENT(IN) :: p00
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: p
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT)  :: t
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+!****MARS 
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: Cp = 844.6
+!****MARS
+      
+      DO j = jts , MIN ( jde-1 , jte )
+         DO k = kts , kte
+            DO i = its , MIN (ide-1 , ite )
+               t(i,k,j) = t(i,k,j) * ( p00 / p(i,k,j) ) ** (Rd / Cp)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE t_to_theta
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE integ_moist ( q_in , p_in , pd_out , t_in , ght_in , intq , &
+                            ids , ide , jds , jde , kds , kde , &
+                            ims , ime , jms , jme , kms , kme , &
+                            its , ite , jts , jte , kts , kte )
+
+   !  Integrate the moisture field vertically.  Mostly used to get the total
+   !  vapor pressure, which can be subtracted from the total pressure to get
+   !  the dry pressure.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: q_in , p_in , t_in , ght_in
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: pd_out
+      REAL , DIMENSION(ims:ime,        jms:jme) , INTENT(OUT)    :: intq
+
+      !  Local vars
+
+      INTEGER :: i , j , k 
+      INTEGER , DIMENSION(ims:ime) :: level_above_sfc
+      REAL , DIMENSION(ims:ime,jms:jme) :: psfc , tsfc , qsfc, zsfc
+      REAL , DIMENSION(ims:ime,kms:kme) :: q , p , t , ght, pd
+
+      REAL :: rhobar , qbar , dz
+      REAL :: p1 , p2 , t1 , t2 , q1 , q2 , z1, z2
+  
+      LOGICAL :: upside_down
+
+!****MARS
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: g  =   3.72
+!****MARS
+      
+
+      !  Get a surface value, always the first level of a 3d field.
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO i = its , MIN (ide-1 , ite )
+            psfc(i,j) = p_in(i,kts,j)
+            tsfc(i,j) = t_in(i,kts,j)
+            qsfc(i,j) = q_in(i,kts,j)
+            zsfc(i,j) = ght_in(i,kts,j)
+         END DO
+      END DO
+
+      IF ( p_in(its,kts+1,jts) .LT. p_in(its,kte,jts) ) THEN
+         upside_down = .TRUE.
+      ELSE
+         upside_down = .FALSE.
+      END IF
+
+      DO j = jts , MIN ( jde-1 , jte )
+
+         !  Initialize the integrated quantity of moisture to zero.
+
+         DO i = its , MIN (ide-1 , ite )
+            intq(i,j) = 0.
+         END DO
+
+         IF ( upside_down ) THEN
+            DO i = its , MIN (ide-1 , ite )
+               p(i,kts) = p_in(i,kts,j)
+               t(i,kts) = t_in(i,kts,j)
+               q(i,kts) = q_in(i,kts,j)
+               ght(i,kts) = ght_in(i,kts,j)
+               DO k = kts+1,kte
+                  p(i,k) = p_in(i,kte+2-k,j)
+                  t(i,k) = t_in(i,kte+2-k,j)
+                  q(i,k) = q_in(i,kte+2-k,j)
+                  ght(i,k) = ght_in(i,kte+2-k,j)
+               END DO
+            END DO
+         ELSE
+            DO i = its , MIN (ide-1 , ite )
+               DO k = kts,kte
+                  p(i,k) = p_in(i,k      ,j)
+                  t(i,k) = t_in(i,k      ,j)
+                  q(i,k) = q_in(i,k      ,j)
+                  ght(i,k) = ght_in(i,k      ,j)
+               END DO
+            END DO
+         END IF
+
+         !  Find the first level above the ground.  If all of the levels are above ground, such as
+         !  a terrain following lower coordinate, then the first level above ground is index #2.
+
+         DO i = its , MIN (ide-1 , ite )
+            level_above_sfc(i) = -1
+            IF ( p(i,kts+1) .LT. psfc(i,j) ) THEN
+               level_above_sfc(i) = kts+1
+            ELSE
+               find_k : DO k = kts+1,kte-1
+                  IF ( ( p(i,k  )-psfc(i,j) .GE. 0. ) .AND. &
+                       ( p(i,k+1)-psfc(i,j) .LT. 0. ) ) THEN 
+                     level_above_sfc(i) = k+1
+                     EXIT find_k
+                  END IF
+               END DO find_k
+               IF ( level_above_sfc(i) .EQ. -1 ) THEN
+print *,'i,j = ',i,j
+print *,'p = ',p(i,:)
+print *,'p sfc = ',psfc(i,j)
+                  CALL wrf_error_fatal ( 'Could not find level above ground')
+               END IF
+            END IF
+         END DO
+
+         DO i = its , MIN (ide-1 , ite )
+
+            !  Account for the moisture above the ground.
+
+            pd(i,kte) = p(i,kte)
+            DO k = kte-1,level_above_sfc(i),-1
+                  rhobar = ( p(i,k  ) / ( Rd * t(i,k  ) ) + &
+                             p(i,k+1) / ( Rd * t(i,k+1) ) ) * 0.5
+                  qbar   = ( q(i,k  ) + q(i,k+1) ) * 0.5
+                  dz     = ght(i,k+1) - ght(i,k)
+                  intq(i,j) = intq(i,j) + g * qbar * rhobar / (1. + qbar) * dz
+                  pd(i,k) = p(i,k) - intq(i,j)
+            END DO
+
+            !  Account for the moisture between the surface and the first level up.
+
+            IF ( ( p(i,level_above_sfc(i)-1)-psfc(i,j) .GE. 0. ) .AND. &
+                 ( p(i,level_above_sfc(i)  )-psfc(i,j) .LT. 0. ) .AND. &
+                 ( level_above_sfc(i) .GT. kts ) ) THEN
+               p1 = psfc(i,j)
+               p2 = p(i,level_above_sfc(i))
+               t1 = tsfc(i,j)
+               t2 = t(i,level_above_sfc(i))
+               q1 = qsfc(i,j)
+               q2 = q(i,level_above_sfc(i))
+               z1 = zsfc(i,j)
+               z2 = ght(i,level_above_sfc(i))
+               rhobar = ( p1 / ( Rd * t1 ) + &
+                          p2 / ( Rd * t2 ) ) * 0.5
+               qbar   = ( q1 + q2 ) * 0.5
+               dz     = z2 - z1
+               IF ( dz .GT. 0.1 ) THEN
+                  intq(i,j) = intq(i,j) + g * qbar * rhobar / (1. + qbar) * dz
+               END IF
+              
+               !  Fix the underground values.
+
+               DO k = level_above_sfc(i)-1,kts+1,-1
+                  pd(i,k) = p(i,k) - intq(i,j)
+               END DO
+            END IF
+            pd(i,kts) = psfc(i,j) - intq(i,j)
+
+         END DO
+
+         IF ( upside_down ) THEN
+            DO i = its , MIN (ide-1 , ite )
+               pd_out(i,kts,j) = pd(i,kts)
+               DO k = kts+1,kte
+                  pd_out(i,kte+2-k,j) = pd(i,k)
+               END DO
+            END DO
+         ELSE
+            DO i = its , MIN (ide-1 , ite )
+               DO k = kts,kte
+                  pd_out(i,k,j) = pd(i,k)
+               END DO
+            END DO
+         END IF
+
+      END DO
+
+
+!!!****MARS: no water vapor pressure
+!!    DO k = level_above_sfc(i)-1,kts+1,-1
+!!         pd(i,k) = p(i,k)
+!!    END DO
+!!    pd(i,kts) = psfc(i,j)
+!!!****MARS
+
+
+   END SUBROUTINE integ_moist
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE rh_to_mxrat (rh, t, p, q , wrt_liquid , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte )
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      LOGICAL , INTENT(IN)        :: wrt_liquid
+
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)     :: p , t
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT)  :: rh
+      REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT)    :: q
+
+      !  Local vars
+
+      INTEGER                     :: i , j , k 
+
+      REAL                        :: ew , q1 , t1
+!****MARS ....  regler si besoin ....
+!****MARS
+      REAL,         PARAMETER     :: T_REF       = 0.0
+      REAL,         PARAMETER     :: MW_AIR      = 28.966
+      REAL,         PARAMETER     :: MW_VAP      = 18.0152
+
+      REAL,         PARAMETER     :: A0       = 6.107799961
+      REAL,         PARAMETER     :: A1       = 4.436518521e-01
+      REAL,         PARAMETER     :: A2       = 1.428945805e-02
+      REAL,         PARAMETER     :: A3       = 2.650648471e-04
+      REAL,         PARAMETER     :: A4       = 3.031240396e-06
+      REAL,         PARAMETER     :: A5       = 2.034080948e-08
+      REAL,         PARAMETER     :: A6       = 6.136820929e-11
+
+      REAL,         PARAMETER     :: ES0 = 6.1121
+
+      REAL,         PARAMETER     :: C1       = 9.09718
+      REAL,         PARAMETER     :: C2       = 3.56654
+      REAL,         PARAMETER     :: C3       = 0.876793
+      REAL,         PARAMETER     :: EIS      = 6.1071
+      REAL                        :: RHS
+      REAL,         PARAMETER     :: TF       = 273.16
+      REAL                        :: TK
+
+      REAL                        :: ES
+      REAL                        :: QS
+      REAL,         PARAMETER     :: EPS         = 0.622
+      REAL,         PARAMETER     :: SVP1        = 0.6112
+      REAL,         PARAMETER     :: SVP2        = 17.67
+      REAL,         PARAMETER     :: SVP3        = 29.65
+      REAL,         PARAMETER     :: SVPT0       = 273.15
+!****MARS
+!****MARS
+
+
+      !  This subroutine computes mixing ratio (q, kg/kg) from basic variables
+      !  pressure (p, Pa), temperature (t, K) and relative humidity (rh, 1-100%).
+      !  The reference temperature (t_ref, C) is used to describe the temperature 
+      !  at which the liquid and ice phase change occurs.
+
+      DO j = jts , MIN ( jde-1 , jte )
+         DO k = kts , kte
+            DO i = its , MIN (ide-1 , ite )
+                  rh(i,k,j) = MIN ( MAX ( rh(i,k,j) ,  1. ) , 100. ) 
+            END DO
+         END DO
+      END DO
+
+      IF ( wrt_liquid ) THEN
+         DO j = jts , MIN ( jde-1 , jte )
+            DO k = kts , kte
+               DO i = its , MIN (ide-1 , ite )
+                  es=svp1*10.*EXP(svp2*(t(i,k,j)-svpt0)/(t(i,k,j)-svp3))
+                  qs=eps*es/(p(i,k,j)/100.-es)
+                  q(i,k,j)=MAX(.01*rh(i,k,j)*qs,0.0)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+         DO j = jts , MIN ( jde-1 , jte )
+            DO k = kts , kte
+               DO i = its , MIN (ide-1 , ite )
+
+                  t1 = t(i,k,j) - 273.16
+
+                  !  Obviously dry.
+
+                  IF ( t1 .lt. -200. ) THEN
+                     q(i,k,j) = 0
+
+                  ELSE
+
+                     !  First compute the ambient vapor pressure of water
+
+                     IF ( ( t1 .GE. t_ref ) .AND. ( t1 .GE. -47.) ) THEN    ! liq phase ESLO
+                        ew = a0 + t1 * (a1 + t1 * (a2 + t1 * (a3 + t1 * (a4 + t1 * (a5 + t1 * a6)))))
+
+                     ELSE IF ( ( t1 .GE. t_ref ) .AND. ( t1 .LT. -47. ) ) then !liq phas poor ES
+                        ew = es0 * exp(17.67 * t1 / ( t1 + 243.5))
+
+                     ELSE
+                        tk = t(i,k,j)
+                        rhs = -c1 * (tf / tk - 1.) - c2 * alog10(tf / tk) +  &
+                               c3 * (1. - tk / tf) +      alog10(eis)
+                        ew = 10. ** rhs
+
+                     END IF
+
+                     !  Now sat vap pres obtained compute local vapor pressure
+  
+                     ew = MAX ( ew , 0. ) * rh(i,k,j) * 0.01
+
+                     !  Now compute the specific humidity using the partial vapor
+                     !  pressures of water vapor (ew) and dry air (p-ew).  The
+                     !  constants assume that the pressure is in hPa, so we divide
+                     !  the pressures by 100.
+
+                     q1 = mw_vap * ew
+                     q1 = q1 / (q1 + mw_air * (p(i,k,j)/100. - ew))
+
+                     q(i,k,j) = q1 / (1. - q1 )
+
+                  END IF
+
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+!!****MARS
+!!TODO: change once tracers are activated ?
+!q=0.
+!!****MARS
+
+   END SUBROUTINE rh_to_mxrat
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE compute_eta ( znw , &
+                           eta_levels , max_eta , max_dz , &
+fixedpbl, &
+                           p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0 , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte )
+   
+      !  Compute eta levels, either using given values from the namelist (hardly
+      !  a computation, yep, I know), or assuming a constant dz above the PBL,
+      !  knowing p_top and the number of eta levels.
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+      REAL , INTENT(IN)           :: max_dz
+      REAL , INTENT(IN)           :: p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0
+      INTEGER , INTENT(IN)        :: max_eta
+      REAL , DIMENSION (max_eta) , INTENT(IN)  :: eta_levels
+
+      REAL , DIMENSION (kts:kte) , INTENT(OUT) :: znw
+
+      !  Local vars
+
+      INTEGER :: k 
+      REAL :: mub , t_init , p_surf , pb, ztop, ztop_pbl , dz , temp
+      REAL , DIMENSION(kts:kte) :: dnw
+
+      INTEGER , PARAMETER :: prac_levels = 17
+      INTEGER :: loop , loop1
+      REAL , DIMENSION(prac_levels) :: znw_prac , znu_prac , dnw_prac
+      REAL , DIMENSION(kts:kte) :: alb , phb
+
+
+!****MARS      
+!****MARS
+INTEGER, fixedpbl   ! usually, 8 first layers are fixed
+                    ! change this parameter if the top is very
+                    ! low     
+print *, 'check Mars: p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0' 
+print *, p_top , g , p00 , cvpm , a , r_d , cp , t00 , p1000mb , t0
+!-----solution alternative: definir dans la namelist les niveaux verticaux
+!****MARS
+!****MARS
+
+
+      !  Gee, do the eta levels come in from the namelist?
+
+      IF ( ABS(eta_levels(1)+1.) .GT. 0.0000001 ) THEN
+
+         IF ( ( ABS(eta_levels(1  )-1.) .LT. 0.0000001 ) .AND. &
+              ( ABS(eta_levels(kde)-0.) .LT. 0.0000001 ) ) THEN
+            DO k = kds+1 , kde-1
+               znw(k) = eta_levels(k)
+            END DO
+            znw(  1) = 1.
+            znw(kde) = 0.
+         ELSE
+            CALL wrf_error_fatal ( 'First eta level should be 1.0 and the last 0.0 in namelist' )
+         END IF
+
+      !  Compute eta levels assuming a constant delta z above the PBL.
+
+      ELSE
+
+         !  Compute top of the atmosphere with some silly levels.  We just want to
+         !  integrate to get a reasonable value for ztop.  We use the planned PBL-esque
+         !  levels, and then just coarse resolution above that.  We know p_top, and we
+         !  have the base state vars.
+
+         p_surf = p00 
+
+!         znw_prac = (/ 1.000 , 0.993 , 0.983 , 0.970 , 0.954 , 0.934 , 0.909 , &
+!                       0.88 , 0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+
+!****MARS
+!****MARS
+! on Mars, this is important to correctly resolve the surface
+! -- levels were changed to get closer to the surface
+! -- values were chosen as done typically in LMD GCM simulations
+!TODO: better repartition ?
+        znw_prac = (/ 1.000 , &
+                        0.9995 , &  
+                        0.9980 , &
+                        0.9950 , &
+                        0.9850 , &
+                        0.9700 , &
+                        0.9400 , &
+                        0.9000 , &
+                        0.8 , 0.7 , 0.6 , 0.5 , 0.4 , 0.3 , 0.2 , 0.1 , 0.0 /)
+!****MARS
+!****MARS
+
+
+         DO k = 1 , prac_levels - 1
+            znu_prac(k) = ( znw_prac(k) + znw_prac(k+1) ) * 0.5
+            dnw_prac(k) = znw_prac(k+1) - znw_prac(k)
+         END DO
+
+         DO k = 1, prac_levels-1
+            pb = znu_prac(k)*(p_surf - p_top) + p_top
+!           temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+            temp =             t00 + A*LOG(pb/p00)
+            t_init = temp*(p00/pb)**(r_d/cp) - t0
+            alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+         END DO
+       
+         !  Base state mu is defined as base state surface pressure minus p_top
+
+         mub = p_surf - p_top
+       
+         !  Integrate base geopotential, starting at terrain elevation.
+
+         phb(1) = 0.
+         DO k  = 2,prac_levels
+               phb(k) = phb(k-1) - dnw_prac(k-1)*mub*alb(k-1)
+         END DO
+
+         !  So, now we know the model top in meters.  Get the average depth above the PBL
+         !  of each of the remaining levels.  We are going for a constant delta z thickness.
+
+         ztop     = phb(prac_levels) / g
+         ztop_pbl = phb(fixedpbl) / g
+         dz = ( ztop - ztop_pbl ) / REAL ( kde - fixedpbl )
+
+         !  Standard levels near the surface so no one gets in trouble.
+         DO k = 1 , fixedpbl
+            znw(k) = znw_prac(k)
+         END DO
+
+         !  Using d phb(k)/ d eta(k) = -mub * alb(k), eqn 2.9 
+         !  Skamarock et al, NCAR TN 468.  Use full levels, so
+         !  use twice the thickness.
+
+         DO k = fixedpbl, kte-1
+            pb = znw(k) * (p_surf - p_top) + p_top
+!           temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+            temp =             t00 + A*LOG(pb/p00)
+            t_init = temp*(p00/pb)**(r_d/cp) - t0
+            alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+            znw(k+1) = znw(k) - dz*g / ( mub*alb(k) )
+         END DO
+         znw(kte) = 0.000
+
+         !  There is some iteration.  We want the top level, ztop, to be
+         !  consistent with the delta z, and we want the half level values
+         !  to be consistent with the eta levels.  The inner loop to 10 gets
+         !  the eta levels very accurately, but has a residual at the top, due
+         !  to dz changing.  We reset dz five times, and then things seem OK.
+
+
+         DO loop1 = 1 , 5
+            DO loop = 1 , 10
+               DO k = fixedpbl, kte-1
+                  pb = (znw(k)+znw(k+1))*0.5 * (p_surf - p_top) + p_top
+!                 temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+                  temp =             t00 + A*LOG(pb/p00)
+                  t_init = temp*(p00/pb)**(r_d/cp) - t0
+                  alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+                  znw(k+1) = znw(k) - dz*g / ( mub*alb(k) )
+!!****MARS
+!!attention 'base_lapse' ne doit pas etre trop grand
+!!sinon ... des NaN car temperatures negatives en haut
+!IF ( ( loop1 .EQ. 5 ) .AND. ( loop .EQ. 10 ) ) THEN
+!	IF (k .EQ. 8) THEN
+!		print *, 'p,t,z,k'
+!	END IF
+!	print *,  pb,temp,znw(k+1),k 
+!END IF
+!****MARS
+               END DO
+               IF ( ( loop1 .EQ. 5 ) .AND. ( loop .EQ. 10 ) ) THEN
+                  print *,'Converged znw(kte) should be 0.0 = ',znw(kte)
+               END IF
+               znw(kte) = 0.000
+            END DO
+
+            !  Here is where we check the eta levels values we just computed.
+
+            DO k = 1, kde-1
+               pb = (znw(k)+znw(k+1))*0.5 * (p_surf - p_top) + p_top
+!              temp = MAX ( 200., t00 + A*LOG(pb/p00) )
+               temp =             t00 + A*LOG(pb/p00)
+               t_init = temp*(p00/pb)**(r_d/cp) - t0
+               alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
+            END DO
+
+            phb(1) = 0.
+            DO k  = 2,kde
+                  phb(k) = phb(k-1) - (znw(k)-znw(k-1)) * mub*alb(k-1)
+            END DO
+
+            !  Reset the model top and the dz, and iterate.
+
+            ztop = phb(kde)/g
+            ztop_pbl = phb(fixedpbl)/g
+            dz = ( ztop - ztop_pbl ) / REAL ( kde - fixedpbl ) 
+         END DO
+
+
+! ****MARS
+! Display the computed levels
+print *,'WRF levels are:'
+print *,'z (m)            = ',phb(1)/g
+do k = 2 ,kte
+print *,'z (m) and dz (m) = ',phb(k)/g,(phb(k)-phb(k-1))/g
+
+
+                !! little check of the repartition
+                if (k>2) then
+                if ((phb(k)-2.*phb(k-1)+phb(k-2))/g < -1.e-2) then
+                        print *, 'problem on the repartition' 
+                        print *, '>> try to decrease force_sfc_in_vinterp (<8)'
+                        print *, '>> or increase model top (i.e. lower ptop)'
+                        print *,  (phb(k)-2.*phb(k-1)+phb(k-2))/g
+                        stop
+                endif
+                endif
+end do
+! ****MARS
+
+
+         IF ( dz .GT. max_dz ) THEN
+print *,'z (m)            = ',phb(1)/g
+do k = 2 ,kte
+print *,'z (m) and dz (m) = ',phb(k)/g,(phb(k)-phb(k-1))/g
+end do
+print *,'dz (m) above fixed eta levels = ',dz
+print *,'namelist max_dz (m) = ',max_dz
+print *,'namelist p_top (Pa) = ',p_top
+            CALL wrf_debug ( 0, 'You need one of three things:' )
+            CALL wrf_debug ( 0, '1) More eta levels to reduce the dz: e_vert' )
+            CALL wrf_debug ( 0, '2) A lower p_top so your total height is reduced: p_top_requested')
+            CALL wrf_debug ( 0, '3) Increase the maximum allowable eta thickness: max_dz')
+            CALL wrf_debug ( 0, 'All are namelist options')
+            CALL wrf_error_fatal ( 'dz above fixed eta levels is too large')
+         END IF
+
+      END IF
+
+   END SUBROUTINE compute_eta
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE monthly_min_max ( field_in , field_min , field_max , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Plow through each month, find the max, min values for each i,j.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      REAL , DIMENSION(ims:ime,12,jms:jme) , INTENT(IN)  :: field_in
+      REAL , DIMENSION(ims:ime,   jms:jme) , INTENT(OUT) :: field_min , field_max
+
+      !  Local vars
+
+      INTEGER :: i , j , l
+      REAL :: minner , maxxer
+
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            minner = field_in(i,1,j)
+            maxxer = field_in(i,1,j)
+            DO l = 2 , 12
+               IF ( field_in(i,l,j) .LT. minner ) THEN
+                  minner = field_in(i,l,j)
+               END IF
+               IF ( field_in(i,l,j) .GT. maxxer ) THEN
+                  maxxer = field_in(i,l,j)
+               END IF
+            END DO
+            field_min(i,j) = minner
+            field_max(i,j) = maxxer
+         END DO
+      END DO
+   
+   END SUBROUTINE monthly_min_max
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE monthly_interp_to_date ( field_in , date_str , field_out , &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+   !  Linrarly in time interpolate data to a current valid time.  The data is
+   !  assumed to come in "monthly", valid at the 15th of every month.
+   
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN)        :: ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     its , ite , jts , jte , kts , kte
+
+      CHARACTER (LEN=24) , INTENT(IN) :: date_str
+      REAL , DIMENSION(ims:ime,12,jms:jme) , INTENT(IN)  :: field_in
+      REAL , DIMENSION(ims:ime,   jms:jme) , INTENT(OUT) :: field_out
+
+      !  Local vars
+
+      INTEGER :: i , j , l
+      INTEGER , DIMENSION(0:13) :: middle
+      INTEGER :: target_julyr , target_julday , target_date
+      INTEGER :: julyr , julday , int_month , month1 , month2
+      REAL :: gmt
+      CHARACTER (LEN=4) :: yr
+      CHARACTER (LEN=2) :: mon , day15
+
+
+      WRITE(day15,FMT='(I2.2)') 15
+      DO l = 1 , 12
+         WRITE(mon,FMT='(I2.2)') l
+         CALL get_julgmt ( date_str(1:4)//'-'//mon//'-'//day15//'_'//'00:00:00.0000' , julyr , julday , gmt )
+         middle(l) = julyr*1000 + julday
+      END DO
+
+      l = 0
+      middle(l) = middle( 1) - 31
+
+      l = 13
+      middle(l) = middle(12) + 31
+
+      CALL get_julgmt ( date_str , target_julyr , target_julday , gmt )
+      target_date = target_julyr * 1000 + target_julday
+      find_month : DO l = 0 , 12
+         IF ( ( middle(l) .LT. target_date ) .AND. ( middle(l+1) .GE. target_date ) ) THEN
+            DO j = jts , MIN ( jde-1 , jte )
+               DO i = its , MIN (ide-1 , ite )
+                  int_month = l
+                  IF ( ( int_month .EQ. 0 ) .OR. ( int_month .EQ. 12 ) ) THEN
+                     month1 = 12
+                     month2 =  1
+                  ELSE
+                     month1 = int_month
+                     month2 = month1 + 1
+                  END IF
+                  field_out(i,j) =  ( field_in(i,month2,j) * ( target_date - middle(l)   ) + &
+                                      field_in(i,month1,j) * ( middle(l+1) - target_date ) ) / &
+                                    ( middle(l+1) - middle(l) )
+               END DO
+            END DO
+            EXIT find_month
+         END IF
+      END DO find_month
+
+   END SUBROUTINE monthly_interp_to_date
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE sfcprs (t, q, height, pslv, ter, avgsfct, p, &
+                      psfc, ez_method, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      !  Computes the surface pressure using the input height,
+      !  temperature and q (already computed from relative
+      !  humidity) on p surfaces.  Sea level pressure is used
+      !  to extrapolate a first guess.
+
+      IMPLICIT NONE
+
+!****MARS
+      REAL , PARAMETER :: Rd = 192.
+      REAL , PARAMETER :: Cp = 844.6
+      REAL, PARAMETER    :: g = 3.72
+      REAL, PARAMETER    :: pconst = 610.
+!****MARS
+      
+!****MARS .... to be changed if used
+      REAL, PARAMETER    :: gamma     = 6.5E-3
+      REAL, PARAMETER    :: TC        = 273.15 + 17.5
+      REAL, PARAMETER    :: gammarg   = gamma * Rd / g
+      REAL, PARAMETER    :: rov2      = Rd / 2.
+!****MARS .... to be changed if used
+
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte 
+      LOGICAL , INTENT ( IN ) :: ez_method
+
+      REAL , DIMENSION (ims:ime,kms:kme,jms:jme) , INTENT(IN ):: t, q, height, p
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(IN ):: pslv ,  ter, avgsfct 
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(OUT):: psfc
+      
+      INTEGER                     :: i
+      INTEGER                     :: j
+      INTEGER                     :: k
+      INTEGER , DIMENSION (its:ite,jts:jte) :: k500 , k700 , k850
+
+      LOGICAL                     :: l1
+      LOGICAL                     :: l2
+      LOGICAL                     :: l3
+      LOGICAL                     :: OK
+
+      REAL                        :: gamma78     ( its:ite,jts:jte )
+      REAL                        :: gamma57     ( its:ite,jts:jte )
+      REAL                        :: ht          ( its:ite,jts:jte )
+      REAL                        :: p1          ( its:ite,jts:jte )
+      REAL                        :: t1          ( its:ite,jts:jte )
+      REAL                        :: t500        ( its:ite,jts:jte )
+      REAL                        :: t700        ( its:ite,jts:jte )
+      REAL                        :: t850        ( its:ite,jts:jte )
+      REAL                        :: tfixed      ( its:ite,jts:jte )
+      REAL                        :: tsfc        ( its:ite,jts:jte )
+      REAL                        :: tslv        ( its:ite,jts:jte )
+
+      !  We either compute the surface pressure from a time averaged surface temperature
+      !  (what we will call the "easy way"), or we try to remove the diurnal impact on the
+      !  surface temperature (what we will call the "other way").  Both are essentially 
+      !  corrections to a sea level pressure with a high-resolution topography field.
+
+!****MARS ....
+!****MARS .... the mean sea level method is abandoned
+print *, 'no sea level pressure on Mars, please'
+stop
+!****MARS ....
+
+      IF ( ez_method ) THEN
+
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               psfc(i,j) = pslv(i,j) * ( 1.0 + gamma * ter(i,j) / avgsfct(i,j) ) ** ( - g / ( Rd * gamma ) )
+            END DO
+         END DO
+
+      ELSE
+
+         !  Find the locations of the 850, 700 and 500 mb levels.
+   
+         k850 = 0                              ! find k at: P=850
+         k700 = 0                              !            P=700
+         k500 = 0                              !            P=500
+   
+         i = its
+         j = jts
+         DO k = kts+1 , kte
+            IF      (NINT(p(i,k,j)) .EQ. 85000) THEN
+               k850(i,j) = k
+            ELSE IF (NINT(p(i,k,j)) .EQ. 70000) THEN
+               k700(i,j) = k
+            ELSE IF (NINT(p(i,k,j)) .EQ. 50000) THEN
+               k500(i,j) = k
+            END IF
+         END DO
+   
+         IF ( ( k850(i,j) .EQ. 0 ) .OR. ( k700(i,j) .EQ. 0 ) .OR. ( k500(i,j) .EQ. 0 ) ) THEN
+
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  psfc(i,j) = pslv(i,j) * ( 1.0 + gamma * ter(i,j) / t(i,1,j) ) ** ( - g / ( Rd * gamma ) )
+               END DO
+            END DO
+            
+            RETURN
+#if 0
+
+            !  Possibly it is just that we have a generalized vertical coord, so we do not
+            !  have the values exactly.  Do a simple assignment to a close vertical level.
+
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  DO k = kts+1 , kte-1
+                     IF ( ( p(i,k,j) - 85000. )  * ( p(i,k+1,j) - 85000. ) .LE. 0.0 ) THEN
+                        k850(i,j) = k
+                     END IF
+                     IF ( ( p(i,k,j) - 70000. )  * ( p(i,k+1,j) - 70000. ) .LE. 0.0 ) THEN
+                        k700(i,j) = k
+                     END IF
+                     IF ( ( p(i,k,j) - 50000. )  * ( p(i,k+1,j) - 50000. ) .LE. 0.0 ) THEN
+                        k500(i,j) = k
+                     END IF
+                  END DO
+               END DO
+            END DO
+
+            !  If we *still* do not have the k levels, punt.  I mean, we did try.
+
+            OK = .TRUE.
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( ( k850(i,j) .EQ. 0 ) .OR. ( k700(i,j) .EQ. 0 ) .OR. ( k500(i,j) .EQ. 0 ) ) THEN
+                     OK = .FALSE.
+                     PRINT '(A)','(i,j) = ',i,j,'  Error in finding p level for 850, 700 or 500 hPa.'
+                     DO K = kts+1 , kte
+                        PRINT '(A,I3,A,F10.2,A)','K = ',k,'  PRESSURE = ',p(i,k,j),' Pa'
+                     END DO
+                     PRINT '(A)','Expected 850, 700, and 500 mb values, at least.'
+                  END IF
+               END DO
+            END DO
+            IF ( .NOT. OK ) THEN
+               CALL wrf_error_fatal ( 'wrong pressure levels' )
+            END IF
+#endif
+
+         !  We are here if the data is isobaric and we found the levels for 850, 700,
+         !  and 500 mb right off the bat.
+
+         ELSE
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  k850(i,j) = k850(its,jts)
+                  k700(i,j) = k700(its,jts)
+                  k500(i,j) = k500(its,jts)
+               END DO
+            END DO
+         END IF
+       
+         !  The 850 hPa level of geopotential height is called something special.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               ht(i,j) = height(i,k850(i,j),j)
+            END DO
+         END DO
+   
+         !  The variable ht is now -ter/ht(850 hPa).  The plot thickens.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               ht(i,j) = -ter(i,j) / ht(i,j)
+            END DO
+         END DO
+   
+         !  Make an isothermal assumption to get a first guess at the surface
+         !  pressure.  This is to tell us which levels to use for the lapse
+         !  rates in a bit.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               psfc(i,j) = pslv(i,j) * (pslv(i,j) / p(i,k850(i,j),j)) ** ht(i,j)
+            END DO
+         END DO
+   
+         !  Get a pressure more than pconst Pa above the surface - p1.  The
+         !  p1 is the top of the level that we will use for our lapse rate
+         !  computations.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF      ( ( psfc(i,j) - 95000. ) .GE. 0. ) THEN
+                  p1(i,j) = 85000.
+               ELSE IF ( ( psfc(i,j) - 70000. ) .GE. 0. ) THEN
+                  p1(i,j) = psfc(i,j) - pconst
+               ELSE
+                  p1(i,j) = 50000.
+               END IF
+            END DO
+         END DO
+   
+         !  Compute virtual temperatures for k850, k700, and k500 layers.  Now
+         !  you see why we wanted Q on pressure levels, it all is beginning   
+         !  to make sense.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               t850(i,j) = t(i,k850(i,j),j) * (1. + 0.608 * q(i,k850(i,j),j))
+               t700(i,j) = t(i,k700(i,j),j) * (1. + 0.608 * q(i,k700(i,j),j))
+               t500(i,j) = t(i,k500(i,j),j) * (1. + 0.608 * q(i,k500(i,j),j))
+            END DO
+         END DO
+   
+         !  Compute lapse rates between these three levels.  These are
+         !  environmental values for each (i,j).
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               gamma78(i,j) = ALOG(t850(i,j) / t700(i,j))  / ALOG (p(i,k850(i,j),j) / p(i,k700(i,j),j) )
+               gamma57(i,j) = ALOG(t700(i,j) / t500(i,j))  / ALOG (p(i,k700(i,j),j) / p(i,k500(i,j),j) )
+            END DO
+         END DO
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF      ( ( psfc(i,j) - 95000. ) .GE. 0. ) THEN
+                  t1(i,j) = t850(i,j)
+               ELSE IF ( ( psfc(i,j) - 85000. ) .GE. 0. ) THEN
+                  t1(i,j) = t700(i,j) * (p1(i,j) / (p(i,k700(i,j),j))) ** gamma78(i,j)
+               ELSE IF ( ( psfc(i,j) - 70000. ) .GE. 0.) THEN 
+                  t1(i,j) = t500(i,j) * (p1(i,j) / (p(i,k500(i,j),j))) ** gamma57(i,j)
+               ELSE
+                  t1(i,j) = t500(i,j)
+               ENDIF
+            END DO 
+         END DO 
+   
+         !  From our temperature way up in the air, we extrapolate down to
+         !  the sea level to get a guess at the sea level temperature.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tslv(i,j) = t1(i,j) * (pslv(i,j) / p1(i,j)) ** gammarg
+            END DO 
+         END DO 
+   
+         !  The new surface temperature is computed from the with new sea level 
+         !  temperature, just using the elevation and a lapse rate.  This lapse 
+         !  rate is -6.5 K/km.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tsfc(i,j) = tslv(i,j) - gamma * ter(i,j)
+            END DO 
+         END DO 
+   
+         !  A small correction to the sea-level temperature, in case it is too warm.
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tfixed(i,j) = tc - 0.005 * (tsfc(i,j) - tc) ** 2
+            END DO 
+         END DO 
+   
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               l1 = tslv(i,j) .LT. tc
+               l2 = tsfc(i,j) .LE. tc
+               l3 = .NOT. l1
+               IF      ( l2 .AND. l3 ) THEN
+                  tslv(i,j) = tc
+               ELSE IF ( ( .NOT. l2 ) .AND. l3 ) THEN
+                  tslv(i,j) = tfixed(i,j)
+               END IF
+            END DO
+         END DO
+   
+         !  Finally, we can get to the surface pressure.
+
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+            p1(i,j) = - ter(i,j) * g / ( rov2 * ( tsfc(i,j) + tslv(i,j) ) )
+            psfc(i,j) = pslv(i,j) * EXP ( p1(i,j) )
+            END DO
+         END DO
+
+      END IF
+
+      !  Surface pressure and sea-level pressure are the same at sea level.
+
+!     DO j = jts , MIN(jde-1,jte)
+!        DO i = its , MIN(ide-1,ite)
+!           IF ( ABS ( ter(i,j) )  .LT. 0.1 ) THEN
+!              psfc(i,j) = pslv(i,j)
+!           END IF
+!        END DO
+!     END DO
+
+   END SUBROUTINE sfcprs
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE sfcprs2(t, q, height, psfc_in, ter, avgsfct, p, &
+                      psfc, ez_method, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      !  Computes the surface pressure using the input height,
+      !  temperature and q (already computed from relative
+      !  humidity) on p surfaces.  Sea level pressure is used
+      !  to extrapolate a first guess.
+
+      IMPLICIT NONE
+
+!****MARS
+      REAL , PARAMETER :: Rd = 192.
+      REAL, PARAMETER    :: g = 3.72
+!****MARS
+
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte 
+      LOGICAL , INTENT ( IN ) :: ez_method
+
+      REAL , DIMENSION (ims:ime,kms:kme,jms:jme) , INTENT(IN ):: t, q, height, p
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(IN ):: psfc_in ,  ter, avgsfct 
+      REAL , DIMENSION (ims:ime,        jms:jme) , INTENT(OUT):: psfc
+      
+      INTEGER                     :: i
+      INTEGER                     :: j
+      INTEGER                     :: k
+
+      REAL :: tv_sfc_avg , tv_sfc , del_z
+
+      !  Compute the new surface pressure from the old surface pressure, and a
+      !  known change in elevation at the surface.
+
+
+!****MARS: as is done in MCD/pres0 with the MOLA topography :)
+
+        !!---------
+        !!  del_z = diff in surface topo, lo-res vs hi-res
+        !grid%em_ght_gc - grid%ht
+        !!---------
+        !!* em_ght_gc: surface geopotential height from the GCM 
+        !!* ht: hi-res altimetry
+        !  psfc = psfc_in * exp ( g del_z / (Rd Tv_sfc ) )
+        !!---------
+
+
+      IF ( ez_method ) THEN
+!!
+!!****MARS: 'ez_method' is 'we_have_tavgsfc', hard-coded as false
+!!
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               tv_sfc_avg = avgsfct(i,j) * (1. + 0.608 * q(i,1,j))
+               del_z = height(i,1,j) - ter(i,j)
+               psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * tv_sfc_avg ) )
+            END DO
+         END DO
+      ELSE
+!!              
+!!****MARS .... here is what is done for Mars
+!!
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+!               tv_sfc = t(i,1,j) * (1. + 0.608 * q(i,1,j))
+!!****MARS: 0.608 >> nonsense on Mars 
+tv_sfc = t(i,1,j)
+!!****MARS .... changer pour t_1km - 7e couche GCM
+!!****MARS .... spiga et al. (2007)
+tv_sfc = t(i,8,j)
+               del_z = height(i,1,j) - ter(i,j)
+               psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * tv_sfc     ) )
+!****MARS
+!****MARS .... which temperature is used in the Laplace formula ?
+!!****MARS: hardcoded as 220K (t0)
+!!****MARS: pas une enorme influence
+!psfc(i,j) = psfc_in(i,j) * EXP ( g * del_z / ( Rd * 220 ) )
+
+               
+!	       !****MARS .... check of the altimetry differences
+!	       print *,del_z, tv_sfc
+
+            END DO
+         END DO
+print *, '1 km temperatures - max'         
+print *, MAXVAL(t(:,8,:))         
+      END IF
+
+   END SUBROUTINE sfcprs2
+
+!---------------------------------------------------------------------
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+   SUBROUTINE constante3(field, field_custom, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      IMPLICIT NONE
+
+      REAL :: field_custom
+      REAL, DIMENSION (ims:ime,kms:kme,jms:jme), INTENT(INOUT):: field
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte
+
+
+!!****MARS: set the 3D field to a constant value
+field(:,:,:)=field_custom
+
+  END SUBROUTINE constante3
+!---------------------------------------------------------------------
+   SUBROUTINE constante2(field, field_custom, &
+                      ids , ide , jds , jde , kds , kde , &
+                      ims , ime , jms , jme , kms , kme , &
+                      its , ite , jts , jte , kts , kte )
+
+
+      IMPLICIT NONE
+
+      REAL :: field_custom
+      REAL, DIMENSION (ims:ime,jms:jme), INTENT(INOUT):: field
+      INTEGER , INTENT(IN) ::  ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte
+
+
+!!****MARS: set the 3D field to a constant value
+field(:,:)=field_custom
+
+  END SUBROUTINE constante2
+!---------------------------------------------------------------------
+
+      subroutine build_sigma_hr(dimlevs,sigma_gcm,ps_gcm,ps_hr,sigma_hr) !,p_pgcm)
+
+      implicit none
+!      include "constants_mcd.inc"
+
+!---------------------------------------
+! written by E. Millour and F. Forget
+! Mars Climate Database v4.2
+! see DDD page 27 and following
+!---------------------------------------
+
+        INTEGER , INTENT(IN) :: dimlevs
+
+!     inputs
+      real sigma_gcm(dimlevs) ! GCM sigma levels
+      real ps_gcm             ! GCM surface pressure
+      real ps_hr              ! High res surface pressure
+!     outputs
+      real sigma_hr(dimlevs)  ! High res sigma levels
+!      real p_pgcm(dimlevs)    ! high res to GCM pressure ratios
+
+!     local variables
+      integer l
+      real x  ! lower layer compression (-0.9<x<0) or dilatation (0.<x<0.9)
+      real rp     ! surface pressure ratio ps_hr/ps_gcm
+      real deltaz   ! corresponding pseudo-altitude difference (km)
+      real f  ! coefficient f= p_hr / p_gcm
+      real z  ! altitude of transition of p_hr toward p_gcm (km)
+      real p_pgcm(dimlevs)    ! high res to GCM pressure ratios
+
+! 1. Coefficients
+      rp=ps_hr/ps_gcm
+      deltaz=-10.*log(rp)
+      x = min(max(0.12*(abs(deltaz)-1.),0.),0.8)
+      if(deltaz.gt.0) x=-x
+      z=max(deltaz + 3.,3.)
+
+      do l=1,dimlevs
+        f=rp*sigma_gcm(l)**x
+!        f=f+(1-f)*0.5*(1+tanh(6.*(-10.*log(sigma_gcm(l))-z)/z))
+!        sigma_hr(l)=f*sigma_gcm(l)/rp
+        p_pgcm(l)=f+(1-f)*0.5*(1+tanh(6.*(-10.*log(sigma_gcm(l))-z)/z))
+        sigma_hr(l)=p_pgcm(l)*sigma_gcm(l)/rp
+      enddo
+
+      end subroutine build_sigma_hr
+
+
+
+
+
+END MODULE module_initialize
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_squall2d_x.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_squall2d_x.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_squall2d_x.F	(revision 2744)
@@ -0,0 +1,772 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!  This MODULE CONTAINS the following routines:
+
+!  initialize_field_test - 1. Set different fields to different constant
+!                             values.  This is only a test.  If the correct
+!                             domain is not found (based upon the "id")
+!                             then a fatal error is issued.               
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize
+
+   USE module_domain
+   USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_timing
+   USE module_configure
+   USE module_init_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+! NOTE:  Modified to remove all but arrays of rank 4 or more from the 
+!        argument list.  Arrays with rank>3 are still problematic due to the 
+!        above-noted fie- and pox-ities.  TBH 20061129.  
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER                :: dyn_opt 
+   INTEGER :: idum1, idum2
+
+   CALL nl_get_dyn_opt( 1, dyn_opt )
+   
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF (      dyn_opt .eq. 1 &
+        .or. dyn_opt .eq. 2 &
+        .or. dyn_opt .eq. 3 &
+                                       ) THEN
+     CALL init_domain_rk( grid &
+!
+#include <em_actual_new_args.inc>
+!
+                        )
+
+   ELSE
+     WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     CALL wrf_error_fatal ( ' init_domain: unknown or unimplemented dyn_opt ' )
+   ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+# include <em_dummy_new_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <em_dummy_new_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+   ! Local data
+
+   INTEGER, PARAMETER :: nl_max = 1000
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in
+   INTEGER :: nl_in
+
+
+   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
+   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
+   REAL    :: z_scale, xrad, yrad, zrad, rad, delt, cof1, cof2
+!   REAL, EXTERNAL :: interp_0
+   REAL    :: hm
+   REAL    :: pi
+
+!  stuff from original initialization that has been dropped from the Registry 
+   REAL    :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt
+   REAL    :: qvf1, qvf2, pd_surf
+   INTEGER :: it
+   real :: thtmp, ptmp, temp(3)
+
+   LOGICAL :: moisture_init
+   LOGICAL :: stretch_grid, dry_sounding
+
+   
+#ifdef DM_PARALLEL
+#    include <em_data_calls.inc>
+#endif
+
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+
+   stretch_grid = .true.
+   delt = 3.
+!   z_scale = .50
+   z_scale = .40
+   pi = 2.*asin(1.0)
+   write(6,*) ' pi is ',pi
+   nxc = (ide-ids)/2
+   nyc = jde/2
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+   moisture_init = .true.
+
+    grid%itimestep=0
+
+#ifdef DM_PARALLEL
+   CALL wrf_dm_bcast_bytes( icm , IWORDSIZE )
+   CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE )
+#endif
+
+    CALL nl_set_mminlu(1, '    ')
+    CALL nl_set_iswater(1,0)
+    CALL nl_set_cen_lat(1,40.)
+    CALL nl_set_cen_lon(1,-105.)
+    CALL nl_set_truelat1(1,0.)
+    CALL nl_set_truelat2(1,0.)
+    CALL nl_set_moad_cen_lat (1,0.)
+    CALL nl_set_stand_lon (1,0.)
+    CALL nl_set_map_proj(1,0)
+
+
+!  here we initialize data we currently is not initialized 
+!  in the input data
+
+    DO j = jts, jte
+      DO i = its, ite
+         grid%msft(i,j)     = 1.
+         grid%msfu(i,j)     = 1.
+         grid%msfv(i,j)     = 1.
+         grid%sina(i,j)     = 0.
+         grid%cosa(i,j)     = 1.
+         grid%e(i,j)        = 0.
+         grid%f(i,j)        = 0.
+
+      END DO
+   END DO
+
+    DO j = jts, jte
+    DO k = kts, kte
+      DO i = its, ite
+         grid%em_ww(i,k,j)     = 0.
+      END DO
+   END DO
+   END DO
+
+   grid%step_number = 0
+
+! set up the grid
+
+   IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz)
+     DO k=1, kde
+      grid%em_znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+                                (1.-exp(-1./z_scale))
+     ENDDO
+   ELSE
+     DO k=1, kde
+      grid%em_znw(k) = 1. - float(k-1)/float(kde-1)
+     ENDDO
+   ENDIF
+
+   DO k=1, kde-1
+    grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+    grid%em_rdnw(k) = 1./grid%em_dnw(k)
+    grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+   ENDDO
+   DO k=2, kde-1
+    grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+    grid%em_rdn(k) = 1./grid%em_dn(k)
+    grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+    grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+   ENDDO
+
+   cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+   cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+   grid%cf1  = grid%em_fnp(2) + cof1
+   grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+   grid%cf3  = cof2       
+
+   grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+   grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+   grid%rdx = 1./config_flags%dx
+   grid%rdy = 1./config_flags%dy
+
+!  get the sounding from the ascii sounding file, first get dry sounding and 
+!  calculate base state
+
+  write(6,*) ' getting dry sounding for base state '
+  dry_sounding = .true.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+
+  write(6,*) ' returned from reading sounding, nl_in is ',nl_in
+
+!  find ptop for the desired ztop (ztop is input from the namelist),
+!  and find surface pressure
+
+  grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in )
+
+  DO j=jts,jte
+  DO i=its,ite  ! flat surface
+    grid%em_phb(i,1,j) = 0.
+    grid%em_php(i,1,j) = 0.
+    grid%em_ph0(i,1,j) = 0.
+    grid%ht(i,j) = 0.
+  ENDDO
+  ENDDO
+
+  DO J = jts, jte
+  DO I = its, ite
+
+    p_surf = interp_0( p_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+    grid%em_mub(i,j) = p_surf-grid%p_top
+
+!  this is dry hydrostatic sounding (base state), so given grid%em_p (coordinate),
+!  interp theta (from interp) and compute 1/rho from eqn. of state
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_pb(i,k,j) = p_level
+      grid%em_t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
+      grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+    ENDDO
+
+!  calc hydrostatic balance (alternatively we could interp the geopotential from the
+!  sounding, but this assures that the base state is in exact hydrostatic balance with
+!  respect to the model eqns.
+
+    DO k  = 2,kte
+      grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+  write(6,*) ' ptop is ',grid%p_top
+  write(6,*) ' base state grid%em_mub(1,1), p_surf is ',grid%em_mub(1,1),grid%em_mub(1,1)+grid%p_top
+
+!  calculate full state for each column - this includes moisture.
+
+  write(6,*) ' getting moist sounding for full state '
+  dry_sounding = .false.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+
+!  At this point grid%p_top is already set. find the DRY mass in the column 
+!  by interpolating the DRY pressure.  
+
+   pd_surf = interp_0( pd_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+
+!  compute the perturbation mass and the full mass
+
+    grid%em_mu_1(i,j) = pd_surf-grid%p_top - grid%em_mub(i,j)
+    grid%em_mu_2(i,j) = grid%em_mu_1(i,j)
+    grid%em_mu0(i,j) = grid%em_mu_1(i,j) + grid%em_mub(i,j)
+
+! given the dry pressure and coordinate system, interp the potential
+! temperature and qv
+
+    do k=1,kde-1
+
+      p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+
+      moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%em_t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
+      grid%em_t_2(i,k,j)          = grid%em_t_1(i,k,j)
+      
+
+    enddo
+
+!  integrate the hydrostatic equation (from the RHS of the bigstep
+!  vertical momentum equation) down from the top to get grid%em_p.
+!  first from the top of the model to the top pressure
+
+    k = kte-1  ! top level
+
+    qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+    qvf2 = 1./(1.+qvf1)
+    qvf1 = qvf1*qvf2
+
+!    grid%em_p(i,k,j) = - 0.5*grid%em_mu_1(i,j)/grid%em_rdnw(k)
+    grid%em_p(i,k,j) = - 0.5*(grid%em_mu_1(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+    qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+    grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+    grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+
+!  down the column
+
+    do k=kte-2,1,-1
+      qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+      qvf2 = 1./(1.+qvf1)
+      qvf1 = qvf1*qvf2
+      grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_1(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+      qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+      grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                  (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+      grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+    enddo
+
+!  this is the hydrostatic equation used in the model after the
+!  small timesteps.  In the model, grid%em_al (inverse density)
+!  is computed from the geopotential.
+
+
+    grid%em_ph_1(i,1,j) = 0.
+    DO k  = 2,kte
+      grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                   (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                    grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+      grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+      grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+    ENDDO
+
+    if((i==2) .and. (j==2)) then
+     write(6,*) ' grid%em_ph_1 calc ',grid%em_ph_1(2,1,2),grid%em_ph_1(2,2,2),&
+                              grid%em_mu_1(2,2)+grid%em_mub(2,2),grid%em_mu_1(2,2), &
+                              grid%em_alb(2,1,2),grid%em_al(1,2,1),grid%em_rdnw(1)
+    endif
+
+  ENDDO
+  ENDDO
+
+!#if 0
+
+!  thermal perturbation to kick off convection
+
+  write(6,*) ' nxc, nyc for perturbation ',nxc,nyc
+  write(6,*) ' delt for perturbation ',delt
+
+  DO J = jts, min(jde-1,jte)
+!    yrad = config_flags%dy*float(j-nyc)/4000.
+     yrad = 0.
+    DO I = its, min(ide-1,ite)
+      xrad = config_flags%dx*float(i-nxc)/4000.
+!     xrad = 0.
+      DO K = 1, kte-1
+
+!  put in preturbation theta (bubble) and recalc density.  note,
+!  the mass in the column is not changing, so when theta changes,
+!  we recompute density and geopotential
+
+        zrad = 0.5*(grid%em_ph_1(i,k,j)+grid%em_ph_1(i,k+1,j)  &
+                   +grid%em_phb(i,k,j)+grid%em_phb(i,k+1,j))/g
+        zrad = (zrad-1500.)/1500.
+        RAD=SQRT(xrad*xrad+yrad*yrad+zrad*zrad)
+        IF(RAD <= 1.) THEN
+           grid%em_t_1(i,k,j)=grid%em_t_1(i,k,j)+delt*COS(.5*PI*RAD)**2
+           grid%em_t_2(i,k,j)=grid%em_t_1(i,k,j)
+           qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+           grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                        (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+           grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+        ENDIF
+      ENDDO
+
+!  rebalance hydrostatically
+
+      DO k  = 2,kte
+        grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                     (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                      grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+        grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+        grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+      ENDDO
+
+    ENDDO
+  ENDDO
+
+!#endif
+
+   write(6,*) ' grid%em_mu_1 from comp ', grid%em_mu_1(1,1)
+   write(6,*) ' full state sounding from comp, ph, grid%em_p, grid%em_al, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1)+grid%em_phb(1,k,1), &
+                                      grid%em_p(1,k,1)+grid%em_pb(1,k,1), grid%em_alt(1,k,1), &
+                                      grid%em_t_1(1,k,1)+t0, moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' pert state sounding from comp, grid%em_ph_1, pp, alp, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1), &
+                                      grid%em_p(1,k,1), grid%em_al(1,k,1), &
+                                      grid%em_t_1(1,k,1), moist(1,k,1,P_QV)
+   enddo
+
+! interp v
+
+  DO J = jts, jte
+  DO I = its, min(ide-1,ite)
+
+    IF (j == jds) THEN
+      z_at_v = grid%em_phb(i,1,j)/g
+    ELSE IF (j == jde) THEN
+      z_at_v = grid%em_phb(i,1,j-1)/g
+    ELSE
+      z_at_v = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i,1,j-1))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_v, nl_in )
+
+    DO K = 1, kte
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in )
+      grid%em_v_2(i,k,j) = grid%em_v_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+! interp u
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, ite
+
+    IF (i == ids) THEN
+      z_at_u = grid%em_phb(i,1,j)/g
+    ELSE IF (i == ide) THEN
+      z_at_u = grid%em_phb(i-1,1,j)/g
+    ELSE
+      z_at_u = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i-1,1,j))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_u, nl_in )
+
+    DO K = 1, kte
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
+      grid%em_u_2(i,k,j) = grid%em_u_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  set w
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte
+  DO I = its, min(ide-1,ite)
+    grid%em_w_1(i,k,j) = 0.
+    grid%em_w_2(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+!  set a few more things
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%h_diabatic(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+  DO k=1,kte-1
+    grid%em_t_base(k) = grid%em_t_1(1,k,1)
+    grid%qv_base(k) = moist(1,k,1,P_QV)
+    grid%u_base(k) = grid%em_u_1(1,k,1)
+    grid%v_base(k) = grid%em_v_1(1,k,1)
+    grid%z_base(k) = 0.5*(grid%em_phb(1,k,1)+grid%em_phb(1,k+1,1)+grid%em_ph_1(1,k,1)+grid%em_ph_1(1,k+1,1))/g
+  ENDDO
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+     thtmp   = grid%em_t_2(i,1,j)+t0
+     ptmp    = grid%em_p(i,1,j)+grid%em_pb(i,1,j)
+     temp(1) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,2,j)+t0
+     ptmp    = grid%em_p(i,2,j)+grid%em_pb(i,2,j)
+     temp(2) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,3,j)+t0
+     ptmp    = grid%em_p(i,3,j)+grid%em_pb(i,3,j)
+     temp(3) = thtmp * (ptmp/p1000mb)**rcp
+
+     grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)
+     grid%tmn(I,J)=grid%tsk(I,J)-0.5
+  ENDDO
+  ENDDO
+
+  RETURN
+
+ END SUBROUTINE init_domain_rk
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+
+!  test driver for get_sounding
+!
+!      implicit none
+!      integer n
+!      parameter(n = 1000)
+!      real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n)
+!      logical dry
+!      integer nl,k
+!
+!      dry = .false.
+!      dry = .true.
+!      call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl )
+!      write(6,*) ' input levels ',nl
+!      write(6,*) ' sounding '
+!      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+!      do k=1,nl
+!        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k)
+!      enddo
+!      end
+!
+!---------------------------------------------------------------------------
+
+      subroutine get_sounding( zk, p, p_dry, theta, rho, &
+                               u, v, qv, dry, nl_max, nl_in )
+      implicit none
+
+      integer nl_max, nl_in
+      real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), &
+           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
+      logical dry
+
+      integer n
+      parameter(n=1000)
+      logical debug
+      parameter( debug = .true.)
+
+! input sounding data
+
+      real p_surf, th_surf, qv_surf
+      real pi_surf, pi(n)
+      real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n)
+
+! diagnostics
+
+      real rho_surf, p_input(n), rho_input(n)
+      real pm_input(n)  !  this are for full moist sounding
+
+! local data
+
+      real p1000mb,cv,cp,r,cvpm,g
+      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+      integer k, it, nl
+      real qvf, qvf1, dz
+
+!  first, read the sounding
+
+      call read_sounding( p_surf, th_surf, qv_surf, &
+                          h_input, th_input, qv_input, u_input, v_input,n, nl, debug )
+
+      if(dry) then
+       do k=1,nl
+         qv_input(k) = 0.
+       enddo
+      endif
+
+      if(debug) write(6,*) ' number of input levels = ',nl
+
+        nl_in = nl
+        if(nl_in .gt. nl_max ) then
+          write(6,*) ' too many levels for input arrays ',nl_in,nl_max
+          call wrf_error_fatal ( ' too many levels for input arrays ' )
+        end if
+
+!  compute diagnostics,
+!  first, convert qv(g/kg) to qv(g/g)
+
+      do k=1,nl
+        qv_input(k) = 0.001*qv_input(k)
+      enddo
+
+      p_surf = 100.*p_surf  ! convert to pascals
+      qvf = 1. + rvovrd*qv_input(1) 
+      rho_surf = 1./((r/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
+      pi_surf = (p_surf/p1000mb)**(r/cp)
+
+      if(debug) then
+        write(6,*) ' surface density is ',rho_surf
+        write(6,*) ' surface pi is      ',pi_surf
+      end if
+
+
+!  integrate moist sounding hydrostatically, starting from the
+!  specified surface pressure
+!  -> first, integrate from surface to lowest level
+
+          qvf = 1. + rvovrd*qv_input(1) 
+          qvf1 = 1. + qv_input(1)
+          rho_input(1) = rho_surf
+          dz = h_input(1)
+          do it=1,10
+            pm_input(1) = p_surf &
+                    - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1
+            rho_input(1) = 1./((r/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm))
+          enddo
+
+! integrate up the column
+
+          do k=2,nl
+            rho_input(k) = rho_input(k-1)
+            dz = h_input(k)-h_input(k-1)
+            qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k)))
+            qvf = 1. + rvovrd*qv_input(k)   ! qv is in g/kg here
+ 
+            do it=1,10
+              pm_input(k) = pm_input(k-1) &
+                      - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
+              rho_input(k) = 1./((r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
+            enddo
+          enddo
+
+!  we have the moist sounding
+
+!  next, compute the dry sounding using p at the highest level from the
+!  moist sounding and integrating down.
+
+        p_input(nl) = pm_input(nl)
+
+          do k=nl-1,1,-1
+            dz = h_input(k+1)-h_input(k)
+            p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g
+          enddo
+
+
+        do k=1,nl
+
+          zk(k) = h_input(k)
+          p(k) = pm_input(k)
+          p_dry(k) = p_input(k)
+          theta(k) = th_input(k)
+          rho(k) = rho_input(k)
+          u(k) = u_input(k)
+          v(k) = v_input(k)
+          qv(k) = qv_input(k)
+
+        enddo
+
+     if(debug) then
+      write(6,*) ' sounding '
+      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+      do k=1,nl
+        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k)
+      enddo
+
+     end if
+
+      end subroutine get_sounding
+
+!-------------------------------------------------------
+
+      subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,n,nl,debug )
+      implicit none
+      integer n,nl
+      real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n)
+      logical end_of_file
+      logical debug
+
+      integer k
+
+      open(unit=10,file='input_sounding',form='formatted',status='old')
+      rewind(10)
+      read(10,*) ps, ts, qvs
+      if(debug) then
+        write(6,*) ' input sounding surface parameters '
+        write(6,*) ' surface pressure (mb) ',ps
+        write(6,*) ' surface pot. temp (K) ',ts
+        write(6,*) ' surface mixing ratio (g/kg) ',qvs
+      end if
+
+      end_of_file = .false.
+      k = 0
+
+      do while (.not. end_of_file)
+
+        read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1)
+        k = k+1
+        if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k)
+        go to 110
+ 100    end_of_file = .true.
+ 110    continue
+      enddo
+
+      nl = k
+
+      close(unit=10,status = 'keep')
+
+      end subroutine read_sounding
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_squall2d_y.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_squall2d_y.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_initialize_squall2d_y.F	(revision 2744)
@@ -0,0 +1,769 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!  This MODULE CONTAINS the following routines:
+
+!  initialize_field_test - 1. Set different fields to different constant
+!                             values.  This is only a test.  If the correct
+!                             domain is not found (based upon the "id")
+!                             then a fatal error is issued.               
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize
+
+   USE module_domain
+   USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_timing
+   USE module_configure
+   USE module_init_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER                :: dyn_opt 
+   INTEGER :: idum1, idum2
+
+   CALL nl_get_dyn_opt( 1, dyn_opt )
+   
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF (      dyn_opt .eq. 1 &
+        .or. dyn_opt .eq. 2 &
+        .or. dyn_opt .eq. 3 &
+                                       ) THEN
+     CALL init_domain_rk( grid &
+!
+#include <em_actual_new_args.inc>
+!
+                        )
+
+   ELSE
+     WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     CALL wrf_error_fatal ( ' init_domain: unknown or unimplemented dyn_opt ' )
+   ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+# include <em_dummy_new_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <em_dummy_new_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+   ! Local data
+
+   INTEGER, PARAMETER :: nl_max = 1000
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in
+   INTEGER :: nl_in
+
+
+   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
+   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
+   REAL    :: z_scale, xrad, yrad, zrad, rad, delt, cof1, cof2
+!   REAL, EXTERNAL :: interp_0
+   REAL    :: hm
+   REAL    :: pi
+
+!  stuff from original initialization that has been dropped from the Registry 
+   REAL    :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt
+   REAL    :: qvf1, qvf2, pd_surf
+   INTEGER :: it
+   real :: thtmp, ptmp, temp(3)
+
+   LOGICAL :: moisture_init
+   LOGICAL :: stretch_grid, dry_sounding
+
+   
+#ifdef DM_PARALLEL
+#    include <em_data_calls.inc>
+#endif
+
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+
+   stretch_grid = .true.
+   delt = 3.
+!   z_scale = .50
+   z_scale = .40
+   pi = 2.*asin(1.0)
+   write(6,*) ' pi is ',pi
+   nxc = (ide-ids)/2
+   nyc = (jde-jds)/2
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+   moisture_init = .true.
+
+    grid%itimestep=0
+
+#ifdef DM_PARALLEL
+   CALL wrf_dm_bcast_bytes( icm , IWORDSIZE )
+   CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE )
+#endif
+
+    CALL nl_set_mminlu(1, '    ')
+    CALL nl_set_iswater(1,0)
+    CALL nl_set_cen_lat(1,40.)
+    CALL nl_set_cen_lon(1,-105.)
+    CALL nl_set_truelat1(1,0.)
+    CALL nl_set_truelat2(1,0.)
+    CALL nl_set_moad_cen_lat (1,0.)
+    CALL nl_set_stand_lon (1,0.)
+    CALL nl_set_map_proj(1,0)
+
+
+!  here we initialize data we currently is not initialized 
+!  in the input data
+
+    DO j = jts, jte
+      DO i = its, ite
+         grid%msft(i,j)     = 1.
+         grid%msfu(i,j)     = 1.
+         grid%msfv(i,j)     = 1.
+         grid%sina(i,j)     = 0.
+         grid%cosa(i,j)     = 1.
+         grid%e(i,j)        = 0.
+         grid%f(i,j)        = 0.
+
+      END DO
+   END DO
+
+    DO j = jts, jte
+    DO k = kts, kte
+      DO i = its, ite
+         grid%em_ww(i,k,j)     = 0.
+      END DO
+   END DO
+   END DO
+
+   grid%step_number = 0
+
+! set up the grid
+
+   IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz)
+     DO k=1, kde
+      grid%em_znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+                                (1.-exp(-1./z_scale))
+     ENDDO
+   ELSE
+     DO k=1, kde
+      grid%em_znw(k) = 1. - float(k-1)/float(kde-1)
+     ENDDO
+   ENDIF
+
+   DO k=1, kde-1
+    grid%em_dnw(k) = grid%em_znw(k+1) - grid%em_znw(k)
+    grid%em_rdnw(k) = 1./grid%em_dnw(k)
+    grid%em_znu(k) = 0.5*(grid%em_znw(k+1)+grid%em_znw(k))
+   ENDDO
+   DO k=2, kde-1
+    grid%em_dn(k) = 0.5*(grid%em_dnw(k)+grid%em_dnw(k-1))
+    grid%em_rdn(k) = 1./grid%em_dn(k)
+    grid%em_fnp(k) = .5* grid%em_dnw(k  )/grid%em_dn(k)
+    grid%em_fnm(k) = .5* grid%em_dnw(k-1)/grid%em_dn(k)
+   ENDDO
+
+   cof1 = (2.*grid%em_dn(2)+grid%em_dn(3))/(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(2) 
+   cof2 =     grid%em_dn(2)        /(grid%em_dn(2)+grid%em_dn(3))*grid%em_dnw(1)/grid%em_dn(3) 
+   grid%cf1  = grid%em_fnp(2) + cof1
+   grid%cf2  = grid%em_fnm(2) - cof1 - cof2
+   grid%cf3  = cof2       
+
+   grid%cfn  = (.5*grid%em_dnw(kde-1)+grid%em_dn(kde-1))/grid%em_dn(kde-1)
+   grid%cfn1 = -.5*grid%em_dnw(kde-1)/grid%em_dn(kde-1)
+   grid%rdx = 1./config_flags%dx
+   grid%rdy = 1./config_flags%dy
+
+!  get the sounding from the ascii sounding file, first get dry sounding and 
+!  calculate base state
+
+  write(6,*) ' getting dry sounding for base state '
+  dry_sounding = .true.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+
+  write(6,*) ' returned from reading sounding, nl_in is ',nl_in
+
+!  find ptop for the desired ztop (ztop is input from the namelist),
+!  and find surface pressure
+
+  grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in )
+
+  DO j=jts,jte
+  DO i=its,ite  ! flat surface
+    grid%em_phb(i,1,j) = 0.
+    grid%em_php(i,1,j) = 0.
+    grid%em_ph0(i,1,j) = 0.
+    grid%ht(i,j) = 0.
+  ENDDO
+  ENDDO
+
+  DO J = jts, jte
+  DO I = its, ite
+
+    p_surf = interp_0( p_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+    grid%em_mub(i,j) = p_surf-grid%p_top
+
+!  this is dry hydrostatic sounding (base state), so given grid%em_p (coordinate),
+!  interp theta (from interp) and compute 1/rho from eqn. of state
+
+    DO K = 1, kte-1
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_pb(i,k,j) = p_level
+      grid%em_t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
+      grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+    ENDDO
+
+!  calc hydrostatic balance (alternatively we could interp the geopotential from the
+!  sounding, but this assures that the base state is in exact hydrostatic balance with
+!  respect to the model eqns.
+
+    DO k  = 2,kte
+      grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+  write(6,*) ' ptop is ',grid%p_top
+  write(6,*) ' base state grid%em_mub(1,1), p_surf is ',grid%em_mub(1,1),grid%em_mub(1,1)+grid%p_top
+
+!  calculate full state for each column - this includes moisture.
+
+  write(6,*) ' getting moist sounding for full state '
+  dry_sounding = .false.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+
+!  At this point grid%p_top is already set. find the DRY mass in the column 
+!  by interpolating the DRY pressure.  
+
+   pd_surf = interp_0( pd_in, zk, grid%em_phb(i,1,j)/g, nl_in )
+
+!  compute the perturbation mass and the full mass
+
+    grid%em_mu_1(i,j) = pd_surf-grid%p_top - grid%em_mub(i,j)
+    grid%em_mu_2(i,j) = grid%em_mu_1(i,j)
+    grid%em_mu0(i,j) = grid%em_mu_1(i,j) + grid%em_mub(i,j)
+
+! given the dry pressure and coordinate system, interp the potential
+! temperature and qv
+
+    do k=1,kde-1
+
+      p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
+
+      moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%em_t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
+      grid%em_t_2(i,k,j)          = grid%em_t_1(i,k,j)
+      
+
+    enddo
+
+!  integrate the hydrostatic equation (from the RHS of the bigstep
+!  vertical momentum equation) down from the top to get grid%em_p.
+!  first from the top of the model to the top pressure
+
+    k = kte-1  ! top level
+
+    qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+    qvf2 = 1./(1.+qvf1)
+    qvf1 = qvf1*qvf2
+
+!    grid%em_p(i,k,j) = - 0.5*grid%em_mu_1(i,j)/grid%em_rdnw(k)
+    grid%em_p(i,k,j) = - 0.5*(grid%em_mu_1(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+    qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+    grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+    grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+
+!  down the column
+
+    do k=kte-2,1,-1
+      qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+      qvf2 = 1./(1.+qvf1)
+      qvf1 = qvf1*qvf2
+      grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_1(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+      qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+      grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                  (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+      grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+    enddo
+
+!  this is the hydrostatic equation used in the model after the
+!  small timesteps.  In the model, grid%em_al (inverse density)
+!  is computed from the geopotential.
+
+
+    grid%em_ph_1(i,1,j) = 0.
+    DO k  = 2,kte
+      grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                   (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                    grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+      grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+      grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+    ENDDO
+
+    if((i==2) .and. (j==2)) then
+     write(6,*) ' grid%em_ph_1 calc ',grid%em_ph_1(2,1,2),grid%em_ph_1(2,2,2),&
+                              grid%em_mu_1(2,2)+grid%em_mub(2,2),grid%em_mu_1(2,2), &
+                              grid%em_alb(2,1,2),grid%em_al(1,2,1),grid%em_rdnw(1)
+    endif
+
+  ENDDO
+  ENDDO
+
+!#if 0
+
+!  thermal perturbation to kick off convection
+
+  write(6,*) ' nxc, nyc for perturbation ',nxc,nyc
+  write(6,*) ' delt for perturbation ',delt
+
+  DO J = jts, min(jde-1,jte)
+    yrad = config_flags%dy*float(j-nyc)/4000.
+!     yrad = 0.
+    DO I = its, min(ide-1,ite)
+!      xrad = config_flags%dx*float(i-nxc)/4000.
+     xrad = 0.
+      DO K = 1, kte-1
+
+!  put in preturbation theta (bubble) and recalc density.  note,
+!  the mass in the column is not changing, so when theta changes,
+!  we recompute density and geopotential
+
+        zrad = 0.5*(grid%em_ph_1(i,k,j)+grid%em_ph_1(i,k+1,j)  &
+                   +grid%em_phb(i,k,j)+grid%em_phb(i,k+1,j))/g
+        zrad = (zrad-1500.)/1500.
+        RAD=SQRT(xrad*xrad+yrad*yrad+zrad*zrad)
+        IF(RAD <= 1.) THEN
+           grid%em_t_1(i,k,j)=grid%em_t_1(i,k,j)+delt*COS(.5*PI*RAD)**2
+           grid%em_t_2(i,k,j)=grid%em_t_1(i,k,j)
+           qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+           grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                        (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+           grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+        ENDIF
+      ENDDO
+
+!  rebalance hydrostatically
+
+      DO k  = 2,kte
+        grid%em_ph_1(i,k,j) = grid%em_ph_1(i,k-1,j) - (1./grid%em_rdnw(k-1))*(       &
+                     (grid%em_mub(i,j)+grid%em_mu_1(i,j))*grid%em_al(i,k-1,j)+ &
+                      grid%em_mu_1(i,j)*grid%em_alb(i,k-1,j)  )
+                                                   
+        grid%em_ph_2(i,k,j) = grid%em_ph_1(i,k,j) 
+        grid%em_ph0(i,k,j) = grid%em_ph_1(i,k,j) + grid%em_phb(i,k,j)
+      ENDDO
+
+    ENDDO
+  ENDDO
+
+!#endif
+
+   write(6,*) ' grid%em_mu_1 from comp ', grid%em_mu_1(1,1)
+   write(6,*) ' full state sounding from comp, ph, grid%em_p, grid%em_al, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1)+grid%em_phb(1,k,1), &
+                                      grid%em_p(1,k,1)+grid%em_pb(1,k,1), grid%em_alt(1,k,1), &
+                                      grid%em_t_1(1,k,1)+t0, moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' pert state sounding from comp, grid%em_ph_1, pp, alp, grid%em_t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%em_ph_1(1,k,1), &
+                                      grid%em_p(1,k,1), grid%em_al(1,k,1), &
+                                      grid%em_t_1(1,k,1), moist(1,k,1,P_QV)
+   enddo
+
+! interp v
+
+  DO J = jts, jte
+  DO I = its, min(ide-1,ite)
+
+    IF (j == jds) THEN
+      z_at_v = grid%em_phb(i,1,j)/g
+    ELSE IF (j == jde) THEN
+      z_at_v = grid%em_phb(i,1,j-1)/g
+    ELSE
+      z_at_v = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i,1,j-1))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_v, nl_in )
+
+    DO K = 1, kte
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in )
+      grid%em_v_2(i,k,j) = grid%em_v_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+! interp u
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, ite
+
+    IF (i == ids) THEN
+      z_at_u = grid%em_phb(i,1,j)/g
+    ELSE IF (i == ide) THEN
+      z_at_u = grid%em_phb(i-1,1,j)/g
+    ELSE
+      z_at_u = 0.5*(grid%em_phb(i,1,j)+grid%em_phb(i-1,1,j))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_u, nl_in )
+
+    DO K = 1, kte
+      p_level = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%em_u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
+      grid%em_u_2(i,k,j) = grid%em_u_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  set w
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte
+  DO I = its, min(ide-1,ite)
+    grid%em_w_1(i,k,j) = 0.
+    grid%em_w_2(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+!  set a few more things
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%h_diabatic(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+  DO k=1,kte-1
+    grid%em_t_base(k) = grid%em_t_1(1,k,1)
+    grid%qv_base(k) = moist(1,k,1,P_QV)
+    grid%u_base(k) = grid%em_u_1(1,k,1)
+    grid%v_base(k) = grid%em_v_1(1,k,1)
+    grid%z_base(k) = 0.5*(grid%em_phb(1,k,1)+grid%em_phb(1,k+1,1)+grid%em_ph_1(1,k,1)+grid%em_ph_1(1,k+1,1))/g
+  ENDDO
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+     thtmp   = grid%em_t_2(i,1,j)+t0
+     ptmp    = grid%em_p(i,1,j)+grid%em_pb(i,1,j)
+     temp(1) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,2,j)+t0
+     ptmp    = grid%em_p(i,2,j)+grid%em_pb(i,2,j)
+     temp(2) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%em_t_2(i,3,j)+t0
+     ptmp    = grid%em_p(i,3,j)+grid%em_pb(i,3,j)
+     temp(3) = thtmp * (ptmp/p1000mb)**rcp
+
+     grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)
+     grid%tmn(I,J)=grid%tsk(I,J)-0.5
+  ENDDO
+  ENDDO
+
+  RETURN
+
+ END SUBROUTINE init_domain_rk
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+
+!  test driver for get_sounding
+!
+!      implicit none
+!      integer n
+!      parameter(n = 1000)
+!      real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n)
+!      logical dry
+!      integer nl,k
+!
+!      dry = .false.
+!      dry = .true.
+!      call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl )
+!      write(6,*) ' input levels ',nl
+!      write(6,*) ' sounding '
+!      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+!      do k=1,nl
+!        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k)
+!      enddo
+!      end
+!
+!---------------------------------------------------------------------------
+
+      subroutine get_sounding( zk, p, p_dry, theta, rho, &
+                               u, v, qv, dry, nl_max, nl_in )
+      implicit none
+
+      integer nl_max, nl_in
+      real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), &
+           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
+      logical dry
+
+      integer n
+      parameter(n=1000)
+      logical debug
+      parameter( debug = .true.)
+
+! input sounding data
+
+      real p_surf, th_surf, qv_surf
+      real pi_surf, pi(n)
+      real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n)
+
+! diagnostics
+
+      real rho_surf, p_input(n), rho_input(n)
+      real pm_input(n)  !  this are for full moist sounding
+
+! local data
+
+      real p1000mb,cv,cp,r,cvpm,g
+      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+      integer k, it, nl
+      real qvf, qvf1, dz
+
+!  first, read the sounding
+
+      call read_sounding( p_surf, th_surf, qv_surf, &
+                          h_input, th_input, qv_input, u_input, v_input,n, nl, debug )
+
+      if(dry) then
+       do k=1,nl
+         qv_input(k) = 0.
+       enddo
+      endif
+
+      if(debug) write(6,*) ' number of input levels = ',nl
+
+        nl_in = nl
+        if(nl_in .gt. nl_max ) then
+          write(6,*) ' too many levels for input arrays ',nl_in,nl_max
+          call wrf_error_fatal ( ' too many levels for input arrays ' )
+        end if
+
+!  compute diagnostics,
+!  first, convert qv(g/kg) to qv(g/g)
+
+      do k=1,nl
+        qv_input(k) = 0.001*qv_input(k)
+      enddo
+
+      p_surf = 100.*p_surf  ! convert to pascals
+      qvf = 1. + rvovrd*qv_input(1) 
+      rho_surf = 1./((r/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
+      pi_surf = (p_surf/p1000mb)**(r/cp)
+
+      if(debug) then
+        write(6,*) ' surface density is ',rho_surf
+        write(6,*) ' surface pi is      ',pi_surf
+      end if
+
+
+!  integrate moist sounding hydrostatically, starting from the
+!  specified surface pressure
+!  -> first, integrate from surface to lowest level
+
+          qvf = 1. + rvovrd*qv_input(1) 
+          qvf1 = 1. + qv_input(1)
+          rho_input(1) = rho_surf
+          dz = h_input(1)
+          do it=1,10
+            pm_input(1) = p_surf &
+                    - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1
+            rho_input(1) = 1./((r/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm))
+          enddo
+
+! integrate up the column
+
+          do k=2,nl
+            rho_input(k) = rho_input(k-1)
+            dz = h_input(k)-h_input(k-1)
+            qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k)))
+            qvf = 1. + rvovrd*qv_input(k)   ! qv is in g/kg here
+ 
+            do it=1,10
+              pm_input(k) = pm_input(k-1) &
+                      - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
+              rho_input(k) = 1./((r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
+            enddo
+          enddo
+
+!  we have the moist sounding
+
+!  next, compute the dry sounding using p at the highest level from the
+!  moist sounding and integrating down.
+
+        p_input(nl) = pm_input(nl)
+
+          do k=nl-1,1,-1
+            dz = h_input(k+1)-h_input(k)
+            p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g
+          enddo
+
+
+        do k=1,nl
+
+          zk(k) = h_input(k)
+          p(k) = pm_input(k)
+          p_dry(k) = p_input(k)
+          theta(k) = th_input(k)
+          rho(k) = rho_input(k)
+          u(k) = u_input(k)
+          v(k) = v_input(k)
+          qv(k) = qv_input(k)
+
+        enddo
+
+     if(debug) then
+      write(6,*) ' sounding '
+      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+      do k=1,nl
+        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k)
+      enddo
+
+     end if
+
+      end subroutine get_sounding
+
+!-------------------------------------------------------
+
+      subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,n,nl,debug )
+      implicit none
+      integer n,nl
+      real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n)
+      logical end_of_file
+      logical debug
+
+      integer k
+
+      open(unit=10,file='input_sounding',form='formatted',status='old')
+      rewind(10)
+      read(10,*) ps, ts, qvs
+      if(debug) then
+        write(6,*) ' input sounding surface parameters '
+        write(6,*) ' surface pressure (mb) ',ps
+        write(6,*) ' surface pot. temp (K) ',ts
+        write(6,*) ' surface mixing ratio (g/kg) ',qvs
+      end if
+
+      end_of_file = .false.
+      k = 0
+
+      do while (.not. end_of_file)
+
+        read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1)
+        k = k+1
+        if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k)
+        go to 110
+ 100    end_of_file = .true.
+ 110    continue
+      enddo
+
+      nl = k
+
+      close(unit=10,status = 'keep')
+
+      end subroutine read_sounding
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_small_step_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_small_step_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_small_step_em.F	(revision 2744)
@@ -0,0 +1,1639 @@
+!WRF:MODEL_LAYER:DYNAMICS
+!
+
+!  SMALL_STEP code for the geometric height coordinate model
+!
+!---------------------------------------------------------------------------
+
+MODULE module_small_step_em
+
+   USE module_configure
+   USE module_model_constants
+
+CONTAINS
+
+!----------------------------------------------------------------------
+
+SUBROUTINE small_step_prep( u_1, u_2, v_1, v_2, w_1, w_2, &
+                            t_1, t_2, ph_1, ph_2,         &
+                            mub, mu_1, mu_2,              &
+                            muu, muus, muv, muvs,         &
+                            mut, muts, mudf,              &
+                            u_save, v_save, w_save,       &
+                            t_save, ph_save, mu_save,     &
+                            ww, ww_save,                  &
+                            dnw, c2a, pb, p, alt,         &
+                            msfu, msfv, msft,             &
+                            rk_step,                      &
+                            ids,ide, jds,jde, kds,kde,    & 
+                            ims,ime, jms,jme, kms,kme,    &
+                            its,ite, jts,jte, kts,kte    )
+
+  IMPLICIT NONE  ! religion first
+
+! declarations for the stuff coming in
+
+  INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+  INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+  INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+  INTEGER,      INTENT(IN   )    :: rk_step
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(INOUT) :: u_1,   &
+                                                              v_1,   &
+                                                              w_1,   &
+                                                              t_1,   &
+                                                              ph_1
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(  OUT) :: u_save,   &
+                                                              v_save,   &
+                                                              w_save,   &
+                                                              t_save,   &
+                                                              ph_save
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(INOUT) :: u_2,   &
+                                                              v_2,   &
+                                                              w_2,   &
+                                                              t_2,   &
+                                                              ph_2
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(  OUT) :: c2a, &
+                                                               ww_save
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::  pb,  &
+                                                                p,   &
+                                                                alt, &
+                                                                ww
+
+! pjj/cray
+! REAL, DIMENSION(ims:ime, jms:jme)         , INTENT(INOUT) :: mu_1
+  REAL, DIMENSION(ims:ime, jms:jme)         , INTENT(INOUT) :: mu_1,mu_2
+
+  REAL, DIMENSION(ims:ime, jms:jme)         , INTENT(INout) :: mub,  &
+                                                               muu,  &
+                                                               muv,  &
+                                                               mut,  &
+                                                               msfu, &
+                                                               msfv, &
+                                                               msft
+
+  REAL, DIMENSION(ims:ime, jms:jme)         , INTENT(  OUT) :: muus, &
+                                                               muvs, &
+                                                               muts, &
+!pjj/cray
+!                                                              mu_2, &
+                                                               mudf
+
+  REAL, DIMENSION(ims:ime, jms:jme)         , INTENT(  OUT) :: mu_save
+
+  REAL, DIMENSION(kms:kme, jms:jme)         , INTENT(IN   ) :: dnw
+
+! local variables
+
+  INTEGER :: i, j, k
+  INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
+  INTEGER :: i_endu, j_endv
+
+
+!<DESCRIPTION>
+!
+!  small_step_prep prepares the prognostic variables for the small timestep.
+!  This includes switching time-levels in the arrays and computing coupled 
+!  perturbation variables for the small timestep 
+!  (i.e. mu*u" = mu(t)*u(t)-mu(*)*u(*); mu*u" is advanced during the small 
+!  timesteps
+!
+!</DESCRIPTION>
+
+    i_start = its
+    i_end   = ite
+    j_start = jts
+    j_end   = jte
+    k_start = kts
+    k_end = min(kte,kde-1)
+
+    i_endu = i_end
+    j_endv = j_end
+
+    IF(i_end == ide) i_end = i_end - 1
+    IF(j_end == jde) j_end = j_end - 1
+
+    !  if this is the first RK step, reset *_1 to *_2
+    !  (we are replacing the t-dt fields with the time t fields)
+
+    IF ((rk_step == 1) ) THEN
+
+! 1 jun 2001 -> added boundary copy to 2D boundary condition routines,
+!  should be OK now without the following data copy
+!#if 0
+!     DO j=j_start, j_end
+!       mu_2(0,j)=mu_2(1,j)
+!       mu_2(i_endu,j)=mu_2(i_end,j)
+!       mu_1(0,j)=mu_2(1,j)
+!       mu_1(i_endu,j)=mu_2(i_end,j)
+!       mub(0,j)=mub(1,j)
+!       mub(i_endu,j)=mub(i_end,j)
+!     ENDDO
+!     DO i=i_start, i_end
+!       mu_2(i,0)=mu_2(i,1)
+!       mu_2(i,j_endv)=mu_2(i,j_end)
+!       mu_1(i,0)=mu_2(i,1)
+!       mu_1(i,j_endv)=mu_2(i,j_end)
+!       mub(i,0)=mub(i,1)
+!       mub(i,j_endv)=mub(i,j_end)
+!     ENDDO
+!#endif
+
+      DO j=j_start, j_end
+      DO i=i_start, i_end
+        mu_1(i,j)=mu_2(i,j)
+        ww_save(i,kde,j) = 0.
+        ww_save(i,1,j) = 0.
+        mudf(i,j) = 0.  !  initialize external mode div damp to zero
+      ENDDO
+      ENDDO
+
+      DO j=j_start, j_end
+      DO k=k_start, k_end
+      DO i=i_start, i_endu
+        u_1(i,k,j) = u_2(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      DO j=j_start, j_endv
+      DO k=k_start, k_end
+      DO i=i_start, i_end
+        v_1(i,k,j) = v_2(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      DO j=j_start, j_end
+      DO k=k_start, k_end
+      DO i=i_start, i_end
+        t_1(i,k,j) = t_2(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      DO j=j_start, j_end
+      DO k=k_start, min(kde,kte)
+      DO i=i_start, i_end
+        w_1(i,k,j)  = w_2(i,k,j)
+        ph_1(i,k,j) = ph_2(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+    DO j=j_start, j_end
+      DO i=i_start, i_end
+        muts(i,j)=mub(i,j)+mu_2(i,j)
+      ENDDO
+      DO i=i_start, i_endu
+!  rk_step==1, WCS fix for tiling
+!        muus(i,j)=0.5*(mub(i,j)+mu_2(i,j)+mub(i-1,j)+mu_2(i-1,j))
+        muus(i,j) = muu(i,j)
+      ENDDO
+    ENDDO
+
+    DO j=j_start, j_endv
+    DO i=i_start, i_end
+!  rk_step==1, WCS fix for tiling
+!      muvs(i,j)=0.5*(mub(i,j)+mu_2(i,j)+mub(i,j-1)+mu_2(i,j-1))
+        muvs(i,j) = muv(i,j)
+    ENDDO
+    ENDDO
+
+    DO j=j_start, j_end
+      DO i=i_start, i_end
+        mu_save(i,j)=mu_2(i,j)
+        mu_2(i,j)=mu_2(i,j)-mu_2(i,j)
+      ENDDO
+    ENDDO
+
+    ELSE
+
+    DO j=j_start, j_end
+      DO i=i_start, i_end
+        muts(i,j)=mub(i,j)+mu_1(i,j)
+      ENDDO
+      DO i=i_start, i_endu
+        muus(i,j)=0.5*(mub(i,j)+mu_1(i,j)+mub(i-1,j)+mu_1(i-1,j))
+      ENDDO
+    ENDDO
+
+    DO j=j_start, j_endv
+    DO i=i_start, i_end
+      muvs(i,j)=0.5*(mub(i,j)+mu_1(i,j)+mub(i,j-1)+mu_1(i,j-1))
+    ENDDO
+    ENDDO
+
+    DO j=j_start, j_end
+      DO i=i_start, i_end
+        mu_save(i,j)=mu_2(i,j)
+        mu_2(i,j)=mu_1(i,j)-mu_2(i,j)
+      ENDDO
+    ENDDO
+
+
+    END IF
+
+    ! set up the small timestep variables
+
+      DO j=j_start, j_end
+      DO i=i_start, i_end
+        ww_save(i,kde,j) = 0.
+        ww_save(i,1,j) = 0.
+      ENDDO
+      ENDDO
+
+    DO j=j_start, j_end
+    DO k=k_start, k_end
+    DO i=i_start, i_end
+      c2a(i,k,j) = cpovcv*(pb(i,k,j)+p(i,k,j))/alt(i,k,j)
+    ENDDO
+    ENDDO
+    ENDDO
+
+    DO j=j_start, j_end
+    DO k=k_start, k_end
+    DO i=i_start, i_endu
+      u_save(i,k,j) = u_2(i,k,j)
+      u_2(i,k,j) = (muus(i,j)*u_1(i,k,j)-muu(i,j)*u_2(i,k,j))/msfu(i,j)
+    ENDDO
+    ENDDO
+    ENDDO
+
+    DO j=j_start, j_endv
+    DO k=k_start, k_end
+    DO i=i_start, i_end
+      v_save(i,k,j) = v_2(i,k,j)
+      v_2(i,k,j) = (muvs(i,j)*v_1(i,k,j)-muv(i,j)*v_2(i,k,j))/msfv(i,j)
+    ENDDO
+    ENDDO
+    ENDDO
+
+    DO j=j_start, j_end
+    DO k=k_start, k_end
+    DO i=i_start, i_end
+      t_save(i,k,j) = t_2(i,k,j)
+      t_2(i,k,j) = muts(i,j)*t_1(i,k,j)-mut(i,j)*t_2(i,k,j)
+    ENDDO
+    ENDDO
+    ENDDO
+
+    DO j=j_start, j_end
+!    DO k=k_start, min(kde,kte)
+    DO k=k_start, kde
+    DO i=i_start, i_end
+      w_save(i,k,j) = w_2(i,k,j)
+      w_2(i,k,j)  = (muts(i,j)* w_1(i,k,j)-mut(i,j)* w_2(i,k,j))/msft(i,j)
+      ph_save(i,k,j) = ph_2(i,k,j)
+      ph_2(i,k,j) = ph_1(i,k,j)-ph_2(i,k,j)
+    ENDDO
+    ENDDO
+    ENDDO
+
+      DO j=j_start, j_end
+!      DO k=k_start, min(kde,kte)
+      DO k=k_start, kde
+      DO i=i_start, i_end
+        ww_save(i,k,j) = ww(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE small_step_prep
+
+!-------------------------------------------------------------------------
+
+
+SUBROUTINE small_step_finish( u_2, u_1, v_2, v_1, w_2, w_1,    &
+                              t_2, t_1, ph_2, ph_1, ww, ww1,   &
+                              mu_2, mu_1,                      &
+                              mut, muts, muu, muus, muv, muvs, &
+                              u_save, v_save, w_save,          &
+                              t_save, ph_save, mu_save,        &
+                              msfu, msfv, msft,                &
+                              h_diabatic,                      &
+                              number_of_small_timesteps,dts,   &
+                              rk_step, rk_order,               &
+                              ids,ide, jds,jde, kds,kde,       &
+                              ims,ime, jms,jme, kms,kme,       &
+                              its,ite, jts,jte, kts,kte       )
+
+
+  IMPLICIT NONE  ! religion first
+
+!  stuff passed in
+
+  INTEGER,                  INTENT(IN   ) :: ids,ide, jds,jde, kds,kde
+  INTEGER,                  INTENT(IN   ) :: ims,ime, jms,jme, kms,kme
+  INTEGER,                  INTENT(IN   ) :: its,ite, jts,jte, kts,kte
+  INTEGER,                  INTENT(IN   ) :: number_of_small_timesteps
+  INTEGER,                  INTENT(IN   ) :: rk_step, rk_order
+  REAL,                     INTENT(IN   ) :: dts
+
+  REAL,   DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN   ) :: u_1, &
+                                                                 v_1, &
+                                                                 w_1, &
+                                                                 t_1, &
+                                                                 ww1, &
+                                                                 ph_1
+
+  REAL,   DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: u_2, &
+                                                                 v_2, &
+                                                                 w_2, &
+                                                                 t_2, &
+                                                                 ww,  &
+                                                                 ph_2
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(IN   ) :: u_save,   &
+                                                              v_save,   &
+                                                              w_save,   &
+                                                              t_save,   &
+                                                              ph_save,  &
+                                                             h_diabatic
+
+  REAL,   DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: muus, muvs
+  REAL,   DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: mu_2, mu_1
+  REAL,   DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: mut, muts, &
+                                                        muu, muv, mu_save
+  REAL,   DIMENSION(ims:ime, jms:jme), INTENT(IN   ) :: msfu, msfv, msft
+
+
+! local stuff
+
+  INTEGER         :: i,j,k
+  INTEGER :: i_start, i_end, j_start, j_end, i_endu, j_endv
+
+!<DESCRIPTION>
+!
+!  small_step_finish reconstructs the full uncoupled prognostic variables
+!  from the coupled perturbation variables used in the small timesteps.
+!
+!</DESCRIPTION>
+
+  i_start = its
+  i_end   = ite
+  j_start = jts
+  j_end   = jte
+
+  i_endu = i_end
+  j_endv = j_end
+
+  IF(i_end == ide) i_end = i_end - 1
+  IF(j_end == jde) j_end = j_end - 1
+
+
+! 1 jun 2001 -> added boundary copy to 2D boundary condition routines,
+!  should be OK now without the following data copy
+
+!#if 0
+! DO j=j_start, j_end
+!   muts(0,j)=muts(1,j)
+!   muts(i_endu,j)=muts(i_end,j)
+! ENDDO
+! DO i=i_start, i_end
+!   muts(i,0)=muts(i,1)
+!   muts(i,j_endv)=muts(i,j_end)
+! ENDDO
+
+! DO j = j_start, j_endv
+! DO i = i_start, i_end
+!   muvs(i,j) = 0.5*(muts(i,j) + muts(i,j-1))
+! ENDDO
+! ENDDO
+
+! DO j = j_start, j_end
+! DO i = i_start, i_endu
+!   muus(i,j) = 0.5*(muts(i,j) + muts(i-1,j))
+! ENDDO
+! ENDDO
+!#endif
+
+!    addition of time level t back into variables
+
+  DO j = j_start, j_endv
+  DO k = kds, kde-1
+  DO i = i_start, i_end
+    v_2(i,k,j) = (msfv(i,j)*v_2(i,k,j) + v_save(i,k,j)*muv(i,j))/muvs(i,j)
+  ENDDO
+  ENDDO
+  ENDDO
+
+  DO j = j_start, j_end
+  DO k = kds, kde-1
+  DO i = i_start, i_endu
+    u_2(i,k,j) = (msfu(i,j)*u_2(i,k,j) + u_save(i,k,j)*muu(i,j))/muus(i,j)
+  ENDDO
+  ENDDO
+  ENDDO
+
+  DO j = j_start, j_end
+  DO k = kds, kde
+  DO i = i_start, i_end
+    w_2(i,k,j) = (msft(i,j)*w_2(i,k,j) + w_save(i,k,j)*mut(i,j))/muts(i,j)
+    ph_2(i,k,j) = ph_2(i,k,j) + ph_save(i,k,j)
+    ww(i,k,j) = ww(i,k,j) + ww1(i,k,j)
+  ENDDO
+  ENDDO
+  ENDDO
+
+#ifdef REVERT
+  DO j = j_start, j_end
+  DO k = kds, kde-1
+  DO i = i_start, i_end
+    t_2(i,k,j) = (t_2(i,k,j) + t_save(i,k,j)*mut(i,j))/muts(i,j)
+  ENDDO
+  ENDDO
+  ENDDO
+#else
+  IF ( rk_step < rk_order ) THEN
+    DO j = j_start, j_end
+    DO k = kds, kde-1
+    DO i = i_start, i_end
+      t_2(i,k,j) = (t_2(i,k,j) + t_save(i,k,j)*mut(i,j))/muts(i,j)
+    ENDDO
+    ENDDO
+    ENDDO
+  ELSE
+
+    DO j = j_start, j_end
+    DO k = kds, kde-1
+    DO i = i_start, i_end
+      t_2(i,k,j) = (t_2(i,k,j) - dts*number_of_small_timesteps*mut(i,j)*h_diabatic(i,k,j) &
+                    + t_save(i,k,j)*mut(i,j))/muts(i,j)
+    ENDDO
+    ENDDO
+    ENDDO
+  ENDIF
+#endif
+
+  DO j = j_start, j_end
+  DO i = i_start, i_end
+    mu_2(i,j) = mu_2(i,j) + mu_save(i,j)
+  ENDDO
+  ENDDO
+
+END SUBROUTINE small_step_finish
+
+!-----------------------------------------------------------------------
+
+SUBROUTINE calc_p_rho( al, p, ph,                    &
+                       alt, t_2, t_1, c2a, pm1,      &
+                       mu, muts, znu, t0,            &
+                       rdnw, dnw, smdiv,             &
+                       non_hydrostatic, step,        &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its,ite, jts,jte, kts,kte    )
+
+  IMPLICIT NONE  ! religion first
+
+! declarations for the stuff coming in
+
+  INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+  INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+  INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+  INTEGER,      INTENT(IN   )    :: step
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(  OUT) :: al,   &
+                                                               p
+! pjj/cray
+!                                                             p,    &
+!                                                             pm1
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(IN   ) :: alt,   &
+                                                              t_2,   &
+                                                              t_1,   &
+                                                              c2a
+
+! pjj/cray
+! REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(INOUT) :: ph
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(INOUT) :: ph, pm1
+
+  REAL, DIMENSION(ims:ime, jms:jme)         , INTENT(IN   ) :: mu,   &
+                                                               muts
+
+  REAL, DIMENSION(kms:kme)         , INTENT(IN   ) :: dnw,  &
+                                                      rdnw, &
+                                                      znu
+
+  REAL,                                       INTENT(IN   ) :: t0, smdiv
+
+  LOGICAL, INTENT(IN   )  :: non_hydrostatic
+
+! local variables
+
+  INTEGER :: i, j, k
+  INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
+  REAL    :: ptmp
+
+!<DESCRIPTION>
+!
+!  For the nonhydrostatic option,
+!  calc_p_rho computes the perturbation inverse density and 
+!  perturbation pressure from the hydrostatic relation and the 
+!  linearized equation of state, respectively.
+!
+!  For the hydrostatic option,
+!  calc_p_rho computes the perturbation pressure, perturbation density,
+!  and perturbation geopotential
+!  from the vertical coordinate definition, linearized equation of state 
+!  and the hydrostatic relation, respectively.
+!
+!  forward weighting of the pressure (divergence damping) is also
+!  computed here.
+!
+!</DESCRIPTION>
+
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = jte
+   k_start = kts
+   k_end = min(kte,kde-1)
+
+   IF(i_end == ide) i_end = i_end - 1
+   IF(j_end == jde) j_end = j_end - 1
+
+   IF (non_hydrostatic) THEN
+     DO j=j_start, j_end
+     DO k=k_start, k_end
+     DO i=i_start, i_end
+
+!  al computation is all dry, so ok with moisture
+
+      al(i,k,j)=-1./muts(i,j)*(alt(i,k,j)*mu(i,j)  &
+             +rdnw(k)*(ph(i,k+1,j)-ph(i,k,j)))
+
+!  this is temporally linearized p, no moisture correction needed
+
+      p(i,k,j)=c2a(i,k,j)*(alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*t_1(i,k,j))  &
+                       /(muts(i,j)*(t0+t_1(i,k,j)))-al (i,k,j))
+
+     ENDDO
+     ENDDO
+     ENDDO
+
+   ELSE  ! hydrostatic calculation
+
+       DO j=j_start, j_end
+       DO k=k_start, k_end
+       DO i=i_start, i_end
+         p(i,k,j)=mu(i,j)*znu(k)
+         al(i,k,j)=alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*t_1(i,k,j))            &
+                      /(muts(i,j)*(t0+t_1(i,k,j)))-p(i,k,j)/c2a(i,k,j)
+         ph(i,k+1,j)=ph(i,k,j)-dnw(k)*(muts(i,j)*al (i,k,j)              &
+                          +mu(i,j)*alt(i,k,j))
+       ENDDO
+       ENDDO
+       ENDDO
+
+   END IF
+
+!  divergence damping setup
+ 
+     IF (step == 0) then   ! we're initializing small timesteps
+       DO j=j_start, j_end
+       DO k=k_start, k_end
+       DO i=i_start, i_end
+         pm1(i,k,j)=p(i,k,j)
+       ENDDO
+       ENDDO
+       ENDDO 
+     ELSE                     ! we're in the small timesteps 
+       DO j=j_start, j_end    ! and adding div damping component
+       DO k=k_start, k_end
+       DO i=i_start, i_end
+         ptmp = p(i,k,j)
+         p(i,k,j) = p(i,k,j) + smdiv*(p(i,k,j)-pm1(i,k,j))
+         pm1(i,k,j) = ptmp
+       ENDDO
+       ENDDO
+       ENDDO
+     END IF
+
+END SUBROUTINE calc_p_rho
+
+!----------------------------------------------------------------------
+
+SUBROUTINE calc_coef_w( a,alpha,gamma,              &
+                        mut, cqw,                   &
+                        rdn, rdnw, c2a,             &
+                        dts, g, epssm,              &
+                        ids,ide, jds,jde, kds,kde,  & ! domain dims
+                        ims,ime, jms,jme, kms,kme,  & ! memory dims
+                        its,ite, jts,jte, kts,kte  )  ! tile   dims
+                                                   
+      IMPLICIT NONE  ! religion first
+
+!  passed in through the call
+
+  INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+  INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+  INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN   ) :: c2a,  &
+                                                               cqw
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: alpha, &
+                                                               gamma, &
+                                                               a
+
+  REAL, DIMENSION(ims:ime, jms:jme),          INTENT(IN   ) :: mut
+
+  REAL, DIMENSION(kms:kme),                   INTENT(IN   ) :: rdn,   &
+                                                               rdnw
+
+  REAL,                                       INTENT(IN   ) :: epssm, &
+                                                               dts,   &
+                                                               g
+
+!  Local stack data.
+
+  REAL, DIMENSION(ims:ime)                         :: cof
+  REAL  :: b, c
+
+  INTEGER :: i, j, k, i_start, i_end, j_start, j_end, k_start, k_end
+  INTEGER :: ij, ijp, ijm
+
+!<DESCRIPTION>
+!
+!  calc_coef_w calculates the coefficients needed for the 
+!  implicit solution of the vertical momentum and geopotential equations.
+!  This requires solution of a tri-diagonal equation.
+!
+!</DESCRIPTION>
+
+                                                 
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = jte
+      k_start = kts
+      k_end   = kte-1
+
+      IF(j_end == jde) j_end = j_end - 1
+      IF(i_end == ide) i_end = i_end - 1
+
+     outer_j_loop:  DO j = j_start, j_end
+
+        DO i = i_start, i_end
+          cof(i)  = (.5*dts*g*(1.+epssm)/mut(i,j))**2
+          a(i, 2 ,j) = 0.
+          a(i,kde,j) =-2.*cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j)
+          gamma(i,1 ,j) = 0.
+        ENDDO
+
+        DO k=3,kde-1
+        DO i=i_start, i_end
+          a(i,k,j) =   -cqw(i,k,j)*cof(i)*rdn(k)* rdnw(k-1)*c2a(i,k-1,j)    
+        ENDDO
+        ENDDO
+
+
+        DO k=2,kde-1
+        DO i=i_start, i_end
+          b = 1.+cqw(i,k,j)*cof(i)*rdn(k)*(rdnw(k  )*c2a(i,k,j  )  &
+                                       +rdnw(k-1)*c2a(i,k-1,j))
+          c =   -cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k  )*c2a(i,k,j  )
+          alpha(i,k,j) = 1./(b-a(i,k,j)*gamma(i,k-1,j))
+          gamma(i,k,j) = c*alpha(i,k,j)
+        ENDDO
+        ENDDO
+
+        DO i=i_start, i_end
+          b = 1.+2.*cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j)
+          c = 0.
+          alpha(i,kde,j) = 1./(b-a(i,kde,j)*gamma(i,kde-1,j))
+          gamma(i,kde,j) = c*alpha(i,kde,j)
+        ENDDO
+
+      ENDDO outer_j_loop
+
+END SUBROUTINE calc_coef_w
+
+!----------------------------------------------------------------------
+
+SUBROUTINE advance_uv ( u, ru_tend, v, rv_tend,        &
+                        p, pb,                         &
+                        ph, php, alt, al, mu,          &
+                        muu, cqu, muv, cqv, mudf,      &
+                        rdx, rdy, dts,                 &
+                        cf1, cf2, cf3, fnm, fnp,       &
+                        emdiv,                         &
+                        rdnw, config_flags, spec_zone, &
+                        non_hydrostatic,               &
+                        ids, ide, jds, jde, kds, kde,  &
+                        ims, ime, jms, jme, kms, kme,  &
+                        its, ite, jts, jte, kts, kte  )
+
+
+
+      IMPLICIT NONE  ! religion first
+
+! stuff coming in
+
+      TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+      LOGICAL, INTENT(IN   ) :: non_hydrostatic
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+      INTEGER,      INTENT(IN   )    :: spec_zone
+
+      REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),  &
+            INTENT(INOUT) ::                          &
+                                                  u,  &
+                                                  v
+
+      REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), &
+            INTENT(IN   ) ::                          &
+                                             ru_tend, &
+                                             rv_tend, &
+                                             ph,      &
+                                             php,     &
+                                             p,       &
+                                             pb,      &
+                                             alt,     &
+                                             al,      &
+                                             cqu,     &
+                                             cqv
+
+
+      REAL, DIMENSION( ims:ime , jms:jme ),    INTENT(IN   ) :: muu,  &
+                                                                muv,  &
+                                                                mu,   &
+                                                                mudf
+
+
+      REAL, DIMENSION( kms:kme ),              INTENT(IN   ) :: fnm,    &
+                                                                fnp ,   &
+                                                                rdnw
+
+      REAL,                                    INTENT(IN   ) :: rdx,    &
+                                                                rdy,    &
+                                                                dts,    &
+                                            cf1,    &
+                                            cf2,    &
+                                        cf3,    &
+                                      emdiv
+    
+
+!  Local 3d array from the stack (note tile size)
+
+      REAL, DIMENSION (its:ite, kts:kte) :: dpn, dpxy
+      REAL, DIMENSION (its:ite) :: mudf_xy
+      REAL                      :: dx, dy
+
+      INTEGER :: i,j,k, i_start, i_end, j_start, j_end, k_start, k_end
+      INTEGER :: i_endu, j_endv, k_endw
+      INTEGER :: i_start_up, i_end_up, j_start_up, j_end_up
+      INTEGER :: i_start_vp, i_end_vp, j_start_vp, j_end_vp
+
+      INTEGER :: i_start_u_tend, i_end_u_tend, j_start_v_tend, j_end_v_tend
+
+!<DESCRIPTION>
+!
+!  advance_uv advances the explicit perturbation horizontal momentum 
+!  equations (u,v) by adding in the large-timestep tendency along with 
+!  the small timestep pressure gradient tendency.
+!
+!</DESCRIPTION>
+
+!  now, the real work.
+!  set the loop bounds taking into account boundary conditions.
+
+    IF( config_flags%nested .or. config_flags%specified ) THEN
+      i_start = max( its,ids+spec_zone )
+      i_end   = min( ite,ide-spec_zone-1 )
+      j_start = max( jts,jds+spec_zone )
+      j_end   = min( jte,jde-spec_zone-1 )
+      k_start = kts
+      k_end   = min( kte, kde-1 )
+
+      i_endu = min( ite,ide-spec_zone )
+      j_endv = min( jte,jde-spec_zone )
+      k_endw = k_end
+
+      IF( config_flags%periodic_x) THEN
+        i_start = its
+        i_end   = ite
+        i_endu = i_end
+        IF(i_end == ide) i_end = i_end - 1
+      ENDIF
+    ELSE
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = jte
+      k_start = kts
+      k_end   = kte-1
+
+      i_endu = i_end
+      j_endv = j_end
+      k_endw = k_end
+
+      IF(j_end == jde) j_end = j_end - 1
+      IF(i_end == ide) i_end = i_end - 1
+    ENDIF
+
+      i_start_up = i_start
+      i_end_up   = i_endu
+      j_start_up = j_start
+      j_end_up   = j_end
+
+      i_start_vp = i_start
+      i_end_vp   = i_end
+      j_start_vp = j_start
+      j_end_vp   = j_endv
+
+      IF ( (config_flags%open_xs   .or.     &
+            config_flags%symmetric_xs   )   &
+            .and. (its == ids) )            &
+                 i_start_up = i_start_up + 1
+
+      IF ( (config_flags%open_xe    .or.  &
+            config_flags%symmetric_xe   ) &
+             .and. (ite == ide) )         &
+                 i_end_up   = i_end_up - 1
+
+      IF ( (config_flags%open_ys    .or.   &
+            config_flags%symmetric_ys   )  &
+                     .and. (jts == jds) )  &
+                 j_start_vp = j_start_vp + 1
+
+      IF ( (config_flags%open_ye     .or. &
+            config_flags%symmetric_ye   ) &
+            .and. (jte == jde) )          &
+                 j_end_vp   = j_end_vp - 1
+
+      i_start_u_tend = i_start
+      i_end_u_tend   = i_endu
+      j_start_v_tend = j_start
+      j_end_v_tend   = j_endv
+
+      IF ( config_flags%symmetric_xs .and. (its == ids) ) &
+                     i_start_u_tend = i_start_u_tend+1
+      IF ( config_flags%symmetric_xe .and. (ite == ide) ) &
+                     i_end_u_tend = i_end_u_tend-1
+      IF ( config_flags%symmetric_ys .and. (jts == jds) ) &
+                     j_start_v_tend = j_start_v_tend+1
+      IF ( config_flags%symmetric_ye .and. (jte == jde) ) &
+                     j_end_v_tend = j_end_v_tend-1
+
+   dx = 1./rdx
+   dy = 1./rdy
+
+!  start real calculations.
+!  first, u
+
+  u_outer_j_loop: DO j = j_start, j_end
+
+   DO k = k_start, k_end
+   DO i = i_start_u_tend, i_end_u_tend
+     u(i,k,j) = u(i,k,j) + dts*ru_tend(i,k,j)
+   ENDDO
+   ENDDO
+
+   DO i = i_start_up, i_end_up
+     mudf_xy(i)= -emdiv*dx*(mudf(i,j)-mudf(i-1,j))
+   ENDDO
+
+   DO k = k_start, k_end
+   DO i = i_start_up, i_end_up
+
+     dpxy(i,k)= .5*rdx*muu(i,j)*(                               &
+       ((ph (i,k+1,j)-ph (i-1,k+1,j))+(ph (i,k,j)-ph (i-1,k,j)))  &
+      +(alt(i,k  ,j)+alt(i-1,k  ,j))*(p  (i,k,j)-p  (i-1,k,j))  &
+      +(al (i,k  ,j)+al (i-1,k  ,j))*(pb (i,k,j)-pb (i-1,k,j)) ) 
+
+   ENDDO
+   ENDDO
+
+   IF (non_hydrostatic) THEN
+
+     DO i = i_start_up, i_end_up
+       dpn(i,1) = .5*( cf1*(p(i,1,j)+p(i-1,1,j))  &
+                      +cf2*(p(i,2,j)+p(i-1,2,j))  &
+                      +cf3*(p(i,3,j)+p(i-1,3,j)) )
+       dpn(i,kde) = 0.
+     ENDDO
+
+
+     DO k = k_start+1, k_end
+       DO i = i_start_up, i_end_up
+         dpn(i,k) = .5*( fnm(k)*(p(i,k  ,j)+p(i-1,k  ,j))   &
+                        +fnp(k)*(p(i,k-1,j)+p(i-1,k-1,j)) )
+       ENDDO
+     ENDDO
+
+     DO k = k_start, k_end
+       DO i = i_start_up, i_end_up
+         dpxy(i,k)=dpxy(i,k) + rdx*(php(i,k,j)-php(i-1,k,j))*        &
+           (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i-1,j)+mu(i,j)))
+       ENDDO
+     ENDDO
+
+ 
+   END IF
+
+
+   DO k = k_start, k_end
+     DO i = i_start_up, i_end_up
+       u(i,k,j)=u(i,k,j)-dts*cqu(i,k,j)*dpxy(i,k)+mudf_xy(i)
+     ENDDO
+   ENDDO
+
+   ENDDO u_outer_j_loop
+
+! now v
+
+  v_outer_j_loop: DO j = j_start_v_tend, j_end_v_tend
+
+
+   DO k = k_start, k_end
+   DO i = i_start, i_end
+     v(i,k,j) = v(i,k,j) + dts*rv_tend(i,k,j)
+   ENDDO
+   ENDDO
+
+   DO i = i_start, i_end
+     mudf_xy(i)= -emdiv*dy*(mudf(i,j)-mudf(i,j-1))
+   ENDDO
+
+     IF (     ( j >= j_start_vp)  &
+       .and.( j <= j_end_vp  ) )  THEN
+
+         DO k = k_start, k_end
+	 DO i = i_start, i_end
+
+	  dpxy(i,k)= .5*rdy*muv(i,j)*(                               &
+	  ((ph(i,k+1,j)-ph(i,k+1,j-1))+(ph (i,k,j)-ph (i,k,j-1)))   &
+	  +(alt(i,k  ,j)+alt(i,k  ,j-1))*(p  (i,k,j)-p  (i,k,j-1))  &
+	  +(al (i,k  ,j)+al (i,k  ,j-1))*(pb (i,k,j)-pb (i,k,j-1)) ) 
+
+	    ENDDO
+	    ENDDO
+
+
+     IF (non_hydrostatic) THEN
+
+       DO i = i_start, i_end     
+         dpn(i,1) = .5*( cf1*(p(i,1,j)+p(i,1,j-1))  &
+                        +cf2*(p(i,2,j)+p(i,2,j-1))  &
+                        +cf3*(p(i,3,j)+p(i,3,j-1)) )
+         dpn(i,kde) = 0.
+       ENDDO
+
+
+       DO k = k_start+1, k_end
+         DO i = i_start, i_end
+           dpn(i,k) = .5*( fnm(k)*(p(i,k  ,j)+p(i,k  ,j-1))  &
+                          +fnp(k)*(p(i,k-1,j)+p(i,k-1,j-1)) )
+         ENDDO
+       ENDDO
+
+       DO k = k_start, k_end
+         DO i = i_start, i_end
+           dpxy(i,k)=dpxy(i,k) + rdy*(php(i,k,j)-php(i,k,j-1))*    &
+             (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i,j-1)+mu(i,j)))
+         ENDDO
+       ENDDO
+
+
+     END IF
+
+
+     DO k = k_start, k_end
+       DO i = i_start, i_end
+         v(i,k,j)=v(i,k,j)-dts*cqv(i,k,j)*dpxy(i,k)+mudf_xy(i)
+       ENDDO
+     ENDDO
+   END IF
+
+  ENDDO  v_outer_j_loop
+
+END SUBROUTINE advance_uv
+
+!---------------------------------------------------------------------
+
+SUBROUTINE advance_mu_t( ww, ww_1, u, u_1, v, v_1,            &
+                         mu, mut, muave, muts, muu, muv,      &
+                         mudf, uam, vam, wwam, t, t_1,        &
+                         t_ave, ft, mu_tend,                  &
+                         rdx, rdy, dts, epssm,                &
+                         dnw, fnm, fnp, rdnw,                 &
+                         msfu, msfv, msft,                    &
+                         step, config_flags,                  &
+                         ids, ide, jds, jde, kds, kde,        &
+                         ims, ime, jms, jme, kms, kme,        &
+                         its, ite, jts, jte, kts, kte        )
+
+  IMPLICIT NONE  ! religion first
+
+! stuff coming in
+
+  TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+  INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+  INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+  INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+  INTEGER,      INTENT(IN   )    :: step
+
+  REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),   &
+            INTENT(IN   ) ::                       &
+                                              u,   &
+                                              v,   &
+                                              u_1, &
+                                              v_1, &
+                                              t_1, &
+                                              ft
+
+  REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),      &
+            INTENT(INOUT) ::                          &
+                                              ww,     &
+                                              ww_1,   &
+                                              t,      &
+                                              t_ave,  &
+                                              uam,    &
+                                              vam,    &
+                                              wwam
+                                              
+  REAL, DIMENSION( ims:ime , jms:jme ),    INTENT(IN   ) :: muu,  &
+                                                            muv,  &
+                                                            mut,  &
+                                                            msfu, &
+                                                            msfv, &
+                                                            msft, &
+                                                            mu_tend
+
+  REAL, DIMENSION( ims:ime , jms:jme ),    INTENT(  OUT) :: muave, &
+                                                            muts,  &
+                                                            mudf
+
+  REAL, DIMENSION( ims:ime , jms:jme ),    INTENT(INOUT) :: mu
+
+  REAL, DIMENSION( kms:kme ),              INTENT(IN   ) :: fnm,    &
+                                                            fnp,    &
+                                                            dnw,    &
+                                                            rdnw
+
+
+  REAL,                                    INTENT(IN   ) :: rdx,    &
+                                                            rdy,    &
+                                                            dts,    &
+                                                            epssm
+
+!  Local 3d array from the stack (note tile size)
+
+  REAL, DIMENSION (its:ite, kts:kte) :: wdtn, dvdxi
+  REAL, DIMENSION (its:ite) :: dmdt
+
+  INTEGER :: i,j,k, i_start, i_end, j_start, j_end, k_start, k_end
+  INTEGER :: i_endu, j_endv
+  REAL    :: acc
+
+!<DESCRIPTION>
+!
+!  advance_mu_t advances the explicit perturbation theta equation and the mass
+!  conservation equation.  In addition, the small timestep omega is updated,
+!  and some quantities needed in other places are squirrelled away.
+!
+!</DESCRIPTION>
+
+!  now, the real work.
+!  set the loop bounds taking into account boundary conditions.
+
+  i_start = its
+  i_end   = ite
+  j_start = jts
+  j_end   = jte
+  k_start = kts
+  k_end   = kte-1
+     
+  i_endu = i_end
+  j_endv = j_end
+
+  IF(j_end == jde) j_end = j_end - 1
+  IF(i_end == ide) i_end = i_end - 1
+
+  IF ( .NOT. config_flags%periodic_x )THEN
+    IF ( (config_flags%specified .or. config_flags%nested) .and. (its == ids) ) &
+             i_start = i_start + 1
+
+    IF ( (config_flags%specified .or. config_flags%nested) .and. (ite == ide) ) &
+             i_end   = i_end - 1
+  ENDIF
+
+  IF ( (config_flags%specified .or. config_flags%nested) .and. (jts == jds) ) &
+             j_start = j_start + 1
+
+  IF ( (config_flags%specified .or. config_flags%nested) .and. (jte == jde) ) &
+             j_end   = j_end - 1
+
+
+!        CALCULATION OF WW (dETA/dt)
+   DO j = j_start, j_end
+
+     DO i=i_start, i_end
+            dmdt(i) = 0.
+     ENDDO
+!  NOTE:  mu is not coupled with the map scale factor.
+!         ww (omega) IS coupled with the map scale factor.
+!         Being coupled with the map scale factor means 
+!           multiplication by (1/msft) in this case.
+
+     DO k=k_start, k_end
+     DO i=i_start, i_end
+        dvdxi(i,k) = msft(i,j)*msft(i,j)*(                        &
+                     rdy*( (v(i,k,j+1)+muv(i,j+1)*v_1(i,k,j+1)/msfv(i,j+1))   &
+                          -(v(i,k,j  )+muv(i,j  )*v_1(i,k,j  )/msfv(i,j  )) ) & 
+                    +rdx*( (u(i+1,k,j)+muu(i+1,j)*u_1(i+1,k,j)/msfu(i+1,j))   &
+                          -(u(i,k,j  )+muu(i  ,j)*u_1(i,k,j  )/msfu(i  ,j)) ) )
+        dmdt(i)    = dmdt(i) + dnw(k)*dvdxi(i,k)
+     ENDDO
+     ENDDO
+     DO i=i_start, i_end
+       muave(i,j) = mu(i,j)
+       mu(i,j) = mu(i,j)+dts*(dmdt(i)+mu_tend(i,j))
+       mudf(i,j) = (dmdt(i)+mu_tend(i,j)) ! save tendency for div damp filter
+       muts(i,j) = mut(i,j)+mu(i,j)
+       muave(i,j) =.5*((1.+epssm)*mu(i,j)+(1.-epssm)*muave(i,j))
+     ENDDO
+
+     DO k=2,k_end
+     DO i=i_start, i_end
+       ww(i,k,j)=ww(i,k-1,j)-dnw(k-1)*(dmdt(i)+dvdxi(i,k-1)+mu_tend(i,j))/msft(i,j)
+     ENDDO
+     END DO
+
+!  NOTE:  ww_1 (large timestep ww) is already coupled with the 
+!         map scale factor
+
+     DO k=1,k_end
+     DO i=i_start, i_end
+       ww(i,k,j)=ww(i,k,j)-ww_1(i,k,j)
+     END DO
+     END DO
+
+   ENDDO
+
+! CALCULATION OF THETA
+
+! NOTE: theta'' is not coupled with the map-scale factor, 
+!       while the theta'' tendency is coupled (i.e., mult by 1/msft)
+
+   DO j=j_start, j_end
+     DO k=1,k_end
+     DO i=i_start, i_end
+       t_ave(i,k,j) = t(i,k,j)
+       t   (i,k,j) = t(i,k,j) + msft(i,j)*dts*ft(i,k,j)
+     END DO
+     END DO
+   ENDDO   
+
+   DO j=j_start, j_end
+
+     DO i=i_start, i_end
+       wdtn(i,1  )=0.
+       wdtn(i,kde)=0.
+     ENDDO
+
+     DO k=2,k_end
+     DO i=i_start, i_end
+        wdtn(i,k)= ww(i,k,j)*(fnm(k)*t_1(i,k  ,j)+fnp(k)*t_1(i,k-1,j))
+     ENDDO
+     ENDDO
+
+     DO k=1,k_end
+     DO i=i_start, i_end
+       t(i,k,j) = t(i,k,j) - dts*msft(i,j)*(               &
+                          msft(i,j)*(                      &
+               .5*rdy*                                     &
+              ( v(i,k,j+1)*(t_1(i,k,j+1)+t_1(i,k, j ))     &
+               -v(i,k,j  )*(t_1(i,k, j )+t_1(i,k,j-1)) )   &
+             + .5*rdx*                                     &
+              ( u(i+1,k,j)*(t_1(i+1,k,j)+t_1(i  ,k,j))     &
+               -u(i  ,k,j)*(t_1(i  ,k,j)+t_1(i-1,k,j)) ) ) &
+             + rdnw(k)*( wdtn(i,k+1)-wdtn(i,k) ) )       
+     ENDDO
+     ENDDO
+
+   ENDDO
+
+END SUBROUTINE advance_mu_t
+          
+
+
+!------------------------------------------------------------
+
+SUBROUTINE advance_w( w, rw_tend, ww, u, v,       &
+                      mu1, mut, muave, muts,      &
+                      t_2ave, t_2, t_1,           &
+                      ph, ph_1, phb, ph_tend,     &
+                      ht, c2a, cqw, alt, alb,     &
+                      a, alpha, gamma,            &
+                      rdx, rdy, dts, t0, epssm,   &
+                      dnw, fnm, fnp, rdnw, rdn,   &
+                      cf1, cf2, cf3, msft,        &
+                      config_flags,               &
+                      ids,ide, jds,jde, kds,kde,  & ! domain dims
+                      ims,ime, jms,jme, kms,kme,  & ! memory dims
+                      its,ite, jts,jte, kts,kte  )  ! tile   dims
+
+  IMPLICIT NONE ! religion first
+      
+! stuff coming in
+
+
+  TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+  INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+  INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+  INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+      REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
+            INTENT(INOUT) ::                          &
+                                             t_2ave,  &
+                                             w,       &
+                                             ph
+
+
+      REAL, DIMENSION(  ims:ime , kms:kme, jms:jme ), &
+            INTENT(IN   ) ::                          &
+                                             rw_tend, &
+                                             ww,     &
+                                             u,       &
+                                             v,       &
+                                             t_2,     &
+                                             t_1,     &
+                                             ph_1,    &
+                                             phb,     &
+                                             ph_tend, &
+                                             alpha,   &
+                                             gamma,   &
+                                             a,       &
+                                             c2a,     &
+                                             cqw,     &
+                                             alb,     &
+                                             alt
+
+      REAL, DIMENSION( ims:ime , jms:jme ), &
+            INTENT(IN   )  ::               &
+                                   mu1,     &
+                                   mut,     &
+                                   muave,   &
+                                   muts,    &
+                                   ht,      &
+                                   msft
+
+      REAL, DIMENSION( kms:kme ),  INTENT(IN   )  :: fnp,     &
+                                                     fnm,     &
+                                                     rdnw,    &
+                                                     rdn,     &
+                                                     dnw
+
+      REAL,   INTENT(IN   )  :: rdx,     &
+                                rdy,     &
+                                dts,     &
+                                cf1,     &
+                                cf2,     &
+                                cf3,     &
+                                t0,      &
+                                epssm
+
+!  Stack based 3d data, tile size.
+
+      REAL, DIMENSION( its:ite ) :: mut_inv, msft_inv
+      REAL, DIMENSION( its:ite, kts:kte ) :: rhs, wdwn
+      INTEGER :: i,j,k, i_start, i_end, j_start, j_end, k_start, k_end
+
+!<DESCRIPTION>
+!
+!  advance_w advances the implicit w and geopotential equations.
+!
+!</DESCRIPTION>
+
+!  set loop limits.
+!  Currently set for periodic boundary conditions
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = jte
+      k_start = kts
+      k_end   = kte-1
+
+
+      IF(j_end == jde) j_end = j_end - 1
+      IF(i_end == ide) i_end = i_end - 1
+
+  IF ( .NOT. config_flags%periodic_x )THEN
+    IF ( (config_flags%specified .or. config_flags%nested) .and. (its == ids) ) &
+             i_start = i_start + 1
+
+    IF ( (config_flags%specified .or. config_flags%nested) .and. (ite == ide) ) &
+             i_end   = i_end - 1
+  ENDIF
+
+  IF ( (config_flags%specified .or. config_flags%nested) .and. (jts == jds) ) &
+             j_start = j_start + 1
+
+  IF ( (config_flags%specified .or. config_flags%nested) .and. (jte == jde) ) &
+             j_end   = j_end - 1
+
+
+! calculation of phi and w equations
+
+    DO i=i_start, i_end
+      rhs(i,1) = 0.
+    ENDDO
+
+  j_loop_w:  DO j = j_start, j_end
+    DO i=i_start, i_end
+       mut_inv(i) = 1./mut(i,j)
+       msft_inv(i) = 1./msft(i,j)
+    ENDDO
+
+    DO k=1, k_end
+    DO i=i_start, i_end
+      t_2ave(i,k,j)=.5*((1.+epssm)*t_2(i,k,j)       &
+                    +(1.-epssm)*t_2ave(i,k,j))
+      t_2ave(i,k,j)=(t_2ave(i,k,j)-mu1(i,j)*t_1(i,k,j)) &
+                    /(muts(i,j)*(t0+t_1(i,k,j)))
+      wdwn(i,k+1)=.5*(ww(i,k+1,j)+ww(i,k,j))*rdnw(k)    &
+           *(ph_1(i,k+1,j)-ph_1(i,k,j)+phb(i,k+1,j)-phb(i,k,j))
+      rhs(i,k+1) = dts*(ph_tend(i,k+1,j) + .5*g*(1.-epssm)*w(i,k+1,j))
+
+    ENDDO
+    ENDDO
+
+    DO k=2,k_end
+    DO i=i_start, i_end
+       rhs(i,k) = rhs(i,k)-dts*( fnm(k)*wdwn(i,k+1)  &
+                                +fnp(k)*wdwn(i,k  ) )
+    ENDDO
+    ENDDO
+
+!  NOTE:  phi'' is not coupled with the map-scale factor  (1/m), 
+!         but it's tendency is, so must multiply by msft here
+
+    DO k=2,k_end+1
+    DO i=i_start, i_end
+      rhs(i,k) = ph(i,k,j) + msft(i,j)*rhs(i,k)*mut_inv(i)
+    ENDDO
+    ENDDO
+
+!  lower boundary condition on w
+
+    DO i=i_start, i_end
+       w(i,1,j)=                                           &
+
+                .5*rdy*(                                   &
+                         (ht(i,j+1)-ht(i,j  ))             &
+        *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1))    &
+                        +(ht(i,j  )-ht(i,j-1))             &
+        *(cf1*v(i,1,j  )+cf2*v(i,2,j  )+cf3*v(i,3,j  ))  ) &
+
+               +.5*rdx*(                                   &
+                         (ht(i+1,j)-ht(i,j  ))             &
+        *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j))    &
+                        +(ht(i,j  )-ht(i-1,j))             &
+        *(cf1*u(i  ,1,j)+cf2*u(i  ,2,j)+cf3*u(i  ,3,j))  ) 
+
+     ENDDO
+!
+! Jammed 3 doubly nested loops over k/i into 1 for slight improvement
+! in efficiency.  No change in results (bit-for-bit). JM 20040514
+! (left a blank line where the other two k/i-loops were)
+!
+    DO k=2,k_end
+      DO i=i_start, i_end
+        w(i,k,j)=w(i,k,j)+dts*rw_tend(i,k,j)                       &
+
+                 + msft_inv(i)*cqw(i,k,j)*(                        &
+            +.5*dts*g*mut_inv(i)*rdn(k)*                           &
+             (c2a(i,k  ,j)*rdnw(k  )                               &
+        *((1.+epssm)*(rhs(i,k+1  )-rhs(i,k    ))                   &
+         +(1.-epssm)*(ph(i,k+1,j)-ph(i,k  ,j)))                    &
+             -c2a(i,k-1,j)*rdnw(k-1)                               &
+        *((1.+epssm)*(rhs(i,k    )-rhs(i,k-1  ))                   &
+         +(1.-epssm)*(ph(i,k  ,j)-ph(i,k-1,j)))))                  &
+
+                +dts*g*msft_inv(i)*(rdn(k)*                        &
+             (c2a(i,k  ,j)*alt(i,k  ,j)*t_2ave(i,k  ,j)            &
+             -c2a(i,k-1,j)*alt(i,k-1,j)*t_2ave(i,k-1,j))           &
+               +(rdn(k)*(c2a(i,k  ,j)*alb(i,k  ,j)                 &
+                        -c2a(i,k-1,j)*alb(i,k-1,j))*mut_inv(i)-1.) &
+                     *muave(i,j))
+      ENDDO
+    ENDDO
+
+    K=k_end+1
+
+    DO i=i_start, i_end
+       w(i,k,j)=w(i,k,j)+dts*rw_tend(i,k,j)                         &
+           +msft_inv(i)*(                                        &
+         -.5*dts*g*mut_inv(i)*rdnw(k-1)**2*2.*c2a(i,k-1,j)            &
+             *((1.+epssm)*(rhs(i,k  )-rhs(i,k-1  ))                 &
+              +(1.-epssm)*(ph(i,k,j)-ph(i,k-1,j)))                  &
+         -dts*g*(2.*rdnw(k-1)*                                      &
+                   c2a(i,k-1,j)*alt(i,k-1,j)*t_2ave(i,k-1,j)        &
+             +(1.+2.*rdnw(k-1)*c2a(i,k-1,j)*alb(i,k-1,j)*mut_inv(i))  &
+                        *muave(i,j)) )
+    ENDDO
+
+    DO k=2,k_end+1
+    DO i=i_start, i_end
+       w(i,k,j)=(w(i,k,j)-a(i,k,j)*w(i,k-1,j))*alpha(i,k,j)
+    ENDDO
+    ENDDO
+
+    DO k=k_end,2,-1
+    DO i=i_start, i_end
+       w (i,k,j)=w (i,k,j)-gamma(i,k,j)*w(i,k+1,j)
+       ph(i,k+1,j) = rhs(i,k+1)+msft(i,j)*.5*dts*g*(1.+epssm) &
+                      *w(i,k+1,j)/muts(i,j)
+    ENDDO
+    ENDDO
+
+    DO i=i_start, i_end
+       ph(i,2,j) =  rhs(i,2)+msft(i,j)*.5*dts*g*(1.+epssm) &
+                      *w(i,2,j)/muts(i,j)
+    ENDDO
+
+  ENDDO j_loop_w
+
+END SUBROUTINE advance_w
+
+!---------------------------------------------------------------------
+
+SUBROUTINE sumflux ( ru, rv, ww,                             &
+                     u_lin, v_lin, ww_lin,                   &
+                     muu, muv,                               &
+                     ru_m, rv_m, ww_m, epssm,                &
+                     msfu, msfv,                             &
+                     iteration , number_of_small_timesteps,  &
+                     ids,ide, jds,jde, kds,kde,              &
+                     ims,ime, jms,jme, kms,kme,              &
+                     its,ite, jts,jte, kts,kte              )
+
+
+  IMPLICIT NONE  ! religion first
+
+! declarations for the stuff coming in
+
+  INTEGER,      INTENT(IN   )    :: number_of_small_timesteps
+  INTEGER,      INTENT(IN   )    :: iteration
+  INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+  INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+  INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme),  INTENT(IN   ) :: ru, &
+                                                                rv, &
+                                                                ww, &
+                                                                u_lin,  &
+                                                                v_lin,  &
+                                                                ww_lin
+
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) , INTENT(INOUT) :: ru_m, &
+                                                                rv_m, &
+                                                                ww_m
+  REAL, DIMENSION(ims:ime, jms:jme) , INTENT(IN   ) :: muu, muv, msfu, msfv
+
+  INTEGER :: mini, minj, mink
+
+
+  REAL, INTENT(IN   )  ::  epssm
+  INTEGER   :: i,j,k
+
+
+!<DESCRIPTION>
+!
+!  update the small-timestep time-averaged mass fluxes;  these
+!  are needed for consistent mass-conserving scalar advection.
+!
+!</DESCRIPTION>
+
+    IF (iteration == 1 )THEN
+      DO  j = jts, jte
+      DO  k = kts, kte
+      DO  i = its, ite
+        ru_m(i,k,j)  = 0.
+        rv_m(i,k,j)  = 0.
+        ww_m(i,k,j)  = 0.
+      ENDDO
+      ENDDO
+      ENDDO
+    ENDIF
+
+  mini = min(ide-1,ite)
+  minj = min(jde-1,jte)
+  mink = min(kde-1,kte)
+
+
+    DO  j = jts, minj
+    DO  k = kts, mink
+    DO  i = its, mini
+      ru_m(i,k,j)  = ru_m(i,k,j) + ru(i,k,j)
+      rv_m(i,k,j)  = rv_m(i,k,j) + rv(i,k,j)
+      ww_m(i,k,j)  = ww_m(i,k,j) + ww(i,k,j)
+    ENDDO
+    ENDDO
+    ENDDO
+ 
+    IF (ite .GT. mini) THEN
+      DO  j = jts, minj
+      DO  k = kts, mink
+      DO  i = mini+1, ite
+        ru_m(i,k,j)  = ru_m(i,k,j) + ru(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+    END IF
+    IF (jte .GT. minj) THEN
+      DO  j = minj+1, jte
+      DO  k = kts, mink
+      DO  i = its, mini
+	rv_m(i,k,j)  = rv_m(i,k,j) + rv(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+    END IF
+    IF ( kte .GT. mink) THEN
+      DO  j = jts, minj
+      DO  k = mink+1, kte
+      DO  i = its, mini
+        ww_m(i,k,j)  = ww_m(i,k,j) + ww(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+    END IF
+
+  IF (iteration == number_of_small_timesteps) THEN
+
+    DO  j = jts, minj
+    DO  k = kts, mink
+    DO  i = its, mini
+      ru_m(i,k,j)  = ru_m(i,k,j) / number_of_small_timesteps   &
+                     + muu(i,j)*u_lin(i,k,j)/msfu(i,j)
+      rv_m(i,k,j)  = rv_m(i,k,j) / number_of_small_timesteps   &
+                     + muv(i,j)*v_lin(i,k,j)/msfv(i,j) 
+      ww_m(i,k,j)  = ww_m(i,k,j) / number_of_small_timesteps   &
+                     + ww_lin(i,k,j) 
+    ENDDO
+    ENDDO
+    ENDDO
+
+
+    IF (ite .GT. mini) THEN
+      DO  j = jts, minj
+      DO  k = kts, mink
+      DO  i = mini+1, ite
+        ru_m(i,k,j)  = ru_m(i,k,j) / number_of_small_timesteps   &
+                     + muu(i,j)*u_lin(i,k,j)/msfu(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+    END IF
+    IF (jte .GT. minj) THEN
+      DO  j = minj+1, jte
+      DO  k = kts, mink
+      DO  i = its, mini
+	rv_m(i,k,j)  = rv_m(i,k,j) / number_of_small_timesteps   &
+                     + muv(i,j)*v_lin(i,k,j)/msfv(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+    END IF
+    IF ( kte .GT. mink) THEN
+      DO  j = jts, minj
+      DO  k = mink+1, kte
+      DO  i = its, mini
+        ww_m(i,k,j)  = ww_m(i,k,j) / number_of_small_timesteps   &
+                     + ww_lin(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+    END IF
+
+  ENDIF
+
+
+END SUBROUTINE sumflux 
+
+!---------------------------------------------------------------------
+
+  SUBROUTINE init_module_small_step
+  END SUBROUTINE init_module_small_step
+
+END MODULE module_small_step_em
Index: trunk/WRF.COMMON/WRFV2/dyn_em/module_solvedebug_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/module_solvedebug_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/module_solvedebug_em.F	(revision 2744)
@@ -0,0 +1,325 @@
+!WRF:MEDIATION_LAYER:UTIL
+!
+
+MODULE module_solvedebug_em
+CONTAINS
+      SUBROUTINE var_min_max( u,v,w,t,r,                  &
+                              ids,ide, jds,jde, kds,kde,  & ! domain dims
+                              ims,ime, jms,jme, kms,kme,  & ! memory dims
+                              ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                              its,ite, jts,jte, kts,kte )
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+      REAL,  DIMENSION( kms: , ims: , jms: ), &
+                   INTENT(IN) :: u,v,w,t,r
+
+      INTEGER  :: i, j, k, istag, jstag, imax, imin, jmax, jmin, &
+                  kmax, kmin
+
+      REAL :: vmax, vmin, vavg
+
+      vmin = u(1,1,1)
+      vmax = u(1,1,1)
+      vavg = 0.
+      imax = 1
+      imin = 1
+      jmax = 1
+      jmin = 1
+      kmax = 1
+      kmin = 1
+
+      do j=jps,jpe-1
+      do i=ips,ipe
+      do k=kps,kpe-1
+        if(u(k,i,j) .gt. vmax) then
+          vmax = u(k,i,j)
+          imax = i
+          jmax = j
+          kmax = k
+         endif
+
+        if(u(k,i,j) .lt. vmin) then
+          vmin = u(k,i,j)
+          imin = i
+          jmin = j
+          kmin = k
+         endif
+        vavg = vavg + abs(u(k,i,j))
+      enddo
+      enddo
+      enddo
+      vavg = vavg/float((ipe-ips)*(jpe-jps-1)*(kpe-kps-1))
+      write(6,*) ' ru min,max,avg ',vmin,vmax,vavg
+      write(6,*) kmax, imax, jmax, kmin, imin, jmin
+
+
+      vmin = v(1,1,1)
+      vmax = v(1,1,1)
+      vavg = 0.
+      imax = 1
+      imin = 1
+      jmax = 1
+      jmin = 1
+      kmax = 1
+      kmin = 1
+
+      do j=jps,jpe
+      do i=ips,ipe-1
+      do k=kps,kpe-1
+        if(v(k,i,j) .gt. vmax) then
+          vmax = v(k,i,j)
+          imax = i
+          jmax = j
+          kmax = k
+        endif
+        if(v(k,i,j) .lt. vmin) then
+          vmin = v(k,i,j)
+          imin = i
+          jmin = j
+          kmin = k
+        endif
+        vavg = vavg + abs(v(k,i,j))
+      enddo
+      enddo
+      enddo
+      vavg = vavg/float((ipe-ips-1)*(jpe-jps)*(kpe-kps-1))
+      write(6,*) ' rv min,max,avg ',vmin,vmax,vavg
+      write(6,*) kmax, imax, jmax, kmin, imin, jmin
+
+
+
+      vmin = w(1,1,1)
+      vmax = w(1,1,1)
+      vavg = 0.
+      imax = 1
+      imin = 1
+      jmax = 1
+      jmin = 1
+      kmax = 1
+      kmin = 1
+
+      do j=jps,jpe-1
+      do i=ips,ipe-1
+      do k=kps,kpe
+        if(w(k,i,j) .gt. vmax) then
+          vmax = w(k,i,j)
+          imax = i
+          jmax = j
+          kmax = k
+        endif
+        if(w(k,i,j) .lt. vmin) then
+          vmin = w(k,i,j)
+          imin = i
+          jmin = j
+          kmin = k
+        endif
+        vavg = vavg + abs(w(k,i,j))
+      enddo
+      enddo
+      enddo
+      vavg = vavg/float((ipe-ips-1)*(jpe-jps-1)*(kpe-kps))
+      write(6,*) ' rom min,max,avg ',vmin,vmax,vavg
+      write(6,*) kmax, imax, jmax, kmin, imin, jmin
+
+
+
+      vmin = t(1,1,1)
+      vmax = t(1,1,1)
+      vavg = 0.
+      imax = 1
+      imin = 1
+      jmax = 1
+      jmin = 1
+      kmax = 1
+      kmin = 1
+
+      do j=jps,jpe-1
+      do i=ips,ipe-1
+      do k=kps,kpe-1
+        if(t(k,i,j) .gt. vmax) then
+          vmax = t(k,i,j)
+          imax = i
+          jmax = j
+          kmax = k
+        endif
+        if(t(k,i,j) .lt. vmin) then
+          vmin = t(k,i,j)
+          imin = i
+          jmin = j
+          kmin = k
+        endif
+        vavg = vavg + abs(t(k,i,j))
+      enddo
+      enddo
+      enddo
+      vavg = vavg/float((ipe-ips-1)*(jpe-jps-1)*(kpe-kps-1))
+      write(6,*) ' rtp min,max,avg ',vmin,vmax,vavg
+      write(6,*) kmax, imax, jmax, kmin, imin, jmin
+
+
+
+      vmin = r(1,1,1)
+      vmax = r(1,1,1)
+      vavg = 0.
+      imax = 1
+      imin = 1
+      jmax = 1
+      jmin = 1
+      kmax = 1
+      kmin = 1
+
+      do j=jps,jpe-1
+      do i=ips,ipe-1
+      do k=kps,kpe-1
+        if(r(k,i,j) .gt. vmax) then
+          vmax = r(k,i,j)
+          imax = i
+          jmax = j
+          kmax = k
+        endif
+        if(r(k,i,j) .lt. vmin) then
+          vmin = r(k,i,j)
+          imin = i
+          jmin = j
+          kmin = k
+        endif
+        vavg = vavg + abs(r(k,i,j))
+      enddo
+      enddo
+      enddo
+      vavg = vavg/float((ipe-ips-1)*(jpe-jps-1)*(kpe-kps-1))
+      write(6,*) ' rhop min,max,avg ',vmin,vmax,vavg
+      write(6,*) kmax, imax, jmax, kmin, imin, jmin
+
+      return
+      end subroutine var_min_max
+
+      SUBROUTINE var1_min_max( u, &
+                              ids,ide, jds,jde, kds,kde,  & ! domain dims
+                              ims,ime, jms,jme, kms,kme,  & ! memory dims
+                              ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                              its,ite, jts,jte, kts,kte )
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+      REAL,  DIMENSION(kms: , ims: , jms: ), &
+                   INTENT(IN) :: u
+
+      INTEGER  :: i, j, k, istag, jstag, imax, imin, jmax, jmin, &
+                  kmax, kmin
+
+      REAL :: vmax, vmin, vavg
+
+      write(6,*) ' min, max, and avg stats '
+
+      vmin = u(1,1,1)
+      vmax = u(1,1,1)
+      vavg = 0.
+      imax = 1
+      imin = 1
+      jmax = 1
+      jmin = 1
+      kmax = 1
+      kmin = 1
+
+      do j=jps,jpe-1
+      do i=ips,ipe
+      do k=kps,kpe-1
+        if(u(k,i,j) .gt. vmax) then
+          vmax = u(k,i,j)
+          imax = i
+          jmax = j
+          kmax = k
+         endif
+
+        if(u(k,i,j) .lt. vmin) then
+          vmin = u(k,i,j)
+          imin = i
+          jmin = j
+          kmin = k
+         endif
+        vavg = vavg + abs(u(k,i,j))
+      enddo
+      enddo
+      enddo
+      vavg = vavg/float((ipe-ips)*(jpe-jps-1)*(kpe-kps-1))
+      write(6,*) ' ru max,min,avg ',vmax,vmin,vavg
+      write(6,*) kmax, imax, jmax, kmin, imin, jmin
+
+      return
+      end subroutine var1_min_max
+
+
+
+
+      SUBROUTINE var_print ( u, &
+                              ims,ime, jms,jme, kms,kme,  & ! memory dims
+                              ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                              level                )  
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: level
+
+      REAL,  DIMENSION(kms:kme, ims:ime, jms:jme), &
+                   INTENT(IN) :: u
+
+      INTEGER  :: i, j, k, istag, jstag, it, imax, imin, jmax, jmin, &
+                  kmax, kmin, ii,jj
+
+      REAL :: vmax, vmin, vavg
+
+      write(6,*) ' level for print ',level
+      write(6,*) (u(level, ii, 1),ii=1,ipe)
+      write(6,*) (u(level, 1, jj),jj=1,jpe)
+
+      return
+      end subroutine var_print
+
+      SUBROUTINE symm_check ( f, &
+                              ids,ide, jds,jde, kds,kde,  & ! domain dims
+                              ims,ime, jms,jme, kms,kme,  & ! memory dims
+                              ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                              level                )  
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: level
+
+      REAL,  DIMENSION(kms:kme, ims:ime, jms:jme), &
+                   INTENT(IN) :: f
+
+      INTEGER  :: i, j, k, istag, jstag, it, imax, imin, jmax, jmin, &
+                  kmax, kmin, ii,jj
+
+      REAL :: vmax, vmin, vavg
+
+      write(6,*) ide,' = ide'
+
+      do k=kps,kpe
+       do i=ips,ipe
+        do j=jps,jpe
+          if(f(k,i,j).ne.f(k,ide-i,j))print *,' x asymmetry at kij ',k,i,j
+          if(f(k,i,j).ne.f(k,i,jde-j))print *,' y asymmetry at kij ',k,i,j
+        enddo
+       enddo
+      enddo
+      return
+      end subroutine symm_check
+END MODULE module_solvedebug_em
Index: trunk/WRF.COMMON/WRFV2/dyn_em/nest_init_utils.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/nest_init_utils.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/nest_init_utils.F	(revision 2744)
@@ -0,0 +1,329 @@
+SUBROUTINE init_domain_constants_em ( parent , nest )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)  :: parent , nest
+
+   INTEGER iswater , map_proj, julyr, julday
+   REAL    cen_lat, cen_lon, truelat1 , truelat2 , gmt , moad_cen_lat , stand_lon
+   CHARACTER (LEN=4) :: char_junk
+
+! single-value constants
+
+   nest%p_top   = parent%p_top
+   nest%cfn     = parent%cfn
+   nest%cfn1    = parent%cfn1
+   nest%rdx     = 1./nest%dx
+   nest%rdy     = 1./nest%dy
+!  nest%dts     = nest%dt/float(nest%time_step_sound)
+   nest%dtseps  = parent%dtseps  ! used in height model only?
+   nest%resm    = parent%resm    ! used in height model only?
+   nest%zetatop = parent%zetatop ! used in height model only?
+   nest%cf1     = parent%cf1
+   nest%cf2     = parent%cf2
+   nest%cf3     = parent%cf3
+   nest%gmt     = parent%gmt
+   nest%julyr   = parent%julyr
+   nest%julday  = parent%julday
+
+   CALL nl_get_mminlu ( 1,char_junk(1:4) )
+   CALL nl_get_iswater (1, iswater )
+   CALL nl_get_truelat1 ( 1 , truelat1 )
+   CALL nl_get_truelat2 ( 1 , truelat2 )
+   CALL nl_get_cen_lat ( 1 , cen_lat )
+   CALL nl_get_cen_lon ( 1 , cen_lon )
+   CALL nl_get_moad_cen_lat ( 1 , moad_cen_lat )
+   CALL nl_get_stand_lon ( 1 , stand_lon )
+   CALL nl_get_map_proj ( 1 , map_proj )
+   CALL nl_get_gmt ( 1 , gmt)
+   CALL nl_get_julyr ( 1 , julyr)
+   CALL nl_get_julday ( 1 , julday)
+   IF ( nest%id .NE. 1 ) THEN
+     CALL nl_set_gmt (nest%id, gmt)
+     CALL nl_set_julyr (nest%id, julyr)
+     CALL nl_set_julday (nest%id, julday)
+     CALL nl_set_iswater (nest%id, iswater )
+     CALL nl_set_cen_lat ( nest%id , cen_lat )
+     CALL nl_set_cen_lon ( nest%id , cen_lon )
+     CALL nl_set_truelat1 ( nest%id , truelat1 )
+     CALL nl_set_truelat2 ( nest%id , truelat2 )
+     CALL nl_set_moad_cen_lat ( nest%id , moad_cen_lat )
+     CALL nl_set_stand_lon ( nest%id , stand_lon )
+     CALL nl_set_map_proj ( nest%id , map_proj )
+   END IF
+   nest%gmt     = gmt 
+   nest%julday  = julday 
+   nest%julyr   = julyr 
+   nest%iswater = iswater 
+   nest%cen_lat = cen_lat 
+   nest%cen_lon = cen_lon 
+   nest%truelat1= truelat1 
+   nest%truelat2= truelat2 
+   nest%moad_cen_lat= moad_cen_lat 
+   nest%stand_lon= stand_lon 
+   nest%map_proj= map_proj 
+
+   nest%step_number  = parent%step_number
+
+! 1D constants (Z)
+
+   nest%em_fnm    = parent%em_fnm
+   nest%em_fnp    = parent%em_fnp
+   nest%em_rdnw   = parent%em_rdnw
+   nest%em_rdn    = parent%em_rdn
+   nest%em_dnw    = parent%em_dnw
+   nest%em_dn     = parent%em_dn
+   nest%em_znu    = parent%em_znu
+   nest%em_znw    = parent%em_znw
+   nest%em_t_base = parent%em_t_base
+   nest%u_base    = parent%u_base
+   nest%v_base    = parent%v_base
+   nest%qv_base   = parent%qv_base
+   nest%z_base    = parent%z_base
+   nest%dzs       = parent%dzs
+   nest%zs        = parent%zs
+
+END SUBROUTINE init_domain_constants_em
+
+SUBROUTINE blend_terrain ( ter_interpolated , ter_input , &
+                           ids , ide , jds , jde , kds , kde , & 
+                           ims , ime , jms , jme , kms , kme , & 
+                           ips , ipe , jps , jpe , kps , kpe )
+
+   USE module_configure
+   IMPLICIT NONE
+
+   INTEGER , INTENT(IN)                       :: ids , ide , jds , jde , kds , kde , & 
+                                                 ims , ime , jms , jme , kms , kme , & 
+                                                 ips , ipe , jps , jpe , kps , kpe
+   REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)    :: ter_interpolated
+   REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT) :: ter_input
+
+   REAL , DIMENSION(ims:ime,kms:kme,jms:jme) :: ter_temp
+   INTEGER :: i , j , k , spec_bdy_width
+   REAL    :: r_blend_zones
+   INTEGER blend_cell, blend_width
+
+   !  The fine grid elevation comes from the horizontally interpolated
+   !  parent elevation for the first spec_bdy_width row/columns, so we need
+   !  to get that value.  We blend the coarse and fine in the next blend_width
+   !  rows and columns.  After that, in the interior, it is 100% fine grid.
+
+   CALL nl_get_spec_bdy_width ( 1, spec_bdy_width) 
+   CALL nl_get_blend_width ( 1, blend_width)
+
+   !  Initialize temp values to the nest ter elevation.  This fills in the values
+   !  that will not be modified below.  
+
+   DO j = jps , MIN(jpe, jde-1)
+      DO k = kps , kpe
+         DO i = ips , MIN(ipe, ide-1)
+            ter_temp(i,k,j) = ter_input(i,k,j)
+         END DO 
+      END DO 
+   END DO 
+
+   !  To avoid some tricky indexing, we fill in the values inside out.  This allows
+   !  us to overwrite incorrect assignments.  There are replicated assignments, and
+   !  there is much unnecessary "IF test inside of a loop" stuff.  For a large
+   !  domain, this is only a patch; for a small domain, this is not a biggy.
+
+   r_blend_zones = 1./(blend_width+1)
+   DO j = jps , MIN(jpe, jde-1)
+      DO k = kps , kpe
+         DO i = ips , MIN(ipe, ide-1)
+            DO blend_cell = blend_width,1,-1
+               IF   ( ( i .EQ.       spec_bdy_width + blend_cell ) .OR.  ( j .EQ.       spec_bdy_width + blend_cell ) .OR. &
+                      ( i .EQ. ide - spec_bdy_width - blend_cell ) .OR.  ( j .EQ. jde - spec_bdy_width - blend_cell ) ) THEN
+                  ter_temp(i,k,j) = ( (blend_cell)*ter_input(i,k,j) + (blend_width+1-blend_cell)*ter_interpolated(i,k,j) ) &
+                                    * r_blend_zones
+               END IF
+            ENDDO
+            IF      ( ( i .LE.       spec_bdy_width     ) .OR.  ( j .LE.       spec_bdy_width     ) .OR. &
+                      ( i .GE. ide - spec_bdy_width     ) .OR.  ( j .GE. jde - spec_bdy_width     ) ) THEN
+               ter_temp(i,k,j) =      ter_interpolated(i,k,j)
+            END IF
+         END DO 
+      END DO 
+   END DO 
+
+   !  Set nest elevation with temp values.  All values not overwritten in the above
+   !  loops have been previously set in the initial assignment.
+
+   DO j = jps , MIN(jpe, jde-1)
+      DO k = kps , kpe
+         DO i = ips , MIN(ipe, ide-1)
+            ter_input(i,k,j) = ter_temp(i,k,j)
+         END DO 
+      END DO 
+   END DO 
+
+END SUBROUTINE blend_terrain
+
+SUBROUTINE store_terrain ( ter_interpolated , ter_input , &
+                           ids , ide , jds , jde , kds , kde , & 
+                           ims , ime , jms , jme , kms , kme , & 
+                           ips , ipe , jps , jpe , kps , kpe )
+
+   IMPLICIT NONE
+
+   INTEGER , INTENT(IN)                       :: ids , ide , jds , jde , kds , kde , & 
+                                                 ims , ime , jms , jme , kms , kme , & 
+                                                 ips , ipe , jps , jpe , kps , kpe
+   REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT) :: ter_interpolated
+   REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)  :: ter_input
+
+   INTEGER :: i , j , k
+
+   DO j = jps , MIN(jpe, jde-1)
+      DO k = kps , kpe
+         DO i = ips , MIN(ipe, ide-1)
+            ter_interpolated(i,k,j) = ter_input(i,k,j)
+         END DO 
+      END DO 
+   END DO 
+
+END SUBROUTINE store_terrain
+
+
+SUBROUTINE input_terrain_rsmas ( grid ,                        &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           ips , ipe , jps , jpe , kps , kpe )
+
+   USE module_domain
+   IMPLICIT NONE
+   TYPE ( domain ) :: grid
+
+   INTEGER , INTENT(IN)                       :: ids , ide , jds , jde , kds , kde , &
+                                                 ims , ime , jms , jme , kms , kme , &
+                                                 ips , ipe , jps , jpe , kps , kpe
+
+   LOGICAL, EXTERNAL ::  wrf_dm_on_monitor
+
+   INTEGER :: i , j , k , myproc
+   INTEGER, DIMENSION(256) :: ipath  ! array for integer coded ascii for passing path down to get_terrain
+   CHARACTER*256 :: message, message2
+   CHARACTER*256 :: rsmas_data_path
+
+#if DM_PARALLEL
+! Local globally sized arrays
+   REAL , DIMENSION(ids:ide,jds:jde) :: ht_g, xlat_g, xlon_g
+#endif
+
+   CALL wrf_get_myproc ( myproc ) 
+
+#if 0
+CALL domain_clock_get ( grid, current_timestr=message2 )
+WRITE ( message , FMT = '(A," HT before ",I3)' ) TRIM(message2), grid%id
+write(30+myproc,*)ipe-ips+1,jpe-jps+1,trim(message)
+do j = jps,jpe
+do i = ips,ipe
+write(30+myproc,*)grid%ht(i,j)
+enddo
+enddo
+#endif
+
+   CALL nl_get_rsmas_data_path(1,rsmas_data_path)
+   do i = 1, LEN(TRIM(rsmas_data_path))
+      ipath(i) = ICHAR(rsmas_data_path(i:i))
+   enddo
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+
+   CALL wrf_patch_to_global_real ( grid%xlat , xlat_g , grid%domdesc, ' ' , 'xy' ,       &
+                                   ids, ide-1 , jds , jde-1 , 1 , 1 , &
+                                   ims, ime   , jms , jme   , 1 , 1 , &
+                                   ips, ipe   , jps , jpe   , 1 , 1   ) 
+   CALL wrf_patch_to_global_real ( grid%xlong , xlon_g , grid%domdesc, ' ' , 'xy' ,       &
+                                   ids, ide-1 , jds , jde-1 , 1 , 1 , &
+                                   ims, ime   , jms , jme   , 1 , 1 , &
+                                   ips, ipe   , jps , jpe   , 1 , 1   ) 
+
+   IF ( wrf_dm_on_monitor() ) THEN
+     CALL get_terrain ( grid%dx/1000., xlat_g(ids:ide,jds:jde), xlon_g(ids:ide,jds:jde), ht_g(ids:ide,jds:jde), &
+                        ide-ids+1,jde-jds+1,ide-ids+1,jde-jds+1, ipath, LEN(TRIM(rsmas_data_path)) )
+     WHERE ( ht_g(ids:ide,jds:jde) < -1000. ) ht_g(ids:ide,jds:jde) = 0.
+   ENDIF
+
+   CALL wrf_global_to_patch_real ( ht_g , grid%ht , grid%domdesc, ' ' , 'xy' ,         &
+                                   ids, ide-1 , jds , jde-1 , 1 , 1 , &
+                                   ims, ime   , jms , jme   , 1 , 1 , &
+                                   ips, ipe   , jps , jpe   , 1 , 1   ) 
+#else
+
+   CALL get_terrain ( grid%dx/1000., grid%xlat(ids:ide,jds:jde), grid%xlong(ids:ide,jds:jde), grid%ht(ids:ide,jds:jde), &
+                       ide-ids+1,jde-jds+1,ide-ids+1,jde-jds+1, ipath, LEN(TRIM(rsmas_data_path)) )
+   WHERE ( grid%ht(ids:ide,jds:jde) < -1000. ) grid%ht(ids:ide,jds:jde) = 0.
+
+#endif
+
+#if 0
+CALL domain_clock_get ( grid, current_timestr=message2 )
+WRITE ( message , FMT = '(A," HT after ",I3)' ) TRIM(message2), grid%id
+write(30+myproc,*)ipe-ips+1,jpe-jps+1,trim(message)
+do j = jps,jpe
+do i = ips,ipe
+write(30+myproc,*)grid%ht(i,j)
+enddo
+enddo
+#endif
+                       
+END SUBROUTINE input_terrain_rsmas
+
+SUBROUTINE update_after_feedback_em ( grid  &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+!
+! perform core specific updates, exchanges after
+! model feedback  (called from med_feedback_domain) -John
+!
+
+! Driver layer modules
+   USE module_domain
+   USE module_configure
+   USE module_driver_constants
+   USE module_machine
+   USE module_tiles
+   USE module_dm
+   USE module_bc
+! Mediation layer modules
+! Registry generated module
+   USE module_state_description
+
+   IMPLICIT NONE
+
+   !  Subroutine interface block.
+
+   TYPE(domain) , TARGET         :: grid
+
+   !  Definitions of dummy arguments
+#include <em_dummy_new_decl.inc>
+
+   INTEGER                         :: ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      ips , ipe , jps , jpe , kps , kpe
+
+  CALL wrf_debug( 500, "entering update_after_feedback_em" )
+
+#ifdef DM_PARALLEL
+#    define REGISTER_I1
+#      include <em_data_calls.inc>
+#endif
+
+!  Obtain dimension information stored in the grid data structure.
+  CALL get_ijk_from_grid (  grid ,                   &
+                            ids, ide, jds, jde, kds, kde,    &
+                            ims, ime, jms, jme, kms, kme,    &
+                            ips, ipe, jps, jpe, kps, kpe    )
+
+  CALL wrf_debug( 500, "before HALO_EM_FEEDBACK.inc in update_after_feedback_em" )
+#ifdef DM_PARALLEL
+#include "HALO_EM_FEEDBACK.inc"
+#endif
+  CALL wrf_debug( 500, "leaving update_after_feedback_em" )
+
+END SUBROUTINE update_after_feedback_em
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/shift_domain_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/shift_domain_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/shift_domain_em.F	(revision 2744)
@@ -0,0 +1,137 @@
+SUBROUTINE shift_domain_em ( grid , disp_x, disp_y &
+!
+# include <em_dummy_new_args.inc>
+!
+                           )
+   USE module_domain
+   USE module_timing
+   USE module_configure
+   USE module_dm
+   USE module_timing
+   IMPLICIT NONE
+  ! Arguments
+   INTEGER disp_x, disp_y       ! number of parent domain points to move
+   TYPE(domain) , POINTER                     :: grid
+  ! Local 
+   INTEGER i, j, ii
+   INTEGER px, py       ! number and direction of nd points to move
+   INTEGER                         :: ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      ips , ipe , jps , jpe , kps , kpe
+   TYPE (grid_config_rec_type)  :: config_flags
+
+   INTERFACE
+       ! need to split this routine to avoid clobbering certain widely used compilers
+       SUBROUTINE shift_domain_em2 ( grid , disp_x, disp_y &
+!
+# include <em_dummy_new_args.inc>
+!
+                           )
+          USE module_domain
+          USE module_timing
+          USE module_configure
+          USE module_dm
+          USE module_timing
+          IMPLICIT NONE
+         ! Arguments
+          INTEGER disp_x, disp_y       ! number of parent domain points to move
+          TYPE(domain) , POINTER                     :: grid
+          TYPE (grid_config_rec_type)  :: config_flags
+
+          !  Definitions of dummy arguments to solve
+#include <em_dummy_new_decl.inc>
+       END SUBROUTINE shift_domain_em2
+   END INTERFACE
+
+   !  Definitions of dummy arguments to solve
+#include <em_dummy_new_decl.inc>
+
+#ifdef MOVE_NESTS
+#ifdef DM_PARALLEL
+#      include <em_data_calls.inc>
+#endif
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+   CALL get_ijk_from_grid (  grid ,                   &
+                             ids, ide, jds, jde, kds, kde,    &
+                             ims, ime, jms, jme, kms, kme,    &
+                             ips, ipe, jps, jpe, kps, kpe    )
+
+   px = isign(config_flags%parent_grid_ratio,disp_x)
+   py = isign(config_flags%parent_grid_ratio,disp_y)
+
+   grid%imask_nostag = 1
+   grid%imask_xstag = 1
+   grid%imask_ystag = 1
+   grid%imask_xystag = 1
+
+   grid%imask_nostag(ips:min(ide-1,ipe),jps:min(jde-1,jpe)) = 0
+   grid%imask_xstag(ips:ipe,jps:min(jde-1,jpe)) = 0
+   grid%imask_ystag(ips:min(ide-1,ipe),jps:jpe) = 0
+   grid%imask_xystag(ips:ipe,jps:jpe) = 0
+
+! shift the nest domain in x
+   do ii = 1,abs(disp_x)
+#include <em_shift_halo_x.inc>
+   enddo
+
+   CALL shift_domain_em2 ( grid , disp_x, disp_y &
+!
+# include <em_dummy_new_args.inc>
+!
+                           )
+
+#endif
+
+END SUBROUTINE shift_domain_em
+
+SUBROUTINE shift_domain_em2 ( grid , disp_x, disp_y &
+!
+# include <em_dummy_new_args.inc>
+!
+                           )
+   USE module_domain
+   USE module_timing
+   USE module_configure
+   USE module_dm
+   USE module_timing
+   IMPLICIT NONE
+  ! Arguments
+   INTEGER disp_x, disp_y       ! number of parent domain points to move
+   TYPE(domain) , POINTER                     :: grid
+  ! Local 
+   INTEGER i, j, ii
+   INTEGER px, py       ! number and direction of nd points to move
+   INTEGER                         :: ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      ips , ipe , jps , jpe , kps , kpe
+   TYPE (grid_config_rec_type)  :: config_flags
+
+   !  Definitions of dummy arguments to solve
+#include <em_dummy_new_decl.inc>
+
+#ifdef MOVE_NESTS
+
+#ifdef DM_PARALLEL
+#      include <em_data_calls.inc>
+#endif
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+   CALL get_ijk_from_grid (  grid ,                   &
+                             ids, ide, jds, jde, kds, kde,    &
+                             ims, ime, jms, jme, kms, kme,    &
+                             ips, ipe, jps, jpe, kps, kpe    )
+
+   px = isign(config_flags%parent_grid_ratio,disp_x)
+   py = isign(config_flags%parent_grid_ratio,disp_y)
+
+! shift the nest domain in y
+   do ii = 1,abs(disp_y)
+#include <em_shift_halo_y.inc>
+   enddo
+
+#endif
+END SUBROUTINE shift_domain_em2
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em/solve_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/solve_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/solve_em.F	(revision 2744)
@@ -0,0 +1,3596 @@
+!WRF:MEDIATION_LAYER:SOLVER
+
+SUBROUTINE solve_em ( grid , config_flags  &
+! Actual arguments generated from Registry
+#include "em_dummy_new_args.inc"
+!
+                    )
+
+! Driver layer modules
+   USE module_domain
+   USE module_configure
+   USE module_driver_constants
+   USE module_machine
+   USE module_tiles
+   USE module_dm
+! Mediation layer modules
+! Model layer modules
+   USE module_model_constants
+   USE module_small_step_em
+   USE module_em
+   USE module_big_step_utilities_em
+   USE module_bc
+   USE module_bc_em
+   USE module_solvedebug_em
+   USE module_physics_addtendc
+   USE module_diffusion_em
+! Registry generated module
+   USE module_state_description
+!!!******MARS MARS
+!!!******MARS MARS
+!!!******MARS MARS
+!   USE module_radiation_driver
+!   USE module_surface_driver
+!   USE module_cumulus_driver
+!   USE module_microphysics_driver
+!   USE module_microphysics_zero_out
+!   USE module_pbl_driver
+!   USE module_fddagd_driver
+!   USE module_fddaobs_driver
+!   USE module_diagnostics
+!****MARS
+! in the dyn_em folder physics driver are only used here
+   USE module_lmd_driver
+!****MARS
+#ifdef WRF_CHEM
+   USE module_input_chem_data
+   USE module_chem_utilities
+#endif
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(domain) , TARGET          :: grid
+
+   !  Definitions of dummy arguments to this routine (generated from Registry).
+#include "em_dummy_new_decl.inc"
+
+   !  Structure that contains run-time configuration (namelist) data for domain
+   TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
+
+   ! Local data
+
+   INTEGER                         :: k_start , k_end, its, ite, jts, jte
+   INTEGER                         :: ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      ips , ipe , jps , jpe , kps , kpe
+   INTEGER                         :: ij , iteration
+   INTEGER                         :: im , num_3d_m , ic , num_3d_c , is , num_3d_s
+   INTEGER                         :: loop
+   INTEGER                         :: ijds, ijde
+   INTEGER                         :: sz
+
+   LOGICAL                         :: specified_bdy, channel_bdy
+
+
+! storage for tendencies and decoupled state (generated from Registry)
+
+#include <em_i1_decl.inc>
+! Previous time level of tracer arrays now defined as i1 variables;
+! the state 4d arrays now redefined as 1-time level arrays in Registry.
+! Benefit: save memory in nested runs, since only 1 domain is active at a
+! time.  Potential problem on stack-limited architectures: increases
+! amount of data on program stack by making these automatic arrays.
+
+   INTEGER :: rc 
+   INTEGER :: number_of_small_timesteps, rk_step
+   INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2    ! for prints/plots only
+   INTEGER :: idum1, idum2, dynamics_option
+
+   INTEGER :: rk_order, iwmax, jwmax, kwmax
+   REAL :: dt_rk, dts_rk, dtm, wmax
+   INTEGER :: l,kte,kk
+
+! urban related variables
+   INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS   ! urban
+
+! Define benchmarking timers if -DBENCH is compiled
+#include <bench_solve_em_def.h>
+
+!----------------------
+! Executable statements
+!----------------------
+
+! Needed by some comm layers, grid%e.g. RSL. If needed, nmm_data_calls.inc is
+! generated from the registry.  The definition of REGISTER_I1 allows
+! I1 data to be communicated in this routine if necessary.
+#ifdef DM_PARALLEL
+#    define REGISTER_I1
+#      include "em_data_calls.inc"
+#endif
+
+!<DESCRIPTION>
+!<pre>
+! solve_em is the main driver for advancing a grid a single timestep.
+! It is a mediation-layer routine -> DM and SM calls are made where 
+! needed for parallel processing.  
+!
+! solve_em can integrate the equations using 3 time-integration methods
+!      
+!    - 3rd order Runge-Kutta time integration (recommended)
+!      
+!    - 2nd order Runge-Kutta time integration
+!      
+! The main sections of solve_em are
+!     
+! (1) Runge-Kutta (RK) loop
+!     
+! (2) Non-timesplit physics (i.grid%e., tendencies computed for updating
+!     model state variables during the first RK sub-step (loop)
+!     
+! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
+!     
+! (4) scalar advance for moist and chem scalar variables (and TKE)
+!     within the RK sub-steps.
+!     
+! (5) time-split physics (after the RK step), currently this includes
+!     only microphyics
+!
+! A more detailed description of these sections follows.
+!</pre>
+!</DESCRIPTION>
+
+! Initialize timers if compiled with -DBENCH
+#include <bench_solve_em_init.h>
+
+!  set runge-kutta solver (2nd or 3rd order)
+
+   dynamics_option = config_flags%rk_ord
+
+!  Obtain dimension information stored in the grid data structure.
+  CALL get_ijk_from_grid (  grid ,                   &
+                            ids, ide, jds, jde, kds, kde,    &
+                            ims, ime, jms, jme, kms, kme,    &
+                            ips, ipe, jps, jpe, kps, kpe    )
+
+  k_start         = kps
+  k_end           = kpe
+
+  ijds = min(ids, jds)
+  ijde = max(ide, jde)
+
+  num_3d_m        = num_moist
+  num_3d_c        = num_chem
+  num_3d_s        = num_scalar
+
+!  Compute these starting and stopping locations for each tile and number of tiles.
+!  See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
+  CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
+!print *,grid%julian,grid%julday,' grid%julian,grid%julday in solve'
+
+  grid%itimestep = grid%itimestep + 1
+
+!**********************************************************************
+!
+!  LET US BEGIN.......
+!
+!<DESCRIPTION>
+!<pre>
+! (1) RK integration loop is named the "Runge_Kutta_loop:"
+!
+!   Predictor-corrector type time integration.
+!   Advection terms are evaluated at time t for the predictor step,
+!   and advection is re-evaluated with the latest predicted value for
+!   each succeeding time corrector step
+!
+!   2nd order Runge Kutta (rk_order = 2):
+!   Step 1 is taken to the midpoint predictor, step 2 is the full step.
+!
+!   3rd order Runge Kutta (rk_order = 3):
+!   Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
+!   and step 3 is from t to dt.
+!
+!   non-timesplit physics are evaluated during first RK step and
+!   these physics tendencies are stored for use in each RK pass.
+!</pre>
+!</DESCRIPTION>
+!**********************************************************************
+
+#ifdef WRF_CHEM
+!
+!    prepare chem aerosols for advection before communication
+!
+
+   kte=min(k_end,kde-1)
+# ifdef DM_PARALLEL
+   if ( num_chem >= PARAM_FIRST_SCALAR ) then
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_CHEM_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_CHEM_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   endif
+# endif
+!--------------------------------------------------------------
+#endif
+
+ rk_order = config_flags%rk_ord
+ IF (grid%time_step_sound == 0) THEN
+! auto-set option
+! This function will give 4 for 6*dx and 6 for 10*dx and returns even numbers only
+   grid%time_step_sound = max ( 2 * ( INT (300.*grid%dt/grid%dx-0.01) + 1 ), 4 )
+   WRITE(wrf_err_message,*)'dx, dt, time_step_sound=',grid%dx,grid%dt,grid%time_step_sound
+   CALL wrf_debug ( 50 , wrf_err_message )
+ ENDIF
+
+ grid%dts = grid%dt/float(grid%time_step_sound)
+
+ Runge_Kutta_loop:  DO rk_step = 1, rk_order
+
+   !  Set the step size and number of small timesteps for
+   !  each part of the timestep
+
+   dtm = grid%dt
+   IF ( rk_order == 1 ) THEN   
+
+      write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
+      CALL wrf_error_fatal( wrf_err_message )
+
+   ELSE IF ( rk_order == 2 ) THEN   ! 2nd order Runge-Kutta timestep
+
+       IF ( rk_step == 1) THEN
+             dt_rk  = 0.5*grid%dt
+             dts_rk = grid%dts
+             number_of_small_timesteps = grid%time_step_sound/2
+       ELSE
+             dt_rk = grid%dt
+             dts_rk = grid%dts
+             number_of_small_timesteps = grid%time_step_sound
+       ENDIF
+
+   ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
+
+       IF ( rk_step == 1) THEN
+            dt_rk = grid%dt/3.
+            dts_rk = dt_rk
+            number_of_small_timesteps = 1
+       ELSE IF (rk_step == 2) THEN
+            dt_rk  = 0.5*grid%dt
+            dts_rk = grid%dts
+            number_of_small_timesteps = grid%time_step_sound/2
+       ELSE
+            dt_rk = grid%dt
+            dts_rk = grid%dts
+            number_of_small_timesteps = grid%time_step_sound
+       ENDIF
+
+   ELSE
+
+      write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
+      CALL wrf_error_fatal( wrf_err_message )
+
+   END IF
+
+!
+!  Time level t is in the *_2 variable in the first part 
+!  of the step, and in the *_1 variable after the predictor.
+!  the latest predicted values are stored in the *_2 variables.
+!
+   CALL wrf_debug ( 200 , ' call rk_step_prep ' )
+
+BENCH_START(step_prep_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , grid%num_tiles
+
+      CALL rk_step_prep  ( config_flags, rk_step,            &
+                           grid%em_u_2, grid%em_v_2, grid%em_w_2, grid%em_t_2, grid%em_ph_2, grid%em_mu_2,   &
+                           moist,                            &
+                           grid%em_ru, grid%em_rv, grid%em_rw, grid%em_ww, grid%em_php, grid%em_alt, grid%em_muu, grid%em_muv,   &
+                           grid%em_mub, grid%em_mut, grid%em_phb, grid%em_pb, grid%em_p, grid%em_al, grid%em_alb,    &
+                           cqu, cqv, cqw,                    &
+                           grid%msfu, grid%msfv, grid%msft,                 &
+                           grid%em_fnm, grid%em_fnp, grid%em_dnw, grid%rdx, grid%rdy,          &
+                           num_3d_m,                         &
+                           ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           grid%i_start(ij), grid%i_end(ij), &
+                           grid%j_start(ij), grid%j_end(ij), &
+                           k_start, k_end                   )
+
+   END DO
+   !$OMP END PARALLEL DO
+BENCH_END(step_prep_tim)
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!  Note:  the small size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
+!         as state variables in the mass coordinate model, as
+!         opposed to the coupled variables as in the height
+!         coordinate model.
+!
+!                           * * * * *
+!         *        * * *    * * * * *
+!       * + *      * + *    * * + * * 
+!         *        * * *    * * * * *
+!                           * * * * *
+!
+!  3D variables - note staggering!  grid%em_ru(X), grid%em_rv(Y), grid%em_ww(grid%em_z), grid%em_php(grid%em_z)
+!
+!j grid%em_ru     x
+!j grid%em_rv     x
+!j grid%em_ww     x
+!j grid%em_php    x
+!j grid%em_alt    x
+!j grid%em_ph_2   x
+!j grid%em_phb    x
+!
+!  the following are 2D (xy) variables
+!
+!j grid%em_muu    x
+!j grid%em_muv    x
+!j grid%em_mut    x
+!--------------------------------------------------------------
+#    include "HALO_EM_A.inc"
+#endif
+
+! set boundary conditions on variables 
+! from big_step_prep for use in big_step_proc
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_A.inc"
+#endif
+
+!   CALL set_tiles ( grid , ids , ide , jds , jde , ips-1 , ipe+1 , jps-1 , jpe+1 )
+
+BENCH_START(set_phys_bc_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
+
+        CALL rk_phys_bc_dry_1( config_flags, grid%em_ru, grid%em_rv, grid%em_rw, grid%em_ww,      & 
+                               grid%em_muu, grid%em_muv, grid%em_mut, grid%em_php, grid%em_alt, grid%em_p,        &
+                               ids, ide, jds, jde, kds, kde,      &
+                               ims, ime, jms, jme, kms, kme,      &
+                               ips, ipe, jps, jpe, kps, kpe,      &
+                               grid%i_start(ij), grid%i_end(ij),  &
+                               grid%j_start(ij), grid%j_end(ij),  &
+                               k_start, k_end                )
+       !TBH:  need this 2nd timestep and later
+       CALL set_physical_bc3d( grid%em_al, 'p', config_flags,            &
+                               ids, ide, jds, jde, kds, kde,     &
+                               ims, ime, jms, jme, kms, kme,     &
+                               ips, ipe, jps, jpe, kps, kpe,     &
+                               grid%i_start(ij), grid%i_end(ij), &
+                               grid%j_start(ij), grid%j_end(ij), &
+                               k_start    , k_end               )
+       CALL set_physical_bc3d( grid%em_ph_2, 'w', config_flags,            &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                               grid%i_start(ij), grid%i_end(ij),        &
+                               grid%j_start(ij), grid%j_end(ij),        &
+                               k_start, k_end                )
+
+   END DO
+   !$OMP END PARALLEL DO
+BENCH_END(set_phys_bc_tim)
+
+    rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
+
+ ! initialize all tendencies to zero in order to update physics
+ ! tendencies first (separate from dry dynamics).
+ 
+BENCH_START(init_zero_tend_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+
+     DO ij = 1 , grid%num_tiles
+
+        CALL wrf_debug ( 200 , ' call init_zero_tendency' )
+        CALL init_zero_tendency ( ru_tendf, rv_tendf, rw_tendf,     &
+                                  ph_tendf, t_tendf, tke_tend,      &
+                                  mu_tendf,                         &
+                                  moist_tend,chem_tend,scalar_tend, &
+                                  num_3d_m,num_3d_c,num_3d_s,       &
+                                  rk_step,                          &
+                                  ids, ide, jds, jde, kds, kde,     &
+                                  ims, ime, jms, jme, kms, kme,     &
+                                  grid%i_start(ij), grid%i_end(ij), &
+                                  grid%j_start(ij), grid%j_end(ij), &
+                                  k_start, k_end                   )
+
+     END DO
+   !$OMP END PARALLEL DO
+BENCH_END(init_zero_tend_tim)
+
+#ifdef DM_PARALLEL
+#     include "HALO_EM_PHYS_A.inc"
+#endif
+
+!<DESCRIPTION>
+!<pre>
+!(2) The non-timesplit physics begins with a call to "phy_prep"
+!    (which computes some diagnostic variables such as temperature,
+!    pressure, u and v at grid%em_p points, etc).  This is followed by
+!    calls to the physics drivers:
+!
+!              radiation,
+!              surface,
+!              pbl,
+!              cumulus,
+!              3D TKE and mixing.
+!<pre>
+!</DESCRIPTION>
+
+
+BENCH_START(phy_prep_tim)
+      !$OMP PARALLEL DO   &
+      !$OMP PRIVATE ( ij )
+      DO ij = 1 , grid%num_tiles
+
+         CALL wrf_debug ( 200 , ' call phy_prep' )
+         CALL phy_prep ( config_flags,                           &
+                         grid%em_mut, grid%em_muu, grid%em_muv, grid%em_u_2, &
+                         grid%em_v_2, grid%em_w_2, grid%em_p, grid%em_pb, grid%em_alt,              &
+                         grid%em_ph_2, grid%em_phb, grid%em_t_2, grid%tsk, moist, num_3d_m,   &
+                         mu_3d, rho,                             &
+                         th_phy, p_phy, pi_phy, u_phy, v_phy, w_phy,    &
+                         p8w, t_phy, t8w, grid%em_z, z_at_w,             &
+                         dz8w, grid%em_fnm, grid%em_fnp,                         &    
+                         grid%rthraten,                               &
+                         grid%rthblten, grid%rublten, grid%rvblten,             &
+                         grid%rqvblten, grid%rqcblten, grid%rqiblten,           &
+                         grid%rthcuten, grid%rqvcuten, grid%rqccuten,           &
+                         grid%rqrcuten, grid%rqicuten, grid%rqscuten,           &
+                         grid%rthften,  grid%rqvften,                      &
+                         grid%RUNDGDTEN, grid%RVNDGDTEN, grid%RTHNDGDTEN,       &
+                         grid%RQVNDGDTEN, grid%RMUNDGDTEN,                 &
+                         ids, ide, jds, jde, kds, kde,           &
+                         ims, ime, jms, jme, kms, kme,           &
+                         grid%i_start(ij), grid%i_end(ij),       &
+                         grid%j_start(ij), grid%j_end(ij),       &
+                         k_start, k_end                         )
+      ENDDO
+      !$OMP END PARALLEL DO
+
+
+BENCH_END(phy_prep_tim)
+
+!  physics to implement
+
+!      CALL set_tiles ( grid , ids , ide-1 , jds , jde-1 ips , ipe , jps , jpe )
+
+! Open MP loops are in physics drivers
+! radiation
+
+!-----------------------------------------------------------------
+! urban related variable are added to arguments of radiation_driver
+!-----------------------------------------------------------------
+
+!!!******MARS MARS
+!!!******MARS MARS
+!!!******MARS MARS
+
+
+!         CALL wrf_debug ( 200 , ' call radiation_driver' )
+!BENCH_START(rad_driver_tim)
+!
+!         CALL radiation_driver(                                           &
+!     &         ACFRCV=grid%acfrcv      ,ACFRST=grid%acfrst      ,ALBEDO=grid%albedo      &
+!     &        ,CFRACH=grid%cfrach      ,CFRACL=grid%cfracl      ,CFRACM=grid%cfracm      &
+!     &        ,CUPPT=grid%cuppt        ,CZMEAN=grid%czmean      ,DT=grid%dt              &
+!     &        ,DZ8W=dz8w          ,EMISS=grid%emiss        ,GLW=grid%glw            &
+!     &        ,GMT=grid%gmt            ,GSW=grid%gsw            ,HBOT=grid%hbot          &
+!     &        ,HTOP=grid%htop ,HBOTR=grid%hbotr, HTOPR=grid%htopr ,ICLOUD=config_flags%icloud &
+!     &        ,ITIMESTEP=grid%itimestep,JULDAY=grid%julday, JULIAN=grid%julian      &
+!     &        ,JULYR=grid%julyr        ,LW_PHYSICS=config_flags%ra_lw_physics  &
+!     &        ,NCFRCV=grid%ncfrcv      ,NCFRST=grid%ncfrst      ,NPHS=1             &
+!     &        ,P8W=p8w            ,P=p_phy            ,PI=pi_phy          &
+!     &        ,RADT=grid%radt     ,RA_CALL_OFFSET=grid%ra_call_offset     &
+!     &        ,RHO=rho            ,RLWTOA=grid%rlwtoa                          &
+!     &        ,RSWTOA=grid%rswtoa      ,RTHRATEN=grid%rthraten                      &
+!     &        ,RTHRATENLW=grid%rthratenlw                                      &
+!     &        ,RTHRATENSW=grid%rthratensw                  ,SNOW=grid%snow          &
+!     &        ,STEPRA=grid%stepra      ,SWDOWN=grid%swdown      ,SWDOWNC=grid%swdownc    &
+!     &        ,SW_PHYSICS=config_flags%ra_sw_physics  ,T8W=t8w            &
+!     &        ,T=t_phy            ,TAUCLDC=grid%taucldc    ,TAUCLDI=grid%taucldi    &
+!     &        ,TSK=grid%tsk            ,VEGFRA=grid%vegfra     ,WARM_RAIN=grid%warm_rain &
+!     &        ,XICE=grid%xice                                                  &
+!     &        ,XLAND=grid%xland        ,XLAT=grid%xlat          ,XLONG=grid%xlong        &
+!!Optional urban
+!     &        ,DECLIN_URB=grid%declin_urb        ,COSZ_URB2D=grid%cosz_urb2d        &
+!     &        ,OMG_URB2D=grid%omg_urb2d                                        &
+!!
+!     &        ,Z=grid%em_z                                                        &
+!     &        ,LEVSIZ=grid%levsiz, N_OZMIXM=num_ozmixm                    &
+!     &        ,N_AEROSOLC=num_aerosolc                                    &
+!     &        ,PAERLEV=grid%paerlev                                       &
+!     &        ,CAM_ABS_DIM1=grid%cam_abs_dim1, CAM_ABS_DIM2=grid%cam_abs_dim2 &
+!     &        ,CAM_ABS_FREQ_S=grid%cam_abs_freq_s                         &
+!     &        ,XTIME=grid%xtime                                                &
+!            ! indexes
+!     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+!     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+!     &        ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1)          &
+!     &        ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1)          &
+!     &        ,kts=k_start, kte=min(k_end,kde-1)                          &
+!     &        ,num_tiles=grid%num_tiles                                   &
+!            ! Optional                          
+!     &        , CLDFRA=grid%cldfra                                             &
+!     &        , PB=grid%em_pb                                                     &
+!     &        , F_ICE_PHY=grid%f_ice_phy,F_RAIN_PHY=grid%f_rain_phy                 &
+!     &        , QV=moist(ims,kms,jms,P_QV), F_QV=F_QV                     &
+!     &        , QC=moist(ims,kms,jms,P_QC), F_QC=F_QC                                        &
+!     &        , QR=moist(ims,kms,jms,P_QR), F_QR=F_QR                     &
+!     &        , QI=moist(ims,kms,jms,P_QI), F_QI=F_QI                                        &
+!     &        , QS=moist(ims,kms,jms,P_QS), F_QS=F_QS                     &
+!     &        , QG=moist(ims,kms,jms,P_QG), F_QG=F_QG                     &
+!#ifdef ACFLUX
+!     &        ,ACSWUPT=acswupt    ,ACSWUPTC=acswuptc                      &
+!     &        ,ACSWDNT=acswdnt    ,ACSWDNTC=acswdntc                      &
+!     &        ,ACSWUPB=acswupb    ,ACSWUPBC=acswupbc                      &
+!     &        ,ACSWDNB=acswdnb    ,ACSWDNBC=acswdnbc                      &
+!     &        ,ACLWUPT=aclwupt    ,ACLWUPTC=aclwuptc                      &
+!     &        ,ACLWDNT=aclwdnt    ,ACLWDNTC=aclwdntc                      &
+!     &        ,ACLWUPB=aclwupb    ,ACLWUPBC=aclwupbc                      &
+!     &        ,ACLWDNB=aclwdnb    ,ACLWDNBC=aclwdnbc                      &
+!     &        ,SWUPT=swupt    ,SWUPTC=swuptc                              &
+!     &        ,SWDNT=swdnt    ,SWDNTC=swdntc                              &
+!     &        ,SWUPB=swupb    ,SWUPBC=swupbc                              &
+!     &        ,SWDNB=swdnb    ,SWDNBC=swdnbc                              &
+!     &        ,LWUPT=lwupt    ,LWUPTC=lwuptc                              &
+!     &        ,LWDNT=lwdnt    ,LWDNTC=lwdntc                              &
+!     &        ,LWUPB=lwupb    ,LWUPBC=lwupbc                              &
+!     &        ,LWDNB=lwdnb    ,LWDNBC=lwdnbc                              &
+!#endif
+!     &        ,LWCF=grid%lwcf                                                  &
+!     &        ,SWCF=grid%swcf                                                  &
+!     &        ,OLR=grid%olr                                                    &
+!     &        ,OZMIXM=grid%ozmixm, PIN=grid%pin                                     &
+!     &        ,M_PS_1=grid%m_ps_1, M_PS_2=grid%m_ps_2, AEROSOLC_1=grid%aerosolc_1        &
+!     &        ,AEROSOLC_2=grid%aerosolc_2, M_HYBI0=grid%m_hybi                      &
+!     &        ,ABSTOT=grid%abstot, ABSNXT=grid%absnxt, EMSTOT=grid%emstot                &
+!#ifdef WRF_CHEM
+!     &        ,QC_ADJUST=grid%GD_CLOUD , QI_ADJUST=grid%GD_CLOUD2         &
+!     &        ,PM2_5_DRY=grid%pm2_5_dry, PM2_5_WATER=grid%pm2_5_water               &
+!     &        ,PM2_5_DRY_EC=grid%pm2_5_dry_ec                                  &
+!     &        ,TAUAER300=grid%tauaer1, TAUAER400=grid%tauaer2 & ! jcb
+!     &        ,TAUAER600=grid%tauaer3, TAUAER999=grid%tauaer4 & ! jcb
+!     &        ,GAER300=grid%gaer1, GAER400=grid%gaer2, GAER600=grid%gaer3, GAER999=grid%gaer4 & ! jcb
+!     &        ,WAER300=grid%waer1, WAER400=grid%waer2, WAER600=grid%waer3, WAER999=grid%waer4 & ! jcb
+!#endif
+!     &                                                              )
+!
+!BENCH_END(rad_driver_tim)
+!
+!!********* Surface driver
+!! surface
+!
+!BENCH_START(surf_driver_tim)
+!
+!!-----------------------------------------------------------------
+!! urban related variable are added to arguments of surface_driver
+!!-----------------------------------------------------------------
+!      NUM_ROOF_LAYERS = grid%num_soil_layers !urban
+!      NUM_WALL_LAYERS = grid%num_soil_layers !urban
+!      NUM_ROAD_LAYERS = grid%num_soil_layers !urban
+!
+!      CALL wrf_debug ( 200 , ' call surface_driver' )
+!      CALL surface_driver(                                                &
+!     &         ACSNOM=grid%acsnom      ,ACSNOW=grid%acsnow      ,AKHS=grid%akhs          &
+!     &        ,AKMS=grid%akms          ,ALBBCK=grid%albbck      ,ALBEDO=grid%albedo      &
+!     &        ,BR=br              ,CANWAT=grid%canwat      ,CHKLOWQ=chklowq    &
+!     &        ,CT=grid%ct              ,DT=grid%dt         ,DX=grid%dx         &
+!     &        ,DZ8W=dz8w          ,DZS=grid%dzs            ,FLHC=grid%flhc          &
+!     &        ,FLQC=grid%flqc          ,GLW=grid%glw            ,GRDFLX=grid%grdflx      &
+!     &        ,GSW=grid%gsw    ,SWDOWN=grid%swdown        ,GZ1OZ0=gz1oz0      ,HFX=grid%hfx              &
+!     &        ,HT=grid%ht              ,IFSNOW=config_flags%ifsnow      ,ISFFLX=config_flags%isfflx      &
+!     &        ,ISLTYP=grid%isltyp      ,ITIMESTEP=grid%itimestep                    &
+!     &        ,IVGTYP=grid%ivgtyp      ,LH=grid%lh              ,LOWLYR=grid%lowlyr      &
+!     &        ,MAVAIL=grid%mavail      ,NUM_SOIL_LAYERS=config_flags%num_soil_layers        &
+!     &        ,P8W=p8w            ,PBLH=grid%pblh          ,PI_PHY=pi_phy      &
+!     &        ,PSFC=grid%psfc          ,PSHLTR=pshltr      ,PSIH=psih          &
+!     &        ,PSIM=psim          ,P_PHY=p_phy        ,Q10=q10            &
+!     &        ,Q2=grid%q2              ,QFX=grid%qfx            ,QSFC=grid%qsfc          &
+!     &        ,QSHLTR=qshltr      ,QZ0=grid%qz0            ,RAINCV=grid%raincv      &
+!     &        ,RA_LW_PHYSICS=config_flags%ra_lw_physics            ,RHO=rho            &
+!     &        ,RMOL=grid%rmol          ,SFCEVP=grid%sfcevp      ,SFCEXC=grid%sfcexc      &
+!     &        ,SFCRUNOFF=grid%sfcrunoff                                        &
+!     &        ,SF_SFCLAY_PHYSICS=config_flags%sf_sfclay_physics                        &
+!     &        ,SF_SURFACE_PHYSICS=config_flags%sf_surface_physics  ,SH2O=grid%sh2o          &
+!     &        ,SHDMAX=grid%shdmax      ,SHDMIN=grid%shdmin      ,SMOIS=grid%smois        &
+!     &        ,SMSTAV=grid%smstav      ,SMSTOT=grid%smstot      ,SNOALB=grid%snoalb      &
+!     &        ,SNOW=grid%snow          ,SNOWC=grid%snowc        ,SNOWH=grid%snowh        &
+!     &        ,SST=grid%sst            ,SST_UPDATE=grid%sst_update                  &
+!     &        ,STEPBL=grid%stepbl      ,TH10=th10          ,TH2=grid%th2            &
+!     &        ,THZ0=grid%thz0          ,TH_PHY=th_phy      ,TKE_MYJ=grid%tke_myj    &
+!     &        ,TMN=grid%tmn            ,TSHLTR=tshltr      ,TSK=grid%tsk            &
+!     &        ,TSLB=grid%tslb          ,T_PHY=t_phy        ,U10=grid%u10            &
+!     &        ,URATX=grid%uratx        ,VRATX=grid%vratx   ,TRATX=grid%tratx        &
+!     &        ,UDRUNOFF=grid%udrunoff  ,UST=grid%ust       ,UZ0=grid%uz0            &
+!     &        ,U_FRAME=grid%u_frame    ,U_PHY=u_phy        ,V10=grid%v10            &
+!     &        ,VEGFRA=grid%vegfra      ,VZ0=grid%vz0       ,V_FRAME=grid%v_frame    &
+!     &        ,V_PHY=v_phy             ,WARM_RAIN=grid%warm_rain                    &
+!     &        ,WSPD=wspd               ,XICE=grid%xice     ,XLAND=grid%xland        &
+!     &        ,Z0=grid%z0              ,Z=grid%em_z        ,ZNT=grid%znt            &
+!     &        ,ZS=grid%zs                                                           &
+!     &        ,DECLIN_URB=grid%declin_urb  ,COSZ_URB2D=grid%cosz_urb2d    & !I urban
+!     &        ,OMG_URB2D=grid%omg_urb2d    ,xlat_urb2d=grid%XLAT          & !I urban
+!     &        ,NUM_ROOF_LAYERS=num_roof_layers                            & !I urban
+!     &        ,NUM_WALL_LAYERS=num_wall_layers                            & !I urban
+!     &        ,NUM_ROAD_LAYERS=num_road_layers                            &
+!     &        ,DZR=grid%dzr ,DZB=grid%dzb ,DZG=grid%dzg                   & !I urban
+!     &        ,TR_URB2D=grid%tr_urb2d ,TB_URB2D=grid%tb_urb2d             &
+!     &        ,TG_URB2D=grid%tg_urb2d                                     & !H urban
+!     &        ,TC_URB2D=grid%tc_urb2d ,QC_URB2D=grid%qc_urb2d             & !H urban
+!     &        ,UC_URB2D=grid%uc_urb2d                                     & !H urban
+!     &        ,XXXR_URB2D=grid%xxxr_urb2d                                 &
+!     &        ,XXXB_URB2D=grid%xxxb_urb2d                                 & !H urban
+!     &        ,XXXG_URB2D=grid%xxxg_urb2d                                 &
+!     &        ,XXXC_URB2D=grid%xxxc_urb2d                                 & !H urban
+!     &        ,TRL_URB3D=grid%trl_urb3d   ,TBL_URB3D=grid%tbl_urb3d       & !H urban
+!     &        ,TGL_URB3D=grid%tgl_urb3d                                   & !H urban
+!     &        ,SH_URB2D=grid%sh_urb2d     ,LH_URB2D=grid%lh_urb2d         &
+!     &        ,G_URB2D=grid%g_urb2d                                       & !H urban
+!     &        ,RN_URB2D=grid%rn_urb2d     , TS_URB2D=grid%ts_urb2d        & !H urban 
+!     &        ,FRC_URB2D=grid%frc_urb2d                                   & !H urban
+!     &        ,UTYPE_URB2D=grid%utype_urb2d                               & !H urban
+!     &        ,ucmcall=grid%ucmcall                                       & !H urban
+!           ! Indexes
+!     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+!     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+!     &        , I_START=grid%i_start,I_END=min(grid%i_end, ide-1)         &
+!     &        , J_START=grid%j_start,J_END=min(grid%j_end, jde-1)         &
+!     &        , KTS=k_start, KTE=min(k_end,kde-1)                         &
+!     &        , NUM_TILES=grid%num_tiles                                  &
+!           ! Optional
+!     &        ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV                 &
+!     &        ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC                 &
+!     &        ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR                 &
+!     &        ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI                 &
+!     &        ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS                 &
+!     &        ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG                 &
+!     &        ,CAPG=grid%capg, EMISS=grid%emiss, HOL=hol,MOL=grid%mol                    &
+!     &        ,RAINBL=grid%rainbl,SR=grid%em_sr                                              &
+!     &        ,RAINNCV=grid%rainncv,REGIME=regime,T2=grid%t2,THC=grid%thc                &
+!     &        ,QSG=grid%qsg,QVG=grid%qvg,QCG=grid%qcg,SOILT1=grid%soilt1,TSNAV=grid%tsnav          & ! ruc lsm
+!     &        ,SMFR3D=grid%smfr3d,KEEPFR3DFLAG=grid%keepfr3dflag                    & ! ruc lsm
+!     &        ,POTEVP=grid%em_POTEVP, SNOPCX=grid%em_SNOPCX, SOILTB=grid%em_SOILTB                & ! ruc lsm
+!     &                                                              )
+!BENCH_END(surf_driver_tim)
+!
+!!*********
+!! pbl
+!
+!      CALL wrf_debug ( 200 , ' call pbl_driver' )
+!BENCH_START(pbl_driver_tim)
+!      CALL pbl_driver(                                                    &
+!     &         AKHS=grid%akhs          ,AKMS=grid%akms                              &
+!     &        ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics                 &
+!     &        ,BR=br              ,CHKLOWQ=chklowq    ,CT=grid%ct              &
+!     &        ,DT=grid%dt              ,DX=grid%dx              ,DZ8W=dz8w          &
+!     &        ,EL_MYJ=grid%el_myj      ,EXCH_H=grid%exch_h      ,GRDFLX=grid%grdflx      &
+!     &        ,GZ1OZ0=gz1oz0      ,HFX=grid%hfx            ,HT=grid%ht              &
+!     &        ,ITIMESTEP=grid%itimestep                    ,KPBL=grid%kpbl          &
+!     &        ,LH=grid%lh              ,LOWLYR=grid%lowlyr      ,P8W=p8w            &
+!     &        ,PBLH=grid%pblh          ,PI_PHY=pi_phy      ,PSIH=psih          &
+!     &        ,PSIM=psim          ,P_PHY=p_phy        ,QFX=grid%qfx            &
+!     &        ,QSFC=grid%qsfc          ,QZ0=grid%qz0                                &
+!     &        ,RA_LW_PHYSICS=config_flags%ra_lw_physics                   &
+!     &        ,RHO=rho            ,RQCBLTEN=grid%rqcblten  ,RQIBLTEN=grid%rqiblten  &
+!     &        ,RQVBLTEN=grid%rqvblten  ,RTHBLTEN=grid%rthblten  ,RUBLTEN=grid%rublten    &
+!     &        ,RVBLTEN=grid%rvblten    ,SNOW=grid%snow          ,STEPBL=grid%stepbl      &
+!     &        ,THZ0=grid%thz0          ,TH_PHY=th_phy      ,TKE_MYJ=grid%tke_myj    &
+!     &        ,TSK=grid%tsk            ,T_PHY=t_phy        ,UST=grid%ust            &
+!     &        ,UZ0=grid%uz0            ,U_FRAME=grid%u_frame    ,U_PHY=u_phy        &
+!     &        ,VZ0=grid%vz0            ,V_FRAME=grid%v_frame    ,V_PHY=v_phy        &
+!     &        ,WARM_RAIN=grid%warm_rain                    ,WSPD=wspd          &
+!     &        ,XICE=grid%xice          ,XLAND=grid%xland        ,Z=grid%em_z                &
+!     &        ,ZNT=grid%znt                                                    &
+!     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+!     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+!     &        ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)          &
+!     &        ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)          &
+!     &        ,KTS=k_start, KTE=min(k_end,kde-1)                          &
+!     &        ,NUM_TILES=grid%num_tiles                                   &
+!          ! optional
+!     &        ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV                 &
+!     &        ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC                 &
+!     &        ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR                 &
+!     &        ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI                 &
+!     &        ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS                 &
+!     &        ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG                 &
+!     &        ,HOL=HOL, MOL=grid%mol, REGIME=REGIME                            &
+!     &                                                          )
+!
+!BENCH_END(pbl_driver_tim)
+!
+!! cumulus para.
+!
+!          CALL wrf_debug ( 200 , ' call cumulus_driver' )
+!
+!BENCH_START(cu_driver_tim)
+!         CALL cumulus_driver(                                             &
+!                 ! Prognostic variables
+!     &              U=u_phy   ,V=v_phy   ,TH=th_phy  ,T=t_phy             &
+!     &             ,W=grid%em_w_2     ,P=p_phy   ,PI=pi_phy  ,RHO=rho             &
+!                 ! Other arguments
+!     &             ,ITIMESTEP=grid%itimestep ,DT=grid%dt      ,DX=grid%dx                &
+!     &             ,RAINC=grid%rainc   ,RAINCV=grid%raincv   ,NCA=grid%nca               &
+!     &             ,HTOP=grid%cutop    ,HBOT=grid%cubot      ,KPBL=grid%kpbl             &
+!     &             ,DZ8W=dz8w     ,P8W=p8w                                &
+!     &             ,W0AVG=grid%w0avg   ,STEPCU=grid%stepcu                          &
+!     &             ,CLDEFI=grid%cldefi ,LOWLYR=grid%lowlyr ,XLAND=grid%xland             &
+!     &             ,APR_GR=grid%apr_gr ,APR_W=grid%apr_w   ,APR_MC=grid%apr_mc           &
+!     &             ,APR_ST=grid%apr_st ,APR_AS=grid%apr_as ,APR_CAPMA=grid%apr_capma     &
+!     &             ,APR_CAPME=grid%apr_capme          ,APR_CAPMI=grid%apr_capmi     &
+!     &             ,MASS_FLUX=grid%mass_flux          ,XF_ENS=grid%xf_ens           &
+!     &             ,PR_ENS=grid%pr_ens ,HT=grid%ht                                  &
+!     &             ,ENSDIM=config_flags%ensdim ,MAXIENS=config_flags%maxiens ,MAXENS=config_flags%maxens         &
+!     &             ,MAXENS2=config_flags%maxens2                ,MAXENS3=config_flags%maxens3       &
+!     &             ,CU_ACT_FLAG=cu_act_flag   ,WARM_RAIN=grid%warm_rain        &
+!     &             ,GSW=grid%gsw                                               &
+!                 ! Selection flag
+!     &             ,CU_PHYSICS=config_flags%cu_physics                    &
+!                 ! Dimension arguments
+!     &             ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde     &
+!     &             ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme     &
+!     &             ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)     &
+!     &             ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)     &
+!     &             ,KTS=k_start, KTE=min(k_end,kde-1)                     &
+!     &             ,NUM_TILES=grid%num_tiles                              &
+!                 ! Moisture tendency arguments
+!     &             ,RQVCUTEN=grid%rqvcuten , RQCCUTEN=grid%rqccuten                 &
+!     &             ,RQSCUTEN=grid%rqscuten , RQICUTEN=grid%rqicuten                 &
+!     &             ,RQRCUTEN=grid%rqrcuten , RQVBLTEN=grid%rqvblten                 &
+!     &             ,RQVFTEN=grid%rqvften                                       &
+!                 ! Other tendency arguments
+!     &             ,RTHRATEN=grid%rthraten , RTHBLTEN=grid%rthblten                 &
+!     &             ,RTHCUTEN=grid%rthcuten , RTHFTEN=grid%rthften                   &
+!                 ! Moisture tracer arguments
+!     &             ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV            &
+!     &             ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC            &
+!     &             ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR            &
+!     &             ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI            &
+!     &             ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS            &
+!     &             ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG            &
+!#ifdef WRF_CHEM
+!     &             ,GD_CLOUD=grid%GD_CLOUD,GD_CLOUD2=grid%GD_CLOUD2                          &
+!#endif
+!     &                                                          )
+!BENCH_END(cu_driver_tim)
+!
+!! fdda
+!
+!          CALL wrf_debug ( 200 , ' call fddagd_driver' )
+!
+!BENCH_START(fdda_driver_tim)
+!   CALL fddagd_driver(itimestep=grid%itimestep,dt=grid%dt,xtime=grid%XTIME,         &
+!                  id=grid%id,      &
+!                  RUNDGDTEN=grid%rundgdten,RVNDGDTEN=grid%rvndgdten,                &
+!                  RTHNDGDTEN=grid%rthndgdten,RQVNDGDTEN=grid%rqvndgdten,            &
+!                  RMUNDGDTEN=grid%rmundgdten,                                  &
+!                  u_ndg_old=fdda3d(ims,kms,jms,P_u_ndg_old),              &
+!                  v_ndg_old=fdda3d(ims,kms,jms,P_v_ndg_old),              &
+!                  t_ndg_old=fdda3d(ims,kms,jms,P_t_ndg_old),              &
+!                  q_ndg_old=fdda3d(ims,kms,jms,P_q_ndg_old),              &
+!                  mu_ndg_old=fdda2d(ims,1,jms,P_mu_ndg_old),              &
+!                  u_ndg_new=fdda3d(ims,kms,jms,P_u_ndg_new),              &
+!                  v_ndg_new=fdda3d(ims,kms,jms,P_v_ndg_new),              &
+!                  t_ndg_new=fdda3d(ims,kms,jms,P_t_ndg_new),              &
+!                  q_ndg_new=fdda3d(ims,kms,jms,P_q_ndg_new),              &
+!                  mu_ndg_new=fdda2d(ims,1,jms,P_mu_ndg_new),              &
+!                  u3d=grid%em_u_2,v3d=grid%em_v_2,th_phy=th_phy,rho=rho,moist=moist,      &
+!                  p_phy=p_phy,pi_phy=pi_phy,p8w=p8w,t_phy=t_phy,          &
+!                  dz8w=dz8w,z=grid%em_z,z_at_w=z_at_w,                            &
+!                  config_flags=config_flags,dx=grid%DX,n_moist=num_3d_m,  &
+!                  STEPFG=grid%STEPFG,                                          &
+!                  pblh=grid%pblh,ht=grid%ht,                                        &
+!                    IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde     &
+!                   ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme     &
+!                   ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)     &
+!                   ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)     &
+!                   ,KTS=k_start, KTE=min(k_end,kde-1)                     &
+!                   , num_tiles=grid%num_tiles                             )
+!BENCH_END(fdda_driver_tim)
+
+
+!****MARS
+IF (config_flags%modif_wrf) THEN
+!!!!!!!!!!!!!!!!!!!!!!!
+! call to LMD physics !
+!!!!!!!!!!!!!!!!!!!!!!!
+         CALL wrf_debug ( 200 , ' call lmd_driver' )
+         CALL lmd_driver(                                                 &
+           ! structure
+     &         id=grid%id,max_dom=grid%max_dom      &
+     &        ,DT=grid%dt                   &
+     &        ,ITIMESTEP=grid%itimestep                                   &
+           ! position
+     &        ,XLAT=grid%xlat,XLONG=grid%xlong                            &
+     &        ,DX=grid%dx         ,DY=grid%dy                             &
+     &        ,MSFT=grid%msft,MSFU=grid%msfu,MSFV=grid%msfv               &
+           ! indexes
+     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+     &        ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1)          &
+     &        ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1)          &
+     &        ,kts=k_start, kte=min(k_end,kde-1)                          &
+     &        ,num_tiles=grid%num_tiles                                   &
+           ! time variables
+     &        ,GMT=grid%gmt       ,JULYR=grid%julyr   ,JULDAY=grid%julday &
+           ! output from phy_prep
+     &        ,P8W=p8w            ,DZ8W=dz8w          ,T8W=t8w            &
+           ! Prognostic variables at p points
+     &        ,Z=grid%em_z                                                &
+                        ! z is the geopotential height at p points 
+                        ! ... (cf phy_prep in module_big_step_utilities_em)
+     &        ,HT=grid%ht                                                 &
+     &        ,U=u_phy            ,V=v_phy             ,W=w_phy           &
+     &        ,TH=th_phy          ,T=t_phy                                &
+     &        ,P=p_phy            ,EXNER=pi_phy               ,RHO=rho    &
+!!!!!ADDITION CAS IDEALISES
+     &        ,PTOP=grid%p_top                                            &
+           ! physics calls
+     &        ,RADT=grid%radt                          &
+     &        ,CUDT=grid%cudt                          &
+           ! surface temperature and surface pressure
+     &        ,TSK=grid%tsk,PSFC=grid%psfc                                &
+           ! tendencies for the dynamics
+     &        ,RTHBLTEN=grid%rthblten  ,RUBLTEN=grid%rublten,RVBLTEN=grid%rvblten    &
+           ! scalars
+     &        ,NUM_3D_S=num_3d_s,SCALAR=grid%scalar  &
+     &        ,NUM_3D_M=num_moist,MOIST=grid%moist   &
+           ! mode
+     &        ,MARS_MODE=config_flags%mars   &
+#ifdef NEWPHYS
+           ! planet
+     &        ,planet_type=config_flags%planet   &
+#endif
+           ! added variables
+     &        ,M_ALBEDO=grid%m_albedo,M_TI=grid%m_ti  &
+     &        ,M_CO2ICE=grid%m_co2ice,M_EMISS=grid%m_emiss   &  
+     &        ,M_H2OICE=grid%m_h2oice     &
+     &        ,M_TSOIL=grid%m_tsoil       &
+     &        ,M_Q2=grid%m_q2             &
+     &        ,M_TSURF=grid%m_tsurf       &
+#ifdef NEWPHYS
+     &        ,M_FLUXRAD=grid%m_fluxrad   &
+     &        ,M_WSTAR=grid%m_wstar       &
+     &        ,M_ISOIL=grid%m_isoil       &
+     &        ,M_DSOIL=grid%m_dsoil       &
+     &        ,M_Z0=grid%m_z0             &
+     &        ,CST_Z0=config_flags%init_Z0      &
+#endif
+     &        ,M_GW=grid%m_gw  &  
+     &        ,NUM_SOIL_LAYERS=config_flags%num_soil_layers    &
+           ! cst fields
+     &        ,CST_AL=config_flags%init_AL  &
+     &        ,CST_TI=config_flags%init_TI  &
+     &        ,ISFFLX=config_flags%isfflx   &
+     &        ,DIFF_OPT=config_flags%diff_opt     &
+     &        ,KM_OPT=config_flags%km_opt         &
+     &        ,HISTORY_INTERVAL=model_config_rec%history_interval(1)  &
+          !------------------!
+          ! OUTPUT VARIABLES !
+          !------------------!
+#ifdef NEWPHYS
+     &       ,HR_SW=grid%HR_SW   &
+     &       ,HR_LW=grid%HR_LW   &
+     &       ,HR_DYN=grid%HR_DYN   &
+     &       ,DDT=grid%DDT  &
+     &       ,DT_RAD=grid%DT_RAD  &
+     &       ,DT_VDF=grid%DT_VDF  &
+     &       ,DT_AJS=grid%DT_AJS  &
+     &       ,CLOUDFRAC=grid%CLOUDFRAC   &
+     &       ,TOTCLOUDFRAC=grid%TOTCLOUDFRAC   &
+     &       ,GRAIN=grid%GRAIN   &
+     &       ,GSNOW=grid%GSNOW   &
+     &       ,REEVAP=grid%REEVAP  &
+     &       ,SURFRAIN=grid%SURFRAIN  &
+     &       ,ALBEQ=grid%ALBEQ   &
+     &       ,FLUXTOP_DN=grid%FLUXTOP_DN   &
+     &       ,FLUXABS_SW=grid%FLUXABS_SW   &
+     &       ,FLUXTOP_LW=grid%FLUXTOP_LW   &
+     &       ,FLUXSURF_SW=grid%FLUXSURF_SW   &
+     &       ,FLUXSURF_LW=grid%FLUXSURF_LW   &
+     &       ,FLXGRD=grid%FLXGRD   &
+     &       ,LSCEZ=grid%LSCEZ   &
+     &       ,H2OICE_REFF=grid%H2OICE_REFF  &
+     &       ,LATENT_HF=grid%LATENT_HF  &
+     &       ,SWDOWNZ=grid%SWDOWNZ   &
+     &       ,TAU_DUST=grid%TAU_DUST   &
+     &       ,RDUST=grid%RDUST   &
+     &       ,QSURFDUST=grid%QSURFDUST   &
+     &       ,MTOT=grid%MTOT   &
+     &       ,ICETOT=grid%ICETOT   &
+     &       ,VMR_ICE=grid%VMR_ICE   &
+     &       ,TAU_ICE=grid%TAU_ICE   &
+     &       ,RICE=grid%RICE   &
+     &       ,ZMAX=grid%ZMAX   &
+     &       ,HFMAX=grid%HFMAX &
+     &       ,USTM=grid%USTM   &
+     &       ,HFX=grid%HFX &
+#else 
+#include "module_lmd_driver_output4.inc"
+#endif
+     &        ,SLPX=grid%slpx,SLPY=grid%slpy,RESTART=config_flags%restart)
+ENDIF
+
+!!!!!!!!!!!!!!!!!!!!!!!
+! call to LMD physics !
+!!!!!!!!!!!!!!!!!!!!!!!
+!****MARS
+
+
+
+! calculate_phy_tend
+
+BENCH_START(cal_phy_tend)
+      !$OMP PARALLEL DO   &
+      !$OMP PRIVATE ( ij )
+
+      DO ij = 1 , grid%num_tiles
+
+          CALL wrf_debug ( 200 , ' call calculate_phy_tend' )
+          CALL calculate_phy_tend (config_flags,grid%em_mut,grid%em_muu,grid%em_muv,pi_phy,            &
+                     grid%rthraten,                                         &
+                     grid%rublten,grid%rvblten,grid%rthblten,                         &
+                     grid%rqvblten,grid%rqcblten,grid%rqiblten,                       &
+                     grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten,              &
+                     grid%rqicuten,grid%rqscuten,                                &
+                     grid%RUNDGDTEN,grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN,        &
+                     grid%RMUNDGDTEN,                                       &
+                     ids,ide, jds,jde, kds,kde,                        &
+                     ims,ime, jms,jme, kms,kme,                        &
+                     grid%i_start(ij), min(grid%i_end(ij),ide-1),      &
+                     grid%j_start(ij), min(grid%j_end(ij),jde-1),      &
+                     k_start    , min(k_end,kde-1)                     )
+
+      ENDDO
+      !$OMP END PARALLEL DO
+BENCH_END(cal_phy_tend)
+
+! tke diffusion
+
+     IF(config_flags%diff_opt .eq. 2 .OR. config_flags%diff_opt .eq. 1) THEN
+
+BENCH_START(comp_diff_metrics_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+
+       DO ij = 1 , grid%num_tiles
+
+          CALL wrf_debug ( 200 , ' call compute_diff_metrics ' )
+          CALL compute_diff_metrics ( config_flags, grid%em_ph_2, grid%em_phb, grid%em_z, grid%em_rdz, grid%em_rdzw, &
+                                      grid%em_zx, grid%em_zy, grid%rdx, grid%rdy,                      &
+                                      ids, ide, jds, jde, kds, kde,          &
+                                      ims, ime, jms, jme, kms, kme,          &
+                                      grid%i_start(ij), grid%i_end(ij),      &
+                                      grid%j_start(ij), grid%j_end(ij),      &
+                                      k_start    , k_end                    )
+       ENDDO
+       !$OMP END PARALLEL DO
+BENCH_END(comp_diff_metrics_tim)
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_A1.inc"
+#endif
+
+BENCH_START(tke_diff_bc_tim)
+       DO ij = 1 , grid%num_tiles
+
+          CALL wrf_debug ( 200 , ' call bc for diffusion_metrics ' )
+          CALL set_physical_bc3d( grid%em_rdzw , 'w', config_flags,           &
+                                  ids, ide, jds, jde, kds, kde,       &
+                                  ims, ime, jms, jme, kms, kme,       &
+                                  ips, ipe, jps, jpe, kps, kpe,       &
+                                  grid%i_start(ij), grid%i_end(ij),   &
+                                  grid%j_start(ij), grid%j_end(ij),   &
+                                  k_start    , k_end                 )
+          CALL set_physical_bc3d( grid%em_rdz , 'w', config_flags,            &
+                                  ids, ide, jds, jde, kds, kde,       &
+                                  ims, ime, jms, jme, kms, kme,       &
+                                  ips, ipe, jps, jpe, kps, kpe,       &
+                                  grid%i_start(ij), grid%i_end(ij),   &
+                                  grid%j_start(ij), grid%j_end(ij),   &
+                                  k_start    , k_end                 )
+          CALL set_physical_bc3d( grid%em_z , 'w', config_flags,              &
+                                  ids, ide, jds, jde, kds, kde,       &
+                                  ims, ime, jms, jme, kms, kme,       &
+                                  ips, ipe, jps, jpe, kps, kpe,       &
+                                  grid%i_start(ij), grid%i_end(ij),   &
+                                  grid%j_start(ij), grid%j_end(ij),   &
+                                  k_start    , k_end                 )
+          CALL set_physical_bc3d( grid%em_zx , 'w', config_flags,             &
+                                  ids, ide, jds, jde, kds, kde,       &
+                                  ims, ime, jms, jme, kms, kme,       &
+                                  ips, ipe, jps, jpe, kps, kpe,       &
+                                  grid%i_start(ij), grid%i_end(ij),   &
+                                  grid%j_start(ij), grid%j_end(ij),   &
+                                  k_start    , k_end                 )
+          CALL set_physical_bc3d( grid%em_zy , 'w', config_flags,             &
+                                  ids, ide, jds, jde, kds, kde,       &
+                                  ims, ime, jms, jme, kms, kme,       &
+                                  ips, ipe, jps, jpe, kps, kpe,       &
+                                  grid%i_start(ij), grid%i_end(ij),   &
+                                  grid%j_start(ij), grid%j_end(ij),   &
+                                  k_start    , k_end                 )
+
+       ENDDO
+BENCH_END(tke_diff_bc_tim)
+
+#ifdef DM_PARALLEL
+#     include "HALO_EM_TKE_C.inc"
+#endif
+
+BENCH_START(deform_div_tim)
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+
+       DO ij = 1 , grid%num_tiles
+
+          CALL wrf_debug ( 200 , ' call cal_deform_and_div' )
+          CALL cal_deform_and_div ( config_flags,grid%em_u_2,grid%em_v_2,grid%em_w_2,grid%div,        &
+                                    grid%defor11,grid%defor22,grid%defor33,grid%defor12,     &
+                                    grid%defor13,grid%defor23,                     &
+                                    grid%u_base, grid%v_base,grid%msfu,grid%msfv,grid%msft,       &
+                                    grid%rdx, grid%rdy, grid%em_dn, grid%em_dnw, grid%em_rdz, grid%em_rdzw,        &
+                                    grid%em_fnm,grid%em_fnp,grid%cf1,grid%cf2,grid%cf3,grid%em_zx,grid%em_zy,           &
+                                    ids, ide, jds, jde, kds, kde,        &
+                                    ims, ime, jms, jme, kms, kme,        &
+                                    grid%i_start(ij), grid%i_end(ij),    &
+                                    grid%j_start(ij), grid%j_end(ij),    &
+                                    k_start    , k_end                  )
+       ENDDO
+       !$OMP END PARALLEL DO
+BENCH_END(deform_div_tim)
+
+
+#ifdef DM_PARALLEL
+#     include "HALO_EM_TKE_D.inc"
+#endif
+
+
+! calculate tke, kmh, and kmv
+
+BENCH_START(calc_tke_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+
+       DO ij = 1 , grid%num_tiles
+
+          CALL wrf_debug ( 200 , ' call calculate_km_kh' )
+          CALL calculate_km_kh( config_flags,grid%dt,grid%dampcoef,grid%zdamp,config_flags%damp_opt,     &
+                                grid%xkmh,grid%xkmhd,grid%xkmv,grid%xkhh,grid%xkhv,grid%bn2,               &
+                                grid%khdif,grid%kvdif,grid%div,                             &
+                                grid%defor11,grid%defor22,grid%defor33,grid%defor12,             &
+                                grid%defor13,grid%defor23,                             &
+                                grid%em_tke_2,p8w,t8w,th_phy,           &
+                                t_phy,p_phy,moist,grid%em_dn,grid%em_dnw,                    &
+                                grid%dx,grid%dy,grid%em_rdz,grid%em_rdzw,config_flags%mix_cr_len,num_3d_m,          &
+                                grid%cf1, grid%cf2, grid%cf3, grid%warm_rain,                    &
+                                grid%kh_tke_upper_bound, grid%kv_tke_upper_bound,      &
+                                ids,ide, jds,jde, kds,kde,                   &
+                                ims,ime, jms,jme, kms,kme,                   &
+                                grid%i_start(ij), grid%i_end(ij),            &
+                                grid%j_start(ij), grid%j_end(ij),            &
+                                k_start    , k_end                          )
+       ENDDO
+       !$OMP END PARALLEL DO
+BENCH_END(calc_tke_tim)
+
+#ifdef DM_PARALLEL
+#     include "HALO_EM_TKE_E.inc"
+#endif
+
+     ENDIF
+
+#ifdef DM_PARALLEL
+#      include "PERIOD_BDY_EM_PHY_BC.inc"
+      IF ( config_flags%grid_fdda .eq. 1) THEN
+#      include "PERIOD_BDY_EM_FDDA_BC.inc"
+      ENDIF
+#      include "PERIOD_BDY_EM_CHEM.inc"
+#endif
+
+BENCH_START(phy_bc_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+
+!
+!****MARS: TODO: check that this is OK, because physical tendency is an input 
+!
+     DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call phy_bc' )
+       CALL phy_bc (config_flags,grid%div,grid%defor11,grid%defor22,grid%defor33,            &
+                            grid%defor12,grid%defor13,grid%defor23,                     &
+                            grid%xkmh,grid%xkmhd,grid%xkmv,grid%xkhh,grid%xkhv,                   &
+                            grid%em_tke_2,                          &
+                            grid%rublten, grid%rvblten,                            &
+                            ids, ide, jds, jde, kds, kde,                &
+                            ims, ime, jms, jme, kms, kme,                &
+                            ips, ipe, jps, jpe, kps, kpe,                &
+                            grid%i_start(ij), grid%i_end(ij),            &
+                            grid%j_start(ij), grid%j_end(ij),            &
+                            k_start    , k_end                           )
+     ENDDO
+     !$OMP END PARALLEL DO
+BENCH_END(phy_bc_tim)
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+!
+! MPP for some physics tendency, km, kh, deformation, and divergence
+!
+!               *                     *
+!             * + *      * + *        +
+!               *                     *
+!
+! (for PBL)
+! grid%rublten                  x
+! grid%rvblten                             x
+!
+! (for diff_opt >= 1)
+! grid%defor11                  x
+! grid%defor22                             x
+! grid%defor12       x
+! grid%defor13                  x
+! grid%defor23                             x
+! grid%div           x
+! grid%xkmv          x
+! grid%xkmh          x
+! grid%xkmhd         x
+! grid%xkhv          x
+! grid%xkhh          x
+! tke           x
+!
+!-----------------------------------------------------------------------
+
+!!****MARS: always include this HALO for Mars version ...
+      IF ( ( config_flags%bl_pbl_physics .ge. 1 ) &
+            .OR. ( config_flags%modif_wrf ) ) THEN
+#      include "HALO_EM_PHYS_PBL.inc"
+      ENDIF
+
+
+      IF ( config_flags%grid_fdda .eq. 1) THEN
+#      include "HALO_EM_FDDA.inc"
+      ENDIF
+      IF ( config_flags%diff_opt .ge. 1 ) THEN
+#      include "HALO_EM_PHYS_DIFFUSION.inc"
+      ENDIF
+
+      IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#       include "HALO_EM_TKE_3.inc"
+      ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#       include "HALO_EM_TKE_5.inc"
+      ELSE
+        WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+        CALL wrf_error_fatal(TRIM(wrf_err_message))
+      ENDIF
+#endif
+
+BENCH_START(update_phy_ten_tim)
+      !$OMP PARALLEL DO   &
+      !$OMP PRIVATE ( ij )
+
+      DO ij = 1 , grid%num_tiles
+
+          CALL wrf_debug ( 200 , ' call update_phy_ten' )
+        CALL update_phy_ten(t_tendf, ru_tendf, rv_tendf,moist_tend,        &
+                          mu_tendf,                                        &
+                          grid%rthraten,grid%rthblten,grid%rthcuten,grid%rublten,grid%rvblten,      &
+                          grid%rqvblten,grid%rqcblten,grid%rqiblten,                      &
+                          grid%rqvcuten,grid%rqccuten,grid%rqrcuten,grid%rqicuten,grid%rqscuten,    &
+                          grid%RUNDGDTEN,grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN,       &
+                          grid%RMUNDGDTEN,                                      &
+                          num_3d_m,config_flags,rk_step,                   &
+                          ids, ide, jds, jde, kds, kde,                    &
+                          ims, ime, jms, jme, kms, kme,                    &
+                          grid%i_start(ij), grid%i_end(ij),                &
+                          grid%j_start(ij), grid%j_end(ij),                &
+                          k_start, k_end                               )
+
+      END DO
+      !$OMP END PARALLEL DO
+BENCH_END(update_phy_ten_tim)
+
+     IF( config_flags%diff_opt .eq. 2 .and. config_flags%km_opt .eq. 2 ) THEN
+
+BENCH_START(tke_rhs_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+
+       DO ij = 1 , grid%num_tiles
+
+          CALL tke_rhs  ( tke_tend,grid%bn2,                               &
+                          config_flags,grid%defor11,grid%defor22,grid%defor33,       &
+                          grid%defor12,grid%defor13,grid%defor23,grid%em_u_2,grid%em_v_2,grid%em_w_2,grid%div,    &
+                          grid%em_tke_2,grid%em_mut,                     &
+                          th_phy,p_phy,p8w,t8w,grid%em_z,grid%em_fnm,grid%em_fnp,             &
+                          grid%cf1,grid%cf2,grid%cf3,grid%msft,grid%xkmh,grid%xkmv,grid%xkhv,grid%rdx,grid%rdy,    &
+                          grid%dx,grid%dy,grid%dt,grid%em_zx,grid%em_zy,grid%em_rdz,grid%em_rdzw,grid%em_dn,       &
+                          grid%em_dnw,config_flags%mix_cr_len,  &
+                          ids, ide, jds, jde, kds, kde,               &
+                          ims, ime, jms, jme, kms, kme,               &
+                          grid%i_start(ij), grid%i_end(ij),           &
+                          grid%j_start(ij), grid%j_end(ij),           &
+                          k_start    , k_end                         )
+
+       ENDDO
+       !$OMP END PARALLEL DO
+BENCH_END(tke_rhs_tim)
+
+     ENDIF
+
+! calculate vertical diffusion first and then horizontal
+! (keep this order)
+
+     IF(config_flags%diff_opt .eq. 2) THEN
+
+!!!!****MARS: vertical diffusion is done by the physics
+       IF ( (config_flags%bl_pbl_physics .eq. 0) &
+             .AND. (.not. config_flags%modif_wrf ) ) THEN
+
+BENCH_START(vert_diff_tim)
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call vertical_diffusion_2 ' )
+           CALL vertical_diffusion_2( ru_tendf, rv_tendf, rw_tendf,              &
+                                      t_tendf, tke_tend,                         &
+                                      moist_tend, num_3d_m,                      &
+                                      chem_tend, num_3d_c,                       &
+                                      scalar_tend, num_3d_s,                     &
+                                      grid%em_u_2, grid%em_v_2,                                  &
+                                      grid%em_t_2,grid%u_base,grid%v_base,grid%em_t_base,grid%qv_base,          &
+                                      grid%em_mut,grid%em_tke_2,config_flags,                    &
+                                      grid%defor13,grid%defor23,grid%defor33,                   &
+                                      grid%div, moist, chem, scalar,                  &
+                                      grid%xkmv, grid%xkhv, config_flags%km_opt,                        &
+                                      grid%em_fnm, grid%em_fnp, grid%em_dn, grid%em_dnw, grid%em_rdz, grid%em_rdzw,              &
+                                      ids, ide, jds, jde, kds, kde,              &
+                                      ims, ime, jms, jme, kms, kme,              &
+                                      grid%i_start(ij), grid%i_end(ij),          &
+                                      grid%j_start(ij), grid%j_end(ij),          &
+                                      k_start    , k_end                        )
+
+         ENDDO
+         !$OMP END PARALLEL DO
+BENCH_END(vert_diff_tim)
+       ENDIF
+
+!
+BENCH_START(hor_diff_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+         CALL wrf_debug ( 200 , ' call horizontal_diffusion_2' )
+         CALL horizontal_diffusion_2( t_tendf, ru_tendf, rv_tendf, rw_tendf, &
+                                      tke_tend,                              &
+                                      moist_tend, num_3d_m,                  &
+                                      chem_tend, num_3d_c,                   &
+                                      scalar_tend, num_3d_s,                 &
+                                      grid%em_t_2, th_phy,                           &
+                                      grid%em_mut, grid%em_tke_2, config_flags,              &
+                                      grid%defor11, grid%defor22, grid%defor12,             &
+                                      grid%defor13, grid%defor23, grid%div,                 &
+                                      moist, chem, scalar,                   &
+                                      grid%msfu, grid%msfv, grid%msft, grid%xkmhd, grid%xkhh, config_flags%km_opt, &
+                                      grid%rdx, grid%rdy, grid%em_rdz, grid%em_rdzw,                   &
+                                      grid%em_fnm, grid%em_fnp, grid%cf1, grid%cf2, grid%cf3,               &
+                                      grid%em_zx, grid%em_zy, grid%em_dn, grid%em_dnw,                       &
+                                      ids, ide, jds, jde, kds, kde,          &
+                                      ims, ime, jms, jme, kms, kme,          &
+                                      grid%i_start(ij), grid%i_end(ij),      &
+                                      grid%j_start(ij), grid%j_end(ij),      &
+                                      k_start    , k_end                    )
+       ENDDO
+       !$OMP END PARALLEL DO
+BENCH_END(hor_diff_tim)
+
+     ENDIF
+
+!# ifdef DM_PARALLEL
+!#     include "HALO_OBS_NUDGE.inc"
+!#endif
+!!***********************************************************************
+!! This section for obs nudging
+!      !$OMP PARALLEL DO   &
+!      !$OMP PRIVATE ( ij )
+!
+!      DO ij = 1 , grid%num_tiles
+!
+!         CALL fddaobs_driver (grid%grid_id, model_config_rec%grid_id,  &
+!                  model_config_rec%parent_id, config_flags%restart,    &
+!                  grid%obs_nudge_opt,                                  &
+!                  grid%obs_ipf_errob,                                  &
+!                  grid%obs_ipf_nudob,                                  &
+!                  grid%fdda_start,                                     &
+!                  grid%fdda_end,                                       &
+!                  grid%obs_nudge_wind,                                 &
+!                  grid%obs_nudge_temp,                                 &
+!                  grid%obs_nudge_mois,                                 &
+!                  grid%obs_nudge_pstr,                                 &
+!                  grid%obs_coef_wind,                                  &
+!                  grid%obs_coef_temp,                                  &
+!                  grid%obs_coef_mois,                                  &
+!                  grid%obs_coef_pstr,                                  &             
+!                  grid%obs_rinxy,                                      &
+!                  grid%obs_rinsig,                                     &
+!                  grid%obs_twindo,                                     &
+!                  grid%obs_npfi,                                       &
+!                  grid%obs_ionf,                                       &
+!                  grid%obs_idynin,                                     &
+!                  grid%obs_dtramp,                                     &
+!                  model_config_rec%cen_lat(1),                         &
+!                  model_config_rec%cen_lon(1),                         &
+!                  config_flags%truelat1,                               &
+!                  config_flags%truelat2,                               &
+!                  config_flags%map_proj,                               &
+!                  model_config_rec%i_parent_start,                     &
+!                  model_config_rec%j_parent_start,                     &
+!                  grid%parent_grid_ratio,                              &
+!                  grid%max_dom, grid%itimestep,                        &
+!                  grid%dt, grid%gmt, grid%julday, grid%fdob,           &
+!                  grid%max_obs,                                        &
+!                  model_config_rec%nobs_ndg_vars,                      &
+!                  model_config_rec%nobs_err_flds,                      &
+!                  grid%fdob%nstat, grid%fdob%varobs, grid%fdob%errf,   &
+!                  grid%dx, grid%KPBL,grid%HT,                          &
+!                  grid%em_mut, grid%em_muu, grid%em_muv,               &
+!                  grid%msft, grid%msfu, grid%msfv,                     &
+!                  p_phy, t_tendf, t0,                                  &
+!                  grid%em_u_2, grid%em_v_2, grid%em_t_2,               &
+!                  moist(:,:,:,P_QV),                                   &
+!                  grid%em_pb, grid%p_top, grid%em_p,                   &
+!                  grid%uratx, grid%vratx, grid%tratx,                  &
+!                  ru_tendf, rv_tendf,                                  &
+!                  moist_tend(:,:,:,P_QV), grid%em_obs_savwt,           &
+!                  ids,ide, jds,jde, kds,kde,                           &
+!                  ims,ime, jms,jme, kms,kme,                           &
+!                  grid%i_start(ij), min(grid%i_end(ij),ide-1),         &
+!                  grid%j_start(ij), min(grid%j_end(ij),jde-1),         &
+!                  k_start    , min(k_end,kde-1)                     )
+!
+!      ENDDO
+!
+!     !$OMP END PARALLEL DO
+!! 
+!!***********************************************************************
+
+     END IF rk_step_is_one
+
+BENCH_START(rk_tend_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+
+      CALL wrf_debug ( 200 , ' call rk_tendency' )
+      CALL rk_tendency ( config_flags, rk_step,                           &
+                         grid%em_ru_tend, grid%em_rv_tend, rw_tend, ph_tend, t_tend,      &
+                         ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
+                         mu_tend, grid%em_u_save, grid%em_v_save, w_save, ph_save,        &
+                         grid%em_t_save, mu_save, grid%rthften,                        &
+                         grid%em_ru, grid%em_rv, grid%em_rw, grid%em_ww,                                  &
+                         grid%em_u_2, grid%em_v_2, grid%em_w_2, grid%em_t_2, grid%em_ph_2,                        &
+                         grid%em_u_1, grid%em_v_1, grid%em_w_1, grid%em_t_1, grid%em_ph_1,                        &
+                         grid%h_diabatic, grid%em_phb, grid%em_t_init,                         &
+                         grid%em_mu_2, grid%em_mut, grid%em_muu, grid%em_muv, grid%em_mub,                        &
+                         grid%em_al, grid%em_alt, grid%em_p, grid%em_pb, grid%em_php, cqu, cqv, cqw,              &
+                         grid%u_base, grid%v_base, grid%em_t_base, grid%qv_base, grid%z_base,         &
+                         grid%msfu, grid%msfv, grid%msft, grid%f, grid%e, grid%sina, grid%cosa,              &
+                         grid%em_fnm, grid%em_fnp, grid%em_rdn, grid%em_rdnw,                             &
+                         grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, grid%xkmhd,               &
+                         grid%diff_6th_opt, grid%diff_6th_factor,           &
+                         grid%dampcoef,grid%zdamp,config_flags%damp_opt,                         &
+                         grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m,              &
+                         config_flags%non_hydrostatic,                    &
+                         ids, ide, jds, jde, kds, kde,                    &
+                         ims, ime, jms, jme, kms, kme,                    &
+                         grid%i_start(ij), grid%i_end(ij),                &
+                         grid%j_start(ij), grid%j_end(ij),                &
+                         k_start, k_end                                  )
+   END DO
+   !$OMP END PARALLEL DO
+BENCH_END(rk_tend_tim)
+
+BENCH_START(relax_bdy_dry_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+
+     IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN 
+
+       CALL relax_bdy_dry ( config_flags,                                &
+                            grid%em_u_save, grid%em_v_save, ph_save, grid%em_t_save,             &
+                            w_save, mu_tend,                             & 
+                            grid%em_ru, grid%em_rv, grid%em_ph_2, grid%em_t_2,                           &
+                            grid%em_w_2, grid%em_mu_2, grid%em_mut,                              &
+                            grid%em_u_b, grid%em_v_b, grid%em_ph_b, grid%em_t_b, grid%em_w_b,                    &
+                            grid%em_mu_b,                                        &
+                            grid%em_u_bt, grid%em_v_bt, grid%em_ph_bt, grid%em_t_bt,                     &
+                            grid%em_w_bt, grid%em_mu_bt,                                 &
+                            config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone,       &
+                            grid%dtbc, grid%fcx, grid%gcx,                              &
+                            ijds, ijde,                                  &
+                            ids,ide, jds,jde, kds,kde,                   &
+                            ims,ime, jms,jme, kms,kme,                   &
+                            ips,ipe, jps,jpe, kps,kpe,                   &
+                            grid%i_start(ij), grid%i_end(ij),            &
+                            grid%j_start(ij), grid%j_end(ij),            &
+                            k_start, k_end                              )
+
+
+     ENDIF
+
+     CALL rk_addtend_dry( grid%em_ru_tend,  grid%em_rv_tend,  rw_tend,  ph_tend,  t_tend,  &
+                          ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
+                          grid%em_u_save, grid%em_v_save, w_save, ph_save, grid%em_t_save, &
+                          mu_tend, mu_tendf, rk_step,                      &
+                          grid%h_diabatic, grid%em_mut, grid%msft, grid%msfu, grid%msfv,               &
+                          ids,ide, jds,jde, kds,kde,                       &
+                          ims,ime, jms,jme, kms,kme,                       &
+                          ips,ipe, jps,jpe, kps,kpe,                       &
+                          grid%i_start(ij), grid%i_end(ij),                &
+                          grid%j_start(ij), grid%j_end(ij),                &
+                          k_start, k_end                                  )
+
+     IF( config_flags%specified .or. config_flags%nested ) THEN 
+       CALL spec_bdy_dry ( config_flags,                                    &
+                           grid%em_ru_tend, grid%em_rv_tend, ph_tend, t_tend,               &
+                           rw_tend, mu_tend,                                &
+                           grid%em_u_b, grid%em_v_b, grid%em_ph_b, grid%em_t_b,                             &
+                           grid%em_w_b, grid%em_mu_b,                                       &
+                           grid%em_u_bt, grid%em_v_bt, grid%em_ph_bt, grid%em_t_bt,                         &
+                           grid%em_w_bt, grid%em_mu_bt,                                     &
+                           config_flags%spec_bdy_width, grid%spec_zone,                       &
+                           ijds, ijde,                 & ! min/max(id,jd)
+                           ids,ide, jds,jde, kds,kde,  & ! domain dims
+                           ims,ime, jms,jme, kms,kme,  & ! memory dims
+                           ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                           grid%i_start(ij), grid%i_end(ij),                &
+                           grid%j_start(ij), grid%j_end(ij),                &
+                           k_start, k_end                                  )
+     
+     ENDIF
+
+   END DO
+   !$OMP END PARALLEL DO
+BENCH_END(relax_bdy_dry_tim)
+
+!<DESCRIPTION>
+!<pre>
+! (3) Small (acoustic,sound) steps.
+!
+!    Several acoustic steps are taken each RK pass.  A small step 
+!    sequence begins with calculating perturbation variables 
+!    and coupling them to the column dry-air-mass mu 
+!    (call to small_step_prep).  This is followed by computing
+!    coefficients for the vertically implicit part of the
+!    small timestep (call to calc_coef_w).  
+!
+!    The small steps are taken
+!    in the named loop "small_steps:".  In the small_steps loop, first 
+!    the horizontal momentum (u and v) are advanced (call to advance_uv),
+!    next mu and theta are advanced (call to advance_mu_t) followed by
+!    advancing w and the geopotential (call to advance_w).  Diagnostic
+!    values for pressure and inverse density are updated at the end of
+!    each small_step.
+!
+!    The small-step section ends with the change of the perturbation variables
+!    back to full variables (call to small_step_finish).
+!</pre>
+!</DESCRIPTION>
+
+BENCH_START(small_step_prep_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , grid%num_tiles
+
+    ! Calculate coefficients for the vertically implicit acoustic/gravity wave
+    ! integration.  We only need calculate these for the first pass through -
+    ! the predictor step.  They are reused as is for the corrector step.
+    ! For third-order RK, we need to recompute these after the first 
+    ! predictor because we may have changed the small timestep -> grid%dts.
+
+      CALL wrf_debug ( 200 , ' call calc_coef_w' )
+
+      CALL small_step_prep( grid%em_u_1,grid%em_u_2,grid%em_v_1,grid%em_v_2,grid%em_w_1,grid%em_w_2,          &
+                            grid%em_t_1,grid%em_t_2,grid%em_ph_1,grid%em_ph_2,                &
+                            grid%em_mub, grid%em_mu_1, grid%em_mu_2,                  &
+                            grid%em_muu, muus, grid%em_muv, muvs,             &
+                            grid%em_mut, grid%em_muts, grid%em_mudf,                  & 
+                            grid%em_u_save, grid%em_v_save, w_save,           & 
+                            grid%em_t_save, ph_save, mu_save,         &
+                            grid%em_ww, ww1,                          &
+                            grid%em_dnw, c2a, grid%em_pb, grid%em_p, grid%em_alt,             &
+                            grid%msfu, grid%msfv, grid%msft,                 &
+                            rk_step,                          &
+                            ids, ide, jds, jde, kds, kde,     &
+                            ims, ime, jms, jme, kms, kme,     &
+                            grid%i_start(ij), grid%i_end(ij), &
+                            grid%j_start(ij), grid%j_end(ij), &
+                            k_start    , k_end               )
+      CALL calc_p_rho( grid%em_al, grid%em_p, grid%em_ph_2,                      &
+                       grid%em_alt, grid%em_t_2, grid%em_t_save, c2a, pm1,       &
+                       grid%em_mu_2, grid%em_muts, grid%em_znu, t0,              &
+                       grid%em_rdnw, grid%em_dnw, grid%smdiv,                 &
+                       config_flags%non_hydrostatic, 0,               &
+                       ids, ide, jds, jde, kds, kde,     &
+                       ims, ime, jms, jme, kms, kme,     &
+                       grid%i_start(ij), grid%i_end(ij), &
+                       grid%j_start(ij), grid%j_end(ij), &
+                       k_start    , k_end               )
+
+      IF (config_flags%non_hydrostatic)                                &
+      CALL calc_coef_w( a,alpha,gamma,                    &
+                        grid%em_mut, cqw,                         &
+                        grid%em_rdn, grid%em_rdnw, c2a,                   &
+                        dts_rk, g, grid%epssm,                 &
+                        ids, ide, jds, jde, kds, kde,     &
+                        ims, ime, jms, jme, kms, kme,     &
+                        grid%i_start(ij), grid%i_end(ij), &
+                        grid%j_start(ij), grid%j_end(ij), &
+                        k_start    , k_end               )
+
+
+   ENDDO
+   !$OMP END PARALLEL DO
+BENCH_END(small_step_prep_tim)
+
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!  Note:  the small size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
+!         as state variables in the mass coordinate model, as
+!         opposed to the coupled variables as in the height
+!         coordinate model.
+!
+!                              * * * * *
+!            *        * * *    * * * * *
+!          * + *      * + *    * * + * * 
+!            *        * * *    * * * * *
+!                              * * * * *
+!
+!  3D variables - note staggering!  grid%em_ph_2(grid%em_z), grid%em_u_save(X), grid%em_v_save(Y)
+!
+!j grid%em_ph_2      x
+!j grid%em_al        x
+!j grid%em_p         x
+!j grid%em_t_1       x
+!j grid%em_t_save    x
+!j grid%em_u_save    x
+!j grid%em_v_save    x
+!
+!  the following are 2D (xy) variables
+!
+!j grid%em_mu_1      x
+!j grid%em_mu_2      x
+!j grid%em_mudf      x
+!--------------------------------------------------------------
+#      include "HALO_EM_B.inc"
+#      include "PERIOD_BDY_EM_B.inc"
+#endif
+
+BENCH_START(set_phys_bc2_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , grid%num_tiles
+
+         CALL set_physical_bc3d( grid%em_ru_tend, 'u', config_flags,          &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                           grid%i_start(ij), grid%i_end(ij),                 &
+                           grid%j_start(ij), grid%j_end(ij),                 &
+                           k_start    , k_end                     )
+
+         CALL set_physical_bc3d( grid%em_rv_tend, 'v', config_flags,            &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                           grid%i_start(ij), grid%i_end(ij),                 &
+                           grid%j_start(ij), grid%j_end(ij),                 &
+                           k_start    , k_end                     )
+
+         CALL set_physical_bc3d( grid%em_ph_2, 'w', config_flags,          &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                           grid%i_start(ij), grid%i_end(ij),                 &
+                           grid%j_start(ij), grid%j_end(ij),                 &
+                           k_start    , k_end                     )
+
+         CALL set_physical_bc3d( grid%em_al, 'p', config_flags,            &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                           grid%i_start(ij), grid%i_end(ij),                 &
+                           grid%j_start(ij), grid%j_end(ij),                 &
+                           k_start    , k_end                     )
+
+         CALL set_physical_bc3d( grid%em_p, 'p', config_flags,             &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                           grid%i_start(ij), grid%i_end(ij),                 &
+                           grid%j_start(ij), grid%j_end(ij),                 &
+                           k_start    , k_end                     )
+
+         CALL set_physical_bc3d( grid%em_t_1, 'p', config_flags,             &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                           grid%i_start(ij), grid%i_end(ij),                 &
+                           grid%j_start(ij), grid%j_end(ij),                 &
+                           k_start    , k_end                     )
+
+         CALL set_physical_bc3d( grid%em_t_save, 't', config_flags,             &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                           grid%i_start(ij), grid%i_end(ij),                 &
+                           grid%j_start(ij), grid%j_end(ij),                 &
+                           k_start    , k_end                     )
+
+         CALL set_physical_bc2d( grid%em_mu_1, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+         CALL set_physical_bc2d( grid%em_mu_2, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+         CALL set_physical_bc2d( grid%em_mudf, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+    END DO
+    !$OMP END PARALLEL DO
+BENCH_END(set_phys_bc2_tim)
+
+   small_steps : DO iteration = 1 , number_of_small_timesteps
+
+   ! Boundary condition time (or communication time).  
+
+#ifdef DM_PARALLEL
+#      include "PERIOD_BDY_EM_B.inc"
+#endif
+
+
+      !$OMP PARALLEL DO   &
+      !$OMP PRIVATE ( ij )
+
+      DO ij = 1 , grid%num_tiles
+
+BENCH_START(advance_uv_tim)
+         CALL advance_uv ( grid%em_u_2, grid%em_ru_tend, grid%em_v_2, grid%em_rv_tend,       &
+                           grid%em_p, grid%em_pb,                            &
+                           grid%em_ph_2, grid%em_php, grid%em_alt, grid%em_al, grid%em_mu_2,         &
+                           grid%em_muu, cqu, grid%em_muv, cqv, grid%em_mudf,         &
+                           grid%rdx, grid%rdy, dts_rk,                 &
+                           grid%cf1, grid%cf2, grid%cf3, grid%em_fnm, grid%em_fnp,          &
+                           grid%emdiv,                            &
+                           grid%em_rdnw, config_flags,grid%spec_zone,     &
+                           config_flags%non_hydrostatic,                  &
+                           ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           grid%i_start(ij), grid%i_end(ij), &
+                           grid%j_start(ij), grid%j_end(ij), &
+                           k_start    , k_end               )
+BENCH_END(advance_uv_tim)
+
+BENCH_START(spec_bdy_uv_tim)
+         IF( config_flags%specified .or. config_flags%nested ) THEN
+           CALL spec_bdyupdate(grid%em_u_2, grid%em_ru_tend, dts_rk,      &
+                               'u'         , config_flags, &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               grid%i_start(ij), grid%i_end(ij),         &
+                               grid%j_start(ij), grid%j_end(ij),         &
+                               k_start    , k_end             )
+
+           CALL spec_bdyupdate(grid%em_v_2, grid%em_rv_tend, dts_rk,      &
+                               'v'         , config_flags, &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               grid%i_start(ij), grid%i_end(ij),         &
+                               grid%j_start(ij), grid%j_end(ij),         &
+                               k_start    , k_end             )
+
+         ENDIF
+BENCH_END(spec_bdy_uv_tim)
+
+      END DO
+      !$OMP END PARALLEL DO
+
+#ifdef DM_PARALLEL
+!
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!         *                     *
+!       * + *      * + *        +
+!         *                     *
+!
+!  grid%em_u_2               x
+!  grid%em_v_2                          x
+!
+#     include "HALO_EM_C.inc"
+#endif
+
+      !$OMP PARALLEL DO   &
+      !$OMP PRIVATE ( ij )
+
+      DO ij = 1 , grid%num_tiles
+
+        !  advance the mass in the column, theta, and calculate grid%em_ww
+
+BENCH_START(advance_mu_t_tim)
+        CALL advance_mu_t( grid%em_ww, ww1, grid%em_u_2, grid%em_u_save, grid%em_v_2, grid%em_v_save, &
+                           grid%em_mu_2, grid%em_mut, muave, grid%em_muts, grid%em_muu, grid%em_muv,  &
+                           grid%em_mudf, grid%em_ru_m, grid%em_rv_m, grid%em_ww_m,                       &
+                           grid%em_t_2, grid%em_t_save, t_2save, t_tend,                              &
+                           mu_tend,                                                                   &
+                           grid%rdx, grid%rdy, dts_rk, grid%epssm,                                    &
+                           grid%em_dnw, grid%em_fnm, grid%em_fnp, grid%em_rdnw,                       &
+                           grid%msfu, grid%msfv, grid%msft,                                           &
+                           iteration, config_flags,                                                   &
+                           ids, ide, jds, jde, kds, kde,      &
+                           ims, ime, jms, jme, kms, kme,      &
+                           grid%i_start(ij), grid%i_end(ij),  &
+                           grid%j_start(ij), grid%j_end(ij),  &
+                           k_start    , k_end                )
+BENCH_END(advance_mu_t_tim)
+
+BENCH_START(spec_bdy_t_tim)
+         IF( config_flags%specified .or. config_flags%nested ) THEN
+
+           CALL spec_bdyupdate(grid%em_t_2, t_tend, dts_rk,      &
+                               't'         , config_flags, &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               grid%i_start(ij), grid%i_end(ij),         &
+                               grid%j_start(ij), grid%j_end(ij),         &
+                               k_start    , k_end             )
+
+           CALL spec_bdyupdate(grid%em_mu_2, mu_tend, dts_rk,      &
+                               'm'         , config_flags, &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
+                               ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
+                               ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
+                               grid%i_start(ij), grid%i_end(ij),         &
+                               grid%j_start(ij), grid%j_end(ij),         &
+                               1    , 1             )
+
+           CALL spec_bdyupdate(grid%em_muts, mu_tend, dts_rk,      &
+                               'm'         , config_flags, &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
+                               ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
+                               ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
+                               grid%i_start(ij), grid%i_end(ij),         &
+                               grid%j_start(ij), grid%j_end(ij),         &
+                               1    , 1             )
+         ENDIF
+BENCH_END(spec_bdy_t_tim)
+
+         ! sumflux accumulates the time-averged mass flux
+         ! (time averaged over the acoustic steps) for use
+         ! in the scalar advection (flux divergence).  Using
+         ! time averaged values gives us exact scalar conservation.
+
+BENCH_START(sumflux_tim)
+         CALL sumflux ( grid%em_u_2, grid%em_v_2, grid%em_ww,                         &
+                        grid%em_u_save, grid%em_v_save, ww1,                  &
+                        grid%em_muu, grid%em_muv,                             &
+                        grid%em_ru_m, grid%em_rv_m, grid%em_ww_m, grid%epssm,              &
+                        grid%msfu, grid%msfv,                           &
+                        iteration, number_of_small_timesteps, &
+                        ids, ide, jds, jde, kds, kde,         &
+                        ims, ime, jms, jme, kms, kme,         &
+                        grid%i_start(ij), grid%i_end(ij),     &
+                        grid%j_start(ij), grid%j_end(ij),     &
+                        k_start    , k_end                   )
+BENCH_END(sumflux_tim)
+
+         ! small (acoustic) step for the vertical momentum,
+         ! density and coupled potential temperature.
+
+
+BENCH_START(advance_w_tim)
+        IF ( config_flags%non_hydrostatic ) THEN
+          CALL advance_w( grid%em_w_2, rw_tend, grid%em_ww, grid%em_u_2, grid%em_v_2,       &
+                          grid%em_mu_2, grid%em_mut, muave, grid%em_muts,           &
+                          t_2save, grid%em_t_2, grid%em_t_save,             &
+                          grid%em_ph_2, ph_save, grid%em_phb, ph_tend,      &
+                          grid%ht, c2a, cqw, grid%em_alt, grid%em_alb,           &
+                          a, alpha, gamma,                  &
+                          grid%rdx, grid%rdy, dts_rk, t0, grid%epssm,      &
+                          grid%em_dnw, grid%em_fnm, grid%em_fnp, grid%em_rdnw, grid%em_rdn,         &
+                          grid%cf1, grid%cf2, grid%cf3, grid%msft,              &
+                          config_flags,                     &
+                          ids,ide, jds,jde, kds,kde,        & ! domain dims
+                          ims,ime, jms,jme, kms,kme,        & ! memory dims
+                          grid%i_start(ij), grid%i_end(ij), &
+                          grid%j_start(ij), grid%j_end(ij), &
+                          k_start    , k_end               )
+        ENDIF
+BENCH_END(advance_w_tim)
+
+        IF( config_flags%specified .or. config_flags%nested ) THEN
+
+BENCH_START(spec_bdynhyd_tim)
+           IF (config_flags%non_hydrostatic)  THEN
+             CALL spec_bdyupdate_ph( ph_save, grid%em_ph_2, ph_tend, mu_tend, grid%em_muts, dts_rk, &
+                                     'h'         , config_flags, &
+                                     grid%spec_zone,                  &
+                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                     grid%i_start(ij), grid%i_end(ij),         &
+                                     grid%j_start(ij), grid%j_end(ij),         &
+                                     k_start    , k_end             )
+
+             IF( config_flags%specified ) THEN
+               CALL zero_grad_bdy ( grid%em_w_2,                        &
+                                    'w'         , config_flags, &
+                                    grid%spec_zone,                  &
+                                    ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                    ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                    ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                    grid%i_start(ij), grid%i_end(ij),         &
+                                    grid%j_start(ij), grid%j_end(ij),         &
+                                    k_start    , k_end             )
+             ELSE
+               CALL spec_bdyupdate   ( grid%em_w_2, rw_tend, dts_rk,       &
+                                       'h'         , config_flags, &
+                                       grid%spec_zone,                  &
+                                       ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                       ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                       ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                       grid%i_start(ij), grid%i_end(ij),         &
+                                       grid%j_start(ij), grid%j_end(ij),         &
+                                       k_start    , k_end             )
+             ENDIF
+          ENDIF
+BENCH_END(spec_bdynhyd_tim)
+        ENDIF
+
+BENCH_START(cald_p_rho_tim)
+        CALL calc_p_rho( grid%em_al, grid%em_p, grid%em_ph_2,                      &
+                         grid%em_alt, grid%em_t_2, grid%em_t_save, c2a, pm1,       &
+                         grid%em_mu_2, grid%em_muts, grid%em_znu, t0,              &
+                         grid%em_rdnw, grid%em_dnw, grid%smdiv,                 &
+                         config_flags%non_hydrostatic, iteration,       &
+                         ids, ide, jds, jde, kds, kde,     &
+                         ims, ime, jms, jme, kms, kme,     &
+                         grid%i_start(ij), grid%i_end(ij), &
+                         grid%j_start(ij), grid%j_end(ij), &
+                         k_start    , k_end               )
+BENCH_END(cald_p_rho_tim)
+
+   ENDDO
+   !$OMP END PARALLEL DO
+
+#ifdef DM_PARALLEL
+!
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!         *                     *
+!       * + *      * + *        +
+!         *                     *
+!
+!  grid%em_ph_2   x
+!  grid%em_al     x
+!  grid%em_p      x
+!
+!  2D variables (x,y)
+!
+!  grid%em_mu_2   x
+!  grid%em_muts   x
+!  grid%em_mudf   x
+
+#      include "HALO_EM_C2.inc"
+#      include "PERIOD_BDY_EM_B3.inc"
+#endif
+
+BENCH_START(phys_bc_tim)
+      !$OMP PARALLEL DO   &
+      !$OMP PRIVATE ( ij )
+
+      DO ij = 1 , grid%num_tiles
+
+        ! boundary condition set for next small timestep
+
+         CALL set_physical_bc3d( grid%em_ph_2, 'w', config_flags,          &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 ips, ipe, jps, jpe, kps, kpe,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+         CALL set_physical_bc3d( grid%em_al, 'p', config_flags,            &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 ips, ipe, jps, jpe, kps, kpe,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+         CALL set_physical_bc3d( grid%em_p, 'p', config_flags,             &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 ips, ipe, jps, jpe, kps, kpe,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+         CALL set_physical_bc2d( grid%em_muts, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+         CALL set_physical_bc2d( grid%em_mu_2, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+         CALL set_physical_bc2d( grid%em_mudf, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+      END DO
+      !$OMP END PARALLEL DO
+BENCH_END(phys_bc_tim)
+
+   END DO small_steps
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , grid%num_tiles
+
+      CALL wrf_debug ( 200 , ' call rk_small_finish' )
+
+      ! change time-perturbation variables back to 
+      ! full perturbation variables.
+      ! first get updated mu at u and v points
+
+BENCH_START(calc_mu_uv_tim)
+      CALL calc_mu_uv_1 ( config_flags,                     &
+                          grid%em_muts, muus, muvs,                 &
+                          ids, ide, jds, jde, kds, kde,     &
+                          ims, ime, jms, jme, kms, kme,     &
+                          grid%i_start(ij), grid%i_end(ij), &
+                          grid%j_start(ij), grid%j_end(ij), &
+                          k_start    , k_end               )
+BENCH_END(calc_mu_uv_tim)
+BENCH_START(small_step_finish_tim)
+      CALL small_step_finish( grid%em_u_2, grid%em_u_1, grid%em_v_2, grid%em_v_1, grid%em_w_2, grid%em_w_1,     &
+                              grid%em_t_2, grid%em_t_1, grid%em_ph_2, grid%em_ph_1, grid%em_ww, ww1,    &
+                              grid%em_mu_2, grid%em_mu_1,                       &
+                              grid%em_mut, grid%em_muts, grid%em_muu, muus, grid%em_muv, muvs,  & 
+                              grid%em_u_save, grid%em_v_save, w_save,           &
+                              grid%em_t_save, ph_save, mu_save,         &
+                              grid%msfu, grid%msfv, grid%msft,                 &
+                              grid%h_diabatic,                       &
+                              number_of_small_timesteps,dts_rk, &
+                              rk_step, rk_order,                &
+                              ids, ide, jds, jde, kds, kde,     &
+                              ims, ime, jms, jme, kms, kme,     &
+                              grid%i_start(ij), grid%i_end(ij), &
+                              grid%j_start(ij), grid%j_end(ij), &
+                              k_start    , k_end               )
+!  call  to set ru_m, rv_m and ww_m b.c's for PD advection
+
+         IF (rk_step == 3) THEN
+
+           CALL set_physical_bc3d( grid%em_ru_m, 'u', config_flags,   &
+                                   ids, ide, jds, jde, kds, kde,      &
+                                   ims, ime, jms, jme, kms, kme,      &
+                                   ips, ipe, jps, jpe, kps, kpe,      &
+                                   grid%i_start(ij), grid%i_end(ij),  &
+                                   grid%j_start(ij), grid%j_end(ij),  &
+                                   k_start    , k_end                )
+
+           CALL set_physical_bc3d( grid%em_rv_m, 'v', config_flags,   &
+                                   ids, ide, jds, jde, kds, kde,      &
+                                   ims, ime, jms, jme, kms, kme,      &
+                                   ips, ipe, jps, jpe, kps, kpe,      &
+                                   grid%i_start(ij), grid%i_end(ij),  &
+                                   grid%j_start(ij), grid%j_end(ij),  &
+                                   k_start    , k_end                )
+
+           CALL set_physical_bc3d( grid%em_ww_m, 'w', config_flags,   &
+                                   ids, ide, jds, jde, kds, kde,      &
+                                   ims, ime, jms, jme, kms, kme,      &
+                                   ips, ipe, jps, jpe, kps, kpe,      &
+                                   grid%i_start(ij), grid%i_end(ij),  &
+                                   grid%j_start(ij), grid%j_end(ij),  &
+                                   k_start    , k_end                )
+
+           CALL set_physical_bc2d( grid%em_mut, 't', config_flags,   &
+                                   ids, ide, jds, jde,               &
+                                   ims, ime, jms, jme,                &
+                                   ips, ipe, jps, jpe,                &
+                                   grid%i_start(ij), grid%i_end(ij),  &
+                                   grid%j_start(ij), grid%j_end(ij) )
+
+          END IF
+
+BENCH_END(small_step_finish_tim)
+
+   END DO
+   !$OMP END PARALLEL DO
+
+!-----------------------------------------------------------------------
+!  add in physics tendency first if positive definite advection is used.
+!  pd advection applies advective flux limiter on last runge-kutta step
+!-----------------------------------------------------------------------
+! first moisture
+
+  IF (config_flags%pd_moist .and. (rk_step == rk_order)) THEN
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+       CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+       do im = PARAM_FIRST_SCALAR, num_3d_m
+       CALL rk_update_scalar_pd( im, im,                                   &
+                                 moist_old(ims,kms,jms,im),                &
+                                 moist_tend(ims,kms,jms,im),               &
+                                 grid%em_mu_1, grid%em_mu_1, grid%em_mub,  &
+                                 rk_step, dt_rk, grid%spec_zone,           &
+                                 config_flags,                             &
+                                 ids, ide, jds, jde, kds, kde,             &
+                                 ims, ime, jms, jme, kms, kme,             &
+                                 grid%i_start(ij), grid%i_end(ij),         &
+                                 grid%j_start(ij), grid%j_end(ij),         &
+                                 k_start    , k_end                       )
+       ENDDO
+   END DO
+   !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+      IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+        DO im = PARAM_FIRST_SCALAR , num_3d_m
+          CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags,   &
+                                   ids, ide, jds, jde, kds, kde,                  &
+                                   ims, ime, jms, jme, kms, kme,                  &
+                                   ips, ipe, jps, jpe, kps, kpe,                  &
+                                   grid%i_start(ij), grid%i_end(ij),              &
+                                   grid%j_start(ij), grid%j_end(ij),              &
+                                   k_start    , k_end                            )
+         END DO
+      ENDIF
+   END DO
+   !$OMP END PARALLEL DO
+
+#ifdef DM_PARALLEL
+   if(config_flags%pd_moist) then
+#ifndef RSL
+     IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_MOIST_OLD_E_5.inc"
+     ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_MOIST_OLD_E_7.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+#else
+       WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+#endif     
+  endif
+#endif
+
+   END IF  ! end if for pd_moist
+
+! scalars
+
+  IF (config_flags%pd_scalar .and. (rk_step == rk_order)) THEN
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , grid%num_tiles
+       CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+       do im = PARAM_FIRST_SCALAR, num_3d_s
+       CALL rk_update_scalar_pd( im, im,                                  &
+                                 scalar_old(ims,kms,jms,im),              &
+                                 scalar_tend(ims,kms,jms,im),             &
+                                 grid%em_mu_1, grid%em_mu_1, grid%em_mub, &
+                                 rk_step, dt_rk, grid%spec_zone,          &
+                                 config_flags,                            &
+                                 ids, ide, jds, jde, kds, kde,            &
+                                 ims, ime, jms, jme, kms, kme,            &
+                                 grid%i_start(ij), grid%i_end(ij),        &
+                                 grid%j_start(ij), grid%j_end(ij),        &
+                                 k_start    , k_end                      )
+       ENDDO
+   ENDDO
+   !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , grid%num_tiles
+      IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+        DO im = PARAM_FIRST_SCALAR , num_3d_s
+            CALL set_physical_bc3d(  scalar_old(ims,kms,jms,im), 'p', config_flags, &
+                                   ids, ide, jds, jde, kds, kde,                    &
+                                   ims, ime, jms, jme, kms, kme,                    &
+                                   ips, ipe, jps, jpe, kps, kpe,                    &
+                                   grid%i_start(ij), grid%i_end(ij),                &
+                                   grid%j_start(ij), grid%j_end(ij),                &
+                                   k_start    , k_end                              )
+         END DO
+      ENDIF
+   END DO
+   !$OMP END PARALLEL DO
+
+#ifdef DM_PARALLEL
+   if(config_flags%pd_scalar) then
+#ifndef RSL
+     IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_SCALAR_OLD_E_5.inc"
+     ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_SCALAR_OLD_E_7.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+#else
+       WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+#endif     
+  endif
+#endif
+
+   END IF  ! end if for pd_scalar
+
+! chem
+
+  IF (config_flags%pd_chem .and. (rk_step == rk_order)) THEN
+
+   write(6,*) ' pd advection for chem '
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+       CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+       do im = PARAM_FIRST_SCALAR, num_3d_c
+       CALL rk_update_scalar_pd( im, im,                                  &
+                                 chem_old(ims,kms,jms,im),                &
+                                 chem_tend(ims,kms,jms,im),               &
+                                 grid%em_mu_1, grid%em_mu_1, grid%em_mub, &
+                                 rk_step, dt_rk, grid%spec_zone,          &
+                                 config_flags,                            &
+                                 ids, ide, jds, jde, kds, kde,            &
+                                 ims, ime, jms, jme, kms, kme,            &
+                                 grid%i_start(ij), grid%i_end(ij),        &
+                                 grid%j_start(ij), grid%j_end(ij),        &
+                                 k_start    , k_end                      )
+       ENDDO
+   END DO
+   !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+      IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+        DO im = PARAM_FIRST_SCALAR , num_3d_c
+          CALL set_physical_bc3d(  chem_old(ims,kms,jms,im), 'p', config_flags,     &
+                                   ids, ide, jds, jde, kds, kde,                    &
+                                   ims, ime, jms, jme, kms, kme,                    &
+                                   ips, ipe, jps, jpe, kps, kpe,                    &
+                                   grid%i_start(ij), grid%i_end(ij),                &
+                                   grid%j_start(ij), grid%j_end(ij),                &
+                                   k_start    , k_end                              )
+         END DO 
+      ENDIF
+   END DO
+   !$OMP END PARALLEL DO
+
+
+#ifdef DM_PARALLEL
+   if(config_flags%pd_chem) then
+#ifndef RSL
+     IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_CHEM_OLD_E_5.inc"
+     ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_CHEM_OLD_E_7.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+#else
+       WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+#endif     
+  endif
+#endif
+
+  END IF  ! end if for pd_chem
+
+! tke
+
+  IF (config_flags%pd_tke .and. (rk_step == rk_order) &
+      .and. (config_flags%km_opt .eq. 2)                ) THEN
+
+   write(6,*) ' pd advection for tke '
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , grid%num_tiles
+       CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+       CALL rk_update_scalar_pd( 1, 1,                                    &
+                                 grid%em_tke_1,                           &
+                                 tke_tend(ims,kms,jms),                   &
+                                 grid%em_mu_1, grid%em_mu_1, grid%em_mub, &
+                                 rk_step, dt_rk, grid%spec_zone,          &
+                                 config_flags,                            &
+                                 ids, ide, jds, jde, kds, kde,            &
+                                 ims, ime, jms, jme, kms, kme,            &
+                                 grid%i_start(ij), grid%i_end(ij),        &
+                                 grid%j_start(ij), grid%j_end(ij),        &
+                                 k_start    , k_end                      )
+   END DO
+   !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+          CALL set_physical_bc3d(  grid%em_tke_1, 'p', config_flags,  &
+                                   ids, ide, jds, jde, kds, kde,      &
+                                   ims, ime, jms, jme, kms, kme,      &
+                                   ips, ipe, jps, jpe, kps, kpe,      &
+                                   grid%i_start(ij), grid%i_end(ij),  &
+                                   grid%j_start(ij), grid%j_end(ij),  &
+                                   k_start    , k_end                )
+   END DO
+   !$OMP END PARALLEL DO
+
+!---  end of positive definite physics tendency update
+
+#ifdef DM_PARALLEL
+     IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_TKE_OLD_E_5.inc"
+     ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_TKE_OLD_E_7.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+#endif
+
+   END IF  ! end if for pd_tke
+
+#ifdef DM_PARALLEL
+!
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!
+! grid%em_ru_m      x
+! grid%em_rv_m      x
+! grid%em_ww_m      x
+! grid%em_mut       x
+!
+!--------------------------------------------------------------
+
+#  include "HALO_EM_D.inc"
+#endif
+
+!<DESCRIPTION>
+!<pre>
+! (4) Still within the RK loop, the scalar variables are advanced.
+!
+!    For the moist and chem variables, each one is advanced
+!    individually, using named loops "moist_variable_loop:"
+!    and "chem_variable_loop:".  Each RK substep begins by
+!    calculating the advective tendency, and, for the first RK step, 
+!    3D mixing (calling rk_scalar_tend) followed by an update
+!    of the scalar (calling rk_scalar_update).
+!</pre>
+!</DESCRIPTION>
+
+
+  moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR )  THEN
+
+   moist_variable_loop: do im = PARAM_FIRST_SCALAR, num_3d_m
+
+   if (grid%adv_moist_cond .or. im==p_qv ) then
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   moist_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
+
+BENCH_START(rk_scalar_tend_tim)
+
+       CALL rk_scalar_tend (  im, im, config_flags,                                      &
+                              rk_step, dt_rk,                                            &
+                              grid%em_ru_m, grid%em_rv_m, grid%em_ww_m,                  &
+                              grid%em_mut, grid%em_mub, grid%em_mu_1,                    &
+                              grid%em_alt,                                               &
+                              moist_old(ims,kms,jms,im),                                 &
+                              moist(ims,kms,jms,im),                                     &
+                              moist_tend(ims,kms,jms,im),                                &
+                              advect_tend,grid%rqvften,                                  &
+                              grid%qv_base, .true., grid%em_fnm, grid%em_fnp,            &
+                              grid%msfu, grid%msfv, grid%msft,                           &
+                              grid%rdx, grid%rdy, grid%em_rdn, grid%em_rdnw, grid%khdif, &
+                              grid%kvdif, grid%xkmhd,                                    &
+                              grid%diff_6th_opt, grid%diff_6th_factor,                   &
+                              config_flags%pd_moist,            &
+                              ids, ide, jds, jde, kds, kde,     &
+                              ims, ime, jms, jme, kms, kme,     &
+                              grid%i_start(ij), grid%i_end(ij), &
+                              grid%j_start(ij), grid%j_end(ij), &
+                              k_start    , k_end               )
+
+BENCH_END(rk_scalar_tend_tim)
+
+BENCH_START(rlx_bdy_scalar_tim)
+     IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN 
+         IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
+            CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            & 
+                                    moist(ims,kms,jms,im),  grid%em_mut,         &
+                                    moist_b(1,1,1,1,im),                   &
+                                    moist_bt(1,1,1,1,im),                  &
+                                    config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
+                                    grid%dtbc, grid%fcx, grid%gcx,             &
+                                    config_flags,               &
+                                    ijds, ijde,                 & ! min/max(id,jd)
+                                    ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                    ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                    ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                    grid%i_start(ij), grid%i_end(ij),      &
+                                    grid%j_start(ij), grid%j_end(ij),      &
+                                    k_start, k_end                        )
+
+            CALL spec_bdy_scalar  ( moist_tend(ims,kms,jms,im),                &
+                                    moist_b(1,1,1,1,im),                     &
+                                    moist_bt(1,1,1,1,im),                    &
+                                    config_flags%spec_bdy_width, grid%spec_zone,                 &
+                                    config_flags,               &
+                                    ijds, ijde,                 & ! min/max(id,jd)
+                                    ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                    ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                    ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                    grid%i_start(ij), grid%i_end(ij),          &
+                                    grid%j_start(ij), grid%j_end(ij),          &
+                                    k_start, k_end                               )
+          ENDIF
+     ENDIF
+BENCH_END(rlx_bdy_scalar_tim)
+
+   ENDDO moist_tile_loop_1
+   !$OMP END PARALLEL DO
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   moist_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+
+BENCH_START(update_scal_tim)
+       CALL rk_update_scalar( im, im,                           &
+                              moist_old(ims,kms,jms,im),        &
+                              moist(ims,kms,jms,im),            &
+                              moist_tend(ims,kms,jms,im),       &
+                              advect_tend, grid%msft,                &
+                              grid%em_mu_1, grid%em_mu_2, grid%em_mub,                  &
+                              rk_step, dt_rk, grid%spec_zone,        &
+                              config_flags,     &
+                              ids, ide, jds, jde, kds, kde,     &
+                              ims, ime, jms, jme, kms, kme,     &
+                              grid%i_start(ij), grid%i_end(ij), &
+                              grid%j_start(ij), grid%j_end(ij), &
+                              k_start    , k_end               )
+BENCH_END(update_scal_tim)
+
+BENCH_START(flow_depbdy_tim)
+       IF( config_flags%specified ) THEN
+         IF(im .ne. P_QV)THEN
+           CALL flow_dep_bdy  (  moist(ims,kms,jms,im),                     &
+                               grid%em_ru_m, grid%em_rv_m, config_flags, &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               grid%i_start(ij), grid%i_end(ij),                      &
+                               grid%j_start(ij), grid%j_end(ij),                      &
+                               k_start, k_end                               )
+         ENDIF
+       ENDIF
+BENCH_END(flow_depbdy_tim)
+
+   ENDDO moist_tile_loop_2
+   !$OMP END PARALLEL DO
+
+     ENDIF  !-- if (grid%adv_moist_cond .or. im==p_qv ) then
+
+   ENDDO moist_variable_loop
+
+ ENDIF moist_scalar_advance
+
+BENCH_START(tke_adv_tim)
+ TKE_advance: IF (config_flags%km_opt .eq. 2) then
+
+#ifdef DM_PARALLEL
+      IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#       include "HALO_EM_TKE_ADVECT_3.inc"
+      ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#       include "HALO_EM_TKE_ADVECT_5.inc"
+      ELSE
+        WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+        CALL wrf_error_fatal(TRIM(wrf_err_message))
+      ENDIF
+#endif
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   tke_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+     CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
+     CALL rk_scalar_tend ( 1, 1, config_flags,                                        &
+                           rk_step, dt_rk,                                            &
+                           grid%em_ru_m, grid%em_rv_m, grid%em_ww_m,                  &
+                           grid%em_mut, grid%em_mub, grid%em_mu_1,                    &
+                           grid%em_alt,                                               &
+                           grid%em_tke_1,                                             &
+                           grid%em_tke_2,                                             &
+                           tke_tend(ims,kms,jms),                                     &
+                           advect_tend,grid%rqvften,                                  &
+                           grid%qv_base, .false., grid%em_fnm, grid%em_fnp,           &
+                           grid%msfu, grid%msfv, grid%msft,                           &
+                           grid%rdx, grid%rdy, grid%em_rdn, grid%em_rdnw, grid%khdif, &
+                           grid%kvdif, grid%xkmhd,                                    &
+                           grid%diff_6th_opt, grid%diff_6th_factor,                   &
+                           config_flags%pd_tke,              &
+                           ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           grid%i_start(ij), grid%i_end(ij), &
+                           grid%j_start(ij), grid%j_end(ij), &
+                           k_start    , k_end               )
+
+   ENDDO tke_tile_loop_1
+   !$OMP END PARALLEL DO
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   tke_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+     CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+     CALL rk_update_scalar( 1, 1,                             &
+                            grid%em_tke_1,               &
+                            grid%em_tke_2,               &
+                            tke_tend(ims,kms,jms),            &
+                            advect_tend,grid%msft,                 &
+                            grid%em_mu_1, grid%em_mu_2, grid%em_mub,                  &
+                            rk_step, dt_rk, grid%spec_zone,        &
+                            config_flags,     &
+                            ids, ide, jds, jde, kds, kde,     &
+                            ims, ime, jms, jme, kms, kme,     &
+                            grid%i_start(ij), grid%i_end(ij), &
+                            grid%j_start(ij), grid%j_end(ij), &
+                            k_start    , k_end               ) 
+
+! bound the tke (greater than 0, less than tke_upper_bound)
+
+     CALL bound_tke( grid%em_tke_2, grid%tke_upper_bound, &
+                     ids, ide, jds, jde, kds, kde,        &
+                     ims, ime, jms, jme, kms, kme,        &
+                     grid%i_start(ij), grid%i_end(ij),    &
+                     grid%j_start(ij), grid%j_end(ij),    &
+                     k_start    , k_end                  )
+
+     IF( config_flags%specified .or. config_flags%nested ) THEN
+         CALL flow_dep_bdy (  grid%em_tke_2,                     &
+                              grid%em_ru_m, grid%em_rv_m, config_flags,               &
+                              grid%spec_zone,                              &
+                              ids,ide, jds,jde, kds,kde,  & ! domain dims
+                              ims,ime, jms,jme, kms,kme,  & ! memory dims
+                              ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                              grid%i_start(ij), grid%i_end(ij),       &
+                              grid%j_start(ij), grid%j_end(ij),       &
+                              k_start, k_end                               )
+     ENDIF
+   ENDDO tke_tile_loop_2
+   !$OMP END PARALLEL DO
+
+   END IF TKE_advance
+BENCH_END(tke_adv_tim)
+
+#ifdef WRF_CHEM
+!  next the chemical species
+BENCH_START(chem_adv_tim)
+  chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR)  THEN
+
+   chem_variable_loop: do ic = PARAM_FIRST_SCALAR, num_3d_c
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   chem_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
+       CALL rk_scalar_tend ( ic, ic, config_flags,                            &
+                             rk_step, dt_rk,                                  &
+                             grid%em_ru_m, grid%em_rv_m, grid%em_ww_m,        &
+                             grid%em_mut, grid%em_mub, grid%em_mu_1,          &
+                             grid%em_alt,                                     &
+                             chem_old(ims,kms,jms,ic),                        &
+                             chem(ims,kms,jms,ic),                            &
+                             chem_tend(ims,kms,jms,ic),                       &
+                             advect_tend,grid%rqvften,                        &
+                             grid%qv_base, .false., grid%em_fnm, grid%em_fnp, &
+                             grid%msfu, grid%msfv, grid%msft,                 &
+                             grid%rdx, grid%rdy, grid%em_rdn, grid%em_rdnw,   &
+                             grid%khdif, grid%kvdif, grid%xkmhd,              &
+                             grid%diff_6th_opt, grid%diff_6th_factor,         &
+                             config_flags%pd_chem,             &
+                             ids, ide, jds, jde, kds, kde,     &
+                             ims, ime, jms, jme, kms, kme,     &
+                             grid%i_start(ij), grid%i_end(ij), &
+                             grid%j_start(ij), grid%j_end(ij), &
+                             k_start    , k_end               )
+!
+! Currently, chemistry species with specified boundaries (i.grid%e. the mother
+! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
+! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
+!
+     IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
+       if(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
+
+         CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic),             &
+                                 chem(ims,kms,jms,ic),  grid%em_mut,            &
+                                 chem_b(1,1,1,1,ic),                    &
+                                 chem_bt(1,1,1,1,ic),                   &
+                                 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
+                                 grid%dtbc, grid%fcx, grid%gcx,             &
+                                 config_flags,               &
+                                 ijds, ijde,                 & ! min/max(id,jd)
+                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                 grid%i_start(ij), grid%i_end(ij),      &
+                                 grid%j_start(ij), grid%j_end(ij),      &
+                                 k_start, k_end                         )
+         CALL spec_bdy_scalar  ( chem_tend(ims,kms,jms,ic),                 &
+                                 chem_b(1,1,1,1,ic),                        &
+                                 chem_bt(1,1,1,1,ic),                       &
+                                 config_flags%spec_bdy_width, grid%spec_zone,                 &
+                                 config_flags,               &
+                                 ijds, ijde,                 & ! min/max(id,jd)
+                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                 grid%i_start(ij), grid%i_end(ij),          &
+                                 grid%j_start(ij), grid%j_end(ij),          &
+                                 k_start, k_end                             )
+     ENDIF
+
+   ENDDO chem_tile_loop_1
+
+   !$OMP END PARALLEL DO
+
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   chem_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+       CALL rk_update_scalar( ic, ic,                           &
+                              chem_old(ims,kms,jms,ic),         &  ! was chem_1
+                              chem(ims,kms,jms,ic),             &
+                              chem_tend(ims,kms,jms,ic),        &
+                              advect_tend, grid%msft,                &
+                              grid%em_mu_1, grid%em_mu_2, grid%em_mub,                  &
+                              rk_step, dt_rk, grid%spec_zone,        &
+                              config_flags,     &
+                              ids, ide, jds, jde, kds, kde,     &
+                              ims, ime, jms, jme, kms, kme,     &
+                              grid%i_start(ij), grid%i_end(ij), &
+                              grid%j_start(ij), grid%j_end(ij), &
+                              k_start    , k_end               )
+
+
+       IF( config_flags%specified  ) THEN
+! come back to this and figure out why two different routines are needed. JM 20041203
+!#ifndef WRF_CHEM
+!!$           CALL flow_dep_bdy  ( chem(ims,kms,jms,ic),       &
+!!$                                grid%em_ru_m, grid%em_rv_m, config_flags,   &
+!!$                                grid%spec_zone,             &
+!!$                                ids,ide, jds,jde, kds,kde,  & ! domain dims
+!!$                                ims,ime, jms,jme, kms,kme,  & ! memory dims
+!!$                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+!!$                                grid%i_start(ij), grid%i_end(ij),  &
+!!$                                grid%j_start(ij), grid%j_end(ij),  &
+!!$                                k_start, k_end                    )
+!#else
+           CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic),            &
+                                chem_b(1,1,1,1,ic),                 &
+                                chem_bt(1,1,1,1,ic), dt_rk,         &
+                                config_flags%spec_bdy_width,grid%em_z,      &
+                                ijds, ijde,grid%have_bcs_chem,      &
+                                grid%em_ru_m, grid%em_rv_m, config_flags,grid%em_alt,       &
+                                grid%em_t_1,grid%em_pb,grid%em_p,t0,p1000mb,rcp,grid%em_ph_2,grid%em_phb,g, &
+                                grid%spec_zone,ic,                  &
+                                ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                grid%i_start(ij), grid%i_end(ij),   &
+                                grid%j_start(ij), grid%j_end(ij),   &
+                                k_start, k_end                      )
+!#endif
+       ENDIF
+
+
+   ENDDO chem_tile_loop_2
+   !$OMP END PARALLEL DO
+
+   ENDDO chem_variable_loop
+
+ ENDIF chem_scalar_advance
+BENCH_END(chem_adv_tim)
+#endif
+
+!  next the other scalar species
+  other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR)  THEN
+
+   scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
+       CALL rk_scalar_tend ( is, is, config_flags,                            &
+                             rk_step, dt_rk,                                  &
+                             grid%em_ru_m, grid%em_rv_m, grid%em_ww_m,        &
+                             grid%em_mut, grid%em_mub, grid%em_mu_1,          &
+                             grid%em_alt,                                     &
+                             scalar_old(ims,kms,jms,is),                      &
+                             scalar(ims,kms,jms,is),                          &
+                             scalar_tend(ims,kms,jms,is),                     &
+                             advect_tend,grid%rqvften,                        &
+                             grid%qv_base, .false., grid%em_fnm, grid%em_fnp, &
+                             grid%msfu, grid%msfv, grid%msft,                 &
+                             grid%rdx, grid%rdy, grid%em_rdn, grid%em_rdnw,   &
+                             grid%khdif, grid%kvdif, grid%xkmhd,              &
+                             grid%diff_6th_opt, grid%diff_6th_factor,         &
+                             config_flags%pd_scalar,           &
+                             ids, ide, jds, jde, kds, kde,     &
+                             ims, ime, jms, jme, kms, kme,     &
+                             grid%i_start(ij), grid%i_end(ij), &
+                             grid%j_start(ij), grid%j_end(ij), &
+                             k_start    , k_end               )
+
+!!!!****MARS
+!     IF( config_flags%nested .and. (rk_step == 1) ) THEN
+!       IF (is .eq. P_QNI) THEN
+     IF ( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1) THEN
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!****MARS MARS MARS: what to do with tracers at the boundaries ??? !!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!IF (  ( (config_flags%mars .eq.  1) .AND. (is .EQ. 2) ) &    !! 1   pass only water vapor
+IF  ( (  config_flags%mars .eq.  1                    ) &    !! 1   pass water vapor AND ice
+ .OR. (  config_flags%mars .eq.  2                    ) &    !! 2   pass the dust tracer
+ .OR. (  config_flags%mars .eq.  3                    ) &    !! 3   pass dust Q and N 
+ .OR. (  config_flags%mars .eq.  10                   ) &    !! 10  pass the co2 tracer
+! .OR. ( (config_flags%mars .eq. 11) .AND. (is .EQ. 2) ) &    !! 11  pass only water vapor
+ .OR. (  config_flags%mars .eq. 11                    ) &    !! 11  pass EVERYTHING
+ .OR. (  config_flags%mars .eq. 12                    ) &    !! 12  pass EVERYTHING 
+ .OR. (  config_flags%mars .eq. 34                    ) &
+ .OR. config_flags%nested ) THEN                             !! *   pass all tracers if nested
+         CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is),            &
+                                 scalar(ims,kms,jms,is),  grid%em_mut,         &
+                                 scalar_b(1,1,1,1,is),                   &
+                                 scalar_bt(1,1,1,1,is),                  &
+                                 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
+                                 grid%dtbc, grid%fcx, grid%gcx,             &
+                                 config_flags,               &
+                                 ijds, ijde,                 & ! min/max(id,jd)
+                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                 grid%i_start(ij), grid%i_end(ij),      &
+                                 grid%j_start(ij), grid%j_end(ij),      &
+                                 k_start, k_end                        )
+
+         CALL spec_bdy_scalar  ( scalar_tend(ims,kms,jms,is),                &
+                                 scalar_b(1,1,1,1,is),                   &
+                                 scalar_bt(1,1,1,1,is),                  &
+                                 config_flags%spec_bdy_width, grid%spec_zone, &
+                                 config_flags,               &
+                                 ijds, ijde,                 & ! min/max(id,jd)
+                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                 grid%i_start(ij), grid%i_end(ij),          &
+                                 grid%j_start(ij), grid%j_end(ij),          &
+                                 k_start, k_end                               )
+ENDIF
+
+      ENDIF
+
+   ENDDO scalar_tile_loop_1
+   !$OMP END PARALLEL DO
+
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+       CALL rk_update_scalar( is, is,                           &
+                              scalar_old(ims,kms,jms,is),       &  ! was scalar_1
+                              scalar(ims,kms,jms,is),           &
+                              scalar_tend(ims,kms,jms,is),      &
+                              advect_tend, grid%msft,                &
+                              grid%em_mu_1, grid%em_mu_2, grid%em_mub,                  &
+                              rk_step, dt_rk, grid%spec_zone,        &
+                              config_flags,     &
+                              ids, ide, jds, jde, kds, kde,     &
+                              ims, ime, jms, jme, kms, kme,     &
+                              grid%i_start(ij), grid%i_end(ij), &
+                              grid%j_start(ij), grid%j_end(ij), &
+                              k_start    , k_end               )
+
+!!!!!****MARS: if parent domain and any other tracer than water vapor, no bdy and simple zero flux bdy condition
+IF ( config_flags%specified ) THEN
+!IF (      ((config_flags%mars .eq. 1 ) .and. (is .ne. 2))  &   
+!     .OR. ((config_flags%mars .eq. 11) .and. (is .ne. 2))  ) THEN
+IF ( config_flags%mars .gt. 50 ) THEN
+
+     !!! YOU HAVE TO ADD A CONDITION HERE IF YOU ADD A mars OPTION in REGISTRY  !!!
+     !!! (this is OK if you are using LES with periodic boundary conditions)    
+
+        CALL flow_dep_bdy  ( scalar(ims,kms,jms,is),     &
+                                grid%em_ru_m, grid%em_rv_m, config_flags,   &
+                                grid%spec_zone,                  &
+                                ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                grid%i_start(ij), grid%i_end(ij),  &
+                                grid%j_start(ij), grid%j_end(ij),  &
+                                k_start, k_end                    )
+
+ENDIF
+ENDIF
+
+   ENDDO scalar_tile_loop_2
+   !$OMP END PARALLEL DO
+
+   ENDDO scalar_variable_loop
+
+ ENDIF other_scalar_advance
+
+ !  update the pressure and density at the new time level
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+
+BENCH_START(calc_p_rho_tim)
+
+     CALL calc_p_rho_phi( moist, num_3d_m,                &
+                          grid%em_al, grid%em_alb, grid%em_mu_2, grid%em_muts,              &
+                          grid%em_ph_2, grid%em_p, grid%em_pb, grid%em_t_2,                 &
+                          p0, t0, grid%em_znu, grid%em_dnw, grid%em_rdnw,           &
+                          grid%em_rdn, config_flags%non_hydrostatic,             &
+                          ids, ide, jds, jde, kds, kde,     &
+                          ims, ime, jms, jme, kms, kme,     &
+                          grid%i_start(ij), grid%i_end(ij), &
+                          grid%j_start(ij), grid%j_end(ij), &
+                          k_start    , k_end               )
+
+BENCH_END(calc_p_rho_tim)
+
+   ENDDO
+   !$OMP END PARALLEL DO
+
+!  Reset the boundary conditions if there is another corrector step.
+!  (rk_step < rk_order), else we'll handle it at the end of everything
+!  (after the split physics, before exiting the timestep).
+
+   rk_step_1_check: IF ( rk_step < rk_order ) THEN
+
+!-----------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!  here's where we need a wide comm stencil - these are the 
+!  uncoupled variables so are used for high order calc in
+!  advection and mixong routines.
+!
+!                              * * * * *
+!            *        * * *    * * * * *
+!          * + *      * + *    * * + * * 
+!            *        * * *    * * * * *
+!                              * * * * *
+!
+!
+! grid%em_u_2                              x
+! grid%em_v_2                              x
+! grid%em_w_2                              x
+! grid%em_t_2                              x
+! grid%em_ph_2                             x
+! grid%em_al         x
+!
+!  2D variable
+! grid%em_mu_2       x
+!
+!  4D variable
+! moist               x
+! chem                x
+!scalar               x
+
+#ifdef DM_PARALLEL
+   IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#    include "HALO_EM_D2_3.inc"
+   ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#    include "HALO_EM_D2_5.inc"
+   ELSE 
+     WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+     CALL wrf_error_fatal(TRIM(wrf_err_message))
+   ENDIF
+#  include "PERIOD_BDY_EM_D.inc"
+#  include "PERIOD_BDY_EM_MOIST2.inc"
+#  include "PERIOD_BDY_EM_CHEM2.inc"
+#  include "PERIOD_BDY_EM_SCALAR2.inc"
+#endif
+
+BENCH_START(bc_end_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+    tile_bc_loop_1: DO ij = 1 , grid%num_tiles
+
+
+      CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
+
+      CALL rk_phys_bc_dry_2( config_flags,                         &
+                             grid%em_u_2, grid%em_v_2, grid%em_w_2,                    &
+                             grid%em_t_2, grid%em_ph_2, grid%em_mu_2,                  &
+                             ids, ide, jds, jde, kds, kde,     &
+                             ims, ime, jms, jme, kms, kme,     &
+                             ips, ipe, jps, jpe, kps, kpe,     &
+                             grid%i_start(ij), grid%i_end(ij), &
+                             grid%j_start(ij), grid%j_end(ij), &
+                             k_start    , k_end               )
+
+BENCH_START(diag_w_tim)
+     IF (.not. config_flags%non_hydrostatic) THEN
+     CALL diagnose_w( ph_tend, grid%em_ph_2, grid%em_ph_1, grid%em_w_2, grid%em_muts, dt_rk,  &
+                      grid%em_u_2, grid%em_v_2, grid%ht,                           &
+                      grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msft,          &
+                      ids, ide, jds, jde, kds, kde,           &
+                      ims, ime, jms, jme, kms, kme,           &
+                      grid%i_start(ij), grid%i_end(ij),       &
+                      grid%j_start(ij), grid%j_end(ij),       &
+                      k_start    , k_end                     )
+     ENDIF
+BENCH_END(diag_w_tim)
+
+      IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+
+        moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
+  
+          CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags,   &
+                                   ids, ide, jds, jde, kds, kde,             &
+                                   ims, ime, jms, jme, kms, kme,             &
+                                   ips, ipe, jps, jpe, kps, kpe,             &
+                                   grid%i_start(ij), grid%i_end(ij),                   &
+                                   grid%j_start(ij), grid%j_end(ij),                   &
+                                   k_start    , k_end                       )
+         END DO moisture_loop_bdy_1
+
+      ENDIF
+
+      IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
+
+        chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
+
+          CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags,   &
+                                  ids, ide, jds, jde, kds, kde,            &
+                                  ims, ime, jms, jme, kms, kme,            &
+                                  ips, ipe, jps, jpe, kps, kpe,            &
+                                  grid%i_start(ij), grid%i_end(ij),                  &
+                                  grid%j_start(ij), grid%j_end(ij),                  &
+                                  k_start    , k_end-1                    )
+
+        END DO chem_species_bdy_loop_1
+
+      END IF
+
+      IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
+
+        scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
+
+          CALL set_physical_bc3d( scalar(ims,kms,jms,is), 'p', config_flags,   &
+                                  ids, ide, jds, jde, kds, kde,            &
+                                  ims, ime, jms, jme, kms, kme,            &
+                                  ips, ipe, jps, jpe, kps, kpe,            &
+                                  grid%i_start(ij), grid%i_end(ij),                  &
+                                  grid%j_start(ij), grid%j_end(ij),                  &
+                                  k_start    , k_end-1                    )
+
+        END DO scalar_species_bdy_loop_1
+
+      END IF
+
+      IF (config_flags%km_opt .eq. 2) THEN
+
+        CALL set_physical_bc3d( grid%em_tke_2 , 'p', config_flags,  &
+                                ids, ide, jds, jde, kds, kde,            &
+                                ims, ime, jms, jme, kms, kme,            &
+                                ips, ipe, jps, jpe, kps, kpe,            &
+                                grid%i_start(ij), grid%i_end(ij),        &
+                                grid%j_start(ij), grid%j_end(ij),        &
+                                k_start    , k_end                      )
+      END IF
+
+    END DO tile_bc_loop_1
+   !$OMP END PARALLEL DO
+BENCH_END(bc_end_tim)
+
+
+#ifdef DM_PARALLEL
+
+!                           * * * * *
+!         *        * * *    * * * * *
+!       * + *      * + *    * * + * *
+!         *        * * *    * * * * *
+!                           * * * * *
+
+! moist, chem, scalar, tke      x
+
+
+      IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+        IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
+#         include "HALO_EM_TKE_5.inc"
+        ELSE
+#         include "HALO_EM_TKE_3.inc"
+        ENDIF
+      ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+        IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
+#         include "HALO_EM_TKE_7.inc"
+        ELSE
+#         include "HALO_EM_TKE_5.inc"
+        ENDIF
+      ELSE
+        WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+        CALL wrf_error_fatal(TRIM(wrf_err_message))
+      ENDIF
+
+#if 0
+   IF (config_flags%km_opt .eq. 2) THEN
+#      include  "HALO_EM_TKE_F.inc"
+   ENDIF
+#endif
+
+   if ( num_moist .ge. PARAM_FIRST_SCALAR ) then
+     IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+       IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_MOIST_E_5.inc"
+       ELSE
+#        include "HALO_EM_MOIST_E_3.inc"
+       END IF
+     ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+       IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_MOIST_E_7.inc"
+       ELSE
+#        include "HALO_EM_MOIST_E_5.inc"
+       END IF
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   endif
+   if ( num_chem >= PARAM_FIRST_SCALAR ) then
+     IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+       IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_CHEM_E_5.inc"
+       ELSE
+#        include "HALO_EM_CHEM_E_3.inc"
+       END IF
+     ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+       IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_CHEM_E_7.inc"
+       ELSE
+#        include "HALO_EM_CHEM_E_5.inc"
+       END IF
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   endif
+   if ( num_scalar >= PARAM_FIRST_SCALAR ) then
+     IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+       IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_SCALAR_E_5.inc"
+       ELSE
+#        include "HALO_EM_SCALAR_E_3.inc"
+       END IF
+     ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+       IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_SCALAR_E_7.inc"
+       ELSE
+#        include "HALO_EM_SCALAR_E_5.inc"
+       END IF
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   endif
+#endif
+
+   ENDIF rk_step_1_check
+
+
+!**********************************************************
+!
+!  end of RK predictor-corrector loop
+!
+!**********************************************************
+
+ END DO Runge_Kutta_loop
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , grid%num_tiles
+
+BENCH_START(advance_ppt_tim)
+      CALL wrf_debug ( 200 , ' call advance_ppt' )
+      CALL advance_ppt(grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
+                     grid%rqicuten,grid%rqscuten,grid%rainc,grid%raincv,grid%nca,    &
+                     grid%htop,grid%hbot,grid%cutop,grid%cubot,                 &
+                     grid%cuppt, config_flags,                   &
+                     ids,ide, jds,jde, kds,kde,             &
+                     ims,ime, jms,jme, kms,kme,             &
+                     grid%i_start(ij), grid%i_end(ij),      &
+                     grid%j_start(ij), grid%j_end(ij),      &
+                     k_start    , k_end                    )
+BENCH_END(advance_ppt_tim)
+
+   ENDDO
+   !$OMP END PARALLEL DO
+
+!<DESCRIPTION>
+!<pre>
+! (5) time-split physics.
+!
+!     Microphysics are the only time  split physics in the WRF model 
+!     at this time.  Split-physics begins with the calculation of
+!     needed diagnostic quantities (pressure, temperature, etc.)
+!     followed by a call to the microphysics driver, 
+!     and finishes with a clean-up, storing off of a diabatic tendency
+!     from the moist physics, and a re-calulation of the  diagnostic
+!     quantities pressure and density.
+!</pre>
+!</DESCRIPTION>
+
+!!!******MARS MARS
+!!!******MARS MARS
+!!!******MARS MARS
+
+!  IF (config_flags%mp_physics /= 0)  then
+!
+!   IF( config_flags%specified .or. config_flags%nested ) THEN
+!     sz = grid%spec_zone
+!   ELSE
+!     sz = 0
+!   ENDIF
+!
+!   !$OMP PARALLEL DO   &
+!   !$OMP PRIVATE ( ij, its, ite, jts, jte )
+!
+!   scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
+!
+!       IF ( config_flags%periodic_x ) THEN
+!         its = max(grid%i_start(ij),ids)
+!         ite = min(grid%i_end(ij),ide-1)
+!       ELSE
+!         its = max(grid%i_start(ij),ids+sz)
+!         ite = min(grid%i_end(ij),ide-1-sz)
+!       ENDIF
+!       jts = max(grid%j_start(ij),jds+sz)
+!       jte = min(grid%j_end(ij),jde-1-sz)
+!
+!       CALL wrf_debug ( 200 , ' call moist_physics_prep' )
+!BENCH_START(moist_physics_prep_tim)
+!       CALL moist_physics_prep_em( grid%em_t_2, grid%em_t_1, t0, rho,                &
+!                                   grid%em_al, grid%em_alb, grid%em_p, p8w, p0, grid%em_pb,          &
+!                                   grid%em_ph_2, grid%em_phb, th_phy, pi_phy, p_phy, &
+!                                   grid%em_z, z_at_w, dz8w,                  &
+!                                   dtm, grid%h_diabatic,                  &
+!                                   config_flags,grid%em_fnm, grid%em_fnp,            &
+!                                   ids, ide, jds, jde, kds, kde,     &
+!                                   ims, ime, jms, jme, kms, kme,     &
+!                                   its, ite, jts, jte,               &
+!                                   k_start    , k_end               )
+!BENCH_END(moist_physics_prep_tim)
+!   END DO scalar_tile_loop_1a
+!   !$OMP END PARALLEL DO
+!
+!       CALL wrf_debug ( 200 , ' call microphysics_driver' )
+!
+!       grid%em_sr = 0.
+!       specified_bdy = config_flags%specified .OR. config_flags%nested
+!       channel_bdy = config_flags%specified .AND. config_flags%periodic_x
+!
+!#if 0
+!BENCH_START(microswap_1)
+!! for load balancing; communication to redistribute the points
+!   IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN
+!#include "SWAP_ETAMP_NEW.inc"
+!   ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
+!#include "SWAP_WSM3.inc"
+!   ENDIF
+!BENCH_END(microswap_1)
+!#endif
+!
+!BENCH_START(micro_driver_tim)
+!
+!       CALL microphysics_driver(                                          &
+!     &         DT=dtm             ,DX=grid%dx              ,DY=grid%dy              &
+!     &        ,DZ8W=dz8w          ,F_ICE_PHY=grid%f_ice_phy                    &
+!     &        ,ITIMESTEP=grid%itimestep                    ,LOWLYR=grid%lowlyr      &
+!     &        ,P8W=p8w            ,P=p_phy            ,PI_PHY=pi_phy      &
+!     &        ,RHO=rho            ,SPEC_ZONE=grid%spec_zone                    &
+!     &        ,SR=grid%em_sr              ,TH=th_phy                              &
+!     &        ,WARM_RAIN=grid%warm_rain                    ,XLAND=grid%xland        &
+!     &        ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy        &
+!     &        ,F_RAIN_PHY=grid%f_rain_phy                                      &
+!     &        ,F_RIMEF_PHY=grid%f_rimef_phy                                    &
+!     &        ,MP_PHYSICS=config_flags%mp_physics                         &
+!     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+!     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+!     &        ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)          &
+!     &        ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)          &
+!     &        ,KTS=k_start, KTE=min(k_end,kde-1)                          &
+!     &        ,NUM_TILES=grid%num_tiles                                   &
+!                 ! Optional
+!     &        , RAINNC=grid%rainnc, RAINNCV=grid%rainncv                            &
+!     &        , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv                            &
+!     &        , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv                &
+!     &        , W=grid%em_w_2, Z=grid%em_z, HT=grid%ht                                         &
+!     &        , MP_RESTART_STATE=grid%mp_restart_state                         &
+!     &        , TBPVS_STATE=grid%tbpvs_state                                   & ! etampnew
+!     &        , TBPVS0_STATE=grid%tbpvs0_state                                 & ! etampnew
+!     &        , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV              &
+!     &        , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC              &
+!     &        , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR              &
+!     &        , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI              &
+!     &        , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS              &
+!     &        , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG              &
+!     &        , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI         &
+!     &        , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT             &
+!                                                                          )
+!BENCH_END(micro_driver_tim)
+!
+!#if 0
+!BENCH_START(microswap_2)
+!! for load balancing; communication to redistribute the points
+!   IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN
+!#include "SWAP_ETAMP_NEW.inc"
+!   ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
+!#include "SWAP_WSM3.inc"
+!   ENDIF
+!BENCH_END(microswap_2)
+!#endif
+!
+!       CALL wrf_debug ( 200 , ' call moist_physics_finish' )
+!BENCH_START(moist_phys_end_tim)
+!   !$OMP PARALLEL DO   &
+!   !$OMP PRIVATE ( ij, its, ite, jts, jte )
+!
+!   scalar_tile_loop_1b: DO ij = 1 , grid%num_tiles
+!
+!       IF ( config_flags%periodic_x ) THEN
+!         its = max(grid%i_start(ij),ids)
+!         ite = min(grid%i_end(ij),ide-1)
+!       ELSE
+!         its = max(grid%i_start(ij),ids+sz)
+!         ite = min(grid%i_end(ij),ide-1-sz)
+!       ENDIF
+!       jts = max(grid%j_start(ij),jds+sz)
+!       jte = min(grid%j_end(ij),jde-1-sz)
+!
+!       CALL microphysics_zero_out (                                    &
+!                     moist , num_moist , config_flags ,              &
+!                     ids, ide, jds, jde, kds, kde,                     &
+!                     ims, ime, jms, jme, kms, kme,                     &
+!                     its, ite, jts, jte,                               &
+!                     k_start    , k_end                                )
+!
+!       CALL moist_physics_finish_em( grid%em_t_2, grid%em_t_1, t0, grid%em_muts, th_phy,       &
+!                                     grid%h_diabatic, dtm, config_flags,    &
+!                                     ids, ide, jds, jde, kds, kde,     &
+!                                     ims, ime, jms, jme, kms, kme,     &
+!                                     its, ite, jts, jte,               &
+!                                     k_start    , k_end               )
+!
+!       CALL calc_p_rho_phi( moist, num_3d_m,                &
+!                            grid%em_al, grid%em_alb, grid%em_mu_2, grid%em_muts,              &
+!                            grid%em_ph_2, grid%em_p, grid%em_pb, grid%em_t_2,                 &
+!                            p0, t0, grid%em_znu, grid%em_dnw, grid%em_rdnw,           &
+!                            grid%em_rdn, config_flags%non_hydrostatic,             &
+!                            ids, ide, jds, jde, kds, kde,     &
+!                            ims, ime, jms, jme, kms, kme,     &
+!                            its, ite, jts, jte,               &
+!                            k_start    , k_end               )
+!
+!   END DO scalar_tile_loop_1b
+!   !$OMP END PARALLEL DO
+!BENCH_END(moist_phys_end_tim)
+!
+!  ENDIF
+
+
+  IF (.not. config_flags%non_hydrostatic) THEN
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+     CALL diagnose_w( ph_tend, grid%em_ph_2, grid%em_ph_1, grid%em_w_2, grid%em_muts, dt_rk,  &
+                      grid%em_u_2, grid%em_v_2, grid%ht,                           &
+                      grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msft,          &
+                      ids, ide, jds, jde, kds, kde,           &
+                      ims, ime, jms, jme, kms, kme,           &
+                      grid%i_start(ij), grid%i_end(ij),       &
+                      grid%j_start(ij), grid%j_end(ij),       &
+                      k_start    , k_end                     )
+
+   END DO
+   !$OMP END PARALLEL DO
+  ENDIF
+
+   chem_tile_loop_3: DO ij = 1 , grid%num_tiles
+
+          CALL wrf_debug ( 200 , ' call scalar_tile_loop_2' )
+
+     IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
+
+!
+!  tiled chemistry not here, it is called from solve_interface, and found in chem_driver
+!
+
+     END IF
+
+   END DO chem_tile_loop_3
+
+
+   !  We're finished except for boundary condition (and patch) update
+
+   ! Boundary condition time (or communication time).  At this time, we have
+   ! implemented periodic and symmetric physical boundary conditions.
+
+   ! b.c. routine for data within patch.
+
+   ! we need to do both time levels of 
+   ! data because the time filter only works in the physical solution space.
+
+   ! First, do patch communications for boundary conditions (periodicity)
+
+!-----------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!  here's where we need a wide comm stencil - these are the 
+!  uncoupled variables so are used for high order calc in
+!  advection and mixong routines.
+!
+!                              * * * * *
+!            *        * * *    * * * * *
+!          * + *      * + *    * * + * * 
+!            *        * * *    * * * * *
+!                              * * * * *
+!
+!   grid%em_u_1                            x
+!   grid%em_u_2                            x
+!   grid%em_v_1                            x
+!   grid%em_v_2                            x
+!   grid%em_w_1                            x
+!   grid%em_w_2                            x
+!   grid%em_t_1                            x
+!   grid%em_t_2                            x
+!  grid%em_ph_1                            x
+!  grid%em_ph_2                            x
+!  grid%em_tke_1                           x
+!  grid%em_tke_2                           x
+!
+!    2D variables
+!  grid%em_mu_1     x
+!  grid%em_mu_2     x
+!
+!    4D variables
+!  moist                         x
+!   chem                         x
+! scalar                         x
+!----------------------------------------------------------
+
+
+#ifdef DM_PARALLEL
+   IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#    include "HALO_EM_D3_3.inc"
+   ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#    include "HALO_EM_D3_5.inc"
+   ELSE 
+     WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+     CALL wrf_error_fatal(TRIM(wrf_err_message))
+   ENDIF
+#  include "PERIOD_BDY_EM_D3.inc"
+#  include "PERIOD_BDY_EM_MOIST.inc"
+#  include "PERIOD_BDY_EM_CHEM.inc"
+#  include "PERIOD_BDY_EM_SCALAR.inc"
+#endif
+
+!  now set physical b.c on a patch
+
+BENCH_START(bc_2d_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+
+   tile_bc_loop_2: DO ij = 1 , grid%num_tiles
+
+
+     CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
+
+     CALL set_phys_bc_dry_2( config_flags,                           &
+                             grid%em_u_1, grid%em_u_2, grid%em_v_1, grid%em_v_2, grid%em_w_1, grid%em_w_2,           &
+                             grid%em_t_1, grid%em_t_2, grid%em_ph_1, grid%em_ph_2, grid%em_mu_1, grid%em_mu_2,       &
+                             ids, ide, jds, jde, kds, kde,           &
+                             ims, ime, jms, jme, kms, kme,           &
+                             ips, ipe, jps, jpe, kps, kpe,           &
+                             grid%i_start(ij), grid%i_end(ij),       &
+                             grid%j_start(ij), grid%j_end(ij),       &
+                             k_start    , k_end                     )
+
+     CALL set_physical_bc3d( grid%em_tke_1, 'p', config_flags,   &
+                             ids, ide, jds, jde, kds, kde,            &
+                             ims, ime, jms, jme, kms, kme,            &
+                             ips, ipe, jps, jpe, kps, kpe,            &
+                             grid%i_start(ij), grid%i_end(ij),        &
+                             grid%j_start(ij), grid%j_end(ij),        &
+                             k_start    , k_end-1                    )
+     CALL set_physical_bc3d( grid%em_tke_2 , 'p', config_flags,  &
+                             ids, ide, jds, jde, kds, kde,            &
+                             ims, ime, jms, jme, kms, kme,            &
+                             ips, ipe, jps, jpe, kps, kpe,            &
+                             grid%i_start(ij), grid%i_end(ij),        &
+                             grid%j_start(ij), grid%j_end(ij),        &
+                             k_start    , k_end                      )
+
+     moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
+
+       CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p',           &
+                               config_flags,                           &
+                               ids, ide, jds, jde, kds, kde,           &
+                               ims, ime, jms, jme, kms, kme,           &
+                               ips, ipe, jps, jpe, kps, kpe,           &
+                               grid%i_start(ij), grid%i_end(ij),       &
+                               grid%j_start(ij), grid%j_end(ij),       &
+                               k_start    , k_end                     )
+
+     END DO moisture_loop_bdy_2
+
+     chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
+
+       CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags,  &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               ips, ipe, jps, jpe, kps, kpe,            &
+                               grid%i_start(ij), grid%i_end(ij),                  &
+                               grid%j_start(ij), grid%j_end(ij),                  &
+                               k_start    , k_end                      )
+
+     END DO chem_species_bdy_loop_2
+
+     scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
+
+       CALL set_physical_bc3d( scalar(ims,kms,jms,is) , 'p', config_flags,  &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               ips, ipe, jps, jpe, kps, kpe,            &
+                               grid%i_start(ij), grid%i_end(ij),                  &
+                               grid%j_start(ij), grid%j_end(ij),                  &
+                               k_start    , k_end                      )
+
+     END DO scalar_species_bdy_loop_2
+
+   END DO tile_bc_loop_2
+   !$OMP END PARALLEL DO
+BENCH_END(bc_2d_tim)
+
+   IF( config_flags%specified .or. config_flags%nested ) THEN 
+     grid%dtbc = grid%dtbc + grid%dt
+   ENDIF
+
+! calculate some model diagnostics.
+
+!!!******MARS MARS
+!!!******MARS MARS
+
+!         CALL wrf_debug ( 200 , ' call diagnostic_driver' )
+!   
+!         CALL diagnostic_output_calc(                                     &
+!     &              DPSDT=grid%dpsdt   ,DMUDT=grid%dmudt                  &
+!     &             ,P_PHY=p_phy   ,PK1M=grid%pk1m                         &
+!     &             ,MU_2=grid%em_mu_2  ,MU_2M=grid%mu_2m                  &
+!     &             ,U=grid%em_u_2    ,V=grid%em_v_2                       &
+!     &             ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv           &
+!     &             ,RAINC=grid%rainc    ,RAINNC=grid%rainnc               &
+!     &             ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh     &
+!     &             ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width      &
+!     &             ,XTIME=grid%xtime                                      &
+!                 ! Selection flag
+!     &             ,DIAG_PRINT=config_flags%diag_print                    &
+!                 ! Dimension arguments
+!     &             ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde     &
+!     &             ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme     &
+!     &             ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe     &
+!     &             ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)     &
+!     &             ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)     &
+!     &             ,KTS=k_start, KTE=min(k_end,kde-1)                     &
+!     &             ,NUM_TILES=grid%num_tiles                              &
+!     &                                                          )
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+   CALL wrf_debug ( 200 , ' call HALO_RK_E' )
+   IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#    include "HALO_EM_E_3.inc"
+   ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#    include "HALO_EM_E_5.inc"
+   ELSE
+     WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+     CALL wrf_error_fatal(TRIM(wrf_err_message))
+   ENDIF
+#endif
+
+#ifdef DM_PARALLEL
+   if ( num_moist >= PARAM_FIRST_SCALAR  ) then
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_MOIST_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_MOIST_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   endif
+   if ( num_chem >= PARAM_FIRST_SCALAR ) then
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_CHEM_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_CHEM_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   endif
+   if ( num_scalar >= PARAM_FIRST_SCALAR ) then
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_SCALAR_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_SCALAR_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   endif
+#endif
+
+
+!!!!!!!!!!!!!MARS
+!!!!!!!!!!!!!MARS
+!!
+!! to get lighter output files, output the sum of the constant value phb (pb) with ph (p)
+!! --- these variables were added to the Registry
+!!
+!!pressure
+     grid%em_ptot  = grid%em_p + grid%em_pb
+!!geopotential: already in php
+     grid%em_phtot = grid%em_php
+!!mass
+     !grid%em_mutot = grid%em_mub + grid%em_mu_2
+!!
+!!!!!!!!!!!!!MARS
+!!!!!!!!!!!!!MARS
+
+
+
+
+   CALL wrf_debug ( 200 , ' call end of solve_em' )
+
+! Finish timers if compiled with -DBENCH.
+#include <bench_solve_em_end.h>
+
+   RETURN
+
+END SUBROUTINE solve_em
Index: trunk/WRF.COMMON/WRFV2/dyn_em/start_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em/start_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em/start_em.F	(revision 2744)
@@ -0,0 +1,940 @@
+!-------------------------------------------------------------------
+
+   SUBROUTINE start_domain_em ( grid, allowed_to_read  &
+! Actual arguments generated from Registry
+# include "em_dummy_new_args.inc"
+!
+)
+
+   USE module_domain
+   USE module_dm
+!  USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_bc_em
+!  USE module_timing
+   USE module_configure
+   USE module_tiles
+
+   USE module_physics_init
+#ifdef WRF_CHEM
+   USE module_aerosols_sorgam, only: sum_pm_sorgam
+   USE module_mosaic_driver, only: sum_pm_mosaic
+#endif
+
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+!!debug
+!USE module_compute_geop
+
+   USE module_model_constants
+   IMPLICIT NONE
+   !  Input data.
+   TYPE (domain)          :: grid
+
+   LOGICAL , INTENT(IN)   :: allowed_to_read
+
+   !  Definitions of dummy arguments to this routine (generated from Registry).
+# include "em_dummy_new_decl.inc"
+
+   !  Structure that contains run-time configuration (namelist) data for domain
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  ips, ipe, jps, jpe, kps, kpe, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  ij,i,j,k,ii,jj,kk,loop,error,l
+
+   INTEGER     :: i_m
+
+   REAL        :: p00, t00, a, p_surf, pd_surf, tiso, temp
+#ifdef WRF_CHEM
+   REAL        RGASUNIV ! universal gas constant [ J/mol-K ]
+   PARAMETER ( RGASUNIV = 8.314510 )
+      REAL,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: &
+                      z_at_w,convfac
+   REAL :: tempfac
+#endif
+
+   REAL :: qvf1, qvf2, qvf
+   REAL :: MPDT
+   REAL :: spongeweight
+   LOGICAL :: first_trip_for_this_domain, start_of_simulation
+
+   REAL :: lat1 , lat2 , lat3 , lat4
+   REAL :: lon1 , lon2 , lon3 , lon4
+   INTEGER :: num_points_lat_lon , iloc , jloc
+   CHARACTER (LEN=132) :: message
+
+! Needed by some comm layers, grid%e.g. RSL. If needed, nmm_data_calls.inc is
+! generated from the registry.  The definition of REGISTER_I1 allows
+! I1 data to be communicated in this routine if necessary.
+#ifdef DM_PARALLEL
+#    include "em_data_calls.inc"
+#endif
+   CALL get_ijk_from_grid (  grid ,                   &
+                             ids, ide, jds, jde, kds, kde,    &
+                             ims, ime, jms, jme, kms, kme,    &
+                             ips, ipe, jps, jpe, kps, kpe    )
+
+   kts = kps ; kte = kpe     ! note that tile is entire patch
+   its = ips ; ite = ipe     ! note that tile is entire patch
+   jts = jps ; jte = jpe    ! note that tile is entire patch
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+   IF ( ( MOD (ide-ids,config_flags%parent_grid_ratio) .NE. 0 ) .OR. &
+        ( MOD (jde-jds,config_flags%parent_grid_ratio) .NE. 0 ) ) THEN
+      WRITE(message, FMT='("Nested dimensions are illegal for domain ",I2,":  Both &
+         &MOD(",I4,"-",I1,",",I2,") and MOD(",I4,"-",I1,",",I2,") must = 0" )') &
+         grid%id,ide,ids,config_flags%parent_grid_ratio,jde,jds,config_flags%parent_grid_ratio
+      CALL wrf_error_fatal ( message ) 
+   END IF
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+!kludge - need to stop CG from resetting precip and phys tendencies to zero
+!         when we are in here due to a nest being spawned, we want to still
+!         recompute the base state, but that is about it
+   !  This is temporary and will need to be changed when grid%itimestep is removed.
+
+   IF ( grid%itimestep .EQ. 0 ) THEN
+      first_trip_for_this_domain = .TRUE.
+   ELSE
+      first_trip_for_this_domain = .FALSE.
+   END IF
+
+   IF ( .not. ( config_flags%restart .or. grid%moved ) ) THEN 
+       grid%itimestep=0
+   ENDIF
+
+   IF ( config_flags%restart .or. grid%moved ) THEN 
+       first_trip_for_this_domain = .TRUE.
+   ENDIF
+
+   IF (config_flags%specified) THEN
+!
+! Arrays for specified boundary conditions
+! wig: Add a combined exponential+linear weight on the mother boundaries
+!      following code changes by Ruby Leung. For the nested grid, there
+!      appears to be some problems when a sponge is used. The points where
+!      processors meet have problematic values.
+
+     DO loop = grid%spec_zone + 1, grid%spec_zone + grid%relax_zone
+       grid%fcx(loop) = 0.1 / grid%dt * (grid%spec_zone + grid%relax_zone - loop) / (grid%relax_zone - 1)
+       grid%gcx(loop) = 1.0 / grid%dt / 50. * (grid%spec_zone + grid%relax_zone - loop) / (grid%relax_zone - 1)
+!      spongeweight=exp(-(loop-2)/3.)
+!      grid%fcx(loop) = grid%fcx(loop)*spongeweight
+!      grid%gcx(loop) = grid%gcx(loop)*spongeweight
+     ENDDO
+
+   ELSE IF (config_flags%nested) THEN
+!
+! Arrays for specified boundary conditions
+
+     DO loop = grid%spec_zone + 1, grid%spec_zone + grid%relax_zone
+       grid%fcx(loop) = 0.1 / grid%dt * (grid%spec_zone + grid%relax_zone - loop) / (grid%relax_zone - 1)
+       grid%gcx(loop) = 1.0 / grid%dt / 50. * (grid%spec_zone + grid%relax_zone - loop) / (grid%relax_zone - 1)
+!      spongeweight=exp(-(loop-2)/3.)
+!      grid%fcx(loop) = grid%fcx(loop)*spongeweight
+!      grid%gcx(loop) = grid%gcx(loop)*spongeweight
+!      grid%fcx(loop) = 0.
+!      grid%gcx(loop) = 0.
+     ENDDO
+
+     grid%dtbc = 0.
+
+   ENDIF
+
+!     IF ( grid%id .NE. 1 ) THEN
+   
+      !  Every time a domain starts or every time a domain moves, this routine is called.  We want
+      !  the center (middle) lat/lon of the grid for the metacode.  The lat/lon values are
+      !  defined at mass points.  Depending on the even/odd points in the SN and WE directions,
+      !  we end up with the middle point as either 1 point or an average of either 2 or 4 points.
+      !  Add to this, the need to make sure that we are on the correct patch to retrieve the
+      !  value of the lat/lon, AND that the lat/lons (for an average) may not all be on the same
+      !  patch.  Once we find the correct value for lat lon, we need to keep it around on all patches, 
+      !  which is where the wrf_dm_min_real calls come in.
+   
+      IF      ( ( MOD(ide,2) .EQ. 0 ) .AND. ( MOD(jde,2) .EQ. 0 ) ) THEN
+         num_points_lat_lon = 1
+         iloc = ide/2
+         jloc = jde/2
+         IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
+              ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
+            lat1 = grid%xlat (iloc,jloc)
+            lon1 = grid%xlong(iloc,jloc)
+         ELSE
+            lat1 = 99999.
+            lon1 = 99999.
+         END IF
+         lat1 = wrf_dm_min_real ( lat1 )
+         lon1 = wrf_dm_min_real ( lon1 )
+         CALL nl_set_cen_lat ( grid%id , lat1 )
+         CALL nl_set_cen_lon ( grid%id , lon1 )
+      ELSE IF ( ( MOD(ide,2) .NE. 0 ) .AND. ( MOD(jde,2) .EQ. 0 ) ) THEN
+         num_points_lat_lon = 2
+         iloc = (ide-1)/2
+         jloc =  jde   /2
+         IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
+              ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
+            lat1 = grid%xlat (iloc,jloc)
+            lon1 = grid%xlong(iloc,jloc)
+         ELSE
+            lat1 = 99999.
+            lon1 = 99999.
+         END IF
+         lat1 = wrf_dm_min_real ( lat1 )
+         lon1 = wrf_dm_min_real ( lon1 )
+   
+         iloc = (ide+1)/2
+         jloc =  jde   /2
+         IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
+              ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
+            lat2 = grid%xlat (iloc,jloc)
+            lon2 = grid%xlong(iloc,jloc)
+         ELSE
+            lat2 = 99999.
+            lon2 = 99999.
+         END IF
+         lat2 = wrf_dm_min_real ( lat2 )
+         lon2 = wrf_dm_min_real ( lon2 )
+   
+         CALL nl_set_cen_lat ( grid%id , ( lat1 + lat2 ) * 0.50 )
+         CALL nl_set_cen_lon ( grid%id , ( lon1 + lon2 ) * 0.50 )
+      ELSE IF ( ( MOD(ide,2) .EQ. 0 ) .AND. ( MOD(jde,2) .NE. 0 ) ) THEN
+         num_points_lat_lon = 2
+         iloc =  ide   /2
+         jloc = (jde-1)/2
+         IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
+              ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
+            lat1 = grid%xlat (iloc,jloc)
+            lon1 = grid%xlong(iloc,jloc)
+         ELSE
+            lat1 = 99999.
+            lon1 = 99999.
+         END IF
+         lat1 = wrf_dm_min_real ( lat1 )
+         lon1 = wrf_dm_min_real ( lon1 )
+   
+         iloc =  ide   /2
+         jloc = (jde+1)/2
+         IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
+              ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
+            lat2 = grid%xlat (iloc,jloc)
+            lon2 = grid%xlong(iloc,jloc)
+         ELSE
+            lat2 = 99999.
+            lon2 = 99999.
+         END IF
+         lat2 = wrf_dm_min_real ( lat2 )
+         lon2 = wrf_dm_min_real ( lon2 )
+   
+         CALL nl_set_cen_lat ( grid%id , ( lat1 + lat2 ) * 0.50 )
+         CALL nl_set_cen_lon ( grid%id , ( lon1 + lon2 ) * 0.50 )
+      ELSE IF ( ( MOD(ide,2) .NE. 0 ) .AND. ( MOD(jde,2) .NE. 0 ) ) THEN
+         num_points_lat_lon = 4
+         iloc = (ide-1)/2
+         jloc = (jde-1)/2
+         IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
+              ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
+            lat1 = grid%xlat (iloc,jloc)
+            lon1 = grid%xlong(iloc,jloc)
+         ELSE
+            lat1 = 99999.
+            lon1 = 99999.
+         END IF
+         lat1 = wrf_dm_min_real ( lat1 )
+         lon1 = wrf_dm_min_real ( lon1 )
+   
+         iloc = (ide+1)/2
+         jloc = (jde-1)/2
+         IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
+              ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
+            lat2 = grid%xlat (iloc,jloc)
+            lon2 = grid%xlong(iloc,jloc)
+         ELSE
+            lat2 = 99999.
+            lon2 = 99999.
+         END IF
+         lat2 = wrf_dm_min_real ( lat2 )
+         lon2 = wrf_dm_min_real ( lon2 )
+   
+         iloc = (ide-1)/2
+         jloc = (jde+1)/2
+         IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
+              ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
+            lat3 = grid%xlat (iloc,jloc)
+            lon3 = grid%xlong(iloc,jloc)
+         ELSE
+            lat3 = 99999.
+            lon3 = 99999.
+         END IF
+         lat3 = wrf_dm_min_real ( lat3 )
+         lon3 = wrf_dm_min_real ( lon3 )
+   
+         iloc = (ide+1)/2
+         jloc = (jde+1)/2
+         IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
+              ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
+            lat4 = grid%xlat (iloc,jloc)
+            lon4 = grid%xlong(iloc,jloc)
+         ELSE
+            lat4 = 99999.
+            lon4 = 99999.
+         END IF
+         lat4 = wrf_dm_min_real ( lat4 )
+         lon4 = wrf_dm_min_real ( lon4 )
+   
+         CALL nl_set_cen_lat ( grid%id , ( lat1 + lat2 + lat3 + lat4 ) * 0.25 )
+         CALL nl_set_cen_lon ( grid%id , ( lon1 + lon2 + lon3 + lon4 ) * 0.25 )
+      END IF
+!  END IF
+
+   IF ( .NOT. config_flags%restart .AND. &
+        (( config_flags%input_from_hires ) .OR. ( config_flags%input_from_file ))) THEN
+
+      IF ( config_flags%map_proj .EQ. 0 ) THEN
+         CALL wrf_error_fatal ( 'start_domain: Idealized case cannot have a separate nested input file' )
+      END IF 
+
+      CALL nl_get_base_pres  ( 1 , p00 )
+      CALL nl_get_base_temp  ( 1 , t00 )
+      CALL nl_get_base_lapse ( 1 , a   )
+      CALL nl_get_tiso ( 1 , tiso )
+
+      !  Base state potential temperature and inverse density (alpha = 1/rho) from
+      !  the half eta levels and the base-profile surface pressure.  Compute 1/rho
+      !  from equation of state.  The potential temperature is a perturbation from t0.
+
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+
+            !  Base state pressure is a function of eta level and terrain, only, plus
+            !  the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
+            !  temperature, K), and A (temperature difference, from 1000 mb to 300 mb, K).
+
+            p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 )
+
+            DO k = 1, kte-1
+               grid%em_pb(i,k,j) = grid%em_znu(k)*(p_surf - grid%p_top) + grid%p_top
+!               grid%em_t_init(i,k,j) = (t00 + A*LOG(grid%em_pb(i,k,j)/p00))*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
+temp = MAX ( tiso, t00 + A*LOG(grid%em_pb(i,k,j)/p00)) 
+grid%em_t_init(i,k,j) = temp*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
+               grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+            END DO
+
+            !  Base state mu is defined as base state surface pressure minus grid%p_top
+
+            grid%em_mub(i,j) = p_surf - grid%p_top
+
+            !  Integrate base geopotential, starting at terrain elevation.  This assures that
+            !  the base state is in exact hydrostatic balance with respect to the model equations.
+            !  This field is on full levels.
+
+            grid%em_phb(i,1,j) = grid%ht(i,j) * g
+            DO k  = 2,kte
+               grid%em_phb(i,k,j) = grid%em_phb(i,k-1,j) - grid%em_dnw(k-1)*grid%em_mub(i,j)*grid%em_alb(i,k-1,j)
+            END DO
+         END DO
+      END DO
+
+   ENDIF
+
+   IF(.not.config_flags%restart)THEN
+
+!  if this is for a nested domain, the defined/interpolated fields are the _2
+
+     IF ( first_trip_for_this_domain ) THEN
+
+! data that is expected to be zero must be explicitly initialized as such
+     grid%h_diabatic = 0.
+
+       DO j = jts,min(jte,jde-1)
+       DO k = kts,kte-1
+       DO i = its, min(ite,ide-1)
+           IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
+             grid%em_t_1(i,k,j)=grid%em_t_2(i,k,j)
+           ENDIF
+       ENDDO
+       ENDDO
+       ENDDO
+  
+       DO j = jts,min(jte,jde-1)
+       DO i = its, min(ite,ide-1)
+           IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
+             grid%em_mu_1(i,j)=grid%em_mu_2(i,j)
+           ENDIF
+       ENDDO
+       ENDDO
+     END IF
+
+!  reconstitute base-state fields
+
+    IF(config_flags%max_dom .EQ. 1)THEN
+! with single domain, grid%em_t_init from wrfinput is OK to use
+     DO j = jts,min(jte,jde-1)
+     DO k = kts,kte-1
+     DO i = its, min(ite,ide-1)
+       IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
+         grid%em_pb(i,k,j) = grid%em_znu(k)*grid%em_mub(i,j)+grid%p_top
+         grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
+       ENDIF
+     ENDDO
+     ENDDO
+     ENDDO
+    ELSE
+! with nests, grid%em_t_init generally needs recomputations (since it is not interpolated)
+     DO j = jts,min(jte,jde-1)
+     DO k = kts,kte-1
+     DO i = its, min(ite,ide-1)
+       IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
+         grid%em_pb(i,k,j) = grid%em_znu(k)*grid%em_mub(i,j)+grid%p_top
+         grid%em_alb(i,k,j) = -grid%em_rdnw(k)*(grid%em_phb(i,k+1,j)-grid%em_phb(i,k,j))/grid%em_mub(i,j)
+         grid%em_t_init(i,k,j) = grid%em_alb(i,k,j)*(p1000mb/r_d)/((grid%em_pb(i,k,j)/p1000mb)**cvpm) - t0
+       ENDIF
+     ENDDO
+     ENDDO
+     ENDDO
+    ENDIF
+
+     DO j = jts,min(jte,jde-1)
+
+       k = kte-1
+       DO i = its, min(ite,ide-1)
+         IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
+           qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+           qvf2 = 1./(1.+qvf1)
+           qvf1 = qvf1*qvf2
+           grid%em_p(i,k,j) = - 0.5*(grid%em_mu_1(i,j)+qvf1*grid%em_mub(i,j))/grid%em_rdnw(k)/qvf2
+           qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+           grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf*(((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+           grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+         ENDIF
+       ENDDO
+
+       DO k = kte-2, 1, -1
+       DO i = its, min(ite,ide-1)
+         IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
+           qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+           qvf2 = 1./(1.+qvf1)
+           qvf1 = qvf1*qvf2
+           grid%em_p(i,k,j) = grid%em_p(i,k+1,j) - (grid%em_mu_1(i,j) + qvf1*grid%em_mub(i,j))/qvf2/grid%em_rdn(k+1)
+           qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+           grid%em_alt(i,k,j) = (r_d/p1000mb)*(grid%em_t_1(i,k,j)+t0)*qvf* &
+                        (((grid%em_p(i,k,j)+grid%em_pb(i,k,j))/p1000mb)**cvpm)
+           grid%em_al(i,k,j) = grid%em_alt(i,k,j) - grid%em_alb(i,k,j)
+         ENDIF
+       ENDDO
+       ENDDO
+
+     ENDDO
+
+   ENDIF
+
+   IF ( ( grid%id .NE. 1 ) .AND. .NOT. ( config_flags%restart ) .AND. &
+       ( ( config_flags%input_from_hires ) .OR. ( config_flags%input_from_file ) ) ) THEN
+      DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+            grid%em_mu_2(i,j) = grid%em_mu_2(i,j) + grid%em_al(i,1,j) / ( grid%em_alt(i,1,j) * grid%em_alb(i,1,j) ) * &
+                                    g * ( grid%ht(i,j) - grid%ht_fine(i,j) )
+         END DO
+       END DO
+       DO j = jts,min(jte,jde-1)
+       DO i = its, min(ite,ide-1)
+          grid%em_mu_1(i,j)=grid%em_mu_2(i,j)
+       ENDDO
+       ENDDO
+
+   END IF
+
+   IF ( first_trip_for_this_domain ) THEN
+
+   CALL wrf_debug ( 100 , 'module_start: start_domain_rk: Before call to phy_init' )
+
+! namelist MPDT does not exist yet, so set it here
+! MPDT is the call frequency for microphysics in minutes (0 means every step)
+   MPDT = 0.
+
+! set GMT outside of phy_init because phy_init may not be called on this
+! process if, for example, it is a moving nest and if this part of the domain is not
+! being initialized (not the leading edge).
+   CALL domain_setgmtetc( grid, start_of_simulation )
+
+   CALL set_tiles ( grid , grid%imask_nostag, ims, ime, jms, jme, ips, ipe, jps, jpe )
+
+! Phy_init is not necessarily thread-safe; do not multi-thread this loop.
+! The tiling is to handle the fact that we may be masking off part of the computation.
+   DO ij = 1, grid%num_tiles
+
+     CALL phy_init (  grid%id , config_flags, grid%DT, grid%RESTART, grid%em_znw, grid%em_znu,   &
+                      grid%p_top, grid%tsk, grid%RADT,grid%BLDT,grid%CUDT, MPDT, &
+                      grid%rthcuten, grid%rqvcuten, grid%rqrcuten,           &
+                      grid%rqccuten, grid%rqscuten, grid%rqicuten,           &
+                      grid%rublten,grid%rvblten,grid%rthblten,               &
+                      grid%rqvblten,grid%rqcblten,grid%rqiblten,             &
+                      grid%rthraten,grid%rthratenlw,grid%rthratensw,         &
+                      grid%stepbl,grid%stepra,grid%stepcu,                   &
+                      grid%w0avg, grid%rainnc, grid%rainc, grid%raincv, grid%rainncv,  &
+                      grid%nca,grid%swrad_scat,                    &
+                      grid%cldefi,grid%lowlyr,                          &
+                      grid%mass_flux,                              &
+                      grid%rthften, grid%rqvften,                       &
+                      grid%cldfra,grid%glw,grid%gsw,grid%emiss,grid%lu_index,          &
+                      grid%landuse_ISICE, grid%landuse_LUCATS,            &
+                      grid%landuse_LUSEAS, grid%landuse_ISN,              &
+                      grid%lu_state,                                      &
+                      grid%xlat,grid%xlong,grid%albedo,grid%albbck,grid%GMT,grid%JULYR,grid%JULDAY,     &
+                      grid%levsiz, num_ozmixm, num_aerosolc, grid%paerlev,  &
+                      grid%tmn,grid%xland,grid%znt,grid%z0,grid%ust,grid%mol,grid%pblh,grid%tke_myj,     &
+                      grid%exch_h,grid%thc,grid%snowc,grid%mavail,grid%hfx,grid%qfx,grid%rainbl, &
+                      grid%tslb,grid%zs,grid%dzs,config_flags%num_soil_layers,grid%warm_rain,  &
+                      grid%adv_moist_cond,                         &
+                      grid%apr_gr,grid%apr_w,grid%apr_mc,grid%apr_st,grid%apr_as,      &
+                      grid%apr_capma,grid%apr_capme,grid%apr_capmi,          &
+                      grid%xice,grid%vegfra,grid%snow,grid%canwat,grid%smstav,         &
+                      grid%smstot, grid%sfcrunoff,grid%udrunoff,grid%grdflx,grid%acsnow,      &
+                      grid%acsnom,grid%ivgtyp,grid%isltyp, grid%sfcevp,grid%smois,     &
+                      grid%sh2o, grid%snowh, grid%smfr3d,                    &
+                      grid%DX,grid%DY,grid%f_ice_phy,grid%f_rain_phy,grid%f_rimef_phy, &
+                      grid%mp_restart_state,grid%tbpvs_state,grid%tbpvs0_state,&
+                      allowed_to_read, grid%moved, start_of_simulation,               &
+                      ids, ide, jds, jde, kds, kde,           &
+                      ims, ime, jms, jme, kms, kme,           &
+                      grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), kts, kte, &
+                      ozmixm,grid%pin,                             &     ! Optional
+                      grid%m_ps_1,grid%m_ps_2,grid%m_hybi,aerosolc_1,aerosolc_2,&  ! Optional
+                      grid%rundgdten,grid%rvndgdten,grid%rthndgdten,         &     ! Optional
+                      grid%rqvndgdten,grid%rmundgdten,                  &     ! Optional
+                      grid%FGDT,grid%stepfg,                        &     ! Optional
+                      grid%DZR, grid%DZB, grid%DZG,                          & !Optional urban
+                      grid%TR_URB2D,grid%TB_URB2D,grid%TG_URB2D,grid%TC_URB2D,    & !Optional urban
+                      grid%QC_URB2D, grid%XXXR_URB2D,grid%XXXB_URB2D,        & !Optional urban
+                      grid%XXXG_URB2D, grid%XXXC_URB2D,                 & !Optional urban
+                      grid%TRL_URB3D, grid%TBL_URB3D, grid%TGL_URB3D,        & !Optional urban
+                      grid%SH_URB2D, grid%LH_URB2D, grid%G_URB2D, grid%RN_URB2D,  & !Optional urban
+                      grid%TS_URB2D, grid%FRC_URB2D, grid%UTYPE_URB2D,      & !Optional urban
+                      itimestep=grid%itimestep,  &
+			fdob=grid%fdob	&
+                      )
+
+
+
+   ENDDO
+
+
+ 
+   CALL wrf_debug ( 100 , 'module_start: start_domain_rk: After call to phy_init' )
+
+#ifdef MCELIO
+   LU_MASK = 0.
+   WHERE ( grid%lu_index .EQ. 16 ) LU_MASK = 1.
+#endif
+
+   END IF
+
+#if 0
+#include "CYCLE_TEST.inc"
+#endif
+
+!
+!
+
+ !  set physical boundary conditions for all initialized variables
+
+!-----------------------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!  Note:  the size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
+!         as state variables in the mass coordinate model, as
+!         opposed to the coupled variables as in the height
+!         coordinate model.
+!
+!                           * * * * *
+!         *        * * *    * * * * *
+!       * + *      * + *    * * + * * 
+!         *        * * *    * * * * *
+!                           * * * * *
+!
+!j  grid%em_u_1                          x
+!j  grid%em_u_2                          x
+!j  grid%em_v_1                          x
+!j  grid%em_v_2                          x
+!j  grid%em_w_1                          x
+!j  grid%em_w_2                          x
+!j  grid%em_t_1                          x
+!j  grid%em_t_2                          x
+!j grid%em_ph_1                          x
+!j grid%em_ph_2                          x
+!
+!j  grid%em_t_init                       x
+!
+!j  grid%em_phb   x
+!j  grid%em_ph0   x
+!j  grid%em_php   x
+!j   grid%em_pb   x
+!j   grid%em_al   x
+!j  grid%em_alt   x
+!j  grid%em_alb   x
+!
+!  the following are 2D (xy) variables
+!
+!j grid%em_mu_1                          x
+!j grid%em_mu_2                          x
+!j grid%em_mub   x
+!j grid%em_mu0   x
+!j grid%ht    x
+!j grid%msft  x
+!j grid%msfu  x
+!j grid%msfv  x
+!j grid%sina  x
+!j grid%cosa  x
+!j grid%e     x
+!j grid%f     x
+!
+!  4D variables
+!
+! moist                        x
+!  chem                        x
+!scalar                        x
+
+!--------------------------------------------------------------
+
+#ifdef DM_PARALLEL
+#  include "HALO_EM_INIT_1.inc"
+#  include "HALO_EM_INIT_2.inc"
+#  include "HALO_EM_INIT_3.inc"
+#  include "HALO_EM_INIT_4.inc"
+#  include "HALO_EM_INIT_5.inc"
+#  include "PERIOD_BDY_EM_INIT.inc"
+#  include "PERIOD_BDY_EM_MOIST.inc"
+#  include "PERIOD_BDY_EM_CHEM.inc"
+#endif
+
+
+   CALL set_physical_bc3d( grid%em_u_1 , 'U' , config_flags ,                  &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+   CALL set_physical_bc3d( grid%em_u_2 , 'U' , config_flags ,                  &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+
+   CALL set_physical_bc3d( grid%em_v_1 , 'V' , config_flags ,                  &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+   CALL set_physical_bc3d( grid%em_v_2 , 'V' , config_flags ,                  &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+
+! set kinematic condition for w 
+
+   CALL set_physical_bc2d( grid%ht , 'r' , config_flags ,                &
+                           ids , ide , jds , jde , &
+                           ims , ime , jms , jme , &
+                           its , ite , jts , jte , &
+                           its , ite , jts , jte   )
+
+   IF ( .not. config_flags%restart ) THEN 
+   CALL set_w_surface(  config_flags,                                      &
+                        grid%em_w_1, grid%ht, grid%em_u_1, grid%em_v_1, grid%cf1, &
+                        grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msft,        &
+                        ids, ide, jds, jde, kds, kde,                      &
+                        ips, ipe, jps, jpe, kps, kpe,                      &
+                        its, ite, jts, jte, kts, kte,                      &
+                        ims, ime, jms, jme, kms, kme                      )
+   CALL set_w_surface(  config_flags,                                      &
+                        grid%em_w_2, grid%ht, grid%em_u_2, grid%em_v_2, grid%cf1, &
+                        grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msft,        &
+                        ids, ide, jds, jde, kds, kde,                      &
+                        ips, ipe, jps, jpe, kps, kpe,                      &
+                        its, ite, jts, jte, kts, kte,                      &
+                        ims, ime, jms, jme, kms, kme                      )
+   END IF
+
+! finished setting kinematic condition for w at the surface
+
+   CALL set_physical_bc3d( grid%em_w_1 , 'W' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+   CALL set_physical_bc3d( grid%em_w_2 , 'W' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+
+   CALL set_physical_bc3d( grid%em_ph_1 , 'W' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+
+   CALL set_physical_bc3d( grid%em_ph_2 , 'W' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+
+   CALL set_physical_bc3d( grid%em_t_1 , 't' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+
+   CALL set_physical_bc3d( grid%em_t_2 , 't' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+
+   CALL set_physical_bc2d( grid%em_mu_1, 't' , config_flags ,   &
+                           ids , ide , jds , jde ,  &
+                           ims , ime , jms , jme ,  &
+                           its , ite , jts , jte ,  &
+                           its , ite , jts , jte   )
+   CALL set_physical_bc2d( grid%em_mu_2, 't' , config_flags ,   &
+                           ids , ide , jds , jde ,  &
+                           ims , ime , jms , jme ,  &
+                           its , ite , jts , jte ,  &
+                           its , ite , jts , jte   )
+   CALL set_physical_bc2d( grid%em_mub , 't' , config_flags ,   &
+                           ids , ide , jds , jde ,  &
+                           ims , ime , jms , jme ,  &
+                           its , ite , jts , jte ,  &
+                           its , ite , jts , jte   )
+   CALL set_physical_bc2d( grid%em_mu0 , 't' , config_flags ,   &
+                           ids , ide , jds , jde ,  &
+                           ims , ime , jms , jme ,  &
+                           its , ite , jts , jte ,  &
+                           its , ite , jts , jte   )
+
+
+   CALL set_physical_bc3d( grid%em_phb , 'W' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+   CALL set_physical_bc3d( grid%em_ph0 , 'W' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+   CALL set_physical_bc3d( grid%em_php , 'W' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+
+   CALL set_physical_bc3d( grid%em_pb , 't' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+   CALL set_physical_bc3d( grid%em_al , 't' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+   CALL set_physical_bc3d( grid%em_alt , 't' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+   CALL set_physical_bc3d( grid%em_alb , 't' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+   CALL set_physical_bc3d(grid%em_t_init, 't' , config_flags ,                 &
+                         ids , ide , jds , jde , kds , kde ,        &
+                         ims , ime , jms , jme , kms , kme ,        &
+                         its , ite , jts , jte , kts , kte ,        &
+                         its , ite , jts , jte , kts , kte )
+
+   IF (num_moist > 0) THEN
+
+! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
+
+      loop_3d_m   : DO loop = 1 , num_moist
+         CALL set_physical_bc3d( moist(:,:,:,loop) , 'r' , config_flags ,                 &
+                                 ids , ide , jds , jde , kds , kde ,        &
+                                 ims , ime , jms , jme , kms , kme ,        &
+                                 its , ite , jts , jte , kts , kte ,        &
+                                 its , ite , jts , jte , kts , kte )
+      END DO loop_3d_m
+
+   ENDIF
+
+#ifdef WRF_CHEM
+! Zero out the Mie arrays so they do not cause instabilities when not calling Fast-J.
+   if( .NOT. config_flags%restart ) then
+      do j=jts,jte
+         do k=kts,kte
+            do i=its,ite
+               grid%tauaer1(i,k,j) = 0.
+               grid%tauaer2(i,k,j) = 0.
+               grid%tauaer3(i,k,j) = 0.
+               grid%tauaer4(i,k,j) = 0.
+               grid%gaer1(i,k,j) = 0.
+               grid%gaer2(i,k,j) = 0.
+               grid%gaer3(i,k,j) = 0.
+               grid%gaer4(i,k,j) = 0.
+               grid%waer1(i,k,j) = 0.
+               grid%waer2(i,k,j) = 0.
+               grid%waer3(i,k,j) = 0.
+               grid%waer4(i,k,j) = 0.
+            end do
+         end do
+      end do
+   end if
+#endif
+
+   IF (num_chem >= PARAM_FIRST_SCALAR ) THEN
+#ifdef WRF_CHEM
+!
+!   we do this here, so we only have one chem_init routine for either core....
+!
+         do j=jts,min(jte,jde-1)
+            do i=its,min(ite,ide-1)
+               do k=kts,kte
+                 z_at_w(i,k,j)=(grid%em_ph_2(i,k,j)+grid%em_phb(i,k,j))/g
+               enddo
+               do k=kts,min(kte,kde-1)
+                 tempfac=(grid%em_t_1(i,k,j) + t0)*((grid%em_p(i,k,j) + grid%em_pb(i,k,j))/p1000mb)**rcp
+                 convfac(i,k,j) = (grid%em_p(i,k,j)+grid%em_pb(i,k,j))/rgasuniv/tempfac
+               enddo
+            enddo
+         enddo
+
+         CALL chem_init (grid%id,chem,grid%dt,grid%bioemdt,grid%photdt,     &
+                         grid%chemdt,                                       &
+                         grid%stepbioe,grid%stepphot,grid%stepchem,                        &
+                         z_at_w,g,grid%aerwrf,config_flags,                               &
+                         grid%em_alt,grid%em_t_1,grid%em_p,convfac,                              &
+                         grid%tauaer1,grid%tauaer2,grid%tauaer3,grid%tauaer4,                   &
+                         grid%gaer1,grid%gaer2,grid%gaer3,grid%gaer4,                           &
+                         grid%waer1,grid%waer2,grid%waer3,grid%waer4,                           &
+                         grid%pm2_5_dry,grid%pm2_5_water,grid%pm2_5_dry_ec,                &
+                         grid%chem_in_opt,                                  &
+                         ids , ide , jds , jde , kds , kde ,                &
+                         ims , ime , jms , jme , kms , kme ,                &
+                         its , ite , jts , jte , kts , kte                  )
+
+!
+! calculate initial pm
+!
+!       print *,'calculating initial pm'
+        select case (config_flags%chem_opt)
+        case (RADM2SORG, RACMSORG)
+           call sum_pm_sorgam (                                             &
+                grid%em_alt, chem, grid%h2oaj, grid%h2oai,                                    &
+                grid%pm2_5_dry, grid%pm2_5_water, grid%pm2_5_dry_ec, grid%pm10,                 &
+                ids,ide, jds,jde, kds,kde,                                  &
+                ims,ime, jms,jme, kms,kme,                                  &
+                its,ite, jts,jte, kts,kte                                   )
+
+        case (CBMZ_MOSAIC_AA, CBMZ_MOSAIC_BB)
+           call sum_pm_mosaic (                                             &
+                grid%em_alt, chem,                                                  &
+                grid%pm2_5_dry, grid%pm2_5_water, grid%pm2_5_dry_ec, grid%pm10,                 &
+                ids,ide, jds,jde, kds,kde,                                  &
+                ims,ime, jms,jme, kms,kme,                                  &
+                its,ite, jts,jte, kts,kte                                   )
+
+        case default
+           do j=jts,min(jte,jde-1)
+              do k=kts,min(kte,kde-1)
+                 do i=its,min(ite,ide-1)
+                    grid%pm2_5_dry(i,k,j)    = 0.
+                    grid%pm2_5_water(i,k,j)  = 0.
+                    grid%pm2_5_dry_ec(i,k,j) = 0.
+                    grid%pm10(i,k,j)         = 0.
+                 enddo
+              enddo
+           enddo
+        end select
+#endif
+
+! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
+
+      loop_3d_c   : DO loop = PARAM_FIRST_SCALAR , num_chem
+         CALL set_physical_bc3d( chem(:,:,:,loop) , 'r' , config_flags ,                 &
+                                 ids , ide , jds , jde , kds , kde ,        &
+                                 ims , ime , jms , jme , kms , kme ,        &
+                                 its , ite , jts , jte , kts , kte ,        &
+                                 its , ite , jts , jte , kts , kte )
+      END DO loop_3d_c
+
+   ENDIF
+
+   CALL set_physical_bc2d( grid%msft , 'r' , config_flags ,              &
+                         ids , ide , jds , jde , &
+                         ims , ime , jms , jme , &
+                         its , ite , jts , jte , &
+                         its , ite , jts , jte   )
+   CALL set_physical_bc2d( grid%msfu , 'x' , config_flags ,              &
+                         ids , ide , jds , jde , &
+                         ims , ime , jms , jme , &
+                         its , ite , jts , jte , &
+                         its , ite , jts , jte   ) 
+   CALL set_physical_bc2d( grid%msfv , 'y' , config_flags ,              &
+                         ids , ide , jds , jde , &
+                         ims , ime , jms , jme , &
+                         its , ite , jts , jte , &
+                         its , ite , jts , jte   ) 
+   CALL set_physical_bc2d( grid%sina , 'r' , config_flags ,              &
+                         ids , ide , jds , jde , &
+                         ims , ime , jms , jme , &
+                         its , ite , jts , jte , &
+                         its , ite , jts , jte   ) 
+   CALL set_physical_bc2d( grid%cosa , 'r' , config_flags ,              &
+                         ids , ide , jds , jde , &
+                         ims , ime , jms , jme , &
+                         its , ite , jts , jte , &
+                         its , ite , jts , jte   ) 
+   CALL set_physical_bc2d( grid%e , 'r' , config_flags ,                 &
+                         ids , ide , jds , jde , &
+                         ims , ime , jms , jme , &
+                         its , ite , jts , jte , &
+                         its , ite , jts , jte   ) 
+   CALL set_physical_bc2d( grid%f , 'r' , config_flags ,                 &
+                         ids , ide , jds , jde , &
+                         ims , ime , jms , jme , &
+                         its , ite , jts , jte , &
+                         its , ite , jts , jte   ) 
+
+#ifdef DM_PARALLEL
+#   include "HALO_EM_INIT_1.inc"
+#   include "HALO_EM_INIT_2.inc"
+#   include "HALO_EM_INIT_3.inc"
+#   include "HALO_EM_INIT_4.inc"
+#   include "HALO_EM_INIT_5.inc"
+#  include "PERIOD_BDY_EM_INIT.inc"
+#  include "PERIOD_BDY_EM_MOIST.inc"
+#  include "PERIOD_BDY_EM_CHEM.inc"
+#endif
+
+     CALL wrf_debug ( 100 , 'module_start: start_domain_rk: Returning' )
+
+     RETURN
+
+   END SUBROUTINE start_domain_em
+
Index: trunk/WRF.COMMON/WRFV2/dyn_em_save
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_em_save	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_em_save	(revision 2744)
@@ -0,0 +1,18 @@
+mkdir save/dyn_em
+cp -rf dyn_em/diff_module_diffusion_em save/dyn_em
+cp -rf dyn_em/diff_module_em save/dyn_em
+cp -rf dyn_em/module_em.F save/dyn_em
+cp -rf dyn_em/diff_module_initialize_hill2d_x save/dyn_em
+cp -rf dyn_em/diff_module_initialize_real save/dyn_em
+cp -rf dyn_em/diff_solve_em save/dyn_em
+cp -rf dyn_em/diff_start_em save/dyn_em
+cp -rf dyn_em/start_em.F save/dyn_em
+cp -rf dyn_em/solve_em.F save/dyn_em
+cp -rf dyn_em/module_big_step_utilities_em.F save/dyn_em
+cp -rf dyn_em/Makefile save/dyn_em
+cp -rf dyn_em/module_diffusion_em.F save/dyn_em
+cp -rf dyn_em/module_initialize_quarter_ss.F* save/dyn_em
+cp -rf dyn_em/module_initialize_hill2d_x.F save/dyn_em
+cp -rf dyn_em/module_initialize_real*.F save/dyn_em
+cp -rf dyn_em/diff_Makefile save/dyn_em
+cp -rf dyn_em/diff_module_big_step_utilities_em save/dyn_em
Index: trunk/WRF.COMMON/WRFV2/dyn_exp/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_exp/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_exp/Makefile	(revision 2744)
@@ -0,0 +1,31 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+
+MODULES =                 		\
+        module_exp.o         		\
+	$(CASE_MODULE)
+
+# possible CASE_MODULE settings
+#	module_initialize_exp.o        
+
+OBJS    = 		          	\
+	solve_exp.o init_modules_exp.o
+
+LIBTARGET    =  dyn_exp
+TARGETDIR    =  ./
+$(LIBTARGET) :  $(MODULES) $(OBJS)
+		$(AR) ../main/libwrflib.a $(MODULES) $(OBJS)
+
+include ../configure.wrf
+
+clean:
+	@ echo 'use the clean script'
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+solve_exp.o:   module_exp.o
+
Index: trunk/WRF.COMMON/WRFV2/dyn_exp/README
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_exp/README	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_exp/README	(revision 2744)
@@ -0,0 +1,123 @@
+1.  Created a new "core specific" directory
+
+mkdir dyn_exp
+
+2.  Create a test directory for experimental core
+
+mkdir test/exp_real
+
+3.  Edited top level Makefile to add targets for same
+
+3.a.  rules to build the framework and then the experimental core
+
+exp_wrf :
+        $(MAKE) MODULE_DIRS="$(SLT_MODULES)" ext
+        $(MAKE) MODULE_DIRS="$(SLT_MODULES)" toolsdir
+        $(MAKE) MODULE_DIRS="$(SLT_MODULES)" framework
+        $(MAKE) MODULE_DIRS="$(SLT_MODULES)" shared
+        $(MAKE) MODULE_DIRS="$(SLT_MODULES)" exp_core
+
+3.b.  sub-rule to build the expimental core
+
+exp_core :
+        @ echo '--------------------------------------'
+        ( cd dyn_exp ; $(MAKE) )
+
+3.c.  experimental core initialization
+
+exp_real : exp_wrf
+        @ echo '--------------------------------------'
+        ( cd main ; $(MAKE) MODULE_DIRS="$(EXP_MODULES)" SOLVER=exp IDEAL_CASE=exp exp_ideal )
+        ( cd test/exp ; /bin/rm -f ideal.exe ; ln -sf ../../main/ideal.exe . )
+        ( cd test/exp ; ln -sf ../../run/README.namelist . )
+
+
+3.d.   add macros to specify the modules for this core
+
+EXP_MODULE_DIR = -I../dyn_exp
+EXP_MODULES =  $(EXP_MODULE_DIR) $(INCLUDE_MODULES)
+
+
+
+4. Edit share/solve_interface.F to add call to experimental core
+
+   ELSE IF ( config_flags%dyn_opt == DYN_EXP  ) THEN
+
+     CALL solve_exp  ( grid ,            &
+!
+#include <exp_actual_args.inc>
+!
+               )
+
+4a. share/start_domain.F
+
+5. Create dyn_exp/solve_exp.F
+
+It's all there and very short -- just a trivial relaxation; some of the
+stuff in there is just "magic," for right now.  Note that the code in
+here is the code to do one step. The time loop is part of the driver
+and can be found in frame/module_integrate.F, which call
+solve_interface, which calls this routine. Note, too, that solve_exp
+doesn't do any computation itself. It is mediation layer. It calls
+model layer subroutines (dyn_exp/module_exp.F) to do the actual computation
+in 'tile-callable' fashion.
+
+6. Create dyn_exp/module_exp.F
+
+This is the model layer code.  Note that boundary tests are always
+encoded explicitly as conditionals using the domain indices passed
+in through the arg list; never implicitly as part of the loop range.
+
+7. Edit the Registry file and create the state data assocaited with this
+solver.  Single entry:
+
+ state real x ikj dyn_exp 2 - ih "TOYVAR"
+
+This specfies a two timelevel variable 'x' that will be known at the
+mediation layer and below as x_1 and x_2 (since it is core associated it
+will be known as exp_x_1 and exp_x_2 in the driver layer; the name
+of the core is prepended to prevent colllisions with variables of the
+same name that are associated with other cores).  The 'ih' means it will
+participate in initial data and in history data. The veriable is known
+externally as TOYVAR, its data name and the name the variable will have
+in data sets.
+
+Note that since the variable is not listed as staggered in any dimension
+it's logical (domain) size is ids:ide-1, kds:kde-1, jds:jde-1. This
+is important in the the module_exp.F code that tests for northern
+and eastern boundaries, and in the init code in module_initialize_exp.F
+
+8. Edit the Registry file and create a halo-exchange for x_1.
+
+ halo     HALO_EXP_A    4:x_1
+
+Note that since halo operations are called from the mediation layer, it
+is not necessary to pre-pend the dyncore name to the variable name x_1
+when adding it to a comm operation like a halo exchange.
+
+9. Edit the Registry file to set up '4' as the value of the 
+namelist variable dyn_opt that means to select our exp dyncore.
+
+package   dyn_exp       dyn_opt==4                   -             -
+
+10. Create a dyn_exp/Makefile  (see that file)
+
+11. Create an file exp/init_modules.F (also includes a couple of stubs
+for other dyncores already in WRF; this is not the normal or correct
+way of doing that; but I'm hurrying...)
+
+12. Create a file exp/module_initialize_exp.F.  This is not part of the
+WRF model itself; rather it is a pre-processor that produces initial
+data for the WRF model.
+
+13. Edit frame/module_domain.F to add case for DYN_EXP to
+alloc_space_field.  (This is a bug;
+one should never have to edit the framework code; will fix this in
+coming versions).  Same goes for share/start_domain.F, although this
+is not a framework routine.
+
+14. clean commands
+
+15. namelist file
+     copy from another dir and change dyn_opt
+     boundary conditions
Index: trunk/WRF.COMMON/WRFV2/dyn_exp/init_modules_exp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_exp/init_modules_exp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_exp/init_modules_exp.F	(revision 2744)
@@ -0,0 +1,34 @@
+!WRF:MEDIATION_LAYER
+!
+SUBROUTINE init_modules_exp
+ USE module_configure
+ USE module_driver_constants
+ USE module_model_constants
+ USE module_domain
+ USE module_machine
+ USE module_nesting
+ USE module_sm
+ USE module_timing
+ USE module_tiles
+ USE module_io_wrf
+ USE module_io
+#ifdef DM_PARALLEL
+ USE module_dm
+#endif
+
+ CALL init_module_configure
+ CALL init_module_driver_constants
+ CALL init_module_model_constants
+ CALL init_module_domain
+! CALL init_module_start
+ CALL init_module_machine
+#ifdef DM_PARALLEL
+ CALL init_module_dm
+#endif
+ CALL init_module_nesting
+ CALL init_module_timing
+ CALL init_module_tiles
+ CALL init_module_io_wrf
+ CALL init_module_io
+END SUBROUTINE init_modules_exp
+
Index: trunk/WRF.COMMON/WRFV2/dyn_exp/module_exp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_exp/module_exp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_exp/module_exp.F	(revision 2744)
@@ -0,0 +1,90 @@
+!WRF:MODEL_LAYER:DYNAMICS
+!
+
+MODULE module_exp
+
+   USE module_state_description
+
+CONTAINS
+
+!------------------------------------------------------------------------
+
+SUBROUTINE relax_1_into_2  ( x1, x2,                        &
+                           ids, ide, jds, jde, kds, kde,    &
+                           ims, ime, jms, jme, kms, kme,    &
+                           its, ite, jts, jte, kts, kte    )
+
+   IMPLICIT NONE
+
+
+   !  Input data.
+
+   INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
+                                               INTENT(IN   ) ::  x1
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme  ) ,                     &
+                                               INTENT(  OUT) ::  x2
+
+   integer :: k, i, j
+
+
+   DO j = jts, jte
+     IF ( j > jds .AND. j < jde-1 ) THEN    ! jde-1 because x is not staggered in Y
+       DO k = kts, kte
+         DO i = its, ite
+           IF ( i > ids .AND. i < ide-1 ) THEN    ! ide-1 because x is not staggered in X
+             x2(i,k,j) = 0.25*(x1(i+1,k,j)+x1(i-1,k,j)+x1(i,k,j+1)+x1(i,k,j-1))
+           ENDIF
+         ENDDO
+       ENDDO
+     ENDIF
+   ENDDO
+
+END SUBROUTINE relax_1_into_2
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE copy_2_into_1  ( x2, x1,                        &
+                           ids, ide, jds, jde, kds, kde,    &
+                           ims, ime, jms, jme, kms, kme,    &
+                           its, ite, jts, jte, kts, kte    )
+
+   IMPLICIT NONE
+
+
+   !  Input data.
+
+   INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
+                                               INTENT(IN   ) ::  x2
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme  ) ,                     &
+                                               INTENT(  OUT) ::  x1
+
+   integer :: k, i, j
+
+   DO j = jts, jte
+     IF ( j > jds .AND. j < jde-1 ) THEN
+       DO k = kts, kte
+         DO i = its, ite
+           IF ( i > ids .AND. i < ide-1 ) THEN
+             x1(i,k,j) = x2(i,k,j)
+           ENDIF
+         ENDDO
+       ENDDO
+     ENDIF
+   ENDDO
+
+END SUBROUTINE copy_2_into_1
+
+!-------------------------------------------------------------------------------
+
+END MODULE module_exp
+
Index: trunk/WRF.COMMON/WRFV2/dyn_exp/module_initialize_exp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_exp/module_initialize_exp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_exp/module_initialize_exp.F	(revision 2744)
@@ -0,0 +1,163 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!  This MODULE CONTAINS the following routines:
+
+!  initialize_field_test - 1. Set different fields to different constant
+!                             values.  This is only a test.  If the correct
+!                             domain is not found (based upon the "id")
+!                             then a fatal error is issued.               
+
+MODULE module_initialize
+
+   USE module_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_timing
+   USE module_configure
+
+
+CONTAINS
+
+   SUBROUTINE init_domain_exp ( grid &
+!
+# include <exp_dummy_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <exp_dummy_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+#define COPY_IN
+#include <exp_scalar_derefs.inc>
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! set the boundaries of the X array
+    DO j = jts, jte
+      DO k = kts, kte
+        DO i = its, ite
+          IF ( i == ids .OR. i == ide-1 .OR. j == jds .OR. j == jde-1 ) THEN
+            x_1(i,k,j) = 1.
+            x_2(i,k,j) = 1.
+          ELSE
+            x_1(i,k,j) = 0.
+            x_2(i,k,j) = 0.
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDDO
+
+#define COPY_OUT
+#include <exp_scalar_derefs.inc>
+
+   RETURN
+
+   END SUBROUTINE init_domain_exp
+   
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER                :: dyn_opt 
+   INTEGER :: idum1, idum2
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+#include "deref_kludge.h"
+
+   CALL nl_get_dyn_opt( 1, dyn_opt )
+   
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF ( dyn_opt .eq. DYN_EXP  ) THEN
+     CALL init_domain_exp( grid &
+!
+#include <exp_actual_args.inc>
+!
+                        )
+   ELSE
+     WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     CALL wrf_error_fatal ( ' init_domain: unknown or unimplemented dyn_opt ' )
+   ENDIF
+
+   END SUBROUTINE init_domain
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_exp/solve_exp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_exp/solve_exp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_exp/solve_exp.F	(revision 2744)
@@ -0,0 +1,154 @@
+!WRF:MEDIATION_LAYER:SOLVER
+!
+
+SUBROUTINE solve_exp ( grid                &
+!
+#include "exp_dummy_args.inc"
+!
+                 )
+
+USE module_exp
+
+
+! Driver layer modules
+   USE module_domain
+   USE module_configure
+   USE module_driver_constants
+   USE module_machine
+   USE module_tiles
+   USE module_dm
+! Mediation layer modules
+! Registry generated module
+   USE module_state_description
+
+   IMPLICIT NONE
+
+   !  Subroutine interface block.
+
+   !  Input data.
+
+   TYPE(domain) , TARGET          :: grid
+
+   !  Definitions of dummy arguments to solve
+#include <exp_dummy_decl.inc>
+
+   !  WRF state bcs
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   ! WRF state data
+
+   ! Local data
+
+   INTEGER                         :: k_start , k_end
+   INTEGER                         :: ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      ips , ipe , jps , jpe , kps , kpe
+   INTEGER                         :: ij , iteration
+   INTEGER                         :: im , num_3d_m , ic , num_3d_c
+   INTEGER                         :: loop
+   INTEGER                         :: ijds, ijde
+   INTEGER                         :: idum1, idum2
+
+! storage for tendencies and decoupled state (generated from Registry)
+#include <exp_i1_decl.inc>
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+#include "deref_kludge.h"
+
+#define COPY_IN
+#include <exp_scalar_derefs.inc>
+#ifdef DM_PARALLEL
+#    define REGISTER_I1
+#      include <exp_data_calls.inc>
+#endif
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+! this sets up the P_* indices into the moisture and chem arrays
+   CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
+ 
+   !  De-reference dimension information stored in the grid data structure.
+
+!                    ikj model   kij model
+
+   ids             = grid%sd31 ! grid%sd32 
+   ide             = grid%ed31 ! grid%ed32 
+   jds             = grid%sd33 ! grid%sd33 
+   jde             = grid%ed33 ! grid%ed33 
+   kds             = grid%sd32 ! grid%sd31 
+   kde             = grid%ed32 ! grid%ed31
+
+   ims             = grid%sm31 ! grid%sm32
+   ime             = grid%em31 ! grid%em32 
+   jms             = grid%sm33 ! grid%sm33 
+   jme             = grid%em33 ! grid%em33 
+   kms             = grid%sm32 ! grid%sm31 
+   kme             = grid%em32 ! grid%em31
+
+   ips             = grid%sp31 ! grid%sp32
+   ipe             = grid%ep31 ! grid%ep32
+   jps             = grid%sp33 ! grid%sp33
+   jpe             = grid%ep33 ! grid%ep33
+   kps             = grid%sp32 ! grid%sp31
+   kpe             = grid%ep32 ! grid%ep31
+
+   k_start         = grid%sd32 ! grid%sd31
+   k_end           = grid%ed32 ! grid%ed31
+
+   ijds = min(ids, jds)
+   ijde = max(ide, jde)
+
+   !  Compute these starting and stopping locations for each tile and number of tiles.
+
+   CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
+
+! end of "magic"; start of experimental solver; just a goofy relaxation 
+
+! Halo exchange on x_1 for relaxation operator in model layer subroutine
+! relax_1_into_2
+
+#ifdef DM_PARALLEL
+# include "HALO_EXP_A.inc"
+#endif
+
+! Simple 4 pt average of x_1 into x_2
+
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+        CALL wrf_debug ( 200 , ' call relax_1_into_2' )
+        CALL relax_1_into_2 ( x_1, x_2,                            &
+                              ids, ide, jds, jde, kds, kde,        &
+                              ims, ime, jms, jme, kms, kme,        &
+                              grid%i_start(ij), grid%i_end(ij),    &
+                              grid%j_start(ij), grid%j_end(ij),    &
+                              k_start, k_end                       )
+     END DO
+     !$OMP END PARALLEL DO
+
+! Update x_1 for next go 'round
+
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+        CALL wrf_debug ( 200 , ' call copy_2_into_1' )
+        CALL copy_2_into_1  ( x_2, x_1,                            &
+                              ids, ide, jds, jde, kds, kde,        &
+                              ims, ime, jms, jme, kms, kme,        &
+                              grid%i_start(ij), grid%i_end(ij),    &
+                              grid%j_start(ij), grid%j_end(ij),    &
+                              k_start, k_end                       )
+     END DO
+     !$OMP END PARALLEL DO
+
+#define COPY_OUT
+#include <exp_scalar_derefs.inc>
+
+   RETURN
+
+END SUBROUTINE solve_exp
+
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/BUCKETS.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/BUCKETS.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/BUCKETS.F	(revision 2744)
@@ -0,0 +1,287 @@
+!-----------------------------------------------------------------------
+!
+!NCEP_MESO:MODEL_LAYER: ACCUMULATION BUCKETS
+!
+!-----------------------------------------------------------------------
+      SUBROUTINE BUCKETS(NTSD,NPREC,NSRFC,NRDSW,NRDLW                   &
+     &                  ,RESTART,TSTART                                 &
+     &                  ,NCLOD,NHEAT,NPHS,TSPH                          &
+     &                  ,ACPREC,CUPREC,ACSNOW,ACSNOM,SSROFF,BGROFF      &
+     &                  ,SFCEVP,POTEVP,SFCSHX,SFCLHX,SUBSHX,SNOPCX      &
+     &                  ,SFCUVX,POTFLX                                  &
+     &                  ,ARDSW,ASWIN,ASWOUT,ASWTOA                      &
+     &                  ,ARDLW,ALWIN,ALWOUT,ALWTOA                      &
+     &                  ,ACFRST,NCFRST,ACFRCV,NCFRCV                    &
+     &                  ,AVCNVC,AVRAIN,TCUCN,TRAIN                      &
+     &                  ,ASRFC                                          &
+     &                  ,T,TLMAX,TLMIN                                  &
+     &                  ,IDS,IDE,JDS,JDE,KDS,KDE                        &
+     &                  ,IMS,IME,JMS,JME,KMS,KME                        &
+     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
+!-----------------------------------------------------------------------
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    BUCKETS     EMPTY ACCUMULATION BUCKETS WHEN NEEDED
+!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 04-08-18
+!     
+! ABSTRACT:
+!     VARIOUS ACCUMULATING QUANTITIES NEED TO BE RESET TO ZERO AT
+!     SPECIFIED INTERVALS.
+!     
+! USAGE: CALL BUCKETS FROM SOLVE_NMM
+!   INPUT ARGUMENT LIST:
+!        NTSD - CURRENT TIMESTEP
+!       NPREC - NUMBER OF TIMESTEPS BETWEEN EMPTYING BUCKETS FOR PRECIP
+!       NHEAT - NUMBER OF TIMESTEPS BETWEEN EMPTYING BUCKETS FOR 
+!               LATENT HEATING
+!       NCNVC - NUMBER OF TIMESTEPS BETWEEN CALLS TO CONVECTION
+!       TSPH - NUMBER OF DYNAMICS TIMESTEPS PER HOUR
+!      ACPREC - ACCUMULATED TOTAL PRECIPITATION (M)
+!      CUPREC - ACCUMULATED CONVECTIVE PRECIPITATION (M)
+!      ACSNOW - ACCUMULATED SNOWFALL (M)
+!      ACSNOM - ACCUMULATED SNOWMELT (M)
+!      SSROFF - ACCUMULATED SURFACE RUNOFF
+!      BGROFF - ACCUMULATED BELOW GROUND RUNOFF
+!      SFCEVP - ACCUMULATED SURFACE EVAPORATION
+!      POTEVP - ACCUMULATED POTENTIAL EVAPORATION
+!           T - TEMPERATURE
+!       TLMAX - MAX TEMPERATURE EACH HOUR IN LOWEST LAYER
+!       TLMIN - MIN TEMPERATURE EACH HOUR IN LOWEST LAYER
+!  
+!   OUTPUT ARGUMENT LIST:  THE ACCUMULATED QUANTITIES
+!     
+!   OUTPUT FILES:  NONE
+!     
+!   SUBPROGRAMS CALLED:  NONE
+!  
+!   UNIQUE: NONE
+!  
+!   LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!*** ARGUMENTS
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: NCLOD,NHEAT,NPHS,NPREC,NRDLW,NRDSW          &
+                           ,NSRFC,NTSD                                  &
+                           ,IDS,IDE,JDS,JDE,KDS,KDE                     &
+                           ,IMS,IME,JMS,JME,KMS,KME                     &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE 
+!
+      REAL,INTENT(IN) :: TSPH,TSTART
+      REAL,INTENT(OUT) :: ARDLW,ARDSW,ASRFC,AVCNVC,AVRAIN
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: ACPREC,ACSNOM      &
+     &                                              ,ACSNOW,ALWIN       &
+     &                                              ,ACFRST,ACFRCV      &
+     &                                              ,ALWOUT,ALWTOA      &
+     &                                              ,ASWIN,ASWOUT       &
+     &                                              ,ASWTOA,BGROFF      &
+     &                                              ,CUPREC,POTEVP      &
+     &                                              ,POTFLX,SFCEVP      &
+     &                                              ,SFCLHX,SFCSHX      &
+     &                                              ,SFCUVX,SNOPCX      &
+     &                                              ,SSROFF,SUBSHX
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: NCFRST,NCFRCV
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: TLMAX,TLMIN
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: T
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: TCUCN      &
+     &                                                      ,TRAIN
+!
+      LOGICAL,INTENT(IN) :: RESTART
+!
+!-----------------------------------------------------------------------
+!***  LOCAL VARIABLES 
+!-----------------------------------------------------------------------
+!
+      INTEGER :: I,J,K,NTSD_BUCKET,NTSPH
+      LOGICAL  WRF_DM_ON_MONITOR
+      EXTERNAL WRF_DM_ON_MONITOR
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      NTSD_BUCKET=NTSD
+      IF(RESTART.AND.TSTART>0.)THEN
+        NTSD_BUCKET=NTSD-1
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  TOTAL AND CONVECTIVE PRECIPITATION ARRAYS.
+!***  TOTAL SNOW AND SNOW MELT ARRAYS.
+!***  STORM SURFACE AND BASE GROUND RUN OFF ARRAYS.
+!***  EVAPORATION ARRAYS.
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD_BUCKET,NPREC)==0)THEN
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          ACPREC(I,J)=0.
+          CUPREC(I,J)=0.
+          ACSNOW(I,J)=0.
+          ACSNOM(I,J)=0.
+          SSROFF(I,J)=0.
+          BGROFF(I,J)=0.
+          SFCEVP(I,J)=0.
+          POTEVP(I,J)=0.
+        ENDDO
+        ENDDO
+!
+        IF ( WRF_DM_ON_MONITOR() ) THEN
+        CALL WRF_MESSAGE('ZEROED OUT PRECIP/RUNOFF ARRAYS')
+        ENDIF
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  SFC FLUX ARRAYS.
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD_BUCKET,NSRFC)==0)THEN
+        ASRFC=0.
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          SFCSHX(I,J)=0.
+          SFCLHX(I,J)=0.
+          SUBSHX(I,J)=0.
+          SNOPCX(I,J)=0.
+          SFCUVX(I,J)=0.
+          POTFLX(I,J)=0.
+        ENDDO
+        ENDDO
+!
+        IF ( WRF_DM_ON_MONITOR() ) THEN
+        CALL WRF_MESSAGE('ZEROED OUT SFC EVAP/FLUX ARRAYS')
+        ENDIF
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  SHORTWAVE FLUX ACCUMULATION ARRAYS.
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD_BUCKET,NRDSW)==0)THEN
+        ARDSW=0.
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          ASWIN(I,J) =0.
+          ASWOUT(I,J)=0.
+          ASWTOA(I,J)=0.
+        ENDDO
+        ENDDO
+!
+        IF ( WRF_DM_ON_MONITOR() ) THEN
+        CALL WRF_MESSAGE('ZEROED OUT ACCUMULATED SHORTWAVE FLUX ARRAYS')
+        ENDIF
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  LONGWAVE FLUX ACCUMULATION ARRAYS.
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD_BUCKET,NRDLW)==0)THEN
+        ARDLW=0.
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          ALWIN(I,J) =0.
+          ALWOUT(I,J)=0.
+          ALWTOA(I,J)=0.
+        ENDDO
+        ENDDO
+!
+        IF ( WRF_DM_ON_MONITOR() ) THEN
+        CALL WRF_MESSAGE('ZEROED OUT ACCUMULATED LONGWAVE FLUX ARRAYS')
+        ENDIF
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  TIME-AVERAGED CLOUD FRACTION ARRAYS.
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD_BUCKET,NCLOD)==0)THEN
+!***
+  !--- Ferrier 11/2/05:  Right now no accumulator variable is used (e.g.,
+  !    "ACLOD"), but instead the 2D arrays NCFRST & NCFRCV are used.  These
+  !    can be removed later to streamline the code.
+!***
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          ACFRCV(I,J)=0.
+          ACFRST(I,J)=0.
+          NCFRCV(I,J)=0
+          NCFRST(I,J)=0
+        ENDDO
+        ENDDO
+!
+        IF ( WRF_DM_ON_MONITOR() ) THEN
+        CALL WRF_MESSAGE('ZEROED OUT ACCUMULATED CLOUD FRACTION ARRAYS')
+        ENDIF
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  GRID-SCALE AND CONVECTIVE (LATENT) HEATING ARRAYS.
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD_BUCKET,NHEAT)==0)THEN
+        AVCNVC=0.
+        AVRAIN=0.
+!
+        DO J=JTS,JTE
+        DO K=KTS,KTE
+        DO I=ITS,ITE
+          TRAIN(I,K,J)=0.
+          TCUCN(I,K,J)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+!
+        IF ( WRF_DM_ON_MONITOR() ) THEN
+        CALL WRF_MESSAGE('ZEROED OUT ACCUMULATED LATENT HEATING ARRAYS')
+        ENDIF
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  MAX/MIN TEMPERATURES
+!-----------------------------------------------------------------------
+!
+      NTSPH=NINT(TSPH)
+      IF(MOD(NTSD_BUCKET,NTSPH)==0)THEN
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          TLMAX(I,J)=-999.
+          TLMIN(I,J)=999.
+        ENDDO
+        ENDDO
+!
+        IF ( WRF_DM_ON_MONITOR() ) THEN
+        CALL WRF_MESSAGE('RESET MAX/MIN TEMPERTURES')
+        ENDIF
+      ENDIF
+!
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        TLMAX(I,J)=MAX(TLMAX(I,J),T(I,1,J))
+        TLMIN(I,J)=MIN(TLMIN(I,J),T(I,1,J))
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!
+      END SUBROUTINE BUCKETS
+!
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/CLTEND.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/CLTEND.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/CLTEND.F	(revision 2744)
@@ -0,0 +1,95 @@
+!
+!NCEP_MESO:MODEL_LAYER: PHYSICS
+!
+!**********************************************************************
+      SUBROUTINE CLTEND (ICLTEND,NPHS,T,T_OLD,T_ADJ                    &
+                        ,IDS,IDE,JDS,JDE,KDS,KDE                       &
+                        ,IMS,IME,JMS,JME,KMS,KME                       &
+                        ,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    CLTEND      TEMPERATURE CHANGE BY CLOUD PROCESSES
+!   PRGRMMR: FERRIER         ORG: W/NP22     DATE: 01-09-26
+!     
+! ABSTRACT:
+!     CLTEND GRADUALLY UPDATES TEMPERATURE TENDENCIES FROM CONVECTION 
+!     GRID-SCALE MICROPHYSICS, AND PRECIPITATION ASSIMILATION.
+!     
+! USAGE: CALL CLTEND FROM SOLVE_RUNSTEAM
+!   INPUT ARGUMENT LIST:
+!     ICLTEND - FLAG SET TO -1 PRIOR TO PHYSICS CALLS, 0 AFTER PHYSICS
+!               CALLS, AND 1 FOR UPDATING TEMPERATURES EVERY TIME STEP
+!  
+!   OUTPUT ARGUMENT LIST:  NONE
+!     
+!   OUTPUT FILES:  NONE
+!     
+!   SUBPROGRAMS CALLED:  NONE
+!  
+!   UNIQUE: NONE
+!  
+!   LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!----------------------------------------------------------------------
+      USE module_MPP
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: ICLTEND                                    &
+                           ,IDS,IDE,JDS,JDE,KDS,KDE                    &
+                           ,IMS,IME,JMS,JME,KMS,KME                    &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE                    &
+                           ,NPHS
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: T     &
+                                                                ,T_ADJ &
+                                                                ,T_OLD
+!
+!***  LOCAL VARIABLES 
+!
+      INTEGER :: I,J,K
+!
+      REAL :: DELTPH
+!
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!
+      IF(ICLTEND.LT.0)THEN
+        DO J=JTS,JTE
+        DO K=KTS,KTE
+        DO I=ITS,ITE
+          T_OLD(I,K,J)=T(I,K,J)
+        ENDDO
+        ENDDO
+        ENDDO
+      ELSEIF(ICLTEND.EQ.0)THEN
+        DO J=JTS,JTE
+        DO K=KTS,KTE
+        DO I=ITS,ITE
+          T_ADJ(I,K,J)=T(I,K,J)-T_OLD(I,K,J)
+          T(I,K,J)=T_OLD(I,K,J)
+        ENDDO
+        ENDDO
+        ENDDO
+      ELSE
+        DELTPH=1./REAL(NPHS)
+        DO J=JTS,JTE
+        DO K=KTS,KTE
+        DO I=ITS,ITE
+          T(I,K,J)=T(I,K,J)+DELTPH*T_ADJ(I,K,J)
+        ENDDO
+        ENDDO
+        ENDDO
+      ENDIF
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE CLTEND
+!
+!----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/DSTRB.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/DSTRB.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/DSTRB.F	(revision 2744)
@@ -0,0 +1,167 @@
+!-----------------------------------------------------------------------
+      SUBROUTINE DSTRB(ARRAYG,ARRAYL,LGS,LGE,LLS,LLE,L1                 &
+     &,                IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &,                IMS,IME,JMS,JME,KMS,KME                          &
+     &,                ITS,ITE,JTS,JTE,KTS,KTE)
+!-----------------------------------------------------------------------
+!     DSTRB DISTRIBUTES THE ELEMENTS OF REAL GLOBAL ARRAY ARRG TO THE
+!     REAL LOCAL ARRAYS ARRL.  LG IS THE VERTICAL DIMENSION OF THE
+!     GLOBAL ARRAY.  LL IS THE VERTICAL DIMENSION OF THE LOCAL ARRAY.
+!     L1 IS THE SPECIFIC LEVEL OF ARRL THAT IS BEING FILLED DURING
+!     THIS CALL (PERTINENT WHEN LG=1 AND LL>1).
+!-----------------------------------------------------------------------
+      USE MODULE_EXT_INTERNAL
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      INCLUDE "mpif.h"
+!-----------------------------------------------------------------------
+!***
+!***  ARGUMENT VARIABLES
+!***
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &,                     IMS,IME,JMS,JME,KMS,KME                     &
+     &,                     ITS,ITE,JTS,JTE,KTS,KTE
+      INTEGER,INTENT(IN) :: L1,LGE,LGS,LLE,LLS
+!
+      REAL,DIMENSION(IDS:IDE,LGS:LGE,JDS:JDE),INTENT(IN) :: ARRAYG
+      REAL,DIMENSION(IMS:IME,LLS:LLE,JMS:JME),INTENT(OUT) :: ARRAYL
+!-----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      REAL,ALLOCATABLE,DIMENSION(:) :: ARRAYX
+!
+      INTEGER :: I,IEND,IPE,IRECV,IRTN,ISEND,ISTART,J,JEND,JSTART,KNT   &
+     &,          L,MPI_COMM_COMP,NUMVALS,MYPE,NPES
+      INTEGER,DIMENSION(4) :: LIMITS
+      INTEGER,DIMENSION(MPI_STATUS_SIZE) :: ISTAT
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+!***  GET OUR TASK ID AND THE COMMUNICATOR
+!
+      CALL WRF_GET_MYPROC(MYPE)
+      CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
+      CALL WRF_GET_NPROC(NPES)
+!
+!***  INITIALIZE THE OUTPUT ARRAY
+!
+      DO J=JMS,JME
+      DO L=LLS,LLE
+      DO I=IMS,IME
+        ARRAYL(I,L,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  TASK 0 FILLS ITS OWN LOCAL DOMAIN THEN PARCELS OUT ALL THE OTHER 
+!***  PIECES TO THE OTHER TASKS.
+!-----------------------------------------------------------------------
+!
+      tasks : IF(MYPE==0)THEN
+!
+        IF(LGE==LGS)THEN
+          DO J=JTS,JTE
+          DO I=ITS,ITE
+            ARRAYL(I,L1,J)=ARRAYG(I,LGS,J)
+          ENDDO
+          ENDDO
+!
+        ELSE
+!
+          DO J=JTS,JTE
+            DO L=LGS,LGE
+            DO I=ITS,ITE
+              ARRAYL(I,L,J)=ARRAYG(I,L,J)
+            ENDDO
+            ENDDO
+          ENDDO
+        ENDIF
+!
+!***  TASK 0 NEEDS THE LIMITS FROM EACH OF THE OTHER TASKS AND THEN
+!***  SENDS OUT THE APPROPRIATE PIECE OF THE GLOBAL ARRAY.
+!
+        DO IPE=1,NPES-1
+!
+          CALL MPI_RECV(LIMITS,4,MPI_INTEGER,IPE,IPE,MPI_COMM_COMP      &
+     &,                 ISTAT,IRECV)
+          ISTART=LIMITS(1)
+          IEND=LIMITS(2)
+          JSTART=LIMITS(3)
+          JEND=LIMITS(4)
+!
+          NUMVALS=(IEND-ISTART+1)*(JEND-JSTART+1)*(LGE-LGS+1)
+          ALLOCATE(ARRAYX(NUMVALS),STAT=I)
+          
+          KNT=0
+!
+          DO J=JSTART,JEND
+            DO L=LGS,LGE
+            DO I=ISTART,IEND
+              KNT=KNT+1
+              ARRAYX(KNT)=ARRAYG(I,L,J)
+            ENDDO
+            ENDDO
+          ENDDO
+!
+          CALL MPI_SEND(ARRAYX,KNT,MPI_REAL,IPE,IPE,MPI_COMM_COMP,ISEND)
+!
+          DEALLOCATE(ARRAYX)
+!
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  ALL OTHER TASKS TELL TASK 0 WHAT THEIR HORIZONTAL LIMITS ARE AND
+!***  RECEIVE THEIR PIECE OF THE GLOBAL ARRAY FROM TASK 0.
+!-----------------------------------------------------------------------
+!
+      ELSE
+!
+        LIMITS(1)=ITS
+        LIMITS(2)=ITE
+        LIMITS(3)=JTS
+        LIMITS(4)=JTE
+!
+        CALL MPI_SEND(LIMITS,4,MPI_INTEGER,0,MYPE,MPI_COMM_COMP,ISEND)
+!
+        NUMVALS=(ITE-ITS+1)*(JTE-JTS+1)*(LGE-LGS+1)
+        ALLOCATE(ARRAYX(NUMVALS),STAT=I)
+!
+        CALL MPI_RECV(ARRAYX,NUMVALS,MPI_REAL,0,MYPE,MPI_COMM_COMP      &
+     &,               ISTAT,IRECV)
+!
+        KNT=0
+        IF(LGE==LGS)THEN
+          DO J=JTS,JTE
+          DO I=ITS,ITE
+            KNT=KNT+1
+            ARRAYL(I,L1,J)=ARRAYX(KNT)
+          ENDDO
+          ENDDO
+        ELSE
+          DO J=JTS,JTE
+            DO L=LGS,LGE
+            DO I=ITS,ITE
+              KNT=KNT+1
+              ARRAYL(I,L,J)=ARRAYX(KNT)
+            ENDDO
+            ENDDO
+          ENDDO
+        ENDIF
+!
+        DEALLOCATE(ARRAYX)
+!
+!-----------------------------------------------------------------------
+!
+      ENDIF tasks
+!
+!-----------------------------------------------------------------------
+      CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
+!-----------------------------------------------------------------------
+!
+      END SUBROUTINE DSTRB
+!
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/Makefile	(revision 2744)
@@ -0,0 +1,91 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+
+MODULES =                 		\
+        module_ADVECTION.o         	\
+        module_BC_NMM.o         	\
+        module_BNDRY_COND.o         	\
+        module_NEST_UTIL.o              \
+        module_CTLBLK.o         	\
+        module_DIFFUSION_NMM.o         	\
+        module_IGWAVE_ADJUST.o         	\
+        module_NONHY_DYNAM.o         	\
+        module_PHYSICS_CALLS.o       	\
+        module_MPPINIT.o        	\
+        module_TIMERS.o                 \
+        module_ZEROX.o                  \
+        module_si_io_nmm.o              \
+        module_initialize_real.o        \
+        module_PRECIP_ADJUST.o          \
+	$(CASE_MODULE)
+
+# moved into share/Makefile
+#        module_MPP.o              	\
+
+#        module_INDX.o                   \
+
+# possible CASE_MODULE settings
+#	module_initialize_nmm.o        
+
+OBJS    = 		          	\
+	read_nmm.o			\
+	init_modules_nmm.o  		\
+	start_domain_nmm.o  		\
+	solve_nmm.o         		\
+	RDTEMP.o    			\
+	BUCKETS.o 			\
+        DSTRB.o                         \
+	CLTEND.o                        \
+        NMM_NEST_UTILS1.o
+
+
+LIBTARGET    =  dyn_nmm
+TARGETDIR    =  ./
+$(LIBTARGET) :  $(MODULES) $(OBJS)
+		$(AR) ../main/libwrflib.a $(MODULES) $(OBJS)
+
+include ../configure.wrf
+
+clean:
+	@ echo 'use the clean script'
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+solve_nmm.o:   module_BC_NMM.o \
+               module_IGWAVE_ADJUST.o module_ADVECTION.o  \
+               module_NONHY_DYNAM.o module_DIFFUSION_NMM.o    \
+               module_BNDRY_COND.o module_PHYSICS_CALLS.o \
+               module_CTLBLK.o
+
+module_ADVECTION.o: ../share/module_MPP.o module_INDX.o
+
+module_MPPINIT.o: ../share/module_MPP.o 
+
+module_DIFFUSION_NMM.o: ../share/module_MPP.o module_INDX.o
+
+module_IGWAVE_ADJUST.o: ../share/module_MPP.o module_INDX.o module_ZEROX.o module_TIMERS.o
+
+module_PHYSICS_CALLS.o: \
+		../frame/module_domain.o		\
+		../frame/module_dm.o		\
+		../frame/module_configure.o		\
+		../frame/module_tiles.o		\
+		../frame/module_state_description.o		\
+		../share/module_model_constants.o		\
+		../phys/module_ra_gfdleta.o  \
+		../phys/module_radiation_driver.o  \
+		../phys/module_sf_myjsfc.o  \
+		../phys/module_surface_driver.o  \
+		../phys/module_pbl_driver.o  \
+		../phys/module_cu_bmj.o  \
+		../phys/module_cumulus_driver.o  \
+		../phys/module_mp_etanew.o  \
+		../phys/module_microphysics_driver.o
+
+module_initialize_real.o: ../share/module_model_constants.o
+
+# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/NMM_NEST_UTILS1.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/NMM_NEST_UTILS1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/NMM_NEST_UTILS1.F	(revision 2744)
@@ -0,0 +1,3003 @@
+#if (NMM_NEST == 1)
+!===========================================================================
+!
+! E-GRID NESTING UTILITIES: This is gopal's doing
+!
+!===========================================================================
+
+SUBROUTINE med_nest_egrid_configure ( parent , nest )
+ USE module_domain
+ USE module_configure
+ USE module_timing
+
+ IMPLICIT NONE
+ TYPE(domain) , POINTER             :: parent , nest
+ REAL, PARAMETER                    :: ERAD=6371200.
+ REAL, PARAMETER                    :: DTR=0.01745329
+ REAL, PARAMETER                    :: DTAD=1.0
+ REAL, PARAMETER                    :: CP=1004.6
+ INTEGER                            :: IDS,IDE,JDS,JDE,KDS,KDE
+ INTEGER                            :: IMS,IME,JMS,JME,KMS,KME
+ INTEGER                            :: ITS,ITE,JTS,JTE,KTS,KTE
+
+!----------------------------------------------------------------------------
+!  PURPOSE: 
+!         - Initialize nested domain configurations including setting up 
+!           wbd,sbd and some other variables and 1D arrays. 
+!         - Note that in order to obtain coincident grid points, which  
+!           is a basic requirement for RSL, WRF infrastructure, we use 
+!           western and southern boundaries of nested domain (nest%wbd0
+!           and nest%sbd0 derived from the parent domain. In this case
+!           the nested domain may be considered as a part of the parent 
+!           domain with a higher resolution (telescoping ?). 
+!         - Also note that in this case, the central lat/lons for nested 
+!           domain should coincide with the central lat/lons of the parent,
+!           although the nested domain NEED NOT be located at the center of
+!           the domain.
+!----------------------------------------------------------------------------
+!
+!   BASIC TEST FOR PARENT DOMAIN: CHECK IF JMAX IS ODD. SINCE JDE IN THE NAMELIST
+!   IS JMAX + 1, WE NEED TO CHECK IF JDE IS EVEN IN WRF CONTEXT
+
+    IF(MOD(parent%ed33,2) .NE. 0)THEN
+     CALL wrf_error_fatal("PARENT DOMAIN: JMAX IS EVEN, INCREASE e_sn IN THE namelist.input BY 1")
+    ENDIF
+
+!   BASIC TEST FOR NESTED DOMAIN: CHECK IF JMAX IS ODD. SINCE JDE IN THE NAMELIST
+!   IS JMAX + 1, WE NEED TO CHECK IF JDE IS EVEN IN WRF CONTEXT
+
+    IF(MOD(nest%ed33,2) .NE. 0)THEN
+     CALL wrf_error_fatal("NESTED DOMAIN: JMAX IS EVEN, INCREASE e_sn IN THE namelist.input BY 1")
+    ENDIF
+
+!   Parent grid configuration, including, western and southern boundary
+
+    IDS = parent%sd31
+    IDE = parent%ed31
+    KDS = parent%sd32
+    KDE = parent%ed32
+    JDS = parent%sd33
+    JDE = parent%ed33
+
+    IMS = parent%sm31
+    IME = parent%em31
+    KMS = parent%sm32
+    KME = parent%em32
+    JMS = parent%sm33
+    JME = parent%em33
+
+    ITS = parent%sp31
+    ITE = parent%ep31
+    KTS = parent%sp32
+    KTE = parent%ep32
+    JTS = parent%sp33
+    JTE = parent%ep33
+
+!   grid configuration
+
+    ! calculate wbd0 and sbd0 only for MOAD i.e. grid with parent_id == 0
+    if (parent%parent_id == 0 ) then        ! Dusan's doing
+       parent%wbd0 = -(IDE-2)*parent%dx     ! WBD0: in degrees;factor 2 takes care of dummy last column
+       parent%sbd0 = -((JDE-1)/2)*parent%dy ! SBD0: in degrees; note that JDE-1 should be odd  
+    end if
+    nest%wbd0   = parent%wbd0 + (nest%i_parent_start-1)*2.*parent%dx + mod(nest%j_parent_start+1,2)*parent%dx
+    nest%sbd0   = parent%sbd0 + (nest%j_parent_start-1)*parent%dy
+    nest%dx     = parent%dx/nest%parent_grid_ratio
+    nest%dy     = parent%dy/nest%parent_grid_ratio
+
+    write(0,*)" - i_parent_start = ",nest%i_parent_start
+    write(0,*)" - j_parent_start = ",nest%j_parent_start
+    write(0,*)" - parent%wbd0    = ",parent%wbd0
+    write(0,*)" - parent%sbd0    = ",parent%sbd0
+    write(0,*)" - nest%wbd0      = ",nest%wbd0
+    write(0,*)" - nest%sbd0      = ",nest%sbd0
+    write(0,*)" - nest%dx        = ",nest%dx
+    write(0,*)" - nest%dy        = ",nest%dy
+!
+    CALL nl_set_dx (nest%id , nest%dx)   ! for output purpose
+    CALL nl_set_dy (nest%id , nest%dy)   ! for output purpose
+
+!   set lat-lons; parent set to nested domain
+
+    CALL nl_get_cen_lat (parent%id, parent%cen_lat) ! cen_lat of parent set to nested domain
+    CALL nl_get_cen_lon (parent%id, parent%cen_lon) ! cen_lon of parent set to nested domain
+    nest%cen_lat=parent%cen_lat
+    nest%cen_lon=parent%cen_lon
+!
+    CALL nl_set_cen_lat ( nest%id , nest%cen_lat)  ! for output purpose
+    CALL nl_set_cen_lon ( nest%id , nest%cen_lon)  ! for output purpose
+
+    write(0,*)" - nest%cen_lat   = ",nest%cen_lat
+    write(0,*)" - nest%cen_lon   = ",nest%cen_lon
+
+
+!   soil configuration
+
+    nest%nmm_sldpth  = parent%nmm_sldpth
+    nest%nmm_dzsoil  = parent%nmm_dzsoil
+    nest%nmm_rtdpth  = parent%nmm_rtdpth
+
+!   numerical set up
+
+    nest%nmm_deta        = parent%nmm_deta
+    nest%nmm_aeta        = parent%nmm_aeta
+    nest%nmm_etax        = parent%nmm_etax
+    nest%nmm_dfl         = parent%nmm_dfl
+    nest%nmm_deta1       = parent%nmm_deta1
+    nest%nmm_aeta1       = parent%nmm_aeta1
+    nest%nmm_eta1        = parent%nmm_eta1
+    nest%nmm_deta2       = parent%nmm_deta2
+    nest%nmm_aeta2       = parent%nmm_aeta2
+    nest%nmm_eta2        = parent%nmm_eta2
+    nest%nmm_pdtop       = parent%nmm_pdtop
+    nest%nmm_pt          = parent%nmm_pt
+    nest%nmm_dfrlg       = parent%nmm_dfrlg
+    nest%num_soil_layers = parent%num_soil_layers
+    nest%num_moves       = parent%num_moves
+
+! Unfortunately, some of the single value constants in used in module_initialize have 
+! to be defiend here instead of the usual spot in med_initialize_nest_nmm. There
+! appears to be a problem in Registry and related code in this area.
+!
+! state  logical upstrm   -      dyn_nmm     -      -      -
+
+
+    nest%nmm_dlmd   = nest%dx
+    nest%nmm_dphd   = nest%dy
+    nest%nmm_dy_nmm = erad*(nest%nmm_dphd*dtr)
+    nest%nmm_cpgfv  = -nest%dt/(48.*nest%nmm_dy_nmm)
+    nest%nmm_en     = nest%dt/( 4.*nest%nmm_dy_nmm)*dtad
+    nest%nmm_ent    = nest%dt/(16.*nest%nmm_dy_nmm)*dtad
+    nest%nmm_f4d    = -.5*nest%dt*dtad
+    nest%nmm_f4q    = -nest%dt*dtad
+    nest%nmm_ef4t   = .5*nest%dt/cp
+
+!  Other output configurations that will make grads happy 
+
+   CALL nl_get_truelat1 (parent%id, parent%truelat1 )
+   CALL nl_get_truelat2 (parent%id, parent%truelat2 )
+   CALL nl_get_map_proj (parent%id, parent%map_proj )
+   CALL nl_get_iswater (parent%id, parent%iswater )
+
+   nest%truelat1=parent%truelat1
+   nest%truelat2=parent%truelat2
+   nest%map_proj=parent%map_proj
+   nest%iswater=parent%iswater
+
+   CALL nl_set_truelat1(nest%id, nest%truelat1)
+   CALL nl_set_truelat2(nest%id, nest%truelat2)
+   CALL nl_set_map_proj(nest%id, nest%map_proj)
+   CALL nl_set_iswater(nest%id, nest%iswater)
+
+!   physics and other configurations
+!   CALL nl_get_iswater (parent%id, nest%iswater) ! iswater is just based on parents
+!   CALL nl_get_bl_surface_physics (nest%id,  nest%bl_surface_physics )
+!   CALL nl_get_num_soil_layers( parent%num_soil_layers )
+!   CALL nl_get_real_data_init_type (parent%real_data_init_type)
+
+END SUBROUTINE med_nest_egrid_configure
+
+SUBROUTINE med_construct_egrid_weights ( parent , nest )
+ USE module_domain
+ USE module_configure
+ USE module_timing
+
+ IMPLICIT NONE
+ TYPE(domain) , POINTER             :: parent , nest
+ LOGICAL, EXTERNAL                  :: wrf_dm_on_monitor
+ INTEGER                            :: IDS,IDE,JDS,JDE,KDS,KDE
+ INTEGER                            :: IMS,IME,JMS,JME,KMS,KME
+ INTEGER                            :: ITS,ITE,JTS,JTE,KTS,KTE
+ INTEGER                            :: I,J,II,JJ,NII,NJJ
+ REAL                               :: parent_CLAT,parent_CLON,parent_WBD,parent_SBD,parent_DLMD,parent_DPHD
+ REAL                               :: nest_WBD,nest_SBD,nest_DLMD,nest_DPHD
+ REAL                               :: SW_LATD,SW_LOND
+ REAL                               :: ADDSUM1,ADDSUM2
+ REAL                               :: xr,zr,xc
+!-----------------------------------------------------------------------------------------------------------
+!   PURPOSE: 
+!           - Initialize lat-lons and determine weights 
+!
+!----------------------------------------------------------------------------------------------------------
+
+!   First obtain central latitude and longitude for the parent domain
+
+    CALL nl_get_cen_lat (parent%ID, parent_CLAT)
+    CALL nl_get_cen_lon (parent%ID, parent_CLON)
+
+!   Parent grid configuration, including, western and southern boundary
+
+    IDS = parent%sd31
+    IDE = parent%ed31
+    KDS = parent%sd32
+    KDE = parent%ed32
+    JDS = parent%sd33
+    JDE = parent%ed33
+
+    IMS = parent%sm31
+    IME = parent%em31
+    KMS = parent%sm32
+    KME = parent%em32
+    JMS = parent%sm33
+    JME = parent%em33
+
+    ITS  = parent%sp31
+    ITE  = parent%ep31
+    KTS  = parent%sp32
+    KTE  = parent%ep32
+    JTS  = parent%sp33
+    JTE  = parent%ep33
+!
+    parent_DLMD = parent%dx                ! DLMD: dlamda in degrees 
+    parent_DPHD = parent%dy                ! DPHD: dphi in degrees 
+    parent_WBD  = parent%wbd0
+    parent_SBD  = parent%sbd0
+
+!   Now compute Geodetic lat/lon (Positive East) of parent grid in degrees
+
+    CALL EARTH_LATLON ( parent%nmm_HLAT,parent%nmm_HLON,parent%nmm_VLAT,parent%nmm_VLON,  & !output
+                        parent_DLMD,parent_DPHD,parent_WBD,parent_SBD,                    & !inputs 
+                        parent_CLAT,parent_CLON,                                          &
+                        IDS,IDE,JDS,JDE,KDS,KDE,                                          &
+                        IMS,IME,JMS,JME,KMS,KME,                                          &
+                        ITS,ITE,JTS,JTE,KTS,KTE                                           )
+
+!   Nested grid configuration, including, western and southern boundary
+
+    IDS = nest%sd31
+    IDE = nest%ed31
+    KDS = nest%sd32
+    KDE = nest%ed32
+    JDS = nest%sd33
+    JDE = nest%ed33
+
+    IMS = nest%sm31
+    IME = nest%em31
+    KMS = nest%sm32
+    KME = nest%em32
+    JMS = nest%sm33
+    JME = nest%em33
+
+    ITS  = nest%sp31
+    ITE  = nest%ep31
+    KTS  = nest%sp32
+    KTE  = nest%ep32
+    JTS  = nest%sp33
+    JTE  = nest%ep33
+!
+    nest_DLMD = nest%dx
+    nest_DPHD = nest%dy
+    nest_WBD  = nest%wbd0
+    nest_SBD  = nest%sbd0
+
+!
+!   Now compute Geodetic lat/lon (Positive East) of nest in degrees, with the same central lat-lon
+!   as the parent grid
+!
+
+    CALL EARTH_LATLON ( nest%nmm_HLAT,nest%nmm_HLON,nest%nmm_VLAT,nest%nmm_VLON, & ! output
+                        nest_DLMD,nest_DPHD,nest_WBD,nest_SBD,                   & ! nest inputs
+                        parent_CLAT,parent_CLON,                                 & ! parent central lat/lon
+                        IDS,IDE,JDS,JDE,KDS,KDE,                                 & ! nested domain dimension
+                        IMS,IME,JMS,JME,KMS,KME,                                 &
+                        ITS,ITE,JTS,JTE,KTS,KTE                                  )
+
+!   Determine the weights of nested grid h points nearest to H points of parent domain 
+
+    CALL G2T2H( nest%nmm_IIH,nest%nmm_JJH,                       & ! output grid index on nested grid
+                nest%nmm_HBWGT1,nest%nmm_HBWGT2,                 & ! output weights on the nested grid 
+                nest%nmm_HBWGT3,nest%nmm_HBWGT4,                 &
+                nest%nmm_HLAT,nest%nmm_HLON,                     & ! target (nest) input lat lon in degrees
+                parent_DLMD,parent_DPHD,parent_WBD,parent_SBD,   & ! parent res, western and south boundaries
+                parent_CLAT,parent_CLON,                         & ! parent central lat,lon, all in degrees
+                parent%ed31,parent%ed33,                         & ! parent imax and jmax
+                IDS,IDE,JDS,JDE,KDS,KDE,                         & ! 
+                IMS,IME,JMS,JME,KMS,KME,                         & ! nested grid configuration
+                ITS,ITE,JTS,JTE,KTS,KTE                          ) !
+
+
+!   Determine the weights of nested grid v points nearest to V points of parent domain
+
+    CALL G2T2V( nest%nmm_IIV,nest%nmm_JJV,                       & ! output grid index on nested grid
+                nest%nmm_VBWGT1,nest%nmm_VBWGT2,                 & ! output weights on the nested grid
+                nest%nmm_VBWGT3,nest%nmm_VBWGT4,                 &
+                nest%nmm_VLAT,nest%nmm_VLON,                     & ! target (nest) input lat lon in degrees
+                parent_DLMD,parent_DPHD,parent_WBD,parent_SBD,   & ! parent res, western and south boundaries
+                parent_CLAT,parent_CLON,                         & ! parent central lat,lon, all in degrees
+                parent%ed31,parent%ed33,                         & ! parent imax and jmax
+                IDS,IDE,JDS,JDE,KDS,KDE,                         & !
+                IMS,IME,JMS,JME,KMS,KME,                         & ! nested grid configuration
+                ITS,ITE,JTS,JTE,KTS,KTE                          ) !
+
+!*** CHECK WEIGHTS AT MASS AND VELOCITY POINTS
+
+     CALL WEIGTS_CHECK(nest%nmm_HBWGT1,nest%nmm_HBWGT2,          & ! output weights on the nested grid
+                       nest%nmm_HBWGT3,nest%nmm_HBWGT4,          &
+                       nest%nmm_VBWGT1,nest%nmm_VBWGT2,          & ! output weights on the nested grid
+                       nest%nmm_VBWGT3,nest%nmm_VBWGT4,          &
+                       IDS,IDE,JDS,JDE,KDS,KDE,                  & !
+                       IMS,IME,JMS,JME,KMS,KME,                  & ! nested grid configuration
+                       ITS,ITE,JTS,JTE,KTS,KTE                   )
+
+!*** CHECK DOMAIN BOUNDS BEFORE PROCEEDING TO INTERPOLATION
+!
+    CALL BOUNDS_CHECK( nest%nmm_IIH,nest%nmm_JJH,nest%nmm_IIV,nest%nmm_JJV,   &
+                       nest%i_parent_start,nest%j_parent_start,nest%shw,      &
+                       IDS,IDE,JDS,JDE,KDS,KDE,                               & !
+                       IMS,IME,JMS,JME,KMS,KME,                               & ! nested grid configuration
+                       ITS,ITE,JTS,JTE,KTS,KTE                                )
+
+!------------------------------------------------------------------------------------------
+
+END SUBROUTINE med_construct_egrid_weights 
+
+!======================================================================================
+!
+! compute earth lat-lons for parent and the nest before interpolations
+!------------------------------------------------------------------------------
+
+SUBROUTINE EARTH_LATLON ( HLAT,HLON,VLAT,VLON,     & !Earth lat,lon at H and V points
+                          DLMD1,DPHD1,WBD1,SBD1,   & !input res,west & south boundaries,
+                          CENTRAL_LAT,CENTRAL_LON, & ! central lat,lon, all in degrees   
+                          IDS,IDE,JDS,JDE,KDS,KDE, &  
+                          IMS,IME,JMS,JME,KMS,KME, &
+                          ITS,ITE,JTS,JTE,KTS,KTE  )
+!============================================================================
+!
+ IMPLICIT NONE
+ INTEGER,    INTENT(IN   )                            :: IDS,IDE,JDS,JDE,KDS,KDE
+ INTEGER,    INTENT(IN   )                            :: IMS,IME,JMS,JME,KMS,KME 
+ INTEGER,    INTENT(IN   )                            :: ITS,ITE,JTS,JTE,KTS,KTE  
+ REAL,       INTENT(IN   )                            :: DLMD1,DPHD1,WBD1,SBD1
+ REAL,       INTENT(IN   )                            :: CENTRAL_LAT,CENTRAL_LON
+ REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(OUT)        :: HLAT,HLON,VLAT,VLON
+
+! local
+
+ INTEGER,PARAMETER                           :: KNUM=SELECTED_REAL_KIND(13) 
+ INTEGER                                     :: I,J
+ REAL(KIND=KNUM)                             :: WB,SB,DLM,DPH,TPH0,STPH0,CTPH0
+ REAL(KIND=KNUM)                             :: TDLM,TDPH,TLMH,TLMV,TLMH0,TLMV0,TPHH,TPHV,DTR
+ REAL(KIND=KNUM)                             :: STPH,CTPH,STPV,CTPV,PI_2
+ REAL(KIND=KNUM)                             :: SPHH,CLMH,FACTH,SPHV,CLMV,FACTV
+ REAL(KIND=KNUM), DIMENSION(IMS:IME,JMS:JME) :: GLATH,GLONH,GLATV,GLONV
+!-------------------------------------------------------------------------
+
+!
+      PI_2 = ACOS(0.)
+      DTR  = PI_2/90.
+      WB   = WBD1 * DTR                 ! WB:   western boundary in radians
+      SB   = SBD1 * DTR                 ! SB:   southern boundary in radians
+      DLM  = DLMD1 * DTR                ! DLM:  dlamda in radians 
+      DPH  = DPHD1 * DTR                ! DPH:  dphi   in radians
+      TDLM = DLM + DLM                  ! TDLM: 2.0*dlamda 
+      TDPH = DPH + DPH                  ! TDPH: 2.0*DPH 
+
+!     For earth lat lon only
+
+      TPH0  = CENTRAL_LAT*DTR                ! TPH0: central lat in radians 
+      STPH0 = SIN(TPH0)
+      CTPH0 = COS(TPH0)
+
+!      WRITE(0,*) 'WB,SB,DLM,DPH,DTR: ',WBD1,SBD1,DLM,DPH,DTR    
+!      WRITE(0,*) 'IMS,IME,JMS,JME,KMS,KME',IMS,IME,JMS,JME,KMS,KME 
+!      WRITE(0,*) 'IDS,IDE,JDS,JDE,KDS,KDE',IDS,IDE,JDS,JDE,KDS,KDE
+!      WRITE(0,*) 'ITS,ITE,JTS,JTE,KTS,KTE',ITS,ITE,JTS,JTE,KTS,KTE 
+
+                                                !    .H
+      DO J = JTS,MIN(JTE,JDE-1)                 ! H./    This loop takes care of zig-zag 
+!                                               !   \.H  starting points along j  
+         TLMH0 = WB - TDLM + MOD(J+1,2) * DLM   !  ./    TLMH (rotated lats at H points)
+         TLMV0 = WB - TDLM + MOD(J,2) * DLM     !  H     (//ly for V points) 
+         TPHH = SB + (J-1)*DPH                  !   TPHH (rotated lons at H points) are simple trans.
+         TPHV = TPHH                            !   TPHV (rotated lons at V points) are simple trans.
+         STPH = SIN(TPHH)
+         CTPH = COS(TPHH)
+         STPV = SIN(TPHV)
+         CTPV = COS(TPHV)
+
+                                                              !   .H
+         DO I = ITS,MIN(ITE,IDE-1)                            !  / 
+           TLMH = TLMH0 + I*TDLM                              !  \.H   .U   .H 
+!                                                             !H./ ----><----
+           SPHH = CTPH0 * STPH + STPH0 * CTPH * COS(TLMH)     !     DLM + DLM
+           GLATH(I,J)=ASIN(SPHH)                              ! GLATH: Earth Lat in radians 
+           CLMH = CTPH*COS(TLMH)/(COS(GLATH(I,J))*CTPH0) &
+                - TAN(GLATH(I,J))*TAN(TPH0)
+           IF(CLMH .GT. 1.) CLMH = 1.0
+           IF(CLMH .LT. -1.) CLMH = -1.0
+           FACTH = 1.
+           IF(TLMH .GT. 0.) FACTH = -1.
+           GLONH(I,J) = -CENTRAL_LON*DTR + FACTH*ACOS(CLMH)
+
+         ENDDO                                    
+
+         DO I = ITS,MIN(ITE,IDE-1)
+           TLMV = TLMV0 + I*TDLM
+           SPHV = CTPH0 * STPV + STPH0 * CTPV * COS(TLMV)
+           GLATV(I,J) = ASIN(SPHV)
+           CLMV = CTPV*COS(TLMV)/(COS(GLATV(I,J))*CTPH0) &
+                - TAN(GLATV(I,J))*TAN(TPH0)
+           IF(CLMV .GT. 1.) CLMV = 1.
+           IF(CLMV .LT. -1.) CLMV = -1.
+           FACTV = 1.
+           IF(TLMV .GT. 0.) FACTV = -1.
+           GLONV(I,J) = -CENTRAL_LON*DTR + FACTV*ACOS(CLMV)
+
+         ENDDO
+
+      ENDDO
+
+!     Conversion to degrees (may not be required, eventually)
+
+      DO J = JTS, MIN(JTE,JDE-1)
+       DO I = ITS, MIN(ITE,IDE-1)
+          HLAT(I,J) = GLATH(I,J) / DTR
+          HLON(I,J)= -GLONH(I,J)/DTR
+          IF(HLON(I,J) .GT. 180.) HLON(I,J) = HLON(I,J)  - 360.
+          IF(HLON(I,J) .LT. -180.) HLON(I,J) = HLON(I,J) + 360.
+!
+          VLAT(I,J) = GLATV(I,J) / DTR
+          VLON(I,J) = -GLONV(I,J) / DTR
+          IF(VLON(I,J) .GT. 180.) VLON(I,J) = VLON(I,J)  - 360.
+          IF(VLON(I,J) .LT. -180.) VLON(I,J) = VLON(I,J) + 360.
+
+       ENDDO
+      ENDDO
+
+END SUBROUTINE EARTH_LATLON
+
+!-----------------------------------------------------------------------------  
+
+  SUBROUTINE G2T2H( IIH,JJH,                     & ! output grid index and weights 
+                    HBWGT1,HBWGT2,               & ! output weights in terms of parent grid
+                    HBWGT3,HBWGT4,               & 
+                    HLAT,HLON,                   & ! target (nest) input lat lon in degrees
+                    DLMD1,DPHD1,WBD1,SBD1,       & ! parent res, west and south boundaries
+                    CENTRAL_LAT,CENTRAL_LON,     & ! parent central lat,lon, all in degrees
+                    P_IDE,P_JDE,                 & ! parent imax and jmax
+                    IDS,IDE,JDS,JDE,KDS,KDE,     & ! target (nest) dIMEnsions
+                    IMS,IME,JMS,JME,KMS,KME,     &
+                    ITS,ITE,JTS,JTE,KTS,KTE      )
+
+! 
+!***  Tom Black   - Initial Version
+!***  Gopal       - Revised Version for WRF (includes coincident grid points) 
+!*** 
+!***  GIVEN PARENT CENTRAL LAT-LONS, RESOLUTION AND WESTERN AND SOUTHERN BOUNDARY,
+!***  AND THE NESTED GRID LAT-LONS AT H POINTS, THIS ROUTINE FIRST LOCATES THE 
+!***  INDICES,IIH,JJH, OF THE PARENT DOMAIN'S H POINTS THAT LIES CLOSEST TO THE
+!***  h POINTS OF THE NESTED DOMAIN   
+!
+!============================================================================
+!
+ IMPLICIT NONE
+ INTEGER,    INTENT(IN   )                            :: IDS,IDE,JDS,JDE,KDS,KDE
+ INTEGER,    INTENT(IN   )                            :: IMS,IME,JMS,JME,KMS,KME
+ INTEGER,    INTENT(IN   )                            :: ITS,ITE,JTS,JTE,KTS,KTE
+ INTEGER,    INTENT(IN   )                            :: P_IDE,P_JDE
+ REAL,       INTENT(IN   )                            :: DLMD1,DPHD1,WBD1,SBD1
+ REAL,       INTENT(IN   )                            :: CENTRAL_LAT,CENTRAL_LON
+ REAL,    DIMENSION(IMS:IME,JMS:JME),    INTENT(IN)   :: HLAT,HLON
+ REAL,    DIMENSION(IMS:IME,JMS:JME),    INTENT(OUT)  :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+ INTEGER, DIMENSION(IMS:IME,JMS:JME),    INTENT(OUT)  :: IIH,JJH
+
+! local
+
+ INTEGER,PARAMETER :: KNUM=SELECTED_REAL_KIND(13)
+ INTEGER           :: IMT,JMT,N2R,MK,K,I,J,DSLP0,DSLOPE
+ INTEGER           :: NROW,NCOL,KROWS
+ REAL(KIND=KNUM)   :: X,Y,Z,TLAT,TLON
+ REAL(KIND=KNUM)   :: PI_2,D2R,R2D,GLAT,GLON,DPH,DLM,TPH0,TLM0,WB,SB                
+ REAL(KIND=KNUM)   :: ROW,COL,SLP0,TLATHC,TLONHC,DENOM,SLOPE
+ REAL(KIND=KNUM)   :: TLAT1,TLAT2,TLON1,TLON2,DLM1,DLM2,DLM3,DLM4,D1,D2
+ REAL(KIND=KNUM)   :: DLA1,DLA2,DLA3,DLA4,S1,R1,DS1,AN1,AN2,AN3                    ! Q
+ REAL(KIND=KNUM)   :: DL1,DL2,DL3,DL4,DL1I,DL2I,DL3I,DL4I,SUMDL,TLONO,TLATO 
+ REAL(KIND=KNUM)   :: DTEMP
+ REAL   , DIMENSION(IMS:IME,JMS:JME)    :: TLATHX,TLONHX
+ INTEGER, DIMENSION(IMS:IME,JMS:JME)    :: KOUTB
+!------------------------------------------------------------------------------- 
+
+  IMT=2*P_IDE-2             ! parent i dIMEnsions 
+  JMT=P_JDE/2               ! parent j dIMEnsions 
+  PI_2=ACOS(0.)
+  D2R=PI_2/90.
+  R2D=1./D2R
+  DPH=DPHD1*D2R
+  DLM=DLMD1*D2R
+  TPH0= CENTRAL_LAT*D2R
+  TLM0=-CENTRAL_LON*D2R        ! NOTE THE MINUS HERE
+  WB=WBD1*D2R                   ! CONVERT NESTED GRID H POINTS FROM GEODETIC
+  SB=SBD1*D2R
+  SLP0=DPHD1/DLMD1
+  DSLP0=NINT(R2D*ATAN(SLP0))
+  DS1=SQRT(DPH*DPH+DLM*DLM)    ! Q
+  AN1=ASIN(DLM/DS1)
+  AN2=ASIN(DPH/DS1)
+
+  DO J =  JTS,MIN(JTE,JDE-1) 
+    DO I = ITS,MIN(ITE,IDE-1) 
+
+!***
+!***  LOCATE TARGET h POINTS (HLAT AND HLON) ON THE PARENT DOMAIN AND
+!***  DETERMINE THE INDICES IN TERMS OF THE PARENT DOMAIN. FIRST 
+!***  CONVERT NESTED GRID h POINTS FROM GEODETIC TO TRANSFORMED 
+!***  COORDINATE ON THE PARENT GRID
+!
+
+      GLAT=HLAT(I,J)*D2R
+      GLON= (360. - HLON(I,J))*D2R
+      X=COS(TPH0)*COS(GLAT)*COS(GLON-TLM0)+SIN(TPH0)*SIN(GLAT)
+      Y=-COS(GLAT)*SIN(GLON-TLM0)
+      Z=COS(TPH0)*SIN(GLAT)-SIN(TPH0)*COS(GLAT)*COS(GLON-TLM0)
+      TLAT=R2D*ATAN(Z/SQRT(X*X+Y*Y))
+      TLON=R2D*ATAN(Y/X)
+
+!      ROW=TLAT/DPHD1+JMT         ! JMT IS THE CENTRAL ROW OF THE PARENT DOMAIN
+!      COL=TLON/DLMD1+P_IDE-1     ! (P_IDE-1) IS THE CENTRAL COLUMN OF THE PARENT DOMAIN 
+
+      ROW=(TLAT-SBD1)/DPHD1+1     ! Dusan's doing
+      COL=(TLON-WBD1)/DLMD1+1     ! Dusan's doing
+
+      NROW=INT(ROW + 0.001)     ! ROUND-OFF IS AVOIDED WITHOUT USING NINT ON PURPOSE
+      NCOL=INT(COL + 0.001)     
+      TLAT=TLAT*D2R
+      TLON=TLON*D2R
+
+!***  
+!***
+!***  FIRST CONSIDER THE SITUATION WHERE THE POINT h IS AT
+!***
+!***              V      H
+!***
+!***
+!***                 h           
+!***              H      V
+!***
+!***  THEN LOCATE THE NEAREST H POINT ON THE PARENT GRID
+!***
+      IF(MOD(NROW,2).EQ.1.AND.MOD(NCOL,2).EQ.1.OR.     &     
+         MOD(NROW,2).EQ.0.AND.MOD(NCOL,2).EQ.0)THEN        
+           TLAT1=(NROW-JMT)*DPH                           
+           TLAT2=TLAT1+DPH                              
+           TLON1=(NCOL-(P_IDE-1))*DLM                                   
+           TLON2=TLON1+DLM                                 
+           DLM1=TLON-TLON1                                 
+           DLM2=TLON-TLON2
+!           D1=ACOS(COS(TLAT)*COS(TLAT1)*COS(DLM1)+SIN(TLAT)*SIN(TLAT1))
+!           D2=ACOS(COS(TLAT)*COS(TLAT2)*COS(DLM2)+SIN(TLAT)*SIN(TLAT2))
+           DTEMP=MIN(1.0_KNUM,COS(TLAT)*COS(TLAT1)*COS(DLM1)+SIN(TLAT)*SIN(TLAT1))
+           D1=ACOS(DTEMP)
+           DTEMP=MIN(1.0_KNUM,COS(TLAT)*COS(TLAT2)*COS(DLM2)+SIN(TLAT)*SIN(TLAT2))
+           D2=ACOS(DTEMP)
+            IF(D1.GT.D2)THEN
+             NROW=NROW+1                    ! FIND THE NEAREST H ROW
+             NCOL=NCOL+1                    ! FIND THE NEAREST H COLUMN
+            ENDIF 
+!            WRITE(60,*)'NEAREST PARENT IS:','col=',COL,'row=',ROW,'ncol=',NCOL,'nrow=',NROW
+      ELSE
+!***
+!***  NOW CONSIDER THE SITUATION WHERE THE POINT h IS AT
+!***
+!***              H      V
+!***
+!***
+!***                 h 
+!***              V      H
+!***
+!***  THEN LOCATE THE NEAREST H POINT ON THE PARENT GRID
+!***
+!***
+           TLAT1=(NROW+1-JMT)*DPH
+           TLAT2=TLAT1-DPH
+           TLON1=(NCOL-(P_IDE-1))*DLM
+           TLON2=TLON1+DLM
+           DLM1=TLON-TLON1
+           DLM2=TLON-TLON2
+!           D1=ACOS(COS(TLAT)*COS(TLAT1)*COS(DLM1)+SIN(TLAT)*SIN(TLAT1))
+!           D2=ACOS(COS(TLAT)*COS(TLAT2)*COS(DLM2)+SIN(TLAT)*SIN(TLAT2))
+           DTEMP=MIN(1.0_KNUM,COS(TLAT)*COS(TLAT1)*COS(DLM1)+SIN(TLAT)*SIN(TLAT1))
+           D1=ACOS(DTEMP)
+           DTEMP=MIN(1.0_KNUM,COS(TLAT)*COS(TLAT2)*COS(DLM2)+SIN(TLAT)*SIN(TLAT2))
+           D2=ACOS(DTEMP)
+             IF(D1.LT.D2)THEN
+              NROW=NROW+1                    ! FIND THE NEAREST H ROW
+             ELSE
+              NCOL=NCOL+1                    ! FIND THE NEAREST H COLUMN
+             ENDIF
+!             WRITE(60,*)'NEAREST PARENT IS:','col=',COL,'row=',ROW,'ncol=',NCOL,'nrow=',NROW
+      ENDIF
+
+      KROWS=((NROW-1)/2)*IMT
+      IF(MOD(NROW,2).EQ.1)THEN
+        K=KROWS+(NCOL+1)/2
+      ELSE
+        K=KROWS+P_IDE-1+NCOL/2
+      ENDIF
+
+!***
+!***  WE NOW KNOW THAT THE INNER GRID POINT IN QUESTION IS
+!***  NEAREST TO THE CENTER K AS SEEN BELOW.  WE MUST FIND
+!***  WHICH OF THE FOUR H-BOXES (OF WHICH THIS H POINT IS
+!***  A VERTEX) SURROUNDS THE INNER GRID h POINT IN QUESTION.
+!***
+!**
+!***                  H
+!***
+!***
+!***
+!***            H     V     H
+!***
+!***
+!***               h
+!***      H     V     H     V     H
+!***
+!***
+!***
+!***            H     V     H
+!***
+!***
+!***
+!***                  H
+!***
+!***
+!***  FIND THE SLOPE OF THE LINE CONNECTING h AND THE CENTER H.
+!***
+    N2R=K/IMT
+    MK=MOD(K,IMT)
+!
+    IF(MK.EQ.0)THEN
+      TLATHC=SB+(2*N2R-1)*DPH
+    ELSE
+      TLATHC=SB+(2*N2R+(MK-1)/(P_IDE-1))*DPH
+    ENDIF
+!
+    IF(MK.LE.(P_IDE-1))THEN
+      TLONHC=WB+2*(MK-1)*DLM
+    ELSE
+      TLONHC=WB+(2*(MK-(P_IDE-1))-1)*DLM
+    ENDIF
+  
+!
+!***  EXECUTE CAUTION IF YOU NEED TO CHANGE THESE CONDITIONS. SINCE WE ARE
+!***  DEALING WITH SLOPES TO GENERATE DIAMOND SHAPE H BOXES, WE NEED TO BE
+!***  CAREFUL HERE      
+!
+
+    IF(ABS(TLON-TLONHC) .LE. 1.E-4)TLONHC=TLON
+    IF(ABS(TLAT-TLATHC) .LE. 1.E-4)TLATHC=TLAT
+    DENOM=(TLON-TLONHC)
+!
+!***
+!***STORE THE LOCATION OF THE WESTERNMOST VERTEX OF THE H-BOX ON
+!***THE OUTER GRID THAT SURROUNDS THE h POINT ON THE INNER GRID.
+!***
+!*** COINCIDENT CONDITIONS
+
+    IF(DENOM.EQ.0.0)THEN
+
+      IF(TLATHC.EQ.TLAT)THEN
+        KOUTB(I,J)=K
+        IIH(I,J) = NCOL
+        JJH(I,J) = NROW
+        TLATHX(I,J)=TLATHC
+        TLONHX(I,J)=TLONHC
+        HBWGT1(I,J)=1.0
+        HBWGT2(I,J)=0.0
+        HBWGT3(I,J)=0.0
+        HBWGT4(I,J)=0.0
+!        WRITE(60,*)'TRIVIAL SOLUTION'
+      ELSE                                      ! SAME LONGITUDE BUT DIFFERENT LATS
+!
+         IF(TLATHC .GT. TLAT)THEN      ! NESTED POINT SOUTH OF PARENT
+          KOUTB(I,J)=K-(P_IDE-1)
+          IIH(I,J) = NCOL-1
+          JJH(I,J) = NROW-1
+          TLATHX(I,J)=TLATHC-DPH
+          TLONHX(I,J)=TLONHC-DLM
+!          WRITE(60,*)'VANISHING SLOPE, -ve: TLATHC-DPH, TLONHC-DLM'
+         ELSE                                   ! NESTED POINT NORTH OF PARENT
+          KOUTB(I,J)=K+(P_IDE-1)-1
+          IIH(I,J) = NCOL-1
+          JJH(I,J) = NROW+1
+          TLATHX(I,J)=TLATHC+DPH
+          TLONHX(I,J)=TLONHC-DLM
+!          WRITE(60,*)'VANISHING SLOPE, +ve: TLATHC+DPH, TLONHC-DLM' 
+         ENDIF
+!***
+!***
+!***                  4
+!***
+!***                  h
+!***             1         2
+!***
+!***                  3
+!***  DL 1-4 ARE THE ANGULAR DISTANCES FROM h TO EACH VERTEX
+
+       TLATO=TLATHX(I,J)
+       TLONO=TLONHX(I,J)
+       DLM1=TLON-TLONO
+       DLA1=TLAT-TLATO                                               ! Q
+!      DL1=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM1)+SIN(TLAT)*SIN(TLATO)) ! Q
+       DL1=SQRT(DLM1*DLM1+DLA1*DLA1)                                 ! Q 
+!
+       TLATO=TLATHX(I,J)
+       TLONO=TLONHX(I,J)+2.*DLM
+       DLM2=TLON-TLONO
+       DLA2=TLAT-TLATO                                               ! Q
+!      DL2=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM2)+SIN(TLAT)*SIN(TLATO)) ! Q
+       DL2=SQRT(DLM2*DLM2+DLA2*DLA2)                                 ! Q
+! 
+       TLATO=TLATHX(I,J)-DPH
+       TLONO=TLONHX(I,J)+DLM
+       DLM3=TLON-TLONO
+       DLA3=TLAT-TLATO                                               ! Q
+!      DL3=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM3)+SIN(TLAT)*SIN(TLATO)) ! Q
+       DL3=SQRT(DLM3*DLM3+DLA3*DLA3)                                 ! Q
+ 
+       TLATO=TLATHX(I,J)+DPH
+       TLONO=TLONHX(I,J)+DLM
+       DLM4=TLON-TLONO
+       DLA4=TLAT-TLATO                                               ! Q
+!      DL4=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM4)+SIN(TLAT)*SIN(TLATO)) ! Q
+       DL4=SQRT(DLM4*DLM4+DLA4*DLA4)                                 ! Q
+
+
+!      THE BILINEAR WEIGHTS
+!***
+!***
+       AN3=ATAN2(DLA1,DLM1)                                          ! Q
+       R1=DL1*SIN(AN2-AN3)/SIN(2.*AN1)
+       S1=DL1*SIN(2.*PI_2-2*AN1-AN2+AN3)/SIN(2.*AN1)
+       R1=R1/DS1
+       S1=S1/DS1
+       DL1I=(1.-R1)*(1.-S1)
+       DL2I=R1*S1
+       DL3I=R1*(1.-S1)
+       DL4I=(1.-R1)*S1
+!
+       HBWGT1(I,J)=DL1I
+       HBWGT2(I,J)=DL2I
+       HBWGT3(I,J)=DL3I
+       HBWGT4(I,J)=DL4I
+! 
+      ENDIF
+
+    ELSE
+!
+!*** NON-COINCIDENT POINTS   
+!
+      SLOPE=(TLAT-TLATHC)/DENOM
+      DSLOPE=NINT(R2D*ATAN(SLOPE))
+
+      IF(DSLOPE.LE.DSLP0.AND.DSLOPE.GE.-DSLP0)THEN
+        IF(TLON.GT.TLONHC)THEN
+          IF(TLONHC.GE.-WB-DLM)CALL wrf_error_fatal("1H:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K
+          IIH(I,J) = NCOL
+          JJH(I,J) = NROW
+          TLATHX(I,J)=TLATHC
+          TLONHX(I,J)=TLONHC
+!          WRITE(60,*)'HERE WE GO1: TLATHC, TLONHC'
+        ELSE
+          IF(TLONHC.LE.WB+DLM)CALL wrf_error_fatal("2H:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K-1
+          IIH(I,J) = NCOL-2
+          JJH(I,J) = NROW
+          TLATHX(I,J)=TLATHC
+          TLONHX(I,J)=TLONHC -2.*DLM
+!          WRITE(60,*)'HERE WE GO2: TLATHC, TLONHC -2.*DLM'
+        ENDIF
+
+!
+      ELSEIF(DSLOPE.GT.DSLP0)THEN
+        IF(TLON.GT.TLONHC)THEN
+          IF(TLATHC.GE.-SB-DPH)CALL wrf_error_fatal("3H:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K+(P_IDE-1)-1
+          IIH(I,J) = NCOL-1
+          JJH(I,J) = NROW+1
+          TLATHX(I,J)=TLATHC+DPH
+          TLONHX(I,J)=TLONHC-DLM
+!          WRITE(60,*)'HERE WE GO3:  TLATHC+DPH, TLONHC-DLM'
+        ELSE
+          IF(TLATHC.LE.SB+DPH)CALL wrf_error_fatal("4H:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K-(P_IDE-1)
+          IIH(I,J) = NCOL-1
+          JJH(I,J) = NROW-1
+          TLATHX(I,J)=TLATHC-DPH
+          TLONHX(I,J)=TLONHC-DLM
+!          WRITE(60,*)'HERE WE GO4:  TLATHC-DPH, TLONHC-DLM' 
+        ENDIF
+
+!
+      ELSEIF(DSLOPE.LT.-DSLP0)THEN
+        IF(TLON.GT.TLONHC)THEN
+          IF(TLATHC.LE.SB+DPH)CALL wrf_error_fatal("5H:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K-(P_IDE-1)
+          IIH(I,J) = NCOL-1
+          JJH(I,J) = NROW-1
+          TLATHX(I,J)=TLATHC-DPH
+          TLONHX(I,J)=TLONHC-DLM
+!          WRITE(60,*)'HERE WE GO5:  TLATHC-DPH, TLONHC-DLM'
+        ELSE
+          IF(TLATHC.GE.-SB-DPH)CALL wrf_error_fatal("6H:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K+(P_IDE-1)-1
+          IIH(I,J) = NCOL-1
+          JJH(I,J) = NROW+1
+          TLATHX(I,J)=TLATHC+DPH
+          TLONHX(I,J)=TLONHC-DLM
+!          WRITE(60,*)'HERE WE GO6: TLATHC+DPH,  TLONHC-DLM'
+        ENDIF
+      ENDIF
+
+!
+!***  NOW WE WILL MOVE AS FOLLOWS:
+!***
+!***
+!***                      4
+!***
+!***
+!***  
+!***                   h
+!***             1                 2
+!***
+!***
+!***
+!***
+!***                      3
+!***
+!***
+!***
+!***  DL 1-4 ARE THE ANGULAR DISTANCES FROM h TO EACH VERTEX
+      
+      TLATO=TLATHX(I,J)
+      TLONO=TLONHX(I,J)
+      DLM1=TLON-TLONO
+      DLA1=TLAT-TLATO                                               ! Q
+!     DL1=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM1)+SIN(TLAT)*SIN(TLATO)) ! Q
+      DL1=SQRT(DLM1*DLM1+DLA1*DLA1)                                 ! Q
+!
+      TLATO=TLATHX(I,J)                                             ! redundant computations
+      TLONO=TLONHX(I,J)+2.*DLM
+      DLM2=TLON-TLONO
+      DLA2=TLAT-TLATO                                               ! Q
+!     DL2=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM2)+SIN(TLAT)*SIN(TLATO)) ! Q
+      DL2=SQRT(DLM2*DLM2+DLA2*DLA2)                                 ! Q
+!
+      TLATO=TLATHX(I,J)-DPH
+      TLONO=TLONHX(I,J)+DLM
+      DLM3=TLON-TLONO
+      DLA3=TLAT-TLATO                                               ! Q
+!     DL3=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM3)+SIN(TLAT)*SIN(TLATO)) ! Q
+      DL3=SQRT(DLM3*DLM3+DLA3*DLA3)                                 ! Q
+!
+      TLATO=TLATHX(I,J)+DPH
+      TLONO=TLONHX(I,J)+DLM
+      DLM4=TLON-TLONO
+      DLA4=TLAT-TLATO                                               ! Q
+!     DL4=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM4)+SIN(TLAT)*SIN(TLATO)) ! Q
+      DL4=SQRT(DLM4*DLM4+DLA4*DLA4)                                 ! Q
+
+!     THE BILINEAR WEIGHTS
+!***
+      AN3=ATAN2(DLA1,DLM1)                                          ! Q
+      R1=DL1*SIN(AN2-AN3)/SIN(2.*AN1)
+      S1=DL1*SIN(2.*PI_2-2*AN1-AN2+AN3)/SIN(2.*AN1)
+      R1=R1/DS1
+      S1=S1/DS1
+      DL1I=(1.-R1)*(1.-S1)
+      DL2I=R1*S1
+      DL3I=R1*(1.-S1)
+      DL4I=(1.-R1)*S1
+!
+      HBWGT1(I,J)=DL1I
+      HBWGT2(I,J)=DL2I
+      HBWGT3(I,J)=DL3I
+      HBWGT4(I,J)=DL4I
+!
+    ENDIF 
+
+!
+!***  FINALLY STORE IIH IN TERMS OF E-GRID INDEX
+!
+      IIH(I,J)=NINT(0.5*IIH(I,J))
+
+      HBWGT1(I,J)=MAX(HBWGT1(I,J),0.0)   ! all weights must be GE zero (postive def)
+      HBWGT2(I,J)=MAX(HBWGT2(I,J),0.0)   ! all weights must be GE zero (postive def)
+      HBWGT3(I,J)=MAX(HBWGT3(I,J),0.0)   ! all weights must be GE zero (postive def)
+      HBWGT4(I,J)=MAX(HBWGT4(I,J),0.0)   ! all weights must be GE zero (postive def)
+
+!      write(0,105)"H WEIGHTS:",I,J,HBWGT1(I,J),HBWGT2(I,J),HBWGT3(I,J),HBWGT4(I,J), &
+!                               HBWGT1(I,J)+HBWGT2(I,J)+HBWGT3(I,J)+HBWGT4(I,J),IIH(i,j),JJH(i,j)
+! 105  format(a,2i4,5f7.3,2i4)
+
+   ENDDO
+  ENDDO
+
+
+  RETURN 
+  END SUBROUTINE G2T2H
+!========================================================================================
+
+
+  SUBROUTINE G2T2V( IIV,JJV,                     & ! output grid index and weights
+                    VBWGT1,VBWGT2,               & ! output weights in terms of parent grid
+                    VBWGT3,VBWGT4,               &
+                    VLAT,VLON,                   & ! target (nest) input lat lon in degrees
+                    DLMD1,DPHD1,WBD1,SBD1,       & ! parent res, west and south boundaries
+                    CENTRAL_LAT,CENTRAL_LON,     & ! parent central lat,lon, all in degrees
+                    P_IDE,P_JDE,                 & ! parent imax and jmax
+                    IDS,IDE,JDS,JDE,KDS,KDE,     & ! target (nest) dIMEnsions
+                    IMS,IME,JMS,JME,KMS,KME,     &
+                    ITS,ITE,JTS,JTE,KTS,KTE      )
+
+!
+!***  Tom Black   - Initial Version 
+!***  Gopal       - Revised Version for WRF (includes coincIDEnt grid points)
+!***
+!***  GIVEN PARENT CENTRAL LAT-LONS, RESOLUTION AND WESTERN AND SOUTHERN BOUNDARY,
+!***  AND THE NESTED GRID LAT-LONS AT v POINTS, THIS ROUTINE FIRST LOCATES THE
+!***  INDICES,IIV,JJV, OF THE PARENT DOMAIN'S v POINTS THAT LIES CLOSEST TO THE
+!***  v POINTS OF THE NESTED DOMAIN
+!
+!============================================================================
+
+ IMPLICIT NONE
+ INTEGER,    INTENT(IN   )                            :: IDS,IDE,JDS,JDE,KDS,KDE
+ INTEGER,    INTENT(IN   )                            :: IMS,IME,JMS,JME,KMS,KME
+ INTEGER,    INTENT(IN   )                            :: ITS,ITE,JTS,JTE,KTS,KTE
+ INTEGER,    INTENT(IN   )                            :: P_IDE,P_JDE
+ REAL,       INTENT(IN   )                            :: DLMD1,DPHD1,WBD1,SBD1
+ REAL,       INTENT(IN   )                            :: CENTRAL_LAT,CENTRAL_LON
+ REAL,    DIMENSION(IMS:IME,JMS:JME),   INTENT(IN)    :: VLAT,VLON
+ REAL,    DIMENSION(IMS:IME,JMS:JME),   INTENT(OUT)   :: VBWGT1,VBWGT2,VBWGT3,VBWGT4
+ INTEGER, DIMENSION(IMS:IME,JMS:JME),   INTENT(OUT)   :: IIV,JJV
+
+! local
+
+ INTEGER,PARAMETER :: KNUM=SELECTED_REAL_KIND(13)     ! (6) single precision
+ INTEGER           :: IMT,JMT,N2R,MK,K,I,J,DSLP0,DSLOPE
+ INTEGER           :: NROW,NCOL,KROWS
+ REAL(KIND=KNUM)   :: X,Y,Z,TLAT,TLON
+ REAL(KIND=KNUM)   :: PI_2,D2R,R2D,GLAT,GLON,DPH,DLM,TPH0,TLM0,WB,SB
+ REAL(KIND=KNUM)   :: ROW,COL,SLP0,TLATVC,TLONVC,DENOM,SLOPE
+ REAL(KIND=KNUM)   :: TLAT1,TLAT2,TLON1,TLON2,DLM1,DLM2,DLM3,DLM4,D1,D2
+ REAL(KIND=KNUM)   :: DLA1,DLA2,DLA3,DLA4,S1,R1,DS1,AN1,AN2,AN3                    ! Q
+ REAL(KIND=KNUM)   :: DL1,DL2,DL3,DL4,DL1I,DL2I,DL3I,DL4I,SUMDL,TLONO,TLATO
+ REAL(KIND=KNUM)   :: DTEMP
+ REAL  , DIMENSION(IMS:IME,JMS:JME)      :: TLATVX,TLONVX
+ INTEGER, DIMENSION(IMS:IME,JMS:JME)     :: KOUTB
+!-------------------------------------------------------------------------------------
+
+  IMT=2*P_IDE-2             ! parent i dIMEnsions
+  JMT=P_JDE/2               ! parent j dIMEnsions
+  PI_2=ACOS(0.)
+  D2R=PI_2/90.
+  R2D=1./D2R
+  DPH=DPHD1*D2R
+  DLM=DLMD1*D2R
+  TPH0= CENTRAL_LAT*D2R
+  TLM0=-CENTRAL_LON*D2R        ! NOTE THE MINUS HERE
+  WB=WBD1*D2R                   ! DEGREES TO RADIANS
+  SB=SBD1*D2R
+  SLP0=DPHD1/DLMD1
+  DSLP0=NINT(R2D*ATAN(SLP0))
+  DS1=SQRT(DPH*DPH+DLM*DLM)    ! Q
+  AN1=ASIN(DLM/DS1)
+  AN2=ASIN(DPH/DS1)
+
+  DO J =  JTS,MIN(JTE,JDE-1)
+    DO I = ITS,MIN(ITE,IDE-1)
+!***
+!***  LOCATE TARGET v POINTS (VLAT AND VLON) ON THE PARENT DOMAIN AND
+!***  DETERMINE THE INDICES IN TERMS OF THE PARENT DOMAIN. FIRST
+!***  CONVERT NESTED GRID v POINTS FROM GEODETIC TO TRANSFORMED
+!***  COORDINATE ON THE PARENT GRID
+!
+
+      GLAT=VLAT(I,J)*D2R
+      GLON=(360. - VLON(I,J))*D2R
+      X=COS(TPH0)*COS(GLAT)*COS(GLON-TLM0)+SIN(TPH0)*SIN(GLAT)
+      Y=-COS(GLAT)*SIN(GLON-TLM0)
+      Z=COS(TPH0)*SIN(GLAT)-SIN(TPH0)*COS(GLAT)*COS(GLON-TLM0)
+      TLAT=R2D*ATAN(Z/SQRT(X*X+Y*Y))
+      TLON=R2D*ATAN(Y/X)
+
+!      ROW=TLAT/DPHD1+JMT         ! JMT IS THE CENTRAL ROW OF THE PARENT DOMAIN
+!      COL=TLON/DLMD1+P_IDE-1     ! (P_IDE-1) IS THE CENTRAL COLUMN OF THE PARENT DOMAIN
+
+      ROW=(TLAT-SBD1)/DPHD1+1     ! Dusan's doing
+      COL=(TLON-WBD1)/DLMD1+1     ! Dusan's doing
+
+      NROW=INT(ROW + 0.001)     ! ROUND-OFF IS AVOIDED WITHOUT USING NINT ON PURPOSE
+      NCOL=INT(COL + 0.001)
+      TLAT=TLAT*D2R
+      TLON=TLON*D2R
+
+!***
+!***
+!***  FIRST CONSIDER THE SITUATION WHERE THE POINT v IS AT
+!***
+!***              H      V
+!***
+!***
+!***                 v
+!***              V      H
+!***
+!***  THEN LOCATE THE NEAREST V POINT ON THE PARENT GRID
+!***
+
+      IF(MOD(NROW,2).EQ.0.AND.MOD(NCOL,2).EQ.1.OR.     &
+         MOD(NROW,2).EQ.1.AND.MOD(NCOL,2).EQ.0)THEN
+           TLAT1=(NROW-JMT)*DPH
+           TLAT2=TLAT1+DPH
+           TLON1=(NCOL-(P_IDE-1))*DLM
+           TLON2=TLON1+DLM
+           DLM1=TLON-TLON1
+           DLM2=TLON-TLON2
+!           D1=ACOS(COS(TLAT)*COS(TLAT1)*COS(DLM1)+SIN(TLAT)*SIN(TLAT1))
+!           D2=ACOS(COS(TLAT)*COS(TLAT2)*COS(DLM2)+SIN(TLAT)*SIN(TLAT2))
+           DTEMP=MIN(1.0_KNUM,COS(TLAT)*COS(TLAT1)*COS(DLM1)+SIN(TLAT)*SIN(TLAT1))
+           D1=ACOS(DTEMP)
+           DTEMP=MIN(1.0_KNUM,COS(TLAT)*COS(TLAT2)*COS(DLM2)+SIN(TLAT)*SIN(TLAT2))
+           D2=ACOS(DTEMP)
+            IF(D1.GT.D2)THEN
+             NROW=NROW+1                    ! FIND THE NEAREST V ROW
+             NCOL=NCOL+1                    ! FIND THE NEAREST V COLUMN
+            ENDIF
+!            WRITE(61,*)'NEAREST PARENT IS:','col=',COL,'row=',ROW,'ncol=',NCOL,'nrow=',NROW
+      ELSE
+
+!***
+!***  NOW CONSIDER THE SITUATION WHERE THE POINT v IS AT
+!***
+!***              V      H
+!***
+!***
+!***                 v
+!***              H      V
+!***
+!*** THEN LOCATE THE NEAREST V POINT ON THE PARENT GRID
+!***
+           TLAT1=(NROW+1-JMT)*DPH
+           TLAT2=TLAT1-DPH
+           TLON1=(NCOL-(P_IDE-1))*DLM
+           TLON2=TLON1+DLM
+           DLM1=TLON-TLON1
+           DLM2=TLON-TLON2
+!           D1=ACOS(COS(TLAT)*COS(TLAT1)*COS(DLM1)+SIN(TLAT)*SIN(TLAT1))
+!           D2=ACOS(COS(TLAT)*COS(TLAT2)*COS(DLM2)+SIN(TLAT)*SIN(TLAT2))
+           DTEMP=MIN(1.0_KNUM,COS(TLAT)*COS(TLAT1)*COS(DLM1)+SIN(TLAT)*SIN(TLAT1))
+           D1=ACOS(DTEMP)
+           DTEMP=MIN(1.0_KNUM,COS(TLAT)*COS(TLAT2)*COS(DLM2)+SIN(TLAT)*SIN(TLAT2))
+           D2=ACOS(DTEMP)
+             IF(D1.LT.D2)THEN
+              NROW=NROW+1                    ! FIND THE NEAREST H ROW
+             ELSE
+              NCOL=NCOL+1                    ! FIND THE NEAREST H COLUMN
+             ENDIF
+!             WRITE(61,*)'NEAREST PARENT IS:','col=',COL,'row=',ROW,'ncol=',NCOL,'nrow=',NROW
+
+      ENDIF
+
+      KROWS=((NROW-1)/2)*IMT
+      IF(MOD(NROW,2).EQ.1)THEN
+        K=KROWS+NCOL/2
+      ELSE
+        K=KROWS+P_IDE-2+(NCOL+1)/2     ! check this one should this not be P_IDE-2 ????
+      ENDIF
+
+!***
+!***  WE NOW KNOW THAT THE INNER GRID POINT IN QUESTION IS
+!***  NEAREST TO THE CENTER K AS SEEN BELOW.  WE MUST FIND
+!***  WHICH OF THE FOUR V-BOXES (OF WHICH THIS V POINT IS
+!***  A VERTEX) SURROUNDS THE INNER GRID v POINT IN QUESTION.
+!***
+!***
+!***                  V
+!***
+!***
+!***
+!***            V     H     V
+!***
+!***
+!***               v
+!***      V     H     V     H     V
+!***
+!***
+!***
+!***            V     H     V
+!***
+!***
+!***
+!***                  V
+!***
+!***
+!***  FIND THE SLOPE OF THE LINE CONNECTING v AND THE CENTER V.
+!***
+      N2R=K/IMT
+      MK=MOD(K,IMT)
+!
+      IF(MK.EQ.0)THEN
+        TLATVC=SB+(2*N2R-1)*DPH
+      ELSE
+        TLATVC=SB+(2*N2R+MK/(P_IDE-1))*DPH
+      ENDIF
+!
+      IF(MK.LE.(P_IDE-1)-1)THEN
+        TLONVC=WB+(2*MK-1)*DLM
+      ELSE
+        TLONVC=WB+2*(MK-(P_IDE-1))*DLM
+      ENDIF
+
+!
+!***  EXECUTE CAUTION IF YOU NEED TO CHANGE THESE CONDITIONS. SINCE WE ARE
+!***  DEALING WITH SLOPES TO GENERATE DIAMOND SHAPE V BOXES, WE NEED TO BE
+!***  CAREFUL HERE
+!
+       IF(ABS(TLON-TLONVC) .LE. 1.E-4)TLONVC=TLON
+       IF(ABS(TLAT-TLATVC) .LE. 1.E-4)TLATVC=TLAT
+       DENOM=(TLON-TLONVC)
+!
+!***
+!***STORE THE LOCATION OF THE WESTERNMOST VERTEX OF THE H-BOX ON
+!***THE OUTER GRID THAT SURROUNDS THE h POINT ON THE INNER GRID.
+!***
+!*** COINCIDENT CONDITIONS
+
+     IF(DENOM.EQ.0.0)THEN
+
+       IF(TLATVC.EQ.TLAT)THEN
+         KOUTB(I,J)=K
+         IIV(I,J) = NCOL
+         JJV(I,J) = NROW
+         TLATVX(I,J)=TLATVC
+         TLONVX(I,J)=TLONVC
+         VBWGT1(I,J)=1.0
+         VBWGT2(I,J)=0.0
+         VBWGT3(I,J)=0.0
+         VBWGT4(I,J)=0.0
+!         WRITE(61,*)'TRIVIAL SOLUTION'
+       ELSE                              ! SAME LONGITUDE BUT DIFFERENT LATS 
+          
+         IF(TLATVC .GT. TLAT)THEN      ! NESTED POINT SOUTH OF PARENT
+          KOUTB(I,J)=K-(P_IDE-1)
+          IIV(I,J) = NCOL-1
+          JJV(I,J) = NROW-1
+          TLATVX(I,J)=TLATVC-DPH
+          TLONVX(I,J)=TLONVC-DLM
+!          WRITE(61,*)'VANISHING SLOPE, -ve: TLATVC-DPH, TLONVC-DLM'
+         ELSE                                   ! NESTED POINT NORTH OF PARENT
+          KOUTB(I,J)=K+(P_IDE-1)-1
+          IIV(I,J) = NCOL-1
+          JJV(I,J) = NROW+1
+          TLATVX(I,J)=TLATVC+DPH
+          TLONVX(I,J)=TLONVC-DLM
+!          WRITE(61,*)'VANISHING SLOPE, +ve: TLATVC+DPH, TLONVC-DLM'
+         ENDIF
+
+!***
+!***
+!***                  4
+!***
+!***                  v 
+!***             1         2
+!***
+!***                  3
+!***  DL 1-4 ARE THE ANGULAR DISTANCES FROM h TO EACH VERTEX
+
+       TLATO=TLATVX(I,J)
+       TLONO=TLONVX(I,J)
+       DLM1=TLON-TLONO
+       DLA1=TLAT-TLATO                                               ! Q
+!      DL1=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM1)+SIN(TLAT)*SIN(TLATO)) ! Q
+       DL1=SQRT(DLM1*DLM1+DLA1*DLA1)                                 ! Q
+!
+       TLATO=TLATVX(I,J)
+       TLONO=TLONVX(I,J)+2.*DLM
+       DLM2=TLON-TLONO
+       DLA2=TLAT-TLATO                                               ! Q
+!      DL2=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM2)+SIN(TLAT)*SIN(TLATO)) ! Q
+       DL2=SQRT(DLM2*DLM2+DLA2*DLA2)                                 ! Q
+
+       TLATO=TLATVX(I,J)-DPH
+       TLONO=TLONVX(I,J)+DLM
+       DLM3=TLON-TLONO
+       DLA3=TLAT-TLATO                                               ! Q
+!      DL3=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM3)+SIN(TLAT)*SIN(TLATO)) ! Q
+       DL3=SQRT(DLM3*DLM3+DLA3*DLA3)                                 ! Q
+
+       TLATO=TLATVX(I,J)+DPH
+       TLONO=TLONVX(I,J)+DLM
+       DLM4=TLON-TLONO
+       DLA4=TLAT-TLATO                                               ! Q
+!      DL4=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM4)+SIN(TLAT)*SIN(TLATO)) ! Q
+       DL4=SQRT(DLM4*DLM4+DLA4*DLA4)                                 ! Q
+                 
+!      THE BILINEAR WEIGHTS
+!***
+       AN3=ATAN2(DLA1,DLM1)                                          ! Q
+       R1=DL1*SIN(AN2-AN3)/SIN(2.*AN1)
+       S1=DL1*SIN(2.*PI_2-2*AN1-AN2+AN3)/SIN(2.*AN1)
+       R1=R1/DS1
+       S1=S1/DS1
+       DL1I=(1.-R1)*(1.-S1)
+       DL2I=R1*S1
+       DL3I=R1*(1.-S1)
+       DL4I=(1.-R1)*S1
+!
+       VBWGT1(I,J)=DL1I
+       VBWGT2(I,J)=DL2I
+       VBWGT3(I,J)=DL3I
+       VBWGT4(I,J)=DL4I      
+
+      ENDIF
+
+    ELSE
+
+!
+!*** NON-COINCIDENT POINTS
+!
+      SLOPE=(TLAT-TLATVC)/DENOM
+      DSLOPE=NINT(R2D*ATAN(SLOPE))
+
+      IF(DSLOPE.LE.DSLP0.AND.DSLOPE.GE.-DSLP0)THEN
+        IF(TLON.GT.TLONVC)THEN
+          IF(TLONVC.GE.-WB-DLM)CALL wrf_error_fatal("1V:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K
+          IIV(I,J)=NCOL
+          JJV(I,J)=NROW
+          TLATVX(I,J)=TLATVC
+          TLONVX(I,J)=TLONVC
+!          WRITE(61,*)'HERE WE GO1: TLATHC, TLONHC'
+        ELSE
+          IF(TLONVC.LE.WB+DLM)CALL wrf_error_fatal("2V:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K-1
+          IIV(I,J) = NCOL-2
+          JJV(I,J) = NROW
+          TLATVX(I,J)=TLATVC
+          TLONVX(I,J)=TLONVC-2.*DLM
+!          WRITE(61,*)'HERE WE GO2: TLATHC, TLONHC -2.*DLM'
+        ENDIF
+ 
+      ELSEIF(DSLOPE.GT.DSLP0)THEN
+        IF(TLON.GT.TLONVC)THEN
+          IF(TLATVC.GE.-SB-DPH)CALL wrf_error_fatal("3V:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K+(P_IDE-1)-1
+          IIV(I,J) = NCOL-1
+          JJV(I,J) = NROW+1
+          TLATVX(I,J)=TLATVC+DPH
+          TLONVX(I,J)=TLONVC-DLM
+!          WRITE(61,*)'HERE WE GO3:  TLATHC+DPH, TLONHC-DLM'
+        ELSE
+          IF(TLATVC.LE.SB+DPH)CALL wrf_error_fatal("4V:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K-(P_IDE-1)
+          IIV(I,J) = NCOL-1
+          JJV(I,J) = NROW-1
+          TLATVX(I,J)=TLATVC-DPH
+          TLONVX(I,J)=TLONVC-DLM
+!          WRITE(61,*)'HERE WE GO4:  TLATHC-DPH, TLONHC-DLM'
+        ENDIF
+ 
+      ELSEIF(DSLOPE.LT.-DSLP0)THEN
+        IF(TLON.GT.TLONVC)THEN
+          IF(TLATVC.LE.SB+DPH)CALL wrf_error_fatal("5V:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K-(P_IDE-1)
+          IIV(I,J) = NCOL-1
+          JJV(I,J) = NROW-1
+          TLATVX(I,J)=TLATVC-DPH
+          TLONVX(I,J)=TLONVC-DLM
+!          WRITE(61,*)'HERE WE GO5:  TLATHC-DPH, TLONHC-DLM'
+        ELSE
+          IF(TLATVC.GE.-SB-DPH)CALL wrf_error_fatal("6V:NESTED DOMAIN TOO CLOSE TO THE BOUNDARY OF PARENT")
+          KOUTB(I,J)=K+(P_IDE-1)-1
+          IIV(I,J) = NCOL-1
+          JJV(I,J) = NROW+1
+          TLATVX(I,J)=TLATVC+DPH
+          TLONVX(I,J)=TLONVC-DLM
+!          WRITE(61,*)'HERE WE GO6: TLATHC+DPH,  TLONHC-DLM'
+        ENDIF
+      ENDIF
+!
+!***  NOW WE WILL MOVE AS FOLLOWS:
+!***
+!***
+!***                      4
+!***
+!***
+!*** 
+!***                   v 
+!***             1                 2
+!***
+!***
+!***
+!***
+!***                      3
+!***
+!***
+!***
+!***  DL 1-4 ARE THE ANGULAR DISTANCES FROM v TO EACH VERTEX
+
+      TLATO=TLATVX(I,J)
+      TLONO=TLONVX(I,J)
+      DLM1=TLON-TLONO
+      DLA1=TLAT-TLATO                                               ! Q
+!     DL1=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM1)+SIN(TLAT)*SIN(TLATO)) ! Q
+      DL1=SQRT(DLM1*DLM1+DLA1*DLA1)                                 ! Q
+!
+      TLATO=TLATVX(I,J)
+      TLONO=TLONVX(I,J)+2.*DLM
+      DLM2=TLON-TLONO
+      DLA2=TLAT-TLATO                                               ! Q
+!     DL2=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM2)+SIN(TLAT)*SIN(TLATO)) ! Q
+      DL2=SQRT(DLM2*DLM2+DLA2*DLA2)                                 ! Q
+!
+      TLATO=TLATVX(I,J)-DPH
+      TLONO=TLONVX(I,J)+DLM
+      DLM3=TLON-TLONO
+      DLA3=TLAT-TLATO                                               ! Q
+!     DL3=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM3)+SIN(TLAT)*SIN(TLATO)) ! Q
+      DL3=SQRT(DLM3*DLM3+DLA3*DLA3)                                 ! Q
+!
+      TLATO=TLATVX(I,J)+DPH
+      TLONO=TLONVX(I,J)+DLM
+      DLM4=TLON-TLONO
+      DLA4=TLAT-TLATO                                               ! Q
+!     DL4=ACOS(COS(TLAT)*COS(TLATO)*COS(DLM4)+SIN(TLAT)*SIN(TLATO)) ! Q
+      DL4=SQRT(DLM4*DLM4+DLA4*DLA4)                                 ! Q
+ 
+!     THE BILINEAR WEIGHTS
+!***
+      AN3=ATAN2(DLA1,DLM1)                                          ! Q
+      R1=DL1*SIN(AN2-AN3)/SIN(2.*AN1)
+      S1=DL1*SIN(2.*PI_2-2*AN1-AN2+AN3)/SIN(2.*AN1)
+      R1=R1/DS1
+      S1=S1/DS1
+      DL1I=(1.-R1)*(1.-S1)
+      DL2I=R1*S1
+      DL3I=R1*(1.-S1)
+      DL4I=(1.-R1)*S1
+!
+      VBWGT1(I,J)=DL1I
+      VBWGT2(I,J)=DL2I
+      VBWGT3(I,J)=DL3I
+      VBWGT4(I,J)=DL4I
+
+     ENDIF
+
+!
+!***  FINALLY STORE IIH IN TERMS OF E-GRID INDEX
+!
+      IIV(I,J)=NINT(0.5*IIV(I,J))
+
+      VBWGT1(I,J)=MAX(VBWGT1(I,J),0.0)   ! all weights must be GE zero (postive def)
+      VBWGT2(I,J)=MAX(VBWGT2(I,J),0.0)   ! all weights must be GE zero (postive def)
+      VBWGT3(I,J)=MAX(VBWGT3(I,J),0.0)   ! all weights must be GE zero (postive def)
+      VBWGT4(I,J)=MAX(VBWGT4(I,J),0.0)   ! all weights must be GE zero (postive def)
+
+!      WRITE(61,*)I,J,VBWGT1(I,J),VBWGT2(I,J),VBWGT3(I,J),VBWGT4(I,J), &
+!                    VBWGT1(I,J)+VBWGT2(I,J)+VBWGT3(I,J)+VBWGT4(I,J),IIV(i,j),JJV(i,j)
+
+    ENDDO
+  ENDDO
+
+ RETURN
+ END SUBROUTINE G2T2V
+
+!------------------------------------------------------------------------------
+!
+SUBROUTINE WEIGTS_CHECK(HBWGT1,HBWGT2,HBWGT3,HBWGT4,       & 
+                        VBWGT1,VBWGT2,VBWGT3,VBWGT4,       &
+                        IDS,IDE,JDS,JDE,KDS,KDE,           &
+                        IMS,IME,JMS,JME,KMS,KME,           & 
+                        ITS,ITE,JTS,JTE,KTS,KTE            )
+
+  IMPLICIT NONE
+  INTEGER, INTENT(IN)                                 :: IDS,IDE,JDS,JDE,KDS,KDE,  &
+                                                         IMS,IME,JMS,JME,KMS,KME,  &
+                                                         ITS,ITE,JTS,JTE,KTS,KTE
+  REAL,    DIMENSION(IMS:IME,JMS:JME),   INTENT(IN)   :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+  REAL,    DIMENSION(IMS:IME,JMS:JME),   INTENT(IN)   :: VBWGT1,VBWGT2,VBWGT3,VBWGT4
+
+! local 
+
+  REAL , PARAMETER :: EPSI=1.0E-3
+  INTEGER          :: I,J
+  REAL             :: ADDSUM
+
+!-------------------------------------------------------------------------------------
+
+! DUE TO THE NEED FOR HALO EXCHANGES IN PARALLEL RUNS ONE HAS TO ENSURE CONSISTENT 
+! USAGE OF NUMBER OF PROCESSORS BEFORE ANY FURTHER COMPUTATIONS. WE INTRODUCE THIS
+! CHECK FIRST
+
+  IF((ITE-ITS) .LE. 5 .OR. (JTE-JTS) .LE. 5)THEN
+   WRITE(0,*)'ITE-ITS=',ITE-ITS,'JTE-JTS=',JTE-JTS
+   CALL wrf_error_fatal ('NESTED DOMAIN:PLEASE OPTIMIZE THE NUMBER OF PROCESSES; TRY SQUARES OF NUMBERS') 
+  ENDIF
+
+!  
+! NOW CHECK WEIGHTS
+!
+
+  ADDSUM=0.
+  DO J = JTS, MIN(JTE,JDE-1)
+   DO I = ITS, MIN(ITE,IDE-1)
+      ADDSUM=HBWGT1(I,J)+HBWGT2(I,J)+HBWGT3(I,J)+HBWGT4(I,J)
+      IF(ABS(1.0-ADDSUM) .GE. EPSI)THEN
+       WRITE(0,*)'I=',I,'J=',J,'WEIGHTS=',HBWGT1(I,J),HBWGT2(I,J),HBWGT3(I,J),HBWGT4(I,J),1-ADDSUM
+       CALL wrf_error_fatal ('NESTED DOMAIN:SOMETHING IS WRONG WITH WEIGHTS COMPUTATION AT MASS POINTS') 
+      ENDIF
+   ENDDO
+  ENDDO
+
+  ADDSUM=0.
+  DO J = JTS, MIN(JTE,JDE-1)
+   DO I = ITS, MIN(ITE,IDE-1)
+      ADDSUM=VBWGT1(I,J)+VBWGT2(I,J)+VBWGT3(I,J)+VBWGT4(I,J)
+      IF(ABS(1.0-ADDSUM) .GE. EPSI)THEN 
+       WRITE(0,*)'I=',I,'J=',J,'WEIGHTS=',VBWGT1(I,J),VBWGT2(I,J),VBWGT3(I,J),VBWGT4(I,J),1-ADDSUM
+       CALL wrf_error_fatal ('NESTED DOMAIN:SOMETHING IS WRONG WITH WEIGHTS COMPUTATION AT VELOCITY POINTS')
+      ENDIF
+   ENDDO
+  ENDDO
+
+END SUBROUTINE WEIGTS_CHECK
+
+!-----------------------------------------------------------------------------------
+
+SUBROUTINE BOUNDS_CHECK( IIH,JJH,IIV,JJV,          &
+                         IPOS,JPOS,SHW,            &
+                         IDS,IDE,JDS,JDE,KDS,KDE,  & !
+                         IMS,IME,JMS,JME,KMS,KME,  & ! nested grid configuration
+                         ITS,ITE,JTS,JTE,KTS,KTE   )
+
+ IMPLICIT NONE
+ INTEGER, INTENT(IN) :: IPOS,JPOS,SHW,            &
+                        IDS,IDE,JDS,JDE,KDS,KDE,  & 
+                        IMS,IME,JMS,JME,KMS,KME,  & 
+                        ITS,ITE,JTS,JTE,KTS,KTE   
+
+ INTEGER, DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IIH,JJH,IIV,JJV
+
+! local variables
+
+ INTEGER :: I,J
+
+!***  Gopal       - Initial version 
+!***
+!*** CHECK DOMAIN BOUNDS BEFORE PROCEEDING TO INTERPOLATION
+!
+!============================================================================
+
+  IF(IPOS .LE. SHW)CALL wrf_error_fatal('NESTED DOMAIN TOO CLOSE TO PARENTs X-BOUNDARY')
+  IF(JPOS .LE. SHW)CALL wrf_error_fatal('NESTED DOMAIN TOO CLOSE TO PARENTs Y-BOUNDARY')
+
+  DO J = JTS, MIN(JTE,JDE-1)
+   DO I = ITS, MIN(ITE,IDE-1)
+      IF(IIH(I,J) .EQ. 0)CALL wrf_error_fatal ('IIH=0: SOMETHING IS WRONG')
+      IF(JJH(I,J) .EQ. 0)CALL wrf_error_fatal ('JJH=0: SOMETHING IS WRONG')
+   ENDDO
+  ENDDO
+
+  DO J = JTS, MIN(JTE,JDE-1)
+   DO I = ITS, MIN(ITE,IDE-1)
+      IF(IIH(I,J) .LT. (IPOS-SHW) .OR. JJH(I,J) .LT. (JPOS-SHW) .OR.   &
+         IIV(I,J) .LT. (IPOS-SHW) .OR. JJV(I,J) .LT. (JPOS-SHW))THEN
+         WRITE(0,*)I,J,IIH(I,J),IPOS,JJH(I,J),JPOS,SHW
+         WRITE(0,*)I,J,IIV(I,J),IPOS,JJV(I,J),JPOS,SHW
+         CALL wrf_error_fatal ('CHECK NESTED DOMAIN BOUNDS: TRY INCREASING STENCIL WIDTH') 
+      ENDIF
+   ENDDO
+  ENDDO
+
+END SUBROUTINE BOUNDS_CHECK
+
+!==========================================================================================
+
+
+SUBROUTINE BASE_STATE_PARENT ( Z3d,Q3d,T3d,PSTD,        &
+                               PINT,T,Q,CWM,            &
+                               FIS,QS,PD,PDTOP,PTOP,    &
+                               ETA1,ETA2,               &
+                               DETA1,DETA2,             &
+                               IDS,IDE,JDS,JDE,KDS,KDE, &
+                               IMS,IME,JMS,JME,KMS,KME, &
+                               ITS,ITE,JTS,JTE,KTS,KTE  )
+!
+
+ USE MODULE_MODEL_CONSTANTS
+ IMPLICIT NONE
+ INTEGER,    INTENT(IN   )                            :: IDS,IDE,JDS,JDE,KDS,KDE
+ INTEGER,    INTENT(IN   )                            :: IMS,IME,JMS,JME,KMS,KME
+ INTEGER,    INTENT(IN   )                            :: ITS,ITE,JTS,JTE,KTS,KTE
+ REAL,       INTENT(IN   )                            :: PDTOP,PTOP
+ REAL, DIMENSION(KMS:KME),                 INTENT(IN) :: ETA1,ETA2,DETA1,DETA2
+ REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(IN) :: FIS,PD,QS
+ REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(IN) :: PINT,T,Q,CWM
+ REAL, DIMENSION(KMS:KME),                 INTENT(OUT):: PSTD
+ REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(OUT):: Z3d,Q3d,T3d
+
+! local
+
+ INTEGER,PARAMETER                                    :: JTB=134
+ INTEGER                                              :: I,J,K,ILOC,JLOC
+ REAL, PARAMETER                                      :: LAPSR=6.5E-3, GI=1./G,D608=0.608
+ REAL, PARAMETER                                      :: COEF3=287.05*GI*LAPSR, COEF2=-1./COEF3
+ REAL, PARAMETER                                      :: TRG=2.0*R_D*GI,LAPSI=1.0/LAPSR
+ REAL, PARAMETER                                      :: P_REF=103000.
+ REAL                                                 :: A,B,APELP,RTOPP,DZ,ZMID
+ REAL, DIMENSION(IMS:IME,JMS:JME)                     :: SLP,TSFC,ZMSLP
+ REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME)             :: Z3d_IN
+ REAL,DIMENSION(JTB)                                  :: PIN,ZIN,Y2,PIO,ZOUT,DUM1,DUM2
+ REAL,DIMENSION(JTB)                                  :: QIN,QOUT,TIN,TOUT
+!-------------------------------------------------------------------------------------- 
+
+!  CLEAN Z3D ARRAY FIRST
+
+    DO J = JTS, MIN(JTE,JDE-1)
+     DO K=KDS,KDE
+      DO I = ITS, MIN(ITE,IDE-1)
+       Z3d(I,K,J)=0.0
+       T3d(I,K,J)=0.0
+       Q3d(I,K,J)=0.0
+      ENDDO
+     ENDDO
+    ENDDO 
+
+
+!  DETERMINE THE HEIGHTS ON THE PARENT DOMAIN
+
+    DO J = JTS, MIN(JTE,JDE-1)
+      DO I = ITS, MIN(ITE,IDE-1)
+       Z3d_IN(I,1,J)=FIS(I,J)*GI
+      ENDDO
+    ENDDO 
+
+    DO J = JTS, MIN(JTE,JDE-1)
+     DO K = KDS,KDE-1
+      DO I = ITS, MIN(ITE,IDE-1)
+        APELP    = (PINT(I,K+1,J)+PINT(I,K,J))
+!       RTOPP    = TRG*T(I,K,J)*(1.0+Q(I,K,J)*P608-CWM(I,K,J))/APELP
+        RTOPP    = TRG*T(I,K,J)*(1.0+Q(I,K,J)*P608)/APELP
+        DZ       = RTOPP*(DETA1(K)*PDTOP+DETA2(K)*PD(I,J))   ! (RTv/P_TOT)*D(P_HYDRO)
+        Z3d_IN(I,K+1,J) = Z3d_IN(I,K,J) + DZ
+!       IF(I==2 .AND. J==2)WRITE(0,*)'INSIDE BASE_STATE',K,T(I,K,J)
+      ENDDO
+     ENDDO
+    ENDDO
+
+
+!  CONSTRUCT STANDARD ISOBARIC SURFACES 
+
+    DO K=KDS,KDE                         ! target points in model interface levels (pint)
+       PSTD(K) = ETA1(K)*PDTOP + ETA2(K)*(P_REF -PDTOP - PTOP) + PTOP
+    ENDDO
+
+!   DETERMINE THE MSLP USE THAT TO CREATE HEIGHTS AT 1000. mb LEVEL. THESE HEIGHTS  
+!   MAY ONLY BE USED IN VERTICAL INTERPOLATION TO ISOBARIC SURFACES WHICH ARE LOCATED
+!   BELOW GROUND LEVEL. 
+
+    DO J = JTS, MIN(JTE,JDE-1)
+      DO I = ITS, MIN(ITE,IDE-1)
+        TSFC(I,J) = T(I,1,J)*(1.+D608*Q(I,1,J)) + LAPSR*(Z3d_IN(I,1,J)+Z3d_IN(I,2,J))*0.5
+        A         = LAPSR*Z3d_IN(I,1,J)/TSFC(I,J)
+        SLP(I,J)  = PINT(I,1,J)*(1-A)**COEF2    ! sea level pressure 
+        B         = (PSTD(1)/SLP(I,J))**COEF3
+        ZMSLP(I,J)= TSFC(I,J)*LAPSI*(1.0 - B)   ! Height at 1000. mb level
+      ENDDO
+    ENDDO
+
+!   INTERPOLATE Z3d_IN TO STANDARD PRESSURE INTERFACES. FOR LEVELS BELOW
+!   GROUND USE ZMSLP(I,J)
+
+    DO J = JTS, MIN(JTE,JDE-1)
+      DO I = ITS, MIN(ITE,IDE-1)
+!    
+!     clean local array before use of spline
+
+      PIN=0.;ZIN=0.;Y2=0;PIO=0.;ZOUT=0.;DUM1=0.;DUM2=0.
+
+       DO K=KDS,KDE                           ! inputs at model interfaces 
+         PIN(K) = PINT(I,KDE-K+1,J)
+         ZIN(K) = Z3d_IN(I,KDE-K+1,J)
+       ENDDO
+
+       IF(PINT(I,1,J) .LE. PSTD(1))THEN
+          PIN(KDE) = PSTD(1)                 
+          ZIN(KDE) = ZMSLP(I,J)             
+       ENDIF
+!
+       Y2(1   )=0.
+       Y2(KDE)=0.
+!
+       DO K=KDS,KDE
+          PIO(K)=PSTD(K)
+       ENDDO
+!
+       CALL SPLINE1(I,J,JTB,KDE,PIN,ZIN,Y2,KDE,PIO,ZOUT,DUM1,DUM2)  ! interpolate
+!
+
+       DO K=KDS,KDE                           ! inputs at model interfaces
+         Z3d(I,K,J)=ZOUT(K)
+       ENDDO
+       
+      ENDDO
+    ENDDO
+!
+!   INTERPOLATE TEMPERATURE ONTO THE STANDARD PRESSURE LEVELS. FOR LEVELS BELOW  
+!   GROUND USE A LAPSE RATE ATMOSPHERE 
+!
+    DO J = JTS, MIN(JTE,JDE-1)
+      DO I = ITS, MIN(ITE,IDE-1)
+!  
+!     clean local array before use of spline or linear interpolation
+!
+      PIN=0.;TIN=0.;Y2=0;PIO=0.;TOUT=0.;DUM1=0.;DUM2=0.
+
+       DO K=KDS+1,KDE                           ! inputs at model levels
+         PIN(K-1) = EXP((ALOG(PINT(I,KDE-K+1,J))+ALOG(PINT(I,KDE-K+2,J)))*0.5)
+         TIN(K-1) = T(I,KDE-K+1,J)
+       ENDDO
+
+       IF(PINT(I,1,J) .LE. PSTD(1))THEN
+         PIN(KDE-1) = EXP((ALOG(PSTD(1))+ALOG(PSTD(2)))*0.5)
+         ZMID     = 0.5*(Z3d_IN(I,1,J)+Z3d_IN(I,2,J))
+         TIN(KDE-1) = T(I,1,J) + LAPSR*(ZMID-ZMSLP(I,J)) 
+       ENDIF
+!
+       Y2(1   )=0.
+       Y2(KDE-1)=0.
+!
+       DO K=KDS,KDE-1
+          PIO(K)=EXP((ALOG(PSTD(K))+ALOG(PSTD(K+1)))*0.5)
+       ENDDO
+
+       CALL SPLINE1(I,J,JTB,KDE-1,PIN,TIN,Y2,KDE-1,PIO,TOUT,DUM1,DUM2)  ! interpolate
+
+
+       DO K=KDS,KDE-1                           ! inputs at model levels
+         T3d(I,K,J)=TOUT(K)
+       ENDDO
+
+      ENDDO
+    ENDDO
+
+!
+!   INTERPOLATE MOISTURE ONTO THE STANDARD PRESSURE LEVELS. FOR LEVELS BELOW 
+!   GROUND USE THE SURFACE MOISTURE 
+!
+    DO J = JTS, MIN(JTE,JDE-1)
+      DO I = ITS, MIN(ITE,IDE-1)
+!
+!     clean local array before use of spline or linear interpolation
+
+
+      PIN=0.;QIN=0.;Y2=0;PIO=0.;QOUT=0.;DUM1=0.;DUM2=0.
+
+       DO K=KDS+1,KDE                           ! inputs at model levels
+         PIN(K-1) = EXP((ALOG(PINT(I,KDE-K+1,J))+ALOG(PINT(I,KDE-K+2,J)))*0.5)
+         QIN(K-1) = Q(I,KDE-K+1,J)
+       ENDDO
+
+       IF(PINT(I,1,J) .LE. PSTD(1))THEN
+          PIN(KDE-1) = EXP((ALOG(PSTD(1))+ALOG(PSTD(2)))*0.5)
+!         QIN(KDE-1) =  QS(I,J)
+       ENDIF
+
+       Y2(1   )=0.
+       Y2(KDE-1)=0.
+!
+       DO K=KDS,KDE-1
+          PIO(K)=EXP((ALOG(PSTD(K))+ALOG(PSTD(K+1)))*0.5)
+       ENDDO
+
+       CALL SPLINE1(I,J,JTB,KDE-1,PIN,QIN,Y2,KDE-1,PIO,QOUT,DUM1,DUM2)  ! interpolate
+
+       DO K=KDS,KDE-1                          ! inputs at model levels
+         Q3d(I,K,J)=QOUT(K)
+       ENDDO
+
+      ENDDO
+    ENDDO
+
+END SUBROUTINE BASE_STATE_PARENT
+!=============================================================================
+      SUBROUTINE SPLINE1(I,J,JTBX,NOLD,XOLD,YOLD,Y2,NNEW,XNEW,YNEW,P,Q)
+!
+!   ******************************************************************
+!   *                                                                *
+!   *  THIS IS A ONE-DIMENSIONAL CUBIC SPLINE FITTING ROUTINE        *
+!   *  PROGRAMED FOR A SMALL SCALAR MACHINE.                         *
+!   *                                                                *
+!   *  PROGRAMER Z. JANJIC                                           *
+!   *                                                                *
+!   *  NOLD - NUMBER OF GIVEN VALUES OF THE FUNCTION.  MUST BE GE 3. *
+!   *  XOLD - LOCATIONS OF THE POINTS AT WHICH THE VALUES OF THE     *
+!   *         FUNCTION ARE GIVEN.  MUST BE IN ASCENDING ORDER.       *
+!   *  YOLD - THE GIVEN VALUES OF THE FUNCTION AT THE POINTS XOLD.   *
+!   *  Y2   - THE SECOND DERIVATIVES AT THE POINTS XOLD.  IF NATURAL *
+!   *         SPLINE IS FITTED Y2(1)=0. AND Y2(NOLD)=0. MUST BE      *
+!   *         SPECIFIED.                                             *
+!   *  NNEW - NUMBER OF VALUES OF THE FUNCTION TO BE CALCULATED.     *
+!   *  XNEW - LOCATIONS OF THE POINTS AT WHICH THE VALUES OF THE     *
+!   *         FUNCTION ARE CALCULATED.  XNEW(K) MUST BE GE XOLD(1)   *
+!   *         AND LE XOLD(NOLD).                                     *
+!   *  YNEW - THE VALUES OF THE FUNCTION TO BE CALCULATED.           *
+!   *  P, Q - AUXILIARY VECTORS OF THE LENGTH NOLD-2.                *
+!   *                                                                *
+!   ******************************************************************
+!---------------------------------------------------------------------
+      IMPLICIT NONE
+!---------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: I,J,JTBX,NNEW,NOLD
+      REAL,DIMENSION(JTBX),INTENT(IN) :: XNEW,XOLD,YOLD
+      REAL,DIMENSION(JTBX),INTENT(INOUT) :: P,Q,Y2
+      REAL,DIMENSION(JTBX),INTENT(OUT) :: YNEW
+!
+      INTEGER :: II,JJ,K,K1,K2,KOLD,NOLDM1
+      REAL :: AK,BK,CK,DEN,DX,DXC,DXL,DXR,DYDXL,DYDXR                 &
+             ,RDX,RTDXC,X,XK,XSQ,Y2K,Y2KP1
+!---------------------------------------------------------------------
+
+!     debug
+
+      II=9999 !67 !35 !50   !4
+      JJ=9999 !31 !73 !115  !192
+      IF(I.eq.II.and.J.eq.JJ)THEN
+        WRITE(0,*)'DEBUG in SPLINE1:HSO= ',xnew(1:nold)
+        DO K=1,NOLD
+         WRITE(0,*)'DEBUG in SPLINE1:L,ZETAI,PINTI= ' &
+                        ,K,YOLD(K),XOLD(K)
+        ENDDO 
+      ENDIF 
+
+!
+      NOLDM1=NOLD-1
+!
+      DXL=XOLD(2)-XOLD(1)
+      DXR=XOLD(3)-XOLD(2)
+      DYDXL=(YOLD(2)-YOLD(1))/DXL
+      DYDXR=(YOLD(3)-YOLD(2))/DXR
+      RTDXC=0.5/(DXL+DXR)
+!
+      P(1)= RTDXC*(6.*(DYDXR-DYDXL)-DXL*Y2(1))
+      Q(1)=-RTDXC*DXR
+!
+      IF(NOLD.EQ.3)GO TO 150
+!---------------------------------------------------------------------
+      K=3
+!
+  100 DXL=DXR
+      DYDXL=DYDXR
+      DXR=XOLD(K+1)-XOLD(K)
+      DYDXR=(YOLD(K+1)-YOLD(K))/DXR
+      DXC=DXL+DXR
+      DEN=1./(DXL*Q(K-2)+DXC+DXC)
+!
+      P(K-1)= DEN*(6.*(DYDXR-DYDXL)-DXL*P(K-2))
+      Q(K-1)=-DEN*DXR
+!
+      K=K+1
+      IF(K.LT.NOLD)GO TO 100
+!-----------------------------------------------------------------------
+  150 K=NOLDM1
+!
+  200 Y2(K)=P(K-1)+Q(K-1)*Y2(K+1)
+!
+      K=K-1
+      IF(K.GT.1)GO TO 200
+!-----------------------------------------------------------------------
+      K1=1
+!
+  300 XK=XNEW(K1)
+!
+      DO 400 K2=2,NOLD
+!
+      IF(XOLD(K2).GT.XK)THEN
+        KOLD=K2-1
+        GO TO 450
+      ENDIF
+!
+  400 CONTINUE
+!
+      YNEW(K1)=YOLD(NOLD)
+      GO TO 600
+!
+  450 IF(K1.EQ.1)GO TO 500
+      IF(K.EQ.KOLD)GO TO 550
+!
+  500 K=KOLD
+!
+      Y2K=Y2(K)
+      Y2KP1=Y2(K+1)
+      DX=XOLD(K+1)-XOLD(K)
+      RDX=1./DX
+!
+      AK=.1666667*RDX*(Y2KP1-Y2K)
+      BK=0.5*Y2K
+      CK=RDX*(YOLD(K+1)-YOLD(K))-.1666667*DX*(Y2KP1+Y2K+Y2K)
+!
+  550 X=XK-XOLD(K)
+      XSQ=X*X
+!
+      YNEW(K1)=AK*XSQ*X+BK*XSQ+CK*X+YOLD(K)
+
+!  debug
+
+      if(i.eq.ii.and.j.eq.jj)then
+        write(0,*) 'DEBUG:: k1,xnew(k1),ynew(k1): ', k1,xnew(k1),ynew(k1)
+      endif
+
+!
+  600 K1=K1+1
+      IF(K1.LE.NNEW)GO TO 300
+
+      RETURN
+      END SUBROUTINE SPLINE1
+!---------------------------------------------------------------------
+
+SUBROUTINE NEST_TERRAIN ( nest )
+
+ USE module_domain
+ USE module_configure
+ USE module_timing
+
+ USE wrfsi_static
+
+ IMPLICIT NONE
+
+ TYPE(domain) , POINTER                        :: nest
+
+!
+! Local variables
+!
+
+ LOGICAL, EXTERNAL                 :: wrf_dm_on_monitor
+ INTEGER                           :: ids,ide,jds,jde,kds,kde
+ INTEGER                           :: ims,ime,jms,jme,kms,kme
+ INTEGER                           :: its,ite,jts,jte,kts,kte 
+ INTEGER                           :: i_parent_start, j_parent_start
+ INTEGER                           :: parent_grid_ratio
+ INTEGER                           :: i,j,ii,jj,nnxp,nnyp
+ INTEGER                           :: i_start,j_start,level
+ REAL, ALLOCATABLE, DIMENSION(:,:) :: data1     ! for highres topo
+ REAL, ALLOCATABLE, DIMENSION(:,:) :: avc_big, lnd_big, lah_big, loh_big
+ REAL, ALLOCATABLE, DIMENSION(:,:) :: avc_nest, lnd_nest, lah_nest, loh_nest
+ INTEGER                           :: im_big, jm_big, i_add
+ INTEGER                           :: im, jm
+ CHARACTER(LEN=6)                  :: nestpath
+ 
+!----------------------------------------------------------------------------------
+
+      IDS = nest%sd31
+      IDE = nest%ed31
+      KDS = nest%sd32
+      KDE = nest%ed32
+      JDS = nest%sd33
+      JDE = nest%ed33
+
+      IMS = nest%sm31
+      IME = nest%em31
+      KMS = nest%sm32
+      KME = nest%em32
+      JMS = nest%sm33
+      JME = nest%em33
+
+      ITS = nest%sp31
+      ITE = nest%ep31
+      KTS = nest%sp32
+      KTE = nest%ep32
+      JTS = nest%sp33
+      JTE = nest%ep33
+
+      i_parent_start = nest%i_parent_start
+      j_parent_start = nest%j_parent_start
+      parent_grid_ratio = nest%parent_grid_ratio
+
+      NNXP=IDE-1
+      NNYP=JDE-1
+
+      ALLOCATE(DATA1(1:NNXP,1:NNYP))
+!
+!
+!--- Read in high resolution topography
+!
+      IF ( wrf_dm_on_monitor() ) THEN                    ! first assign a status
+!
+!      This part of the code is Dusan's doing. Extended by gopal for multiple nest (Feb 19,2005)
+!
+       call find_ijstart_level (nest,i_start,j_start,level)
+       write(0,*)" nest%id =", nest%id , " i_start,j_start,level =", i_start,j_start,level
+
+       write(nestpath,"(a4,i1,a1)") 'nest',level,'/'
+
+       if ( level > 0 ) then
+          CALL get_wrfsi_static_dims(nestpath, im_big, jm_big)
+          ALLOCATE (avc_big(im_big,jm_big))
+          ALLOCATE (lnd_big(im_big,jm_big))
+          ALLOCATE (lah_big(im_big,jm_big))
+          ALLOCATE (loh_big(im_big,jm_big))
+          CALL get_wrfsi_static_2d(nestpath, 'avc', avc_big)
+          CALL get_wrfsi_static_2d(nestpath, 'lnd', lnd_big)
+          CALL get_wrfsi_static_2d(nestpath, 'lah', lah_big)
+          CALL get_wrfsi_static_2d(nestpath, 'loh', loh_big)
+       else
+          CALL wrf_error_fatal('this routine NEST_TERRAIN should nou be called for top-level domain')
+       end if
+
+! select subdomain from big fine grid
+
+        im = NNXP
+        jm = NNYP
+
+        ALLOCATE (avc_nest(im,jm))
+        ALLOCATE (lnd_nest(im,jm))
+        ALLOCATE (lah_nest(im,jm))
+        ALLOCATE (loh_nest(im,jm))
+
+        i_add = mod(j_start+1,2) 
+        DO j=1,jm
+        DO i=1,im
+           avc_nest(i,j) = avc_big(i_start+i-1 + mod(j+1,2)*i_add, j_start+j-1)
+           lnd_nest(i,j) = lnd_big(i_start+i-1 + mod(j+1,2)*i_add, j_start+j-1)
+           lah_nest(i,j) = lah_big(i_start+i-1 + mod(j+1,2)*i_add, j_start+j-1)
+           loh_nest(i,j) = loh_big(i_start+i-1 + mod(j+1,2)*i_add, j_start+j-1)
+        END DO
+        END DO
+
+        WRITE(0,*)'SOME MATCHING TEST i_parent_start, j_parent_start',i_parent_start,j_parent_start
+        WRITE(0,*)'WRFSI LAT      COMPUTED LAT'
+        WRITE(0,*)lah_nest(1,1),nest%nmm_hlat(1,1)
+        WRITE(0,*)'WRFSI LON      COMPUTED LON'
+        WRITE(0,*)loh_nest(1,1),nest%nmm_hlon(1,1)
+
+        IF(ABS(lah_nest(1,1)-nest%nmm_hlat(1,1)) .GE. 0.5 .OR.  & 
+           ABS(loh_nest(1,1)-nest%nmm_hlon(1,1)) .GE. 0.5)THEN 
+            WRITE(0,*)'CHECK WRFSI CONFIGURATION AND INPUT HIGH RESOLUTION TOPOGRAPHY AND/OR GRID RATIO' 
+            CALL wrf_error_fatal('LATLON MISMATCH: ERROR READING static.wrfsi.rotlat FOR THE NEST')
+        ENDIF
+
+        call smdhld(im,jm,avc_nest,1.0-lnd_nest,12,12)
+
+!-------------4-point averaging of mountains along inner boundary-------
+
+        do i=1,im-1
+            avc_nest(i,2)=0.25*(avc_nest(i,1)+avc_nest(i+1,1)+ &
+           &                    avc_nest(i,3)+avc_nest(i+1,3))
+        enddo
+
+        do i=1,im-1
+            avc_nest(i,jm-1)=0.25*(avc_nest(i,jm-2)+avc_nest(i+1,jm-2)+ &
+           &                       avc_nest(i,jm)+avc_nest(i+1,jm))
+        enddo
+
+        do j=4,jm-3,2
+            avc_nest(1,j)=0.25*(avc_nest(1,j-1)+avc_nest(2,j-1)+ &
+           &                    avc_nest(1,j+1)+avc_nest(2,j+1))
+        enddo
+
+        do j=4,jm-3,2
+            avc_nest(im,j)=0.25*(avc_nest(im-1,j-1)+avc_nest(im,j-1)+ &
+           &                     avc_nest(im-1,j+1)+avc_nest(im,j+1))
+        enddo
+        
+        DO J = 1,NNYP
+         DO I = 1,NNXP
+            DATA1(I,J) = 9.81*avc_nest(I,J)
+         ENDDO
+        ENDDO
+
+        DEALLOCATE (avc_big,lnd_big)
+        DEALLOCATE (avc_nest,lnd_nest)
+!
+      ENDIF
+
+      CALL wrf_dm_bcast_bytes (DATA1,NNXP*NNYP*RWORDSIZE)
+
+      DO J=JDS,JDE
+       DO I =IDS,IDE
+        IF(I.GE.ITS .AND. I .LE. MIN(ide-1,ite) .AND. J.GE.JTS  .AND. J .LE. MIN(jde-1,jte))THEN
+          nest%nmm_hres_fis(I,J)=DATA1(I,J)
+        ENDIF
+       ENDDO
+      ENDDO
+
+      DEALLOCATE(DATA1)
+      WRITE(0,*)'end of NEST_TERRAIN'
+
+END SUBROUTINE NEST_TERRAIN
+!===========================================================================================
+
+
+SUBROUTINE med_init_domain_constants_nmm ( parent, nest)   !, config_flags)
+  ! Driver layer
+   USE module_domain
+   USE module_configure
+   USE module_timing
+   IMPLICIT NONE
+   TYPE(domain) , POINTER                     :: parent, nest, grid
+!
+#ifdef DEREF_KLUDGE
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+!
+   INTERFACE
+     SUBROUTINE med_initialize_nest_nmm ( grid  &   
+!
+# include <nmm_dummy_args.inc>
+!
+                           )
+        USE module_domain
+        USE module_configure
+        USE module_timing
+        IMPLICIT NONE
+        TYPE(domain) , POINTER                  :: grid
+#include <nmm_dummy_decl.inc>
+     END SUBROUTINE med_initialize_nest_nmm 
+   END INTERFACE
+
+!------------------------------------------------------------------------------
+!  PURPOSE: 
+!         - initialize some data, mainly 2D & 3D nmm arrays  very similar to 
+!           those done in ./dyn_nmm/module_initialize_real.F 
+!-----------------------------------------------------------------------------
+!
+
+   grid => nest
+
+#ifdef DEREF_KLUDGE
+   sm31             = grid%sm31
+   em31             = grid%em31
+   sm32             = grid%sm32
+   em32             = grid%em32
+   sm33             = grid%sm33
+   em33             = grid%em33
+   sm31x            = grid%sm31x
+   em31x            = grid%em31x
+   sm32x            = grid%sm32x
+   em32x            = grid%em32x
+   sm33x            = grid%sm33x
+   em33x            = grid%em33x
+   sm31y            = grid%sm31y
+   em31y            = grid%em31y
+   sm32y            = grid%sm32y
+   em32y            = grid%em32y
+   sm33y            = grid%sm33y
+   em33y            = grid%em33y
+#endif
+
+   CALL med_initialize_nest_nmm( grid &   
+!
+# include <nmm_actual_args.inc>
+!
+                       )
+
+END SUBROUTINE med_init_domain_constants_nmm
+
+SUBROUTINE med_initialize_nest_nmm( grid &
+!
+# include <nmm_dummy_args.inc>
+!
+                           )
+
+ USE module_domain
+ USE module_configure
+ USE module_timing
+ IMPLICIT NONE
+
+! Local domain indices and counters.
+
+ INTEGER :: ids, ide, jds, jde, kds, kde, &
+            ims, ime, jms, jme, kms, kme, &
+            its, ite, jts, jte, kts, kte, &
+            i, j, k, nnxp, nnyp 
+
+ TYPE(domain) , POINTER                     :: grid
+
+! Local data
+
+ LOGICAL, EXTERNAL                   :: wrf_dm_on_monitor
+ INTEGER                             :: KHH,KVH,JAM,JA,IHL, IHH, L
+ INTEGER                             :: II,JJ,ISRCH,ISUM
+ INTEGER, ALLOCATABLE, DIMENSION(:)  :: KHL2,KVL2,KHH2,KVH2,KHLA,KHHA,KVLA,KVHA
+ INTEGER,PARAMETER                   :: KNUM=SELECTED_REAL_KIND(13)
+!
+ REAL(KIND=KNUM)                     :: WB,SB,DLM,DPH,TPH0,STPH0,CTPH0
+ REAL(KIND=KNUM)                     :: STPH,CTPH,TDLM,TDPH,FP,TPH,TLM,TLM0
+ REAL                                :: TPH0D,TLM0D,ANBI,TSPH,DTAD,DTCF,DT
+ REAL                                :: ACDT,CDDAMP,DXP
+ REAL                                :: WBD,SBD,WBI,SBI,EBI
+ REAL                                :: DY_NMM0
+ REAL                                :: RSNOW,SNOFAC
+ REAL, ALLOCATABLE, DIMENSION(:)     :: DXJ,WPDARJ,CPGFUJ,CURVJ,   &
+                                        FCPJ,FDIVJ,EMJ,EMTJ,FADJ,  &
+                                        HDACJ,DDMPUJ,DDMPVJ
+!
+ REAL, PARAMETER:: SALP=2.60
+ REAL, PARAMETER:: SNUP=0.040
+ REAL, PARAMETER:: W_NMM=0.08
+ REAL, PARAMETER:: COAC=0.75
+ REAL, PARAMETER:: CODAMP=6.4
+ REAL, PARAMETER:: TWOM=.00014584
+ REAL, PARAMETER:: CP=1004.6
+ REAL, PARAMETER:: DFC=1.0    
+ REAL, PARAMETER:: DDFC=1.0  
+ REAL, PARAMETER:: ROI=916.6
+ REAL, PARAMETER:: R=287.04
+ REAL, PARAMETER:: CI=2060.0
+ REAL, PARAMETER:: ROS=1500.
+ REAL, PARAMETER:: CS=1339.2
+ REAL, PARAMETER:: DS=0.050
+ REAL, PARAMETER:: AKS=.0000005
+ REAL, PARAMETER:: DZG=2.85
+ REAL, PARAMETER:: DI=.1000
+ REAL, PARAMETER:: AKI=0.000001075
+ REAL, PARAMETER:: DZI=2.0
+ REAL, PARAMETER:: THL=210.
+ REAL, PARAMETER:: PLQ=70000.
+ REAL, PARAMETER:: ERAD=6371200.
+ REAL, PARAMETER:: DTR=0.01745329
+
+   !  Definitions of dummy arguments to solve
+#include <nmm_dummy_decl.inc>
+
+#ifdef DEREF_KLUDGE
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+#ifdef DEREF_KLUDGE
+   sm31             = grid%sm31
+   em31             = grid%em31
+   sm32             = grid%sm32
+   em32             = grid%em32
+   sm33             = grid%sm33
+   em33             = grid%em33
+   sm31x            = grid%sm31x
+   em31x            = grid%em31x
+   sm32x            = grid%sm32x
+   em32x            = grid%em32x
+   sm33x            = grid%sm33x
+   em33x            = grid%em33x
+   sm31y            = grid%sm31y
+   em31y            = grid%em31y
+   sm32y            = grid%sm32y
+   em32y            = grid%em32y
+   sm33y            = grid%sm33y
+   em33y            = grid%em33y
+#endif
+
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+#ifdef DM_PARALLEL
+#      include <nmm_data_calls.inc>
+#endif
+
+   CALL get_ijk_from_grid (  grid ,                           &
+                             ids, ide, jds, jde, kds, kde,    &
+                             ims, ime, jms, jme, kms, kme,    &
+                             its, ite, jts, jte, kts, kte     )
+
+
+!=================================================================================
+!
+!
+
+    DT=grid%dt         !float(TIME_STEP)/parent_time_step_ratio
+    NNXP=min(ITE,IDE-1)
+    NNYP=min(JTE,JDE-1)
+    JAM=6+2*((JDE-1)-10)         ! this should be the fix instead of JAM=6+2*(NNYP-10)
+
+    WRITE(0,*)'TIME STEP ON DOMAIN',grid%id,'==',dt
+
+!
+    ALLOCATE(KHL2(JTS:NNYP),KVL2(JTS:NNYP),KHH2(JTS:NNYP),KVH2(JTS:NNYP))
+    ALLOCATE(DXJ(JTS:NNYP),WPDARJ(JTS:NNYP),CPGFUJ(JTS:NNYP),CURVJ(JTS:NNYP))
+    ALLOCATE(FCPJ(JTS:NNYP),FDIVJ(JTS:NNYP),FADJ(JTS:NNYP))
+    ALLOCATE(HDACJ(JTS:NNYP),DDMPUJ(JTS:NNYP),DDMPVJ(JTS:NNYP))
+    ALLOCATE(KHLA(JAM),KHHA(JAM))
+    ALLOCATE(KVLA(JAM),KVHA(JAM))
+
+!   INITIALIZE SOME LAND/WATER SURFACE DATA ON THE BASIS OF INPUTS: SM, XICE, WEASD, 
+!   INTERPOLATED FROM MOTHER (WRFSI) DOMAIN. THIS PART OF THE CODE HAS TO BE REVISITED
+!   LATER ON
+
+    DO J = JTS, MIN(JTE,JDE-1)
+     DO I = ITS, MIN(ITE,IDE-1)
+      IF(SM(I,J).GT.0.9) THEN           ! OVER WATER SURFACE
+!
+           IF (XICE(I,J) .gt. 0)THEN    ! XICE: SI INPUT ON PARENT, INTERPOLATED ONTO NEST
+             SI(I,J)=1.0                ! INITIALIZE SI BASED ON XICE FROM INTERPOLATED INPUT
+           ENDIF
+!
+           EPSR(I,J)= 0.97              ! VALID OVER SEA SURFACE
+           GFFC(I,J)= 0.
+           ALBEDO(I,J)=.06
+           ALBASE(I,J)=.06
+!
+              IF(SI (I,J) .GT. 0.)THEN  ! VALID OVER SEA-ICE 
+                 SM(I,J)=0.
+                 SI(I,J)=0.             ! 
+                 SICE(I,J)=1.
+                 GFFC(I,J)=0.           ! just leave zero as irrelevant
+                 ALBEDO(I,J)=.60        ! DEFINE ALBEDO 
+                 ALBASE(I,J)=.60
+              ENDIF
+!
+      ELSE                              ! OVER LAND SURFACE
+!
+           SI(I,J)=5.0*WEASD(I,J)/1000. ! SNOW WATER EQ (mm) OBTAINED FROM PARENT (SI) IS INTERPOLATED 
+           EPSR(I,J)=1.0                ! EMISSIVITY DEFINED OVER LAND IN THE NESTED DOMAIN
+           GFFC(I,J)=0.0                ! just leave zero as irrelevant
+           SICE(I,J)=0.                 ! SEA ICE
+           SNO(I,J)=SI(I,J)*.20         ! LAND-SNOW COVER 
+!
+      ENDIF
+!
+     ENDDO
+    ENDDO
+
+!   This may just be a fix and may need some Registry related changes, later on
+
+    DO J = JTS, MIN(JTE,JDE-1)
+     DO I = ITS, MIN(ITE,IDE-1)
+         VEGFRA(I,J)=VEGFRC(I,J)
+     ENDDO
+    ENDDO
+
+!   DETERMINE ALBEDO OVER LAND ON THE BASIS OF INPUTS: SM, ALBASE, MXSNAL & VEGFRA
+!   INTERPOLATED FROM MOTHER (WRFSI) DOMAIN
+
+ 
+    DO J = JTS, MIN(JTE,JDE-1) 
+     DO I = ITS, MIN(ITE,IDE-1)
+
+          IF(SM(I,J).LT.0.9.AND.SICE(I,J).LT.0.9) THEN
+!
+            IF ( (SNO(I,J) .EQ. 0.0) .OR. &            ! SNOWFREE ALBEDO
+                           (ALBASE(I,J) .GE. MXSNAL(I,J) ) ) THEN
+              ALBEDO(I,J) = ALBASE(I,J)
+            ELSE
+              IF (SNO(I,J) .LT. SNUP) THEN             ! MODIFY ALBEDO IF SNOWCOVER:
+                  RSNOW = SNO(I,J)/SNUP                ! BELOW SNOWDEPTH THRESHOLD
+                  SNOFAC = 1. - ( EXP(-SALP*RSNOW) - RSNOW*EXP(-SALP))
+              ELSE
+                  SNOFAC = 1.0                         ! ABOVE SNOWDEPTH THRESHOLD
+              ENDIF
+              ALBEDO(I,J) = ALBASE(I,J) &
+                          + (1.0-VEGFRA(I,J))*SNOFAC*(MXSNAL(I,J)-ALBASE(I,J))
+            ENDIF
+!
+          END IF
+
+          SI(I,J)=5.0*WEASD(I,J)
+          SNO(I,J)=WEASD(I,J)
+! this block probably superfluous.  Meant to guarantee land/sea agreement
+
+        IF (SM(I,J) .gt. 0.5)THEN 
+           landmask(I,J)=0.0
+        ELSE 
+           landmask(I,J)=1.0
+        ENDIF 
+
+        IF (SICE(I,J) .eq. 1.0) then !!!! change vegtyp and sltyp to fit seaice (desireable??)
+         ISLTYP(I,J)=16
+         IVGTYP(I,J)=24
+        ENDIF 
+
+     ENDDO
+    ENDDO
+
+!  Check land water interface
+
+    DO J = JTS, MIN(JTE,JDE-1)
+     DO I = ITS,MIN(ITE,IDE-1)
+      IF(SM(I,J).GT.0.9 .AND. VEGFRA(I,J) .NE. 0) THEN
+        WRITE(20,*)'PROBLEM AT THE LAND-WATER INTERFACE:',I,J,SM(I-1,J),VEGFRA(I-1,j),SM(I,J),VEGFRA(I,J)
+      ENDIF
+!
+      IF(SM(I,J).GT.0.9 .AND. NMM_TSK(I,J) .NE. 0) THEN
+        WRITE(20,*)'PROBLEM AT THE LAND-WATER INTERFACE:',I,J,SM(I-1,J),NMM_TSK(I-1,J),SM(I,J),NMM_TSK(I,J)
+      ENDIF
+     ENDDO
+    ENDDO
+
+
+!   hardwire root depth for time being
+
+        RTDPTH=0.
+        RTDPTH(1)=0.1
+        RTDPTH(2)=0.3
+        RTDPTH(3)=0.6
+
+!   hardwire soil depth for time being
+
+        SLDPTH=0.
+        SLDPTH(1)=0.1
+        SLDPTH(2)=0.3
+        SLDPTH(3)=0.6
+        SLDPTH(4)=1.0
+
+!-----------  END OF LAND SURFACE INITIALIZATION -------------------------------------
+!
+!   INITIALIZE 3D HEIGHT MASK AND VELOCITY FIELDS (HTM AND VTM),
+!   AND LOWEST ABV GROUND LEVEL (LMH AND LMV) AND RECIPROCAL 
+!   ETAS (RES) OVER THE NESTED DOMAIN  
+
+
+    DO J = JTS, MIN(JTE,JDE-1)
+     DO K = KTS,KTE
+      DO I = ITS, MIN(ITE,IDE-1)
+       HTM(I,K,J)=1.0
+       VTM(I,K,J)=1.0
+      ENDDO
+     ENDDO
+    ENDDO
+
+    DO J = JTS, MIN(JTE,JDE-1)
+     DO I = ITS, MIN(ITE,IDE-1)
+       LMH(I,J)= KME-1        ! note the flipping for start_domain_nmm.F
+       LMV(I,J)= KME-1        ! this is consistent with Tom's version
+       RES(I,J)=1.
+     ENDDO
+    ENDDO
+
+!   INITIALIZE 2D BOUNDARY MASKS
+
+!! HBM2:
+ 
+    HBM2=0.
+    DO J = JTS, MIN(JTE,JDE-1)
+      DO I = ITS, MIN(ITE,IDE-1)
+       IF((J .GE. 3 .and. J .LE. (JDE-1)-2) .AND.   &
+          (I .GE. 2 .and. I .LE. (IDE-1)-2+MOD(J,2))) THEN
+          HBM2(I,J)=1.
+        ENDIF
+      ENDDO
+    ENDDO   
+
+!! HBM3:
+
+    HBM3=0.
+    DO J=JTS,MIN(JTE,JDE-1)
+     IHWG(J)=mod(J+1,2)-1
+      IF (J .ge. 4 .and. J .le. (JDE-1)-3) THEN
+        IHL=(IDS+1)-IHWG(J) 
+        IHH=(IDE-1)-2
+        DO I=ITS,MIN(ITE,IDE-1)
+           IF (I .ge. IHL  .and. I .le. IHH) HBM3(I,J)=1.
+        ENDDO 
+      ENDIF
+    ENDDO 
+   
+!! VBM2
+
+    VBM2=0.
+    DO J=JTS,MIN(JTE,JDE-1)
+     DO I=ITS,MIN(ITE,IDE-1)
+       IF((J .ge. 3 .and. J .le. (JDE-1)-2)  .AND.  &
+          (I .ge. 2 .and. I .le. (IDE-1)-1-MOD(J,2))) THEN
+           VBM2(I,J)=1.
+       ENDIF
+     ENDDO
+    ENDDO
+
+!! VBM3
+
+    VBM3=0.
+    DO J=JTS,MIN(JTE,JDE-1)
+      DO I=ITS,MIN(ITE,IDE-1)
+        IF((J .ge. 4 .and. J .le. (JDE-1)-3)  .AND.  &
+           (I .ge. 3-MOD(J,2) .and. I .le. (IDE-1)-2)) THEN
+           VBM3(I,J)=1.
+        ENDIF
+      ENDDO
+    ENDDO
+
+    TPH0D  = grid%CEN_LAT
+    TLM0D  = grid%CEN_LON
+    TPH0   = TPH0D*DTR
+    WBD    = grid%WBD0   ! gopal's doing: may use Registry WBD0 now
+    WB     = WBD*DTR
+    SBD    = grid%SBD0   ! gopal's doing: may use Registry SBD0 now
+    SB     = SBD*DTR
+    DLM    = DLMD*DTR  ! input now from med_nest_egrid_configure
+    DPH    = DPHD*DTR  ! input now from med_nest_egrid_configure
+    TDLM   = DLM+DLM
+    TDPH   = DPH+DPH
+    WBI    = WB+TDLM
+    SBI    = SB+TDPH
+    EBI    = WB+((ide-1)-2)*TDLM  ! gopal's doing: check this for nested domain
+    ANBI   = SB+((jde-1)-3)*DPH   ! gopal's doing: check this for nested domain
+    STPH0  = SIN(TPH0)
+    CTPH0  = COS(TPH0)
+    TSPH   = 3600./grid%DT
+    DTAD   = 1.0
+    DTCF   = 4.0    
+    DY_NMM0= DY_NMM ! ERAD*DPH; input now from med_nest_egrid_configure
+
+!   CORIOLIS PARAMETER  (There appears to be some roundoff in computing TLM & STPH and other terms,
+!   in the nested domain. The problem needs to be revisited
+
+    DO J=JTS,MIN(JTE,JDE-1)
+      TLM0=WB-TDLM+MOD(J,2)*DLM           ! remember this is a wind point
+      TPH =SB+float(J-1)*DPH
+      STPH=SIN(TPH)
+      CTPH=COS(TPH)
+      DO I=ITS,MIN(ITE,IDE-1)
+         TLM=TLM0 + I*TDLM
+         FP=TWOM*(CTPH0*STPH+STPH0*CTPH*COS(TLM))
+         F(I,J)=0.5*grid%DT*FP
+      ENDDO
+    ENDDO
+
+
+    DO J=JTS,MIN(JTE,JDE-1)
+      KHL2(J)=(IDE-1)*(J-1)-(J-1)/2+2
+      KVL2(J)=(IDE-1)*(J-1)-J/2+2
+      KHH2(J)=(IDE-1)*J-J/2-1
+      KVH2(J)=(IDE-1)*J-(J+1)/2-1
+    ENDDO
+
+
+    TPH=SB-DPH
+    DO J=JTS,MIN(JTE,JDE-1)
+      TPH=SB+float(J-1)*DPH
+      DXP=ERAD*DLM*COS(TPH)
+      DXJ(J)=DXP
+      WPDARJ(J)=-W_NMM*((ERAD*DLM*AMIN1(COS(ANBI),COS(SBI)))**2+DY_NMM0**2)/  & 
+                (grid%DT*32.*DXP*DY_NMM0)
+      CPGFUJ(J)=-grid%DT/(48.*DXP)
+      CURVJ(J)=.5*grid%DT*TAN(TPH)/ERAD
+      FCPJ(J)=grid%DT/(CP*192.*DXP*DY_NMM0)
+      FDIVJ(J)=1./(12.*DXP*DY_NMM0)
+      FADJ(J)=-grid%DT/(48.*DXP*DY_NMM0)*DTAD
+      ACDT=grid%DT*SQRT((ERAD*DLM*AMIN1(COS(ANBI),COS(SBI)))**2+DY_NMM0**2)
+      CDDAMP=CODAMP*ACDT
+      HDACJ(J)=COAC*ACDT/(4.*DXP*DY_NMM0)
+      DDMPUJ(J)=CDDAMP/DXP
+      DDMPVJ(J)=CDDAMP/DY_NMM0
+    ENDDO
+
+! --------------DERIVED VERTICAL GRID CONSTANTS--------------------------
+
+     WRITE(0,*)'NEW CHANGE',F4D,EF4T,F4Q
+
+      DO L=KDS,KDE-1
+        RDETA(L)=1./DETA(L)
+        F4Q2(L)=-.25*grid%DT*DTAD/DETA(L)
+      ENDDO
+
+       DO J=JTS,MIN(JTE,JDE-1)
+        DO I=ITS,MIN(ITE,IDE-1)
+          DX_NMM(I,J)=DXJ(J)
+          WPDAR(I,J)=WPDARJ(J)*HBM2(I,J)
+          CPGFU(I,J)=CPGFUJ(J)*VBM2(I,J)
+          CURV(I,J)=CURVJ(J)*VBM2(I,J)
+          FCP(I,J)=FCPJ(J)*HBM2(I,J)
+          FDIV(I,J)=FDIVJ(J)*HBM2(I,J)
+          FAD(I,J)=FADJ(J)
+          HDACV(I,J)=HDACJ(J)*VBM2(I,J)
+          HDAC(I,J)=HDACJ(J)*1.25*HBM2(I,J)
+        ENDDO
+       ENDDO
+
+       DO J=JTS, MIN(JTE,JDE-1)
+        IF (J.LE.5.OR.J.GE.(JDE-1)-4) THEN
+          KHH=(IDE-1)-2+MOD(J,2) ! KHH is global...loop over I that have
+          DO I=ITS,MIN(ITE,IDE-1)
+             IF (I .ge. 2 .and. I .le. KHH) THEN
+               HDAC(I,J)=HDAC(I,J)* DFC
+             ENDIF
+          ENDDO
+        ELSE
+          KHH=2+MOD(J,2)
+          DO I=ITS,MIN(ITE,IDE-1)
+             IF (I .ge. 2 .and. I .le. KHH) THEN
+               HDAC(I,J)=HDAC(I,J)* DFC
+             ENDIF
+          ENDDO
+          KHH=(IDE-1)-2+MOD(J,2)
+
+          DO I=ITS,MIN(ITE,IDE-1)
+             IF (I .ge. (IDE-1)-2 .and. I .le. KHH) THEN
+               HDAC(I,J)=HDAC(I,J)* DFC
+             ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+
+      DO J=JTS,min(JTE,JDE-1)
+      DO I=ITS,min(ITE,IDE-1)
+        DDMPU(I,J)=DDMPUJ(J)*VBM2(I,J)
+        DDMPV(I,J)=DDMPVJ(J)*VBM2(I,J)
+        HDACV(I,J)=HDACV(I,J)*VBM2(I,J)
+      ENDDO
+      ENDDO
+
+! --------------INCREASING DIFFUSION ALONG THE BOUNDARIES----------------
+
+        DO J=JTS,MIN(JTE,JDE-1)
+        IF (J.LE.5.OR.J.GE.JDE-1-4) THEN
+          KVH=(IDE-1)-1-MOD(J,2)
+          DO I=ITS,MIN(ITE,IDE-1)
+            IF (I .ge. 2 .and.  I .le. KVH) THEN
+             DDMPU(I,J)=DDMPU(I,J)*DDFC
+             DDMPV(I,J)=DDMPV(I,J)*DDFC
+             HDACV(I,J)=HDACV(I,J)*DFC
+            ENDIF
+          ENDDO
+        ELSE
+          KVH=3-MOD(J,2)
+          DO I=ITS,MIN(ITE,IDE-1)
+           IF (I .ge. 2 .and.  I .le. KVH) THEN
+            DDMPU(I,J)=DDMPU(I,J)*DDFC
+            DDMPV(I,J)=DDMPV(I,J)*DDFC
+            HDACV(I,J)=HDACV(I,J)*DFC
+           ENDIF
+          ENDDO
+          KVH=(IDE-1)-1-MOD(J,2)
+          DO I=ITS,MIN(ITE,IDE-1)
+           IF (I .ge. IDE-1-2 .and. I .le. KVH) THEN
+            DDMPU(I,J)=DDMPU(I,J)*DDFC
+            DDMPV(I,J)=DDMPV(I,J)*DDFC
+            HDACV(I,J)=HDACV(I,J)*DFC
+           ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+
+! This one was left over for nested domain
+ 
+     DO J = JTS, MIN(JTE,JDE-1)
+       DO I = ITS, MIN(ITE,IDE-1)
+          GLAT(I,J)=HLAT(I,J)*DTR
+          GLON(I,J)=HLON(I,J)*DTR
+       ENDDO
+     ENDDO
+
+!!   compute EMT, EM on global domain, and only on task 0.
+
+!    IF (wrf_dm_on_monitor()) THEN   !!!! NECESSARY TO LIMIT THIS TO TASK ZERO?
+      
+     ALLOCATE(EMJ(JDS:JDE-1),EMTJ(JDS:JDE-1))
+     write(0,*) 'FIGURING OUT EMJ, EMTJ ', JDS, JDE-1
+     DO J=JDS,JDE-1
+       TPH=SB+float(J-1)*DPH
+       DXP=ERAD*DLM*COS(TPH)
+       EMJ(J)= grid%DT/( 4.*DXP)*DTAD
+       EMTJ(J)=grid%DT/(16.*DXP)*DTAD
+!       write(0,*) 'J, EMTJ(J): ', J, EMTJ(J)
+     ENDDO
+
+          JA=0
+          DO 161 J=3,5
+          JA=JA+1
+          KHLA(JA)=2
+          KHHA(JA)=(IDE-1)-1-MOD(J+1,2)
+ 161      EMT(JA)=EMTJ(J)
+          DO 162 J=(JDE-1)-4,(JDE-2)-2
+          JA=JA+1
+          KHLA(JA)=2
+          KHHA(JA)=(IDE-1)-1-MOD(J+1,2)
+ 162      EMT(JA)=EMTJ(J)
+          DO 163 J=6,(JDE-1)-5
+          JA=JA+1
+          KHLA(JA)=2
+          KHHA(JA)=2+MOD(J,2)
+ 163      EMT(JA)=EMTJ(J)
+          DO 164 J=6,(JDE-1)-5
+          JA=JA+1
+          KHLA(JA)=(IDE-1)-2
+          KHHA(JA)=(IDE-1)-1-MOD(J+1,2)
+ 164      EMT(JA)=EMTJ(J)
+
+! --------------SPREADING OF UPSTREAM VELOCITY-POINT ADVECTION FACTOR----
+
+          JA=0
+          DO 171 J=3,5
+          JA=JA+1
+          KVLA(JA)=2
+          KVHA(JA)=(IDE-1)-1-MOD(J,2)
+ 171      EM(JA)=EMJ(J)
+          DO 172 J=(JDE-1)-4,(JDE-2)-2
+          JA=JA+1
+          KVLA(JA)=2
+          KVHA(JA)=(IDE-1)-1-MOD(J,2)
+ 172      EM(JA)=EMJ(J)
+          DO 173 J=6,(JDE-1)-5
+          JA=JA+1
+          KVLA(JA)=2
+          KVHA(JA)=2+MOD(J+1,2)
+ 173      EM(JA)=EMJ(J)
+          DO 174 J=6,(JDE-1)-5
+          JA=JA+1
+          KVLA(JA)=(IDE-1)-2
+          KVHA(JA)=(IDE-1)-1-MOD(J,2)
+ 174      EM(JA)=EMJ(J)
+
+!        ENDIF ! wrf_dm_on_monitor
+
+!! must be a better place to put this, but will eliminate "phantom"
+!! wind points here (no wind point on eastern boundary of odd numbered rows)
+!!
+                                                                !   phantom
+        IF (ABS(IDE-1-ITE) .eq. 1 ) THEN                        !      | 
+         WRITE(0,*)'zero phantom winds'                         !  H  [x]    H    V
+         DO K=KDS,KDE-1                                         !  
+          DO J=JDS,JDE-1,2                                      !  V  [H]    V    H
+           IF (J .ge. JTS .and. J .le. JTE) THEN                !
+             U(IDE-1,K,J)=0.                                    !  H  [x]    H    V
+             V(IDE-1,K,J)=0.                                    !  ------    ------  
+           ENDIF                                                !   ide-1      ide
+          ENDDO                                                 !   NMM/SI     WRF
+         ENDDO                                                  !   domain    domain
+        ENDIF                                                   !             (dummy)   
+
+
+! just a test for gravity waves
+
+!  PD=62000.
+!   U=0.0
+!   V=0.0
+!   T=300.
+!   Q=0.0
+!   Q2=0.0
+!   CWM=0.0
+!   FIS=0.0
+
+! testx
+!  DO J = JTS, MIN(JTE,JDE-1)
+!   DO K = KTS,KTE
+!    DO I = ITS, MIN(ITE,IDE-1)
+!      SM(I,J)=I
+!       U(I,K,J)=J
+!    ENDDO
+!   ENDDO
+!  ENDDO
+!
+
+!   deallocs
+
+    DEALLOCATE(KHL2,KVL2,KHH2,KVH2)
+    DEALLOCATE(DXJ,WPDARJ,CPGFUJ,CURVJ)
+    DEALLOCATE(FCPJ,FDIVJ,FADJ)
+    DEALLOCATE(HDACJ,DDMPUJ,DDMPVJ)
+    DEALLOCATE(KHLA,KHHA)
+    DEALLOCATE(KVLA,KVHA)
+
+
+END SUBROUTINE med_initialize_nest_nmm
+!======================================================================
+
+      subroutine smdhld(ime,jme,h,s,lines,nsmud)
+      dimension ihw(jme),ihe(jme)
+      dimension h(ime,jme),s(ime,jme) &
+     &         ,hbms(ime,jme),hne(ime,jme),hse(ime,jme)
+!-----------------------------------------------------------------------
+          do j=1,jme
+      ihw(j)=-mod(j,2)
+      ihe(j)=ihw(j)+1
+          enddo
+!-----------------------------------------------------------------------
+
+              do j=1,jme
+          do i=1,ime
+      hbms(i,j)=1.-s(i,j)
+          enddo
+              enddo
+!
+      jmelin=jme-lines+1
+      ibas=lines/2
+      m2l=mod(lines,2)
+!
+              do j=lines,jmelin
+          ihl=ibas+mod(j,2)+m2l*mod(j+1,2)
+          ihh=ime-ibas-m2l*mod(j+1,2)
+
+!       write(6,*) 'no smooth limits for J: ', J, 'are  ', ihl,ihh
+!
+          do i=ihl,ihh
+      hbms(i,j)=0.
+          enddo
+              enddo
+!-----------------------------------------------------------------------
+                  do ks=1,nsmud
+
+                write(6,*) 'H(1,1): ', h(1,1)
+                write(6,*) 'H(3,1): ', h(1,1)
+!-----------------------------------------------------------------------
+              do j=1,jme-1
+          do i=1,ime-1
+      hne(i,j)=h(i+ihe(j),j+1)-h(i,j)
+          enddo
+              enddo
+              do j=2,jme
+          do i=1,ime-1
+      hse(i,j)=h(i+ihe(j),j-1)-h(i,j)
+          enddo
+              enddo
+!
+              do j=2,jme-1
+          do i=1+mod(j,2),ime-1
+      h(i,j)=(hne(i,j)-hne(i+ihw(j),j-1) &
+     &       +hse(i,j)-hse(i+ihw(j),j+1))*hbms(i,j)*0.125+h(i,j)
+          enddo
+              enddo
+!-----------------------------------------------------------------------
+
+!!!         smooth around boundary somehow?
+
+!       special treatment for four corners
+
+        if (hbms(1,1) .eq. 1) then
+        h(1,1)=0.75*h(1,1)+0.125*h(1+ihe(1),2)+ &
+     &                            0.0625*(h(2,1)+h(1,3))
+        endif
+
+        if (hbms(ime,1) .eq. 1) then
+        h(ime,1)=0.75*h(ime,1)+0.125*h(ime+ihw(1),2)+ &
+     &                            0.0625*(h(ime-1,1)+h(ime,3))
+        endif
+
+        if (hbms(1,jme) .eq. 1) then
+        h(1,jme)=0.75*h(1,jme)+0.125*h(1+ihe(jme),jme-1)+ &
+     &                            0.0625*(h(2,jme)+h(1,jme-2))
+        endif
+
+        if (hbms(ime,jme) .eq. 1) then
+        h(ime,jme)=0.75*h(ime,jme)+0.125*h(ime+ihw(jme),jme-1)+ &
+     &                            0.0625*(h(ime-1,jme)+h(ime,jme-2))
+        endif
+
+
+!       S bound
+
+        J=1
+        do I=2,ime-1
+        if (hbms(I,J) .eq. 1) then
+        h(I,J)=0.75*h(I,J)+0.125*(h(I+ihw(J),J+1)+h(I+ihe(J),J+1))
+        endif
+        enddo
+
+!       N bound
+
+        J=JME
+        do I=2,ime-1
+        if (hbms(I,J) .eq. 1) then
+        h(I,J)=0.75*h(I,J)+0.125*(h(I+ihw(J),J-1)+h(I+ihe(J),J-1))
+        endif
+        enddo
+
+!       W bound
+
+        I=1
+        do J=3,jme-2
+        if (hbms(I,J) .eq. 1) then
+        h(I,J)=0.75*h(I,J)+0.125*(h(I+ihe(J),J+1)+h(I+ihe(J),J-1))
+        endif
+        enddo
+
+!       E bound
+
+        I=IME
+        do J=3,jme-2
+        if (hbms(I,J) .eq. 1) then
+        h(I,J)=0.75*h(I,J)+0.125*(h(I+ihw(J),J+1)+h(I+ihw(J),J-1))
+        endif
+        enddo
+
+
+                      enddo   ! end ks loop
+
+!!      (light touch) with 5-point filter over untouched interior?
+
+!       do ks=1,5
+!       do J=lines-1,jme-(lines-1)
+!       do I=lines-1,ime-(lines-1)
+!       if (s(I,J) .eq. 0 .and.
+!     &      h(I,J) .gt. h(i+ihw(J),J+1) .and.
+!     &      h(I,J) .gt. h(I+ihe(J),J+1) .and.
+!     &      h(I,J) .gt. h(i+ihw(J),J-1) .and.
+!     &      h(I,J) .gt. h(I+ihe(J),J-1)) then
+!       write(6,*) 'smoothing topo at I,J...', I,J,H(I,J)
+!       h(I,J)=h(I,J)+0.125*( h(i+ihw(J),J+1) + h(I+ihe(J),J+1) +
+!     &                      h(i+ihw(J),J-1) + h(I+ihe(J),J-1) -
+!     &                       4*h(I,J) )
+!       write(6,*) 'post smoothing val', ks,H(I,J)
+!       endif
+!       enddo
+!       enddo
+!       enddo
+
+!-----------------------------------------------------------------------
+      return
+      end subroutine smdhld
+
+!--------------------------------------------------------------------------------------
+#if 0
+SUBROUTINE initial_nest_pivot ( parent , nest, iloc, jloc )
+
+!==========================================================================================
+!
+! This program produces i_start and j_start for the nested domain depending on the
+! central lat-lon of the storm.
+!
+!==========================================================================================
+
+ USE module_domain
+ USE module_configure
+ USE module_timing
+ USE module_dm 
+
+ IMPLICIT NONE
+ TYPE(domain) , POINTER              :: parent , nest
+ INTEGER, INTENT(OUT)                :: ILOC,JLOC
+ INTEGER                             :: IMS,IME,JMS,JME,KMS,KME
+ INTEGER                             :: IDS,IDE,JDS,JDE,KDS,KDE
+ INTEGER                             :: IMS,IME,JMS,JME,KMS,KME
+ INTEGER                             :: ITS,ITE,JTS,JTE,KTS,KTE
+ INTEGER                             :: NIDE,NJDE              ! nest dimension
+ INTEGER                             :: I,J,ITER,IDUM,JDUM
+ REAL                                :: ALAT,ALON,DIFF1,DIFF2,ERR
+ REAL                                :: parent_CLAT,parent_CLON,parent_SLAT,parent_SLON
+ REAL                                :: parent_WBD,parent_SBD,parent_DLMD,parent_DPHD 
+!========================================================================================
+
+!   First obtain central latitude and longitude for the parent domain
+
+    CALL nl_get_cen_lat (parent%ID, parent_CLAT)
+    CALL nl_get_cen_lon (parent%ID, parent_CLON)
+!    CALL nl_get_storm_lat (parent%ID, parent_SLAT)
+!    CALL nl_get_storm_lon (parent%ID, parent_SLON)
+
+!   Parent grid configuration, including, western and southern boundary
+
+    IDS = parent%sd31
+    IDE = parent%ed31
+    KDS = parent%sd32
+    KDE = parent%ed32
+    JDS = parent%sd33
+    JDE = parent%ed33
+
+    IMS = parent%sm31
+    IME = parent%em31
+    KMS = parent%sm32
+    KME = parent%em32
+    JMS = parent%sm33
+    JME = parent%em33
+
+    ITS  = parent%sp31
+    ITE  = parent%ep31
+    KTS  = parent%sp32
+    KTE  = parent%ep32
+    JTS  = parent%sp33
+    JTE  = parent%ep33
+
+    NIDE = nest%ed31
+    NJDE = nest%ed33
+
+    parent_DLMD = parent%dx          ! DLMD: dlamda in degrees
+    parent_DPHD = parent%dy          ! DPHD: dphi in degrees
+    parent_WBD  = -(IDE-2)*parent%dx ! WBD0: in deg;factor 2 takes care of dummy last column 
+    parent_SBD  = -((JDE-1)/2)*parent%dy ! SBD0: in degrees; note that JDE-1 should be odd 
+    ALAT  = parent_SLAT - 0.5*(NJDE-2)*parent_DPHD/nest%parent_grid_ratio
+    ALON  = parent_SLON - 1.0*(NIDE-2)*parent_DLMD/nest%parent_grid_ratio
+
+!    WRITE(0,*)'ALAT AND ALON=',ALAT,ALON
+
+    CALL EARTH_LATLON ( parent%nmm_HLAT,parent%nmm_HLON,parent%nmm_VLAT,parent%nmm_VLON, & !output
+                        parent_DLMD,parent_DPHD,parent_WBD,parent_SBD,                   & !inputs
+                        parent_CLAT,parent_CLON,                                         &
+                        IDS,IDE,JDS,JDE,KDS,KDE,                                         &
+                        IMS,IME,JMS,JME,KMS,KME,                                         &
+                        ITS,ITE,JTS,JTE,KTS,KTE                          )
+
+!   start iteration
+
+      ILOC=-99
+      JLOC=-99
+      ERR=0.1
+      ITER=1
+100   CONTINUE
+
+     DO J = JTS,min(JTE,JDE-1)
+      DO I = ITS,min(ITE,IDE-1)
+        DIFF1 = ABS(ALAT - parent%nmm_HLAT(I,J))
+        DIFF2 = ABS(ALON - parent%nmm_HLON(I,J))
+        IF(DIFF1 .LE. ERR .AND. DIFF2 .LE. ERR)THEN
+         ILOC=I
+         JLOC=J
+!         WRITE(0,*)'ITERATED',ERR,ITER,I,J,parent%nmm_HLAT(I,J),ALAT,parent%nmm_HLON(I,J),ALON
+        ENDIF
+      ENDDO
+     ENDDO
+
+     CALL wrf_dm_maxval_integer ( ILOC, idum, jdum )
+     CALL wrf_dm_maxval_integer ( JLOC, idum, jdum ) 
+
+     IF(ILOC .EQ. -99 .AND. JLOC .EQ. -99)THEN
+       ERR=ERR+0.1
+       ITER=ITER+1
+       IF(ITER .LE. 100)GO TO 100
+     ENDIF
+
+     IF(ILOC .NE. -99 .AND. JLOC .NE. -99)THEN
+       WRITE(0,*)'NOTE: I_PARENT_START AND J_PARENT_START FOUND FOR THE NESTED DOMAIN CONFIGURATION AT ITER=',ITER
+       WRITE(0,*)'istart=',ILOC
+       WRITE(0,*)'jstart=',JLOC
+     ELSE
+       ILOC=IDE/3
+       JLOC=JDE/3
+!
+       WRITE(0,*)'WARNING: COULD NOT LOCATE I_PARENT_START AND J_PARENT_START FROM INPUT STORM INFO'
+       WRITE(0,*)'ISTART=',IDE/3
+       WRITE(0,*)'JSTART=',JDE/3
+     ENDIF
+
+     RETURN
+END SUBROUTINE initial_nest_pivot
+
+!============================================================================================
+#endif
+
+LOGICAL FUNCTION nmm_cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, xstag, ystag )
+   INTEGER, INTENT(IN) :: pig, ips_save, ipe_save , pjg, jps_save, jpe_save
+   LOGICAL, INTENT(IN) :: xstag, ystag
+
+   INTEGER ioff, joff
+
+   ioff = 0 ; joff = 0
+   IF ( xstag  ) ioff = 1
+   IF ( ystag  ) joff = 1
+
+   nmm_cd_feedback_mask = ( pig .ge. ips_save+1        .and.      &
+                            pjg .ge. jps_save+1        .and.      &
+                            pig .le. ipe_save-1  +ioff .and.      &
+                            pjg .le. jpe_save-1  +joff           )
+
+END FUNCTION nmm_cd_feedback_mask
+
+!----------------------------------------------------------------------------
+#else
+SUBROUTINE stub_nmm_nest_stub
+END SUBROUTINE stub_nmm_nest_stub
+#endif
+
+RECURSIVE SUBROUTINE find_ijstart_level ( grid, i_start, j_start, level )
+
+! Dusan Jovic
+
+   USE module_domain
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(domain) :: grid
+   INTEGER, INTENT (OUT) :: i_start, j_start, level
+   INTEGER :: iadd
+
+      if (grid%parent_id == 0 ) then
+         i_start = 1
+         j_start = 1
+         level = 0
+      else
+         call find_ijstart_level ( grid%parents(1)%ptr, i_start, j_start, level )
+         if (level > 0) then
+             iadd = (i_start-1)*3
+             if ( mod(j_start,2).ne.0 .and. mod(grid%j_parent_start,2).ne.0 ) iadd = iadd - 1
+             if ( mod(j_start,2).eq.0 .and. mod(grid%j_parent_start,2).eq.0 ) iadd = iadd + 2
+         else
+             iadd = -mod(grid%j_parent_start,2)
+         end if
+         i_start = iadd + grid%i_parent_start*3 - 1
+         j_start = ( (j_start-1) + (grid%j_parent_start-1) ) * 3 + 1
+         level = level + 1
+      end if
+
+END SUBROUTINE find_ijstart_level
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/RDTEMP.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/RDTEMP.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/RDTEMP.F	(revision 2744)
@@ -0,0 +1,139 @@
+!
+!NCEP_MESO:MODEL_LAYER: PHYSICS
+!
+!***********************************************************************
+      SUBROUTINE RDTEMP(NTSD,DT,JULDAY,JULYR,IHRST,GLAT,GLON            &
+     &                 ,CZEN,CZMEAN,T,RSWTT,RLWTT,HTM,HBM2              &
+     &                 ,IDS,IDE,JDS,JDE,KDS,KDE                         &
+     &                 ,IMS,IME,JMS,JME,KMS,KME                         &
+     &                 ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    RDTEMP      RADIATIVE TEMPERATURE CHANGE
+!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 93-12-29
+!     
+! ABSTRACT:
+!     RDTEMP APPLIES THE TEMPERATURE TENDENCIES DUE TO
+!     RADIATION AT ALL LAYERS AT EACH ADJUSTMENT TIME STEP
+!     
+! PROGRAM HISTORY LOG:
+!   87-09-??  BLACK      - ORIGINATOR
+!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   95-11-20  ABELES     - PARALLEL OPTIMIZATION
+!   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
+!   02-06-07  BLACK      - WRF CODING STANDARDS
+!   02-09-09  WOLFE      - CONVERTING TO GLOBAL INDEXING
+!     
+! USAGE: CALL RDTEMP FROM SUBROUTINE SOLVE_RUNSTREAM
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!-----------------------------------------------------------------------
+      USE MODULE_MPP
+      USE MODULE_RA_GFDLETA,ONLY : CAL_MON_DAY,ZENITH
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: IHRST,JULDAY,JULYR,NTSD
+!
+      REAL,INTENT(IN) :: DT
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CZMEAN,GLAT,GLON    &
+     &                                             ,HBM2
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM         &
+     &                                                     ,RLWTT       &
+     &                                                     ,RSWTT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: T
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CZEN
+!
+!-----------------------------------------------------------------------
+!***  LOCAL VARIABLES
+!-----------------------------------------------------------------------
+!
+      INTEGER :: I,J,JDAY,JMONTH,K
+!
+      INTEGER,DIMENSION(3) :: IDAT
+!
+      REAL :: DAYI,HOUR,TIMES,TTNDKL
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: CZEN2,XLAT2,XLON2
+!
+      REAL,DIMENSION(ITS:ITE,JTS:JTE) :: FACTR
+!
+      REAL :: DEGRAD=3.1415926/180.
+      real :: xlat1,xlon1
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      MYIS=MAX(IDS,ITS)
+      MYIE=MIN(IDE,ITE)
+      MYJS=MAX(JDS,JTS)
+      MYJE=MIN(JDE,JTE)
+!-----------------------------------------------------------------------
+!
+!***  GET CURRENT VALUE OF COS(ZENITH ANGLE)
+!
+      TIMES=NTSD*DT
+!
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+        XLAT2(I,J)=GLAT(I,J)
+        XLON2(I,J)=GLON(I,J)
+!!!!!!!!!!!!Remove the following lines after bit-correct answers
+!!!!!!!!!!!!are established with the control
+!       xlat1=glat(i,j)/degrad
+!       xlat2(i,j)=xlat1*degrad
+!       xlon1=glon(i,j)/degrad
+!       xlon2(i,j)=xlon1*degrad
+!!!!!!!!!!!!
+!!!!!!!!!!!!
+      ENDDO
+      ENDDO
+!
+      CALL CAL_MON_DAY(JULDAY,JULYR,JMONTH,JDAY)
+
+      IDAT(1)=JMONTH
+      IDAT(2)=JDAY
+      IDAT(3)=JULYR
+!
+      CALL ZENITH(TIMES,DAYI,HOUR,IDAT,IHRST,XLON2,XLAT2,CZEN2          &
+     &           ,MYIS,MYIE,MYJS,MYJE                                   &
+     &           ,IDS,IDE,JDS,JDE,KDS,KDE                               &
+     &           ,IMS,IME,JMS,JME,KMS,KME                               &
+     &           ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+        CZEN(I,J)=CZEN2(I,J)
+        IF(CZMEAN(I,J).GT.0.)THEN 
+          FACTR(I,J)=CZEN(I,J)/CZMEAN(I,J)
+        ELSE
+          FACTR(I,J)=0.
+        ENDIF
+      ENDDO
+      ENDDO
+!
+      DO J=MYJS,MYJE
+        DO K=KTS,KTE
+        DO I=MYIS,MYIE
+          TTNDKL=RSWTT(I,K,J)*FACTR(I,J)+RLWTT(I,K,J)
+          T(I,K,J)=T(I,K,J)+TTNDKL*DT*HTM(I,K,J)*HBM2(I,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      END SUBROUTINE RDTEMP
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/adve_optim.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/adve_optim.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/adve_optim.h	(revision 2744)
@@ -0,0 +1,1173 @@
+!*********************************************************************** 
+      SUBROUTINE ADVE(NTSD,DT,DETA1,DETA2,PDTOP                         &
+     &               ,CURV,F,FAD,F4D,EM_LOC,EMT_LOC,EN,ENT,DX,DY        &
+     &               ,HTM,HBM2,VTM,VBM2,LMH,LMV                         &
+     &               ,T,U,V,PDSLO,TOLD,UOLD,VOLD                        &
+     &               ,PETDT,UPSTRM                                      &
+     &               ,FEW,FNS,FNE,FSE                                   &
+     &               ,ADT,ADU,ADV                                       &
+     &               ,N_IUP_H,N_IUP_V                                   &
+     &               ,N_IUP_ADH,N_IUP_ADV                               &
+     &               ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                       &
+     &               ,IHE,IHW,IVE,IVW,INDX3_WRK                         &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &               ,IMS,IME,JMS,JME,KMS,KME                           &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    ADVE        HORIZONTAL AND VERTICAL ADVECTION
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 93-10-28       
+!     
+! ABSTRACT:
+!     ADVE CALCULATES THE CONTRIBUTION OF THE HORIZONTAL AND VERTICAL
+!     ADVECTION TO THE TENDENCIES OF TEMPERATURE AND WIND AND THEN
+!     UPDATES THOSE VARIABLES.
+!     THE JANJIC ADVECTION SCHEME FOR THE ARAKAWA E GRID IS USED
+!     FOR ALL VARIABLES INSIDE THE FIFTH ROW.  AN UPSTREAM SCHEME
+!     IS USED ON ALL VARIABLES IN THE THIRD, FOURTH, AND FIFTH
+!     OUTERMOST ROWS.  THE ADAMS-BASHFORTH TIME SCHEME IS USED.
+!     
+! PROGRAM HISTORY LOG:
+!   87-06-??  JANJIC     - ORIGINATOR
+!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   96-03-28  BLACK      - ADDED EXTERNAL EDGE
+!   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
+!   99-07-    JANJIC     - CONVERTED TO ADAMS-BASHFORTH SCHEME
+!                          COMBINING HORIZONTAL AND VERTICAL ADVECTION
+!   02-02-04  BLACK      - ADDED VERTICAL CFL CHECK
+!   02-02-05  BLACK      - CONVERTED TO WRF FORMAT
+!   02-08-29  MICHALAKES - CONDITIONAL COMPILATION OF MPI
+!                          CONVERT TO GLOBAL INDEXING
+!   02-09-06  WOLFE      - MORE CONVERSION TO GLOBAL INDEXING
+!   04-05-29  JANJIC,BLACK - CRANK-NICHOLSON VERTICAL ADVECTION
+!     
+! USAGE: CALL ADVE FROM SUBROUTINE SOLVE_RUNSTREAM
+!   INPUT ARGUMENT LIST:
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V          &
+     &                                        ,N_IUP_ADH,N_IUP_ADV
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V      &
+     &                                                ,IUP_ADH,IUP_ADV  &
+     &                                                ,LMH,LMV
+!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      REAL,INTENT(IN) :: DT,DY,EN,ENT,F4D,PDTOP
+!
+      REAL,DIMENSION(NMM_MAX_DIM),INTENT(IN) :: EM_LOC,EMT_LOC
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CURV,DX,F,FAD,HBM2  &
+     &                                             ,PDSLO,VBM2
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: T,TOLD   &
+     &                                                        ,U,UOLD   &
+     &                                                        ,V,VOLD
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: ADT,ADU    &
+     &                                                      ,ADV        &
+     &                                                      ,FEW,FNE    &
+     &                                                      ,FNS,FSE
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      LOGICAL :: UPSTRM
+!
+      INTEGER :: I,IEND,IFP,IFQ,II,IPQ,ISP,ISQ,ISTART                   &
+     &          ,IUP_ADH_J,IVH,IVL                                      &
+     &          ,J,J1,JA,JAK,JEND,JGLOBAL,JJ,JKNT,JP2,JSTART            &
+     &          ,K,KNTI_ADH,KSTART,KSTOP,LMHK,LMVK                      &
+     &          ,N,N_IUPH_J,N_IUPADH_J,N_IUPADV_J
+!
+      INTEGER :: MY_IS_GLB,MY_IE_GLB,MY_JS_GLB,MY_JE_GLB
+!
+      INTEGER :: J0_P3,J0_P2,J0_P1,J0_00,J0_M1,J1_P2,J1_P1,J1_00,J1_M1  &
+     &          ,J2_P1,J2_00,J2_M1,J3_P2,J3_P1,J3_00                    &
+     &          ,J4_P1,J4_00,J4_M1,J5_00,J5_M1,J6_P1,J6_00
+!
+      INTEGER,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: ISPA,ISQA
+!
+      REAL :: ARRAY3_X,CFT,CFU,CFV,CMT,CMU,CMV                          &
+     &       ,DPDE_P3,DTE,DTQ                                           &
+     &       ,F0,F1,F2,F3,FEW_00,FEW_P1,FNE_X,FNS_P1,FNS_X,FPP,FSE_X    &
+     &       ,HM,PDOP,PDOPU,PDOPV,PP                                    &
+     &       ,PVVLO,PVVLOU,PVVLOV,PVVUP,PVVUPU,PVVUPV                   &
+     &       ,QP,RDP,RDPD,RDPDX,RDPDY,RDPU,RDPV                         &
+     &       ,T_UP,TEMPA,TEMPB,TTA,TTB,U_UP,UDY_P1,UDY_X                &
+     &       ,VXD_X,VDX_P2,V_UP,VDX_X,VM,VTA,VUA,VVA                    &
+     &       ,VVLO,VVLOU,VVLOV,VVUP,VVUPU,VVUPV
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: ARRAY0,ARRAY1              &
+     &                                      ,ARRAY2,ARRAY3              &
+     &                                      ,VAD_TEND_T,VAD_TEND_U      &
+     &                                      ,VAD_TEND_V
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: TEW,UEW,VEW
+!
+      REAL,DIMENSION(KTS:KTE) :: CRT,CRU,CRV,DETA1_PDTOP                &
+     &                          ,RCMT,RCMU,RCMV,RSTT,RSTU,RSTV,TN,UN    &
+     &                          ,VAD_TNDX_T,VAD_TNDX_U,VAD_TNDX_V,VN
+!
+      REAL,DIMENSION(ITS-5:ITE+5,-1:1) :: PETDTK
+!
+      REAL,DIMENSION(ITS-5:ITE+5) :: TDN,UDN,VDN
+!
+!-----------------------------------------------------------------------
+!
+!***  TYPE 0 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-3:3) :: DPDE
+!
+!***  TYPE 1 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-2:2) :: TST,UDY,UST,VDX,VST
+!
+!***  TYPE 4 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-1:1) :: TNS,UNS,VNS
+!
+!***  TYPE 5 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-1:0) :: TNE,UNE,VNE
+!
+!***  TYPE 6 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME, 0:1) :: TSE,USE,VSE
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***********************************************************************
+!
+!                         DPDE      -----  3
+!                          |                      J Increasing
+!                          |                        
+!                          |                            ^
+!                         FNS       -----  2            |
+!                          |                            |
+!                          |                            |
+!                          |                            |
+!                         VNS       -----  1            |
+!                          |
+!                          |
+!                          |
+!                         ADV       -----  0  ------> Current J
+!                          |
+!                          |
+!                          |
+!                         VNS       ----- -1
+!                          |
+!                          |
+!                          |
+!                         FNS       ----- -2
+!                          |
+!                          |
+!                          |
+!                         DPDE      ----- -3
+!
+!***********************************************************************
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      ISTART=MYIS_P2
+      IEND=MYIE_P2 
+      IF(ITE==IDE)IEND=MYIE-3 
+!
+      DTQ=DT*0.25
+      DTE=DT*(0.5*0.25)
+!***
+!***  INITIALIZE SOME WORKING ARRAYS TO ZERO
+!***
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        TEW(I,K)=0.
+        UEW(I,K)=0.
+        VEW(I,K)=0.
+      ENDDO
+      ENDDO
+!
+!***  TYPE 0
+!
+      DO N=-3,3
+        DO K=KTS,KTE
+        DO I=ITS-5,ITE+5
+          DPDE(I,K,N)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!***  TYPE 1
+!
+      DO N=-2,2
+        DO K=KTS,KTE
+        DO I=ITS-5,ITE+5
+          TST(I,K,N)=0.
+          UST(I,K,N)=0.
+          VST(I,K,N)=0.
+          UDY(I,K,N)=0.
+          VDX(I,K,N)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!***  TYPES 5 AND 6
+!
+      DO N=-1,0
+        DO K=KTS,KTE
+        DO I=ITS-5,ITE+5
+          TNE(I,K,N)=0.
+          TSE(I,K,N+1)=0.
+          UNE(I,K,N)=0.
+          USE(I,K,N+1)=0.
+          VNE(I,K,N)=0.
+          VSE(I,K,N+1)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!***
+!***  PRECOMPUTE DETA1 TIMES PDTOP.
+!***
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+        DETA1_PDTOP(K)=DETA1(K)*PDTOP
+      ENDDO
+!-----------------------------------------------------------------------
+!***
+!***  WE NEED THE STARTING AND ENDING J FOR THIS TASK'S INTEGRATION
+!***
+      JSTART=MYJS2
+      JEND=MYJE2
+!
+!
+!-----------------------------------------------------------------------
+!
+!***  START THE HORIZONTAL ADVECTION IN THE INITIAL SOUTHERN SLABS.
+!
+!-----------------------------------------------------------------------
+!
+      DO J=-2,1
+        JJ=JSTART+J
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          TST(I,K,J)=T(I,K,JJ)*FFC+TOLD(I,K,JJ)*FBC
+          UST(I,K,J)=U(I,K,JJ)*FFC+UOLD(I,K,JJ)*FBC
+          VST(I,K,J)=V(I,K,JJ)*FFC+VOLD(I,K,JJ)*FBC
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
+!***  FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
+!***  IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J.
+!***  ONLY THE NORTHERNMOST OF EACH OF THE WORKING ARRAYS WILL BE
+!***  FILLED IN THE PRIMARY INTEGRATION SECTION.
+!-----------------------------------------------------------------------
+!
+      J1=-3
+      IF(JTS==JDS)J1=-2  ! Cannot go 3 south from J=2 for south tasks
+!
+      DO J=J1,2
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          DPDE(I,K,J)=DETA1_PDTOP(K)+DETA2(K)*PDSLO(I,JJ)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-2,1
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          UDY(I,K,J)=U(I,K,JJ)*DY
+          VDX_X=V(I,K,JJ)*DX(I,JJ)
+          FNS(I,K,JJ)=VDX_X*(DPDE(I,K,J-1)+DPDE(I,K,J+1))
+          VDX(I,K,J)=VDX_X
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-2,0
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          TEMPA=(UDY(I+IHE(JJ),K,J)+VDX(I+IHE(JJ),K,J))                 &
+     &         +(UDY(I,K,J+1)      +VDX(I,K,J+1))
+          FNE(I,K,JJ)=TEMPA*(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J+1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-1,1
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          TEMPB=(UDY(I+IHE(JJ),K,J)-VDX(I+IHE(JJ),K,J))                 &
+     &         +(UDY(I,K,J-1)      -VDX(I,K,J-1))
+          FSE(I,K,JJ)=TEMPB*(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J-1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-1,0
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS1_P3,MYIE1_P3
+          FNS_X=FNS(I,K,JJ)
+          TNS(I,K,J)=FNS_X*(TST(I,K,J+1)-TST(I,K,J-1))
+!
+          UDY_X=U(I,K,JJ)*DY
+          FEW(I,K,JJ)=UDY_X*(DPDE(I+IVW(JJ),K,J)+DPDE(I+IVE(JJ),K,J))   
+        ENDDO
+        ENDDO
+!
+        DO K=KTS,KTE
+        DO I=MYIS1_P4,MYIE1_P4
+          UNS(I,K,J)=(FNS(I+IHW(JJ),K,JJ)+FNS(I+IHE(JJ),K,JJ))          &
+     &              *(UST(I,K,J+1)-UST(I,K,J-1))
+          VNS(I,K,J)=(FNS(I,K,JJ-1)+FNS(I,K,JJ+1))                      &
+     &              *(VST(I,K,J+1)-VST(I,K,J-1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      JJ=JSTART-1
+!
+      DO K=KTS,KTE
+      DO I=MYIS1_P2,MYIE1_P2
+        FNE_X=FNE(I,K,JJ)
+        TNE(I,K,-1)=FNE_X*(TST(I+IHE(JJ),K,0)-TST(I,K,-1))
+!
+        FSE_X=FSE(I,K,JJ+1)
+        TSE(I,K,0)=FSE_X*(TST(I+IHE(JJ+1),K,-1)-TST(I,K,0))
+!
+        UNE(I,K,-1)=(FNE(I+IVW(JJ),K,JJ)+FNE(I+IVE(JJ),K,JJ))           &
+     &             *(UST(I+IVE(JJ),K,0)-UST(I,K,-1))
+        USE(I,K,0)=(FSE(I+IVW(JJ+1),K,JJ+1)+FSE(I+IVE(JJ+1),K,JJ+1))    &
+     &            *(UST(I+IVE(JJ+1),K,-1)-UST(I,K,0))
+        VNE(I,K,-1)=(FNE(I,K,JJ-1)+FNE(I,K,JJ+1))                       &
+     &             *(VST(I+IVE(JJ),K,0)-VST(I,K,-1))
+        VSE(I,K,0)=(FSE(I,K,JJ)+FSE(I,K,JJ+2))                          &
+     &            *(VST(I+IVE(JJ+1),K,-1)-VST(I,K,0))
+      ENDDO
+      ENDDO
+!
+      JKNT=0
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      main_integration : DO J=JSTART,JEND
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***
+!***  SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
+!***                                           AND PFDHT DIAGRAMS)
+!***
+!***  J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
+!***  LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
+!***  NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
+!***  THE CURRENT VALUE OF THE main_integration LOOP.
+!***  (P3 denotes +3, M1 denotes -1, etc.)
+!***
+
+!
+! John and Tom both think this is all right, even for tiles,
+! as long as the slab arrays being indexed by these things
+! are locally defined.
+!
+      JKNT=JKNT+1
+!
+      J0_P3=INDX3_WRK(3,JKNT,0)
+      J0_P2=INDX3_WRK(2,JKNT,0)
+      J0_P1=INDX3_WRK(1,JKNT,0)
+      J0_00=INDX3_WRK(0,JKNT,0)
+      J0_M1=INDX3_WRK(-1,JKNT,0)
+!
+      J1_P2=INDX3_WRK(2,JKNT,1)
+      J1_P1=INDX3_WRK(1,JKNT,1)
+      J1_00=INDX3_WRK(0,JKNT,1)
+      J1_M1=INDX3_WRK(-1,JKNT,1)
+!
+      J2_P1=INDX3_WRK(1,JKNT,2)
+      J2_00=INDX3_WRK(0,JKNT,2)
+      J2_M1=INDX3_WRK(-1,JKNT,2)
+!
+      J3_P2=INDX3_WRK(2,JKNT,3)
+      J3_P1=INDX3_WRK(1,JKNT,3)
+      J3_00=INDX3_WRK(0,JKNT,3)
+!
+      J4_P1=INDX3_WRK(1,JKNT,4)
+      J4_00=INDX3_WRK(0,JKNT,4)
+      J4_M1=INDX3_WRK(-1,JKNT,4)
+!
+      J5_00=INDX3_WRK(0,JKNT,5)
+      J5_M1=INDX3_WRK(-1,JKNT,5)
+!
+      J6_P1=INDX3_WRK(1,JKNT,6)
+      J6_00=INDX3_WRK(0,JKNT,6)
+!
+      MY_IS_GLB=1  ! make this a noop for global indexing
+      MY_IE_GLB=1  ! make this a noop for global indexing
+      MY_JS_GLB=1  ! make this a noop for global indexing
+      MY_JE_GLB=1  ! make this a noop for global indexing
+!  
+!-----------------------------------------------------------------------
+!***  THE WORKING ARRAYS FOR THE PRIMARY VARIABLES
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+      DO I=MYIS_P4,MYIE_P4
+        TST(I,K,J1_P2)=T(I,K,J+2)*FFC+TOLD(I,K,J+2)*FBC
+        UST(I,K,J1_P2)=U(I,K,J+2)*FFC+UOLD(I,K,J+2)*FBC
+        VST(I,K,J1_P2)=V(I,K,J+2)*FFC+VOLD(I,K,J+2)*FBC
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  MASS FLUXES AND MASS POINT ADVECTION COMPONENTS
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+      DO I=MYIS_P4,MYIE_P4
+!
+!-----------------------------------------------------------------------
+!***  THE NS AND EW FLUXES IN THE FOLLOWING LOOP ARE ON V POINTS
+!***  FOR T.
+!-----------------------------------------------------------------------
+!
+        DPDE_P3=DETA1_PDTOP(K)+DETA2(K)*PDSLO(I,J+3)
+        DPDE(I,K,J0_P3)=DPDE_P3
+!
+!-----------------------------------------------------------------------
+        UDY(I,K,J1_P2)=U(I,K,J+2)*DY
+        VDX_P2=V(I,K,J+2)*DX(I,J+2)
+        VDX(I,K,J1_P2)=VDX_P2
+        FNS(I,K,J+2)=VDX_P2*(DPDE(I,K,J0_P1)+DPDE_P3)
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO K=KTS,KTE
+      DO I=MYIS_P3,MYIE_P3
+        TEMPA=(UDY(I+IHE(J+1),K,J1_P1)+VDX(I+IHE(J+1),K,J1_P1))         &
+     &       +(UDY(I,K,J1_P2)         +VDX(I,K,J1_P2))
+        FNE(I,K,J+1)=TEMPA*(DPDE(I,K,J0_P1)+DPDE(I+IHE(J+1),K,J0_P2))
+!
+!-----------------------------------------------------------------------
+        TEMPB=(UDY(I+IHE(J+2),K,J1_P2)-VDX(I+IHE(J+2),K,J1_P2))         &
+     &       +(UDY(I,K,J1_P1)         -VDX(I,K,J1_P1))
+        FSE(I,K,J+2)=TEMPB*(DPDE(I,K,J0_P2)+DPDE(I+IHE(J),K,J0_P1))
+!
+!-----------------------------------------------------------------------
+        FNS_P1=FNS(I,K,J+1)
+        TNS(I,K,J4_P1)=FNS_P1*(TST(I,K,J1_P2)-TST(I,K,J1_00))
+!
+!-----------------------------------------------------------------------
+        UDY_P1=U(I,K,J+1)*DY
+        FEW(I,K,J+1)=UDY_P1*(DPDE(I+IVW(J+1),K,J0_P1)                   &
+     &                        +DPDE(I+IVE(J+1),K,J0_P1))
+        FEW_00=FEW(I,K,J)
+        TEW(I,K)=FEW_00*(TST(I+IVE(J),K,J1_00)-TST(I+IVW(J),K,J1_00))
+!
+!-----------------------------------------------------------------------
+!***  THE NE AND SE FLUXES ARE ASSOCIATED WITH H POINTS
+!***  (ACTUALLY JUST TO THE NE AND SE OF EACH H POINT).
+!-----------------------------------------------------------------------
+!
+        FNE_X=FNE(I,K,J)
+        TNE(I,K,J5_00)=FNE_X*(TST(I+IHE(J),K,J1_P1)-TST(I,K,J1_00))
+!
+        FSE_X=FSE(I,K,J+1)
+        TSE(I,K,J6_P1)=FSE_X*(TST(I+IHE(J+1),K,J1_00)-TST(I,K,J1_P1))
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  CALCULATION OF MOMENTUM ADVECTION COMPONENTS
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  THE NS AND EW FLUXES ARE ON H POINTS FOR U AND V.
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+      DO I=MYIS_P2,MYIE_P2
+        UEW(I,K)=(FEW(I+IHW(J),K,J)+FEW(I+IHE(J),K,J))                  &
+     &          *(UST(I+IHE(J),K,J1_00)-UST(I+IHW(J),K,J1_00))
+        UNS(I,K,J4_P1)=(FNS(I+IHW(J+1),K,J+1)                           &
+     &                 +FNS(I+IHE(J+1),K,J+1))                          &
+     &                *(UST(I,K,J1_P2)-UST(I,K,J1_00))
+        VEW(I,K)=(FEW(I,K,J-1)+FEW(I,K,J+1))                            &
+     &          *(VST(I+IHE(J),K,J1_00)-VST(I+IHW(J),K,J1_00))
+        VNS(I,K,J4_P1)=(FNS(I,K,J)+FNS(I,K,J+2))                        &
+     &                *(VST(I,K,J1_P2)-VST(I,K,J1_00))
+!
+!-----------------------------------------------------------------------
+!***  THE FOLLOWING NE AND SE FLUXES ARE TIED TO V POINTS AND ARE
+!***  LOCATED JUST TO THE NE AND SE OF THE GIVEN I,J.
+!-----------------------------------------------------------------------
+!
+        UNE(I,K,J5_00)=(FNE(I+IVW(J),K,J)+FNE(I+IVE(J),K,J))            &
+     &                *(UST(I+IVE(J),K,J1_P1)-UST(I,K,J1_00))
+        USE(I,K,J6_P1)=(FSE(I+IVW(J+1),K,J+1)                           &
+     &                 +FSE(I+IVE(J+1),K,J+1))                          &
+     &                *(UST(I+IVE(J+1),K,J1_00)-UST(I,K,J1_P1))
+        VNE(I,K,J5_00)=(FNE(I,K,J-1)+FNE(I,K,J+1))                      &
+     &                *(VST(I+IVE(J),K,J1_P1)-VST(I,K,J1_00))
+        VSE(I,K,J6_P1)=(FSE(I,K,J)+FSE(I,K,J+2))                        &
+     &                *(VST(I+IVE(J+1),K,J1_00)-VST(I,K,J1_P1))
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE THE ADVECTION TENDENCIES FOR T.
+!***  THE AD ARRAYS ARE ON H POINTS.
+!***  SKIP TO UPSTREAM IF THESE ROWS HAVE ONLY UPSTREAM POINTS.
+!-----------------------------------------------------------------------
+!
+      
+      JGLOBAL=J+MY_JS_GLB-1
+      IF(JGLOBAL>=6.AND.JGLOBAL<=JDE-5)THEN
+!
+        JJ=J+MY_JS_GLB-1   ! okay because MY_JS_GLB is 1
+        IF(ITS==IDS)ISTART=3+MOD(JJ,2)  ! need to think about this
+                                        ! more in terms of how to 
+                                        ! convert to global indexing
+!
+        DO K=KTS,KTE
+        DO I=ISTART,IEND
+          RDPD=1./DPDE(I,K,J0_00)
+!
+          ADT(I,K,J)=(TEW(I+IHW(J),K)+TEW(I+IHE(J),K)                   &
+     &               +TNS(I,K,J4_M1)+TNS(I,K,J4_P1)                     &
+     &               +TNE(I+IHW(J),K,J5_M1)+TNE(I,K,J5_00)              &
+     &               +TSE(I,K,J6_00)+TSE(I+IHW(J),K,J6_P1))             &
+     &               *RDPD*FAD(I,J)
+!
+        ENDDO
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE THE ADVECTION TENDENCIES FOR U AND V.
+!***  THE AD ARRAYS ARE ON VELOCITY POINTS.
+!-----------------------------------------------------------------------
+!
+        IF(ITS==IDS)ISTART=3+MOD(JJ+1,2)
+!
+        DO K=KTS,KTE
+        DO I=ISTART,IEND
+          RDPDX=1./(DPDE(I+IVW(J),K,J0_00)+DPDE(I+IVE(J),K,J0_00))
+          RDPDY=1./(DPDE(I,K,J0_M1)+DPDE(I,K,J0_P1))
+!
+          ADU(I,K,J)=(UEW(I+IVW(J),K)+UEW(I+IVE(J),K)                   &
+     &               +UNS(I,K,J4_M1)+UNS(I,K,J4_P1)                     &
+     &               +UNE(I+IVW(J),K,J5_M1)+UNE(I,K,J5_00)              &
+     &               +USE(I,K,J6_00)+USE(I+IVW(J),K,J6_P1))             &
+     &               *RDPDX*FAD(I+IVW(J),J)
+!
+          ADV(I,K,J)=(VEW(I+IVW(J),K)+VEW(I+IVE(J),K)                   &
+     &               +VNS(I,K,J4_M1)+VNS(I,K,J4_P1)                     &
+     &               +VNE(I+IVW(J),K,J5_M1)+VNE(I,K,J5_00)              &
+     &               +VSE(I,K,J6_00)+VSE(I+IVW(J),K,J6_P1))             &
+     &               *RDPDY*FAD(I+IVW(J),J)
+!
+        ENDDO
+        ENDDO
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!***  END OF JANJIC HORIZONTAL ADVECTION 
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  UPSTREAM ADVECTION OF T, U, AND V
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      upstream : IF(UPSTRM)THEN
+!
+!-----------------------------------------------------------------------
+!***
+!***  COMPUTE UPSTREAM COMPUTATIONS ON THIS TASK'S ROWS.
+!***
+!-----------------------------------------------------------------------
+!
+          N_IUPH_J=N_IUP_H(J)   ! See explanation in INIT
+!
+          DO K=KTS,KTE
+!
+            DO II=0,N_IUPH_J-1
+              I=IUP_H(IMS+II,J)
+              TTA=EMT_LOC(J)*(UST(I,K,J1_M1)+UST(I+IHW(J),K,J1_00)      &
+     &                       +UST(I+IHE(J),K,J1_00)+UST(I,K,J1_P1))
+              TTB=ENT       *(VST(I,K,J1_M1)+VST(I+IHW(J),K,J1_00)      &
+     &                       +VST(I+IHE(J),K,J1_00)+VST(I,K,J1_P1))
+              PP=-TTA-TTB
+              QP= TTA-TTB
+!
+              IF(PP<0.)THEN
+                ISPA(I,K)=-1
+              ELSE
+                ISPA(I,K)= 1
+              ENDIF
+!
+              IF(QP<0.)THEN
+                ISQA(I,K)=-1
+              ELSE
+                ISQA(I,K)= 1
+              ENDIF
+!
+              PP=ABS(PP)
+              QP=ABS(QP)
+              ARRAY3_X=PP*QP
+              ARRAY0(I,K)=ARRAY3_X-PP-QP
+              ARRAY1(I,K)=PP-ARRAY3_X
+              ARRAY2(I,K)=QP-ARRAY3_X
+              ARRAY3(I,K)=ARRAY3_X
+            ENDDO
+!
+          ENDDO
+!-----------------------------------------------------------------------
+!
+          N_IUPADH_J=N_IUP_ADH(J) 
+!
+          DO K=KTS,KTE
+!
+            KNTI_ADH=1
+            IUP_ADH_J=IUP_ADH(IMS,J)
+!
+            DO II=0,N_IUPH_J-1
+              I=IUP_H(IMS+II,J)
+!
+              ISP=ISPA(I,K)
+              ISQ=ISQA(I,K)
+              IFP=(ISP-1)/2
+              IFQ=(-ISQ-1)/2
+              IPQ=(ISP-ISQ)/2
+!
+              IF(HTM(I+IHE(J)+IFP,K,J+ISP)                              &
+     &          *HTM(I+IHE(J)+IFQ,K,J+ISQ)                              &
+     &          *HTM(I+IPQ,K,J+ISP+ISQ)>0.1)THEN
+                 GO TO 150
+              ENDIF
+!
+              IF(HTM(I+IHE(J)+IFP,K,J+ISP)                              &
+     &          +HTM(I+IHE(J)+IFQ,K,J+ISQ)                              &
+     &          +HTM(I+IPQ,K,J+ISP+ISQ)<0.1)THEN 
+!
+                T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)
+                T(I+IPQ,K,J+ISP+ISQ)=T(I,K,J)
+!
+              ELSEIF                                                    &
+     &        (HTM(I+IHE(J)+IFP,K,J+ISP)+HTM(I+IPQ,K,J+ISP+ISQ)         &
+     &         <0.99)THEN
+!
+                T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)
+                T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFQ,K,J+ISQ)
+!
+              ELSEIF                                                    &
+     &        (HTM(I+IHE(J)+IFQ,K,J+ISQ)+HTM(I+IPQ,K,J+ISP+ISQ)         &
+               <0.99)THEN
+!
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)
+                T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)
+!
+              ELSEIF                                                    &
+     &        (HTM(I+IHE(J)+IFP,K,J+ISP)                                &
+     &        +HTM(I+IHE(J)+IFQ,K,J+ISQ)<0.99)THEN
+                T(I+IHE(J)+IFP,K,J+ISP)=0.5*(T(I,K,J)                   &
+     &                                      +T(I+IPQ,K,J+ISP+ISQ))
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)
+!
+              ELSEIF(HTM(I+IHE(J)+IFP,K,J+ISP)<0.99)THEN
+                T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)                        &
+     &                                 +T(I+IPQ,K,J+ISP+ISQ)            &
+     &                                 -T(I+IHE(J)+IFQ,K,J+ISQ)
+!
+              ELSEIF(HTM(I+IHE(J)+IFQ,K,J+ISQ)<0.99)THEN
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)                        &
+     &                                 +T(I+IPQ,K,J+ISP+ISQ)            &
+     &                                 -T(I+IHE(J)+IFP,K,J+ISP)
+!
+              ELSE
+                T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)            &
+     &                              +T(I+IHE(J)+IFQ,K,J+ISQ)            &
+     &                              -T(I,K,J)
+!
+              ENDIF
+!
+  150         CONTINUE
+!
+!-----------------------------------------------------------------------
+!
+              IF(I==IUP_ADH_J)THEN  ! Update advection H tendencies
+!
+                ISP=ISPA(I,K)
+                ISQ=ISQA(I,K)
+                IFP=(ISP-1)/2
+                IFQ=(-ISQ-1)/2
+                IPQ=(ISP-ISQ)/2
+!
+                F0=ARRAY0(I,K)
+                F1=ARRAY1(I,K)
+                F2=ARRAY2(I,K)
+                F3=ARRAY3(I,K)
+!
+                ADT(I,K,J)=F0*T(I,K,J)                                  &
+     &                    +F1*T(I+IHE(J)+IFP,K,J+ISP)                   &
+     &                    +F2*T(I+IHE(J)+IFQ,K,J+ISQ)                   &
+                          +F3*T(I+IPQ,K,J+ISP+ISQ)
+!
+!-----------------------------------------------------------------------
+!
+                IF(KNTI_ADH<N_IUPADH_J)THEN
+                  IUP_ADH_J=IUP_ADH(IMS+KNTI_ADH,J)
+                  KNTI_ADH=KNTI_ADH+1
+                ENDIF
+!
+              ENDIF  ! End of advection H tendency IF block
+!
+            ENDDO  ! End of II loop
+!
+          ENDDO  ! End of K loop
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  UPSTREAM ADVECTION OF VELOCITY COMPONENTS
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+          N_IUPADV_J=N_IUP_ADV(J)
+!
+          DO K=KTS,KTE
+!
+            DO II=0,N_IUPADV_J-1
+              I=IUP_ADV(IMS+II,J)
+!
+              TTA=EM_LOC(J)*UST(I,K,J1_00)
+              TTB=EN       *VST(I,K,J1_00)
+              PP=-TTA-TTB
+              QP=TTA-TTB
+!
+              IF(PP<0.)THEN
+                ISP=-1
+              ELSE
+                ISP= 1
+              ENDIF
+!
+              IF(QP<0.)THEN
+                ISQ=-1
+              ELSE
+                ISQ= 1
+              ENDIF
+!
+              IFP=(ISP-1)/2
+              IFQ=(-ISQ-1)/2
+              IPQ=(ISP-ISQ)/2
+              PP=ABS(PP)
+              QP=ABS(QP)
+              F3=PP*QP
+              F0=F3-PP-QP
+              F1=PP-F3
+              F2=QP-F3
+!
+              ADU(I,K,J)=F0*U(I,K,J)                                    &
+     &                  +F1*U(I+IVE(J)+IFP,K,J+ISP)                     &
+     &                  +F2*U(I+IVE(J)+IFQ,K,J+ISQ)                     &
+     &                  +F3*U(I+IPQ,K,J+ISP+ISQ)
+! 
+              ADV(I,K,J)=F0*V(I,K,J)                                    &
+     &                  +F1*V(I+IVE(J)+IFP,K,J+ISP)                     &
+     &                  +F2*V(I+IVE(J)+IFQ,K,J+ISQ)                     &
+     &                  +F3*V(I+IPQ,K,J+ISP+ISQ)
+!
+            ENDDO
+!
+          ENDDO  !  End of K loop
+!
+!-----------------------------------------------------------------------
+!
+        ENDIF upstream
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  END OF THIS UPSTREAM REGION
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!***  COMPUTE VERTICAL ADVECTION TENDENCIES USING CRANK-NICHOLSON.
+!
+!-----------------------------------------------------------------------
+!***  FIRST THE TEMPERATURE
+!-----------------------------------------------------------------------
+!
+      iloop_for_t:  DO I=MYIS1,MYIE1
+!
+        PDOP=PDSLO(I,J)
+        PVVLO=PETDT(I,KTE-1,J)*DTQ
+        VVLO=PVVLO/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOP)
+        CMT=-VVLO+1.
+        RCMT(KTE)=1./CMT
+        CRT(KTE)=VVLO
+        RSTT(KTE)=-VVLO*(T(I,KTE-1,J)-T(I,KTE,J))+T(I,KTE,J)
+!
+        LMHK=KTE-LMH(I,J)+1
+        DO K=KTE-1,LMHK+1,-1
+          RDP=1./(DETA1_PDTOP(K)+DETA2(K)*PDOP)
+          PVVUP=PVVLO
+          PVVLO=PETDT(I,K-1,J)*DTQ
+          VVUP=PVVUP*RDP
+          VVLO=PVVLO*RDP
+          CFT=-VVUP*RCMT(K+1)
+          CMT=-CRT(K+1)*CFT+(VVUP-VVLO+1.)
+          RCMT(K)=1./CMT
+          CRT(K)=VVLO
+          RSTT(K)=-RSTT(K+1)*CFT+T(I,K,J)                               &
+     &            -(T(I,K,J)-T(I,K+1,J))*VVUP                           &
+     &            -(T(I,K-1,J)-T(I,K,J))*VVLO
+        ENDDO
+!
+        PVVUP=PVVLO
+        VVUP=PVVUP/(DETA1_PDTOP(LMHK)+DETA2(LMHK)*PDOP)
+        CFT=-VVUP*RCMT(LMHK+1)
+        CMT=-CRT(LMHK+1)*CFT+VVUP+1.
+        CRT(LMHK)=0.
+        RSTT(LMHK)=-(T(I,LMHK,J)-T(I,LMHK+1,J))*VVUP                    &
+     &               -RSTT(LMHK+1)*CFT+T(I,LMHK,J)
+        TN(LMHK)=RSTT(LMHK)/CMT
+        VAD_TEND_T(I,LMHK)=TN(LMHK)-T(I,LMHK,J)
+!
+        DO K=LMHK+1,KTE
+          TN(K)=(-CRT(K)*TN(K-1)+RSTT(K))*RCMT(K)
+          VAD_TEND_T(I,K)=TN(K)-T(I,K,J)
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  The following section is only for checking the implicit solution
+!***  using back-substitution.  Remove this section otherwise.
+!-----------------------------------------------------------------------
+!
+!       IF(I==ITEST.AND.J==JTEST)THEN
+!!
+!         PVVLO=PETDT(I,KTE-1,J)*DT*0.25
+!         VVLO=PVVLO/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOP)
+!         TTLO=VVLO*(T(I,KTE-1,J)-T(I,KTE,J)                            &
+!    &              +TN(KTE-1)-TN(KTE))
+!         ADTP=TTLO+TN(KTE)-T(I,KTE,J)
+!         WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',KTE     &
+!    &,             ' ADTP=',ADTP
+!         WRITE(0,*)' T=',T(I,KTE,J),' TN=',TN(KTE)                     &
+!    &,               ' VAD_TEND_T=',VAD_TEND_T(I,KTE)
+!         WRITE(0,*)' '
+!!
+!         DO K=KTE-1,LMHK+1,-1
+!           RDP=1./(DETA1_PDTOP(K)+DETA2(K)*PDOP)
+!           PVVUP=PVVLO
+!           PVVLO=PETDT(I,K-1,J)*DT*0.25
+!           VVUP=PVVUP*RDP
+!           VVLO=PVVLO*RDP
+!           TTUP=VVUP*(T(I,K,J)-T(I,K+1,J)+TN(K)-TN(K+1))
+!           TTLO=VVLO*(T(I,K-1,J)-T(I,K,J)+TN(K-1)-TN(K))
+!           ADTP=TTLO+TTUP+TN(K)-T(I,K,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',K             &
+!    &,               ' ADTP=',ADTP
+!           WRITE(0,*)' T=',T(I,K,J),' TN=',TN(K)                       &
+!    &,               ' VAD_TEND_T=',VAD_TEND_T(I,K)
+!           WRITE(0,*)' '
+!         ENDDO
+!!
+!         IF(LMHK==KTS)THEN
+!           PVVUP=PVVLO
+!           VVUP=PVVUP/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOP)
+!           TTUP=VVUP*(T(I,KTS,J)-T(I,KTS+1,J)+TN(KTS)-TN(KTS+1))
+!           ADTP=TTUP+TN(KTS)-T(I,KTS,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',KTS           &
+!    &,               ' ADTP=',ADTP
+!           WRITE(0,*)' T=',T(I,KTS,J),' TN=',TN(KTS)                   &
+!    &,               ' VAD_TEND_T=',VAD_TEND_T(I,KTS)
+!           WRITE(0,*)' '
+!         ENDIF
+!       ENDIF
+!
+!-----------------------------------------------------------------------
+!***  End of check.
+!-----------------------------------------------------------------------
+!
+      ENDDO iloop_for_t
+!
+!-----------------------------------------------------------------------
+!***  NOW VERTICAL ADVECTION OF WIND COMPONENTS
+!-----------------------------------------------------------------------
+!
+      iloop_for_uv:  DO I=MYIS1,MYIE1
+!
+        PDOPU=(PDSLO(I+IVW(J),J)+PDSLO(I+IVE(J),J))*0.5
+        PDOPV=(PDSLO(I,J-1)+PDSLO(I,J+1))*0.5
+        PVVLOU=(PETDT(I+IVW(J),KTE-1,J)+PETDT(I+IVE(J),KTE-1,J))*DTE
+        PVVLOV=(PETDT(I,KTE-1,J-1)+PETDT(I,KTE-1,J+1))*DTE
+        VVLOU=PVVLOU/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPU)
+        VVLOV=PVVLOV/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPV)
+        CMU=-VVLOU+1.
+        CMV=-VVLOV+1.
+        RCMU(KTE)=1./CMU
+        RCMV(KTE)=1./CMV
+        CRU(KTE)=VVLOU
+        CRV(KTE)=VVLOV
+        RSTU(KTE)=-VVLOU*(U(I,KTE-1,J)-U(I,KTE,J))+U(I,KTE,J)
+        RSTV(KTE)=-VVLOV*(V(I,KTE-1,J)-V(I,KTE,J))+V(I,KTE,J)
+!
+        LMVK=KTE-LMV(I,J)+1
+        DO K=KTE-1,LMVK+1,-1
+          RDPU=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPU)
+          RDPV=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPV)
+          PVVUPU=PVVLOU
+          PVVUPV=PVVLOV
+          PVVLOU=(PETDT(I+IVW(J),K-1,J)+PETDT(I+IVE(J),K-1,J))*DTE
+          PVVLOV=(PETDT(I,K-1,J-1)+PETDT(I,K-1,J+1))*DTE
+          VVUPU=PVVUPU*RDPU
+          VVUPV=PVVUPV*RDPV
+          VVLOU=PVVLOU*RDPU
+          VVLOV=PVVLOV*RDPV
+          CFU=-VVUPU*RCMU(K+1)
+          CFV=-VVUPV*RCMV(K+1)
+          CMU=-CRU(K+1)*CFU+VVUPU-VVLOU+1.
+          CMV=-CRV(K+1)*CFV+VVUPV-VVLOV+1.
+          RCMU(K)=1./CMU
+          RCMV(K)=1./CMV
+          CRU(K)=VVLOU
+          CRV(K)=VVLOV
+          RSTU(K)=-RSTU(K+1)*CFU+U(I,K,J)                               &
+     &            -(U(I,K,J)-U(I,K+1,J))*VVUPU                          &
+     &            -(U(I,K-1,J)-U(I,K,J))*VVLOU
+          RSTV(K)=-RSTV(K+1)*CFV+V(I,K,J)                               &
+     &            -(V(I,K,J)-V(I,K+1,J))*VVUPV                          &
+     &            -(V(I,K-1,J)-V(I,K,J))*VVLOV
+        ENDDO
+!
+        RDPU=1./(DETA1_PDTOP(LMVK)+DETA2(LMVK)*PDOPU)
+        RDPV=1./(DETA1_PDTOP(LMVK)+DETA2(LMVK)*PDOPV)
+        PVVUPU=PVVLOU
+        PVVUPV=PVVLOV
+        VVUPU=PVVUPU*RDPU
+        VVUPV=PVVUPV*RDPV
+        CFU=-VVUPU*RCMU(LMVK+1)
+        CFV=-VVUPV*RCMV(LMVK+1)
+        CMU=-CRU(LMVK+1)*CFU+VVUPU+1.
+        CMV=-CRV(LMVK+1)*CFV+VVUPV+1.
+        CRU(LMVK)=0.
+        CRV(LMVK)=0.
+        RSTU(LMVK)=-(U(I,LMVK,J)-U(I,LMVK+1,J))*VVUPU                   &
+     &               -RSTU(LMVK+1)*CFU+U(I,LMVK,J)
+        RSTV(LMVK)=-(V(I,LMVK,J)-V(I,LMVK+1,J))*VVUPV                   &
+     &               -RSTV(LMVK+1)*CFV+V(I,LMVK,J)
+        UN(LMVK)=RSTU(LMVK)/CMU
+        VN(LMVK)=RSTV(LMVK)/CMV
+        VAD_TEND_U(I,LMVK)=UN(LMVK)-U(I,LMVK,J)
+        VAD_TEND_V(I,LMVK)=VN(LMVK)-V(I,LMVK,J)
+!
+        DO K=LMVK+1,KTE
+          UN(K)=(-CRU(K)*UN(K-1)+RSTU(K))*RCMU(K)
+          VN(K)=(-CRV(K)*VN(K-1)+RSTV(K))*RCMV(K)
+          VAD_TEND_U(I,K)=UN(K)-U(I,K,J)
+          VAD_TEND_V(I,K)=VN(K)-V(I,K,J)
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  The following section is only for checking the implicit solution
+!***  using back-substitution.  Remove this section otherwise.
+!-----------------------------------------------------------------------
+!
+!       IF(I==ITEST.AND.J==JTEST)THEN
+!!
+!         PDOPU=(PDSLO(I+IVW(J),J)+PDSLO(I+IVE(J),J))*0.5
+!         PDOPV=(PDSLO(I,J-1)+PDSLO(I,J+1))*0.5
+!         PVVLOU=(PETDT(I+IVW(J),KTE-1,J)                               &
+!    &           +PETDT(I+IVE(J),KTE-1,J))*DTE
+!         PVVLOV=(PETDT(I,KTE-1,J-1)                                    &
+!    &           +PETDT(I,KTE-1,J+1))*DTE
+!         VVLOU=PVVLOU/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPU)
+!         VVLOV=PVVLOV/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPV)
+!         TULO=VVLOU*(U(I,KTE-1,J)-U(I,KTE,J)+UN(KTE-1)-UN(KTE))
+!         TVLO=VVLOV*(V(I,KTE-1,J)-V(I,KTE,J)+VN(KTE-1)-VN(KTE))
+!         ADUP=TULO+UN(KTE)-U(I,KTE,J)
+!         ADVP=TVLO+VN(KTE)-V(I,KTE,J)
+!         WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',KTE             &
+!    &,             ' ADUP=',ADUP,' ADVP=',ADVP
+!         WRITE(0,*)' U=',U(I,KTE,J),' UN=',UN(KTE)                     &
+!    &,             ' VAD_TEND_U=',VAD_TEND_U(I,KTE)                    &
+!    &,             ' V=',V(I,KTE,J),' VN=',VN(KTE)                     &
+!    &,             ' VAD_TEND_V=',VAD_TEND_V(I,KTE)
+!         WRITE(0,*)' '
+!!
+!         DO K=KTE-1,LMVK+1,-1
+!           RDPU=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPU)
+!           RDPV=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPV)
+!           PVVUPU=PVVLOU
+!           PVVUPV=PVVLOV
+!           PVVLOU=(PETDT(I+IVW(J),K-1,J)                               &
+!    &            +PETDT(I+IVE(J),K-1,J))*DTE
+!           PVVLOV=(PETDT(I,K-1,J-1)+PETDT(I,K-1,J+1))*DTE
+!           VVUPU=PVVUPU*RDPU
+!           VVUPV=PVVUPV*RDPV
+!           VVLOU=PVVLOU*RDPU
+!           VVLOV=PVVLOV*RDPV
+!           TUUP=VVUPU*(U(I,K,J)-U(I,K+1,J)+UN(K)-UN(K+1))
+!           TVUP=VVUPV*(V(I,K,J)-V(I,K+1,J)+VN(K)-VN(K+1))
+!           TULO=VVLOU*(U(I,K-1,J)-U(I,K,J)+UN(K-1)-UN(K))
+!           TVLO=VVLOV*(V(I,K-1,J)-V(I,K,J)+VN(K-1)-VN(K))
+!           ADUP=TUUP+TULO+UN(K)-U(I,K,J)
+!           ADVP=TVUP+TVLO+VN(K)-V(I,K,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',K     &
+!    &,               ' ADUP=',ADUP,' ADVP=',ADVP
+!           WRITE(0,*)' U=',U(I,K,J),' UN=',UN(K)                       &
+!    &,               ' VAD_TEND_U=',VAD_TEND_U(I,K)                    &
+!    &,               ' V=',V(I,K,J),' VN=',VN(K)                       &
+!    &,               ' VAD_TEND_V=',VAD_TEND_V(I,K)
+!           WRITE(0,*)' '
+!         ENDDO
+!!
+!         IF(LMVK==KTS)THEN
+!           PVVUPU=PVVLOU
+!           PVVUPV=PVVLOV
+!           VVUPU=PVVUPU/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOPU)
+!           VVUPV=PVVUPV/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOPV)
+!           TUUP=VVUPU*(U(I,KTS,J)-U(I,KTS+1,J)+UN(KTS)-UN(KTS+1))
+!           TVUP=VVUPV*(V(I,KTS,J)-V(I,KTS+1,J)+VN(KTS)-VN(KTS+1))
+!           ADUP=TUUP+UN(KTS)-U(I,KTS,J)
+!           ADVP=TVUP+VN(KTS)-V(I,KTS,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',KTS   &
+!    &,               ' ADUP=',ADUP,' ADVP=',ADVP
+!           WRITE(0,*)' U=',U(I,KTS,J),' UN=',UN(KTS)                   &
+!    &,               ' VAD_TEND_U=',VAD_TEND_U(I,KTS)                  &
+!    &,               ' V=',V(I,KTS,J),' VN=',VN(KTS)                   &
+!    &,               ' VAD_TEND_V=',VAD_TEND_V(I,KTS)
+!           WRITE(0,*)' '
+!         ENDIF
+!       ENDIF
+!
+!-----------------------------------------------------------------------
+!***  End of check.
+!-----------------------------------------------------------------------
+!
+      ENDDO iloop_for_uv
+!
+!
+!-----------------------------------------------------------------------
+!
+!***  NOW SUM THE VERTICAL AND HORIZONTAL TENDENCIES,
+!***  CURVATURE AND CORIOLIS TERMS
+!
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+      DO I=MYIS1,MYIE1
+        HM=HTM(I,K,J)*HBM2(I,J)
+        VM=VTM(I,K,J)*VBM2(I,J)
+        ADT(I,K,J)=(VAD_TEND_T(I,K)+2.*ADT(I,K,J))*HM
+!
+        FPP=CURV(I,J)*2.*UST(I,K,J1_00)+F(I,J)*2.
+        ADU(I,K,J)=(VAD_TEND_U(I,K)+2.*ADU(I,K,J)+VST(I,K,J1_00)*FPP)   &
+     &             *VM
+        ADV(I,K,J)=(VAD_TEND_V(I,K)+2.*ADV(I,K,J)-UST(I,K,J1_00)*FPP)   &
+     &             *VM
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      ENDDO main_integration
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***  SAVE THE OLD VALUES FOR TIMESTEPPING
+!-----------------------------------------------------------------------
+!
+      DO J=MYJS_P4,MYJE_P4
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          TOLD(I,K,J)=T(I,K,J)
+          UOLD(I,K,J)=U(I,K,J)
+          VOLD(I,K,J)=V(I,K,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  FINALLY UPDATE THE PROGNOSTIC VARIABLES
+!-----------------------------------------------------------------------
+!
+      DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+        DO I=MYIS1,MYIE1
+          T(I,K,J)=ADT(I,K,J)+T(I,K,J)
+          U(I,K,J)=ADU(I,K,J)+U(I,K,J)
+          V(I,K,J)=ADV(I,K,J)+V(I,K,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      END SUBROUTINE ADVE
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/adve_orig.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/adve_orig.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/adve_orig.h	(revision 2744)
@@ -0,0 +1,1173 @@
+!*********************************************************************** 
+      SUBROUTINE ADVE(NTSD,DT,DETA1,DETA2,PDTOP                         &
+     &               ,CURV,F,FAD,F4D,EM_LOC,EMT_LOC,EN,ENT,DX,DY        &
+     &               ,HTM,HBM2,VTM,VBM2,LMH,LMV                         &
+     &               ,T,U,V,PDSLO,TOLD,UOLD,VOLD                        &
+     &               ,PETDT,UPSTRM                                      &
+     &               ,FEW,FNS,FNE,FSE                                   &
+     &               ,ADT,ADU,ADV                                       &
+     &               ,N_IUP_H,N_IUP_V                                   &
+     &               ,N_IUP_ADH,N_IUP_ADV                               &
+     &               ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                       &
+     &               ,IHE,IHW,IVE,IVW,INDX3_WRK                         &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &               ,IMS,IME,JMS,JME,KMS,KME                           &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    ADVE        HORIZONTAL AND VERTICAL ADVECTION
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 93-10-28       
+!     
+! ABSTRACT:
+!     ADVE CALCULATES THE CONTRIBUTION OF THE HORIZONTAL AND VERTICAL
+!     ADVECTION TO THE TENDENCIES OF TEMPERATURE AND WIND AND THEN
+!     UPDATES THOSE VARIABLES.
+!     THE JANJIC ADVECTION SCHEME FOR THE ARAKAWA E GRID IS USED
+!     FOR ALL VARIABLES INSIDE THE FIFTH ROW.  AN UPSTREAM SCHEME
+!     IS USED ON ALL VARIABLES IN THE THIRD, FOURTH, AND FIFTH
+!     OUTERMOST ROWS.  THE ADAMS-BASHFORTH TIME SCHEME IS USED.
+!     
+! PROGRAM HISTORY LOG:
+!   87-06-??  JANJIC     - ORIGINATOR
+!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   96-03-28  BLACK      - ADDED EXTERNAL EDGE
+!   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
+!   99-07-    JANJIC     - CONVERTED TO ADAMS-BASHFORTH SCHEME
+!                          COMBINING HORIZONTAL AND VERTICAL ADVECTION
+!   02-02-04  BLACK      - ADDED VERTICAL CFL CHECK
+!   02-02-05  BLACK      - CONVERTED TO WRF FORMAT
+!   02-08-29  MICHALAKES - CONDITIONAL COMPILATION OF MPI
+!                          CONVERT TO GLOBAL INDEXING
+!   02-09-06  WOLFE      - MORE CONVERSION TO GLOBAL INDEXING
+!   04-05-29  JANJIC,BLACK - CRANK-NICHOLSON VERTICAL ADVECTION
+!     
+! USAGE: CALL ADVE FROM SUBROUTINE SOLVE_RUNSTREAM
+!   INPUT ARGUMENT LIST:
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V          &
+     &                                        ,N_IUP_ADH,N_IUP_ADV
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V      &
+     &                                                ,IUP_ADH,IUP_ADV  &
+     &                                                ,LMH,LMV
+!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      REAL,INTENT(IN) :: DT,DY,EN,ENT,F4D,PDTOP
+!
+      REAL,DIMENSION(NMM_MAX_DIM),INTENT(IN) :: EM_LOC,EMT_LOC
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CURV,DX,F,FAD,HBM2  &
+     &                                             ,PDSLO,VBM2
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: T,TOLD   &
+     &                                                        ,U,UOLD   &
+     &                                                        ,V,VOLD
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: ADT,ADU    &
+     &                                                      ,ADV        &
+     &                                                      ,FEW,FNE    &
+     &                                                      ,FNS,FSE
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      LOGICAL :: UPSTRM
+!
+      INTEGER :: I,IEND,IFP,IFQ,II,IPQ,ISP,ISQ,ISTART                   &
+     &          ,IUP_ADH_J,IVH,IVL                                      &
+     &          ,J,J1,JA,JAK,JEND,JGLOBAL,JJ,JKNT,JP2,JSTART            &
+     &          ,K,KNTI_ADH,KSTART,KSTOP,LMHK,LMVK                      &
+     &          ,N,N_IUPH_J,N_IUPADH_J,N_IUPADV_J
+!
+      INTEGER :: MY_IS_GLB,MY_IE_GLB,MY_JS_GLB,MY_JE_GLB
+!
+      INTEGER :: J0_P3,J0_P2,J0_P1,J0_00,J0_M1,J1_P2,J1_P1,J1_00,J1_M1  &
+     &          ,J2_P1,J2_00,J2_M1,J3_P2,J3_P1,J3_00                    &
+     &          ,J4_P1,J4_00,J4_M1,J5_00,J5_M1,J6_P1,J6_00
+!
+      INTEGER,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: ISPA,ISQA
+!
+      REAL :: ARRAY3_X,CFT,CFU,CFV,CMT,CMU,CMV                          &
+     &       ,DPDE_P3,DTE,DTQ                                           &
+     &       ,F0,F1,F2,F3,FEW_00,FEW_P1,FNE_X,FNS_P1,FNS_X,FPP,FSE_X    &
+     &       ,HM,PDOP,PDOPU,PDOPV,PP                                    &
+     &       ,PVVLO,PVVLOU,PVVLOV,PVVUP,PVVUPU,PVVUPV                   &
+     &       ,QP,RDP,RDPD,RDPDX,RDPDY,RDPU,RDPV                         &
+     &       ,T_UP,TEMPA,TEMPB,TTA,TTB,U_UP,UDY_P1,UDY_X                &
+     &       ,VXD_X,VDX_P2,V_UP,VDX_X,VM,VTA,VUA,VVA                    &
+     &       ,VVLO,VVLOU,VVLOV,VVUP,VVUPU,VVUPV
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: ARRAY0,ARRAY1              &
+     &                                      ,ARRAY2,ARRAY3              &
+     &                                      ,VAD_TEND_T,VAD_TEND_U      &
+     &                                      ,VAD_TEND_V
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: TEW,UEW,VEW
+!
+      REAL,DIMENSION(KTS:KTE) :: CRT,CRU,CRV,DETA1_PDTOP                &
+     &                          ,RCMT,RCMU,RCMV,RSTT,RSTU,RSTV,TN,UN    &
+     &                          ,VAD_TNDX_T,VAD_TNDX_U,VAD_TNDX_V,VN
+!
+      REAL,DIMENSION(ITS-5:ITE+5,-1:1) :: PETDTK
+!
+      REAL,DIMENSION(ITS-5:ITE+5) :: TDN,UDN,VDN
+!
+!-----------------------------------------------------------------------
+!
+!***  TYPE 0 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-3:3) :: DPDE
+!
+!***  TYPE 1 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-2:2) :: TST,UDY,UST,VDX,VST
+!
+!***  TYPE 4 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-1:1) :: TNS,UNS,VNS
+!
+!***  TYPE 5 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-1:0) :: TNE,UNE,VNE
+!
+!***  TYPE 6 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME, 0:1) :: TSE,USE,VSE
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***********************************************************************
+!
+!                         DPDE      -----  3
+!                          |                      J Increasing
+!                          |                        
+!                          |                            ^
+!                         FNS       -----  2            |
+!                          |                            |
+!                          |                            |
+!                          |                            |
+!                         VNS       -----  1            |
+!                          |
+!                          |
+!                          |
+!                         ADV       -----  0  ------> Current J
+!                          |
+!                          |
+!                          |
+!                         VNS       ----- -1
+!                          |
+!                          |
+!                          |
+!                         FNS       ----- -2
+!                          |
+!                          |
+!                          |
+!                         DPDE      ----- -3
+!
+!***********************************************************************
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      ISTART=MYIS_P2
+      IEND=MYIE_P2 
+      IF(ITE==IDE)IEND=MYIE-3 
+!
+      DTQ=DT*0.25
+      DTE=DT*(0.5*0.25)
+!***
+!***  INITIALIZE SOME WORKING ARRAYS TO ZERO
+!***
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        TEW(I,K)=0.
+        UEW(I,K)=0.
+        VEW(I,K)=0.
+      ENDDO
+      ENDDO
+!
+!***  TYPE 0
+!
+      DO N=-3,3
+        DO K=KTS,KTE
+        DO I=ITS-5,ITE+5
+          DPDE(I,K,N)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!***  TYPE 1
+!
+      DO N=-2,2
+        DO K=KTS,KTE
+        DO I=ITS-5,ITE+5
+          TST(I,K,N)=0.
+          UST(I,K,N)=0.
+          VST(I,K,N)=0.
+          UDY(I,K,N)=0.
+          VDX(I,K,N)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!***  TYPES 5 AND 6
+!
+      DO N=-1,0
+        DO K=KTS,KTE
+        DO I=ITS-5,ITE+5
+          TNE(I,K,N)=0.
+          TSE(I,K,N+1)=0.
+          UNE(I,K,N)=0.
+          USE(I,K,N+1)=0.
+          VNE(I,K,N)=0.
+          VSE(I,K,N+1)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!***
+!***  PRECOMPUTE DETA1 TIMES PDTOP.
+!***
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+        DETA1_PDTOP(K)=DETA1(K)*PDTOP
+      ENDDO
+!-----------------------------------------------------------------------
+!***
+!***  WE NEED THE STARTING AND ENDING J FOR THIS TASK'S INTEGRATION
+!***
+      JSTART=MYJS2
+      JEND=MYJE2
+!
+!
+!-----------------------------------------------------------------------
+!
+!***  START THE HORIZONTAL ADVECTION IN THE INITIAL SOUTHERN SLABS.
+!
+!-----------------------------------------------------------------------
+!
+      DO J=-2,1
+        JJ=JSTART+J
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          TST(I,K,J)=T(I,K,JJ)*FFC+TOLD(I,K,JJ)*FBC
+          UST(I,K,J)=U(I,K,JJ)*FFC+UOLD(I,K,JJ)*FBC
+          VST(I,K,J)=V(I,K,JJ)*FFC+VOLD(I,K,JJ)*FBC
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
+!***  FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
+!***  IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J.
+!***  ONLY THE NORTHERNMOST OF EACH OF THE WORKING ARRAYS WILL BE
+!***  FILLED IN THE PRIMARY INTEGRATION SECTION.
+!-----------------------------------------------------------------------
+!
+      J1=-3
+      IF(JTS==JDS)J1=-2  ! Cannot go 3 south from J=2 for south tasks
+!
+      DO J=J1,2
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          DPDE(I,K,J)=DETA1_PDTOP(K)+DETA2(K)*PDSLO(I,JJ)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-2,1
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          UDY(I,K,J)=U(I,K,JJ)*DY
+          VDX_X=V(I,K,JJ)*DX(I,JJ)
+          FNS(I,K,JJ)=VDX_X*(DPDE(I,K,J-1)+DPDE(I,K,J+1))
+          VDX(I,K,J)=VDX_X
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-2,0
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          TEMPA=(UDY(I+IHE(JJ),K,J)+VDX(I+IHE(JJ),K,J))                 &
+     &         +(UDY(I,K,J+1)      +VDX(I,K,J+1))
+          FNE(I,K,JJ)=TEMPA*(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J+1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-1,1
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          TEMPB=(UDY(I+IHE(JJ),K,J)-VDX(I+IHE(JJ),K,J))                 &
+     &         +(UDY(I,K,J-1)      -VDX(I,K,J-1))
+          FSE(I,K,JJ)=TEMPB*(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J-1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-1,0
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS1_P3,MYIE1_P3
+          FNS_X=FNS(I,K,JJ)
+          TNS(I,K,J)=FNS_X*(TST(I,K,J+1)-TST(I,K,J-1))
+!
+          UDY_X=U(I,K,JJ)*DY
+          FEW(I,K,JJ)=UDY_X*(DPDE(I+IVW(JJ),K,J)+DPDE(I+IVE(JJ),K,J))   
+        ENDDO
+        ENDDO
+!
+        DO K=KTS,KTE
+        DO I=MYIS1_P4,MYIE1_P4
+          UNS(I,K,J)=(FNS(I+IHW(JJ),K,JJ)+FNS(I+IHE(JJ),K,JJ))          &
+     &              *(UST(I,K,J+1)-UST(I,K,J-1))
+          VNS(I,K,J)=(FNS(I,K,JJ-1)+FNS(I,K,JJ+1))                      &
+     &              *(VST(I,K,J+1)-VST(I,K,J-1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      JJ=JSTART-1
+!
+      DO K=KTS,KTE
+      DO I=MYIS1_P2,MYIE1_P2
+        FNE_X=FNE(I,K,JJ)
+        TNE(I,K,-1)=FNE_X*(TST(I+IHE(JJ),K,0)-TST(I,K,-1))
+!
+        FSE_X=FSE(I,K,JJ+1)
+        TSE(I,K,0)=FSE_X*(TST(I+IHE(JJ+1),K,-1)-TST(I,K,0))
+!
+        UNE(I,K,-1)=(FNE(I+IVW(JJ),K,JJ)+FNE(I+IVE(JJ),K,JJ))           &
+     &             *(UST(I+IVE(JJ),K,0)-UST(I,K,-1))
+        USE(I,K,0)=(FSE(I+IVW(JJ+1),K,JJ+1)+FSE(I+IVE(JJ+1),K,JJ+1))    &
+     &            *(UST(I+IVE(JJ+1),K,-1)-UST(I,K,0))
+        VNE(I,K,-1)=(FNE(I,K,JJ-1)+FNE(I,K,JJ+1))                       &
+     &             *(VST(I+IVE(JJ),K,0)-VST(I,K,-1))
+        VSE(I,K,0)=(FSE(I,K,JJ)+FSE(I,K,JJ+2))                          &
+     &            *(VST(I+IVE(JJ+1),K,-1)-VST(I,K,0))
+      ENDDO
+      ENDDO
+!
+      JKNT=0
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      main_integration : DO J=JSTART,JEND
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***
+!***  SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
+!***                                           AND PFDHT DIAGRAMS)
+!***
+!***  J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
+!***  LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
+!***  NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
+!***  THE CURRENT VALUE OF THE main_integration LOOP.
+!***  (P3 denotes +3, M1 denotes -1, etc.)
+!***
+
+!
+! John and Tom both think this is all right, even for tiles,
+! as long as the slab arrays being indexed by these things
+! are locally defined.
+!
+      JKNT=JKNT+1
+!
+      J0_P3=INDX3_WRK(3,JKNT,0)
+      J0_P2=INDX3_WRK(2,JKNT,0)
+      J0_P1=INDX3_WRK(1,JKNT,0)
+      J0_00=INDX3_WRK(0,JKNT,0)
+      J0_M1=INDX3_WRK(-1,JKNT,0)
+!
+      J1_P2=INDX3_WRK(2,JKNT,1)
+      J1_P1=INDX3_WRK(1,JKNT,1)
+      J1_00=INDX3_WRK(0,JKNT,1)
+      J1_M1=INDX3_WRK(-1,JKNT,1)
+!
+      J2_P1=INDX3_WRK(1,JKNT,2)
+      J2_00=INDX3_WRK(0,JKNT,2)
+      J2_M1=INDX3_WRK(-1,JKNT,2)
+!
+      J3_P2=INDX3_WRK(2,JKNT,3)
+      J3_P1=INDX3_WRK(1,JKNT,3)
+      J3_00=INDX3_WRK(0,JKNT,3)
+!
+      J4_P1=INDX3_WRK(1,JKNT,4)
+      J4_00=INDX3_WRK(0,JKNT,4)
+      J4_M1=INDX3_WRK(-1,JKNT,4)
+!
+      J5_00=INDX3_WRK(0,JKNT,5)
+      J5_M1=INDX3_WRK(-1,JKNT,5)
+!
+      J6_P1=INDX3_WRK(1,JKNT,6)
+      J6_00=INDX3_WRK(0,JKNT,6)
+!
+      MY_IS_GLB=1  ! make this a noop for global indexing
+      MY_IE_GLB=1  ! make this a noop for global indexing
+      MY_JS_GLB=1  ! make this a noop for global indexing
+      MY_JE_GLB=1  ! make this a noop for global indexing
+!  
+!-----------------------------------------------------------------------
+!***  THE WORKING ARRAYS FOR THE PRIMARY VARIABLES
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+      DO I=MYIS_P4,MYIE_P4
+        TST(I,K,J1_P2)=T(I,K,J+2)*FFC+TOLD(I,K,J+2)*FBC
+        UST(I,K,J1_P2)=U(I,K,J+2)*FFC+UOLD(I,K,J+2)*FBC
+        VST(I,K,J1_P2)=V(I,K,J+2)*FFC+VOLD(I,K,J+2)*FBC
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  MASS FLUXES AND MASS POINT ADVECTION COMPONENTS
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+      DO I=MYIS_P4,MYIE_P4
+!
+!-----------------------------------------------------------------------
+!***  THE NS AND EW FLUXES IN THE FOLLOWING LOOP ARE ON V POINTS
+!***  FOR T.
+!-----------------------------------------------------------------------
+!
+        DPDE_P3=DETA1_PDTOP(K)+DETA2(K)*PDSLO(I,J+3)
+        DPDE(I,K,J0_P3)=DPDE_P3
+!
+!-----------------------------------------------------------------------
+        UDY(I,K,J1_P2)=U(I,K,J+2)*DY
+        VDX_P2=V(I,K,J+2)*DX(I,J+2)
+        VDX(I,K,J1_P2)=VDX_P2
+        FNS(I,K,J+2)=VDX_P2*(DPDE(I,K,J0_P1)+DPDE_P3)
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO K=KTS,KTE
+      DO I=MYIS_P3,MYIE_P3
+        TEMPA=(UDY(I+IHE(J+1),K,J1_P1)+VDX(I+IHE(J+1),K,J1_P1))         &
+     &       +(UDY(I,K,J1_P2)         +VDX(I,K,J1_P2))
+        FNE(I,K,J+1)=TEMPA*(DPDE(I,K,J0_P1)+DPDE(I+IHE(J+1),K,J0_P2))
+!
+!-----------------------------------------------------------------------
+        TEMPB=(UDY(I+IHE(J+2),K,J1_P2)-VDX(I+IHE(J+2),K,J1_P2))         &
+     &       +(UDY(I,K,J1_P1)         -VDX(I,K,J1_P1))
+        FSE(I,K,J+2)=TEMPB*(DPDE(I,K,J0_P2)+DPDE(I+IHE(J),K,J0_P1))
+!
+!-----------------------------------------------------------------------
+        FNS_P1=FNS(I,K,J+1)
+        TNS(I,K,J4_P1)=FNS_P1*(TST(I,K,J1_P2)-TST(I,K,J1_00))
+!
+!-----------------------------------------------------------------------
+        UDY_P1=U(I,K,J+1)*DY
+        FEW(I,K,J+1)=UDY_P1*(DPDE(I+IVW(J+1),K,J0_P1)                   &
+     &                        +DPDE(I+IVE(J+1),K,J0_P1))
+        FEW_00=FEW(I,K,J)
+        TEW(I,K)=FEW_00*(TST(I+IVE(J),K,J1_00)-TST(I+IVW(J),K,J1_00))
+!
+!-----------------------------------------------------------------------
+!***  THE NE AND SE FLUXES ARE ASSOCIATED WITH H POINTS
+!***  (ACTUALLY JUST TO THE NE AND SE OF EACH H POINT).
+!-----------------------------------------------------------------------
+!
+        FNE_X=FNE(I,K,J)
+        TNE(I,K,J5_00)=FNE_X*(TST(I+IHE(J),K,J1_P1)-TST(I,K,J1_00))
+!
+        FSE_X=FSE(I,K,J+1)
+        TSE(I,K,J6_P1)=FSE_X*(TST(I+IHE(J+1),K,J1_00)-TST(I,K,J1_P1))
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  CALCULATION OF MOMENTUM ADVECTION COMPONENTS
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  THE NS AND EW FLUXES ARE ON H POINTS FOR U AND V.
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+      DO I=MYIS_P2,MYIE_P2
+        UEW(I,K)=(FEW(I+IHW(J),K,J)+FEW(I+IHE(J),K,J))                  &
+     &          *(UST(I+IHE(J),K,J1_00)-UST(I+IHW(J),K,J1_00))
+        UNS(I,K,J4_P1)=(FNS(I+IHW(J+1),K,J+1)                           &
+     &                 +FNS(I+IHE(J+1),K,J+1))                          &
+     &                *(UST(I,K,J1_P2)-UST(I,K,J1_00))
+        VEW(I,K)=(FEW(I,K,J-1)+FEW(I,K,J+1))                            &
+     &          *(VST(I+IHE(J),K,J1_00)-VST(I+IHW(J),K,J1_00))
+        VNS(I,K,J4_P1)=(FNS(I,K,J)+FNS(I,K,J+2))                        &
+     &                *(VST(I,K,J1_P2)-VST(I,K,J1_00))
+!
+!-----------------------------------------------------------------------
+!***  THE FOLLOWING NE AND SE FLUXES ARE TIED TO V POINTS AND ARE
+!***  LOCATED JUST TO THE NE AND SE OF THE GIVEN I,J.
+!-----------------------------------------------------------------------
+!
+        UNE(I,K,J5_00)=(FNE(I+IVW(J),K,J)+FNE(I+IVE(J),K,J))            &
+     &                *(UST(I+IVE(J),K,J1_P1)-UST(I,K,J1_00))
+        USE(I,K,J6_P1)=(FSE(I+IVW(J+1),K,J+1)                           &
+     &                 +FSE(I+IVE(J+1),K,J+1))                          &
+     &                *(UST(I+IVE(J+1),K,J1_00)-UST(I,K,J1_P1))
+        VNE(I,K,J5_00)=(FNE(I,K,J-1)+FNE(I,K,J+1))                      &
+     &                *(VST(I+IVE(J),K,J1_P1)-VST(I,K,J1_00))
+        VSE(I,K,J6_P1)=(FSE(I,K,J)+FSE(I,K,J+2))                        &
+     &                *(VST(I+IVE(J+1),K,J1_00)-VST(I,K,J1_P1))
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE THE ADVECTION TENDENCIES FOR T.
+!***  THE AD ARRAYS ARE ON H POINTS.
+!***  SKIP TO UPSTREAM IF THESE ROWS HAVE ONLY UPSTREAM POINTS.
+!-----------------------------------------------------------------------
+!
+      
+      JGLOBAL=J+MY_JS_GLB-1
+      IF(JGLOBAL>=6.AND.JGLOBAL<=JDE-5)THEN
+!
+        JJ=J+MY_JS_GLB-1   ! okay because MY_JS_GLB is 1
+        IF(ITS==IDS)ISTART=3+MOD(JJ,2)  ! need to think about this
+                                        ! more in terms of how to 
+                                        ! convert to global indexing
+!
+        DO K=KTS,KTE
+        DO I=ISTART,IEND
+          RDPD=1./DPDE(I,K,J0_00)
+!
+          ADT(I,K,J)=(TEW(I+IHW(J),K)+TEW(I+IHE(J),K)                   &
+     &               +TNS(I,K,J4_M1)+TNS(I,K,J4_P1)                     &
+     &               +TNE(I+IHW(J),K,J5_M1)+TNE(I,K,J5_00)              &
+     &               +TSE(I,K,J6_00)+TSE(I+IHW(J),K,J6_P1))             &
+     &               *RDPD*FAD(I,J)
+!
+        ENDDO
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE THE ADVECTION TENDENCIES FOR U AND V.
+!***  THE AD ARRAYS ARE ON VELOCITY POINTS.
+!-----------------------------------------------------------------------
+!
+        IF(ITS==IDS)ISTART=3+MOD(JJ+1,2)
+!
+        DO K=KTS,KTE
+        DO I=ISTART,IEND
+          RDPDX=1./(DPDE(I+IVW(J),K,J0_00)+DPDE(I+IVE(J),K,J0_00))
+          RDPDY=1./(DPDE(I,K,J0_M1)+DPDE(I,K,J0_P1))
+!
+          ADU(I,K,J)=(UEW(I+IVW(J),K)+UEW(I+IVE(J),K)                   &
+     &               +UNS(I,K,J4_M1)+UNS(I,K,J4_P1)                     &
+     &               +UNE(I+IVW(J),K,J5_M1)+UNE(I,K,J5_00)              &
+     &               +USE(I,K,J6_00)+USE(I+IVW(J),K,J6_P1))             &
+     &               *RDPDX*FAD(I+IVW(J),J)
+!
+          ADV(I,K,J)=(VEW(I+IVW(J),K)+VEW(I+IVE(J),K)                   &
+     &               +VNS(I,K,J4_M1)+VNS(I,K,J4_P1)                     &
+     &               +VNE(I+IVW(J),K,J5_M1)+VNE(I,K,J5_00)              &
+     &               +VSE(I,K,J6_00)+VSE(I+IVW(J),K,J6_P1))             &
+     &               *RDPDY*FAD(I+IVW(J),J)
+!
+        ENDDO
+        ENDDO
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!***  END OF JANJIC HORIZONTAL ADVECTION 
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  UPSTREAM ADVECTION OF T, U, AND V
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      upstream : IF(UPSTRM)THEN
+!
+!-----------------------------------------------------------------------
+!***
+!***  COMPUTE UPSTREAM COMPUTATIONS ON THIS TASK'S ROWS.
+!***
+!-----------------------------------------------------------------------
+!
+          N_IUPH_J=N_IUP_H(J)   ! See explanation in INIT
+!
+          DO K=KTS,KTE
+!
+            DO II=0,N_IUPH_J-1
+              I=IUP_H(IMS+II,J)
+              TTA=EMT_LOC(J)*(UST(I,K,J1_M1)+UST(I+IHW(J),K,J1_00)      &
+     &                       +UST(I+IHE(J),K,J1_00)+UST(I,K,J1_P1))
+              TTB=ENT       *(VST(I,K,J1_M1)+VST(I+IHW(J),K,J1_00)      &
+     &                       +VST(I+IHE(J),K,J1_00)+VST(I,K,J1_P1))
+              PP=-TTA-TTB
+              QP= TTA-TTB
+!
+              IF(PP<0.)THEN
+                ISPA(I,K)=-1
+              ELSE
+                ISPA(I,K)= 1
+              ENDIF
+!
+              IF(QP<0.)THEN
+                ISQA(I,K)=-1
+              ELSE
+                ISQA(I,K)= 1
+              ENDIF
+!
+              PP=ABS(PP)
+              QP=ABS(QP)
+              ARRAY3_X=PP*QP
+              ARRAY0(I,K)=ARRAY3_X-PP-QP
+              ARRAY1(I,K)=PP-ARRAY3_X
+              ARRAY2(I,K)=QP-ARRAY3_X
+              ARRAY3(I,K)=ARRAY3_X
+            ENDDO
+!
+          ENDDO
+!-----------------------------------------------------------------------
+!
+          N_IUPADH_J=N_IUP_ADH(J) 
+!
+          DO K=KTS,KTE
+!
+            KNTI_ADH=1
+            IUP_ADH_J=IUP_ADH(IMS,J)
+!
+            DO II=0,N_IUPH_J-1
+              I=IUP_H(IMS+II,J)
+!
+              ISP=ISPA(I,K)
+              ISQ=ISQA(I,K)
+              IFP=(ISP-1)/2
+              IFQ=(-ISQ-1)/2
+              IPQ=(ISP-ISQ)/2
+!
+              IF(HTM(I+IHE(J)+IFP,K,J+ISP)                              &
+     &          *HTM(I+IHE(J)+IFQ,K,J+ISQ)                              &
+     &          *HTM(I+IPQ,K,J+ISP+ISQ)>0.1)THEN
+                 GO TO 150
+              ENDIF
+!
+              IF(HTM(I+IHE(J)+IFP,K,J+ISP)                              &
+     &          +HTM(I+IHE(J)+IFQ,K,J+ISQ)                              &
+     &          +HTM(I+IPQ,K,J+ISP+ISQ)<0.1)THEN 
+!
+                T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)
+                T(I+IPQ,K,J+ISP+ISQ)=T(I,K,J)
+!
+              ELSEIF                                                    &
+     &        (HTM(I+IHE(J)+IFP,K,J+ISP)+HTM(I+IPQ,K,J+ISP+ISQ)         &
+     &         <0.99)THEN
+!
+                T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)
+                T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFQ,K,J+ISQ)
+!
+              ELSEIF                                                    &
+     &        (HTM(I+IHE(J)+IFQ,K,J+ISQ)+HTM(I+IPQ,K,J+ISP+ISQ)         &
+               <0.99)THEN
+!
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)
+                T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)
+!
+              ELSEIF                                                    &
+     &        (HTM(I+IHE(J)+IFP,K,J+ISP)                                &
+     &        +HTM(I+IHE(J)+IFQ,K,J+ISQ)<0.99)THEN
+                T(I+IHE(J)+IFP,K,J+ISP)=0.5*(T(I,K,J)                   &
+     &                                      +T(I+IPQ,K,J+ISP+ISQ))
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)
+!
+              ELSEIF(HTM(I+IHE(J)+IFP,K,J+ISP)<0.99)THEN
+                T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)                        &
+     &                                 +T(I+IPQ,K,J+ISP+ISQ)            &
+     &                                 -T(I+IHE(J)+IFQ,K,J+ISQ)
+!
+              ELSEIF(HTM(I+IHE(J)+IFQ,K,J+ISQ)<0.99)THEN
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)                        &
+     &                                 +T(I+IPQ,K,J+ISP+ISQ)            &
+     &                                 -T(I+IHE(J)+IFP,K,J+ISP)
+!
+              ELSE
+                T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)            &
+     &                              +T(I+IHE(J)+IFQ,K,J+ISQ)            &
+     &                              -T(I,K,J)
+!
+              ENDIF
+!
+  150         CONTINUE
+!
+!-----------------------------------------------------------------------
+!
+              IF(I==IUP_ADH_J)THEN  ! Update advection H tendencies
+!
+                ISP=ISPA(I,K)
+                ISQ=ISQA(I,K)
+                IFP=(ISP-1)/2
+                IFQ=(-ISQ-1)/2
+                IPQ=(ISP-ISQ)/2
+!
+                F0=ARRAY0(I,K)
+                F1=ARRAY1(I,K)
+                F2=ARRAY2(I,K)
+                F3=ARRAY3(I,K)
+!
+                ADT(I,K,J)=F0*T(I,K,J)                                  &
+     &                    +F1*T(I+IHE(J)+IFP,K,J+ISP)                   &
+     &                    +F2*T(I+IHE(J)+IFQ,K,J+ISQ)                   &
+                          +F3*T(I+IPQ,K,J+ISP+ISQ)
+!
+!-----------------------------------------------------------------------
+!
+                IF(KNTI_ADH<N_IUPADH_J)THEN
+                  IUP_ADH_J=IUP_ADH(IMS+KNTI_ADH,J)
+                  KNTI_ADH=KNTI_ADH+1
+                ENDIF
+!
+              ENDIF  ! End of advection H tendency IF block
+!
+            ENDDO  ! End of II loop
+!
+          ENDDO  ! End of K loop
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  UPSTREAM ADVECTION OF VELOCITY COMPONENTS
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+          N_IUPADV_J=N_IUP_ADV(J)
+!
+          DO K=KTS,KTE
+!
+            DO II=0,N_IUPADV_J-1
+              I=IUP_ADV(IMS+II,J)
+!
+              TTA=EM_LOC(J)*UST(I,K,J1_00)
+              TTB=EN       *VST(I,K,J1_00)
+              PP=-TTA-TTB
+              QP=TTA-TTB
+!
+              IF(PP<0.)THEN
+                ISP=-1
+              ELSE
+                ISP= 1
+              ENDIF
+!
+              IF(QP<0.)THEN
+                ISQ=-1
+              ELSE
+                ISQ= 1
+              ENDIF
+!
+              IFP=(ISP-1)/2
+              IFQ=(-ISQ-1)/2
+              IPQ=(ISP-ISQ)/2
+              PP=ABS(PP)
+              QP=ABS(QP)
+              F3=PP*QP
+              F0=F3-PP-QP
+              F1=PP-F3
+              F2=QP-F3
+!
+              ADU(I,K,J)=F0*U(I,K,J)                                    &
+     &                  +F1*U(I+IVE(J)+IFP,K,J+ISP)                     &
+     &                  +F2*U(I+IVE(J)+IFQ,K,J+ISQ)                     &
+     &                  +F3*U(I+IPQ,K,J+ISP+ISQ)
+! 
+              ADV(I,K,J)=F0*V(I,K,J)                                    &
+     &                  +F1*V(I+IVE(J)+IFP,K,J+ISP)                     &
+     &                  +F2*V(I+IVE(J)+IFQ,K,J+ISQ)                     &
+     &                  +F3*V(I+IPQ,K,J+ISP+ISQ)
+!
+            ENDDO
+!
+          ENDDO  !  End of K loop
+!
+!-----------------------------------------------------------------------
+!
+        ENDIF upstream
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  END OF THIS UPSTREAM REGION
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!***  COMPUTE VERTICAL ADVECTION TENDENCIES USING CRANK-NICHOLSON.
+!
+!-----------------------------------------------------------------------
+!***  FIRST THE TEMPERATURE
+!-----------------------------------------------------------------------
+!
+      iloop_for_t:  DO I=MYIS1,MYIE1
+!
+        PDOP=PDSLO(I,J)
+        PVVLO=PETDT(I,KTE-1,J)*DTQ
+        VVLO=PVVLO/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOP)
+        CMT=-VVLO+1.
+        RCMT(KTE)=1./CMT
+        CRT(KTE)=VVLO
+        RSTT(KTE)=-VVLO*(T(I,KTE-1,J)-T(I,KTE,J))+T(I,KTE,J)
+!
+        LMHK=KTE-LMH(I,J)+1
+        DO K=KTE-1,LMHK+1,-1
+          RDP=1./(DETA1_PDTOP(K)+DETA2(K)*PDOP)
+          PVVUP=PVVLO
+          PVVLO=PETDT(I,K-1,J)*DTQ
+          VVUP=PVVUP*RDP
+          VVLO=PVVLO*RDP
+          CFT=-VVUP*RCMT(K+1)
+          CMT=-CRT(K+1)*CFT+(VVUP-VVLO+1.)
+          RCMT(K)=1./CMT
+          CRT(K)=VVLO
+          RSTT(K)=-RSTT(K+1)*CFT+T(I,K,J)                               &
+     &            -(T(I,K,J)-T(I,K+1,J))*VVUP                           &
+     &            -(T(I,K-1,J)-T(I,K,J))*VVLO
+        ENDDO
+!
+        PVVUP=PVVLO
+        VVUP=PVVUP/(DETA1_PDTOP(LMHK)+DETA2(LMHK)*PDOP)
+        CFT=-VVUP*RCMT(LMHK+1)
+        CMT=-CRT(LMHK+1)*CFT+VVUP+1.
+        CRT(LMHK)=0.
+        RSTT(LMHK)=-(T(I,LMHK,J)-T(I,LMHK+1,J))*VVUP                    &
+     &               -RSTT(LMHK+1)*CFT+T(I,LMHK,J)
+        TN(LMHK)=RSTT(LMHK)/CMT
+        VAD_TEND_T(I,LMHK)=TN(LMHK)-T(I,LMHK,J)
+!
+        DO K=LMHK+1,KTE
+          TN(K)=(-CRT(K)*TN(K-1)+RSTT(K))*RCMT(K)
+          VAD_TEND_T(I,K)=TN(K)-T(I,K,J)
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  The following section is only for checking the implicit solution
+!***  using back-substitution.  Remove this section otherwise.
+!-----------------------------------------------------------------------
+!
+!       IF(I==ITEST.AND.J==JTEST)THEN
+!!
+!         PVVLO=PETDT(I,KTE-1,J)*DT*0.25
+!         VVLO=PVVLO/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOP)
+!         TTLO=VVLO*(T(I,KTE-1,J)-T(I,KTE,J)                            &
+!    &              +TN(KTE-1)-TN(KTE))
+!         ADTP=TTLO+TN(KTE)-T(I,KTE,J)
+!         WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',KTE     &
+!    &,             ' ADTP=',ADTP
+!         WRITE(0,*)' T=',T(I,KTE,J),' TN=',TN(KTE)                     &
+!    &,               ' VAD_TEND_T=',VAD_TEND_T(I,KTE)
+!         WRITE(0,*)' '
+!!
+!         DO K=KTE-1,LMHK+1,-1
+!           RDP=1./(DETA1_PDTOP(K)+DETA2(K)*PDOP)
+!           PVVUP=PVVLO
+!           PVVLO=PETDT(I,K-1,J)*DT*0.25
+!           VVUP=PVVUP*RDP
+!           VVLO=PVVLO*RDP
+!           TTUP=VVUP*(T(I,K,J)-T(I,K+1,J)+TN(K)-TN(K+1))
+!           TTLO=VVLO*(T(I,K-1,J)-T(I,K,J)+TN(K-1)-TN(K))
+!           ADTP=TTLO+TTUP+TN(K)-T(I,K,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',K             &
+!    &,               ' ADTP=',ADTP
+!           WRITE(0,*)' T=',T(I,K,J),' TN=',TN(K)                       &
+!    &,               ' VAD_TEND_T=',VAD_TEND_T(I,K)
+!           WRITE(0,*)' '
+!         ENDDO
+!!
+!         IF(LMHK==KTS)THEN
+!           PVVUP=PVVLO
+!           VVUP=PVVUP/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOP)
+!           TTUP=VVUP*(T(I,KTS,J)-T(I,KTS+1,J)+TN(KTS)-TN(KTS+1))
+!           ADTP=TTUP+TN(KTS)-T(I,KTS,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',KTS           &
+!    &,               ' ADTP=',ADTP
+!           WRITE(0,*)' T=',T(I,KTS,J),' TN=',TN(KTS)                   &
+!    &,               ' VAD_TEND_T=',VAD_TEND_T(I,KTS)
+!           WRITE(0,*)' '
+!         ENDIF
+!       ENDIF
+!
+!-----------------------------------------------------------------------
+!***  End of check.
+!-----------------------------------------------------------------------
+!
+      ENDDO iloop_for_t
+!
+!-----------------------------------------------------------------------
+!***  NOW VERTICAL ADVECTION OF WIND COMPONENTS
+!-----------------------------------------------------------------------
+!
+      iloop_for_uv:  DO I=MYIS1,MYIE1
+!
+        PDOPU=(PDSLO(I+IVW(J),J)+PDSLO(I+IVE(J),J))*0.5
+        PDOPV=(PDSLO(I,J-1)+PDSLO(I,J+1))*0.5
+        PVVLOU=(PETDT(I+IVW(J),KTE-1,J)+PETDT(I+IVE(J),KTE-1,J))*DTE
+        PVVLOV=(PETDT(I,KTE-1,J-1)+PETDT(I,KTE-1,J+1))*DTE
+        VVLOU=PVVLOU/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPU)
+        VVLOV=PVVLOV/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPV)
+        CMU=-VVLOU+1.
+        CMV=-VVLOV+1.
+        RCMU(KTE)=1./CMU
+        RCMV(KTE)=1./CMV
+        CRU(KTE)=VVLOU
+        CRV(KTE)=VVLOV
+        RSTU(KTE)=-VVLOU*(U(I,KTE-1,J)-U(I,KTE,J))+U(I,KTE,J)
+        RSTV(KTE)=-VVLOV*(V(I,KTE-1,J)-V(I,KTE,J))+V(I,KTE,J)
+!
+        LMVK=KTE-LMV(I,J)+1
+        DO K=KTE-1,LMVK+1,-1
+          RDPU=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPU)
+          RDPV=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPV)
+          PVVUPU=PVVLOU
+          PVVUPV=PVVLOV
+          PVVLOU=(PETDT(I+IVW(J),K-1,J)+PETDT(I+IVE(J),K-1,J))*DTE
+          PVVLOV=(PETDT(I,K-1,J-1)+PETDT(I,K-1,J+1))*DTE
+          VVUPU=PVVUPU*RDPU
+          VVUPV=PVVUPV*RDPV
+          VVLOU=PVVLOU*RDPU
+          VVLOV=PVVLOV*RDPV
+          CFU=-VVUPU*RCMU(K+1)
+          CFV=-VVUPV*RCMV(K+1)
+          CMU=-CRU(K+1)*CFU+VVUPU-VVLOU+1.
+          CMV=-CRV(K+1)*CFV+VVUPV-VVLOV+1.
+          RCMU(K)=1./CMU
+          RCMV(K)=1./CMV
+          CRU(K)=VVLOU
+          CRV(K)=VVLOV
+          RSTU(K)=-RSTU(K+1)*CFU+U(I,K,J)                               &
+     &            -(U(I,K,J)-U(I,K+1,J))*VVUPU                          &
+     &            -(U(I,K-1,J)-U(I,K,J))*VVLOU
+          RSTV(K)=-RSTV(K+1)*CFV+V(I,K,J)                               &
+     &            -(V(I,K,J)-V(I,K+1,J))*VVUPV                          &
+     &            -(V(I,K-1,J)-V(I,K,J))*VVLOV
+        ENDDO
+!
+        RDPU=1./(DETA1_PDTOP(LMVK)+DETA2(LMVK)*PDOPU)
+        RDPV=1./(DETA1_PDTOP(LMVK)+DETA2(LMVK)*PDOPV)
+        PVVUPU=PVVLOU
+        PVVUPV=PVVLOV
+        VVUPU=PVVUPU*RDPU
+        VVUPV=PVVUPV*RDPV
+        CFU=-VVUPU*RCMU(LMVK+1)
+        CFV=-VVUPV*RCMV(LMVK+1)
+        CMU=-CRU(LMVK+1)*CFU+VVUPU+1.
+        CMV=-CRV(LMVK+1)*CFV+VVUPV+1.
+        CRU(LMVK)=0.
+        CRV(LMVK)=0.
+        RSTU(LMVK)=-(U(I,LMVK,J)-U(I,LMVK+1,J))*VVUPU                   &
+     &               -RSTU(LMVK+1)*CFU+U(I,LMVK,J)
+        RSTV(LMVK)=-(V(I,LMVK,J)-V(I,LMVK+1,J))*VVUPV                   &
+     &               -RSTV(LMVK+1)*CFV+V(I,LMVK,J)
+        UN(LMVK)=RSTU(LMVK)/CMU
+        VN(LMVK)=RSTV(LMVK)/CMV
+        VAD_TEND_U(I,LMVK)=UN(LMVK)-U(I,LMVK,J)
+        VAD_TEND_V(I,LMVK)=VN(LMVK)-V(I,LMVK,J)
+!
+        DO K=LMVK+1,KTE
+          UN(K)=(-CRU(K)*UN(K-1)+RSTU(K))*RCMU(K)
+          VN(K)=(-CRV(K)*VN(K-1)+RSTV(K))*RCMV(K)
+          VAD_TEND_U(I,K)=UN(K)-U(I,K,J)
+          VAD_TEND_V(I,K)=VN(K)-V(I,K,J)
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  The following section is only for checking the implicit solution
+!***  using back-substitution.  Remove this section otherwise.
+!-----------------------------------------------------------------------
+!
+!       IF(I==ITEST.AND.J==JTEST)THEN
+!!
+!         PDOPU=(PDSLO(I+IVW(J),J)+PDSLO(I+IVE(J),J))*0.5
+!         PDOPV=(PDSLO(I,J-1)+PDSLO(I,J+1))*0.5
+!         PVVLOU=(PETDT(I+IVW(J),KTE-1,J)                               &
+!    &           +PETDT(I+IVE(J),KTE-1,J))*DTE
+!         PVVLOV=(PETDT(I,KTE-1,J-1)                                    &
+!    &           +PETDT(I,KTE-1,J+1))*DTE
+!         VVLOU=PVVLOU/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPU)
+!         VVLOV=PVVLOV/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPV)
+!         TULO=VVLOU*(U(I,KTE-1,J)-U(I,KTE,J)+UN(KTE-1)-UN(KTE))
+!         TVLO=VVLOV*(V(I,KTE-1,J)-V(I,KTE,J)+VN(KTE-1)-VN(KTE))
+!         ADUP=TULO+UN(KTE)-U(I,KTE,J)
+!         ADVP=TVLO+VN(KTE)-V(I,KTE,J)
+!         WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',KTE             &
+!    &,             ' ADUP=',ADUP,' ADVP=',ADVP
+!         WRITE(0,*)' U=',U(I,KTE,J),' UN=',UN(KTE)                     &
+!    &,             ' VAD_TEND_U=',VAD_TEND_U(I,KTE)                    &
+!    &,             ' V=',V(I,KTE,J),' VN=',VN(KTE)                     &
+!    &,             ' VAD_TEND_V=',VAD_TEND_V(I,KTE)
+!         WRITE(0,*)' '
+!!
+!         DO K=KTE-1,LMVK+1,-1
+!           RDPU=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPU)
+!           RDPV=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPV)
+!           PVVUPU=PVVLOU
+!           PVVUPV=PVVLOV
+!           PVVLOU=(PETDT(I+IVW(J),K-1,J)                               &
+!    &            +PETDT(I+IVE(J),K-1,J))*DTE
+!           PVVLOV=(PETDT(I,K-1,J-1)+PETDT(I,K-1,J+1))*DTE
+!           VVUPU=PVVUPU*RDPU
+!           VVUPV=PVVUPV*RDPV
+!           VVLOU=PVVLOU*RDPU
+!           VVLOV=PVVLOV*RDPV
+!           TUUP=VVUPU*(U(I,K,J)-U(I,K+1,J)+UN(K)-UN(K+1))
+!           TVUP=VVUPV*(V(I,K,J)-V(I,K+1,J)+VN(K)-VN(K+1))
+!           TULO=VVLOU*(U(I,K-1,J)-U(I,K,J)+UN(K-1)-UN(K))
+!           TVLO=VVLOV*(V(I,K-1,J)-V(I,K,J)+VN(K-1)-VN(K))
+!           ADUP=TUUP+TULO+UN(K)-U(I,K,J)
+!           ADVP=TVUP+TVLO+VN(K)-V(I,K,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',K     &
+!    &,               ' ADUP=',ADUP,' ADVP=',ADVP
+!           WRITE(0,*)' U=',U(I,K,J),' UN=',UN(K)                       &
+!    &,               ' VAD_TEND_U=',VAD_TEND_U(I,K)                    &
+!    &,               ' V=',V(I,K,J),' VN=',VN(K)                       &
+!    &,               ' VAD_TEND_V=',VAD_TEND_V(I,K)
+!           WRITE(0,*)' '
+!         ENDDO
+!!
+!         IF(LMVK==KTS)THEN
+!           PVVUPU=PVVLOU
+!           PVVUPV=PVVLOV
+!           VVUPU=PVVUPU/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOPU)
+!           VVUPV=PVVUPV/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOPV)
+!           TUUP=VVUPU*(U(I,KTS,J)-U(I,KTS+1,J)+UN(KTS)-UN(KTS+1))
+!           TVUP=VVUPV*(V(I,KTS,J)-V(I,KTS+1,J)+VN(KTS)-VN(KTS+1))
+!           ADUP=TUUP+UN(KTS)-U(I,KTS,J)
+!           ADVP=TVUP+VN(KTS)-V(I,KTS,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',KTS   &
+!    &,               ' ADUP=',ADUP,' ADVP=',ADVP
+!           WRITE(0,*)' U=',U(I,KTS,J),' UN=',UN(KTS)                   &
+!    &,               ' VAD_TEND_U=',VAD_TEND_U(I,KTS)                  &
+!    &,               ' V=',V(I,KTS,J),' VN=',VN(KTS)                   &
+!    &,               ' VAD_TEND_V=',VAD_TEND_V(I,KTS)
+!           WRITE(0,*)' '
+!         ENDIF
+!       ENDIF
+!
+!-----------------------------------------------------------------------
+!***  End of check.
+!-----------------------------------------------------------------------
+!
+      ENDDO iloop_for_uv
+!
+!
+!-----------------------------------------------------------------------
+!
+!***  NOW SUM THE VERTICAL AND HORIZONTAL TENDENCIES,
+!***  CURVATURE AND CORIOLIS TERMS
+!
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+      DO I=MYIS1,MYIE1
+        HM=HTM(I,K,J)*HBM2(I,J)
+        VM=VTM(I,K,J)*VBM2(I,J)
+        ADT(I,K,J)=(VAD_TEND_T(I,K)+2.*ADT(I,K,J))*HM
+!
+        FPP=CURV(I,J)*2.*UST(I,K,J1_00)+F(I,J)*2.
+        ADU(I,K,J)=(VAD_TEND_U(I,K)+2.*ADU(I,K,J)+VST(I,K,J1_00)*FPP)   &
+     &             *VM
+        ADV(I,K,J)=(VAD_TEND_V(I,K)+2.*ADV(I,K,J)-UST(I,K,J1_00)*FPP)   &
+     &             *VM
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      ENDDO main_integration
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***  SAVE THE OLD VALUES FOR TIMESTEPPING
+!-----------------------------------------------------------------------
+!
+      DO J=MYJS_P4,MYJE_P4
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          TOLD(I,K,J)=T(I,K,J)
+          UOLD(I,K,J)=U(I,K,J)
+          VOLD(I,K,J)=V(I,K,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  FINALLY UPDATE THE PROGNOSTIC VARIABLES
+!-----------------------------------------------------------------------
+!
+      DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+        DO I=MYIS1,MYIE1
+          T(I,K,J)=ADT(I,K,J)+T(I,K,J)
+          U(I,K,J)=ADU(I,K,J)+U(I,K,J)
+          V(I,K,J)=ADV(I,K,J)+V(I,K,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      END SUBROUTINE ADVE
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/init_modules_nmm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/init_modules_nmm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/init_modules_nmm.F	(revision 2744)
@@ -0,0 +1,7 @@
+!WRF:MEDIATION_LAYER
+!
+SUBROUTINE init_modules_nmm
+! USE module_indx
+! CALL init_module_indx
+END SUBROUTINE init_modules_nmm
+
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_ADVECTION.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_ADVECTION.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_ADVECTION.F	(revision 2744)
@@ -0,0 +1,3727 @@
+!----------------------------------------------------------------------
+!#define BIT_FOR_BIT
+!----------------------------------------------------------------------
+#include "nmm_loop_basemacros.h"
+#include "nmm_loop_macros.h"
+!----------------------------------------------------------------------
+!
+!NCEP_MESO:MODEL_LAYER: HORIZONTAL AND VERTICAL ADVECTION
+!
+!----------------------------------------------------------------------
+!
+      MODULE MODULE_ADVECTION
+!
+!----------------------------------------------------------------------
+      USE MODULE_MODEL_CONSTANTS
+      USE MODULE_EXT_INTERNAL
+!----------------------------------------------------------------------
+#ifdef DM_PARALLEL
+      INCLUDE "mpif.h"
+#endif
+!----------------------------------------------------------------------
+!
+      REAL,PARAMETER :: FF2=-0.64813,FF3=0.24520,FF4=-0.12189
+      REAL,PARAMETER :: FFC=1.533,FBC=1.-FFC
+      REAL :: CONSERVE_MIN=0.9,CONSERVE_MAX=1.1
+!
+!----------------------------------------------------------------------
+!***  CRANK-NICHOLSON OFF-CENTER WEIGHTS FOR CURRENT AND FUTURE
+!***  TIME LEVELS.
+!-----------------------------------------------------------------------
+!
+      REAL,PARAMETER :: WGT1=0.90
+      REAL,PARAMETER :: WGT2=2.-WGT1
+!
+!***  FOR CRANK_NICHOLSON CHECK ONLY.
+!
+      INTEGER :: ITEST=47,JTEST=70
+      REAL :: ADTP,ADUP,ADVP,TTLO,TTUP,TULO,TUUP,TVLO,TVUP
+!
+!----------------------------------------------------------------------
+      CONTAINS
+!
+!*********************************************************************** 
+      SUBROUTINE ADVE(NTSD,DT,DETA1,DETA2,PDTOP                         &
+     &               ,CURV,F,FAD,F4D,EM_LOC,EMT_LOC,EN,ENT,DX,DY        &
+     &               ,HTM,HBM2,VTM,VBM2,LMH,LMV                         &
+     &               ,T,U,V,PDSLO,TOLD,UOLD,VOLD                        &
+     &               ,PETDT,UPSTRM                                      &
+     &               ,FEW,FNS,FNE,FSE                                   &
+     &               ,ADT,ADU,ADV                                       &
+     &               ,N_IUP_H,N_IUP_V                                   &
+     &               ,N_IUP_ADH,N_IUP_ADV                               &
+     &               ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                       &
+     &               ,IHE,IHW,IVE,IVW,INDX3_WRK                         &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &               ,IMS,IME,JMS,JME,KMS,KME                           &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    ADVE        HORIZONTAL AND VERTICAL ADVECTION
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 93-10-28       
+!     
+! ABSTRACT:
+!     ADVE CALCULATES THE CONTRIBUTION OF THE HORIZONTAL AND VERTICAL
+!     ADVECTION TO THE TENDENCIES OF TEMPERATURE AND WIND AND THEN
+!     UPDATES THOSE VARIABLES.
+!     THE JANJIC ADVECTION SCHEME FOR THE ARAKAWA E GRID IS USED
+!     FOR ALL VARIABLES INSIDE THE FIFTH ROW.  AN UPSTREAM SCHEME
+!     IS USED ON ALL VARIABLES IN THE THIRD, FOURTH, AND FIFTH
+!     OUTERMOST ROWS.  THE ADAMS-BASHFORTH TIME SCHEME IS USED.
+!     
+! PROGRAM HISTORY LOG:
+!   87-06-??  JANJIC       - ORIGINATOR
+!   95-03-25  BLACK        - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   96-03-28  BLACK        - ADDED EXTERNAL EDGE
+!   98-10-30  BLACK        - MODIFIED FOR DISTRIBUTED MEMORY
+!   99-07-    JANJIC       - CONVERTED TO ADAMS-BASHFORTH SCHEME
+!                            COMBINING HORIZONTAL AND VERTICAL ADVECTION
+!   02-02-04  BLACK        - ADDED VERTICAL CFL CHECK
+!   02-02-05  BLACK        - CONVERTED TO WRF FORMAT
+!   02-08-29  MICHALAKES   - CONDITIONAL COMPILATION OF MPI
+!                            CONVERT TO GLOBAL INDEXING
+!   02-09-06  WOLFE        - MORE CONVERSION TO GLOBAL INDEXING
+!   04-05-29  JANJIC,BLACK - CRANK-NICHOLSON VERTICAL ADVECTION
+!   04-11-23  BLACK        - THREADED 
+!     
+! USAGE: CALL ADVE FROM SUBROUTINE SOLVE_NMM
+!   INPUT ARGUMENT LIST:
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+      INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V         &
+     &                                         ,N_IUP_ADH,N_IUP_ADV
+      INTEGER, DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V     &
+     &                                                 ,IUP_ADH,IUP_ADV &
+     &                                                 ,LMH,LMV
+!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      REAL,INTENT(IN) :: DT,DY,EN,ENT,F4D,PDTOP
+!
+      REAL,DIMENSION(NMM_MAX_DIM),INTENT(IN) :: EM_LOC,EMT_LOC
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CURV,DX,F,FAD,HBM2  &
+     &                                             ,PDSLO,VBM2
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: T,TOLD   &
+     &                                                        ,U,UOLD   &
+     &                                                        ,V,VOLD
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: ADT,ADU    &
+     &                                                      ,ADV        &
+     &                                                      ,FEW,FNE    &
+     &                                                      ,FNS,FSE
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      LOGICAL :: UPSTRM
+!
+      INTEGER :: I,IEND,IFP,IFQ,II,IPQ,ISP,ISQ,ISTART                   &
+     &          ,IUP_ADH_J,IVH,IVL                                      &
+     &          ,J,J1,JA,JAK,JEND,JGLOBAL,JJ,JKNT,JP2,JSTART            &
+     &          ,K,KNTI_ADH,KSTART,KSTOP,LMHK,LMVK                      &
+     &          ,N,N_IUPH_J,N_IUPADH_J,N_IUPADV_J
+!
+      INTEGER :: MY_IS_GLB,MY_IE_GLB,MY_JS_GLB,MY_JE_GLB
+!
+      INTEGER :: J0_P3,J0_P2,J0_P1,J0_00,J0_M1,J1_P2,J1_P1,J1_00,J1_M1  &
+     &          ,J2_P1,J2_00,J2_M1,J3_P2,J3_P1,J3_00                    &
+     &          ,J4_P1,J4_00,J4_M1,J5_00,J5_M1,J6_P1,J6_00
+!
+      INTEGER,DIMENSION(ITS-5:ITE+5) :: KBOT_CFL_T,KTOP_CFL_T           &
+     &                                 ,KBOT_CFL_U,KTOP_CFL_U           &
+     &                                 ,KBOT_CFL_V,KTOP_CFL_V
+!
+      INTEGER,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: ISPA,ISQA
+!
+      REAL :: ARRAY3_X,CFL,CFT,CFU,CFV,CMT,CMU,CMV                      &
+     &       ,DPDE_P3,DTE,DTQ                                           &
+     &       ,F0,F1,F2,F3,FEW_00,FEW_P1,FNE_X,FNS_P1,FNS_X,FPP,FSE_X    &
+     &       ,HM,PDOP,PDOPU,PDOPV,PP                                    &
+     &       ,PVVLO,PVVLOU,PVVLOV,PVVUP,PVVUPU,PVVUPV                   &
+     &       ,QP,RDP,RDPD,RDPDX,RDPDY,RDPU,RDPV                         &
+     &       ,T_UP,TEMPA,TEMPB,TTA,TTB,U_UP,UDY_P1,UDY_X                &
+     &       ,VXD_X,VDX_P2,V_UP,VDX_X,VM,VTA,VUA,VVA                    &
+     &       ,VVLO,VVLOU,VVLOV,VVUP,VVUPU,VVUPV
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: ARRAY0,ARRAY1              &
+     &                                      ,ARRAY2,ARRAY3              &
+     &                                      ,VAD_TEND_T,VAD_TEND_U      &
+     &                                      ,VAD_TEND_V
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: TEW,UEW,VEW
+!
+      REAL,DIMENSION(KTS:KTE) :: CRT,CRU,CRV,DETA1_PDTOP                &
+     &                          ,RCMT,RCMU,RCMV,RSTT,RSTU,RSTV,TN,UN    &
+     &                          ,VAD_TNDX_T,VAD_TNDX_U,VAD_TNDX_V,VN
+!
+      REAL,DIMENSION(ITS-5:ITE+5,-1:1) :: PETDTK
+!
+      REAL,DIMENSION(ITS-5:ITE+5) :: TDN,UDN,VDN
+!
+!-----------------------------------------------------------------------
+!
+!***  TYPE 0 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-3:3) :: DPDE
+!
+!***  TYPE 1 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-2:2) :: TST,UDY,UST,VDX,VST
+!
+!***  TYPE 4 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-1:1) :: TNS,UNS,VNS
+!
+!***  TYPE 5 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-1:0) :: TNE,UNE,VNE
+!
+!***  TYPE 6 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KMS:KME, 0:1) :: TSE,USE,VSE
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***********************************************************************
+!
+!                         DPDE      -----  3
+!                          |                      J Increasing
+!                          |                        
+!                          |                            ^
+!                         FNS       -----  2            |
+!                          |                            |
+!                          |                            |
+!                          |                            |
+!                         VNS       -----  1            |
+!                          |
+!                          |
+!                          |
+!                         ADV       -----  0  ------> Current J
+!                          |
+!                          |
+!                          |
+!                         VNS       ----- -1
+!                          |
+!                          |
+!                          |
+!                         FNS       ----- -2
+!                          |
+!                          |
+!                          |
+!                         DPDE      ----- -3
+!
+!***********************************************************************
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      ISTART=MYIS_P2
+      IEND=MYIE_P2 
+      IF(ITE==IDE)IEND=MYIE-3 
+!
+      DTQ=DT*0.25
+      DTE=DT*(0.5*0.25)
+!***
+!***  INITIALIZE SOME WORKING ARRAYS TO ZERO
+!***
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        TEW(I,K)=0.
+        UEW(I,K)=0.
+        VEW(I,K)=0.
+      ENDDO
+      ENDDO
+!
+!***  TYPE 0
+!
+      DO N=-3,3
+        DO K=KTS,KTE
+        DO I=ITS-5,ITE+5
+          DPDE(I,K,N)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!***  TYPE 1
+!
+      DO N=-2,2
+        DO K=KTS,KTE
+        DO I=ITS-5,ITE+5
+          TST(I,K,N)=0.
+          UST(I,K,N)=0.
+          VST(I,K,N)=0.
+          UDY(I,K,N)=0.
+          VDX(I,K,N)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!***  TYPES 5 AND 6
+!
+      DO N=-1,0
+        DO K=KTS,KTE
+        DO I=ITS-5,ITE+5
+          TNE(I,K,N)=0.
+          TSE(I,K,N+1)=0.
+          UNE(I,K,N)=0.
+          USE(I,K,N+1)=0.
+          VNE(I,K,N)=0.
+          VSE(I,K,N+1)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!***
+!***  PRECOMPUTE DETA1 TIMES PDTOP.
+!***
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+        DETA1_PDTOP(K)=DETA1(K)*PDTOP
+      ENDDO
+!-----------------------------------------------------------------------
+!***
+!***  WE NEED THE STARTING AND ENDING J FOR THIS TASK'S INTEGRATION
+!***
+!-----------------------------------------------------------------------
+!
+      JSTART=MYJS2
+      JEND=MYJE2
+!
+!-----------------------------------------------------------------------
+!
+!***  START THE HORIZONTAL ADVECTION IN THE INITIAL SOUTHERN SLABS.
+!
+!-----------------------------------------------------------------------
+!
+      DO J=-2,1
+        JJ=JSTART+J
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          TST(I,K,J)=T(I,K,JJ)*FFC+TOLD(I,K,JJ)*FBC
+          UST(I,K,J)=U(I,K,JJ)*FFC+UOLD(I,K,JJ)*FBC
+          VST(I,K,J)=V(I,K,JJ)*FFC+VOLD(I,K,JJ)*FBC
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
+!***  FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
+!***  IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J.
+!***  ONLY THE NORTHERNMOST OF EACH OF THE WORKING ARRAYS WILL BE
+!***  FILLED IN THE PRIMARY INTEGRATION SECTION.
+!-----------------------------------------------------------------------
+!
+      J1=-3
+      IF(JTS==JDS)J1=-2  ! Cannot go 3 south from J=2 for south tasks
+!
+      DO J=J1,2
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          DPDE(I,K,J)=DETA1_PDTOP(K)+DETA2(K)*PDSLO(I,JJ)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-2,1
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          UDY(I,K,J)=U(I,K,JJ)*DY
+          VDX_X=V(I,K,JJ)*DX(I,JJ)
+          FNS(I,K,JJ)=VDX_X*(DPDE(I,K,J-1)+DPDE(I,K,J+1))
+          VDX(I,K,J)=VDX_X
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-2,0
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k,tempa)
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          TEMPA=(UDY(I+IHE(JJ),K,J)+VDX(I+IHE(JJ),K,J))                 &
+     &         +(UDY(I,K,J+1)      +VDX(I,K,J+1))
+          FNE(I,K,JJ)=TEMPA*(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J+1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-1,1
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k,tempb)
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          TEMPB=(UDY(I+IHE(JJ),K,J)-VDX(I+IHE(JJ),K,J))                 &
+     &         +(UDY(I,K,J-1)      -VDX(I,K,J-1))
+          FSE(I,K,JJ)=TEMPB*(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J-1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO J=-1,0
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(fns_x,i,k,udy_x)
+        DO K=KTS,KTE
+        DO I=MYIS1_P3,MYIE1_P3
+          FNS_X=FNS(I,K,JJ)
+          TNS(I,K,J)=FNS_X*(TST(I,K,J+1)-TST(I,K,J-1))
+!
+          UDY_X=U(I,K,JJ)*DY
+          FEW(I,K,JJ)=UDY_X*(DPDE(I+IVW(JJ),K,J)+DPDE(I+IVE(JJ),K,J))   
+        ENDDO
+        ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS1_P4,MYIE1_P4
+          UNS(I,K,J)=(FNS(I+IHW(JJ),K,JJ)+FNS(I+IHE(JJ),K,JJ))          &
+     &              *(UST(I,K,J+1)-UST(I,K,J-1))
+          VNS(I,K,J)=(FNS(I,K,JJ-1)+FNS(I,K,JJ+1))                      &
+     &              *(VST(I,K,J+1)-VST(I,K,J-1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      JJ=JSTART-1
+!
+!$omp parallel do                                                       &
+!$omp& private(fne_x,fse_x,i,k)
+      DO K=KTS,KTE
+      DO I=MYIS1_P2,MYIE1_P2
+        FNE_X=FNE(I,K,JJ)
+        TNE(I,K,-1)=FNE_X*(TST(I+IHE(JJ),K,0)-TST(I,K,-1))
+!
+        FSE_X=FSE(I,K,JJ+1)
+        TSE(I,K,0)=FSE_X*(TST(I+IHE(JJ+1),K,-1)-TST(I,K,0))
+!
+        UNE(I,K,-1)=(FNE(I+IVW(JJ),K,JJ)+FNE(I+IVE(JJ),K,JJ))           &
+     &             *(UST(I+IVE(JJ),K,0)-UST(I,K,-1))
+        USE(I,K,0)=(FSE(I+IVW(JJ+1),K,JJ+1)+FSE(I+IVE(JJ+1),K,JJ+1))    &
+     &            *(UST(I+IVE(JJ+1),K,-1)-UST(I,K,0))
+        VNE(I,K,-1)=(FNE(I,K,JJ-1)+FNE(I,K,JJ+1))                       &
+     &             *(VST(I+IVE(JJ),K,0)-VST(I,K,-1))
+        VSE(I,K,0)=(FSE(I,K,JJ)+FSE(I,K,JJ+2))                          &
+     &            *(VST(I+IVE(JJ+1),K,-1)-VST(I,K,0))
+      ENDDO
+      ENDDO
+!
+      JKNT=0
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      main_integration : DO J=JSTART,JEND
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***
+!***  SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
+!***                                           AND PFDHT DIAGRAMS)
+!***
+!***  J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
+!***  LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
+!***  NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
+!***  THE CURRENT VALUE OF THE main_integration LOOP.
+!***  (P3 denotes +3, M1 denotes -1, etc.)
+!***
+!-----------------------------------------------------------------------
+!
+      JKNT=JKNT+1
+!
+      J0_P3=INDX3_WRK(3,JKNT,0)
+      J0_P2=INDX3_WRK(2,JKNT,0)
+      J0_P1=INDX3_WRK(1,JKNT,0)
+      J0_00=INDX3_WRK(0,JKNT,0)
+      J0_M1=INDX3_WRK(-1,JKNT,0)
+!
+      J1_P2=INDX3_WRK(2,JKNT,1)
+      J1_P1=INDX3_WRK(1,JKNT,1)
+      J1_00=INDX3_WRK(0,JKNT,1)
+      J1_M1=INDX3_WRK(-1,JKNT,1)
+!
+      J2_P1=INDX3_WRK(1,JKNT,2)
+      J2_00=INDX3_WRK(0,JKNT,2)
+      J2_M1=INDX3_WRK(-1,JKNT,2)
+!
+      J3_P2=INDX3_WRK(2,JKNT,3)
+      J3_P1=INDX3_WRK(1,JKNT,3)
+      J3_00=INDX3_WRK(0,JKNT,3)
+!
+      J4_P1=INDX3_WRK(1,JKNT,4)
+      J4_00=INDX3_WRK(0,JKNT,4)
+      J4_M1=INDX3_WRK(-1,JKNT,4)
+!
+      J5_00=INDX3_WRK(0,JKNT,5)
+      J5_M1=INDX3_WRK(-1,JKNT,5)
+!
+      J6_P1=INDX3_WRK(1,JKNT,6)
+      J6_00=INDX3_WRK(0,JKNT,6)
+!
+      MY_IS_GLB=1  ! make this a noop for global indexing
+      MY_IE_GLB=1  ! make this a noop for global indexing
+      MY_JS_GLB=1  ! make this a noop for global indexing
+      MY_JE_GLB=1  ! make this a noop for global indexing
+  
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(dpde_p3,few_00,fne_x,fns_p1,fse_x,i,k,tempa,tempb        &
+!$omp&        ,udy_p1,vdx_p2)
+      vertical_loop_1 : DO K=KTS,KTE
+!
+!-----------------------------------------------------------------------
+!***  EXECUTE HORIZONTAL ADVECTION.
+!-----------------------------------------------------------------------
+!
+      DO I=MYIS_P4,MYIE_P4
+        TST(I,K,J1_P2)=T(I,K,J+2)*FFC+TOLD(I,K,J+2)*FBC
+        UST(I,K,J1_P2)=U(I,K,J+2)*FFC+UOLD(I,K,J+2)*FBC
+        VST(I,K,J1_P2)=V(I,K,J+2)*FFC+VOLD(I,K,J+2)*FBC
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  MASS FLUXES AND MASS POINT ADVECTION COMPONENTS
+!-----------------------------------------------------------------------
+!
+      DO I=MYIS_P4,MYIE_P4
+!
+!-----------------------------------------------------------------------
+!***  THE NS AND EW FLUXES IN THE FOLLOWING LOOP ARE ON V POINTS
+!***  FOR T.
+!-----------------------------------------------------------------------
+!
+        DPDE_P3=DETA1_PDTOP(K)+DETA2(K)*PDSLO(I,J+3)
+        DPDE(I,K,J0_P3)=DPDE_P3
+!
+!-----------------------------------------------------------------------
+        UDY(I,K,J1_P2)=U(I,K,J+2)*DY
+        VDX_P2=V(I,K,J+2)*DX(I,J+2)
+        VDX(I,K,J1_P2)=VDX_P2
+        FNS(I,K,J+2)=VDX_P2*(DPDE(I,K,J0_P1)+DPDE_P3)
+      ENDDO
+!
+!-----------------------------------------------------------------------
+      DO I=MYIS_P3,MYIE_P3
+        TEMPA=(UDY(I+IHE(J+1),K,J1_P1)+VDX(I+IHE(J+1),K,J1_P1))         &
+     &       +(UDY(I,K,J1_P2)         +VDX(I,K,J1_P2))
+        FNE(I,K,J+1)=TEMPA*(DPDE(I,K,J0_P1)+DPDE(I+IHE(J+1),K,J0_P2))
+!
+!-----------------------------------------------------------------------
+        TEMPB=(UDY(I+IHE(J+2),K,J1_P2)-VDX(I+IHE(J+2),K,J1_P2))         &
+     &       +(UDY(I,K,J1_P1)         -VDX(I,K,J1_P1))
+        FSE(I,K,J+2)=TEMPB*(DPDE(I,K,J0_P2)+DPDE(I+IHE(J),K,J0_P1))
+!
+!-----------------------------------------------------------------------
+        FNS_P1=FNS(I,K,J+1)
+        TNS(I,K,J4_P1)=FNS_P1*(TST(I,K,J1_P2)-TST(I,K,J1_00))
+!
+!-----------------------------------------------------------------------
+        UDY_P1=U(I,K,J+1)*DY
+        FEW(I,K,J+1)=UDY_P1*(DPDE(I+IVW(J+1),K,J0_P1)                   &
+     &                        +DPDE(I+IVE(J+1),K,J0_P1))
+        FEW_00=FEW(I,K,J)
+        TEW(I,K)=FEW_00*(TST(I+IVE(J),K,J1_00)-TST(I+IVW(J),K,J1_00))
+!
+!-----------------------------------------------------------------------
+!***  THE NE AND SE FLUXES ARE ASSOCIATED WITH H POINTS
+!***  (ACTUALLY JUST TO THE NE AND SE OF EACH H POINT).
+!-----------------------------------------------------------------------
+!
+        FNE_X=FNE(I,K,J)
+        TNE(I,K,J5_00)=FNE_X*(TST(I+IHE(J),K,J1_P1)-TST(I,K,J1_00))
+!
+        FSE_X=FSE(I,K,J+1)
+        TSE(I,K,J6_P1)=FSE_X*(TST(I+IHE(J+1),K,J1_00)-TST(I,K,J1_P1))
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  CALCULATION OF MOMENTUM ADVECTION COMPONENTS
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  THE NS AND EW FLUXES ARE ON H POINTS FOR U AND V.
+!-----------------------------------------------------------------------
+!
+      DO I=MYIS_P2,MYIE_P2
+        UEW(I,K)=(FEW(I+IHW(J),K,J)+FEW(I+IHE(J),K,J))                  &
+     &          *(UST(I+IHE(J),K,J1_00)-UST(I+IHW(J),K,J1_00))
+        UNS(I,K,J4_P1)=(FNS(I+IHW(J+1),K,J+1)                           &
+     &                 +FNS(I+IHE(J+1),K,J+1))                          &
+     &                *(UST(I,K,J1_P2)-UST(I,K,J1_00))
+        VEW(I,K)=(FEW(I,K,J-1)+FEW(I,K,J+1))                            &
+     &          *(VST(I+IHE(J),K,J1_00)-VST(I+IHW(J),K,J1_00))
+        VNS(I,K,J4_P1)=(FNS(I,K,J)+FNS(I,K,J+2))                        &
+     &                *(VST(I,K,J1_P2)-VST(I,K,J1_00))
+!
+!-----------------------------------------------------------------------
+!***  THE FOLLOWING NE AND SE FLUXES ARE TIED TO V POINTS AND ARE
+!***  LOCATED JUST TO THE NE AND SE OF THE GIVEN I,J.
+!-----------------------------------------------------------------------
+!
+        UNE(I,K,J5_00)=(FNE(I+IVW(J),K,J)+FNE(I+IVE(J),K,J))            &
+     &                *(UST(I+IVE(J),K,J1_P1)-UST(I,K,J1_00))
+        USE(I,K,J6_P1)=(FSE(I+IVW(J+1),K,J+1)                           &
+     &                 +FSE(I+IVE(J+1),K,J+1))                          &
+     &                *(UST(I+IVE(J+1),K,J1_00)-UST(I,K,J1_P1))
+        VNE(I,K,J5_00)=(FNE(I,K,J-1)+FNE(I,K,J+1))                      &
+     &                *(VST(I+IVE(J),K,J1_P1)-VST(I,K,J1_00))
+        VSE(I,K,J6_P1)=(FSE(I,K,J)+FSE(I,K,J+2))                        &
+     &                *(VST(I+IVE(J+1),K,J1_00)-VST(I,K,J1_P1))
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!
+      ENDDO vertical_loop_1
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE THE ADVECTION TENDENCIES FOR T.
+!***  THE AD ARRAYS ARE ON H POINTS.
+!***  SKIP TO UPSTREAM IF THESE ROWS HAVE ONLY UPSTREAM POINTS.
+!-----------------------------------------------------------------------
+!
+      
+      JGLOBAL=J+MY_JS_GLB-1
+      IF(JGLOBAL>=6.AND.JGLOBAL<=JDE-5)THEN
+!
+        JJ=J+MY_JS_GLB-1   ! okay because MY_JS_GLB is 1
+        IF(ITS==IDS)ISTART=3+MOD(JJ,2)  ! need to think about this
+                                        ! more in terms of how to 
+                                        ! convert to global indexing
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k,rdpd)
+        DO K=KTS,KTE
+        DO I=ISTART,IEND
+          RDPD=1./DPDE(I,K,J0_00)
+!
+          ADT(I,K,J)=(TEW(I+IHW(J),K)+TEW(I+IHE(J),K)                   &
+     &               +TNS(I,K,J4_M1)+TNS(I,K,J4_P1)                     &
+     &               +TNE(I+IHW(J),K,J5_M1)+TNE(I,K,J5_00)              &
+     &               +TSE(I,K,J6_00)+TSE(I+IHW(J),K,J6_P1))             &
+     &               *RDPD*FAD(I,J)
+!
+        ENDDO
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE THE ADVECTION TENDENCIES FOR U AND V.
+!***  THE AD ARRAYS ARE ON VELOCITY POINTS.
+!-----------------------------------------------------------------------
+!
+        IF(ITS==IDS)ISTART=3+MOD(JJ+1,2)
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k,rdpdx,rdpdy)
+        DO K=KTS,KTE
+        DO I=ISTART,IEND
+          RDPDX=1./(DPDE(I+IVW(J),K,J0_00)+DPDE(I+IVE(J),K,J0_00))
+          RDPDY=1./(DPDE(I,K,J0_M1)+DPDE(I,K,J0_P1))
+!
+          ADU(I,K,J)=(UEW(I+IVW(J),K)+UEW(I+IVE(J),K)                   &
+     &               +UNS(I,K,J4_M1)+UNS(I,K,J4_P1)                     &
+     &               +UNE(I+IVW(J),K,J5_M1)+UNE(I,K,J5_00)              &
+     &               +USE(I,K,J6_00)+USE(I+IVW(J),K,J6_P1))             &
+     &               *RDPDX*FAD(I+IVW(J),J)
+!
+          ADV(I,K,J)=(VEW(I+IVW(J),K)+VEW(I+IVE(J),K)                   &
+     &               +VNS(I,K,J4_M1)+VNS(I,K,J4_P1)                     &
+     &               +VNE(I+IVW(J),K,J5_M1)+VNE(I,K,J5_00)              &
+     &               +VSE(I,K,J6_00)+VSE(I+IVW(J),K,J6_P1))             &
+     &               *RDPDY*FAD(I+IVW(J),J)
+!
+        ENDDO
+        ENDDO
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!***  END OF JANJIC HORIZONTAL ADVECTION 
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  UPSTREAM ADVECTION OF T, U, AND V
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      upstream : IF(UPSTRM)THEN
+!
+!-----------------------------------------------------------------------
+!***
+!***  COMPUTE UPSTREAM COMPUTATIONS ON THIS TASK'S ROWS.
+!***
+!-----------------------------------------------------------------------
+!
+          N_IUPH_J=N_IUP_H(J)   ! See explanation in INIT
+!
+!$omp parallel do                                                       &
+!$omp& private(array3_x,i,k,pp,qp,tta,ttb)
+          DO K=KTS,KTE
+!
+            DO II=0,N_IUPH_J-1
+              I=IUP_H(IMS+II,J)
+              TTA=EMT_LOC(J)*(UST(I,K,J1_M1)+UST(I+IHW(J),K,J1_00)      &
+     &                       +UST(I+IHE(J),K,J1_00)+UST(I,K,J1_P1))
+              TTB=ENT       *(VST(I,K,J1_M1)+VST(I+IHW(J),K,J1_00)      &
+     &                       +VST(I+IHE(J),K,J1_00)+VST(I,K,J1_P1))
+              PP=-TTA-TTB
+              QP= TTA-TTB
+!
+              IF(PP<0.)THEN
+                ISPA(I,K)=-1
+              ELSE
+                ISPA(I,K)= 1
+              ENDIF
+!
+              IF(QP<0.)THEN
+                ISQA(I,K)=-1
+              ELSE
+                ISQA(I,K)= 1
+              ENDIF
+!
+              PP=ABS(PP)
+              QP=ABS(QP)
+              ARRAY3_X=PP*QP
+              ARRAY0(I,K)=ARRAY3_X-PP-QP
+              ARRAY1(I,K)=PP-ARRAY3_X
+              ARRAY2(I,K)=QP-ARRAY3_X
+              ARRAY3(I,K)=ARRAY3_X
+            ENDDO
+!
+          ENDDO
+!-----------------------------------------------------------------------
+!
+          N_IUPADH_J=N_IUP_ADH(J) 
+!
+!$omp parallel do                                                       &
+!$omp& private(f0,f1,f2,f3,i,ifp,ifq,ipq,isp,isq,iup_adh_j,k,knti_adh)
+          DO K=KTS,KTE
+!
+            KNTI_ADH=1
+            IUP_ADH_J=IUP_ADH(IMS,J)
+!
+            DO II=0,N_IUPH_J-1
+              I=IUP_H(IMS+II,J)
+!
+              ISP=ISPA(I,K)
+              ISQ=ISQA(I,K)
+              IFP=(ISP-1)/2
+              IFQ=(-ISQ-1)/2
+              IPQ=(ISP-ISQ)/2
+!
+              IF(HTM(I+IHE(J)+IFP,K,J+ISP)                              &
+     &          *HTM(I+IHE(J)+IFQ,K,J+ISQ)                              &
+     &          *HTM(I+IPQ,K,J+ISP+ISQ)>0.1)THEN
+                 GO TO 150
+              ENDIF
+!
+              IF(HTM(I+IHE(J)+IFP,K,J+ISP)                              &
+     &          +HTM(I+IHE(J)+IFQ,K,J+ISQ)                              &
+     &          +HTM(I+IPQ,K,J+ISP+ISQ)<0.1)THEN 
+!
+                T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)
+                T(I+IPQ,K,J+ISP+ISQ)=T(I,K,J)
+!
+              ELSEIF                                                    &
+     &        (HTM(I+IHE(J)+IFP,K,J+ISP)+HTM(I+IPQ,K,J+ISP+ISQ)         &
+     &         <0.99)THEN
+!
+                T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)
+                T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFQ,K,J+ISQ)
+!
+              ELSEIF                                                    &
+     &        (HTM(I+IHE(J)+IFQ,K,J+ISQ)+HTM(I+IPQ,K,J+ISP+ISQ)         &
+               <0.99)THEN
+!
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)
+                T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)
+!
+              ELSEIF                                                    &
+     &        (HTM(I+IHE(J)+IFP,K,J+ISP)                                &
+     &        +HTM(I+IHE(J)+IFQ,K,J+ISQ)<0.99)THEN
+                T(I+IHE(J)+IFP,K,J+ISP)=0.5*(T(I,K,J)                   &
+     &                                      +T(I+IPQ,K,J+ISP+ISQ))
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)
+!
+              ELSEIF(HTM(I+IHE(J)+IFP,K,J+ISP)<0.99)THEN
+                T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)                        &
+     &                                 +T(I+IPQ,K,J+ISP+ISQ)            &
+     &                                 -T(I+IHE(J)+IFQ,K,J+ISQ)
+!
+              ELSEIF(HTM(I+IHE(J)+IFQ,K,J+ISQ)<0.99)THEN
+                T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)                        &
+     &                                 +T(I+IPQ,K,J+ISP+ISQ)            &
+     &                                 -T(I+IHE(J)+IFP,K,J+ISP)
+!
+              ELSE
+                T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)            &
+     &                              +T(I+IHE(J)+IFQ,K,J+ISQ)            &
+     &                              -T(I,K,J)
+!
+              ENDIF
+!
+  150         CONTINUE
+!
+!-----------------------------------------------------------------------
+!
+              IF(I==IUP_ADH_J)THEN  ! Update advection H tendencies
+!
+                ISP=ISPA(I,K)
+                ISQ=ISQA(I,K)
+                IFP=(ISP-1)/2
+                IFQ=(-ISQ-1)/2
+                IPQ=(ISP-ISQ)/2
+!
+                F0=ARRAY0(I,K)
+                F1=ARRAY1(I,K)
+                F2=ARRAY2(I,K)
+                F3=ARRAY3(I,K)
+!
+                ADT(I,K,J)=F0*T(I,K,J)                                  &
+     &                    +F1*T(I+IHE(J)+IFP,K,J+ISP)                   &
+     &                    +F2*T(I+IHE(J)+IFQ,K,J+ISQ)                   &
+                          +F3*T(I+IPQ,K,J+ISP+ISQ)
+!
+!-----------------------------------------------------------------------
+!
+                IF(KNTI_ADH<N_IUPADH_J)THEN
+                  IUP_ADH_J=IUP_ADH(IMS+KNTI_ADH,J)
+                  KNTI_ADH=KNTI_ADH+1
+                ENDIF
+!
+              ENDIF  ! End of advection H tendency IF block
+!
+            ENDDO  ! End of II loop
+!
+          ENDDO  ! End of K loop
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  UPSTREAM ADVECTION OF VELOCITY COMPONENTS
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+          N_IUPADV_J=N_IUP_ADV(J)
+!
+!$omp parallel do                                                       &
+!$omp& private(f0,f1,f2,f3,i,ifp,ifq,ipq,isp,isq,k,pp,qp,tta,ttb)
+          DO K=KTS,KTE
+!
+            DO II=0,N_IUPADV_J-1
+              I=IUP_ADV(IMS+II,J)
+!
+              TTA=EM_LOC(J)*UST(I,K,J1_00)
+              TTB=EN       *VST(I,K,J1_00)
+              PP=-TTA-TTB
+              QP=TTA-TTB
+!
+              IF(PP<0.)THEN
+                ISP=-1
+              ELSE
+                ISP= 1
+              ENDIF
+!
+              IF(QP<0.)THEN
+                ISQ=-1
+              ELSE
+                ISQ= 1
+              ENDIF
+!
+              IFP=(ISP-1)/2
+              IFQ=(-ISQ-1)/2
+              IPQ=(ISP-ISQ)/2
+              PP=ABS(PP)
+              QP=ABS(QP)
+              F3=PP*QP
+              F0=F3-PP-QP
+              F1=PP-F3
+              F2=QP-F3
+!
+              ADU(I,K,J)=F0*U(I,K,J)                                    &
+     &                  +F1*U(I+IVE(J)+IFP,K,J+ISP)                     &
+     &                  +F2*U(I+IVE(J)+IFQ,K,J+ISQ)                     &
+     &                  +F3*U(I+IPQ,K,J+ISP+ISQ)
+! 
+              ADV(I,K,J)=F0*V(I,K,J)                                    &
+     &                  +F1*V(I+IVE(J)+IFP,K,J+ISP)                     &
+     &                  +F2*V(I+IVE(J)+IFQ,K,J+ISQ)                     &
+     &                  +F3*V(I+IPQ,K,J+ISP+ISQ)
+!
+            ENDDO
+!
+          ENDDO  !  End of K loop
+!
+!-----------------------------------------------------------------------
+!
+        ENDIF upstream
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  END OF THIS UPSTREAM REGION
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!***  COMPUTE VERTICAL ADVECTION TENDENCIES USING CRANK-NICHOLSON.
+!
+!-----------------------------------------------------------------------
+!***  FIRST THE TEMPERATURE
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(cft,cmt,crt,i,k,lmhk,pdop,pvvlo,pvvup,rcmt,rdp,rstt,tn   &
+!$omp&        ,vvlo,vvup                                                &
+!!!$omp&        ,adtp,ttlo,ttup                                           &
+!$omp&        )
+      iloop_for_t:  DO I=MYIS1,MYIE1
+!
+        PDOP=PDSLO(I,J)
+        PVVLO=PETDT(I,KTE-1,J)*DTQ
+        VVLO=PVVLO/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOP)
+        CMT=-VVLO*WGT2+1.
+        RCMT(KTE)=1./CMT
+        CRT(KTE)=VVLO*WGT2
+        RSTT(KTE)=-VVLO*WGT1*(T(I,KTE-1,J)-T(I,KTE,J))+T(I,KTE,J)
+!
+        LMHK=KTE-LMH(I,J)+1
+        DO K=KTE-1,LMHK+1,-1
+          RDP=1./(DETA1_PDTOP(K)+DETA2(K)*PDOP)
+          PVVUP=PVVLO
+          PVVLO=PETDT(I,K-1,J)*DTQ
+          VVUP=PVVUP*RDP
+          VVLO=PVVLO*RDP
+          CFT=-VVUP*WGT2*RCMT(K+1)
+          CMT=-CRT(K+1)*CFT+((VVUP-VVLO)*WGT2+1.)
+          RCMT(K)=1./CMT
+          CRT(K)=VVLO*WGT2
+          RSTT(K)=-RSTT(K+1)*CFT+T(I,K,J)                               &
+     &            -(T(I,K,J)-T(I,K+1,J))*VVUP*WGT1                      &
+     &            -(T(I,K-1,J)-T(I,K,J))*VVLO*WGT1
+        ENDDO
+!
+        PVVUP=PVVLO
+        VVUP=PVVUP/(DETA1_PDTOP(LMHK)+DETA2(LMHK)*PDOP)
+        CFT=-VVUP*WGT2*RCMT(LMHK+1)
+        CMT=-CRT(LMHK+1)*CFT+VVUP*WGT2+1.
+        CRT(LMHK)=0.
+        RSTT(LMHK)=-(T(I,LMHK,J)-T(I,LMHK+1,J))*VVUP*WGT1               &
+     &               -RSTT(LMHK+1)*CFT+T(I,LMHK,J)
+        TN(LMHK)=RSTT(LMHK)/CMT
+        VAD_TEND_T(I,LMHK)=TN(LMHK)-T(I,LMHK,J)
+!
+        DO K=LMHK+1,KTE
+          TN(K)=(-CRT(K)*TN(K-1)+RSTT(K))*RCMT(K)
+          VAD_TEND_T(I,K)=TN(K)-T(I,K,J)
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  The following section is only for checking the implicit solution
+!***  using back-substitution.  Remove this section otherwise.
+!-----------------------------------------------------------------------
+!       if(ntsd<=10.or.ntsd>=6000)then
+!       IF(I==ITEST.AND.J==JTEST)THEN
+!!
+!         PVVLO=PETDT(I,KTE-1,J)*DT*0.25
+!         VVLO=PVVLO/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOP)
+!         TTLO=VVLO*(T(I,KTE-1,J)-T(I,KTE,J)                            &
+!    &              +TN(KTE-1)-TN(KTE))
+!         ADTP=TTLO+TN(KTE)-T(I,KTE,J)
+!         WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',KTE     &
+!    &,             ' ADTP=',ADTP
+!         WRITE(0,*)' T=',T(I,KTE,J),' TN=',TN(KTE)                     &
+!    &,               ' VAD_TEND_T=',VAD_TEND_T(I,KTE)
+!         WRITE(0,*)' '
+!!
+!         DO K=KTE-1,LMHK+1,-1
+!           RDP=1./(DETA1_PDTOP(K)+DETA2(K)*PDOP)
+!           PVVUP=PVVLO
+!           PVVLO=PETDT(I,K-1,J)*DT*0.25
+!           VVUP=PVVUP*RDP
+!           VVLO=PVVLO*RDP
+!           TTUP=VVUP*(T(I,K,J)-T(I,K+1,J)+TN(K)-TN(K+1))
+!           TTLO=VVLO*(T(I,K-1,J)-T(I,K,J)+TN(K-1)-TN(K))
+!           ADTP=TTLO+TTUP+TN(K)-T(I,K,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',K             &
+!    &,               ' ADTP=',ADTP
+!           WRITE(0,*)' T=',T(I,K,J),' TN=',TN(K)                       &
+!    &,               ' VAD_TEND_T=',VAD_TEND_T(I,K)
+!           WRITE(0,*)' '
+!         ENDDO
+!!
+!         IF(LMHK==KTS)THEN
+!           PVVUP=PVVLO
+!           VVUP=PVVUP/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOP)
+!           TTUP=VVUP*(T(I,KTS,J)-T(I,KTS+1,J)+TN(KTS)-TN(KTS+1))
+!           ADTP=TTUP+TN(KTS)-T(I,KTS,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',KTS           &
+!    &,               ' ADTP=',ADTP
+!           WRITE(0,*)' T=',T(I,KTS,J),' TN=',TN(KTS)                   &
+!    &,               ' VAD_TEND_T=',VAD_TEND_T(I,KTS)
+!           WRITE(0,*)' '
+!         ENDIF
+!       ENDIF
+!       endif
+!
+!-----------------------------------------------------------------------
+!***  End of check.
+!-----------------------------------------------------------------------
+!
+      ENDDO iloop_for_t
+!
+!-----------------------------------------------------------------------
+!***  NOW VERTICAL ADVECTION OF WIND COMPONENTS
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(cfu,cfv,cmu,cmv,cru,crv,i,k,lmvk,pdopu,pdopv             &
+!$omp&        ,pvvlou,pvvlov,pvvupu,pvvupv,rcmu,rcmv,rdpu,rdpv          &
+!$omp&        ,rstu,rstv,un,vn,vvlou,vvlov,vvupu,vvupv                  &
+!!!$omp&        ,adup,advp,tulo,tuup,tvlo,tvup                            &
+!$omp&         ) 
+      iloop_for_uv:  DO I=MYIS1,MYIE1
+!
+        PDOPU=(PDSLO(I+IVW(J),J)+PDSLO(I+IVE(J),J))*0.5
+        PDOPV=(PDSLO(I,J-1)+PDSLO(I,J+1))*0.5
+        PVVLOU=(PETDT(I+IVW(J),KTE-1,J)+PETDT(I+IVE(J),KTE-1,J))*DTE
+        PVVLOV=(PETDT(I,KTE-1,J-1)+PETDT(I,KTE-1,J+1))*DTE
+        VVLOU=PVVLOU/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPU)
+        VVLOV=PVVLOV/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPV)
+        CMU=-VVLOU*WGT2+1.
+        CMV=-VVLOV*WGT2+1.
+        RCMU(KTE)=1./CMU
+        RCMV(KTE)=1./CMV
+        CRU(KTE)=VVLOU*WGT2
+        CRV(KTE)=VVLOV*WGT2
+        RSTU(KTE)=-VVLOU*WGT1*(U(I,KTE-1,J)-U(I,KTE,J))+U(I,KTE,J)
+        RSTV(KTE)=-VVLOV*WGT1*(V(I,KTE-1,J)-V(I,KTE,J))+V(I,KTE,J)
+!
+        LMVK=KTE-LMV(I,J)+1
+        DO K=KTE-1,LMVK+1,-1
+          RDPU=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPU)
+          RDPV=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPV)
+          PVVUPU=PVVLOU
+          PVVUPV=PVVLOV
+          PVVLOU=(PETDT(I+IVW(J),K-1,J)+PETDT(I+IVE(J),K-1,J))*DTE
+          PVVLOV=(PETDT(I,K-1,J-1)+PETDT(I,K-1,J+1))*DTE
+          VVUPU=PVVUPU*RDPU
+          VVUPV=PVVUPV*RDPV
+          VVLOU=PVVLOU*RDPU
+          VVLOV=PVVLOV*RDPV
+          CFU=-VVUPU*WGT2*RCMU(K+1)
+          CFV=-VVUPV*WGT2*RCMV(K+1)
+          CMU=-CRU(K+1)*CFU+(VVUPU-VVLOU)*WGT2+1.
+          CMV=-CRV(K+1)*CFV+(VVUPV-VVLOV)*WGT2+1.
+          RCMU(K)=1./CMU
+          RCMV(K)=1./CMV
+          CRU(K)=VVLOU*WGT2
+          CRV(K)=VVLOV*WGT2
+          RSTU(K)=-RSTU(K+1)*CFU+U(I,K,J)                               &
+     &            -(U(I,K,J)-U(I,K+1,J))*VVUPU*WGT1                     &
+     &            -(U(I,K-1,J)-U(I,K,J))*VVLOU*WGT1
+          RSTV(K)=-RSTV(K+1)*CFV+V(I,K,J)                               &
+     &            -(V(I,K,J)-V(I,K+1,J))*VVUPV*WGT1                     &
+     &            -(V(I,K-1,J)-V(I,K,J))*VVLOV*WGT1
+        ENDDO
+!
+        RDPU=1./(DETA1_PDTOP(LMVK)+DETA2(LMVK)*PDOPU)
+        RDPV=1./(DETA1_PDTOP(LMVK)+DETA2(LMVK)*PDOPV)
+        PVVUPU=PVVLOU
+        PVVUPV=PVVLOV
+        VVUPU=PVVUPU*RDPU
+        VVUPV=PVVUPV*RDPV
+        CFU=-VVUPU*WGT2*RCMU(LMVK+1)
+        CFV=-VVUPV*WGT2*RCMV(LMVK+1)
+        CMU=-CRU(LMVK+1)*CFU+VVUPU*WGT2+1.
+        CMV=-CRV(LMVK+1)*CFV+VVUPV*WGT2+1.
+        CRU(LMVK)=0.
+        CRV(LMVK)=0.
+        RSTU(LMVK)=-(U(I,LMVK,J)-U(I,LMVK+1,J))*VVUPU*WGT1              &
+     &               -RSTU(LMVK+1)*CFU+U(I,LMVK,J)
+        RSTV(LMVK)=-(V(I,LMVK,J)-V(I,LMVK+1,J))*VVUPV*WGT1              &
+     &               -RSTV(LMVK+1)*CFV+V(I,LMVK,J)
+        UN(LMVK)=RSTU(LMVK)/CMU
+        VN(LMVK)=RSTV(LMVK)/CMV
+        VAD_TEND_U(I,LMVK)=UN(LMVK)-U(I,LMVK,J)
+        VAD_TEND_V(I,LMVK)=VN(LMVK)-V(I,LMVK,J)
+!
+        DO K=LMVK+1,KTE
+          UN(K)=(-CRU(K)*UN(K-1)+RSTU(K))*RCMU(K)
+          VN(K)=(-CRV(K)*VN(K-1)+RSTV(K))*RCMV(K)
+          VAD_TEND_U(I,K)=UN(K)-U(I,K,J)
+          VAD_TEND_V(I,K)=VN(K)-V(I,K,J)
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  The following section is only for checking the implicit solution
+!***  using back-substitution.  Remove this section otherwise.
+!-----------------------------------------------------------------------
+!
+!       if(ntsd<=10.or.ntsd>=6000)then
+!       IF(I==ITEST.AND.J==JTEST)THEN
+!!
+!         PDOPU=(PDSLO(I+IVW(J),J)+PDSLO(I+IVE(J),J))*0.5
+!         PDOPV=(PDSLO(I,J-1)+PDSLO(I,J+1))*0.5
+!         PVVLOU=(PETDT(I+IVW(J),KTE-1,J)                               &
+!    &           +PETDT(I+IVE(J),KTE-1,J))*DTE
+!         PVVLOV=(PETDT(I,KTE-1,J-1)                                    &
+!    &           +PETDT(I,KTE-1,J+1))*DTE
+!         VVLOU=PVVLOU/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPU)
+!         VVLOV=PVVLOV/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPV)
+!         TULO=VVLOU*(U(I,KTE-1,J)-U(I,KTE,J)+UN(KTE-1)-UN(KTE))
+!         TVLO=VVLOV*(V(I,KTE-1,J)-V(I,KTE,J)+VN(KTE-1)-VN(KTE))
+!         ADUP=TULO+UN(KTE)-U(I,KTE,J)
+!         ADVP=TVLO+VN(KTE)-V(I,KTE,J)
+!         WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',KTE             &
+!    &,             ' ADUP=',ADUP,' ADVP=',ADVP
+!         WRITE(0,*)' U=',U(I,KTE,J),' UN=',UN(KTE)                     &
+!    &,             ' VAD_TEND_U=',VAD_TEND_U(I,KTE)                    &
+!    &,             ' V=',V(I,KTE,J),' VN=',VN(KTE)                     &
+!    &,             ' VAD_TEND_V=',VAD_TEND_V(I,KTE)
+!         WRITE(0,*)' '
+!!
+!         DO K=KTE-1,LMVK+1,-1
+!           RDPU=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPU)
+!           RDPV=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPV)
+!           PVVUPU=PVVLOU
+!           PVVUPV=PVVLOV
+!           PVVLOU=(PETDT(I+IVW(J),K-1,J)                               &
+!    &            +PETDT(I+IVE(J),K-1,J))*DTE
+!           PVVLOV=(PETDT(I,K-1,J-1)+PETDT(I,K-1,J+1))*DTE
+!           VVUPU=PVVUPU*RDPU
+!           VVUPV=PVVUPV*RDPV
+!           VVLOU=PVVLOU*RDPU
+!           VVLOV=PVVLOV*RDPV
+!           TUUP=VVUPU*(U(I,K,J)-U(I,K+1,J)+UN(K)-UN(K+1))
+!           TVUP=VVUPV*(V(I,K,J)-V(I,K+1,J)+VN(K)-VN(K+1))
+!           TULO=VVLOU*(U(I,K-1,J)-U(I,K,J)+UN(K-1)-UN(K))
+!           TVLO=VVLOV*(V(I,K-1,J)-V(I,K,J)+VN(K-1)-VN(K))
+!           ADUP=TUUP+TULO+UN(K)-U(I,K,J)
+!           ADVP=TVUP+TVLO+VN(K)-V(I,K,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',K     &
+!    &,               ' ADUP=',ADUP,' ADVP=',ADVP
+!           WRITE(0,*)' U=',U(I,K,J),' UN=',UN(K)                       &
+!    &,               ' VAD_TEND_U=',VAD_TEND_U(I,K)                    &
+!    &,               ' V=',V(I,K,J),' VN=',VN(K)                       &
+!    &,               ' VAD_TEND_V=',VAD_TEND_V(I,K)
+!           WRITE(0,*)' '
+!         ENDDO
+!!
+!         IF(LMVK==KTS)THEN
+!           PVVUPU=PVVLOU
+!           PVVUPV=PVVLOV
+!           VVUPU=PVVUPU/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOPU)
+!           VVUPV=PVVUPV/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOPV)
+!           TUUP=VVUPU*(U(I,KTS,J)-U(I,KTS+1,J)+UN(KTS)-UN(KTS+1))
+!           TVUP=VVUPV*(V(I,KTS,J)-V(I,KTS+1,J)+VN(KTS)-VN(KTS+1))
+!           ADUP=TUUP+UN(KTS)-U(I,KTS,J)
+!           ADVP=TVUP+VN(KTS)-V(I,KTS,J)
+!           WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',KTS   &
+!    &,               ' ADUP=',ADUP,' ADVP=',ADVP
+!           WRITE(0,*)' U=',U(I,KTS,J),' UN=',UN(KTS)                   &
+!    &,               ' VAD_TEND_U=',VAD_TEND_U(I,KTS)                  &
+!    &,               ' V=',V(I,KTS,J),' VN=',VN(KTS)                   &
+!    &,               ' VAD_TEND_V=',VAD_TEND_V(I,KTS)
+!           WRITE(0,*)' '
+!         ENDIF
+!       ENDIF
+!     endif
+!
+!-----------------------------------------------------------------------
+!***  End of check.
+!-----------------------------------------------------------------------
+!
+      ENDDO iloop_for_uv
+!
+!-----------------------------------------------------------------------
+!
+!***  NOW SUM THE VERTICAL AND HORIZONTAL TENDENCIES,
+!***  CURVATURE AND CORIOLIS TERMS
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(fpp,hm,i,k,vm)
+      DO K=KTS,KTE
+      DO I=MYIS1,MYIE1
+        HM=HTM(I,K,J)*HBM2(I,J)
+        VM=VTM(I,K,J)*VBM2(I,J)
+        ADT(I,K,J)=(VAD_TEND_T(I,K)+2.*ADT(I,K,J))*HM
+!
+        FPP=CURV(I,J)*2.*UST(I,K,J1_00)+F(I,J)*2.
+        ADU(I,K,J)=(VAD_TEND_U(I,K)+2.*ADU(I,K,J)+VST(I,K,J1_00)*FPP)   &
+     &             *VM
+        ADV(I,K,J)=(VAD_TEND_V(I,K)+2.*ADV(I,K,J)-UST(I,K,J1_00)*FPP)   &
+     &             *VM
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      ENDDO main_integration
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***  SAVE THE OLD VALUES FOR TIMESTEPPING
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS_P4,MYJE_P4
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          TOLD(I,K,J)=T(I,K,J)
+          UOLD(I,K,J)=U(I,K,J)
+          VOLD(I,K,J)=V(I,K,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  FINALLY UPDATE THE PROGNOSTIC VARIABLES
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+        DO I=MYIS1,MYIE1
+          T(I,K,J)=ADT(I,K,J)+T(I,K,J)
+          U(I,K,J)=ADU(I,K,J)+U(I,K,J)
+          V(I,K,J)=ADV(I,K,J)+V(I,K,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      END SUBROUTINE ADVE
+!-----------------------------------------------------------------------
+!
+!***********************************************************************
+      SUBROUTINE VAD2(NTSD,DT,IDTAD,DX,DY                               &
+     &               ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP                &
+     &               ,HBM2,LMH                                          &
+     &               ,Q,Q2,CWM,PETDT                                    &
+     &               ,N_IUP_H,N_IUP_V                                   &
+     &               ,N_IUP_ADH,N_IUP_ADV                               &
+     &               ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                       &
+     &               ,IHE,IHW,IVE,IVW,INDX3_WRK                         &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &               ,IMS,IME,JMS,JME,KMS,KME                           &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    VAD2        VERTICAL ADVECTION OF H2O SUBSTANCE AND TKE
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 96-07-19
+!
+! ABSTRACT:
+!     VAD2 CALCULATES THE CONTRIBUTION OF THE VERTICAL ADVECTION
+!     TO THE TENDENCIES OF WATER SUBSTANCE AND TKE AND THEN UPDATES
+!     THOSE VARIABLES.  AN ANTI-FILTERING TECHNIQUE IS USED.
+!
+! PROGRAM HISTORY LOG:
+!   96-07-19  JANJIC   - ORIGINATOR
+!   98-11-02  BLACK    - MODIFIED FOR DISTRIBUTED MEMORY
+!   99-03-17  TUCCILLO - INCORPORATED MPI_ALLREDUCE FOR GLOBAL SUM
+!   02-02-06  BLACK    - CONVERTED TO WRF FORMAT
+!   02-09-06  WOLFE    - MORE CONVERSION TO GLOBAL INDEXING
+!   04-11-23  BLACK    - THREADED
+!
+! USAGE: CALL VAD2 FROM SUBROUTINE SOLVE_NMM
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST
+!
+!   OUTPUT FILES:
+!       NONE
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!***********************************************************************
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V          &
+     &                                        ,N_IUP_ADH,N_IUP_ADV
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V      &
+     &                                                ,IUP_ADH,IUP_ADV
+! NMM_MAX_DIM is set in configure.wrf and must agree with
+! the value of dimspec q in the Registry/Registry
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: IDTAD,NTSD
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: DT,DY,PDTOP
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DX,HBM2,PDSL
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM,Q,Q2
+!
+!----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      REAL,PARAMETER :: FF1=0.525
+!
+      LOGICAL :: BOT,TOP
+!
+      INTEGER :: I,IRECV,J,JFP,JFQ,K,KOFF,LAP,LLAP
+!
+      INTEGER,DIMENSION(KTS:KTE) :: LA
+!
+      REAL*8 :: ADDT,AFRP,D2PQE,D2PQQ,D2PQW,DEP,DETAP,DPDN,DPUP,DQP     &
+     &       ,DWP,E00,E4P,EP,EP0,HADDT,HBM2IJ                           &
+     &       ,Q00,Q4P,QP,QP0                                            &
+     &       ,RFACEK,RFACQK,RFACWK,RFC,RR                               &
+     &       ,SUMNE,SUMNQ,SUMNW,SUMPE,SUMPQ,SUMPW                       &
+     &       ,W00,W4P,WP,WP0
+!
+      REAL,DIMENSION(KTS:KTE) :: AFR,DEL,DQL,DWL,E3,E4,PETDTK           &
+     &                          ,RFACE,RFACQ,RFACW,Q3,Q4,W3,W4
+!
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      ADDT=REAL(IDTAD)*DT
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(afr,afrp,bot,d2pqe,d2pqq,d2pqw,del,dep,detap,dpdn,dpup   &
+!$omp&        ,dql,dqp,dwl,dwp,e00,e3,e4,e4p,ep,ep0,haddt,i,j,k,koff    &
+!$omp&        ,la,lap,llap,petdtk,q00,q3,q4,q4p,qp,qp0,rfacek,rfacqk    &
+!$omp&        ,rfacwk,rfc,rr,sumne,sumnq,sumnw,sumpe,sumpq,sumpw,top    &
+!$omp&        ,w00,w3,w4,w4p,wp,wp0)
+      main_integration : DO J=MYJS2,MYJE2
+!
+      DO I=MYIS1_P1,MYIE1_P1
+!-----------------------------------------------------------------------
+        KOFF=KTE-LMH(I,J)
+!
+        E3(KTE)=Q2(I,KTE,J)*0.5
+!
+        DO K=KTE-1,KOFF+1,-1
+          E3(K)=MAX((Q2(I,K+1,J)+Q2(I,K,J))*0.5,EPSQ2)
+        ENDDO
+!
+        DO K=KOFF+1,KTE
+          Q3(K)=MAX(Q(I,K,J),EPSQ)
+          W3(K)=MAX(CWM(I,K,J),CLIMIT)
+          E4(K)=E3(K)
+          Q4(K)=Q3(K)
+          W4(K)=W3(K)
+        ENDDO
+!
+        PETDTK(KTE)=PETDT(I,KTE-1,J)*0.5
+!
+        DO K=KTE-1,KOFF+2,-1
+          PETDTK(K)=(PETDT(I,K,J)+PETDT(I,K-1,J))*0.5
+        ENDDO
+!
+        PETDTK(KOFF+1)=PETDT(I,KOFF+1,J)*0.5
+!-----------------------------------------------------------------------
+        HADDT=-ADDT*HBM2(I,J)
+!
+        DO K=KTE,KOFF+1,-1
+          RR=PETDTK(K)*HADDT
+!
+          IF(RR<0.)THEN
+            LAP=1
+          ELSE
+            LAP=-1
+          ENDIF
+!
+          LA(K)=LAP
+          LLAP=K+LAP
+!
+          TOP=.FALSE.
+          BOT=.FALSE.
+!
+          IF(LLAP>KOFF.AND.LLAP<KTE+1.AND.LAP/=0)THEN
+            RR=ABS(RR/((AETA1(LLAP)-AETA1(K))*PDTOP                     &
+     &                +(AETA2(LLAP)-AETA2(K))*PDSL(I,J)))
+!
+            AFR(K)=(((FF4*RR+FF3)*RR+FF2)*RR+FF1)*RR
+            DQP=(Q3(LLAP)-Q3(K))*RR
+            DWP=(W3(LLAP)-W3(K))*RR
+            DEP=(E3(LLAP)-E3(K))*RR
+            DQL(K)=DQP
+            DWL(K)=DWP
+            DEL(K)=DEP
+          ELSE
+            TOP=LLAP==KTE+1
+            BOT=LLAP==KOFF
+!
+            RR=0.
+            AFR(K)=0.
+            DQL(K)=0.
+            DWL(K)=0.
+            DEL(K)=0.
+          ENDIF
+        ENDDO
+!-----------------------------------------------------------------------
+        IF(TOP)THEN
+          IF(LA(KTE-1)>0)THEN
+            RFC=(DETA1(KTE-1)*PDTOP+DETA2(KTE-1)*PDSL(I,J))             &
+     &         /(DETA1(KTE  )*PDTOP+DETA2(KTE  )*PDSL(I,J))
+            DQL(KTE)=-DQL(KTE+1)*RFC
+            DWL(KTE)=-DWL(KTE+1)*RFC
+            DEL(KTE)=-DEL(KTE+1)*RFC
+          ENDIF
+        ENDIF
+!
+        IF(BOT)THEN
+          IF(LA(KOFF+2)<0)THEN
+            RFC=(DETA1(KOFF+2)*PDTOP+DETA2(KOFF+2)*PDSL(I,J))           &
+     &         /(DETA1(KOFF+1)*PDTOP+DETA2(KOFF+1)*PDSL(I,J))
+            DQL(KOFF+1)=-DQL(KOFF+2)*RFC
+            DWL(KOFF+1)=-DWL(KOFF+2)*RFC
+            DEL(KOFF+1)=-DEL(KOFF+2)*RFC
+          ENDIF
+        ENDIF
+!
+        DO K=KOFF+1,KTE
+          Q4(K)=Q3(K)+DQL(K)
+          W4(K)=W3(K)+DWL(K)
+          E4(K)=E3(K)+DEL(K)
+        ENDDO
+!-----------------------------------------------------------------------
+!***  ANTI-FILTERING STEP
+!-----------------------------------------------------------------------
+        SUMPQ=0.
+        SUMNQ=0.
+        SUMPW=0.
+        SUMNW=0.
+        SUMPE=0.
+        SUMNE=0.
+!
+!***  ANTI-FILTERING LIMITERS
+!
+        DO 50 K=KTE-1,KOFF+2,-1
+!
+        DETAP=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
+!
+        Q4P=Q4(K)
+        W4P=W4(K)
+        E4P=E4(K)
+!
+        LAP=LA(K)
+!
+        IF(LAP.NE.0)THEN
+          DPDN=(AETA1(K+LAP)-AETA1(K))*PDTOP                            &
+     &        +(AETA2(K+LAP)-AETA2(K))*PDSL(I,J)
+          DPUP=(AETA1(K)-AETA1(K-LAP))*PDTOP                            &
+     &        +(AETA2(K)-AETA2(K-LAP))*PDSL(I,J)
+!
+          AFRP=2.*AFR(K)*DPDN*DPDN/(DPDN+DPUP)
+          D2PQQ=((Q4(K+LAP)-Q4P)/DPDN                                   &
+     &          -(Q4P-Q4(K-LAP))/DPUP)*AFRP
+          D2PQW=((W4(K+LAP)-W4P)/DPDN                                   &
+     &          -(W4P-W4(K-LAP))/DPUP)*AFRP
+          D2PQE=((E4(K+LAP)-E4P)/DPDN                                   &
+     &          -(E4P-E4(K-LAP))/DPUP)*AFRP
+        ELSE
+          D2PQQ=0.
+          D2PQW=0.
+          D2PQE=0.
+        ENDIF
+!
+        QP=Q4P-D2PQQ
+        WP=W4P-D2PQW
+        EP=E4P-D2PQE
+!
+        Q00=Q3(K)
+        QP0=Q3(K+LAP)
+!
+        W00=W3(K)
+        WP0=W3(K+LAP)
+!
+        E00=E3(K)
+        EP0=E3(K+LAP)
+!
+        IF(LAP/=0)THEN
+          QP=MAX(QP,MIN(Q00,QP0))
+          QP=MIN(QP,MAX(Q00,QP0))
+          WP=MAX(WP,MIN(W00,WP0))
+          WP=MIN(WP,MAX(W00,WP0))
+          EP=MAX(EP,MIN(E00,EP0))
+          EP=MIN(EP,MAX(E00,EP0))
+        ENDIF
+!
+        DQP=QP-Q00
+        DWP=WP-W00
+        DEP=EP-E00
+!
+        DQL(K)=DQP
+        DWL(K)=DWP
+        DEL(K)=DEP
+!
+        DQP=DQP*DETAP
+        DWP=DWP*DETAP
+        DEP=DEP*DETAP
+!
+        IF(DQP>0.)THEN
+          SUMPQ=SUMPQ+DQP
+        ELSE
+          SUMNQ=SUMNQ+DQP
+        ENDIF
+!
+        IF(DWP>0.)THEN
+          SUMPW=SUMPW+DWP
+        ELSE
+          SUMNW=SUMNW+DWP
+        ENDIF
+!
+        IF(DEP>0.)THEN
+          SUMPE=SUMPE+DEP
+        ELSE
+          SUMNE=SUMNE+DEP
+        ENDIF
+!
+   50   CONTINUE
+!-----------------------------------------------------------------------
+        DQL(KOFF+1)=0.
+        DWL(KOFF+1)=0.
+        DEL(KOFF+1)=0.
+!
+        DQL(KTE)=0.
+        DWL(KTE)=0.
+        DEL(KTE)=0.
+!-----------------------------------------------------------------------
+!***  FIRST MOMENT CONSERVING FACTOR
+!-----------------------------------------------------------------------
+        IF(SUMPQ>1.E-9)THEN
+          RFACQK=-SUMNQ/SUMPQ
+        ELSE
+          RFACQK=1.
+        ENDIF
+!
+        IF(SUMPW>1.E-9)THEN
+          RFACWK=-SUMNW/SUMPW
+        ELSE
+          RFACWK=1.
+        ENDIF
+!
+        IF(SUMPE>1.E-9)THEN
+          RFACEK=-SUMNE/SUMPE
+        ELSE
+          RFACEK=1.
+        ENDIF
+!
+        IF(RFACQK<CONSERVE_MIN.OR.RFACQK>CONSERVE_MAX)RFACQK=1.
+        IF(RFACWK<CONSERVE_MIN.OR.RFACWK>CONSERVE_MAX)RFACWK=1.
+        IF(RFACEK<CONSERVE_MIN.OR.RFACEK>CONSERVE_MAX)RFACEK=1.
+!-----------------------------------------------------------------------
+!***  IMPOSE CONSERVATION ON ANTI-FILTERING
+!-----------------------------------------------------------------------
+        DO K=KTE,KOFF+1,-1
+          DQP=DQL(K)
+          IF(DQP>=0.)DQP=DQP*RFACQK
+          Q(I,K,J)=Q3(K)+DQP
+        ENDDO
+!-----------------------------------------------------------------------
+        DO K=KTE,KOFF+1,-1
+          DWP=DWL(K)
+          IF(DWP>=0.)DWP=DWP*RFACWK
+          CWM(I,K,J)=W3(K)+DWP
+        ENDDO
+!-----------------------------------------------------------------------
+        DO K=KTE,KOFF+1,-1
+          DEP=DEL(K)
+          IF(DEP>=0.)DEP=DEP*RFACEK
+          E3(K)=E3(K)+DEP
+        ENDDO
+!
+        HBM2IJ=HBM2(I,J)
+        Q2(I,KTE,J)=MAX(E3(KTE)+E3(KTE)-EPSQ2,EPSQ2)*HBM2IJ             &
+     &             +Q2(I,KTE,J)*(1.-HBM2IJ)
+        DO K=KTE-1,KOFF+2,-1
+          Q2(I,K,J)=MAX(E3(K)+E3(K)-Q2(I,K+1,J),EPSQ2)*HBM2IJ           &
+     &             +Q2(I,K,J)*(1.-HBM2IJ)
+        ENDDO
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      ENDDO 
+!
+      ENDDO main_integration
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      END SUBROUTINE VAD2
+!-----------------------------------------------------------------------
+!
+!***********************************************************************
+      SUBROUTINE HAD2(                                                  &
+#if defined(DM_PARALLEL)
+     &                domdesc ,                                         &
+#endif
+     &                NTSD,DT,IDTAD,DX,DY                               &
+     &               ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP                &
+     &               ,HTM,HBM2,HBM3,LMH                                 &
+     &               ,Q,Q2,CWM,U,V,Z,HYDRO                              &
+     &               ,N_IUP_H,N_IUP_V                                   &
+     &               ,N_IUP_ADH,N_IUP_ADV                               &
+     &               ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                       &
+     &               ,IHE,IHW,IVE,IVW,INDX3_WRK                         &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &               ,IMS,IME,JMS,JME,KMS,KME                           &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    HAD2        HORIZONTAL ADVECTION OF H2O AND TKE
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 96-07-19
+!
+! ABSTRACT:
+!     HAD2 CALCULATES THE CONTRIBUTION OF THE HORIZONTAL ADVECTION
+!     TO THE TENDENCIES OF WATER SUBSTANCE AND TKE AND THEN
+!     UPDATES THOSE VARIABLES.  AN ANTI-FILTERING TECHNIQUE IS USED.
+!
+! PROGRAM HISTORY LOG:
+!   96-07-19  JANJIC   - ORIGINATOR
+!   98-11-02  BLACK    - MODIFIED FOR DISTRIBUTED MEMORY
+!   99-03-17  TUCCILLO - INCORPORATED MPI_ALLREDUCE FOR GLOBAL SUM
+!   02-02-06  BLACK    - CONVERTED TO WRF FORMAT
+!   02-09-06  WOLFE    - MORE CONVERSION TO GLOBAL INDEXING
+!   03-05-23  JANJIC   - ADDED SLOPE FACTOR
+!   04-11-23  BLACK    - THREADED
+!
+! USAGE: CALL HAD2 FROM SUBROUTINE SOLVE_NMM
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST
+!
+!   OUTPUT FILES:
+!       NONE
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V          &
+     &                                        ,N_IUP_ADH,N_IUP_ADV
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V      &
+     &                                                ,IUP_ADH,IUP_ADV
+!-----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! NMM_MAX_DIM is set in configure.wrf and must agree with the value of
+! dimspec q in Registry/Registry.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-----------------------------------------------------------------------
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: IDTAD,NTSD
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: DT,DY,PDTOP
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DX,HBM2,HBM3,PDSL
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,U,V,Z
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM,Q,Q2
+!
+      LOGICAL,INTENT(IN) :: HYDRO
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      REAL,PARAMETER :: FF1=0.530
+!
+#ifdef DM_PARALLEL
+      INTEGER :: DOMDESC
+#endif
+!
+#if defined(BIT_FOR_BIT) && defined(DM_PARALLEL)
+      LOGICAL,EXTERNAL :: WRF_DM_ON_MONITOR
+      INTEGER :: N
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,6) :: XSUMS_L
+      REAL,DIMENSION(IDS:IDE,KDS:KDE,JDS:JDE,6) :: XSUMS_G
+#endif
+!
+      LOGICAL :: BOT,TOP
+!
+      INTEGER :: I,IRECV,J,JFP,JFQ,K,KOFF,LAP,LLAP,MPI_COMM_COMP
+!
+      INTEGER,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: IFPA,IFPF           &
+     &                                             ,IFQA,IFQF           &
+     &                                             ,JFPA,JFPF           &
+     &                                             ,JFQA,JFQF
+!
+      REAL :: ADDT,AFRP,CRIT,D2PQE,D2PQQ,D2PQW,DEP,DESTIJ,DQP,DQSTIJ    &
+     &       ,DVOLP,DWP,DWSTIJ,DZA,DZB,E00,E0Q,E1X,E2IJ,E4P,ENH,EP,EP0  &
+     &       ,ESTIJ,FPQ,HAFP,HAFQ,HBM2IJ,HM,HTMIKJ,PP,PPQ00,Q00,Q0Q     &
+     &       ,Q1IJ,Q4P,QP,QP0,QSTIJ,RDY,RFACEK,RFACQK,RFACWK,RFC        &
+     &       ,RFEIJ,RFQIJ,RFWIJ,RR,SLOPAC,SPP,SQP,SSA,SSB,SUMNE,SUMNQ   &
+     &       ,SUMNW,SUMPE,SUMPQ,SUMPW,TTA,TTB,W00,W0Q,W1IJ,W4P,WP,WP0   &
+     &       ,WSTIJ
+!
+      DOUBLE PRECISION,DIMENSION(6,KTE-KTS+1) :: GSUMS,XSUMS
+!
+      REAL,DIMENSION(KTS:KTE) :: AFR,DEL,DQL,DWL,E3,E4                  &
+     &                          ,RFACE,RFACQ,RFACW,Q3,Q4,W3,W4
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: DARE,EMH
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,JTS-5:JTE+5) :: AFP,AFQ,DEST   &
+     &                                                  ,DQST,DVOL,DWST &
+     &                                                  ,E1,E2,Q1,W1
+      integer :: nunit,ier
+      save nunit
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      RDY=1./DY
+      SLOPAC=SLOPHT*SQRT(2.)*0.5*50.
+      CRIT=SLOPAC*REAL(IDTAD)*DT*RDY*1000.
+!
+      ADDT=REAL(IDTAD)*DT
+      ENH=ADDT/(08.*DY)
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS_P3,MYJE_P3
+      DO I=MYIS_P2,MYIE_P2
+        EMH (I,J)=ADDT/(08.*DX(I,J))
+        DARE(I,J)=HBM3(I,J)*DX(I,J)*DY
+        E1(I,KTE,J)=MAX(Q2(I,KTE,J)*0.5,EPSQ2)
+        E2(I,KTE,J)=E1(I,KTE,J)
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(e1x,htmikj,i,j,k)
+      DO J=MYJS_P3,MYJE_P3
+        DO K=KTS,KTE
+        DO I=MYIS_P2,MYIE_P2
+          DVOL(I,K,J)=DARE(I,J)*(DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J))
+          HTMIKJ=HTM(I,K,J)
+          Q  (I,K,J)=MAX(Q  (I,K,J),EPSQ)*HTMIKJ
+          CWM(I,K,J)=MAX(CWM(I,K,J),CLIMIT)*HTMIKJ
+          Q1  (I,K,J)=Q  (I,K,J)
+          W1  (I,K,J)=CWM(I,K,J)
+        ENDDO
+        ENDDO
+!
+        DO K=KTE-1,KTS,-1
+        DO I=MYIS_P2,MYIE_P2
+          E1X=(Q2(I,K+1,J)+Q2(I,K,J))*0.5
+          E1(I,K,J)=MAX(E1X,EPSQ2)
+          E2(I,K,J)=E1(I,K,J)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dza,dzb,fpq,i,j,jfp,jfq,k,pp,qp,ssa,ssb,spp,sqp,tta,ttb)
+      DO J=MYJS2_P1,MYJE2_P1
+      DO K=KTS,KTE
+      DO I=MYIS1_P1,MYIE1_P1
+!
+        TTA=(U(I,K,J-1)+U(I+IHW(J),K,J)+U(I+IHE(J),K,J)+U(I,K,J+1))     &
+     &      *EMH(I,J)*HBM2(I,J)
+        TTB=(V(I,K,J-1)+V(I+IHW(J),K,J)+V(I+IHE(J),K,J)+V(I,K,J+1))     &
+     &      *ENH*HBM2(I,J)
+!
+        SPP=-TTA-TTB
+        SQP= TTA-TTB
+!
+        IF(SPP<0.)THEN
+          JFP=-1
+        ELSE
+          JFP=1
+        ENDIF
+        IF(SQP<0.)THEN
+          JFQ=-1
+        ELSE
+          JFQ=1
+        ENDIF
+!
+        IFPA(I,K,J)=IHE(J)+I+( JFP-1)/2
+        IFQA(I,K,J)=IHE(J)+I+(-JFQ-1)/2
+!
+        JFPA(I,K,J)=J+JFP
+        JFQA(I,K,J)=J+JFQ
+!
+        IFPF(I,K,J)=IHE(J)+I+(-JFP-1)/2
+        IFQF(I,K,J)=IHE(J)+I+( JFQ-1)/2
+!
+        JFPF(I,K,J)=J-JFP
+        JFQF(I,K,J)=J-JFQ
+!
+!-----------------------------------------------------------------------
+        IF(.NOT.HYDRO)THEN ! z currently not available for hydro=.true.
+          DZA=(Z(IFPA(I,K,J),K,JFPA(I,K,J))-Z(I,K,J))*RDY
+          DZB=(Z(IFQA(I,K,J),K,JFQA(I,K,J))-Z(I,K,J))*RDY
+!
+          IF(ABS(DZA)>SLOPAC)THEN
+            SSA=DZA*SPP
+            IF(SSA>CRIT)THEN
+              SPP=0. !spp*.1
+            ENDIF
+          ENDIF
+!
+          IF(ABS(DZB)>SLOPAC)THEN
+            SSB=DZB*SQP
+            IF(SSB>CRIT)THEN
+              SQP=0. !sqp*.1
+            ENDIF
+          ENDIF
+!
+        ENDIF
+!-----------------------------------------------------------------------
+        SPP=SPP*HTM(IFPA(I,K,J),K,JFPA(I,K,J))
+        SQP=SQP*HTM(IFQA(I,K,J),K,JFQA(I,K,J))
+        FPQ=SPP*SQP*HTM(I,K,J-2)*HTM(I-1,K,J)                           &
+     &             *HTM(I+1,K,J)*HTM(I,K,J+2)*0.25
+        PP=ABS(SPP)
+        QP=ABS(SQP)
+!
+        AFP(I,K,J)=(((FF4*PP+FF3)*PP+FF2)*PP+FF1)*PP
+        AFQ(I,K,J)=(((FF4*QP+FF3)*QP+FF2)*QP+FF1)*QP
+!
+        Q1(I,K,J)=(Q  (IFPA(I,K,J),K,JFPA(I,K,J))-Q  (I,K,J))*PP        &
+     &           +(Q  (IFQA(I,K,J),K,JFQA(I,K,J))-Q  (I,K,J))*QP        &
+     &           +(Q  (I,K,J-2)+Q  (I,K,J+2)                            &
+     &            -Q  (I-1,K,J)-Q  (I+1,K,J))*FPQ                       &
+     &           +Q(I,K,J)
+!
+        W1(I,K,J)=(CWM(IFPA(I,K,J),K,JFPA(I,K,J))-CWM(I,K,J))*PP        &
+     &           +(CWM(IFQA(I,K,J),K,JFQA(I,K,J))-CWM(I,K,J))*QP        &
+     &           +(CWM(I,K,J-2)+CWM(I,K,J+2)                            &
+     &            -CWM(I-1,K,J)-CWM(I+1,K,J))*FPQ                       &
+     &           +CWM(I,K,J)
+!
+        E2(I,K,J)=(E1 (IFPA(I,K,J),K,JFPA(I,K,J))-E1 (I,K,J))*PP        &
+     &           +(E1 (IFQA(I,K,J),K,JFQA(I,K,J))-E1 (I,K,J))*QP        &
+     &           +(E1 (I,K,J-2)+E1 (I,K,J+2)                            &
+     &            -E1 (I-1,K,J)-E1 (I+1,K,J))*FPQ                       &
+     &           +E1(I,K,J)
+!
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  ANTI-FILTERING STEP
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+        XSUMS(1,K)=0.
+        XSUMS(2,K)=0.
+        XSUMS(3,K)=0.
+        XSUMS(4,K)=0.
+        XSUMS(5,K)=0.
+        XSUMS(6,K)=0.
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!***  ANTI-FILTERING LIMITERS
+!
+!-----------------------------------------------------------------------
+#if defined(BIT_FOR_BIT) && defined(DM_PARALLEL)
+      DO N=1,6
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+        DO J=JMS,JME 
+        DO K=KMS,KME 
+        DO I=IMS,IME 
+          XSUMS_L(I,K,J,N)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+        DO J=JDS,JDE 
+        DO K=KDS,KDE 
+        DO I=IDS,IDE 
+          XSUMS_G(I,K,J,N)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+#endif
+!-----------------------------------------------------------------------
+      DO 150 J=MYJS2,MYJE2
+      DO 150 K=KTS,KTE
+      DO 150 I=MYIS1,MYIE1
+!
+      DVOLP=DVOL(I,K,J)
+      Q1IJ =Q1(I,K,J)
+      W1IJ =W1(I,K,J)
+      E2IJ =E2(I,K,J)
+!
+      HAFP=HTM(IFPF(I,K,J),K,JFPF(I,K,J))*AFP(I,K,J)
+      HAFQ=HTM(IFQF(I,K,J),K,JFQF(I,K,J))*AFQ(I,K,J)
+!
+      D2PQQ=(Q1(IFPA(I,K,J),K,JFPA(I,K,J))-Q1IJ                         &
+     &      -Q1IJ+Q1(IFPF(I,K,J),K,JFPF(I,K,J)))                        &
+     &      *HAFP                                                       &
+     &     +(Q1(IFQA(I,K,J),K,JFQA(I,K,J))-Q1IJ                         &
+     &      -Q1IJ+Q1(IFQF(I,K,J),K,JFQF(I,K,J)))                        &
+     &      *HAFQ
+!
+      D2PQW=(W1(IFPA(I,K,J),K,JFPA(I,K,J))-W1IJ                         &
+     &      -W1IJ+W1(IFPF(I,K,J),K,JFPF(I,K,J)))                        &
+     &      *HAFP                                                       &
+     &     +(W1(IFQA(I,K,J),K,JFQA(I,K,J))-W1IJ                         &
+     &      -W1IJ+W1(IFQF(I,K,J),K,JFQF(I,K,J)))                        &
+     &      *HAFQ
+!
+      D2PQE=(E2(IFPA(I,K,J),K,JFPA(I,K,J))-E2IJ                         &
+     &      -E2IJ+E2(IFPF(I,K,J),K,JFPF(I,K,J)))                        &
+     &      *HAFP                                                       &
+     &     +(E2(IFQA(I,K,J),K,JFQA(I,K,J))-E2IJ                         &
+     &      -E2IJ+E2(IFQF(I,K,J),K,JFQF(I,K,J)))                        &
+     &      *HAFQ
+!
+      QSTIJ=Q1IJ-D2PQQ
+      WSTIJ=W1IJ-D2PQW
+      ESTIJ=E2IJ-D2PQE
+!
+      Q00=Q  (I          ,K          ,J)
+      QP0=Q  (IFPA(I,K,J),K,JFPA(I,K,J))
+      Q0Q=Q  (IFQA(I,K,J),K,JFQA(I,K,J))
+!
+      W00=CWM(I          ,K          ,J)
+      WP0=CWM(IFPA(I,K,J),K,JFPA(I,K,J))
+      W0Q=CWM(IFQA(I,K,J),K,JFQA(I,K,J))
+!
+      E00=E1 (I          ,K          ,J)
+      EP0=E1 (IFPA(I,K,J),K,JFPA(I,K,J))
+      E0Q=E1 (IFQA(I,K,J),K,JFQA(I,K,J))
+!
+      QSTIJ=MAX(QSTIJ,MIN(Q00,QP0,Q0Q))
+      QSTIJ=MIN(QSTIJ,MAX(Q00,QP0,Q0Q))
+      WSTIJ=MAX(WSTIJ,MIN(W00,WP0,W0Q))
+      WSTIJ=MIN(WSTIJ,MAX(W00,WP0,W0Q))
+      ESTIJ=MAX(ESTIJ,MIN(E00,EP0,E0Q))
+      ESTIJ=MIN(ESTIJ,MAX(E00,EP0,E0Q))
+!
+      DQSTIJ=QSTIJ-Q(I,K,J)
+      DWSTIJ=WSTIJ-CWM(I,K,J)
+      DESTIJ=ESTIJ-E1(I,K,J)
+!
+      DQST(I,K,J)=DQSTIJ
+      DWST(I,K,J)=DWSTIJ
+      DEST(I,K,J)=DESTIJ
+!
+      DQSTIJ=DQSTIJ*DVOLP
+      DWSTIJ=DWSTIJ*DVOLP
+      DESTIJ=DESTIJ*DVOLP
+!
+#if defined(BIT_FOR_BIT) && defined(DM_PARALLEL)
+      DO N=1,6
+        XSUMS_L(I,K,J,N)=0.
+      ENDDO
+!
+      IF(DQSTIJ>0.)THEN
+        XSUMS_L(I,K,J,1)=DQSTIJ
+      ELSE
+        XSUMS_L(I,K,J,2)=DQSTIJ
+      ENDIF
+!
+      IF(DWSTIJ>0.)THEN
+        XSUMS_L(I,K,J,3)=DWSTIJ
+      ELSE
+        XSUMS_L(I,K,J,4)=DWSTIJ
+      ENDIF
+!
+      IF(DESTIJ>0.)THEN
+        XSUMS_L(I,K,J,5)=DESTIJ
+      ELSE
+        XSUMS_L(I,K,J,6)=DESTIJ
+      ENDIF
+#else
+      IF(DQSTIJ>0.)THEN
+        XSUMS(1,K)=XSUMS(1,K)+DQSTIJ
+      ELSE
+        XSUMS(2,K)=XSUMS(2,K)+DQSTIJ
+      ENDIF
+!
+      IF(DWSTIJ>0.)THEN
+        XSUMS(3,K)=XSUMS(3,K)+DWSTIJ
+      ELSE
+        XSUMS(4,K)=XSUMS(4,K)+DWSTIJ
+      ENDIF
+!
+      IF(DESTIJ>0.)THEN
+        XSUMS(5,K)=XSUMS(5,K)+DESTIJ
+      ELSE
+        XSUMS(6,K)=XSUMS(6,K)+DESTIJ
+      ENDIF
+#endif
+!
+  150 CONTINUE
+!
+!-----------------------------------------------------------------------
+#if defined(BIT_FOR_BIT) && defined(DM_PARALLEL)
+      DO N=1,6
+        CALL WRF_PATCH_TO_GLOBAL_REAL( XSUMS_L(IMS,KMS,JMS,N)           &
+     &,                                XSUMS_G(1,1,1,N),DOMDESC         & 
+     &,                               'xyz','xzy'                       &
+     &,                                IDS,IDE,KDS,KDE,JDS,JDE          &    
+     &,                                IMS,IME,KMS,KME,JMS,JME          &
+     &,                                ITS,ITE,KTS,KTE,JTS,JTE )
+      ENDDO
+!
+      GSUMS=0.
+!
+      IF(WRF_DM_ON_MONITOR())THEN
+        DO N=1,6
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+          DO J=JDS,JDE
+          DO K=KDS,KDE
+          DO I=IDS,IDE
+            GSUMS(N,K)=GSUMS(N,K)+XSUMS_G(I,K,J,N)
+          ENDDO
+          ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+
+      CALL WRF_DM_BCAST_BYTES(GSUMS,2*RWORDSIZE*6*(KDE-KDS+1) )
+
+#else
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***  GLOBAL REDUCTION
+!-----------------------------------------------------------------------
+!
+# ifdef DM_PARALLEL
+      CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
+      CALL MPI_ALLREDUCE(XSUMS,GSUMS,6*(KTE-KTS+1)                      &
+     &                  ,MPI_DOUBLE_PRECISION,MPI_SUM                   &
+     &                  ,MPI_COMM_COMP,IRECV)
+# else
+      GSUMS=XSUMS
+# endif
+#endif
+!
+!-----------------------------------------------------------------------
+!***  END OF GLOBAL REDUCTION
+!-----------------------------------------------------------------------
+!
+!     if(mype==0)then
+!       if(ntsd==0)then
+!!        call int_get_fresh_handle(nunit)
+!!        close(nunit)
+!         nunit=56
+!         open(unit=nunit,file='gsums',form='unformatted',iostat=ier)
+!       endif
+!     endif
+      DO K=KTS,KTE
+!       if(mype==0)then
+!         write(nunit)(gsums(i,k),i=1,6)
+!       endif
+!
+!-----------------------------------------------------------------------
+        SUMPQ=GSUMS(1,K)
+        SUMNQ=GSUMS(2,K)
+        SUMPW=GSUMS(3,K)
+        SUMNW=GSUMS(4,K)
+        SUMPE=GSUMS(5,K)
+        SUMNE=GSUMS(6,K)
+!
+!-----------------------------------------------------------------------
+!***  FIRST MOMENT CONSERVING FACTOR
+!-----------------------------------------------------------------------
+!
+        IF(SUMPQ>1.)THEN
+          RFACQK=-SUMNQ/SUMPQ
+        ELSE
+          RFACQK=1.
+        ENDIF
+!
+        IF(SUMPW>1.)THEN
+          RFACWK=-SUMNW/SUMPW
+        ELSE
+          RFACWK=1.
+        ENDIF
+!
+        IF(SUMPE>1.)THEN
+          RFACEK=-SUMNE/SUMPE
+        ELSE
+          RFACEK=1.
+        ENDIF
+!
+        IF(RFACQK<CONSERVE_MIN.OR.RFACQK>CONSERVE_MAX)RFACQK=1.
+        IF(RFACWK<CONSERVE_MIN.OR.RFACWK>CONSERVE_MAX)RFACWK=1.
+        IF(RFACEK<CONSERVE_MIN.OR.RFACEK>CONSERVE_MAX)RFACEK=1.
+!
+        RFACQ(K)=RFACQK
+        RFACW(K)=RFACWK
+        RFACE(K)=RFACEK
+!
+      ENDDO
+!     if(mype==0.and.ntsd==181)close(nunit)
+!
+!-----------------------------------------------------------------------
+!***  IMPOSE CONSERVATION ON ANTI-FILTERING
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dqstij,i,j,k,rfacqk,rfqij)
+      DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+          RFACQK=RFACQ(K)
+          IF(RFACQK<1.)THEN
+            DO I=MYIS1,MYIE1
+              DQSTIJ=DQST(I,K,J)
+              RFQIJ=HBM2(I,J)*(RFACQK-1.)+1.
+              IF(DQSTIJ>=0.)DQSTIJ=DQSTIJ*RFQIJ
+              Q(I,K,J)=Q(I,K,J)+DQSTIJ
+            ENDDO
+          ELSE
+            DO I=MYIS1,MYIE1
+              DQSTIJ=DQST(I,K,J)
+              RFQIJ=HBM2(I,J)*(RFACQK-1.)+1.
+              IF(DQSTIJ<0.)DQSTIJ=DQSTIJ/RFQIJ
+              Q(I,K,J)=Q(I,K,J)+DQSTIJ
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dwstij,i,j,k,rfacwk,rfwij)
+      DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+          RFACWK=RFACW(K)
+          IF(RFACWK<1.)THEN
+            DO I=MYIS1,MYIE1
+              DWSTIJ=DWST(I,K,J)
+              RFWIJ=HBM2(I,J)*(RFACWK-1.)+1.
+              IF(DWSTIJ>=0.)DWSTIJ=DWSTIJ*RFWIJ
+              CWM(I,K,J)=CWM(I,K,J)+DWSTIJ
+            ENDDO
+          ELSE
+            DO I=MYIS1,MYIE1
+              DWSTIJ=DWST(I,K,J)
+              RFWIJ=HBM2(I,J)*(RFACWK-1.)+1.
+              IF(DWSTIJ<0.)DWSTIJ=DWSTIJ/RFWIJ
+              CWM(I,K,J)=CWM(I,K,J)+DWSTIJ
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(destij,i,j,k,rfacek,rfeij)
+      DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+          RFACEK=RFACE(K)
+          IF(RFACEK<1.)THEN
+            DO I=MYIS1,MYIE1
+              DESTIJ=DEST(I,K,J)
+              RFEIJ=HBM2(I,J)*(RFACEK-1.)+1.
+              IF(DESTIJ>=0.)DESTIJ=DESTIJ*RFEIJ
+              E1(I,K,J)=E1(I,K,J)+DESTIJ
+            ENDDO
+          ELSE
+            DO I=MYIS1,MYIE1
+              DESTIJ=DEST(I,K,J)
+              RFEIJ=HBM2(I,J)*(RFACEK-1.)+1.
+              IF(DESTIJ<0.)DESTIJ=DESTIJ/RFEIJ
+              E1(I,K,J)=E1(I,K,J)+DESTIJ
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS,MYJE
+      DO K=KTS,KTE
+      DO I=MYIS,MYIE
+        Q  (I,K,J)=MAX(Q  (I,K,J),EPSQ)*HTM(I,K,J)
+        CWM(I,K,J)=MAX(CWM(I,K,J),CLIMIT)*HTM(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+        Q2(I,KTE,J)=MAX(E1(I,KTE,J)+E1(I,KTE,J)-EPSQ2,EPSQ2)            &
+     &             *HTM(I,KTE,J)
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k,koff)
+      DO J=MYJS,MYJE
+      DO K=KTE-1,KTS+1,-1
+      DO I=MYIS,MYIE
+        KOFF=KTE-LMH(I,J)
+        IF(K>KOFF+1)THEN
+          Q2(I,K,J)=MAX(E1(I,K,J)+E1(I,K,J)-Q2(I,K+1,J),EPSQ2)          &
+     &             *HTM(I,K,J)
+        ELSE
+          Q2(I,K,J)=Q2(I,K+1,J)
+        ENDIF
+      ENDDO
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      END SUBROUTINE HAD2
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE VAD2_DRY(NTSD,DT,IDTAD,DX,DY                           &
+     &                   ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP            &
+     &                   ,HBM2,LMH                                      &
+     &                   ,Q2,PETDT                                      &
+     &                   ,N_IUP_H,N_IUP_V                               &
+     &                   ,N_IUP_ADH,N_IUP_ADV                           &
+     &                   ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                   &
+     &                   ,IHE,IHW,IVE,IVW,INDX3_WRK                     &
+     &                   ,IDS,IDE,JDS,JDE,KDS,KDE                       &
+     &                   ,IMS,IME,JMS,JME,KMS,KME                       &
+     &                   ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    VAD2_DRY    VERTICAL ADVECTION OF TKE
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 96-07-19
+!
+! ABSTRACT:
+!     VAD2 CALCULATES THE CONTRIBUTION OF THE HORIZONTAL AND VERTICAL
+!     ADVECTION TO THE TENDENCY OF TKE AND THEN UPDATES IT.
+!     AN ANTI-FILTERING TECHNIQUE IS USED.
+!
+! PROGRAM HISTORY LOG:
+!   96-07-19  JANJIC   - ORIGINATOR
+!   98-11-02  BLACK    - MODIFIED FOR DISTRIBUTED MEMORY
+!   99-03-17  TUCCILLO - INCORPORATED MPI_ALLREDUCE FOR GLOBAL SUM
+!   02-02-06  BLACK    - CONVERTED TO WRF FORMAT
+!   02-09-06  WOLFE    - MORE CONVERSION TO GLOBAL INDEXING
+!   04-11-23  BLACK    - THREADED
+!
+! USAGE: CALL VAD2_DRY FROM SUBROUTINE DIGITAL_FILTER
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST
+!
+!   OUTPUT FILES:
+!       NONE
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V          &
+     &                                        ,N_IUP_ADH,N_IUP_ADV
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V      &
+     &                                                ,IUP_ADH,IUP_ADV
+! NMM_MAX_DIM is set in configure.wrf and must agree with
+! the value of dimspec q in the Registry/Registry
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: IDTAD,NTSD
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: DT,DY,PDTOP
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DX,HBM2,PDSL
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: Q2
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      REAL,PARAMETER :: FF1=0.525
+!
+      LOGICAL :: BOT,TOP
+!
+      INTEGER :: I,IRECV,J,JFP,JFQ,K,KOFF,LAP,LLAP
+!
+      INTEGER,DIMENSION(KTS:KTE) :: LA
+!
+      REAL :: ADDT,AFRP,D2PQE,DEP,DETAP,DPDN,DPUP,DQP                   &
+     &       ,DWP,E00,E4P,EP,EP0,HADDT,HBM2IJ                           &
+     &       ,RFACEK,RFC,RR,SUMNE,SUMPE
+!
+      REAL,DIMENSION(KTS:KTE) :: AFR,DEL,E3,E4,PETDTK,RFACE
+!
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      ADDT=REAL(IDTAD)*DT
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(afr,afrp,bot,d2pqe,del,dep,detap,dpdn,dpup,e00,e3        &
+!$omp&        ,e4,e4p,ep,ep0,hbm2ij,i,j,k,koff,la,lap,llap,petdtk       &
+!$omp&        ,rfacek,rfc,rr,sumne,sumpe,top)
+      main_integration : DO J=MYJS2,MYJE2
+!
+      DO I=MYIS1_P1,MYIE1_P1
+!-----------------------------------------------------------------------
+        KOFF=KTE-LMH(I,J)
+!
+        E3(KTE)=Q2(I,KTE,J)*0.5
+!
+        DO K=KTE-1,KOFF+1,-1
+          E3(K)=MAX((Q2(I,K+1,J)+Q2(I,K,J))*0.5,EPSQ2)
+        ENDDO
+!
+        DO K=KOFF+1,KTE
+          E4(K)=E3(K)
+        ENDDO
+!
+        PETDTK(KTE)=PETDT(I,KTE-1,J)*0.5
+!
+        DO K=KTE-1,KOFF+2,-1
+          PETDTK(K)=(PETDT(I,K+1,J)+PETDT(I,K,J))*0.5
+        ENDDO
+!
+        PETDTK(KOFF+1)=PETDT(I,KOFF+1,J)*0.5
+!-----------------------------------------------------------------------
+        HADDT=-ADDT*HBM2(I,J)
+!
+        DO K=KTE,KOFF+1,-1
+          RR=PETDTK(K)*HADDT
+!
+          IF(RR<0.)THEN
+            LAP=1
+          ELSE
+            LAP=-1
+          ENDIF
+!
+          LA(K)=LAP
+          LLAP=K+LAP
+!
+          TOP=.FALSE.
+          BOT=.FALSE.
+!
+          IF(LLAP>0.AND.LLAP<KTE+1.AND.LAP/=0)THEN
+            RR=ABS(RR/((AETA1(LLAP)-AETA1(K))*PDTOP                     &
+     &                +(AETA2(LLAP)-AETA2(K))*PDSL(I,J)))
+!
+            AFR(K)=(((FF4*RR+FF3)*RR+FF2)*RR+FF1)*RR
+            DEP=(E3(LLAP)-E3(K))*RR
+            DEL(K)=DEP
+          ELSE
+            TOP=LLAP==KTE+1
+            BOT=LLAP==KOFF
+!
+            RR=0.
+            AFR(K)=0.
+            DEL(K)=0.
+          ENDIF
+        ENDDO
+!-----------------------------------------------------------------------
+        IF(TOP)THEN
+          IF(LA(KTE-1)<0)THEN
+            RFC=(DETA1(KTE-1)*PDTOP+DETA2(KTE-1)*PDSL(I,J))             &
+     &         /(DETA1(KTE  )*PDTOP+DETA2(KTE  )*PDSL(I,J))
+            DEL(KTE)=-DEL(KTE+1)*RFC
+          ENDIF
+        ENDIF
+!
+        IF(BOT)THEN
+          IF(LA(KOFF+2)<0)THEN
+            RFC=(DETA1(KOFF+2)*PDTOP+DETA2(KOFF+2)*PDSL(I,J))           &
+     &         /(DETA1(KOFF+1)*PDTOP+DETA2(KOFF+1)*PDSL(I,J))
+            DEL(KOFF+1)=-DEL(KOFF+2)*RFC
+          ENDIF
+        ENDIF
+!
+        DO K=KOFF+1,KTE
+          E4(K)=E3(K)+DEL(K)
+        ENDDO
+!-----------------------------------------------------------------------
+!***  ANTI-FILTERING STEP
+!-----------------------------------------------------------------------
+        SUMPE=0.
+        SUMNE=0.
+!
+!***  ANTI-FILTERING LIMITERS
+!
+        DO 50 K=KTE-1,KOFF+2,-1
+!
+        DETAP=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
+!
+        E4P=E4(K)
+!
+        LAP=LA(K)
+!
+        IF(LAP/=0)THEN
+          DPDN=(AETA1(K+LAP)-AETA1(K))*PDTOP                            &
+     &        +(AETA2(K+LAP)-AETA2(K))*PDSL(I,J)
+          DPUP=(AETA1(K)-AETA1(K-LAP))*PDTOP                            &
+     &        +(AETA2(K)-AETA2(K-LAP))*PDSL(I,J)
+!
+          AFRP=2.*AFR(K)*DPDN*DPDN/(DPDN+DPUP)
+          D2PQE=((E4(K+LAP)-E4P)/DPDN                                   &
+     &          -(E4P-E4(K-LAP))/DPUP)*AFRP
+        ELSE
+          D2PQE=0.
+        ENDIF
+!
+        EP=E4P-D2PQE
+!
+        E00=E3(K)
+        EP0=E3(K+LAP)
+!
+        IF(LAP/=0)THEN
+          EP=MAX(EP,MIN(E00,EP0))
+          EP=MIN(EP,MAX(E00,EP0))
+        ENDIF
+!
+        DEP=EP-E00
+!
+        DEL(K)=DEP
+!
+        DEP=DEP*DETAP
+!
+        IF(DEP>0.)THEN
+          SUMPE=SUMPE+DEP
+        ELSE
+          SUMNE=SUMNE+DEP
+        ENDIF
+!
+   50   CONTINUE
+!-----------------------------------------------------------------------
+        DEL(KTE)=0.
+!
+        DEL(KOFF+1)=0.
+!-----------------------------------------------------------------------
+!***  FIRST MOMENT CONSERVING FACTOR
+!-----------------------------------------------------------------------
+        IF(SUMPE>1.E-9)THEN
+          RFACEK=-SUMNE/SUMPE
+        ELSE
+          RFACEK=1.
+        ENDIF
+!
+        IF(RFACEK<CONSERVE_MIN.OR.RFACEK>CONSERVE_MAX)RFACEK=1.
+!-----------------------------------------------------------------------
+!***  IMPOSE CONSERVATION ON ANTI-FILTERING
+!-----------------------------------------------------------------------
+        DO K=KOFF+1,KTE
+          DEP=DEL(K)
+          IF(DEP>=0.)DEP=DEP*RFACEK
+          E3(K)=E3(K)+DEP
+        ENDDO
+!
+        HBM2IJ=HBM2(I,J)
+        Q2(I,KTE,J)=MAX(E3(KTE)+E3(KTE)-EPSQ2,EPSQ2)*HBM2IJ             &
+     &             +Q2(I,KTE,J)*(1.-HBM2IJ)
+        DO K=KTE-1,KOFF+2
+          Q2(I,K,J)=MAX(E3(K)+E3(K)-Q2(I,K+1,J),EPSQ2)*HBM2IJ           &
+     &             +Q2(I,K,J)*(1.-HBM2IJ)
+        ENDDO
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      ENDDO 
+!
+      ENDDO main_integration
+!-----------------------------------------------------------------------
+!----------------------------------------------------------------------
+      END SUBROUTINE VAD2_DRY
+!----------------------------------------------------------------------
+!
+!***********************************************************************
+      SUBROUTINE HAD2_DRY(NTSD,DT,IDTAD,DX,DY                           &
+     &                   ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP            &
+     &                   ,HTM,HBM2,HBM3,LMH                             &
+     &                   ,Q2,U,V,Z,HYDRO                                &
+     &                   ,N_IUP_H,N_IUP_V                               &
+     &                   ,N_IUP_ADH,N_IUP_ADV                           &
+     &                   ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                   &
+     &                   ,IHE,IHW,IVE,IVW,INDX3_WRK                     &
+     &                   ,IDS,IDE,JDS,JDE,KDS,KDE                       &
+     &                   ,IMS,IME,JMS,JME,KMS,KME                       &
+     &                   ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    HAD2_DRY    HORIZONTAL ADVECTION OF TKE
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 96-07-19
+!
+! ABSTRACT:
+!     HAD2 CALCULATES THE CONTRIBUTION OF THE HORIZONTAL ADVECTION
+!     TO THE TENDENCIES OF TKE AND UPDATES IT.
+!     AN ANTI-FILTERING TECHNIQUE IS USED.
+!
+! PROGRAM HISTORY LOG:
+!   96-07-19  JANJIC   - ORIGINATOR
+!   98-11-02  BLACK    - MODIFIED FOR DISTRIBUTED MEMORY
+!   99-03-17  TUCCILLO - INCORPORATED MPI_ALLREDUCE FOR GLOBAL SUM
+!   02-02-06  BLACK    - CONVERTED TO WRF FORMAT
+!   02-09-06  WOLFE    - MORE CONVERSION TO GLOBAL INDEXING
+!   03-05-23  JANJIC   - ADDED SLOPE FACTOR
+!   04-11-23  BLACK    - THREADED
+!
+! USAGE: CALL HAD2_DRY FROM SUBROUTINE DIGITAL_FILTER
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST
+!
+!   OUTPUT FILES:
+!       NONE
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V          &
+     &                                        ,N_IUP_ADH,N_IUP_ADV
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V      &
+     &                                                ,IUP_ADH,IUP_ADV
+! NMM_MAX_DIM is set in configure.wrf and must agree with
+! the value of dimspec q in the Registry/Registry
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: IDTAD,NTSD
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: DT,DY,PDTOP
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DX,HBM2,HBM3,PDSL
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,U,V,Z
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: Q2
+!
+      LOGICAL,INTENT(IN) :: HYDRO
+!
+!----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      REAL,PARAMETER :: FF1=0.530
+!
+      LOGICAL :: BOT,TOP
+!
+      INTEGER :: I,IRECV,J,JFP,JFQ,K,KOFF,LAP,LLAP,MPI_COMM_COMP
+!
+      INTEGER,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: IFPA,IFPF           &
+     &                                             ,IFQA,IFQF           &
+     &                                             ,JFPA,JFPF           &
+     &                                             ,JFQA,JFQF
+!
+      REAL :: ADDT,AFRP,CRIT,D2PQE,DEP,DESTIJ,DVOLP,DZA,DZB             &
+     &       ,E00,E0Q,E2IJ,E4P,ENH,EP,EP0,ESTIJ,FPQ                     &
+     &       ,HAFP,HAFQ,HBM2IJ,HM,HTMIKJ,PP,PPQ00                       &
+     &       ,QP,RDY,RFACEK,RFC,RFEIJ,RR                                &
+     &       ,SLOPAC,SPP,SQP,SSA,SSB,SUMNE,SUMPE,TTA,TTB
+!
+      REAL,DIMENSION(2,KTE-KTS+1) :: GSUMS,XSUMS
+!
+      REAL,DIMENSION(KTS:KTE) :: AFR,DEL,E3,E4,RFACE
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: DARE,EMH
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: AFP,AFQ,DEST,DVOL      &
+     &                                          ,E1,E2  
+!
+!***********************************************************************
+!-----------------------------------------------------------------------
+      RDY=1./DY
+      SLOPAC=SLOPHT*SQRT(2.)*0.5*50.
+      CRIT=SLOPAC*REAL(IDTAD)*DT*RDY*1000.
+!
+      ADDT=REAL(IDTAD)*DT
+      ENH=ADDT/(08.*DY)
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS_P3,MYJE_P3
+      DO I=MYIS_P2,MYIE_P2
+        EMH (I,J)=ADDT/(08.*DX(I,J))
+        DARE(I,J)=HBM3(I,J)*DX(I,J)*DY
+        E1(I,KTE,J)=MAX(Q2(I,KTE,J)*0.5,EPSQ2)
+        E2(I,KTE,J)=E1(I,KTE,J)
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS_P3,MYJE_P3
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P2,MYIE_P2
+          DVOL(I,K,J)=DARE(I,J)*(DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J))
+        ENDDO
+        ENDDO
+!
+        DO K=KTE-1,KTS,-1
+        DO I=MYIS_P2,MYIE_P2
+          E1(I,K,J)=MAX((Q2(I,K+1,J)+Q2(I,K,J))*0.5,EPSQ2)
+          E2(I,K,J)=E1(I,K,J)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dza,dzb,fpq,i,j,jfp,jfq,k,pp,qp,spp,sqp,ssa,ssb,tta,ttb)
+      DO J=MYJS2_P1,MYJE2_P1
+      DO K=KTS,KTE
+      DO I=MYIS1_P1,MYIE1_P1
+!
+        TTA=(U(I,K,J-1)+U(I+IHW(J),K,J)+U(I+IHE(J),K,J)+U(I,K,J+1))     &
+     &      *EMH(I,J)*HBM2(I,J)
+        TTB=(V(I,K,J-1)+V(I+IHW(J),K,J)+V(I+IHE(J),K,J)+V(I,K,J+1))     &
+     &      *ENH*HBM2(I,J)
+!
+        SPP=-TTA-TTB
+        SQP= TTA-TTB
+!
+        IF(SPP<0.)THEN
+          JFP=-1
+        ELSE
+          JFP=1
+        ENDIF
+        IF(SQP<0.)THEN
+          JFQ=-1
+        ELSE
+          JFQ=1
+        ENDIF
+!
+        IFPA(I,K,J)=IHE(J)+I+( JFP-1)/2
+        IFQA(I,K,J)=IHE(J)+I+(-JFQ-1)/2
+!
+        JFPA(I,K,J)=J+JFP
+        JFQA(I,K,J)=J+JFQ
+!
+        IFPF(I,K,J)=IHE(J)+I+(-JFP-1)/2
+        IFQF(I,K,J)=IHE(J)+I+( JFQ-1)/2
+!
+        JFPF(I,K,J)=J-JFP
+        JFQF(I,K,J)=J-JFQ
+!
+!------------------------------------------------------------------------
+        IF(.NOT.HYDRO)THEN ! z currently not available for hydro=.true.
+          DZA=(Z(IFPA(I,K,J),K,JFPA(I,K,J))-Z(I,K,J))*RDY
+          DZB=(Z(IFQA(I,K,J),K,JFQA(I,K,J))-Z(I,K,J))*RDY
+!
+          IF(ABS(DZA)>SLOPAC)THEN
+            SSA=DZA*SPP
+            IF(SSA>CRIT)THEN
+              SPP=0. !spp*.1
+            ENDIF
+          ENDIF
+!
+          IF(ABS(DZB)>SLOPAC)THEN
+            SSB=DZB*SQP
+            IF(SSB>CRIT)THEN
+              SQP=0. !sqp*.1
+            ENDIF
+          ENDIF
+!
+        ENDIF
+!-----------------------------------------------------------------------
+        SPP=SPP*HTM(IFPA(I,K,J),K,JFPA(I,K,J))
+        SQP=SQP*HTM(IFQA(I,K,J),K,JFQA(I,K,J))
+        FPQ=SPP*SQP*HTM(I,K,J-2)*HTM(I-1,K,J)                           &
+     &             *HTM(I+1,K,J)*HTM(I,K,J+2)*0.25
+        PP=ABS(SPP)
+        QP=ABS(SQP)
+!
+        AFP(I,K,J)=(((FF4*PP+FF3)*PP+FF2)*PP+FF1)*PP
+        AFQ(I,K,J)=(((FF4*QP+FF3)*QP+FF2)*QP+FF1)*QP
+!
+        E2(I,K,J)=(E1 (IFPA(I,K,J),K,JFPA(I,K,J))-E1 (I,K,J))*PP        &
+     &           +(E1 (IFQA(I,K,J),K,JFQA(I,K,J))-E1 (I,K,J))*QP        &
+     &           +(E1 (I,K,J-2)+E1 (I,K,J+2)                            &
+     &            -E1 (I-1,K,J)-E1 (I+1,K,J))*FPQ                       &
+     &           +E1(I,K,J)
+!
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  ANTI-FILTERING STEP
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+        XSUMS(1,K)=0.
+        XSUMS(2,K)=0.
+      ENDDO
+!
+!--------------ANTI-FILTERING LIMITERS----------------------------------
+!
+      DO 150 J=MYJS2,MYJE2
+      DO 150 K=KTS,KTE
+      DO 150 I=MYIS1,MYIE1
+!
+      DVOLP=DVOL(I,K,J)
+      E2IJ =E2(I,K,J)
+!
+      HAFP=HTM(IFPF(I,K,J),K,JFPF(I,K,J))*AFP(I,K,J)
+      HAFQ=HTM(IFQF(I,K,J),K,JFQF(I,K,J))*AFQ(I,K,J)
+!
+      D2PQE=(E2(IFPA(I,K,J),K,JFPA(I,K,J))-E2IJ                         &
+     &      -E2IJ+E2(IFPF(I,K,J),K,JFPF(I,K,J)))                        &
+     &      *HAFP                                                       &
+     &     +(E2(IFQA(I,K,J),K,JFQA(I,K,J))-E2IJ                         &
+     &      -E2IJ+E2(IFQF(I,K,J),K,JFQF(I,K,J)))                        &
+     &      *HAFQ
+!
+      ESTIJ=E2IJ-D2PQE
+!
+      E00=E1 (I          ,K          ,J)
+      EP0=E1 (IFPA(I,K,J),K,JFPA(I,K,J))
+      E0Q=E1 (IFQA(I,K,J),K,JFQA(I,K,J))
+!
+      ESTIJ=MAX(ESTIJ,MIN(E00,EP0,E0Q))
+      ESTIJ=MIN(ESTIJ,MAX(E00,EP0,E0Q))
+!
+      DESTIJ=ESTIJ-E1(I,K,J)
+      DEST(I,K,J)=DESTIJ
+!
+      DESTIJ=DESTIJ*DVOLP
+!
+      IF(DESTIJ>0.)THEN
+        XSUMS(1,K)=XSUMS(1,K)+DESTIJ
+      ELSE
+        XSUMS(2,K)=XSUMS(2,K)+DESTIJ
+      ENDIF
+!
+  150 CONTINUE
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***  GLOBAL REDUCTION
+!-----------------------------------------------------------------------
+!
+#ifdef DM_PARALLEL
+      CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
+      CALL MPI_ALLREDUCE(XSUMS,GSUMS,2*(KTE-KTS+1),MPI_REAL,MPI_SUM     &
+     &                  ,MPI_COMM_COMP,IRECV)
+#else
+      GSUMS=XSUMS
+#endif
+!
+!-----------------------------------------------------------------------
+!***  END OF GLOBAL REDUCTION
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+!
+!-----------------------------------------------------------------------
+        SUMPE=GSUMS(1,K)
+        SUMNE=GSUMS(2,K)
+!
+!-----------------------------------------------------------------------
+!***  FIRST MOMENT CONSERVING FACTOR
+!-----------------------------------------------------------------------
+!
+        IF(SUMPE>1.)THEN
+          RFACEK=-SUMNE/SUMPE
+        ELSE
+          RFACEK=1.
+        ENDIF
+!
+        IF(RFACEK<CONSERVE_MIN.OR.RFACEK>CONSERVE_MAX)RFACEK=1.
+!
+        RFACE(K)=RFACEK
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  IMPOSE CONSERVATION ON ANTI-FILTERING
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(destij,i,j,k,rfacek,rfeij)
+      DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+          RFACEK=RFACE(K)
+          IF(RFACEK<1.)THEN
+            DO I=MYIS1,MYIE1
+              DESTIJ=DEST(I,K,J)
+              RFEIJ=HBM2(I,J)*(RFACEK-1.)+1.
+              IF(DESTIJ>=0.)DESTIJ=DESTIJ*RFEIJ
+              E1(I,K,J)=E1(I,K,J)+DESTIJ
+            ENDDO
+          ELSE
+            DO I=MYIS1,MYIE1
+              DESTIJ=DEST(I,K,J)
+              RFEIJ=HBM2(I,J)*(RFACEK-1.)+1.
+              IF(DESTIJ<0.)DESTIJ=DESTIJ/RFEIJ
+              E1(I,K,J)=E1(I,K,J)+DESTIJ
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+        Q2(I,KTE,J)=MAX(E1(I,KTE,J)+E1(I,KTE,J)-EPSQ2,EPSQ2)            &
+     &             *HTM(I,KTE,J)
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k,koff)
+      DO J=MYJS,MYJE
+      DO K=KTE-1,KTS+1,-1
+      DO I=MYIS,MYIE
+        KOFF=KTE-LMH(I,J)
+        IF(K>KOFF+1)THEN
+          Q2(I,K,J)=MAX(E1(I,K,J)+E1(I,K,J)-Q2(I,K+1,J),EPSQ2)          &
+     &             *HTM(I,K,J)
+        ELSE
+          Q2(I,K,J)=Q2(I,K+1,J)
+        ENDIF
+      ENDDO
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      END SUBROUTINE HAD2_DRY
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!^L
+! New routines added by Georg Grell to handle advection more like ARW
+! core.  Instead of VAD2/HAD2 that advect TKE, specific humidity, and
+! condensed water species all in one routine, we call VAD2/HAD2_SCAL
+! with multidimensioned arrays to advect each variable.  For purposes
+! here, solve_nmm.F calls this routine once for TKE, then again for
+! all the species held in the moist array (qv, qc, qi, qr, qs, qg),
+! then call again for number concentrations held in scalar array (qni).
+! The dummy argument lstart is the starting index of the multidimensioned
+! array for starting the advection since the 1st index of moist and
+! scalar are actually empty placeholders (and the 2nd element is vapor,
+! then qc, etc.)  When calling with single 3D array (like TKE), just
+! set NUM_SCAL=1 and lstart=1.  The variable to advect is called SCAL
+! herein.
+!***********************************************************************
+      SUBROUTINE VAD2_SCAL(NTSD,DT,IDTAD,DX,DY                               &
+     &               ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP                &
+     &               ,HBM2,LMH                                          &
+     &               ,SCAL,PETDT                                        &
+     &               ,N_IUP_H,N_IUP_V                                   &
+     &               ,N_IUP_ADH,N_IUP_ADV                               &
+     &               ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                       &
+     &               ,IHE,IHW,IVE,IVW,INDX3_WRK                         &
+     &               ,NUM_SCAL,lstart                                   &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &               ,IMS,IME,JMS,JME,KMS,KME                           &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    VAD2_SCAL   VERTICAL ADVECTION OF SCALARS
+!
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 96-07-19
+!            GRELL,PECKHAM   ORG: NOAA/FSL   DATE: 05-02-03
+!     
+! ABSTRACT:          
+!     VAD2_SCAL CALCULATES THE CONTRIBUTION OF THE VERTICAL ADVECTION   
+!     TO THE TENDENCIES OF SCALAR SUBSTANCES AND THEN UPDATES           
+!     THOSE VARIABLES.  AN ANTI-FILTERING TECHNIQUE IS USED.            
+!    
+! PROGRAM HISTORY LOG:
+!   96-07-19  JANJIC           - ORIGINATOR
+!   05-02-03  GRELL,PECKHAM    - MODIFIED FOR SCALARS                   
+!    
+! USAGE: CALL VAD2_SCAL FROM SUBROUTINE SOLVE_NMM                       
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST
+!                
+!   OUTPUT FILES:
+!       NONE
+!   SUBPROGRAMS CALLED:      
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!***********************************************************************
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE
+
+      INTEGER,INTENT(IN) :: NUM_SCAL, lstart
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V          &
+     &                                        ,N_IUP_ADH,N_IUP_ADV
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V      &
+     &                                                ,IUP_ADH,IUP_ADV
+! NMM_MAX_DIM is set in configure.wrf and must agree with
+! the value of dimspec q in the Registry/Registry
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: IDTAD,NTSD
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: DT,DY,PDTOP
+!    
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DX,HBM2,PDSL
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,1:NUM_SCAL),INTENT(INOUT) :: SCAL
+!
+!----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      REAL,PARAMETER :: FF1=0.525
+!
+      LOGICAL :: BOT,TOP
+!
+      INTEGER :: I,IRECV,J,JFP,JFQ,K,KOFF,LAP,LLAP, L
+!
+      INTEGER,DIMENSION(KTS:KTE) :: LA
+!
+      REAL*8 :: ADDT,AFRP,D2PQE,D2PQQ,D2PQW,DEP,DETAP,DPDN,DPUP,DQP     &
+     &       ,DWP,E00,E4P,EP,EP0,HADDT,HBM2IJ                           &
+     &       ,Q00,Q4P,QP,QP0                                            &
+     &       ,RFACEK,RFACQK,RFACWK,RFC,RR                               &
+     &       ,SUMNE,SUMNQ,SUMNW,SUMPE,SUMPQ,SUMPW                       &
+     &       ,W00,W4P,WP,WP0
+      REAL,DIMENSION(KTS:KTE) :: AFR,DEL,DQL,DWL,E3,E4,PETDTK           &
+     &                          ,RFACE,RFACQ,RFACW,Q3,Q4,W3,W4
+!
+!***********************************************************************
+!-----------------------------------------------------------------------
+!     
+      ADDT=REAL(IDTAD)*DT
+!     
+!-----------------------------------------------------------------------
+!     
+!$omp parallel do                                                       &
+!$omp& private(afr,afrp,bot,d2pqe,d2pqq,d2pqw,del,dep,detap,dpdn,dpup   &
+!$omp&        ,dql,dqp,dwl,dwp,e00,e3,e4,e4p,ep,ep0,haddt,i,j,k,koff    &
+!$omp&        ,la,lap,llap,petdtk,q00,q3,q4,q4p,qp,qp0,rfacek,rfacqk    &
+!$omp&        ,rfacwk,rfc,rr,sumne,sumnq,sumnw,sumpe,sumpq,sumpw,top    &
+!$omp&        ,w00,w3,w4,w4p,wp,wp0)
+
+      scalar_loop : DO L=lstart,NUM_SCAL
+      main_integration : DO J=MYJS2,MYJE2
+!
+      DO I=MYIS1_P1,MYIE1_P1
+!-----------------------------------------------------------------------
+        KOFF=KTE-LMH(I,J)
+!
+        DO K=KOFF+1,KTE
+!         Q3(K)=MAX(SCAL(I,K,J,L),EPSILSCALAR)
+          Q3(K)=SCAL(I,K,J,L)
+          Q4(K)=Q3(K)
+        ENDDO
+!
+        PETDTK(KTE)=PETDT(I,KTE-1,J)*0.5
+!
+        DO K=KTE-1,KOFF+2,-1
+          PETDTK(K)=(PETDT(I,K,J)+PETDT(I,K-1,J))*0.5
+        ENDDO
+!
+        PETDTK(KOFF+1)=PETDT(I,KOFF+1,J)*0.5
+!-----------------------------------------------------------------------
+        HADDT=-ADDT*HBM2(I,J)
+!
+        DO K=KTE,KOFF+1,-1
+          RR=PETDTK(K)*HADDT
+!
+          IF(RR<0.)THEN
+            LAP=1
+          ELSE
+            LAP=-1
+          ENDIF
+!
+          LA(K)=LAP
+          LLAP=K+LAP
+!
+          TOP=.FALSE.
+          BOT=.FALSE.
+!
+          IF(LLAP>KOFF.AND.LLAP<KTE+1.AND.LAP/=0)THEN
+            RR=ABS(RR/((AETA1(LLAP)-AETA1(K))*PDTOP                     &
+     &                +(AETA2(LLAP)-AETA2(K))*PDSL(I,J)))
+!
+            AFR(K)=(((FF4*RR+FF3)*RR+FF2)*RR+FF1)*RR
+            DQP=(Q3(LLAP)-Q3(K))*RR
+            DQL(K)=DQP
+          ELSE
+            TOP=LLAP==KTE+1
+            BOT=LLAP==KOFF
+!
+            RR=0.
+            AFR(K)=0.
+            DQL(K)=0.
+          ENDIF
+        ENDDO
+!-----------------------------------------------------------------------
+        IF(TOP)THEN
+          IF(LA(KTE-1)>0)THEN
+            RFC=(DETA1(KTE-1)*PDTOP+DETA2(KTE-1)*PDSL(I,J))             &
+     &         /(DETA1(KTE  )*PDTOP+DETA2(KTE  )*PDSL(I,J))
+            DQL(KTE)=-DQL(KTE+1)*RFC
+          ENDIF
+        ENDIF
+!       
+        IF(BOT)THEN
+          IF(LA(KOFF+2)<0)THEN
+            RFC=(DETA1(KOFF+2)*PDTOP+DETA2(KOFF+2)*PDSL(I,J))           &
+     &         /(DETA1(KOFF+1)*PDTOP+DETA2(KOFF+1)*PDSL(I,J))
+            DQL(KOFF+1)=-DQL(KOFF+2)*RFC
+          ENDIF
+        ENDIF
+!       
+        DO K=KOFF+1,KTE
+          Q4(K)=Q3(K)+DQL(K)
+        ENDDO
+!-----------------------------------------------------------------------
+!***  ANTI-FILTERING STEP
+!-----------------------------------------------------------------------
+        SUMPQ=0.
+        SUMNQ=0.
+!
+!***  ANTI-FILTERING LIMITERS
+!       
+        DO 50 K=KTE-1,KOFF+2,-1
+!       
+        DETAP=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
+!       
+        Q4P=Q4(K)
+!       
+        LAP=LA(K)
+!       
+        IF(LAP.NE.0)THEN
+          DPDN=(AETA1(K+LAP)-AETA1(K))*PDTOP                            &
+     &        +(AETA2(K+LAP)-AETA2(K))*PDSL(I,J)
+          DPUP=(AETA1(K)-AETA1(K-LAP))*PDTOP                            &
+     &        +(AETA2(K)-AETA2(K-LAP))*PDSL(I,J)
+!
+          AFRP=2.*AFR(K)*DPDN*DPDN/(DPDN+DPUP)
+          D2PQQ=((Q4(K+LAP)-Q4P)/DPDN                                   &
+     &          -(Q4P-Q4(K-LAP))/DPUP)*AFRP
+        ELSE
+          D2PQQ=0.
+        ENDIF
+!
+        QP=Q4P-D2PQQ
+!
+        Q00=Q3(K)
+        QP0=Q3(K+LAP)
+!
+        IF(LAP/=0)THEN
+          QP=MAX(QP,MIN(Q00,QP0))
+          QP=MIN(QP,MAX(Q00,QP0))
+        ENDIF
+!
+        DQP=QP-Q00
+!
+        DQL(K)=DQP
+!
+        DQP=DQP*DETAP
+!
+        IF(DQP>0.)THEN
+          SUMPQ=SUMPQ+DQP
+        ELSE
+          SUMNQ=SUMNQ+DQP
+        ENDIF
+!
+   50   CONTINUE
+!-----------------------------------------------------------------------
+        DQL(KOFF+1)=0.
+!
+        DQL(KTE)=0.
+!-----------------------------------------------------------------------
+!***  FIRST MOMENT CONSERVING FACTOR
+!-----------------------------------------------------------------------
+        IF(SUMPQ>1.E-9)THEN
+          RFACQK=-SUMNQ/SUMPQ
+        ELSE  
+          RFACQK=1.
+        ENDIF
+!         
+        IF(RFACQK<CONSERVE_MIN.OR.RFACQK>CONSERVE_MAX)RFACQK=1.
+!-----------------------------------------------------------------------
+!***  IMPOSE CONSERVATION ON ANTI-FILTERING
+!-----------------------------------------------------------------------
+        DO K=KTE,KOFF+1,-1
+          DQP=DQL(K)
+          IF(DQP>=0.)DQP=DQP*RFACQK
+          SCAL(I,K,J,L)=Q3(K)+DQP
+        ENDDO
+!
+!       HBM2IJ=HBM2(I,J)
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      ENDDO
+
+!       
+      ENDDO main_integration
+      ENDDO scalar_loop
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      END SUBROUTINE VAD2_SCAL
+!-----------------------------------------------------------------------
+!         
+!***********************************************************************
+      SUBROUTINE HAD2_SCAL(                                             &
+#if defined(DM_PARALLEL)
+     &                domdesc ,                                         &
+#endif  
+     &                NTSD,DT,IDTAD,DX,DY                               &
+     &               ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP                &
+     &               ,HTM,HBM2,HBM3,LMH                                 &
+     &               ,SCAL,U,V,Z,HYDRO                              &
+     &               ,N_IUP_H,N_IUP_V                                   &
+     &               ,N_IUP_ADH,N_IUP_ADV                               &
+     &               ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                       &
+     &               ,IHE,IHW,IVE,IVW,INDX3_WRK                         &
+     &               ,NUM_SCAL,lstart                                   &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &               ,IMS,IME,JMS,JME,KMS,KME                           &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    HAD2_SCAL   HORIZONTAL ADVECTION OF SCALAR
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 96-07-19
+!            GRELL,PECKHAM   ORG: NOAA/FSL   DATE: 05-02-03
+!
+! ABSTRACT:
+!     HAD2_SCAL CALCULATES THE CONTRIBUTION OF THE HORIZONTAL ADVECTION
+!     TO THE TENDENCIES OF SCALAR SUBSTANCES AND THEN
+!     UPDATES THOSE VARIABLES.  AN ANTI-FILTERING TECHNIQUE IS USED.
+!
+! PROGRAM HISTORY LOG:
+!   96-07-19  JANJIC           - ORIGINATOR
+!   05-01-03  GRELL,PECKKHAM   - MODIFIED FOR SCALAR
+!
+! USAGE: CALL HAD2_SCAL FROM SUBROUTINE SOLVE_NMM
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST
+!
+!   OUTPUT FILES:
+!       NONE
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!***********************************************************************
+!-----------------------------------------------------------------------
+!    
+      IMPLICIT NONE  
+!    
+!-----------------------------------------------------------------------
+!    
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+
+      INTEGER,INTENT(IN) :: NUM_SCAL, lstart
+!   
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V          &
+     &                                        ,N_IUP_ADH,N_IUP_ADV
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V      &
+     &                                                ,IUP_ADH,IUP_ADV
+!-----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! NMM_MAX_DIM is set in configure.wrf and must agree with the value of
+! dimspec q in Registry/Registry.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-----------------------------------------------------------------------
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!   
+      INTEGER,INTENT(IN) :: IDTAD,NTSD
+!   
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
+!   
+      REAL,INTENT(IN) :: DT,DY,PDTOP
+!   
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+!     
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DX,HBM2,HBM3,PDSL
+!     
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,U,V,Z
+! 
+!!!!!   q is local. CORRECT DIMENSION???
+!jjjj
+!!!!!      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME)               :: Q
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,JTS-5:JTE+5) :: Q
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,NUM_SCAL),INTENT(INOUT) :: SCAL
+!
+      LOGICAL,INTENT(IN) :: HYDRO
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      REAL,PARAMETER :: FF1=0.530
+!
+#ifdef DM_PARALLEL
+      INTEGER :: DOMDESC
+#endif
+!
+#if defined(BIT_FOR_BIT) && defined(DM_PARALLEL)
+      LOGICAL,EXTERNAL :: WRF_DM_ON_MONITOR
+      INTEGER :: N
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,6) :: XSUMS_L
+      REAL,DIMENSION(IDS:IDE,KDS:KDE,JDS:JDE,6) :: XSUMS_G
+#endif
+!
+      LOGICAL :: BOT,TOP
+!
+      INTEGER :: I,IRECV,J,JFP,JFQ,K,KOFF,LAP,LLAP,MPI_COMM_COMP, L
+!
+      INTEGER,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: IFPA,IFPF           &
+     &                                             ,IFQA,IFQF           &
+     &                                             ,JFPA,JFPF           &
+     &                                             ,JFQA,JFQF
+!
+      REAL :: ADDT,AFRP,CRIT,D2PQE,D2PQQ,D2PQW,DEP,DESTIJ,DQP,DQSTIJ    &
+     &       ,DVOLP,DWP,DWSTIJ,DZA,DZB,E00,E0Q,E1X,E2IJ,E4P,ENH,EP,EP0  &
+     &       ,ESTIJ,FPQ,HAFP,HAFQ,HBM2IJ,HM,HTMIKJ,PP,PPQ00,Q00,Q0Q     &
+     &       ,Q1IJ,Q4P,QP,QP0,QSTIJ,RDY,RFACEK,RFACQK,RFACWK,RFC        &
+     &       ,RFEIJ,RFQIJ,RFWIJ,RR,SLOPAC,SPP,SQP,SSA,SSB,SUMNE,SUMNQ   &
+     &       ,SUMNW,SUMPE,SUMPQ,SUMPW,TTA,TTB,W00,W0Q,W1IJ,W4P,WP,WP0   &
+     &       ,WSTIJ
+!
+      DOUBLE PRECISION,DIMENSION(6,KTE-KTS+1) :: GSUMS,XSUMS
+!
+      REAL,DIMENSION(KTS:KTE) :: AFR,DEL,DQL,DWL,E3,E4                  &
+     &                          ,RFACE,RFACQ,RFACW,Q3,Q4,W3,W4
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: DARE,EMH
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,JTS-5:JTE+5) :: AFP,AFQ,DEST   &
+     &                                                  ,DQST,DVOL,DWST &
+     &                                                  ,E1,E2,Q1,W1
+      integer :: nunit,ier
+      save nunit
+!***********************************************************************
+!-----------------------------------------------------------------------
+!     
+      RDY=1./DY
+      SLOPAC=SLOPHT*SQRT(2.)*0.5*50.
+      CRIT=SLOPAC*REAL(IDTAD)*DT*RDY*1000.
+!     
+      ADDT=REAL(IDTAD)*DT
+      ENH=ADDT/(08.*DY)
+!     
+!-----------------------------------------------------------------------
+!
+      SCALAR_LOOP :  DO L=lstart,NUM_SCAL
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS_P3,MYJE_P3                         
+      DO I=MYIS_P2,MYIE_P2                         
+        EMH (I,J)=ADDT/(08.*DX(I,J))               
+        DARE(I,J)=HBM3(I,J)*DX(I,J)*DY
+!       E1(I,KTE,J)=MAX(Q2(I,KTE,J)*0.5,EPSQ2)
+!       E2(I,KTE,J)=E1(I,KTE,J)
+      ENDDO  
+      ENDDO  
+!-----------------------------------------------------------------------
+!    
+!$omp parallel do                                                       &
+!$omp& private(e1x,htmikj,i,j,k)
+      DO J=MYJS_P3,MYJE_P3
+        DO K=KTS,KTE
+        DO I=MYIS_P2,MYIE_P2
+          DVOL(I,K,J)=DARE(I,J)*(DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J))
+          HTMIKJ=HTM(I,K,J)
+!         Q  (I,K,J)=MAX(SCAL(I,K,J,L),EPSILSCALAR)*HTMIKJ
+          Q  (I,K,J)=SCAL(I,K,J,L)*HTMIKJ
+          Q1  (I,K,J)=Q  (I,K,J)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dza,dzb,fpq,i,j,jfp,jfq,k,pp,qp,ssa,ssb,spp,sqp,tta,ttb)
+      DO J=MYJS2_P1,MYJE2_P1
+      DO K=KTS,KTE
+      DO I=MYIS1_P1,MYIE1_P1
+!
+        TTA=(U(I,K,J-1)+U(I+IHW(J),K,J)+U(I+IHE(J),K,J)+U(I,K,J+1))     &
+     &      *EMH(I,J)*HBM2(I,J)
+        TTB=(V(I,K,J-1)+V(I+IHW(J),K,J)+V(I+IHE(J),K,J)+V(I,K,J+1))     &
+     &      *ENH*HBM2(I,J)
+!
+        SPP=-TTA-TTB
+        SQP= TTA-TTB
+!
+        IF(SPP<0.)THEN
+          JFP=-1
+        ELSE
+          JFP=1
+        ENDIF
+        IF(SQP<0.)THEN
+          JFQ=-1
+        ELSE
+          JFQ=1
+        ENDIF
+!
+        IFPA(I,K,J)=IHE(J)+I+( JFP-1)/2
+        IFQA(I,K,J)=IHE(J)+I+(-JFQ-1)/2
+!
+        JFPA(I,K,J)=J+JFP
+        JFQA(I,K,J)=J+JFQ
+!
+        IFPF(I,K,J)=IHE(J)+I+(-JFP-1)/2
+        IFQF(I,K,J)=IHE(J)+I+( JFQ-1)/2
+!         
+        JFPF(I,K,J)=J-JFP
+        JFQF(I,K,J)=J-JFQ
+!       
+!-----------------------------------------------------------------------
+        IF(.NOT.HYDRO)THEN ! z currently not available for hydro=.true.
+          DZA=(Z(IFPA(I,K,J),K,JFPA(I,K,J))-Z(I,K,J))*RDY
+          DZB=(Z(IFQA(I,K,J),K,JFQA(I,K,J))-Z(I,K,J))*RDY
+!
+          IF(ABS(DZA)>SLOPAC)THEN
+            SSA=DZA*SPP
+            IF(SSA>CRIT)THEN
+              SPP=0. !spp*.1
+            ENDIF
+          ENDIF
+!    
+          IF(ABS(DZB)>SLOPAC)THEN
+            SSB=DZB*SQP
+            IF(SSB>CRIT)THEN
+              SQP=0. !sqp*.1
+            ENDIF
+          ENDIF
+!       
+        ENDIF
+!-----------------------------------------------------------------------
+        SPP=SPP*HTM(IFPA(I,K,J),K,JFPA(I,K,J))
+        SQP=SQP*HTM(IFQA(I,K,J),K,JFQA(I,K,J))
+        FPQ=SPP*SQP*HTM(I,K,J-2)*HTM(I-1,K,J)                           &
+     &             *HTM(I+1,K,J)*HTM(I,K,J+2)*0.25
+        PP=ABS(SPP)
+        QP=ABS(SQP)
+!       
+        AFP(I,K,J)=(((FF4*PP+FF3)*PP+FF2)*PP+FF1)*PP
+        AFQ(I,K,J)=(((FF4*QP+FF3)*QP+FF2)*QP+FF1)*QP
+!       
+        Q1(I,K,J)=(Q  (IFPA(I,K,J),K,JFPA(I,K,J))-Q  (I,K,J))*PP        &
+     &           +(Q  (IFQA(I,K,J),K,JFQA(I,K,J))-Q  (I,K,J))*QP        &
+     &           +(Q  (I,K,J-2)+Q  (I,K,J+2)                            &
+     &            -Q  (I-1,K,J)-Q  (I+1,K,J))*FPQ                       &
+     &           +Q(I,K,J)
+!
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  ANTI-FILTERING STEP
+!-----------------------------------------------------------------------
+!
+      DO K=KTS,KTE
+        XSUMS(1,K)=0.
+        XSUMS(2,K)=0.
+        XSUMS(3,K)=0.
+        XSUMS(4,K)=0.
+        XSUMS(5,K)=0.
+        XSUMS(6,K)=0.
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!***  ANTI-FILTERING LIMITERS
+!
+!-----------------------------------------------------------------------
+#if defined(BIT_FOR_BIT) && defined(DM_PARALLEL)
+      DO N=1,6
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+        DO J=JMS,JME
+        DO K=KMS,KME
+        DO I=IMS,IME
+          XSUMS_L(I,K,J,N)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+        DO J=JDS,JDE
+        DO K=KDS,KDE
+        DO I=IDS,IDE
+          XSUMS_G(I,K,J,N)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+!     
+      ENDDO
+!
+#endif
+!-----------------------------------------------------------------------
+      DO 150 J=MYJS2,MYJE2
+      DO 150 K=KTS,KTE
+      DO 150 I=MYIS1,MYIE1
+!       
+      DVOLP=DVOL(I,K,J)
+      Q1IJ =Q1(I,K,J)
+      W1IJ =W1(I,K,J)
+      E2IJ =E2(I,K,J)
+!     
+      HAFP=HTM(IFPF(I,K,J),K,JFPF(I,K,J))*AFP(I,K,J)
+      HAFQ=HTM(IFQF(I,K,J),K,JFQF(I,K,J))*AFQ(I,K,J)
+!
+      D2PQQ=(Q1(IFPA(I,K,J),K,JFPA(I,K,J))-Q1IJ                         &
+     &      -Q1IJ+Q1(IFPF(I,K,J),K,JFPF(I,K,J)))                        &
+     &      *HAFP                                                       &
+     &     +(Q1(IFQA(I,K,J),K,JFQA(I,K,J))-Q1IJ                         &
+     &      -Q1IJ+Q1(IFQF(I,K,J),K,JFQF(I,K,J)))                        &
+     &      *HAFQ                                                       
+!
+      QSTIJ=Q1IJ-D2PQQ
+!       
+      Q00=Q  (I          ,K          ,J)
+      QP0=Q  (IFPA(I,K,J),K,JFPA(I,K,J))
+      Q0Q=Q  (IFQA(I,K,J),K,JFQA(I,K,J))
+!       
+      QSTIJ=MAX(QSTIJ,MIN(Q00,QP0,Q0Q))
+      QSTIJ=MIN(QSTIJ,MAX(Q00,QP0,Q0Q))
+!
+      DQSTIJ=QSTIJ-Q(I,K,J)
+!       
+      DQST(I,K,J)=DQSTIJ
+!       
+      DQSTIJ=DQSTIJ*DVOLP
+!
+#if defined(BIT_FOR_BIT) && defined(DM_PARALLEL)
+      DO N=1,6
+        XSUMS_L(I,K,J,N)=0.
+      ENDDO
+!
+      IF(DQSTIJ>0.)THEN
+        XSUMS_L(I,K,J,1)=DQSTIJ
+      ELSE
+        XSUMS_L(I,K,J,2)=DQSTIJ
+      ENDIF
+!
+#else
+      IF(DQSTIJ>0.)THEN
+        XSUMS(1,K)=XSUMS(1,K)+DQSTIJ
+      ELSE
+        XSUMS(2,K)=XSUMS(2,K)+DQSTIJ
+      ENDIF
+!
+#endif
+!
+  150 CONTINUE
+!
+!-----------------------------------------------------------------------
+#if defined(BIT_FOR_BIT) && defined(DM_PARALLEL)
+      DO N=1,6
+        CALL WRF_PATCH_TO_GLOBAL_REAL( XSUMS_L(IMS,KMS,JMS,N)           &
+     &,                                XSUMS_G(1,1,1,N),DOMDESC         &
+     &,                               'xyz','xzy'                       &
+     &,                                IDS,IDE,KDS,KDE,JDS,JDE          &
+     &,                                IMS,IME,KMS,KME,JMS,JME          &
+     &,                                ITS,ITE,KTS,KTE,JTS,JTE )
+      ENDDO
+!
+      GSUMS=0.
+!
+      IF(WRF_DM_ON_MONITOR())THEN
+        DO N=1,6
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+          DO J=JDS,JDE
+          DO K=KDS,KDE
+          DO I=IDS,IDE
+            GSUMS(N,K)=GSUMS(N,K)+XSUMS_G(I,K,J,N)
+          ENDDO
+          ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+      
+      CALL WRF_DM_BCAST_BYTES(GSUMS,2*RWORDSIZE*6*(KDE-KDS+1) )
+      
+#else
+!-----------------------------------------------------------------------
+!     
+!-----------------------------------------------------------------------
+!***  GLOBAL REDUCTION
+!-----------------------------------------------------------------------
+!     
+# ifdef DM_PARALLEL
+      CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
+      CALL MPI_ALLREDUCE(XSUMS,GSUMS,6*(KTE-KTS+1)                      &
+     &                  ,MPI_DOUBLE_PRECISION,MPI_SUM                   &
+     &                  ,MPI_COMM_COMP,IRECV)
+# else
+      GSUMS=XSUMS
+# endif
+#endif  
+!    
+!-----------------------------------------------------------------------
+!***  END OF GLOBAL REDUCTION          
+!-----------------------------------------------------------------------
+!    
+!     if(mype==0)then
+!       if(ntsd==0)then
+!!        call int_get_fresh_handle(nunit)
+!!        close(nunit)
+!         nunit=56
+!         open(unit=nunit,file='gsums',form='unformatted',iostat=ier)
+!       endif
+!     endif
+      DO K=KTS,KTE
+!       if(mype==0)then
+!         write(nunit)(gsums(i,k),i=1,6)
+!       endif
+!
+!-----------------------------------------------------------------------
+        SUMPQ=GSUMS(1,K)
+        SUMNQ=GSUMS(2,K)
+!
+!-----------------------------------------------------------------------
+!***  FIRST MOMENT CONSERVING FACTOR
+!-----------------------------------------------------------------------
+!
+        IF(SUMPQ>1.)THEN
+          RFACQK=-SUMNQ/SUMPQ
+        ELSE
+          RFACQK=1.
+        ENDIF
+!
+        IF(RFACQK<CONSERVE_MIN.OR.RFACQK>CONSERVE_MAX)RFACQK=1.
+!
+        RFACQ(K)=RFACQK
+!
+      ENDDO
+!     if(mype==0.and.ntsd==181)close(nunit)
+!
+!-----------------------------------------------------------------------
+!***  IMPOSE CONSERVATION ON ANTI-FILTERING
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dqstij,i,j,k,rfacqk,rfqij)
+      DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+          RFACQK=RFACQ(K)
+          IF(RFACQK<1.)THEN
+            DO I=MYIS1,MYIE1
+              DQSTIJ=DQST(I,K,J)
+              RFQIJ=HBM2(I,J)*(RFACQK-1.)+1.
+              IF(DQSTIJ>=0.)DQSTIJ=DQSTIJ*RFQIJ
+              Q(I,K,J)=Q(I,K,J)+DQSTIJ
+            ENDDO
+          ELSE
+            DO I=MYIS1,MYIE1
+              DQSTIJ=DQST(I,K,J)
+              RFQIJ=HBM2(I,J)*(RFACQK-1.)+1.
+              IF(DQSTIJ<0.)DQSTIJ=DQSTIJ/RFQIJ
+              Q(I,K,J)=Q(I,K,J)+DQSTIJ
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS,MYJE
+      DO K=KTS,KTE
+      DO I=MYIS,MYIE
+!       SCAL(I,K,J,L)=MAX(Q (I,K,J),EPSILSCALAR)*HTM(I,K,J)
+        SCAL(I,K,J,L)=Q (I,K,J)*HTM(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+        
+      ENDDO   SCALAR_LOOP
+!-----------------------------------------------------------------------
+      END SUBROUTINE HAD2_SCAL
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      END MODULE MODULE_ADVECTION
+!-----------------------------------------------------------------------
+
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_BC_NMM.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_BC_NMM.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_BC_NMM.F	(revision 2744)
@@ -0,0 +1,14 @@
+!
+      MODULE MODULE_BC_NMM
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!
+!***  PRIMARY BOUNDARY CONDITION ARRAYS
+!
+      REAL,ALLOCATABLE,DIMENSION(:,:) :: PDB_ORIG
+!
+      REAL,ALLOCATABLE,DIMENSION(:,:,:) :: TB_ORIG,QB_ORIG,     &
+                            UB_ORIG,VB_ORIG,Q2B_ORIG,CWMB_ORIG
+!
+!----------------------------------------------------------------------
+      END MODULE MODULE_BC_NMM
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_BNDRY_COND.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_BNDRY_COND.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_BNDRY_COND.F	(revision 2744)
@@ -0,0 +1,1133 @@
+!-----------------------------------------------------------------------
+!
+!NCEP_MESO:MODEL_LAYER: BOUNDARY CONDITION UPDATES
+!
+!-----------------------------------------------------------------------
+!
+#include "nmm_loop_basemacros.h"
+#include "nmm_loop_macros.h"
+!
+!-----------------------------------------------------------------------
+!
+      MODULE MODULE_BNDRY_COND
+!
+!-----------------------------------------------------------------------
+      USE MODULE_STATE_DESCRIPTION
+      USE MODULE_MODEL_CONSTANTS
+!-----------------------------------------------------------------------
+#ifdef DM_PARALLEL
+      INCLUDE "mpif.h"
+#endif
+!-----------------------------------------------------------------------
+      REAL :: D06666=0.06666666
+!-----------------------------------------------------------------------
+!
+      CONTAINS
+!
+!***********************************************************************
+      SUBROUTINE BOCOH(GRIDID,NTSD,DT0,NEST,NBC,NBOCO,LAST_TIME,TSPH    &  ! GRIDID ADDED BY GOPAL
+     &                ,LB,ETA1,ETA2,PDTOP,PT,RES,HTM                    &
+     &                ,PD_B,T_B,Q_B,U_B,V_B,Q2_B,CWM_B                  &
+     &                ,PD_BT,T_BT,Q_BT,U_BT,V_BT,Q2_BT,CWM_BT           &
+     &                ,PD,T,Q,Q2,CWM,PINT,MOIST,N_MOIST,SCALAR,N_SCALAR &
+#ifdef WRF_CHEM
+     &                ,CHEM,NUM_CHE,CONFIG_FLAGS                        &
+#endif
+     &                ,IJDS,IJDE,SPEC_BDY_WIDTH,Z                       &  ! min/max(id,jd)
+     &                ,IHE,IHW,IVE,IVW,INDX3_WRK                        &
+     &                ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &                ,IMS,IME,JMS,JME,KMS,KME                          &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    BOCOH       UPDATE MASS POINTS ON BOUNDARY
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 94-03-08
+!     
+! ABSTRACT:
+!     TEMPERATURE, SPECIFIC HUMIDITY, AND SURFACE PRESSURE
+!     ARE UPDATED ON THE DOMAIN BOUNDARY BY APPLYING THE
+!     PRE-COMPUTED TENDENCIES AT EACH TIME STEP.
+!     
+! PROGRAM HISTORY LOG:
+!   87-??-??  MESINGER   - ORIGINATOR
+!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D in HORIZONTAL
+!   96-12-13  BLACK      - FINAL MODIFICATION FOR NESTED RUNS
+!   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
+!   00-01-06  BLACK      - MODIFIED FOR JANJIC NONHYDROSTATIC CODE
+!   00-09-14  BLACK      - MODIFIED FOR DIRECT ACCESS READ
+!   01-03-12  BLACK      - CONVERTED TO WRF STRUCTURE
+!   02-08-29  MICHALAKES - CHANGED II=I-MY_IS_GLB+1 TO II=I
+!                          ADDED CONDITIONAL COMPILATION AROUND MPI
+!                          CONVERT INDEXING FROM LOCAL TO GLOBAL
+!   02-09-06  WOLFE      - MORE CONVERSION TO GLOBAL INDEXING 
+!   04-11-18  BLACK      - THREADED
+!     
+! USAGE: CALL BOCOH FROM SUBROUTINE SOLVE_NMM
+!   INPUT ARGUMENT LIST:
+!
+!     NOTE THAT IDE AND JDE INSIDE ROUTINE SHOULD BE PASSED IN
+!     AS WHAT WRF CONSIDERS THE UNSTAGGERED GRID DIMENSIONS; THAT
+!     IS, 1 LESS THAN THE IDE AND JDE SET BY WRF FRAMEWORK, JM
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM 
+!$$$  
+!***********************************************************************
+!-----------------------------------------------------------------------
+#ifdef WRF_CHEM
+    USE MODULE_INPUT_CHEM_DATA
+#endif
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+      LOGICAL,INTENT(IN) :: NEST
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+      INTEGER,INTENT(IN) :: IJDS,IJDE,SPEC_BDY_WIDTH
+      INTEGER,INTENT(IN) :: N_MOIST, N_SCALAR
+#ifdef WRF_CHEM
+      INTEGER,INTENT(IN) :: NUM_CHE
+#endif
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!-----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! NMM_MAX_DIM is set in configure.wrf and must agree with the value of
+! dimspec q in the Registry/Registry
+!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-----------------------------------------------------------------------
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: GRIDID
+      INTEGER,INTENT(IN) :: LB,NBC,NTSD
+      LOGICAL,INTENT(IN) :: LAST_TIME
+      INTEGER,INTENT(INOUT) :: NBOCO
+!
+      REAL,INTENT(IN) :: DT0,PDTOP,PT,TSPH
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM
+!
+      REAL,DIMENSION(IJDS:IJDE,1,SPEC_BDY_WIDTH,4)                      &
+     &                                     ,INTENT(INOUT) :: PD_B,PD_BT
+!
+      REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4)                &
+     &                                ,INTENT(INOUT) :: CWM_B,Q_B,Q2_B  &
+     &                                                 ,T_B,U_B,V_B 
+      REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4)                &
+     &                             ,INTENT(INOUT) :: CWM_BT,Q_BT,Q2_BT  &
+     &                                              ,T_BT,U_BT,V_BT 
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: RES
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: PD
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM      &
+     &                                                        ,PINT,Q   &
+     &                                                        ,Q2,T,Z
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,NUM_MOIST),INTENT(INOUT) :: MOIST
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,NUM_SCALAR),INTENT(INOUT) :: SCALAR
+#ifdef WRF_CHEM
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,1:NUM_CHEM),INTENT(INOUT) :: CHEM
+      TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
+#endif
+
+
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      INTEGER :: BF,I,IB,IBDY,II,IIM,IM,IRTN,ISIZ1,ISIZ2                &
+     &          ,J,JB,JJ,JJM,JM,K,N,NN,NREC,REC,NV
+      INTEGER :: MY_IS_GLB,MY_JS_GLB,MY_IE_GLB,MY_JE_GLB  
+      INTEGER :: I_M,ILPAD1,IRPAD1,JBPAD1,JTPAD1
+!
+      LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY
+!
+      REAL :: BCHR,RHTM,SHTM,DT
+      REAL :: CONVFAC,RRI,PLYR
+      INTEGER KK,NUMGAS
+      REAL :: CWK
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+#ifdef WRF_CHEM
+   ! DETERMINE THE INDEX OF THE LAST GAS SPECIES
+     NUMGAS=P_HO2                     
+!   NUMGAS = GET_LAST_GAS(CONFIG_FLAGS%CHEM_OPT)       
+#endif
+      IM=IDE-IDS+1
+      JM=JDE-JDS+1
+      IIM=IM
+      JJM=JM
+!
+      ISIZ1=2*LB
+      ISIZ2=2*LB*(KME-KMS)
+!
+      W_BDY=(ITS==IDS)
+      E_BDY=(ITE==IDE)
+      S_BDY=(JTS==JDS)
+      N_BDY=(JTE==JDE)
+!
+      ILPAD1=1
+      IF(W_BDY)ILPAD1=0
+      IRPAD1=1
+      IF(E_BDY)IRPAD1=0
+      JBPAD1=1
+      IF(S_BDY)JBPAD1=0
+      JTPAD1=1
+      IF(N_BDY)JTPAD1=0
+!
+      MY_IS_GLB=ITS
+      MY_IE_GLB=ITE
+      MY_JS_GLB=JTS
+      MY_JE_GLB=JTE
+!
+      DT=DT0
+!
+!-----------------------------------------------------------------------
+!***  SOUTH AND NORTH BOUNDARIES
+!-----------------------------------------------------------------------
+!
+!***  USE IBDY=1 FOR SOUTH; 2 FOR NORTH
+!
+      DO IBDY=1,2 
+!
+!***  MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
+!
+        IF((S_BDY.AND.IBDY==1).OR.(N_BDY.AND.IBDY==2))THEN
+!
+          IF(IBDY==1)THEN
+            BF=P_YSB     ! Which boundary (YSB=the boundary where Y is at its start)
+            JB=1         ! Which cell in from boundary
+            JJ=1         ! Which cell in the domain
+          ELSE
+            BF=P_YEB     ! Which boundary (YEB=the boundary where Y is at its end)
+            JB=1         ! Which cell in from boundary
+            JJ=JJM       ! Which cell in the domain
+          ENDIF
+!
+          DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+            PD_B(I,1,JB,BF)=PD_B(I,1,JB,BF)+PD_BT(I,1,JB,BF)*DT
+            PD(I,JJ)=PD_B(I,1,JB,BF)
+          ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+          DO K=KTS,KTE
+            DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+              T_B(I,K,JB,BF)=T_B(I,K,JB,BF)+T_BT(I,K,JB,BF)*DT
+              Q_B(I,K,JB,BF)=Q_B(I,K,JB,BF)+Q_BT(I,K,JB,BF)*DT
+              Q2_B(I,K,JB,BF)=Q2_B(I,K,JB,BF)+Q2_BT(I,K,JB,BF)*DT
+              CWM_B(I,K,JB,BF)=CWM_B(I,K,JB,BF)+CWM_BT(I,K,JB,BF)*DT
+              T(I,K,JJ)=T_B(I,K,JB,BF)
+              Q(I,K,JJ)=Q_B(I,K,JB,BF)
+              Q2(I,K,JJ)=Q2_B(I,K,JB,BF)
+              CWM(I,K,JJ)=CWM_B(I,K,JB,BF)
+              PINT(I,K,JJ)=ETA1(K)*PDTOP                                &
+     &                    +ETA2(K)*PD(I,JJ)*RES(I,JJ)+PT
+            ENDDO
+          ENDDO
+          DO I_M=1,N_MOIST
+            IF(I_M==P_QV)THEN
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+              DO K=KTS,KTE
+              DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+                MOIST(I,K,JJ,I_M)=Q(I,K,JJ)/(1.-Q(I,K,JJ))
+              ENDDO
+              ENDDO
+            ELSE
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+              DO K=KTS,KTE
+              DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+                MOIST(I,K,JJ,I_M)=0.
+              ENDDO
+              ENDDO
+            ENDIF
+          ENDDO
+          DO I_M=2,N_SCALAR
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+            DO K=KTS,KTE
+            DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+              SCALAR(I,K,JJ,I_M)=0.
+            ENDDO
+            ENDDO
+          ENDDO
+#ifdef WRF_CHEM
+!$omp parallel do                                                       &
+!$omp& private(i,k,nv)
+          DO NV=P_SO2,P_HO2
+          DO K=KTS,KTE
+            DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+              CALL BDY_CHEM_VALUE (CHEM(I,K,JJ,NV), Z(I,K,JJ), NV,NUMGAS)
+            ENDDO
+          ENDDO
+          ENDDO
+!$omp parallel do                                                       &
+!$omp& private(i,k,nv)
+          DO NV=P_HO2+1,NUM_CHEM
+          DO K=KTS,KTE
+          KK=MIN(K+1,KTE)
+            DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+              PLYR=(PINT(I,K,JJ)+PINT(I,KK,JJ))*0.5
+              RRI=R_D*T(I,K,JJ)*(1.+.608*Q(I,K,JJ))/PLYR
+              CONVFAC=PLYR/RGASUNIV/T(I,K,JJ)
+              CALL BDY_CHEM_VALUE_SORGAM (CHEM(I,K,JJ,NV), Z(I,K,JJ), NV, &
+                                          CONFIG_FLAGS,RRI,CONVFAC,G)
+            ENDDO
+          ENDDO
+          ENDDO
+#endif
+        ENDIF
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  WEST AND EAST BOUNDARIES
+!-----------------------------------------------------------------------
+!
+!***  USE IBDY=1 FOR WEST; 2 FOR EAST. 
+!
+      DO IBDY=1,2 
+!
+!***  MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
+!
+        IF((W_BDY.AND.IBDY==1).OR.(E_BDY.AND.IBDY==2))THEN
+          IF(IBDY==1)THEN
+            BF=P_XSB     ! Which boundary (XSB=the boundary where X is at its start)
+            IB=1         ! Which cell in from boundary 
+            II=1         ! Which cell in the domain
+          ELSE
+            BF=P_XEB     ! Which boundary (XEB=the boundary where X is at its end)
+            IB=1         ! Which cell in from boundary
+            II=IIM       ! Which cell in the domain
+          ENDIF
+!
+          DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
+            IF(MOD(J,2)==1)THEN
+              PD_B(J,1,IB,BF)=PD_B(J,1,IB,BF)+PD_BT(J,1,IB,BF)*DT
+              PD(II,J)=PD_B(J,1,IB,BF)
+            ENDIF
+          ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(j,k)
+          DO K=KTS,KTE
+            DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
+!
+              IF(MOD(J,2)==1)THEN
+                T_B(J,K,IB,BF)=T_B(J,K,IB,BF)+T_BT(J,K,IB,BF)*DT
+                Q_B(J,K,IB,BF)=Q_B(J,K,IB,BF)+Q_BT(J,K,IB,BF)*DT
+                Q2_B(J,K,IB,BF)=Q2_B(J,K,IB,BF)+Q2_BT(J,K,IB,BF)*DT
+                CWM_B(J,K,IB,BF)=CWM_B(J,K,IB,BF)+CWM_BT(J,K,IB,BF)*DT
+                T(II,K,J)=T_B(J,K,IB,BF)
+                Q(II,K,J)=Q_B(J,K,IB,BF)
+                Q2(II,K,J)=Q2_B(J,K,IB,BF)
+                CWM(II,K,J)=CWM_B(J,K,IB,BF)
+                PINT(II,K,J)=ETA1(K)*PDTOP                              &
+     &                      +ETA2(K)*PD(II,J)*RES(II,J)+PT
+              ENDIF
+!
+            ENDDO
+          ENDDO
+!
+          DO I_M=1,N_MOIST
+            IF(I_M==P_QV)THEN
+!$omp parallel do                                                       &
+!$omp& private(j,k)
+              DO K=KTS,KTE
+              DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
+                IF(MOD(J,2)==1)THEN
+                  MOIST(II,K,J,I_M)=Q(II,K,J)/(1.-Q(II,K,J))
+                ENDIF
+              ENDDO
+              ENDDO
+!
+            ELSE
+!$omp parallel do                                                       &
+!$omp& private(j,k)
+              DO K=KTS,KTE
+              DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
+                IF(MOD(J,2)==1)THEN
+                  MOIST(II,K,J,I_M)=0.
+                ENDIF
+              ENDDO
+              ENDDO
+!
+            ENDIF
+          ENDDO
+!
+          DO I_M=2,N_SCALAR
+!$omp parallel do                                                       &
+!$omp& private(j,k)
+            DO K=KTS,KTE
+            DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
+              IF(MOD(J,2)==1)THEN
+                SCALAR(II,K,J,I_M)=0.
+              ENDIF
+            ENDDO
+            ENDDO
+          ENDDO
+!
+#ifdef WRF_CHEM
+!$omp parallel do                                                       &
+!$omp& private(nv,j,k)
+          DO K=KTS,KTE
+            DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
+              IF(MOD(J,2)==1)THEN
+                 DO NV=P_SO2,P_HO2
+                   CALL BDY_CHEM_VALUE (CHEM(II,K,J,NV), Z(II,K,J), NV,NUMGAS)
+                 ENDDO
+!$omp parallel do                                                       &
+!$omp& private(nv)
+                 DO NV=P_HO2+1,NUM_CHEM
+                    PLYR=(PINT(II,K,J)+PINT(II,KK,J))*0.5
+                    RRI=R_D*T(II,K,J)*(1.+P608*Q(II,K,J))/PLYR
+                    CONVFAC=PLYR/RGASUNIV/T(II,K,J)
+                    CALL BDY_CHEM_VALUE_SORGAM (CHEM(II,K,J,NV), Z(II,K,J), NV, &
+     &                                          CONFIG_FLAGS,RRI,CONVFAC,G)
+                 ENDDO
+               ENDIF
+            ENDDO
+          ENDDO
+
+#endif
+        ENDIF
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  SPACE INTERPOLATION OF PD THEN REMAINING MASS VARIABLES
+!***  AT INNER BOUNDARY
+!-----------------------------------------------------------------------
+!
+!***  ONE ROW NORTH OF SOUTHERN BOUNDARY
+!
+      IF(S_BDY)THEN
+        DO I=MYIS,MYIE1
+          SHTM=HTM(I,KTE,1)+HTM(I+1,KTE,1)+HTM(I,KTE,3)+HTM(I+1,KTE,3)
+          PD(I,2)=(PD(I,1)*HTM(I,KTE,1)+PD(I+1,1)*HTM(I+1,KTE,1)        &
+     &            +PD(I,3)*HTM(I,KTE,3)+PD(I+1,3)*HTM(I+1,KTE,3))/SHTM
+        ENDDO
+      ENDIF
+!
+!***  ONE ROW SOUTH OF NORTHERN BOUNDARY
+!
+      IF(N_BDY)THEN
+        DO I=MYIS,MYIE1
+          CWK=PD(I,JJM-1)
+          SHTM=HTM(I,KTE,JJM-2)+HTM(I+1,KTE,JJM-2)+HTM(I,KTE,JJM)       &
+     &                                          +HTM(I+1,KTE,JJM)
+          PD(I,JJM-1)=(PD(I,JJM-2)*HTM(I,KTE,JJM-2)                     &
+     &                +PD(I+1,JJM-2)*HTM(I+1,KTE,JJM-2)                 &
+     &                +PD(I,JJM)*HTM(I,KTE,JJM)                         &
+     &                +PD(I+1,JJM)*HTM(I+1,KTE,JJM))/SHTM
+
+! test. 
+
+          IF(I<=IDE-1.AND.ABS(CWK-PD(I,JJM-1))>=300.)THEN
+            WRITE(0,*)'PSEUDO HYDROSTATIC IMBALANCE AT THE NORTHERN BOUNDARY AT',I,JJM-1,'GRID #',GRIDID
+            WRITE(0,*)'             ',CWK/100.
+            WRITE(0,*)PD(I,JJM)/100.,'               ',PD(I+1,JJM)/100.
+            WRITE(0,*)'             ',PD(I,JJM-1)/100.
+            WRITE(0,*)PD(I,JJM-2)/100.,'             ',PD(I+1,JJM-2)/100.
+            WRITE(0,*)
+          ENDIF
+
+        ENDDO
+      ENDIF
+!
+!***  ONE ROW EAST OF WESTERN BOUNDARY
+!
+      IF(W_BDY)THEN
+        DO J=4,JM-3,2
+!
+          IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1                              &
+     &            .AND.J<=MY_JE_GLB+JTPAD1)THEN
+            CWK=PD(1,J)
+            JJ=J
+            SHTM=HTM(1,KTE,JJ-1)+HTM(2,KTE,JJ-1)+HTM(1,KTE,JJ+1)        &
+     &                                          +HTM(2,KTE,JJ+1)
+            PD(1,JJ)=(PD(1,JJ-1)*HTM(1,KTE,JJ-1)                        &
+     &               +PD(2,JJ-1)*HTM(2,KTE,JJ-1)                        &
+     &               +PD(1,JJ+1)*HTM(1,KTE,JJ+1)                        &
+     &               +PD(2,JJ+1)*HTM(2,KTE,JJ+1))/SHTM
+
+! test.
+
+             IF(ABS(CWK-PD(1,JJ))>300.)THEN
+              WRITE(0,*)'PSEUDO HYDROSTATIC IMBALANCE AT THE WESTERN BOUNDARY AT',J,1,'GRID #',GRIDID
+              WRITE(0,*)'             ',CWK/100.
+              WRITE(0,*)PD(1,JJ+1)/100.,'               ',PD(2,JJ+1)/100.
+              WRITE(0,*)'             ',PD(1,JJ)/100.
+              WRITE(0,*)PD(1,JJ-1)/100,'               ',PD(2,JJ-1)/100.
+              WRITE(0,*)
+            ENDIF
+
+          ENDIF
+!
+        ENDDO
+      ENDIF
+!
+!***  ONE ROW WEST OF EASTERN BOUNDARY
+!
+      IF(E_BDY)THEN
+        DO J=4,JM-3,2
+!
+          IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1                              &
+     &            .AND.J<=MY_JE_GLB+JTPAD1)THEN
+            JJ=J
+            SHTM=HTM(IIM-1,KTE,JJ-1)+HTM(IIM,KTE,JJ-1)                  &
+     &          +HTM(IIM-1,KTE,JJ+1)+HTM(IIM,KTE,JJ+1)
+            PD(IIM-1,JJ)=(PD(IIM-1,JJ-1)*HTM(IIM-1,KTE,JJ-1)            &
+     &                   +PD(IIM,JJ-1)*HTM(IIM,KTE,JJ-1)                &
+     &                   +PD(IIM-1,JJ+1)*HTM(IIM-1,KTE,JJ+1)            &
+     &                   +PD(IIM,JJ+1)*HTM(IIM,KTE,JJ+1))/SHTM
+          ENDIF
+!
+        ENDDO
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,jj,k,rhtm)
+      DO 200 K=KTS,KTE
+!
+!-----------------------------------------------------------------------
+!
+!***  ONE ROW NORTH OF SOUTHERN BOUNDARY
+!
+      IF(S_BDY)THEN
+        DO I=MYIS,MYIE1
+          RHTM=1./(HTM(I,K,1)+HTM(I+1,K,1)+HTM(I,K,3)+HTM(I+1,K,3))
+          T(I,K,2)=(T(I,K,1)*HTM(I,K,1)+T(I+1,K,1)*HTM(I+1,K,1)         &
+     &             +T(I,K,3)*HTM(I,K,3)+T(I+1,K,3)*HTM(I+1,K,3))        &
+     &             *RHTM
+          Q(I,K,2)=(Q(I,K,1)*HTM(I,K,1)+Q(I+1,K,1)*HTM(I+1,K,1)         &
+     &             +Q(I,K,3)*HTM(I,K,3)+Q(I+1,K,3)*HTM(I+1,K,3))        &
+     &             *RHTM
+          Q2(I,K,2)=(Q2(I,K,1)*HTM(I,K,1)+Q2(I+1,K,1)*HTM(I+1,K,1)      &
+     &              +Q2(I,K,3)*HTM(I,K,3)+Q2(I+1,K,3)*HTM(I+1,K,3))     &
+     &              *RHTM
+          CWM(I,K,2)=(CWM(I,K,1)*HTM(I,K,1)+CWM(I+1,K,1)*HTM(I+1,K,1)   &
+     &               +CWM(I,K,3)*HTM(I,K,3)+CWM(I+1,K,3)*HTM(I+1,K,3))  &
+     &               *RHTM
+          PINT(I,K,2)=ETA1(K)*PDTOP+ETA2(K)*PD(I,2)*RES(I,2)+PT
+        ENDDO
+        DO I_M=1,N_MOIST
+          IF(I_M==P_QV)THEN
+            DO I=MYIS,MYIE1
+              MOIST(I,K,2,I_M)=Q(I,K,2)/(1.-Q(I,K,2))
+            ENDDO
+          ELSE
+            DO I=MYIS,MYIE1
+              MOIST(I,K,2,I_M)=(MOIST(I,K,1,I_M)*HTM(I,K,1)             &
+     &                         +MOIST(I+1,K,1,I_M)*HTM(I+1,K,1)         &
+     &                         +MOIST(I,K,3,I_M)*HTM(I,K,3)             &
+     &                         +MOIST(I+1,K,3,I_M)*HTM(I+1,K,3))        &
+     &                          *RHTM
+            ENDDO
+          ENDIF
+        ENDDO
+!
+        DO I_M=2,N_SCALAR
+          DO I=MYIS,MYIE1
+            SCALAR(I,K,2,I_M)=(SCALAR(I,K,1,I_M)*HTM(I,K,1)             &
+     &                        +SCALAR(I+1,K,1,I_M)*HTM(I+1,K,1)         &
+     &                        +SCALAR(I,K,3,I_M)*HTM(I,K,3)             &
+     &                        +SCALAR(I+1,K,3,I_M)*HTM(I+1,K,3))        &
+     &                         *RHTM
+          ENDDO
+        ENDDO
+!
+      ENDIF
+!
+!***  ONE ROW SOUTH OF NORTHERN BOUNDARY
+!
+      IF(N_BDY)THEN
+        DO I=MYIS,MYIE1
+          RHTM=1./(HTM(I,K,JJM-2)+HTM(I+1,K,JJM-2)                      &
+     &            +HTM(I,K,JJM)+HTM(I+1,K,JJM))
+          T(I,K,JJM-1)=(T(I,K,JJM-2)*HTM(I,K,JJM-2)                     &
+     &                 +T(I+1,K,JJM-2)*HTM(I+1,K,JJM-2)                 &
+     &                 +T(I,K,JJM)*HTM(I,K,JJM)                         &
+     &                 +T(I+1,K,JJM)*HTM(I+1,K,JJM))                    &
+     &                 *RHTM
+          Q(I,K,JJM-1)=(Q(I,K,JJM-2)*HTM(I,K,JJM-2)                     &
+     &                 +Q(I+1,K,JJM-2)*HTM(I+1,K,JJM-2)                 &
+     &                 +Q(I,K,JJM)*HTM(I,K,JJM)                         &
+     &                 +Q(I+1,K,JJM)*HTM(I+1,K,JJM))                    &
+     &                 *RHTM
+          Q2(I,K,JJM-1)=(Q2(I,K,JJM-2)*HTM(I,K,JJM-2)                   &
+     &                  +Q2(I+1,K,JJM-2)*HTM(I+1,K,JJM-2)               &
+     &                  +Q2(I,K,JJM)*HTM(I,K,JJM)                       &
+     &                  +Q2(I+1,K,JJM)*HTM(I+1,K,JJM))                  &
+     &                  *RHTM
+          CWM(I,K,JJM-1)=(CWM(I,K,JJM-2)*HTM(I,K,JJM-2)                 &
+     &                   +CWM(I+1,K,JJM-2)*HTM(I+1,K,JJM-2)             &
+     &                   +CWM(I,K,JJM)*HTM(I,K,JJM)                     &
+     &                   +CWM(I+1,K,JJM)*HTM(I+1,K,JJM))                &
+     &                   *RHTM
+          PINT(I,K,JJM-1)=ETA1(K)*PDTOP                                 &
+     &                   +ETA2(K)*PD(I,JJM-1)*RES(I,JJM-1)+PT
+        ENDDO
+        DO I_M=1,N_MOIST
+          IF(I_M==P_QV)THEN
+            DO I=MYIS,MYIE1
+              MOIST(I,K,JJM-1,I_M)=Q(I,K,JJM-1)/(1.-Q(I,K,JJM-1))
+            ENDDO
+          ELSE
+            DO I=MYIS,MYIE1
+              MOIST(I,K,JJM-1,I_M)=(MOIST(I,K,JJM-2,I_M)*HTM(I,K,JJM-2) &
+     &                             +MOIST(I+1,K,JJM-2,I_M)*HTM(I+1,K,JJM-2) &
+     &                             +MOIST(I,K,JJM,I_M)*HTM(I,K,JJM)     &
+     &                             +MOIST(I+1,K,JJM,I_M)*HTM(I+1,K,JJM)) &
+     &                              *RHTM
+            ENDDO
+
+          ENDIF
+        ENDDO
+!
+        DO I_M=2,N_SCALAR
+          DO I=MYIS,MYIE1
+            SCALAR(I,K,JJM-1,I_M)=(SCALAR(I,K,JJM-2,I_M)*HTM(I,K,JJM-2) &
+     &                            +SCALAR(I+1,K,JJM-2,I_m)*HTM(I+1,K,JJM-2) &
+     &                            +SCALAR(I,K,JJM,I_M)*HTM(I,K,JJM)     &
+     &                            +SCALAR(I+1,K,JJM,I_M)*HTM(I+1,K,JJM)) &
+     &                             *RHTM
+          ENDDO
+        ENDDO
+!
+      ENDIF
+!
+!***  ONE ROW EAST OF WESTERN BOUNDARY
+!
+      IF(W_BDY)THEN
+        DO J=4,JM-3,2
+!
+          IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1                              &
+     &            .AND.J<=MY_JE_GLB+JTPAD1)THEN
+            JJ=J
+            RHTM=1./(HTM(1,K,JJ-1)+HTM(2,K,JJ-1)                        &
+     &              +HTM(1,K,JJ+1)+HTM(2,K,JJ+1))
+            T(1,K,JJ)=(T(1,K,JJ-1)*HTM(1,K,JJ-1)                        &
+     &                +T(2,K,JJ-1)*HTM(2,K,JJ-1)                        &
+     &                +T(1,K,JJ+1)*HTM(1,K,JJ+1)                        &
+     &                +T(2,K,JJ+1)*HTM(2,K,JJ+1))                       &
+     &                *RHTM
+            Q(1,K,JJ)=(Q(1,K,JJ-1)*HTM(1,K,JJ-1)                        &
+     &                +Q(2,K,JJ-1)*HTM(2,K,JJ-1)                        &
+     &                +Q(1,K,JJ+1)*HTM(1,K,JJ+1)                        &
+     &                +Q(2,K,JJ+1)*HTM(2,K,JJ+1))                       &
+     &                *RHTM
+            Q2(1,K,JJ)=(Q2(1,K,JJ-1)*HTM(1,K,JJ-1)                      &
+     &                 +Q2(2,K,JJ-1)*HTM(2,K,JJ-1)                      &
+     &                 +Q2(1,K,JJ+1)*HTM(1,K,JJ+1)                      &
+     &                 +Q2(2,K,JJ+1)*HTM(2,K,JJ+1))                     &
+     &                 *RHTM
+            CWM(1,K,JJ)=(CWM(1,K,JJ-1)*HTM(1,K,JJ-1)                    &
+     &                  +CWM(2,K,JJ-1)*HTM(2,K,JJ-1)                    &
+     &                  +CWM(1,K,JJ+1)*HTM(1,K,JJ+1)                    &
+     &                  +CWM(2,K,JJ+1)*HTM(2,K,JJ+1))                   &
+     &                  *RHTM
+            PINT(1,K,JJ)=ETA1(K)*PDTOP                                  &
+     &                  +ETA2(K)*PD(1,JJ)*RES(1,JJ)+PT
+            DO I_M=1,N_MOIST
+              IF(I_M==P_QV)THEN
+                MOIST(1,K,JJ,I_M)=Q(1,K,JJ)/(1.-Q(1,K,JJ))     
+              ELSE  
+                MOIST(1,K,JJ,I_M)=(MOIST(1,K,JJ-1,I_M)*HTM(1,K,JJ-1)    &
+     &                            +MOIST(2,K,JJ-1,I_M)*HTM(2,K,JJ-1)    &
+     &                            +MOIST(1,K,JJ+1,I_M)*HTM(1,K,JJ+1)    &
+     &                            +MOIST(2,K,JJ+1,I_M)*HTM(2,K,JJ+1))   &
+     &                             *RHTM
+              ENDIF
+            ENDDO    
+!
+            DO I_M=2,N_SCALAR
+              SCALAR(1,K,JJ,I_M)=(SCALAR(1,K,JJ-1,I_M)*HTM(1,K,JJ-1)    &
+     &                           +SCALAR(2,K,JJ-1,I_M)*HTM(2,K,JJ-1)    &
+     &                           +SCALAR(1,K,JJ+1,I_M)*HTM(1,K,JJ+1)    &
+     &                           +SCALAR(2,K,JJ+1,I_M)*HTM(2,K,JJ+1))   &
+     &                            *RHTM
+            ENDDO
+!
+          ENDIF
+!
+        ENDDO
+!
+      ENDIF
+!
+!***  ONE ROW WEST OF EASTERN BOUNDARY
+!
+      IF(E_BDY)THEN
+        DO J=4,JM-3,2
+!
+          IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1                              &
+     &            .AND.J<=MY_JE_GLB+JTPAD1)THEN
+            JJ=J
+            RHTM=1./(HTM(IIM-1,K,JJ-1)+HTM(IIM,K,JJ-1)                  &
+     &              +HTM(IIM-1,K,JJ+1)+HTM(IIM,K,JJ+1))
+            T(IIM-1,K,JJ)=(T(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1)            &
+     &                    +T(IIM,K,JJ-1)*HTM(IIM,K,JJ-1)                &
+     &                    +T(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1)            &
+     &                    +T(IIM,K,JJ+1)*HTM(IIM,K,JJ+1))               &
+     &                    *RHTM
+            Q(IIM-1,K,JJ)=(Q(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1)            &
+     &                    +Q(IIM,K,JJ-1)*HTM(IIM,K,JJ-1)                &
+     &                    +Q(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1)            &
+     &                    +Q(IIM,K,JJ+1)*HTM(IIM,K,JJ+1))               &
+     &                    *RHTM
+            Q2(IIM-1,K,JJ)=(Q2(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1)          &
+     &                     +Q2(IIM,K,JJ-1)*HTM(IIM,K,JJ-1)              &
+     &                     +Q2(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1)          &
+     &                     +Q2(IIM,K,JJ+1)*HTM(IIM,K,JJ+1))             &
+     &                     *RHTM
+            CWM(IIM-1,K,JJ)=(CWM(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1)        &
+     &                      +CWM(IIM,K,JJ-1)*HTM(IIM,K,JJ-1)            &
+     &                      +CWM(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1)        &
+     &                      +CWM(IIM,K,JJ+1)*HTM(IIM,K,JJ+1))           &
+     &                      *RHTM
+            PINT(IIM-1,K,JJ)=ETA1(K)*PDTOP                              &
+     &                      +ETA2(K)*PD(IIM-1,JJ)*RES(IIM-1,JJ)+PT
+!
+            DO I_M=1,N_MOIST
+              IF(I_M==P_QV)THEN
+                MOIST(IIM-1,K,JJ,I_M)=Q(IIM-1,K,JJ)/(1.-Q(IIM-1,K,JJ))
+              ELSE
+                MOIST(IIM-1,K,JJ,I_M)=(MOIST(IIM-1,K,JJ-1,I_M)*HTM(IIM-1,K,JJ-1) &
+     &                                +MOIST(IIM,K,JJ-1,I_M)*HTM(IIM,K,JJ-1)     &
+     &                                +MOIST(IIM-1,K,JJ+1,I_M)*HTM(IIM-1,K,JJ+1) &
+     &                                +MOIST(IIM,K,JJ+1,I_M)*HTM(IIM,K,JJ+1))    &
+     &                                 *RHTM
+                ENDIF
+              ENDDO
+!
+              DO I_M=2,N_SCALAR
+                SCALAR(IIM-1,K,JJ,I_M)=(SCALAR(IIM-1,K,JJ-1,I_M)*HTM(IIM-1,K,JJ-1)  &
+     &                                 +SCALAR(IIM,K,JJ-1,I_M)*HTM(IIM,K,JJ-1)      &
+     &                                 +SCALAR(IIM-1,K,JJ+1,I_M)*HTM(IIM-1,K,JJ+1)  &
+     &                                 +SCALAR(IIM,K,JJ+1,I_M)*HTM(IIM,K,JJ+1))     &
+     &                                  *RHTM
+              ENDDO
+!
+          ENDIF
+!
+        ENDDO
+      ENDIF
+!-----------------------------------------------------------------------
+!
+  200 CONTINUE
+!
+!-----------------------------------------------------------------------
+      END SUBROUTINE BOCOH
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE BOCOV(GRIDID,NTSD,DT,LB,VTM,U_B,V_B,U_BT,V_BT          &  ! GRIDID ADDED BY GOPAL
+     &                ,U,V                                              &
+     &                ,IJDS,IJDE,SPEC_BDY_WIDTH                         &  ! min/max(id,jd)
+     &                ,IHE,IHW,IVE,IVW,INDX3_WRK                        &
+     &                ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &                ,IMS,IME,JMS,JME,KMS,KME                          &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    BOCOV       UPDATE WIND POINTS ON BOUNDARY
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 94-03-08
+!     
+! ABSTRACT:
+!     U AND V COMPONENTS OF THE WIND ARE UPDATED ON THE
+!     DOMAIN BOUNDARY BY APPLYING THE PRE-COMPUTED
+!     TENDENCIES AT EACH TIME STEP.  AN EXTRAPOLATION FROM
+!     INSIDE THE DOMAIN IS USED FOR THE COMPONENT TANGENTIAL
+!     TO THE BOUNDARY IF THE NORMAL COMPONENT IS OUTWARD.
+!     
+! PROGRAM HISTORY LOG:
+!   87-??-??  MESINGER   - ORIGINATOR
+!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
+!   01-03-13  BLACK      - CONVERTED TO WRF STRUCTURE
+!   02-09-06  WOLFE      - MORE CONVERSION TO GLOBAL INDEXING 
+!   04-11-23  BLACK      - THREADED
+!     
+! USAGE: CALL BOCOH FROM SUBROUTINE SOLVE_NMM
+!   INPUT ARGUMENT LIST:
+!
+!     NOTE THAT IDE AND JDE INSIDE ROUTINE SHOULD BE PASSED IN
+!     AS WHAT WRF CONSIDERS THE UNSTAGGERED GRID DIMENSIONS; THAT
+!     IS, 1 LESS THAN THE IDE AND JDE SET BY WRF FRAMEWORK, JM
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM 
+!$$$  
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+      INTEGER,INTENT(IN) :: IJDS,IJDE,SPEC_BDY_WIDTH
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!-----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! NMM_MAX_DIM is set in configure.wrf and must agree with
+! the value of dimspec q in the Registry/Registry
+!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-----------------------------------------------------------------------
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: GRIDID
+      INTEGER,INTENT(IN) :: LB,NTSD
+!
+      REAL,INTENT(IN) :: DT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: VTM
+!
+      REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4),INTENT(INOUT)  &
+     &                                         :: U_B,V_B,U_BT,V_BT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: U,V
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      INTEGER :: I,II,IIM,IM,J,JJ,JJM,JM,K,N
+      INTEGER :: MY_IS_GLB, MY_JS_GLB,MY_IE_GLB,MY_JE_GLB  
+      INTEGER :: IBDY,BF,JB,IB
+      INTEGER :: ILPAD1,IRPAD1,JBPAD1,JTPAD1
+      LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***  TIME INTERPOLATION OF U AND V AT THE OUTER BOUNDARY
+!-----------------------------------------------------------------------
+!
+      IM=IDE-IDS+1
+      JM=JDE-JDS+1
+      IIM=IM
+      JJM=JM
+!
+      W_BDY=(ITS==IDS)
+      E_BDY=(ITE==IDE)
+      S_BDY=(JTS==JDS)
+      N_BDY=(JTE==JDE)
+!
+      ILPAD1=1
+      IF(ITS==IDS)ILPAD1=0
+      IRPAD1=1
+      IF(ITE==IDE)ILPAD1=0
+      JBPAD1=1
+      IF(JTS==JDS)JBPAD1=0
+      JTPAD1=1
+      IF(JTE==JDE)JTPAD1=0
+!
+      MY_IS_GLB=ITS
+      MY_IE_GLB=ITE
+      MY_JS_GLB=JTS
+      MY_JE_GLB=JTE
+!
+!-----------------------------------------------------------------------
+!***  SOUTH AND NORTH BOUNDARIES
+!***  USE IBDY=1 FOR SOUTH; 2 FOR NORTH.
+!-----------------------------------------------------------------------
+!
+      DO IBDY=1,2  
+!
+!***  MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
+!
+        IF((S_BDY.AND.IBDY==1).OR.(N_BDY.AND.IBDY==2))THEN
+!
+          IF(IBDY==1)THEN 
+            BF=P_YSB     ! Which boundary (YSB=the boundary where Y is at its start)
+            JB=1         ! Which cell in from Boundary 
+            JJ=1         ! Which cell in the Domain
+          ELSE
+            BF=P_YEB     ! Which boundary (YEB=the boundary where Y is at its end)
+            JB=1         ! Which cell in from Boundary
+            JJ=JJM       ! Which cell in the Domain
+          ENDIF
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+          DO K=KTS,KTE
+            DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+              U_B(I,K,JB,BF)=U_B(I,K,JB,BF)+U_BT(I,K,JB,BF)*DT
+              V_B(I,K,JB,BF)=V_B(I,K,JB,BF)+V_BT(I,K,JB,BF)*DT
+              U(I,K,JJ)=U_B(I,K,JB,BF)
+              V(I,K,JJ)=V_B(I,K,JB,BF)
+            ENDDO
+          ENDDO
+!
+        ENDIF
+      ENDDO
+
+!
+!-----------------------------------------------------------------------
+!***  WEST AND EAST BOUNDARIES
+!***  USE IBDY=1 FOR WEST; 2 FOR EAST.
+!-----------------------------------------------------------------------
+!
+      DO IBDY=1,2    
+!
+!***  MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
+!
+        IF((W_BDY.AND.IBDY==1).OR.(E_BDY.AND.IBDY==2))THEN
+!
+          IF(IBDY==1)THEN 
+            BF=P_XSB     ! Which boundary (YSB=the boundary where Y is at its start)
+            IB=1         ! Which cell in from boundary
+            II=1         ! Which cell in the domain
+          ELSE
+            BF=P_XEB     ! Which boundary (YEB=the boundary where Y is at its end)
+            IB=1         ! Which cell in from boundary
+            II=IIM       ! Which cell in the domain
+          ENDIF
+!
+!$omp parallel do                                                       &
+!$omp& private(j,k)
+          DO K=KTS,KTE
+            DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1)
+              IF(MOD(J,2)==0)THEN
+                U_B(J,K,IB,BF)=U_B(J,K,IB,BF)+U_BT(J,K,IB,BF)*DT
+                V_B(J,K,IB,BF)=V_B(J,K,IB,BF)+V_BT(J,K,IB,BF)*DT
+                U(II,K,J)=U_B(J,K,IB,BF)
+                V(II,K,J)=V_B(J,K,IB,BF)
+              ENDIF
+            ENDDO
+          ENDDO
+!
+        ENDIF
+      ENDDO
+
+!
+!-----------------------------------------------------------------------
+!***  EXTRAPOLATION OF TANGENTIAL VELOCITY AT OUTFLOW POINTS
+!***  BASED ON SOME DISCUSSIONS WITH ZAVISA AND EXPERIMENTS
+!***  ON GRAVITY PULSE FOR NESTED DOMAIN.
+!-----------------------------------------------------------------------
+!
+      IF(GRIDID/=1)GO TO 201
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,jj,k)
+      DO 200 K=KTS,KTE
+!
+!-----------------------------------------------------------------------
+!
+!***  SOUTHERN BOUNDARY
+!
+      IF(S_BDY)THEN
+        DO I=MYIS1_P1,MYIE2_P1
+          IF(V(I,K,1)<0.)U(I,K,1)=(VTM(I,K,5)+1.)*U(I,K,3)              &
+     &                            -VTM(I,K,5)    *U(I,K,5)
+        ENDDO
+      ENDIF
+!
+!***  NORTHERN BOUNDARY
+!
+      IF(N_BDY)THEN
+        DO I=MYIS1_P1,MYIE2_P1
+          IF(V(I,K,JJM)>0.)                                             &
+     &        U(I,K,JJM)=(VTM(I,K,JJM-4)+1.)*U(I,K,JJM-2)               &
+     &                   -VTM(I,K,JJM-4)    *U(I,K,JJM-4)
+        ENDDO
+      ENDIF
+!
+!***  WESTERN BOUNDARY
+!
+      DO J=4,JM-3,2
+        IF(W_BDY)THEN
+!
+          IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1                              &
+     &            .AND.J<=MY_JE_GLB+JTPAD1)THEN
+            JJ=J
+            IF(U(1,K,JJ)<0.)                                            &
+     &          V(1,K,JJ)=(VTM(3,K,JJ)+1.)*V(2,K,JJ)                    &
+     &                    -VTM(3,K,JJ)    *V(3,K,JJ)
+          ENDIF
+!
+        ENDIF
+      ENDDO
+!
+!***  EASTERN BOUNDARY
+!
+      DO J=4,JM-3,2
+        IF(E_BDY)THEN
+!
+          IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1                              &
+     &            .AND.J<=MY_JE_GLB+JTPAD1)THEN
+            JJ=J
+            IF(U(IIM,K,JJ)>0.)                                          &
+     &          V(IIM,K,JJ)=(VTM(IIM-2,K,JJ)+1.)*V(IIM-1,K,JJ)          &
+     &                      -VTM(IIM-2,K,JJ)    *V(IIM-2,K,JJ)
+          ENDIF
+!
+        ENDIF
+      ENDDO
+!-----------------------------------------------------------------------
+!
+  200 CONTINUE
+
+  201 CONTINUE
+!
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***  SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,jj,k)
+      DO 300 K=KTS,KTE
+!
+!-----------------------------------------------------------------------
+!
+!***  SOUTHWEST CORNER
+!
+      IF(S_BDY.AND.W_BDY)THEN
+        U(2,K,2)=D06666*(4.*(U(1,K,1)+U(2,K,1)+U(2,K,3))                &
+     &                     + U(1,K,2)+U(1,K,4)+U(2,K,4))               
+        V(2,K,2)=D06666*(4.*(V(1,K,1)+V(2,K,1)+V(2,K,3))                &
+     &                      +V(1,K,2)+V(1,K,4)+V(2,K,4))
+      ENDIF
+!
+!***  SOUTHEAST CORNER
+!
+      IF(S_BDY.AND.E_BDY)THEN
+        U(IIM-1,K,2)=D06666*(4.*(U(IIM-2,K,1)+U(IIM-1,K,1)              &
+     &                          +U(IIM-2,K,3))                          &
+     &                          +U(IIM,K,2)+U(IIM,K,4)+U(IIM-1,K,4))
+        V(IIM-1,K,2)=D06666*(4.*(V(IIM-2,K,1)+V(IIM-1,K,1)              &
+     &                          +V(IIM-2,K,3))                          &
+     &                          +V(IIM,K,2)+V(IIM,K,4)+V(IIM-1,K,4))
+      ENDIF
+!
+!***  NORTHWEST CORNER
+!
+      IF(N_BDY.AND.W_BDY)THEN
+        U(2,K,JJM-1)=D06666*(4.*(U(1,K,JJM)+U(2,K,JJM)+U(2,K,JJM-2))    &
+     &                          +U(1,K,JJM-1)+U(1,K,JJM-3)              &
+     &                          +U(2,K,JJM-3))
+        V(2,K,JJM-1)=D06666*(4.*(V(1,K,JJM)+V(2,K,JJM)+V(2,K,JJM-2))    &
+     &                          +V(1,K,JJM-1)+V(1,K,JJM-3)              &
+     &                          +V(2,K,JJM-3))
+      ENDIF
+!
+!***  NORTHEAST CORNER
+!
+      IF(N_BDY.AND.E_BDY)THEN
+        U(IIM-1,K,JJM-1)=                                               &
+     &    D06666*(4.*(U(IIM-2,K,JJM)+U(IIM-1,K,JJM)+U(IIM-2,K,JJM-2))   &
+     &               +U(IIM,K,JJM-1)+U(IIM,K,JJM-3)+U(IIM-1,K,JJM-3))
+        V(IIM-1,K,JJM-1)=                                               &
+     &    D06666*(4.*(V(IIM-2,K,JJM)+V(IIM-1,K,JJM)+V(IIM-2,K,JJM-2))   &
+     &               +V(IIM,K,JJM-1)+V(IIM,K,JJM-3)+V(IIM-1,K,JJM-3))
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY
+!-----------------------------------------------------------------------
+!
+!***  ONE ROW NORTH OF SOUTHERN BOUNDARY
+!
+      IF(S_BDY)THEN
+        DO I=MYIS2,MYIE2
+          U(I,K,2)=(U(I-1,K,1)+U(I,K,1)+U(I-1,K,3)+U(I,K,3))*0.25
+          V(I,K,2)=(V(I-1,K,1)+V(I,K,1)+V(I-1,K,3)+V(I,K,3))*0.25
+        ENDDO
+      ENDIF
+!
+!***  ONE ROW SOUTH OF NORTHERN BOUNDARY
+!
+      IF(N_BDY)THEN
+        DO I=MYIS2,MYIE2
+          U(I,K,JJM-1)=(U(I-1,K,JJM-2)+U(I,K,JJM-2)                     &
+     &                 +U(I-1,K,JJM)+U(I,K,JJM))*0.25
+          V(I,K,JJM-1)=(V(I-1,K,JJM-2)+V(I,K,JJM-2)                     &
+     &                 +V(I-1,K,JJM)+V(I,K,JJM))*0.25
+        ENDDO
+      ENDIF
+!
+!***  ONE ROW EAST OF WESTERN BOUNDARY
+!
+      DO J=3,JM-2,2
+        IF(W_BDY)THEN
+          IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1                              &
+     &            .AND.J<=MY_JE_GLB+JTPAD1)THEN
+            JJ=J
+            U(1,K,JJ)=(U(1,K,JJ-1)+U(2,K,JJ-1)                          &
+     &                +U(1,K,JJ+1)+U(2,K,JJ+1))*0.25
+            V(1,K,JJ)=(V(1,K,JJ-1)+V(2,K,JJ-1)                          &
+     &                +V(1,K,JJ+1)+V(2,K,JJ+1))*0.25
+          ENDIF
+        ENDIF
+      ENDDO
+!
+!***  ONE ROW WEST OF EASTERN BOUNDARY
+!
+      IF(E_BDY)THEN
+        DO J=3,JM-2,2
+          IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1                              &
+     &            .AND.J<=MY_JE_GLB+JTPAD1)THEN
+            JJ=J
+            U(IIM-1,K,JJ)=0.25*(U(IIM-1,K,JJ-1)+U(IIM,K,JJ-1)           &
+     &                         +U(IIM-1,K,JJ+1)+U(IIM,K,JJ+1))
+            V(IIM-1,K,JJ)=0.25*(V(IIM-1,K,JJ-1)+V(IIM,K,JJ-1)           &
+     &                         +V(IIM-1,K,JJ+1)+V(IIM,K,JJ+1))
+          ENDIF
+        ENDDO
+      ENDIF
+!-----------------------------------------------------------------------
+!
+  300 CONTINUE
+!
+!-----------------------------------------------------------------------
+      END SUBROUTINE BOCOV
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+      END MODULE MODULE_BNDRY_COND
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_CLDWTR.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_CLDWTR.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_CLDWTR.F	(revision 2744)
@@ -0,0 +1,18 @@
+!
+      MODULE MODULE_CLDWTR
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!
+!***  GRID-SCALE CLOUD WATER
+!
+!jm      REAL,ALLOCATABLE,DIMENSION(:,:,:) :: CWM,F_ICE,F_RAIN,F_RIMEF
+!
+!jm      REAL,ALLOCATABLE,DIMENSION(:,:) :: SR,U00
+!jm      REAL,ALLOCATABLE,DIMENSION(:,:) :: CFRACH,CFRACL,CFRACM,CUPPT
+!
+!jm      INTEGER,ALLOCATABLE,DIMENSION(:,:) :: LC
+!jm      INTEGER,ALLOCATABLE,DIMENSION(:) :: UL
+!
+      LOGICAL MICRO_START
+!----------------------------------------------------------------------
+      END MODULE MODULE_CLDWTR
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_CTLBLK.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_CTLBLK.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_CTLBLK.F	(revision 2744)
@@ -0,0 +1,40 @@
+!
+      MODULE MODULE_CTLBLK
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!
+!***  FUNDAMENTAL DOMAIN VARIABLES
+!
+      INTEGER :: IM,JM,LM
+      INTEGER :: NROOT
+!----------------------------------------------------------------------
+!
+!***  SET SOME CONSTANTS
+!
+      INTEGER :: LIST=6            ! STANDARD OUT UNIT NUMBER
+      INTEGER,PARAMETER :: LSM=39  ! NUMBER OF OUTPUT PRESSURE LEVELS
+!----------------------------------------------------------------------
+!
+!***  SINGLE GLOBAL OR MULTIPLE LOCAL RESTART FILES
+!
+      LOGICAL :: SINGLRST
+!----------------------------------------------------------------------
+!
+!***  VARIOUS CONTROL VARIABLES
+!
+      LOGICAL :: RUN,FIRST,RESTRT,NEST
+!
+!JW   REAL :: DT,TLM0D,TPH0D,TSPH
+      REAL :: TLM0D,TPH0D,TSPH
+!
+      INTEGER :: IHRST,NFCST,NUNIT_NBC,IOUT                            &
+                ,NTSTM,NSTART,NTDDMP,NBOCO,NSHDE 
+!               ,NTSD,NTSTM,NSTART,NTDDMP,NPREC,NBOCO,NSHDE 
+!
+      INTEGER,DIMENSION(3) :: IDAT
+!
+      INTEGER,DIMENSION(99) :: ISHDE
+!
+      REAL,DIMENSION(LSM) :: SPL
+!----------------------------------------------------------------------
+      END MODULE MODULE_CTLBLK
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_DIFFUSION_NMM.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_DIFFUSION_NMM.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_DIFFUSION_NMM.F	(revision 2744)
@@ -0,0 +1,773 @@
+!-----------------------------------------------------------------------
+!
+!NCEP_MESO:MODEL_LAYER: HORIZONTAL DIFFUSION
+!
+!-----------------------------------------------------------------------
+!
+#include "nmm_loop_basemacros.h"
+#include "nmm_loop_macros.h"
+!
+!-----------------------------------------------------------------------
+!
+      MODULE MODULE_DIFFUSION_NMM
+!
+!-----------------------------------------------------------------------
+      USE MODULE_MODEL_CONSTANTS
+!-----------------------------------------------------------------------
+!
+      LOGICAL :: SECOND=.TRUE.
+      INTEGER :: KSMUD=1
+!
+!-----------------------------------------------------------------------
+!
+      CONTAINS
+!
+!***********************************************************************
+      SUBROUTINE HDIFF(NTSD,DT,FIS,DY,HDAC,HDACV                        &
+     &                ,HTM,HBM2,VTM,DETA1,SIGMA                         &
+     &                ,T,Q,U,V,Q2,Z,W,SM,SICE                           &
+     &                ,IHE,IHW,IVE,IVW,INDX3_WRK                        &
+     &                ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &                ,IMS,IME,JMS,JME,KMS,KME                          &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    HDIFF       HORIZONTAL DIFFUSION
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 93-11-17
+!     
+! ABSTRACT:
+!     HDIFF CALCULATES THE CONTRIBUTION OF THE HORIZONTAL DIFFUSION
+!     TO THE TENDENCIES OF TEMPERATURE, SPECIFIC HUMIDITY, WIND
+!     COMPONENTS, AND TURBULENT KINETIC ENERGY AND THEN UPDATES THOSE
+!     VARIABLES.  A SECOND-ORDER NONLINEAR SCHEME SIMILAR TO
+!     SMAGORINSKY'S IS USED WHERE THE DIFFUSION COEFFICIENT IS
+!     A FUNCTION OF THE DEFORMATION FIELD AND OF THE TURBULENT
+!     KINETIC ENERGY.
+!     
+! PROGRAM HISTORY LOG:
+!   87-06-??  JANJIC     - ORIGINATOR
+!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   96-03-28  BLACK      - ADDED EXTERNAL EDGE
+!   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
+!   02-02-07  BLACK      - CONVERTED TO WRF STRUCTURE
+!   02-08-29  MICHALAKES -
+!   02-09-06  WOLFE      -
+!   03-05-27  JANJIC     - ADDED SLOPE ADJUSTMENT
+!   04-11-18  BLACK      - THREADED
+!   06-08-15  JANJIC     - ENHANCEMENT AT SLOPING SEA COAST
+!     
+! USAGE: CALL HDIFF FROM SUBROUTINE SOLVE_RUNSTREAM
+!
+!   INPUT ARGUMENT LIST:
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      REAL,INTENT(IN) :: DT,DY
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2            &
+     &                                             ,HDAC,HDACV          &
+     &                                             ,SM,SICE
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM,Z,W
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: T,Q,Q2   &
+     &                                                        ,U,V
+!
+      INTEGER, DIMENSION(JMS:JME), INTENT(IN) :: IHE,IHW,IVE,IVW
+!
+!-----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-----------------------------------------------------------------------
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: SIGMA
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      LOGICAL :: CILINE,WATSLOP
+!
+      INTEGER :: I,J,J1_P1,J1_P2,J2_00,J2_M1,J2_P1,J3_00,J3_P1,J3_P2    &
+     &          ,J4_00,J4_M1,J4_M2,J4_P1,J4_P2,JJ,JKNT,JSTART,K,KS
+!
+      REAL :: DEF_J,DEFSK,DEFTK,HKNE_J,HKSE_J,Q2L,RDY,SLOP,SLOPHC       &
+     &       ,UTK,VKNE_J,VKSE_J,VTK,DEF1,DEF2,DEF3,DEF4
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: Q2L_IK,SNE,SSE
+!
+!***  TYPE 1 WORKING ARRAY (SEE PFDHT)
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:2) :: DEF
+!
+!***  TYPE 2 WORKING ARRAY (SEE PFDHT)
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:1) :: HKNE,QNE,Q2NE,TNE     &
+     &                                           ,UNE,VKNE,VNE
+!
+!***  TYPE 3 WORKING ARRAY (SEE PFDHT)
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:2) :: HKSE,QSE,Q2SE,TSE     &
+     &                                           ,USE,VKSE,VSE
+!
+!***  TYPE 4 WORKING ARRAY (SEE PFDHT)
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: CKE,QDIF,Q2DIF        &
+     &                                           ,TDIF,UDIF,VDIF
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      JSTART=MYJS2
+!-----------------------------------------------------------------------
+!
+      SLOPHC=SLOPHT*SQRT(2.)*0.5
+      RDY=1./DY
+!
+!-----------------------------------------------------------------------
+!***
+!***  DIFFUSING Q2 AT GROUND LEVEL DOES NOT MATTER
+!***  BECAUSE USTAR2 IS RECALCULATED
+!***
+!-----------------------------------------------------------------------
+!***  MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
+!***  FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
+!***  IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J.
+!-----------------------------------------------------------------------
+!
+      DO J=-2,2
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        DEF(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=-2,1
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        TNE(I,K,J)=0.
+        QNE(I,K,J)=0.
+        Q2NE(I,K,J)=0.
+        HKNE(I,K,J)=0.
+        UNE(I,K,J)=0.
+        VNE(I,K,J)=0.
+        VKNE(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=-1,2
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        TSE(I,K,J)=0.
+        QSE(I,K,J)=0.
+        Q2SE(I,K,J)=0.
+        HKSE(I,K,J)=0.
+        USE(I,K,J)=0.
+        VSE(I,K,J)=0.
+        VKSE(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(def_j,def1,def2,def3,def4,defsk,deftk,i,j,jj,k,q2l)
+      DO J=-2,1
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+
+        DO I=MYIS_P1,MYIE_P1
+          DEFTK=U(I+IHE(JJ),K,JJ)-U(I+IHW(JJ),K,JJ)                     &
+     &         -V(I,K,JJ+1)+V(I,K,JJ-1)
+          DEFSK=U(I,K,JJ+1)-U(I,K,JJ-1)                                 &
+     &         +V(I+IHE(JJ),K,JJ)-V(I+IHW(JJ),K,JJ)
+          Q2L=MAX(Q2(I,K,JJ),EPSQ2)
+          IF(Q2L<=EPSQ2)Q2L=0.
+!
+          DEF1=W(I+IHW(JJ),K,JJ-1)-W(I,K,JJ)
+          DEF2=W(I+IHE(JJ),K,JJ-1)-W(I,K,JJ)
+          DEF3=W(I+IHW(JJ),K,JJ+1)-W(I,K,JJ)
+          DEF4=W(I+IHE(JJ),K,JJ+1)-W(I,K,JJ)
+!
+          DEF_J=DEFTK*DEFTK+DEFSK*DEFSK+DEF1*DEF1+DEF2*DEF2+            &
+     &          DEF3*DEF3+DEF4*DEF4+SCQ2*Q2L
+          DEF_J=SQRT(DEF_J+DEF_J)*HBM2(I,JJ)
+          DEF_J=MAX(DEF_J,DEFC)
+          DEF_J=MIN(DEF_J,DEFM)
+          DEF_J=DEF_J*0.1
+          DEF(I,K,J)=DEF_J
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(hkne_j,i,j,jj,k,slop,sne,vkne_j)
+      DO J=-2,0
+        JJ=JSTART+J
+!
+!-----------------------------------------------------------------------
+!***  SLOPE SWITCHES FOR MOISTURE
+!-----------------------------------------------------------------------
+!
+        IF(SIGMA==1)THEN
+          DO K=KTS,KTE
+!
+!-----------------------------------------------------------------------
+!***  PRESSURE DOMAIN
+!-----------------------------------------------------------------------
+!
+            IF(DETA1(K)>0.)THEN
+              DO I=MYIS_P1,MYIE1_P1
+                SNE(I,K)=1.
+              ENDDO
+!
+!-----------------------------------------------------------------------
+!***  SIGMA DOMAIN
+!-----------------------------------------------------------------------
+!
+            ELSE
+              DO I=MYIS_P1,MYIE1_P1
+                SLOP=ABS((Z(I+IHE(JJ),K,JJ+1)-Z(I,K,JJ))*RDY)
+!
+                CILINE=((SM(I+IHE(JJ),JJ+1)/=SM(I,JJ)) .OR.             &
+                        (SICE(I+IHE(JJ),JJ+1)/=SICE(I,JJ)))
+!
+                WATSLOP=(SM(I+IHE(JJ),JJ+1)==1.0 .AND.                  &
+                         SM(I,JJ)==1.0 .AND. SLOP/=0.)
+!
+                IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
+                  SNE(I,K)=1.
+                ELSE
+                  SNE(I,K)=0.
+                ENDIF
+!
+              ENDDO
+            ENDIF
+!
+          ENDDO
+        ENDIF
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P1,MYIE1_P1
+          HKNE_J=(DEF(I,K,J)+DEF(I+IHE(JJ),K,J+1))                      &
+     &           *HTM(I,K,JJ)*HTM(I+IHE(JJ),K,JJ+1)*SNE(I,K)
+          TNE (I,K,J)=(T (I+IHE(JJ),K,JJ+1)-T (I,K,JJ))*HKNE_J
+          QNE (I,K,J)=(Q (I+IHE(JJ),K,JJ+1)-Q (I,K,JJ))*HKNE_J
+          Q2NE(I,K,J)=(Q2(I+IHE(JJ),K,JJ+1)-Q2(I,K,JJ))*HKNE_J
+          HKNE(I,K,J)=HKNE_J
+!
+          VKNE_J=(DEF(I+IVE(JJ),K,J)+DEF(I,K,J+1))                      &
+     &           *VTM(I,K,JJ)*VTM(I+IVE(JJ),K,JJ+1)
+          UNE(I,K,J)=(U(I+IVE(JJ),K,JJ+1)-U(I,K,JJ))*VKNE_J
+          VNE(I,K,J)=(V(I+IVE(JJ),K,JJ+1)-V(I,K,JJ))*VKNE_J
+          VKNE(I,K,J)=VKNE_J
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(hkse_j,i,j,jj,k,slop,sse,vkse_j)
+      DO J=-1,1
+        JJ=JSTART+J
+!
+!-----------------------------------------------------------------------
+!***  SLOPE SWITCHES FOR MOISTURE
+!-----------------------------------------------------------------------
+!
+        IF(SIGMA==1)THEN
+          DO K=KTS,KTE
+!
+!-----------------------------------------------------------------------
+!***  PRESSURE DOMAIN
+!-----------------------------------------------------------------------
+!
+            IF(DETA1(K)>0.)THEN
+              DO I=MYIS_P1,MYIE1_P1
+                SSE(I,K)=1.
+              ENDDO
+!
+!-----------------------------------------------------------------------
+!***  SIGMA DOMAIN
+!-----------------------------------------------------------------------
+!
+            ELSE
+              DO I=MYIS_P1,MYIE1_P1
+                SLOP=ABS((Z(I+IHE(JJ),K,JJ-1)-Z(I,K,JJ))*RDY)
+!
+                CILINE=((SM(I+IHE(JJ),JJ-1)/=SM(I,JJ)) .OR.             &
+                        (SICE(I+IHE(JJ),JJ-1)/=SICE(I,JJ)))
+!
+                WATSLOP=(SM(I+IHE(JJ),JJ-1)==1.0 .AND.                  &
+                         SM(I,JJ)==1.0 .AND. SLOP/=0.) 
+!
+                IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
+                  SSE(I,K)=1.
+                ELSE
+                  SSE(I,K)=0.
+                ENDIF
+              ENDDO
+!
+            ENDIF
+!
+          ENDDO
+        ENDIF
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P1,MYIE1_P1
+          HKSE_J=(DEF(I+IHE(JJ),K,J-1)+DEF(I,K,J))                      &
+     &           *HTM(I+IHE(JJ),K,JJ-1)*HTM(I,K,JJ)*SSE(I,K)
+          TSE (I,K,J)=(T (I+IHE(JJ),K,JJ-1)-T (I,K,JJ))*HKSE_J
+          QSE (I,K,J)=(Q (I+IHE(JJ),K,JJ-1)-Q (I,K,JJ))*HKSE_J
+          Q2SE(I,K,J)=(Q2(I+IHE(JJ),K,JJ-1)-Q2(I,K,JJ))*HKSE_J
+          HKSE(I,K,J)=HKSE_J
+!
+          VKSE_J=(DEF(I,K,J-1)+DEF(I+IVE(JJ),K,J))                      &
+     &           *VTM(I+IVE(JJ),K,JJ-1)*VTM(I,K,JJ)
+          USE(I,K,J)=(U(I+IVE(JJ),K,JJ-1)-U(I,K,JJ))*VKSE_J
+          VSE(I,K,J)=(V(I+IVE(JJ),K,JJ-1)-V(I,K,JJ))*VKSE_J
+          VKSE(I,K,J)=VKSE_J
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,jj,k)
+      DO J=-1,0
+        JJ=JSTART+J
+!
+        DO K=KTS,KTE
+        DO I=MYIS1_P1,MYIE1
+          TDIF (I,K,J)=(TNE (I,K,J)-TNE (I+IHW(JJ),K,J-1)               &
+     &                 +TSE (I,K,J)-TSE (I+IHW(JJ),K,J+1))              &
+     &                 *HDAC(I,JJ)
+          QDIF (I,K,J)=(QNE (I,K,J)-QNE (I+IHW(JJ),K,J-1)               &
+     &                 +QSE (I,K,J)-QSE (I+IHW(JJ),K,J+1))              &
+     &                 *HDAC(I,JJ)*FCDIF
+          Q2DIF(I,K,J)=(Q2NE(I,K,J)-Q2NE(I+IHW(JJ),K,J-1)               &
+     &                 +Q2SE(I,K,J)-Q2SE(I+IHW(JJ),K,J+1))              &
+     &                 *HDAC(I,JJ)
+!
+          UDIF (I,K,J)=(UNE (I,K,J)-UNE (I+IVW(JJ),K,J-1)               &
+     &                 +USE (I,K,J)-USE (I+IVW(JJ),K,J+1))              &
+     &                 *HDACV(I,JJ)
+          VDIF (I,K,J)=(VNE (I,K,J)-VNE (I+IVW(JJ),K,J-1)               &
+     &                 +VSE (I,K,J)-VSE (I+IVW(JJ),K,J+1))              &
+     &                 *HDACV(I,JJ)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  ITERATION LOOP
+!-----------------------------------------------------------------------
+!
+      DO 600 KS=1,KSMUD
+	
+!
+      JKNT=0
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  MAIN VERTICAL INTEGRATION LOOP
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      main_integration : DO J=MYJS2,MYJE2
+!-----------------------------------------------------------------------
+!
+!***
+!***  SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
+!***                                           AND DIAGRAMS IN PFDHT)
+!***
+!***  J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
+!***  LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
+!***  NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
+!***  THE CURRENT VALUE OF THE main_integration LOOP.
+!***  (P2 denotes +2, etc.)
+!***
+      JKNT=JKNT+1
+!
+      J1_P2=INDX3_WRK(2,JKNT,1)
+      J1_P1=INDX3_WRK(1,JKNT,1)
+!
+      J2_P1=INDX3_WRK(1,JKNT,2)
+      J2_00=INDX3_WRK(0,JKNT,2)
+      J2_M1=INDX3_WRK(-1,JKNT,2)
+!
+      J3_P2=INDX3_WRK(2,JKNT,3)
+      J3_P1=INDX3_WRK(1,JKNT,3)
+      J3_00=INDX3_WRK(0,JKNT,3)
+!
+      J4_P2=INDX3_WRK(2,JKNT,4)
+      J4_P1=INDX3_WRK(1,JKNT,4)
+      J4_00=INDX3_WRK(0,JKNT,4)
+      J4_M1=INDX3_WRK(-1,JKNT,4)
+!
+!-----------------------------------------------------------------------
+!***  SLOPE SWITCHES FOR MOISTURE
+!-----------------------------------------------------------------------
+      IF(SIGMA==1)THEN
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k,slop)
+        DO K=KTS,KTE
+!
+!-----------------------------------------------------------------------
+!***  PRESSURE DOMAIN
+!-----------------------------------------------------------------------
+!
+          IF(DETA1(K)>0.)THEN
+            DO I=MYIS_P1,MYIE1_P1
+              SNE(I,K)=1.
+              SSE(I,K)=1.
+            ENDDO
+!
+!-----------------------------------------------------------------------
+!***  SIGMA DOMAIN
+!-----------------------------------------------------------------------
+!
+          ELSE
+            DO I=MYIS_P1,MYIE1_P1
+              SLOP=ABS((Z(I+IHE(J+1),K,J+2)-Z(I,K,J+1))*RDY)
+!
+              CILINE=((SM(I+IHE(J+1),J+2)/=SM(I,J+1)) .OR.              &
+                      (SICE(I+IHE(J+1),J+2)/=SICE(I,J+1)))
+!
+              WATSLOP=(SM(I+IHE(J+1),J+2)==1.0 .AND.                    &
+                       SM(I,J+1)==1.0 .AND. SLOP/=0.)
+!
+              IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
+                SNE(I,K)=1.
+              ELSE
+                SNE(I,K)=0.
+              ENDIF
+!
+              SLOP=ABS((Z(I+IHE(J+2),K,J+1)-Z(I,K,J+2))*RDY)
+!
+              CILINE=((SM(I+IHE(J+2),J+1)/=SM(I,J+2)) .OR.              &
+                      (SICE(I+IHE(J+2),J+1)/=SICE(I,J+2)))
+!
+              WATSLOP=(SM(I+IHE(J+2),J+1)==1.0 .AND.                    &
+                       SM(I,J+2)==1.0 .AND. SLOP/=0.)
+
+              IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
+                SSE(I,K)=1.
+              ELSE
+                SSE(I,K)=0.
+              ENDIF
+            ENDDO
+          ENDIF
+!
+        ENDDO
+      ENDIF
+!-----------------------------------------------------------------------
+!***  DEFORMATIONS
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k,q2l)
+      DO K=KTS,KTE
+      DO I=MYIS_P1,MYIE_P1
+        Q2L=Q2(I,K,J+2)
+        IF(Q2L<=EPSQ2)Q2L=0.
+        Q2L_IK(I,K)=Q2L
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(def_j,def1,def2,def3,def4,defsk,deftk,i,k,q2l)
+      DO K=KTS,KTE
+      DO I=MYIS_P1,MYIE_P1
+!
+        DEFTK=U(I+IHE(J+2),K,J+2)-U(I+IHW(J+2),K,J+2)                   &
+     &       -V(I,K,J+3)+V(I,K,J+1)
+        DEFSK=U(I,K,J+3)-U(I,K,J+1)                                     &
+     &       +V(I+IHE(J+2),K,J+2)-V(I+IHW(J+2),K,J+2)
+        DEF1=W(I+IHW(J+2),K,J+1)-W(I,K,J+2)
+        DEF2=W(I+IHE(J+2),K,J+1)-W(I,K,J+2)
+        DEF3=W(I+IHW(J+2),K,J+3)-W(I,K,J+2)
+        DEF4=W(I+IHE(J+2),K,J+3)-W(I,K,J+2)
+        DEF_J=DEFTK*DEFTK+DEFSK*DEFSK+DEF1*DEF1+DEF2*DEF2               & 
+     &       +DEF3*DEF3+DEF4*DEF4+SCQ2*Q2L_IK(I,K)
+        DEF_J=SQRT(DEF_J+DEF_J)*HBM2(I,J+2)
+        DEF_J=MAX(DEF_J,DEFC)
+        DEF_J=MIN(DEF_J,DEFM)
+        DEF_J=DEF_J*0.1
+        DEF(I,K,J1_P2)=DEF_J
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  DIAGONAL CONTRIBUTIONS
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(hkne_j,hkse_j,i,k,vkne_j,vkse_j)
+      DO K=KTS,KTE
+      DO I=MYIS_P1,MYIE1_P1
+        HKNE_J=(DEF(I,K,J1_P1)+DEF(I+IHE(J+1),K,J1_P2))                 &
+     &         *HTM(I,K,J+1)*HTM(I+IHE(J+1),K,J+2)*SNE(I,K)
+        TNE (I,K,J2_P1)=(T (I+IHE(J+1),K,J+2)-T (I,K,J+1))*HKNE_J
+        QNE (I,K,J2_P1)=(Q (I+IHE(J+1),K,J+2)-Q (I,K,J+1))*HKNE_J
+        Q2NE(I,K,J2_P1)=(Q2(I+IHE(J+1),K,J+2)-Q2(I,K,J+1))*HKNE_J
+        HKNE(I,K,J2_P1)=HKNE_J
+!
+        VKNE_J=(DEF(I+IVE(J+1),K,J1_P1)+DEF(I,K,J1_P2))                 &
+     &         *VTM(I,K,J+1)*VTM(I+IVE(J+1),K,J+2)
+        UNE(I,K,J2_P1)=(U(I+IVE(J+1),K,J+2)-U(I,K,J+1))*VKNE_J
+        VNE(I,K,J2_P1)=(V(I+IVE(J+1),K,J+2)-V(I,K,J+1))*VKNE_J
+        VKNE(I,K,J2_P1)=VKNE_J
+!
+        HKSE_J=(DEF(I+IHE(J+2),K,J1_P1)+DEF(I,K,J1_P2))                 &
+     &         *HTM(I+IHE(J+2),K,J+1)*HTM(I,K,J+2)*SSE(I,K)
+        TSE (I,K,J3_P2)=(T (I+IHE(J+2),K,J+1)-T (I,K,J+2))*HKSE_J
+        QSE (I,K,J3_P2)=(Q (I+IHE(J+2),K,J+1)-Q (I,K,J+2))*HKSE_J
+        Q2SE(I,K,J3_P2)=(Q2(I+IHE(J+2),K,J+1)-Q2(I,K,J+2))*HKSE_J
+        HKSE(I,K,J3_P2)=HKSE_J
+!
+        VKSE_J=(DEF(I,K,J1_P1)+DEF(I+IVE(J+2),K,J1_P2))                 &
+     &         *VTM(I+IVE(J+2),K,J+1)*VTM(I,K,J+2)
+        USE (I,K,J3_P2)=(U (I+IVE(J+2),K,J+1)-U (I,K,J+2))*VKSE_J
+        VSE (I,K,J3_P2)=(V (I+IVE(J+2),K,J+1)-V (I,K,J+2))*VKSE_J
+        VKSE(I,K,J3_P2)=VKSE_J
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+      DO K=KTS,KTE
+      DO I=MYIS_P1,MYIE
+        TDIF (I,K,J4_P1)=(TNE (I,K,J2_P1)-TNE (I+IHW(J+1),K,J2_00)      &
+     &                   +TSE (I,K,J3_P1)-TSE (I+IHW(J+1),K,J3_P2))     &
+     &                   *HDAC(I,J+1)
+        QDIF (I,K,J4_P1)=(QNE (I,K,J2_P1)-QNE (I+IHW(J+1),K,J2_00)      &
+     &                   +QSE (I,K,J3_P1)-QSE (I+IHW(J+1),K,J3_P2))     &
+     &                   *HDAC(I,J+1)*FCDIF
+        Q2DIF(I,K,J4_P1)=(Q2NE(I,K,J2_P1)-Q2NE(I+IHW(J+1),K,J2_00)      &
+     &                   +Q2SE(I,K,J3_P1)-Q2SE(I+IHW(J+1),K,J3_P2))     &
+     &                   *HDAC(I,J+1)
+!
+        UDIF (I,K,J4_P1)=(UNE (I,K,J2_P1)-UNE (I+IVW(J+1),K,J2_00)      &
+     &                   +USE (I,K,J3_P1)-USE (I+IVW(J+1),K,J3_P2))     &
+     &                   *HDACV(I,J+1)
+        VDIF (I,K,J4_P1)=(VNE (I,K,J2_P1)-VNE (I+IVW(J+1),K,J2_00)      &
+     &                   +VSE (I,K,J3_P1)-VSE (I+IVW(J+1),K,J3_P2))     &
+     &                   *HDACV(I,J+1)
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  2ND ORDER DIFFUSION
+!-----------------------------------------------------------------------
+!
+      IF(SECOND)THEN
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS1,MYIE1
+          T(I,K,J)=T(I,K,J)+TDIF(I,K,J4_00)
+          Q(I,K,J)=Q(I,K,J)+QDIF(I,K,J4_00)
+!
+          U(I,K,J)=U(I,K,J)+UDIF(I,K,J4_00)
+          V(I,K,J)=V(I,K,J)+VDIF(I,K,J4_00)
+        ENDDO
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS+1,KTE
+        DO I=MYIS1,MYIE1
+          Q2(I,K,J)=Q2(I,K,J)+Q2DIF(I,K,J4_00)*HTM(I,K-1,J)
+        ENDDO
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  4TH ORDER DIAGONAL CONTRIBUTIONS
+!-----------------------------------------------------------------------
+!
+      ELSE
+!
+!$omp parallel do                                                       &
+!$omp& private(hkne_j,hkse_j,i,k,vkne_j,vkse_j)
+        DO K=KTS,KTE
+        DO I=MYIS_P1,MYIE1
+          HKNE_J=HKNE(I,K,J2_00)
+          TNE (I,K,J2_00)=(TDIF (I+IHE(J),K,J4_P1)-TDIF (I,K,J4_00))    &
+     &                    *HKNE_J
+          QNE (I,K,J2_00)=(QDIF (I+IHE(J),K,J4_P1)-QDIF (I,K,J4_00))    &
+     &                    *HKNE_J
+          Q2NE(I,K,J2_00)=(Q2DIF(I+IHE(J),K,J4_P1)-Q2DIF(I,K,J4_00))    &
+     &                    *HKNE_J
+!
+          VKNE_J=VKNE(I,K,J2_00)
+          UNE (I,K,J2_00)=(UDIF (I+IVE(J),K,J4_P1)-UDIF (I,K,J4_00))    &
+     &                    *VKNE_J
+          VNE (I,K,J2_00)=(VDIF (I+IVE(J),K,J4_P1)-VDIF (I,K,J4_00))    &
+     &                    *VKNE_J
+!
+          HKSE_J=HKSE(I,K,J3_P1)
+          TSE (I,K,J3_P1)=(TDIF (I+IHE(J+1),K,J4_00)                    &
+     &                    -TDIF (I         ,K,J4_P1))*HKSE_J
+          QSE (I,K,J3_P1)=(QDIF (I+IHE(J+1),K,J4_00)                    &
+     &                    -QDIF (I         ,K,J4_P1))*HKSE_J
+          Q2SE(I,K,J3_P1)=(Q2DIF(I+IHE(J+1),K,J4_00)                    &
+     &                    -Q2DIF(I         ,K,J4_P1))*HKSE_J
+
+!
+          VKSE_J=VKSE(I,K,J3_P1)
+          USE (I,K,J3_P1)=(UDIF (I+IVE(J+1),K,J4_00)                    &
+     &                    -UDIF (I         ,K,J4_P1))*VKSE_J
+          VSE (I,K,J3_P1)=(VDIF (I+IVE(J+1),K,J4_00)                    &
+     &                    -VDIF (I         ,K,J4_P1))*VKSE_J
+        ENDDO
+        ENDDO
+!
+        IF(J==MYJS2)THEN
+!$omp parallel do                                                       &
+!$omp& private(hkne_j,hkse_j,i,k,vkne_j,vkse_j)
+          DO K=KTS,KTE
+          DO I=MYIS_P1,MYIE1
+            HKNE_J=HKNE(I,K,J2_M1)
+            TNE (I,K,J2_M1)=(TDIF (I+IHE(J-1),K,J4_00)                  &
+     &                      -TDIF (I         ,K,J4_M1))*HKNE_J
+            QNE (I,K,J2_M1)=(QDIF (I+IHE(J-1),K,J4_00)                  &
+     &                      -QDIF (I         ,K,J4_M1))*HKNE_J
+            Q2NE(I,K,J2_M1)=(Q2DIF(I+IHE(J-1),K,J4_00)                  &
+     &                      -Q2DIF(I         ,K,J4_M1))*HKNE_J
+!
+            VKNE_J=VKNE(I,K,J2_M1)
+            UNE (I,K,J2_M1)=(UDIF (I+IVE(J-1),K,J4_00)                  &
+     &                      -UDIF (I         ,K,J4_M1))*VKNE_J
+            VNE (I,K,J2_M1)=(VDIF (I+IVE(J-1),K,J4_00)                  &
+     &                      -VDIF (I         ,K,J4_M1))*VKNE_J
+!
+            HKSE_J=HKSE(I,K,J3_00)
+            TSE (I,K,J3_00)=(TDIF (I+IHE(J),K,J4_M1)                    &
+     &                      -TDIF (I       ,K,J4_00))*HKSE_J
+            QSE (I,K,J3_00)=(QDIF (I+IHE(J),K,J4_M1)                    &
+     &                      -QDIF (I       ,K,J4_00))*HKSE_J
+            Q2SE(I,K,J3_00)=(Q2DIF(I+IHE(J),K,J4_M1)                    &
+     &                      -Q2DIF(I       ,K,J4_00))*HKSE_J
+
+!
+            VKSE_J=VKSE(I,K,J3_00)
+            USE (I,K,J3_00)=(UDIF (I+IVE(J),K,J4_M1)                    &
+     &                      -UDIF (I       ,K,J4_00))*VKSE_J
+            VSE (I,K,J3_00)=(VDIF (I+IVE(J),K,J4_M1)                    &
+     &                      -VDIF (I       ,K,J4_00))*VKSE_J
+          ENDDO
+          ENDDO
+        ENDIF
+!
+        IF(J==MYJE2)THEN
+!
+          DO K=KTS,KTE
+          DO I=MYIS_P1,MYIE1
+            TNE (I,K,J2_P1)=0.
+            QNE (I,K,J2_P1)=0.
+            Q2NE(I,K,J2_P1)=0.
+            UNE (I,K,J2_P1)=0.
+            VNE (I,K,J2_P1)=0.
+          ENDDO
+          ENDDO
+!
+        ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k,utk,vtk)
+        DO K=KTS,KTE
+        DO I=MYIS1,MYIE1
+          T(I,K,J)=T(I,K,J)-(TNE (I,K,J2_00)-TNE (I+IHW(J),K,J2_M1)     &
+     &                      +TSE (I,K,J3_00)-TSE (I+IHW(J),K,J3_P1))    &
+     &                      *HDAC(I,J)
+          Q(I,K,J)=Q(I,K,J)-(QNE (I,K,J2_00)-QNE (I+IHW(J),K,J2_M1)     &
+     &                      +QSE (I,K,J3_00)-QSE (I+IHW(J),K,J3_P1))    &
+     &                      *HDAC(I,J)*FCDIF
+!
+          UTK=U(I,K,J)
+          VTK=V(I,K,J)
+          U(I,K,J)=U(I,K,J)-(UNE (I,K,J2_00)-UNE (I+IVW(J),K,J2_M1)     &
+     &                      +USE (I,K,J3_00)-USE (I+IVW(J),K,J3_P1))    &
+     &                      *HDACV(I,J)
+          V(I,K,J)=V(I,K,J)-(VNE (I,K,J2_00)-VNE (I+IVW(J),K,J2_M1)     &
+     &                      +VSE (I,K,J3_00)-VSE (I+IVW(J),K,J3_P1))    &
+     &                      *HDACV(I,J)
+          CKE(I,K,J4_00)=0.5*(U(I,K,J)*U(I,K,J)-UTK*UTK                 &
+     &                       +V(I,K,J)*V(I,K,J)-VTK*VTK)
+        ENDDO
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE-1
+        DO I=MYIS1,MYIE1
+          Q2(I,K,J)=Q2(I,K,J)-(Q2NE(I,K,J2_00)-Q2NE(I+IHW(J),K,J2_M1)   &
+     &                        +Q2SE(I,K,J3_00)-Q2SE(I+IHW(J),K,J3_P1))  &
+     &                        *HDAC(I,J)*HTM(I,K+1,J)
+        ENDDO
+        ENDDO
+!
+!-----------------------------------------------------------------------
+      ENDIF  ! End 4th order diffusion
+!-----------------------------------------------------------------------
+!
+      ENDDO main_integration
+!
+!-----------------------------------------------------------------------
+!
+  600 CONTINUE
+!
+!-----------------------------------------------------------------------
+      END SUBROUTINE HDIFF
+!-----------------------------------------------------------------------
+      END MODULE MODULE_DIFFUSION_NMM
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_IGWAVE_ADJUST.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_IGWAVE_ADJUST.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_IGWAVE_ADJUST.F	(revision 2744)
@@ -0,0 +1,1417 @@
+!-----------------------------------------------------------------------
+!
+!NCEP_MESO:MODEL_LAYER: INERTIAL GRAVITY WAVE ADJUSTMENT
+!
+!-----------------------------------------------------------------------
+#include "nmm_loop_basemacros.h"
+#include "nmm_loop_macros.h"
+#define  DATA_CALLS_INCLUDED
+!-----------------------------------------------------------------------
+!
+      MODULE MODULE_IGWAVE_ADJUST
+!
+!-----------------------------------------------------------------------
+      USE MODULE_MODEL_CONSTANTS
+!     USE MODULE_TIMERS  ! this one creates a name conflict at compile time
+!-----------------------------------------------------------------------
+!***
+!***  SPECIFY THE NUMBER OF TIMES TO SMOOTH THE VERTICAL VELOCITY
+!***  AND THE NUMBER OF ROWS FROM THE NORTHERN AND SOUTHERN EDGES
+!***  OF THE GLOBAL DOMAIN BEYOND WHICH THE SMOOTHING DOES NOT GO
+!***  FOR SUBROUTINE PDTE
+!
+      INTEGER :: KSMUD=0,LNSDT=7
+!
+!-----------------------------------------------------------------------
+!
+      CONTAINS
+!
+!***********************************************************************
+      SUBROUTINE PFDHT(NTSD,LAST_TIME,PT,DETA1,DETA2,PDTOP,RES,FIS      &
+     &                ,HYDRO,SIGMA,FIRST,DX,DY                          &
+     &                ,HTM,HBM2,VTM,VBM2,VBM3                           &
+     &                ,FDIV,FCP,WPDAR,DFL,CPGFU,CPGFV                   &
+     &                ,PD,PDSL,T,Q,U,V,CWM,OMGALF,PINT,DWDT             &
+     &                ,RTOP,DIV,FEW,FNS,FNE,FSE                         &
+     &                ,IHE,IHW,IVE,IVW,INDX3_WRK                        &
+     &                ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &                ,IMS,IME,JMS,JME,KMS,KME                          &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    PFDHT       DIVERGENCE/HORIZONTAL OMEGA-ALPHA
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 93-10-28
+!
+! ABSTRACT:
+!     PFDHT CALCULATES THE PRESSURE GRADIENT FORCE, UPDATES THE
+!     VELOCITY COMPONENTS DUE TO THE EFFECT OF THE PRESSURE GRADIENT
+!     AND CORIOILS FORCES, COMPUTES THE DIVERGENCE INCLUDING THE
+!     MODIFICATION PREVENTING GRAVITY WAVE GRID SEPARATION, AND
+!     CALCULATES THE HORIZONTAL PART OF THE OMEGA-ALPHA TERM.
+!     (THE PART PROPORTIONAL TO THE ADVECTION OF MASS ALONG
+!      COORDINATE SURFACES).
+!
+! PROGRAM HISTORY LOG:
+!   87-06-??  JANJIC     - ORIGINATOR
+!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   96-03-29  BLACK      - ADDED EXTERNAL EDGE
+!   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
+!   02-02-01  BLACK      - REWRITTEN FOR WRF CODING STANDARDS
+!   04-02-17  JANJIC     - REMOVED UPDATE OF TEMPERATURE
+!   04-11-23  BLACK      - THREADED
+!
+! USAGE: CALL PFDHT FROM MAIN PROGRAM SOLVE_RUNSTREAM
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST:
+!
+!   OUTPUT FILES:
+!     NONE
+!
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+!#ifdef DM_PARALLEL
+!      INCLUDE "mpif.h"
+!#endif
+!-----------------------------------------------------------------------
+      LOGICAL,INTENT(IN) :: FIRST,HYDRO
+      INTEGER,INTENT(IN) :: SIGMA
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: NTSD
+      LOGICAL,INTENT(IN) :: LAST_TIME
+!
+      REAL,INTENT(IN) :: CPGFV,DY,PDTOP,PT
+!
+      REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: DFL
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CPGFU,DX,FCP,FDIV   &
+     &                                             ,PD,FIS,RES,WPDAR    &
+     &                                             ,HBM2,VBM2,VBM3
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: CWM,DWDT    &
+     &                                                     ,Q,T,HTM,VTM
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DIV      &
+     &                                                        ,OMGALF   &
+     &                                                        ,RTOP,U,V
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: FEW,FNS    &
+     &                                                      ,FNE,FSE
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: PDSL
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      INTEGER :: I,J,JJ,JKNT,JSTART,K
+      INTEGER :: J1_00,J1_M1,J1_P1,J1_P2
+      INTEGER :: J2_00,J2_M1,J2_P1
+      INTEGER :: J3_00,J3_P1,J3_P2
+      INTEGER :: J4_00,J4_M1,J4_P1
+      INTEGER :: J5_00,J5_M1
+      INTEGER :: J6_00,J6_P1
+!
+      REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: ALP1,FILO
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE+1,JTS-5:JTE+5) :: PINTLG
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,JTS-5:JTE+5) :: FIM
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: DIVL,TEW
+!
+      REAL :: ADPDNE,ADPDSE,ADPDX,ADPDY,APELP,DFI,DCNEK,DCSEK           &
+     &       ,DPFEW,DPFNS,DPFNEK,DPFSEK,DPNEK,DPSEK,EDIV,FIUP           &
+     &       ,HM,PCEW,PCNS,PEW,PNS,PRSFRC,PVNEK,PVSEK,RTOPP,VM
+!
+      REAL :: SLP_STD=101300.0
+!
+!***  TYPE 1 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:2) :: APEL,DFDZ,DPDE
+!
+!***  TYPE 2 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:1) :: CNE,PCNE,PNE,PPNE
+!
+!***  TYPE 3 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:2) :: CSE,PCSE,PPSE,PSE
+!
+!***  TYPE 4 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: PCXC,TNS,UDY,VDX
+!
+!***  TYPE 5 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:0) :: TNE
+!
+!***  TYPE 6 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE, 0:1) :: TSE
+!-----------------------------------------------------------------------
+!***********************************************************************
+!
+!                                       
+!                CSE                          CSE            -------  1
+!                 *                            *  
+!                 *                            *    
+!       *******   *                  *******   *   
+!      *       *  *                 *       *  *  
+!   CNE         * *              CNE         * *       
+!               TEW----------OMGALF----------TEW             -------  0
+!   CSE         * *              CSE         * *         
+!      *       *  *                 *       *  *       
+!       *******   *                  *******   *     
+!                 *                            *   
+!                 *                            * 
+!                CNE                          CNE            ------- -1
+!                                        
+!
+!
+! 
+!***********************************************************************
+! 
+!                              CSE                           -------  2
+!                               *
+!                               *
+!                               *
+!                               *
+!                      CNE*****TNS                           -------  1
+!                      CSE     | *
+!                              | *
+!                              | *
+!                              | *
+!                              | CNE
+!                            OMGALF                          -------  0
+!                              | CSE
+!                              | *
+!                              | *
+!                              | *
+!                      CNE     | *
+!                      CSE*****TNS                           ------- -1
+!                               *
+!                               *
+!                               *
+!                               *
+!                              CNE                           ------- -2
+! 
+!***********************************************************************
+!-----------------------------------------------------------------------
+!***  PREPARATORY CALCULATIONS
+!-----------------------------------------------------------------------
+!     call hpm_start('PFDHT')
+!
+      DO J=JMS,JME
+      DO I=IMS,IME
+        PDSL(I,J)=0.
+      ENDDO
+      ENDDO
+!
+      DO J=JMS,JME
+      DO K=KMS,KME
+      DO I=IMS,IME
+        OMGALF(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!***  ZERO OUT TEMPORARIES.
+!
+      DO J=JTS-5,JTE+5
+      DO I=ITS-5,ITE+5
+        ALP1(I,J)=0.
+        FILO(I,J)=0.
+      ENDDO
+      ENDDO
+!
+      DO J=JTS-5,JTE+5
+      DO K=KTS,KTE+1
+      DO I=ITS-5,ITE+5
+        PINTLG(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=JTS-5,JTE+5
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        FIM(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        DIVL(I,K)=0.
+        TEW(I,K)=0.
+      ENDDO
+      ENDDO
+!
+      DO J=-2,2
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        APEL(I,K,J)=0.
+        DFDZ(I,K,J)=0.
+        DPDE(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=-2,1
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        CNE(I,K,J)=0.
+        PCNE(I,K,J)=0.
+        PNE(I,K,J)=0.
+        PPNE(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=-1,2
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        CSE(I,K,J)=0.
+        PCSE(I,K,J)=0.
+        PSE(I,K,J)=0.
+        PPSE(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=-1,1
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        PCXC(I,K,J)=0.
+        TNS(I,K,J)=0.
+        UDY(I,K,J)=0.
+        VDX(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=-1,0
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        TNE(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=0,1
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        TSE(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      IF(SIGMA.EQ.1)THEN
+        DO J=MYJS_P4,MYJE_P4
+        DO I=MYIS_P4,MYIE_P4
+          FILO(I,J)=FIS(I,J)
+          PDSL(I,J)=PD(I,J)
+        ENDDO
+        ENDDO
+      ELSE
+        DO J=MYJS_P4,MYJE_P4
+        DO I=MYIS_P4,MYIE_P4
+          FILO(I,J)=0.0
+          PDSL(I,J)=RES(I,J)*PD(I,J)
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***
+!***  INTEGRATE THE GEOPOTENTIAL
+!***
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(apelp,dfi,fiup,i,j,k,rtopp)
+      DO J=MYJS_P4,MYJE_P4
+!
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+!
+          APELP=(PINT(I,K+1,J)+PINT(I,K,J))*0.5
+          RTOPP=(Q(I,K,J)*P608-CWM(I,K,J)+1.)*T(I,K,J)*R_D/APELP
+
+          DFI=RTOPP*(DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J))
+!
+          RTOP(I,K,J)=RTOPP
+          FIUP=FILO(I,J)+DFI
+          FIM(I,K,J)=FILO(I,J)+FIUP
+          FILO(I,J)=(FIUP-DFL(K+1))*HTM(I,K,J)+DFL(K+1)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
+!***  FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
+!***  IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      JSTART=MYJS2_P2
+!
+      DO J=-2,1
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(apelp,i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          APELP=0.5*(PINT(I,K+1,JJ)+PINT(I,K,JJ))
+          APEL(I,K,J)=APELP
+          DFDZ(I,K,J)=RTOP(I,K,JJ)
+          DPDE(I,K,J)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,JJ)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+      DO J=-2,0
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          CNE(I,K,J)=(DFDZ(I+IHE(JJ),K,J+1)+DFDZ(I,K,J))*2.             &
+     &              *(APEL(I+IHE(JJ),K,J+1)-APEL(I,K,J))
+          PNE(I,K,J)=(FIM(I+IHE(JJ),K,JJ+1)-FIM(I,K,JJ))                &
+     &              *(DWDT(I+IHE(JJ),K,JJ+1)+DWDT(I,K,JJ))
+          PCNE(I,K,J)=CNE(I,K,J)*(DPDE(I+IHE(JJ),K,J+1)+DPDE(I,K,J))
+          PPNE(I,K,J)=PNE(I,K,J)*(DPDE(I+IHE(JJ),K,J+1)+DPDE(I,K,J))
+        ENDDO
+        ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          CSE(I,K,J+1)=(DFDZ(I+IHE(JJ+1),K,J)+DFDZ(I,K,J+1))*2.         &
+     &                *(APEL(I+IHE(JJ+1),K,J)-APEL(I,K,J+1))
+          PSE(I,K,J+1)=(FIM(I+IHE(JJ+1),K,JJ)-FIM(I,K,JJ+1))            &                
+     &                *(DWDT(I+IHE(JJ+1),K,JJ)+DWDT(I,K,JJ+1))
+          PCSE(I,K,J+1)=CSE(I,K,J+1)                                    &
+     &                 *(DPDE(I+IHE(JJ+1),K,J)+DPDE(I,K,J+1))
+          PPSE(I,K,J+1)=PSE(I,K,J+1)                                    &
+     &                 *(DPDE(I+IHE(JJ+1),K,J)+DPDE(I,K,J+1))
+        ENDDO
+        ENDDO
+      ENDDO
+!
+      IF(.NOT.FIRST)THEN   ! Skip at timestep 0
+        J=0
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(adpdx,adpdy,dcnek,dcsek,dpfew,dpfnek,dpfns,dpfsek,       &
+!$omp&         dpnek,dpsek,i,k,pcew,pcns,pew,pns,vm)
+        DO K=KTS,KTE
+        DO I=MYIS_P2,MYIE1_P2
+          DPFNEK=((PPNE(I+IVW(JJ),K,J)+PPNE(I,K,J-1))                   &
+     &           +(PCNE(I+IVW(JJ),K,J)+PCNE(I,K,J-1)))*2.
+          DPFSEK=((PPSE(I+IVW(JJ),K,J)+PPSE(I,K,J+1))                   &
+     &           +(PCSE(I+IVW(JJ),K,J)+PCSE(I,K,J+1)))*2.
+          DPFEW=DPFNEK+DPFSEK
+          DPFNS=DPFNEK-DPFSEK
+          ADPDX=DPDE(I+IVW(JJ),K,J)+DPDE(I+IVE(JJ),K,J)
+          ADPDY=DPDE(I,K,J-1)+DPDE(I,K,J+1)
+          DPNEK=PNE(I+IVW(JJ),K,J)+PNE(I,K,J-1)
+          DPSEK=PSE(I+IVW(JJ),K,J)+PSE(I,K,J+1)
+          PEW=DPNEK+DPSEK
+          PNS=DPNEK-DPSEK
+          DCNEK=CNE(I+IVW(JJ),K,J)+CNE(I,K,J-1)
+          DCSEK=CSE(I+IVW(JJ),K,J)+CSE(I,K,J+1)
+          PCEW=(DCNEK+DCSEK)*ADPDX
+          PCNS=(DCNEK-DCSEK)*ADPDY
+          VM=VTM(I,K,JJ)*VBM2(I,JJ)
+          U(I,K,JJ)=(((DPFEW+PCEW)/ADPDX+PEW)*CPGFU(I,JJ))*VM+U(I,K,JJ)
+          V(I,K,JJ)=(((DPFNS+PCNS)/ADPDY+PNS)*CPGFV      )*VM+V(I,K,JJ)
+        ENDDO
+        ENDDO
+      ENDIF
+!
+      DO J=-1,0
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(adpdy,dcnek,dcsek,i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          UDY(I,K,J)=DY*U(I,K,JJ)
+          VDX(I,K,J)=DX(I,JJ)*V(I,K,JJ)
+          DCNEK=CNE(I+IVW(JJ),K,J)+CNE(I,K,J-1)
+          DCSEK=CSE(I+IVW(JJ),K,J)+CSE(I,K,J+1)
+          ADPDY=DPDE(I,K,J-1)+DPDE(I,K,J+1)
+          TNS(I,K,J)=VDX(I,K,J)*((DCNEK-DCSEK)*ADPDY)
+          FNS(I,K,JJ)=VDX(I,K,J)*ADPDY
+        ENDDO
+        ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P1,MYIE_P1
+          PCXC(I,K,J)=(PNE(I+IVW(JJ),K,J)-PNE(I,K,J-1)                  &
+     &                +CNE(I+IVW(JJ),K,J)-CNE(I,K,J-1)                  &
+     &                +PSE(I+IVW(JJ),K,J)-PSE(I,K,J+1)                  &
+     &                +CSE(I+IVW(JJ),K,J)-CSE(I,K,J+1))                 &
+     &                *VBM3(I,JJ)*VTM(I,K,JJ)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+      JJ=JSTART
+!$omp parallel do                                                       &
+!$omp& private(adpdne,i,k,pvnek)
+      DO K=KTS,KTE
+      DO I=MYIS_P2,MYIE1_P2
+        ADPDNE=DPDE(I+IHE(JJ-1),K,0)+DPDE(I,K,-1)
+        PVNEK=(UDY(I+IHE(JJ-1),K,-1)+VDX(I+IHE(JJ-1),K,-1))             &
+     &       +(UDY(I,K,0)          +VDX(I,K,0))
+        PCNE(I,K,-1)=CNE(I,K,-1)*ADPDNE
+        PPNE(I,K,-1)=PNE(I,K,-1)*ADPDNE
+        TNE(I,K,-1)=PVNEK*PCNE(I,K,-1)*2.
+        FNE(I,K,JJ-1)=PVNEK*ADPDNE
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(adpdse,i,k,pvsek)
+      DO K=KTS,KTE
+      DO I=MYIS_P2,MYIE1_P2
+        ADPDSE=DPDE(I+IHE(JJ),K,-1)+DPDE(I,K,0)
+        PVSEK=(UDY(I+IHE(JJ),K,0)-VDX(I+IHE(JJ),K,0))                   &
+     &       +(UDY(I,K,-1)      -VDX(I,K,-1))
+        PCSE(I,K,0)=CSE(I,K,0)*ADPDSE
+        PPSE(I,K,0)=PSE(I,K,0)*ADPDSE
+        TSE(I,K,0)=PVSEK*PCSE(I,K,0)*2.
+        FSE(I,K,JJ)=PVSEK*ADPDSE
+      ENDDO
+      ENDDO
+!
+      JKNT=0
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***  MAIN INTEGRATION LOOP
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      main_integration : DO J=MYJS2_P2,MYJE2_P2
+!
+!-----------------------------------------------------------------------
+!***
+!***  SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
+!***                                           AND ABOVE DIAGRAMS)
+!***
+!***  J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
+!***  LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
+!***  NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
+!***  THE CURRENT VALUE OF THE main_integration LOOP.
+!***  (P2 denotes +2, etc.)
+!***
+      JKNT=JKNT+1
+!
+      J1_P2=INDX3_WRK(2,JKNT,1)
+      J1_P1=INDX3_WRK(1,JKNT,1)
+      J1_00=INDX3_WRK(0,JKNT,1)
+      J1_M1=INDX3_WRK(-1,JKNT,1)
+!
+      J2_P1=INDX3_WRK(1,JKNT,2)
+      J2_00=INDX3_WRK(0,JKNT,2)
+      J2_M1=INDX3_WRK(-1,JKNT,2)
+!
+      J3_P2=INDX3_WRK(2,JKNT,3)
+      J3_P1=INDX3_WRK(1,JKNT,3)
+      J3_00=INDX3_WRK(0,JKNT,3)
+!
+      J4_P1=INDX3_WRK(1,JKNT,4)
+      J4_00=INDX3_WRK(0,JKNT,4)
+      J4_M1=INDX3_WRK(-1,JKNT,4)
+!
+      J5_00=INDX3_WRK(0,JKNT,5)
+      J5_M1=INDX3_WRK(-1,JKNT,5)
+!
+      J6_P1=INDX3_WRK(1,JKNT,6)
+      J6_00=INDX3_WRK(0,JKNT,6)
+!
+!-----------------------------------------------------------------------
+      PRSFRC=PDTOP/(SLP_STD-PT)
+!$omp parallel do                                                       &
+!$omp& private(apelp,i,k)
+      DO K=KTS,KTE
+!
+      DO I=MYIS_P4,MYIE_P4
+        APELP=0.5*(PINT(I,K+1,J+2)+PINT(I,K,J+2))
+        APEL(I,K,J1_P2)=APELP
+        DFDZ(I,K,J1_P2)=RTOP(I,K,J+2)
+        DPDE(I,K,J1_P2)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J+2)
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  DIAGONAL CONTRIBUTIONS TO PRESSURE GRADIENT FORCE
+!-----------------------------------------------------------------------
+!
+!     call hpm_start('block1')
+      DO I=MYIS_P3,MYIE_P3
+        CNE(I,K,J2_P1)=(DFDZ(I+IHE(J+1),K,J1_P2)+DFDZ(I,K,J1_P1))*2.    &
+     &                *(APEL(I+IHE(J+1),K,J1_P2)-APEL(I,K,J1_P1))
+        PNE(I,K,J2_P1)=(FIM(I+IHE(J+1),K,J+2)-FIM(I,K,J+1))             &
+     &                *(DWDT(I+IHE(J+1),K,J+2)+DWDT(I,K,J+1))
+        PCNE(I,K,J2_P1)=CNE(I,K,J2_P1)                                  &
+     &                 *(DPDE(I+IHE(J+1),K,J1_P2)+DPDE(I,K,J1_P1))
+        PPNE(I,K,J2_P1)=PNE(I,K,J2_P1)                                  &
+     &                 *(DPDE(I+IHE(J+1),K,J1_P2)+DPDE(I,K,J1_P1))
+      ENDDO
+!
+      DO I=MYIS_P3,MYIE_P3
+        CSE(I,K,J3_P2)=(DFDZ(I+IHE(J+2),K,J1_P1)+DFDZ(I,K,J1_P2))*2.    &
+     &                *(APEL(I+IHE(J+2),K,J1_P1)-APEL(I,K,J1_P2))
+        PSE(I,K,J3_P2)=(FIM(I+IHE(J+2),K,J+1)-FIM(I,K,J+2))             &
+     &                *(DWDT(I+IHE(J+2),K,J+1)+DWDT(I,K,J+2))
+        PCSE(I,K,J3_P2)=CSE(I,K,J3_P2)                                  &
+     &                 *(DPDE(I+IHE(J+2),K,J1_P1)+DPDE(I,K,J1_P2))
+        PPSE(I,K,J3_P2)=PSE(I,K,J3_P2)                                  &
+     &                 *(DPDE(I+IHE(J+2),K,J1_P1)+DPDE(I,K,J1_P2))
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  CONTINUITY EQUATION MODIFICATION
+!-----------------------------------------------------------------------
+!
+      DO I=MYIS_P1,MYIE_P1
+        PCXC(I,K,J4_P1)=(PNE(I+IVW(J+1),K,J2_P1)                        &
+     &                  +CNE(I+IVW(J+1),K,J2_P1)                        &
+     &                  +PSE(I+IVW(J+1),K,J3_P1)                        &
+     &                  +CSE(I+IVW(J+1),K,J3_P1)                        &
+     &                  -PNE(I,K,J2_00)                                 &
+     &                  -CNE(I,K,J2_00)                                 &
+     &                  -PSE(I,K,J3_P2)                                 &
+     &                  -CSE(I,K,J3_P2))                                &
+     &                  *VBM3(I,J+1)*VTM(I,K,J+1)
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!
+      DO I=MYIS1,MYIE1
+        DIVL(I,K)=(DETA1(K)*PRSFRC                                      &
+     &            +DETA2(K)*(1.-PRSFRC))*WPDAR(I,J)                     &
+     &           *(PCXC(I+IHE(J),K,J4_00)-PCXC(I,K,J4_P1)               &
+                  +PCXC(I+IHW(J),K,J4_00)-PCXC(I,K,J4_M1))
+      ENDDO
+      ENDDO
+!     call hpm_stop('block1')
+!
+!-----------------------------------------------------------------------
+!
+      IF(.NOT.FIRST)THEN     ! Skip at timestep 0
+!
+!-----------------------------------------------------------------------
+!***  LAT & LONG PRESSURE FORCE COMPONENTS
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(adpdx,adpdy,dcnek,dcsek,dpfew,dpfnek,dpfns,dpfsek,       &
+!$omp&         dpnek,dpsek,i,k,pcew,pcns,pew,pns,vm)
+        DO K=KTS,KTE
+        DO I=MYIS_P2,MYIE1_P2
+          DPNEK=PNE(I+IVW(J+1),K,J2_P1)+PNE(I,K,J2_00)
+          DPSEK=PSE(I+IVW(J+1),K,J3_P1)+PSE(I,K,J3_P2)
+          PEW=DPNEK+DPSEK
+          PNS=DPNEK-DPSEK
+!
+          ADPDX=DPDE(I+IVW(J+1),K,J1_P1)+DPDE(I+IVE(J+1),K,J1_P1)
+          ADPDY=DPDE(I,K,J1_00)+DPDE(I,K,J1_P2)
+          DCNEK=CNE(I+IVW(J+1),K,J2_P1)+CNE(I,K,J2_00)
+          DCSEK=CSE(I+IVW(J+1),K,J3_P1)+CSE(I,K,J3_P2)
+          PCEW=(DCNEK+DCSEK)*ADPDX
+          PCNS=(DCNEK-DCSEK)*ADPDY
+!
+          DPFNEK=((PPNE(I+IVW(J+1),K,J2_P1)+PPNE(I,K,J2_00))            &
+     &           +(PCNE(I+IVW(J+1),K,J2_P1)+PCNE(I,K,J2_00)))*2.
+          DPFSEK=((PPSE(I+IVW(J+1),K,J3_P1)+PPSE(I,K,J3_P2))            &
+     &           +(PCSE(I+IVW(J+1),K,J3_P1)+PCSE(I,K,J3_P2)))*2.
+          DPFEW=DPFNEK+DPFSEK
+          DPFNS=DPFNEK-DPFSEK
+!
+!-----------------------------------------------------------------------
+!***  UPDATE U AND V FOR PRESSURE GRADIENT FORCE
+!-----------------------------------------------------------------------
+!
+          VM=VTM(I,K,J+1)*VBM2(I,J+1)
+          U(I,K,J+1)=(((DPFEW+PCEW)/ADPDX+PEW)*CPGFU(I,J+1))*VM         &
+     &              +U(I,K,J+1) 
+          V(I,K,J+1)=(((DPFNS+PCNS)/ADPDY+PNS)*CPGFV       )*VM         &
+     &              +V(I,K,J+1)
+        ENDDO
+        ENDDO
+!-----------------------------------------------------------------------
+!
+      ENDIF    !End of IF block executed for FIRST equal to .FALSE.
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      IF(.NOT.LAST_TIME)THEN    !Do not execute block at last timestep
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(adpdx,adpdy,dcnek,dcsek,ediv,hm,i,k,pvnek,pvsek)
+        DO K=KTS,KTE
+        DO I=MYIS_P2,MYIE_P3
+          UDY(I,K,J4_P1)=DY*U(I,K,J+1)
+          VDX(I,K,J4_P1)=DX(I,J+1)*V(I,K,J+1)
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  LAT & LON FLUXES & OMEGA-ALPHA COMPONENTS
+!-----------------------------------------------------------------------
+!
+        DO I=MYIS_P2,MYIE_P3
+          ADPDX=DPDE(I+IVW(J),K,J1_00)+DPDE(I+IVE(J),K,J1_00)
+          DCNEK=CNE(I+IVW(J),K,J2_00)+CNE(I,K,J2_M1)
+          DCSEK=CSE(I+IVW(J),K,J3_00)+CSE(I,K,J3_P1)
+          TEW(I,K)=UDY(I,K,J4_00)*((DCNEK+DCSEK)*ADPDX)
+          FEW(I,K,J)=UDY(I,K,J4_00)*ADPDX
+!
+          ADPDY=DPDE(I,K,J1_P2)+DPDE(I,K,J1_00)
+          DCNEK=CNE(I+IVW(J+1),K,J2_P1)+CNE(I,K,J2_00)
+          DCSEK=CSE(I+IVW(J+1),K,J3_P1)+CSE(I,K,J3_P2)
+          TNS(I,K,J4_P1)=VDX(I,K,J4_P1)*((DCNEK-DCSEK)*ADPDY)
+          FNS(I,K,J+1)=VDX(I,K,J4_P1)*ADPDY
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND
+!-----------------------------------------------------------------------
+!
+        DO I=MYIS_P1,MYIE1_P1
+          PVNEK=(UDY(I+IHE(J),K,J4_00)+VDX(I+IHE(J),K,J4_00))           &
+     &         +(UDY(I,K,J4_P1)       +VDX(I,K,J4_P1))
+          TNE(I,K,J5_00)=PVNEK*PCNE(I,K,J2_00)*2.
+          FNE(I,K,J)=PVNEK*(DPDE(I+IHE(J),K,J1_P1)+DPDE(I,K,J1_00))
+        ENDDO
+!
+        DO I=MYIS_P1,MYIE1_P1
+          PVSEK=(UDY(I+IHE(J+1),K,J4_P1)-VDX(I+IHE(J+1),K,J4_P1))       &
+     &         +(UDY(I,K,J4_00)         -VDX(I,K,J4_00))
+          TSE(I,K,J6_P1)=PVSEK*PCSE(I,K,J3_P1)*2.
+          FSE(I,K,J+1)=PVSEK*(DPDE(I+IHE(J+1),K,J1_00)+DPDE(I,K,J1_P1))
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  HORIZONTAL PART OF OMEGA-ALPHA & DIVERGENCE
+!-----------------------------------------------------------------------
+!
+        DO I=MYIS1,MYIE1
+          HM=HTM(I,K,J)*HBM2(I,J)
+          OMGALF(I,K,J)=(TEW(I+IHE(J),K)+TEW(I+IHW(J),K)                &
+     &                  +TNS(I,K,J4_P1) +TNS(I,K,J4_M1)                 &
+     &                  +TNE(I,K,J5_00) +TNE(I+IHW(J),K,J5_M1)          &
+     &                  +TSE(I,K,J6_00)+TSE(I+IHW(J),K,J6_P1))          &
+     &                  /DPDE(I,K,J1_00)*FCP(I,J)*HM
+          EDIV=(FEW(I+IHE(J),K,J)+FNS(I,K,J+1)                          &
+     &         +FNE(I,K,J)+FSE(I,K,J)                                   &
+     &        -(FEW(I+IHW(J),K,J)+FNS(I,K,J-1)                          &
+     &         +FNE(I+IHW(J),K,J-1)+FSE(I+IHW(J),K,J+1)))*FDIV(I,J)
+          DIV(I,K,J)=(EDIV+DIVL(I,K))*HM
+        ENDDO
+        ENDDO
+!-----------------------------------------------------------------------
+!
+      ENDIF   !End block to skip execution at last timestep
+!
+!-----------------------------------------------------------------------
+!
+      ENDDO main_integration
+!     call hpm_stop('PFDHT')
+!
+!-----------------------------------------------------------------------
+!
+      END SUBROUTINE PFDHT
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+      SUBROUTINE PDTE(                                                  &
+#ifdef DM_PARALLEL
+     &                GRID,                                             &
+#endif
+     &                NTSD,DT,PT,ETA2,RES,HYDRO                         &
+     &               ,HTM,HBM2                                          &
+     &               ,PD,PDSL,PDSLO                                     &
+     &               ,PETDT,DIV,PSDT                                    &
+     &               ,IHE,IHW,IVE,IVW,INDX3_WRK                         &                 
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &               ,IMS,IME,JMS,JME,KMS,KME                           &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    PDTE        SURFACE PRESSURE TENDENCY CALC
+!   PRGRMMR: JANJIC          ORG: W/NP2      DATE: 96-07-??      
+!     
+! ABSTRACT:
+!     PDTE VERTICALLY INTEGRATES THE MASS FLUX DIVERGENCE TO
+!     OBTAIN THE SURFACE PRESSURE TENDENCY AND VERTICAL VELOCITY ON
+!     THE LAYER INTERFACES.  THEN IT UPDATES THE HYDROSTATIC SURFACE
+!     PRESSURE AND THE NONHYDROSTATIC PRESSURE.
+!     
+! PROGRAM HISTORY LOG:
+!   87-06-??  JANJIC     - ORIGINATOR
+!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   96-05-??  JANJIC     - ADDED NONHYDROSTATIC EFFECTS & MERGED THE
+!                          PREVIOUS SUBROUTINES PDTE & PDNEW
+!   00-01-03  BLACK      - DISTRIBUTED MEMORY AND THREADS
+!   01-02-23  BLACK      - CONVERTED TO WRF FORMAT
+!   01-04-11  BLACK      - REWRITTEN FOR WRF CODING STANDARDS
+!   04-02-17  JANJIC     - MOVED UPDATE OF T DUE TO OMEGA-ALPHA TERM
+!                          AND UPDATE OF PINT TO NEW ROUTINE VTOA
+!   04-11-23  BLACK      - THREADED
+!     
+! USAGE: CALL PDTE FROM SUBROUTINE SOLVE_RUNSTREAM
+!   INPUT ARGUMENT LIST:
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!***********************************************************************
+#ifdef DM_PARALLEL
+      USE module_domain
+      USE module_dm
+#endif
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+#ifdef DM_PARALLEL
+!     INCLUDE "mpif.h"
+      TYPE (DOMAIN) :: GRID
+#endif
+!-----------------------------------------------------------------------
+      LOGICAL,INTENT(IN) :: HYDRO
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+                           ,IMS,IME,JMS,JME,KMS,KME                     &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      REAL,INTENT(IN) :: DT,PT
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: RES,HBM2   
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DIV
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: PD,PDSL
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: PETDT
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: PDSLO,PSDT
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      INTEGER :: I,IHH,IHL,IX,J,JHH,JHL,JJ,JX,K,KNT,KS,NSMUD
+      INTEGER :: J1_00,J1_M1,J2_00,J2_P1
+      INTEGER :: MY_IS_GLB,MY_IE_GLB,MY_JS_GLB,MY_JE_GLB
+#ifdef DM_PARALLEL
+      INTEGER :: IPS,IPE,JPS,JPE,KPS,KPE
+#endif
+#ifdef DEREF_KLUDGE
+! SEE http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+      INTEGER :: SM31,EM31,SM32,EM32,SM33,EM33
+      INTEGER :: SM31X,EM31X,SM32X,EM32X,SM33X,EM33X
+      INTEGER :: SM31Y,EM31Y,SM32Y,EM32Y,SM33Y,EM33Y
+#endif
+!
+      REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: APDT,HBMS,PRET
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:0) :: PNE
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE, 0:1) :: PSE
+!
+      REAL :: PETDTL
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+#include "deref_kludge.h"
+!
+      DO J=JMS,JME
+      DO I=IMS,IME
+        PDSLO(I,J)=0.
+      ENDDO
+      ENDDO
+!
+      MY_IS_GLB=ITS
+      MY_IE_GLB=ITE
+      MY_JS_GLB=JTS
+      MY_JE_GLB=JTE
+!-----------------------------------------------------------------------
+!***  COMPUTATION OF PRESSURE TENDENCY & PREPARATIONS
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS_P2,MYJE_P2
+        DO K=KTE-1,KTS,-1
+        DO I=MYIS_P2,MYIE_P2
+          DIV(I,K,J)=DIV(I,K+1,J)+DIV(I,K,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS_P2,MYJE_P2
+      DO I=MYIS_P2,MYIE_P2
+        PSDT(I,J)=-DIV(I,KTS,J)
+        APDT(I,J)=PSDT(I,J)
+        PDSLO(I,J)=PDSL(I,J)
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      DO J=JMS,JME
+      DO I=IMS,IME
+        PDSL(I,J)=0.
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS_P2,MYJE_P2
+      DO I=MYIS_P2,MYIE_P2
+        PD(I,J)=PSDT(I,J)*DT+PD(I,J)
+        PRET(I,J)=PSDT(I,J)*RES(I,J)
+        PDSL(I,J)=PD(I,J)*RES(I,J)
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!***  COMPUTATION OF PETDT
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS_P2,MYJE_P2
+        DO K=KTE-1,KTS,-1
+        DO I=MYIS_P2,MYIE_P2
+          PETDT(I,K,J)=-(PRET(I,J)*ETA2(K+1)+DIV(I,K+1,J))              &
+     &                  *HTM(I,K,J)*HBM2(I,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!***  SMOOTHING VERTICAL VELOCITY ALONG BOUNDARIES
+!-----------------------------------------------------------------------
+      nonhydrostatic_smoothing: IF(.NOT.HYDRO.AND.KSMUD.GT.0)THEN
+!
+        NSMUD=KSMUD
+!
+        DO J=MYJS,MYJE
+        DO I=MYIS,MYIE
+          HBMS(I,J)=HBM2(I,J)
+        ENDDO
+        ENDDO
+!
+        JHL=LNSDT
+        JHH=JDE-JHL+1
+!
+!$omp parallel do                                                       &
+!$omp& private(i,ihh,ihl,ix,j,jx)
+        DO J=JHL,JHH
+          IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN
+            IHL=JHL/2+1
+            IHH=IDE-IHL+MOD(J,2)
+!
+            DO I=IHL,IHH
+              IF(I.GE.MY_IS_GLB.AND.I.LE.MY_IE_GLB)THEN
+                IX=I    ! -MY_IS_GLB+1
+                JX=J    ! -MY_JS_GLB+1
+                HBMS(IX,JX)=0.
+              ENDIF
+            ENDDO
+!
+          ENDIF
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***
+!***  SMOOTH THE VERTICAL VELOCITY
+!***
+!-----------------------------------------------------------------------
+!
+        DO KS=1,NSMUD
+!
+!-----------------------------------------------------------------------
+!
+!***  FILL SOUTHERNMOST SLABS OF THE PNE AND PSE WORKING ARRAYS
+!
+          JJ=MYJS2-1
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+          DO K=KTS,KTE-1
+!
+          DO I=MYIS_P1,MYIE1_P1
+            PNE(I,K,-1)=(PETDT(I+IHE(JJ),K,JJ+1)-PETDT(I,K,JJ))         &
+     &                  *HTM(I,K,JJ)*HTM(I+IHE(JJ),K,JJ+1)
+          ENDDO
+!
+          DO I=MYIS_P1,MYIE1_P1
+            PSE(I,K,0)=(PETDT(I+IHE(JJ+1),K,JJ)-PETDT(I,K,JJ+1))        &
+     &                 *HTM(I+IHE(JJ+1),K,JJ)*HTM(I,K,JJ+1)
+          ENDDO
+!
+          ENDDO
+!
+          KNT=0
+!
+!-----------------------------------------------------------------------
+!
+!***  PROCEED NORTHWARD WITH THE SMOOTHING.
+!***  PNE AT H(I,J) LIES BETWEEN (I,J) AND THE H POINT TO THE NE.
+!***  PSE AT H(I,J) LIES BETWEEN (I,J) AND THE H POINT TO THE SE.
+!
+          DO J=MYJS2,MYJE2
+!
+            KNT=KNT+1
+            J1_00=-MOD(KNT+1,2)
+            J1_M1=-MOD(KNT,2)
+            J2_P1=MOD(KNT,2)
+            J2_00=MOD(KNT+1,2)
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k,petdtl)
+            DO K=KTS,KTE-1
+!
+            DO I=MYIS_P1,MYIE1_P1
+              PNE(I,K,J1_00)=(PETDT(I+IHE(J),K,J+1)-PETDT(I,K,J))       &
+     &                       *HTM(I,K+1,J)*HTM(I+IHE(J),K+1,J+1)
+            ENDDO
+!
+            DO I=MYIS_P1,MYIE1_P1
+              PSE(I,K,J2_P1)=(PETDT(I+IHE(J+1),K,J)-PETDT(I,K,J+1))     &
+     &                       *HTM(I+IHE(J+1),K+1,J)*HTM(I,K+1,J+1)
+            ENDDO
+!
+            DO I=MYIS1,MYIE1
+              PETDTL=(PNE(I,K,J1_00)-PNE(I+IHW(J),K,J1_M1)              &
+     &               +PSE(I,K,J2_00)-PSE(I+IHW(J),K,J2_P1))*HBM2(I,J)
+              PETDT(I,K,J)=PETDTL*HBMS(I,J)*0.125+PETDT(I,K,J) 
+            ENDDO
+!
+            ENDDO
+!
+          ENDDO
+!
+#ifdef DM_PARALLEL
+          IPS=ITS;IPE=ITE;JPS=JTS;JPE=JTE;KPS=KTS;KPE=KTE
+# include <HALO_NMM_E.inc>
+#endif
+!-----------------------------------------------------------------------
+!
+        ENDDO  ! End of smoothing loop
+!
+!-----------------------------------------------------------------------
+      ENDIF nonhydrostatic_smoothing
+!-----------------------------------------------------------------------
+      END SUBROUTINE PDTE
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+      SUBROUTINE VTOA(                                                  &
+#ifdef DM_PARALLEL
+     &                grid,                                             &
+#endif
+     &                NTSD,DT,PT,ETA2                                   &
+     &               ,HTM,HBM2,EF4T                                     &
+     &               ,T,DWDT,RTOP,OMGALF                                &
+     &               ,PINT,DIV,PSDT,RES                                 &
+     &               ,IHE,IHW,IVE,IVW,INDX3_WRK                         &                 
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &               ,IMS,IME,JMS,JME,KMS,KME                           &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    VTOA        OMEGA-ALPHA
+!   PRGRMMR: JANJIC          ORG: W/NP2      DATE: 04-02-17      
+!     
+! ABSTRACT:
+!     VTOA UPDATES THE NONHYDROSTATIC PRESSURE AND ADDS THE
+!     CONTRIBUTION OF THE OMEGA-ALPHA TERM OF THE THERMODYNAMIC
+!     EQUATION.  ALSO, THE OMEGA-ALPHA TERM IS COMPUTED FOR DIAGNOSTICS.
+!     
+! PROGRAM HISTORY LOG:
+!   04-02-17  JANJIC     - SEPARATED FROM ORIGINAL PDTEDT ROUTINE
+!   04-11-23  BLACK      - THREADED
+!     
+
+!   INPUT ARGUMENT LIST:
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!***********************************************************************
+#ifdef DM_PARALLEL
+      USE MODULE_DOMAIN
+      USE MODULE_DM
+#endif
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+#ifdef DM_PARALLEL
+!     INCLUDE "mpif.h"
+      TYPE (DOMAIN) :: GRID
+#endif
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+                           ,IMS,IME,JMS,JME,KMS,KME                     &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      REAL,INTENT(IN) :: DT,EF4T,PT
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HBM2,PSDT,RES
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DIV,DWDT    &
+     &                                                     ,HTM,RTOP
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: OMGALF,T  
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: PINT
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      INTEGER :: I,IHH,IHL,IX,J,JHH,JHL,JJ,JX,K,KNT,KS,NSMUD
+      INTEGER :: J1_00,J1_M1,J2_00,J2_P1
+!
+      REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: PRET,TPM
+!
+      REAL :: DWDTP,RHS,TPMP
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!***  PREPARATIONS
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS_P2,MYJE_P2
+      DO I=MYIS_P2,MYIE_P2
+        PINT(I,KTE+1,J)=PT
+        TPM(I,J)=PT+PINT(I,KTE,J)
+        PRET(I,J)=PSDT(I,J)*RES(I,J)
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!***  KINETIC ENERGY GENERATION TERMS IN T EQUATION
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dwdtp,i,j,rhs,tpmp)
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+        DWDTP=DWDT(I,KTE,J)
+        TPMP=PINT(I,KTE,J)+PINT(I,KTE-1,J)
+!
+        RHS=-DIV(I,KTE,J)*RTOP(I,KTE,J)*HTM(I,KTE,J)*DWDTP*EF4T
+        OMGALF(I,KTE,J)=OMGALF(I,KTE,J)+RHS
+        T(I,KTE,J)=OMGALF(I,KTE,J)*HBM2(I,J)+T(I,KTE,J)
+        PINT(I,KTE,J)=PRET(I,J)*(ETA2(KTE+1)+ETA2(KTE))*DWDTP*DT        &
+     &             +TPM(I,J)-PINT(I,KTE+1,J)
+!
+        TPM(I,J)=TPMP
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dwdtp,i,j,k,rhs,tpmp)
+      DO J=MYJS,MYJE
+        DO K=KTE-1,KTS+1,-1
+        DO I=MYIS,MYIE
+          DWDTP=DWDT(I,K,J)
+          TPMP=PINT(I,K,J)+PINT(I,K-1,J)
+!
+          RHS=-(DIV(I,K+1,J)+DIV(I,K,J))*RTOP(I,K,J)*HTM(I,K,J)*DWDTP   &
+     &         *EF4T
+          OMGALF(I,K,J)=OMGALF(I,K,J)+RHS
+          T(I,K,J)=OMGALF(I,K,J)*HBM2(I,J)+T(I,K,J)
+          PINT(I,K,J)=PRET(I,J)*(ETA2(K+1)+ETA2(K))*DWDTP*DT            &
+     &               +TPM(I,J)-PINT(I,K+1,J)
+!
+          TPM(I,J)=TPMP
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dwdtp,i,j,rhs)
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+!
+        DWDTP=DWDT(I,KTS,J)
+!
+        RHS=-(DIV(I,KTS+1,J)+DIV(I,KTS,J))*RTOP(I,KTS,J)*HTM(I,KTS,J)   &
+     &       *DWDTP*EF4T
+        OMGALF(I,KTS,J)=OMGALF(I,KTS,J)+RHS
+        T(I,KTS,J)=OMGALF(I,KTS,J)*HBM2(I,J)+T(I,KTS,J)
+        PINT(I,KTS,J)=PRET(I,J)*(ETA2(KTS+1)+ETA2(KTS))*DWDTP*DT        &
+     &                 +TPM(I,J)-PINT(I,KTS+1,J)
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      END SUBROUTINE VTOA
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE DDAMP(NTSD,DT,DETA1,DETA2,PDSL,PDTOP,DIV,HBM2,VTM      &
+     &                ,T,U,V,DDMPU,DDMPV                                &
+     &                ,IHE,IHW,IVE,IVW,INDX3_WRK                        &              
+     &                ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &                ,IMS,IME,JMS,JME,KMS,KME                          &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    DDAMP       DIVERGENCE DAMPING
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 94-03-08       
+!     
+! ABSTRACT:
+!     DDAMP MODIFIES THE WIND COMPONENTS SO AS TO REDUCE THE
+!     HORIZONTAL DIVERGENCE.
+!     
+! PROGRAM HISTORY LOG:
+!   87-08-??  JANJIC     - ORIGINATOR
+!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   95-03-28  BLACK      - ADDED EXTERNAL EDGE
+!   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
+!   01-03-12  BLACK      - CONVERTED TO WRF STRUCTURE
+!   04-11-18  BLACK      - THREADED
+!     
+! USAGE: CALL DDAMP FROM SUBROUTINE SOLVE_RUNSTREAM
+!
+!   INPUT ARGUMENT LIST:
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: NONE
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!***********************************************************************
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!
+!-----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-----------------------------------------------------------------------
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      REAL,INTENT(IN) :: DT,PDTOP
+!
+      REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DDMPU,DDMPV         &
+     &                                             ,HBM2,PDSL
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: VTM
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DIV,T    &
+     &                                                        ,U,V
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      INTEGER :: I,IER,J,J4_00,J4_M1,J4_P1,JJ,JKNT,JSTART,K,STAT
+!
+      REAL :: RDPDX,RDPDY
+!
+!***  TYPE 4 WORKING ARRAY   ! See PFDHT
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: CKE,DPDE
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+!***  MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
+!***  FILLING THE WORKING ARRAY NEEDED FOR AVERAGING AND
+!***  DIFFERENCING IN J
+!
+!-----------------------------------------------------------------------
+      JSTART=MYJS2
+!
+      DO J=-1,0
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P2,MYIE_P2
+          DPDE(I,K,J)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,JJ)
+          DIV(I,K,JJ)=DIV(I,K,JJ)*HBM2(I,JJ)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+      JKNT=0
+!-----------------------------------------------------------------------
+!
+      main_integration : DO J=MYJS2,MYJE2
+!
+!-----------------------------------------------------------------------
+!***
+!***  SET THE 3RD INDEX OF THE WORKING ARRAYS (SEE SUBROUTINE INIT
+!***                                           AND PFDHT DIAGRAMS)
+!***
+!***  J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
+!***  LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
+!***  NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
+!***  THE CURRENT VALUE OF THE main_integration LOOP.
+!***  (P2 denotes +2, etc.)
+!***
+      JKNT=JKNT+1
+!
+      J4_P1=INDX3_WRK(1,JKNT,4)
+      J4_00=INDX3_WRK(0,JKNT,4)
+      J4_M1=INDX3_WRK(-1,JKNT,4)
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,k,rdpdx,rdpdy)
+      DO K=KTS,KTE
+!
+      DO I=MYIS_P2,MYIE_P2
+        DPDE(I,K,J4_P1)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J+1)
+        DIV(I,K,J+1)=DIV(I,K,J+1)*HBM2(I,J+1)
+      ENDDO
+!
+      DO I=MYIS1_P1,MYIE1_P1
+        RDPDX=VTM(I,K,J)/(DPDE(I+IVW(J),K,J4_00)                        &
+     &                   +DPDE(I+IVE(J),K,J4_00))
+        U(I,K,J)=U(I,K,J)+(DIV(I+IVE(J),K,J)-DIV(I+IVW(J),K,J))         &
+     &                    *RDPDX*DDMPU(I,J)
+!
+        RDPDY=VTM(I,K,J)/(DPDE(I,K,J4_M1)+DPDE(I,K,J4_P1))
+        V(I,K,J)=V(I,K,J)+(DIV(I,K,J+1)-DIV(I,K,J-1))                   &
+     &                    *RDPDY*DDMPV(I,J)
+      ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!
+      ENDDO main_integration
+!
+!-----------------------------------------------------------------------
+      END SUBROUTINE DDAMP
+!-----------------------------------------------------------------------
+      END MODULE MODULE_IGWAVE_ADJUST
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_INDX.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_INDX.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_INDX.F	(revision 2744)
@@ -0,0 +1,49 @@
+!
+      MODULE MODULE_INDX
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!
+!***  INDEX INCREMENTS FOR MOVING TO NEIGHBORS ON THE E-GRID
+!
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: IHE,IHW,IVE,IVW,IRAD         &
+                                         ,IHEG,IHWG,IVEG,IVWG,IRADG
+!----------------------------------------------------------------------
+!
+!***  INDEX INCREMENTS FOR 3RD INDEX IN WORKING ARRAYS IN PFDHT, DDAMP,
+!***  ADVE, AND HDIFF.
+!
+      INTEGER,ALLOCATABLE,DIMENSION(:,:,:) :: INDX3_WRK
+!----------------------------------------------------------------------
+!
+!***  INCREMENTS TO J1_00 IN UPSTREAM HORIZONTAL ADVECTION.
+!
+      INTEGER,DIMENSION(-2:2,-2:2) :: INC_UPS
+!----------------------------------------------------------------------
+!
+!***  NUMBER OF POINTS NEEDED IN EACH ROW FOR UPSTREAM COMPUTATIONS
+!
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: N_IUP_H,N_IUP_V              &
+                                         ,N_IUP_ADH,N_IUP_ADV
+!
+!***  I VALUES IN EACH ROW NEEDED FOR UPSTREAM ADVECTION
+!
+      INTEGER,ALLOCATABLE,DIMENSION(:,:) :: IUP_H,IUP_V,IUP_ADH,IUP_ADV
+!----------------------------------------------------------------------
+
+      CONTAINS
+         SUBROUTINE init_module_indx
+#if 0
+            ALLOCATE(IHE(-2:NMM_MAX_DIM))
+            ALLOCATE(IHW(-2:NMM_MAX_DIM))
+            ALLOCATE(IVE(-2:NMM_MAX_DIM))
+            ALLOCATE(IVW(-2:NMM_MAX_DIM))
+            ALLOCATE(IRAD(-2:NMM_MAX_DIM))
+            ALLOCATE(IHEG(-2:NMM_MAX_DIM))
+            ALLOCATE(IHWG(-2:NMM_MAX_DIM))
+            ALLOCATE(IVEG(-2:NMM_MAX_DIM))
+            ALLOCATE(IVWG(-2:NMM_MAX_DIM))
+            ALLOCATE(IRADG(-2:NMM_MAX_DIM))
+            ALLOCATE(INDX3_WRK(-3:3,1:NMM_MAX_DIM,0:6))
+#endif
+         END SUBROUTINE init_module_indx
+      END MODULE MODULE_INDX
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_MPP.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_MPP.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_MPP.F	(revision 2744)
@@ -0,0 +1,61 @@
+!
+      MODULE MODULE_MPP
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!
+!***  THE RANK OF THIS TASK
+!
+      INTEGER :: MYPE
+!----------------------------------------------------------------------
+!
+!***  NUMBER OF TASKS
+!
+      INTEGER :: INPES,JNPES,NPES
+!
+!***  FUNDAMENTAL GLOBAL AND LOCAL ARRAY EXTENTS ON EACH TASK
+!
+      INTEGER :: MY_IS_GLB,MY_IE_GLB,MY_JS_GLB,MY_JE_GLB               &
+                ,MY_IS_LOC,MY_IE_LOC,MY_JS_LOC,MY_JE_LOC
+!----------------------------------------------------------------------
+!
+!***  SUB-DOMAIN LOOP LIMITS THAT PENETRATE HALOES
+!
+      INTEGER :: MYIS,MYIE,MYJS,MYJE                                   &
+                ,MYIS1,MYIS2,MYIS3,MYIS4,MYIS5                         &
+                ,MYIE1,MYIE2,MYIE3,MYIE4,MYIE5                         &
+                ,MYIS_P1,MYIS_P2,MYIS_P3,MYIS_P4,MYIS_P5               &
+                ,MYIS1_P1,MYIS1_P2,MYIS1_P3,MYIS1_P4,MYIS1_P5          &
+                ,MYIS2_P1,MYIS2_P2,MYIS2_P3,MYIS2_P4,MYIS2_P5          &
+                ,MYIS3_P1,MYIS3_P2,MYIS3_P3,MYIS3_P4,MYIS3_P5          &
+                ,MYIS4_P1,MYIS4_P2,MYIS4_P3,MYIS4_P4,MYIS4_P5          &
+                ,MYIS5_P1,MYIS5_P2,MYIS5_P3,MYIS5_P4,MYIS5_P5          &
+                ,MYIE_P1,MYIE_P2,MYIE_P3,MYIE_P4,MYIE_P5               &
+                ,MYIE1_P1,MYIE1_P2,MYIE1_P3,MYIE1_P4,MYIE1_P5          &
+                ,MYIE2_P1,MYIE2_P2,MYIE2_P3,MYIE2_P4,MYIE2_P5          &
+                ,MYIE3_P1,MYIE3_P2,MYIE3_P3,MYIE3_P4,MYIE3_P5          &
+                ,MYIE4_P1,MYIE4_P2,MYIE4_P3,MYIE4_P4,MYIE4_P5          &
+                ,MYIE5_P1,MYIE5_P2,MYIE5_P3,MYIE5_P4,MYIE5_P5          &
+                ,MYJS1,MYJS2,MYJS3,MYJS4,MYJS5                         &
+                ,MYJE1,MYJE2,MYJE3,MYJE4,MYJE5                         &
+                ,MYJS_P1,MYJS_P2,MYJS_P3,MYJS_P4,MYJS_P5               &
+                ,MYJS1_P1,MYJS1_P2,MYJS1_P3,MYJS1_P4,MYJS1_P5          &
+                ,MYJS2_P1,MYJS2_P2,MYJS2_P3,MYJS2_P4,MYJS2_P5          &
+                ,MYJS3_P1,MYJS3_P2,MYJS3_P3,MYJS3_P4,MYJS3_P5          &
+                ,MYJS4_P1,MYJS4_P2,MYJS4_P3,MYJS4_P4,MYJS4_P5          &
+                ,MYJS5_P1,MYJS5_P2,MYJS5_P3,MYJS5_P4,MYJS5_P5          &
+                ,MYJE_P1,MYJE_P2,MYJE_P3,MYJE_P4,MYJE_P5               &
+                ,MYJE1_P1,MYJE1_P2,MYJE1_P3,MYJE1_P4,MYJE1_P5          &
+                ,MYJE2_P1,MYJE2_P2,MYJE2_P3,MYJE2_P4,MYJE2_P5          &
+                ,MYJE3_P1,MYJE3_P2,MYJE3_P3,MYJE3_P4,MYJE3_P5          &
+                ,MYJE4_P1,MYJE4_P2,MYJE4_P3,MYJE4_P4,MYJE4_P5          &
+                ,MYJE5_P1,MYJE5_P2,MYJE5_P3,MYJE5_P4,MYJE5_P5
+
+!
+!----------------------------------------------------------------------
+!
+!***  MPI_COMM_COMP IS THE INTRACOMMUNICATOR FOR ALL TASKS.
+!
+      INTEGER :: MPI_COMM_COMP
+
+!----------------------------------------------------------------------
+      END MODULE MODULE_MPP
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_MPPINIT.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_MPPINIT.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_MPPINIT.F	(revision 2744)
@@ -0,0 +1,447 @@
+!
+!NCEP_MESO:MEDIATION_LAYER: SET UP DOMAIN DECOMPOSITION VARIABLES
+!
+!
+!----------------------------------------------------------------------
+!
+      MODULE MODULE_MPPINIT
+!
+!----------------------------------------------------------------------
+      USE MODULE_MPP
+!----------------------------------------------------------------------
+!
+      CONTAINS
+!
+!**********************************************************************
+      SUBROUTINE MPPINIT(IDS,IDE,JDS,JDE,KDS,KDE                       &
+                        ,IMS,IME,JMS,JME,KMS,KME                       &
+                        ,IPS,IPE,JPS,JPE,KPS,KPE)
+!**********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    MPPINIT     SET UP DECOMPOSITION VARIABLES
+!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 98-10-28
+!
+! ABSTRACT:
+!     MPPINIT DETERMINES ALL RELEVANT VALUES FOR DIMENSIONS OF THE
+!     DISTRIBUTED SUBDOMAINS AND THEIR HALOES.
+!
+! PROGRAM HISTORY LOG:
+!   97-??-??  MEYS       - ORIGINATOR
+!   97-??-??  BLACK      - CHANGES MADE FOR CLARITY
+!   98-10-29  BLACK      - REWRITTEN FOR CLARITY
+!
+! USAGE: CALL MPPINIT FROM MAIN PROGRAM NCEP_MESO
+!   INPUT ARGUMENT LIST:
+
+!   OUTPUT ARGUMENT LIST:
+!     NONE
+!
+!   OUTPUT FILES:
+!     NONE
+!
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE:
+!        NONE
+!
+!     LIBRARY:
+!        NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+                           ,IMS,IME,JMS,JME,KMS,KME                    &
+                           ,IPS,IPE,JPS,JPE,KPS,KPE
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+
+      CALL wrf_get_myproc ( MYPE )
+      CALL wrf_get_nproc  ( NPES )
+      CALL wrf_get_dm_communicator ( mpi_comm_comp )
+
+!jm
+      MYIS    = MAX( IPS-0, IDS+0 )
+      MYIS_P1 = MAX( IPS-1, IDS+0 )
+      MYIS_P2 = MAX( IPS-2, IDS+0 )
+      MYIS_P3 = MAX( IPS-3, IDS+0 )
+      MYIS_P4 = MAX( IPS-4, IDS+0 )
+      MYIS_P5 = MAX( IPS-5, IDS+0 )
+!
+      MYIS1   = MAX( IPS-0, IDS+1 )
+      MYIS1_P1= MAX( IPS-1, IDS+1 )
+      MYIS1_P2= MAX( IPS-2, IDS+1 )
+      MYIS1_P3= MAX( IPS-3, IDS+1 )
+      MYIS1_P4= MAX( IPS-4, IDS+1 )
+      MYIS1_P5= MAX( IPS-5, IDS+1 )
+!
+      MYIS2   = MAX( IPS-0, IDS+2 )
+      MYIS2_P1= MAX( IPS-1, IDS+2 )
+      MYIS2_P2= MAX( IPS-2, IDS+2 )
+      MYIS2_P3= MAX( IPS-3, IDS+2 )
+      MYIS2_P4= MAX( IPS-4, IDS+2 )
+      MYIS2_P5= MAX( IPS-5, IDS+2 )
+!
+      MYIS3   = MAX( IPS-0, IDS+3 )
+      MYIS3_P1= MAX( IPS-1, IDS+3 )
+      MYIS3_P2= MAX( IPS-2, IDS+3 )
+      MYIS3_P3= MAX( IPS-3, IDS+3 )
+      MYIS3_P4= MAX( IPS-4, IDS+3 )
+      MYIS3_P5= MAX( IPS-5, IDS+3 )
+!
+      MYIS4   = MAX( IPS-0, IDS+4 )
+      MYIS4_P1= MAX( IPS-1, IDS+4 )
+      MYIS4_P2= MAX( IPS-2, IDS+4 )
+      MYIS4_P3= MAX( IPS-3, IDS+4 )
+      MYIS4_P4= MAX( IPS-4, IDS+4 )
+      MYIS4_P5= MAX( IPS-5, IDS+4 )
+!
+      MYIS5   = MAX( IPS-0, IDS+5 )
+      MYIS5_P1= MAX( IPS-1, IDS+5 )
+      MYIS5_P2= MAX( IPS-2, IDS+5 )
+      MYIS5_P3= MAX( IPS-3, IDS+5 )
+      MYIS5_P4= MAX( IPS-4, IDS+5 )
+      MYIS5_P5= MAX( IPS-5, IDS+5 )
+
+!jm
+      MYIE    = MIN( IPE+0, IDE-0 )
+      MYIE_P1 = MIN( IPE+1, IDE-0 )
+      MYIE_P2 = MIN( IPE+2, IDE-0 )
+      MYIE_P3 = MIN( IPE+3, IDE-0 )
+      MYIE_P4 = MIN( IPE+4, IDE-0 )
+      MYIE_P5 = MIN( IPE+5, IDE-0 )
+!
+      MYIE1   = MIN( IPE+0, IDE-1 )
+      MYIE1_P1= MIN( IPE+1, IDE-1 )
+      MYIE1_P2= MIN( IPE+2, IDE-1 )
+      MYIE1_P3= MIN( IPE+3, IDE-1 )
+      MYIE1_P4= MIN( IPE+4, IDE-1 )
+      MYIE1_P5= MIN( IPE+5, IDE-1 )
+!
+      MYIE2   = MIN( IPE+0, IDE-2 )
+      MYIE2_P1= MIN( IPE+1, IDE-2 )
+      MYIE2_P2= MIN( IPE+2, IDE-2 )
+      MYIE2_P3= MIN( IPE+3, IDE-2 )
+      MYIE2_P4= MIN( IPE+4, IDE-2 )
+      MYIE2_P5= MIN( IPE+5, IDE-2 )
+!
+      MYIE3   = MIN( IPE+0, IDE-3 )
+      MYIE3_P1= MIN( IPE+1, IDE-3 )
+      MYIE3_P2= MIN( IPE+2, IDE-3 )
+      MYIE3_P3= MIN( IPE+3, IDE-3 )
+      MYIE3_P4= MIN( IPE+4, IDE-3 )
+      MYIE3_P5= MIN( IPE+5, IDE-3 )
+!
+      MYIE4   = MIN( IPE+0, IDE-4 )
+      MYIE4_P1= MIN( IPE+1, IDE-4 )
+      MYIE4_P2= MIN( IPE+2, IDE-4 )
+      MYIE4_P3= MIN( IPE+3, IDE-4 )
+      MYIE4_P4= MIN( IPE+4, IDE-4 )
+      MYIE4_P5= MIN( IPE+5, IDE-4 )
+!
+      MYIE5   = MIN( IPE+0, IDE-5 )
+      MYIE5_P1= MIN( IPE+1, IDE-5 )
+      MYIE5_P2= MIN( IPE+2, IDE-5 )
+      MYIE5_P3= MIN( IPE+3, IDE-5 )
+      MYIE5_P4= MIN( IPE+4, IDE-5 )
+      MYIE5_P5= MIN( IPE+5, IDE-5 )
+
+!jm
+      MYJS    = MAX( JPS-0, JDS+0 )
+      MYJS_P1 = MAX( JPS-1, JDS+0 )
+      MYJS_P2 = MAX( JPS-2, JDS+0 )
+      MYJS_P3 = MAX( JPS-3, JDS+0 )
+      MYJS_P4 = MAX( JPS-4, JDS+0 )
+      MYJS_P5 = MAX( JPS-5, JDS+0 )
+!
+      MYJS1   = MAX( JPS-0, JDS+1 )
+      MYJS1_P1= MAX( JPS-1, JDS+1 )
+      MYJS1_P2= MAX( JPS-2, JDS+1 )
+      MYJS1_P3= MAX( JPS-3, JDS+1 )
+      MYJS1_P4= MAX( JPS-4, JDS+1 )
+      MYJS1_P5= MAX( JPS-5, JDS+1 )
+!
+      MYJS2   = MAX( JPS-0, JDS+2 )
+      MYJS2_P1= MAX( JPS-1, JDS+2 )
+      MYJS2_P2= MAX( JPS-2, JDS+2 )
+      MYJS2_P3= MAX( JPS-3, JDS+2 )
+      MYJS2_P4= MAX( JPS-4, JDS+2 )
+      MYJS2_P5= MAX( JPS-5, JDS+2 )
+!
+      MYJS3   = MAX( JPS-0, JDS+3 )
+      MYJS3_P1= MAX( JPS-1, JDS+3 )
+      MYJS3_P2= MAX( JPS-2, JDS+3 )
+      MYJS3_P3= MAX( JPS-3, JDS+3 )
+      MYJS3_P4= MAX( JPS-4, JDS+3 )
+      MYJS3_P5= MAX( JPS-5, JDS+3 )
+!
+      MYJS4   = MAX( JPS-0, JDS+4 )
+      MYJS4_P1= MAX( JPS-1, JDS+4 )
+      MYJS4_P2= MAX( JPS-2, JDS+4 )
+      MYJS4_P3= MAX( JPS-3, JDS+4 )
+      MYJS4_P4= MAX( JPS-4, JDS+4 )
+      MYJS4_P5= MAX( JPS-5, JDS+4 )
+!
+      MYJS5   = MAX( JPS-0, JDS+5 )
+      MYJS5_P1= MAX( JPS-1, JDS+5 )
+      MYJS5_P2= MAX( JPS-2, JDS+5 )
+      MYJS5_P3= MAX( JPS-3, JDS+5 )
+      MYJS5_P4= MAX( JPS-4, JDS+5 )
+      MYJS5_P5= MAX( JPS-5, JDS+5 )
+!
+!jm
+      MYJE    = MIN( JPE+0, JDE-0 )
+      MYJE_P1 = MIN( JPE+1, JDE-0 )
+      MYJE_P2 = MIN( JPE+2, JDE-0 )
+      MYJE_P3 = MIN( JPE+3, JDE-0 )
+      MYJE_P4 = MIN( JPE+4, JDE-0 )
+      MYJE_P5 = MIN( JPE+5, JDE-0 )
+!
+      MYJE1   = MIN( JPE+0, JDE-1 )
+      MYJE1_P1= MIN( JPE+1, JDE-1 )
+      MYJE1_P2= MIN( JPE+2, JDE-1 )
+      MYJE1_P3= MIN( JPE+3, JDE-1 )
+      MYJE1_P4= MIN( JPE+4, JDE-1 )
+      MYJE1_P5= MIN( JPE+5, JDE-1 )
+!
+      MYJE2   = MIN( JPE+0, JDE-2 )
+      MYJE2_P1= MIN( JPE+1, JDE-2 )
+      MYJE2_P2= MIN( JPE+2, JDE-2 )
+      MYJE2_P3= MIN( JPE+3, JDE-2 )
+      MYJE2_P4= MIN( JPE+4, JDE-2 )
+      MYJE2_P5= MIN( JPE+5, JDE-2 )
+!
+      MYJE3   = MIN( JPE+0, JDE-3 )
+      MYJE3_P1= MIN( JPE+1, JDE-3 )
+      MYJE3_P2= MIN( JPE+2, JDE-3 )
+      MYJE3_P3= MIN( JPE+3, JDE-3 )
+      MYJE3_P4= MIN( JPE+4, JDE-3 )
+      MYJE3_P5= MIN( JPE+5, JDE-3 )
+!
+      MYJE4   = MIN( JPE+0, JDE-4 )
+      MYJE4_P1= MIN( JPE+1, JDE-4 )
+      MYJE4_P2= MIN( JPE+2, JDE-4 )
+      MYJE4_P3= MIN( JPE+3, JDE-4 )
+      MYJE4_P4= MIN( JPE+4, JDE-4 )
+      MYJE4_P5= MIN( JPE+5, JDE-4 )
+!
+      MYJE5   = MIN( JPE+0, JDE-5 )
+      MYJE5_P1= MIN( JPE+1, JDE-5 )
+      MYJE5_P2= MIN( JPE+2, JDE-5 )
+      MYJE5_P3= MIN( JPE+3, JDE-5 )
+      MYJE5_P4= MIN( JPE+4, JDE-5 )
+      MYJE5_P5= MIN( JPE+5, JDE-5 )
+
+!----------------------------------------------------------------------
+      END SUBROUTINE MPPINIT
+!**********************************************************************
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!jm!**********************************************************************
+!jm!----------------------------------------------------------------------
+!jm!
+!jm!**********************************************************************
+!jm      SUBROUTINE GOSSIP(IDS,IDE,JDS,JDE,KDS,KDE                        &
+!jm                       ,IMS,IME,JMS,JME,KMS,KME                        &
+!jm                       ,ITS,ITE,JTS,JTE,KTS,KTE)
+!jm!**********************************************************************
+!jm!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!jm!                .      .    .
+!jm! SUBPROGRAM:    GOSSIP      EXCHANGE OF FIELDS BETWEEN PROCESSORS
+!jm!   PRGRMMR: BLACK           ORG: W/NP2      DATE: 97-08-30
+!jm!
+!jm! ABSTRACT:
+!jm!     GOSSIP EXCHANGES MANY FIELDS BETWEEN PROCESSORS
+!jm!     IN ORDER TO FILL THE HALOES
+!jm!
+!jm! PROGRAM HISTORY LOG:
+!jm!   97-05-??  MEYS       - ORIGINATOR
+!jm!   98-10-23  BLACK      - MODIFIED FOR CURRENT VERSION OF MODEL 
+!jm!   01-03-21  BLACK      - CONVERTED TO WRF FORMAT
+!jm!
+!jm! USAGE: CALL GOSSIP FROM MAIN PROGRAM EBU
+!jm!   INPUT ARGUMENT LIST:
+!jm!       IMS - TASKS'S STARTING I ADDRESS
+!jm!       IME - TASKS'S ENDING I ADDRESS
+!jm!       JMS - TASKS'S STARTING J ADDRESS
+!jm!       JME - TASKS'S ENDING J ADDRESS
+!jm!       KMS - TASKS'S STARTING K ADDRESS
+!jm!       KME - TASKS'S ENDING K ADDRESS
+!jm!
+!jm!   OUTPUT ARGUMENT LIST:
+!jm!     NONE
+!jm!
+!jm!   OUTPUT FILES:
+!jm!     NONE
+!jm!
+!jm!   SUBPROGRAMS CALLED:
+!jm!
+!jm!     UNIQUE: EXCH
+!jm!
+!jm!     LIBRARY: NONE
+!jm!
+!jm! ATTRIBUTES:
+!jm!   LANGUAGE: FORTRAN 90
+!jm!   MACHINE : IBM SP
+!jm!$$$
+!jm!**********************************************************************
+!jm!----------------------------------------------------------------------
+!jm!
+!jm      IMPLICIT NONE
+!jm!
+!jm!----------------------------------------------------------------------
+!jm      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+!jm                           ,IMS,IME,JMS,JME,KMS,KME                    &
+!jm                           ,ITS,ITE,JTS,JTE,KTS,KTE
+!jm!
+!jm      INTEGER :: J
+!jm!----------------------------------------------------------------------
+!jm!**********************************************************************
+!jm!
+!jm!***  THE NHB ARRAYS
+!jm!
+!jm      CALL EXCH(LMH,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(LMV,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(HBM2,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(HBM3,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(VBM2,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(VBM3,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(SM,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(SICE,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(HTM,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(VTM,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(DX,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(WPDAR,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(CPGFU,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(CURV,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(FCP,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(FDIV,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(FAD,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(F,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(DDMPU,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(DDMPV,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(GLAT,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(GLON,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(EPSR,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(TG,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(GFFC,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(SST,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(ALBASE,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(HDAC,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(HDACV,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(IVGTYP,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(ISLTYP,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(ISLOPE,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH(VEGFRC,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm!
+!jm!***  THE RESTRT FILE ARRAYS
+!jm!
+!jm      CALL EXCH (OMGALF,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (PD,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (RES,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (FIS,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (T,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (U,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (V,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (Q,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (Q2,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CWM,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (TRAIN,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (TCUCN,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (RSWIN,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (RSWOUT,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (TG,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (Z0,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (AKMS,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CZEN,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (AKHS,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (THS,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (QS,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (TWBS,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (QWBS,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (HBOT,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CFRACL,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (THZ0,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (QZ0,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (UZ0,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (VZ0,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (USTAR,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (HTOP,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CFRACM,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SNO,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SI,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CLDEFI,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (RF,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CUPPT,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CFRACH,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SOILTB,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SFCEXC,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SMSTAV,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SMSTOT,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (GRNFLX,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (PCTSNO,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (RLWIN,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (RADOT,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CZMEAN,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SIGT4,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (U00,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (LC,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SR,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (PREC,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ACPREC,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ACCLIQ,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CUPREC,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ACFRCV,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (NCFRCV,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ACFRST,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (NCFRST,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ACSNOW,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ACSNOM,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SSROFF,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (BGROFF,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SFCSHX,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SFCLHX,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SUBSHX,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SNOPCX,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SFCUVX,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SFCEVP,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (POTEVP,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ASWIN,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ASWOUT,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ASWTOA,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ALWIN,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ALWOUT,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ALWTOA,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SMC,NSOIL,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (CMC,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (STC,NSOIL,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (SH2O,NSOIL,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (ALBEDO,1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm!
+!jm      CALL EXCH (PINT,LM+1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (Z,LM+1,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (DWDT,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (TOLD,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (UOLD,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm      CALL EXCH (VOLD,LM,5,5,IMS,IME,JMS,JME,KMS,KME)
+!jm!
+!jm      DO J=MYJS_P4,MYJE_P4
+!jm        IVW(J)=IVWG(J+MY_JS_GLB-1)
+!jm        IVE(J)=IVEG(J+MY_JS_GLB-1)
+!jm        IHE(J)=IHEG(J+MY_JS_GLB-1)
+!jm        IHW(J)=IHWG(J+MY_JS_GLB-1)
+!jm      ENDDO
+!jm!
+!jm!----------------------------------------------------------------------
+!jm      END SUBROUTINE GOSSIP
+!----------------------------------------------------------------------
+      END MODULE MODULE_MPPINIT
+
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_NEST_UTIL.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_NEST_UTIL.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_NEST_UTIL.F	(revision 2744)
@@ -0,0 +1,436 @@
+!
+!NCEP_MESO:MODEL_LAYER: BOUNDARY CONDITION UPDATES
+!
+!----------------------------------------------------------------------
+!
+      MODULE module_NEST_UTIL
+!
+!----------------------------------------------------------------------
+      USE MODULE_MPP
+      USE MODULE_STATE_DESCRIPTION
+      USE MODULE_DM
+!
+!#ifdef DM_PARALLEL
+!      INCLUDE "mpif.h"
+!#endif
+!----------------------------------------------------------------------
+      CONTAINS
+!
+!*********************************************************************************************
+      SUBROUTINE NESTBC_PATCH(PD_B,T_B,Q_B,U_B,V_B,Q2_B,CWM_B                             &
+                             ,PD_BT,T_BT,Q_BT,U_BT,V_BT,Q2_BT,CWM_BT                      & 
+                             ,PDTMP_B,TTMP_B,QTMP_B,UTMP_B,VTMP_B,Q2TMP_B,CWMTMP_B        &
+                             ,PDTMP_BT,TTMP_BT,QTMP_BT,UTMP_BT,VTMP_BT,Q2TMP_BT,CWMTMP_BT &
+                             ,IJDS,IJDE,SPEC_BDY_WIDTH                                    &  ! min/max(id,jd)
+                             ,IDS,IDE,JDS,JDE,KDS,KDE                                     &
+                             ,IMS,IME,JMS,JME,KMS,KME                                     &
+                             ,ITS,ITE,JTS,JTE,KTS,KTE                                     )
+!**********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    PATCH       
+!   PRGRMMR: gopal 
+!     
+! ABSTRACT:
+!         THIS IS JUST A FIX FOR USING NESTED BOUNDARIES IN THE HALLO REGION     
+! PROGRAM HISTORY LOG:
+!   09-23-2004  : gopal 
+!     
+! USAGE: CALL PATCH FROM SUBROUTINE SOLVE_RUNSTREAM FOR NESTED DOMAIN ONLY
+!  
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+!
+
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+                           ,IMS,IME,JMS,JME,KMS,KME                    &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE
+      INTEGER,INTENT(IN) :: IJDS,IJDE,SPEC_BDY_WIDTH
+!
+!
+      REAL,DIMENSION(IJDS:IJDE,1,SPEC_BDY_WIDTH,4)                     &
+                                           ,INTENT(INOUT) :: PD_B,PD_BT
+!
+      REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4)                &
+                                      ,INTENT(INOUT) :: CWM_B,Q_B,Q2_B, &
+                                                        T_B,U_B,V_B 
+      REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4)                &
+                                   ,INTENT(INOUT) :: CWM_BT,Q_BT,Q2_BT, &
+                                                     T_BT,U_BT,V_BT 
+
+      REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: PDTMP_B,PDTMP_BT
+
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),                          &
+                                  INTENT(IN) :: TTMP_B,QTMP_B,UTMP_B,   &
+                                                VTMP_B,Q2TMP_B,CWMTMP_B
+
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),                           &
+                                  INTENT(IN) :: TTMP_BT,QTMP_BT,UTMP_BT, &
+                                                VTMP_BT,Q2TMP_BT,CWMTMP_BT
+!
+!----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+      LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY
+      INTEGER :: I,J,K,IBDY,II,JJ,IB,JB,IIM,JJM,BF
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+      W_BDY=(ITS==IDS)
+      E_BDY=(ITE==IDE)
+      S_BDY=(JTS==JDS)
+      N_BDY=(JTE==JDE)
+
+!----------------------------------------------------------------------
+!***  WEST AND EAST BOUNDARIES
+!----------------------------------------------------------------------
+!
+!***  USE IBDY=1 FOR WEST; 2 FOR EAST.
+
+!      WRITE(0,*)'WESTERN BC FOR PATCH',IDS,MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
+!
+
+      DO IBDY=1,2
+!
+!***  MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
+!
+        IF((W_BDY.AND.IBDY.EQ.1).OR.(E_BDY.AND.IBDY.EQ.2))THEN
+          IF(IBDY.EQ.1)THEN
+            BF=P_XSB     ! Which boundary (XSB=the boundary where X is at its start)
+            IB=1         ! Which cell in from boundary
+            II=1         ! Which cell in the domain
+          ELSE
+            BF=P_XEB     ! Which boundary (XEB=the boundary where X is at its end)
+            IB=1         ! Which cell in from boundary
+            II=IDE       ! Which cell in the domain
+          ENDIF
+
+          DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
+             IF(MOD(J,2).EQ.1)THEN                 ! J=3,5,7,9
+                PD_B(J,1,IB,BF)  =PDTMP_B(II,J)
+                PD_BT(J,1,IB,BF) =PDTMP_BT(II,J)
+             ENDIF
+          ENDDO
+
+!
+          DO K=KTS,KTE
+            DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)  
+              IF(MOD(J,2).EQ.1)THEN                  ! J=3,5,7,9
+                T_B(J,K,IB,BF)    = TTMP_B(II,K,J)
+                T_BT(J,K,IB,BF)   = TTMP_BT(II,K,J)
+                Q_B(J,K,IB,BF)    = QTMP_B(II,K,J)
+                Q_BT(J,K,IB,BF)   = QTMP_BT(II,K,J)
+                Q2_B(J,K,IB,BF)   = Q2TMP_B(II,K,J)
+                Q2_BT(J,K,IB,BF)  = Q2TMP_BT(II,K,J)
+                CWM_B(J,K,IB,BF)  = CWMTMP_B(II,K,J)
+                CWM_BT(J,K,IB,BF) = CWMTMP_BT(II,K,J)
+              ENDIF
+            ENDDO
+          ENDDO
+
+          DO K=KTS,KTE
+            DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1)   
+              IF(MOD(J,2).EQ.0)THEN                  ! J=2,4,6,8  
+                U_B(J,K,IB,BF)    = UTMP_B(II,K,J)
+                U_BT(J,K,IB,BF)   = UTMP_BT(II,K,J)
+                V_B(J,K,IB,BF)    = VTMP_B(II,K,J)
+                V_BT(J,K,IB,BF)   = VTMP_BT(II,K,J)
+              ENDIF
+            ENDDO
+          ENDDO
+
+        ENDIF
+      ENDDO
+!
+!----------------------------------------------------------------------
+!***  SOUTH AND NORTH BOUNDARIES
+!----------------------------------------------------------------------
+!
+!***  USE IBDY=1 FOR SOUTH; 2 FOR NORTH
+!
+      DO IBDY=1,2
+!
+!***  MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
+!
+        IF((S_BDY.AND.IBDY.EQ.1).OR.(N_BDY.AND.IBDY.EQ.2))THEN
+!
+          IF(IBDY.EQ.1)THEN
+            BF=P_YSB     ! Which boundary (YSB=the boundary where Y is at its start)
+            JB=1         ! Which cell in from boundary
+            JJ=1         ! Which cell in the domain
+          ELSE
+            BF=P_YEB      ! Which boundary (YEB=the boundary where Y is at its end)
+            JB=1          ! Which cell in from boundary
+            JJ=JDE        ! Which cell in the domain
+          ENDIF
+!
+          DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+            PD_B(I,1,JB,BF) = PDTMP_B(I,JJ)
+            PD_BT(I,1,JB,BF)= PDTMP_BT(I,JJ)
+          ENDDO
+
+!
+          DO K=KTS,KTE
+            DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+              T_B(I,K,JB,BF)   = TTMP_B(I,K,JJ)
+              T_BT(I,K,JB,BF)  = TTMP_BT(I,K,JJ)
+              Q_B(I,K,JB,BF)   = QTMP_B(I,K,JJ)
+              Q_BT(I,K,JB,BF)  = QTMP_BT(I,K,JJ)
+              Q2_B(I,K,JB,BF)  = Q2TMP_B(I,K,JJ)
+              Q2_BT(I,K,JB,BF) = Q2TMP_BT(I,K,JJ) 
+              CWM_B(I,K,JB,BF) = CWMTMP_B(I,K,JJ)
+              CWM_BT(I,K,JB,BF)= CWMTMP_BT(I,K,JJ)
+            ENDDO
+          ENDDO
+
+          DO K=KTS,KTE
+           DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
+              U_B(I,K,JB,BF)   = UTMP_B(I,K,JJ)
+              U_BT(I,K,JB,BF)  = UTMP_BT(I,K,JJ)
+              V_B(I,K,JB,BF)   = VTMP_B(I,K,JJ)
+              V_BT(I,K,JB,BF)  = VTMP_BT(I,K,JJ)
+           ENDDO
+          ENDDO
+
+        ENDIF
+      ENDDO
+END  SUBROUTINE NESTBC_PATCH 
+
+!----------------------------------------------------------------------
+!
+SUBROUTINE STATS_FOR_MOVE (XLOC,YLOC,PDYN,MSLP,SQWS              &
+                          ,PINT,T,Q,U,V                          &
+                          ,FIS,PD,SM,PDTOP,PTOP                  &
+                          ,DETA1,DETA2                           &
+                          ,MOVED,MVNEST,NTSD,NPHS                &
+                          ,IDS,IDE,JDS,JDE,KDS,KDE               &
+                          ,IMS,IME,JMS,JME,KMS,KME               &
+                          ,ITS,ITE,JTS,JTE,KTS,KTE               )
+
+!**********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:  STATS_FOR_MOVE  
+!   PRGRMMR: gopal
+!
+! ABSTRACT:
+!         THIS ROUTINE COMPUTES SOME STATS REQUIRED FOR AUTOMATIC GRID MOTION 
+! PROGRAM HISTORY LOG:
+!   05-18-2005  : gopal
+!
+! USAGE: CALL STATS_FOR_MOVE FROM SUBROUTINE SOLVE_RUNSTREAM FOR NESTED DOMAIN ONLY
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!**********************************************************************
+
+      USE MODULE_MODEL_CONSTANTS
+      USE MODULE_DM 
+
+      IMPLICIT NONE
+!
+      LOGICAL,EXTERNAL                                      :: wrf_dm_on_monitor
+      LOGICAL,INTENT(INOUT)                                 :: MVNEST  ! NMM SWITCH FOR GRID MOTION
+      LOGICAL,INTENT(IN)                                    :: MOVED   
+      INTEGER,INTENT(IN)                                    :: IDS,IDE,JDS,JDE,KDS,KDE   &
+                                                              ,IMS,IME,JMS,JME,KMS,KME   &
+                                                              ,ITS,ITE,JTS,JTE,KTS,KTE   &
+                                                              ,NTSD,NPHS
+!
+      INTEGER, INTENT(OUT)                                  :: XLOC,YLOC
+      REAL, DIMENSION(KMS:KME),                 INTENT(IN)  :: DETA1,DETA2 
+      REAL,                                     INTENT(IN)  :: PDTOP,PTOP
+      REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(IN)  :: FIS,PD,SM
+      REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(IN)  :: PINT,T,Q,U,V
+      REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(OUT) :: PDYN,MSLP,SQWS
+!
+!     LOCAL
+
+      INTEGER,SAVE                                          :: NTIME0
+      INTEGER                                               :: IM,JM,IP,JP
+      INTEGER                                               :: I,K,J,XR,YR,DTMOVE,IDUM,JDUM,ITF,JTF
+      REAL, PARAMETER                                       :: LAPSR=6.5E-3, GI=1./G,D608=0.608
+      REAL, PARAMETER                                       :: COEF3=287.05*GI*LAPSR, COEF2=-1./COEF3
+      REAL, PARAMETER                                       :: TRG=2.0*R_D*GI,LAPSI=1.0/LAPSR
+      REAL                                                  :: DZ,RTOPP,APELP,A,TSFC,STMP0,STMP1
+      REAL                                                  :: SMSUM,SMOUT,XDIFF,YDIFF,PCUT,PGR
+      REAL                                                  :: MINGBL_PDYN,MAXGBL_PDYN,MAXGBL_SQWS
+      REAL                                                  :: MINGBL_MIJ
+      REAL, DIMENSION(IMS:IME,JMS:JME)                      :: MIJ
+      REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME)              :: Z
+
+!    EXEC 
+
+     ITF=MIN(ITE,IDE-1)
+     JTF=MIN(JTE,JDE-1)     
+
+!----------------------------------------------------------------------------------
+
+!     KEEP NEST MOTION IN SINK WITH PHYSICS TIME STEPS
+
+      IF(MOD(NTSD+1,NPHS)/=0)THEN
+        MVNEST=.FALSE.
+        RETURN
+      ENDIF
+
+      WRITE(0,*)'PHYSICS IN SINK',NTSD,NPHS
+
+!     DETERMINE THE HEIGHTS ON THE PARENT DOMAIN
+
+      DO J = JTS, MIN(JTE,JDE)
+       DO I = ITS, MIN(ITE,IDE)
+         Z(I,1,J)=FIS(I,J)*GI
+       ENDDO
+      ENDDO
+!
+      DO J = JTS, MIN(JTE,JDE)
+       DO K = KTS,KTE
+        DO I = ITS, MIN(ITE,IDE)
+          APELP      = (PINT(I,K+1,J)+PINT(I,K,J))
+          RTOPP      = TRG*T(I,K,J)*(1.0+Q(I,K,J)*P608)/APELP
+          DZ         = RTOPP*(DETA1(K)*PDTOP+DETA2(K)*PD(I,J)) 
+          Z(I,K+1,J) = Z(I,K,J) + DZ
+        ENDDO
+       ENDDO
+      ENDDO
+
+!     DETERMINE THE MEAN SEA LEVEL PRESSURE, THE VERTICALLY AVERAGED WIND
+!     SPEED AT ABOUT LEVELS 9 10 AND 11 AND THE DYNAMIC PRESSURES DEFINED
+!     FROM BASIC BERNOULLI's THEOREM
+
+      DO J = JTS, MIN(JTE,JDE)
+        DO I = ITS, MIN(ITE,IDE)
+            TSFC      = T(I,1,J)*(1.+D608*Q(I,1,J)) + LAPSR*(Z(I,1,J)+Z(I,2,J))*0.5
+            A         = LAPSR*Z(I,1,J)/TSFC
+            MSLP(I,J) = PINT(I,1,J)*(1-A)**COEF2
+            SQWS(I,J) =  (U(I,9,J)*U(I,9,J) + V(I,9,J)*V(I,9,J)           &
+                      +   U(I,10,J)*U(I,10,J) + V(I,10,J)*V(I,10,J)       &
+                      +   U(I,11,J)*U(I,11,J) + V(I,11,J)*V(I,11,J))/3.0
+            PDYN(I,J) =   MSLP(I,J)  + 1.1*SQWS(I,J)/2.0
+        ENDDO
+      ENDDO
+
+!     FILTER OUT PDYN AND STORE THAT IN MIJ. THE MAXIMUM VALUE OF MIJ GIVES THE STORM CENTER
+!     ALSO DO THAT WITHIN A SUB DOMAIN
+
+      MAXGBL_PDYN=MAXVAL(PDYN(ITS:ITF,JTS:JTF))       
+      CALL WRF_DM_MAXVAL(MAXGBL_PDYN,IDUM,JDUM)    
+      MINGBL_PDYN=MINVAL(PDYN(ITS:ITF,JTS:JTF))
+      CALL WRF_DM_MINVAL(MINGBL_PDYN,IDUM,JDUM)            
+      PCUT = 0.5*(MAXGBL_PDYN + MINGBL_PDYN)
+!
+      IM=IDE/2 - IDE/6 
+      IP=IDE/2 + IDE/6
+      JM=JDE/2 - JDE/4
+      JP=JDE/2 + JDE/4
+!
+      DO J = JTS, MIN(JTE,JDE)
+        DO I = ITS, MIN(ITE,IDE)
+          IF(I .GE. IM .AND. I .LE. IP .AND. J .GE. JM .AND. J .LE. JP  &
+                       .AND. PCUT .GT. PDYN(I,J))THEN
+             MIJ(I,J) = PDYN(I,J)   
+          ELSE
+             MIJ(I,J) = 105000. 
+          ENDIF
+        ENDDO
+      ENDDO
+
+      DO J = JTS, MIN(JTE,JDE)
+        DO I = ITS, MIN(ITE,IDE)
+          PDYN(I,J)=MIJ(I,J) 
+        ENDDO
+      ENDDO
+
+!     DETERMINE THE LOCATION OF CENTER OF THE CIRCULATION DEFINED BY MIJ AND FIND THE CORRESPONDING MSLP 
+
+      MINGBL_MIJ=MINVAL(MIJ(ITS:ITF,JTS:JTF))
+      DO J = JTS, MIN(JTE,JDE)
+        DO I = ITS, MIN(ITE,IDE)
+           IF(MIJ(I,J) .EQ. MINGBL_MIJ)THEN
+             XLOC=I
+             YLOC=J
+             STMP0=MSLP(I,J)
+           ENDIF
+        ENDDO
+      ENDDO
+
+      CALL WRF_DM_MINVAL(MINGBL_MIJ,XLOC,YLOC)
+      CALL WRF_DM_MINVAL(STMP0,IDUM,JDUM)
+
+!     DETERMINE THE MAXIMUM MSLP AT ABOUT 18 GRID POINTS AWAY FROM THE STORM CENTER 
+
+      DO J = JTS, MIN(JTE,JDE)
+        DO I = ITS, MIN(ITE,IDE)
+           IF(I .EQ. XLOC+18)THEN
+             XR=I
+             YR=J
+             STMP1=MSLP(I,J)
+           ENDIF
+        ENDDO
+      ENDDO
+
+      CALL WRF_DM_MAXVAL(STMP1,XR,YR)
+
+!
+!     DETERMINE IF THE ENTIRE NESTED DOMAIN IS OVER LAND (SM=0)
+!
+
+      SMSUM = 0.0
+      DO J = JTS, MIN(JTE,JDE)
+       DO I = ITS, MIN(ITE,IDE)
+         SMSUM = SMSUM + SM(I,J)
+       ENDDO
+      ENDDO
+
+      SMOUT=WRF_DM_SUM_REAL(SMSUM)/(IDE*JDE)
+
+!     STOP GRID MOTION. AVOID MOVING TOO RAPID GRID MOTION, SAY SOMETHING LIKE EVERY
+!     OTHER TIME STEP OR SO  
+
+      PGR=STMP1-STMP0
+      XDIFF=ABS(XLOC - IDE/2)
+      YDIFF=ABS(YLOC - JDE/2)
+      IF(NTSD==0 .OR. MOVED)NTIME0=NTSD 
+      DTMOVE=NTSD-NTIME0                    ! TIME INTERVAL SINCE THE PREVIOUS MOVE
+!
+      IF(DTMOVE .LE. 45 .OR. PGR .LE. 200.)THEN       
+        WRITE(0,*)'SUSPEND MOTION: SMALL DTMOVE OR WEAK PGF:','DTMOVE=',DTMOVE,'PGR=',PGR 
+        MVNEST=.FALSE.                               ! SET STATIC GRID
+      ELSE IF(STMP0 .GE. STMP1)THEN
+        WRITE(0,*)'SUSPEND MOTION: THERE IS NO VORTEX IN THE DOMAIN:','STMP0=',STMP0,'STMP1=',STMP1
+        MVNEST=.FALSE.
+      ELSE IF(XDIFF .GT. 24 .OR. YDIFF .GT. 24)THEN
+        WRITE(0,*)'SUSPEND MOTION: LOST VORTEX ','DTMOVE=',DTMOVE,'XDIFF=',XDIFF,'YDIFF=',YDIFF
+        MVNEST=.FALSE.
+      ELSE IF(SMOUT .LE. 0.2 .AND. XDIFF .GT. 12 .AND. YDIFF .GT. 12)THEN  
+        WRITE(0,*)'SUSPEND MOTION: VORTEX LOST OVER LAND ','DTMOVE=',DTMOVE,'XDIFF=',XDIFF,'YDIFF=',YDIFF
+        MVNEST=.FALSE. 
+      ELSE IF(SMOUT .LE. 0.2 .AND. PGR .LE. 400.)THEN
+        WRITE(0,*)'SUSPEND MOTION: VORTEX WEAK OVER LAND ','SMOUT=',SMOUT,'PGR=',PGR
+        MVNEST=.FALSE.
+      ELSE IF(SMOUT .LE. 0.2 .AND. DTMOVE .GE. 1500)THEN
+        WRITE(0,*)'SUSPEND MOTION: STOP MOTION  OVER LAND','SMOUT=',SMOUT,'DTMOVE=',DTMOVE
+        MVNEST=.FALSE.
+      ELSE
+        MVNEST=.TRUE.
+      ENDIF
+
+      RETURN
+
+END SUBROUTINE STATS_FOR_MOVE
+!----------------------------------------------------------------------------------
+
+END  MODULE module_NEST_UTIL
+
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_NONHY_DYNAM.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_NONHY_DYNAM.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_NONHY_DYNAM.F	(revision 2744)
@@ -0,0 +1,1047 @@
+!----------------------------------------------------------------------
+!
+!NCEP_MESO:MODEL_LAYER: NONHYDROSTATIC DYNAMICS ROUTINES
+!
+!----------------------------------------------------------------------
+!
+#include "nmm_loop_basemacros.h"
+#include "nmm_loop_macros.h"
+!
+!----------------------------------------------------------------------
+!
+      MODULE MODULE_NONHY_DYNAM
+!
+!----------------------------------------------------------------------
+      USE MODULE_MODEL_CONSTANTS
+!     USE MODULE_INDX
+!----------------------------------------------------------------------
+!
+      REAL :: CAPA=R_D/CP,RG=1./G,TRG=2.*R_D/G
+!
+      CONTAINS
+!
+!***********************************************************************
+      SUBROUTINE EPS(NTSD,DT,HYDRO,DX,DY,FAD                            &
+                    ,DETA1,DETA2,PDTOP,PT                               &
+                    ,HTM,HBM2,HBM3,LMH                                  &
+                    ,PDSL,PDSLO,PINT,RTOP,PETDT,PDWDT                   &
+                    ,DWDT,DWDTMN,DWDTMX                                 &
+                    ,FNS,FEW,FNE,FSE                                    &
+                    ,T,U,V,W,Q,CWM                                      &
+                    ,IHE,IHW,IVE,IVW,INDX3_WRK                          &
+                    ,IDS,IDE,JDS,JDE,KDS,KDE                            &
+                    ,IMS,IME,JMS,JME,KMS,KME                            &
+                    ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    EPS
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 9?-??-??
+!
+! ABSTRACT:
+!     EPS COMPUTES THE VERTICAL AND HORIZONTAL ADVECTION OF DZ/DT
+!
+! PROGRAM HISTORY LOG:
+!   9?-??-??  JANJIC     - ORIGINATOR
+!   00-01-05  BLACK      - DISTRIBUTED MEMORY AND THREADS
+!   02-02-07  BLACK      - CONVERTED TO WRF STRUCTURE
+!   04-11-22  BLACK      - THREADED
+!
+! USAGE: CALL EPS FROM SUBROUTINE SOLVE_RUNSTREAM
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST:
+!
+!   OUTPUT FILES:
+!     NONE
+!
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+#ifdef DM_PARALLEL
+      INCLUDE "mpif.h"
+#endif
+!
+!-----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+                           ,IMS,IME,JMS,JME,KMS,KME                     &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE 
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!
+!-----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-----------------------------------------------------------------------
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: DT,DY,PDTOP,PT
+!
+      REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DWDTMN,DWDTMX,DX    &
+                                                   ,FAD,HBM2,HBM3       &
+                                                   ,PDSL,PDSLO
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: CWM         &
+                                                           ,FEW,FNE     &
+                                                           ,FNS,FSE     &
+                                                           ,HTM,Q       &
+                                                           ,RTOP        &
+                                                           ,U,V
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DWDT     &
+                                                              ,PDWDT    &
+                                                              ,T
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: PINT,W
+!
+      LOGICAL,INTENT(IN) :: HYDRO
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,PARAMETER :: NTSHY=2
+!
+      REAL,PARAMETER :: WGHT=0.35,WP=0.
+!
+      INTEGER,DIMENSION(KTS:KTE) :: LA
+!
+      INTEGER :: I,J,J4_00,J4_M1,J4_P1,J5_00,J5_M1,J6_00,J6_P1          &
+                ,JEND,JJ,JKNT,JSTART,K,KOFF,LMP
+!
+      REAL,DIMENSION(KTS:KTE) :: B1,B2,B3,C0,CWM_K,DWDT_K,Q_K,RDPP      &
+                                ,RTOP_K,T_K
+!
+      REAL,DIMENSION(KTS:KTE+1) :: CHI,COFF,PINT_K,PNP1,PONE,PSTR,W_K
+!
+      REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: TTB
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: WEW
+!
+      REAL :: ADDT,DELP,DETAL,DP,DPDE,DPPL,DPSTR,DPTL,DPTU              &
+             ,DWDTT,EPSN,FCT,FFC,GDT,GDT2                               &
+             ,HBM3IJ,HM,PP1,PSTRDN,PSTRUP,RDP,RDPDN,RDPUP,RDT           &
+             ,TFC,TMP,TTAL,TTFC
+!
+      LOGICAL :: BOT,TOP
+!
+!***  TYPE 4 WORKING ARRAY (SEE PFDHT)
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: WNS
+!
+!***  TYPE 5 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:0) :: WNE
+!
+!***  TYPE 6 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE, 0:1) :: WSE
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+      IF(NTSD<=NTSHY.OR.HYDRO)THEN
+!***
+        DO J=MYJS_P2,MYJE_P2
+        DO I=MYIS_P1,MYIE_P1
+          PINT(I,KTE+1,J)=PT
+        ENDDO
+        ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+        DO J=MYJS_P2,MYJE_P2
+          DO K=KTS,KTE
+          DO I=MYIS_P1,MYIE_P1
+            DWDT(I,K,J)=1.
+            PDWDT(I,K,J)=1.
+          ENDDO
+          ENDDO
+        ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+        DO J=MYJS_P2,MYJE_P2
+          DO K=KTE,KTS,-1
+          DO I=MYIS_P1,MYIE_P1
+            PINT(I,K,J)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)+PINT(I,K+1,J)
+          ENDDO
+          ENDDO
+        ENDDO
+!***
+        RETURN
+!***
+      ENDIF
+!-----------------------------------------------------------------------
+      ADDT=DT
+      RDT=1./ADDT
+!-----------------------------------------------------------------------
+!
+!***  TIME TENDENCY
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS_P1,MYJE_P1
+        DO K=KTS,KTE
+        DO I=MYIS_P1,MYIE_P1
+          DWDT(I,K,J)=(W(I,K,J)-DWDT(I,K,J))*HTM(I,K,J)*HBM2(I,J)*RDT
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***
+!***  VERTICAL ADVECTION
+!***
+!-----------------------------------------------------------------------
+      DO J=MYJS2,MYJE2
+      DO I=MYIS,MYIE
+        TTB(I,J)=0.
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k,ttal)
+      DO J=MYJS2,MYJE2
+      DO K=KTE,KTS+1,-1
+      DO I=MYIS,MYIE
+        TTAL=(W(I,K-1,J)-W(I,K,J))*PETDT(I,K-1,J)*0.5
+        DWDT(I,K,J)=(TTAL+TTB(I,J))                                     &
+                   /(DETA1(K)*PDTOP+DETA2(K)*PDSLO(I,J))                &
+                    +DWDT(I,K,J)
+        TTB(I,J)=TTAL
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS2,MYJE2
+      DO I=MYIS1,MYIE1
+        TTB(I,J)=(W(I,KTS,J)-W(I,KTS+1,J))*PETDT(I,KTS,J)*0.5
+        DWDT(I,KTS,J)=TTB(I,J)/(DETA1(KTS)*PDTOP+DETA2(KTS)*PDSLO(I,J)) &
+                     +DWDT(I,KTS,J)
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!***
+!***  END OF VERTICAL ADVECTION
+!***
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***
+!***  HORIZONTAL ADVECTION
+!***
+!-----------------------------------------------------------------------
+!***  MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
+!***  FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
+!***  IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J
+!-----------------------------------------------------------------------
+!
+      JSTART=MYJS3
+!
+      DO J=-1,0
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          WNS(I,K,J)=FNS(I,K,JJ)*(W(I,K,JJ+1)-W(I,K,JJ-1))
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+      J=-1
+      JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+      DO K=KTS,KTE
+      DO I=MYIS_P2,MYIE1_P2
+        WNE(I,K,J)=FNE(I,K,JJ)*(W(I+IHE(JJ),K,JJ+1)-W(I,K,JJ))
+      ENDDO
+      ENDDO
+!
+      J=0
+      JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+      DO K=KTS,KTE
+      DO I=MYIS_P2,MYIE1_P2
+        WSE(I,K,J)=FSE(I,K,JJ)*(W(I+IHE(JJ),K,JJ-1)-W(I,K,JJ))
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      JKNT=0
+      JSTART=MYJS3
+      JEND  =MYJE3
+!
+      main_horizontal:  DO J=JSTART,JEND
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!***
+!***  SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
+!***                                           AND PFDHT DIAGRAMS)
+!***
+!***  J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
+!***  LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
+!***  NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
+!***  THE CURRENT VALUE OF THE main_integration LOOP.
+!***  (P3 denotes +3, M1 denotes -1, etc.)
+!***
+      JKNT=JKNT+1
+!
+      J4_P1=INDX3_WRK(1,JKNT,4)
+      J4_00=INDX3_WRK(0,JKNT,4)
+      J4_M1=INDX3_WRK(-1,JKNT,4)
+!
+      J5_00=INDX3_WRK(0,JKNT,5)
+      J5_M1=INDX3_WRK(-1,JKNT,5)
+!
+      J6_P1=INDX3_WRK(1,JKNT,6)
+      J6_00=INDX3_WRK(0,JKNT,6)
+!
+!-----------------------------------------------------------------------
+!***  THE WORKING ARRAYS FOR THE PRIMARY VARIABLES
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dpde,i,k)
+      DO K=KTS,KTE
+!
+      DO I=MYIS_P3,MYIE_P3
+        WEW(I,K)=FEW(I,K,J)*(W(I+IVE(J),K,J)-W(I+IVW(J),K,J))
+        WNS(I,K,J4_P1)=FNS(I,K,J+1)*(W(I,K,J+2)-W(I,K,J))
+      ENDDO
+!
+!***  DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND
+!
+      DO I=MYIS_P2,MYIE1_P2
+        WNE(I,K,J5_00)=FNE(I,K,J)*(W(I+IHE(J),K,J+1)-W(I,K,J))
+        WSE(I,K,J6_P1)=FSE(I,K,J+1)*(W(I+IHE(J+1),K,J)-W(I,K,J+1))
+      ENDDO
+!-----------------------------------------------------------------------
+!
+      DO I=MYIS2,MYIE2
+        DPDE=DETA1(K)*PDTOP+DETA2(K)*PDSLO(I,J)
+        DWDT(I,K,J)=-(WEW(I+IHW(J),K)      +WEW(I+IHE(J),K)             &
+                     +WNS(I,K,J4_M1)       +WNS(I,K,J4_P1)              &
+                     +WNE(I+IHW(J),K,J5_M1)+WNE(I,K,J5_00)              &
+                     +WSE(I,K,J6_00)       +WSE(I+IHW(J),K,J6_P1))      &
+                     *FAD(I,J)*HTM(I,K,J)*HBM3(I,J)/(DPDE*DT)           &
+                     +DWDT(I,K,J)
+      ENDDO
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!
+      ENDDO main_horizontal
+!
+!-----------------------------------------------------------------------
+!***
+!***  END OF HORIZONTAL ADVECTION
+!***
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(dwdtt,i,j,k)
+      DO J=MYJS,MYJE
+      DO K=KTS,KTE
+      DO I=MYIS,MYIE
+        DWDTT=DWDT(I,K,J)*HTM(I,K,J)
+        DWDTT=MAX(DWDTT,DWDTMN(I,J))
+        DWDTT=MIN(DWDTT,DWDTMX(I,J))
+!
+        DWDT(I,K,J)=(DWDTT*RG+1.)*(1.-WP)+PDWDT(I,K,J)*WP
+      ENDDO
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+      GDT=G*DT
+      GDT2=GDT*GDT
+      FFC=-R_D/GDT2
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(b1,b2,b3,c0,chi,coff,cwm_k,delp,dppl,dpstr,dptl,dptu,    &
+!$omp&         dwdt_k,fct,hbm3ij,i,j,k,koff,pint_k,pnp1,pone,pp1,pstr,  &
+!$omp&         pstrdn,pstrup,q_k,rdpdn,rdpp,rdpup,rtop_k,t_k,tfc,       &
+!$omp&         tmp,ttfc,w_k)
+      final_update:  DO J=MYJS3,MYJE3
+!
+      PONE(KTE+1)=PT
+      PSTR(KTE+1)=PT
+      PNP1(KTE+1)=PT
+      CHI(KTE+1)=0.
+!
+      DO I=MYIS2,MYIE2
+!
+!-----------------------------------------------------------------------
+!
+!***  EXTRACT COLUMNS FROM 3-D ARRAYS
+!
+        DO K=KTS,KTE
+          CWM_K(K)=CWM(I,K,J)
+          DWDT_K(K)=DWDT(I,K,J)
+          Q_K(K)=Q(I,K,J)
+          RTOP_K(K)=RTOP(I,K,J)
+          T_K(K)=T(I,K,J)
+        ENDDO
+!
+        DO K=KTS,KTE+1
+          PINT_K(K)=PINT(I,K,J)
+          W_K(K)=W(I,K,J)
+        ENDDO
+!-----------------------------------------------------------------------
+!
+        KOFF=KTE-LMH(I,J)
+!
+        DO K=KTE,KOFF+1,-1
+          CHI(K)=0.
+          DPPL=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
+          RDPP(K)=1./DPPL
+          PONE(K)=PINT_K(K)
+          DPSTR=DWDT_K(K)*DPPL
+          PSTR(K)=PSTR(K+1)+DPSTR
+          PP1=PNP1(K+1)+DPSTR
+          PNP1(K)=(PP1-PONE(K))*WGHT+PONE(K)
+          TFC=Q_K(K)*P608+(1.-CWM_K(K))
+          TTFC=-CAPA*TFC+1.
+          COFF(K)=T_K(K)*TTFC*TFC*DPPL*FFC                              &
+                   /((PNP1(K+1)+PNP1(K))*(PNP1(K+1)+PNP1(K)))
+        ENDDO
+!-----------------------------------------------------------------------
+!
+        PSTRUP=-(PSTR(KTE+1)+PSTR(KTE)-PONE(KTE+1)-PONE(KTE))*COFF(KTE)
+!
+!-----------------------------------------------------------------------
+        DO K=KTE-1,KOFF+1,-1
+          RDPDN=RDPP(K)
+          RDPUP=RDPP(K+1)
+!
+          PSTRDN=-(PSTR(K+1)+PSTR(K)-PONE(K+1)-PONE(K))*COFF(K)
+!
+          B1(K)=COFF(K+1)+RDPUP
+          B2(K)=(COFF(K+1)+COFF(K))-(RDPUP+RDPDN)
+          B3(K)=COFF(K)+RDPDN
+          C0(K)=PSTRUP+PSTRDN
+!
+          PSTRUP=PSTRDN
+        ENDDO
+!-----------------------------------------------------------------------
+        B1(KTE-1)=0.
+        B2(KOFF+1)=B2(KOFF+1)+B3(KOFF+1)
+!-----------------------------------------------------------------------
+!
+!***  ELIMINATION
+!
+        DO K=KTE-2,KOFF+1,-1
+          TMP=-B1(K)/B2(K+1)
+          B2(K)=B3(K+1)*TMP+B2(K)
+          C0(K)=C0(K+1)*TMP+C0(K)
+        ENDDO
+!
+        CHI(KTE+1)=0.
+!-----------------------------------------------------------------------
+!
+!***  BACK SUBSTITUTION
+!
+        CHI(KOFF+2)=C0(KOFF+1)/B2(KOFF+1)
+        CHI(KOFF+1)=CHI(KOFF+2)
+!
+        DO K=KOFF+3,KTE
+          CHI(K)=(-B3(K-1)*CHI(K-1)+C0(K-1))/B2(K-1)
+        ENDDO
+!-----------------------------------------------------------------------
+        HBM3IJ=HBM3(I,J)
+        DPTU=0.
+        FCT=0.5/CP*HBM3IJ
+!
+        DO K=KTE,KOFF+1,-1
+          DPTL=(CHI(K)+PSTR(K)-PINT_K(K))*HBM3IJ
+          PINT_K(K)=PINT_K(K)+DPTL
+          T_K(K)=(DPTU+DPTL)*RTOP_K(K)*FCT+T_K(K)
+          DELP=(PINT_K(K)-PINT_K(K+1))*RDPP(K)
+          W_K(K)=((DELP-DWDT_K(K))*GDT+W_K(K))*HBM3IJ
+          DWDT_K(K)=(DELP-1.)*HBM3IJ+1.
+!
+          DPTU=DPTL
+        ENDDO
+!-----------------------------------------------------------------------
+        DO K=KOFF+1,KTE
+          PINT(I,K,J)=PINT_K(K)
+          T(I,K,J)=T_K(K)
+          W(I,K,J)=W_K(K)
+          DWDT(I,K,J)=DWDT_K(K)
+        ENDDO
+!-----------------------------------------------------------------------
+!
+      ENDDO
+!
+      ENDDO final_update
+!
+!-----------------------------------------------------------------------
+!
+      END SUBROUTINE EPS
+!
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE VADZ(NTSD,DT,FIS,SIGMA,DFL,HTM,HBM2                    &
+                     ,DETA1,DETA2,PDTOP                                 &
+                     ,PINT,PDSL,PDSLO,PETDT                             &
+                     ,RTOP,T,Q,CWM,Z,W,DWDT,PDWDT                       &
+                     ,IHE,IHW,IVE,IVW,INDX3_WRK                         &
+                     ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+                     ,IMS,IME,JMS,JME,KMS,KME                           &
+                     ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    VADZ        VERTICAL ADVECTION OF HEIGHT
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 93-11-17
+!     
+! ABSTRACT:
+!     VADV CALCULATES THE CONTRIBUTION OF THE VERTICAL ADVECTION
+!     OF HEIGHT IN ORDER TO COMPUTE W=DZ/DT DIAGNOSTICALLY
+!     
+! PROGRAM HISTORY LOG:
+!   96-05-??  JANJIC     - ORIGINATOR
+!   00-01-04  BLACK      - DISTRIBUTED MEMORY AND THREADS
+!   01-03-26  BLACK      - CONVERTED TO WRF STRUCTURE
+!   02-02-19  BLACK      - CONVERSION UPDATED
+!   04-11-22  BLACK      - THREADED
+!     
+! USAGE: CALL VADZ FROM MAIN PROGRAM
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST:
+!
+!   OUTPUT FILES:
+!     NONE
+!
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+#ifdef  AS_RECEIVED
+      LOGICAL,INTENT(IN) :: SIGMA
+#else
+      INTEGER,INTENT(IN) :: SIGMA
+#endif
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+                           ,IMS,IME,JMS,JME,KMS,KME                     &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!
+!-----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-----------------------------------------------------------------------
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      REAL,INTENT(IN) :: DT,PDTOP
+!
+      REAL,DIMENSION(KTS:KTE),INTENT(IN) :: DETA1,DETA2
+!
+      REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: DFL
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PDSL,PDSLO
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: CWM,HTM     &
+                                                           ,Q,RTOP,T
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: PDWDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DWDT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: W,Z
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+!-----------------------------------------------------------------------
+      INTEGER :: I,J,K
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: FNE,FSE,TTB
+!
+      REAL :: DZ,RDT,TTAL,ZETA
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+      RDT=1./DT
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dz,i,j,k,zeta)
+      DO J=MYJS,MYJE
+!
+        DO K=KTS,KTE
+        DO I=MYIS,MYIE
+          PDWDT(I,K,J)=DWDT(I,K,J)
+          DWDT(I,K,J)=W(I,K,J)
+        ENDDO
+        ENDDO
+!
+        DO I=MYIS,MYIE
+          W(I,KTS,J)=0.
+#ifdef AS_RECEIVED
+          IF(SIGMA)THEN
+#else
+          IF(SIGMA==1)THEN
+#endif
+            Z(I,KTS,J)=FIS(I,J)*RG
+          ELSE
+            Z(I,KTS,J)=0.
+          ENDIF
+        ENDDO
+!
+        DO K=KTS,KTE
+!
+          ZETA=DFL(K+1)*RG
+!
+          DO I=MYIS,MYIE
+!
+            DZ=(Q(I,K,J)*P608-CWM(I,K,J)+1.)*T(I,K,J)                   &
+              /(PINT(I,K+1,J)+PINT(I,K,J))                              &
+              *(DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J))*TRG
+            Z(I,K+1,J)=(Z(I,K,J)+DZ-ZETA)*HTM(I,K,J)+ZETA
+            W(I,K+1,J)=(DZ-RTOP(I,K,J)                                  &
+                      *(DETA1(K)*PDTOP+DETA2(K)*PDSLO(I,J))*RG)         &
+                      *HTM(I,K,J)*HBM2(I,J)                             &
+                      +W(I,K,J)
+!
+          ENDDO
+        ENDDO
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS,MYJE
+!
+        DO K=KTS,KTE
+        DO I=MYIS,MYIE
+          Z(I,K,J)=(Z(I,K+1,J)+Z(I,K,J))*0.5
+          W(I,K,J)=(W(I,K+1,J)+W(I,K,J))*HTM(I,K,J)*HBM2(I,J)*0.5*RDT
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!-----------------------------------------------------------------------
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+        TTB(I,J)=0.
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k,ttal)
+      DO J=MYJS2,MYJE2
+        DO K=KTE,KTS+1,-1
+        DO I=MYIS1,MYIE1
+          TTAL=(Z(I,K-1,J)-Z(I,K,J))*PETDT(I,K-1,J)*0.5
+          W(I,K,J)=(TTAL+TTB(I,J))/(DETA1(K)*PDTOP+DETA2(K)*PDSLO(I,J)) &
+                  +W(I,K,J)
+          TTB(I,J)=TTAL
+        ENDDO
+        ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS2,MYJE2
+      DO I=MYIS1,MYIE1
+        W(I,KTS,J)=TTB(I,J)/(DETA1(KTS)*PDTOP+DETA2(KTS)*PDSLO(I,J))    &
+                  +W(I,KTS,J)
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      END SUBROUTINE VADZ
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE HADZ(NTSD,DT,HYDRO,HTM,HBM2,DETA1,DETA2,PDTOP          &
+                     ,DX,DY,FAD                                         &
+                     ,FEW,FNS,FNE,FSE                                   &
+                     ,PDSL,U,V,W,Z                                      &
+                     ,IHE,IHW,IVE,IVW,INDX3_WRK                         &
+                     ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+                     ,IMS,IME,JMS,JME,KMS,KME                           &
+                     ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    HADZ        HORIZONTAL ADVECTION OF HEIGHT
+!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 96-05-??       
+!     
+! ABSTRACT:
+!     HADZ CALCULATES DIAGNOSTICALLY THE CONTRIBUTION OF
+!     THE HORIZONTAL ADVECTION OF HEIGHT
+!     
+! PROGRAM HISTORY LOG:
+!   96-05-??  JANJIC     - ORIGINATOR
+!   00-01-04  BLACK      - DISTRIBUTED MEMORY AND THREADS
+!   01-03-26  BLACK      - CONVERTED TO WRF STRUCTURE
+!   04-11-22  BLACK      - THREADED
+!
+! USAGE: CALL HADZ FROM MAIN PROGRAM
+!   INPUT ARGUMENT LIST:
+!
+!   OUTPUT ARGUMENT LIST:
+!     NONE
+!
+!   OUTPUT FILES:
+!
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+      LOGICAL,INTENT(IN) :: HYDRO
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+                           ,IMS,IME,JMS,JME,KMS,KME                     &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!
+!-----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!***  NMM_MAX_DIM is set in configure.wrf and must agree with
+!***  the value of dimspec q in the Registry/Registry
+!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-----------------------------------------------------------------------
+!
+      INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
+!
+      REAL,INTENT(IN) :: DT,DY,PDTOP
+!
+      REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DX,FAD,HBM2,PDSL
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,U,V
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: FEW,FNE    &
+                                                            ,FNS,FSE
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: Z
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: W
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+!-----------------------------------------------------------------------
+      INTEGER,PARAMETER :: NTSHY=2
+!
+      INTEGER :: I,J,J1_00,J1_P1,J1_P2,J4_00,J4_M1,J4_P1,J5_00,J5_M1    &
+                ,J6_00,J6_P1,JJ,JKNT,JSTART,K
+!
+      REAL :: FEWP,FNEP,FNSP,FSEP,UDY,VDX
+!
+      REAL,DIMENSION(IMS:IME,KTS:KTE) :: UDY_00,ZEW
+!
+!***  TYPE 1 WORKING ARRAY (SEE PFDHT)
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:2) :: DPDE
+!
+!***  TYPE 4 WORKING ARRAY 
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: UNED,USED,ZNS
+!
+!***  TYPE 5 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:0) :: ZNE
+!
+!***  TYPE 6 WORKING ARRAY
+!
+      REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE, 0:1) :: ZSE
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+      IF(NTSD+1<=NTSHY.OR.HYDRO)THEN
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+        DO J=MYJS,MYJE
+          DO K=KTS,KTE
+          DO I=MYIS,MYIE
+            W(I,K,J)=0.
+          ENDDO
+          ENDDO
+        ENDDO
+!***
+        RETURN
+!***
+      ENDIF
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+!***  FIRST ZERO OUT SOME WORKING ARRAYS
+!
+      DO J=-2,2
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        DPDE(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=-1,1
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+      DO K=KTS,KTE
+      DO I=ITS-5,ITE+5
+        UNED(I,K,J)=0.
+        USED(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
+!***  FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
+!***  IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J
+!-----------------------------------------------------------------------
+!
+      JSTART=MYJS2_P1
+!
+      DO J=-2,1
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(i,k)
+        DO K=KTS,KTE
+        DO I=MYIS_P4,MYIE_P4
+          DPDE(I,K,J)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,JJ)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+      DO J=-1,0
+        JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(fnsp,i,k,udy,vdx)
+        DO K=KTS,KTE
+        DO I=MYIS_P3,MYIE_P3
+          UDY=U(I,K,JJ)*DY
+          VDX=V(I,K,JJ)*DX(I,JJ)
+          UNED(I,K,J)=UDY+VDX
+          USED(I,K,J)=UDY-VDX
+          FNSP=VDX*(DPDE(I,K,J-1)+DPDE(I,K,J+1))
+          ZNS(I,K,J)=FNSP*(Z(I,K,JJ+1)-Z(I,K,JJ-1))
+          FNS(I,K,JJ)=FNSP
+          UDY_00(I,K)=UDY
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+      J=-1
+      JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(fnep,i,k)
+      DO K=KTS,KTE
+      DO I=MYIS_P2,MYIE_P2
+        FNEP=(UNED(I+IHE(JJ),K,J)+UNED(I,K,J+1))                        &
+            *(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J+1))
+        ZNE(I,K,J)=FNEP*(Z(I+IHE(JJ),K,JJ+1)-Z(I,K,JJ))
+      ENDDO
+      ENDDO
+!
+      J=0
+      JJ=JSTART+J
+!
+!$omp parallel do                                                       &
+!$omp& private(fsep,i,k)
+      DO K=KTS,KTE
+      DO I=MYIS_P2,MYIE_P2
+        FSEP=(USED(I+IHE(JJ),K,J)+USED(I,K,J-1))                        &
+            *(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J-1))
+        ZSE(I,K,J)=FSEP*(Z(I+IHE(JJ),K,JJ-1)-Z(I,K,JJ))
+        FSE(I,K,JJ)=FSEP
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+      JKNT=0
+!
+      main_integration:  DO J=MYJS2_P1,MYJE2_P1
+!
+!-----------------------------------------------------------------------
+!***
+!***  SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
+!***                                           AND ABOVE DIAGRAMS)
+!***
+!***  J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
+!***  LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
+!***  NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
+!***  THE CURRENT VALUE OF THE main_integration LOOP.
+!***  (P2 denotes +2, etc.)
+!***
+        JKNT=JKNT+1
+!
+        J1_P2=INDX3_WRK(2,JKNT,1)
+        J1_P1=INDX3_WRK(1,JKNT,1)
+        J1_00=INDX3_WRK(0,JKNT,1)
+!
+        J4_P1=INDX3_WRK(1,JKNT,4)
+        J4_00=INDX3_WRK(0,JKNT,4)
+        J4_M1=INDX3_WRK(-1,JKNT,4)
+!
+        J5_00=INDX3_WRK(0,JKNT,5)
+        J5_M1=INDX3_WRK(-1,JKNT,5)
+!
+        J6_P1=INDX3_WRK(1,JKNT,6)
+        J6_00=INDX3_WRK(0,JKNT,6)
+!-----------------------------------------------------------------------
+!
+!***  MASS FLUXES AND MASS POINT ADVECTION COMPONENTS
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(fewp,fnep,fnsp,fsep,i,k,udy,vdx)
+        DO K=KTS,KTE
+!
+        DO I=MYIS_P4,MYIE_P4
+          DPDE(I,K,J1_P2)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J+2)
+        ENDDO
+!
+        DO I=MYIS_P3,MYIE_P3
+          UDY=U(I,K,J+1)*DY
+          VDX=V(I,K,J+1)*DX(I,J+1)
+!
+          FEWP=UDY_00(I,K)                                              &
+             *(DPDE(I+IVW(J),K,J1_00)+DPDE(I+IVE(J),K,J1_00))
+          FNSP=VDX*(DPDE(I,K,J1_00)+DPDE(I,K,J1_P2))
+!
+          FEW(I,K,J)=FEWP
+          FNS(I,K,J+1)=FNSP
+!
+          ZEW(I,K)=FEWP*(Z(I+IVE(J),K,J)-Z(I+IVW(J),K,J))
+          ZNS(I,K,J4_P1)=FNSP*(Z(I,K,J+2)-Z(I,K,J))
+!
+          UNED(I,K,J4_P1)=UDY+VDX
+          USED(I,K,J4_P1)=UDY-VDX
+!
+          UDY_00(I,K)=UDY
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!
+!***  DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND
+!
+!-----------------------------------------------------------------------
+        DO I=MYIS_P2,MYIE1_P2
+          FNEP=(UNED(I+IHE(J),K,J4_00)+UNED(I,K,J4_P1))                 &
+              *(DPDE(I,K,J1_00)+DPDE(I+IHE(J),K,J1_P1))
+          FNE(I,K,J)=FNEP
+          ZNE(I,K,J5_00)=FNEP*(Z(I+IHE(J),K,J+1)-Z(I,K,J))
+!
+          FSEP=(USED(I+IHE(J+1),K,J4_P1)+USED(I,K,J4_00))               &
+              *(DPDE(I,K,J1_P1)+DPDE(I+IHE(J+1),K,J1_00))
+          FSE(I,K,J+1)=FSEP
+          ZSE(I,K,J6_P1)=FSEP*(Z(I+IHE(J+1),K,J)-Z(I,K,J+1))
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!
+!***  ADVECTION OF Z
+!
+!-----------------------------------------------------------------------
+        DO I=MYIS1_P1,MYIE1_P1
+          W(I,K,J)=-(ZEW(I+IHW(J),K)+ZEW(I+IHE(J),K)                    &
+                    +ZNS(I,K,J4_M1)+ZNS(I,K,J4_P1)                      &
+                    +ZNE(I+IHW(J),K,J5_M1)+ZNE(I,K,J5_00)               &
+                    +ZSE(I,K,J6_00)+ZSE(I+IHW(J),K,J6_P1))              &
+                    *FAD(I,J)*HTM(I,K,J)*HBM2(I,J)/(DPDE(I,K,J1_00)*DT) &
+                    +W(I,K,J)
+        ENDDO
+!
+        ENDDO   ! End K loop
+!-----------------------------------------------------------------------
+!
+      ENDDO main_integration
+!
+!-----------------------------------------------------------------------
+!
+      END SUBROUTINE HADZ
+!
+!-----------------------------------------------------------------------
+      END MODULE MODULE_NONHY_DYNAM
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_PHYSICS_CALLS.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_PHYSICS_CALLS.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_PHYSICS_CALLS.F	(revision 2744)
@@ -0,0 +1,2296 @@
+!-----------------------------------------------------------------------
+!
+!NCEP_MESO:MODEL_LAYER: PHYSICS
+!
+!-----------------------------------------------------------------------
+#include "nmm_loop_basemacros.h"
+#include "nmm_loop_macros.h"
+!-----------------------------------------------------------------------
+!
+      MODULE MODULE_PHYSICS_CALLS
+!
+!-----------------------------------------------------------------------
+      USE MODULE_DOMAIN
+      USE MODULE_DM
+      USE MODULE_CONFIGURE
+      USE MODULE_TILES
+      USE MODULE_STATE_DESCRIPTION,ONLY : P_QV,P_QC,P_QR,P_QI,P_QS,P_QG,P_QNI
+      USE MODULE_MODEL_CONSTANTS
+      USE MODULE_RA_GFDLETA,ONLY : CAL_MON_DAY,ZENITH
+      USE MODULE_RADIATION_DRIVER
+      USE MODULE_SF_MYJSFC
+      USE MODULE_SURFACE_DRIVER
+      USE MODULE_PBL_DRIVER
+      USE MODULE_CU_BMJ
+      USE MODULE_CUMULUS_DRIVER
+      USE MODULE_MP_ETANEW
+      USE MODULE_MICROPHYSICS_DRIVER
+      USE MODULE_MICROPHYSICS_ZERO_OUT
+!-----------------------------------------------------------------------
+!
+      CONTAINS
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE RADIATION(NTSD,DT,JULDAY,JULYR,XTIME,JULIAN            &
+     &                    ,IHRST,NPHS,GLAT,GLON                         &
+     &                    ,NRADS,NRADL                                  &
+     &                    ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT   &
+     &                    ,PD,RES,PINT,T,Q,MOIST,THS,ALBEDO,EPSR        &
+     &                    ,F_ICE,F_RAIN                                 &
+#ifdef WRF_CHEM
+     &                    ,GD_CLOUD,GD_CLOUD2                           &
+#endif
+     &                    ,SM,HBM2,LMH,CLDFRA,N_MOIST,RESTRT            &
+     &                    ,RLWTT,RSWTT,RLWIN,RSWIN,RSWINC,RSWOUT        &
+     &                    ,RLWTOA,RSWTOA,CZMEAN                         &
+     &                    ,CFRACL,CFRACM,CFRACH,SIGT4                   &
+     &                    ,ACFRST,NCFRST,ACFRCV,NCFRCV                  &
+     &                    ,CUPPT,VEGFRC,SNOW,HTOP,HBOT                  &
+     &                    ,Z,SICE,NUM_AEROSOLC,NUM_OZMIXM               &
+     &                    ,GRID,CONFIG_FLAGS                            &
+     &                    ,RTHRATEN                                     &
+#ifdef WRF_CHEM
+     &                    ,PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC         &
+     &                    ,TAUAER1, TAUAER2, TAUAER3, TAUAER4           &
+     &                    ,GAER1, GAER2, GAER3, GAER4                   &
+     &                    ,WAER1, WAER2, WAER3, WAER4                   &
+#endif
+     &                    ,IDS,IDE,JDS,JDE,KDS,KDE                      &
+     &                    ,IMS,IME,JMS,JME,KMS,KME                      &
+     &                    ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***  NOTE ***
+! RLWIN  - downward longwave at the surface (=TOTLWDN, now a local array)
+! RSWIN  - downward shortwave at the surface (=TOTSWDN, now a local array)
+! RSWINC - CLEAR-SKY downward shortwave at the surface (=TOTSWDNC, new for AQ)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    RADIATION   RADIATION OUTER DRIVER
+!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 2002-06-04       
+!     
+! ABSTRACT:
+!     RADIATION SERVES AS THE INTERFACE BETWEEN THE NCEP NONHYDROSTATIC
+!     MESOSCALE MODEL AND THE WRF RADIATION DRIVER.
+!     
+! PROGRAM HISTORY LOG:
+!   02-06-04  BLACK      - ORIGINATOR
+!   02-09-09  WOLFE      - CONVERTING TO GLOBAL INDEXING
+!   04-11-18  BLACK      - THREADED
+!     
+! USAGE: CALL RADIATION FROM SOLVE_NMM      
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM 
+!$$$  
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE                     &
+     &                     ,IHRST,JULDAY,JULYR                          &
+     &                     ,N_MOIST,NPHS,NRADL,NRADS,NTSD               &
+     &                     ,NUM_AEROSOLC,NUM_OZMIXM
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: NCFRCV,NCFRST
+!
+      REAL,INTENT(IN) :: DT,PDTOP,PT,XTIME,JULIAN
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
+!
+      REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: ALBEDO              &
+     &                                             ,EPSR,GLAT,GLON      &
+     &                                             ,HBM2                &
+     &                                             ,PD,RES,SM           &
+     &                                             ,SNOW,THS,VEGFRC,SICE
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CUPPT            
+
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: F_ICE       &
+     &                                                     ,F_RAIN      &
+     &                                                     ,Q,T,Z
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: RTHRATEN
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST),INTENT(INOUT) :: MOIST
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACFRCV,ACFRST    &
+     &                                                ,RLWIN,RLWTOA     &
+     &                                                ,RSWIN,RSWOUT     &
+     &                                                ,HBOT,HTOP        &
+     &                                                ,RSWINC,RSWTOA
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: PINT     &
+     &                                                        ,RLWTT    &
+     &                                                        ,RSWTT
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CFRACH,CFRACL      &
+     &                                              ,CFRACM,CZMEAN      &
+     &                                              ,SIGT4
+#ifdef WRF_CHEM
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME ),INTENT(IN) ::            &
+     &                              GAER1,GAER2,GAER3,GAER4,            &
+     &                              GD_CLOUD,GD_CLOUD2,                 &
+     &                              PM2_5_DRY,PM2_5_WATER,PM2_5_DRY_EC, &
+     &                              TAUAER1,TAUAER2,TAUAER3,TAUAER4,    &
+     &                              WAER1,WAER2,WAER3,WAER4
+#endif
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CLDFRA
+!
+      LOGICAL,INTENT(IN) :: RESTRT
+!
+      TYPE(DOMAIN),TARGET :: GRID
+!
+      TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
+!
+!-----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+!-----------------------------------------------------------------------
+      INTEGER :: I,ICLOUD,IENDX,II,J,JDAY,JMONTH,K,KMNTH,LMHIJ,NRAD
+!
+      INTEGER,DIMENSION(3) :: IDAT
+      INTEGER,DIMENSION(12) :: MONTH=(/31,28,31,30,31,30,31,31          &
+     &                                ,30,31,30,31/)
+!
+      REAL :: CAPA,DAYI,DPL,FICE,FRAIN,GMT,HOUR,PDSL,PLYR,PSFC          &
+     &       ,QI,QR,QW,RADT,TIMES,WC,TDUM
+!
+      REAL,DIMENSION(KMS:KME-1) :: QL,TL
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: REXNSFC,SWNETDN                &
+     &                                  ,TOT,TSFC,XLAND,XLAT,XLON       &
+     &                                  ,TOTLWDN,TOTSWDN,TOTSWDNC,CZEN  &
+     &                                  ,HBOTR,HTOPR,CUPPTR
+!
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W,P_PHY,PI_PHY    &
+     &                                          ,RR,T8W                 &
+     &                                          ,THRATENLW,THRATENSW    &
+     &                                          ,TH_PHY,T_PHY,CLFR
+!
+!
+!***  Different way to include cloud effects in radiation.
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: QC1R,QI1R
+!
+      LOGICAL :: WARM_RAIN
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!*****
+!***** NOTE: THIS IS HARDWIRED FOR CALLS TO LONGWAVE AND SHORTWAVE
+!*****       AT EQUAL INTERVALS
+!*****
+      NRAD=NRADS
+      RADT=DT*NRADS/60.
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      CAPA=R_D/CP
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(dpl,fice,frain,i,j,k,pdsl,plyr,ql,tl)
+      DO J=MYJS2,MYJE2
+      DO I=MYIS1,MYIE1
+!
+        PDSL=PD(I,J)*RES(I,J)
+        P8W(I,KTE+1,J)=PT
+        XLAT(I,J)=GLAT(I,J)/DEGRAD
+        XLON(I,J)=GLON(I,J)/DEGRAD
+        XLAND(I,J)=SM(I,J)+1.
+        PSFC=PD(I,J)+PDTOP+PT
+        REXNSFC(I,J)=(PSFC*1.E-5)**CAPA
+        TSFC(I,J)=THS(I,J)*REXNSFC(I,J)
+        T8W(I,1,J)=TSFC(I,J)
+        P8W(I,KTS,J)=ETA1(KTS)*PDTOP+ETA2(KTS)*PDSL+PT
+!
+!-----------------------------------------------------------------------
+!***  FILL THE SINGLE-COLUMN INPUT
+!-----------------------------------------------------------------------
+!
+        DO K=KTS,KTE
+          DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL
+          QL(K)=AMAX1(Q(I,K,J),EPSQ)
+          PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT
+          TL(K)=T(I,K,J)
+!
+          RR(I,K,J)=PLYR/(R_D*TL(K)*(1.+P608*QL(K)))
+          T_PHY(I,K,J)=TL(K)
+          TH_PHY(I,K,J)=TL(K)*(1.E5/PLYR)**CAPA
+          P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL+PT
+          P_PHY(I,K,J)=PLYR
+          PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA
+          DZ(I,K,J)=TL(K)*(P608*QL(K)+1.)*R_D                           &
+     &                 *(P8W(I,K,J)-P8W(I,K+1,J))                       &
+     &                 /(P_PHY(I,K,J)*G)
+!!!  &                 *ALOG(P8W(I,KFLIP,J)/P8W(I,KFLIP+1,J))/G         &
+!!!  &                 *ALOG(PINT(I,K+1,J)/PINT(I,K,J))/G               &
+!
+          RTHRATEN(I,K,J)=0.
+          THRATENLW(I,K,J)=0.
+          THRATENSW(I,K,J)=0.
+!         PM2_5_DRY(I,K,J)=0.
+!         PM2_5_WATER(I,K,J)=0.
+
+        ENDDO
+!
+        DO K=KTS+1,KTE
+          T8W(I,K,J)=0.5*(TL(K-1)+TL(K))
+        ENDDO
+        T8W(I,KTE+1,J)=-1.E20
+!
+      ENDDO
+      ENDDO
+!
+      ICLOUD=999
+!
+      GMT=REAL(IHRST)
+!
+!-----------------------------------------------------------------------
+!
+!***  CALL THE INNER DRIVER.
+!
+!-----------------------------------------------------------------------
+!
+      DO J=JMS,JME
+      DO K=KMS,KME
+      DO I=IMS,IME
+        QC1R(I,K,J)=0.
+        QI1R(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+          DO I=MYIS1,MYIE1
+            QC1R(I,K,J)=MOIST(I,K,J,P_QC)
+            QI1R(I,K,J)=MOIST(I,K,J,P_QI)
+          ENDDO
+        ENDDO
+      ENDDO
+      DO J=JMS,JME
+        DO K=KMS,KME
+        DO I=IMS,IME
+          CLDFRA(I,K,J)=0.
+        ENDDO
+        ENDDO
+!
+        DO I=IMS,IME
+          CFRACH(I,J)=0.
+          CFRACL(I,J)=0.
+          CFRACM(I,J)=0.
+          CZMEAN(I,J)=0.
+          SIGT4(I,J)=0.
+          TOTSWDN(I,J)=0.   ! TOTAL (clear+cloudy sky) shortwave down at the surface
+          TOTSWDNC(I,J)=0.  ! CLEAR SKY shortwave down at the surface
+          SWNETDN(I,J)=0.   ! Net (down - up) total (clear+cloudy sky) shortwave at the surface
+          TOTLWDN(I,J)=0.   ! Total longwave down at the surface
+          CUPPTR(I,J)=CUPPT(I,J)   ! Temporary array set to zero in radiation
+!-- NOTE:  HBOTR, HTOPR are passed into radiation and set equal to HBOT, HTOP.  HBOT, HTOP are
+!          reset to clear sky values to be used by the ARW.  At the bottom of this subroutine, 
+!          HBOT, HTOP are re-defined again to values stored in HBOTR, HTOPR.  HBOT, HTOP are 
+!          reset to clear sky values after the call to radiation and after the top of the hour
+!          in subroutine CUCNVC below.
+        ENDDO
+      ENDDO
+!
+      CALL SET_TILES(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)
+!
+      CALL RADIATION_DRIVER(                                            &
+     &                  IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
+     &                 ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
+     &                 ,I_START=GRID%I_START,I_END=GRID%I_END           &
+     &                 ,J_START=GRID%J_START,J_END=GRID%J_END           &
+     &                 ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES        &
+     &                 ,ITIMESTEP=NTSD,DT=DT                            &
+     &                 ,cu_rad_feedback=config_flags%cu_rad_feedback    &
+#ifdef WRF_CHEM
+     &        ,PM2_5_DRY=pm2_5_dry, PM2_5_WATER=pm2_5_water               &
+     &        ,PM2_5_DRY_EC=pm2_5_dry_ec                                  &
+     &        ,TAUAER300=tauaer1, TAUAER400=tauaer2, TAUAER600=tauaer3, TAUAER999=tauaer4 & ! jcb
+     &        ,GAER300=gaer1, GAER400=gaer2, GAER600=gaer3, GAER999=gaer4 & ! jcb
+     &        ,WAER300=waer1, WAER400=waer2, WAER600=waer3, WAER999=waer4 & ! jcb
+     &        ,qc_adjust=GD_CLOUD,qi_adjust=GD_CLOUD2                   &
+#endif
+     &                 ,RTHRATENLW=THRATENLW,RTHRATENSW=THRATENSW       &
+     &                 ,RTHRATEN=RTHRATEN                               &
+     &                 ,GLW=TOTLWDN,GSW=SWNETDN,SWDOWN=TOTSWDN          &
+     &                 ,XLAT=XLAT,XLONG=XLON,ALBEDO=ALBEDO,EMISS=EPSR   &
+     &                 ,XICE=SICE,XLAND=XLAND,Z=Z,TSK=TSFC              &
+     &                 ,N_AEROSOLC=NUM_AEROSOLC,PAERLEV=GRID%PAERLEV    &
+     &                 ,CAM_ABS_DIM1=GRID%CAM_ABS_DIM1                  &
+     &                 ,CAM_ABS_DIM2=GRID%CAM_ABS_DIM2                  &
+     &                 ,CAM_ABS_FREQ_S=GRID%CAM_ABS_FREQ_S              &
+     &                 ,LEVSIZ=GRID%LEVSIZ,N_OZMIXM=NUM_OZMIXM          &
+     &                 ,HTOP=HTOP,HBOT=HBOT,CUPPT=CUPPTR                &
+     &                 ,HTOPR=HTOPR,HBOTR=HBOTR                         &
+     &                 ,VEGFRA=VEGFRC,SNOW=SNOW                         &
+     &                 ,RHO=RR,P8W=P8W,P=P_PHY,PI=PI_PHY                &
+     &                 ,DZ8W=DZ,T=T_PHY,T8W=T8W,GMT=GMT                 &
+     &                 ,JULDAY=JULDAY,JULYR=JULYR,NPHS=NPHS             &
+     &                 ,JULIAN=JULIAN,XTIME=XTIME                       &
+     &                 ,LW_PHYSICS=CONFIG_FLAGS%RA_LW_PHYSICS           &
+     &                 ,SW_PHYSICS=CONFIG_FLAGS%RA_SW_PHYSICS           &
+     &                 ,RADT=RADT,RA_CALL_OFFSET=GRID%RA_CALL_OFFSET    &
+     &                 ,STEPRA=NRAD,ICLOUD=ICLOUD                       &
+     &                 ,WARM_RAIN=WARM_RAIN                             & 
+     &                 ,SWDOWNC=TOTSWDNC,CLDFRA=CLFR                    &
+     &                 ,RSWTOA=RSWTOA,RLWTOA=RLWTOA                     &
+     &                 ,CZMEAN=CZMEAN,CFRACL=CFRACL                     &
+     &                 ,CFRACM=CFRACM,CFRACH=CFRACH                     &
+     &                 ,ACFRST=ACFRST,NCFRST=NCFRST                     &
+     &                 ,ACFRCV=ACFRCV,NCFRCV=NCFRCV                     &
+     &                 ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN               &
+     &                 ,QV=MOIST(IMS,KMS,JMS,P_QV),F_QV=F_QV            &
+     &                 ,QC=MOIST(IMS,KMS,JMS,P_QC),F_QC=F_QC                               &
+     &                 ,QR=MOIST(IMS,KMS,JMS,P_QR),F_QR=F_QR            &
+     &                 ,QI=MOIST(IMS,KMS,JMS,P_QI),F_QI=F_QI                               &
+     &                 ,QS=MOIST(IMS,KMS,JMS,P_QS),F_QS=F_QS            &
+     &                 ,QG=MOIST(IMS,KMS,JMS,P_QG),F_QG=F_QG          )
+
+!
+!-----------------------------------------------------------------------
+!
+!***  UPDATE FLUXES AND TEMPERATURE TENDENCIES.
+!
+!-----------------------------------------------------------------------
+!***  SHORTWAVE
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+      IF(MOD(NTSD,NRADS)==0)THEN
+!-----------------------------------------------------------------------
+!
+        IF(CONFIG_FLAGS%RA_SW_PHYSICS/=GFDLSWSCHEME)THEN
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE CZMEAN FOR NON-GFDL SHORTWAVE
+!-----------------------------------------------------------------------
+!
+          DO J=MYJS,MYJE
+          DO I=MYIS,MYIE
+            CZMEAN(I,J)=0.
+            TOT(I,J)=0.
+          ENDDO
+          ENDDO
+!
+          CALL CAL_MON_DAY(JULDAY,JULYR,JMONTH,JDAY)
+          IDAT(1)=JMONTH
+          IDAT(2)=JDAY
+          IDAT(3)=JULYR
+!
+          DO II=0,NRADS,NPHS
+            TIMES=NTSD*DT+II*DT
+            CALL ZENITH(TIMES,DAYI,HOUR,IDAT,IHRST,GLON,GLAT,CZEN       &
+     &                 ,MYIS &
+     &                 ,MYIE &
+     &                 ,MYJS &
+     &                 ,MYJE &
+     &                 ,IDS,IDE,JDS,JDE,KDS,KDE                         &
+     &                 ,IMS,IME,JMS,JME,KMS,KME                         &
+     &                 ,ITS,ITE,JTS,JTE,KTS,KTE)
+            DO J=MYJS,MYJE
+            DO I=MYIS,MYIE
+              IF(CZEN(I,J)>0.)THEN
+                CZMEAN(I,J)=CZMEAN(I,J)+CZEN(I,J)
+                TOT(I,J)=TOT(I,J)+1.
+              ENDIF
+            ENDDO
+            ENDDO
+!
+          ENDDO
+!
+          DO J=MYJS,MYJE
+          DO I=MYIS,MYIE
+            IF(TOT(I,J)>0.)CZMEAN(I,J)=CZMEAN(I,J)/TOT(I,J)
+          ENDDO
+          ENDDO
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE TOTAL SFC SHORTWAVE DOWN FOR NON-GFDL SCHEMES
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+          DO J=MYJS2,MYJE2
+          DO I=MYIS1,MYIE1
+!
+            IF(HBM2(I,J)>0.5)THEN
+              TOTSWDN(I,J)=SWNETDN(I,J)/(1.-ALBEDO(I,J))  
+!--- No value currently available for clear-sky solar fluxes from
+!    non GFDL schemes, though it's needed for air quality forecasts.
+!    For the time being, set to the total downward solar fluxes.
+              TOTSWDNC(I,J)=TOTSWDN(I,J)
+            ENDIF
+!
+          ENDDO
+          ENDDO
+!
+        ENDIF   !End non-GFDL block
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,iendx,j,k)
+        DO J=MYJS2,MYJE2
+          IENDX=MYIE1
+          IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
+          DO I=MYIS1,IENDX
+!
+            RSWIN(I,J)=TOTSWDN(I,J)
+            RSWINC(I,J)=TOTSWDNC(I,J)
+            RSWOUT(I,J)=TOTSWDN(I,J)-SWNETDN(I,J)
+!
+            DO K=KTS,KTE
+              RSWTT(I,K,J)=THRATENSW(I,K,J)*PI_PHY(I,K,J)
+            ENDDO
+!
+          ENDDO
+        ENDDO
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  LONGWAVE
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD,NRADL)==0)THEN
+!
+!$omp parallel do                                                       &
+!$omp& private(i,iendx,j,k,lmhij)
+        DO J=MYJS2,MYJE2
+          IENDX=MYIE1
+          IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
+          DO I=MYIS1,IENDX
+!
+            IF(HBM2(I,J)>0.5)THEN
+              LMHIJ=KTE+1-LMH(I,J)
+              TDUM=T(I,LMHIJ,J)
+              SIGT4(I,J)=STBOLT*TDUM*TDUM*TDUM*TDUM
+!
+              DO K=KTS,KTE
+                RLWTT(I,K,J)=THRATENLW(I,K,J)*PI_PHY(I,K,J)
+              ENDDO
+!
+              RLWIN(I,J)=TOTLWDN(I,J)
+            ENDIF
+!
+          ENDDO
+        ENDDO
+!
+      ENDIF
+!
+!-- Store 3D cloud fractions & restore HBOT/HTOP arrays
+!
+      DO J=MYJS2,MYJE2
+        IENDX=MYIE1
+        IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
+        DO K=KTS,KTE
+          DO I=MYIS1,IENDX
+            CLDFRA(I,K,J)=CLFR(I,K,J)
+          ENDDO
+        ENDDO
+        DO I=MYIS1,IENDX
+          HBOT(I,J)=HBOTR(I,J)
+          HTOP(I,J)=HTOPR(I,J)
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!***  ZERO OUT BOUNDARY ROWS.
+!-----------------------------------------------------------------------
+!
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        IF(HBM2(I,J)<0.5)THEN
+          ACFRST(I,J)=0.
+          ACFRCV(I,J)=0.
+          CFRACL(I,J)=0.
+          CFRACM(I,J)=0.
+          CFRACH(I,J)=0.
+          RSWTOA(I,J)=0.
+          RLWTOA(I,J)=0.
+        ENDIF
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!
+
+      END SUBROUTINE RADIATION
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE TURBL(NTSD,DT,NPHS,RESTRT                              &
+     &                ,N_MOIST,NSOIL,SLDPTH,DZSOIL                      &
+     &                ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT       &
+     &                ,SM,LMH,HTM,VTM,HBM2,VBM2,DX_ARRAY,DFRLG          &
+     &                ,CZEN,CZMEAN,SIGT4,RLWIN,RSWIN,RADOT              &
+!- RLWIN/RSWIN - downward longwave/shortwave at the surface (also TOTLWDN/TOTSWDN in RADIATION)
+     &                ,PD,RES,PINT,T,Q,CWM,F_ICE,F_RAIN,SR              &
+     &                ,Q2,U,V,THS,TSFC,SST,PREC,SNO,ZERO_3D             &
+     &                ,FIS,Z0,Z0BASE,USTAR,PBLH,LPBL,EL_MYJ             &
+     &                ,MOIST,RMOL                                       &
+     &                ,EXCH_H,AKHS,AKMS,AKHS_OUT,AKMS_OUT               &
+     &                ,THZ0,QZ0,UZ0,VZ0,QS,MAVAIL                       &
+     &                ,STC,SMC,CMC,SMSTAV,SMSTOT,SSROFF,BGROFF          &
+     &                ,IVGTYP,ISLTYP,VEGFRC,SHDMIN,SHDMAX,GRNFLX        &
+     &                ,SFCEXC,ACSNOW,ACSNOM,SNOPCX,SICE,TG,SOILTB       &
+     &                ,ALBASE,MXSNAL,ALBEDO,SH2O,SI,EPSR                &
+     &                ,U10,V10,TH10,Q10,TSHLTR,QSHLTR,PSHLTR            &
+     &                ,T2,QSG,QVG,QCG,SOILT1,TSNAV,SMFR3D,KEEPFR3DFLAG  &
+     &                ,TWBS,QWBS,SFCSHX,SFCLHX,SFCEVP                   &
+     &                ,POTEVP,POTFLX,SUBSHX                             &
+     &                ,APHTIM,ARDSW,ARDLW,ASRFC                         &
+     &                ,RSWOUT,RSWTOA,RLWTOA                             &
+     &                ,ASWIN,ASWOUT,ASWTOA,ALWIN,ALWOUT,ALWTOA          &
+     &                ,UZ0H,VZ0H,DUDT,DVDT                              & 
+     &                ,RTHBLTEN,RQVBLTEN                                & 
+     &                ,PCPFLG,DDATA                                     & ! PRECIP ASSIM
+     &                ,GRID,CONFIG_FLAGS                                &
+     &                ,IHE,IHW,IVE,IVW                                  &
+     &                ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &                ,IMS,IME,JMS,JME,KMS,KME                          &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    TURBL       TURBULENCE OUTER DRIVER
+!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 02-04-19       
+!     
+! ABSTRACT:
+!     TURBL DRIVES THE TURBULENCE SCHEMES
+!     
+! PROGRAM HISTORY LOG (with changes to called routines) :
+!   95-03-15  JANJIC     - ORIGINATOR OF THE SUBROUTINES CALLED
+!   BLACK & JANJIC       - ORIGINATORS OF THE DRIVER
+!   95-03-28  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
+!   96-03-29  BLACK      - ADDED EXTERNAL EDGE; REMOVED SCRCH COMMON
+!   96-07-19  MESINGER   - ADDED Z0 EFFECTIVE
+!   98-??-??  TUCCILLO   - MODIFIED FOR CLASS VIII PARALLELISM
+!   98-10-27  BLACK      - PARALLEL CHANGES INTO MOST RECENT CODE
+!   02-01-10  JANJIC     - MOIST TURBULENCE (DRIVER, MIXLEN, VDIFH)
+!   02-01-10  JANJIC     - VERT. DIF OF Q2 INCREASED (Grenier & Bretherton)
+!   02-02-02  JANJIC     - NEW SFCDIF
+!   02-04-19  BLACK      - ORIGINATOR OF THIS OUTER DRIVER FOR WRF
+!   02-05-03  JANJIC     - REMOVAL OF SUPERSATURATION AT 2m AND 10m
+!   04-11-18  BLACK      - THREADED
+!     
+! USAGE: CALL TURBL FROM SOLVE_NMM
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM
+!$$$  
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE                     &
+     &                     ,N_MOIST,NPHS,NSOIL,NTSD
+!
+      INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: ISLTYP,IVGTYP    &
+     &                                                ,LMH
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: LPBL
+!
+      REAL,INTENT(IN) :: DT,PDTOP,PT
+!
+      REAL,INTENT(INOUT) :: APHTIM,ARDSW,ARDLW,ASRFC
+!
+      REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+!
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: DFRLG,ETA1,ETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ALBASE,MXSNAL
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CZEN,CZMEAN         &
+     &                                             ,DX_ARRAY            &
+     &                                             ,FIS,HBM2            &
+     &                                             ,PD,RES              &
+     &                                             ,RLWIN,RLWTOA        &
+     &                                             ,RSWIN,RSWOUT,RSWTOA &
+     &                                             ,SHDMIN,SHDMAX       &
+!    &                                             ,SICE,SIGT4,SM,SR    & !Bandaid
+     &                                             ,SICE,SIGT4          &
+     &                                             ,SST,TG,VBM2,VEGFRC
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: SM,EPSR,SR         !Bandaid
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: GRNFLX,QWBS,RADOT  &
+                                                    ,SFCEXC,SMSTAV      &
+                                                    ,SOILTB,TWBS
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACSNOM,ACSNOW    &
+     &                                                ,AKHS,AKMS        &
+     &                                                ,ALBEDO           &
+     &                                                ,MAVAIL           &
+     &                                                ,BGROFF,CMC       &
+     &                                                ,PBLH,POTEVP      &
+     &                                                ,POTFLX,PREC      &
+     &                                                ,QCG,QS,QSG       &
+     &                                                ,QVG,QZ0          &
+     &                                                ,SFCEVP           &
+     &                                                ,SFCLHX,SFCSHX    &
+     &                                                ,SI,SMSTOT        &
+     &                                                ,SNO,SNOPCX       &
+     &                                                ,SOILT1           &
+     &                                                ,SSROFF,SUBSHX    &
+     &                                                ,T2,THS,THZ0      &
+     &                                                ,TSFC,TSNAV       &
+     &                                                ,USTAR,UZ0,UZ0H   &
+     &                                                ,VZ0,VZ0H         &
+     &                                                ,Z0,Z0BASE
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: AKHS_OUT,AKMS_OUT  &
+     &                                              ,ALWIN,ALWOUT       &
+     &                                              ,ALWTOA,ASWIN       &
+     &                                              ,ASWOUT,ASWTOA      &
+     &                                              ,PSHLTR,Q10,QSHLTR  &
+     &                                              ,TH10,TSHLTR        &
+     &                                              ,U10,V10
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM      &
+     &                                                        ,DUDT     &
+     &                                                        ,DVDT     &
+     &                                                        ,EXCH_H   &
+     &                                                        ,F_ICE    &
+     &                                                        ,F_RAIN   &
+     &                                                        ,Q,Q2     &
+     &                                                        ,T,U,V
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: RQVBLTEN,RTHBLTEn
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST),INTENT(INOUT) :: MOIST
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: ZERO_3D
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: EL_MYJ
+!
+      REAL,DIMENSION(NSOIL),INTENT(IN) :: DZSOIL,SLDPTH
+!
+      REAL,DIMENSION(IMS:IME,NSOIL,JMS:JME),INTENT(INOUT) :: KEEPFR3DFLAG &
+     &                                                      ,SH2O,SMC     &
+     &                                                      ,SMFR3D,STC
+!
+      LOGICAL,INTENT(IN) :: RESTRT
+!
+      TYPE(DOMAIN),TARGET :: GRID
+!
+      TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
+!
+!  For precip assimilation:
+      LOGICAL,INTENT(IN) :: PCPFLG
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DDATA
+!
+!-----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+!-----------------------------------------------------------------------
+      INTEGER :: I,I_M,IDUMMY,IEND,ISFFLX,ISTR,J,K,KOUNT_ALL,LENGTH_ROW &
+     &          ,LLIJ,LLMH,LLYR,N,SST_UPDATE
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME) :: KPBL,LOWLYR
+!
+      REAL :: TRESH=0.95
+!
+      REAL :: ALTITUDE,CWML,DQDT,DTDT,DTPHS,DX,DZHALF,FACTR,FACTRL      &
+     &       ,G_INV,PDSL,PLYR,PSFC,QI,QL,QOLD,QR,QW,RATIOMX,RDTPHS      &
+     &       ,ROG,RWMSK,SDEPTH,SNO_FACTR,TL,TLMH,TLMH4,TNEW,TSFC2       &
+     &       ,U_FRAME,V_FRAME,WMSK,XLVRW
+!
+      REAL :: APES,CKLQ,FACTOR,FFS,PQ0X,Q2SAT,QFC1,QLOWX,RLIVWV         &
+     &       ,THBOT
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: BR,CHKLOWQ,CT,CWMLOW,ELFLX     &
+     &                                  ,EXNSFC,FACTRS,FLHC,FLQC,GZ1OZ0 &
+     &                                  ,ONE,PLM,PSFC_OUT,PSIH,PSIM     &
+     &                                  ,Q2X,QLOW,RAIN,RAINBL           &
+     &                                  ,RLW_DN_SFC,RMOL,RSW_NET_SFC    &
+     &                                  ,RSW_DN_SFC                     &
+     &                                  ,SFCEVPX,SFCZ,SNOW,SNOWC,SNOWH  &
+     &                                  ,TH2X,THLOW,TLOW,VGFRCK         &
+     &                                  ,WSPD,XLAND,ZERO_2D,EMISS
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME-1,JMS:JME) :: EXNER
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W                 &
+     &                                          ,P_PHY,PI_PHY           &
+     &                                          ,RQCBLTEN,RQIBLTEN      &
+     &                                          ,RR   &
+!    &                                          ,RQVBLTEN,RR,RTHBLTEN   &
+     &                                          ,T_PHY,TH_PHY,TKE       &
+     &                                          ,U_PHY,V_PHY,Z
+!
+      REAL,DIMENSION(IMS:IME,NSOIL,JMS:JME) :: ZERO_SOIL
+!
+      LOGICAL :: E_BDY,WARM_RAIN
+!
+      INTEGER :: ucmcall
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+     ucmcall=config_flags%ucmcall
+!
+      DTPHS=NPHS*DT
+      RDTPHS=1./DTPHS
+      G_INV=1./G
+      ROG=R_D*G_INV
+      FACTOR=-XLV*RHOWATER/DTPHS
+!
+      U_FRAME=0.
+      V_FRAME=0.
+!
+      IDUMMY=0
+      ISFFLX=1
+      DX=0.
+      SST_UPDATE=0
+!
+      DO J=JMS,JME
+      DO I=IMS,IME
+        UZ0H(I,J)=0.
+        VZ0H(I,J)=0.
+        ONE(I,J)=1.
+        RMOL(I,J)=0.  !Reciprocal of Monin-Obukhov length
+        SFCEVPX(I,J)=0.  !Dummy for accumulated latent energy, not flux
+      ENDDO
+      ENDDO
+!
+      IF(MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==99)THEN
+        SNO_FACTR=1.
+      ELSE
+        SNO_FACTR=0.001
+      ENDIF
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+        LOWLYR(I,J)=1
+        VGFRCK(I,J)=100.*VEGFRC(I,J)
+        SNOW(I,J)=SNO(I,J)
+        SNOWH(I,J)=SI(I,J)*SNO_FACTR
+        XLAND(I,J)=SM(I,J)+1.
+        T2(I,J)=TSFC(I,J)
+        EMISS(I,J)=EPSR(I,J)
+      ENDDO
+      ENDDO
+!
+      IF(NTSD==0)THEN
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+        DO J=MYJS,MYJE
+        DO I=MYIS,MYIE
+          Z0BASE(I,J)=Z0(I,J)
+          IF(SM(I,J)>0.5.AND.SICE(I,J)>0.5)THEN  !Bandaid
+            SM(I,J)=0.        
+          ENDIF              
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=MYJS,MYJE
+      DO K=KTS,KTE+1
+      DO I=MYIS,MYIE
+        Z(I,K,J)=0.
+        DZ(I,K,J)=0.
+        EXCH_H(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!
+!***  PREPARE NEEDED ARRAYS
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(cwml,factrl,i,j,k,llij,llmh,pdsl,plyr,psfc,qi,ql,qr,qw   &
+!$omp&        ,tl,tlmh,tlmh4)
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+!
+        LLMH=LMH(I,J)
+        PDSL=PD(I,J)*RES(I,J)
+!!!     PSFC=PD(I,J)+PDTOP+PT
+!!!     P8W(I,KTS,J)=PSFC
+        P8W(I,KTS,J)=PINT(I,KTS,J)
+        PSFC=PINT(I,KTS,J)
+        LOWLYR(I,J)=KTE+1-LLMH
+        EXNSFC(I,J)=(1.E5/PSFC)**CAPA
+        THS(I,J)=(SST(I,J)*EXNSFC(I,J))*SM(I,J)+THS(I,J)*(1.-SM(I,J))
+        TSFC(I,J)=THS(I,J)/EXNSFC(I,J)
+        SFCZ(I,J)=FIS(I,J)*G_INV
+        ZERO_2D(I,J)=0.
+!YL     RAIN(I,J)=PREC(I,J)*RHOWATER
+        IF (PCPFLG.AND.DDATA(I,J)<100.)THEN
+          RAIN(I,J)=DDATA(I,J)*RHOWATER
+        ELSE
+          RAIN(I,J)=PREC(I,J)*RHOWATER
+        ENDIF
+!YL
+        RAINBL(I,J)=0.
+        IF(SNO(I,J)>0.)SNOWC(I,J)=1.
+        LLIJ=LOWLYR(I,J)
+        PLM(I,J)=(PINT(I,LLIJ,J)+PINT(I,LLIJ+1,J))*0.5
+        TH2X(I,J)=T(I,LLIJ,J)*(1.E5/PLM(I,J))**CAPA
+        Q2X(I,J)=Q(I,LLIJ,J)
+!
+!-----------------------------------------------------------------------
+!*** LONG AND SHORTWAVE FLUX AT GROUND SURFACE
+!-----------------------------------------------------------------------
+!
+        IF(CZMEAN(I,J)>0.)THEN
+          FACTRS(I,J)=CZEN(I,J)/CZMEAN(I,J)
+        ELSE
+          FACTRS(I,J)=0.
+        ENDIF
+!
+        IF(SIGT4(I,J)>0.)THEN
+          TLMH=T(I,LLIJ,J)
+          FACTRL=STBOLT*TLMH*TLMH*TLMH*TLMH/SIGT4(I,J)
+        ELSE
+          FACTRL=0.
+        ENDIF
+!     
+!- RLWIN/RSWIN - downward longwave/shortwave at the surface
+!
+        RLW_DN_SFC(I,J)=RLWIN(I,J)*HBM2(I,J)*FACTRL
+        RSW_NET_SFC(I,J)=(RSWIN(I,J)-RSWOUT(I,J))*HBM2(I,J)*FACTRS(I,J)
+!
+!- Instant downward solar for nmm_lsm
+!
+        RSW_DN_SFC(I,J)=RSWIN(I,J)*HBM2(I,J)*FACTRS(I,J)
+!
+!-----------------------------------------------------------------------
+!***  FILL THE ARRAYS FOR CALLING THE INNER DRIVER.
+!-----------------------------------------------------------------------
+!
+        Z(I,KTS,J)=SFCZ(I,J)
+!
+        DO K=KTS,KTE
+          Q2(I,K,J)=AMAX1(Q2(I,K,J)*HBM2(I,J),EPSQ2)
+          QL=AMAX1(Q(I,K,J),EPSQ)
+          PLYR=(PINT(I,K,J)+PINT(I,K+1,J))*0.5
+!!!       PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT
+          TL=T(I,K,J)
+          CWML=CWM(I,K,J)
+!
+          RR(I,K,J)=PLYR/(R_D*TL)
+          T_PHY(I,K,J)=TL
+!
+          EXNER(I,K,J)=(1.E5/PLYR)**CAPA
+          PI_PHY(I,K,J)=1./EXNER(I,K,J)
+          TH_PHY(I,K,J)=TL*EXNER(I,K,J)
+          P8W(I,K+1,J)=PINT(I,K+1,J)
+!!!       P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL+PT
+          P_PHY(I,K,J)=PLYR
+          TKE(I,K,J)=0.5*Q2(I,K,J)
+!
+          RTHBLTEN(I,K,J)=0.
+          RQVBLTEN(I,K,J)=0.
+          RQCBLTEN(I,K,J)=0.
+          RQIBLTEN(I,K,J)=0.
+!
+          Z(I,K+1,J)=Z(I,K,J)+TL/PLYR                                   &
+     &                  *(DETA1(K)*PDTOP+DETA2(K)*PDSL)*ROG             &
+                        *(Q(I,K,J)*P608-CWML+1.)
+          Z(I,K+1,J)=(Z(I,K+1,J)-DFRLG(K+1))*HTM(I,K,J)+DFRLG(K+1)
+!!!       FACTR=1.-HTM(I,K,J)
+!!!       Z(I,K+1,J)=Z(I,K+1,J)*HTM(I,K,J)+FACTR*DFRLG(K+1)
+          DZ(I,K,J)=Z(I,K+1,J)-Z(I,K,J)
+        ENDDO
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,llyr,qlowx)
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+        TWBS(I,J)=0.
+        QWBS(I,J)=0.
+        LLYR=LOWLYR(I,J)
+        THLOW(I,J)=TH_PHY(I,LLYR,J)
+        TLOW(I,J)=T_PHY(I,LLYR,J)
+        QLOW(I,J)=MAX(Q(I,LLYR,J),EPSQ)
+        QLOWX=QLOW(I,J)/(1.-QLOW(I,J))
+        QLOW(I,J)=QLOWX/(1.+QLOWX)
+        CWMLOW(I,J)=CWM(I,LLYR,J)
+        PBLH(I,J)=MAX(PBLH(I,J),0.)
+        PBLH(I,J)=MIN(PBLH(I,J),Z(I,KTE,J))
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!***  COMPUTE VELOCITY COMPONENTS AT MASS POINTS
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j,k,rwmsk,wmsk)
+      DO J=MYJS1_P1,MYJE1_P1
+!
+        DO K=KTS,KTE
+          DO I=MYIS_P1,MYIE_P1
+            WMSK=VTM(I+IHE(J),K,J)+VTM(I+IHW(J),K,J)                    &
+     &          +VTM(I,K,J+1)+VTM(I,K,J-1)
+            IF(WMSK>0.)THEN
+              RWMSK=1./WMSK
+              U_PHY(I,K,J)=(U(I+IHE(J),K,J)*VTM(I+IHE(J),K,J)           &
+     &                         +U(I+IHW(J),K,J)*VTM(I+IHW(J),K,J)       &
+     &                         +U(I,K,J+1)*VTM(I,K,J+1)                 &
+     &                         +U(I,K,J-1)*VTM(I,K,J-1))*RWMSK
+              V_PHY(I,K,J)=(V(I+IHE(J),K,J)*VTM(I+IHE(J),K,J)           &
+     &                         +V(I+IHW(J),K,J)*VTM(I+IHW(J),K,J)       &
+     &                         +V(I,K,J+1)*VTM(I,K,J+1)                 &
+     &                         +V(I,K,J-1)*VTM(I,K,J-1))*RWMSK
+            ELSE
+              U_PHY(I,K,J)=0.
+              V_PHY(I,K,J)=0.
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,iend,istr,j)
+      DO J=MYJS1_P1,MYJE1_P1
+        IF(MOD(J,2)==0)THEN
+          ISTR=MYIS_P1
+          IEND=MIN(MYIE_P1,IDE-1)
+        ELSE
+          ISTR=MAX(MYIS_P1,IDS+1)
+          IEND=MIN(MYIE_P1,IDE-1)
+        ENDIF
+!     
+        DO I=ISTR,IEND
+          UZ0H(I,J)=(UZ0(I+IHE(J),J)+UZ0(I+IHW(J),J)                    &
+     &              +UZ0(I,J+1)+UZ0(I,J-1))*0.25
+!!!  &              +UZ0(I,J+1)+UZ0(I,J-1))*HBM2(I,J)*0.25
+          VZ0H(I,J)=(VZ0(I+IHE(J),J)+VZ0(I+IHW(J),J)                    &
+     &              +VZ0(I,J+1)+VZ0(I,J-1))*0.25
+!!!  &              +VZ0(I,J+1)+VZ0(I,J-1))*HBM2(I,J)*0.25
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!***  CALL SURFACE LAYER AND LAND SURFACE PHYSICS
+!
+!-----------------------------------------------------------------------
+!
+      CALL SET_TILES(GRID,IDS,IDE-1,JDS+1,JDE-1,ITS,ITE,JTS,JTE)
+!
+      DO J=JTS,JTE  !jm was JTS
+      DO I=ITS,ITE
+        IF(MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==99)THEN
+          ONE(I,J)=1.
+        ELSE
+!tgs  -  MAVAIL should not be equal to 1. for other LSMs
+          ONE(I,J)=MAVAIL(I,J)
+        ENDIF 
+      ENDDO
+      ENDDO
+!
+      CALL SURFACE_DRIVER(                                              &
+     &           ACSNOM=ACSNOM,ACSNOW=ACSNOW,AKHS=AKHS,AKMS=AKMS        &
+     &          ,ALBEDO=ALBEDO,BR=BR,CANWAT=CMC,CHKLOWQ=CHKLOWQ         &
+     &          ,DT=DT,DX=DX,DZ8W=DZ,DZS=DZSOIL,GLW=RLW_DN_SFC          &
+     &          ,GRDFLX=GRNFLX,GSW=RSW_NET_SFC,SWDOWN=RSW_DN_SFC        &
+     &          ,GZ1OZ0=GZ1OZ0,HFX=TWBS                                 &
+     &          ,HT=SFCZ,IFSNOW=IDUMMY,ISFFLX=ISFFLX,ISLTYP=ISLTYP      &
+     &          ,ITIMESTEP=NTSD,IVGTYP=IVGTYP,LOWLYR=LOWLYR             &
+     &          ,MAVAIL=ONE,RMOL=RMOL,NUM_SOIL_LAYERS=NSOIL,P8W=P8W &
+     &          ,PBLH=PBLH,PI_PHY=PI_PHY,PSHLTR=PSHLTR,PSIH=PSIH        &
+     &          ,PSIM=PSIM,P_PHY=P_PHY,Q10=Q10,Q2=Q2X,QFX=QWBS,QSFC=QS  &
+     &          ,QSHLTR=QSHLTR,QZ0=QZ0,RAINCV=RAIN                      &
+     &          ,RHO=RR,SFCEVP=SFCEVPX,SFCEXC=SFCEXC,SFCRUNOFF=SSROFF   &
+     &          ,SMOIS=SMC,SMSTAV=SMSTAV,SMSTOT=SMSTOT,SNOALB=MXSNAL    &
+     &          ,SNOW=SNOW,SNOWC=SNOWC,SNOWH=SNOWH,STEPBL=NPHS          &
+     &          ,SST=SST,SST_UPDATE=SST_UPDATE                          &
+     &          ,TH10=TH10,TH2=TH2X,T2=T2,THZ0=THZ0,TH_PHY=TH_PHY       &
+     &          ,TMN=TG,TSHLTR=TSHLTR,TSK=TSFC,TSLB=STC,T_PHY=T_PHY     &
+     &          ,U10=U10,UDRUNOFF=BGROFF,UST=USTAR,UZ0=UZ0H             &
+     &          ,U_FRAME=U_FRAME,U_PHY=U_PHY,V10=V10,VEGFRA=VGFRCK      &
+     &          ,VZ0=VZ0H,V_FRAME=V_FRAME,V_PHY=V_PHY                   &
+     &          ,WARM_RAIN=WARM_RAIN,WSPD=WSPD,XICE=SICE                &
+     &          ,XLAND=XLAND,Z=Z,ZNT=Z0,ZS=SLDPTH,CT=CT,TKE_MYJ=TKE     &
+     &          ,ALBBCK=ALBASE,LH=ELFLX,SH2O=SH2O,SHDMAX=SHDMAX         &
+     &          ,SHDMIN=SHDMIN,Z0=Z0BASE,FLQC=FLQC,FLHC=FLHC            &
+     &          ,PSFC=PSFC_OUT,EMISS=EPSR                               &
+     &          ,SF_SFCLAY_PHYSICS=CONFIG_FLAGS%SF_SFCLAY_PHYSICS       &
+     &          ,SF_SURFACE_PHYSICS=CONFIG_FLAGS%SF_SURFACE_PHYSICS     &
+     &          ,RA_LW_PHYSICS=CONFIG_FLAGS%RA_LW_PHYSICS               &
+     &          ,UCMCALL=ucmcall                                        &
+     &          ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE        &
+     &          ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME        &
+     &          ,I_START=GRID%I_START,I_END=GRID%I_END                  &
+     &          ,J_START=GRID%J_START,J_END=GRID%J_END                  &
+     &          ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES               &
+           ! Optional args
+     &          ,QV_CURR=MOIST(IMS,KMS,JMS,P_QV),F_QV=F_QV              &
+     &          ,QC_CURR=MOIST(IMS,KMS,JMS,P_QC),F_QC=F_QC              &
+     &          ,QR_CURR=MOIST(IMS,KMS,JMS,P_QR),F_QR=F_QR              &
+     &          ,QI_CURR=MOIST(IMS,KMS,JMS,P_QI),F_QI=F_QI              &
+     &          ,QS_CURR=MOIST(IMS,KMS,JMS,P_QS),F_QS=F_QS              & 
+     &          ,QG_CURR=MOIST(IMS,KMS,JMS,P_QG),F_QG=F_QG              &
+     &          ,RAINBL=RAINBL                                          &
+! for RUCLSM
+     &          ,QSG=QSG, QVG=QVG, QCG=QCG, SOILT1=SOILT1               &
+     &          ,TSNAV=TSNAV, SMFR3D=SMFR3D, KEEPFR3DFLAG=KEEPFR3DFLAG  &
+     &          ,POTEVP=POTEVP,SNOPCX=SNOPCX,SOILTB=SOILTB,SR=SR)
+!
+!-----------------------------------------------------------------------
+!
+!***  CALL FREE ATMOSPHERE TURBULENCE
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=JMS,JME
+      DO K=KMS,KME
+      DO I=IMS,IME
+        DUDT(I,K,J)=0.
+        DVDT(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!***  THE SURFACE EXCHANGE COEFFICIENTS AKHS AND AKMS ARE ACTUALLY
+!***  MULTIPLIED BY HALF THE DEPTH OF THE LOWEST LAYER.  WE MUST RETAIN
+!***  THOSE VALUES FOR THE NEXT TIMESTEP SO USE AUXILLIARY ARRAYS FOR
+!***  THE OUTPUT.
+!
+!$omp parallel do                                                       &
+!$omp& private(dzhalf,i,j)
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        DZHALF=0.5*DZ(I,KTS,J)
+        AKHS_OUT(I,J)=AKHS(I,J)*DZHALF
+        AKMS_OUT(I,J)=AKMS(I,J)*DZHALF
+      ENDDO
+      ENDDO
+!
+      CALL PBL_DRIVER(                                                &
+     &                ITIMESTEP=NTSD,DT=DT                            &
+     &               ,U_FRAME=U_FRAME,V_FRAME=V_FRAME                 &
+     &               ,RUBLTEN=DUDT,RVBLTEN=DVDT,RTHBLTEN=RTHBLTEN     &
+     &               ,RQVBLTEN=RQVBLTEN,RQCBLTEN=RQCBLTEN             &
+     &               ,RQSBLTEN=RQIBLTEN                               &
+     &               ,TSK=TSFC,XLAND=XLAND,ZNT=Z0,HT=SFCZ             &
+     &               ,UST=USTAR, PBLH=PBLH                            &
+     &               ,HFX=TWBS,QFX=QWBS,  GRDFLX=GRNFLX               &
+     &               ,U_PHY=U_PHY,V_PHY=V_PHY,TH_PHY=TH_PHY,RHO=RR    &
+     &               ,P_PHY=P_PHY,PI_PHY=PI_PHY,P8W=P8W,T_PHY=T_PHY   &
+     &               ,DZ8W=DZ,Z=Z,TKE_MYJ=TKE,EL_MYJ=EL_MYJ           &
+     &               ,EXCH_H=EXCH_H,AKHS=AKHS,AKMS=AKMS               &
+     &               ,THZ0=THZ0,QZ0=QZ0,UZ0=UZ0H,VZ0=VZ0H             &
+     &               ,QSFC=QS,LOWLYR=LOWLYR                           &
+     &               ,PSIM=PSIM,PSIH=PSIH,GZ1OZ0=GZ1OZ0               &
+     &               ,WSPD=WSPD,BR=BR,CHKLOWQ=CHKLOWQ                 &
+     &               ,DX=DX,STEPBL=NPHS,WARM_RAIN=WARM_RAIN           &
+     &               ,KPBL=KPBL,CT=CT,LH=ELFLX,SNOW=SNOW,XICE=SICE    &
+     &               ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics      &
+     &               ,RA_LW_PHYSICS=config_flags%ra_lw_physics        &
+     &               ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
+     &               ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
+     &               ,I_START=GRID%I_START,I_END=GRID%I_END           &
+     &               ,J_START=GRID%J_START,J_END=GRID%J_END           &
+     &               ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES        &
+                ! Optional args
+     &               ,QV_CURR=moist(IMS,KMS,JMS,P_QV) , F_QV=F_QV     &
+     &               ,QC_CURR=moist(IMS,KMS,JMS,P_QC) , F_QC=F_QC     &
+     &               ,QR_CURR=moist(IMS,KMS,JMS,P_QR) , F_QR=F_QR     &
+     &               ,QI_CURR=moist(IMS,KMS,JMS,P_QI) , F_QI=F_QI     &
+     &               ,QS_CURR=moist(IMS,KMS,JMS,P_QS) , F_QS=F_QS     &
+     &               ,QG_CURR=moist(IMS,KMS,JMS,P_QG) , F_QG=F_QG   )
+!
+!***  NOTE THAT THE EXCHANGE COEFFICIENTS FOR HEAT EXCH_H COMING OUT OF
+!***  PBL_DRIVER ARE DEFINED AT THE TOPS OF THE LAYERS KTS TO KTE-1
+!***  IF MODULE_BL_MYJPBL WAS INVOKED.
+!
+!-----------------------------------------------------------------------
+! UNCOMPUTED LOCATIONS MUST BE FILLED IN FOR THE POST-PROCESSOR
+!-----------------------------------------------------------------------
+!
+!***  EASTERN GLOBAL BOUNDARY
+!
+      IF(MYIE==IDE)THEN
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+        DO J=JDS,JDE
+        IF (J>=MYJS.AND.J<=MYJE)THEN
+          TH10(MYIE,J)=TH10(MYIE-1,J)
+          Q10(MYIE,J)=Q10(MYIE-1,J)
+          U10(MYIE,J)=U10(MYIE-1,J)
+          V10(MYIE,J)=V10(MYIE-1,J)
+          TSHLTR(MYIE,J)=TSHLTR(MYIE-1,J)
+          QSHLTR(MYIE,J)=QSHLTR(MYIE-1,J)
+        ENDIF
+        ENDDO
+      ENDIF
+!
+!***  SOUTHERN GLOBAL BOUNDARY
+!
+
+      IF(MYJS==1)THEN
+        DO J=1,2
+        DO I=IDS,IDE
+          IF (I>=MYIS.AND.I<=MYIE) THEN
+            TH10(I,J)=TH10(I,MYJS+2)
+            Q10(I,J)=Q10(I,MYJS+2)
+            U10(I,J)=U10(I,MYJS+2)
+            V10(I,J)=V10(I,MYJS+2)
+            TSHLTR(I,J)=TSHLTR(I,MYJS+2)
+            QSHLTR(I,J)=QSHLTR(I,MYJS+2)
+          ENDIF
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!***  NORTHERN GLOBAL BOUNDARY
+!
+      IF(MYJE==JDE)THEN
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+        DO J=MYJE-1,MYJE
+        DO I=IDS,IDE
+          IF (I>=MYIS.AND.I<=MYIE) THEN
+            TH10(I,J)=TH10(I,MYJE-2)
+            Q10(I,J)=Q10(I,MYJE-2)
+            U10(I,J)=U10(I,MYJE-2)
+            V10(I,J)=V10(I,MYJE-2)
+            TSHLTR(I,J)=TSHLTR(I,MYJE-2)
+            QSHLTR(I,J)=QSHLTR(I,MYJE-2)
+          ENDIF
+        ENDDO
+        ENDDO
+      ENDIF
+!
+      IF(CONFIG_FLAGS%SF_SFCLAY_PHYSICS==1)THEN ! non-NMM package
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+        DO J=MYJS1,MYJE1
+        DO I=MYIS,MYIE1
+!         TSHLTR(I,J)=TSHLTR(I,J)*(1.E5/PSHLTR(I,J))**RCP
+          IF(TSHLTR(I,J)<200..OR.TSHLTR(I,J)>350.)THEN
+            WRITE(0,*)'Troublesome TSHLTR...I,J,TSHLTR,PSHLTR: ',       &
+               I,J,TSHLTR(I,J),PSHLTR(I,J)
+          ENDIF
+	ENDDO
+	ENDDO
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE MODEL LAYER CONTAINING THE TOP OF THE BOUNDARY LAYER
+!-----------------------------------------------------------------------
+!
+      IF(CONFIG_FLAGS%BL_PBL_PHYSICS/=MYJPBLSCHEME)THEN
+        LENGTH_ROW=MYIE1-MYIS1+1
+        DO J=MYJS2,MYJE2
+        DO I=MYIS1,MYIE1
+          KPBL(I,J)=-1000
+        ENDDO
+        ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(altitude,i,j,k,kount_all)
+        DO J=MYJS2,MYJE2
+          KOUNT_ALL=0
+          find_kpbl : DO K=KTS,KTE
+          DO I=MYIS1,MYIE1
+            ALTITUDE=Z(I,K+1,J)-SFCZ(I,J)
+            IF(PBLH(I,J)<=ALTITUDE.AND.KPBL(I,J)<0)THEN
+              KPBL(I,J)=K
+              KOUNT_ALL=KOUNT_ALL+1
+            ENDIF
+            IF(KOUNT_ALL==LENGTH_ROW)EXIT find_kpbl
+          ENDDO
+          ENDDO find_kpbl
+        ENDDO
+      ENDIF
+!
+      IF(MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==99)THEN
+        SNO_FACTR=1.
+      ELSE
+        SNO_FACTR=1000.
+      ENDIF
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS2,MYJE2
+      DO I=MYIS1,MYIE1
+        SNO(I,J)=SNOW(I,J)
+        SI(I,J)=SNOWH(I,J)*SNO_FACTR
+        LPBL(I,J)=KTE-KPBL(I,J)+1
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  DIAGNOSTIC RADIATION ACCUMULATION
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,tsfc2)
+      DO J=MYJS2,MYJE2
+      DO I=MYIS,MYIE
+        ASWIN (I,J)=ASWIN (I,J)+RSWIN(I,J)*HBM2(I,J)*FACTRS(I,J)
+        ASWOUT(I,J)=ASWOUT(I,J)-RSWOUT(I,J)*HBM2(I,J)*FACTRS(I,J)
+        ASWTOA(I,J)=ASWTOA(I,J)+RSWTOA(I,J)*HBM2(I,J)*FACTRS(I,J)
+        ALWIN (I,J)=ALWIN (I,J)+RLW_DN_SFC(I,J)
+        ALWOUT(I,J)=ALWOUT(I,J)-RADOT (I,J)*HBM2(I,J)
+        ALWTOA(I,J)=ALWTOA(I,J)+RLWTOA(I,J)*HBM2(I,J)
+!
+        TSFC2=TSFC(I,J)*TSFC(I,J)
+        RADOT(I,J)=HBM2(I,J)*EPSR(I,J)*STBOLT*TSFC2*TSFC2
+        THS(I,J)=TSFC(I,J)*EXNSFC(I,J)
+        PREC(I,J)=0.
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD, AND TKE.
+!-----------------------------------------------------------------------
+!
+      E_BDY=(ITE>=IDE)
+!
+!$omp parallel do                                                       &
+!$omp& private(dqdt,dtdt,i,iend,j,k,qi,qold,qr,qw,ratiomx,i_m)
+      DO J=MYJS2,MYJE2
+        IEND=MYIE1
+        IF(E_BDY.AND.MOD(J,2)==0)IEND=IEND-1
+!
+        DO K=KTS,KTE
+        DO I=MYIS1,IEND
+          DTDT=RTHBLTEN(I,K,J)*PI_PHY(I,K,J)
+          DQDT=RQVBLTEN(I,K,J)         !Mixing ratio tendency
+          T(I,K,J)=T(I,K,J)+DTDT*DTPHS
+          QOLD=Q(I,K,J)
+          RATIOMX=QOLD/(1.-QOLD)+DQDT*DTPHS
+          Q(I,K,J)=RATIOMX/(1.+RATIOMX)
+!         Q(I,K,J)=MAX(Q(I,K,J),EPSQ)
+          QW=max(0.,MOIST(I,K,J,P_QC)+RQCBLTEN(I,K,J)*DTPHS )
+          QI=max(0.,MOIST(I,K,J,P_QS)+RQIBLTEN(I,K,J)*DTPHS )
+          QR=max(0.,MOIST(I,K,J,P_QR) )
+!          CWM(I,K,J)=QW+QI+QR
+          CWM(I,K,J)=0. 
+!
+          DO I_M=1,N_MOIST
+             IF(I_M/=P_QV)THEN
+               CWM(I,K,J)=CWM(I,K,J)+MOIST(I,K,J,I_M)
+             ENDIF
+             IF(I_M==P_QV)THEN
+               MOIST(I,K,J,P_QV)=MAX(EPSQ,(MOIST(I,K,J,P_QV) + RQVBLTEN(I,K,J)*DTPHS) )
+             ELSEIF (I_M==P_QC)THEN
+                CWM(I,K,J)=MAX(0., (CWM(I,K,J) + RQCBLTEN(I,K,J)*DTPHS) )
+             ELSEIF(I_M==P_QI)THEN
+                CWM(I,K,J)=MAX(0., (CWM(I,K,J) + RQIBLTEN(I,K,J)*DTPHS) )
+             ENDIF
+          ENDDO
+!
+          MOIST(I,K,J,P_QC)=QW
+          MOIST(I,K,J,P_QS)=QI
+          MOIST(I,K,J,P_QR)=QR
+!
+          IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
+            IF(QI<=EPSQ)THEN  
+              F_ICE(I,K,J)=0.
+            ELSE
+              F_ICE(I,K,J)=MAX(0.,MIN(1.,QI/CWM(I,K,J)))
+            ENDIF
+!
+            IF(QR<=EPSQ)THEN
+              F_RAIN(I,K,J)=0.
+            ELSE
+              F_RAIN(I,K,J)=QR/(QW+QR)
+            ENDIF
+          ENDIF
+!
+          Q2(I,K,J)=2.*TKE(I,K,J)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***
+!***  SAVE SURFACE-RELATED FIELDS.
+!***
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j,llij,xlvrw)
+      DO J=MYJS2,MYJE2
+      DO I=MYIS1,MYIE1
+        LLIJ=LOWLYR(I,J)
+!
+!-----------------------------------------------------------------------
+!***  INSTANTANEOUS SENSIBLE AND LATENT HEAT FLUX
+!-----------------------------------------------------------------------
+!
+        TWBS(I,J)=-TWBS(I,J)
+        QWBS(I,J)=-QWBS(I,J)*XLV*CHKLOWQ(I,J)
+!
+!-----------------------------------------------------------------------
+!***  ACCUMULATED QUANTITIES.
+!***  IN OPNL LSM, SFCEVP APPEARS TO BE IN UNITS OF
+!***  METERS OF LIQUID WATER.  IT IS COMING FROM
+!***  WRF MODULE AS KG/M**2.
+!-----------------------------------------------------------------------
+!
+        SFCSHX(I,J)=SFCSHX(I,J)+TWBS(I,J)
+        SFCLHX(I,J)=SFCLHX(I,J)+QWBS(I,J)
+        XLVRW=DTPHS/(XLV*RHOWATER)
+        SFCEVP(I,J)=SFCEVP(I,J)-QWBS(I,J)*XLVRW
+        POTEVP(I,J)=POTEVP(I,J)-QWBS(I,J)*SM(I,J)*XLVRW
+        POTFLX(I,J)=POTEVP(I,J)*FACTOR
+        SUBSHX(I,J)=SUBSHX(I,J)+GRNFLX(I,J)
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  COUNTERS
+!-----------------------------------------------------------------------
+!
+      APHTIM=APHTIM+1.
+      ARDSW =ARDSW +1.
+      ARDLW =ARDLW +1.
+      ASRFC =ASRFC +1.
+!-----------------------------------------------------------------------
+!
+      END SUBROUTINE TURBL
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE UV_H_TO_V(NTSD,DT,NPHS,UZ0H,VZ0H,UZ0,VZ0               &
+     &                    ,DUDT,DVDT,U,V,HBM2,VTM,IVE,IVW               & 
+     &                    ,IDS,IDE,JDS,JDE,KDS,KDE                      &
+     &                    ,IMS,IME,JMS,JME,KMS,KME                      &
+     &                    ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    UV_H_TO_V   INTERPOLATE WINDS FROM H TO V POINTS
+!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 05-02-22       
+!     
+! ABSTRACT:
+!     INTERPOLATE WINDS BACK TO V POINTS AFTER TURBULENCE
+!     
+! PROGRAM HISTORY LOG :
+!   05-02-22  BLACK      - ORIGINATOR
+!     
+! USAGE: CALL TURBL FROM SOLVE_NMM
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM
+!$$$  
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE                     &
+     &                     ,NPHS,NTSD
+!
+      INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IVE,IVW
+!
+      REAL,INTENT(IN) :: DT
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HBM2,UZ0H,VZ0H
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DUDT,DVDT   &
+     &                                                     ,VTM
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: UZ0,VZ0
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: U,V
+!
+!-----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+!-----------------------------------------------------------------------
+!
+      INTEGER :: I,IEND,J,K
+!
+      REAL :: DTPHS
+!
+      LOGICAL :: E_BDY
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+      DTPHS=NPHS*DT
+      E_BDY=(ITE>=IDE)
+!
+!-----------------------------------------------------------------------
+!***  RECONSTRUCT UZ0 AND VZ0 ON VELOCITY POINTS.
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j)
+      DO J=MYJS2,MYJE2
+      DO I=MYIS,MYIE
+        UZ0(I,J)=(UZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J)                     &
+     &           +UZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J)                     &
+     &           +UZ0H(I,J+1)*HBM2(I,J+1)+UZ0H(I,J-1)*HBM2(I,J-1))*0.25
+        VZ0(I,J)=(VZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J)                     &
+     &           +VZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J)                     &
+     &           +VZ0H(I,J+1)*HBM2(I,J+1)+VZ0H(I,J-1)*HBM2(I,J-1))*0.25
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  INTERPOLATE WIND TENDENCIES TO VELOCITY POINTS AND UPDATE WINDS.
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(i,iend,j,k)
+      DO J=MYJS2,MYJE2
+        IEND=MYIE1
+        IF(E_BDY.AND.MOD(J,2)==1)IEND=IEND-1
+!
+        DO K=KTS,KTE
+        DO I=MYIS1,IEND
+          U(I,K,J)=(DUDT(I+IVE(J),K,J)+DUDT(I+IVW(J),K,J)               &
+     &             +DUDT(I,K,J+1)+DUDT(I,K,J-1))*0.25*DTPHS             &
+     &             *VTM(I,K,J)+U(I,K,J)
+          V(I,K,J)=(DVDT(I+IVE(J),K,J)+DVDT(I+IVW(J),K,J)               &
+     &             +DVDT(I,K,J+1)+DVDT(I,K,J-1))*0.25*DTPHS             &
+     &             *VTM(I,K,J)+V(I,K,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+      END SUBROUTINE UV_H_TO_V
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE CUCNVC(NTSD,DT,NCNVC,NRADS,NRADL                       &
+     &                 ,GPS,RESTRT,HYDRO                                &
+     &                 ,CLDEFI,LMH,N_MOIST,ENSDIM                       &
+     &                 ,MOIST                                           &
+     &                 ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2               &
+     &                 ,F_ICE,F_RAIN                                    &
+!***  Changes for other cu-schemes, most for gd scheme
+     &                 ,APR_GR,APR_W,APR_MC,TTEN,QTEN                   &
+     &                 ,APR_ST,APR_AS,APR_CAPMA                         &
+     &                 ,APR_CAPME          ,APR_CAPMI                   &
+     &                 ,MASS_FLUX         ,XF_ENS                       &
+     &                 ,PR_ENS,GSW                                      &
+#ifdef WRF_CHEM
+     &                 ,GD_CLOUD,GD_CLOUD2                              &
+#endif
+!
+     &                 ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TCUCN              &
+     &                 ,OMGALF,U,V,VTM,WINT,Z,FIS,W0AVG                 &
+     &                 ,PREC,ACPREC,CUPREC,CUPPT,CPRATE                 &
+     &                 ,SM,HBM2,LPBL,CNVBOT,CNVTOP                      &
+     &                 ,HTOP,HBOT,HTOPD,HBOTD,HTOPS,HBOTS               &
+     &                 ,RTHBLTEN,RQVBLTEN,RTHRATEN                      & 
+     &                 ,AVCNVC,ACUTIM,ZERO_3D,IHE,IHW                   &
+     &                 ,GRID,CONFIG_FLAGS                               &
+     &                 ,IDS,IDE,JDS,JDE,KDS,KDE                         &
+     &                 ,IMS,IME,JMS,JME,KMS,KME                         &
+     &                 ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    CUCNVC      CONVECTIVE PRECIPITATION OUTER DRIVER
+!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 02-03-21       
+!     
+! ABSTRACT:
+!     CUCVNC DRIVES THE WRF CONVECTION SCHEMES
+!     
+! PROGRAM HISTORY LOG:
+!   02-03-21  BLACK      - ORIGINATOR
+!   04-11-18  BLACK      - THREADED
+!     
+! USAGE: CALL CUCNVC FROM SOLVE_NMM
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM 
+!$$$  
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: ENSDIM                                      &
+     &                     ,IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE                     &
+     &                     ,N_MOIST,NCNVC,NTSD,NRADS,NRADL
+!
+      INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH,LPBL
+!
+      REAL,INTENT(IN) :: DT,GPS,PDTOP,PT
+!
+      REAL,INTENT(INOUT) :: ACUTIM,AVCNVC
+!
+      REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+      REAL,DIMENSION(KMS:KME  ),INTENT(IN) :: ETA1,ETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PD,RES,SM
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACPREC,CLDEFI    &
+     &                                                ,CNVBOT,CNVTOP    &
+     &                                                ,CUPPT,CUPREC     &
+     &                                                ,HBOT,HTOP        &
+     &                                                ,HBOTD,HTOPD      &
+     &                                                ,HBOTS,HTOPS      &
+     &                 ,APR_GR,APR_W,APR_MC                             &
+     &                 ,APR_ST,APR_AS,APR_CAPMA                         &
+     &                 ,APR_CAPME          ,APR_CAPMI                   &
+     &                 ,MASS_FLUX                                       &
+     &                 ,GSW  ,PREC,CPRATE
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: F_ICE       &
+     &                                                     ,F_RAIN
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: TTEN     &
+     &                                                     ,QTEN        &
+     &                                       ,RTHBLTEN,RQVBLTEN,RTHRATEN
+
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: Q,T      &
+     &                                                        ,CWM      &
+     &                                                        ,TCUCN    &
+     &                                                        ,W0AVG    &
+     &                                                        ,WINT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: OMGALF      &
+     &                                                     ,PINT,U,V    &
+     &                                                     ,VTM,Z
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: ZERO_3D
+      REAL,DIMENSION(IMS:IME,jMS:jME,1:ENSDIM),INTENT(INOUT) ::          &
+     &                         XF_ENS                                    &
+     &                        ,PR_ENS
+      
+!    
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST)                   &
+     &                                           ,INTENT(INOUT) :: moist
+#ifdef WRF_CHEM
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: GD_CLOUD,GD_CLOUD2
+#endif
+!
+      LOGICAL,INTENT(IN) :: HYDRO,RESTRT
+!
+      TYPE(DOMAIN),TARGET :: GRID
+!
+      TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
+!
+!-----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+!-----------------------------------------------------------------------
+      INTEGER :: I,ICLDCK,IENDX,J,K,MNTO,NCUBOT,NCUTOP,NSTEP_CNV        &
+     &          ,N_TIMSTPS_OUTPUT
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME) :: KPBL,LBOT,LOWLYR,LTOP
+!
+      REAL :: CAPA,CF_HI,DPL,DQDT,DTCNVC,DTDT,FICE,FRAIN,G_INV          &
+     &       ,PCPCOL,PDSL,PLYR,QI,QL_K,QR,QW,RDTCNVC,RWMSK,WMSK,WC
+!
+      REAL,DIMENSION(KMS:KME-1) :: QL,TL
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: CUBOT,CUTOP,NCA,RAINC,RAINCV   &
+     &                                  ,SFCZ,XLAND
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME) :: WMID
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W,P_PHY,PI_PHY    &
+     &                                          ,RQCCUTEN,RQRCUTEN      &
+     &                                          ,RQICUTEN,RQSCUTEN      &
+     &                                          ,RQVCUTEN,RR,RTHCUTEN   &
+     &                                          ,T_PHY,TH_PHY           &
+     &                                          ,U_PHY,V_PHY
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME)        :: ZERO_2D
+      REAL,DIMENSION(IMS:IME,JMS:JME,ENSDIM) :: ZERO_GD
+!
+      LOGICAL :: RESTART,WARM_RAIN
+      LOGICAL,DIMENSION(IMS:IME,JMS:JME) :: CU_ACT_FLAG
+!
+!-----------------------------------------------------------------------
+!***  FOR TEMPERATURE CHANGE CHECK ONLY.
+!-----------------------------------------------------------------------
+      INTEGER :: DTEMP_CHECK=1.0
+      REAL :: TCHANGE
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!***  RESET THE HBOT/HTOP CONVECTIVE CLOUD BOTTOM (BASE) AND TOP ARRAYS
+!***  USED IN RADIATION.  THEY STORE THE MAXIMUM VERTICAL LIMITS OF 
+!***  CONVECTIVE CLOUD BETWEEN RADIATION CALLS.  CUPPT IS THE ACCUMULATED
+!***  CONVECTIVE PRECIPITATION BETWEEN RADIATION CALLS.
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD,NRADS)==0.OR.MOD(NTSD,NRADL)==0)THEN
+         DO J=JMS,JME
+         DO I=IMS,IME
+           HTOP(I,J)=0.
+           HBOT(I,J)=REAL(KTE+1)
+           CUPPT(I,J)=0.
+         ENDDO
+         ENDDO
+      ENDIF
+!-----------------------------------------------------------------------
+      IF(MOD(NTSD,NCNVC)/=0.AND.                                      &
+     &   CONFIG_FLAGS%CU_PHYSICS==BMJSCHEME)RETURN
+      IF(MOD(NTSD,NCNVC)/=0.AND.                                      &
+     &   CONFIG_FLAGS%CU_PHYSICS==SASSCHEME)RETURN
+!-----------------------------------------------------------------------
+      NSTEP_CNV=NCNVC
+!
+      RESTART=RESTRT
+!-----------------------------------------------------------------------
+      IF(CONFIG_FLAGS%CU_PHYSICS==KFETASCHEME)THEN
+!
+        IF(.NOT.RESTART.AND.NTSD==0)THEN
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+          DO J=JTS,JTE
+          DO K=KTS,KTE
+          DO I=ITS,ITE
+            W0AVG(I,K,J)=0.
+          ENDDO
+          ENDDO
+          ENDDO
+        ENDIF
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  GENERAL PREPARATION 
+!-----------------------------------------------------------------------
+!
+      AVCNVC=AVCNVC+1.
+      ACUTIM=ACUTIM+1.
+!
+      DTCNVC=NCNVC*DT
+      RDTCNVC=1./DTCNVC
+      CAPA=R_D/CP
+      G_INV=1./G
+!
+!$omp parallel do                                                       &
+!$omp& private(dpl,fice,frain,i,j,k,pdsl,plyr,ql,tl)
+      DO J=MYJS2,MYJE2
+      DO I=MYIS1,MYIE1
+!
+        PDSL=PD(I,J)*RES(I,J)
+        RAINCV(I,J)=0.
+        RAINC(I,J)=0.
+        P8W(I,KTS,J)=PD(I,J)+PDTOP+PT
+        LOWLYR(I,J)=KTE+1-LMH(I,J)
+        XLAND(I,J)=SM(I,J)+1.
+        NCA(I,J)=0.
+        SFCZ(I,J)=FIS(I,J)*G_INV
+!tgs
+          CUTOP(I,J)=HTOP(I,J)
+          CUBOT(I,J)=HBOT(I,J)
+!
+!***  LPBL IS THE MODEL LAYER CONTAINING THE PBL TOP
+!***  COUNTING DOWNWARD FROM THE TOP OF THE DOMAIN
+!***  SO KPBL IS THE SAME LAYER COUNTING UPWARD FROM 
+!***  THE GROUND.
+!
+        KPBL(I,J)=KTE-LPBL(I,J)+1
+        ZERO_2D(I,J)=0
+!
+        DO K=KTS,KTE
+          DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL
+          QL(K)=AMAX1(Q(I,K,J),EPSQ)
+          PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT
+          TL(K)=T(I,K,J)
+!
+          RR(I,K,J)=PLYR/(R_D*TL(K)*(P608*QL(K)+1.))
+          T_PHY(I,K,J)=TL(K)
+
+          TH_PHY(I,K,J)=TL(K)*(1.E5/PLYR)**CAPA
+!!!       P8W(I,KFLIP,J)=PINT(I,K+1,J)
+          P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL+PT
+          P_PHY(I,K,J)=PLYR
+          PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA
+!
+          RTHCUTEN(I,K,J)=0.
+          RQVCUTEN(I,K,J)=0.
+          RQCCUTEN(I,K,J)=0.
+          RQRCUTEN(I,K,J)=0.
+          RQICUTEN(I,K,J)=0.
+          RQSCUTEN(I,K,J)=0.
+        ENDDO
+!
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!
+
+      IF(.NOT.HYDRO)THEN
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+        DO J=MYJS2,MYJE2
+        DO K=KTS,KTE
+        DO I=MYIS1,MYIE1
+          DZ(I,K,J)=Z(I,K+1,J)-Z(I,K,J)
+        ENDDO
+        ENDDO
+        ENDDO
+!
+        IF(NTSD==0)THEN
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+          DO J=MYJS2,MYJE2
+          DO K=KTS,KTE
+          DO I=MYIS1,MYIE1
+            WINT(I,K,J)=0.
+          ENDDO
+          ENDDO
+          ENDDO
+        ENDIF
+      ELSE
+        DO J=MYJS2,MYJE2
+        DO I=MYIS1,MYIE1
+          WINT(I,1,J)=0.
+          WINT(I,KTE+1,J)=0.
+        ENDDO
+        ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k,plyr,wmid)
+        DO J=MYJS2,MYJE2
+          DO I=MYIS1,MYIE1
+            WMID(I,KTS)=-OMGALF(I,KTS,J)*CP/(G*DT)
+            PDSL=PD(I,J)*RES(I,J)
+            PLYR=AETA1(KTS)*PDTOP+AETA2(KTS)*PDSL+PT
+            DZ(I,KTS,J)=T(I,KTS,J)*(P608*Q(I,KTS,J)+1.)*R_D             &
+     &                 *(P8W(I,KTS,J)-P8W(I,KTS+1,J))                   &
+     &                 /(PLYR*G)
+          ENDDO
+!
+          DO K=KTS+1,KTE
+          DO I=MYIS1,MYIE1
+            QL_K=AMAX1(Q(I,K,J),EPSQ)
+            WMID(I,K)=-OMGALF(I,K,J)*CP/(G*DT)
+            WINT(I,K,J)=0.5*(WMID(I,K-1)+WMID(I,K))
+            DZ(I,K,J)=T_PHY(I,K,J)*(P608*QL_K+1.)*R_D                   &
+     &               *(P8W(I,K,J)-P8W(I,K+1,J))                         &
+     &               /(P_PHY(I,K,J)*G)
+          ENDDO
+          ENDDO
+        ENDDO
+!
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  COMPUTE VELOCITY COMPONENTS AT MASS POINTS
+!-----------------------------------------------------------------------
+!
+      IF(CONFIG_FLAGS%CU_PHYSICS.NE.BMJSCHEME)THEN
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k,rwmsk,wmsk)
+        DO J=MYJS1_P1,MYJE1_P1
+!
+          DO K=KTS,KTE
+          DO I=MYIS_P1,MYIE_P1
+            WMSK=VTM(I+IHE(J),K,J)+VTM(I+IHW(J),K,J)                    &
+     &          +VTM(I,K,J+1)+VTM(I,K,J-1)
+            IF(WMSK>0.)THEN
+              RWMSK=1./WMSK
+              U_PHY(I,K,J)=(U(I+IHE(J),K,J)*VTM(I+IHE(J),K,J)           &
+     &                         +U(I+IHW(J),K,J)*VTM(I+IHW(J),K,J)       &
+     &                         +U(I,K,J+1)*VTM(I,K,J+1)                 &
+     &                         +U(I,K,J-1)*VTM(I,K,J-1))*RWMSK
+              V_PHY(I,K,J)=(V(I+IHE(J),K,J)*VTM(I+IHE(J),K,J)           &
+     &                         +V(I+IHW(J),K,J)*VTM(I+IHW(J),K,J)       &
+     &                         +V(I,K,J+1)*VTM(I,K,J+1)                 &
+     &                         +V(I,K,J-1)*VTM(I,K,J-1))*RWMSK
+            ELSE
+              U_PHY(I,K,J)=0.
+              V_PHY(I,K,J)=0.
+            ENDIF
+          ENDDO
+          ENDDO
+!
+        ENDDO
+!
+      ENDIF
+!-----------------------------------------------------------------------
+!
+!***  SINGLE-COLUMN CONVECTION
+!
+!-----------------------------------------------------------------------
+!
+      CALL SET_TILES(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)
+!
+      CALL CUMULUS_DRIVER(                                              &
+     &                  IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
+     &                 ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
+     &                 ,I_START=GRID%I_START,I_END=GRID%I_END           &
+     &                 ,J_START=GRID%J_START,J_END=GRID%J_END           &
+     &                 ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES        &
+                  ! Prognostic
+     &                 ,U=U_PHY,V=V_PHY,TH=TH_PHY,T=T_PHY,W=WINT        &
+     &                 ,P=P_PHY,PI=PI_PHY,RHO=RR,W0AVG=W0AVG            &
+                  ! Others
+     &                 ,ITIMESTEP=NTSD,DT=DT,DX=GPS                     &
+     &                 ,RAINC=RAINC,RAINCV=RAINCV,NCA=NCA               &
+     &                 ,DZ8W=DZ,P8W=P8W,FORCET=TTEN,FORCEQ=QTEN         &
+     &                 ,CLDEFI=cldefi,LOWLYR=lowlyr,XLAND=xland         &
+     &                 ,CU_ACT_FLAG=cu_act_flag,WARM_RAIN=warm_rain     &
+     &                 ,STEPCU=NSTEP_CNV,GSW=gsw                        &
+     &                 ,HTOP=CUTOP,HBOT=CUBOT,KPBL=KPBL,HT=SFCZ         &   
+     &                 ,APR_GR=apr_gr,APR_W=apr_w,APR_MC=apr_mc         &
+     &                 ,APR_ST=apr_st,APR_AS=apr_as,APR_CAPMA=apr_capma &
+     &                 ,APR_CAPME=apr_capme,APR_CAPMI=apr_capmi         &
+     &                 ,MASS_FLUX=mass_flux,XF_ENS=xf_ens               &
+     &                 ,PR_ENS=pr_ens                                   &
+#ifdef WRF_CHEM
+     &                 ,gd_cloud=gd_cloud,gd_cloud2=gd_cloud2           &
+#endif
+
+     &                 ,ENSDIM=ENSDIM,MAXIENS=1,MAXENS=3                &
+     &                 ,MAXENS2=3,MAXENS3=16                            &
+     &                 ,RTHCUTEN=RTHCUTEN ,RQVCUTEN=RQVCUTEN            &
+     &                 ,RQCCUTEN=RQCCUTEN ,RQRCUTEN=RQRCUTEN            &
+     &                 ,RQICUTEN=RQICUTEN ,RQSCUTEN=RQSCUTEN            &
+     &                 ,RTHBLTEN=RTHBLTEN,RQVBLTEN=RQVBLTEN             & 
+     &                 ,RTHRATEN=RTHRATEN                               & 
+                  ! Selection argument
+     &                 ,CU_PHYSICS=CONFIG_FLAGS%CU_PHYSICS              &
+                  ! Moisture tracer arguments
+     &                 ,QV_CURR=MOIST(IMS,KMS,JMS,P_QV),F_QV=F_QV       &
+     &                 ,QC_CURR=MOIST(IMS,KMS,JMS,P_QC),F_QC=F_QC       &
+     &                 ,QR_CURR=MOIST(IMS,KMS,JMS,P_QR),F_QR=F_QR       &
+     &                 ,QI_CURR=MOIST(IMS,KMS,JMS,P_QI),F_QI=F_QI       &
+     &                 ,QS_CURR=MOIST(IMS,KMS,JMS,P_QS),F_QS=F_QS       &
+     &                 ,QG_CURR=MOIST(IMS,KMS,JMS,P_QG),F_QG=F_QG      )
+!
+!-----------------------------------------------------------------------
+!
+!***  CNVTOP/CNVBOT HOLD THE MAXIMUM VERTICAL LIMITS OF CONVECTIVE CLOUD 
+!***  BETWEEN HISTORY OUTPUT TIMES.  HBOTS/HTOPS STORE SIMILIAR INFORMATION
+!***  FOR SHALLOW (NONPRECIPITATING) CONVECTION, AND HBOTD/HTOPD ARE FOR
+!***  DEEP (PRECIPITATING) CONVECTION.  
+!
+      CF_HI=CONFIG_FLAGS%HISTORY_INTERVAL
+      N_TIMSTPS_OUTPUT=NINT(60.*CF_HI/DT)
+      MNTO=MOD(NTSD,N_TIMSTPS_OUTPUT)
+!
+      IF(MNTO>0.AND.MNTO<=NCNVC)THEN
+        DO J=MYJS2,MYJE2
+        IENDX=MYIE1
+        IF(MOD(J,2)==0.AND.ITE==IDE-1)IENDX=IENDX-1
+        DO I=MYIS1,IENDX
+          CNVBOT(I,J)=REAL(KTE+1.)
+          CNVTOP(I,J)=0.
+          HBOTD(I,J)=REAL(KTE+1.)
+          HTOPD(I,J)=0.
+          HBOTS(I,J)=REAL(KTE+1.)
+          HTOPS(I,J)=0.
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!$omp parallel do                                                       &
+!$omp& private(dqdt,dtdt,i,iendx,j,k,ncubot,ncutop,pcpcol               &
+!$omp&        ,tchange                                                  &
+!$omp&        )
+      DO J=MYJS2,MYJE2
+      IENDX=MYIE1
+      IF(MOD(J,2)==0.AND.ITE==IDE-1)IENDX=IENDX-1
+      DO I=MYIS1,IENDX
+!
+!***  UPDATE TEMPERATURE, SPECIFIC HUMIDITY, AND HEATING.
+!***  THE FLIP IS BECAUSE RTHCUTEN AND RQVCUTEN REACH THIS POINT
+!***  WITH LAYER 1 AT THE BOTTOM.
+!
+        DO K=KTS,KTE
+!
+!***  RQVCUTEN IN BMJDRV IS THE MIXING RATIO TENDENCY,
+!***  SO RETRIEVE DQDT BY CONVERTING TO SPECIFIC HUMIDITY.
+!
+          DQDT=RQVCUTEN(I,K,J)/(1.+MOIST(I,K,J,P_QV))**2
+!
+!***  RTHCUTEN IN BMJDRV IS DTDT OVER PI.
+!
+          DTDT=RTHCUTEN(I,K,J)*PI_PHY(I,K,J)
+          T(I,K,J)=T(I,K,J)+DTDT*DTCNVC
+          Q(I,K,J)=Q(I,K,J)+DQDT*DTCNVC
+          MOIST(I,K,J,P_QV)=Q(I,K,J)/(1.-Q(I,K,J))       !Convert to mixing ratio
+!tgs - added next two lines
+          cps_select: SELECT CASE(config_flags%cu_physics)
+!
+          CASE (KFSCHEME,KFETASCHEME,GDSCHEME,SASSCHEME)
+             MOIST(I,K,J,P_QS)=MAX(0.,MOIST(I,K,J,P_QS)+RQICUTEN(I,K,J)*DTCNVC)
+             MOIST(I,K,J,P_QC)=MAX(0.,MOIST(I,K,J,P_QC)+RQCCUTEN(I,K,J)*DTCNVC)
+          END SELECT cps_select
+!
+          TCUCN(I,K,J)=TCUCN(I,K,J)+DTDT
+!
+          TCHANGE=DTDT*DTCNVC
+	  IF(ABS(TCHANGE)>DTEMP_CHECK)THEN
+            WRITE(0,*)'BIG T CHANGE BY CONVECTION:  I,J,K,NTSD',TCHANGE,I,J,K,NTSD
+	  ENDIF
+!
+        ENDDO
+!
+!***  UPDATE PRECIPITATION
+!
+        PCPCOL=RAINCV(I,J)*1.E-3*NSTEP_CNV
+        PREC(I,J)=PREC(I,J)+PCPCOL
+        ACPREC(I,J)=ACPREC(I,J)+PCPCOL
+        CUPREC(I,J)=CUPREC(I,J)+PCPCOL
+        CUPPT(I,J)=CUPPT(I,J)+PCPCOL
+        CPRATE(I,J)=PCPCOL
+!
+!***  SAVE CLOUD TOP AND BOTTOM FOR RADIATION (HTOP/HBOT) AND
+!***  FOR OUTPUT (CNVTOP/CNVBOT, HTOPS/HBOTS, HTOPD/HBOTD) ARRAYS.
+!***  MUST BE TREATED SEPARATELY FROM EACH OTHER.
+!
+        NCUTOP=NINT(CUTOP(I,J))
+        NCUBOT=NINT(CUBOT(I,J))
+!
+        IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
+          HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
+          CNVTOP(I,J)=MAX(CUTOP(I,J),CNVTOP(I,J))
+          IF(PCPCOL>0.)THEN
+            HTOPD(I,J)=MAX(CUTOP(I,J),HTOPD(I,J))
+          ELSE
+            HTOPS(I,J)=MAX(CUTOP(I,J),HTOPS(I,J))
+          ENDIF
+        ENDIF
+        IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
+          HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
+          CNVBOT(I,J)=MIN(CUBOT(I,J),CNVBOT(I,J))
+          IF(PCPCOL>0.)THEN
+            HBOTD(I,J)=MIN(CUBOT(I,J),HBOTD(I,J))
+          ELSE
+            HBOTS(I,J)=MIN(CUBOT(I,J),HBOTS(I,J))
+          ENDIF
+        ENDIF
+!
+      ENDDO
+      ENDDO
+!
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=JMS,JME
+      DO K=KMS,KME
+      DO I=IMS,IME
+        ZERO_3D(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+      END SUBROUTINE CUCNVC
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+      SUBROUTINE GSMDRIVE(NTSD,DT,NPHS,N_MOIST                          &
+     &                   ,DX,DY,LMH,SM,HBM2,FIS                         &
+     &                   ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2             &
+     &                   ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TRAIN            &
+     &                   ,MOIST,SCALAR,N_SCALAR                         &
+     &                   ,F_ICE,F_RAIN,F_RIMEF,SR                       &
+     &                   ,PREC,ACPREC,AVRAIN,ZERO_3D                    &
+     &                   ,MP_RESTART_STATE                              &
+     &                   ,TBPVS_STATE                                   &
+     &                   ,TBPVS0_STATE                                  &
+     &                   ,GRID,CONFIG_FLAGS                             &
+     &                   ,IDS,IDE,JDS,JDE,KDS,KDE                       &
+     &                   ,IMS,IME,JMS,JME,KMS,KME                       &
+     &                   ,ITS,ITE,JTS,JTE,KTS,KTE)
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    GSMDRIVE    MICROPHYSICS OUTER DRIVER
+!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 02-03-26       
+!     
+! ABSTRACT:
+!     GSMDRIVE DRIVES THE MICROPHYSICS SCHEMES
+!     
+! PROGRAM HISTORY LOG:
+!   02-03-26  BLACK      - ORIGINATOR
+!   04-11-18  BLACK      - THREADED
+!     
+! USAGE: CALL GSMDRIVE FROM SOLVE_NMM
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM
+!$$$  
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE                     &
+     &                     ,N_MOIST,N_SCALAR,NPHS,NTSD
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: DT,DX,DY,PDTOP,PT
+!
+      REAL,INTENT(INOUT) :: AVRAIN
+!
+      REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PD,RES,SM
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: ZERO_3D
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACPREC,PREC
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM,Q,T  &
+     &                                                        ,TRAIN
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: F_ICE    &
+     &                                                        ,F_RAIN   &
+     &                                                        ,F_RIMEF
+
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,n_moist),INTENT(INOUT) :: MOIST
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,n_scalar),INTENT(INOUT) :: SCALAR
+!
+!***  State var for etampnew microphysics (JM, 2005 05 02)
+!
+      REAL,DIMENSION(:),INTENT(INOUT) ::               MP_RESTART_STATE &
+     &                                                     ,TBPVS_STATE &
+     &                                                    ,TBPVS0_STATE
+
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: SR
+!
+      TYPE(DOMAIN),TARGET :: GRID
+!
+      TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
+!
+!-----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+!-----------------------------------------------------------------------
+      INTEGER :: I,I_M,IENDX,J,K,IJ
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME) :: LOWLYR
+!
+      REAL :: CAPA,DPL,DTPHS,PCPCOL,PDSL,PLYR,RDTPHS,RG,TNEW
+!
+      REAL,DIMENSION(KMS:KME-1) :: QL,TL
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: CUBOT,CUTOP,RAINNC,RAINNCV,XLAND      &
+     &                                  ,ZERO_2D
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W,P_PHY,PI_PHY    &
+     &                                          ,RR,T_PHY,TH_PHY
+!
+      LOGICAL :: E_BDY,F_QT,QT_PRESENT,WARM_RAIN
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+      IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
+        QT_PRESENT=.TRUE.
+      ELSE
+        QT_PRESENT=.FALSE.
+      ENDIF
+!
+      DTPHS=NPHS*DT
+      RDTPHS=1./DTPHS
+      CAPA=R_D/CP
+      RG=1./G
+      AVRAIN=AVRAIN+1.
+!
+!-----------------------------------------------------------------------
+!
+!***  PREPARE NEEDED ARRAYS
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(dpl,i,j,k,pdsl,plyr,ql,tl)
+      DO J=MYJS2,MYJE2
+      DO I=MYIS1,MYIE1
+!
+        PDSL=PD(I,J)*RES(I,J)
+        P8W(I,KTE+1,J)=PT
+        LOWLYR(I,J)=KTE+1-LMH(I,J)
+        XLAND(I,J)=SM(I,J)+1.
+        ZERO_2D(I,J)=0.
+! FILL RAINNC WITH ZERO (NORMALLY CONTAINS THE NONCONVECTIVE 
+!         ACCUMULATED RAIN BUT NOT YET USED BY NMM)
+! COULD BE OBTAINED FROM ACPREC AND CUPREC (ACPREC-CUPREC) 
+        RAINNC(I,J)=0.
+!
+!***  FILL THE SINGLE-COLUMN INPUT
+!
+        DO K=KTS,KTE
+          DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL
+          QL(K)=AMAX1(Q(I,K,J),EPSQ)
+!!!       PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT
+          PLYR=(PINT(I,K,J)+PINT(I,K+1,J))*0.5
+          TL(K)=T(I,K,J)
+!
+          RR(I,K,J)=PLYR/(R_D*TL(K)*(P608*QL(K)+1.))
+          T_PHY(I,K,J)=TL(K)
+          PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA
+          TH_PHY(I,K,J)=TL(K)/PI_PHY(I,K,J)
+!!!       P8W(I,KFLIP,J)=PINT(I,K+1,J)
+          P8W(I,K,J)=ETA1(K)*PDTOP+ETA2(K)*PDSL+PT
+          P_PHY(I,K,J)=PLYR
+          DZ(I,K,J)=DPL*RG/RR(I,K,J)
+        ENDDO
+!
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!***  CALL MICROPHYSICS
+!
+!-----------------------------------------------------------------------
+!
+      CALL SET_TILES(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)
+!
+      CALL MICROPHYSICS_DRIVER(                                         &
+     &                  TH=TH_PHY,RHO=RR,PI_PHY=PI_PHY,P=P_PHY          &
+     &                 ,RAINNC=RAINNC,RAINNCV=RAINNCV                   &
+     &                 ,DZ8W=DZ,P8W=P8W,DT=DTPHS,DX=DX,DY=DY            &
+     &                 ,MP_PHYSICS=CONFIG_FLAGS%MP_PHYSICS              &
+     &                 ,SPECIFIED=CONFIG_FLAGS%SPECIFIED                &
+     &                        .OR.CONFIG_FLAGS%NESTED                   &
+     &                 ,SPEC_ZONE=0,WARM_RAIN=WARM_RAIN                 &
+     &                 ,XLAND=XLAND,ITIMESTEP=NTSD-1                    &
+     &                 ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN               &
+     &                 ,F_RIMEF_PHY=F_RIMEF                             &
+     &                 ,LOWLYR=LOWLYR,SR=SR                             &
+     &                 ,QV_CURR=MOIST(IMS,KMS,JMS,P_QV),F_QV=F_QV       &
+     &                 ,QC_CURR=MOIST(IMS,KMS,JMS,P_QC),F_QC=F_QC       &
+     &                 ,QR_CURR=MOIST(IMS,KMS,JMS,P_QR),F_QR=F_QR       &
+     &                 ,QI_CURR=MOIST(IMS,KMS,JMS,P_QI),F_QI=F_QI       &
+     &                 ,QS_CURR=MOIST(IMS,KMS,JMS,P_QS),F_QS=F_QS       &
+     &                 ,QG_CURR=MOIST(IMS,KMS,JMS,P_QG),F_QG=F_QG       &
+     &                 ,QNI_CURR=SCALAR(IMS,KMS,JMS,P_QNI),F_QNI=F_QNI  &
+     &                 ,QT_CURR=CWM,F_QT=qt_present                     &
+     &                 ,MP_RESTART_STATE=MP_RESTART_STATE               &
+     &                 ,TBPVS_STATE=TBPVS_STATE                         &
+     &                 ,TBPVS0_STATE=TBPVS0_STATE                       &
+     &                 ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
+     &                 ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
+     &                 ,I_START=GRID%I_START,I_END=GRID%I_END           &
+     &                 ,J_START=GRID%J_START,J_END=GRID%J_END           &
+     &                 ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES        &
+                                                                        )
+
+!$omp parallel do                                                       &
+!$omp& private(ij)
+      DO IJ=1,GRID%NUM_TILES
+        CALL MICROPHYSICS_ZERO_OUT(                                     &
+                     MOIST,N_MOIST,CONFIG_FLAGS                         &
+                    ,IDS,IDE,JDS,JDE,KDS,KDE                            &
+                    ,IMS,IME,JMS,JME,KMS,KME                            &
+                    ,GRID%I_START(IJ),GRID%I_END(IJ)                    &
+                    ,GRID%J_START(IJ),GRID%J_END(IJ)                    &
+                    ,KTS,KTE                                       )
+      ENDDO
+
+
+
+!
+!-----------------------------------------------------------------------
+!
+      E_BDY=(ITE>=IDE)
+!
+!$omp parallel do                                                       &
+!$omp& private(i,iendx,j,k,pcpcol,tnew,i_m)
+      DO J=MYJS2,MYJE2
+      IENDX=MYIE1
+      IF(E_BDY.AND.MOD(J,2)==0)IENDX=IENDX-1
+      DO I=MYIS1,IENDX
+!
+!***  UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD WATER, AND HEATING.
+!
+        DO K=KTS,KTE
+          TNEW=TH_PHY(I,K,J)*PI_PHY(I,K,J)
+          TRAIN(I,K,J)=TRAIN(I,K,J)+(TNEW-T(I,K,J))*RDTPHS
+          T(I,K,J)=TNEW
+          Q(I,K,J)=MOIST(I,K,J,P_QV)/(1.+MOIST(I,K,J,P_QV)) !To s.h.
+!         CWM(I,K,J)=0.
+!         DO I_M=2,N_MOIST
+!           IF(I_M/=P_QV)THEN
+!             CWM(I,K,J)=CWM(I,K,J)+MOIST(I,K,J,I_M)
+!           ENDIF
+!         ENDDO
+        ENDDO
+!
+!-----------------------------------------------------------------------
+!***  UPDATE PRECIPITATION
+!-----------------------------------------------------------------------
+!
+        PCPCOL=RAINNCV(I,J)*1.E-3
+        PREC(I,J)=PREC(I,J)+PCPCOL
+        ACPREC(I,J)=ACPREC(I,J)+PCPCOL
+! NOTE: RAINNC IS ACCUMULATED INSIDE MICROPHYSICS BUT NMM ZEROES IT OUT ABOVE
+!    SINCE IT IS ONLY A LOCAL ARRAY FOR NOW
+!
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!$omp parallel do                                                       &
+!$omp& private(i,j,k)
+      DO J=JMS,JME
+      DO K=KMS,KME
+      DO I=IMS,IME
+        ZERO_3D(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!-------------------------------------------------------------------
+!
+      END SUBROUTINE GSMDRIVE
+!
+!-------------------------------------------------------------------
+!
+      END MODULE MODULE_PHYSICS_CALLS
+!
+!-------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_PRECIP_ADJUST.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_PRECIP_ADJUST.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_PRECIP_ADJUST.F	(revision 2744)
@@ -0,0 +1,297 @@
+!-----------------------------------------------------------------------
+!
+!NCEP_MESO:MODEL_LAYER: PHYSICS
+!
+!----------------------------------------------------------------------
+#include "nmm_loop_basemacros.h"
+#include "nmm_loop_macros.h"
+!-----------------------------------------------------------------------
+!
+      MODULE MODULE_PRECIP_ADJUST
+!
+! This module contains 3 subroutines:
+!     READPCP
+!     CHKSNOW
+!     ADJPPT
+!-----------------------------------------------------------------------
+!***
+!***  Specify the diagnostic point here: (i,j) and the processor number.
+!***  Remember that in WRF, local and global (i,j) are the same, so don't
+!***  use the "local(i,j)" output from glb2loc.f; use the GLOBAL (I,J)
+!***  and the PE_WRF.
+!***
+!
+      INTEGER :: ITEST=346,JTEST=256,TESTPE=53
+!-----------------------------------------------------------------------
+!
+      CONTAINS
+!
+!-----------------------------------------------------------------------
+      SUBROUTINE READPCP(PPTDAT,DDATA,LSPA                              &
+     &  ,IDS,IDE,JDS,JDE,KDS,KDE                                        &
+     &  ,IMS,IME,JMS,JME,KMS,KME                                        &
+     &  ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+!     ****************************************************************
+!     *                                                              *
+!     *   PRECIPITATION ASSIMILATION INITIALIZATION.                 *
+!     *    READ IN PRECIP ANALYSIS AND DATA MASK AND SET UP ALL      *
+!     *    APPROPRIATE VARIABLES.                                    *
+!     *                   MIKE BALDWIN, MARCH 1994                   *
+!     *                   Adapted to 2-D code, Ying Lin, Mar 1996    *
+!     *                   For WRF/NMM: Y.Lin Mar 2005                *
+!     *                                                              *
+!     ****************************************************************
+!-----------------------------------------------------------------------
+!
+! READ THE BINARY VERSION OF THE PRECIP ANALYSIS.
+!
+      IMPLICIT NONE
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE,                    &
+     &                      IMS,IME,JMS,JME,KMS,KME,                    &
+     &                      ITS,ITE,JTS,JTE,KTS,KTE
+      REAL,DIMENSION(IDS:IDE,JDS:JDE) :: TEMPG
+      REAL,DIMENSION(IMS:IME,JMS:JME) :: TEMPL
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: DDATA, LSPA
+      REAL,DIMENSION(IMS:IME,JMS:JME,3),INTENT(OUT) :: PPTDAT
+      INTEGER :: I, J, IHR
+      INTEGER :: MYPE
+      CHARACTER*256 :: MESSAGE
+!
+! Get the value of MYPE:
+!
+      CALL WRF_GET_MYPROC(MYPE)
+!
+      TEMPG=999.
+!
+      DO IHR=1,3
+        IF(MYPE==0)THEN
+          READ(40+IHR) ((TEMPG(I,J),I=IDS,IDE-1),J=JDS,JDE-1)
+          WRITE(MESSAGE,*) 'IHR=', IHR, ' FINISHED READING PCP TO TEMPG'
+          CALL WRF_MESSAGE(MESSAGE)
+          CLOSE(40+IHR)
+!
+          DO J=JDS,JDE-1
+            DO I=IDS,IDE-1
+! In the binary version of the precip data, missing data are denoted as '999.'
+! Convert the valid data from mm to m:
+              IF (TEMPG(I,J).LT.900.) TEMPG(I,J)=TEMPG(I,J)*0.001
+            ENDDO
+          ENDDO
+        ENDIF
+!
+! Distribute to local temp array:
+        CALL DSTRB(TEMPG,TEMPL,1,1,1,1,1                                &
+     &,                IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &,                IMS,IME,JMS,JME,KMS,KME                          &
+     &,                ITS,ITE,JTS,JTE,KTS,KTE)
+!
+! Place into correct hour slot in PPTDAT:
+        DO J=JMS,JME
+          DO I=IMS,IME
+            PPTDAT(I,J,IHR)=TEMPL(I,J)
+          ENDDO
+        ENDDO
+!
+        IF(MYPE==TESTPE)THEN
+          WRITE(MESSAGE,*) 'ADJPPT-READPCP, IHR',IHR, 'PPTDAT=',        &
+     &      PPTDAT(ITEST,JTEST,IHR)
+          CALL WRF_MESSAGE(MESSAGE)
+        ENDIF
+
+      ENDDO
+!
+! Give DDATA (hourly precipitation analysis partitioned into each physics
+! timestep; partitioning done in ADJPPT) an initial value of 999, because
+! TURBL/SURFCE is called before ADJPPT.  Also initialize LSPA to zero.
+!
+      DDATA=999.
+      LSPA=0.
+!
+      RETURN
+      END SUBROUTINE READPCP
+!
+      SUBROUTINE CHKSNOW(NTSD,DT,NPHS,SR,PPTDAT                         &
+     &  ,IDS,IDE,JDS,JDE,KDS,KDE                                        &
+     &  ,IMS,IME,JMS,JME,KMS,KME                                        &
+     &  ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+! AT THE FIRST PHYSICS TIME STEP AFTER THE TOP OF EACH HOUR, CHECK THE SNOW
+! ARRAY AGAINST THE SR (SNOW/TOTAL PRECIP RATIO).  IF SR .GE. 0.9, SET THIS
+! POINT TO MISSING (SO WE WON'T DO SNOW ADJUSTMENT HERE).
+!
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: NTSD,NPHS
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE,                    &
+     &                      IMS,IME,JMS,JME,KMS,KME,                    &
+     &                      ITS,ITE,JTS,JTE,KTS,KTE
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: SR
+      REAL,DIMENSION(IMS:IME,JMS:JME,3),INTENT(INOUT) :: PPTDAT
+      REAL,INTENT(IN) :: DT
+      REAL :: TIMES
+      INTEGER :: I, J, IHR
+      INTEGER :: MYPE
+      CHARACTER*256 :: MESSAGE
+!-----------------------------------------------------------------------
+      TIMES=NTSD*DT
+      IF (MOD(TIMES,3600.) < NPHS*DT) THEN
+        IHR=INT(TIMES)/3600+1
+        IF (IHR > 3) go to 10
+        DO J=MYJS2,MYJE2
+        DO I=MYIS1,MYIE1
+          IF (SR(I,J) >= 0.9) PPTDAT(I,J,IHR) = 999.
+        ENDDO
+        ENDDO
+!
+! Get the value of MYPE:
+!
+        CALL WRF_GET_MYPROC(MYPE)
+!
+        IF (MYPE==TESTPE) THEN
+          WRITE(MESSAGE,1010) TIMES,SR(ITEST,JTEST)
+ 1010     FORMAT('ADJPPT-CHKSNOW: TIMES, SR=',F6.0,X,F6.4)
+          CALL WRF_MESSAGE(MESSAGE)
+        ENDIF
+      ENDIF
+ 10   CONTINUE
+      RETURN
+      END SUBROUTINE CHKSNOW
+!
+      SUBROUTINE ADJPPT(NTSD,DT,NPHS,PREC,LSPA,PPTDAT,DDATA             &
+     &  ,IDS,IDE,JDS,JDE,KDS,KDE                                        &
+     &  ,IMS,IME,JMS,JME,KMS,KME                                        &
+     &  ,ITS,ITE,JTS,JTE,KTS,KTE)
+
+!***********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    ADJPPT    PRECIPITATION/CLOUD ADJUSTMENT
+!    PRGRMMR:    Y. LIN    ORG: W/NP22     DATE: 2005/03/30
+!     
+! ABSTRACT:
+!     ADJPPT  MAKES ADJUSTMENT TO MODEL'S TEMPERATURE, MOISTURE, HYDROMETEOR
+!     FIELDS TO BE MORE CONSISTENT WITH THE OBSERVED PRECIPITATION AND CLOUD
+!     TOP PRESSURE
+!     
+!     FOR NOW, AS A FIRST STEP, JUST PARTITION THE INPUT HOURLY PRECIPITATION
+!     OBSERVATION INTO TIME STEPS, AND FEED IT INTO THE SOIL.
+! PROGRAM HISTORY LOG:
+!
+!   2005/03/30  LIN      - BAREBONES PRECIPITATION PARTITION/FEEDING TO GROUND
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM 
+!$$$  
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: NPHS, NTSD
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE,                    &
+     &                      IMS,IME,JMS,JME,KMS,KME,                    &
+     &                      ITS,ITE,JTS,JTE,KTS,KTE
+      REAL,INTENT(IN) :: DT
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: PREC
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: DDATA, LSPA
+      REAL,DIMENSION(IMS:IME,JMS:JME,3),INTENT(OUT) :: PPTDAT
+!-----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+!-----------------------------------------------------------------------
+      REAL :: DTPHS, FRACT, FRACT1, FRACT2, TIMES, TPHS1, TPHS2
+      INTEGER :: I, J, IHR, IHR1, IHR2, NTSP
+      INTEGER :: MYPE
+      CHARACTER*256 :: MESSAGE
+!
+! Get the value of MYPE:
+!
+      CALL WRF_GET_MYPROC(MYPE)
+!
+      TIMES=NTSD*DT
+      IHR=INT(TIMES)/3600+1
+! Size of physics time step:
+      DTPHS=NPHS*DT
+!
+! Compute the beginning and ending time of the current physics time step,
+! TPHS1 and TPHS2:
+!  
+      NTSP=NTSD/NPHS+1
+      TPHS1=(NTSP-1)*DTPHS
+      TPHS2=NTSP*DTPHS
+!
+      IHR1=INT(TPHS1)/3600+1
+      IHR2=INT(TPHS2)/3600+1
+!
+! Fraction of an hour that falls into IHR1 and IHR2.  Note that IHR1 and IHR2
+! might be identical.
+      IF (IHR1 > 3) THEN 
+        GO TO 200
+      ELSEIF (IHR2 > 3) THEN
+        IHR2=3
+        FRACT1=(3600.- MOD(INT(TPHS1),3600))/3600.
+        FRACT2=0.
+      ELSEIF (IHR1 .EQ. IHR2) THEN
+         FRACT1=0.5*DTPHS/3600.
+         FRACT2=FRACT1
+      ELSE
+         FRACT1=(3600.- MOD(INT(TPHS1),3600))/3600.
+         FRACT2=FLOAT(MOD(INT(TPHS2),3600))/3600.
+      ENDIF
+!
+      FRACT=FRACT1 + FRACT2
+!
+      IF (MYPE==TESTPE) THEN
+         WRITE(MESSAGE,1010) NTSD,NTSP,TIMES,IHR1,IHR2,TPHS1,TPHS2,      &
+      &    FRACT1,FRACT2
+ 1010    FORMAT('ADJPPT: NTSD,NTSP,TIMES=',I4,X,I4,1X,F6.0,' IHR1,IHR2=',&
+      &    I1,X,I1,' TPHS1,TPHS2=',F6.0,X,F6.0,' FRACT1,FRACT2=',        &
+      &    2(X,F6.4))
+        CALL WRF_MESSAGE(MESSAGE)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!   FRACT1/2 IS THE FRACTION OF IHR1/2'S PRECIP THAT WE WANT FOR
+!   THIS ADJUSTMENT (assuming that the physics time step spans over
+!   IHR1 and IHR2.  If not, then IHR1=IHR2).
+!-----------------------------------------------------------------------
+!   SET UP OBSERVED PRECIP FOR THIS TIMESTEP IN DDATA
+!-----------------------------------------------------------------------
+      DO J=MYJS2,MYJE2
+      DO I=MYIS1,MYIE1
+! Note sometimes IHR1=IHR2.  
+        IF (PPTDAT(I,J,IHR1).GT.900..OR.PPTDAT(I,J,IHR2).GT.900.) THEN
+          DDATA(I,J) = 999.
+          LSPA(I,J) = LSPA(I,J) + PREC(I,J)
+          GO TO 100
+        ELSE
+          IF (IHR2 .LE. 3) then
+            DDATA(I,J) = PPTDAT(I,J,IHR1)*FRACT1                        &
+     &                 + PPTDAT(I,J,IHR2)*FRACT2
+          ELSE
+            DDATA(I,J) = PPTDAT(I,J,IHR1)*FRACT1 
+          ENDIF
+!
+           LSPA(I,J) = LSPA(I,J) + DDATA(I,J)
+        ENDIF
+        IF (I.EQ.ITEST .AND. J.EQ.JTEST .AND. MYPE.EQ.TESTPE) THEN
+          WRITE(MESSAGE,1020) DDATA(I,J), PREC(I,J), LSPA(I,J)
+ 1020     FORMAT('ADJPPT: DDATA=',E12.6, ' PREC=',E12.6,' LSPA=',E12.6)
+          CALL WRF_MESSAGE(MESSAGE)
+        ENDIF
+!
+ 100    CONTINUE
+      ENDDO
+      ENDDO
+!
+ 200  CONTINUE
+
+      RETURN
+      END SUBROUTINE ADJPPT
+END MODULE module_PRECIP_ADJUST
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_TIMERS.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_TIMERS.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_TIMERS.F	(revision 2744)
@@ -0,0 +1,17 @@
+!
+      MODULE MODULE_TIMERS
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!***  TIMERS OF FORECAST COMPONENTS
+!
+      REAL :: adve_tim,bocoh_tim,bocov_tim,chkout_tim,cltend_tim       &
+             ,cucnvc_tim,ddamp_tim,eps_tim,exch_tim,goss_tim           &
+             ,gsmdrive_tim,had2_tim,hadz_tim,hdiff_tim                 &
+             ,init_tim,nhb_tim,pdtedt_tim,pfdht_tim                    &
+             ,radtn_tim,rdtemp_tim,res_tim,surfce_tim,turbl_tim        &
+             ,vad2_tim,vadz_tim          
+      REAL :: allocm_tim,allocs_tim,digflt_tim,fltas_tim               &
+             ,gossip_tim,mpp_tim,runstream_tim
+      REAL :: brun_tim,btim,btimx,pct,tot_tim,tot2_tim
+!----------------------------------------------------------------------
+      END MODULE MODULE_TIMERS
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_ZEROX.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_ZEROX.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_ZEROX.F	(revision 2744)
@@ -0,0 +1,85 @@
+      MODULE MODULE_ZEROX
+!----------------------------------------------------------------------
+      CONTAINS
+!----------------------------------------------------------------------
+!**********************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    ZEROx       ZERO OUT MULTI-DIMENSIONAL ARRAY
+!   PRGRMMR: BLACK           ORG: W/NP2      DATE: 01-03-20
+!
+! ABSTRACT:
+!     SUBROUTINE ZEROx FILLS REAL ARRAYS WITH ZEROES
+!
+!     CURRENT INTERFACES: ZERO2, ZERO3
+!
+! PROGRAM HISTORY LOG:
+!   01-03-20  BLACK      - ORIGINATOR
+!
+! USAGE: CALL ZERO WHERE NEEDED
+!   INPUT ARGUMENT LIST:
+!      ARR2 - THE ARRAY TO BE FILLED
+!       IMS - THE STARTING I VALUE FOR LOCAL MEMORY
+!       IME - THE ENDING I VALUE FOR LOCAL MEMORY
+!       JMS - THE STARTING J VALUE FOR LOCAL MEMORY
+!       JME - THE ENDING J VALUE FOR LOCAL MEMORY
+!
+!   OUTPUT ARGUMENT LIST:
+!      ARR2
+!
+!   OUTPUT FILES:
+!     NONE
+!
+!   SUBPROGRAMS CALLED:
+!
+!     UNIQUE: NONE
+!
+!     LIBRARY: NONE
+!
+!   COMMON BLOCKS: NONE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$
+!**********************************************************************
+      SUBROUTINE ZERO2(ARR2,IS,IE,JS,JE)
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IE,IS,JE,JS
+      REAL,DIMENSION(IS:IE,JS:JE),INTENT(INOUT) :: ARR2
+!
+      INTEGER :: I,J
+!**********************************************************************
+!----------------------------------------------------------------------
+      DO J=JS,JE
+      DO I=IS,IE
+        ARR2(I,J)=0.
+      ENDDO
+      ENDDO
+!----------------------------------------------------------------------
+      END SUBROUTINE ZERO2
+!**********************************************************************
+      SUBROUTINE ZERO3(ARR2,IS,IE,JS,JE,KS,KE)
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IE,IS,JE,JS,KE,KS
+      REAL,DIMENSION(IS:IE,KS:KE,JS:JE),INTENT(INOUT) :: ARR2
+!
+      INTEGER :: I,J,K
+!**********************************************************************
+!----------------------------------------------------------------------
+      DO J=JS,JE
+      DO K=KS,KE
+      DO I=IS,IE
+        ARR2(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!----------------------------------------------------------------------
+      END SUBROUTINE ZERO3
+!**********************************************************************
+!----------------------------------------------------------------------
+      END MODULE MODULE_ZEROX
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_initialize_real.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_initialize_real.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_initialize_real.F	(revision 2744)
@@ -0,0 +1,1741 @@
+!REAL:MODEL_LAYER:INITIALIZATION
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains, specifically for the Eulerian, mass-based coordinate.
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize
+
+   USE module_bc
+   USE module_configure
+   USE module_domain
+   USE module_io_domain
+   USE module_model_constants
+!   USE module_si_io_nmm
+   USE module_state_description
+   USE module_timing
+   USE module_soil_pre
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain ( grid )
+
+      IMPLICIT NONE
+
+      !  Input space and data.  No gridded meteorological data has been stored, though.
+
+!     TYPE (domain), POINTER :: grid 
+      TYPE (domain)          :: grid 
+
+      !  Local data.
+
+      INTEGER :: dyn_opt 
+      INTEGER :: idum1, idum2
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+#include "deref_kludge.h"
+
+      CALL nl_get_dyn_opt ( head_grid%id, dyn_opt )
+      
+      CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+      IF (      dyn_opt .eq. 1 &
+           .or. dyn_opt .eq. 2 &
+           .or. dyn_opt .eq. 3 &
+                                          ) THEN
+        CALL wrf_error_fatal ( "no RK version within dyn_nmm, dyn_opt wrong in namelist, wrf_error_fataling" )
+
+     ELSEIF ( dyn_opt .eq. 4 ) THEN
+
+        CALL init_domain_nmm (grid &
+!
+#include <nmm_actual_args.inc>
+!
+      )
+
+      ELSE
+         WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+        CALL wrf_error_fatal ( "ERROR-dyn_opt-wrong-in-namelist" )
+      ENDIF
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+!---------------------------------------------------------------------
+   SUBROUTINE init_domain_nmm ( grid &
+!
+# include <nmm_dummy_args.inc>
+!
+   )
+
+      USE module_optional_si_input
+      IMPLICIT NONE
+
+      !  Input space and data.  No gridded meteorological data has been stored, though.
+
+!     TYPE (domain), POINTER :: grid
+      TYPE (domain)          :: grid
+
+# include <nmm_dummy_decl.inc>
+
+      TYPE (grid_config_rec_type)              :: config_flags
+
+      !  Local domain indices and counters.
+
+      INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+
+      INTEGER                             ::                       &
+                                     ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte, &
+                                     i, j, k, NNXP, NNYP, ICOUNT, &
+                                     FLAG_RUC_SNOW, FLAG_NAM_SNOW
+
+      !  Local data
+
+        CHARACTER(LEN=19):: start_date
+
+#ifdef DM_PARALLEL
+
+        LOGICAL,EXTERNAL :: WRF_DM_ON_MONITOR
+
+!              INTEGER :: DOMDESC
+              REAL,ALLOCATABLE    :: SICE_G(:,:), SM_G(:,:)
+              INTEGER, ALLOCATABLE::  IHE_G(:),IHW_G(:)
+#endif
+
+
+      CHARACTER (LEN=132) :: message
+
+      INTEGER :: error
+      REAL    :: p_surf, p_level
+      REAL    :: cof1, cof2
+      REAL    :: qvf , qvf1 , qvf2 , pd_surf
+      REAL    :: p00 , t00 , a
+      REAL    :: hold_znw, rmin,rmax
+
+      LOGICAL :: stretch_grid, dry_sounding, debug, log_flag_sst
+
+        REAL, ALLOCATABLE,DIMENSION(:,:):: ADUM2D,SNOWC,HT,TG_ALT
+
+        INTEGER, ALLOCATABLE, DIMENSION(:):: KHL2,KVL2,KHH2,KVH2, &
+                                             KHLA,KHHA,KVLA,KVHA
+
+!        INTEGER, ALLOCATABLE, DIMENSION(:,:):: LU_INDEX
+
+        REAL, ALLOCATABLE, DIMENSION(:):: DXJ,WPDARJ,CPGFUJ,CURVJ, &
+                                          FCPJ,FDIVJ,EMJ,EMTJ,FADJ, &
+                                          HDACJ,DDMPUJ,DDMPVJ
+
+!-- Carsel and Parrish [1988]
+         REAL , DIMENSION(100) :: lqmi
+         integer iicount 
+
+        REAL:: TPH0D,TLM0D
+        REAL:: TPH0,WB,SB,DLM,DPH,TDLM,TDPH
+        REAL:: WBI,SBI,EBI,ANBI,STPH0,CTPH0
+        REAL:: TSPH,DTAD,DTCF
+        REAL:: ACDT,CDDAMP,TPH,DXP,TLM,FP
+        REAL:: CTPH,STPH
+        REAL:: WBD,SBD
+        REAL:: RSNOW,SNOFAC
+        REAL, PARAMETER:: SALP=2.60
+        REAL, PARAMETER:: SNUP=0.040
+        REAL:: SMCSUM,STCSUM,SEAICESUM,FISX
+        REAL:: cur_smc, aposs_smc
+
+        REAL:: TERM1,APH
+
+        INTEGER:: KHH,KVH,JAM,JA, IHL, IHH, L
+        INTEGER:: II,JJ,ISRCH,ISUM,ITER
+
+        REAL, PARAMETER:: DTR=0.01745329
+        REAL, PARAMETER:: W_NMM=0.08
+        REAL, PARAMETER:: COAC=1.6
+        REAL, PARAMETER:: CODAMP=6.4
+        REAL, PARAMETER:: TWOM=.00014584
+        REAL, PARAMETER:: CP=1004.6
+        REAL, PARAMETER:: DFC=1.0
+        REAL, PARAMETER:: DDFC=8.0
+        REAL, PARAMETER:: ROI=916.6
+        REAL, PARAMETER:: R=287.04
+        REAL, PARAMETER:: CI=2060.0
+        REAL, PARAMETER:: ROS=1500.
+        REAL, PARAMETER:: CS=1339.2
+        REAL, PARAMETER:: DS=0.050
+        REAL, PARAMETER:: AKS=.0000005
+        REAL, PARAMETER:: DZG=2.85
+        REAL, PARAMETER:: DI=.1000
+        REAL, PARAMETER:: AKI=0.000001075
+        REAL, PARAMETER:: DZI=2.0
+        REAL, PARAMETER:: THL=210.
+        REAL, PARAMETER:: PLQ=70000.
+        REAL, PARAMETER:: ERAD=6371200.
+        REAL, PARAMETER:: TG0=258.16
+        REAL, PARAMETER:: TGA=30.0
+
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+#include "deref_kludge.h"
+
+        if (ALLOCATED(ADUM2D)) DEALLOCATE(ADUM2D)
+        if (ALLOCATED(TG_ALT)) DEALLOCATE(TG_ALT)
+
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+#ifdef DM_PARALLEL
+#    include <nmm_data_calls.inc>
+#endif
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+            kds = grid%sd31 ; kde = grid%ed31 ;
+            ids = grid%sd32 ; ide = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            kms = grid%sm31 ; kme = grid%em31 ;
+            ims = grid%sm32 ; ime = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            kts = grid%sp31 ; kte = grid%ep31 ; ! tile is entire patch
+            its = grid%sp32 ; ite = grid%ep32 ; ! tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
+
+         CASE ( DATA_ORDER_XYZ )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            jds = grid%sd32 ; jde = grid%ed32 ;
+            kds = grid%sd33 ; kde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            jms = grid%sm32 ; jme = grid%em32 ;
+            kms = grid%sm33 ; kme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
+            jts = grid%sp32 ; jte = grid%ep32 ; ! tile is entire patch
+            kts = grid%sp33 ; kte = grid%ep33 ; ! tile is entire patch
+
+         CASE ( DATA_ORDER_XZY )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            kds = grid%sd32 ; kde = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            kms = grid%sm32 ; kme = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
+            kts = grid%sp32 ; kte = grid%ep32 ; ! tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
+
+      END SELECT
+
+        
+        grid%DT=float(grid%TIME_STEP)
+
+        NNXP=min(ITE,IDE-1)
+        NNYP=min(JTE,JDE-1)
+
+        write(0,*) 'nnxp,nnyp: ', nnxp,nnyp
+        write(0,*) 'IDE, JDE: ', IDE,JDE
+
+        JAM=6+2*(JDE-JDS-10)
+
+        ALLOCATE(ADUM2D(grid%sm31:grid%em31,jms:jme))
+        ALLOCATE(KHL2(JTS:NNYP),KVL2(JTS:NNYP),KHH2(JTS:NNYP),KVH2(JTS:NNYP))
+        ALLOCATE(DXJ(JTS:NNYP),WPDARJ(JTS:NNYP),CPGFUJ(JTS:NNYP),CURVJ(JTS:NNYP))
+        ALLOCATE(FCPJ(JTS:NNYP),FDIVJ(JTS:NNYP),&
+                 FADJ(JTS:NNYP))
+        ALLOCATE(HDACJ(JTS:NNYP),DDMPUJ(JTS:NNYP),DDMPVJ(JTS:NNYP))
+        ALLOCATE(KHLA(JAM),KHHA(JAM))
+        ALLOCATE(KVLA(JAM),KVHA(JAM))
+
+
+    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+        write(0,*) 'cen_lat: ', config_flags%cen_lat
+        write(0,*) 'cen_lon: ', config_flags%cen_lon
+        write(0,*) 'dx: ', config_flags%dx
+        write(0,*) 'dy: ', config_flags%dy
+        write(0,*) 'config_flags%start_year: ', config_flags%start_year
+        write(0,*) 'config_flags%start_month: ', config_flags%start_month
+        write(0,*) 'config_flags%start_day: ', config_flags%start_day
+        write(0,*) 'config_flags%start_hour: ', config_flags%start_hour
+
+	write(0,*) 'writing to start_date'
+
+        write(start_date,435) config_flags%start_year, config_flags%start_month, &
+                config_flags%start_day, config_flags%start_hour
+  435   format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':00:00')
+        
+        dlmd=config_flags%dx
+        dphd=config_flags%dy
+        tph0d=config_flags%cen_lat
+        tlm0d=config_flags%cen_lon
+
+	write(0,*) 'dlmd, dphd, tph0d, tlm0d: ', dlmd, dphd, tph0d, tlm0d
+
+!==========================================================================
+
+!!
+
+ !  Check to see if the boundary conditions are set 
+ !  properly in the namelist file.
+ !  This checks for sufficiency and redundancy.
+
+      CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+      !  Some sort of "this is the first time" initialization.  Who knows.
+
+      grid%itimestep=0
+
+      !  Pull in the info in the namelist to compare it to the input data.
+
+      grid%real_data_init_type = model_config_rec%real_data_init_type
+
+!!! WEASD has "snow water equivalent" in mm
+
+	FLAG_RUC_SNOW=0
+	FLAG_NAM_SNOW=0
+    IF(maxval(snow).gt.0.) FLAG_RUC_SNOW=1
+    IF(maxval(weasd).gt.0.) FLAG_NAM_SNOW=1
+
+       DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+
+      IF(SM(I,J).GT.0.9) THEN
+
+       IF (XICE(I,J) .gt. 0) then
+         SI(I,J)=1.0
+       ENDIF
+
+!  SEA
+              EPSR(I,J)=.97
+              GFFC(I,J)=0.
+              ALBEDO(I,J)=.06
+              ALBASE(I,J)=.06
+              IF(SI (I,J).GT.0.    ) THEN
+!  SEA-ICE
+                 SM(I,J)=0.
+                 SI(I,J)=0.
+                 SICE(I,J)=1.
+                 GFFC(I,J)=0. ! just leave zero as irrelevant
+                 ALBEDO(I,J)=.60
+                 ALBASE(I,J)=.60
+              ENDIF
+           ELSE
+
+! LAND
+    IF(FLAG_RUC_SNOW .eq. 1) THEN
+! RUC variable for snow is SNOW
+        SI(I,J)=SNOW(I,J)/RHOSN(I,J)
+        EPSR(I,J)=1.0
+        GFFC(I,J)=0.0 ! just leave zero as irrelevant
+        SICE(I,J)=0.
+        SNO(I,J)=SNOW(I,J)/1000.
+
+     ELSEIF (FLAG_NAM_SNOW .eq. 1) THEN
+!  NAM variable for snow is WEASD
+        SI(I,J)=5.0*WEASD(I,J)/1000.
+        EPSR(I,J)=1.0
+        GFFC(I,J)=0.0 ! just leave zero as irrelevant
+        SICE(I,J)=0.
+        SNO(I,J)=WEASD(I,J)/1000.
+     ELSE
+        SI(I,J)=0.
+        EPSR(I,J)=1.0
+        GFFC(I,J)=0.0 ! just leave zero as irrelevant
+        SICE(I,J)=0.
+        SNO(I,J)=0.
+     ENDIF
+           ENDIF
+        ENDDO
+        ENDDO
+
+! DETERMINE ALBEDO OVER LAND
+       DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+          IF(SM(I,J).LT.0.9.AND.SICE(I,J).LT.0.9) THEN
+! SNOWFREE ALBEDO
+            IF ( (SNO(I,J) .EQ. 0.0) .OR. &
+                (ALBASE(I,J) .GE. MXSNAL(I,J) ) ) THEN
+              ALBEDO(I,J) = ALBASE(I,J)
+            ELSE
+! MODIFY ALBEDO IF SNOWCOVER:
+! BELOW SNOWDEPTH THRESHOLD...
+              IF (SNO(I,J) .LT. SNUP) THEN
+                RSNOW = SNO(I,J)/SNUP
+                SNOFAC = 1. - ( EXP(-SALP*RSNOW) - RSNOW*EXP(-SALP))
+! ABOVE SNOWDEPTH THRESHOLD...
+              ELSE
+                SNOFAC = 1.0
+              ENDIF
+! CALCULATE ALBEDO ACCOUNTING FOR SNOWDEPTH AND VGFRCK
+              ALBEDO(I,J) = ALBASE(I,J) &
+               + (1.0-VEGFRA(I,J))*SNOFAC*(MXSNAL(I,J)-ALBASE(I,J))
+            ENDIF
+          END IF
+    IF(FLAG_RUC_SNOW .eq. 1) then
+        SI(I,J)=SNOW(I,J)/RHOSN(I,J)*1000.
+        SNO(I,J)=SNOW(I,J)
+!          SNO(I,J)=SNOW(I,J)
+!          SNO(I,J)=WEASD(I,J)
+    ELSEIF (FLAG_NAM_SNOW .eq. 1) then
+
+          SI(I,J)=5.0*WEASD(I,J)
+          SNO(I,J)=WEASD(I,J)
+    ELSE
+        SI(I,J)=0.
+        SNO(I,J)=0.
+    ENDIF
+        ENDDO
+      ENDDO
+
+#ifdef DM_PARALLEL
+
+        ALLOCATE(SM_G(IDS:IDE,JDS:JDE),SICE_G(IDS:IDE,JDS:JDE))
+
+        CALL WRF_PATCH_TO_GLOBAL_REAL( SICE(IMS,JMS)           &
+     &,                                SICE_G,grid%DOMDESC         &
+     &,                               'z','xy'                       &
+     &,                                IDS,IDE-1,JDS,JDE-1,1,1          &
+     &,                                IMS,IME,JMS,JME,1,1              &
+     &,                                ITS,ITE,JTS,JTE,1,1 )
+
+        CALL WRF_PATCH_TO_GLOBAL_REAL( SM(IMS,JMS)           &
+     &,                                SM_G,grid%DOMDESC         &
+     &,                               'z','xy'                       &
+     &,                                IDS,IDE-1,JDS,JDE-1,1,1          &
+     &,                                IMS,IME,JMS,JME,1,1              &
+     &,                                ITS,ITE,JTS,JTE,1,1 )
+
+
+        IF (WRF_DM_ON_MONITOR()) THEN
+
+  637   format(40(f3.0,1x))
+
+        allocate(IHE_G(JDS:JDE-1),IHW_G(JDS:JDE-1))
+       DO j = JDS, JDE-1
+          IHE_G(J)=MOD(J+1,2)
+          IHW_G(J)=IHE_G(J)-1
+       ENDDO
+
+      DO ITER=1,10
+       DO j = jds+1, (jde-1)-1
+         DO i = ids+1, (ide-1)-1
+
+! any sea ice around point in question?
+
+        IF (SM_G(I,J) .eq. 1.) THEN
+          SEAICESUM=SICE_G(I+IHE_G(J),J+1)+SICE_G(I+IHW_G(J),J+1)+ &
+                    SICE_G(I+IHE_G(J),J-1)+SICE_G(I+IHW_G(J),J-1)
+          IF (SEAICESUM .ge. 1. .and. SEAICESUM .lt. 3.) THEN
+            IF ((SICE_G(I+IHE_G(J),J+1).eq.0 .and. SM_G(I+IHE_G(J),J+1).eq.0) .OR. &
+                (SICE_G(I+IHW_G(J),J+1).eq.0 .and. SM_G(I+IHW_G(J),J+1).eq.0) .OR. &
+                (SICE_G(I+IHE_G(J),J-1).eq.0 .and. SM_G(I+IHE_G(J),J-1).eq.0) .OR. &
+                (SICE_G(I+IHW_G(J),J-1).eq.0 .and. SM_G(I+IHW_G(J),J-1).eq.0)) THEN
+
+!       HAVE SEA ICE AND A SURROUNDING LAND POINT - CONVERT TO SEA ICE
+!       write(0,*) 'making seaice (1): ', I,J
+              SICE_G(I,J)=1.0
+              SM_G(I,J)=0.
+            ENDIF
+          ELSEIF (SEAICESUM .ge. 3) THEN
+!       WATER POINT SURROUNDED BY ICE  - CONVERT TO SEA ICE
+!       write(0,*) 'making seaice (2): ', I,J
+        SICE_G(I,J)=1.0
+        SM_G(I,J)=0.
+          ENDIF
+        ENDIF
+
+        ENDDO
+       ENDDO
+      ENDDO
+
+        ENDIF
+
+        CALL WRF_GLOBAL_TO_PATCH_REAL( SICE_G, SICE           &
+     &,                                grid%DOMDESC         &
+     &,                               'z','xy'                       &
+     &,                                IDS,IDE-1,JDS,JDE-1,1,1          &
+     &,                                IMS,IME,JMS,JME,1,1              &
+     &,                                ITS,ITE,JTS,JTE,1,1 )
+
+        CALL WRF_GLOBAL_TO_PATCH_REAL( SM_G,SM           &
+     &,                                grid%DOMDESC         &
+     &,                               'z','xy'                       &
+     &,                                IDS,IDE-1,JDS,JDE-1,1,1          &
+     &,                                IMS,IME,JMS,JME,1,1              &
+     &,                                ITS,ITE,JTS,JTE,1,1 )
+
+        IF (WRF_DM_ON_MONITOR()) THEN
+
+        DEALLOCATE(SM_G,SICE_G)
+        DEALLOCATE(IHE_G,IHW_G)
+
+        ENDIF
+
+!        write(0,*) 'revised sea ice on patch'
+!        do J=JTE,JTS,-JTE/25
+!        write(0,637) (SICE(I,J),I=ITS,ITE,ITE/20)
+!        enddo
+
+!        write(0,*) 'revised sea mask on patch'
+!        do J=JTE,JTS,-JTE/25
+!        write(0,637) (SM(I,J),I=ITS,ITE,ITE/20)
+!        enddo
+
+
+#else
+! serial sea ice reprocessing
+
+       DO j = jts, MIN(jte,jde-1)
+          IHE(J)=MOD(J+1,2)
+          IHW(J)=IHE(J)-1
+       ENDDO
+
+      DO ITER=1,10
+       DO j = jts+1, MIN(jte,jde-1)-1
+         DO i = its+1, MIN(ite,ide-1)-1
+
+! any sea ice around point in question?
+
+        IF (SM(I,J) .eq. 1) THEN
+          SEAICESUM=SICE(I+IHE(J),J+1)+SICE(I+IHW(J),J+1)+ &
+                  SICE(I+IHE(J),J-1)+SICE(I+IHW(J),J-1)
+          IF (SEAICESUM .ge. 1. .and. SEAICESUM .lt. 3.) THEN
+            IF ((SICE(I+IHE(J),J+1).eq.0 .and. SM(I+IHE(J),J+1).eq.0) .OR. &
+                (SICE(I+IHW(J),J+1).eq.0 .and. SM(I+IHW(J),J+1).eq.0) .OR. &
+                (SICE(I+IHE(J),J-1).eq.0 .and. SM(I+IHE(J),J-1).eq.0) .OR. &
+                (SICE(I+IHW(J),J-1).eq.0 .and. SM(I+IHW(J),J-1).eq.0)) THEN
+
+!       HAVE SEA ICE AND A SURROUNDING LAND POINT - CONVERT TO SEA ICE
+              SICE(I,J)=1.0
+              SM(I,J)=0.
+            ENDIF
+          ELSEIF (SEAICESUM .ge. 3) THEN
+!       WATER POINT SURROUNDED BY ICE  - CONVERT TO SEA ICE
+        SICE(I,J)=1.0
+        SM(I,J)=0.
+          ENDIF
+        ENDIF
+
+        ENDDO
+       ENDDO
+      ENDDO
+
+#endif
+
+! this block meant to guarantee land/sea agreement between SM and landmask
+
+       DO j = jts, MIN(jte,jde-1)
+         DO i = its, MIN(ite,ide-1)
+
+        if (SM(I,J) .gt. 0.5) then
+                landmask(I,J)=0.0
+        elseif (SM(I,J) .eq. 0 .and. SICE(I,J) .eq. 1) then
+                landmask(I,J)=0.0
+        elseif (SM(I,J) .lt. 0.5 .and. SICE(I,J) .eq. 0) then
+                landmask(I,J)=1.0
+        else
+        write(0,*) 'missed point in landmask definition ' , I,J
+        landmask(I,J)=0.0
+        endif
+
+        ENDDO
+      ENDDO
+
+      !  For sf_surface_physics = 1, we want to use close to a 10 cm value
+      !  for the bottom level of the soil temps.
+
+      IF      ( ( model_config_rec%sf_surface_physics(grid%id) .EQ. 1 ) .AND. &
+                ( flag_st000010 .EQ. 1 ) ) THEN
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               soiltb(i,j) = st000010(i,j)
+            END DO
+         END DO
+      END IF
+
+  !  Adjust the various soil temperature values depending on the difference in
+  !  in elevation between the current model's elevation and the incoming data's
+  !  orography.
+
+        write(0,*) 'flag_toposoil= ', flag_toposoil
+         
+      IF ( ( flag_toposoil .EQ. 1 ) ) THEN 
+
+        ALLOCATE(HT(ims:ime,jms:jme))
+
+        DO J=jms,jme
+          DO I=ims,ime
+              HT(I,J)=FIS(I,J)/9.81
+          END DO
+        END DO
+           
+!       if (maxval(toposoil) .gt. 100.) then
+!
+!  Being avoided.   Something to revisit eventually.
+!
+!1219 might be simply a matter of including TOPOSOIL 
+!
+!    CODE NOT TESTED AT NCEP USING THIS FUNCTIONALITY, 
+!    SO TO BE SAFE WILL AVOID FOR RETRO RUNS.
+!
+!       write(0,*) 'calling adjust_soil_temp_new'
+!        CALL adjust_soil_temp_new ( soiltb , 2 , &
+!                       nmm_tsk , ht , toposoil , landmask, flag_toposoil , &
+!                       st000010 , st010040 , st040100 , st100200 , st010200 , &
+!                       flag_st000010 , flag_st010040 , flag_st040100 , &
+!                       flag_st100200 , flag_st010200 , &
+!                       soilt000 , soilt005 , soilt020 , soilt040 , &
+!                       soilt160 , soilt300 , &
+!                       flag_soilt000 , flag_soilt005 , flag_soilt020 , &
+!                       flag_soilt040 , flag_soilt160 , flag_soilt300 , &
+!                       ids , ide , jds , jde , kds , kde , &
+!                       ims , ime , jms , jme , kms , kme , &
+!                       its , ite , jts , jte , kts , kte )
+!       endif
+
+      END IF
+
+      !  Process the LSM data.
+   
+      IF ( grid%real_data_init_type .EQ. 1 ) THEN
+   
+         num_veg_cat      = SIZE ( landusef , DIM=2 )
+         num_soil_top_cat = SIZE ( soilctop , DIM=2 )
+         num_soil_bot_cat = SIZE ( soilcbot , DIM=2 )
+
+!       sm (1=water, 0=land)
+!       landmask(0=water, 1=land)
+
+         CALL process_percent_cat_new ( landmask , &
+                         landusef , soilctop , soilcbot , &
+                         isltyp , ivgtyp , &
+                         num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                         ids , ide , jds , jde , kds , kde , &
+                         ims , ime , jms , jme , kms , kme , &
+                         its , ite , jts , jte , kts , kte , &
+                         model_config_rec%iswater(grid%id) )
+
+        DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+
+        IF (SICE(I,J) .eq. 0) THEN
+
+        if (landmask(I,J) .gt. 0.5 .and. sm(I,J) .eq. 1.0) then
+                write(0,*) 'land mask and SM both > 0.5: ', &
+                                           I,J,landmask(I,J),sm(I,J)
+
+        SM(I,J)=0.
+
+        elseif (landmask(I,J) .lt. 0.5 .and. sm(I,J) .eq. 0.0) then
+                write(0,*) 'land mask and SM both < 0.5: ', &
+                                           I,J, landmask(I,J),sm(I,J)
+
+        SM(I,J)=1.
+
+        endif
+
+        ELSE
+
+        if (landmask(I,J) .gt. 0.5 .and. SM(I,J)+SICE(I,J) .eq. 1) then
+        write(0,*) 'landmask says LAND, SM/SICE say SEAICE: ', I,J
+        endif
+
+        ENDIF
+
+           ENDDO
+        ENDDO
+
+         DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+
+        if (SICE(I,J) .eq. 1.0) then
+!!!! change vegtyp and sltyp to fit seaice (desireable??)
+        ISLTYP(I,J)=16
+        IVGTYP(I,J)=24
+        endif
+
+            ENDDO
+         ENDDO
+
+
+! MOVE HERE
+
+        write(0,*) 'flag_sst before define is: ', flag_sst
+        FLAG_SST=1
+
+         DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+
+        if (SM(I,J) .lt. 0.5) then
+            SST(I,J)=0.
+        endif
+
+        if (SM(I,J) .gt. 0.5) then
+          if (SST(I,J) .eq. 0) then
+            SST(I,J)=NMM_TSK(I,J)
+          endif
+            NMM_TSK(I,J)=0.
+        endif
+
+                
+        if ( (NMM_TSK(I,J)+SST(I,J)) .lt. 200. .or. &
+             (NMM_TSK(I,J)+SST(I,J)) .gt. 350. ) then
+        write(0,*) 'TSK, SST trouble at : ', I,J
+        write(0,*) 'SM= ', SM(I,J)
+        write(0,*) 'NMM_TSK(I,J), SST(I,J): ', NMM_TSK(I,J), SST(I,J)
+        endif
+
+            ENDDO
+         ENDDO
+
+        write(0,*) 'SM'
+        do J=min(jde-1,jte),jts,-(jte-jts)/15
+        write(0,635) (sm(i,J),I=its,ite,(ite-its)/10)
+        enddo
+
+!       write(0,*) 'SST/NMM_TSK'
+!       do J=min(jde-1,jte),jts,-(jte-jts)/15
+!       write(0,635) (SST(I,J)+NMM_TSK(I,J),I=ITS,min(ide-1,ite),(ite-its)/10)
+!       enddo
+
+  635   format(20(f5.1,1x))
+
+         DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+               IF ( ( landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) ) THEN
+                  soiltb(i,j) = sst(i,j)
+!curious               ELSE IF (  landmask(i,j) .LT. 0.5 ) THEN
+               ELSE IF (  landmask(i,j) .GT. 0.5 ) THEN
+                  soiltb(i,j) = nmm_tsk(i,j)
+               END IF
+            END DO
+         END DO
+
+!      END IF
+
+! END MOVE HERE
+
+   !  Land use categories, dominant soil and vegetation types (if available).
+
+!       allocate(lu_index(ims:ime,jms:jme))
+   
+          DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+               lu_index(i,j) = ivgtyp(i,j)
+            END DO
+          END DO
+
+      END IF
+
+        if (flag_sst .eq. 1) log_flag_sst=.true.
+        if (flag_sst .eq. 0) log_flag_sst=.false.
+
+	write(0,*) 'st_input dimensions: ', size(st_input,dim=1),size(st_input,dim=2),size(st_input,dim=3)
+
+        write(0,*) 'maxval st_input(1): ', maxval(st_input(:,1,:))
+        write(0,*) 'maxval st_input(2): ', maxval(st_input(:,2,:))
+        write(0,*) 'maxval st_input(3): ', maxval(st_input(:,3,:))
+        write(0,*) 'maxval st_input(4): ', maxval(st_input(:,4,:))
+
+!!!!!!!!!!!!!!!!!!!!!!!!!
+
+        ALLOCATE(TG_ALT(grid%sm31:grid%em31,jms:jme))
+
+      TPH0=TPH0D*DTR
+      WBD=-(((ide-1)-1)*DLMD)
+      WB= WBD*DTR
+      SBD=-(((jde-1)/2)*DPHD)
+      SB= SBD*DTR
+      DLM=DLMD*DTR
+      DPH=DPHD*DTR
+      TDLM=DLM+DLM
+      TDPH=DPH+DPH
+      WBI=WB+TDLM
+      SBI=SB+TDPH
+      EBI=WB+(ide-2)*TDLM
+      ANBI=SB+(jde-2)*DPH
+      STPH0=SIN(TPH0)
+      CTPH0=COS(TPH0)
+      TSPH=3600./GRID%DT
+         DO J=JTS,min(JTE,JDE-1)
+           TLM=WB-TDLM+MOD(J,2)*DLM   !For velocity points on the E grid
+           TPH=SB+float(J-1)*DPH
+           STPH=SIN(TPH)
+           CTPH=COS(TPH)
+           DO I=ITS,MIN(ITE,IDE-1)
+
+        if (I .eq. ITS) THEN
+             TLM=TLM+TDLM*ITS
+        else
+             TLM=TLM+TDLM
+        endif
+
+             TERM1=(STPH0*CTPH*COS(TLM)+CTPH0*STPH)
+             FP=TWOM*(TERM1)
+             F(I,J)=0.5*GRID%DT*FP
+           ENDDO
+         ENDDO
+         DO J=JTS,min(JTE,JDE-1)
+           TLM=WB-TDLM+MOD(J+1,2)*DLM   !For mass points on the E grid
+           TPH=SB+float(J-1)*DPH
+           STPH=SIN(TPH)
+           CTPH=COS(TPH)
+           DO I=ITS,MIN(ITE,IDE-1)
+
+        if (I .eq. ITS) THEN
+             TLM=TLM+TDLM*ITS
+        else
+             TLM=TLM+TDLM
+        endif
+
+             TERM1=(STPH0*CTPH*COS(TLM)+CTPH0*STPH)
+             APH=ASIN(TERM1)
+             TG_ALT(I,J)=TG0+TGA*COS(APH)-FIS(I,J)/3333.
+           ENDDO
+         ENDDO
+
+            DO j = jts, MIN(jde-1,jte)
+               DO i = its, MIN(ide-1,ite)
+!                  IF ( ( landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &
+!                         SICE(I,J) .eq. 0. ) THEN
+!                     TG(i,j) = sst(i,j)
+!                   ELSEIF (SICE(I,J) .eq. 1) THEN
+!                     TG(i,j) = 271.16
+!                   END IF
+
+        if (TG(I,J) .lt. 200.) then   ! only use default TG_ALT definition if
+                                      ! not getting TGROUND from SI
+                TG(I,J)=TG_ALT(I,J)
+        endif
+
+       if (TG(I,J) .lt. 200. .or. TG(I,J) .gt. 320.) then
+               write(message,*) 'problematic TG point at : ', I,J
+               CALL wrf_message( message )
+       endif
+
+        adum2d(i,j)=nmm_tsk(I,J)+sst(I,J)
+
+               END DO
+            END DO
+
+        DEALLOCATE(TG_ALT)
+
+  CALL process_soil_real ( adum2d, TG , &
+     landmask, sst, &
+     st_input, sm_input, sw_input, &
+     st_levels_input , sm_levels_input , &
+     sw_levels_input , &
+     sldpth , dzsoil , stc , smc , sh2o,  &
+     flag_sst , flag_soilt000, flag_soilm000, &
+     ids , ide , jds , jde , kds , kde , &
+     ims , ime , jms , jme , kms , kme , &
+     its , ite , jts , jte , kts , kte , &
+     model_config_rec%sf_surface_physics(grid%id) , &
+     model_config_rec%num_soil_layers ,  &
+     model_config_rec%real_data_init_type , &
+     num_st_levels_input , num_sm_levels_input , &
+     num_sw_levels_input , &
+     num_st_levels_alloc , num_sm_levels_alloc , &
+     num_sw_levels_alloc )
+      write(0,*)' its=',its,' ite=',ite,' jts=',jts,' jte=',jte
+      write(0,*)' ide=',ide,' jde=',jde
+
+!  Minimum soil values, residual, from RUC LSM scheme.  For input from Noah and using
+       !  RUC LSM scheme, this must be subtracted from the input total soil moisture.  For
+       !  input RUC data and using the Noah LSM scheme, this value must be added to the soil
+       !  moisture input.
+
+       lqmi(1:num_soil_top_cat) = &
+       (/0.045, 0.057, 0.065, 0.067, 0.034, 0.078, 0.10,     &
+         0.089, 0.095, 0.10,  0.070, 0.068, 0.078, 0.0,      &
+         0.004, 0.065 /) !dusan , 0.020, 0.004, 0.008 /)
+
+!  At the initial time we care about values of soil moisture and temperature, other times are
+!  ignored by the model, so we ignore them, too.
+
+          account_for_zero_soil_moisture : SELECT CASE ( model_config_rec%sf_surface_physics(grid%id) )
+
+             CASE ( LSMSCHEME , NMMLSMSCHEME)
+                iicount = 0
+                IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+                   DO j = jts, MIN(jde-1,jte)
+                      DO i = its, MIN(ide-1,ite)
+                         IF ( (landmask(i,j).gt.0.5) .and. ( stc(i,1,j) .gt. 200 ) .and. &
+                              ( stc(i,1,j) .lt. 400 ) .and. ( smc(i,1,j) .lt. 0.005 ) ) then
+                            print *,'Noah > Noah: bad soil moisture at i,j = ',i,j,smc(i,:,j)
+                            iicount = iicount + 1
+                            smc(i,:,j) = 0.005
+                         END IF
+                      END DO
+                   END DO
+                   IF ( iicount .GT. 0 ) THEN
+                      print *,'Noah -> Noah: total number of small soil moisture locations = ',iicount
+                   END IF
+                ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+                   DO j = jts, MIN(jde-1,jte)
+                      DO i = its, MIN(ide-1,ite)
+                         smc(i,:,j) = smc(i,:,j) + lqmi(isltyp(i,j))
+                      END DO
+                   END DO
+                   DO j = jts, MIN(jde-1,jte)
+                      DO i = its, MIN(ide-1,ite)
+                         IF ( (landmask(i,j).gt.0.5) .and. ( stc(i,1,j) .gt. 200 ) .and. &
+                              ( stc(i,1,j) .lt. 400 ) .and. ( smc(i,1,j) .lt. 0.004 ) ) then
+                            print *,'RUC -> Noah: bad soil moisture at i,j = ',i,j,smc(i,:,j)
+                            iicount = iicount + 1
+                            smc(i,:,j) = 0.004
+                         END IF
+                      END DO
+                   END DO
+                   IF ( iicount .GT. 0 ) THEN
+                      print *,'RUC -> Noah: total number of small soil moisture locations = ',iicount
+                   END IF
+                END IF 
+               CASE ( RUCLSMSCHEME )
+                iicount = 0
+                IF      ( FLAG_SM000010 .EQ. 1 ) THEN
+                   DO j = jts, MIN(jde-1,jte)
+                      DO i = its, MIN(ide-1,ite)
+                         smc(i,:,j) = MAX ( smc(i,:,j) - lqmi(isltyp(i,j)) , 0. )
+                      END DO
+                   END DO
+                ELSE IF ( FLAG_SOILM000 .EQ. 1 ) THEN
+                   ! no op
+                END IF
+
+          END SELECT account_for_zero_soil_moisture
+
+!!!     zero out NMM_TSK at water points again
+
+         DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+        if (SM(I,J) .gt. 0.5) then
+            NMM_TSK(I,J)=0.
+        endif
+            END DO
+         END DO
+
+!!      check on STC
+
+          DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+
+        IF (SICE(I,J) .eq. 1.0) then
+          DO L = 1, grid%num_soil_layers
+            STC(I,L,J)=271.16    ! TG value used by Eta/NMM
+!tgs - initialize sea ice temp profile if needed
+!           mid_point_depth=(3./grid%num_soil_layers)/2. + &
+!                             (l-1)*(3./grid%num_soil_layers) 
+!          stc(i,l,j) = ( (3.-mid_point_depth)*nmm_tsk(i,j) + & 
+!                           mid_point_depth*271.16 ) / 3.
+
+          END DO
+        END IF
+                
+            END DO
+          END DO
+
+         DO j = jts, MIN(jde-1,jte)
+            DO i = its, MIN(ide-1,ite)
+
+        if (STC(I,1,J) .eq. 0) then
+        write(0,*) 'troublesome STC,SMC value: ', I,J, stc(I,1,J),smc(I,1,J)
+        do JJ=J-1,J+1
+        do L=1, grid%num_soil_layers
+        do II=I-1,I+1
+
+	if (II .ge. its .and. II .le. MIN(ide-1,ite) .and. &
+            JJ .ge. jts .and. JJ .le. MIN(jde-1,jte)) then
+
+        STC(I,L,J)=amax1(STC(I,L,J),STC(II,L,JJ))
+        cur_smc=SMC(I,L,J)
+
+        if ( SMC(II,L,JJ) .gt. 0.005 .and. SMC(II,L,JJ) .lt. 1.0) then 
+		aposs_smc=SMC(II,L,JJ)
+
+        if ( cur_smc .eq. 0 ) then
+                cur_smc=aposs_smc
+                SMC(I,L,J)=cur_smc
+        else
+                cur_smc=amin1(cur_smc,aposs_smc)
+                cur_smc=amin1(cur_smc,aposs_smc)
+                SMC(I,L,J)=cur_smc
+        endif
+	endif
+
+	endif ! bounds check
+
+        enddo
+        enddo
+        enddo
+        write(0,*) 'STC, SMC(1) now: ',  stc(I,1,J),smc(I,1,J)
+        endif
+
+        if (STC(I,1,J) .eq. 0) then
+        write(0,*) 'STILL troublesome STC value: ', I,J, stc(I,1,J),smc(I,1,J)
+        call wrf_error_fatal("quitting due to significant STC trouble")
+
+!        do JJ=J-3,J+3
+!        do L=1, grid%num_soil_layers
+!        do II=I-3,I+3
+!        STC(I,L,J)=amax1(STC(I,L,J),STC(II,L,JJ))
+!        SMC(I,L,J)=amin1(SMC(I,L,J),SMC(II,L,JJ))
+!        enddo
+!        enddo
+!        enddo
+
+        endif
+
+        ENDDO
+        ENDDO
+
+!hardwire soil stuff for time being
+
+        RTDPTH=0.
+        RTDPTH(1)=0.1
+        RTDPTH(2)=0.3
+        RTDPTH(3)=0.6
+
+!        SLDPTH=0.
+!        SLDPTH(1)=0.1
+!        SLDPTH(2)=0.3
+!        SLDPTH(3)=0.6
+!        SLDPTH(4)=1.0
+
+!        write(0,*) 'SLDPTH: ', SLDPTH(1:4)
+!        write(0,*) 'RTDPTH: ', RTDPTH(1:4)
+
+!!! main body of nmm_specific starts here
+!
+        do J=jts,min(jte,jde-1)
+        do I=its,min(ite,ide-1)
+         LMH(I,J)= kme-1        !1
+         LMV(I,J)= kme-1        !1
+         RES(I,J)=1.
+        enddo
+        enddo
+
+!! HBM2
+
+        HBM2=0.
+
+       do J=jts,min(jte,jde-1)
+        do I=its,min(ite,ide-1)
+
+        IF ( (J .ge. 3 .and. J .le. (jde-1)-2) .AND. &
+             (I .ge. 2 .and. I .le. (ide-1)-2+mod(J,2)) ) THEN
+       HBM2(I,J)=1.
+        ENDIF
+       enddo
+       enddo
+
+!! HBM3
+        HBM3=0.
+
+!!      LOOP OVER LOCAL DIMENSIONS
+
+       do J=jts,min(jte,jde-1)
+          IHWG(J)=mod(J+1,2)-1
+          IF (J .ge. 4 .and. J .le. (jde-1)-3) THEN
+            IHL=(ids+1)-IHWG(J)
+            IHH=(ide-1)-2
+            do I=its,min(ite,ide-1)
+              IF (I .ge. IHL  .and. I .le. IHH) HBM3(I,J)=1.
+            enddo
+          ENDIF
+        enddo
+
+!! VBM2
+
+       VBM2=0.
+
+       do J=jts,min(jte,jde-1)
+       do I=its,min(ite,ide-1)
+
+        IF ( (J .ge. 3 .and. J .le. (jde-1)-2)  .AND.  &
+             (I .ge. 2 .and. I .le. (ide-1)-1-mod(J,2)) ) THEN
+
+           VBM2(I,J)=1.
+
+        ENDIF
+
+       enddo
+       enddo
+
+!! VBM3
+
+        VBM3=0.
+
+       do J=jts,min(jte,jde-1)
+       do I=its,min(ite,ide-1)
+
+        IF ( (J .ge. 4 .and. J .le. (jde-1)-3)  .AND.  &
+             (I .ge. 3-mod(J,2) .and. I .le. (ide-1)-2) ) THEN
+         VBM3(I,J)=1.
+        ENDIF
+
+       enddo
+       enddo
+
+      DTAD=1.0
+!       IDTCF=DTCF, IDTCF=4
+      DTCF=4.0 ! used?
+
+      DY_NMM=ERAD*DPH
+      CPGFV=-GRID%DT/(48.*DY_NMM)
+      EN= GRID%DT/( 4.*DY_NMM)*DTAD
+      ENT=GRID%DT/(16.*DY_NMM)*DTAD
+
+        DO J=jts,nnyp
+         KHL2(J)=(IDE-1)*(J-1)-(J-1)/2+2
+         KVL2(J)=(IDE-1)*(J-1)-J/2+2
+         KHH2(J)=(IDE-1)*J-J/2-1
+         KVH2(J)=(IDE-1)*J-(J+1)/2-1
+        ENDDO
+
+        TPH=SB-DPH
+
+        DO J=jts,min(jte,jde-1)
+         TPH=SB+float(J-1)*DPH
+         DXP=ERAD*DLM*COS(TPH)
+         DXJ(J)=DXP
+         WPDARJ(J)=-W_NMM * &
+     ((ERAD*DLM*AMIN1(COS(ANBI),COS(SBI)))**2+DY_NMM**2)/ &
+                   (GRID%DT*32.*DXP*DY_NMM)
+
+         CPGFUJ(J)=-GRID%DT/(48.*DXP)
+         CURVJ(J)=.5*GRID%DT*TAN(TPH)/ERAD
+         FCPJ(J)=GRID%DT/(CP*192.*DXP*DY_NMM)
+         FDIVJ(J)=1./(12.*DXP*DY_NMM)
+!         EMJ(J)= GRID%DT/( 4.*DXP)*DTAD
+!         EMTJ(J)=GRID%DT/(16.*DXP)*DTAD
+         FADJ(J)=-GRID%DT/(48.*DXP*DY_NMM)*DTAD
+         ACDT=GRID%DT*SQRT((ERAD*DLM*AMIN1(COS(ANBI),COS(SBI)))**2+DY_NMM**2)
+         CDDAMP=CODAMP*ACDT
+         HDACJ(J)=COAC*ACDT/(4.*DXP*DY_NMM)
+         DDMPUJ(J)=CDDAMP/DXP
+         DDMPVJ(J)=CDDAMP/DY_NMM
+        ENDDO
+
+!!! wrf_dm_on_monitor block was here, but was causing problems for unknown reasons
+
+          DO J=JTS,min(JTE,JDE-1)
+           TLM=WB-TDLM+MOD(J,2)*DLM
+           TPH=SB+float(J-1)*DPH
+           STPH=SIN(TPH)
+           CTPH=COS(TPH)
+           DO I=ITS,MIN(ITE,IDE-1)
+
+        if (I .eq. ITS) THEN
+             TLM=TLM+TDLM*ITS
+        else
+             TLM=TLM+TDLM
+        endif
+
+             FP=TWOM*(CTPH0*STPH+STPH0*CTPH*COS(TLM))
+             F(I,J)=0.5*GRID%DT*FP
+
+           ENDDO
+          ENDDO
+
+! --------------DERIVED VERTICAL GRID CONSTANTS--------------------------
+
+      EF4T=.5*GRID%DT/CP
+      F4Q =   -GRID%DT*DTAD
+      F4D =-.5*GRID%DT*DTAD
+
+       DO L=KDS,KDE-1
+        RDETA(L)=1./DETA(L)
+        F4Q2(L)=-.25*GRID%DT*DTAD/DETA(L)
+       ENDDO
+
+! shouldnt need to be done globally, right?
+        DO J=JTS,min(JTE,JDE-1)
+        DO I=ITS,min(ITE,IDE-1)
+          DX_NMM(I,J)=DXJ(J)
+          WPDAR(I,J)=WPDARJ(J)*HBM2(I,J)
+          CPGFU(I,J)=CPGFUJ(J)*VBM2(I,J)
+          CURV(I,J)=CURVJ(J)*VBM2(I,J)
+          FCP(I,J)=FCPJ(J)*HBM2(I,J)
+          FDIV(I,J)=FDIVJ(J)*HBM2(I,J)
+          FAD(I,J)=FADJ(J)
+          HDACV(I,J)=HDACJ(J)*VBM2(I,J)
+          HDAC(I,J)=HDACJ(J)*1.25*HBM2(I,J)
+        ENDDO
+        ENDDO
+
+!      DO J=3,(JDE-1)-2
+        DO J=JTS, MIN(JDE-1,JTE)
+
+        IF (J.LE.5.OR.J.GE.(JDE-1)-4) THEN
+
+               KHH=(IDE-1)-2+MOD(J,2) ! KHH is global...loop over I that have
+               DO I=ITS,MIN(IDE-1,ITE)
+                 IF (I .ge. 2 .and. I .le. KHH) THEN
+                   HDAC(I,J)=HDAC(I,J)* DFC
+                 ENDIF
+               ENDDO
+
+        ELSE
+
+          KHH=2+MOD(J,2)
+               DO I=ITS,MIN(IDE-1,ITE)
+                 IF (I .ge. 2 .and. I .le. KHH) THEN
+                    HDAC(I,J)=HDAC(I,J)* DFC
+                 ENDIF
+               ENDDO
+
+          KHH=(IDE-1)-2+MOD(J,2)
+
+!          DO I=(IDE-1)-2,KHH
+               DO I=ITS,MIN(IDE-1,ITE)
+                 IF (I .ge. (IDE-1)-2 .and. I .le. KHH) THEN
+                   HDAC(I,J)=HDAC(I,J)* DFC
+                 ENDIF
+               ENDDO
+        ENDIF
+      ENDDO
+
+      DO J=JTS,min(JTE,JDE-1)
+      DO I=ITS,min(ITE,IDE-1)
+        DDMPU(I,J)=DDMPUJ(J)*VBM2(I,J)
+        DDMPV(I,J)=DDMPVJ(J)*VBM2(I,J)
+        HDACV(I,J)=HDACV(I,J)*VBM2(I,J)
+      ENDDO
+      ENDDO
+! --------------INCREASING DIFFUSION ALONG THE BOUNDARIES----------------
+
+!      DO J=3,JDE-1-2
+
+        DO J=JTS,MIN(JDE-1,JTE)
+        IF (J.LE.5.OR.J.GE.JDE-1-4) THEN
+          KVH=(IDE-1)-1-MOD(J,2)
+          DO I=ITS,min(IDE-1,ITE)
+            IF (I .ge. 2 .and.  I .le. KVH) THEN
+             DDMPU(I,J)=DDMPU(I,J)*DDFC
+             DDMPV(I,J)=DDMPV(I,J)*DDFC
+             HDACV(I,J)=HDACV(I,J)* DFC
+            ENDIF
+          ENDDO
+        ELSE
+          KVH=3-MOD(J,2)
+          DO I=ITS,min(IDE-1,ITE)
+           IF (I .ge. 2 .and.  I .le. KVH) THEN
+            DDMPU(I,J)=DDMPU(I,J)*DDFC
+            DDMPV(I,J)=DDMPV(I,J)*DDFC
+            HDACV(I,J)=HDACV(I,J)* DFC
+           ENDIF
+          ENDDO
+          KVH=(IDE-1)-1-MOD(J,2)
+          DO I=ITS,min(IDE-1,ITE)
+           IF (I .ge. IDE-1-2 .and. I .le. KVH) THEN
+            DDMPU(I,J)=DDMPU(I,J)*DDFC
+            DDMPV(I,J)=DDMPV(I,J)*DDFC
+            HDACV(I,J)=HDACV(I,J)* DFC
+           ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+
+        write(0,*) ' grid%num_soil_layers = ',  grid%num_soil_layers
+
+        write(0,*) 'STC(1)'
+        do J=min(jde-1,jte),jts,-(jte-jts)/15
+        write(0,635) (stc(I,1,J),I=its,min(ite,ide-1),(ite-its)/12)
+        enddo
+
+        write(0,*) 'SMC(1)'
+        do J=min(jde-1,jte),jts,-(jte-jts)/15
+        write(0,635) (smc(I,1,J),I=its,min(ite,ide-1),(ite-its)/12)
+        enddo
+
+!       write(0,*) 'SM'
+!       do J=min(jde-1,jte),jts,-(jte-jts)/15
+!       write(0,635) (smc(I,1,J),I=its,min(ite,ide-1),(ite-its)/12)
+!       enddo
+
+          DO j = jts, MIN(jde-1,jte)
+          DO i=  ITS, MIN(IDE-1,ITE)
+
+        if (SM(I,J) .eq. 0 .and. SMC(I,1,J) .gt. 0.5 .and. SICE(I,J) .eq. 0) then
+        write(0,*) 'wet on land point: ', I,J,SMC(I,1,J),SICE(I,J)
+        endif
+
+          enddo
+        enddo
+
+!!!! MOVE MONITOR BLOCK HERE
+
+!!!   compute EMT, EM on global domain, and only on task 0.
+
+!!!   this block also inhibits running as a serial job, it would seem.
+
+        IF (wrf_dm_on_monitor()) THEN   !!!! NECESSARY TO LIMIT THIS TO TASK ZERO?
+
+        ALLOCATE(EMJ(JDS:JDE-1),EMTJ(JDS:JDE-1))
+
+!       write(0,*) 'FIGURING OUT EMJ, EMTJ ', JDS, JDE-1
+        DO J=JDS,JDE-1
+         TPH=SB+float(J-1)*DPH
+         DXP=ERAD*DLM*COS(TPH)
+         EMJ(J)= GRID%DT/( 4.*DXP)*DTAD
+         EMTJ(J)=GRID%DT/(16.*DXP)*DTAD
+!       write(0,*) 'J, EMTJ(J): ', J, EMTJ(J)
+        ENDDO
+        
+          JA=0
+          DO 161 J=3,5
+          JA=JA+1
+          KHLA(JA)=2
+          KHHA(JA)=(IDE-1)-1-MOD(J+1,2)
+ 161      EMT(JA)=EMTJ(J)
+          DO 162 J=(JDE-1)-4,(JDE-1)-2
+          JA=JA+1
+          KHLA(JA)=2
+          KHHA(JA)=(IDE-1)-1-MOD(J+1,2)
+ 162      EMT(JA)=EMTJ(J)
+          DO 163 J=6,(JDE-1)-5
+          JA=JA+1
+          KHLA(JA)=2
+          KHHA(JA)=2+MOD(J,2)
+ 163      EMT(JA)=EMTJ(J)
+          DO 164 J=6,(JDE-1)-5
+          JA=JA+1
+          KHLA(JA)=(IDE-1)-2
+          KHHA(JA)=(IDE-1)-1-MOD(J+1,2)
+ 164      EMT(JA)=EMTJ(J)
+
+! --------------SPREADING OF UPSTREAM VELOCITY-POINT ADVECTION FACTOR----
+
+      JA=0
+              DO 171 J=3,5
+          JA=JA+1
+          KVLA(JA)=2
+          KVHA(JA)=(IDE-1)-1-MOD(J,2)
+ 171      EM(JA)=EMJ(J)
+              DO 172 J=(JDE-1)-4,(JDE-1)-2
+          JA=JA+1
+          KVLA(JA)=2
+          KVHA(JA)=(IDE-1)-1-MOD(J,2)
+ 172      EM(JA)=EMJ(J)
+              DO 173 J=6,(JDE-1)-5
+          JA=JA+1
+          KVLA(JA)=2
+          KVHA(JA)=2+MOD(J+1,2)
+ 173      EM(JA)=EMJ(J)
+              DO 174 J=6,(JDE-1)-5
+          JA=JA+1
+          KVLA(JA)=(IDE-1)-2
+          KVHA(JA)=(IDE-1)-1-MOD(J,2)
+ 174      EM(JA)=EMJ(J)
+
+   696  continue
+        ENDIF ! wrf_dm_on_monitor
+
+
+     if(model_config_rec%sf_surface_physics(grid%id).EQ.99) then
+      call NMM_SH2O(IMS,IME,JMS,JME,ITS,NNXP,JTS,NNYP,grid%num_soil_layers,ISLTYP, &
+                             SM,SICE,STC,SMC,SH2O)
+     endif
+
+!! must be a better place to put this, but will eliminate "phantom"
+!! wind points here (no wind point on eastern boundary of odd numbered rows)
+
+        if (   abs(IDE-1-ITE) .eq. 1 ) THEN ! along eastern boundary
+        write(0,*) 'zero phantom winds'
+        do K=1,KDE-1
+!         do J=JTS,JDE-1,2
+        DO J=JDS,JDE-1,2
+        if (J .ge. JTS .and. J .le. JTE) THEN
+             u(IDE-1,K,J)=0.
+             v(IDE-1,K,J)=0.
+        endif
+          enddo
+        enddo
+        endif
+
+  969   continue
+
+!       write(0,*) 'NMM_TSK leaving init_domain_nmm'
+!       do J=min(jte,jde-1),jts,-(jte-jts)/15
+!       write(0,635) (NMM_TSK(I,J),I=its,min(ide-1,ite),(ite-its)/12)
+!       enddo
+
+         DO j = jms, jme
+            DO i = ims, ime
+
+          fisx=max(fis(i,j),0.)
+          Z0(I,J)    =SM(I,J)*Z0SEA+(1.-SM(I,J))*                      &
+     &                (Z0(I,J)*Z0MAX+FISx    *FCM+Z0LAND)
+
+            ENDDO
+          ENDDO
+
+        write(0,*) 'Z0 over memory, leaving module_initialize_real'
+        do J=JME,JMS,-(JME-JMS)/20
+        write(0,635) (Z0(I,J),I=IMS,IME,(IME-IMS)/14)
+        enddo
+
+
+
+        write(0,*) 'leaving init_domain_nmm'
+!
+! Gopal's doing's : following lines  moved to namelist_input4 in Registry 
+!
+!       write(0,*) 'hardwire'
+!        sigma=.true.
+!       grid%IDTAD=2  
+!       grid%NSOIL=4
+!       grid%NPHS=4
+!       grid%NCNVC=4
+       write(message,*)'STUFF MOVED TO REGISTRY:',grid%IDTAD,          &
+     & grid%NSOIL,grid%NRADL,grid%NRADS,grid%NPHS,grid%NCNVC,grid%sigma
+       CALL wrf_message( TRIM(message) )
+!==================================================================================
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+      RETURN
+
+   END SUBROUTINE init_domain_nmm
+
+!--------------------------------------------------------------------
+      SUBROUTINE NMM_SH2O(IMS,IME,JMS,JME,ISTART,IM,JSTART,JM,&
+                        NSOIL,ISLTPK, &
+                        SM,SICE,STC,SMC,SH2O)
+
+!!        INTEGER, PARAMETER:: NSOTYP=9
+!        INTEGER, PARAMETER:: NSOTYP=16
+        INTEGER, PARAMETER:: NSOTYP=19 !!!!!!!!MAYBE???
+
+        REAL :: PSIS(NSOTYP),BETA(NSOTYP),SMCMAX(NSOTYP)
+        REAL :: STC(IMS:IME,NSOIL,JMS:JME), &
+                SMC(IMS:IME,NSOIL,JMS:JME)
+        REAL :: SH2O(IMS:IME,NSOIL,JMS:JME),SICE(IMS:IME,JMS:JME),&
+                SM(IMS:IME,JMS:JME)
+        REAL :: HLICE,GRAV,T0,BLIM
+        INTEGER :: ISLTPK(IMS:IME,JMS:JME)
+
+! Constants used in cold start SH2O initialization
+      DATA HLICE/3.335E5/,GRAV/9.81/,T0/273.15/
+      DATA BLIM/5.5/
+!      DATA PSIS /0.04,0.62,0.47,0.14,0.10,0.26,0.14,0.36,0.04/
+!      DATA BETA /4.26,8.72,11.55,4.74,10.73,8.17,6.77,5.25,4.26/
+!      DATA SMCMAX /0.421,0.464,0.468,0.434,0.406, &
+!                  0.465,0.404,0.439,0.421/
+
+        
+!!!      NOT SURE...PSIS=SATPSI, BETA=BB??
+
+        DATA PSIS /0.069, 0.036, 0.141, 0.759, 0.759, 0.355,   &
+                   0.135, 0.617, 0.263, 0.098, 0.324, 0.468,   &
+                   0.355, 0.000, 0.069, 0.036, 0.468, 0.069, 0.069  /
+
+        DATA BETA/2.79,  4.26,  4.74,  5.33,  5.33,  5.25,    &
+                  6.66,  8.72,  8.17, 10.73, 10.39, 11.55,    &
+                  5.25,  0.00,  2.79,  4.26, 11.55, 2.79, 2.79 /
+
+        DATA SMCMAX/0.339, 0.421, 0.434, 0.476, 0.476, 0.439,  &
+                    0.404, 0.464, 0.465, 0.406, 0.468, 0.468,  &
+                    0.439, 1.000, 0.200, 0.421, 0.468, 0.200, 0.339/
+
+!tgs - the following table values are from REDPRM_USGS in NMM LSM
+!      DATA PSIS /0.0350, 0.0363, 0.1413, 0.7586, 0.7586, 0.3548,   &
+!                  0.1349, 0.6166, 0.2630, 0.0977, 0.3236, 0.4677,   &
+!                  0.3548, 0.0000, 0.0350, 0.0363, 0.4677, 0.0350,   &
+!                  0.0350 /
+
+!      DATA BETA    /4.05,  4.26,  4.74,  5.33,  5.33,  5.25,    &
+!                  6.77,  8.72,  8.17, 10.73, 10.39, 11.55,    &
+!                  5.25,  0.00,  4.05,  4.26, 11.55,  4.05,    &
+!                  4.05 /
+
+!      DATA SMCMAX/0.395, 0.421, 0.434, 0.476, 0.476, 0.439,  &
+!                  0.404, 0.464, 0.465, 0.406, 0.468, 0.457,  &
+!                  0.464, 0.000, 0.200, 0.421, 0.457, 0.200,  &
+!                  0.395 /
+
+
+        write(0,*) 'define SH2O over IM,JM: ', IM,JM
+        DO K=1,NSOIL
+         DO J=JSTART,JM
+          DO I=ISTART,IM
+        if(i==169.and.j==111.and.k==1)then
+          write(0,*)' enter NMM_SH2O k=',k,' smc=',smc(i,k,j),' sh2o=',sh2o(i,k,j)
+        endif
+!tst
+        IF (SMC(I,K,J) .gt. SMCMAX(ISLTPK(I,J))) then
+! if (K .eq. 1) then
+!  write(0,*) 'I,J,reducing SMC from ' ,I,J,SMC(I,K,J), 'to ', SMCMAX(ISLTPK(I,J))
+!  endif
+        SMC(I,K,J)=SMCMAX(ISLTPK(I,J))
+        ENDIF
+!tst
+
+        if(i==056.and.j==265.and.k==1)then
+          write(0,*)' NMM_SH2O point 2 k=',k,' smc=',smc(i,k,j),' sh2o=',sh2o(i,k,j)
+        endif
+        IF ( (SM(I,J) .lt. 0.5) .and. (SICE(I,J) .lt. 0.5) ) THEN
+
+        IF (ISLTPK(I,J) .gt. 19) THEN
+                WRITE(6,*) 'FORCING ISLTPK at : ', I,J
+                ISLTPK(I,J)=9
+        ELSEIF (ISLTPK(I,J) .le. 0) then
+                WRITE(6,*) 'FORCING ISLTPK at : ', I,J
+                ISLTPK(I,J)=1
+        ENDIF
+
+
+! cold start:  determine liquid soil water content (SH2O)
+! SH2O <= SMC for T < 273.149K (-0.001C)
+
+           IF (STC(I,K,J) .LT. 273.149) THEN
+
+! first guess following explicit solution for Flerchinger Eqn from Koren
+! et al, JGR, 1999, Eqn 17 (KCOUNT=0 in FUNCTION FRH2O).
+
+              BX = BETA(ISLTPK(I,J))
+              IF ( BETA(ISLTPK(I,J)) .GT. BLIM ) BX = BLIM
+
+        if ( GRAV*(-PSIS(ISLTPK(I,J))) .eq. 0 ) then
+        write(0,*) 'TROUBLE'
+        write(0,*) 'I,J: ', i,J
+        write(0,*) 'grav, isltpk, psis(isltpk): ', grav,isltpk(I,J),&
+                 psis(isltpk(I,J))
+        endif
+
+        if (BX .eq. 0 .or. STC(I,K,J) .eq. 0) then
+                write(0,*) 'I,J,BX, STC: ', I,J,BX,STC(I,K,J)
+        endif
+              FK = (((HLICE/(GRAV*(-PSIS(ISLTPK(I,J)))))* &
+                  ((STC(I,K,J)-T0)/STC(I,K,J)))** &
+                  (-1/BX))*SMCMAX(ISLTPK(I,J))
+              IF (FK .LT. 0.02) FK = 0.02
+              SH2O(I,K,J) = MIN ( FK, SMC(I,K,J) )
+! ----------------------------------------------------------------------
+! now use iterative solution for liquid soil water content using
+! FUNCTION FRH2O (from the Eta "NOAH" land-surface model) with the
+! initial guess for SH2O from above explicit first guess.
+
+              SH2O(I,K,J)=FRH2O_init(STC(I,K,J),SMC(I,K,J),SH2O(I,K,J), &
+                         SMCMAX(ISLTPK(I,J)),BETA(ISLTPK(I,J)), &
+                         PSIS(ISLTPK(I,J)))
+
+            ELSE ! above freezing
+              SH2O(I,K,J)=SMC(I,K,J)
+            ENDIF
+
+
+        ELSE   ! water point
+              SH2O(I,K,J)=SMC(I,K,J)
+
+        ENDIF ! test on land/ice/sea
+        if (SH2O(I,K,J) .gt. SMCMAX(ISLTPK(I,J))) then
+        write(0,*) 'SH2O > THAN SMCMAX ', I,J,SH2O(I,K,J),SMCMAX(ISLTPK(I,J)),SMC(I,K,J)
+        endif
+
+        if(i==169.and.j==111.and.k==1)then
+          write(0,*)' exit NMM_SH2O k=',k,' smc=',smc(i,k,j),' sh2o=',sh2o(i,k,j)
+        endif
+
+         ENDDO
+        ENDDO
+       ENDDO
+
+        END SUBROUTINE NMM_SH2O
+
+!-------------------------------------------------------------------
+
+      FUNCTION FRH2O_init(TKELV,SMC,SH2O,SMCMAX,B,PSIS)
+
+      IMPLICIT NONE
+
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!  PURPOSE:  CALCULATE AMOUNT OF SUPERCOOLED LIQUID SOIL WATER CONTENT
+!  IF TEMPERATURE IS BELOW 273.15K (T0).  REQUIRES NEWTON-TYPE ITERATION
+!  TO SOLVE THE NONLINEAR IMPLICIT EQUATION GIVEN IN EQN 17 OF
+!  KOREN ET AL. (1999, JGR, VOL 104(D16), 19569-19585).
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!
+! New version (JUNE 2001): much faster and more accurate newton iteration
+! achieved by first taking log of eqn cited above -- less than 4
+! (typically 1 or 2) iterations achieves convergence.  Also, explicit
+! 1-step solution option for special case of parameter Ck=0, which reduces
+! the original implicit equation to a simpler explicit form, known as the
+! ""Flerchinger Eqn". Improved handling of solution in the limit of
+! freezing point temperature T0.
+!
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!
+! INPUT:
+!
+!   TKELV.........Temperature (Kelvin)
+!   SMC...........Total soil moisture content (volumetric)
+!   SH2O..........Liquid soil moisture content (volumetric)
+!   SMCMAX........Saturation soil moisture content (from REDPRM)
+!   B.............Soil type "B" parameter (from REDPRM)
+!   PSIS..........Saturated soil matric potential (from REDPRM)
+!
+! OUTPUT:
+!   FRH2O.........supercooled liquid water content.
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      REAL B
+      REAL BLIM
+      REAL BX
+      REAL CK
+      REAL DENOM
+      REAL DF
+      REAL DH2O
+      REAL DICE
+      REAL DSWL
+      REAL ERROR
+      REAL FK
+      REAL FRH2O_init
+      REAL GS
+      REAL HLICE
+      REAL PSIS
+      REAL SH2O
+      REAL SMC
+      REAL SMCMAX
+      REAL SWL
+      REAL SWLK
+      REAL TKELV
+      REAL T0
+
+      INTEGER NLOG
+      INTEGER KCOUNT
+      PARAMETER (CK=8.0)
+!      PARAMETER (CK=0.0)
+      PARAMETER (BLIM=5.5)
+!      PARAMETER (BLIM=7.0)
+      PARAMETER (ERROR=0.005)
+
+      PARAMETER (HLICE=3.335E5)
+      PARAMETER (GS = 9.81)
+      PARAMETER (DICE=920.0)
+      PARAMETER (DH2O=1000.0)
+      PARAMETER (T0=273.15)
+
+!  ###   LIMITS ON PARAMETER B: B < 5.5  (use parameter BLIM)  ####
+!  ###   SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT  ####
+!  ###   IS NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES    ####
+!  ################################################################
+!
+      BX = B
+      IF ( B .GT. BLIM ) BX = BLIM
+! ------------------------------------------------------------------
+
+! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG.
+      NLOG=0
+      KCOUNT=0
+
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C  IF TEMPERATURE NOT SIGNIFICANTLY BELOW FREEZING (T0), SH2O = SMC
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+
+      IF (TKELV .GT. (T0 - 1.E-3)) THEN
+
+        FRH2O_init=SMC
+
+      ELSE
+
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+       IF (CK .NE. 0.0) THEN
+
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! CCCCCCCCC OPTION 1: ITERATED SOLUTION FOR NONZERO CK CCCCCCCCCCC
+! CCCCCCCCCCCC IN KOREN ET AL, JGR, 1999, EQN 17 CCCCCCCCCCCCCCCCC
+
+! INITIAL GUESS FOR SWL (frozen content)
+        SWL = SMC-SH2O
+! KEEP WITHIN BOUNDS.
+         IF (SWL .GT. (SMC-0.02)) SWL=SMC-0.02
+         IF(SWL .LT. 0.) SWL=0.
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C  START OF ITERATIONS
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+        DO WHILE (NLOG .LT. 10 .AND. KCOUNT .EQ. 0)
+         NLOG = NLOG+1
+         DF = ALOG(( PSIS*GS/HLICE ) * ( ( 1.+CK*SWL )**2. ) * &
+             ( SMCMAX/(SMC-SWL) )**BX) - ALOG(-(TKELV-T0)/TKELV)
+         DENOM = 2. * CK / ( 1.+CK*SWL ) + BX / ( SMC - SWL )
+         SWLK = SWL - DF/DENOM
+! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION.
+         IF (SWLK .GT. (SMC-0.02)) SWLK = SMC - 0.02
+         IF(SWLK .LT. 0.) SWLK = 0.
+! MATHEMATICAL SOLUTION BOUNDS APPLIED.
+         DSWL=ABS(SWLK-SWL)
+         SWL=SWLK
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! CC IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.)
+! CC WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED.
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+         IF ( DSWL .LE. ERROR )  THEN
+           KCOUNT=KCOUNT+1
+         END IF
+        END DO
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C  END OF ITERATIONS
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION.
+        FRH2O_init = SMC - SWL
+
+! CCCCCCCCCCCCCCCCCCCCCCCC END OPTION 1 CCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+       ENDIF
+
+       IF (KCOUNT .EQ. 0) THEN
+!         Print*,'Flerchinger used in NEW version. Iterations=',NLOG
+
+! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! CCCCC OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0 CCCCCCCC
+! CCCCCCCCCCCCC IN KOREN ET AL., JGR, 1999, EQN 17  CCCCCCCCCCCCCCC
+
+        FK=(((HLICE/(GS*(-PSIS)))*((TKELV-T0)/TKELV))**(-1/BX))*SMCMAX
+! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION
+        IF (FK .LT. 0.02) FK = 0.02
+        FRH2O_init = MIN ( FK, SMC )
+
+! CCCCCCCCCCCCCCCCCCCCCCCCC END OPTION 2 CCCCCCCCCCCCCCCCCCCCCCCCCC
+
+       ENDIF
+
+      ENDIF
+
+        RETURN
+
+      END FUNCTION FRH2O_init
+
+
+!--------------------------------------------------------------------
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+
+END MODULE module_initialize
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/module_si_io_nmm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/module_si_io_nmm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/module_si_io_nmm.F	(revision 2744)
@@ -0,0 +1,1313 @@
+MODULE module_si_io_nmm
+
+   USE module_optional_si_input
+
+   IMPLICIT NONE
+
+      !  Input 3D meteorological fields.
+
+      REAL , DIMENSION(:,:,:) , ALLOCATABLE :: u_input , v_input , &
+                                               q_input , t_input
+
+      !  Input 3D LSM fields.
+
+      REAL , DIMENSION(:,:,:) , ALLOCATABLE :: landuse_frac_input , &
+                                               soil_top_cat_input , &
+                                               soil_bot_cat_input
+
+      REAL, ALLOCATABLE:: htm_in(:,:,:),vtm_in(:,:,:)
+
+      !  Input 2D surface fields.
+
+      REAL , DIMENSION(:,:)   , ALLOCATABLE :: soilt010_input , soilt040_input , &
+                                               soilt100_input , soilt200_input , &
+                                               soilm010_input , soilm040_input , &
+                                               soilm100_input , soilm200_input , &
+                                               psfc_in,pmsl
+
+      REAL , DIMENSION(:,:)   , ALLOCATABLE :: lat_wind, lon_wind 
+
+      REAL , DIMENSION(:)     , ALLOCATABLE :: DETA_in, AETA_in, ETAX_in
+      REAL , DIMENSION(:)     , ALLOCATABLE :: DETA1_in, AETA1_in, ETA1_in
+      REAL , DIMENSION(:)     , ALLOCATABLE :: DETA2_in, AETA2_in, ETA2_in, DFL_in
+
+      REAL , DIMENSION(:,:,:), ALLOCATABLE :: st_inputx , sm_inputx, sw_inputx
+
+      !  Local input arrays
+
+      REAL,DIMENSION(:,:),ALLOCATABLE :: dum2d
+      INTEGER,DIMENSION(:,:),ALLOCATABLE :: idum2d
+      REAL,DIMENSION(:,:,:),ALLOCATABLE :: dum3d
+
+      LOGICAL , SAVE :: first_time_in = .TRUE.
+
+      INTEGER :: flag_soilt010 , flag_soilt100 , flag_soilt200 , &
+        	 flag_soilm010 , flag_soilm100 , flag_soilm200
+
+!   Some constants to allow simple dimensions in the defined types
+!   given below.
+
+      INTEGER, PARAMETER          :: var_maxdims = 5
+      INTEGER, PARAMETER          :: max_staggers_xy_new = 4
+      INTEGER, PARAMETER          :: max_staggers_xy_old = 3
+      INTEGER, PARAMETER          :: max_staggers_z = 2
+      INTEGER, PARAMETER          :: max_standard_lats = 4
+      INTEGER, PARAMETER          :: max_standard_lons = 4  
+      INTEGER, PARAMETER          :: max_fg_variables = 200
+      INTEGER, PARAMETER          :: max_vertical_levels = 2000
+
+!   This module defines the items needed for the WRF metadata
+!   which is broken up into three levels:  
+!      Global metadata:  Those things which apply to the
+!                        entire simulation that are 
+!                        independent of time, domain, or
+!                        variable
+!
+!      Domain metadata:  Those things which apply to 
+!                        a single domain (this may
+!                        or may not be time dependent)
+!
+!      Variable metadata: Those things which apply to 
+!                        a specific variable at a 
+!                        specific time
+!
+!      The variable names and definitions can be 
+!      found in the wrf_metadata spec, which is still
+!      a living document as coding goes on.   The names
+!      may not match exactly, but you should be able 
+!      to figure things out.  
+!
+
+      TYPE wrf_var_metadata
+	 CHARACTER (LEN=8)         :: name 
+	 CHARACTER (LEN=16)        :: units
+	 CHARACTER (LEN=80)        :: description
+	 INTEGER                   :: domain_id
+	 INTEGER                   :: ndim
+	 INTEGER                   :: dim_val (var_maxdims)
+	 CHARACTER(LEN=4)          :: dim_desc (var_maxdims)
+	 INTEGER                   :: start_index(var_maxdims)
+	 INTEGER                   :: stop_index(var_maxdims)
+	 INTEGER                   :: h_stagger_index
+	 INTEGER                   :: v_stagger_index
+	 CHARACTER(LEN=8)          :: array_order
+	 CHARACTER(LEN=4)          :: field_type
+	 CHARACTER(LEN=8)          :: field_source_prog
+	 CHARACTER(LEN=80)         :: source_desc
+	 CHARACTER(LEN=8)          :: field_time_type
+	 INTEGER                   :: vt_date_start
+	 REAL                      :: vt_time_start
+	 INTEGER                   :: vt_date_stop
+	 REAL                      :: vt_time_stop
+      END TYPE wrf_var_metadata
+
+      TYPE(wrf_var_metadata)  :: var_meta , var_info
+
+      TYPE wrf_domain_metadata
+	 INTEGER                   :: id
+	 INTEGER                   :: parent_id
+	 CHARACTER(LEN=8)          :: dyn_init_src
+	 CHARACTER(LEN=8)          :: static_init_src 
+	 INTEGER                   :: vt_date
+	 REAL                      :: vt_time
+	 INTEGER                   :: origin_parent_x
+	 INTEGER                   :: origin_parent_y
+	 INTEGER                   :: ratio_to_parent
+	 REAL                      :: delta_x
+	 REAL                      :: delta_y
+	 REAL                      :: top_level
+	 INTEGER                   :: origin_parent_z
+	 REAL                      :: corner_lats_new(4,max_staggers_xy_new)
+	 REAL                      :: corner_lons_new(4,max_staggers_xy_new)
+	 REAL                      :: corner_lats_old(4,max_staggers_xy_old)
+	 REAL                      :: corner_lons_old(4,max_staggers_xy_old)
+	 INTEGER                   :: xdim
+	 INTEGER                   :: ydim
+	 INTEGER                   :: zdim
+      END TYPE wrf_domain_metadata
+      TYPE(wrf_domain_metadata) :: dom_meta
+
+      TYPE wrf_global_metadata
+	 CHARACTER(LEN=80)         :: simulation_name
+	 CHARACTER(LEN=80)         :: user_desc
+	 INTEGER                   :: si_version
+	 INTEGER                   :: analysis_version  
+	 INTEGER                   :: wrf_version
+	 INTEGER                   :: post_version
+	 CHARACTER(LEN=32)         :: map_projection
+	 REAL                      :: moad_known_lat
+	 REAL                      :: moad_known_lon
+	 CHARACTER(LEN=8)          :: moad_known_loc
+	 REAL                      :: moad_stand_lats(max_standard_lats)
+	 REAL                      :: moad_stand_lons(max_standard_lons)
+	 REAL                      :: moad_delta_x
+	 REAL                      :: moad_delta_y
+	 CHARACTER(LEN=4)          :: horiz_stagger_type
+	 INTEGER                   :: num_stagger_xy
+	 REAL                      :: stagger_dir_x_new(max_staggers_xy_new)
+	 REAL                      :: stagger_dir_y_new(max_staggers_xy_new)
+	 REAL                      :: stagger_dir_x_old(max_staggers_xy_old)
+	 REAL                      :: stagger_dir_y_old(max_staggers_xy_old)
+	 INTEGER                   :: num_stagger_z    
+	 REAL                      :: stagger_dir_z(max_staggers_z)
+	 CHARACTER(LEN=8)          :: vertical_coord
+	 INTEGER                   :: num_domains
+	 INTEGER                   :: init_date
+	 REAL                      :: init_time
+	 INTEGER                   :: end_date
+	 REAL                      :: end_time
+	 CHARACTER(LEN=4)          :: lu_source
+	 INTEGER                   :: lu_water
+	 INTEGER                   :: lu_ice  
+      END TYPE wrf_global_metadata
+      TYPE(wrf_global_metadata)   :: global_meta
+
+CONTAINS
+
+   SUBROUTINE read_si ( grid, file_date_string )
+
+      USE module_soil_pre
+      USE module_domain
+
+      IMPLICIT NONE
+
+      TYPE(domain) , INTENT(INOUT)  :: grid
+      CHARACTER (LEN=19) , INTENT(IN) :: file_date_string
+
+      INTEGER :: ids,ide,jds,jde,kds,kde           &
+                ,ims,ime,jms,jme,kms,kme           &
+                ,its,ite,jts,jte,kts,kte
+
+      INTEGER :: i , j , k , loop, IMAX, JMAX
+
+      REAL :: dummy
+
+      CHARACTER (LEN= 8) :: dummy_char
+
+      INTEGER :: ok , map_proj , ok_open
+      REAL :: pt
+      INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+
+      write(0,*)' enter read_si'
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+            kds = grid%sd31 ; kde = grid%ed31 ;
+            ids = grid%sd32 ; ide = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            kms = grid%sm31 ; kme = grid%em31 ;
+            ims = grid%sm32 ; ime = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            kts = grid%sp31 ; kte = grid%ep31 ; ! tile is entire patch
+            its = grid%sp32 ; ite = grid%ep32 ; ! tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
+
+         CASE ( DATA_ORDER_XYZ )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            jds = grid%sd32 ; jde = grid%ed32 ;
+            kds = grid%sd33 ; kde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            jms = grid%sm32 ; jme = grid%em32 ;
+            kms = grid%sm33 ; kme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
+            jts = grid%sp32 ; jte = grid%ep32 ; ! tile is entire patch
+            kts = grid%sp33 ; kte = grid%ep33 ; ! tile is entire patch
+
+         CASE ( DATA_ORDER_XZY )
+            ids = grid%sd31 ; ide = grid%ed31 ;
+            kds = grid%sd32 ; kde = grid%ed32 ;
+            jds = grid%sd33 ; jde = grid%ed33 ;
+
+            ims = grid%sm31 ; ime = grid%em31 ;
+            kms = grid%sm32 ; kme = grid%em32 ;
+            jms = grid%sm33 ; jme = grid%em33 ;
+
+            its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
+            kts = grid%sp32 ; kte = grid%ep32 ; ! tile is entire patch
+            jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
+
+      END SELECT
+
+      !  Initialize what soil temperature and moisture is available.
+
+      write(0,*) 'dum3d I allocs: ', ids,ide-1
+      write(0,*) 'dum3d J allocs: ', jds,jde-1
+      write(0,*) 'dum3d K allocs: ', kds,kde-1
+
+      flag_st000010 = 0
+      flag_st010040 = 0
+      flag_st040100 = 0
+      flag_st100200 = 0
+      flag_sm000010 = 0 
+      flag_sm010040 = 0
+      flag_sm040100 = 0
+      flag_sm100200 = 0
+      flag_st010200 = 0
+      flag_sm010200 = 0
+
+      flag_soilt010 = 0
+      flag_soilt040 = 0
+      flag_soilt100 = 0
+      flag_soilt200 = 0 
+      flag_soilm010 = 0 
+      flag_soilm040 = 0
+      flag_soilm100 = 0
+      flag_soilm200 = 0
+
+      flag_sst      = 0
+      flag_toposoil = 0
+
+      !  How many soil levels have we found?  Well, right now, none.
+
+      num_st_levels_input = 0
+      num_sm_levels_input = 0
+      st_levels_input = -1
+      sm_levels_input = -1
+
+      !  Get the space for the data if this is the first time here.
+
+        write(6,*) 'enter read_si...first_time_in:: ', first_time_in
+
+      IF ( first_time_in ) THEN
+
+         CLOSE(12)
+         OPEN ( FILE   = 'real_input_nm.global.metadata' , &
+                UNIT   = 12                              , &
+                STATUS = 'OLD'                           , &
+                ACCESS = 'SEQUENTIAL'                    , &
+                FORM   = 'UNFORMATTED'                   , &
+                IOSTAT = ok_open                           )
+
+         IF ( ok_open .NE. 0 ) THEN
+            PRINT '(A)','You asked for WRF SI data, but no real_input_nm.global.metadata file exists.'
+            STOP 'No_real_input_nm.global.metadata_exists'
+         END IF
+
+         READ(12) global_meta%simulation_name, global_meta%user_desc, &
+                  global_meta%si_version, global_meta%analysis_version, &
+                  global_meta%wrf_version, global_meta%post_version
+   
+         REWIND (12)
+
+         IF      ( global_meta%si_version .EQ. 1 ) THEN
+            READ(12) global_meta%simulation_name, global_meta%user_desc, &
+                     global_meta%si_version, global_meta%analysis_version, &
+                     global_meta%wrf_version, global_meta%post_version, &
+                     global_meta%map_projection, global_meta%moad_known_lat, &
+                     global_meta%moad_known_lon, global_meta%moad_known_loc, &
+                     global_meta%moad_stand_lats, global_meta%moad_stand_lons, &
+                     global_meta%moad_delta_x, global_meta%moad_delta_y, &
+                     global_meta%horiz_stagger_type, global_meta%num_stagger_xy, &
+                     global_meta%stagger_dir_x_old, global_meta%stagger_dir_y_old, &
+                     global_meta%num_stagger_z, global_meta%stagger_dir_z, &
+                     global_meta%vertical_coord, global_meta%num_domains, &
+                     global_meta%init_date, global_meta%init_time, &
+                     global_meta%end_date, global_meta%end_time
+         ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
+            READ(12) global_meta%simulation_name, global_meta%user_desc, &
+                     global_meta%si_version, global_meta%analysis_version, &
+                     global_meta%wrf_version, global_meta%post_version, &
+                     global_meta%map_projection, global_meta%moad_known_lat, &
+                     global_meta%moad_known_lon, global_meta%moad_known_loc, &
+                     global_meta%moad_stand_lats, global_meta%moad_stand_lons, &
+                     global_meta%moad_delta_x, global_meta%moad_delta_y, &
+                     global_meta%horiz_stagger_type, global_meta%num_stagger_xy, &
+                     global_meta%stagger_dir_x_new, global_meta%stagger_dir_y_new, &
+                     global_meta%num_stagger_z, global_meta%stagger_dir_z, &
+                     global_meta%vertical_coord, global_meta%num_domains, &
+                     global_meta%init_date, global_meta%init_time, &
+                     global_meta%end_date, global_meta%end_time , &
+                     global_meta%lu_source, global_meta%lu_water, global_meta%lu_ice
+         END IF
+         CLOSE (12)
+   
+         print *,'GLOBAL METADATA'
+         print *,'global_meta%simulation_name', global_meta%simulation_name
+         print *,'global_meta%user_desc', global_meta%user_desc
+         print *,'global_meta%user_desc', global_meta%user_desc
+         print *,'global_meta%si_version', global_meta%si_version
+         print *,'global_meta%analysis_version', global_meta%analysis_version
+         print *,'global_meta%wrf_version', global_meta%wrf_version
+         print *,'global_meta%post_version', global_meta%post_version
+         print *,'global_meta%map_projection', global_meta%map_projection
+         print *,'global_meta%moad_known_lat', global_meta%moad_known_lat
+         print *,'global_meta%moad_known_lon', global_meta%moad_known_lon
+         print *,'global_meta%moad_known_loc', global_meta%moad_known_loc
+         print *,'global_meta%moad_stand_lats', global_meta%moad_stand_lats
+         print *,'global_meta%moad_stand_lons', global_meta%moad_stand_lons
+         print *,'global_meta%moad_delta_x', global_meta%moad_delta_x
+         print *,'global_meta%moad_delta_y', global_meta%moad_delta_y
+         print *,'global_meta%horiz_stagger_type', global_meta%horiz_stagger_type
+         print *,'global_meta%num_stagger_xy', global_meta%num_stagger_xy
+         IF      ( global_meta%si_version .EQ. 1 ) THEN
+            print *,'global_meta%stagger_dir_x', global_meta%stagger_dir_x_old
+            print *,'global_meta%stagger_dir_y', global_meta%stagger_dir_y_old
+         ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
+            print *,'global_meta%stagger_dir_x', global_meta%stagger_dir_x_new
+            print *,'global_meta%stagger_dir_y', global_meta%stagger_dir_y_new
+         END IF
+         print *,'global_meta%num_stagger_z', global_meta%num_stagger_z
+         print *,'global_meta%stagger_dir_z', global_meta%stagger_dir_z
+         print *,'global_meta%vertical_coord', global_meta%vertical_coord
+         print *,'global_meta%num_domains', global_meta%num_domains
+         print *,'global_meta%init_date', global_meta%init_date
+         print *,'global_meta%init_time', global_meta%init_time
+         print *,'global_meta%end_date', global_meta%end_date
+         print *,'global_meta%end_time', global_meta%end_time
+         IF ( global_meta%si_version .EQ. 2 ) THEN
+            print *,'global_meta%lu_source', global_meta%lu_source
+            print *,'global_meta%lu_water', global_meta%lu_water
+            print *,'global_meta%lu_ice', global_meta%lu_ice
+         END IF
+         print *,' '
+
+         !  1D - this is the definition of the vertical coordinate.
+
+        IF (.NOT. ALLOCATED (DETA_in)) ALLOCATE(DETA_in(kds:kde-1))
+        IF (.NOT. ALLOCATED (AETA_in)) ALLOCATE(AETA_in(kds:kde-1))
+        IF (.NOT. ALLOCATED (ETAX_in)) ALLOCATE(ETAX_in(kds:kde))
+
+        IF (.NOT. ALLOCATED (DETA1_in)) ALLOCATE(DETA1_in(kds:kde-1))
+        IF (.NOT. ALLOCATED (AETA1_in)) ALLOCATE(AETA1_in(kds:kde-1))
+        IF (.NOT. ALLOCATED (ETA1_in))  ALLOCATE(ETA1_in(kds:kde))
+
+        IF (.NOT. ALLOCATED (DETA2_in)) ALLOCATE(DETA2_in(kds:kde-1))
+        IF (.NOT. ALLOCATED (AETA2_in)) ALLOCATE(AETA2_in(kds:kde-1))
+        IF (.NOT. ALLOCATED (ETA2_in)) ALLOCATE(ETA2_in(kds:kde))
+
+        IF (.NOT. ALLOCATED (DFL_in)) ALLOCATE(DFL_in(kds:kde))
+
+         !  3D met
+
+        IF (.NOT. ALLOCATED (u_input)  ) ALLOCATE ( u_input(its:ite,jts:jte,kts:kte) )
+        IF (.NOT. ALLOCATED (v_input)  ) ALLOCATE ( v_input(its:ite,jts:jte,kts:kte) )
+        IF (.NOT. ALLOCATED (q_input)  ) ALLOCATE ( q_input(its:ite,jts:jte,kts:kte) )
+        IF (.NOT. ALLOCATED (t_input)  ) ALLOCATE ( t_input(its:ite,jts:jte,kts:kte) )
+        IF (.NOT. ALLOCATED (htm_in)  ) ALLOCATE ( htm_in(its:ite,jts:jte,kts:kte) )
+        IF (.NOT. ALLOCATED (vtm_in)  ) ALLOCATE ( vtm_in(its:ite,jts:jte,kts:kte) )
+
+        !  2D pressure fields
+
+        IF (.NOT. ALLOCATED (pmsl)              ) ALLOCATE ( pmsl(its:ite,jts:jte) )
+        IF (.NOT. ALLOCATED (psfc_in)           ) ALLOCATE ( psfc_in(its:ite,jts:jte) )
+
+        !  2D - for LSM, these are computed from the categorical precentage values.
+
+        !  2D - for LSM, the various soil temperature and moisture levels that are available.
+
+        IF (.NOT. ALLOCATED (st_inputx)) ALLOCATE (st_inputx(its:ite,jts:jte,num_st_levels_alloc))
+        IF (.NOT. ALLOCATED (sm_inputx)) ALLOCATE (sm_inputx(its:ite,jts:jte,num_st_levels_alloc))
+        IF (.NOT. ALLOCATED (sw_inputx)) ALLOCATE (sw_inputx(its:ite,jts:jte,num_st_levels_alloc))
+
+        IF (.NOT. ALLOCATED (soilt010_input)    ) ALLOCATE ( soilt010_input(its:ite,jts:jte) )
+        IF (.NOT. ALLOCATED (soilt040_input)    ) ALLOCATE ( soilt040_input(its:ite,jts:jte) )
+        IF (.NOT. ALLOCATED (soilt100_input)    ) ALLOCATE ( soilt100_input(its:ite,jts:jte) )
+        IF (.NOT. ALLOCATED (soilt200_input)    ) ALLOCATE ( soilt200_input(its:ite,jts:jte) )
+        IF (.NOT. ALLOCATED (soilm010_input)    ) ALLOCATE ( soilm010_input(its:ite,jts:jte) )
+        IF (.NOT. ALLOCATED (soilm040_input)    ) ALLOCATE ( soilm040_input(its:ite,jts:jte) )
+        IF (.NOT. ALLOCATED (soilm100_input)    ) ALLOCATE ( soilm100_input(its:ite,jts:jte) )
+        IF (.NOT. ALLOCATED (soilm200_input)    ) ALLOCATE ( soilm200_input(its:ite,jts:jte) )
+
+        IF (.NOT. ALLOCATED (lat_wind)          ) ALLOCATE (lat_wind(its:ite,jts:jte))
+        IF (.NOT. ALLOCATED (lon_wind)          ) ALLOCATE (lon_wind(its:ite,jts:jte))
+
+        !  Local arrays
+        IF (.NOT. ALLOCATED (dum2d)             ) ALLOCATE (dum2d(IDS:IDE-1,JDS:JDE-1))
+        IF (.NOT. ALLOCATED (idum2d)            ) ALLOCATE (idum2d(IDS:IDE-1,JDS:JDE-1))
+        IF (.NOT. ALLOCATED (dum3d)             ) ALLOCATE (dum3d(IDS:IDE-1,JDS:JDE-1,KDS:KDE-1))
+
+
+      END IF
+
+      CLOSE(13)
+
+      write(6,*) 'file_date_string: ', file_date_string
+      write(6,*) 'opening real_input_nm.d01.'//file_date_string//' as unit 13'
+      OPEN ( FILE   = 'real_input_nm.d01.'//file_date_string , &
+             UNIT   = 13                                     , &
+             STATUS = 'OLD'                                  , &
+             ACCESS = 'SEQUENTIAL'                           , &
+             FORM   = 'UNFORMATTED'                            )
+
+      IF      ( global_meta%si_version .EQ. 1 ) THEN
+         READ (13) dom_meta%id,dom_meta%parent_id,dom_meta%dyn_init_src,&
+                   dom_meta%static_init_src, dom_meta%vt_date, dom_meta%vt_time, &
+                   dom_meta%origin_parent_x, dom_meta%origin_parent_y, &
+                   dom_meta%ratio_to_parent, dom_meta%delta_x, dom_meta%delta_y, &
+                   dom_meta%top_level, dom_meta%origin_parent_z, &
+                   dom_meta%corner_lats_old, dom_meta%corner_lons_old, dom_meta%xdim, &
+                   dom_meta%ydim, dom_meta%zdim
+      ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
+         READ (13) dom_meta%id,dom_meta%parent_id,dom_meta%dyn_init_src,&
+                   dom_meta%static_init_src, dom_meta%vt_date, dom_meta%vt_time, &
+                   dom_meta%origin_parent_x, dom_meta%origin_parent_y, &
+                   dom_meta%ratio_to_parent, dom_meta%delta_x, dom_meta%delta_y, &
+                   dom_meta%top_level, dom_meta%origin_parent_z, &
+                   dom_meta%corner_lats_new, dom_meta%corner_lons_new, dom_meta%xdim, &
+                   dom_meta%ydim, dom_meta%zdim
+      END IF
+
+      print *,'DOMAIN METADATA'
+      print *,'dom_meta%id=', dom_meta%id
+      print *,'dom_meta%parent_id=', dom_meta%parent_id
+      print *,'dom_meta%dyn_init_src=', dom_meta%dyn_init_src
+      print *,'dom_meta%static_init_src=', dom_meta%static_init_src
+      print *,'dom_meta%vt_date=', dom_meta%vt_date
+      print *,'dom_meta%vt_time=', dom_meta%vt_time
+      print *,'dom_meta%origin_parent_x=', dom_meta%origin_parent_x
+      print *,'dom_meta%origin_parent_y=', dom_meta%origin_parent_y
+      print *,'dom_meta%ratio_to_parent=', dom_meta%ratio_to_parent
+      print *,'dom_meta%delta_x=', dom_meta%delta_x
+      print *,'dom_meta%delta_y=', dom_meta%delta_y
+      print *,'dom_meta%top_level=', dom_meta%top_level
+      print *,'dom_meta%origin_parent_z=', dom_meta%origin_parent_z
+      IF      ( global_meta%si_version .EQ. 1 ) THEN
+         print *,'dom_meta%corner_lats=', dom_meta%corner_lats_old
+         print *,'dom_meta%corner_lons=', dom_meta%corner_lons_old
+      ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
+         print *,'dom_meta%corner_lats=', dom_meta%corner_lats_new
+         print *,'dom_meta%corner_lons=', dom_meta%corner_lons_new
+      END IF
+      print *,'dom_meta%xdim=', dom_meta%xdim
+      print *,'dom_meta%ydim=', dom_meta%ydim
+      print *,'dom_meta%zdim=', dom_meta%zdim
+      print *,' '
+
+      !  A simple domain size test.
+    
+
+!!        relax constraint, as model namelist has +1 for i and j, while
+!!        si data has true dimensions
+
+      IF (  abs(dom_meta%xdim - (ide-1)) .gt. 1 &
+       .OR. abs(dom_meta%ydim - (jde-1)) .gt. 1 &
+       .OR. abs(dom_meta%zdim - (kde-1)) .gt. 1) THEN
+         PRINT '(A)','Namelist does not match the input data.'
+         PRINT '(A,3I5,A)','Namelist dimensions =',ide-1,jde-1,kde-1,'.'
+         PRINT '(A,3I5,A)','Input data dimensions =',dom_meta%xdim,dom_meta%ydim,dom_meta%zdim,'.'
+         STOP 'Wrong_data_size'
+      END IF
+
+      ! How about the grid distance?  Is it the same as in the namelist?
+
+      IF        ( global_meta%si_version .EQ. 1 ) THEN
+         CALL nl_set_cen_lat ( grid%id , ( dom_meta%corner_lats_old(1,1) + dom_meta%corner_lats_old(2,1) +        &
+                                        dom_meta%corner_lats_old(3,1) + dom_meta%corner_lats_old(4,1) ) * 0.25 ) 
+      ELSE IF ( ( global_meta%si_version .EQ. 2 ) .AND. ( global_meta%moad_known_loc(1:6) .EQ. 'CENTER' ) ) THEN
+         CALL nl_set_cen_lat ( grid%id , global_meta%moad_known_lat )
+      ELSE IF   ( global_meta%si_version .EQ. 2 ) THEN
+         CALL nl_set_cen_lat ( grid%id , ( dom_meta%corner_lats_new(1,1) + dom_meta%corner_lats_new(2,1) +        &
+                                        dom_meta%corner_lats_new(3,1) + dom_meta%corner_lats_new(4,1) ) * 0.25 ) 
+      END IF
+
+
+!!!        might be trouble here
+
+      CALL nl_set_cen_lon ( grid%id , global_meta%moad_stand_lons(1) )
+!!!!!
+      write(6,*) 'set_cen_lat... global_meta%moad_stand_lats(1): ', global_meta%moad_stand_lats(1)
+      CALL nl_set_cen_lat ( grid%id , global_meta%moad_stand_lats(1) )
+!!!!!
+      CALL nl_set_truelat1 ( grid%id , global_meta%moad_stand_lats(1) )
+      CALL nl_set_truelat2 ( grid%id , global_meta%moad_stand_lats(2) )
+
+      pt = dom_meta%top_level
+
+      IF      ( global_meta%map_projection(1:17) .EQ. 'LAMBERT CONFORMAL'   ) THEN
+         map_proj = 1
+      ELSE IF ( global_meta%map_projection(1:19) .EQ. 'POLAR STEREOGRAPHIC' ) THEN
+         map_proj = 2
+      ELSE IF ( global_meta%map_projection(1: 8) .EQ. 'MERCATOR'            ) THEN
+         map_proj = 3
+      ELSE IF ( global_meta%map_projection(1:14) .EQ. 'ROTATED LATLON' ) THEN
+         map_proj = 203 !?
+      ELSE
+         PRINT '(A,A,A)','Undefined map projection: ',TRIM(global_meta%map_projection(1:20)),'.'
+         STOP 'Undefined_map_proj_si'
+      END IF
+      CALL nl_set_map_proj ( grid%id , map_proj ) 
+     
+      write(0,*) 'global_meta%si_version: ', global_meta%si_version
+      write(0,*) 'global_meta%lu_source: ', global_meta%lu_source
+      write(0,*) 'global_meta%lu_water: ', global_meta%lu_water
+      IF      ( global_meta%si_version .EQ. 1 ) THEN
+         CALL nl_set_mminlu (grid%id, 'USGS' )
+         CALL nl_set_iswater (grid%id, 16 )
+      ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
+         CALL nl_set_mminlu ( grid%id, global_meta%lu_source )
+         CALL nl_set_iswater (grid%id, global_meta%lu_water )
+         CALL nl_set_isice (grid%id, global_meta%lu_ice )
+      END IF
+
+      CALL nl_set_gmt (grid%id, dom_meta%vt_time / 3600. )
+      CALL nl_set_julyr (grid%id, dom_meta%vt_date / 1000 )
+      CALL nl_set_julday (grid%id, dom_meta%vt_date - ( dom_meta%vt_date / 1000 ) * 1000 )
+
+      write(6,*) 'start reading from unit 13'
+      read_all_the_data : DO
+
+         READ (13,IOSTAT=OK) var_info%name, var_info%units, &
+                             var_info%description, var_info%domain_id, var_info%ndim, &
+                             var_info%dim_val, var_info%dim_desc, var_info%start_index, &
+                             var_info%stop_index, var_info%h_stagger_index, var_info%v_stagger_index,&
+                             var_info%array_order, var_info%field_type, var_info%field_source_prog, &
+                             var_info%source_desc, var_info%field_time_type, var_info%vt_date_start, &
+                             var_info%vt_time_start, var_info%vt_date_stop, var_info%vt_time_stop
+
+         IF ( OK .NE. 0 ) THEN
+            PRINT '(A,A,A)','End of file found for real_input_nm.d01.',file_date_string,'.'
+            EXIT read_all_the_data
+         END IF
+
+!        print *,'VARIABLE METADATA'
+         PRINT '(A,A)','var_info%name=', var_info%name 
+!        print *,'var_info%units=', var_info%units 
+!        print *,'var_info%description=', var_info%description 
+!        print *,'var_info%domain_id=', var_info%domain_id 
+!        print *,'var_info%ndim=', var_info%ndim 
+!        print *,'var_info%dim_val=', var_info%dim_val 
+!        print *,'var_info%dim_desc=', var_info%dim_desc 
+!        print *,'var_info%start_index=', var_info%start_index 
+!        print *,'var_info%stop_index=', var_info%stop_index 
+!        print *,'var_info%h_stagger_index=', var_info%h_stagger_index 
+!        print *,'var_info%v_stagger_index=', var_info%v_stagger_index
+!        print *,'var_info%array_order=', var_info%array_order 
+!        print *,'var_info%field_type=', var_info%field_type 
+!        print *,'var_info%field_source_prog=', var_info%field_source_prog 
+!        print *,'var_info%source_desc=', var_info%source_desc 
+!        print *,'var_info%field_time_type=', var_info%field_time_type 
+!        print *,'var_info%vt_date_start=', var_info%vt_date_start 
+!        print *,'var_info%vt_time_start=', var_info%vt_time_start 
+!        print *,'var_info%vt_date_stop=', var_info%vt_date_stop 
+!        print *,'var_info%vt_time_stop=', var_info%vt_time_stop
+
+        JMAX=min(JDE-1,JTE)
+        IMAX=min(IDE-1,ITE)
+         !  3D meteorological fields.
+
+         write(0,*)' read_si var_info%name=',var_info%name(1:8)
+
+         IF      ( var_info%name(1:8) .EQ. 'T       ' ) THEN
+            READ (13) dum3d
+            do k=kts,kte-1
+            do j=jts,JMAX
+            do i=its,IMAX
+              t_input(i,j,k)=dum3d(i,j,k)
+            enddo
+            enddo
+            enddo
+
+         ELSE IF      ( var_info%name(1:8) .EQ. 'U       ' ) THEN
+            READ (13) dum3d
+            do k=kts,kte-1
+            do j=jts,JMAX
+            do i=its,IMAX
+              u_input(i,j,k)=dum3d(i,j,k)
+            enddo
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'V       ' ) THEN
+            READ (13) dum3d
+            do k=kts,kte-1
+            do j=jts,JMAX
+            do i=its,IMAX
+              v_input(i,j,k)=dum3d(i,j,k)
+            enddo
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'Q      ' ) THEN
+            READ (13) dum3d
+            do k=kts,kte-1
+            do j=jts,JMAX
+            do i=its,IMAX
+              q_input(i,j,k)=dum3d(i,j,k)
+            enddo
+            enddo
+            enddo
+
+         !  3D LSM fields.  Don't know the 3rd dimension until we read it in.
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'LANDUSEF' ) THEN
+            IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( landuse_frac_input) ) ) THEN
+               ALLOCATE (landuse_frac_input(its:ite,jts:jte,var_info%dim_val(3)) )
+            END IF
+            READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
+            do k=1,var_info%dim_val(3)
+            do j=jts,JMAX
+            do i=its,IMAX
+              landuse_frac_input(i,j,k)=dum3d(i,j,k)
+            enddo
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILCTOP' ) THEN
+            IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( soil_top_cat_input) ) ) THEN
+               ALLOCATE (soil_top_cat_input(its:ite,jts:jte,var_info%dim_val(3)) )
+            END IF
+            READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
+            do k=1,var_info%dim_val(3)
+            do j=jts,JMAX
+            do i=its,IMAX
+              soil_top_cat_input(i,j,k)=dum3d(i,j,k)
+            enddo
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILCBOT' ) THEN
+            IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( soil_bot_cat_input) ) ) THEN
+               ALLOCATE (soil_bot_cat_input(its:ite,jts:jte,var_info%dim_val(3)) )
+            END IF
+            READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
+            do k=1,var_info%dim_val(3)
+            do j=jts,JMAX
+            do i=its,IMAX
+              soil_bot_cat_input(i,j,k)=dum3d(i,j,k)
+            enddo
+            enddo
+            enddo
+
+         !  2D dry pressure minus ptop.
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'PD      ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_pd(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'PSFC    ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              psfc_in(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'PMSL    ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              pmsl(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'PDTOP   ' ) THEN
+            READ (13) grid%nmm_pdtop
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'PT      ' ) THEN
+            READ (13) grid%nmm_pt
+
+         !  2D surface fields.
+
+        ELSE IF ( var_info%name(1:8) .eq. 'GLAT    ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_glat(i,j)=dum2d(i,j)
+            enddo
+            enddo
+        ELSE IF ( var_info%name(1:8) .eq. 'GLON    ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_glon(i,j)=dum2d(i,j)
+            enddo
+            enddo
+        ELSE IF ( var_info%name(1:8) .eq. 'LAT_V   ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              lat_wind(i,j)=dum2d(i,j)
+            enddo
+            enddo
+        ELSE IF ( var_info%name(1:8) .eq. 'LON_V   ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              lon_wind(i,j)=dum2d(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'ST000010' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%st000010(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_st000010 = 1
+            num_st_levels_input = num_st_levels_input + 1
+            st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+              st_inputx(I,J,num_st_levels_input + 1) = grid%st000010(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'ST010040' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%st010040(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_st010040 = 1
+            num_st_levels_input = num_st_levels_input + 1
+            st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+              st_inputx(I,J,num_st_levels_input + 1) = grid%st010040(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'ST040100' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%st040100(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_st040100 = 1
+            num_st_levels_input = num_st_levels_input + 1
+            st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+              st_inputx(I,J,num_st_levels_input + 1) = grid%st040100(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'ST100200' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%st100200(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_st100200 = 1
+            num_st_levels_input = num_st_levels_input + 1
+            st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+              st_inputx(I,J,num_st_levels_input + 1) = grid%st100200(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'ST010200' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%st010200(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_st010200 = 1
+            num_st_levels_input = num_st_levels_input + 1
+            st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+              st_inputx(I,J,num_st_levels_input + 1) = grid%st010200(i,j)
+            enddo
+            enddo
+
+        ELSE IF ( var_info%name(1:8) .EQ. 'SM000010' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%sm000010(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_sm000010 = 1
+            num_sm_levels_input = num_sm_levels_input + 1
+            sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+              sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm000010(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'SM010040' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%sm010040(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_sm010040 = 1
+            num_sm_levels_input = num_sm_levels_input + 1
+            sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+              sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm010040(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'SM040100' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%sm040100(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_sm040100 = 1
+            num_sm_levels_input = num_sm_levels_input + 1
+            sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+              sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm040100(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'SM100200' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%sm100200(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_sm100200 = 1
+            num_sm_levels_input = num_sm_levels_input + 1
+            sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+              sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm100200(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'SM010200' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%sm010200(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_sm010200 = 1
+            num_sm_levels_input = num_sm_levels_input + 1
+            sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
+            do j=jts,JMAX
+            do i=its,IMAX
+               sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm010200(i,j)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILT010' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              soilt010_input(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_soilt010 = 1
+            num_st_levels_input = num_st_levels_input + 1
+            st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
+!mp            st_inputx(:,:,num_st_levels_input + 1) = soilt010_input
+            do j=jts,JMAX
+            do i=its,IMAX
+              st_inputx(I,J,num_st_levels_input + 1) = soilt010_input(I,J)
+            enddo
+            enddo
+            write(6,*) 'num_st_levels_input=',num_st_levels_input
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILT040' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              soilt040_input(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_soilt040 = 1
+            num_st_levels_input = num_st_levels_input + 1
+            st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
+!mp            st_inputx(:,:,num_st_levels_input + 1) = soilt040_input
+            do j=jts,JMAX
+            do i=its,IMAX
+              st_inputx(I,J,num_st_levels_input + 1) = soilt040_input(I,J)
+            enddo
+            enddo
+            write(6,*) 'num_st_levels_input=',num_st_levels_input
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILT100' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              soilt100_input(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_soilt100 = 1
+            num_st_levels_input = num_st_levels_input + 1
+            st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
+!mp            st_inputx(:,:,num_st_levels_input + 1) = soilt100_input
+            do j=jts,JMAX
+            do i=its,IMAX
+              st_inputx(I,J,num_st_levels_input + 1) = soilt100_input(I,J)
+            enddo
+            enddo
+            write(6,*) 'num_st_levels_input=',num_st_levels_input
+        ELSE IF ( var_info%name(1:8) .EQ. 'SOILT200' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              soilt200_input(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_soilt200 = 1
+            num_st_levels_input = num_st_levels_input + 1
+            st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
+!mp            st_inputx(:,:,num_st_levels_input + 1) = soilt200_input
+            do j=jts,JMAX
+            do i=its,IMAX
+              st_inputx(I,J,num_st_levels_input + 1) = soilt200_input(I,J)
+            enddo
+            enddo
+            write(6,*) 'num_st_levels_input=',num_st_levels_input
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILM010' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              soilm010_input(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_soilm010 = 1
+            num_sm_levels_input = num_sm_levels_input + 1
+            sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
+!mp            sm_inputx(:,:,num_sm_levels_input + 1) = soilm010_input
+            do j=jts,JMAX
+            do i=its,IMAX
+              sm_inputx(I,J,num_sm_levels_input + 1) = soilm010_input(I,J)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILM040' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              soilm040_input(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_soilm040 = 1
+            num_sm_levels_input = num_sm_levels_input + 1
+            sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
+!mp            sm_inputx(:,:,num_sm_levels_input + 1) = soilm040_input
+            do j=jts,JMAX
+            do i=its,IMAX
+              sm_inputx(I,J,num_sm_levels_input + 1) = soilm040_input(I,J)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILM100' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              soilm100_input(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_soilm100 = 1
+            num_sm_levels_input = num_sm_levels_input + 1
+            sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
+!mp            sm_inputx(:,:,num_sm_levels_input + 1) = soilm100_input
+            do j=jts,JMAX
+            do i=its,IMAX
+              sm_inputx(I,J,num_sm_levels_input + 1) = soilm100_input(I,J)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILM200' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              soilm200_input(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_soilm200 = 1
+            num_sm_levels_input = num_sm_levels_input + 1
+            sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
+!mp            sm_inputx(:,:,num_sm_levels_input + 1) = soilm200_input
+            do j=jts,JMAX
+            do i=its,IMAX
+              sm_inputx(I,J,num_sm_levels_input + 1) = soilm200_input(I,J)
+            enddo
+            enddo
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'SEAICE  ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%xice(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'WEASD   ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%weasd(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'CANWAT  ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%canwat(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'LANDMASK' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%landmask(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'SKINTEMP' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_nmm_tsk(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'TGROUND ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+             grid%nmm_tg(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'SOILTB  ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+             grid%nmm_soiltb(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'SST     ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+               grid%sst(i,j)=dum2d(i,j)
+            enddo
+            enddo
+            flag_sst = 1
+         ELSE IF ( var_info%name(1:8) .EQ. 'GREENFRC' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_vegfrc(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'ISLOPE  ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_islope(i,j)=nint(dum2d(i,j))
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'GREENMAX' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%greenmax(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'GREENMIN' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+               grid%greenmin(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'FIS     ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_fis(i,j)=dum2d(i,j)
+            enddo
+            enddo
+        ELSE IF ( var_info%name(1:8) .EQ. 'Z0      ' ) THEN
+!         ELSE IF ( var_info%name(1:8) .EQ. 'STDEV   ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_z0(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'CMC     ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_cmc(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'HTM     ' ) THEN
+            READ (13) dum3d
+            do k=kts,kte-1
+            do j=jts,JMAX
+            do i=its,IMAX
+              htm_in(i,j,k)=dum3d(i,j,k)
+            enddo
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'VTM     ' ) THEN
+            READ (13) dum3d
+            do k=kts,kte-1
+            do j=jts,JMAX
+            do i=its,IMAX
+              vtm_in(i,j,k)=dum3d(i,j,k)
+            enddo
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'SM      ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_sm(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'ALBASE  ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_albase(i,j)=dum2d(i,j)
+            enddo
+            enddo
+         ELSE IF ( var_info%name(1:8) .EQ. 'MXSNAL  ' ) THEN
+            READ (13) dum2d
+            do j=jts,JMAX
+            do i=its,IMAX
+              grid%nmm_mxsnal(i,j)=dum2d(i,j)
+            enddo
+            enddo
+
+         !  1D vertical coordinate.
+
+          ELSE IF ( var_info%name(1:8) .EQ. 'DETA    ' ) THEN
+             READ(13) DETA_in
+          ELSE IF ( var_info%name(1:8) .EQ. 'DETA1   ' ) THEN
+             READ(13) DETA1_in
+          ELSE IF ( var_info%name(1:8) .EQ. 'DETA2   ' ) THEN
+             READ(13) DETA2_in
+          ELSE IF ( var_info%name(1:8) .EQ. 'ETAX    ' ) THEN
+             READ(13) ETAX_in
+          ELSE IF ( var_info%name(1:8) .EQ. 'ETA1    ' ) THEN
+             READ(13) ETA1_in
+          ELSE IF ( var_info%name(1:8) .EQ. 'ETA2    ' ) THEN
+             READ(13) ETA2_in
+          ELSE IF ( var_info%name(1:8) .EQ. 'AETA    ' ) THEN
+             READ(13) AETA_in
+          ELSE IF ( var_info%name(1:8) .EQ. 'AETA1   ' ) THEN
+             READ(13) AETA1_in
+          ELSE IF ( var_info%name(1:8) .EQ. 'AETA2   ' ) THEN
+             READ(13) AETA2_in
+          ELSE IF ( var_info%name(1:8) .EQ. 'DFL     ' ) THEN
+             READ(13) DFL_in
+
+!         ELSE IF ( var_info%name(1:8) .EQ. 'ETAPHALF' ) THEN
+!            READ (13) etahalf
+!         ELSE IF ( var_info%name(1:8) .EQ. 'ETAPFULL' ) THEN
+!            READ (13) etafull
+
+         !  wrong input data.
+
+         ELSE IF ( var_info%name(1:8) .EQ. 'ZETAFULL' ) THEN
+            PRINT '(A)','Oops, you put in the height data.'
+            STOP 'this_is_mass_not_height'
+ 
+
+         !  Stuff that we do not want or need is just skipped over.
+
+         ELSE
+print *,'------------------> skipping ', var_info%name(1:8)
+            READ (13) dummy
+         END IF
+
+      END DO read_all_the_data
+
+      CLOSE (13)
+
+      first_time_in = .FALSE.
+
+!new
+        sw_inputx=0.
+!new
+
+      do j=jts,JMAX
+      do k=kts,kte-1
+      do i=its,IMAX
+        grid%nmm_HTM(I,K,J)=HTM_in(I,J,K)
+        grid%nmm_VTM(I,K,J)=VTM_in(I,J,K)
+        grid%nmm_U(I,K,J)=U_input(I,J,K)
+        grid%nmm_V(I,K,J)=V_input(I,J,K)
+        grid%nmm_T(I,K,J)=T_input(I,J,K)
+        grid%nmm_Q(I,K,J)=Q_input(I,J,K)
+      enddo
+      enddo
+      enddo
+
+      write(0,*) 'size sw_input: ', size(sw_input,dim=1),size(sw_input,dim=2),size(sw_input,dim=3)
+      write(0,*) 'size sw_inputx: ', size(sw_inputx,dim=1),size(sw_inputx,dim=2),size(sw_inputx,dim=3)
+      sw_input=0.
+
+        write(0,*) 'maxval st_inputx(1): ', maxval(st_input(:,:,1))
+        write(0,*) 'maxval st_inputx(2): ', maxval(st_input(:,:,2))
+        write(0,*) 'maxval st_inputx(3): ', maxval(st_input(:,:,3))
+        write(0,*) 'maxval st_inputx(4): ', maxval(st_input(:,:,4))
+
+
+        do K=1,num_st_levels_alloc
+         do J=JTS,min(JDE-1,JTE)
+          do I=ITS,min(IDE-1,ITE)
+             st_input(I,K,J)=st_inputx(I,J,K)
+             sm_input(I,K,J)=sm_inputx(I,J,K)
+             sw_input(I,K,J)=sw_inputx(I,J,K)
+          enddo
+         enddo
+        enddo
+
+        write(0,*) 'maxval st_input(1): ', maxval(st_input(:,1,:))
+        write(0,*) 'maxval st_input(2): ', maxval(st_input(:,2,:))
+        write(0,*) 'maxval st_input(3): ', maxval(st_input(:,3,:))
+        write(0,*) 'maxval st_input(4): ', maxval(st_input(:,4,:))
+
+
+         num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
+         num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
+         num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
+
+        do J=JTS,min(JDE-1,JTE)
+         do K=1,num_soil_top_cat
+          do I=ITS,min(IDE-1,ITE)
+          grid%SOILCTOP(I,K,J)=soil_top_cat_input(I,J,K)
+          enddo
+         enddo
+        enddo
+
+        do J=JTS,min(JDE-1,JTE)
+         do K=1,num_soil_bot_cat
+          do I=ITS,min(IDE-1,ITE)
+          grid%SOILCBOT(I,K,J)=soil_bot_cat_input(I,J,K)
+          enddo
+         enddo
+        enddo
+
+        do J=JTS,min(JDE-1,JTE)
+         do K=1,num_veg_cat
+          do I=ITS,min(IDE-1,ITE)
+          grid%LANDUSEF(I,K,J)=landuse_frac_input(I,J,K)
+          enddo
+         enddo
+        enddo
+
+
+      do K=KDS,KDE
+        grid%nmm_ETAX(K)=ETAX_in(KDE-K+1)
+        grid%nmm_ETA1(K)=ETA1_in(KDE-K+1)
+        grid%nmm_ETA2(K)=ETA2_in(KDE-K+1)
+        grid%nmm_DFL(K)=DFL_in(KDE-K+1)
+      enddo
+
+      do K=KDS,KDE-1
+        grid%nmm_DETA(K)=DETA_in(KDE-K)
+        grid%nmm_DETA1(K)=DETA1_in(KDE-K)
+        grid%nmm_DETA2(K)=DETA2_in(KDE-K)
+        grid%nmm_AETA(K)=AETA_in(KDE-K)
+        grid%nmm_AETA1(K)=AETA1_in(KDE-K)
+        grid%nmm_AETA2(K)=AETA2_in(KDE-K)
+      enddo
+
+   END SUBROUTINE read_si
+
+END MODULE module_si_io_nmm
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/nmm_loop_basemacros.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/nmm_loop_basemacros.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/nmm_loop_basemacros.h	(revision 2744)
@@ -0,0 +1,9 @@
+! these define the various loop range variables
+! that were defined in module_MPP. Defined as macros
+! here to allow thread-safety/tile callability
+
+#define MY_IS(A,B) max(ids+(A),its-(B))
+#define MY_IE(A,B) min(ide-(A),ite+(B))
+#define MY_JS(A,B) max(jds+(A),jts-(B))
+#define MY_JE(A,B) min(jde-(A),jte+(B))
+
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/nmm_loop_macros.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/nmm_loop_macros.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/nmm_loop_macros.h	(revision 2744)
@@ -0,0 +1,128 @@
+! these define the various loop range variables
+! that were defined in module_MPP. Defined as macros
+! here to allow thread-safety/tile callability
+
+#define MYIS      MY_IS( 0 , 0  )
+#define MYIS_P1   MY_IS( 0 , 1  )
+#define MYIS_P2   MY_IS( 0 , 2  )
+#define MYIS_P3   MY_IS( 0 , 3  )
+#define MYIS_P4   MY_IS( 0 , 4  )
+#define MYIS_P5   MY_IS( 0 , 5  )
+#define MYIS1     MY_IS( 1 , 0  )
+#define MYIS1_P1  MY_IS( 1 , 1  )
+#define MYIS1_P2  MY_IS( 1 , 2  )
+#define MYIS1_P3  MY_IS( 1 , 3  )
+#define MYIS1_P4  MY_IS( 1 , 4  )
+#define MYIS1_P5  MY_IS( 1 , 5  )
+#define MYIS2     MY_IS( 2 , 0  )
+#define MYIS2_P1  MY_IS( 2 , 1  )
+#define MYIS2_P2  MY_IS( 2 , 2  )
+#define MYIS2_P3  MY_IS( 2 , 3  )
+#define MYIS2_P4  MY_IS( 2 , 4  )
+#define MYIS2_P5  MY_IS( 2 , 5  )
+#define MYIS3     MY_IS( 3 , 0  )
+#define MYIS3_P1  MY_IS( 3 , 1  )
+#define MYIS3_P2  MY_IS( 3 , 2  )
+#define MYIS3_P3  MY_IS( 3 , 3  )
+#define MYIS3_P4  MY_IS( 3 , 4  )
+#define MYIS3_P5  MY_IS( 3 , 5  )
+#define MYIS4     MY_IS( 4 , 0  )
+#define MYIS4_P1  MY_IS( 4 , 1  )
+#define MYIS4_P2  MY_IS( 4 , 2  )
+#define MYIS4_P3  MY_IS( 4 , 3  )
+#define MYIS4_P4  MY_IS( 4 , 4  )
+#define MYIS4_P5  MY_IS( 4 , 5  )
+
+#define MYIE      MY_IE( 0 , 0  )
+#define MYIE_P1   MY_IE( 0 , 1  )
+#define MYIE_P2   MY_IE( 0 , 2  )
+#define MYIE_P3   MY_IE( 0 , 3  )
+#define MYIE_P4   MY_IE( 0 , 4  )
+#define MYIE_P5   MY_IE( 0 , 5  )
+#define MYIE1     MY_IE( 1 , 0  )
+#define MYIE1_P1  MY_IE( 1 , 1  )
+#define MYIE1_P2  MY_IE( 1 , 2  )
+#define MYIE1_P3  MY_IE( 1 , 3  )
+#define MYIE1_P4  MY_IE( 1 , 4  )
+#define MYIE1_P5  MY_IE( 1 , 5  )
+#define MYIE2     MY_IE( 2 , 0  )
+#define MYIE2_P1  MY_IE( 2 , 1  )
+#define MYIE2_P2  MY_IE( 2 , 2  )
+#define MYIE2_P3  MY_IE( 2 , 3  )
+#define MYIE2_P4  MY_IE( 2 , 4  )
+#define MYIE2_P5  MY_IE( 2 , 5  )
+#define MYIE3     MY_IE( 3 , 0  )
+#define MYIE3_P1  MY_IE( 3 , 1  )
+#define MYIE3_P2  MY_IE( 3 , 2  )
+#define MYIE3_P3  MY_IE( 3 , 3  )
+#define MYIE3_P4  MY_IE( 3 , 4  )
+#define MYIE3_P5  MY_IE( 3 , 5  )
+#define MYIE4     MY_IE( 4 , 0  )
+#define MYIE4_P1  MY_IE( 4 , 1  )
+#define MYIE4_P2  MY_IE( 4 , 2  )
+#define MYIE4_P3  MY_IE( 4 , 3  )
+#define MYIE4_P4  MY_IE( 4 , 4  )
+#define MYIE4_P5  MY_IE( 4 , 5  )
+
+#define MYJS      MY_JS( 0 , 0  )
+#define MYJS_P1   MY_JS( 0 , 1  )
+#define MYJS_P2   MY_JS( 0 , 2  )
+#define MYJS_P3   MY_JS( 0 , 3  )
+#define MYJS_P4   MY_JS( 0 , 4  )
+#define MYJS_P5   MY_JS( 0 , 5  )
+#define MYJS1     MY_JS( 1 , 0  )
+#define MYJS1_P1  MY_JS( 1 , 1  )
+#define MYJS1_P2  MY_JS( 1 , 2  )
+#define MYJS1_P3  MY_JS( 1 , 3  )
+#define MYJS1_P4  MY_JS( 1 , 4  )
+#define MYJS1_P5  MY_JS( 1 , 5  )
+#define MYJS2     MY_JS( 2 , 0  )
+#define MYJS2_P1  MY_JS( 2 , 1  )
+#define MYJS2_P2  MY_JS( 2 , 2  )
+#define MYJS2_P3  MY_JS( 2 , 3  )
+#define MYJS2_P4  MY_JS( 2 , 4  )
+#define MYJS2_P5  MY_JS( 2 , 5  )
+#define MYJS3     MY_JS( 3 , 0  )
+#define MYJS3_P1  MY_JS( 3 , 1  )
+#define MYJS3_P2  MY_JS( 3 , 2  )
+#define MYJS3_P3  MY_JS( 3 , 3  )
+#define MYJS3_P4  MY_JS( 3 , 4  )
+#define MYJS3_P5  MY_JS( 3 , 5  )
+#define MYJS4     MY_JS( 4 , 0  )
+#define MYJS4_P1  MY_JS( 4 , 1  )
+#define MYJS4_P2  MY_JS( 4 , 2  )
+#define MYJS4_P3  MY_JS( 4 , 3  )
+#define MYJS4_P4  MY_JS( 4 , 4  )
+#define MYJS4_P5  MY_JS( 4 , 5  )
+
+#define MYJE      MY_JE( 0 , 0  )
+#define MYJE_P1   MY_JE( 0 , 1  )
+#define MYJE_P2   MY_JE( 0 , 2  )
+#define MYJE_P3   MY_JE( 0 , 3  )
+#define MYJE_P4   MY_JE( 0 , 4  )
+#define MYJE_P5   MY_JE( 0 , 5  )
+#define MYJE1     MY_JE( 1 , 0  )
+#define MYJE1_P1  MY_JE( 1 , 1  )
+#define MYJE1_P2  MY_JE( 1 , 2  )
+#define MYJE1_P3  MY_JE( 1 , 3  )
+#define MYJE1_P4  MY_JE( 1 , 4  )
+#define MYJE1_P5  MY_JE( 1 , 5  )
+#define MYJE2     MY_JE( 2 , 0  )
+#define MYJE2_P1  MY_JE( 2 , 1  )
+#define MYJE2_P2  MY_JE( 2 , 2  )
+#define MYJE2_P3  MY_JE( 2 , 3  )
+#define MYJE2_P4  MY_JE( 2 , 4  )
+#define MYJE2_P5  MY_JE( 2 , 5  )
+#define MYJE3     MY_JE( 3 , 0  )
+#define MYJE3_P1  MY_JE( 3 , 1  )
+#define MYJE3_P2  MY_JE( 3 , 2  )
+#define MYJE3_P3  MY_JE( 3 , 3  )
+#define MYJE3_P4  MY_JE( 3 , 4  )
+#define MYJE3_P5  MY_JE( 3 , 5  )
+#define MYJE4     MY_JE( 4 , 0  )
+#define MYJE4_P1  MY_JE( 4 , 1  )
+#define MYJE4_P2  MY_JE( 4 , 2  )
+#define MYJE4_P3  MY_JE( 4 , 3  )
+#define MYJE4_P4  MY_JE( 4 , 4  )
+#define MYJE4_P5  MY_JE( 4 , 5  )
+
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/read_nmm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/read_nmm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/read_nmm.F	(revision 2744)
@@ -0,0 +1,970 @@
+!WRF:MEDIATION_LAYER:
+!
+
+SUBROUTINE med_read_nmm ( grid , config_flags , ntsd, dt_from_file, tstart_from_file, tend_from_file &
+!
+#include <nmm_dummy_args.inc>
+!
+     )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+  ! Model layer
+   USE module_configure
+   USE module_bc_time_utilities
+!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+!----------------------------------------------------------------------
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+
+#include <nmm_dummy_decl.inc>
+
+!----------------------------------------------------------------------
+  ! Local
+
+   REAL, DIMENSION(1:2*NMM_MAX_DIM,2)           :: PDB
+   REAL, DIMENSION(1:2*NMM_MAX_DIM,grid%sd32:grid%ed32-1,2) :: TB,QB,UB,VB,Q2B,CWMB
+
+   INTEGER :: NUNIT_PARMETA=10,NUNIT_FCSTDATA=11                  &
+             ,NUNIT_NHB=12,NUNIT_CO2=14,NUNIT_Z0=22
+   INTEGER :: NMAP,NRADSH,NRADLH,NTDDMP
+   INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE
+   INTEGER :: IPS,IPE,JPS,JPE,KPS,KPE
+   INTEGER :: IMS,IME,JMS,JME,KMS,KME
+   INTEGER :: IM,JM,LM,NROOT,INPES,JNPES,NFCST,NUNIT_NBC,LISTB
+!!!INTEGER :: I,J,K,IHRST,JAM,NTSD,IHRSTB,IHH,IHL
+   INTEGER :: I,J,K,IHRST,JAM,IHRSTB,IHH,IHL
+   INTEGER :: KBI,KBI2,LRECBC
+   INTEGER :: N,ISTART,LB,NREC
+! Addition, JM 20050819
+! Rconfig variables no longer passed through dummy arg list or declared
+! in nmm_dummy_decl. Declare them local here.
+   INTEGER :: NSOIL,NPHS,NCNVC,IDTAD,SIGMA,NRADS,NRADL
+   REAL    :: DT
+! End addition, JM 20050819
+   INTEGER,DIMENSION(3) :: IDAT,IDATB
+   LOGICAL :: RESTRT,SINGLRST,NEST,RUN,RUNB
+   REAL :: TSTART,TEND,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC
+   REAL :: BCHR,TSTEPS,TSPH,TBOCO
+   REAL,DIMENSION(39) :: SPL
+   REAL,DIMENSION(99) :: TSHDE
+   REAL,ALLOCATABLE,DIMENSION(:) :: TEMP1
+   REAL,ALLOCATABLE,DIMENSION(:,:) :: TEMP
+   INTEGER,ALLOCATABLE,DIMENSION(:,:) :: ITEMP
+   REAL,ALLOCATABLE,DIMENSION(:,:,:) :: HOLD
+   REAL ::                      TDDAMP                     &
+                                            ,ETA
+   REAL :: PLQ,RDPQ,RDTHEQ,STHEQ,THE0Q
+   REAL :: ROS,CS,DS,ROI,CI,DI                             &
+          ,PL,THL,RDQ,RDTH,RDP,RDTHE                       &
+                ,QS0,SQS,STHE,THE0
+!!!tlb   REAL :: PTBL,TTBL                                       &
+   REAL :: WBD,SBD,TLM0D,TPH0D,R,        CMLD,DP30               &
+    ,X1P,Y1P,IXM,IYM
+   INTEGER :: NN, mype
+   REAL :: dt_from_file
+   REAL :: tstart_from_file, tend_from_file
+   real :: dtx
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+
+
+
+!**********************************************************************
+!
+!***  Temporary fix for reading in lookup tables
+!
+   INTEGER,PARAMETER :: ITB=76,JTB=134,ITBQ=152,JTBQ=440
+   REAL,DIMENSION(ITB,JTB) :: PTBL
+   REAL,DIMENSION(JTB,ITB) :: TTBL
+   REAL,DIMENSION(JTBQ,ITBQ) :: TTBLQ
+!**********************************************************************
+   CHARACTER*256 mess
+!----------------------------------------------------------------------
+! small file with global dimensions
+   NAMELIST /PARMNMM/ IM,JM,LM,NSOIL,NROOT,INPES,JNPES
+!
+! another small file with forecast parameters
+   NAMELIST /FCSTDATA/                                            &
+    TSTART,TEND,RESTRT,SINGLRST,NMAP,TSHDE,SPL                    &
+   ,NPHS,NCNVC,NRADSH,NRADLH,NTDDMP                               &
+   ,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC                           &
+   ,NEST,HYDRO
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+#include "deref_kludge.h"
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+#ifdef DM_PARALLEL
+#    include <nmm_data_calls.inc>
+#endif
+
+!
+   REWIND NUNIT_PARMETA
+   READ(NUNIT_PARMETA,PARMNMM)
+   NSOIL=4
+      write(0,*)' assigned nsoil=',nsoil
+   CALL wrf_debug ( 100 , 'nmm: read global dimensions file' )
+
+! temporarily produce array limits here
+!   IDS=1
+!   IDE=IM
+!   JDS=1
+!   JDE=JM
+!   KDS=1
+!   KDE=LM
+
+!----------------------------------------------------------------------
+  CALL get_ijk_from_grid (  grid ,                   &
+                            ids, ide, jds, jde, kds, kde,    &
+                            ims, ime, jms, jme, kms, kme,    &
+                            ips, ipe, jps, jpe, kps, kpe    )
+
+! GLOBAL GRID DIMS ARE WHAT WRF CONSIDERS UNSTAGGERED
+   ide = ide - 1
+   jde = jde - 1
+   kde = kde - 1
+   NSOIL=4
+
+   CALL wrf_debug(100,'in mediation_read_nmm')
+   WRITE(mess,*)'ids,ide,jds,jde,kds,kde ',ids,ide,jds,jde,kds,kde
+   CALL wrf_debug(100,mess)
+
+!----------------------------------------------------------------------
+! read constants file
+      write(0,*)' before allocates and nhb nsoil=',nsoil
+   ALLOCATE(TEMP1(1:NSOIL),STAT=I)
+   ALLOCATE(ITEMP(IDS:IDE,JDS:JDE),STAT=I)
+   ALLOCATE(TEMP(IDS:IDE,JDS:JDE),STAT=I)
+   ALLOCATE(HOLD(IDS:IDE,JDS:JDE,KDS:KDE),STAT=I)
+!
+!----------------------------------------------------------------------
+! read z0 file
+      READ(NUNIT_Z0)TEMP
+      DO J=JDS,JDE
+      DO I=IDS,IDE
+        Z0(I,J)=TEMP(I,J)
+      ENDDO
+      ENDDO
+!----------------------------------------------------------------------
+!
+   READ(NUNIT_NHB) NFCST,NUNIT_NBC,LISTB,DT,IDTAD,SIGMA
+      write(0,*)' read_nmm sigma=',sigma
+   dt_from_file = dt
+   WRITE( mess, * ) 'NFCST = ',NFCST,'  DT  = ',DT
+   WRITE( 0, * ) 'NFCST = ',NFCST,'  DT  = ',DT,' NHB=',NUNIT_NHB 
+   CALL wrf_debug(100, mess)
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) ITEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       LMH(I,J)=ITEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) ITEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       LMV(I,J)=ITEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       HBM2(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       HBM3(I,J)=0.
+     ENDDO
+   ENDDO
+!
+   DO J=JDS,JDE
+     IHWG(J)=MOD(J+1,2)-1
+     IF(J.GE.JDS+3.AND.J.LE.JDE-3)THEN
+       IHL=2-IHWG(J)
+!      IHWG=MOD(J+1,2)-1
+!      IHL=2-IHWG
+       IHL=2-IHWG(J)
+       IHH=IDE-2
+       DO I=IDS,IDE
+         IF(I.GE.IHL.AND.I.LE.IHH)HBM3(I,J)=1.
+       ENDDO
+     ENDIF
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       VBM2(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       VBM3(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       SM(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       SICE(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   DO K=KDE,KDS,-1
+     READ(NUNIT_NHB)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read HTM into HOLD' )
+   DO K=KDS,KDE
+     DO J=JDS,JDE
+       DO I=IDS,IDE
+         HTM(I,K,J)=HOLD(I,J,K)
+       ENDDO
+     ENDDO
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read of record' )
+!----------------------------------------------------------------------
+   DO K=KDE,KDS,-1
+     READ(NUNIT_NHB)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read VTM into HOLD' )
+   DO K=KDS,KDE
+     DO J=JDS,JDE
+       DO I=IDS,IDE
+         VTM(I,K,J)=HOLD(I,J,K)
+       ENDDO
+     ENDDO
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read VTM' )
+!----------------------------------------------------------------------
+   JAM=6+2*(JDE-JDS-9)
+   READ(NUNIT_NHB)DY_NMM,CPGFV,EN,ENT,R,PT,TDDAMP                 &
+                 ,F4D,F4Q,EF4T,PDTOP                              &
+                 ,(DETA(KME-K),K=KMS,KME-1)                       &
+                 ,(AETA(KME-K),K=KMS,KME-1)                       &
+                 ,(F4Q2(KME-K),K=KMS,KME-1)                       &
+                 ,(ETAX(KME+1-K),K=KMS,KME)                       &
+                 ,(DFL(KME+1-K),K=KMS,KME)                        &
+                 ,(DETA1(KME-K),K=KMS,KME-1)                      &
+                 ,(AETA1(KME-K),K=KMS,KME-1)                      &
+                 ,(ETA1(KME+1-K),K=KMS,KME)                       &
+                 ,(DETA2(KME-K),K=KMS,KME-1)                      &
+                 ,(AETA2(KME-K),K=KMS,KME-1)                      &
+                 ,(ETA2(KME+1-K),K=KMS,KME)                       &
+                 ,(EM(K),K=1,JAM)                                 &
+                 ,(EMT(K),K=1,JAM)
+   CALL wrf_debug ( 100 , 'nmm: read NMM_DX_NMM' )
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       DX_NMM(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read NMM_WPDAR' )
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       WPDAR(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read NMM_CPGFU' )
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       CPGFU(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read NMM_CURV' )
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       CURV(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read NMM_FCP' )
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       FCP(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   CALL wrf_debug ( 100 , 'nmm: read NMM_FDIV' )
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       FDIV(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   CALL wrf_debug ( 100 , 'nmm: read NMM_FAD' )
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       FAD(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read NMM_F' )
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       F(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read NMM_DDMPU' )
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       DDMPU(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read NMM_DDMPV' )
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       DDMPV(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read NMM_GLAT' )
+   READ(NUNIT_NHB) PT, TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       GLAT(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read NMM_GLON' )
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       GLON(I,J)=-TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read PLQ,RDPQ,RDTHEQ,STHEQ,THE0Q' )
+   READ(NUNIT_NHB)PLQ,RDPQ,RDTHEQ,STHEQ,THE0Q
+!                ,(STHEQ(K),K=1,ITBQ)                             &
+!                ,(THE0Q(K),K=1,ITBQ)
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read ROS,CS,DS,ROI,CI,DI' )
+   READ(NUNIT_NHB)ROS,CS,DS,ROI,CI,DI                             &
+           ,PL,THL,RDQ,RDTH,RDP,RDTHE                             &
+           ,(DETA(KME-K),K=KMS,KME-1)                             &
+           ,(AETA(KME-K),K=KMS,KME-1)                             &
+           ,(DFRLG(KME+1-K),K=KMS,KME)                            &
+           ,(DETA1(KME-K),K=KMS,KME-1)                            &
+           ,(AETA1(KME-K),K=KMS,KME-1)                            &
+           ,(DETA2(KME-K),K=KMS,KME-1)                            &
+           ,(AETA2(KME-K),K=KMS,KME-1)                            &
+           ,QS0,SQS,STHE,THE0
+!          ,(QS0(K),K=1,JTB)                                      &
+!          ,(SQS(K),K=1,JTB)                                      &
+!          ,(STHE(K),K=1,ITB)                                     &                
+!          ,(THE0(K),K=1,ITB)
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       MXSNAL(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       EPSR(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       TG(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       GFFC(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       SST(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       ALBASE(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       HDAC(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       HDACV(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+!!!tlb   READ(NUNIT_NHB) TEMP
+    READ(NUNIT_NHB) TTBLQ
+!   DO J=JDS,JDE
+!     DO I=IDS,IDE
+!       TTBLQ(I,J)=TEMP(I,J)
+!     ENDDO
+!   ENDDO
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read PTBL,TTBL' )
+        READ(NUNIT_NHB)PTBL,TTBL                                       &
+                ,R,PT,TSPH                                             &
+                ,WBD,SBD,TLM0D,TPH0D,DLMD,DPHD,CMLD,DP30               &
+                ,X1P,Y1P,IXM,IYM                                       &
+                ,(DETA(KME-K),K=KMS,KME-1)                             &
+                ,(AETA(KME-K),K=KMS,KME-1)                             &
+                ,(ETAX(KME+1-K),K=KMS,KME)                             &
+                ,(DETA1(KME-K),K=KMS,KME-1)                            &
+                ,(AETA1(KME-K),K=KMS,KME-1)                            &
+                ,(ETA1(KME+1-K),K=KMS,KME)                             &
+                ,(DETA2(KME-K),K=KMS,KME-1)                            &
+                ,(AETA2(KME-K),K=KMS,KME-1)                            &
+                ,(ETA2(KME+1-K),K=KMS,KME)                              
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) ITEMP
+    DO J=JDS,JDE
+      DO I=IDS,IDE
+        IVGTYP(I,J)=ITEMP(I,J)
+      ENDDO
+    ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) ITEMP
+    DO J=JDS,JDE
+      DO I=IDS,IDE
+        ISLTYP(I,J)=ITEMP(I,J)
+      ENDDO
+    ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) ITEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       ISLOPE(I,J)=ITEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       VEGFRC(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) (SLDPTH(N),N=1,NSOIL)
+!----------------------------------------------------------------------
+   READ(NUNIT_NHB) (RTDPTH(N),N=1,NSOIL)
+!----------------------------------------------------------------------
+   CALL wrf_debug ( 100 , 'nmm: read constants file' )
+
+   REWIND NUNIT_FCSTDATA
+   READ(NUNIT_FCSTDATA,FCSTDATA)
+   tstart_from_file = tstart
+   tend_from_file   = tend
+   CALL wrf_debug ( 100 , 'nmm: read forecast parameters file' )
+!----------------------------------------------------------------------
+
+   nrads = nint(nradsh*tsph)
+   nradl = nint(nradlh*tsph)
+!----------------------------------------------------------------------
+!
+! INITIAL CONDITIONS
+!
+!----------------------------------------------------------------------
+   REWIND NFCST
+   READ(NFCST)RUN,IDAT,IHRST,NTSD
+   IF(NTSD.EQ.1)NTSD=0
+!----------------------------------------------------------------------
+   READ(NFCST) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       PD(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NFCST) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       RES(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+!----------------------------------------------------------------------
+   READ(NFCST) TEMP
+   DO J=JDS,JDE
+     DO I=IDS,IDE
+       FIS(I,J)=TEMP(I,J)
+     ENDDO
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read FIS' )
+!----------------------------------------------------------------------
+   DO K=KDE,KDS,-1
+     READ(NFCST)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read U into HOLD' )
+   DO K=KDS,KDE
+     DO J=JDS,JDE
+       DO I=IDS,IDE
+         U(I,K,J)=HOLD(I,J,K)
+       ENDDO
+     ENDDO
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read U' )
+!----------------------------------------------------------------------
+   DO K=KDE,KDS,-1
+     READ(NFCST)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
+   ENDDO
+   DO K=KDS,KDE
+     DO J=JDS,JDE
+       DO I=IDS,IDE
+         V(I,K,J)=HOLD(I,J,K)
+       ENDDO
+     ENDDO
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read V' )
+!----------------------------------------------------------------------
+   DO K=KDE,KDS,-1
+     READ(NFCST)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
+   ENDDO
+   DO K=KDS,KDE
+     DO J=JDS,JDE
+       DO I=IDS,IDE
+         T(I,K,J)=HOLD(I,J,K)
+       ENDDO
+     ENDDO
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read T' )
+!----------------------------------------------------------------------
+   DO K=KDE,KDS,-1
+     READ(NFCST)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
+   ENDDO
+   DO K=KDS,KDE
+     DO J=JDS,JDE
+       DO I=IDS,IDE
+         Q(I,K,J)=HOLD(I,J,K)
+       ENDDO
+     ENDDO
+   ENDDO
+   CALL wrf_debug ( 100 , 'nmm: read Q' )
+!----------------------------------------------------------------------
+   READ(NFCST)((SI(I,J),I=IDS,IDE),J=JDS,JDE)
+   READ(NFCST)((SNO(I,J),I=IDS,IDE),J=JDS,JDE)
+!  READ(NFCST)(((SMC(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
+   READ(NFCST)(((hold(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
+      do k=1,nsoil
+        do j=jds,jde
+        do i=ids,ide
+          smc(i,k,j)=hold(i,j,k)
+        enddo
+        enddo
+      enddo
+   READ(NFCST)((CMC(I,J),I=IDS,IDE),J=JDS,JDE)
+!  READ(NFCST)(((STC(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
+   READ(NFCST)(((hold(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
+   do k=1,nsoil
+     do j=jds,jde
+     do i=ids,ide
+       stc(i,k,j)=hold(i,j,k)
+     enddo
+     enddo
+   enddo
+!  READ(NFCST)(((SH2O(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
+   READ(NFCST)(((hold(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
+   do k=1,nsoil
+     do j=jds,jde
+     do i=ids,ide
+       sh2o(i,k,j)=hold(i,j,k)
+!      sh2o(i,k,j)=0.05
+     enddo
+     enddo
+   enddo
+   CALL wrf_debug ( 100 , 'nmm: read initial conditions file' )
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!
+ENTRY med_read_nmm_bdy ( grid , config_flags , ntsd , dt_from_file, tstart_from_file, tend_from_file &
+!
+#include <nmm_dummy_args.inc>
+!
+     )
+!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+
+!----------------------------------------------------------------------
+!***  READ BOUNDARY CONDITIONS.
+!----------------------------------------------------------------------
+!
+      DT = dt_from_file
+  CALL get_ijk_from_grid (  grid ,                   &
+                            ids, ide, jds, jde, kds, kde,    &
+                            ims, ime, jms, jme, kms, kme,    &
+                            ips, ipe, jps, jpe, kps, kpe    )
+
+! GLOBAL GRID DIMS ARE WHAT WRF CONSIDERS UNSTAGGERED
+   ide = ide - 1
+   jde = jde - 1
+   kde = kde - 1
+   NSOIL=4
+
+   CALL wrf_debug(100,'in mediation_read_nmm')
+   WRITE(mess,*)'ids,ide,jds,jde,kds,kde ',ids,ide,jds,jde,kds,kde
+   CALL wrf_debug(100,mess)
+
+      mype = 0
+      IF(MYPE.EQ.0)THEN
+        IF(NEST)THEN
+          KBI=2*IM+JM-3
+          KBI2=KBI-4
+#ifdef DEC_ALPHA
+          LRECBC=(1+(1+6*LM)*KBI*2+(KBI+KBI2)*(LM+1))
+#else
+          LRECBC=4*(1+(1+6*LM)*KBI*2+(KBI+KBI2)*(LM+1))
+#endif
+          OPEN(UNIT=NUNIT_NBC,ACCESS='DIRECT',RECL=LRECBC)
+          read(nunit_nbc,rec=2) bchr
+        ENDIF
+!
+        IF(.NOT.NEST)REWIND NUNIT_NBC
+!
+#ifdef DP_REAL
+        IF(NEST)THEN
+          READ(NUNIT_NBC,REC=1)RUNBX,IDATBX,IHRSTBX,TBOCO
+        ELSE
+          READ(NUNIT_NBC)RUNBX,IDATBX,IHRSTBX,TBOCO
+        ENDIF
+!
+        RUNB=RUNBX
+        IDATB=IDATBX
+        IHRSTB=IHRSTBX
+#else
+        IF(NEST)THEN
+          READ(NUNIT_NBC,REC=1)RUNB,IDATB,IHRSTB,TBOCO
+        ELSE
+          READ(NUNIT_NBC)RUNB,IDATB,IHRSTB,TBOCO
+        ENDIF
+#endif
+      ENDIF
+!
+!      CALL MPI_BCAST(RUNB,1,MPI_LOGICAL,0,MPI_COMM_COMP,IRTN)
+!      CALL MPI_BCAST(IDATB,3,MPI_INTEGER,0,MPI_COMM_COMP,IRTN)
+!      CALL MPI_BCAST(IHRSTB,1,MPI_INTEGER,0,MPI_COMM_COMP,IRTN)
+!      CALL MPI_BCAST(TBOCO,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
+!
+!      CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
+!
+      ISTART=NINT(TSTART)
+      LB=2*(IDE-IDS+1)+(JDE-JDS+1)-3
+!
+
+      IF(MYPE.EQ.0.AND..NOT.NEST)THEN
+!
+        READ(NUNIT_NBC)BCHR
+  205   READ(NUNIT_NBC)((PDB(N,I),N=1,LB),I=1,2)
+        READ(NUNIT_NBC)(((TB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
+        READ(NUNIT_NBC)(((QB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
+        READ(NUNIT_NBC)(((UB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
+        READ(NUNIT_NBC)(((VB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
+        READ(NUNIT_NBC)(((Q2B(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
+        READ(NUNIT_NBC)(((CWMB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
+!
+        IF(ISTART.EQ.NINT(BCHR))THEN
+          IF(ISTART.GT.0)READ(NUNIT_NBC)BCHR
+          GO TO 215
+        ELSE
+          READ(NUNIT_NBC)BCHR
+        ENDIF
+!
+      write(0,*)' read_nmm istart=',istart,' bchr=',bchr,' tsph=',tsph
+        IF(ISTART.GE.NINT(BCHR))THEN
+          GO TO 205
+        ELSEIF(ISTART.LT.NINT(BCHR))THEN
+          TSTEPS=ISTART*TSPH
+!
+          DO N=1,LB
+      if(n==5.or.n==6)then
+        write(0,*)' read_nmm i=',i,' pdb(1)=',pdb(n,1),' pdb(2)=',pdb(n,2),' dt=',dt,' tsteps=',tsteps
+      endif
+            PDB(N,1)=PDB(N,1)+PDB(N,2)*DT*TSTEPS
+          ENDDO
+!
+          DO K=1,LM
+          DO N=1,LB
+            TB(N,K,1)=TB(N,K,1)+TB(N,K,2)*DT*TSTEPS
+            QB(N,K,1)=QB(N,K,1)+QB(N,K,2)*DT*TSTEPS
+            UB(N,K,1)=UB(N,K,1)+UB(N,K,2)*DT*TSTEPS
+            VB(N,K,1)=VB(N,K,1)+VB(N,K,2)*DT*TSTEPS
+            Q2B(N,K,1)=Q2B(N,K,1)+Q2B(N,K,2)*DT*TSTEPS
+            CWMB(N,K,1)=CWMB(N,K,1)+CWMB(N,K,2)*DT*TSTEPS
+          ENDDO
+          ENDDO
+          GO TO 215
+        ENDIF
+      ENDIF
+!
+      IF(MYPE.EQ.0.AND.NEST)THEN
+        NREC=1
+!
+  210   NREC=NREC+1
+        READ(NUNIT_NBC,REC=NREC)BCHR
+!
+        IF(ISTART.EQ.NINT(BCHR))THEN
+!!!!!     IF(ISTART.GT.0)READ(NUNIT_NBC,REC=NREC+1)BCHR
+          GO TO 215
+        ELSE
+          GO TO 210
+        ENDIF
+      ENDIF
+!
+  215 CONTINUE
+
+      IF(NTSD.EQ.0)THEN
+        IF(MYPE.EQ.0.AND..NOT.NEST.AND.ISTART.GE.NINT(BCHR))THEN
+          BACKSPACE NUNIT_NBC
+          BACKSPACE NUNIT_NBC
+          BACKSPACE NUNIT_NBC
+          BACKSPACE NUNIT_NBC
+          BACKSPACE NUNIT_NBC
+          BACKSPACE NUNIT_NBC
+          BACKSPACE NUNIT_NBC
+!          WRITE(LIST,*)'  BACKSPACE UNIT NBC=',NUNIT_NBC
+        ENDIF
+      ENDIF
+
+      IF(MYPE.EQ.0.AND.NEST)THEN
+          NREC=NINT(((NTSD-1)*DT)/3600.)+2
+          READ(NUNIT_NBC,REC=NREC)BCHR                                  &
+                         ,((PDB(N,NN),N=1,LB),NN=1,2)                  &
+                         ,(((TB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2)   &
+                         ,(((QB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2)   &
+                         ,(((UB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2)   &
+                         ,(((VB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2)   &
+                        ,(((Q2B(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2)   &
+                       ,(((CWMB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2)
+      ENDIF
+
+! Copy the bounary into the WRF framework boundary data structs
+
+      N=1
+!
+!***  SOUTH BOUNDARY
+!
+      DO I=1,IDE
+        PD_B(I,1,1,P_YSB) = PDB(N,1)
+        PD_BT(I,1,1,P_YSB) = PDB(N,2)
+        N=N+1
+      ENDDO
+!
+!***  NORTH BOUNDARY
+!
+      DO I=1,IDE
+        PD_B(I,1,1,P_YEB) = PDB(N,1)
+        PD_BT(I,1,1,P_YEB) = PDB(N,2)
+        N=N+1
+      ENDDO
+!
+!***  WEST BOUNDARY
+!
+      DO J=3,JDE-2,2
+        PD_B(J,1,1,P_XSB) = PDB(N,1)
+        PD_BT(J,1,1,P_XSB) = PDB(N,2)
+        N=N+1
+      ENDDO
+!
+!***  EAST BOUNDARY
+!
+      DO J=3,JDE-2,2
+        PD_B(J,1,1,P_XEB) = PDB(N,1)
+        PD_BT(J,1,1,P_XEB) = PDB(N,2)
+        N=N+1
+      ENDDO
+!
+      DO K=KDS,KDE
+        N=1
+!
+!***  SOUTH BOUNDARY
+!
+        DO I=1,IDE
+          T_B(I,k,1,P_YSB) = TB(N,k,1)
+          T_BT(I,k,1,P_YSB) = TB(N,k,2)
+          Q_B(I,k,1,P_YSB) = QB(N,k,1)
+          Q_BT(I,k,1,P_YSB) = QB(N,k,2)
+          Q2_B(I,k,1,P_YSB) = Q2B(N,k,1)
+          Q2_BT(I,k,1,P_YSB) = Q2B(N,k,2)
+          CWM_B(I,k,1,P_YSB) = CWMB(N,k,1)
+          CWM_BT(I,k,1,P_YSB) = CWMB(N,k,2)
+          N=N+1
+        ENDDO
+!
+!***  NORTH BOUNDARY
+!
+        DO I=1,IDE
+          T_B(I,k,1,P_YEB) = TB(N,k,1)
+          T_BT(I,k,1,P_YEB) = TB(N,k,2)
+          Q_B(I,k,1,P_YEB) = QB(N,k,1)
+          Q_BT(I,k,1,P_YEB) = QB(N,k,2)
+          Q2_B(I,k,1,P_YEB) = Q2B(N,k,1)
+          Q2_BT(I,k,1,P_YEB) = Q2B(N,k,2)
+          CWM_B(I,k,1,P_YEB) = CWMB(N,k,1)
+          CWM_BT(I,k,1,P_YEB) = CWMB(N,k,2)
+          N=N+1
+        ENDDO
+!
+!***  WEST BOUNDARY
+!
+        DO J=3,JDE-2,2
+          T_B(J,k,1,P_XSB) = TB(N,k,1)
+          T_BT(J,k,1,P_XSB) = TB(N,k,2)
+          Q_B(J,k,1,P_XSB) = QB(N,k,1)
+          Q_BT(J,k,1,P_XSB) = QB(N,k,2)
+          Q2_B(J,k,1,P_XSB) = Q2B(N,k,1)
+          Q2_BT(J,k,1,P_XSB) = Q2B(N,k,2)
+          CWM_B(J,k,1,P_XSB) = CWMB(N,k,1)
+          CWM_BT(J,k,1,P_XSB) = CWMB(N,k,2)
+          N=N+1
+        ENDDO
+!
+!***  EAST BOUNDARY
+!
+        DO J=3,JDE-2,2
+          T_B(J,k,1,P_XEB) = TB(N,k,1)
+          T_BT(J,k,1,P_XEB) = TB(N,k,2)
+      if(k.eq.1.and.j.eq.79)then
+        write(0,62510)ntsd,nrec
+        write(0,62511)p_xeb,t_b(j,k,1,p_xeb),t_bt(j,k,1,p_xeb)
+62510   format(' ntsd=',i5,' nrec=',i5)
+62511   format(' p_xeb=',i2,' t_b=',z8,' t_bt=',z8)
+      endif
+          Q_B(J,k,1,P_XEB) = QB(N,k,1)
+          Q_BT(J,k,1,P_XEB) = QB(N,k,2)
+          Q2_B(J,k,1,P_XEB) = Q2B(N,k,1)
+          Q2_BT(J,k,1,P_XEB) = Q2B(N,k,2)
+          CWM_B(J,k,1,P_XEB) = CWMB(N,k,1)
+          CWM_BT(J,k,1,P_XEB) = CWMB(N,k,2)
+          N=N+1
+        ENDDO
+      ENDDO
+
+      DO K=KDS,KDE
+        N=1
+!
+!***  SOUTH BOUNDARY
+!
+        DO I=1,IDE-1
+          U_B(I,k,1,P_YSB) = UB(N,k,1)
+          U_BT(I,k,1,P_YSB) = UB(N,k,2)
+          V_B(I,k,1,P_YSB) = VB(N,k,1)
+          V_BT(I,k,1,P_YSB) = VB(N,k,2)
+          N=N+1
+        ENDDO
+!
+!***  NORTH BOUNDARY
+!
+        DO I=1,IDE-1
+          U_B(I,k,1,P_YEB) = UB(N,k,1)
+          U_BT(I,k,1,P_YEB) = UB(N,k,2)
+          V_B(I,k,1,P_YEB) = VB(N,k,1)
+          V_BT(I,k,1,P_YEB) = VB(N,k,2)
+          N=N+1
+        ENDDO
+!
+!***  WEST BOUNDARY
+!
+        DO J=2,JDE-1,2
+          U_B(J,k,1,P_XSB) = UB(N,k,1)
+          U_BT(J,k,1,P_XSB) = UB(N,k,2)
+          V_B(J,k,1,P_XSB) = VB(N,k,1)
+          V_BT(J,k,1,P_XSB) = VB(N,k,2)
+          N=N+1
+        ENDDO
+!
+!***  EAST BOUNDARY
+!
+        DO J=2,JDE-1,2
+          U_B(J,k,1,P_XEB) = UB(N,k,1)
+          U_BT(J,k,1,P_XEB) = UB(N,k,2)
+          V_B(J,k,1,P_XEB) = VB(N,k,1)
+          V_BT(J,k,1,P_XEB) = VB(N,k,2)
+          N=N+1
+        ENDDO
+      ENDDO
+
+!
+!      CALL MPI_BCAST(BCHR,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
+!
+!      CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
+!
+!      IF(MYPE.EQ.0)WRITE(LIST,*)'  READ UNIT NBC=',NUNIT_NBC
+!
+!***
+!***  COMPUTE THE 1ST TIME FOR BOUNDARY CONDITION READ
+!***
+!
+!      NBOCO=NINT(BCHR*TSPH)
+!
+
+!
+
+   DEALLOCATE(TEMP1,STAT=I)
+   DEALLOCATE(ITEMP,STAT=I)
+   DEALLOCATE(TEMP,STAT=I)
+   DEALLOCATE(HOLD,STAT=I)
+
+      CALL wrf_debug ( 100 , 'nmm: returnomatic' )
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+
+   RETURN
+END SUBROUTINE med_read_nmm
+
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/solve_nmm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/solve_nmm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/solve_nmm.F	(revision 2744)
@@ -0,0 +1,2175 @@
+!-----------------------------------------------------------------------
+!
+!NCEP_MESO:MEDIATION_LAYER:SOLVER
+!
+!-----------------------------------------------------------------------
+#include "nmm_loop_basemacros.h"
+#include "nmm_loop_macros.h"
+!-----------------------------------------------------------------------
+!
+      SUBROUTINE SOLVE_NMM(GRID,CONFIG_FLAGS                           &
+!
+#include "nmm_dummy_args.inc"
+!
+     &           )
+!-----------------------------------------------------------------------
+      USE MODULE_DOMAIN
+      USE MODULE_CONFIGURE
+      USE MODULE_MODEL_CONSTANTS
+      USE MODULE_STATE_DESCRIPTION
+      USE MODULE_CTLBLK
+      USE MODULE_DM
+      USE MODULE_IGWAVE_ADJUST,		ONLY: PDTE,PFDHT,DDAMP,VTOA
+      USE MODULE_ADVECTION,		ONLY: ADVE,VAD2,HAD2,VAD2_SCAL,HAD2_SCAL
+      USE MODULE_NONHY_DYNAM,		ONLY: EPS,VADZ,HADZ
+      USE MODULE_DIFFUSION_NMM, 	ONLY: HDIFF
+      USE MODULE_BNDRY_COND,		ONLY: BOCOH,BOCOV
+      USE MODULE_PHYSICS_CALLS
+      USE MODULE_EXT_INTERNAL
+      USE MODULE_PRECIP_ADJUST
+      USE MODULE_NEST_UTIL
+!-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+      INCLUDE "mpif.h"
+!-----------------------------------------------------------------------
+!
+!***  INPUT DATA
+!
+!-----------------------------------------------------------------------
+!
+      TYPE(DOMAIN),TARGET :: GRID
+!
+!***  DEFINITIONS OF DUMMY ARGUMENTS TO THIS ROUTINE (GENERATED FROM REGISTRY)
+!
+! NOTE, REGISTRY NO LONGER GENERATES DUMMY ARGUMENTS OR DUMMY ARGUMENT
+! DECLARATIONS FOR RCONFIG ENTRIES. THEY ARE STILL PART OF STATE. ACCESS
+! TO THESE VARIABLES IS NOW THROUGH GRID STRUCTURE, AS MODIFIED BELOW.
+! AFFECTED VARIABLES: SIGMA, DT, NPHS, IDTAD, NRADS, NRADL, JULDAY,
+! JULYR, NUM_SOIL_LAYERS, NCNVC, ENSDIM, DY, AND SPEC_BDY_WIDTH.
+! JM, 20050819
+!
+!----------------------------
+#include <nmm_dummy_decl.inc>
+!----------------------------
+!
+!***  STRUCTURE THAT CONTAINS RUN-TIME CONFIGURATION (NAMELIST) DATA FOR DOMAIN
+!
+      TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
+!
+!-----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+!-----------------------------------------------------------------------
+      INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE                                &
+     &          ,IMS,IME,JMS,JME,KMS,KME                                & 
+     &          ,IPS,IPE,JPS,JPE,KPS,KPE                                &
+     &          ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER :: I,ICLTEND,IDF,IJDE,IJDS,IRTN,J,JC,JDF,K,KDF,LB,N_MOIST &
+     &          ,NTSD_current
+      INTEGER,SAVE :: NTSD_restart
+!dusan      INTEGER :: MPI_COMM_COMP,MYPE,MYPROC,NPES
+      INTEGER :: MYPROC
+      INTEGER :: KVH,NTSD_rad,RC
+      REAL :: WC, QI, QR, QW, FICE, FRAIN
+      INTEGER :: NUM_OZMIXM,NUM_AEROSOLC
+!
+      CHARACTER*80 :: MESSAGE
+!
+!  For precip assimilation:
+      INTEGER :: ISTAT
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: PPTDAT
+
+!  For physics compatibility with other packages
+      REAL,ALLOCATABLE,DIMENSION(:,:,:) :: TTEN,QTEN
+      REAL,ALLOCATABLE,DIMENSION(:,:,:) :: RTHRATEN,RTHBLTEN,RQVBLTEN
+!
+      REAL :: DT_INV,GPS
+!
+      LOGICAL :: LAST_TIME
+!
+      LOGICAL wrf_dm_on_monitor
+      EXTERNAL wrf_dm_on_monitor
+!
+!-----------------------------------------------------------------------
+!***  TIMING VARIABLES
+!-----------------------------------------------------------------------
+      real,save :: solve_tim,exch_tim,pdte_tim,adve_tim,vtoa_tim        &
+     &,            vadz_tim,hadz_tim,eps_tim,vad2_tim,had2_tim          &
+     &,            radiation_tim,rdtemp_tim,turbl_tim,cltend_tim        &
+     &,            cucnvc_tim,gsmdrive_tim,hdiff_tim,bocoh_tim          &
+     &,            pfdht_tim,ddamp_tim,bocov_tim,uv_htov_tim,sum_tim    &
+     &,            adjppt_tim
+      real,save :: exch_tim_max
+      real :: btim,btimx
+      real :: et_max,this_tim
+      integer :: n_print_time
+!
+#ifdef RSL
+      integer rsl_internal_milliclock
+      external rsl_internal_milliclock
+# define timef rsl_internal_milliclock
+#else
+      real*8 :: timef
+#endif
+!-----------------------------------------------------------------------
+!
+#ifdef DEREF_KLUDGE
+! SEE http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+      INTEGER :: SM31,EM31,SM32,EM32,SM33,EM33 
+      INTEGER :: SM31X,EM31X,SM32X,EM32X,SM33X,EM33X
+      INTEGER :: SM31Y,EM31Y,SM32Y,EM32Y,SM33Y,EM33Y
+#endif
+!
+!-----------------------------------------------------------------------
+!
+! LIMIT THE NUMBER OF ARGUMENTS IF COMPILED WITH -DLIMIT_ARGS BY COPYING
+! SCALAR (NON-ARRAY) ARGUMENTS OUT OF THE GRID DATA STRUCTURE INTO LOCALLY
+! DEFINED COPIES (DEFINED IN EM_DUMMY_DECL.INC, ABOVE, AS THEY ARE IF THEY
+! ARE ARGUMENTS).  AN EQUIVALENT INCLUDE OF EM_SCALAR_DEREFS.INC APPEARS
+! AT THE END OF THE ROUTINE TO COPY BACK ANY CHNAGED NON-ARRAY VALUES.
+! THE DEFINITION OF COPY_IN OR COPY_OUT BEFORE THE INCLUDE DEFINES THE
+! DIRECTION OF THE COPY.  NMM_SCALAR_DEREFS IS GENERATED FROM REGISTRY.
+!
+!-----------------------------------------------------------------------
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+!-----------------------------------------------------------------------
+!
+! TRICK PROBLEMATIC COMPILERS INTO NOT PERFORMING COPY-IN/COPY-OUT BY ADDING
+! INDICES TO ARRAY ARGUMENTS IN THE CALL STATEMENTS IN THIS ROUTINE.
+! IT HAS THE EFFECT OF PASSING ONLY THE FIRST ELEMENT OF THE ARRAY, RATHER
+! THAN THE ENTIRE ARRAY.  SEE:
+! http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+!
+!-----------------------------------------------------------------------
+#include "deref_kludge.h"
+!-----------------------------------------------------------------------
+!
+! NEEDED BY SOME COMM LAYERS, E.G. RSL.  IF NEEDED, nmm_data_calls.inc IS
+! GENERATED FROM THE REGISTRY.  THE DEFINITION OF REGISTER_I1 ALLOWS
+! I1 DATA TO BE COMMUNICATED IN THIS ROUTINE IF NECESSARY.
+!
+!-----------------------------------------------------------------------
+#ifdef DM_PARALLEL
+#    define REGISTER_I1
+#    include <nmm_data_calls.inc>
+#endif
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+      CALL WRF_GET_MYPROC(MYPROC)
+      MYPE=MYPROC
+!-----------------------------------------------------------------------
+!
+!***  OBTAIN DIMENSION INFORMATION STORED IN THE GRID DATA STRUCTURE.
+!
+      CALL GET_IJK_FROM_GRID(GRID                                       &
+     &                      ,IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                      ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                      ,IPS,IPE,JPS,JPE,KPS,KPE )
+!-----------------------------------------------------------------------
+!
+!***  COMPUTE THESE STARTING AND STOPPING LOCATIONS FOR EACH TILE AND
+!***  NUMBER OF TILES.
+!***  SEE: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
+!
+      CALL SET_TILES(GRID,IDS,IDE,JDS,JDE,IPS,IPE,JPS,JPE)
+!-----------------------------------------------------------------------
+!
+!***  TTEN, QTEN are used by GD convection scheme
+!
+      ALLOCATE(TTEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
+      ALLOCATE(QTEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
+      ALLOCATE(RTHBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
+      ALLOCATE(RQVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
+      ALLOCATE(RTHRATEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
+!
+      DO J=JMS,JME
+      DO K=KMS,KME
+      DO I=IMS,IME
+        TTEN(I,K,J)=T(I,K,J)
+        QTEN(I,K,J)=Q(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      GRID%SIGMA=1 
+      HYDRO=.FALSE.
+!
+      IJDS=MIN(IDS,JDS)
+      IJDE=MAX(IDE,JDE)
+!
+      IDF=IDE-1
+      JDF=JDE-1
+      KDF=KDE-1
+!
+!-----------------------------------------------------------------------
+!
+!***  FOR NOW SET CONTROLS FOR TILES TO PATCHES
+!
+!-----------------------------------------------------------------------
+      ITS=IPS
+      ITE=MIN(IPE,IDF)
+      JTS=JPS
+      JTE=MIN(JPE,JDF)
+      KTS=KPS
+      KTE=MIN(KPE,KDF)
+      if(ntsd==0)then
+        write(0,*)' its=',its,' ite=',ite
+        write(0,*)' jts=',jts,' jte=',jte
+        write(0,*)' kts=',kts,' kte=',kte
+      endif
+!-----------------------------------------------------------------------
+!***  SET TIMING VARIABLES TO ZERO AT START OF FORECAST.
+!-----------------------------------------------------------------------
+      if(ntsd==0)then
+        solve_tim=0.
+        exch_tim=0.
+        pdte_tim=0.
+        adve_tim=0.
+        vtoa_tim=0.
+        vadz_tim=0.
+        hadz_tim=0.
+        eps_tim=0.
+        vad2_tim=0.
+        had2_tim=0.
+        radiation_tim=0.
+        rdtemp_tim=0.
+        turbl_tim=0.
+        cltend_tim=0.
+        cucnvc_tim=0.
+        gsmdrive_tim=0.
+        hdiff_tim=0.
+        bocoh_tim=0.
+        pfdht_tim=0.
+        ddamp_tim=0.
+        bocov_tim=0.
+        uv_htov_tim=0.
+        exch_tim_max=0.
+        adjppt_tim=0.
+      endif
+!-----------------------------------------------------------------------
+      N_MOIST=NUM_MOIST
+!
+      DO J=MYJS_P4,MYJE_P4
+        IHEG(J)=MOD(J+1,2)
+        IHWG(J)=IHEG(J)-1
+        IVEG(J)=MOD(J,2)
+        IVWG(J)=IVEG(J)-1
+      ENDDO
+
+      DO J=MYJS_P4,MYJE_P4
+        IVW(J)=IVWG(J)
+        IVE(J)=IVEG(J)
+        IHE(J)=IHEG(J)
+        IHW(J)=IHWG(J)
+      ENDDO
+!
+!***  LATERAL POINTS IN THE BOUNDARY ARRAYS
+!
+      LB=2*(IDF-IDS+1)+(JDF-JDS+1)-3
+!
+!***  APPROXIMATE GRIDPOINT SPACING (METERS)
+!
+      JC=JMS+(JME-JMS)/2
+      GPS=SQRT(DX_NMM(IMS,JC)**2+DY_NMM**2)
+!
+!***  TIMESTEPS PER HOUR
+!
+      TSPH=3600./GRID%DT
+!
+      n_print_time=nint(3600./grid%dt)   ! Print stats once per hour
+!-----------------------------------------------------------------------
+!
+      NBOCO=0
+!-----------------------------------------------------------------------
+!***
+!***               THE MAIN TIME INTEGRATION LOOP
+!***
+!-----------------------------------------------------------------------
+!
+!***  NTSD IS THE TIMESTEP COUNTER (Number of Time Steps Done)
+!
+!-----------------------------------------------------------------------
+!***
+!***  ADVANCE_count STARTS AT ZERO FOR ALL RUNS (REGULAR AND RESTART).
+!***
+!-----------------------------------------------------------------------
+!
+      CALL DOMAIN_CLOCK_GET(GRID,ADVANCEcOUNT=NTSD_current)
+!
+      IF(NTSD_current==0)THEN
+        IF(GRID%RESTART.AND.GRID%TSTART>0.)THEN
+          IHRST=NSTART_HOUR
+          NTSD_restart=NTSD+1
+        ELSE
+          IHRST=GRID%GMT
+          NSTART_HOUR=IHRST
+          NTSD_restart=0
+        ENDIF
+      ENDIF
+!
+      NTSD=NTSD_restart+NTSD_current
+      LAST_TIME=domain_last_time_step(GRID)
+!
+!-----------------------------------------------------------------------
+!
+      IF(WRF_DM_ON_MONITOR() )THEN
+        WRITE(MESSAGE,125)NTSD,NTSD*GRID%DT/3600.
+  125   FORMAT(' SOLVE_NMM: TIMESTEP IS ',I5,'   TIME IS ',F7.3,' HOURS')
+        CALL WRF_MESSAGE(TRIM(MESSAGE))
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+      CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
+      CALL WRF_GET_NPROC(NPES)
+!
+#if (NMM_NEST == 1)
+!-----------------------------------------------------------------------------
+!***  PATCHING NESTED BOUNDARIES.
+!-----------------------------------------------------------------------------
+!
+      CALL wrf_debug ( 100 , 'nmm: in patch' )
+
+      btimx=timef()
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_ZZ.inc"
+#endif
+
+      IF(GRID%ID/=1)THEN
+!
+        CALL NESTBC_PATCH (PD_B,T_B,Q_B,U_B,V_B,Q2_B,CWM_B                                    &
+                          ,PD_BT,T_BT,Q_BT,U_BT,V_BT,Q2_BT,CWM_BT                             &
+                          ,PDNEST_B,TNEST_B,QNEST_B,UNEST_B,VNEST_B,Q2NEST_B,CWMNEST_B        &
+                          ,PDNEST_BT,TNEST_BT,QNEST_BT,UNEST_BT,VNEST_BT,Q2NEST_BT,CWMNEST_BT &
+                          ,IJDS,IJDE,GRID%SPEC_BDY_WIDTH                                      &
+                          ,IDS,IDF,JDS,JDF,KDS,KDE                                            &
+                          ,IMS,IME,JMS,JME,KMS,KME                                            &
+                          ,ITS,ITE,JTS,JTE,KTS,KTE                                            )
+        CALL wrf_debug ( 100 , 'nmm: out of patch' )
+!
+#ifdef MOVE_NESTS
+
+        IF(GRID%ID/=1.AND.MOD(NTSD,1)==0.AND.GRID%NUM_MOVES==-99)THEN
+          XLOC_1=(IDE-1)/2     ! This maneuvers the storm to the center of the nest quickly
+          YLOC_1=(JDE-1)/2     ! This maneuvers the storm to the center of the nest quickly
+        ENDIF
+#endif
+
+      ENDIF
+#endif
+!
+!-----------------------------------------------------------------------
+!***  ALLOCATE PPTDAT ARRAY (PRECIP ASSIM):
+!-----------------------------------------------------------------------
+!
+      IF(GRID%PCPFLG.AND..NOT.ALLOCATED(PPTDAT))THEN
+        ALLOCATE(PPTDAT(IMS:IME,JMS:JME,3),STAT=ISTAT)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***
+!***      Call READPCP to
+!***            1) READ IN PRECIPITATION FOR HOURS 1, 2 and 3;
+!***            2) Initialize DDATA to 999. (this is the amount
+!***               of input precip allocated to each physics time step
+!***               in ADJPPT; TURBL/SURFCE, which uses DDATA, is called
+!***               before ADJPPT)
+!***            3) Initialize LSPA to zero
+!***
+!-----------------------------------------------------------------------
+      IF (NTSD==0) THEN
+        IF (GRID%PCPFLG) THEN
+          CALL READPCP(PPTDAT,DDATA,LSPA                                &
+     &      ,IDS,IDE,JDS,JDE,KDS,KDE                                    &
+     &      ,IMS,IME,JMS,JME,KMS,KME                                    &
+     &      ,ITS,ITE,JTS,JTE,KTS,KTE)
+        ENDIF
+      ENDIF
+!-----------------------------------------------------------------------
+!
+      btim=timef()
+!
+!-----------------------------------------------------------------------
+!***  ZERO OUT ACCUMULATED QUANTITIES WHEN NEEDED.
+!-----------------------------------------------------------------------
+!
+      CALL BUCKETS(NTSD,NPREC,NSRFC,NRDSW,NRDLW                         &
+     &            ,GRID%RESTART,GRID%TSTART                             &
+     &            ,NCLOD,NHEAT,GRID%NPHS,TSPH                           &
+     &            ,ACPREC,CUPREC,ACSNOW,ACSNOM,SSROFF,BGROFF            &
+     &            ,SFCEVP,POTEVP,SFCSHX,SFCLHX,SUBSHX,SNOPCX            &
+     &            ,SFCUVX,POTFLX                                        &
+     &            ,ARDSW,ASWIN,ASWOUT,ASWTOA                            &
+     &            ,ARDLW,ALWIN,ALWOUT,ALWTOA                            &
+     &            ,ACFRST,NCFRST,ACFRCV,NCFRCV                          &
+     &            ,AVCNVC,AVRAIN,TCUCN,TRAIN                            &
+     &            ,ASRFC                                                &
+     &            ,T,TLMAX,TLMIN                                        &
+     &            ,IDS,IDE,JDS,JDE,KDS,KDE                              &
+     &            ,IMS,IME,JMS,JME,KMS,KME                              &
+     &            ,ITS,ITE,JTS,JTE,KTS,KTE)
+!-----------------------------------------------------------------------
+!
+      IF(NTSD==0)THEN
+        FIRST=.TRUE.
+!       call hpm_init()
+        btimx=timef()
+!
+!-----------------------------------------------------------------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_A.inc"
+#endif
+!
+#ifdef DM_PARALLEL
+      IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW)THEN
+#    include "HALO_NMM_A_3.inc"
+      ENDIF
+#endif
+!
+!***  Only for chemistry:
+!
+#ifdef WRF_CHEM   
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_A_2.inc"
+#endif
+#endif
+!
+!-----------------------------------------------------------------------
+!***  USE THE FOLLOWING VARIABLES TO KEEP TRACK OF EXCHANGE TIMES.
+!-----------------------------------------------------------------------
+        exch_tim=exch_tim+timef()-btimx
+!       this_tim=timef()-btimx
+!       call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max           &
+!    &                    ,mpi_comm_comp,irtn)
+!       exch_tim_max=exch_tim_max+et_max
+!-----------------------------------------------------------------------
+!
+        GO TO 2003
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ 2000 CONTINUE
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!***  PRESSURE TENDENCY, SIGMA DOT, VERTICAL PART OF OMEGA-ALPHA
+!-----------------------------------------------------------------------
+!
+      btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_D.inc"
+#endif
+!-----------------
+      exch_tim=exch_tim+timef()-btimx
+!     this_tim=timef()-btimx
+!     call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max             &
+!    &                  ,mpi_comm_comp,irtn)
+!     exch_tim_max=exch_tim_max+et_max
+!
+      btimx=timef()
+!
+      CALL PDTE(                                                        &
+#ifdef DM_PARALLEL
+     &            GRID,                                                 &
+#endif
+     &            NTSD,GRID%DT,PT,ETA2,RES,HYDRO                        &
+     &           ,HTM,HBM2                                              &
+     &           ,PD,PDSL,PDSLO                                         &
+     &           ,PETDT,DIV,PSDT                                        &
+     &           ,IHE,IHW,IVE,IVW,INDX3_WRK                             &
+     &           ,IDS,IDF,JDS,JDF,KDS,KDE                               &
+     &           ,IMS,IME,JMS,JME,KMS,KME                               &
+     &           ,ITS,ITE,JTS,JTE,KTS,KTE)
+
+      pdte_tim=pdte_tim+timef()-btimx
+!
+!-----------------------------------------------------------------------
+!***  ADVECTION OF T, U, AND V
+!-----------------------------------------------------------------------
+!
+      btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_F.inc"
+#    include "HALO_NMM_F1.inc"
+#endif
+!-----------------
+      exch_tim=exch_tim+timef()-btimx
+!     this_tim=timef()-btimx
+!     call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max             &
+!    &                  ,mpi_comm_comp,irtn)
+!     exch_tim_max=exch_tim_max+et_max
+!
+      btimx=timef()
+!
+      CALL ADVE(NTSD,GRID%DT,DETA1,DETA2,PDTOP                          &
+     &         ,CURV,F,FAD,F4D,EM_LOC,EMT_LOC,EN,ENT,DX_NMM,DY_NMM      &
+     &         ,HTM,HBM2,VTM,VBM2,LMH,LMV                               &
+     &         ,T,U,V,PDSLO,TOLD,UOLD,VOLD                              &
+     &         ,PETDT,UPSTRM                                            &
+     &         ,FEW,FNS,FNE,FSE                                         &
+     &         ,ADT,ADU,ADV                                             & 
+     &         ,N_IUP_H,N_IUP_V                                         &
+     &         ,N_IUP_ADH,N_IUP_ADV                                     &
+     &         ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                             &
+     &         ,IHE,IHW,IVE,IVW,INDX3_WRK                               &
+     &         ,IDS,IDF,JDS,JDF,KDS,KDE                                 &
+     &         ,IMS,IME,JMS,JME,KMS,KME                                 &
+     &         ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      adve_tim=adve_tim+timef()-btimx
+!
+!-----------------------------------------------------------------------
+!***  PRESSURE TENDENCY, ETA/SIGMADOT, VERTICAL PART OF OMEGA-ALPHA TERM
+!-----------------------------------------------------------------------
+!
+      btimx=timef()
+!
+      CALL VTOA(                                                        &
+#ifdef DM_PARALLEL
+     &          GRID,                                                   &
+#endif
+     &          NTSD,GRID%DT,PT,ETA2                                    &
+     &         ,HTM,HBM2,EF4T                                           &
+     &         ,T,DWDT,RTOP,OMGALF                                      &
+     &         ,PINT,DIV,PSDT,RES                                       &
+     &         ,IHE,IHW,IVE,IVW,INDX3_WRK                               &
+     &         ,IDS,IDF,JDS,JDF,KDS,KDE                                 &
+     &         ,IMS,IME,JMS,JME,KMS,KME                                 &
+     &         ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      vtoa_tim=vtoa_tim+timef()-btimx
+!
+!-----------------------------------------------------------------------
+!***  VERTICAL ADVECTION OF HEIGHT
+!-----------------------------------------------------------------------
+!
+      btimx=timef()
+!
+      CALL VADZ(NTSD,GRID%DT,FIS,GRID%SIGMA,DFL,HTM,HBM2                &
+     &         ,DETA1,DETA2,PDTOP                                       &
+     &         ,PINT,PDSL,PDSLO,PETDT                                   &
+     &         ,RTOP,T,Q,CWM,Z,W,DWDT,PDWDT                             &
+     &         ,IHE,IHW,IVE,IVW,INDX3_WRK                               &
+     &         ,IDS,IDF,JDS,JDF,KDS,KDE                                 &
+     &         ,IMS,IME,JMS,JME,KMS,KME                                 &
+     &         ,ITS,ITE,JTS,JTE,KTS,KTE)
+
+      vadz_tim=vadz_tim+timef()-btimx
+!
+!-----------------------------------------------------------------------
+!***  HORIZONTAL ADVECTION OF HEIGHT
+!-----------------------------------------------------------------------
+!
+      btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_G.inc"
+#endif
+!-----------------
+      exch_tim=exch_tim+timef()-btimx
+!     this_tim=timef()-btimx
+!     call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max             &
+!    &                  ,mpi_comm_comp,irtn)
+!     exch_tim_max=exch_tim_max+et_max
+!
+      btimx=timef()
+!
+      CALL HADZ(NTSD,GRID%DT,HYDRO,HTM,HBM2,DETA1,DETA2,PDTOP           &
+     &         ,DX_NMM,DY_NMM,FAD                                       &
+     &         ,FEW,FNS,FNE,FSE                                         &
+     &         ,PDSL,U,V,W,Z                                            &
+     &         ,IHE,IHW,IVE,IVW,INDX3_WRK                               &
+     &         ,IDS,IDF,JDS,JDF,KDS,KDE                                 &
+     &         ,IMS,IME,JMS,JME,KMS,KME                                 &
+     &         ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      hadz_tim=hadz_tim+timef()-btimx
+!
+!-----------------------------------------------------------------------
+!***  ADVECTION OF W
+!-----------------------------------------------------------------------
+!
+      btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_H.inc"
+#endif
+!-----------------
+      exch_tim=exch_tim+timef()-btimx
+!     this_tim=timef()-btimx
+!     call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max             &
+!    &                  ,mpi_comm_comp,irtn)
+!     exch_tim_max=exch_tim_max+et_max
+!
+      btimx=timef()
+!
+      CALL EPS(NTSD,GRID%DT,HYDRO,DX_NMM,DY_NMM,FAD                     &
+     &        ,DETA1,DETA2,PDTOP,PT                                     &
+     &        ,HTM,HBM2,HBM3,LMH                                        &
+     &        ,PDSL,PDSLO,PINT,RTOP,PETDT,PDWDT                         &
+     &        ,DWDT,DWDTMN,DWDTMX                                       &
+     &        ,FNS,FEW,FNE,FSE                                          &
+     &        ,T,U,V,W,Q,CWM                                            &
+     &        ,IHE,IHW,IVE,IVW,INDX3_WRK                                &
+     &        ,IDS,IDF,JDS,JDF,KDS,KDE                                  &
+     &        ,IMS,IME,JMS,JME,KMS,KME                                  &
+     &        ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      eps_tim=eps_tim+timef()-btimx
+!
+!-----------------------------------------------------------------------
+!***  VERTICAL ADVECTION OF Q, TKE, AND CLOUD WATER
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD,GRID%IDTAD)==0)THEN
+        btimx=timef()
+!
+        vad2_micro_check: IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
+          CALL VAD2(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM               &
+     &             ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP                  &
+     &             ,HBM2,LMH                                            &
+     &             ,Q,Q2,CWM,PETDT                                      &
+     &             ,N_IUP_H,N_IUP_V                                     &
+     &             ,N_IUP_ADH,N_IUP_ADV                                 &
+     &             ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                         &
+     &             ,IHE,IHW,IVE,IVW,INDX3_WRK                           &
+     &             ,IDS,IDF,JDS,JDF,KDS,KDE                             &
+     &             ,IMS,IME,JMS,JME,KMS,KME                             &
+     &             ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+        ELSE vad2_micro_check
+          CALL VAD2_SCAL(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM          &
+     &                  ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP             &
+     &                  ,HBM2,LMH                                       &
+     &                  ,Q2,PETDT                                       &
+     &                  ,N_IUP_H,N_IUP_V                                &
+     &                  ,N_IUP_ADH,N_IUP_ADV                            &
+     &                  ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                    &
+     &                  ,IHE,IHW,IVE,IVW,INDX3_WRK                      &
+     &                  ,1,1                                            &
+     &                  ,IDS,IDF,JDS,JDF,KDS,KDE                        &
+     &                  ,IMS,IME,JMS,JME,KMS,KME                        &
+     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)                              
+     
+          CALL VAD2_SCAL(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM          &
+     &                  ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP             &
+     &                  ,HBM2,LMH                                       &
+     &                  ,MOIST,PETDT                                    &
+     &                  ,N_IUP_H,N_IUP_V                                &
+     &                  ,N_IUP_ADH,N_IUP_ADV                            &
+     &                  ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                    &
+     &                  ,IHE,IHW,IVE,IVW,INDX3_WRK                      &
+     &                  ,NUM_MOIST,2                                    &
+     &                  ,IDS,IDF,JDS,JDF,KDS,KDE                        &
+     &                  ,IMS,IME,JMS,JME,KMS,KME                        &
+     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+          CALL VAD2_SCAL(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM          &
+     &                  ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP             &
+     &                  ,HBM2,LMH                                       &
+     &                  ,SCALAR,PETDT                                   &
+     &                  ,N_IUP_H,N_IUP_V                                &
+     &                  ,N_IUP_ADH,N_IUP_ADV                            &
+     &                  ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                    &
+     &                  ,IHE,IHW,IVE,IVW,INDX3_WRK                      &
+     &                  ,NUM_SCALAR,2                                   &
+     &                  ,IDS,IDF,JDS,JDF,KDS,KDE                        &
+     &                  ,IMS,IME,JMS,JME,KMS,KME                        &
+     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+
+          DO J=MYJS,MYJE
+          DO K=KTS,KTE
+          DO i=MYIS,MYIE
+            Q(I,K,J)=MOIST(I,K,J,P_QV)/(1.+MOIST(I,K,J,P_QV))
+          ENDDO
+          ENDDO   
+          ENDDO   
+!
+        ENDIF vad2_micro_check
+!
+        vad2_tim=vad2_tim+timef()-btimx
+!
+      ENDIF
+!    
+!-----------------------------------------------------------------------
+!***  VERTICAL ADVECTION OF CHEMISTRY
+!-----------------------------------------------------------------------
+!
+#ifdef WRF_CHEM  
+      IF(MOD(NTSD,GRID%IDTAD)==0)THEN
+#ifdef IBM
+        btimx=timef()
+#endif
+!
+        CALL VAD2_SCAL(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM            &
+     &           ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP                    &
+     &           ,HBM2,LMH                                              &
+     &           ,CHEM,PETDT                                            & 
+     &           ,N_IUP_H,N_IUP_V                                       &
+     &           ,N_IUP_ADH,N_IUP_ADV                                   &
+     &           ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                           &
+     &           ,IHE,IHW,IVE,IVW,INDX3_WRK                             &
+     &           ,NUM_CHEM,1                                            & 
+     &           ,IDS,IDF,JDS,JDF,KDS,KDE                               &
+     &           ,IMS,IME,JMS,JME,KMS,KME                               &
+     &           ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      ENDIF      
+#endif 
+!
+!-----------------------------------------------------------------------
+!***  HORIZONTAL ADVECTION OF Q, TKE, AND CLOUD WATER
+!-----------------------------------------------------------------------
+!
+      IF(MOD(NTSD,GRID%IDTAD)==0)THEN
+        btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_I.inc"
+#endif
+!
+#ifdef DM_PARALLEL
+        IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW)THEN
+#    include "HALO_NMM_I_3.inc"
+        ENDIF
+#endif
+!
+!-----------------
+        exch_tim=exch_tim+timef()-btimx
+!       this_tim=timef()-btimx
+!       call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max           &
+!    &                    ,mpi_comm_comp,irtn)
+!       exch_tim_max=exch_tim_max+et_max
+!
+        btimx=timef()
+!
+!-----------------------------------------------------------------------
+        had2_micro_check: IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
+!-----------------------------------------------------------------------
+!
+          CALL HAD2(                                                   &
+#if defined(DM_PARALLEL)
+     &              GRID%DOMDESC,                                      &
+#endif
+     &              NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM              &
+     &             ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP                 &
+     &             ,HTM,HBM2,HBM3,LMH                                  &
+     &             ,Q,Q2,CWM,U,V,Z,HYDRO                               &
+     &             ,N_IUP_H,N_IUP_V                                    &
+     &             ,N_IUP_ADH,N_IUP_ADV                                &
+     &             ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                        &
+     &             ,IHE,IHW,IVE,IVW,INDX3_WRK                          &
+     &             ,IDS,IDF,JDS,JDF,KDS,KDE                            &
+     &             ,IMS,IME,JMS,JME,KMS,KME                            &
+     &             ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+!***  UPDATE MOIST ARRAY
+!
+          DO J=MYJS,MYJE
+          DO K=KTS,KTE
+          DO I=MYIS,MYIE
+            MOIST(I,K,J,P_QV)=Q(I,K,J)/(1.-Q(I,K,J))
+            WC = CWM(I,K,J)
+            QI = 0.
+            QR = 0.
+            QW = 0.
+            FICE=F_ICE(I,K,J)
+            FRAIN=F_RAIN(I,K,J)
+!
+            IF(FICE>=1.)THEN
+              QI=WC
+            ELSEIF(FICE<=0.)THEN
+              QW=WC
+            ELSE
+              QI=FICE*WC
+              QW=WC-QI
+            ENDIF
+!
+            IF(QW>0..AND.FRAIN>0.)THEN
+              IF(FRAIN>=1.)THEN
+                QR=QW
+                QW=0.
+              ELSE
+                QR=FRAIN*QW
+                QW=QW-QR
+              ENDIF
+            ENDIF
+!
+            MOIST(I,K,J,P_QC)=QW
+            MOIST(I,K,J,P_QR)=QR
+            MOIST(I,K,J,P_QI)=0.
+            MOIST(I,K,J,P_QS)=QI
+            MOIST(I,K,J,P_QG)=0.
+          ENDDO
+          ENDDO
+          ENDDO
+!
+!-----------------------------------------------------------------------
+        ELSE had2_micro_check
+!-----------------------------------------------------------------------
+!
+          CALL HAD2_SCAL(                                              &
+#if defined(DM_PARALLEL)
+     &                   GRID%DOMDESC,                                 &
+#endif        
+     &                   NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM         &
+     &                  ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP            &
+     &                  ,HTM,HBM2,HBM3,LMH                             &
+     &                  ,Q2,U,V,Z,HYDRO                                &
+     &                  ,N_IUP_H,N_IUP_V                               &
+     &                  ,N_IUP_ADH,N_IUP_ADV                           &
+     &                  ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                   &
+     &                  ,IHE,IHW,IVE,IVW,INDX3_WRK                     &
+     &                  ,1,1                                           &
+     &                  ,IDS,IDF,JDS,JDF,KDS,KDE                       &
+     &                  ,IMS,IME,JMS,JME,KMS,KME                       &
+     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
+!        
+          CALL HAD2_SCAL(                                              &
+#if defined(DM_PARALLEL)
+     &                   GRID%DOMDESC,                                 &
+#endif
+     &                   NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM         &
+     &                  ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP            &
+     &                  ,HTM,HBM2,HBM3,LMH                             &
+     &                  ,MOIST,U,V,Z,HYDRO                             &
+     &                  ,N_IUP_H,N_IUP_V                               &
+     &                  ,N_IUP_ADH,N_IUP_ADV                           &
+     &                  ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                   &
+     &                  ,IHE,IHW,IVE,IVW,INDX3_WRK                     &
+     &                  ,NUM_MOIST,2                                   &
+     &                  ,IDS,IDF,JDS,JDF,KDS,KDE                       &
+     &                  ,IMS,IME,JMS,JME,KMS,KME                       &
+     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+          CALL HAD2_SCAL(                                              &
+#if defined(DM_PARALLEL)
+     &                   GRID%DOMDESC,                                 &
+#endif
+     &                   NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM         &
+     &                  ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP            &
+     &                  ,HTM,HBM2,HBM3,LMH                             &
+     &                  ,SCALAR,U,V,Z,HYDRO                            &
+     &                  ,N_IUP_H,N_IUP_V                               &
+     &                  ,N_IUP_ADH,N_IUP_ADV                           &
+     &                  ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                   &
+     &                  ,IHE,IHW,IVE,IVW,INDX3_WRK                     &
+     &                  ,NUM_SCALAR,2                                  &
+     &                  ,IDS,IDF,JDS,JDF,KDS,KDE                       &
+     &                  ,IMS,IME,JMS,JME,KMS,KME                       &
+     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)                             
+!    
+          DO J=MYJS,MYJE
+          DO K=KTS,KTE 
+          DO I=MYIS,MYIE
+            Q(I,K,J)=MOIST(I,K,J,P_QV)/(1.+MOIST(I,K,J,P_QV))           
+          ENDDO
+          ENDDO    
+          ENDDO   
+!
+!-----------------------------------------------------------------------
+        ENDIF had2_micro_check
+!-----------------------------------------------------------------------
+!
+        had2_tim=had2_tim+timef()-btimx
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!***  HORIZONTAL ADVECTION OF CHEMISTRY
+!-----------------------------------------------------------------------
+!
+#ifdef WRF_CHEM
+      IF(MOD(NTSD,GRID%IDTAD)==0)THEN
+        btimx=timef()
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_I_2.inc"
+#endif
+        exch_tim=exch_tim+timef()-btimx
+!       this_tim=timef()-btimx
+!       call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max           &
+!    &                    ,mpi_comm_comp,irtn)
+!       exch_tim_max=exch_tim_max+et_max
+!
+        btimx=timef()
+!
+        CALL HAD2_SCAL(                                                &
+#if defined(DM_PARALLEL)
+     &                 GRID%DOMDESC,                                   &
+#endif
+     &                 NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM           &
+     &                ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP              &
+     &                ,HTM,HBM2,HBM3,LMH                               &
+     &                ,CHEM,U,V,Z,HYDRO                                &
+     &                ,N_IUP_H,N_IUP_V                                 &
+     &                ,N_IUP_ADH,N_IUP_ADV                             &
+     &                ,IUP_H,IUP_V,IUP_ADH,IUP_ADV                     &
+     &                ,IHE,IHW,IVE,IVW,INDX3_WRK                       &
+     &                ,NUM_CHEM,1                                      &
+     &                ,IDS,IDF,JDS,JDF,KDS,KDE                         &
+     &                ,IMS,IME,JMS,JME,KMS,KME                         &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+
+      ENDIF
+#endif
+!
+!----------------------------------------------------------------------
+!***  RADIATION
+!----------------------------------------------------------------------
+!
+!***  When allocating CAM radiation 4d arrays (ozmixm, aerosolc), 
+!***  the following two scalars are not needed.
+!
+      NUM_OZMIXM=1
+      NUM_AEROSOLC=1
+!
+      IF(NTSD<=0)THEN
+        NTSD_rad=NTSD
+      ELSE
+!
+!***  Call radiation just BEFORE the top of the hour
+!***  so that updated fields are written to history files.
+!
+        NTSD_rad=NTSD+1
+      ENDIF
+!
+      IF(MOD(NTSD_rad,GRID%NRADS)==0.OR.                               &
+     &   MOD(NTSD_rad,GRID%NRADL)==0)THEN
+        btimx=timef()
+!
+        CALL RADIATION(NTSD_rad,GRID%DT,GRID%JULDAY,GRID%JULYR         &
+     &                ,GRID%XTIME,GRID%JULIAN                          &
+     &                ,IHRST,GRID%NPHS                                 &
+     &                ,GLAT,GLON,GRID%NRADS,GRID%NRADL                 &
+     &                ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT      &
+     &                ,PD,RES,PINT,T,Q,MOIST,THS,ALBEDO,EPSR           &
+     &                ,F_ICE,F_RAIN                                    &
+#ifdef WRF_CHEM
+     &                ,GD_CLOUD,GD_CLOUD2                              &
+#endif
+     &                ,SM,HBM2,LMH,CLDFRA,N_MOIST,RESTRT               &
+     &                ,RLWTT,RSWTT,RLWIN,RSWIN,RSWINC,RSWOUT           &
+     &                ,RLWTOA,RSWTOA,CZMEAN                            &
+     &                ,CFRACL,CFRACM,CFRACH,SIGT4                      &
+     &                ,ACFRST,NCFRST,ACFRCV,NCFRCV                     &
+     &                ,CUPPT,VEGFRC,SNO,HTOP,HBOT                      &
+     &                ,Z,SICE,NUM_AEROSOLC,NUM_OZMIXM                  &
+     &                ,GRID,CONFIG_FLAGS                               &
+     &                ,RTHRATEN                                        &  
+#ifdef WRF_CHEM
+     &                ,PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC            &
+     &                ,TAUAER1, TAUAER2, TAUAER3, TAUAER4              & 
+     &                ,GAER1, GAER2, GAER3, GAER4                      &
+     &                ,WAER1, WAER2, WAER3, WAER4                      &
+#endif
+     &                ,IDS,IDF,JDS,JDF,KDS,KDE                         &
+     &                ,IMS,IME,JMS,JME,KMS,KME                         &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+        DO J=JMS,JME
+        DO I=IMS,IME
+          GSW(I,J)=RSWIN(I,J)-RSWOUT(I,J)
+        ENDDO
+        ENDDO
+!
+!                            ***  NOTE  ***
+! RLWIN/RSWIN  - downward longwave/shortwave at the surface (formerly TOTLWDN/TOTSWDN)
+! RSWINC - CLEAR-SKY downward shortwave at the surface (new for AQ)
+!                            ***  NOTE  ***
+!
+        radiation_tim=radiation_tim+timef()-btimx
+      ENDIF
+!
+!----------------------------------------------------------------------
+!***  APPLY TEMPERATURE TENDENCY DUE TO RADIATION
+!----------------------------------------------------------------------
+!
+      btimx=timef()
+!
+      CALL RDTEMP(NTSD,GRID%DT,GRID%JULDAY,GRID%JULYR,IHRST,GLAT,GLON  &
+     &           ,CZEN,CZMEAN,T,RSWTT,RLWTT,HTM,HBM2                   &
+     &           ,IDS,IDF,JDS,JDF,KDS,KDE                              &
+     &           ,IMS,IME,JMS,JME,KMS,KME                              &
+     &           ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      rdtemp_tim=rdtemp_tim+timef()-btimx
+!
+!----------------------------------------------------------------------
+!***  TURBULENT PROCESSES 
+!----------------------------------------------------------------------
+!
+      IF(MOD(NTSD,GRID%NPHS)==0)THEN
+!
+        btimx=timef()
+!
+        CALL TURBL(NTSD,GRID%DT,GRID%NPHS,RESTRT                       &
+     &            ,N_MOIST,GRID%NUM_SOIL_LAYERS,SLDPTH,DZSOIL          &
+     &            ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT          &
+!    &            ,SM,LMH,HTM,VTM,HBM2,VBM2,DX_NMM,DFL                 &
+     &            ,SM,LMH,HTM,VTM,HBM2,VBM2,DX_NMM,DFRLG               &
+     &            ,CZEN,CZMEAN,SIGT4,RLWIN,RSWIN,RADOT                 &
+     &            ,PD,RES,PINT,T,Q,CWM,F_ICE,F_RAIN,SR                 &
+     &            ,Q2,U,V,THS,NMM_TSK,SST,PREC,SNO,ZERO_3D             &
+     &            ,FIS,Z0,Z0BASE,USTAR,PBLH,LPBL,EL_MYJ                &
+     &            ,MOIST,RMOL                                          &
+     &            ,EXCH_H,AKHS,AKMS,AKHS_OUT,AKMS_OUT                  &
+     &            ,THZ0,QZ0,UZ0,VZ0,QSH,MAVAIL                         &
+     &            ,STC,SMC,CMC,SMSTAV,SMSTOT,SSROFF,BGROFF             &
+     &            ,IVGTYP,ISLTYP,VEGFRC,SHDMIN,SHDMAX,GRNFLX           &
+     &            ,SFCEXC,ACSNOW,ACSNOM,SNOPCX,SICE,TG,SOILTB          &
+     &            ,ALBASE,MXSNAL,ALBEDO,SH2O,SI,EPSR                   &
+     &            ,U10,V10,TH10,Q10,TSHLTR,QSHLTR,PSHLTR               &
+     &            ,T2,QSG,QVG,QCG,SOILT1,TSNAV,SMFR3D,KEEPFR3DFLAG     &
+     &            ,TWBS,QWBS,SFCSHX,SFCLHX,SFCEVP                      &
+     &            ,POTEVP,POTFLX,SUBSHX                                &
+     &            ,APHTIM,ARDSW,ARDLW,ASRFC                            &
+     &            ,RSWOUT,RSWTOA,RLWTOA                                &
+     &            ,ASWIN,ASWOUT,ASWTOA,ALWIN,ALWOUT,ALWTOA             &
+     &            ,UZ0H,VZ0H,DUDT,DVDT                                 & 
+     &            ,RTHBLTEN,RQVBLTEN                                   & 
+     &            ,GRID%PCPFLG,DDATA                                   &
+     &            ,GRID,CONFIG_FLAGS                                   &
+     &            ,IHE,IHW,IVE,IVW                                     &
+     &            ,IDS,IDF,JDS,JDF,KDS,KDE                             &
+     &            ,IMS,IME,JMS,JME,KMS,KME                             &
+     &            ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+!                     ***  NOTE  ***
+! RLWIN/RSWIN - downward longwave/shortwave at the surface
+!                     ***  NOTE  ***
+!
+        turbl_tim=turbl_tim+timef()-btimx
+!
+        btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+# include "HALO_NMM_TURBL_A.inc"
+#endif
+!-----------------
+#ifdef DM_PARALLEL
+# include "HALO_NMM_TURBL_B.inc"
+#endif
+!-----------------
+        exch_tim=exch_tim+timef()-btimx
+!       this_tim=timef()-btimx
+!       call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max           &
+!    &                    ,mpi_comm_comp,irtn)
+!       exch_tim_max=exch_tim_max+et_max
+!
+!***  INTERPOLATE WINDS FROM H POINTS BACK TO V POINTS.
+!
+        btimx=timef()
+        CALL UV_H_TO_V(NTSD,GRID%DT,GRID%NPHS,UZ0H,VZ0H,UZ0,VZ0         &
+     &                ,DUDT,DVDT,U,V,HBM2,VTM,IVE,IVW                   &
+     &                ,IDS,IDF,JDS,JDF,KDS,KDE                          &
+     &                ,IMS,IME,JMS,JME,KMS,KME                          &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+        uv_htov_tim=uv_htov_tim+timef()-btimx
+!
+!----------------------------------------------------------------------
+!*** STORE ORIGINAL TEMPERATURE ARRAY
+!----------------------------------------------------------------------
+!
+        btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_J.inc"
+#endif
+!
+#ifdef DM_PARALLEL
+        IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW)THEN
+#    include "HALO_NMM_J_3.inc"
+        ENDIF
+#endif
+!
+#ifdef WRF_CHEM
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_J_2.inc"
+#endif
+#endif
+!-----------------
+        exch_tim=exch_tim+timef()-btimx
+!       this_tim=timef()-btimx
+!       call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max           &
+!    &                    ,mpi_comm_comp,irtn)
+!       exch_tim_max=exch_tim_max+et_max
+!
+        ICLTEND=-1
+        btimx=timef()
+! 
+        CALL CLTEND(ICLTEND,GRID%NPHS,T,T_OLD,T_ADJ                    &
+     &             ,IDS,IDF,JDS,JDF,KDS,KDE                            &
+     &             ,IMS,IME,JMS,JME,KMS,KME                            &
+     &             ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+        cltend_tim=cltend_tim+timef()-btimx
+      ENDIF
+!
+!----------------------------------------------------------------------
+!***  CONVECTIVE PRECIPITATION
+!----------------------------------------------------------------------
+      IF(MOD(NTSD,GRID%NCNVC)==0.AND.                                  &
+     &   CONFIG_FLAGS%CU_PHYSICS==KFETASCHEME)THEN
+!
+        btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_C.inc"
+#endif
+!-----------------
+        exch_tim=exch_tim+timef()-btimx
+!       this_tim=timef()-btimx
+!       call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max          &
+!    &                    ,mpi_comm_comp,irtn)
+!       exch_tim_max=exch_tim_max+et_max
+      ENDIF
+!
+      IF(GRID%NCNVC/=999)THEN
+        btimx=timef()
+!
+!***  GET TENDENCIES FOR GD SCHEME.
+!    
+        IF(CONFIG_FLAGS%CU_PHYSICS==GDSCHEME)THEN
+          DT_INV=1./GRID%DT
+          DO J=JMS,JME
+          DO K=KMS,KME
+          DO I=IMS,IME
+            TTEN(I,K,J)=(T(I,K,J)-TTEN(I,K,J))*DT_INV
+            QTEN(I,K,J)=(Q(I,K,J)-QTEN(I,K,J))*DT_INV
+          ENDDO
+          ENDDO
+          ENDDO
+        ENDIF
+
+        CALL CUCNVC(NTSD,GRID%DT,GRID%NCNVC,GRID%NRADS,GRID%NRADL      &
+     &             ,GPS,RESTRT,HYDRO,CLDEFI,LMH,N_MOIST,GRID%ENSDIM    &
+     &             ,MOIST                                              &
+     &             ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2                  &
+     &             ,F_ICE,F_RAIN                                       &
+!***  Changes for other cu schemes, most for GD scheme
+     &             ,APR_GR,APR_W,APR_MC,TTEN,QTEN                      &
+     &             ,APR_ST,APR_AS,APR_CAPMA                            &
+     &             ,APR_CAPME,APR_CAPMI                                &
+     &             ,MASS_FLUX,XF_ENS                                   &
+     &             ,PR_ENS,GSW                                         &
+#ifdef WRF_CHEM
+     &             ,GD_CLOUD,GD_CLOUD2                                 &
+#endif
+!
+     &             ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TCUCN                 &
+     &             ,OMGALF,U,V,VTM,W,Z,FIS,W0AVG                       &
+     &             ,PREC,ACPREC,CUPREC,CUPPT,CPRATE                    &
+     &             ,SM,HBM2,LPBL,CNVBOT,CNVTOP                         &
+     &             ,HTOP,HBOT,HTOPD,HBOTD,HTOPS,HBOTS                  &
+     &             ,RTHBLTEN,RQVBLTEN,RTHRATEN                         & 
+     &             ,AVCNVC,ACUTIM,ZERO_3D,IHE,IHW                      &
+     &             ,GRID,CONFIG_FLAGS                                  &
+     &             ,IDS,IDF,JDS,JDF,KDS,KDE                            &
+     &             ,IMS,IME,JMS,JME,KMS,KME                            &
+     &             ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+        cucnvc_tim=cucnvc_tim+timef()-btimx
+!
+      ENDIF
+!
+!----------------------------------------------------------------------
+!***  GRIDSCALE MICROPHYSICS (CONDENSATION & PRECIPITATION)
+!----------------------------------------------------------------------
+!
+      IF(MOD(NTSD,GRID%NPHS)==0)THEN
+        btimx=timef()
+!
+        CALL GSMDRIVE(NTSD,GRID%DT,GRID%NPHS,N_MOIST                   &
+     &               ,DX_NMM(ITS,JC),GRID%DY,LMH,SM,HBM2,FIS           &
+     &               ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2                &
+     &               ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TRAIN               &
+     &               ,MOIST,SCALAR,NUM_SCALAR                          &
+     &               ,F_ICE,F_RAIN,F_RIMEF,SR                          &
+     &               ,PREC,ACPREC,AVRAIN,ZERO_3D                       &
+     &               ,MP_RESTART_STATE                                 &
+     &               ,TBPVS_STATE                                      &
+     &               ,TBPVS0_STATE                                     &
+     &               ,GRID,CONFIG_FLAGS                                &
+     &               ,IDS,IDF,JDS,JDF,KDS,KDE                          &
+     &               ,IMS,IME,JMS,JME,KMS,KME                          &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+        gsmdrive_tim=gsmdrive_tim+timef()-btimx
+!
+!-----------------------------------------------------------------------
+!---------PRECIPITATION ASSIMILATION------------------------------------
+!-----------------------------------------------------------------------
+!
+        IF (GRID%PCPFLG) THEN
+          btimx=timef()
+!
+          CALL CHKSNOW(NTSD,GRID%DT,GRID%NPHS,SR,PPTDAT                 &
+     &      ,IDS,IDE,JDS,JDE,KDS,KDE                                    &
+     &      ,IMS,IME,JMS,JME,KMS,KME                                    &
+     &      ,ITS,ITE,JTS,JTE,KTS,KTE)
+          CALL ADJPPT(NTSD,GRID%DT,GRID%NPHS,PREC,LSPA,PPTDAT,DDATA     &
+     &      ,IDS,IDE,JDS,JDE,KDS,KDE                                    &
+     &      ,IMS,IME,JMS,JME,KMS,KME                                    &
+     &      ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+          adjppt_tim=adjppt_tim+timef()-btimx
+        ENDIF
+!
+!----------------------------------------------------------------------
+!***  CALCULATE TEMP TENDENCIES AND RESTORE ORIGINAL TEMPS
+!----------------------------------------------------------------------
+!      
+        ICLTEND=0
+        btimx=timef()
+!
+        CALL CLTEND(ICLTEND,GRID%NPHS,T,T_OLD,T_ADJ                    &
+     &             ,IDS,IDF,JDS,JDF,KDS,KDE                            &
+     &             ,IMS,IME,JMS,JME,KMS,KME                            &
+     &             ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+        cltend_tim=cltend_tim+timef()-btimx
+      ENDIF
+!
+!----------------------------------------------------------------------
+!***  UPDATE TEMP TENDENCIES FROM CLOUD PROCESSES EVERY TIME STEP
+!----------------------------------------------------------------------
+!
+      ICLTEND=1
+      btimx=timef()
+!
+      CALL CLTEND(ICLTEND,GRID%NPHS,T,T_OLD,T_ADJ                      &
+     &           ,IDS,IDF,JDS,JDF,KDS,KDE                              &
+     &           ,IMS,IME,JMS,JME,KMS,KME                              &
+     &           ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      cltend_tim=cltend_tim+timef()-btimx
+!
+!----------------------------------------------------------------------
+!***  LATERAL DIFFUSION
+!----------------------------------------------------------------------
+!
+      btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_K.inc"
+#endif
+!-----------------
+      exch_tim=exch_tim+timef()-btimx
+!     this_tim=timef()-btimx
+!     call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max             &
+!    &                  ,mpi_comm_comp,irtn)
+!     exch_tim_max=exch_tim_max+et_max
+!
+      btimx=timef()
+!
+      CALL HDIFF(NTSD,GRID%DT,FIS,DY_NMM,HDAC,HDACV                    &
+     &          ,HTM,HBM2,VTM,DETA1,GRID%SIGMA                         &
+     &          ,T,Q,U,V,Q2,Z,W,SM,SICE                                &
+     &          ,IHE,IHW,IVE,IVW,INDX3_WRK                             &
+     &          ,IDS,IDF,JDS,JDF,KDS,KDE                               &
+     &          ,IMS,IME,JMS,JME,KMS,KME                               &
+     &          ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      DO J=MYJS,MYJE
+      DO K=KTS,KTE
+      DO I=MYIS,MYIE
+!!!      MOIST(I,K,J,P_QV)=MAX(0.,Q(I,K,J)/(1.-Q(I,K,J)))
+         MOIST(I,K,J,P_QV)=Q(I,K,J)/(1.-Q(I,K,J))
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      hdiff_tim=hdiff_tim+timef()-btimx
+!
+!----------------------------------------------------------------------
+!***  UPDATING BOUNDARY VALUES AT HEIGHT POINTS
+!----------------------------------------------------------------------
+!
+      btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_L.inc"
+#endif
+!
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_L_3.inc"
+#endif
+!
+#ifdef WRF_CHEM
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_L_2.inc"
+#endif
+#endif
+!-----------------
+      exch_tim=exch_tim+timef()-btimx
+!     this_tim=timef()-btimx
+!     call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max             &
+!    &                  ,mpi_comm_comp,irtn)
+!     exch_tim_max=exch_tim_max+et_max
+!
+      btimx=timef()
+!
+      CALL BOCOH(GRID%ID,NTSD,GRID%DT,NEST,NUNIT_NBC,NBOCO,LAST_TIME,TSPH & 
+     &          ,LB,ETA1,ETA2,PDTOP,PT,RES,HTM                         &
+     &          ,PD_B,T_B,Q_B,U_B,V_B,Q2_B,CWM_B                       &
+     &          ,PD_BT,T_BT,Q_BT,U_BT,V_BT,Q2_BT,CWM_BT                &
+     &          ,PD,T,Q,Q2,CWM,PINT,MOIST,N_MOIST,SCALAR,NUM_SCALAR    &
+#ifdef WRF_CHEM
+     &          ,CHEM,NUM_CHEM,CONFIG_FLAGS                            &
+#endif
+     &          ,IJDS,IJDE,GRID%SPEC_BDY_WIDTH,Z                       &
+     &          ,IHE,IHW,IVE,IVW,INDX3_WRK                             &
+     &          ,IDS,IDF,JDS,JDF,KDS,KDE                               &
+     &          ,IMS,IME,JMS,JME,KMS,KME                               &
+     &          ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      bocoh_tim=bocoh_tim+timef()-btimx
+!     if(mod(ntsd,n_print_time)==0)then
+!       call twr(t,0,'t',ntsd,mype,npes,mpi_comm_comp &
+!    &          ,ids,ide,jds,jde,kds,kde                               &
+!    &          ,ims,ime,jms,jme,kms,kme                               &
+!    &          ,its,ite,jts,jte,kts,kte)
+!     endif
+!
+!----------------------------------------------------------------------
+!***  IS IT TIME FOR A CHECK POINT ON THE MODEL HISTORY FILE?
+!----------------------------------------------------------------------
+!
+ 2003 CONTINUE
+!
+!----------------------------------------------------------------------
+!***  PRESSURE GRD, CORIOLIS, DIVERGENCE, AND HORIZ PART OF OMEGA-ALPHA
+!----------------------------------------------------------------------
+!
+      btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_A.inc"
+#endif
+!
+#ifdef DM_PARALLEL
+      IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW)THEN
+#    include "HALO_NMM_A_3.inc"
+      ENDIF
+#endif
+!
+#ifdef WRF_CHEM
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_A_2.inc"
+#endif
+#endif
+!-----------------
+      exch_tim=exch_tim+timef()-btimx
+!     this_tim=timef()-btimx
+!     call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max             &
+!    &                  ,mpi_comm_comp,irtn)
+!     exch_tim_max=exch_tim_max+et_max
+!
+      btimx=timef()
+!
+      CALL PFDHT(NTSD,LAST_TIME,PT,DETA1,DETA2,PDTOP,RES,FIS           &
+     &          ,HYDRO,GRID%SIGMA,FIRST,DX_NMM,DY_NMM                  &
+     &          ,HTM,HBM2,VTM,VBM2,VBM3                                &
+     &          ,FDIV,FCP,WPDAR,DFL,CPGFU,CPGFV                        &
+     &          ,PD,PDSL,T,Q,U,V,CWM,OMGALF,PINT,DWDT                  &
+     &          ,RTOP,DIV,FEW,FNS,FNE,FSE                              &
+     &          ,IHE,IHW,IVE,IVW,INDX3_WRK                             &
+     &          ,IDS,IDF,JDS,JDF,KDS,KDE                               &
+     &          ,IMS,IME,JMS,JME,KMS,KME                               &
+     &          ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      pfdht_tim=pfdht_tim+timef()-btimx
+!
+!----------------------------------------------------------------------
+!***  DIVERGENCE DAMPING
+!----------------------------------------------------------------------
+!
+      btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_B.inc"
+#endif
+!-----------------
+      exch_tim=exch_tim+timef()-btimx
+!     this_tim=timef()-btimx
+!     call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max            &
+!    &                  ,mpi_comm_comp,irtn)
+!     exch_tim_max=exch_tim_max+et_max
+!
+      btimx=timef()
+!
+      CALL DDAMP(NTSD,GRID%DT,DETA1,DETA2,PDSL,PDTOP,DIV,HBM2,VTM      &
+     &          ,T,U,V,DDMPU,DDMPV                                     &
+     &          ,IHE,IHW,IVE,IVW,INDX3_WRK                             &
+     &          ,IDS,IDF,JDS,JDF,KDS,KDE                               &
+     &          ,IMS,IME,JMS,JME,KMS,KME                               &
+     &          ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+      ddamp_tim=ddamp_tim+timef()-btimx
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!
+      IF(FIRST.AND.NTSD==0)THEN
+        FIRST=.FALSE.
+        btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_A.inc"
+#endif
+#ifdef WRF_CHEM
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_A_2.inc"
+#endif
+#endif
+!-----------------
+        exch_tim=exch_tim+timef()-btimx
+!       this_tim=timef()-btimx
+!       call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max          &
+!    &                    ,mpi_comm_comp,irtn)
+!       exch_tim_max=exch_tim_max+et_max
+!
+        GO TO 2000
+      ENDIF
+!
+!----------------------------------------------------------------------
+!***  UPDATING BOUNDARY VALUES AT VELOCITY POINTS
+!----------------------------------------------------------------------
+!
+      btimx=timef()
+!-----------------
+#ifdef DM_PARALLEL
+#    include "HALO_NMM_C.inc"
+#endif
+!-----------------
+      exch_tim=exch_tim+timef()-btimx
+!     this_tim=timef()-btimx
+!     call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max            &
+!    &                  ,mpi_comm_comp,irtn)
+!     exch_tim_max=exch_tim_max+et_max
+!
+      btimx=timef()
+!
+      CALL BOCOV(GRID%ID,NTSD,GRID%DT,LB,VTM,U_B,V_B,U_BT,V_BT         & 
+     &          ,U,V                                                   &
+     &          ,IJDS,IJDE,GRID%SPEC_BDY_WIDTH                         &
+     &          ,IHE,IHW,IVE,IVW,INDX3_WRK                             &
+     &          ,IDS,IDF,JDS,JDF,KDS,KDE                               &
+     &          ,IMS,IME,JMS,JME,KMS,KME                               &
+     &          ,ITS,ITE,JTS,JTE,KTS,KTE )
+!
+      bocov_tim=bocov_tim+timef()-btimx
+!
+!----------------------------------------------------------------------
+!***  COPY THE NMM VARIABLE Q2 TO THE WRF VARIABLE TKE_MYJ
+!----------------------------------------------------------------------
+!
+      DO J=JTS,JTE
+      DO K=KTS,KTE
+      DO I=ITS,ITE
+        TKE_MYJ(I,K,J)=0.5*Q2(I,K,J) !TKE is q squared over 2
+      ENDDO
+      ENDDO
+      ENDDO
+!
+!----------------------------------------------------------------------
+!
+      IF(LAST_TIME.AND.ALLOCATED(PPTDAT))THEN
+        DEALLOCATE(PPTDAT,STAT=ISTAT)
+      ENDIF
+!
+!----------------------------------------------------------------------
+!
+      solve_tim=solve_tim+timef()-btim
+!
+!----------------------------------------------------------------------
+!***  PRINT TIMING VARIABLES WHEN DESIRED.
+!----------------------------------------------------------------------
+!
+      sum_tim=pdte_tim+adve_tim+vtoa_tim+vadz_tim+hadz_tim+eps_tim     &
+     &       +vad2_tim+had2_tim+radiation_tim+rdtemp_tim+turbl_tim     &
+     &       +cltend_tim+cucnvc_tim+gsmdrive_tim+hdiff_tim             &
+     &       +bocoh_tim+pfdht_tim+ddamp_tim+bocov_tim+uv_htov_tim      &
+     &       +exch_tim+adjppt_tim
+!
+      if(mod(ntsd,n_print_time)==0)then
+        write(0,*)' ntsd=',ntsd,' solve_tim=',solve_tim*1.e-3          &
+     &           ,' sum_tim=',sum_tim*1.e-3
+        write(0,*)' pdte_tim=',pdte_tim*1.e-3,' pct=',pdte_tim/sum_tim*100.
+        write(0,*)' adve_tim=',adve_tim*1.e-3,' pct=',adve_tim/sum_tim*100.
+        write(0,*)' vtoa_tim=',vtoa_tim*1.e-3,' pct=',vtoa_tim/sum_tim*100.
+        write(0,*)' vadz_tim=',vadz_tim*1.e-3,' pct=',vadz_tim/sum_tim*100.
+        write(0,*)' hadz_tim=',hadz_tim*1.e-3,' pct=',hadz_tim/sum_tim*100.
+        write(0,*)' eps_tim=',eps_tim*1.e-3,' pct=',eps_tim/sum_tim*100.
+        write(0,*)' vad2_tim=',vad2_tim*1.e-3,' pct=',vad2_tim/sum_tim*100.
+        write(0,*)' had2_tim=',had2_tim*1.e-3,' pct=',had2_tim/sum_tim*100.
+        write(0,*)' radiation_tim=',radiation_tim*1.e-3,' pct=',radiation_tim/sum_tim*100.
+        write(0,*)' rdtemp_tim=',rdtemp_tim*1.e-3,' pct=',rdtemp_tim/sum_tim*100.
+        write(0,*)' turbl_tim=',turbl_tim*1.e-3,' pct=',turbl_tim/sum_tim*100.
+        write(0,*)' cltend_tim=',cltend_tim*1.e-3,' pct=',cltend_tim/sum_tim*100.
+        write(0,*)' cucnvc_tim=',cucnvc_tim*1.e-3,' pct=',cucnvc_tim/sum_tim*100.
+        write(0,*)' gsmdrive_tim=',gsmdrive_tim*1.e-3,' pct=',gsmdrive_tim/sum_tim*100.
+        write(0,*)' adjppt_tim=',adjppt_tim*1.e-3,' pct=',adjppt_tim/sum_tim*100.
+        write(0,*)' hdiff_tim=',hdiff_tim*1.e-3,' pct=',hdiff_tim/sum_tim*100.
+        write(0,*)' bocoh_tim=',bocoh_tim*1.e-3,' pct=',bocoh_tim/sum_tim*100.
+        write(0,*)' pfdht_tim=',pfdht_tim*1.e-3,' pct=',pfdht_tim/sum_tim*100.
+        write(0,*)' ddamp_tim=',ddamp_tim*1.e-3,' pct=',ddamp_tim/sum_tim*100.
+        write(0,*)' bocov_tim=',bocov_tim*1.e-3,' pct=',bocov_tim/sum_tim*100.
+        write(0,*)' uv_h_to_v_tim=',uv_htov_tim*1.e-3,' pct=',uv_htov_tim/sum_tim*100.
+        write(0,*)' exch_tim=',exch_tim*1.e-3,' pct=',exch_tim/sum_tim*100.
+!        call time_stats(exch_tim,'exchange',ntsd,mype,npes,mpi_comm_comp)
+!        write(0,*)' exch_tim_max=',exch_tim_max*1.e-3
+!
+        call field_stats(t,mype,mpi_comm_comp                          &
+     &                  ,ids,ide,jds,jde,kds,kde                       &
+     &                  ,ims,ime,jms,jme,kms,kme                       &
+     &                  ,its,ite,jts,jte,kts,kte)
+      endif
+!
+!     if(last_time)then
+      DEALLOCATE(TTEN,STAT=ISTAT)
+      DEALLOCATE(QTEN,STAT=ISTAT)
+      DEALLOCATE(RTHRATEN,STAT=ISTAT)
+      DEALLOCATE(RTHBLTEN,STAT=ISTAT)
+      DEALLOCATE(RQVBLTEN,STAT=ISTAT)
+!
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+      Return
+!----------------------------------------------------------------------
+!**********************************************************************
+!**********************************************************************
+!*************    EXIT FROM THE TIME LOOP    **************************
+!**********************************************************************
+!**********************************************************************
+!----------------------------------------------------------------------
+      END SUBROUTINE SOLVE_NMM
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+      SUBROUTINE TWR(ARRAY,KK,FIELD,NTSD,MYPE,NPES,MPI_COMM_COMP       &
+     &              ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &              ,IMS,IME,JMS,JME,KMS,KME                           &
+     &              ,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+!**********************************************************************
+      USE MODULE_EXT_INTERNAL
+!
+      IMPLICIT NONE
+      INCLUDE "mpif.h"
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE                    &
+     &                     ,KK,MPI_COMM_COMP,MYPE,NPES,NTSD
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME+KK,JMS:JME),INTENT(IN) :: ARRAY
+!
+      CHARACTER(*),INTENT(IN) :: FIELD
+!
+!*** LOCAL VARIABLES
+!
+      INTEGER,DIMENSION(MPI_STATUS_SIZE) :: JSTAT
+      INTEGER,DIMENSION(MPI_STATUS_SIZE,4) :: STATUS_ARRAY
+      INTEGER,DIMENSION(2) :: IM_REM,JM_REM,IT_REM,JT_REM
+!
+      INTEGER :: I,IENDX,IER,IPE,IRECV,IRTN,ISEND,IUNIT                &
+     &          ,J,K,N,NLEN,NSIZE
+      INTEGER :: ITS_REM,ITE_REM,JTS_REM,JTE_REM
+!
+      REAL,DIMENSION(IDS:IDE,JDS:JDE) :: TWRITE
+      REAL,ALLOCATABLE,DIMENSION(:) :: VALUES
+      CHARACTER(5) :: TIMESTEP
+      CHARACTER(6) :: FMT
+      CHARACTER(12) :: FILENAME
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+      IF(NTSD<=9)THEN
+        FMT='(I1.1)'
+        NLEN=1
+      ELSEIF(NTSD<=99)THEN
+        FMT='(I2.2)'
+        NLEN=2
+      ELSEIF(NTSD<=999)THEN
+        FMT='(I3.3)'
+        NLEN=3
+      ELSEIF(NTSD<=9999)THEN
+        FMT='(I4.4)'
+        NLEN=4
+      ELSEIF(NTSD<=99999)THEN
+        FMT='(I5.5)'
+        NLEN=5
+      ENDIF
+      WRITE(TIMESTEP,FMT)NTSD
+      FILENAME=FIELD//'_'//TIMESTEP(1:NLEN)
+!
+      IF(MYPE==0)THEN
+        CALL INT_GET_FRESH_HANDLE(IUNIT)
+        CLOSE(IUNIT)
+        OPEN(UNIT=IUNIT,FILE=FILENAME,FORM='UNFORMATTED',IOSTAT=IER)
+      ENDIF
+!
+!----------------------------------------------------------------------
+!!!!  DO 500 K=KTS,KTE+KK     !Unflipped
+!!!!  DO 500 K=KTE+KK,KTS,-1
+      DO 500 K=KDE-1,KDS,-1   !Write LM layers top down for checking
+!----------------------------------------------------------------------
+!
+      IF(MYPE==0)THEN
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          TWRITE(I,J)=ARRAY(I,K,J)
+        ENDDO
+        ENDDO
+!
+        DO IPE=1,NPES-1
+          CALL MPI_RECV(IT_REM,2,MPI_INTEGER,IPE,IPE                    &
+     &                 ,MPI_COMM_COMP,JSTAT,IRECV)
+          CALL MPI_RECV(JT_REM,2,MPI_INTEGER,IPE,IPE                    &
+     &                 ,MPI_COMM_COMP,JSTAT,IRECV)
+!
+          ITS_REM=IT_REM(1)
+          ITE_REM=IT_REM(2)
+          JTS_REM=JT_REM(1)
+          JTE_REM=JT_REM(2)
+!
+          NSIZE=(ITE_REM-ITS_REM+1)*(JTE_REM-JTS_REM+1)
+          ALLOCATE(VALUES(1:NSIZE))
+!
+          CALL MPI_RECV(VALUES,NSIZE,MPI_REAL,IPE,IPE                   &
+     &                 ,MPI_COMM_COMP,JSTAT,IRECV)
+          N=0
+          DO J=JTS_REM,JTE_REM
+            DO I=ITS_REM,ITE_REM
+              N=N+1
+              TWRITE(I,J)=VALUES(N)
+            ENDDO
+          ENDDO
+!
+          DEALLOCATE(VALUES)
+!
+        ENDDO
+!
+!----------------------------------------------------------------------
+      ELSE
+        NSIZE=(ITE-ITS+1)*(JTE-JTS+1)
+        ALLOCATE(VALUES(1:NSIZE))
+!
+        N=0
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          N=N+1
+          VALUES(N)=ARRAY(I,K,J)
+        ENDDO
+        ENDDO
+!
+        IT_REM(1)=ITS
+        IT_REM(2)=ITE
+        JT_REM(1)=JTS
+        JT_REM(2)=JTE
+!
+        CALL MPI_SEND(IT_REM,2,MPI_INTEGER,0,MYPE                       &
+     &               ,MPI_COMM_COMP,ISEND)
+        CALL MPI_SEND(JT_REM,2,MPI_INTEGER,0,MYPE                       &
+     &               ,MPI_COMM_COMP,ISEND)
+!
+        CALL MPI_SEND(VALUES,NSIZE,MPI_REAL,0,MYPE                      &
+     &               ,MPI_COMM_COMP,ISEND)
+!
+        DEALLOCATE(VALUES)
+!
+      ENDIF
+!----------------------------------------------------------------------
+!
+      CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
+!
+      IF(MYPE==0)THEN
+!
+        DO J=JDS,JDE-1
+          IENDX=IDE-1
+          IF(MOD(J,2)==0)IENDX=IENDX-1
+          WRITE(IUNIT)(TWRITE(I,J),I=1,IENDX)
+        ENDDO
+!
+      ENDIF
+!
+!----------------------------------------------------------------------
+  500 CONTINUE
+!
+      IF(MYPE==0)CLOSE(IUNIT)
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE TWR
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+      SUBROUTINE EXIT(NAME,T,Q,U,V,Q2,NTSD,MYPE,MPI_COMM_COMP          &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &               ,IMS,IME,JMS,JME,KMS,KME                          &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+!**********************************************************************
+      USE MODULE_EXT_INTERNAL
+!
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+!----------------------------------------------------------------------
+      INCLUDE "mpif.h"
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE                    &
+     &                     ,MYPE,MPI_COMM_COMP,NTSD      
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: T,Q,U,V,Q2
+      CHARACTER(*),INTENT(IN) :: NAME
+!
+      INTEGER :: I,J,K,IEND,IERR,IRET
+      CHARACTER(256) :: ERRMESS
+      LOGICAL :: E_BDY,S_BDY
+!----------------------------------------------------------------------
+      IRET=0
+  100 FORMAT(' EXIT ',A,' AT NTSD=',I5)
+      IEND=ITE
+      S_BDY=(JTS==JDS)
+      E_BDY=(ITE==IDE-1)
+!
+      DO J=JTS,JTE
+      IEND=ITE
+      DO K=KTS,KTE
+      IF(E_BDY.AND.MOD(J,2)==0)IEND=ITE-1
+!
+      DO I=ITS,IEND
+        IF(T(I,K,J)>330..OR.T(I,K,J)<180..OR.T(I,K,J)/=T(I,K,J))THEN
+          WRITE(0,100)NAME,NTSD
+          WRITE(0,200)I,J,K,T(I,K,J),MYPE,NTSD
+  200     FORMAT(' BAD VALUE I=',I3,' J=',I3,' K=',I2,' T=',E12.5      &
+     &,          ' MYPE=',I3,' NTSD=',I5)
+          IRET=666
+          return
+!         WRITE(ERRMESS,205)NAME,T(I,K,J),I,K,J,MYPE
+  205     FORMAT(' EXIT ',A,' TEMPERATURE=',E12.5                      &
+     &,          ' AT (',I3,',',I2,',',I3,')',' MYPE=',I3)
+!         CALL WRF_ERROR_FATAL(ERRMESS)
+!         CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
+        ELSEIF(Q(I,K,J)<-1.E-4.OR.Q(I,K,J)>30.E-3                      &
+     &         .OR.Q(I,K,J)/=Q(I,K,J))THEN
+          WRITE(0,100)NAME,NTSD
+          WRITE(0,300)I,J,K,Q(I,K,J),MYPE,NTSD
+  300     FORMAT(' BAD VALUE I=',I3,' J=',I3,' K=',I2,' Q=',E12.5      &
+     &,          ' MYPE=',I3,' NTSD=',I5)
+          IRET=666
+          return
+!         WRITE(ERRMESS,305)NAME,Q(I,K,J),I,K,J,MYPE
+  305     FORMAT(' EXIT ',A,' SPEC HUMIDITY=',E12.5                    &
+     &,          ' AT (',I3,',',I2,',',I3,')',' MYPE=',I3)
+!         CALL WRF_ERROR_FATAL(ERRMESS)
+!         CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
+        ENDIF
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=JTS,JTE
+      IEND=ITE
+      DO K=KTS,KTE
+      IF(E_BDY.AND.MOD(J,2)==1)IEND=ITE-1
+      DO I=ITS,IEND
+        IF(ABS(U(I,K,J))>125..OR.ABS(V(I,K,J))>125.                    &
+     &         .OR.U(I,K,J)/=U(I,K,J).OR.V(I,K,J)/=V(I,K,J))THEN
+          WRITE(0,100)NAME,NTSD
+          WRITE(0,400)I,J,K,U(I,K,J),V(I,K,J),MYPE,NTSD
+  400     FORMAT(' BAD VALUE I=',I3,' J=',I3,' K=',I2,' U=',E12.5      &
+     &,          ' V=',E12.5,' MYPE=',I3,' NTSD=',I5)
+          IRET=666
+          return
+!         WRITE(ERRMESS,405)NAME,U(I,K,J),V(I,K,J),I,K,J,MYPE
+  405     FORMAT(' EXIT ',A,' U=',E12.5,' V=',E12.5                    &
+     &,          ' AT (',I3,',',I2,',',I3,')',' MYPE=',I3)
+!         CALL WRF_ERROR_FATAL(ERRMESS)
+!         CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
+        ENDIF
+      ENDDO
+      ENDDO
+      ENDDO
+!----------------------------------------------------------------------
+      END SUBROUTINE EXIT
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+      SUBROUTINE TIME_STATS(TIME_LCL,NAME,NTSD,MYPE,NPES,MPI_COMM_COMP)
+!----------------------------------------------------------------------
+!**********************************************************************
+      USE MODULE_EXT_INTERNAL
+!
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+!----------------------------------------------------------------------
+      INCLUDE "mpif.h"
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: MPI_COMM_COMP,MYPE,NPES,NTSD
+      REAL,INTENT(IN) :: TIME_LCL
+!
+      CHARACTER(*),INTENT(IN) :: NAME
+!
+!*** LOCAL VARIABLES
+!
+      INTEGER,DIMENSION(MPI_STATUS_SIZE) :: JSTAT
+      INTEGER,DIMENSION(MPI_STATUS_SIZE,4) :: STATUS_ARRAY
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: ID_PE,IPE_SORT
+!
+      INTEGER :: IPE,IPE_MAX,IPE_MEDIAN,IPE_MIN,IRECV,IRTN,ISEND       &
+     &          ,N,N_MEDIAN,NLEN
+!
+      REAL,ALLOCATABLE,DIMENSION(:) :: TIME,SORT_TIME
+      REAL,DIMENSION(2) :: REMOTE
+      REAL :: TIME_MAX,TIME_MEAN,TIME_MEDIAN,TIME_MIN
+!
+      CHARACTER(5) :: TIMESTEP
+      CHARACTER(6) :: FMT
+      CHARACTER(25) :: TITLE
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+      IF(NTSD<=9)THEN
+        FMT='(I1.1)'
+        NLEN=1
+      ELSEIF(NTSD<=99)THEN
+        FMT='(I2.2)'
+        NLEN=2
+      ELSEIF(NTSD<=999)THEN
+        FMT='(I3.3)'
+        NLEN=3
+      ELSEIF(NTSD<=9999)THEN
+        FMT='(I4.4)'
+        NLEN=4
+      ELSEIF(NTSD<=99999)THEN
+        FMT='(I5.5)'
+        NLEN=5
+      ENDIF
+      WRITE(TIMESTEP,FMT)NTSD
+      TITLE=NAME//'_'//TIMESTEP(1:NLEN)
+!
+!----------------------------------------------------------------------
+!
+      IF(MYPE==0)THEN
+        ALLOCATE(TIME(1:NPES))
+        ALLOCATE(SORT_TIME(1:NPES))
+        ALLOCATE(ID_PE(1:NPES))
+        ALLOCATE(IPE_SORT(1:NPES))
+!
+        TIME(1)=TIME_LCL
+        ID_PE(1)=MYPE
+!
+!***  COLLECT TIMES AND PE VALUES FROM OTHER PEs
+!
+        DO IPE=1,NPES-1
+          CALL MPI_RECV(REMOTE,2,MPI_REAL,IPE,IPE                      &
+     &                 ,MPI_COMM_COMP,JSTAT,IRECV)
+!
+          TIME(IPE+1)=REMOTE(1)
+          ID_PE(IPE+1)=NINT(REMOTE(2))
+        ENDDO
+!
+!***  NOW GET STATS.
+!***  FIRST THE MAX, MIN, AND MEAN TIMES.
+!
+        TIME_MEAN=0.
+        TIME_MAX=-1.
+        TIME_MIN=1.E10
+        IPE_MAX=-1
+        IPE_MIN=-1
+!
+        DO N=1,NPES
+          TIME_MEAN=TIME_MEAN+TIME(N)
+!
+          IF(TIME(N)>TIME_MAX)THEN
+            TIME_MAX=TIME(N)
+            IPE_MAX=ID_PE(N)
+          ENDIF
+!
+          IF(TIME(N)<TIME_MIN)THEN
+            TIME_MIN=TIME(N)
+            IPE_MIN=ID_PE(N)
+          ENDIF
+!
+        ENDDO
+!
+        TIME_MAX=TIME_MAX*1.E-3
+        TIME_MIN=TIME_MIN*1.E-3
+        TIME_MEAN=TIME_MEAN*1.E-3/REAL(NPES)
+!
+!***  THEN THE MEDIAN TIME.
+!
+        CALL SORT(TIME,NPES,SORT_TIME,IPE_SORT)
+        N_MEDIAN=(NPES+1)/2
+        TIME_MEDIAN=SORT_TIME(N_MEDIAN)*1.E-3
+        IPE_MEDIAN=IPE_SORT(N_MEDIAN)
+!
+!----------------------------------------------------------------------
+      ELSE
+!
+!***  SEND TIME AND PE VALUE TO PE0.
+!
+        REMOTE(1)=TIME_LCL
+        REMOTE(2)=REAL(MYPE)
+!
+        CALL MPI_SEND(REMOTE,2,MPI_REAL,0,MYPE,MPI_COMM_COMP,ISEND)
+!
+      ENDIF
+!----------------------------------------------------------------------
+!
+      CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
+!
+!***  WRITE RESULTS
+!
+      IF(MYPE==0)THEN
+        WRITE(0,100)TITLE
+        WRITE(0,105)TIME_MAX,IPE_MAX
+        WRITE(0,110)TIME_MIN,IPE_MIN
+        WRITE(0,115)TIME_MEDIAN,IPE_MEDIAN
+        WRITE(0,120)TIME_MEAN
+  100   FORMAT(' Time for ',A)
+  105   FORMAT(' Maximum=',G11.5,' for PE ',I2.2)
+  110   FORMAT(' Minimum=',G11.5,' for PE ',I2.2)
+  115   FORMAT(' Median =',G11.5,' for PE ',I2.2)
+  120   FORMAT(' Mean   =',G11.5)
+      ENDIF
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE TIME_STATS
+!
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+      SUBROUTINE SORT(DATA,NPES,DATA_SORTED,IPE_SORTED)
+!----------------------------------------------------------------------
+!***
+!***  SORT DATA FROM MULTIPLE PEs.  SEND BACK THE SORTED DATA ITEMS
+!***  ALONG WITH THE ASSOCIATED TASK IDs.
+!***
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: NPES
+      REAL,DIMENSION(NPES),INTENT(IN) :: DATA
+!
+      INTEGER,DIMENSION(NPES),INTENT(OUT) :: IPE_SORTED
+      REAL,DIMENSION(NPES),INTENT(OUT) :: DATA_SORTED
+!----------------------------------------------------------------------
+      TYPE :: DATA_LINK
+        REAL :: VALUE
+        INTEGER :: IPE
+        TYPE(DATA_LINK),POINTER :: NEXT_VALUE
+      END TYPE
+!----------------------------------------------------------------------
+!
+!***  LOCAL VARIABLES
+!
+!----------------------------------------------------------------------
+      INTEGER :: ISTAT,N
+!
+      TYPE(DATA_LINK),POINTER :: HEAD,TAIL  ! Smallest, largest
+      TYPE(DATA_LINK),POINTER :: PTR_NEW    ! Each new value
+      TYPE(DATA_LINK),POINTER :: PTR1,PTR2  ! Working pointers
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+      pe_loop: DO N=1,NPES
+        ALLOCATE(PTR_NEW,STAT=ISTAT)  ! Location for next data items
+        PTR_NEW%VALUE=DATA(N)
+        PTR_NEW%IPE=N-1
+!
+!----------------------------------------------------------------------
+!***  DETERMINE WHERE IN LIST TO INSERT VALUE.
+!***  FIRST THE INITIAL DATA VALUE.
+!----------------------------------------------------------------------
+!
+!       main: IF(.NOT.ASSOCIATED(HEAD))THEN
+        main: IF(N==1)THEN
+          HEAD=>PTR_NEW
+          TAIL=>HEAD
+          NULLIFY(PTR_NEW%NEXT_VALUE)
+!
+!----------------------------------------------------------------------
+!***  THE NEW VALUE IS LESS THAN THE SMALLEST VALUE ALREADY SORTED.
+!----------------------------------------------------------------------
+!
+        ELSE
+          check: IF(PTR_NEW%VALUE<HEAD%VALUE)THEN
+            PTR_NEW%NEXT_VALUE=>HEAD
+            HEAD=>PTR_NEW
+!
+!----------------------------------------------------------------------
+!***  THE NEW VALUE IS GREATER THAN THE LARGEST VALUE ALREADY SORTED.
+!----------------------------------------------------------------------
+!
+          ELSEIF(PTR_NEW%VALUE>=TAIL%VALUE)THEN
+            TAIL%NEXT_VALUE=>PTR_NEW  ! This is what connects the former
+                                      ! final value in the list to
+                                      ! the new value being appended.
+            TAIL=>PTR_NEW
+            NULLIFY(TAIL%NEXT_VALUE)
+!
+!----------------------------------------------------------------------
+!***  THE NEW VALUE IS IN BETWEEN VALUES ALREADY SORTED.
+!----------------------------------------------------------------------
+!
+          ELSE
+            PTR1=>HEAD
+            PTR2=>PTR1%NEXT_VALUE
+!
+            search: DO
+              IF((PTR_NEW%VALUE>=PTR1%VALUE).AND.                      &
+     &           (PTR_NEW%VALUE<PTR2%VALUE))THEN
+                PTR_NEW%NEXT_VALUE=>PTR2
+                PTR1%NEXT_VALUE=>PTR_NEW
+                EXIT search
+              ENDIF
+!
+              PTR1=>PTR2
+              PTR2=>PTR2%NEXT_VALUE
+            ENDDO search
+!
+          ENDIF check
+!
+        ENDIF main
+!
+      ENDDO pe_loop
+!
+!----------------------------------------------------------------------
+!***  COLLECT THE SORTED NUMBERS FROM THE LINKED LIST.
+!----------------------------------------------------------------------
+!
+      PTR1=>HEAD
+!
+      DO N=1,NPES
+!       IF(.NOT.ASSOCIATED(PTR_NEW))EXIT
+        DATA_SORTED(N)=PTR1%VALUE
+        IPE_SORTED(N)=PTR1%IPE
+        PTR1=>PTR1%NEXT_VALUE
+      ENDDO
+!
+      DEALLOCATE(PTR_NEW)
+      NULLIFY (HEAD,TAIL,PTR1,PTR2)
+!----------------------------------------------------------------------
+      END SUBROUTINE SORT
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+      SUBROUTINE FIELD_STATS(FIELD,MYPE,MPI_COMM_COMP                  &
+     &                      ,IDS,IDE,JDS,JDE,KDS,KDE                   &
+     &                      ,IMS,IME,JMS,JME,KMS,KME                   &
+     &                      ,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+!***
+!***  GENERATE STANDARD LAYER STATISTICS FOR THE DESIRED FIELD.
+!***
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+!----------------------------------------------------------------------
+      INCLUDE "mpif.h"
+!----------------------------------------------------------------------
+!
+      INTEGER,INTENT(IN) :: MPI_COMM_COMP,MYPE
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: FIELD
+!
+!----------------------------------------------------------------------
+!***  LOCAL
+!----------------------------------------------------------------------
+!
+      INTEGER,PARAMETER :: DOUBLE=SELECTED_REAL_KIND(15,300)
+!
+      INTEGER :: I,IEND,IRTN,I_BY_J,J,K,KFLIP
+!
+      REAL :: FIKJ,FMAXK,FMINK
+      REAL(KIND=DOUBLE) :: F_MEAN,POINTS,RMS,ST_DEV,SUMFK,SUMF2K
+      REAL,DIMENSION(KTS:KTE) :: FMAX,FMAX_0,FMIN,FMIN_0
+      REAL(KIND=DOUBLE),DIMENSION(KTS:KTE) :: SUMF,SUMF_0,SUMF2,SUMF2_0
+!----------------------------------------------------------------------
+!
+      I_BY_J=(IDE-IDS)*(JDE-JDS)-(JDE-JDS-1)/2  ! This assumes that
+                                                ! IDE and JDE are each
+                                                ! one greater than the
+                                                ! true grid size.
+!
+      layer_loop:  DO K=KTS,KTE
+!
+        FMAXK=-1.E10
+        FMINK=1.E10
+        SUMFK=0.
+        SUMF2K=0.
+!
+        DO J=JTS,JTE
+          IEND=MIN(ITE,IDE-1)
+          IF(MOD(J,2)==0.AND.ITE==IDE-1)IEND=IEND-1
+          DO I=ITS,IEND
+            FIKJ=FIELD(I,K,J)
+            FMAXK=MAX(FMAXK,FIKJ)
+            FMINK=MIN(FMINK,FIKJ)
+            SUMFK=SUMFK+FIKJ
+            SUMF2K=SUMF2K+FIKJ*FIKJ
+          ENDDO
+        ENDDO
+!
+        FMAX(K)=FMAXK
+        FMIN(K)=FMINK
+        SUMF(K)=SUMFK
+        SUMF2(K)=SUMF2K
+!
+      ENDDO layer_loop
+!
+!----------------------------------------------------------------------
+!***  GLOBAL STATS
+!----------------------------------------------------------------------
+!
+      CALL MPI_REDUCE(SUMF,SUMF_0,KTE,MPI_REAL8,MPI_SUM,0              &
+     &               ,MPI_COMM_COMP,IRTN)
+      CALL MPI_REDUCE(SUMF2,SUMF2_0,KTE,MPI_REAL8,MPI_SUM,0            &
+     &               ,MPI_COMM_COMP,IRTN)
+      CALL MPI_REDUCE(FMAX,FMAX_0,KTE,MPI_REAL,MPI_MAX,0               &
+     &               ,MPI_COMM_COMP,IRTN)
+      CALL MPI_REDUCE(FMIN,FMIN_0,KTE,MPI_REAL,MPI_MIN,0               &
+     &               ,MPI_COMM_COMP,IRTN)
+!
+      IF(MYPE==0)THEN
+        POINTS=I_BY_J
+        DO K=KTE,KTS,-1
+          F_MEAN=SUMF_0(K)/POINTS
+          ST_DEV=SQRT((POINTS*SUMF2_0(K)-SUMF_0(K)*SUMF_0(K))/         &
+     &                (POINTS*(POINTS-1)))
+          RMS=SQRT(SUMF2_0(K)/POINTS)
+          KFLIP=KTE-K+1
+          WRITE(0,101)KFLIP,FMAX_0(K),FMIN_0(K)
+          WRITE(0,102)F_MEAN,ST_DEV,RMS
+  101     FORMAT(' LAYER=',I2,' MAX=',E13.6,' MIN=',E13.6)
+  102     FORMAT(9X,' MEAN=',E13.6,' STDEV=',E13.6,' RMS=',E13.6)
+        ENDDO
+      ENDIF
+!----------------------------------------------------------------------
+      END SUBROUTINE FIELD_STATS
+!----------------------------------------------------------------------
+      FUNCTION TIMEF()
+      REAL*8 TIMEF
+      INTEGER IC, IR
+      CALL SYSTEM_CLOCK(COUNT=IC, COUNT_RATE=IR)
+      TIMEF=REAL(IC)/REAL(IR) * 1000.0
+      END
Index: trunk/WRF.COMMON/WRFV2/dyn_nmm/start_domain_nmm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/dyn_nmm/start_domain_nmm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/dyn_nmm/start_domain_nmm.F	(revision 2744)
@@ -0,0 +1,2093 @@
+!#define NO_RESTRICT_ACCEL
+!#define NO_GFDLETAINIT
+!#define NO_UPSTREAM_ADVECTION
+!----------------------------------------------------------------------
+!
+      SUBROUTINE START_DOMAIN_NMM(GRID, allowed_to_read                &
+!
+#include <nmm_dummy_args.inc>
+!
+     &           )
+!----------------------------------------------------------------------
+!
+      USE MODULE_DOMAIN
+      USE MODULE_DRIVER_CONSTANTS
+      USE module_model_constants
+      USE MODULE_CONFIGURE
+      USE MODULE_WRF_ERROR
+      USE MODULE_MPP
+      USE MODULE_CTLBLK
+      USE MODULE_DM
+!
+      USE MODULE_IGWAVE_ADJUST,ONLY: PDTE, PFDHT, DDAMP
+      USE MODULE_ADVECTION,    ONLY: ADVE, VAD2, HAD2
+      USE MODULE_NONHY_DYNAM,  ONLY: VADZ, HADZ
+      USE MODULE_DIFFUSION_NMM,ONLY: HDIFF
+      USE MODULE_BNDRY_COND,   ONLY: BOCOH, BOCOV
+      USE MODULE_PHYSICS_INIT
+!     USE MODULE_RA_GFDLETA
+!
+      USE MODULE_EXT_INTERNAL
+!
+#ifdef WRF_CHEM
+   USE MODULE_AEROSOLS_SORGAM, ONLY: SUM_PM_SORGAM
+   USE MODULE_MOSAIC_DRIVER, ONLY: SUM_PM_MOSAIC
+#endif
+!
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+!***
+!***  Arguments
+!***
+      TYPE(DOMAIN),INTENT(INOUT) :: GRID
+      LOGICAL , INTENT(IN)       :: allowed_to_read
+!
+#include <nmm_dummy_decl.inc>
+!
+      TYPE(GRID_CONFIG_REC_TYPE) :: CONFIG_FLAGS
+!
+#ifdef WRF_CHEM
+   REAL        RGASUNIV ! universal gas constant [ J/mol-K ]
+   PARAMETER ( RGASUNIV = 8.314510 )
+#endif
+!
+!***
+!***  LOCAL DATA
+!***
+      INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE                               &
+     &          ,IMS,IME,JMS,JME,KMS,KME                                &
+     &          ,IPS,IPE,JPS,JPE,KPS,KPE
+!
+      INTEGER :: ERROR,LOOP
+
+      REAL,ALLOCATABLE,DIMENSION(:) :: PHALF
+!
+      REAL :: EPSB=0.1,EPSIN=9.8
+!
+      INTEGER :: JHL=7
+!
+      INTEGER :: I,IEND,IER,IERR,IFE,IFS,IHH,IHL,IHRSTB,II,IRTN        &
+     &          ,ISIZ1,ISIZ2,ISTART,IX,J,J00,JFE,JFS,JHH,JJ             &
+     &          ,JM1,JM2,JM3,JP1,JP2,JP3,JX                             &
+     &          ,K,K400,KBI,KBI2,KCCO2,KNT,KNTI,KOFF,KOFV               &
+     &          ,LB,LLMH,LMHK,LMVK,LRECBC                               &
+     &          ,N,NMAP,NRADLH,NRADSH,NREC,NS,RECL,STAT                 &
+     &          ,STEPBL,STEPCU,STEPRA
+      INTEGER :: i_m
+!
+      INTEGER :: ILPAD2,IRPAD2,JBPAD2,JTPAD2
+      INTEGER :: ITS,ITE,JTS,JTE,KTS,KTE,KK,L
+!
+      INTEGER,DIMENSION(3) :: LPTOP
+!
+      REAL :: ADDL,APELM,APELMNW,APEM1,CAPA,CLOGES,DPLM,DZLM,EPS,ESE   &
+     &       ,FAC1,FAC2,PDIF,PLM,PM1,PSFCK,PSS,PSUM,QLM,RANG           &
+     &       ,SLPM,TERM1,THLM,TIME,TLM,TSFCK,ULM,VLM
+!
+!!!   REAL :: BLDT,CWML,EXNSFC,G_INV,PLYR,PSFC,ROG,SFCZ,THSIJ,TL
+      REAL :: CWML,EXNSFC,G_INV,PLYR,PSURF,ROG,SFCZ,THSIJ,TL
+      REAL :: TEND
+
+!
+!!!   REAL,ALLOCATABLE,DIMENSION(:,:) :: RAINBL,RAINNC,RAINNC           &
+      INTEGER,ALLOCATABLE,DIMENSION(:,:) :: LOWLYR
+      REAL,ALLOCATABLE,DIMENSION(:) :: SFULL,SMID
+!state    real   DZS             l        dyn_em      -         Z     ir 
+!state    real  CLDFRA          ikj      dyn_em        1         -      r
+!state    real  RQCBLTEN        ikj      dyn_em        1         -      r
+!state    real  RQIBLTEN        ikj      dyn_em        1         -      r
+!state    real  RQVBLTEN        ikj      dyn_em        1         -      r
+!state    real  RTHBLTEN        ikj      dyn_em        1         -      r
+!state    real  RUBLTEN         ikj      dyn_em        1         -      r
+!state    real  RVBLTEN         ikj      dyn_em        1         -      r
+!state    real  RQCCUTEN        ikj      dyn_em        1         -      r
+!state    real  RQICUTEN        ikj      dyn_em        1         -      r
+!state    real  RQRCUTEN        ikj      dyn_em        1         -      r
+!state    real  RQSCUTEN        ikj      dyn_em        1         -      r
+!state    real  RQVCUTEN        ikj      dyn_em        1         -      r
+!state    real  RTHCUTEN        ikj      dyn_em        1         -      r
+!state    real  RTHRATEN        ikj      dyn_em        1         -      r
+!state    real  RTHRATENLW      ikj      dyn_em        1         -      r
+!state    real  RTHRATENSW      ikj      dyn_em        1         -      r
+!state    real   TSLB           ilj       dyn_em      1         Z     irh
+!state    real   ZS              l        dyn_em      -         Z     ir 
+      REAL,ALLOCATABLE,DIMENSION(:) :: DZS,ZS
+      REAL,ALLOCATABLE,DIMENSION(:,:,:) :: RQCBLTEN,RQIBLTEN            &
+     &                                    ,RQVBLTEN,RTHBLTEN            &
+     &                                    ,RUBLTEN,RVBLTEN              &
+     &                                    ,RQCCUTEN,RQICUTEN,RQRCUTEN   &
+     &                                    ,RQSCUTEN,RQVCUTEN,RTHCUTEN   &
+     &                                    ,RTHRATEN                     &
+     &                                    ,RTHRATENLW,RTHRATENSW
+      REAL,ALLOCATABLE,DIMENSION(:,:) :: EMISS,GLW,HFX                  &
+     &                                  ,NCA                            &
+     &                                  ,QFX,RAINBL,RAINC,RAINNC        &
+     &                                  ,RAINNCV                        &
+     &                                  ,SNOWC,THC,TMN,TSFC
+
+      REAL,ALLOCATABLE,DIMENSION(:,:) :: Z0_DUM, ALBEDO_DUM
+!
+      REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZINT,RRI,CONVFAC
+!     REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZMID
+#if 0
+      REAL,ALLOCATABLE,DIMENSION(:,:,:) :: W0AVG
+#endif
+      LOGICAL :: E_BDY,N_BDY,S_BDY,W_BDY,WARM_RAIN,ADV_MOIST_COND
+      LOGICAL :: START_OF_SIMULATION
+      integer :: jam,retval
+      character(20) :: seeout="hi08.t00z.nhbmeso"
+      real :: dummyx(791)
+      integer myproc
+      real :: dsig,dsigsum,pdbot,pdtot,rpdtot
+      real :: fisx,ht,prodx,rg
+      integer :: i_t=096,j_t=195,n_t=11
+      integer :: i_u=49,j_u=475,n_u=07
+      integer :: i_v=49,j_v=475,n_v=07
+      integer :: num_ozmixm, num_aerosolc
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+! z0base new
+ 
+      REAL,DIMENSION(0:30) :: VZ0TBL_24
+      VZ0TBL_24= (/0.,                                                 &
+     &            1.00,  0.07,  0.07,  0.07,  0.07,  0.15,             &
+     &            0.08,  0.03,  0.05,  0.86,  0.80,  0.85,             &
+     &            2.65,  1.09,  0.80,  0.001, 0.04,  0.05,             &
+     &            0.01,  0.04,  0.06,  0.05,  0.03,  0.001,            &
+     &            0.000, 0.000, 0.000, 0.000, 0.000, 0.000/)
+ 
+! end z0base new
+
+#include "deref_kludge.h"
+
+!
+!----------------------------------------------------------------------
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+#ifdef DM_PARALLEL
+#    include <nmm_data_calls.inc>
+#endif
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+      CALL GET_IJK_FROM_GRID(GRID,                                     &
+     &                       IDS,IDE,JDS,JDE,KDS,KDE,                  &
+     &                       IMS,IME,JMS,JME,KMS,KME,                  &
+     &                       IPS,IPE,JPS,JPE,KPS,KPE)
+!
+      ITS=IPS
+      ITE=IPE
+      JTS=JPS
+      JTE=JPE
+      KTS=KPS
+      KTE=KPE
+
+      CALL model_to_grid_config_rec(grid%id,model_config_rec           &
+     &                             ,config_flags)
+!
+        RESTRT=config_flags%restart
+!       write(0,*) 'set RESTRT to: ', RESTRT
+
+#if 1
+      IF(IME.GT. NMM_MAX_DIM )THEN
+        WRITE(wrf_err_message,*)                                       &
+         'start_domain_nmm ime (',ime,') > ',NMM_MAX_DIM,    &
+         '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
+        CALL WRF_ERROR_FATAL(wrf_err_message)
+      ENDIF
+!
+      IF(JME.GT. NMM_MAX_DIM )THEN
+        WRITE(wrf_err_message,*)                                       &
+         'start_domain_nmm jme (',jme,') > ',NMM_MAX_DIM,    &
+         '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
+        CALL WRF_ERROR_FATAL(wrf_err_message)
+      ENDIF
+#else
+      IF(IMS.GT.-2.OR.IME.GT. NMM_MAX_DIM )THEN
+        WRITE(wrf_err_message,*)                                       &
+         'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM,    &
+         '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
+        CALL WRF_ERROR_FATAL(wrf_err_message)
+      ENDIF
+!
+      IF(JMS.GT.-2.OR.JME.GT. NMM_MAX_DIM )THEN
+        WRITE(wrf_err_message,*)                                       &
+         'start_domain_nmm jms(',jms,' > -2 or jme (',jme,') > ',NMM_MAX_DIM,    &
+         '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
+        CALL WRF_ERROR_FATAL(wrf_err_message)
+      ENDIF
+#endif
+!
+!---------------------------------------------------------------------- 
+!
+      WRITE(0,196)IHRST,IDAT
+      WRITE(LIST,196)IHRST,IDAT
+  196 FORMAT(' FORECAST BEGINS ',I2,' GMT ',2(I2,'/'),I4)
+!!!!!!tlb
+!!!! For now, set NPES to 1
+      NPES=1
+!!!!!!tlb
+      MY_IS_GLB=IPS
+      MY_IE_GLB=IPE-1
+      MY_JS_GLB=JPS
+      MY_JE_GLB=JPE-1
+!
+      IM=IPE-1
+      JM=JPE-1
+!!!!!!!!!
+!! All "my" variables defined below have had the IDE or JDE specification
+!! reduced by 1
+!!!!!!!!!!!
+
+      MYIS=MAX(IDS,IPS)
+      MYIE=MIN(IDE-1,IPE)
+      MYJS=MAX(JDS,JPS)
+      MYJE=MIN(JDE-1,JPE)
+
+      MYIS1  =MAX(IDS+1,IPS)
+      MYIE1  =MIN(IDE-2,IPE)
+      MYJS2  =MAX(JDS+2,JPS)
+      MYJE2  =MIN(JDE-3,JPE)
+!
+      MYIS_P1=MAX(IDS,IPS-1)
+      MYIE_P1=MIN(IDE-1,IPE+1)
+      MYIS_P2=MAX(IDS,IPS-2)
+      MYIE_P2=MIN(IDE-1,IPE+2)
+      MYIS_P3=MAX(IDS,IPS-3)
+      MYIE_P3=MIN(IDE-1,IPE+3)
+      MYJS_P3=MAX(JDS,JPS-3)
+      MYJE_P3=MIN(JDE-1,JPE+3)
+      MYIS_P4=MAX(IDS,IPS-4)
+      MYIE_P4=MIN(IDE-1,IPE+4)
+      MYJS_P4=MAX(JDS,JPS-4)
+      MYJE_P4=MIN(JDE-1,JPE+4)
+      MYIS_P5=MAX(IDS,IPS-5)
+      MYIE_P5=MIN(IDE-1,IPE+5)
+      MYJS_P5=MAX(JDS,JPS-5)
+      MYJE_P5=MIN(JDE-1,JPE+5)
+!
+      MYIS1_P1=MAX(IDS+1,IPS-1)
+      MYIE1_P1=MIN(IDE-2,IPE+1)
+      MYIS1_P2=MAX(IDS+1,IPS-2)
+      MYIE1_P2=MIN(IDE-2,IPE+2)
+!
+      MYJS1_P1=MAX(JDS+1,JPS-1)
+      MYJS2_P1=MAX(JDS+2,JPS-1)
+      MYJE1_P1=MIN(JDE-2,JPE+1)
+      MYJE2_P1=MIN(JDE-3,JPE+1)
+      MYJS1_P2=MAX(JDS+1,JPS-2)
+      MYJE1_P2=MIN(JDE-2,JPE+2)
+      MYJS2_P2=MAX(JDS+2,JPS-2)
+      MYJE2_P2=MIN(JDE-3,JPE+2)
+      MYJS1_P3=MAX(JDS+1,JPS-3)
+      MYJE1_P3=MIN(JDE-2,JPE+3)
+      MYJS2_P3=MAX(JDS+2,JPS-3)
+      MYJE2_P3=MIN(JDE-3,JPE+3)
+!!!!!!!!!!!
+!
+#ifdef DM_PARALLEL
+
+      CALL WRF_GET_MYPROC(MYPROC)
+      MYPE=MYPROC
+
+#  include <HALO_NMM_INIT_1.inc>
+#  include <HALO_NMM_INIT_2.inc>
+#  include <HALO_NMM_INIT_3.inc>
+#  include <HALO_NMM_INIT_4.inc>
+#  include <HALO_NMM_INIT_5.inc>
+#  include <HALO_NMM_INIT_6.inc>
+#  include <HALO_NMM_INIT_7.inc>
+#  include <HALO_NMM_INIT_8.inc>
+#  include <HALO_NMM_INIT_9.inc>
+#  include <HALO_NMM_INIT_10.inc>
+#  include <HALO_NMM_INIT_11.inc>
+#  include <HALO_NMM_INIT_12.inc>
+
+#  include <HALO_NMM_INIT_13.inc>
+
+!        CALL wrf_shutdown
+!        stop
+
+#  include <HALO_NMM_INIT_14.inc>
+#  include <HALO_NMM_INIT_15.inc>
+#  include <HALO_NMM_INIT_16.inc>
+#  include <HALO_NMM_INIT_17.inc>
+#  include <HALO_NMM_INIT_18.inc>
+#  include <HALO_NMM_INIT_19.inc>
+#  include <HALO_NMM_INIT_20.inc>
+#  include <HALO_NMM_INIT_21.inc>
+#  include <HALO_NMM_INIT_22.inc>
+#  include <HALO_NMM_INIT_23.inc>
+#  include <HALO_NMM_INIT_24.inc>
+#  include <HALO_NMM_INIT_25.inc>
+#  include <HALO_NMM_INIT_26.inc>
+#  include <HALO_NMM_INIT_27.inc>
+#  include <HALO_NMM_INIT_28.inc>
+#  include <HALO_NMM_INIT_29.inc>
+#  include <HALO_NMM_INIT_30.inc>
+#  include <HALO_NMM_INIT_31.inc>
+#  include <HALO_NMM_INIT_32.inc>
+#  include <HALO_NMM_INIT_33.inc>
+#  include <HALO_NMM_INIT_34.inc>
+#  include <HALO_NMM_INIT_35.inc>
+#  include <HALO_NMM_INIT_36.inc>
+#  include <HALO_NMM_INIT_37.inc>
+#  include <HALO_NMM_INIT_38.inc>
+#  include <HALO_NMM_INIT_39.inc>
+#endif
+
+      DO J=MYJS_P4,MYJE_P4
+        IHEG(J)=MOD(J+1,2)
+        IHWG(J)=IHEG(J)-1
+        IVEG(J)=MOD(J,2)
+        IVWG(J)=IVEG(J)-1
+      ENDDO
+!
+      DO J=MYJS_P4,MYJE_P4
+        IVW(J)=IVWG(J)
+        IVE(J)=IVEG(J)
+        IHE(J)=IHEG(J)
+        IHW(J)=IHWG(J)
+      ENDDO
+!
+      CAPA=R_D/CP
+      LM=KPE-KPS+1
+!
+      IFS=IPS
+      JFS=JPS
+      JFE=MIN(JPE,JDE-1)
+      IFE=MIN(IPE,IDE-1)
+!
+      IF(.NOT.RESTRT)THEN
+        DO J=JFS,JFE
+        DO I=IFS,IFE
+          LLMH=LMH(I,J)
+          KOFF=KPE-1-LLMH
+          PDSL(I,J)  =PD(I,J)*RES(I,J)
+          PREC(I,J)  =0.
+          ACPREC(I,J)=0.
+          CUPREC(I,J)=0.
+          rg=1./g
+          ht=fis(i,j)*rg
+!!!       fisx=ht*g
+!          fisx=max(fis(i,j),0.)
+!          prodx=Z0(I,J)*Z0MAX
+!          Z0(I,J)    =SM(I,J)*Z0SEA+(1.-SM(I,J))*                      &
+!     &                (Z0(I,J)*Z0MAX+FISx    *FCM+Z0LAND)
+!!!  &                (prodx        +FISx    *FCM+Z0LAND)
+          QSH(I,J)   =0.
+          AKMS(I,J)  =0.
+          AKHS(I,J)  =0.
+          TWBS(I,J)  =0.
+          QWBS(I,J)  =0.
+          CLDEFI(I,J)=1.
+!!!!          HTOP(I,J)  =REAL(LLMH)
+!!!!          HBOT(I,J)  =REAL(LLMH)
+          HTOP(I,J)  =REAL(KTS)
+          HTOPD(I,J) =REAL(KTS)
+          HTOPS(I,J) =REAL(KTS)
+          HBOT(I,J)  =REAL(KTE)
+          HBOTD(I,J) =REAL(KTE)
+          HBOTS(I,J) =REAL(KTE)
+!***
+!***  AT THIS POINT, WE MUST CALCULATE THE INITIAL POTENTIAL TEMPERATURE
+!***  OF THE SURFACE AND OF THE SUBGROUND.
+!***  EXTRAPOLATE DOWN FOR INITIAL SURFACE POTENTIAL TEMPERATURE.
+!***  ALSO DO THE SHELTER PRESSURE.
+!***
+          PM1=AETA1(KOFF+1)*PDTOP+AETA2(KOFF+1)*PDSL(I,J)+PT
+          APEM1=(1.E5/PM1)**CAPA
+
+        IF (NMM_TSK(I,J) .ge. 200.) THEN ! have a specific skin temp, use it
+               THS(I,J)=NMM_TSK(I,J)*APEM1
+               TSFCK=NMM_TSK(I,J)
+	ELSE ! use lowest layer as a proxy
+          THS(I,J)=T(I,KOFF+1,J)*APEM1
+          TSFCK=T(I,KOFF+1,J)
+	ENDIF
+
+!	if (I .eq. IFE/2 .and. J .eq. JFE/2) then
+!	write(6,*) 'I,J,T(I,KOFF+1,J),NMM_TSK(I,J):: ', I,J,T(I,KOFF+1,J),NMM_TSK(I,J)
+!	write(6,*) 'THS(I,J): ', THS(I,J)
+!	endif
+
+          PSFCK=PD(I,J)+PDTOP+PT
+!
+          IF(SM(I,J).LT.0.5) THEN
+            QSH(I,J)=PQ0/PSFCK*EXP(A2*(TSFCK-A3)/(TSFCK-A4))
+          ELSEIF(SM(I,J).GT.0.5) THEN
+            THS(I,J)=SST(I,J)*(1.E5/(PD(I,J)+PDTOP+PT))**CAPA
+          ENDIF
+!
+          TERM1=-0.068283/T(I,KOFF+1,J)
+          PSHLTR(I,J)=(PD(I,J)+PDTOP+PT)*EXP(TERM1)
+!
+          USTAR(I,J)=0.1
+          THZ0(I,J)=THS(I,J)
+          QZ0(I,J)=QSH(I,J)
+          UZ0(I,J)=0.
+          VZ0(I,J)=0.
+! 
+        ENDDO
+        ENDDO
+
+!***
+!***  INITIALIZE 3D MASKS
+!***
+        DO J=JFS,JFE
+          DO K=KPS,KPE
+          DO I=IFS,IFE
+            HTM(I,K,J)=1.
+            VTM(I,K,J)=1.
+          ENDDO
+          ENDDO
+        ENDDO
+!***
+!***  INITIALIZE CLOUD FIELDS
+!***
+      IF (MAXVAL(CWM) .gt. 0. .and. MAXVAL(CWM) .lt. 1.) then
+        write(0,*) 'appear to have CWM values...do not zero'
+      ELSE
+        write(0,*) 'zeroing CWM'
+        DO J=JFS,JFE
+          DO K=KPS,KPE
+          DO I=IFS,IFE
+            CWM(I,K,J)=0.
+          ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+!***
+!***  INITIALIZE ACCUMULATOR ARRAYS TO ZERO.
+!***
+        ARDSW=0.0
+        ARDLW=0.0
+        ASRFC=0.0
+        AVRAIN=0.0
+        AVCNVC=0.0
+!
+        DO J=JFS,JFE
+        DO I=IFS,IFE
+          ACFRCV(I,J)=0.
+          NCFRCV(I,J)=0
+          ACFRST(I,J)=0.
+          NCFRST(I,J)=0
+          ACSNOW(I,J)=0.
+          ACSNOM(I,J)=0.
+          SSROFF(I,J)=0.
+          BGROFF(I,J)=0.
+          ALWIN(I,J) =0.
+          ALWOUT(I,J)=0.
+          ALWTOA(I,J)=0.
+          ASWIN(I,J) =0.
+          ASWOUT(I,J)=0.
+          ASWTOA(I,J)=0.
+          SFCSHX(I,J)=0.
+          SFCLHX(I,J)=0.
+          SUBSHX(I,J)=0.
+          SNOPCX(I,J)=0.
+          SFCUVX(I,J)=0.
+          SFCEVP(I,J)=0.
+          POTEVP(I,J)=0.
+          POTFLX(I,J)=0.
+        ENDDO
+        ENDDO
+!***
+!***  INITIALIZE SATURATION SPECIFIC HUMIDITY OVER THE WATER.
+!***
+        EPS=R_D/R_V
+!
+        DO J=JFS,JFE
+        DO I=IFS,IFE
+          IF(SM(I,J).GT.0.5)THEN
+            CLOGES =-CM1/SST(I,J)-CM2*ALOG10(SST(I,J))+CM3
+            ESE    = 10.**(CLOGES+2.)
+            QSH(I,J)= SM(I,J)*EPS*ESE/(PD(I,J)+PDTOP+PT-ESE*(1.-EPS))
+          ENDIF
+        ENDDO
+        ENDDO
+!***  
+!***  INITIALIZE TURBULENT KINETIC ENERGY (TKE) TO A SMALL
+!***  VALUE (EPSQ2) ABOVE GROUND.  SET TKE TO ZERO IN THE
+!***  THE LOWEST MODEL LAYER.  IN THE LOWEST TWO ATMOSPHERIC
+!***  ETA LAYERS SET TKE TO A SMALL VALUE (Q2INI).
+!***
+!***EROGERS: add check for realistic values of q2
+!
+      IF (MAXVAL(Q2) .gt. epsq2 .and. MAXVAL(Q2) .lt. 200.) then
+        write(0,*) 'appear to have Q2 values...do not zero'
+      ELSE
+        write(0,*) 'zeroing Q2'
+        DO J=JFS,JFE
+        DO K=KPS,KPE-1
+        DO I=IFS,IFE
+          Q2(I,K,J)=HTM(I,K+1,J)*HBM2(I,J)*EPSQ2
+        ENDDO
+        ENDDO
+        ENDDO
+!
+        DO J=JFS,JFE
+        DO I=IFS,IFE
+          Q2(I,LM,J)    = 0.
+          LLMH          = LMH(I,J)
+          Q2(I,LLMH-2,J)= HBM2(I,J)*Q2INI
+          Q2(I,LLMH-1,J)= HBM2(I,J)*Q2INI
+        ENDDO
+        ENDDO
+      ENDIF
+!***  
+!***  PAD ABOVE GROUND SPECIFIC HUMIDITY IF IT IS TOO SMALL.
+!***  INITIALIZE LATENT HEATING ACCUMULATION ARRAYS.
+!***
+        DO J=JFS,JFE
+        DO K=KPS,KPE
+        DO I=IFS,IFE
+          IF(Q(I,K,J).LT.EPSQ)Q(I,K,J)=EPSQ*HTM(I,K,J)
+          TRAIN(I,K,J)=0.
+          TCUCN(I,K,J)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+!
+!***
+!***  INITIALIZE MAX/MIN TEMPERATURES.
+!***
+        DO J=JFS,JFE
+        DO I=IFS,IFE
+          TLMAX(I,J)=T(I,KPS,J)
+          TLMIN(I,J)=T(I,KPS,J)
+        ENDDO
+        ENDDO
+!
+!----------------------------------------------------------------------
+!***  END OF SCRATCH START INITIALIZATION BLOCK.
+!----------------------------------------------------------------------
+!
+        CALL wrf_message('INIT:  INITIALIZED ARRAYS FOR CLEAN START')
+      ENDIF ! <--- (not restart)
+
+      IF(NEST)THEN
+        DO J=JFS,JFE
+        DO I=IFS,IFE
+!
+          LLMH=LMH(I,J)
+          KOFF=KPE-1-LLMH
+!
+          IF(T(I,KOFF+1,J).EQ.0.)THEN
+            T(I,KOFF+1,J)=T(I,KOFF+2,J)
+          ENDIF
+!
+          TERM1=-0.068283/T(I,KOFF+1,J)
+          PSHLTR(I,J)=(PD(I,J)+PDTOP+PT)*EXP(TERM1)
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!----------------------------------------------------------------------
+!***  RESTART INITIALIZING.  CHECK TO SEE IF WE NEED TO ZERO
+!***  ACCUMULATION ARRAYS.
+!----------------------------------------------------------------------
+
+      TSPH=3600./GRID%DT ! needed?
+      NPHS0=GRID%NPHS
+
+      IF(MYPE==0)THEN
+        write(0,*)' start_nmm TSTART=',grid%tstart
+        write(0,*)' start_nmm TPREC=',grid%tprec
+        write(0,*)' start_nmm THEAT=',grid%theat
+        write(0,*)' start_nmm TCLOD=',grid%tclod
+        write(0,*)' start_nmm TRDSW=',grid%trdsw
+        write(0,*)' start_nmm TRDLW=',grid%trdlw
+        write(0,*)' start_nmm TSRFC=',grid%tsrfc
+        write(0,*)' start_nmm PCPFLG=',grid%pcpflg
+      ENDIF
+
+      NSTART = INT(grid%TSTART*TSPH+0.5)
+!
+      NTSD = NSTART
+
+
+!! want non-zero values for NPREC, NHEAT type vars to avoid problems
+!! with mod statements below.
+
+      NPREC  = INT(grid%TPREC *TSPH+0.5)
+      NHEAT  = INT(grid%THEAT *TSPH+0.5)
+      NCLOD  = INT(grid%TCLOD *TSPH+0.5)
+      NRDSW  = INT(grid%TRDSW *TSPH+0.5)
+      NRDLW  = INT(grid%TRDLW *TSPH+0.5)
+      NSRFC  = INT(grid%TSRFC *TSPH+0.5)
+
+      IF(RESTRT)THEN
+!
+!***
+!***    AVERAGE CLOUD AMOUNT ARRAY
+!***
+        IF(MOD(NTSD,NCLOD).LT.GRID%NPHS)THEN
+          CALL wrf_message('  ZERO AVG CLD AMT ARRAY')
+          DO J=JFS,JFE
+          DO I=IFS,IFE
+            ACFRCV(I,J)=0.
+            NCFRCV(I,J)=0
+            ACFRST(I,J)=0.
+            NCFRST(I,J)=0
+          ENDDO
+          ENDDO
+        ENDIF
+!***  
+!***     GRID-SCALE AND CONVECTIVE LATENT HEATING ARRAYS.
+!***  
+        IF(MOD(NTSD,NHEAT).LT.GRID%NCNVC)THEN
+          CALL wrf_message('  ZERO ACCUM LATENT HEATING ARRAYS')
+!
+          AVRAIN=0.
+          AVCNVC=0.
+          DO J=JFS,JFE
+          DO K=KPS,KPE
+          DO I=IFS,IFE
+            TRAIN(I,K,J)=0.
+            TCUCN(I,K,J)=0.
+          ENDDO
+          ENDDO
+          ENDDO
+        ENDIF
+!***
+!***  IF THIS IS NOT A NESTED RUN, INITIALIZE TKE
+!***
+!       IF(.NOT.NEST)THEN
+!         DO K=1,LM
+!           DO J=JFS,JFE
+!           DO I=IFS,IFE
+!             Q2(I,K,J)=AMAX1(Q2(I,K,J)*HBM2(I,J),EPSQ2)
+!           ENDDO
+!           ENDDO
+!         ENDDO
+!       ENDIF
+!***
+!***  CLOUD EFFICIENCY
+!***
+!       DO J=JFS,JFE
+!       DO I=IFS,IFE
+!!!       CLDEFI(I,J)=AVGEFI*SM(I,J)+STEFI*(1.-SM(I,J))
+!         CLDEFI(I,J)=1.
+!       ENDDO
+!       ENDDO
+!***
+!***  TOTAL AND CONVECTIVE PRECIPITATION ARRAYS.
+!***  TOTAL SNOW AND SNOW MELT ARRAYS.
+!***  STORM SURFACE AND BASE GROUND RUN OFF ARRAYS.
+!     
+        IF(MOD(NTSD,NPREC).LT.GRID%NPHS)THEN
+          CALL wrf_message('  ZERO ACCUM PRECIP ARRAYS')
+          DO J=JFS,JFE
+          DO I=IFS,IFE
+            ACPREC(I,J)=0.
+            CUPREC(I,J)=0.
+            ACSNOW(I,J)=0.
+            ACSNOM(I,J)=0.
+            SSROFF(I,J)=0.
+            BGROFF(I,J)=0.
+          ENDDO
+          ENDDO
+        ENDIF
+!***  
+!***  LONG WAVE RADIATION ARRAYS.
+!***  
+        IF(MOD(NTSD,NRDLW).LT.GRID%NPHS)THEN
+          CALL wrf_message('  ZERO ACCUM LW RADTN ARRAYS')
+          ARDLW=0.
+          DO J=JFS,JFE
+          DO I=IFS,IFE
+            ALWIN(I,J) =0.
+            ALWOUT(I,J)=0.
+            ALWTOA(I,J)=0.
+          ENDDO
+          ENDDO
+        ENDIF
+!***  
+!***  SHORT WAVE RADIATION ARRAYS.
+!***  
+        IF(MOD(NTSD,NRDSW).LT.GRID%NPHS)THEN
+          CALL wrf_message('  ZERO ACCUM SW RADTN ARRAYS')
+          ARDSW=0.
+          DO J=JFS,JFE
+          DO I=IFS,IFE
+            ASWIN(I,J) =0.
+            ASWOUT(I,J)=0.
+            ASWTOA(I,J)=0.
+          ENDDO
+          ENDDO
+        ENDIF
+!***  
+!***  SURFACE SENSIBLE AND LATENT HEAT FLUX ARRAYS.
+!***  
+        IF(MOD(NTSD,NSRFC).LT.GRID%NPHS)THEN
+          CALL wrf_message('  ZERO ACCUM SFC FLUX ARRAYS')
+          ASRFC=0.
+          DO J=JFS,JFE
+          DO I=IFS,IFE
+            SFCSHX(I,J)=0.
+            SFCLHX(I,J)=0.
+            SUBSHX(I,J)=0.
+            SNOPCX(I,J)=0.
+            SFCUVX(I,J)=0.
+            SFCEVP(I,J)=0.
+            POTEVP(I,J)=0.
+            POTFLX(I,J)=0.
+          ENDDO
+          ENDDO
+        ENDIF
+!***
+!***  ENDIF FOR RESTART FILE ACCUMULATION ZERO BLOCK.
+!***
+        CALL wrf_message('INIT:  INITIALIZED ARRAYS FOR RESTART START')
+      ENDIF
+!
+      DO J=JFS,JFE
+      DO K=KPS,KPE
+      DO I=IFS,IFE
+        ZERO_3D(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!----------------------------------------------------------------------
+!
+!***  FLAG FOR INITIALIZING ARRAYS, LOOKUP TABLES, & CONSTANTS USED IN
+!***  MICROPHYSICS AND RADIATION
+!
+!----------------------------------------------------------------------
+!
+      MICRO_START=.TRUE.
+!
+!----------------------------------------------------------------------
+!***
+!***  INITIALIZE ADVECTION TENDENCIES TO ZERO SO THAT
+!***  BOUNDARY POINTS WILL ALWAYS BE ZERO
+!***
+      DO J=JFS,JFE
+      DO K=KPS,KPE
+      DO I=IFS,IFE
+        ADT(I,K,J)=0.
+        ADU(I,K,J)=0.
+        ADV(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!----------------------------------------------------------------------
+!***
+!***  SET INDEX ARRAYS FOR UPSTREAM ADVECTION
+!***
+!----------------------------------------------------------------------
+      DO J=JFS,JFE
+        N_IUP_H(J)=0
+        N_IUP_V(J)=0
+        N_IUP_ADH(J)=0
+        N_IUP_ADV(J)=0
+!
+        DO I=IFS,IFE
+          IUP_H(I,J)=-999
+          IUP_V(I,J)=-999
+          IUP_ADH(I,J)=-999
+          IUP_ADV(I,J)=-999
+        ENDDO
+!
+      ENDDO
+
+#ifndef NO_UPSTREAM_ADVECTION
+!
+!***  N_IUP_H HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
+!***  FOR UPSTREAM ADVECTION (FULL ROWS IN THE 3RD THROUGH 7TH
+!***  ROWS FROM THE SOUTH AND NORTH GLOBAL BOUNDARIES AND 
+!***  FOUR POINTS ADJACENT TO THE WEST AND EAST GLOBAL BOUNDARIES
+!***  ON ALL OTHER INTERNAL ROWS).  SIMILARLY FOR N_IUP_V.
+!***  BECAUSE OF HORIZONTAL OPERATIONS, THESE POINTS EXTEND OUTSIDE 
+!***  OF THE UPSTREAM REGION SOMEWHAT.
+!***  N_IUP_ADH HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
+!***  FOR THE COMPUTATION OF THE TENDENCIES THEMSELVES (ADT, ADQ2M
+!***  AND ADQ2L); SPECIFICALLY THESE TENDENCIES ARE ONLY DONE IN
+!***  THE UPSTREAM REGION.
+!***  N_IUP_ADV HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
+!***  FOR THE VELOCITY POINT TENDENCIES.
+!***  IUP_H AND IUP_V HOLD THE ACTUAL I VALUES USED IN EACH ROW.
+!***  LIKEWISE FOR IUP_ADH AND IUP_ADV. 
+!***  ALSO, SET UPSTRM FOR THOSE TASKS AROUND THE GLOBAL EDGE.
+!
+      UPSTRM=.FALSE.
+!
+      S_BDY=(JPS==JDS)
+      N_BDY=(JPE==JDE)
+      W_BDY=(IPS==IDS)
+      E_BDY=(IPE==IDE)
+!
+      JTPAD2=2
+      JBPAD2=2
+      IRPAD2=2
+      ILPAD2=2
+!
+      IF(S_BDY)THEN
+        UPSTRM=.TRUE.
+        JBPAD2=0
+!
+        DO JJ=1,7
+          J=JJ      ! -MY_JS_GLB+1
+          KNTI=0
+          DO I=MYIS_P2,MYIE_P2
+            IUP_H(IMS+KNTI,J)=I
+            IUP_V(IMS+KNTI,J)=I
+            KNTI=KNTI+1
+          ENDDO
+          N_IUP_H(J)=KNTI
+          N_IUP_V(J)=KNTI
+        ENDDO
+!
+        DO JJ=3,5
+          J=JJ      ! -MY_JS_GLB+1
+          KNTI=0
+          ISTART=MYIS1_P2
+          IEND=MYIE1_P2
+          IF(E_BDY)IEND=IEND-MOD(JJ+1,2)
+          DO I=ISTART,IEND
+            IUP_ADH(IMS+KNTI,J)=I
+            KNTI=KNTI+1
+          ENDDO
+          N_IUP_ADH(J)=KNTI
+!
+          KNTI=0
+          ISTART=MYIS1_P2
+          IEND=MYIE1_P2
+          IF(E_BDY)IEND=IEND-MOD(JJ,2)
+          DO I=ISTART,IEND
+            IUP_ADV(IMS+KNTI,J)=I
+            KNTI=KNTI+1
+          ENDDO
+          N_IUP_ADV(J)=KNTI
+        ENDDO
+      ENDIF
+!
+      IF(N_BDY)THEN
+        UPSTRM=.TRUE.
+        JTPAD2=0
+!
+        DO JJ=JDE-7, JDE-1 ! JM-6,JM
+          J=JJ      ! -MY_JS_GLB+1
+          KNTI=0
+          DO I=MYIS_P2,MYIE_P2
+            IUP_H(IMS+KNTI,J)=I
+            IUP_V(IMS+KNTI,J)=I
+            KNTI=KNTI+1
+          ENDDO
+          N_IUP_H(J)=KNTI
+          N_IUP_V(J)=KNTI
+        ENDDO
+!
+        DO JJ=JDE-5, JDE-3 ! JM-4,JM-2
+          J=JJ      ! -MY_JS_GLB+1
+          KNTI=0
+          ISTART=MYIS1_P2
+          IEND=MYIE1_P2
+          IF(E_BDY)IEND=IEND-MOD(JJ+1,2)
+          DO I=ISTART,IEND
+            IUP_ADH(IMS+KNTI,J)=I
+            KNTI=KNTI+1
+          ENDDO
+          N_IUP_ADH(J)=KNTI
+!
+          KNTI=0
+          ISTART=MYIS1_P2
+          IEND=MYIE1_P2
+          IF(E_BDY)IEND=IEND-MOD(JJ,2)
+          DO I=ISTART,IEND
+            IUP_ADV(IMS+KNTI,J)=I
+            KNTI=KNTI+1
+          ENDDO
+          N_IUP_ADV(J)=KNTI
+        ENDDO
+      ENDIF
+!
+      IF(W_BDY)THEN
+        UPSTRM=.TRUE.
+        ILPAD2=0
+        DO JJ=8,JDE-8   ! JM-7
+          IF(JJ.GE.MY_JS_GLB-2.AND.JJ.LE.MY_JE_GLB+2)THEN
+            J=JJ      ! -MY_JS_GLB+1
+!
+            DO I=1,4
+              IUP_H(IMS+I-1,J)=I
+              IUP_V(IMS+I-1,J)=I
+            ENDDO
+            N_IUP_H(J)=4
+            N_IUP_V(J)=4
+          ENDIF
+        ENDDO
+!
+        DO JJ=6,JDE-6   ! JM-5
+          IF(JJ.GE.MY_JS_GLB-2.AND.JJ.LE.MY_JE_GLB+2)THEN
+            J=JJ      ! -MY_JS_GLB+1
+            KNTI=0
+            IEND=2+MOD(JJ,2)
+            DO I=2,IEND
+              IUP_ADH(IMS+KNTI,J)=I
+              KNTI=KNTI+1
+            ENDDO
+            N_IUP_ADH(J)=KNTI
+!
+            KNTI=0
+            IEND=2+MOD(JJ+1,2)
+            DO I=2,IEND
+              IUP_ADV(IMS+KNTI,J)=I
+              KNTI=KNTI+1
+            ENDDO
+            N_IUP_ADV(J)=KNTI
+!
+          ENDIF
+        ENDDO
+      ENDIF
+!
+      CALL WRF_GET_NPROCX(INPES)
+!
+      IF(E_BDY)THEN
+        UPSTRM=.TRUE.
+        IRPAD2=0
+        DO JJ=8,JDE-8   ! JM-7
+          IF(JJ.GE.MY_JS_GLB-2.AND.JJ.LE.MY_JE_GLB+2)THEN
+            J=JJ      ! -MY_JS_GLB+1
+            IEND=IM-MOD(JJ+1,2)
+            ISTART=IEND-3
+!
+!***  IN CASE THERE IS ONLY A SINGLE GLOBAL TASK IN THE
+!***  I DIRECTION THEN WE MUST ADD THE WESTSIDE UPSTREAM
+!***  POINTS TO THE EASTSIDE POINTS IN EACH ROW.
+!
+            KNTI=0
+            IF(INPES.EQ.1)KNTI=N_IUP_H(J)
+!
+            DO II=ISTART,IEND
+              I=II      ! -MY_IS_GLB+1
+              IUP_H(IMS+KNTI,J)=I
+              KNTI=KNTI+1
+            ENDDO
+            N_IUP_H(J)=KNTI
+          ENDIF
+        ENDDO
+!
+        DO JJ=6,JDE-6   ! JM-5
+          IF(JJ.GE.MY_JS_GLB-2.AND.JJ.LE.MY_JE_GLB+2)THEN
+            J=JJ      ! -MY_JS_GLB+1
+            IEND=IM-1-MOD(JJ+1,2)
+            ISTART=IEND-MOD(JJ,2)
+            KNTI=0
+            IF(INPES.EQ.1)KNTI=N_IUP_ADH(J)
+            DO II=ISTART,IEND
+              I=II      ! -MY_IS_GLB+1
+              IUP_ADH(IMS+KNTI,J)=I
+              KNTI=KNTI+1
+            ENDDO
+            N_IUP_ADH(J)=KNTI
+          ENDIF
+        ENDDO
+!***
+        DO JJ=8,JDE-8  ! JM-7
+          IF(JJ.GE.MY_JS_GLB-2.AND.JJ.LE.MY_JE_GLB+2)THEN
+            J=JJ      ! -MY_JS_GLB+1
+            IEND=IM-MOD(JJ,2)
+            ISTART=IEND-3
+            KNTI=0
+            IF(INPES.EQ.1)KNTI=N_IUP_V(J)
+!
+            DO II=ISTART,IEND
+              I=II      ! -MY_IS_GLB+1
+              IUP_V(IMS+KNTI,J)=I
+              KNTI=KNTI+1
+            ENDDO
+            N_IUP_V(J)=KNTI
+          ENDIF
+        ENDDO
+!
+        DO JJ=6,JDE-6  !  JM-5
+          IF(JJ.GE.MY_JS_GLB-2.AND.JJ.LE.MY_JE_GLB+2)THEN
+            J=JJ      ! -MY_JS_GLB+1
+            IEND=IM-1-MOD(JJ,2)
+            ISTART=IEND-MOD(JJ+1,2)
+            KNTI=0
+            IF(INPES.EQ.1)KNTI=N_IUP_ADV(J)
+            DO II=ISTART,IEND
+              I=II      ! -MY_IS_GLB+1
+              IUP_ADV(IMS+KNTI,J)=I
+              KNTI=KNTI+1
+            ENDDO
+            N_IUP_ADV(J)=KNTI
+          ENDIF
+        ENDDO
+      ENDIF
+!----------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!tlb
+!!!Read in EM and EMT from the original NMM nhb file
+!!!   call int_get_fresh_handle( retval )
+!!!   close(retval)
+!!!   open(unit=retval,file=seeout,form='UNFORMATTED',iostat=ier)
+!!!!!!do j=1,128
+!!!     read(seeout)
+!!!!!!  read(55)
+!!!!!!enddo
+!!!   read(seeout)dummyx,em,emt
+!!!!!!read(55)dummyx,em,emt
+!!!   close(retval)
+      jam=6+2*(JDE-JDS-1-9)
+!     read(55)(em(j),j=1,jam),(emt(j),j=1,jam)
+!!!!!!!!!!!!!!!!!!!!tlb
+!
+!***  EXTRACT EM AND EMT FOR THE LOCAL SUBDOMAINS
+!
+      DO J=MYJS_P5,MYJE_P5
+        EM_LOC(J)=-9.E9
+        EMT_LOC(J)=-9.E9
+      ENDDO
+!!!   IF(IBROW==1)THEN
+      IF(S_BDY)THEN
+        DO J=3,5
+          EM_LOC(J)=EM(J-2)
+          EMT_LOC(J)=EMT(J-2)
+        ENDDO
+      ENDIF
+!!!   IF(ITROW==1)THEN
+      IF(N_BDY)THEN
+        KNT=3
+        DO JJ=JDE-5,JDE-3 ! JM-4,JM-2
+          KNT=KNT+1
+          J=JJ      ! -MY_JS_GLB+1
+          EM_LOC(J)=EM(KNT)
+          EMT_LOC(J)=EMT(KNT)
+        ENDDO
+      ENDIF
+!!!   IF(ILCOL==1)THEN
+      IF(W_BDY)THEN
+        KNT=6
+        DO JJ=6,JDE-6 ! JM-5
+          KNT=KNT+1
+          IF(JJ.GE.MY_JS_GLB-2.AND.JJ.LE.MY_JE_GLB+2)THEN
+            J=JJ      ! -MY_JS_GLB+1
+            EM_LOC(J)=EM(KNT)
+            EMT_LOC(J)=EMT(KNT)
+          ENDIF
+        ENDDO
+      ENDIF
+!!!   IF(IRCOL==1)THEN
+      IF(E_BDY)THEN
+        KNT=6+JDE-11 ! JM-10
+        DO JJ=6,JDE-6 ! JM-5
+          KNT=KNT+1
+          IF(JJ.GE.MY_JS_GLB-2.AND.JJ.LE.MY_JE_GLB+2)THEN
+            J=JJ      ! -MY_JS_GLB+1
+            EM_LOC(J)=EM(KNT)
+            EMT_LOC(J)=EMT(KNT)
+          ENDIF
+        ENDDO
+      ENDIF
+#else
+      CALL wrf_message( 'start_domain_nmm: upstream advection commented out')
+#endif
+!
+!***
+!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
+!***
+      IF(NSTART.EQ.0)THEN
+!
+         GRID%NSOIL= GRID%NUM_SOIL_LAYERS
+        DO J=JFS,JFE
+        DO I=IFS,IFE
+          PCTSNO(I,J)=-999.0
+          IF(SM(I,J).LT.0.5)THEN
+              CMC(I,J)=0.0
+!              CMC(I,J)=canwat(i,j)   ! tgs
+            IF(SICE(I,J).GT.0.5)THEN
+!***
+!***  SEA-ICE CASE
+!***
+              SMSTAV(I,J)=1.0
+              SMSTOT(I,J)=1.0
+              SSROFF(I,J)=0.0
+              BGROFF(I,J)=0.0
+              CMC(I,J)=0.0
+              DO NS=1,GRID%NSOIL
+                SMC(I,NS,J)=1.0
+!               SH2O(I,NS,J)=0.05
+                SH2O(I,NS,J)=1.0
+              ENDDO
+            ENDIF
+          ELSE
+!***
+!***  WATER CASE
+!***
+            SMSTAV(I,J)=1.0
+            SMSTOT(I,J)=1.0
+            SSROFF(I,J)=0.0
+            BGROFF(I,J)=0.0
+            SOILTB(I,J)=NMM_TSK(I,J)
+            GRNFLX(I,J)=0.
+            SUBSHX(I,J)=0.0
+            ACSNOW(I,J)=0.0
+            ACSNOM(I,J)=0.0
+            SNOPCX(I,J)=0.0
+            CMC(I,J)=0.0
+            SNO(I,J)=0.0
+            DO NS=1,GRID%NSOIL
+              SMC(I,NS,J)=1.0
+              STC(I,NS,J)=NMM_TSK(I,J)
+!             SH2O(I,NS,J)=0.05
+              SH2O(I,NS,J)=1.0
+            ENDDO
+          ENDIF
+!
+        ENDDO
+        ENDDO
+!
+        APHTIM=0.0
+        ARATIM=0.0
+        ACUTIM=0.0
+!
+      ENDIF
+!
+!----------------------------------------------------------------------
+!***  INITIALIZE RADTN VARIABLES
+!***  CALCULATE THE NUMBER OF STEPS AT EACH POINT.
+!***  THE ARRAY 'LVL' WILL COORDINATE VERTICAL LOCATIONS BETWEEN
+!***  THE LIFTED WORKING ARRAYS AND THE FUNDAMENTAL MODEL ARRAYS.
+!***  LVL HOLDS THE HEIGHT (IN MODEL LAYERS) OF THE TOPOGRAPHY AT
+!***  EACH GRID POINT.
+!----------------------------------------------------------------------
+!   
+      DO J=JFS,JFE
+      DO I=IFS,IFE
+        LVL(I,J)=LM-LMH(I,J)
+      ENDDO
+      ENDDO
+!***
+!***  DETERMINE MODEL LAYER LIMITS FOR HIGH(3), MIDDLE(2),
+!***  AND LOW(1) CLOUDS.  ALSO FIND MODEL LAYER THAT IS JUST BELOW
+!***  (HEIGHT-WISE) 400 MB. (K400)
+!*** 
+      K400=0
+      PSUM=PT
+      SLPM=101325.
+      PDIF=SLPM-PT
+      DO K=1,LM
+        PSUM=PSUM+DETA(K)*PDIF
+        IF(LPTOP(3).EQ.0)THEN
+          IF(PSUM.GT.PHITP)LPTOP(3)=K
+        ELSEIF(LPTOP(2).EQ.0)THEN
+          IF(PSUM.GT.PMDHI)LPTOP(2)=K
+        ELSEIF(K400.EQ.0)THEN
+          IF(PSUM.GT.P400)K400=K
+        ELSEIF(LPTOP(1).EQ.0)THEN
+          IF(PSUM.GT.PLOMD)LPTOP(1)=K
+        ENDIF
+      ENDDO
+!***
+!*** CALL GRADFS ONCE TO CALC. CONSTANTS AND GET O3 DATA
+!***
+      KCCO2=0
+!***
+!*** CALCULATE THE MIDLAYER PRESSURES IN THE STANDARD ATMOSPHERE
+!***
+      PSS=101325.
+      PDIF=PSS-PT
+!
+      ALLOCATE(PHALF(LM+1),STAT=I)
+!
+      DO K=KPS,KPE-1
+        PHALF(K+1)=AETA(K)*PDIF+PT
+      ENDDO
+      
+!
+      PHALF(1)=0.
+      PHALF(LM+1)=PSS
+!***
+!!!   CALL GRADFS(PHALF,KCCO2,NUNIT_CO2)
+!***
+!***  CALL SOLARD TO CALCULATE NON-DIMENSIONAL SUN-EARTH DISTANCE
+!***
+!!!   IF(MYPE.EQ.0)CALL SOLARD(SUN_DIST)
+!!!   CALL MPI_BCAST(SUN_DIST,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
+
+!***
+!***  CALL ZENITH SIMPLY TO GET THE DAY OF THE YEAR FOR
+!***  THE SETUP OF THE OZONE DATA
+!***
+      TIME=(NTSD-1)*GRID%DT
+!
+!!!   CALL ZENITH(TIME,DAYI,HOUR)
+!
+      ADDL=0.
+      IF(MOD(IDAT(3),4).EQ.0)ADDL=1.
+!
+!!!   CALL O3CLIM
+!
+!
+      DEALLOCATE(PHALF)
+!----------------------------------------------------------------------
+!***  SOME INITIAL VALUES RELATED TO TURBULENCE SCHEME
+!----------------------------------------------------------------------
+!
+      DO J=JFS,JFE
+      DO I=IFS,IFE
+!***
+!***  TRY A SIMPLE LINEAR INTERP TO GET 2/10 M VALUES
+!***
+        PDSL(I,J)=PD(I,J)*RES(I,J)
+        LMHK=LMH(I,J)
+        LMVK=LMV(I,J)
+!
+        KOFF=KPE-1-LMHK
+        KOFV=KPE-1-LMVK
+!
+        ULM=U(I,KOFV+1,J)
+        VLM=V(I,KOFV+1,J)
+        TLM=T(I,KOFF+1,J)
+        QLM=Q(I,KOFF+1,J)
+        PLM=AETA1(KOFF+1)*PDTOP+AETA2(KOFF+1)*PDSL(I,J)+PT
+        APELM=(1.0E5/PLM)**CAPA
+        APELMNW=(1.0E5/PSHLTR(I,J))**CAPA
+        THLM=TLM*APELM
+        DPLM=(DETA1(KOFF+1)*PDTOP+DETA2(KOFF+1)*PDSL(I,J))*0.5
+        DZLM=R_D*DPLM*TLM*(1.+P608*QLM)/(G*PLM)
+        FAC1=10./DZLM
+        FAC2=(DZLM-10.)/DZLM
+        IF(DZLM.LE.10.)THEN
+          FAC1=1.
+          FAC2=0.
+        ENDIF
+!
+        IF(.NOT.RESTRT)THEN
+          TH10(I,J)=FAC2*THS(I,J)+FAC1*THLM
+          Q10(I,J)=FAC2*QSH(I,J)+FAC1*QLM
+          U10(I,J)=ULM
+          V10(I,J)=VLM
+        ENDIF
+!
+!        FAC1=2./DZLM
+!        FAC2=(DZLM-2.)/DZLM
+!        IF(DZLM.LE.2.)THEN
+!          FAC1=1.
+!          FAC2=0.
+!        ENDIF
+!
+        IF(.NOT.RESTRT.OR.NEST)THEN
+
+	IF ( (THLM-THS(I,J)) .gt. 2.0) THEN  ! weight differently in different scenarios
+	 FAC1=0.3
+         FAC2=0.7
+        ELSE
+         FAC1=0.8
+         FAC2=0.2
+        ENDIF
+
+          TSHLTR(I,J)=FAC2*THS(I,J)+FAC1*THLM
+!          TSHLTR(I,J)=0.2*THS(I,J)+0.8*THLM
+          QSHLTR(I,J)=FAC2*QSH(I,J)+FAC1*QLM
+!          QSHLTR(I,J)=0.2*QSH(I,J)+0.8*QLM
+        ENDIF
+!***
+!***  NEED TO CONVERT TO THETA IF IS THE RESTART CASE
+!***  AS CHKOUT.f WILL CONVERT TO TEMPERATURE
+!***
+!EROGERS: COMMENT OUT IN WRF-NMM
+!***
+!       IF(RESTRT)THEN
+!         TSHLTR(I,J)=TSHLTR(I,J)*APELMNW
+!       ENDIF
+      ENDDO
+      ENDDO
+!
+!----------------------------------------------------------------------
+!***  INITIALIZE TAU-1 VALUES FOR ADAMS-BASHFORTH 
+!----------------------------------------------------------------------
+!
+      IF(.NOT.RESTRT)THEN
+        DO J=jfs,jfe
+          DO K=KPS,KPE
+          DO I=ifs,ife
+            TOLD(I,K,J)=T(I,K,J)   ! T AT TAU-1
+            UOLD(I,K,J)=U(I,K,J)   ! U AT TAU-1
+            VOLD(I,K,J)=V(I,K,J)   ! V AT TAU-1
+          ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+!
+!----------------------------------------------------------------------
+!***  INITIALIZE NONHYDROSTATIC QUANTITIES
+!----------------------------------------------------------------------
+!
+!!!!	SHOULD DWDT BE REDEFINED IF RESTRT?
+
+        IF(.NOT.RESTRT.OR.NEST)THEN
+      DO J=jfs,jfe
+        DO K=KPS,KPE
+        DO I=ifs,ife
+          DWDT(I,K,J)=1.
+        ENDDO
+        ENDDO
+      ENDDO
+	ENDIF
+!***
+      IF(GRID%SIGMA.EQ.1)THEN
+        DO J=jfs,jfe
+        DO I=ifs,ife
+          PDSL(I,J)=PD(I,J)
+        ENDDO
+        ENDDO
+      ELSE
+        DO J=jfs,jfe
+        DO I=ifs,ife
+          PDSL(I,J)=RES(I,J)*PD(I,J)
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!***
+!
+!
+!!!!	SHOULD PINT,Z,W BE REDEFINED IF RESTRT?
+
+      write(0,*)' restrt=',restrt,' nest=',nest
+      write(0,*)' ifs=',ifs,' ife=',ife
+      write(0,*)' jfs=',jfs,' jfe=',jfe
+      write(0,*)' kps=',kps,' kpe=',kpe
+      write(0,*)' pdtop=',pdtop,' pt=',pt
+        IF(.NOT.RESTRT.OR.NEST)THEN
+      DO J=jfs,jfe
+        DO K=KPS,KPE
+        DO I=ifs,ife
+          PINT(I,K,J)=ETA1(K)*PDTOP+ETA2(K)*PDSL(I,J)+PT
+          Z(I,K,J)=PINT(I,K,J)
+          W(I,K,J)=0.
+        ENDDO
+        ENDDO
+      ENDDO
+	ENDIF
+
+#ifndef NO_RESTRICT_ACCEL
+!----------------------------------------------------------------------
+!***  RESTRICTING THE ACCELERATION ALONG THE BOUNDARIES
+!----------------------------------------------------------------------
+!
+      DO J=jfs,jfe
+      DO I=ifs,ife
+        DWDTMN(I,J)=-EPSIN
+        DWDTMX(I,J)= EPSIN
+      ENDDO
+      ENDDO
+
+
+!
+!***
+      IF(JHL.GT.1)THEN
+        JHH=JDE-1-JHL+1 ! JM-JHL+1
+        IHL=JHL/2+1
+!
+        DO J=1,JHL
+          IF(J.GE.MY_JS_GLB-JBPAD2.AND.J.LE.MY_JE_GLB+JTPAD2)THEN
+            JX=J      ! -MY_JS_GLB+1
+            DO I=1,IDE-1 ! IM
+              IF(I.GE.MY_IS_GLB-ILPAD2.AND.I.LE.MY_IE_GLB+IRPAD2)THEN
+                IX=I      ! -MY_IS_GLB+1
+                DWDTMN(IX,JX)=-EPSB
+                DWDTMX(IX,JX)= EPSB
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDDO
+!
+        DO J=JHH,JDE-1   ! JM
+          IF(J.GE.MY_JS_GLB-JBPAD2.AND.J.LE.MY_JE_GLB+JTPAD2)THEN
+            JX=J      ! -MY_JS_GLB+1
+            DO I=1,IDE-1 ! IM
+              IF(I.GE.MY_IS_GLB-ILPAD2.AND.I.LE.MY_IE_GLB+IRPAD2)THEN
+                IX=I      ! -MY_IS_GLB+1
+                DWDTMN(IX,JX)=-EPSB
+                DWDTMX(IX,JX)= EPSB
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDDO
+!
+        DO J=1,JDE-1 ! JM
+          IF(J.GE.MY_JS_GLB-JBPAD2.AND.J.LE.MY_JE_GLB+JTPAD2)THEN
+            JX=J      ! -MY_JS_GLB+1
+            DO I=1,IHL
+              IF(I.GE.MY_IS_GLB-ILPAD2.AND.I.LE.MY_IE_GLB+IRPAD2)THEN
+                IX=I      ! -MY_IS_GLB+1
+                DWDTMN(IX,JX)=-EPSB
+                DWDTMX(IX,JX)= EPSB
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDDO
+!
+        DO J=1,JDE-1 ! JM
+          IF(J.GE.MY_JS_GLB-JBPAD2.AND.J.LE.MY_JE_GLB+JTPAD2)THEN
+            JX=J      ! -MY_JS_GLB+1
+             ! moved this line to inside the J-loop, 20030429, jm
+            IHH=IDE-1-IHL+MOD(j,2) ! IM-IHL+MOD(J,2)
+            DO I=IHH,IDE-1 ! IM
+              IF(I.GE.MY_IS_GLB-ILPAD2.AND.I.LE.MY_IE_GLB+IRPAD2)THEN
+                IX=I      ! -MY_IS_GLB+1
+                DWDTMN(IX,JX)=-EPSB
+                DWDTMX(IX,JX)= EPSB
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDDO
+!
+      ENDIF
+
+#else
+      CALL wrf_message('start_domain_nmm: NO_RESTRICT_ACCEL')
+#endif
+
+!-----------------------------------------------------------------------
+!***  CALL THE GENERAL PHYSICS INITIALIZATION
+!-----------------------------------------------------------------------
+!
+
+      ALLOCATE(SFULL(KMS:KME),STAT=I)           ; SFULL    = 0.
+      ALLOCATE(SMID(KMS:KME),STAT=I)            ; SMID     = 0.
+      ALLOCATE(EMISS(IMS:IME,JMS:JME),STAT=I)   ; EMISS    = 0.
+      ALLOCATE(GLW(IMS:IME,JMS:JME),STAT=I)     ; GLW      = 0.
+      ALLOCATE(HFX(IMS:IME,JMS:JME),STAT=I)     ; HFX      = 0.
+      ALLOCATE(LOWLYR(IMS:IME,JMS:JME),STAT=I)  ; LOWLYR   = 0.
+!     ALLOCATE(MAVAIL(IMS:IME,JMS:JME),STAT=I)  ; MAVAIL   = 0.
+      ALLOCATE(NCA(IMS:IME,JMS:JME),STAT=I)     ; NCA      = 0.
+      ALLOCATE(QFX(IMS:IME,JMS:JME),STAT=I)     ; QFX      = 0.
+      ALLOCATE(RAINBL(IMS:IME,JMS:JME),STAT=I)  ; RAINBL   = 0.
+      ALLOCATE(RAINC(IMS:IME,JMS:JME),STAT=I)   ; RAINC    = 0.
+      ALLOCATE(RAINNC(IMS:IME,JMS:JME),STAT=I)  ; RAINNC   = 0.
+      ALLOCATE(RAINNCV(IMS:IME,JMS:JME),STAT=I) ; RAINNCV  = 0.
+
+      ALLOCATE(ZS(KMS:KME),STAT=I)              ; ZS       = 0.
+      ALLOCATE(SNOWC(IMS:IME,JMS:JME),STAT=I)   ; SNOWC    = 0.
+      ALLOCATE(THC(IMS:IME,JMS:JME),STAT=I)     ; THC      = 0.
+      ALLOCATE(TMN(IMS:IME,JMS:JME),STAT=I)     ; TMN      = 0.
+      ALLOCATE(TSFC(IMS:IME,JMS:JME),STAT=I)    ; TSFC     = 0.
+      ALLOCATE(Z0_DUM(IMS:IME,JMS:JME),STAT=I)  ; Z0_DUM   = 0.
+      ALLOCATE(ALBEDO_DUM(IMS:IME,JMS:JME),STAT=I)  ; ALBEDO_DUM   = 0.
+
+      ALLOCATE(DZS(KMS:KME),STAT=I)                         ; DZS = 0.
+      ALLOCATE(RQCBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RQCBLTEN = 0.
+      ALLOCATE(RQIBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RQIBLTEN = 0.
+      ALLOCATE(RQVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RQVBLTEN =  0.
+      ALLOCATE(RTHBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RTHBLTEN =  0.
+      ALLOCATE(RUBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)     ; RUBLTEN = 0.
+      ALLOCATE(RVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)     ; RVBLTEN = 0.
+      ALLOCATE(RQCCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RQCCUTEN = 0.
+      ALLOCATE(RQICUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RQICUTEN  = 0.
+      ALLOCATE(RQRCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RQRCUTEN = 0.
+      ALLOCATE(RQSCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RQSCUTEN = 0.
+      ALLOCATE(RQVCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RQVCUTEN = 0.
+      ALLOCATE(RTHCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RTHCUTEN = 0.
+      ALLOCATE(RTHRATEN(IMS:IME,KMS:KME,JMS:JME),STAT=I)    ; RTHRATEN  = 0.
+      ALLOCATE(RTHRATENLW(IMS:IME,KMS:KME,JMS:JME),STAT=I)  ; RTHRATENLW = 0.
+      ALLOCATE(RTHRATENSW(IMS:IME,KMS:KME,JMS:JME),STAT=I)  ; RTHRATENSW = 0.
+      ALLOCATE(RRI(IMS:IME,KMS:KME,JMS:JME),STAT=I)  ; RRI = 0.
+      ALLOCATE(ZINT(IMS:IME,KMS:KME,JMS:JME),STAT=I)  ; ZINT = 0.
+!     ALLOCATE(ZMID(IMS:IME,KMS:KME,JMS:JME),STAT=I)  ; ZMID = 0.
+      ALLOCATE(CONVFAC(IMS:IME,KMS:KME,JMS:JME),STAT=I)  ; CONVFAC = 0.
+#if 0
+      ALLOCATE(W0AVG(IMS:IME,KMS:KME,JMS:JME),STAT=I)       ; W0AVG = 0.
+#endif
+!-----------------------------------------------------------------------
+!jm added set of g_inv
+      G_INV=1./G
+      ROG=R_D*G_INV
+      GRID%RADT=GRID%NRADS*GRID%DT/60.
+      GRID%BLDT=GRID%NPHS*GRID%DT/60.
+      GRID%CUDT=GRID%NCNVC*GRID%DT/60.
+      GRID%GSMDT=GRID%NPHS*GRID%DT/60.
+!
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+        SFCZ=FIS(I,J)*G_INV
+        ZINT(I,KTS,J)=SFCZ
+        PDSL(I,J)=PD(I,J)*RES(I,J)
+        PSURF=PINT(I,KTS,J)
+        EXNSFC=(1.E5/PSURF)**CAPA
+        XLAND(I,J)=SM(I,J)+1.
+        THSIJ=(SST(I,J)*EXNSFC)*(XLAND(I,J)-1.)                         &
+     &        +THS(I,J)*(2.-SM(I,J))
+        TSFC(I,J)=THSIJ/EXNSFC
+!
+        DO K=KTS,KTE-1
+          PLYR=(PINT(I,K,J)+PINT(I,K+1,J))*0.5
+          TL=T(I,K,J)
+          CWML=CWM(I,K,J)
+          rri(i,k,j)=r_d*tl*(1.+p608*q(i,k,j))/plyr
+          ZINT(I,K+1,J)=ZINT(I,K,J)+TL/PLYR                             & 
+                     *(DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J))*ROG        & 
+                     *(Q(I,K,J)*P608-CWML+1.)
+        ENDDO
+!
+!        DO K=KTS,KTE
+!!!       ZMID(I,K,J)=0.5*(ZINT(I,K,J)+ZINT(I,K+1,J))
+!        ENDDO
+      ENDDO
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  RECREATE SIGMA VALUES AT LAYER INTERFACES FOR THE FULL VERTICAL
+!***  DOMAIN FROM THICKNESS VALUES FOR THE TWO SUBDOMAINS.
+!***  NOTE: KTE=NUMBER OF LAYERS PLUS ONE
+!-----------------------------------------------------------------------
+!
+      write(0,*)' start_domain kte=',kte
+      PDTOT=101325.-PT
+      RPDTOT=1./PDTOT
+      PDBOT=PDTOT-PDTOP
+      SFULL(KTS)=1.
+      SFULL(KTE)=0.
+      dsigsum = 0.
+      DO K=KTS+1,KTE
+        DSIG=(DETA1(K-1)*PDTOP+DETA2(K-1)*PDBOT)*RPDTOT
+        dsigsum=dsigsum+dsig
+        SFULL(K)=SFULL(K-1)-DSIG
+        SMID(K-1)=0.5*(SFULL(K-1)+SFULL(K))
+      ENDDO
+      dsig=(deta1(kte-1)*pdtop+deta2(kte-1)*pdbot)*rpdtot
+      dsigsum=dsigsum+dsig
+      SMID(KTE-1)=0.5*(SFULL(KTE-1)+SFULL(KTE))
+!
+!-----------------------------------------------------------------------
+
+      LU_INDEX=IVGTYP
+
+      IF(.NOT.RESTRT)THEN
+        DO J=MYJS,MYJE
+        DO I=MYIS,MYIE
+          Z0_DUM(I,J)=Z0(I,J) ! hold
+          ALBEDO_DUM(I,J)=ALBEDO(I,J) ! Save albedos
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!     always define the quantity Z0BASE
+                                                                                                                                              
+      DO J=MYJS,MYJE
+      DO I=MYIS,MYIE
+                                                                                                                                              
+! topo based
+!       Z0BASE(I,J)=SM(I,J)*Z0SEA+(1.-SM(I,J))*  &
+!    &             (FIS(I,J)*(FCM/3.)+Z0LAND)
+!
+        IF(SM(I,J)==0)then
+!         Z0BASE(I,J)=MAX(VZ0TBL_24(IVGTYP(I,J)),0.1)
+          Z0BASE(I,J)=VZ0TBL_24(IVGTYP(I,J))+Z0LAND
+        ELSE
+          Z0BASE(I,J)=VZ0TBL_24(IVGTYP(I,J))+Z0SEA
+        ENDIF
+!
+      ENDDO
+      ENDDO
+!
+! when allocating CAM radiation 4d arrays (ozmixm, aerosolc) these are not needed
+      num_ozmixm=1
+      num_aerosolc=1
+
+! Set GMT, JULDAY, and JULYR outside of phy_init because it is no longer 
+! called inside phy_init due to moving nest changes.  (When nests move 
+! phy_init may not be called on a process if, for example, it is a moving 
+! nest and if this part of the domain is not being initialized (not the 
+! leading edge).)  Calling domain_setgmtetc() here will avoid this problem 
+! when NMM moves to moving nests.  
+      CALL domain_setgmtetc( GRID, START_OF_SIMULATION )
+
+! Several arguments are RCONFIG entries in Registry.NMM. Registry no longer
+! includes these as dummy arguments or declares them.  Access them from 
+! GRID.  JM 20050819
+      CALL PHY_INIT(GRID%ID,CONFIG_FLAGS,GRID%DT,GRID%RESTART,sfull,smid&
+     &             ,PT,TSFC,GRID%RADT,GRID%BLDT,GRID%CUDT,GRID%GSMDT    &
+     &             ,RTHCUTEN, RQVCUTEN, RQRCUTEN                        &
+     &             ,RQCCUTEN, RQSCUTEN, RQICUTEN                        &
+     &             ,RUBLTEN,RVBLTEN,RTHBLTEN                            &
+     &             ,RQVBLTEN,RQCBLTEN,RQIBLTEN                          &
+     &             ,RTHRATEN,RTHRATENLW,RTHRATENSW                      &
+     &             ,STEPBL,STEPRA,STEPCU                                &
+     &             ,W0AVG, RAINNC, RAINC, RAINCV, RAINNCV               &
+     &             ,NCA,GRID%SWRAD_SCAT                                 &
+     &             ,CLDEFI,LOWLYR                                       &
+     &             ,MASS_FLUX                                           &
+     &             ,RTHFTEN, RQVFTEN                                    &
+     &             ,CLDFRA,GLW,GSW,EMISS,LU_INDEX                       &
+     &             ,GRID%LANDUSE_ISICE, GRID%LANDUSE_LUCATS             &
+     &             ,GRID%LANDUSE_LUSEAS, GRID%LANDUSE_ISN               &
+     &             ,GRID%LU_STATE                                       &
+     &             ,XLAT,XLONG,ALBEDO,ALBBCK                            &
+     &             ,GRID%GMT,GRID%JULYR,GRID%JULDAY                     &
+     &             ,GRID%LEVSIZ, NUM_OZMIXM, NUM_AEROSOLC, GRID%PAERLEV &
+     &             ,TMN,XLAND,ZNT,Z0,USTAR,MOL,PBLH,TKE_MYJ             &
+     &             ,EXCH_H,THC,SNOWC,MAVAIL,HFX,QFX,RAINBL              &
+     &             ,STC,ZS,DZS,GRID%NUM_SOIL_LAYERS,WARM_RAIN           &
+     &             ,ADV_MOIST_COND                                      &
+     &             ,APR_GR,APR_W,APR_MC,APR_ST,APR_AS                   &
+     &             ,APR_CAPMA,APR_CAPME,APR_CAPMI                       &
+     &             ,XICE,VEGFRA,SNOW,CANWAT,SMSTAV                      &
+     &             ,SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW            &
+     &             ,ACSNOM,IVGTYP,ISLTYP,SFCEVP,SMC                     &
+     &             ,SH2O, SNOWH, SMFR3D                                 &  ! temporary
+     &             ,GRID%DX,GRID%DY,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY    &
+     &             ,MP_RESTART_STATE,TBPVS_STATE,TBPVS0_STATE           &
+     &             ,.TRUE.,.FALSE.,START_OF_SIMULATION                  &
+     &             ,IDS, IDE, JDS, JDE, KDS, KDE                        &
+     &             ,IMS, IME, JMS, JME, KMS, KME                        &
+     &             ,ITS, ITE, JTS, JTE, KTS, KTE                        &
+     &                )
+
+!-----------------------------------------------------------------------
+!
+!mp replace F*_PHY with values defined in module_initialize_real.F?
+
+	IF (.NOT. RESTRT) THEN
+! Added by Greg Thompson, NCAR-RAL, for initializing water vapor
+! mixing ratio (from NMM's specific humidity var) into moist array.
+
+        write(0,*) 'Initializng moist(:,:,:, Qv) from Q'
+        DO J=JFS,JFE
+        DO K=KPS,KPE
+        DO I=IFS,IFE
+           moist(I,K,J,P_QV) = Q(I,K,J) / (1.-Q(I,K,J))                 
+        enddo      
+        enddo      
+        enddo      
+     
+! Also sum cloud water, ice, rain, snow, graupel into Ferrier CWM       
+! array (if any hydrometeors found and non-zero from initialization     
+! package).  Then, determine fractions ice and rain from species.       
+     
+        IF (.not. (MAXVAL(CWM).gt.0. .and. MAXVAL(CWM).lt.1.) ) then    
+          do i_m = 2, num_moist
+          if (i_m.ne.p_qv) &
+     &       write(0,*) ' summing moist(:,:,:,',i_m,') into CWM array'  
+          DO J=JFS,JFE
+          DO K=KPS,KPE
+          DO I=IFS,IFE
+            IF ( (moist(I,K,J,i_m).gt.EPSQ) .and. (i_m.ne.p_qv) ) THEN  
+               CWM(I,K,J) = CWM(I,K,J) + moist(I,K,J,i_m)               
+            ENDIF  
+          enddo    
+          enddo
+          enddo
+          enddo
+
+          IF (.not. ( (maxval(F_ICE)+maxval(F_RAIN)) .gt. EPSQ) ) THEN
+            write(0,*) '  computing F_ICE'
+            do i_m = 2, num_moist
+            DO J=JFS,JFE
+            DO K=KPS,KPE
+            DO I=IFS,IFE
+              IF ( (moist(I,K,J,i_m).gt.EPSQ) .and. &
+     &               ( (i_m.eq.p_qi).or.(i_m.eq.p_qs).or.(i_m.eq.p_qg) ) ) THEN
+                 F_ICE(I,K,J) = F_ICE(I,K,J) + moist(I,K,J,i_m)
+              ENDIF
+        if (model_config_rec%mp_physics(grid%id).EQ.ETAMPNEW) then
+            if ((i_m.eq.p_qi).or.(i_m.eq.p_qg) ) then
+               moist(I,K,J,p_qs)=moist(I,K,J,p_qs)+moist(I,K,J,i_m)
+               moist(I,K,J,i_m) =0.
+            endif
+        endif
+            enddo
+            enddo
+            enddo
+            enddo
+            write(0,*) '  computing F_RAIN'
+            DO J=JFS,JFE
+            DO K=KPS,KPE
+            DO I=IFS,IFE
+          IF(F_ICE(i,k,j)<=EPSQ)THEN
+              F_ICE(I,K,J)=0.
+          ELSE
+              F_ICE(I,K,J) = F_ICE(I,K,J)/CWM(I,K,J)
+          ENDIF
+              IF ( (moist(I,K,J,p_qr)+moist(I,K,J,p_qc)).gt.EPSQ) THEN
+           IF(moist(i,k,j,p_qr)<=EPSQ)THEN
+              F_RAIN(I,K,J)=0.
+           ELSE
+              F_RAIN(I,K,J) = moist(i,k,j,p_qr) &
+     &                    / (moist(i,k,j,p_qr)+moist(i,k,j,p_qc))
+           ENDIF
+              ENDIF
+            enddo
+            enddo
+            enddo
+          ENDIF
+        ENDIF
+! End addition by Greg Thompson
+
+        IF (maxval(F_ICE) .gt. 0.) THEN
+        write(0,*) 'F_ICE > 0'
+         do J=JMS,JME
+         do K=KMS,KME
+         do I=IMS,IME
+          F_ICE_PHY(I,K,J)=F_ICE(I,K,J)
+         enddo
+         enddo
+         enddo
+        ENDIF
+
+        IF (maxval(F_RAIN) .gt. 0.) THEN
+        write(0,*) 'F_RAIN > 0'
+         do J=JMS,JME
+         do K=KMS,KME
+         do I=IMS,IME
+          F_RAIN_PHY(I,K,J)=F_RAIN(I,K,J)
+         enddo
+         enddo
+         enddo
+        ENDIF
+
+        IF (maxval(F_RIMEF) .gt. 0.) THEN
+        write(0,*) 'F_RIMEF > 0'
+         do J=JMS,JME
+         do K=KMS,KME
+         do I=IMS,IME
+          F_RIMEF_PHY(I,K,J)=F_RIMEF(I,K,J)
+         enddo
+         enddo
+         enddo
+        ENDIF
+	ENDIF
+
+!mp
+        IF (.NOT. RESTRT) THEN
+      DO J=JMS,JME
+      DO I=IMS,IME
+        Z0(I,J)=Z0_DUM(I,J)+0.5*Z0(I,J) ! add 1/2 of veg Z0 component,
+                                        ! expecting this code to be called
+                                        ! both by real and by the model.
+      ENDDO
+      ENDDO
+  !-- Replace albedos if original albedos are nonzero
+      IF(MAXVAL(ALBEDO_DUM)>0.)THEN
+        DO J=JMS,JME
+        DO I=IMS,IME
+          ALBEDO(I,J)=ALBEDO_DUM(I,J)
+        ENDDO
+        ENDDO
+      ENDIF
+        ENDIF
+
+      DO J=JMS,JME
+      DO I=IMS,IME
+        APREC(I,J)=RAINNC(I,J)*1.E-3
+        CUPREC(I,J)=RAINCV(I,J)*1.E-3
+      ENDDO
+      ENDDO
+!following will need mods Sep06
+!
+#ifdef WRF_CHEM
+      do j=jts,jte
+        jj=min(jde-1,j)
+        do k=kts,kte-1
+          kk=min(kde-1,k)
+          do i=its,ite
+            ii=min(ide-1,i)
+            convfac(i,k,j) = pint(ii,kk,jj)/rgasuniv/t(ii,kk,jj)
+          enddo
+        enddo
+      enddo
+!
+         CALL chem_init (grid%id,chem,grid%dt,grid%bioemdt,grid%photdt,grid%chemdt, &
+               stepbioe,stepphot,stepchem,                           &
+               zint,g,aerwrf,config_flags,                           &
+               rri,t,pint,convfac,                                   &
+               tauaer1,tauaer2,tauaer3,tauaer4,                      &
+               gaer1,gaer2,gaer3,gaer4,                              &
+               waer1,waer2,waer3,waer4,                              &
+               pm2_5_dry,pm2_5_water,pm2_5_dry_ec,grid%chem_in_opt,  &
+               ids , ide , jds , jde , kds , kde ,                   &
+               ims , ime , jms , jme , kms , kme ,                   &
+               its , ite , jts , jte , kts , kte                     )
+!     
+! calculate initial pm
+!     
+        select case (config_flags%chem_opt)
+        case (RADM2SORG, RACMSORG,RACMSORG_KPP)
+           call sum_pm_sorgam (                                             &
+                rri, chem, h2oaj, h2oai,                                    &
+                pm2_5_dry, pm2_5_water, pm2_5_dry_ec, pm10,                 &
+                ids,ide, jds,jde, kds,kde,                                  &
+                ims,ime, jms,jme, kms,kme,                                  &
+                its,ite, jts,jte, kts,kte                                   )
+               
+        case (CBMZ_MOSAIC_AA, CBMZ_MOSAIC_BB)
+           call sum_pm_mosaic (                                             &
+                rri, chem,                                                  &
+                pm2_5_dry, pm2_5_water, pm2_5_dry_ec, pm10,                 &
+                ids,ide, jds,jde, kds,kde,                                  &
+                ims,ime, jms,jme, kms,kme,                                  &
+                its,ite, jts,jte, kts,kte                                   )
+               
+        case default
+           do j=jts,min(jte,jde-1)
+              do k=kts,min(kte,kde-1)
+                 do i=its,min(ite,ide-1)
+                    pm2_5_dry(i,k,j)    = 0.
+                    pm2_5_water(i,k,j)  = 0.
+                    pm2_5_dry_ec(i,k,j) = 0.
+                    pm10(i,k,j)         = 0.
+                 enddo
+              enddo
+           enddo
+        end select
+#endif
+      DEALLOCATE(SFULL)
+      DEALLOCATE(SMID)
+      DEALLOCATE(DZS)
+      DEALLOCATE(EMISS)
+      DEALLOCATE(GLW)
+      DEALLOCATE(HFX)
+      DEALLOCATE(LOWLYR)
+!     DEALLOCATE(MAVAIL)
+      DEALLOCATE(NCA)
+      DEALLOCATE(QFX)
+      DEALLOCATE(RAINBL)
+      DEALLOCATE(RAINC)
+      DEALLOCATE(RAINNC)
+      DEALLOCATE(RAINNCV)
+      DEALLOCATE(RQCBLTEN)
+      DEALLOCATE(RQIBLTEN)
+      DEALLOCATE(RQVBLTEN)
+      DEALLOCATE(RTHBLTEN)
+      DEALLOCATE(RUBLTEN)
+      DEALLOCATE(RVBLTEN)
+      DEALLOCATE(RQCCUTEN)
+      DEALLOCATE(RQICUTEN)
+      DEALLOCATE(RQRCUTEN)
+      DEALLOCATE(RQSCUTEN)
+      DEALLOCATE(RQVCUTEN)
+      DEALLOCATE(RTHCUTEN)
+      DEALLOCATE(RTHRATEN)
+      DEALLOCATE(RTHRATENLW)
+      DEALLOCATE(RTHRATENSW)
+      DEALLOCATE(ZINT)
+      DEALLOCATE(CONVFAC)
+      DEALLOCATE(RRI)
+!     DEALLOCATE(ZMID)
+      DEALLOCATE(SNOWC)
+      DEALLOCATE(THC)
+      DEALLOCATE(TMN)
+      DEALLOCATE(TSFC)
+      DEALLOCATE(ZS)
+#if 0
+      DEALLOCATE(W0AVG)
+#endif
+!-----------------------------------------------------------------------
+!----------------------------------------------------------------------
+        DO J=jfs,jfe
+        DO I=ifs,ife
+          DWDTMN(I,J)=DWDTMN(I,J)*HBM3(I,J)
+          DWDTMX(I,J)=DWDTMX(I,J)*HBM3(I,J)
+        ENDDO
+        ENDDO
+!----------------------------------------------------------------------
+!***  INITIALIZE 3RD INDEX IN WORKING ARRAYS USED IN PFDHT, DDAMP, AND  
+!***  HZADV.  THESE ARRAYS MUST HAVE AN EXTENT OF MORE THAN 1 IN J DUE 
+!***  TO THE MANY DIFFERENCES AND AVERAGES THAT ARE COMPUTED IN J
+!***  OR BECAUSE THE ARRAY IS SIMPLY REFERENCED AT MORE THAN ONE J.
+!***  THE WORKING "SPACE" SPANS FROM 3 ROWS SOUTH TO 3 ROWS NORTH
+!***  OF THE ROW FOR WHICH THE PRIMARY COMPUTATION IS BEING DONE
+!***  THUS THE 3RD DIMENSION CAN VARY FROM -3 TO +3 ALTHOUGH ALL OF
+!***  THESE ARRAYS DO NOT NEED TO SPAN THAT MANY ROWS.  FOR INSTANCE,
+!***  SOME OF THE ARRAYS ARE ONLY USED FROM 2 ROWS SOUTH TO 1 ROW 
+!***  NORTH, OR FROM 1 ROW SOUTH TO THE CENTRAL ROW.  AS THE INTEGRATION
+!***  MOVES NORTHWARD, THE SOUTHERNMOST I,K SLAB IS DROPPED FOR EACH
+!***  WORKING ARRAY AND THE NORTHERNMOST IS GENERATED.  SO AS NOT TO
+!***  HAVE TO ACTUALLY MOVE ANY OF THE I,K SLABS NORTHWARD, THE 3RD
+!***  INDEX IS CYCLED THROUGH THE EXTENT OF EACH ARRAY'S J DIMENSION.
+!***  THE FOLLOWING WILL FILL AN ARRAY WITH THE VALUES OF THE 3RD
+!***  INDEX FOR EACH THESE VARIATIONS OF J EXTENTS FOR ALL J's IN
+!***  THE LOCAL DOMAIN.
+!----------------------------------------------------------------------
+!
+!***  CASE 0: J EXTENT IS -3 TO 3
+!
+      KNT=0
+      DO J=MYJS2_P2,MYJE2_P2
+        KNT=KNT+1
+        JP3=KNT+2-7*((KNT+5)/7)
+        JP2=JP3-1+7*((4-JP3)/7)
+        JP1=JP2-1+7*((4-JP2)/7)
+        J00=JP1-1+7*((4-JP1)/7)
+        JM1=J00-1+7*((4-J00)/7)
+        JM2=JM1-1+7*((4-JM1)/7)
+        JM3=JM2-1+7*((4-JM2)/7)
+        INDX3_WRK(3,KNT,0)=JP3
+        INDX3_WRK(2,KNT,0)=JP2
+        INDX3_WRK(1,KNT,0)=JP1
+        INDX3_WRK(0,KNT,0)=J00
+        INDX3_WRK(-1,KNT,0)=JM1
+        INDX3_WRK(-2,KNT,0)=JM2
+        INDX3_WRK(-3,KNT,0)=JM3
+      ENDDO
+!
+!***  CASE 1: J EXTENT IS -2 TO 2
+!
+      KNT=0
+      DO J=MYJS2_P2,MYJE2_P2
+        KNT=KNT+1
+        JP2=KNT+1-5*((KNT+3)/5)
+        JP1=JP2-1+5*((3-JP2)/5)
+        J00=JP1-1+5*((3-JP1)/5)
+        JM1=J00-1+5*((3-J00)/5)
+        JM2=JM1-1+5*((3-JM1)/5)
+        INDX3_WRK(3,KNT,1)=999
+        INDX3_WRK(2,KNT,1)=JP2
+        INDX3_WRK(1,KNT,1)=JP1
+        INDX3_WRK(0,KNT,1)=J00
+        INDX3_WRK(-1,KNT,1)=JM1
+        INDX3_WRK(-2,KNT,1)=JM2
+        INDX3_WRK(-3,KNT,1)=999
+      ENDDO
+!
+!***  CASE 2: J EXTENT IS -2 TO 1
+!
+      KNT=0
+      DO J=MYJS2_P2,MYJE2_P2
+        KNT=KNT+1
+        JP1=KNT-4*((KNT+2)/4)
+        J00=JP1-1+4*((2-JP1)/4)
+        JM1=J00-1+4*((2-J00)/4)
+        JM2=JM1-1+4*((2-JM1)/4)
+        INDX3_WRK(3,KNT,2)=999
+        INDX3_WRK(2,KNT,2)=999
+        INDX3_WRK(1,KNT,2)=JP1
+        INDX3_WRK(0,KNT,2)=J00
+        INDX3_WRK(-1,KNT,2)=JM1
+        INDX3_WRK(-2,KNT,2)=JM2
+        INDX3_WRK(-3,KNT,2)=999
+      ENDDO
+!
+!***  CASE 3: J EXTENT IS -1 TO 2
+!
+      KNT=0
+      DO J=MYJS2_P2,MYJE2_P2
+        KNT=KNT+1
+        JP2=KNT+1-4*((KNT+2)/4)
+        JP1=JP2-1+4*((3-JP2)/4)
+        J00=JP1-1+4*((3-JP1)/4)
+        JM1=J00-1+4*((3-J00)/4)
+        INDX3_WRK(3,KNT,3)=999
+        INDX3_WRK(2,KNT,3)=JP2
+        INDX3_WRK(1,KNT,3)=JP1
+        INDX3_WRK(0,KNT,3)=J00
+        INDX3_WRK(-1,KNT,3)=JM1
+        INDX3_WRK(-2,KNT,3)=999
+        INDX3_WRK(-3,KNT,3)=999
+      ENDDO
+!
+!***  CASE 4: J EXTENT IS -1 TO 1
+!
+      KNT=0
+      DO J=MYJS2_P2,MYJE2_P2
+        KNT=KNT+1
+        JP1=KNT-3*((KNT+1)/3)
+        J00=JP1-1+3*((2-JP1)/3)
+        JM1=J00-1+3*((2-J00)/3)
+        INDX3_WRK(3,KNT,4)=999
+        INDX3_WRK(2,KNT,4)=999
+        INDX3_WRK(1,KNT,4)=JP1
+        INDX3_WRK(0,KNT,4)=J00
+        INDX3_WRK(-1,KNT,4)=JM1
+        INDX3_WRK(-2,KNT,4)=999
+        INDX3_WRK(-3,KNT,4)=999
+      ENDDO
+!
+!***  CASE 5: J EXTENT IS -1 TO 0
+!
+      KNT=0
+      DO J=MYJS2_P2,MYJE2_P2
+        KNT=KNT+1
+        J00=-MOD(KNT+1,2)
+        JM1=-1-J00
+        INDX3_WRK(3,KNT,5)=999
+        INDX3_WRK(2,KNT,5)=999
+        INDX3_WRK(1,KNT,5)=999
+        INDX3_WRK(0,KNT,5)=J00
+        INDX3_WRK(-1,KNT,5)=JM1
+        INDX3_WRK(-2,KNT,5)=999
+        INDX3_WRK(-3,KNT,5)=999
+      ENDDO
+!
+!***  CASE 6: J EXTENT IS 0 TO 1
+!
+      KNT=0
+      DO J=MYJS2_P2,MYJE2_P2
+        KNT=KNT+1
+        JP1=MOD(KNT,2)
+        J00=1-JP1
+        INDX3_WRK(3,KNT,6)=999
+        INDX3_WRK(2,KNT,6)=999
+        INDX3_WRK(1,KNT,6)=JP1
+        INDX3_WRK(0,KNT,6)=J00
+        INDX3_WRK(-1,KNT,6)=999
+        INDX3_WRK(-2,KNT,6)=999
+        INDX3_WRK(-3,KNT,6)=999
+      ENDDO
+
+#ifdef DM_PARALLEL
+#  include <HALO_NMM_INIT_1.inc>
+#  include <HALO_NMM_INIT_2.inc>
+#  include <HALO_NMM_INIT_3.inc>
+#  include <HALO_NMM_INIT_4.inc>
+#  include <HALO_NMM_INIT_5.inc>
+#  include <HALO_NMM_INIT_6.inc>
+#  include <HALO_NMM_INIT_7.inc>
+#  include <HALO_NMM_INIT_8.inc>
+#  include <HALO_NMM_INIT_9.inc>
+#  include <HALO_NMM_INIT_10.inc>
+#  include <HALO_NMM_INIT_11.inc>
+#  include <HALO_NMM_INIT_12.inc>
+#  include <HALO_NMM_INIT_13.inc>
+#  include <HALO_NMM_INIT_14.inc>
+#  include <HALO_NMM_INIT_15.inc>
+#  include <HALO_NMM_INIT_15B.inc>
+#  include <HALO_NMM_INIT_16.inc>
+#  include <HALO_NMM_INIT_17.inc>
+#  include <HALO_NMM_INIT_18.inc>
+#  include <HALO_NMM_INIT_19.inc>
+#  include <HALO_NMM_INIT_20.inc>
+#  include <HALO_NMM_INIT_21.inc>
+#  include <HALO_NMM_INIT_22.inc>
+#  include <HALO_NMM_INIT_23.inc>
+#  include <HALO_NMM_INIT_24.inc>
+#  include <HALO_NMM_INIT_25.inc>
+#  include <HALO_NMM_INIT_26.inc>
+#  include <HALO_NMM_INIT_27.inc>
+#  include <HALO_NMM_INIT_28.inc>
+#  include <HALO_NMM_INIT_29.inc>
+#  include <HALO_NMM_INIT_30.inc>
+#  include <HALO_NMM_INIT_31.inc>
+#  include <HALO_NMM_INIT_32.inc>
+#  include <HALO_NMM_INIT_33.inc>
+#  include <HALO_NMM_INIT_34.inc>
+#  include <HALO_NMM_INIT_35.inc>
+#  include <HALO_NMM_INIT_36.inc>
+#  include <HALO_NMM_INIT_37.inc>
+#  include <HALO_NMM_INIT_38.inc>
+#  include <HALO_NMM_INIT_39.inc>
+#endif
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+
+   RETURN
+
+
+END SUBROUTINE start_domain_nmm
+
Index: trunk/WRF.COMMON/WRFV2/external/IOAPI
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/IOAPI	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/IOAPI	(revision 2744)
@@ -0,0 +1,4 @@
+
+Please see http://www.mmm.ucar.edu/wrf/WG2/software_2.0/IOAPI.doc for the 
+latest documentation of the WRF I/O API.  
+
Index: trunk/WRF.COMMON/WRFV2/external/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/Makefile	(revision 2744)
@@ -0,0 +1,18 @@
+
+
+superclean :
+	( cd esmf_time_f90 ;  make superclean )
+	( cd io_netcdf ;  make superclean )
+	( cd io_pnetcdf ;  make superclean )
+	( cd io_int ; make superclean )
+	( cd io_mcel ;  make superclean )
+	( cd io_phdf5 ; make superclean )
+	( cd io_grib1 ; make superclean )
+	( cd io_grib_share ; make superclean )
+	( cd io_grib2 ; make superclean )
+	( cd io_esmf ;  make superclean )
+	( cd ioapi_share ;  make superclean )
+	( cd RSL/RSL ; make superclean )
+	( cd RSL_LITE ; make superclean )
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/LoopMacros.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/LoopMacros.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/LoopMacros.inc	(revision 2744)
@@ -0,0 +1,38 @@
+c#define OLDR90
+
+#ifdef OLDR90
+# define MAX_RUNPAD 0
+#else
+# define MAX_RUNPAD 2
+#endif
+
+#ifndef RSL_MAXRUN
+# define RSL_MAXRUN 700
+#endif
+
+
+#  define RSL_RUN_ARGS  xinest,nrunj,nruni,js,is,ie,is2,js2,je2,idif,jdif
+#  define RSL_RUN_VARS RSL_RUN_ARGS
+
+#  define RSL_INIT_RUNS(D) rsl_get_run_info(D,RSL_MAXRUN,RSL_RUN_VARS)
+
+#  define RSL_DECLARE_RUN_ARGS integer xinest,nrunj,nruni,js(nrunj),is(nrunj),ie(nrunj),is2(nruni),js2(nruni),je2(nruni),idif,jdif,nr,ig,jg
+#  define RSL_DECLARE_RUN_VARS integer xinest,nrunj,nruni,js(RSL_MAXRUN),is(RSL_MAXRUN),ie(RSL_MAXRUN),is2(RSL_MAXRUN),js2(RSL_MAXRUN),je2(RSL_MAXRUN),idif,jdif,nr,ig,jg
+
+#  define RSL_MAJOR_BOUND(J,L,H) if ((((J)-jdif).ge.(L)).and.(((J)-jdif).le.(H))) then
+#  define RSL_MINOR_BOUND(I,L,H) if ((((I)-idif).ge.(L)).and.(((I)-idif).le.(H))) then
+#  define RSL_END_BOUND  endif
+
+#  define RSL_MAJOR_LOOP(J) do nr=1+MAX_RUNPAD,nrunj+MAX_RUNPAD;J=js(nr);jg=J-jdif
+#  define RSL_END_MAJOR_LOOP enddo
+
+#  define RSL_MINOR_LOOP(I) do I=is(nr),ie(nr);ig=I-idif
+#  define RSL_END_MINOR_LOOP enddo
+
+#  define RSL_MAJOR_LOOPB(J,L,H) do nr=1+MAX_RUNPAD,nrunj+MAX_RUNPAD;J=js(nr);jg=J-jdif;RSL_MAJOR_BOUND(J,L,H)
+#  define RSL_END_MAJOR_LOOPB RSL_END_BOUND ; enddo
+
+#  define RSL_MINOR_LOOPB(I,L,H) do I=is(nr),ie(nr);ig=I-idif;RSL_MINOR_BOUND(I,L,H)
+#  define RSL_END_MINOR_LOOPB RSL_END_BOUND ; enddo
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/bcopy.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/bcopy.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/bcopy.c	(revision 2744)
@@ -0,0 +1,75 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+bcopy( a, b, n )
+  char *a, *b ;
+  int n ;
+{
+  register int i ;
+  for ( i = 0 ; i < n ; i++ )
+  {
+    *b++ = *a++ ;
+  }
+}
+
+bzero( a, n )
+  char *a ;
+  int n ;
+{
+  register int i ;
+  for ( i = 0 ; i < n ; i++ ) *a++ = '\0' ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/border.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/border.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/border.c	(revision 2744)
@@ -0,0 +1,158 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+static int zero = 0 ;
+
+rsl_processor_t
+locproc( i, m, numproc )
+  rsl_index_t i ;
+  rsl_dimlen_t m ;
+  rsl_processor_t numproc ;
+{
+  int val ;
+  rsl_processor_t retval ;
+
+  int ii, im, inumproc ;
+
+  ii = i ; im = m ; inumproc = numproc ;
+  c_locproc( &ii, &im, &inumproc, &zero, &zero, &val ) ;
+  retval = val ;
+  return( retval ) ;
+}
+  
+
+
+/***************************************************************************
+ patchmap routine:
+      Given position(p) in the global dimension (max) in the grid, with
+      margins of size ml (left/top) and mr (right/bottom), divide it among
+      the nproc processors in that dimension so the margins get at least
+      the margin and no more than width+1 processes.
+
+                          J A Mogill         19 April 1993
+****************************************************************************/
+
+c_locproc(p, max, nproc, ml, mr, ret)
+int *p, *max, *nproc, *ml, *mr, *ret;
+
+{ 
+  int width, rem, ret2, bl, br, mid, adjust;
+
+  int p_r, max_r, nproc_r, zero ;
+
+  adjust = 0;
+  rem = *max%*nproc;
+  width = *max/(*nproc);
+  mid = *max/2;
+
+  if(rem>0 && ((rem%2==0 || rem>2) || *p<=mid ))
+     width++;
+  if(*p<=mid && rem%2!=0)
+     adjust++;
+
+  bl = maximum(width,*ml);
+  br = maximum(width,*mr);
+
+  if(*p<bl)
+     *ret = 0;
+  else if(*p>*max-br-1)
+     *ret = *nproc-1;
+  else
+     {
+       p_r = *p-bl ;
+       max_r = *max-bl-br+adjust ;
+       nproc_r = maximum(*nproc-2,1) ;
+       zero = 0 ;
+
+       c_locproc( &p_r, &max_r, &nproc_r, &zero, &zero, &ret2);
+       *ret = ret2 + 1;
+     }
+}
+
+
+
+
+
+
+int maximum(x,y)
+int x,y;
+
+ {
+   if(x>=y)
+     return(x);
+   else
+     return(y);
+ }
+
+#if 0
+main()
+{
+   int i, m, numproc ;
+   m = 61 ;
+   numproc = 10 ;
+   for ( i = 0; i < 61 ; i++ ) 
+   {
+   printf("locproc(%d,%d,%d) = %d\n",i,m,numproc,locproc(i,m,numproc)) ;
+   }
+}
+#endif
+
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/boundary_safe.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/boundary_safe.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/boundary_safe.F	(revision 2744)
@@ -0,0 +1,281 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine boundary_safe( pid, bwdth, ix, jx, il, jl )
+      implicit none
+
+      integer bwdth		! boundary width
+      integer ix, jx		! static dimensions
+      integer il, jl		! effective dimensions
+      integer pid( ix, jx )	! map array
+
+      integer i, j, p, q, problem, strat, a, b
+
+c boundary safe in east-west -- we do not want the e/w boundaries
+c decomposed in this dimension. 
+
+c check western boundary
+      do i = 1, ix
+        problem = 0
+        p = pid(i,1)
+        do j = 1,bwdth
+          if ( p .ne. pid(i,j) .and. problem .eq. 0 ) problem = j
+        enddo
+        if ( problem .ne. 0 ) then
+
+           q = pid(i,problem)
+	   strat = 1
+           do j = problem, problem+bwdth-1
+             if ( pid(i,j) .ne. q ) then
+	       if ( j .le. bwdth ) then		! no hope for it
+                 write(0,*)'wb: problem with mapper: use patchmap'
+                 goto 890
+	       endif
+	       strat = 2
+             endif
+           enddo
+
+	   if ( strat .eq. 1 ) then		! stategy 1 -- move offending
+						! point(s) from boundary area
+             j = problem
+             do q = 1, bwdth
+               pid(i,q) = pid(i,j)
+               j = j+1
+             enddo
+             j = bwdth+1
+             do q = 1, problem-1
+               pid(i,j) = p
+               j = j+1
+             enddo
+	   else					! strategy 2 -- make all one
+						! or the other
+c	     write(0,*) 'wb using strat 2 on i=',i
+	     a = problem - 1		! # points on first proc
+	     b = bwdth - a 		! # points on second
+	     if ( a .lt. b ) then
+	       do j = 1, a
+		 pid( i, j ) = pid( i, bwdth ) 
+	       enddo
+	     else
+	       do j = a+1, bwdth
+		 pid( i, j ) = pid( i, 1 ) 
+	       enddo
+	     endif
+	   endif
+        endif
+      enddo
+c check southern boundary
+      do j = 1, jx
+        problem = 0
+        p = pid(1,j)
+        do i = 1,bwdth
+          if ( p .ne. pid(i,j) .and. problem .eq. 0 ) problem = i
+        enddo
+        if ( problem .ne. 0 ) then
+
+           q = pid(problem,j)
+           strat = 1
+           do i = problem, problem+bwdth-1
+             if ( pid(i,j) .ne. q ) then
+               if ( i .le. bwdth ) then           ! no hope for it
+                 write(0,*)'sb: problem with mapper: use patchmap'
+                 goto 890
+               endif
+               strat = 2
+             endif
+           enddo
+
+           if ( strat .eq. 1 ) then             ! stategy 1 -- move offending
+                                                ! point(s) from boundary area
+             i = problem
+             do q = 1, bwdth
+               pid(q,j) = pid(i,j)
+               i = i+1
+             enddo
+             i = bwdth+1
+             do q = 1, problem-1
+               pid(i,j) = p
+               i = i+1
+             enddo
+           else                                 ! strategy 2 -- make all one
+                                                ! or the other
+c             write(0,*) 'sb using strat 2 on j=',j
+             a = problem - 1            ! # points on first proc
+             b = bwdth - a              ! # points on second
+             if ( a .lt. b ) then
+               do i = 1, a
+                 pid( i, j ) = pid( bwdth, j )
+               enddo
+             else
+               do i = a+1, bwdth
+                 pid( i, j ) = pid( 1, j )
+               enddo
+             endif
+           endif
+        endif
+      enddo
+c check eastern boundary
+      do i = 1, ix
+        problem = 0
+        p = pid(i,jl)
+        do j = jl,jl-bwdth,-1   ! this covers bwdth+1 cells for beta grid
+          if ( p .ne. pid(i,j) .and. problem .eq. 0 ) problem = j
+        enddo
+        if ( problem .ne. 0 ) then
+
+           q = pid(i,problem)
+           strat = 1
+           do j = problem, problem-bwdth, -1
+             if ( pid(i,j) .ne. q ) then
+               if ( j .ge. jl-bwdth+1 ) then              ! no hope for it
+                 write(0,*)'eb: problem with mapper: use patchmap'
+                 goto 890
+               endif
+               strat = 2
+             endif
+           enddo
+
+           if ( strat .eq. 1 ) then             ! stategy 1 -- move offending
+                                                ! point(s) from boundary area
+             j = problem
+             do q = jl,jl-bwdth,-1
+               pid(i,q) = pid(i,j)
+               j = j-1
+             enddo
+             j = jl-bwdth-1
+             do q = jl,problem+1,-1
+               pid(i,j) = p
+               j = j-1
+             enddo
+           else                                 ! strategy 2 -- make all one
+                                                ! or the other
+c             write(0,*) 'eb using strat 2 on i=',i
+             a = jl - problem           ! # points on first proc
+             b = bwdth - a              ! # points on second
+             if ( a .lt. b ) then
+               do j = jl, jl-a+1, -1
+                 pid( i, j ) = pid( i, jl-bwdth+1 )
+               enddo
+             else
+               do j = jl-a, jl-bwdth+1, -1
+                 pid( i, j ) = pid( i, jl )
+               enddo
+             endif
+           endif
+        endif
+      enddo
+c check northern boundary
+      do j = 1, jx
+        problem = 0
+        p = pid(il,j)
+        do i = il,il-bwdth,-1   ! this covers bwdth+1 cells for beta grid
+          if ( p .ne. pid(i,j) .and. problem .eq. 0 ) problem = i
+        enddo
+        if ( problem .ne. 0 ) then
+
+           q = pid(problem,j)
+           strat = 1
+           do i = problem, problem-bwdth, -1
+             if ( pid(i,j) .ne. q ) then
+               if ( i .ge. il-bwdth+1 ) then              ! no hope for it
+                 write(0,*)'nb: problem with mapper: use patchmap'
+                 goto 890
+               endif
+               strat = 2
+             endif
+           enddo
+
+           if ( strat .eq. 1 ) then             ! stategy 1 -- move offending
+                                                ! point(s) from boundary area
+             i = problem
+             do q = il,il-bwdth,-1
+               pid(q,j) = pid(i,j)
+               i = i-1
+             enddo
+             i = il-bwdth-1
+             do q = il,problem+1,-1
+               pid(i,j) = p
+               i = i-1
+             enddo
+           else                                 ! strategy 2 -- make all one
+                                                ! or the other
+c             write(0,*) 'nb using strat 2 on j=',j
+             a = il - problem           ! # points on first proc
+             b = bwdth - a              ! # points on second
+             if ( a .lt. b ) then
+               do i = il, il-a+1, -1
+                 pid( i, j ) = pid( il-bwdth+1, j )
+               enddo
+             else
+               do i = il-a, il-bwdth+1, -1
+                 pid( i, j ) = pid( il, j )
+               enddo
+             endif
+
+           endif
+        endif
+      enddo
+
+c boundary safe in north-south -- we do not want the n/s boundaries
+c decomposed in this dimension
+
+      return
+ 890  continue
+      stop
+      end
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/buf_for_proc.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/buf_for_proc.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/buf_for_proc.c	(revision 2744)
@@ -0,0 +1,210 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+typedef struct bufdesc {
+  char * buf ;
+  int size ;
+} bufdesc_t ;
+
+/* buftab[RSL_SENDBUF] is send buffer descriptor,
+   buftab[RSL_RECVBUF] is recv buffer descriptor. */
+static bufdesc_t buftab[2][RSL_MAXPROC] ;
+static int first = 1 ;
+
+#ifdef NEC_TUNE
+/*
+   NECNOTE:
+   modify RSL message buffering scheme to utilize NEC Global Memory
+   to aid in performance of MPI Message Passing on Multi-node SX machines.
+*/
+#include <mpi.h>
+#include <malloc.h>
+#define MAXBUFSIZE 1024*1024*64 /* NEC Global Memory buffer size */
+#endif
+/* 
+   buffer_for_proc
+
+   returns a pointer to a buffer already allocated for processor P if
+   it is big enough; otherwise, it frees the existing buffer, if there
+   is one and then allocates a new one that is big enough.  If RSL_FREEBUF
+   is called for a P, the two buffers (send and recv) are truncated and
+   freed and NULL is returned.
+
+   You are guaranteed to get back the same buffer as the previous call
+   for a given P, as long as the size is less than the size passed to
+   the previous call.  Thus, you can use this routine to manage the
+   pointers to the buffers for P and avoid having to set up arrays
+   of pointers in the routines that use these buffers.
+
+*/
+
+char *
+buffer_for_proc( P, size, code )
+  rsl_processor_t P ;   /* processor number */
+  int size,		/* requested size */
+      code ;		/* RSL_SENDBUF, RSL_RECVBUF, or RSL_FREEBUF */
+{
+  rsl_processor_t p ;
+  int i, j ;
+  char * ret ;
+#ifdef NEC_TUNE
+  static char * private_buf ; /* pointer to NEC Global Memory */
+  static int cur_indx ;       /* size of total user memory requests */
+#endif
+
+  ret = NULL ;
+  if ( first )
+  {
+    for ( p = 0 ; p < RSL_MAXPROC ; p++ )
+    {
+      buftab[0][p].buf  = NULL ;    
+      buftab[1][p].buf  = NULL ;    
+      buftab[0][p].size = 0 ;    
+      buftab[1][p].size = 0 ;    
+    }
+#ifdef NEC_TUNE
+    MPI_Alloc_mem(MAXBUFSIZE, MPI_INFO_NULL, &private_buf) ;
+    cur_indx = 0 ;
+#endif
+    first = 0 ;
+  }
+  if ( P < 0 || P >= RSL_MAXPROC )
+  {
+#ifndef NEC_TUNE
+    sprintf(mess,"Bad P argument to buffer_for_proc.  P = %d. Has RSL_MESH been called?\n",P) ;
+    RSL_TEST_ERR( 1, mess ) ;
+#else
+    fprintf(stderr,"Bad P argument to buffer_for_proc.  P = %d. Has RSL_MESH been called?\n",P) ;
+#endif
+  }
+  if ( code == RSL_FREEBUF )
+  {
+/* fprintf(stderr,"buffer_for_proc freeing buffer %d\n",P) ; */
+/* NECNOTE: do not free Global Memory */
+#ifndef NEC_TUNE
+    if ( buftab[0][P].buf != NULL ) RSL_FREE( buftab[0][P].buf ) ;
+    if ( buftab[1][P].buf != NULL ) RSL_FREE( buftab[1][P].buf ) ;
+    buftab[0][P].buf  = NULL ;    
+    buftab[1][P].buf  = NULL ;    
+    buftab[0][P].size = 0 ;    
+    buftab[1][P].size = 0 ;    
+#endif
+/* show_tot_size() ; */
+  }
+  else if ( code == RSL_SENDBUF || code == RSL_RECVBUF )
+  {
+    if ( buftab[code][P].size < size )
+    {
+/* fprintf(stderr,"buffer_for_proc %s %d : was %d, increasing to %d\n",
+         (code == RSL_SENDBUF)?"RSL_SENDBUF":"RSL_RECVBUF",
+	 P,buftab[code][P].size, size+512) ; */
+#ifndef NEC_TUNE
+      if ( buftab[code][P].buf != NULL ) RSL_FREE( buftab[code][P].buf ) ;
+      buftab[code][P].buf = RSL_MALLOC(char,size+512) ;
+      buftab[code][P].size = size ;
+#else
+/*
+   NECNOTE:
+   if we exceed the GLOBAL MEMORY allocated, stop program.
+   user should increase MAXBUFSIZE above to fix problem.
+*/
+      if( (cur_indx+size) > MAXBUFSIZE )
+      {
+        fprintf(stderr,
+          "<<<buf_for_proc>>> exceeded MAXBUFSIZE %ld requested %ld bytes",
+          MAXBUFSIZE, cur_indx+size) ;
+        exit(3) ;
+      }
+      buftab[code][P].buf = private_buf ;
+      buftab[code][P].size = size ;
+      private_buf =  private_buf + size+512 ;
+      cur_indx = cur_indx + size+512 ;
+#endif
+/* show_tot_size() ; */
+    }
+    ret = buftab[code][P].buf ;
+  }
+  return(ret) ;
+}
+
+show_tot_size()
+{
+  int P ;
+  int acc ;
+  acc = 0 ;
+  for ( P = 0 ; P < RSL_MAXPROC ; P++ )
+  {
+    acc += buftab[0][P].size ;
+    acc += buftab[1][P].size ;
+  }
+#ifndef NEC_TUNE
+  fprintf(stderr,"Total bytes allocated for buffers: %d\n", acc ) ;
+#else
+  printf("Total bytes allocated for buffers: %d\n", acc ) ;
+#endif
+}
+
+int
+buffer_size_for_proc( P, code )
+  int P ;
+  int code ;
+{
+  return( buftab[code][P].size ) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/buf_for_proc.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/buf_for_proc.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/buf_for_proc.h	(revision 2744)
@@ -0,0 +1,68 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+
+
+#ifndef BUFFER_FOR_PROC_H
+#define BUFFER_FOR_PROC_H
+
+#define RSL_SENDBUF 0
+#define RSL_RECVBUF 1
+#define RSL_FREEBUF 2
+
+char * buffer_for_proc() ;	/* forward declaration */
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/build_rsltest
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/build_rsltest	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/build_rsltest	(revision 2744)
@@ -0,0 +1,19 @@
+#!/bin/csh
+
+# for IBM
+
+#setenv F90 "mpxlf -qfixed=132 -qnosave "
+#setenv RSLLIB RSL/librsl.a
+
+# for Alpha
+
+set echo
+
+setenv F90 "mpif90 -g -extend_source"
+#setenv F90 "f90 -g -extend_source"
+setenv RSLLIB ./librsl.a
+
+/lib/cpp -C -P rsltest.F > rsltest.f
+$F90 -c rsltest.f
+$F90 -o tst rsltest.o $RSLLIB
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd.c	(revision 2744)
@@ -0,0 +1,317 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+#ifdef STANDALONE
+  typedef int * int_p ;
+# define RSL_INVALID -1
+# define RSL_VALID 1
+# define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) )
+# define INDEX_3(A,B,NB,C,NC)  INDEX_2( (A), INDEX_2( (B), (C), (NC) ), (NB)*(NC))
+# define RSL_MALLOC(T,N)  (T *)malloc((sizeof(T))*(N))
+# define RSL_MALLOC(T,N)  (T *)malloc((sizeof(T))*(N))
+# define RSL_FREE(P)  free(P)
+# define BOUNDARY_SAFE boundary_safe_
+
+main()
+{
+  int i,m,n,py,px ;
+  int bwdth ;
+  int wk1[4000], wk2[4000] ;
+  for ( i = 0 ; i < 4000 ; i++ ) wk1[i] = RSL_VALID ;
+  printf("m n py px bwdth\n") ; scanf("%d %d %d %d %d",&m,&n,&py,&px,&bwdth) ;
+  rsl_default_decomp( wk1, wk2, NULL, &m,&n,&py,&px ) ;
+  if ( bwdth > 0 ) BOUNDARY_SAFE ( wk2, &bwdth, &m, &n, &m, &n ) ;
+  print_region( wk2, m,n) ; 
+}
+#else
+#  include "rsl.h"
+#endif
+
+/*#define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) ) */
+
+mark_line( wrk, m, n, x1, y1, x2, y2, val )
+  int wrk[] ;
+  int m, n, x1, y1, x2, y2, val ;
+{
+  int x, y, i, j, k ;
+  int yz, yz2, dex ;
+
+  double SLOPE, X, Y, DX, DY, dY, X1, X2, Y1, Y2 ;
+
+  X1 = x1 ;
+  X2 = x2 ;
+  DX = X2 - X1 ;
+  Y1 = y1 ;
+  Y2 = y2 ;
+  DY = Y2 - Y1 ;
+  if ( DX == 0.0 )
+  {
+    if ( y2 >= y1 )
+      for ( i = y1 ; i <= y2 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = val ;
+    else
+      for ( i = y2 ; i <= y1 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = val ;
+    return ;
+  }
+  else
+  {
+    SLOPE = DY/DX ;
+    dY = SLOPE * .5 ;
+  }
+
+  if ( x2 >= X1 )
+  {
+    Y = y1 + .5 ;
+    for ( X = x1+.5 ; X < x2+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = val ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = val ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x2, y2, m )] = val ;
+  }
+  else
+  {
+    Y = y2 + .5 ;
+    for ( X = x2+.5 ; X < x1+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = val ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = val ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x1, y1, m )] = val ;
+  }
+}
+
+fill_region( wrk, m, n, v, v2 )
+  int wrk[], m, n, v, v2 ;
+{
+  int x, y ;
+  
+  for ( y = 0 ; y < m ; y++ )
+  {
+    flood( 0, y, v, v2, wrk, m, n ) ;
+    flood( n-1, y, v, v2, wrk, m, n ) ;
+  }
+  for ( x = 0 ; x < n ; x++ )
+  {
+    flood( x, 0, v, v2, wrk, m, n ) ;
+    flood( x, m-1, v, v2, wrk, m, n ) ;
+  }
+}
+
+flood( x, y, v, v2, wrk, m, n )
+  int x, y, v, v2, wrk[], m, n ;
+{
+  if ( x < 0 || x >= n || y < 0 || y >= m )
+    return ;
+  if ( wrk[INDEX_2(x,y,m)] == v )
+  {
+    wrk[INDEX_2(x,y,m)] = v2 ;
+    flood( x+1, y  , v, v2, wrk, m, n ) ;
+    flood( x-1, y  , v, v2, wrk, m, n ) ;
+    flood( x  , y+1, v, v2, wrk, m, n ) ;
+    flood( x  , y-1, v, v2, wrk, m, n ) ;
+  }
+}
+
+decomp_region_2( wrk, m, n, py, px )
+  int wrk[], m, n, py, px ;
+{
+  int *wk ;
+  int x, y, ncells, nprocs, n_p, n_py, n_px, i, pid, p ;
+
+  wk = RSL_MALLOC( int, m*n ) ;
+
+  nprocs = px * py ;
+
+  ncells = 0 ;
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != -1 ) ncells++ ;
+  }
+
+  n_p = ncells / nprocs ;
+#if 0
+printf("ncells %d\n",ncells) ;
+printf("nprocs %d\n",nprocs) ;
+printf("n_p    %d\n",n_p) ;
+#endif
+
+  /* divide over py in m dimension first */
+  pid = -1 ;
+  i = 0 ;
+  n_py = ncells / py ;
+  for ( y = 0 ; y < m ; y++ )
+  {
+    for ( x = 0 ; x < n ; x++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != RSL_INVALID )
+      {
+        if ( i % n_py == 0 ) pid++ ;
+        i++ ;
+        if ( pid > py-1 ) pid = py-1 ;
+        wk[INDEX_2(x,y,m)] = pid ;
+      }
+    }
+  }
+
+  /* now divide over px in n dimension */
+  n_px = n_py / px ;
+  for ( p = 0 ; p < py ; p++ )
+  {
+    pid = -1 ;
+    i = 0 ;
+    for ( x = 0 ; x < n ; x++ )
+    {
+      for ( y = 0 ; y < m ; y++ )
+      {
+        if ( wk[INDEX_2(x,y,m)] == p )
+        {
+          if ( i % n_px == 0 ) pid++ ;
+          i++ ;
+          if ( pid > px-1 ) pid = px-1 ;
+          wk[INDEX_2(x,y,m)] = pid*10000 + p ;
+        }
+      }
+    }
+  }
+  
+  for ( x = 0 ; x < n ; x++ )
+    for ( y = 0 ; y < m ; y++ )
+  {
+    if (( p = wk[ INDEX_2( x, y, m ) ] ) != RSL_INVALID )
+    {
+      n_py = p % 10000 ;
+      n_px = p / 10000 ;
+      wrk[INDEX_2( x, y, m )] = n_py*px + n_px ;
+    }
+    else
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  RSL_FREE(wk) ;
+}
+
+print_region( wrk, m, n )
+  int wrk[], m, n ;
+{
+  int i, j ;
+  for ( i = m-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < n ; j++ )
+    {
+      if ( wrk[ INDEX_2( j, i, m ) ] == RSL_INVALID )
+        printf("  ." ) ;
+      else 
+	printf("%3d", wrk[ INDEX_2( j, i, m ) ] ) ;
+    }
+    printf("\n") ;
+  }
+}
+
+#ifndef vpp
+rsl_default_decomp( w1, w2, info_p, m_p, n_p, py_p, px_p )
+  int_p w1, w2, info_p, m_p, n_p, py_p, px_p ;
+{
+  int i ;
+  int bwdth ;
+
+  bwdth = HARD_CODED_BOUNDARY_WIDTH_FIX_ME_PLEASE ;
+
+  for ( i = 0 ; i < *n_p * *m_p ; i++ )
+    w2[i] = w1[i] ;
+  if ( regular_decomp )
+  {
+    patchmap( w2, *m_p, *n_p, *py_p, *px_p ) ;
+  }
+  else
+  {
+    decomp_region_2( w2, *m_p, *n_p, *py_p, *px_p ) ;
+  }
+  return(0) ;
+}
+#else
+rsl_default_decomp( w1, w2, info_p, m_p, n_p, py_p, px_p )
+  int_p w1, w2, info_p, m_p, n_p, py_p, px_p ;
+{
+  int i ;
+
+  for ( i = 0 ; i < *n_p * *m_p ; i++ )
+    w2[i] = w1[i] ;
+  patchmap( w2, *m_p, *n_p, *py_p, *px_p ) ;
+  return(0) ;
+}
+#endif
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd1.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd1.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd1.c	(revision 2744)
@@ -0,0 +1,489 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+
+#define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) )
+
+mark_line( wrk, m, n, x1, y1, x2, y2 )
+  int wrk[] ;
+  int m, n, x1, y1, x2, y2 ;
+{
+  int x, y, i, j, k ;
+  int yz, yz2, dex ;
+
+  double SLOPE, X, Y, DX, DY, dY, X1, X2, Y1, Y2 ;
+
+  X1 = x1 ;
+  X2 = x2 ;
+  DX = X2 - X1 ;
+  Y1 = y1 ;
+  Y2 = y2 ;
+  DY = Y2 - Y1 ;
+  if ( DX == 0.0 )
+  {
+    if ( y2 >= y1 )
+      for ( i = y1 ; i <= y2 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = 1 ;
+    else
+      for ( i = y2 ; i <= y1 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = 1 ;
+    return ;
+  }
+  else
+  {
+    SLOPE = DY/DX ;
+    dY = SLOPE * .5 ;
+  }
+
+  if ( x2 >= X1 )
+  {
+    Y = y1 + .5 ;
+    for ( X = x1+.5 ; X < x2+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = 1 ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = 1 ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x2, y2, m )] = 1 ;
+  }
+  else
+  {
+    Y = y2 + .5 ;
+    for ( X = x2+.5 ; X < x1+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = 1 ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = 1 ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x1, y1, m )] = 1 ;
+  }
+}
+
+fill_region( wrk, m, n )
+  int wrk[], m, n ;
+{
+  int x, y ;
+  
+  for ( y = 0 ; y < m ; y++ )
+  {
+    flood( 0, y, 0, 2, wrk, m, n ) ;
+    flood( n-1, y, 0, 2, wrk, m, n ) ;
+  }
+  for ( x = 0 ; x < n ; x++ )
+  {
+    flood( x, 0, 0, 2, wrk, m, n ) ;
+    flood( x, m-1, 0, 2, wrk, m, n ) ;
+  }
+
+  for ( y = 0 ; y < n ; y++ )
+  {
+    for ( x = 0 ; x < m ; x++ )
+    {
+      if      ( wrk[ INDEX_2(x,y,m) ] == 0 )
+        wrk[ INDEX_2(x,y,m) ] = 1 ;
+      else if ( wrk[ INDEX_2(x,y,m) ] == 2 )
+        wrk[ INDEX_2(x,y,m) ] = 0 ;
+    }
+  }
+}
+
+decomp_region_1( wrk, m, n, py, px )
+  int wrk[], m, n, py, px ;
+{
+  int *wk ;
+  int x, y, ncells, nprocs, n_p, n_py, n_px, i, pid, p ;
+
+  wk = (int*)malloc(m*n*sizeof(int)) ;
+
+  nprocs = px * py ;
+
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != 0 ) ncells++ ;
+  }
+
+  n_p = ncells / nprocs ;
+
+  /* divide over py in m dimension first */
+  pid = 0 ;
+  i = 0 ;
+  n_py = ncells / py ;
+  for ( y = 0 ; y < m ; y++ )
+  {
+    for ( x = 0 ; x < n ; x++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )   /* only do cells in partition */
+      {
+        i++ ;
+        if ( i % n_py == 0 ) pid++ ;
+        wk[INDEX_2(x,y,m)] = pid ;
+      }
+    }
+  }
+
+  /* now divide over px in n dimension */
+  n_px = n_py / px ;
+  for ( p = 0 ; p < py ; p++ )
+  {
+    pid = 0 ;
+    i = 0 ;
+    for ( x = 0 ; x < n ; x++ )
+    {
+      for ( y = 0 ; y < m ; y++ )
+      {
+        if ( wk[INDEX_2(x,y,m)] == p )
+        {
+          i++ ;
+          if ( i % n_px == 0 ) pid++ ;
+          if ( pid > px-1 ) pid = px-1 ;
+          wk[INDEX_2(x,y,m)] = pid*10000 + p ;
+        }
+      }
+    }
+  }
+  
+  for ( x = 0 ; x < n ; x++ )
+    for ( y = 0 ; y < m ; y++ )
+  {
+    if (( p = wk[ INDEX_2( x, y, m ) ] ) != -1 )
+    {
+      n_py = p % 10000 ;
+      n_px = p / 10000 ;
+      wrk[INDEX_2( x, y, m )] = n_py*px + n_px ;
+    }
+    else
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  free(wk) ;
+}
+
+decomp_region_2( wrk, m, n, py, px )
+  int wrk[], m, n, py, px ;
+{
+  int *wk ;
+  int x, y, ncells, nprocs, n_p, n_py, n_px, i, pid, p ;
+
+
+  printf("decomp_region_2( wrk, %d, %d, %d, %d )\n",m, n, py, px ) ;
+  wk = (int*)malloc(m*n*sizeof(int)) ;
+
+  nprocs = px * py ;
+
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != 0 ) ncells++ ;
+  }
+
+  n_p = ncells / nprocs ;
+
+  dc2( 0, nprocs, wk, wrk, m, n, py, px, n_p ) ;
+  
+  for ( x = 0 ; x < n ; x++ )
+    for ( y = 0 ; y < m ; y++ )
+  {
+    if (( p = wk[ INDEX_2( x, y, m ) ] ) != -1 )
+    {
+      n_py = p % 10000 ;
+      n_px = p / 10000 ;
+      wrk[INDEX_2( x, y, m )] = n_py*px + n_px ;
+    }
+    else
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  free(wk) ;
+}
+
+dc2( p, nprocs, wk, wrk, m, n, py, px, n_p )
+  int p, nprocs, wk[], wrk[], m, n, py, px, n_p ;
+{
+  int x, y, i, v, flg, reach, oldi ;
+
+  if ( p >= nprocs ) return ;
+
+  printf("dc2(%d, %d, wk, wk, %d, %d, %d, %d, %d)\n",p, nprocs,m, n, py, px, n_p );
+
+
+  for ( x = 0 ; x < n ; x++ )
+  {
+    flg = 1 ;
+    for ( y = 0 ; y < m && flg ; y++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( y = 0 ; y < m ; y++ )
+  {
+    flg = 1 ;
+    for ( x = n-1 ; x >= 0 && flg ; x-- )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( x = n-1 ; x >=0 ; x-- )
+  {
+    flg = 1 ;
+    for ( y = m-1 ; y >=0 && flg ; y-- )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( y = m-1 ; y >= 0 ; y-- )
+  {
+    flg = 1 ;
+    for ( x = 0 ; x < n && flg ; x++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( x = 0 ; x < n ; x++ )
+  {
+    for ( y = 0 ; y < m ; y++ )
+    {
+      v = wk[INDEX_2(x,y,m)] ;
+      if ( v == -1 && wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        goto breakout ;
+      }
+    }
+  }
+
+breakout:
+  if ( x == n ) return ;                /* done, none found */
+
+  printf("dc2: p %d v %d x %d y %d  wrk %d\n", p,v,x,y,wrk[INDEX_2(x,y,m)]) ;
+  
+  reach = 0 ;
+  i = 0 ;
+  /* start acreting outward until we're stopped dead or we get enough */
+  while ( (i < n_p) )
+  {
+    reach++ ;
+    oldi = i ;
+    acrete( wk, wrk, p, &i, n_p, reach, x, y, m, n ) ;
+    if ( i == oldi ) break ;
+  }
+
+  printf("\n") ;
+  print_region( wk, m, n ) ;
+
+  dc2( p+1, nprocs, wk, wrk, m, n, py, px, n_p ) ;
+}
+
+#define T(X,Y) \
+   {                                                                    \
+     if( (X) >= 0 && (X) < n && (Y) >= 0 && (Y) < m && *i < n_p )       \
+       if (wk[INDEX_2((X),(Y),m)]==-1&&wrk[INDEX_2((X),(Y),m)]!=0)      \
+       {                                                                \
+	   setone = 1 ;							\
+           wk[INDEX_2((X),(Y),m)] = p ;                                 \
+           *i = *i + 1 ;                                                \
+       }                                                                \
+   }
+
+acrete( wk, wrk, p, i, n_p, reach, x, y, m, n )
+  int wk[], wrk[], p, *i, n_p ;
+{
+  int setone ;
+
+  if ( reach == 0 ) return ;
+  if ( *i >= n_p ) return ;
+  if ( !(x >= 0 && x < n && y >= 0 && y < m) ) return ;
+  if ( wrk[INDEX_2(x,y,m)]==0 ) return ;
+  if ( wk[INDEX_2(x,y,m)]!=-1 && wk[INDEX_2(x,y,m)]!= p) return ;
+
+  /*
+  if ( p == 5 && reach == 1 )
+  printf("acrete(wk,wrk, p %d, *i %d, n_p %d, reach %d, x %d, y %d, m %d, n %d)\n",p, *i, n_p, reach, x, y, m, n ) ;
+  */
+
+  T( x   , y   ) ;
+  T( x-1 , y+1 ) ;
+  T( x   , y+1 ) ;
+  T( x+1 , y+1 ) ;
+  T( x-1 , y   ) ;
+  T( x+1 , y   ) ;
+  T( x-1 , y-1 ) ;
+  T( x   , y-1 ) ;
+  T( x+1 , y-1 ) ;
+
+  acrete( wk, wrk, p, i, n_p, reach-1, x-1 , y-1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x-1 , y   , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x-1 , y+1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x   , y+1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x+1 , y+1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x+1 , y   , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x+1 , y-1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x   , y-1 , m, n ) ;
+
+}
+
+
+flood( x, y, v, v2, wrk, m, n )
+  int x, y, v, v2, wrk[], m, n ;
+{
+  if ( x < 0 || x >= n || y < 0 || y >= m )
+    return ;
+  if ( wrk[INDEX_2(x,y,m)] == v )
+  {
+    wrk[INDEX_2(x,y,m)] = v2 ;
+    flood( x+1, y  , v, v2, wrk, m, n ) ;
+    flood( x-1, y  , v, v2, wrk, m, n ) ;
+    flood( x  , y+1, v, v2, wrk, m, n ) ;
+    flood( x  , y-1, v, v2, wrk, m, n ) ;
+  }
+}
+
+print_region( wrk, m, n )
+  int wrk[], m, n ;
+{
+  int i, j ;
+  for ( i = m-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < n ; j++ )
+    {
+      if ( wrk[ INDEX_2( j, i, m ) ] == -1 )
+        printf("  ." ) ;
+      else 
+	printf("%3d", wrk[ INDEX_2( j, i, m ) ] ) ;
+    }
+    printf("\n") ;
+  }
+}
+
+/****************/
+
+main()
+{
+  /*      n   m */
+  int wrk[100 * 100] ;
+  int i, j, m, n, x1, y1, x2, y2, py, px, opt ;
+
+  for ( i = 0 ; i < 100*100 ; i++ ) wrk[i] = 0 ;
+
+  scanf("%d %d", &m, &n) ;
+  scanf("%d %d %d", &py, &px, &opt) ;
+  scanf("%d %d", &x1, &y1) ;
+  while ( scanf("%d %d", &x2, &y2) != EOF )
+  {
+    mark_line( wrk, m, n, x1, y1, x2, y2 ) ;
+    x1 = x2 ;
+    y1 = y2 ;
+  }
+
+  /* print_region( wrk, m, n ) ; */
+
+  fill_region( wrk, m, n ) ;
+
+  /* print_region( wrk, m, n ) ; */
+
+  switch ( opt )
+  {
+    case 1 : decomp_region_1( wrk, m, n, py, px ) ;
+	     print_region( wrk, m, n ) ;
+	     break ;
+    case 2 : decomp_region_2( wrk, m, n, py, px ) ;
+	     break ; 
+    default : break ;
+  }
+
+  printf("\n") ;
+
+
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd2.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd2.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd2.c	(revision 2744)
@@ -0,0 +1,489 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+
+#define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) )
+
+mark_line( wrk, m, n, x1, y1, x2, y2 )
+  int wrk[] ;
+  int m, n, x1, y1, x2, y2 ;
+{
+  int x, y, i, j, k ;
+  int yz, yz2, dex ;
+
+  double SLOPE, X, Y, DX, DY, dY, X1, X2, Y1, Y2 ;
+
+  X1 = x1 ;
+  X2 = x2 ;
+  DX = X2 - X1 ;
+  Y1 = y1 ;
+  Y2 = y2 ;
+  DY = Y2 - Y1 ;
+  if ( DX == 0.0 )
+  {
+    if ( y2 >= y1 )
+      for ( i = y1 ; i <= y2 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = 1 ;
+    else
+      for ( i = y2 ; i <= y1 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = 1 ;
+    return ;
+  }
+  else
+  {
+    SLOPE = DY/DX ;
+    dY = SLOPE * .5 ;
+  }
+
+  if ( x2 >= X1 )
+  {
+    Y = y1 + .5 ;
+    for ( X = x1+.5 ; X < x2+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = 1 ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = 1 ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x2, y2, m )] = 1 ;
+  }
+  else
+  {
+    Y = y2 + .5 ;
+    for ( X = x2+.5 ; X < x1+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = 1 ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = 1 ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x1, y1, m )] = 1 ;
+  }
+}
+
+fill_region( wrk, m, n )
+  int wrk[], m, n ;
+{
+  int x, y ;
+  
+  for ( y = 0 ; y < m ; y++ )
+  {
+    flood( 0, y, 0, 2, wrk, m, n ) ;
+    flood( n-1, y, 0, 2, wrk, m, n ) ;
+  }
+  for ( x = 0 ; x < n ; x++ )
+  {
+    flood( x, 0, 0, 2, wrk, m, n ) ;
+    flood( x, m-1, 0, 2, wrk, m, n ) ;
+  }
+
+  for ( y = 0 ; y < n ; y++ )
+  {
+    for ( x = 0 ; x < m ; x++ )
+    {
+      if      ( wrk[ INDEX_2(x,y,m) ] == 0 )
+        wrk[ INDEX_2(x,y,m) ] = 1 ;
+      else if ( wrk[ INDEX_2(x,y,m) ] == 2 )
+        wrk[ INDEX_2(x,y,m) ] = 0 ;
+    }
+  }
+}
+
+decomp_region_1( wrk, m, n, py, px )
+  int wrk[], m, n, py, px ;
+{
+  int *wk ;
+  int x, y, ncells, nprocs, n_p, n_py, n_px, i, pid, p ;
+
+  wk = (int*)malloc(m*n*sizeof(int)) ;
+
+  nprocs = px * py ;
+
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != 0 ) ncells++ ;
+  }
+
+  n_p = ncells / nprocs ;
+
+  /* divide over py in m dimension first */
+  pid = 0 ;
+  i = 0 ;
+  n_py = ncells / py ;
+  for ( y = 0 ; y < m ; y++ )
+  {
+    for ( x = 0 ; x < n ; x++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )   /* only do cells in partition */
+      {
+        i++ ;
+        if ( i % n_py == 0 ) pid++ ;
+        wk[INDEX_2(x,y,m)] = pid ;
+      }
+    }
+  }
+
+  /* now divide over px in n dimension */
+  n_px = n_py / px ;
+  for ( p = 0 ; p < py ; p++ )
+  {
+    pid = 0 ;
+    i = 0 ;
+    for ( x = 0 ; x < n ; x++ )
+    {
+      for ( y = 0 ; y < m ; y++ )
+      {
+        if ( wk[INDEX_2(x,y,m)] == p )
+        {
+          i++ ;
+          if ( i % n_px == 0 ) pid++ ;
+          if ( pid > px-1 ) pid = px-1 ;
+          wk[INDEX_2(x,y,m)] = pid*10000 + p ;
+        }
+      }
+    }
+  }
+  
+  for ( x = 0 ; x < n ; x++ )
+    for ( y = 0 ; y < m ; y++ )
+  {
+    if (( p = wk[ INDEX_2( x, y, m ) ] ) != -1 )
+    {
+      n_py = p % 10000 ;
+      n_px = p / 10000 ;
+      wrk[INDEX_2( x, y, m )] = n_py*px + n_px ;
+    }
+    else
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  free(wk) ;
+}
+
+decomp_region_2( wrk, m, n, py, px )
+  int wrk[], m, n, py, px ;
+{
+  int *wk ;
+  int x, y, ncells, nprocs, n_p, n_py, n_px, i, pid, p ;
+
+
+  printf("decomp_region_2( wrk, %d, %d, %d, %d )\n",m, n, py, px ) ;
+  wk = (int*)malloc(m*n*sizeof(int)) ;
+
+  nprocs = px * py ;
+
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != 0 ) ncells++ ;
+  }
+
+  n_p = ncells / nprocs ;
+
+  dc2( 0, nprocs, wk, wrk, m, n, py, px, n_p ) ;
+  
+  for ( x = 0 ; x < n ; x++ )
+    for ( y = 0 ; y < m ; y++ )
+  {
+    if (( p = wk[ INDEX_2( x, y, m ) ] ) != -1 )
+    {
+      n_py = p % 10000 ;
+      n_px = p / 10000 ;
+      wrk[INDEX_2( x, y, m )] = n_py*px + n_px ;
+    }
+    else
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  free(wk) ;
+}
+
+dc2( p, nprocs, wk, wrk, m, n, py, px, n_p )
+  int p, nprocs, wk[], wrk[], m, n, py, px, n_p ;
+{
+  int x, y, i, v, flg, reach, oldi ;
+
+  if ( p >= nprocs ) return ;
+
+  printf("dc2(%d, %d, wk, wk, %d, %d, %d, %d, %d)\n",p, nprocs,m, n, py, px, n_p );
+
+
+  for ( x = 0 ; x < n ; x++ )
+  {
+    flg = 1 ;
+    for ( y = 0 ; y < m && flg ; y++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( y = 0 ; y < m ; y++ )
+  {
+    flg = 1 ;
+    for ( x = n-1 ; x >= 0 && flg ; x-- )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( x = n-1 ; x >=0 ; x-- )
+  {
+    flg = 1 ;
+    for ( y = m-1 ; y >=0 && flg ; y-- )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( y = m-1 ; y >= 0 ; y-- )
+  {
+    flg = 1 ;
+    for ( x = 0 ; x < n && flg ; x++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( x = 0 ; x < n ; x++ )
+  {
+    for ( y = 0 ; y < m ; y++ )
+    {
+      v = wk[INDEX_2(x,y,m)] ;
+      if ( v == -1 && wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        goto breakout ;
+      }
+    }
+  }
+
+breakout:
+  if ( x == n ) return ;                /* done, none found */
+
+  printf("dc2: p %d v %d x %d y %d  wrk %d\n", p,v,x,y,wrk[INDEX_2(x,y,m)]) ;
+  
+  reach = 0 ;
+  i = 0 ;
+  /* start acreting outward until we're stopped dead or we get enough */
+  while ( (i < n_p) )
+  {
+    reach++ ;
+    oldi = i ;
+    acrete( wk, wrk, p, &i, n_p, reach, x, y, m, n ) ;
+    if ( i == oldi ) break ;
+  }
+
+  printf("\n") ;
+  print_region( wk, m, n ) ;
+
+  dc2( p+1, nprocs, wk, wrk, m, n, py, px, n_p ) ;
+}
+
+#define T(X,Y) \
+   {                                                                    \
+     if( (X) >= 0 && (X) < n && (Y) >= 0 && (Y) < m && *i < n_p )       \
+       if (wk[INDEX_2((X),(Y),m)]==-1&&wrk[INDEX_2((X),(Y),m)]!=0)      \
+       {                                                                \
+	   setone = 1 ;							\
+           wk[INDEX_2((X),(Y),m)] = p ;                                 \
+           *i = *i + 1 ;                                                \
+       }                                                                \
+   }
+
+acrete( wk, wrk, p, i, n_p, reach, x, y, m, n )
+  int wk[], wrk[], p, *i, n_p ;
+{
+  int setone ;
+
+  if ( reach == 0 ) return ;
+  if ( *i >= n_p ) return ;
+  if ( !(x >= 0 && x < n && y >= 0 && y < m) ) return ;
+  if ( wrk[INDEX_2(x,y,m)]==0 ) return ;
+  if ( wk[INDEX_2(x,y,m)]!=-1 && wk[INDEX_2(x,y,m)]!= p) return ;
+
+  /*
+  if ( p == 5 && reach == 1 )
+  printf("acrete(wk,wrk, p %d, *i %d, n_p %d, reach %d, x %d, y %d, m %d, n %d)\n",p, *i, n_p, reach, x, y, m, n ) ;
+  */
+
+  T( x   , y   ) ;
+  T( x-1 , y+1 ) ;
+  T( x   , y+1 ) ;
+  T( x+1 , y+1 ) ;
+  T( x-1 , y   ) ;
+  T( x+1 , y   ) ;
+  T( x-1 , y-1 ) ;
+  T( x   , y-1 ) ;
+  T( x+1 , y-1 ) ;
+
+  acrete( wk, wrk, p, i, n_p, reach-1, x-1 , y-1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x-1 , y   , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x-1 , y+1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x   , y+1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x+1 , y+1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x+1 , y   , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x+1 , y-1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x   , y-1 , m, n ) ;
+
+}
+
+
+flood( x, y, v, v2, wrk, m, n )
+  int x, y, v, v2, wrk[], m, n ;
+{
+  if ( x < 0 || x >= n || y < 0 || y >= m )
+    return ;
+  if ( wrk[INDEX_2(x,y,m)] == v )
+  {
+    wrk[INDEX_2(x,y,m)] = v2 ;
+    flood( x+1, y  , v, v2, wrk, m, n ) ;
+    flood( x-1, y  , v, v2, wrk, m, n ) ;
+    flood( x  , y+1, v, v2, wrk, m, n ) ;
+    flood( x  , y-1, v, v2, wrk, m, n ) ;
+  }
+}
+
+print_region( wrk, m, n )
+  int wrk[], m, n ;
+{
+  int i, j ;
+  for ( i = m-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < n ; j++ )
+    {
+      if ( wrk[ INDEX_2( j, i, m ) ] == -1 )
+        printf("  ." ) ;
+      else 
+	printf("%3d", wrk[ INDEX_2( j, i, m ) ] ) ;
+    }
+    printf("\n") ;
+  }
+}
+
+/****************/
+
+main()
+{
+  /*      n   m */
+  int wrk[100 * 100] ;
+  int i, j, m, n, x1, y1, x2, y2, py, px, opt ;
+
+  for ( i = 0 ; i < 100*100 ; i++ ) wrk[i] = 0 ;
+
+  scanf("%d %d", &m, &n) ;
+  scanf("%d %d %d", &py, &px, &opt) ;
+  scanf("%d %d", &x1, &y1) ;
+  while ( scanf("%d %d", &x2, &y2) != EOF )
+  {
+    mark_line( wrk, m, n, x1, y1, x2, y2 ) ;
+    x1 = x2 ;
+    y1 = y2 ;
+  }
+
+  /* print_region( wrk, m, n ) ; */
+
+  fill_region( wrk, m, n ) ;
+
+  /* print_region( wrk, m, n ) ; */
+
+  switch ( opt )
+  {
+    case 1 : decomp_region_1( wrk, m, n, py, px ) ;
+	     print_region( wrk, m, n ) ;
+	     break ;
+    case 2 : decomp_region_2( wrk, m, n, py, px ) ;
+	     break ; 
+    default : break ;
+  }
+
+  printf("\n") ;
+
+
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd3.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd3.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd3.c	(revision 2744)
@@ -0,0 +1,487 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+
+#define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) )
+
+mark_line( wrk, m, n, x1, y1, x2, y2, val )
+  int wrk[] ;
+  int m, n, x1, y1, x2, y2, val ;
+{
+  int x, y, i, j, k ;
+  int yz, yz2, dex ;
+
+  double SLOPE, X, Y, DX, DY, dY, X1, X2, Y1, Y2 ;
+
+  X1 = x1 ;
+  X2 = x2 ;
+  DX = X2 - X1 ;
+  Y1 = y1 ;
+  Y2 = y2 ;
+  DY = Y2 - Y1 ;
+  if ( DX == 0.0 )
+  {
+    if ( y2 >= y1 )
+      for ( i = y1 ; i <= y2 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = val ;
+    else
+      for ( i = y2 ; i <= y1 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = val ;
+    return ;
+  }
+  else
+  {
+    SLOPE = DY/DX ;
+    dY = SLOPE * .5 ;
+  }
+
+  if ( x2 >= X1 )
+  {
+    Y = y1 + .5 ;
+    for ( X = x1+.5 ; X < x2+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = val ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = val ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x2, y2, m )] = val ;
+  }
+  else
+  {
+    Y = y2 + .5 ;
+    for ( X = x2+.5 ; X < x1+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = val ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = val ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x1, y1, m )] = val ;
+  }
+}
+
+fill_region( wrk, m, n, v, v2 )
+  int wrk[], m, n, v, v2 ;
+{
+  int x, y ;
+  
+  for ( y = 0 ; y < m ; y++ )
+  {
+    flood( 0, y, v, v2, wrk, m, n ) ;
+    flood( n-1, y, v, v2, wrk, m, n ) ;
+  }
+  for ( x = 0 ; x < n ; x++ )
+  {
+    flood( x, 0, v, v2, wrk, m, n ) ;
+    flood( x, m-1, v, v2, wrk, m, n ) ;
+  }
+}
+
+decomp_region_1( wrk, m, n, py, px )
+  int wrk[], m, n, py, px ;
+{
+  int *wk ;
+  int x, y, ncells, nprocs, n_p, n_py, n_px, i, pid, p ;
+
+  wk = (int*)malloc(m*n*sizeof(int)) ;
+
+  nprocs = px * py ;
+
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != 0 ) ncells++ ;
+  }
+
+  n_p = ncells / nprocs ;
+
+  /* divide over py in m dimension first */
+  pid = -1 ;
+  i = 0 ;
+  n_py = ncells / py ;
+  for ( y = 0 ; y < m ; y++ )
+  {
+    for ( x = 0 ; x < n ; x++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )   /* only do cells in partition */
+      {
+        if ( i % n_py == 0 ) pid++ ;
+        i++ ;
+        if ( pid > px-1 ) pid = px-1 ;
+        wk[INDEX_2(x,y,m)] = pid ;
+      }
+    }
+  }
+
+  /* now divide over px in n dimension */
+  n_px = n_py / px ;
+  for ( p = 0 ; p < py ; p++ )
+  {
+    pid = -1 ;
+    i = 0 ;
+    for ( x = 0 ; x < n ; x++ )
+    {
+      for ( y = 0 ; y < m ; y++ )
+      {
+        if ( wk[INDEX_2(x,y,m)] == p )
+        {
+          if ( i % n_px == 0 ) pid++ ;
+          i++ ;
+          if ( pid > py-1 ) pid = py-1 ;
+          wk[INDEX_2(x,y,m)] = pid*10000 + p ;
+        }
+      }
+    }
+  }
+  
+  for ( x = 0 ; x < n ; x++ )
+    for ( y = 0 ; y < m ; y++ )
+  {
+    if (( p = wk[ INDEX_2( x, y, m ) ] ) != -1 )
+    {
+      n_py = p % 10000 ;
+      n_px = p / 10000 ;
+      wrk[INDEX_2( x, y, m )] = n_py*px + n_px ;
+    }
+    else
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  free(wk) ;
+}
+
+decomp_region_2( wrk, m, n, py, px )
+  int wrk[], m, n, py, px ;
+{
+  int *wk ;
+  int x, y, ncells, nprocs, n_p, n_py, n_px, i, pid, p ;
+
+
+  printf("decomp_region_2( wrk, %d, %d, %d, %d )\n",m, n, py, px ) ;
+  wk = (int*)malloc(m*n*sizeof(int)) ;
+
+  nprocs = px * py ;
+
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != 0 ) ncells++ ;
+  }
+
+  n_p = ncells / nprocs ;
+
+  dc2( 0, nprocs, wk, wrk, m, n, py, px, n_p ) ;
+  
+  for ( x = 0 ; x < n ; x++ )
+    for ( y = 0 ; y < m ; y++ )
+  {
+    if (( p = wk[ INDEX_2( x, y, m ) ] ) != -1 )
+    {
+      n_py = p % 10000 ;
+      n_px = p / 10000 ;
+      wrk[INDEX_2( x, y, m )] = n_py*px + n_px ;
+    }
+    else
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  free(wk) ;
+}
+
+dc2( p, nprocs, wk, wrk, m, n, py, px, n_p )
+  int p, nprocs, wk[], wrk[], m, n, py, px, n_p ;
+{
+  int x, y, i, v, flg, reach, oldi ;
+
+  if ( p >= nprocs ) return ;
+
+  printf("dc2(%d, %d, wk, wk, %d, %d, %d, %d, %d)\n",p, nprocs,m, n, py, px, n_p );
+
+
+  for ( x = 0 ; x < n ; x++ )
+  {
+    flg = 1 ;
+    for ( y = 0 ; y < m && flg ; y++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( y = 0 ; y < m ; y++ )
+  {
+    flg = 1 ;
+    for ( x = n-1 ; x >= 0 && flg ; x-- )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( x = n-1 ; x >=0 ; x-- )
+  {
+    flg = 1 ;
+    for ( y = m-1 ; y >=0 && flg ; y-- )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( y = m-1 ; y >= 0 ; y-- )
+  {
+    flg = 1 ;
+    for ( x = 0 ; x < n && flg ; x++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        if ( wk[INDEX_2(x,y,m)] == -1 ) goto breakout ;
+        if ( wk[INDEX_2(x,y,m)] != -1 ) flg = 0 ; 
+      }
+    }
+  }
+
+  for ( x = 0 ; x < n ; x++ )
+  {
+    for ( y = 0 ; y < m ; y++ )
+    {
+      v = wk[INDEX_2(x,y,m)] ;
+      if ( v == -1 && wrk[INDEX_2(x,y,m)] != 0 )
+      {
+        goto breakout ;
+      }
+    }
+  }
+
+breakout:
+  if ( x == n ) return ;                /* done, none found */
+
+  printf("dc2: p %d v %d x %d y %d  wrk %d\n", p,v,x,y,wrk[INDEX_2(x,y,m)]) ;
+  
+  reach = 0 ;
+  i = 0 ;
+  /* start acreting outward until we're stopped dead or we get enough */
+  while ( (i < n_p) )
+  {
+    reach++ ;
+    oldi = i ;
+    acrete( wk, wrk, p, &i, n_p, reach, x, y, m, n ) ;
+    if ( i == oldi ) break ;
+  }
+
+  printf("\n") ;
+  print_region( wk, m, n ) ;
+
+  dc2( p+1, nprocs, wk, wrk, m, n, py, px, n_p ) ;
+}
+
+#define T(X,Y) \
+   {                                                                    \
+     if( (X) >= 0 && (X) < n && (Y) >= 0 && (Y) < m && *i < n_p )       \
+       if (wk[INDEX_2((X),(Y),m)]==-1&&wrk[INDEX_2((X),(Y),m)]!=0)      \
+       {                                                                \
+	   setone = 1 ;							\
+           wk[INDEX_2((X),(Y),m)] = p ;                                 \
+           *i = *i + 1 ;                                                \
+       }                                                                \
+   }
+
+acrete( wk, wrk, p, i, n_p, reach, x, y, m, n )
+  int wk[], wrk[], p, *i, n_p ;
+{
+  int setone ;
+
+  if ( reach == 0 ) return ;
+  if ( *i >= n_p ) return ;
+  if ( !(x >= 0 && x < n && y >= 0 && y < m) ) return ;
+  if ( wrk[INDEX_2(x,y,m)]==0 ) return ;
+  if ( wk[INDEX_2(x,y,m)]!=-1 && wk[INDEX_2(x,y,m)]!= p) return ;
+
+  /*
+  if ( p == 5 && reach == 1 )
+  printf("acrete(wk,wrk, p %d, *i %d, n_p %d, reach %d, x %d, y %d, m %d, n %d)\n",p, *i, n_p, reach, x, y, m, n ) ;
+  */
+
+  T( x   , y   ) ;
+  T( x-1 , y+1 ) ;
+  T( x   , y+1 ) ;
+  T( x+1 , y+1 ) ;
+  T( x-1 , y   ) ;
+  T( x+1 , y   ) ;
+  T( x-1 , y-1 ) ;
+  T( x   , y-1 ) ;
+  T( x+1 , y-1 ) ;
+
+  acrete( wk, wrk, p, i, n_p, reach-1, x-1 , y-1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x-1 , y   , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x-1 , y+1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x   , y+1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x+1 , y+1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x+1 , y   , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x+1 , y-1 , m, n ) ;
+  acrete( wk, wrk, p, i, n_p, reach-1, x   , y-1 , m, n ) ;
+
+}
+
+
+flood( x, y, v, v2, wrk, m, n )
+  int x, y, v, v2, wrk[], m, n ;
+{
+  if ( x < 0 || x >= n || y < 0 || y >= m )
+    return ;
+  if ( wrk[INDEX_2(x,y,m)] == v )
+  {
+    wrk[INDEX_2(x,y,m)] = v2 ;
+    flood( x+1, y  , v, v2, wrk, m, n ) ;
+    flood( x-1, y  , v, v2, wrk, m, n ) ;
+    flood( x  , y+1, v, v2, wrk, m, n ) ;
+    flood( x  , y-1, v, v2, wrk, m, n ) ;
+  }
+}
+
+print_region( wrk, m, n )
+  int wrk[], m, n ;
+{
+  int i, j ;
+  for ( i = m-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < n ; j++ )
+    {
+      if ( wrk[ INDEX_2( j, i, m ) ] == -1 )
+        printf("  ." ) ;
+      else 
+	printf("%3d", wrk[ INDEX_2( j, i, m ) ] ) ;
+    }
+    printf("\n") ;
+  }
+}
+
+/****************/
+
+main()
+{
+  /*      n   m */
+  int wrk[100 * 100] ;
+  int i, j, m, n, x1, y1, x2, y2, py, px, opt ;
+
+  for ( i = 0 ; i < 100*100 ; i++ ) wrk[i] = 0 ;
+
+  scanf("%d %d", &m, &n) ;
+  scanf("%d %d %d", &py, &px, &opt) ;
+  scanf("%d %d", &x1, &y1) ;
+  while ( scanf("%d %d", &x2, &y2) != EOF )
+  {
+    mark_line( wrk, m, n, x1, y1, x2, y2, 1 ) ;
+    x1 = x2 ;
+    y1 = y2 ;
+  }
+
+  print_region( wrk, m, n ) ;
+
+  fill_region( wrk, m, n, 0, 2 ) ;
+  for ( j = 0 ; j < n ; j++ )
+    for ( i = 0 ; i < m ; i++ )
+    {
+      if ( wrk[ INDEX_2( j, i, m ) ] == 2 )
+        wrk[ INDEX_2( j, i, m ) ] = 0 ;
+      else
+        wrk[ INDEX_2( j, i, m ) ] = 1 ;
+    }
+
+  print_region( wrk, m, n ) ;
+
+  switch ( opt )
+  {
+    case 1 : decomp_region_1( wrk, m, n, py, px ) ;
+	     print_region( wrk, m, n ) ;
+	     break ;
+    case 2 : decomp_region_2( wrk, m, n, py, px ) ;
+	     break ; 
+    default : break ;
+  }
+
+  printf("\n") ;
+
+
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd4.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd4.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/cd4.c	(revision 2744)
@@ -0,0 +1,391 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "rsl.h"
+
+
+/*#define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) ) */
+
+mark_line( wrk, m, n, x1, y1, x2, y2, val )
+  int wrk[] ;
+  int m, n, x1, y1, x2, y2, val ;
+{
+  int x, y, i, j, k ;
+  int yz, yz2, dex ;
+
+  double SLOPE, X, Y, DX, DY, dY, X1, X2, Y1, Y2 ;
+
+  X1 = x1 ;
+  X2 = x2 ;
+  DX = X2 - X1 ;
+  Y1 = y1 ;
+  Y2 = y2 ;
+  DY = Y2 - Y1 ;
+  if ( DX == 0.0 )
+  {
+    if ( y2 >= y1 )
+      for ( i = y1 ; i <= y2 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = val ;
+    else
+      for ( i = y2 ; i <= y1 ; i++ )
+        wrk[ INDEX_2( x1, i, m )] = val ;
+    return ;
+  }
+  else
+  {
+    SLOPE = DY/DX ;
+    dY = SLOPE * .5 ;
+  }
+
+  if ( x2 >= X1 )
+  {
+    Y = y1 + .5 ;
+    for ( X = x1+.5 ; X < x2+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = val ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = val ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x2, y2, m )] = val ;
+  }
+  else
+  {
+    Y = y2 + .5 ;
+    for ( X = x2+.5 ; X < x1+.5 ; X = X+.5 )
+    {
+      j = X + .25 ;
+      if ( dY >= 0.0 )
+        for ( i = Y ; i <= (k=Y+dY) ; i++ )     /* k business converts to int */
+          wrk[ INDEX_2( j, i, m )] = val ;
+      else
+        for ( i = Y ; i >= (k=Y+dY) ; i-- )
+          wrk[ INDEX_2( j, i, m )] = val ;
+      Y = Y + dY ;
+    }
+    wrk[ INDEX_2( x1, y1, m )] = val ;
+  }
+}
+
+fill_region( wrk, m, n, v, v2 )
+  int wrk[], m, n, v, v2 ;
+{
+  int x, y ;
+  
+  for ( y = 0 ; y < m ; y++ )
+  {
+    flood( 0, y, v, v2, wrk, m, n ) ;
+    flood( n-1, y, v, v2, wrk, m, n ) ;
+  }
+  for ( x = 0 ; x < n ; x++ )
+  {
+    flood( x, 0, v, v2, wrk, m, n ) ;
+    flood( x, m-1, v, v2, wrk, m, n ) ;
+  }
+}
+
+/* decompose over a 1-d vector of processors in y */
+decomp_region_1y( wrk, m, n, py )
+  int wrk[], m, n, py ;
+{
+  int *wk ;
+  int nprocs, i, x, y, ncells, pid, n_py ;
+
+  wk = RSL_MALLOC( int, m*n ) ;
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != 0 ) ncells++ ;
+  }
+  /* divide over py in m dimension first */
+  pid = -1 ;
+  i = 0 ;
+  n_py = ncells / py ;
+  for ( y = 0 ; y < m ; y++ )
+  {
+    for ( x = 0 ; x < n ; x++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )   /* only do cells in partition */
+      {
+        if ( i % n_py == 0 ) pid++ ;
+        i++ ;
+        if ( pid > py-1 ) pid = py-1 ;
+        wk[INDEX_2(x,y,m)] = pid ;
+      }
+    }
+  }
+
+  for ( y = 0 ; y < m ; y++ )
+  {
+    for ( x = 0 ; x < n ; x++ )
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  RSL_FREE(wk) ;
+}
+
+/* decompose over a 1-d vector of processors in x */
+decomp_region_1x( wrk, m, n, px )
+  int wrk[], m, n, px ;
+{
+  int *wk ;
+  int nprocs, i, x, y, ncells, pid, n_px ;
+
+  wk = RSL_MALLOC( int, m*n ) ;
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != 0 ) ncells++ ;
+  }
+  /* divide over px in m dimension first */
+  pid = -1 ;
+  i = 0 ;
+  n_px = ncells / px ;
+  for ( x = 0 ; x < n ; x++ )
+  {
+    for ( y = 0 ; y < m ; y++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )   /* only do cells in partition */
+      {
+        if ( i % n_px == 0 ) pid++ ;
+        i++ ;
+        if ( pid > px-1 ) pid = px-1 ;
+        wk[INDEX_2(x,y,m)] = pid ;
+      }
+    }
+  }
+
+  for ( y = 0 ; y < m ; y++ )
+  {
+    for ( x = 0 ; x < n ; x++ )
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  RSL_FREE(wk) ;
+}
+
+decomp_region_2( wrk, m, n, py, px )
+  int wrk[], m, n, py, px ;
+{
+  int *wk ;
+  int x, y, ncells, nprocs, n_p, n_py, n_px, i, pid, p ;
+
+  wk = RSL_MALLOC( int, m*n ) ;
+
+  nprocs = px * py ;
+
+  for ( x = 0 ; x < m*n ; x++ ) 
+  {
+    wk[x] = -1 ;
+    if ( wrk[x] != 0 ) ncells++ ;
+  }
+
+  n_p = ncells / nprocs ;
+
+  /* divide over py in m dimension first */
+  pid = -1 ;
+  i = 0 ;
+  n_py = ncells / py ;
+  for ( y = 0 ; y < m ; y++ )
+  {
+    for ( x = 0 ; x < n ; x++ )
+    {
+      if ( wrk[INDEX_2(x,y,m)] != 0 )   /* only do cells in partition */
+      {
+        if ( i % n_py == 0 ) pid++ ;
+        i++ ;
+        if ( pid > px-1 ) pid = px-1 ;
+        wk[INDEX_2(x,y,m)] = pid ;
+      }
+    }
+  }
+
+  /* now divide over px in n dimension */
+  n_px = n_py / px ;
+  for ( p = 0 ; p < py ; p++ )
+  {
+    pid = -1 ;
+    i = 0 ;
+    for ( x = 0 ; x < n ; x++ )
+    {
+      for ( y = 0 ; y < m ; y++ )
+      {
+        if ( wk[INDEX_2(x,y,m)] == p )
+        {
+          if ( i % n_px == 0 ) pid++ ;
+          i++ ;
+          if ( pid > py-1 ) pid = py-1 ;
+          wk[INDEX_2(x,y,m)] = pid*10000 + p ;
+        }
+      }
+    }
+  }
+  
+  for ( x = 0 ; x < n ; x++ )
+    for ( y = 0 ; y < m ; y++ )
+  {
+    if (( p = wk[ INDEX_2( x, y, m ) ] ) != -1 )
+    {
+      n_py = p % 10000 ;
+      n_px = p / 10000 ;
+      wrk[INDEX_2( x, y, m )] = n_py*px + n_px ;
+    }
+    else
+    {
+      wrk[INDEX_2( x, y, m )] = wk[INDEX_2( x, y, m )] ;
+    }
+  }
+
+  RSL_FREE(wk) ;
+}
+
+flood( x, y, v, v2, wrk, m, n )
+  int x, y, v, v2, wrk[], m, n ;
+{
+  if ( x < 0 || x >= n || y < 0 || y >= m )
+    return ;
+  if ( wrk[INDEX_2(x,y,m)] == v )
+  {
+    wrk[INDEX_2(x,y,m)] = v2 ;
+    flood( x+1, y  , v, v2, wrk, m, n ) ;
+    flood( x-1, y  , v, v2, wrk, m, n ) ;
+    flood( x  , y+1, v, v2, wrk, m, n ) ;
+    flood( x  , y-1, v, v2, wrk, m, n ) ;
+  }
+}
+
+print_region( wrk, m, n )
+  int wrk[], m, n ;
+{
+  int i, j ;
+  for ( i = m-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < n ; j++ )
+    {
+      if ( wrk[ INDEX_2( j, i, m ) ] == -1 )
+        printf("  ." ) ;
+      else 
+	printf("%3d", wrk[ INDEX_2( j, i, m ) ] ) ;
+    }
+    printf("\n") ;
+  }
+}
+
+/****************/
+
+main()
+{
+  /*      n   m */
+  int wrk[100 * 100] ;
+  int i, j, m, n, x1, y1, x2, y2, py, px, opt ;
+
+  for ( i = 0 ; i < 100*100 ; i++ ) wrk[i] = 0 ;
+
+  scanf("%d %d", &m, &n) ;
+  scanf("%d %d %d", &py, &px, &opt) ;
+  scanf("%d %d", &x1, &y1) ;
+  while ( scanf("%d %d", &x2, &y2) != EOF )
+  {
+    mark_line( wrk, m, n, x1, y1, x2, y2, 1 ) ;
+    x1 = x2 ;
+    y1 = y2 ;
+  }
+
+  print_region( wrk, m, n ) ;
+
+  fill_region( wrk, m, n, 0, 2 ) ;
+  for ( j = 0 ; j < n ; j++ )
+    for ( i = 0 ; i < m ; i++ )
+    {
+      if ( wrk[ INDEX_2( j, i, m ) ] == 2 )
+        wrk[ INDEX_2( j, i, m ) ] = 0 ;
+      else
+        wrk[ INDEX_2( j, i, m ) ] = 1 ;
+    }
+
+  print_region( wrk, m, n ) ;
+
+  switch ( opt )
+  {
+    case 0 : decomp_region_1x( wrk, m, n, py*px ) ;
+	     print_region( wrk, m, n ) ;
+	     break ;
+    case 1 : decomp_region_1y( wrk, m, n, py*px ) ;
+	     print_region( wrk, m, n ) ;
+	     break ;
+    case 2 : decomp_region_2( wrk, m, n, py, px ) ;
+	     print_region( wrk, m, n ) ;
+	     break ; 
+    default : break ;
+  }
+
+  printf("\n") ;
+
+
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_cells.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_cells.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_cells.c	(revision 2744)
@@ -0,0 +1,227 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+static rsl_list_t *lp[RSL_MAXDOMAINS] ;
+
+
+/*@
+  RSL_COMPUTE_CELLS - apply a subroutine to all points of a domain
+
+  Synopsis:
+  RSL_COMPUTE_CELLS ( d, f )
+    INTEGER     d        ! (I) RSL domain descriptor
+    EXTERNAL    f        ! (I) Subroutine
+
+  Notes:
+  This routine is supported but considered obsolete.
+  RSL now provides more integrated means for iterating over decomposed
+  domain dimensions --- see LoopMacros.
+
+  RSL_COMPUTE_CELLS calls
+  a subroutine for each grid point of the domain.
+  By default, the
+  cells on each processor are traversed in an M-minor, N-major ordering.
+  This ordering can be changed
+  using RSL_ORDER.  Use RSL_COMPUTE_MASK to iterate over a subset of a domain.
+  The subroutine F takes five 
+  integer arguments (see example) that provide local and global indices of
+  a point and nest level.  Other model data must be provided to the subroutine
+  through common or through a USE statement (Fortran90).
+
+  Example:
+
+$  subroutine F( inest, i, j, ig, jg )
+$  integer inest    ! nest level (1 is top)
+$  integer i, j     ! index of point in local memory
+$  integer ig, jg   ! index of point in global domain
+$    -- computation for point --
+$  return
+$  end
+
+$  external f
+$    --
+$  call rsl_compute_cells ( d, f )
+$    --
+$  stop
+$  end
+
+BREAKTHEEXAMPLECODE
+
+  The subroutine F is 
+  called for a point of the domain d if M evaluates true.
+
+  See also:
+  LoopMacros, RSL_ORDER, RSL_COMPUTE_MASK
+
+@*/
+
+/*@
+  RSL_COMPUTE_MASK - apply a subroutine to selected points in a domain
+
+  Synopsis:
+  RSL_COMPUTE_MASK ( d, f, m )
+    INTEGER    d      ! (I) RSL domain descriptor
+    EXTERNAL   f      ! (I) Subroutine
+    EXTERNAL   m      ! (I) Mask function
+    LOGICAL    m
+
+  Notes:
+  This routine is supported but considered obsolete.
+  RSL now provides more integrated means for iterating over decomposed
+  domain dimensions --- see LoopMacros.
+
+  RSL_COMPUTE_MASK calls
+  a subroutine for grid points of the domain based on evaluation of a
+  mask function.  See also RSL_COMPUTE_CELLS.
+
+  Example:
+$  subroutine F( inest, i, j, ig, jg )
+$  integer inest    ! nest level (1 is top)
+$  integer i, j     ! index of point in local memory
+$  integer ig, jg   ! index of point in global domain
+$    -- computation for point --
+$  return
+$  end
+$
+$  logical function M ( inest, i, j, ig, jg )
+$  M = < .true. if included in computation >
+$  return
+$  end
+$
+$  external f, m
+$  logical  m
+$    --
+$  call rsl_compute_mask ( d, f, m )
+$    --
+BREAKTHEEXAMPLECODE
+
+  The subroutine F is 
+  called for a point of the domain d if M evaluates true.
+
+  See also:
+  LoopMacros, RSL_ORDER, RSL_COMPUTE_MASK
+
+@*/
+
+int RSL_INIT_NEXTCELL ( d_p )
+  int_p d_p ;
+{
+  rsl_index_t d ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_init_nextcell: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p, 
+			   &(domain_info[*d_p].loc_m),
+			   &(domain_info[*d_p].loc_n) ) ;
+  }
+  lp[d] = domain_info[d].pts ;
+  return(0) ;
+}
+
+int RSL_INIT_GHOST ( d_p )
+  int_p d_p ;
+{
+  rsl_index_t d ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_init_nextcell: invalid domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  lp[d] = domain_info[d].ghost_pts ;
+  return(0) ;
+}
+
+int RSL_C_NEXTCELL ( d_p, min_p, maj_p, min_g_p, maj_g_p, retval_p )
+  int_p d_p, min_p, maj_p, min_g_p, maj_g_p, retval_p ;
+{
+  rsl_index_t d ;
+  rsl_point_t *pt ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_init_nextcell: invalid domain") ;
+
+  if ( lp[d] == NULL )
+  {
+    *retval_p = 0 ;		/* no more */
+  }
+  else
+  {
+    pt = (rsl_point_t *) lp[d]->data ;
+    *min_g_p = ID_IDEX( pt->id ) + 1;
+    *maj_g_p = ID_JDEX( pt->id ) + 1;
+    *min_p = *min_g_p - domain_info[d].ilocaloffset ;
+    *maj_p = *maj_g_p - domain_info[d].jlocaloffset ;
+#if 0
+fprintf(stderr,"%d comp_cells point -> %d %d %d %d; jlocaloffset %d\n",
+       rsl_myproc, *min_p, *maj_p, *min_g_p, *maj_g_p,
+       domain_info[d].jlocaloffset) ;
+#endif
+    lp[d] = lp[d]->next ;
+    *retval_p = 1 ;
+  }
+  return(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_cells_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_cells_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_cells_f.F	(revision 2744)
@@ -0,0 +1,181 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine rsl_compute_cells( domain, f )
+      implicit none
+      integer domain    ! domain descriptor
+      integer f         ! function (typed to keep implicit none quiet)
+
+      integer nl, min, maj, min_g, maj_g
+      integer retval
+      integer dummy
+
+      call rsl_nl( domain, nl )	       ! get nest level for this domain
+      call rsl_init_nextcell(domain)   ! initializes rsl_next_cell
+      call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      do while ( retval .eq. 1 )
+         dummy = f( nl+1, min, maj, min_g, maj_g )
+         call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      enddo
+      return
+      end
+
+      subroutine rsl_compute_mask( domain, f, mask )
+      implicit none
+      integer domain    ! domain descriptor
+      integer f         ! function (typed to keep implicit none quiet)
+      logical mask	! function (mask out cells 
+
+      integer nl, min, maj, min_g, maj_g
+      integer retval
+      integer dummy
+
+      call rsl_nl( domain, nl )        ! get nest level for this domain
+      call rsl_init_nextcell(domain)   ! initializes rsl_next_cell
+      call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      do while ( retval .eq. 1 )
+	 if ( mask( domain, min, maj, min_g, maj_g ) ) then
+           dummy = f( nl+1, min, maj, min_g, maj_g )
+	 endif
+         call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      enddo
+      return
+      end
+
+
+      logical function rsl_nextcell( d, min, maj, min_g, maj_g )
+      integer d, min, maj, min_g, maj_g
+      integer retval
+      call rsl_c_nextcell( d, min, maj, min_g, maj_g, retval )
+      if ( retval .eq. 1 ) then
+         rsl_nextcell = .true.
+      else
+         rsl_nextcell = .false.
+      endif
+      return
+      end
+
+c routine for computing on ghost points
+      subroutine rsl_compute_ghost( domain, f )
+      implicit none
+      integer domain    ! domain descriptor
+      integer f         ! function (typed to keep implicit none quiet)
+
+      integer nl, min, maj, min_g, maj_g
+      integer retval
+      integer dummy
+
+      call rsl_nl( domain, nl )        ! get nest level for this domain
+      call rsl_init_ghost(domain)      ! initializes rsl_next_cell
+      call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      do while ( retval .eq. 1 )
+         dummy = f( nl+1, min, maj, min_g, maj_g )
+         call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      enddo
+
+      return
+      end
+
+
+      subroutine rsl_compute_cells6( domain, f, d, ilen, jlen, klen )
+      implicit none
+      integer domain    ! domain descriptor
+      integer f         ! function (typed to keep implicit none quiet)
+      character d(*)  ! pointer to structure
+      integer ilen, jlen, klen
+
+      integer nl, min, maj, min_g, maj_g
+      integer retval
+      integer dummy
+
+      call rsl_nl( domain, nl )        ! get nest level for this domain
+      call rsl_init_nextcell(domain)   ! initializes rsl_next_cell
+      call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      do while ( retval .eq. 1 )
+         dummy = f( nl+1, min, maj, min_g, maj_g, d, ilen, jlen, klen )
+         call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      enddo
+      return
+      end
+
+      subroutine rsl_compute_mask6( domain, f, mask,
+     $                              d, ilen, jlen, klen )
+      implicit none
+      integer domain    ! domain descriptor
+      integer f         ! function (typed to keep implicit none quiet)
+      logical mask      ! function (mask out cells
+      character d(*)  ! pointer to structure
+      integer ilen, jlen, klen
+
+      integer nl, min, maj, min_g, maj_g
+      integer retval
+      integer dummy
+
+      call rsl_nl( domain, nl )        ! get nest level for this domain
+      call rsl_init_nextcell(domain)   ! initializes rsl_next_cell
+      call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      do while ( retval .eq. 1 )
+         if ( mask( domain, min, maj, min_g, maj_g ) ) then
+           dummy =
+     $        f( nl+1, min, maj, min_g, maj_g, d, ilen, jlen, klen )
+         endif
+         call rsl_c_nextcell( domain, min, maj, min_g, maj_g, retval )
+      enddo
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_period.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_period.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_period.c	(revision 2744)
@@ -0,0 +1,516 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* The mechanism here is similar to and patterned after that used by the
+   stencil mechanism: see comp_sten.c */
+
+
+/* used by compile_period, below */
+static period_desc_t *sd ;            /* set in compile_period */
+static rsl_procrec_t *procrec ;       /* set in compile_period */
+static int send_accum ;
+static int recv_accum ;
+
+static check_local_pts_period( d, m, n, hm, hn, min_gh, maj_gh, fldspec )
+  rsl_index_t d ;               /* domain index */
+  rsl_index_t m, n ;            /* this point */
+  rsl_index_t hm, hn ;          /* home point (whose period I'm on)  */
+  rsl_index_t min_gh ;        /* direction and amount to make sure minor ghost region is updated */
+  rsl_index_t maj_gh ;        /* direction and amount to make sure major ghost region is updated */
+  rsl_fldspec_t *fldspec ;
+{
+  int mlen ;                    /* length of minor domain dimension */
+  rsl_fldspec_t *fp, *fpm, *prev, *new ;
+  int message, found ;
+  rsl_processor_t  P , Pthis , Pmin_gh , Pmaj_gh ;
+  rsl_point_id_t id ;
+  rsl_ptrec_t *ptrec, *recv_ptrec ;
+  int recv_npts ;       /* dummy */
+  rsl_list_t *lp ;
+  rsl_domain_info_t *dinfo ;
+  rsl_point_t *domain ;
+  message_desc_t * msg ;
+  int mfldlen, nfldlen ;
+  rsl_fldspec_t *fld ;
+
+  dinfo = &(domain_info[d]) ;
+  domain = dinfo->domain ;
+  mlen = dinfo->len_m ;
+
+  switch ( fldspec->strategy )
+  {
+    case MINNS_MAJEW_2D :
+      mfldlen = fldspec->glen[0] ; nfldlen = fldspec->glen[1] ; break ;
+    case MINEW_MAJNS_2D :
+      mfldlen = fldspec->glen[1] ; nfldlen = fldspec->glen[0] ; break ;
+    case MINNS_MAJEW_K_3D :
+      mfldlen = fldspec->glen[0] ; nfldlen = fldspec->glen[1] ; break ;
+    case MINEW_MAJNS_K_3D :
+      mfldlen = fldspec->glen[1] ; nfldlen = fldspec->glen[0] ; break ;
+    case K_MIDNS_MAJEW_3D :
+      mfldlen = fldspec->glen[1] ; nfldlen = fldspec->glen[2] ; break ;
+    case MINNS_K_MAJEW_3D :
+      mfldlen = fldspec->glen[0] ; nfldlen = fldspec->glen[2] ; break ;
+    default :
+      RSL_TEST_ERR(1,"unsupported strategy") ;
+  }
+
+/* P is the processor on which sits the off-domain point being filled in */
+  P       = domain[INDEX_2( (hn<0)?0:((hn>nfldlen-1)?nfldlen-1:hn) , (hm<0)?0:((hm>mfldlen-1)?mfldlen-1:hm),mlen )  ].P ;
+  Pmin_gh = domain[INDEX_2( (hn<0)?0:((hn>nfldlen-1)?nfldlen-1:hn) , (hm+min_gh<0)?0:((hm+min_gh>mfldlen-1)?mfldlen-1:hm+min_gh),mlen )  ].P ;
+  Pmaj_gh = domain[INDEX_2( (hn+maj_gh<0)?0:((hn+maj_gh>nfldlen-1)?nfldlen-1:hn+maj_gh) , (hm<0)?0:((hm>mfldlen-1)?mfldlen-1:hm       ),mlen )  ].P ;
+
+/* Pthis is the processor on which sits the on-domain point being replicated */
+  Pthis = RSL_INVALID ;
+  if ( n >= 0 && n < dinfo->len_n && m >= 0 && m < dinfo->len_m )
+     Pthis = domain[INDEX_2(n,m,mlen)].P ;
+
+/* SENDS -- if the point to be replicated sits on my processsor, and the off-domain point being filled
+   in sits on the "other" processor, record a send that includes the coordinates of the point being
+   replicated for the packing mechanism.  */
+
+#if 1
+  if (   rsl_c_comp2phys_proc ( Pthis ) == rsl_myproc  && 
+       ( P == procrec->P || Pmin_gh == procrec->P || Pmaj_gh == procrec->P ) &&
+         rsl_c_comp2phys_proc ( procrec->P ) != rsl_myproc )   /* if the other processor is me don't bother */
+#else
+  if ( rsl_c_comp2phys_proc ( Pthis ) == rsl_myproc  &&  P == procrec->P )
+#endif
+  {
+#if 0
+fprintf(stderr,"send: %d %d P = %d , Pthis = %d , procrec->P %d , m %d , n %d , hm %d , hn %d , min_gh %d , maj_gh %d \n", mfldlen, nfldlen,  P, Pthis, procrec->P, m,n,hm,hn,min_gh,maj_gh ) ;
+#endif
+    found = 0 ;
+/* always create a new record; searching and trying to reuse records will throw
+   off the order of packing when multiple fields with different dimensions are
+   involved. */
+    if ( !found )       /* add it */
+    {
+      lp    = RSL_MALLOC( rsl_list_t, 1 ) ;
+      ptrec = RSL_MALLOC( rsl_ptrec_t, 1 ) ;
+      ptrec->ig = m ;
+      ptrec->jg = n ;
+      ptrec->nsendmsgs = 0 ;
+      ptrec->nrecvmsgs = 0 ;
+      ptrec->send_messages = NULL ;
+      ptrec->recv_messages = NULL ;
+      lp->data = ptrec ;
+      lp->next = procrec->point_list ;
+      procrec->point_list = lp ;
+      procrec->npts++ ;
+      send_accum += sizeof( rsl_point_hdr_t ) ;
+    }
+/* 1.1.1.1.2 */
+    /* at this point ptrec points to a ptrec (for the local point) in the 
+       list for the non-local processor. */
+    if ( ptrec->send_messages == NULL )
+    {
+      msg = RSL_MALLOC( message_desc_t , 1 ) ;
+      lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+      lp->data = msg ;
+      lp->next = ptrec->send_messages ;
+      ptrec->send_messages = lp ;
+    }
+    lp = ptrec->send_messages ;
+    msg = lp->data ;
+    fld = RSL_MALLOC( rsl_fldspec_t , 1 ) ;
+    *fld = *fldspec ;
+    fld->next = msg->fldspecs ;
+    msg->fldspecs = fld ;
+    send_accum += fldsize( fld ) ;
+    send_accum += sizeof(int) ;         /* for send of period point index */
+    ptrec->nsendmsgs = 1 ;
+  }
+
+/* RECEIVES: if the off-domain point to be filled in is on my processor, and the processor
+   this with the on-domain point is the "other" processor, generate a receive, recording the
+   coordinates of the off-domain point for the upacking mechanism.  */
+
+#if 1
+  if ( ( rsl_c_comp2phys_proc ( P ) == rsl_myproc || rsl_c_comp2phys_proc ( Pmaj_gh ) == rsl_myproc || rsl_c_comp2phys_proc ( Pmin_gh ) == rsl_myproc ) && 
+         Pthis == procrec->P && 
+         rsl_c_comp2phys_proc ( Pthis ) != rsl_myproc )   /* if the other processor is me don't bother */
+#else
+  if ( rsl_c_comp2phys_proc ( P ) == rsl_myproc && Pthis == procrec->P )
+#endif
+  {
+
+#if 0
+fprintf(stderr,"recv: %d %d P = %d , Pthis = %d , procrec->P %d , m %d , n %d , hm %d , hn %d , min_gh %d , maj_gh %d\n", mfldlen, nfldlen, P, Pthis, procrec->P, m,n,hm,hn,min_gh,maj_gh ) ;
+#endif
+
+/* 2.1.1.1.1 */
+    /* add the ghost point to the list of points from which we
+       will receive messages */
+    found = 0 ;
+    if ( !found )       /* add it */
+    {
+      lp    = RSL_MALLOC( rsl_list_t, 1 ) ;
+      recv_ptrec = RSL_MALLOC( rsl_ptrec_t, 1 ) ;
+      recv_ptrec->ig = hm ;
+      recv_ptrec->jg = hn ;
+      recv_ptrec->nsendmsgs = 0 ;
+      recv_ptrec->nrecvmsgs = 0 ;
+      recv_ptrec->send_messages = NULL ;
+      recv_ptrec->recv_messages = NULL ;
+      lp->data = recv_ptrec ;
+      lp->next = procrec->recv_point_list ;
+      procrec->recv_point_list = lp ;
+      procrec->recv_npts++ ;
+      recv_accum += sizeof( rsl_point_hdr_t ) ;
+    }
+
+    if ( recv_ptrec->recv_messages == NULL )
+    {
+      msg = RSL_MALLOC( message_desc_t , 1 ) ;
+      lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+      lp->data = msg ;
+      lp->next = recv_ptrec->recv_messages ;
+      recv_ptrec->recv_messages = lp ;
+    }
+    lp = recv_ptrec->recv_messages ;
+    msg = lp->data ;
+    fld = RSL_MALLOC( rsl_fldspec_t , 1 ) ;
+    *fld = *fldspec ;
+    fld->next = msg->fldspecs ;
+    msg->fldspecs = fld ;
+    recv_accum += fldsize( fld ) ;
+    recv_accum += sizeof(int) ;
+    recv_ptrec->nrecvmsgs = 1 ;
+
+  }
+}
+
+/* this is used internally only -- this will be called automatically
+   whenever a period exchange is attempted on a period that has not
+   yet been compiled */
+rsl_compile_period( d_p, s_p )
+  int_p d_p, s_p ;
+{
+  int d, s ;
+  int i, j, k ;
+  int len_plist ;
+  int (*ptfcn)() ;
+  rsl_list_t *lp, *lp2, *destr, *destr2, *ghost_points ;
+  rsl_domain_info_t *dp ;
+  rsl_point_t  *pt ;
+  rsl_dimlen_t mlen, nlen ;
+  rsl_fldspec_t * fld ;
+  message_desc_t *msg ;
+  int m, n, dir ;
+  rsl_processor_t P, Plist[RSL_MAXPROC] ;
+  int check_local_pts_period() ;
+
+  d = *d_p ;
+  s = *s_p ;
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "rsl_compile_period: bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID, 
+        "rsl_compile_period: descriptor for invalid domain" ) ;
+
+  mlen = domain_info[d].len_m ;
+  nlen = domain_info[d].len_n ;
+
+  /* sd is static so that check_local_pts can get at it */
+  RSL_TEST_ERR( s <= 0 || s > RSL_MAXDESCRIPTORS,
+        "rsl_compile_period: bad period descriptor" ) ;
+  RSL_TEST_ERR((sd = (period_desc_t *)pr_descriptors[s]) == NULL,
+        "compile_descriptor: null period descriptor" ) ;
+  RSL_TEST_ERR( sd->tag != PERIOD_DESC,
+        "compile_descriptor: bad period descriptor" ) ;
+  RSL_TEST_ERR( sd->compiled[d] != 0,
+        "compile_period: period has already been compiled for this domain") ;
+
+  sd->compiled[d] = 1 ;
+  dp = &(domain_info[d]) ;
+
+  if ( dp->decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+
+for ( dir = 0 ; dir < 2 ; dir++ )
+{
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    procrec = RSL_MALLOC( rsl_procrec_t, 1 ) ;
+    procrec->P = P ;
+    procrec->npts = 0 ;
+    procrec->recv_npts = 0 ;
+
+/* 1.1 */
+    /* for every ghost point from P, mark any local point that lies
+       on its period (using the point function associated with the
+       period.   */
+    
+    send_accum = 0 ;
+    recv_accum = 0 ;
+
+        for ( fld = sd->msgs[d]->fldspecs ; fld != NULL ; fld = fld->next )
+    for ( n = 0 ; n < nlen ; n++ )
+      for ( m = 0 ; m < mlen ; m++ )
+/* 1.1.1 */
+         {
+           switch ( fld->strategy )
+           {
+           case MINNS_MAJEW_2D :
+             rsl_period_pt( dir, d, m, fld->glen[0], fld->stag[0], n, fld->glen[1], fld->stag[1], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
+           case MINEW_MAJNS_2D :
+             rsl_period_pt( dir, d, m, fld->glen[1], fld->stag[1], n, fld->glen[0], fld->stag[0], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
+           case MINNS_MAJEW_K_3D :
+             rsl_period_pt( dir, d, m, fld->glen[0], fld->stag[0], n, fld->glen[1], fld->stag[1], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
+           case MINEW_MAJNS_K_3D :
+             rsl_period_pt( dir, d, m, fld->glen[1], fld->stag[1], n, fld->glen[0], fld->stag[0], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
+           case K_MIDNS_MAJEW_3D :
+             rsl_period_pt( dir, d, m, fld->glen[1], fld->stag[1], n, fld->glen[2], fld->stag[2], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
+           case MINNS_K_MAJEW_3D :
+             rsl_period_pt( dir, d, m, fld->glen[0], fld->stag[0], n, fld->glen[2], fld->stag[2], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
+           default :
+              RSL_TEST_ERR(1,"unsupported strategy") ;
+           }
+         }
+
+    procrec->nsends = 0 ;
+    procrec->nrecvs = 0 ;
+    procrec->sendsize = send_accum + sizeof(int) ; /* extra word for count */
+    procrec->recvsize = recv_accum + sizeof(int) ; /* extra word for count */
+
+    if ( send_accum != 0 || recv_accum != 0 )
+    {
+      procrec->next = sd->procs[dir][d] ;
+      sd->procs[dir][d] = procrec ;
+    }
+    else
+    {
+      RSL_FREE(procrec) ;
+    }
+  }
+  {
+    int ig, jg, i, j ;
+    rsl_list_t *lp1 ;
+    void * base ;
+    int elemsz, t0, t1, pack_table_size ;
+    period_desc_t * per ;
+    rsl_ptrec_t * ptrec ;
+    message_desc_t * msg ;
+    rsl_fldspec_t * fld ;
+    
+    per = (period_desc_t *) pr_descriptors[ s ] ;
+    for ( procrec = per->procs[dir][d] ; procrec != NULL ; procrec = procrec->next )
+    {
+      init_period_refs() ;
+      for ( lp = procrec->point_list ; lp != NULL ; lp = lp->next )
+      {
+        ptrec = (rsl_ptrec_t *) lp->data ;
+        ig = ptrec->ig ;
+        jg = ptrec->jg ;
+        i = ig - domain_info[d].ilocaloffset ;
+        j = jg - domain_info[d].jlocaloffset ;
+
+        for ( lp1 = ptrec->send_messages ; lp1 != NULL ; lp1 = lp1->next )
+        {
+          msg = (message_desc_t *) lp1->data ;
+          for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
+          {
+            if ( fld->type >= 100 ) sd->has_f90_fields = 1 ;
+            base = fld->base ;
+#if 0
+fprintf(stderr,"pack  P=%d  i j ig jg    %3d %3d %3d %3d, base %08x\n",procrec->P,i,j,ig,jg,base) ;
+#endif
+            elemsz = fld->elemsz ;
+            switch (fld->strategy)
+            {
+            case MINNS_MAJEW_2D :               /* <MM> eg: psa(i,j) */
+              t0 = fld->llen[0] ;
+              store_period_refs( base, fld->f90_table_index , (i+j*t0)*elemsz, elemsz, 1, elemsz) ;
+              break ;
+            case MINEW_MAJNS_2D :               /* xxx(j,i) */
+              t0 = fld->llen[0] ;
+              store_period_refs( base, fld->f90_table_index , (j+i*t0)*elemsz, elemsz, 1, elemsz) ;
+              break ;
+
+
+
+            case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_period_refs( base, fld->f90_table_index , 
+                                         (i+j*t0)*elemsz,     /* offset */
+                                         elemsz,              /* n      */
+                                         fld->llen[2],        /* nelems */
+                                         t1*elemsz) ;         /* stride */
+              break ;
+
+            case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_period_refs( base, fld->f90_table_index ,
+                                         (j+i*t0)*elemsz,     /* offset */
+                                         elemsz,              /* n      */
+                                         fld->llen[2],        /* nelems */
+                                         t1*elemsz) ;         /* stride */
+              break ;
+
+            case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                                                             /* offset               n      nelems   stride */
+                                                             /*   |                  |         |      |     */
+                                                             /*   v                  v         v      v     */
+              store_period_refs( base, fld->f90_table_index , (i*t0+j*t1)*elemsz, elemsz * t0, 1, elemsz) ;
+              break ;
+
+            case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_period_refs( base, fld->f90_table_index , (i+j*t1)*elemsz, elemsz, fld->llen[1], t0*elemsz) ;
+              break ;
+            default:
+              RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+              break ;
+            }
+          }
+        }
+      }
+      period_refs( &(procrec->pack_table),
+                    &(procrec->pack_table_size),
+                    &(procrec->pack_table_nbytes) , 0 ) ;
+    }
+  }
+#if 0
+fprintf(stderr,"-=-=-=-=-=-=-\n") ;
+#endif
+  {
+    int ig, jg, i, j ;
+    rsl_list_t *lp1 ;
+    void * base ;
+    int elemsz, t0, t1, pack_table_size ;
+    period_desc_t * per ;
+    rsl_ptrec_t * ptrec ;
+    message_desc_t * msg ;
+    rsl_fldspec_t * fld ;
+    
+    per = (period_desc_t *) pr_descriptors[ s ] ;
+    for ( procrec = per->procs[dir][d] ; procrec != NULL ; procrec = procrec->next )
+    {
+      init_period_refs() ;
+      for ( lp = procrec->recv_point_list ; lp != NULL ; lp = lp->next )
+      {
+        ptrec = (rsl_ptrec_t *) lp->data ;
+        ig = ptrec->ig ;
+        jg = ptrec->jg ;
+        i = ig - domain_info[d].ilocaloffset ;
+        j = jg - domain_info[d].jlocaloffset ;
+
+        for ( lp1 = ptrec->recv_messages ; lp1 != NULL ; lp1 = lp1->next )
+        {
+          msg = (message_desc_t *) lp1->data ;
+          for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
+          {
+            if ( fld->type >= 100 ) sd->has_f90_fields = 1 ;
+            base = fld->base ;
+#if 0
+fprintf(stderr,"unpack  P = %d  i j ig jg    %3d %3d %3d %3d, base %08x\n",procrec->P,i,j,ig,jg, base) ;
+#endif
+            elemsz = fld->elemsz ;
+            switch (fld->strategy)
+            {
+            case MINNS_MAJEW_2D :               /* <MM> eg: psa(i,j) */
+              t0 = fld->llen[0] ;
+              store_period_refs( base, fld->f90_table_index , (i+j*t0)*elemsz, elemsz, 1, elemsz) ;
+              break ;
+            case MINEW_MAJNS_2D :               /* xxx(j,i) */
+              t0 = fld->llen[0] ;
+              store_period_refs( base, fld->f90_table_index , (j+i*t0)*elemsz, elemsz, 1, elemsz) ;
+              break ;
+            case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_period_refs( base, fld->f90_table_index , (i+j*t0)*elemsz, elemsz,
+                                         fld->llen[2],
+                                         t1*elemsz) ;
+              break ;
+            case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_period_refs( base, fld->f90_table_index , (j+i*t0)*elemsz, elemsz,
+                                         fld->llen[2],
+                                         t1*elemsz) ;
+              break ;
+            case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_period_refs( base, fld->f90_table_index , (i*t0+j*t1)*elemsz, elemsz * t0, 1, elemsz) ;
+              break ;
+            case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_period_refs( base, fld->f90_table_index , (i+j*t1)*elemsz, elemsz, fld->llen[1], t0*elemsz) ;
+              break ;
+            default:
+              RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+              break ;
+            }
+          }
+        }
+      }
+      period_refs( &(procrec->unpack_table),
+                    &(procrec->unpack_table_size),
+                    &(procrec->unpack_table_nbytes) , 0 ) ;
+    }
+  }
+}
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_slabs.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_slabs.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_slabs.c	(revision 2744)
@@ -0,0 +1,177 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+static rsl_list_t *rp[RSL_MAXDOMAINS] ;
+
+/*@
+  RSL_COMPUTE_ISLAB - apply a routine to each islab locally stored points
+
+  Synopsis:
+  subroutine RSL_COMPUTE_ISLAB ( d, f )
+  integer d
+  external f
+
+  Input parameters:
+. d - domain descriptor
+. f - subroutine to be applied
+
+  Notes:
+  This is one of the principal computational routines of RSL.  It applies
+  a function that represents some piece of work -- compute a time step
+  -- to be done on a horizontal grid point.  RSL_COMPUTE_ISLAB will
+  call the subroutine for each continguous run of points local to the
+  processor up the minor dimension of the domain.
+
+  The subroutine, f, provided should be slab-callable
+  and have six
+  integer dummy arguments which are shown in the example below.
+
+  Example:
+
+$  -- prototypical function --
+$  subroutine F( inest, irun, i1, j1, ig1, jg1 )
+$  integer inest    ! nest level (1 is top)
+$  integer irun     ! number of points in the run
+$  integer i, j     ! index of starting point in local memory
+$  integer ig, jg   ! index of starting point in global domain
+
+$  j = j1
+$  ig = ig1-1
+$  do i = i1, i1+irun-1
+$    ig = ig+1
+$    -- computation --
+$  enddo
+
+$  return
+$  end
+
+$  -- top level routine --
+
+$  external f, m
+$  logical  m
+$    --
+$  call rsl_compute_islab ( d, f )
+$    --
+
+BREAKTHEEXAMPLECODE
+
+@*/
+
+/*@
+  RSL_INIT_NEXTISLAB - Initialize a traversal over local slabs
+
+  RSL_C_NEXTISLAB - Get indices and run length of next slab in traversal
+
+  Notes:
+  These routines are called from within RSL_COMPUTE_ISLAB and are not
+  typically used by the application programmer.
+
+@*/
+int RSL_INIT_NEXTISLAB ( d_p )
+  int_p d_p ;
+{
+  rsl_index_t d ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_init_nextislab: bad domain descriptor") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextislab: invalid domain descriptor") ;
+
+  rp[d] = domain_info[d].iruns ;
+  return(0) ;
+}
+
+int RSL_C_NEXTISLAB ( d_p, irun_p, min_p, maj_p, min_g_p, maj_g_p, retval_p )
+  int_p d_p, irun_p, min_p, maj_p, min_g_p, maj_g_p, retval_p ;
+{
+  rsl_index_t d ;
+  rsl_runrec_t *rrec ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_init_nextcell: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+
+  if ( rp[d] == NULL )
+  {
+    *retval_p = 0 ;		/* no more */
+  }
+  else
+  {
+    rrec = (rsl_runrec_t *)(rp[d]->data) ;
+    *irun_p = rrec->runlength ;
+    *min_g_p = rrec->ig + 1;
+    *maj_g_p = rrec->jg + 1;
+    *min_p = *min_g_p - domain_info[d].ilocaloffset ;
+    *maj_p = *maj_g_p - domain_info[d].jlocaloffset ;
+    rp[d] = rp[d]->next ;
+    *retval_p = 1 ;
+  }
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_slabs_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_slabs_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_slabs_f.F	(revision 2744)
@@ -0,0 +1,79 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine rsl_compute_islab( domain, f )
+      implicit none
+      integer domain    ! domain descriptor
+      integer f         ! function (typed to keep implicit none quiet)
+
+      integer nl, irun, min, maj, min_g, maj_g
+      integer retval
+      integer dummy
+
+      call rsl_nl( domain, nl )	       ! get nest level for this domain
+      call rsl_init_nextislab(domain)   ! initializes rsl_next_cell
+      call rsl_c_nextislab( domain, irun, min, maj, min_g, 
+     +                      maj_g, retval )
+      do while ( retval .eq. 1 )
+         dummy = f( nl+1, irun, min, maj, min_g, maj_g )
+         call rsl_c_nextislab( domain, irun, min, maj, min_g, maj_g,
+     +                         retval )
+      enddo
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_sten.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_sten.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_sten.c	(revision 2744)
@@ -0,0 +1,875 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*
+   Here's a drawing of the graph this routine is trying to construct:
+
+      (stencil_desc)
+        |      |
+        |      |
+        |    array of message_descs corresponding to stencil pts
+        |      msg1 msg2 msg3 msg4 ...
+        |       0    1    2    3     
+        |                       \
+   array of processor lists      \ <---pointers back to message structures
+   on list for each domain        \        |
+     |                            |        |
+  d                               ^      \ v       +-------------------------+
+  o (0) -->  procrec  -->         |       \        |there is one node for    |
+  m            |                  |        \       |each physical processor  |
+  a (1)        |                  |         \      |this processor will need |
+  i            |                  ^          \     |to communicate with for  |
+  n  .         |                  |           \    |this stencil.            |
+     .         v                  |            ^   +-------------------------+
+     .      (list_t)              |            |
+               |  \               ^            ^     +-------------------------+
+               | ( ptrec ) --> (list_t) --> (list_t) |1 for each msg associated|
+               |     |                               |with the point           |
+               |      \                              +-------------------------+
+               v       \+-------------------------------------------------+
+            (list_t)    |points to the entry for the local point in domain|
+               |        |data structure.                                  |
+               |        +-------------------------------------------------+
+               .
+               .
+               .
+
+**************
+  Algorithm:
+
+    P is a remote processor, M is me
+
+ 1  To work out sends to P from M:
+ 1.1   for each ghost point GP from P
+ 1.1.1   for each point p on GP's stencil
+ 1.1.1.1    if p is on M
+ 1.1.1.1.1     add p to list of points going to P (if not already on)
+ 1.1.1.1.2     add message from p to p's entry in the aforementioned list 
+
+ 2  To work out receives from P to M:
+ 2.1   for each ghost point GP from P
+ 2.1.1   for each point p on GP's stencil
+ 2.1.1.1    if p is on M
+ 2.1.1.1.1     add GP to list of points being sent from P (if not already on)
+ 2.1.1.1.2     add message from GP to GP's entry in the aforementioned list 
+
+    Combined algorithm;
+          
+ 1  To work out receives from P to M:
+ 1.1   for each ghost point GP from P
+ 1.1.1   for each point p on GP's stencil
+ 1.1.1.1    if p is on M
+ 1.1.1.1.1     add p to list of points going to P (if not already on)
+ 1.1.1.1.2     add message from p to p's entry in the aforementioned list 
+ 2.1.1.1.1     add GP to list of points being sent from P (if not already on)
+ 2.1.1.1.2     add message from GP to GP's entry in the aforementioned list 
+
+*/
+
+/* used by compile_stencil, below */
+static stencil_desc_t *sd ;            /* set in compile_stencil */
+static rsl_procrec_t *procrec ;        /* set in compile_stencil */
+static int send_accum ;
+static int recv_accum ;
+
+#if 0
+/* this is a linked list that is used for the receives from the remote
+   processor (the GP list in the above algorithmic descriptions).  We are 
+   only counting bytes for these messages (to allocated the correctly sized 
+   buffers) so this is just a temporary data structure that is cleaned up 
+   on each call to rsl_compile_stencil */
+static rsl_list_t *recv_point_list = NULL ;   /* 940308 */
+#endif
+
+dstry_ptrec_list( recv_ptrec )
+  rsl_ptrec_t *recv_ptrec ;
+{
+  destroy_list( &(recv_ptrec->recv_messages), NULL ) ;
+}
+
+rsl_processor_t idx_ ;
+
+#ifdef NEC_TUNE
+/*
+   NECNOTE: 
+   quick tables to speed up link list searching in routine check_local_pts.
+   tbl_'id'_... used for searching rsl_point_t id's.
+*/
+static int ntbl_id_max = 128 ; /* Note first allocation will be of size 256 */
+static int ntbl_id = 0 ;
+static rsl_point_id_t *tbl_id = NULL ;
+static rsl_ptrec_t **tbl_ptrec = NULL ;
+static rsl_procrec_t *prev_procrec = NULL ;
+#endif
+/* 1.1.1 (continued) */
+/* this routine is called for each point on the ghost point's stencil */
+check_local_pts( d, m, n, hm, hn, pt, ipt )
+  rsl_index_t d ;               /* domain index */
+  rsl_index_t m, n ;            /* this point */
+  rsl_index_t hm, hn ;          /* home point (whose stencil I'm on)  */
+  rsl_index_t pt ;              /* point in stencil */
+  rsl_index_t ipt ;             /* inverse point in stencil */
+{
+  int mlen ;			/* length of minor domain dimension */
+  rsl_fldspec_t *fp, *fpm, *prev, *new ;
+  int message, found ;
+  rsl_processor_t  P ;
+  rsl_point_id_t id ;
+  rsl_ptrec_t *ptrec, *recv_ptrec ;
+  int recv_npts ;       /* dummy */
+  rsl_list_t *lp ;
+  message_desc_t *msg ;
+  rsl_domain_info_t *dinfo ;
+  rsl_point_t *domain ;
+#ifdef NEC_TUNE
+  int i ;
+#endif
+
+  dinfo = &(domain_info[d]) ;
+  domain = dinfo->domain ;
+  mlen = dinfo->len_m ;
+
+  /* P is proc of ghost point */
+  P = domain[INDEX_2(hn,hm,mlen)].P ;
+/* 1.1.1.1 */
+  if ( rsl_c_comp2phys_proc (domain[INDEX_2(n,m,mlen)].P) == rsl_myproc )
+  {
+/* 1.1.1.1.1 */
+    id = POINTID(d,n,m) ;
+    found = 0 ;
+#ifndef NEC_TUNE
+    for ( lp = procrec->point_list ; lp != NULL ; lp = lp->next )
+    {
+      ptrec = (rsl_ptrec_t *)lp->data ;
+      if ( ptrec->pt->id == id )
+      {
+        found = 1 ;
+        break ;
+      }
+    }
+#else
+    if ( prev_procrec != procrec )
+    {
+      ntbl_id = 0 ;
+      prev_procrec = procrec ;
+    }
+    for ( i = 0 ; i < ntbl_id ; i++ )
+    {
+      if ( tbl_id[i] == id )
+      {
+        found = 1 ;
+        break ;
+      }
+    }
+    if ( found ) ptrec = tbl_ptrec[i] ;
+#endif
+    if ( !found )       /* add it */
+    {
+      lp    = RSL_MALLOC( rsl_list_t, 1 ) ;
+      ptrec = RSL_MALLOC( rsl_ptrec_t, 1 ) ;
+      ptrec->pt = &(domain[INDEX_2(n,m,mlen)]) ;
+      ptrec->ig = m ;
+      ptrec->jg = n ;
+      ptrec->nsendmsgs = 0 ;
+      ptrec->nrecvmsgs = 0 ;
+      ptrec->send_messages = NULL ;
+      ptrec->recv_messages = NULL ;
+      lp->data = ptrec ;
+      lp->next = procrec->point_list ;
+      procrec->point_list = lp ;
+      procrec->npts++ ;
+      send_accum += sizeof( rsl_point_hdr_t ) ;
+#ifdef NEC_TUNE
+      if ( ntbl_id == ntbl_id_max || tbl_id == NULL )
+      {
+        ntbl_id_max *= 2 ;
+        tbl_id = (rsl_point_id_t *)realloc((void *)tbl_id, ntbl_id_max*sizeof(rsl_point_id_t *)) ;
+        tbl_ptrec = (rsl_ptrec_t **)realloc((void *)tbl_ptrec, ntbl_id_max*sizeof(rsl_ptrec_t *)) ;
+      }
+      tbl_id[ntbl_id] = id ;
+      tbl_ptrec[ntbl_id] = ptrec ;
+      ntbl_id++ ;
+#endif
+    }
+
+/* 2.1.1.1.1 */
+    /* add the ghost point to the list of points from which we
+       will receive messages */
+    id = POINTID(d,hn,hm) ;
+    found = 0 ;
+    for ( lp = procrec->recv_point_list ; lp != NULL ; lp = lp->next )
+    {
+      recv_ptrec = (rsl_ptrec_t *)lp->data ;
+      if ( recv_ptrec->pt->id == id )
+      {
+        found = 1 ;
+        break ;
+      }
+    }
+    if ( !found )       /* add it */
+    {
+      lp    = RSL_MALLOC( rsl_list_t, 1 ) ;
+      recv_ptrec = RSL_MALLOC( rsl_ptrec_t, 1 ) ;
+      recv_ptrec->pt = &(domain[INDEX_2(hn,hm,mlen)]) ;
+      recv_ptrec->ig = hm ;
+      recv_ptrec->jg = hn ;
+      recv_ptrec->nsendmsgs = 0 ;
+      recv_ptrec->nrecvmsgs = 0 ;
+      recv_ptrec->send_messages = NULL ;
+      recv_ptrec->recv_messages = NULL ;
+      lp->data = recv_ptrec ;
+      lp->next = procrec->recv_point_list ;
+      procrec->recv_point_list = lp ;
+      procrec->recv_npts++ ;
+      recv_accum += sizeof( rsl_point_hdr_t ) ;
+    }
+
+
+/* 1.1.1.1.2 */
+    /* at this point ptrec points to a ptrec (for the local point) in the 
+       list for the non-local processor. */
+    msg = sd->msgs[d][ pt-1 ] ;
+    if ( msg != NULL )
+    {
+      /* iterate through message list for ptrec and add the message 
+         to be sent to the ghost point from this local point to the list
+         for the local point if it isn't there */
+      for ( lp = ptrec->send_messages, found = 0 ; lp != NULL ; lp = lp->next )
+      {
+        if ( msg == ( message_desc_t * )lp->data )
+        {
+          found = 1 ;
+          break ;
+        }
+      }
+      if ( !found )   /* add it */
+      {
+        lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+        lp->data = msg ;
+        lp->next = ptrec->send_messages ;
+	lp->info1 = pt ;			/* index of stencil point */
+        ptrec->send_messages = lp ;
+        send_accum += message_size( msg ) ;
+        send_accum += sizeof(int) ;		/* for send of stencil point index */
+        ptrec->nsendmsgs++ ;
+      }
+    }
+
+/* 2.1.1.1.2 */
+    /* repeat for the receives, but note, that for the receives we
+       are only interested in the size of the messages. Also, we're
+       interested in the ghost-point, not the point.*/
+    msg = sd->msgs[d][ ipt-1 ] ;     /* ipt instead of pt used for index */
+    if ( msg != NULL )
+    {
+      /* iterate through message list for recv_ptrec and if message to be
+         received is not there add it. */
+      for ( lp = recv_ptrec->recv_messages, found = 0 ;
+                                      lp != NULL ; lp = lp->next )
+      {
+        if ( msg == ( message_desc_t * )lp->data )
+        {
+          found = 1 ;
+          break ;
+        }
+      }
+      if ( !found )
+      {
+        lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+        lp->data = msg ;
+        lp->next = recv_ptrec->recv_messages ;
+	lp->info2 = ipt ;		/* inverse stencil point */
+        recv_ptrec->recv_messages = lp ;
+        recv_accum += message_size( msg ) ;
+        recv_accum += sizeof(int) ;		/* for send of stencil point index */
+        recv_ptrec->nrecvmsgs++ ;
+        ptrec->nrecvmsgs = recv_ptrec->nrecvmsgs ;   /* intentional (ptrec) */
+      }
+    }
+  }
+}
+
+check_sten ( s_p )
+  int_p s_p ;
+{
+  int s ;
+
+  s = *s_p ;
+  RSL_TEST_ERR( s <= 0 || s > RSL_MAXDESCRIPTORS,
+	"rsl_compile_stencil: bad stencil descriptor" ) ;
+  RSL_TEST_ERR((sd = (stencil_desc_t *)sh_descriptors[s]) == NULL,
+	"compile_descriptor: null stencil descriptor" ) ;
+fprintf(stderr,"DEBUG CHECK_STEN: s %d, sd->tag %d\n", s, sd->tag ) ;
+  RSL_TEST_ERR( sd->tag != STENCIL_DESC,
+        "compile_descriptor: bad stencil descriptor" ) ;
+}
+
+/* this is now used internally only -- this will be called automatically
+   whenever a stencil exchange is attempted on a stencil that has not
+   yet been compiled */
+rsl_compile_stencil( d_p, s_p )
+  int_p d_p, s_p ;
+{
+  int d, s ;
+  int i, j, k ;
+  int len_plist ;
+  int (*ptfcn)() ;
+  rsl_list_t *lp, *lp2, *destr, *destr2, *ghost_points ;
+  rsl_domain_info_t *dp ;
+  rsl_point_t  *pt ;
+  rsl_dimlen_t mlen, nlen ;
+  int m, n ;
+  rsl_processor_t P, Plist[RSL_MAXPROC] ;
+  int check_local_pts() ;
+
+  d = *d_p ;
+  s = *s_p ;
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "rsl_compile_stencil: bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID, 
+	"rsl_compile_stencil: descriptor for invalid domain" ) ;
+
+  mlen = domain_info[d].len_m ;
+  nlen = domain_info[d].len_n ;
+
+  /* sd is static so that check_local_pts can get at it */
+  RSL_TEST_ERR( s <= 0 || s > RSL_MAXDESCRIPTORS,
+	"rsl_compile_stencil: bad stencil descriptor" ) ;
+  RSL_TEST_ERR((sd = (stencil_desc_t *)sh_descriptors[s]) == NULL,
+	"compile_descriptor: null stencil descriptor" ) ;
+  RSL_TEST_ERR( sd->tag != STENCIL_DESC,
+        "compile_descriptor: bad stencil descriptor" ) ;
+  RSL_TEST_ERR( sd->compiled[d] != 0,
+        "compile_stencil: stencil has already been compiled for this domain") ;
+
+  sd->compiled[d] = 1 ;
+  ptfcn = sd->f[d].ptfcn ;
+  dp = &(domain_info[d]) ;
+
+  if ( dp->decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+  /* get a list of the processors that have ghost points and store in 
+     Plist; len_plist is the number of processors stored */
+  for ( i = 0 ; i < RSL_MAXPROC ; i++ )
+    Plist[i] = 0 ;
+  for ( lp = dp->ghost_pts ; lp != NULL ; lp = lp->next ) 
+  {
+    idx_ = ((rsl_point_t *)lp->data)->P ;
+    if ( idx_ < 0 || idx_ >= RSL_MAXPROC )
+    {
+      sprintf(mess,"domain %d: idx_ = %d\n",d, idx_ );
+      RSL_TEST_WRN(1,mess) ;
+    }
+    Plist[ idx_ ] = 1 ;
+  }
+  for ( len_plist = 0, i = 0 ; i < RSL_MAXPROC ; i++ )
+    if ( Plist[i] == 1 ) Plist[ len_plist++ ] = i ;
+
+  for ( k = 0 ; k < len_plist ; k++ )
+  {
+    P = Plist[k] ; 
+
+    procrec = RSL_MALLOC( rsl_procrec_t, 1 ) ;
+    procrec->P = P ;
+    procrec->next = sd->procs[d] ;
+    sd->procs[d] = procrec ;
+
+#if 0
+    destroy_list( &recv_point_list, dstry_ptrec_list ) ;
+    recv_point_list = NULL ;
+#endif
+
+/* 1.1 */
+    /* for every ghost point from P, mark any local point that lies
+       on its stencil (using the point function associated with the
+       stencil.   */
+    procrec->npts = 0 ;
+    procrec->recv_npts = 0 ;
+    send_accum = 0 ;
+    recv_accum = 0 ;
+    for ( n = 0 ; n < nlen ; n++ )
+      for ( m = 0 ; m < mlen ; m++ )
+        if ( dp->domain[ INDEX_2( n, m, mlen ) ].P == P )
+        {
+/* 1.1.1 */
+           (*ptfcn)( d, m, mlen, n, nlen, check_local_pts ) ;
+        }
+
+    procrec->nsends = 0 ;
+    procrec->nrecvs = 0 ;
+    procrec->sendsize = send_accum + sizeof(int) ; /* extra word for count */
+    procrec->recvsize = recv_accum + sizeof(int) ; /* extra word for count */
+  }
+#define NEW
+#ifdef NEW
+  {
+    int ig, jg, i, j ;
+    rsl_list_t *lp1 ;
+    void * base ;
+    int elemsz, t0, t1, pack_table_size ;
+    stencil_desc_t * sten ;
+    rsl_ptrec_t * ptrec ;
+    message_desc_t * msg ;
+    rsl_fldspec_t * fld ;
+
+    sten = (stencil_desc_t *) sh_descriptors[ s ] ;
+    for ( procrec = sten->procs[d] ; procrec != NULL ; procrec = procrec->next )
+    {
+      init_process_refs() ;
+      for ( lp = procrec->point_list ; lp != NULL ; lp = lp->next )
+      {
+        ptrec = (rsl_ptrec_t *) lp->data ;
+        ig = ptrec->ig ;
+        jg = ptrec->jg ;
+        i = ig - domain_info[d].ilocaloffset ;
+        j = jg - domain_info[d].jlocaloffset ;
+
+        for ( lp1 = ptrec->send_messages ; lp1 != NULL ; lp1 = lp1->next )
+        {
+	  msg = (message_desc_t *) lp1->data ;
+	  for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
+	  {
+            if ( fld->type >= 100 ) sten->has_f90_fields = 1 ;
+	    base = fld->base ;
+	    elemsz = fld->elemsz ;
+	    switch (fld->strategy)
+	    {
+	    case MINNS_MAJEW_2D :		/* <MM> eg: psa(i,j) */
+	      t0 = fld->llen[0] ;
+	      store_process_refs( base, fld->f90_table_index, (i+j*t0)*elemsz, elemsz, 1, elemsz) ;
+	      break ;
+	    case MINEW_MAJNS_2D :		/* xxx(j,i) */
+	      t0 = fld->llen[0] ;
+	      store_process_refs( base, fld->f90_table_index, (j+i*t0)*elemsz, elemsz, 1, elemsz) ;
+	      break ;
+	    case MINNS_MAJEW_K_3D :		/* <MM> eg: ua(i,j,k) */
+	      t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+	      store_process_refs( base, fld->f90_table_index, (i+j*t0)*elemsz, elemsz,
+                                         fld->llen[2],
+                                         t1*elemsz) ;
+	      break ;
+	    case MINEW_MAJNS_K_3D :		/* <MM> eg: u(j,i,k) */
+	      t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+	      store_process_refs( base, fld->f90_table_index, (j+i*t0)*elemsz, elemsz,
+                                         fld->llen[2],
+                                         t1*elemsz) ;
+	      break ;
+	    case K_MIDNS_MAJEW_3D :		/* <MM> eg: u(k,i,j) */
+	      t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+	      store_process_refs( base, fld->f90_table_index, (i*t0+j*t1)*elemsz, elemsz * t0, 1, elemsz) ;
+	      break ;
+	    case MINNS_K_MAJEW_3D :		/* <MM> eg: u(i,k,j) */
+	      t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+	      store_process_refs( base, fld->f90_table_index, (i+j*t1)*elemsz, elemsz, fld->llen[1], t0*elemsz) ;
+	      break ;
+	    default:
+	      RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+	      break ;
+	    }
+	  }
+        }
+      }
+      process_refs( &(procrec->pack_table),
+                    &(procrec->pack_table_size),
+                    &(procrec->pack_table_nbytes), 1 ) ;
+#if 0
+      fprintf(stderr,"pack P = %3d:\n",procrec->P ) ;
+      show_pack_table( procrec->pack_table,
+                       procrec->pack_table_size,
+                       procrec->pack_table_nbytes ) ;
+#endif
+    }
+  }
+  {
+    int ig, jg, i, j ;
+    rsl_list_t *lp1 ;
+    void * base ;
+    int elemsz, t0, t1, pack_table_size ;
+    stencil_desc_t * sten ;
+    rsl_ptrec_t * ptrec ;
+    message_desc_t * msg ;
+    rsl_fldspec_t * fld ;
+    
+    sten = (stencil_desc_t *) sh_descriptors[ s ] ;
+    for ( procrec = sten->procs[d] ; procrec != NULL ; procrec = procrec->next )
+    {
+      init_process_refs() ;
+      for ( lp = procrec->recv_point_list ; lp != NULL ; lp = lp->next )
+      {
+        ptrec = (rsl_ptrec_t *) lp->data ;
+        ig = ptrec->ig ;
+        jg = ptrec->jg ;
+        i = ig - domain_info[d].ilocaloffset ;
+        j = jg - domain_info[d].jlocaloffset ;
+
+        for ( lp1 = ptrec->recv_messages ; lp1 != NULL ; lp1 = lp1->next )
+        {
+	  msg = (message_desc_t *) lp1->data ;
+	  for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
+	  {
+            if ( fld->type >= 100 ) sten->has_f90_fields = 1 ;
+	    base = fld->base ;
+	    elemsz = fld->elemsz ;
+            switch (fld->strategy)
+            {
+            case MINNS_MAJEW_2D :               /* <MM> eg: psa(i,j) */
+              t0 = fld->llen[0] ;
+              store_process_refs( base, fld->f90_table_index, (i+j*t0)*elemsz, elemsz, 1, elemsz) ;
+              break ;
+            case MINEW_MAJNS_2D :               /* xxx(j,i) */
+              t0 = fld->llen[0] ;
+              store_process_refs( base, fld->f90_table_index, (j+i*t0)*elemsz, elemsz, 1, elemsz) ;
+              break ;
+            case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_process_refs( base, fld->f90_table_index, (i+j*t0)*elemsz, elemsz,
+                                         fld->llen[2],
+                                         t1*elemsz) ;
+              break ;
+            case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_process_refs( base, fld->f90_table_index, (j+i*t0)*elemsz, elemsz,
+                                         fld->llen[2],
+                                         t1*elemsz) ;
+              break ;
+            case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_process_refs( base, fld->f90_table_index, (i*t0+j*t1)*elemsz, elemsz * t0, 1, elemsz) ;
+              break ;
+            case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
+              t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+              store_process_refs( base, fld->f90_table_index, (i+j*t1)*elemsz, elemsz, fld->llen[1], t0*elemsz) ;
+              break ;
+            default:
+              RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+              break ;
+            }
+	  }
+        }
+      }
+      process_refs( &(procrec->unpack_table),
+                    &(procrec->unpack_table_size),
+                    &(procrec->unpack_table_nbytes), 1 ) ;
+#if 0
+      fprintf(stderr,"upack P = %3d:\n",procrec->P ) ;
+      show_pack_table( procrec->unpack_table,
+                       procrec->unpack_table_size,
+                       procrec->unpack_table_nbytes ) ;
+#endif
+    }
+  }
+#endif
+}
+
+show_pack_table( pack_table, pack_table_size, pack_table_nbytes )
+  packrec_t pack_table[] ;
+  int pack_table_size ;
+  int pack_table_nbytes ;
+{
+  int i,ii,jj ;
+  for ( i = 0 ; i < pack_table_size ; i++ )
+  {
+    fprintf(stderr,
+"  base %08x %12d offset %10d f90 index %d n %3d nelem %5d stride %5d valid %2d\n",
+	      pack_table[i].base,
+	      pack_table[i].base,
+	      pack_table[i].offset,
+	      pack_table[i].f90_table_index,
+	      pack_table[i].n,
+	      pack_table[i].nelems,
+	      pack_table[i].stride,
+	      pack_table[i].valid ) ;
+#if 0
+    for ( jj = 0 ; jj < pack_table[i].nelems ; jj++ )
+    for ( ii = 0 ; ii < pack_table[i].n ; ii += 4 )
+    {
+      fprintf(stderr,"** elem %d, n %d, %16lx, %f\n",jj,ii,
+		(float *)( (char *)
+		   pack_table[i].base + 
+		   pack_table[i].offset +
+		   jj * pack_table[i].stride +
+		   ii ),
+		*((float *)( (char *)
+		   pack_table[i].base + 
+		   pack_table[i].offset +
+		   jj * pack_table[i].stride +
+		   ii ))
+		   ) ;
+    }
+#endif
+
+  }
+  fprintf(stderr," table nbytes=%d\n", pack_table_nbytes ) ;
+}
+
+
+/*@
+  SHOW_STEN_DIAGS - Show run time information about stencil performance.
+
+  Input parameter:
+. d - domain descriptor
+. s - stencil descriptor
+
+  Synopsis:
+  subroutine SHOW_STEN_DIAGS ( d, s )
+  integer d
+  integer s
+
+  Notes:
+  Information is sent to a file sten_diags_<pid> for each
+  processor.
+
+  See also:
+  RSL_CREATE_STENCIL, RSL_DESCRIBE_STENCIL, RSL_EXCH_STENCIL
+
+@*/
+
+static int show_sten_diags_first = 1 ;
+
+SHOW_STEN_DIAGS ( d_p, s_p )
+  int_p d_p, s_p ;
+{
+  int d, s, P, nsends, nbytes ;
+  stencil_desc_t *sp ;
+  rsl_procrec_t *procrec ;
+  rsl_ptrec_t *ptrec ;
+  FILE *fp ;
+  char fname[80], *code  ;
+  int smsgs, rmsgs ;
+  rsl_list_t *lp ;
+
+  s = *s_p ;
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, 
+                            "show_sten_diags: bad domain descriptor") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+		"show_sten_diags: invalid domain descriptor" ) ;
+  sp = (stencil_desc_t *)sh_descriptors[s] ;
+  if ( sp == NULL ) return ;
+  if ( show_sten_diags_first )
+  {
+    code = "w" ;
+    show_sten_diags_first = 0 ;
+  }
+  else
+  {
+    code = "a" ;
+  }
+  sprintf(fname,"sten_diags_%04d",rsl_myproc) ;
+  if (( fp = fopen ( fname, code )) == NULL )
+  {
+     perror(fname) ;
+     exit(2) ;
+  }
+  fprintf(fp,"Diagnostics for stencil %3d, domain %3d\n",s,d) ;
+
+  for ( procrec = sp->procs[d] ; procrec != NULL ; procrec = procrec->next )
+  {
+    smsgs = 0 ; rmsgs = 0 ;
+    for ( lp = procrec->point_list ; lp != NULL ; lp = lp->next )
+    {
+      ptrec = (rsl_ptrec_t *) lp->data ;
+      smsgs += ptrec->nsendmsgs ;
+      rmsgs += ptrec->nrecvmsgs ;
+    }
+    fprintf(fp,"   to %4d : %5d of %10d bytes (%10d tot), pts %4d, msgs %4d\n",
+            procrec->P,
+            procrec->nsends,
+            procrec->sendsize,
+            procrec->nsends*procrec->sendsize,
+            procrec->npts,
+            smsgs ) ;
+    fprintf(fp," from %4d : %5d of %10d bytes (%10d tot), pts %4d, msgs %4d\n",
+            procrec->P,
+            procrec->nrecvs,
+            procrec->recvsize,
+            procrec->nrecvs*procrec->recvsize,
+            procrec->recv_npts,
+            rmsgs ) ;
+  }
+  fclose(fp) ;
+}
+
+static FILE * fp = NULL ;
+static int show_first = 1 ;
+SHOW_MESSAGE ( mh_p )
+  int_p mh_p ;
+{
+  int mh ;
+  message_desc_t *msg ;
+  rsl_fldspec_t  *fld ; 
+  int dim ;
+  char * code ;
+  char fname[80] ;
+
+  mh = *mh_p ;
+  if ( show_first )
+  {
+    code = "w" ;
+    show_first = 0 ;
+    sprintf(fname,"show_def_%04d",rsl_myproc) ;
+    if (( fp = fopen ( fname, code )) == NULL )
+    {
+       perror(fname) ;
+       exit(2) ;
+    }
+  }
+  if ( mh == RSL_INVALID )
+  {
+    fprintf(fp,"MESSAGE HANDLE: RSL_INVALID\n" ) ;
+  }
+  else
+  {
+    msg = (message_desc_t *)mh_descriptors[mh] ;
+    show_message_desc( msg ) ;
+  }
+}
+
+show_message_desc( msg )
+  message_desc_t * msg ;
+{
+  rsl_fldspec_t  *fld ; 
+  int dim ;
+  int mh ;
+
+  if ( msg == NULL ) return ;
+  fprintf(fp,"MESSAGE HANDLE: %d\n",msg->mh ) ;
+  fprintf(fp,"           tag: %d\n",msg->tag ) ;
+  fprintf(fp,"         nflds: %d\n",msg->nflds ) ;
+  for ( fld = msg->fldspecs ; fld != NULL ; fld=fld->next )
+  {
+    fprintf(fp,"  FLD:\n") ;
+    fprintf(fp,"          base: %x\n",fld->base ) ;
+    fprintf(fp,"          ndim: %d\n",fld->ndim ) ;
+    fprintf(fp,"        elemsz: %d\n",fld->elemsz ) ;
+    for ( dim = 0 ; dim < fld->ndim && dim < RSL_MAXDIM ; dim++ )
+    {
+      fprintf(fp,"       decomp[%3d]: %d\n",dim,fld->decomp[dim] ) ;
+      fprintf(fp,"         gdex[%3d]: %d\n",dim,fld->gdex[dim] ) ;
+      fprintf(fp,"         glen[%3d]: %d\n",dim,fld->glen[dim] ) ;
+      fprintf(fp,"         llen[%3d]: %d\n",dim,fld->llen[dim] ) ;
+    }
+  }
+}
+
+/*@
+  SHOW_STENCIL - Show information about the stencil structure
+
+  Input parameter:
+. s - domain descriptor
+
+  Synopsis:
+  subroutine SHOW_STENCIL ( s )
+  integer s		
+
+  Notes:
+  Information is sent to a file show_def_<pid> for each
+  processor.
+
+  See also:
+  RSL_CREATE_STENCIL, RSL_DESCRIBE_STENCIL
+
+@*/
+
+SHOW_STENCIL ( d_p, sh_p )
+  int_p d_p ;
+  int_p sh_p ;
+{
+  int sh, d ;
+  int spt ;
+  stencil_desc_t * sten ; 
+  char * code ;
+  char fname[80] ;
+
+  d  = *d_p ;
+  sh = *sh_p ;
+  if ( show_first )
+  {
+    code = "w" ;
+    show_first = 0 ;
+    sprintf(fname,"show_def_%04d",rsl_myproc) ;
+    if (( fp = fopen ( fname, code )) == NULL )
+    {
+       perror(fname) ;
+       exit(2) ;
+    }
+  }
+  sten = (stencil_desc_t *)sh_descriptors[sh] ;
+  if ( sten == NULL ) return ;
+  fprintf(fp,"STENCIL HANDLE: %d\n",sh ) ;
+  fprintf(fp,"           tag: %d\n",sten->tag ) ;
+  fprintf(fp,"          npts: %d\n",sten->npts[d] ) ;
+  fprintf(fp,"        maskid: %d\n",sten->maskid[d] ) ;
+  
+  for ( spt = 0 ; spt < sten->npts[d] && spt < RSL_MAXSTEN+1 ; spt++ )
+  {
+    fprintf(fp,"    stencil pt: %d\n",spt ) ;
+    show_message_desc( sten->msgs[d][spt] ) ;
+  }
+
+  /* code to show processor lists not here yet */
+
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_world.bad
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_world.bad	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_world.bad	(revision 2744)
@@ -0,0 +1,502 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_GET_RUN_INFO - get RSL information about size and shape local allocation.
+
+  Notes:
+  This routine is used to initialize loops over each processor's
+  local partition of the decomposed domain.  The routine can be used
+  directly, or RSL-provided macros may be used in the code that expand
+  to the proper calls.  Both M4 and CPP macros are provided in the 
+  RSL distribution (see LoopMacros).
+  The macro approach is recommended
+  for readability, simplicity,
+  and also to insulate the code from future potential updates in RSL.
+  Of the two sets, the M4 macros are recommended since they
+  are more flexible.
+
+  RSL returns through the arguments Arg6, Arg7, and Arg8 information
+  for iterating over the local processor partition N-major, M-minor.
+  Argument Arg4 is the number of iterations to cover the part of the
+  domain allocated to the processor.  Arg6 contains the
+  J-indices (Arg4 of them) of each I-strip local to the processor.
+  The first index into the local partition is stored at stored at Arg6(3).
+  The locations Arg6(1) and Arg6(2) are placeholders for indices
+  if one wishes to include one or two of the pad or ghost cells in
+  the iteration (see RSL_GET_INFOP).
+  Arg7 contains the starting and ending indices of each I-strip.  Likewise,
+  the first actual index in Arg7 is at Arg7(3).
+  The arguments Arg9, Arg10, and
+  Arg11 have the same sense as Arg6, Arg7, and Arg8, except that they
+  provide information for 
+  iteration in M-major, N-minor order.  Argument Arg5 is
+  the number of major iterations over M.
+  The arrays Arg6, Arg7, Arg8, Arg9, Arg10, and Arg11 store local (memory)
+  indices.  The logical (global) indices can be obtained by subtracting
+  Arg12 (for M-dimension indices) or Arg13 (for N-dimension indices).
+  
+  Unlike programs that are implemented in single address
+  spaces, the identical
+  relationship between logical and memory
+  indices does not hold for data-domain decomposition over distributed
+  memories.  That is, the memory index (the subscripts into a model
+  array) may not be used for testing proximity of the point to a
+  boundary in the logical domain.  Further, the relationship between
+  logical and memory indices differs on each processor.  The Arg12 and
+  Arg13 arguments are the differences between the local and global
+  indices in the M and N dimensions, respectively, and can be used by
+  the program for converting between logical and memory indices.  For
+  example, the local index I in the M dimension is equal to Arg12 plus
+  the global index IG.
+
+  All of these arrays -- Arg6, Arg7, Arg8, Arg9, Arg10, and Arg11 
+  are integers and must have been allocated by the user with size
+  large enough to fit the largest possible run through a dimension.
+  The argument Arg2 is the length of the arrays.
+  The integer Arg1 is an RSL domain descriptor.
+
+  The integer Arg3
+  is the nest level of the domain (mother domain is at nest-level 1),
+  which is not necessary for iteration over the domain but which 
+  is information that RSL has available and that is useful to have
+  at the beginning of a module.
+
+  Example:
+
+$  -- original code --
+
+$  subroutine F( ... )
+$  ...
+$  do j = 3, jl-2
+$    do i = 3, il-2
+$      a(i,j) = b(i,j) + c(i,j)
+$    enddo
+$  enddo
+
+$  -- example using M4 macros in LoopMacros.m4 --
+
+$  subroutine F( ... )
+$  RSL_RUN_DECL
+$  ...
+$  RSL_INIT_RUNVARS(d)              ! d is an RSL domain descriptor
+$  RSL_DO_N(j,3,jl-2)
+$    RSL_DO_M(i,3,il-2)
+$      a(i,j) = b(i,j) + c(i,j)
+$    RSL_ENDDO
+$  RSL_ENDDO
+
+$  -- example using CPP macros in LoopMacros.inc --
+
+$ #include "LoopMacros.cpp"
+$  subroutine F( ... )
+$  RSL_DECLARE_RUN_VARS 
+$  ...
+$  RSL_INIT_RUNS(d)                 ! d is an RSL domain descriptor
+$  RSL_MAJOR_BOUND(j,3,jl-2)
+$    RSL_MINOR_BOUND(j,3,jl-2)
+$      a(i,j) = b(i,j) + c(i,j)
+$    RSL_END_MINOR_LOOPB
+$  RSL_END_MAJOR_LOOPB
+
+$  -- example with macros expanded --
+
+$  subroutine F( ... )
+$  integer   ig,jg,nruni,nrunj,js,is,ie,is2,js2,je2,idif,jdif,nr
+$  dimension js(512)  ,is(512)  ,ie(512)    ! for N-major iteration
+$  dimension is2(512) ,js2(512) ,je2(512)   ! for M-major iteration
+$
+$  call rsl_get_run_info( d,     512,   nl,   nrunj,   nruni, 
+$ +                       js,    is,    ie,
+$ +                       js2,   is2,   ie2,
+$ +                       idif,  jdif                         )
+
+$  do nr = 3, nrun+2
+$    j=js(nr)
+$    jg=j-jdif
+$    if ( jg .ge. 3 .and. jg .le. maxj-2 ) then
+$      do i=is(nr),ie1(nr)
+$        ig=i-idif
+$        if ( ig .ge. 3 .and. ig .le. maxi-2 ) then
+$          a(i,j) = b(i,j) + c(i,j)
+$        endif
+$      enddo
+$    endif
+$  enddo
+
+BREAKTHEEXAMPLECODE
+
+  See also:
+  RSL_GET_RUN_INFOP, LoopMacros.m4
+
+@*/
+
+RSL_GET_RUN_INFO ( d_p, maxrun_p, nl_p, nrunj_p, nruni_p, js, is, ie, is2, js2, je2, idif_p, jdif_p )
+  int_p 
+    d_p          /* (I) RSL domain descriptor (input) */
+   ,maxrun_p     /* (I) Number of elements in array arguments to this routine */
+   ,nl_p         /* (O) Nest level of the domain */
+   ,nrunj_p      /* (O) Number of runs through domain in j-major traversal */
+   ,nruni_p ;    /* (O) Number of runs through domain in i-minor traversal */
+  int
+    js[]         /* (O) Local J-index of each run in j-major traversal */
+   ,is[]         /* (O) Starting local I-index of each run in j-major traversal */
+   ,ie[]         /* (O) Ending local I-index of each run in j-major traversal */
+   ,is2[]        /* (O) Local I-index of each run in i-major traversal */
+   ,js2[]        /* (O) Starting local J-index of each run in i-major traversal */
+   ,je2[] ;      /* (O) Ending local J-index of each run in i-major traversal */
+  int_p
+    idif_p       /* (O) Difference between local and global I indices (i-ig). */
+   ,jdif_p  ;    /* (O) Difference between local and global J indices (j-jg). */
+{
+  int x ;
+  int *dummy ;
+  x = 0 ;
+  dummy = NULL ;
+  RSL_GET_RUN_INFOP ( d_p, &x, maxrun_p, nl_p, nrunj_p, nruni_p,
+                      js, is, ie, is2, js2, je2, idif_p, jdif_p,
+                      dummy, dummy ) ;
+}
+
+/* additional P argument is the width of pad to allow for */
+/*@
+  RSL_GET_RUN_INFOP - get RSL information about size and shape local allocation.
+
+  Notes:
+  This routine is similar to RSL_GET_RUN_INFO except that it allows for
+  execution on the extended array pads of the local processor
+  subdomains.  This can be useful for trading off computation for
+  communication in the code and can simplify the implementation
+  by allowing fewer modifications for distributed memory
+  parallelism.  The argument Arg2 may be set to
+  for one of 3 modes of iteration over the local subdomain ---
+  Arg2 = 2 gives iteration over the local subdomain and the set of
+  ghost points that are two-away from points in the local subdomain,
+  Arg2 = 1 gives iteration over the local subdomain and the set of
+  ghost points that are one-away from points in the local subdomain, and
+  Arg2 = 0 gives iteration over just the local subdomain (no ghost points).
+  that are immediately adjacent to the local processor subdomain, or
+  the set that is within 2 cells of the local processor subdomain.  The
+  information for controlling iteration over the region is returned in
+  the arguments Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, and Arg12.
+
+  The M4 RSL loop macros automatically initialize 3 separate sets of
+  these data structures for the 3 available modes of iteration.
+
+  See also:
+  RSL_GET_RUN_INFO, LoopMacros.m4
+@*/
+RSL_GET_RUN_INFOP ( d_p, p_p, maxrun_p, nl_p, nrunj_p, nruni_p,
+                    js, is, ie, is2, js2, je2, idif_p, jdif_p,
+                    jg2n, ig2n )
+  int_p
+    d_p          /* (I) RSL domain descriptor (input) */
+   ,p_p          /* (I) How many extra pad cells to include (0, 1, or 2) */
+   ,maxrun_p     /* (I) Number of elements in array arguments to this routine */
+   ,nl_p         /* (O) Nest level of the domain */
+   ,nrunj_p      /* (O) Number of runs through domain in j-major traversal */
+   ,nruni_p      /* (O) Number of runs through domain in i-minor traversal */
+   ,js           /* (OA) Local J-index of each run in j-major traversal */
+   ,is           /* (OA) Starting local I-index of each run in j-major traversal */
+   ,ie           /* (OA) Ending local I-index of each run in j-major traversal */
+   ,is2          /* (OA) Local I-index of each run in i-major traversal */
+   ,js2          /* (OA) Starting local J-index of each run in i-major traversal */
+   ,je2          /* (OA) Ending local J-index of each run in i-major traversal */
+   ,idif_p       /* (O) Difference between local and global I indices (i-ig). */
+   ,jdif_p       /* (O) Difference between local and global J indices (j-jg). */
+   ,jg2n         /* (OA) Number of run for a global J-index in j-major traversal. */
+   ,ig2n         /* (OA) Number of run for a global I-index in i-major traversal. */
+   ;
+{
+  int d, i, p ;
+  d = *d_p ;
+  p = *p_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_get_run_info: bad domain") ;
+  RSL_TEST_ERR( p < 0, "Negative pad arg for RSL_GET_RUN_INFOP") ;
+  if ( p > MAX_KINDPAD )
+  {
+    sprintf(mess,"RSL_GET_RUN_INFOP: pad arg (%d) larger than %d",p,MAX_KINDPAD) ;
+    RSL_TEST_ERR( 1,  mess ) ;
+  }
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+
+  *nl_p = domain_info[d].nest_level ;
+  *idif_p = domain_info[d].idif ;
+  *jdif_p = domain_info[d].jdif ;
+
+  *nrunj_p = domain_info[d].nrun[p] ;
+  if ( *maxrun_p < *nrunj_p )
+  {
+         *maxrun_p, *nrunj_p ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+
+/*****************/
+  if ( p <=2 )
+  {
+  for ( i = 0 ; i < MAX_RUNPAD-p ; i++ )
+  {
+    js[i] = 0 ;
+    is[i] = 0 ;
+    ie[i] = -1 ;
+  }
+  for ( i = 0 ; i < *nrunj_p ; i++ )
+  {
+    js[i+(MAX_RUNPAD-p)] = domain_info[d].js[p][i] ;
+    is[i+(MAX_RUNPAD-p)] = domain_info[d].is[p][i] ;
+    ie[i+(MAX_RUNPAD-p)] = domain_info[d].ie[p][i] ;
+  }
+  if ( jg2n != NULL )
+  {
+    for ( i = 0 ; i < domain_info[d].len_n ; i++ )
+    {
+      jg2n[i] = domain_info[d].jg2n[p][i] + MAX_RUNPAD-p;
+    }
+  }
+
+  *nruni_p = domain_info[d].nruni[p] ;
+  if ( *maxrun_p < *nruni_p )
+  {
+    sprintf(mess,
+     "rsl_get_run_info: would overwrite user arrays: maxrun (%d) < nruni (%d)",
+         *maxrun_p, *nruni_p ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  for ( i = 0 ; i < MAX_RUNPAD-p ; i++ )
+  {
+    is2[i] = 0 ;
+    js2[i] = 0 ;
+    je2[i] = -1 ;
+  }
+  for ( i = 0 ; i < *nruni_p ; i++ )
+  {
+    is2[i+(MAX_RUNPAD-p)] = domain_info[d].is2[p][i] ;
+    js2[i+(MAX_RUNPAD-p)] = domain_info[d].js2[p][i] ;
+    je2[i+(MAX_RUNPAD-p)] = domain_info[d].je2[p][i] ;
+  }
+  if ( ig2n != NULL )
+  {
+    for ( i = 0 ; i < domain_info[d].len_n ; i++ )
+    {
+      ig2n[i] = domain_info[d].ig2n[p][i] + MAX_RUNPAD-p;
+    }
+  }
+  }
+/*****************/
+/*****************/
+  else if ( p > 3 && p <= 4)
+  {
+  int p1 ;
+  p1 = 0 ;
+  for ( i = 0 ; i < MAX_RUNPAD-p1 ; i++ )
+  {
+    js[i] = 0 ;
+    is[i] = 0 ;
+    ie[i] = -1 ;
+  }
+  for ( i = 0 ; i < *nrunj_p ; i++ )
+  {
+    js[i+(MAX_RUNPAD-0)] = domain_info[d].js[p][i] ;
+    is[i+(MAX_RUNPAD-0)] = domain_info[d].is[p][i] ;
+    ie[i+(MAX_RUNPAD-0)] = domain_info[d].ie[p][i] ;
+  }
+  if ( jg2n != NULL )
+  {
+    for ( i = 0 ; i < domain_info[d].len_n ; i++ )
+    {
+      jg2n[i] = domain_info[d].jg2n[p][i] + MAX_RUNPAD-0;
+    }
+  }
+
+  *nruni_p = domain_info[d].nruni[p] ;
+  if ( *maxrun_p < *nruni_p )
+  {
+    sprintf(mess,
+     "rsl_get_run_info: would overwrite user arrays: maxrun (%d) < nruni (%d)",
+         *maxrun_p, *nruni_p ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  for ( i = 0 ; i < MAX_RUNPAD-0 ; i++ )
+  {
+    is2[i] = 0 ;
+    js2[i] = 0 ;
+    je2[i] = -1 ;
+  }
+  for ( i = 0 ; i < *nruni_p ; i++ )
+  {
+    is2[i+(MAX_RUNPAD-0)] = domain_info[d].is2[p][i] ;
+    js2[i+(MAX_RUNPAD-0)] = domain_info[d].js2[p][i] ;
+    je2[i+(MAX_RUNPAD-0)] = domain_info[d].je2[p][i] ;
+  }
+  if ( ig2n != NULL )
+  {
+    for ( i = 0 ; i < domain_info[d].len_n ; i++ )
+    {
+      ig2n[i] = domain_info[d].ig2n[p][i] + MAX_RUNPAD-0;
+    }
+  }
+  }
+/*****************/
+}
+
+RSL_REG_RUN_INFOP( d_p, p_p, maxrun_p, nl_p,
+		  is, ie,
+		  js, je,
+		  idif_p, jdif_p )
+  int_p
+    d_p          /* (I) RSL domain descriptor (input) */
+   ,p_p          /* (I) How many extra pad cells to include (0, 1, or 2) */
+   ,maxrun_p     /* (I) Number of elements in array arguments to this routine */
+   ,nl_p         /* (O) Nest level of the domain */
+   ,is
+   ,ie
+   ,js
+   ,je
+   ,idif_p
+   ,jdif_p ;
+{
+  int d, i, j, p, cnt ;
+  d = *d_p ;
+  p = *p_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_get_run_info: bad domain") ;
+  RSL_TEST_ERR( p < 0, "Negative pad arg for RSL_GET_RUN_INFOP") ;
+  if ( p > MAX_KINDPAD )
+  {
+    sprintf(mess,"RSL_GET_RUN_INFOP: pad arg (%d) larger than %d",p,MAX_KINDPAD)
+ ;
+    RSL_TEST_ERR( 1,  mess ) ;
+  }
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+  RSL_TEST_ERR( domain_info[*d_p].len_n > *maxrun_p,
+    "domain_info[*d_p].len_n > *maxrun_p") ;
+  RSL_TEST_ERR( domain_info[*d_p].len_m > *maxrun_p,
+    "domain_info[*d_p].len_m > *maxrun_p") ;
+
+  *nl_p = domain_info[d].nest_level ;
+  *idif_p = domain_info[d].idif ;
+  *jdif_p = domain_info[d].jdif ;
+
+/* in following code, note assumptions on order of traversal,
+   contiguity of points, and rectangularity of partitions */
+  /** js, je **/
+  for ( j=0, cnt=0 ; j < domain_info[*d_p].len_n ; j++ )
+  {
+    if ( j+1 < domain_info[d].js2[p][MAX_RUNPAD]-*jdif_p )
+    {
+      js[j]=domain_info[d].js2[p][MAX_RUNPAD] ;
+      je[j]=9999999 ;
+    }
+    else if ( j+1 > domain_info[d].je2[p][MAX_RUNPAD]-*jdif_p )
+    {
+      js[j]=9999999 ;
+      je[j]=domain_info[d].je2[p][MAX_RUNPAD] ;
+    }
+    else
+    {
+      js[j]=domain_info[d].js2[p][MAX_RUNPAD] + cnt ;
+      je[j]=domain_info[d].js2[p][MAX_RUNPAD] + cnt ;  /* yes -> js2 */
+      cnt++ ;
+    }
+  }
+  /** is, ie **/
+  for ( i=0, cnt=0 ; i < domain_info[*d_p].len_m ; i++ )
+  {
+    if ( i+1 < domain_info[d].is[p][MAX_RUNPAD]-*idif_p )
+    {
+      is[i]=domain_info[d].is[p][MAX_RUNPAD] ;
+      ie[i]=-9999999 ;
+    }
+    else if ( i+1 > domain_info[d].ie[p][MAX_RUNPAD]-*idif_p )
+    {
+      is[i]=9999999 ;
+      ie[i]=domain_info[d].ie[p][MAX_RUNPAD] ;
+    }
+    else
+    {
+      is[i]=domain_info[d].is[p][MAX_RUNPAD] + cnt ;
+      ie[i]=domain_info[d].is[p][MAX_RUNPAD] + cnt ;  /* yes -> is */
+      cnt++ ;
+    }
+       if ( rsl_debug_flg )
+       {
+       printf("is[%3d] = info[%d].is[%d] + cnt %3d = %d : ",i,d,p,cnt,is[i]);
+       printf("ie[%3d] = %d \n",i,d,p,cnt,ie[i]);
+       }
+  }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_world.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_world.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_world.c	(revision 2744)
@@ -0,0 +1,688 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_GET_RUN_INFO - get RSL information about size and shape local allocation.
+
+  Notes:
+  This routine is used to initialize loops over each processor's
+  local partition of the decomposed domain.  The routine can be used
+  directly, or RSL-provided macros may be used in the code that expand
+  to the proper calls.  Both M4 and CPP macros are provided in the 
+  RSL distribution (see LoopMacros).
+  The macro approach is recommended
+  for readability, simplicity,
+  and also to insulate the code from future potential updates in RSL.
+  Of the two sets, the M4 macros are recommended since they
+  are more flexible.
+
+  RSL returns through the arguments Arg6, Arg7, and Arg8 information
+  for iterating over the local processor partition N-major, M-minor.
+  Argument Arg4 is the number of iterations to cover the part of the
+  domain allocated to the processor.  Arg6 contains the
+  J-indices (Arg4 of them) of each I-strip local to the processor.
+  The first index into the local partition is stored at stored at Arg6(3).
+  The locations Arg6(1) and Arg6(2) are placeholders for indices
+  if one wishes to include one or two of the pad or ghost cells in
+  the iteration (see RSL_GET_INFOP).
+  Arg7 contains the starting and ending indices of each I-strip.  Likewise,
+  the first actual index in Arg7 is at Arg7(3).
+  The arguments Arg9, Arg10, and
+  Arg11 have the same sense as Arg6, Arg7, and Arg8, except that they
+  provide information for 
+  iteration in M-major, N-minor order.  Argument Arg5 is
+  the number of major iterations over M.
+  The arrays Arg6, Arg7, Arg8, Arg9, Arg10, and Arg11 store local (memory)
+  indices.  The logical (global) indices can be obtained by subtracting
+  Arg12 (for M-dimension indices) or Arg13 (for N-dimension indices).
+  
+  Unlike programs that are implemented in single address
+  spaces, the identical
+  relationship between logical and memory
+  indices does not hold for data-domain decomposition over distributed
+  memories.  That is, the memory index (the subscripts into a model
+  array) may not be used for testing proximity of the point to a
+  boundary in the logical domain.  Further, the relationship between
+  logical and memory indices differs on each processor.  The Arg12 and
+  Arg13 arguments are the differences between the local and global
+  indices in the M and N dimensions, respectively, and can be used by
+  the program for converting between logical and memory indices.  For
+  example, the local index I in the M dimension is equal to Arg12 plus
+  the global index IG.
+
+  All of these arrays -- Arg6, Arg7, Arg8, Arg9, Arg10, and Arg11 
+  are integers and must have been allocated by the user with size
+  large enough to fit the largest possible run through a dimension.
+  The argument Arg2 is the length of the arrays.
+  The integer Arg1 is an RSL domain descriptor.
+
+  The integer Arg3
+  is the nest level of the domain (mother domain is at nest-level 1),
+  which is not necessary for iteration over the domain but which 
+  is information that RSL has available and that is useful to have
+  at the beginning of a module.
+
+  Example:
+
+$  -- original code --
+
+$  subroutine F( ... )
+$  ...
+$  do j = 3, jl-2
+$    do i = 3, il-2
+$      a(i,j) = b(i,j) + c(i,j)
+$    enddo
+$  enddo
+
+$  -- example using M4 macros in LoopMacros.m4 --
+
+$  subroutine F( ... )
+$  RSL_RUN_DECL
+$  ...
+$  RSL_INIT_RUNVARS(d)              ! d is an RSL domain descriptor
+$  RSL_DO_N(j,3,jl-2)
+$    RSL_DO_M(i,3,il-2)
+$      a(i,j) = b(i,j) + c(i,j)
+$    RSL_ENDDO
+$  RSL_ENDDO
+
+$  -- example using CPP macros in LoopMacros.inc --
+
+$ #include "LoopMacros.cpp"
+$  subroutine F( ... )
+$  RSL_DECLARE_RUN_VARS 
+$  ...
+$  RSL_INIT_RUNS(d)                 ! d is an RSL domain descriptor
+$  RSL_MAJOR_BOUND(j,3,jl-2)
+$    RSL_MINOR_BOUND(j,3,jl-2)
+$      a(i,j) = b(i,j) + c(i,j)
+$    RSL_END_MINOR_LOOPB
+$  RSL_END_MAJOR_LOOPB
+
+$  -- example with macros expanded --
+
+$  subroutine F( ... )
+$  integer   ig,jg,nruni,nrunj,js,is,ie,is2,js2,je2,idif,jdif,nr
+$  dimension js(512)  ,is(512)  ,ie(512)    ! for N-major iteration
+$  dimension is2(512) ,js2(512) ,je2(512)   ! for M-major iteration
+$
+$  call rsl_get_run_info( d,     512,   nl,   nrunj,   nruni, 
+$ +                       js,    is,    ie,
+$ +                       js2,   is2,   ie2,
+$ +                       idif,  jdif                         )
+
+$  do nr = 3, nrun+2
+$    j=js(nr)
+$    jg=j-jdif
+$    if ( jg .ge. 3 .and. jg .le. maxj-2 ) then
+$      do i=is(nr),ie1(nr)
+$        ig=i-idif
+$        if ( ig .ge. 3 .and. ig .le. maxi-2 ) then
+$          a(i,j) = b(i,j) + c(i,j)
+$        endif
+$      enddo
+$    endif
+$  enddo
+
+BREAKTHEEXAMPLECODE
+
+  See also:
+  RSL_GET_RUN_INFOP, LoopMacros.m4
+
+@*/
+
+RSL_GET_RUN_INFO ( d_p, maxrun_p, nl_p, nrunj_p, nruni_p, js, is, ie, is2, js2, je2, idif_p, jdif_p )
+  int_p 
+    d_p          /* (I) RSL domain descriptor (input) */
+   ,maxrun_p     /* (I) Number of elements in array arguments to this routine */
+   ,nl_p         /* (O) Nest level of the domain */
+   ,nrunj_p      /* (O) Number of runs through domain in j-major traversal */
+   ,nruni_p ;    /* (O) Number of runs through domain in i-minor traversal */
+  int
+    js[]         /* (O) Local J-index of each run in j-major traversal */
+   ,is[]         /* (O) Starting local I-index of each run in j-major traversal */
+   ,ie[]         /* (O) Ending local I-index of each run in j-major traversal */
+   ,is2[]        /* (O) Local I-index of each run in i-major traversal */
+   ,js2[]        /* (O) Starting local J-index of each run in i-major traversal */
+   ,je2[] ;      /* (O) Ending local J-index of each run in i-major traversal */
+  int_p
+    idif_p       /* (O) Difference between local and global I indices (i-ig). */
+   ,jdif_p  ;    /* (O) Difference between local and global J indices (j-jg). */
+{
+  int x ;
+  int *dummy ;
+  x = 0 ;
+  dummy = NULL ;
+  RSL_GET_RUN_INFOP ( d_p, &x, maxrun_p, nl_p, nrunj_p, nruni_p,
+                      js, is, ie, is2, js2, je2, idif_p, jdif_p,
+                      dummy, dummy ) ;
+}
+
+/* additional P argument is the width of pad to allow for */
+/*@
+  RSL_GET_RUN_INFOP - get RSL information about size and shape local allocation.
+
+  Notes:
+  This routine is similar to RSL_GET_RUN_INFO except that it allows for
+  execution on the extended array pads of the local processor
+  subdomains.  This can be useful for trading off computation for
+  communication in the code and can simplify the implementation
+  by allowing fewer modifications for distributed memory
+  parallelism.  The argument Arg2 may be set to
+  for one of 3 modes of iteration over the local subdomain ---
+  Arg2 = 2 gives iteration over the local subdomain and the set of
+  ghost points that are two-away from points in the local subdomain,
+  Arg2 = 1 gives iteration over the local subdomain and the set of
+  ghost points that are one-away from points in the local subdomain, and
+  Arg2 = 0 gives iteration over just the local subdomain (no ghost points).
+  that are immediately adjacent to the local processor subdomain, or
+  the set that is within 2 cells of the local processor subdomain.  The
+  information for controlling iteration over the region is returned in
+  the arguments Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, and Arg12.
+
+  The M4 RSL loop macros automatically initialize 3 separate sets of
+  these data structures for the 3 available modes of iteration.
+
+  See also:
+  RSL_GET_RUN_INFO, LoopMacros.m4
+@*/
+RSL_GET_RUN_INFOP ( d_p, p_p, maxrun_p, nl_p, nrunj_p, nruni_p,
+                    js, is, ie, is2, js2, je2, idif_p, jdif_p,
+                    jg2n, ig2n )
+  int_p
+    d_p          /* (I) RSL domain descriptor (input) */
+   ,p_p          /* (I) How many extra pad cells to include (0, 1, or 2) */
+   ,maxrun_p     /* (I) Number of elements in array arguments to this routine */
+   ,nl_p         /* (O) Nest level of the domain */
+   ,nrunj_p      /* (O) Number of runs through domain in j-major traversal */
+   ,nruni_p      /* (O) Number of runs through domain in i-minor traversal */
+   ,js           /* (OA) Local J-index of each run in j-major traversal */
+   ,is           /* (OA) Starting local I-index of each run in j-major traversal */
+   ,ie           /* (OA) Ending local I-index of each run in j-major traversal */
+   ,is2          /* (OA) Local I-index of each run in i-major traversal */
+   ,js2          /* (OA) Starting local J-index of each run in i-major traversal */
+   ,je2          /* (OA) Ending local J-index of each run in i-major traversal */
+   ,idif_p       /* (O) Difference between local and global I indices (i-ig). */
+   ,jdif_p       /* (O) Difference between local and global J indices (j-jg). */
+   ,jg2n         /* (OA) Number of run for a global J-index in j-major traversal. */
+   ,ig2n         /* (OA) Number of run for a global I-index in i-major traversal. */
+   ;
+{
+  int d, i, p ;
+  d = *d_p ;
+  p = *p_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_get_run_info: bad domain") ;
+  RSL_TEST_ERR( p < 0, "Negative pad arg for RSL_GET_RUN_INFOP") ;
+  if ( p > MAX_KINDPAD )
+  {
+    sprintf(mess,"RSL_GET_RUN_INFOP: pad arg (%d) larger than %d",p,MAX_KINDPAD) ;
+    RSL_TEST_ERR( 1,  mess ) ;
+  }
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+
+  *nl_p = domain_info[d].nest_level ;
+  *idif_p = domain_info[d].idif ;
+  *jdif_p = domain_info[d].jdif ;
+
+  *nrunj_p = domain_info[d].nrun[p] ;
+  if ( *maxrun_p < *nrunj_p )
+  {
+    sprintf(mess,
+     "rsl_get_run_info: would overwrite user arrays: maxrun (%d) < nruni (%d)",
+         *maxrun_p, *nrunj_p ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+
+/*****************/
+  if ( p <= MAX_RUNPAD )
+  {
+  for ( i = 0 ; i < MAX_RUNPAD-p ; i++ )
+  {
+    js[i] = 0 ;
+    is[i] = 0 ;
+    ie[i] = -1 ;
+  }
+  for ( i = 0 ; i < *nrunj_p ; i++ )
+  {
+    js[i+(MAX_RUNPAD-p)] = domain_info[d].js[p][i] ;
+    is[i+(MAX_RUNPAD-p)] = domain_info[d].is[p][i] ;
+    ie[i+(MAX_RUNPAD-p)] = domain_info[d].ie[p][i] ;
+  }
+  if ( jg2n != NULL )
+  {
+    for ( i = 0 ; i < domain_info[d].len_n ; i++ )
+    {
+      jg2n[i] = domain_info[d].jg2n[p][i] + MAX_RUNPAD-p;
+    }
+  }
+
+  *nruni_p = domain_info[d].nruni[p] ;
+  if ( *maxrun_p < *nruni_p )
+  {
+    sprintf(mess,
+     "rsl_get_run_info: would overwrite user arrays: maxrun (%d) < nruni (%d)",
+         *maxrun_p, *nruni_p ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  for ( i = 0 ; i < MAX_RUNPAD-p ; i++ )
+  {
+    is2[i] = 0 ;
+    js2[i] = 0 ;
+    je2[i] = -1 ;
+  }
+  for ( i = 0 ; i < *nruni_p ; i++ )
+  {
+    is2[i+(MAX_RUNPAD-p)] = domain_info[d].is2[p][i] ;
+    js2[i+(MAX_RUNPAD-p)] = domain_info[d].js2[p][i] ;
+    je2[i+(MAX_RUNPAD-p)] = domain_info[d].je2[p][i] ;
+  }
+  if ( ig2n != NULL )
+  {
+    for ( i = 0 ; i < domain_info[d].len_n ; i++ )
+    {
+      ig2n[i] = domain_info[d].ig2n[p][i] + MAX_RUNPAD-p;
+    }
+  }
+  }
+/*****************/
+/*****************/
+  else if ( p > 3 && p <= 4)
+  {
+  int p1 ;
+  p1 = 0 ;
+  for ( i = 0 ; i < MAX_RUNPAD-p1 ; i++ )
+  {
+    js[i] = 0 ;
+    is[i] = 0 ;
+    ie[i] = -1 ;
+  }
+  for ( i = 0 ; i < *nrunj_p ; i++ )
+  {
+    js[i+(MAX_RUNPAD-0)] = domain_info[d].js[p][i] ;
+    is[i+(MAX_RUNPAD-0)] = domain_info[d].is[p][i] ;
+    ie[i+(MAX_RUNPAD-0)] = domain_info[d].ie[p][i] ;
+  }
+  if ( jg2n != NULL )
+  {
+    for ( i = 0 ; i < domain_info[d].len_n ; i++ )
+    {
+      jg2n[i] = domain_info[d].jg2n[p][i] + MAX_RUNPAD-0;
+    }
+  }
+
+  *nruni_p = domain_info[d].nruni[p] ;
+  if ( *maxrun_p < *nruni_p )
+  {
+    sprintf(mess,
+     "rsl_get_run_info: would overwrite user arrays: maxrun (%d) < nruni (%d)",
+         *maxrun_p, *nruni_p ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  for ( i = 0 ; i < MAX_RUNPAD-0 ; i++ )
+  {
+    is2[i] = 0 ;
+    js2[i] = 0 ;
+    je2[i] = -1 ;
+  }
+  for ( i = 0 ; i < *nruni_p ; i++ )
+  {
+    is2[i+(MAX_RUNPAD-0)] = domain_info[d].is2[p][i] ;
+    js2[i+(MAX_RUNPAD-0)] = domain_info[d].js2[p][i] ;
+    je2[i+(MAX_RUNPAD-0)] = domain_info[d].je2[p][i] ;
+  }
+  if ( ig2n != NULL )
+  {
+    for ( i = 0 ; i < domain_info[d].len_n ; i++ )
+    {
+      ig2n[i] = domain_info[d].ig2n[p][i] + MAX_RUNPAD-0;
+    }
+  }
+  }
+/*****************/
+}
+
+RSL_REG_RUN_INFOP ( d_p, p_p, maxrun_p, nl_p,
+		  is, ie,
+		  js, je,
+		  idif_p, jdif_p )
+  int_p
+    d_p          /* (I) RSL domain descriptor (input) */
+   ,p_p          /* (I) How many extra pad cells to include (0, 1, or 2) */
+   ,maxrun_p     /* (I) Number of elements in array arguments to this routine */
+   ,nl_p         /* (O) Nest level of the domain */
+   ,is
+   ,ie
+   ,js
+   ,je
+   ,idif_p
+   ,jdif_p ;
+{
+  int d, i, j, p, cnt ;
+  d = *d_p ;
+  p = *p_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_get_run_info: bad domain") ;
+  RSL_TEST_ERR( p < 0, "Negative pad arg for RSL_GET_RUN_INFOP") ;
+  if ( p > MAX_KINDPAD )
+  {
+    sprintf(mess,"RSL_GET_RUN_INFOP: pad arg (%d) larger than %d",p,MAX_KINDPAD)
+ ;
+    RSL_TEST_ERR( 1,  mess ) ;
+  }
+  RSL_TEST_ERR( ((! sw_allow_dynpad) && p > 4),
+   "Invalid to call RSL_REG_RUN_INFOP with p > 4 if RSL_ALLOW_DYNPAD has not been called.\n") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+  RSL_TEST_ERR( domain_info[*d_p].len_n > *maxrun_p,
+    "domain_info[*d_p].len_n > *maxrun_p") ;
+  RSL_TEST_ERR( domain_info[*d_p].len_m > *maxrun_p,
+    "domain_info[*d_p].len_m > *maxrun_p") ;
+
+  *nl_p = domain_info[d].nest_level ;
+  *idif_p = domain_info[d].idif ;
+  *jdif_p = domain_info[d].jdif ;
+
+#define WHICH_RUN 0
+/* in following code, note assumptions on order of traversal,
+   contiguity of points, and rectangularity of partitions */
+  /** js, je **/
+  for ( j=0, cnt=0 ; j < domain_info[*d_p].len_n ; j++ )
+  {
+    if ( j+1 < domain_info[d].js2[p][WHICH_RUN]-*jdif_p )
+    {
+      js[j]=domain_info[d].js2[p][WHICH_RUN] ;
+      je[j]=-9999999 ;
+    }
+    else if ( j+1 > domain_info[d].je2[p][WHICH_RUN]-*jdif_p )
+    {
+      js[j]=9999999 ;
+      je[j]=domain_info[d].je2[p][WHICH_RUN] ;
+    }
+    else
+    {
+      js[j]=domain_info[d].js2[p][WHICH_RUN] + cnt ;
+      je[j]=domain_info[d].js2[p][WHICH_RUN] + cnt ;  /* yes -> js2 */
+      cnt++ ;
+    }
+  }
+  /** is, ie **/
+  for ( i=0, cnt=0 ; i < domain_info[*d_p].len_m ; i++ )
+  {
+    if ( i+1 < domain_info[d].is[p][WHICH_RUN]-*idif_p )
+    {
+      is[i]=domain_info[d].is[p][WHICH_RUN] ;
+      ie[i]=-9999999 ;
+    }
+    else if ( i+1 > domain_info[d].ie[p][WHICH_RUN]-*idif_p )
+    {
+      is[i]=9999999 ;
+      ie[i]=domain_info[d].ie[p][WHICH_RUN] ;
+    }
+    else
+    {
+      is[i]=domain_info[d].is[p][WHICH_RUN] + cnt ;
+      ie[i]=domain_info[d].is[p][WHICH_RUN] + cnt ;  /* yes -> is */
+      cnt++ ;
+    }
+  }
+}
+
+RSL_DYNPAD_7    ( d_p, maxrun_p, nl_p,
+		  is, ie,
+		  js, je,
+		  idif_p, jdif_p )
+  int_p
+    d_p          /* (I) RSL domain descriptor (input) */
+   ,maxrun_p     /* (I) Number of elements in array arguments to this routine */
+   ,nl_p         /* (O) Nest level of the domain */
+   ,is          /* 2d arrays -- first index is array elements, second is runpad from 0..6 */
+   ,ie
+   ,js
+   ,je
+   ,idif_p
+   ,jdif_p ;
+{
+  int d, i, j, p, cnt ;
+  d = *d_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_get_run_info: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  RSL_TEST_ERR( ! sw_allow_dynpad, "RSL_DYNPAD_7 cannot be used unless RSL_ALLOW_DYNPAD has been called") ; 
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+  RSL_TEST_ERR( domain_info[*d_p].len_n > *maxrun_p,
+    "domain_info[*d_p].len_n > *maxrun_p") ;
+  RSL_TEST_ERR( domain_info[*d_p].len_m > *maxrun_p,
+    "domain_info[*d_p].len_m > *maxrun_p") ;
+
+  *nl_p = domain_info[d].nest_level ;
+  *idif_p = domain_info[d].idif ;
+  *jdif_p = domain_info[d].jdif ;
+
+  for ( p = 0 ; p <= 6 ; p++ )
+  {
+
+#define WHICH_RUN 0
+/* in following code, note assumptions on order of traversal,
+   contiguity of points, and rectangularity of partitions */
+  /** js, je **/
+  for ( j=0, cnt=0 ; j < domain_info[*d_p].len_n ; j++ )
+  {
+    if ( j+1 < domain_info[d].js2[p][WHICH_RUN]-*jdif_p )
+    {
+      js[j+*maxrun_p*p]=domain_info[d].js2[p][WHICH_RUN] ;
+      je[j+*maxrun_p*p]=-9999999 ;
+    }
+    else if ( j+1 > domain_info[d].je2[p][WHICH_RUN]-*jdif_p )
+    {
+      js[j+*maxrun_p*p]=9999999 ;
+      je[j+*maxrun_p*p]=domain_info[d].je2[p][WHICH_RUN] ;
+    }
+    else
+    {
+      js[j+*maxrun_p*p]=domain_info[d].js2[p][WHICH_RUN] + cnt ;
+      je[j+*maxrun_p*p]=domain_info[d].js2[p][WHICH_RUN] + cnt ;  /* yes -> js2 */
+      cnt++ ;
+    }
+  }
+  /** is, ie **/
+  for ( i=0, cnt=0 ; i < domain_info[*d_p].len_m ; i++ )
+  {
+    if ( i+1 < domain_info[d].is[p][WHICH_RUN]-*idif_p )
+    {
+      is[i+*maxrun_p*p]=domain_info[d].is[p][WHICH_RUN] ;
+      ie[i+*maxrun_p*p]=-9999999 ;
+    }
+    else if ( i+1 > domain_info[d].ie[p][WHICH_RUN]-*idif_p )
+    {
+      is[i+*maxrun_p*p]=9999999 ;
+      ie[i+*maxrun_p*p]=domain_info[d].ie[p][WHICH_RUN] ;
+    }
+    else
+    {
+      is[i+*maxrun_p*p]=domain_info[d].is[p][WHICH_RUN] + cnt ;
+      ie[i+*maxrun_p*p]=domain_info[d].is[p][WHICH_RUN] + cnt ;  /* yes -> is */
+      cnt++ ;
+    }
+  }
+  }
+}
+
+RSL_REG_PATCHINFO_MN ( d_p ,
+                       sp1  , ep1  , sp2  , ep2 ,  sp3  , ep3   )
+  int_p d_p ;
+  int_p sp1  , ep1  , sp2  , ep2 ,  sp3  , ep3 ;
+{
+  int d, i, j, k ;
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, "rsl_get_run_info: bad domain" ) ;
+  *sp1 = -1 ; *ep1 = -1 ;
+  *sp2 = -1 ; *ep2 = -1 ;
+  for ( j = 0 ; j < domain_info[d].len_n ; j++ )
+  {
+    for ( i = 0 ; i < domain_info[d].len_m ; i++ )
+    {
+      if ( rsl_c_comp2phys_proc(domain_info[d].domain[INDEX_2(j,i,domain_info[d].len_m)].P)==rsl_myproc)
+      {
+	if ( *sp1 < 0 ) *sp1 = i + 1 ;
+	*ep1 = i + 1 ;
+	if ( *sp2 < 0 ) *sp2 = j + 1 ;
+	*ep2 = j + 1 ;
+      }
+    }
+  }
+  *sp3 = 1 ;
+  *ep3 = domain_info[d].len_z ;
+}
+
+RSL_REG_PATCHINFO_MZ ( d_p ,
+                       sp1  , ep1  , sp2  , ep2 ,  sp3  , ep3   )
+  int_p d_p ;
+  int_p sp1  , ep1  , sp2  , ep2 ,  sp3  , ep3 ;
+{
+  int d, i, j, k ;
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, "rsl_get_run_info: bad domain" ) ;
+  *sp1 = -1 ; *ep1 = -1 ;
+  *sp3 = -1 ; *ep3 = -1 ;
+  for ( k = 0 ; k < domain_info[d].len_z ; k++ )
+  {
+    for ( i = 0 ; i < domain_info[d].len_m ; i++ )
+    {
+      if ( rsl_c_comp2phys_proc(domain_info[d].domain_mz[INDEX_2(k,i,domain_info[d].len_m)].P)==rsl_myproc)
+      {
+        if ( *sp1 < 0 ) *sp1 = i + 1 ;
+        *ep1 = i + 1 ;
+        if ( *sp3 < 0 ) *sp3 = k + 1 ;
+        *ep3 = k + 1 ;
+      }
+    }
+  }
+  *sp2 = 1 ;
+  *ep2 = domain_info[d].len_n ;
+}
+
+RSL_REG_PATCHINFO_NZ ( d_p ,
+                       sp1  , ep1  , sp2  , ep2 ,  sp3  , ep3   )
+  int_p d_p ;
+  int_p sp1  , ep1  , sp2  , ep2 ,  sp3  , ep3 ;
+{
+  int d, i, j, k ;
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, "rsl_get_run_info: bad domain" ) ;
+  *sp2 = -1 ; *ep2 = -1 ;
+  *sp3 = -1 ; *ep3 = -1 ;
+  for ( k = 0 ; k < domain_info[d].len_z ; k++ )
+  {
+    for ( j = 0 ; j < domain_info[d].len_n ; j++ )
+    {
+      if ( rsl_c_comp2phys_proc(domain_info[d].domain_nz[INDEX_2(k,j,domain_info[d].len_n)].P)==rsl_myproc)
+      {
+        if ( *sp2 < 0 ) *sp2 = j + 1 ;
+        *ep2 = j + 1 ;
+        if ( *sp3 < 0 ) *sp3 = k + 1 ;
+        *ep3 = k + 1 ;
+      }
+    }
+  }
+  *sp1 = 1 ;
+  *ep1 = domain_info[d].len_m ;
+}
+
+RSL_GET_GLEN ( d_p , mlen_p , nlen_p , zlen_p )
+  int_p d_p, mlen_p, nlen_p, zlen_p ;
+{
+  rsl_domain_info_t *dinfo ;
+  int d ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_get_get_glen: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_get_glen: invalid domain") ;
+
+  dinfo = &(domain_info[d]) ;
+  *mlen_p = dinfo->len_m ;
+  *nlen_p = dinfo->len_n ;
+  *zlen_p = dinfo->len_z ;
+  return(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_xpose.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_xpose.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/comp_xpose.c	(revision 2744)
@@ -0,0 +1,858 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* The mechanism here is similar to and patterned after that used by the
+   stencil mechanism: see comp_sten.c */
+
+
+/* this is used internally only -- this will be called automatically
+   whenever a xpose is attempted that has not
+   yet been compiled */
+rsl_compile_xpose( d_p, x_p )
+  int_p d_p, x_p ;
+{
+  int d, x ;
+  xpose_desc_t * xp ;
+  int i, j, ig, jg, kg, k, js, je, is, ie, ks, ke  ;
+  int len_plist ;
+  rsl_domain_info_t *dp ;
+  rsl_point_t  *pt ;
+  rsl_dimlen_t mlen, nlen, zlen ;
+  rsl_fldspec_t * fld ;
+  message_desc_t *msg_from, *msg_to ;
+  rsl_procrec_t *procrec ;
+  int m, n, dir ;
+  rsl_processor_t P, Plist[RSL_MAXPROC], sendP, recvP, prevP ;
+  int elemsz, t0, t1 ;
+  int ipack ;
+  void *base ;
+
+  d = *d_p ;
+  x = *x_p ;
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "rsl_compile_xpose: bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID, 
+        "rsl_compile_xpose: descriptor for invalid domain" ) ;
+
+  mlen = domain_info[d].len_m ;
+  nlen = domain_info[d].len_n ;
+  zlen = domain_info[d].len_z ;
+
+  RSL_TEST_ERR( x <= 0 || x > RSL_MAXDESCRIPTORS,
+        "rsl_compile_xpose: bad xpose descriptor" ) ;
+  RSL_TEST_ERR((xp = (xpose_desc_t *)xp_descriptors[x]) == NULL,
+        "rsl_compile_xpose: null xpose descriptor" ) ;
+  RSL_TEST_ERR( xp->tag != XPOSE_DESC,
+        "rsl_compile_xpose: bad xpose descriptor" ) ;
+  RSL_TEST_ERR( xp->compiled[d] != 0,
+        "rsl_compile_xpose: xpose has already been compiled for this domain") ;
+
+  xp->compiled[d] = 1 ;
+
+  dp = &(domain_info[d]) ;
+  if ( dp->decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+
+/************* MN to MZ *************/
+
+  msg_from = xp->msgs_mn[d] ; 
+  msg_to   = xp->msgs_mz[d] ;
+
+
+/* first pass builds the procrec list, second pass traverses it */
+/* this is necessary because the process_refs mechanism can only */
+/* build one set of pack or unpack lists at a time */
+/* ipack = 0 packing on sender ; ipack = 1, unpacking on receiver */
+
+    xp->procs[d][XPOSE_MN_MZ] = NULL ;
+    ipack = 0 ;
+    for ( P = 0 ; P < rsl_nproc_all ; P++ )
+    {
+      procrec = RSL_MALLOC( rsl_procrec_t, 1 ) ;
+      procrec->P = P ;
+
+      init_process_refs() ;
+
+/***/ for ( k = 0 ; k < zlen ; k++ )
+      {
+/***/   for ( ig = 0 ; ig < mlen ; ig++ )
+        {
+         recvP = domain_info[*d_p].domain_mz[INDEX_2(k,ig,mlen)].P ;
+         if ( ipack == 0 || rsl_c_comp2phys_proc(recvP) != rsl_myproc )
+         {
+          js = 0 - domain_info[d].jlocaloffset ; je = -1 ;
+          prevP = domain_info[*d_p].domain[INDEX_2(0,ig,mlen)].P ;
+#if 0
+fprintf(stderr,"set js to %d\n",js) ;
+fprintf(stderr,"set prevP to %d\n",prevP) ;
+#endif
+/***/     for ( jg = 0 ; jg < nlen ; jg++ ) 
+          {
+	    sendP = domain_info[*d_p].domain[INDEX_2(jg,ig,mlen)].P ;
+	    if ( jg == nlen-1 ) 
+              { sendP = -1 ; je++ ;}
+            i = ig - domain_info[d].ilocaloffset ;
+            j = jg - domain_info[d].jlocaloffset ;
+#if 0
+if ( k==0) fprintf(stderr,"P %d sendP %d prevP %d js %d je %d\n",P,sendP,prevP, js,je) ;
+#endif
+	    if ((ipack == 0) && (sendP != prevP ))
+	    {
+	      if ( rsl_c_comp2phys_proc(prevP) == rsl_myproc && recvP == P )
+	      {
+	        if ( jg > 0 )
+	        {
+	          /* store the pencil (ig,k,js:je) as being sent 
+	             from sendP and received by recvP */
+  
+                  if ( ipack == 0 ) { fld = msg_from->fldspecs ; }
+                  else              { fld = msg_to->fldspecs ; }
+  
+                  for ( ; fld != NULL ;  fld = fld->next )
+                  {
+                    if ( fld->type >= 100 ) xp->has_f90_fields = 1 ;
+                    base = fld->base ;
+                    elemsz = fld->elemsz ;
+                    switch (fld->strategy)
+                    {
+                      case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_r^: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d js %2d je %2d je-js+1 %3d\n",P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,js,je,je-js+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (i+js*t0+k*t1)*elemsz, elemsz,
+                                                  je-js+1 ,
+                                                  -t0*elemsz) ;
+                        break ;
+                      case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (js+i*t0+k*t1)*elemsz, (je-js+1)*elemsz,
+                                                  1 ,
+                                                  -elemsz) ;
+                        break ;
+                      case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (k+i*t0+js*t1)*elemsz, elemsz,
+                                                  je-js+1, 
+						  -t1*elemsz) ;
+                        break ;
+                      case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_r^: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d js %2d je %2d je-js+1 %3d\n",P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,js,je,je-js+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (i+k*t0+js*t1)*elemsz, elemsz,
+                                                  je-js+1,
+						  -t1*elemsz) ;  /* don't need to suppress packing optimization on MN grid because of pads */
+                        break ;
+                      default:
+                        RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+                        break ;
+                    }
+                  }
+	        }
+	      }
+#if 0
+fprintf(stderr,"resetting js to %d\n",j) ;
+#endif
+	      js = j ;
+	    }
+	    je = j ;
+#if 0
+fprintf(stderr,"resetting je to %d\n",je) ;
+#endif
+	    prevP = sendP ;
+#if 0
+fprintf(stderr,"resset prevP to %d\n",prevP) ;
+#endif
+          }
+         }
+        }
+      }
+        process_refs( &(procrec->pack_table),
+                      &(procrec->pack_table_size),
+                      &(procrec->pack_table_nbytes), 1 ) ;
+
+#if 0
+        fprintf(stderr,"pack P = %3d:\n",procrec->P ) ;
+        show_pack_table( procrec->pack_table,
+                         procrec->pack_table_size,
+                         procrec->pack_table_nbytes ) ;
+#endif
+
+        procrec->next = xp->procs[d][XPOSE_MN_MZ] ;
+        xp->procs[d][XPOSE_MN_MZ] = procrec ;
+    }
+
+/* unpacking loop */
+
+    ipack = 1 ;
+    for ( procrec = xp->procs[d][XPOSE_MN_MZ] ; procrec != NULL ; procrec = procrec->next )
+    {
+      P = procrec->P ;
+      init_process_refs() ;
+
+/***/ for ( kg = 0 ; kg < zlen ; kg++ )
+      {
+/***/   for ( ig = 0 ; ig < mlen ; ig++ )
+        {
+         recvP = domain_info[*d_p].domain_mz[INDEX_2(kg,ig,mlen)].P ;
+
+          js = 0 - domain_info[d].jlocaloffset_mz ; je = -1 ;
+
+          prevP = domain_info[*d_p].domain[INDEX_2(0,ig,mlen)].P ;
+/***/     for ( jg = 0 ; jg < nlen ; jg++ ) 
+          {
+	    sendP = domain_info[*d_p].domain[INDEX_2(jg,ig,mlen)].P ;
+	    if ( jg == nlen-1 ) 
+              { sendP = -1 ; je++ ;}
+
+            i = ig - domain_info[d].ilocaloffset_mz ;
+            j = jg - domain_info[d].jlocaloffset_mz ;
+            k = kg - domain_info[d].klocaloffset_mz ;
+
+	    if (sendP != prevP )
+	    {
+#if 0
+fprintf(stderr,"sendP (%2d) != prevP (%d) =? P (%d) ||  recvP (%d) =? rsl_myproc (%d)\n",
+sendP,prevP,P,recvP,rsl_myproc) ;
+#endif
+ 	      if ( rsl_c_comp2phys_proc(prevP) == P && recvP == rsl_myproc )
+	      {
+	        if ( jg > 0 )
+	        {
+	          /* store the pencil (ig,k,js:je) as being sent 
+	             from sendP and received by recvP */
+    
+                  if ( ipack == 0 ) { fld = msg_from->fldspecs ; }
+                  else              { fld = msg_to->fldspecs ; }
+    
+                  for ( ; fld != NULL ;  fld = fld->next )
+                  {
+                    if ( fld->type >= 100 ) xp->has_f90_fields = 1 ;
+                    base = fld->base ;
+                    elemsz = fld->elemsz ;
+                    switch (fld->strategy)
+                    {
+                      case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_rv: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d js %2d je %2d je-js+1 %3d\n",
+P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,js,je,je-js+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (i+js*t0+k*t1)*elemsz, elemsz,
+                                                  je-js+1 ,
+                                                  -t0*elemsz) ;
+                        break ;
+                      case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (js+i*t0+k*t1)*elemsz, (je-js+1)*elemsz,
+                                                  1 ,
+                                                  -elemsz) ;
+                        break ;
+                      case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (k+i*t0+js*t1)*elemsz, elemsz,
+                                                  je-js+1, 
+						  -t1*elemsz) ;
+                        break ;
+                      case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_rv: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d js %2d je %2d je-js+1 %3d ofst %3d\n",
+P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,js,je,je-js+1, (i+k*t0+js*t1)*elemsz) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (i+k*t0+js*t1)*elemsz, elemsz,
+                                                  je-js+1, 
+						  -t1*elemsz) ;   /* negative stride suppresses some unpacking collapses */
+                        break ;
+                      default:
+                        RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+                        break ;
+                    }
+                  }
+	        }
+	      }
+#if 0
+fprintf(stderr,"resetting js to %d\n",j) ;
+#endif
+	      js = j ;
+	    }
+	    je = j ;
+#if 0
+fprintf(stderr,"resetting je to %d\n",je) ;
+#endif
+	    prevP = sendP ;
+#if 0
+fprintf(stderr,"resset prevP to %d\n",prevP) ;
+#endif
+          }
+        }
+      }
+        process_refs( &(procrec->unpack_table),
+                      &(procrec->unpack_table_size),
+                      &(procrec->unpack_table_nbytes), 1 ) ;
+#if 0
+        fprintf(stderr,"unpack P = %3d:\n",procrec->P ) ;
+        show_pack_table( procrec->unpack_table,
+                         procrec->unpack_table_size,
+                         procrec->unpack_table_nbytes ) ;
+#endif
+
+    }
+
+/************* MZ to NZ *************/
+
+  msg_from = xp->msgs_mz[d] ; 
+  msg_to   = xp->msgs_nz[d] ;
+
+
+/* first pass builds the procrec list, second pass traverses it */
+/* this is necessary because the process_refs mechanism can only */
+/* build one set of pack or unpack lists at a time */
+/* ipack = 0 packing on sender ; ipack = 1, unpacking on receiver */
+
+   ipack = 0  ;
+    xp->procs[d][XPOSE_MZ_NZ] = NULL ;
+    ipack = 0 ;
+    for ( P = 0 ; P < rsl_nproc_all ; P++ )
+    {
+      procrec = RSL_MALLOC( rsl_procrec_t, 1 ) ;
+      procrec->P = P ;
+
+      init_process_refs() ;
+
+/***/ for ( jg = 0 ; jg < nlen ; jg++ )
+      {
+/***/   for ( kg = 0 ; kg < zlen ; kg++ )
+        {
+         recvP = domain_info[*d_p].domain_nz[INDEX_2(kg,jg,nlen)].P ;
+         if ( ipack == 0 || rsl_c_comp2phys_proc(recvP) != rsl_myproc )
+         {
+          is = 0 - domain_info[d].ilocaloffset_mz ; ie = -1 ;
+          prevP = domain_info[*d_p].domain_mz[INDEX_2(kg,0,mlen)].P ;
+#if 0
+fprintf(stderr,"set is to %d\n",is) ;
+fprintf(stderr,"set prevP to %d\n",prevP) ;
+#endif
+/***/     for ( ig = 0 ; ig < mlen ; ig++ ) 
+          {
+	    sendP = domain_info[*d_p].domain_mz[INDEX_2(kg,ig,mlen)].P ;
+	    if ( ig == mlen-1 ) 
+              { sendP = -1 ; ie++ ;}
+            i = ig - domain_info[d].ilocaloffset_mz ;
+            j = jg - domain_info[d].jlocaloffset_mz ;
+            k = kg - domain_info[d].klocaloffset_mz ;
+#if 0
+if ( k==0) fprintf(stderr,"P %d sendP %d prevP %d js %d je %d\n",P,sendP,prevP, is,ie) ;
+#endif
+	    if (sendP != prevP )
+	    {
+	      if ( rsl_c_comp2phys_proc(prevP) == rsl_myproc && recvP == P )
+	      {
+	        if ( ig > 0 )
+	        {
+	          /* store the pencil (is:ie,k,jg) as being sent 
+	             from sendP and received by recvP */
+  
+                  fld = msg_from->fldspecs ;
+  
+                  for ( ; fld != NULL ;  fld = fld->next )
+                  {
+                    if ( fld->type >= 100 ) xp->has_f90_fields = 1 ;
+                    base = fld->base ;
+                    elemsz = fld->elemsz ;
+                    switch (fld->strategy)
+                    {
+                      case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_r^: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d is %2d ie %2d ie-is+1 %3d\n",P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,is,ie,ie-is+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (is+j*t0+k*t1)*elemsz, (ie-is+1)*elemsz,
+                                                  1 ,
+                                                  -elemsz) ;
+                        break ;
+                      case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (j+is*t0+k*t1)*elemsz, elemsz,
+                                                  (ie-is+1) ,
+                                                  -t0*elemsz) ;
+                        break ;
+                      case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (k+is*t0+j*t1)*elemsz, elemsz,
+                                                  ie-is+1,
+                                                  -t0*elemsz) ;
+                        break ;
+                      case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_r^: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d is %2d ie %2d ie-is+1 %3d\n",P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,is,ie,ie-is+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (is+k*t0+j*t1)*elemsz, (ie-is+1)*elemsz,
+                                                  1,
+						  -elemsz) ;   /* negative stride suppresses some packing optimzation in process_refs */
+                        break ;
+                      default:
+                        RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+                        break ;
+                    }
+                  }
+	        }
+	      }
+#if 0
+fprintf(stderr,"resetting is to %d\n",j) ;
+#endif
+	      is = i ;
+	    }
+	    ie = i ;
+#if 0
+fprintf(stderr,"resetting ie to %d\n",ie) ;
+#endif
+	    prevP = sendP ;
+#if 0
+fprintf(stderr,"resset prevP to %d\n",prevP) ;
+#endif
+          }
+         }
+        }
+      }
+        process_refs( &(procrec->pack_table),
+                      &(procrec->pack_table_size),
+                      &(procrec->pack_table_nbytes), 1 ) ;
+
+#if 0
+        fprintf(stderr,"pack P = %3d:\n",procrec->P ) ;
+        show_pack_table( procrec->pack_table,
+                         procrec->pack_table_size,
+                         procrec->pack_table_nbytes ) ;
+#endif
+
+        procrec->next = xp->procs[d][XPOSE_MZ_NZ] ;
+        xp->procs[d][XPOSE_MZ_NZ] = procrec ;
+    }
+
+/* unpacking loop */
+
+    ipack = 1 ;
+    for ( procrec = xp->procs[d][XPOSE_MZ_NZ] ; procrec != NULL ; procrec = procrec->next )
+    {
+      P = procrec->P ;
+      init_process_refs() ;
+
+/***/ for ( jg = 0 ; jg < nlen ; jg++ )
+      {
+/***/   for ( kg = 0 ; kg < zlen ; kg++ )
+        {
+         recvP = domain_info[*d_p].domain_nz[INDEX_2(kg,jg,nlen)].P ;
+          is = 0 - domain_info[d].ilocaloffset_nz ; ie = -1 ;
+          prevP = domain_info[*d_p].domain_mz[INDEX_2(kg,0,mlen)].P ;
+/***/     for ( ig = 0 ; ig < mlen ; ig++ ) 
+          {
+	    sendP = domain_info[*d_p].domain_mz[INDEX_2(kg,ig,mlen)].P ;
+	    if ( ig == mlen-1 ) 
+              { sendP = -1 ; ie++ ;}
+
+            i = ig - domain_info[d].ilocaloffset_nz ;
+            j = jg - domain_info[d].jlocaloffset_nz ;
+            k = kg - domain_info[d].klocaloffset_nz ;
+
+	    if (sendP != prevP )
+	    {
+#if 0
+fprintf(stderr,"sendP (%2d) != prevP (%d) =? P (%d) ||  recvP (%d) =? rsl_myproc (%d)\n",
+sendP,prevP,P,recvP,rsl_myproc) ;
+#endif
+ 	      if ( rsl_c_comp2phys_proc(prevP) == P && recvP == rsl_myproc )
+	      {
+	        if ( ig > 0 )
+	        {
+	          /* store the pencil (is:ie,k,jg) as being sent 
+	             from sendP and received by recvP */
+    
+                  fld = msg_to->fldspecs ;
+    
+                  for ( ; fld != NULL ;  fld = fld->next )
+                  {
+                    if ( fld->type >= 100 ) xp->has_f90_fields = 1 ;
+                    base = fld->base ;
+                    elemsz = fld->elemsz ;
+                    switch (fld->strategy)
+                    {
+                      case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_rv: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d is %2d ie %2d ie-is+1 %3d\n",
+P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,is,ie,ie-is+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (is+j*t0+k*t1)*elemsz, (ie-is+1)*elemsz,
+                                                  1 ,
+                                                  -elemsz) ;
+                        break ;
+                      case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (j+is*t0+k*t1)*elemsz, elemsz,
+                                                  ie-is+1 ,
+                                                  -t0*elemsz) ;
+                        break ;
+                      case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (k+is*t0+j*t1)*elemsz, elemsz,
+                                                  ie-is+1,
+						  -t0*elemsz) ;
+                        break ;
+                      case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_rv: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d is %2d ie %2d ie-is+1 %3d\n",
+P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,is,ie,ie-is+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (is+k*t0+j*t1)*elemsz, (ie-is+1)*elemsz,
+                                                  1,
+						  -elemsz) ;  /* negative stride suppresses some unpacking optimization in process_refs */
+                        break ;
+                      default:
+                        RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+                        break ;
+                    }
+                  }
+	        }
+	      }
+#if 0
+fprintf(stderr,"resetting is to %d\n",i) ;
+#endif
+	      is = i ;
+	    }
+	    ie = i ;
+#if 0
+fprintf(stderr,"resetting je to %d\n",je) ;
+#endif
+	    prevP = sendP ;
+#if 0
+fprintf(stderr,"resset prevP to %d\n",prevP) ;
+#endif
+          }
+        }
+      }
+        process_refs( &(procrec->unpack_table),
+                      &(procrec->unpack_table_size),
+                      &(procrec->unpack_table_nbytes), 1 ) ;
+#if 0
+        fprintf(stderr,"unpack P = %3d:\n",procrec->P ) ;
+        show_pack_table( procrec->unpack_table,
+                         procrec->unpack_table_size,
+                         procrec->unpack_table_nbytes ) ;
+#endif
+
+    }
+
+/************* NZ to MN *************/
+ /* (may the circle be unbroken) */
+
+  msg_from = xp->msgs_nz[d] ; 
+  msg_to   = xp->msgs_mn[d] ;
+
+/* first pass builds the procrec list, second pass traverses it */
+/* this is necessary because the process_refs mechanism can only */
+/* build one set of pack or unpack lists at a time */
+/* ipack = 0 packing on sender ; ipack = 1, unpacking on receiver */
+
+   ipack = 0  ;
+    xp->procs[d][XPOSE_NZ_MN] = NULL ;
+    ipack = 0 ;
+    for ( P = 0 ; P < rsl_nproc_all ; P++ )
+    {
+      procrec = RSL_MALLOC( rsl_procrec_t, 1 ) ;
+      procrec->P = P ;
+
+      init_process_refs() ;
+
+/***/ for ( jg = 0 ; jg < nlen ; jg++ )
+      {
+/***/   for ( ig = 0 ; ig < mlen ; ig++ ) 
+        {
+         recvP = domain_info[*d_p].domain[INDEX_2(jg,ig,mlen)].P ;
+         if ( ipack == 0 || rsl_c_comp2phys_proc(recvP) != rsl_myproc )
+         {
+          ks = 0 - domain_info[d].klocaloffset_nz ; ke = -1 ;
+          prevP = domain_info[*d_p].domain_nz[INDEX_2(0,jg,nlen)].P ;
+#if 0
+fprintf(stderr,"set ks to %d\n",ks) ;
+fprintf(stderr,"set prevP to %d\n",prevP) ;
+#endif
+/***/     for ( kg = 0 ; kg < zlen ; kg++ )
+          {
+	    sendP = domain_info[*d_p].domain_nz[INDEX_2(kg,jg,nlen)].P ;
+	    if ( kg == zlen-1 ) 
+              { sendP = -1 ; ke++ ;}
+            i = ig - domain_info[d].ilocaloffset_nz ;
+            j = jg - domain_info[d].jlocaloffset_nz ;
+            k = kg - domain_info[d].klocaloffset_nz ;
+#if 0
+if ( k==0) fprintf(stderr,"P %d sendP %d prevP %d ks %d ke %d\n",P,sendP,prevP, ks,ke) ;
+#endif
+	    if (sendP != prevP )
+	    {
+	      if ( rsl_c_comp2phys_proc(prevP) == rsl_myproc && recvP == P )
+	      {
+	        if ( kg > 0 )
+	        {
+	          /* store the pencil (ig,ks:ke,jg) as being sent 
+	             from sendP and received by recvP */
+  
+                  fld = msg_from->fldspecs ;
+  
+                  for ( ; fld != NULL ;  fld = fld->next )
+                  {
+                    if ( fld->type >= 100 ) xp->has_f90_fields = 1 ;
+                    base = fld->base ;
+                    elemsz = fld->elemsz ;
+                    switch (fld->strategy)
+                    {
+                      case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_r^: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d ks %2d ke %2d ke-ks+1 %3d\n",P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,ks,ke,ke-ks+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (i+j*t0+ks*t1)*elemsz, elemsz,
+                                                  ke-ks+1 ,
+                                                  -t1*elemsz) ;
+                        break ;
+                      case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (j+i*t0+ks*t1)*elemsz, elemsz,
+                                                  ke-ks+1 ,
+                                                  -t1*elemsz) ;
+                        break ;
+                      case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (ks+i*t0+j*t1)*elemsz, (ke-ks+1)*elemsz,
+                                                  1, 
+						  -elemsz) ;
+                        break ;
+                      case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"MZ to MN s_p_r^: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d ks %2d ke %2d ke-ks+1 %3d\n",P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,ks,ke,ke-ks+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (i+ks*t0+j*t1)*elemsz, elemsz,
+                                                  ke-ks+1,
+						  -t0*elemsz) ;  /* negative stride suppresses some packing optimizationin process_refs */
+                        break ;
+                      default:
+                        RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+                        break ;
+                    }
+                  }
+	        }
+	      }
+#if 0
+fprintf(stderr,"resetting ks to %d\n",k) ;
+#endif
+	      ks = k ;
+	    }
+	    ke = k ;
+#if 0
+fprintf(stderr,"resetting ke to %d\n",ke) ;
+#endif
+	    prevP = sendP ;
+#if 0
+fprintf(stderr,"resset prevP to %d\n",prevP) ;
+#endif
+          }
+         }
+        }
+      }
+        process_refs( &(procrec->pack_table),
+                      &(procrec->pack_table_size),
+                      &(procrec->pack_table_nbytes), 1 ) ;
+
+#if 0
+        fprintf(stderr,"pack P = %3d:\n",procrec->P ) ;
+        show_pack_table( procrec->pack_table,
+                         procrec->pack_table_size,
+                         procrec->pack_table_nbytes ) ;
+#endif
+
+        procrec->next = xp->procs[d][XPOSE_NZ_MN] ;
+        xp->procs[d][XPOSE_NZ_MN] = procrec ;
+    }
+
+/* unpacking loop */
+
+    ipack = 1 ;
+    for ( procrec = xp->procs[d][XPOSE_NZ_MN] ; procrec != NULL ; procrec = procrec->next )
+    {
+      P = procrec->P ;
+      init_process_refs() ;
+
+/***/ for ( jg = 0 ; jg < nlen ; jg++ )
+      {
+/***/   for ( ig = 0 ; ig < mlen ; ig++ ) 
+        {
+         recvP = domain_info[*d_p].domain[INDEX_2(jg,ig,mlen)].P ;
+          ks = 0                               ; ke = -1 ;
+          prevP = domain_info[*d_p].domain_nz[INDEX_2(0,jg,nlen)].P ;
+/***/     for ( kg = 0 ; kg < zlen ; kg++ )
+          {
+	    sendP = domain_info[*d_p].domain_nz[INDEX_2(kg,jg,nlen)].P ;
+	    if ( kg == zlen-1 ) 
+              { sendP = -1 ; ke++ ;}
+
+            i = ig - domain_info[d].ilocaloffset ;
+            j = jg - domain_info[d].jlocaloffset ;
+            k = kg ;
+
+	    if (sendP != prevP )
+	    {
+#if 0
+fprintf(stderr,"sendP (%2d) != prevP (%d) =? P (%d) ||  recvP (%d) =? rsl_myproc (%d)\n",
+sendP,prevP,P,recvP,rsl_myproc) ;
+#endif
+ 	      if ( rsl_c_comp2phys_proc(prevP) == P && recvP == rsl_myproc )
+	      {
+	        if ( kg > 0 )
+	        {
+	          /* store the pencil (i,ks:ke,jg) as being sent 
+	             from sendP and received by recvP */
+    
+                  fld = msg_to->fldspecs ;
+    
+                  for ( ; fld != NULL ;  fld = fld->next )
+                  {
+                    if ( fld->type >= 100 ) xp->has_f90_fields = 1 ;
+                    base = fld->base ;
+                    elemsz = fld->elemsz ;
+                    switch (fld->strategy)
+                    {
+                      case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"s_p_rv: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d ks %2d ke %2d ke-ks+1 %3d\n",
+P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,ks,ke,ke-ks+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (i+j*t0+ks*t1)*elemsz, elemsz,
+                                                  ke-ks+1 ,
+                                                  -t1*elemsz) ;
+                        break ;
+                      case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (j+i*t0+ks*t1)*elemsz, elemsz,
+                                                  ke-ks+1 ,
+                                                  -t1*elemsz) ;
+                        break ;
+                      case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+                        store_process_refs( base, fld->f90_table_index, (ks+i*t0+j*t1)*elemsz, (ke-ks+1)*elemsz,
+                                                  1, 
+						  -elemsz) ;
+                        break ;
+                      case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
+                        t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
+#if 0
+if (1)fprintf(stderr,"MZ to MN s_p_rv: P %2d prevP %2d recvP %2d ipack %d i %2d j %2d k %2d ig %2d jg %2d t0 %3d t1 %3d ks %2d ke %2d ke-ks+1 %3d\n",
+P,prevP,recvP,ipack,i,j,k,ig,jg,t0,t1,ks,ke,ke-ks+1) ;
+#endif
+                        store_process_refs( base, fld->f90_table_index, (i+ks*t0+j*t1)*elemsz, elemsz,
+                                                  ke-ks+1,
+						  -t0*elemsz) ;   /* don't need to suppress optimizations unpacking onto MN grid because of pads */
+                        break ;
+                      default:
+                        RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
+                        break ;
+                    }
+                  }
+	        }
+	      }
+#if 0
+fprintf(stderr,"resetting ks to %d\n",k) ;
+#endif
+	      ks = k ;
+	    }
+	    ke = k ;
+#if 0
+fprintf(stderr,"resetting ke to %d\n",ke) ;
+#endif
+	    prevP = sendP ;
+#if 0
+fprintf(stderr,"resset prevP to %d\n",prevP) ;
+#endif
+          }
+        }
+      }
+        process_refs( &(procrec->unpack_table),
+                      &(procrec->unpack_table_size),
+                      &(procrec->unpack_table_nbytes), 1 ) ;
+#if 0
+        fprintf(stderr,"unpack P = %3d:\n",procrec->P ) ;
+        show_pack_table( procrec->unpack_table,
+                         procrec->unpack_table_size,
+                         procrec->unpack_table_nbytes ) ;
+#endif
+
+    }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/compat.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/compat.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/compat.h	(revision 2744)
@@ -0,0 +1,695 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+
+
+#ifndef COMPAT_H
+#define COMPAT_H
+
+/* 
+   Note that when using these macros, you *HAVE* to leave a space
+   between the routine name and its argument list.  Example:
+
+	 RSL_C_COMPUTE_PROC (P)
+
+   This applies both to declaration and use from C.
+*/
+
+#ifndef T3D
+
+#  ifndef NOUNDERSCORE
+
+/********************************************* F2CSTYLE *****/
+#    ifdef F2CSTYLE
+
+#   define RSL_INITIALIZE		rsl_initialize__
+#   define RSL_INITIALIZE1		rsl_initialize1__
+#   define RSL_SHUTDOWN		rsl_shutdown__
+#   define RSL_MESH		rsl_mesh__
+#   define RSL_MOTHER_DOMAIN	rsl_mother_domain__
+#   define RSL_MOTHER_DOMAIN3D	rsl_mother_domain3d__
+#   define RSL_SPAWN_REGULAR_NEST	rsl_spawn_regular_nest__
+#   define RSL_SPAWN_REGULAR_NEST1	rsl_spawn_regular_nest1__
+#   define RSL_SPAWN_IRREG_NEST   rsl_spawn_irreg_nest__
+#   define RSL_GET_BDY_LPT        rsl_get_bdy_lpt__
+#   define RSL_GET_BDY_LARRAY     rsl_get_bdy_larray__
+#   define RSL_GET_BDY_LARRAY2     rsl_get_bdy_larray2__
+#   define RSL_GET_BDY_GPT        rsl_get_bdy_gpt__
+#   define RSL_GET_BDY_GARRAY     rsl_get_bdy_garray__
+#   define RSL_GET_BDY4_LPT       rsl_get_bdy4_lpt__
+#   define RSL_GET_BDY4_LARRAY    rsl_get_bdy4_larray__
+#   define RSL_GET_BDY4_GPT       rsl_get_bdy4_gpt__
+#   define RSL_GET_BDY4_GARRAY    rsl_get_bdy4_garray__
+#   define RSL_PATCH_DECOMPOSE	rsl_patch_decompose__
+#   define RSL_FDECOMPOSE	        rsl_fdecompose__
+#   define RSL_FCN_REMAP    	rsl_fcn_remap__
+#   define RSL_FCN_DECOMPOSE	rsl_fcn_decompose__
+#   define RSL_NEW_DECOMPOSITION	rsl_new_decomposition__
+#   define RSL_IAMMONITOR         rsl_iammonitor__
+#   define RSL_C_IAMMONITOR       rsl_c_iammonitor__
+#   define RSL_IAMCOMPUTE         rsl_iamcompute__
+#   define RSL_C_IAMCOMPUTE       rsl_c_iamcompute__
+#   define RSL_PHYS2COMP_C	rsl_phys2comp_c__
+#   define RSL_COMP2PHYS_C	rsl_comp2phys_c__
+#   define RSL_CREATE_STENCIL	rsl_create_stencil__
+#   define RSL_CREATE_XPOSE	rsl_create_xpose__
+#   define RSL_CREATE_MESSAGE     rsl_create_message__
+#   define RSL_BUILD_MESSAGE      rsl_build_message__
+#   define RSL_BLANK_MESSAGE      rsl_blank_message__
+#   define RSL_DESCRIBE_STENCIL   rsl_describe_stencil__
+#   define RSL_DESCRIBE_XPOSE   rsl_describe_xpose__
+#   define RSL_EXCH_STENCIL       rsl_exch_stencil__
+#   define RSL_COMPILE_STENCIL    rsl_compile_stencil__
+#   define RSL_INIT_NEXTCELL      rsl_init_nextcell__
+#   define RSL_INIT_GHOST         rsl_init_ghost__
+#   define RSL_C_NEXTCELL         rsl_c_nextcell__
+#   define RSL_READ               rsl_read__
+#   define RSL_WRITE              rsl_write__
+#   define RSL_IOSERVE            rsl_ioserve__
+#   define RSL_IO_SHUTDOWN        rsl_io_shutdown__
+#   define RSL_INIT_FORTRAN       rsl_init_fortran__
+#   define RSL_CLOSE              rsl_close__
+#   define SHOW_DOMAIN_DECOMP     show_domain_decomp__
+#   define READ_DOMAIN_DECOMP     read_domain_decomp__
+#   define GET_DOMAIN_DECOMP      get_domain_decomp__
+#   define SHOW_STEN_DIAGS        show_sten_diags__
+#   define SHOW_MESSAGE           show_message__
+#   define SHOW_STENCIL           show_stencil__
+
+#   define RSL_CREATE_PERIOD    rsl_create_period__
+#   define RSL_DESCRIBE_PERIOD   rsl_describe_period__
+#   define RSL_EXCH_PERIOD       rsl_exch_period__
+#   define RSL_COMPILE_PERIOD    rsl_compile_period__
+
+#   define FORT_COMPLEXREAD 	fort_complexread__
+#   define FORT_INTREAD 		fort_intread__
+#   define FORT_CHARACTERREAD 	fort_characterread__
+#   define FORT_DOUBLEREAD 	fort_doubleread__
+#   define FORT_REALREAD 		fort_realread__
+#   define FORT_COMPLEXWRITE 	fort_complexwrite__
+#   define FORT_INTWRITE 		fort_intwrite__
+#   define FORT_CHARACTERWRITE 	fort_characterwrite__
+#   define FORT_DOUBLEWRITE 	fort_doublewrite__
+#   define FORT_REALWRITE 	fort_realwrite__
+#   define FORT_CLOSE          	fort_close__
+
+#   define RSL_MM_BDY_IN          rsl_mm_bdy_in__
+#   define RSL_MM_DIST_BDY        rsl_mm_dist_bdy__
+#   define RSL_READ_REPL          rsl_read_repl__
+#   define RSL_READ_REPLW         rsl_read_replw__
+#   define FORT_BDYIN_REAL        fort_bdyin_real__
+#   define FORT_BDYIN_DBL         fort_bdyin_dbl__
+
+#   define RSL_F_SET_PADAREA      rsl_f_set_padarea__
+#   define RSL_SET_PADAREA        rsl_set_padarea__
+
+#   define RSL_TO_CHILD_INFO      rsl_to_child_info__
+#   define RSL_TO_CHILD_MSG       rsl_to_child_msg__
+#   define RSL_BCAST_MSGS         rsl_bcast_msgs__
+#   define RSL_FROM_PARENT_INFO   rsl_from_parent_info__
+#   define RSL_FROM_PARENT_MSG    rsl_from_parent_msg__
+
+#   define RSL_TO_PARENT_INFO     rsl_to_parent_info__
+#   define RSL_TO_PARENT_MSG      rsl_to_parent_msg__
+#   define RSL_TO_PARENT_MSGX     rsl_to_parent_msgx__
+#   define RSL_MERGE_MSGS         rsl_merge_msgs__
+#   define RSL_FROM_CHILD_INFO    rsl_from_child_info__
+#   define RSL_FROM_CHILD_MSG     rsl_from_child_msg__
+#   define RSL_FROM_CHILD_MSGX    rsl_from_child_msgx__
+
+#   define RSL_WITHIN_NESTED_BOUNDARY  rsl_within_nested_boundary__
+#   define RSL_WITHIN_NESTED_BETA  rsl_within_nested_beta__
+
+#   define RSL_NL                 rsl_nl__
+
+
+#   define RSL_FUNIT_CLOSE        rsl_funit_close__
+#   define RSL_ORDER              rsl_order__
+
+#   define RSL_DEBUG		rsl_debug__
+
+#   define RSL_MON_BCAST		rsl_mon_bcast__
+
+#  ifdef MPI
+#   define MPI_INIT_F             mpi_init_f__
+#  endif
+
+/* socket stuff */
+#   define RSL_SOCKOPEN           rsl_sockopen__
+#   define RSL_SOCKWRITE          rsl_sockwrite__
+#   define RSL_SOCKREAD           rsl_sockread_		/* not yet */
+#   define RSL_SOCKCLOSE          rsl_sockclose__
+
+/* slab stuff added 1/9/95 */
+#   define RSL_INIT_NEXTISLAB     rsl_init_nextislab__
+#   define RSL_C_NEXTISLAB        rsl_c_nextislab__
+
+#   define RSL_COMPUTE            rsl_compute__
+#   define RSL_GET_RUN_INFO       rsl_get_run_info__
+#   define RSL_GET_RUN_INFOP      rsl_get_run_infop__
+#   define RSL_REG_RUN_INFOP      rsl_reg_run_infop__
+#   define RSL_DYNPAD_7           rsl_dynpad_7__
+
+#   define RSL_CHILD_INFO         rsl_child_info__
+#   define RSL_CHILD_INFO1        rsl_child_info1__
+
+#   define RSL_REMAP_STATE        rsl_remap_state__
+#   define RSL_DESCRIBE_STATE     rsl_describe_state__
+
+#   define RSL_PATCH_DECOMP       rsl_patch_decomp__
+#   define SET_DEF_DECOMP_FCN     set_def_decomp_fcn__
+#   define SET_DEF_DECOMP_FCN1     set_def_decomp_fcn1__
+#   define SET_DEF_DECOMP_INFO     set_def_decomp_info__
+
+#   define BOUNDARY_SAFE		boundary_safe__
+
+#   define RSL_BDY_TIEBRK		rsl_bdy_tiebrk__
+
+#   define RSL_OLD_OFFSETS        rsl_old_offsets__
+
+#   define RSL_ERROR_DUP          rsl_error_dup__
+#   define RSL_ERROR_DUP1          rsl_error_dup1__
+
+#   define RSL_OUTPUT_BUFFER_WRITE rsl_output_buffer_write__
+#   define RSL_OUTPUT_BUFFER_YES   rsl_output_buffer_yes__
+#   define RSL_OUTPUT_BUFFER_NO   rsl_output_buffer_no__
+#   define RSL_IO_NODE_YES        rsl_io_node_yes__
+#   define RSL_IO_NODE_NO         rsl_io_node_no__
+#   define RSL_WRITE_MM5V3_SM_HEADER rsl_write_mm5v3_sm_header__
+#   define RSL_WRITE_MM5V3_BIG_HEADER rsl_write_mm5v3_big_header__
+#   define RSL_WRITE_1D_DATA     rsl_write_1d_data__
+
+#   define RSL_REGISTER_F90     rsl_register_f90__
+#   define RSL_REGISTER_F90_BASE_AND_SIZE     rsl_register_f90_base_and_size__
+#   define RSL_START_REGISTER_F90     rsl_start_register_f90__
+#   define RSL_END_REGISTER_F90     rsl_end_register_f90__
+
+#   define RSL_RESET_STAGING   rsl_reset_staging__
+
+#   define RSL_TO_OH_INFO    rsl_to_oh_info__
+#   define RSL_TO_OH_MSG     rsl_to_oh_msg__
+#   define RSL_FROM_TH_INFO  rsl_from_th_info__
+#   define RSL_FROM_TH_MSG   rsl_from_th_msg__
+#   define RSL_FORCE_HEMI    rsl_force_hemi__
+#   define RSL_POINT_ON_PROC    rsl_point_on_proc__
+#   define RSL_PROC_FOR_POINT    rsl_proc_for_point__
+
+#   define VRCOPY   vrcopy_
+
+#   define RSL_SET_REGULAR_DECOMP  rsl_set_regular_decomp__
+#   define RSL_ALLOW_DYNPAD  rsl_allow_dynpad__
+#   define RSL_GET_COMMUNICATOR    rsl_get_communicator__
+#   define RSL_SET_COMMUNICATOR    rsl_set_communicator__
+
+#   define RSL_XPOSE_MN_MZ     rsl_xpose_mn_mz__
+#   define RSL_XPOSE_MZ_MN     rsl_xpose_mz_mn__
+#   define RSL_XPOSE_MZ_NZ     rsl_xpose_mz_nz__
+#   define RSL_XPOSE_NZ_MZ     rsl_xpose_nz_mz__
+#   define RSL_XPOSE_NZ_MN     rsl_xpose_nz_mn__
+#   define RSL_XPOSE_MN_NZ     rsl_xpose_mn_nz__
+
+#   define RSL_REG_PATCHINFO_MN  rsl_reg_patchinfo_mn__
+#   define RSL_REG_PATCHINFO_MZ  rsl_reg_patchinfo_mz__
+#   define RSL_REG_PATCHINFO_NZ  rsl_reg_patchinfo_nz__
+
+#   define COLLECT_ON_COMM  collect_on_comm__
+#   define INT_PACK_DATA  int_pack_data__
+
+#   define GET_NEXT_DOMAIN_DESCRIPTOR get_next_domain_descriptor__
+#   define RSL_GET_GLEN rsl_get_glen__
+#   define RSL_REMAP_ARRAY rsl_remap_array__
+#   define RSL_MOVE_NEST rsl_move_nest__
+
+#   define RSL_INTERNAL_MILLICLOCK rsl_internal_milliclock__
+#   define RSL_INTERNAL_MICROCLOCK rsl_internal_microclock__
+
+#    else
+
+/********************************************* UNDERSCORE *****/
+
+#   define RSL_INITIALIZE		rsl_initialize_
+#   define RSL_INITIALIZE1		rsl_initialize1_
+#   define RSL_SHUTDOWN		rsl_shutdown_
+#   define RSL_MESH		rsl_mesh_
+#   define RSL_MOTHER_DOMAIN	rsl_mother_domain_
+#   define RSL_MOTHER_DOMAIN3D	rsl_mother_domain3d_
+#   define RSL_SPAWN_REGULAR_NEST	rsl_spawn_regular_nest_
+#   define RSL_SPAWN_REGULAR_NEST1	rsl_spawn_regular_nest1_
+#   define RSL_SPAWN_IRREG_NEST   rsl_spawn_irreg_nest_
+#   define RSL_GET_BDY_LPT        rsl_get_bdy_lpt_
+#   define RSL_GET_BDY_LARRAY     rsl_get_bdy_larray_
+#   define RSL_GET_BDY_LARRAY2     rsl_get_bdy_larray2_
+#   define RSL_GET_BDY_GPT        rsl_get_bdy_gpt_
+#   define RSL_GET_BDY_GARRAY     rsl_get_bdy_garray_
+#   define RSL_GET_BDY4_LPT       rsl_get_bdy4_lpt_
+#   define RSL_GET_BDY4_LARRAY    rsl_get_bdy4_larray_
+#   define RSL_GET_BDY4_GPT       rsl_get_bdy4_gpt_
+#   define RSL_GET_BDY4_GARRAY    rsl_get_bdy4_garray_
+#   define RSL_PATCH_DECOMPOSE	rsl_patch_decompose_
+#   define RSL_FDECOMPOSE	        rsl_fdecompose_
+#   define RSL_FCN_REMAP    	rsl_fcn_remap_
+#   define RSL_FCN_DECOMPOSE	rsl_fcn_decompose_
+#   define RSL_NEW_DECOMPOSITION	rsl_new_decomposition_
+#   define RSL_IAMMONITOR         rsl_iammonitor_
+#   define RSL_C_IAMMONITOR       rsl_c_iammonitor_
+#   define RSL_IAMCOMPUTE         rsl_iamcompute_
+#   define RSL_C_IAMCOMPUTE       rsl_c_iamcompute_
+#   define RSL_PHYS2COMP_C	rsl_phys2comp_c_
+#   define RSL_COMP2PHYS_C	rsl_comp2phys_c_
+#   define RSL_CREATE_STENCIL	rsl_create_stencil_
+#   define RSL_CREATE_XPOSE	rsl_create_xpose_
+#   define RSL_CREATE_MESSAGE     rsl_create_message_
+#   define RSL_BUILD_MESSAGE      rsl_build_message_
+#   define RSL_BLANK_MESSAGE      rsl_blank_message_
+#   define RSL_DESCRIBE_STENCIL   rsl_describe_stencil_
+#   define RSL_DESCRIBE_XPOSE   rsl_describe_xpose_
+#   define RSL_EXCH_STENCIL       rsl_exch_stencil_
+#   define RSL_COMPILE_STENCIL    rsl_compile_stencil_
+#   define RSL_INIT_NEXTCELL      rsl_init_nextcell_
+#   define RSL_INIT_GHOST         rsl_init_ghost_
+#   define RSL_C_NEXTCELL         rsl_c_nextcell_
+#   define RSL_READ               rsl_read_
+#   define RSL_WRITE              rsl_write_
+#   define RSL_IOSERVE            rsl_ioserve_
+#   define RSL_IO_SHUTDOWN        rsl_io_shutdown_
+#   define RSL_INIT_FORTRAN       rsl_init_fortran_
+#   define RSL_CLOSE              rsl_close_
+#   define SHOW_DOMAIN_DECOMP     show_domain_decomp_
+#   define READ_DOMAIN_DECOMP     read_domain_decomp_
+#   define GET_DOMAIN_DECOMP      get_domain_decomp_
+#   define SHOW_STEN_DIAGS        show_sten_diags_
+#   define SHOW_MESSAGE           show_message_
+#   define SHOW_STENCIL           show_stencil_
+
+#   define RSL_CREATE_PERIOD    rsl_create_period_
+#   define RSL_DESCRIBE_PERIOD   rsl_describe_period_
+#   define RSL_EXCH_PERIOD       rsl_exch_period_
+#   define RSL_COMPILE_PERIOD    rsl_compile_period_
+
+#   define FORT_COMPLEXREAD 	fort_complexread_
+#   define FORT_INTREAD 		fort_intread_
+#   define FORT_CHARACTERREAD 	fort_characterread_
+#   define FORT_DOUBLEREAD 	fort_doubleread_
+#   define FORT_REALREAD 		fort_realread_
+#   define FORT_COMPLEXWRITE 	fort_complexwrite_
+#   define FORT_INTWRITE 		fort_intwrite_
+#   define FORT_CHARACTERWRITE 	fort_characterwrite_
+#   define FORT_DOUBLEWRITE 	fort_doublewrite_
+#   define FORT_REALWRITE 	fort_realwrite_
+#   define FORT_CLOSE          	fort_close_
+
+#   define RSL_MM_BDY_IN          rsl_mm_bdy_in_
+#   define RSL_MM_DIST_BDY        rsl_mm_dist_bdy_
+#   define RSL_READ_REPL          rsl_read_repl_
+#   define RSL_READ_REPLW         rsl_read_replw_
+#   define FORT_BDYIN_REAL        fort_bdyin_real_
+#   define FORT_BDYIN_DBL         fort_bdyin_dbl_
+
+#   define RSL_F_SET_PADAREA      rsl_f_set_padarea_
+#   define RSL_SET_PADAREA        rsl_set_padarea_
+
+#   define RSL_TO_CHILD_INFO      rsl_to_child_info_
+#   define RSL_TO_CHILD_MSG       rsl_to_child_msg_
+#   define RSL_BCAST_MSGS         rsl_bcast_msgs_
+#   define RSL_FROM_PARENT_INFO   rsl_from_parent_info_
+#   define RSL_FROM_PARENT_MSG    rsl_from_parent_msg_
+
+#   define RSL_TO_PARENT_INFO     rsl_to_parent_info_
+#   define RSL_TO_PARENT_MSG      rsl_to_parent_msg_
+#   define RSL_TO_PARENT_MSGX     rsl_to_parent_msgx_
+#   define RSL_MERGE_MSGS         rsl_merge_msgs_
+#   define RSL_FROM_CHILD_INFO    rsl_from_child_info_
+#   define RSL_FROM_CHILD_MSG     rsl_from_child_msg_
+#   define RSL_FROM_CHILD_MSGX    rsl_from_child_msgx_
+
+#   define RSL_WITHIN_NESTED_BOUNDARY  rsl_within_nested_boundary_
+#   define RSL_WITHIN_NESTED_BETA  rsl_within_nested_beta_
+
+#   define RSL_NL                 rsl_nl_
+
+
+#   define RSL_FUNIT_CLOSE        rsl_funit_close_
+#   define RSL_ORDER              rsl_order_
+
+#   define RSL_DEBUG		rsl_debug_
+
+#   define RSL_MON_BCAST		rsl_mon_bcast_
+
+#  ifdef MPI
+#   define MPI_INIT_F             mpi_init_f_
+#  endif
+
+/* socket stuff */
+#   define RSL_SOCKOPEN           rsl_sockopen_
+#   define RSL_SOCKWRITE          rsl_sockwrite_
+#   define RSL_SOCKREAD           rsl_sockread_		/* not yet */
+#   define RSL_SOCKCLOSE          rsl_sockclose_
+
+/* slab stuff added 1/9/95 */
+#   define RSL_INIT_NEXTISLAB     rsl_init_nextislab_
+#   define RSL_C_NEXTISLAB        rsl_c_nextislab_
+
+#   define RSL_COMPUTE            rsl_compute_
+#   define RSL_GET_RUN_INFO       rsl_get_run_info_
+#   define RSL_GET_RUN_INFOP      rsl_get_run_infop_
+#   define RSL_REG_RUN_INFOP      rsl_reg_run_infop_
+#   define RSL_DYNPAD_7           rsl_dynpad_7_
+
+#   define RSL_CHILD_INFO         rsl_child_info_
+#   define RSL_CHILD_INFO1        rsl_child_info1_
+
+#   define RSL_REMAP_STATE        rsl_remap_state_
+#   define RSL_DESCRIBE_STATE     rsl_describe_state_
+
+#   define RSL_PATCH_DECOMP       rsl_patch_decomp_
+#   define SET_DEF_DECOMP_FCN     set_def_decomp_fcn_
+#   define SET_DEF_DECOMP_FCN1     set_def_decomp_fcn1_
+#   define SET_DEF_DECOMP_INFO     set_def_decomp_info_
+
+#   define BOUNDARY_SAFE		boundary_safe_
+
+#   define RSL_BDY_TIEBRK		rsl_bdy_tiebrk_
+
+#   define RSL_OLD_OFFSETS        rsl_old_offsets_
+
+#   define RSL_ERROR_DUP          rsl_error_dup_
+#   define RSL_ERROR_DUP1          rsl_error_dup1_
+
+#   define RSL_OUTPUT_BUFFER_WRITE rsl_output_buffer_write_
+#   define RSL_OUTPUT_BUFFER_YES   rsl_output_buffer_yes_
+#   define RSL_OUTPUT_BUFFER_NO   rsl_output_buffer_no_
+#   define RSL_IO_NODE_YES        rsl_io_node_yes_
+#   define RSL_IO_NODE_NO         rsl_io_node_no_
+#   define RSL_WRITE_MM5V3_SM_HEADER rsl_write_mm5v3_sm_header_
+#   define RSL_WRITE_MM5V3_BIG_HEADER rsl_write_mm5v3_big_header_
+#   define RSL_WRITE_1D_DATA     rsl_write_1d_data_
+
+#   define RSL_REGISTER_F90     rsl_register_f90_
+#   define RSL_START_REGISTER_F90     rsl_start_register_f90_
+#   define RSL_REGISTER_F90_BASE_AND_SIZE     rsl_register_f90_base_and_size_
+#   define RSL_END_REGISTER_F90     rsl_end_register_f90_
+
+#   define RSL_RESET_STAGING   rsl_reset_staging_
+
+#   define RSL_TO_OH_INFO    rsl_to_oh_info_
+#   define RSL_TO_OH_MSG     rsl_to_oh_msg_
+#   define RSL_FROM_TH_INFO  rsl_from_th_info_
+#   define RSL_FROM_TH_MSG   rsl_from_th_msg_
+#   define RSL_FORCE_HEMI    rsl_force_hemi_
+#   define RSL_POINT_ON_PROC    rsl_point_on_proc_
+#   define RSL_PROC_FOR_POINT    rsl_proc_for_point_
+
+#   define VRCOPY   vrcopy_
+
+#   define RSL_SET_REGULAR_DECOMP  rsl_set_regular_decomp_
+#   define RSL_ALLOW_DYNPAD  rsl_allow_dynpad_
+
+#   define RSL_GET_COMMUNICATOR    rsl_get_communicator_
+#   define RSL_SET_COMMUNICATOR    rsl_set_communicator_
+
+#   define RSL_XPOSE_MN_MZ     rsl_xpose_mn_mz_
+#   define RSL_XPOSE_MZ_MN     rsl_xpose_mz_mn_
+#   define RSL_XPOSE_MZ_NZ     rsl_xpose_mz_nz_
+#   define RSL_XPOSE_NZ_MZ     rsl_xpose_nz_mz_
+#   define RSL_XPOSE_NZ_MN     rsl_xpose_nz_mn_
+#   define RSL_XPOSE_MN_NZ     rsl_xpose_mn_nz_
+
+#   define RSL_REG_PATCHINFO_MN  rsl_reg_patchinfo_mn_
+#   define RSL_REG_PATCHINFO_MZ  rsl_reg_patchinfo_mz_
+#   define RSL_REG_PATCHINFO_NZ  rsl_reg_patchinfo_nz_
+
+#   define COLLECT_ON_COMM  collect_on_comm_
+#   define INT_PACK_DATA  int_pack_data_
+
+#   define GET_NEXT_DOMAIN_DESCRIPTOR get_next_domain_descriptor_
+#   define RSL_GET_GLEN rsl_get_glen_
+#   define RSL_REMAP_ARRAY rsl_remap_array_
+#   define RSL_MOVE_NEST rsl_move_nest_
+
+#   define RSL_INTERNAL_MILLICLOCK rsl_internal_milliclock_
+#   define RSL_INTERNAL_MICROCLOCK rsl_internal_microclock_
+
+#    endif
+
+#  else
+
+/********************************************* NOUNDERSCORE ***/
+
+#   define RSL_INITIALIZE		rsl_initialize
+#   define RSL_INITIALIZE1		rsl_initialize1
+#   define RSL_SHUTDOWN		rsl_shutdown
+#   define RSL_MESH		rsl_mesh
+#   define RSL_MOTHER_DOMAIN	rsl_mother_domain
+#   define RSL_MOTHER_DOMAIN3D	rsl_mother_domain3d
+#   define RSL_SPAWN_REGULAR_NEST	rsl_spawn_regular_nest
+#   define RSL_SPAWN_REGULAR_NEST1	rsl_spawn_regular_nest1
+#   define RSL_SPAWN_IRREG_NEST   rsl_spawn_irreg_nest
+#   define RSL_GET_BDY_LPT        rsl_get_bdy_lpt
+#   define RSL_GET_BDY_LARRAY     rsl_get_bdy_larray
+#   define RSL_GET_BDY_LARRAY2     rsl_get_bdy_larray2
+#   define RSL_GET_BDY_GPT        rsl_get_bdy_gpt
+#   define RSL_GET_BDY_GARRAY     rsl_get_bdy_garray
+#   define RSL_GET_BDY4_LPT        rsl_get_bdy4_lpt
+#   define RSL_GET_BDY4_LARRAY     rsl_get_bdy4_larray
+#   define RSL_GET_BDY4_GPT        rsl_get_bdy4_gpt
+#   define RSL_GET_BDY4_GARRAY     rsl_get_bdy4_garray
+#   define RSL_PATCH_DECOMPOSE	rsl_patch_decompose
+#   define RSL_FDECOMPOSE	        rsl_fdecompose
+#   define RSL_FCN_REMAP    	rsl_fcn_remap
+#   define RSL_FCN_DECOMPOSE	rsl_fcn_decompose
+#   define RSL_NEW_DECOMPOSITION	rsl_new_decomposition
+#   define RSL_IAMMONITOR         rsl_iammonitor
+#   define RSL_C_IAMMONITOR       rsl_c_iammonitor
+#   define RSL_IAMCOMPUTE         rsl_iamcompute
+#   define RSL_C_IAMCOMPUTE       rsl_c_iamcompute
+#   define RSL_PHYS2COMP_C	rsl_phys2comp_c
+#   define RSL_COMP2PHYS_C	rsl_comp2phys_c
+#   define RSL_CREATE_STENCIL	rsl_create_stencil
+#   define RSL_CREATE_XPOSE	rsl_create_xpose
+#   define RSL_CREATE_MESSAGE     rsl_create_message
+#   define RSL_BUILD_MESSAGE      rsl_build_message
+#   define RSL_BLANK_MESSAGE      rsl_blank_message
+#   define RSL_DESCRIBE_STENCIL   rsl_describe_stencil
+#   define RSL_DESCRIBE_XPOSE   rsl_describe_xpose
+#   define RSL_EXCH_STENCIL       rsl_exch_stencil
+#   define RSL_COMPILE_STENCIL    rsl_compile_stencil
+#   define RSL_INIT_NEXTCELL      rsl_init_nextcell
+#   define RSL_INIT_GHOST         rsl_init_ghost
+#   define RSL_C_NEXTCELL         rsl_c_nextcell
+#   define RSL_READ               rsl_read
+#   define RSL_WRITE              rsl_write
+#   define RSL_IOSERVE            rsl_ioserve
+#   define RSL_IO_SHUTDOWN        rsl_io_shutdown
+#   define RSL_INIT_FORTRAN       rsl_init_fortran
+#   define RSL_CLOSE              rsl_close
+#   define SHOW_DOMAIN_DECOMP     show_domain_decomp
+#   define READ_DOMAIN_DECOMP     read_domain_decomp
+#   define GET_DOMAIN_DECOMP      get_domain_decomp
+#   define SHOW_STEN_DIAGS        show_sten_diags
+#   define SHOW_MESSAGE           show_message
+#   define SHOW_STENCIL           show_stencil
+
+#   define RSL_CREATE_PERIOD    rsl_create_period
+#   define RSL_DESCRIBE_PERIOD   rsl_describe_period
+#   define RSL_EXCH_PERIOD       rsl_exch_period
+#   define RSL_COMPILE_PERIOD    rsl_compile_period
+
+#   define FORT_COMPLEXREAD 	fort_complexread
+#   define FORT_INTREAD 		fort_intread
+#   define FORT_CHARACTERREAD 	fort_characterread
+#   define FORT_DOUBLEREAD 	fort_doubleread
+#   define FORT_REALREAD 		fort_realread
+#   define FORT_COMPLEXWRITE 	fort_complexwrite
+#   define FORT_INTWRITE 		fort_intwrite
+#   define FORT_CHARACTERWRITE 	fort_characterwrite
+#   define FORT_DOUBLEWRITE 	fort_doublewrite
+#   define FORT_REALWRITE 	fort_realwrite
+#   define FORT_CLOSE   	 	fort_close
+
+#   define RSL_MM_BDY_IN          rsl_mm_bdy_in
+#   define RSL_MM_DIST_BDY        rsl_mm_dist_bdy
+#   define RSL_READ_REPL          rsl_read_repl
+#   define RSL_READ_REPLW         rsl_read_replw
+#   define FORT_BDYIN_REAL        fort_bdyin_real
+#   define FORT_BDYIN_DBL         fort_bdyin_dbl
+
+#   define RSL_F_SET_PADAREA      rsl_f_set_padarea
+#   define RSL_SET_PADAREA        rsl_set_padarea
+
+#   define RSL_TO_CHILD_INFO      rsl_to_child_info
+#   define RSL_TO_CHILD_MSG       rsl_to_child_msg
+#   define RSL_BCAST_MSGS         rsl_bcast_msgs
+#   define RSL_FROM_PARENT_INFO   rsl_from_parent_info
+#   define RSL_FROM_PARENT_MSG    rsl_from_parent_msg
+
+#   define RSL_TO_PARENT_INFO     rsl_to_parent_info
+#   define RSL_TO_PARENT_MSG      rsl_to_parent_msg
+#   define RSL_TO_PARENT_MSGX     rsl_to_parent_msgx
+#   define RSL_MERGE_MSGS         rsl_merge_msgs
+#   define RSL_FROM_CHILD_INFO    rsl_from_child_info
+#   define RSL_FROM_CHILD_MSG     rsl_from_child_msg
+#   define RSL_FROM_CHILD_MSGX    rsl_from_child_msgx
+
+#   define RSL_WITHIN_NESTED_BOUNDARY  rsl_within_nested_boundary
+#   define RSL_WITHIN_NESTED_BETA  rsl_within_nested_beta
+
+#   define RSL_NL                 rsl_nl
+
+#   define RSL_FUNIT_CLOSE        rsl_funit_close
+#   define RSL_ORDER              rsl_order
+
+#   define RSL_DEBUG		rsl_debug
+
+#   define RSL_MON_BCAST		rsl_mon_bcast
+
+#  ifdef MPI
+#   define MPI_INIT_F             mpi_init_f
+#  endif
+
+/* socket stuff */
+#   define RSL_SOCKOPEN           rsl_sockopen
+#   define RSL_SOCKWRITE          rsl_sockwrite
+#   define RSL_SOCKREAD           rsl_sockread		/* not yet */
+#   define RSL_SOCKCLOSE          rsl_sockclose
+
+/* slab stuff added 1/9/95 */
+#   define RSL_INIT_NEXTISLAB     rsl_init_nextislab
+#   define RSL_C_NEXTISLAB        rsl_c_nextislab
+
+#   define RSL_COMPUTE            rsl_compute
+#   define RSL_GET_RUN_INFO       rsl_get_run_info
+#   define RSL_GET_RUN_INFOP      rsl_get_run_infop
+#   define RSL_REG_RUN_INFOP      rsl_reg_run_infop
+#   define RSL_DYNPAD_7           rsl_dynpad_7
+
+#   define RSL_CHILD_INFO         rsl_child_info
+#   define RSL_CHILD_INFO1        rsl_child_info1
+
+#   define RSL_REMAP_STATE        rsl_remap_state
+#   define RSL_DESCRIBE_STATE     rsl_describe_state
+
+#   define RSL_PATCH_DECOMP       rsl_patch_decomp
+#   define SET_DEF_DECOMP_FCN     set_def_decomp_fcn
+#   define SET_DEF_DECOMP_FCN1     set_def_decomp_fcn1
+#   define SET_DEF_DECOMP_INFO     set_def_decomp_info
+
+#   define BOUNDARY_SAFE		boundary_safe
+
+#   define RSL_BDY_TIEBRK		rsl_bdy_tiebrk
+
+#   define RSL_OLD_OFFSETS        rsl_old_offsets
+
+#   define RSL_ERROR_DUP          rsl_error_dup
+#   define RSL_ERROR_DUP1          rsl_error_dup1
+
+#   define RSL_OUTPUT_BUFFER_WRITE rsl_output_buffer_write
+#   define RSL_OUTPUT_BUFFER_YES   rsl_output_buffer_yes
+#   define RSL_OUTPUT_BUFFER_NO   rsl_output_buffer_no
+#   define RSL_IO_NODE_YES        rsl_io_node_yes
+#   define RSL_IO_NODE_NO         rsl_io_node_no
+#   define RSL_WRITE_MM5V3_SM_HEADER rsl_write_mm5v3_sm_header
+#   define RSL_WRITE_MM5V3_BIG_HEADER rsl_write_mm5v3_big_header
+#   define RSL_WRITE_1D_DATA     rsl_write_1d_data
+
+#   define RSL_REGISTER_F90     rsl_register_f90
+#   define RSL_START_REGISTER_F90     rsl_start_register_f90
+#   define RSL_REGISTER_F90_BASE_AND_SIZE     rsl_register_f90_base_and_size
+#   define RSL_END_REGISTER_F90     rsl_end_register_f90
+
+#   define RSL_RESET_STAGING   rsl_reset_staging
+
+#   define RSL_TO_OH_INFO    rsl_to_oh_info
+#   define RSL_TO_OH_MSG     rsl_to_oh_msg
+#   define RSL_FROM_TH_INFO  rsl_from_th_info
+#   define RSL_FROM_TH_MSG   rsl_from_th_msg
+#   define RSL_FORCE_HEMI    rsl_force_hemi
+#   define RSL_POINT_ON_PROC    rsl_point_on_proc
+#   define RSL_PROC_FOR_POINT    rsl_proc_for_point
+
+#   define VRCOPY   vrcopy
+
+#   define RSL_SET_REGULAR_DECOMP  rsl_set_regular_decomp
+#   define RSL_ALLOW_DYNPAD  rsl_allow_dynpad
+
+#   define RSL_GET_COMMUNICATOR    rsl_get_communicator
+#   define RSL_SET_COMMUNICATOR    rsl_set_communicator
+
+#   define RSL_XPOSE_MN_MZ     rsl_xpose_mn_mz
+#   define RSL_XPOSE_MZ_MN     rsl_xpose_mz_mn
+#   define RSL_XPOSE_MZ_NZ     rsl_xpose_mz_nz
+#   define RSL_XPOSE_NZ_MZ     rsl_xpose_nz_mz
+#   define RSL_XPOSE_NZ_MN     rsl_xpose_nz_mn
+#   define RSL_XPOSE_MN_NZ     rsl_xpose_mn_nz
+
+#   define RSL_REG_PATCHINFO_MN  rsl_reg_patchinfo_mn
+#   define RSL_REG_PATCHINFO_MZ  rsl_reg_patchinfo_mz
+#   define RSL_REG_PATCHINFO_NZ  rsl_reg_patchinfo_nz
+
+#   define COLLECT_ON_COMM  collect_on_comm
+#   define INT_PACK_DATA  int_pack_data
+
+#   define GET_NEXT_DOMAIN_DESCRIPTOR get_next_domain_descriptor
+#   define RSL_GET_GLEN rsl_get_glen
+#   define RSL_REMAP_ARRAY rsl_remap_array
+#   define RSL_MOVE_NEST rsl_move_nest
+
+#   define RSL_INTERNAL_MILLICLOCK rsl_internal_milliclock
+#   define RSL_INTERNAL_MICROCLOCK rsl_internal_microclock
+
+#  endif
+#endif
+
+#endif /* nothing after this */
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/debug.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/debug.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/debug.c	(revision 2744)
@@ -0,0 +1,411 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+/*
+ * debug.c
+ *
+ * Various debugging things, including malloc debugging stuff
+ */
+
+dumdebug(j)
+{
+  return ;
+}
+
+/* #define NEXUS_MALLOC_DEBUG */
+#ifdef NEXUS_MALLOC_DEBUG
+
+#include <stdio.h>
+#include <ctype.h>
+#include <errno.h>
+#include <sys/param.h>
+#include <sys/access.h>
+
+/*
+ * Memory allocation debugging and diagnostics code.
+ */
+
+#define NEXUS_MALLOC_PAD 512
+#define NEXUS_N_MALLOC_RECS 20000
+
+typedef struct _malloc_rec_t
+{
+    char *addr;
+    char *file;
+    char *free_file;
+    int size;
+#ifdef crayx1
+    int line;
+    int free_line;
+    int freed;
+#else
+    short line;
+    short free_line;
+    short freed;
+#endif
+} *malloc_rec_t;
+
+static struct _malloc_rec_t malloc_recs[NEXUS_N_MALLOC_RECS];
+static int next_malloc_rec = 0;
+
+static char last_successful_file[1024];
+static int last_successful_line;
+
+static int initialized = 0;
+
+
+#define START_MAGIC 0xf00dface
+#define END_MAGIC 0xeeaaddff
+
+/*
+ * nexus_debug_malloc()
+ *
+ * Malloc wrapper that can print out the size and location
+ * of allocations when the -Dmalloc argument has been given.
+ *
+ * The intent is to define a macro of the form
+ *
+ *	#ifdef NEXUS_DEBUG
+ *	#define malloc(size) nexus_debug_malloc(size, __FILE__, __LINE__)
+ *	#endif
+ *
+ * in order to trace memory allocation in detail.
+ * 
+ */
+void *nexus_debug_malloc(int size, char *file, int line)
+{
+    void *rc, *addr;
+    malloc_rec_t rec;
+    int *p;
+
+	nexus_debug_malloc_check(file, line);
+	
+	while ((size & 0x07) != 0)
+	    size++;
+	
+	if (next_malloc_rec >= NEXUS_N_MALLOC_RECS)
+	{
+	    fprintf(stderr,"Too many malloc recs\n");
+	    rc = malloc(size);
+	}
+	else
+	{
+	    rec = &malloc_recs[next_malloc_rec];
+	    
+	    addr = malloc(size + 2 * NEXUS_MALLOC_PAD);
+	    rc = (char *) addr + NEXUS_MALLOC_PAD;
+	    bzero( rc, size ) ; 	/* zero storage */
+	    if (0 )
+	    {
+		printf("malloc(%d) at %s:%d returns %x idx=%d\n",
+			    size, file, line, rc, next_malloc_rec);
+	    }
+	    
+	    rec->addr = addr;
+	    rec->file = file;
+	    rec->line = line;
+	    rec->size = size;
+	    rec->free_file = (char *) NULL;
+	    rec->free_line = -1;
+	    rec->freed = 0;
+
+	    if (NEXUS_MALLOC_PAD >= 4)
+	    {
+		*((int *) addr) = next_malloc_rec;
+	    
+		for (p = (int *) addr + 1; p < (int *) rc; p++)
+		{
+		    *p = START_MAGIC;
+		}
+		for (p = (int *) ((char *) addr + size + NEXUS_MALLOC_PAD);
+		     p < (int *) ((char *) addr + size + 2 * NEXUS_MALLOC_PAD); p++)
+		{
+		    *p = END_MAGIC;
+		}
+	    }
+
+	    next_malloc_rec++;
+	}
+
+    return rc;
+} /* nexus_debug_malloc() */
+
+
+/*
+ * nexus_debug_malloc_check()
+ *
+ * Walk the list of allocated blocks looking for munged memory.
+ */
+nexus_debug_malloc_check(char *file, int line)
+{
+    int i;
+    malloc_rec_t rec;
+    int *p;
+
+    if (NEXUS_MALLOC_PAD < 4)
+	return;
+
+    for (i = 0; i < next_malloc_rec; i++)
+    {
+	rec = &malloc_recs[i];
+
+	if (rec->freed)
+	    continue;
+
+	if (*((int *) rec->addr) != i)
+	{
+	    fprintf(stderr,"Malloc check (start) failed for idx %d at %s:%d for allocation at %s:%d of size %d. Last successful check was %s:%d\n",
+			i,
+			file, line,
+			rec->file, rec->line,
+			rec->size,
+			last_successful_file,
+			last_successful_line);
+	    exit(2) ;
+	}
+
+	for (p = (int *) rec->addr + 1; p < (int *) ((char *) rec->addr + NEXUS_MALLOC_PAD); p++)
+	{
+	    if (*p != START_MAGIC)
+	    {
+	    fprintf(stderr,"Malloc check (start) failed for idx %d at %s:%d for allocation at %s:%d of size %d Last successful check was %s:%d\n",
+			    i,
+			    file, line,
+			    rec->file, rec->line,
+			    rec->size,
+			    last_successful_file,
+			    last_successful_line);
+	    exit(2) ;
+	    }
+	}
+	
+	for (p = (int *) ((char *) rec->addr + rec->size + NEXUS_MALLOC_PAD);
+	     p < (int *) ((char *) rec->addr + rec->size + 2 * NEXUS_MALLOC_PAD); p++)
+	{
+	    if (*p != END_MAGIC)
+	    {
+	    fprintf(stderr,"Malloc check (end) failed for idx %d at %s:%d for allocation at %s:%d of size %d Last successful check was %s:%d\n",
+			    i,
+			    file, line,
+			    rec->file, rec->line,
+			    rec->size,
+			    last_successful_file,
+			    last_successful_line);
+	    exit(2) ;
+	    }
+	}
+    }
+    strcpy(last_successful_file, file);
+    last_successful_line = line;
+} /* nexus_debug_malloc_check() */
+
+void nexus_debug_mem_check(int size, void *address)
+{
+    int i;
+    malloc_rec_t rec;
+    char *pad1_start, *pad1_end, *pad2_start, *pad2_end, *a_start, *a_end;
+
+    for (i = 0; i < next_malloc_rec; i++)
+    {
+	rec = &malloc_recs[i];
+
+	if (rec->freed)
+	    continue;
+
+	pad1_start = rec->addr;
+	pad1_end = pad1_start + NEXUS_MALLOC_PAD;
+
+	pad2_start = rec->addr + rec->size + NEXUS_MALLOC_PAD;
+	pad2_end = pad2_start + NEXUS_MALLOC_PAD;
+
+	a_start = address;
+	a_end = a_start + size - 1;
+
+	if ((a_start >= pad1_start && a_start < pad1_end) ||
+	    (a_end >= pad1_start && a_end < pad1_end) ||
+	    (a_start >= pad2_start && a_start < pad2_end) ||
+	    (a_end >= pad2_start && a_end < pad2_end) ||
+	    (a_start < pad1_start && a_end > pad1_end) ||
+	    (a_start < pad2_start && a_end > pad2_end))
+	{
+	    fprintf(stderr,"Malloc memory check for address %x length %s failed for idx %d for allocation at %s:%d of size %d.\n",
+			address,
+			size,
+			i,
+			rec->file, rec->line,
+			rec->size);
+	    exit(2) ;
+	}
+    }
+} /* nexus_debug_mem_check() */
+
+
+/*
+ * nexus_debug_show_freed_blocks()
+ *
+ * Walk the list of allocated blocks looking blocks that
+ * were never freed.
+ */
+void nexus_debug_show_freed_blocks()
+{
+    int i;
+    malloc_rec_t rec;
+
+    for (i = 0; i < next_malloc_rec; i++)
+    {
+	rec = &malloc_recs[i];
+
+	if (!rec->freed)
+	{
+	    fprintf(stderr,"Unfreed block %d size=%5d at %s:%d\n",
+			i, rec->size, rec->file, rec->line);
+	}
+    }
+} /* nexus_debug_show_freed_blocks() */
+
+
+/*
+ * nexus_debug_show_malloc_stats()
+ *
+ * Print a summary of memory allocation statistics.
+ */
+void nexus_debug_show_malloc_stats()
+{
+    int i;
+    malloc_rec_t rec;
+    int bytes, bytes_freed;
+    int n_blocks_freed;
+
+    bytes = bytes_freed = n_blocks_freed = 0;
+
+    for (i = 0; i < next_malloc_rec; i++)
+    {
+	rec = &malloc_recs[i];
+
+	bytes += rec->size;
+
+	if (rec->freed)
+	{
+	    bytes_freed += rec->size;
+	    n_blocks_freed++;
+	}
+    }
+
+    fprintf(stderr,"Malloc statistics:\n");
+    fprintf(stderr,"\tbytes allocated:  %d\n", bytes);
+    fprintf(stderr,"\tbytes freed:      %d\n", bytes_freed);
+    fprintf(stderr,"\tbytes unfreed:    %d\n", bytes - bytes_freed);
+    fprintf(stderr,"\tblocks allocated: %d\n", next_malloc_rec);
+    fprintf(stderr,"\tblocks freed:     %d\n", n_blocks_freed);
+    fprintf(stderr,"\tblocks unfreed:   %d\n", next_malloc_rec - n_blocks_freed);
+} /* nexus_debug_show_malloc_stats() */
+
+
+/*
+ * nexus_debug_free()
+ */
+void nexus_debug_free(void *ptr, char *file, int line)
+{
+    void *addr;
+    int idx;
+
+	malloc_rec_t rec;
+
+	if (NEXUS_MALLOC_PAD >= 4)
+	{
+	    addr = (char *) ptr - NEXUS_MALLOC_PAD;
+	
+	    idx = *((int *) addr);
+
+	    if ( idx < 0 || idx >= NEXUS_N_MALLOC_RECS )
+	    {
+fprintf(stderr,"nexus_debug_free(): bad idx = %d; \n  possibly corrupt ptr %08x at %s line %d\n",
+idx, ptr, file, line ) ;
+	    }
+
+	    rec = &(malloc_recs[idx]);
+
+	    if (rec->freed == 1 )
+	    {
+		fprintf(stderr,"nexus_debug_free(): block %x idx %d allocated at %s:%d was freed twice at %s:%d and %s:%d\n",
+			    ptr, idx,
+			    rec->file, rec->line,
+			    rec->free_file, rec->free_line,
+			    file, line);
+		exit(2) ;
+	    }
+	
+	    rec->freed = 1;
+	    rec->free_file = file;
+	    rec->free_line = line;
+	    free(addr);
+	}
+	else
+	{
+	    idx = -1;
+	    free(ptr);
+	}
+	if (0)
+	{
+	    nexus_printf("free(%x) at %s:%d index=%d\n",
+			ptr, file, line, idx);
+	}
+} /* nexus_debug_free() */
+
+
+
+#endif /* NEXUS_DEBUG */
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/decomp.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/decomp.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/decomp.c	(revision 2744)
@@ -0,0 +1,551 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#define DEFINE_GLOBAL
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+rsl_list_t *point_move_receives[ RSL_MAXPROC ] ;
+rsl_list_t *point_move_sends[ RSL_MAXPROC ] ;
+
+/*@
+  RSL_FDECOMPOSE Decompose domain using user-supplied function.
+
+  Notes:
+  This routine decomposes the a domain using a function provided
+  by the user.  The prototypical mapping function is described below.
+
+  Mapping function:
+  The user-supplied function for decomposing the domain should have
+  the following form.
+
+  Verbatim:
+$  INTEGER FUNCTION MAPPING ( in, out, info_p, m, n, py, px )
+BREAKTHEEXAMPLECODE
+
+  In and out are m by n integer arrays.  Each element of the in array is
+  set to RSL_VALID for valid points in the domain or RSL_INVALID if the
+  point is not considered to be part of the domain and therefore not
+  to be allocated to a processor (as might be the case if extra memory
+  is allocated but not used).  The function generates an out array
+  such that every point that was RSL_VALID in the in array is given
+  a processor number between 0 (zero) and py times px minus 1.  Integers
+  m and n are the in and out array dimensions; integer py is the number
+  of processors decomposing m; integer px is the number of processors
+  decomposing n.
+
+@*/
+
+RSL_FDECOMPOSE (d_p,fcn,py_p,px_p,info_p,mloc_p,nloc_p,zloc_p,
+                                         mloc_mz_p,nloc_mz_p,zloc_mz_p,
+                                         mloc_nz_p,nloc_nz_p,zloc_nz_p )
+  int_p
+    d_p  ;      /* (I) domain descriptor */
+  int 
+   (*fcn)() ;   /* (I) decomposition function */
+  int_p
+    py_p        /* (I) number of processors in y dimension */
+   ,px_p        /* (I) number of processors in x dimension */
+   ,info_p	     /* (I) extra argument, passed as-is to fcn */
+   ,mloc_p      /* (O) minimum m size of local array on this processor */
+   ,nloc_p      /* (O) minimum n size of local array on this processor */
+   ,zloc_p      /* (O) minimum n size of local array on this processor */
+   ,mloc_mz_p   /* (O) minimum m size of local array on this processor */
+   ,nloc_mz_p   /* (O) minimum n size of local array on this processor */
+   ,zloc_mz_p   /* (O) minimum n size of local array on this processor */
+   ,mloc_nz_p   /* (O) minimum m size of local array on this processor */
+   ,nloc_nz_p   /* (O) minimum n size of local array on this processor */
+   ,zloc_nz_p   /* (O) minimum n size of local array on this processor */
+   ;
+{
+
+  int d, nest, state, mlen, nlen, zlen, i, j, k, m, n, z, px, py, px1, py1 ;
+  int result ;
+  int mom ;
+  int kn, km, kp, np ;
+  int was_decomposed ;
+  rsl_domain_info_t *dinfo, *ninfo ;
+  rsl_point_t *domain, *ndomain, *p ;
+  rsl_child_info_t *moms_kids, *my_kids ;
+  int *wrk1, *wrk2 ;
+  rsl_list_t *lp ;
+  int P, my_P ;
+  int l, h, lz, hiz ;
+  int retval ;
+
+  retval = 0 ;
+  d = *d_p ;
+  px = *px_p ;
+  py = *py_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, 
+                "rsl_fdecompose: bad domain descriptor" ) ;
+  dinfo = &( domain_info[d] ) ;
+  RSL_TEST_ERR( dinfo->valid != RSL_VALID,
+                "rsl_fdecompose: invalid domain descriptor" ) ;
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+  zlen = dinfo->len_z ;
+
+/* set the ones that aren't decomposed */
+  *zloc_p = zlen ;
+  *nloc_mz_p = nlen + 2 * rsl_padarea ;
+  *mloc_nz_p = mlen + 2 * rsl_padarea ;
+
+  if ( zlen > 1 ) {
+/* figure out MZ decomp: added 20010222 -- for 3d decomposition for xposes */
+    wrk1 = RSL_MALLOC( int, mlen * zlen ) ;
+    wrk2 = RSL_MALLOC( int, mlen * zlen ) ;
+    domain = dinfo->domain_mz ;
+
+  /* load up input work array with valid points */
+    for ( k = 0 ; k < zlen ; k++ )
+      for ( i = 0 ; i < mlen ; i++ )
+      {
+        if ( domain[ INDEX_2(k,i,mlen) ].valid == RSL_VALID )
+          wrk1[INDEX_2(k,i,mlen)] = RSL_VALID ;
+        else
+          wrk1[INDEX_2(k,i,mlen)] = RSL_INVALID ;
+      }
+
+    m = mlen ; z = zlen ; px1 = px ; py1 = py ;  /* protect variables */
+    result = rsl_default_decomp( wrk1, wrk2, info_p, &m, &z, &px1, &py1 ) ;
+
+    if ( ! result )
+    {
+      /* set the processor numbers of the valid points */
+      l = -1 ; h = -1 ; lz = -1 ; hiz = -1 ;
+      for ( k = 0 ; k < zlen ; k++ ) {
+        for ( i = 0 ; i < mlen ; i++ ) {
+          p = &(domain[ INDEX_2(k,i,mlen) ]) ;
+	  p->valid = RSL_VALID ;
+          p->P = wrk2[INDEX_2(k,i,mlen)] ;
+          if ( rsl_c_comp2phys_proc(p->P) == rsl_myproc ) {
+	    if ( l == -1 ) l = i ;
+	    h = i ;
+	    if ( lz == -1 ) lz = k ;
+	    hiz = k ;
+          }
+        }
+      }
+      *mloc_mz_p = h-l+1 + 2 * rsl_padarea ;
+      *zloc_mz_p = hiz-lz+1 ;
+    }
+
+    RSL_FREE( wrk1 ) ;
+    RSL_FREE( wrk2 ) ;
+
+/* figure out NZ decomp: added 20010222 -- for 3d decomposition for xposes */
+    wrk1 = RSL_MALLOC( int, nlen * zlen ) ;
+    wrk2 = RSL_MALLOC( int, nlen * zlen ) ;
+    domain = dinfo->domain_nz ;
+
+  /* load up input work array with valid points */
+    for ( k = 0 ; k < zlen ; k++ )
+      for ( j = 0 ; j < nlen ; j++ )
+      {
+        if ( domain[ INDEX_2(k,j,nlen) ].valid == RSL_VALID )
+          wrk1[INDEX_2(k,j,nlen)] = RSL_VALID ;
+        else
+          wrk1[INDEX_2(k,j,nlen)] = RSL_INVALID ;
+      }
+
+    n = nlen ; z = zlen ; px1 = px ; py1 = py ;  /* protect variables */
+    result = rsl_default_decomp( wrk1, wrk2, info_p, &n, &z, &px1, &py1 ) ;
+
+    if ( ! result )
+    {
+      /* set the processor numbers of the valid points */
+      l = -1 ; h = -1 ; lz = -1 ; hiz = -1 ;
+      for ( k = 0 ; k < zlen ; k++ ) {
+        for ( j = 0 ; j < nlen ; j++ ) {
+          p = &(domain[ INDEX_2(k,j,nlen) ]) ;
+	  p->valid = RSL_VALID ;
+          p->P = wrk2[INDEX_2(k,j,nlen)] ;
+          if ( rsl_c_comp2phys_proc(p->P) == rsl_myproc ) {
+	    if ( l == -1 ) l = j ;
+	    h = j ;
+	    if ( lz == -1 ) lz = k ;
+	    hiz = k ;
+          }
+        }
+      }
+      *nloc_nz_p = h-l+1 + 2 * rsl_padarea ;
+      *zloc_nz_p = hiz-lz+1 ;
+    }
+
+    RSL_FREE( wrk1 ) ;
+    RSL_FREE( wrk2 ) ;
+
+  }
+/* end of changes for xposes -- 20010222 */
+
+  wrk1 = RSL_MALLOC( int, mlen * nlen ) ;
+  wrk2 = RSL_MALLOC( int, mlen * nlen ) ;
+  domain = dinfo->domain ;
+
+  /* load up input work array with valid points */
+  for ( j = 0 ; j < nlen ; j++ )
+    for ( i = 0 ; i < mlen ; i++ )
+    {
+      if ( domain[ INDEX_2(j,i,mlen) ].valid == RSL_VALID )
+        wrk1[INDEX_2(j,i,mlen)] = RSL_VALID ;
+      else
+        wrk1[INDEX_2(j,i,mlen)] = RSL_INVALID ;
+    }
+
+  if ( fcn != NULL )
+  {
+    m = mlen ; n = nlen ; px1 = px ; py1 = py ;  /* protect variables */
+    result = (*fcn)( wrk1, wrk2, info_p, &m, &n, &py1, &px1 ) ;
+  }
+  else
+  {
+    /* call internal decomposition routine */
+    m = mlen ; n = nlen ; px1 = px ; py1 = py ;  /* protect variables */
+    result = rsl_default_decomp( wrk1, wrk2, info_p, &m, &n, &py1, &px1 ) ;
+  }
+
+
+  if ( result )
+  {
+    if ( dinfo->decomposed )
+    {
+      RSL_TEST_WRN( 1, "RSL_FDECOMPOSE: Decomposition not changed." ) ;
+      return(1) ;
+    }
+    else
+    {
+      RSL_TEST_WRN( 1, "RSL_FDECOMPOSE: method failure -- not decomposed" ) ;
+      return(1) ;
+    }
+  }
+
+  if ( dinfo->decomposed )
+  {
+    /* make a note that there was a previous decomposition and
+       store it in wrk1 for use in figuring out what needs to 
+       be moved to get from the old decomp to the new one */
+    was_decomposed = 1 ;
+    for ( j = 0 ; j < nlen ; j++ )
+    {
+      for ( i = 0 ; i < mlen ; i++ )
+      {
+	wrk1[INDEX_2(j,i,mlen)] = domain[ INDEX_2(j,i,mlen) ].P ;
+      }
+    }
+  }
+
+  destroy_decomposition( d_p ) ;                /* no backing out now */
+
+#ifdef ENABLE_READ_DECOMP
+result = read_domain_decomp ( d, wrk2,  m, n ) ;  /* 20030505 */
+#endif
+
+  for ( P = 0 ; P < RSL_MAXPROC ; P++ )
+  {
+    destroy_list( &(point_move_receives[P]), NULL ) ;
+    destroy_list( &(point_move_sends[P]), NULL ) ;
+  }
+
+  /* set the processor numbers of the valid points */
+  for ( j = 0 ; j < nlen ; j++ )
+  {
+    for ( i = 0 ; i < mlen ; i++ )
+    {
+      if ( wrk2[INDEX_2(j,i,mlen)] != RSL_INVALID )
+      {
+        p = &(domain[ INDEX_2(j,i,mlen) ]) ;
+/* added 5/16/95 */
+/* If a previous decomposition exists, build a list of point moves to each processor */
+	if ( was_decomposed )
+	{
+	  /* figure out the sends */
+	  /* note: wrk1 contains the old decomposition; wrk2 the new one */
+	  if (( rsl_c_comp2phys_proc(wrk1[INDEX_2(j,i,mlen)]) == rsl_myproc))
+	  {
+	    lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+	    lp->info1 = i ;
+	    lp->info2 = j ;
+	    lp->next = point_move_sends[wrk2[INDEX_2(j,i,mlen)]] ;
+            point_move_sends[wrk2[INDEX_2(j,i,mlen)]] = lp ;
+	  }
+	  else
+	  if (( rsl_c_comp2phys_proc(wrk2[INDEX_2(j,i,mlen)] ) == rsl_myproc )) 
+	  {
+	    int idex ;
+
+	    idex = wrk1[INDEX_2(j,i,mlen)] ;
+	    lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+	    lp->info1 = i ;
+	    lp->info2 = j ;
+	    lp->next = point_move_receives[idex] ;
+            point_move_receives[idex] = lp ;
+	  }
+	}
+
+	p->valid = RSL_VALID ;
+        p->P = wrk2[INDEX_2(j,i,mlen)] ;
+        /* if this is a child of point in the next domain up, let the
+	   mother know where the kid is going */
+	if (( mom = p->mother_id ) != RSL_INVALID )
+	{
+	  p->mother_P =
+	    domain_info[ID_DOMAIN(mom)].
+	      domain[INDEX_2(ID_JDEX(mom),
+			     ID_IDEX(mom),
+			     domain_info[ID_DOMAIN(mom)].len_m )].P ;
+	  moms_kids =
+	    domain_info[ID_DOMAIN(mom)].
+	      domain[INDEX_2(ID_JDEX(mom),
+			     ID_IDEX(mom),
+			     domain_info[ID_DOMAIN(mom)].len_m )].children_p ;
+          /* search for me in mom's list -- mom! remember your own kid? */
+	  for ( kn = 0 ; kn < dinfo->irax_n ; kn++ )
+	  {
+	    for ( km = 0 ; km < dinfo->irax_m ; km++ )
+	    {
+	      if ( moms_kids->child[INDEX_2(kn,km,dinfo->irax_m)] ==
+		   POINTID( d, j, i ))
+	      {
+		/* she remembered!
+		   here's my processsor, mom. don't be a stranger, OK?  */
+		moms_kids->P[ INDEX_2(kn,km,dinfo->irax_m) ] = 
+		   domain[ INDEX_2(j,i,mlen) ].P ;
+		break ;
+	      }
+	    }
+	  }
+	}
+#if 0
+	/* added 4/21/95 -- there should never be a point without an
+	   associated mother id at this point in the program */
+	else 
+	{
+	  /* note, the mother domain would not have a parent */
+	  if ( d != 0 )
+	  {
+	    sprintf(mess,"Point %d %d on domain %d has no mother.\n",
+		  i,j,d ) ;
+	    RSL_TEST_ERR(1,mess)
+	  }
+	}
+#endif
+
+        /* this bit informs the children associated with this point
+           that the processor allocation for this point has set */
+	my_P = domain[ INDEX_2(j,i,mlen) ].P ;
+	if (( my_kids = p->children_p ) != NULL )
+	{
+	  /* the the nest id and the nest info for my chidren */
+	  nest = ID_DOMAIN(my_kids->child[0]) ;
+	  ninfo = &(domain_info[nest]) ;
+	  ndomain = ninfo->domain ;
+	  /* */
+	  for ( kp = 0 ; kp < ninfo->irax_n * ninfo->irax_m ; kp++ )
+	  {
+	    np = my_kids->child[kp] ;
+	    ndomain[INDEX_2(ID_JDEX(np),ID_IDEX(np),
+		    domain_info[ID_DOMAIN(np)].len_m )].mother_P = my_P ;
+	  }
+	}
+      }
+    }
+  }
+
+  /* note that this call will set mloc_p and nloc_p, which can then
+     be used by the calling program to allocate buffers of the
+     appropriate size, if desired.  NOTE ALSO, THAT THE EXTRA MEMORY
+     FOR THE PADS IS INCLUDED. */
+  dinfo->decomposed = 1 ;
+  rsl_new_decomposition( d_p, mloc_p, nloc_p ) ;
+
+  /* TODO code to move state vector stuff around needs to be added */
+
+  RSL_FREE( wrk1 ) ;
+  RSL_FREE( wrk2 ) ;
+  return(retval) ;
+}
+
+destroy_decomposition( d_p )
+  int_p d_p ;
+{
+  int d, nest ;
+  int mlen, nlen, i, j, mom, np ;
+  int kn, km, kp ;
+  rsl_domain_info_t *dinfo, *ninfo ;
+  rsl_point_t *domain, *ndomain, *p ;
+  rsl_child_info_t *moms_kids ;
+  rsl_child_info_t *my_kids ;
+  int destroy_runrec() ;
+
+  d = *d_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+                "rsl_fdecompose: bad domain descriptor" ) ;
+  dinfo = &( domain_info[d] ) ;
+  domain = dinfo->domain ;
+  RSL_TEST_ERR( dinfo->valid != RSL_VALID,
+                "rsl_fdecompose: invalid domain descriptor" ) ;
+
+  dinfo->decomposed = 0 ;
+
+  /* uncompile stencils associated with domain */
+  /* note: we aren't getting rid of them, just uncompiling them */
+  for ( i = 0 ; i < dinfo->stencurs ; i++ )
+  {
+    if ( dinfo->stenlist[i] != RSL_INVALID )
+      uncompile_stencil_on_domain( d, sh_descriptors[dinfo->stenlist[i]] ) ;
+  }
+
+  /* TODO uncompile bcast/merges associated with domain */
+
+  mlen = dinfo->len_m ; nlen = dinfo->len_n ;
+
+  for ( j = 0 ; j < nlen ; j++ )
+  {
+    for ( i = 0 ; i < mlen ; i++ )
+    {
+      p = &(domain[ INDEX_2(j,i,mlen) ]) ;
+      p->P = RSL_INVALID ;
+      if ( p->valid )
+      {
+	/* this bit informs the mother domain point associated with this point
+	   that the processor allocation for this point has been invalidated */
+	if (( mom = p->mother_id ) != RSL_INVALID )
+	{
+          moms_kids =
+            domain_info[ID_DOMAIN(mom)].
+              domain[INDEX_2(ID_JDEX(mom),
+                             ID_IDEX(mom),
+                             domain_info[ID_DOMAIN(mom)].len_m )].children_p ;
+          for ( kn = 0 ; kn < dinfo->irax_n ; kn++ )
+          {
+            for ( km = 0 ; km < dinfo->irax_m ; km++ )
+            {
+              if ( moms_kids->child[INDEX_2(kn,km,dinfo->irax_m)] ==
+                   POINTID( d, j, i ))
+              {
+                /*  I've lost my processor, ma.  Goodbye. */
+                moms_kids->P[ INDEX_2(kn,km,dinfo->irax_m) ] = RSL_INVALID ;
+                break ;
+              }
+            }
+          }
+        }
+	/* this bit informs the children associated with this point
+	   that the processor allocation for this point has been invalidated */
+	if (( my_kids = p->children_p ) != NULL )
+	{
+	  /* the the nest id and the nest info for my chidren */
+	  nest = ID_DOMAIN(my_kids->child[0]) ;
+	  ninfo = &(domain_info[nest]) ;
+	  ndomain = ninfo->domain ;
+	  /* */
+	  for ( kp = 0 ; kp < ninfo->irax_n * ninfo->irax_m ; kp++ )
+	  {
+	    np = my_kids->child[kp] ;
+	    ndomain[INDEX_2(ID_JDEX(np),ID_IDEX(np),
+		    domain_info[ID_DOMAIN(np)].len_m )].mother_P = RSL_INVALID ;
+	  }
+	}
+      }
+    }
+  }
+
+  for ( i = 0 ; i < RSL_MAXDOMAINS ; i++ )
+  {
+    domain_info[d].child_bcast_compiled[i] = 0 ;
+    domain_info[d].child_merge_compiled[i] = 0 ;
+  }
+  domain_info[d].parent_bcast_compiled = 0 ;
+  domain_info[d].parent_merge_compiled = 0 ;
+
+/* store for move */
+  domain_info[d].old_ilocaloffset = domain_info[d].ilocaloffset ;
+  domain_info[d].old_jlocaloffset = domain_info[d].jlocaloffset ;
+  domain_info[d].ilocaloffset = RSL_INVALID ;
+  domain_info[d].jlocaloffset = RSL_INVALID ;
+  domain_info[d].loc_m = RSL_INVALID ;
+  domain_info[d].loc_n = RSL_INVALID ;
+  destroy_list( &(domain_info[d].pts), NULL ) ;
+  destroy_list( &(domain_info[d].ghost_pts), NULL ) ;
+  destroy_list( &(domain_info[d].iruns), destroy_runrec ) ;
+  { int p ;
+    for ( p = 0 ; p < MAX_KINDPAD ; p++ )
+    {
+      if ( domain_info[d].js[p] != NULL ) RSL_FREE( domain_info[d].js[p] ) ;
+      if ( domain_info[d].is[p] != NULL ) RSL_FREE( domain_info[d].is[p] ) ;
+      if ( domain_info[d].ie[p] != NULL ) RSL_FREE( domain_info[d].ie[p] ) ;
+      if ( domain_info[d].ie[p] != NULL ) RSL_FREE( domain_info[d].jg2n[p] ) ;
+      domain_info[d].js[p] = NULL ;
+      domain_info[d].is[p] = NULL ;
+      domain_info[d].ie[p] = NULL ;
+      domain_info[d].jg2n[p] = NULL ;
+      if ( domain_info[d].js[p] != NULL ) RSL_FREE( domain_info[d].is2[p] ) ;
+      if ( domain_info[d].is[p] != NULL ) RSL_FREE( domain_info[d].js2[p] ) ;
+      if ( domain_info[d].ie[p] != NULL ) RSL_FREE( domain_info[d].je2[p] ) ;
+      if ( domain_info[d].ie[p] != NULL ) RSL_FREE( domain_info[d].ig2n[p] ) ;
+      domain_info[d].is2[p] = NULL ;
+      domain_info[d].js2[p] = NULL ;
+      domain_info[d].je2[p] = NULL ;
+      domain_info[d].ig2n[p] = NULL ;
+    }
+  }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/default_decomposition.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/default_decomposition.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/default_decomposition.c	(revision 2744)
@@ -0,0 +1,191 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+static struct default_decomp {
+   int (*default_decomp_fcn)() ;
+} default_decomp[RSL_MAXDOMAINS] ;
+static int *def_decomp_info[RSL_MAXDOMAINS] ;
+
+/* this is called from various parts of the code to decompose a
+   domain if it has not been decomposed already */
+default_decomposition( d_p, mloc_p, nloc_p )
+  int_p d_p, mloc_p, nloc_p ;
+{ 
+  int px, py ;
+  int (*f)() ;
+  int retval ;
+  int zloc_p,
+      mloc_mz_p, nloc_mz_p, zloc_mz_p,
+      mloc_nz_p, nloc_nz_p, zloc_nz_p ;
+
+  py = rsl_nproc_m ;
+  px = rsl_nproc_n ;
+
+  f = default_decomp[*d_p].default_decomp_fcn ;
+
+  retval = RSL_FDECOMPOSE (
+          d_p,
+	  f,
+	  &py,
+	  &px,
+	  def_decomp_info[*d_p],
+	  mloc_p, nloc_p, &zloc_p,
+	  &mloc_mz_p, &nloc_mz_p, &zloc_mz_p,
+	  &mloc_nz_p, &nloc_nz_p, &zloc_nz_p ) ;
+
+/* these have been added for the parallel matrix transpose, 20010223.
+   default_decomp is called many places in RSL, and rather than thread
+   all this through, I have opted to just store the additional info
+   from teh decomposition algorithma and store it in the domain info */
+  domain_info[*d_p].loc_m = *mloc_p ;
+  domain_info[*d_p].loc_n = *nloc_p ;
+  domain_info[*d_p].loc_z = zloc_p ;
+  domain_info[*d_p].loc_mz_m = mloc_mz_p ;
+  domain_info[*d_p].loc_mz_n = nloc_mz_p ;
+  domain_info[*d_p].loc_mz_z = zloc_mz_p ;
+  domain_info[*d_p].loc_nz_m = mloc_nz_p ;
+  domain_info[*d_p].loc_nz_n = nloc_nz_p ;
+  domain_info[*d_p].loc_nz_z = zloc_nz_p ;
+
+  return(retval) ;
+}
+
+/*@
+  SET_DEF_DECOMP_FCN --- Replace the default mapping routine.
+
+  This provides a mechanism to replace the mapping function currently
+  in effect with a different routine, specified by the functional
+  pointer Arg1.  This is the routine that will be called by RSL
+  whenever a new domain is created.  The user program can provide
+  additional information to the mapping function using 
+  SET_DEF_DECOMP_INFO.
+
+  Mapping function:
+  The user-supplied function for decomposing the domain should have
+  the following form.
+
+  Verbatim:
+$ INTEGER FUNCTION MAPPING ( in, out, info, m, n, py, px )
+BREAKTHEEXAMPLECODE
+
+  In and out are m by n integer arrays.  Each element of the in array is
+  set to RSL_VALID for valid points in the domain or RSL_INVALID if the
+  point is not considered to be part of the domain and therefore not
+  to be allocated to a processor (as might be the case if extra memory
+  is allocated but not used).  The function generates an out array
+  such that every point that was RSL_VALID in the in array is given
+  a processor number between 0 (zero) and py times px minus 1.  Integers
+  m and n are the in and out array dimensions; integer py is the number
+  of processors decomposing m; integer px is the number of processors
+  decomposing n.
+
+  See also:
+  SET_DEF_DECOMP_INFO
+
+@*/
+SET_DEF_DECOMP_FCN ( f )
+  int 
+    (*f)() ;        /* (I) Function to use as default decomposition. */
+{
+  int i ;
+
+  for ( i = 0 ; i < RSL_MAXDOMAINS ; i++ )
+    default_decomp[i].default_decomp_fcn = f ;
+}
+
+SET_DEF_DECOMP_FCN1 ( d_p, f )
+  int_p d_p ;
+  int
+    (*f)() ;        /* (I) Function to use as default decomposition. */
+{
+  int i ;
+  int d ;
+
+  d = *d_p ;
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "rsl_compile_stencil: bad domain descriptor" ) ;
+  default_decomp[*d_p].default_decomp_fcn = f ;
+}
+
+
+/*@
+  SET_DEF_DECOMP_INFO --- Provide data to RSL to pass to the mapping routine.
+
+  Notes:
+  When RSL calls the default mapping function, the data provided as Arg2
+  will be passed as the third argument to the function.  This provides
+  mechanism for moving data such as timing information from the user program
+  to the mapping routine for use in calculating the domain decomposition.
+
+  See also:
+  SET_DEF_DECOMP_FCN
+
+
+@*/
+SET_DEF_DECOMP_INFO ( d_p, inf )
+  int_p 
+      d_p ;    /* (I) RSL domain descriptor */
+  void *
+      inf ;    /* (I) Pointer to memory that will be passed as-is to the decomposition routine */
+{
+  def_decomp_info[*d_p] = (int_p) inf ;
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/destroy_list.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/destroy_list.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/destroy_list.c	(revision 2744)
@@ -0,0 +1,104 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* traverse a list and free up nodes */
+
+#if 0
+destroy_list( list, dfcn )
+  rsl_list_t ** list ;		/* pointer to pointer to list */
+  int (*dfcn)() ;		/* pointer to function for destroying
+				   the data field of the list */
+{
+  if ( list == NULL ) return ;
+  if ( *list == NULL ) return ;
+
+  if ( dfcn != NULL ) (*dfcn)( (*list)->data ) ;
+
+  destroy_list( &((*list)->next), dfcn ) ;
+
+  RSL_FREE( (*list) ) ;
+
+  *list = NULL ;
+
+  return(0) ;
+
+}
+#else
+
+destroy_list( list, dfcn )
+  rsl_list_t ** list ;		/* pointer to pointer to list */
+  int (*dfcn)() ;		/* pointer to function for destroying
+				   the data field of the list */
+{
+  rsl_list_t *p, *trash ;
+  if ( list == NULL ) return(0) ;
+  if ( *list == NULL ) return(0) ;
+  for ( p = *list ; p != NULL ; )
+  {
+    if ( dfcn != NULL ) (*dfcn)( p->data ) ;
+    trash = p ;
+    p = p->next ;
+    RSL_FREE( trash ) ;
+  }
+  *list = NULL ;
+  return(0) ;
+}
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/domain_def.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/domain_def.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/domain_def.c	(revision 2744)
@@ -0,0 +1,1675 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+#define SOUTH RSL_MLOW
+#define NORTH RSL_MHIGH
+#define WEST  RSL_NLOW
+#define EAST  RSL_NHIGH
+
+static int debuggal_mine = 0 ;
+
+/*@
+  RSL_MOTHER_DOMAIN - Define the topmost domain.
+
+  Notes:
+  This routine defines the principal, top-level domain of the model.
+
+  As input, the routine takes Arg2, a specifier for the largest stencil that
+  will be used.  It may be one of
+  
+  Verbatim:
+  
+$    RSL_4PT,
+$    RSL_8PT,
+$    RSL_12PT,
+$    RSL_24PT, or
+$    RSL_168PT.
+
+BREAKTHEEXAMPLECODE
+  It also takes Arg3 and Arg4, the
+  logical (undecomposed) dimensions of the domain, m and n.
+
+  Output is Arg1, a domain descriptor, a
+  handle to RSL's definition of the domain, and Arg5 and Arg6,
+  minimum local sizes
+  for array dimensions on the local processor.  These values can be used
+  to allocate local arrays in models that use dynamic memory allocation.
+  Models that allocate memory
+  statically may use these values as a check to be sure that enough
+  memory has been allocated.
+
+  RSL must have been initialized and a processor mesh specified
+  before a domain is defined.
+
+  Example:
+
+$  INCLUDE 'rsl.inc'
+$  INTEGER D
+$  INTEGER MLEN, NLEN
+$  --
+$  CALL RSL_INITIALIZE
+$  CALL RSL_MESH(2, 2)
+$  CALL RSL_MOTHER_DOMAIN(D,RSL_8PT,25,30,MLEN,NLEN)
+
+BREAKTHEEXAMPLECODE
+  This declares a 25 by 30 element domain.
+  The
+  integer d contains a domain descriptor, which will
+  be used in all subsequent operations involving the domain.
+
+  See also:
+  RSL_INITIALIZE, RSL_SPAWN_REGULAR_NEST
+
+@*/
+int
+RSL_MOTHER_DOMAIN ( domain_p, maskid_p, mlen_p, nlen_p, mloc_p, nloc_p )
+  int_p
+    domain_p        /* (O)  Domain id. */
+   ,maskid_p        /* (I)  Id of maximum stencil for this domain. */
+   ,mlen_p          /* (I)  Number of cells in m dimension of domain. */
+   ,nlen_p          /* (I)  Number of cells in n dimension of domain. */
+   ,mloc_p          /* (O)  Required size of local memory in m. */
+   ,nloc_p          /* (O)  Required size of local memory in n. */
+    ;
+{
+  rsl_index_t i, j, k ;
+  int  d ;
+  rsl_dimlen_t nmax ;
+  rsl_dimlen_t mmax ;
+  rsl_dimlen_t zmax ;
+  int mmin, nmin, mtrim, ntrim ;
+
+  mmax = *mlen_p ;
+  nmax = *nlen_p ;
+  zmax = 1 ;  /* trivial */
+  GET_NEXT_DOMAIN_DESCRIPTOR ( &d ) ; ;
+  *domain_p = d ;
+
+  RSL_TEST_ERR( domain_info[d].valid == RSL_VALID,
+     "rsl_mother_domain() called more than once" ) ;
+
+  domain_info[d].nest_level = 0 ;
+  domain_info[d].maskid     = *maskid_p ;
+  domain_info[d].trim_m     = 0 ;
+  domain_info[d].trim_n     = 0 ;
+
+  rsl_c_initialize_domain( d, nmax, mmax, zmax, nmax, mmax, zmax ) ;
+
+  mtrim = domain_info[d].trim_m ;
+  ntrim = domain_info[d].trim_n ;
+
+  for ( j = 0 ; j < nmax ; j++ ) for ( i = 0 ; i < mmax ; i++ )
+    { /* all points valid on mother domain -- always rectangular */
+      domain_info[d].domain[INDEX_2(j,i,mmax)].valid = RSL_VALID ;
+      domain_info[d].domain[INDEX_2(j,i,mmax)].trimmed = 0 ; }
+
+  for ( k = 0 ; k < zmax ; k++ ) for ( i = 0 ; i < mmax ; i++ )
+    { /* all points valid on mother domain -- always rectangular */
+      domain_info[d].domain_mz[INDEX_2(k,i,mmax)].valid = RSL_VALID ; }
+
+  for ( k = 0 ; k < zmax ; k++ ) for ( j = 0 ; j < nmax ; j++ )
+    { /* all points valid on mother domain -- always rectangular */
+      domain_info[d].domain_nz[INDEX_2(k,j,nmax)].valid = RSL_VALID ; }
+
+  trim_domain( domain_info[d].domain, mmax, nmax, 0, 0 ) ;
+
+  work_out_bdy( domain_info[d].domain, mmax, nmax ) ;
+
+  {
+/* moved here, 4/21/95 --- see comment in spawn nest below */
+    int dd ;
+    dd = d ;
+    default_decomposition( &dd,
+                           mloc_p,
+                           nloc_p ) ;
+  }
+
+  rsl_ndomains = 1 ;
+  return(0) ;
+}
+
+/* (20010222) */
+RSL_MOTHER_DOMAIN3D( domain_p, maskid_p, mlen_p, nlen_p, zlen_p, 
+                                         mloc_p, nloc_p, zloc_p,
+                                         mloc_mz_p, nloc_mz_p , zloc_mz_p,
+                                         mloc_nz_p, nloc_nz_p , zloc_nz_p )
+  int_p
+    domain_p        /* (O)  Domain id. */
+   ,maskid_p        /* (I)  Id of maximum stencil for this domain. */
+   ,mlen_p          /* (I)  Number of cells in m dimension of domain. */
+   ,nlen_p          /* (I)  Number of cells in n dimension of domain. */
+   ,zlen_p          /* (I)  Number of cells in z dimension of domain. */
+   ,mloc_p          /* (O)  Required size of local memory in m. (MN decomp) */
+   ,nloc_p          /* (O)  Required size of local memory in n.      "      */
+   ,zloc_p          /* (O)  Required size of local memory in z.      "      */
+   ,mloc_mz_p       /* (O)  Required size of local memory in m. (MZ decomp) */
+   ,nloc_mz_p       /* (O)  Required size of local memory in n.      "      */
+   ,zloc_mz_p       /* (O)  Required size of local memory in z.      "      */
+   ,mloc_nz_p       /* (O)  Required size of local memory in m. (NZ decomp) */
+   ,nloc_nz_p       /* (O)  Required size of local memory in n.      "      */
+   ,zloc_nz_p       /* (O)  Required size of local memory in z.      "      */
+    ;
+{
+
+  rsl_index_t i, j, k ;
+  int  d ;
+  rsl_dimlen_t nmax ;
+  rsl_dimlen_t mmax ;
+  rsl_dimlen_t zmax ;
+  int mmin, nmin, mtrim, ntrim ;
+
+  mmax = *mlen_p ;
+  nmax = *nlen_p ;
+  zmax = *zlen_p ;
+  GET_NEXT_DOMAIN_DESCRIPTOR ( &d ) ;
+  *domain_p = d ;
+
+  RSL_TEST_ERR( domain_info[d].valid == RSL_VALID,
+     "rsl_mother_domain() called more than once" ) ;
+
+  if ( domain_info[d].domain_mz != NULL ) { RSL_FREE( domain_info[d].domain_mz ) ; }
+  if ( domain_info[d].domain_nz != NULL ) { RSL_FREE( domain_info[d].domain_nz ) ; }
+
+
+  domain_info[d].nest_level = 0 ;
+  domain_info[d].maskid     = *maskid_p ;
+  domain_info[d].trim_m     = 0 ;
+  domain_info[d].trim_n     = 0 ;
+
+  rsl_c_initialize_domain( d, nmax, mmax, zmax, nmax, mmax, zmax ) ;
+
+  mtrim = domain_info[d].trim_m ;
+  ntrim = domain_info[d].trim_n ;
+
+  for ( j = 0 ; j < nmax ; j++ ) for ( i = 0 ; i < mmax ; i++ )
+    { /* all points valid on mother domain -- always rectangular */
+      domain_info[d].domain[INDEX_2(j,i,mmax)].valid = RSL_VALID ;
+      domain_info[d].domain[INDEX_2(j,i,mmax)].trimmed = 0 ; }
+
+  for ( k = 0 ; k < zmax ; k++ ) for ( i = 0 ; i < mmax ; i++ )
+    { /* all points valid on mother domain -- always rectangular */
+      domain_info[d].domain_mz[INDEX_2(k,i,mmax)].valid = RSL_VALID ; }
+
+  for ( k = 0 ; k < zmax ; k++ ) for ( j = 0 ; j < nmax ; j++ )
+    { /* all points valid on mother domain -- always rectangular */
+      domain_info[d].domain_nz[INDEX_2(k,j,nmax)].valid = RSL_VALID ; }
+
+  trim_domain( domain_info[d].domain, mmax, nmax, 0, 0 ) ;
+
+  work_out_bdy( domain_info[d].domain, mmax, nmax ) ;
+
+  {
+/* moved here, 4/21/95 --- see comment in spawn nest below */
+    int dd ;
+    dd = d ;
+    default_decomposition( &dd,
+                           mloc_p,
+                           nloc_p ) ;
+  }
+
+/* these are set by the revised default_decomposition routine (20010223) */
+
+  *zloc_p    = domain_info[d].loc_z ;
+  *mloc_mz_p = domain_info[d].loc_mz_m ;
+  *nloc_mz_p = domain_info[d].loc_mz_n ;
+  *zloc_mz_p = domain_info[d].loc_mz_z ;
+  *mloc_nz_p = domain_info[d].loc_nz_m ;
+  *nloc_nz_p = domain_info[d].loc_nz_n ;
+  *zloc_nz_p = domain_info[d].loc_nz_z ;
+
+  rsl_ndomains = 1 ;
+
+}
+
+/*
+   rsl_c_initialize_domain
+
+   Initializes a domain descriptor.
+
+   For a mother domain the actual and effective sizes will be the same.
+
+   For a nest, they may differ.   This is because the nest must always
+   be a multiple of IRAX wide, but may not compute over all of that.
+
+*/
+int
+rsl_c_initialize_domain ( d, nmax, mmax, zmax, neff, meff, zeff )
+  rsl_index_t d ;
+  rsl_dimlen_t nmax, mmax, zmax ;   /* actual size definition */
+  rsl_dimlen_t neff, meff, zeff ;   /* effective size definition (for computing) */
+{
+  rsl_index_t i, j, k ;
+  rsl_point_t *p ;
+
+#if 0
+  fprintf(stderr,"1> rsl_c_initialize_domain d = %d\n",d ) ;
+  fprintf(stderr,"                    nmax     = %d\n",nmax ) ;
+  fprintf(stderr,"                    mmax     = %d\n",mmax ) ;
+  fprintf(stderr,"                    neff     = %d\n",neff ) ;
+  fprintf(stderr,"                    meff     = %d\n",meff ) ;
+#endif
+
+  domain_info[d].pts = NULL ;
+  domain_info[d].ghost_pts = NULL ;
+  domain_info[d].iruns = NULL ;
+  domain_info[d].len_n = nmax ;
+  domain_info[d].len_m = mmax ;
+  domain_info[d].len_z = zmax ;
+  domain_info[d].eff_n = neff ;
+  domain_info[d].eff_m = meff ;
+  domain_info[d].eff_z = zeff ;
+  domain_info[d].coord_n = RSL_INVALID ;
+  domain_info[d].coord_m = RSL_INVALID ;
+
+#if 0
+  fprintf(stderr,"2> rsl_c_initialize_domain d = %d\n",d ) ;
+  fprintf(stderr,"                    nmax     = %d\n",nmax ) ;
+  fprintf(stderr,"                    mmax     = %d\n",mmax ) ;
+  fprintf(stderr,"                    zmax     = %d\n",zmax ) ;
+  fprintf(stderr,"                    neff     = %d\n",neff ) ;
+  fprintf(stderr,"                    meff     = %d\n",meff ) ;
+#endif
+
+  if ( domain_info[d].domain != NULL )    { RSL_FREE( domain_info[d].domain ) ; }
+  if ( domain_info[d].domain_mz != NULL ) { RSL_FREE( domain_info[d].domain_mz ) ; }
+  if ( domain_info[d].domain_nz != NULL ) { RSL_FREE( domain_info[d].domain_nz ) ; }
+
+  domain_info[d].domain    = RSL_MALLOC(rsl_point_t,(nmax*mmax)) ;
+  domain_info[d].domain_nz = RSL_MALLOC(rsl_point_t,(nmax*zmax)) ;
+  domain_info[d].domain_mz = RSL_MALLOC(rsl_point_t,(mmax*zmax)) ;
+
+  domain_info[d].valid = RSL_VALID ;
+  domain_info[d].decomposed = 0 ;
+  domain_info[d].trim_m = 0 ;
+  domain_info[d].trim_n = 0 ;
+
+  for ( j = 0 ; j < nmax ; j++ )
+  {
+    for ( i = 0 ; i < mmax ; i++ )
+    {
+  
+      p = &(domain_info[d].domain[ INDEX_2(j,i,mmax) ]) ;
+      p->dbdy = RSL_INVALID ;
+      p->P           = RSL_INVALID ;
+      p->valid       = RSL_INVALID ;
+      p->trimmed     = RSL_INVALID ;
+      p->id          = POINTID( d, j, i ) ;
+      p->info_1      = RSL_INVALID ;
+      p->info_2      = RSL_INVALID ;
+      p->mother_id   = RSL_INVALID ;
+      p->which_kid_am_i_m   = RSL_INVALID ;
+      p->which_kid_am_i_n   = RSL_INVALID ;
+      if ( p->children_p != NULL ) 
+      {
+        RSL_FREE( p->children_p ) ;
+      }
+      p->dbdy = RSL_INVALID ;
+      p->bdy_cclockwise = RSL_INVALID ;
+      p->bdy_clockwise = RSL_INVALID ;
+      p->dbdy_x = RSL_INVALID ;
+      p->bdy_x_cclockwise = RSL_INVALID ;
+      p->bdy_x_clockwise = RSL_INVALID ;
+    }
+  }
+
+
+  for ( i = 0 ; i < RSL_MAXDESCRIPTORS ; i++ )
+  {
+    domain_info[d].stenlist[i] = RSL_INVALID ;
+  }
+  for ( i = 0 ; i < RSL_MAXDOMAINS ; i++ )
+  {
+    domain_info[d].child_bcast_compiled[i] = 0 ;
+    domain_info[d].child_merge_compiled[i] = 0 ;
+  }
+  domain_info[d].parent_bcast_compiled = 0 ;
+  domain_info[d].parent_merge_compiled = 0 ;
+  domain_info[d].stencurs = 0 ;
+  domain_info[d].periodcurs = 0 ;
+  domain_info[d].xposecurs = 0 ;
+
+  return(0);
+}
+
+/*@
+  RSL_SPAWN_REGULAR_NEST - Spawn a domain using coarse domain dimensions. 
+
+  Notes:
+  This routine spawns a rectangular nest in an existing domain whose
+  descriptor is provided as Arg2.  The newly defined domain descriptor
+  is returned as Arg1.
+
+  The argument Arg3 specifies the maximum stencil that will be used on
+  the domain and may be one of
+
+  Verbatim:
+$    RSL_4PT,
+$    RSL_8PT,
+$    RSL_12PT,
+$    RSL_24PT, or
+$    RSL_168PT.
+
+BREAKTHEEXAMPLECODE
+
+  These are defined in the file rsl.inc.
+  For efficiency, choose the smallest.  Arg4 and Arg5 are the coordinates
+  of the south-west corner of the nest in the parent domain.  The
+  arguments Arg6 and Arg7 are the dimensions of the parent domain area
+  under which the nest is being defined.  In other words, the nest
+  dimensions are specified in parent domain units
+  (RSL_SPAWN_REGULAR_NEST1 allows specification of the nest dimensions
+  in nest units).  The Arg8 and Arg9 are the nesting ratios in M and N
+  respectively; these are the number of nest cells per parent cell in
+  each dimension (e.g. 3, as in MM5.) The Arg10 and Arg11 arguments are
+  trim arguments for adjusting a logical (undecomposed) dimension of
+  the nest from other than a multiple of the number of parent domain
+  cells in the dimension.
+
+  On return, Arg12 and Arg13 are set to the minimum local dimensions that
+  will be required for model arrays on the processor.  This also includes
+  additional memory for ghost points around the local processor partition
+  (the amount allocated will depend on the stencil specified by Arg3).
+  The Arg14 and Arg15 arguments will be set to the effective undecomposed
+  dimensions, after trimming.
+
+  Example:
+
+$   IPOS = 15 ; JPOS = 20     ! position of nest sw corner
+$   IDIM = 7  ; JDIM = 10     ! dimensions of nested region in parent
+$   BTRIM = 2                 ! trimming for MM5 nesting w/ Arakawa B-grid
+$   IRAX = 3                  ! nesting ratio
+$   CALL RSL_SPAWN_REGULAR_NEST( NEST%RSL_ID, PARENT%RSL_ID, RSL_24PT,
+$  +                             IPOS, JPOS, IDIM, JDIM,
+$  +                             IRAX, IRAX,
+$  +                             BTRIM, BTRIM,
+$  +                             MLOC, NLOC, M, N )
+$ C
+$ C Use size info returned by RSL to allocate 2-d and 3-d domain data
+$ C structures for nest.
+$ C
+$   NLEV = 25                 ! number vert. levels
+$   ALLOCATE( NEST\%UA(MLOC,NLOC,NLEV) )   ! ew wind
+$   ALLOCATE( NEST\%VA(MLOC,NLOC,NLEV) )   ! ns wind
+$   ALLOCATE( NEST\%TA(MLOC,NLOC,NLEV) )   ! ns wind
+$   ALLOCATE( NEST\%PS(MLOC,NLOC) )        ! surface pres
+$   ...
+
+BREAKTHEEXAMPLECODE
+
+  A rectangular nest is spawned within a 7-cell by 10-cell region of a
+  parent domain.  The southwest corner of the nest is positioned under
+  parent cell (15,20).  A 24-point stencil is the largest that will be used
+  on the nest.  There are 3 nest cells per parent cell in both
+  horizontal dimensions; thus the total nest size is 21 by 30 cells.
+  However, we wish to follow a rule (used in MM5) that nest dimensions
+  must always be one greater than a multiple of the nesting ratio to
+  accounts for the staggering of dot and cross grids on the parent and
+  nest.  Therefore, we trim two points from the northern and eastern
+  edges of the nest; the result is effective nest dimensions of 19 by
+  28, the values returned in m and n respectively.  In the example,
+  return values mloc and nloc are used in subsequent Fortran90 allocate
+  statements to size the local state arrays for the nest.
+
+  See also:
+  RSL_INITIALIZE, RSL_MOTHER_DOMAIN, RSL_SPAWN_REGULAR_NEST1
+
+@*/
+
+RSL_SPAWN_REGULAR_NEST ( n_p, d_p, maskid_p, sw_min_p,  sw_maj_p, dim_min_p, dim_maj_p, irax_m_p,  irax_n_p, mtrim_p, ntrim_p, mloc_p, nloc_p, mlen_p, nlen_p )
+  int_p 
+    n_p             /* (O) Handle to nested domain. */
+   ,d_p             /* (I) Handle to parent domain. */
+   ,maskid_p        /* (I) Id of maximum stencil for this domain. */
+   ,sw_min_p        /* (I) M coord in mother domain of sw of nest.*/
+   ,sw_maj_p        /* (I) N coord in mother domain of sw of nest.*/
+   ,dim_min_p       /* (I) M dimension of nest.  */
+   ,dim_maj_p       /* (I) N dimension of nest.  */
+   ,mtrim_p         /* (I) M trim. */
+   ,ntrim_p         /* (I) N trip. */
+   ,irax_m_p        /* (I) Nesting ratio in M dimension. */
+   ,irax_n_p ;      /* (I) Nesting ration in n dimension. */
+  int_p
+    mloc_p          /* (O) Minimum local array size in M. */
+   ,nloc_p ;        /* (O) Minimum local array size in N. */
+  int_p
+    mlen_p          /* (O) Undecomposed size of M. */
+   ,nlen_p ;        /* (O) Undecomposed size of N. */
+{
+rsl_c_spawn_regnest( n_p, d_p, maskid_p, sw_min_p, sw_maj_p,
+                     dim_min_p, dim_maj_p,
+                     irax_m_p, irax_n_p,
+		     mtrim_p, ntrim_p,
+                     mloc_p, nloc_p,
+                     mlen_p, nlen_p, 1 ) ;
+}
+
+/*@
+  RSL_SPAWN_REGULAR_NEST1 - Spawn a domain using nested domain dimensions. 
+
+  Notes:
+  This routine spawns a rectangular nest in an existing domain whose
+  descriptor is provided as Arg2.  The newly defined domain descriptor
+  is returned as Arg1.
+
+  The argument Arg3 specifies the maximum stencil that will be used on
+  the domain and may be one of
+
+  Verbatim:
+$    RSL_4PT,
+$    RSL_8PT,
+$    RSL_12PT,
+$    RSL_24PT, or
+$    RSL_168PT.
+
+BREAKTHEEXAMPLECODE
+
+  These are defined in the file rsl.inc.
+  For efficiency, choose the smallest.
+  Arg4 and Arg5 are the coordinates of the south-west corner of the nest in
+  the parent domain.
+  The arguments Arg6 and Arg7 are the dimensions of the nest.
+  (RSL_SPAWN_REGULAR_NEST allows
+  specification of the nest dimensions in terms of the parent grid).
+  The Arg8 and Arg9 are the nesting ratios in M and N respectively; these
+  are the number of nest cells per parent cell in each dimension (e.g. 3, as
+  in MM5.)
+
+  On return, Arg10 and Arg11 are set to the minimum local dimensions that
+  will be required for model arrays on the processor.  This also includes
+  additional memory for ghost points around the local processor partition
+  (the amount allocated will depend on the stencil specified by Arg3).
+  The Arg12 and Arg13 arguments will be set to the effective undecomposed
+  dimensions.
+
+  Example:
+
+$   IPOS = 15 ; JPOS = 20     ! position of nest sw corner
+$   IDIM = 19 ; JDIM = 28     ! dimensions of nest
+$   IRAX = 3                  ! nesting ratio
+$   CALL RSL_SPAWN_REGULAR_NEST1( NEST%RSL_ID, PARENT%RSL_ID, RSL_24PT,
+$  +                              IPOS, JPOS, IDIM, JDIM,
+$  +                              IRAX, IRAX,
+$  +                              MLOC, NLOC, M, N )
+$ C
+$ C Use size info returned by RSL to allocate 2-d and 3-d domain data
+$ C structures for nest.
+$ C
+$   NLEV = 25                 ! number vert. levels
+$   ALLOCATE( NEST\%UA(MLOC,NLOC,NLEV) )   ! ew wind
+$   ALLOCATE( NEST\%VA(MLOC,NLOC,NLEV) )   ! ns wind
+$   ALLOCATE( NEST\%TA(MLOC,NLOC,NLEV) )   ! ns wind
+$   ALLOCATE( NEST\%PS(MLOC,NLOC) )        ! surface pres
+$   ...
+
+BREAKTHEEXAMPLECODE
+
+  A rectangular 19 by 28 cell nest is spawned an located with its
+  southwest corner at point (15,20) in the parent domain.  A 24-point
+  stencil is the largest that will be used on the nest.  There are 3
+  nest cells per parent cell in both horizontal dimensions.  In the
+  example, return values mloc and nloc are used in subsequent Fortran90
+  allocate statements to size the local state arrays for the nest.
+
+  See also:
+  RSL_INITIALIZE, RSL_MOTHER_DOMAIN, RSL_SPAWN_REGULAR_NEST
+
+@*/
+RSL_SPAWN_REGULAR_NEST1 ( n_p, d_p, maskid_p,
+                          sw_min_p,  sw_maj_p,
+                          dim_min_p, dim_maj_p,
+                          irax_m_p,  irax_n_p,
+                          mloc_p, nloc_p, mlen_p, nlen_p ) 
+  int_p 
+    n_p,            /* (O) Handle to nested domain. */
+    d_p,            /* (I) Handle to parent domain. */
+    maskid_p,       /* (I) Id of maximum stencil for this domain. */
+    sw_min_p,       /* (I) M coord in mother domain of sw of nest. */
+    sw_maj_p,       /* (I) N coord in mother domain of sw of nest. */
+    dim_min_p,      /* (I) M dimension of nest. */
+    dim_maj_p,      /* (I) N dimension of nest. */
+    irax_m_p,       /* (I) Nesting ratio in M dimension.*/
+    irax_n_p ;      /* (I) Nesting ratio in N dimension.*/
+  int_p
+    mloc_p,         /* (O) Minimum local array size in M. */
+    nloc_p ;        /* (O) Minimum local array size in N. */
+  int_p
+    mlen_p,         /* (O) Undecomposed size of M. */
+    nlen_p ;        /* (O) Undecomposed size of N. */
+{
+int dummy ;
+rsl_c_spawn_regnest( n_p, d_p, maskid_p, sw_min_p, sw_maj_p,
+                     dim_min_p, dim_maj_p,
+                     irax_m_p, irax_n_p,
+		     &dummy, &dummy,	/* not needed when using n.d. coords */
+                     mloc_p, nloc_p,  
+                     mlen_p, nlen_p, 0 ) ;
+}
+
+rsl_c_spawn_regnest( n_p, d_p, maskid_p,
+                     sw_min_p, sw_maj_p,
+                     dim_min_p, dim_maj_p,
+                     irax_m_p, irax_n_p,
+		     mtrim_p, ntrim_p,
+                     mloc_p, nloc_p, 
+                     mlen_p, nlen_p, sw )
+  int_p n_p,            /* handle to nested domain */
+        d_p,            /* handle to mother domain */
+        maskid_p,       /* Input.   Id of maximum stencil for this domain. */
+        sw_min_p,       /* coordinates in mother domain of sw corner of nest */
+        sw_maj_p,       /* <MM: sw_min is i (n/s), sw_maj is j (e/w) */
+        dim_min_p,
+        dim_maj_p,
+	mtrim_p, ntrim_p,
+        irax_m_p,       /* nesting ratio in m dimension */
+        irax_n_p ;      /* nesting ration in n dimension */
+  int   sw ;            /* switch: if 1, dims are specified in c.d. coords
+                           if 0, dims are specified in n.d. coords. */
+  int_p mloc_p, nloc_p ;/* local memory needs */
+  int_p mlen_p, nlen_p ;/* resulting effective global dimensions of nest */
+{
+  int c ;
+  rsl_index_t i, j, in, jn ;
+  rsl_index_t d ;               /* number of mother domain */
+  rsl_index_t nest ;            /* number of nest domain */
+  rsl_index_t im,ime ;  /* coordinate of first/last in mother domain */
+  rsl_index_t jm,jme ;  /* coordinate of first/last in mother domain */
+  rsl_dimlen_t len_n ;  /* mother domain length of nested dimension */
+  rsl_dimlen_t len_m ;  /* mother domain length of nested dimension */
+  rsl_dimlen_t nlen_n ; /* number of cells in nested dimension */
+  rsl_dimlen_t nlen_m ; /* number of cells in nested dimension */
+  rsl_dimlen_t elen_n ; /* effective number of cells in nested dimension */
+  rsl_dimlen_t elen_m ; /* effective number of cells in nested dimension */
+  int irax_m, irax_n ;
+  int mtrim, ntrim ;
+
+  int xlist[4], ylist[4] ;      /* point lists */
+  int nlistpoints ;
+
+  d = *d_p ;
+  im = *sw_min_p - 1 ;  /* note conversion to C coords (0..n-1) */
+  jm = *sw_maj_p - 1 ;
+  irax_m = *irax_m_p ;
+  irax_n = *irax_n_p ;
+  mtrim = *mtrim_p ;	/* this is only used if sw == 1 */
+  ntrim = *ntrim_p ;	/* this is only used if sw == 1 */
+
+  if ( sw == 0 )        /* dims are specified in n.d. coords. */
+  {
+    elen_m = *dim_min_p ;
+    elen_n = *dim_maj_p ;
+    len_m = (elen_m+irax_m-1) / irax_m ;
+    len_n = (elen_n+irax_n-1) / irax_n ;
+    nlen_m = len_m*irax_m ;
+    nlen_n = len_n*irax_n ;
+    ime = im + len_m - 1 ;
+    jme = jm + len_n - 1 ;
+
+    mtrim = ((len_m*irax_m-elen_m)>0)?(len_m*irax_m-elen_m):0 ;
+    ntrim = ((len_n*irax_n-elen_n)>0)?(len_n*irax_n-elen_n):0 ;
+
+  }
+  else          /* default: dims are specified in c.d. coords */
+  {
+    len_m = *dim_min_p ;
+    len_n = *dim_maj_p ;
+    nlen_m = len_m * irax_m ;
+    nlen_n = len_n * irax_n ;
+    elen_m = nlen_m ;
+    elen_n = nlen_n ;
+    ime = im + len_m - 1 ;
+    jme = jm + len_n - 1 ;
+  }
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, "invalid domain index") ;
+  RSL_TEST_ERR( im < 0 || im >= domain_info[d].len_m || 
+                jm < 0 || jm >= domain_info[d].len_n || 
+                ime < 0 || ime>= domain_info[d].len_m || 
+                jme< 0 || jme>= domain_info[d].len_n , 
+                     "nested domain won't fit in mother domain" ) ;
+
+  /* set the four corners of the nest in c.d. coordinates */
+  xlist[0] = jm   ; ylist[0] = im  ;
+  xlist[1] = jm   ; ylist[1] = ime ;
+  xlist[2] = jme  ; ylist[2] = ime ;
+  xlist[3] = jme  ; ylist[3] = im  ;
+  nlistpoints = 4 ;
+
+  rsl_spawn_nest ( n_p, d_p, maskid_p, xlist, ylist, &nlistpoints,
+                   &mtrim, &ntrim,
+                   irax_m_p, irax_n_p,
+                   mloc_p, nloc_p, mlen_p, nlen_p ) ;
+
+  domain_info[*n_p].nestshape = RSL_REGULAR_NEST ;
+  domain_info[*n_p].eff_m = elen_m ;
+  domain_info[*n_p].eff_n = elen_n ;
+  domain_info[*n_p].trim_m = mtrim ;
+  domain_info[*n_p].trim_n = ntrim ;
+
+}
+
+/*@
+  RSL_SPAWN_IRREG_NEST - Spawn a non-rectangular nest.
+
+  Notes:
+  This routine spawns an irregularly shaped nest in an existing domain whose
+  descriptor is provided as Arg2.  The newly defined domain descriptor
+  is returned as Arg1.
+
+  The argument Arg3 specifies the maximum stencil that will be used on
+  the domain and may be one of
+
+  Verbatim:
+$    RSL_4PT,
+$    RSL_8PT,
+$    RSL_12PT,
+$    RSL_24PT, or
+$    RSL_168PT.
+
+BREAKTHEEXAMPLECODE
+
+  These are defined in the file rsl.inc.
+  that will be used on the domain.  For efficiency, choose the smallest.
+
+  The shape of the irregular nest is specified by listing the nodes (corners)
+  of the polygon.  The corner vertices are specified by their parent domain
+  coordinates.  The M coordinates of the vertices are given by the array Arg4.
+  the N coordinates are given by Arg5.  Arg6 gives the number of vertices.
+
+  The Arg7 and Arg8 are the nesting ratios in M and N respectively; these
+  are the number of nest cells per parent cell in each dimension (e.g. 3
+  in MM5.)
+  The Arg9 and Arg10 arguments are trim arguments for adjusting a
+  logical (undecomposed) dimension of the nest from other than a multiple
+  of the number of parent domain cells in the dimension.
+
+  On return, Arg11 and Arg12 are set to the minimum local dimensions that
+  will be required for model arrays on the processor.  This is always
+  rectangular, even though the local processor partition may not be.
+  This also includes
+  additional memory for ghost points around the local processor partition
+  (the amount allocated will depend on the stencil specified by Arg3).
+  The Arg13 and Arg14 arguments will be set to the effective undecomposed
+  dimensions of the rectangle enclosing the irregularly shaped nest.
+
+  Example:
+
+$ C
+$ C Irregular nest outline specified by listing the vertices
+$ C of the polygonal domain.  These are parent domain coordinates.
+$ C
+$   ILIST( 1) = 15 ; JLIST( 1) =        18
+$   ILIST( 2) = 10 ; JLIST( 2) =        20
+$   ILIST( 3) = 10 ; JLIST( 3) =        27
+$   ILIST( 4) = 15 ; JLIST( 4) =        27
+$   ILIST( 5) = 20 ; JLIST( 5) =        32
+$   ILIST( 6) = 20 ; JLIST( 6) =        54
+$   ILIST( 7) = 39 ; JLIST( 7) =        54
+$   ILIST( 8) = 39 ; JLIST( 8) =        31
+$   ILIST( 9) = 26 ; JLIST( 9) =        18
+$   NVX = 9                   ! Number of vertices in polygon.
+$   BTRIM = 2                 ! trimming for MM5 nesting w/ Arakawa B-grid
+$   IRAX = 3                  ! nesting ratio
+$ CALL RSL_SPAWN_IRREG_NEST(
+$ +                NEST%RSL_ID, PARENT%RSL_ID,
+$ +                RSL_24PT,
+$ +                ILIST, JLIST, NVX,
+$ +                IRAX, IRAX,
+$ +                BTRIM, BTRIM,
+$ +                MLOC, NLOC,
+$ +                M,    N      )
+
+BREAKTHEEXAMPLECODE
+
+  A polygonal region of nesting is specified in the parent domain
+  by listing the coordinates of the vertices.  As with the other
+  nest spawning routines in RSL, MLOC and
+  NLOC are set to the minimum sizes of data arrays to hold the local
+  processor's allocation of the domain.  M and N are the global
+  dimensions (in nest coordiates) of the bounding box for the
+  irregularly shaped nest.
+
+
+  See also:
+  RSL_INITIALIZE, RSL_SPAWN_REGULAR_NEST
+
+@*/
+RSL_SPAWN_IRREG_NEST ( n_p, d_p, maskid_p,
+                       ypoints0, xpoints0, npoints_p,
+                       irax_m_p, irax_n_p,
+                       mtrim_p, ntrim_p,
+                       mloc_p, nloc_p,
+		       mlen_p, nlen_p )
+  int_p
+    n_p             /* (O) Handle to nested domain. */
+   ,d_p             /* (I) Handle to parent domain. */
+   ,maskid_p ;      /* (I) Id of maximum stencil for this domain. */
+  int
+    xpoints0[]       /* (I) List of M coordinates of nest shape vertices. */
+   ,ypoints0[] ;     /* (I) List of N coordinates of nest shape vertices. */
+  int_p
+    npoints_p       /* (I) Number of vertices in nest shape polygon. */
+   ,mtrim_p         /* (I) Number of points to trim from M dimension. */
+   ,ntrim_p         /* (I) Number of points to trim from N dimension. */
+   ,irax_m_p        /* (I) Nesting ratio in M dimension. */
+   ,irax_n_p        /* (I) Nesting ratio in N dimension. */
+   ,mloc_p          /* (O) Minimum local array size in M. */
+   ,nloc_p ;        /* (O) Minimum local array size in N. */
+  int_p
+    mlen_p          /* (O) Undecomposed size in M of enclosing rectangle. */
+   ,nlen_p ;        /* (O) Undecomposed size in N of enclosing rectangle. */
+{
+  int c ;
+  rsl_index_t i, j, in, jn ;
+  rsl_index_t d ;               /* number of mother domain */
+  rsl_index_t nest ;            /* number of nest domain */
+  int irax_m, irax_n ;
+  int xpoints[1024], ypoints[1024] ;
+
+  d = *d_p ;
+  irax_m = *irax_m_p ;
+  irax_n = *irax_n_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, "invalid domain index") ;
+  RSL_TEST_ERR( *npoints_p >= 1024,
+    "internal error; see routine and recompile with larger arrays") ;
+
+  /* convert fortran point specs to C (zero based) */
+
+  for ( i = 0 ; i < *npoints_p ; i++ )
+  {
+     xpoints[i] = xpoints0[i] - 1 ;
+     ypoints[i] = ypoints0[i] - 1 ;
+  }
+
+  rsl_spawn_nest ( n_p, d_p, maskid_p, xpoints, ypoints, npoints_p,
+                   mtrim_p, ntrim_p,
+                   irax_m_p, irax_n_p, mloc_p, nloc_p, mlen_p, nlen_p ) ;
+
+  domain_info[*n_p].nestshape = RSL_RAGGED_NEST ;
+  domain_info[*n_p].trim_m = *mtrim_p ;
+  domain_info[*n_p].trim_n = *ntrim_p ;
+
+}
+
+rsl_spawn_nest ( nest_p, par_p, maskid_p,
+                 xpoints, ypoints, npoints_p,
+                 mtrim_p, ntrim_p,
+                 irax_m_p, irax_n_p,
+                 mloc_p, nloc_p, mlen_p, nlen_p )
+  int_p 
+    nest_p,
+    par_p,
+    maskid_p,
+    xpoints,
+    ypoints,       /* these are arrays */
+    npoints_p,
+    mtrim_p,
+    ntrim_p,       /* trim amounts */
+    irax_m_p,
+    irax_n_p ;
+  int_p
+    mloc_p,
+    nloc_p ;        /* output: local memory needs */
+  int_p
+    mlen_p,
+    nlen_p ;
+{
+  int par ;                     /* parent domain descriptor */
+  int nest ;                    /* nested domain descriptor */
+  int nmax_par, mmax_par ;      /* parent global dimensions */
+  int neff_par, meff_par ;      /* parent effective global dimensions */
+  int nmax_nes, mmax_nes ;      /* nest global dimensions */
+  int neff_nes, meff_nes ;      /* nest effective global dimensions */
+  int irax_m, irax_n ;          /* nesting ratio, m by n */
+  int npts ;
+  int i, j, m, n ;
+  int in, jn ;  /* nested domain cursors */
+  int which_kid_am_i_m, which_kid_am_i_n ;
+  int mid ;     /* mother point id */
+  int nid ;     /* nest point id */
+  int cm, cn ;  /* cursors for m, n dimension in children of cd point */
+  int im,ime ;  /* coordinate of first/last in mother domain */
+  int jm,jme ;  /* coordinate of first/last in mother domain */
+  int * work ;                  /* work array */
+  int mtrim, ntrim ;
+  int dmlow, dmhigh, dnlow, dnhigh, mmin, nmin ;
+  rsl_point_t *ppt, *p, *pdom, *ndom ; /* working point and domain pointers */
+
+  par = *par_p ;
+  npts = *npoints_p ;
+  irax_m = *irax_m_p ;
+  irax_n = *irax_n_p ;
+  mtrim = *mtrim_p ;
+  ntrim = *ntrim_p ;
+
+  RSL_TEST_ERR( par < 0 || par >= RSL_MAXDOMAINS,
+             "spawn_nest: bad parent domain index") ;
+  RSL_TEST_ERR( !domain_info[par].valid == RSL_VALID,
+                "spawn_nest: invalid parent domain") ;
+
+/* test for the existence of other, previously defined active nests at
+   this level. */
+  if ( old_offsets == 1 )
+  {
+    int i ;
+    for ( i = 1 ; i < RSL_MAXDOMAINS ; i++ )
+    {
+      RSL_TEST_ERR( 
+      (domain_info[i].valid == RSL_VALID && domain_info[i].parent == par ),
+      "Already a nest at this level; disallowed with old offsetting scheme.") ;
+    }
+  }
+
+  nmax_par = domain_info[par].len_n ;
+  mmax_par = domain_info[par].len_m ;
+  neff_par = domain_info[par].eff_n ;
+  meff_par = domain_info[par].eff_m ;
+
+  work = RSL_MALLOC( int,  nmax_par*mmax_par ) ;
+  for ( i = 0 ; i < nmax_par*mmax_par ; i++ )
+    work[i] = 0 ;
+
+  /* draw the polygon */
+  i = 0 ;
+  if ( xpoints[i] < 0 || xpoints[i] >= neff_par ||
+       ypoints[i] < 0 || ypoints[i] >= meff_par )
+  {
+    sprintf(mess,
+      "spawn_nest: point outside effective boundary of parent x=%d, y=%d\n",
+      xpoints[i], ypoints[i] ) ;
+    RSL_TEST_ERR(1,mess) ;
+  }
+  for ( i = 1 ; i < npts ; i++ )
+  {
+    if ( xpoints[i] < 0 || xpoints[i] >= neff_par ||
+         ypoints[i] < 0 || ypoints[i] >= meff_par )
+    {
+      sprintf(mess,
+        "spawn_nest: point outside effective boundary of parent x=%d, y=%d\n",
+        xpoints[i], ypoints[i] ) ;
+      RSL_TEST_ERR(1,mess) ;
+    }
+    mark_line( work, mmax_par, nmax_par,
+               xpoints[i-1], ypoints[i-1], 
+               xpoints[i],   ypoints[i], 1 ) ;
+  }
+  /* close polygon if not closed already
+     (if it is closed, this won't do anything) */
+  mark_line( work, mmax_par, nmax_par,
+             xpoints[0], ypoints[0], 
+             xpoints[npts-1], ypoints[npts-1], 1 ) ;
+
+  fill_region( work, mmax_par, nmax_par, 0, 2 ) ;
+
+  m = mmax_par ;
+  n = nmax_par ;
+
+  for ( j = 0 ; j < n ; j++ )
+    for ( i = 0 ; i < m ; i++ )
+    {
+      if ( work[ INDEX_2( j, i, m ) ] == 2 )
+        work[ INDEX_2( j, i, m ) ] = RSL_INVALID ;
+      else
+        work[ INDEX_2( j, i, m ) ] = RSL_VALID ;
+    }
+
+  /* at this point, the region of the c.d. that will have a nest has
+     been drawn.  Figure out how big a domain we need to hold this shape. */
+
+  /* work out min and max indices in i and j */
+  ime = -99999999 ;
+  jme = -99999999 ;
+  im  =  99999999 ;
+  jm  =  99999999 ;
+  for ( j = 0 ; j < n ; j++ )
+    for ( i = 0 ; i < m ; i++ )
+      if ( work[ INDEX_2( j, i, m ) ] == RSL_VALID )
+      {
+        if ( i > ime ) ime = i ;
+        if ( i < im ) im = i ;
+        if ( j > jme ) jme = j ;
+        if ( j < jm ) jm = j ;
+      }
+
+/* the nested dimensions */
+  nmax_nes = ( jme - jm + 1 ) * irax_n ;
+  mmax_nes = ( ime - im + 1 ) * irax_m ;
+  *nlen_p = nmax_nes - ntrim ;
+  *mlen_p = mmax_nes - mtrim ;
+
+/* create the nest */
+  GET_NEXT_DOMAIN_DESCRIPTOR ( &nest ) ;
+  *nest_p = nest ;
+  domain_info[nest].nest_level = domain_info[par].nest_level + 1 ;
+  rsl_ndomains++ ;
+  rsl_c_initialize_domain( nest,
+      nmax_nes, mmax_nes, 1, *nlen_p, *mlen_p, 1 ) ;
+  domain_info[nest].parent = par ;
+  domain_info[nest].maskid = *maskid_p ;
+
+/* the coordinate in the c.d. -- note, the coordinate point does not
+   have to be in the nest itself. */
+
+  domain_info[nest].coord_m = im ;
+  domain_info[nest].coord_n = jm ;
+  domain_info[nest].irax_m = irax_m ;
+  domain_info[nest].irax_n = irax_n ;
+
+  pdom = domain_info[par].domain ;
+  ndom = domain_info[nest].domain ;
+
+/* link up child pointers */
+  for ( j = jm ; j <= jme ; j++ )
+  {
+    for ( i = im ; i <= ime ; i++ )
+    {
+      if ( work[ INDEX_2( j, i, mmax_par ) ] == RSL_VALID )
+      {
+        ppt = &(pdom[ INDEX_2( j, i, mmax_par ) ]) ;
+        if ( ppt->children_p != NULL )
+        {
+          RSL_FREE(  ppt->children_p ) ;
+        }
+        ppt->children_p = RSL_MALLOC( rsl_child_info_t, 1 ) ;
+        mid = POINTID(par,j,i) ;
+        for ( cn = 0 ; cn < irax_n ; cn++ )
+        {
+          for ( cm = 0 ; cm < irax_m ; cm++ )
+          {
+            jn = (j-jm)*irax_n+cn ;
+            in = (i-im)*irax_m+cm ;
+            nid = POINTID( nest, jn, in ) ;
+            /* connect child pointers in mother domain */
+            ppt->children_p->child[ INDEX_2(cn,cm,irax_m) ] = nid ;
+            /* connect mother pointers in child domain */
+            ndom[INDEX_2(jn,in,mmax_nes)].mother_id = mid ;
+            ndom[INDEX_2(jn,in,mmax_nes)].which_kid_am_i_m = cm ;
+            ndom[INDEX_2(jn,in,mmax_nes)].which_kid_am_i_n = cn ;
+            /* mark the nested point as valid */
+            ndom[INDEX_2(jn,in,mmax_nes)].valid = RSL_VALID ;
+          }
+        }
+      }
+    }
+  }
+
+  trim_domain( ndom, mmax_nes, nmax_nes, mtrim, ntrim ) ;
+
+  debuggal_mine = 1 ;
+
+  work_out_bdy( ndom, mmax_nes, nmax_nes ) ;
+
+  if ( domain_info[par].decomposed == 0 )
+  {
+    int dum1, dum2 ;
+    default_decomposition( &par, &dum1, &dum2 ) ;
+    domain_info[par].decomposed = 1 ;
+  }
+  if ( domain_info[nest].decomposed == 0 )
+  {
+    default_decomposition( &nest, mloc_p, nloc_p ) ;
+    domain_info[nest].decomposed = 1 ;
+  }
+
+  RSL_FREE( work ) ;
+}
+
+
+/* 
+
+The effective size of a nest for purposes of computation on the
+nest is not necessarily it's actual size.  The actual size is
+constrained to be some multiple of the nesting ratio in each 
+dimension, whereas the effective size may be less (it is, in
+fact, 2 less in MM5).  An earlier version of R90 attempted to
+express this by simply invalidating the extra cells in the
+trim_domain routine after the nested domain had been defined.
+However, this caused problems for the broadcast/merges because
+although the extra cells do not participate in computation, they
+may receive data from a parent -- this happens in the case of
+dot-variables in a staggered B-grid (U and V in MM5).  The last
+row and column of the dot variables end up being passed down from
+the parent into the last+1 row and column of the nest (because
+of staggering).  If those cells are invalidated they will not
+participate in the bcast merge and this data is lost to the
+nest.  By trimming, but not invalidating the extra cells, they
+are allowed to participate in the bcast merge, but the section
+of R90 code that works out what cells are valid for computation
+(this is in rsl_new_decomp.c) can still avoid including them.
+jm 9/13/95.
+
+*/
+
+trim_domain( dom, mmax, nmax, mtrim, ntrim )
+  rsl_point_t *dom ;
+  int mmax, nmax, mtrim, ntrim ;
+{
+  int i, j, jj, ii, cnt ;
+  rsl_point_t *p, *pdiag, *pn, *pne, *pe ;
+
+  for ( j = nmax-1 ; j >= 0 ; j-- )
+  {
+    for ( i = mmax-1 ; i >= 0 ; i-- )
+    {
+      p = &(dom[INDEX_2(j,i,mmax)]) ;
+      p->trimmed = 0 ;
+    }
+  }
+
+  /* sweep down from high m and knock out first mtrim we hit */
+
+  for ( j = nmax-1 ; j >= 0 ; j-- )
+  {
+    cnt = 0 ;
+    for ( i = mmax-1 ; i >= 0 ; i-- )
+    {
+      p = &(dom[INDEX_2(j,i,mmax)]) ;
+      if ( p->valid == RSL_VALID )
+      {
+	if ( cnt < mtrim )
+	{
+	  /* p->valid = RSL_INVALID ; */
+	  p->trimmed = 1 ;
+	  /* 1/22/96 -- handle inside northeast corners on irreg grids. jm */
+	  jj = j-cnt-1 ;
+	  if ( jj >= 0 )
+	  {
+	    pdiag = &(dom[INDEX_2(jj,i,mmax)]) ;
+	    if ( pdiag->valid == RSL_VALID )
+	    {
+	      pdiag->trimmed = 1 ;
+	    }
+	  }
+	  /* 1/22/96 -- end */
+	}
+	cnt++ ;
+      }
+      else
+	cnt = 0 ;
+    }
+  }
+  /* now do the same for ntrim */
+  for ( i = mmax-1 ; i >= 0 ; i-- )
+  {
+    cnt = 0 ;
+    for ( j = nmax-1 ; j >= 0 ; j-- )
+    {
+      p = &(dom[INDEX_2(j,i,mmax)]) ;
+      if ( p->valid == RSL_VALID )
+      {
+        if ( cnt < ntrim )
+        {
+          /* p->valid = RSL_INVALID ; */
+	  p->trimmed = 1 ;
+          /* 1/22/96 -- handle inside northeast corners on irreg grids. jm */
+          ii = i-cnt-1 ;
+          if ( ii >= 0 )
+          {
+            pdiag = &(dom[INDEX_2(j,ii,mmax)]) ;
+            if ( pdiag->valid == RSL_VALID )
+            {
+              pdiag->trimmed = 1 ;
+            }
+          }
+          /* 1/22/96 -- end */
+        }
+        cnt++ ;
+      }
+      else
+        cnt = 0 ;
+    }
+  }
+
+/* set up cross grid points */
+  for ( j = 0 ; j < nmax ; j++ )
+  {
+    for ( i = mmax-1 ; i >= 0 ; i-- )
+    {
+      p = &(dom[INDEX_2(j,i,mmax)]) ;
+      p->cross = 0 ;
+      if ( p->valid == RSL_VALID && ! p->trimmed )
+      {
+        if ( (i+1 < mmax) && (j+1 < nmax) )
+        {
+          if (    ((pn  =  &(dom[INDEX_2(j  ,i+1,mmax)])) != NULL )
+               && ((pne =  &(dom[INDEX_2(j+1,i+1,mmax)])) != NULL )
+               && ((pe  =  &(dom[INDEX_2(j+1,i  ,mmax)])) != NULL ) )
+          {
+            if ( ( pn->valid == RSL_VALID  &&  ! pn->trimmed  ) &&
+                 ( pne->valid == RSL_VALID &&  ! pne->trimmed ) &&
+                 ( pe->valid == RSL_VALID  &&  ! pe->trimmed  )  )
+            {
+              p->cross = 1 ;
+            }
+          }
+        }
+      }
+    }
+  }
+}
+
+#ifndef NEC_TUNE
+#define PTEST(P) (!(P.valid==RSL_VALID && P.trimmed == 0)) 
+#define QTEST(P) (!(P.valid==RSL_VALID && P.trimmed == 0 && P.cross == 1 )) 
+#else
+#define PTEST(P) (!(P.valid==RSL_VALID & P.trimmed == 0)) 
+#define QTEST(P) (!(P.valid==RSL_VALID & P.trimmed == 0 & P.cross == 1 )) 
+#endif
+
+
+work_out_bdy( dom, mmax, nmax )
+  rsl_point_t *dom ;
+  int mmax, nmax ;
+{
+  int i, j, idx, in ;
+  int dmlow, dmhigh, dnlow, dnhigh ;
+  int d00, d0n, dm0, dmn ;
+  int min, closest ;
+  rsl_point_t *p ;
+  int *wrk_bdy1, *wrk_dbdy1 ;
+  int *wrk_bdy2, *wrk_dbdy2 ;
+#ifdef NEC_TUNE
+  int ii ;
+  int jj ;
+  int Tdmlow ;
+  int Tdmhigh ;
+  int Tdnlow ;
+  int Tdnhigh ;
+#endif
+
+/* this first section works out the distance and direction to the "closest"
+   boundary. */
+
+  wrk_bdy1 = RSL_MALLOC(int, mmax*nmax) ;
+  wrk_dbdy1 = RSL_MALLOC(int, mmax*nmax) ;
+  wrk_bdy2 = RSL_MALLOC(int, mmax*nmax) ;
+  wrk_dbdy2 = RSL_MALLOC(int, mmax*nmax) ;
+
+/* DOT GRID */
+#pragma csd parallel for private(j, i, idx, p)
+  for ( j = 0 ; j < nmax ; j++ )
+#pragma _CRI concurrent
+#pragma cdir nodep
+    for ( i = 0 ; i < mmax ; i++ )
+    {
+      idx = INDEX_2(j,i,mmax) ;
+      p = &(dom[ idx ]) ;
+      if ( p->valid == RSL_VALID && p->trimmed == 0 )
+      {
+	wrk_bdy1[ idx ] = 0 ; wrk_dbdy1[ idx ] = 0 ;
+	wrk_bdy2[ idx ] = 0 ; wrk_dbdy2[ idx ] = 0 ;
+      }
+      else
+      {
+	wrk_bdy1[ idx ] = -1 ; wrk_dbdy1[ idx ] = -1 ;
+	wrk_bdy2[ idx ] = -1 ; wrk_dbdy2[ idx ] = -1 ;
+      }
+
+    }
+
+  fill_boundary( wrk_bdy1, wrk_dbdy1, mmax, nmax,	/* counter clockwise */
+		 1, -1, NORTH, SOUTH, EAST, WEST ) ;
+  fill_boundary( wrk_bdy2, wrk_dbdy2, mmax, nmax,	/* clockwise */
+		 0, -1, NORTH, SOUTH, EAST, WEST ) ;
+#pragma csd parallel for private(j, i, idx, p)
+  for ( j = 0 ; j < nmax ; j++ )
+#pragma _CRI concurrent
+#pragma cdir nodep
+    for ( i = 0 ; i < mmax ; i++ )
+    {
+      idx = INDEX_2(j,i,mmax) ;
+#ifndef NEC_TUNE
+      p = &(dom[ idx ]) ;
+      if ( p->valid == RSL_VALID && p->trimmed == 0 )
+      {
+	p->dbdy = wrk_dbdy1[ idx ] ;
+	p->bdy_cclockwise = wrk_bdy1[ idx ] ;
+	p->bdy_clockwise = wrk_bdy2[ idx ] ;
+      }
+      else
+      {
+	p->dbdy = RSL_INVALID ;
+	p->bdy_cclockwise = RSL_INVALID ;
+	p->bdy_clockwise = RSL_INVALID ;
+      }
+#else
+      if ( dom[idx].valid == RSL_VALID && dom[idx].trimmed == 0 )
+      {
+        dom[idx].dbdy = wrk_dbdy1[ idx ] ;
+        dom[idx].bdy_cclockwise = wrk_bdy1[ idx ] ;
+        dom[idx].bdy_clockwise = wrk_bdy2[ idx ] ; 
+      }
+      else
+      {
+        dom[idx].dbdy = RSL_INVALID ;
+        dom[idx].bdy_cclockwise = RSL_INVALID ;
+        dom[idx].bdy_clockwise = RSL_INVALID ;
+      }
+#endif
+    }
+
+/* CROSS GRID */
+#pragma csd parallel for private(j, i, idx, p)
+  for ( j = 0 ; j < nmax ; j++ )
+#pragma _CRI concurrent
+#pragma cdir nodep
+    for ( i = 0 ; i < mmax ; i++ )
+    {
+      idx = INDEX_2(j,i,mmax) ;
+      p = &(dom[ idx ]) ;
+      if ( p->valid == RSL_VALID && p->trimmed == 0 && p->cross == 1 )
+      {
+	wrk_bdy1[ idx ] = 0 ; wrk_dbdy1[ idx ] = 0 ;
+	wrk_bdy2[ idx ] = 0 ; wrk_dbdy2[ idx ] = 0 ;
+      }
+      else
+      {
+	wrk_bdy1[ idx ] = -1 ; wrk_dbdy1[ idx ] = -1 ;
+	wrk_bdy2[ idx ] = -1 ; wrk_dbdy2[ idx ] = -1 ;
+      }
+
+    }
+
+  fill_boundary( wrk_bdy1, wrk_dbdy1, mmax, nmax,	/* counter clockwise */
+		 1, -1, NORTH, SOUTH, EAST, WEST ) ;
+  fill_boundary( wrk_bdy2, wrk_dbdy2, mmax, nmax,	/* clockwise */
+		 0, -1, NORTH, SOUTH, EAST, WEST ) ;
+
+#pragma csd parallel for private(j, i, idx, p)
+  for ( j = 0 ; j < nmax ; j++ )
+#pragma _CRI concurrent
+#pragma cdir nodep
+    for ( i = 0 ; i < mmax ; i++ )
+    {
+      idx = INDEX_2(j,i,mmax) ;
+      p = &(dom[ idx ]) ;
+      if ( p->valid == RSL_VALID && p->trimmed == 0 && p->cross == 1 )
+      {
+	p->dbdy_x = wrk_dbdy1[ idx ] ;
+	p->bdy_x_cclockwise = wrk_bdy1[ idx ] ;
+	p->bdy_x_clockwise = wrk_bdy2[ idx ] ;
+      }
+      else
+      {
+	p->dbdy_x = RSL_INVALID ;
+	p->bdy_x_cclockwise = RSL_INVALID ;
+	p->bdy_x_clockwise = RSL_INVALID ;
+      }
+    }
+
+  RSL_FREE( wrk_bdy1 ) ;
+  RSL_FREE( wrk_dbdy1 ) ;
+  RSL_FREE( wrk_bdy2 ) ;
+  RSL_FREE( wrk_dbdy2 ) ;
+
+/* this second section works out the distances to each of the four boundaries
+   but does not take corners into account */
+
+#ifdef NO_RAGGED
+
+/* DOT GRID */
+  for ( j = 0 ; j < nmax ; j++ )
+  {
+    for ( i = 0 ; i < mmax ; i++ )
+    {
+      p = &(dom[INDEX_2(j,i,mmax)]) ;
+      if ( p->valid == RSL_VALID && p->trimmed == 0 )
+      {
+        p->dist_mlow  = (i)+1 ;
+        p->dist_mhigh = (mmax-i) ;
+        p->dist_nlow  = (j)+1 ;
+        p->dist_nhigh = (nmax-j) ;
+      }
+    }
+  }
+/* CROSS GRID */
+  for ( j = 0 ; j < nmax ; j++ )
+  {
+    for ( i = 0 ; i < mmax ; i++ )
+    {
+      p = &(dom[INDEX_2(j,i,mmax)]) ;
+      if ( p->valid == RSL_VALID && p->trimmed == 0 && p->cross == 1 )
+      {
+        p->dist_mlow_x  = (i)+1  ;              /* make 1 based for fortran */
+        p->dist_mhigh_x = (mmax-i) ;
+        p->dist_nlow_x  = (j)+1  ;
+        p->dist_nhigh_x = (nmax-j) ;
+      }
+    }
+  }
+
+#else
+
+/* DOT GRID */
+  /* work out boundary info -- this is a little tricky (and time consuming)
+     because we have to allow for irregularly shaped nests */
+#pragma csd parallel for private(j, i, p, dmlow, dmhigh, dnlow, dnhigh)
+  for ( j = 0 ; j < nmax ; j++ )
+  {
+    for ( i = 0 ; i < mmax ; i++ )
+    {
+      p = &(dom[INDEX_2(j,i,mmax)]) ;
+      if ( p->valid == RSL_VALID && p->trimmed == 0 )
+      {
+        /* zip down til we find the mlow boundary */
+#ifndef NEC_TUNE
+#pragma _CRI concurrent
+        for ( dmlow = 1 ; i-dmlow >= 0 ; dmlow++ )
+        {
+          if ( PTEST(dom[INDEX_2(j,i-dmlow,mmax)])) break ;
+        }
+        dmlow-- ;
+#else
+        for ( ii = 1 ; ii <= i ; ii++ )
+        {
+          if ( PTEST(dom[INDEX_2(j,i-ii,mmax)])) break ;
+        }
+        dmlow = ii - 1 ;
+        Tdmlow = dmlow ;
+#endif
+        /* zip up til we find the mhigh boundary */
+#ifndef NEC_TUNE
+#pragma _CRI concurrent
+        for ( dmhigh = 1 ; i+dmhigh < mmax ; dmhigh++ )
+        {
+          if ( PTEST(dom[INDEX_2(j,i+dmhigh,mmax)])) break ;
+        }
+        dmhigh-- ;
+#else
+        for ( ii = 1 ; ii < mmax-i ; ii++ )
+        {
+          if ( PTEST(dom[INDEX_2(j,i+ii,mmax)])) break ;
+        }
+        dmhigh = ii - 1 ;
+        Tdmhigh = dmhigh ;
+#endif
+        /* zip west til we find the nlow boundary */
+#ifndef NEC_TUNE
+#pragma _CRI concurrent
+        for ( dnlow = 1 ; j-dnlow >= 0 ; dnlow++ )
+        {
+          if ( PTEST(dom[INDEX_2(j-dnlow,i,mmax)])) break ;
+        }
+        dnlow-- ;
+#else
+        for ( jj = 1 ; jj <= j ; jj++ )
+        {
+          if ( PTEST(dom[INDEX_2(j-jj,i,mmax)])) break ;
+        }
+        dnlow = jj - 1 ;
+        Tdnlow = dnlow ;
+#endif
+        /* zip east til we find the nhigh boundary */
+#ifndef NEC_TUNE
+#pragma _CRI concurrent
+        for ( dnhigh = 1 ; j+dnhigh < nmax ; dnhigh++ )
+        {
+          if ( PTEST(dom[INDEX_2(j+dnhigh,i,mmax)])) break ;
+        }
+        dnhigh-- ;
+#else
+        for ( jj = 1 ; jj < nmax-j ; jj++ )
+        {
+          if ( PTEST(dom[INDEX_2(j+jj,i,mmax)])) break ;
+        }
+        dnhigh = jj - 1 ;
+        Tdnhigh = dnhigh ;
+#endif
+
+        p->dist_mlow  = dmlow+1  ;		/* make 1 based for fortran */
+        p->dist_mhigh = dmhigh+1 ;
+        p->dist_nlow  = dnlow+1  ;
+        p->dist_nhigh = dnhigh+1 ;
+
+      }
+    }
+  }
+
+/* CROSS GRID */
+  /* work out boundary info -- this is a little tricky (and time consuming)
+     because we have to allow for irregularly shaped nests */
+#pragma csd parallel for private(j, i, p, dmlow, dmhigh, dnlow, dnhigh)
+  for ( j = 0 ; j < nmax-1 ; j++ )
+  {
+    for ( i = 0 ; i < mmax-1 ; i++ )
+    {
+      p = &(dom[INDEX_2(j,i,mmax)]) ;
+      if ( p->valid == RSL_VALID && p->trimmed == 0 && p->cross == 1 )
+      {
+        /* zip down til we find the mlow boundary */
+#ifndef NEC_TUNE
+#pragma _CRI concurrent
+        for ( dmlow = 1 ; i-dmlow >= 0 ; dmlow++ )
+        {
+          if ( QTEST(dom[INDEX_2(j,i-dmlow,mmax)])) break ;
+        }
+        dmlow-- ;
+#else
+        for ( ii = 1 ; ii <= i ; ii++ )
+        {
+          if ( QTEST(dom[INDEX_2(j,i-ii,mmax)])) break ;
+        }
+        dmlow = ii - 1 ;
+        Tdmlow = dmlow ;
+#endif
+        /* zip up til we find the mhigh boundary */
+#ifndef NEC_TUNE
+#pragma _CRI concurrent
+        for ( dmhigh = 1 ; i+dmhigh < mmax ; dmhigh++ )
+        {
+          if ( QTEST(dom[INDEX_2(j,i+dmhigh,mmax)])) break ;
+        }
+        dmhigh-- ;
+#else
+        for ( ii = 1 ; ii < mmax-i ; ii++ )
+        {
+          if ( QTEST(dom[INDEX_2(j,i+ii,mmax)])) break ;
+        }
+        dmhigh = ii - 1 ;
+        Tdmhigh = dmhigh ;
+#endif
+        /* zip west til we find the nlow boundary */
+#ifndef NEC_TUNE
+#pragma _CRI concurrent
+        for ( dnlow = 1 ; j-dnlow >= 0 ; dnlow++ )
+        {
+          if ( QTEST(dom[INDEX_2(j-dnlow,i,mmax)])) break ;
+        }
+        dnlow-- ;
+#else
+        for ( jj = 1 ; jj <= j ; jj++ )
+        {
+          if ( QTEST(dom[INDEX_2(j-jj,i,mmax)])) break ;
+        }
+        dnlow = jj - 1 ;
+        Tdnlow = dnlow ;
+#endif
+        /* zip east til we find the nhigh boundary */
+#ifndef NEC_TUNE
+#pragma _CRI concurrent
+        for ( dnhigh = 1 ; j+dnhigh < nmax ; dnhigh++ )
+        {
+          if ( QTEST(dom[INDEX_2(j+dnhigh,i,mmax)])) break ;
+        }
+        dnhigh-- ;
+#else
+        for ( jj = 1 ; jj < nmax-j ; jj++ )
+        {
+          if ( QTEST(dom[INDEX_2(j+jj,i,mmax)])) break ;
+        }
+        dnhigh = jj - 1 ;
+        Tdnhigh = dnhigh ;
+#endif
+
+        p->dist_mlow_x  = dmlow+1  ;		/* make 1 based for fortran */
+        p->dist_mhigh_x = dmhigh+1 ;
+        p->dist_nlow_x  = dnlow+1  ;
+        p->dist_nhigh_x = dnhigh+1 ;
+
+      }
+    }
+  }
+#endif
+}
+
+#if COMMENTED_OUT
+RSL_DEACTIVATE_DOMAIN ( d_p )
+  int_p d_p ;
+{
+  rsl_domain_info_t * ninfo ;
+  int d, P ;
+  int destroy_runrec() ;
+  int i ;
+
+  d = *d_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, "invalid domain index") ;
+
+  domain_info[d].valid = RSL_INVALID ;
+  domain_info[d].decomposed = 0 ;
+
+  if ( domain_info[d].domain != NULL ) RSL_FREE( domain_info[d].domain ) ;
+
+  destroy_list( &(domain_info[d].pts), NULL ) ;
+  destroy_list( &(domain_info[d].ghost_pts), NULL ) ;
+  destroy_list( &(domain_info[d].iruns), destroy_runrec ) ;
+
+  if ( domain_info[d].js != NULL ) RSL_FREE( domain_info[d].js ) ;
+  if ( domain_info[d].is != NULL ) RSL_FREE( domain_info[d].is ) ;
+  if ( domain_info[d].ie != NULL ) RSL_FREE( domain_info[d].ie ) ;
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    ninfo->bcast_recv_Pnpts[P] = 0 ;
+    ninfo->bcast_recv_Plist[P] = RSL_INVALID ;
+    ninfo->bcast_recv_Ptags[P] = RSL_INVALID ;
+    ninfo->Nbcast_recv_Plist = 0 ;
+  }
+
+/* get rid of stencils on this domain */
+  for ( i = 0 ; i < domain_info[d].stencurs ; i++ )
+  {
+    if ( domain_info[d].stenlist[i] > 0 && 
+	 domain_info[d].stenlist[i] < RSL_MAXDESCRIPTORS )
+    {
+      destroy_stencil_on_domain( d,
+				 sh_descriptors[domain_info[d].stenlist[i]] ) ;
+    }
+  }
+  domain_info[d].stencurs = 0 ;
+
+}
+#endif
+
+
+/* this returns the first unused domain descriptor; it checks
+   for unusededness by seeing if the domain pointed to is valid 
+   or not.  If it's not, it's unused.  That's the only checking
+   that this thing does. */
+/* this can also be used to find out what the next descriptor
+   will be -- so it shouldn't, by itself, change the state of 
+   the domain descriptor as a result of being called */
+
+GET_NEXT_DOMAIN_DESCRIPTOR ( d_p )
+  int_p d_p ;
+{
+  int d ;
+
+  for ( d = 0 ; d < RSL_MAXDOMAINS ; d++ )
+  {
+    if ( domain_info[d].valid == RSL_INVALID )
+    {
+      break ;
+    }
+  }
+  RSL_TEST_ERR( d == RSL_MAXDOMAINS, "Out of domains." ) ;
+  *d_p = d ;
+}
+
+
+#if 0
+clear()
+{
+char clear[] = "[H[2J" ;
+printf(clear) ;
+}
+
+
+if (debuggal_mine) {
+  int i, j, x ;
+  rsl_point_t *p ;
+  printf("------ in %d ------ bc: %d %d\n", in, breadcrumb_i, breadcrumb_j ) ;
+  for ( i = mmax-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < nmax ; j++ )
+    {
+      p = &(dom[INDEX_2(j,i,mmax)]) ;
+      if ( p->dbdy==-1 ) x = 0 ;
+      else x = p->dbdy % 10 ;
+      printf("%1d",x ) ;
+    }
+    printf("\n") ;
+  }
+/*
+  sleep(1) ;
+  clear() ;
+*/
+}
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/exch_period.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/exch_period.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/exch_period.c	(revision 2744)
@@ -0,0 +1,306 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_EXCH_PERIOD - Exchange data on an RSL periodic boundary
+
+  Notes:
+
+  See also:
+
+@*/
+
+RSL_EXCH_PERIOD ( d_p, s_p, dir_p )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,s_p             /* (I) Period descriptor. */
+   ,dir_p ;         /* (I) RSL_M or RSL_N. */
+{
+  int d, s, dir ;
+  period_desc_t *per ;
+  message_desc_t *msg ;
+  rsl_procrec_t *procrec ;
+  rsl_ptrec_t *ptrec ;
+  rsl_list_t *lp, *lp1 ;
+  rsl_index_t ig, jg ;
+  rsl_point_hdr_t point_hdr ;
+  int i, ipt, sp, j ;
+  int curs ;
+  int nprocs, npts ;
+  int retval ;
+  int mtype, mdest ;
+  char * pbuf ;
+  int P ;
+  int Pque[RSL_MAXPROC] ;
+  rsl_procrec_t *procrecque[RSL_MAXPROC ] ;
+  int typeque[RSL_MAXPROC] ;
+  int tqp, ndone ;
+  packrec_t * pr ;
+  void * base ;
+
+int ts, te ;
+
+  d = *d_p ; s = *s_p ; 
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+        "descriptor for invalid domain" ) ;
+  if      ( *dir_p == RSL_M )
+  {
+    dir = 0 ;
+  }
+  else if ( *dir_p == RSL_N )
+  {
+    dir = 1 ;
+  }
+  else
+  {
+    RSL_TEST_ERR( 1 , "invalid direction: must be RSL_M or RSL_N" ) ;
+  }
+
+
+#ifdef UPSHOT
+MPE_Log_event( 15, s, "period begin" ) ;
+#endif
+#if 0
+fprintf(stderr,"debug called RSL_EXCH_PERIOD %d\n",s ) ;
+#endif
+
+  per = (period_desc_t *) pr_descriptors[ s ] ;
+
+  /* if period has not been compiled, compile it now! */
+  if ( per->compiled[d] == 0 )
+  {
+    rsl_compile_period( d_p, s_p ) ;
+  }
+
+  /* post receives */
+  /* iterate over procrecs for domain and post buffers */
+
+  tqp = 0 ;
+  for ( procrec = per->procs[dir][d] ; procrec != NULL ; procrec = procrec->next )
+  {
+#if 0
+ fprintf(stderr,"A procrec->P %d\n",procrec->P) ;
+ fprintf(stderr,"  procrec->npts %d\n",procrec->npts) ;
+ fprintf(stderr,"  procrec->recv_npts %d\n",procrec->recv_npts) ;
+ fprintf(stderr,"  procrec->pack_table_size %d\n",procrec->pack_table_size) ;
+ fprintf(stderr,"  procrec->unpack_table_size %d\n",procrec->unpack_table_size) ;
+ fprintf(stderr,"  procrec->pack_table_nbytes %d\n",procrec->pack_table_nbytes) ;
+ fprintf(stderr,"  procrec->unpack_table_nbytes %d\n",procrec->unpack_table_nbytes) ;
+#endif
+    if ( procrec->unpack_table_nbytes > 0 )
+    {
+      P = procrec->P ;
+      Pque[tqp] = P ;
+      procrecque[tqp] = procrec ;
+      pbuf = buffer_for_proc( P, procrec->unpack_table_nbytes, RSL_RECVBUF ) ;
+      mtype = MTYPE_FROMTO( MSG_PERCOM, 
+			    rsl_c_comp2phys_proc (procrec->P), 
+			    rsl_myproc ) ;
+      typeque[tqp] = mtype ;
+      procrec->nrecvs++ ; /* diagnostic */
+#if 0
+fprintf(stderr,"debug posting async recv for %d bytes from %d\n", procrec->unpack_table_nbytes, rsl_c_comp2phys_proc (procrec->P) ) ;
+#endif
+      RSL_RECVBEGIN ( pbuf, procrec->unpack_table_nbytes, mtype ) ;
+      tqp++ ;
+    }
+  }
+  nprocs = tqp ;
+
+  /* pack buffers and issue sends */
+
+  for ( procrec = per->procs[dir][d] ; procrec != NULL ; procrec = procrec->next )
+  {
+    pbuf=buffer_for_proc(procrec->P, procrec->pack_table_nbytes, RSL_SENDBUF) ;
+    pr = procrec->pack_table ;
+    for ( curs = 0, i = 0 ; i < procrec->pack_table_size ; i++, pr++ )
+    {
+      if ( per->has_f90_fields && procrec->pack_table_size > 0 )
+        base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+      else
+        base = pr->base ;
+      for ( j = 0 ; j < pr->nelems ; j++ )
+      {
+#if 0
+fprintf(stderr,"pck base %08x, %08x, buf %08x, curs %5d, n %5d, off %5d, j %5d, s %5d\n",
+(char *)(base),
+(char *)(base) + pr->offset + j * pr->stride,
+&(pbuf[curs]), curs, pr->n,
+pr->offset, j, pr->stride ) ;
+#endif
+        bcopy((char *)(base) + pr->offset + j * pr->stride,
+	      &(pbuf[curs]),pr->n) ;
+        curs += pr->n ;
+      }
+    }
+    if ( curs > 0 )
+    {
+      mdest = rsl_c_comp2phys_proc (procrec->P) ;
+      mtype = MTYPE_FROMTO( MSG_PERCOM, rsl_myproc, mdest ) ;
+      procrec->nsends++ ;
+      if ( curs > procrec->pack_table_nbytes ) 
+      {
+        sprintf(mess,"pack buffer overflow %d > %d\n",curs,procrec->pack_table_nbytes) ;
+        RSL_TEST_ERR(1,mess) ;
+      }
+#if 0
+fprintf(stderr,"debug sending %d bytes to %d\n", curs, mdest ) ;
+#endif
+#if 1
+      RSL_SEND ( pbuf, curs, mtype, mdest ) ;
+#else
+
+{ 
+   MPI_Request waitHandle ;
+   MPI_Isend (pbuf,
+              curs,
+              MPI_BYTE,
+              mdest,
+              mtype,
+              rsl_mpi_communicator,
+              &waitHandle);
+}
+
+#endif
+    }
+    else if ( curs == 0 && procrec->pack_table_nbytes != 0 )
+    {
+      RSL_TEST_ERR(1,"internal error") ;
+    }
+  }
+
+
+  /* wait on receives and unpack messages as they come in */
+  ndone = 0 ;
+  tqp = 0 ;
+  retval = 1 ;
+
+  while( ndone < nprocs )
+  {
+    if (tqp >= nprocs ) tqp = 0 ;
+    if (typeque[tqp] != RSL_INVALID)
+    {
+      mtype = typeque[tqp] ;
+      if ( rsl_noprobe == NULL )
+        RSL_PROBE ( mtype, &retval ) ;
+      /* else, retval will always be 1 */
+
+      if ( retval )
+      {
+#ifdef PGON
+/* on the Paragon, calling RSL_PROBE clears the message so this
+   would bomb on an unknown message id.  Don't call unless the probe
+   is disabled (rsl_noprobe != NULL). */
+        if ( rsl_noprobe != NULL ) RSL_RECVEND ( mtype ) ;
+#else  
+        RSL_RECVEND ( mtype ) ;
+#endif
+
+	curs = 0 ;
+        pbuf = buffer_for_proc( Pque[tqp], 0, RSL_RECVBUF ) ;
+        procrec = procrecque[tqp] ;
+        pr = procrec->unpack_table ;
+        for ( curs = 0, i = 0 ; i < procrec->unpack_table_size ; i++, pr++ )
+	{
+          if ( per->has_f90_fields && procrec->unpack_table_size > 0 )
+            base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+          else
+            base = pr->base ;
+          for ( j = 0 ; j < pr->nelems ; j++ )
+          {
+#if 0
+fprintf(stderr,"uck base %08x, %08x, buf %08x, curs %5d, n %5d, off %5d, j %5d, s %5d\n",
+(char *)(base),
+(char *)(base) + pr->offset + j * pr->stride,
+&(pbuf[curs]), curs, pr->n,
+pr->offset, j, pr->stride ) ;
+#endif
+            bcopy(&(pbuf[curs]),
+		 (char *)(base) + pr->offset + j * pr->stride, pr->n) ;
+            curs += pr->n ;
+	  }
+	}
+	if ( curs == 0 )
+	{
+	  RSL_TEST_ERR(1,"internal error") ;
+	}
+        if ( curs > procrec->unpack_table_nbytes )
+        {
+          sprintf(mess,"unpack buffer overflow %d > %d\n",curs,procrec->pack_table_nbytes) ;
+          RSL_TEST_ERR(1,mess) ;
+	}
+#if 0
+fprintf(stderr,"debug got message from %d and unpacked %d bytes\n", Pque[tqp], curs ) ;
+#endif
+        typeque[tqp] = RSL_INVALID ;
+        ndone++ ;
+      }
+    }
+    tqp++ ;
+  }
+#ifdef UPSHOT
+MPE_Log_event( 16, s, "per end" ) ;
+#endif
+
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/exch_sten.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/exch_sten.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/exch_sten.c	(revision 2744)
@@ -0,0 +1,609 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_EXCH_STENCIL - Exchange data on an RSL stencil
+
+  Notes:
+  This routine is used to exchange data within domain Arg1 using
+  an RSL stencil, Arg2.
+  When this routine returns, data
+  in the ghost areas around the local partition will have been
+  updated with data from cells on surrounding processors, as
+  described in the stencil.  A stencil must have been described
+  in the context of a domain before it can be used on the domain
+  (RSL_DESCRIBE_STENCIL).
+
+  This routine generates interprocessor communication on message
+  passing architectures.
+
+  All processors must call RSL_EXCH_STENCIL at the same point in
+  the code.
+
+  See also:
+  RSL_CREATE_STENCIL, RSL_DESCRIBE_STENCIL
+
+@*/
+
+#ifndef crayx1
+
+#ifdef NEC_TUNE
+void copymem( void *src,    /* Source address (byte) */
+              int src_inc,  /* Stride between source per copy (bytes) */
+              void *dest,   /* Destination address (byte) */
+              int dest_inc, /* Stride between destination per copy (bytes) */
+              int nbytes,   /* Number of bytes to move per copy (bytes) */
+              int nelems )  /* Number of times to repeat copy */
+{
+  /* Byte based pointers. */
+  char * src1b ;
+  char * dest1b ;
+  /* 4 byte based pointers. */
+  int * src4b ;
+  int * dest4b ;
+  /* 8 byte based pointers. */
+  long * src8b ;
+  long * dest8b ;
+  int outer ;
+  int inner ;
+
+  if ( (((long)src | (long)dest | src_inc | dest_inc | nbytes) & (sizeof(int) -1)) == 0 )
+  {
+    src4b = (int *)(src) ;
+    dest4b = (int *)(dest) ;
+    src_inc /= sizeof(int) ;
+    dest_inc /= sizeof(int) ;
+
+    for ( outer = 0 ; outer < nbytes/sizeof(int) ; outer++ )
+    {
+#pragma cdir nodep
+      for ( inner = 0 ; inner < nelems ; inner++ )
+      {
+        dest4b[outer + inner*dest_inc] = src4b[outer + inner*src_inc] ;
+      }
+    }
+  }
+  else
+  {
+    src1b = (char *) (src) ;
+    dest1b = (char *) (dest) ;
+    for ( inner = 0 ; inner < nelems ; inner++ )
+    {
+      bcopy(src1b, dest1b, nbytes) ;
+      src1b += src_inc ;
+      dest1b += dest_inc ;
+    }
+  }
+} /* copymem */
+#endif
+
+RSL_EXCH_STENCIL ( d_p, s_p )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,s_p ;           /* (I) Stencil descriptor. */
+{
+  int d, s ;
+  stencil_desc_t *sten ;
+  message_desc_t *msg ;
+  rsl_procrec_t *procrec ;
+  rsl_ptrec_t *ptrec ;
+  rsl_list_t *lp, *lp1 ;
+  rsl_index_t ig, jg ;
+  rsl_point_hdr_t point_hdr ;
+  int i, ipt, sp, j ;
+  int curs ;
+  int nprocs, npts ;
+  int retval ;
+  int mtype, mdest ;
+  char * pbuf ;
+  int P ;
+  int Pque[RSL_MAXPROC] ;
+  rsl_procrec_t *procrecque[RSL_MAXPROC ] ;
+  int typeque[RSL_MAXPROC] ;
+  int tqp, ndone ;
+  void * base ;
+  packrec_t * pr ;
+
+
+  d = *d_p ; s = *s_p ;
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+        "descriptor for invalid domain" ) ;
+
+#ifdef UPSHOT
+MPE_Log_event( 15, s, "sten begin" ) ;
+#endif
+#if 0
+fprintf(stderr,"debug called RSL_EXCH_STENCIL %d\n",s ) ;
+#endif
+
+  if ((sten = (stencil_desc_t *) sh_descriptors[ s ]) == NULL )
+  {
+    RSL_TEST_ERR(1,"invalid or unspecified stencil descriptor" ) ;
+  }
+
+  /* if stencil has not been compiled, compile it now! */
+  if ( sten->compiled[d] == 0 )
+  {
+    rsl_compile_stencil( d_p, s_p ) ;
+  }
+
+  /* post receives */
+  /* iterate over procrecs for domain and post buffers */
+
+  tqp = 0 ;
+  for ( procrec = sten->procs[d] ; procrec != NULL ; procrec = procrec->next )
+  {
+    if ( procrec->unpack_table_nbytes > 0 )
+    {
+      P = procrec->P ;
+      Pque[tqp] = P ;
+      procrecque[tqp] = procrec ;
+      pbuf = buffer_for_proc( P, procrec->unpack_table_nbytes, RSL_RECVBUF ) ;
+      mtype = MTYPE_FROMTO( MSG_STENCOM, 
+                            rsl_c_comp2phys_proc (procrec->P), 
+                            rsl_myproc ) ;
+      typeque[tqp] = mtype ;
+      procrec->nrecvs++ ; /* diagnostic */
+#if 0
+fprintf(stderr,"debug posting async recv for %d bytes from %d\n", procrec->unpack_table_nbytes, rsl_c_comp2phys_proc (procrec->P) ) ;
+#endif
+      RSL_RECVBEGIN ( pbuf, procrec->unpack_table_nbytes, mtype ) ;
+      tqp++ ;
+    }
+  }
+  nprocs = tqp ;
+
+  /* pack buffers and issue sends */
+
+  for ( procrec = sten->procs[d] ; procrec != NULL ; procrec = procrec->next )
+  {
+    pbuf=buffer_for_proc(procrec->P, procrec->pack_table_nbytes, RSL_SENDBUF) ;
+    pr = procrec->pack_table ;
+    for ( curs = 0, i = 0 ; i < procrec->pack_table_size ; i++, pr++ )
+    {
+      if ( sten->has_f90_fields && procrec->pack_table_size > 0 )
+        base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+      else
+        base =  pr->base ;
+#if 0
+fprintf(stderr,"pack   base %lu, f90_index %d, sten=%d\n",base,pr->f90_table_index,s) ;
+#endif
+#ifndef NEC_TUNE
+      for ( j = 0 ; j < pr->nelems ; j++ )
+      {
+
+#if 0
+if ( rsl_debug_flg ) {
+fprintf(stderr,"pck %08x, buf %08x, curs %5d, n %5d, off %5d, j %5d, s %5d\n",
+(char *)(base) + pr->offset + j * pr->stride,
+&(pbuf[curs]), curs, pr->n,
+pr->offset, j, pr->stride ) ;
+}
+#endif
+
+        bcopy((char *)(base) + pr->offset + j * pr->stride,
+	      &(pbuf[curs]),pr->n) ;
+        curs += pr->n ;
+      }
+#else
+      copymem((char *)(base) + pr->offset, pr->stride, &(pbuf[curs]), pr->n, pr->n, pr->nelems) ;
+      curs += pr->n*pr->nelems ;
+#endif
+    }
+    if ( curs > 0 )
+    {
+      mdest = rsl_c_comp2phys_proc (procrec->P) ;
+      mtype = MTYPE_FROMTO( MSG_STENCOM, rsl_myproc, mdest ) ;
+      procrec->nsends++ ;
+      if ( curs > procrec->pack_table_nbytes ) 
+      {
+        sprintf(mess,"pack buffer overflow %d > %d\n",curs,procrec->pack_table_nbytes) ;
+        RSL_TEST_ERR(1,mess) ;
+      }
+#if 0
+fprintf(stderr,"debug sending %d bytes to %d, sten=%d\n", curs, mdest, s ) ;
+#endif
+      RSL_SEND ( pbuf, curs, mtype, mdest ) ;
+    }
+    else if ( curs == 0 && procrec->pack_table_nbytes != 0 )
+    {
+      RSL_TEST_ERR(1,"internal error") ;
+    }
+  }
+
+  /* wait on receives and unpack messages as they come in */
+  ndone = 0 ;
+  tqp = 0 ;
+  retval = 1 ;
+
+  while( ndone < nprocs )
+  {
+    if (tqp >= nprocs ) tqp = 0 ;
+    if (typeque[tqp] != RSL_INVALID)
+    {
+      mtype = typeque[tqp] ;
+      if ( rsl_noprobe == NULL )
+        RSL_PROBE ( mtype, &retval ) ;
+      /* else, retval will always be 1 */
+
+      if ( retval )
+      {
+#ifdef PGON
+/* on the Paragon, calling RSL_PROBE clears the message so this
+   would bomb on an unknown message id.  Don't call unless the probe
+   is disabled (rsl_noprobe != NULL). */
+        if ( rsl_noprobe != NULL ) RSL_RECVEND ( mtype ) ;
+#else  
+        RSL_RECVEND ( mtype ) ;
+#endif
+
+	curs = 0 ;
+        pbuf = buffer_for_proc( Pque[tqp], 0, RSL_RECVBUF ) ;
+        procrec = procrecque[tqp] ;
+        pr = procrec->unpack_table ;
+        for ( curs = 0, i = 0 ; i < procrec->unpack_table_size ; i++, pr++ )
+	{
+          if ( sten->has_f90_fields && procrec->unpack_table_size > 0 )
+            base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+          else
+            base = pr->base ;
+#if 0
+fprintf(stderr,"unpack base %lu, f90_index %d, sten=%d\n",base,pr->f90_table_index,s) ;
+#endif
+#ifndef NEC_TUNE
+          for ( j = 0 ; j < pr->nelems ; j++ )
+          {
+            bcopy(&(pbuf[curs]),
+		 (char *)(base) + pr->offset + j * pr->stride, pr->n) ;
+            curs += pr->n ;
+	  }
+#else
+          copymem(&(pbuf[curs]), pr->n, (char *)(base) + pr->offset, pr->stride, pr->n, pr->nelems) ;
+          curs += pr->n*pr->nelems ;
+#endif
+	}
+	if ( curs == 0 )
+	{
+	  RSL_TEST_ERR(1,"internal error") ;
+	}
+        if ( curs > procrec->unpack_table_nbytes )
+        {
+          sprintf(mess,"unpack buffer overflow %d > %d\n",curs,procrec->pack_table_nbytes) ;
+          RSL_TEST_ERR(1,mess) ;
+	}
+#if 0
+fprintf(stderr,"debug got message from %d and unpacked %d bytes; sten=%d\n", Pque[tqp], curs, s ) ;
+#endif
+        typeque[tqp] = RSL_INVALID ;
+        ndone++ ;
+      }
+    }
+    tqp++ ;
+  }
+#ifdef UPSHOT
+MPE_Log_event( 16, s, "sten end" ) ;
+#endif
+
+}
+
+
+#else
+
+
+RSL_EXCH_STENCIL ( d_p, s_p )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,s_p ;           /* (I) Stencil descriptor. */
+{
+  int d, s ;
+  stencil_desc_t *sten ;
+  rsl_procrec_t *procrec ;
+  int i,j ;
+  int curs ;
+  int nprocs ;
+  int retval ;
+  int mtype, mdest ;
+  char * pbuf ;
+  int P ;
+  int Pque[RSL_MAXPROC] ;
+  rsl_procrec_t *procrecque[RSL_MAXPROC ] ;
+  int typeque[RSL_MAXPROC] ;
+  int tqp, ndone ;
+  void * base ;
+
+  packrec_t * pr ;
+
+  d = *d_p ; s = *s_p ;
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+        "descriptor for invalid domain" ) ;
+
+#ifdef UPSHOT
+MPE_Log_event( 15, s, "sten begin" ) ;
+#endif
+#if 0
+fprintf(stderr,"debug called RSL_EXCH_STENCIL %d\n",s ) ;
+#endif
+
+  if ((sten = (stencil_desc_t *) sh_descriptors[ s ]) == NULL )
+  {
+    RSL_TEST_ERR(1,"invalid or unspecified stencil descriptor" ) ;
+  }
+
+  /* if stencil has not been compiled, compile it now! */
+  if ( sten->compiled[d] == 0 )
+  {
+    rsl_compile_stencil( d_p, s_p ) ;
+                                                                                       
+    /* fill in curs value for pack and unpack buffers */
+    for ( procrec = sten->procs[d] ; procrec != NULL ; procrec = procrec->next )
+    {
+      /* determine offset into pack buffer for each element */
+      pr = procrec->pack_table ;
+      if ( procrec->pack_table_nbytes > 0 )
+      {
+        for ( curs = 0, i = 0 ; i < procrec->pack_table_size ; i++, pr++ )
+        {
+          pr->curs = curs;
+          curs += pr->nelems * pr->n;
+        }
+//        fprintf(stderr, "pack %d %d\n", curs, procrec->pack_table_nbytes);
+      }
+      /* determine offset into unpack buffer for each element */
+      if ( procrec->unpack_table_nbytes > 0 )
+      {
+        pr = procrec->unpack_table ;
+        for ( curs = 0, i = 0 ; i < procrec->unpack_table_size ; i++, pr++ )
+        {
+          pr->curs = curs;
+          curs += pr->nelems * pr->n;
+        }
+//        fprintf(stderr, "unpack %d %d\n", curs, procrec->unpack_table_nbytes);
+      }
+    }
+  }
+
+  /* post receives */
+  /* iterate over procrecs for domain and post buffers */
+
+  tqp = 0 ;
+  for ( procrec = sten->procs[d] ; procrec != NULL ; procrec = procrec->next )
+  {
+    if ( procrec->unpack_table_nbytes > 0 )
+    {
+      P = procrec->P ;
+      Pque[tqp] = P ;
+      procrecque[tqp] = procrec ;
+      pbuf = buffer_for_proc( P, procrec->unpack_table_nbytes, RSL_RECVBUF ) ;
+      mtype = MTYPE_FROMTO( MSG_STENCOM, 
+                   rsl_c_comp2phys_proc (procrec->P), rsl_myproc ) ;
+      typeque[tqp] = mtype ;
+      procrec->nrecvs++ ; /* diagnostic */
+#if 0
+fprintf(stderr,"debug posting async recv for %d bytes from %d\n", procrec->unpack_table_nbytes, rsl_c_comp2phys_proc (procrec->P) ) ;
+#endif
+      RSL_RECVBEGIN ( pbuf, procrec->unpack_table_nbytes, mtype ) ;
+      tqp++ ;
+    }
+  }
+  nprocs = tqp ;
+
+  /* pack buffers and issue sends */
+
+  for ( procrec = sten->procs[d] ; procrec != NULL ; procrec = procrec->next )
+  {
+
+    pbuf=buffer_for_proc(procrec->P, procrec->pack_table_nbytes, RSL_SENDBUF) ;
+
+#pragma csd parallel for private(i, pr, base)
+    for ( i = 0 ; i < procrec->pack_table_size ; i++ )
+    {
+      int inc, nwrds;
+      int *bufin, *bufout;
+
+      pr = &procrec->pack_table[i];
+
+      if ( sten->has_f90_fields && procrec->pack_table_size > 0 )
+        base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+      else
+        base =  pr->base ;
+#if 0
+fprintf(stderr,"pack   base %lu, f90_index %d, sten=%d\n",base,pr->f90_table_index,s) ;
+#endif
+#pragma no_cache_alloc bufin bufout
+      bufin = (int *)(base) + (pr->offset >> 2);
+      bufout = (int *)(pbuf) + (pr->curs >> 2);
+      inc = pr->stride >> 2;
+      nwrds = pr->n >> 2;
+      if (nwrds < 64) {
+        int j, k;
+        for (j = 0; j < nwrds; j++) {
+#pragma _CRI ivdep
+#pragma prefervector 
+#pragma cdir nodep
+           for (k = 0; k < pr->nelems; k++) {
+              bufout[k*nwrds+j] = bufin[k*inc+j];
+           }
+        }
+      }
+      else {
+        int j, k;
+        int iwd = 0;
+        int iwd2 = 0;
+        for (j = 0; j < pr->nelems; j++) {
+#pragma _CRI ivdep
+#pragma cdir nodep
+          for (k = 0; k < nwrds; k++) {
+            bufout[iwd++] = bufin[iwd2+k];
+          }
+          iwd2 += inc;
+        }
+      }
+    }
+
+    curs = procrec->pack_table_nbytes;
+    if ( curs > 0 )
+    {
+      mdest = rsl_c_comp2phys_proc (procrec->P) ;
+      mtype = MTYPE_FROMTO( MSG_STENCOM, rsl_myproc, mdest ) ;
+      procrec->nsends++ ;
+#if 0
+fprintf(stderr,"debug sending %d bytes to %d, sten=%d\n", curs, mdest, s ) ;
+#endif
+      RSL_SEND ( pbuf, curs, mtype, mdest ) ;
+    }
+  }
+
+  /* wait on receives and unpack messages as they come in */
+  ndone = 0 ;
+  tqp = 0 ;
+  retval = 1 ;
+
+  while( ndone < nprocs )
+  {
+    if (tqp >= nprocs ) tqp = 0 ;
+    if (typeque[tqp] != RSL_INVALID)
+    {
+      mtype = typeque[tqp] ;
+      if ( rsl_noprobe == NULL )
+        RSL_PROBE ( mtype, &retval ) ;
+      /* else, retval will always be 1 */
+
+      if ( retval )
+      {
+#ifdef PGON
+/* on the Paragon, calling RSL_PROBE clears the message so this
+   would bomb on an unknown message id.  Don't call unless the probe
+   is disabled (rsl_noprobe != NULL). */
+        if ( rsl_noprobe != NULL ) RSL_RECVEND ( mtype ) ;
+#else  
+        RSL_RECVEND ( mtype ) ;
+#endif
+
+        pbuf = buffer_for_proc( Pque[tqp], 0, RSL_RECVBUF ) ;
+        procrec = procrecque[tqp] ;
+#pragma csd parallel for private(i, pr, base)
+        for ( i = 0 ; i < procrec->unpack_table_size ; i++ )
+        {
+          int inc, nwrds;
+          int *bufin, *bufout;
+#pragma no_cache_alloc bufin bufout
+
+          pr = &procrec->unpack_table[i] ;
+
+          if ( sten->has_f90_fields && procrec->unpack_table_size > 0 )
+            base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+          else
+            base = pr->base ;
+#if 0
+fprintf(stderr,"unpack base %lu, f90_index %d, sten=%d\n",base,pr->f90_table_index,s) ;
+#endif
+
+          bufin = (int *)(pbuf) + (pr->curs >> 2);
+          bufout = (int *)(base) + (pr->offset >> 2);
+          inc = pr->stride >> 2;
+          nwrds = pr->n >> 2;
+          if (nwrds < 64) {
+            int j, k;
+            for (j = 0; j < nwrds; j++) {
+#pragma _CRI ivdep
+#pragma prefervector 
+#pragma cdir nodep
+                for (k = 0; k < pr->nelems; k++) {
+                bufout[k*inc+j] = bufin[k*nwrds+j];
+              }
+            }
+          }
+          else {
+            int j, k;
+            int iwd = 0;
+            int iwd2 = 0;
+            for (j = 0; j < pr->nelems; j++) {
+#pragma _CRI ivdep
+#pragma cdir nodep
+              for (k = 0; k < nwrds; k++) {
+                bufout[iwd2+k] = bufin[iwd++];
+              }
+              iwd2 += inc;
+            }
+          }
+        }
+
+#if 0
+fprintf(stderr,"debug got message from %d and unpacked %d bytes; sten=%d\n", Pque[tqp], curs, s ) ;
+#endif
+        typeque[tqp] = RSL_INVALID ;
+        ndone++ ;
+      }
+    }
+    tqp++ ;
+  }
+#ifdef UPSHOT
+MPE_Log_event( 16, s, "sten end" ) ;
+#endif
+}
+
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fill_boundary.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fill_boundary.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fill_boundary.c	(revision 2744)
@@ -0,0 +1,547 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+/*
+   Given a work array with the in-valid entries marked with invalid,
+   Traverse the boundaries and figure the distances using the snake
+   and breadcrumb method: start at an outer point, leave a breadcrumb
+   and snake around either clockwise or counterclockwise (value of rot)
+   feeling the left or right edge respectively, until you get back to the
+   breadcrumb, then jump in and start the next boundary.  Each valid
+   cell is marked with an integer signifying its distance from the boundary
+   (1 is the outermost valid row or column).
+
+   The points are also marked with the code for which boundary they are
+   closest to.  How corners are marked will depend on which direction
+   the rotation occured.  Therefore, one may wish to compute two
+   traversals, and then difference them.  Any points that come up
+   different can be resolved by the differencing algorithm with an
+   east-west wins, north-south wins, or diagonal-separate policy.
+
+   the array bdy countains the invalid markings
+   the array dbdy, may be uninitialized
+   m is assumed to be minor and the north-south dimension.
+   n is assumed to be major and the east-west dimension.
+   the integer boundary tags are passed in.
+
+   returns zero for success, non-zero for failure 
+
+*/
+
+#include "rsl.h"
+
+#ifndef INDEX_2
+# define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) )
+#endif
+#ifndef INDEX_3
+# define INDEX_3(A,B,NB,C,NC)  INDEX_2((A),INDEX_2((B),(C),(NC)),(NB)*(NC))
+#endif
+#ifndef RSL_MALLOC
+# define RSL_MALLOC(T,N)  (T *)rsl_malloc(__FILE__,__LINE__,(sizeof(T))*(N))
+#endif
+#ifndef RSL_TEST_ERR
+# define RSL_TEST_ERR(T,M) {if(T){fprintf(stderr,"error (\"%s\":%d) %s\n",__FILE__,__LINE__,M);RSL_FATAL(5);}}
+#endif
+#ifndef RSL_FATAL
+# define RSL_FATAL(X) exit(X)
+#endif
+
+static int bc_i, bc_j, dir ;    /* breadcrumb indices */
+static int in ;
+
+
+/* fortran wrapper */
+#ifdef NOUNDERSCORE
+fill_bdy( bdy, dbdy, mmax, nmax, rot, invalid, ntag, stag, etag, wtag )
+#else
+# ifdef F2CSTYLE
+fill_bdy__( bdy, dbdy, mmax, nmax, rot, invalid, ntag, stag, etag, wtag )
+# else
+fill_bdy_( bdy, dbdy, mmax, nmax, rot, invalid, ntag, stag, etag, wtag )
+# endif
+#endif
+  int * bdy ;     /* boundary associations, on entry contains invalid entries */
+  int * dbdy ;    /* distances to boundaries, may be unitialized */
+  int * mmax,     /* minor n/s dimension of arrays */
+      * nmax ;    /* major e/w dimension of arrays */
+  int * rot ;     /* rotation 1=counterclockwise, 0=clockwise */
+  int * invalid ; /* integer value of an invalid point */
+  int * ntag ;    /* tag for north boundary assn */
+  int * stag ;    /* tag for south boundary assn */
+  int * etag ;    /* tag for east  boundary assn */
+  int * wtag ;    /* tag for west  boundary assn */
+{
+ fill_boundary( bdy, dbdy, *mmax, *nmax, *rot, *invalid,
+                *ntag, *stag, *etag, *wtag ) ;
+}
+
+fill_boundary( bdy, dbdy, mmax, nmax, rot, invalid, ntag, stag, etag, wtag )
+  int * bdy ;   /* boundary associations, on entry contains invalid entries */
+  int * dbdy ;  /* distances to boundaries, may be unitialized */
+  int mmax,     /* minor n/s dimension of arrays */
+      nmax ;    /* major e/w dimension of arrays */
+  int rot ;     /* rotation 1=counterclockwise, 0=clockwise */
+  int invalid ; /* integer value of an invalid point */
+  int ntag ;    /* tag for north boundary assn */
+  int stag ;    /* tag for south boundary assn */
+  int etag ;    /* tag for east  boundary assn */
+  int wtag ;    /* tag for west  boundary assn */
+{
+  int i, j, retval ;
+
+  if ( bdy == NULL && dbdy == NULL ) return(1) ;
+
+  retval = 0 ; 
+
+  /* initialized distances array -- nextcell relies on this */
+  for ( i = 0 ; i < mmax*nmax ; i++ ) dbdy[i] = -1 ;
+
+  in = 0 ;
+  while ( ! place_to_start( bdy, dbdy, mmax, nmax, rot,
+                            &i, &j, 
+                            invalid, ntag, stag, etag, wtag,
+                            &dir ) )
+  {
+    bc_i = i ;
+    bc_j = j ;
+    /* recursive */
+    in++ ;
+    retval = fill_boundary_1( bdy, dbdy, mmax, nmax, rot, i, j,
+                              invalid, ntag, stag, etag, wtag ) ;
+  }
+  return( retval ) ;
+}
+
+fill_boundary_1( bdy, dbdy, mmax, nmax, rot, i, j,
+                 invalid, ntag, stag, etag, wtag )
+  int * bdy ;   /* boundary associations, on entry contains invalid entries */
+  int * dbdy ;  /* distances to boundaries, initialized to -1 */
+  int mmax,     /* minor n/s dimension of arrays */
+      nmax ;    /* major e/w dimension of arrays */
+  int rot ;     /* rotation 1=counterclockwise, 0=clockwise */
+  int i, j ;    /* current point */
+  int invalid ; /* integer value of an invalid point */
+  int ntag ;    /* tag for north boundary assn */
+  int stag ;    /* tag for south boundary assn */
+  int etag ;    /* tag for east  boundary assn */
+  int wtag ;    /* tag for west  boundary assn */
+
+{
+  int idx ;     /* index of point */
+  int fbc ;     /* found bread crumb */
+  int i2, j2 ;
+  int retval ;
+
+  idx = INDEX_2(j,i,mmax) ;
+
+  dbdy[ idx ] = in ;
+  bdy[ idx ] = bdy_from_dir( dir, rot, ntag, stag, etag, wtag ) ;
+
+
+#if 0
+if ( in >= 15 ) {
+  int i, j, idx ;
+  char x ;
+  printf("------ in %d ------ bc: %d %d\n", in, bc_i, bc_j ) ;
+  for ( i = mmax-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < nmax ; j++ )
+    {
+      idx = INDEX_2(j,i,mmax) ;
+      if ( dbdy[idx]==-1 ) x = '.' ;
+      else x = (dbdy[idx] % 10) + '0' ;
+      printf("%1c",x ) ;
+    }
+    printf("\n") ;
+  }
+/*  sleep(1) ; */
+/*  clear() ; */
+}
+#endif
+
+  while ( nextcell( bdy, dbdy, mmax, nmax, rot, i, j, in, &i2, &j2, &fbc,
+                    invalid, ntag, stag, etag, wtag ) )
+  {
+    if ( fbc )
+    {
+      bc_i = i2 ;
+      bc_j = j2 ;
+      /* recurse */
+      in++ ;
+      retval = fill_boundary_1( bdy, dbdy, mmax, nmax, rot, i2, j2,
+                                invalid, ntag, stag, etag, wtag ) ;
+      break ;
+    }
+    else
+    {
+      idx = INDEX_2(j2,i2,mmax) ;
+      dbdy[ idx ] = in ;
+      bdy[ idx ] = bdy_from_dir( dir, rot, ntag, stag, etag, wtag ) ;
+    }
+    i = i2 ;
+    j = j2 ;
+  }
+#if 0
+if ( in >= 15 ) {
+  char x ;
+  int i, j,  idx ;
+  printf("------ in %d ------ bc: %d %d\n", in, bc_i, bc_j ) ;
+  for ( i = mmax-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < nmax ; j++ )
+    {
+      idx = INDEX_2(j,i,mmax) ;
+      if ( dbdy[idx]==-1 ) x = '.' ;
+      else x = (dbdy[idx] % 10) + '0' ;
+      printf("%1c",x ) ;
+    }
+    printf("\n") ;
+  }
+/*  sleep(1) ; */
+/*  clear() ; */
+}
+#endif
+  return(retval) ;
+}
+
+nextcell( bdy, dbdy, mmax, nmax, rot, i, j, in, i2, j2, fbc,
+          invalid, ntag, stag, etag, wtag )
+  int * bdy ;   /* boundary associations, on entry contains invalid entries */
+  int * dbdy ;  /* distances to boundaries, initialized to -1 */
+  int mmax,     /* minor n/s dimension of arrays */
+      nmax ;    /* major e/w dimension of arrays */
+  int rot ;     /* rotation 1=counterclockwise, 0=clockwise */
+  int i, j ;    /* current point */
+  int in ;      /* how far into domain on this instantiation of routine */
+  int *i2,*j2 ;	/* new point */
+  int *fbc ;    /* found bread crumb */
+  int invalid ; /* integer value of an invalid point */
+  int ntag ;    /* tag for north boundary assn */
+  int stag ;    /* tag for south boundary assn */
+  int etag ;    /* tag for east  boundary assn */
+  int wtag ;    /* tag for west  boundary assn */
+{
+  int cnt, try, fail ;
+  int ii, jj, idx ;
+
+  *fbc = 0 ;
+  for ( cnt = 0 ; cnt < 4 ; cnt++ )
+  {
+    if ( rot ) 		/* counter clockwise */
+    {
+      if      ( dir == ntag )
+      {
+      /* going north; try to go east */
+        ii = i  ; jj = j+1 ; try = etag ; fail = wtag ;
+      }
+      else if ( dir == etag )
+      {
+      /* going east; try to go south */
+        ii = i-1 ; jj = j   ; try = stag ; fail = ntag ;
+      }
+      else if ( dir == stag )
+      {
+      /* going south; try to go west */
+        ii = i   ; jj = j-1 ; try = wtag ; fail = etag ;
+      }
+      else if ( dir == wtag )
+      {
+      /* going west; try to go north */
+        ii = i+1 ; jj = j   ; try = ntag ; fail = stag ;
+      }
+      else
+      {
+        RSL_TEST_ERR(1,"method failure") ;
+      }
+    }
+    else   		/* clockwise */
+    {
+      if      ( dir == ntag )
+      {
+      /* going north; try to go west */
+        ii = i   ; jj = j-1 ; try = wtag ; fail = etag ;
+      }
+      else if ( dir == etag )
+      {
+      /* going east; try to go north */
+        ii = i+1 ; jj = j   ; try = ntag ; fail = stag ;
+      }
+      else if ( dir == stag )
+      {
+      /* going south; try to go east */
+        ii = i   ; jj = j+1 ; try = etag ; fail = wtag ;
+      }
+      else if ( dir == wtag )
+      {
+      /* going west; try to go south */
+        ii = i-1 ; jj = j   ; try = stag ; fail = ntag ;
+      }
+      else
+      {
+        RSL_TEST_ERR(1,"method failure") ;
+      }
+    }
+    if ( ii >= 0 && ii < mmax && jj >= 0 && jj < nmax )
+    {
+      if ( ii == bc_i && jj == bc_j )
+      {
+        *fbc = 1 ;
+      }
+      idx = INDEX_2(jj,ii,mmax) ;
+      dir = try ;
+      *i2 = ii ; *j2 = jj ;
+      if ( bdy[idx] != invalid &&
+          (dbdy[idx] == -1 || (dbdy[idx] == in && ! *fbc )))
+                  /* this business (prev line) allows backtracking */
+      {
+        return(1) ;
+      }
+    }
+    dir = fail ;
+  }
+  return(0) ;
+}
+
+/***********************
+  Table for bdy_from_dir
+                             boundary associating for rotation
+      going             rot=1 (counterclock)    rot=0 (clockwise)
+      ---------------------------------------------------
+      north             east                    west
+      east              south                   north
+      south             west                    east
+      west              north                   south
+
+
+************************/
+bdy_from_dir( dir, rot, ntag, stag, etag, wtag )
+  int dir ;                     /* current direction */
+  int rot ;                     /* rotation (see table) */
+  int ntag, stag, etag, wtag ;  /* direction tags */
+{
+  int bdy ;
+
+  if      ( dir == ntag )
+    bdy = (rot?etag:wtag) ;  /* if north, then east  bdy */
+  else if ( dir == etag )
+    bdy = (rot?stag:ntag) ;  /* if east , then south bdy */
+  else if ( dir == stag )
+    bdy = (rot?wtag:etag) ;  /* if south, then west  bdy */
+  else if ( dir == wtag )
+    bdy = (rot?ntag:stag) ;  /* if west , then north bdy */
+  else
+    RSL_TEST_ERR(1,"bad tag") ;
+
+  return( bdy ) ;
+}
+
+/* returns 0 on success (found a place to start, otherwise non-zero */
+place_to_start( bdy, dbdy, mmax, nmax, rot,
+                i2, j2,
+                invalid, ntag, stag, etag, wtag,
+                dir )
+  int * bdy ;   /* boundary associations, on entry contains invalid entries */
+  int * dbdy ;  /* distances to boundaries, initialized to -1 */
+  int mmax,     /* minor n/s dimension of arrays */
+      nmax ;    /* major e/w dimension of arrays */
+  int rot ;     /* rotation 1=counterclockwise, 0=clockwise */
+  int *i2, *j2 ; /* current point  (output) */
+  int invalid ; /* integer value of an invalid point */
+  int ntag ;    /* tag for north boundary assn */
+  int stag ;    /* tag for south boundary assn */
+  int etag ;    /* tag for east  boundary assn */
+  int wtag ;    /* tag for west  boundary assn */
+  int *dir ;	/* initial direction (output) */
+{
+  int i, j, idx ;
+  int i0, j0, it, jt ;
+  int cnt ;
+
+  /* find first valid point */
+  for ( j = 0 ; j < nmax ; j++ )
+  {
+    for ( i = 0 ; i < mmax ; i++ )
+    {
+      idx = INDEX_2(j,i,mmax) ;
+      if ( bdy[ idx ] != invalid && dbdy[idx] == -1 )
+      {
+	*i2 = i ;
+	*j2 = j ;
+	goto out1 ;
+      }
+    }
+  }
+
+out1:
+
+  /* set an initial direction -- we will chose the first valid direction
+     that does not have a valid direction to its right (rot=1, cntrclkwise)
+     or left (rot=1, clkwise) */
+
+
+  for ( cnt = 0 ; cnt < 4 ; cnt++ ) 
+  {
+    switch(cnt)
+    {
+    case 0 :
+      /* how about north ? */
+      *dir = ntag ;
+      i0 = i+1 ; j0 = j ;
+      it = i ; jt = (rot?j+1:j-1) ;
+      break ;
+    case 1 :
+      /* how about south ? */
+      *dir = stag ;
+      i0 = i-1 ; j0 = j ;
+      it = i ; jt = (rot?j-1:j+1) ;
+      break ;
+    case 2 :
+      /* how about east ? */
+      *dir = etag ;
+      i0 = i ; j0 = j+1 ;
+      it = (rot?i-1:i+1) ; jt = j ;
+      break ;
+    case 3 :
+      /* how about west ? */
+      *dir = wtag ;
+      i0 = i ; j0 = j-1 ;
+      it = (rot?i+1:i-1) ; jt = j ;
+      break ;
+    }
+
+    /* there are RETURN statements in these conditionals */
+    /* see if i0, j0 is valid, then see if it,jt is invalid */
+    if ( i0 >= 0 && i0 < mmax && j0 >= 0 && j0 < nmax )
+    {
+      idx = INDEX_2(j0,i0,mmax) ;
+      if ( bdy[ idx ] != invalid && dbdy[idx] == -1 ) /*and unvisited*/
+      {
+	/* if this point is invalid or out of bounds, we've got the
+	   correct choice for i0, j0 and direction */
+        if ( ! ( it >= 0 && it < mmax && jt >= 0 && jt < nmax ) )
+	{
+	  return(0) ;
+	}
+	idx = INDEX_2(jt,it,mmax) ;
+        if ( bdy[ idx ] == invalid || dbdy[idx] != -1 ) /* or visited */
+	{
+	  return(0) ;
+	}
+      }
+    }
+#if 0
+    switch(cnt)
+    {
+    case 0 :
+      /* how about north ? */
+      *dir = ntag ;
+      i0 = i+1 ; j0 = j ;
+      it = i0 ; jt = (rot?j+1:j-1) ;
+      break ;
+    case 1 :
+      /* how about south ? */
+      *dir = stag ;
+      i0 = i-1 ; j0 = j ;
+      it = i0 ; jt = (rot?j-1:j+1) ;
+      break ;
+    case 2 :
+      /* how about east ? */
+      *dir = etag ;
+      i0 = i ; j0 = j+1 ;
+      it = (rot?i-1:i+1) ; jt = j0 ;
+      break ;
+    case 3 :
+      /* how about west ? */
+      *dir = wtag ;
+      i0 = i ; j0 = j-1 ;
+      it = (rot?i+1:i-1) ; jt = j0 ;
+      break ;
+    }
+
+    /* there are RETURN statements in these conditionals */
+    /* see if i0, j0 is valid, then see if it,jt is invalid */
+    if ( i0 >= 0 && i0 < mmax && j0 >= 0 && j0 < nmax )
+    {
+      idx = INDEX_2(j0,i0,mmax) ;
+      if ( bdy[ idx ] != invalid && dbdy[idx] == -1 ) /*and unvisited*/
+      {
+	/* if this point is invalid or out of bounds, we've got the
+	   correct choice for i0, j0 and direction */
+        if ( ! ( it >= 0 && it < mmax && jt >= 0 && jt < nmax ) )
+	{
+	  return(0) ;
+	}
+	idx = INDEX_2(jt,it,mmax) ;
+        if ( bdy[ idx ] == invalid || dbdy[idx] != -1 ) /* or visited */
+	{
+	  return(0) ;
+	}
+      }
+    }
+#endif
+  }
+  return(1) ;
+}
+
+char cl[] = "[H[2J" ;
+
+clear()
+{
+printf(cl) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fix_semicolons.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fix_semicolons.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fix_semicolons.c	(revision 2744)
@@ -0,0 +1,91 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+
+main()
+{
+   char inline[1024] ;
+   char inquote ;
+   int i ;
+
+
+   inquote = '\0' ;
+
+   while ( gets( inline )  != NULL )
+   {
+     /* parse the line and if you see a semicolon that's not
+	inside quotes, make a new card out of what follows */
+     for ( i = 0 ; i < 1024 ; i++ )
+     {
+       if ( inline[i] == '\0' ) { putchar('\n') ; break ; }
+       if ( inline[i] == '\'' && inquote == '\0' ) inquote = '\'' ;
+       if ( inline[i] == '\'' && inquote == '\'' ) inquote = '\0' ;
+       if ( inline[i] == '"'  && inquote == '"'  ) inquote = '\0' ;
+       if ( inline[i] == '"'  && inquote == '\0' ) inquote = '"' ;
+       if ( inline[i] == ';' && inquote == '\0' )
+       {
+	 printf("\n      ") ;
+       }
+       else
+       {
+	 putchar(inline[i]) ;
+       }
+     }
+   }
+   exit(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort.7
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort.7	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort.7	(revision 2744)
@@ -0,0 +1,3 @@
+10 12 
+1
+2 2
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_bdyin_dbl.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_bdyin_dbl.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_bdyin_dbl.F	(revision 2744)
@@ -0,0 +1,66 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine fort_bdyin_dbl( unit,
+     $               buf_e,buf_w,buf_n,buf_s, n_ew, n_ns )
+      implicit none
+      integer unit, n_ew, n_ns
+      double precision buf_e(n_ew),buf_w(n_ew),buf_n(n_ns),buf_s(n_ns)
+      read( unit ) buf_e,buf_w,buf_n,buf_s
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_bdyin_real.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_bdyin_real.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_bdyin_real.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine fort_bdyin_real( unit,
+     $               buf_e,buf_w,buf_n,buf_s, n_ew, n_ns )
+      implicit none
+      integer unit, n_ew, n_ns
+      real buf_e(n_ew),buf_w(n_ew),buf_n(n_ns),buf_s(n_ns)
+      read( unit ) buf_e,buf_w,buf_n,buf_s
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_characterread.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_characterread.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_characterread.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine fort_characterread( unit, buf, n )
+      implicit none
+      integer unit, n
+      character buf(n)
+      read( unit ) buf
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_characterwrite.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_characterwrite.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_characterwrite.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine fort_characterwrite( unit, buf, n )
+      implicit none
+      integer unit, n
+      character buf(n)
+      write( unit ) buf
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_close.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_close.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_close.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+c added 7/27/94
+      subroutine fort_close(unit)
+      implicit none
+      integer unit
+      close( unit )
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_complexread.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_complexread.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_complexread.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine fort_complexread( unit, buf, n )
+      implicit none
+      integer unit, n
+      complex buf(n)
+      read( unit ) buf
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_complexwrite.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_complexwrite.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_complexwrite.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine fort_complexwrite( unit, buf, n )
+      implicit none
+      integer unit, n
+      complex buf(n)
+      write( unit ) buf
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_doubleread.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_doubleread.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_doubleread.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine fort_doubleread( unit, buf, n )
+      implicit none
+      integer unit, n
+      double precision buf(n)
+      read( unit ) buf
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_doublewrite.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_doublewrite.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_doublewrite.F	(revision 2744)
@@ -0,0 +1,66 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine fort_doublewrite( unit, buf, n )
+      implicit none
+      integer unit, n
+      double precision buf(n)
+      write( unit ) buf
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_intread.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_intread.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_intread.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine fort_intread( unit, buf, n )
+      implicit none
+      integer unit, n
+      integer buf(n)
+      read( unit ) buf
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_intwrite.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_intwrite.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_intwrite.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine fort_intwrite( unit, buf, n )
+      implicit none
+      integer unit, n
+      integer buf(n)
+      write( unit ) buf
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_realread.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_realread.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_realread.F	(revision 2744)
@@ -0,0 +1,68 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine fort_realread( unit, buf, n )
+      implicit none
+      integer unit, n, i
+      real buf(n)
+c      real testbuf( 242800 )
+c          write(0,*)'fort_realread unit ',unit,' n ',n,
+c     +             ' loc(buf) ',loc(buf), ' loc(testbuf) ',loc(testbuf)
+c      read( unit ) (testbuf(i),i=1,n)
+      read( unit ) buf
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_realwrite.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_realwrite.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/fort_realwrite.F	(revision 2744)
@@ -0,0 +1,64 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine fort_realwrite( unit, buf, n )
+      implicit none
+      integer unit, n
+      real buf(n)
+      write( unit ) buf
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/generate_invoke.csh
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/generate_invoke.csh	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/generate_invoke.csh	(revision 2744)
@@ -0,0 +1,37 @@
+# generates the case statement in invoke_pf.F
+# Usage:  generate_invoke.csh n
+#
+# where n is the number of cases to generate.
+# 
+onintr cleanup
+
+/bin/rm -f /tmp/foo1.$$
+
+set n = $1
+
+set i = 0 
+while ( $i < $n )
+  echo "," >> /tmp/foo1.$$
+  @ i += 1
+end
+
+set i = 0
+while ( $i < $n )
+  @ ii = $i + 1
+  sed "$ii,${n}s/.*,/&A($i),/" /tmp/foo1.$$ > /tmp/foo2.$$
+  /bin/mv /tmp/foo2.$$ /tmp/foo1.$$
+  @ i += 1
+end
+
+cat -n /tmp/foo1.$$ | \
+sed -e 's/^/case/' -e 's/	/ : /' -e 's/,/(*f)(/' -e 's/,$/); break ;/' \
+> /tmp/foo2.$$
+
+echo 'case     0 : (*f)() ; break ;'
+cat /tmp/foo2.$$
+
+
+cleanup:
+
+/bin/rm -f /tmp/foo[12].$$
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/get_bdy_info.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/get_bdy_info.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/get_bdy_info.c	(revision 2744)
@@ -0,0 +1,859 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+static int tiebreaker = DIAG_WINS ;
+/*@
+  RSL_BDY_TIEBRK -- Break ties in determining cells' boundary affiliations.
+
+  Notes:
+  This routine effects the information provided by the set of RSL_GET_BDY routines.
+
+  Corner points that are equidistant to both a boundary in the M dimension and
+  a boundary in the N dimension are, by default considered neither; they are
+  considered "diagonal." RSL_BDY_TIEBRK changes the behavior to the one specified
+  by the argument Arg1, which may be M_WINS, N_WINS, or DIAG_WINS (defined in the file
+  rsl.inc).
+
+  See also:
+
+  RSL_GET_BDY_LPT, RSL_GET_BDY_LARRAY, RSL_GET_BDY_GPT,
+
+  RSL_GET_BDY_GARRAY
+
+@*/
+RSL_BDY_TIEBRK ( brk_p )
+  int_p brk_p ;      /* (I) M_WINS, N_WINS, or DIAG_WINS */
+{
+  if      ( *brk_p == M_WINS )
+    tiebreaker = M_WINS ;
+  else if ( *brk_p == N_WINS ) 
+    tiebreaker = N_WINS ;
+  else 
+    tiebreaker = DIAG_WINS ;
+}
+
+
+/*@
+  RSL_GET_BDY_LPT  -- Get boundary information for a locally indexed point.
+
+  Notes:
+  This returns boundary information for a locally specified point in the integer
+  array Arg2. The information is useful with irregularly shaped nests
+  (see RSL_SPAWN_IRREG_NEST), in which boundary proximity is not easily determined
+  from loop indices.
+
+  The variations of this routine are RSL_GET_BDY_LPT, RSL_GET_BDY_LARRAY,
+  RSL_GET_BDY_GPT, and RSL_GET_BDY_GARRAY.
+
+  The argument Arg3 should be either DOT_BDY_INFO_LEN or 
+  CROSS_BDY_INFO_LEN (defined in the file rsl.inc).  With DOT_BDY_INFO_LEN, the
+  routine will return
+  boundary information for a domain containing all points of the grid (i.e., the 
+  dot-boundaries of an Arakawa-B grid).
+  With CROSS_BDY_INFO_LEN, the routine will return the dot boundary information plus
+  the cross boundary information (i.e., the uppermost boundaries in M and N are at
+  M-1 and N-1).
+
+  The array Arg2 may be indexed to obtain the following information.
+
+  Verbatim:
+$      symbolic name        description
+$      (rsl.inc)          
+$      --------------------------------------------
+$
+$ Normal grid boundary information (dot, in Arakawa B)
+$
+$      RSL_MLOW             Distance to MLOW (south) boundary
+$      RSL_MHIGH            Distance to MHIGH (north) boundary
+$      RSL_NLOW             Distance to NLOW (west) boundary 
+$      RSL_NHIGH            Distance to NHIGH (east) boundary
+$      RSL_DBDY             Distance to closest boundary
+$      RSL_CLOSEST          Closest boundary
+$
+$ Cross grid boundary information (Arakawa B)
+$
+$      RSL_MLOW_X           Distance to MLOW (south) cross boundary
+$      RSL_MHIGH_X          Distance to MHIGH (north) cross boundary
+$      RSL_NLOW_X           Distance to NLOW (west) cross boundary 
+$      RSL_NHIGH_X          Distance to NHIGH (east) cross boundary
+$      RSL_DBDY_X           Distance to closest cross boundary
+$      RSL_CLOSEST_X        Closest cross boundary
+
+BREAKTHEEXAMPLECODE
+
+  Example:
+$      INTEGER LBDYINFO(CROSS_BDY_INFO_LEN)
+$      ...
+$      RSL_DO_N(J,1,JMAX)
+$        RSL_DO_M(I,1,IMAX)
+$          CALL RSL_GET_BDY_LPT( DID, GBDYINFO, CROSS_BDY_INFO_LEN, I, J )
+$          IF ( LBDYINFO(RSL_DBDY) .EQ. 1 ) THEN
+$            ...CODE TO EXECUTE ONLY ON OUTERMOST BOUNDARY CELLS...
+$          ENDIF
+$        RSL_ENDDO
+$      RSL_ENDDO
+$      
+BREAKTHEEXAMPLECODE
+
+  In this example, the boundary information in LBDYINFO is used to determine
+  the first boundary row or column during iteration over a domain.
+
+
+  See also:
+
+  RSL_GET_BDY_LPT, RSL_GET_BDY_LARRAY, RSL_GET_BDY_GPT,
+
+  RSL_GET_BDY_GARRAY
+
+
+@*/
+   
+RSL_GET_BDY_LPT ( d_p, bdyinf, n_p, i_p, j_p )
+  int_p 
+    d_p ;            /* (I) RSL domain descriptor */
+  int 
+    bdyinf[] ;       /* (O) Boundary information (see table) */
+  int_p 
+    n_p              /* (I) DOT_BDY_INFO_LEN or CROSS_BDY_INFO_LEN */
+   ,i_p              /* (I) M coordinate of point */
+   ,j_p ;            /* (I) N coordinate of point */
+{
+  int d ;
+  int i, j, nrun, ig, jg ;
+  int mloc, nloc, len, mtn ;
+  int mlen, idif, jdif ;
+  int *p ;
+  rsl_domain_info_t *dinfo ;
+  rsl_point_t *ddom, *pt ;
+
+  d = *d_p ;
+
+  if ( *n_p < DOT_BDY_INFO_LEN )
+  {
+    sprintf(mess, "argument for length of bdyinfo too small, %d < %d",
+	    *n_p, DOT_BDY_INFO_LEN ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_compute: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+
+  dinfo = &(domain_info[*d_p]) ;
+  ddom = dinfo->domain ;
+
+  mlen = dinfo->len_m ;
+  idif = dinfo->idif ;
+  jdif = dinfo->jdif ;
+
+  for ( p = bdyinf, i = 0 ; i < *n_p ; i++, p++ )
+  {
+    *p = RSL_INVALID ;
+  }
+  i = *i_p-1 ;
+  j = *j_p-1 ;
+  jg = j - jdif ;
+  ig = i - idif ;
+
+  pt = &(ddom[INDEX_2(jg,ig,mlen)]) ;
+
+  bdyinf[ RSL_MLOW      -1 ] = pt->dist_mlow ;
+  bdyinf[ RSL_MHIGH     -1 ] = pt->dist_mhigh ;
+  bdyinf[ RSL_NLOW      -1 ] = pt->dist_nlow ;
+  bdyinf[ RSL_NHIGH     -1 ] = pt->dist_nhigh ;
+  bdyinf[ RSL_DBDY      -1 ] = pt->dbdy ;
+  bdyinf[ RSL_CLOSEST   -1 ] = set_bdy_direction( pt->bdy_cclockwise,
+		   				  pt->bdy_clockwise ) ;
+
+  if ( *n_p > DOT_BDY_INFO_LEN && *n_p <= CROSS_BDY_INFO_LEN ) 
+  {
+    bdyinf[ RSL_MLOW_X    -1 ] = pt->dist_mlow_x ;
+    bdyinf[ RSL_MHIGH_X   -1 ] = pt->dist_mhigh_x ;
+    bdyinf[ RSL_NLOW_X    -1 ] = pt->dist_nlow_x ;
+    bdyinf[ RSL_NHIGH_X   -1 ] = pt->dist_nhigh_x ;
+    bdyinf[ RSL_DBDY_X    -1 ] = pt->dbdy_x ;
+    bdyinf[ RSL_CLOSEST_X -1 ] = set_bdy_direction( pt->bdy_x_cclockwise,
+		   				    pt->bdy_x_clockwise ) ;
+  }
+
+}
+
+
+/*@
+  RSL_GET_BDY_LARRAY  -- Get local array containing boundary information.
+
+  Notes:
+  This fills in the entries of Arg2, a 3-dimensional array of boundary information for
+  a domain.  The first two dimensions are the locally sized M and N dimensions
+  of the domain.  The array is indexed by the local domain indices and by the
+  third (most major) index that specifies the
+  information about the point (see table).
+
+  The variations of this routine are RSL_GET_BDY_LPT, RSL_GET_BDY_LARRAY,
+  RSL_GET_BDY_GPT, and RSL_GET_BDY_GARRAY.
+  
+  The first two dimensions of Arg2 must be declared MLOC and NLOC, the local array sizes returned
+  by the RSL domain definition routines RSL_MOTHER and the several nest spawning routines.
+  The third
+  dimension of Arg2 should be declared using one either CROSS_BDY_INFO_LEN or
+  DOT_BDY_INFO_LEN (if in doubt use CROSS_BDY_INFO_LEN, since it is larger).
+  These are defined in the file ``rsl.inc." Also use this constant as
+  Arg3 in the call to RSL_GET_BDY_LARRAY.  With DOT_BDY_INFO_LEN, the
+  routine will return
+  boundary information for a domain containing all points of the grid (i.e., the 
+  dot-boundaries of an Arakawa-B grid).
+  With CROSS_BDY_INFO_LEN, the routine will return the dot boundary information plus
+  the cross boundary information (i.e., the uppermost boundaries in M and N are at
+  M-1 and N-1).
+
+  Improper declaration and allocation
+  of memory for
+  Arg2 properly or an incorrect value for Arg3 may result in memory
+  being overwritten with unpredictable results.
+
+  The array Arg2 may be indexed to obtain the following information.
+
+  Verbatim:
+$      symbolic name        description
+$      (rsl.inc)          
+$      --------------------------------------------
+$
+$      RSL_MLOW             Distance to MLOW (south) boundary
+$      RSL_MHIGH            Distance to MHIGH (north) boundary
+$      RSL_NLOW             Distance to NLOW (west) boundary
+$      RSL_NHIGH            Distance to NHIGH (east) boundary
+$      RSL_DBDY             Distance to closest boundary
+$      RSL_CLOSEST          Closest boundary
+$
+$ Cross grid boundary information (Arakawa B)
+$
+$      RSL_MLOW_X           Distance to MLOW (south) cross boundary
+$      RSL_MHIGH_X          Distance to MHIGH (north) cross boundary
+$      RSL_NLOW_X           Distance to NLOW (west) cross boundary
+$      RSL_NHIGH_X          Distance to NHIGH (east) cross boundary
+$      RSL_DBDY_X           Distance to closest cross boundary
+$      RSL_CLOSEST_X        Closest cross boundary
+
+BREAKTHEEXAMPLECODE
+
+
+
+  Example:
+$      INTEGER, ALLOCATABLE :: LBDYINFO(:,:,:)
+$      ...
+$      ALLOCATE( LBDYINFO( MLOC, NLOC, CROSS_BDY_INFO_LEN ) )
+$      ...
+$      CALL RSL_GET_BDY_LARRAY( DID, LBDYINFO, CROSS_BDY_INFO_LEN )
+$      RSL_DO_N(J,1,JMAX)
+$        RSL_DO_M(I,1,IMAX)
+$          IF ( LBDYINFO(I,J,RSL_DBDY) .EQ. 1 ) THEN
+$            ...CODE TO EXECUTE ONLY ON OUTERMOST BOUNDARY CELLS...
+$          ENDIF
+$        RSL_ENDDO
+$      RSL_ENDDO
+$      
+BREAKTHEEXAMPLECODE
+
+
+  See also:
+
+  RSL_GET_BDY_LPT, RSL_GET_BDY_LARRAY, RSL_GET_BDY_GPT,
+
+  RSL_GET_BDY_GARRAY
+
+
+@*/
+
+RSL_GET_BDY_LARRAY ( d_p, bdyinf, n_p )
+  int_p d_p ;       /* (I) RSL domain descriptor */
+  int_p bdyinf ;    /* (O) A 3-dimensional array (see discussion) */
+  int_p n_p ;       /* (I) DOT_BDY_INFO_LEN or CROSS_BDY_INFO_LEN */
+{
+  int d ;
+  int cross ;
+  int i, j, nrun, ig, jg ;
+  int mloc, nloc, len, mtn ;
+  int mlen, idif, jdif ;
+  int *p ;
+  rsl_domain_info_t *dinfo ;
+  rsl_point_t *ddom, *pt ;
+
+  d = *d_p ;
+
+  if ( *n_p < DOT_BDY_INFO_LEN )
+  {
+    sprintf(mess, "argument for length of bdyinfo too small, %d < %d",
+            *n_p, DOT_BDY_INFO_LEN ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_compute: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+
+  dinfo = &(domain_info[*d_p]) ;
+  ddom = dinfo->domain ;
+
+  mlen = dinfo->len_m ;
+  mloc = dinfo->loc_m ;
+  nloc = dinfo->loc_n ;
+  mtn = mloc*nloc ;
+  idif = dinfo->idif ;
+  jdif = dinfo->jdif ;
+
+  for ( p = bdyinf, i = 0 ; i < *n_p*mtn ; i++, p++ )
+  {
+    *p = RSL_INVALID ;
+  }
+  for ( nrun = 0 ; nrun < domain_info[d].nrun[0] ; nrun++ )
+  {
+    j = dinfo->js[0][nrun]-1 ;
+    jg = j - jdif ;
+    for ( i = dinfo->is[0][nrun]-1 ; i <= dinfo->ie[0][nrun]-1 ; i++ )
+    {
+      ig = i - idif ;
+      pt = &(ddom[INDEX_2(jg,ig,mlen)]) ;
+      cross = pt->cross ;
+      p = &(bdyinf[INDEX_3(0,j,nloc,i,mloc)]) ;
+
+      *p = pt->dist_mlow    ; p+=mtn ;
+      *p = pt->dist_mhigh   ; p+=mtn ;
+      *p = pt->dist_nlow    ; p+=mtn ;
+      *p = pt->dist_nhigh   ; p+=mtn ;
+      *p = pt->dbdy         ; p+=mtn ;
+      *p = set_bdy_direction( pt->bdy_cclockwise,
+			      pt->bdy_clockwise ) ;
+			      p+=mtn ;
+
+      if ( *n_p > DOT_BDY_INFO_LEN && *n_p <= CROSS_BDY_INFO_LEN )
+      {
+	/* note that the increment of p is outside the if  and
+	   happens unconditionally */
+        if ( cross ) *p = pt->dist_mlow_x    ; p+=mtn ;
+        if ( cross ) *p = pt->dist_mhigh_x   ; p+=mtn ;
+        if ( cross ) *p = pt->dist_nlow_x    ; p+=mtn ;
+        if ( cross ) *p = pt->dist_nhigh_x   ; p+=mtn ;
+        if ( cross ) *p = pt->dbdy_x         ; p+=mtn ;
+        if ( cross ) *p = set_bdy_direction( pt->bdy_x_cclockwise,
+		           	             pt->bdy_x_clockwise ) ;
+			                       p+=mtn ;
+      }
+    }
+  }
+}
+
+RSL_GET_BDY_LARRAY2 ( d_p, bdyinf, n_p, mloc_p, nloc_p )
+  int_p d_p ;       /* (I) RSL domain descriptor */
+  int_p bdyinf ;    /* (O) A 3-dimensional array (see discussion) */
+  int_p n_p ;       /* (I) DOT_BDY_INFO_LEN or CROSS_BDY_INFO_LEN */
+  int_p mloc_p, nloc_p ; /* (I) m and n dimensions of bdyinf */
+{
+  int d ;
+  int cross ;
+  int i, j, nrun, ig, jg ;
+  int mloc, nloc, len, mtn ;
+  int mlen, idif, jdif ;
+  int *p ;
+  rsl_domain_info_t *dinfo ;
+  rsl_point_t *ddom, *pt ;
+
+  d = *d_p ;
+
+  if ( *n_p < DOT_BDY_INFO_LEN )
+  {
+    sprintf(mess, "argument for length of bdyinfo too small, %d < %d",
+            *n_p, DOT_BDY_INFO_LEN ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_compute: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+
+  dinfo = &(domain_info[*d_p]) ;
+  ddom = dinfo->domain ;
+
+  mlen = dinfo->len_m ;
+  mloc = *mloc_p ;
+  nloc = *nloc_p ;
+  mtn = mloc*nloc ;
+  idif = dinfo->idif ;
+  jdif = dinfo->jdif ;
+
+  for ( p = bdyinf, i = 0 ; i < *n_p*mtn ; i++, p++ )
+  {
+    *p = RSL_INVALID ;
+  }
+  for ( nrun = 0 ; nrun < domain_info[d].nrun[0] ; nrun++ )
+  {
+    j = dinfo->js[0][nrun]-1 ;
+    jg = j - jdif ;
+    for ( i = dinfo->is[0][nrun]-1 ; i <= dinfo->ie[0][nrun]-1 ; i++ )
+    {
+      ig = i - idif ;
+      pt = &(ddom[INDEX_2(jg,ig,mlen)]) ;
+      cross = pt->cross ;
+      p = &(bdyinf[INDEX_3(0,j,nloc,i,mloc)]) ;
+
+      *p = pt->dist_mlow    ; p+=mtn ;
+      *p = pt->dist_mhigh   ; p+=mtn ;
+      *p = pt->dist_nlow    ; p+=mtn ;
+      *p = pt->dist_nhigh   ; p+=mtn ;
+      *p = pt->dbdy         ; p+=mtn ;
+      *p = set_bdy_direction( pt->bdy_cclockwise,
+			      pt->bdy_clockwise ) ;
+			      p+=mtn ;
+
+      if ( *n_p > DOT_BDY_INFO_LEN && *n_p <= CROSS_BDY_INFO_LEN )
+      {
+	/* note that the increment of p is outside the if  and
+	   happens unconditionally */
+        if ( cross ) *p = pt->dist_mlow_x    ; p+=mtn ;
+        if ( cross ) *p = pt->dist_mhigh_x   ; p+=mtn ;
+        if ( cross ) *p = pt->dist_nlow_x    ; p+=mtn ;
+        if ( cross ) *p = pt->dist_nhigh_x   ; p+=mtn ;
+        if ( cross ) *p = pt->dbdy_x         ; p+=mtn ;
+        if ( cross ) *p = set_bdy_direction( pt->bdy_x_cclockwise,
+		           	             pt->bdy_x_clockwise ) ;
+			                       p+=mtn ;
+      }
+    }
+  }
+}
+
+
+/* These are like the other routines but return the global (undecomposed)
+   boundary data for a domain.  Bdyinf would be indexed by ig and jg,
+   rather than i and j in the calling program.  */
+
+/*@
+  RSL_GET_BDY_GPT  -- Get boundary information for a globally indexed point.
+
+  Notes:
+  This returns boundary information for a globally specified point in the integer
+  array Arg2. The information is useful with irregularly shaped nests
+  (see RSL_SPAWN_IRREG_NEST), in which boundary proximity is not easily determined
+  from loop indices.
+
+  The variations of this routine are RSL_GET_BDY_LPT, RSL_GET_BDY_LARRAY,
+  RSL_GET_BDY_GPT, and RSL_GET_BDY_GARRAY.
+
+  The argument Arg3 should be either DOT_BDY_INFO_LEN or 
+  CROSS_BDY_INFO_LEN (defined in the file rsl.inc).  With DOT_BDY_INFO_LEN, the
+  routine will return
+  boundary information for a domain containing all points of the grid (i.e., the 
+  dot-boundaries of an Arakawa-B grid).
+  With CROSS_BDY_INFO_LEN, the routine will return the dot boundary information plus
+  the cross boundary information (i.e., the uppermost boundaries in M and N are at
+  M-1 and N-1).
+
+  The array Arg2 may be indexed to obtain the following information.
+
+  Verbatim:
+$      symbolic name        description
+$      (rsl.inc)          
+$      --------------------------------------------
+$
+$      RSL_MLOW             Distance to MLOW (south) boundary
+$      RSL_MHIGH            Distance to MHIGH (north) boundary
+$      RSL_NLOW             Distance to NLOW (west) boundary
+$      RSL_NHIGH            Distance to NHIGH (east) boundary
+$      RSL_DBDY             Distance to closest boundary
+$      RSL_CLOSEST          Closest boundary
+$
+$ Cross grid boundary information (Arakawa B)
+$
+$      RSL_MLOW_X           Distance to MLOW (south) cross boundary
+$      RSL_MHIGH_X          Distance to MHIGH (north) cross boundary
+$      RSL_NLOW_X           Distance to NLOW (west) cross boundary
+$      RSL_NHIGH_X          Distance to NHIGH (east) cross boundary
+$      RSL_DBDY_X           Distance to closest cross boundary
+$      RSL_CLOSEST_X        Closest cross boundary
+
+BREAKTHEEXAMPLECODE
+
+  Example:
+$      INTEGER GBDYINFO(CROSS_BDY_INFO_LEN)
+$      ...
+$      RSL_DO_N(J,1,JMAX)
+$        RSL_DO_M(I,1,IMAX)
+$          CALL RSL_GET_BDY_GPT( DID, GBDYINFO, CROSS_BDY_INFO_LEN, IG, JG )
+$          IF ( GBDYINFO(RSL_DBDY) .EQ. 1 ) THEN
+$            ...CODE TO EXECUTE ONLY ON OUTERMOST BOUNDARY CELLS...
+$          ENDIF
+$        RSL_ENDDO
+$      RSL_ENDDO
+$      
+BREAKTHEEXAMPLECODE
+
+  In this example, the boundary information in GBDYINFO is used to determine
+  the first boundary row or column during iteration over a domain.  The reserved
+  global index variables IG and JG are set by the RSL_DO macros.
+
+  See also:
+
+  RSL_GET_BDY_LPT, RSL_GET_BDY_LARRAY, RSL_GET_BDY_GPT,
+
+  RSL_GET_BDY_GARRAY
+
+@*/
+
+
+RSL_GET_BDY_GPT ( d_p, bdyinf, n_p, ig_p, jg_p )
+  int_p 
+    d_p ;            /* (I) RSL domain descriptor */
+  int 
+    bdyinf[] ;       /* (O) Boundary information (see table). */
+  int_p 
+    n_p              /* (I) DOT_BDY_INFO_LEN or CROSS_BDY_INFO_LEN */
+   ,ig_p             /* (I) Global index into M dimension */
+   ,jg_p ;           /* (I) Global index into N dimension */
+{
+  int d ;
+  int i, j ;
+  int mlen, nlen ;
+  int *p ;
+  rsl_domain_info_t *dinfo ;
+  rsl_point_t *ddom, *pt ;
+
+  d = *d_p ;
+
+  if ( *n_p < DOT_BDY_INFO_LEN )
+  {
+    sprintf(mess, "argument for length of bdyinfo too small, %d < %d",
+            *n_p, DOT_BDY_INFO_LEN ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_compute: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+
+  dinfo = &(domain_info[*d_p]) ;
+  ddom = dinfo->domain ;
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+
+  for ( p = bdyinf, i = 0 ; i < *n_p ; i++, p++ )
+  {
+    *p = RSL_INVALID ;
+  }
+
+  j = *jg_p-1 ;
+  i = *ig_p-1 ;
+
+  pt = &(ddom[INDEX_2(j,i,mlen)]) ;
+
+  bdyinf[ RSL_MLOW      -1 ] = pt->dist_mlow ;
+  bdyinf[ RSL_MHIGH     -1 ] = pt->dist_mhigh ;
+  bdyinf[ RSL_NLOW      -1 ] = pt->dist_nlow ;
+  bdyinf[ RSL_NHIGH     -1 ] = pt->dist_nhigh ;
+  bdyinf[ RSL_DBDY      -1 ] = pt->dbdy ;
+  bdyinf[ RSL_CLOSEST   -1 ] = set_bdy_direction( pt->bdy_cclockwise,
+                                                  pt->bdy_clockwise ) ;
+
+  if ( *n_p > DOT_BDY_INFO_LEN && *n_p <= CROSS_BDY_INFO_LEN )
+  {
+    bdyinf[ RSL_MLOW_X    -1 ] = pt->dist_mlow_x ;
+    bdyinf[ RSL_MHIGH_X   -1 ] = pt->dist_mhigh_x ;
+    bdyinf[ RSL_NLOW_X    -1 ] = pt->dist_nlow_x ;
+    bdyinf[ RSL_NHIGH_X   -1 ] = pt->dist_nhigh_x ;
+    bdyinf[ RSL_DBDY_X    -1 ] = pt->dbdy_x ;
+    bdyinf[ RSL_CLOSEST_X -1 ] = set_bdy_direction( pt->bdy_x_cclockwise,
+                                                    pt->bdy_x_clockwise ) ;
+  }
+
+}
+
+/*@
+  RSL_GET_BDY_GARRAY  -- Get global array containing boundary information.
+
+  Notes:
+  This fills in the entries of Arg2, a 3-dimensional array of boundary information for
+  a domain.  The first two dimensions are the globally sized M and N dimensions
+  of the domain.  The array is indexed by the global domain indices and by the
+  third (most major) index that specifies the
+  information about the point (see table).
+
+  The variations of this routine are RSL_GET_BDY_LPT, RSL_GET_BDY_LARRAY,
+  RSL_GET_BDY_GPT, and RSL_GET_BDY_GARRAY.
+  
+  The first two dimensions of Arg2 must be declared M and N, the global array sizes returned
+  by the RSL domain definition routines RSL_MOTHER and the several nest spawning routines.
+  The third
+  dimension of Arg2 should be declared using one either CROSS_BDY_INFO_LEN or
+  DOT_BDY_INFO_LEN (if in doubt use CROSS_BDY_INFO_LEN, since it is larger).
+  These are defined in the file ``rsl.inc." Also use this constant as
+  Arg3 in the call to RSL_GET_BDY_LARRAY.  With DOT_BDY_INFO_LEN, the
+  routine will return
+  boundary information for a domain containing all points of the grid (i.e., the 
+  dot-boundaries of an Arakawa-B grid).
+  With CROSS_BDY_INFO_LEN, the routine will return the dot boundary information plus
+  the cross boundary information (i.e., the uppermost boundaries in M and N are at
+  M-1 and N-1).
+
+  Improper declaration and allocation
+  of memory for
+  Arg2 properly or an incorrect value for Arg3 may result in memory
+  being overwritten with unpredictable results.
+
+  The array Arg2 may be indexed to obtain the following information.
+
+  Verbatim:
+$      symbolic name        description
+$      (rsl.inc)          
+$      --------------------------------------------
+$
+$      RSL_MLOW             Distance to MLOW (south) boundary
+$      RSL_MHIGH            Distance to MHIGH (north) boundary
+$      RSL_NLOW             Distance to NLOW (west) boundary
+$      RSL_NHIGH            Distance to NHIGH (east) boundary
+$      RSL_DBDY             Distance to closest boundary
+$      RSL_CLOSEST          Closest boundary
+$
+$ Cross grid boundary information (Arakawa B)
+$
+$      RSL_MLOW_X           Distance to MLOW (south) cross boundary
+$      RSL_MHIGH_X          Distance to MHIGH (north) cross boundary
+$      RSL_NLOW_X           Distance to NLOW (west) cross boundary
+$      RSL_NHIGH_X          Distance to NHIGH (east) cross boundary
+$      RSL_DBDY_X           Distance to closest cross boundary
+$      RSL_CLOSEST_X        Closest cross boundary
+
+
+BREAKTHEEXAMPLECODE
+
+  Example:
+$      INTEGER, ALLOCATABLE :: GBDYINFO(:,:,:)
+$      ...
+$      ALLOCATE( GBDYINFO( M, N, CROSS_BDY_INFO_LEN ) )
+$      ...
+$      CALL RSL_GET_BDY_LARRAY( DID, GBDYINFO, CROSS_BDY_INFO_LEN )
+$      ...
+$      RSL_DO_N(J,1,JMAX)
+$        RSL_DO_M(I,1,IMAX)
+$          IF ( GBDYINFO(IG,JG,RSL_DBDY) .EQ. 1 ) THEN
+$            ...CODE TO EXECUTE ONLY ON OUTERMOST BOUNDARY CELLS...
+$          ENDIF
+$        RSL_ENDDO
+$      RSL_ENDDO
+$      
+BREAKTHEEXAMPLECODE
+
+  In this example, the boundary information array GBDYINFO is used to determine
+  the first boundary row or column during iteration over a domain.  The reserved
+  global index variables IG and JG are set by the RSL_DO macros.
+
+
+  See also:
+
+  RSL_GET_BDY_LPT, RSL_GET_BDY_LARRAY, RSL_GET_BDY_GPT,
+
+  RSL_GET_BDY_GARRAY
+
+
+@*/
+
+RSL_GET_BDY_GARRAY ( d_p, bdyinf, n_p )
+  int_p d_p ;         /* (I) RSL domain descriptor */
+  int_p bdyinf ;      /* (O) A 3-dimensional array (see discussion) */
+  int_p n_p ;         /* (I) DOT_BDY_INFO_LEN or CROSS_BDY_INFO_LEN */
+{
+  int d ;
+  int i, j ;
+  int mtn ;
+  int mlen, nlen ;
+  int cross ;
+  int *p ;
+  rsl_domain_info_t *dinfo ;
+  rsl_point_t *ddom, *pt ;
+
+  d = *d_p ;
+
+  if ( *n_p < DOT_BDY_INFO_LEN )
+  {
+    sprintf(mess, "argument for length of bdyinfo too small, %d < %d",
+            *n_p, DOT_BDY_INFO_LEN ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_compute: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+
+  dinfo = &(domain_info[*d_p]) ;
+  ddom = dinfo->domain ;
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+  mtn = mlen*nlen ;
+
+  for ( p = bdyinf, i = 0 ; i < 2*mtn ; i++, p++ )
+  {
+    *p = RSL_INVALID ;
+  }
+  for ( j = 0 ; j < nlen ; j++ )
+  {
+    for ( i = 0 ; i < mlen ; i++ )
+    {
+      pt = &(ddom[INDEX_2(j,i,mlen)]) ;
+      cross = pt->cross ;
+      p = &(bdyinf[INDEX_3(0,j,nlen,i,mlen)]) ;
+
+      *p = pt->dist_mlow    ; p+=mtn ;
+      *p = pt->dist_mhigh   ; p+=mtn ;
+      *p = pt->dist_nlow    ; p+=mtn ;
+      *p = pt->dist_nhigh   ; p+=mtn ;
+      *p = pt->dbdy         ; p+=mtn ;
+      *p = set_bdy_direction( pt->bdy_cclockwise,
+                              pt->bdy_clockwise ) ;
+                              p+=mtn ;
+
+      if ( *n_p > DOT_BDY_INFO_LEN && *n_p <= CROSS_BDY_INFO_LEN )
+      {
+        /* note that the increment of p is outside the if  and
+           happens unconditionally */
+        if ( cross ) *p = pt->dist_mlow_x    ; p+=mtn ;
+        if ( cross ) *p = pt->dist_mhigh_x   ; p+=mtn ;
+        if ( cross ) *p = pt->dist_nlow_x    ; p+=mtn ;
+        if ( cross ) *p = pt->dist_nhigh_x   ; p+=mtn ;
+        if ( cross ) *p = pt->dbdy_x         ; p+=mtn ;
+        if ( cross ) *p = set_bdy_direction( pt->bdy_x_cclockwise,
+                                             pt->bdy_x_clockwise ) ;
+                                               p+=mtn ;
+      }
+    }
+  }
+}
+
+
+/*****************************************/
+/* bits in closest are mapped as follows */
+/*                                       */
+/*       5  6  7                         */
+/*       3     4                         */
+/*       0  1  2                         */
+/*                                       */
+/*****************************************/
+set_bdy_direction( cclock, clock )
+  int cclock,	/* dir to closest boundary from counter-clockwise traversal */
+      clock ;   /* dir to closest boundary from clockwise traversal */
+{
+  /* if they agree, fine.  Just return */
+  if ( cclock == clock ) return(cclock) ;
+
+  /* otherwise, resolve the disagrement using one of several strategies */
+
+  if      ( tiebreaker == M_WINS )
+  {
+    if      ( cclock == RSL_MLOW || cclock == RSL_MHIGH )
+      return( cclock ) ;
+    else if ( clock == RSL_MLOW || clock == RSL_MHIGH )
+      return( clock ) ;
+    else
+      return( RSL_INVALID ) ;
+  }
+  else if ( tiebreaker == N_WINS ) 
+  {
+    if      ( cclock == RSL_NLOW || cclock == RSL_NHIGH )
+      return( cclock ) ;
+    else if ( clock == RSL_NLOW || clock == RSL_NHIGH )
+      return( clock ) ;
+    else
+      return( RSL_INVALID ) ;
+  }
+  else if ( tiebreaker == DIAG_WINS )
+  {
+    if      (( cclock == RSL_MLOW &&  clock == RSL_NLOW ) ||
+	     (  clock == RSL_MLOW && cclock == RSL_NLOW ))
+      return( RSL_00 ) ;
+    else if (( cclock == RSL_MHIGH &&  clock == RSL_NLOW )||
+	     (  clock == RSL_MHIGH && cclock == RSL_NLOW ))
+      return( RSL_M0 ) ;
+    else if (( cclock == RSL_MLOW &&  clock == RSL_NHIGH ) ||
+	     (  clock == RSL_MLOW && cclock == RSL_NHIGH ))
+      return( RSL_0N ) ;
+    else if (( cclock == RSL_MHIGH &&  clock == RSL_NHIGH ) ||
+	     (  clock == RSL_MHIGH && cclock == RSL_NHIGH ))
+      return( RSL_MN ) ;
+    else
+      return( RSL_INVALID ) ;
+  }
+  else
+    RSL_TEST_ERR(1,"no such strategy") ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/handle_spec1.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/handle_spec1.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/handle_spec1.c	(revision 2744)
@@ -0,0 +1,236 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* this routine is specific to MM5.  It's purpose is to read in boundary
+   data from the boundary file and these records have unusual shapes.  There
+   are also multiple fields per record.  For not it easier to do this this
+   was, with a special routine, than to incorporate the necessary generality
+   into rsl.  This particular implementation of this is especially 
+   dreadful -- there is ample room for improvement as time permits. */
+
+/* IMPORTANT -- note that the three-d variables have k (level) as their
+   second, not third, dimension in MM5.  EG:  ueb(MIX,MKX,NSPGD)  2/1/94 */
+
+/* rev: 2/3/94, added code to pass and receive extra boundary points to 
+   neighboring processors along a 4 pt stencil */
+
+/* rev: 7/14/94, changed to a 12 pt stencil to make sure we have enough
+   points for the dot and the cross grids.   Also modified rsl_mm_io.c */
+
+/* rev: 9/8/94, fixed memory leak wherein pbuf was only freed when 
+   rsl_myproc was equal to mdest.  Change to free unconditionally
+   for each of the boundaries.  */
+
+/* rev: 1/10/95, added test to make sure domain is always c.d.  This
+   function will not work properly on a nest and should never be
+   called on one.  MM5 does not read in boundary data on a nest. */
+
+int
+handle_special1( req, buf_e, esz,
+		      buf_w, wsz,
+	              buf_n, nsz,
+		      buf_s, ssz )
+  rsl_read_req_t * req ;
+  char **buf_e, **buf_w, **buf_n, **buf_s ;
+  int *wsz, *esz, *nsz, *ssz ;
+{
+  int dim, i, k, ig, jg, d ;
+  int maj, min, majlen, minlen ;
+  int nelem_ns, nelem_ew, nbytes, typelen, len, cursor  ;
+  int P ;
+  int bwdth ;
+  int mlen, mtag, mdest ;
+  int psendto[ RSL_MAXPROC ] ;    /* size of messages to each processor */
+  char *rbuf_e, *rbuf_w, *rbuf_n, *rbuf_s, *rbuf_tot ;
+  rsl_point_t *domain ;
+  int i_am_monitor ;
+
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+
+  bwdth = req->speciala ;
+
+  nelem_ns = bwdth * req->glen[1] * ( req->ndim==3?req->glen[2]:1 ) ;
+  nelem_ew = bwdth * req->glen[0] * ( req->ndim==3?req->glen[2]:1 ) ;
+
+  typelen = elemsize( req->type ) ;
+
+  *wsz = nelem_ew * typelen ;
+  *esz = nelem_ew * typelen ;
+  *nsz = nelem_ns * typelen ;
+  *ssz = nelem_ns * typelen ;
+
+  /* figure out sizes of buffers needed */
+              /*caller will free */
+  rbuf_tot = RSL_MALLOC( char, 2*(nelem_ew+nelem_ns)*typelen+100) ; /* 100 is safety */
+  *buf_e = &( rbuf_tot[ 0                                      ] ) ;
+  *buf_w = &( rbuf_tot[ 1 * nelem_ew                 * typelen ] ) ;  
+  *buf_n = &( rbuf_tot[ 2 * nelem_ew                 * typelen ] ) ;  
+  *buf_s = &( rbuf_tot[(2 * nelem_ew + 1 * nelem_ns) * typelen ] ) ;  
+
+  if ( i_am_monitor )
+  {
+    /* call fortran to read a record from the named unit */
+    switch ( req->type )
+    {
+    case RSL_REAL :
+      FORT_BDYIN_REAL ( &(req->unit), 
+             *buf_e, *buf_w, *buf_n, *buf_s, &nelem_ew, &nelem_ns ) ;
+      break ;
+#ifndef T3D
+    case RSL_DOUBLE :
+      FORT_BDYIN_DBL ( &(req->unit),
+             *buf_e, *buf_w, *buf_n, *buf_s, &nelem_ew, &nelem_ns ) ;
+      break ;
+#endif
+    default :
+      RSL_TEST_WRN(1,"read operation not yet implemented for this data type") ;
+    }
+  }
+
+  d = req->domain ;
+  RSL_TEST_ERR( d != 0,
+		"attempt to read boundary data on domain other than c.d.") ;
+  majlen = domain_info[d].len_n ;
+  minlen = domain_info[d].len_m ;
+  domain = domain_info[d].domain ;
+
+  for ( i = 0 ; i < rsl_nproc_all ; i++ ) 	/* 95/02/22 */
+  {
+    psendto[i] = 0 ;
+  }
+  /*  figure out sizes for each processor */
+  for ( jg = 0 ; jg < majlen ; jg++ )
+  {
+    for ( ig = 0 ; ig < minlen ; ig++ )
+    {
+        domain[INDEX_2(jg,ig,minlen)].info_1 = 0 ;
+    }
+  }
+  for ( jg = 0 ; jg < majlen ; jg++ )
+  {
+    for ( ig = 0 ; ig < minlen ; ig++ )
+    {
+      if ( jg < bwdth )                             /* west  1 */
+      {
+        domain[INDEX_2(jg,ig,minlen)].info_1 = domain[INDEX_2(jg,ig,minlen)].info_1 | 1 ; /* mark on wbdy */
+        psendto[domain[INDEX_2(jg,ig,minlen)].P] = 1 ;
+      }
+      if ( jg >= majlen - bwdth && jg <  majlen )   /* east  2 */
+      {
+        domain[INDEX_2(jg,ig,minlen)].info_1 = domain[INDEX_2(jg,ig,minlen)].info_1 | 2 ; /* mark on edy */
+        psendto[domain[INDEX_2(jg,ig,minlen)].P] = 1 ;
+      }
+      if ( ig >= minlen - bwdth && ig <  minlen )   /* north 8 */
+      {
+        domain[INDEX_2(jg,ig,minlen)].info_1 = domain[INDEX_2(jg,ig,minlen)].info_1 | 8 ; /* mark on nbdy */
+        psendto[domain[INDEX_2(jg,ig,minlen)].P] = 1 ;
+      }
+      if ( ig < bwdth )                             /* south 4 */
+      {
+        domain[INDEX_2(jg,ig,minlen)].info_1 = domain[INDEX_2(jg,ig,minlen)].info_1 | 4 ; /* mark on sbdy */
+        psendto[domain[INDEX_2(jg,ig,minlen)].P] = 1 ;
+      }
+    }
+  }
+
+  if ( i_am_monitor )
+  {
+    for ( P = 0 ; P < rsl_nproc_all ; P++ )	/* 95/02/22 */
+    {
+      if ( psendto[P] != 0 )
+      {
+        mdest = rsl_c_comp2phys_proc( P ) ;
+        if ( ! mdest == rsl_myproc )
+        {
+          mtag = MTYPE_FROMTO( MSG_SPECIAL1_RESPONSE, rsl_myproc, mdest ) ;
+          mlen = 2*(nelem_ew+nelem_ns)*typelen ;
+          RSL_SEND( rbuf_tot, mlen, mtag, mdest ) ;
+        }
+        }
+    }
+  }
+  else
+  {
+    if ( psendto[rsl_c_phys2comp_proc(rsl_myproc)] )
+    {
+      mdest = RSL_C_MONITOR_PROC () ;
+      mtag = MTYPE_FROMTO( MSG_SPECIAL1_RESPONSE, mdest, rsl_myproc ) ;
+      mlen = 2*(nelem_ew+nelem_ns)*typelen ;
+      RSL_RECV( rbuf_tot, mlen, mtag ) ;
+    }
+  }
+
+  if ( psendto[rsl_c_phys2comp_proc(rsl_myproc)] )
+    return( 2*(nelem_ew+nelem_ns)*typelen ) ;  /* whether to expect message */
+  else
+    return(0) ;
+
+}
+
+bdymark( d, ig, jg, hig, hjg, pt, ipt )
+  int d, ig, jg, hig, hjg, pt, ipt ;
+{ 
+  int minlen ;
+
+  minlen = domain_info[d].len_m ;
+  if ( domain_info[d].domain[INDEX_2(jg,ig,minlen)].info_1 == 1 )
+    domain_info[d].domain[INDEX_2(jg,ig,minlen)].info_2 = 1 ; /* mark for this proc */
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/handle_spec2.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/handle_spec2.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/handle_spec2.c	(revision 2744)
@@ -0,0 +1,110 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* for reading in replicated data */
+
+int
+handle_special2( req )
+  rsl_read_req_t * req ;
+{
+  int mlen, mtag, mdest ;
+  rsl_read_resp_t resp ;
+  char *rbuf ;
+  int nbytes ;
+  int P ;
+
+#ifdef T3D
+fprintf(stderr,"handle_special2 called - disabled on T3D.  Stopping\n") ;
+exit(3) ;
+#endif
+
+  /* is this a new request?  if so, service it.  otherwise, it has already
+  being handled -- discard the message */
+
+  if ( req->sequence <= io_seq_monitor ) return(0) ;
+  if ( req->sequence > io_seq_monitor+1 )
+  {
+    sprintf(mess,"handle_read_request: sequence number race %d > %d",
+	   req->sequence, io_seq_monitor+1 ) ;
+    RSL_TEST_ERR(1,mess) ;
+  }
+  /* req->sequence equals io_seq_monitor+1 */
+  io_seq_monitor++ ;
+
+  nbytes = req->speciala ;
+  rbuf = RSL_MALLOC( char, nbytes ) ;
+
+  FORT_CHARACTERREAD ( &(req->unit), rbuf, &nbytes ) ;
+
+  resp.sequence = req->sequence ;
+
+  for ( P = 0 ; P < rsl_nproc ; P++ )
+  {
+    mdest = rsl_c_comp2phys_proc(P) ;
+    mtag = MTYPE_FROMTO( MSG_SPECIAL2_RESPONSE, rsl_myproc, mdest ) ;
+    mlen = sizeof( resp ) ;
+    RSL_SEND( &resp, mlen, mtag, mdest ) ;
+    mlen = nbytes ;
+    RSL_SEND( rbuf, mlen, mtag, mdest ) ;
+  }
+
+  RSL_FREE( rbuf ) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/handle_spec3.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/handle_spec3.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/handle_spec3.c	(revision 2744)
@@ -0,0 +1,189 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+#include "which_boundary.h"
+
+/* this routine is specific to MM5.  It's purpose is to read in boundary
+   data from the boundary file and these records have unusual shapes.  There
+   are also multiple fields per record.  For not it easier to do this this
+   was, with a special routine, than to incorporate the necessary generality
+   into rsl.  This particular implementation of this is especially 
+   dreadful -- there is ample room for improvement as time permits. */
+
+/* IMPORTANT -- note that the three-d variables have k (level) as their
+   second, not third, dimension in MM5.  EG:  ueb(MIX,MKX,NSPGD)  2/1/94 */
+
+/* rev: 2/3/94, added code to pass and receive extra boundary points to 
+   neighboring processors along a 4 pt stencil */
+
+/* rev: 7/14/94, changed to a 12 pt stencil to make sure we have enough
+   points for the dot and the cross grids.   Also modified rsl_mm_io.c */
+
+/* rev: 9/8/94, fixed memory leak wherein pbuf was only freed when 
+   rsl_myproc was equal to mdest.  Change to free unconditionally
+   for each of the boundaries.  */
+
+/* rev: 1/10/95, added test to make sure domain is always c.d.  This
+   function will not work properly on a nest and should never be
+   called on one.  MM5 does not read in boundary data on a nest. */
+
+int
+handle_special3( req, which_boundary, rbuf, buf ) 
+  rsl_read_req_t * req ;
+  int which_boundary ;
+  char *rbuf ;
+  char **buf ;
+{
+  int dim, i, k, ig, jg, d ;
+  int maj, min, majlen, minlen ;
+  int nelem ;
+  int P ;
+  int bwdth ;
+  int mlen, mtag, mdest ;
+  int psendto[ RSL_MAXPROC ] ;    /* size of messages to each processor */
+  rsl_point_t *domain ;
+  int i_am_monitor ;
+  int typelen ;
+
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+
+  bwdth = req->speciala ;
+
+  if      ( which_boundary == WHICH_BDY_NORTH || which_boundary == WHICH_BDY_SOUTH )
+    nelem = bwdth * req->glen[1] * ( req->ndim==3?req->glen[2]:1 ) ;
+  else if ( which_boundary == WHICH_BDY_WEST || which_boundary == WHICH_BDY_EAST )
+    nelem = bwdth * req->glen[0] * ( req->ndim==3?req->glen[2]:1 ) ;
+  else
+    RSL_TEST_ERR(1,"handle_special3 bad which_boundary") ;
+
+  typelen = elemsize( req->type ) ;
+
+  /* figure out sizes of buffers needed */
+              /*caller will free */
+  *buf = RSL_MALLOC( char, nelem*typelen+100) ; /* 100 is safety */
+
+  d = req->domain ;
+  RSL_TEST_ERR( d != 0,
+		"attempt to read boundary data on domain other than c.d.") ;
+  majlen = domain_info[d].len_n ;
+  minlen = domain_info[d].len_m ;
+  domain = domain_info[d].domain ;
+
+  for ( i = 0 ; i < rsl_nproc_all ; i++ ) 	/* 95/02/22 */
+  {
+    psendto[i] = 0 ;
+  }
+  for ( jg = 0 ; jg < majlen ; jg++ )
+  {
+    for ( ig = 0 ; ig < minlen ; ig++ )
+    {
+      if ( jg < bwdth )                             /* west  1 */
+      {
+        psendto[domain[INDEX_2(jg,ig,minlen)].P] = 1 ;
+      }
+      if ( jg >= majlen - bwdth && jg <  majlen )   /* east  2 */
+      {
+        psendto[domain[INDEX_2(jg,ig,minlen)].P] = 1 ;
+      }
+      if ( ig >= minlen - bwdth && ig <  minlen )   /* north 8 */
+      {
+        psendto[domain[INDEX_2(jg,ig,minlen)].P] = 1 ;
+      }
+      if ( ig < bwdth )                             /* south 4 */
+      {
+        psendto[domain[INDEX_2(jg,ig,minlen)].P] = 1 ;
+      }
+    }
+  }
+
+  if ( i_am_monitor )
+  {
+    for ( P = 0 ; P < rsl_nproc_all ; P++ )	/* 95/02/22 */
+    {
+      if ( psendto[P] != 0 )
+      {
+        mdest = rsl_c_comp2phys_proc( P ) ;
+        if ( ! mdest == rsl_myproc )
+        {
+          mtag = MTYPE_FROMTO( MSG_SPECIAL1_RESPONSE, rsl_myproc, mdest ) ;
+          mlen = nelem*typelen ;
+          RSL_SEND( rbuf, mlen, mtag, mdest ) ;
+        }
+      }
+    }
+    bcopy( rbuf, *buf, nelem*typelen ) ;
+  }
+  else
+  {
+    if ( psendto[rsl_c_phys2comp_proc(rsl_myproc)] )
+    {
+      mdest = RSL_C_MONITOR_PROC () ;
+      mtag = MTYPE_FROMTO( MSG_SPECIAL1_RESPONSE, mdest, rsl_myproc ) ;
+      mlen = nelem*typelen ;
+      RSL_RECV( *buf, mlen, mtag ) ;
+    }
+  }
+
+  if ( psendto[rsl_c_phys2comp_proc(rsl_myproc)] )
+    return( nelem*typelen ) ;  /* whether to expect message */
+  else
+    return(0) ;
+
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/index.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/index.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/index.c	(revision 2744)
@@ -0,0 +1,89 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+/* function versions of indexing macros */
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+rsl_point_id_t
+pointid( d, j, i )
+  rsl_index_t d, j, i ;
+{
+  return(POINTID(d,j,i)) ;
+}
+
+rsl_index_t
+id_domain( m )
+  rsl_point_id_t m ;
+{
+  return(ID_DOMAIN(m)) ;
+}
+
+rsl_index_t
+id_jdex(m)
+  rsl_point_id_t m ;
+{
+  return(ID_JDEX(m)) ;
+}
+
+rsl_index_t
+id_idex(m)
+  rsl_point_id_t m ;
+{
+  return(ID_IDEX(m)) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/invoke_pf.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/invoke_pf.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/invoke_pf.c	(revision 2744)
@@ -0,0 +1,141 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#define MAXDOM_MAKE 1
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*#define A(I) b->[I]*/
+#define A(I) x[I]
+
+invoke_pf( nflds, f,
+           parent_nl, child_nl,
+	   p_i, p_j, p_ig, p_jg,
+	   n_ig, n_jg,
+	   cm1, cn1, buf, n )
+  int nflds ;
+  int (*f)() ;
+  int_p    parent_nl, child_nl,
+	   p_i, p_j, p_ig, p_jg,
+	   n_ig, n_jg,
+	   cm1, cn1, buf, n ;
+{
+  int x[900] ;		/* remove -- testing only */
+
+  RSL_TEST_ERR( nflds > 50 || nflds < 0, "nflds out of range") ;
+  /* the following case statement was genenerated by the script
+     generate_invoke.csh (I did not type this in by hand!) */
+  switch (nflds)
+  {
+case     0 : (*f)() ; break ;
+case     1 : (*f)(A(0)); break ;
+case     2 : (*f)(A(0),A(1)); break ;
+case     3 : (*f)(A(0),A(1),A(2)); break ;
+case     4 : (*f)(A(0),A(1),A(2),A(3)); break ;
+case     5 : (*f)(A(0),A(1),A(2),A(3),A(4)); break ;
+case     6 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5)); break ;
+case     7 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6)); break ;
+case     8 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7)); break ;
+case     9 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8)); break ;
+case    10 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9)); break ;
+case    11 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10)); break ;
+case    12 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11)); break ;
+case    13 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12)); break ;
+case    14 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13)); break ;
+case    15 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14)); break ;
+case    16 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15)); break ;
+case    17 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16)); break ;
+case    18 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17)); break ;
+case    19 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18)); break ;
+case    20 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19)); break ;
+case    21 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20)); break ;
+case    22 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21)); break ;
+case    23 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22)); break ;
+case    24 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23)); break ;
+case    25 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24)); break ;
+case    26 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25)); break ;
+case    27 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26)); break ;
+case    28 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27)); break ;
+case    29 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28)); break ;
+case    30 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29)); break ;
+case    31 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30)); break ;
+case    32 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31)); break ;
+case    33 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32)); break ;
+case    34 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33)); break ;
+case    35 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34)); break ;
+case    36 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35)); break ;
+case    37 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36)); break ;
+case    38 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37)); break ;
+case    39 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38)); break ;
+case    40 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39)); break ;
+case    41 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40)); break ;
+case    42 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40),A(41)); break ;
+case    43 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40),A(41),A(42)); break ;
+case    44 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40),A(41),A(42),A(43)); break ;
+case    45 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40),A(41),A(42),A(43),A(44)); break ;
+case    46 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40),A(41),A(42),A(43),A(44),A(45)); break ;
+case    47 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40),A(41),A(42),A(43),A(44),A(45),A(46)); break ;
+case    48 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40),A(41),A(42),A(43),A(44),A(45),A(46),A(47)); break ;
+case    49 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40),A(41),A(42),A(43),A(44),A(45),A(46),A(47),A(48)); break ;
+case    50 : (*f)(A(0),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),A(12),A(13),A(14),A(15),A(16),A(17),A(18),A(19),A(20),A(21),A(22),A(23),A(24),A(25),A(26),A(27),A(28),A(29),A(30),A(31),A(32),A(33),A(34),A(35),A(36),A(37),A(38),A(39),A(40),A(41),A(42),A(43),A(44),A(45),A(46),A(47),A(48),A(49)); break ;
+
+    default:
+	RSL_TEST_ERR(1,"bad number of arguments") ;
+  }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile	(revision 2744)
@@ -0,0 +1,207 @@
+#########################################################################
+#     
+#                              COPYRIGHT
+#     
+#     The following is a notice of limited availability of the code and 
+#     Government license and disclaimer which must be included in the 
+#     prologue of the code and in all source listings of the code.
+#     
+#     Copyright notice
+#       (c) 1977  University of Chicago
+#     
+#     Permission is hereby granted to use, reproduce, prepare 
+#     derivative works, and to redistribute to others at no charge.  If 
+#     you distribute a copy or copies of the Software, or you modify a 
+#     copy or copies of the Software or any portion of it, thus forming 
+#     a work based on the Software and make and/or distribute copies of 
+#     such work, you must meet the following conditions:
+#     
+#          a) If you make a copy of the Software (modified or verbatim) 
+#             it must include the copyright notice and Government       
+#             license and disclaimer.
+#     
+#          b) You must cause the modified Software to carry prominent   
+#             notices stating that you changed specified portions of    
+#             the Software.
+#     
+#     This software was authored by:
+#     
+#     Argonne National Laboratory
+#     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+#     Mathematics and Computer Science Division
+#     Argonne National Laboratory, Argonne, IL  60439
+#     
+#     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+#     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+#     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+#     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+#     
+#                      GOVERNMENT LICENSE AND DISCLAIMER
+#     
+#     This computer code material was prepared, in part, as an account 
+#     of work sponsored by an agency of the United States Government.
+#     The Government is granted for itself and others acting on its 
+#     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+#     this data to reproduce, prepare derivative works, distribute 
+#     copies to the public, perform publicly and display publicly, and 
+#     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+#     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+#     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+#     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+#     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+#     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+#     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+#
+#########################################################################
+
+# Top level makefile for RSL.
+#
+#
+
+###################################################
+# User settable compile time constants.
+###################################################
+
+# largest number of domains
+MAX_DOMAINS  = 6
+
+# largest number of processors
+MAX_PROC     = 256
+
+###################################################
+# Install time constants
+###################################################
+
+# 0 is hostless (monitor is a compute node);
+# 1 (monitor is an extra node)
+HOST_NODE = 0
+#HOST_NODE = 1
+
+# 1, monitor is the low node; 0, monitor is high node
+# (set this for all hosts)
+MON_LOW = 1
+#MON_LOW = 0
+
+###################################################
+# Generally not modified
+###################################################
+
+CONFIG_OPTS = -DIMAX_MAKE=$(IMAX) -DJMAX_MAKE=$(JMAX) \
+	      -DMAXDOM_MAKE=$(MAX_DOMAINS) \
+	      -DMAXPROC_MAKE=$(MAX_PROC) \
+	      -DHOST_NODE=$(HOST_NODE) -DMON_LOW=$(MON_LOW) \
+	      -DALLOW_RSL_168PT=1 $(LEARN_BCAST)
+
+MAKE_OPTS=SED_LINE="-e s/IMAX_MAKE/$(IMAX)/ \
+		     -e s/JMAX_MAKE/$(JMAX)/ \
+		     -e s/MAXDOM_MAKE/$(MAX_DOMAINS)/ \
+	             -e s/MAXPROC_MAKE/$(MAX_PROC)/" \
+          CONFIG_OPTS="$(CONFIG_OPTS)"
+
+
+include makefile.core
+OBJ = $(CORE_OBJ)
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+MINITAR = $(CORE_MINITAR)
+
+.SUFFIXES: .o .c
+MAKE = make -r
+
+help :
+	@ echo "Must specify target (see makefile)."
+
+mpl :
+	@ echo "Do not compile for MPL.  Use MPI."
+
+sp2 :
+	@ if [ -f LAST_MADE ] ; then /bin/mv -f LAST_MADE LAST_MADE.bak ; fi
+	@ echo Last made as: make sp2 > LAST_MADE
+	@ make >> LAST_MADE
+	$(MAKE) -f makefile.sp2 $(MAKE_OPTS) all
+
+sp2ch :
+	@ if [ -f LAST_MADE ] ; then /bin/mv -f LAST_MADE LAST_MADE.bak ; fi
+	@ echo Last made as: make sp2ch > LAST_MADE
+	@ make >> LAST_MADE
+	$(MAKE) -f makefile.sp2ch $(MAKE_OPTS) all
+
+sp2.1 :
+	@ if [ -f LAST_MADE ] ; then /bin/mv -f LAST_MADE LAST_MADE.bak ; fi
+	@ echo Last made as: make sp2.1 > LAST_MADE
+	@ make >> LAST_MADE
+	$(MAKE) -f makefile.sp2.1 $(MAKE_OPTS) all
+
+t3e :
+	@ if [ -f LAST_MADE ] ; then /bin/mv -f LAST_MADE LAST_MADE.bak ; fi
+	@ echo Last made as: make t3e > LAST_MADE
+	@ make >> LAST_MADE
+	$(MAKE) -f makefile.t3e $(MAKE_OPTS) all
+
+crayx1 :
+	@ if [ -f LAST_MADE ] ; then /bin/mv -f LAST_MADE LAST_MADE.bak ; fi
+	@ echo Last made as: make x1 > LAST_MADE
+	@ make >> LAST_MADE
+	$(MAKE) -f makefile.x1 $(MAKE_OPTS) all
+
+o2k :
+	$(MAKE) -f makefile.o2k $(MAKE_OPTS) all
+
+hp :
+	$(MAKE) -f makefile.hp $(MAKE_OPTS) all
+
+alpha :
+	$(MAKE) -f makefile.alpha $(MAKE_OPTS) all
+
+alphavector :
+	$(MAKE) -f makefile.alphavector $(MAKE_OPTS) all
+
+vpp :
+	$(MAKE) -f makefile.vpp $(MAKE_OPTS) all
+
+sunmpi :
+	$(MAKE) -f makefile.sunmpi $(MAKE_OPTS) all
+
+altix :
+	$(MAKE) -f makefile.altix $(MAKE_OPTS) all
+
+linux :
+	$(MAKE) -f makefile.linux LINUX_MPIHOME=$(LINUX_MPIHOME) $(MAKE_OPTS) all
+
+sx :
+	$(MAKE) -f makefile.sx $(MAKE_OPTS) all
+
+stub :
+	@ if [ -f LAST_MADE ] ; then /bin/mv -f LAST_MADE LAST_MADE.bak ; fi
+	@ echo Last made as: make stub > LAST_MADE
+	@ make >> LAST_MADE
+	$(MAKE) -f makefile.stub $(MAKE_OPTS) all
+
+showtar :
+	@ echo these files will be included in the tar
+	@ echo $(TAR) | tr '\040' '\012'
+
+tar :
+	tar cvf rsltar $(TAR)
+	compress rsltar
+	ls -l rsltar.Z
+
+minitar :
+	tar cvf rslminitar $(MINITAR)
+	compress rslminitar
+	ls -l rslminitar.Z
+
+man :
+	$(MAKE) -f Makefile.man
+	cd docs ; make man
+
+manclean :
+	/bin/rm -fr man
+	cd docs ; make manclean
+
+superclean : 
+	/bin/rm -f *.o librsl.a rsl.inc
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.alpha
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.alpha	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.alpha	(revision 2744)
@@ -0,0 +1,55 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the DEC Alpha
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+### When compiling RSL with MM5, the CC macro is defined by the call to make
+### from MM5/Makefile.  Don't define it here.
+# for compiling with MPICH
+#CC = mpicc
+# for compiling with DEC's version of MPI
+#CC = cc
+#FC = f77
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -DMPI -DSWAPBYTES -O $(UNDERSCORE)
+FFLAGS  = -align dcommons -convert big_endian -O
+#CFLAGS = -DMPI -DSWAPBYTES -g $(UNDERSCORE)
+#FFLAGS  = -align dcommons -convert big_endian -g
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.alphavector
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.alphavector	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.alphavector	(revision 2744)
@@ -0,0 +1,60 @@
+#version of RSL makefile used for testing vector option on local compaq hosts
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the DEC Alpha
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+### When compiling RSL with MM5, the CC macro is defined by the call to make
+### from MM5/Makefile.  Don't define it here.
+# for compiling with MPICH
+#CC = mpicc
+# for compiling with DEC's version of MPI
+#CC = cc
+#FC = f77
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -DMPI -DSWAPBYTES -Dvpp -Dalphavector -O $(UNDERSCORE)
+FFLAGS  = -align dcommons -convert big_endian -O
+CFLAGS = -DMPI -DSWAPBYTES -Dvpp -Dalphavector -g $(UNDERSCORE)
+FFLAGS  = -align dcommons -convert big_endian -g
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
+
+vicopy.o : vicopy.F
+	$(FC) -c $(FVFLAGS) $<
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.altix
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.altix	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.altix	(revision 2744)
@@ -0,0 +1,59 @@
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the SGI Altix using Intel 8.0 compilers
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = icc
+FC = ifort
+
+# MPIHOME=/usr
+# IDIR=$(MPIHOME)/include
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+# CFLAGS = -w -O3 -ipo -tpp2 -g -DMPI -DRSL_SYNCIO -Dlinux -DSWAPBYTES
+# FFLAGS = -w -O3 -ipo -tpp2 -ftz -g -convert big_endian
+CFLAGS = -w -O3 -ip -tpp2 -no-gcc -DMPI -DRSL_SYNCIO -Dlinux -DSWAPBYTES $(IDIR) -DMPI2_SUPPORT
+#FFLAGS = -w -O3 -ip -tpp2 -ftz -convert big_endian $(IDIR) -mP3OPT_ecg_mm_fp_ld_latency=20
+FFLAGS = -w -O3 -ip -tpp2 -ftz -convert big_endian $(IDIR) 
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+#	xild -lib ru librsl.a $(OBJ)
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+superclean : clean
+	/bin/rm -f librsl.a rsl.inc
+
+
+###
+
+$(OBJ) : $(HDR)
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.core
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.core	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.core	(revision 2744)
@@ -0,0 +1,39 @@
+
+CORE_OBJ = set_padarea.o set_f_padarea.o domain_def.o within_nest.o  \
+      mesh_topo.o \
+      decomp.o show_decomp.o rsl_new_decom.o rsl_nl.o rsl_initial.o \
+      rsl_malloc.o index.o border.o pt.o proc.o proc_f.o \
+      buf_for_proc.o message_def.o stencil_def.o comp_sten.o \
+      pack_message.o exch_sten.o rsl_probe.o comp_cells_f.o comp_cells.o \
+      fort_realread.o \
+      fort_intread.o \
+      fort_complexread.o \
+      fort_characterread.o \
+      fort_close.o \
+      fort_realwrite.o \
+      fort_intwrite.o \
+      fort_complexwrite.o \
+      fort_characterwrite.o \
+      rsl_funit_close.o \
+      fort_bdyin_real.o \
+      rsl_io.o rsl_ioserve.o rsl_init_f.o \
+      rsl_mm_io.o handle_spec1.o handle_spec2.o handle_spec3.o \
+      rsl_bcast.o rsl_bcast_f.o rsl_merge.o rsl_merge_f.o \
+      rsl_order.o rsl_move.o rsl_debug.o rsl_mon_bcast.o rsl_fopen_f.o \
+      rsl_fclose_f.o \
+      comp_slabs.o comp_slabs_f.o destroy_list.o comp_world.o \
+      cd.o rsl.o default_decomposition.o rsl_child_info.o get_bdy_info.o \
+      rsl_remap_state.o patchmap.o boundary_safe.o fill_boundary.o \
+      process_refs.o rsl_error_dup.o \
+      fort_doubleread.o  fort_doublewrite.o fort_bdyin_dbl.o \
+      comp_period.o exch_period.o period_def.o period_refs.o \
+      rsl_hemiforce.o \
+      comp_xpose.o xpose_def.o xpose.o
+
+CORE_HDR = rsl.h  rsl_comm.h compat.h
+
+CORE_MINITAR = rsl.inc_base *.c *.h *.inc *.f TODO makefile* *.csh README*
+
+CORE_TAR = $(CORE_MINITAR)
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.hp
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.hp	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.hp	(revision 2744)
@@ -0,0 +1,51 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the IBM SP[12] and nets of wkstations
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = mpicc
+FC = mpif90
+
+MPIHOME=#/usr/local/mpi
+IDIR=#$(MPIHOME)/include
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -DMPI -DNOUNDERSCORE -g
+FFLAGS = +noppu +O3
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.ibm.sv
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.ibm.sv	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.ibm.sv	(revision 2744)
@@ -0,0 +1,49 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the IBM SP[12] and nets of wkstations
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = cc
+FC = xlf
+
+MPIHOME=/usr/local/mpi
+IDIR=$(MPIHOME)/include
+
+LIB = 
+
+CFLAGS = -I$(IDIR) -DNOUNDERSCORE -DMPI -g # -O # -g
+FFLAGS = -g
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.f.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.linux
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.linux	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.linux	(revision 2744)
@@ -0,0 +1,47 @@
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+IDIR=$(LINUX_MPIHOME)/include
+#CC = $(LINUX_MPIHOME)/bin/mpicc
+#FC = $(LINUX_MPIHOME)/bin/mpif77 -byteswapio
+
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -I$(IDIR) -DMPI -DRSL_SYNCIO -Dlinux -DSWAPBYTES -O
+FFLAGS = -O
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.o2k
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.o2k	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.o2k	(revision 2744)
@@ -0,0 +1,54 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the IBM SP[12] and nets of wkstations
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy_o2k.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = cc -64 -mips4
+FC = f90 -64 -mips4
+
+MPIHOME=/usr
+IDIR=$(MPIHOME)/include
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -w -I$(IDIR) -DMPI -DO2K -O2 -DMPI2_SUPPORT
+FFLAGS = -w -O2
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+superclean : clean
+	/bin/rm -f librsl.a rsl.inc
+
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sp2
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sp2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sp2	(revision 2744)
@@ -0,0 +1,51 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the IBM SP[12] and nets of wkstations
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = mpcc
+FC = mpxlf
+
+MPIHOME=#/usr/local/mpi
+IDIR=#$(MPIHOME)/include
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -I$(IDIR) -DNOUNDERSCORE -DMPI -O
+FFLAGS = -O
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sp2.1
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sp2.1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sp2.1	(revision 2744)
@@ -0,0 +1,54 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the IBM SP[12] and nets of wkstations
+# this is for older versions of the SP, in which the MPI stuff is not
+# automatically accessible via mpcc.
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = mpicc
+FC = mpixlf
+
+MPIHOME=#/usr/local/mpi
+IDIR=#$(MPIHOME)/include
+
+LIB = 
+
+.SUFFIXES: .a .inc .o .c .F
+
+CFLAGS = -I$(IDIR) -DNOUNDERSCORE -DMPI -O
+FFLAGS = -O
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+	touch librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sp2ch
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sp2ch	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sp2ch	(revision 2744)
@@ -0,0 +1,51 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the IBM SP[12] and nets of wkstations
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = cc
+FC = xlf
+
+MPIHOME=/homes/michalak/mpich
+IDIR=$(MPIHOME)/include
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -I$(IDIR) -DNOUNDERSCORE -DMPI -g
+FFLAGS = -g #-O
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.stub
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.stub	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.stub	(revision 2744)
@@ -0,0 +1,59 @@
+
+# this is a makefile for RSL that maps the package down to the
+# IBM SP without message passing at all (must run single proc)
+
+include makefile.core
+OBJ = $(CORE_OBJ) debug.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+.SUFFIXES: .F .o .c
+
+
+
+LIB = 
+
+# IBM
+#CFLAGS = -DNOUNDERSCORE -DSTUBS -g
+#CC = cc
+#FC = xlf
+# SUN
+#CFLAGS = -DSTUBS -g
+#CC = cc
+#FC = f77 -w
+
+
+#FFLAGS = -O
+#ucomment for alpha
+#CFLAGS = -DSTUBS -DSWAPBYTES -O
+#FFLAGS = -O -convert big_endian
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sunmpi
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sunmpi	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sunmpi	(revision 2744)
@@ -0,0 +1,63 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on SunOS
+
+.SUFFIXES: .F .o .c
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o debug.o fort_doubleread.o fort_doublewrite.o fort_bdyin_dbl.o mpi_init_f.o rsl_error_dup.o vicopy_o2k.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = mpcc
+FC = mpf90
+
+MPIHOME=
+IDIR=.
+
+LIB = 
+
+COPTIM = -O
+FOPTIM = -O
+CFLAGS = -I$(IDIR) -DMPI -DSUN
+FFLAGS =
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+	ranlib librsl.a
+
+# problem with illigal instruction in rsl_merge when compiled with -O
+# haven't determined cause yet.  96/06/02
+rsl_merge.o :
+	$(CC) -c -g $(CFLAGS) $(CONFIG_OPTS) $<
+
+# problem with illigal instruction in rsl_merge when compiled with -O
+# haven't determined cause yet.  96/06/02
+#rsl_merge_f.o :
+#	$(FC) -c -g $(FFLAGS) $<
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(COPTIM) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $(FOPTIM) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sx
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sx	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.sx	(revision 2744)
@@ -0,0 +1,70 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the NEC SX-5
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy_sx.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = sxmpic++
+FC = sxmpif90
+
+#MPIHOME=
+#IDIR=
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -DMPI -I../../../include -Dsx -DRSL_SYNCIO -Dcrayx1 -DNO_RAGGED
+CFLAGS = -DMPI -I../../../include -Dsx -DRSL_SYNCIO -DNEC_TUNE -DNEC_SINGLENEST -DNEC_TYPE4B
+CFLAGS = -DMPI -I../../../include -Dsx -DRSL_SYNCIO -DNEC_TUNE
+FFLAGS = -float0
+#INLINE = -pi fullmsg auto file=proc.c
+
+# "-DNEC_SINGLENEST"
+# avoids redundant count of grid points.
+# don't specify this if the form of the grid-plane changes.
+# (i.e. multi-nest run)
+# target file is "rsl_ioserve.c".
+
+# "-DNEC_TYPE4B"
+# 1 byte char data copy by "bcopy" is replaced with 4 byte float
+# substitution.
+# this modification promotes vectorization.
+# this effects only multi-nest run.
+# target file is "rsl_bcast.c".
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	sxar cr librsl.a $(OBJ)
+#	ranlib librsl.a
+
+rsl_mpi_compat.o:	rsl_mpi_compat.c
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(INLINE) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.t3e
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.t3e	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.t3e	(revision 2744)
@@ -0,0 +1,58 @@
+
+##### from Bill Gropp #####
+# (see /Net/moline14/moline14_5/gropp/mpich/examples/test/pt2pt/Makefile)
+#
+#MPIR_HOME   = /opt/ctl/mpt/1.1.0.1
+##LIB_PATH    = -L$(MPIR_HOME)/lib
+#LIB_PATH    = -L/opt/ctl/mpt/1.1.0.1/lib
+#LIB_LIST    = -lmpi
+#INCLUDE_DIR =  -I$(MPIR_HOME)/include
+#
+LIBS = $(LIB_PATH) $(LIB_LIST)
+#
+##### end stuff from Gropp #####
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = cc
+FC = f90
+
+.SUFFIXES: .o .c .F
+
+IDIR= $(INCLUDE_DIR)
+
+CFLAGS = -DMPI -DT3D -O $(IDIR) -DRSL_SYNCIO
+FFLAGS = 
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+#	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.vpp
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.vpp	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.vpp	(revision 2744)
@@ -0,0 +1,55 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the IBM SP[12] and nets of wkstations
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = vcc
+FC = frt
+
+MPIHOME=#/usr/local/mpi
+IDIR=$(MPIINCDIR)
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -I$(IDIR) -DMPI -Dvpp -DRSL_SYNCIO -O -Wl,-P -J -KA32 -Ka4
+FFLAGS = -O -Fixed -X7 -Wl,-P -Wv -KA32
+FVFLAGS = -Sw -Wv,-Of,-te,-ilfunc,-noalias,-m3,-P255 -Oe,-P -Kfast -Pdos -lmpi -lmp -KA32
+
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
+
+vicopy.o : vicopy.F
+	$(FC) -c $(FVFLAGS) $<
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.vpp2
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.vpp2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.vpp2	(revision 2744)
@@ -0,0 +1,50 @@
+
+# this is a makefile for RSL that maps the package down to the
+# MPI message passing primitives on the IBM SP[12] and nets of wkstations
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o debug.o fort_doubleread.o fort_doublewrite.o rsl_error_dup.o fort_bdyin_dbl.o vicopy.o
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = vcc
+FC = frt
+
+MPIHOME=#/usr/local/mpi
+IDIR=$(MPIINCDIR)
+
+LIB = 
+
+.SUFFIXES: .o .c .F
+
+CFLAGS = -I$(IDIR) -DMPI -Dvpp2 -Dnomallinfo -DRSL_SYNCIO -O -Wl,-P -J
+FFLAGS = -O -Fixed -X7 -Wl,-P
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.x1
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.x1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/makefile.x1	(revision 2744)
@@ -0,0 +1,64 @@
+
+##### from Bill Gropp #####
+# (see /Net/moline14/moline14_5/gropp/mpich/examples/test/pt2pt/Makefile)
+#
+#MPIR_HOME   = /opt/ctl/mpt/1.1.0.1
+##LIB_PATH    = -L$(MPIR_HOME)/lib
+#LIB_PATH    = -L/opt/ctl/mpt/1.1.0.1/lib
+#LIB_LIST    = -lmpi
+#INCLUDE_DIR =  -I$(MPIR_HOME)/include
+#
+LIBS = $(LIB_PATH) $(LIB_LIST)
+#
+##### end stuff from Gropp #####
+
+include makefile.core
+OBJ = $(CORE_OBJ) rsl_mpi_compat.o mpi_init_f.o vicopy.o debug.o 
+HDR = $(CORE_HDR)
+TAR = $(CORE_TAR)
+
+CC = cc
+FC = ftn
+
+.SUFFIXES: .o .c .F
+
+IDIR= $(INCLUDE_DIR)
+
+CFLAGS = -DMPI -O3 $(IDIR) -DRSL_SYNCIO -Dcrayx1 -h list=a  -DNO_RAGGED
+FFLAGS = -Dcrayx1
+
+CFLAGS0 = -hstream0,vector3,scalar3,fp2,inline3 -DMPI -DRSL_SYNCIO -VV -h display_opt -h report=imsvf -Dcrayx1
+
+warning :
+	@ echo 'This makefile is not a top level makefile'
+	@ echo 'and is not intended for direct use.  Please'
+	@ echo 'type "make" by itself for assistance.'
+
+all : rsl.inc librsl.a
+
+fill_boundary.o : fill_boundary.c
+	$(CC) -P $(CFLAGS0) $(CONFIG_OPTS) fill_boundary.c
+	$(CC) -c $(CFLAGS0) $(CONFIG_OPTS) fill_boundary.c
+
+rsl.inc : $(HDR) rsl.inc_base
+	cat $(HDR) | sed $(SED_LINE) |\
+	grep '^#.*define.*\/\* FORTRAN \*\/' | \
+	awk '{printf("      integer %s\n      parameter(%s=%s)\n",$$2,$$2,$$3)}' | \
+	cat rsl.inc_base - > rsl.inc
+
+librsl.a : $(OBJ)
+	ar cr librsl.a $(OBJ)
+#	ranlib librsl.a
+
+.c.o :
+	$(CC) -c $(CFLAGS) $(CONFIG_OPTS) $<
+
+.F.o :
+	$(FC) -c $(FFLAGS) $<
+
+clean :
+	/bin/rm -f *.o
+
+###
+
+$(OBJ) : $(HDR)
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mesh_topo.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mesh_topo.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mesh_topo.c	(revision 2744)
@@ -0,0 +1,66 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+rsl_processor_t
+mesh_topo( p_row, nrow, p_col, ncol )
+  rsl_processor_t p_row, nrow, p_col, ncol ;
+{
+  return( p_row*ncol + p_col ) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/message_def.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/message_def.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/message_def.c	(revision 2744)
@@ -0,0 +1,562 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_CREATE_MESSAGE - create a descriptor for an RSL message.
+
+  Synopsis:
+  RSL_CREATE_MESSAGE ( m )
+  integer m
+
+  Input parameter:
+. m - message descriptor
+
+  Notes:
+  Create a descriptor for an RSL message.  On return, the
+  integer Arg1 will contain a handle to a new RSL message.
+  Messages exist only temporarily by themselves -- once a message
+  has been asssociated with a stencil or a state vector, the handle
+  becomes invalid.
+
+  See also:
+  RSL_BUILD_MESSAGE, RSL_DESCRIBE_STENCIL, RSL_DESCRIBE_STATE
+
+@*/
+
+
+RSL_CREATE_MESSAGE ( mh_p )
+  int_p mh_p ;
+{
+
+  int i ;
+  message_desc_t *msg ;
+
+  /* NOTE: never return the 0th message descriptor */
+  for ( i = 1 ; i < RSL_MAXDESCRIPTORS ; i++ )
+    if ( mh_descriptors[i] == NULL ) break ;    /* got one */
+
+  RSL_TEST_ERR( i == RSL_MAXDESCRIPTORS,
+    "rsl_create_message: out of descriptors.\nAre you creating messages and then not associating them with\na stencil, bcast/merge, or state vector?" ) ;
+
+  *mh_p = i ;
+  msg = RSL_MALLOC(message_desc_t,1) ;
+  msg->tag = MESSAGE_DESC ;
+  msg->mh = *mh_p ;
+  mh_descriptors[*mh_p] = msg ;
+}
+
+/* Only ever called internally to RSL.   This routine is for use
+   by routines that associate messages with other RSL constructs.  Once
+   the association is made, those constructs point to the messages.  We
+   do *not* free the message description structures here, only free up
+   the descriptors so they can be used again.  */
+
+release_mh_descriptor (mh_p)
+  int_p mh_p ;
+{
+  int mh ;
+
+  mh = *mh_p ;
+
+  if ( mh == RSL_INVALID ) return ;
+
+  RSL_TEST_ERR( mh <= 0 || mh >= RSL_MAXDESCRIPTORS,
+                "internal error.  Invalid message descriptor.") ;
+  if ( mh_descriptors[mh] != NULL )
+  {
+    mh_descriptors[mh] = NULL ;
+  }
+  /* it can happen that this will be called for a descriptor that
+     has already been nulled out.  Let it happen. */
+}
+
+
+/*
+  RSL_BLANK_MESSAGE - (obsolete) describe a message for broadcast/merges.
+
+  Synopsis:
+  RSL_BLANK_MESSAGE ( m, len )
+  integer m
+  integer len
+
+  Input parameter:
+. m - message descriptor
+. len - length, in bytes, of message
+
+  Notes:
+  Messages to be used in a broadcast or a merge operation
+  for inter-domain communication do not have fields associated
+  with them ahead of time, unlike messages that are used
+  in stencil exchanges (see RSL_BUILD_MESSAGE).  Rather, the
+  packing and unpacking routines are provided by the user,
+  and the message is simply a stream of bytes.   RSL_BLANK_MESSAGE
+  designates a message as a blank message and associates with
+  the message its length in bytes.
+
+  See also:
+  RSL_BUILD_MESSAGE, RSL_COMP_BCAST, RSL_COMP_MERGE
+*/
+
+
+RSL_BLANK_MESSAGE ( mh_p, len_p )
+  int_p mh_p ;          /* message handle */
+  int_p len_p ;         /* length in bytes */
+{
+  int mh, len ;
+  message_desc_t *msg ;
+
+  mh = *mh_p ; len = *len_p ;
+
+  RSL_TEST_ERR((mh <= 0)|| (mh >= RSL_MAXDESCRIPTORS),
+                "rsl_blank_message: bad message handle" ) ;
+  RSL_TEST_ERR((msg = (message_desc_t *)mh_descriptors[mh])==NULL,
+               "descriptor for null message");
+  RSL_TEST_ERR( msg->tag != MESSAGE_DESC,
+       "rsl_blank_message: handle given is not for an rsl message def" ) ;
+
+  msg->tag = BLANK_MESSAGE_DESC ;       /* change tag */
+  msg->nbytes = len ;
+  return ;
+}
+
+/*@
+  RSL_BUILD_MESSAGE - Add a 2- or 3-dimensional field to a message.
+
+  Notes:
+  An RSL message is a set of fields that are to be communicated
+  for a point in the model grid.  Describing messages in this way
+  allows RSL to assume control of packing and unpacking of model data
+  from and to local processor memory for efficient and transparent
+  communication of stencil exchanges and state remappings.
+    
+  A field (Arg3), a multi-dimensional
+  array of a given type (Arg2),
+  is
+  added
+  to a message (Arg1) by repeated calls to RSL_BUILD_MESSAGE.
+  Once constructed, messages may then be combined into stencils
+  (RSL_DESCRIBE_STENCIL) for stencil exchanges (RSL_EXCH_STENCIL).
+  A message may also be used to describe a state-vector (RSL_DESCRIBE_STATE)
+  used in remapping for load balancing.
+
+  The Arg4 argument gives the number of dimensions in the field
+  being added to the message.  It is permissable to mix 2 and 3
+  dimensional fields.  Regardless, however, 2 and only dimensions
+  of the field
+  must be decomposed.
+  The three arguments Arg4, Arg5, and Arg6, are integer arrays
+  of size Arg4.  The indicies of these arrays correspond to the
+  dimensions of the field being added; index 1 is the most minor,
+  and index ndim is the most major dimension.
+  
+  The values stored in the Arg4 array may be
+  
+  Verbatim:
+$     RSL_NORTHSOUTH  -- decomposed over M
+$     RSL_EASTWEST -- decomposed over N
+$     RSL_NOTDECOMPOSED.  -- not decomposed.
+BREAKTHEEXAMPLECODE
+
+  This tells RSL whether the
+  dimension in question is decomposed over a north/south column of
+  processors in the mesh, an east-west row in the mesh, or -- as is the
+  case with the vertical dimension in 3-d arrays -- not decomposed at
+  all.  RSL_NORTHSOUTH, RSL_EASTWEST, and RSL_NOTDECOMPOSED are 
+  defined in the RSL include file "rsl.inc".
+
+  The values stored in the Arg5 array are the global, or
+  undecomposed, sizes of each dimension of the field.  The values 
+  stored in the Arg6 array are the local, or actual,
+  sizes of the dimensions of the field as it exists in the processor's
+  memory.  If the field is statically declared (say, in common) the
+  sizes would be the sizes that were used to declare the array itself.
+  If the array is dynamically allocated using a Fortran90 
+  ALLOCATE() statement, the values of llen would be sizes that
+  were specified to the ALLOCATE() statement.  In the latter case,
+  if these sizes ever change during the course of a run, it would
+  be necessary to destroy this message and reconstruct a new one
+  for RSL, since it must always be able to determine the true size
+  in memory of the data structures involved in messaging operations.
+
+  Example:
+$  integer m                           ! message descriptor
+$  integer decomp(3), llen(3), glen(3) ! dimension descriptions
+$  real ua(ix,jx,kx), va(ix,jx,kx)     ! locally dimensioned 3-d arrays
+$  real psa(ix,jx,kx)                  ! locally dimensioned 2-d array
+
+$  decomp(1) = RSL_NORTHSOUTH     ! how most minor dim decomposed
+$  decomp(2) = RSL_EASTWEST       ! how next dim decomposed
+$  decomp(3) = RSL_NOTDECOMPOSED  ! major dim (vertical) not decomposed
+
+$  glen(1) = g_ix    ! global size in n/s
+$  glen(2) = g_jx    ! global size in e/w
+$  glen(3) = kx      ! size in vertical
+$  llen(1) = ix      ! local size in n/s
+$  llen(2) = jx      ! local size in e/w
+$  llen(3) = kx      ! local size of vertical (same as global)
+
+$  call rsl_create_message( m )
+$  call rsl_build_message( m, RSL_REAL, ua,  3, decomp, glen, llen )
+$  call rsl_build_message( m, RSL_REAL, va,  3, decomp, glen, llen )
+$  call rsl_build_message( m, RSL_REAL, psa, 2, decomp, glen, llen )
+
+
+BREAKTHEEXAMPLECODE
+
+  In the above example, a message is created and then built by 
+  adding two three-dimensional fields and one two-dimensional field.  
+  The order of the construction is not important.  Subsequent
+  to these statements, the completed message could be used to define
+  one or more points of a stencil exchange to communicate ua,
+  psa, and va between processors.
+
+
+  See also:
+  RSL_CREATE_MESSAGE, RSL_BLANK_MESSAGE, RSL_DESCRIBE_STENCIL,
+  RSL_DESCRIBE_STATE
+
+@*/
+
+static struct f90_base_table_entry {
+  char * base, * virt_base ;
+  int size_in_bytes ;
+} f90_base_table[ MAX_BASE_TABLE_ENTRIES ] ;
+static int base_table_cursor = 1;
+static int base_table_size = 1;
+
+RSL_BUILD_MESSAGE ( mh_p, t_p, base, ndim_p, decomp, glen, llen )
+  int_p 
+     mh_p       /* (I) Message handle created by RSL_CREATE_MESSAGE. */
+    ,t_p        /* (I) RSL type description. */
+    ,ndim_p ;   /* (I) Number of dimensions of field being added to message.*/
+  void *
+    base ;      /* (I) Base address field in local memory. */
+  int 
+    decomp[] ;  /* (I) How decomposed. */
+  int 
+    glen[] ;    /* (I) Global (undecomposed) dimensions of field. */
+  int 
+    llen[] ;    /* (I) Local (decomposed) dimensions of field. */
+{
+  int mh, t, ndim, i ;
+  message_desc_t *msg ;
+  rsl_fldspec_t *fld ;
+  int dim ;
+  int f90_table_index ;
+  char errmess[256] ;
+
+  mh = *mh_p ; t = *t_p ; ndim = *ndim_p ;
+
+  RSL_TEST_ERR( ndim < 0, "rsl_build_message: bad ndim argument" ) ;
+  RSL_TEST_ERR( ndim > RSL_MAXDIM, 
+"rsl_build_message: ndim too large.  Change RSL_MAXDIM; recompile librsl.a." ) ;
+  RSL_TEST_ERR((mh <= 0)||(mh >= RSL_MAXDESCRIPTORS),
+       "rsl_build_message: bad message handle" ) ;
+  if ( (msg = (message_desc_t *)mh_descriptors[mh])==NULL )
+  {
+      RSL_TEST_ERR(1, "descriptor for null message");
+  }
+  RSL_TEST_ERR( msg->tag != MESSAGE_DESC,
+       "rsl_build_message: handle given is not for an rsl message def" ) ;
+
+  fld = RSL_MALLOC( rsl_fldspec_t, 1 ) ;
+
+  fld->type = t ;
+  fld->elemsz = elemsize( t ) ;
+  for ( fld->memsize = fld->elemsz, i = 0 ; i < ndim ; i++ )
+  {
+    fld->memsize = fld->memsize * llen[i] ;
+  }
+
+  if ( t >= 100 )
+  {
+    if ( ! (fld->f90_table_index = get_index_for_base( base )) )
+    { RSL_TEST_ERR(1,"Use of unregistered f90 typed variable") ; }
+#if 0
+    fld->base = (void *)((fld->f90_table_index-1) * F90_MAX_FLD_SIZE_IN_BYTES + 1) ; /* don't allow base of 0 */
+#else
+    fld->base = f90_base_table[ fld->f90_table_index ].virt_base ;
+#endif
+  }
+  else
+  {
+    fld->base = base ;
+  }
+  fld->ndim = ndim ;
+  for ( dim = 0 ; dim < ndim ; dim++ )
+  {
+    fld->decomp[dim] = decomp[dim] ;
+    fld->gdex[dim] = RSL_INVALID ;	/* this gets filled in dynamically */
+    if ( decomp[dim] == RSL_NOTDECOMPOSED && glen[dim] != llen[dim] )
+    {
+       sprintf(errmess,
+"rsl_build_message: mesg %d: dim %d is RSL_NOTDECOMPOSED so glen(%d)=%d must eq llen(%d)=%d",
+       mh, dim+1, dim+1, glen[dim], dim+1, llen[dim] ) ;
+       RSL_TEST_WRN( 1, errmess ) ;
+    }
+    fld->glen[dim] = glen[dim] ;
+    fld->llen[dim] = llen[dim] ;
+    if ( decomp[dim] > 10 )
+      fld->stag[dim] = 1 ;
+    else 
+      fld->stag[dim] = 0 ;
+  }
+
+  /* work out pack/unpack strategy for this field */
+  switch ( ndim )
+  {
+  case 2 :
+    if      ( decomp[0]%10 == RSL_M && 
+	      decomp[1]%10 == RSL_N )
+      fld->strategy = MINNS_MAJEW_2D ;
+    else if ( decomp[1]%10 == RSL_M &&
+	      decomp[0]%10 == RSL_N )
+      fld->strategy = MINEW_MAJNS_2D ;
+    else
+      RSL_TEST_ERR(1,"rsl_build_message: unsupported decomposition strategy for 2d message") ;
+    break ;
+  case 3 :
+    if      ( decomp[0]%10 == RSL_M &&
+	      decomp[1]%10 == RSL_N &&
+	      decomp[2]%10 == RSL_NOTDECOMPOSED)
+      fld->strategy = MINNS_MAJEW_K_3D ;
+    else if ( decomp[0]%10 == RSL_N &&
+	      decomp[1]%10 == RSL_M &&
+	      decomp[2]%10 == RSL_NOTDECOMPOSED)
+      fld->strategy = MINEW_MAJNS_K_3D ;
+    else if ( decomp[0]%10 == RSL_NOTDECOMPOSED &&
+	      decomp[1]%10 == RSL_M &&
+	      decomp[2]%10 == RSL_N )
+      fld->strategy = K_MIDNS_MAJEW_3D ;
+    else if ( decomp[0]%10 == RSL_M &&
+	      decomp[1]%10 == RSL_NOTDECOMPOSED &&
+	      decomp[2]%10 == RSL_N )
+      fld->strategy = MINNS_K_MAJEW_3D ;
+    else
+      RSL_TEST_ERR(1,"rsl_build_message: unsupported decomposition strategy for 3d message") ;
+    break ;
+  default :
+    sprintf(mess,"rsl_build_message: %d dimension flds not supported yet\n",
+	    ndim ) ;
+    RSL_TEST_ERR(1,mess) ;
+    break ;
+  }
+
+  /* insert fldspec at beginning of list (note: we're not concerning
+     ourselves with order of the fields -- this will reverse them from
+     the order they were specified in.) */
+
+  fld->next = msg->fldspecs ;
+  msg->fldspecs = fld ;
+  msg->nflds++ ;
+}
+
+
+RSL_REGISTER_F90 ( base )
+  char * base ;
+{
+  if ( base_table_cursor < MAX_BASE_TABLE_ENTRIES )
+  {
+    f90_base_table[ base_table_cursor ].base = base ;
+    base_table_cursor++ ;
+  }
+  else
+  {
+    RSL_TEST_ERR(1,"Exceeded MAX_BASE_TABLE_ENTRIES number of f90 fields") ;
+  }
+}
+
+#define BASE_TABLE_PADDING sizeof(double) ;
+RSL_REGISTER_F90_BASE_AND_SIZE ( base , size )
+  char * base ;
+  int * size ;
+{
+  if ( base_table_cursor < MAX_BASE_TABLE_ENTRIES )
+  {
+    f90_base_table[ base_table_cursor ].base = base ;
+    f90_base_table[ base_table_cursor ].size_in_bytes = * size ;
+    f90_base_table[ base_table_cursor ].virt_base =
+           f90_base_table[ base_table_cursor-1 ].virt_base +
+           f90_base_table[ base_table_cursor-1 ].size_in_bytes + BASE_TABLE_PADDING ;
+    base_table_cursor++ ;
+  }
+  else
+  {
+    RSL_TEST_ERR(1,"Exceeded MAX_BASE_TABLE_ENTRIES number of f90 fields") ;
+  }
+}
+
+RSL_END_REGISTER_F90 ()
+{
+  base_table_size = base_table_cursor ;
+}
+
+RSL_START_REGISTER_F90 ()
+{
+  base_table_cursor = 1 ;
+  f90_base_table[ 0 ].virt_base = (char *) BASE_TABLE_PADDING ;
+  f90_base_table[ 0 ].size_in_bytes = 0 ;
+}
+
+void *
+get_base_for_index ( dex )
+  int dex ;
+{
+  if ( dex < 1 || dex >= base_table_size )
+  {
+    sprintf(mess, "bad index %d into f90_base_table.  base_table_size %d\n", dex, base_table_size ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  return( (void *) f90_base_table[dex].base ) ;
+}
+
+get_index_for_base ( base )
+  char * base ;
+{
+  int i ;
+  for ( i = 1 ; i < base_table_size ; i++ )
+  { 
+    if ( base == f90_base_table[ i ].base )
+    {
+      return( i ) ;
+    }
+  }
+  return(0) ;
+}
+
+/* return the number of bytes this message will require 
+   (only the data requirements -- descriptors not figured here */
+int
+message_size( msg )
+  message_desc_t *msg ;
+{
+  int dim, dimlen ;
+  int accum ;
+  rsl_fldspec_t * fld ;
+
+  if ( msg == NULL ) return(0) ;
+  if ( msg->tag != MESSAGE_DESC ) return(-1) ;
+  accum = 0 ;
+  for ( fld = msg->fldspecs ; fld != NULL ; fld = fld->next )
+  {
+    accum += fldsize( fld ) ;
+  }
+  return(accum) ;
+}
+
+int
+fldsize( fld )
+  rsl_fldspec_t * fld ;
+{
+  int dim, dimlen ;
+  int accum, fldaccum ;
+  fldaccum = 1 ;
+  for ( dim = 0 ; dim < fld->ndim ; dim++ )
+  {
+    fldaccum *= (fld->decomp[dim] == RSL_NOTDECOMPOSED)?fld->llen[dim]:1;
+  }
+  return (fldaccum * fld->elemsz) ;
+}
+
+/* only used internally within the RSL package... called by routines
+   that destroy larger RSL constructs such as stencils, bcast/merges,
+   state vectors (note: this routine was written using emacs, so
+   be careful) */
+destroy_message( msg )
+  message_desc_t * msg ;
+{
+  rsl_fldspec_t *fld, *doomed ;
+  if ( msg == NULL ) return ;
+  RSL_TEST_ERR( msg->tag != MESSAGE_DESC, "destroy_message: arg not a msg.") ;
+
+  for ( fld = msg->fldspecs ; fld != NULL ; )
+  {
+    doomed = fld ;
+    fld = fld->next ;
+    RSL_FREE( doomed ) ;
+  }
+  RSL_FREE( msg ) ;
+  msg = NULL ;
+}
+
+int
+elemsize( t )
+  int t ;
+{
+  if ( t >= 100 ) t = t % 100 ; /* remove extra info */
+  switch ( t )
+  {
+#ifdef T3D
+  case RSL_REAL         : return(sizeof(double)) ;
+#else
+  case RSL_REAL         : return(sizeof(float)) ;
+#endif
+  case RSL_DOUBLE       : return(sizeof(double)) ;
+#ifdef T3D
+  case RSL_COMPLEX      : return(2*sizeof(double)) ;
+#else
+  case RSL_COMPLEX      : return(2*sizeof(float)) ;
+#endif
+  case RSL_INTEGER      : return(sizeof(int)) ;
+  case RSL_CHARACTER    : return(sizeof(char)) ;
+  }
+  return(-1) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpc_sttus.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpc_sttus.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpc_sttus.c	(revision 2744)
@@ -0,0 +1,66 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+mpc_sttus( x )
+int x ;
+{
+   int i ;
+   int j ;
+   j = x ;
+   i = mpc_status( j ) ;
+   return(i) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpi_init_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpi_init_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpi_init_f.F	(revision 2744)
@@ -0,0 +1,67 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine mpi_init_f( ierr )
+      logical iflag
+      call mpi_initialized( iflag, ierr )
+      ierr = 0 
+      if ( .NOT. iflag ) then
+         call mpi_init(ierr)
+      endif
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpir_getarg.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpir_getarg.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpir_getarg.F	(revision 2744)
@@ -0,0 +1,84 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+c for some reason, n is passed in by value -- don't use
+      subroutine mpir_getarg( i, arg, n )
+      implicit none
+      integer i,n,j,m,cur
+      character arg(*)
+      character*256 str
+      call getarg( i, str)
+      m = len(str)
+      do j = 1,m
+        arg(j) = str(j:j)
+      enddo
+      return
+      end
+
+      integer function mpir_iargc()
+      implicit none
+      integer iargc
+      external iargc
+      mpir_iargc = iargc()
+      return
+      end
+
+c      program main
+c      character arg(30)
+c      call mpir_getarg( 1, arg, 30 )
+c      print *,arg
+c      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpl_test.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpl_test.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/mpl_test.c	(revision 2744)
@@ -0,0 +1,132 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+#include "rsl_comm.h"
+
+char buf1[4096] ;
+char buf2[4096] ;
+char buf3[4096] ;
+char buf4[4096] ;
+char buf5[4096] ;
+
+main()
+{
+  int rc, bc ;
+  int source ;
+  int tag, tag1, tag2, tag3, tag4, tag5 ;
+  int handle1 ;
+  int nbuf[10] ;
+  int que[5] ;
+  int retval ;
+  int i, ngot ;
+
+  RSL_INITIALIZE () ;
+
+  tag1 = 1001 ;
+  tag2 = 1002 ;
+  tag3 = 1003 ;
+  tag4 = 1004 ;
+  tag5 = 1005 ;
+
+  if ( rsl_myproc != 0 )
+  {
+/* Post several receives */
+    RSL_RECVBEGIN ( buf1, 2000, tag1 ) ; 
+    RSL_RECVBEGIN ( buf2, 2000, tag2 ) ; 
+    RSL_RECVBEGIN ( buf3, 2000, tag3 ) ; 
+    RSL_RECVBEGIN ( buf4, 2000, tag4 ) ; 
+    RSL_RECVBEGIN ( buf5, 2000, tag5 ) ; 
+
+    que[0] = 0 ;
+    que[1] = 0 ;
+    que[2] = 0 ;
+    que[3] = 0 ;
+    que[4] = 0 ;
+
+/* Probe for receive */
+    i = 0 ;
+    ngot = 0 ;
+    while ( ngot < 5 ) 
+    {
+      if ( i >= 5 ) i = 0 ; 
+      tag = 1001 + i ;
+      if ( que[i] != RSL_INVALID )
+      {
+      RSL_PROBE ( tag, &retval ) ;
+      if ( retval )
+      {
+        RSL_RECVEND ( tag ) ;
+        que[i] = RSL_INVALID ;
+        ngot++ ;
+      }
+      }
+      i++ ;
+    }
+  }
+  else
+  {
+    RSL_SEND ( buf1, 2000, tag1, 1 ) ;
+    RSL_SEND ( buf2, 2000, tag2, 1 ) ;
+    RSL_SEND ( buf3, 2000, tag3, 1 ) ;
+    RSL_SEND ( buf4, 2000, tag4, 1 ) ;
+    RSL_SEND ( buf5, 2000, tag5, 1 ) ;
+  }
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/pack_message.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/pack_message.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/pack_message.c	(revision 2744)
@@ -0,0 +1,415 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#define INTXFER
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+#define FWD(A,B,C)	my_bcopy(A,B,C)
+#define BWD(A,B,C)	my_bcopy(B,A,C)
+
+extern int debuggal_pack ;
+
+static int first_1 = 1 ;
+static int first_2 = 1 ;
+
+static FILE * xfp = NULL ;
+
+pack_message( msg, buf, cursor_p, d, ig, jg)
+  message_desc_t *msg  ;
+  char * buf ;
+  int * cursor_p ;
+  rsl_index_t d, ig, jg;
+{
+  rsl_fldspec_t *fld ;
+  int stride ;
+  register int *ips, *ipd ;
+  char * dd, * ss ;
+  unsigned int i, j, k, elemsz, t0, t1, t2, t3 ;
+  char * base ;
+  int cursor ;
+
+  cursor = *cursor_p ;
+
+#if 0
+if ( xfp == NULL )
+{
+  sprintf(mess,"xfp.%03d",rsl_myproc);
+  if(( xfp = fopen(mess,"w")) == NULL ) perror(mess)  ;
+}
+#endif
+
+  if ( msg == NULL ) return(-1) ;
+
+  i = ig - domain_info[d].ilocaloffset ;	/* this must not go neg */
+  j = jg - domain_info[d].jlocaloffset ;        /* this must not go neg */
+
+#if 0
+  if ( debuggal_pack )
+  {
+    fprintf(stderr,"pack_message: %16x, d %d i %d,j %d,ig %d,jg %d, ioff %d, joff %d\n",
+    msg->fldspecs->base, d, i,j,ig,jg,domain_info[d].ilocaloffset,domain_info[d].jlocaloffset ) ;
+    if ( first_2 == 1 )
+    {
+      first_2 = 0 ;
+      for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
+      {
+        base = fld->base ;
+        fprintf(stderr,"  : %16x\n",base) ;
+      }
+    }
+    fflush(stderr) ;
+  }
+#endif
+
+  for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
+  {
+    elemsz = fld->elemsz ;
+    if ( fld->type >= 100 )
+    {
+      base = (void *)get_base_for_index( fld->f90_table_index ) ;
+    }
+    else
+    {
+      base = fld->base ;
+    }
+    switch (fld->strategy)
+    {
+    case MINNS_MAJEW_2D :		/* <MM> eg: psa(i,j) */
+      t0 = fld->llen[0] ;
+      FWD( base+(i+j*t0)*elemsz,&(buf[cursor]),elemsz ) ; cursor+=elemsz ;
+      break ;
+    case MINEW_MAJNS_2D :		/*      eg: xxx(j,i) */
+      t0 = fld->llen[0] ;
+      FWD( base+(j+i*t0)*elemsz,&(buf[cursor]),elemsz ) ; cursor+=elemsz ;
+      break ;
+    case MINNS_MAJEW_K_3D :		/* <MM> eg: ua(i,j,k) */
+      t0 = fld->llen[0] ;
+      t1 = fld->llen[1]*t0 ;
+      switch (elemsz)
+      {
+#ifdef INTXFER
+      case sizeof(int) :
+	stride = t1 ;
+        ipd = (int *)(&buf[cursor]) ;
+	ips = (int *)(base + (i + j*t0)*elemsz) ;
+	/* ipd must be aligned on 4 byte boundary on some machines
+	   for this to work -- a symptom of it not working would be
+	   a bus error, for example. */
+	for ( k = 0 ; k < fld->llen[2] ; k++ )
+	{
+           *ipd = *ips ;
+	   ips += stride ;
+	   ipd ++ ;
+	}
+	cursor += fld->llen[2] * elemsz ;
+	break ;
+#endif
+      default :
+        for( k = 0 ; k < fld->llen[2] ; k++ )
+        {
+          FWD( base+(i+j*t0+k*t1)*elemsz,&(buf[cursor]),elemsz ) ;
+	  cursor+=elemsz ;
+        }
+	break ;
+      }
+      break ;
+    case MINEW_MAJNS_K_3D :		/* <MM> eg: u(j,i,k) */
+      t0 = fld->llen[0] ;
+      t1 = fld->llen[1]*t0 ;
+      switch (elemsz)
+      {
+#ifdef INTXFER
+      case sizeof(int) :
+        stride = t1 ;
+        ipd = (int *)(&buf[cursor]) ;
+        ips = (int *)(base + (j + i*t0)*elemsz) ;
+        /* ipd must be aligned on 4 byte boundary on some machines
+           for this to work -- a symptom of it not working would be
+           a bus error, for example. */
+        for ( k = 0 ; k < fld->llen[2] ; k++ )
+        {
+           *ipd = *ips ;
+           ips += stride ;
+           ipd ++ ;
+        }
+        cursor += fld->llen[2] * elemsz ;
+        break ;
+#endif
+      default :
+        for( k = 0 ; k < fld->llen[2] ; k++ )
+        {
+          FWD( base+(j+i*t0+k*t1)*elemsz,&(buf[cursor]),elemsz ) ;
+	  cursor+=elemsz ;
+        }
+	break ;
+      }
+      break ;
+
+    case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+      t0 = fld->llen[0] ;
+      t1 = fld->llen[1]*t0 ;
+      switch (elemsz)
+      {
+#ifdef INTXFER
+      case sizeof(int) :
+        ipd = (int *)(&buf[cursor]) ;
+        ips = (int *)(base + (i*t0+j*t1)*elemsz) ;
+        /* ipd must be aligned on 4 byte boundary on some machines
+           for this to work -- a symptom of it not working would be
+           a bus error, for example. */
+        for ( k = 0 ; k < t0 ; k++ )
+        {
+           *ipd++ = *ips++ ;
+        }
+        cursor += t0*elemsz ;
+        break ;
+#endif
+      default :
+        FWD( base+(i*t0+j*t1)*elemsz,&(buf[cursor]),t0*elemsz ) ;
+        cursor+=t0*elemsz ;
+        break ;
+      }
+      break ;
+
+
+    default:
+      RSL_TEST_ERR(1,"pack_message: strategy not supported" ) ;
+      break ;
+    }
+  }
+  *cursor_p = cursor ;
+}
+
+unpack_message( msg, buf, cursor_p, d, ig, jg)
+  message_desc_t *msg  ;
+  char * buf ;
+  int * cursor_p ;
+  rsl_index_t d, ig, jg;
+{
+  rsl_fldspec_t *fld ;
+  register int * ips, * ipd ;
+  char * dd, * ss ;
+  unsigned int i, j, k, elemsz, t0, t1, t2, t3 ;
+  char * base ;
+  int cursor ;
+  int stride ;
+
+  cursor = *cursor_p ;
+
+#if 0
+if ( xfp == NULL )
+{
+  sprintf(mess,"xfp.%03d",rsl_myproc);
+  xfp = fopen(mess,"w") ;
+}
+#endif
+
+
+  if ( msg == NULL ) return(-1) ;
+
+  i = ig - domain_info[d].ilocaloffset ;	/* this must not go neg */
+  j = jg - domain_info[d].jlocaloffset ;        /* this must not go neg */
+
+#if 0
+  if ( debuggal_pack )
+  {
+    fprintf(stderr,"unpack_message: %16x, i %d,j %d,ig %d,jg %d, ioff %d, joff %d\n",
+    msg->fldspecs->base,i,j,ig,jg,domain_info[d].ilocaloffset,domain_info[d].jlocaloffset ) ;
+    if ( first_1 == 1 )
+    {
+      first_1 = 0 ;
+      for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
+      {
+        base = fld->base ;
+        fprintf(stderr, "  : base=%16x, elemsz=%d, strategy=%d \n"
+                           , base, fld->elemsz, fld->strategy
+               ) ;
+      }
+    }
+
+    fflush(stderr) ;
+  }
+#endif
+
+  for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
+  {
+    elemsz = fld->elemsz ;
+    if ( fld->type >= 100 )
+    {
+      base = (void *)get_base_for_index( fld->f90_table_index ) ;
+    }
+    else
+    {
+      base = fld->base ;
+    }
+    switch (fld->strategy)
+    {
+    case MINNS_MAJEW_2D :		/* <MM> eg: psa(i,j) */
+      t0 = fld->llen[0] ;
+      BWD( base+(i+j*t0)*elemsz,&(buf[cursor]),elemsz ) ; cursor+=elemsz ;
+      break ;
+    case MINEW_MAJNS_2D :		/*      eg: xxx(j,i) */
+      t0 = fld->llen[0] ;
+      BWD( base+(j+i*t0)*elemsz,&(buf[cursor]),elemsz ) ; cursor+=elemsz ;
+      break ;
+    case MINNS_MAJEW_K_3D :		/* <MM> eg: ua(i,j,k) */
+      t0 = fld->llen[0] ;
+      t1 = fld->llen[1]*t0 ;
+      switch (elemsz)
+      {
+#ifdef INTXFER
+      case sizeof(int) :
+        stride = t1 ;
+        ips = (int *)(&buf[cursor]) ;
+        ipd = (int *)(base + (i + j*t0)*elemsz) ;
+        /* ipd must be aligned on 4 byte boundary on some machines
+           for this to work -- a symptom of it not working would be
+           a bus error, for example. */
+        for ( k = 0 ; k < fld->llen[2] ; k++ )
+        {
+           *ipd = *ips ;
+           ips ++ ;
+           ipd += stride ;
+        }
+        cursor += fld->llen[2] * elemsz ;
+        break ;
+#endif
+      default :
+        for( k = 0 ; k < fld->llen[2] ; k++ )
+        {
+          BWD( base+(i+j*t0+k*t1)*elemsz,&(buf[cursor]),elemsz ) ;
+          cursor+=elemsz ;
+        }
+        break ;
+      }
+      break ;
+    case MINEW_MAJNS_K_3D :		/* <MM> eg: u(j,i,k) */
+      t0 = fld->llen[0] ;
+      t1 = fld->llen[1]*t0 ;
+      switch (elemsz)
+      {
+#ifdef INTXFER
+      case sizeof(int) :
+        stride = t1 ;
+        ips = (int *)(&buf[cursor]) ;
+        ipd = (int *)(base + (j + i*t0)*elemsz) ;
+        /* ipd must be aligned on 4 byte boundary on some machines
+           for this to work -- a symptom of it not working would be
+           a bus error, for example. */
+        for ( k = 0 ; k < fld->llen[2] ; k++ )
+        {
+           *ipd = *ips ;
+           ips ++ ;
+           ipd += stride ;
+        }
+        cursor += fld->llen[2] * elemsz ;
+        break ;
+#endif
+      default :
+        for( k = 0 ; k < fld->llen[2] ; k++ )
+        {
+          BWD( base+(j+i*t0+k*t1)*elemsz,&(buf[cursor]),elemsz ) ;
+          cursor+=elemsz ;
+        }
+        break ;
+      }
+      break ;
+
+    case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
+      t0 = fld->llen[0] ;
+      t1 = fld->llen[1]*t0 ;
+      switch (elemsz)
+      {
+#ifdef INTXFER
+      case sizeof(int) :
+        ips = (int *)(&buf[cursor]) ;
+        ipd = (int *)(base + (i*t0+j*t1)*elemsz) ;
+        /* ipd must be aligned on 4 byte boundary on some machines
+           for this to work -- a symptom of it not working would be
+           a bus error, for example. */
+        for ( k = 0 ; k < t0 ; k++ )
+        {
+           *ipd++ = *ips++ ;
+        }
+        cursor += t0*elemsz ;
+        break ;
+#endif
+      default :
+        BWD( base+(i*t0+j*t1)*elemsz,&(buf[cursor]),t0*elemsz ) ;
+        cursor+=t0*elemsz ;
+        break ;
+      }
+      break ;
+
+    default:
+      RSL_TEST_ERR(1,"unpack_message: strategy not supported" ) ;
+      break ;
+    }
+  }
+  *cursor_p = cursor ;
+}
+
+my_bcopy( A, B, C )
+  char * A ;
+  char * B ;
+  int C ;
+{
+  int i ;
+  for ( i = 0 ; i < C ; i++ ) *(B+i) = *(A+i) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/patchmap.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/patchmap.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/patchmap.c	(revision 2744)
@@ -0,0 +1,90 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "rsl.h"
+
+RSL_PATCH_DECOMP ( w1, w2, info_p, m_p, n_p, py_p, px_p ) 
+  int_p w1, w2, info_p, m_p, n_p, py_p, px_p ;
+{
+  int i ;
+  for ( i = 0 ; i < *n_p * *m_p ; i++ )
+    w2[i] = w1[i] ;
+  patchmap( w2, *m_p, *n_p, *py_p, *px_p ) ;
+  return(0) ;
+}
+
+patchmap( wrk, m, n, py, px )
+  int wrk[], m, n, py, px ;
+{
+  int x, y, ncells, nprocs, n_p, n_py, n_px, i, j, pid, p ;
+  int p_maj, p_min ;  /* processor # in lon, in lat */
+
+  nprocs = px * py ;
+
+  for ( j = 0 ; j < n ; j++ )
+  {
+    p_maj = locproc( j, n, px ) ;
+    for ( i = 0 ; i < m ; i++ )
+    {
+      p_min = locproc( i, m, py ) ;
+      wrk[ i + j*m ] = mesh_topo( p_min, py, p_maj, px ) ;
+    }
+  }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/period_def.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/period_def.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/period_def.c	(revision 2744)
@@ -0,0 +1,210 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_CREATE_PERIOD -- Create a period descriptor.
+
+  Notes:
+
+  See also:
+@*/
+
+RSL_CREATE_PERIOD ( pr_p )
+  int_p pr_p ;     /* (O) New RSL period descriptor. */
+{
+  int i ;
+  period_desc_t *per ;
+  
+  /* NOTE: never return the 0th period */
+  for ( i = 1 ; i < RSL_MAXDESCRIPTORS ; i++ )
+    if ( pr_descriptors[i] == NULL ) break ;    /* got one */
+
+  RSL_TEST_ERR( i == RSL_MAXDESCRIPTORS,
+  "rsl_create_period:  out of descriptors.");
+
+  *pr_p = i ;
+  per = RSL_MALLOC(period_desc_t,1) ;
+  per->tag = PERIOD_DESC ;
+  per->has_f90_fields = 0 ;
+  pr_descriptors[*pr_p] = per ;
+  per->pr = *pr_p ;
+}
+
+release_pr_descriptor (pr_p)
+  int_p pr_p ;
+{
+  int pr ;
+
+  pr = *pr_p ;
+  RSL_TEST_ERR( pr < 0 || pr >= RSL_MAXDESCRIPTORS,
+                "internal error.  Invalid period descriptor.") ;
+  if ( pr_descriptors[pr] != NULL )
+  {
+    pr_descriptors[pr] = NULL ;
+  }
+}
+
+/*@
+  RSL_DESCRIBE_PERIOD -- Defines an RSL period exchange on a domain.
+
+  Notes:
+
+  See also:
+
+@*/
+
+RSL_DESCRIBE_PERIOD ( d_p, pr_p, bdyw_p, message_p )
+  int_p d_p,            /* (I) Domain descriptor. */
+        pr_p,           /* (I) Period handle */
+        bdyw_p ;        /* (I) BDY width. */
+  int_p message_p ;       /* (I) Array of message descriptors. */
+{
+  int d, pr, mh, bdyw ;
+  rsl_domain_info_t * dinfo ;
+  period_desc_t *per ;
+  message_desc_t *msg ;
+  int pt ;
+
+  d = *d_p ; pr = *pr_p ; bdyw = *bdyw_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+    "rsl_describe_period: bad domain descriptor\n") ;
+  dinfo = &(domain_info[d]) ;
+  RSL_TEST_ERR(dinfo->valid != RSL_VALID,
+    "rsl_describe_period: descriptor is not for a valid domain\n") ;
+
+  RSL_TEST_ERR( bdyw < 1 ,
+    "rsl_describe_period: boundary width < 1" ) ;
+  RSL_TEST_ERR( pr < 0 || pr >= RSL_MAXDESCRIPTORS,
+    "rsl_describe_period: bad period handle" ) ;
+  per = (period_desc_t *) pr_descriptors[pr] ;
+  RSL_TEST_ERR( per->tag != PERIOD_DESC,
+       "rsl_describe_period: handle given is not for an rsl period def" ) ;
+
+  per->bdyw[d] = bdyw ;
+  per->compiled[d] = 0 ;
+
+  mh = *message_p ;
+  RSL_TEST_ERR( mh < 0 || mh >=RSL_MAXDESCRIPTORS,
+         "rsl_describe_period: bad message handle in list") ;
+  msg = (message_desc_t *) mh_descriptors[ mh ] ;
+  RSL_TEST_ERR( msg->tag != MESSAGE_DESC, 
+   "rsl_describe_period: handle given in message list is not for an rsl mesage def" ) ;
+  per->msgs[d] = msg ;
+  
+  release_mh_descriptor( message_p ) ;
+  /* add my descriptor to the list for the domain */
+  dinfo->periodlist[dinfo->periodcurs] = pr ;
+  dinfo->periodcurs++ ;  /* 970317 */
+  if ( dinfo->periodcurs >= RSL_MAXDESCRIPTORS )
+  {
+    sprintf(mess,
+     "Domain %d doesn't have room for any more periods, but the allowable\nlimit of %d should have been more than enough.\nYou might recompile RSL with a higher setting for RSL_MAXDESCRIPTORS, but\n it's likely something else is wrong.",
+       d, RSL_MAXDESCRIPTORS ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+}
+
+/* only used internally within the RSL package */
+destroy_period( per )
+  period_desc_t * per ;
+{
+  int d ;
+  rsl_fldspec_t *fld, *doomed ;
+  if ( per == NULL ) return ;
+  RSL_TEST_ERR( per->tag != PERIOD_DESC, "destroy_period: arg not a period desc.") ;
+
+  for ( d = 0 ; d < RSL_MAXDOMAINS ; d++ )
+  {
+    destroy_period_on_domain( d, per ) ;
+  }
+  release_pr_descriptor (per->pr) ;
+  RSL_FREE( per ) ;
+}
+
+destroy_period_on_domain( d, per )
+  int d ;
+  period_desc_t * per ;
+{
+  int i ;
+
+  if ( per == NULL ) return ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "destroy_period_on_domain: bad domain descriptor") ;
+  destroy_message( per->msgs[d] ) ;
+  uncompile_period_on_domain( d, per ) ;
+}
+
+uncompile_period_on_domain( d, per )
+  int d ;
+  period_desc_t * per ;
+{
+  int i ;
+
+  if ( per == NULL ) return ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "uncompile_period_on_domain: bad domain descriptor") ;
+  per->compiled[d] = 0 ;
+  destroy_procrec_list( per->procs[0][d] ) ;
+  destroy_procrec_list( per->procs[1][d] ) ;
+  per->procs[0][d] = NULL ; /* 970317 */
+  per->procs[1][d] = NULL ; /* 970317 */
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/period_def.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/period_def.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/period_def.h	(revision 2744)
@@ -0,0 +1,73 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+
+
+#ifndef PERIOD_DEF_H
+#define PERIOD_DEF_H
+
+typedef struct period_desc {
+  rsl_tag_t tag;                        /* should be PERIOD_DESC */
+  int pr ;		/* my descriptor */
+  int has_f90_fields ;
+  rsl_tag_t compiled[RSL_MAXDOMAINS];
+  rsl_tag_t bdyw[RSL_MAXDOMAINS] ;
+  message_desc_t *msgs[RSL_MAXDOMAINS] ; 
+  rsl_procrec_t *procs[2][RSL_MAXDOMAINS] ; /* 2 is dir, RSL_M or RSL_N */
+} period_desc_t ;
+
+#endif  /* nothing after this line */
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/period_refs.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/period_refs.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/period_refs.c	(revision 2744)
@@ -0,0 +1,133 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+static rsl_list_t * list_head = NULL ;
+
+static int destroy_packrec( p ) packrec_t * p ; { free( p ) ; return(0) ; }
+
+static int compare_period_sort( a, b, dummy )
+  packrec_t *a, *b ;
+  int dummy ;
+{
+  if ( a != NULL && b != NULL )
+#if 0
+    if ((unsigned long)a->offset+(unsigned long)a->base > (unsigned long)b->offset+(unsigned long)b->base)
+#else
+    if ((unsigned long)a->base > (unsigned long)b->base)
+#endif
+      return(1) ;
+  return(0) ;
+}
+
+init_period_refs()
+{
+  rsl_list_t * lp, *lpnext ; 
+  destroy_list( &list_head, destroy_packrec ) ;
+  list_head = NULL ;
+}
+
+store_period_refs( base, f90_table_index , offset, n, nelems, stride )
+  void * base ;
+  int f90_table_index ;
+  int offset ;
+  int n ;
+  int nelems ;
+  int stride ;
+{
+  rsl_list_t * lp, *lp1, *lp2, *lp3, *lp4 ;
+  rsl_list_t * x ;
+  packrec_t * newrec, *arec, *nextrec ;
+  int found, found1 ;
+
+  newrec = RSL_MALLOC( packrec_t, 1 ) ;
+  newrec->base = base ;
+  newrec->f90_table_index = f90_table_index ;
+  newrec->offset = offset ;
+  newrec->n = n ;
+  newrec->nelems = nelems ;
+  newrec->stride = stride ;
+  newrec->valid = 1 ;
+
+  lp1 = NULL ;
+  for ( lp = list_head ; lp != NULL ; lp = lp->next )
+  {
+    lp1 = lp ;
+  }
+  if ( lp1 == NULL )
+  {
+    lp1 = RSL_MALLOC( rsl_list_t, 1 ) ;
+    lp1->next = NULL ;
+    list_head = lp1 ;
+  }
+  else
+  {
+    lp1->next = RSL_MALLOC( rsl_list_t, 1 ) ;
+    lp1 = lp1->next ;
+    lp1->next = NULL ;
+  }
+  lp1->data = newrec ;
+}
+
+#include <sys/time.h>
+RSL_INTERNAL_MILLICLOCK ()
+{
+    struct timeval tb ;
+    struct timezone tzp ;
+    int isec ;  /* seconds */
+    int usec ;  /* microseconds */
+    int msecs ;
+    gettimeofday( &tb, &tzp ) ;
+    isec = tb.tv_sec ;
+    usec = tb.tv_usec ;
+    msecs = 1000 * isec + usec / 1000 ;
+    return(msecs) ;
+}
+RSL_INTERNAL_MICROCLOCK ()
+{
+    struct timeval tb ;
+    struct timezone tzp ;
+    int isec ;  /* seconds */
+    int usec ;  /* microseconds */
+    int msecs ;
+    gettimeofday( &tb, &tzp ) ;
+    isec = tb.tv_sec ;
+    usec = tb.tv_usec ;
+    msecs = 1000000 * isec + usec ;
+    return(msecs) ;
+}
+
+period_refs( pack_table, pack_table_size, pack_table_nbytes, collapse )
+  packrec_t ** pack_table ;
+  int * pack_table_size, *pack_table_nbytes, collapse ;
+{
+  /* First sort the primary list, then sort each of the secondary lists
+     in the data structure built by
+     store_process_refs.   Finally, go through and collapse them. */
+
+  rsl_list_t * lp, *lp1, *lp2, *lp3 ;
+  packrec_t *x, *y ;
+  int i, nbytes ;
+  int compare_period_sort() ;
+
+  /* figure the number of entries */
+  for ( i = 0, lp = list_head ; lp ; lp = lp->next )
+      i++ ;
+
+  *pack_table_size = i ;
+
+  /* now allocate and populate the table */
+  *pack_table = RSL_MALLOC( packrec_t, *pack_table_size ) ;
+  for ( i = 0, nbytes = 0, lp = list_head ; lp ; lp = lp->next )
+    {
+      x = (packrec_t *)lp->data ;
+      nbytes += x->n * x->nelems ;
+      bcopy(lp->data,&((*pack_table)[i]),sizeof(packrec_t)) ;
+      i++ ;
+    }
+
+  *pack_table_nbytes = nbytes ;
+  
+  return ;
+}
+ 
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/picl_mpl_compat.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/picl_mpl_compat.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/picl_mpl_compat.c	(revision 2744)
@@ -0,0 +1,462 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#ifdef MPL
+#ifndef __MPL_COMPAT__
+#define __MPL_COMPAT__
+
+#include <stdio.h>
+
+typedef unsigned int MPL_Request ;
+typedef unsigned int MPL_Status ;
+
+#define PICLHandleInc 128
+
+struct tagsToHandles
+       {
+       int tag;
+       MPL_Request Handle;
+       int type ;		/* send = 1, recv = 2 */
+       int nbytes ;
+       };
+struct piclMPLHandles
+       {
+       int nHandles;
+       int nUsed;
+       struct tagsToHandles *tags;
+       } piclMPLHandleLUT;
+
+/******************************************************
+ * piclMPLInit ()
+ *   do whatever initialization is necessary for the
+ *   MPL port
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *  Adapted to MPL: J. Michalakes 7/13/94
+ *  Adapted to PICL from RSL: J. Michalakes 7/13/94
+ *
+ *****************************************************/
+
+static int argc_dummy = 0 ;
+static char * argv_dummy = "" ;
+
+int dontcare ;
+int allmsg ;
+int nulltask ;
+int allgrp ;
+int type_low ;
+int type_high ;
+
+/*
+ *   setarc0
+ */
+
+void setarc0( i1, i2, i3, i4 ) 	/* noop */
+  int *i1, *i2, *i3, *i4 ;
+{ return ; }
+
+/*
+ *   check0
+ */
+
+void check0( i1 ) 	        /* noop */
+  int *i1 ;
+{ return ; }
+
+/*
+ *   open0
+ */
+
+void open0( nprocs, me, dum )
+  int *nprocs, *me, *dum ;
+{
+  int nbuf[4] ;
+   
+  piclMPLHandleLUT.nHandles = PICLHandleInc;
+  piclMPLHandleLUT.nUsed = 0;
+  piclMPLHandleLUT.tags = (struct tagsToHandles *) 
+                     malloc (sizeof (struct tagsToHandles) * PICLHandleInc);
+
+  mpc_task_query( nbuf, 2, 2 ) ;
+  type_low = nbuf[0] ;
+  type_high= nbuf[1] ;
+  mpc_task_query( nbuf, 4, 3 ) ;
+  dontcare = nbuf[0] ;
+  allmsg   = nbuf[1] ;
+  nulltask = nbuf[2] ;
+  allgrp   = nbuf[3] ;
+
+#if 0
+  fprintf(stderr,"piclMPLInit: \n") ;
+  fprintf(stderr,"type_low:  %d\n",type_low) ;
+  fprintf(stderr,"type_high: %d\n",type_high) ;
+  fprintf(stderr,"dontcare:  %d\n",dontcare) ;
+  fprintf(stderr,"allmsg:    %d\n",allmsg) ;
+  fprintf(stderr,"nulltask:  %d\n",nulltask) ;
+  fprintf(stderr,"allgrp:    %d\n",allgrp) ;
+#endif
+
+
+  if (piclMPLHandleLUT.tags == NULL)
+  {
+    fprintf (stderr, "Fatal Error: malloc failure in piclMPLInit\n");
+    exit(1);
+  }
+
+  who0( nprocs, me, dum ) ;
+}
+
+/*
+ *   who0
+ */
+who0( nprocs, me, dum )
+  int *nprocs, *me, *dum ;
+{
+  mpc_environ( nprocs, me ) ;
+}
+
+/*
+ *   clock0
+ */
+double clock0()
+{
+  fprintf(stderr,"Warning -- clock0 is stubbed in %s\n", __FILE__ ) ;
+  return(0.0) ;		 /* stub for now */
+}
+
+/*
+ *   recv0
+ */
+
+recv0( buf, len, type )
+  char *buf ;
+  int *len, *type ;
+{
+  int rc ;
+  int rsl_mp_source ;
+  int rsl_mp_type ;
+  int rsl_mp_n ;
+
+  rsl_mp_type = *type ;
+  rsl_mp_n = *len ;
+
+  if ( rsl_mp_type < type_low || rsl_mp_type > type_high )
+  {
+    sprintf(mess,"RSL_RECV message type %d out of allowed range: %d..%d\n",
+            rsl_mp_type,type_low,type_high) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  rc = mpc_brecv(buf,rsl_mp_n,
+                 &rsl_mp_source,
+                 &rsl_mp_type,
+                 &rsl_mp_nbytes) ;
+  if ( rc ) {fprintf(stderr,"mpc_brecv returns %d\n",rc);exit(1);} 
+  if ( rsl_mp_nbytes > (*len) )
+  {
+    fprintf(stderr,"Message too large: tag %d, recvd %d, allocated %d\n",
+            *type,rsl_mp_nbytes,(*len));
+  }
+}
+
+/*
+ *   send0
+ */
+
+send0( buf, len, type, dest )
+  char *buf ;
+  int *len, *type, *dest ;
+{
+  int rc ;
+  int rsl_mp_type ;
+
+  rsl_mp_type = *type ;
+  if ( rsl_mp_type < type_low || rsl_mp_type > type_high )
+  {
+    sprintf(mess,"RSL_SEND message type %d out of allowed range: %d..%d\n",
+    rsl_mp_type,type_low,type_high) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  if (0) fprintf(stderr,"mpc_bsend: nlen %10d  type %10d  dest %10d\n", \
+                 B, rsl_mp_type, D ) ; \
+  rc = mpc_bsend(A,B,D,C) ; \
+  if ( rc ) {fprintf(stderr,"mpc_bsend returns %d\n",rc);exit(1);} \
+}
+
+
+
+
+/******************************************************
+ * piclMPLFindWaitH (tag)
+ *  Use the LUT to find an MPL wait handle from a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+
+long piclMPLFindWaitH (tag, waitHandle, type, nbytes )
+  int tag;   /* Tag for which we lookup a wait handle */
+  MPL_Request *waitHandle ;
+  int *type, *nbytes ;
+{
+  int i;
+  long retVal = -1;
+
+  for (i=0; i < piclMPLHandleLUT.nUsed; i++)
+  {
+    if (piclMPLHandleLUT.tags[i].tag == tag)
+    {
+      *waitHandle = piclMPLHandleLUT.tags[i].Handle;
+      *type = piclMPLHandleLUT.tags[i].type;
+      *nbytes = piclMPLHandleLUT.tags[i].nbytes;
+      piclMPLHandleLUT.nUsed--;  /* Keep them contiguous */
+      piclMPLHandleLUT.tags[i].tag=piclMPLHandleLUT.tags[piclMPLHandleLUT.nUsed].tag;
+      piclMPLHandleLUT.tags[i].Handle=
+                  piclMPLHandleLUT.tags[piclMPLHandleLUT.nUsed].Handle;
+      piclMPLHandleLUT.tags[i].type=
+		  piclMPLHandleLUT.tags[piclMPLHandleLUT.nUsed].type;
+      piclMPLHandleLUT.tags[i].nbytes=
+		  piclMPLHandleLUT.tags[piclMPLHandleLUT.nUsed].nbytes ;
+      retVal = 0 ;
+      break;
+    }
+  }
+  return( retVal ) ;
+}
+
+/******************************************************
+ * piclMPLSaveWaitH (tag, waitHandle)
+ *  Use the LUT to save an MPL wait handle referenced by a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void piclMPLSaveWaitH (tag, waitHandle,type,nbytes)
+ int tag;
+ MPL_Request * waitHandle;
+ int type, nbytes ;
+{
+ /* Make sure there is enough space, if not, try a realloc */
+ /* If the realloc fails we're in deep trouble */
+ if (piclMPLHandleLUT.nUsed == piclMPLHandleLUT.nHandles)
+   {
+   struct tagsToHandles *tags;  /* Temp pointer */
+   tags = (struct tagsToHandles *) 
+      realloc (piclMPLHandleLUT.tags, 
+      sizeof (struct tagsToHandles) * (piclMPLHandleLUT.nHandles + PICLHandleInc));
+   if (tags != NULL)
+     {
+     piclMPLHandleLUT.tags = tags;
+     piclMPLHandleLUT.nHandles += PICLHandleInc;
+     }
+   else
+     {
+#ifdef FATAL_ERRORS
+     fprintf (stderr, "Fatal Error: realloc failure in piclMPLSaveWaitH\n");
+     exit(1);
+#endif
+     return;
+     }
+   }
+ /* Stash the handle */
+ piclMPLHandleLUT.tags[piclMPLHandleLUT.nUsed].tag = tag;
+ piclMPLHandleLUT.tags[piclMPLHandleLUT.nUsed].Handle = *waitHandle;
+ piclMPLHandleLUT.tags[piclMPLHandleLUT.nUsed].type = type ;
+ piclMPLHandleLUT.tags[piclMPLHandleLUT.nUsed].nbytes = nbytes ;
+ piclMPLHandleLUT.nUsed++;
+}
+
+/******************************************************
+ * piclMPLISend (buff, mlen, tag, dest)
+ *  Post a non blocking send an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void piclMPLISend (buff, mlen, tag, dest)
+ char *buff;
+ int mlen;
+ int tag;
+ int dest;
+ {
+   MPL_Request waitHandle;
+   int rc ;
+ 
+   if ( tag < type_low || tag > type_high )
+   {
+sprintf(mess,"PICL_SENDBEGIN message type %d out of allowed range: %d..%d\n",
+tag,type_low,type_high) ;
+PICL_TEST_ERR( 1, mess ) ;
+   }
+
+   rc = mpc_send  (buff,
+              mlen,
+              dest,
+              tag,
+              &waitHandle); 
+
+#if 0
+fprintf(stderr,"mpc_send: nlen %10d  type %10d  dest %10d  handle %08x\n",
+mlen, tag, dest, waitHandle ) ;
+#endif
+
+   if ( rc )
+   {
+     sprintf(mess,"mpc_send returns %d", rc ) ;
+     PICL_TEST_ERR( 1, mess ) ;
+   }
+
+   piclMPLSaveWaitH (tag, &waitHandle,1,mlen);
+ }
+ 
+/******************************************************
+ * piclMPLIRecv (buff, mlen, tag)
+ *  Post a non blocking receive an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void piclMPLIRecv (buff, mlen, tag)
+ char *buff;
+ int mlen;
+ int tag;
+ {
+   MPL_Request waitHandle;
+   int source ;
+   int tagloc ;
+   int rc ;
+
+   source = dontcare ;
+   tagloc = tag ;
+
+   if ( tag < type_low || tag > type_high )
+   {
+sprintf(mess,"PICL_RECVBEGIN message type %d out of allowed range: %d..%d\n",
+tag,type_low,type_high) ;
+PICL_TEST_ERR( 1, mess ) ;
+   }
+
+
+   rc = mpc_recv  (buff,
+              mlen,
+              &source,
+              &tagloc,
+              &waitHandle);
+
+#if 0
+fprintf(stderr,"mpc_recv: nlen %10d  type %10d  source %10d  handle %08x\n",
+mlen, tag, source, waitHandle ) ;
+#endif
+
+   if ( rc )
+   {
+     sprintf(mess,"mpc_recv returns %d", rc ) ;
+     PICL_TEST_ERR( 1, mess ) ;
+   }
+
+   piclMPLSaveWaitH (tag, &waitHandle, 2, mlen);
+ }
+
+/******************************************************
+ * piclMPLWait (tag)
+ *  Wait for a pending send/recv
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+
+extern int mperrno ;
+ 
+void piclMPLWait (tag)
+ int tag;
+{
+  MPL_Request waitHandle;
+  MPL_Status status ;
+  int rc ;
+  int type, nbytes;
+
+  if ( piclMPLFindWaitH (tag, &waitHandle, &type, &nbytes ) != 0 )
+  {
+    fprintf(stderr,"piclMPLWait: tag %d not found by piclMPLFindWaitH\n",tag) ;
+    exit(2) ;
+  }
+
+#if 0
+  fprintf(stderr,"calling mpc_wait: tag %d, handle %08x, type %d (%s), original nbytes %d\n",
+        tag, waitHandle, type, (type==1)?"send":((type==2)?"recv":"unknown"),
+	nbytes) ;
+#endif
+
+  rc = mpc_wait ( &waitHandle, &status  );
+  if ( rc )
+  {
+    fprintf(stderr,"mpc_wait fails: tag %d, handle %08x, type %d (%s), original nbytes %d, status %d, rc %d, mperrno = %d\n",
+        tag, waitHandle, type, (type==1)?"send":((type==2)?"recv":"unknown"),
+	nbytes, status, rc, mperrno) ;
+    exit(2) ;
+  }
+
+#if 0
+  fprintf(stderr,"mpc_wait : tag %d, handle %08x, status %d\n",
+        tag, waitHandle, status) ;
+#endif
+
+}
+
+#endif /* __MPL_COMPAT__ */
+#endif /* MPL */
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/proc.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/proc.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/proc.c	(revision 2744)
@@ -0,0 +1,247 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+#ifdef FORTRANMANUAL
+/*@
+  RSL_IAMMONITOR -- Informational routine: am I the monitor?
+
+  Notes:
+  This function returns the value .TRUE. on the monitor processor
+  (usually node zero), and .FALSE. otherwise.  The monitor node is the
+  I/O node and also the root node for broadcasts (using RSL_MON_BCAST)
+  and internal reads and writes (RSL_READ, RSL_WRITE).  RSL_IAMMONITOR
+  may be called before RSL_MESH has been called.
+
+  Example:
+$  IF ( RSL_IAMMONITOR() ) THEN
+$    CALL RSL_UOPEN( INPUT_UNIT, FNAME, "OLD" )
+$  ENDIF
+BREAKTHEEXAMPLECODE
+  This shows RSL_IAMMONITOR being used in conjunction with
+  the RSL unformatted fortran open routine to do a named
+  upon on the monitor processor.
+
+  See also:
+  RSL_C_IAMMONITOR, RSL_MESH, RSL_MON_BCAST, RSL_READ, RSL_WRITE
+  
+@*/
+int
+RSL_IAMMONITOR ( retval )
+  int_p retval ;   /* Return value */
+{}
+#endif
+
+/*@
+  RSL_C_IAMMONITOR -- Informational routine: am I the monitor?
+
+  Notes:
+  The integer Arg1 is set to 1 on the monitor processor.  The monitor
+  (usually node zero).  The monitor node is the I/O node and also the
+  root node for broadcasts
+  (using RSL_MON_BCAST) and internal reads and writes (RSL_READ, RSL_WRITE).
+  RSL_C_IAMMONITOR may be called before RSL_MESH has been called.
+
+  See also:
+  RSL_IAMMONITOR, RSL_MESH, RSL_MON_BCAST, RSL_READ, RSL_WRITE
+  
+@*/
+
+int
+RSL_C_IAMMONITOR ( retval )
+  int_p retval ;  /* Return value. */
+{
+#if ( HOST_NODE == 0 )
+#  if ( MON_LOW == 0 )
+					/* hostless */
+  if ( rsl_myproc == rsl_nproc-1 ) 
+    *retval = 1 ;
+  else
+    *retval = 0 ;
+#  else
+					/* have a host node */
+  if ( rsl_myproc == 0 ) 
+    *retval = 1 ;
+  else
+    *retval = 0 ;
+#  endif
+#else
+#  if ( MON_LOW == 0 )
+  if ( rsl_myproc == rsl_nproc )
+    *retval = 1 ;
+  else
+    *retval = 0 ;
+#  else
+  if ( rsl_myproc == 0 )
+    *retval = 1 ;
+  else
+    *retval = 0 ;
+#  endif
+#endif
+  return(0) ;
+}
+
+int
+RSL_C_IAMCOMPUTE ( retval )
+  int_p retval ;
+{
+#if ( HOST_NODE == 0 )
+#  if ( MON_LOW == 0 )
+  if ( rsl_myproc < rsl_nproc-1 ) 
+    *retval = 1 ;
+  else
+    *retval = 0 ;
+#  else
+  if ( rsl_myproc > 0 )
+    *retval = 1 ;
+  else
+    *retval = 0 ;
+#  endif
+#else
+#  if ( MON_LOW == 0 )
+  if ( rsl_myproc < rsl_nproc )
+    *retval = 1 ;
+  else
+    *retval = 0 ;
+#  else
+  if ( rsl_myproc > 0 )
+    *retval = 1 ;
+  else
+    *retval = 0 ;
+#  endif
+#endif
+  return(0) ;
+}
+
+RSL_C_MONITOR_PROC ()
+{
+#if ( HOST_NODE == 0 )
+#  if ( MON_LOW == 0 )
+  return(rsl_nproc-1) ; 
+#  else
+  return(0) ; 
+#  endif
+#else
+#  if ( MON_LOW == 0 )
+  return(rsl_nproc) ; 
+#  else
+  return(0) ; 
+#  endif
+#endif
+}
+
+/* this maps compute processor id (0 based) to physical
+   processor id */
+int
+rsl_c_comp2phys_proc ( P ) 
+  int P ;
+{
+#if ( HOST_NODE == 0 )
+#  if ( MON_LOW == 0 )
+  return(P) ;
+#  else
+  return(P) ;
+#  endif
+#else
+#  if ( MON_LOW == 0 )
+  return(P) ;     /* monitor is high */
+#  else
+  return(P+1) ;     /* monitor is low */
+#  endif
+#endif
+}
+
+
+RSL_COMP2PHYS_C ( P, retval )
+  int_p P, retval ;
+{
+  *retval = rsl_c_comp2phys_proc( *P ) ;
+  return ;
+}
+
+
+/* this maps physical processor id to compute proc id
+   inverse of rsl_c_comp2phys_proc */
+
+int 
+rsl_c_phys2comp_proc( P )
+{
+#if ( HOST_NODE == 0 )
+#  if ( MON_LOW == 0 )
+  return(P) ;
+#  else
+  return(P) ;
+#  endif
+#else
+#  if ( MON_LOW == 0 )
+  return(P) ;		/* monitor is high */
+#  else
+  return(P-1) ;		/* monitor is low */
+#  endif
+#endif
+}
+
+RSL_PHYS2COMP_C ( P, retval )
+  int_p P, retval ;
+{
+  *retval = rsl_c_phys2comp_proc( *P ) ;
+  return ;
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/proc_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/proc_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/proc_f.F	(revision 2744)
@@ -0,0 +1,100 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      logical function rsl_iammonitor()           ! wrapper
+      implicit none
+      external rsl_c_iammonitor
+      integer retval
+      call rsl_c_iammonitor( retval ) 
+      if ( retval .eq. 1 ) then
+         rsl_iammonitor = .true.
+      else
+         rsl_iammonitor = .false.
+      endif
+      return
+      end
+
+      logical function rsl_iamcompute()           ! wrapper
+      implicit none
+      external rsl_c_iamcompute
+      integer retval
+      call rsl_c_iamcompute( retval )  
+      if ( retval .eq. 1 ) then
+         rsl_iamcompute = .true.
+      else
+         rsl_iamcompute = .false.
+      endif
+      return
+      end
+
+      integer function rsl_phys2comp( p )
+      implicit none
+      external rsl_phys2comp_c
+      integer retval, p
+      call  rsl_phys2comp_c( p, retval )
+      rsl_phys2comp = retval
+      return
+      end
+
+      integer function rsl_comp2phys( p )
+      implicit none
+      external rsl_comp2phys_c
+      integer retval, p
+      call  rsl_comp2phys_c( p, retval )
+      rsl_comp2phys = retval
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/process_refs.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/process_refs.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/process_refs.c	(revision 2744)
@@ -0,0 +1,530 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+#ifdef NEC_TUNE
+typedef struct{
+  int max_nsec ;                   /* Maximum number of entris on secondary list */
+  int nsec ;                       /* Number of entries on secondary list */
+  void *base ;                     /* Base address */
+  int *offset ;                    /* Array of "offsets" associated with base */
+  int *n ;                         /* Array of "lengths" associated with offset */
+  packrec_t **data ;               /* Array of "Ptr's to head data" */
+} Pri_lst_t ;
+static int max_npri = 128 ;        /* Max. no of "base" entries on primary list */
+static int npri = 0 ;              /* Number of "base" entries on primary list */
+static Pri_lst_t *Pri_lst = NULL ; /* Primary list */
+#endif
+static rsl_list_t * list_head = NULL ;
+
+static int destroy_packrec( p ) packrec_t * p ; { free( p ) ; return(0) ;}
+
+init_process_refs()
+{
+  int destroy_packrec() ;
+  rsl_list_t * lp, *lpnext ; 
+
+  for ( lp = list_head ; lp ; lp = lp->next )
+  {
+    destroy_list( &(lp->data), destroy_packrec ) ;
+  }
+  destroy_list( &list_head, NULL ) ;
+#ifdef NEC_TUNE
+/*
+   NECNOTE: 
+   If primary list is allocated and has entries assigned, free all data
+   allocated on secondary lists by reseting variable 'nsec' to zero.
+*/
+  if ( npri != 0 )
+  {
+    int ipri ;
+    for ( ipri = 0 ; ipri < npri ; ipri++ )
+    {
+      Pri_lst[ipri].nsec = 0 ; /* Free all entries on secondary list */
+    }
+    npri = 0 ; /* Free all entries on primary list */
+  }
+#endif
+}
+/*
+   The data structure being built by this routine:
+      (n is next pointer, d is data pointer)
+   The primary list (downwards) is a list of lists.
+   Each of the secondary lists (leftwards) is a list of all the
+   pack or unpack records with the same base.  This routine
+   checks to ensure that recs that are complete duplicates
+   (which can happen) are not added.
+
+   list_t -d-> list_t -n-> list_t -n-> list_t -n-> ...
+    |           \            \           \
+    n            d            d           d
+    |             \            \            \
+    |           base,off,n    base,off,n   base,off,n    ...
+    v
+   list_t -d-> list_t -n-> list_t -n-> list_t -n-> ...
+    |           \            \           \
+    n            d            d           d
+    |             \            \            \
+    |           base,off,n    base,off,n   base,off,n    ...
+    v
+   list_t -d-> list_t -n-> list_t -n-> list_t -n-> ...
+    |           \            \           \
+    n            d            d           d
+    |             \            \            \
+    |           base,off,n    base,off,n   base,off,n    ...
+    v
+    .
+    .
+    .
+*/
+
+store_process_refs( base, f90_table_index , offset, n, nelems, stride )
+  void * base ;
+  int f90_table_index ;
+  int offset ;
+  int n ;
+  int nelems ;
+  int stride ;
+{
+  rsl_list_t * lp, *lp1, *lp2, *lp3, *lp4 ;
+  rsl_list_t * x ;
+  packrec_t * newrec, *arec, *nextrec ;
+  int found, found1 ;
+#ifdef NEC_TUNE
+  int ipri ;
+  int isec ;
+  int found_search ;
+
+  if ( Pri_lst == NULL ) /* Need to initialize Primary list */
+  {
+    Pri_lst = realloc(Pri_lst, max_npri*sizeof(Pri_lst_t)) ;
+    RSL_TEST_ERR(Pri_lst == NULL, "out of memory - 1") ;
+  }
+#endif
+
+#if 0
+fprintf(stderr,"debug store_process_refs 1 base %08x ",base) ;
+fprintf(stderr," f90_table_index %3d ",f90_table_index) ;
+fprintf(stderr," offset %10d ",offset) ;
+fprintf(stderr," n %5d",n) ;
+fprintf(stderr," nelems %5d",nelems) ;
+fprintf(stderr," stride %5d\n",stride) ;
+#endif
+
+  newrec = RSL_MALLOC( packrec_t, 1 ) ;
+  newrec->endstop = 0 ;
+  if ( stride < 0 ) { newrec->endstop = 1 ; stride = -stride ; }
+  newrec->base = base ;
+  newrec->f90_table_index = f90_table_index ;
+  newrec->offset = offset ;
+  newrec->n = n ;
+  newrec->nelems = nelems ;
+  newrec->stride = stride ;
+  newrec->valid = 1 ;
+
+  /* traverse the primary list and see if there's a secondary
+     list already for this base address.  If there is not, add
+     it with newrec as the first entry in the new secondar list. 
+     If there is alread a secondary list, traverse it and make sure
+     there's not already an entry for newrec.  If there isn't, add
+     an entry for newrec to the end of the secondary list. */
+  found = 0 ;
+#ifdef	NEC_TUNE
+  for ( ipri = 0 ; ipri < npri ; ipri++ )
+  {
+    if ( base == Pri_lst[ipri].base )
+    {
+      found = 1 ;
+      break ;
+    }
+  }
+  if ( found )
+  {
+    /* Quick search to see whether this is a duplicate call. */
+    found_search = 0 ;
+#pragma vdir altcode=loopcnt
+    for ( isec = 0 ; isec < Pri_lst[ipri].nsec ; isec++ )
+    {
+      if ( Pri_lst[ipri].offset[isec] == offset )
+      {
+        found_search = 1 ; /* return silently */
+        break ;
+      }
+    }
+    if ( found_search )
+    {
+      if ( Pri_lst[ipri].n[isec] < n )
+      {
+        Pri_lst[ipri].n[isec] = n ;
+        Pri_lst[ipri].data[isec]->n = n ;
+      }
+      RSL_FREE(newrec) ;
+      return ;
+    }
+  }
+#endif
+  for ( lp = list_head ; lp ; lp = lp->next )
+  {
+    if ( lp != NULL )
+      if ((lp1 = (rsl_list_t *)lp->data) != NULL )
+         if ((arec = (packrec_t *) lp1->data) != NULL )
+           if ( arec->base == base )
+           {
+             found = 1 ;
+             break ;
+           }
+  }
+  if ( !found )
+  {
+    x = RSL_MALLOC( rsl_list_t, 1 ) ;
+    x->next = list_head ;
+    list_head = x ;
+    x->data = RSL_MALLOC( rsl_list_t, 1 ) ;
+    ((rsl_list_t *) x->data)->data = newrec ;
+    ((rsl_list_t *) x->data)->next = NULL ;
+  }
+  else
+  {
+    /* includes an insertion sort */
+    found1 = 0 ;
+#ifndef NEC_TUNE
+    for ( lp2 = lp1 ; lp2 != NULL ; lp2 = lp2->next )
+    {
+      lp3 = lp2 ;  /* store previous lp2 */
+      arec = (packrec_t *) lp2->data ;
+
+      if (lp2 == lp1)
+      {
+	if ( newrec->offset < arec->offset )
+	{ found1 = 0 ; break ; }
+      }
+      if (newrec->offset == arec->offset)
+      {
+        if (arec->n >= newrec->n)
+          { found1 = 1 ; break ; }
+        else
+          { arec->n = newrec->n ; found1 = 1 ; break ; }
+      }
+      else if (lp2->next != NULL)
+      {
+	nextrec = lp2->next->data ;
+	if ( newrec->offset > arec->offset &&
+	     newrec->offset < nextrec->offset )
+        { found1 = 2 ; break ; }
+      }
+      else if (newrec->offset > arec->offset)
+      {
+        { found1 = 2 ; break ; }
+      }
+    }
+#else
+    for ( lp2 = lp1 ; lp2 != NULL ; lp2 = lp2->next )
+    {
+      lp3 = lp2 ;  /* store previous lp2 */
+      arec = (packrec_t *) lp2->data ;
+
+      if (lp2 == lp1)
+      {
+        if ( offset < arec->offset )
+        { found1 = 0 ; break ; }
+      }
+      if (offset == arec->offset)
+      {
+        if (arec->n >= n)
+          { found1 = 1 ; break ; }
+        else
+          { arec->n = n ; found1 = 3 ; break ; }
+      }
+      else if (lp2->next != NULL)
+      {
+        nextrec = lp2->next->data ;
+        if ( offset > arec->offset &&
+             offset < nextrec->offset )
+        { found1 = 2 ; break ; }
+      }
+      else if (offset > arec->offset)
+      {
+        { found1 = 2 ; break ; }
+      }
+    }
+/* NECNOTE: Add base/offset/n to duplicate list. */
+    if ( found1 == 1 || found1 == 3 )
+    {
+      int nsec ;
+      int pri_found ;
+      RSL_FREE(newrec) ;
+
+      for ( ipri = 0, pri_found = 0 ; ipri < npri ; ipri++ )
+      {
+        if ( Pri_lst[ipri].base == base )
+        {
+          pri_found = 1 ;
+          break ;
+        }
+      }
+
+      if ( !pri_found )
+      {
+        if ( npri == max_npri )
+        {
+          max_npri *= 2 ;
+          Pri_lst = (Pri_lst_t *)realloc(Pri_lst, max_npri*sizeof(Pri_lst_t)) ;
+        }
+
+        Pri_lst[npri].max_nsec = 128 ;
+        Pri_lst[npri].nsec = 0 ;
+        Pri_lst[npri].base = base ;
+/*
+   NECNOTE:
+   I'd like to use RSL_MALLOC, but there is a good chance that the
+   following two pointers will be 'realloc'ed.
+*/
+        Pri_lst[npri].offset = (int *)malloc(Pri_lst[npri].max_nsec*sizeof(int)) ;
+        Pri_lst[npri].n = (int *)malloc(Pri_lst[npri].max_nsec*sizeof(int)) ;
+        Pri_lst[npri].data = (packrec_t **)malloc(Pri_lst[npri].max_nsec*sizeof(packrec_t *)) ;
+        RSL_TEST_ERR(Pri_lst[npri].offset == NULL || Pri_lst[npri].n == NULL ||
+                     Pri_lst[npri].data == NULL, "out of memory - 2") ;
+        npri++ ;
+      }
+
+      nsec = Pri_lst[ipri].nsec ;
+      if ( nsec == Pri_lst[ipri].max_nsec )
+      {
+        Pri_lst[ipri].max_nsec *= 2 ;
+        Pri_lst[ipri].offset = (int *)realloc(Pri_lst[ipri].offset, Pri_lst[ipri].max_nsec*sizeof(int)) ;
+        Pri_lst[ipri].n = (int *)realloc(Pri_lst[ipri].n, Pri_lst[ipri].max_nsec*sizeof(int)) ;
+        Pri_lst[ipri].data = (packrec_t **)realloc(Pri_lst[ipri].data, Pri_lst[ipri].max_nsec*sizeof(packrec_t *)) ;
+      }
+
+      Pri_lst[ipri].offset[nsec] = offset ;
+      Pri_lst[ipri].n[nsec] = n ;
+      Pri_lst[ipri].data[nsec] = arec ;
+      Pri_lst[ipri].nsec++ ;
+    }
+#endif
+    if ( found1 == 0 )      /* not found; add to beginning of list */
+    {
+      lp4 = RSL_MALLOC( rsl_list_t, 1 ) ;
+      lp4->next = (rsl_list_t *) lp->data ;
+      lp4->data = newrec ;
+      lp->data = lp4 ;
+    }
+    if ( found1 == 2 )      /* insert after this element */
+    {
+      lp4 = RSL_MALLOC( rsl_list_t, 1 ) ;
+      lp4->data = newrec ;
+      lp4->next = lp2->next ;
+      lp2->next = lp4 ;
+    }
+  }
+}
+
+static int compare_primary( lp1, lp2, dummy )
+  rsl_list_t *lp1, *lp2 ;
+  int dummy ;
+{
+  rsl_list_t *a, *b ;
+  packrec_t *x, *y ;
+  if ( lp1 != NULL && lp2 != NULL )
+  {
+    if ((x=(packrec_t*)lp1->data) != NULL && (y=(packrec_t*)lp2->data) != NULL )
+    {
+      if (x->base > y->base)
+      {
+        return(1) ;
+      }
+    }
+    else
+      RSL_TEST_ERR(1,"compare_primary 2") ;
+  }
+  else
+    RSL_TEST_ERR(1, "compare_primary 1" ) ;
+  return(0) ;
+}
+
+static int compare_secondary( a, b, dummy )
+  packrec_t *a, *b ;
+  int dummy ;
+{
+  if ( a != NULL && b != NULL )
+    if (a->offset > b->offset) 
+      return(1) ;
+  return(0) ;
+}
+
+static int collapsetable( lst )
+  rsl_list_t ** lst ;
+{
+  rsl_list_t * lp, * lp2, * prevlp ;
+  packrec_t *x, *y ;
+
+  if ( lst == NULL ) return(0)  ;
+
+lp = *lst ; x = lp->data ; if ( ! (x->valid ) ) RSL_TEST_ERR(1,"internal error: first entry invalid\n") ;
+
+  for ( lp = *lst ; lp != NULL ; lp = lp->next )
+  {
+    if (( x = lp->data ) != NULL ) ; if ( x->valid )       /* 2 statements */
+    {
+      for ( lp2 = lp->next ; lp2 != NULL ; lp2 = lp2->next )
+      {
+        if (( y = lp2->data ) != NULL ) ; if ( y->valid )  /* 2 statements */
+        {
+          if ((x->stride == y->stride) &&
+              (x->nelems == y->nelems) &&
+	      ((x->offset + x->n ) == y->offset) && ! x->endstop )
+          {
+	    {
+              y->valid = 0 ;
+              x->n += y->n ;
+	    }
+	  }
+          else
+	  {
+	    break ;   /* out of inner loop */
+	  }
+        }
+      }
+    }
+  }
+/* new bit... collapse sequences of entries with the same base and stride */
+  {
+    int xn, bigstride, firsty ;
+    for ( lp = *lst ; lp != NULL ; lp = lp->next )
+    {
+      if (( x = lp->data ) != NULL ) ; if ( x->valid )       /* 2 statements */
+      {
+        if ( x->nelems != 1 ) continue ;
+        xn = x->n ;
+	firsty = 1 ;
+        for ( lp2 = lp->next ; lp2 != NULL ; lp2 = lp2->next )
+        {
+          if (( y = lp2->data ) != NULL ) ; if ( y->valid )  /* 2 statements */
+          {
+	    if ( y->base != x->base ) break ;
+	    if ( y->nelems != 1 ) break ;
+	    if ( y->n != xn ) break ;
+	    if ( firsty == 1 ) /* first y */
+	    {
+	      firsty = 0 ;
+	      bigstride = y->offset - x->offset ;
+	    }
+	    if ( bigstride <= x->n ) break ;
+	    if ( y->offset - x->offset == bigstride )
+	    {
+	      y->valid = 0 ;
+	      x->nelems++ ;
+	      x->stride = bigstride ;
+	    }
+          }
+        }
+      }
+    }
+  }
+  /* now eliminate the invalidated entries */
+  for ( prevlp = *lst, lp = *lst ; lp != NULL ; )
+  {
+    if (( x=lp->data ) != NULL ) ; if ( ! x->valid )   /* 2 statements */
+    {
+      RSL_TEST_ERR( lp == *lst , " internal error -- shouldn't happen " ) ;
+      prevlp->next = lp->next ;
+      lp->next = NULL ;
+      destroy_list( &lp, destroy_packrec ) ;  /* destroys just one rec */
+      lp2 = prevlp ;
+      lp = prevlp->next ;
+    }
+    else
+    {
+      lp2 = lp ;
+      lp = lp->next ;
+    }
+    prevlp = lp2 ;
+  }
+}
+
+process_refs( pack_table, pack_table_size, pack_table_nbytes, collapse )
+  packrec_t ** pack_table ;
+  int * pack_table_size, *pack_table_nbytes, collapse ;
+{
+  /* First sort the primary list, then sort each of the secondary lists
+     in the data structure built by
+     store_process_refs.   Finally, go through and collapse them. */
+
+  int compare_primary(), compare_secondary() ;
+  rsl_list_t * lp, *lp1, *lp2, *lp3 ;
+  packrec_t *x, *y ;
+  int dummy ;
+  int i, nbytes ;
+
+#if 0
+fprintf(stderr,"before sort\n") ;
+for ( i = 0, lp = list_head ; lp ; lp = lp->next )
+{
+lp2 = lp->data ;
+fprintf(stderr,"%d %08x\n", i,  ((packrec_t *)(lp2->data))->base) ;
+i++ ;
+}
+#endif
+
+  dummy = 0 ;
+  rsl_sort( &list_head, compare_primary, dummy ) ;
+
+  /* figure the number of entries */
+  for ( i = 0, lp = list_head ; lp ; lp = lp->next )
+    for ( lp1 = (rsl_list_t *)lp->data ; lp1 ; lp1 = lp1->next )
+      i++ ;
+
+  for ( lp = list_head ; lp ; lp = lp->next )
+  {
+    rsl_sort( &(lp->data), compare_secondary, 99 ) ;
+#if 1
+    if ( collapse ) collapsetable( &(lp->data) ) ;
+#endif
+  }
+
+#if 0
+  for ( i = 0, lp = list_head ; lp ; lp = lp->next )
+  {
+#if 0
+lp1 = (rsl_list_t *)lp->data ; x = (packrec_t *)lp1->data ;
+fprintf(stderr,"Entries for base %08x\n", x->base ) ;
+#endif
+    for ( lp1 = (rsl_list_t *)lp->data ; lp1 ; lp1 = lp1->next )
+    {
+#if 0
+x = (packrec_t *)lp1->data ;
+fprintf(stderr,"     offset %10d  %d  %4d\n", x->offset, x->f90_table_index,x->n ) ;
+#endif
+      i++ ;
+    }
+  }
+#endif
+
+
+  /* figure the number of remaining entries */
+  for ( i = 0, lp = list_head ; lp ; lp = lp->next )
+    for ( lp1 = (rsl_list_t *)lp->data ; lp1 ; lp1 = lp1->next )
+      i++ ;
+
+  *pack_table_size = i ;
+
+#if 0
+fprintf(stderr,"debug 2 pack_table_size = %d\n",*pack_table_size) ;
+#endif
+
+  /* now allocate and populate the table */
+  *pack_table = RSL_MALLOC( packrec_t, *pack_table_size ) ;
+  for ( i = 0, nbytes = 0, lp = list_head ; lp ; lp = lp->next )
+    for ( lp1 = (rsl_list_t *)lp->data ; lp1 ; lp1 = lp1->next )
+    {
+      x = (packrec_t *)lp1->data ;
+      nbytes += x->n * x->nelems ;
+      bcopy(lp1->data,&((*pack_table)[i]),sizeof(packrec_t)) ;
+      i++ ;
+    }
+
+  *pack_table_nbytes = nbytes ;
+  
+  return ;
+}
+ 
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/pt.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/pt.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/pt.c	(revision 2744)
@@ -0,0 +1,878 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* apply the function f to each of the points of the stencil in order:
+
+                       1
+                    2 00  3
+                       4
+
+NOTE: as written, this routine assumes that the ns index is minor as
+in the NCAR MM.
+
+*/
+
+rsl_4pt( d, min, minlen, maj, majlen, f  )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+if ( maj >= 0 && maj < majlen )
+{
+  /* n1 */ if ( min+1 < minlen ) (*f)( d, min+1, maj, min, maj, 1, 4 ) ;
+  /* s1 */ if ( min-1 >= 0 )      (*f)( d, min-1, maj, min, maj, 4, 1 ) ;
+}
+if ( min >= 0 && min < minlen )
+{
+  /* w1 */ if ( maj-1 >= 0 )      (*f)( d, min, maj-1, min, maj, 2, 3 ) ;
+  /* e1 */ if ( maj+1 < majlen ) (*f)( d, min, maj+1, min, maj, 3, 2 ) ;
+}
+/* 00 */ if ( maj >= 0 && maj < majlen &&
+              min >= 0 && min < minlen ) (*f)( d, min, maj, min, maj, 0, 0 ) ;
+}
+
+/* Comment about periodic boundaries and staggered fields. JM 20031223 
+
+This is a bit of a stretch from the point of view of intuition, but if
+you have the following grid that is 5 dot points and 4 cross points
+across:
+
+        0     1     2     3     4     5
+        .  x  .  x  .  x  .  x  .  x  .
+           0     1     2     3     4 
+
+then the correct way to update a 1-deep periodic boundary is:
+
+(not 5!)                                  (not zero!)
+  4     0     1     2     3     4     5     1
+  .  x  .  x  .  x  .  x  .  x  .  x  .  x  .
+     4     0     1     2     3     4     0
+
+It may help to think about this as the 0 and 5 dot points being
+copies of each other. */
+
+/* periodic version ; Feb 99 */
+rsl_period_pt( dir, d, min, minlen, minstag, maj, majlen, majstag, fld, bdyw, f  )
+  int dir ;    /* direction: 0 is M, 1 is N */
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  int minstag ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int majstag ;
+  int bdyw ;
+  rsl_fldspec_t * fld ;
+  int (*f)() ;
+{
+  if ( bdyw >= 1 )
+  {
+    if      ( dir == 1 )   /* RSL_N */
+    {
+      if ( majstag )
+      {
+        /* Dot point at YS (index 0) replicated to last dot point in domain before XE boundary, (majlen-1) */
+        if ( maj == 0        && min >=0 && min < minlen+minstag ) { (*f)( d, min-1, maj, min-1,    majlen-0, -1, 0, fld ) ;
+                                                                    (*f)( d, min  , maj, min  ,    majlen-0,  0, 0, fld ) ;
+                                                                    (*f)( d, min+1, maj, min+1,    majlen-0,  1, 0, fld ) ; }
+        /* Dot point at YS+1 (index 1) replicated to first dot point in YE boundary, (majlen) */
+        if ( maj == 1        && min >=0 && min < minlen+minstag ) { (*f)( d, min-1, maj, min-1,    majlen+1, -1, 0, fld ) ;
+                                                                    (*f)( d, min  , maj, min  ,    majlen+1,  0, 0, fld ) ;
+                                                                    (*f)( d, min+1, maj, min+1,    majlen+1,  1, 0, fld ) ; }
+        /* YE edge of domain goes to YS edge - 1 */
+        if ( maj == majlen-1 && min >=0 && min < minlen+minstag ) { (*f)( d, min-1, maj, min-1,    -1,     -1, 0, fld ) ;
+                                                                    (*f)( d, min  , maj, min  ,    -1,      0, 0, fld ) ;
+                                                                    (*f)( d, min+1, maj, min+1,    -1,      1, 0, fld ) ; }
+
+      }
+      else
+      {
+        /* YS edge of domain goes to YE edge + 1 */
+        if ( maj == 0        && min >=0 && min < minlen+minstag ) { (*f)( d, min-1, maj, min-1,    majlen, -1, 0, fld ) ;
+                                                                    (*f)( d, min  , maj, min  ,    majlen,  0, 0, fld ) ;
+                                                                    (*f)( d, min+1, maj, min+1,    majlen,  1, 0, fld ) ; }
+
+        /* YE edge of domain goes to YS edge - 1 */
+        if ( maj == majlen-1 && min >=0 && min < minlen )         { (*f)( d, min-1, maj, min-1,    -1,     -1, 0, fld ) ;
+                                                                    (*f)( d, min  , maj, min  ,    -1,      0, 0, fld ) ;
+                                                                    (*f)( d, min+1, maj, min+1,    -1,      1, 0, fld ) ; }
+      }
+    }
+    else if ( dir == 0 )   /* RSL_M */
+    {
+      if ( minstag )
+      {
+        /* Dot point at XS (index 0) replicated to last dot point in domain before XE boundary, (minlen-1) */
+        if ( min == 0        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-1, minlen-0, maj-1,    0, -1, fld ) ;
+                                                                    (*f)( d, min, maj  , minlen-0, maj  ,    0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+1, minlen-0, maj+1,    0,  1, fld ) ; }
+        if ( min == 1        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-1, minlen+1, maj-1,    0, -1, fld ) ;
+                                                                    (*f)( d, min, maj  , minlen+1, maj  ,    0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+1, minlen+1, maj+1,    0,  1, fld ) ; }
+        /* XE edge of domain goes to XS edge - 1 */
+        if ( min == minlen-1 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-1, -1,       maj-1,    0, -1, fld ) ;
+                                                                    (*f)( d, min, maj  , -1,       maj  ,    0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+1, -1,       maj+1,    0,  1, fld ) ; }
+      }
+      else
+      {
+        /* XS edge of domain goes to XE edge + 1 */
+        if ( min == 0        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-1, minlen, maj-1,    0, -1, fld ) ;
+                                                                    (*f)( d, min, maj  , minlen, maj  ,    0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+1, minlen, maj+1,    0,  1, fld ) ; }
+
+        /* XE edge of domain goes to XS edge - 1 */
+        if ( min == minlen-1 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-1, -1,     maj-1,    0, -1, fld ) ;
+                                                                    (*f)( d, min, maj  , -1,     maj  ,    0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+1, -1,     maj+1,    0,  1, fld ) ; }
+      }
+    }
+
+/* sw corner to ne corner */
+    if ( min == 0+minstag        && maj == 0+majstag        ) { (*f)( d, min, maj  , minlen+minstag, majlen+majstag,   0,  0, fld ) ; }
+/* nw corner to se corner */
+    if ( min == 0+minstag        && maj == majlen-1-majstag ) { (*f)( d, min, maj  , minlen+minstag, -1            ,   0,  0, fld ) ; }
+/* se corner to nw corner */
+    if ( min == minlen-1-minstag && maj == 0+majstag        ) { (*f)( d, min, maj  , -1            , majlen+majstag,   0,  0, fld ) ; }
+/* ne corner to sw corner */
+    if ( min == minlen-1-minstag && maj ==majlen-1-majstag  ) { (*f)( d, min, maj  , -1            , -1            ,   0,  0, fld ) ; }
+
+  }
+#if 1
+  if ( bdyw >= 2 )
+  {
+    if      ( dir == 1 ) /* RSL_N */
+    {
+      if ( majstag )
+      {
+/**/    if ( maj == 0        && min >=0 && min < minlen+minstag ) { (*f)( d, min-2, maj, min-2,  majlen-0, -2, 0, fld ) ;
+                                                                    (*f)( d, min,   maj, min,    majlen-0,  0, 0, fld ) ;
+                                                                    (*f)( d, min+2, maj, min+2,  majlen-0,  2, 0, fld ) ; }
+        if ( maj == 1        && min >=0 && min < minlen+minstag ) { (*f)( d, min-2, maj, min-2,  majlen+1, -2, 0, fld ) ;
+                                                                    (*f)( d, min,   maj, min,    majlen+1,  0, 0, fld ) ;
+                                                                    (*f)( d, min+2, maj, min+2,  majlen+1,  2, 0, fld ) ; }
+        if ( maj == 2        && min >=0 && min < minlen+minstag ) { (*f)( d, min-2, maj, min-2,  majlen+2, -2, 0, fld ) ;
+                                                                    (*f)( d, min,   maj, min,    majlen+2,  0, 0, fld ) ;
+                                                                    (*f)( d, min+2, maj, min+2,  majlen+2,  2, 0, fld ) ; }
+        if ( maj == majlen-2 && min >=0 && min < minlen+minstag ) { (*f)( d, min-2, maj, min-2,  -2,       -2, 0, fld ) ;
+                                                                    (*f)( d, min,   maj, min,    -2,        0, 0, fld ) ;
+                                                                    (*f)( d, min+2, maj, min+2,  -2,        2, 0, fld ) ; }
+/**/    if ( maj == majlen-1 && min >=0 && min < minlen+minstag ) { (*f)( d, min-2, maj, min-2,  -1,       -2, 0, fld ) ;
+                                                                    (*f)( d, min,   maj, min,    -1,        0, 0, fld ) ;
+                                                                    (*f)( d, min+2, maj, min+2,  -1,        2, 0, fld ) ; }
+      }
+      else
+      {
+/**/    if ( maj == 0        && min >=0 && min < minlen+minstag ) { (*f)( d, min-2, maj, min-2,  majlen,   -2, 0, fld ) ;
+                                                                    (*f)( d, min  , maj, min  ,  majlen,    0, 0, fld ) ;
+                                                                    (*f)( d, min+2, maj, min+2,  majlen,    2, 0, fld ) ; }
+        if ( maj == 1        && min >=0 && min < minlen+minstag ) { (*f)( d, min-2, maj, min-2,  majlen+1, -2, 0, fld ) ;
+                                                                    (*f)( d, min,   maj, min,    majlen+1,  0, 0, fld ) ;
+                                                                    (*f)( d, min+2, maj, min+2,  majlen+1,  2, 0, fld ) ; }
+        if ( maj == majlen-2 && min >=0 && min < minlen+minstag ) { (*f)( d, min-2, maj, min-2,  -2,       -2, 0, fld ) ;
+                                                                    (*f)( d, min,   maj, min,    -2,        0, 0, fld ) ;
+                                                                    (*f)( d, min+2, maj, min+2,  -2,        2, 0, fld ) ; }
+/**/    if ( maj == majlen-1 && min >=0 && min < minlen+minstag ) { (*f)( d, min-2, maj, min-2,  -1,       -2, 0, fld ) ;
+                                                                    (*f)( d, min,   maj, min,    -1,        0, 0, fld ) ;
+                                                                    (*f)( d, min+2, maj, min+2,  -1,        2, 0, fld ) ; }
+      }
+    }
+    else if ( dir == 0 ) /* RSL_M */
+    {
+      if ( minstag )
+      {
+/**/    if ( min == 0        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-2, minlen-0, maj-2,    0, -2, fld ) ;
+                                                                    (*f)( d, min, maj,   minlen-0, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+2, minlen-0, maj+2,    0,  2, fld ) ; }
+/**/    if ( min == 1        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-2, minlen+1, maj-2,    0, -2, fld ) ;
+                                                                    (*f)( d, min, maj,   minlen+1, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+2, minlen+1, maj+2,    0,  2, fld ) ; }
+        if ( min == 2        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-2, minlen+2, maj-2,    0, -2, fld ) ;
+                                                                    (*f)( d, min, maj,   minlen+2, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+2, minlen+2, maj+2,    0,  2, fld ) ; }
+        if ( min == minlen-2 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-2, -2,       maj-2,    0, -2, fld ) ;
+                                                                    (*f)( d, min, maj,   -2,       maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+2, -2,       maj+2,    0,  2, fld ) ; }
+/**/    if ( min == minlen-1 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-2, -1,       maj-2,    0, -2, fld ) ;
+                                                                    (*f)( d, min, maj,   -1,       maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+2, -1,       maj+2,    0,  2, fld ) ; }
+      }
+      else
+      {
+/**/    if ( min == 0        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-2, minlen,   maj-2,    0, -2, fld ) ;
+                                                                    (*f)( d, min, maj  , minlen,   maj  ,    0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+2, minlen,   maj+2,    0,  2, fld ) ; }
+        if ( min == 1        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-2, minlen+1, maj-2,    0, -2, fld ) ;
+                                                                    (*f)( d, min, maj  , minlen+1, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+2, minlen+1, maj+2,    0,  2, fld ) ; }
+        if ( min == minlen-2 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-2, -2,       maj-2,    0, -2, fld ) ;
+                                                                    (*f)( d, min, maj,   -2,       maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+2, -2,       maj+2,    0,  2, fld ) ; }
+/**/    if ( min == minlen-1 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj-2, -1,       maj-2,    0, -2, fld ) ;
+                                                                    (*f)( d, min, maj  , -1,       maj  ,    0,  0, fld ) ;
+                                                                    (*f)( d, min, maj+2, -1,       maj+2,    0,  2, fld ) ; }
+      }
+    }
+
+/* sw corner to ne corner */
+/*  if ( min == 0+minstag        && maj == 0+majstag        ) { (*f)( d, min, maj  , minlen+minstag  , majlen+majstag  ,   0,  0, fld ) ; } */
+    if ( min == 1+minstag        && maj == 0+majstag        ) { (*f)( d, min, maj  , minlen+minstag+1, majlen+majstag  ,   0,  0, fld ) ; }
+    if ( min == 0+minstag        && maj == 1+majstag        ) { (*f)( d, min, maj  , minlen+minstag  , majlen+majstag+1,   0,  0, fld ) ; }
+    if ( min == 1+minstag        && maj == 1+majstag        ) { (*f)( d, min, maj  , minlen+minstag+1, majlen+majstag+1,   0,  0, fld ) ; }
+/* nw corner to se corner */
+/*  if ( min == 0+minstag        && maj == majlen-1-majstag ) { (*f)( d, min, maj  , minlen+minstag  , -1            ,   0,  0, fld ) ; } */
+    if ( min == 0+minstag        && maj == majlen-2-majstag ) { (*f)( d, min, maj  , minlen+minstag  , -2            ,   0,  0, fld ) ; }
+    if ( min == 1+minstag        && maj == majlen-2-majstag ) { (*f)( d, min, maj  , minlen+minstag+1, -2            ,   0,  0, fld ) ; }
+    if ( min == 1+minstag        && maj == majlen-1-majstag ) { (*f)( d, min, maj  , minlen+minstag+1, -1            ,   0,  0, fld ) ; }
+/* se corner to nw corner */
+/*  if ( min == minlen-1-minstag && maj == 0+majstag        ) { (*f)( d, min, maj  , -1            , majlen+majstag  ,   0,  0, fld ) ; } */
+    if ( min == minlen-2-minstag && maj == 0+majstag        ) { (*f)( d, min, maj  , -2            , majlen+majstag  ,   0,  0, fld ) ; }
+    if ( min == minlen-2-minstag && maj == 1+majstag        ) { (*f)( d, min, maj  , -2            , majlen+majstag+1,   0,  0, fld ) ; }
+    if ( min == minlen-1-minstag && maj == 1+majstag        ) { (*f)( d, min, maj  , -1            , majlen+majstag+1,   0,  0, fld ) ; }
+/* ne corner to sw corner */
+/*  if ( min == minlen-1-minstag && maj ==majlen-1-majstag  ) { (*f)( d, min, maj  , -1            , -1            ,   0,  0, fld ) ; } */
+    if ( min == minlen-1-minstag && maj ==majlen-2-majstag  ) { (*f)( d, min, maj  , -1            , -2            ,   0,  0, fld ) ; }
+    if ( min == minlen-2-minstag && maj ==majlen-1-majstag  ) { (*f)( d, min, maj  , -2            , -1            ,   0,  0, fld ) ; }
+    if ( min == minlen-2-minstag && maj ==majlen-2-majstag  ) { (*f)( d, min, maj  , -2            , -2            ,   0,  0, fld ) ; }
+
+  }
+
+#endif
+
+  if ( bdyw >= 3 )
+  {
+    if      ( dir == 1 ) /* RSL_N */
+    {
+      if ( majstag )
+      {
+        if ( maj == 0        && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      majlen-0, -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen-0,  0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen-0,  3, 0, fld ) ; }
+        if ( maj == 1        && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      majlen+1, -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+1,  0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+1,  3, 0, fld ) ; }
+        if ( maj == 2        && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      majlen+2, -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+2,  0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+2,  3, 0, fld ) ; }
+        if ( maj == 3        && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      majlen+3, -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+3,  0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+3,  3, 0, fld ) ; }
+        if ( maj == majlen-3 && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      -3,       -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -3,        0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -3,        3, 0, fld ) ; }
+        if ( maj == majlen-2 && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      -2,       -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -2,        0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -2,        3, 0, fld ) ; }
+        if ( maj == majlen-1 && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      -1,       -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -1,        0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -1,        3, 0, fld ) ; }
+
+      }
+      else
+      {
+        if ( maj == 0        && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      majlen+0, -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+0,  0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+0,  3, 0, fld ) ; }
+        if ( maj == 1        && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      majlen+1, -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+1,  0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+1,  3, 0, fld ) ; }
+        if ( maj == 2        && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      majlen+2, -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+2,  0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      majlen+2,  3, 0, fld ) ; }
+        if ( maj == majlen-3 && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      -3,       -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -3,        0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -3,        3, 0, fld ) ; }
+        if ( maj == majlen-2 && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      -2,       -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -2,        0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -2,        3, 0, fld ) ; }
+        if ( maj == majlen-1 && min >=0 && min < minlen+minstag ) { (*f)( d, min, maj, min,      -1,       -3, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -1,        0, 0, fld ) ;
+                                                                    (*f)( d, min, maj, min,      -1,        3, 0, fld ) ; }
+      }
+    }
+    else if ( dir == 0 ) /* RSL_M */
+    {
+      if ( minstag )
+      {
+        if ( min == 0        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, minlen-0, maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, minlen-0, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, minlen-0, maj,      0,  3, fld ) ; }
+        if ( min == 1        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, minlen+1, maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+1, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+1, maj,      0,  3, fld ) ; }
+        if ( min == 2        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, minlen+2, maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+2, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+2, maj,      0,  3, fld ) ; }
+        if ( min == 3        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, minlen+3, maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+3, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+3, maj,      0,  3, fld ) ; }
+        if ( min == minlen-3 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, -3,       maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, -3,       maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, -3,       maj,      0,  3, fld ) ; }
+        if ( min == minlen-2 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, -2,       maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, -2,       maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, -2,       maj,      0,  3, fld ) ; }
+        if ( min == minlen-1 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, -1,       maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, -1,       maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, -1,       maj,      0,  3, fld ) ; }
+      }
+      else
+      {
+        if ( min == 0        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, minlen+0, maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+0, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+0, maj,      0,  3, fld ) ; }
+        if ( min == 1        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, minlen+1, maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+1, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+1, maj,      0,  3, fld ) ; }
+        if ( min == 2        && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, minlen+2, maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+2, maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, minlen+2, maj,      0,  3, fld ) ; }
+        if ( min == minlen-3 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, -3,       maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, -3,       maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, -3,       maj,      0,  3, fld ) ; }
+        if ( min == minlen-2 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, -2,       maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, -2,       maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, -2,       maj,      0,  3, fld ) ; }
+        if ( min == minlen-1 && maj >=0 && maj < majlen+majstag ) { (*f)( d, min, maj, -1,       maj,      0, -3, fld ) ;
+                                                                    (*f)( d, min, maj, -1,       maj,      0,  0, fld ) ;
+                                                                    (*f)( d, min, maj, -1,       maj,      0,  3, fld ) ; }
+      }
+    }
+  }
+/* sw corner to ne corner */
+/*  if ( min == 0+minstag        && maj == 0+majstag        ) { (*f)( d, min, maj  , minlen+minstag  , majlen+majstag  ,   0,  0, fld ) ; } */
+/*  if ( min == 1+minstag        && maj == 0+majstag        ) { (*f)( d, min, maj  , minlen+minstag+1, majlen+majstag  ,   0,  0, fld ) ; } */
+/*  if ( min == 0+minstag        && maj == 1+majstag        ) { (*f)( d, min, maj  , minlen+minstag  , majlen+majstag+1,   0,  0, fld ) ; } */
+/*  if ( min == 1+minstag        && maj == 1+majstag        ) { (*f)( d, min, maj  , minlen+minstag+1, majlen+majstag+1,   0,  0, fld ) ; } */
+    if ( min == 2+minstag        && maj == 0+majstag        ) { (*f)( d, min, maj  , minlen+minstag+2, majlen+majstag  ,   0,  0, fld ) ; }
+    if ( min == 2+minstag        && maj == 1+majstag        ) { (*f)( d, min, maj  , minlen+minstag+2, majlen+majstag+1,   0,  0, fld ) ; }
+    if ( min == 2+minstag        && maj == 2+majstag        ) { (*f)( d, min, maj  , minlen+minstag+2, majlen+majstag+2,   0,  0, fld ) ; }
+    if ( min == 1+minstag        && maj == 2+majstag        ) { (*f)( d, min, maj  , minlen+minstag+1, majlen+majstag+2,   0,  0, fld ) ; }
+    if ( min == 0+minstag        && maj == 2+majstag        ) { (*f)( d, min, maj  , minlen+minstag  , majlen+majstag+2,   0,  0, fld ) ; }
+/* nw corner to se corner */
+/*  if ( min == 0+minstag        && maj == majlen-1-majstag ) { (*f)( d, min, maj  , minlen+minstag  , -1            ,   0,  0, fld ) ; } */
+/*  if ( min == 0+minstag        && maj == majlen-2-majstag ) { (*f)( d, min, maj  , minlen+minstag  , -2            ,   0,  0, fld ) ; } */
+/*  if ( min == 1+minstag        && maj == majlen-2-majstag ) { (*f)( d, min, maj  , minlen+minstag+1, -2            ,   0,  0, fld ) ; } */
+/*  if ( min == 1+minstag        && maj == majlen-1-majstag ) { (*f)( d, min, maj  , minlen+minstag+1, -1            ,   0,  0, fld ) ; } */
+    if ( min == 2+minstag        && maj == majlen-1-majstag ) { (*f)( d, min, maj  , minlen+minstag+2, -1            ,   0,  0, fld ) ; }
+    if ( min == 2+minstag        && maj == majlen-2-majstag ) { (*f)( d, min, maj  , minlen+minstag+2, -2            ,   0,  0, fld ) ; }
+    if ( min == 2+minstag        && maj == majlen-3-majstag ) { (*f)( d, min, maj  , minlen+minstag+2, -3            ,   0,  0, fld ) ; }
+    if ( min == 1+minstag        && maj == majlen-3-majstag ) { (*f)( d, min, maj  , minlen+minstag+1, -3            ,   0,  0, fld ) ; }
+    if ( min == 0+minstag        && maj == majlen-3-majstag ) { (*f)( d, min, maj  , minlen+minstag  , -3            ,   0,  0, fld ) ; }
+/* se corner to nw corner */
+/*  if ( min == minlen-1-minstag && maj == 0+majstag        ) { (*f)( d, min, maj  , -1            , majlen+majstag  ,   0,  0, fld ) ; } */
+/*  if ( min == minlen-2-minstag && maj == 0+majstag        ) { (*f)( d, min, maj  , -2            , majlen+majstag  ,   0,  0, fld ) ; } */
+/*  if ( min == minlen-2-minstag && maj == 1+majstag        ) { (*f)( d, min, maj  , -2            , majlen+majstag+1,   0,  0, fld ) ; } */
+/*  if ( min == minlen-1-minstag && maj == 1+majstag        ) { (*f)( d, min, maj  , -1            , majlen+majstag+1,   0,  0, fld ) ; } */
+    if ( min == minlen-3-minstag && maj == 0+majstag        ) { (*f)( d, min, maj  , -3            , majlen+majstag+0,   0,  0, fld ) ; }
+    if ( min == minlen-3-minstag && maj == 1+majstag        ) { (*f)( d, min, maj  , -3            , majlen+majstag+1,   0,  0, fld ) ; }
+    if ( min == minlen-3-minstag && maj == 2+majstag        ) { (*f)( d, min, maj  , -3            , majlen+majstag+2,   0,  0, fld ) ; }
+    if ( min == minlen-2-minstag && maj == 2+majstag        ) { (*f)( d, min, maj  , -2            , majlen+majstag+2,   0,  0, fld ) ; }
+    if ( min == minlen-1-minstag && maj == 2+majstag        ) { (*f)( d, min, maj  , -1            , majlen+majstag+2,   0,  0, fld ) ; }
+/* ne corner to sw corner */
+/*  if ( min == minlen-1-minstag && maj ==majlen-1-majstag  ) { (*f)( d, min, maj  , -1            , -1            ,   0,  0, fld ) ; } */
+/*  if ( min == minlen-1-minstag && maj ==majlen-2-majstag  ) { (*f)( d, min, maj  , -1            , -2            ,   0,  0, fld ) ; } */
+/*  if ( min == minlen-2-minstag && maj ==majlen-1-majstag  ) { (*f)( d, min, maj  , -2            , -1            ,   0,  0, fld ) ; } */
+/*  if ( min == minlen-2-minstag && maj ==majlen-2-majstag  ) { (*f)( d, min, maj  , -2            , -2            ,   0,  0, fld ) ; } */
+    if ( min == minlen-3-minstag && maj ==majlen-1-majstag  ) { (*f)( d, min, maj  , -3            , -1            ,   0,  0, fld ) ; }
+    if ( min == minlen-3-minstag && maj ==majlen-2-majstag  ) { (*f)( d, min, maj  , -3            , -2            ,   0,  0, fld ) ; }
+    if ( min == minlen-3-minstag && maj ==majlen-3-majstag  ) { (*f)( d, min, maj  , -3            , -3            ,   0,  0, fld ) ; }
+    if ( min == minlen-2-minstag && maj ==majlen-3-majstag  ) { (*f)( d, min, maj  , -2            , -3            ,   0,  0, fld ) ; }
+    if ( min == minlen-1-minstag && maj ==majlen-3-majstag  ) { (*f)( d, min, maj  , -1            , -3            ,   0,  0, fld ) ; }
+
+}
+
+
+/* apply the function f to each of the points of the stencil in order:
+
+                    1  2  3
+                    4 00  5   
+                    6  7  8
+
+NOTE: as written, this routine assumes that the ns index is minor as
+in the NCAR MM.
+
+*/
+
+rsl_8pt( d, min, minlen, maj, majlen, f )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+if ( maj >= 0 && maj < majlen )
+{
+  /* n1 */ if ( min+1 < minlen ) (*f)( d, min+1, maj, min, maj, 2, 7 ) ;
+  /* s1 */ if ( min-1 >= 0 )      (*f)( d, min-1, maj, min, maj, 7, 2 ) ;
+}
+if ( min >= 0 && min < minlen )
+{
+  /* w1 */ if ( maj-1 >= 0 )      (*f)( d, min, maj-1, min, maj, 4, 5 ) ;
+  /* e1 */ if ( maj+1 < majlen ) (*f)( d, min, maj+1, min, maj, 5, 4 ) ;
+}
+/* nw */ if ( maj-1 >= 0 &&
+              min+1 < minlen ) (*f)( d, min+1, maj-1, min, maj, 1, 8  ) ;
+/* ne */ if ( maj+1 < majlen &&
+              min+1 < minlen ) (*f)( d, min+1, maj+1, min, maj, 3, 6 ) ;
+/* sw */ if ( maj-1 >= 0 &&
+              min-1 >= 0 )      (*f)( d, min-1, maj-1, min, maj, 6, 3 ) ;
+/* se */ if ( maj+1 < majlen &&
+              min-1 >= 0 )      (*f)( d, min-1, maj+1, min, maj, 8, 1 ) ;
+/* 00 */ if ( maj >= 0 && maj < majlen &&
+              min >= 0 && min < minlen ) (*f)( d, min, maj, min, maj, 0, 0 ) ;
+}
+
+/* apply the function f to each of the points of the stencil in order:
+
+                       1
+                    2  3  4
+                 5  6 00  7  8
+                    9 10 11
+                      12
+
+NOTE: as written, this routine assumes that the ns index is minor as
+in the NCAR MM.
+
+*/
+
+rsl_12pt( d, min, minlen, maj, majlen, f )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+if ( maj >= 0 && maj < majlen )
+{
+  /* n2 */ if ( min+2 < minlen ) (*f)( d, min+2, maj, min, maj, 1, 12 ) ;
+  /* n1 */ if ( min+1 < minlen ) (*f)( d, min+1, maj, min, maj, 3, 10 ) ;
+  /* s1 */ if ( min-1 >= 0 )      (*f)( d, min-1, maj, min, maj, 10, 3 ) ;
+  /* s2 */ if ( min-2 >= 0 )      (*f)( d, min-2, maj, min, maj, 12, 1 ) ;
+}
+if ( min >= 0 && min < minlen )
+{
+  /* w2 */ if ( maj-2 >= 0 )      (*f)( d, min, maj-2, min, maj, 5, 8 ) ;
+  /* w1 */ if ( maj-1 >= 0 )      (*f)( d, min, maj-1, min, maj, 6, 7 ) ;
+  /* e1 */ if ( maj+1 < majlen ) (*f)( d, min, maj+1, min, maj, 7, 6 ) ;
+  /* e2 */ if ( maj+2 < majlen ) (*f)( d, min, maj+2, min, maj, 8, 5 ) ;
+}
+/* nw */ if ( maj-1 >= 0 &&
+              min+1 < minlen ) (*f)( d, min+1, maj-1, min, maj, 2, 11 ) ;
+/* ne */ if ( maj+1 < majlen && 
+              min+1 < minlen ) (*f)( d, min+1, maj+1, min, maj,  4, 9 ) ;
+/* sw */ if ( maj-1 >= 0 && 
+              min-1 >= 0 )      (*f)( d, min-1, maj-1, min, maj, 9, 4 ) ;
+/* se */ if ( maj+1 < majlen && 
+              min-1 >= 0 )      (*f)( d, min-1, maj+1, min, maj, 11, 2 ) ;
+/* 00 */ if ( maj >= 0 && maj < majlen && 
+              min >= 0 && min < minlen ) (*f)( d, min, maj, min, maj, 0, 0 ) ;
+}
+
+/* apply the function f to each of the points of the stencil in order:
+
+                 1  2  3  4  5
+                 6  7  8  9 10
+                11 12 00 13 14
+                15 16 17 18 19
+                20 21 22 23 24
+
+NOTE: as written, this routine assumes that the ns index is minor as
+in the NCAR MM.
+
+*/
+static char pts[] = { 20, 21, 22, 23, 24,
+                      15, 16, 17, 18, 19,
+                      11, 12,  0, 13, 14,
+                       6,  7,  8,  9, 10,
+                       1,  2,  3,  4,  5, } ;
+
+static char ipts[] = { 5,  4,  3,  2,  1,
+                      10,  9,  8,  7,  6,
+                      14, 13,  0, 12, 11,
+                      19, 18, 17, 16, 15,
+                      24, 23, 22, 21, 20, } ;
+
+rsl_24pt( d, min, minlen, maj, majlen, f )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+  rsl_index_t i, j, k ;
+
+  k = 0 ;
+  for ( i = -2 ; i <= 2 ; i++ )
+  {
+    for ( j = -2 ; j <= 2 ; j++ )
+    {
+      if ( min+i >= 0 && min+i < minlen &&
+             maj+j >= 0 && maj+j < majlen )
+      {
+        (*f)(d,min+i,maj+j,min,maj,pts[k],ipts[k]) ;
+      }
+      k++ ;
+    }
+  }
+}
+
+#if ( ALLOW_RSL_168PT == 1 )
+/* apply the function f to each of the points of the stencil in order:
+
+  1   2   3   4   5   6   7   8   9  10  11  12  13
+ 14  15  16  17  18  19  20  21  22  23  23  25  26
+ 27  28  29  30  31  32  33  34  35  36  37  38  39
+ 40  41  42  43  44  45  46  47  48  49  50  51  52
+ 53  54  55  56  57  58  59  60  61  62  63  64  65
+ 66  67  68  69  70  71  72  73  74  75  76  77  78
+ 79  80  81  82  83  84  00  85  86  87  88  89  90
+ 91  92  93  94  95  96  97  98  99 100 101 102 103
+104 105 106 107 108 109 110 111 112 113 114 115 116
+117 118 119 120 121 122 123 124 125 126 127 128 129
+130 131 132 133 134 135 136 137 138 139 140 141 142
+143 144 145 146 147 148 149 150 151 152 153 154 155
+156 157 158 159 160 161 162 163 164 165 166 167 168
+
+NOTE: as written, this routine assumes that the ns index is minor as
+in the NCAR MM.
+
+Here is a shell script for converting the above table into 
+the form that is assigned to ipts168 below (it reverses
+the columns).   Commas get added separately.
+
+#
+/bin/cp xxx yyy
+echo phase 1
+set i=0
+while ($i < 13)
+  echo $i
+  cut -c1-4 yyy > /tmp/$i.temp
+  cut -c5-  yyy > foo
+  /bin/mv foo yyy
+  @ i += 1
+end
+echo phase 1
+/bin/cp /tmp/0.temp yyy
+set i=1
+while ($i < 13)
+  echo $i
+  paste /tmp/$i.temp yyy | sed 's/    //' > foo
+  /bin/mv foo yyy
+  @ i += 1
+end
+
+*/
+
+
+static rsl_index_t pts48[] = {
+    42, 43, 44, 45, 46, 47, 48,
+    35, 36, 37, 38, 39, 40, 41,
+    28, 29, 30, 31, 32, 33, 34,
+    22, 23, 24, 00, 25, 26, 27,
+    15, 16, 17, 18, 19, 20, 21,
+     8,  9, 10, 11, 12, 13, 14,
+     1,  2,  3,  4,  5,  6,  7
+    } ;
+
+static rsl_index_t ipts48[] = {
+     7,  6,  5,  4,  3,  2,  1,
+    14, 13, 12, 11, 10,  9,  8,
+    21, 20, 19, 18, 17, 16, 15,
+    27, 26, 25, 00, 24, 23, 22,
+    34, 33, 32, 31, 30, 29, 28,
+    41, 40, 39, 38, 37, 36, 35,
+    48, 47, 46, 45, 44, 43, 42
+    } ;
+
+
+rsl_48pt( d, min, minlen, maj, majlen, f )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+  rsl_index_t i, j, k ;
+
+  k = 0 ;
+  for ( i = -3 ; i <= 3 ; i++ )
+  {
+    for ( j = -3 ; j <= 3 ; j++ )
+    {
+      if ( min+i >= 0 && min+i < minlen &&
+             maj+j >= 0 && maj+j < majlen )
+      {
+        (*f)(d,min+i,maj+j,min,maj,pts48[k],ipts48[k]) ;
+      }
+      k++ ;
+    }
+  }
+}
+
+static rsl_index_t pts80[] = {
+    72, 73, 74, 75, 76, 77, 78, 79, 80,
+    63, 64, 65, 66, 67, 68, 69, 70, 71,
+    54, 55, 56, 57, 58, 59, 60, 61, 62,
+    45, 46, 47, 48, 49, 50, 51, 52, 53,
+    37, 38, 39, 40, 00, 41, 42, 43, 44,
+    28, 29, 30, 31, 32, 33, 34, 35, 36,
+    19, 20, 21, 22, 23, 24, 25, 26, 27,
+    10, 11, 12, 13, 14, 15, 16, 17, 18,
+     1,  2,  3,  4,  5,  6,  7,  8,  9,
+    } ;
+
+static rsl_index_t ipts80[] = {
+     9,  8,  7,  6,  5,  4,  3,  2,  1,
+    18, 17, 16, 15, 14, 13, 12, 11, 10,
+    27, 26, 25, 24, 23, 22, 21, 20, 19,
+    36, 35, 34, 33, 32, 31, 30, 29, 28,
+    44, 43, 42, 41, 00, 40, 39, 38, 37,
+    53, 52, 51, 50, 49, 48, 47, 46, 45,
+    62, 61, 60, 59, 58, 57, 56, 55, 54,
+    71, 70, 69, 68, 67, 66, 65, 64, 63,
+    80, 79, 78, 77, 76, 75, 74, 73, 72
+    } ;
+
+
+rsl_80pt( d, min, minlen, maj, majlen, f )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+  rsl_index_t i, j, k ;
+
+  k = 0 ;
+  for ( i = -4 ; i <= 4 ; i++ )
+  {
+    for ( j = -4 ; j <= 4 ; j++ )
+    {
+      if ( min+i >= 0 && min+i < minlen &&
+             maj+j >= 0 && maj+j < majlen )
+      {
+        (*f)(d,min+i,maj+j,min,maj,pts80[k],ipts80[k]) ;
+      }
+      k++ ;
+    }
+  }
+}
+
+static rsl_index_t pts120[] = {
+   110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120,
+    99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109,
+    88,  89,  90,  91,  92,  93,  94,  95,  96,  97,  98,
+    77,  78,  79,  80,  81,  82,  83,  84,  85,  86,  87,
+    66,  67,  68,  69,  70,  71,  72,  73,  74,  75,  76,
+    56,  57,  58,  59,  60,  00,  61,  62,  63,  64,  65,
+    45,  46,  47,  48,  49,  50,  51,  52,  53,  54,  55,
+    34,  35,  36,  37,  38,  39,  40,  41,  42,  43,  44,
+    23,  24,  25,  26,  27,  28,  29,  30,  31,  32,  33,
+    12,  13,  14,  15,  16,  17,  18,  19,  20,  21,  22,
+     1,   2,   3,   4,   5,   6,   7,   8,   9,  10,  11,
+    } ;
+
+static rsl_index_t ipts120[] = {
+    11,  10,   9,   8,   7,   6,   5,   4,   3,   2,   1,
+    22,  21,  20,  19,  18,  17,  16,  15,  14,  13,  12,
+    33,  32,  31,  30,  29,  28,  27,  26,  25,  24,  23,
+    44,  43,  42,  41,  40,  39,  38,  37,  36,  35,  34,
+    55,  54,  53,  52,  51,  50,  49,  48,  47,  46,  45,
+    65,  64,  63,  62,  61,  00,  60,  59,  58,  57,  56,
+    76,  75,  74,  73,  72,  71,  70,  69,  68,  67,  66,
+    87,  86,  85,  84,  83,  82,  81,  80,  79,  78,  77,
+    98,  97,  96,  95,  94,  93,  92,  91,  90,  89,  88,
+   109, 108, 107, 106, 105, 104, 103, 102, 101, 100,  99,
+   120, 119, 118, 117, 116, 115, 114, 113, 112, 111, 110
+    } ;
+
+
+rsl_120pt( d, min, minlen, maj, majlen, f )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+  rsl_index_t i, j, k ;
+
+  k = 0 ;
+  for ( i = -5 ; i <= 5 ; i++ )
+  {
+    for ( j = -5 ; j <= 5 ; j++ )
+    {
+      if ( min+i >= 0 && min+i < minlen &&
+             maj+j >= 0 && maj+j < majlen )
+      {
+        (*f)(d,min+i,maj+j,min,maj,pts120[k],ipts120[k]) ;
+      }
+      k++ ;
+    }
+  }
+}
+
+static rsl_index_t pts168[] = {
+   156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168,
+   143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155,
+   130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142,
+   117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129,
+   104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116,
+    91,  92,  93,  94,  95,  96,  97,  98,  99, 100, 101, 102, 103,
+    79,  80,  81,  82,  83,  84,  00,  85,  86,  87,  88,  89,  90,
+    66,  67,  68,  69,  70,  71,  72,  73,  74,  75,  76,  77,  78,
+    53,  54,  55,  56,  57,  58,  59,  60,  61,  62,  63,  64,  65,
+    40,  41,  42,  43,  44,  45,  46,  47,  48,  49,  50,  51,  52,
+    27,  28,  29,  30,  31,  32,  33,  34,  35,  36,  37,  38,  39,
+    14,  15,  16,  17,  18,  19,  20,  21,  22,  23,  23,  25,  26,
+     1,   2,   3,   4,   5,   6,   7,   8,   9,  10,  11,  12,  13
+    } ;
+
+static rsl_index_t ipts168[] = {
+    13,  12,  11,  10,   9,   8,   7,   6,   5,   4,   3,   2,   1, 
+    26,  25,  23,  23,  22,  21,  20,  19,  18,  17,  16,  15,  14, 
+    39,  38,  37,  36,  35,  34,  33,  32,  31,  30,  29,  28,  27, 
+    52,  51,  50,  49,  48,  47,  46,  45,  44,  43,  42,  41,  40, 
+    65,  64,  63,  62,  61,  60,  59,  58,  57,  56,  55,  54,  53, 
+    78,  77,  76,  75,  74,  73,  72,  71,  70,  69,  68,  67,  66, 
+    90,  89,  88,  87,  86,  85,  00,  84,  83,  82,  81,  80,  79, 
+   103, 102, 101, 100,  99,  98,  97,  96,  95,  94,  93,  92,  91, 
+   116, 115, 114, 113, 112, 111, 110, 109, 108, 107, 106, 105, 104, 
+   129, 128, 127, 126, 125, 124, 123, 122, 121, 120, 119, 118, 117, 
+   142, 141, 140, 139, 138, 137, 136, 135, 134, 133, 132, 131, 130, 
+   155, 154, 153, 152, 151, 150, 149, 148, 147, 146, 145, 144, 143, 
+   168, 167, 166, 165, 164, 163, 162, 161, 160, 159, 158, 157, 156
+    } ;
+
+
+rsl_168pt( d, min, minlen, maj, majlen, f )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+  rsl_index_t i, j, k ;
+
+  k = 0 ;
+  for ( i = -6 ; i <= 6 ; i++ )
+  {
+    for ( j = -6 ; j <= 6 ; j++ )
+    {
+      if ( min+i >= 0 && min+i < minlen &&
+             maj+j >= 0 && maj+j < majlen )
+      {
+        (*f)(d,min+i,maj+j,min,maj,pts168[k],ipts168[k]) ;
+      }
+      k++ ;
+    }
+  }
+}
+
+/* March 1997 */
+
+rsl_2ptm( d, min, minlen, maj, majlen, f  )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+if ( maj >= 0 && maj < majlen )
+{
+  /* n1 */ if ( min+1 < minlen ) (*f)( d, min+1, maj, min, maj, 1, 4 ) ;
+  /* s1 */ if ( min-1 >= 0 )      (*f)( d, min-1, maj, min, maj, 4, 1 ) ;
+}
+/* 00 */ if ( maj >= 0 && maj < majlen &&
+              min >= 0 && min < minlen ) (*f)( d, min, maj, min, maj, 0, 0 ) ;
+}
+
+rsl_4ptm( d, min, minlen, maj, majlen, f )
+  rsl_index_t d ;
+  rsl_index_t min ;
+  rsl_dimlen_t minlen ;
+  rsl_index_t maj ;
+  rsl_dimlen_t majlen ;
+  int (*f)() ;
+{
+if ( maj >= 0 && maj < majlen )
+{
+  /* n2 */ if ( min+2 < minlen ) (*f)( d, min+2, maj, min, maj, 1, 12 ) ;
+  /* n1 */ if ( min+1 < minlen ) (*f)( d, min+1, maj, min, maj, 3, 10 ) ;
+  /* s1 */ if ( min-1 >= 0 )      (*f)( d, min-1, maj, min, maj, 10, 3 ) ;
+  /* s2 */ if ( min-2 >= 0 )      (*f)( d, min-2, maj, min, maj, 12, 1 ) ;
+}
+/* 00 */ if ( maj >= 0 && maj < majlen && 
+              min >= 0 && min < minlen ) (*f)( d, min, maj, min, maj, 0, 0 ) ;
+}
+
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl.c	(revision 2744)
@@ -0,0 +1,71 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+destroy_runrec( p )
+  rsl_runrec_t *p ;
+{
+  if ( p != NULL ) RSL_FREE( p ) ;
+}
+
+rsl_fatal( n )
+  int n ;
+{
+  exit(n) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl.h	(revision 2744)
@@ -0,0 +1,876 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+
+#ifndef RSL_H
+#define RSL_H
+
+/**************************************************************/
+/* Any changes to this file should be followed by make clean  */
+/* before remaking the RSL library                            */
+/**************************************************************/
+
+/**************************************************************/
+/* not likely that you will need to change things below here */
+
+/* this definition used in cd.c */
+#define HARD_CODED_BOUNDARY_WIDTH_FIX_ME_PLEASE 5
+
+#define RSL_MAXDOMAINS  MAXDOM_MAKE	/* FORTRAN */
+
+#define RSL_MAXPROC     MAXPROC_MAKE	/* FORTRAN */
+
+/* increased from 5 to 7 10/4/96 to accomodate 168 pt stencil */
+/* decreased to 3 (2 + 1 for garbage row) to save memory -- only estore
+   in sound needs 168 pt stencil and we'll handle that as a special case */
+#define RSL_DEFAULT_PADAREA 4           /* FORTRAN */
+
+#define RSL_MLOW        1		/* FORTRAN */
+#define RSL_MHIGH       2               /* FORTRAN */
+#define RSL_NLOW        3               /* FORTRAN */
+#define RSL_NHIGH       4               /* FORTRAN */
+#define RSL_DBDY	5		/* FORTRAN */
+#define RSL_CLOSEST     6		/* FORTRAN */
+
+#define DOT_BDY_INFO_LEN 10		/* FORTRAN */
+
+#define RSL_MLOW_X      7		/* FORTRAN */
+#define RSL_MHIGH_X     8               /* FORTRAN */
+#define RSL_NLOW_X      9               /* FORTRAN */
+#define RSL_NHIGH_X    10               /* FORTRAN */
+#define RSL_DBDY_X     11		/* FORTRAN */
+#define RSL_CLOSEST_X  12		/* FORTRAN */
+
+#define CROSS_BDY_INFO_LEN 12 		/* FORTRAN */
+
+#define RSL_00	        7		/* FORTRAN */
+#define RSL_M0	        8		/* FORTRAN */
+#define RSL_0N	        9		/* FORTRAN */
+#define RSL_MN	       10		/* FORTRAN */
+
+#define MLOW (RSL_MLOW-1)
+#define MHIGH (RSL_MHIGH-1)
+#define NLOW (RSL_NLOW-1)
+#define NHIGH (RSL_NHIGH-1)
+
+#define MAX_RUNPAD  6
+#define MAX_KINDPAD 8
+/* break ties in boundary classification */
+#define M_WINS      0                   /* FORTRAN */
+#define N_WINS      1                   /* FORTRAN */
+#define DIAG_WINS  2                   /* FORTRAN */
+
+#ifdef SHOW_RSL_CONFIGURATION
+/* SHOW_RSL_CONFIGURATION is only every defined externally.  This
+   next bit is never actually used.  Rather it is used by the top
+   level makefile to show the configuration of the model when the
+   user types make showconfig.  */
+show config:  ---if the library were completely remade---
+show config:"RSL_IMAX" would be set to:            RSL_IMAX
+show config:"RSL_JMAX" would be set to:            RSL_JMAX
+show config:"RSL_MAXDOMAINS" would be set to:      RSL_MAXDOMAINS
+show config:"RSL_MAXPROC" would be set to:         RSL_MAXPROC
+show config:  ---See also the makefile---
+#endif
+
+
+/* this should become runtime setaable from the fortran someday */
+
+#define RSL_TRUE  1			/* FORTRAN */
+#define RSL_FALSE 0			/* FORTRAN */
+#define RSL_INVALID -1			/* FORTRAN */
+#define RSL_VALID 1			/* FORTRAN */
+
+#define RSL_IRAX 3			/* FORTRAN */
+#define RSL_MAXCHILDREN (RSL_IRAX*RSL_IRAX)
+#define RSL_MAXKIDS RSL_MAXCHILDREN
+#define RSL_MAXDESCRIPTORS  2048
+/* settings below will allow for 20000 fields */
+#define MAX_BASE_TABLE_ENTRIES 20000
+
+#if (ALLOW_RSL_168PT == 1)
+#  define RSL_MAXSTEN    168              /* MAX NUMBER OF STENCIL PTS */
+#else
+#  define RSL_MAXSTEN	 24		/* MAX NUMBER OF STENCIL PTS */
+#endif
+
+
+#define RSL_REAL		0	/* FORTRAN */
+#define RSL_DOUBLE		1	/* FORTRAN */
+#define RSL_COMPLEX		2	/* FORTRAN */
+#define RSL_INTEGER		3	/* FORTRAN */
+#define RSL_CHARACTER		4	/* FORTRAN */
+
+#define RSL_REAL_F90		100	/* FORTRAN */
+#define RSL_DOUBLE_F90		101	/* FORTRAN */
+#define RSL_COMPLEX_F90		102	/* FORTRAN */
+#define RSL_INTEGER_F90		103	/* FORTRAN */
+#define RSL_CHARACTER_F90	104	/* FORTRAN */
+
+/* traversal orders */
+/* A = Ascending, D = Descending, applied to dim in order left to right */
+#define MINMAJ_AA                0       /* FORTRAN */
+#define MINMAJ_AD                1       /* FORTRAN */
+#define MINMAJ_DA                2       /* FORTRAN */
+#define MINMAJ_DD                3       /* FORTRAN */
+#define MAJMIN_AA             1000       /* FORTRAN */
+#define MAJMIN_AD             1001       /* FORTRAN */
+#define MAJMIN_DA             1002       /* FORTRAN */
+#define MAJMIN_DD             1003       /* FORTRAN */
+#define MINMAJ           MINMAJ_AA       /* FORTRAN */
+#define MAJMIN           MAJMIN_AA       /* FORTRAN */
+
+#define MNMJ(X)     ( ( (X) / 1000 ) == 0 )
+#define D1(X)       ( 2 & (X) )
+#define D2(X)       ( 1 & (X) )
+#define A1(X)       ( ! A1 )
+#define A2(X)       ( ! A2 )
+
+/* nested domain shapes */
+#define RSL_REGULAR_NEST  55		/* FORTRAN */
+#define RSL_RAGGED_NEST  56		/* FORTRAN */
+
+/* packing strategies */
+#define MINNS_MAJEW_2D   0
+#define MINEW_MAJNS_2D   1
+#define MINNS_MAJEW_K_3D 2
+#define MINEW_MAJNS_K_3D 3
+#define K_MIDNS_MAJEW_3D 4
+#define MINNS_K_MAJEW_3D 5
+
+/* io strategies */
+
+#define IO_REPL  99		/* FORTRAN */
+
+#define IO2D_IJ  0		/* FORTRAN */
+#define IO2D_JI  1		/* FORTRAN */
+#define IO3D_IJK 2		/* FORTRAN */
+#define IO3D_JIK 3		/* FORTRAN */
+#define IO2D     4		/* FORTRAN */
+#define IO3D     5		/* FORTRAN */
+#define IO3D_KIJ 6              /* FORTRAN */
+#define IO3D_IKJ 7              /* FORTRAN */
+
+#define IO2D_IJ_RAW  10		/* FORTRAN */
+#define IO2D_JI_RAW  11		/* FORTRAN */
+#define IO3D_IJK_RAW 12		/* FORTRAN */
+#define IO3D_JIK_RAW 13		/* FORTRAN */
+
+#define IO2D_IJ_PORTAL  20	/* FORTRAN */
+#define IO2D_JI_PORTAL  21	/* FORTRAN */
+#define IO3D_IJK_PORTAL 22	/* FORTRAN */
+#define IO3D_JIK_PORTAL 23	/* FORTRAN */
+
+#define IO2D_IJ_INTERNAL  24	/* FORTRAN */
+#define IO2D_JI_INTERNAL  25	/* FORTRAN */
+#define IO3D_IJK_INTERNAL 26	/* FORTRAN */
+#define IO3D_JIK_INTERNAL 27	/* FORTRAN */
+#define IO3D_KIJ_INTERNAL 28	/* FORTRAN */
+#define IO3D_IKJ_INTERNAL 29	/* FORTRAN */
+
+#define IO2D_IJ_88  30	/* FORTRAN */
+#define IO2D_JI_88  31	/* FORTRAN */
+#define IO3D_IJK_88 32	/* FORTRAN */
+#define IO3D_JIK_88 33	/* FORTRAN */
+
+#define RSL_MAXDIM 3
+
+/* type declarations */
+
+typedef int * int_p ;
+#if !(defined(SUNDEBUG) || defined(crayx1))
+#ifndef NEC_TUNE
+typedef short   rsl_processor_t ;
+typedef short   rsl_index_t ;
+typedef short   rsl_dimlen_t ;
+#else
+typedef int   rsl_processor_t ;
+typedef int   rsl_index_t ;
+typedef int   rsl_dimlen_t ;
+#endif
+#else
+typedef int   rsl_processor_t ;
+typedef int   rsl_index_t ;
+typedef int   rsl_dimlen_t ;
+#endif
+typedef long    rsl_point_id_t ;
+
+#ifdef crayx1
+typedef int rsl_tag_t ;
+#else
+#ifndef NEC_TUNE
+typedef unsigned char rsl_tag_t ;
+#else
+typedef int rsl_tag_t ;
+#endif
+#endif
+
+typedef struct rsl_list {
+  struct rsl_list * next ;
+  void * data ;	                /* pointer to some node */
+#ifdef crayx1
+  int info1 ;                   /* blank info field */
+  int info2 ;                   /* blank info field */
+#else
+  short info1 ;                 /* blank info field */
+  short info2 ;                 /* blank info field */
+#endif
+} rsl_list_t ;
+
+
+typedef struct rsl_runrec {	/* added 1/9/95 for rsl_compute_islab */
+  int i, j, ig, jg, runlength ;
+} rsl_runrec_t ;
+
+typedef struct bcast_point_desc {
+  rsl_point_id_t nest_id ;	/* pt in nest */
+  rsl_point_id_t parent_id ;	/* cd pt */
+  unsigned char cn, cm ;	/* indices of point, with respect to cd pt */
+} bcast_point_desc_t ;
+
+typedef bcast_point_desc_t merge_point_desc_t ;
+
+typedef struct rsl_fldspec {
+  struct rsl_fldspec    * next ;
+  void                  * base ;
+  rsl_tag_t             ndim ;
+  rsl_tag_t             elemsz ;
+  rsl_tag_t             memsize ;
+  rsl_tag_t             type ;
+  int                   f90_table_index ;
+  rsl_tag_t             strategy ;
+  rsl_tag_t             decomp[ RSL_MAXDIM ] ;
+  rsl_index_t           gdex[ RSL_MAXDIM ] ;
+  rsl_dimlen_t          glen[ RSL_MAXDIM ] ;
+  rsl_dimlen_t          llen[ RSL_MAXDIM ] ;
+  rsl_dimlen_t          stag[ RSL_MAXDIM ] ;  /* 0 = not staggered; 1 = staggered */
+} rsl_fldspec_t ;
+
+typedef struct message_desc {
+  rsl_tag_t tag;
+    /* should be MESSAGE_DESC or BLANK_MESSAGE_DESC */
+  int mh ;              /* handle */
+  int nflds ;           /* number of field specs in message */
+  int nbytes ;          /* for blank messages */
+  rsl_fldspec_t *fldspecs ;
+} message_desc_t ;
+
+typedef struct rsl_plist_elem {
+  struct rsl_plist_elem *next ;
+  rsl_point_id_t id ;
+  rsl_processor_t P ;
+} rsl_plist_elem_t ;
+
+typedef struct rsl_child_info {
+  rsl_point_id_t  child[RSL_MAXCHILDREN] ;
+  rsl_processor_t P[RSL_MAXCHILDREN] ;
+} rsl_child_info_t ;
+
+typedef struct rsl_point {
+  rsl_processor_t   P ;		/* physical processor number */
+  int               valid ;	/* a valid point? */
+  rsl_tag_t         trimmed ;	/* was this point trimmed */
+  rsl_tag_t         cross ;     /* member of the cross grid */
+  rsl_tag_t	    info_1 ;	/* misc tag info */
+  rsl_tag_t	    info_2 ;	/* misc tag info */
+  rsl_point_id_t    id ;
+  rsl_point_id_t    mother_id ;
+  rsl_processor_t   mother_P ;
+  rsl_tag_t         which_kid_am_i_m ;
+  rsl_tag_t         which_kid_am_i_n ;
+
+/* on whole grid */
+
+ 			/* counter-clockwise and clockwise below refer
+			   to the direction of the traversal in fill_boundary
+			   that determined the boundary association... 
+			   we store both to allow for several resolution
+			   strategies on corners.  */
+
+/* dot grid */
+  rsl_index_t       bdy_cclockwise ;	/* direction to boundary (counter) */
+  rsl_index_t       bdy_clockwise ;	/* direction to boundary (clockwise) */
+  rsl_index_t       dbdy ;		/* distance to boundary */
+
+			/* these next four fields are computed differently,
+			   in that they do not take into account corners.
+			   They simply measure the distance from the point
+			   to the boundary in question. */
+  rsl_index_t       dist_mlow ;		/* distance to southern bdy */
+  rsl_index_t       dist_mhigh ;	/*     "    to northern bdy */
+  rsl_index_t       dist_nlow ;         /*     "    to western bdy  */
+  rsl_index_t       dist_nhigh ;        /*     "    to eastern bdy  */
+
+/* on cross grid */
+/* cross grid */
+  rsl_index_t       bdy_x_cclockwise ;	/* direction to boundary (counter) */
+  rsl_index_t       bdy_x_clockwise ;	/* direction to boundary (clockwise) */
+  rsl_index_t       dbdy_x ;		/* distance to boundary */
+
+  rsl_index_t       dist_mlow_x ;	/* distance to southern bdy */
+  rsl_index_t       dist_mhigh_x ;	/*     "    to northern bdy */
+  rsl_index_t       dist_nlow_x ;       /*     "    to western bdy  */
+  rsl_index_t       dist_nhigh_x ;      /*     "    to eastern bdy  */
+
+  rsl_child_info_t *children_p ;
+} rsl_point_t ;
+
+typedef struct rsl_hemi_rec {
+  int oig , ojg ;
+  int nbytes ;
+  int curs ;
+  char * data ;
+  struct rsl_hemi_rec * next ;
+} rsl_hemi_rec_t ;
+
+typedef struct rsl_domain_info {
+  int valid ;
+  int decomposed ;
+
+  /* parent domain descriptor */
+  int parent ;
+  int nestshape ;	/* RSL_REGULAR_NEST, RSL_RAGGED_NEST */
+
+  /* information about parent, children */
+  int parent_bcast_compiled ;
+  int parent_merge_compiled ;
+  int child_bcast_compiled[RSL_MAXDOMAINS] ;
+  int child_merge_compiled[RSL_MAXDOMAINS] ;
+
+  /* pointer to MN domain data structure (array of points) */
+  rsl_point_t     *domain ;
+
+  /* pointer to MZ domain data structure (array of points) (20010222) */
+  rsl_point_t     *domain_mz ;
+
+  /* pointer to NZ domain data structure (array of points) (20010222) */
+  rsl_point_t     *domain_nz ;
+
+/* MN decomp */
+  /* dimensions of the global domain data structure */
+  rsl_dimlen_t    len_m ;
+  rsl_dimlen_t    len_n ;
+  rsl_dimlen_t    eff_m ;
+  rsl_dimlen_t    eff_n ;
+  rsl_dimlen_t    loc_m ;
+  rsl_dimlen_t    loc_n ;
+  /* dimensions of the global domain data structure (20010222) */
+  rsl_dimlen_t    len_z ;
+  rsl_dimlen_t    eff_z ;
+  rsl_dimlen_t    loc_z ;
+/* MZ decomp (20010223) */
+  /* dimensions of the global domain data structure */
+  rsl_dimlen_t    len_mz_m ;
+  rsl_dimlen_t    len_mz_n ;
+  rsl_dimlen_t    eff_mz_m ;
+  rsl_dimlen_t    eff_mz_n ;
+  rsl_dimlen_t    loc_mz_m ;
+  rsl_dimlen_t    loc_mz_n ;
+  rsl_dimlen_t    len_mz_z ;
+  rsl_dimlen_t    eff_mz_z ;
+  rsl_dimlen_t    loc_mz_z ;
+/* NZ decomp  (20010223 */
+  /* dimensions of the global domain data structure */
+  rsl_dimlen_t    len_nz_m ;
+  rsl_dimlen_t    len_nz_n ;
+  rsl_dimlen_t    eff_nz_m ;
+  rsl_dimlen_t    eff_nz_n ;
+  rsl_dimlen_t    loc_nz_m ;
+  rsl_dimlen_t    loc_nz_n ;
+  rsl_dimlen_t    len_nz_z ;
+  rsl_dimlen_t    eff_nz_z ;
+  rsl_dimlen_t    loc_nz_z ;
+
+  /* list of stencils used on this domain  (just keep handles) */
+  int stenlist[RSL_MAXDESCRIPTORS] ;
+  int stencurs ;
+  int periodlist[RSL_MAXDESCRIPTORS] ;
+  int periodcurs ;
+  int xposelist[RSL_MAXDESCRIPTORS] ;
+  int xposecurs ;
+
+  message_desc_t *old_state_vect, *new_state_vect ;
+
+  /* coordinates of the domain in its parent (sort of) */
+  rsl_index_t     coord_m ;
+  rsl_index_t     coord_n ;
+
+  /* nesting ratio in parent domain */
+  int irax_m ;
+  int irax_n ;
+
+  /* trimming constants -- these are used to tell rsl how much shorter
+     in a dimension the effective range of a nest is than the declared
+     range -- it might be declared longer because it has to be a 
+     multiple of irax_[mn] */
+  int trim_m ;
+  int trim_n ;
+
+  rsl_index_t  nest_level ;     /* 0 is mother domain */
+  rsl_list_t   *pts ;	 	/* list of points on this processor */
+  rsl_list_t   *ghost_pts ;	/* list of points communicating with us */
+  rsl_list_t   *iruns ;		/* list of runs in idimension 1/9/95 */
+  rsl_index_t  ilocaloffset ;	/* ns offset global to local in domain ds */
+  rsl_index_t  jlocaloffset ;   /* ew offset global to local in domain ds */
+
+  rsl_index_t  ilocaloffset_mz ;
+  rsl_index_t  jlocaloffset_mz ;
+  rsl_index_t  klocaloffset_mz ;
+
+  rsl_index_t  ilocaloffset_nz ;
+  rsl_index_t  jlocaloffset_nz ;
+  rsl_index_t  klocaloffset_nz ;
+
+  rsl_index_t  old_ilocaloffset ;
+  rsl_index_t  old_jlocaloffset ;
+  int          maskid  ;	/* maximum stencil specified for this domain */
+
+/* added for RSL_COMPUTE -- in comp_world.c */
+/* these are worked out in rsl_new_decomp.c */
+  int    idif, jdif ;
+  /* these are for iterating with j-major */
+  int    nrun[MAX_KINDPAD+1];
+  int    *(js[MAX_KINDPAD+1]) ;
+  int    *(is[MAX_KINDPAD+1]), *(ie[MAX_KINDPAD+1]), *(jg2n[MAX_KINDPAD+1]) ;
+  /* these are for iterating with i-major */
+  int    nruni[MAX_KINDPAD+1];
+  int    *(is2[MAX_KINDPAD+1]) ;
+  int    *(js2[MAX_KINDPAD+1]), *(je2[MAX_KINDPAD+1]), *(ig2n[MAX_KINDPAD+1]) ;
+
+  rsl_processor_t bcast_recv_Pnpts[RSL_MAXPROC] ;
+  rsl_processor_t bcast_recv_Plist[RSL_MAXPROC] ;
+  rsl_processor_t bcast_recv_Ptags[RSL_MAXPROC] ;
+  int Nbcast_recv_Plist ;
+  rsl_processor_t bcast_send_Pnpts[RSL_MAXPROC] ;
+  rsl_processor_t bcast_send_Plist[RSL_MAXPROC] ;
+  int Nbcast_send_Plist ;
+
+  rsl_list_t *bcast_Xlist ;
+
+
+  rsl_processor_t merge_recv_Pnpts[RSL_MAXPROC] ;
+  rsl_processor_t merge_recv_Plist[RSL_MAXPROC] ;
+  rsl_processor_t merge_recv_Ptags[RSL_MAXPROC] ;
+  int Nmerge_recv_Plist ;
+  rsl_processor_t merge_send_Pnpts[RSL_MAXPROC] ;
+  rsl_processor_t merge_send_Plist[RSL_MAXPROC] ;
+  int Nmerge_send_Plist ;
+
+  rsl_list_t *merge_Xlist ;
+
+
+  int other_hemi_proclist_built ;
+  rsl_hemi_rec_t * other_hemi_procbufs[RSL_MAXPROC] ;
+  int hemi_sendPlist[RSL_MAXPROC] ;
+  int hemi_recvPlist[RSL_MAXPROC] ;
+  int hemi_recv_tags[RSL_MAXPROC] ;
+
+  int is_write, is_read, ie_write, ie_read ;
+  int js_write, js_read, je_write, je_read ;
+
+} rsl_domain_info_t ;
+
+
+/* March 1998 -- structure for new packing strategy */
+#ifdef crayx1
+struct packrec_struct {
+    void * base ;
+    int offset ;
+    int n ;             /* number of bytes in an element */
+    int nelems ;        /* number of elements */
+    int stride ;        /* number of bytes between each element */
+    int f90_table_index ;
+    int endstop ;
+    int valid ;
+    int curs ;          /* position of data in pack buf */
+} ;
+typedef struct packrec_struct packrec_t ;
+
+#else
+struct packrec_struct {
+  void * base ;
+  int offset ;
+  int n ;		/* number of bytes in an element */
+  int nelems ;		/* number of elements */
+  int stride ;		/* number of bytes between each element */
+  int f90_table_index ;
+  int endstop ;
+  int valid ;
+} ;
+typedef struct packrec_struct packrec_t ;
+#endif
+
+typedef struct rsl_procrec {
+  struct rsl_procrec * next ;
+  rsl_processor_t P ;
+  int sendsize ;	/* size of send buf needed for this processor */
+  int recvsize ;	/* size of recv buf needed for this processor */
+  int npts ;
+  int recv_npts ;
+  int nsends ;		/* diagnostic -- keeps running total number of sends */
+  int nrecvs ;		/* diagnostic -- keeps running total number of sends */
+  rsl_list_t *point_list ;
+/* Mar 1998 */
+  rsl_list_t *recv_point_list ;
+  packrec_t * pack_table ;
+  int pack_table_size ;
+  int pack_table_nbytes ;
+  packrec_t * unpack_table ;
+  int unpack_table_size ;
+  int unpack_table_nbytes ;
+} rsl_procrec_t ;
+
+typedef struct rsl_ptrec {
+  struct rsl_ptrec * next ;
+  rsl_point_t *pt ;
+  rsl_index_t ig, jg ;
+  rsl_list_t  *send_messages ;
+  rsl_list_t  *recv_messages ;
+#ifdef crayx1
+  int nsendmsgs ;
+  int nrecvmsgs ;
+#else
+  short nsendmsgs ;
+  short nrecvmsgs ;
+#endif
+} rsl_ptrec_t ;
+
+typedef struct rsl_point_hdr {
+  rsl_index_t d, ig, jg, dummy ;   /* dummy maintains alignment */
+  int nmsgs ;
+} rsl_point_hdr_t ;
+
+typedef struct rsl_message_hdr {  /* packet hdr for message */
+  int sp ;
+} rsl_message_hdr_t ;
+
+typedef struct rsl_fld_hdr {	/* packet hdr for fld */
+  void * base ;                 /* base address; byte pointer arithmetic */
+#ifdef crayx1
+  int len ;                     /* number of bytes to follow */
+#else
+  short len ;                   /* number of bytes to follow */
+#endif
+} rsl_fld_hdr_t ;
+
+/* global data */
+
+#ifdef DEFINE_GLOBAL
+#   define EXTERN
+#else
+#   define EXTERN extern
+#endif
+
+EXTERN rsl_domain_info_t  domain_info[RSL_MAXDOMAINS] ;
+/* message descriptors */
+EXTERN void * mh_descriptors[RSL_MAXDESCRIPTORS] ;
+/* stencil descriptors */
+EXTERN void * sh_descriptors[RSL_MAXDESCRIPTORS] ;
+/* xpose descriptors */
+EXTERN void * xp_descriptors[RSL_MAXDESCRIPTORS] ;
+/* period descriptors */
+EXTERN void * pr_descriptors[RSL_MAXDESCRIPTORS] ;
+EXTERN int rsl_ndomains  ; /* number of active domains */
+EXTERN int rsl_nproc     ; /* number of compute processors */
+EXTERN int rsl_nproc_all ; /* total # of processors (compute and monitor) */
+EXTERN int rsl_nproc_n ; /* number of processors decomposing maj dimension */
+EXTERN int rsl_nproc_m ; /* number of processors decomposing min dimension */
+EXTERN int rsl_myproc ;	/* my physical processor id */
+EXTERN int rsl_idum ;	/* dummy integer variable */
+EXTERN int rsl_padarea ;   /* pad area */
+EXTERN int io_seq_compute ;
+EXTERN int io_seq_monitor ;
+EXTERN char mess[1024] ;      /* misc. message buffer for errors and warns */
+EXTERN char * rsl_noprobe ;  /* set from environment */
+
+EXTERN int rsl_debug_flg ;	/* set by rsl_debug */
+EXTERN int old_offsets ;	/* used in rsl_new_decomp.c */
+
+EXTERN int regular_decomp ;
+EXTERN int sw_allow_dynpad ;
+
+/* rsl macros */
+
+#define RSL_FATAL(N)     rsl_fatal(N)
+#define RSL_TEST_ERR(T,M) {if(T){fprintf(stderr,"%d rsl error (\"%s\":%d) %s\n",rsl_myproc,__FILE__,__LINE__,M);RSL_FATAL(5);}}
+#define RSL_TEST_WRN(T,M) {if(T){fprintf(stderr,"%d rsl warning (\"%s\":%d) %s\n",rsl_myproc,__FILE__,__LINE__,M);}}
+
+#if 1
+#ifndef NEC_TUNE
+#define RSL_MALLOC(T,N)  (T *)rsl_malloc(__FILE__,__LINE__,(sizeof(T))*(N))
+#define RSL_FREE(P)      rsl_free(P)
+#else
+#define RSL_MALLOC(T,N)  (T *)calloc(N, sizeof(T))
+#define RSL_FREE(P)      free(P)
+#endif
+#else
+/* Bob Olson's stuff */
+#define RSL_MALLOC(T,N)  (T *)nexus_debug_malloc((sizeof(T))*(N),__FILE__,__LINE__)
+#define RSL_FREE(P)      nexus_debug_free(P,__FILE__,__LINE__)
+#endif
+
+#define MONITOR_ONLY(S)  { int x ; \
+    RSL_C_IAMMONITOR( &x ) ; \
+    if ( x==0 )                 \
+      sprintf(mess,"%s: callable only by monitor",S) ; \
+      RSL_TEST_ERR( x == 0,mess) ; }
+
+/*
+   This uses the low 26 bits of a 32 bit message type to encode a message
+   type, a FROM processor designation and a TO processor designation.  Note
+   the limits of this encoding:
+
+        o  10 bits available for processor id (limit is 1024 processors)
+        o   6 bits available for message tag - 1, because we are not
+            allowing 0.  (limit is thus 63 possible tags)
+
+   This is a potential machine or message passing interface dependency.
+   Note, though, that under the proposed MPI standard, this would not
+   be a problem because there are no FORCED type ranges to avoid and
+   all .
+
+rev: 95/02/15 -- jm.  Modified to drop the TO field (never used) and
+   shorten the TAG field by 1 bit so that the total number of bits
+   required is 15 (compatibility with minimum MPI standard and, in
+   particular for the Fujitsu AP1000 at ANU).  Note the new limits
+   from this encoding:
+
+        o  10 bits available for processor id (limit is 1024 processors)
+           (FROM only is encoded now)
+        o   5 bits available for message tag - 1, because we are not
+            allowing 0.  (limit is now 31 possible tags).
+*/
+
+#if 0
+# define MTYPE_FROMTO(Y,F,T) ((((Y)&0x3f)<<20)|(((F)&0x3ff)<<10)|(((T)&0x3ff)))
+# define MTYPE_TAG(X)   (((X)>>20)&0x3f)
+# define MTYPE_FROM(X)  (((X)>>10)&0x3ff)
+# define MTYPE_TO(X)    ((X)&0x3ff)
+#else
+# if 1
+/* T is ignored and not encoded in the message tag, Y has been shorted 1 bit */
+# define MTYPE_FROMTO(Y,F,T) (((((Y)&0x1f)<<10)|(((F)&0x3ff))) | 0 )
+# define MTYPE_TAG(X)   (((X)>>10)&0x1f)
+# define MTYPE_FROM(X)  ((X)&0x3ff)
+# else
+/* update May 2002, increase upper bound on processors to 4096 (12 bits)*/
+# define MTYPE_FROMTO(Y,F,T) (((((Y)&0x1f)<<12)|(((F)&0xfff))) | 0 )
+# define MTYPE_TAG(X)   (((X)>>12)&0x1f)
+# define MTYPE_FROM(X)  ((X)&0xfff)
+# endif
+#endif
+
+
+#define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) )
+#define INDEX_3(A,B,NB,C,NC)  INDEX_2( (A), INDEX_2( (B), (C), (NC) ), (NB)*(NC) )
+
+#if 0
+/* new encoding for these -- 
+    7 bits -- domain id		maximum number is 127
+   12 bits -- ig index		maximum number is 4095
+   12 bits -- jg index		maximum number is 4095
+  ----
+   31 bits
+*/
+#define POINTID(D,J,I)   ((((((D)&0x7f))<<24)|(((J)&0xfff)<<12)|((I)&0xfff))|0L)
+#define ID_DOMAIN(M)     ((((M)>>24)&0x7f)|0L)
+#define ID_JDEX(M)       ((((M)>>12)&0xfff)|0L)
+#define ID_IDEX(M)       (((M)      &0xfff)|0L)
+#else
+/* make ig and jg work as signed quantities */
+/* new encoding for these -- 
+    7 bits -- domain id		maximum number is 127
+   12 bits -- ig index		range is -2048 to 2047
+   12 bits -- jg index		range is is -2048 to 2047
+  ----
+   31 bits
+*/
+#define POINTID(D,J,I)   ((((((D)&0x7f))<<24)|(((J)&0xfff)<<12)|((I)&0xfff))|0L)
+#define ID_DOMAIN(M)     ((((M)>>24)&0x7f)|0L)
+#define ID_JDEX(M)       (((((M)>>12)&0xfff)&0x800)?((((M)>>12)&0xfff)|(-4096L)):((((M)>>12)&0xfff)|0L))
+#define ID_IDEX(M)       (((M)&0x800)?(((M)      &0xfff)|(-4096L)):(((M)      &0xfff)|0L))
+#endif
+
+#define IS_INVALID(M) ( (M) == RSL_INVALID )
+
+/* forward declarations */
+
+rsl_point_id_t pointid() ;
+rsl_index_t id_domain(), id_jdex(), id_idex() ;
+
+/* RSL PT DESCRIPTORS */
+
+#define RSL_4PT     4		/* FORTRAN */
+#define RSL_8PT     8		/* FORTRAN */
+#define RSL_12PT   12		/* FORTRAN */
+#define RSL_24PT   24		/* FORTRAN */
+#define RSL_48PT   48		/* FORTRAN */
+#define RSL_80PT   80		/* FORTRAN */
+#define RSL_120PT  120		/* FORTRAN */
+#if (ALLOW_RSL_168PT == 1)
+/* new -- added for MM5's upper radiative boundary stencil 9/26/96 */
+#define RSL_168PT  168          /* FORTRAN */
+#endif
+
+#define RSL_NORTHSOUTH       1	/* FORTRAN */
+#define RSL_EASTWEST         2	/* FORTRAN */
+#define RSL_NORTHSOUTH_STAG  11	/* FORTRAN */
+#define RSL_EASTWEST_STAG    12	/* FORTRAN */
+#define RSL_NOTDECOMPOSED    3	/* FORTRAN */
+
+#define RSL_M                1	/* FORTRAN */
+#define RSL_N                2	/* FORTRAN */
+#define RSL_M_STAG          11	/* FORTRAN */
+#define RSL_N_STAG          12	/* FORTRAN */
+
+/* message tags */
+
+#define MSG_NEWDECOMPOSITION 100
+#define MSG_MONITOR_REQUEST  101
+#define MSG_STENCOM          		1
+#define MSG_READ_RESPONSE    		2
+#define MSG_WRITE_RESPONSE    		3
+#define MSG_WRITE_COMPUTE_RESPONSE    	4
+#define MSG_SPECIAL1_RESPONSE           5
+#define MSG_SPECIAL2_RESPONSE           6
+#define MSG_FROM_PARENT      		7
+#define MSG_BCAST_SETUP      		8
+#define MSG_MERGE_SETUP      		9
+#define MSG_TO_PARENT        	       10
+#define MSG_MON_BCAST		       11
+#define MSG_REDISTCOM    	       12
+#define MSG_PERCOM                     13
+#define MSG_XPOSECOM                     14
+
+#define MSG_IO_FORTRAN                  1
+#define MSG_IO_SOCKET                   2
+
+/* values for request mode2 when writing to sockets
+   Raw mode just writes a byte stream,
+
+   Fortran mode puts control words at beginning and end of each write
+   with byte count in control word. 
+
+   Portal mode puts a portal style dimension descriptor at the
+   head of each new write.
+*/
+
+#define MSG_MODE2_RAW                         1
+#define MSG_MODE2_FORTRAN                     2
+#define MSG_MODE2_PORTAL                      3
+#define MSG_MODE2_88                          4
+
+/* monitor request types */
+#define RSL_READ_REQUEST      100
+#define RSL_READ_RESPONSE     101
+#define RSL_READ_SPECIAL1     102
+#define RSL_READ_SPECIAL2     103
+#define RSL_READ_SPECIAL3     104
+#define RSL_SHUTDOWN_REQUEST  105
+#define RSL_WRITE_REQUEST     106
+#define RSL_WRITE_RESPONSE    107
+
+/* descriptor tags */
+
+#define MESSAGE_DESC 0
+#define STENCIL_DESC 1
+#define BLANK_MESSAGE_DESC 2
+#define PERIOD_DESC 3
+#define XPOSE_DESC 4
+
+/* xpose switches */
+#define XPOSE_MN_MZ 0
+#define XPOSE_MZ_MN 0
+
+#define XPOSE_MZ_NZ 1
+#define XPOSE_NZ_MZ 1
+
+#define XPOSE_MN_NZ 2
+#define XPOSE_NZ_MN 2
+
+/* defines for MPI2 compat */
+
+#ifndef MPI2_SUPPORT
+typedef int MPI_Fint;
+#  define MPI_Comm_c2f(comm) (MPI_Fint)(comm)
+#  define MPI_Comm_f2c(comm) (MPI_Comm)(comm)
+#endif
+
+/* other includes */
+
+#include "rsl_comm.h"
+#include "compat.h"
+#include "buf_for_proc.h"
+#include "stencil_def.h"	/* stencil_def.h must follow message_def.h */
+#include "xpose_def.h"	/* xpose_def.h must follow message_def.h */
+#include "period_def.h"	/* period_def.h must follow message_def.h */
+#include "rsl_io.h"
+
+#if (( defined(vpp) || defined(vpp2) ) && ! defined(sx))
+#define bcopy(a,b,c) vbcopy_C(a,b,c)
+#endif
+
+void * rsl_malloc(), * malloc()  ;
+void * get_base_for_index() ;
+
+#ifdef NEC_TUNE
+extern void copymem( void *, int, void *, int, int, int ) ;
+#endif
+
+
+#endif   /* nothing after this line */
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl.inc_base
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl.inc_base	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl.inc_base	(revision 2744)
@@ -0,0 +1,20 @@
+      integer rsl_phys2comp, rsl_comp2phys
+      logical rsl_iamcompute, rsl_iammonitor, rsl_nextcell
+      external rsl_iamcompute, rsl_iammonitor, rsl_nextcell
+      external rsl_phys2comp, rsl_comp2phys
+
+      integer rsl_nproc_all
+      integer rsl_nproc
+      integer rsl_myproc
+      integer rsl_nproc_min
+      integer rsl_nproc_maj
+      integer rsl_ndomains
+      integer rsl_padarea
+      common /rslsysXx/ rsl_nproc_all
+      common /rslsysXx/ rsl_nproc
+      common /rslsysXx/ rsl_myproc
+      common /rslsysXx/ rsl_nproc_min
+      common /rslsysXx/ rsl_nproc_maj
+      common /rslsysXx/ rsl_ndomains
+      common /rslsysXx/ rsl_padarea
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_bcast.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_bcast.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_bcast.c	(revision 2744)
@@ -0,0 +1,1501 @@
+/* #define LEARN_BCAST */
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#define MOD_9707
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+typedef struct stage_point {
+  char * p ;            /* pointer to buffer for point */
+  int curs ;            /* cursor into point buffer */
+#if (defined(vpp) || defined(vpp2))
+  int blankcurs ;       /* curser into blank stage array */
+#endif
+  int P ;               /* processor ID for point */
+  int kid_id ;
+  int parent_id ;
+  int cm ;
+  int cn ;
+  struct stage_point *next ;    /* list pointer */
+} stage_point_t ;
+
+typedef struct par_info {
+  rsl_index_t ig, jg, cn, cm ;
+  int kidid ;
+} par_info_t ;
+
+static destroy_par_info ( p )
+  char * p ;
+{
+  if ( p != NULL ) RSL_FREE( p ) ;
+}
+
+static rsl_list_t *Xlist, *Xp, *Xprev ;
+static stage_point_t *stage ;
+static int stage_len = 0 ;              /* 96/3/15 */
+
+static int s_d ;
+static int s_nst ;
+static int s_msize ;
+static int s_nlen ;
+static int s_mlen ;
+static int s_nlen_nst ;
+static int s_mlen_nst ;
+static int s_irax_n ;
+static int s_irax_m ;
+static stage_point_t *Plist[RSL_MAXPROC] ;
+static int Psize[RSL_MAXPROC] ;
+static rsl_domain_info_t *s_dinfo, *s_ninfo ;
+static rsl_point_t *s_ddomain, *s_ndomain ;
+static char *s_parent_msgs ;
+static int s_parent_msgs_curs ;
+static int s_remaining ;  /* number of bytes left in a parent message before
+                           the next point descriptor */
+
+/* add a field to a message outgoing for the specified child domain cell */
+/* relies on rsl_ready_bcast having been called already */
+/* sends are specified in terms of coarse domain */
+
+static int s_i, s_j, s_ig, s_jg, s_cm, s_cn,
+           s_nig, s_njg ;
+
+#ifdef LEARN_BCAST
+static int s_putmsg = 0 ;
+#endif
+
+#if (defined(vpp) || defined(vpp2))
+static char *blankstage = NULL ;
+static int blankstagesize = 0 ;
+static int blankstagecurs = 0 ;
+#endif
+
+/*@
+  RSL_TO_CHILD_INFO -- Get the next cell in a packing sequence for forcing.
+
+  Notes:
+  RSL_TO_CHILD_INFO is used in a packing loop to build messages for
+  forcing a nested (Arg2) domain with data from a parent (Arg1), in
+  preparation for a call to RSL_BCAST_MSGS.  For an overview of the
+  mechanism and a detailed example, see RSL_BCAST_MSGS.
+
+  The Arg3 argument gives the size of the parent to child cell messages
+  in bytes.  This may be larger than needed, but never smaller;
+  otherwise the program will abort (to avoid overwriting memory).
+
+  Each call to RSL_TO_CHILD_INFO gives the coordinates of a nested
+  point to be sent forcing data (Arg10, Arg11), the local indices
+  (Arg4, Arg5) and global indices (Arg6, Arg7) of the associated parent
+  cell, and the indices of the child cell in the set of nest cells
+  associated with the parent (Arg8, Arg9).  These
+  specify which of the nest cells associated with the parent
+  is being referred to.  There are IRAX_M by IRAX_N nest points
+  associated with each parent, where IRAX_M is the nesting ratio in the
+  M dimension and IRAX_N is the nesting ratio in the N dimension (See
+  the descriptions for the RSL nest spawning routines RSL_SPAWN...).
+
+  RSL_TO_CHILD_INFO will return a new set of coordinates for every nest
+  point associated with a locally stored parent domain point.  In other
+  words, if the processor has 15 points from the parent domain in its
+  local memory and the nesting ratios are 3 by 3, then 135 (15*9)
+  successive calls to RSL_TO_CHILD_INFO will return valid coordinates.
+  Each time the routine returns with a valid point, the value of Arg12
+  will be 1 and RSL will be in a state that is ready to accept data for
+  the point.  The message is constructed using the routine
+  RSL_TO_CHILD_MSG.  The 136th call will return a value of 0 (zero) in
+  Arg12, indicating there are no more points.
+
+  It isn't necessary that anything be done with the coordinates that
+  are returned.  However, once called, RSL_TO_CHILD_INFO must be called
+  as many times as it takes to exhaust the number of points; otherwise
+  the underlying RSL mechanism will not be left in the proper state at
+  the conclusion of the broadcast.
+
+  See also:
+  RSL_BCAST_MSGS, RSL_TO_CHILD_MSG, RSL_FROM_PARENT_INFO
+@*/
+
+RSL_TO_CHILD_INFO ( d_p, n_p, msize_p,
+                    i_p, j_p,
+                    ig_p, jg_p, cm_p, cn_p,
+                    nig_p, njg_p, retval_p )
+  int_p
+     d_p            /* (I) RSL domain descriptor of parent. */
+    ,n_p            /* (I) RSL domain descriptor of nest. */
+    ,msize_p        /* (I) Message size in bytes. */
+    ,i_p            /* (O) Local M index of parent domain point. */
+    ,j_p            /* (O) Local N index of parent domain point. */
+    ,ig_p           /* (O) Global N index of parent domain point. */
+    ,jg_p           /* (O) Global N index of parent domain point. */
+    ,cm_p           /* (O) M index of child cell beneath parent cell (see discussion). */
+    ,cn_p           /* (O) N index of child cell beneath parent cell (see discussion). */
+    ,nig_p          /* (O) Global M index of nest domain point. */
+    ,njg_p          /* (O) Global N index of nest domain point. */
+    ,retval_p ;     /* (O) =1 if a valid point returned; =0 (zero) otherwise. */
+{
+  rsl_child_info_t *kid ;
+  rsl_list_t *lp ;
+#ifdef LEARN_BCAST
+  int removed ;
+#endif
+  par_info_t *dp ;
+  int P ;
+
+  if ( stage == NULL )
+  {
+    rsl_ready_bcast( d_p, n_p, msize_p ) ;
+  }
+
+  if (( lp = Xlist) == NULL ) 
+  {
+    *retval_p = -1 ;
+    Xlist = s_ninfo->bcast_Xlist ;
+#ifdef LEARN_BCAST
+    Xprev = NULL ;
+    Xp = NULL ;
+    s_putmsg = 0 ;
+#endif
+    return ;
+  }
+
+#ifdef LEARN_BCAST
+  removed = 0 ;
+  if ( s_putmsg == 0 )
+  {
+     /* the node  previous to the one pointed to by Xlist did not
+        add any messages.  Let's get rid of it. */
+     if ( Xprev != NULL  ) { Xprev->next = Xlist ; Xp = Xlist ; removed = 1 ; }
+  }
+  if ( Xlist != s_ninfo->bcast_Xlist && ! removed ) Xprev = Xp ;
+  Xp = Xlist ;
+#endif
+
+  Xlist = Xlist->next ;
+  dp = (par_info_t *)(lp->data) ;
+  s_ig = dp->ig ;
+  s_jg = dp->jg ;
+  s_i = s_ig + s_dinfo->idif ;
+  s_j = s_jg + s_dinfo->jdif ;
+  s_cm = dp->cm ;
+  s_cn = dp->cn ;
+  s_nig = ID_IDEX( dp->kidid ) ;
+  s_njg = ID_JDEX( dp->kidid ) ;
+
+  *ig_p = s_ig + 1 ;
+  *jg_p = s_jg + 1;
+  *i_p = s_i + 1 ;
+  *j_p = s_j + 1;
+  *cm_p = s_cm + 1;
+  *cn_p = s_cn + 1;
+  *nig_p = s_nig + 1;
+  *njg_p = s_njg + 1;
+
+#ifdef LEARN_BCAST
+  s_putmsg = 0 ;
+#endif
+
+  *retval_p = 1 ;
+  return ;
+}
+
+/*@
+  RSL_TO_CHILD_MSG -- Pack force data into a message for a nest point.
+
+  Notes:
+  RSL_TO_CHILD_MSG is used in a loop to pack messages for forcing
+  a nested domain with data from a parent in preparation for
+  a call to RSL_BCAST_MSGS.  For an overview of the mechanism and a detailed
+  example, see RSL_BCAST_MSGS.
+
+  Before calling RSL_TO_CHILD_MSG, RSL must have been put into the correct
+  state; that is, ready to accept data that will be sent to a particular
+  point in the nest.  This is done by first calling RSL_TO_CHILD_INFO.
+  RSL_TO_CHILD_MSG may be called as many times as necessary to pack
+  data into the message (or not at all, if there is no data for the point
+  returned by RSL_TO_CHILD_INFO).  Each call to RSL_TO_CHILD_MSG copies
+  Arg1 bytes from the bufffer specified by Arg2 into the message, which
+  is allocated by RSL and never manipulated directly by
+  the user program.  The amount of data that can be packed is limited
+  to the message size that
+  was specified in the first call to RSL_TO_CHILD_INFO.
+
+  See also:
+  RSL_BCAST_MSGS, RSL_TO_CHILD_INFO
+
+@*/
+
+RSL_TO_CHILD_MSG ( nbuf_p, buf )
+  int_p
+    nbuf_p ;     /* (I) Number of bytes to be packed. */
+#ifndef NEC_TYPE4B
+  char *
+    buf ;        /* (I) Buffer containing the data to be packed. */
+#else
+  float *
+    buf ;        /* (I) Buffer containing the data to be packed. */
+#endif
+{
+  int kiddex ;
+  int nbuf ;
+  int P ;
+#ifdef NEC_TYPE4B
+  float * dist ;
+  int i ;
+#endif
+
+  RSL_TEST_ERR(buf==NULL,"2nd argument is NULL.  Field allocated?") ;
+
+  nbuf = *nbuf_p ;
+
+#if (defined(vpp)||defined(vpp2))
+#define BLANKBUMP (4*1024)
+#endif
+
+#ifdef LEARN_BCAST
+  s_putmsg = 1 ;
+#endif
+
+  kiddex = INDEX_2(s_njg,s_nig,s_mlen_nst) ;
+  P = s_ndomain[ kiddex ].P ;
+#if ! (defined(vpp)||defined(vpp2))
+  if ( stage[ kiddex ].p == NULL )
+  {
+    stage[ kiddex ].p = RSL_MALLOC( char, s_msize ) ;
+    stage[ kiddex ].curs = 0 ;
+    stage[ kiddex ].P = P ;
+    stage[ kiddex ].next = Plist[P] ;
+    Plist[P] =  &(stage[ kiddex ]) ;
+  }
+#else
+  if ( stage[ kiddex ].p == NULL )
+  {
+    if (  blankstagecurs + s_msize >= blankstagesize )
+    {
+       char * newblank ;
+       int i ;
+       newblank = RSL_MALLOC( char, blankstagesize + BLANKBUMP*s_msize ) ;
+       bcopy(blankstage,newblank,blankstagesize) ;
+       /* reset the stage p pointers into the new blank stage buffer */
+       for ( i = 0 ; i < s_mlen_nst * s_nlen_nst ; i++)
+       {
+         if ( stage[i].p != NULL )
+         {
+           stage[i].p = &(newblank[stage[i].blankcurs]) ;
+         }
+       }
+       blankstagesize += BLANKBUMP*s_msize ;
+       if ( blankstage != NULL ) RSL_FREE( blankstage ) ;
+       blankstage = newblank ;
+    }
+    stage[ kiddex ].p = (char *) &( blankstage[blankstagecurs] ) ;
+    stage[ kiddex ].blankcurs = blankstagecurs ;
+    blankstagecurs += s_msize ;
+    stage[ kiddex ].curs = 0 ;
+    stage[ kiddex ].P = P ;
+    stage[ kiddex ].next = Plist[P] ;
+    Plist[P] =  &(stage[ kiddex ]) ;
+  }
+#endif
+  if ( stage[ kiddex ].curs + nbuf > s_msize )
+  {
+    sprintf(mess,
+    "RSL_TO_CHILD_MSG: would overflow buffer (%d+%d>%d)\n",
+        stage[ kiddex ].curs, nbuf, s_msize ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+
+  /* add point to head of list of points for processor P */
+  stage[kiddex].kid_id = POINTID(s_nst,s_njg,s_nig) ;
+  stage[kiddex].parent_id = POINTID( s_d, s_jg, s_ig ) ;
+  stage[kiddex].cm = s_cm ;
+  stage[kiddex].cn = s_cn ;
+  Psize[P] += s_msize + sizeof( bcast_point_desc_t ) ;
+
+  /* pack the buffer associated with stage[kiddex] */
+#ifndef NEC_TYPE4B
+  bcopy( buf, &(stage[ kiddex ].p[ stage[ kiddex ].curs ]), nbuf ) ;
+#else
+  dist = (float *) &(stage[ kiddex ].p[ stage[ kiddex ].curs ]) ;
+#pragma cdir nodep
+  for ( i = 0 ; i < nbuf / 4 ; i++ )
+  {
+    *(dist++) = *(buf++) ;
+  }
+#endif
+  stage[ kiddex ].curs += nbuf ;
+
+}
+
+/*@
+  RSL_BCAST_MSGS -- Convey forcing data from parent to nest points.
+
+  Notes:
+  RSL_BCAST_MSGS is called once forcing data
+  from points in a parent domain have been packed into messages
+  destined for associated points on the nest.  The routine has
+  no arguments; rather, RSL must be in a ready state; this occurs
+  once RSL_TO_CHILD_INFO has returned a value of 0 (zero)
+  in its last argument on all processors.  The forcing data is
+  conveyed along logical communication channels that were set up
+  between nest points and associated points in the parent domain
+  when the nest was spawned.  Interprocessor communication
+  is generated for messages between points on different processors;
+  otherwise, the transfer
+  is done within the processor's local memory.
+
+  The inverse operation to RSL_BCAST_MSGS is RSL_MERGE_MSGS, which
+  is used for conveying feedback data from nest to parent.
+
+  Note while reading the following example that RSL decomposes all
+  domains independently and over all processors, so that every
+  processor will have cells from the parent and from the nest.
+  Thus, all processors perform both the packing of data from
+  the parent and the unpacking of data onto the nest.  Other
+  RSL routines appearing in the example are described elsewhere
+  in these documents.
+
+  Example:
+
+$ C
+$ C Packing data from the parent.
+$ C
+$   NLEV = (the number of vertical levels)
+$   MSIZE = 3 * NLEV + 1 * WORDSIZE
+$ C
+$ C First call to rsl_to_child_info
+$ C
+$   CALL RSL_TO_CHILD_INFO( PID, NID,      ! parent, nest domain descriptors
+$                           MSIZE,         ! size of message to a point
+$                           I,J,PIG,PJG,   ! local and global parent cell coords
+$                           CM,CN,         ! index of nest cell in parent cell
+$                           NIG,NJG,       ! global nest cell coords
+$                           IRETVAL )      ! return value
+$   DO WHILE ( IRETVAL .EQ. 1 )
+$     IF ( NIG .EQ. 1 .OR. NIG .EQ. M .OR. ! force only cells on nest bdy
+$          NJG .EQ. 1 .OR. NJG .EQ. N     ) THEN
+$       DO K = 1, NLEV
+$         CALL RSL_TO_CHILD_MSG( WORDSIZE, FINTERP( CN, CM, U, I, J ) )
+$         CALL RSL_TO_CHILD_MSG( WORDSIZE, FINTERP( CN, CM, V, I, J ) )
+$         CALL RSL_TO_CHILD_MSG( WORDSIZE, FINTERP( CN, CM, T, I, J ) )
+$       ENDDO
+$       CALL RSL_TO_CHILD_MSG( WORDSIZE, FINTERP( CN, CM, PS, I, J ) )
+$     ENDIF
+$ C
+$ C Subsequent calls to rsl_to_child_info
+$ C
+$     CALL RSL_TO_CHILD_INFO( PID, NID, MSIZE, I,J,PIG,PJG, CM,CN,
+$                             NIG,NJG, IRETVAL )
+$   END DO
+$ C
+$ C Broadcast the data.
+$ C
+$   CALL RSL_BCAST_MSGS
+$ C
+$ C Unpack the data onto the nest.
+$ C
+$ C
+$ C First call to rsl_from_parent_info
+$ C
+$   CALL RSL_FROM_PARENT_INFO( I, J,       ! local nest cell coords
+$                              NIG, NJG,   ! global nest cell coords
+$                              CM, CN,     ! index of nest cell in parent cell
+$                              PIG, PJG,   ! global parent cell coords
+$                              IRETVAL )   ! return value
+$   DO WHILE ( IRETVAL .EQ. 1 )
+$     IF ( NIG .EQ. 1 .OR. NIG .EQ. M .OR.      ! force only cells on nest bdy
+$          NJG .EQ. 1 .OR. NJG .EQ. N     ) THEN
+$       DO K = 1, NLEV
+$         CALL RSL_FROM_PARENT_MSG( WORDSIZE, U(I,J,K) )
+$         CALL RSL_FROM_PARENT_MSG( WORDSIZE, V(I,J,K) )
+$         CALL RSL_FROM_PARENT_MSG( WORDSIZE, T(I,J,K) )
+$       ENDDO
+$       CALL RSL_FROM_PARENT_MSG( WORDSIZE, PS(I,J) )
+$     END IF
+$ C
+$ C Subsequent calls to rsl_from_parent_info
+$ C
+$     CALL RSL_FROM_PARENT_INFO( I, J, NIG, NJG, CM, CN, PIG, PJG, IRETVAL )
+$   END DO
+
+BREAKTHEEXAMPLECODE
+
+  In this example, three 3-dimensional fields, U, V, and T, and one
+  2-dimensional field, PS, from the parent domain are interpolated and
+  sent as forcing data to the boundary of the nest.  Finterp is an
+  interpolation function that computes the value for the nest based
+  on the coordinates in the parent and on which nest cell the value
+  is going to.  WORDSIZE, PIG, and PJG are integers; otherwise implicit typing
+  holds.
+
+                          
+  See also:
+  RSL_TO_CHILD_INFO, RSL_FROM_PARENT_INFO, RSL_MERGE_MSGS
+
+@*/
+
+
+RSL_BCAST_MSGS ()
+{
+  int P ;
+  char *work ;
+  bcast_point_desc_t pdesc ;
+  stage_point_t *pt ;
+  int curs ;
+  int msglen, mdest, mtag ;
+  int ii ;
+  int ig, jg ;
+#ifdef NEC_TYPE4B
+  float * from ;
+  float * to ;
+  int i ;
+#endif
+
+  RSL_TEST_ERR( stage == NULL,
+    "RSL_BCAST_MSGS: rsl_to_child_info not called first" ) ;
+
+#if 0
+ fprintf(stderr,"RSL_BCAST DEBUG s_msize %d\n",s_msize) ;
+#endif
+
+  for ( ii = 0 ; ii < s_ninfo->Nbcast_send_Plist ; ii++ )
+  {
+    P = s_ninfo->bcast_send_Plist[ii] ;
+    msglen = s_ninfo->bcast_send_Pnpts[ii]*( sizeof(pdesc) + s_msize ) 
+             + sizeof(pdesc) ; /*  end of message marker */
+    curs = 0 ;
+    work = buffer_for_proc( P, msglen, RSL_SENDBUF ) ;
+    /* NOTE ASSUMPTION that the number of points in Plist will
+       be less or equal to ninfo->bcast_send_Pnpts[ii].  If it isn't,
+       we've got trouble.  */
+#if 0
+    /* debugging -- check the length of the list and compare
+       it with the number of points we *think* we have. */
+    { int npts_have, npts_thinkhave ;
+      npts_thinkhave = s_ninfo->bcast_send_Pnpts[ii] ;
+      for ( pt = Plist[P], npts_have = 0 ; pt != NULL ; pt = pt->next )
+      {
+        npts_have++ ;
+      }
+      if ( npts_thinkhave < npts_have )
+      {
+        sprintf(mess,"For P=%d Think have (%d) < have (%d)\n",P,npts_thinkhave,npts_have) ;
+        RSL_TEST_ERR(1,mess) ;
+      }
+    }
+#endif
+    for ( pt = Plist[P] ; pt != NULL ; pt = pt->next )
+    {
+      if ( curs+sizeof(bcast_point_desc_t)+s_msize>msglen )
+      {
+        sprintf(mess,"would overwrite in bcast messages: %d > %d",
+                curs+sizeof(bcast_point_desc_t)+s_msize, msglen) ;
+        RSL_TEST_ERR(1,mess) ;
+      }
+#if 0
+      ig = ID_IDEX( pt->parent_id ) ;
+      jg = ID_JDEX( pt->parent_id ) ;
+      if ( rsl_c_comp2phys_proc(s_dinfo->domain[INDEX_2(jg,ig,s_mlen)].P) != rsl_myproc )
+      {
+        sprintf(mess,"Point %d %d doesn't belong to me (%d) but rather to %d\n",ig,jg,rsl_myproc,
+                      rsl_c_comp2phys_proc(s_dinfo->domain[INDEX_2(jg,ig,s_mlen)].P)) ;
+        RSL_TEST_ERR(1,mess) ;
+      }
+#endif
+      pdesc.nest_id = pt->kid_id ;
+      pdesc.parent_id = pt->parent_id ;
+      pdesc.cm = pt->cm ;
+      pdesc.cn = pt->cn ;
+      bcopy( &pdesc, &work[curs], sizeof( bcast_point_desc_t )) ;
+      curs += sizeof( bcast_point_desc_t ) ;
+#ifndef NEC_TYPE4B
+      bcopy( pt->p, &work[curs], s_msize ) ;
+#else
+      from = (float *) pt->p ;
+      to = (float *) &work[curs] ;
+#pragma cdir nodep
+      for ( i = 0 ; i < s_msize / 4 ; i++ )
+      {
+        *(to++) = *(from++) ;
+      }
+#endif
+
+#if 0
+{
+  int v ;
+  float f ;
+  fprintf(stderr,"RSL_BCAST DEBUG : ") ;
+  for ( v = 0 ; v < s_msize/4 ; v++ )
+  {
+    bcopy( &work[v*4], &f, 4 ) ;
+    fprintf(stderr," %f ",f ) ;
+  }
+}
+#endif
+
+      curs += s_msize ;
+    }
+    RSL_TEST_ERR(curs+sizeof(bcast_point_desc_t)>msglen,
+      "Internal error: (end marker) would overwrite in bcast messages.") ;
+    /* add end marker */
+    pdesc.nest_id = RSL_INVALID ;
+    pdesc.parent_id = RSL_INVALID ;
+    pdesc.cm = RSL_INVALID ;
+    pdesc.cn = RSL_INVALID ;
+    bcopy( &pdesc, &work[curs], sizeof( bcast_point_desc_t )) ;
+    curs += sizeof( bcast_point_desc_t ) ;
+    /* note that it is all right for mlen to be less than msglen */
+    if ( rsl_c_comp2phys_proc(P) != rsl_myproc )
+    {
+      mdest = rsl_c_comp2phys_proc(P) ;
+      mtag = MTYPE_FROMTO( MSG_FROM_PARENT, rsl_myproc, mdest ) ;
+      msglen = curs ;
+      RSL_SEND( work, msglen, mtag, mdest ) ;
+    }
+    /* othersize, leave in the send buffer and we'll pick it
+       up later */
+  }
+
+  /* reset this for the next phase, in RSL_MESSAGE_FROM_PARENT */
+  s_parent_msgs = NULL ;
+}
+
+/* Return a point from some parent processor each time called.
+   If no more points, from a processor, got to the next one.
+   If no more points at all, retval is returned as RSL_INVALID */
+
+
+/*@
+  RSL_FROM_PARENT_INFO -- Get the next cell in a unpacking sequence for forcing.
+
+  Notes:
+  RSL_FROM_PARENT_INFO is used in a loop to unpack messages
+  containing forcing data for a nested domain.  The messages have arrived on the
+  local processor as a result of a previous call to RSL_BCAST_MSGS.
+  The domain descriptors do not need to be specified; they are part of
+  the state of RSL as a result of the calls to RSL_TO_CHILD_INFO that
+  have come before.  For a detailed example, see RSL_BCAST_MSGS.
+
+  Each call to RSL_FROM_PARENT_INFO gives the local indices a
+  nested point receiving forcing data (Arg1, Arg2), the global indices
+  of the nested point (Arg3, Arg4), and the global indices of the
+  parent domain point providing the forcing data (Arg7, Arg8).  The
+  indices of the child cell in the set of nest cells associated with
+  the parent are returned through arguments Arg5 and Arg6.  These
+  specify which of the nest cells associated with the parent
+  is being referred to.  There are IRAX_M by IRAX_N nest points
+  associated with each parent where IRAX_M is the nesting ratio in the
+  M dimension and IRAX_N is the nesting ratio in the N dimension (See
+  the descriptions for the RSL nest spawning routines RSL_SPAWN...).
+
+  RSL_FROM_PARENT_INFO will return a new set of coordinates for every
+  nest point stored in local processor memory.  For each point,
+  RSL_FROM_PARENT_INFO returns a value of 1 through Arg9.  RSL is
+  left in a state ready to yield
+  data for the nest point; the data
+  is unpacked from the message by calling RSL_FROM_PARENT_MSG.  Once
+  all local nest points have been traversed, RSL_FROM_PARENT_INFO
+  returns a value of 0 (zero) in Arg9.
+
+  It isn't necessary that anything be unpacked with the coordinates
+  that are returned.  However, once called, RSL_FROM_PARENT_INFO must
+  be called as many times as it takes to exhaust the number of points;
+  otherwise the underlying RSL mechanism will not be left in the proper
+  state at the conclusion of the broadcast.
+
+  See also:
+  RSL_BCAST_MSGS, RSL_TO_CHILD_INFO, RSL_FROM_PARENT_MSG
+@*/
+
+RSL_FROM_PARENT_INFO ( i_p, j_p, ig_p, jg_p, cm_p, cn_p,
+                       pig_p, pjg_p, retval_p )
+  int_p
+    i_p         /* (O) Local index in M dimension of nest. */
+   ,j_p         /* (O) Local index in N dimension of nest. */
+   ,ig_p        /* (O) Global index in M dimension of nest. */
+   ,jg_p        /* (O) Global index in N dimension of nest. */
+   ,cm_p        /* (O) M index of child cell beneath parent cell. */
+   ,cn_p        /* (O) N index of child cell beneath parent cell. */
+   ,pig_p       /* (O) Global index in M dimension of parent. */
+   ,pjg_p       /* (O) Global index in N dimension of parent. */
+   ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
+{
+  int ii ;
+  bcast_point_desc_t pdesc ;
+
+  if ( s_remaining > 0 )
+  {
+    s_parent_msgs_curs += s_remaining ;
+    s_remaining = 0 ;
+  }
+  get_a_new_bcast_point( retval_p ) ;
+  if ( *retval_p != 1 )
+  {
+    cleanup_after_bcast() ;
+    return ;
+  }
+  s_remaining = s_msize + sizeof(bcast_point_desc_t) ;
+
+  /* at this point we have a non-null message buffer */
+  /* read the descriptor */
+  bcopy( &(s_parent_msgs[s_parent_msgs_curs]),
+         &pdesc,
+         sizeof(bcast_point_desc_t)) ;
+  s_parent_msgs_curs += sizeof(bcast_point_desc_t) ;
+  s_remaining -= sizeof(bcast_point_desc_t) ;
+
+  /* get_a_new_bcast_point should not be returning these */
+  RSL_TEST_ERR( pdesc.nest_id == RSL_INVALID, "Internal error.") ;
+
+  *ig_p = ID_IDEX(pdesc.nest_id)+1 ;
+  *jg_p = ID_JDEX(pdesc.nest_id)+1 ;
+  *i_p = *ig_p + s_ninfo->idif ;
+  *j_p = *jg_p + s_ninfo->jdif ;
+  *pig_p = ID_IDEX(pdesc.parent_id)+1 ;
+  *pjg_p = ID_JDEX(pdesc.parent_id)+1 ;
+  *cm_p = pdesc.cm+1 ;
+  *cn_p = pdesc.cn+1 ;
+
+  *retval_p = 1 ;
+  return ;
+}
+
+/*@
+  RSL_FROM_PARENT_MSG -- Unpack feedback data into a nest point.
+
+  Notes:
+  RSL_FROM_PARENT_MSG is used in a loop to unpack messages containing
+  forcing data from a parent domain.
+  For an overview of the mechanism and a detailed
+  example, see RSL_BCAST_MSGS.
+
+  Before calling RSL_FROM_PARENT_MSG, RSL must have been put into the correct
+  state; that is, ready to accept data that will be sent to a particular
+  point in the nest.  This is done by first calling RSL_FROM_PARENT_INFO.
+  RSL_FROM_PARENT_MSG may then be called as many times as necessary to unpack
+  data from the message (or not at all, if there is no data for the point).
+  Each call to RSL_FROM_PARENT_MSG copies
+  Arg1 bytes from message into the bufffer specified by Arg2. Note that
+  the message
+  is allocated and handled entirely within RSL and never manipulated directly by
+  the user program.  The amount of data that can be packed is limited
+  to the message size that
+  was specified in the first call to RSL_TO_CHILD_INFO.
+
+  See also:
+  RSL_BCAST_MSGS, RSL_FROM_PARENT_INFO, RSL_TO_CHILD_INFO
+
+@*/
+RSL_FROM_PARENT_MSG ( len_p, buf )
+  int_p
+    len_p ;          /* (I) Number of bytes to unpack. */
+#ifndef NEC_TYPE4B
+  char *
+    buf ;            /* (O) Destination buffer. */
+#else
+  float *
+    buf ;            /* (O) Destination buffer. */
+#endif
+{
+#ifdef NEC_TYPE4B
+  float * dist ;
+  int i ;
+#endif
+  if ( *len_p <= 0 ) return ;
+  if ( *len_p > s_remaining ) 
+  {
+    sprintf(mess,
+"RSL_FROM_PARENT_MSG:\n   Requested number of bytes (%d) exceeds %d, the number remaining for this point.\n", *len_p, s_remaining) ;
+    RSL_TEST_WRN(1,mess) ;
+  }
+#ifndef NEC_TYPE4B
+  bcopy( &(s_parent_msgs[s_parent_msgs_curs]),
+         buf,
+         *len_p ) ;
+#else
+  dist = (float *) &(s_parent_msgs[s_parent_msgs_curs]) ;
+#pragma cdir nodep
+  for ( i = 0 ; i < *len_p / 4 ; i++ )
+  {
+    *(buf++) = *(dist++) ;
+  }
+#endif
+
+#if 0
+{
+float f ;
+bcopy(buf,&f,4) ;
+fprintf(stderr,"RSL_FROM_PARENT_MSG debug: curs: %d, val %f\n",
+        s_parent_msgs_curs, f ) ;
+}
+#endif
+
+  s_parent_msgs_curs += *len_p ;
+  s_remaining -= *len_p ;
+}
+
+get_a_new_bcast_point( retval_p )
+  int_p retval_p ;
+{
+  int result, mtag, ii ;
+  bcast_point_desc_t pdesc ;
+
+  do {
+    if ( s_parent_msgs != NULL )
+    {
+#if 0
+      pdesc = *((bcast_point_desc_t *)(&(s_parent_msgs[s_parent_msgs_curs]))) ;
+#else
+/* djs 1/98 */
+      bcopy( &s_parent_msgs[s_parent_msgs_curs]
+           , &pdesc
+           , sizeof( bcast_point_desc_t )
+           ) ;
+#endif
+      if ( pdesc.nest_id != RSL_INVALID )
+      {
+        *retval_p = 1 ;
+        return ;                /* 2.a. */
+      }
+    }
+    /* are there outstanding messages? */
+    for ( ii = 0 ; ii < s_ninfo->Nbcast_recv_Plist ; ii++ )
+    {
+      if ( s_ninfo->bcast_recv_Ptags[ii] != RSL_INVALID )
+      {
+        break ;
+      }
+    }
+    if ((ii == s_ninfo->Nbcast_recv_Plist)||(s_ninfo->Nbcast_recv_Plist <= 0))
+    {
+      *retval_p = -1 ;
+      s_parent_msgs = NULL ;
+      return ;                  /* 2.b.i */
+    }
+    /* scan till we get a message */
+    ii = 0 ;
+    result = 1 ;
+    while (1)
+    {
+      if ( s_ninfo->bcast_recv_Ptags[ii] != RSL_INVALID )
+      {
+        if ( rsl_c_comp2phys_proc(s_ninfo->bcast_recv_Plist[ii]) != rsl_myproc )
+        {
+          mtag = s_ninfo->bcast_recv_Ptags[ii] ;
+          if ( rsl_noprobe == NULL )
+            RSL_PROBE( mtag, &result ) ;
+          /* else, result will always be 1 */
+          if ( result )
+          {
+#ifdef PGON
+            if ( rsl_noprobe != NULL ) RSL_RECVEND ( mtag ) ;
+#else
+            RSL_RECVEND ( mtag ) ;
+#endif
+            s_ninfo->bcast_recv_Ptags[ii] = RSL_INVALID ;
+            s_parent_msgs =
+               buffer_for_proc( s_ninfo->bcast_recv_Plist[ii], 0, RSL_RECVBUF )
+;
+            break ;
+          }
+        }
+        else
+        {
+          /* code to handle data from myself, which will be in my send buffer */
+          s_ninfo->bcast_recv_Ptags[ii] = RSL_INVALID ;
+          s_parent_msgs =
+             buffer_for_proc( s_ninfo->bcast_recv_Plist[ii], 0, RSL_SENDBUF ) ;
+                                                          /*    ^^^^^^^^^^^  */
+                                                          /* because data is */
+                                                          /* from myself     */
+          break ;
+        }
+      }
+      if ( ++ii >= s_ninfo->Nbcast_recv_Plist ) ii = 0 ;
+    }
+    s_parent_msgs_curs = 0 ;
+#if 0
+    pdesc = *((bcast_point_desc_t *)(&(s_parent_msgs[s_parent_msgs_curs]))) ;
+#else
+/* djs 1/98 */
+    bcopy( &s_parent_msgs[s_parent_msgs_curs]
+         , &pdesc
+         , sizeof(bcast_point_desc_t)
+         ) ;
+#endif
+  } while ( pdesc.nest_id == RSL_INVALID ) ;
+  *retval_p = 1 ;
+}
+
+post_receives_from_parent()
+{
+  int ii, msglen, P, mtag, mfrom ;
+  char * work ;
+
+  for ( ii = 0 ; ii < s_ninfo->Nbcast_recv_Plist ; ii++ )
+  {
+    P = s_ninfo->bcast_recv_Plist[ii] ;
+    mfrom = rsl_c_comp2phys_proc(P) ;
+    if ( mfrom != rsl_myproc )
+    {
+      msglen = s_ninfo->bcast_recv_Pnpts[ii]*(sizeof(bcast_point_desc_t)+s_msize)
+               + sizeof(bcast_point_desc_t) ;    /* end marker */
+      work = buffer_for_proc(P, msglen, RSL_RECVBUF) ;
+      mtag = MTYPE_FROMTO( MSG_FROM_PARENT, mfrom, rsl_myproc ) ;
+      RSL_RECVBEGIN( work, msglen, mtag ) ;
+      s_ninfo->bcast_recv_Ptags[ii] = mtag ; /* store tag */
+    }
+    else
+    {
+      /* set the tag so we know to unpack the send buffer 
+         for data from ourself */
+      mtag = MTYPE_FROMTO( MSG_FROM_PARENT, mfrom, rsl_myproc ) ;
+      s_ninfo->bcast_recv_Ptags[ii] = mtag ;
+    }
+  }
+}
+
+RSL_MOVE_NEST ( d_p, n_p,  mdisp_p, ndisp_p )
+  int_p d_p, n_p, mdisp_p, ndisp_p ;
+{
+  int parent, intermed, nest, mdisp, ndisp ;
+  rsl_domain_info_t *dinfo, *ninfo ;
+  int i, j, cm, cn, irax_m, irax_n, nid ;
+  int mother_id ;
+  rsl_child_info_t ** children_p ;
+
+  parent = *d_p    ; nest = *n_p      ;
+  mdisp = *mdisp_p ; ndisp = *ndisp_p ; 
+
+  RSL_TEST_ERR( parent < 0 || parent > RSL_MAXDOMAINS, "rsl_move_nest: bad parent domain descriptor" ) ;
+  RSL_TEST_ERR( nest < 0   || nest > RSL_MAXDOMAINS,   "rsl_move_nest: bad nested domain descriptor" ) ;
+  dinfo = &( domain_info[parent]) ;
+  ninfo = &( domain_info[nest]) ;
+  irax_m = ninfo->irax_m ;
+  irax_n = ninfo->irax_n ;
+
+  if ( dinfo->child_bcast_compiled[s_nst] != 1 ||
+       ninfo->parent_bcast_compiled != 1 )
+  {
+    rsl_comp_bcast( d_p, n_p ) ;
+  }
+  dinfo->child_bcast_compiled[nest] = 0 ;  /* invalidate broadcast */
+  ninfo->parent_bcast_compiled      = 0 ;  /* invalidate broadcast */
+
+
+  if ( dinfo->child_merge_compiled[s_nst] != 1 ||
+       ninfo->parent_merge_compiled != 1 )
+  {
+    rsl_comp_merge( d_p, n_p ) ;
+  }
+  dinfo->child_merge_compiled[nest] = 0 ;  /* invalidate merge */
+  ninfo->parent_merge_compiled      = 0 ;  /* invalidate merge */
+
+  children_p = RSL_MALLOC( rsl_child_info_t *, dinfo->len_n * dinfo->len_m ) ;
+
+  for ( j = 0 ; j < dinfo->len_n ; j++ )
+    for ( i = 0 ; i < dinfo->len_m ; i++ )
+         children_p[ INDEX_2( j, i, dinfo->len_m ) ] = NULL ;
+
+  for ( j = 0 ; j < dinfo->len_n ; j++ )
+    for ( i = 0 ; i < dinfo->len_m ; i++ )
+       if (    i - mdisp >= 0 && i - mdisp < dinfo->len_m 
+            && j - ndisp >= 0 && j - ndisp < dinfo->len_n ) {
+         children_p[ INDEX_2( j, i, dinfo->len_m ) ] = dinfo->domain[ INDEX_2( j - ndisp , i - mdisp, dinfo->len_m ) ].children_p ;
+       }
+
+  for ( j = 0 ; j < dinfo->len_n ; j++ )
+    for ( i = 0 ; i < dinfo->len_m ; i++ )
+       dinfo->domain[ INDEX_2( j , i , dinfo->len_m ) ].children_p = children_p[ INDEX_2( j, i, dinfo->len_m ) ] ;
+
+  RSL_FREE( children_p ) ;
+
+  for ( j = 0 ; j < dinfo->len_n ; j++ )
+    for ( i = 0 ; i < dinfo->len_m ; i++ )
+      for ( cn = 0 ; cn < irax_n ; cn++ )
+        for ( cm = 0 ; cm < irax_m ; cm++ )
+          if ( dinfo->domain[ INDEX_2( j, i, dinfo->len_m ) ].children_p != NULL )
+          {
+            dinfo->domain[ INDEX_2( j, i, dinfo->len_m ) ].children_p->child[INDEX_2(cn,cm,irax_m)] = RSL_INVALID ;
+          }
+
+  for ( j = 0 ; j < ninfo->len_n ; j++ )
+  {
+    for ( i = 0 ; i < ninfo->len_m ; i++ )
+    {
+      nid = POINTID( nest, j, i ) ;
+      mother_id = ninfo->domain[ INDEX_2( j, i, ninfo->len_m ) ].mother_id ;
+      mother_id = POINTID(parent, (ID_JDEX( mother_id )) + ndisp, (ID_IDEX( mother_id )) + mdisp ) ;
+      ninfo->domain[ INDEX_2( j, i, ninfo->len_m ) ].mother_id = mother_id ;
+      ninfo->domain[ INDEX_2( j, i, ninfo->len_m ) ].mother_P = 
+                       dinfo->domain[ INDEX_2( ID_JDEX( mother_id ), ID_IDEX( mother_id ), dinfo->len_m ) ].P ;
+      cm = ninfo->domain[ INDEX_2( j, i, ninfo->len_m ) ].which_kid_am_i_m ;
+      cn = ninfo->domain[ INDEX_2( j, i, ninfo->len_m ) ].which_kid_am_i_n ;
+      if ( dinfo->domain[ INDEX_2( ID_JDEX( mother_id ), ID_IDEX( mother_id ), dinfo->len_m ) ].children_p != NULL ) {
+        dinfo->domain[ INDEX_2( ID_JDEX( mother_id ), ID_IDEX( mother_id ), dinfo->len_m ) ].children_p->child[INDEX_2(cn,cm,irax_m)] = nid ;
+      }
+    }
+  }
+  ninfo->coord_m += mdisp ;
+  ninfo->coord_n += ndisp ;
+}
+
+rsl_ready_bcast( d_p, n_p, msize_p )
+  int_p d_p, n_p, msize_p ;
+{
+  int i ;
+  par_info_t *dp ;
+  rsl_list_t *lp ;
+  rsl_child_info_t * kid ;
+  rsl_point_t *pt, *pt2 ;
+  int kidid ;
+  int ig, jg, kig, kjg, cn, cm ;
+  int P ;
+#ifdef NEC_TUNE
+  int size ;
+  int myproc ;
+  int * list ;
+#endif
+
+  s_msize = *msize_p ;
+  s_d = *d_p ;
+  s_nst = *n_p ;
+  RSL_TEST_ERR( stage != NULL,
+    "rsl_ready_bcast: called again before RSL_BCAST_MSGS of previous call.") ;
+  RSL_TEST_ERR( s_d < 0 || s_d > RSL_MAXDOMAINS,
+    "rsl_ready_bcast: bad parent domain descriptor" ) ;
+  RSL_TEST_ERR( s_nst < 0 || s_nst > RSL_MAXDOMAINS,
+    "rsl_ready_bcast: bad nested domain descriptor" ) ;
+  RSL_TEST_ERR( s_d == s_nst,
+    "rsl_ready_bcast: domain cannot broadcast to itself" ) ;
+  RSL_TEST_ERR( domain_info[s_nst].parent != s_d ,
+    "rsl_ready_bcast: the nest is not a child of the parent" ) ;
+ 
+  s_dinfo = &( domain_info[s_d]) ;
+  s_ninfo = &( domain_info[s_nst]) ;
+  RSL_TEST_ERR( s_dinfo->valid != RSL_VALID,
+    "rsl_ready_bcast: invalid parent domain" ) ;
+  RSL_TEST_ERR( s_ninfo->valid != RSL_VALID,
+    "rsl_ready_bcast: invalid nested domain" ) ;
+  s_ddomain = s_dinfo->domain ;
+  s_ndomain = s_ninfo->domain ;
+
+  s_mlen = s_dinfo->len_m ;
+  s_nlen = s_dinfo->len_n ;
+  s_mlen_nst = s_ninfo->len_m ;
+  s_nlen_nst = s_ninfo->len_n ;
+  s_irax_n = s_ninfo->irax_n ;
+  s_irax_m = s_ninfo->irax_m ;
+
+
+  if ( s_dinfo->child_bcast_compiled[s_nst] != 1 ||
+       s_ninfo->parent_bcast_compiled != 1 )
+  {
+    rsl_comp_bcast( d_p, n_p ) ;
+    if ( s_ninfo->bcast_Xlist != NULL )
+    {
+      destroy_list( &(s_ninfo->bcast_Xlist), destroy_par_info ) ;
+    }
+    s_ninfo->bcast_Xlist = NULL ;
+  }
+
+  post_receives_from_parent() ;
+
+  stage = RSL_MALLOC( stage_point_t , s_mlen_nst * s_nlen_nst ) ;
+  stage_len = s_mlen_nst * s_nlen_nst ;         /* 96/3/15 */
+  for ( i = 0 ; i < stage_len ; i++ )
+  {
+    stage[i].p = NULL ;
+  }
+
+#if (defined(vpp)||defined(vpp2))
+  blankstagecurs = 0 ;
+#endif
+
+  /* construct the list of nested points under local parent points */
+
+  if ( s_ninfo->bcast_Xlist == NULL )
+  {
+    /* traverse backwards so that Xlist can be constructed easily frontwards */
+#ifndef NEC_TUNE
+    for ( jg = s_nlen-1 ; jg >=0 ; jg-- )
+    {
+      for ( ig = s_mlen-1 ; ig >= 0 ; ig-- )
+      {
+        pt = &(s_ddomain[INDEX_2(jg,ig,s_mlen)]) ;
+        if ( pt->valid == RSL_VALID &&
+             rsl_c_comp2phys_proc(pt->P) == rsl_myproc )
+        {
+          if ((kid=pt->children_p) != NULL )
+          {
+            for ( cn = s_irax_n-1 ; cn >= 0 ; cn-- )
+            {
+              for ( cm = s_irax_m-1 ; cm >= 0 ; cm-- )
+              {
+                kidid = kid->child[INDEX_2(cn,cm,s_irax_m)] ;
+                kig = ID_IDEX( kidid ) ;
+                kjg = ID_JDEX( kidid ) ;
+                pt2 = &(s_ndomain[INDEX_2(kjg,kig,s_mlen_nst)]) ;
+                if ( pt2->valid == RSL_VALID  &&
+                     ID_DOMAIN(kidid)==s_nst)
+                {
+                  dp = RSL_MALLOC( par_info_t, 1 ) ;
+                  dp->ig = ig ;
+                  dp->jg = jg ;
+                  dp->cn = cn ;
+                  dp->cm = cm ;
+                  dp->kidid = kidid ;
+                  lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+                  lp->data = dp ;
+                  lp->next = s_ninfo->bcast_Xlist ;
+                  s_ninfo->bcast_Xlist = lp ;
+                }
+              }
+            }
+          }
+        }
+      }
+    }
+#else
+    list = malloc( (s_irax_n*s_irax_m*s_nlen*s_mlen+1) * sizeof(int) ) ;
+    size = 0 ;
+    for ( cn = s_irax_n-1 ; cn >= 0; cn-- )
+    {
+      for ( cm = s_irax_m-1 ; cm >= 0; cm-- )
+      {
+#pragma cdir nodep
+        for ( i = s_nlen*s_mlen-1 ; i >= 0; i-- )
+        {
+          pt = &(s_ddomain[i]) ;
+#if ( HOST_NODE == 0 )
+#  if ( MON_LOW == 0 )
+          myproc = pt->P ;
+#  else
+          myproc = pt->P ;
+#  endif
+#else
+#  if ( MON_LOW == 0 )
+          myproc = pt->P ;
+#  else
+          myproc = pt->P + 1 ;
+#  endif
+#endif
+          if ( pt->valid == RSL_VALID && myproc == rsl_myproc )
+          {
+            if ((kid=pt->children_p) != NULL )
+            {
+              kidid = kid->child[INDEX_2(cn,cm,s_irax_m)] ;
+              kig = ID_IDEX( kidid ) ;
+              kjg = ID_JDEX( kidid ) ;
+              pt2 = &(s_ndomain[INDEX_2(kjg,kig,s_mlen_nst)]) ;
+              if ( pt2->valid == RSL_VALID && ID_DOMAIN(kidid)==s_nst)
+              {
+                size++ ;
+                *(list+size) = i ;
+              }
+            }
+          }
+        }
+      }
+    }
+    dp = RSL_MALLOC( par_info_t, size ) ;
+    lp = RSL_MALLOC( rsl_list_t, size ) ;
+    for ( cn = s_irax_n-1 ; cn >= 0; cn-- )
+    {
+      for ( cm = s_irax_m-1 ; cm >= 0; cm-- )
+      {
+        for ( i = 1 ; i <= size ; i++ )
+        {
+          pt = &(s_ddomain[*(list+i)]) ;
+#if ( HOST_NODE == 0 )
+#  if ( MON_LOW == 0 )
+          myproc = pt->P ;
+#  else
+          myproc = pt->P ;
+#  endif
+#else
+#  if ( MON_LOW == 0 )
+          myproc = pt->P ;
+#  else
+          myproc = pt->P + 1 ;
+#  endif
+#endif
+          if ( pt->valid == RSL_VALID && myproc == rsl_myproc )
+          {
+            if ((kid=pt->children_p) != NULL )
+            {
+              kidid = kid->child[INDEX_2(cn,cm,s_irax_m)] ;
+              kig = ID_IDEX( kidid ) ;
+              kjg = ID_JDEX( kidid ) ;
+              pt2 = &(s_ndomain[INDEX_2(kjg,kig,s_mlen_nst)]) ;
+              if ( pt2->valid == RSL_VALID && ID_DOMAIN(kidid)==s_nst)
+              {
+                dp->ig = *(list+i) % s_mlen ;
+                dp->jg = *(list+i) / s_mlen ;
+                dp->cn = cn ;
+                dp->cm = cm ;
+                dp->kidid = kidid ;
+                lp->data = dp ;
+                lp->next = s_ninfo->bcast_Xlist ;
+                s_ninfo->bcast_Xlist = lp ;
+                dp++ ;
+                lp++ ;
+              }
+            }
+          }
+        }
+      }
+    }
+    free( list ) ;
+#endif
+  }
+  Xlist = s_ninfo->bcast_Xlist ;
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    Plist[P] = NULL ;
+  }
+
+  return ;
+}
+
+/* now used internally only */
+rsl_comp_bcast( d_p, n_p )
+  int_p d_p, 
+        n_p ;
+{
+  int d, nst, mlen, nlen, mlen_nst, nlen_nst ;
+  rsl_domain_info_t *dinfo, *ninfo ;
+  rsl_point_t *ddomain, *ndomain, *pt ;
+  rsl_child_info_t *kids ;
+  rsl_processor_t P ;
+  int i, j, jg, ig, jgn, ign, cn, cm, cnt, p ;
+  int irax_n, irax_m ;
+
+  d = *d_p ;
+  nst = *n_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, 
+        "rsl_comp_bcast: bad parent domain descriptor") ;
+  RSL_TEST_ERR( nst < 0 || nst >= RSL_MAXDOMAINS, 
+        "rsl_comp_bcast: bad nested domain descriptor") ;
+  RSL_TEST_ERR( d == nst, 
+        "rsl_comp_bcast: domain cannot broadcast to itself" ) ;
+  RSL_TEST_ERR( domain_info[nst].parent != d ,
+        "rsl_comp_bcast: the nest is not a child of the parent" ) ;
+
+  dinfo = &( domain_info[d]) ;
+  ninfo = &( domain_info[nst]) ;
+  RSL_TEST_ERR( dinfo->valid != RSL_VALID,
+        "rsl_comp_bcast: invalid parent domain" ) ;
+  RSL_TEST_ERR( ninfo->valid != RSL_VALID,
+        "rsl_comp_bcast: invalid nested domain" ) ;
+
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+  mlen_nst = ninfo->len_m ;
+  nlen_nst = ninfo->len_n ;
+  ddomain = dinfo->domain ;
+  ndomain = ninfo->domain ;
+  irax_n = ninfo->irax_n ;
+  irax_m = ninfo->irax_m ;
+
+  destroy_bcast_compilation( d_p, n_p ) ;
+
+  if ( dinfo->decomposed != 1 )
+  {
+     fprintf(stderr,"Calling default decomposition for parent %d\n",*d_p);
+     default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+  if ( ninfo->decomposed != 1 )
+  {
+     fprintf(stderr,"Calling default decomposition for nest %d\n",*n_p);
+     default_decomposition( n_p,
+                           &(domain_info[*n_p].loc_m),
+                           &(domain_info[*n_p].loc_n) ) ;
+  }
+
+  /* begin by computing the receive list */
+  for ( i = 0 ; i < rsl_nproc_all ; i++ ) 
+    ninfo->bcast_recv_Pnpts[i] = 0 ;
+
+  for ( jgn = 0 ; jgn < nlen_nst ; jgn++ )
+  {
+    for ( ign = 0 ; ign < mlen_nst ; ign++ )
+    {
+      pt = &(ndomain[INDEX_2(jgn,ign,mlen_nst)]) ;
+      if ( pt->valid == RSL_VALID  &&
+           rsl_c_comp2phys_proc(pt->P) == rsl_myproc )
+      {
+        (ninfo->bcast_recv_Pnpts[pt->mother_P])++ ; /* count this point as 
+                                                       coming from the parent
+                                                       processor */
+      }
+    }
+  }
+  /* compress and copy the plist */
+  ninfo->Nbcast_recv_Plist = 0 ;
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    if ( ninfo->bcast_recv_Pnpts[P] > 0 )
+    {
+      ninfo->bcast_recv_Pnpts[ninfo->Nbcast_recv_Plist] =
+                                        ninfo->bcast_recv_Pnpts[P] ;
+      ninfo->bcast_recv_Plist[ninfo->Nbcast_recv_Plist] = P ;
+      (ninfo->Nbcast_recv_Plist)++ ;
+    }
+  }
+
+  /* now compute the send list */
+  for ( i = 0 ; i < rsl_nproc_all ; i++ ) 
+    ninfo->bcast_send_Pnpts[i] = 0 ;
+
+  for ( jgn = 0 ; jgn < nlen_nst ; jgn++ )
+  {
+    for ( ign = 0 ; ign < mlen_nst ; ign++ )
+    {
+      pt = &(ndomain[INDEX_2(jgn,ign,mlen_nst)]) ;
+      if ( pt->valid == RSL_VALID  &&
+           rsl_c_comp2phys_proc(pt->mother_P) == rsl_myproc )
+      {
+         if ( pt->valid == RSL_VALID )
+          ninfo->bcast_send_Pnpts[pt->P]++ ; /* count this point being
+                                                sent from me to P */
+      }
+    }
+  }
+
+  /* compress and copy the plist */
+  ninfo->Nbcast_send_Plist = 0 ;
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    if ( ninfo->bcast_send_Pnpts[P] > 0 )
+    {
+      ninfo->bcast_send_Pnpts[ninfo->Nbcast_send_Plist] =
+                                        ninfo->bcast_send_Pnpts[P] ;
+      ninfo->bcast_send_Plist[ninfo->Nbcast_send_Plist] = P ;
+
+      (ninfo->Nbcast_send_Plist)++ ;
+    }
+  }
+
+  dinfo->child_bcast_compiled[nst] = 1 ;
+  ninfo->parent_bcast_compiled = 1 ;
+
+  return ;
+}
+
+cleanup_after_bcast()
+{
+  int i ;
+  if ( stage != NULL )
+  {
+    for ( i = 0 ; i < stage_len ; i++ )
+    {
+#if ! (defined(vpp)||defined(vpp2))
+      if ( stage[i].p != NULL ) RSL_FREE( stage[i].p ) ;  /* 96/3/15 */
+#else
+      stage[i].p = NULL ;
+#endif
+    }
+    RSL_FREE( stage ) ;
+  }
+#if (defined(vpp)||defined(vpp2))
+  blankstagecurs = 0 ;
+#endif
+  stage = NULL ;
+  s_msize = RSL_INVALID ;
+  s_dinfo = NULL ;
+  s_ninfo = NULL ;
+  s_ddomain = NULL ;
+  s_ndomain = NULL ;
+  s_parent_msgs = NULL ;
+  s_parent_msgs_curs = RSL_INVALID ;
+}
+
+destroy_bcast_compilation( d_p, n_p )
+  int_p d_p, n_p ;
+{
+  int d, nst, P ;
+  rsl_domain_info_t *dinfo, *ninfo ;
+  rsl_point_t *ddomain, *ndomain, *pt ;
+
+  d = *d_p ;
+  nst = *n_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+        "rsl_comp_bcast: bad parent domain descriptor") ;
+  RSL_TEST_ERR( nst < 0 || nst >= RSL_MAXDOMAINS,
+        "rsl_comp_bcast: bad nested domain descriptor") ;
+  RSL_TEST_ERR( d == nst,
+        "rsl_comp_bcast: domain cannot broadcast to itself" ) ;
+  RSL_TEST_ERR( domain_info[nst].parent != d ,
+        "rsl_comp_bcast: the nest is not a child of the parent" ) ;
+
+  dinfo = &( domain_info[d]) ;
+  ninfo = &( domain_info[nst]) ;
+  RSL_TEST_ERR( dinfo->valid != RSL_VALID,
+        "rsl_comp_bcast: invalid parent domain" ) ;
+  RSL_TEST_ERR( ninfo->valid != RSL_VALID,
+        "rsl_comp_bcast: invalid nested domain" ) ;
+  
+  ninfo->parent_bcast_compiled = 0 ;
+  dinfo->child_bcast_compiled[nst] = 0 ;
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    ninfo->bcast_recv_Pnpts[P] = 0 ;
+    ninfo->bcast_recv_Plist[P] = RSL_INVALID ;
+    ninfo->bcast_recv_Ptags[P] = RSL_INVALID ;
+    ninfo->Nbcast_recv_Plist = 0 ;
+  }
+}
+
+#ifdef NOUNDERSCORE
+cwrap_fbcast ( pd, nd, msize, mf, pf, upf )
+#else
+# ifdef T3D
+CWRAP_FBCAST ( pd, nd, msize, mf, pf, upf )
+# else
+#   ifdef F2CSTYLE
+cwrap_fbcast__( pd, nd, msize, mf, pf, upf )
+#   else
+cwrap_fbcast_( pd, nd, msize, mf, pf, upf )
+#   endif
+# endif
+#endif
+  int *pd, *nd, *msize ;
+  void (*mf)(), (*pf)(), (*upf)() ;
+{
+  char * buf ;
+  buf = RSL_MALLOC( char, *msize ) ;
+#ifdef NOUNDERSCORE
+  rsl_f_bcast_chld ( pd, nd, msize, buf, mf, pf, upf ) ;
+#else
+# ifdef T3D
+  RSL_F_BCAST_CHLD ( pd, nd, msize, buf, mf, pf, upf ) ;
+# else
+#   ifdef F2CSTYLE
+  rsl_f_bcast_chld__( pd, nd, msize, buf, mf, pf, upf ) ;
+#   else
+  rsl_f_bcast_chld_( pd, nd, msize, buf, mf, pf, upf ) ;
+#   endif
+# endif
+#endif
+  RSL_FREE( buf ) ;
+}
+
+#ifdef NOUNDERSCORE
+cwrap_fmerge ( pd, nd, msize, mf, pf, upf )
+#else
+# ifdef T3D
+CWRAP_FMERGE ( pd, nd, msize, mf, pf, upf )
+# else
+#   ifdef F2CSTYLE
+cwrap_fmerge__( pd, nd, msize, mf, pf, upf )
+#   else
+cwrap_fmerge_( pd, nd, msize, mf, pf, upf )
+#   endif
+# endif
+#endif
+  int *pd, *nd, *msize ;
+  void (*mf)(), (*pf)(), (*upf)() ;
+{
+  char * buf ;
+  buf = RSL_MALLOC( char, *msize ) ;
+#ifdef NOUNDERSCORE
+  rsl_f_merge_chld ( pd, nd, msize, buf, mf, pf, upf ) ;
+#else
+# ifdef T3D
+  RSL_F_MERGE_CHLD ( pd, nd, msize, buf, mf, pf, upf ) ;
+# else
+#   ifdef F2CSTYLE
+  rsl_f_merge_chld__( pd, nd, msize, buf, mf, pf, upf ) ;
+#   else
+  rsl_f_merge_chld_( pd, nd, msize, buf, mf, pf, upf ) ;
+#   endif
+# endif
+#endif
+  RSL_FREE( buf ) ;
+}
+
+vbcopy_C(a,b,c)
+  char *a, *b ; int c ;
+{
+#if (( defined(vpp) || defined(vpp2) ) && ! defined(sx))
+  int l, lb ;
+  l = ((c)/sizeof(int)) ;
+  lb = l*sizeof(int) ;
+  vicopy_(a,b,&l) ;
+  l = c-lb ;
+  vbcopy_(a+lb,b+lb,&l) ;
+#endif
+}
+
+RSL_RESET_STAGING ()
+{
+#if (defined(vpp) || defined(vpp2))
+if ( blankstage != NULL ) RSL_FREE( blankstage ) ;
+blankstage = NULL ;
+blankstagesize = 0 ;
+blankstagecurs = 0 ;
+#endif
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_bcast_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_bcast_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_bcast_f.F	(revision 2744)
@@ -0,0 +1,106 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine rsl_bcast_chld( pd, nd, msize, mf, pf, upf )
+      call cwrap_fbcast( pd, nd, msize, mf, pf, upf )
+      return
+      end
+
+      subroutine rsl_f_bcast_chld( pd, nd, msize, buf, mf, pf, upf )
+      implicit none
+      integer pd                ! parent domain
+      integer nd                ! nested domain
+      integer msize             ! message size  in BYTES
+      integer pf                ! packing function
+      integer upf               ! unpacking function
+      logical mf                ! mask function
+      real buf(msize)
+      include 'rsl.inc'
+c local variables
+      integer retval, i, j, ig, jg, dum
+      integer njg, nig, n, pjg, pig, cn, cm
+
+      call rsl_to_child_info( pd, nd, msize,
+     +                        i,j,pig,pjg,cm,cn,nig,njg,retval )
+      do while ( retval .eq. 1 )
+        if ( mf( pd, nd, i, j, pig, pjg ) ) then
+          dum = pf ( pd, nd, i, j, pig, pjg, 
+     +              dum, dum,     nig, njg,
+     +              cm, cn, buf, msize )
+          call rsl_to_child_msg(msize,buf)
+        endif
+        call rsl_to_child_info( pd, nd, msize,
+     +                          i,j,pig,pjg,cm,cn,nig,njg,retval )
+      enddo
+
+c exchange the messages
+      call rsl_bcast_msgs
+
+c unpack the messages from children of points in this domain
+
+      call rsl_from_parent_info( i, j, nig, njg, cm, cn, pig, pjg, 
+     +                           retval )
+      do while ( retval .eq. 1 )
+	call rsl_from_parent_msg( msize, buf )
+        dum = upf( pd, nd, i, j, nig, njg, cm, cn, buf, msize )
+        call rsl_from_parent_info( i, j, nig, njg, cm, cn, pig, pjg,
+     +                             retval )
+      enddo
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_bdyin_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_bdyin_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_bdyin_f.F	(revision 2744)
@@ -0,0 +1,76 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine fort_bdyin_real( unit,
+     $               buf_e,buf_w,buf_n,buf_s, n_ew, n_ns )
+      implicit none
+      integer unit, n_ew, n_ns
+      real buf_e(n_ew),buf_w(n_ew),buf_n(n_ns),buf_s(n_ns)
+      read( unit ) buf_e,buf_w,buf_n,buf_s
+      return
+      end
+
+      subroutine fort_bdyin_dbl( unit,
+     $               buf_e,buf_w,buf_n,buf_s, n_ew, n_ns )
+      implicit none
+      integer unit, n_ew, n_ns
+      double precision buf_e(n_ew),buf_w(n_ew),buf_n(n_ns),buf_s(n_ns)
+      read( unit ) buf_e,buf_w,buf_n,buf_s
+      return
+      end
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_cham_compat.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_cham_compat.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_cham_compat.c	(revision 2744)
@@ -0,0 +1,288 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+/* this is still under construction  -- 11/94 */
+
+#ifdef CHAMELEON
+#ifndef __CHAM_COMPAT__
+#define __CHAM_COMPAT__
+
+#include <stdio.h>
+#include "tools.h" 
+#include "comm/comm.h"
+#include "rsl.h"
+
+#define RSLHandleInc 32
+
+typedef long CHAM_request ;
+
+struct tagsToHandles
+       {
+       int tag;
+       char * buff ;
+       int mlen ;
+       int datatype ;
+       CHAM_Request Handle;
+       };
+struct rslCHAMHandles
+       {
+       int nHandles;
+       int nUsed;
+       struct tagsToHandles *tags;
+       } rslCHAMHandleLUT;
+
+/******************************************************
+ * rslCHAMInit ()
+ *   do whatever initialization is necessary for the
+ *   CHAM port
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *  Adapted to CHAM: J. Michalakes 11/94
+ *
+ *****************************************************/
+
+static int dummy = 0 ;
+
+void rslCHAMInit()
+  {
+  rslCHAMHandleLUT.nHandles = RSLHandleInc;
+  rslCHAMHandleLUT.nUsed = 0;
+  rslCHAMHandleLUT.tags = (struct tagsToHandles *) 
+                     malloc (sizeof (struct tagsToHandles) * RSLHandleInc);
+
+#ifdef FATAL_ERRORS
+  if (rslCHAMHandleLUT.tags == NULL)
+    {
+    fprintf (stderr, "Fatal Error: malloc failure in rslCHAMInit\n");
+    exit(1);
+    }
+#endif
+  }
+
+
+/******************************************************
+ * rslCHAMWho ( numproc, myproc )
+ *  Use the LUT to find an CHAM wait handle from a tag
+ *
+ *  Initial coding: J. Michalakes  7/13/94
+ *
+ *****************************************************/
+
+long rslCHAMWho( numproc, myproc )
+  int * numproc, * myproc ;
+{
+  *myproc = PImytid ;
+  *numproc = PInumtids ;
+  return( 0L ) ;
+}
+
+/******************************************************
+ * rslCHAMFindWaitH (tag)
+ *  Use the LUT to find an CHAM wait handle from a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+
+long rslCHAMFindWaitH (tag, waitHandle,
+		       buff, mlen, datatype )
+  int tag;   /* Tag for which we lookup a wait handle */
+  CHAM_Request *waitHandle ;
+  char ** buff ;
+  int *mlen ;
+  int *datatype ;
+  {
+  int i;
+  long retVal = -1;
+
+  for (i=0; i < rslCHAMHandleLUT.nUsed; i++)
+    {
+    if (rslCHAMHandleLUT.tags[i].tag == tag)
+      {
+      *buff       = rslCHAMHandleLUT.tags[i].buff;
+      *mlen       = rslCHAMHandleLUT.tags[i].mlen;
+      *datatype   = rslCHAMHandleLUT.tags[i].datatype;
+      *waitHandle = rslCHAMHandleLUT.tags[i].Handle;
+
+      rslCHAMHandleLUT.nUsed--;  /* Keep them contiguous */
+      rslCHAMHandleLUT.tags[i].tag=rslCHAMHandleLUT.tags[rslCHAMHandleLUT.nUsed].tag;
+      rslCHAMHandleLUT.tags[i].buff=
+                  rslCHAMHandleLUT.tags[rslCHAMHandleLUT.nUsed].buff;
+      rslCHAMHandleLUT.tags[i].mlen=
+                  rslCHAMHandleLUT.tags[rslCHAMHandleLUT.nUsed].mlen;
+      rslCHAMHandleLUT.tags[i].datatype=
+                  rslCHAMHandleLUT.tags[rslCHAMHandleLUT.nUsed].datatype;
+      rslCHAMHandleLUT.tags[i].Handle=
+                  rslCHAMHandleLUT.tags[rslCHAMHandleLUT.nUsed].Handle;
+      break;
+      }
+    }
+  }
+
+/******************************************************
+ * rslCHAMSaveWaitH (tag, waitHandle)
+ *  Use the LUT to save an CHAM wait handle referenced by a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslCHAMSaveWaitH (tag, waitHandle)
+ int tag;
+ CHAM_Request * waitHandle;
+ {
+ /* Make sure there is enough space, if not, try a realloc */
+ /* If the realloc fails we're in deep trouble */
+ if (rslCHAMHandleLUT.nUsed == rslCHAMHandleLUT.nHandles)
+   {
+   struct tagsToHandles *tags;  /* Temp pointer */
+   tags = (struct tagsToHandles *) 
+      realloc (rslCHAMHandleLUT.tags, 
+      sizeof (struct tagsToHandles) * (rslCHAMHandleLUT.nHandles + RSLHandleInc));
+   if (tags != NULL)
+     {
+     rslCHAMHandleLUT.tags = tags;
+     rslCHAMHandleLUT.nHandles += RSLHandleInc;
+     }
+   else
+     {
+#ifdef FATAL_ERRORS
+     fprintf (stderr, "Fatal Error: realloc failure in rslCHAMSaveWaitH\n");
+     exit(1);
+#endif
+     return;
+     }
+   }
+ /* Stash the handle */
+ rslCHAMHandleLUT.tags[rslCHAMHandleLUT.nUsed].tag = tag;
+ rslCHAMHandleLUT.tags[rslCHAMHandleLUT.nUsed].Handle = *waitHandle;
+ rslCHAMHandleLUT.nUsed++;
+ }
+
+/******************************************************
+ * rslCHAMISend (buff, mlen, tag, dest)
+ *  Post a non blocking send an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslCHAMISend (buff, mlen, tag, dest)
+ char *buff;
+ int mlen;
+ int tag;
+ int dest;
+ {
+   CHAM_Request waitHandle;
+ 
+   PInsend(   tag,
+	      buff,
+	      mlen,
+	      dest,
+	      MSG_OTHER,
+              &waitHandle); 
+
+   rslCHAMSaveWaitH (tag, &waitHandle);
+ }
+ 
+/******************************************************
+ * rslCHAMIRecv (buff, mlen, tag)
+ *  Post a non blocking receive an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslCHAMIRecv (buff, mlen, tag)
+ char *buff;
+ int mlen;
+ int tag;
+ {
+   CHAM_Request waitHandle;
+
+   PInrecv   (tag,
+              buff,
+              mlen,
+              MSG_OTHER,
+              tag,
+              &waitHandle);
+
+   rslCHAMSaveWaitH (tag, waitHandle);
+ }
+
+/******************************************************
+ * rslCHAMWait (tag)
+ *  Wait for a pending send/recv
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslCHAMWait (tag, flag)
+ int tag, flag;
+ {
+ CHAM_Request waitHandle;
+ CHAM_Status status ;
+
+ rslCHAMFindWaitH (tag, &waitHandle );
+ if ( flag == 1 ) 		/* receive */
+   CHAM_Wait ( &waitHandle, &status  );
+ else				/* send */
+   CHAM_Wait ( &waitHandle, &status  );
+ }
+
+#endif /* __CHAM_COMPAT__ */
+#endif /* CHAM */
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_child_info.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_child_info.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_child_info.c	(revision 2744)
@@ -0,0 +1,168 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* given a coarse domain point and nest index within it, return
+   its nest coords */
+RSL_CHILD_INFO ( d_p, n_p, ig_p, jg_p, cm_p, cn_p, ni_p, nj_p, nig_p, njg_p )
+  int_p d_p, n_p, ig_p, jg_p, cm_p, cn_p ;      /* input */ 
+  int_p ni_p, nj_p, nig_p, njg_p ; 				/* output */
+{
+  int d, nst ;
+  int kidid ;
+  rsl_domain_info_t *ninfo, *dinfo ;
+  rsl_point_t *ndomain, *ddomain ;
+  int ig, jg, cn, cm, mlen, nlen, irax_n, irax_m ;
+
+  d = *d_p ;
+  nst = *n_p ;
+  RSL_TEST_ERR( d < 0 || d > RSL_MAXDOMAINS,
+    "rsl_child_info: bad parent domain descriptor" ) ;
+  RSL_TEST_ERR( nst < 0 || nst > RSL_MAXDOMAINS,
+    "rsl_child_info: bad nested domain descriptor" ) ;
+  RSL_TEST_ERR( d == nst,
+    "rsl_child_info: domain cannot broadcast to itself" ) ;
+  RSL_TEST_ERR( domain_info[nst].parent != d ,
+    "rsl_child_info: the nest is not a child of the parent" ) ;
+
+  dinfo = &( domain_info[d]) ;
+  ninfo = &( domain_info[nst]) ;
+  RSL_TEST_ERR( dinfo->valid != RSL_VALID,
+    "rsl_child_info: invalid parent domain" ) ;
+  RSL_TEST_ERR( ninfo->valid != RSL_VALID,
+    "rsl_child_info: invalid nested domain" ) ;
+  ddomain = dinfo->domain ;
+  ndomain = ninfo->domain ;
+
+  ig = *ig_p ;
+  jg = *jg_p ;
+  cn = *cn_p ;
+  cm = *cm_p ;
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+  irax_n = dinfo->irax_n ;
+  irax_m = dinfo->irax_m ;
+
+  *nig_p = RSL_INVALID ;
+  *njg_p = RSL_INVALID ;
+  *ni_p = RSL_INVALID ;
+  *nj_p = RSL_INVALID ;
+
+  if ( ddomain[INDEX_2(jg,ig,mlen)].children_p != NULL )
+  {
+    kidid = ddomain[INDEX_2(jg,ig,mlen)].children_p->
+		    child[INDEX_2(cn,cm,irax_m)] ;
+    *nig_p = ID_IDEX(kidid) ;
+    *njg_p = ID_JDEX(kidid) ;
+    *ni_p = *nig_p + ninfo->idif ;
+    *nj_p = *njg_p + ninfo->jdif ;
+  }
+  return ;
+}
+
+/* given a nested domain pt, return its coarse domain coords and
+   position within the cd cell */
+RSL_CHILD_INFO1 ( d_p, n_p, nig_p, njg_p, cm_p, cn_p, i_p, j_p, ig_p, jg_p )
+  int_p d_p, n_p, nig_p, njg_p ; /* input */
+  int_p cm_p, cn_p, i_p, j_p, ig_p, jg_p ; /* output */
+{
+  int d, nst ;
+  int mid ;
+  rsl_domain_info_t *ninfo, *dinfo ;
+  rsl_point_t *ndomain, *ddomain ;
+  int nig, njg, cn, cm, mlen, nlen, irax_n, irax_m ;
+
+  d = *d_p ;
+  nst = *n_p ;
+  RSL_TEST_ERR( d < 0 || d > RSL_MAXDOMAINS,
+    "rsl_child_info1: bad parent domain descriptor" ) ;
+  RSL_TEST_ERR( nst < 0 || nst > RSL_MAXDOMAINS,
+    "rsl_child_info1: bad nested domain descriptor" ) ;
+  RSL_TEST_ERR( d == nst,
+    "rsl_child_info1: domain cannot broadcast to itself" ) ;
+  RSL_TEST_ERR( domain_info[nst].parent != d ,
+    "rsl_child_info1: the nest is not a child of the parent" ) ;
+
+  dinfo = &( domain_info[d]) ;
+  ninfo = &( domain_info[nst]) ;
+  RSL_TEST_ERR( dinfo->valid != RSL_VALID,
+    "rsl_child_info1: invalid parent domain" ) ;
+  RSL_TEST_ERR( ninfo->valid != RSL_VALID,
+    "rsl_child_info1: invalid nested domain" ) ;
+  ddomain = dinfo->domain ;
+  ndomain = ninfo->domain ;
+
+  nig = *nig_p ;
+  njg = *njg_p ;
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+  irax_n = dinfo->irax_n ;
+  irax_m = dinfo->irax_m ;
+
+  mid = ndomain[INDEX_2(njg,nig,mlen)].mother_id ;
+  *ig_p = ID_IDEX(mid) ;
+  *jg_p = ID_JDEX(mid) ;
+  *i_p = *ig_p + dinfo->idif ;
+  *j_p = *jg_p + dinfo->jdif ;
+  *cn_p = ndomain[INDEX_2(njg,nig,mlen)].which_kid_am_i_n ;
+  *cm_p = ndomain[INDEX_2(njg,nig,mlen)].which_kid_am_i_m ;
+
+  return ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_comm.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_comm.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_comm.h	(revision 2744)
@@ -0,0 +1,359 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+
+
+#ifndef RSL_COMM_H
+#define RSL_COMM_H
+
+/* #define STUBS */
+
+/***********************************************************************
+Below is a mapping of the message passing macros that are used in RSL,
+the library package that supports the model (there is no explicit
+message passing in the model code itself -- all of that is encapsulated
+within RSL).
+
+# define RSL_OPEN0(A,B)          open0_( &(A), &(B), &rsl_idum )
+# define RSL_CLOSE0()            close0_()
+# define RSL_WHO(A,B)           who0_( &(A), &(B), &rsl_idum )
+# define RSL_RECV(A,B,C)        recv0_( A, &(B), &(C) )
+# define RSL_SEND(A,B,C,D)      send0_( A, &(B), &(C), &(D) )
+# define RSL_RECVBEGIN(A,B,C)   recvbegin0_( A, &(B), &(C) )
+# define RSL_SENDBEGIN(A,B,C,D) sendbegin0_( A, &(B), &(C), &(D) )
+# define RSL_RECVEND(A)         recvend0_( &(A) )
+# define RSL_SENDEND(A)         sendend0_( &(A) )
+# define RSL_PROBE(A,B)         rsl_probe_( &(A), B )
+
+In this particular fragment, the macros are defined to PICL calls, 
+but that is just incidental.
+
+RSL_OPEN0(A,B)
+RSL_CLOSE0()
+
+  This will map to whatever routine the underlying mp library requires
+  for startup and initialization/shutdown.  It can just be a noop if the
+  mp lib in use does not require initialization.  As far as RSL is concerned,
+  arguments A and B are dummys.
+
+RSL_WHO(A,B)
+
+  This will map to the informational routine in the mp library that
+  returns number of nodes in partition (returned as A) and the node
+  number of the local processor (returned as B).
+
+RSL_RECV(A,B,C)
+
+  This is the synchronous recv (like crecv in NX).  A is a pointer
+  to the buffer, B is the length in bytes, and C is the integer
+  message tag.
+
+RSL_SEND(A,B,C,D)
+
+  This is the synchronous send (like csend in NX).  A is a pointer
+  to the buffer, B is the length in bytes, and C is the integer
+  message tag.  D is the node number of the destination processor.
+
+RSL_RECVBEGIN(A,B,C)
+
+  This is the asynchronous version of RSL_RECV.  It records the message
+  descriptor returned by the OS, posts the receive and then returns
+  control to the calling program.  In NX is it implemented using
+  irecv.
+
+RSL_RECVEND(A)
+
+  This is the call the blocks until completion of the message started
+  with RSL_RECVBEGIN.  The argument, A, is the integer tag of the 
+  message (the third argument, C, of the original RSL_RECVBEGIN call).
+  Using the tag, the routine looks up the OS descriptor for the original
+  message and then issues the mp library call to block on that message
+  (in the case of NX, the routine called is msgwait).
+
+
+RSL_SENDBEGIN(A,B,C,D)
+ 
+  This is the asynchronous version of RSL_SEND.  It records the message
+  descriptor returned by the OS, posts the send and then returns
+  control to the calling program.  In NX is it implemented using
+  isend.
+  
+RSL_SENDEND(A)
+
+  This is the call the blocks until completion of the message started
+  with RSL_SENDBEGIN.  The argument, A, is the integer tag of the 
+  message (the third argument, C, of the original RSL_SENDBEGIN call).
+  Using the tag, the routine looks up the OS descriptor for the original
+  message and then issues the mp library call to block on that message
+  (in the case of NX, the routine called is msgwait).
+
+RSL_PROBE(A,B)
+
+  This maps to the mp library routine for checking on the status of
+  an asynchronously posted receive.  This is *not* currently in use
+  but may be needed at some point in the future.
+
+---
+
+John
+***********************************************************************/
+
+#ifdef STUBS
+
+# define RSL_OPEN0              {RSL_TEST_WRN(1,"COMMUNICATIONS STUBBED!");}
+# define RSL_CLOSE0()
+# define RSL_WHO(A,B)           { A = 1 ; B = 0 ; }
+# define RSL_RECV(A,B,C)
+# define RSL_SEND(A,B,C,D)
+# define RSL_RECVBEGIN(A,B,C)
+# define RSL_SENDBEGIN(A,B,C,D)
+# define RSL_RECVEND(A)
+# define RSL_SENDEND(A)
+# define RSL_PROBE(A,B)         { *(B) = 1 ; }
+
+#else
+#ifdef PGON
+
+# define RSL_OPEN0(A,B)         rslNXInit()
+# define RSL_CLOSE0
+# define RSL_WHO(A,B)           { A = numnodes(); B = mynode(); }
+# define RSL_RECV(A,B,C)        crecv ((long)(C),A,(long)(B))
+# define RSL_SEND(A,B,C,D)      csend ((long)(C),A,(long)(B),(long)(D),(long)0)
+# define RSL_RECVBEGIN(A,B,C)   rslNXIRecv ( A, B, C )
+# define RSL_SENDBEGIN(A,B,C,D) rslNXISend ( A, B, C, D )
+# define RSL_RECVEND(A)         rslNXWait ( A )
+# define RSL_SENDEND(A)         rslNXWait ( A )
+# define RSL_PROBE(A,B)         rslNXProbe ( A, B )
+/* # define RSL_PROBE(A,B)         (*(B) = (iprobe ( A ) == 1)) */
+
+#else
+#ifdef MPL
+/* map down to native MPL primitives of SP[12] */
+
+#    ifdef __MPL_COMPAT__
+       int rsl_mp_source ;
+       int rsl_mp_nbytes ;
+       int rsl_mp_n ;
+       int rsl_mp_type ;
+
+       int dontcare ;
+       int allmsg ;
+       int nulltask ;
+       int allgrp ;
+       int type_low ;
+       int type_high ;
+
+#    else
+       extern int rsl_mp_source ;
+       extern int rsl_mp_nbytes ;
+       extern int rsl_mp_type ;
+       extern int rsl_mp_n ;
+
+       extern int dontcare ;
+       extern int allmsg ;
+       extern int nulltask ;
+       extern int allgrp ;
+       extern int type_low ;
+       extern int type_high ;
+
+#    endif
+
+# define RSL_OPEN0(A,B)         rslMPLInit()
+# define RSL_CLOSE0()
+# define RSL_WHO(A,B)           mpc_environ( &(A), &(B) )
+
+# define RSL_RECV(A,B,C)  \
+  { int rc ; \
+    rsl_mp_source = dontcare ;\
+    rsl_mp_type   = C ;\
+    rsl_mp_n      = B ;\
+    if ( rsl_mp_type < type_low || rsl_mp_type > type_high )	\
+    { \
+      sprintf(mess,"RSL_RECV message type %d out of allowed range: %d..%d\n", \
+      rsl_mp_type,type_low,type_high) ; \
+      RSL_TEST_ERR( 1, mess ) ; \
+    } \
+    rc = mpc_brecv(A,rsl_mp_n,               \
+                   &rsl_mp_source,            \
+                   &rsl_mp_type,              \
+                   &rsl_mp_nbytes) ;  \
+    if ( rc ) {fprintf(stderr,"mpc_brecv returns %d\n",rc);exit(1);} \
+    if ( rsl_mp_nbytes > (B) ) 	\
+    {				\
+      fprintf(stderr,"Message too large: tag %d, recvd %d, allocated %d\n", \
+ 	      C,rsl_mp_nbytes,(B));	\
+    }  \
+  }
+
+# define RSL_SEND(A,B,C,D)       \
+  { \
+    int rc ; \
+    rsl_mp_type = C ; \
+    if ( rsl_mp_type < type_low || rsl_mp_type > type_high )	\
+    { \
+      sprintf(mess,"RSL_SEND message type %d out of allowed range: %d..%d\n", \
+      rsl_mp_type,type_low,type_high) ; \
+      RSL_TEST_ERR( 1, mess ) ; \
+    } \
+    if (0) fprintf(stderr,"mpc_bsend: nlen %10d  type %10d  dest %10d\n", \
+                   B, rsl_mp_type, D ) ; \
+    rc = mpc_bsend(A,B,D,C) ; \
+    if ( rc ) {fprintf(stderr,"mpc_bsend returns %d\n",rc);exit(1);} \
+  }
+
+# define RSL_RECVBEGIN(A,B,C)   rslMPLIRecv ( A, B, C )
+# define RSL_SENDBEGIN(A,B,C,D) rslMPLISend ( A, B, C, D )
+# define RSL_RECVEND(A)         rslMPLWait ( A )
+# define RSL_SENDEND(A)         rslMPLWait ( A )
+# define RSL_PROBE(A,B)         rslMPLProbe( A, B )
+
+#else
+#ifdef MPI
+
+#    include "mpi.h"
+/* EXTERN is defined in rsl.h */
+
+EXTERN MPI_Comm rsl_mpi_communicator ;
+
+#    ifdef __MPI_COMPAT__
+       MPI_Status mpi_status ;
+#    else
+       extern MPI_Status mpi_status ;
+#    endif
+
+# define RSL_OPEN0(A,B)         rslMPIInit() 
+# define RSL_CLOSE0()           MPI_Finalize()
+# define RSL_WHO(A,B)           rslMPIWho( &(A), &(B) )
+
+# define RSL_RECV(A,B,C)  \
+{ \
+MPI_Recv(A,B,MPI_BYTE,MPI_ANY_SOURCE,C,rsl_mpi_communicator,&mpi_status) ; \
+}
+
+# define RSL_SEND(A,B,C,D)      MPI_Send(A,B,MPI_BYTE,D,C,rsl_mpi_communicator)
+# define RSL_RECVBEGIN(A,B,C)   rslMPIIRecv ( A, B, C )
+# define RSL_SENDBEGIN(A,B,C,D) rslMPIISend ( A, B, C, D )
+# define RSL_RECVEND(A)         rslMPIWait ( A )
+# define RSL_SENDEND(A)         rslMPIWait ( A )
+# define RSL_PROBE(A,B)         /* rslMPITest ( A, B ) */
+
+#else
+#ifdef CHAMELEON
+
+#include "tools.h" 
+#include "comm/comm.h"
+
+#   define RSL_OPEN0(A,B)         rslCHAMInit()
+#   define RSL_CLOSE0
+#   define RSL_WHO(A,B)           who0_( &(A), &(B), &rsl_idum )
+#   define RSL_RECV(A,B,C)        PIbrecv( C, A, B, MSG_OTHER )
+#   define RSL_SEND(A,B,C,D)      PIbsend( C, A, B, D, MSG_OTHER )
+#   define RSL_RECVBEGIN(A,B,C)   rslCHAMRecv( A, B, C )
+#   define RSL_SENDBEGIN(A,B,C,D) rslCHAMSend( A, B, C, D )
+#   define RSL_RECVEND(A)         rslCHAMWait( A, 1 )
+#   define RSL_SENDEND(A)         rslCHAMWait( A, 0 )
+#   define RSL_PROBE(A,B)         ( &(A), B )
+
+
+else
+
+# ifndef NOUNDERSCORE
+
+#   ifdef CHAMELEON_PICL
+#     define RSL_OPEN0(A,B)    /* a noop */
+#   else
+#     define RSL_OPEN0(A,B)        open0_( &(A), &(B), &rsl_idum )
+#   endif
+#   define RSL_CLOSE0
+#   define RSL_WHO(A,B)           who0_( &(A), &(B), &rsl_idum )
+#   define RSL_RECV(A,B,C)        recv0_( A, &(B), &(C) )
+#   define RSL_SEND(A,B,C,D)      send0_( A, &(B), &(C), &(D) )
+#   define RSL_RECVBEGIN(A,B,C)   recvbegin0_( A, &(B), &(C) )
+#   define RSL_SENDBEGIN(A,B,C,D) sendbegin0_( A, &(B), &(C), &(D) )
+#   define RSL_RECVEND(A)         recvend0_( &(A) )
+#   define RSL_SENDEND(A)         sendend0_( &(A) )
+#   define RSL_PROBE(A,B)         rsl_probe_( &(A), B )
+
+
+# else
+
+#   ifdef CHAMELEON_PICL_ooo
+#     define RSL_OPEN0(A,B)    /* a noop */
+#   else
+#     define RSL_OPEN0(A,B)        open0( &(A), &(B), &rsl_idum )
+#   endif
+#   define RSL_CLOSE0
+#   define RSL_WHO(A,B)           who0( &(A), &(B), &rsl_idum )
+#   define RSL_RECV(A,B,C)        recv0( A, &(B), &(C) )
+#   define RSL_SEND(A,B,C,D)      send0( A, &(B), &(C), &(D) )
+#   define RSL_RECVBEGIN(A,B,C)   recvbegin0( A, &(B), &(C) )
+#   define RSL_SENDBEGIN(A,B,C,D) sendbegin0( A, &(B), &(C), &(D) )
+#   define RSL_RECVEND(A)         recvend0( &(A) )
+#   define RSL_SENDEND(A)         sendend0( &(A) )
+#   define RSL_PROBE(A,B)         rsl_probe( &(A), B )
+
+# endif  /* NOUNDERSCORE */
+
+#endif  /* CHAMELEON */
+#endif  /* MPI */
+#endif  /* MPL */
+#endif  /* PGON */
+#endif  /* STUBS */
+
+
+
+#endif  /* nothing after this line */
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_debug.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_debug.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_debug.c	(revision 2744)
@@ -0,0 +1,69 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+RSL_DEBUG ( setget, flg )
+  int *setget, *flg ;
+{
+  if ( *setget == 1 )
+    rsl_debug_flg = *flg ;
+  else
+    *flg = rsl_debug_flg ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_error_dup.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_error_dup.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_error_dup.c	(revision 2744)
@@ -0,0 +1,169 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+/* redirect standard error from process into a file */
+/* also redirect standard output to a file */
+
+#include <stdio.h>
+#ifdef SEQUENT
+#include <sys/file.h>
+#else
+#include <fcntl.h>
+#endif
+
+#include "rsl.h"
+
+#define STANDARD_ERROR 2
+
+#define STANDARD_OUTPUT 1
+
+/*@
+  RSL_ERROR_DUP --- Redirect standard out and error on each proc.
+
+  Notes:
+  This routine redirects the standard and error outputs to a 
+  unique pair of files for each processor.  The file names generated
+  are rsl.out.dddd and rsl.error.dddd, where dddd is the 4-digit
+  zero-padded processor number.  RSL\_INITIALIZE must be called before
+  this routine.
+
+  See also:
+  RSL\_INITIALIZE, RSL\_MESH
+@*/
+
+RSL_ERROR_DUP () 
+{
+    int newfd ;
+    char filename[256] ;
+
+    int *me ;
+
+    me = &rsl_myproc ;
+
+/* redirect standard out*/
+    sprintf(filename,"rsl.out.%04d",*me) ;
+    if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
+    {
+	perror("error_dup: cannot open rsl.out.nnnn") ;
+	fprintf(stderr,"...sending output to standard output and continuing.\n") ;
+	return ;
+    }
+    if( dup2( newfd, STANDARD_OUTPUT ) < 0 )
+    {
+	perror("error_dup: dup2 fails to change output descriptor") ;
+	fprintf(stderr,"...sending output to standard output and continuing.\n") ;
+	close(newfd) ;
+	return ;
+    }
+
+/* redirect standard error */
+    sprintf(filename,"rsl.error.%04d",*me) ;
+    if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
+    {
+	perror("error_dup: cannot open rsl.error.log") ;
+	fprintf(stderr,"...sending error to standard error and continuing.\n") ;
+	return ;
+    }
+    if( dup2( newfd, STANDARD_ERROR ) < 0 )
+    {
+	perror("error_dup: dup2 fails to change error descriptor") ;
+	fprintf(stderr,"...sending error to standard error and continuing.\n") ;
+	close(newfd) ;
+	return ;
+    }
+
+}
+
+RSL_ERROR_DUP1 ( int *me )
+{
+    int newfd ;
+    char filename[256] ;
+
+/* redirect standard out*/
+    sprintf(filename,"rsl.out.%04d",*me) ;
+    if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
+    {
+        perror("error_dup: cannot open rsl.out.nnnn") ;
+        fprintf(stderr,"...sending output to standard output and continuing.\n") ;
+        return ;
+    }
+    if( dup2( newfd, STANDARD_OUTPUT ) < 0 )
+    {
+        perror("error_dup: dup2 fails to change output descriptor") ;
+        fprintf(stderr,"...sending output to standard output and continuing.\n") ;
+        close(newfd) ;
+        return ;
+    }
+
+/* redirect standard error */
+    sprintf(filename,"rsl.error.%04d",*me) ;
+    if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
+    {
+        perror("error_dup: cannot open rsl.error.log") ;
+        fprintf(stderr,"...sending error to standard error and continuing.\n") ;
+        return ;
+    }
+    if( dup2( newfd, STANDARD_ERROR ) < 0 )
+    {
+        perror("error_dup: dup2 fails to change error descriptor") ;
+        fprintf(stderr,"...sending error to standard error and continuing.\n") ;
+        close(newfd) ;
+        return ;
+    }
+
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_fclose_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_fclose_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_fclose_f.F	(revision 2744)
@@ -0,0 +1,71 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine rsl_uclose( unit )
+      implicit none
+      integer unit, result
+
+      call rsl_c_iammonitor( result )
+      if ( result .ne. 1 ) then
+	return
+      endif
+c only execute on monitor
+      close( unit )
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_fopen_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_fopen_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_fopen_f.F	(revision 2744)
@@ -0,0 +1,75 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine rsl_uopen( unit, name, stat )
+      implicit none
+      integer unit, result
+      character*(*) name, stat
+
+      call rsl_c_iammonitor( result )
+      if ( result .ne. 1 ) then
+	return
+      endif
+c only execute on monitor
+      open( unit, file=name, form="unformatted", status=stat,
+     +      access="sequential",iostat=result, err=99 )
+      return
+  99  continue
+      write(0,*)'rsl_open_uread: error opening ',name,' iostat=',result
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_funit_close.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_funit_close.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_funit_close.F	(revision 2744)
@@ -0,0 +1,64 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+
+      subroutine rsl_funit_close( unit )
+      implicit none
+      integer unit
+      close( unit )
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_hemiforce.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_hemiforce.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_hemiforce.c	(revision 2744)
@@ -0,0 +1,538 @@
+#define KLUDGE_20000821
+
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_TO_OH_INFO -- Get the next cell in a packing sequence for forcing.
+
+  Notes:
+
+  See also:
+
+@*/
+
+static rsl_domain_info_t *s_tinfo, *s_oinfo ;
+static int s_oig, s_ojg ;
+static int s_p, s_t, s_o ;
+static int s_msize ;
+static struct rsl_hemi_rec * s_q, * s_q1 ;
+static int s_nlen_o ;
+static int s_mlen_o ;
+static rsl_point_t *s_tdomain, *s_odomain ;
+static char * s_pointbuf = NULL ;
+
+RSL_TO_OH_INFO ( t_p, o_p, msize_p, seed_p,
+                 oig_p, ojg_p, retval_p )
+  int_p
+     t_p            /* (I) RSL domain descriptor of this hemi. */
+    ,o_p            /* (I) RSL domain descriptor of other hemi. */
+    ,msize_p        /* (I) Message size in bytes. */
+    ,seed_p         /* (I) =1 start the traversal; =0 (zero) continue traversal */
+    ,oig_p          /* (O) Global M index of other domain point. */
+    ,ojg_p          /* (O) Global N index of other domain point. */
+    ,retval_p ;     /* (O) =1 if a valid point returned; =0 (zero) otherwise. */
+{
+  int kiddex ;
+  int P ;
+  rsl_hemi_rec_t * q ;
+#ifdef KLUDGE_20000821
+  rsl_hemi_rec_t * qnuke ;
+  rsl_hemi_rec_t * prev ;
+#endif
+  int p, p1 ;
+  int globalhemiPlist[RSL_MAXPROC][RSL_MAXPROC], work[RSL_MAXPROC][RSL_MAXPROC] ;
+
+#ifndef STUBS
+  s_msize = *msize_p ;
+  s_t = *t_p ;
+  s_o = *o_p ;
+  RSL_TEST_ERR( s_t < 0 || s_t > RSL_MAXDOMAINS,
+    "rsl_ready_bcast: bad 'this hemi' descriptor" ) ;
+  RSL_TEST_ERR( s_o < 0 || s_o > RSL_MAXDOMAINS,
+    "rsl_ready_bcast: bad 'other hemi' descriptor" ) ;
+  RSL_TEST_ERR( s_t == s_o,
+    "rsl_ready_bcast: hemispere cannot force itself" ) ;
+
+  s_tinfo = &( domain_info[s_t]) ;
+  s_oinfo = &( domain_info[s_o]) ;
+  s_mlen_o = s_oinfo->len_m ;
+  s_nlen_o = s_oinfo->len_n ;
+  s_odomain = s_oinfo->domain ;
+
+  if ( ! s_tinfo->other_hemi_proclist_built )
+  {
+    if ( *seed_p )
+    {
+      s_oig = 0 ; s_ojg = 0 ;
+      for ( p = 0 ; p < RSL_MAXPROC ; p++ )
+      {
+#ifdef KLUDGE_20000821
+        for ( q = s_tinfo->other_hemi_procbufs[p], prev = NULL ; q ; )
+        {
+           if ( q->data ) RSL_FREE( q->data ) ;
+           qnuke = q ;
+           q = q->next ;
+           RSL_FREE( qnuke ) ;
+        }
+#endif
+	s_tinfo->other_hemi_procbufs[p] = NULL ;
+	s_tinfo->hemi_sendPlist[p] = 0 ;
+        for ( p1 = 0 ; p1 < RSL_MAXPROC ; p1++ )
+	{
+	  globalhemiPlist[p][p1] = 0 ;
+	}
+      }
+    }
+    else
+    {
+      s_oig++ ;
+      if ( s_oig >= s_oinfo->len_m )
+      {
+        s_oig = 0 ;
+        s_ojg++ ;
+        if ( s_ojg >= s_oinfo->len_n )
+        {
+	  *retval_p = 0 ;
+#ifndef KLUDGE_20000821
+	  s_tinfo->other_hemi_proclist_built = 1 ; /* FIX 20000818 JM */
+ #endif
+
+/* collapse the list and keep only entries that have data associated */
+/* also fill entries for processors I must send to, indicating the number 
+   of columns that go to each processors, or zero for processors I don't
+   send to */
+          for ( p = 0 ; p < RSL_MAXPROC ; p++ )
+	  {
+	    rsl_hemi_rec_t * prev ;
+	    for ( q = s_tinfo->other_hemi_procbufs[p], prev = NULL ; q ; )
+	    {
+	      if ( q->data == NULL )
+	      {
+		if ( prev == NULL )
+		{
+		  s_tinfo->other_hemi_procbufs[p] = q->next ;
+		  RSL_FREE(q) ;
+		  q = s_tinfo->other_hemi_procbufs[p] ;
+		}
+		else if ( prev->next == q )
+		{
+		  prev->next = q->next ;
+		  RSL_FREE(q) ;
+		  q = prev->next ;
+		}
+		else
+		  RSL_TEST_ERR(1,"internal error") ;
+	      }
+	      else
+	      {
+		s_tinfo->hemi_sendPlist[p]++ ;
+		prev = q ;
+		q = q->next ;
+	      }
+	    }
+	  }
+
+	  /* mpi all to all communication to share matrix of senders/receivers */
+	  MPI_Gather( s_tinfo->hemi_sendPlist, RSL_MAXPROC, MPI_INT,
+                      globalhemiPlist, RSL_MAXPROC, MPI_INT, 
+                      0, rsl_mpi_communicator ) ;
+	  /* transpose */
+	  for ( p = 0 ; p < RSL_MAXPROC ; p++ )
+	    for ( p1 = 0 ; p1 < RSL_MAXPROC ; p1++ )
+	      work[p][p1] = globalhemiPlist[p1][p] ;
+	  for ( p = 0 ; p < RSL_MAXPROC ; p++ )
+	    for ( p1 = 0 ; p1 < RSL_MAXPROC ; p1++ )
+	      globalhemiPlist[p][p1] = work[p][p1] ;
+	  MPI_Scatter( globalhemiPlist, RSL_MAXPROC, MPI_INT, 
+                       s_tinfo->hemi_recvPlist, RSL_MAXPROC, MPI_INT,
+                       0, rsl_mpi_communicator ) ;
+
+	  return ;       /* EARLY RETURN */
+        }
+      }
+    }
+    kiddex = INDEX_2(s_ojg,s_oig,s_mlen_o) ;
+    P = s_odomain[ kiddex ].P ;
+    if ( s_tinfo->other_hemi_procbufs[P] == NULL )
+    {
+      q = RSL_MALLOC( rsl_hemi_rec_t, 1 ) ;
+    }
+    else
+    {
+      q = RSL_MALLOC( rsl_hemi_rec_t, 1 ) ;
+      q->next = s_tinfo->other_hemi_procbufs[P] ;
+    }
+    q->oig = s_oig ;
+    q->ojg = s_ojg ;
+    q->data = NULL ;
+    s_tinfo->other_hemi_procbufs[P] = q ;
+    s_q1 = q ;
+  }
+  else
+  {
+    int * x ;
+    if ( *seed_p )
+    {
+      s_p = -1 ;
+      s_q = NULL ;
+    }
+    if ( s_q == NULL )
+    {
+      s_p++ ;
+      while ( s_tinfo->other_hemi_procbufs[s_p] == NULL ) s_p++ ;
+      if ( s_p >= rsl_nproc_all )
+      {
+	*retval_p = 0 ;
+	return ;       /* EARLY RETURN */
+      }
+      s_q = s_tinfo->other_hemi_procbufs[s_p] ;
+    }
+    s_oig = s_q->oig ;
+    s_ojg = s_q->ojg ;
+    s_q1 = s_q ;
+    s_q = s_q->next ;
+  }
+  *oig_p = s_oig + 1 ;  /* C to Fortran */
+  *ojg_p = s_ojg + 1 ;  /* C to Fortran */
+  *retval_p = 1 ;
+#else
+   RSL_TEST_ERR( 1, "RSL_TO_OH_INFO STUBBED" ) ;
+#endif
+  return ;
+}
+
+/*@
+  RSL_TO_OH_MSG -- Pack force data into a message for a nest point.
+
+  Notes:
+  See also:
+
+@*/
+
+RSL_TO_OH_MSG ( nbuf_p, buf )
+  int_p
+    nbuf_p ;     /* (I) Number of bytes to be packed. */
+  char *
+    buf ;        /* (I) Buffer containing the data to be packed. */
+{
+  int kiddex ;
+  int nbuf ;
+  int P ;
+
+  RSL_TEST_ERR(buf==NULL,"2nd argument is NULL.  Field allocated?") ;
+  nbuf = *nbuf_p ;
+  if ( s_q1->data == NULL )
+  {
+    s_q1->data = RSL_MALLOC( char, s_msize ) ;
+    s_q1->curs = 0 ;
+  }
+  if ( s_q1->curs+nbuf >= s_msize )
+  {
+    sprintf(mess,"RSL_TO_OH_MSG: store of %d bytes would overflow %d sized buffer.\n",nbuf,s_msize ) ;
+    RSL_TEST_ERR(1,mess) ;
+  }
+  bcopy( buf, &(s_q1->data[s_q1->curs]), nbuf ) ;
+  s_q1->curs += nbuf ;
+}
+
+/*@
+  RSL_FORCE_HEMI -- Convey forcing data from this hemi to other hemi
+
+  Notes:
+
+  See also:
+@*/
+
+RSL_FORCE_HEMI ()
+{
+  int P ;
+  int msglen, mdest, mtag ;
+  int ii ;
+  int ig, jg ;
+  char * recvbuf, * sendbuf ;
+  rsl_hemi_rec_t * q ;
+
+  /* post receives */
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    if ( s_tinfo->hemi_recvPlist[P] > 0 )
+    {
+      msglen = s_msize * s_tinfo->hemi_recvPlist[P] + 3*sizeof(int) ;
+      recvbuf = buffer_for_proc( P, msglen,  RSL_RECVBUF ) ;
+      mtag = MTYPE_FROMTO( MSG_FROM_PARENT, P, rsl_myproc ) ;
+#ifdef DEBUGGAL
+fprintf(stderr,"Posting receive on tag %d\n",mtag ) ;
+#endif
+      RSL_RECVBEGIN( recvbuf, msglen, mtag ) ;
+      s_tinfo->hemi_recv_tags[P] = mtag ; /* store tag */
+    }
+  }
+
+  /* do sends */
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+#ifdef DEBUGGAL
+fprintf(stderr,"s_tinfo->hemi_sendPlist[P] %d\n",s_tinfo->hemi_sendPlist[P]) ;
+#endif
+    if ( s_tinfo->hemi_sendPlist[P] > 0 )
+    {
+      int curs ;
+      int endofdata ;
+	  
+	  /* oig,ojg,nbytes,buffer * # of points + end of data */
+      msglen = (3*sizeof(int)+s_msize)*s_tinfo->hemi_sendPlist[P]+1*sizeof(int) ;
+      sendbuf = buffer_for_proc( P, msglen,  RSL_SENDBUF ) ;
+      curs = 0 ;
+      for ( q = s_tinfo->other_hemi_procbufs[P] ; q ; q = q->next )
+      {
+#ifdef DEBUGGAL
+{
+int *dp ;
+dp = (int *) q->data ;
+fprintf(stderr,"> curs %d, msglen %d msize %d (%d %d) data %d\n", curs, msglen, s_msize, q->oig, q->ojg, *dp ) ;
+}
+#endif
+        bcopy( &(q->oig), &(sendbuf[curs]), sizeof(int)) ; curs += sizeof(int) ;
+        bcopy( &(q->ojg), &(sendbuf[curs]), sizeof(int)) ; curs += sizeof(int) ;
+        bcopy( &(q->curs), &(sendbuf[curs]), sizeof(int)) ; curs += sizeof(int) ;
+        bcopy( q->data, &(sendbuf[curs]), q->curs) ; curs += q->curs ;
+      }
+      endofdata = RSL_INVALID ;
+      bcopy( &endofdata, &(sendbuf[curs]), sizeof(int)) ; curs += sizeof(int) ;
+      mtag = MTYPE_FROMTO( MSG_FROM_PARENT, rsl_myproc, P ) ;
+#ifdef DEBUGGAL
+fprintf(stderr,"sending sendbuf to %d, curs = %d\n",P,curs) ;
+#endif
+      RSL_SEND( sendbuf, curs, mtag, P ) ;
+    }
+  }
+}
+
+/*@
+  RSL_FROM_TH_INFO -- Get the next cell in a unpacking sequence for forcing.
+
+  Notes:
+
+  See also:
+@*/
+
+static int s_endofdata, s_remaining, s_ndata, s_curs ;
+static char * s_recvbuf ;
+
+RSL_FROM_TH_INFO ( seed_p, oig_p, ojg_p, retval_p )
+  int_p
+    seed_p      /* (I) =1 if first call; =0 otherwise */
+   ,oig_p        /* (O) Global index in M dimension of nest. */
+   ,ojg_p        /* (O) Global index in N dimension of nest. */
+   ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
+{
+  int mtag ;
+
+#ifdef DEBUGGAL
+fprintf(stderr,"RSL_FROM_TH_INFO seed = %d, s_endofdata %d\n",*seed_p,s_endofdata) ;
+#endif
+
+  if ( *seed_p == 1 )
+  {
+    if ( s_pointbuf != NULL ) RSL_FREE(s_pointbuf) ;
+    s_pointbuf = RSL_MALLOC( char, 2*s_msize ) ;  /* 2 times for safety */
+    s_p = 0 ;
+    s_endofdata = 1 ;
+  }
+
+nextproc:
+  if ( s_endofdata )
+  {
+    while ( s_tinfo->hemi_recvPlist[s_p] <= 0 ) s_p++ ;
+    if ( s_p >= rsl_nproc_all )
+    {
+      *retval_p = 0 ;
+#ifdef DEBUGGAL
+fprintf(stderr,"EARLY RETURN retval = 0\n") ;
+#endif
+      return ;          /* EARLY RETURN */
+    }
+    mtag = s_tinfo->hemi_recv_tags[s_p] ;
+#ifdef DEBUGGAL
+fprintf(stderr,"Waiting for receive on tag %d\n",mtag ) ;
+#endif
+    RSL_RECVEND ( mtag ) ;
+#ifdef DEBUGGAL
+fprintf(stderr,"got receive\n") ;
+#endif
+    s_recvbuf = buffer_for_proc( s_p, 0, RSL_RECVBUF ) ;
+    s_p++ ;
+    s_curs = 0 ;
+    s_endofdata = 0 ;
+  }
+
+#ifdef DEBUGGAL
+fprintf(stderr,"before bcopy  %d, s_recvbuf %08x\n",s_curs, s_recvbuf) ;
+#endif
+
+  bcopy ( &(s_recvbuf[s_curs]), oig_p, sizeof(int) ) ; s_curs += sizeof(int) ;
+  if ( *oig_p == RSL_INVALID )
+  {
+#ifdef DEBUGGAL
+fprintf(stderr,"hit end of data for s_p %d, %d\n", s_p, *oig_p ) ;
+#endif
+    s_endofdata = 1 ;
+    goto nextproc ;
+  }
+  bcopy ( &(s_recvbuf[s_curs]), ojg_p, sizeof(int) ) ; s_curs += sizeof(int) ;
+  bcopy ( &(s_recvbuf[s_curs]), &s_ndata, sizeof(int) ) ; s_curs += sizeof(int) ;
+  bcopy ( &(s_recvbuf[s_curs]), s_pointbuf, s_ndata ) ; s_curs += s_ndata ;
+  s_remaining = s_ndata ;
+#ifdef DEBUGGAL
+fprintf(stderr,"s_remaining = %d\n",s_remaining) ;
+#endif
+
+  (*oig_p) ++ ;
+  (*ojg_p) ++ ;
+#ifdef DEBUGGAL
+fprintf(stderr,"RETURN oig ojg %d %d\n", *oig_p, *ojg_p ) ;
+#endif
+  *retval_p = 1 ;
+  return ;
+}
+
+/*@
+  RSL_FROM_TH_MSG -- Unpack feedback data into a nest point.
+
+  Notes:
+
+@*/
+RSL_FROM_TH_MSG ( len_p, buf )
+  int_p
+    len_p ;          /* (I) Number of bytes to unpack. */
+  char *
+    buf ;            /* (O) Destination buffer. */
+{
+  if ( *len_p <= 0 ) return ;
+  if ( *len_p > s_remaining ) 
+  {
+    sprintf(mess,
+"RSL_FROM_TH_MSG:\n   Requested number of bytes (%d) exceeds %d, the number remaining for this point.\n", *len_p, s_remaining) ;
+    RSL_TEST_WRN(1,mess) ;
+  }
+  bcopy( &(s_pointbuf[s_ndata-s_remaining]),
+         buf,
+         *len_p ) ;
+
+  s_remaining -= *len_p ;
+}
+
+/* retval =1 if point is local, =0 otherwise */
+RSL_POINT_ON_PROC ( d_p, ig_p, jg_p, retval_p )
+  int_p d_p, ig_p, jg_p, retval_p ;
+{
+  int d ;
+  int kiddex ;
+  int P ;
+  int ig, jg ;
+
+  rsl_domain_info_t * info ;
+  rsl_point_t       * domain ;
+  ig = *ig_p - 1 ;
+  jg = *jg_p - 1 ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d > RSL_MAXDOMAINS,
+    "rsl_ready_bcast: bad 'this hemi' descriptor" ) ;
+  info = &( domain_info[d]) ;
+/* added 12/27/01 -- JM */
+  if ( ig < 0 || ig >= info->len_m ||
+       jg < 0 || jg >= info->len_n ) { *retval_p = 0 ; return ; }
+  domain = info->domain ;
+  kiddex = INDEX_2(jg,ig,info->len_m ) ;
+  P = domain[ kiddex ].P ;
+  *retval_p = 0 ;
+  if ( P == rsl_myproc ) *retval_p = 1 ;
+  return ;
+}
+
+/* given a global point, return the processor number */
+RSL_PROC_FOR_POINT ( d_p, ig_p, jg_p, retval_p )
+  int_p d_p, ig_p, jg_p, retval_p ;
+{
+  int d ;
+  int kiddex ;
+  int P ;
+  int ig, jg ;
+
+  rsl_domain_info_t * info ;
+  rsl_point_t       * domain ;
+  ig = *ig_p - 1 ;
+  jg = *jg_p - 1 ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d > RSL_MAXDOMAINS,
+    "rsl_point_on_proc: bad descriptor" ) ;
+  info = &( domain_info[d]) ;
+  domain = info->domain ;
+  kiddex = INDEX_2(jg,ig,info->len_m ) ;
+  *retval_p = domain[ kiddex ].P ;
+  return ;
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_init_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_init_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_init_f.F	(revision 2744)
@@ -0,0 +1,70 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine rsl_init_fortran ( nproc_all, nproc, myproc,
+     $              nproc_min, nproc_maj, ndom )
+      include 'rsl.inc'
+
+      rsl_nproc_all = nproc_all
+      rsl_nproc     = nproc
+      rsl_myproc    = myproc
+      rsl_nproc_min = nproc_min
+      rsl_nproc_maj = nproc_maj
+      rsl_ndomains  = ndom
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_initial.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_initial.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_initial.c	(revision 2744)
@@ -0,0 +1,359 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#undef AP1000
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_INITIALIZE - initialize the RSL package.
+
+  Notes:
+  This routine initializes the RSL package and must be called on each
+  processor before any other RSL routine.  Once RSL_INITIALIZE is called,
+  RSL_MON_BCAST and several other low-level informational RSL routines 
+  (e.g. RSL_IAMMONITOR)
+  may be used to broadcast configuration data read in on
+  processor zero to other processors.  Other RSL routines may not be
+  used until RSL_MESH has been called.
+
+  Example:
+
+$  program model
+$  integer intsize                     ! Size in bytes of an integer.
+$  parameter (intsize = 4)
+$  integer nproc_m, nproc_n            ! Number of processors in m, n.
+$  integer retval
+$  namelist /config/ nproc_m, nproc_n  ! Will be read in from namelist.
+
+$  call RSL_INITIALIZE                 ! Initialize RSL
+$  call RSL_IAMMONITOR( retval )       ! Read namelist on processor zero
+$  if ( retval .eq. 1 ) then
+$    read(10,config)
+$  endif
+$  call RSL_MON_BCAST( nproc_m, intsize )   ! Broadcast config to other procs.
+$  call RSL_MON_BCAST( nproc_n, intsize )   ! Broadcast config to other procs.
+$  call RSL_MESH( nproc_m, nproc_n )   ! All processors define processor mesh.
+$  ...                                 ! Rest of model.
+$  call RSL_SHUTDOWN                   ! Shutdown.
+$  stop
+$  end
+  
+BREAKTHEEXAMPLECODE
+
+  See also:
+  RSL_SHUTDOWN, RSL_MESH, RSL_MON_BCAST
+
+@*/
+RSL_INITIALIZE ()
+{
+  int s, o ;
+#ifndef STUBS
+  rslMPIInit() ;
+  rsl_mpi_communicator = MPI_COMM_WORLD ;
+#endif
+  rsl_initialize_internal() ;
+  s = 1 ; o = 0 ;
+  RSL_DEBUG( &s , &o ) ;
+  
+}
+
+#ifndef STUBS
+RSL_INITIALIZE1 ( MPI_Fint * comm )
+{
+  rsl_mpi_communicator = MPI_Comm_f2c( *comm ) ;
+  rsl_initialize_internal() ;
+}
+#else
+RSL_INITIALIZE1 ( int * comm )
+{
+  rsl_initialize_internal() ;
+}
+#endif
+
+rsl_initialize_internal()
+{
+  char name[256] ;
+  int d ;
+  int i ;
+  int rsl_default_decomp() ;		/* defined in cd.c */
+
+  for ( d = 0 ; d < RSL_MAXDOMAINS ; d++ )
+  {
+    domain_info[d].valid = RSL_INVALID ;
+  }
+  for ( i = 0 ; i < RSL_MAXDESCRIPTORS ; i++ ) mh_descriptors[i] = NULL ;
+  for ( i = 0 ; i < RSL_MAXDESCRIPTORS ; i++ ) sh_descriptors[i] = NULL ;
+  for ( i = 0 ; i < RSL_MAXDESCRIPTORS ; i++ ) xp_descriptors[i] = NULL ;
+  for ( i = 0 ; i < RSL_MAXDESCRIPTORS ; i++ ) pr_descriptors[i] = NULL ;
+  mh_descriptors[0] = (void*)1 ;  /* leave 0th one alone -- never use.
+				   this means that a message handle of
+				   zero is always an error */
+  rsl_ndomains = 0 ;
+  old_offsets = 0 ;
+
+#ifndef STUBS
+  rslMPIInit() ;
+
+  MPI_Comm_size( rsl_mpi_communicator , &rsl_nproc_all ) ;
+  MPI_Comm_rank( rsl_mpi_communicator , &rsl_myproc ) ;
+#else
+  rsl_nproc_all = 1 ;
+  rsl_myproc = 0 ;
+#endif
+
+/* John's patented brain substitute ; 5/3/2002 */
+  if ( rsl_nproc_all > RSL_MAXPROC )
+  {
+    sprintf(mess,"rsl_nproc_all (%d) > RSL_MAXPROC (%d). Recompile RSL with larger value.\n%s\n",rsl_nproc_all,RSL_MAXPROC,
+                 "(For WRF, change value of MAX_PROC in configure.wrf)"
+    ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+
+  rsl_nproc = rsl_nproc_all ; 	/* this may be reset by RSL_MESH */
+  rsl_padarea = RSL_DEFAULT_PADAREA ;
+  io_seq_monitor = 0 ;  /* OBS */
+  io_seq_compute = 1 ;  /* OBS */
+
+  regular_decomp = 0 ;
+  sw_allow_dynpad = 0 ;
+
+
+
+  RSL_INIT_FORTRAN ( &rsl_nproc_all, &rsl_nproc, &rsl_myproc,
+                     &rsl_nproc_m, &rsl_nproc_n, &rsl_ndomains ) ;
+
+#ifndef T3D
+  gethostname(name,255) ;
+  fprintf(stderr,"%s -- rsl_nproc_all %d, rsl_myproc %d\n",name,
+                  rsl_nproc_all, rsl_myproc ) ;
+#endif
+
+  RSL_F_SET_PADAREA ( &rsl_padarea ) ;
+
+  rsl_noprobe = (char *)getenv( "RSL_NOPROBE" ) ;
+  if ( rsl_noprobe != NULL && rsl_myproc == 0 )
+  {
+    if ( rsl_myproc == 0 ) 
+      fprintf(stderr,"Advisory: RSL_NOPROBE defined.  Won't probe.\n") ;
+  }
+
+  for (  d = 0 ; d < RSL_MAXDOMAINS ; d++ )
+  {
+    domain_info[d].valid = RSL_INVALID ;
+    domain_info[d].iruns = NULL ;
+    domain_info[d].domain = NULL ;
+    domain_info[d].bcast_Xlist = NULL ;
+    domain_info[d].merge_Xlist = NULL ;
+    { int p ;
+      for ( p = 0 ; p < MAX_KINDPAD ; p++ )
+      {
+        domain_info[d].js[p] = NULL ;
+        domain_info[d].is[p] = NULL ;
+        domain_info[d].ie[p] = NULL ;
+        domain_info[d].jg2n[p] = NULL ;
+        domain_info[d].is2[p] = NULL ;
+        domain_info[d].js2[p] = NULL ;
+        domain_info[d].je2[p] = NULL ;
+        domain_info[d].ig2n[p] = NULL ;
+      }
+    }
+    domain_info[d].is_write = RSL_INVALID ;
+    domain_info[d].ie_write = RSL_INVALID ;
+    domain_info[d].js_write = RSL_INVALID ;
+    domain_info[d].je_write = RSL_INVALID ;
+    domain_info[d].is_read = RSL_INVALID ;
+    domain_info[d].ie_read = RSL_INVALID ;
+    domain_info[d].js_read = RSL_INVALID ;
+    domain_info[d].je_read = RSL_INVALID ;
+
+  }
+
+  /* set up default decomposition fuctions */
+  SET_DEF_DECOMP_FCN ( rsl_default_decomp ) ;  /* defined in cd.c */
+  for (  d = 0 ; d < RSL_MAXDOMAINS ; d++ )
+  {
+    SET_DEF_DECOMP_INFO ( &d, NULL ) ;
+  }
+}
+
+/*@
+  RSL_SHUTDOWN - shut down the RSL package.
+
+  Notes:
+  This routine shuts down the RSL package at the end of the program
+  and should be called before program termination.
+
+  See also:
+  RSL_INITIALIZE, RSL_MESH
+
+@*/
+RSL_SHUTDOWN ()
+{
+  RSL_CLOSE0 () ;
+}
+
+/*@
+  RSL_MESH - specify a 2-dimensional mesh of processors for the RSL package.
+
+  Notes:
+  This routine is used to specify the two-dimensional mesh of processors.
+  RSL_INITIALIZE must have already been called.  RSL_MESH
+  must be called before any RSL domain has been defined.  Only RSL_MON_BCAST
+  will work prior to the call to RSL_MESH; this allows node zero to read
+  and broadcast to the other processors configuration information.
+  RSL_MESH must be called on all processors.
+
+  Example:
+$  program model
+$  integer intsize                     ! Size in bytes of an integer.
+$  parameter (intsize = 4)
+$  integer nproc_m, nproc_n            ! Number of processors in m, n.
+$  integer retval
+$  namelist /config/ nproc_m, nproc_n  ! Will be read in from namelist.
+$
+$  call RSL_INITIALIZE                 ! Initialize RSL
+$  call RSL_IAMMONITOR( retval )       ! Read namelist on processor zero
+$  if ( retval .eq. 1 ) then
+$    read(10,config)
+$  endif
+$  call RSL_MON_BCAST( nproc_m, intsize )   ! Broadcast config to other procs.
+$  call RSL_MON_BCAST( nproc_n, intsize )   ! Broadcast config to other procs.
+$  call RSL_MESH( nproc_m, nproc_n )   ! All processors define processor mesh.
+$  ...                                 ! Rest of model.
+$  call RSL_SHUTDOWN                   ! Shutdown.
+$  stop
+$  end
+BREAKTHEEXAMPLECODE
+
+  See also:
+  RSL_INITIALIZE, RSL_MON_BCAST, RSL_SHUTDOWN
+@*/
+RSL_MESH (nproc_m_p, nproc_n_p )
+  int_p 
+    nproc_m_p   /* (I) Number of processors decomposing M dimension. */
+   ,nproc_n_p   /* (I) Number of processors decomposing N dimension. */
+   ;
+{
+  char name[256] ;
+  int d ;
+  int i ;
+  int rsl_default_decomp() ;		/* defined in cd.c */
+
+  rsl_nproc_m = *nproc_m_p ;
+  rsl_nproc_n = *nproc_n_p ;
+  rsl_nproc = rsl_nproc_n * rsl_nproc_m ;
+
+  rsl_padarea = RSL_DEFAULT_PADAREA ;
+  io_seq_monitor = 0 ;  /* OBS */
+  io_seq_compute = 1 ;  /* OBS */
+
+  RSL_INIT_FORTRAN ( &rsl_nproc_all, &rsl_nproc, &rsl_myproc,
+                     &rsl_nproc_m, &rsl_nproc_n, &rsl_ndomains ) ;
+  RSL_F_SET_PADAREA ( &rsl_padarea ) ;
+  if ( rsl_nproc_all < rsl_nproc )
+  {
+    sprintf(mess,"RSL_MESH: %d is too few processors (need px*py=%d)",
+                 rsl_nproc_all, rsl_nproc ) ;
+    RSL_TEST_ERR( rsl_nproc_all < rsl_nproc, mess ) ;
+  }
+
+}
+
+/*@
+  RSL_OLD_OFFSETS -- Calculate local indices using old F77 MPMM strategy.
+
+  Notes:
+  This routine is provided for backward compatibility with the F77
+  parallel implementation of MM5, MPMM, which was developed
+  using an earlier version of RSL.  Call this routine after
+  RSL_INITIALIZE in the model to use this version of RSL with MPMM.
+
+  See also:
+  RSL_INITIALIZE
+
+@*/
+RSL_OLD_OFFSETS ()
+{
+  old_offsets = 1 ;
+}
+
+RSL_SET_REGULAR_DECOMP ()
+{
+  regular_decomp = 1 ;
+}
+
+RSL_GET_COMMUNICATOR ( communicator )
+  int_p  communicator ;  /* (O) return value with communicator from underlying mp layer (mpi probably) */
+{
+#ifdef MPI
+  *communicator = MPI_Comm_c2f( rsl_mpi_communicator ) ;
+#else
+  *communicator = 0 ;
+#endif
+}
+
+RSL_SET_COMMUNICATOR ( communicator )
+  int_p  communicator ;  /* (O) return value with communicator from underlying mp layer (mpi probably) */
+{
+#ifdef MPI
+  rsl_mpi_communicator = MPI_Comm_f2c( *communicator ) ;
+#endif
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_io.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_io.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_io.c	(revision 2744)
@@ -0,0 +1,1314 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_CLOSE - close a fortran unit
+
+  Synopsis:
+  RSL_CLOSE ( unit )
+  integer unit
+
+  Input parameters:
+. unit - unit number
+
+  Notes:
+  Used to close down a fortran unit number.  At present, RSL does
+  not provide a way of opening a named file, so RSL_CLOSE does
+  no do much except flush the identifier.
+
+@*/
+RSL_CLOSE ( unit_p )
+  int_p unit_p ;
+{
+/* this was added 7/27/94 to the monitor-less version.  It won't
+   work, as is, in the monitor/compute version. */
+  int i_am_monitor ;
+
+  RSL_C_IAMMONITOR ( &i_am_monitor ) ;
+  if ( i_am_monitor )
+  {
+    FORT_CLOSE ( unit_p ) ;
+  }
+}
+
+int io_debug = 0 ;
+
+enable_rsl_debug() { io_debug = 1 ; }
+disable_rsl_debug() { io_debug = 0 ; }
+
+/*@
+  
+
+  Notes:
+  Used to read in one record from an unformatted (binary) Fortran
+  file or from a globally dimensioned data structure in the memory
+  of the monitor processor (see RSL_IAMMONITOR).  The record should
+  contain an undecomposed two- or three-dimensional array.  As a result
+  of the read, the record is distributed according to the decomposition
+  in effect for the domain whose RSL descriptor is given as argument
+  Arg4.
+
+
+  The layout of the
+  array in memory is specified by Arg2, which may be
+
+  Verbatim:
+$     IO2D_IJ,
+$     IO2D_JI,
+$     IO3D_IJK, or
+$     IO3D_JIK
+BREAKTHEEXAMPLECODE
+
+  for reads from a file, or
+
+  Verbatim:
+$     IO2D_IJ_INTERNAL,
+$     IO2D_JI_INTERNAL,
+$     IO3D_IJK_INTERNAL, or
+$     IO3D_JIK_INTERNAL
+BREAKTHEEXAMPLECODE
+
+  for reads from the memory of the monitor processor.  The constants
+  are defined in the header file rsl.inc.
+
+
+  Internal reads are useful 
+  for distributing the results
+  from global calculations performed on the monitor node.
+  Although this is not a scalable technique --- communication from
+  the monitor processor becomes a bottleneck --- it is often practical
+  and much simpler to implement for operations that are performed
+  only once during initialization, or infrequently.
+
+  For internal reads, instead of a unit number,
+  the first argument is the global (undecomposed)
+  data structure from which the data is to be read and distributed.
+  The data must actually populated the data structure only on the
+  monitor processor (the other processors treat the first argument
+  as a dummy).  The monitor distributes the data and, on return
+  from the read, the local (decomposed) portion of the array 
+  is returned as Arg3 on each processor.
+
+  IO2D_IJ specifies a two-dimensional array
+  whose minor dimension is M.  IO3D_JI specifies a two-dimensional array
+  whose minor dimension is N.  (This is as
+  as specified in the call to the routine that created or spawned
+  the domain; e.g., RSL_MOTHER_DOMAIN).
+
+  The type argument specifies the data type of an array element and
+  may be one of
+  Verbatim:
+$     RSL_REAL,
+$     RSL_DOUBLE,
+$     RSL_COMPLEX,
+$     RSL_INTEGER, or
+$     RSL_CHARACTER.  
+BREAKTHEEXAMPLECODE
+
+  The Arg6 array should contain the global (undecomposed) size of
+  each dimension in order from minor to major.  The first element of
+  glen is the size of the minor dimension.  The Arg7 array should
+  contain the size of each dimension as statically declared on the
+  processor.
+
+  Example:
+$ C Example 1, reading from a file
+$ C
+$    #include "rsl.inc"
+$       real ua(mix,mjx,mkx)
+$       integer glen(3), llen(3)
+$       glen(1) = il
+$       glen(2) = jl
+$       glen(3) = mkx
+$       llen(1) = mix
+$       llen(2) = mjx
+$       llen(3) = mkx
+$ C
+$       call rsl_read( 10, IO3D_IJK, ua, did,
+$     +               RSL_REAL, glen, llen )
+$ C
+BREAKTHEEXAMPLECODE
+
+  In the example a three-dimensional field, ua, is read in
+  from Fortran unit 10 on 
+  domain DID.
+  GLEN(1) and GLEN(2) are set to the global sizes of the two
+  horizontal dimensions.
+  LLEN(1) and LLEN(2) are set to the
+  static sizes of the local array (mix, mjx, and mkx are 
+  Fortran parameters).
+
+  See also:
+  RSL_WRITE
+
+@*/
+RSL_READ ( unit_p, iotag_p, base, d_p, type_p, glen, llen  )
+  int_p
+    unit_p              /* (I) Fortran I/O unit number. */
+   ,iotag_p ;           /* (I) RSL I/O code. */
+  char *
+    base ;              /* (O) Buffer. */
+  int_p
+    d_p                 /* (I) RSL domain descriptor */
+   ,type_p ;            /* (I) RSL data type code. */
+  int
+    glen[]              /* (I) Global dimension information. */
+   ,llen[] ;            /* (I) Local dimension information. */
+{
+  rsl_read_req_t request ;
+  rsl_read_resp_t resp ;
+  rsl_processor_t me ;
+  int cursor, mdest, mtag, msglen, dim, d ;
+  int mlen, nlen, minelems, majelems ;
+  unsigned long ig, jg, min, maj, ioffset, joffset, tlen, k ;
+  void *dex ;
+  char *pbuf ;
+  int i_am_monitor ;
+  rsl_point_t *domain ;
+  int iotag ;
+
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_read: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_read: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+  mlen = domain_info[d].len_m ;
+  nlen = domain_info[d].len_n ;
+  domain = domain_info[d].domain ;
+  iotag = *iotag_p ;
+
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+  me = rsl_c_phys2comp_proc( rsl_myproc ) ;
+  ioffset = domain_info[*d_p].ilocaloffset ;
+  joffset = domain_info[*d_p].jlocaloffset ;
+  tlen = elemsize( *type_p ) ;
+
+  switch( iotag )
+  {
+  case IO2D_IJ_INTERNAL :
+    iotag = IO2D_IJ ;
+    request.internal = 1 ;
+    break ;
+  case IO2D_JI_INTERNAL :
+    iotag = IO2D_JI ;
+    request.internal = 1 ;
+    break ;
+  case IO3D_IJK_INTERNAL :
+    iotag = IO3D_IJK ;
+    request.internal = 1 ;
+    break ;
+  case IO3D_JIK_INTERNAL :
+    iotag = IO3D_JIK ;
+    request.internal = 1 ;
+    break ;
+  case IO3D_IKJ_INTERNAL :
+    iotag = IO3D_IKJ ;
+    request.internal = 1 ;
+    break ;
+  default :
+    request.internal = 0 ;
+    break ;
+  }
+
+  request.request_type = RSL_READ_REQUEST ;
+  request.request_mode = MSG_IO_FORTRAN ;
+  request.myproc = rsl_myproc ;
+  request.base = base ;
+  request.domain = *d_p ;
+  request.unit = *unit_p ;
+  request.unit_p = unit_p ;
+  request.type = *type_p ;
+  request.iotag = iotag ;
+  request.sequence = io_seq_compute++ ;
+
+  switch( iotag )
+  {
+  case IO2D_IJ :
+    request.ndim = 2 ;
+    minelems = request.glen[0] ;
+    majelems = request.glen[1] ;
+    break ;
+  case IO2D_JI :
+    request.ndim = 2 ;
+    minelems = request.glen[1] ;
+    majelems = request.glen[0] ;
+    break ;
+  case IO3D_IJK :
+    RSL_TEST_ERR(glen[2] > llen[2],
+       "rsl_read: global len of K dim is greater than local len") ;
+    request.ndim = 3 ;
+    minelems = request.glen[0] ;
+    majelems = request.glen[1] ;
+    break ;
+  case IO3D_JIK :
+    RSL_TEST_ERR(glen[2] > llen[2],
+       "rsl_read: global len of K dim is greater than local len") ;
+    request.ndim = 3 ;
+    minelems = request.glen[1] ;
+    majelems = request.glen[0] ;
+    break ;
+  case IO3D_KIJ :
+    RSL_TEST_ERR(glen[0] > llen[0],
+       "rsl_read: global len of K dim is greater than local len") ;
+    request.ndim = 3 ;
+    minelems = request.glen[1] ;
+    majelems = request.glen[2] ;
+    break ;
+  case IO3D_IKJ :
+    RSL_TEST_ERR(glen[1] > llen[1],
+       "rsl_read: global len of K dim is greater than local len") ;
+    request.ndim = 3 ;
+    minelems = request.glen[0] ;
+    majelems = request.glen[2] ;
+    break ;
+
+  default:
+    RSL_TEST_ERR(1,"rsl_read: unknown data tag") ;
+  }
+
+  for ( dim = 0 ; dim < request.ndim ; dim++ )
+  {
+    request.glen[dim] = glen[dim] ;
+    request.llen[dim] = llen[dim] ;
+  }
+
+  pbuf = NULL ;
+  if ( i_am_monitor )
+  {
+    /* note ! this routine allocates pbuf */
+    handle_read_request( &request, &resp, &pbuf ) ;
+  }
+  else
+  {
+    mdest = RSL_C_MONITOR_PROC () ;
+    mtag = MTYPE_FROMTO( MSG_READ_RESPONSE, mdest, rsl_myproc ) ;
+    msglen = sizeof(resp) ;
+    RSL_RECV( &resp, msglen, mtag ) ;
+
+    pbuf = RSL_MALLOC( char, resp.tofollow ) ;
+    msglen = resp.tofollow ;
+    RSL_RECV( pbuf, msglen, mtag ) ;
+  }
+
+  if ( pbuf != NULL ) 
+  {
+  /* we do it this way to ensure that we unpack in the same
+     order that the data were packed on the monitor */
+  cursor = 0 ;
+#ifndef vpp
+
+  for ( jg = 0 ; jg < nlen ; jg++ )
+  {
+    for ( ig = 0 ; ig < mlen ; ig++ )
+    {
+      if ( me == domain[INDEX_2(jg,ig,mlen)].P )
+      {
+        switch( iotag )
+        {
+        case IO2D_IJ :
+          min = ig - ioffset ;
+          maj = jg - joffset ;
+          dex = base+tlen*(min+maj*llen[0]) ;
+          bcopy(&(pbuf[cursor]),dex,tlen) ;
+          cursor += tlen ;
+          break ;
+        case IO2D_JI :
+          min = jg - joffset ;
+          maj = ig - ioffset ;
+          dex = base+tlen*(min+maj*llen[0]) ;
+          bcopy(&(pbuf[cursor]),dex,tlen) ;
+          cursor += tlen ;
+          break ;
+        case IO3D_IJK :
+          min = ig - ioffset ;
+          maj = jg - joffset ;
+          for ( k = 0 ; k < glen[2] ; k++ )
+          {
+            dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+            bcopy(&(pbuf[cursor]),dex,tlen) ;
+            cursor += tlen ;
+          }
+          break ;
+        case IO3D_JIK :
+          min = jg - joffset ;
+          maj = ig - ioffset ;
+          for ( k = 0 ; k < glen[2] ; k++ )
+          {
+            dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+            bcopy(&(pbuf[cursor]),dex,tlen) ;
+            cursor += tlen ;
+          }
+          break ;
+        case IO3D_KIJ :
+          min = ig - ioffset ;
+          maj = jg - joffset ;
+          for ( k = 0 ; k < glen[0] ; k++ )
+          {
+            dex = base+tlen*(k+llen[0]*(min+maj*llen[1])) ;
+            bcopy(&(pbuf[cursor]),dex,tlen) ;
+            cursor += tlen ;
+          }
+          break ;
+        case IO3D_IKJ :
+          min = ig - ioffset ;
+          maj = jg - joffset ;
+          for ( k = 0 ; k < glen[1] ; k++ )
+          {
+            dex = base+tlen*(min+llen[0]*(k+maj*llen[1])) ;
+            bcopy(&(pbuf[cursor]),dex,tlen) ;
+            cursor += tlen ;
+          }
+          break ;
+
+        }
+      }
+    }
+  }
+#else
+/* assumes 1 d decomp in j only */
+  for ( jg = 0 ; jg < nlen ; jg++ )
+  {
+    if ( me == domain[INDEX_2(jg,0,mlen)].P )
+    {
+        switch( iotag )
+        {
+        case IO2D_IJ :
+          if ( request.type == RSL_REAL )
+          {
+            min = 0 - ioffset ;
+            maj = jg - joffset ;
+            dex = base+tlen*(min+maj*llen[0]) ;
+            VRCOPY (&(pbuf[cursor]),dex,&mlen) ;
+            cursor += tlen*mlen ;
+          }
+          else
+          {
+            for ( ig = 0 ; ig < mlen ; ig++ )
+            {
+              min = ig - ioffset ;
+              maj = jg - joffset ;
+              dex = base+tlen*(min+maj*llen[0]) ;
+              bcopy(&(pbuf[cursor]),dex,tlen) ;
+              cursor += tlen ;
+            }
+          }
+          break ;
+        case IO2D_JI :
+          for ( ig = 0 ; ig < mlen ; ig++ )
+          {
+            min = jg - joffset ;
+            maj = ig - ioffset ;
+            dex = base+tlen*(min+maj*llen[0]) ;
+            bcopy(&(pbuf[cursor]),dex,tlen) ;
+            cursor += tlen ;
+          }
+          break ;
+        case IO3D_IJK :
+          maj = jg - joffset ;
+          if ( request.type == RSL_REAL )
+          {
+            for ( k = 0 ; k < glen[2] ; k++ )                 /* note reversal of k and i packing order for vpp */
+            {
+              min = 0 - ioffset ;
+              dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+              VRCOPY ( &(pbuf[cursor]),dex,&mlen) ;
+              cursor += tlen*mlen ;
+            }
+          }
+          else
+          {
+            for ( k = 0 ; k < glen[2] ; k++ )                 /* note reversal of k and i packing order for vpp */
+            {
+              for ( ig = 0 ; ig < mlen ; ig++ )
+              {
+                min = ig - ioffset ;
+                dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+                bcopy(&(pbuf[cursor]),dex,tlen) ;
+                cursor += tlen ;
+              }
+            }
+          }
+          break ;
+        case IO3D_JIK :
+          for ( ig = 0 ; ig < mlen ; ig++ )
+          {
+            min = jg - joffset ;
+            maj = ig - ioffset ;
+            for ( k = 0 ; k < glen[2] ; k++ )
+            {
+              dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+              bcopy(&(pbuf[cursor]),dex,tlen) ;
+              cursor += tlen ;
+            }
+          }
+          break ;
+        case IO3D_KIJ :
+          for ( ig = 0 ; ig < mlen ; ig++ )
+          {
+            min = ig - ioffset ;
+            maj = jg - joffset ;
+            for ( k = 0 ; k < glen[0] ; k++ )
+            {
+              dex = base+tlen*(k+llen[0]*(min+maj*llen[1])) ;
+              bcopy(&(pbuf[cursor]),dex,tlen) ;
+              cursor += tlen ;
+            }
+          }
+          break ;
+        case IO3D_IKJ :
+          for ( ig = 0 ; ig < mlen ; ig++ )
+          {
+            min = ig - ioffset ;
+            maj = jg - joffset ;
+            for ( k = 0 ; k < glen[1] ; k++ )
+            {
+              dex = base+tlen*(min+llen[0]*(k+maj*llen[1])) ;
+              bcopy(&(pbuf[cursor]),dex,tlen) ;
+              cursor += tlen ;
+            }
+          }
+          break ;
+
+        }
+    }
+  }
+#endif
+
+  RSL_FREE( pbuf ) ;
+  }
+}
+
+/************/
+
+/*@
+  RSL_WRITE - Collect and write a distributed array to a file or memory.
+
+  Notes:
+  Used to write one record to an unformatted (binary) Fortran
+  file or to a globally dimensioned data structure in the memory
+  of the monitor processor (see RSL_IAMMONITOR).  After the write,
+  the record will
+  contain an undecomposed two- or three-dimensional array.
+
+  The layout of the
+  array to be written is specified by Arg2, which may be
+
+  Verbatim:
+$     IO2D_IJ,
+$     IO2D_JI,
+$     IO3D_IJK, or
+$     IO3D_JIK
+BREAKTHEEXAMPLECODE
+
+  for writes to a file, or
+
+  Verbatim:
+$     IO2D_IJ_INTERNAL,
+$     IO2D_JI_INTERNAL,
+$     IO3D_IJK_INTERNAL, or
+$     IO3D_JIK_INTERNAL
+BREAKTHEEXAMPLECODE
+
+  for writes to the memory of the monitor processor.  The constants
+  are defined in the header file rsl.inc.
+  
+  For internal writes, instead of a unit number,
+  the first argument is the global (undecomposed)
+  data structure into which the distributed data is written.
+  All processors send their portion of the distributed array
+  to the monitor processor.  On that processor, the write 
+  returns with the global data structure.
+
+  Internal writes are useful for collecting distributed data onto
+  one processor to perform global operations (RSL_READ may then
+  be used to redistribute the results with an internal read, or
+  if the operation is a reduction, the result can be broadcast
+  using RSL_MON_BCAST).
+  Although this is not a scalable technique --- communication to
+  the monitor processor becomes a bottleneck --- it is often practical
+  and much simpler to implement for operations that are performed
+  only once during initialization, or infrequently (see Example 2 below).
+     
+  IO2D_IJ specifies a two-dimensional array
+  whose minor dimension is M.  IO3D_JI specifies a two-dimensional array
+  whose minor dimension is N.  (This is as
+  as specified in the call to the routine that created or spawned
+  the domain; e.g., RSL_MOTHER_DOMAIN).
+
+  The type argument specifies the data type of an array element and
+  may be one of
+  Verbatim:
+$     RSL_REAL,
+$     RSL_DOUBLE,
+$     RSL_COMPLEX,
+$     RSL_INTEGER, or
+$     RSL_CHARACTER.  
+BREAKTHEEXAMPLECODE
+
+  The Arg6 array should contain the global (undecomposed) size of
+  each dimension in order from minor to major.  The first element of
+  glen is the size of the minor dimension.  The Arg7 array should
+  contain the size of each dimension as statically declared on the
+  processor.
+
+  Example:
+
+$ C
+$ C Example 1, writing a distributed array to unit 11.
+$ C
+$    #include "rsl.inc"
+$       real ua(mix,mjx,mkx)
+$       integer glen(3), llen(3)
+$       glen(1) = il
+$       glen(2) = jl
+$       glen(3) = mkx
+$       llen(1) = mix
+$       llen(2) = mjx
+$       llen(3) = mkx
+$       call rsl_write( 11, IO3D_IJK, ua, domains(inest),
+$     +                 RSL_REAL, glen, llen )
+$ C
+$ C Example 2, part of a global initialization in MM90.
+$ C
+$       ALLOCATE( ASTORE_G(IL,JL) )
+$       ...
+$       CALL RSL_WRITE(ASTORE_G, IO2D_IJ_INTERNAL,
+$     +                ASTORE,DID,RSL_REAL,GLEN,LLEN)
+$       ...
+$       CALL RSL_IAMMONITOR(RETVAL)
+$       IF(RETVAL.EQ.1)THEN
+$         DO J=1,JL
+$           DO I=1,IL
+$             ATOT=ATOT+ASTORE_G(I,J)
+$           ENDDO
+$       ENDDO
+$         NPTS=IL*JL
+$         ABAR=ATOT/NPTS
+$       ENDIF
+$       CALL RSL_MON_BCAST(  ABAR,    WORDSIZE )
+BREAKTHEEXAMPLECODE
+
+  In the example a three-dimensional field, ua, is written to
+  Fortran unit 11 from
+  domain DID.
+  GLEN(1) and GLEN(2) are set to the global sizes of the two
+  horizontal dimensions.
+  LLEN(1) and LLEN(2) are set to the
+  static sizes of the local array (mix, mjx, and mkx are
+  Fortran parameters).
+
+  In example two, a reduction is used to compute an average
+  that will be used to initialize a calculation in a weather
+  model.  RSL_WRITE is used to write into the globally dimensioned
+  array ASTORE_G; RSL_IAMMONITOR is used to limit the calculation
+  to the monitor processor; RSL_MON_BCAST is used to broadcast
+  back the result.
+
+
+  See also:
+  RSL_READ
+
+@*/
+RSL_WRITE ( unit_p, iotag_p, base, d_p, type_p, glen, llen  )
+  int_p
+    unit_p              /* (I) Fortran unit number. */
+   ,iotag_p ;           /* (I) RSL I/O code. */
+  char *
+    base ;              /* (I) Buffer. */
+  int_p
+    d_p                 /* (I) RSL domain descriptor */
+   ,type_p ;            /* (I) RSL data type code. */
+  int
+    glen[]              /* (I) Global dimension information. */
+   ,llen[] ;            /* (I) Local dimension information. */
+{
+  rsl_read_req_t request ;
+  rsl_read_resp_t resp ;
+  rsl_processor_t me ;
+  int cursor, mdest, mtag, msglen, dim, d ;
+  int mlen, nlen ;
+  int minelems, majelems ;
+  unsigned long min, maj, ioffset, joffset, tlen, k ;
+  int ig, jg ;
+  void *dex ;
+  char *pbuf ;
+  int i_am_monitor ;
+  int psize, nelem, typelen, nbytes, columnelems  ;
+  rsl_point_t *domain ;
+  int iotag ;
+  int *is_write, *ie_write, *js_write, *je_write ;
+  int in_write ;
+  int dummy ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_write: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_write: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+  mlen = domain_info[d].len_m ;
+  nlen = domain_info[d].len_n ;
+  domain = domain_info[d].domain ;
+
+  is_write = &( domain_info[d].is_write ) ;
+  js_write = &( domain_info[d].js_write ) ;
+  ie_write = &( domain_info[d].ie_write ) ;
+  je_write = &( domain_info[d].je_write ) ;
+
+/* reset and recompute each time; otherwise smaller fields will truncate bigger fields later on . JM 20030417.  */
+  *is_write = RSL_INVALID ;
+  *ie_write = RSL_INVALID ;
+  *js_write = RSL_INVALID ;
+  *je_write = RSL_INVALID ;
+
+  iotag = *iotag_p ;
+
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+
+  me = rsl_c_phys2comp_proc( rsl_myproc ) ;
+  ioffset = domain_info[*d_p].ilocaloffset ;
+  joffset = domain_info[*d_p].jlocaloffset ;
+  tlen = elemsize( *type_p ) ;
+
+  switch( iotag )
+  {
+  case IO2D_IJ_INTERNAL :
+    iotag = IO2D_IJ ;
+    request.internal = 1 ;
+    break ;
+  case IO2D_JI_INTERNAL :
+    iotag = IO2D_JI ;
+    request.internal = 1 ;
+    break ;
+  case IO3D_IJK_INTERNAL :
+    iotag = IO3D_IJK ;
+    request.internal = 1 ;
+    break ;
+  case IO3D_JIK_INTERNAL :
+    iotag = IO3D_JIK ;
+    request.internal = 1 ;
+    break ;
+  case IO3D_IKJ_INTERNAL :
+    iotag = IO3D_IKJ ;
+    request.internal = 1 ;
+    break ;
+  default :
+    request.internal = 0 ;
+    break ;
+  }
+
+  request.request_type = RSL_WRITE_REQUEST ;
+  request.request_mode = MSG_IO_FORTRAN ;
+  request.myproc = rsl_myproc ;
+  request.base = base ;
+  request.domain = *d_p ;
+  request.unit = *unit_p ;
+  request.unit_p = unit_p ;
+  request.type = *type_p ;
+  request.iotag = iotag ;
+  request.sequence = io_seq_compute++ ;
+
+  switch( iotag )
+  {
+  case IO2D_IJ :
+    request.ndim = 2 ;
+    break ;
+  case IO2D_JI :
+    request.ndim = 2 ;
+    break ;
+  case IO3D_IJK :
+    request.ndim = 3 ;
+    RSL_TEST_ERR(glen[2] > llen[2],
+       "rsl_write: global len of K dim is greater than local len") ;
+    break ;
+  case IO3D_JIK :
+    RSL_TEST_ERR(glen[2] > llen[2],
+       "rsl_write: global len of K dim is greater than local len") ;
+    request.ndim = 3 ;
+    break ;
+  case IO3D_KIJ :
+    RSL_TEST_ERR(glen[0] > llen[0],
+       "rsl_write: global len of K dim is greater than local len") ;
+    request.ndim = 3 ;
+    break ;
+  case IO3D_IKJ :
+    RSL_TEST_ERR(glen[1] > llen[1],
+       "rsl_write: global len of K dim is greater than local len") ;
+    request.ndim = 3 ;
+    break ;
+  default:
+    RSL_TEST_ERR(1,"rsl_write: unknown data tag") ;
+  }
+  for ( dim = 0 ; dim < request.ndim ; dim++ )
+  {
+    request.glen[dim] = glen[dim] ;
+    request.llen[dim] = llen[dim] ;
+  }
+
+  /* figure out size of buffer needed */
+  nelem = 1 ;
+  for  ( dim = 0 ; dim < request.ndim ; dim++ )
+  {
+    nelem *= request.glen[dim] ;
+  }
+  typelen = elemsize( request.type ) ;
+  nbytes = nelem * typelen ;
+
+  switch ( request.iotag )
+  {
+  case IO2D_IJ :
+    columnelems = 1 ;
+    minelems = request.glen[0] ;
+    majelems = request.glen[1] ;
+    break ;
+  case IO2D_JI :
+    columnelems = 1 ;
+    minelems = request.glen[1] ;
+    majelems = request.glen[0] ;
+    break ;
+  case IO3D_IJK :
+    columnelems = request.glen[2] ;
+    minelems = request.glen[0] ;
+    majelems = request.glen[1] ;
+    break ;
+  case IO3D_JIK :
+    columnelems = request.glen[2] ;
+    minelems = request.glen[1] ;
+    majelems = request.glen[0] ;
+    break ;
+  case IO3D_KIJ :
+    columnelems = request.glen[0] ;
+    minelems = request.glen[1] ;
+    majelems = request.glen[2] ;
+    break ;
+  case IO3D_IKJ :
+    columnelems = request.glen[1] ;
+    minelems = request.glen[0] ;
+    majelems = request.glen[2] ;
+    break ;
+  default:
+    RSL_TEST_ERR(1,"handle_write_request: unknown data tag") ;
+  }
+
+  /*  figure out size for this processor */
+  pbuf = NULL ;
+  psize = (regular_decomp)?(4*sizeof(int)):0 ;
+
+  RSL_TEST_ERR( majelems <= 0, "Major dim spec on write is zero or less.") ;
+  RSL_TEST_ERR( minelems <= 0, "Minor dim spec on write is zero or less.") ;
+  if ( majelems > domain_info[request.domain].len_n )
+  { sprintf(mess,"Major dim spec on write (%d) greater than global domain definition in that dimension (%d)\n",majelems,domain_info[request.domain].len_n) ;
+    RSL_TEST_ERR(1,mess) ; }
+  if ( minelems > domain_info[request.domain].len_m )
+  { sprintf(mess,"Minor dim spec on write (%d) greater than global domain definition in that dimension (%d)\n",minelems,domain_info[request.domain].len_m) ;
+    RSL_TEST_ERR(1,mess) ; }
+
+  for ( jg = 0 ; jg < majelems ; jg++ )
+  {
+    for ( ig = 0 ; ig < minelems ; ig++ )
+    {
+      if ( me == domain[INDEX_2(jg,ig,mlen)].P )
+        psize += columnelems * typelen ;
+    }
+  }
+
+  pbuf = RSL_MALLOC( char, psize ) ;
+
+  cursor = 0 ;
+
+  if ( regular_decomp )
+  {
+    if ( *is_write == RSL_INVALID )
+    {
+      for ( jg = 0 ; jg < majelems ; jg++ )
+      {
+        for ( ig = 0 ; ig < minelems ; ig++ )
+        {
+          if ( me == domain[INDEX_2(jg,ig,mlen)].P )
+          {
+            if ( *is_write == RSL_INVALID ) { *is_write = ig ; }
+            if ( *js_write == RSL_INVALID ) { *js_write = jg ; }
+            *ie_write = ig ;
+            *je_write = jg ;
+          }
+        }
+      }
+      if ( *is_write == RSL_INVALID )   /* nothing set */
+      {
+        *is_write = 0 ;      /* set so no iterations occur */
+        *js_write = 0 ;
+        *ie_write = -1 ;
+        *je_write = -1 ;
+      }
+    }
+
+    bcopy( is_write, &(pbuf[cursor]), sizeof(int) ) ; cursor += sizeof(int) ;
+    bcopy( ie_write, &(pbuf[cursor]), sizeof(int) ) ; cursor += sizeof(int) ;
+    bcopy( js_write, &(pbuf[cursor]), sizeof(int) ) ; cursor += sizeof(int) ;
+    bcopy( je_write, &(pbuf[cursor]), sizeof(int) ) ; cursor += sizeof(int) ;
+
+    if ( *ie_write == -1 )
+    {
+      in_write = 0 ;
+    }
+    else
+    {
+      in_write = *ie_write - *is_write + 1 ;
+    }
+
+    for ( jg = *js_write ; jg <= *je_write ; jg++ )
+    {
+        switch( iotag )
+        {
+        case IO2D_IJ :
+	  if ( request.type == RSL_REAL ) 
+	  {
+            min = *is_write - ioffset ;
+            maj = jg - joffset ;
+            dex = base+tlen*(min+maj*llen[0]) ;
+            VRCOPY (dex,&(pbuf[cursor]),&in_write) ;
+            cursor += tlen*in_write ;
+	  }
+	  else
+	  {
+            for ( ig = *is_write ; ig <= *ie_write ; ig++ )
+            {
+              min = ig - ioffset ;
+              maj = jg - joffset ;
+              dex = base+tlen*(min+maj*llen[0]) ;
+              bcopy(dex,&(pbuf[cursor]),tlen) ;
+              cursor += tlen ;
+            }
+          }
+          break ;
+        case IO2D_JI :
+          for ( ig = *is_write ; ig <= *ie_write ; ig++ )
+          {
+            min = jg - joffset ;
+            maj = ig - ioffset ;
+            dex = base+tlen*(min+maj*llen[0]) ;
+            bcopy(dex,&(pbuf[cursor]),tlen) ;
+            cursor += tlen ;
+	  }
+          break ;
+        case IO3D_IJK :
+          maj = jg - joffset ;
+	  if ( request.type == RSL_REAL )
+	  {
+            for ( k = 0 ; k < glen[2] ; k++ )                 /* note reversal of k and i packing order for vpp */
+            {
+              min = *is_write - ioffset ;
+              dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+	      VRCOPY ( dex,&(pbuf[cursor]),&in_write) ;
+              cursor += tlen*in_write ;
+	    }
+	  }
+	  else
+	  {
+            for ( k = 0 ; k < glen[2] ; k++ )                 /* note reversal of k and i packing order for vpp */
+            {
+	      for ( ig = *is_write ; ig <= *ie_write ; ig++ )
+	      {
+                min = ig - ioffset ;
+                dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+                bcopy(dex,&(pbuf[cursor]),tlen) ;
+                cursor += tlen ;
+	      }
+            }
+          }
+          break ;
+        case IO3D_JIK :
+          for ( ig = *is_write ; ig <= *ie_write ; ig++ )
+          {
+            min = jg - joffset ;
+            maj = ig - ioffset ;
+            for ( k = 0 ; k < glen[2] ; k++ )
+            {
+              dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+              bcopy(dex,&(pbuf[cursor]),tlen) ;
+              cursor += tlen ;
+            }
+	  }
+          break ;
+
+        case IO3D_KIJ :
+          for ( ig = *is_write ; ig <= *ie_write ; ig++ )
+          {
+            min = ig - ioffset ;
+            maj = jg - joffset ;
+            for ( k = 0 ; k < glen[0] ; k++ )
+            {
+              dex = base+tlen*(k+llen[0]*(min+maj*llen[1])) ;
+              bcopy(dex,&(pbuf[cursor]),tlen) ;
+              cursor += tlen ;
+            }
+          }
+          break ;
+
+        case IO3D_IKJ :
+#ifndef NEC_TUNE
+          for ( ig = *is_write ; ig <= *ie_write ; ig++ )
+          {
+            min = ig - ioffset ;
+            maj = jg - joffset ;
+            for ( k = 0 ; k < glen[1] ; k++ )
+            {
+              dex = base+tlen*(min+llen[0]*(k+maj*llen[1])) ;
+              bcopy(dex,&(pbuf[cursor]),tlen) ;
+              cursor += tlen ;
+            }
+          }
+#else
+          maj = jg - joffset ;
+          min = *is_write - ioffset ;
+          for ( k = 0 ; k < glen[1] ; k++ )
+          {
+            dex = base+tlen*(min+llen[0]*(k+maj*llen[1])) ;
+            copymem(dex, tlen, &(pbuf[cursor+k*tlen]), tlen*glen[1], tlen, *ie_write-*is_write+1) ;
+          }
+          cursor += tlen*(*ie_write-*is_write+1)*glen[1] ;
+#endif
+          break ;
+
+        }
+    }
+  }
+  else
+  {
+    for ( jg = 0 ; jg < majelems ; jg++ )
+    {
+      for ( ig = 0 ; ig < minelems ; ig++ )
+      {
+        if ( me == domain[INDEX_2(jg,ig,mlen)].P )
+        {
+          switch( iotag )
+          {
+          case IO2D_IJ :
+            min = ig - ioffset ;
+            maj = jg - joffset ;
+            dex = base+tlen*(min+maj*llen[0]) ;
+            bcopy(dex,&(pbuf[cursor]),tlen) ;
+            cursor += tlen ;
+            break ;
+          case IO2D_JI :
+            min = jg - joffset ;
+            maj = ig - ioffset ;
+            dex = base+tlen*(min+maj*llen[0]) ;
+            bcopy(dex,&(pbuf[cursor]),tlen) ;
+            cursor += tlen ;
+            break ;
+          case IO3D_IJK :
+            min = ig - ioffset ;
+            maj = jg - joffset ;
+            for ( k = 0 ; k < glen[2] ; k++ )
+            {
+              dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+              bcopy(dex,&(pbuf[cursor]),tlen) ;
+              cursor += tlen ;
+            }
+            break ;
+          case IO3D_JIK :
+            min = jg - joffset ;
+            maj = ig - ioffset ;
+            for ( k = 0 ; k < glen[2] ; k++ )
+            {
+              dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+              bcopy(dex,&(pbuf[cursor]),tlen) ;
+              cursor += tlen ;
+            }
+            break ;
+
+          case IO3D_KIJ :
+            min = ig - ioffset ;
+            maj = jg - joffset ;
+            for ( k = 0 ; k < glen[0] ; k++ )
+            {
+              dex = base+tlen*(k+llen[0]*(min+maj*llen[1])) ;
+              bcopy(dex,&(pbuf[cursor]),tlen) ;
+              cursor += tlen ;
+            }
+            break ;
+          case IO3D_IKJ :
+            min = ig - ioffset ;
+            maj = jg - joffset ;
+            for ( k = 0 ; k < glen[1] ; k++ )
+            {
+              dex = base+tlen*(min+llen[0]*(k+maj*llen[1])) ;
+              bcopy(dex,&(pbuf[cursor]),tlen) ;
+              cursor += tlen ;
+            }
+            break ;
+          }
+        }
+      }
+    }
+  }
+
+  if ( pbuf != NULL )
+  {
+  if ( i_am_monitor )
+  {
+    handle_write_request( &request, nelem, psize, pbuf ) ;
+  }
+  else
+  {
+#ifdef RSL_SYNCIO
+    mdest = RSL_C_MONITOR_PROC () ;
+    msglen = 1 ;
+    mtag = MTYPE_FROMTO( MSG_WRITE_COMPUTE_RESPONSE, mdest, rsl_myproc ) ;
+    RSL_RECV( &dummy, msglen, mtag ) ;
+#endif
+    mdest = RSL_C_MONITOR_PROC () ;
+    msglen = psize ;
+    mtag = MTYPE_FROMTO( MSG_WRITE_COMPUTE_RESPONSE, rsl_myproc, mdest ) ;
+    RSL_SEND( pbuf, msglen, mtag, mdest ) ;
+  }
+
+  RSL_FREE( pbuf ) ;
+  }
+}
+
+
+
+RSL_IO_SHUTDOWN ()
+{ 
+  rsl_read_req_t request ;
+  int mdest, mtag, msglen ;
+
+  request.request_type = RSL_SHUTDOWN_REQUEST ;
+  request.sequence = io_seq_compute++ ;
+  mdest = RSL_C_MONITOR_PROC () ;
+  mtag = MSG_MONITOR_REQUEST ;
+  msglen = sizeof( request ) ;
+
+  RSL_SEND( &request, msglen, mtag, mdest ) ;
+
+  return ;
+}
+
+/* this is collective over all processors, but not every processor will
+   necessarily have data at input or output. Map the patch from the input 
+   array onto the patch of the output array, communicating as necessary.
+   code assumes (for now) anyway, that each patch is disjoint on each side. */
+
+RSL_REMAP_ARRAY ( inbuf, ndim_p, type_p,
+                          is_dimd, ie_dimd, 
+                          is_dimp, ie_dimp, is_dimm, ie_dimm,
+                  outbuf, os_dimp, oe_dimp, os_dimm, oe_dimm )
+  char inbuf[], outbuf[] ;
+  int_p ndim_p, type_p ;
+  int is_dimd[], is_dimp[], is_dimm[], os_dimp[], os_dimm[] ;
+  int ie_dimd[], ie_dimp[], ie_dimm[], oe_dimp[], oe_dimm[] ;
+{
+
+#ifndef STUBS
+
+#define STRT 0
+#define ENDD 1
+#define PCH  0
+#define MEM  1
+#define DOM  2
+
+  int group_i[2][3][RSL_MAXPROC][3] ;
+  int group_o[2][3][RSL_MAXPROC][3] ;
+  MPI_Request reqlist[RSL_MAXPROC] ;
+  MPI_Comm rsl_mpi_communicator=MPI_COMM_WORLD ;
+  char * rcvbuf, *sndbuf ;
+  int outstanding = 0 ; 
+  int msglen ;
+  int P, good, ps0[RSL_MAXPROC], ps1[RSL_MAXPROC] ;
+  int          pe0[RSL_MAXPROC], pe1[RSL_MAXPROC] ;
+  int          ds0, ds1 ;
+  int          de0, de1 ;
+  int i,j,k,l,curs,dex,w, outer ;
+  int ndim, type, mtag ;
+  MPI_Status Stat ;
+
+  ndim = *ndim_p ;
+  type = *type_p ;
+
+  MPI_Allgather( is_dimp, 3, MPI_INT, group_i[STRT][PCH], 3, MPI_INT, rsl_mpi_communicator )  ;
+  MPI_Allgather( is_dimm, 3, MPI_INT, group_i[STRT][MEM], 3, MPI_INT, rsl_mpi_communicator )  ;
+  MPI_Allgather( is_dimd, 3, MPI_INT, group_i[STRT][DOM], 3, MPI_INT, rsl_mpi_communicator )  ;
+  MPI_Allgather( ie_dimp, 3, MPI_INT, group_i[ENDD][PCH], 3, MPI_INT, rsl_mpi_communicator )  ;
+  MPI_Allgather( ie_dimm, 3, MPI_INT, group_i[ENDD][MEM], 3, MPI_INT, rsl_mpi_communicator )  ;
+  MPI_Allgather( ie_dimd, 3, MPI_INT, group_i[ENDD][DOM], 3, MPI_INT, rsl_mpi_communicator )  ;
+
+  MPI_Allgather( os_dimp, 3, MPI_INT, group_o[STRT][PCH], 3, MPI_INT, rsl_mpi_communicator )  ;
+  MPI_Allgather( os_dimm, 3, MPI_INT, group_o[STRT][MEM], 3, MPI_INT, rsl_mpi_communicator )  ;
+  MPI_Allgather( oe_dimp, 3, MPI_INT, group_o[ENDD][PCH], 3, MPI_INT, rsl_mpi_communicator )  ;
+  MPI_Allgather( oe_dimm, 3, MPI_INT, group_o[ENDD][MEM], 3, MPI_INT, rsl_mpi_communicator )  ;
+
+/* now everybody knows about everybody, figure out what I need from where */
+/* assume ijk for now */
+
+  /* loop over possible senders so we can post receives */
+  /* is any point I need on P? */
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    good = 0 ;
+    /* cases where there definitely are not... */
+    if ( os_dimp[0] > group_i[ENDD][PCH][P][0] || oe_dimp[0] < group_i[STRT][PCH][P][0] )
+    { }
+    else
+    {
+      ps0[outstanding] = ( os_dimp[0] < group_i[STRT][PCH][P][0] )? group_i[STRT][PCH][P][0] : os_dimp[0] ;
+      pe0[outstanding] = ( oe_dimp[0] > group_i[ENDD][PCH][P][0] )? group_i[ENDD][PCH][P][0] : oe_dimp[0] ;
+      if ( os_dimp[1] > group_i[ENDD][PCH][P][1] || oe_dimp[1] < group_i[STRT][PCH][P][1] )
+      { }
+      else
+      {
+        ps1[outstanding] = ( os_dimp[1] < group_i[STRT][PCH][P][1] )? group_i[STRT][PCH][P][1] : os_dimp[1] ;
+        pe1[outstanding] = ( oe_dimp[1] > group_i[ENDD][PCH][P][1] )? group_i[ENDD][PCH][P][1] : oe_dimp[1] ;
+        good = 1 ;
+      }
+    }
+    if ( good )
+    {
+      msglen = (oe_dimp[2]-os_dimp[2]+1)*(pe1[outstanding]-ps1[outstanding]+1)*(pe0[outstanding]-ps0[outstanding]+1)*elemsize(type) ;
+      rcvbuf = (char *) buffer_for_proc(P, msglen, RSL_RECVBUF) ;
+      mtag = MTYPE_FROMTO( MSG_READ_RESPONSE, P, rsl_myproc ) ;
+
+      MPI_Irecv( rcvbuf , msglen, MPI_CHAR, P, 
+                 mtag , rsl_mpi_communicator, &reqlist[outstanding] ) ;  /* posted receive */
+      outstanding++ ;
+    }
+  }
+  /* loop over possible receivers so we can pack and send stuff */
+  /* are points I have needed by P */
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    good = 0 ;
+    /* cases where they definitely are not */
+    if ( is_dimp[0] > group_o[ENDD][PCH][P][0] || ie_dimp[0] < group_o[STRT][PCH][P][0] )
+    { }
+    else
+    {
+      ds0 = ( is_dimp[0] < group_o[STRT][PCH][P][0] )? group_o[STRT][PCH][P][0] : is_dimp[0] ;
+      de0 = ( ie_dimp[0] > group_o[ENDD][PCH][P][0] )? group_o[ENDD][PCH][P][0] : ie_dimp[0] ;
+      if ( is_dimp[1] > group_o[ENDD][PCH][P][1] || ie_dimp[1] < group_o[STRT][PCH][P][1] )
+      { }
+      else
+      {
+        ds1 = ( is_dimp[1] < group_o[STRT][PCH][P][1] )? group_o[STRT][PCH][P][1] : is_dimp[1] ;
+        de1 = ( ie_dimp[1] > group_o[ENDD][PCH][P][1] )? group_o[ENDD][PCH][P][1] : ie_dimp[1] ;
+        good = 1 ;
+      }
+    }
+    if ( good )
+    {
+      /* pack and send */
+      msglen = (oe_dimp[2]-os_dimp[2]+1)*(de1-ds1+1)*(de0-ds0+1)*elemsize(type) ;
+      sndbuf = (char *) buffer_for_proc(P, msglen, RSL_SENDBUF) ;
+      curs = 0 ;
+      for ( k = is_dimm[2] ; k <= ie_dimm[2] ; k++ )
+        for ( j = ds1 ; j <= de1 ; j++ )
+          for ( i = ds0 ; i <= de0 ; i++ )
+            for ( l = 0 ; l < elemsize(type) ; l++ )
+            {
+              dex = elemsize(type)*
+                    ((i-is_dimm[0])
+                    +(j-is_dimm[1])*(ie_dimm[0]-is_dimm[0]+1)
+                    +(k-is_dimm[2])*(ie_dimm[0]-is_dimm[0]+1)*(ie_dimm[1]-is_dimm[1]+1))  ;
+              sndbuf[curs++] = inbuf[l+dex] ;
+            }
+       mtag = MTYPE_FROMTO( MSG_READ_RESPONSE, rsl_myproc, P ) ;
+#if 0
+fprintf(stderr,"MPI_Send to %d %d\n",P,msglen) ;
+#endif
+       MPI_Send( sndbuf, msglen, MPI_CHAR, P, mtag, rsl_mpi_communicator ) ;
+    }
+  }
+
+  for ( outer = 0 ; outer < outstanding ; outer++ )
+  {
+    MPI_Waitany ( outstanding, reqlist, &w, &Stat ) ;
+    P = Stat.MPI_SOURCE ;
+    rcvbuf = (char *) buffer_for_proc(P, 0, RSL_RECVBUF) ;
+    curs = 0 ;
+    for ( k = os_dimm[2] ; k <= oe_dimm[2] ; k++ )
+      for ( j = ps1[w] ; j <= pe1[w] ; j++ )
+        for ( i = ps0[w] ; i <= pe0[w] ; i++ )
+          for ( l = 0 ; l < elemsize(type) ; l++ )
+	  {
+            dex = elemsize(type)*
+                  ((i-os_dimm[0])
+                  +(j-os_dimm[1])*(oe_dimm[0]-os_dimm[0]+1)
+                  +(k-os_dimm[2])*(oe_dimm[0]-os_dimm[0]+1)*(oe_dimm[1]-os_dimm[1]+1))  ;
+            outbuf[l+dex] = rcvbuf[curs++] ;
+	  }
+  }
+#else
+  RSL_TEST_ERR (1,"RSL_REMAP_ARRAY STUBBED") ; 
+#endif
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_io.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_io.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_io.h	(revision 2744)
@@ -0,0 +1,130 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+
+
+#ifndef RSL_IO_H
+#define RSL_IO_H
+
+typedef struct rsl_read_resp {
+  int response_type ;
+  int sequence ;
+  int tofollow ;
+} rsl_read_resp_t ;
+
+typedef struct rsl_read_req {
+  int request_type  ;
+
+  int request_mode  ;	/* FORTRAN or SOCKET   added 9/30/94 */
+  int request_mode2 ;	/* RAW or PORTAL       added 9/30/94 */
+
+  rsl_processor_t myproc ;
+  rsl_index_t domain ;
+  void * base ;
+  int sequence ;
+  int iotag ;
+  int unit ;
+  int_p unit_p ;
+  int internal ;
+  int ndim ;
+  int type ;
+  int speciala ;		/* extra information */
+  int specialb ;		/* extra information */
+  int specialc ;		/* extra information */
+  int glen[RSL_MAXDIM] ;
+  int llen[RSL_MAXDIM] ;
+#ifdef crayx1
+  int is_write, ie_write ;
+  int js_write, je_write ;
+  int is_read , ie_read  ;
+  int js_read , je_read  ;
+#else
+  short is_write, ie_write ;
+  short js_write, je_write ;
+  short is_read , ie_read  ;
+  short js_read , je_read  ;
+#endif
+} rsl_read_req_t ;
+
+typedef rsl_read_req_t rsl_write_req_t ;
+
+
+/* start 981228 AFWA IO */
+
+typedef struct rsl_write_buffer_struct {
+  rsl_write_req_t req ;
+  int nelem ;
+  char * buf ;
+  struct rsl_write_buffer_struct *next ;
+} rsl_write_buffer_struct_t ;
+
+#ifdef DEFINE_GLOBAL
+rsl_write_buffer_struct_t * write_buffer_head = NULL ;
+rsl_write_buffer_struct_t * write_buffer_tail = NULL ;
+int rsl_buffer_output = 0 ;
+int rsl_io_node = 0 ;
+#else
+extern rsl_write_buffer_struct_t * write_buffer_head ;
+extern rsl_write_buffer_struct_t * write_buffer_tail ;
+extern int rsl_buffer_output ;
+extern int rsl_io_node ;
+#endif
+
+
+/* end 981228 AFWA IO */
+
+
+#endif /* nothing after this line */
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_ioserve.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_ioserve.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_ioserve.c	(revision 2744)
@@ -0,0 +1,1846 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+#include <stdio.h>
+#include <sys/uio.h>
+#include <string.h>
+#ifdef T3D
+#include <fortran.h>
+#endif
+
+       static int first_time_through = 1 ;
+
+
+static char request_buf[ 2048 ] ;
+
+/* hack for IBM/Chameleon, and other machines/api's that aren't
+   completely competant about flushing FORTRAN I/O before shutting
+   down.  We'll do that here, each time a shutdown occurs.  That
+   entails keeping track of which files were written to, hence
+   this data structure. */
+
+#define NUNITS  128
+static unsigned char unit_written[NUNITS] ;
+
+
+
+RSL_IOSERVE ()
+{
+  int *rtype ;
+  int msglen, mtag ;
+  int done, nshutdown ;
+  int i, x ;
+
+  nshutdown = 0 ;
+  done = 0 ;
+
+  for ( i = 0 ; i < NUNITS ; i++ )
+     unit_written[i] = '\0' ;
+
+  while( !done )
+  {
+    msglen = 2048 ;
+    mtag = MSG_MONITOR_REQUEST ;
+    RSL_RECV( request_buf, msglen, mtag ) ;
+    rtype = (int *) request_buf ;
+    switch( *rtype )
+    {
+    case RSL_READ_REQUEST :
+      handle_read_request( request_buf ) ;
+      break ;
+    case RSL_WRITE_REQUEST :
+      handle_write_request( request_buf ) ;
+      break ;
+    case RSL_READ_SPECIAL1   :
+      handle_special1( request_buf ) ;
+      break ;
+    case RSL_READ_SPECIAL2   :
+      handle_special2( request_buf ) ;
+      break ;
+    case RSL_SHUTDOWN_REQUEST  :
+      /* last processor causes shutdown */
+      nshutdown++ ;
+      if ( nshutdown == rsl_nproc ) 
+        done = 1 ;
+      break ;
+    default :
+      sprintf(mess,"rsl_ioserve: monitor received unknown request %d",*rtype) ;
+      RSL_TEST_ERR(1,mess) ;
+    }
+  }
+
+  for ( i = 0 ; i < NUNITS ; i++ )
+  {
+     if ( unit_written[i] != '\0' )
+     {
+        x = i + 1 ;
+        RSL_FUNIT_CLOSE ( &x ) ;
+     }
+  }
+}
+
+int
+handle_read_request( req, resp_me, pbuf_me )
+  rsl_read_req_t * req ;
+  char * resp_me ;
+  char ** pbuf_me ;
+{
+  int dim, i, k, ig, jg, nelem ;
+  int columnelems, nbytes, typelen, len, cursor  ;
+  int P ;
+  int msglen, mtag, mdest ;
+  int mlen, nlen, minelems, majelems ;
+  rsl_read_resp_t resp ;
+  int psize[ RSL_MAXPROC ] ;    /* size of messages to each processor */
+  char * rbuf ;
+  char *pbuf ;
+  rsl_point_t *domain ;
+  int nelem_alloc ;
+
+/* efficiency update from JM, 2002/05/24 */
+  int numpts[RSL_MAXPROC], maxnumpts, iii ;
+  int *iptlst, *jptlst, *ip1, *ip2  ;
+  double *dp1, *dp2 ;
+
+/* bug fix from AJB; rbuf needs to be as large as the
+   domain size (with padding out to factor of 3 for nest
+   dimensions) or may generate a seg-fault in bcopies below
+   in loop that runs over the mlen/nlen dimensions
+*/
+  /* figure out size of read buffer needed (includes padding) */
+  nelem_alloc = domain_info[req->domain].len_m * domain_info[req->domain].len_n ;
+  switch ( req->iotag )
+  {
+  case IO2D_IJ  : break ;
+  case IO2D_JI  : break ;
+  case IO3D_IJK : nelem_alloc *= req->glen[2] ; break ;
+  case IO3D_JIK : nelem_alloc *= req->glen[2] ; break ;
+  case IO3D_KIJ : nelem_alloc *= req->glen[0] ; break ;
+  case IO3D_IKJ : nelem_alloc *= req->glen[1] ; break ;
+  }
+  /* figure out number of elements to read into read buffer */
+  nelem = 1 ;
+  for  ( dim = 0 ; dim < req->ndim ; dim++ )
+  {
+    nelem *= req->glen[dim] ; 
+  }
+  typelen = elemsize( req->type ) ;
+  nbytes = nelem_alloc * typelen ;
+
+  rbuf = RSL_MALLOC( char, nbytes ) ;  
+
+  /* call fortran to read a record from the named unit */
+  if ( req->internal ) 
+  {
+#ifndef NEC_TUNE
+    bcopy( req->unit_p, rbuf, nbytes ) ;
+#else
+    copymem( (void *)req->unit_p, typelen, (void *)rbuf, typelen, typelen, nelem_alloc ) ;
+#endif
+  }
+  else
+  {
+    switch ( req->type )
+    {
+    case RSL_REAL :
+      FORT_REALREAD ( &(req->unit), rbuf, &nelem ) ;
+      break ;
+    case RSL_INTEGER :
+      FORT_INTREAD ( &(req->unit), rbuf, &nelem ) ;
+      break ;
+#ifndef T3D
+    case RSL_DOUBLE :
+      FORT_DOUBLEREAD ( &(req->unit), rbuf, &nelem ) ;
+      break ;
+#endif
+    case RSL_COMPLEX :
+      FORT_COMPLEXREAD ( &(req->unit), rbuf, &nelem ) ;
+      break ;
+    case RSL_CHARACTER :
+      FORT_CHARACTERREAD ( &(req->unit), rbuf, &nelem ) ;
+      break ;
+    default :
+      RSL_TEST_WRN(1,"read operation not yet implemented for this data type") ;
+    }
+  }
+  /* global record is now stored -- ship it out */
+  switch ( req->iotag )
+  {
+  case IO2D_IJ :
+    columnelems = 1 ;
+    minelems = req->glen[0] ;
+    majelems = req->glen[1] ;
+    break ;
+  case IO2D_JI :
+    columnelems = 1 ;
+    minelems = req->glen[1] ;
+    majelems = req->glen[0] ;
+    break ;
+  case IO3D_IJK :
+    columnelems = req->glen[2] ;
+    minelems = req->glen[0] ;
+    majelems = req->glen[1] ;
+    break ;
+  case IO3D_JIK :
+    columnelems = req->glen[2] ;
+    minelems = req->glen[1] ;
+    majelems = req->glen[0] ;
+    break ;
+  case IO3D_KIJ :
+    columnelems = req->glen[0] ;
+    minelems = req->glen[1] ;
+    majelems = req->glen[2] ;
+    break ;
+  case IO3D_IKJ :
+    columnelems = req->glen[1] ;
+    minelems = req->glen[0] ;
+    majelems = req->glen[2] ;
+    break ;
+  default:
+    RSL_TEST_ERR(1,"handle_read_request: unknown data tag") ;
+  }
+  /*  figure out sizes for each processor */
+  pbuf = NULL ;
+  for ( i = 0 ; i < rsl_nproc_all ; i++ )       /* 95/02/22 */
+  {
+    psize[i] = 0 ;
+    numpts[i] = 0 ;
+  }
+  mlen = domain_info[req->domain].len_m ;
+  nlen = domain_info[req->domain].len_n ;
+  domain = domain_info[req->domain].domain ;
+  for ( jg = 0 ; jg < nlen ; jg++ )
+  {
+    for ( ig = 0 ; ig < mlen ; ig++ )
+    {
+      P = domain[INDEX_2(jg,ig,mlen)].P ;       /* 2002/05/24 */
+      psize[P] += columnelems * typelen ;       /* 2002/05/24 */
+      if ( P >= 0 && P < rsl_nproc_all ) numpts[P]++ ;   /* 2002/05/24 */
+    }
+  }
+  maxnumpts = 0 ;                               /* 2002/05/24 */
+  for ( i = 0 ; i < rsl_nproc_all ; i++ )       /* 2002/05/24 */
+  {                                             /* 2002/05/24 */
+    if ( maxnumpts < numpts[i] ) maxnumpts = numpts[i] ; /* 2002/05/24 */
+  }                                             /* 2002/05/24 */
+
+  iptlst = RSL_MALLOC( int, rsl_nproc_all * maxnumpts ) ;      /* 2002/05/24 */
+  jptlst = RSL_MALLOC( int, rsl_nproc_all * maxnumpts ) ;      /* 2002/05/24 */
+  for ( i = 0 ; i < rsl_nproc_all ; i++ ) numpts[i] = 0 ;      /* 2002/05/24 */
+  for ( jg = 0 ; jg < nlen ; jg++ )                            /* 2002/05/24 */
+  {                                                            /* 2002/05/24 */
+   for ( ig = 0 ; ig < mlen ; ig++ )                           /* 2002/05/24 */
+    {                                                          /* 2002/05/24 */
+      P = domain[INDEX_2(jg,ig,mlen)].P ;                      /* 2002/05/24 */
+      if ( P >= 0 && P < rsl_nproc_all )                       /* 2002/05/24 */
+      {                                                        /* 2002/05/24 */
+        iptlst[INDEX_2(P,numpts[P],maxnumpts)] = ig ;          /* 2002/05/24 */
+        jptlst[INDEX_2(P,numpts[P],maxnumpts)] = jg ;          /* 2002/05/24 */
+        numpts[P]++ ;                                          /* 2002/05/24 */
+      }                                                        /* 2002/05/24 */
+    }                                                          /* 2002/05/24 */
+  }                                                            /* 2002/05/24 */
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )       /* 95/02/22 */
+  {
+    len = 0 ;
+    len += psize[P] ;
+    pbuf = RSL_MALLOC( char, len ) ;
+    resp.response_type = RSL_READ_RESPONSE ;
+    resp.sequence = req->sequence ;
+    resp.tofollow = psize[P] ;
+    cursor = 0 ;
+    /*bcopy( &resp, &(pbuf[cursor]), sizeof( resp )) ; cursor += sizeof(resp) ; */
+
+/* NOTE AND WARNING:  this code is quick and dirty and makes the very
+   naive assumption that the data set being read in is point for point
+   with the domain and is dimensioned to be exactly the same size!!!! 
+   Only with this assumption can the ig, jg indices into the domain
+   data structure be used in this way as indices into the data.  This
+   will work for MM.  A more general approach will require modification. */
+
+#ifndef vpp
+if ( typelen == sizeof ( int ) ) {
+    for ( iii = 0 ; iii < numpts[P] ; iii++ )
+    {
+      ig = iptlst[INDEX_2(P,iii,maxnumpts)] ;
+      jg = jptlst[INDEX_2(P,iii,maxnumpts)] ;
+          RSL_TEST_ERR( cursor >= len,
+   "something wrong with read request: check glen, llen arrays in call") ;
+          switch ( req->iotag )
+          {
+          case IO2D_IJ :
+            ip1 = (int *) &(rbuf[typelen*(ig+jg*req->glen[0])]) ;
+            ip2 = (int *) &(pbuf[cursor]) ;
+            *ip2 = *ip1 ;
+            cursor += typelen ;
+            break ;
+          case IO2D_JI :
+            ip1 = (int *) &(rbuf[typelen*(jg+ig*req->glen[0])]) ;
+            ip2 = (int *) &(pbuf[cursor]) ;
+            *ip2 = *ip1 ;
+            cursor += typelen ;
+            break ;
+          case IO3D_IJK :
+            k = 0 ;
+            ip1 = (int *) &(rbuf[typelen*(ig+req->glen[0]*(jg+k*req->glen[1]))]) ;
+            ip2 = (int *) &(pbuf[cursor]) ;
+            for ( k = 0 ; k < req->glen[2] ; k++ )
+            {
+              *ip2 = *ip1 ;
+              ip1 += req->glen[0] * req->glen[1] ;
+              ip2++ ;
+            }
+            cursor += typelen*req->glen[2]  ;
+            break ;
+          case IO3D_JIK :
+            k = 0 ;
+            ip1 = (int *) &(rbuf[typelen*(jg+req->glen[0]*(ig+k*req->glen[1]))]) ;
+            ip2 = (int *) &(pbuf[cursor]) ;
+            for ( k = 0 ; k < req->glen[2] ; k++ )
+            {
+              *ip2 = *ip1 ;
+              ip1 += req->glen[0] * req->glen[1] ;
+              ip2++ ;
+            }
+            cursor += typelen*req->glen[2]  ;
+            break ;
+          case IO3D_KIJ :
+            k = 0 ;
+            ip1 = (int *) &(rbuf[typelen*(k+req->glen[0]*(ig+jg*req->glen[1]))]) ;
+            ip2 = (int *) &(pbuf[cursor]) ;
+            for ( k = 0 ; k < req->glen[0] ; k++ )
+            {
+              *ip2 = *ip1 ;
+              ip1++ ;
+              ip2++ ;
+            }
+            cursor += typelen*req->glen[0] ;
+            break ;
+          case IO3D_IKJ :
+            k = 0 ;
+            ip1 = (int *) &(rbuf[typelen*(ig+req->glen[0]*(k+jg*req->glen[1]))]) ;
+            ip2 = (int *) &(pbuf[cursor]) ;
+            for ( k = 0 ; k < req->glen[1] ; k++ )
+            {
+              *ip2 = *ip1 ;
+              ip1 += req->glen[0] ;
+              ip2++ ;
+            }
+            cursor += typelen*req->glen[1] ;
+            break ;
+          }
+    }
+} else if ( typelen == sizeof ( double ) ) {
+    for ( iii = 0 ; iii < numpts[P] ; iii++ )
+    {
+      ig = iptlst[INDEX_2(P,iii,maxnumpts)] ;
+      jg = jptlst[INDEX_2(P,iii,maxnumpts)] ;
+          RSL_TEST_ERR( cursor >= len,
+   "something wrong with read request: check glen, llen arrays in call") ;
+          switch ( req->iotag )
+          {
+          case IO2D_IJ :
+            dp1 = (double *) &(rbuf[typelen*(ig+jg*req->glen[0])]) ;
+            dp2 = (double *) &(pbuf[cursor]) ;
+            *dp2 = *dp1 ;
+            cursor += typelen ;
+            break ;
+          case IO2D_JI :
+            dp1 = (double *) &(rbuf[typelen*(jg+ig*req->glen[0])]) ;
+            dp2 = (double *) &(pbuf[cursor]) ;
+            *dp2 = *dp1 ;
+            cursor += typelen ;
+            break ;
+          case IO3D_IJK :
+            k = 0 ;
+            dp1 = (double *) &(rbuf[typelen*(ig+req->glen[0]*(jg+k*req->glen[1]))]) ;
+            dp2 = (double *) &(pbuf[cursor]) ;
+            for ( k = 0 ; k < req->glen[2] ; k++ )
+            {
+              *dp2 = *dp1 ;
+              dp1 += req->glen[0] * req->glen[1] ;
+              dp2++ ;
+            }
+            cursor += typelen*req->glen[2]  ;
+            break ;
+          case IO3D_JIK :
+            k = 0 ;
+            dp1 = (double *) &(rbuf[typelen*(jg+req->glen[0]*(ig+k*req->glen[1]))]) ;
+            dp2 = (double *) &(pbuf[cursor]) ;
+            for ( k = 0 ; k < req->glen[2] ; k++ )
+            {
+              *dp2 = *dp1 ;
+              dp1 += req->glen[0] * req->glen[1] ;
+              dp2++ ;
+            }
+            cursor += typelen*req->glen[2]  ;
+            break ;
+          case IO3D_KIJ :
+            k = 0 ;
+            dp1 = (double *) &(rbuf[typelen*(k+req->glen[0]*(ig+jg*req->glen[1]))]) ;
+            dp2 = (double *) &(pbuf[cursor]) ;
+            for ( k = 0 ; k < req->glen[0] ; k++ )
+            {
+              *dp2 = *dp1 ;
+              dp1++ ;
+              dp2++ ;
+            }
+            cursor += typelen*req->glen[0] ;
+            break ;
+          case IO3D_IKJ :
+            k = 0 ;
+            dp1 = (double *) &(rbuf[typelen*(ig+req->glen[0]*(k+jg*req->glen[1]))]) ;
+            dp2 = (double *) &(pbuf[cursor]) ;
+            for ( k = 0 ; k < req->glen[1] ; k++ )
+            {
+              *dp2 = *dp1 ;
+              dp1 += req->glen[0] ;
+              dp2++ ;
+            }
+            cursor += typelen*req->glen[1] ;
+            break ;
+          }
+    }
+}else{
+    for ( iii = 0 ; iii < numpts[P] ; iii++ )
+    {
+      ig = iptlst[INDEX_2(P,iii,maxnumpts)] ;
+      jg = jptlst[INDEX_2(P,iii,maxnumpts)] ;
+          RSL_TEST_ERR( cursor >= len,
+   "something wrong with read request: check glen, llen arrays in call") ;
+          switch ( req->iotag )
+          {
+          case IO2D_IJ :
+            bcopy(&(rbuf[typelen*(ig+jg*req->glen[0])]),
+                  &(pbuf[cursor]),
+                  typelen) ;
+            cursor += typelen ;
+            break ;
+          case IO2D_JI :
+            bcopy(&(rbuf[typelen*(jg+ig*req->glen[0])]),
+                  &(pbuf[cursor]),
+                  typelen) ;
+            cursor += typelen ;
+            break ;
+          case IO3D_IJK :
+            for ( k = 0 ; k < req->glen[2] ; k++ )
+            {
+              bcopy(&(rbuf[typelen*(ig+req->glen[0]*(jg+k*req->glen[1]))]),
+                    &(pbuf[cursor]),
+                    typelen) ;
+              cursor += typelen ;
+            }
+            break ;
+          case IO3D_JIK :
+            for ( k = 0 ; k < req->glen[2] ; k++ )
+            {
+              bcopy(&(rbuf[typelen*(jg+req->glen[0]*(ig+k*req->glen[1]))]),
+                    &(pbuf[cursor]),
+                    typelen) ;
+              cursor += typelen ;
+            }
+            break ;
+          case IO3D_KIJ :
+            for ( k = 0 ; k < req->glen[0] ; k++ )
+            {
+              bcopy(&(rbuf[typelen*(k+req->glen[0]*(ig+jg*req->glen[1]))]),
+                    &(pbuf[cursor]),
+                    typelen) ;
+              cursor += typelen ;
+            }
+            break ;
+          case IO3D_IKJ :
+            for ( k = 0 ; k < req->glen[1] ; k++ )
+            {
+              bcopy(&(rbuf[typelen*(ig+req->glen[0]*(k+jg*req->glen[1]))]),
+                    &(pbuf[cursor]),
+                    typelen) ;
+              cursor += typelen ;
+            }
+            break ;
+          }
+    }
+}
+#else
+    for ( jg = 0 ; jg < nlen ;  jg++ )
+    {
+      if ( domain[INDEX_2(jg,0,mlen)].P == P )
+      {
+          switch ( req->iotag )
+          {
+          case IO2D_IJ :
+            if ( req->type == RSL_REAL )
+            {
+              ig = 0 ;
+              VRCOPY (&(rbuf[typelen*(ig+jg*req->glen[0])]),
+                      &(pbuf[cursor]),
+                      &mlen) ;
+              cursor += typelen*mlen ;
+            }
+            else
+            {
+              for ( ig = 0 ; ig < mlen ; ig++ )
+              {
+                bcopy(&(rbuf[typelen*(ig+jg*req->glen[0])]),
+                      &(pbuf[cursor]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+            }
+            break ;
+          case IO2D_JI :
+            if ( req->type == RSL_REAL )
+            {
+              for ( ig = 0 ; ig < mlen ; ig++ )
+              {
+                bcopy(&(rbuf[typelen*(jg+ig*req->glen[0])]),
+                      &(pbuf[cursor]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+            }
+            break ;
+          case IO3D_IJK :
+            if ( req->type == RSL_REAL )
+            {
+              ig = 0 ;
+              for ( k = 0 ; k < req->glen[2] ; k++ )
+              {
+                VRCOPY (&(rbuf[typelen*(ig+req->glen[0]*(jg+k*req->glen[1]))]),
+                        &(pbuf[cursor]),
+                        &mlen) ;
+                cursor += typelen*mlen ;
+              }
+            }
+            else
+            {
+              for ( k = 0 ; k < req->glen[2] ; k++ )
+              {
+                for ( ig = 0 ; ig < mlen ; ig++ )
+                {
+                  bcopy(&(rbuf[typelen*(ig+req->glen[0]*(jg+k*req->glen[1]))]),
+                        &(pbuf[cursor]),
+                        typelen) ;
+                  cursor += typelen ;
+                }
+              }
+            }
+            break ;
+          case IO3D_JIK :
+            for ( ig = 0 ; ig < mlen ; ig++ )
+            {
+              for ( k = 0 ; k < req->glen[2] ; k++ )
+              {
+                bcopy(&(rbuf[typelen*(jg+req->glen[0]*(ig+k*req->glen[1]))]),
+                      &(pbuf[cursor]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+            }
+            break ;
+          case IO3D_KIJ :
+            for ( ig = 0 ; ig < mlen ; ig++ )
+            {
+              for ( k = 0 ; k < req->glen[0] ; k++ )
+              {
+                bcopy(&(rbuf[typelen*(k+req->glen[0]*(ig+jg*req->glen[1]))]),
+                      &(pbuf[cursor]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+            }
+            break ;
+          case IO3D_IKJ :
+            for ( ig = 0 ; ig < mlen ; ig++ )
+            {
+              for ( k = 0 ; k < req->glen[1] ; k++ )
+              {
+                bcopy(&(rbuf[typelen*(ig+req->glen[0]*(k+jg*req->glen[1]))]),
+                      &(pbuf[cursor]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+            }
+            break ;
+
+        }
+      }
+    }
+#endif
+    mdest = rsl_c_comp2phys_proc( P ) ;
+    mtag = MTYPE_FROMTO( MSG_READ_RESPONSE, rsl_myproc, mdest ) ;
+    msglen = sizeof( resp ) ;
+
+#ifndef T3D
+     { int i, j  ;
+       for ( i = 0 ; i < msglen ; i++ )
+       {
+         j = j + pbuf[i] ;
+       }
+       dumdebug(j) ;
+     }
+#endif
+
+
+    if ( rsl_myproc == mdest )
+    {
+      bcopy( &resp, resp_me, msglen ) ;
+      *pbuf_me = pbuf ;
+    }
+    else
+    {
+      RSL_SEND( &resp, msglen, mtag, mdest ) ;
+      msglen = resp.tofollow ;
+      RSL_SEND( pbuf, msglen, mtag, mdest ) ;
+      RSL_FREE( pbuf ) ;
+    }
+  }
+
+  RSL_FREE (iptlst) ;   /* 20020524 */
+  RSL_FREE (jptlst) ;   /* 20020524 */
+  RSL_FREE( rbuf ) ;
+  return(0) ;
+}
+
+static int wrt_sock_err = 0 ;
+#ifdef NEC_TUNE
+static int pndomains_init = 0;
+static int pndomains[ RSL_MAXPROC ] ; /* Number of domains for each processor */
+#endif
+
+int
+handle_write_request( req, nelem, psize_me, pbuf_me )
+  rsl_write_req_t * req ;
+  int nelem ;
+  int psize_me ;
+  char * pbuf_me ;
+{
+  int dim, i, k, ig, jg, nbytes ;
+  int columnelems, typelen, len, cursor  ;
+  int P ;
+  int minelems, majelems ;
+  int msglen, mtag, mtag2, mdest, mfrom ;
+  int mlen, nlen ;
+  rsl_read_resp_t resp ;
+  int psize[ RSL_MAXPROC ] ;    /* size of messages to each processor */
+  float * pr , * qr ;
+  char * wbuf ;
+  char *pbuf ;
+  rsl_point_t *domain ;
+  int is_write, ie_write, js_write, je_write ;
+  int in_write ;
+#ifdef NEC_TUNE
+  int tcursor ;
+  int j ;
+#endif
+
+  typelen = elemsize( req->type ) ;
+  nbytes = typelen * nelem ;
+  wbuf = RSL_MALLOC( char, nbytes ) ;  
+
+  mlen = domain_info[req->domain].len_m ;
+  nlen = domain_info[req->domain].len_n ;
+  domain = domain_info[req->domain].domain ;
+
+  /* global record is now stored -- ship it out */
+  switch ( req->iotag )
+  {
+  case IO2D_IJ :
+  case IO2D_IJ_RAW :
+  case IO2D_IJ_PORTAL :
+  case IO2D_IJ_88 :
+    columnelems = 1 ;
+    minelems = req->glen[0] ;
+    majelems = req->glen[1] ;
+    break ;
+  case IO2D_JI :
+  case IO2D_JI_RAW :
+  case IO2D_JI_PORTAL :
+  case IO2D_JI_88 :
+    columnelems = 1 ;
+    minelems = req->glen[1] ;
+    majelems = req->glen[0] ;
+    break ;
+  case IO3D_IJK :
+  case IO3D_IJK_RAW :
+  case IO3D_IJK_PORTAL :
+  case IO3D_IJK_88 :
+    columnelems = req->glen[2] ;
+    minelems = req->glen[0] ;
+    majelems = req->glen[1] ;
+    break ;
+  case IO3D_JIK :
+  case IO3D_JIK_RAW :
+  case IO3D_JIK_PORTAL :
+  case IO3D_JIK_88 :
+    columnelems = req->glen[2] ;
+    minelems = req->glen[1] ;
+    majelems = req->glen[0] ;
+    break ;
+  case IO3D_KIJ :
+    columnelems = req->glen[0] ;
+    minelems = req->glen[1] ;
+    majelems = req->glen[2] ;
+    break ;
+  case IO3D_IKJ :
+    columnelems = req->glen[1] ;
+    minelems = req->glen[0] ;
+    majelems = req->glen[2] ;
+    break ;
+  default:
+    RSL_TEST_ERR(1,"handle_write_request: unknown data tag") ;
+  }
+
+  RSL_TEST_ERR( majelems <= 0, "Major dim spec on write is zero or less.") ;
+  RSL_TEST_ERR( minelems <= 0, "Minor dim spec on write is zero or less.") ;
+  if ( majelems > nlen )
+  { sprintf(mess,"Major dim spec on write (%d) greater than global domain defini tion in that dimension (%d)\n",majelems,nlen) ;
+    RSL_TEST_ERR(1,mess) ; }
+  if ( minelems > mlen )
+  { sprintf(mess,"Minor dim spec on write (%d) greater than global domain defini tion in that dimension (%d)\n",minelems,mlen) ;
+    RSL_TEST_ERR(1,mess) ; }
+
+#if !(defined(NEC_TUNE)) || !(defined(NEC_SINGLENEST))
+#ifndef NEC_TUNE
+  /*  figure out sizes for each processor */
+  pbuf = NULL ;
+  for ( i = 0 ; i < rsl_nproc_all ; i++ )       /* 95/02/22 */
+  {
+    psize[i] = (regular_decomp)?(4*sizeof(int)):0 ;
+  }
+  for ( jg = 0 ; jg < majelems ; jg++ )
+  {
+    for ( ig = 0 ; ig < minelems ; ig++ )
+    {
+      psize[domain[INDEX_2(jg,ig,mlen)].P] += columnelems * typelen ;
+    }
+  }
+#else
+  pbuf = NULL ;
+/*
+   NECNOTE:
+   Count the number of domains allocated to each processor.
+*/
+  for ( i = 0 ; i < rsl_nproc_all ; i++ )
+  {
+    pndomains[i] = 0 ;
+  }
+  for ( i = 0 ; i < rsl_nproc_all ; i++ )
+  {
+    j = 0 ;
+    for ( jg = 0 ; jg < majelems ; jg++ )
+    {
+      for ( ig = 0 ; ig < minelems ; ig++ )
+      {
+        if( domain[INDEX_2(jg,ig,mlen)].P == i )
+        {
+          j++ ;
+        }
+      }
+    }
+    pndomains[i] = j ;
+  }
+  for ( i = 0 ; i < rsl_nproc_all ; i++ )
+  {
+    psize[i] = ((regular_decomp)?(4*sizeof(int)):0) + pndomains[i]*columnelems*typelen ;
+  }
+#endif
+#else /* !(defined(NEC_TUNE)) || !(defined(NEC_SINGLENEST)) */
+  pbuf = NULL ;
+  if ( ! pndomains_init )
+  {
+/*
+   NECNOTE:
+   Count the number of domains allocated to each processor.
+*/
+    for ( i = 0 ; i < rsl_nproc_all ; i++ )
+    {
+      pndomains[i] = 0 ;
+    }
+    for ( i = 0 ; i < rsl_nproc_all ; i++ )
+    {
+      j = 0 ;
+      for ( jg = 0 ; jg < majelems ; jg++ )
+      {
+        for ( ig = 0 ; ig < minelems ; ig++ )
+        {
+          if( domain[INDEX_2(jg,ig,mlen)].P == i )
+          {
+            j++ ;
+          }
+        }
+      }
+      pndomains[i] = j ;
+    }
+  }
+  for ( i = 0 ; i < rsl_nproc_all ; i++ )
+  {
+    psize[i] = ((regular_decomp)?(4*sizeof(int)):0) + pndomains[i]*columnelems*typelen ;
+  }
+#endif /* !(defined(NEC_TUNE)) || !(defined(NEC_SINGLENEST)) */
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )       /* 95/02/22 */
+  {
+    cursor = 0 ;
+    mdest = rsl_c_comp2phys_proc( P ) ;
+    if ( rsl_myproc != mdest )
+    {
+#ifdef RSL_SYNCIO
+      /* send a short "go ahead" message */
+      msglen = 1 ;
+      mfrom = mdest ;
+      mtag2 = MTYPE_FROMTO( MSG_WRITE_COMPUTE_RESPONSE, rsl_myproc, mfrom ) ;
+      RSL_SEND( " ", msglen, mtag2, mfrom ) ;
+#endif
+      msglen = psize[P] ;
+      pbuf = RSL_MALLOC( char, msglen ) ;
+      mfrom = mdest ;
+      mtag2 = MTYPE_FROMTO( MSG_WRITE_COMPUTE_RESPONSE, mfrom, rsl_myproc ) ;
+      RSL_RECV( pbuf, msglen, mtag2 ) ;
+    }
+    else
+    {
+      sprintf(mess,"psize_me (%d) != psize[P] (%d)", psize_me,psize[P]) ;
+      RSL_TEST_ERR( psize_me != psize[P], mess ) ;
+      msglen = psize_me ;
+      pbuf = pbuf_me ;
+    }
+
+    if ( regular_decomp )
+    {
+
+      bcopy( &(pbuf[cursor]), &is_write, sizeof(int) ) ; cursor += sizeof(int) ;
+      bcopy( &(pbuf[cursor]), &ie_write, sizeof(int) ) ; cursor += sizeof(int) ;
+      bcopy( &(pbuf[cursor]), &js_write, sizeof(int) ) ; cursor += sizeof(int) ;
+      bcopy( &(pbuf[cursor]), &je_write, sizeof(int) ) ; cursor += sizeof(int) ;
+
+      in_write = ie_write - is_write + 1 ;
+
+      for ( jg = js_write ; jg <= je_write ; jg++ )
+      {
+        switch ( req->iotag )
+        {
+          case IO2D_IJ :
+          case IO2D_IJ_RAW :
+          case IO2D_IJ_PORTAL :
+          case IO2D_IJ_88 :
+            if ( req->type == RSL_REAL )
+            {
+               ig = is_write ;
+               VRCOPY ( &(pbuf[cursor]),
+                       &(wbuf[typelen*(ig+jg*req->glen[0])]),
+                       &in_write ) ;
+               cursor += in_write*typelen ;
+            }
+            else
+            {
+              for ( ig = is_write ; ig <= ie_write ; ig++ )
+              {
+                bcopy(&(pbuf[cursor]),
+                      &(wbuf[typelen*(ig+jg*req->glen[0])]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+            }
+            break ;
+          case IO2D_JI :
+          case IO2D_JI_RAW :
+          case IO2D_JI_PORTAL :
+          case IO2D_JI_88 :
+            for ( ig = is_write ; ig <= ie_write ; ig++ )
+            {
+              bcopy(&(pbuf[cursor]),
+                    &(wbuf[typelen*(jg+ig*req->glen[0])]),
+                    typelen) ;
+              cursor += typelen ;
+            }
+            break ;
+          case IO3D_IJK :
+          case IO3D_IJK_RAW :
+          case IO3D_IJK_PORTAL :
+          case IO3D_IJK_88 :
+            if ( req->type == RSL_REAL )
+            {
+              ig = is_write ;
+              for ( k = 0 ; k < req->glen[2] ; k++ )   /* note reversal of i and k on vpp */
+              {
+                VRCOPY ( &(pbuf[cursor]),
+                        &(wbuf[typelen*(ig+req->glen[0]*(jg+k*req->glen[1]))]),
+                        &in_write ) ;
+                cursor += typelen*in_write ;
+              }
+            }
+            else
+            {
+              for ( k = 0 ; k < req->glen[2] ; k++ )   /* note reversal of i and k on vpp */
+              {
+                for ( ig = is_write ; ig <= ie_write ; ig++ )
+                {
+                  bcopy(&(pbuf[cursor]),
+                        &(wbuf[typelen*(ig+req->glen[0]*(jg+k*req->glen[1]))]),
+                        typelen) ;
+                  cursor += typelen ;
+                }
+              }
+            }
+            break ;
+          case IO3D_JIK :
+          case IO3D_JIK_RAW :
+          case IO3D_JIK_PORTAL :
+          case IO3D_JIK_88 :
+            for ( k = 0 ; k < req->glen[2] ; k++ )
+            {
+              for ( ig = is_write ; ig <= ie_write ; ig++ )
+              {
+                bcopy(&(pbuf[cursor]),
+                      &(wbuf[typelen*(jg+req->glen[0]*(ig+k*req->glen[1]))]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+            }
+            break ;
+          case IO3D_KIJ :
+            for ( ig = is_write ; ig <= ie_write ; ig++ )
+            {
+              for ( k = 0 ; k < req->glen[0] ; k++ )
+              {
+                bcopy(&(pbuf[cursor]),
+                      &(wbuf[typelen*(k+req->glen[0]*(ig+jg*req->glen[1]))]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+            }
+            break ;
+          case IO3D_IKJ :
+#ifndef NEC_TUNE
+            for ( ig = is_write ; ig <= ie_write ; ig++ )
+            {
+              for ( k = 0 ; k < req->glen[1] ; k++ )
+              {
+                bcopy(&(pbuf[cursor]),
+                      &(wbuf[typelen*(ig+req->glen[0]*(k+jg*req->glen[1]))]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+            }
+#else
+            for ( k = 0 ; k < req->glen[1] ; k++ )
+            {
+              tcursor = cursor + (k * typelen) ;
+              copymem(&(pbuf[tcursor]), typelen*req->glen[1],
+                &(wbuf[typelen*(is_write+req->glen[0]*(k+jg*req->glen[1]))]), typelen,
+                typelen, ie_write-is_write+1) ;
+            }
+            cursor += (ie_write-is_write+1)*req->glen[1]*typelen ;
+#endif
+            break ;
+        }
+      }
+    }
+    else
+    {
+      for ( jg = 0 ; jg < majelems ; jg++ )
+      {
+        for ( ig = 0 ; ig < minelems ; ig++ )
+        {
+          if ( domain[INDEX_2(jg,ig,mlen)].P == P )
+          {
+            switch ( req->iotag )
+            {
+            case IO2D_IJ :
+            case IO2D_IJ_RAW :
+            case IO2D_IJ_PORTAL :
+            case IO2D_IJ_88 :
+              bcopy(&(pbuf[cursor]),
+                    &(wbuf[typelen*(ig+jg*req->glen[0])]),
+                    typelen) ;
+              cursor += typelen ;
+              break ;
+            case IO2D_JI :
+            case IO2D_JI_RAW :
+            case IO2D_JI_PORTAL :
+            case IO2D_JI_88 :
+              bcopy(&(pbuf[cursor]),
+                    &(wbuf[typelen*(jg+ig*req->glen[0])]),
+                    typelen) ;
+              cursor += typelen ;
+              break ;
+            case IO3D_IJK :
+            case IO3D_IJK_RAW :
+            case IO3D_IJK_PORTAL :
+            case IO3D_IJK_88 :
+              for ( k = 0 ; k < req->glen[2] ; k++ )
+              {
+                bcopy(&(pbuf[cursor]),
+                      &(wbuf[typelen*(ig+req->glen[0]*(jg+k*req->glen[1]))]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+              break ;
+            case IO3D_JIK :
+            case IO3D_JIK_RAW :
+            case IO3D_JIK_PORTAL :
+            case IO3D_JIK_88 :
+              for ( k = 0 ; k < req->glen[2] ; k++ )
+              {
+                bcopy(&(pbuf[cursor]),
+                      &(wbuf[typelen*(jg+req->glen[0]*(ig+k*req->glen[1]))]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+              break ;
+            case IO3D_KIJ :
+              for ( k = 0 ; k < req->glen[0] ; k++ )
+              {
+                bcopy(&(pbuf[cursor]),
+                      &(wbuf[typelen*(k+req->glen[0]*(ig+jg*req->glen[1]))]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+              break ;
+            case IO3D_IKJ :
+              for ( k = 0 ; k < req->glen[1] ; k++ )
+              {
+                bcopy(&(pbuf[cursor]),
+                      &(wbuf[typelen*(ig+req->glen[0]*(k+jg*req->glen[1]))]),
+                      typelen) ;
+                cursor += typelen ;
+              }
+              break ;
+
+            }
+          }
+        }
+      }
+    }
+    if ( rsl_myproc != rsl_c_comp2phys_proc( P ) ) 
+    {
+      RSL_FREE( pbuf ) ;   /* the monitor frees its own buffer outside
+                              this routine */
+    }
+  }
+
+  /* mark the unit as needing to be flushed */
+  if ( ! req->internal )
+  {
+    unit_written[ req->unit - 1 ] = (unsigned char) 1 ;
+  }
+
+/* start 981228 AFWA_IO */
+/* need some kind of graceful failure if the node runs out of memory */
+  if ( rsl_buffer_output && ! req->internal )
+  {
+    if ( write_buffer_head == NULL && write_buffer_tail == NULL )
+    {
+      write_buffer_head = RSL_MALLOC( rsl_write_buffer_struct_t, 1 ) ;
+      write_buffer_tail = write_buffer_head ;
+    }
+    else
+    {
+      write_buffer_tail->next = RSL_MALLOC( rsl_write_buffer_struct_t, 1 ) ;
+      write_buffer_tail = write_buffer_tail->next ;
+    }
+    write_buffer_tail->req       = *req ;
+    write_buffer_tail->nelem     = nelem ;
+    write_buffer_tail->buf       = RSL_MALLOC( char, nelem * elemsize( req->type ) ) ;
+    bcopy( wbuf, write_buffer_tail->buf, nelem * elemsize( req->type ) ) ;
+  }
+  else
+  {
+    send_to_output_device( req, wbuf, nelem ) ;
+  }
+  RSL_FREE( wbuf ) ;
+  return(0) ;
+}
+
+
+/* these routines added for MM5 v3 */
+
+
+RSL_WRITE_1D_DATA( unit_p,
+                   buf,
+                   nbuf_p,
+                   type_p  )
+  int_p  unit_p ;
+  char * buf             ;  int_p nbuf_p   ;
+  int_p  type_p ;
+{
+  rsl_write_req_t req ;
+  int nelem ;
+  int icurs ;
+  char * wbuf ;
+  int i_am_monitor ;
+  int type, typelen ;
+
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+  if ( ! i_am_monitor ) return ;
+
+  nelem = *nbuf_p ;
+  type = *type_p ;
+  typelen = elemsize( type ) ;
+          
+  req.internal     = 0 ;
+  req.request_type = RSL_WRITE_REQUEST ;
+  req.request_mode = MSG_IO_FORTRAN    ;
+  req.unit         = *unit_p           ;
+  req.unit_p       = unit_p            ;
+  req.iotag        = IO_REPL           ;
+  req.type         = type     ;
+
+  wbuf             = RSL_MALLOC( char, nelem*typelen ) ;
+
+  icurs = 0 ;
+  bcopy( buf  , wbuf, nelem*typelen ) ;
+
+  if ( rsl_buffer_output && ! req.internal )
+  {
+    if ( write_buffer_head == NULL && write_buffer_tail == NULL )
+    {
+      write_buffer_head = RSL_MALLOC( rsl_write_buffer_struct_t, 1 ) ;
+      write_buffer_tail = write_buffer_head ;
+    }
+    else
+    {
+      write_buffer_tail->next = RSL_MALLOC( rsl_write_buffer_struct_t, 1 ) ;
+      write_buffer_tail = write_buffer_tail->next ;
+    }
+    write_buffer_tail->req       = req ;
+    write_buffer_tail->nelem     = nelem ;
+    write_buffer_tail->buf       = RSL_MALLOC( char, nelem*typelen ) ;
+    bcopy( wbuf, write_buffer_tail->buf, nelem*typelen ) ;
+  }
+  else
+  {
+    send_to_output_device( &req, wbuf, nelem ) ;
+  }
+
+  RSL_FREE( wbuf ) ;
+}
+
+send_to_output_device( req, wbuf, nelem )
+  rsl_write_req_t * req ;
+  char * wbuf ;
+  int nelem ;
+{
+
+  int nbytes, typelen, minelems, majelems, columnelems ;
+  int ig, jg ;
+
+  typelen = elemsize( req->type ) ;
+  nbytes = typelen * nelem ;
+
+  /* global record is now stored -- ship it out */
+  switch ( req->iotag )
+  {
+  case IO2D_IJ :
+  case IO2D_IJ_RAW :
+  case IO2D_IJ_PORTAL :
+  case IO2D_IJ_88 :
+    columnelems = 1 ;
+    minelems = req->glen[0] ;
+    majelems = req->glen[1] ;
+    break ;
+  case IO2D_JI :
+  case IO2D_JI_RAW :
+  case IO2D_JI_PORTAL :
+  case IO2D_JI_88 :
+    columnelems = 1 ;
+    minelems = req->glen[1] ;
+    majelems = req->glen[0] ;
+    break ;
+  case IO3D_IJK :
+  case IO3D_IJK_RAW :
+  case IO3D_IJK_PORTAL :
+  case IO3D_IJK_88 :
+    columnelems = req->glen[2] ;
+    minelems = req->glen[0] ;
+    majelems = req->glen[1] ;
+    break ;
+  case IO3D_JIK :
+  case IO3D_JIK_RAW :
+  case IO3D_JIK_PORTAL :
+  case IO3D_JIK_88 :
+    columnelems = req->glen[2] ;
+    minelems = req->glen[1] ;
+    majelems = req->glen[0] ;
+    break ;
+  case IO3D_KIJ :
+    columnelems = req->glen[0] ;
+    minelems = req->glen[1] ;
+    majelems = req->glen[2] ;
+    break ;
+  case IO3D_IKJ :
+    columnelems = req->glen[1] ;
+    minelems = req->glen[0] ;
+    majelems = req->glen[2] ;
+    break ;
+  case IO_REPL :
+    break ;
+  default:
+    RSL_TEST_ERR(1,"handle_write_request: unknown data tag") ;
+  }
+
+  if ( req->request_mode == MSG_IO_FORTRAN )
+  {
+
+  /* call fortran to write a record to the named unit */
+    if ( req->internal )
+    {
+      bcopy( wbuf, req->unit_p, nbytes ) ;
+    }
+    else
+    {
+      /* call fortran to write a record to the named unit */
+      switch ( req->type )
+      {
+      case RSL_REAL :
+        FORT_REALWRITE ( &(req->unit), wbuf, &nelem ) ;
+        break ;
+      case RSL_INTEGER :
+        FORT_INTWRITE ( &(req->unit), wbuf, &nelem ) ;
+        break ;
+#ifndef T3D
+      case RSL_DOUBLE :
+        FORT_DOUBLEWRITE ( &(req->unit), wbuf, &nelem ) ;
+        break ;
+#endif
+      case RSL_COMPLEX :
+        FORT_COMPLEXWRITE ( &(req->unit), wbuf, &nelem ) ;
+        break ;
+      case RSL_CHARACTER :
+#ifndef T3D
+        FORT_CHARACTERWRITE ( &(req->unit), wbuf, &nelem ) ;
+#else
+        {
+          _fcd x ;
+          x = _cptofcd( wbuf, nelem ) ;
+          FORT_CHARACTERWRITE ( &(req->unit), x, &nelem ) ;
+        }
+#endif
+        break ;
+      default :
+        RSL_TEST_WRN(1,"write operation not implemented for this data type") ;
+      }
+    }
+  }
+  else
+  if ( req->request_mode == MSG_IO_SOCKET )
+  {
+    /* nbytes contains the number of bytes to be written,
+       wbuf is the buffer to be written,
+       req->unit is the socket id */
+
+    int cw ;
+    struct hdr_info_3d
+    {
+       int  typelen, xdim, ydim, zdim;
+    } wbuf_header ;
+
+    if ( req->request_mode2 == MSG_MODE2_RAW )
+    {
+      if ( write_sock( req->unit, wbuf, nbytes ) < 0 )
+      {
+        perror("writing on socket");
+        RSL_TEST_WRN(1,"") ;
+      }
+    }
+    else
+    if ( req->request_mode2 == MSG_MODE2_FORTRAN )
+    {
+      /* simulate control words at beginning and end */
+      cw = nbytes ;
+
+      if (write_sock(req->unit , &cw, 4)  < 0)
+      {
+        perror("writing first control word on socket");
+        RSL_TEST_WRN(1,"") ;
+      }
+      if (write_sock(req->unit , wbuf, nbytes )  < 0)
+      {
+        perror("writing wbuf on socket");
+        RSL_TEST_WRN(1,"") ;
+      }
+      if (write_sock(req->unit , &cw, 4)  < 0)
+      {
+        perror("writing second control word on socket");
+        RSL_TEST_WRN(1,"") ;
+      }
+    }
+    else
+    if ( req->request_mode2 == MSG_MODE2_PORTAL )
+    {
+      wbuf_header.typelen = typelen ;
+      wbuf_header.xdim  = minelems ;
+      wbuf_header.ydim  = majelems ;
+      wbuf_header.zdim  = columnelems ;
+      if (write_sock(req->unit , &wbuf_header , sizeof( wbuf_header ) )  < 0)
+      {
+        perror("writing wbuf header on socket");
+        RSL_TEST_WRN(1,"") ;
+      }
+      if (write_sock(req->unit , wbuf , nbytes )  < 0)
+      {
+        perror("writing wbuf header on socket");
+        RSL_TEST_WRN(1,"") ;
+      }
+    }
+    else
+    if ( req->request_mode2 == MSG_MODE2_88 )
+    {
+      int x,y,z ;
+      char outline[256] ;
+      for ( z = 0; z < columnelems ; z++ )
+      {
+        sprintf(outline,"%d %d\n",majelems,minelems) ;
+        if (write_sock(req->unit , outline , strlen( outline ) )  < 0)
+        {
+          if ( ! wrt_sock_err )
+          {
+            wrt_sock_err = 1 ;
+            perror("writing wbuf header on socket");
+            RSL_TEST_WRN(1,"") ;
+          }
+        }
+        else
+        {
+        for ( ig = 0 ; ig < minelems ; ig++ )
+        {
+          for ( jg = 0 ; jg < majelems ; jg++ )
+          {
+            if ( req->type == RSL_REAL )
+            {
+               float a ;
+               bcopy(&(wbuf[typelen*(jg+ig*req->glen[0])]),&a,sizeof(float)) ;
+               sprintf(outline,"%g\n",a) ;
+            }
+            else if ( req->type == RSL_DOUBLE )
+            {
+               double a ;
+               bcopy(&(wbuf[typelen*(jg+ig*req->glen[0])]),&a,sizeof(double)) ;
+               sprintf(outline,"%g\n",a) ;
+            }
+            else if ( req->type == RSL_INTEGER )
+            {
+               int a ;
+               bcopy(&(wbuf[typelen*(jg+ig*req->glen[0])]),&a,sizeof(int)) ;
+               sprintf(outline,"%d\n",a) ;
+            }
+            if (write_sock(req->unit , outline , strlen(outline) )  < 0)
+            {
+              if ( ! wrt_sock_err )
+              {
+                wrt_sock_err = 1 ;
+                perror("writing wbuf header on socket");
+                RSL_TEST_WRN(1,"") ;
+              }
+            }
+          }
+        }
+        }
+      }
+    }
+    else
+    {
+      sprintf(mess, "Unknown request request_mode2: %d\n",
+              req->request_mode2 ) ;
+      RSL_TEST_ERR(1,mess) ;
+    }
+  }
+  else
+  {
+    sprintf(mess, "Unknown request request_mode: %d\n",
+                  req->request_mode ) ;
+    RSL_TEST_ERR(1,mess) ;
+  }
+}
+
+RSL_OUTPUT_BUFFER_WRITE ()
+{
+  int i_am_monitor ;
+  rsl_write_buffer_struct_t * p, * old ;
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+
+  if ( rsl_buffer_output && i_am_monitor && write_buffer_head != NULL )
+  {
+    for ( p = write_buffer_head ; p ; )
+    {
+      send_to_output_device( &(p->req), p->buf, p->nelem ) ;
+      RSL_FREE( p->buf ) ;
+      old = p ;
+      p = p->next ;
+      RSL_FREE( old ) ;
+    }
+  }
+  write_buffer_head = NULL  ;
+  write_buffer_tail = NULL  ;
+}
+
+RSL_OUTPUT_BUFFER_YES ()
+{
+  rsl_buffer_output = 1 ;
+}
+RSL_OUTPUT_BUFFER_NO ()
+{
+  rsl_buffer_output = 0 ;
+}
+
+RSL_IO_NODE_YES ()
+{
+  rsl_io_node = 1 ;
+}
+RSL_IO_NODE_NO ()
+{
+  rsl_io_node = 0 ;
+}
+
+
+
+#include <signal.h>
+
+write_sock( sd, buf, n )
+  int sd ;
+  char * buf ;
+  int n ;
+{
+  static int errseen = 0 ;
+  int todo, n_written ;
+  char * p ;
+
+  signal( SIGPIPE, SIG_IGN ) ;  /* if the receiver dies, we should cont */
+  todo = n ;
+  p = buf ;
+  if ( ! errseen )
+    do {
+      if ((n_written = write(sd, p, todo)) < 0 )
+      {
+        errseen = 1 ;
+        perror("write_sock") ;
+        return( n_written ) ;
+      }
+      p += n_written ;
+      todo -= n_written ;
+    } while ( todo > 0 ) ;
+  signal( SIGPIPE, SIG_DFL ) ;
+
+  return(n) ;
+}
+
+/* On vpp from here to remainder of file, we may be bcopying character strings
+   so undefine the substution to the vector bcopy */
+#if defined(vpp) || defined(vpp2)
+#undef bcopy
+#endif
+
+
+RSL_WRITE_MM5V3_SM_HEADER( unit_p,ndim_p,
+                        s1_p,s2_p,s3_p,s4_p,
+                        e1_p,e2_p,e3_p,e4_p,
+                        iwordsize_p,
+                        xtime_p,
+                        rwordsize_p,
+                        staggering_p,     nstaggering_p,
+                        ordering_p,       nordering_p,
+                        current_date_p,   ncurrent_date_p,
+                        name_p,           nname_p,
+                        units_p,          nunits_p,
+                        description_p,    ndescription_p )
+  int_p unit_p ;
+  int_p ndim_p ;
+  int_p s1_p, s2_p, s3_p, s4_p ;
+  int_p e1_p, e2_p, e3_p, e4_p ;
+  int_p  iwordsize_p ;
+  char * xtime_p ;
+  int_p  rwordsize_p ;
+#ifndef T3D
+  char * staggering_p     ;  int_p nstaggering_p   ;
+  char * ordering_p       ;  int_p nordering_p      ;
+  char * current_date_p   ;  int_p ncurrent_date_p  ;
+  char * name_p           ;  int_p nname_p          ;
+  char * units_p          ;  int_p nunits_p         ;
+  char * description_p    ;  int_p ndescription_p   ;
+#else
+  _fcd staggering_p     ;  int_p nstaggering_p   ;
+  _fcd ordering_p       ;  int_p nordering_p      ;
+  _fcd current_date_p   ;  int_p ncurrent_date_p  ;
+  _fcd name_p           ;  int_p nname_p          ;
+  _fcd units_p          ;  int_p nunits_p         ;
+  _fcd description_p    ;  int_p ndescription_p   ;
+#endif
+{
+  rsl_write_req_t req ;
+  int nelem ;
+  int iwordsize ;
+  int rwordsize ;
+  int nstringbytes ;
+  int icurs ;
+  char * wbuf ;
+  int i_am_monitor ;
+
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+  if ( ! i_am_monitor ) return ;
+
+  iwordsize = *iwordsize_p ;
+  rwordsize = *rwordsize_p ;
+  nstringbytes =  *nstaggering_p+ *nordering_p+ *ncurrent_date_p
+                + *nname_p+ *nunits_p+ *ndescription_p ;
+#ifndef T3D
+  nelem = 9 * iwordsize + 1 * rwordsize + nstringbytes ;
+#else
+  nelem = 9 * iwordsize/2 + 1 * rwordsize/2 + nstringbytes ;
+#endif
+
+  req.internal     = 0 ;
+  req.request_type = RSL_WRITE_REQUEST ;
+  req.request_mode = MSG_IO_FORTRAN    ;
+  req.unit         = *unit_p           ;
+  req.unit_p       = unit_p            ;
+  req.iotag        = IO_REPL           ;
+  req.type         = RSL_CHARACTER     ;
+
+  wbuf       = RSL_MALLOC( char, nelem ) ;
+
+  icurs = 0 ;
+#ifndef T3D
+  bcopy( ndim_p, &(wbuf[icurs]), iwordsize ) ;   icurs += iwordsize ;
+  bcopy( s1_p  , &(wbuf[icurs]), iwordsize ) ;   icurs += iwordsize ;
+  bcopy( s2_p  , &(wbuf[icurs]), iwordsize ) ;   icurs += iwordsize ;
+  bcopy( s3_p  , &(wbuf[icurs]), iwordsize ) ;   icurs += iwordsize ;
+  bcopy( s4_p  , &(wbuf[icurs]), iwordsize ) ;   icurs += iwordsize ;
+  bcopy( e1_p  , &(wbuf[icurs]), iwordsize ) ;   icurs += iwordsize ;
+  bcopy( e2_p  , &(wbuf[icurs]), iwordsize ) ;   icurs += iwordsize ;
+  bcopy( e3_p  , &(wbuf[icurs]), iwordsize ) ;   icurs += iwordsize ;
+  bcopy( e4_p  , &(wbuf[icurs]), iwordsize ) ;   icurs += iwordsize ;
+# ifdef SWAPBYTES
+  rsl_swapbytes( wbuf, iwordsize, 9 ) ;
+# endif
+#else
+#ifdef crayx1
+  { int i ;
+#else
+  { short i ;
+#endif
+    i = *ndim_p ; bcopy( &i, &(wbuf[icurs]), iwordsize/2 ) ;   icurs += iwordsize/2 ;
+    i = *s1_p   ; bcopy( &i, &(wbuf[icurs]), iwordsize/2 ) ;   icurs += iwordsize/2 ;
+    i = *s2_p   ; bcopy( &i, &(wbuf[icurs]), iwordsize/2 ) ;   icurs += iwordsize/2 ;
+    i = *s3_p   ; bcopy( &i, &(wbuf[icurs]), iwordsize/2 ) ;   icurs += iwordsize/2 ;
+    i = *s4_p   ; bcopy( &i, &(wbuf[icurs]), iwordsize/2 ) ;   icurs += iwordsize/2 ;
+    i = *e1_p   ; bcopy( &i, &(wbuf[icurs]), iwordsize/2 ) ;   icurs += iwordsize/2 ;
+    i = *e2_p   ; bcopy( &i, &(wbuf[icurs]), iwordsize/2 ) ;   icurs += iwordsize/2 ;
+    i = *e3_p   ; bcopy( &i, &(wbuf[icurs]), iwordsize/2 ) ;   icurs += iwordsize/2 ;
+    i = *e4_p   ; bcopy( &i, &(wbuf[icurs]), iwordsize/2 ) ;   icurs += iwordsize/2 ;
+  }
+# ifdef SWAPBYTES
+  rsl_swapbytes( wbuf, iwordsize/2, 9 ) ;
+# endif
+#endif
+
+#ifndef T3D
+  bcopy( xtime_p  , &(wbuf[icurs]), rwordsize ) ;  
+# ifdef SWAPBYTES
+  rsl_swapbytes( &(wbuf[icurs]), rwordsize, 1 ) ;
+# endif
+  icurs += rwordsize ;
+#else
+  { float x ; double y ;
+    bcopy( xtime_p, &y, rwordsize ) ;
+    x = y ;
+    bcopy( &x  , &(wbuf[icurs]), rwordsize/2 ) ;
+  }
+# ifdef SWAPBYTES
+  rsl_swapbytes( &(wbuf[icurs]), rwordsize/2, 1 ) ;
+# endif
+  icurs += rwordsize/2 ;
+#endif
+
+#ifndef T3D
+  bcopy( staggering_p   , &(wbuf[icurs]),
+                                 *nstaggering_p ) ;          icurs += *nstaggering_p ;
+  bcopy( ordering_p     , &(wbuf[icurs]),
+                                 *nordering_p    ) ;         icurs += *nordering_p   ;
+  bcopy( current_date_p , &(wbuf[icurs]),
+                                 *ncurrent_date_p    ) ;     icurs += *ncurrent_date_p   ;
+  bcopy( name_p         , &(wbuf[icurs]),
+                                 *nname_p    ) ;             icurs += *nname_p   ;
+  bcopy( units_p        , &(wbuf[icurs]),
+                                 *nunits_p    ) ;            icurs += *nunits_p   ;
+  bcopy( description_p  , &(wbuf[icurs]),
+                                 *ndescription_p    ) ;      icurs += *ndescription_p   ;
+#else
+  bcopy( _fcdtocp( staggering_p )  , &(wbuf[icurs]),
+                                 *nstaggering_p ) ;          icurs += *nstaggering_p ;
+  bcopy( _fcdtocp( ordering_p )    , &(wbuf[icurs]),
+                                 *nordering_p    ) ;         icurs += *nordering_p   ;
+  bcopy( _fcdtocp( current_date_p ), &(wbuf[icurs]),
+                                 *ncurrent_date_p    ) ;     icurs += *ncurrent_date_p   ;
+  bcopy( _fcdtocp( name_p )        , &(wbuf[icurs]),
+                                 *nname_p    ) ;             icurs += *nname_p   ;
+  bcopy( _fcdtocp( units_p )       , &(wbuf[icurs]),
+                                 *nunits_p    ) ;            icurs += *nunits_p   ;
+  bcopy( _fcdtocp( description_p ) , &(wbuf[icurs]),
+                                 *ndescription_p    ) ;      icurs += *ndescription_p   ;
+#endif
+
+  if ( rsl_buffer_output && ! req.internal )
+  {
+    if ( write_buffer_head == NULL && write_buffer_tail == NULL )
+    {
+      write_buffer_head = RSL_MALLOC( rsl_write_buffer_struct_t, 1 ) ;
+      write_buffer_tail = write_buffer_head ;
+    }
+    else
+    {
+      write_buffer_tail->next = RSL_MALLOC( rsl_write_buffer_struct_t, 1 ) ;
+      write_buffer_tail = write_buffer_tail->next ;
+    }
+    write_buffer_tail->req       = req ;
+    write_buffer_tail->nelem     = nelem ;
+    write_buffer_tail->buf       = RSL_MALLOC( char, nelem ) ;
+    bcopy( wbuf, write_buffer_tail->buf, nelem ) ;
+  }
+  else
+  {
+    send_to_output_device( &req, wbuf, nelem ) ;
+  }
+
+  RSL_FREE( wbuf ) ;
+}
+
+rsl_swapbytes ( buf, wordsz, nwords )
+  char * buf ;
+  int wordsz, nwords ;
+{
+  char tbuf[8] ;
+  int i ;
+
+  if ( wordsz == 4 )
+  {
+    for ( i = 0 ; i < nwords*wordsz ; i += wordsz  )   
+    {
+      tbuf[0] = buf[3+i] ;
+      tbuf[1] = buf[2+i] ;
+      tbuf[2] = buf[1+i] ;
+      tbuf[3] = buf[0+i] ;
+      buf[0+i] = tbuf[0] ;
+      buf[1+i] = tbuf[1] ;
+      buf[2+i] = tbuf[2] ;
+      buf[3+i] = tbuf[3] ;
+    }
+  }
+  else if ( wordsz == 8 )
+  {
+    for ( i = 0 ; i < nwords*wordsz ; i += wordsz )   
+    {
+      tbuf[0] = buf[7+i] ;
+      tbuf[1] = buf[6+i] ;
+      tbuf[2] = buf[5+i] ;
+      tbuf[3] = buf[4+i] ;
+      tbuf[4] = buf[3+i] ;
+      tbuf[5] = buf[2+i] ;
+      tbuf[6] = buf[1+i] ;
+      tbuf[7] = buf[0+i] ;
+      buf[0+i] = tbuf[0] ;
+      buf[1+i] = tbuf[1] ;
+      buf[2+i] = tbuf[2] ;
+      buf[3+i] = tbuf[3] ;
+      buf[4+i] = tbuf[4] ;
+      buf[5+i] = tbuf[5] ;
+      buf[6+i] = tbuf[6] ;
+      buf[7+i] = tbuf[7] ;
+    }
+  }
+  else
+  {
+    sprintf(mess,"invalid argument wordsz = %d",wordsz) ;
+    RSL_TEST_ERR(1,mess) ;
+  }
+}
+
+RSL_WRITE_MM5V3_BIG_HEADER( unit_p,
+                         ibuf,nibuf_p,
+                         rbuf,nrbuf_p,
+                         cb1,ncb1_p, 
+                         cb2,ncb2_p,
+                         iwordsize_p,rwordsize_p )
+  int_p  unit_p ;
+  char * ibuf             ;  int_p nibuf_p   ;
+  char * rbuf             ;  int_p nrbuf_p   ;
+#ifndef T3D
+  char * cb1              ;  int_p ncb1_p    ;
+  char * cb2              ;  int_p ncb2_p    ;
+#else
+  _fcd   cb1              ;  int_p ncb1_p    ;
+  _fcd   cb2              ;  int_p ncb2_p    ;
+#endif
+  int_p  iwordsize_p ;
+  int_p  rwordsize_p ;
+{
+  rsl_write_req_t req ;
+  int nelem ;
+  int iwordsize ;
+  int rwordsize ;
+  int nstringbytes ;
+  int icurs ;
+  char * wbuf ;
+  int i_am_monitor ;
+
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+  if ( ! i_am_monitor ) return ;
+
+  iwordsize = *iwordsize_p ;
+  rwordsize = *rwordsize_p ;
+
+#ifndef T3D
+  nelem = *nibuf_p * iwordsize + 
+          *nrbuf_p * rwordsize +
+          *ncb1_p + *ncb2_p ;
+#else
+  nelem = *nibuf_p * iwordsize /2 + 
+          *nrbuf_p * rwordsize /2 +
+          *ncb1_p + *ncb2_p ;
+#endif
+          
+  req.internal     = 0 ;
+  req.request_type = RSL_WRITE_REQUEST ;
+  req.request_mode = MSG_IO_FORTRAN    ;
+  req.unit         = *unit_p           ;
+  req.unit_p       = unit_p            ;
+  req.iotag        = IO_REPL           ;
+  req.type         = RSL_CHARACTER     ;
+
+  wbuf       = RSL_MALLOC( char, nelem ) ;
+
+  icurs = 0 ;
+#ifdef SWAPBYTES
+  rsl_swapbytes( ibuf, iwordsize, *nibuf_p ) ;
+#endif
+#ifndef T3D
+  bcopy( ibuf  , &(wbuf[icurs]), *nibuf_p * iwordsize ) ;
+  icurs += *nibuf_p * iwordsize ;
+#else
+#ifdef crayx1
+  { long *p ; int *q ; int i ;
+    p = (long *) ibuf ;
+    q = (int *) ibuf ;
+#else
+  { long *p ; short *q ; int i ;
+    p = (long *) ibuf ;
+    q = (short *) ibuf ;
+#endif
+    for ( i = 0 ; i < *nibuf_p ; i++ )
+    {
+      *q = *p ; q++ ; p++ ;
+    }
+  }
+  bcopy( ibuf  , &(wbuf[icurs]), *nibuf_p * iwordsize /2 ) ;
+  icurs += *nibuf_p * iwordsize / 2 ;
+#endif
+#ifdef SWAPBYTES
+  rsl_swapbytes( rbuf, rwordsize, *nrbuf_p ) ;
+#endif
+#ifndef T3D
+  bcopy( rbuf  , &(wbuf[icurs]), *nrbuf_p * rwordsize ) ;
+  icurs += *nrbuf_p * rwordsize ;
+#else
+  { double *p ; float *q ; int i ;
+    p = (double *) rbuf ;
+    q = (float *) rbuf ;
+    for ( i = 0 ; i < *nrbuf_p ; i++ )
+    {
+      *q = *p ; q++ ; p++ ;
+    }
+  }
+  bcopy( rbuf  , &(wbuf[icurs]), *nrbuf_p * rwordsize /2 ) ;
+  icurs += *nrbuf_p * rwordsize / 2 ;
+#endif
+#ifndef T3D
+  bcopy( cb1   , &(wbuf[icurs]), *ncb1_p   ) ;   icurs += *ncb1_p ;
+  bcopy( cb2   , &(wbuf[icurs]), *ncb2_p   ) ;   icurs += *ncb2_p ;
+#else
+  bcopy( _fcdtocp( cb1 ), &(wbuf[icurs]), *ncb1_p   ) ;   icurs += *ncb1_p ;
+  bcopy( _fcdtocp( cb2 ), &(wbuf[icurs]), *ncb2_p   ) ;   icurs += *ncb2_p ;
+#endif
+  if ( rsl_buffer_output && ! req.internal )
+  {
+    if ( write_buffer_head == NULL && write_buffer_tail == NULL )
+    {
+      write_buffer_head = RSL_MALLOC( rsl_write_buffer_struct_t, 1 ) ;
+      write_buffer_tail = write_buffer_head ;
+    }
+    else
+    {
+      write_buffer_tail->next = RSL_MALLOC( rsl_write_buffer_struct_t, 1 ) ;
+      write_buffer_tail = write_buffer_tail->next ;
+    }
+    write_buffer_tail->req       = req ;
+    write_buffer_tail->nelem     = nelem ;
+    write_buffer_tail->buf       = RSL_MALLOC( char, nelem ) ;
+    bcopy( wbuf, write_buffer_tail->buf, nelem ) ;
+  }
+  else
+  {
+    send_to_output_device( &req, wbuf, nelem ) ;
+  }
+  RSL_FREE( wbuf ) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_malloc.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_malloc.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_malloc.c	(revision 2744)
@@ -0,0 +1,208 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+/*#define PADIT		/* add page at beginning and end of allocation */
+#if 0
+# define BASE_MALLOC   fence_malloc
+# define BASE_FREE     fence_free
+#else
+# define BASE_MALLOC   malloc
+# define BASE_FREE     free
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <malloc.h>
+#ifdef T3D
+#include <errno.h>
+#endif
+#include "rsl.h"
+
+/*
+extern int EF_ALIGNMENT;
+extern int EF_PROTECT_BELOW;
+extern int EF_PROTECT_FREE;
+*/
+
+
+static char zero_length_storage[] = "" ;
+
+#if !(defined(vpp) || defined(vpp2) || defined(SUN))
+static struct mallinfo minf ;
+#endif
+
+static char *last_f ;
+static int last_l ;
+static int last_s ;
+
+#ifdef O2K
+static struct mallinfo mallinfo() {} ;
+#endif
+
+void * rsl_malloc(f,l,s)
+   char * f ;
+   int l, s ;
+{
+   char mess[128] ;
+   void *retval ;
+   int s2, tries ;
+
+/*
+EF_PROTECT_BELOW = 0 ;
+EF_PROTECT_FREE = 1 ;
+*/
+
+   if ( s == 0 )
+   {
+     retval = (void *) zero_length_storage ;
+   }
+   else 
+   {
+#ifdef PADIT
+     s2 = s + 1024 ;
+#else
+     s2 = s ;
+#endif
+     tries = 0 ;
+     while ((retval=(void *)BASE_MALLOC(s2))==(void *)NULL)
+     {
+       tries++ ;
+       sprintf(mess,
+"rsl_malloc failed allocating %d bytes, called %s, line %d, try %d\n",
+       s,f,l,tries) ;
+       perror(mess) ;
+#if !(defined(vpp) || defined(vpp2) || defined(SUN))
+       minf = mallinfo() ;
+       fprintf(stderr,"mallinfo: arena %d\n",minf.arena)  ;
+       fprintf(stderr,"mallinfo: ordblks %d\n",minf.ordblks)  ;
+       fprintf(stderr,"mallinfo: smblks %d\n",minf.smblks)  ;
+       fprintf(stderr,"mallinfo: hblks %d\n",minf.hblks)  ;
+       fprintf(stderr,"mallinfo: hblkhd %d\n",minf.hblkhd)  ;
+       fprintf(stderr,"mallinfo: usmblks %d\n",minf.usmblks)  ;
+       fprintf(stderr,"mallinfo: fsmblks %d\n",minf.fsmblks)  ;
+       fprintf(stderr,"mallinfo: uordblks %d\n",minf.uordblks)  ;
+       fprintf(stderr,"mallinfo: fordblks %d\n",minf.fordblks)  ;
+       fprintf(stderr,"mallinfo: keepcost %d\n",minf.keepcost)  ;
+#ifdef SUNINFO
+       fprintf(stderr,"mallinfo: mkfast %d\n",minf.mkfast)  ;
+       fprintf(stderr,"mallinfo: nblks %d\n",minf.nblks)  ;
+       fprintf(stderr,"mallinfo: grain %d\n",minf.grain)  ;
+       fprintf(stderr,"mallinfo: uordbytes %d\n",minf.uordbytes)  ;
+       fprintf(stderr,"mallinfo: allocated %d\n",minf.allocated)  ;
+       fprintf(stderr,"mallinfo: treeoverhead %d\n",minf.treeoverhead)  ;
+#endif
+#endif
+       if ( tries >= 2 )
+       { 
+	 system("lsps -a") ;
+	 sleep(1) ;
+       }
+       if ( tries >= 3 ) 
+       {
+	 system("lsps -a") ;
+	 RSL_FATAL(2) ;
+       }
+     }
+   }
+#if !(defined(vpp)||defined(vpp2)) || defined(sx) || defined(alphavector)
+   if ( s > 0 )
+     bzero( retval, s2 ) ;	/* return zero'd storage always */
+#else
+   if ( s > 0 )
+   { int l, lb ;
+     l = s2/sizeof(int) ;
+     lb = l*sizeof(int) ;
+     vizero_( retval, &l  ) ;
+     l = s2-lb ;
+     vbzero_( retval+lb, &l ) ;	/* return zero'd storage always */
+   }
+#endif
+
+#ifdef PADIT
+   retval = retval + 512 ;
+#endif
+
+#ifdef T3D_COMMENTOUT
+   if ( rsl_myproc == 0 )
+   {
+   if (malloc_check(0))
+   {
+    if ( rsl_myproc == 0 )
+    fprintf(stderr,"%s, %d ---problem from malloc_check--- %d bytes last %s %d %d \n",f,l,s,last_f, last_l, last_s) ;
+    exit(3);
+   }
+   }
+   last_s = s ;
+   last_l = l ;
+   last_f = f ;
+#endif
+
+   return(retval) ;
+}
+
+rsl_free( p )
+   char * p ;
+{
+   if ( p == zero_length_storage ) return ;    /* fix from ANU */
+#ifdef PADIT
+   BASE_FREE ( p-512 ) ;
+#else
+   BASE_FREE ( p ) ;
+#endif
+   p = NULL ;
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_merge.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_merge.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_merge.c	(revision 2744)
@@ -0,0 +1,1181 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+typedef struct stage_point {
+  char * p ;            /* pointer to buffer for point */
+  int curs ;            /* cursor into point buffer */
+  int P ;               /* processor ID for point */
+  int kid_id ;
+  int parent_id ;
+  int cm ;
+  int cn ;
+  struct stage_point *next ;    /* list pointer */
+} stage_point_t ;
+
+typedef struct nest_info {
+  rsl_index_t ig, jg, cn, cm ;
+  int mother_id ;
+} nest_info_t ;
+
+static destroy_nest_info ( p )
+  char * p ;
+{
+  if ( p != NULL ) RSL_FREE( p ) ;
+}
+
+static rsl_list_t *Xlist = NULL ;
+static stage_point_t *stage = NULL ;
+static int stage_len = 0 ;
+
+static int s_d ;
+static int s_nst ;
+static int s_msize ;
+static int s_nlen ;
+static int s_mlen ;
+static int s_nlen_nst ;
+static int s_mlen_nst ;
+static int s_irax_n ;
+static int s_irax_m ;
+static stage_point_t *Plist[RSL_MAXPROC] ;
+static int Psize[RSL_MAXPROC] ;
+static rsl_domain_info_t *s_dinfo = NULL , *s_ninfo  = NULL ;
+static rsl_point_t *s_ddomain = NULL , *s_ndomain  = NULL ;
+static char *s_child_msgs = NULL ;
+static int s_child_msgs_curs = 0 ;
+static int s_remaining = 0 ;  /* number of bytes left in a child message before
+                           the next point descriptor */
+
+/* add a field to a message outgoing for the specified child domain cell */
+/* relies on rsl_ready_merge having been called already */
+/* sends are specified in terms of coarse domain */
+
+static int s_i, s_j, s_ig, s_jg, s_cm, s_cn,
+           s_pig, s_pjg ;
+
+/*@
+  RSL_TO_PARENT_INFO -- Get the next cell in a packing sequence for feedback.
+
+  Notes:
+  RSL_TO_PARENT_INFO is used in a packing loop to build feedback
+  messages from a nested (Arg2) domain with data from a parent (Arg1),
+  in preparation for a call to RSL_MERGE_MSGS.  For an overview of the
+  mechanism and a detailed example, see RSL_MERGE_MSGS.
+
+  The Arg3 argument gives the size of the child to parent cell messages
+  in bytes.  This may be larger than needed, but never smaller;
+  otherwise the program will abort (to avoid overwriting memory).
+
+  Each call to RSL_TO_PARENT_INFO gives the local (Arg4, Arg5) and
+  global (Arg6, Arg7) indices of a nested point that will send feedback
+  data, the global indices (Arg10, Arg11) of the associated parent
+  cell, and the indices of the nest cell in the set of nest cells
+  associated with the parent (Arg8, Arg9).  These last two are needed
+  to differentiate which of the nest cells associated with the parent
+  is being referred to.  There are IRAX_M by IRAX_N nest points
+  associated with each parent, where IRAX_M is the nesting ratio in the
+  M dimension and IRAX_N is the nesting ratio in the N dimension (See
+  the descriptions for the RSL nest spawning routines RSL_SPAWN...).
+
+  RSL_TO_PARENT_INFO will return a new set of coordinates for every
+  nest point stored locally on the processor.  Each time the routine
+  returns with a valid point, the value of Arg12 will be 1 and RSL will
+  be in a state that is ready to accept data for the point.  The
+  message is constructed using the routine RSL_TO_PARENT_MSG.  The last
+  call will return a value of 0 (zero) in Arg12 indicating there are no
+  more nest points.
+
+  It isn't necessary that anything be done with the coordinates that
+  are returned.  However, once called, RSL_TO_PARENT_INFO must be
+  called as many times as it takes to exhaust the number of points;
+  otherwise the underlying RSL mechanism will not be left in the proper
+  state at the conclusion of the broadcast.
+
+  See also:
+  RSL_MERGE_MSGS, RSL_TO_PARENT_MSG, RSL_FROM_CHILD_INFO
+@*/
+
+RSL_TO_PARENT_INFO ( d_p, n_p, msize_p,
+                     i_p, j_p,
+                     ig_p, jg_p, cm_p, cn_p,
+                     pig_p, pjg_p, retval_p )
+  int_p
+    d_p         /* (I) RSL domain descriptor of parent. */
+   ,n_p         /* (I) RSL domain descriptor of nest. */
+   ,msize_p     /* (I) Message size in bytes. */
+   ,i_p         /* (O) Local M index of nest domain point. */
+   ,j_p         /* (O) Local N index of nest domain point. */
+   ,ig_p        /* (O) Global M index of nest domain point. */
+   ,jg_p        /* (O) Global N index of nest domain point. */
+   ,cm_p        /* (O) M index of child cell beneath parent cell. */
+   ,cn_p        /* (O) N index of child cell beneath parent cell. */
+   ,pig_p       /* (O) Global N index of parent domain point. */
+   ,pjg_p       /* (O) Global N index of parent domain point. */
+   ,retval_p ;  /* (O) =1 if a valid point returned; =0 (zero) otherwise. */
+{
+  rsl_child_info_t *kid ;
+  rsl_list_t *lp ;
+  nest_info_t *dp ;
+  int P ;
+
+  if ( stage == NULL )
+  {
+    rsl_ready_merge( d_p, n_p, msize_p ) ;
+  }
+
+  if (( lp = Xlist) == NULL ) 
+  {
+    *retval_p = -1 ;
+    return ;
+  }
+  Xlist = Xlist->next ;
+  dp = (nest_info_t *)(lp->data) ;
+
+  s_ig = dp->ig ;
+  s_jg = dp->jg ;
+  s_i = s_ig + s_ninfo->idif ;
+  s_j = s_jg + s_ninfo->jdif ;
+  s_cm = dp->cm ;
+  s_cn = dp->cn ;
+  s_pig = ID_IDEX( dp->mother_id ) ;
+  s_pjg = ID_JDEX( dp->mother_id ) ;
+
+  *ig_p = s_ig + 1 ;
+  *jg_p = s_jg + 1;
+  *i_p = s_i + 1 ;
+  *j_p = s_j + 1;
+  *cm_p = s_cm + 1;
+  *cn_p = s_cn + 1;
+  *pig_p = s_pig + 1;
+  *pjg_p = s_pjg + 1;
+
+/*
+this should only be freed when the list is recalculated 960605
+  RSL_FREE(lp) ;
+  RSL_FREE(dp) ;
+*/
+
+  *retval_p = 1 ;
+  return ;
+}
+
+/*@
+  RSL_TO_PARENT_MSG -- Pack feedback data into a message for a parent point.
+
+  Notes:
+  RSL_TO_PARENT_MSG is used in a loop to pack messages for feeding back
+  data from
+  a nested domain to a parent in preparation for
+  a call to RSL_MERGE_MSGS.  For an overview of the mechanism and a detailed
+  example, see RSL_MERGE_MSGS.
+
+  Before calling RSL_TO_PARENT_MSG, RSL must have been put into the
+  correct state; that is, ready to accept data that will be sent to a
+  particular parent domain point.  This is done by first calling
+  RSL_TO_PARENT_INFO.  RSL_TO_PARENT_MSG may be called as many times as
+  necessary to pack data into the message (or not at all, if there is
+  no data for the point returned by RSL_TO_PARENT_INFO).  Each call to
+  RSL_TO_PARENT_MSG copies Arg1 bytes from the bufffer specified by
+  Arg2 into the message, which is allocated by RSL and never
+  manipulated directly by the user program.  The amount of data that
+  can be packed is limited to the message size that was specified in
+  the first call to RSL_TO_PARENT_INFO.
+
+  See also:
+  RSL_MERGE_MSGS, RSL_TO_PARENT_INFO
+
+@*/
+
+RSL_TO_PARENT_MSG ( nbuf_p, buf )
+  int_p
+    nbuf_p ;            /* (I) Number of bytes to be packed. */
+  char *
+    buf ;               /* (I) Buffer containing the data to be packed. */
+{
+  int kiddex ;
+  int nbuf ;
+  int P ;
+
+  RSL_TEST_ERR(buf==NULL,"2nd argument is NULL.  Field allocated?") ;
+  nbuf = *nbuf_p ;
+  kiddex = INDEX_2(s_jg,s_ig,s_mlen_nst) ;
+  P = s_ndomain[ kiddex ].mother_P ;
+  if ( stage[ kiddex ].p == NULL )
+  {
+    stage[ kiddex ].p = RSL_MALLOC( char, s_msize ) ;
+    stage[ kiddex ].curs = 0 ;
+    stage[ kiddex ].P = P ;
+    stage[kiddex].next = Plist[P] ;
+    Plist[P] =  &(stage[ kiddex ]) ;
+  }
+  if ( stage[ kiddex ].curs + nbuf > s_msize ) 
+  {
+    sprintf(mess,
+    "RSL_TO_PARENT_MSG: would overflow buffer (%d+%d>%d)\n",
+        stage[ kiddex ].curs, nbuf, s_msize ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+
+  /* add point to head of list of points for processor P */
+  stage[kiddex].kid_id = POINTID(s_nst,s_jg,s_ig) ;
+  stage[kiddex].parent_id = POINTID( s_d, s_pjg, s_pig ) ;
+  stage[kiddex].cm = s_cm ;
+  stage[kiddex].cn = s_cn ;
+  Psize[P] += s_msize + sizeof( merge_point_desc_t ) ;
+
+  /* pack the buffer associated with stage[kiddex] */
+#ifdef crayx1
+  if( nbuf == sizeof(float) ) {
+    float *bufin  = (float *) buf;
+    float *bufout = (float *)&(stage[ kiddex ].p [ stage[ kiddex].curs]);
+    bufout[0] = bufin[0];
+  }
+  else {
+    bcopy( buf, &(stage[ kiddex ].p[ stage[ kiddex ].curs ]), nbuf ) ;
+  }
+  stage[ kiddex ].curs += nbuf ;
+#else
+  bcopy( buf, &(stage[ kiddex ].p[ stage[ kiddex ].curs ]), nbuf ) ;
+  stage[ kiddex ].curs += nbuf ;
+#endif
+}
+
+#ifdef crayx1
+RSL_TO_PARENT_MSGX ( n_vals_p, s_vals_p, stride_p, buf )
+  int_p
+    n_vals_p ;            /* (I) Number of values to be packed. */
+  int_p
+    s_vals_p ;            /* (I) Size of values to be packed. */
+  int_p
+    stride_p ;            /* (I) Number of values for stride. */
+  char *
+    buf ;                 /* (I) Buffer containing the data to be packed. */
+{
+  int n_vals, s_vals, stride;
+  int kiddex, nbuf, P;
+                                                                                                    
+  RSL_TEST_ERR(buf==NULL,"2nd argument is NULL.  Field allocated?") ;
+  n_vals = *n_vals_p;
+  s_vals = *s_vals_p;
+  stride = *stride_p;
+  nbuf   = n_vals * s_vals ;   /* Number of bytes to be packed */
+  kiddex = INDEX_2(s_jg,s_ig,s_mlen_nst) ;
+  P = s_ndomain[ kiddex ].mother_P ;
+  if ( stage[ kiddex ].p == NULL )
+  {
+    stage[ kiddex ].p = RSL_MALLOC( char, s_msize ) ;
+    stage[ kiddex ].curs = 0 ;
+    stage[ kiddex ].P = P ;
+    stage[kiddex].next = Plist[P] ;
+    Plist[P] =  &(stage[ kiddex ]) ;
+  }
+  if ( stage[ kiddex ].curs + nbuf > s_msize )
+  {
+    sprintf(mess,
+    "RSL_TO_PARENT_MSGX: would overflow buffer (%d+%d>%d)\n",
+        stage[ kiddex ].curs, nbuf, s_msize ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  /* add point to head of list of points for processor P */
+  stage[kiddex].kid_id = POINTID(s_nst,s_jg,s_ig) ;
+  stage[kiddex].parent_id = POINTID( s_d, s_pjg, s_pig ) ;
+  stage[kiddex].cm = s_cm ;
+  stage[kiddex].cn = s_cn ;
+  Psize[P] += s_msize + sizeof( merge_point_desc_t ) ;
+   
+  /* pack the buffer associated with stage[kiddex] */
+  if ( s_vals == sizeof(float) ) {
+    int k, ki;
+    float *bufin = (float *)buf;
+    float *bufout = (float *)&(stage[ kiddex ].p[ stage[ kiddex ].curs ]);
+#pragma _CRI ivdep
+    for ( k = 0, ki = 0; k < n_vals; k++, ki += stride ) {
+          bufout[k] = bufin[ki];
+    }
+    stage[ kiddex ].curs += nbuf ;
+  }
+  else {
+    sprintf(mess,
+    "RSL_TO_PARENT_MSGX: Element size %d not supported for stride\n", s_vals);
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+}
+#endif
+
+/*@
+  RSL_MERGE_MSGS -- Convey feedback data from nest to parent points.
+
+  Notes:
+  RSL_MERGE_MSGS is called once feedback data
+  to points in a parent domain have been packed into messages
+  from the associated points on the nest.  The routine has
+  no arguments; rather, RSL must be in a ready state; this occurs
+  once RSL_TO_PARENT_INFO has returned a value of 0 (zero)
+  in its last argument on all processors.  The feedback data is
+  conveyed along logical communication channels that were set up
+  between nest points and associated points in the parent domain
+  when the nest was spawned.  Interprocessor communication
+  is generated for messages between
+  points on different processors; otherwise, the transfer
+  is done within the processor's local memory.
+
+  The inverse operation to RSL_MERGE_MSGS is RSL_BCAST_MSGS, which
+  is used for conveying forcing data from parent to nest.
+
+  Note while reading the following example that RSL decomposes all
+  domains independently and over all processors, so that every
+  processor will have cells from the parent and from the nest.
+  Thus, all processors perform both the packing of data from
+  the nest and the unpacking of data onto the parent.  Other
+  RSL routines appearing in the example are described elsewhere
+  in these documents.
+
+  Example:
+
+$ C
+$ C Packing data from the nest.
+$ C
+$   NLEV = (the number of vertical levels)
+$   MSIZE = 3 * NLEV + 1 * WORDSIZE
+$ C
+$ C First call to rsl_to_parent_info
+$ C
+$   CALL RSL_TO_PARENT_INFO( PID, NID,     ! parent, nest domain descriptors
+$                            MSIZE,        ! size of message to a point
+$                            I,J,IG,JG,    ! local and global nest cell coords
+$                            CM,CN,        ! index of nest cell in parent cell
+$                            PIG,PJG,      ! global parent cell coords
+$                            IRETVAL )     ! return value
+$   DO WHILE ( IRETVAL .EQ. 1 )
+$ C   Dot point variables feedback from the sw nest cell under each parent.
+$     IF ( CM .EQ. 1 .AND. CN .EQ. 1 ) THEN
+$       DO K = 1, NLEV
+$         CALL RSL_TO_PARENT_MSG( WORDSIZE, U(I,J,K) )
+$         CALL RSL_TO_PARENT_MSG( WORDSIZE, V(I,J,K) )
+$       ENDDO
+$     END IF
+$ C   Cross point variables feedback from the center nest cell.
+$     IF ( CM .EQ. 2 .AND. CN .EQ. 2 ) THEN
+$       DO K = 1, NLEV
+$         CALL RSL_TO_PARENT_MSG( WORDSIZE, T(I,J,K) )
+$       ENDDO
+$       CALL RSL_TO_PARENT_MSG( WORDSIZE, PS(I,J) )
+$     ENDIF
+$ C
+$ C Subsequent calls to rsl_to_parent_info
+$ C
+$     CALL RSL_TO_PARENT_INFO( PID, NID, MSIZE, I,J,IG,JG, CM,CN,
+$                              PIG,PJG, IRETVAL )
+$   END DO
+$ C
+$ C Merge the data.
+$ C
+$   CALL RSL_MERGE__MSGS
+$ C
+$ C Unpack the data onto the parent.
+$ C
+$ C
+$ C First call to rsl_from_child_info
+$ C
+$   CALL RSL_FROM_CHILD_INFO( I, J,       ! local parent cell coords
+$                             IG, JG,     ! global parent cell coords
+$                             CM, CN,     ! index of nest cell in parent cell
+$                             NIG, NJG,   ! global nest cell coords
+$                             IRETVAL )   ! return value
+$   DO WHILE ( IRETVAL .EQ. 1 )
+$     IF ( CM .EQ. 1 .AND. CN .EQ. 1 ) THEN
+$       DO K = 1, NLEV
+$         CALL RSL_FROM_CHILD_MSG( WORDSIZE, U(I,J,K) )
+$         CALL RSL_FROM_CHILD_MSG( WORDSIZE, V(I,J,K) )
+$       ENDDO
+$     END IF
+$     IF ( CM .EQ. 2 .AND. CN .EQ. 2 ) THEN
+$       DO K = 1, NLEV
+$         CALL RSL_FROM_CHILD_MSG( WORDSIZE, T(I,J,K) )
+$       ENDDO
+$       CALL RSL_FROM_CHILD_MSG( WORDSIZE, PS(I,J) )
+$     END IF
+$ C
+$ C Subsequent calls to rsl_from_child_info
+$ C
+$     CALL RSL_FROM_CHILD_INFO( I, J, IG, JG, CM, CN, NIG, NJG, IRETVAL )
+$   END DO
+
+BREAKTHEEXAMPLECODE
+
+  In this example, three 3-dimensional fields, U, V, and T, and one
+  2-dimensional field, PS, from the parent domain are fed back from the
+  entire nest (as opposed to the forcing example for RSL_BCAST_MSGS in
+  which only the nest boundaries received data).  Assuming an Arakawa-B
+  grid, selecting the center nest cell associated with a parent cell
+  for cross-point data (T, PS) and the south-west nest cell for
+  dot-point data (U, V) accounts for staggering of the dot and cross
+  grids.
+  WORDSIZE, PIG, and PJG are integers; otherwise implicit typing
+  holds.
+
+                          
+  See also:
+  RSL_TO_CHILD_INFO, RSL_FROM_PARENT_INFO, RSL_BCAST_MSGS
+
+@*/
+
+RSL_MERGE_MSGS ()
+{
+  int P ;
+  char *work ;
+  merge_point_desc_t pdesc ;
+  stage_point_t *pt ;
+  int curs ;
+  int msglen, mdest, mtag ;
+  int ii ;
+
+  RSL_TEST_ERR( stage == NULL,
+    "RSL_MERGE_MESSAGES: RSL_MESSAGE_TO_CHILD not called first" ) ;
+
+
+  for ( ii = 0 ; ii < s_ninfo->Nmerge_send_Plist ; ii++ )
+  {
+    P = s_ninfo->merge_send_Plist[ii] ;
+    msglen = s_ninfo->merge_send_Pnpts[ii]*( sizeof(pdesc) + s_msize ) 
+             + sizeof(pdesc) ; /*  end of message marker */
+    curs = 0 ;
+    work = buffer_for_proc( P, msglen, RSL_SENDBUF ) ;
+    /* NOTE ASSUMPTION that the number of points in Plist will
+       be less or equal to ninfo->merge_send_Pnpts[ii].  If it isn't,
+       we've got trouble.  */
+    for ( pt = Plist[P] ; pt != NULL ; pt = pt->next )
+    {
+      RSL_TEST_ERR(curs+sizeof(merge_point_desc_t)+s_msize>msglen,
+        "Internal error: would overwrite in merge messages.") ;
+      pdesc.nest_id = pt->kid_id ;
+      pdesc.parent_id = pt->parent_id ;
+      pdesc.cm = pt->cm ;
+      pdesc.cn = pt->cn ;
+      bcopy( &pdesc, &work[curs], sizeof( merge_point_desc_t )) ;
+      curs += sizeof( merge_point_desc_t ) ;
+      bcopy( pt->p, &work[curs], s_msize ) ;
+      curs += s_msize ;
+    }
+    RSL_TEST_ERR(curs+sizeof(merge_point_desc_t)>msglen,
+      "Internal error: (end marker) would overwrite in merge messages.") ;
+    /* add end marker */
+    pdesc.nest_id = RSL_INVALID ;
+    pdesc.parent_id = RSL_INVALID ;
+    pdesc.cm = RSL_INVALID ;
+    pdesc.cn = RSL_INVALID ;
+    bcopy( &pdesc, &work[curs], sizeof( merge_point_desc_t )) ;
+    curs += sizeof( merge_point_desc_t ) ;
+    /* note that it is all right for mlen to be less than msglen */
+    if ( rsl_c_comp2phys_proc(P) != rsl_myproc )
+    {
+      mdest = rsl_c_comp2phys_proc(P) ;
+      mtag = MTYPE_FROMTO( MSG_TO_PARENT, rsl_myproc, mdest ) ;
+      msglen = curs ;
+      RSL_SEND( work, msglen, mtag, mdest ) ;
+    }
+    /* otherwise, leave in the send buffer and we'll pick it
+       up later */
+  }
+
+  /* reset this for the next phase, in */
+  s_child_msgs = NULL ;
+  s_remaining = 0 ;
+}
+
+/* Return a point from some child processor each time called.
+   If no more points, from a processor, go to the next one.
+   If no more points at all, retval is returned as RSL_INVALID */
+
+/*@
+  RSL_FROM_CHILD_INFO -- Get the next cell in a unpacking sequence for feedback.
+
+  Notes:
+  RSL_FROM_CHILD_INFO is used in a loop to unpack messages containing
+  feedback data from a nested domain.  The messages have arrived on the
+  local processor as a result of a previous call to RSL_MERGE_MSGS.
+  The domain descriptors do not need to be specified; they are part of
+  the state of RSL as a result of the calls to RSL_TO_CHILD_INFO that
+  have come before.  For a detailed example, see RSL_MERGE_MSGS.
+
+  Each call to RSL_FROM_CHILD_INFO gives the local indices (Arg1, Arg2)
+  and global indices (Arg3, Arg4) of a
+  parent domain point receiving feedback data from a nest point
+  whose the global indices are (Arg7, Arg8).
+  The indices of the child cell in the set of nest cells associated with
+  the parent are returned through arguments Arg5 and Arg6.  These
+  specify which of the nest cells associated with the parent
+  is being referred to.  There are IRAX_M by IRAX_N nest points
+  associated with each parent where IRAX_M is the nesting ratio in the
+  M dimension and IRAX_N is the nesting ratio in the N dimension (See
+  the descriptions for the RSL nest spawning routines RSL_SPAWN...).
+
+  RSL_FROM_CHILD_INFO will return a new set of coordinates for every
+  parent domain point stored in local processor memory.  For each
+  point, RSL_FROM_CHILD_INFO returns a value of 1 through
+  Arg9.   RSL is left in a state ready to yield
+  data from the nest point; the data
+  is unpacked from the message by calling RSL_FROM_CHILD_MSG.  Once
+  all local nest points have been traversed, RSL_FROM_CHILD_INFO returns
+  a value of 0 (zero) in Arg9.
+
+  It isn't necessary that anything be unpacked with the coordinates
+  that are returned.  However, once called, RSL_FROM_CHILD_INFO must
+  be called as many times as it takes to exhaust the number of points;
+  otherwise the underlying RSL mechanism will not be left in the proper
+  state at the conclusion of the broadcast.
+
+  See also:
+  RSL_MERGE_MSGS, RSL_TO_PARENT_INFO, RSL_FROM_CHILD_MSG
+@*/
+
+RSL_FROM_CHILD_INFO ( i_p, j_p, ig_p, jg_p, cm_p, cn_p,
+                       nig_p, njg_p, retval_p )
+  int_p
+    i_p         /* (O) Local index in M dimension of parent. */
+   ,j_p         /* (O) Local index in N dimension of parent. */
+   ,ig_p        /* (O) Global index in M dimension of parent. */
+   ,jg_p        /* (O) Global index in N dimension of parent. */
+   ,cm_p        /* (O) M index of child cell beneath parent cell. */
+   ,cn_p        /* (O) N index of child cell beneath parent cell. */
+   ,nig_p       /* (O) Global index in M dimension of nest. */
+   ,njg_p       /* (O) Global index in N dimension of nest. */
+   ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
+{
+  int ii ;
+  merge_point_desc_t pdesc ;
+
+  if ( s_remaining > 0 ) 
+  {
+    s_child_msgs_curs += s_remaining ;
+    s_remaining = 0 ;
+  }
+  get_a_new_merge_point( retval_p ) ;
+  if ( *retval_p != 1 )
+  {
+    cleanup_after_merge() ;
+    return ; 
+  }
+  s_remaining = s_msize + sizeof(merge_point_desc_t) ;
+
+  /* at this point we have a non-null message buffer */
+  /* read the descriptor */
+  bcopy( &(s_child_msgs[s_child_msgs_curs]),
+         &pdesc,
+         sizeof(merge_point_desc_t)) ;
+  s_child_msgs_curs += sizeof(merge_point_desc_t) ;
+  s_remaining -= sizeof(merge_point_desc_t) ;
+
+  /* get_a_new_merge_point should not be returning these */
+  RSL_TEST_ERR( pdesc.nest_id == RSL_INVALID, "Internal error.") ;
+
+  *ig_p = ID_IDEX(pdesc.parent_id)+1 ;
+  *jg_p = ID_JDEX(pdesc.parent_id)+1 ;
+  *i_p = *ig_p + s_dinfo->idif ;
+  *j_p = *jg_p + s_dinfo->jdif ;
+  *nig_p = ID_IDEX(pdesc.nest_id)+1 ;
+  *njg_p = ID_JDEX(pdesc.nest_id)+1 ;
+  *cm_p = pdesc.cm+1 ;
+  *cn_p = pdesc.cn+1 ;
+
+  *retval_p = 1 ;
+  return ;
+}
+
+/*@
+  RSL_FROM_CHILD_MSG -- Unpack feedback data into a parent point.
+
+  Notes:
+  RSL_FROM_CHILD_MSG is used in a loop to unpack messages containing
+  feedback data from a nested domain.  For an overview of the mechanism
+  and a detailed example, see RSL_MERGE_MSGS.
+
+  Before calling RSL_FROM_CHILD_MSG, RSL must have been put into the
+  correct state; that is, ready to accept data that will be sent to a
+  particular point in the nest.  This is done by first calling
+  RSL_FROM_CHILD_INFO.  RSL_FROM_CHILD_MSG may then be called as many
+  times as necessary to unpack data from the message (or not at all, if
+  there is no data for the point).  Each call to RSL_FROM_CHILD_MSG
+  copies Arg1 bytes from message into the bufffer specified by Arg2.
+  Note that the message is allocated and handled entirely within RSL
+  and never manipulated directly by the user program.  The amount of
+  data that can be packed is limited to the message size that was
+  specified in the first call to RSL_TO_PARENT_INFO.
+
+  See also:
+  RSL_BCAST_MSGS, RSL_FROM_CHILD_INFO, RSL_TO_PARENT_INFO
+
+@*/
+
+RSL_FROM_CHILD_MSG ( len_p, buf )
+  int_p
+    len_p ;             /* (I) Number of bytes to unpack. */
+  char *
+    buf ;               /* (O) Destination buffer. */
+{
+  if ( *len_p <= 0 ) return ;
+  if ( *len_p > s_remaining ) 
+  {
+    sprintf(mess,
+"RSL_FROM_CHILD_MSG:\n   Requested number of bytes (%d) exceeds %d, the number remaining for this point.\n", *len_p, s_remaining) ;
+    RSL_TEST_WRN(1,mess) ;
+  }
+#ifdef crayx1
+  if( (*len_p) == sizeof(float) ) {
+    float *bufout = (float *)buf;
+    float *bufin  = (float *)&(s_child_msgs[s_child_msgs_curs]);
+    bufout[0]   = bufin[0];
+  }
+  else {
+    bcopy( &(s_child_msgs[s_child_msgs_curs]),
+         buf,
+         *len_p ) ;
+  }
+  s_child_msgs_curs += *len_p ;
+  s_remaining -= *len_p ;
+#else
+  bcopy( &(s_child_msgs[s_child_msgs_curs]),
+         buf,
+         *len_p ) ;
+  s_child_msgs_curs += *len_p ;
+  s_remaining -= *len_p ;
+#endif
+}
+
+#ifdef crayx1
+RSL_FROM_CHILD_MSGX ( n_vals_p, s_vals_p, stride_p, buf )
+  int_p
+    n_vals_p ;            /* (I) Number of values to be packed. */
+  int_p
+    s_vals_p ;            /* (I) Size of values to be packed. */
+  int_p
+    stride_p ;            /* (I) Number of values for stride. */
+  char *
+    buf ;                 /* (O) Buffer containing the unpacked data. */
+{
+  int n_vals, s_vals, stride, len;
+  n_vals = *n_vals_p;
+  s_vals = *s_vals_p;
+  stride = *stride_p;
+  len    = n_vals * s_vals;  /* Number of bytes to unpack */
+  if ( len <= 0 ) return ;
+  if ( len > s_remaining )
+  {
+    sprintf(mess,
+"RSL_FROM_CHILD_MSGX:\n   Requested number of bytes (%d) exceeds %d, the number remaining for this point.\n", len, s_remaining) ;
+    RSL_TEST_WRN(1,mess) ;
+  }
+  if ( (s_vals) == sizeof (float) ) {
+    int k, ki;
+    float *bufout = (float *)buf;
+    float *bufin  = (float *)&(s_child_msgs[s_child_msgs_curs]);
+                                                                 
+#pragma _CRI ivdep
+    for ( k = 0, ki = 0; k < n_vals; k++, ki += stride ) {
+          bufout[ki] = bufin[k];
+    }
+    s_child_msgs_curs += len ;
+    s_remaining -= len ;
+  }
+  else {
+    sprintf(mess, "RSL_FROM_CHILD_MSGX: Element size %d not supported for stride\n", s_vals);
+    RSL_TEST_WRN(1,mess) ;
+  }
+}
+#endif
+
+/* This is called by RSL_FROM_CHILD_INFO on a parent domain each time we
+   need a received point from a nest.
+
+   When this is called, one of two states may obtain.
+
+   1. The first time this is called for a given merge operation, the global
+   pointer s_child_msgs will be equal to NULL.
+
+   2. Subsequent times this is called, the s_child_msgs pointer will be
+   non-null and point to a buffer that was returned by a previous call
+   to this routine.  The integer cursor s_child_msgs_curs will always
+   be the index of the starting byte of a point descriptor of type
+   merge_point_desc_t. 
+   
+     a. If the descriptor is a valid point, we return
+     without doing anything.
+
+     b. If the descriptor is a special invalid descriptor, this marks
+     the end of a set of messages from a processor.  Get the next 
+     buffer and assign it to s_child_msgs, and set the cursors appropriately.
+
+        i. If there are no more messages, the s_child_msgs is set to
+           null and *retval_p is set to -1, indicating that we are 
+           finished with this set of messages for the merge operation.
+
+
+*/
+get_a_new_merge_point( retval_p )
+  int_p retval_p ;
+{
+  int result, mtag, ii ;
+  merge_point_desc_t pdesc ;
+
+  do {
+    if ( s_child_msgs != NULL )
+    {
+#if 0
+      pdesc = *((merge_point_desc_t *)(&(s_child_msgs[s_child_msgs_curs]))) ;
+#else
+/* djs 1/98 */
+      bcopy( &s_child_msgs[s_child_msgs_curs]
+           , &pdesc
+           , sizeof(merge_point_desc_t)
+           ) ;
+#endif
+      if ( pdesc.nest_id != RSL_INVALID )
+      {
+        *retval_p = 1 ;
+        return ;                /* 2.a. */
+      }
+    }
+    /* are there outstanding messages? */
+    for ( ii = 0 ; ii < s_ninfo->Nmerge_recv_Plist ; ii++ )
+    {
+      if ( s_ninfo->merge_recv_Ptags[ii] != RSL_INVALID )
+      {
+        break ;
+      }
+    }
+    if ((ii == s_ninfo->Nmerge_recv_Plist)||(s_ninfo->Nmerge_recv_Plist <= 0))
+    {
+      *retval_p = -1 ;
+      s_child_msgs = NULL ;
+      return ;                  /* 2.b.i */
+    }
+    /* scan till we get a message */
+    ii = 0 ;
+    result = 1 ;
+    while (1)
+    {
+      if ( s_ninfo->merge_recv_Ptags[ii] != RSL_INVALID )
+      {
+        if ( rsl_c_comp2phys_proc(s_ninfo->merge_recv_Plist[ii]) != rsl_myproc )
+        {
+          mtag = s_ninfo->merge_recv_Ptags[ii] ;
+          if ( rsl_noprobe == NULL )
+          {
+            RSL_PROBE( mtag, &result ) ;
+          }
+          /* else, result will always be 1 */
+          if ( result )
+          {
+#ifdef PGON
+            if ( rsl_noprobe != NULL ) RSL_RECVEND ( mtag ) ;
+#else
+            RSL_RECVEND ( mtag ) ;
+#endif
+            s_ninfo->merge_recv_Ptags[ii] = RSL_INVALID ;
+            s_child_msgs =
+               buffer_for_proc( s_ninfo->merge_recv_Plist[ii], 0, RSL_RECVBUF ) ;
+            break ;
+          }
+        }
+        else
+        {
+          /* code to handle data from myself, which will be in my send buffer */
+          s_ninfo->merge_recv_Ptags[ii] = RSL_INVALID ;
+          s_child_msgs =
+             buffer_for_proc( s_ninfo->merge_recv_Plist[ii], 0, RSL_SENDBUF ) ;
+                                                          /*    ^^^^^^^^^^^  */
+                                                          /* because data is */
+                                                          /* from myself     */
+          break ;
+        }
+      }
+      if ( ++ii >= s_ninfo->Nmerge_recv_Plist ) ii = 0 ;
+    }
+    s_child_msgs_curs = 0 ;
+#if 0
+    pdesc = *((merge_point_desc_t *)(&(s_child_msgs[s_child_msgs_curs]))) ;
+#else
+/* djs 1/98 */
+    bcopy ( &s_child_msgs[s_child_msgs_curs]
+          , &pdesc
+          , sizeof(merge_point_desc_t)
+          ) ;
+#endif
+  } while ( pdesc.nest_id == RSL_INVALID ) ;
+  *retval_p = 1 ;
+}
+
+
+post_receives_from_child()
+{
+  int ii, msglen, P, mtag, mfrom ;
+  char * work ;
+
+  for ( ii = 0 ; ii < s_ninfo->Nmerge_recv_Plist ; ii++ )
+  {
+    P = s_ninfo->merge_recv_Plist[ii] ;
+    mfrom = rsl_c_comp2phys_proc(P) ;
+    if ( mfrom != rsl_myproc )
+    {
+      msglen = s_ninfo->merge_recv_Pnpts[ii]*(sizeof(merge_point_desc_t)+s_msize)
+               + sizeof(merge_point_desc_t) ;    /* end marker */
+      work = buffer_for_proc(P, msglen, RSL_RECVBUF) ;
+      mtag = MTYPE_FROMTO( MSG_TO_PARENT, mfrom, rsl_myproc ) ;
+      RSL_RECVBEGIN( work, msglen, mtag ) ;
+      s_ninfo->merge_recv_Ptags[ii] = mtag ; /* store tag */
+    }
+    else
+    {
+      /* next statement is just diagnostic */
+      msglen = s_ninfo->merge_recv_Pnpts[ii]*(sizeof(merge_point_desc_t)+s_msize)
+               + sizeof(merge_point_desc_t) ;    /* end marker */
+      /* set the tag so we know to unpack the send buffer 
+         for data from ourself */
+      mtag = MTYPE_FROMTO( MSG_TO_PARENT, mfrom, rsl_myproc ) ;
+      s_ninfo->merge_recv_Ptags[ii] = mtag ;
+    }
+  }
+}
+
+rsl_ready_merge( d_p, n_p, msize_p )
+  int_p d_p, n_p, msize_p ;
+{
+  int i ;
+  nest_info_t *dp ;
+  rsl_list_t *lp ;
+  rsl_child_info_t * kid ;
+  rsl_point_t *pt ;
+  int kidid ;
+  int ig, jg, cn, cm ;
+  int P ;
+
+  s_msize = *msize_p ;
+  s_d = *d_p ;
+  s_nst = *n_p ;
+  RSL_TEST_ERR( stage != NULL,
+    "rsl_ready_merge: called again before RSL_MERGE_MSGS of previous call.") ;
+  RSL_TEST_ERR( s_d < 0 || s_d > RSL_MAXDOMAINS,
+    "rsl_ready_merge: bad parent domain descriptor" ) ;
+  RSL_TEST_ERR( s_nst < 0 || s_nst > RSL_MAXDOMAINS,
+    "rsl_ready_merge: bad nested domain descriptor" ) ;
+  RSL_TEST_ERR( s_d == s_nst,
+    "rsl_ready_merge: domain cannot broadcast to itself" ) ;
+  RSL_TEST_ERR( domain_info[s_nst].parent != s_d ,
+    "rsl_ready_merge: the nest is not a child of the parent" ) ;
+ 
+  s_dinfo = &( domain_info[s_d]) ;
+  s_ninfo = &( domain_info[s_nst]) ;
+  RSL_TEST_ERR( s_dinfo->valid != RSL_VALID,
+    "rsl_ready_merge: invalid parent domain" ) ;
+  RSL_TEST_ERR( s_ninfo->valid != RSL_VALID,
+    "rsl_ready_merge: invalid nested domain" ) ;
+  s_ddomain = s_dinfo->domain ;
+  s_ndomain = s_ninfo->domain ;
+
+  s_mlen = s_dinfo->len_m ;
+  s_nlen = s_dinfo->len_n ;
+  s_mlen_nst = s_ninfo->len_m ;
+  s_nlen_nst = s_ninfo->len_n ;
+  s_irax_n = s_ninfo->irax_n ;
+  s_irax_m = s_ninfo->irax_m ;
+
+  if ( s_dinfo->child_merge_compiled[s_nst] != 1 ||
+       s_ninfo->parent_merge_compiled != 1 )
+  {
+    rsl_comp_merge( d_p, n_p ) ;
+    if ( s_ninfo->merge_Xlist != NULL )
+    {
+      destroy_list( &(s_ninfo->merge_Xlist), destroy_nest_info ) ;
+    }
+    s_ninfo->merge_Xlist = NULL ;
+  }
+
+  post_receives_from_child() ;
+
+  /* stage will be NULL here because rsl_ready_merge is only called
+     if stage is NULL (that's tested near the top of this routine).
+     cleanup_after_merge deallocates all this malloc'd storage */
+
+                                                             /* v-paranoid */
+  stage = RSL_MALLOC( stage_point_t , s_mlen_nst * s_nlen_nst * 2 ) ;
+                                                             /* ^-paranoid */
+  stage_len = s_mlen_nst * s_nlen_nst ;  /* 96/3/15 */
+  for ( i = 0 ; i < stage_len ; i++ )
+  {
+    stage[i].p = NULL ;
+  }
+
+  /* construct the list of local nested points that go to parent points */
+#if 0
+  if ( Xlist != NULL ) destroy_list( &(Xlist), destroy_nest_info ) ;
+  Xlist = NULL ;
+#endif
+  if ( s_ninfo->merge_Xlist == NULL )
+  {
+
+  /* traverse backwards so that Xlist can be constructed easily frontwards */
+    for ( jg = s_nlen_nst-1 ; jg >=0 ; jg-- )
+    {
+      for ( ig = s_mlen_nst-1 ; ig >= 0 ; ig-- )
+      {
+        pt = &(s_ndomain[INDEX_2(jg,ig,s_mlen_nst)]) ;
+        if ( pt->valid == RSL_VALID &&
+             rsl_c_comp2phys_proc(pt->P) == rsl_myproc )
+        {
+          dp = RSL_MALLOC( nest_info_t, 1 ) ;
+          dp->ig = ig ;
+          dp->jg = jg ;
+          dp->cn = pt->which_kid_am_i_n ;
+          dp->cm = pt->which_kid_am_i_m ;
+          dp->mother_id = pt->mother_id ;
+          lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+          lp->data = dp ;
+          lp->next = s_ninfo->merge_Xlist ;
+          s_ninfo->merge_Xlist = lp ;
+        }
+      }
+    }
+  }
+  Xlist = s_ninfo->merge_Xlist ;
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    Plist[P] = NULL ;
+  }
+}
+
+
+
+/* now used internally only */
+rsl_comp_merge( d_p, n_p )
+  int_p d_p, 
+        n_p ;
+{
+  int d, nst, mlen, nlen, mlen_nst, nlen_nst ;
+  rsl_domain_info_t *dinfo, *ninfo ;
+  rsl_point_t *ddomain, *ndomain, *pt ;
+  rsl_child_info_t *kids ;
+  rsl_processor_t P ;
+  int i, j, jg, ig, jgn, ign, cn, cm, cnt, p ;
+  int irax_n, irax_m ;
+
+  d = *d_p ;
+  nst = *n_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, 
+        "rsl_comp_merge: bad parent domain descriptor") ;
+  RSL_TEST_ERR( nst < 0 || nst >= RSL_MAXDOMAINS, 
+        "rsl_comp_merge: bad nested domain descriptor") ;
+  RSL_TEST_ERR( d == nst, 
+        "rsl_comp_merge: domain cannot merge to itself" ) ;
+  RSL_TEST_ERR( domain_info[nst].parent != d ,
+        "rsl_comp_merge: the nest is not a child of the parent" ) ;
+
+  dinfo = &( domain_info[d]) ;
+  ninfo = &( domain_info[nst]) ;
+  RSL_TEST_ERR( dinfo->valid != RSL_VALID,
+        "rsl_comp_merge: invalid parent domain" ) ;
+  RSL_TEST_ERR( ninfo->valid != RSL_VALID,
+        "rsl_comp_merge: invalid nested domain" ) ;
+
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+  mlen_nst = ninfo->len_m ;
+  nlen_nst = ninfo->len_n ;
+  ddomain = dinfo->domain ;
+  ndomain = ninfo->domain ;
+  irax_n = ninfo->irax_n ;
+  irax_m = ninfo->irax_m ;
+
+  destroy_merge_compilation( d_p, n_p ) ;
+
+  if ( dinfo->decomposed != 1 )
+     default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  if ( ninfo->decomposed != 1 )
+     default_decomposition( n_p,
+                           &(domain_info[*n_p].loc_m),
+                           &(domain_info[*n_p].loc_n) ) ;
+
+  /* begin by computing the receive list */
+  for ( i = 0 ; i < rsl_nproc_all ; i++ ) 
+    ninfo->merge_recv_Pnpts[i] = 0 ;
+
+  for ( jgn = 0 ; jgn < nlen_nst ; jgn++ )
+  {
+    for ( ign = 0 ; ign < mlen_nst ; ign++ )
+    {
+      pt = &(ndomain[INDEX_2(jgn,ign,mlen_nst)]) ;
+      if ( pt->valid == RSL_VALID &&
+           rsl_c_comp2phys_proc(pt->mother_P) == rsl_myproc )
+      {
+        if ( pt->valid == RSL_VALID )
+          (ninfo->merge_recv_Pnpts[pt->P])++ ; /* count this point as 
+                                                  coming from the nest
+                                                  processor */
+      }
+    }
+  }
+  /* compress and copy the plist */
+  ninfo->Nmerge_recv_Plist = 0 ;
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    if ( ninfo->merge_recv_Pnpts[P] > 0 )
+    {
+      ninfo->merge_recv_Pnpts[ninfo->Nmerge_recv_Plist] =
+                                        ninfo->merge_recv_Pnpts[P] ;
+      ninfo->merge_recv_Plist[ninfo->Nmerge_recv_Plist] = P ;
+      (ninfo->Nmerge_recv_Plist)++ ;
+    }
+  }
+
+  /* now compute the send list */
+  for ( i = 0 ; i < rsl_nproc_all ; i++ ) 
+    ninfo->merge_send_Pnpts[i] = 0 ;
+
+  for ( jgn = 0 ; jgn < nlen_nst ; jgn++ )
+  {
+    for ( ign = 0 ; ign < mlen_nst ; ign++ )
+    {
+      pt = &(ndomain[INDEX_2(jgn,ign,mlen_nst)]) ;
+      if ( pt->valid == RSL_VALID && 
+           rsl_c_comp2phys_proc(pt->P) == rsl_myproc )
+      {
+        ninfo->merge_send_Pnpts[pt->mother_P]++ ;
+      }
+    }
+  }
+  /* compress and copy the plist */
+  ninfo->Nmerge_send_Plist = 0 ;
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    if ( ninfo->merge_send_Pnpts[P] > 0 )
+    {
+      ninfo->merge_send_Pnpts[ninfo->Nmerge_send_Plist] =
+                                        ninfo->merge_send_Pnpts[P] ;
+      ninfo->merge_send_Plist[ninfo->Nmerge_send_Plist] = P ;
+      (ninfo->Nmerge_send_Plist)++ ;
+    }
+  }
+
+  dinfo->child_merge_compiled[nst] = 1 ;
+  ninfo->parent_merge_compiled = 1 ;
+}
+
+cleanup_after_merge()
+{
+  int i ;
+  if ( stage != NULL )
+  {
+    for ( i = 0 ; i < stage_len ; i++ )
+    {
+      if ( stage[i].p != NULL ) RSL_FREE( stage[i].p ) ;  /* 96/3/15 */
+    }
+    RSL_FREE( stage ) ;
+  }
+  stage = NULL ;
+  s_msize = RSL_INVALID ;
+  s_dinfo = NULL ;
+  s_ninfo = NULL ;
+  s_ddomain = NULL ;
+  s_ndomain = NULL ;
+  s_child_msgs = NULL ;
+  s_child_msgs_curs = RSL_INVALID ;
+}
+
+destroy_merge_compilation( d_p, n_p )
+  int_p d_p, n_p ;
+{
+  int d, nst, P ;
+  rsl_domain_info_t *dinfo, *ninfo ;
+  rsl_point_t *ddomain, *ndomain, *pt ;
+
+  d = *d_p ;
+  nst = *n_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+        "rsl_comp_merge: bad parent domain descriptor") ;
+  RSL_TEST_ERR( nst < 0 || nst >= RSL_MAXDOMAINS,
+        "rsl_comp_merge: bad nested domain descriptor") ;
+  RSL_TEST_ERR( d == nst,
+        "rsl_comp_merge: domain cannot broadcast to itself" ) ;
+  RSL_TEST_ERR( domain_info[nst].parent != d ,
+        "rsl_comp_merge: the nest is not a child of the parent" ) ;
+
+  dinfo = &( domain_info[d]) ;
+  ninfo = &( domain_info[nst]) ;
+  RSL_TEST_ERR( dinfo->valid != RSL_VALID,
+        "rsl_comp_merge: invalid parent domain" ) ;
+  RSL_TEST_ERR( ninfo->valid != RSL_VALID,
+        "rsl_comp_merge: invalid nested domain" ) ;
+  
+  ninfo->parent_merge_compiled = 0 ;
+  dinfo->child_merge_compiled[nst] = 0 ;
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    ninfo->merge_recv_Pnpts[P] = 0 ;
+    ninfo->merge_recv_Plist[P] = RSL_INVALID ;
+    ninfo->merge_recv_Ptags[P] = RSL_INVALID ;
+    ninfo->Nmerge_recv_Plist = 0 ;
+  }
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_merge_f.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_merge_f.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_merge_f.F	(revision 2744)
@@ -0,0 +1,99 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine rsl_merge_chld( pd, nd, msize, mf, pf, upf )
+      call cwrap_fmerge( pd, nd, msize, mf, pf, upf )
+      return
+      end
+
+      subroutine rsl_f_merge_chld( pd, nd, msize, buf, mf, pf, upf )
+      implicit none
+      integer pd                ! parent domain
+      integer nd                ! nested domain
+      integer msize             ! message size (bytes)
+      logical mf                ! packing  mask function
+      integer pf                ! packing function
+      integer upf               ! unpacking function
+      real buf(*)
+      include 'rsl.inc'
+c local variables
+      integer retval, i, j, pig, pjg, nig, njg
+      integer dum, n, cm, cn
+
+      call rsl_to_parent_info( pd, nd, msize,
+     +                         i,j,nig,njg,cm,cn,pig,pjg,retval )
+      do while ( retval .eq. 1 )
+        if ( mf( pd, nd, i, j, nig, njg ) ) then
+          dum = pf( pd, nd, i, j, nig, njg, cm, cn, buf, msize )
+          call rsl_to_parent_msg( msize, buf )
+        endif
+        call rsl_to_parent_info( pd, nd, msize,
+     +                           i,j,nig,njg,cm,cn,pig,pjg,retval )
+      enddo
+
+      call rsl_merge_msgs
+
+      call rsl_from_child_info( i,j,pig,pjg,cm,cn,nig,njg,retval )
+      do while ( retval .eq. 1 )
+        call rsl_from_child_msg( msize, buf )
+        dum = upf( pd, nd, i, j, pig, pjg, cm, cn, buf, msize )
+        call rsl_from_child_info( i,j,pig,pjg,cm,cn,nig,njg,retval )
+      enddo
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mm_io.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mm_io.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mm_io.c	(revision 2744)
@@ -0,0 +1,596 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* this module is specific to MM5 */
+
+
+/*@
+  RSL_READ_REPL --- Fortran read of replicated, byte data into a buffer
+
+  Notes:
+  This does an unformatted (binary) Fortran read on a
+  file specified by Arg1.  Data is read into the buffer specified
+  by Arg2.  The length of the buffer, in bytes, is given by
+  Arg3.  When the call returns, the data will be available on
+  all processors.
+
+@*/
+RSL_READ_REPL ( unit_p, base, nbytes_p )
+  int_p
+    unit_p ;     /* (I) Fortran I/O unit number. */
+  void *
+    base ;       /* (O) Buffer. */
+  int_p
+    nbytes_p ;   /* (I) Buffer length in bytes. */
+{
+  int unit, nbytes ;
+  rsl_read_req_t request ;
+  rsl_read_resp_t resp ;
+  rsl_processor_t P ;
+  int mlen, nlen, d ;
+  int mdest, mtag, msglen ;
+  int i_am_monitor ;
+
+  RSL_C_IAMMONITOR ( &i_am_monitor ) ;
+
+#ifdef T3D
+  fprintf(stderr,"RSL_READ_REPL not implemented on T3D\n") ;
+  fprintf(stderr,"Use RSL_READ_REPLW instead\n") ;
+  RSL_TEST_ERR(1,"") ;
+  exit(2) ;
+#else
+
+  unit = *unit_p ;
+  nbytes = *nbytes_p ;
+  request.request_type = RSL_READ_SPECIAL2 ;
+  request.speciala = nbytes ;
+  request.myproc = rsl_myproc ;
+  request.base = base ;
+  request.unit = *unit_p ;
+  request.sequence = io_seq_compute++ ;
+
+  if ( i_am_monitor )
+  {
+    FORT_CHARACTERREAD ( &unit, base, &nbytes ) ;
+    for ( P = 0 ; P < rsl_nproc_all ; P++ )     /* 95/02/22 */
+    {
+      mdest = rsl_c_comp2phys_proc(P) ;
+      if ( mdest != rsl_myproc )
+      {
+        mtag = MTYPE_FROMTO( MSG_SPECIAL2_RESPONSE, rsl_myproc, mdest ) ;
+        msglen = sizeof( resp ) ;
+        RSL_SEND( &resp, msglen, mtag, mdest ) ;
+        msglen = nbytes ;
+        RSL_SEND( base, msglen, mtag, mdest ) ;
+      }
+    }
+  }
+  else
+  {
+    mdest = RSL_C_MONITOR_PROC () ;
+    mtag = MTYPE_FROMTO( MSG_SPECIAL2_RESPONSE, mdest, rsl_myproc ) ;
+    msglen = sizeof(resp) ;
+    RSL_RECV( &resp, msglen, mtag ) ;
+    msglen = nbytes ;
+    RSL_RECV( base, msglen, mtag ) ;
+  }
+#endif
+}
+
+/*@
+  RSL_READ_REPLW --- Fortran read of replicated, typed data into a buffer
+
+  Notes:
+  This does an unformatted (binary) Fortran read on a
+  file specified by Arg1.  The element type of the data is
+  given as Arg2.  It may be
+  Verbatim:
+$      RSL_REAL
+$      RSL_INTEGER
+$      RSL_DOUBLE
+$      RSL_COMPLEX
+$      RSL_CHARACTER
+BREAKTHEEXAMPLECODE
+
+  The buffer is provided as
+  Arg3.  The length of the buffer, expressed as the number of
+  elements to be read, is given by
+  Arg4.  When the call returns, the data will be available on
+  all processors.
+
+@*/
+
+RSL_READ_REPLW ( unit_p, type_p, base, nelems_p )
+  int_p
+    unit_p      /* (I) Fortran I/O unit number. */
+   ,type_p ;    /* (I) Element type of data. */
+  void *
+    base ;      /* (O) Buffer. */
+  int_p
+    nelems_p ;  /* (I) Number of elements to be read. */
+{
+  int unit, nwords, type ;
+  rsl_read_req_t request ;
+  rsl_read_resp_t resp ;
+  rsl_processor_t P ;
+
+  int mdest, mtag, mlen ;
+  int i_am_monitor ;
+
+  RSL_C_IAMMONITOR ( &i_am_monitor ) ;
+
+  unit = *unit_p ;
+  nwords = *nelems_p ;
+  type = *type_p ;
+  request.request_type = RSL_READ_SPECIAL2 ;
+  request.speciala = nwords ;
+  request.myproc = rsl_myproc ;
+  request.base = base ;
+  request.unit = *unit_p ;
+  request.sequence = io_seq_compute++ ;
+
+  if ( i_am_monitor )
+  {
+
+    switch (type)
+    {
+    case RSL_REAL :
+      FORT_REALREAD ( &unit, base, &nwords ) ;
+      break ;
+    case RSL_INTEGER :
+      FORT_INTREAD ( &unit, base, &nwords ) ;
+      break ;
+#ifndef T3D
+    case RSL_DOUBLE :
+      FORT_DOUBLEREAD ( &unit, base, &nwords ) ; 
+      break ;
+#endif
+    case RSL_COMPLEX :
+      FORT_COMPLEXREAD ( &unit, base, &nwords ) ; 
+      break ;
+    case RSL_CHARACTER :
+      FORT_CHARACTERREAD ( &unit, base, &nwords ) ;
+      break ;
+    default:
+      RSL_TEST_ERR(1,"unsupported type argument") ;
+    }
+    for ( P = 0 ; P < rsl_nproc_all ; P++ )     /* 95/02/22 */
+    {
+      mdest = rsl_c_comp2phys_proc(P) ;
+      if ( mdest != rsl_myproc )
+      {
+        mtag = MTYPE_FROMTO( MSG_SPECIAL2_RESPONSE, rsl_myproc, mdest ) ;
+        mlen = sizeof( resp ) ;
+        RSL_SEND( &resp, mlen, mtag, mdest ) ;
+        mlen = elemsize(type)*nwords ;
+        RSL_SEND( base, mlen, mtag, mdest ) ;
+      }
+    }
+  }
+  else
+  {
+    mdest = RSL_C_MONITOR_PROC () ;
+    mtag = MTYPE_FROMTO( MSG_SPECIAL2_RESPONSE, mdest, rsl_myproc ) ;
+    mlen = sizeof(resp) ;
+    RSL_RECV( &resp, mlen, mtag ) ;
+    mlen = elemsize(type)*nwords ;
+    RSL_RECV( base, mlen, mtag ) ;
+  }
+}
+
+/* this module is specific to MM5 -- yes, it is a kludge to the max */
+
+/* rev: 9/8/94 -- fixed problem wherein the monitor would attempt to
+   free buffers for boundaries it did not have (and so, had not been
+   allocated storage by the call to handle_spec1).   The effect was
+   a segmentation error in the call to free.    */
+   
+
+RSL_MM_BDY_IN ( unit_p, iotag_p,
+                ebase, wbase, nbase, sbase,
+                d_p, type_p,
+                bdy_wdth_p,
+                glen, llen )
+  int_p unit_p ;
+  int_p iotag_p ;
+  int_p type_p ;
+  int_p bdy_wdth_p ;
+  int_p d_p ;
+  char *ebase, *wbase, *nbase, *sbase ;
+  int glen[], llen[] ;
+{
+  rsl_read_req_t request ;
+  rsl_read_resp_t resp ;
+  int cursor, mdest, mtag, msglen, dim ;
+  int bwdth ;
+  unsigned long ig, jg, min, maj, ioffset, joffset, tlen, k ;
+  void *dex ;
+  char *pbuf ;
+  char *buf_w, *buf_e, *buf_n, *buf_s ;
+  int wsz, esz, nsz, ssz ;
+  rsl_read_resp_t resp_w, resp_e, resp_n, resp_s ;
+  int P, mlen, nlen, d  ;
+  int bdymark() ;
+  int i_am_monitor, got_bdy ;
+  rsl_point_t *domain ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_init_nextcell: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+  mlen = domain_info[d].len_m ;
+  nlen = domain_info[d].len_n ;
+  domain = domain_info[d].domain ;
+
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+
+  bwdth = *bdy_wdth_p ;
+  ioffset = domain_info[*d_p].ilocaloffset ;
+  joffset = domain_info[*d_p].jlocaloffset ;
+  tlen = elemsize( *type_p ) ;
+
+  request.request_type = RSL_READ_SPECIAL1 ;
+  request.speciala = bwdth ;
+  request.myproc = rsl_myproc ;
+  request.base = ebase ;        /* not used anyway */
+  request.domain = *d_p ;
+  request.unit = *unit_p ;
+  request.type = *type_p ;
+  request.iotag = *iotag_p ;
+  request.sequence = io_seq_compute++ ;
+
+  P = rsl_c_phys2comp_proc( rsl_myproc ) ;
+  mlen = domain_info[*d_p].len_m ;
+  nlen = domain_info[*d_p].len_n ;
+  d = *d_p ;
+
+  switch( *iotag_p )
+  {
+  case IO2D :
+  case IO2D_IJ :
+  case IO2D_JI :
+    request.ndim = 2 ;
+    break ;
+  case IO3D :
+  case IO3D_IJK :
+  case IO3D_JIK :
+    request.ndim = 3 ;
+    break ;
+  default:
+      RSL_TEST_ERR(1,"rsl_mm_bdy_in: unknown data tag") ;
+  }
+  for ( dim = 0 ; dim < request.ndim ; dim++ )
+  {
+    request.glen[dim] = glen[dim] ;
+    request.llen[dim] = llen[dim] ;
+  }
+
+  buf_w = NULL ;
+  buf_e = NULL ;
+  buf_n = NULL ;
+  buf_s = NULL ;
+  got_bdy = handle_special1( &request, &buf_e, &esz,
+                                       &buf_w, &wsz,
+                                       &buf_n, &nsz,
+                                       &buf_s, &ssz ) ;
+  if ( got_bdy )
+  {
+    int i, j, k, by, b ;
+    int ix_g, jx_g, kx_g ;
+    int ix_l, jx_l, kx_l ;
+    ix_g = glen[0] ; jx_g = glen[1] ; kx_g = (request.ndim==3)?glen[2]:1 ;
+    ix_l = llen[0] ; jx_l = llen[1] ; kx_l = (request.ndim==3)?glen[2]:1 ;
+
+    /* west/east */
+    for ( b = 0 ; b < bwdth ; b++ )
+      for ( k = 0 ; k < kx_l ; k++ )
+        for ( i = 0 ; i < ix_l ; i++ )
+	{
+          if ( i+ioffset >= 0 )
+          {
+            for ( by = 0 ; by < tlen ; by++ )
+	    {
+	      wbase[by+tlen*(i+k*ix_l+b*ix_l*kx_l)]=buf_w[by+tlen*((i+ioffset)+k*ix_g+b*ix_g*kx_g)];
+	      ebase[by+tlen*(i+k*ix_l+b*ix_l*kx_l)]=buf_e[by+tlen*((i+ioffset)+k*ix_g+b*ix_g*kx_g)];
+	    }
+          }
+	}
+
+    /* north/south */
+    for ( b = 0 ; b < bwdth ; b++ )
+      for ( k = 0 ; k < kx_l ; k++ )
+        for ( j = 0 ; j < jx_l ; j++ )
+	{
+          if ( j+joffset >= 0 )
+          {
+            for ( by = 0 ; by < tlen ; by++ )
+	    {
+	      nbase[by+tlen*(j+k*jx_l+b*jx_l*kx_l)]=buf_n[by+tlen*((j+joffset)+k*jx_g+b*jx_g*kx_g)];
+	      sbase[by+tlen*(j+k*jx_l+b*jx_l*kx_l)]=buf_s[by+tlen*((j+joffset)+k*jx_g+b*jx_g*kx_g)];
+	    }
+	  }
+	}
+  }
+
+  RSL_FREE( buf_e ) ;
+}
+
+#include "which_boundary.h"
+
+RSL_MM_DIST_BDY ( unit_p, iotag_p, iorder_p, base, d_p,
+                  type_p, bdy_wdth_p, bdy_height_p,
+                  bdy_g_length_p, bdy_l_length_p )
+  int_p
+    unit_p
+   ,iotag_p
+   ,iorder_p ;
+  char *
+    base ;
+  int_p
+    d_p
+   ,type_p
+   ,bdy_wdth_p
+   ,bdy_height_p
+   ,bdy_g_length_p
+   ,bdy_l_length_p ;
+
+{
+  rsl_read_req_t request ;
+  rsl_read_resp_t resp ;
+  int cursor, mdest, mtag, msglen, dim ;
+  int bwdth ;
+  unsigned long ig, jg, min, maj, ioffset, joffset, tlen, k ;
+  void *dex ;
+  char *buf ;
+  int P, mlen, nlen, d  ;
+  int i_am_monitor, got_bdy, iorder, which_boundary ;
+  rsl_point_t *domain ;
+
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "rsl_init_nextcell: bad domain") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+     "rsl_init_nextcell: invalid domain") ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    default_decomposition( d_p,
+                           &(domain_info[*d_p].loc_m),
+                           &(domain_info[*d_p].loc_n) ) ;
+  }
+  mlen = domain_info[d].len_m ;
+  nlen = domain_info[d].len_n ;
+  domain = domain_info[d].domain ;
+
+  RSL_C_IAMMONITOR( &i_am_monitor ) ;
+
+  iorder = *iorder_p ;
+  bwdth = *bdy_wdth_p ;
+  ioffset = domain_info[*d_p].ilocaloffset ;
+  joffset = domain_info[*d_p].jlocaloffset ;
+  tlen = elemsize( *type_p ) ;
+
+  request.request_type = RSL_READ_SPECIAL1 ;
+  request.speciala = bwdth ;
+  request.myproc = rsl_myproc ;
+  request.base = base ;        /* not used anyway */
+  request.domain = *d_p ;
+  request.unit = *unit_p ;
+  request.type = *type_p ;
+  request.iotag = *iotag_p ;
+  request.sequence = io_seq_compute++ ;
+
+  P = rsl_c_phys2comp_proc( rsl_myproc ) ;
+  mlen = domain_info[*d_p].len_m ;
+  nlen = domain_info[*d_p].len_n ;
+  d = *d_p ;
+
+  switch( *iotag_p )
+  {
+  case IO2D :
+  case IO2D_IJ :
+  case IO2D_JI :
+    request.ndim = 2 ;
+    break ;
+  case IO3D :
+  case IO3D_IJK :
+  case IO3D_JIK :
+    request.ndim = 3 ;
+    break ;
+  default:
+      RSL_TEST_ERR(1,"rsl_mm_bdy_in: unknown data tag") ;
+  }
+
+#if 0
+   /* east  2 */
+   /* west  1 */
+   /* north 8 */
+   /* south 4 */
+#endif
+
+     /* set up some dimensioning for the call to handle_special3.  For regularity with
+	other parts of the RSL code it uses the glen/llen construct for carrying this
+	information, although in the case of n/s boundaries the i info is not used and
+	in the case of the e/w boundaries the j info is not used.  The boundary width
+	information is set above, in the assigment of request.speciala                   */
+
+  switch ( iorder )
+  {
+  case RSL_MLOW :                    /* south */
+    which_boundary = WHICH_BDY_SOUTH ;
+  case RSL_MHIGH :                   /* north */    /* FALL THROUGH */
+    which_boundary = WHICH_BDY_NORTH ;
+    request.glen[0] =  0 ;                 /* I dimension NOT USED for n/s boundaries */
+    request.glen[1] =  *bdy_g_length_p ;   /* Global length of boundary is global J */
+    request.glen[2] =  *bdy_height_p ;     /* number of levels */
+    request.llen[0] =  0 ;                 /* I dimension NOT USED for n/s boundaries */
+    request.llen[1] =  *bdy_l_length_p ;   /* Local length of boundary is local J */
+    request.llen[2] =  *bdy_height_p ;     /* number of levels */
+    break ;
+  case RSL_NLOW :                    /* west */
+    which_boundary = WHICH_BDY_WEST ;
+  case RSL_NHIGH :                   /* east */    /* FALL THROUGH */
+    which_boundary = WHICH_BDY_EAST ;
+    request.glen[0] =  *bdy_g_length_p ;   /* Global Length of boundary is global I */
+    request.glen[1] =  0 ;                 /* J dimension NOT USED for e/w boundaries */
+    request.glen[2] =  *bdy_height_p ;     /* number of levels */
+    request.llen[0] =  *bdy_l_length_p ;   /* Local length of boundary is local I */
+    request.llen[1] =  0 ;                 /* J dimension NOT USED for e/w boundaries */
+    request.llen[2] =  *bdy_height_p ;     /* number of levels */
+    break ;
+  default :
+    RSL_TEST_ERR(1,"Bad iorder spec for RSL_MM_DIST_BDY") ;
+    break ;
+  }
+
+
+  buf = NULL ;
+  got_bdy = handle_special3( &request, which_boundary, base, &buf ) ;
+
+  if ( got_bdy )
+  {
+    int i, j, k, by, b ;
+    int ix_g, jx_g, kx_g ;
+    int ix_l, jx_l, kx_l ;
+    ix_g = request.glen[0] ; jx_g = request.glen[1] ; kx_g = (request.ndim==3)?request.glen[2]:1 ;
+    ix_l = request.llen[0] ; jx_l = request.llen[1] ; kx_l = (request.ndim==3)?request.glen[2]:1 ;
+
+    switch ( iorder )
+    {
+    case RSL_NHIGH :
+    /* east */
+    for ( b = 0 ; b < bwdth ; b++ )
+      for ( k = 0 ; k < kx_l ; k++ )
+        for ( i = 0 ; i < ix_l ; i++ )
+	{
+          if ( i+ioffset >= 0 )
+          {
+            for ( by = 0 ; by < tlen ; by++ )
+	    {
+	      base[by+tlen*(i+k*ix_l+b*ix_l*kx_l)]=buf[by+tlen*((i+ioffset)+k*ix_g+b*ix_g*kx_g)];
+	    }
+          }
+	}
+        break ;
+
+    case RSL_NLOW :
+    /* west */
+    for ( b = 0 ; b < bwdth ; b++ )
+      for ( k = 0 ; k < kx_l ; k++ )
+        for ( i = 0 ; i < ix_l ; i++ )
+        {
+          if ( i+ioffset >= 0 )
+          {
+            for ( by = 0 ; by < tlen ; by++ )
+            {
+	      base[by+tlen*(i+k*ix_l+b*ix_l*kx_l)]=buf[by+tlen*((i+ioffset)+k*ix_g+b*ix_g*kx_g)];
+            }
+          }
+        }
+        break ;
+
+    case RSL_MHIGH :
+    /* north */
+    for ( b = 0 ; b < bwdth ; b++ )
+      for ( k = 0 ; k < kx_l ; k++ )
+        for ( j = 0 ; j < jx_l ; j++ )
+	{
+          if ( j+joffset >= 0 )
+          {
+            for ( by = 0 ; by < tlen ; by++ )
+	    {
+	      base[by+tlen*(j+k*jx_l+b*jx_l*kx_l)]=buf[by+tlen*((j+joffset)+k*jx_g+b*jx_g*kx_g)];
+	    }
+	  }
+	}
+        break ;
+
+    case RSL_MLOW :
+    /* south */
+    for ( b = 0 ; b < bwdth ; b++ )
+      for ( k = 0 ; k < kx_l ; k++ )
+        for ( j = 0 ; j < jx_l ; j++ )
+	{
+          if ( j+joffset >= 0 )
+          {
+            for ( by = 0 ; by < tlen ; by++ )
+	    {
+	      base[by+tlen*(j+k*jx_l+b*jx_l*kx_l)]=buf[by+tlen*((j+joffset)+k*jx_g+b*jx_g*kx_g)];
+	    }
+	  }
+	}
+        break ;
+
+    default:
+        RSL_TEST_ERR(1,"what boundary was that??") ;
+        break ;
+    }
+  }
+
+  RSL_FREE( buf ) ;
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mon_bcast.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mon_bcast.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mon_bcast.c	(revision 2744)
@@ -0,0 +1,147 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+/* added 9/20/94 */
+
+/*
+ *  rsl_mon_bcast
+ *
+ *  broadcasts a buffer from the monitor to all other nodes 
+ *
+ *  Right now this is a dumb algorithm for portability.  Could
+ *  map this down to bcasts in specific underlying message packages
+ *  at some point.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_MON_BCAST -- Broadcast a buffer from monitor to all other procs.
+
+  Notes:
+  On return, the contents of Arg1 on the monitor processor (usually
+  processor zero) will be contents of Arg1 on all processors.
+  The integer Arg2 is the number of bytes of Arg1 to be broadcast.
+  This routine may be called before RSL_MESH has been called.
+
+  This routine broadcasts the entire buffer, which is considered to be
+  replicated, and therefore undecomposed, data.
+  RSL also permits decomposed array data to be aggragated and distributed
+  from the monitor processor using internal writes and reads (see RSL_WRITE
+  and RSL_READ).
+
+  Despite the unfortunate similarity in names, this routine should not be confused with RSL_BCAST, the scatter operation
+  for nest forcing.  
+
+  Example:
+
+$ Need example
+
+BREAKTHEEXAMPLECODE
+
+  See also:
+  RSL_INITIALIZE, RSL_IAMMONITOR, RSL_READ, RSL_WRITE
+@*/
+
+RSL_MON_BCAST ( buf, nbytes0 )
+  void *
+    buf ;       /*  (IO) Buffer to be broadcast. */
+  int_p 
+    nbytes0 ;   /*  (I) Length of buffer in bytes. */
+{
+  int nbytes ;
+  int retval ;
+  int mtype, mdest, mfrom, mlen ;
+  int P ;
+
+  nbytes = *nbytes0 ;
+
+  RSL_TEST_ERR( buf == NULL, "NULL pointer" ) ;
+  RSL_TEST_ERR( nbytes < 0 , "Invalid (negative) number of bytes" ) ;
+
+#if 0
+/* Replaced this with an MPI_Bcast (below), 3/3/00 */
+  RSL_C_IAMMONITOR ( &retval ) ;
+
+  if ( retval == 1 )                    /* monitor code */
+  {
+    for ( P = 0 ; P < rsl_nproc_all ; P++ )     /* 95/02/22 */
+    {
+      if ( rsl_c_comp2phys_proc(P) != rsl_myproc )  /* not me */
+      {
+               mdest = rsl_c_comp2phys_proc (P) ;
+        mlen  = nbytes ;
+        mtype = MTYPE_FROMTO( MSG_MON_BCAST, rsl_myproc, mdest ) ;
+               RSL_SEND( buf, mlen, mtype, mdest ) ;
+      }
+    }
+  }
+  else                                  /* other nodes */
+  {
+    mfrom = RSL_C_MONITOR_PROC () ;
+    mlen  = nbytes ;
+    mtype  = MTYPE_FROMTO( MSG_MON_BCAST, mfrom, rsl_myproc ) ;
+    RSL_RECV( buf, mlen, mtype ) ;
+  }
+#else
+#  ifndef STUBS
+  MPI_Bcast( buf, nbytes, MPI_BYTE, 0, rsl_mpi_communicator ) ;
+#  endif
+#endif
+
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_move.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_move.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_move.c	(revision 2744)
@@ -0,0 +1,64 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+rsl_move_cells()
+{
+   RSL_TEST_WRN( 1, "rsl_move_cells: stub" ) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mpi_compat.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mpi_compat.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mpi_compat.c	(revision 2744)
@@ -0,0 +1,290 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#ifdef MPI
+#ifndef __MPI_COMPAT__
+#define __MPI_COMPAT__
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "mpi.h" 
+#include "rsl.h"
+
+#define RSLHandleInc 32
+
+
+struct tagsToHandles
+       {
+       int tag;
+       MPI_Request Handle;
+       };
+struct rslMPIHandles
+       {
+       int nHandles;
+       int nUsed;
+       struct tagsToHandles *tags;
+       } rslMPIHandleLUT;
+
+/******************************************************
+ * rslMPIInit ()
+ *   do whatever initialization is necessary for the
+ *   MPI port
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *  Adapted to MPI: J. Michalakes 7/13/94
+ *
+ *****************************************************/
+
+static int dummy = 0 ;
+
+#ifdef linux
+int xargc ;
+#endif
+
+void rslMPIInit()
+  {
+  int flag ;
+  rslMPIHandleLUT.nHandles = RSLHandleInc;
+  rslMPIHandleLUT.nUsed = 0;
+  rslMPIHandleLUT.tags = (struct tagsToHandles *) 
+                     malloc (sizeof (struct tagsToHandles) * RSLHandleInc);
+
+  MPI_Initialized( &flag ) ;
+
+  if ( ! flag ) {
+
+#ifndef linux
+  MPI_INIT_F ( &dummy ) ;  /* call to fortran wrapper */
+#else
+  xargc = iargc_()+1;
+#  ifdef F2CSTYLE
+  mpi_init__( &dummy ) ;
+#  else
+  mpi_init_( &dummy ) ;
+#  endif
+#endif
+
+  }
+
+#ifdef FATAL_ERRORS
+  if (rslMPIHandleLUT.tags == NULL)
+    {
+    fprintf (stderr, "Fatal Error: malloc failure in rslMPIInit\n");
+    exit(1);
+    }
+#endif
+  }
+
+
+/******************************************************
+ * rslMPIWho ( numproc, myproc )
+ *  Use the LUT to find an MPI wait handle from a tag
+ *
+ *  Initial coding: J. Michalakes  7/13/94
+ *
+ *****************************************************/
+
+long rslMPIWho( numproc, myproc )
+  int * numproc, * myproc ;
+{
+  MPI_Comm_rank( rsl_mpi_communicator, myproc ) ;
+  MPI_Comm_size( rsl_mpi_communicator, numproc ) ;
+  return( 0L ) ;
+}
+
+/******************************************************
+ * rslMPIFindWaitH (tag)
+ *  Use the LUT to find an MPI wait handle from a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+
+long rslMPIFindWaitH (tag, waitHandle)
+  int tag;   /* Tag for which we lookup a wait handle */
+  MPI_Request *waitHandle ;
+  {
+  int i;
+  long retVal = -1;
+
+  for (i=0; i < rslMPIHandleLUT.nUsed; i++)
+    {
+    if (rslMPIHandleLUT.tags[i].tag == tag)
+      {
+      *waitHandle = rslMPIHandleLUT.tags[i].Handle;
+      rslMPIHandleLUT.nUsed--;  /* Keep them contiguous */
+      rslMPIHandleLUT.tags[i].tag=rslMPIHandleLUT.tags[rslMPIHandleLUT.nUsed].tag;
+      rslMPIHandleLUT.tags[i].Handle=
+                  rslMPIHandleLUT.tags[rslMPIHandleLUT.nUsed].Handle;
+      break;
+      }
+    }
+    return(0L) ;
+  }
+
+/******************************************************
+ * rslMPISaveWaitH (tag, waitHandle)
+ *  Use the LUT to save an MPI wait handle referenced by a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslMPISaveWaitH (tag, waitHandle)
+ int tag;
+ MPI_Request * waitHandle;
+ {
+ /* Make sure there is enough space, if not, try a realloc */
+ /* If the realloc fails we're in deep trouble */
+ if (rslMPIHandleLUT.nUsed == rslMPIHandleLUT.nHandles)
+   {
+   struct tagsToHandles *tags;  /* Temp pointer */
+   tags = (struct tagsToHandles *) 
+      realloc (rslMPIHandleLUT.tags, 
+      sizeof (struct tagsToHandles) * (rslMPIHandleLUT.nHandles + RSLHandleInc));
+   if (tags != NULL)
+     {
+     rslMPIHandleLUT.tags = tags;
+     rslMPIHandleLUT.nHandles += RSLHandleInc;
+     }
+   else
+     {
+#ifdef FATAL_ERRORS
+     fprintf (stderr, "Fatal Error: realloc failure in rslMPISaveWaitH\n");
+     exit(1);
+#endif
+     return;
+     }
+   }
+ /* Stash the handle */
+ rslMPIHandleLUT.tags[rslMPIHandleLUT.nUsed].tag = tag;
+ rslMPIHandleLUT.tags[rslMPIHandleLUT.nUsed].Handle = *waitHandle;
+ rslMPIHandleLUT.nUsed++;
+ }
+
+/******************************************************
+ * rslMPIISend (buff, mlen, tag, dest)
+ *  Post a non blocking send an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslMPIISend (buff, mlen, tag, dest)
+ char *buff;
+ int mlen;
+ int tag;
+ int dest;
+ {
+   MPI_Request waitHandle;
+ 
+   MPI_Isend (buff,
+              mlen,
+              MPI_BYTE,
+              dest,
+              tag,
+              rsl_mpi_communicator,
+              &waitHandle); 
+
+   rslMPISaveWaitH (tag, &waitHandle);
+ }
+ 
+/******************************************************
+ * rslMPIIRecv (buff, mlen, tag)
+ *  Post a non blocking receive an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslMPIIRecv (buff, mlen, tag)
+ char *buff;
+ int mlen;
+ int tag;
+ {
+   MPI_Request waitHandle;
+
+   MPI_Irecv (buff,
+              mlen,
+              MPI_BYTE,
+              MPI_ANY_SOURCE,
+              tag,
+              rsl_mpi_communicator,
+              &waitHandle);
+
+   rslMPISaveWaitH (tag, &waitHandle);
+ }
+
+/******************************************************
+ * rslMPIWait (tag)
+ *  Wait for a pending send/recv
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslMPIWait (tag)
+ int tag;
+ {
+ MPI_Request waitHandle;
+ MPI_Status status ;
+
+ rslMPIFindWaitH (tag, &waitHandle );
+ (void) MPI_Wait ( &waitHandle, &status  );
+ }
+
+#endif /* __MPI_COMPAT__ */
+#endif /* MPI */
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mpl_compat.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mpl_compat.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_mpl_compat.c	(revision 2744)
@@ -0,0 +1,421 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#ifdef MPL
+#ifndef __MPL_COMPAT__
+#define __MPL_COMPAT__
+
+#include <stdio.h>
+#include "rsl.h"
+#include "rsl_comm.h"
+
+typedef int MPL_Request ;
+typedef int MPL_Status ;
+
+#define RSLHandleInc 32
+
+#define FATAL_ERRORS
+
+
+struct tagsToHandles
+       {
+       int tag;
+       MPL_Request Handle;
+       int type ;		/* send = 1, recv = 2 */
+       int nbytes ;
+       };
+struct rslMPLHandles
+       {
+       int nHandles;
+       int nUsed;
+       struct tagsToHandles *tags;
+       } rslMPLHandleLUT;
+
+/******************************************************
+ * rslMPLInit ()
+ *   do whatever initialization is necessary for the
+ *   MPL port
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *  Adapted to MPL: J. Michalakes 7/13/94
+ *
+ *****************************************************/
+
+static int argc_dummy = 0 ;
+static char * argv_dummy = "" ;
+
+int dontcare ;
+int allmsg ;
+int nulltask ;
+int allgrp ;
+int type_low ;
+int type_high ;
+
+void rslMPLInit()
+{
+  int nbuf[4] ;
+   
+  rslMPLHandleLUT.nHandles = RSLHandleInc;
+  rslMPLHandleLUT.nUsed = 0;
+  rslMPLHandleLUT.tags = (struct tagsToHandles *) 
+                     malloc (sizeof (struct tagsToHandles) * RSLHandleInc);
+
+  mpc_task_query( nbuf, 2, 2 ) ;
+  type_low = nbuf[0] ;
+  type_high= nbuf[1] ;
+  mpc_task_query( nbuf, 4, 3 ) ;
+  dontcare = nbuf[0] ;
+  allmsg   = nbuf[1] ;
+  nulltask = nbuf[2] ;
+  allgrp   = nbuf[3] ;
+
+#if 0
+  fprintf(stderr,"rslMPLInit: \n") ;
+  fprintf(stderr,"type_low:  %d\n",type_low) ;
+  fprintf(stderr,"type_high: %d\n",type_high) ;
+  fprintf(stderr,"dontcare:  %d\n",dontcare) ;
+  fprintf(stderr,"allmsg:    %d\n",allmsg) ;
+  fprintf(stderr,"nulltask:  %d\n",nulltask) ;
+  fprintf(stderr,"allgrp:    %d\n",allgrp) ;
+#endif
+
+
+#ifdef FATAL_ERRORS
+  if (rslMPLHandleLUT.tags == NULL)
+    {
+    fprintf (stderr, "Fatal Error: malloc failure in rslMPLInit\n");
+    exit(1);
+    }
+#endif
+}
+
+
+/******************************************************
+ * rslMPLFindWaitH (tag)
+ *  Use the LUT to find an MPL wait handle from a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+
+long rslMPLFindWaitH (tag, waitHandle, type, nbytes )
+  int tag;   /* Tag for which we lookup a wait handle */
+  MPL_Request *waitHandle ;
+  int *type, *nbytes ;
+{
+  int i;
+  long retVal = -1;
+
+  for (i=0; i < rslMPLHandleLUT.nUsed; i++)
+  {
+    if (rslMPLHandleLUT.tags[i].tag == tag)
+    {
+      *waitHandle = rslMPLHandleLUT.tags[i].Handle;
+      *type = rslMPLHandleLUT.tags[i].type;
+      *nbytes = rslMPLHandleLUT.tags[i].nbytes;
+      rslMPLHandleLUT.nUsed--;  /* Keep them contiguous */
+      rslMPLHandleLUT.tags[i].tag=rslMPLHandleLUT.tags[rslMPLHandleLUT.nUsed].tag;
+      rslMPLHandleLUT.tags[i].Handle=
+                  rslMPLHandleLUT.tags[rslMPLHandleLUT.nUsed].Handle;
+      rslMPLHandleLUT.tags[i].type=
+		  rslMPLHandleLUT.tags[rslMPLHandleLUT.nUsed].type;
+      rslMPLHandleLUT.tags[i].nbytes=
+		  rslMPLHandleLUT.tags[rslMPLHandleLUT.nUsed].nbytes ;
+      retVal = 0 ;
+      break;
+    }
+  }
+  return( retVal ) ;
+}
+
+/* same as above, but leaves list alone */
+long rslMPLPeekWaitH (tag, waitHandle, type, nbytes )
+  int tag;   /* Tag for which we lookup a wait handle */
+  MPL_Request *waitHandle ;
+  int *type, *nbytes ;
+{
+  int i;
+  long retVal = -1;
+
+  for (i=0; i < rslMPLHandleLUT.nUsed; i++)
+  {
+    if (rslMPLHandleLUT.tags[i].tag == tag)
+    {
+      *waitHandle = rslMPLHandleLUT.tags[i].Handle;
+      *type = rslMPLHandleLUT.tags[i].type;
+      *nbytes = rslMPLHandleLUT.tags[i].nbytes;
+      retVal = 0 ;
+      break;
+    }
+  }
+  return( retVal ) ;
+}
+
+
+/******************************************************
+ * rslMPLSaveWaitH (tag, waitHandle)
+ *  Use the LUT to save an MPL wait handle referenced by a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslMPLSaveWaitH (tag, waitHandle,type,nbytes)
+ int tag;
+ MPL_Request * waitHandle;
+ int type, nbytes ;
+{
+ /* Make sure there is enough space, if not, try a realloc */
+ /* If the realloc fails we're in deep trouble */
+ if (rslMPLHandleLUT.nUsed == rslMPLHandleLUT.nHandles)
+   {
+   struct tagsToHandles *tags;  /* Temp pointer */
+   tags = (struct tagsToHandles *) 
+      realloc (rslMPLHandleLUT.tags, 
+      sizeof (struct tagsToHandles) * (rslMPLHandleLUT.nHandles + RSLHandleInc));
+   if (tags != NULL)
+     {
+     rslMPLHandleLUT.tags = tags;
+     rslMPLHandleLUT.nHandles += RSLHandleInc;
+     }
+   else
+     {
+#ifdef FATAL_ERRORS
+     fprintf (stderr, "Fatal Error: realloc failure in rslMPLSaveWaitH\n");
+     exit(1);
+#endif
+     return;
+     }
+   }
+ /* Stash the handle */
+ rslMPLHandleLUT.tags[rslMPLHandleLUT.nUsed].tag = tag;
+ rslMPLHandleLUT.tags[rslMPLHandleLUT.nUsed].Handle = *waitHandle;
+ rslMPLHandleLUT.tags[rslMPLHandleLUT.nUsed].type = type ;
+ rslMPLHandleLUT.tags[rslMPLHandleLUT.nUsed].nbytes = nbytes ;
+ rslMPLHandleLUT.nUsed++;
+}
+
+/******************************************************
+ * rslMPLISend (buff, mlen, tag, dest)
+ *  Post a non blocking send an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslMPLISend (buff, mlen, tag, dest)
+ char *buff;
+ int mlen;
+ int tag;
+ int dest;
+ {
+   MPL_Request waitHandle;
+   int rc ;
+ 
+   if ( tag < type_low || tag > type_high )
+   {
+sprintf(mess,"RSL_SENDBEGIN message type %d out of allowed range: %d..%d\n",
+tag,type_low,type_high) ;
+RSL_TEST_ERR( 1, mess ) ;
+   }
+
+   rc = mpc_send  (buff,
+              mlen,
+              dest,
+              tag,
+              &waitHandle); 
+
+#if 0
+fprintf(stderr,"mpc_send: nlen %10d  type %10d  dest %10d  handle %08x\n",
+mlen, tag, dest, waitHandle ) ;
+#endif
+
+   if ( rc )
+   {
+     sprintf(mess,"mpc_send returns %d", rc ) ;
+     RSL_TEST_ERR( 1, mess ) ;
+   }
+
+   rslMPLSaveWaitH (tag, &waitHandle,1,mlen);
+ }
+ 
+/******************************************************
+ * rslMPLIRecv (buff, mlen, tag)
+ *  Post a non blocking receive an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslMPLIRecv (buff, mlen, tag)
+ char *buff;
+ int mlen;
+ int tag;
+ {
+   MPL_Request waitHandle;
+   int source ;
+   int tagloc ;
+   int rc ;
+
+   source = dontcare ;
+   tagloc = tag ;
+
+   if ( tag < type_low || tag > type_high )
+   {
+sprintf(mess,"RSL_RECVBEGIN message type %d out of allowed range: %d..%d\n",
+tag,type_low,type_high) ;
+RSL_TEST_ERR( 1, mess ) ;
+   }
+
+
+   rc = mpc_recv  (buff,
+              mlen,
+              &source,
+              &tagloc,
+              &waitHandle);
+
+   if ( rc )
+   {
+     sprintf(mess,"mpc_recv returns %d", rc ) ;
+     RSL_TEST_ERR( 1, mess ) ;
+   }
+
+/* fprintf(stderr,"rslMPLIRecv tag = %d, handle = %d\n",tag,waitHandle) ; */
+
+   rslMPLSaveWaitH (tag, &waitHandle, 2, mlen);
+ }
+
+/******************************************************
+ * rslMPLWait (tag)
+ *  Wait for a pending send/recv
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+
+extern int mperrno ;
+ 
+void rslMPLWait (tag)
+ int tag;
+{
+  MPL_Request waitHandle;
+  MPL_Status status ;
+  int rc ;
+  int type, nbytes;
+
+  if ( rslMPLFindWaitH (tag, &waitHandle, &type, &nbytes ) != 0 )
+  {
+    fprintf(stderr,"rslMPLWait: tag %d not found by rslMPLFindWaitH\n",tag) ;
+    exit(2) ;
+  }
+
+#if 0
+  fprintf(stderr,"calling mpc_wait: tag %d, handle %08x, type %d (%s), original nbytes %d\n",
+        tag, waitHandle, type, (type==1)?"send":((type==2)?"recv":"unknown"),
+	nbytes) ;
+#endif
+
+  rc = mpc_wait ( &waitHandle, &status  );
+  if ( rc )
+  {
+    fprintf(stderr,"mpc_wait fails: tag %d, handle %08x, type %d (%s), original nbytes %d, status %d, rc %d, mperrno = %d\n",
+        tag, waitHandle, type, (type==1)?"send":((type==2)?"recv":"unknown"),
+	nbytes, status, rc, mperrno) ;
+    exit(2) ;
+  }
+
+#if 0
+  fprintf(stderr,"mpc_wait : tag %d, handle %08x, status %d\n",
+        tag, waitHandle, status) ;
+#endif
+
+}
+
+
+MPL_Request d1, d2, d3, waitHandle, d4, d5, d6 ;
+
+rslMPLProbe( tag, retval )
+  int tag, *retval ;
+{ 
+  MPL_Status status ;
+  int rc ;
+  int type, nbytes ;
+
+  if ( rslMPLPeekWaitH (tag, &waitHandle, &type, &nbytes ) != 0 )
+  {
+    fprintf(stderr,"rslMPLWait: tag %d not found by rslMPLPeekWaitH\n",tag) ;
+    exit(2) ;
+  }
+  rc = mpc_status( waitHandle ) ;
+
+  if ( rc >= 0 )
+  {
+    *retval = 1 ;
+  }
+  else if ( rc == -1 )
+  {
+    *retval = 0 ;
+  }
+  else
+  {
+    sprintf(mess,"No outstanding message for tag %d (handle %d) rc=%d\n",tag,waitHandle,rc) ;
+    RSL_TEST_ERR(1,mess) ;
+  }
+  return ;
+}
+
+#endif /* __MPL_COMPAT__ */
+#endif /* MPL */
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_new_decom.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_new_decom.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_new_decom.c	(revision 2744)
@@ -0,0 +1,789 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* routine and local data used by rsl_new_decomposition */
+static int count_neighbors_count ;
+static rsl_processor_t count_neighbors_myproc ;
+count_neighbors( d, m, n, hm, hn, pt, ipt )
+  rsl_index_t d ;
+  rsl_index_t m, n ;        /* this point */
+  rsl_index_t hm, hn ;      /* home point (whose stencil I'm on)  */
+  rsl_index_t pt ;              /* point in stencil */
+  rsl_index_t ipt ;             /* inverse point in stencil */
+{
+  int mlen ;
+  rsl_point_t *domain ;
+  rsl_domain_info_t *dinfo ;
+
+  dinfo = &(domain_info[d]) ;
+  domain = dinfo->domain ;
+  mlen = dinfo->len_m ;
+
+  if ( (domain[INDEX_2(n,m,mlen)].info_1 == 0)
+        && (domain[INDEX_2(n,m,mlen)].P != RSL_INVALID) /* 970216 */
+        && (domain[INDEX_2(n,m,mlen)].P != count_neighbors_myproc ) )
+  {
+    domain[INDEX_2(n,m,mlen)].info_1 = 1 ;    /* mark as counted */
+    count_neighbors_count++ ;           /* increment counter */
+  }
+}
+
+
+/* note that this has been changed to an internal routine that
+   is callable for a single domain at a time */
+int
+rsl_new_decomposition( d_p, mloc_p, nloc_p )
+  int_p d_p, 
+        mloc_p, nloc_p ; /* output: minimum sizes to hold local partition */
+{
+  int (*pt)(), (*f)() ;
+  int d, m, n ;
+  int mlen, nlen, zlen, meff, neff ;
+  int P ;
+  int i, j, k, size ;
+  int firsti, firstj, firstk ;
+  int mtype, mdest, retval ;
+  int maskid ;
+  int no_points ;
+  rsl_list_t *lp, *tlp[RSL_MAXDOMAINS] ;
+  rsl_domain_info_t *dinfo ;
+  rsl_point_t *domain ;
+
+  /* added 3/23/95 */
+  int nrun, eff_n, dex ;
+  rsl_list_t *rp ;
+
+  extern rsl_4pt(), rsl_8pt(), rsl_12pt(), rsl_24pt(), rsl_48pt(),
+         rsl_80pt(), rsl_120pt(), rsl_168pt(), count_neighbors() ;
+#if ( ALLOW_RSL_168PT == 1 )
+  extern rsl_168pt() ;
+#endif
+
+  P = rsl_c_phys2comp_proc(rsl_myproc) ;
+  d = *d_p ;
+
+  dinfo = &(domain_info[d]) ;
+
+/* 20010228 */
+
+/* work out the i, j, and k offsets for the transpose arrays */
+/* MZ */
+  domain = dinfo->domain_mz ;
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+  zlen = dinfo->len_z ;
+  firsti = RSL_INVALID ;
+  firstk = RSL_INVALID ;
+  for ( k = 0 ; k < zlen ; k++ )
+  {
+    for ( i = 0 ; i < mlen ; i++ )
+    {
+      if ( rsl_c_comp2phys_proc ( domain[INDEX_2(k,i,mlen)].P ) == rsl_myproc )
+      {
+	if ( firsti == RSL_INVALID ) firsti = i ;
+	if ( firstk == RSL_INVALID ) firstk = k ;
+      }
+    }
+  }
+  dinfo->ilocaloffset_mz = firsti - rsl_padarea ;
+  dinfo->klocaloffset_mz = firstk ;
+  dinfo->jlocaloffset_mz = -rsl_padarea ;
+
+/* NZ */
+  domain = dinfo->domain_nz ;
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+  zlen = dinfo->len_z ;
+  firstj = RSL_INVALID ;
+  firstk = RSL_INVALID ;
+  for ( k = 0 ; k < zlen ; k++ )
+  {
+    for ( j = 0 ; j < nlen ; j++ )
+    {
+      if ( rsl_c_comp2phys_proc ( domain[INDEX_2(k,j,nlen)].P ) == rsl_myproc )
+      {
+	if ( firstj == RSL_INVALID ) firstj = j ;
+	if ( firstk == RSL_INVALID ) firstk = k ;
+      }
+    }
+  }
+  dinfo->jlocaloffset_nz = firstj - rsl_padarea ;
+  dinfo->klocaloffset_nz = firstk ;
+  dinfo->ilocaloffset_nz = -rsl_padarea ;
+
+/* end 20010228 */
+
+  domain = dinfo->domain ;
+  mlen = dinfo->len_m ;
+  nlen = dinfo->len_n ;
+
+  for ( n = 0 ; n < nlen ; n++ )
+    for ( m = 0 ; m < mlen ; m++ )
+    {
+      domain[INDEX_2(n,m,mlen)].info_1 = 0 ;    /* mark all untouched */
+    }
+
+  maskid = dinfo->maskid ;
+  switch( maskid )
+  {
+
+  case RSL_4PT   : pt = rsl_4pt  ; break ;
+  case RSL_8PT   : pt = rsl_8pt  ; break ;
+  case RSL_12PT  : pt = rsl_12pt ; break ;
+  case RSL_24PT  : pt = rsl_24pt ; break ;
+  case RSL_48PT  : pt = rsl_48pt ; break ;
+  case RSL_80PT  : pt = rsl_80pt ; break ;
+  case RSL_120PT  : pt = rsl_120pt ; break ;
+#if ( ALLOW_RSL_168PT == 1 )
+  case RSL_168PT  : pt = rsl_168pt ; break ;
+#endif
+  default: 
+     RSL_TEST_ERR(1,"rsl_new_decomposition(): bad mask spec") ; break ;
+
+  }
+  mlen = domain_info[d].len_m ;  /* actual dimensions */
+  nlen = domain_info[d].len_n ;
+  meff = domain_info[d].eff_m ;  /* effective dimensions */
+  neff = domain_info[d].eff_n ;
+  firsti = RSL_INVALID ;
+  firstj = RSL_INVALID ;
+  for ( n = 0 ; n < nlen ; n++ )
+  {
+    for ( m = 0 ; m < mlen ; m++ )
+    {
+      if ( domain[INDEX_2(n,m,mlen)].P == P ) 
+      {
+        /* this is assigned to the processor I'm looking at (me).
+           count it and it's untouched off proc neighbors */
+        /* set firsti and firstj for the computation of 
+           ioffset and joffset, later.  Note, what we're really
+           doing is finding the minimum index in each dimension. */
+        if ( domain[INDEX_2(n,m,mlen)].info_1 == 0 )
+        {
+          if ( firsti == RSL_INVALID ) 
+          {
+            firsti = m ;
+          }
+          else
+          {
+            if ( m < firsti ) firsti = m ;
+          }
+          if ( firstj == RSL_INVALID ) 
+          {
+            firstj = n ;
+          }
+          else
+          {
+            if ( n < firstj ) firstj = n ;
+          }
+          domain[INDEX_2(n,m,mlen)].info_1 = 1 ;
+
+          count_neighbors_myproc = P ;
+          count_neighbors_count = 0 ;
+          /* pt is the stencil function set above in this routine,
+             count_neighbors is defined in this file */
+          (*pt)( d, m, mlen, n, nlen, count_neighbors ) ;
+        }
+      }
+    }
+  }
+
+  /* work out the sizes of the local memory requirements for the domain */
+  /* for now, this information is just passed back to the caller; at some
+     point we could optionally allocate the domains, here or elsewhere
+     in RSL */
+
+  no_points=0;
+  if ( firsti == RSL_INVALID || firstj == RSL_INVALID )
+  {
+    no_points=1 ;
+    /* it so happens that this processor doesn't have any points */
+    *mloc_p = 0 ;
+    *nloc_p = 0 ;
+#if 0
+/* removed this return so that the js (and so forth) fields in the domain_info
+   structure get memory allocated  -- 981227 JM */
+    return ;                    /* RETURN */
+#endif
+  }
+  else
+  {
+    int mlow, nlow, mhigh, nhigh ;
+    mlow =   99999999 ;
+    nlow =   99999999 ;
+    mhigh = -99999999 ;
+    nhigh = -99999999 ;
+
+    for ( n = 0 ; n < nlen ; n++ )
+    {
+      for ( m = 0 ; m < mlen ; m++ )
+      {
+        if ( domain[INDEX_2(n,m,mlen)].P == P )
+        {
+          if ( m < mlow  ) mlow  = m ;
+          if ( m > mhigh ) mhigh = m ;
+          if ( n < nlow  ) nlow  = n ;
+          if ( n > nhigh ) nhigh = n ;
+        }
+      }
+    }
+#ifndef vpp
+    *mloc_p = mhigh - mlow + 1 + 2 * rsl_padarea ;
+#else
+    *mloc_p = mhigh - mlow + 1 ;
+#endif
+    *nloc_p = nhigh - nlow + 1 + 2 * rsl_padarea ;
+    dinfo->loc_m = *mloc_p ;
+    dinfo->loc_n = *nloc_p ;
+  }
+
+
+#ifndef vpp
+  dinfo->ilocaloffset = firsti-rsl_padarea ;
+#else
+  dinfo->ilocaloffset = firsti ;
+#endif
+
+  if ( old_offsets == 0 )
+  {
+    dinfo->jlocaloffset = firstj-rsl_padarea ;
+  }
+  else
+  {
+    if ( dinfo->nest_level == 0 )
+    {
+      dinfo->jlocaloffset = firstj-rsl_padarea ;
+    }
+    else
+    {
+      int prevsize, i, pid /*parent id*/, did /*domain id*/;
+      prevsize = 0 ;
+      did = d ;
+      for ( i = 0 ; i < dinfo->nest_level ; i++ )
+      {
+        pid = domain_info[did].parent ;
+        /*
+        prevsize +=  2*rsl_padarea + domain_info[pid].loc_n ;
+        */
+        prevsize +=  domain_info[pid].loc_n ;
+        did = pid ;
+      }
+      RSL_TEST_ERR( (did != 0) , "internal error" ) ;
+      dinfo->jlocaloffset = firstj - rsl_padarea - prevsize ;
+    }
+  }
+
+/* went back to use of actual dimensions -- will test for effective
+   dimensions using whether the point was trimmed */
+  for ( n = 0 ; n < nlen ; n++ )
+  {
+    for ( m = 0 ; m < mlen ; m++ )
+    {
+      if ( domain[INDEX_2(n,m,mlen)].trimmed == 0 )
+      {
+        if ( rsl_c_comp2phys_proc (domain[INDEX_2(n,m,mlen)].P) == rsl_myproc )
+        {
+          /* a local point -- add to list of local points */
+          lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+          lp->data = &(domain[INDEX_2(n,m,mlen)]) ;
+          lp->next = NULL ;
+          /* add to end of list of local points */
+          if ( domain_info[d].pts == NULL )
+          {
+             domain_info[d].pts = lp ;
+             tlp[d] = lp ;
+          }
+          else
+          {
+             tlp[d]->next = lp ;
+             tlp[d] = lp ;
+          }
+        }
+        /* this test is necessary to avoid counting everyone in the
+           domain -- we only want those who have been marked as neighbors
+           by the count_neighbors function */
+        else if ( domain[INDEX_2(n,m,mlen)].info_1 == 1 )
+        {
+          lp = RSL_MALLOC( rsl_list_t, 1 ) ;
+          lp->data = &(domain[INDEX_2(n,m,mlen)]) ;
+          lp->next = domain_info[d].ghost_pts ;
+          domain_info[d].ghost_pts = lp ;
+        }
+      }
+    }
+  }
+
+  /* 1/9/95.  compute runs through partition for rsl_compute_islab */
+
+  {
+    int retval, i, j, ig, jg, prev_ig, prev_jg ;
+    int start_i, start_j, start_ig, start_jg, runlength ;
+    rsl_list_t *rp, *trp[RSL_MAXDOMAINS] ;
+    rsl_runrec_t *rr ;
+
+
+    RSL_INIT_NEXTCELL ( &d ) ;
+    RSL_C_NEXTCELL ( &d, &i, &j, &ig, &jg, &retval ) ;
+    i-- ; j-- ; ig-- ; jg-- ;         /* base 0 for C */
+    start_i = i ;
+    start_j = j ;
+    start_ig = ig ;
+    start_jg = jg ;
+    runlength = 1 ;
+    prev_ig = ig-1 ;
+    prev_jg = jg ;
+    while ( retval != 0 )
+    {
+      if ( ! ( ig == prev_ig+1 && jg == prev_jg ) )
+      {
+        rr = RSL_MALLOC( rsl_runrec_t, 1 ) ;
+        rr->i  = start_i ;
+        rr->j  = start_j ;
+        rr->ig = start_ig ;
+        rr->jg = start_jg ;
+        rr->runlength = runlength-1 ;
+        rp = RSL_MALLOC( rsl_list_t, 1 ) ;
+        rp->data = rr ;
+        rp->next = NULL ;
+        /* add to list of local points */
+        if ( domain_info[d].iruns == NULL )
+        {
+           domain_info[d].iruns = rp ;
+           trp[d] = rp ;
+        }
+        else
+        {
+           trp[d]->next = rp ;
+           trp[d] = rp ;
+        }
+        runlength = 1 ;
+        start_i = i ;
+        start_j = j ;
+        start_ig = ig ;
+        start_jg = jg ;
+      }
+      prev_ig = ig ;
+      prev_jg = jg ;
+      RSL_C_NEXTCELL ( &d, &i, &j, &ig, &jg, &retval ) ;
+      if ( retval == 1 ) runlength++ ;
+      i-- ; j-- ; ig-- ; jg-- ;       /* base 0 for C */
+    }
+    /* handle last one */
+    if ( runlength != 0 )
+    {
+        rr = RSL_MALLOC( rsl_runrec_t, 1 ) ;
+        rr->i  = start_i ;
+        rr->j  = start_j ;
+        rr->ig = start_ig ;
+        rr->jg = start_jg ;
+        rr->runlength = runlength ;
+        rp = RSL_MALLOC( rsl_list_t, 1 ) ;
+        rp->data = rr ;
+        rp->next = NULL ;
+        /* add to list of local points */
+        if ( domain_info[d].iruns == NULL )
+        {
+           domain_info[d].iruns = rp ;
+           trp[d] = rp ;
+        }
+        else
+        {
+           trp[d]->next = rp ;
+           trp[d] = rp ;
+        }
+    }
+  }
+
+  /* 3/22/95.  compute 2d runs through partition for rsl_compute */
+  { 
+    int p ;
+    int i, j, ig, jg, prev_ig, prev_jg ;
+    int start_i, start_j, start_ig, start_jg, runlength ;
+    int nrun ;
+    int m, mlen ;
+    int n, nlen ;
+    int ilocaloffset, jlocaloffset ;
+    int first ;
+    int square ;
+
+    for ( p =  0 ; p <= MAX_KINDPAD ; p++ )
+    {
+      mlen = domain_info[d].len_m ;
+      nlen = domain_info[d].len_n ;
+      for ( n = 0 ; n < nlen ; n++ )
+        for ( m = 0 ; m < mlen ; m++ )
+        {
+          domain[INDEX_2(n,m,mlen)].info_1 = 0 ;    /* mark all untouched */
+        }
+
+      if ( p > 0 )
+      {
+        for ( n = 0 ; n < nlen ; n++ )
+        {
+          for ( m = 0 ; m < mlen ; m++ )
+          {
+            if ( domain[INDEX_2(n,m,mlen)].P == P ) 
+            {
+              /* this is assigned to the processor I'm looking at (me).
+                 count it and it's untouched off proc neighbors */
+                count_neighbors_myproc = P ;
+                count_neighbors_count = 0 ;
+              /* pt is the stencil function set above in this routine,
+                 count_neighbors is defined in this file */
+              switch ( p )
+              {
+              case 1 :
+                rsl_8pt( d, m, mlen, n, nlen, count_neighbors ) ;   
+                break ;
+              case 2 :
+#ifdef INLINE_COUNTS
+                square = 2 ;
+                /* note fall through */
+#else
+                rsl_24pt( d, m, mlen, n, nlen, count_neighbors ) ;  
+                break ;
+#endif
+	      case 3 :
+#ifdef INLINE_COUNTS
+                if ( sw_allow_dynpad )
+                {
+                  square = 3 ;
+                  /* note fall through */
+                }
+                else
+                {
+                  rsl_2ptm( d, m, mlen, n, nlen, count_neighbors ) ; /* 1 extra ns */
+                  break ;
+                }
+#else
+		if ( sw_allow_dynpad )
+		{
+                  rsl_48pt( d, m, mlen, n, nlen, count_neighbors ) ;
+		}
+		else
+		{
+                  rsl_2ptm( d, m, mlen, n, nlen, count_neighbors ) ; /* 1 extra ns */
+		}
+                break ;
+#endif
+	      case 4 :
+#ifdef INLINE_COUNTS
+		if ( sw_allow_dynpad )
+		{
+                  square = 4 ;
+                  /* note fall through */
+		}
+		else
+		{
+                  rsl_4ptm( d, m, mlen, n, nlen, count_neighbors ) ; /* 2 extra ns */
+                  break ;
+		}
+#else
+		if ( sw_allow_dynpad )
+		{
+                  rsl_80pt( d, m, mlen, n, nlen, count_neighbors ) ;
+		}
+		else
+		{
+                  rsl_4ptm( d, m, mlen, n, nlen, count_neighbors ) ; /* 2 extra ns */
+		}
+                break ;
+#endif
+	      case 5 :
+#ifdef INLINE_COUNTS
+                /* note fall through */
+                square = 5 ;
+#else
+                rsl_120pt( d, m, mlen, n, nlen, count_neighbors ) ;
+                break ;
+#endif
+	      case 6 :
+#ifdef INLINE_COUNTS
+                square = 6 ;
+{
+/* this code comes from pt.c, rsl_168pt */
+  rsl_index_t min = m ;
+  rsl_dimlen_t minlen = mlen ;
+  rsl_index_t maj = n ;
+  rsl_dimlen_t majlen = nlen ;
+
+  rsl_index_t i, j ;
+
+  for ( i = -square ; i <= square ; i++ )
+  {
+    for ( j = -square ; j <= square ; j++ )
+    {
+      if ( min+i >= 0 && min+i < minlen &&
+             maj+j >= 0 && maj+j < majlen )
+      {
+
+# ifdef INLINE_COUNTS
+/* this code is count_neighbors, above, in this file */
+{
+  rsl_index_t m=min+i, n=maj+j ;        /* this point */
+  rsl_index_t hm=min, hn=maj ;      /* home point (whose stencil I'm on)  */
+
+  if ( (domain[INDEX_2(n,m,mlen)].info_1 == 0)
+        && (domain[INDEX_2(n,m,mlen)].P != RSL_INVALID) /* 970216 */
+        && (domain[INDEX_2(n,m,mlen)].P != count_neighbors_myproc ) )
+  {
+    domain[INDEX_2(n,m,mlen)].info_1 = 1 ;    /* mark as counted */
+    count_neighbors_count++ ;           /* increment counter */
+  }
+}
+# else
+        (*f)(d,min+i,maj+j,min,maj,pts168[k],ipts168[k]) ;
+# endif
+      }
+    }
+  }
+}
+
+#else
+                rsl_168pt( d, m, mlen, n, nlen, count_neighbors ) ; 
+#endif
+                break ;
+	      /* special cases */
+              case 7 :
+                rsl_2ptm( d, m, mlen, n, nlen, count_neighbors ) ; /* 1 extra ns */
+                break ;
+              case 8 :
+                rsl_4ptm( d, m, mlen, n, nlen, count_neighbors ) ; /* 2 extra ns */
+                break ;
+              default :
+                sprintf(mess,"internal error p=%d\n",p) ;
+                RSL_TEST_ERR(1,mess) ; 
+              }
+            }
+          }
+        }
+      }
+      /* at this point all the cells in my partition are marked */
+
+      /* set up j-major iteration */
+      if ( domain_info[d].js[p] != NULL ) RSL_FREE( domain_info[d].js[p] ) ;
+      if ( domain_info[d].is[p] != NULL ) RSL_FREE( domain_info[d].is[p] ) ;
+      if ( domain_info[d].ie[p] != NULL ) RSL_FREE( domain_info[d].ie[p] ) ;
+      if ( domain_info[d].jg2n[p] != NULL ) RSL_FREE( domain_info[d].jg2n[p] ) ;
+      domain_info[d].js[p] = RSL_MALLOC(int,2*nlen+10) ;
+      domain_info[d].is[p] = RSL_MALLOC(int,2*nlen+10) ;
+      domain_info[d].ie[p] = RSL_MALLOC(int,2*nlen+10) ;
+      domain_info[d].jg2n[p] = RSL_MALLOC(int,2*nlen+10) ;
+      ilocaloffset = domain_info[d].ilocaloffset ;
+      jlocaloffset = domain_info[d].jlocaloffset ;
+      for ( nrun = 0 ; nrun < 2*nlen+10 ; nrun++ )
+      {
+	domain_info[d].is[p][nrun] = 999999 ;
+	domain_info[d].ie[p][nrun] = -999999 ;
+      }
+      nrun = 0 ;
+      if ( ! no_points )
+      {
+      first = 1 ;
+      for ( n = 0 ; n < nlen ; n++ )
+      {
+        for ( m = 0 ; m < mlen ; m++ )
+        {
+          if ( domain[INDEX_2(n,m,mlen)].trimmed == 0 )
+          {
+            if (domain[INDEX_2(n,m,mlen)].P == P
+              || ( domain[INDEX_2(n,m,mlen)].info_1 == 1 ))
+            {
+              ig = ID_IDEX(domain[INDEX_2(n,m,mlen)].id) ;
+              jg = ID_JDEX(domain[INDEX_2(n,m,mlen)].id) ;
+              i = ig - ilocaloffset ;
+              j = jg - jlocaloffset ;
+              if ( first )
+              {
+                first = 0 ;
+                start_i = i ;
+                start_j = j ;
+                start_ig = ig ;
+                start_jg = jg ;
+                runlength = 1 ;
+                prev_ig = ig-1 ;
+                prev_jg = jg ;
+                domain_info[d].idif = i - ig ;
+                domain_info[d].jdif = j - jg ;
+              }
+              else
+              {
+                runlength++ ;
+              }
+              if ( ! ( ig == prev_ig+1 && jg == prev_jg ) )
+              {
+                domain_info[d].js[p][nrun] = start_j + 1 ;
+                domain_info[d].is[p][nrun] = start_i + 1 ;
+                domain_info[d].ie[p][nrun] = start_i + runlength-1 ;
+		domain_info[d].jg2n[p][jg] = nrun + 1  ;
+                runlength = 1 ;
+                start_i = i ;
+                start_j = j ;
+                start_ig = ig ;
+                start_jg = jg ;
+                nrun++ ;
+              }
+              prev_ig = ig ;
+              prev_jg = jg ;
+            }
+          }
+        }
+      }
+      /* handle last one -- note assumption on setting of jg for
+	 the index into jg2n field */
+      if ( runlength != 0 )
+      {
+        domain_info[d].js[p][nrun] = start_j + 1 ;
+        domain_info[d].is[p][nrun] = start_i + 1 ;
+        domain_info[d].ie[p][nrun] = start_i + runlength ;
+	domain_info[d].jg2n[p][jg] = nrun + 1  ;
+        nrun++ ; 
+      }
+      }
+      domain_info[d].nrun[p] = nrun ;
+
+      /* set up i-major iteration */
+      if ( domain_info[d].is2[p] != NULL ) RSL_FREE( domain_info[d].is2[p] ) ;
+      if ( domain_info[d].js2[p] != NULL ) RSL_FREE( domain_info[d].js2[p] ) ;
+      if ( domain_info[d].je2[p] != NULL ) RSL_FREE( domain_info[d].je2[p] ) ;
+      if ( domain_info[d].ig2n[p] != NULL ) RSL_FREE( domain_info[d].ig2n[p] ) ;
+      domain_info[d].is2[p] = RSL_MALLOC(int,2*nlen+10) ;
+      domain_info[d].js2[p] = RSL_MALLOC(int,2*nlen+10) ;
+      domain_info[d].je2[p] = RSL_MALLOC(int,2*nlen+10) ;
+      domain_info[d].ig2n[p] = RSL_MALLOC(int,2*nlen+10) ;
+      ilocaloffset = domain_info[d].ilocaloffset ;
+      jlocaloffset = domain_info[d].jlocaloffset ;
+      for ( nrun = 0 ; nrun < 2*nlen+10 ; nrun++ )
+      {
+	domain_info[d].js2[p][nrun] = 999999 ;
+	domain_info[d].je2[p][nrun] = -999999 ;
+      }
+      nrun = 0 ;
+      if ( ! no_points )
+      {
+      first = 1 ;
+      for ( m = 0 ; m < mlen ; m++ )
+      {
+        for ( n = 0 ; n < nlen ; n++ )
+        {
+          if ( domain[INDEX_2(n,m,mlen)].trimmed == 0 )
+          {
+            if (domain[INDEX_2(n,m,mlen)].P == P
+              || ( domain[INDEX_2(n,m,mlen)].info_1 == 1 ))
+            {
+              ig = ID_IDEX(domain[INDEX_2(n,m,mlen)].id) ;
+              jg = ID_JDEX(domain[INDEX_2(n,m,mlen)].id) ;
+              i = ig - ilocaloffset ;
+              j = jg - jlocaloffset ;
+              if ( first )
+              {
+                first = 0 ;
+                start_i = i ;
+                start_j = j ;
+                start_ig = ig ;
+                start_jg = jg ;
+                runlength = 1 ;
+                prev_jg = jg-1 ;
+                prev_ig = ig ;
+              }
+              else
+              {
+                runlength++ ;
+              }
+              if ( ! ( jg == prev_jg+1 && ig == prev_ig ) )
+              {
+                domain_info[d].is2[p][nrun] = start_i + 1 ;
+                domain_info[d].js2[p][nrun] = start_j + 1 ;
+                domain_info[d].je2[p][nrun] = start_j + runlength-1 ;
+		domain_info[d].ig2n[p][jg] = nrun + 1  ;
+                runlength = 1 ;
+                start_i = i ;
+                start_j = j ;
+                start_ig = ig ;
+                start_jg = jg ;
+                nrun++ ;
+              }
+              prev_ig = ig ;
+              prev_jg = jg ;
+            }
+          }
+        }
+      }
+      /* handle last one -- note assumption on setting of jg for
+	 the index into jg2n field */
+      if ( runlength != 0 )
+      {
+        domain_info[d].is2[p][nrun] = start_i + 1 ;
+        domain_info[d].js2[p][nrun] = start_j + 1 ;
+        domain_info[d].je2[p][nrun] = start_j + runlength ;
+	domain_info[d].ig2n[p][jg] = nrun + 1  ;
+        nrun++ ; 
+      }
+      }
+      domain_info[d].nruni[p] = nrun ;
+    }
+  }
+  return(0) ;
+}
+
+RSL_ALLOW_DYNPAD ()
+{
+  sw_allow_dynpad = 1 ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_nl.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_nl.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_nl.c	(revision 2744)
@@ -0,0 +1,71 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* return nesting level  for domain */
+RSL_NL ( domain_p, nl_p )
+  int_p  domain_p, nl_p ;
+{
+  int d ;
+
+  d = *domain_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS, "rsl_nl: invalid domain index") ;
+  *nl_p = domain_info[ d ].nest_level ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_nx_compat.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_nx_compat.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_nx_compat.c	(revision 2744)
@@ -0,0 +1,300 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#ifdef PGON
+#ifndef __PGON_COMPAT__
+#define __PGON_COMPAT__
+#include <stdio.h>
+#include <nx.h>
+
+#define RSLHandleInc 32
+
+extern int errno ;
+
+struct tagsToHandles
+       {
+       int tag;
+       long nxHandle;
+       };
+struct rslNXHandles
+       {
+       int nHandles;
+       int nUsed;
+       struct tagsToHandles *tags;
+       } rslNXHandleLUT;
+
+/******************************************************
+ * rslNXInit ()
+ *   do whatever initialization is necessary for the
+ *   NX port
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+void rslNXInit()
+  {
+  rslNXHandleLUT.nHandles = RSLHandleInc;
+  rslNXHandleLUT.nUsed = 0;
+  rslNXHandleLUT.tags = (struct tagsToHandles *) 
+                     malloc (sizeof (struct tagsToHandles) * RSLHandleInc);
+#ifdef FATAL_ERRORS
+  if (rslNXHandleLUT.tags == NULL)
+    {
+    fprintf (stderr, "Fatal Error: malloc failure in rslNXInit\n");
+    exit(1);
+    }
+#endif
+  }
+
+/******************************************************
+ * rslNXFindWaitH (tag)
+ *  Use the LUT to find an NX wait handle from a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+
+long rslNXFindWaitH (tag)
+  int tag;   /* Tag for which we lookup a wait handle */
+  {
+  int i;
+  long retVal = -1;
+
+  for (i=0; i < rslNXHandleLUT.nUsed; i++)
+    {
+    if (rslNXHandleLUT.tags[i].tag == tag)
+      {
+      retVal = rslNXHandleLUT.tags[i].nxHandle;
+      rslNXHandleLUT.nUsed--;  /* Keep them contiguous */
+      rslNXHandleLUT.tags[i].tag=rslNXHandleLUT.tags[rslNXHandleLUT.nUsed].tag;
+      rslNXHandleLUT.tags[i].nxHandle=
+                  rslNXHandleLUT.tags[rslNXHandleLUT.nUsed].nxHandle;
+      break;
+      }
+    }
+  return retVal;
+  }
+
+/******************************************************
+ * rslNXPeekWaitH (tag)
+ *  Use the LUT to find an NX wait handle from a tag
+ *
+ * same as above but does not remove from list.  JM. 9/27/94
+ *
+ *****************************************************/
+
+long rslNXPeekWaitH (tag)
+  int tag;   /* Tag for which we lookup a wait handle */
+  {
+  int i;
+  long retVal = -1;
+
+  for (i=0; i < rslNXHandleLUT.nUsed; i++)
+    {
+    if (rslNXHandleLUT.tags[i].tag == tag)
+      {
+      retVal = rslNXHandleLUT.tags[i].nxHandle;
+      break;
+      }
+    }
+  return retVal;
+  }
+
+
+
+/******************************************************
+ * rslNXSaveWaitH (tag, waitHandle)
+ *  Use the LUT to save an NX wait handle referenced by a tag
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslNXSaveWaitH (tag, waitHandle)
+ int tag;
+ long waitHandle;
+ {
+ /* Make sure there is enough space, if not, try a realloc */
+ /* If the realloc fails we're in deep trouble */
+ if (rslNXHandleLUT.nUsed == rslNXHandleLUT.nHandles)
+   {
+   struct tagsToHandles *tags;  /* Temp pointer */
+   tags = (struct tagsToHandles *) 
+      realloc (rslNXHandleLUT.tags, 
+      sizeof (struct tagsToHandles) * (rslNXHandleLUT.nHandles + RSLHandleInc));
+   if (tags != NULL)
+     {
+     rslNXHandleLUT.tags = tags;
+     rslNXHandleLUT.nHandles += RSLHandleInc;
+     }
+   else
+     {
+#ifdef FATAL_ERRORS
+     fprintf (stderr, "Fatal Error: realloc failure in rslNXSaveWaitH\n");
+     exit(1);
+#endif
+     return;
+     }
+   }
+ /* Stash the handle */
+ rslNXHandleLUT.tags[rslNXHandleLUT.nUsed].tag = tag;
+ rslNXHandleLUT.tags[rslNXHandleLUT.nUsed].nxHandle = waitHandle;
+ rslNXHandleLUT.nUsed++;
+ }
+
+/******************************************************
+ * rslNXISend (buff, mlen, tag, dest)
+ *  Post a non blocking send an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslNXISend (buff, mlen, tag, dest)
+ char *buff;
+ int mlen;
+ int tag;
+ int dest;
+ {
+ long waitHandle;
+ 
+ waitHandle = isend ((long) tag, buff, (long) mlen, (long) dest, (long) 0);
+ rslNXSaveWaitH (tag, waitHandle);
+ }
+ 
+/******************************************************
+ * rslNXIRecv (buff, mlen, tag)
+ *  Post a non blocking receive an stash a wait handle
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslNXIRecv (buff, mlen, tag)
+ char *buff;
+ int mlen;
+ int tag;
+ {
+ long waitHandle;
+
+ waitHandle = irecv ((long) tag, buff, (long) mlen);
+ rslNXSaveWaitH (tag, waitHandle);
+ }
+
+/******************************************************
+ * rslNXWait (tag)
+ *  Wait for a pending send/recv
+ *
+ *  Initial coding: Leslie Hart, 22 Apr 94
+ *
+ *****************************************************/
+ 
+void rslNXWait (tag)
+ int tag;
+ {
+ long waitHandle;
+
+ waitHandle = rslNXFindWaitH (tag);
+ (void) msgwait (waitHandle);
+ }
+
+/******************************************************
+ * rslNXProbe (tag)
+ *  check for pending receive
+ *
+ * added 9/27/94  jm
+ *
+ *****************************************************/
+ 
+rslNXProbe( tag, retval )
+  int tag, *retval ;
+{
+  long waitHandle;
+  long status ;
+  int rc ;
+  int type, nbytes ;
+
+
+  waitHandle = rslNXPeekWaitH (tag) ;
+  rc = _msgdone( waitHandle ) ;
+
+  if ( rc == 1 )
+  {
+/* message received... now make call that will remove tag from LUT.
+(on other systems, there would be a message wait later after this
+call that would do this, but on the Paragon there won't be.  Presently,
+RSL_PROBE is only called in exch_sten.c, and there is special paragon
+code there to ensure this.)  940927.  JM */
+    waitHandle = rslNXFindWaitH (tag) ;
+    *retval = 1 ;
+  }
+  else if ( rc == 0 )
+  {
+    *retval = 0 ;
+  }
+  else
+  {
+    fprintf(stderr,"Error in _msgdone(%d) for tag=%d.  errno=%d.\n",
+		    waitHandle, tag, errno ) ;
+    *retval = 0 ;
+  }
+
+  return ;
+}
+
+
+#endif /* __PGON_COMPAT__ */
+#endif /* PGON */
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_order.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_order.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_order.c	(revision 2744)
@@ -0,0 +1,348 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+RSL_ORDER ( d_p, dir_p ) 
+  rsl_index_t *d_p  ; /* domain */
+  int_p       dir_p ; /* sort direction */
+{
+  int d, dir, up ;
+  int retval ;
+  rsl_list_t *lp ;
+
+  RSL_TEST_ERR( d_p == NULL, "rsl_order: null domain ptr" ) ;
+  d = *d_p ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+    "rsl_order: bad domain descriptor") ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+    "rsl_order: invalid domain") ;
+  RSL_TEST_WRN(1,"RSL_ORDER: obsolete") ;
+
+  if ( dir_p != NULL )
+    dir = *dir_p ;
+  else
+    dir = MINMAJ_AA ;
+
+  lp = domain_info[d].pts ;
+
+  if ( MNMJ( dir ))  /* MNMJ, D1, and D2 macros defined in rsl.h */
+  {
+    up = D1(dir)?-1:1 ;
+    bubble( lp, up ) ; /* sort by inner key */
+    up = D2(dir)?-2:2 ;
+    bubble( lp, up ) ; /* sort by outer key */
+  }
+  else
+  {
+    up = D1(dir)?-2:2 ;
+    bubble( lp, up ) ; /* sort by inner key */
+    up = D2(dir)?-1:1 ;
+    bubble( lp, up ) ; /* sort by outer key */
+  }
+}
+
+lenlist( a )
+  rsl_list_t *a ;
+{
+  rsl_list_t *p ;
+  int i ;
+  for ( p = a, i = 0 ; p != NULL ; p = p->next ) i++  ;
+  return (i) ;
+}
+
+showlist( l, s )
+  rsl_list_t * l ;
+  char * s  ;
+{
+  rsl_list_t * lp ;
+  rsl_point_t *p ;
+  int i, j ;
+
+  for ( lp = l ; lp != NULL ; lp = lp->next ) 
+  {
+    p = (rsl_point_t *) lp->data ;
+    i = ID_IDEX( p->id ) ;
+    j = ID_JDEX( p->id ) ;
+    fprintf(stderr,"%s > %d %d\n",s,i,j) ;
+  }
+}
+
+rsl_sort( list, compare, up )
+  rsl_list_t **list ;
+  int (*compare)() ;
+  int up ;
+{
+#if 0
+  fprintf(stderr,"rsl_sort: lenlist(*list) = %d  %x\n", lenlist(*list), *list ) ; 
+#endif
+  rsl_sort1( list, compare, up ) ;
+}
+
+rsl_sort1( list, compare, up )
+  rsl_list_t **list ;
+  int (*compare)() ;
+  int up ;
+{
+  int n, np, nq ;
+  rsl_list_t *p, *q, *qnext ;
+
+  p = *list ; q = NULL ;
+
+  /* count items and q at list midpoint */
+  for ( n = 0, nq = 0 ; p != NULL ; p = p->next )
+  {
+    if ( n % 2 == 1 ) {
+      if ( q == NULL ) { q = *list ; }
+      else             { q = q->next ; }
+      nq++ ;
+    }
+    n++ ;
+  }
+  if ( n <= 1 ) return ;
+  np = n - nq ;  /* nq is length of first half; np is length of second half */
+
+  qnext = q->next ;
+  q->next = NULL ;
+  /* first half */
+  if ( nq > 1 )
+  {
+    rsl_sort1( list, compare, up ) ;
+  }
+  /* second half */
+  if ( np > 1 )
+  {
+    rsl_sort1( &qnext, compare, up ) ;
+  }
+  if ( n > 0 )
+  {
+    rsl_quicksort_merge ( list, *list, qnext, compare, up, n ) ;
+  }
+}
+
+rsl_quicksort_merge( retlist, a , b, compare, up, n )
+  rsl_list_t **retlist, *a , *b  ;
+  int (*compare)() ;
+  int up ;
+  int n ;
+{
+  rsl_list_t *newlist, *t, *p, *q ;
+  int i ;
+
+  p = b ; q = a ;
+  if ( q != NULL && p != NULL )
+  {
+    if ( (*compare)(q->data,p->data,up) )
+    {
+      newlist = p ;
+      p = p->next ;
+    }
+    else
+    {
+      newlist = q ;
+      q = q->next ;
+    }
+  }
+  else if ( p != NULL )
+  {
+    newlist = p ; p = p->next ;
+  }
+  else if ( q != NULL )
+  {
+    newlist = q ; q = q->next ;
+  }
+
+  t = newlist ;
+  for ( i = 1 ; i < n ; i++ )
+  {
+    if ( q != NULL && p != NULL )
+    {
+      if( (*compare)(q->data,p->data,up) )
+      {
+        t->next = p ;
+        p = p->next ;
+      }
+      else
+      {
+        t->next = q ;
+        q = q->next ;
+      }
+    }
+    else if ( q != NULL )
+    {
+      t->next = q ;
+      q = q->next ;
+    }
+    else if ( p != NULL )
+    {
+      t->next = p ;
+      p = p->next ;
+    }
+    t = t->next ;
+  }
+  t->next = NULL ;
+  *retlist = newlist ;
+}
+
+
+
+/* OBSOLETE */
+bubble( list, up )
+  rsl_list_t *list ;
+  int up ;
+{
+  int i, desc, p, c ;
+  rsl_list_t *lp, *prev ;
+  struct srtrec {
+    rsl_point_t *pt ;
+    int         k1 ;
+    int         k2 ;
+  } *lst, *lp2 ;
+  int swap, pass, listlen, kk ;
+  void * data ;
+  rsl_point_id_t id ;
+  rsl_point_t *pt ;
+
+  desc = 0 ;
+  if ( up < 0 )
+  {
+    up = -up ;
+    desc = 1 ;
+  }
+  listlen = 0 ;
+  for ( lp = list ; lp != NULL ; lp = lp->next ) listlen++ ;
+  lst = RSL_MALLOC( struct srtrec, listlen ) ;
+  for ( lp = list, lp2 = lst  ; lp != NULL ; lp = lp->next, lp2++ )
+  {
+    lp2->pt = (rsl_point_t *) lp->data ;
+    id = lp2->pt->id ;
+    lp2->k1 = ID_IDEX( id ) ;
+    lp2->k2 = ID_JDEX( id ) ;
+  }
+
+  pass = 0 ;
+  swap = 1 ;
+  while ( swap )
+  {
+    swap = 0 ;
+    lp2 = lst ;
+    switch ( up )
+    {
+    case 1:
+      for ( i = 0 ; i < listlen-1 ; i++ )
+      {
+	p = lp2->k1 ;
+	c = (lp2+1)->k1 ;
+	if ((desc && ( p < c )) || (!desc && ( p > c )))
+        {
+            pt = lp2->pt ;
+            lp2->pt = (lp2+1)->pt ;
+            (lp2+1)->pt = pt ;
+            kk = lp2->k1 ;
+            lp2->k1 = (lp2+1)->k1 ;
+            (lp2+1)->k1 = kk ;
+            swap = 1 ;
+        }
+        lp2++ ;
+      }
+      break ;
+    case 2:
+      for ( i = 0 ; i < listlen-1 ; i++ )
+      {
+	p = lp2->k2 ;
+	c = (lp2+1)->k2 ;
+	if ((desc && ( p < c )) || (!desc && ( p > c )))
+        {
+            pt = lp2->pt ;
+            lp2->pt = (lp2+1)->pt ;
+            (lp2+1)->pt = pt ;
+            kk = lp2->k2 ;
+            lp2->k2 = (lp2+1)->k2 ;
+            (lp2+1)->k2 = kk ;
+            swap = 1 ;
+        }
+        lp2++ ;
+      }
+      break ;
+    default:
+      RSL_TEST_ERR(1,"sort: no such key") ;
+      break ;
+    }
+
+    pass++ ;
+#if 0
+    if ( pass%100 == 0 )
+    {
+      fprintf(stderr,"pass %d, listlen %d\n",pass,listlen) ;
+    }
+#endif
+    if ( pass > (listlen + 110))
+    {
+      fprintf(stderr,"pass = %d, listlen=%d\n",pass,listlen) ;
+      RSL_TEST_ERR(1,"something's wrong in sort in rsl order") ;
+    }
+  }
+
+  /* restored sorted values to linked list */
+  for ( lp = list, lp2 = lst  ; lp != NULL ; lp = lp->next, lp2++ )
+  {
+    lp->data = lp2->pt ;
+  }
+
+  RSL_FREE(lst) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_probe.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_probe.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_probe.F	(revision 2744)
@@ -0,0 +1,65 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine rsl_probe( type, retval )
+      implicit none
+      integer type, retval, probe0
+      external probe0
+      retval = probe0( type )
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_remap_state.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_remap_state.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_remap_state.c	(revision 2744)
@@ -0,0 +1,470 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+/* #define NOPACK   */
+/* #define NOUNPACK */
+/*
+   rsl_remap_state
+
+   Called to move partitions in memory and between processors
+   after a domain is re-decomposed.  Assumes that a state vector
+   has been associated with a domain.  If not, returns with warning.
+
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+extern rsl_list_t *point_move_receives[] ;	/* decomp.c */
+extern rsl_list_t *point_move_sends[] ;
+
+int debuggal_pack = 0 ;
+
+static int sendsize[RSL_MAXPROC] ;
+static int recvsize[RSL_MAXPROC] ;
+static int recvtag[RSL_MAXPROC] ;
+static int recvnpts[RSL_MAXPROC] ;
+
+/*@
+  RSL_REMAP_STATE --- Use previously defined state vectors to remap grid points.
+
+  Notes:
+  This routine is called at the point in a remapping at which two state vectors
+  --- one for the source data structures and one for the destination
+  data structures of a domain --- have 
+  been defined for RSL using RSL_DESCRIBE_STATE.  Remapping can be done in-place
+  (both state vectors may refer to the same data structures).  Also, a
+  new decomposition should have been given to RSL using RSL_FDECOMPOSE.
+
+  When this routine is called, RSL computes the difference between the
+  old and new mappings and constructs a schedule of points that need
+  to be moved between processors.  Using the schedule, it packs data
+  for moving grid points into messages, exchanges the messages between
+  processors, then unpacks the messages into their new locations.
+  Points may be moved in a processor's memory, even if the
+  points are not communicated (this allows RSL to make room for
+  an influx of points in the subdomain, if necessary).  RSL bases
+  packing and unpacking on the state vectors that have been previously
+  defined.
+
+  On return, old domain data structures may be discarded (assuming the
+  remapping has not been done in-place), and computation may resume.
+  All subsequent horizontal iteration, stencil-exchange, and
+  broadcast-merge communications will be over the new mapping.
+  The stencils and broadcast merges will automatically reconfigure
+  themselves the first time they are used on the new mapping.  However,
+  it is crucial that the loop macros (LoopMacros.m4) be re-initialized
+  by an execution of RSL_INIT_RUNVARS, before iteration is begun.
+  If the program is not using the loop macros and instead handling iteration
+  explicitely, a new call to RSL_GET_RUN_INFO or RSL_GET_RUN_INFOP is
+  required.  Iteration using the column-callable routines RSL_COMPUTE_CELLS
+  and RSL_COMPUTE_MASK does not need to be re-initialized.
+
+  Example:
+$ C Construct state vector for current mapping.
+$   dcp(1) = rsl_northsouth ; dcp(2) = rsl_eastwest ; dcp(3) = rsl_notdecomposed
+$   gl(1)  = d%m            ; gl(2)  = d%n          ; gl(3)  = d%nlev
+$   call rsl_create_message(ms)
+$   call rsl_build_message(ms,rsl_real,d%psa,size(shape(d%psa)),
+$                          dcp,gl,shape(d%psa))
+$   call rsl_build_message(ms,rsl_real,d%ua,size(shape(d%ua)),
+$                          dcp,gl,shape(d%ua))
+$   call rsl_build_message(ms,rsl_real,d%va,size(shape(d%va)),
+$                          dcp,gl,shape(d%va))
+$   . . .
+$   call rsl_describe_state(did,ms)
+$ C
+$ C New decomposition.
+$   retval=rsl_fdecompose(did,mapping,p_lt,p_ln,timers,mloc,nloc)
+$ C
+$   if (retval .eq. 0 ) then
+$ C
+$ C Construct state vector for new mapping and associate with
+$ C newly allocated data structures.
+$     call allocate_domain(tmp,did,tmp%m,tmp%n,tmp%nlev,mloc,nloc)
+$     call rsl_create_message(ms)
+$     call rsl_build_message(ms,rsl_real,tmp%ua,size(shape(tmp%psa)),
+$                            dcp,gl,shape(tmp%psa))
+$     . . .
+$     call rsl_describe_state(did,ms)
+$ C
+$ C Effect the remapping
+$     call rsl_remap_state(did)
+
+BREAKTHEEXAMPLECODE
+
+  This example is from the dynamic load balancing code in MM90,
+  the Fortran90 implementation of the Penn State/NCAR MM5.
+
+  A state vector --- an RSL message definition that contains a list of
+  all the fields that make up the state for a grid-column in the old
+  decomposition --- is constructed with successive calls to
+  RSL_BUILD_MESSAGE.  Then, the
+  domain DID is decomposed using the MM90 routine, MAPPING, passed as a
+  function to the RSL_FDECOMPOSE.  TIMERS is an MM90 array of timers for
+  containing per-grid-column performance data that is used by MAPPING.
+  TIMERS
+  is passed directly to MAPPING when it is called from within RSL.
+  RSL_FDECOMPOSE returns 0 for
+  success if the new mapping improves on the current one.
+  It also passes back MLOC and NLOC with the
+  dimensions of arrays that will be needed to hold the arrays of the processor
+  subdomain under the new decomposition.  Otherwise, the RSL_FDECOMPOSE
+  returns a non-zero value, indicating that the program should continue
+  to time step using the old decomposition.
+
+  If a new decomposition is adopted, MM90 allocates a new domain
+  structure, TMP, using MLOC and NLOC.  This will hold the remapped
+  data.  (RSL permits remapping in place, without resizing memory, but
+  this places restrictions on how far the remapping algorithm can go in
+  moving work around).  The code defines a new state vector identical to
+  the previous one except that it is associated with the new fields of TMP.
+
+  The call to RSL_REMAP_STATE effects the remapping.  RSL compares the
+  old and new mappings and generates the lists of moves between each
+  processor.  RSL then uses the information in the first state
+  vector to pack the columns to be moved into messages and sends the
+  messages between the processors. On arrival, the incoming messages are
+  unpacked using information from the second state vector.  When the call
+  returns TMP contains the remapped state data. The program then
+  uses pointer assignments (not shown) to swap old and new data into the
+  D domain, then the old data structures are deallocated.  In the end, D
+  points to the structure with the remapped data and the model resumes
+  time stepping on the domain under the new mapping.
+
+  See also:
+  RSL_DESCRIBE_STATE, RSL_FDECOMPOSE, LoopMacros.m4
+@*/
+
+RSL_REMAP_STATE ( d_p )
+  int_p d_p ; 	/* (I) RSL domain descriptor. */
+{
+  message_desc_t *old, *new ;
+  rsl_domain_info_t * dinfo ;
+  rsl_list_t *lp ;
+  int m1, m2, msize, size, npts, curs ;
+  int mtype, mdest ;
+  int isaved, jsaved ;
+  char *pbuf ;
+  int P ;
+  int d ;
+  int i, id, ig, jg, d1 ;
+
+  d = *d_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+    "rsl_remap_state: bad domain descriptor\n") ;
+  dinfo = &(domain_info[d]) ;
+  RSL_TEST_ERR(dinfo->valid != RSL_VALID,
+    "rsl_remap_state: descriptor is not for a valid domain\n") ;
+
+
+  /* get old and new state vectors */
+
+  RSL_TEST_ERR((old = dinfo->old_state_vect) == NULL,
+	"no state message previously associated with domain" );
+  RSL_TEST_ERR((new = dinfo->new_state_vect) == NULL,
+	"no state message associated with domain" ) ;
+  
+  /* figure out size and post a recieve for each processor in the receive list */
+  m1 = message_size( new ) ;
+  m2 = message_size( old ) ;
+  if ( m1 != m2 )
+  {
+    sprintf(mess,
+    "old (%d) and new (%d) state vectors cannot be different sizes.",m2,m1) ;
+    RSL_TEST_ERR(1,mess) ;
+  }
+  msize = m1 ;
+
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    size = 0 ;
+    npts = 0 ;
+    for ( lp = point_move_receives[P] ; lp != NULL ; lp = lp->next )
+    {
+#ifdef crayx1
+      size += msize + 2*sizeof(int) ;  /* size plus int for ig and jg */
+#else
+      size += msize + 2*sizeof(short) ;  /* size plus shorts for ig and jg */
+#endif
+      npts++ ;
+    }
+    if ( size > 0 )
+    {
+      if ( rsl_c_comp2phys_proc(P) != rsl_myproc )
+      {
+        pbuf = buffer_for_proc( P, size, RSL_RECVBUF ) ;
+        mtype = MTYPE_FROMTO( MSG_REDISTCOM,
+                              rsl_c_comp2phys_proc(P),
+                              rsl_myproc ) ;
+        RSL_RECVBEGIN( pbuf, size, mtype ) ;
+	recvsize[P] = size ;
+	recvtag[P] = mtype ;
+        recvnpts[P] = npts ;
+      }
+      else
+      {
+	recvsize[P] = size ;
+	recvtag[P] = mtype ;
+        recvnpts[P] = npts ;
+      }
+    }
+    else
+    {
+      recvsize[P] = 0 ;
+      recvnpts[P] = 0 ;
+      recvtag[P] = RSL_INVALID ;
+    }
+  }
+
+  isaved = dinfo->ilocaloffset ;
+  jsaved = dinfo->jlocaloffset ;
+  dinfo->ilocaloffset = dinfo->old_ilocaloffset ;
+  dinfo->jlocaloffset = dinfo->old_jlocaloffset ;
+
+  debuggal_pack = 0 ;
+
+  /* pack and send messages to each processor in the send list --
+     buffer the ones for me */
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    size = 0 ;
+    npts = 0 ;
+    for ( lp = point_move_sends[P] ; lp != NULL ; lp = lp->next )
+    {
+#ifdef crayx1
+      size += msize + 2*sizeof(int) ;
+#else
+      size += msize + 2*sizeof(short) ;
+#endif
+      npts++ ;
+    }
+    if ( size > 0 )
+    {
+      pbuf = buffer_for_proc( P, size, RSL_SENDBUF ) ;
+    }
+    curs = 0 ;
+    for ( lp = point_move_sends[P] ; lp != NULL ; lp = lp->next )
+    {
+#ifdef crayx1
+      bcopy( &(lp->info1), &(pbuf[curs]), sizeof(int)) ;        /* point id */
+      curs += sizeof(int) ;
+      bcopy( &(lp->info2), &(pbuf[curs]), sizeof(int)) ;        /* point id */
+      curs += sizeof(int) ;
+#else
+      bcopy( &(lp->info1), &(pbuf[curs]), sizeof(short)) ;      /* point id */
+      curs += sizeof(short) ;
+      bcopy( &(lp->info2), &(pbuf[curs]), sizeof(short)) ;      /* point id */
+      curs += sizeof(short) ;
+#endif
+      ig = lp->info1 ;
+      jg = lp->info2 ;
+#ifndef NOPACK
+      pack_message( old, pbuf, &curs, d, ig, jg ) ;
+#else
+      curs = size ;
+#endif
+      RSL_TEST_ERR(curs > size, "Buffer overflow") ;
+    }
+
+    if ( curs > 0 )
+    {
+      if ( rsl_myproc != rsl_c_comp2phys_proc(P) )
+      {
+        mtype = MTYPE_FROMTO( MSG_REDISTCOM,
+			      rsl_myproc,
+			      rsl_c_comp2phys_proc(P) ) ;
+        mdest = rsl_c_comp2phys_proc (P) ;
+        RSL_SEND( pbuf, curs, mtype, mdest ) ;
+      }
+      else
+      {
+	recvsize[P] = curs ;
+	recvnpts[P] = npts ;
+      }
+    }
+  }
+  dinfo->ilocaloffset = isaved ;
+  dinfo->jlocaloffset = jsaved ;
+
+  /* receive points from other processors and unpack in new position */
+  for ( P = 0 ; P < rsl_nproc_all ; P++ )
+  {
+    curs = 0 ;
+    if ( recvsize[P] > 0 ) 
+    {
+      if ( rsl_c_comp2phys_proc( P ) != rsl_myproc )
+      {
+        RSL_RECVEND( recvtag[P] ) ;
+	pbuf = buffer_for_proc( P, recvsize[P], RSL_RECVBUF ) ;
+      }
+      else
+      {
+	pbuf = buffer_for_proc( P, recvsize[P], RSL_SENDBUF ) ;
+      }
+      for ( i = 0 ; i < recvnpts[P] ; i++ )
+      {
+#ifdef crayx1
+        int id ;
+                                                                                                                    
+        bcopy( &(pbuf[curs]), &id, sizeof(int)) ;       /* point id */
+        curs += sizeof(int) ;
+        ig = id ;
+                                                                                                                    
+        bcopy( &(pbuf[curs]), &id, sizeof(int)) ;       /* point id */
+        curs += sizeof(int) ;
+#else
+        short id ;
+                                                                                                                    
+        bcopy( &(pbuf[curs]), &id, sizeof(short)) ;     /* point id */
+        curs += sizeof(short) ;
+        ig = id ;
+                                                                                                                    
+        bcopy( &(pbuf[curs]), &id, sizeof(short)) ;     /* point id */
+        curs += sizeof(short) ;
+#endif
+	jg = id ;
+
+#ifndef NOUNPACK
+        unpack_message( new, pbuf, &curs, d, ig, jg ) ;
+#endif
+      }
+    }
+  }
+
+  buffer_for_proc( rsl_c_phys2comp_proc(rsl_myproc), 0, RSL_FREEBUF ) ;
+
+  debuggal_pack = 0 ;
+
+}
+
+/*@
+  RSL_DESCRIBE_STATE --- Describe a state vector for use in remappping.
+
+  Notes:
+  This routine takes an RSL message, Arg2, and associates it with
+  the domain specified by Arg1.   The message Arg2 is built using
+  RSL_BUILD_MESSAGE.  The state vector is then stored internally
+  within RSL and used in run-time remapping (RSL_REMAP_STATE) for
+  dynamic load balancing.
+
+  RSL keeps a maximum of two state vectors internally, one representing
+  a new state and one representing an old.  Each call to RSL_DESCRIBE_STATE
+  installs Arg2 as the new new state vector, pushing the previous 
+  new state vector to the old position.   The previous old state vector
+  is discarded.  RSL_REMAP_STATE uses the old state vector as it's
+  guide for packing source data into messages
+  for remapping.   The new state vector is used for unpacking into
+  destination data structures.  See RSL_REMAP_STATE for a code example.
+
+  See also:
+  RSL_REMAP_STATE, RSL_BUILD_MESSAGES
+
+
+@*/
+
+RSL_DESCRIBE_STATE ( d_p, message )
+  int_p d_p ;
+  int_p message ;
+{
+  int d ;
+  int mh ;
+  rsl_domain_info_t * dinfo ;
+  message_desc_t *msg ;
+
+  d = *d_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+    "rsl_describe_state: bad domain descriptor\n") ;
+  dinfo = &(domain_info[d]) ;
+  RSL_TEST_ERR(dinfo->valid != RSL_VALID,
+    "rsl_describe_state: descriptor is not for a valid domain\n") ;
+
+  mh = *message ;
+  RSL_TEST_ERR( mh != RSL_INVALID && (mh < 0 || mh >=RSL_MAXDESCRIPTORS),
+"rsl_describe_state: bad message handle in list,\n  must be either valid message or RSL_INVALID") ;
+  dinfo->old_state_vect = dinfo->new_state_vect ;
+  if ( mh != RSL_INVALID )
+  {
+    RSL_TEST_ERR((msg = (message_desc_t *) mh_descriptors[ mh ])==NULL,
+       "rsl_describe_state: handle does not describe an active message") ;
+    RSL_TEST_ERR( msg->tag != MESSAGE_DESC,
+       "rsl_describe_state: handle given in message list is not for an rsl mesage def" ) ;
+    dinfo->new_state_vect = msg ;
+  }
+  else
+  {
+    dinfo->new_state_vect = NULL ;
+  }
+
+/* If there was not an old state, make the old state the dup of the new state */
+  if ( dinfo->old_state_vect == NULL )
+  {
+    dinfo->old_state_vect = dinfo->new_state_vect ;
+  }
+
+  release_mh_descriptor( &mh ) ;
+
+}
+
+void *
+myloc( x )
+  void * x ;
+{
+  return( x ) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_socket.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_socket.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsl_socket.c	(revision 2744)
@@ -0,0 +1,584 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+/*
+ *  rsl_socket.c  -- added 9/30/94
+ *
+ *               RSL_SOCKOPEN
+ *               RSL_SOCKREAD   <-- not yet
+ *               RSL_SOCKWRITE
+ *               RSL_SOCKCLOSE
+ */
+
+#include "stdio.h"
+#include "stdlib.h"
+#include "rsl.h"
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+#include <sys/uio.h>
+
+
+/*@
+  RSL_SOCKCLOSE - close a socket
+
+  Synopsis:
+  subroutine RSL_SOCKCLOSE ( sid )
+
+  Input parameters:
+. sid  close a socket opened by RSL_SOCKOPEN
+
+  See also:
+  RSL_SOCKOPEN
+
+@*/
+RSL_SOCKCLOSE ( sid0 )
+  int_p sid0 ;          /* socket id -- set by this routine */
+{
+  int retval ;
+
+  RSL_C_IAMMONITOR ( &retval ) ;
+  if ( retval == 1 ) 
+  {
+    close(*sid0) ;
+  }
+}
+
+static int first = 1 ;
+
+
+/*@
+  RSL_SOCKOPEN - open a TCP/IP socket connection for reading or writing
+
+  Synopsis:
+  subroutine RSL_SOCKOPEN ( sid, portnum, hostname, namelen )
+  integer sid
+  integer portnum
+  character*(*) hostname
+  integer namelen
+
+  Input parameters:
+. portnum  port to connect to on hostname
+. hostname string containing the name of the remote host
+. namelen  length in characters of hostname
+
+  Output parameters:
+. sid	socket descriptor for use in subsequent operations on socket
+
+  Notes:
+  Open a TCP/IP stream socket to a host for later use by RSL_SOCKWRITE and
+  RSL_SOCKREAD.  Portnum must be specified and it is the number of the
+  port on the remote host to connect to.   The name of the host
+  (e.g., xyz.abc.com) is passed to the routine as a string whose length
+  is passed as namelen.
+  
+  On return, sid argument contains the socket descriptor.
+
+  Example:
+
+$ call rsl_sockopen( sid, 5550, 'xyz.abc.com', 11 )
+
+BREAKTHEEXAMPLECODE
+
+  Bugs:
+
+  The routine prints a warning message if it fails to open
+  a socket and returns.  It would be better if this returned
+  an error code.
+
+  See also:
+  socket(2), RSL_SOCKWRITE, RSL_SOCKREAD, RSL_SOCKCLOSE
+
+
+@*/
+RSL_SOCKOPEN ( sid0, portnum0, hstname0, namelen0 )
+  int_p sid0 ;		/* socket id -- set by this routine */
+  int_p portnum0 ;	/* port number input to this routine */
+  char *hstname0 ;	/* name of host */
+  int_p namelen0 ;	/* number of characters in hstname0 */
+{
+  int i, retval  ;
+  char * p, * q, c ;
+  int portnum ;
+  char hstname[128] ;
+
+  struct sockaddr_in name;
+  struct hostent *hp, *gethostbyname();
+
+
+
+  RSL_C_IAMMONITOR ( &retval ) ;
+  if ( retval == 1 )
+  {
+
+    /* process input args from fortran */
+    portnum = *portnum0 ;
+    RSL_TEST_WRN( hstname0 == NULL, "Null hstname argument" ) ;
+    if ( *namelen0 < 0 || *namelen0 > 64 )
+    {
+      sprintf(mess,"Invalid hstname length %d.",*namelen0) ;
+      RSL_TEST_WRN(1,mess) ;
+    }
+    strncpy( hstname, hstname0, *namelen0 ) ;
+    hstname[*namelen0] = '\0' ;
+/* get rid of any white space */
+    {
+      char *p, *q;
+      for ( p = hstname, q = p ; *p ; p++ )
+	if ( *p != ' ' && *p != '\t' && *p != '\n' ) *q++ = *p ; 
+      *q = '\0' ;
+    }
+/* end mod for removing white space */
+
+    /* create socket */
+    if ( (*sid0 = socket(AF_INET,SOCK_STREAM,0)) < 0 ) 
+    {
+      perror("opening socket") ;
+      RSL_TEST_WRN(1,"") ;
+    }
+
+    /* connect socket */
+    name.sin_family = AF_INET;
+    if((hp = gethostbyname(hstname)) == NULL )
+    {
+      sprintf(mess,"%s: unknown host", hstname);
+      RSL_TEST_WRN(1,mess) ;
+    }
+
+    bcopy((char *)hp -> h_addr, (char *)&name.sin_addr, hp-> h_length);
+    name.sin_port = htons(portnum);
+
+    if(connect(*sid0, (struct sockaddr *)&name, sizeof(name)) < 0)
+    {
+      perror("connecting stream socket");
+      RSL_TEST_WRN(1,"") ;
+    }
+    if ( first == 1 )
+    {
+      first = 0 ;
+      setup_socket(*sid0) ;
+    }
+  }
+
+fprintf(stderr,"RSL_SOCKOPEN returns *sid0 = %d\n",*sid0) ;
+  return ;
+}
+
+/************/
+
+/*@
+  RSL_SOCKWRITE - write a distributed two- or three-dimensional array to a socket
+
+  Synopsis:
+  subroutine RSL_SOCKWRITE ( sid, iotag, var, domain, type, glen, llen )
+
+  Input parameters:
+. socket descriptor
+. iotag  tag describing array dimensions
+. var    distributed array being written
+. domain  domain descriptor
+. type   type of an array element
+. glen   integer array of global (undecomposed) dimensions of array
+. llen  integer array of local static dimensions of array
+
+  Notes:
+  A distributed two- or three-dimensional array will be written to
+  a socket, previously opened with RSL_SOCKOPEN.  Except as noted below,
+  the semantics are similar to RSL_READ and RSL_WRITE (which read and
+  write Fortran files).  The reader should become familiar with these
+  routines first.
+
+  A number of different output options are available, depending on the
+  value of iotag.  The tags IO2D_IJ, IO2D_JI, IO3D_IJK, or IO3D_JIK specify
+  Fortran-style record blocking (that is, with Fortran record blocking 
+  information encoded in the data stream).   The data is written to the
+  socket, but a Fortran record-blocking control word is added to the
+  beginning and end of each record written to the socket.  (Each 4-byte
+  control word is a byte
+  count for the record that follows/preceeds it, and for each n-byte
+  record written, n+8 bytes will actually be written to the socket).
+
+  The tags IO2D_IJ_RAW, IO2D_JI_RAW, IO3D_IJK_RAW, and IO3D_JIK_RAW specify
+  that the data is to be streamed to the socket as-is, with no additional
+  record blocking information.
+
+  The tags IO2D_IJ_PORTAL, IO2D_JI_PORTAL, IO3D_IJK_PORTAL, and
+  IO3D_JIK_PORTAL specify that special header packets understood by the
+  Portal communication library (see reference below) are added to the
+  beginning of each record.  This header data describes the dimensionality
+  of the data that will follow and the size of the dimensions; Portal
+  should be used on the receiving process to properly handle data written
+  in this mode.
+
+  Example:
+
+$ glen(1) = il
+$ glen(2) = jl
+$ glen(3) = mkx
+$ llen(1) = mix
+$ llen(2) = mjx
+$ llen(3) = mkx
+
+$ m2 = IO2D_IJ_RAW
+$ m3 = IO3D_IJK_RAW
+
+$ call rsl_sockwrite(sock,m2,ht,domains(inest),RSL_REAL,glen,llen)
+$ call rsl_sockwrite(sock,m3,ta,domains(inest),RSL_REAL,glen,llen)
+
+BREAKTHEEXAMPLECODE
+
+  The 2-dimensional distributed array ht and the three-dimensional
+  distributed array ta are written in raw mode to the socket specified
+  by sock.  Sock has been opened using RSL_SOCKOPEN.
+
+  See also:
+  ``Portal Communication Library for Run-Time Visualization of Distributed,
+  Asynchronous Data,'' J.S. Rowlan, B.T. Wightman, Mathematics and Computer
+  Science Division, Argonne National Laboratory, 1994.  Preprint MCS-P395-1193.
+
+  RSL_SOCKOPEN, RSL_SOCKCLOSE, RSL_READ, RSL_WRITE
+
+
+@*/
+RSL_SOCKWRITE ( unit_p, iotag_p, base, d_p, type_p, glen, llen  )
+  int_p unit_p ;
+  int_p iotag_p ;
+  int_p type_p ;
+  int_p d_p ;
+  char * base ;
+  int glen[], llen[] ;
+{
+  rsl_read_req_t request ;
+  rsl_read_resp_t resp ;
+  rsl_processor_t me ;
+  int cursor, mdest, mtag, msglen, dim ;
+  int mlen, nlen ;
+  int minelems, majelems ;
+  unsigned long ig, jg, min, maj, ioffset, joffset, tlen, k ;
+  void * dex ;
+  char *pbuf ;
+  int i_am_monitor ;
+  int psize, nelem, typelen, nbytes, columnelems  ;
+  rsl_point_t *domain ;
+
+  RSL_TEST_ERR( *d_p < 0 || *d_p >= RSL_MAXDOMAINS,
+		"rsl_sockwrite: bad domain descriptor") ;
+  RSL_TEST_ERR( domain_info[*d_p].valid != RSL_VALID,
+		"rsl_sockwrite: invalid domain descriptor" ) ;
+
+  mlen = domain_info[*d_p].len_m ;
+  nlen = domain_info[*d_p].len_n ;
+  domain = domain_info[*d_p].domain ;
+
+  RSL_C_IAMMONITOR ( &i_am_monitor ) ;
+
+  me = rsl_c_phys2comp_proc( rsl_myproc ) ;
+  ioffset = domain_info[*d_p].ilocaloffset ;
+  joffset = domain_info[*d_p].jlocaloffset ;
+  tlen = elemsize( *type_p ) ;
+
+  request.request_type = RSL_WRITE_REQUEST ;
+  request.request_mode = MSG_IO_SOCKET ;
+  request.myproc = rsl_myproc ;
+  request.base = base ;
+  request.domain = *d_p ;
+  request.unit = *unit_p ;
+  request.type = *type_p ;
+  request.iotag = *iotag_p ;
+  request.sequence = io_seq_compute++ ;
+  switch( *iotag_p )
+  {
+
+  case IO2D_IJ :
+    request.ndim = 2 ;
+    request.request_mode2 = MSG_MODE2_FORTRAN ;
+    break ;
+  case IO2D_JI :
+    request.ndim = 2 ;
+    request.request_mode2 = MSG_MODE2_FORTRAN ;
+    break ;
+  case IO3D_IJK :
+    request.ndim = 3 ;
+    request.request_mode2 = MSG_MODE2_FORTRAN ;
+    break ;
+  case IO3D_JIK :
+    request.ndim = 3 ;
+    request.request_mode2 = MSG_MODE2_FORTRAN ;
+    break ;
+
+  case IO2D_IJ_RAW :
+    request.ndim = 2 ;
+    request.request_mode2 = MSG_MODE2_RAW ;
+    break ;
+  case IO2D_JI_RAW :
+    request.ndim = 2 ;
+    request.request_mode2 = MSG_MODE2_RAW ;
+    break ;
+  case IO3D_IJK_RAW :
+    request.ndim = 3 ;
+    request.request_mode2 = MSG_MODE2_RAW ;
+    break ;
+  case IO3D_JIK_RAW :
+    request.ndim = 3 ;
+    request.request_mode2 = MSG_MODE2_RAW ;
+    break ;
+
+  case IO2D_IJ_PORTAL :
+    request.ndim = 2 ;
+    request.request_mode2 = MSG_MODE2_PORTAL ;
+    break ;
+  case IO2D_JI_PORTAL :
+    request.ndim = 2 ;
+    request.request_mode2 = MSG_MODE2_PORTAL ;
+    break ;
+  case IO3D_IJK_PORTAL :
+    request.ndim = 3 ;
+    request.request_mode2 = MSG_MODE2_PORTAL ;
+    break ;
+  case IO3D_JIK_PORTAL :
+    request.ndim = 3 ;
+    request.request_mode2 = MSG_MODE2_PORTAL ;
+    break ;
+
+  case IO2D_IJ_88 :
+    request.ndim = 2 ;
+    request.request_mode2 = MSG_MODE2_88 ;
+    break ;
+  case IO2D_JI_88 :
+    request.ndim = 2 ;
+    request.request_mode2 = MSG_MODE2_88 ;
+    break ;
+  case IO3D_IJK_88 :
+    request.ndim = 3 ;
+    request.request_mode2 = MSG_MODE2_88 ;
+    break ;
+  case IO3D_JIK_88 :
+    request.ndim = 3 ;
+    request.request_mode2 = MSG_MODE2_88 ;
+    break ;
+
+  default:
+    RSL_TEST_ERR(1,"rsl_read: unknown data tag") ;
+  }
+
+  for ( dim = 0 ; dim < request.ndim ; dim++ )
+  {
+    request.glen[dim] = glen[dim] ;
+    request.llen[dim] = llen[dim] ;
+  }
+
+  /* figure out size of buffer needed */
+  nelem = 1 ;
+  for  ( dim = 0 ; dim < request.ndim ; dim++ )
+  {
+    nelem *= request.glen[dim] ;
+  }
+  typelen = elemsize( request.type ) ;
+  nbytes = nelem * typelen ;
+
+  switch ( request.iotag )
+  {
+
+  case IO2D_IJ :
+  case IO2D_IJ_RAW :
+  case IO2D_IJ_PORTAL :
+  case IO2D_IJ_88 :
+    columnelems = 1 ;
+    minelems = request.glen[0] ;
+    majelems = request.glen[1] ;
+    break ;
+  case IO2D_JI :
+  case IO2D_JI_RAW :
+  case IO2D_JI_PORTAL :
+  case IO2D_JI_88 :
+    columnelems = 1 ;
+    minelems = request.glen[1] ;
+    majelems = request.glen[0] ;
+    break ;
+  case IO3D_IJK :
+  case IO3D_IJK_RAW :
+  case IO3D_IJK_PORTAL :
+  case IO3D_IJK_88 :
+    columnelems = request.llen[2] ;
+    minelems = request.glen[0] ;
+    majelems = request.glen[1] ;
+    break ;
+  case IO3D_JIK :
+  case IO3D_JIK_RAW :
+  case IO3D_JIK_PORTAL :
+  case IO3D_JIK_88 :
+    columnelems = request.llen[2] ;
+    minelems = request.glen[1] ;
+    majelems = request.glen[0] ;
+    break ;
+
+  default:
+    RSL_TEST_ERR(1,"handle_write_request: unknown data tag") ;
+  }
+
+
+  /*  figure out size for this processor */
+  pbuf = NULL ;
+  psize = 0 ;
+
+  RSL_TEST_ERR( majelems <= 0, "Major dim spec on write is zero or less.") ;
+  RSL_TEST_ERR( minelems <= 0, "Minor dim spec on write is zero or less.") ;
+  if ( majelems > domain_info[request.domain].len_n )
+  { sprintf(mess,"Major dim spec on write (%d) greater than global domain definition in that dimension (%d)\n",majelems,domain_info[request.domain].len_n) ;
+    RSL_TEST_ERR(1,mess) ; }
+  if ( minelems > domain_info[request.domain].len_m )
+  { sprintf(mess,"Minor dim spec on write (%d) greater than global domain definition in that dimension (%d)\n",minelems,domain_info[request.domain].len_m) ;
+    RSL_TEST_ERR(1,mess) ; }
+
+  for ( jg = 0 ; jg < majelems ; jg++ )
+  {
+    for ( ig = 0 ; ig < minelems ; ig++ )
+    {
+      if ( me == domain[INDEX_2(jg,ig,mlen)].P )
+        psize += columnelems * typelen ;
+    }
+  }
+
+
+  pbuf = RSL_MALLOC( char, psize ) ;
+
+  cursor = 0 ;
+
+#if 0
+  for ( jg = 0 ; jg < domain_info[*d_p].len_n ; jg++ )
+  {
+    for ( ig = 0 ; ig < domain_info[*d_p].len_m ; ig++ )
+    {
+#else
+  for ( jg = 0 ; jg < majelems ; jg++ )
+  {
+    for ( ig = 0 ; ig < minelems ; ig++ )
+    {
+#endif
+      if ( me == domain[INDEX_2(jg,ig,mlen)].P )
+      {
+        switch( *iotag_p )
+        {
+        case IO2D_IJ :
+        case IO2D_IJ_RAW :
+        case IO2D_IJ_PORTAL :
+        case IO2D_IJ_88 :
+	  min = ig - ioffset ;
+	  maj = jg - joffset ;
+	  dex = base+tlen*(min+maj*llen[0]) ;
+	  bcopy(dex,&(pbuf[cursor]),tlen) ;
+	  cursor += tlen ;
+          break ;
+        case IO2D_JI :
+        case IO2D_JI_RAW :
+        case IO2D_JI_PORTAL :
+        case IO2D_JI_88 :
+	  min = jg - joffset ;
+	  maj = ig - ioffset ;
+	  dex = base+tlen*(min+maj*llen[0]) ;
+	  bcopy(dex,&(pbuf[cursor]),tlen) ;
+	  cursor += tlen ;
+          break ;
+        case IO3D_IJK :
+        case IO3D_IJK_RAW :
+        case IO3D_IJK_PORTAL :
+        case IO3D_IJK_88 :
+	  min = ig - ioffset ;
+	  maj = jg - joffset ;
+	  for ( k = 0 ; k < llen[2] ; k++ )
+	  {
+	    dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+	    bcopy(dex,&(pbuf[cursor]),tlen) ;
+	    cursor += tlen ;
+	  }
+          break ;
+        case IO3D_JIK :
+        case IO3D_JIK_RAW :
+        case IO3D_JIK_PORTAL :
+        case IO3D_JIK_88 :
+	  min = jg - ioffset ;
+	  maj = ig - joffset ;
+	  for ( k = 0 ; k < llen[2] ; k++ )
+	  {
+	    dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
+	    bcopy(dex,&(pbuf[cursor]),tlen) ;
+	    cursor += tlen ;
+	  }
+          break ;
+        }
+      }
+    }
+  }
+  if ( pbuf != NULL )
+  {
+  if ( i_am_monitor )
+  {
+    handle_write_request( &request, nelem, psize, pbuf ) ;
+  }
+  else
+  {
+    mdest = RSL_C_MONITOR_PROC () ;
+    msglen = psize ;
+    mtag = MTYPE_FROMTO( MSG_WRITE_COMPUTE_RESPONSE, rsl_myproc, mdest ) ;
+    RSL_SEND( pbuf, msglen, mtag, mdest ) ;
+  }
+
+  RSL_FREE( pbuf ) ;
+  }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsltest.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsltest.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/rsltest.F	(revision 2744)
@@ -0,0 +1,702 @@
+#include "LoopMacros.inc"
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC FORTRAN 90 MODULE DEFINITION FOR A 'DOMAIN'
+CC
+CC User program definition of domain data structure and
+CC manipulation routines.
+CC
+      module domains_module
+        integer :: maxkids              ! maximum number of children
+        parameter ( maxkids = 5 )
+C
+C Domainstruct is the principal domain data structure in the user
+C program.  It contains the size of the domain in local
+C memory and logically.  Also pointers to parent and child domains,
+C if any.  Also the RSL domain handle.  Also, the domain state
+C arrays themselves (unallocated, so virtually no storage expended
+C unless the domain is actually used).
+C
+        type domainstruct
+C
+C This section has "meta" information about the domain.
+C
+          type( domainstruct ), pointer ::
+     $           parent,        ! parent domain
+     $           child(:)       ! children
+          integer nkids         ! number of (active) children
+          integer nestlevel     ! nestlevel of this domain
+          integer domdesc       ! RSL domain handle
+          logical active        ! flag
+          integer m, mloc       ! global and local dimensions in m
+          integer n, nloc       ! global and local dimensions in n
+          integer sten          ! stencil descriptor
+          integer period        ! periodic boundary descriptor
+C
+C This section has the state arrays for the domain.
+C
+          real, pointer    :: X(:,:)
+          real, pointer    :: Y(:,:)
+        endtype domainstruct
+C
+C Declaration of the top-level domain (all others are children of this one)
+C
+        type ( domainstruct ), target :: mother
+C
+C Domain manipulation routines
+C
+        contains
+C
+C Initialize a domain data structure
+C
+        subroutine init_domain( d )
+          type(domainstruct) :: d
+          d%active = .false.
+          d%m = 0
+          d%n = 0
+        end subroutine
+C
+C Allocate the fields of the domain (including state arrays).  Once
+C this is called, the domain will take more than nominal storage.
+C
+        subroutine allocate_domain( d, m, n, mloc, nloc )
+          type(domainstruct) :: d       ! domain structure
+          integer m, n, mloc, nloc      ! global and local sizes
+          integer k                     ! child index
+
+          if ( d%active ) then
+            write(0,*) 'allocate_domain: domain already active.'
+            stop
+          endif
+C
+C Create and initialize structures for future children.   Note: only
+C the child domain structures and not the child state arrays are
+C being allocated here -- thus, the children require only nominal
+C storage until actually activated and allocated.
+C
+          allocate (d%child(maxkids))
+          do k = 1, maxkids
+            call init_domain( d%child(k) )
+          enddo
+C
+C Set the size information about this domain
+C
+          d%m = m
+          d%n = n
+          d%mloc = mloc
+          d%nloc = nloc
+          d%active = .true.
+          d%nkids = 0
+C
+C Allocate storage for state arrays.
+C
+          allocate (d%X(mloc,nloc))
+          allocate (d%Y(mloc,nloc))
+        end subroutine
+      end module
+CC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC MAIN PROGRAM
+CC
+CC This is the main routine for a Fortran-90/RSL implementation of 
+CC a simple relaxation problem on a grid, with an irregularly shaped
+CC nested domain.
+CC 
+CC The bulk of the main routine, here, is involved with defining
+CC and allocating the problem, which can be done entirely at run-time
+CC by exploiting modern features of F90 such as derived data types
+CC and dynamic memory allocation.
+CC 
+CC The model itself is is executed in one call to another routine,
+CC ITERATE_MODEL
+CC at the bottom of this main program.
+CC 
+      program relaxmain
+      use domains_module
+      implicit none
+      type(domainstruct), pointer :: d
+      include "rsl.inc"
+      integer m,n,mloc,nloc,did         ! coarse domain params
+      integer m_n,n_n,mloc_n,nloc_n,nid ! nested domain params
+      integer mtrim, ntrim              ! trim for the nest
+      integer xlist(20), ylist(20), npoints   ! outline of nest
+      integer iter                      ! number of iterations to perform 
+      integer k                         ! child index
+      integer nproc_m, nproc_n          ! number of procs in m, n
+      integer rsl_patch_decomp
+      external rsl_patch_decomp
+C
+C Initialize RSL
+C
+      call rsl_initialize
+C
+C Input run-time problem configuration information
+C
+      if ( rsl_iammonitor() ) then
+         read(7,*)m,n              ! mother domain size specif. at run time
+         read(7,*)iter             ! number of mother domain iterations
+         read(7,*)nproc_m, nproc_n ! number of processors specif. at run time
+      endif
+      call rsl_mon_bcast( m , 4 )
+      call rsl_mon_bcast( n , 4 )
+      call rsl_mon_bcast( iter , 4 )
+      call rsl_mon_bcast( nproc_m , 4 )
+      call rsl_mon_bcast( nproc_n , 4 )
+       write(0,*)nproc_m,nproc_n
+      call rsl_mesh ( nproc_m, nproc_n )
+      CALL RSL_ERROR_DUP
+      CALL SET_DEF_DECOMP_FCN( rsl_patch_decomp )
+
+C
+C Mother domain.  Note that the RSL routine is called before the
+C domain is allocated.  This allows the local state arrays to be
+C allocated only as large as necessary (using the size information
+C returned by rsl_mother_domain in mloc and nloc).
+C
+      call init_domain(mother)
+C
+      call rsl_mother_domain(
+     $                       did,               ! output: RSL domain handle
+     $                       RSL_8PT,           ! input: max stencil
+     $                       m, n,              ! input: global size
+     $                       mloc, nloc )       ! output: local size
+C
+      call show_domain_decomp ( did )
+      call allocate_domain( mother, m, n, mloc, nloc )
+      mother%domdesc = did                      ! store RSL handle in domain
+      mother%nestlevel = 1                      ! nest level of mother is 1
+#if 0
+C
+C Specify the "trim" for the nest
+C
+      mtrim = 2
+      ntrim = 2
+C
+C Spawn an irregular nest using the outline and trim information
+C specified above.
+C
+      call RSL_SPAWN_REGULAR_NEST1(
+     $              nid,                        ! output: nest handle
+     $              mother%domdesc,             ! input: parent handle
+     $              RSL_8PT,                    ! input: max stencil
+     $              10, 12,
+     $              37, 40,
+     $              3, 3,                       ! input: nesting ratios
+     $              mloc_n, nloc_n,             ! output: local memory size
+     $              m_n, n_n )                  ! output: global size
+      CALL SHOW_DOMAIN_DECOMP( did )
+      CALL SHOW_DOMAIN_DECOMP( nid )
+C
+C Allocate using local size information returned by RSL.
+C
+      call allocate_domain( mother%child(1), m_n, n_n, mloc_n, nloc_n )
+C
+C Set fields in domain structures associating nest with parent
+C
+      mother%nkids = 1                          ! mother has one nest
+      mother%child(1)%parent    => mother       ! back pointer to parent
+      mother%child(1)%domdesc   =  nid          ! store RSL handle
+      mother%child(1)%nestlevel =  mother%nestlevel+1
+#else
+      mother%nkids = 0                          ! mother has no nest
+#endif
+C
+C Define the stencil communications on the mother and all subnests
+C
+      call define_data( mother )                ! user routine: recursive
+C
+C Initialize the interior of the mother and the boundary cells
+C
+      call init_grid( mother, mloc, nloc, 1 )
+C
+C Initialize the nests with data from the mother.  (There is only
+C one nest in this example, but this code allows for more).
+C
+      do k = 1, mother%nkids
+        call initial_nest_data( mother, mother%child(k) )
+      enddo
+C
+C Write initial state of the model
+C
+      call output_domains( mother )             ! recursive
+C
+C Execute 'iter' iterations of the simulation.  The following call
+C executes on the mother and recursively on all nests.
+C
+      call iterate_model( mother, 1, iter )     ! main time loop (recursive)
+C
+      call rsl_shutdown
+      stop
+      end
+CC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC ITERATE_MODEL
+CC
+CC Main computational routine -- loop over time, iteration over mother
+CC and all subnests, and control of inter-domain data exchanges.
+CC
+      recursive subroutine iterate_model( d, iter1, itern )
+      use domains_module
+      implicit none
+      include "rsl.inc"
+      type(domainstruct) :: d           ! input: domain 
+      integer iter1, itern              ! input: starting and ending steps
+
+      integer t                         ! local: time step on this domain
+      integer k                         ! local: child index
+
+      do t = iter1, itern
+        call relax_grid( d, d%mloc, d%nloc, 1 )         ! compute this domain
+        do k = 1, d%nkids                               ! for each nest...
+          call force_domain( d, d%child(k) )            !   force
+          call iterate_model( d%child(k), 1, 3 )        !   RECURSIVE CALL
+          call merge_domain( d, d%child(k) )            !   feedback
+        enddo
+        if ( d%nestlevel .eq. 1 .and.
+     $      ((mod(t-1, 5) .eq. 0) .or. (t .eq. itern))
+     $                                            ) then
+          call output_domains( d )                      ! if time, output
+
+        endif
+      enddo
+      return
+      end
+CC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC RELAX_GRID
+CC
+CC This is the main computational routine that is called for one step
+CC on a domain.  The new value for each point is computed as the
+CC average of the values of 8 neighbors.  Prior to the computation,
+CC a stencil exchange is performed to ensure that off-processor data
+CC will be available for the computation.
+CC
+      subroutine relax_grid( d, ilen, jlen, klen )
+      use domains_module
+      implicit none
+      include "rsl.inc"
+      type(domainstruct) :: d           ! input: domain being computed
+      integer ilen,                     ! input: local array sizes in m
+     $        jlen,                     ! input: local array sizes in n
+     $        klen                      ! input: local array sizes in vertical
+      RSL_DECLARE_RUN_VARS( 500 )      ! declares looping information
+      integer m, n, i, j                ! local: misc info
+      real New( ilen, jlen )            ! local: temporary array
+      integer bdyinfo(ilen,jlen, CROSS_BDY_INFO_LEN)
+                                        ! local: proximity information
+      real, pointer :: X(:,:)           ! local: state array pointer
+C
+C Initialize RSL loop constructs
+C
+      call rsl_get_run_info( d%domdesc, 500, RSL_RUN_VARS )
+C
+C Get boundary proximity information for each cell from RSL.
+C
+      call rsl_get_bdy_larray( d%domdesc, bdyinfo, CROSS_BDY_INFO_LEN )
+C
+C Exchange data with other processors on this domain using the stencil
+C information defined for and stored with the domain.
+C
+
+         write(60+rsl_myproc,*) jlen, ilen, ' XA '
+         do i = 1, ilen
+         do j = 1, jlen
+            write(60+rsl_myproc,*) d%X(i,j)
+         enddo
+         enddo
+         write(70+rsl_myproc,*) jlen, ilen, ' YA '
+         do i = 1, ilen
+         do j = 1, jlen
+            write(70+rsl_myproc,*) d%Y(i,j)
+         enddo
+         enddo
+
+      call rsl_exch_period( d%domdesc, d%period )
+
+         write(60+rsl_myproc,*) jlen, ilen, ' XB '
+         do i = 1, ilen
+         do j = 1, jlen
+            write(60+rsl_myproc,*) d%X(i,j)
+         enddo
+         enddo
+         write(70+rsl_myproc,*) jlen, ilen, ' YB '
+         do i = 1, ilen
+         do j = 1, jlen
+            write(70+rsl_myproc,*) d%Y(i,j)
+         enddo
+         enddo
+
+      call rsl_exch_stencil( d%domdesc, d%sten )
+
+C
+C Set pointer to domain state array.  Size info.
+C
+      X => d%X
+      m = d%m
+      n = d%n
+C
+C Main loop over horizontal dimensions of partition of array that
+C is stored on local processor.  If a boundary cell, hold fixed,
+C otherwise compute average.  Boundary cells are those with a boundary
+C proximity of zero (i.e. they are zero cells away from a boundary).
+C
+      RSL_MAJOR_LOOP(j)
+        RSL_MINOR_LOOP(i)
+          if ( bdyinfo(i,j,RSL_DBDY) .eq. 1 ) then
+             New(i,j) = X(i,j)
+          else
+             New(i,j) =  (
+     $          X(i+1,j-1)   +  X(i+1,j)  +  X(i+1,j+1) +
+     $          X(i,j-1)     +               X(i,j+1)   +
+     $          X(i-1,j-1)   +  X(i-1,j)  +  X(i-1,j+1)
+     $                 ) / 8.0
+          endif
+        RSL_END_MINOR_LOOP
+      RSL_END_MAJOR_LOOP
+C
+C Update X.
+C
+      RSL_MAJOR_LOOP(j)
+        RSL_MINOR_LOOP(i)
+          X(i,j) = New(i,j)
+        RSL_END_MINOR_LOOP
+      RSL_END_MAJOR_LOOP
+C
+      return
+      end
+CC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC OUTPUT_DOMAINS
+CC
+CC Called initially and periodically.  Outputs state of model on 
+CC to separate files for each nest level.
+CC
+      recursive subroutine output_domains( d )
+      use domains_module
+      implicit none
+      include "rsl.inc"
+      type(domainstruct) :: d                   ! input: domain
+      integer k                                 ! local: child index
+      integer glen(2), llen(2)                  ! local: size arrays
+C
+      glen(1) = d%m
+      glen(2) = d%n
+      llen(1) = d%mloc
+      llen(2) = d%nloc
+C
+C Output top level domain
+C
+      call rsl_write( 18+d%nestlevel-1,         ! Fortran unit for output
+     $                IO2D_IJ,                  ! describe record
+     $                d%X,                      ! data for record
+     $                d%domdesc,                ! domain descriptor
+     $                RSL_REAL,                 ! type of each element
+     $                glen, llen )              ! size info
+C
+C Foreach nest, output it and its subnests recursively.
+C
+      do k = 1, d%nkids
+        call output_domains( d%child(k) )       ! recurse
+      enddo
+      return
+      end
+CC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC INITIAL_NEST_DATA
+CC
+CC Set the cells in the nest to values transferred down from the parent.
+CC This is called to initialize the nest.
+CC
+      subroutine initial_nest_data ( d, nst )
+      use domains_module
+      implicit none
+      include "rsl.inc"
+      type(domainstruct) :: d, nst              ! input: parent and nest
+      integer pi, pj, pig, pjg                  ! local: parent indices
+      integer ni, nj, nig, njg                  ! local: nest indices
+      integer m, n, i, j, msize                 ! local: misc variables
+      integer cm, cn                            ! local: relative nest index
+      integer retval                            ! local: return value
+      real, pointer :: X(:,:)                   ! local: pointer to state array
+C
+C Point to parent's state arrays.
+C
+      X => d%X
+C
+C Build a message for each point on the nest using data from the
+C overlying cell in the parent domain.  Loop goes until we have handled
+C data from all the parent domain points on this processor.
+C
+      call rsl_to_child_info( d%domdesc, nst%domdesc, 4,
+     $                        i, j, pig, pjg, cm, cn, nig, njg, retval )
+      do while ( retval .eq. 1 )
+        call rsl_to_child_msg( 4, X(i,j) )
+        call rsl_to_child_info( d%domdesc, nst%domdesc, 4,
+     $                          i, j, pig, pjg, cm, cn, nig, njg, retval )
+      enddo
+C
+C Exchange the data using RSL inter-domain communication.
+C
+      call rsl_bcast_msgs
+C
+C Now, point to nest state data
+C
+      X => nst%X
+      X = 0.
+C
+C Unpack the message on each point of the nest.  Loop goes until we
+C have unpacked all the nested domain points that are local to this
+C processor.
+C
+      call rsl_from_parent_info( i, j, nig, njg, cm, cn, pig, pjg, retval )
+      do while ( retval .eq. 1 )
+        call rsl_from_parent_msg( 4, X(i,j) )
+        call rsl_from_parent_info( i, j, nig, njg, cm, cn, pig, pjg, retval )
+      enddo
+C
+      return
+      end
+CC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC FORCE_DOMAIN
+CC
+CC Similar to init_domain, except this is called at
+CC each step to force only the boundaries of the nest
+CC (not the entire domain, as in init_domain).
+CC
+      subroutine force_domain ( d, nst )
+      use domains_module
+      implicit none
+      include "rsl.inc"
+      type(domainstruct) :: d, nst              ! input: parent and nest
+      integer pi, pj, pig, pjg                  ! local: parent indices
+      integer ni, nj, nig, njg                  ! local: nest indices
+      integer m, n, i, j, msize                 ! local: misc variables
+      integer cm, cn                            ! local: relative nest index
+      integer retval                            ! local: return value
+      real, pointer :: X(:,:)                   ! local: pointer to state array
+      integer bdyinfo(CROSS_BDY_INFO_LEN)       ! local: boundary proximity
+C
+C Point to parent's state arrays.
+C
+      X => d%X
+C
+C Build a message for ONLY THOSE POINTS on the nest that are on a boundary.
+C The call to rsl_get_bdy_gpt gets the proximity information for a nested
+C point.  The information is then used to decide whether or not data should
+C be packed for that point.  Note: RSL will automatically size the messages
+C between processors to exchange only that data that is packed.
+C
+      call rsl_to_child_info( d%domdesc, nst%domdesc, 4,
+     $                        i, j, pig, pjg, cm, cn, nig, njg, retval )
+      do while ( retval .eq. 1 )
+        call rsl_get_bdy_gpt( nst%domdesc, bdyinfo, CROSS_BDY_INFO_LEN, nig, njg )
+        if ( bdyinfo(RSL_DBDY) .ge. 1 .and. bdyinfo(RSL_DBDY) .le. 2 ) then
+          write(0,999)'xx ' ,rsl_myproc,nig, njg, pig, pjg, cm, cn
+ 999      format(a3,7i5) 
+          call rsl_to_child_msg( 4, X(i,j) )
+        endif
+        call rsl_to_child_info( d%domdesc, nst%domdesc, 4,
+     $                          i, j, pig, pjg, cm, cn, nig, njg, retval )
+      enddo
+C
+C Exchange the data using RSL inter-domain communication.
+C
+      call rsl_bcast_msgs
+C
+C Now, point to nest state data
+C
+      X => nst%X
+C
+C Unpack the message on each point of the nest.  Because the first phase
+C of the exchange packed only data for the boundary points, this loop 
+C will iterate only over those.
+C
+      call rsl_from_parent_info( i, j, nig, njg, cm, cn, pig, pjg, retval )
+      do while ( retval .eq. 1 )
+        call rsl_from_parent_msg( 4, X(i,j) )
+        call rsl_from_parent_info( i, j, nig, njg, cm, cn, pig, pjg, retval )
+      enddo
+
+      return
+      end
+CC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC MERGE_DOMAIN
+CC
+CC This implements the feedback of data from the nest to the parent.
+CC The structure is similar to FORCE_DOMAIN, except that the flow
+CC of information is in the opposite direction.  Data is returned only
+CC for the center nest point under each coarse domain point (cm=2, cn=2).
+CC
+      subroutine merge_domain ( d, nst )
+      use domains_module
+      implicit none
+      include "rsl.inc"
+      type(domainstruct) :: d, nst              ! input: parent and nest
+      integer pi, pj, pig, pjg                  ! local: parent indices
+      integer ni, nj, nig, njg                  ! local: nest indices
+      integer m, n, i, j, msize                 ! local: misc variables
+      integer cm, cn                            ! local: relative nest index
+      integer retval                            ! local: return value
+      real, pointer :: X(:,:)                   ! local: pointer to state array
+C
+      X =>nst%X
+      call rsl_to_parent_info( d%domdesc, nst%domdesc, 4,
+     $                        i, j, nig, njg, cm, cn, pig, pjg, retval )
+      do while ( retval .eq. 1 )
+        if ( cm .eq. 1 .and. cn .eq. 1 ) then
+          call rsl_to_parent_msg( 4, X(i,j) )
+        endif
+        call rsl_to_parent_info( d%domdesc, nst%domdesc, 4,
+     $                          i, j, nig, njg, cm, cn, pig, pjg, retval )
+      enddo
+C
+      call rsl_merge_msgs
+C
+      X => d%X
+      call rsl_from_child_info( i, j, pig, pjg, cm, cn, nig, njg, retval )
+      do while ( retval .eq. 1 )
+        if ( cm .eq. 2 .and. cn .eq. 2 ) then
+          call rsl_from_child_msg( 4, X(i,j) )
+        endif
+        call rsl_from_child_info( i, j, pig, pjg, cm, cn, nig, njg, retval )
+      enddo
+C
+      return
+      end
+CC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC INIT_GRID
+CC
+CC This is a computational routine whose purpose it is to assign
+CC a domain with initial values.  Boundary cells receive a non-zero
+CC initial value.  The interior receives a zero value.
+CC
+      subroutine init_grid( d, ilen, jlen, klen )
+      use domains_module
+      implicit none
+      include "rsl.inc"
+      type(domainstruct) :: d
+      integer ilen, jlen, klen
+      RSL_DECLARE_RUN_VARS( 500 )
+      integer bdyinfo(ilen,jlen,CROSS_BDY_INFO_LEN)
+      integer m, n, i, j
+      integer cn, cm
+      real, pointer :: X(:,:), Y(:,:)
+C
+      call rsl_get_run_info( d%domdesc, 500, RSL_RUN_VARS )
+      call rsl_get_bdy_larray( d%domdesc, bdyinfo, CROSS_BDY_INFO_LEN )
+C
+      X    => d%X
+      Y    => d%Y
+      m = d%m
+      n = d%n
+      X = 0.
+      Y = 0.
+C
+      RSL_MAJOR_LOOP(j)
+        RSL_MINOR_LOOP(i)
+          if ( bdyinfo(i,j,RSL_DBDY) .eq. 1 ) then
+C              X(i,j) = 10.0
+              X(i,j) = J + I *.01
+          else
+              X(i,j) = 0.0
+          endif
+          if ( bdyinfo(i,j,RSL_DBDY_X) .eq. 1 ) then
+              Y(i,j) = J + I *.01
+          else
+              Y(i,j) = 0.0
+          endif
+        RSL_END_MINOR_LOOP
+      RSL_END_MAJOR_LOOP
+C
+      return
+      end
+CC
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CC
+CC DEFINE_DATA
+CC
+CC This is called only once, prior to the first step of the model, and
+CC is used to define the stencils on all the domains in the simulation.
+CC Stencils, though identical, must be assigned individually for each
+CC domain.  This routine does that recursively for the domain 'd', and
+CC all nests under 'd'.
+CC
+      recursive subroutine define_data( d )
+      use domains_module
+      include "rsl.inc"
+      type(domainstruct) :: d           ! input: domain
+      integer decomp(3)                 ! local: how dimensions are decomposed
+      integer llen(3)                   ! local: local size in each dim.
+      integer glen(3)                   ! local: global size in each dim.
+      integer mesg                      ! local: a message definition
+      integer messages(8)               ! local: message for each stencil pt.
+      integer k                         ! local: child index
+!      interface
+!        subroutine rsl_build_message( mesg, type, var, dim , d1, d2, d3 )
+!          integer mesg, type, dim, d1(*), d2(*), d3(*)
+!          real    var(:,:)
+!        end subroutine rsl_build_message
+!      end interface
+C
+      decomp(1) = RSL_NORTHSOUTH        ! m is decomposed by n/s processors
+      decomp(2) = RSL_EASTWEST          ! n is decomposed by e/w processors
+      glen(1) = d%m                     ! global sizes set
+      glen(2) = d%n
+      llen(1) = d%mloc                  ! local sizes set
+      llen(2) = d%nloc
+C
+C Create and build a message descriptor containing the state array X.
+C
+      call rsl_create_message( mesg )
+         write(0,*)'loc of d%X',loc(d%X), loc(d%X(1,1))
+      call rsl_build_message( mesg,RSL_REAL,d%X(1,1),2,decomp,glen,llen )
+      call rsl_build_message( mesg,RSL_REAL,d%Y(1,1),2,decomp,glen,llen )
+C
+C Create and build a stencil with the message on each of the 8 pts.
+C
+      call rsl_create_stencil( d%sten )
+      messages(1) =    mesg
+      messages(2) =           mesg
+      messages(3) =                 mesg
+      messages(4) =    mesg
+      messages(5) =                 mesg
+      messages(6) =    mesg
+      messages(7) =           mesg
+      messages(8) =                 mesg
+      call rsl_describe_stencil( d%domdesc, d%sten, RSL_8PT, messages )
+
+C Periodic boundary
+      call rsl_create_message( mesg )
+      call rsl_build_message( mesg,RSL_REAL,d%X(1,1),2,decomp,glen,llen )
+      glen(1) = d%m-1
+      glen(2) = d%n-1
+      call rsl_build_message( mesg,RSL_REAL,d%Y(1,1),2,decomp,glen,llen )
+      glen(1) = d%m
+      glen(2) = d%n
+      call rsl_create_period( d%period )
+      call rsl_describe_period( d%domdesc, d%period, 1, mesg )
+C
+C Define the stencils for all the child domains of this domains
+C
+      do k = 1, d%nkids
+        call define_data( d%child(k) )  ! RECURSION
+      enddo
+C
+      return
+      end
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/set_f_padarea.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/set_f_padarea.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/set_f_padarea.F	(revision 2744)
@@ -0,0 +1,67 @@
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     
+C                              COPYRIGHT
+C     
+C     The following is a notice of limited availability of the code and 
+C     Government license and disclaimer which must be included in the 
+C     prologue of the code and in all source listings of the code.
+C     
+C     Copyright notice
+C       (c) 1977  University of Chicago
+C     
+C     Permission is hereby granted to use, reproduce, prepare 
+C     derivative works, and to redistribute to others at no charge.  If 
+C     you distribute a copy or copies of the Software, or you modify a 
+C     copy or copies of the Software or any portion of it, thus forming 
+C     a work based on the Software and make and/or distribute copies of 
+C     such work, you must meet the following conditions:
+C     
+C          a) If you make a copy of the Software (modified or verbatim) 
+C             it must include the copyright notice and Government       
+C             license and disclaimer.
+C     
+C          b) You must cause the modified Software to carry prominent   
+C             notices stating that you changed specified portions of    
+C             the Software.
+C     
+C     This software was authored by:
+C     
+C     Argonne National Laboratory
+C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+C     Mathematics and Computer Science Division
+C     Argonne National Laboratory, Argonne, IL  60439
+C     
+C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+C     
+C                      GOVERNMENT LICENSE AND DISCLAIMER
+C     
+C     This computer code material was prepared, in part, as an account 
+C     of work sponsored by an agency of the United States Government.
+C     The Government is granted for itself and others acting on its 
+C     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+C     this data to reproduce, prepare derivative works, distribute 
+C     copies to the public, perform publicly and display publicly, and 
+C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+
+      subroutine rsl_f_set_padarea( newpad )
+      implicit none
+      include 'rsl.inc'
+      integer newpad
+
+      rsl_padarea = newpad 
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/set_padarea.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/set_padarea.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/set_padarea.c	(revision 2744)
@@ -0,0 +1,66 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+RSL_SET_PADAREA ( newpad_p )
+  int_p newpad_p ;
+{
+  rsl_padarea = *newpad_p ;
+  RSL_F_SET_PADAREA ( newpad_p ) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/setup_socket.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/setup_socket.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/setup_socket.c	(revision 2744)
@@ -0,0 +1,91 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#if 0
+From olson@mcs.anl.gov Fri Sep 30 16:02:19 1994
+Received: from mcs.anl.gov (dalek.mcs.anl.gov [140.221.1.2]) by antares.mcs.anl.gov (8.6.4/8.6.4) with ESMTP id QAA01471 for <michalak>; Fri, 30 Sep 1994 16:02:18 -0500
+Message-Id: <199409302102.QAA01471@antares.mcs.anl.gov>
+To: michalak
+Subject: socket setup stuff
+Date: Fri, 30 Sep 1994 16:02:17 -0500
+From: Bob Olson <olson@mcs.anl.gov>
+Status: RO
+#endif
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+#include <stdio.h>
+#include <signal.h>
+#include <errno.h>
+#include <netinet/tcp.h>
+
+static void setup_socket(s)
+  int s ;
+{
+  int on = 1;
+
+#ifdef TCP_RFC1323
+  if (setsockopt(s,IPPROTO_TCP,TCP_RFC1323,&on,sizeof(on)) < 0)
+    perror("setsockopt RFC1323");
+#endif
+  if (setsockopt(s,IPPROTO_TCP,TCP_NODELAY,&on,sizeof(on)) < 0)
+    perror("setsockopt NODELAY");
+  if (setsockopt(s,SOL_SOCKET,SO_REUSEADDR,&on,sizeof(on)) < 0)
+    perror("setsockopt REUSEADDR");
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/show_decomp.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/show_decomp.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/show_decomp.c	(revision 2744)
@@ -0,0 +1,257 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+#include <sys/stat.h>
+
+
+static int show_domain_first = 1 ;
+
+SHOW_DOMAIN_DECOMP ( d_p )
+  int_p d_p ;
+{
+#ifndef STUBS
+  rsl_index_t d ;
+  int Phist[RSL_MAXPROC] ;
+  char fname[50] ;
+  FILE * fp ;
+  rsl_index_t i, j, k ;
+  char * code ;
+  int i_am_monitor ;
+
+  RSL_C_IAMMONITOR ( &i_am_monitor ) ;
+
+ if ( i_am_monitor )
+ {
+  d = *d_p ;
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+        "descriptor for invalid domain" ) ;
+
+  if ( show_domain_first )
+  {
+    code = "w" ;
+    show_domain_first = 0 ;
+  }
+  else
+  {
+    code = "r+" ;
+  }
+  sprintf(fname,"show_domain_%04d",rsl_myproc) ;
+  if (( fp = fopen ( fname, code )) == NULL )
+  {
+     perror(fname) ;
+     exit(2) ;
+  }
+  fseek(fp,0L,2) ;
+  fprintf(fp,"domain=%d, len_n=%d, len_m=%d\n", 
+	   d, domain_info[d].len_n, domain_info[d].len_m ) ;
+  if ( domain_info[d].decomposed != 1 )
+  {
+    fprintf(fp,"not decomposed at this point in program") ;
+    return ;
+  }
+  for ( i = 0 ; i < RSL_MAXPROC ; i++ ) Phist[i] = 0 ;
+  for ( i = domain_info[d].len_m-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < domain_info[d].len_n ; j++ )
+    {
+      if ( domain_info[d].domain[INDEX_2(j,i,domain_info[d].len_m)].children_p != NULL )
+        fprintf(fp, "%2d ",domain_info[d].domain[INDEX_2(j,i,domain_info[d].len_m)].P+90) ;
+      else
+        fprintf(fp, "%2d ",domain_info[d].domain[INDEX_2(j,i,domain_info[d].len_m)].P) ;
+      Phist[domain_info[d].domain[INDEX_2(j,i,domain_info[d].len_m)].P]++ ;
+    }
+    fprintf(fp,"\n") ;
+  }
+  for ( i = 0 ; i < rsl_nproc_all ; i++ )
+  {
+    fprintf(fp,"%5d  %7d\n",i,Phist[i]) ;
+  }
+
+/* added 20010222 */
+  if ( domain_info[d].len_z > 1 )
+  {
+    fprintf(fp,"\nMZ decoomposition len_m = %d len_z = %d\n", domain_info[d].len_m, domain_info[d].len_z) ;
+    for ( k = domain_info[d].len_z-1 ; k >= 0 ; k-- ) {
+      for ( i = 0 ; i < domain_info[d].len_m ; i++ ) {
+        fprintf(fp, "%2d ",domain_info[d].domain_mz[INDEX_2(k,i,domain_info[d].len_m)].P) ;
+      }
+      fprintf(fp,"\n") ;
+    }
+    fprintf(fp,"\nNZ decoomposition len_n = %d len_z = %d\n", domain_info[d].len_n, domain_info[d].len_z ) ;
+    for ( k = domain_info[d].len_z-1 ; k >= 0 ; k-- ) {
+      for ( j = 0 ; j < domain_info[d].len_n ; j++ ) {
+        fprintf(fp, "%2d ",domain_info[d].domain_nz[INDEX_2(k,j,domain_info[d].len_n)].P) ;
+      }
+      fprintf(fp,"\n") ;
+    }
+  }
+
+  fclose(fp) ;
+ }
+#endif
+  return(0) ;
+}
+
+
+READ_DOMAIN_DECOMP ( d_p, wrk,  m, n )
+  int_p d_p ;
+  int * wrk ;
+  int m, n ;
+{
+  int P ;
+  int d ;
+  char fname[50] ;
+  FILE * fp ;
+  rsl_index_t i, j, k ;
+  char * code ;
+  int i_am_monitor ;
+  int in_d, in_len_n, in_len_m ;
+
+  code = "r+" ;
+
+  d = *d_p ;
+
+  sprintf(fname,"read_domain_%04d",0) ;
+
+  if (( fp = fopen ( fname, code )) == NULL )
+  {
+     perror(fname) ;
+     return(1) ;
+  }
+
+  fscanf(fp,"domain=%d, len_n=%d, len_m=%d\n", 
+	     &in_d, &in_len_n, &in_len_m ) ;
+  fprintf(stderr,"READ_DOMAIN_DECOMP: domain=%d, len_n=%d, len_m=%d\n", in_d,in_len_n,in_len_m ) ;
+
+  if ( in_len_n != domain_info[d].len_n ) {
+    fprintf(stderr,"in_len_n != domain_info[d].len_n (%d != %d)\n",in_len_n,domain_info[d].len_n) ;
+    RSL_TEST_ERR(1,"" ) ;
+  }
+  if ( in_len_m != domain_info[d].len_m ) {
+    fprintf(stderr,"in_len_m != domain_info[d].len_m (%d != %d)\n",in_len_m,domain_info[d].len_m) ;
+    RSL_TEST_ERR(1,"" ) ;
+  }
+
+  for ( i = domain_info[d].len_m-1 ; i >= 0 ; i-- )
+  {
+    for ( j = 0 ; j < domain_info[d].len_n ; j++ )
+    {
+      fscanf(fp, "%2d ",&P) ;
+      wrk[INDEX_2(j,i,domain_info[d].len_m)] = P ;
+#if 0
+      fprintf(stderr,"%2d ",wrk[INDEX_2(j,i,domain_info[d].len_m)]) ;
+#endif
+    }
+    fscanf(fp,"\n") ;
+#if 0
+    fprintf(stderr,"\n") ;
+#endif
+  }
+
+  fclose(fp) ;
+  return(0) ;
+}
+
+
+GET_DOMAIN_DECOMP ( d_p, wk, nwk_p )
+  int_p d_p ;
+  int_p wk ;
+  int_p nwk_p ;
+{
+  rsl_index_t d ;
+  char fname[50] ;
+  FILE * fp ;
+  int nwk ;
+  rsl_index_t i, j, m ;
+  char * code ;
+
+  d = *d_p ;
+  nwk = *nwk_p ;
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+        "descriptor for invalid domain" ) ;
+  RSL_TEST_ERR(wk == NULL, "GET_DOMAIN_DECOMP: NULL argument wk" ) ;
+  if ( domain_info[d].len_m * domain_info[d].len_n > nwk )
+  {
+    sprintf(mess,"%d ints would overwrite input array (size=%d ints)\n",
+	    domain_info[d].len_m * domain_info[d].len_n,
+	    nwk);
+    RSL_TEST_ERR(1,mess) ;
+  }
+
+  if ( domain_info[d].decomposed != 1 )
+  {
+    return ;
+  }
+  m = domain_info[d].len_m ;
+
+  for ( j = 0 ; j < domain_info[d].len_n ; j++ )
+  {
+    for ( i = 0 ; i < domain_info[d].len_m ; i++ )
+    {
+      wk[INDEX_2(j,i,m)] = domain_info[d].domain[INDEX_2(j,i,m)].P ;
+    }
+  }
+  return(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/stencil_def.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/stencil_def.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/stencil_def.c	(revision 2744)
@@ -0,0 +1,349 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_CREATE_STENCIL -- Create a stencil descriptor.
+
+  Notes:
+  The output argument is the integer Arg1, a descriptor to 
+  a new RSL stencil.  The stencil is then built (RSL_DESCRIBE_STENCIL)
+  and used in stencil exchanges (RSL_EXCH_STENCIL) during the model
+  run.
+
+  See also:
+  RSL_DESCRIBE_STENCIL, RSL_EXCH_STENCIL
+@*/
+
+RSL_CREATE_STENCIL ( sh_p )
+  int_p sh_p ;     /* (O) New RSL stencil descriptor. */
+{
+  int i ;
+  stencil_desc_t *sten ;
+  
+  /* NOTE: never return the 0th stencil */
+  for ( i = 1 ; i < RSL_MAXDESCRIPTORS ; i++ )
+    if ( sh_descriptors[i] == NULL ) break ;    /* got one */
+
+  RSL_TEST_ERR( i == RSL_MAXDESCRIPTORS,
+  "rsl_create_stencil:  out of descriptors.");
+
+  *sh_p = i ;
+  sten = RSL_MALLOC(stencil_desc_t,1) ;
+  sten->tag = STENCIL_DESC ;
+  sten->has_f90_fields = 0 ;
+  sh_descriptors[*sh_p] = sten ;
+  sten->sh = *sh_p ;
+}
+
+release_sh_descriptor (sh_p)
+  int_p sh_p ;
+{
+  int sh ;
+
+  sh = *sh_p ;
+  RSL_TEST_ERR( sh < 0 || sh >= RSL_MAXDESCRIPTORS,
+                "internal error.  Invalid stencil descriptor.") ;
+  if ( sh_descriptors[sh] != NULL )
+  {
+    sh_descriptors[sh] = NULL ;
+  }
+}
+
+/*@
+  RSL_DESCRIBE_STENCIL -- Defines an RSL stencil exchange on a domain.
+
+  Notes:
+  This routine gives a stencil a size and shape, associates RSL messages
+  with the stencil points, and asssociates the stencil with the domain
+  Arg1.  The argument Arg2 is a stencil descriptor previously created
+  by RSL_CREATE_STENCIL.  The shape of the stencil is specified by
+  Arg3, which is one of RSL_4PT (N, W, E, S), RSL_8PT (NW, N, NE, W, E, SW,
+  S, SE), RSL_24PT (a 5 by 5 stencil of around a given point), RSL_48PT
+  (a 7 by 7 stencil), and RSL_168PT (a 13 by 13 stencil).
+
+  Messages for each stencil point must have been previously created and
+  built using RSL_CREATE_MESSAGE and RSL_BUILD_MESSAGE.  The message
+  descriptors corresponding to 
+  each point in the stencil are passed to RSL_DESCRIBE_STENCIL as elements
+  of the
+  the 1-dimensional integer array Arg4.  The size of Arg4 corresponds to
+  the number of points (not counting the center) of the stencil.  They
+  are ordered from west to east and then north to south.  A message
+  may be associated with more than one stencil point.
+  Unused
+  points in a stencil can be set to RSL_INVALID to indicate that no messages
+  are associated with those points.  
+  Once
+  RSL_DESCRIBE_STENCIL returns, all
+  of the messages are invalidated and the message descriptors become
+  undefined.
+
+  Example:
+
+$  integer m             ! message descriptor
+$  integer messages(8)   ! array of messages for 8 pt stencil
+$  integer sten          ! stencil descriptor
+
+$ C Size and decomposition information for building messages
+$  decomp(1) = RSL_NORTHSOUTH	     ! how most minor dim decomposed
+$  decomp(2) = RSL_EASTWEST	       ! how next dim decomposed
+$  decomp(3) = RSL_NOTDECOMPOSED	  ! major dim (vertical) not decomposed
+$  glen(1) = g_ix	! global size in n/s
+$  glen(2) = g_jx	! global size in e/w
+$  glen(3) = kx		 ! size in vertical
+$  llen(1) = ix	  ! local size in n/s
+$  llen(2) = jx 		! local size in e/w
+$  llen(3) = kx	  ! local size of vertical (same as global)
+$ C Create a message and add fields UA, VA, and PSA
+$  call rsl_create_message( m )
+$  call rsl_build_message( m, RSL_REAL, ua,  3, decomp, glen, llen )
+$  call rsl_build_message( m, RSL_REAL, va,  3, decomp, glen, llen )
+$  call rsl_build_message( m, RSL_REAL, psa, 2, decomp, glen, llen )
+$ C Construct stencil for W,SW,S exchange
+$  messages(1) =    RSL_INVALID
+$  messages(2) =                RSL_INVALID
+$  messages(3) =                            RSL_INVALID
+$  messages(4) =    m
+$  messages(5) =                            RSL_INVALID
+$  messages(6) =    m
+$  messages(7) =                m
+$  messages(8) =                            RSL_INVALID
+$ C Create and describe stencil
+$  call rsl_create_stencil( sten )
+$  call rsl_describe_stencil( d, sten, RSL_8PT, messages )
+
+BREAKTHEEXAMPLECODE
+  In this example, an  exchange of surface pressure PSA
+  and horizontal wind velocity
+  components UA and VA on a south-west stencil is created.  Unused
+  points in the eight-point stencil are marked with RSL_INVALID.  Because
+  the same fields are communicated on each of the three active stencil
+  points (W, SW, and S), the same message, M, is associated with each.
+  Adding spaces to the statements that assign the array messages enhance
+  readability by outlining visually the shape of the communication.
+
+  See also:
+  RSL_CREATE_STENCIL, RSL_EXCH_STENCIL, RSL_CREATE_MESSAGE, RSL_BUILD_MESSAGE
+
+@*/
+
+RSL_DESCRIBE_STENCIL ( d_p, sh_p, maskid_p, messages )
+  int_p d_p,            /* (I) Domain descriptor. */
+        sh_p,           /* (I) Stencil handle */
+        maskid_p ;      /* (I) Stencil shape and size. */
+  int messages[] ;      /* (I) Array of message descriptors. */
+{
+  int d, sh, mh, maskid ;
+  rsl_domain_info_t * dinfo ;
+  stencil_desc_t *sten ;
+  message_desc_t *msg ;
+  int pt ;
+
+  d = *d_p ; sh = *sh_p ; maskid = *maskid_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+    "rsl_describe_stencil: bad domain descriptor\n") ;
+  dinfo = &(domain_info[d]) ;
+  RSL_TEST_ERR(dinfo->valid != RSL_VALID,
+    "rsl_describe_stencil: descriptor is not for a valid domain\n") ;
+
+  RSL_TEST_ERR( sh < 0 || sh >= RSL_MAXDESCRIPTORS,
+    "rsl_describe_stencil: bad stencil handle" ) ;
+  sten = (stencil_desc_t *) sh_descriptors[sh] ;
+  RSL_TEST_ERR( sten->tag != STENCIL_DESC,
+       "rsl_describe_stencil: handle given is not for an rsl stencil def" ) ;
+
+  switch ( maskid )
+  {
+  case RSL_4PT  : sten->f[d].ptfcn = rsl_4pt ;  sten->npts[d] = 4  ; break ;
+  case RSL_8PT  : sten->f[d].ptfcn = rsl_8pt ;  sten->npts[d] = 8  ; break ;
+  case RSL_12PT : sten->f[d].ptfcn = rsl_12pt ; sten->npts[d] = 12 ; break ;
+  case RSL_24PT : sten->f[d].ptfcn = rsl_24pt ; sten->npts[d] = 24 ; break ;
+  case RSL_48PT : sten->f[d].ptfcn = rsl_48pt ; sten->npts[d] = 48 ; break ;
+  case RSL_80PT : sten->f[d].ptfcn = rsl_80pt ; sten->npts[d] = 80 ; break ;
+  case RSL_120PT : sten->f[d].ptfcn = rsl_120pt ; sten->npts[d] = 120 ; break ;
+#if ( ALLOW_RSL_168PT == 1 )
+  case RSL_168PT : sten->f[d].ptfcn = rsl_168pt ; sten->npts[d] = 168 ; break ;
+  default : RSL_TEST_ERR( 1, 
+"rsl_describe_stencil: invalid maskid,\n  must be RSL_4PT, RSL_8PT, RSL_12PT, RSL_24PT, RSL_48PT, or RSL_168PT" ) ;
+#else
+  default : RSL_TEST_ERR( 1, 
+"rsl_describe_stencil: invalid maskid,\n  must be RSL_4PT, RSL_8PT, RSL_12PT or RSL_24PT, RSL_48PT" ) ;
+#endif
+    return ;
+  }
+
+  sten->maskid[d] = maskid ;
+  sten->compiled[d] = 0 ;
+
+  for ( pt = 0 ; pt < sten->npts[d] ; pt++ )
+  {
+    mh = messages[ pt ] ;
+    RSL_TEST_ERR( mh != RSL_INVALID && (mh < 0 || mh >=RSL_MAXDESCRIPTORS),
+"rsl_describe_stencil: bad message handle in list,\n  must be either valid message or RSL_INVALID") ;
+    if ( mh != RSL_INVALID )
+    {
+      msg = (message_desc_t *) mh_descriptors[ mh ] ;
+      RSL_TEST_ERR( msg->tag != MESSAGE_DESC, 
+       "rsl_describe_stencil: handle given in message list is not for an rsl mesage def" ) ;
+      sten->msgs[d][pt] = msg ;
+    }
+    else
+    {
+      sten->msgs[d][pt] = NULL ;
+    }
+  }
+  /* free up the message descriptors; they've done their job */
+  for ( pt = 0 ; pt < sten->npts[d] ; pt++ )
+  {
+    release_mh_descriptor( &(messages[pt]) ) ;
+  }
+  /* add my descriptor to the list for the domain */
+  dinfo->stenlist[dinfo->stencurs] = sh ;
+  dinfo->stencurs++ ;  /* 970317 */
+  if ( dinfo->stencurs >= RSL_MAXDESCRIPTORS )
+  {
+    sprintf(mess,
+     "Domain %d doesn't have room for any more stencils, but the allowable\nlimit of %d should have been more than enough.\nYou might recompile RSL with a higher setting for RSL_MAXDESCRIPTORS, but\n it's likely something else is wrong.",
+       d, RSL_MAXDESCRIPTORS ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+     
+  }
+}
+
+/* only used internally within the RSL package */
+destroy_stencil( sten )
+  stencil_desc_t * sten ;
+{
+  int d ;
+  rsl_fldspec_t *fld, *doomed ;
+  if ( sten == NULL ) return ;
+  RSL_TEST_ERR( sten->tag != STENCIL_DESC, "destroy_stencil: arg not a stencil.") ;
+
+  for ( d = 0 ; d < RSL_MAXDOMAINS ; d++ )
+  {
+    destroy_stencil_on_domain( d, sten ) ;
+  }
+  release_sh_descriptor (sten->sh) ;
+  RSL_FREE( sten ) ;
+}
+
+destroy_stencil_on_domain( d, sten )
+  int d ;
+  stencil_desc_t * sten ;
+{
+  int i ;
+
+  if ( sten == NULL ) return ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "destroy_stencil_on_domain: bad domain descriptor") ;
+  for ( i = 0 ; i < RSL_MAXSTEN+1 ; i++ )
+  {
+    destroy_message( sten->msgs[d][i] ) ;
+  }
+  sten->f[d].ptfcn = NULL ;
+  sten->npts[d] = 0 ;
+  uncompile_stencil_on_domain( d, sten ) ;
+}
+
+uncompile_stencil_on_domain( d, sten )
+  int d ;
+  stencil_desc_t * sten ;
+{
+  int i ;
+
+  if ( sten == NULL ) return ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "uncompile_stencil_on_domain: bad domain descriptor") ;
+  sten->compiled[d] = 0 ;
+  destroy_procrec_list( sten->procs[d] ) ;
+  sten->procs[d] = NULL ; /* 970317 */
+}
+
+destroy_procrec_list( prec )
+  rsl_procrec_t *prec ;
+{ 
+  rsl_procrec_t *p, *doomed ;
+  int destroy_ptrec_list() ;
+  if ( prec == NULL ) return ;
+  for ( p = prec ; p != NULL ; )
+  {
+    doomed = p ;
+    p = p->next ;
+    destroy_list( &(doomed->point_list), destroy_ptrec_list ) ;
+    RSL_FREE(doomed) ;
+  }
+}
+
+destroy_ptrec_list( ptrec )
+  rsl_ptrec_t *ptrec ;
+{
+  rsl_ptrec_t *p, *doomed ;
+  if ( ptrec == NULL ) return ;
+  for ( p = ptrec ; p != NULL ; )
+  {
+    doomed = p ;
+    p = p->next ;
+    destroy_list( &(doomed->send_messages), NULL ) ;
+    destroy_list( &(doomed->recv_messages), NULL ) ;
+    RSL_FREE(doomed) ;
+  }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/stencil_def.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/stencil_def.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/stencil_def.h	(revision 2744)
@@ -0,0 +1,90 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+
+
+#ifndef STENCIL_DEF_H
+#define STENCIL_DEF_H
+
+typedef struct stencil_desc {
+  rsl_tag_t tag;                        /* should be STENCIL_DESC */
+  int sh ;		/* my descriptor */
+  int has_f90_fields ;
+  rsl_tag_t compiled[RSL_MAXDOMAINS];
+  rsl_tag_t npts[RSL_MAXDOMAINS] ;
+  rsl_tag_t maskid[RSL_MAXDOMAINS] ;
+  message_desc_t *msgs[RSL_MAXDOMAINS][ RSL_MAXSTEN+1 ] ;
+  rsl_procrec_t *procs[RSL_MAXDOMAINS] ;
+  struct {
+    int (*ptfcn)() ;
+  } f[RSL_MAXDOMAINS] ;
+} stencil_desc_t ;
+
+int rsl_4pt() ;		/* forward declarations for pt functions */
+int rsl_8pt() ;		/* forward declarations for pt functions */
+int rsl_12pt() ;	/* forward declarations for pt functions */
+int rsl_24pt() ;	/* forward declarations for pt functions */
+int rsl_48pt() ;	/* forward declarations for pt functions */
+int rsl_80pt() ;	/* forward declarations for pt functions */
+int rsl_120pt() ;	/* forward declarations for pt functions */
+#if (ALLOW_RSL_168PT == 1)
+int rsl_168pt() ;	/* forward declarations for pt functions */
+#endif
+int rsl_2ptm() ;	/* forward declarations for pt functions */
+int rsl_4ptm() ;	/* forward declarations for pt functions */
+
+#endif  /* nothing after this line */
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/tag.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/tag.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/tag.c	(revision 2744)
@@ -0,0 +1,109 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+FILE * inp = stdin ;
+char inline[256] ;
+
+main( argc, argv )
+  int argc;
+  char * argv[] ;
+{
+  int n, done ;
+
+  if ( argc == 2 )
+  {
+    inp = NULL ;
+  }
+
+  done = 0 ;
+  while ( ! done )
+  {
+  if ( inp == NULL )
+  {
+    n = atoi( argv[1] ) ;
+    done = 1 ;
+  }
+  else
+  {
+    if ( fgets( inline, 80, stdin ) == NULL ) 
+      break ;
+    n = atoi( inline ) ;
+  }
+
+  printf("From  is %d\n", MTYPE_FROM(n) ) ;
+  printf("Tag   is %d\n", MTYPE_TAG(n) ) ;
+
+  switch ( MTYPE_TAG(n) )
+  {
+case MSG_STENCOM	: printf("msg_stencom\n") ; break ;
+case MSG_READ_RESPONSE	: printf("msg_read_response\n") ; break ;
+case MSG_WRITE_RESPONSE	: printf("msg_write_response\n") ; break ;
+case MSG_WRITE_COMPUTE_RESPONSE	: printf("msg_write_compute_response\n") ; break ;
+case MSG_SPECIAL1_RESPONSE	: printf("msg_special1_response\n") ; break ;
+case MSG_SPECIAL2_RESPONSE	: printf("msg_special2_response\n") ; break ;
+case MSG_FROM_PARENT	: printf("msg_from_parent\n") ; break ;
+case MSG_BCAST_SETUP	: printf("msg_bcast_setup\n") ; break ;
+case MSG_MERGE_SETUP	: printf("msg_merge_setup\n") ; break ;
+case MSG_TO_PARENT	: printf("msg_to_parent\n") ; break ;
+  default : break ;
+  }
+  }
+  exit(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/vicopy.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/vicopy.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/vicopy.F	(revision 2744)
@@ -0,0 +1,45 @@
+      subroutine vicopy( a, b, c )
+      integer a(*), b(*)
+      integer c
+      do i = 1, c
+        b(i) = a(i)
+      enddo
+      return
+      end
+
+      subroutine vrcopy( a, b, c )
+      real a(*), b(*)
+      integer c
+      do i = 1, c
+        b(i) = a(i)
+      enddo
+      return
+      end
+
+      subroutine vbcopy( a, b, c )
+      byte a(*), b(*)
+      integer c
+      do i = 1, c
+        b(i) = a(i)
+      enddo
+      return
+      end
+
+      subroutine vizero( a, c )
+      integer a(*)
+      integer c
+      do i = 1, c
+        a(i) = 0
+      enddo
+      return
+      end
+
+      subroutine vbzero( a, c )
+      byte a(*)
+      integer c
+      do i = 1, c
+        a(i) = 0
+      enddo
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/vicopy_o2k.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/vicopy_o2k.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/vicopy_o2k.F	(revision 2744)
@@ -0,0 +1,45 @@
+      subroutine vicopy( a, b, c )
+      integer a(*), b(*)
+      integer c
+      do i = 1, c
+        b(i) = a(i)
+      enddo
+      return
+      end
+
+      subroutine vrcopy( a, b, c )
+      real a(*), b(*)
+      integer c
+      do i = 1, c
+        b(i) = a(i)
+      enddo
+      return
+      end
+
+      subroutine vbcopy( a, b, c )
+      integer*1 a(*), b(*)
+      integer c
+      do i = 1, c
+        b(i) = a(i)
+      enddo
+      return
+      end
+
+      subroutine vizero( a, c )
+      integer a(*)
+      integer c
+      do i = 1, c
+        a(i) = 0
+      enddo
+      return
+      end
+
+      subroutine vbzero( a, c )
+      integer*1 a(*)
+      integer c
+      do i = 1, c
+        a(i) = 0
+      enddo
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/vicopy_sx.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/vicopy_sx.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/vicopy_sx.F	(revision 2744)
@@ -0,0 +1,18 @@
+      subroutine vicopy( a, b, c )
+      integer a(*), b(*)
+      integer c
+      do i = 1, c
+        b(i) = a(i)
+      enddo
+      return
+      end
+
+      subroutine vrcopy( a, b, c )
+      real a(*), b(*)
+      integer c
+      do i = 1, c
+        b(i) = a(i)
+      enddo
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/which_boundary.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/which_boundary.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/which_boundary.h	(revision 2744)
@@ -0,0 +1,5 @@
+#define WHICH_BDY_EAST   2
+#define WHICH_BDY_WEST   1
+#define WHICH_BDY_NORTH  8
+#define WHICH_BDY_SOUTH  4
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/within_nest.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/within_nest.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/within_nest.c	(revision 2744)
@@ -0,0 +1,159 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/* note -- only works for regular nests right now */
+/* note also, these indices come is as FORTRAN  (1..n)*/
+
+/* 1/10/95, BUG: should these be converted to use eff_m, eff_n
+   instead of len_m, len_n? */
+
+RSL_WITHIN_NESTED_BOUNDARY ( wdth_p, pd_p, nd_p, ig_p, jg_p, retval_p )
+  int_p wdth_p,         /* width of boundary in nested domain cells */
+        pd_p,           /* descriptor to parent -- this domain */
+        nd_p,           /* descriptor for nest */
+        ig_p, jg_p,     /* coordinates of coarse domain cell */
+        retval_p ;      /* return 1 if on boundary, 0 otherwise */
+{
+  int wdth, pd, nd, ig, jg, retval ;
+  int cwdth ;  /* coarse domain width (ceiling of wdth / IRAX) */
+  int swi, swj, leni, lenj, rax ;
+
+  wdth = *wdth_p ; pd = *pd_p ; nd = *nd_p ;
+  ig = *ig_p - 1 ; jg = *jg_p - 1 ;
+
+  rax = domain_info[nd].irax_m ;  /* TODO -- BUG -- if irax_m and irax_n differ, hozed */
+
+  cwdth = wdth / rax + ((wdth%rax == 0)?0:1) ;
+  swi = domain_info[nd].coord_m ;
+  swj = domain_info[nd].coord_n ;
+  leni = domain_info[nd].len_m /  domain_info[nd].irax_m ;
+  lenj = domain_info[nd].len_n /  domain_info[nd].irax_n ;
+
+  retval = 0 ;
+  if ( jg >= swj && ig >= swi  &&
+       jg < swj + lenj && ig < swi + leni )
+  {
+      
+  /* check western */
+  if      ( jg - swj < cwdth ) 
+    retval = 1 ;
+  /* check eastern */
+  else if ( swj + lenj - jg <= cwdth )
+    retval = 1 ;
+  /* check southern */
+  if      ( ig - swi < cwdth ) 
+    retval = 1 ;
+  /* check northern */
+  else if ( swi + leni - ig <= cwdth )
+    retval = 1 ;
+
+  }
+
+  *retval_p = retval ;
+}
+
+/* like above, but gives an extra row and column on north and east
+   respectively */
+
+RSL_WITHIN_NESTED_BETA ( wdth_p, pd_p, nd_p, ig_p, jg_p, retval_p )
+  int_p wdth_p,         /* width of boundary in nested domain cells */
+        pd_p,           /* descriptor to parent -- this domain */
+        nd_p,           /* descriptor for nest */
+        ig_p, jg_p,     /* coordinates of coarse domain cell */
+        retval_p ;      /* return 1 if on boundary, 0 otherwise */
+{
+  int wdth, pd, nd, ig, jg, retval ;
+  int cwdth ;  /* coarse domain width (ceiling of wdth / IRAX) */
+  int swi, swj, leni, lenj, rax ;
+
+  wdth = *wdth_p ; pd = *pd_p ; nd = *nd_p ;
+  ig = *ig_p - 1 ; jg = *jg_p - 1 ;
+
+  rax = domain_info[nd].irax_m ;  /* TODO -- BUG -- if irax_m and irax_n differ,
+ hozed */
+
+  cwdth = wdth / rax + ((wdth%rax == 0)?0:1) ;
+  swi = domain_info[nd].coord_m ;
+  swj = domain_info[nd].coord_n ;
+  leni = domain_info[nd].len_m /  domain_info[nd].irax_m ;
+  lenj = domain_info[nd].len_n /  domain_info[nd].irax_n ;
+
+  retval = 0 ;
+  if ( jg >= swj && ig >= swi  &&
+       jg < swj + lenj && ig < swi + leni )
+  {
+      
+  /* check western */
+  if      ( jg - swj < cwdth ) 
+    retval = 1 ;
+  /* check eastern */
+  else if ( swj + lenj - jg <= cwdth+1 )
+    retval = 1 ;
+  /* check southern */
+  if      ( ig - swi < cwdth ) 
+    retval = 1 ;
+  /* check northern */
+  else if ( swi + leni - ig <= cwdth+1 )
+    retval = 1 ;
+
+  }
+
+  *retval_p = retval ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/xpose.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/xpose.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/xpose.c	(revision 2744)
@@ -0,0 +1,610 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_XPOSE - Transpose data
+
+  Notes:
+
+@*/
+
+RSL_XPOSE_MN_MZ ( d_p, x_p )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,x_p ;           /* (I) Xpose descriptor. */
+{
+  rsl_xpose_common_up ( d_p , x_p , XPOSE_MN_MZ ) ;
+}
+
+RSL_XPOSE_MZ_MN ( d_p, x_p )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,x_p ;           /* (I) Xpose descriptor. */
+{
+  rsl_xpose_common_down( d_p, x_p, XPOSE_MZ_MN ) ;
+}
+
+RSL_XPOSE_MZ_NZ ( d_p, x_p )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,x_p ;           /* (I) Xpose descriptor. */
+{
+  rsl_xpose_common_up ( d_p , x_p , XPOSE_MZ_NZ ) ;
+}
+
+RSL_XPOSE_NZ_MZ ( d_p, x_p )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,x_p ;           /* (I) Xpose descriptor. */
+{
+  rsl_xpose_common_down( d_p, x_p, XPOSE_NZ_MZ ) ;
+}
+
+RSL_XPOSE_NZ_MN ( d_p, x_p )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,x_p ;           /* (I) Xpose descriptor. */
+{
+#if 0
+fprintf(stderr,"RSL_XPOSE_NZ_MN called\n" ) ;
+#endif
+  rsl_xpose_common_up ( d_p , x_p , XPOSE_NZ_MN ) ;
+#if 0
+fprintf(stderr,"RSL_XPOSE_NZ_MN back\n" ) ;
+#endif
+}
+
+RSL_XPOSE_MN_NZ ( d_p, x_p )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,x_p ;           /* (I) Xpose descriptor. */
+{
+  rsl_xpose_common_down( d_p, x_p, XPOSE_MN_NZ ) ;
+}
+
+/**************************************************/
+
+rsl_xpose_common_up ( d_p, x_p, xpose_sw )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,x_p ;           /* (I) Xpose descriptor. */
+  int xpose_sw ;
+{
+  int d, x ;
+  xpose_desc_t *xpose ;
+  message_desc_t *msg ;
+  rsl_procrec_t *procrec ;
+  rsl_ptrec_t *ptrec ;
+  rsl_list_t *lp, *lp1 ;
+  rsl_index_t ig, jg ;
+  rsl_point_hdr_t point_hdr ;
+  int i, ipt, sp, j ;
+  int curs ;
+  int nprocs, npts ;
+  int retval ;
+  int mtype, mdest ;
+  char * pbuf ;
+  int P ;
+  int Pque[RSL_MAXPROC] ;
+  rsl_procrec_t *procrecque[RSL_MAXPROC ] ;
+  int typeque[RSL_MAXPROC] ;
+  int tqp, ndone ;
+  void * base ;
+  packrec_t * pr ;
+
+
+  d = *d_p ; x = *x_p ;
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+        "descriptor for invalid domain" ) ;
+
+#ifdef UPSHOT
+MPE_Log_event( 15, x, "xpose begin" ) ;
+#endif
+#if 0
+fprintf(stderr,"debug called RSL_XPOSE_MN_MZ %d\n" ) ;
+#endif
+
+  xpose = (xpose_desc_t *) xp_descriptors[ x ] ;
+
+  /* if xpose has not been compiled, compile it now! */
+  if ( xpose->compiled[d] == 0 )
+  {
+    rsl_compile_xpose( d_p, x_p ) ;
+  }
+
+  /* post receives */
+  /* iterate over procrecs for domain and post buffers */
+
+  tqp = 0 ;
+  for ( procrec = xpose->procs[d][xpose_sw] ; procrec != NULL ; procrec = procrec->next )
+  {
+    if ( procrec->unpack_table_nbytes > 0 )
+    {
+      P = procrec->P ;
+      Pque[tqp] = P ;
+      procrecque[tqp] = procrec ;
+      pbuf = buffer_for_proc( P, procrec->unpack_table_nbytes, RSL_RECVBUF ) ;
+      mtype = MTYPE_FROMTO( MSG_XPOSECOM, 
+                            rsl_c_comp2phys_proc (procrec->P), 
+                            rsl_myproc ) ;
+      typeque[tqp] = mtype ;
+      procrec->nrecvs++ ; /* diagnostic */
+#if 0
+fprintf(stderr,"debug posting async recv for %d bytes from %d\n", procrec->unpack_table_nbytes, rsl_c_comp2phys_proc (procrec->P) ) ;
+#endif
+      RSL_RECVBEGIN ( pbuf, procrec->unpack_table_nbytes, mtype ) ;
+      tqp++ ;
+    }
+  }
+  nprocs = tqp ;
+
+  /* pack buffers and issue sends */
+
+  for ( procrec = xpose->procs[d][xpose_sw] ; procrec != NULL ; procrec = procrec->next )
+  {
+    pbuf=buffer_for_proc(procrec->P, procrec->pack_table_nbytes, RSL_SENDBUF) ;
+    pr = procrec->pack_table ;
+    for ( curs = 0, i = 0 ; i < procrec->pack_table_size ; i++, pr++ )
+    {
+      if ( xpose->has_f90_fields && procrec->pack_table_size > 0 )
+        base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+      else
+        base =  pr->base ;
+#if 0
+fprintf(stderr,"pack   base %lu, f90_index %d, xpose=%d, pr->nelems=%d\n",base,pr->f90_table_index,x, pr->nelems) ;
+#endif
+      for ( j = 0 ; j < pr->nelems ; j++ )
+      {
+
+#if 0
+fprintf(stderr,"pck %08x, base %08x, buf %08x, curs %5d, n %5d, off %5d, j %5d, s %5d\n",
+(char *)(base) + pr->offset + j * pr->stride,
+base,
+&(pbuf[curs]), curs, pr->n,
+pr->offset, j, pr->stride ) ;
+#endif
+#if 0
+{ int iii, mloc_mn, nloc_mn, zloc_mn, x ;
+mloc_mn = 10 ;
+nloc_mn = 9 ;
+zloc_mn = 2 ;
+for ( iii = 0 ; iii < pr->n ; iii+=4 )
+{
+x = ((pr->offset + j * pr->stride + iii))/4 ;
+fprintf(stderr,"^ >>> %3d i %2d k %2d j %2d          %f\n",
+               x ,
+               x % mloc_mn ,
+               (x % (mloc_mn*zloc_mn))/mloc_mn  ,
+               (x / (mloc_mn*zloc_mn)) ,
+               *((float *)((char *)(base) + pr->offset + j * pr->stride + iii))) ;
+}}
+#endif
+
+
+#if 0
+fprintf(stderr,"pck %08x, base %08x, buf %08x, curs %5d, n %5d, off %5d, j %5d, s %5d\n",
+(char *)(base) + pr->offset + j * pr->stride,
+base,
+&(pbuf[curs]), curs, pr->n,
+pr->offset, j, pr->stride ) ;
+{ int iii ;
+for ( iii = 0 ; iii < pr->n ; iii+=4 )
+{
+fprintf(stderr,"^ >>> %d  %f\n", pr->offset + j * pr->stride + iii, *((float *)((char *)(base) + pr->offset + j * pr->stride + iii))) ;
+}}
+#endif
+
+
+        bcopy((char *)(base) + pr->offset + j * pr->stride,
+	      &(pbuf[curs]),pr->n) ;
+        curs += pr->n ;
+      }
+    }
+    if ( curs > 0 )
+    {
+      mdest = rsl_c_comp2phys_proc (procrec->P) ;
+      mtype = MTYPE_FROMTO( MSG_XPOSECOM, rsl_myproc, mdest ) ;
+      procrec->nsends++ ;
+      if ( curs > procrec->pack_table_nbytes ) 
+      {
+        sprintf(mess,"pack buffer overflow %d > %d\n",curs,procrec->pack_table_nbytes) ;
+        RSL_TEST_ERR(1,mess) ;
+      }
+#if 0
+fprintf(stderr,"debug sending %d bytes to %d, xpose=%d\n", curs, mdest, x ) ;
+#endif
+      RSL_SEND ( pbuf, curs, mtype, mdest ) ;
+    }
+    else if ( curs == 0 && procrec->pack_table_nbytes != 0 )
+    {
+      RSL_TEST_ERR(1,"internal error") ;
+    }
+  }
+
+  /* wait on receives and unpack messages as they come in */
+  ndone = 0 ;
+  tqp = 0 ;
+  retval = 1 ;
+
+  while( ndone < nprocs )
+  {
+    if (tqp >= nprocs ) tqp = 0 ;
+    if (typeque[tqp] != RSL_INVALID)
+    {
+      mtype = typeque[tqp] ;
+      if ( rsl_noprobe == NULL )
+        RSL_PROBE ( mtype, &retval ) ;
+      /* else, retval will always be 1 */
+
+      if ( retval )
+      {
+#ifdef PGON
+/* on the Paragon, calling RSL_PROBE clears the message so this
+   would bomb on an unknown message id.  Don't call unless the probe
+   is disabled (rsl_noprobe != NULL). */
+        if ( rsl_noprobe != NULL ) RSL_RECVEND ( mtype ) ;
+#else  
+        RSL_RECVEND ( mtype ) ;
+#endif
+
+	curs = 0 ;
+        pbuf = buffer_for_proc( Pque[tqp], 0, RSL_RECVBUF ) ;
+        procrec = procrecque[tqp] ;
+#if 0
+        fprintf(stderr,"**unpack P = %3d:\n",procrec->P ) ;
+        show_pack_table( procrec->unpack_table,
+                         procrec->unpack_table_size,
+                         procrec->unpack_table_nbytes ) ;
+#endif
+
+        pr = procrec->unpack_table ;
+        for ( curs = 0, i = 0 ; i < procrec->unpack_table_size ; i++, pr++ )
+	{
+          if ( xpose->has_f90_fields && procrec->unpack_table_size > 0 )
+            base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+          else
+            base = pr->base ;
+#if 0
+fprintf(stderr,"^ unpack base %08x, n %3d, nelems %d, stride %3d, f90_index %d, xpose=%d\n",
+  base,pr->n,pr->nelems,pr->stride,pr->f90_table_index,x) ;
+#endif
+          for ( j = 0 ; j < pr->nelems ; j++ )
+          {
+            bcopy(&(pbuf[curs]),
+		 (char *)(base) + pr->offset + j * pr->stride, pr->n) ;
+#if 0
+{ int iii, mloc_mz, nloc_mz, zloc_mz, x ;
+mloc_mz = 8 ;
+nloc_mz = 9 ;
+zloc_mz = 3 ;
+for ( iii = 0 ; iii < pr->n ; iii+=4 )
+{
+x = ((pr->offset + j * pr->stride + iii))/4 ;
+fprintf(stderr,"^ <<< %d i %2d k %2d j %2d %f\n",
+               x ,
+               x % mloc_mz ,
+               (x % (mloc_mz*zloc_mz))/mloc_mz  ,
+               (x / (mloc_mz*zloc_mz)) ,
+               *((float *)((char *)(base) + pr->offset + j * pr->stride + iii))) ;
+}}
+#endif
+            curs += pr->n ;
+	  }
+	}
+	if ( curs == 0 )
+	{
+	  RSL_TEST_ERR(1,"internal error") ;
+	}
+        if ( curs > procrec->unpack_table_nbytes )
+        {
+          sprintf(mess,"unpack buffer overflow %d > %d\n",curs,procrec->unpack_table_nbytes) ;
+          RSL_TEST_ERR(1,mess) ;
+	}
+#if 0
+fprintf(stderr,"debug got message from %d and unpacked %d bytes; xpose=%d\n", Pque[tqp], curs, x ) ;
+#endif
+        typeque[tqp] = RSL_INVALID ;
+        ndone++ ;
+      }
+    }
+    tqp++ ;
+  }
+#ifdef UPSHOT
+MPE_Log_event( 16, s, "xpose end" ) ;
+#endif
+}
+
+/***********************************************/
+
+rsl_xpose_common_down ( d_p , x_p , xpose_sw )
+  int_p
+    d_p             /* (I) Domain descriptor. */
+   ,x_p ;           /* (I) Xpose descriptor. */
+  int xpose_sw ;
+{
+  int d, x ;
+  xpose_desc_t *xpose ;
+  message_desc_t *msg ;
+  rsl_procrec_t *procrec ;
+  rsl_ptrec_t *ptrec ;
+  rsl_list_t *lp, *lp1 ;
+  rsl_index_t ig, jg ;
+  rsl_point_hdr_t point_hdr ;
+  int i, ipt, sp, j ;
+  int curs ;
+  int nprocs, npts ;
+  int retval ;
+  int mtype, mdest ;
+  char * pbuf ;
+  int P ;
+  int Pque[RSL_MAXPROC] ;
+  rsl_procrec_t *procrecque[RSL_MAXPROC ] ;
+  int typeque[RSL_MAXPROC] ;
+  int tqp, ndone ;
+  void * base ;
+  packrec_t * pr ;
+
+#if 0
+fprintf(stderr,"RSL_XPOSE_MZ_MN called\n" ) ;
+#endif
+
+  d = *d_p ; x = *x_p ;
+
+  RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
+          "bad domain descriptor" ) ;
+  RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
+        "descriptor for invalid domain" ) ;
+
+#ifdef UPSHOT
+MPE_Log_event( 15, x, "xpose begin" ) ;
+#endif
+#if 0
+fprintf(stderr,"debug called RSL_XPOSE_MN_MZ %d\n" ) ;
+#endif
+
+  xpose = (xpose_desc_t *) xp_descriptors[ x ] ;
+
+  /* if xpose has not been compiled, compile it now! */
+  if ( xpose->compiled[d] == 0 )
+  {
+    rsl_compile_xpose( d_p, x_p ) ;
+  }
+
+  /* post receives */
+  /* iterate over procrecs for domain and post buffers */
+
+/*** TO EFFECT THE OTHER DIRECTION, JUST SWITCH PACK AND UNPACK POINTERS ***/
+
+  tqp = 0 ;
+  for ( procrec = xpose->procs[d][xpose_sw] ; procrec != NULL ; procrec = procrec->next )
+  {
+    if ( procrec->pack_table_nbytes > 0 )
+    {
+      P = procrec->P ;
+      Pque[tqp] = P ;
+      procrecque[tqp] = procrec ;
+      pbuf = buffer_for_proc( P, procrec->pack_table_nbytes, RSL_RECVBUF ) ;
+      mtype = MTYPE_FROMTO( MSG_XPOSECOM, 
+                            rsl_c_comp2phys_proc (procrec->P), 
+                            rsl_myproc ) ;
+      typeque[tqp] = mtype ;
+      procrec->nrecvs++ ; /* diagnostic */
+#if 0
+fprintf(stderr,"debug posting async recv for %d bytes from %d\n", procrec->pack_table_nbytes, rsl_c_comp2phys_proc (procrec->P) ) ;
+#endif
+      RSL_RECVBEGIN ( pbuf, procrec->pack_table_nbytes, mtype ) ;
+      tqp++ ;
+    }
+  }
+  nprocs = tqp ;
+
+  /* pack buffers and issue sends */
+
+  for ( procrec = xpose->procs[d][xpose_sw] ; procrec != NULL ; procrec = procrec->next )
+  {
+    pbuf=buffer_for_proc(procrec->P, procrec->unpack_table_nbytes, RSL_SENDBUF) ;
+    pr = procrec->unpack_table ;
+    for ( curs = 0, i = 0 ; i < procrec->unpack_table_size ; i++, pr++ )
+    {
+      if ( xpose->has_f90_fields && procrec->unpack_table_size > 0 )
+        base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+      else
+        base =  pr->base ;
+#if 0
+fprintf(stderr,"pack   base %lu, f90_index %d, xpose=%d\n",base,pr->f90_table_index,x) ;
+#endif
+      for ( j = 0 ; j < pr->nelems ; j++ )
+      {
+
+#if 0
+fprintf(stderr,"pck %08x, buf %08x, curs %5d, n %5d, off %5d, j %5d, s %5d\n",
+(char *)(base) + pr->offset + j * pr->stride,
+&(pbuf[curs]), curs, pr->n,
+pr->offset, j, pr->stride ) ;
+{ int iii ;
+for ( iii = 0 ; iii < pr->n ; iii+=4 )
+{
+fprintf(stderr,"v >>> %f\n", *((float *)((char *)(base) + pr->offset + j * pr->stride + iii))) ;
+}}
+#endif
+
+        bcopy((char *)(base) + pr->offset + j * pr->stride,
+	      &(pbuf[curs]),pr->n) ;
+        curs += pr->n ;
+      }
+    }
+    if ( curs > 0 )
+    {
+      mdest = rsl_c_comp2phys_proc (procrec->P) ;
+      mtype = MTYPE_FROMTO( MSG_XPOSECOM, rsl_myproc, mdest ) ;
+      procrec->nsends++ ;
+      if ( curs > procrec->unpack_table_nbytes ) 
+      {
+        sprintf(mess,"pack buffer overflow %d > %d\n",curs,procrec->unpack_table_nbytes) ;
+        RSL_TEST_ERR(1,mess) ;
+      }
+#if 0
+fprintf(stderr,"debug sending %d bytes to %d, xpose=%d\n", curs, mdest, x ) ;
+#endif
+      RSL_SEND ( pbuf, curs, mtype, mdest ) ;
+    }
+    else if ( curs == 0 && procrec->unpack_table_nbytes != 0 )
+    {
+      RSL_TEST_ERR(1,"internal error") ;
+    }
+  }
+
+  /* wait on receives and unpack messages as they come in */
+  ndone = 0 ;
+  tqp = 0 ;
+  retval = 1 ;
+
+  while( ndone < nprocs )
+  {
+    if (tqp >= nprocs ) tqp = 0 ;
+    if (typeque[tqp] != RSL_INVALID)
+    {
+      mtype = typeque[tqp] ;
+      if ( rsl_noprobe == NULL )
+        RSL_PROBE ( mtype, &retval ) ;
+      /* else, retval will always be 1 */
+
+      if ( retval )
+      {
+#ifdef PGON
+/* on the Paragon, calling RSL_PROBE clears the message so this
+   would bomb on an unknown message id.  Don't call unless the probe
+   is disabled (rsl_noprobe != NULL). */
+        if ( rsl_noprobe != NULL ) RSL_RECVEND ( mtype ) ;
+#else  
+        RSL_RECVEND ( mtype ) ;
+#endif
+
+	curs = 0 ;
+        pbuf = buffer_for_proc( Pque[tqp], 0, RSL_RECVBUF ) ;
+        procrec = procrecque[tqp] ;
+#if 0
+        fprintf(stderr,"**unpack P = %3d:\n",procrec->P ) ;
+        show_pack_table( procrec->pack_table,
+                         procrec->pack_table_size,
+                         procrec->pack_table_nbytes ) ;
+#endif
+
+        pr = procrec->pack_table ;
+        for ( curs = 0, i = 0 ; i < procrec->pack_table_size ; i++, pr++ )
+	{
+          if ( xpose->has_f90_fields && procrec->pack_table_size > 0 )
+            base = (void *) get_base_for_index ( pr->f90_table_index ) ;
+          else
+            base = pr->base ;
+#if 0
+fprintf(stderr,"v unpack base %08x, n %3d, nelems %d, stride %3d, f90_index %d, xpose=%d\n",
+  base,pr->n,pr->nelems,pr->stride,pr->f90_table_index,x) ;
+#endif
+          for ( j = 0 ; j < pr->nelems ; j++ )
+          {
+            bcopy(&(pbuf[curs]),
+		 (char *)(base) + pr->offset + j * pr->stride, pr->n) ;
+#if 0
+{ int iii, mloc_mz, nloc_mz, zloc_mz, x ;
+mloc_mz = 8 ;
+nloc_mz = 9 ;
+zloc_mz = 3 ;
+for ( iii = 0 ; iii < pr->n ; iii+=4 )
+{
+x = ((pr->offset + j * pr->stride + iii))/4 ;
+fprintf(stderr,"v <<< %d i %2d k %2d j %2d %f\n",
+               x ,
+               x % mloc_mz ,
+               (x % (mloc_mz*zloc_mz))/mloc_mz  ,
+               (x / (mloc_mz*zloc_mz)) ,
+               *((float *)((char *)(base) + pr->offset + j * pr->stride + iii))) ;
+}}
+#endif
+            curs += pr->n ;
+	  }
+	}
+	if ( curs == 0 )
+	{
+	  RSL_TEST_ERR(1,"internal error") ;
+	}
+        if ( curs > procrec->pack_table_nbytes )
+        {
+          sprintf(mess,"unpack buffer overflow %d > %d\n",curs,procrec->pack_table_nbytes) ;
+          RSL_TEST_ERR(1,mess) ;
+	}
+#if 0
+fprintf(stderr,"debug got message from %d and unpacked %d bytes; xpose=%d\n", Pque[tqp], curs, x ) ;
+#endif
+        typeque[tqp] = RSL_INVALID ;
+        ndone++ ;
+      }
+    }
+    tqp++ ;
+  }
+#ifdef UPSHOT
+MPE_Log_event( 16, s, "xpose end" ) ;
+#endif
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/xpose_def.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/xpose_def.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/xpose_def.c	(revision 2744)
@@ -0,0 +1,257 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl.h"
+
+/*@
+  RSL_CREATE_XPOSE -- Create a stencil descriptor.
+
+  Notes:
+  The output argument is the integer Arg1, a descriptor to 
+  a new RSL stencil.  The stencil is then built (RSL_DESCRIBE_STENCIL)
+  and used in stencil exchanges (RSL_EXCH_STENCIL) during the model
+  run.
+
+  See also:
+  RSL_DESCRIBE_STENCIL, RSL_EXCH_STENCIL
+@*/
+
+RSL_CREATE_XPOSE ( xp_p )
+  int_p xp_p ;     /* (O) New RSL xpose descriptor. */
+{
+  int i ;
+  xpose_desc_t *xpose ;
+  
+  /* NOTE: never return the 0th stencil */
+  for ( i = 1 ; i < RSL_MAXDESCRIPTORS ; i++ )
+    if ( xp_descriptors[i] == NULL ) break ;    /* got one */
+
+  RSL_TEST_ERR( i == RSL_MAXDESCRIPTORS,
+  "rsl_create_xpose:  out of descriptors.");
+
+  *xp_p = i ;
+  xpose = RSL_MALLOC(xpose_desc_t,1) ;
+  xpose->tag = XPOSE_DESC ;
+  xpose->has_f90_fields = 0 ;
+  xp_descriptors[*xp_p] = xpose ;
+  xpose->xp = *xp_p ;
+}
+
+release_xp_descriptor (xp_p)
+  int_p xp_p ;
+{
+  int xp ;
+
+  xp = *xp_p ;
+  RSL_TEST_ERR( xp < 0 || xp >= RSL_MAXDESCRIPTORS,
+                "internal error.  Invalid xpose descriptor.") ;
+  if ( xp_descriptors[xp] != NULL )
+  {
+    xp_descriptors[xp] = NULL ;
+  }
+}
+
+/*@
+  RSL_DESCRIBE_XPOSE -- Defines an RSL transpose exchange on a domain.
+
+@*/
+
+RSL_DESCRIBE_XPOSE ( d_p, xp_p, message_mn_p , message_mz_p , message_nz_p )
+  int_p d_p,            /* (I) Domain descriptor. */
+        xp_p,           /* (I) Xpose handle */
+    message_mn_p,       /* (I) Message descriptor. */
+    message_mz_p,       /* (I) Message descriptor. */
+    message_nz_p   ;    /* (I) Message descriptor. */
+{
+  int d, xp, mh ;
+  rsl_domain_info_t * dinfo ;
+  xpose_desc_t *xpose ;
+  message_desc_t *msg_mn, *msg_mz, *msg_nz ;
+  int pt ;
+
+  d = *d_p ; xp = *xp_p ;
+
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+    "rsl_describe_xpose: bad domain descriptor\n") ;
+  dinfo = &(domain_info[d]) ;
+  RSL_TEST_ERR(dinfo->valid != RSL_VALID,
+    "rsl_describe_xpose: descriptor is not for a valid domain\n") ;
+
+  RSL_TEST_ERR( xp < 0 || xp >= RSL_MAXDESCRIPTORS,
+    "rsl_describe_stencil: bad stencil handle" ) ;
+  xpose = (xpose_desc_t *) xp_descriptors[xp] ;
+  RSL_TEST_ERR( xpose->tag != XPOSE_DESC,
+       "rsl_describe_xpose: handle given is not for an rsl xpose def" ) ;
+
+  xpose->compiled[d] = 0 ;
+
+  RSL_TEST_ERR(  (*message_mn_p <= 0 || *message_mn_p >=RSL_MAXDESCRIPTORS),
+"rsl_describe_xpose: bad message handle in list,\n  must be valid message") ;
+  msg_mn = (message_desc_t *) mh_descriptors[ *message_mn_p ] ;
+  xpose->msgs_mn[d] = msg_mn ;
+
+  RSL_TEST_ERR(  (*message_mz_p <= 0 || *message_mz_p >=RSL_MAXDESCRIPTORS),
+"rsl_describe_xpose: bad message handle in list,\n  must be valid message") ;
+  msg_mz = (message_desc_t *) mh_descriptors[ *message_mz_p ] ;
+  xpose->msgs_mz[d] = msg_mz ;
+
+  RSL_TEST_ERR(  (*message_nz_p <= 0 || *message_nz_p >=RSL_MAXDESCRIPTORS),
+"rsl_describe_xpose: bad message handle in list,\n  must be valid message") ;
+  msg_nz = (message_desc_t *) mh_descriptors[ *message_nz_p ] ;
+  xpose->msgs_nz[d] = msg_nz ;
+
+  /* free up the message descriptor; it has done its job */
+  release_mh_descriptor( message_mn_p ) ;
+  release_mh_descriptor( message_mz_p ) ;
+  release_mh_descriptor( message_nz_p ) ;
+
+  /* add my descriptor to the list for the domain */
+  dinfo->xposelist[dinfo->xposecurs] = xp ;
+  dinfo->xposecurs++ ;  /* 970317 */
+
+  if ( dinfo->xposecurs >= RSL_MAXDESCRIPTORS )
+  {
+    sprintf(mess,
+     "Domain %d doesn't have room for any more xposes, but the allowable\nlimit of %d should have been more than enough.\nYou might recompile RSL with a higher setting for RSL_MAXDESCRIPTORS, but\n it's likely something else is wrong.",
+       d, RSL_MAXDESCRIPTORS ) ;
+    RSL_TEST_ERR( 1, mess ) ;
+     
+  }
+}
+
+#if 0
+/* some of these need to be converted for xposes; others need to be eliminated */
+/* only used internally within the RSL package */
+destroy_stencil( sten )
+  stencil_desc_t * sten ;
+{
+  int d ;
+  rsl_fldspec_t *fld, *doomed ;
+  if ( sten == NULL ) return ;
+  RSL_TEST_ERR( sten->tag != STENCIL_DESC, "destroy_stencil: arg not a stencil.") ;
+
+  for ( d = 0 ; d < RSL_MAXDOMAINS ; d++ )
+  {
+    destroy_stencil_on_domain( d, sten ) ;
+  }
+  release_sh_descriptor (sten->sh) ;
+  RSL_FREE( sten ) ;
+}
+
+destroy_stencil_on_domain( d, sten )
+  int d ;
+  stencil_desc_t * sten ;
+{
+  int i ;
+
+  if ( sten == NULL ) return ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "destroy_stencil_on_domain: bad domain descriptor") ;
+  for ( i = 0 ; i < RSL_MAXSTEN+1 ; i++ )
+  {
+    destroy_message( sten->msgs[d][i] ) ;
+  }
+  sten->f[d].ptfcn = NULL ;
+  sten->npts[d] = 0 ;
+  uncompile_stencil_on_domain( d, sten ) ;
+}
+
+uncompile_stencil_on_domain( d, sten )
+  int d ;
+  stencil_desc_t * sten ;
+{
+  int i ;
+
+  if ( sten == NULL ) return ;
+  RSL_TEST_ERR( d < 0 || d >= RSL_MAXDOMAINS,
+     "uncompile_stencil_on_domain: bad domain descriptor") ;
+  sten->compiled[d] = 0 ;
+  destroy_procrec_list( sten->procs[d] ) ;
+  sten->procs[d] = NULL ; /* 970317 */
+}
+
+destroy_procrec_list( prec )
+  rsl_procrec_t *prec ;
+{ 
+  rsl_procrec_t *p, *doomed ;
+  int destroy_ptrec_list() ;
+  if ( prec == NULL ) return ;
+  for ( p = prec ; p != NULL ; )
+  {
+    doomed = p ;
+    p = p->next ;
+    destroy_list( &(doomed->point_list), destroy_ptrec_list ) ;
+    RSL_FREE(doomed) ;
+  }
+}
+
+destroy_ptrec_list( ptrec )
+  rsl_ptrec_t *ptrec ;
+{
+  rsl_ptrec_t *p, *doomed ;
+  if ( ptrec == NULL ) return ;
+  for ( p = ptrec ; p != NULL ; )
+  {
+    doomed = p ;
+    p = p->next ;
+    destroy_list( &(doomed->send_messages), NULL ) ;
+    destroy_list( &(doomed->recv_messages), NULL ) ;
+    RSL_FREE(doomed) ;
+  }
+}
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/RSL/RSL/xpose_def.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/RSL/xpose_def.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/RSL/xpose_def.h	(revision 2744)
@@ -0,0 +1,75 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+
+
+#ifndef XPOSE_DEF_H
+#define XPOSE_DEF_H
+
+typedef struct xpose_desc {
+  rsl_tag_t tag;               
+  int xp ;		/* my descriptor */
+  int has_f90_fields ;
+  rsl_tag_t compiled[RSL_MAXDOMAINS];
+  rsl_tag_t npts[RSL_MAXDOMAINS] ;
+        /* 0 is from, 1 is to */
+  message_desc_t *msgs_mn[RSL_MAXDOMAINS] ;
+  message_desc_t *msgs_mz[RSL_MAXDOMAINS] ;
+  message_desc_t *msgs_nz[RSL_MAXDOMAINS] ;
+  rsl_procrec_t *procs[RSL_MAXDOMAINS][3] ; /* XPOSE_MN_MZ, XPOSE_MZ_NZ, or XPOSE_MN_NZ */
+} xpose_desc_t ;
+
+#endif  /* nothing after this line */
Index: trunk/WRF.COMMON/WRFV2/external/RSL/gen_comms.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/gen_comms.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/gen_comms.c	(revision 2744)
@@ -0,0 +1,1243 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+/* For detecting variables that are members of a derived type */
+#define NULLCHARPTR   (char *) 0
+static int parent_type;
+
+int
+gen_halos ( char * dirname )
+{
+  node_t * p, * q ;
+  node_t * dimd ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char tmp[4096], tmp2[4096], tmp3[4096] ;
+  char commuse[4096] ;
+  int maxstenwidth, stenwidth ;
+  FILE * fp ;
+  char * t1, * t2 ;
+  char * pos1 , * pos2 ;
+  char indices[NAMELEN], post[NAMELEN], varref[NAMELEN] ;
+  int zdex ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  for ( p = Halos ; p != NULL ; p = p->next )
+  {
+    strcpy( commname, p->name ) ;
+    make_upper_case(commname) ;
+    if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s.inc",dirname,commname) ; }
+    else                       { sprintf(fname,"%s.inc",commname) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) 
+    {
+      fprintf(stderr,"WARNING: gen_halos in registry cannot open %s for writing\n",fname ) ;
+      continue ; 
+    }
+    /* get maximum stencil width */
+    maxstenwidth = 0 ;
+    strcpy( tmp, p->comm_define ) ;
+    t1 = strtok_rentr( tmp , "; " , &pos1 ) ;
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ": " , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for halo %s\n", commname ) ; exit(1) ; }
+      stenwidth = atoi (t2) ;
+      if ( stenwidth == 0 )
+       { fprintf(stderr,"* unparseable description for halo %s\n", commname ) ; exit(1) ; }
+      if ( stenwidth > maxstenwidth ) maxstenwidth = stenwidth ;
+      t1 = strtok_rentr( NULL , "; " , &pos1 ) ;
+    }
+    print_warning(fp,fname) ;
+    fprintf(fp,"#ifndef DATA_CALLS_INCLUDED\n") ;
+    fprintf(fp,"--- DELIBERATE SYNTAX ERROR: THIS ROUTINE SHOULD INCLUDE \"%s_data_calls.inc\"\n",p->use+4) ;
+    fprintf(fp,"    BECAUSE IT CONTAINS AN RSL HALO OPERATION\n" ) ;
+    fprintf(fp,"#endif\n") ;
+
+    fprintf(fp,"IF ( grid%%comms( %s ) == invalid_message_value ) THEN\n",commname ) ;
+    fprintf(fp,"  CALL wrf_debug ( 50 , 'set up halo %s' )\n",commname ) ;
+    fprintf(fp,"  CALL setup_halo_rsl( grid )\n" ) ;
+    fprintf(fp,"  CALL reset_msgs_%dpt\n", maxstenwidth ) ;
+
+    /* pass through description again now and generate the calls  */
+    strcpy( tmp, p->comm_define ) ;
+    strcpy( commuse, p->use ) ;
+    t1 = strtok_rentr( tmp , "; " , &pos1 ) ;
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ": " , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for halo %s\n", commname ) ; continue ; }
+      stenwidth = atoi (t2) ;
+      t2 = strtok_rentr(NULL,", ", &pos2) ;
+
+      while ( t2 != NULL )
+      {
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )
+        {
+          fprintf(stderr,"WARNING 1 : %s in halo spec %s (%s) is not defined in registry.\n",t2,commname, commuse) ;
+        }
+        else
+        {
+
+          strcpy( varref, t2 ) ;
+          if ( q->node_kind & FIELD  && ! (q->node_kind & I1) ) {
+             if ( !strncmp( q->use,  "dyn_", 4 )) {
+                  char * core ;
+                  core = q->use+4 ;
+                  sprintf(varref,"grid%%%s_%s",core,t2) ;
+             } else {
+                  sprintf(varref,"grid%%%s",t2) ;
+             }
+          }
+
+          if      (  strcmp( q->type->name, "real") && strcmp( q->type->name, "integer") && strcmp( q->type->name, "doubleprecision") )
+          {
+            fprintf(stderr,"WARNING: only type 'real', 'doubleprecision', or 'integer' can be part of halo exchange. %s in %s is %s\n",t2,commname,q->type->name) ;
+          }
+          else if ( q->boundary_array )
+          {
+            fprintf(stderr,"WARNING: boundary array %s cannot be member of halo spec %s.\n",t2,commname) ;
+          }
+          else
+          {
+            if ( q->node_kind & FOURD )
+            {
+              node_t *member ;
+              zdex = get_index_for_coord( q , COORD_Z ) ;
+              if ( zdex >=1 && zdex <= 3 )
+              {
+                for ( member = q->members ; member != NULL ; member = member->next )
+                {
+                  if ( strcmp( member->name, "-" ) )
+                  {
+                    fprintf(fp,"  if ( P_%s .GT. 1 ) CALL add_msg_%dpt_%s ( %s ( grid%%sm31,grid%%sm32,grid%%sm33,P_%s), glen(%d) )\n", 
+                       member->name, stenwidth, q->type->name, t2 , member->name, zdex+1 ) ;
+                  }
+                }
+              }
+              else
+              {
+                fprintf(stderr,"WARNING: %d some dimension info missing for 4d array %s\n",zdex,t2) ;
+              }
+            }
+            else
+            {
+              strcpy (indices,"");
+              if ( sw_deref_kludge ) /* &&  strchr (t2, '%') != NULLCHARPTR ) */
+              {
+                sprintf(post,")") ;
+                sprintf(indices, "%s",index_with_firstelem("(","",tmp3,q,post)) ;
+              }
+              dimd = get_dimnode_for_coord( q , COORD_Z ) ;
+              zdex = get_index_for_coord( q , COORD_Z ) ;
+              if ( dimd != NULL )
+              {
+                char dimstrg[256] ;
+
+                if      ( dimd->len_defined_how == DOMAIN_STANDARD )
+                    sprintf(dimstrg,"(glen(%d))",zdex+1) ;
+                else if ( dimd->len_defined_how == NAMELIST )
+                {
+                  if ( !strcmp(dimd->assoc_nl_var_s,"1") )
+                    sprintf(dimstrg,"config_flags%%%s",dimd->assoc_nl_var_e) ;
+                  else
+                    sprintf(dimstrg,"(config_flags%%%s - config_flags%%%s + 1)",dimd->assoc_nl_var_e,dimd->assoc_nl_var_s) ;
+                }
+                else if ( dimd->len_defined_how == CONSTANT )
+                    sprintf(dimstrg,"(%d - %d + 1)",dimd->coord_end,dimd->coord_start) ;
+
+                fprintf(fp,"  CALL add_msg_%dpt_%s ( %s%s , %s )\n", stenwidth, q->type->name, varref, indices, dimstrg ) ;
+              }
+              else if ( q->ndims == 2 )  /* 2d */
+              {
+                fprintf(fp,"  CALL add_msg_%dpt_%s ( %s%s , %s )\n", stenwidth, q->type->name, varref, indices, "1" ) ;
+              }
+            }
+          }
+          q->subject_to_communication = 1 ;         /* Indicate that this field may be communicated */
+        }
+        t2 = strtok_rentr( NULL , ", " , &pos2 ) ;
+      }
+      t1 = strtok_rentr( NULL , "; " , &pos1 ) ;
+    }
+    fprintf(fp,"  CALL stencil_%dpt ( grid%%domdesc , grid%%comms ( %s ) )\n", maxstenwidth , commname ) ;
+    fprintf(fp,"ENDIF\n") ;
+    fprintf(fp,"  CALL wrf_debug ( 50 , 'exchange halo %s' )\n",commname ) ;
+    fprintf(fp,"CALL rsl_exch_stencil ( grid%%domdesc , grid%%comms( %s ) )\n", commname ) ;
+
+    close_the_file(fp) ;
+  }
+  return(0) ;
+}
+
+int
+gen_periods ( char * dirname )
+{
+  node_t * p, * q ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char indices[NAMELEN], post[NAMELEN], varref[NAMELEN] ;
+  char tmp[4096], tmp2[4096], tmp3[4096], commuse[4096] ;
+  int maxperwidth, perwidth ;
+  FILE * fp ;
+  char * t1, * t2 ;
+  char * pos1 , * pos2 ;
+  node_t * dimd ;
+  int zdex ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  for ( p = Periods ; p != NULL ; p = p->next )
+  {
+    strcpy( commname, p->name ) ;
+    make_upper_case(commname) ;
+    if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s.inc",dirname,commname) ; }
+    else                       { sprintf(fname,"%s.inc",commname) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) 
+    {
+      fprintf(stderr,"WARNING: gen_periods in registry cannot open %s for writing\n",fname ) ;
+      continue ; 
+    }
+    /* get maximum stencil width */
+    maxperwidth = 0 ;
+    strcpy( tmp, p->comm_define ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for halo %s\n", commname ) ; exit(1) ; }
+      perwidth = atoi (t2) ;
+      if ( perwidth > maxperwidth ) maxperwidth = perwidth ;
+      t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+    }
+    print_warning(fp,fname) ;
+
+    fprintf(fp,"#ifndef DATA_CALLS_INCLUDED\n") ;
+    fprintf(fp,"--- DELIBERATE SYNTAX ERROR: THIS ROUTINE SHOULD INCLUDE \"%s_data_calls.inc\"\n",p->use+4) ;
+    fprintf(fp,"    BECAUSE IT CONTAINS AN RSL PERIOD OPERATION\n" ) ;
+    fprintf(fp,"#endif\n") ;
+    fprintf(fp,"IF ( grid%%comms( %s ) == invalid_message_value .AND. (config_flags%%periodic_x .OR. config_flags%%periodic_y )) THEN\n",commname ) ;
+
+    fprintf(fp,"  CALL wrf_debug ( 50 , 'setting up period %s' )\n",commname ) ;
+    fprintf(fp,"  CALL setup_period_rsl( grid )\n" ) ;
+    fprintf(fp,"  CALL reset_period\n") ;
+
+    /* pass through description again now and generate the calls  */
+    strcpy( tmp, p->comm_define ) ;
+    strcpy( commuse, p->use ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for period %s\n", commname ) ; continue ; }
+      perwidth = atoi (t2) ;
+      t2 = strtok_rentr(NULL,",", &pos2) ;
+      while ( t2 != NULL )
+      {
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )
+        {
+          fprintf(stderr,"WARNING 2 : %s in period spec %s is not defined in registry.\n",t2,commname) ;
+        }
+        else
+        {
+          if ( q->boundary_array )
+          {
+            fprintf(stderr,"WARNING: boundary array %s cannot be member of period spec %s.\n",t2,commname) ;
+          }
+          else
+          {
+
+            strcpy( varref, t2 ) ;
+            if ( q->node_kind & FIELD  && ! (q->node_kind & I1) ) {
+               if ( !strncmp( q->use,  "dyn_", 4 )) {
+                    char * core ;
+                    core = q->use+4 ;
+                    sprintf(varref,"grid%%%s_%s",core,t2) ;
+               } else {
+                    sprintf(varref,"grid%%%s",t2) ;
+               }
+            }
+
+            if ( q->node_kind & FOURD )
+            {
+              node_t *member ;
+              zdex = get_index_for_coord( q , COORD_Z ) ;
+              if ( zdex >=1 && zdex <= 3 )
+              {
+                for ( member = q->members ; member != NULL ; member = member->next )
+                {
+                  if ( strcmp( member->name, "-" ) )
+                  {
+                    fprintf(fp,"  if ( P_%s .GT. 1 ) CALL add_msg_period_%s ( %s ( grid%%sm31,grid%%sm32,grid%%sm33,P_%s), glen(%d) )\n",
+                       member->name, q->type->name, t2 , member->name, zdex+1 ) ;
+                  }
+                }
+              }
+              else
+              {
+                fprintf(stderr,"WARNING: %d some dimension info missing for 4d array %s\n",zdex,t2) ;
+              }
+            }
+            else
+            {
+              strcpy (indices,"");
+              if ( sw_deref_kludge ) /* &&  strchr (t2, '%') != NULLCHARPTR ) */
+              {
+                sprintf(post,")") ;
+                sprintf(indices, "%s",index_with_firstelem("(","",tmp3,q,post)) ;
+              }
+              dimd = get_dimnode_for_coord( q , COORD_Z ) ;
+              zdex = get_index_for_coord( q , COORD_Z ) ;
+              if ( dimd != NULL )
+              {
+                char dimstrg[256] ;
+
+                if      ( dimd->len_defined_how == DOMAIN_STANDARD )
+                    sprintf(dimstrg,"(glen(%d))",zdex+1) ;
+                else if ( dimd->len_defined_how == NAMELIST )
+                {
+                  if ( !strcmp(dimd->assoc_nl_var_s,"1") )
+                    sprintf(dimstrg,"config_flags%%%s",dimd->assoc_nl_var_e) ;
+                  else
+                    sprintf(dimstrg,"(config_flags%%%s - config_flags%%%s + 1)",dimd->assoc_nl_var_e,dimd->assoc_nl_var_s) ;
+                }
+                else if ( dimd->len_defined_how == CONSTANT )
+                    sprintf(dimstrg,"(%d - %d + 1)",dimd->coord_end,dimd->coord_start) ;
+
+                fprintf(fp,"  CALL add_msg_period_%s ( %s%s , %s )\n", q->type->name, varref, indices, dimstrg ) ;
+              }
+              else if ( q->ndims == 2 )  /* 2d */
+              {
+                fprintf(fp,"  CALL add_msg_period_%s ( %s%s , %s )\n", q->type->name, varref, indices, "1" ) ;
+              }
+            }
+          }
+          q->subject_to_communication = 1 ;         /* Indicate that this field may be communicated */
+        }
+        t2 = strtok_rentr( NULL , "," , &pos2 ) ;
+      }
+      t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+    }
+    fprintf(fp,"  CALL period_def ( grid%%domdesc , grid%%comms ( %s ) , %d )\n",commname , maxperwidth ) ;
+    fprintf(fp,"ENDIF\n") ;
+    fprintf(fp,"IF ( config_flags%%periodic_x ) THEN\n") ; 
+    fprintf(fp,"  CALL wrf_debug ( 50 , 'exchanging period %s on x' )\n",commname ) ;
+    fprintf(fp,"  CALL rsl_exch_period ( grid%%domdesc , grid%%comms( %s ) , x_period_flag )\n",commname ) ;
+    fprintf(fp,"END IF\n") ; 
+    fprintf(fp,"IF ( config_flags%%periodic_y ) THEN\n") ;
+    fprintf(fp,"  CALL wrf_debug ( 50 , 'exchanging period %s on y' )\n",commname ) ;
+    fprintf(fp,"  CALL rsl_exch_period ( grid%%domdesc , grid%%comms( %s ) , y_period_flag )\n",commname ) ;
+    fprintf(fp,"END IF\n") ;
+
+    close_the_file(fp) ;
+  }
+  return(0) ;
+}
+
+int
+gen_xposes ( char * dirname )
+{
+  node_t * p, * q ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char tmp[4096], tmp2[4096], tmp3[4096] ;
+  char commuse[4096] ;
+  FILE * fp ;
+  char * t1, * t2 ;
+  char * pos1 , * pos2 ;
+  char *xposedir[] = { "z2x" , "x2z" , "x2y" , "y2x" , "z2y" , "y2z" , 0L } ;
+  char ** x ;
+  char indices[NAMELEN], post[NAMELEN], varname[NAMELEN], varref[NAMELEN] ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  for ( p = Xposes ; p != NULL ; p = p->next )
+  {
+    for ( x = xposedir ; *x ; x++ )
+    {
+      strcpy( commname, p->name ) ;
+      make_upper_case(commname) ;
+      if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s_%s.inc",dirname,commname, *x) ; }
+      else                       { sprintf(fname,"%s_%s.inc",commname,*x) ; }
+      if ((fp = fopen( fname , "w" )) == NULL ) 
+      {
+        fprintf(stderr,"WARNING: gen_halos in registry cannot open %s for writing\n",fname ) ;
+        continue ; 
+      }
+
+      print_warning(fp,fname) ;
+      fprintf(fp,"#ifndef DATA_CALLS_INCLUDED\n") ;
+      fprintf(fp,"--- DELIBERATE SYNTAX ERROR: THIS ROUTINE SHOULD INCLUDE \"%s_data_calls.inc\"\n",p->use+4) ;
+      fprintf(fp,"    BECAUSE IT CONTAINS AN RSL TRANSPOSE OPERATION\n" ) ;
+      fprintf(fp,"#endif\n") ;
+      fprintf(fp,"IF ( grid%%comms( %s ) == invalid_message_value ) THEN\n",commname ) ;
+
+      fprintf(fp,"  CALL wrf_debug ( 50 , 'setting up xpose %s' )\n",commname ) ;
+      fprintf(fp,"  CALL setup_xpose_rsl( grid )\n") ;
+      fprintf(fp,"  CALL reset_msgs_xpose\n" ) ;
+
+      strcpy( tmp, p->comm_define ) ;
+      strcpy( commuse, p->use ) ;
+      t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+      while ( t1 != NULL )
+      {
+        strcpy( tmp2 , t1 ) ;
+
+/* Z array */
+        t2 = strtok_rentr(tmp2,",", &pos2) ;
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )    
+         { fprintf(stderr,"WARNING 3 : %s in xpose spec %s (%s) is not defined in registry.\n",t2,commname,commuse) ; goto skiperific ; }
+        strcpy( varref, t2 ) ;
+        if ( q->node_kind & FIELD  && ! (q->node_kind & I1) ) {
+           if ( !strncmp( q->use,  "dyn_", 4 )) {
+                char * core ;
+                core = q->use+4 ;
+                sprintf(varref,"grid%%%s_%s",core,t2) ;
+           } else {
+                sprintf(varref,"grid%%%s",t2) ;
+           }
+        }
+        if ( q->proc_orient != ALL_Z_ON_PROC ) 
+         { fprintf(stderr,"WARNING: %s in xpose spec %s is not ALL_Z_ON_PROC.\n",t2,commname) ; goto skiperific ; }
+        if ( q->ndims != 3 )
+         { fprintf(stderr,"WARNING: boundary array %s must be 3D to be member of xpose spec %s.\n",t2,commname) ; goto skiperific ; }
+        if ( q->boundary_array )
+         { fprintf(stderr,"WARNING: boundary array %s cannot be member of xpose spec %s.\n",t2,commname) ; goto skiperific ; }
+        strcpy (indices,"");
+        if ( sw_deref_kludge &&  strchr (t2, '%') != NULLCHARPTR )
+        {
+          sprintf(post,")") ;
+          sprintf(indices, "%s",index_with_firstelem("(","",tmp3,q,post)) ;
+        }
+        fprintf(fp," CALL add_msg_xpose_%s ( %s%s ,", q->type->name, varref,indices ) ;
+        q->subject_to_communication = 1 ;         /* Indicate that this field may be communicated */
+
+/* X array */
+        t2 = strtok_rentr( NULL , "," , &pos2 ) ;
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )    
+         { fprintf(stderr,"WARNING 4 : %s in xpose spec %s (%s) is not defined in registry.\n",t2,commname,commuse) ; goto skiperific ; }
+        strcpy( varref, t2 ) ;
+        if ( q->node_kind & FIELD  && ! (q->node_kind & I1) ) {
+           if ( !strncmp( q->use,  "dyn_", 4 )) {
+                char * core ;
+                core = q->use+4 ;
+                sprintf(varref,"grid%%%s_%s",core,t2) ;
+           } else {
+                sprintf(varref,"grid%%%s",t2) ;
+           }
+        }
+        if ( q->proc_orient != ALL_X_ON_PROC ) 
+         { fprintf(stderr,"WARNING: %s in xpose spec %s is not ALL_X_ON_PROC.\n",t2,commname) ; goto skiperific ; }
+        if ( q->ndims != 3 )
+         { fprintf(stderr,"WARNING: boundary array %s must be 3D to be member of xpose spec %s.\n",t2,commname) ; goto skiperific ; }
+        if ( q->boundary_array )
+         { fprintf(stderr,"WARNING: boundary array %s cannot be member of xpose spec %s.\n",t2,commname) ; goto skiperific ; }
+        strcpy (indices,"");
+        if ( sw_deref_kludge &&  strchr (t2, '%') != NULLCHARPTR )
+        {
+          sprintf(post,")") ;
+          sprintf(indices, "%s",index_with_firstelem("(","",tmp3,q,post)) ;
+        }
+        fprintf(fp," %s%s ,", varref, indices ) ;
+        q->subject_to_communication = 1 ;         /* Indicate that this field may be communicated */
+
+/* Y array */
+        t2 = strtok_rentr( NULL , "," , &pos2 ) ;
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )    
+         { fprintf(stderr,"WARNING 5 : %s in xpose spec %s (%s)is not defined in registry.\n",t2,commname,commuse) ; goto skiperific ; }
+        strcpy( varref, t2 ) ;
+        if ( q->node_kind & FIELD  && ! (q->node_kind & I1) ) {
+           if ( !strncmp( q->use,  "dyn_", 4 )) {
+                char * core ;
+                core = q->use+4 ;
+                sprintf(varref,"grid%%%s_%s",core,t2) ;
+           } else {
+                sprintf(varref,"grid%%%s",t2) ;
+           }
+        }
+        if ( q->proc_orient != ALL_Y_ON_PROC ) 
+         { fprintf(stderr,"WARNING: %s in xpose spec %s is not ALL_Y_ON_PROC.\n",t2,commname) ; goto skiperific ; }
+        if ( q->ndims != 3 )
+         { fprintf(stderr,"WARNING: boundary array %s must be 3D to be member of xpose spec %s.\n",t2,commname) ; goto skiperific ; }
+        if ( q->boundary_array )
+         { fprintf(stderr,"WARNING: boundary array %s cannot be member of xpose spec %s.\n",t2,commname) ; goto skiperific ; }
+        strcpy (indices,"");
+        if ( sw_deref_kludge &&  strchr (t2, '%') != NULLCHARPTR )
+        {
+          sprintf(post,")") ;
+          sprintf(indices, "%s",index_with_firstelem("(","",tmp3,q,post)) ;
+        }
+        fprintf(fp," %s%s , 3 )\n", varref, indices ) ;
+        q->subject_to_communication = 1 ;         /* Indicate that this field may be communicated */
+        t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+      }
+      fprintf(fp,"  CALL define_xpose ( grid%%domdesc , grid%%comms ( %s ) )\n", commname ) ;
+      fprintf(fp,"ENDIF\n") ;
+      fprintf(fp,"CALL wrf_debug ( 50 , 'calling wrf_dm_xpose_%s for %s')\n",*x,commname ) ;
+      fprintf(fp,"CALL wrf_dm_xpose_%s ( grid%%domdesc , grid%%comms, %s )\n", *x , commname ) ;
+
+      close_the_file(fp) ;
+    }
+skiperific:
+    ;
+  }
+  return(0) ;
+}
+
+int
+gen_comm_descrips ( char * dirname )
+{
+  node_t * p ;
+  char * fn = "dm_comm_cpp_flags" ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  FILE * fp ;
+  int ncomm ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  else                       { sprintf(fname,"%s",fn) ; }
+
+  if ((fp = fopen( fname , "w" )) == NULL )
+  {
+    fprintf(stderr,"WARNING: gen_comm_descrips in registry cannot open %s for writing\n",fname ) ;
+  }
+
+  ncomm = 1 ;
+  for ( p = Halos ; p != NULL ; p = p->next )
+  {
+    strcpy( commname, p->name ) ;
+    make_upper_case(commname) ;
+    fprintf(fp,"-D%s=%d\n",commname,ncomm++) ;
+  }
+  for ( p = Periods ; p != NULL ; p = p->next )
+  {
+    strcpy( commname, p->name ) ;
+    make_upper_case(commname) ;
+    fprintf(fp,"-D%s=%d\n",commname,ncomm++) ;
+  }
+  for ( p = Xposes ; p != NULL ; p = p->next )
+  {
+    strcpy( commname, p->name ) ;
+    make_upper_case(commname) ;
+    fprintf(fp,"-D%s=%d\n",commname,ncomm++) ;
+  }
+  fprintf(fp,"-DWRF_RSL_NCOMMS=%d\n",ncomm-1 ) ;
+  return(0) ;
+}
+
+/*
+
+
+
+*/
+
+/* for each core, generate the halo updates to allow shifting all state data */
+int
+gen_shift (  char * dirname )
+{
+  int i, ncore ;
+  FILE * fp ;
+  node_t *p, *q, *dimd ;
+  char * corename ;
+  char **direction ;
+  char *directions[] = { "x", "y", 0L } ;
+  char fname[NAMELEN], vname[NAMELEN], vname2[NAMELEN], core[NAMELEN] ;
+  char indices[NAMELEN], post[NAMELEN], tmp3[NAMELEN] ;
+  int zdex ;
+int said_it = 0 ;
+
+  for ( direction = directions ; *direction != NULL ; direction++ )
+  {
+  for ( ncore = 0 ; ncore < get_num_cores() ; ncore++ )
+  {
+    corename = get_corename_i(ncore) ;
+    if ( dirname == NULL || corename == NULL ) return(1) ;
+    if ( strlen(dirname) > 0 )
+     { sprintf(fname,"%s/%s_shift_halo_%s.inc",dirname,corename,*direction) ; }
+    else
+     { sprintf(fname,"%s_shift_halo_%s.inc",corename,*direction) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+    print_warning(fp,fname) ;
+    fprintf(fp,"IF ( grid%%shift_%s == invalid_message_value ) THEN\n",*direction ) ;
+    fprintf(fp,"  CALL wrf_debug ( 50 , 'set up halo for %s shift' )\n",*direction ) ;
+    fprintf(fp,"  CALL setup_halo_rsl( grid )\n" ) ;
+    fprintf(fp,"  CALL reset_msgs_%s_shift\n", *direction ) ;
+
+    for ( p = Domain.fields ; p != NULL ; p = p->next )
+    {
+
+/* special cases in WRF */
+if ( !strcmp( p->name , "xf_ens" ) || !strcmp( p->name , "pr_ens" ) ||
+     !strcmp( p->name , "abstot" ) || !strcmp( p->name , "absnxt" ) ||
+     !strcmp( p->name , "emstot" ) || !strcmp( p->name , "obs_savwt" ) ) {
+  if ( sw_move && ! said_it ) { fprintf(stderr,"Info only - not an error: Moving nests not implemented for Grell Ens. Cumulus\n") ;
+                                fprintf(stderr,"Info only - not an error: Moving nests not implemented for CAM radiation\n") ;
+                                fprintf(stderr,"Info only - not an error: Moving nests not implemented for Observation Nudging\n") ;
+  said_it = 1 ; }
+  continue ;
+}
+
+      if (( p->node_kind & (FIELD | FOURD) ) && p->ndims >= 2 && ! p->boundary_array &&
+	  ((!strncmp(p->use,"dyn_",4) && !strcmp(corename,p->use+4)) || strncmp(p->use,"dyn_",4)))
+      {
+
+        if ( p->node_kind & FOURD ) {
+          sprintf(core,"") ;
+        } else {
+          if (!strncmp( p->use, "dyn_", 4))   sprintf(core,"%s_",corename) ;
+          else                                sprintf(core,"") ;
+        }
+
+/* make sure that the only things we are shifting are arrays that have a decomposed X and a Y dimension */
+        if ( get_dimnode_for_coord( p , COORD_X ) && get_dimnode_for_coord( p , COORD_Y ) ) {
+	  if ( p->type->type_type == SIMPLE )
+	  {
+	    for ( i = 1 ; i <= p->ntl ; i++ )
+	    {
+              if ( p->ntl > 1 ) sprintf(vname,"%s_%d",p->name,i ) ;
+              else              sprintf(vname,"%s",p->name ) ;
+              if ( p->ntl > 1 ) sprintf(vname2,"%s%s_%d",core,p->name,i ) ;
+              else              sprintf(vname2,"%s%s",core,p->name ) ;
+	      if ( p->node_kind & FOURD )
+              {
+                node_t *member ;
+                zdex = get_index_for_coord( p , COORD_Z ) ;
+                if ( zdex >=1 && zdex <= 3 )
+                {
+                  for ( member = p->members ; member != NULL ; member = member->next )
+                  {
+                    if ( strcmp( member->name, "-" ) )
+                    {
+                      fprintf(fp,
+   "  if ( P_%s .GT. 1 ) CALL add_msg_%s_shift_%s ( %s ( grid%%sm31,grid%%sm32,grid%%sm33,P_%s), glen(%d) )\n",
+                         member->name, *direction, p->type->name, vname, member->name, zdex+1 ) ;
+                      p->subject_to_communication = 1 ;
+                    }
+                  }
+                }
+                else
+                {
+                  fprintf(stderr,"WARNING: %d some dimension info missing for 4d array %s\n",zdex,t2) ;
+                }
+              }
+              else
+	      {
+                strcpy (indices,"");
+                if ( sw_deref_kludge ) /* &&  strchr (p->name, '%') != NULLCHARPTR ) */
+                {
+                  sprintf(post,")") ;
+                  sprintf(indices, "%s",index_with_firstelem("(","",tmp3,p,post)) ;
+                }
+                dimd = get_dimnode_for_coord( p , COORD_Z ) ;
+                zdex = get_index_for_coord( p , COORD_Z ) ;
+                if ( dimd != NULL )
+                {
+                  char dimstrg[256] ;
+
+                  if      ( dimd->len_defined_how == DOMAIN_STANDARD )
+                      sprintf(dimstrg,"(glen(%d))",zdex+1) ;
+                  else if ( dimd->len_defined_how == NAMELIST )
+                  {
+                    if ( !strcmp(dimd->assoc_nl_var_s,"1") )
+                      sprintf(dimstrg,"config_flags%%%s",dimd->assoc_nl_var_e) ;
+                    else
+                      sprintf(dimstrg,"(config_flags%%%s - config_flags%%%s + 1)",dimd->assoc_nl_var_e,dimd->assoc_nl_var_s) ;
+                  }
+                  else if ( dimd->len_defined_how == CONSTANT )
+                      sprintf(dimstrg,"(%d - %d + 1)",dimd->coord_end,dimd->coord_start) ;
+  
+                  fprintf(fp,"  CALL add_msg_%s_shift_%s ( grid%%%s%s , %s )\n", *direction, p->type->name, vname2, indices, dimstrg ) ;
+                  p->subject_to_communication = 1 ;
+                }
+                else if ( p->ndims == 2 )  /* 2d */
+                {
+                  fprintf(fp,"  CALL add_msg_%s_shift_%s ( grid%%%s%s , %s )\n", *direction, p->type->name, vname2, indices, "1" ) ;
+                  p->subject_to_communication = 1 ;
+                }
+              }
+            }
+	  }
+	}
+      }
+    }
+    fprintf(fp,"  CALL stencil_%s_shift ( grid%%domdesc , grid%%shift_%s )\n", *direction , *direction ) ;
+    fprintf(fp,"ENDIF\n") ;
+    fprintf(fp,"  CALL wrf_debug ( 50 , 'exchange halo for %s shift' )\n",*direction ) ;
+    fprintf(fp,"CALL rsl_exch_stencil ( grid%%domdesc , grid%%shift_%s )\n", *direction ) ;
+
+    for ( p = Domain.fields ; p != NULL ; p = p->next )
+    {
+
+/* special cases in WRF */
+if ( !strcmp( p->name , "xf_ens" ) || !strcmp( p->name , "pr_ens" ) ||
+     !strcmp( p->name , "abstot" ) || !strcmp( p->name , "absnxt" ) ||
+     !strcmp( p->name , "emstot" ) || !strcmp( p->name , "obs_savwt" ) ) {
+  continue ;
+}
+      if ( p->node_kind & FOURD ) {
+        sprintf(core,"") ;
+      } else {
+        if (!strncmp( p->use, "dyn_", 4))   sprintf(core,"%s_",corename) ;
+        else                                sprintf(core,"") ;
+      }
+
+      if (( p->node_kind & (FIELD | FOURD) ) && p->ndims >= 2 && ! p->boundary_array &&
+	  ((!strncmp(p->use,"dyn_",4) && !strcmp(corename,p->use+4)) || strncmp(p->use,"dyn_",4)))
+      {
+/* make sure that the only things we are shifting are arrays that have a decomposed X and a Y dimension */
+        if ( get_dimnode_for_coord( p , COORD_X ) && get_dimnode_for_coord( p , COORD_Y ) ) {
+  	  if ( p->type->type_type == SIMPLE )
+	  {
+	    for ( i = 1 ; i <= p->ntl ; i++ )
+	    {
+              if ( p->ntl > 1 ) sprintf(vname,"%s_%d",p->name,i ) ;
+              else              sprintf(vname,"%s",p->name ) ;
+              if ( p->ntl > 1 ) sprintf(vname2,"%s%s_%d",core,p->name,i ) ;
+              else              sprintf(vname2,"%s%s",core,p->name ) ;
+
+	      if ( p->node_kind & FOURD )
+              {
+                node_t *member ;
+                zdex = get_index_for_coord( p , COORD_Z ) ;
+                if ( zdex >=1 && zdex <= 3 )
+                {
+                  for ( member = p->members ; member != NULL ; member = member->next )
+                  {
+                    if ( strcmp( member->name, "-" ) )
+                    {
+                      if ( !strcmp( *direction, "x" ) )
+                      {
+                        fprintf(fp,
+   "  if ( P_%s .GT. 1 ) %s ( ips:min(ide%s,ipe),:,jms:jme,P_%s) = %s (ips+px:min(ide%s,ipe)+px,:,jms:jme,P_%s)\n",
+                         member->name, vname, member->stag_x?"":"-1", member->name, vname, member->stag_x?"":"-1", member->name ) ;
+                      }
+                      else
+                      {
+                        fprintf(fp,
+   "  if ( P_%s .GT. 1 ) %s ( ims:ime,:,jps:min(jde%s,jpe),P_%s) = %s (ims:ime,:,jps+py:min(jde%s,jpe)+py,P_%s)\n",
+                         member->name, vname, member->stag_y?"":"-1", member->name, vname, member->stag_y?"":"-1", member->name ) ;
+                      }
+                    }
+                  }
+                }
+                else
+                {
+                  fprintf(stderr,"WARNING: %d some dimension info missing for 4d array %s\n",zdex,t2) ;
+                }
+              }
+              else
+	      {
+	        char * vdim ;
+	        vdim = "" ;
+	        if ( p->ndims == 3 ) vdim = ":," ;
+                if ( !strcmp( *direction, "x" ) )
+                {
+                  fprintf(fp,"grid%%%s (ips:min(ide%s,ipe),%sjms:jme) = grid%%%s (ips+px:min(ide%s,ipe)+px,%sjms:jme)\n", vname2,  p->stag_x?"":"-1", vdim, vname2, p->stag_x?"":"-1", vdim ) ;
+                }
+                else
+	        {
+                  fprintf(fp,"grid%%%s (ims:ime,%sjps:min(jde%s,jpe)) = grid%%%s (ims:ime,%sjps+py:min(jde%s,jpe)+py)\n", vname2, vdim,  p->stag_y?"":"-1", vname2, vdim, p->stag_y?"":"-1" ) ;
+                }
+              }
+            }
+	  }
+	}
+      }
+    }
+    close_the_file(fp) ;
+  }
+  }
+}
+
+int
+gen_datacalls ( char * dirname )
+{
+  int i ;
+  FILE * fp ;
+  char * corename ;
+  char * fn = "data_calls.inc" ;
+  char fname[NAMELEN] ;
+
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+  {
+    corename = get_corename_i(i) ;
+    if ( dirname == NULL || corename == NULL ) return(1) ;
+    if ( strlen(dirname) > 0 )
+     { sprintf(fname,"%s/%s_%s",dirname,corename,fn) ; }
+    else
+     { sprintf(fname,"%s_%s",corename,fn) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+    print_warning(fp,fname) ;
+    fprintf(fp," CALL rsl_start_register_f90\n") ;
+    parent_type = SIMPLE;
+    gen_datacalls1( fp , corename, "grid%", FIELD , Domain.fields ) ;
+    gen_datacalls1( fp , corename, "", FOURD , Domain.fields ) ;
+    fprintf(fp,"#ifdef REGISTER_I1\n") ;
+    gen_datacalls1( fp , corename, "", I1 , Domain.fields ) ;
+    fprintf(fp,"#endif\n") ;
+    fprintf(fp," CALL rsl_end_register_f90\n") ;
+    fprintf(fp,"#define  DATA_CALLS_INCLUDED\n") ;
+    close_the_file(fp) ;
+  }
+  return(0) ;
+}
+
+int
+gen_datacalls1 ( FILE * fp , char * corename , char * structname , int mask , node_t * node )
+{
+  node_t * p, * q  ;
+  int i, member_number ;
+  char tmp[NAMELEN],tmp2[NAMELEN], tc ;
+  char indices[NAMELEN], post[NAMELEN] ;
+  char s0[NAMELEN], s1[NAMELEN], s2[NAMELEN] ;
+  char e0[NAMELEN], e1[NAMELEN], e2[NAMELEN] ;
+
+  for ( p = node ; p != NULL ; p = p->next )
+  {
+    if ( ( mask & p->node_kind ) &&
+        ((!strncmp(p->use,"dyn_",4) && !strcmp(corename,p->use+4)) || strncmp(p->use,"dyn_",4)))
+    {
+    if ( (p->subject_to_communication == 1) || ( p->type->type_type == DERIVED ) )
+    {
+      if ( p->type->type_type == SIMPLE )
+      {
+        if ( !strcmp( p->type->name , "real" ) ) tc = 'R' ;
+        if ( !strcmp( p->type->name , "double" ) ) tc = 'D' ;
+        if ( !strcmp( p->type->name , "integer" ) ) tc = 'I' ;
+        for ( i = 1 ; i <= p->ntl ; i++ )
+        {
+/* IF (P_QI .ge. P_FIRST_SCALAR */
+          if ( p->members != NULL )   /* a 4d array */
+          {
+            member_number = 0 ;
+            for ( q = p->members ; q != NULL ; q = q->next )
+            {
+              get_elem( "grid%", "", s0, 0, p , 0 ) ;
+              get_elem( "grid%", "", s1, 1, p , 0 ) ;
+              get_elem( "grid%", "", s2, 2, p , 0 ) ;
+
+              get_elem( "grid%", "", e0, 0, p , 1 ) ;
+              get_elem( "grid%", "", e1, 1, p , 1 ) ;
+              get_elem( "grid%", "", e2, 2, p , 1 ) ;
+
+              sprintf(tmp, "(%s,%s,%s,1+%d)", s0, s1, s2, member_number ) ;
+              sprintf(tmp2, "(%s-%s+1)*(%s-%s+1)*(%s-%s+1)*%cWORDSIZE",e0,s0,e1,s1,e2,s2,tc) ;
+              if ( p->ntl > 1 ) fprintf(fp," IF(1+%d.LE.num_%s)CALL rsl_register_f90_base_and_size ( %s%s_%d %s , &\n %s  )\n",
+                                             member_number,p->name,structname,p->name,i,tmp,tmp2) ;
+              else              fprintf(fp," IF(1+%d.LE.num_%s)CALL rsl_register_f90_base_and_size ( %s%s %s, &\n %s )\n",
+                                             member_number,p->name,structname,p->name,tmp,tmp2) ;
+              member_number++ ;
+            }
+          }
+          else
+          {
+            char ca[NAMELEN] ;
+            strcpy (indices,"");
+            if ( sw_deref_kludge )
+            {
+              sprintf(post,")") ;
+              sprintf(indices, "%s",index_with_firstelem("(","",tmp,p,post)) ;
+            }
+            strcpy( ca, "" ) ;
+            if (!strncmp( p->use , "dyn_", 4 )) { char * cb ;  cb = p->use+4 ; sprintf(ca,"%s_", cb) ; }
+            if ( p->ntl > 1 ) fprintf(fp," CALL rsl_register_f90_base_and_size ( %s%s%s_%d%s , SIZE( %s%s%s_%d ) * %cWORDSIZE )\n",
+                                                                                   structname,ca,p->name,i,indices,
+                                                                                   structname,ca,p->name,i,tc ) ;
+            else              fprintf(fp," CALL rsl_register_f90_base_and_size ( %s%s%s%s , SIZE( %s%s%s  ) * %cWORDSIZE )\n",
+                                                                                   structname,ca,p->name,indices,
+                                                                                   structname,ca,p->name, tc) ;
+          }
+        }
+      }
+      else if ( p->type->type_type == DERIVED )
+      {
+        parent_type = DERIVED;
+        sprintf( tmp , "grid%%%s%%", p->name ) ; 
+        gen_datacalls1 ( fp , corename , tmp , mask, p->type->fields ) ;
+      }
+    }
+  }
+  }
+  return(0) ;
+}
+
+/*****************/
+/*****************/
+
+gen_nest_packing ( char * dirname )
+{
+  gen_nest_pack( dirname ) ;   
+  gen_nest_unpack( dirname ) ; 
+}
+
+#define PACKIT 1
+#define UNPACKIT 2
+
+int
+gen_nest_pack ( char * dirname )
+{
+  int i ;
+  FILE * fp ;
+  char * corename ;
+  char * fnlst[] = { "nest_interpdown_pack.inc" , "nest_forcedown_pack.inc" , "nest_feedbackup_pack.inc", 0L } ;
+  int down_path[] = { INTERP_DOWN , FORCE_DOWN , INTERP_UP } ;
+  int ipath ;
+  char ** fnp ; char * fn ;
+  char fname[NAMELEN] ;
+  node_t *node, *p, *dim ;
+  int xdex, ydex, zdex ;
+  char ddim[3][2][NAMELEN] ;
+  char mdim[3][2][NAMELEN] ;
+  char pdim[3][2][NAMELEN] ;
+  char vname[NAMELEN] ; char tag[NAMELEN] ; char core[NAMELEN] ;
+  int d2, d3 ;
+
+  for ( fnp = fnlst , ipath = 0 ; *fnp ; fnp++ , ipath++ )
+  {
+    fn = *fnp ;
+    for ( i = 0 ; i < get_num_cores() ; i++ )
+    {
+      corename = get_corename_i(i) ;
+      if ( dirname == NULL || corename == NULL ) return(1) ;
+      if ( strlen(dirname) > 0 ) {
+       if ( strlen( corename ) > 0 )
+         { sprintf(fname,"%s/%s_%s",dirname,corename,fn) ; }
+       else
+         { sprintf(fname,"%s/%s",dirname,fn) ; }
+      } else { 
+       if ( strlen( corename ) > 0 ) 
+          { sprintf(fname,"%s_%s",corename,fn) ; }
+       else
+          { sprintf(fname,"%s",fn) ; }
+      }
+      if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+      print_warning(fp,fname) ;
+
+      d2 = 0 ;
+      d3 = 0 ;
+      node = Domain.fields ;
+
+      count_fields ( node , &d2 , &d3 , corename , down_path[ipath] ) ;
+
+      if ( d2 + d3 > 0 ) {
+        if ( down_path[ipath] == INTERP_UP )
+        {
+
+          fprintf(fp,"msize = %d * nlev + %d\n", d3, d2 ) ;
+          fprintf(fp,"CALL rsl_to_parent_info( grid%%domdesc, intermediate_grid%%domdesc ,  &\n") ;
+          fprintf(fp,"                        msize*RWORDSIZE,                             &\n") ;
+          fprintf(fp,"                        i,j,nig,njg,cm,cn,pig,pjg,retval )\n") ;
+          fprintf(fp,"DO while ( retval .eq. 1 )\n") ;
+ 
+          gen_nest_packunpack ( fp , Domain.fields, corename, PACKIT, down_path[ipath] ) ;
+
+          fprintf(fp,"CALL rsl_to_parent_info( grid%%domdesc, intermediate_grid%%domdesc ,  &\n") ;
+          fprintf(fp,"                         msize*RWORDSIZE,                             &\n") ;
+          fprintf(fp,"                         i,j,nig,njg,cm,cn,pig,pjg,retval )\n") ;
+          fprintf(fp,"ENDDO\n") ;
+
+        }
+        else
+        {
+
+          fprintf(fp,"msize = %d * nlev + %d\n", d3, d2 ) ;
+          fprintf(fp,"CALL rsl_to_child_info( grid%%domdesc, intermediate_grid%%domdesc ,  &\n") ;
+          fprintf(fp,"                        msize*RWORDSIZE,                             &\n") ;
+          fprintf(fp,"                        i,j,pig,pjg,cm,cn,nig,njg,retval )\n") ;
+          fprintf(fp,"DO while ( retval .eq. 1 )\n") ;
+  
+          gen_nest_packunpack ( fp , Domain.fields, corename, PACKIT, down_path[ipath] ) ;
+
+          fprintf(fp,"CALL rsl_to_child_info( grid%%domdesc, intermediate_grid%%domdesc ,  &\n") ;
+          fprintf(fp,"                        msize*RWORDSIZE,                             &\n") ;
+          fprintf(fp,"                        i,j,pig,pjg,cm,cn,nig,njg,retval )\n") ;
+          fprintf(fp,"ENDDO\n") ;
+
+        }
+      }
+
+      close_the_file(fp) ;
+    }
+  }
+  return(0) ;
+}
+
+int
+gen_nest_unpack ( char * dirname )
+{
+  int i ;
+  FILE * fp ;
+  char * corename ;
+  char * fnlst[] = { "nest_interpdown_unpack.inc" , "nest_forcedown_unpack.inc" , "nest_feedbackup_unpack.inc" , 0L } ;
+  int down_path[] = { INTERP_DOWN , FORCE_DOWN , INTERP_UP } ;
+  int ipath ;
+  char ** fnp ; char * fn ;
+  char fname[NAMELEN] ;
+  node_t *node, *p, *dim ;
+  int xdex, ydex, zdex ;
+  char ddim[3][2][NAMELEN] ;
+  char mdim[3][2][NAMELEN] ;
+  char pdim[3][2][NAMELEN] ;
+  char vname[NAMELEN] ; char tag[NAMELEN] ; char core[NAMELEN] ;
+  int d2, d3 ;
+
+  for ( fnp = fnlst , ipath = 0 ; *fnp ; fnp++ , ipath++ )
+  {
+    fn = *fnp ;
+    for ( i = 0 ; i < get_num_cores() ; i++ )
+    {
+      d2 = 0 ;
+      d3 = 0 ;
+      node = Domain.fields ;
+
+      corename = get_corename_i(i) ;
+      if ( dirname == NULL || corename == NULL ) return(1) ;
+      if ( strlen(dirname) > 0 )
+       { sprintf(fname,"%s/%s_%s",dirname,corename,fn) ; }
+      else
+       { sprintf(fname,"%s_%s",corename,fn) ; }
+      if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+      print_warning(fp,fname) ;
+
+      count_fields ( node , &d2 , &d3 , corename , down_path[ipath] ) ;
+
+      if ( d2 + d3 > 0 ) {
+        if ( down_path[ipath] == INTERP_UP )
+        {
+
+          fprintf(fp,"CALL rsl_from_child_info(i,j,pig,pjg,cm,cn,nig,njg,retval)\n") ;
+          fprintf(fp,"DO while ( retval .eq. 1 )\n") ;
+
+          gen_nest_packunpack ( fp , Domain.fields, corename, UNPACKIT, down_path[ipath] ) ;
+
+          fprintf(fp,"CALL rsl_from_child_info(i,j,pig,pjg,cm,cn,nig,njg,retval)\n") ;
+          fprintf(fp,"ENDDO\n") ;
+
+        }
+        else
+        {
+
+          fprintf(fp,"CALL rsl_from_parent_info(i,j,nig,njg,cm,cn,pig,pjg,retval)\n") ;
+          fprintf(fp,"DO while ( retval .eq. 1 )\n") ;
+          gen_nest_packunpack ( fp , Domain.fields, corename, UNPACKIT, down_path[ipath] ) ;
+          fprintf(fp,"CALL rsl_from_parent_info(i,j,nig,njg,cm,cn,pig,pjg,retval)\n") ;
+          fprintf(fp,"ENDDO\n") ;
+
+        }
+      }
+
+      close_the_file(fp) ;
+    }
+  }
+  return(0) ;
+}
+
+int
+gen_nest_packunpack ( FILE *fp , node_t * node , char * corename, int dir, int down_path )
+{
+  int i ;
+  node_t *p, *p1, *dim ;
+  int d2, d3, xdex, ydex, zdex ;
+  char ddim[3][2][NAMELEN] ;
+  char mdim[3][2][NAMELEN] ;
+  char pdim[3][2][NAMELEN] ;
+  char vname[NAMELEN], vname2[NAMELEN], dexes[NAMELEN] ; char tag[NAMELEN] ; char core[NAMELEN] ;
+  char c, d ;
+
+  for ( p1 = node ;  p1 != NULL ; p1 = p1->next )
+  {
+
+    if ( p1->node_kind & FOURD )
+    {
+      gen_nest_packunpack ( fp, p1->members, corename, dir , down_path ) ;  /* RECURSE over members */
+      continue ;
+    }
+    else
+    {
+      p = p1 ;
+    }
+
+    if ( p->io_mask & down_path )
+    {
+      if ((!strncmp( p->use, "dyn_", 4) && !strcmp(p->use+4,corename)) || strncmp( p->use, "dyn_", 4))
+      {
+
+        if (!strncmp( p->use, "dyn_", 4))   sprintf(core,"%s",corename) ;
+        else                                sprintf(core,"") ;
+
+        if ( p->ntl > 1 ) sprintf(tag,"_2") ;
+        else              sprintf(tag,"") ;
+
+        set_dim_strs ( p , ddim , mdim , pdim , "c", 0 ) ;
+        zdex = get_index_for_coord( p , COORD_Z ) ;
+        xdex = get_index_for_coord( p , COORD_X ) ;
+        ydex = get_index_for_coord( p , COORD_Y ) ;
+
+        if ( down_path == INTERP_UP )
+        {
+          c = ( dir == PACKIT )?'n':'p' ;
+          d = ( dir == PACKIT )?'2':'1' ;
+        } else {
+          c = ( dir == UNPACKIT )?'n':'p' ;
+          d = ( dir == UNPACKIT )?'2':'1' ;
+        }
+
+        if ( zdex >= 0 ) {
+          if      ( xdex == 0 && zdex == 1 && ydex == 2 )  sprintf(dexes,"pig,k,pjg") ;
+          else if ( zdex == 0 && xdex == 1 && ydex == 2 )  sprintf(dexes,"k,pig,pjg") ;
+          else if ( xdex == 0 && ydex == 1 && zdex == 2 )  sprintf(dexes,"pig,pjg,k") ;
+        } else {
+          if ( xdex == 0 && ydex == 1 )  sprintf(dexes,"pig,pjg") ;
+          if ( ydex == 0 && xdex == 1 )  sprintf(dexes,"pjg,pig") ;
+        }
+
+        /* construct variable name */
+        if ( p->scalar_array_member )
+        {
+          sprintf(vname,"%s%s(%s,P_%s)",p->use,tag,dexes,p->name) ;
+          if ( strlen(core) > 0 )
+            sprintf(vname2,"%s_%s%s(%s,P_%s)",core,p->use,tag,dexes,p->name) ;
+          else
+            sprintf(vname2,"%s%s(%s,P_%s)",p->use,tag,dexes,p->name) ;
+        }
+        else
+        {
+          sprintf(vname,"%s%s(%s)",p->name,tag,dexes) ;
+          if ( strlen(core) > 0 )
+            sprintf(vname2,"%s_%s%s(%s)",core,p->name,tag,dexes) ;
+          else
+            sprintf(vname2,"%s%s(%s)",p->name,tag,dexes) ;
+        }
+
+        if ( p->scalar_array_member )
+	{
+fprintf(fp,"IF ( P_%s .GE. PARAM_FIRST_SCALAR ) THEN\n",p->name) ;
+	}
+
+        if ( dir == UNPACKIT ) 
+        {
+          if ( down_path == INTERP_UP )
+	  {
+            if ( zdex >= 0 ) {
+fprintf(fp,"CALL rsl_from_child_msg(((%s)-(%s)+1)*RWORDSIZE,xv) ;\n",ddim[zdex][1], ddim[zdex][0] ) ;
+            } else {
+fprintf(fp,"CALL rsl_from_child_msg(RWORDSIZE,xv)\n" ) ;
+            }
+fprintf(fp,"IF ( %s_cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, %s, %s ) ) THEN\n",
+                 corename, p->stag_x?".TRUE.":".FALSE." ,p->stag_y?".TRUE.":".FALSE." ) ;
+            if ( zdex >= 0 ) {
+fprintf(fp,"DO k = %s,%s\nNEST_INFLUENCE(grid%%%s,xv(k))\nENDDO\n", ddim[zdex][0], ddim[zdex][1], vname2 ) ;
+            } else {
+fprintf(fp,"grid%%%s = xv(1) ;\n", vname2) ;
+            }
+fprintf(fp,"ENDIF\n") ;
+          }
+          else
+          {
+            if ( zdex >= 0 ) {
+fprintf(fp,"CALL rsl_from_parent_msg(((%s)-(%s)+1)*RWORDSIZE,xv)\nDO k = %s,%s\ngrid%%%s = xv(k)\nENDDO\n",
+                                    ddim[zdex][1], ddim[zdex][0], ddim[zdex][0], ddim[zdex][1], vname2) ;
+            } else {
+fprintf(fp,"CALL rsl_from_parent_msg(RWORDSIZE,xv)\ngrid%%%s = xv(1)\n", vname2) ;
+            }
+          }
+        }
+        else
+        {
+          if ( down_path == INTERP_UP )
+	  {
+            if ( zdex >= 0 ) {
+fprintf(fp,"DO k = %s,%s\nxv(k)= intermediate_grid%%%s\nENDDO\nCALL rsl_to_parent_msg(((%s)-(%s)+1)*RWORDSIZE,xv)\n",
+                           ddim[zdex][0], ddim[zdex][1], vname2, ddim[zdex][1], ddim[zdex][0] ) ;
+            } else {
+fprintf(fp,"xv(1)= intermediate_grid%%%s\nCALL rsl_to_parent_msg(RWORDSIZE,xv)\n", vname2) ;
+            }
+          }
+          else
+          {
+            if ( zdex >= 0 ) {
+fprintf(fp,"DO k = %s,%s\nxv(k)= grid%%%s\nENDDO\nCALL rsl_to_child_msg(((%s)-(%s)+1)*RWORDSIZE,xv)\n",
+                           ddim[zdex][0], ddim[zdex][1], vname2, ddim[zdex][1], ddim[zdex][0] ) ;
+            } else {
+fprintf(fp,"xv(1)=grid%%%s\nCALL rsl_to_child_msg(RWORDSIZE,xv)\n", vname2) ;
+            }
+          }
+        }
+        if ( p->scalar_array_member )
+	{
+fprintf(fp,"ENDIF\n") ;
+	}
+      }
+    }
+  }
+
+  return(0) ;
+}
+
+/*****************/
+
+int
+count_fields ( node_t * node , int * d2 , int * d3 , char * corename , int down_path )
+{
+  node_t * p ;
+  int zdex ;
+/* count up the total number of levels from all fields */
+  for ( p = node ;  p != NULL ; p = p->next )
+  {
+    if ( p->node_kind == FOURD ) 
+    {
+      count_fields( p->members , d2 , d3 , corename , down_path ) ;  /* RECURSE */
+    }
+    else
+    {
+      if ( p->io_mask & down_path )
+      {
+        if ((!strncmp( p->use, "dyn_", 4) && !strcmp(p->use+4,corename)) || strncmp( p->use, "dyn_", 4))
+        {
+          if ( p->node_kind == FOURD )
+            zdex = get_index_for_coord( p->members , COORD_Z ) ;
+          else
+            zdex = get_index_for_coord( p , COORD_Z ) ;
+  
+          if ( zdex < 0 ) {
+            (*d2)++ ;   /* if no zdex then only 2 d */
+          } else {
+            (*d3)++ ;   /* if has a zdex then 3 d */
+          }
+        }
+      }
+    }
+  }
+  return(0) ;
+}
+
+/*****************/
+
+int
+gen_comms ( char * dirname )
+{
+  if ( sw_dm_parallel )
+    fprintf(stderr,"ADVISORY: RSL version of gen_comms is linked in with registry program.\n") ;
+
+  gen_halos( "inc" ) ;
+  gen_shift( "inc" ) ;
+  gen_periods( "inc" ) ;
+  gen_xposes( "inc" ) ;
+  gen_comm_descrips( "inc" ) ;
+  gen_datacalls( "inc" ) ;
+  gen_nest_packing( "inc" ) ;
+
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL/module_dm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/module_dm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/module_dm.F	(revision 2744)
@@ -0,0 +1,4849 @@
+!WRF:PACKAGE:RSL 
+!
+MODULE module_dm
+
+   USE module_machine
+   USE module_configure
+   USE module_state_description
+   USE module_wrf_error
+
+#include "rsl.inc"
+
+   INTEGER msg_z, msg_x, msg_y
+   INTEGER msg,messages(168)
+   INTEGER invalid_message_value
+   INTEGER x_period_flag, y_period_flag
+   INTEGER msg_msg
+   INTEGER &
+      n5w5 ,n5w4 ,n5w3 ,n5w2 ,n5w ,n5 ,n5e ,n5e2 ,n5e3 ,n5e4 ,n5e5  &
+     ,n4w5 ,n4w4 ,n4w3 ,n4w2 ,n4w ,n4 ,n4e ,n4e2 ,n4e3 ,n4e4 ,n4e5  &
+     ,n3w5 ,n3w4 ,n3w3 ,n3w2 ,n3w ,n3 ,n3e ,n3e2 ,n3e3 ,n3e4 ,n3e5  &
+     ,n2w5 ,n2w4 ,n2w3 ,n2w2 ,n2w ,n2 ,n2e ,n2e2 ,n2e3 ,n2e4 ,n2e5  &
+     ,nw5  ,nw4  ,nw3  ,nw2  ,nw  ,n1 ,ne  ,ne2  ,ne3  ,ne4  ,ne5   &
+     ,w5   ,w4   ,w3   ,w2   ,w1      ,e1  ,e2   ,e3   ,e4   ,e5    &
+     ,sw5  ,sw4  ,sw3  ,sw2  ,sw  ,s1 ,se  ,se2  ,se3  ,se4  ,se5   &
+     ,s2w5 ,s2w4 ,s2w3 ,s2w2 ,s2w ,s2 ,s2e ,s2e2 ,s2e3 ,s2e4 ,s2e5  &
+     ,s3w5 ,s3w4 ,s3w3 ,s3w2 ,s3w ,s3 ,s3e ,s3e2 ,s3e3 ,s3e4 ,s3e5  &
+     ,s4w5 ,s4w4 ,s4w3 ,s4w2 ,s4w ,s4 ,s4e ,s4e2 ,s4e3 ,s4e4 ,s4e5  &
+     ,s5w5 ,s5w4 ,s5w3 ,s5w2 ,s5w ,s5 ,s5e ,s5e2 ,s5e3 ,s5e4 ,s5e5
+   INTEGER glen(3), llen(3), decomp(3), decompx(3), decompy(3), decompxy(3)
+   INTEGER glen2d(2), llen2d(2), decomp2d(2), decompx2d(2), decompy2d(2), decompxy2d(2)
+   INTEGER glenx(3), gleny(3), glenxy(3)
+   INTEGER llenx(3), lleny(3), llenxy(3)
+   INTEGER glenx2d(2), gleny2d(2), glenxy2d(2)
+   INTEGER llenx2d(2), lleny2d(2), llenxy2d(2)
+   INTEGER llen_tx(3)
+   INTEGER llen_ty(3)
+   INTEGER ips_save, jps_save
+   INTEGER ipe_save, jpe_save
+   INTEGER, PRIVATE :: mpi_comm_local
+   INTEGER, PRIVATE :: nproc_lt, nproc_ln
+
+#if ( RWORDSIZE != DWORDSIZE )
+   INTERFACE add_msg_period
+     MODULE PROCEDURE add_msg_period_real, add_msg_period_integer, add_msg_period_doubleprecision
+   END INTERFACE
+   INTERFACE add_msg_xpose
+     MODULE PROCEDURE add_msg_xpose_real, add_msg_xpose_integer, add_msg_xpose_doubleprecision
+   END INTERFACE
+   INTERFACE add_msg_4pt
+     MODULE PROCEDURE add_msg_4pt_real, add_msg_4pt_integer, add_msg_4pt_doubleprecision
+   END INTERFACE
+   INTERFACE add_msg_8pt
+     MODULE PROCEDURE add_msg_8pt_real, add_msg_8pt_integer, add_msg_8pt_doubleprecision
+   END INTERFACE
+   INTERFACE add_msg_12pt
+     MODULE PROCEDURE add_msg_12pt_real, add_msg_12pt_integer, add_msg_12pt_doubleprecision
+   END INTERFACE
+   INTERFACE add_msg_24pt
+     MODULE PROCEDURE add_msg_24pt_real, add_msg_24pt_integer, add_msg_24pt_doubleprecision
+   END INTERFACE
+   INTERFACE add_msg_48pt
+     MODULE PROCEDURE add_msg_48pt_real, add_msg_48pt_integer, add_msg_48pt_doubleprecision
+   END INTERFACE
+   INTERFACE add_msg_80pt
+     MODULE PROCEDURE add_msg_80pt_real, add_msg_80pt_integer, add_msg_80pt_doubleprecision
+   END INTERFACE
+   INTERFACE add_msg_120pt
+     MODULE PROCEDURE add_msg_120pt_real, add_msg_120pt_integer, add_msg_120pt_doubleprecision
+   END INTERFACE
+   INTERFACE wrf_dm_maxval
+     MODULE PROCEDURE wrf_dm_maxval_real , wrf_dm_maxval_integer, wrf_dm_maxval_doubleprecision
+   END INTERFACE
+   INTERFACE wrf_dm_minval
+     MODULE PROCEDURE wrf_dm_minval_real , wrf_dm_minval_integer, wrf_dm_minval_doubleprecision
+   END INTERFACE
+
+#define TRUE_RSL_REAL     RSL_REAL
+#define TRUE_RSL_REAL_F90 RSL_REAL_F90
+#else
+   INTERFACE add_msg_period
+     MODULE PROCEDURE add_msg_period_real, add_msg_period_integer
+   END INTERFACE
+   INTERFACE add_msg_xpose
+     MODULE PROCEDURE add_msg_xpose_real, add_msg_xpose_integer
+   END INTERFACE
+   INTERFACE add_msg_4pt
+     MODULE PROCEDURE add_msg_4pt_real, add_msg_4pt_integer
+   END INTERFACE
+   INTERFACE add_msg_8pt
+     MODULE PROCEDURE add_msg_8pt_real, add_msg_8pt_integer
+   END INTERFACE
+   INTERFACE add_msg_12pt
+     MODULE PROCEDURE add_msg_12pt_real, add_msg_12pt_integer
+   END INTERFACE
+   INTERFACE add_msg_24pt
+     MODULE PROCEDURE add_msg_24pt_real, add_msg_24pt_integer
+   END INTERFACE
+   INTERFACE add_msg_48pt
+     MODULE PROCEDURE add_msg_48pt_real, add_msg_48pt_integer
+   END INTERFACE
+   INTERFACE add_msg_80pt
+     MODULE PROCEDURE add_msg_80pt_real, add_msg_80pt_integer
+   END INTERFACE
+   INTERFACE add_msg_120pt
+     MODULE PROCEDURE add_msg_120pt_real, add_msg_120pt_integer
+   END INTERFACE
+   INTERFACE wrf_dm_maxval
+     MODULE PROCEDURE wrf_dm_maxval_real , wrf_dm_maxval_integer
+   END INTERFACE
+   INTERFACE wrf_dm_minval
+     MODULE PROCEDURE wrf_dm_minval_real , wrf_dm_minval_integer
+   END INTERFACE
+
+#define TRUE_RSL_REAL     RSL_DOUBLE
+#define TRUE_RSL_REAL_F90 RSL_DOUBLE_F90
+#endif
+
+CONTAINS
+
+   SUBROUTINE MPASPECT( P, MINM, MINN, PROCMIN_M, PROCMIN_N )
+
+! <DESCRIPTION>
+! This is a routine provided by the rsl external comm layer.
+! and is defined in external/RSL/module_dm.F, which is copied
+! into frame/module_dm.F at compile time.  Changes to frame/module_dm.F
+! will be lost.
+!
+! Given a total number of tasks, P, work out a two-dimensional mesh of
+! processors that is MINM processors in the M dimension and MINN
+! processors in the N dimension. The algorithm attempts to find two
+! numbers that divide the total number of processors without a remainder.
+! The best it might do, sometimes, is 1 and P. It attempts to divide
+! the M dimension over the smaller number.
+! 
+! The PROCMIN arguments are a holdover from MM5. The represent the
+! minimum number of processors the algorithm is allowed to use for M and
+! N. This is a holdover from MM5 which had static (compile-time) array
+! sizes ; PROCMIN_M and PROCMIN_N  should always be 1 in WRF.
+! 
+! </DESCRIPTION>
+
+      INTEGER P, M, N, MINI, MINM, MINN, PROCMIN_M, PROCMIN_N
+      MINI = 2*P
+      MINM = 1
+      MINN = P
+      DO M = 1, P
+        IF ( MOD( P, M ) .EQ. 0 ) THEN
+          N = P / M
+          IF ( ABS(M-N) .LT. MINI                &
+               .AND. M .GE. PROCMIN_M            &
+               .AND. N .GE. PROCMIN_N            &
+             ) THEN
+            MINI = ABS(M-N)
+            MINM = M
+            MINN = N
+          ENDIF
+        ENDIF
+      ENDDO
+      IF ( MINM .LT. PROCMIN_M .OR. MINN .LT. PROCMIN_N ) THEN
+        WRITE( wrf_err_message , * )'MPASPECT: UNABLE TO GENERATE PROCESSOR MESH.  STOPPING.'
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE(0,*)' PROCMIN_M ', PROCMIN_M
+        WRITE( wrf_err_message , * )' PROCMIN_M ', PROCMIN_M
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' PROCMIN_N ', PROCMIN_N
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' P         ', P
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' MINM      ', MINM
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' MINN      ', MINN
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        CALL wrf_error_fatal ( 'module_dm: mpaspect' )
+      ENDIF
+   RETURN
+   END SUBROUTINE MPASPECT
+
+
+   SUBROUTINE wrf_dm_initialize
+! <DESCRIPTION>
+! This is a routine provided by the RSL external comm layer.
+! and is defined in external/RSL/module_dm.F, which is copied
+! into frame/module_dm.F at compile time.  Changes to frame/module_dm.F
+! will be lost.
+!
+! This routine is used to complete initialization the rsl external comm
+! layer, once the namelist.input file has been read-in and broadcast to
+! all the tasks.  It must be called <em>after</em> the call to <a
+! href=init_module_dm.html>init_module_dm</a>.
+! 
+! Wrf_dm_initialize calls RSL_SET_REGULAR_DECOMP to set up a regular
+! domain decompostion (subdomains will be rectangular) and then looks to
+! see if the namelist variables nproc_x and nproc_y have been set.  If
+! these have been set it uses these to map the MPI tasks to a
+! two-dimensional processor mesh.  Otherwise, it uses the <a
+! href=mpaspect.html>mpaspect</a> routine to compute the mesh.  The
+! dimensions of the mesh are then provided to rsl with call to RSL_MESH.
+! 
+! The WRF EM core uses the default pad area (the area of extra memory
+! that will be allocated around each local processor subdomain). The
+! default, defined in external/RSL/RSL/rsl.h, is 4. Other dycores, such
+! as NMM, may need a different size.  A non-default pad area is set in
+! rsl using a call to RSL_SET_PADAREA.
+! 
+! </DESCRIPTION>
+      CALL RSL_SET_REGULAR_DECOMP
+      CALL nl_get_nproc_x ( 1, nproc_ln )
+      CALL nl_get_nproc_y ( 1, nproc_lt )
+! check if user has specified in the namelist
+      IF ( nproc_ln .GT. 0 .OR. nproc_lt .GT. 0 ) THEN
+        ! if only nproc_ln is specified then make it 1-d decomp in i
+        IF      ( nproc_ln .GT. 0 .AND. nproc_lt .EQ. -1 ) THEN
+          nproc_lt = rsl_nproc / nproc_ln
+        ! if only nproc_lt is specified then make it 1-d decomp in j
+        ELSE IF ( nproc_ln .EQ. -1 .AND. nproc_lt .GT. 0 ) THEN
+          nproc_ln = rsl_nproc / nproc_lt
+        ENDIF
+        ! make sure user knows what they're doing
+        IF ( nproc_ln * nproc_lt .NE. rsl_nproc ) THEN
+          WRITE( wrf_err_message , * )'WRF_DM_INITIALIZE (RSL): nproc_x * nproc_y in namelist ne ',rsl_nproc
+          CALL wrf_error_fatal ( wrf_err_message )
+        ENDIF
+      ELSE
+        ! When neither is specified, work out mesh with MPASPECT
+        ! Pass nproc_ln and nproc_nt so that number of procs in 
+        ! i-dim (nproc_ln) is equal or lesser.
+        CALL mpaspect( rsl_nproc , nproc_ln , nproc_lt , 1 , 1 )
+      ENDIF
+       !                X          Y
+      CALL RSL_MESH( nproc_ln, nproc_lt )
+#ifdef NMM_CORE
+      CALL rsl_set_padarea ( 6 )
+#endif
+      CALL nl_set_nproc_x ( 1, nproc_ln )
+      CALL nl_set_nproc_y ( 1, nproc_lt )
+      invalid_message_value = RSL_INVALID
+      x_period_flag         = RSL_M
+      y_period_flag         = RSL_N
+      RETURN
+   END SUBROUTINE wrf_dm_initialize
+
+! period additions, 200505
+
+   SUBROUTINE reset_period
+      IMPLICIT NONE
+      CALL rsl_create_message ( msg )
+   END SUBROUTINE reset_period
+
+   SUBROUTINE add_msg_period_real( fld, kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if (      kdim >  1 ) then
+        CALL rsl_build_message(msg,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(msg,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+   END SUBROUTINE add_msg_period_real
+
+   SUBROUTINE add_msg_period_integer( fld, kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if (      kdim >  1 ) then
+        CALL rsl_build_message(msg,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(msg,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+   END SUBROUTINE add_msg_period_integer
+
+#if (  RWORDSIZE != DWORDSIZE )
+   SUBROUTINE add_msg_period_doubleprecision( fld, kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if (      kdim >  1 ) then
+        CALL rsl_build_message(msg,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(msg,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+   END SUBROUTINE add_msg_period_doubleprecision
+#endif
+
+! xpose additions, 20000302
+
+   SUBROUTINE reset_msgs_xpose
+      IMPLICIT NONE
+      CALL rsl_create_message ( msg_z )
+      CALL rsl_create_message ( msg_x )
+      CALL rsl_create_message ( msg_y )
+   END SUBROUTINE reset_msgs_xpose
+
+   SUBROUTINE add_msg_xpose_real( fld_z, fld_x, fld_y, dim )
+      IMPLICIT NONE
+      real fld_z(*), fld_x(*), fld_y(*)
+      integer dim
+      if (      dim == 3 ) then
+        CALL rsl_build_message(msg_z,TRUE_RSL_REAL_F90,fld_z,dim,decomp(1),glen(1),llen(1))
+        CALL rsl_build_message(msg_y,TRUE_RSL_REAL_F90,fld_x,dim,decomp(1),glen(1),llen_tx(1))  ! msg_y->msg_x 20020908
+        CALL rsl_build_message(msg_x,TRUE_RSL_REAL_F90,fld_y,dim,decomp(1),glen(1),llen_ty(1))  ! msg_x->msg_y 20020908
+      endif
+   END SUBROUTINE add_msg_xpose_real
+
+#if ( RWORDSIZE != DWORDSIZE )
+   SUBROUTINE add_msg_xpose_doubleprecision( fld_z, fld_x, fld_y, dim )
+      IMPLICIT NONE
+      doubleprecision fld_z(*), fld_x(*), fld_y(*)
+      integer dim
+      if (      dim == 3 ) then
+        CALL rsl_build_message(msg_z,RSL_DOUBLE_F90,fld_z,dim,decomp(1),glen(1),llen(1))
+        CALL rsl_build_message(msg_y,RSL_DOUBLE_F90,fld_x,dim,decomp(1),glen(1),llen_tx(1))  ! msg_y->msg_x 20020908
+        CALL rsl_build_message(msg_x,RSL_DOUBLE_F90,fld_y,dim,decomp(1),glen(1),llen_ty(1))  ! msg_x->msg_y 20020908
+      endif
+   END SUBROUTINE add_msg_xpose_doubleprecision
+#endif
+
+
+   SUBROUTINE add_msg_xpose_integer ( fld_z, fld_x, fld_y, dim )
+      IMPLICIT NONE
+      integer fld_z(*), fld_x(*), fld_y(*)
+      integer dim
+      if (      dim == 3 ) then
+        CALL rsl_build_message(msg_z,RSL_INTEGER_F90,fld_z,dim,decomp(1),glen(1),llen(1))
+        CALL rsl_build_message(msg_y,RSL_INTEGER_F90,fld_x,dim,decomp(1),glen(1),llen_tx(1))  ! msg_y->msg_x 20020908
+        CALL rsl_build_message(msg_x,RSL_INTEGER_F90,fld_y,dim,decomp(1),glen(1),llen_ty(1))  ! msg_x->msg_y 20020908
+      endif
+   END SUBROUTINE add_msg_xpose_integer
+
+   SUBROUTINE define_xpose ( did, xp )
+      IMPLICIT NONE
+      INTEGER did , xp
+      CALL rsl_create_xpose ( xp )
+      CALL rsl_describe_xpose ( did , xp , msg_z , msg_x , msg_y )
+   END SUBROUTINE define_xpose
+
+! end xpose additions, 20000302
+
+!      n5w5 ,n5w4 ,n5w3 ,n5w2 ,n5w ,n5 ,n5e ,n5e2 ,n5e3 ,n5e4 ,n5e5  &
+!     ,n4w5 ,n4w4 ,n4w3 ,n4w2 ,n4w ,n4 ,n4e ,n4e2 ,n4e3 ,n4e4 ,n4e5  &
+!     ,n3w5 ,n3w4 ,n3w3 ,n3w2 ,n3w ,n3 ,n3e ,n3e2 ,n3e3 ,n3e4 ,n3e5  &
+!     ,n2w5 ,n2w4 ,n2w3 ,n2w2 ,n2w ,n2 ,n2e ,n2e2 ,n2e3 ,n2e4 ,n2e5  &
+!     ,nw5  ,nw4  ,nw3  ,nw2  ,nw  ,n1 ,ne  ,ne2  ,ne3  ,ne4  ,ne5   &
+!     ,w5   ,w4   ,w3   ,w2   ,w1      ,e1  ,e2   ,e3   ,e4   ,e5    &
+!     ,sw5  ,sw4  ,sw3  ,sw2  ,sw  ,s1 ,se  ,se2  ,se3  ,se4  ,se5   &
+!     ,s2w5 ,s2w4 ,s2w3 ,s2w2 ,s2w ,s2 ,s2e ,s2e2 ,s2e3 ,s2e4 ,s2e5  &
+!     ,s3w5 ,s3w4 ,s3w3 ,s3w2 ,s3w ,s3 ,s3e ,s3e2 ,s3e3 ,s3e4 ,s3e5  &
+!     ,s4w5 ,s4w4 ,s4w3 ,s4w2 ,s4w ,s4 ,s4e ,s4e2 ,s4e3 ,s4e4 ,s4e5  &
+!     ,s5w5 ,s5w4 ,s5w3 ,s5w2 ,s5w ,s5 ,s5e ,s5e2 ,s5e3 ,s5e4 ,s5e5
+
+   SUBROUTINE reset_msgs_120pt
+      CALL reset_msgs_80pt
+#if 0
+      CALL rsl_create_message(n5w5)
+      CALL rsl_create_message(n5w4)
+      CALL rsl_create_message(n5w3)
+      CALL rsl_create_message(n5w2)
+      CALL rsl_create_message(n5w )
+      CALL rsl_create_message(n5)
+      CALL rsl_create_message(n5e )
+      CALL rsl_create_message(n5e2)
+      CALL rsl_create_message(n5e3)
+      CALL rsl_create_message(n5e4)
+      CALL rsl_create_message(n5e5)
+      CALL rsl_create_message(n4w5)
+      CALL rsl_create_message(n3w5)
+      CALL rsl_create_message(n2w5)
+      CALL rsl_create_message(nw5)
+      CALL rsl_create_message(w5)
+      CALL rsl_create_message(sw5)
+      CALL rsl_create_message(s2w5)
+      CALL rsl_create_message(s3w5)
+      CALL rsl_create_message(s4w5)
+      CALL rsl_create_message(n4e5)
+      CALL rsl_create_message(n3e5)
+      CALL rsl_create_message(n2e5)
+      CALL rsl_create_message(ne5)
+      CALL rsl_create_message(e5)
+      CALL rsl_create_message(se5)
+      CALL rsl_create_message(s2e5)
+      CALL rsl_create_message(s3e5)
+      CALL rsl_create_message(s4e5)
+      CALL rsl_create_message(s5w5)
+      CALL rsl_create_message(s5w4)
+      CALL rsl_create_message(s5w3)
+      CALL rsl_create_message(s5w2)
+      CALL rsl_create_message(s5w )
+      CALL rsl_create_message(s5)
+      CALL rsl_create_message(s5e )
+      CALL rsl_create_message(s5e2)
+      CALL rsl_create_message(s5e3)
+      CALL rsl_create_message(s5e4)
+      CALL rsl_create_message(s5e5)
+#endif
+   END SUBROUTINE reset_msgs_120pt
+
+   SUBROUTINE reset_msgs_80pt
+#if 1
+      CALL rsl_create_message(msg_msg)
+#else
+      CALL reset_msgs_48pt
+      CALL rsl_create_message(n4w4)
+      CALL rsl_create_message(n4w3)
+      CALL rsl_create_message(n4w2)
+      CALL rsl_create_message(n4w )
+      CALL rsl_create_message(n4)
+      CALL rsl_create_message(n4e )
+      CALL rsl_create_message(n4e2)
+      CALL rsl_create_message(n4e3)
+      CALL rsl_create_message(n4e4)
+      CALL rsl_create_message(n3w4)
+      CALL rsl_create_message(n2w4)
+      CALL rsl_create_message(nw4)
+      CALL rsl_create_message(w4)
+      CALL rsl_create_message(sw4)
+      CALL rsl_create_message(s2w4)
+      CALL rsl_create_message(s3w4)
+      CALL rsl_create_message(n3e4)
+      CALL rsl_create_message(n2e4)
+      CALL rsl_create_message(ne4)
+      CALL rsl_create_message(e4)
+      CALL rsl_create_message(se4)
+      CALL rsl_create_message(s2e4)
+      CALL rsl_create_message(s3e4)
+      CALL rsl_create_message(s4w4)
+      CALL rsl_create_message(s4w3)
+      CALL rsl_create_message(s4w2)
+      CALL rsl_create_message(s4w )
+      CALL rsl_create_message(s4)
+      CALL rsl_create_message(s4e )
+      CALL rsl_create_message(s4e2)
+      CALL rsl_create_message(s4e3)
+      CALL rsl_create_message(s4e4)
+#endif
+   END SUBROUTINE reset_msgs_80pt
+
+   SUBROUTINE reset_msgs_48pt
+      CALL reset_msgs_24pt
+      CALL rsl_create_message(n3w3)
+      CALL rsl_create_message(n3w2)
+      CALL rsl_create_message(n3w )
+      CALL rsl_create_message(n3)
+      CALL rsl_create_message(n3e )
+      CALL rsl_create_message(n3e2)
+      CALL rsl_create_message(n3e3)
+      CALL rsl_create_message(n2w3)
+      CALL rsl_create_message(n2e3)
+      CALL rsl_create_message(nw3)
+      CALL rsl_create_message(ne3)
+      CALL rsl_create_message(w3)
+      CALL rsl_create_message(e3)
+      CALL rsl_create_message(sw3)
+      CALL rsl_create_message(se3)
+      CALL rsl_create_message(s2w3)
+      CALL rsl_create_message(s2e3)
+      CALL rsl_create_message(s3w3)
+      CALL rsl_create_message(s3w2)
+      CALL rsl_create_message(s3w )
+      CALL rsl_create_message(s3)
+      CALL rsl_create_message(s3e )
+      CALL rsl_create_message(s3e2)
+      CALL rsl_create_message(s3e3)
+      RETURN
+   END SUBROUTINE reset_msgs_48pt
+
+   SUBROUTINE reset_msgs_24pt
+      CALL reset_msgs_12pt
+      CALL rsl_create_message(n2w2)
+      CALL rsl_create_message(n2w)
+      CALL rsl_create_message(n2e)
+      CALL rsl_create_message(n2e2)
+      CALL rsl_create_message(nw2)
+      CALL rsl_create_message(ne2)
+      CALL rsl_create_message(sw2)
+      CALL rsl_create_message(se2)
+      CALL rsl_create_message(s2w2)
+      CALL rsl_create_message(s2w)
+      CALL rsl_create_message(s2e)
+      CALL rsl_create_message(s2e2)
+      RETURN
+   END SUBROUTINE reset_msgs_24pt
+
+   SUBROUTINE reset_msgs_12pt
+      CALL reset_msgs_8pt
+      call rsl_create_message(n2)
+      call rsl_create_message(w2)
+      call rsl_create_message(e2)
+      call rsl_create_message(s2)
+      RETURN
+   END SUBROUTINE reset_msgs_12pt
+
+   SUBROUTINE reset_msgs_8pt
+      call reset_msgs_4pt
+      call rsl_create_message(ne)
+      call rsl_create_message(nw)
+      call rsl_create_message(se)
+      call rsl_create_message(sw)
+      RETURN
+   END SUBROUTINE reset_msgs_8pt
+
+   SUBROUTINE reset_msgs_4pt
+      call rsl_create_message(n1)
+      call rsl_create_message(w1)
+      call rsl_create_message(e1)
+      call rsl_create_message(s1)
+      RETURN
+   END SUBROUTINE reset_msgs_4pt
+
+   SUBROUTINE reset_msgs_y_shift
+      call rsl_create_message(s5)
+      call rsl_create_message(s4)
+      call rsl_create_message(s3)
+      call rsl_create_message(s2)
+      call rsl_create_message(s1)
+      call rsl_create_message(n1)
+      call rsl_create_message(n2)
+      call rsl_create_message(n3)
+      call rsl_create_message(n4)
+      call rsl_create_message(n5)
+      RETURN
+   END SUBROUTINE reset_msgs_y_shift
+
+   SUBROUTINE reset_msgs_x_shift
+      call rsl_create_message(w5)
+      call rsl_create_message(w4)
+      call rsl_create_message(w3)
+      call rsl_create_message(w2)
+      call rsl_create_message(w1)
+      call rsl_create_message(e1)
+      call rsl_create_message(e2)
+      call rsl_create_message(e3)
+      call rsl_create_message(e4)
+      call rsl_create_message(e5)
+      RETURN
+   END SUBROUTINE reset_msgs_x_shift
+
+   SUBROUTINE add_msg_x_shift_real ( fld, kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim  > 1 ) then
+        CALL rsl_build_message(w5,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w4,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w1,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e1,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e4,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e5,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(w5,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w4,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w1,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e1,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e4,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e5,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_x_shift_real
+   SUBROUTINE add_msg_y_shift_real ( fld, kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim  > 1 ) then
+        CALL rsl_build_message(s5,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s4,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s1,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n1,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n4,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n5,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(s5,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s4,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s1,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n1,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n4,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n5,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_y_shift_real
+
+   SUBROUTINE add_msg_x_shift_integer ( fld, kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim  > 1 ) then
+        CALL rsl_build_message(w5,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w4,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w1,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e1,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e4,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e5,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(w5,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w4,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w1,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e1,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e4,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e5,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_x_shift_integer
+   SUBROUTINE add_msg_y_shift_integer ( fld, kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim  > 1 ) then
+        CALL rsl_build_message(s5,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s4,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s1,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n1,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n4,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n5,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(s5,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s4,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s1,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n1,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n4,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n5,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_y_shift_integer
+
+   SUBROUTINE add_msg_x_shift_doubleprecision ( fld, kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim  > 1 ) then
+        CALL rsl_build_message(w5,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w4,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w1,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e1,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e4,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e5,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(w5,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w4,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w1,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e1,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e4,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e5,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_x_shift_doubleprecision
+   SUBROUTINE add_msg_y_shift_doubleprecision ( fld, kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim  > 1 ) then
+        CALL rsl_build_message(s5,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s4,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s1,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n1,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n4,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n5,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(s5,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s4,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s1,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n1,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n4,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n5,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_y_shift_doubleprecision
+
+   SUBROUTINE add_msg_4pt_real ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim   
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim  > 1 ) then
+        CALL rsl_build_message(w1,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s1,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e1,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n1,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(w1,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s1,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e1,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n1,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_4pt_real
+
+#if (  RWORDSIZE != DWORDSIZE )
+   SUBROUTINE add_msg_4pt_doubleprecision ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim  > 1 ) then
+        CALL rsl_build_message(w1,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s1,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e1,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n1,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(w1,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s1,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e1,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n1,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_4pt_doubleprecision
+#endif
+
+
+   SUBROUTINE add_msg_4pt_integer ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim   
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim  > 1 ) then
+        CALL rsl_build_message(w1,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s1,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e1,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n1,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(w1,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s1,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e1,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n1,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_4pt_integer
+
+   SUBROUTINE add_msg_8pt_real ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim   
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_4pt ( fld , kdim )
+      if (      kdim >  1 ) then
+        CALL rsl_build_message(nw,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(sw,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(ne,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(se,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(nw,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(sw,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(ne,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(se,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_8pt_real
+
+#if ( RWORDSIZE != DWORDSIZE )
+   SUBROUTINE add_msg_8pt_doubleprecision ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_4pt ( fld , kdim )
+      if (      kdim >  1 ) then
+        CALL rsl_build_message(nw,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(sw,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(ne,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(se,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(nw,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(sw,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(ne,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(se,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_8pt_doubleprecision
+#endif
+
+
+   SUBROUTINE add_msg_8pt_integer( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim  
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_4pt ( fld , kdim )
+      if (      kdim >  1 ) then
+        CALL rsl_build_message(nw,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(sw,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(ne,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(se,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(nw,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(sw,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(ne,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(se,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_8pt_integer
+
+   SUBROUTINE add_msg_12pt_real ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_8pt ( fld , kdim )
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(w2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(w2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_12pt_real
+
+#if ( RWORDSIZE != DWORDSIZE )
+   SUBROUTINE add_msg_12pt_doubleprecision ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_8pt ( fld , kdim )
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(w2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(w2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_12pt_doubleprecision
+#endif
+
+
+   SUBROUTINE add_msg_12pt_integer ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_8pt ( fld , kdim )
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(w2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(w2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_12pt_integer
+
+   SUBROUTINE add_msg_24pt_real ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_8pt ( fld , kdim )
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(n2w2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2w,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2e,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2e2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(nw2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(ne2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(sw2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(se2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2w2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2w,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2e,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2e2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(n2w2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2w,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2e,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2e2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(nw2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(ne2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(sw2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(se2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2w2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2w,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2e,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2e2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_24pt_real
+
+#if ( RWORDSIZE != DWORDSIZE )
+   SUBROUTINE add_msg_24pt_doubleprecision ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_8pt ( fld , kdim )
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(n2w2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2w,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2e,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2e2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(nw2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(ne2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(sw2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(se2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2w2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2w,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2e,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2e2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(n2w2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2w,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2e,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2e2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(nw2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(ne2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(sw2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(se2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2w2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2w,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2e,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2e2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_24pt_doubleprecision
+#endif
+
+
+   SUBROUTINE add_msg_24pt_integer ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_8pt ( fld , kdim )
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(n2w2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2w,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2e,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2e2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(nw2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(ne2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(sw2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(se2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2w2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2w,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2e,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2e2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(n2w2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2w,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2e,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2e2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(nw2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(ne2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(sw2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(se2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2w2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2w,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2e,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2e2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_24pt_integer
+
+   SUBROUTINE add_msg_48pt_real ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_24pt ( fld , kdim )
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(n3w3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3w2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3w,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3e,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3e2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3e3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2w3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2e3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(nw3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(ne3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(sw3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(se3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2w3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2e3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3w3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3w2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3w,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3e,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3e2,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3e3,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(n3w3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3w2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3w,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3e,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3e2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3e3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2w3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2e3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(nw3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(ne3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(sw3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(se3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2w3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2e3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3w3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3w2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3w,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3e,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3e2,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3e3,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_48pt_real
+
+#if ( RWORDSIZE != DWORDSIZE )
+   SUBROUTINE add_msg_48pt_doubleprecision ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_24pt ( fld , kdim )
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(n3w3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3w2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3w,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3e,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3e2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3e3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2w3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2e3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(nw3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(ne3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(sw3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(se3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2w3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2e3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3w3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3w2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3w,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3e,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3e2,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3e3,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(n3w3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3w2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3w,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3e,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3e2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3e3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2w3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2e3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(nw3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(ne3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(sw3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(se3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2w3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2e3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3w3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3w2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3w,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3e,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3e2,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3e3,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_48pt_doubleprecision
+#endif
+
+   SUBROUTINE add_msg_48pt_integer ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      CALL add_msg_24pt ( fld , kdim )
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(n3w3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3w2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3w,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3e,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3e2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n3e3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2w3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(n2e3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(nw3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(ne3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(w3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(e3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(sw3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(se3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2w3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s2e3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3w3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3w2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3w,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3e,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3e2,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+        CALL rsl_build_message(s3e3,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(n3w3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3w2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3w,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3e,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3e2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n3e3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2w3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(n2e3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(nw3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(ne3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(w3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(e3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(sw3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(se3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2w3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s2e3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3w3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3w2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3w,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3e,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3e2,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+        CALL rsl_build_message(s3e3,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_48pt_integer
+
+
+   SUBROUTINE add_msg_80pt_real ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(msg_msg,TRUE_RSL_REAL_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(msg_msg,TRUE_RSL_REAL_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_80pt_real
+
+#if ( RWORDSIZE != DWORDSIZE )
+   SUBROUTINE add_msg_80pt_doubleprecision ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim   
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(msg_msg,RSL_DOUBLE_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(msg_msg,RSL_DOUBLE_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_80pt_doubleprecision 
+#endif
+
+   SUBROUTINE add_msg_80pt_integer ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = kdim    ; ll(2) = kdim
+           gl(3) = glen(3) ; ll(3) = llen(3)
+         CASE ( DATA_ORDER_XYZ )
+           gl(1) = glen(1) ; ll(1) = llen(1)
+           gl(2) = glen(2) ; ll(2) = llen(2)
+           gl(3) = kdim    ; ll(3) = kdim
+         CASE DEFAULT
+      END SELECT
+      if      ( kdim >  1 ) then
+        CALL rsl_build_message(msg_msg,RSL_INTEGER_F90,fld,3,decomp(1),gl(1),ll(1))
+      else if ( kdim == 1 ) then
+        CALL rsl_build_message(msg_msg,RSL_INTEGER_F90,fld,2,decomp2d(1),glen2d(1),llen2d(1))
+      endif
+      RETURN
+   END SUBROUTINE add_msg_80pt_integer
+
+   SUBROUTINE add_msg_120pt_real ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      real fld(*)
+      CALL add_msg_80pt ( fld , kdim )
+      RETURN
+   END SUBROUTINE add_msg_120pt_real
+
+#if ( RWORDSIZE != DWORDSIZE )
+   SUBROUTINE add_msg_120pt_doubleprecision ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      doubleprecision fld(*)
+      CALL add_msg_80pt ( fld , kdim )
+      RETURN
+   END SUBROUTINE add_msg_120pt_doubleprecision
+#endif
+
+   SUBROUTINE add_msg_120pt_integer ( fld , kdim )
+      IMPLICIT NONE
+      integer kdim, gl(3), ll(3)
+      integer fld(*)
+      CALL add_msg_80pt ( fld , kdim )
+      RETURN
+   END SUBROUTINE add_msg_120pt_integer
+
+   SUBROUTINE stencil_y_shift ( did , stenid )
+      IMPLICIT NONE
+      INTEGER did, stenid
+      INTEGER i
+      DO i = 1, 48
+        messages(i) = n1
+      ENDDO
+      CALL rsl_create_stencil( stenid )
+      CALL rsl_describe_stencil ( did, stenid, RSL_48PT, messages )
+      RETURN
+   END SUBROUTINE stencil_y_shift
+
+   SUBROUTINE stencil_x_shift ( did , stenid )
+      IMPLICIT NONE
+      INTEGER did, stenid
+      INTEGER i
+      DO i = 1, 48
+        messages(i) = w1
+      ENDDO
+      CALL rsl_create_stencil( stenid )
+      CALL rsl_describe_stencil ( did, stenid, RSL_48PT, messages )
+      RETURN
+   END SUBROUTINE stencil_x_shift
+
+   SUBROUTINE stencil_4pt ( did, stenid )
+      IMPLICIT NONE
+      INTEGER did, stenid
+      messages(1) =          n1
+      messages(2) =   w1
+      messages(3) =                 e1
+      messages(4) =          s1
+      CALL rsl_create_stencil( stenid )
+      CALL rsl_describe_stencil ( did, stenid, RSL_4PT, messages )
+      RETURN
+   END SUBROUTINE stencil_4pt
+
+   SUBROUTINE stencil_8pt ( did, stenid )
+      IMPLICIT NONE
+      INTEGER did, stenid
+      messages(1) =   nw
+      messages(2) =          n1
+      messages(3) =                 ne
+      messages(4) =   w1
+      messages(5) =                 e1
+      messages(6) =   sw
+      messages(7) =          s1
+      messages(8) =                 se
+      CALL rsl_create_stencil( stenid )
+      CALL rsl_describe_stencil ( did, stenid, RSL_8PT, messages )
+      RETURN
+   END SUBROUTINE stencil_8pt
+
+   SUBROUTINE stencil_12pt ( did, stenid )
+      IMPLICIT NONE
+      INTEGER did, stenid
+      messages(1)  =                 n2
+      messages(2)  =          nw
+      messages(3)  =                 n1
+      messages(4)  =                           ne
+      messages(5)  =  w2
+      messages(6)  =          w1                  
+      messages(7)  =                           e1
+      messages(8)  =                                    e2
+      messages(9)  =          sw
+      messages(10) =                 s1
+      messages(11) =                           se
+      messages(12) =                 s2
+      CALL rsl_create_stencil( stenid )
+      CALL rsl_describe_stencil ( did, stenid, RSL_12PT, messages )
+      RETURN
+   END SUBROUTINE stencil_12pt
+
+   SUBROUTINE stencil_24pt ( did, stenid )
+      IMPLICIT NONE
+      INTEGER did, stenid, i
+      messages( 1) = n2w2
+      messages( 2) = n2w
+      messages( 3) = n2
+      messages( 4) = n2e
+      messages( 5) = n2e2
+      messages( 6) = nw2
+      messages( 7) = nw
+      messages( 8) = n1
+      messages( 9) = ne
+      messages(10) = ne2
+      messages(11) = w2
+      messages(12) = w1
+      messages(13) = e1
+      messages(14) = e2
+      messages(15) = sw2
+      messages(16) = sw
+      messages(17) = s1
+      messages(18) = se
+      messages(19) = se2
+      messages(20) = s2w2
+      messages(21) = s2w
+      messages(22) = s2
+      messages(23) = s2e
+      messages(24) = s2e2
+      CALL rsl_create_stencil( stenid )
+      CALL rsl_describe_stencil ( did, stenid, RSL_24PT, messages )
+      RETURN
+   END SUBROUTINE stencil_24pt
+
+   SUBROUTINE stencil_48pt ( did, stenid )
+      IMPLICIT NONE
+      INTEGER did, stenid, i
+      messages( 1) = n3w3
+      messages( 2) = n3w2
+      messages( 3) = n3w
+      messages( 4) = n3
+      messages( 5) = n3e
+      messages( 6) = n3e2
+      messages( 7) = n3e3
+      messages( 8) = n2w3
+      messages( 9) = n2w2
+      messages(10) = n2w
+      messages(11) = n2
+      messages(12) = n2e
+      messages(13) = n2e2
+      messages(14) = n2e3
+      messages(15) = nw3
+      messages(16) = nw2
+      messages(17) = nw
+      messages(18) = n1
+      messages(19) = ne
+      messages(20) = ne2
+      messages(21) = ne3
+      messages(22) = w3
+      messages(23) = w2
+      messages(24) = w1
+      messages(25) = e1
+      messages(26) = e2
+      messages(27) = e3
+      messages(28) = sw3
+      messages(29) = sw2
+      messages(30) = sw
+      messages(31) = s1
+      messages(32) = se
+      messages(33) = se2
+      messages(34) = se3
+      messages(35) = s2w3
+      messages(36) = s2w2
+      messages(37) = s2w
+      messages(38) = s2
+      messages(39) = s2e
+      messages(40) = s2e2
+      messages(41) = s2e3
+      messages(42) = s3w3
+      messages(43) = s3w2
+      messages(44) = s3w
+      messages(45) = s3
+      messages(46) = s3e
+      messages(47) = s3e2
+      messages(48) = s3e3
+      CALL rsl_create_stencil( stenid )
+      CALL rsl_describe_stencil ( did, stenid, RSL_48PT, messages )
+      RETURN
+   END SUBROUTINE stencil_48pt
+
+   SUBROUTINE stencil_80pt ( did, stenid )
+      IMPLICIT NONE
+      INTEGER did, stenid, i
+#if 1
+      do i = 1, 80
+         messages(i) = msg_msg
+      enddo
+#else
+messages(1)=    n4w4
+messages(2)=    n4w3
+messages(3)=    n4w2
+messages(4)=    n4w
+messages(5)=    n4
+messages(6)=    n4e
+messages(7)=    n4e2
+messages(8)=    n4e3
+messages(9)=    n4e4
+messages(10)=   n3w4
+messages(11)=   n3w3
+messages(12)=   n3w2
+messages(13)=   n3w
+messages(14)=   n3
+messages(15)=   n3e
+messages(16)=   n3e2
+messages(17)=   n3e3
+messages(18)=   n3e4
+messages(19)=   n2w4
+messages(20)=   n2w3
+messages(21)=   n2w2
+messages(22)=   n2w
+messages(23)=   n2
+messages(24)=   n2e
+messages(25)=   n2e2
+messages(26)=   n2e3
+messages(27)=   n2e4
+messages(28)=   nw4
+messages(29)=   nw3
+messages(30)=   nw2
+messages(31)=   nw
+messages(32)=   n1
+messages(33)=   ne
+messages(34)=   ne2
+messages(35)=   ne3
+messages(36)=   ne4
+messages(37)=   w4
+messages(38)=   w3
+messages(39)=   w2
+messages(40)=   w1
+messages(41)=   e1
+messages(42)=   e2
+messages(43)=   e3
+messages(44)=   e4
+messages(45)=   sw4
+messages(46)=   sw3
+messages(47)=   sw2
+messages(48)=   sw
+messages(49)=   s1
+messages(50)=   se
+messages(51)=   se2
+messages(52)=   se3
+messages(53)=   se4
+messages(54)=   s2w4
+messages(55)=   s2w3
+messages(56)=   s2w2
+messages(57)=   s2w
+messages(58)=   s2
+messages(59)=   s2e
+messages(60)=   s2e2
+messages(61)=   s2e3
+messages(62)=   s2e4
+messages(63)=   s3w4
+messages(64)=   s3w3
+messages(65)=   s3w2
+messages(66)=   s3w
+messages(67)=   s3
+messages(68)=   s3e
+messages(69)=   s3e2
+messages(70)=   s3e3
+messages(71)=   s3e4
+messages(72)=   s4w4
+messages(73)=   s4w3
+messages(74)=   s4w2
+messages(75)=   s4w
+messages(76)=   s4
+messages(77)=   s4e
+messages(78)=   s4e2
+messages(79)=   s4e3
+messages(80)=   s4e4
+#endif
+      CALL rsl_create_stencil( stenid )
+      CALL rsl_describe_stencil ( did, stenid, RSL_80PT, messages )
+      RETURN
+   END SUBROUTINE stencil_80pt
+
+   SUBROUTINE stencil_120pt ( did, stenid )
+      IMPLICIT NONE
+      INTEGER did, stenid, i
+#if 1
+      do i = 1, 120
+         messages(i) = msg_msg
+      enddo
+#else
+messages(1)=    n5w5
+messages(2)=    n5w4
+messages(3)=    n5w3
+messages(4)=    n5w2
+messages(5)=    n5w
+messages(6)=    n5
+messages(7)=    n5e
+messages(8)=    n5e2
+messages(9)=    n5e3
+messages(10)=   n5e4
+messages(11)=   n5e5
+messages(12)=   n4w5
+messages(13)=   n4w4
+messages(14)=   n4w3
+messages(15)=   n4w2
+messages(16)=   n4w
+messages(17)=   n4
+messages(18)=   n4e
+messages(19)=   n4e2
+messages(20)=   n4e3
+messages(21)=   n4e4
+messages(22)=   n4e5
+messages(23)=   n3w5
+messages(24)=   n3w4
+messages(25)=   n3w3
+messages(26)=   n3w2
+messages(27)=   n3w
+messages(28)=   n3
+messages(29)=   n3e
+messages(30)=   n3e2
+messages(31)=   n3e3
+messages(32)=   n3e4
+messages(33)=   n3e5
+messages(34)=   n2w5
+messages(35)=   n2w4
+messages(36)=   n2w3
+messages(37)=   n2w2
+messages(38)=   n2w
+messages(39)=   n2
+messages(40)=   n2e
+messages(41)=   n2e2
+messages(42)=   n2e3
+messages(43)=   n2e4
+messages(44)=   n2e5
+messages(45)=   nw5
+messages(46)=   nw4
+messages(47)=   nw3
+messages(48)=   nw2
+messages(49)=   nw
+messages(50)=   n1
+messages(51)=   ne
+messages(52)=   ne2
+messages(53)=   ne3
+messages(54)=   ne4
+messages(55)=   ne5
+messages(56)=   w5
+messages(57)=   w4
+messages(58)=   w3
+messages(59)=   w2
+messages(60)=   w1
+messages(61)=   e1
+messages(62)=   e2
+messages(63)=   e3
+messages(64)=   e4
+messages(65)=   e5
+messages(66)=   sw5
+messages(67)=   sw4
+messages(68)=   sw3
+messages(69)=   sw2
+messages(70)=   sw
+messages(71)=   s1
+messages(72)=   se
+messages(73)=   se2
+messages(74)=   se3
+messages(75)=   se4
+messages(76)=   se5
+messages(77)=   s2w5
+messages(78)=   s2w4
+messages(79)=   s2w3
+messages(80)=   s2w2
+messages(81)=   s2w
+messages(82)=   s2
+messages(83)=   s2e
+messages(84)=   s2e2
+messages(85)=   s2e3
+messages(86)=   s2e4
+messages(87)=   s2e5
+messages(88)=   s3w5
+messages(89)=   s3w4
+messages(90)=   s3w3
+messages(91)=   s3w2
+messages(92)=   s3w
+messages(93)=   s3
+messages(94)=   s3e
+messages(95)=   s3e2
+messages(96)=   s3e3
+messages(97)=   s3e4
+messages(98)=   s3e5
+messages(99)=   s4w5
+messages(100)=  s4w4
+messages(101)=  s4w3
+messages(102)=  s4w2
+messages(103)=  s4w
+messages(104)=  s4
+messages(105)=  s4e
+messages(106)=  s4e2
+messages(107)=  s4e3
+messages(108)=  s4e4
+messages(109)=  s4e5
+messages(110)=  s5w5
+messages(111)=  s5w4
+messages(112)=  s5w3
+messages(113)=  s5w2
+messages(114)=  s5w
+messages(115)=  s5
+messages(116)=  s5e
+messages(117)=  s5e2
+messages(118)=  s5e3
+messages(119)=  s5e4
+messages(120)=  s5e5
+#endif
+      CALL rsl_create_stencil( stenid )
+      CALL rsl_describe_stencil ( did, stenid, RSL_120PT, messages )
+      RETURN
+   END SUBROUTINE stencil_120pt
+
+   SUBROUTINE period_def ( did, perid, w )
+      IMPLICIT NONE
+      INTEGER did, perid, w
+      CALL rsl_create_period( perid )
+      CALL rsl_describe_period ( did, perid, w, msg )
+      RETURN
+   END SUBROUTINE period_def
+
+   SUBROUTINE setup_halo_rsl( grid )
+       USE module_domain
+       IMPLICIT NONE
+       TYPE(domain) , INTENT (INOUT) :: grid 
+      INTEGER i, kms, ims, jms
+   ! executable
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_ZXY )
+            kms = grid%sm31
+            ims = grid%sm32
+            jms = grid%sm33
+            decomp(1) = RSL_NOTDECOMPOSED
+            decomp(2) = RSL_M
+            decomp(3) = RSL_N
+            decomp2d(1) = RSL_M
+            decomp2d(2) = RSL_N
+            glen2d(1) = grid%ed32 - grid%sd32 + 1
+            glen2d(2) = grid%ed33 - grid%sd33 + 1
+            llen2d(1) = grid%em32 - grid%sm32 + 1
+            llen2d(2) = grid%em33 - grid%sm33 + 1
+         CASE ( DATA_ORDER_XYZ )
+            kms = grid%sm33
+            ims = grid%sm31
+            jms = grid%sm32
+            decomp(1) = RSL_M
+            decomp(2) = RSL_N
+            decomp(3) = RSL_NOTDECOMPOSED
+            decomp2d(1) = RSL_M
+            decomp2d(2) = RSL_N
+            glen2d(1) = grid%ed31 - grid%sd31 + 1
+            glen2d(2) = grid%ed32 - grid%sd32 + 1
+            llen2d(1) = grid%em31 - grid%sm31 + 1
+            llen2d(2) = grid%em32 - grid%sm32 + 1
+         CASE ( DATA_ORDER_XZY )
+            kms = grid%sm32
+            ims = grid%sm31
+            jms = grid%sm33
+            decomp(1) = RSL_M
+            decomp(2) = RSL_NOTDECOMPOSED
+            decomp(3) = RSL_N
+            decomp2d(1) = RSL_M
+            decomp2d(2) = RSL_N
+            glen2d(1) = grid%ed31 - grid%sd31 + 1
+            glen2d(2) = grid%ed33 - grid%sd33 + 1
+            llen2d(1) = grid%em31 - grid%sm31 + 1
+            llen2d(2) = grid%em33 - grid%sm33 + 1
+         CASE ( DATA_ORDER_YXZ )
+            kms = grid%sm33
+            ims = grid%sm32
+            jms = grid%sm31
+            decomp(1) = RSL_N
+            decomp(2) = RSL_M
+            decomp(3) = RSL_NOTDECOMPOSED
+            decomp2d(1) = RSL_N
+            decomp2d(2) = RSL_M
+            glen2d(1) = grid%ed32 - grid%sd32 + 1
+            glen2d(2) = grid%ed31 - grid%sd31 + 1
+            llen2d(1) = grid%em32 - grid%sm32 + 1
+            llen2d(2) = grid%em31 - grid%sm31 + 1
+      END SELECT
+
+      glen(1)   = grid%ed31 - grid%sd31 + 1
+      glen(2)   = grid%ed32 - grid%sd32 + 1
+      glen(3)   = grid%ed33 - grid%sd33 + 1
+      llen(1)   = grid%em31 - grid%sm31 + 1
+      llen(2)   = grid%em32 - grid%sm32 + 1
+      llen(3)   = grid%em33 - grid%sm33 + 1
+
+   END SUBROUTINE setup_halo_rsl
+
+
+   SUBROUTINE setup_xpose_rsl( grid )
+       USE module_domain
+       IMPLICIT NONE
+       TYPE(domain) , INTENT (INOUT) :: grid 
+      INTEGER i, kms, ims, jms
+
+      CALL setup_halo_rsl ( grid )
+
+      llen_tx(1) = grid%em31x - grid%sm31x + 1
+      llen_tx(2) = grid%em32x - grid%sm32x + 1
+      llen_tx(3) = grid%em33x - grid%sm33x + 1
+      llen_ty(1) = grid%em31y - grid%sm31y + 1
+      llen_ty(2) = grid%em32y - grid%sm32y + 1
+      llen_ty(3) = grid%em33y - grid%sm33y + 1
+
+   END SUBROUTINE setup_xpose_rsl
+
+   SUBROUTINE setup_period_rsl( grid )
+       USE module_domain
+       IMPLICIT NONE
+       TYPE(domain) , INTENT (INOUT) :: grid 
+      INTEGER i, kms, ims, jms
+
+      CALL setup_xpose_rsl ( grid )
+
+   ! Define periodic BC's -- for the period routines, the glen
+   ! array contains the actual logical size of the field (that is,
+   ! staggering is explicitly stated).  Llen is not affected.
+
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_XZY )
+
+      glen(1)    = grid%ed31 - grid%sd31
+      glen(2)    = grid%ed32 - grid%sd32 + 1
+      glen(3)    = grid%ed33 - grid%sd33
+      glenx(1)   = glen(1)
+      glenx(2)   = glen(2)
+      glenx(3)   = glen(3)
+      gleny(1)   = glen(1)
+      gleny(2)   = glen(2)
+      gleny(3)   = glen(3)
+      glenxy(1)   = glen(1)
+      glenxy(2)   = glen(2)
+      glenxy(3)   = glen(3)
+      llenx(1)   = llen(1)
+      llenx(2)   = llen(2)
+      llenx(3)   = llen(3)
+      lleny(1)   = llen(1)
+      lleny(2)   = llen(2)
+      lleny(3)   = llen(3)
+      llenxy(1)   = llen(1)
+      llenxy(2)   = llen(2)
+      llenxy(3)   = llen(3)
+
+      glen2d(1)    = grid%ed31 - grid%sd31
+      glen2d(2)    = grid%ed33 - grid%sd33
+      glenx2d(1)   = glen2d(1)
+      glenx2d(2)   = glen2d(2)
+      gleny2d(1)   = glen2d(1)
+      gleny2d(2)   = glen2d(2)
+      glenxy2d(1)  = glen2d(1)
+      glenxy2d(2)  = glen2d(2)
+      llenx2d(1)   = llen2d(1)
+      llenx2d(2)   = llen2d(2)
+      lleny2d(1)   = llen2d(1)
+      lleny2d(2)   = llen2d(2)
+      llenxy2d(1)   = llen2d(1)
+      llenxy2d(2)   = llen2d(2)
+
+      decompx(1)   = RSL_M_STAG
+      decompx(2)   = RSL_NOTDECOMPOSED
+      decompx(3)   = RSL_N
+      decompy(1)   = RSL_M
+      decompy(2)   = RSL_NOTDECOMPOSED
+      decompy(3)   = RSL_N_STAG
+      decompxy(1)  = RSL_M_STAG
+      decompxy(2)  = RSL_NOTDECOMPOSED
+      decompxy(3)  = RSL_N_STAG
+
+      decomp2d(1)  = RSL_M
+      decomp2d(2)  = RSL_N
+
+      decompx2d(1)  = RSL_M_STAG
+      decompx2d(2)  = RSL_N
+
+      decompy2d(1)  = RSL_M
+      decompy2d(2)  = RSL_N_STAG
+
+      decompxy2d(1)  = RSL_M_STAG
+      decompxy2d(2)  = RSL_N_STAG
+
+         CASE DEFAULT
+            CALL wrf_error_fatal ( "module_dm: setup_period_rsl: unsuppported data order" )
+
+      END SELECT
+
+      RETURN
+   END SUBROUTINE setup_period_rsl
+
+!------------------------------------------------------------------
+   INTEGER FUNCTION intermediate_mapping ( w1, w2, info, m, n, py, px )
+      IMPLICIT NONE
+      INTEGER, DIMENSION(*)   :: w1, w2
+      REAL, DIMENSION(*)      :: info
+      INTEGER, INTENT(IN)     :: m, n, py, px
+      INTEGER                 :: nest_m, nest_n, nri, nrj, nest_domdesc, shw
+! <DESCRIPTION>
+! This is a routine provided by the rsl external comm layer.
+! and is defined in external/RSL/module_dm.F, which is copied
+! into frame/module_dm.F at compile time.  Changes to frame/module_dm.F
+! will be lost.
+! 
+! This routine is related to nesting and is used by the rsl domain
+! decomposition algorithm to decompose an domain that serves as an
+! intermediary between the parent domain and the nest. This intermediate
+! domain is at the coarse domain's resolution but it is only large enough
+! to cover the region of the nested domain plus an extra number of cells
+! out onto the coarse domain around the region of the nest (this number
+! is specified by the namelist variable shw, default 2). The intermediate
+! domain is decomposed using the nested domain's decomposition
+! information so that all interpolations from coarse domain data to the
+! nest may be done locally on the processor without communication.  (The
+! communication occurs during the transfer of data between the parent
+! domain and the intermediate domain.  See <a
+! href=interp_domain_em_part1.html>interp_domain_em_part1</a>, <a
+! href=interp_domain_em_part2.html>interp_domain_em_part2</a>, <a
+! href=force_domain_em_part2.html>force_domain_em_part2</a>, <a
+! href=feedback_domain_em_part1.html>feedback_domain_em_part1</a>, and <a
+! href=feedback_domain_em_part2.html>feedback_domain_em_part2</a>.)
+! 
+! This routine and it's companion intermediate_mapping2 call the rsl
+! routine GET_DOMAIN_DECOMP passing it the rsl domain descriptor for the
+! nest to retrieve from rsl the nested decomposition.  This information
+! is then used to decomposed the intermediate domain.
+! 
+! Rsl is given the intermediate_mapping function to use when decomposing
+! the intermediate domain with a call to:
+! 
+!   <tt>CALL set_def_decomp_fcn1 ( intermediate_domdesc, intermediate_mapping )</tt>
+! 
+! inside the routine <a href=patch_domain_rsl.html>patch_domain_rsl</a>
+! that is also defined in external/RSL/module_dm.F.
+!
+! </DESCRIPTION>
+
+      nest_m = int(info(1)+.01) ; nest_n = int(info(2)+.01) ; nest_domdesc = int(info(3)+.01)
+      nri = int(info(4)+.01)    ; nrj    = int(info(5)+.01)
+      shw = int(info(6)+.01)
+      CALL  intermediate_mapping2 ( w1, w2, info, m, n, nest_m, nest_n, nest_domdesc, py, px, nri, nrj, shw )
+      intermediate_mapping = 0
+      RETURN
+   END FUNCTION intermediate_mapping
+
+   SUBROUTINE intermediate_mapping2 ( w1, w2, info, m, n, nest_m, nest_n, nest_domdesc, py, px, nri, nrj, shw )
+      IMPLICIT NONE
+      INTEGER, DIMENSION(*)   :: w1, w2
+      REAL, DIMENSION(*)      :: info
+      INTEGER, INTENT(IN)     :: m, n, nest_m, nest_n, nest_domdesc, py, px, nri, nrj, shw
+      INTEGER                 :: nest_decomp( nest_m, nest_n )
+      INTEGER                 :: i, j
+! <DESCRIPTION>
+! See <a href=intermediate_mapping.html>intermediate_mapping</a>.
+! </DESCRIPTION>
+
+
+      CALL GET_DOMAIN_DECOMP ( nest_domdesc, nest_decomp, nest_m*nest_n )
+      DO j = 1, nest_n, nrj
+        DO i = 1, nest_m, nri
+          w2((i/nri+1+shw) + (j/nrj+1-1+shw)*m) = nest_decomp(i,j)
+        ENDDO
+      ENDDO
+#if 1
+      ! fill out the stencil to the edges of the intermediate domain
+      do j = 1,n
+        do i = 1,shw
+          w2(i+(j-1)*m) = w2(shw+1+(j-1)*m)
+        enddo
+        do i = m,m-shw-1,-1
+          w2(i+(j-1)*m) = w2(m-shw-2+(j-1)*m)
+        enddo
+      enddo
+      do i = 1,m
+        do j = 1,shw
+          w2(i+(j-1)*m) = w2(i+(shw+1-1)*m)
+        enddo
+        do j = n,n-shw-1,-1
+          w2(i+(j-1)*m) = w2(i+(n-shw-2-1)*m)
+        enddo
+      enddo
+#endif
+
+      RETURN
+   END SUBROUTINE intermediate_mapping2
+
+!------------------------------------------------------------------
+
+   SUBROUTINE patch_domain_rsl( id  , domdesc , parent, parent_id , parent_domdesc , &
+                                sd1 , ed1 , sp1 , ep1 , sm1 , em1 ,        &
+                                sd2 , ed2 , sp2 , ep2 , sm2 , em2 ,        &
+                                sd3 , ed3 , sp3 , ep3 , sm3 , em3 ,        &
+                                            sp1x , ep1x , sm1x , em1x ,        &
+                                            sp2x , ep2x , sm2x , em2x ,        &
+                                            sp3x , ep3x , sm3x , em3x ,        &
+                                            sp1y , ep1y , sm1y , em1y ,        &
+                                            sp2y , ep2y , sm2y , em2y ,        &
+                                            sp3y , ep3y , sm3y , em3y ,        &
+                                bdx , bdy )
+
+      USE module_domain
+      USE module_machine
+
+      IMPLICIT NONE
+      INTEGER, INTENT(IN)   :: sd1 , ed1 , sd2 , ed2 , sd3 , ed3 , bdx , bdy
+      INTEGER, INTENT(OUT)  :: sp1 , ep1 , sp2 , ep2 , sp3 , ep3 , &
+                               sm1 , em1 , sm2 , em2 , sm3 , em3
+      INTEGER, INTENT(OUT)  :: sp1x , ep1x , sp2x , ep2x , sp3x , ep3x , &
+                               sm1x , em1x , sm2x , em2x , sm3x , em3x
+      INTEGER, INTENT(OUT)  :: sp1y , ep1y , sp2y , ep2y , sp3y , ep3y , &
+                               sm1y , em1y , sm2y , em2y , sm3y , em3y
+      INTEGER, INTENT(IN)   :: id
+      INTEGER, INTENT(OUT)  :: domdesc
+      INTEGER, INTENT(IN)   :: parent_id
+      INTEGER, INTENT(IN)   :: parent_domdesc
+      TYPE(domain),POINTER  :: parent
+
+! <DESCRIPTION>
+! This is a routine provided by the rsl external comm layer.
+! and is defined in external/RSL/module_dm.F, which is copied
+! into frame/module_dm.F at compile time.  Changes to frame/module_dm.F
+! will be lost.
+! 
+! This routine is called by <a
+! href=wrf_dm_patch_domain.html>wrf_dm_patch_domain</a>, the rsl
+! package-supplied routine that is called by <a
+! href=wrf_patch_domain.html>wrf_patch_domain</a> in the course of
+! setting up a new domain when running WRF on distributed memory parallel
+! computers.  This provides the rsl-specific mechanisms for defining and
+! decomposing a domain, and for associating it within rsl to it's parent
+! domain (in the case of a nest).
+!
+! The routine takes as input arguments the domain id, the index of the
+! domain in the namelist (top-most domain is id=1) the parent's id and
+! rsl domain descriptor (if there is a parent), and the the global
+! (undecomposed) dimensions of the new domain. The routine returns the
+! patch dimensions (computational extent),  memory dimensions (local
+! array sizes on each task), and an rsl domain descriptor for the new
+! domain.  The width of the x and y boundary regions is also passed in
+! (defined in <a href=../../share/module_bc.f>share/module_bc.F</a>) and
+! are used in the calculation of the memory dimensions.
+! 
+! <b>Nesting </b>
+! 
+! This routine also defines, decomposes, and associates the intermediate
+! domain that is used to transfer forcing and feedback data between a
+! nest and its parent domain.
+! 
+! The relationship between a parent domain, the nest, and this
+! intermediate domain is stored partly in rsl and partly in WRF as fields
+! in the TYPE(domain) data structure (defined in <a
+! href=../../frame/module_domain.f>frame/module_domain.F</a>).
+! 
+! Basically, the rsl-maintained relationship is between the parent domain
+! and the intermediate domain; for purposes of interprocessor
+! communication and forcing and feedback, rsl considers the nest a
+! standalone domain. This is because all of the rsl-mediated
+! communication for moving data between processors for forcing and
+! feedback is between the parent and the intermediate domain.  The
+! movement of data between the intermediate domain and the nest is all
+! on-processor, and therefore does not involve rsl to a large extent.
+! 
+! The WRF-maintained relationship between a parent and a nest is
+! represented through pointers in TYPE(domain).  The parent domain
+! maintains an array of pointers to its children through the
+! <em>nests</em> field of TYPE(domain).  The nest has a back-pointer to
+! its parent through <em>parents</em> (there is only ever one parent of a
+! nest in WRF).  The nest also holds the pointer to the intermediate
+! domain, called <em>intermediate_grid</em>.
+! 
+! The actual forcing and feedback between parent, nest, and intermediate
+! domains are handled by other routines defined in
+! external/RSL/module_dm.F. See See <a
+! href=interp_domain_em_part1.html>interp_domain_em_part1</a>, <a
+! href=interp_domain_em_part2.html>interp_domain_em_part2</a>, <a
+! href=force_domain_em_part2.html>force_domain_em_part2</a>, <a
+! href=feedback_domain_em_part1.html>feedback_domain_em_part1</a>, and <a
+! href=feedback_domain_em_part2.html>feedback_domain_em_part2</a>.)
+!
+! </DESCRIPTION>
+
+! Local variables
+      INTEGER               :: c_sd1 , c_ed1 , c_sd2 , c_ed2 , c_sd3 , c_ed3
+      INTEGER               :: c_sp1 , c_ep1 , c_sp2 , c_ep2 , c_sp3 , c_ep3 , &
+                               c_sm1 , c_em1 , c_sm2 , c_em2 , c_sm3 , c_em3
+      INTEGER               :: c_sp1x , c_ep1x , c_sp2x , c_ep2x , c_sp3x , c_ep3x , &
+                               c_sm1x , c_em1x , c_sm2x , c_em2x , c_sm3x , c_em3x
+      INTEGER               :: c_sp1y , c_ep1y , c_sp2y , c_ep2y , c_sp3y , c_ep3y , &
+                               c_sm1y , c_em1y , c_sm2y , c_em2y , c_sm3y , c_em3y
+
+      INTEGER               :: mloc , nloc , zloc         ! all k on same proc
+      INTEGER               :: mloc_x , nloc_x , zloc_x   ! all x on same proc
+      INTEGER               :: mloc_y , nloc_y , zloc_y   ! all y on same proc
+      INTEGER               :: c_mloc , c_nloc , c_zloc         ! all k on same proc
+      INTEGER               :: c_mloc_x , c_nloc_x , c_zloc_x   ! all x on same proc
+      INTEGER               :: c_mloc_y , c_nloc_y , c_zloc_y   ! all y on same proc
+      INTEGER               :: mglob , nglob
+      INTEGER               :: idim , jdim , kdim , i
+      INTEGER , PARAMETER   :: rsl_jjx_x = 2047
+      INTEGER , DIMENSION( rsl_jjx_x ) :: rsl_js_x0 , rsl_je_x0 , rsl_is_x0 , rsl_ie_x0
+      INTEGER                          :: rsl_xinest_x0 , rsl_idif_x0 , rsl_jdif_x0
+      INTEGER               :: i_parent_start , j_parent_start
+      INTEGER               :: ids, ide, jds, jde, kds, kde
+      INTEGER               :: c_ids, c_ide, c_jds, c_jde, c_kds, c_kde
+      INTEGER               :: parent_grid_ratio
+      INTEGER               :: shw
+      INTEGER               :: idim_cd, jdim_cd, intermediate_domdesc
+      INTEGER               :: intermediate_mloc, intermediate_nloc
+      INTEGER               :: intermediate_mglob, intermediate_nglob
+      REAL                  :: info(7)
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER  :: nest_grid
+
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_ZXY )
+            idim = ed2-sd2+1
+            jdim = ed3-sd3+1
+            kdim = ed1-sd1+1
+         CASE ( DATA_ORDER_XYZ )
+            idim = ed1-sd1+1
+            jdim = ed2-sd2+1
+            kdim = ed3-sd3+1
+         CASE ( DATA_ORDER_XZY )
+            idim = ed1-sd1+1
+            jdim = ed3-sd3+1
+            kdim = ed2-sd2+1
+         CASE ( DATA_ORDER_YXZ)
+            idim = ed2-sd2+1
+            jdim = ed1-sd1+1
+            kdim = ed3-sd3+1
+      END SELECT
+      if ( id == 1 ) then
+! <DESCRIPTION>
+! <b> Main Domain </b>
+!
+! The top-level WRF domain (id = 1) is set up when <a
+! href=alloc_and_configure_domain.html>alloc_and_configure_domain</a> is
+! called from <a href=wrf.html>wrf</a>.  This is done here in
+! rsl_patch_domain with a call to RSL_MOTHER_DOMAIN3D.  The global domain
+! dimensions are converted to the length of each dimension in i, j, and k
+! for the domain (based on model_data_order, which is defined in <a
+! href=../../frame/module_driver_constants.f>frame/module_driver_constants.F</a>,
+! based on the dimspec entries in the Registry.  In WRF the X/I dimension
+! corresponds to the the first dimension, the Z/K dimension the second,
+! and the Y/J the third.
+!
+! An rsl tag denoting the largest stencil to be used on the domain is
+! also provided. This is RSL_24PT for the EM core; the NMM core uses a
+! wider maximum stencil, RSL_120PT.  On return, the RSL domain descriptor
+! for the domain will be defined along with rsl's advice on the minimum
+! memory required for the memory dimensions on this task.
+! 
+! Rsl supports
+! alternate decompositions of the domain -- X/Z and Y/Z -- and
+! transposition operations between these decompositions. These are used
+! in WRF 3DVAR but not in the EM version of the WRF model itself, which
+! is always only an X/Y decomposition.
+!
+! As a diagnostic, the rsl routine SHOW_DOMAIN_DECOMP is called, which
+! outputs a text file with information on the decomposition to the
+! file show_domain_0000 from processor zero.
+!
+! The actual memory dimensions that patch_domain_rsl are computed in a
+! call to <a
+! href=compute_memory_dims_using_rsl.html>compute_memory_dims_using_rsl</a>,
+! also defined in external/RSL/module_dm.F. Once these have been computed
+! the patch_domain_rsl returns.
+! 
+! </DESCRIPTION>
+
+#ifndef NMM_CORE
+         CALL rsl_mother_domain3d(domdesc, RSL_24PT,               &
+#else
+         CALL rsl_mother_domain3d(domdesc, RSL_120PT,               &
+#endif
+                                  idim   ,  jdim   ,  kdim   ,     &
+                                  mloc   ,  nloc   ,  zloc   ,     &
+                                  mloc_y ,  nloc_y ,  zloc_y ,     &   ! x->y 20020908
+                                  mloc_x ,  nloc_x ,  zloc_x       )   ! y->x 20020908
+         CALL show_domain_decomp(domdesc)
+         ! this computes the dimension information for the
+         ! nest and passes these back
+         CALL compute_memory_dims_using_rsl (          &
+                   domdesc ,                           &
+                   mloc   ,  nloc   ,  zloc   ,        &
+                   mloc_x ,  nloc_x ,  zloc_x ,        &
+                   mloc_y ,  nloc_y ,  zloc_y ,        &
+                   sd1,  ed1,  sd2,  ed2,  sd3,  ed3,  &
+                   sp1,  ep1,  sp2,  ep2,  sp3,  ep3,  &
+                   sp1x, ep1x, sp2x, ep2x, sp3x, ep3x, &
+                   sp1y, ep1y, sp2y, ep2y, sp3y, ep3y, &
+                   sm1,  em1,  sm2,  em2,  sm3,  em3,  &
+                   sm1x, em1x, sm2x, em2x, sm3x, em3x, &
+                   sm1y, em1y, sm2y, em2y, sm3y, em3y  )
+
+      else
+
+! <DESCRIPTION>
+! <b> Nested Domain </b>
+! For nested domains (id greater than 1), the patch_domain_rsl first
+! defines the nest itself in rsl as a stand-alone domain (as far as RSL
+! knows it has no parent), then sets up the the intermediate domain that,
+! from rsl's point of view, is a nest of the parent with a refinement
+! ratio of 1 to 1 (same resolution).
+! 
+! As with the top-most domain, the nested domain is defined using
+! RSL_MOTHER_DOMAIN3D and its memory dimensions are computed calling
+! compute_memory_dims_using_rsl, as above.
+!
+! </DESCRIPTION>
+         !
+         ! first spawn the actual nest. It is not
+         ! directly associated in rsl with the parent
+         ! so we spawn it as an unassociated domain
+         ! (another "mother")
+         !
+#ifndef NMM_CORE
+         CALL rsl_mother_domain3d(domdesc, RSL_24PT,               &
+#else
+         CALL rsl_mother_domain3d(domdesc, RSL_120PT,               &
+#endif
+                                  idim   ,  jdim   ,  kdim   ,     &
+                                  mloc   ,  nloc   ,  zloc   ,     &
+                                  mloc_y ,  nloc_y ,  zloc_y ,     &     ! x->y 20020910
+                                  mloc_x ,  nloc_x ,  zloc_x       )     ! y->x 20020910
+         CALL show_domain_decomp(domdesc)
+         ! this computes the dimension information for the
+         ! nest and passes these back
+         CALL compute_memory_dims_using_rsl (          &
+                   domdesc ,                           &
+                   mloc   ,  nloc   ,  zloc   ,        &
+                   mloc_x ,  nloc_x ,  zloc_x ,        &
+                   mloc_y ,  nloc_y ,  zloc_y ,        &
+                   sd1,  ed1,  sd2,  ed2,  sd3,  ed3,  &
+                   sp1,  ep1,  sp2,  ep2,  sp3,  ep3,  &
+                   sp1x, ep1x, sp2x, ep2x, sp3x, ep3x, &
+                   sp1y, ep1y, sp2y, ep2y, sp3y, ep3y, &
+                   sm1,  em1,  sm2,  em2,  sm3,  em3,  &
+                   sm1x, em1x, sm2x, em2x, sm3x, em3x, &
+                   sm1y, em1y, sm2y, em2y, sm3y, em3y  )
+
+! <DESCRIPTION>
+! Once the nest is defined, the intermediate
+! domain is defined and associated as a nest with the parent.
+! Here, SET_DEF_DECOMP_FCN1 is called, which directs rsl to use a special decomposition function,
+! <a href=intermediate_mapping.html>intermediate_mapping</a>, that
+! generates a decomposition of the intermediate domain in which
+! intermediate domain points are assigned to the same task as the nested
+! points they overlay (allowing the interpolation to be task-local).
+! This applies only to the intermediate domain; the default decmposition function
+! for other domains is not affected.
+! This decomposition algorithm also requires knowledge of the dimensions
+! of the nest, the nests rsl descriptor (defined above), the nesting
+! ratio, and the extra amount the intermediate domain should cover in the
+! coarse domain to allow for the stencil of the interpolator (the <a
+! href=sint.html>sint</a> routine.  This information is packed into an
+! "info" vector that is provided to rsl with a call to
+! SET_DEF_DECOMP_INFO.
+! 
+! </DESCRIPTION>
+
+
+         CALL nl_get_shw( id, shw )
+         CALL nl_get_i_parent_start( id , i_parent_start )
+         CALL nl_get_j_parent_start( id , j_parent_start )
+         CALL nl_get_parent_grid_ratio( id, parent_grid_ratio )
+
+         info(1) = idim               ! nest i dimension for intermediate mapping
+         info(2) = jdim               ! nest j dimension for intermediate mapping
+         info(3) = domdesc            ! nest domain descriptor
+         info(4) = parent_grid_ratio  ! nesting ratio in i
+         info(5) = parent_grid_ratio  ! nesting ratio in j
+         info(6) = shw                ! stencil half-width
+
+# if 1
+   ! tells which descriptor will be given back next when intermediate domain is spawned below
+   ! that is used to associate the decomposition information from the nested domain with
+   ! this intermediate domain, so that it will be decomposed identically, through 
+   ! the intermediate mapping function.
+         CALL get_next_domain_descriptor ( intermediate_domdesc )
+         CALL set_def_decomp_fcn1 ( intermediate_domdesc, intermediate_mapping )
+         CALL set_def_decomp_info ( intermediate_domdesc, info )
+# endif
+
+         ! now spawn the intermediate domain that will serve as the
+         ! nest-decomposed area of the CD domain, onto which data
+         ! will be transferred from the CD for interpolation
+         ! ** need to make sure the decomposition matches the
+         ! ** nested decomposition
+
+! <DESCRIPTION>
+! The undecomposed dimensions of the intermediate domain are computed along
+! with the location of the intermediate domain's lower left-hand point and these
+! are passed to the RSL_SPAWN_REGULAR_NEST1 routine, which defines the intermediate
+! domain as a nest with 1:1 refinement within the parent domain. The memory dimensions
+! of the intermediate domain are computed by calling COMPUTE_MEMORY_DIMS_USING_RSL
+! and then the intermediate domain is allocated as a WRF grid of TYPE(domain).
+! The flow of control here resembles that of <a href=alloc_and_configure_domain.html>
+! alloc_and_configure_domain</a>, in <a href=../../frame/module_domain.f>
+! frame/module_domain.F</a>.
+! </DESCRIPTION>
+
+         idim_cd = idim / parent_grid_ratio + 1 + 2*shw + 1
+         jdim_cd = jdim / parent_grid_ratio + 1 + 2*shw + 1
+
+         c_ids = i_parent_start-shw ; c_ide = c_ids + idim_cd - 1
+         c_jds = j_parent_start-shw ; c_jde = c_jds + jdim_cd - 1
+         c_kds = sd2                ; c_kde = ed2                   ! IKJ ONLY
+
+         CALL RSL_SPAWN_REGULAR_NEST1(                  &
+                intermediate_domdesc,                   &
+                parent_domdesc,                         &
+#ifndef NMM_CORE
+                RSL_24PT,                               &
+#else
+                RSL_120PT,                               &
+#endif
+                c_ids, c_jds,                               &
+                idim_cd,jdim_cd,                        &
+                1, 1,                                   &
+                intermediate_mloc,intermediate_nloc,    &
+                intermediate_mglob,intermediate_nglob)
+
+         zloc = kdim
+         ! compute dims for intermediate domain
+         CALL show_domain_decomp(intermediate_domdesc)
+         CALL compute_memory_dims_using_rsl (          &
+                   intermediate_domdesc ,              &
+                   intermediate_mloc   ,  intermediate_nloc   ,  zloc   ,        &
+                   c_mloc_x ,  c_nloc_x ,  c_zloc_x ,        &
+                   c_mloc_y ,  c_nloc_y ,  c_zloc_y ,        &
+                   c_ids,  c_ide,  c_kds,  c_kde,  c_jds,  c_jde,  &   ! IKJ ONLY
+                   c_sp1,  c_ep1,  c_sp2,  c_ep2,  c_sp3,  c_ep3, &
+                   c_sp1x, c_ep1x, c_sp2x, c_ep2x, c_sp3x, c_ep3x, &
+                   c_sp1y, c_ep1y, c_sp2y, c_ep2y, c_sp3y, c_ep3y, &
+                   c_sm1,  c_em1,  c_sm2,  c_em2,  c_sm3,  c_em3,  &
+                   c_sm1x, c_em1x, c_sm2x, c_em2x, c_sm3x, c_em3x, &
+                   c_sm1y, c_em1y, c_sm2y, c_em2y, c_sm3y, c_em3y  )
+         ! since the RSL_SPAWN_REGULAR_NEST1 does not do the vert dimension
+         ! we need to set that manually  >>>>> IKJ ONLY
+         c_sp2 = c_kds   !IKJ ONLY
+         c_ep2 = c_kde   !IKJ ONLY
+         c_sm2 = c_kds   !IKJ ONLY
+         c_em2 = c_kde   !IKJ ONLY
+
+         ! global dims are same as CD
+         ! good for IKJ only
+         c_sd1 = parent%sd31       ; c_ed1 = parent%ed31
+         c_sd2 = parent%sd32       ; c_ed2 = parent%ed32
+         c_sd3 = parent%sd33       ; c_ed3 = parent%ed33
+
+
+         ! Sequence of calls to create a new, intermediate domain
+         ! data structures that can be used to store the CD data
+         ! that will be used as input to the forcing interpolation
+         ! on each processor.
+         ALLOCATE ( intermediate_grid )
+         ALLOCATE ( intermediate_grid%parents( max_parents ) )
+         ALLOCATE ( intermediate_grid%nests( max_nests ) )
+
+         NULLIFY( intermediate_grid%sibling )
+         DO i = 1, max_nests
+            NULLIFY( intermediate_grid%nests(i)%ptr )
+         ENDDO
+         NULLIFY  (intermediate_grid%next)
+         NULLIFY  (intermediate_grid%same_level)
+         NULLIFY  (intermediate_grid%i_start)
+         NULLIFY  (intermediate_grid%j_start)
+         NULLIFY  (intermediate_grid%i_end)
+         NULLIFY  (intermediate_grid%j_end)
+
+         intermediate_grid%id = id
+         intermediate_grid%domdesc = intermediate_domdesc
+         intermediate_grid%num_nests = 0
+         intermediate_grid%num_siblings = 0
+         intermediate_grid%num_parents = 1
+         intermediate_grid%max_tiles   = 0
+         intermediate_grid%num_tiles_spec   = 0
+         ! hook up some pointers
+         
+! <DESCRIPTION>
+! However, the pointers in the nested hierachy must be set up differently
+! in this case.  First, the pointer to the nests TYPE(domain) is
+! retrieved in a somewhat roundabout way, by searching the domain
+! hierarcy rooted at head_grid (defined in frame/module_domain.F) with a
+! call to <a href=find_grid_by_id.html>find_grid_by_id</a>.  The nested
+! grid has already been added to the hierarchy by WRF because that is
+! done in <a
+! href=alloc_and_configure_domain.html>alloc_and_configure_domain</a>
+! before <a href=wrf_patch_domain.html>wrf_patch_domain</a> is called,
+! but the arguments to patch_domain_rsl, here, do not include a pointer to
+! the nest domain, only the id (could be changed).  Once the pointer
+! to the nested grid's domain data structure is located, the nest's
+! intermediate_grid pointer is set to the the domain data struture for
+! the newly created created intermediate_domain.  In a curious twist of
+! geneology, however, the intermediate_grid (from WRF domain hierarchy
+! point of view) is set to consider the nest its parent. This is because,
+! from the WRF framework's point of view, the intermediate domain does
+! not exist (it only exists because of code in external/RSL/module_dm.F,
+! an external-package supplied module).  It remains only to allocate
+! the fields in the intermediate domain's domain data type, set a few
+! other fields such as dx, dy, and dt (to the parent domain's values) and 
+! return.
+! 
+! </DESCRIPTION>
+
+         CALL find_grid_by_id ( id, head_grid, nest_grid )
+         nest_grid%intermediate_grid => intermediate_grid  ! nest grid now has a pointer to this baby
+         intermediate_grid%parents(1)%ptr => nest_grid     ! the intermediate grid considers nest its parent
+         intermediate_grid%num_parents = 1
+
+         c_sm1x = 1 ; c_em1x = 1 ; c_sm2x = 1 ; c_em2x = 1 ; c_sm3x = 1 ; c_em3x = 1
+         c_sm1y = 1 ; c_em1y = 1 ; c_sm2y = 1 ; c_em2y = 1 ; c_sm3y = 1 ; c_em3y = 1
+
+         intermediate_grid%sm31x                           = c_sm1x
+         intermediate_grid%em31x                           = c_em1x
+         intermediate_grid%sm32x                           = c_sm2x
+         intermediate_grid%em32x                           = c_em2x
+         intermediate_grid%sm33x                           = c_sm3x
+         intermediate_grid%em33x                           = c_em3x
+         intermediate_grid%sm31y                           = c_sm1y
+         intermediate_grid%em31y                           = c_em1y
+         intermediate_grid%sm32y                           = c_sm2y
+         intermediate_grid%em32y                           = c_em2y
+         intermediate_grid%sm33y                           = c_sm3y
+         intermediate_grid%em33y                           = c_em3y
+
+
+#if 0
+         ! allocate space for the intermediate domain
+         CALL alloc_space_field ( intermediate_grid, id , 3 , .TRUE. , &   ! use same id as nest
+                               c_sd1, c_ed1, c_sd2, c_ed2, c_sd3, c_ed3,       &
+                               c_sm1,  c_em1,  c_sm2,  c_em2,  c_sm3,  c_em3,  &
+                               c_sm1x, c_em1x, c_sm2x, c_em2x, c_sm3x, c_em3x, &   ! x-xpose
+                               c_sm1y, c_em1y, c_sm2y, c_em2y, c_sm3y, c_em3y  )   ! y-xpose
+#endif
+
+         intermediate_grid%sd31                            =   c_sd1
+         intermediate_grid%ed31                            =   c_ed1
+         intermediate_grid%sp31                            = c_sp1
+         intermediate_grid%ep31                            = c_ep1
+         intermediate_grid%sm31                            = c_sm1
+         intermediate_grid%em31                            = c_em1
+         intermediate_grid%sd32                            =   c_sd2
+         intermediate_grid%ed32                            =   c_ed2
+         intermediate_grid%sp32                            = c_sp2
+         intermediate_grid%ep32                            = c_ep2
+         intermediate_grid%sm32                            = c_sm2
+         intermediate_grid%em32                            = c_em2
+         intermediate_grid%sd33                            =   c_sd3
+         intermediate_grid%ed33                            =   c_ed3
+         intermediate_grid%sp33                            = c_sp3
+         intermediate_grid%ep33                            = c_ep3
+         intermediate_grid%sm33                            = c_sm3
+         intermediate_grid%em33                            = c_em3
+
+         CALL med_add_config_info_to_grid ( intermediate_grid )
+
+         intermediate_grid%dx = parent%dx
+         intermediate_grid%dy = parent%dy
+         intermediate_grid%dt = parent%dt
+
+         CALL wrf_dm_define_comms ( intermediate_grid )
+
+      endif
+
+      RETURN
+  END SUBROUTINE patch_domain_rsl
+
+  SUBROUTINE compute_memory_dims_using_rsl (        &
+                domdesc ,                           &
+                mloc   ,  nloc   ,  zloc   ,        &
+                mloc_x ,  nloc_x ,  zloc_x ,        &
+                mloc_y ,  nloc_y ,  zloc_y ,        &
+                sd1,  ed1,  sd2,  ed2,  sd3,  ed3,  &
+                sp1,  ep1,  sp2,  ep2,  sp3,  ep3,  &
+                sp1x, ep1x, sp2x, ep2x, sp3x, ep3x, &
+                sp1y, ep1y, sp2y, ep2y, sp3y, ep3y, &
+                sm1,  em1,  sm2,  em2,  sm3,  em3,  &
+                sm1x, em1x, sm2x, em2x, sm3x, em3x, &
+                sm1y, em1y, sm2y, em2y, sm3y, em3y  )
+      USE module_machine
+      IMPLICIT NONE
+      ! Arguments
+      INTEGER, INTENT(IN ) :: domdesc
+      INTEGER, INTENT(IN ) :: mloc , nloc , zloc         ! all k on same proc
+      INTEGER, INTENT(IN ) :: mloc_x , nloc_x , zloc_x   ! all x on same proc
+      INTEGER, INTENT(IN ) :: mloc_y , nloc_y , zloc_y   ! all y on same proc
+      INTEGER, INTENT(IN ) :: sd1, ed1, sd2, ed2, sd3, ed3
+      INTEGER, INTENT(OUT) :: sp1, ep1, sp2, ep2, sp3, ep3
+      INTEGER, INTENT(OUT) :: sp1x, ep1x, sp2x, ep2x, sp3x, ep3x
+      INTEGER, INTENT(OUT) :: sp1y, ep1y, sp2y, ep2y, sp3y, ep3y
+      INTEGER, INTENT(OUT) :: sm1, em1, sm2, em2, sm3, em3
+      INTEGER, INTENT(OUT) :: sm1x, em1x, sm2x, em2x, sm3x, em3x
+      INTEGER, INTENT(OUT) :: sm1y, em1y, sm2y, em2y, sm3y, em3y
+! <DESCRIPTION>
+! For a given domain (referred to by it's rsl domain descriptor) interrogate 
+! rsl and compute the patch and memory dimensions for the section of the
+! domain that is computed on this task.  rsl has this information already
+! and it is necessary only to (1) assign the information to the correct
+! dimension in WRF, based on the setting of model_data_order (
+! defined in <a href=../../frame/module_driver_constants.f>frame/module_driver_constants.F</a>,
+! based on the dimspec entries in the Registry), and (2) convert the
+! start and end of each dimension
+! from local (as they are carried in rsl, a holdover from MM5) to global.
+! 
+! </DESCRIPTION>
+      ! Local data
+      INTEGER , PARAMETER   :: rsl_jjx_x = 2047
+      INTEGER , DIMENSION( rsl_jjx_x ) :: rsl_js_x0 , rsl_je_x0 , rsl_is_x0 , rsl_ie_x0
+      INTEGER                          :: rsl_xinest_x0 , rsl_idif_x0 , rsl_jdif_x0
+
+      CALL RSL_REG_RUN_INFOP(domdesc , 0 ,               &
+                             rsl_jjx_x ,                 &
+                             rsl_xinest_x0 ,             &
+                             rsl_is_x0 , rsl_ie_x0 ,     &
+                             rsl_js_x0 , rsl_je_x0 ,     &
+                             rsl_idif_x0 , rsl_jdif_x0   )
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+
+           CALL rsl_reg_patchinfo_mn ( domdesc ,                       &
+                       sp2  , ep2  , sp3  , ep3  ,  sp1  , ep1   )
+           sp1 = sp1 - ( 1 - sd1 ) ; ep1 = ep1 - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2 = sp2 - ( 1 - sd2 ) ; ep2 = ep2 - ( 1 - sd2 )
+           sp3 = sp3 - ( 1 - sd3 ) ; ep3 = ep3 - ( 1 - sd3 )
+           sm2 = sp2 - rsl_padarea
+           em2 = sm2 + mloc - 1
+           sm3 = sp3 - rsl_padarea
+           em3 = sm3 + nloc - 1
+           sm1 = sp1
+           em1 = sm1 + zloc - 1
+
+           CALL rsl_reg_patchinfo_nz ( domdesc ,                       &                    ! switched m->n 20020910
+                       sp2x , ep2x , sp3x , ep3x ,  sp1x , ep1x  )
+           sp1x = sp1x - ( 1 - sd1 ) ; ep1x = ep1x - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2x = sp2x - ( 1 - sd2 ) ; ep2x = ep2x - ( 1 - sd2 )
+           sp3x = sp3x - ( 1 - sd3 ) ; ep3x = ep3x - ( 1 - sd3 )
+           sm2x = sp2x - rsl_padarea
+           em2x = sm2x + mloc_x - 1
+           sm3x = sp3x - rsl_padarea
+           em3x = sm3x + nloc_x - 1
+           sm1x = sp1x
+           em1x = sm1x + zloc_x - 1
+
+           CALL rsl_reg_patchinfo_mz ( domdesc ,                       &                    ! switched n->m 20020910
+                       sp2y , ep2y , sp3y , ep3y ,  sp1y , ep1y  )
+           sp1y = sp1y - ( 1 - sd1 ) ; ep1y = ep1y - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2y = sp2y - ( 1 - sd2 ) ; ep2y = ep2y - ( 1 - sd2 )
+           sp3y = sp3y - ( 1 - sd3 ) ; ep3y = ep3y - ( 1 - sd3 )
+           sm2y = sp2y - rsl_padarea
+           em2y = sm2y + mloc_y - 1
+           sm3y = sp3y - rsl_padarea
+           em3y = sm3y + nloc_y - 1
+           sm1y = sp1y
+           em1y = sm1y + zloc_y - 1
+
+         CASE ( DATA_ORDER_XZY )
+
+           CALL rsl_reg_patchinfo_mn ( domdesc ,                       &
+                       sp1  , ep1  , sp3  , ep3  ,  sp2  , ep2   )
+
+           sp1 = sp1 - ( 1 - sd1 ) ; ep1 = ep1 - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2 = sp2 - ( 1 - sd2 ) ; ep2 = ep2 - ( 1 - sd2 )
+           sp3 = sp3 - ( 1 - sd3 ) ; ep3 = ep3 - ( 1 - sd3 )
+
+           sm1 = sp1 - rsl_padarea
+           em1 = sm1 + mloc - 1
+           sm3 = sp3 - rsl_padarea
+           em3 = sm3 + nloc - 1
+           sm2 = sp2
+           em2 = sm2 + zloc - 1
+
+           CALL rsl_reg_patchinfo_nz ( domdesc ,                       &   ! switched m->n 20020908
+                       sp1x , ep1x , sp3x , ep3x ,  sp2x , ep2x  )
+           sp1x = sp1x - ( 1 - sd1 ) ; ep1x = ep1x - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2x = sp2x - ( 1 - sd2 ) ; ep2x = ep2x - ( 1 - sd2 )
+           sp3x = sp3x - ( 1 - sd3 ) ; ep3x = ep3x - ( 1 - sd3 )
+           sm1x = sp1x - rsl_padarea
+           em1x = sm1x + mloc_x - 1
+           sm3x = sp3x - rsl_padarea
+           em3x = sm3x + nloc_x - 1
+           sm2x = sp2x
+           em2x = sm2x + zloc_x - 1
+
+           CALL rsl_reg_patchinfo_mz ( domdesc ,                       &   ! switched n->m 20020908
+                       sp1y , ep1y , sp3y , ep3y ,  sp2y , ep2y  )
+           sp1y = sp1y - ( 1 - sd1 ) ; ep1y = ep1y - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2y = sp2y - ( 1 - sd2 ) ; ep2y = ep2y - ( 1 - sd2 )
+           sp3y = sp3y - ( 1 - sd3 ) ; ep3y = ep3y - ( 1 - sd3 )
+           sm1y = sp1y - rsl_padarea
+           em1y = sm1y + mloc_y - 1
+           sm3y = sp3y - rsl_padarea
+           em3y = sm3y + nloc_y - 1
+           sm2y = sp2y
+           em2y = sm2y + zloc_y - 1
+
+         CASE ( DATA_ORDER_XYZ )
+
+           CALL rsl_reg_patchinfo_mn ( domdesc ,                       &
+                       sp1  , ep1  , sp2  , ep2  ,  sp3  , ep3   )
+           sp1 = sp1 - ( 1 - sd1 ) ; ep1 = ep1 - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2 = sp2 - ( 1 - sd2 ) ; ep2 = ep2 - ( 1 - sd2 )
+           sp3 = sp3 - ( 1 - sd3 ) ; ep3 = ep3 - ( 1 - sd3 )
+           sm1 = sp1 - rsl_padarea
+           em1 = sm1 + mloc - 1
+           sm2 = sp2 - rsl_padarea
+           em2 = sm2 + nloc - 1
+           sm3 = sp3
+           em3 = sm3 + zloc - 1
+
+           CALL rsl_reg_patchinfo_nz ( domdesc ,                       &     ! switched m->n 20020910
+                       sp1x , ep1x , sp2x , ep2x ,  sp3x , ep3x  )
+           sp1x = sp1x - ( 1 - sd1 ) ; ep1x = ep1x - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2x = sp2x - ( 1 - sd2 ) ; ep2x = ep2x - ( 1 - sd2 )
+           sp3x = sp3x - ( 1 - sd3 ) ; ep3x = ep3x - ( 1 - sd3 )
+           sm1x = sp1x - rsl_padarea
+           em1x = sm1x + mloc_x - 1
+           sm2x = sp2x - rsl_padarea
+           em2x = sm2x + nloc_x - 1
+           sm3x = sp3x
+           em3x = sm3x + zloc_x - 1
+
+           CALL rsl_reg_patchinfo_mz ( domdesc ,                       &     ! switched n->m 20020910
+                       sp1y , ep1y , sp2y , ep2y ,  sp3y , ep3y  )
+           sp1y = sp1y - ( 1 - sd1 ) ; ep1y = ep1y - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2y = sp2y - ( 1 - sd2 ) ; ep2y = ep2y - ( 1 - sd2 )
+           sp3y = sp3y - ( 1 - sd3 ) ; ep3y = ep3y - ( 1 - sd3 )
+           sm1y = sp1y - rsl_padarea
+           em1y = sm1y + mloc_y - 1
+           sm2y = sp2y - rsl_padarea
+           em2y = sm2y + nloc_y - 1
+           sm3y = sp3y
+           em3y = sm3y + zloc_y - 1
+
+         CASE ( DATA_ORDER_YXZ )
+
+           CALL rsl_reg_patchinfo_mn ( domdesc ,                       &
+                       sp2  , ep2  , sp1  , ep1  ,  sp3  , ep3   )
+
+           sp1 = sp1 - ( 1 - sd1 ) ; ep1 = ep1 - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2 = sp2 - ( 1 - sd2 ) ; ep2 = ep2 - ( 1 - sd2 )
+           sp3 = sp3 - ( 1 - sd3 ) ; ep3 = ep3 - ( 1 - sd3 )
+           sm2 = sp2 - rsl_padarea
+           em2 = sm2 + mloc - 1
+           sm1 = sp1 - rsl_padarea
+           em1 = sm1 + nloc - 1
+           sm3 = sp3
+           em3 = sm3 + zloc - 1
+
+           CALL rsl_reg_patchinfo_nz ( domdesc ,                       &     ! switched n->m 20020910
+                       sp2x , ep2x , sp1x , ep1x ,  sp3x , ep3x  )
+           sp1x = sp1x - ( 1 - sd1 ) ; ep1x = ep1x - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2x = sp2x - ( 1 - sd2 ) ; ep2x = ep2x - ( 1 - sd2 )
+           sp3x = sp3x - ( 1 - sd3 ) ; ep3x = ep3x - ( 1 - sd3 )
+           sm2x = sp2x - rsl_padarea
+           em2x = sm2x + mloc_x - 1
+           sm1x = sp1x - rsl_padarea
+           em1x = sm1x + nloc_x - 1
+           sm3x = sp3x
+           em3x = sm3x + zloc_x - 1
+
+           CALL rsl_reg_patchinfo_mz ( domdesc ,                       &     ! switched m->n 20020910
+                       sp2y , ep2y , sp1y , ep1y ,  sp3y , ep3y  )
+           sp1y = sp1y - ( 1 - sd1 ) ; ep1y = ep1y - ( 1 - sd1 )   ! adjust if domain start not 1
+           sp2y = sp2y - ( 1 - sd2 ) ; ep2y = ep2y - ( 1 - sd2 )
+           sp3y = sp3y - ( 1 - sd3 ) ; ep3y = ep3y - ( 1 - sd3 )
+           sm2y = sp2y - rsl_padarea
+           em2y = sm2y + mloc_y - 1
+           sm1y = sp1y - rsl_padarea
+           em1y = sm1y + nloc_y - 1
+           sm3y = sp3y
+           em3y = sm3y + zloc_y - 1
+
+      END SELECT
+
+      RETURN
+   END SUBROUTINE compute_memory_dims_using_rsl
+
+   SUBROUTINE init_module_dm
+      IMPLICIT NONE
+      INTEGER ierr, mytask
+      EXTERNAL rsl_patch_decomp
+! <DESCRIPTION>
+! This is the first part of the initialization of rsl for distributed
+! memory parallel execution.  The routine first interrogates MPI to find
+! out if it needs to be intialized (it may not, since 
+! <a href=init_module_wrf_quilt.html>init_module_wrf_quilt</a> may
+! have done this already) and if so, calls mpi_init.  Standard output
+! and standard error on each process is directed to a separate file
+! with a call to <a href=wrf_termio_dup.html>wrf_termio_dup</a> and,
+! in the case where we <em>are</em> calling mpi_init here, MPI_COMM_WORLD
+! is set as the communicator (it would not be in the case of quilting).
+! 
+! Finally, rsl itself is initialized and the default decomposition
+! algorithm in rsl is set to the rsl-provided algorithm RSL_PATCH_DECOMP.
+!
+! Certain parts of this algorithm are #ifdef'd out in case -DSTUBMPI
+! is specified in the configure.wrf file at compile time.  This allows
+! rsl's nesting functionality to be used on a single processor (for nesting, for example) without using MPI.
+! 
+! </DESCRIPTION>
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      LOGICAL mpi_inited
+      CALL mpi_initialized( mpi_inited, ierr )
+      IF ( .NOT. mpi_inited ) THEN
+        ! If MPI has not been initialized then initialize it and 
+        ! make comm_world the communicator
+        ! Otherwise, something else (e.g. quilt-io) has already 
+        ! initialized MPI, so just grab the communicator that
+        ! should already be stored and use that.
+        CALL mpi_init ( ierr )
+        CALL wrf_termio_dup
+        CALL wrf_set_dm_communicator ( MPI_COMM_WORLD )
+      ENDIF
+      CALL wrf_get_dm_communicator( mpi_comm_local )
+      CALL wrf_termio_dup
+#endif
+      CALL rsl_initialize1( mpi_comm_local )
+      CALL set_def_decomp_fcn ( rsl_patch_decomp )
+   END SUBROUTINE init_module_dm
+
+! internal, used below for switching the argument to MPI calls
+! if reals are being autopromoted to doubles in the build of WRF
+   INTEGER function getrealmpitype()
+#ifndef STUBMPI
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER rtypesize, dtypesize, ierr
+      CALL mpi_type_size ( MPI_REAL, rtypesize, ierr )
+      CALL mpi_type_size ( MPI_DOUBLE_PRECISION, dtypesize, ierr )
+      IF ( RWORDSIZE .EQ. rtypesize ) THEN
+        getrealmpitype = MPI_REAL
+      ELSE IF ( RWORDSIZE .EQ. dtypesize ) THEN
+        getrealmpitype = MPI_DOUBLE_PRECISION
+      ELSE
+        CALL wrf_error_fatal ( 'RWORDSIZE or DWORDSIZE does not match any MPI type' )
+      ENDIF
+#else
+! required dummy initialization for function that is never called
+      getrealmpitype = 1
+#endif
+      RETURN
+   END FUNCTION getrealmpitype
+
+   REAL FUNCTION wrf_dm_max_real ( inval )
+      IMPLICIT NONE
+      REAL inval, retval
+      INTEGER ierr
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value; on return
+! all processors are passed back the maximum of all values passed.
+!
+! </DESCRIPTION>
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      CALL mpi_allreduce ( inval, retval , 1, getrealmpitype() , MPI_MAX, mpi_comm_local, ierr )
+      wrf_dm_max_real = retval
+#else
+      wrf_dm_max_real = inval
+#endif
+   END FUNCTION wrf_dm_max_real
+
+   REAL FUNCTION wrf_dm_min_real ( inval )
+      IMPLICIT NONE
+      REAL inval, retval
+      INTEGER typesize, op
+      INTEGER ierr
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value; on return
+! all processors are passed back the minumum of all values passed.
+!
+! </DESCRIPTION>
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      CALL mpi_allreduce ( inval, retval , 1, getrealmpitype() , MPI_MIN, mpi_comm_local, ierr )
+      wrf_dm_min_real = retval
+#else
+      wrf_dm_min_real = inval
+#endif
+   END FUNCTION wrf_dm_min_real
+
+   REAL FUNCTION wrf_dm_sum_real ( inval )
+      IMPLICIT NONE
+      INTEGER ierr
+      INTEGER typesize, op
+      REAL inval, retval
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value; on return
+! all processors are passed back the sum of all values passed.
+!
+! </DESCRIPTION>
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      CALL mpi_allreduce ( inval, retval , 1, getrealmpitype() , MPI_SUM, mpi_comm_local, ierr )
+      wrf_dm_sum_real = retval
+#else
+      wrf_dm_sum_real = inval
+#endif
+   END FUNCTION wrf_dm_sum_real
+
+   INTEGER FUNCTION wrf_dm_sum_integer ( inval )
+      IMPLICIT NONE
+      INTEGER inval, retval, ierr
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value; on return
+! all processors are passed back the sum of all values passed.
+!
+! </DESCRIPTION>
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      CALL mpi_allreduce ( inval, retval , 1, MPI_INTEGER, MPI_SUM, mpi_comm_local, ierr )
+      wrf_dm_sum_integer = retval
+#else
+      wrf_dm_sum_integer = inval
+#endif
+   END FUNCTION wrf_dm_sum_integer
+
+
+   SUBROUTINE wrf_dm_maxval_real ( val, idex, jdex )
+      IMPLICIT NONE
+      REAL val, val_all( rsl_nproc )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,rsl_nproc)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, getrealmpitype(), val_all , 1, getrealmpitype(), comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, rsl_nproc
+        IF ( val_all(i) .GT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_maxval_real
+
+   SUBROUTINE wrf_dm_minval_real ( val, idex, jdex )
+      IMPLICIT NONE
+      REAL val, val_all( rsl_nproc )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,rsl_nproc)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the minimum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, getrealmpitype(), val_all , 1, getrealmpitype(), comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, rsl_nproc
+        IF ( val_all(i) .LT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_minval_real
+
+   SUBROUTINE wrf_dm_maxval_doubleprecision ( val, idex, jdex )
+      IMPLICIT NONE
+      DOUBLE PRECISION val, val_all( rsl_nproc )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,rsl_nproc)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_DOUBLE_PRECISION, val_all , 1, MPI_DOUBLE_PRECISION, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, rsl_nproc
+        IF ( val_all(i) .GT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_maxval_doubleprecision
+
+   SUBROUTINE wrf_dm_minval_doubleprecision ( val, idex, jdex )
+      IMPLICIT NONE
+      DOUBLE PRECISION val, val_all( rsl_nproc )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,rsl_nproc)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the minimum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_DOUBLE_PRECISION, val_all , 1, MPI_DOUBLE_PRECISION, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, rsl_nproc
+        IF ( val_all(i) .LT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_minval_doubleprecision
+
+
+   SUBROUTINE wrf_dm_maxval_integer ( val, idex, jdex )
+      IMPLICIT NONE
+      INTEGER val, val_all( rsl_nproc )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,rsl_nproc)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_INTEGER, val_all , 1, MPI_INTEGER, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, rsl_nproc
+        IF ( val_all(i) .GT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_maxval_integer
+
+   SUBROUTINE wrf_dm_minval_integer ( val, idex, jdex )
+      IMPLICIT NONE
+      INTEGER val, val_all( rsl_nproc )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,rsl_nproc)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the minimum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_INTEGER, val_all , 1, MPI_INTEGER, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, rsl_nproc
+        IF ( val_all(i) .LT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_minval_integer
+
+   SUBROUTINE wrf_dm_move_nest ( parent, nest, dx, dy )
+      USE module_domain
+      TYPE (domain),INTENT(INOUT) :: parent, nest
+      INTEGER, INTENT(IN)         :: dx, dy
+      CALL rsl_move_nest ( parent%domdesc, nest%domdesc, dx, dy )
+   END SUBROUTINE wrf_dm_move_nest
+
+!------------------------------------------------------------------------------
+   SUBROUTINE get_full_obs_vector( nsta, nerrf, niobf,          &
+                                   mp_local_uobmask,            &
+                                   mp_local_vobmask,            &
+                                   mp_local_cobmask, errf )
+
+!------------------------------------------------------------------------------
+!  PURPOSE: Do MPI allgatherv operation across processors to get the
+!           errors at each observation point on all processors. 
+!
+!------------------------------------------------------------------------------
+#ifndef STUBMPI
+    INCLUDE 'mpif.h'
+
+    INTEGER, INTENT(IN)   :: nsta                ! Observation index.
+    INTEGER, INTENT(IN)   :: nerrf               ! Number of error fields.
+    INTEGER, INTENT(IN)   :: niobf               ! Number of observations.
+    LOGICAL, INTENT(IN)   :: MP_LOCAL_UOBMASK(NIOBF)
+    LOGICAL, INTENT(IN)   :: MP_LOCAL_VOBMASK(NIOBF)
+    LOGICAL, INTENT(IN)   :: MP_LOCAL_COBMASK(NIOBF)
+    REAL, INTENT(INOUT)   :: errf(nerrf, niobf)
+
+! Local declarations
+    integer i, n, nlocal_dot, nlocal_crs
+    REAL UVT_BUFFER(NIOBF)    ! Buffer for holding U, V, or T
+    REAL QRK_BUFFER(NIOBF)    ! Buffer for holding Q or RKO
+    REAL SFP_BUFFER(NIOBF)    ! Buffer for holding Surface pressure
+    INTEGER N_BUFFER(NIOBF)
+    REAL FULL_BUFFER(NIOBF)
+    INTEGER IFULL_BUFFER(NIOBF)
+    INTEGER IDISPLACEMENT(1024)   ! HARD CODED MAX NUMBER OF PROCESSORS
+    INTEGER ICOUNT(1024)          ! HARD CODED MAX NUMBER OF PROCESSORS
+
+    INTEGER :: MPI_COMM_COMP      ! MPI group communicator
+    INTEGER :: NPROCS             ! Number of processors
+    INTEGER :: IERR               ! Error code from MPI routines
+
+! Get communicator for MPI operations.
+    CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
+
+! Get rank of monitor processor and broadcast to others.
+    CALL MPI_COMM_SIZE( MPI_COMM_COMP, NPROCS, IERR )
+
+! DO THE U FIELD
+   NLOCAL_DOT = 0
+   DO N = 1, NSTA
+     IF ( MP_LOCAL_UOBMASK(N) ) THEN      ! USE U-POINT MASK
+       NLOCAL_DOT = NLOCAL_DOT + 1
+       UVT_BUFFER(NLOCAL_DOT) = ERRF(1,N)        ! U WIND COMPONENT
+       SFP_BUFFER(NLOCAL_DOT) = ERRF(7,N)        ! SURFACE PRESSURE
+       QRK_BUFFER(NLOCAL_DOT) = ERRF(9,N)        ! RKO
+       N_BUFFER(NLOCAL_DOT) = N
+     ENDIF
+   ENDDO
+   CALL MPI_ALLGATHER(NLOCAL_DOT,1,MPI_INTEGER, &
+                      ICOUNT,1,MPI_INTEGER,     &
+                      MPI_COMM_COMP,IERR)
+   I = 1
+
+   IDISPLACEMENT(1) = 0
+   DO I = 2, NPROCS
+     IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1)
+   ENDDO
+   CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_DOT, MPI_INTEGER,    &
+                        IFULL_BUFFER, ICOUNT, IDISPLACEMENT,  &
+                        MPI_INTEGER, MPI_COMM_COMP, IERR)
+! U
+   CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(1,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! SURF PRESS AT U-POINTS
+   CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(7,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! RKO
+   CALL MPI_ALLGATHERV( QRK_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(9,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+
+! DO THE V FIELD
+   NLOCAL_DOT = 0
+   DO N = 1, NSTA
+     IF ( MP_LOCAL_VOBMASK(N) ) THEN         ! USE V-POINT MASK
+       NLOCAL_DOT = NLOCAL_DOT + 1
+       UVT_BUFFER(NLOCAL_DOT) = ERRF(2,N)    ! V WIND COMPONENT
+       SFP_BUFFER(NLOCAL_DOT) = ERRF(8,N)    ! SURFACE PRESSURE
+       N_BUFFER(NLOCAL_DOT) = N
+     ENDIF
+   ENDDO
+   CALL MPI_ALLGATHER(NLOCAL_DOT,1,MPI_INTEGER, &
+                      ICOUNT,1,MPI_INTEGER,     &
+                      MPI_COMM_COMP,IERR)
+   I = 1
+
+   IDISPLACEMENT(1) = 0
+   DO I = 2, NPROCS
+     IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1)
+   ENDDO
+   CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_DOT, MPI_INTEGER,    &
+                        IFULL_BUFFER, ICOUNT, IDISPLACEMENT,  &
+                        MPI_INTEGER, MPI_COMM_COMP, IERR)
+! V
+   CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(2,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! SURF PRESS AT V-POINTS
+   CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(8,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+
+! DO THE CROSS FIELDS, T AND Q
+   NLOCAL_CRS = 0
+   DO N = 1, NSTA
+     IF ( MP_LOCAL_COBMASK(N) ) THEN       ! USE MASS-POINT MASK
+       NLOCAL_CRS = NLOCAL_CRS + 1
+       UVT_BUFFER(NLOCAL_CRS) = ERRF(3,N)     ! TEMPERATURE
+       QRK_BUFFER(NLOCAL_CRS) = ERRF(4,N)     ! MOISTURE
+       SFP_BUFFER(NLOCAL_CRS) = ERRF(6,N)     ! SURFACE PRESSURE
+       N_BUFFER(NLOCAL_CRS) = N
+     ENDIF
+   ENDDO
+   CALL MPI_ALLGATHER(NLOCAL_CRS,1,MPI_INTEGER, &
+                      ICOUNT,1,MPI_INTEGER,     &
+                      MPI_COMM_COMP,IERR)
+   IDISPLACEMENT(1) = 0
+   DO I = 2, NPROCS
+     IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1)
+   ENDDO
+   CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_CRS, MPI_INTEGER,    &
+                        IFULL_BUFFER, ICOUNT, IDISPLACEMENT,  &
+                        MPI_INTEGER, MPI_COMM_COMP, IERR)
+! T
+   CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_CRS, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+
+   DO N = 1, NSTA
+     ERRF(3,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! Q
+   CALL MPI_ALLGATHERV( QRK_BUFFER, NLOCAL_CRS, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(4,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! SURF PRESS AT MASS POINTS
+   CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_CRS, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(6,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+#endif
+   END SUBROUTINE get_full_obs_vector
+
+END MODULE module_dm
+
+!=========================================================================
+! wrf_dm_patch_domain has to be outside the module because it is called
+! by a routine in module_domain but depends on module domain
+
+
+SUBROUTINE wrf_dm_patch_domain ( id  , domdesc , parent_id , parent_domdesc , &
+                          sd1 , ed1 , sp1 , ep1 , sm1 , em1 , &
+                          sd2 , ed2 , sp2 , ep2 , sm2 , em2 , &
+                          sd3 , ed3 , sp3 , ep3 , sm3 , em3 , &
+                                      sp1x , ep1x , sm1x , em1x , &
+                                      sp2x , ep2x , sm2x , em2x , &
+                                      sp3x , ep3x , sm3x , em3x , &
+                                      sp1y , ep1y , sm1y , em1y , &
+                                      sp2y , ep2y , sm2y , em2y , &
+                                      sp3y , ep3y , sm3y , em3y , &
+                          bdx , bdy )
+   USE module_domain
+   USE module_dm
+   IMPLICIT NONE
+
+   INTEGER, INTENT(IN)   :: sd1 , ed1 , sd2 , ed2 , sd3 , ed3 , bdx , bdy
+   INTEGER, INTENT(OUT)  :: sp1 , ep1 , sp2 , ep2 , sp3 , ep3 , &
+                            sm1 , em1 , sm2 , em2 , sm3 , em3
+   INTEGER, INTENT(OUT)  :: sp1x , ep1x , sp2x , ep2x , sp3x , ep3x , &
+                            sm1x , em1x , sm2x , em2x , sm3x , em3x
+   INTEGER, INTENT(OUT)  :: sp1y , ep1y , sp2y , ep2y , sp3y , ep3y , &
+                            sm1y , em1y , sm2y , em2y , sm3y , em3y
+   INTEGER, INTENT(INOUT):: id  , domdesc , parent_id , parent_domdesc
+
+   TYPE(domain), POINTER :: parent, grid_ptr
+
+! <DESCRIPTION>
+! The rsl-package supplied routine that computes the patch and memory dimensions
+! for this task. See also <a href=patch_domain_rsl.html>patch_domain_rsl</a>
+! 
+! </DESCRIPTION>
+
+   ! this is necessary because we cannot pass parent directly into 
+   ! wrf_dm_patch_domain because creating the correct interface definitions
+   ! would generate a circular USE reference between module_domain and module_dm
+   ! see comment this date in module_domain for more information. JM 20020416
+
+   NULLIFY( parent )
+   grid_ptr => head_grid
+   CALL find_grid_by_id( parent_id , grid_ptr , parent )
+
+   CALL patch_domain_rsl ( id  , domdesc , parent, parent_id , parent_domdesc , & 
+                           sd1 , ed1 , sp1 , ep1 , sm1 , em1 , & 
+                           sd2 , ed2 , sp2 , ep2 , sm2 , em2 , &
+                           sd3 , ed3 , sp3 , ep3 , sm3 , em3 , &
+                                       sp1x , ep1x , sm1x , em1x , &
+                                       sp2x , ep2x , sm2x , em2x , &
+                                       sp3x , ep3x , sm3x , em3x , &
+                                       sp1y , ep1y , sm1y , em1y , &
+                                       sp2y , ep2y , sm2y , em2y , &
+                                       sp3y , ep3y , sm3y , em3y , &
+                           bdx , bdy )
+
+
+   RETURN
+END SUBROUTINE wrf_dm_patch_domain
+
+SUBROUTINE wrf_termio_dup
+  IMPLICIT NONE
+  INTEGER mytask, ntasks, ierr
+! <DESCRIPTION>
+! Redirect standard output and standard error to separate files for each processor.
+!
+! </DESCRIPTION>
+#ifndef STUBMPI
+  INCLUDE 'mpif.h'
+  CALL mpi_comm_size(MPI_COMM_WORLD, ntasks, ierr )
+  CALL mpi_comm_rank(MPI_COMM_WORLD, mytask, ierr )
+#else
+  ntasks = 1
+  mytask = 0
+#endif
+  write(0,*)'starting wrf task ',mytask,' of ',ntasks
+  CALL rsl_error_dup1( mytask )
+END SUBROUTINE wrf_termio_dup
+
+SUBROUTINE wrf_get_myproc( myproc )
+  IMPLICIT NONE
+! <DESCRIPTION>
+! Pass back the task number (usually MPI rank) on this process.
+!
+! </DESCRIPTION>
+# include "rsl.inc"
+  INTEGER myproc
+  myproc = rsl_myproc
+  RETURN
+END SUBROUTINE wrf_get_myproc
+
+SUBROUTINE wrf_get_nproc( nproc )
+  IMPLICIT NONE
+# include "rsl.inc"
+  INTEGER nproc
+! <DESCRIPTION>
+! Pass back the number of distributed-memory tasks.
+!
+! </DESCRIPTION>
+  nproc = rsl_nproc_all
+  RETURN
+END SUBROUTINE wrf_get_nproc
+
+SUBROUTINE wrf_get_nprocx( nprocx )
+  IMPLICIT NONE
+# include "rsl.inc"
+  INTEGER nprocx
+! <DESCRIPTION>
+! Pass back the number of distributed-memory tasks decomposing the X dimension of the domain.
+!
+! </DESCRIPTION>
+  nprocx = rsl_nproc_min
+  RETURN
+END SUBROUTINE wrf_get_nprocx
+
+SUBROUTINE wrf_get_nprocy( nprocy )
+  IMPLICIT NONE
+# include "rsl.inc"
+  INTEGER nprocy
+! <DESCRIPTION>
+! Pass back the number of distributed-memory tasks decomposing the Y dimension of the domain.
+!
+! </DESCRIPTION>
+  nprocy = rsl_nproc_maj
+  RETURN
+END SUBROUTINE wrf_get_nprocy
+
+SUBROUTINE wrf_dm_bcast_bytes ( buf , size )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER size
+#ifndef NEC
+   INTEGER*1 BUF(size)
+#else
+   CHARACTER*1 BUF(size)
+#endif
+! <DESCRIPTION>
+! Collective operation. Given a buffer and a size in bytes on task zero, broadcast and return that buffer on all tasks.
+!
+! </DESCRIPTION>
+   CALL rsl_mon_bcast( buf , size )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_bytes
+
+SUBROUTINE wrf_dm_bcast_string( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+! <DESCRIPTION>
+! Collective operation. Given a string and a size in characters on task zero, broadcast and return that buffer on all tasks.
+!
+! </DESCRIPTION>
+   CHARACTER*(*) buf
+   INTEGER ibuf(256),i,n
+   CHARACTER*256 tstr
+   n = n1
+   ! Root task is required to have the correct value of N1, other tasks
+   ! might not have the correct value.
+   CALL wrf_dm_bcast_integer( n , 1 )
+   IF (n .GT. 256) n = 256
+   IF (n .GT. 0 ) then
+     DO i = 1, n
+       ibuf(I) = ichar(buf(I:I))
+     ENDDO
+     CALL wrf_dm_bcast_integer( ibuf, n )
+     buf = ''
+     DO i = 1, n
+       buf(i:i) = char(ibuf(i))
+     ENDDO
+   ENDIF
+   RETURN
+END SUBROUTINE wrf_dm_bcast_string
+
+SUBROUTINE wrf_dm_bcast_integer( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   INTEGER  buf(*)
+! <DESCRIPTION>
+! Collective operation. Given an array of integers and length on task zero, broadcast and return that array of values on all tasks.
+!
+! </DESCRIPTION>
+   CALL rsl_mon_bcast( BUF , N1 * IWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_integer
+
+SUBROUTINE wrf_dm_bcast_double( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+! <DESCRIPTION>
+! Collective operation. Given an array of doubles and length on task zero, broadcast and return that array of values on all tasks.
+!
+! </DESCRIPTION>
+   DOUBLEPRECISION  buf(*)
+   CALL rsl_mon_bcast( BUF , N1 * DWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_double
+
+SUBROUTINE wrf_dm_bcast_real( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+! <DESCRIPTION>
+! Collective operation. Given an array of reals and length on task zero, broadcast and return that array of values on all tasks.
+!
+! </DESCRIPTION>
+   REAL  buf(*)
+   CALL rsl_mon_bcast( BUF , N1 * RWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_real
+
+SUBROUTINE wrf_dm_bcast_logical( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+! <DESCRIPTION>
+! Collective operation. Given an array of logicals and length on task zero, broadcast and return that array of values on all tasks.
+!
+! </DESCRIPTION>
+   LOGICAL  buf(*)
+   CALL rsl_mon_bcast( BUF , N1 * LWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_logical
+
+SUBROUTINE wrf_dm_halo ( domdesc , comms , stencil_id )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , stencil_id
+   CALL rsl_exch_stencil ( domdesc , comms( stencil_id ) )
+   RETURN
+END SUBROUTINE wrf_dm_halo
+
+SUBROUTINE wrf_dm_xpose_z2y ( domdesc , comms , xpose_id )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , xpose_id
+   CALL rsl_xpose_mn_mz ( domdesc , comms( xpose_id ) )      ! switched nz->mz 20020910
+   RETURN
+END SUBROUTINE wrf_dm_xpose_z2y
+
+SUBROUTINE wrf_dm_xpose_y2z ( domdesc , comms , xpose_id )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , xpose_id
+   CALL rsl_xpose_mz_mn ( domdesc , comms( xpose_id ) )      ! switched nz->mz 20020910
+   RETURN
+END SUBROUTINE wrf_dm_xpose_y2z
+
+SUBROUTINE wrf_dm_xpose_y2x ( domdesc , comms , xpose_id )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , xpose_id
+   CALL rsl_xpose_mz_nz ( domdesc , comms( xpose_id ) )      ! switched nz<->mz 20020910
+   RETURN
+END SUBROUTINE wrf_dm_xpose_y2x
+
+SUBROUTINE wrf_dm_xpose_x2y ( domdesc , comms , xpose_id )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , xpose_id
+   CALL rsl_xpose_nz_mz ( domdesc , comms( xpose_id ) )      ! switched nz<->mz 20020910
+   RETURN
+END SUBROUTINE wrf_dm_xpose_x2y
+
+SUBROUTINE wrf_dm_xpose_x2z ( domdesc , comms , xpose_id )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , xpose_id
+   CALL rsl_xpose_nz_mn ( domdesc , comms( xpose_id ) )      ! switched mz->nz 20020910
+   RETURN
+END SUBROUTINE wrf_dm_xpose_x2z
+
+SUBROUTINE wrf_dm_xpose_z2x ( domdesc , comms , xpose_id )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , xpose_id
+   CALL rsl_xpose_mn_nz ( domdesc , comms( xpose_id ) )      ! switched mz->nz 20020910
+   RETURN
+END SUBROUTINE wrf_dm_xpose_z2x
+
+#if 0
+SUBROUTINE wrf_dm_boundary ( domdesc , comms , period_id , &
+                             periodic_x , periodic_y )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , period_id
+   LOGICAL , INTENT(IN)      :: periodic_x, periodic_y
+# include "rsl.inc"
+
+   IF ( periodic_x ) THEN
+     CALL rsl_exch_period ( domdesc , comms( period_id ) , RSL_M )
+   END IF
+   IF ( periodic_y ) THEN
+     CALL rsl_exch_period ( domdesc , comms( period_id ) , RSL_N )
+   END IF
+   RETURN
+END SUBROUTINE wrf_dm_boundary
+#endif
+
+SUBROUTINE wrf_dm_define_comms ( grid )
+   USE module_domain
+   USE module_dm
+   IMPLICIT NONE
+   TYPE(domain) , INTENT (INOUT) :: grid 
+   INTEGER dyn_opt
+   INTEGER idum1, idum2, icomm
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+#include "deref_kludge.h"
+
+   CALL nl_get_dyn_opt( 1, dyn_opt )
+
+   CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
+
+! rsl interface has been restructured so there is no longer a 
+! need to call a dyncore specific define_comms routine here.
+! Removed 6/2001. JM
+
+   DO icomm = 1, max_comms
+     grid%comms(icomm) = invalid_message_value
+   ENDDO
+   grid%shift_x = invalid_message_value
+   grid%shift_y = invalid_message_value
+
+   RETURN
+END SUBROUTINE wrf_dm_define_comms
+
+SUBROUTINE write_68( grid, v , s , &
+                   ids, ide, jds, jde, kds, kde, &
+                   ims, ime, jms, jme, kms, kme, &
+                   its, ite, jts, jte, kts, kte )
+  USE module_domain
+  IMPLICIT NONE
+  TYPE(domain) , INTENT (INOUT) :: grid 
+  CHARACTER *(*) s
+  INTEGER ids, ide, jds, jde, kds, kde, &
+          ims, ime, jms, jme, kms, kme, &
+          its, ite, jts, jte, kts, kte
+  REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: v
+# include "rsl.inc"
+
+  INTEGER i,j,k
+
+  logical, external :: wrf_dm_on_monitor
+  real globbuf( ids:ide, kds:kde, jds:jde )
+  character*3 ord, stag
+
+  if ( kds == kde ) then
+    ord = 'xy'
+    stag = 'xy'
+  CALL wrf_patch_to_global_real ( v, globbuf, grid%domdesc, stag, ord, &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+  else
+
+    stag = 'xyz' 
+    ord = 'xzy'
+  CALL wrf_patch_to_global_real ( v, globbuf, grid%domdesc, stag, ord, &
+                     ids, ide, kds, kde, jds, jde, &
+                     ims, ime, kms, kme, jms, jme, &
+                     its, ite, kts, kte, jts, jte )
+  endif
+
+
+  if ( wrf_dm_on_monitor() ) THEN
+    WRITE(68,*) ide-ids+1, jde-jds+1 , s
+    DO j = jds, jde
+    DO i = ids, ide
+       WRITE(68,*) globbuf(i,1,j)
+    ENDDO
+    ENDDO
+  endif
+
+  RETURN
+END
+
+   SUBROUTINE wrf_abort
+! <DESCRIPTION>
+! Kill the run. Calls MPI_ABORT.
+!
+! </DESCRIPTION>
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      CALL mpi_abort(MPI_COMM_WORLD,1,ierr)
+#else
+      STOP
+#endif
+   END SUBROUTINE wrf_abort
+
+   SUBROUTINE wrf_dm_shutdown
+# include "rsl.inc"
+! <DESCRIPTION>
+! Shutdown (gracefully) the underlying comm layer.
+!
+! </DESCRIPTION>
+      CALL RSL_SHUTDOWN
+      RETURN
+   END SUBROUTINE wrf_dm_shutdown
+
+   LOGICAL FUNCTION wrf_dm_on_monitor()
+      LOGICAL rsl_iammonitor
+      EXTERNAL rsl_iammonitor
+! <DESCRIPTION>
+! Return true on task zero, false otherwise.
+!
+! </DESCRIPTION>
+      wrf_dm_on_monitor = rsl_iammonitor()
+      RETURN
+   END FUNCTION wrf_dm_on_monitor
+
+   SUBROUTINE wrf_get_dm_communicator ( communicator )
+      IMPLICIT NONE
+      INTEGER , INTENT(OUT) :: communicator
+! <DESCRIPTION>
+! Return the communicator the underlying comm layer is using.
+!
+! </DESCRIPTION>
+      CALL rsl_get_communicator ( communicator )
+      RETURN
+   END SUBROUTINE wrf_get_dm_communicator
+
+   SUBROUTINE wrf_get_dm_iocommunicator ( iocommunicator )
+      IMPLICIT NONE
+      INTEGER , INTENT(OUT) :: iocommunicator
+! <DESCRIPTION>
+! Return the io communicator the underlying comm layer is using.  Not used.
+!
+! </DESCRIPTION>
+      CALL rsl_get_communicator ( iocommunicator )  ! same as regular communicator
+      RETURN
+   END SUBROUTINE wrf_get_dm_iocommunicator
+
+   SUBROUTINE wrf_set_dm_communicator ( communicator )
+      IMPLICIT NONE
+      INTEGER , INTENT(IN) :: communicator
+! <DESCRIPTION>
+! Set the communicator the underlying comm layer is to use.
+!
+! </DESCRIPTION>
+      CALL rsl_set_communicator ( communicator )
+      RETURN
+   END SUBROUTINE wrf_set_dm_communicator
+
+   SUBROUTINE wrf_set_dm_iocommunicator ( iocommunicator )
+      IMPLICIT NONE
+      INTEGER , INTENT(IN) :: iocommunicator
+! <DESCRIPTION>
+! Set the io communicator the underlying comm layer is to use. Not used.
+!
+! </DESCRIPTION>
+!      CALL rsl_set_communicator ( iocommunicator )  ! same as regular communicator
+      RETURN
+   END SUBROUTINE wrf_set_dm_iocommunicator
+
+
+!!!!!!!!!!!!!!!!!!!!!!! PATCH TO GLOBAL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE wrf_patch_to_global_real (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       REAL globbuf(*)
+       REAL buf(*)
+! <DESCRIPTION>
+! Collective operation. Given a buffer of type real corresponding to a 2- or 3-dimensional patch on a local processor,
+! return on task zero the global array assembled from the pieces stored on each processor.
+! 
+! </DESCRIPTION>
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,TRUE_RSL_REAL,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_real 
+
+   SUBROUTINE wrf_patch_to_global_double (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       DOUBLEPRECISION globbuf(*)
+       DOUBLEPRECISION buf(*)
+! <DESCRIPTION>
+! Collective operation. Given a buffer of type double corresponding to a 2- or 3-dimensional patch on a local processor,
+! return on task zero the global array assembled from the pieces stored on each processor.
+! 
+! </DESCRIPTION>
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,RSL_DOUBLE,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_double
+
+
+   SUBROUTINE wrf_patch_to_global_integer (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       INTEGER globbuf(*)
+       INTEGER buf(*)
+! <DESCRIPTION>
+! Collective operation. Given a buffer of type integer corresponding to a 2- or 3-dimensional patch on a local processor,
+! return on task zero the global array assembled from the pieces stored on each processor.
+! 
+! </DESCRIPTION>
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,rsl_integer,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_integer 
+
+   SUBROUTINE wrf_patch_to_global_logical (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       INTEGER globbuf(*)
+       INTEGER buf(*)
+! <DESCRIPTION>
+! Collective operation. Given a buffer of type integer corresponding to a 2- or 3-dimensional patch on a local processor,
+! return on task zero the global array assembled from the pieces stored on each processor.
+!
+! </DESCRIPTION>
+
+       IF ( LWORDSIZE .NE. IWORDSIZE ) THEN
+         CALL wrf_error_fatal( "module_dm: LWORDSIZE != IWORDSIZE on this machine. RSL cannot cast" ) 
+       ENDIF
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,rsl_integer,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_logical
+
+   SUBROUTINE wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,type,&
+                                       DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3a )
+       USE module_driver_constants
+       USE module_timing
+       USE module_wrf_error
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3A 
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc,type
+       REAL globbuf(*)
+       REAL buf(*)
+
+       LOGICAL, EXTERNAL :: has_char
+       INTEGER glen(3),llen(3),glen2d(3),llen2d(3)
+       INTEGER i, j, k, ord, ord2d, ndim
+       INTEGER mlen, nlen, zlen
+
+       DS1 = DS1a ; DE1 = DE1a ; DS2=DS2a ; DE2 = DE2a ; DS3 = DS3a ; DE3 = DE3a
+       MS1 = MS1a ; ME1 = ME1a ; MS2=MS2a ; ME2 = ME2a ; MS3 = MS3a ; ME3 = ME3a
+       PS1 = PS1a ; PE1 = PE1a ; PS2=PS2a ; PE2 = PE2a ; PS3 = PS3a ; PE3 = PE3a
+
+       ndim = len(TRIM(ordering))
+
+       CALL rsl_get_glen( domdesc, glen(1), glen(2), glen(3) )
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xyz','xy' )
+           ord = io3d_ijk_internal ; ord2d = io2d_ij_internal
+            ! the non-staggered variables come in at one-less than
+            ! domain dimensions, but RSL wants full domain spec, so 
+            ! adjust if not staggered
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'yxz','yx' )
+           ord = io3d_jik_internal ; ord2d = io2d_ji_internal
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'zxy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( .NOT. has_char( stagger, 'z' ) ) DE1 = DE1+1
+           ord = io3d_kij_internal ; ord2d = io2d_ij_internal
+#if 0
+         CASE ( 'zyx' )
+           ord = io3d_kji_internal ; ord2d = io2d_ji_internal
+         CASE ( 'yzx' )
+           ord = io3d_jki_internal ; ord2d = io2d_ji_internal
+#endif
+         CASE ( 'xzy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( .NOT. has_char( stagger, 'z' ) ) DE2 = DE2+1
+           ord = io3d_ikj_internal ; ord2d = io2d_ij_internal
+         CASE DEFAULT
+           ord = -1 ; ord2d = -1
+       END SELECT
+
+
+       glen(1) = DE1-DS1+1   ; glen(2) = DE2-DS2+1   ; glen(3) = DE3-DS3+1
+       llen(1) = ME1-MS1+1   ; llen(2) = ME2-MS2+1   ; llen(3) = ME3-MS3+1
+       glen2d(1) = DE1-DS1+1 ; glen2d(2) = DE2-DS2+1
+       llen2d(1) = ME1-MS1+1 ; llen2d(2) = ME2-MS2+1
+
+       IF ( wrf_at_debug_level(500) ) THEN
+         CALL start_timing
+       ENDIF
+
+       IF ( ndim .EQ. 3 ) THEN
+         CALL rsl_write(globbuf,ord,buf,domdesc,type,glen,llen)
+       ELSE
+         CALL rsl_write(globbuf,ord2d,buf,domdesc,type,glen2d,llen2d)
+       ENDIF
+       IF ( wrf_at_debug_level(500) ) THEN
+         CALL end_timing('wrf_patch_to_global_generic')
+       ENDIF
+       RETURN
+    END SUBROUTINE wrf_patch_to_global_generic
+
+!!!!!!!!!!!!!!!!!!!!!!! GLOBAL TO PATCH !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    SUBROUTINE wrf_global_to_patch_real (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       REAL globbuf(*)
+       REAL buf(*)
+! <DESCRIPTION>
+! Collective operation. Given a global 2- or 3-dimensional array of type real on task zero,
+! return the appropriate decomposed section (patch) on each processor.
+! 
+! </DESCRIPTION>
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,TRUE_RSL_REAL,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_real
+
+    SUBROUTINE wrf_global_to_patch_double (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       DOUBLEPRECISION globbuf(*)
+       DOUBLEPRECISION buf(*)
+! <DESCRIPTION>
+! Collective operation. Given a global 2- or 3-dimensional array of type double on task zero,
+! return the appropriate decomposed section (patch) on each processor.
+! 
+! </DESCRIPTION>
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,RSL_DOUBLE,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_double
+
+
+    SUBROUTINE wrf_global_to_patch_integer (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       INTEGER globbuf(*)
+       INTEGER buf(*)
+! <DESCRIPTION>
+! Collective operation. Given a global 2- or 3-dimensional array of type integer on task zero,
+! return the appropriate decomposed section (patch) on each processor.
+! 
+! </DESCRIPTION>
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,rsl_integer,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_integer
+
+    SUBROUTINE wrf_global_to_patch_logical (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       LOGICAL globbuf(*)
+       LOGICAL buf(*)
+! <DESCRIPTION>
+! Collective operation. Given a global 2- or 3-dimensional array of type integer on task zero,
+! return the appropriate decomposed section (patch) on each processor.
+!
+! </DESCRIPTION>
+
+       IF ( LWORDSIZE .NE. IWORDSIZE ) THEN
+         CALL wrf_error_fatal( "RSL module_dm: LWORDSIZE != IWORDSIZE on this machine. RSL cannot cast" ) 
+       ENDIF
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,rsl_integer,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_logical
+
+    SUBROUTINE wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,type,&
+                                       DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3a )
+       USE module_driver_constants
+       IMPLICIT NONE
+#include "rsl.inc"
+       INTEGER                         DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3A 
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc,type
+       REAL globbuf(*)
+       REAL buf(*)
+       LOGICAL, EXTERNAL :: has_char
+
+       INTEGER i,j,k,ord,ord2d,ndim
+       INTEGER glen(3),llen(3),glen2d(3),llen2d(3)
+
+       DS1 = DS1a ; DE1 = DE1a ; DS2=DS2a ; DE2 = DE2a ; DS3 = DS3a ; DE3 = DE3a
+       MS1 = MS1a ; ME1 = ME1a ; MS2=MS2a ; ME2 = ME2a ; MS3 = MS3a ; ME3 = ME3a
+       PS1 = PS1a ; PE1 = PE1a ; PS2=PS2a ; PE2 = PE2a ; PS3 = PS3a ; PE3 = PE3a
+
+       ndim = len(TRIM(ordering))
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xyz','xy' )
+           ord = io3d_ijk_internal ; ord2d = io2d_ij_internal
+            ! the non-staggered variables come in at one-less than
+            ! domain dimensions, but RSL wants full domain spec, so 
+            ! adjust if not staggered
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'yxz','yx' )
+           ord = io3d_jik_internal ; ord2d = io2d_ji_internal
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'zxy' )
+           ord = io3d_kij_internal ; ord2d = io2d_ij_internal
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( .NOT. has_char( stagger, 'z' ) ) DE1 = DE1+1
+#if 0
+         CASE ( 'zyx' )
+           ord = io3d_kji_internal ; ord2d = io2d_ji_internal
+         CASE ( 'yzx' )
+           ord = io3d_jki_internal ; ord2d = io2d_ji_internal
+#endif
+         CASE ( 'xzy' )
+           ord = io3d_ikj_internal ; ord2d = io2d_ij_internal
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( .NOT. has_char( stagger, 'z' ) ) DE2 = DE2+1
+         CASE DEFAULT
+           ord = -1 ; ord2d = -1
+       END SELECT
+
+       glen(1) = DE1-DS1+1   ; glen(2) = DE2-DS2+1   ; glen(3) = DE3-DS3+1
+       llen(1) = ME1-MS1+1   ; llen(2) = ME2-MS2+1   ; llen(3) = ME3-MS3+1
+       glen2d(1) = DE1-DS1+1 ; glen2d(2) = DE2-DS2+1
+       llen2d(1) = ME1-MS1+1 ; llen2d(2) = ME2-MS2+1
+
+       IF ( ndim .EQ. 3 ) THEN
+         CALL rsl_read(globbuf,ord,buf,domdesc,type,glen,llen)
+       ELSE
+         CALL rsl_read(globbuf,ord2d,buf,domdesc,type,glen2d,llen2d)
+       ENDIF
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_generic
+
+
+!------------------------------------------------------------------
+
+#if ( EM_CORE == 1 )
+
+!------------------------------------------------------------------
+
+   SUBROUTINE force_domain_em_part2 ( grid, ngrid, config_flags   &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include "em_dummy_new_decl.inc"
+#include "em_i1_decl.inc"
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+! <DESCRIPTION>
+! Description is to do...
+! </DESCRIPTION>
+
+#ifdef DM_PARALLEL
+#    define REGISTER_I1
+#      include "em_data_calls.inc"
+#endif
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+#  include "em_nest_interpdown_unpack.inc"
+
+#include "HALO_EM_FORCE_DOWN.inc"
+
+      ! code here to interpolate the data into the nested domain
+#  include "em_nest_forcedown_interp.inc"
+
+      RETURN
+   END SUBROUTINE force_domain_em_part2
+
+
+
+!------------------------------------------------------------------
+
+   SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_timing
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+#include "em_dummy_new_decl.inc"
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+
+!
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  intermediate_grid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+#  include "em_nest_interpdown_pack.inc"
+
+      CALL rsl_bcast_msgs
+
+      RETURN
+   END SUBROUTINE interp_domain_em_part1
+
+   SUBROUTINE interp_domain_em_part2 ( grid, ngrid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include "em_dummy_new_decl.inc"
+#include "em_i1_decl.inc"
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+
+#ifdef DM_PARALLEL
+#    define REGISTER_I1
+#      include "em_data_calls.inc"
+#endif
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1 
+
+#  include "em_nest_interpdown_unpack.inc"
+
+#include "HALO_EM_INTERP_DOWN.inc"
+      ! code here to interpolate the data into the nested domain
+
+#  include "em_nest_interpdown_interp.inc"
+
+      RETURN
+   END SUBROUTINE interp_domain_em_part2
+
+!------------------------------------------------------------------
+! This routine exists only to call a halo on a domain (the nest)
+! gets called from feedback_domain_em_part1, below.  This is needed
+! because the halo code expects the fields being exchanged to have
+! been dereferenced from the grid data structure, but in feedback_domain_em_part1
+! the grid data structure points to the coarse domain, not the nest.
+! And we want the halo exchange on the nest, so that the code in 
+! em_nest_feedbackup_interp.inc will work correctly on multi-p. JM 20040308
+!
+   SUBROUTINE feedback_nest_prep ( grid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+)
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_state_description
+!
+      TYPE(domain), TARGET :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE (grid_config_rec_type) :: config_flags ! configureation flags, has vertical dim of 
+                                                  ! soil temp, moisture, etc., has vertical dim
+                                                  ! of soil categories
+#include "em_dummy_new_decl.inc"
+
+#ifdef DM_PARALLEL
+#      include "em_data_calls.inc"
+#endif
+
+#ifdef DM_PARALLEL
+# include "HALO_EM_INTERP_UP.inc"
+#endif
+
+   END SUBROUTINE feedback_nest_prep
+
+   SUBROUTINE feedback_domain_em_part1 ( grid, ngrid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include "em_dummy_new_decl.inc"
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE(domain), POINTER :: xgrid
+      TYPE (grid_config_rec_type)            :: config_flags, nconfig_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTERFACE 
+          SUBROUTINE feedback_nest_prep ( grid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+)
+             USE module_domain
+             USE module_configure
+             USE module_dm
+             USE module_state_description
+!
+             TYPE (grid_config_rec_type)            :: config_flags
+             TYPE(domain), TARGET                   :: grid
+#include "em_dummy_new_decl.inc"
+          END SUBROUTINE feedback_nest_prep
+
+      END INTERFACE
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,                  &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+      ips_save = ngrid%i_parent_start   ! used in feedback_domain_em_part2 below
+      jps_save = ngrid%j_parent_start
+      ipe_save = ngrid%i_parent_start + (nide-nids+1) / ngrid%parent_grid_ratio - 1
+      jpe_save = ngrid%j_parent_start + (njde-njds+1) / ngrid%parent_grid_ratio - 1
+
+      CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags )
+      CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 )
+
+      xgrid => grid
+      grid => ngrid 
+
+      CALL feedback_nest_prep ( grid, nconfig_flags    &
+!
+#include "em_actual_new_args.inc"
+!
+)
+
+      grid => xgrid
+      CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
+
+#  include "em_nest_feedbackup_interp.inc"
+
+      RETURN
+   END SUBROUTINE feedback_domain_em_part1
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid, ngrid , config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+#include "em_dummy_new_decl.inc"
+#include "em_i1_decl.inc"
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      REAL          :: nest_influence
+      LOGICAL, EXTERNAL  :: em_cd_feedback_mask
+
+#ifdef DM_PARALLEL
+#    define REGISTER_I1
+#      include "em_data_calls.inc"
+#endif
+
+      nest_influence = 1.
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  intermediate_grid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+#  include "em_nest_feedbackup_pack.inc"
+
+      CALL rsl_merge_msgs
+
+#define NEST_INFLUENCE(A,B) A = B
+#  include "em_nest_feedbackup_unpack.inc"
+
+      ! smooth coarse grid 
+
+      CALL get_ijk_from_grid (  ngrid,                           &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+#  include "HALO_EM_INTERP_UP.inc"
+#  include "em_nest_feedbackup_smooth.inc"
+
+      RETURN
+   END SUBROUTINE feedback_domain_em_part2
+
+#endif
+
+!------------------------------------------------------------------
+
+#if ( NMM_CORE == 1 )
+!==============================================================================
+! NMM nesting infrastructure extended from EM core. This is gopal's doing.
+!==============================================================================
+
+   SUBROUTINE interp_domain_nmm_part1 ( grid, intermediate_grid, ngrid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_timing
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+#include "nmm_dummy_decl.inc"
+      TYPE (grid_config_rec_type)            :: config_flags
+
+      CALL wrf_error_fatal ( 'module_dm: NMM nesting does not support RSL' )
+
+      RETURN
+   END SUBROUTINE interp_domain_nmm_part1
+
+   SUBROUTINE interp_domain_nmm_part2 ( grid, ngrid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include "nmm_dummy_decl.inc"
+      TYPE (grid_config_rec_type)            :: config_flags
+
+      CALL wrf_error_fatal ( 'module_dm: NMM nesting does not support RSL' )
+
+      RETURN
+   END SUBROUTINE interp_domain_nmm_part2
+
+   SUBROUTINE force_domain_nmm_part1 ( grid, intermediate_grid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_timing
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+#include "nmm_dummy_decl.inc"
+      TYPE (grid_config_rec_type)            :: config_flags
+
+      CALL wrf_error_fatal ( 'module_dm: NMM nesting does not support RSL' )
+
+      RETURN
+   END SUBROUTINE force_domain_nmm_part1
+
+   SUBROUTINE force_domain_nmm_part2 ( grid, ngrid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include "nmm_dummy_decl.inc"
+      TYPE (grid_config_rec_type)            :: config_flags
+
+      CALL wrf_error_fatal ( 'module_dm: NMM nesting does not support RSL' )
+
+      RETURN
+   END SUBROUTINE force_domain_nmm_part2
+
+   SUBROUTINE feedback_domain_nmm_part1 ( grid, ngrid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include "nmm_dummy_decl.inc"
+      TYPE (grid_config_rec_type)            :: config_flags, nconfig_flags
+
+      CALL wrf_error_fatal ( 'module_dm: NMM nesting does not support RSL' )
+
+      RETURN
+   END SUBROUTINE feedback_domain_nmm_part1
+
+   SUBROUTINE feedback_domain_nmm_part2 ( grid, intermediate_grid, ngrid , config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_utility
+      IMPLICIT NONE
+
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+
+#include "nmm_dummy_decl.inc"
+      TYPE (grid_config_rec_type)            :: config_flags
+
+      CALL wrf_error_fatal ( 'module_dm: NMM nesting does not support RSL' )
+
+      RETURN
+   END SUBROUTINE feedback_domain_nmm_part2
+
+!=================================================================================
+!   End of gopal's doing
+!=================================================================================
+#endif
+
+
+
+#ifndef STUBMPI
+
+   SUBROUTINE wrf_gatherv_real (Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   USE module_dm
+   IMPLICIT NONE
+   INCLUDE 'mpif.h'
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   REAL, DIMENSION(*) :: Field, globbuf
+
+           CALL mpi_gatherv( Field( field_ofst ),      &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            getrealmpitype()         ,               &    ! sendtype
+                            globbuf( glob_ofst ) ,                 &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            getrealmpitype()                       , &    ! recvtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+
+   END SUBROUTINE wrf_gatherv_real
+
+   SUBROUTINE wrf_gatherv_integer (Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   USE module_dm
+   IMPLICIT NONE
+   INCLUDE 'mpif.h'
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   INTEGER, DIMENSION(*) :: Field, globbuf
+
+           CALL mpi_gatherv( Field( field_ofst ),      &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            MPI_INTEGER         ,               &    ! sendtype
+                            globbuf( glob_ofst ) ,                 &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            MPI_INTEGER                       , &    ! recvtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+
+   END SUBROUTINE wrf_gatherv_integer
+
+   SUBROUTINE wrf_gatherv_double (Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   USE module_dm
+   IMPLICIT NONE
+   INCLUDE 'mpif.h'
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   DOUBLE PRECISION, DIMENSION(*) :: Field, globbuf
+
+           CALL mpi_gatherv( Field( field_ofst ),      &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            MPI_DOUBLE_PRECISION         ,               &    ! sendtype
+                            globbuf( glob_ofst ) ,                 &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            MPI_DOUBLE_PRECISION                      , &    ! recvtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+
+   END SUBROUTINE wrf_gatherv_double
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/RSL/rsl_cpp_flags
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL/rsl_cpp_flags	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL/rsl_cpp_flags	(revision 2744)
@@ -0,0 +1,34 @@
+-DWRF_RSL_LF_NCOMMS=33
+-DHALO_LF_INIT=1
+-DHALO_LF_A=2
+-DHALO_LF_B=3
+-DHALO_LF_C=4
+-DHALO_LF_D=5
+-DHALO_LF_E=6
+-DHALO_LF_MOIST=7
+-DHALO_LF_CHEM=8
+-DPERIOD_BDY_LF_A=9
+-DPERIOD_BDY_LF_B=10
+-DPERIOD_BDY_LF_C=11
+-DPERIOD_BDY_LF_D=12
+-DPERIOD_BDY_LF_MOIST=13
+-DPERIOD_BDY_LF_CHEM=14
+-DPERIOD_BDY_LF_INIT=15
+-DPERIOD_BDY_LF_MOUNTAIN=16
+-DHALO_RK_INIT=17
+-DHALO_RK_A=18
+-DHALO_RK_B=19
+-DHALO_RK_C=20
+-DHALO_RK_D=21
+-DHALO_RK_E=22
+-DHALO_RK_MOIST=23
+-DHALO_RK_CHEM=24
+-DPERIOD_BDY_RK_A=25
+-DPERIOD_BDY_RK_B=26
+-DPERIOD_BDY_RK_C=27
+-DPERIOD_BDY_RK_D=28
+-DPERIOD_BDY_RK_MOIST=29
+-DPERIOD_BDY_RK_CHEM=30
+-DPERIOD_BDY_RK_INIT=31
+-DPERIOD_BDY_RK_MOUNTAIN=32
+-DHALO_RK_PHYS_A=33
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/buf_for_proc.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/buf_for_proc.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/buf_for_proc.c	(revision 2744)
@@ -0,0 +1,167 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "rsl_lite.h"
+#include "mpi.h"
+
+typedef struct bufdesc {
+  char * buf ;
+  int size ;
+} bufdesc_t ;
+
+/* buftab[RSL_SENDBUF] is send buffer descriptor,
+   buftab[RSL_RECVBUF] is recv buffer descriptor. */
+static bufdesc_t buftab[2][RSL_MAXPROC] ;
+static int first = 1 ;
+
+/* 
+   buffer_for_proc
+
+   returns a pointer to a buffer already allocated for processor P if
+   it is big enough; otherwise, it frees the existing buffer, if there
+   is one and then allocates a new one that is big enough.  If RSL_FREEBUF
+   is called for a P, the two buffers (send and recv) are truncated and
+   freed and NULL is returned.
+
+   You are guaranteed to get back the same buffer as the previous call
+   for a given P, as long as the size is less than the size passed to
+   the previous call.  Thus, you can use this routine to manage the
+   pointers to the buffers for P and avoid having to set up arrays
+   of pointers in the routines that use these buffers.
+
+*/
+
+char mess[1024] ;
+
+char *
+buffer_for_proc( P, size, code )
+  int P ;   /* processor number */
+  int size,		/* requested size */
+      code ;		/* RSL_SENDBUF, RSL_RECVBUF, or RSL_FREEBUF */
+{
+  int p ;
+  int i, j ;
+  char * ret ;
+
+  ret = NULL ;
+  if ( first )
+  {
+    for ( p = 0 ; p < RSL_MAXPROC ; p++ )
+    {
+      buftab[0][p].buf  = NULL ;    
+      buftab[1][p].buf  = NULL ;    
+      buftab[0][p].size = 0 ;    
+      buftab[1][p].size = 0 ;    
+    }
+    first = 0 ;
+  }
+  if ( P < 0 || P >= RSL_MAXPROC )
+  {
+    sprintf(mess,"Bad P argument to buffer_for_proc.  P = %d. Has RSL_MESH been called?\n",P) ;
+    RSL_TEST_ERR( 1, mess ) ;
+  }
+  if ( code == RSL_FREEBUF )
+  {
+/* fprintf(stderr,"buffer_for_proc freeing buffer %d\n",P) ; */
+    if ( buftab[0][P].buf != NULL ) RSL_FREE( buftab[0][P].buf ) ;
+    if ( buftab[1][P].buf != NULL ) RSL_FREE( buftab[1][P].buf ) ;
+    buftab[0][P].buf  = NULL ;    
+    buftab[1][P].buf  = NULL ;    
+    buftab[0][P].size = 0 ;    
+    buftab[1][P].size = 0 ;    
+/* show_tot_size() ; */
+  }
+  else if ( code == RSL_SENDBUF || code == RSL_RECVBUF )
+  {
+    if ( buftab[code][P].size < size )
+    {
+#if 0
+fprintf(stderr,"buffer_for_proc %s %d : was %d, increasing to %d\n",
+         (code == RSL_SENDBUF)?"RSL_SENDBUF":"RSL_RECVBUF",
+	 P,buftab[code][P].size, size+512) ;
+#endif
+      if ( buftab[code][P].buf != NULL ) RSL_FREE( buftab[code][P].buf ) ;
+      buftab[code][P].buf = RSL_MALLOC(char,size+512) ;
+      buftab[code][P].size = size+512 ;
+/* show_tot_size() ; */
+    }
+    ret = buftab[code][P].buf ;
+  }
+  return(ret) ;
+}
+
+show_tot_size()
+{
+  int P ;
+  int acc ;
+  acc = 0 ;
+  for ( P = 0 ; P < RSL_MAXPROC ; P++ )
+  {
+    acc += buftab[0][P].size ;
+    acc += buftab[1][P].size ;
+  }
+  fprintf(stderr,"Total bytes allocated for buffers: %d\n", acc ) ;
+}
+
+int
+buffer_size_for_proc( P, code )
+  int P ;
+  int code ;
+{
+  return( buftab[code][P].size ) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/c_code.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/c_code.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/c_code.c	(revision 2744)
@@ -0,0 +1,696 @@
+#include <stdio.h>
+#include <fcntl.h>
+
+#define STANDARD_ERROR 2
+
+#define STANDARD_OUTPUT 1
+
+#include "mpi.h"
+#include "rsl_lite.h"
+
+#define F_PACK
+
+RSL_LITE_ERROR_DUP1 ( int *me )
+{
+    int newfd ;
+    char filename[256] ;
+    char hostname[256] ;
+
+    gethostname( hostname, 256 ) ;
+
+/* redirect standard out*/
+    sprintf(filename,"rsl.out.%04d",*me) ;
+    if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
+    {
+        perror("error_dup: cannot open rsl.out.nnnn") ;
+        fprintf(stderr,"...sending output to standard output and continuing.\n") ;
+        return ;
+    }
+    if( dup2( newfd, STANDARD_OUTPUT ) < 0 )
+    {
+        perror("error_dup: dup2 fails to change output descriptor") ;
+        fprintf(stderr,"...sending output to standard output and continuing.\n") ;
+        close(newfd) ;
+        return ;
+    }
+
+/* redirect standard error */
+    sprintf(filename,"rsl.error.%04d",*me) ;
+    if ((newfd = open( filename, O_CREAT | O_WRONLY, 0666 )) < 0 )
+    {
+        perror("error_dup: cannot open rsl.error.log") ;
+        fprintf(stderr,"...sending error to standard error and continuing.\n") ;
+        return ;
+    }
+    if( dup2( newfd, STANDARD_ERROR ) < 0 )
+    {
+        perror("error_dup: dup2 fails to change error descriptor") ;
+        fprintf(stderr,"...sending error to standard error and continuing.\n") ;
+        close(newfd) ;
+        return ;
+    }
+    fprintf( stdout, "taskid: %d hostname: %s\n",*me,hostname) ;
+    fprintf( stderr, "taskid: %d hostname: %s\n",*me,hostname) ;
+
+}
+
+BYTE_BCAST ( char * buf, int * size, int * Fcomm )
+{
+    MPI_Comm *comm, dummy_comm ;
+
+    comm = &dummy_comm ;
+    *comm = MPI_Comm_f2c( *Fcomm ) ;
+#ifdef crayx1
+    if (*size % sizeof(int) == 0) {
+       MPI_Bcast ( buf, *size/sizeof(int), MPI_INT, 0, *comm ) ;
+    } else {
+       MPI_Bcast ( buf, *size, MPI_BYTE, 0, *comm ) ;
+    }
+#else
+    MPI_Bcast ( buf, *size, MPI_BYTE, 0, *comm ) ;
+#endif
+}
+
+static int yp_curs, ym_curs, xp_curs, xm_curs ;
+
+RSL_LITE_INIT_EXCH ( 
+                int * Fcomm0,
+                int * shw0,
+                int * n3dR0, int *n2dR0, int * typesizeR0 , 
+                int * n3dI0, int *n2dI0, int * typesizeI0 , 
+                int * n3dD0, int *n2dD0, int * typesizeD0 , 
+                int * n3dL0, int *n2dL0, int * typesizeL0 , 
+                int * me0, int * np0 , int * np_x0 , int * np_y0 ,
+                int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
+{
+  int n3dR, n2dR, typesizeR ;
+  int n3dI, n2dI, typesizeI ;
+  int n3dD, n2dD, typesizeD ;
+  int n3dL, n2dL, typesizeL ;
+  int shw ;
+  int me, np, np_x, np_y ;
+  int ips , ipe , jps , jpe , kps , kpe ;
+  int yp, ym, xp, xm ;
+  int nbytes ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+
+  shw = *shw0 ;
+  n3dR = *n3dR0 ; n2dR = *n2dR0 ; typesizeR = *typesizeR0 ;
+  n3dI = *n3dI0 ; n2dI = *n2dI0 ; typesizeI = *typesizeI0 ;
+  n3dD = *n3dD0 ; n2dD = *n2dD0 ; typesizeD = *typesizeD0 ;
+  n3dL = *n3dL0 ; n2dL = *n2dL0 ; typesizeL = *typesizeL0 ;
+  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
+
+#if 1
+
+  if ( np_y > 1 ) {
+    nbytes = typesizeR*(ipe-ips+1+2*shw)*shw*(n3dR*(kpe-kps+1)+n2dR) +
+             typesizeI*(ipe-ips+1+2*shw)*shw*(n3dI*(kpe-kps+1)+n2dI) +
+             typesizeD*(ipe-ips+1+2*shw)*shw*(n3dD*(kpe-kps+1)+n2dD) +
+             typesizeL*(ipe-ips+1+2*shw)*shw*(n3dL*(kpe-kps+1)+n2dL) ;
+    MPI_Cart_shift ( *comm0, 0, 1, &ym, &yp ) ;
+    if ( yp != MPI_PROC_NULL ) {
+       buffer_for_proc ( yp , nbytes, RSL_RECVBUF ) ;
+       buffer_for_proc ( yp , nbytes, RSL_SENDBUF ) ;
+    }
+    if ( ym != MPI_PROC_NULL ) {
+       buffer_for_proc ( ym , nbytes, RSL_RECVBUF ) ;
+       buffer_for_proc ( ym , nbytes, RSL_SENDBUF ) ;
+    }
+  }
+  if ( np_x > 1 ) {
+    nbytes = typesizeR*(jpe-jps+1+2*shw)*shw*(n3dR*(kpe-kps+1)+n2dR) +
+             typesizeI*(jpe-jps+1+2*shw)*shw*(n3dI*(kpe-kps+1)+n2dI) +
+             typesizeD*(jpe-jps+1+2*shw)*shw*(n3dD*(kpe-kps+1)+n2dD) +
+             typesizeL*(jpe-jps+1+2*shw)*shw*(n3dL*(kpe-kps+1)+n2dL) ;
+    MPI_Cart_shift ( *comm0, 1, 1, &xm, &xp ) ;
+    if ( xp != MPI_PROC_NULL ) {
+       buffer_for_proc ( xp , nbytes, RSL_RECVBUF ) ;
+       buffer_for_proc ( xp , nbytes, RSL_SENDBUF ) ;
+    }
+    if ( xm != MPI_PROC_NULL ) {
+       buffer_for_proc ( xm , nbytes, RSL_RECVBUF ) ;
+       buffer_for_proc ( xm , nbytes, RSL_SENDBUF ) ;
+    }
+  }
+#endif
+  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
+}
+
+RSL_LITE_PACK ( int * Fcomm0, char * buf , int * shw0 , int * typesize0 , int * xy0 , int * pu0 , char * memord , int * xstag0, /* not used */
+           int *me0, int * np0 , int * np_x0 , int * np_y0 , 
+           int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
+           int * ims0 , int * ime0 , int * jms0 , int * jme0 , int * kms0 , int * kme0 ,
+           int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
+{
+  int me, np, np_x, np_y ;
+  int shw , typesize ;
+  int ids , ide , jds , jde , kds , kde ;
+  int ims , ime , jms , jme , kms , kme ;
+  int ips , ipe , jps , jpe , kps , kpe ;
+  int xy ;   /* y = 0 , x = 1 */
+  int pu ;   /* pack = 0 , unpack = 1 */
+  register int i, j, k, t ;
+#ifdef crayx1
+  register int i2,i3,i4,i_offset;
+#endif
+  char *p ;
+  int da_buf ;
+  int yp, ym, xp, xm ;
+  int nbytes, ierr ;
+  register int *pi, *qi ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+  int js, je, ks, ke, is, ie, wcount ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+
+  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  shw = *shw0 ; typesize = *typesize0 ;
+  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
+  ims = *ims0-1 ; ime = *ime0-1 ; jms = *jms0-1 ; jme = *jme0-1 ; kms = *kms0-1 ; kme = *kme0-1 ;
+  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
+  xy = *xy0 ;
+  pu = *pu0 ;
+
+/* need to adapt for other memory orders */
+
+#define RANGE(S1,E1,S2,E2,S3,E3,S4,E4) (((E1)-(S1)+1)*((E2)-(S2)+1)*((E3)-(S3)+1)*((E4)-(S4)+1))
+#define IMAX(A) (((A)>ids)?(A):ids)
+#define IMIN(A) (((A)<ide)?(A):ide)
+#define JMAX(A) (((A)>jds)?(A):jds)
+#define JMIN(A) (((A)<jde)?(A):jde)
+
+  da_buf = ( pu == 0 ) ? RSL_SENDBUF : RSL_RECVBUF ;
+
+  if ( np_y > 1 && xy == 0 ) {
+    MPI_Cart_shift( *comm0 , 0, 1, &ym, &yp ) ;
+    if ( yp != MPI_PROC_NULL ) {
+      p = buffer_for_proc( yp , 0 , da_buf ) ;
+      if ( pu == 0 ) {
+        js = jpe-shw+1     ; je = jpe ;
+        ks = kps           ; ke = kpe ;
+        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
+        nbytes = buffer_size_for_proc( yp, da_buf ) ;
+	if ( yp_curs + RANGE( jpe-shw+1, jpe, kps, kpe, ips-shw, ipe+shw, 1, typesize ) > nbytes ) {
+	  fprintf(stderr,"memory overwrite in rsl_lite_pack, Y pack up, %d > %d\n",
+	      yp_curs + RANGE( jpe-shw+1, jpe, kps, kpe, ips-shw, ipe+shw, 1, typesize ), nbytes ) ;
+	  MPI_Abort(MPI_COMM_WORLD, 99) ;
+        }
+        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
+          F_PACK_LINT ( buf, p+yp_curs, &js, &je, &ks, &ke, &is, &ie, 
+                                              &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          yp_curs += wcount*typesize ;
+        }
+	else if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_PACK_INT ( buf, p+yp_curs, &js, &je, &ks, &ke, &is, &ie,
+                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          yp_curs += wcount*typesize ;
+#else
+          wcount = 0 ;
+          for ( j = jpe-shw+1 ; j <= jpe ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              pi = (int *)(p+yp_curs) ;
+              i = IMAX(ips-shw) ;
+              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
+                *pi++ = *qi++ ;
+                wcount++ ;
+              }
+              yp_curs += (i-(ips-shw))*typesize ;
+            }
+          }
+#endif
+	}
+	else {
+          for ( j = jpe-shw+1 ; j <= jpe ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                  *(p+yp_curs) = 
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                  yp_curs++ ;
+                }
+              }
+            }
+          }
+        }
+      } else {
+        js = jpe+1         ; je = jpe+shw ;
+        ks = kps           ; ke = kpe ;
+        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
+        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
+          F_UNPACK_LINT ( p+yp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          yp_curs += wcount*typesize ;
+        }
+	else if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_UNPACK_INT ( p+yp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          yp_curs += wcount*typesize ;
+#else
+          for ( j = jpe+1 ; j <= jpe+shw ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              pi = (int *)(p+yp_curs) ;
+              i = IMAX(ips-shw) ;
+              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
+                *qi++ = *pi++ ;
+              }
+              yp_curs += (i-(ips-shw))*typesize ;
+            }
+          }
+#endif
+	}
+	else {
+          for ( j = jpe+1 ; j <= jpe+shw ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                  *(p+yp_curs) ;
+                  yp_curs++ ;
+                }
+              }
+            }
+          }
+	}
+      }
+    }
+    if ( ym != MPI_PROC_NULL ) {
+      p = buffer_for_proc( ym , 0 , da_buf ) ;
+      if ( pu == 0 ) {
+        js = jps           ; je = jps+shw-1 ;
+        ks = kps           ; ke = kpe ;
+        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
+        nbytes = buffer_size_for_proc( ym, da_buf ) ;
+	if ( ym_curs + RANGE( jps, jps+shw-1, kps, kpe, ips-shw, ipe+shw, 1, typesize ) > nbytes ) {
+	  fprintf(stderr,"memory overwrite in rsl_lite_pack, Y pack dn, %d > %d\n",
+	      ym_curs + RANGE( jps, jps+shw-1, kps, kpe, ips-shw, ipe+shw, 1, typesize ), nbytes ) ;
+	  MPI_Abort(MPI_COMM_WORLD, 99) ;
+        }
+        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
+          F_PACK_LINT ( buf, p+ym_curs, &js, &je, &ks, &ke, &is, &ie,
+                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          ym_curs += wcount*typesize ;
+        }
+	else if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_PACK_INT ( buf, p+ym_curs, &js, &je, &ks, &ke, &is, &ie,
+                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          ym_curs += wcount*typesize ;
+#else
+          wcount = 0 ;
+          for ( j = jps ; j <= jps+shw-1 ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              pi = (int *)(p+ym_curs) ;
+              i = IMAX(ips-shw) ;
+              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
+                *pi++ = *qi++ ;
+                wcount++ ;
+              }
+              ym_curs += (i-(ips-shw))*typesize ;
+            }
+          }
+#endif
+	}
+	else {
+          for ( j = jps ; j <= jps+shw-1 ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                  *(p+ym_curs) = 
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                  ym_curs++ ;
+                }
+              }
+            }
+          }
+	}
+      } else {
+        js = jps-shw       ; je = jps-1 ;
+        ks = kps           ; ke = kpe ;
+        is = IMAX(ips-shw) ; ie = IMIN(ipe+shw) ;
+        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
+          F_UNPACK_LINT ( p+ym_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                                &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          ym_curs += wcount*typesize ;
+        }
+	else if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_UNPACK_INT ( p+ym_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                               &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          ym_curs += wcount*typesize ;
+#else
+         for ( j = jps-shw ; j <= jps-1 ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              pi = (int *)(p+ym_curs) ;
+              i = IMAX(ips-shw) ;
+              qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
+                *qi++ = *pi++ ;
+              }
+              ym_curs += (i-(ips-shw))*typesize ;
+            }
+          }
+#endif
+	}
+	else {
+          for ( j = jps-shw ; j <= jps-1 ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = IMAX(ips-shw) ; i <= IMIN(ipe+shw) ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                  *(p+ym_curs)  ;
+                  ym_curs++ ;
+                }
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+
+  if ( np_x > 1 && xy == 1 ) {
+    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
+    if ( xp != MPI_PROC_NULL ) {
+      p = buffer_for_proc( xp , 0 , da_buf ) ;
+      if ( pu == 0 ) {
+        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
+        ks = kps           ; ke = kpe ;
+        is = ipe-shw+1     ; ie = ipe ;
+        nbytes = buffer_size_for_proc( xp, da_buf ) ;
+        if ( xp_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ipe-shw+1, ipe, 1, typesize ) > nbytes ) {
+	  fprintf(stderr,"memory overwrite in rsl_lite_pack, X pack right, %d > %d\n",
+	      xp_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ipe-shw+1, ipe, 1, typesize ), nbytes ) ;
+	  MPI_Abort(MPI_COMM_WORLD, 99) ;
+        }
+        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
+          F_PACK_LINT ( buf, p+xp_curs, &js, &je, &ks, &ke, &is, &ie,
+                                              &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xp_curs += wcount*typesize ;
+        }
+	else if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_PACK_INT ( buf, p+xp_curs, &js, &je, &ks, &ke, &is, &ie,
+                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xp_curs += wcount*typesize ;
+#else
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+xp_curs) ;
+	      i = ipe-shw+1 ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = ipe-shw+1 ; i <= ipe ; i++ ) {
+	        *pi++ = *qi++ ;
+	      }
+	      xp_curs += shw*typesize ;
+	    }
+	  }
+#endif
+	}
+	else {
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = ipe-shw+1 ; i <= ipe ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                  *(p+xp_curs) = 
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                  xp_curs++ ;
+                }
+              }
+            }
+          }
+	}
+      } else {
+        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
+        ks = kps           ; ke = kpe ;
+        is = ipe+1         ; ie = ipe+shw ;
+        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
+          F_UNPACK_LINT ( p+xp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                                &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xp_curs += wcount*typesize ;
+        }
+	else if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_UNPACK_INT ( p+xp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                               &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xp_curs += wcount*typesize ;
+#else
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+xp_curs) ;
+	      i = ipe+1 ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = ipe+1 ; i <= ipe+shw ; i++ ) {
+	        *qi++ = *pi++ ;
+	      }
+	      xp_curs += shw*typesize ;
+	    }
+	  }
+#endif
+	}
+	else {
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = ipe+1 ; i <= ipe+shw ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                  *(p+xp_curs) ;
+                  xp_curs++ ;
+                }
+              }
+            }
+          }
+        }
+      }
+    }
+    if ( xm != MPI_PROC_NULL ) {
+      p = buffer_for_proc( xm , 0 , da_buf ) ;
+      if ( pu == 0 ) {
+        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
+        ks = kps           ; ke = kpe ;
+        is = ips           ; ie = ips+shw-1 ;
+        nbytes = buffer_size_for_proc( xm, da_buf ) ;
+        if ( xm_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ips, ips+shw-1, 1, typesize ) > nbytes ) {
+	  fprintf(stderr,"memory overwrite in rsl_lite_pack, X left , %d > %d\n",
+	      xm_curs + RANGE( jps-shw, jpe+shw, kps, kpe, ips, ips+shw-1, 1, typesize ), nbytes ) ;
+	  MPI_Abort(MPI_COMM_WORLD, 99) ;
+        }
+        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
+          F_PACK_LINT ( buf, p+xm_curs, &js, &je, &ks, &ke, &is, &ie,
+                                              &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xm_curs += wcount*typesize ;
+        }
+	else if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_PACK_INT ( buf, p+xm_curs, &js, &je, &ks, &ke, &is, &ie,
+                                             &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xm_curs += wcount*typesize ;
+#else
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+xm_curs) ;
+	      i = ips ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = ips ; i <= ips+shw-1 ; i++ ) {
+	        *pi++ = *qi++ ;
+	      }
+	      xm_curs += shw*typesize ;
+	    }
+	  }
+#endif
+	}
+	else {
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = ips ; i <= ips+shw-1 ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                  *(p+xm_curs) = 
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                  xm_curs++ ;
+                }
+              }
+            }
+          }
+        }
+      } else {
+        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
+        ks = kps           ; ke = kpe ;
+        is = ips-shw       ; ie = ips-1 ;
+        if ( typesize == sizeof(long int) && sizeof( long int ) != sizeof(int) ) {
+          F_UNPACK_LINT ( p+xm_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                                &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xm_curs += wcount*typesize ;
+        } 
+        else if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_UNPACK_INT ( p+xm_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                               &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xm_curs += wcount*typesize ;
+#else
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+xm_curs) ;
+	      i = ips-shw ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = ips-shw ; i <= ips-1 ; i++ ) {
+	        *qi++ = *pi++ ;
+	      }
+	      xm_curs += shw*typesize ;
+	    }
+	  }
+#endif
+	}
+	else {
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = ips-shw ; i <= ips-1 ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                  *(p+xm_curs) ;
+                  xm_curs++ ;
+                }
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+}
+
+static MPI_Request yp_recv, ym_recv, yp_send, ym_send ;
+static MPI_Request xp_recv, xm_recv, xp_send, xm_send ;
+
+RSL_LITE_EXCH_Y ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
+{
+  int me, np, np_x, np_y ;
+  int yp, ym, xp, xm, ierr ;
+  MPI_Status stat ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+#if 1
+  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  if ( np_y > 1 ) {
+    MPI_Cart_shift( *comm0, 0, 1, &ym, &yp ) ;
+    if ( yp != MPI_PROC_NULL ) {
+      ierr=MPI_Irecv ( buffer_for_proc( yp, yp_curs, RSL_RECVBUF ), yp_curs, MPI_CHAR, yp, me, comm, &yp_recv ) ;
+    }
+    if ( ym != MPI_PROC_NULL ) {
+      ierr=MPI_Irecv ( buffer_for_proc( ym, ym_curs, RSL_RECVBUF ), ym_curs, MPI_CHAR, ym, me, comm, &ym_recv ) ;
+    }
+    if ( yp != MPI_PROC_NULL ) {
+      ierr=MPI_Isend ( buffer_for_proc( yp, 0,       RSL_SENDBUF ), yp_curs, MPI_CHAR, yp, yp, comm, &yp_send ) ;
+    }
+    if ( ym != MPI_PROC_NULL ) {
+      ierr=MPI_Isend ( buffer_for_proc( ym, 0,       RSL_SENDBUF ), ym_curs, MPI_CHAR, ym, ym, comm, &ym_send ) ;
+    }
+    if ( yp != MPI_PROC_NULL ) MPI_Wait( &yp_recv, &stat ) ; 
+    if ( ym != MPI_PROC_NULL ) MPI_Wait( &ym_recv, &stat ) ; 
+    if ( yp != MPI_PROC_NULL ) MPI_Wait( &yp_send, &stat ) ; 
+    if ( ym != MPI_PROC_NULL ) MPI_Wait( &ym_send, &stat ) ;
+  }
+  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
+#else 
+fprintf(stderr,"RSL_LITE_EXCH_Y disabled\n") ;
+#endif
+}
+
+RSL_LITE_EXCH_X ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
+{
+  int me, np, np_x, np_y ;
+  int yp, ym, xp, xm ;
+  MPI_Status stat ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+#if 1
+  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  if ( np_x > 1 ) {
+    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
+    if ( xp != MPI_PROC_NULL ) {
+      MPI_Irecv ( buffer_for_proc( xp, xp_curs, RSL_RECVBUF ), xp_curs, MPI_CHAR, xp, me, comm, &xp_recv ) ;
+    }
+    if ( xm != MPI_PROC_NULL ) {
+      MPI_Irecv ( buffer_for_proc( xm, xm_curs, RSL_RECVBUF ), xm_curs, MPI_CHAR, xm, me, comm, &xm_recv ) ;
+    }
+    if ( xp != MPI_PROC_NULL ) {
+      MPI_Isend ( buffer_for_proc( xp, 0,       RSL_SENDBUF ), xp_curs, MPI_CHAR, xp, xp, comm, &xp_send ) ;
+    }
+    if ( xm != MPI_PROC_NULL ) {
+      MPI_Isend ( buffer_for_proc( xm, 0,       RSL_SENDBUF ), xm_curs, MPI_CHAR, xm, xm, comm, &xm_send ) ;
+    }
+    if ( xp != MPI_PROC_NULL ) MPI_Wait( &xp_recv, &stat ) ; 
+    if ( xm != MPI_PROC_NULL ) MPI_Wait( &xm_recv, &stat ) ; 
+    if ( xp != MPI_PROC_NULL ) MPI_Wait( &xp_send, &stat ) ; 
+    if ( xm != MPI_PROC_NULL ) MPI_Wait( &xm_send, &stat ) ;
+  }
+#else 
+fprintf(stderr,"RSL_LITE_EXCH_X disabled\n") ;
+#endif
+  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
+}
+
+#include <sys/time.h>
+RSL_INTERNAL_MILLICLOCK ()
+{
+    struct timeval tb ;
+    struct timezone tzp ;
+    int isec ;  /* seconds */
+    int usec ;  /* microseconds */
+    int msecs ;
+    gettimeofday( &tb, &tzp ) ;
+    isec = tb.tv_sec ;
+    usec = tb.tv_usec ;
+    msecs = 1000 * isec + usec / 1000 ;
+    return(msecs) ;
+}
+RSL_INTERNAL_MICROCLOCK ()
+{
+    struct timeval tb ;
+    struct timezone tzp ;
+    int isec ;  /* seconds */
+    int usec ;  /* microseconds */
+    int msecs ;
+    gettimeofday( &tb, &tzp ) ;
+    isec = tb.tv_sec ;
+    usec = tb.tv_usec ;
+    msecs = 1000000 * isec + usec ;
+    return(msecs) ;
+}
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/cycle.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/cycle.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/cycle.c	(revision 2744)
@@ -0,0 +1,356 @@
+#include <stdio.h>
+#include <fcntl.h>
+
+#define STANDARD_ERROR 2
+
+#define STANDARD_OUTPUT 1
+
+#include "mpi.h"
+#include "rsl_lite.h"
+
+#define  UP_EVEN(A)   ((A)+abs((A)%2))
+#define  DOWN_EVEN(A) ((A) - abs((A)%2))
+#define  UP_ODD(A)    ((A) + abs(((A)+1)%2))
+#define  DOWN_ODD(A)  ((A) - abs(((A)+1)%2))
+#define  MIN(A,B)     ((A)<(B)?(A):(B))
+#define  MAX(A,B)     ((A)>(B)?(A):(B))
+
+static int *y_curs_src = NULL ;
+static int *x_curs_src = NULL ;
+static int *y_curs_dst = NULL ;
+static int *x_curs_dst = NULL ;
+static int *x_peermask_src = NULL ;
+static int *x_peermask_dst = NULL ;
+static int *nbytes_src = NULL ; 
+static int *nbytes_dst = NULL ; 
+static MPI_Request *x_recv = NULL ,  *x_send = NULL ;
+
+RSL_LITE_INIT_CYCLE (  int * Fcomm ,
+                int * xy0 , int * inout0 ,
+                int * n3dR0, int *n2dR0, int * typesizeR0 , 
+                int * n3dI0, int *n2dI0, int * typesizeI0 , 
+                int * n3dD0, int *n2dD0, int * typesizeD0 , 
+                int * n3dL0, int *n2dL0, int * typesizeL0 , 
+                int * me0, int * np0 , int * np_x0 , int * np_y0 ,
+                int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
+                int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
+{
+  int n3dR, n2dR, typesizeR ;
+  int n3dI, n2dI, typesizeI ;
+  int n3dD, n2dD, typesizeD ;
+  int n3dL, n2dL, typesizeL ;
+  int xy, inout ;
+  int me, np, np_x, np_y, np_dim ;
+  int ids , ide , jds , jde , kds , kde ;
+  int ips , ipe , jps , jpe , kps , kpe ;
+  int ips_send , ipe_send ;
+  int npts, i, ii, j, jj, m, n, ps, pe, ops, ope ;
+  int Px, Py, P, Q, swap, coords[2] ;
+  MPI_Comm *comm, dummy_comm ;
+
+  comm = &dummy_comm ;
+  *comm = MPI_Comm_f2c( *Fcomm ) ;
+
+  xy = *xy0 ;
+  inout = *inout0 ;     /* 1 is in (uncycled to cycled) 0 is out */
+  n3dR = *n3dR0 ; n2dR = *n2dR0 ; typesizeR = *typesizeR0 ;
+  n3dI = *n3dI0 ; n2dI = *n2dI0 ; typesizeI = *typesizeI0 ;
+  n3dD = *n3dD0 ; n2dD = *n2dD0 ; typesizeD = *typesizeD0 ;
+  n3dL = *n3dL0 ; n2dL = *n2dL0 ; typesizeL = *typesizeL0 ;
+  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
+  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
+
+  if ( nbytes_src == NULL ) nbytes_src = RSL_MALLOC ( int , np ) ;
+  if ( nbytes_dst == NULL ) nbytes_dst = RSL_MALLOC ( int , np ) ;
+  if ( x_curs_src == NULL ) x_curs_src = RSL_MALLOC ( int , np ) ;
+  if ( x_curs_dst == NULL ) x_curs_dst = RSL_MALLOC ( int , np ) ;
+  if ( x_peermask_src == NULL ) x_peermask_src = RSL_MALLOC ( int , np ) ;
+  if ( x_peermask_dst == NULL ) x_peermask_dst = RSL_MALLOC ( int , np ) ;
+  if ( x_recv == NULL ) x_recv = RSL_MALLOC ( MPI_Request , np ) ;
+  if ( x_send == NULL ) x_send = RSL_MALLOC ( MPI_Request , np ) ;
+  for ( i = 0 ; i < np ; i++ ) { nbytes_src[i] = 0 ; x_curs_src[i] = 0 ; x_peermask_src[i] = 0 ; }
+  for ( i = 0 ; i < np ; i++ ) { nbytes_dst[i] = 0 ; x_curs_dst[i] = 0 ; x_peermask_dst[i] = 0 ; }
+
+  if ( xy == 1 ) {   /* xy = 1, cycle in X, otherwise Y */
+    np_dim = np_x ;
+    ps = ips ;
+    pe = ipe ;
+    ops = jps ;
+    ope = jpe ;
+    m = (ide-ids+1)/np_dim ;
+    n = (m*np_dim)/m ;
+  } else {
+    np_dim = np_y ;
+    ps = jps ;
+    pe = jpe ;
+    ops = ips ;
+    ope = ipe ;
+    m = (jde-jds+1)/np_dim ;
+    n = (m*np_dim)/m ;
+  }
+
+  for ( i = ps ; i <= MIN(pe,m*np_dim) ; i++ ) {
+    ii = (i/n) + (i%n)*m ;
+    jj = (i/m) + (i%m)*n ;
+    if ( xy == 1 ) {
+      TASK_FOR_POINT ( &ii , &jps , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+      coords[1] = Px ; coords[0] = Py ;
+      MPI_Cart_rank( *comm, coords, &P ) ;
+      TASK_FOR_POINT ( &jj , &jps , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+      coords[1] = Px ; coords[0] = Py ;
+      MPI_Cart_rank( *comm, coords, &Q ) ;
+    } else {
+      TASK_FOR_POINT ( &ips , &ii , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+      coords[1] = Px ; coords[0] = Py ;
+      MPI_Cart_rank( *comm, coords, &P ) ;
+      TASK_FOR_POINT ( &ips , &jj , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+      coords[1] = Px ; coords[0] = Py ;
+      MPI_Cart_rank( *comm, coords, &Q ) ;
+    }
+    if ( inout == 0 ) { swap = P ; P = Q ; Q = swap ; }
+
+    nbytes_src[P] += typesizeR*(ope-ops+1)*(n3dR*(kpe-kps+1)+n2dR) +
+                     typesizeI*(ope-ops+1)*(n3dI*(kpe-kps+1)+n2dI) +
+                     typesizeD*(ope-ops+1)*(n3dD*(kpe-kps+1)+n2dD) +
+                     typesizeL*(ope-ops+1)*(n3dL*(kpe-kps+1)+n2dL) ;
+
+    nbytes_dst[Q] += typesizeR*(ope-ops+1)*(n3dR*(kpe-kps+1)+n2dR) +
+                     typesizeI*(ope-ops+1)*(n3dI*(kpe-kps+1)+n2dI) +
+                     typesizeD*(ope-ops+1)*(n3dD*(kpe-kps+1)+n2dD) +
+                     typesizeL*(ope-ops+1)*(n3dL*(kpe-kps+1)+n2dL) ;
+  }
+
+  for ( P = 0 ; P < np ; P++ ) {
+       buffer_for_proc ( P , nbytes_src[P], RSL_SENDBUF ) ;
+       buffer_for_proc ( P , nbytes_dst[P], RSL_RECVBUF ) ;
+  }
+}
+
+RSL_LITE_PACK_CYCLE ( int * Fcomm, char * buf , int * inout0 , int * typesize0 , int * xy0 , int * pu0 , char * memord , int * xstag0 ,
+           int *me0, int * np0 , int * np_x0 , int * np_y0 , 
+           int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
+           int * ims0 , int * ime0 , int * jms0 , int * jme0 , int * kms0 , int * kme0 ,
+           int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
+{
+  int me, np, np_x, np_y, np_dim ;
+  int inout , typesize ;
+  int ids , ide , jds , jde , kds , kde ;
+  int ims , ime , jms , jme , kms , kme ;
+  int ips , ipe , jps , jpe , kps , kpe ;
+  int xstag ;  /* 0 not stag, 1 stag */
+  int xy ;   /* y = 0 , x = 1 */
+  int pu ;   /* pack = 0 , unpack = 1 */
+  int i, ii, j, jj, m, n  ;
+  int ps, pe, ops, ope ;
+  register int k, t ;
+#ifdef crayx1
+  register int i2,i3,i4,i_offset;
+#endif
+  char *p ;
+  int da_buf ;
+  int Px, Py, P, coords[2] ;
+  int ierr = 0 ;
+  register int *pi, *qi ;
+  float f ;
+  MPI_Comm *comm, dummy_comm ;
+
+  comm = &dummy_comm ;
+  *comm = MPI_Comm_f2c( *Fcomm ) ;
+
+  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  xstag = *xstag0 ;
+  inout = *inout0 ; typesize = *typesize0 ;
+  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
+  ims = *ims0-1 ; ime = *ime0-1 ; jms = *jms0-1 ; jme = *jme0-1 ; kms = *kms0-1 ; kme = *kme0-1 ;
+  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
+  xy = *xy0 ;
+  pu = *pu0 ;
+
+/* need to adapt for other memory orders */
+#define IMAX(A) (((A)>ids)?(A):ids)
+#define IMIN(A) (((A)<ide)?(A):ide)
+#define JMAX(A) (((A)>jds)?(A):jds)
+#define JMIN(A) (((A)<jde)?(A):jde)
+
+  da_buf = ( pu == 0 ) ? RSL_SENDBUF : RSL_RECVBUF ;
+
+  if ( xy == 1 ) {   /* xy = 1, cycle in X, otherwise Y */
+    np_dim = np_x ;
+    ps = ips ;
+    pe = ipe ;
+    m = (ide-ids+1)/np_dim ;
+    n = (m*np_dim)/m ;
+  } else {
+    np_dim = np_y ;
+    ps = jps ;
+    pe = jpe ;
+    m = (jde-jds+1)/np_dim ;
+    n = (m*np_dim)/m ;
+  }
+
+  if ( np_x > 1 && xy == 1 ) {
+
+    for ( i = ips ; i <= MIN(ipe,m*np_dim-1) ; i++ ) {
+      if ( pu == 0 ) {
+        ii = (inout)?(i/n)+(i%n)*m:(i/m)+(i%m)*n  ;
+        TASK_FOR_POINT ( &ii , &jps , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+        coords[1] = Px ; coords[0] = Py ;
+        MPI_Cart_rank( *comm, coords, &P ) ;
+        p = buffer_for_proc( P , 0 , da_buf ) ;
+	if ( typesize == sizeof(int) ) {
+          for ( j = jps ; j <= jpe ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+x_curs_src[P]) ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+	      *pi++ = *qi++ ;
+	      x_curs_src[P] += typesize ;
+	    }
+	  }
+	}
+	else {
+          for ( j = jps ; j <= jpe ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( t = 0 ; t < typesize ; t++ ) {
+                *(p+x_curs_src[P]) = 
+                               *(buf + t + typesize*(
+                                      (i-ims) + (ime-ims+1)*(
+                                      (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                x_curs_src[P]++ ;
+              }
+            }
+          }
+	}
+      } else {
+        ii = (inout)?(i/m)+(i%m)*n:(i/n)+(i%n)*m  ;
+        TASK_FOR_POINT ( &ii , &jps , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+        coords[1] = Px ; coords[0] = Py ;
+        MPI_Cart_rank( *comm, coords, &P ) ;
+        p = buffer_for_proc( P , 0 , da_buf ) ;
+	if ( typesize == sizeof(int) ) {
+          for ( j = jps ; j <= jpe ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+x_curs_dst[P]) ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+	      *qi++ = *pi++ ;
+	      x_curs_dst[P] += typesize ;
+	    }
+	  }
+	}
+	else {
+          for ( j = jps ; j <= jpe ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( t = 0 ; t < typesize ; t++ ) {
+                               *(buf + t + typesize*(
+                                      (i-ims) + (ime-ims+1)*(
+                                      (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                *(p+x_curs_dst[P]) ;
+                x_curs_dst[P]++ ;
+              }
+            }
+          }
+        }
+      }
+    }
+  } else if ( np_y > 1 && xy == 0 ) {
+    for ( j = jps ; j <= MIN(jpe,m*np_dim-1) ; j++ ) {
+      if ( pu == 0 ) {
+        jj = (inout)?(j/n) + (j%n)*m:(j/m) + (j%m)*n ;
+        TASK_FOR_POINT ( &ips , &jj , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+        coords[1] = Px ; coords[0] = Py ;
+        MPI_Cart_rank( *comm, coords, &P ) ;
+        p = buffer_for_proc( P , 0 , da_buf ) ;
+	if ( typesize == sizeof(int) ) {
+          for ( i = ips ; i <= ipe ; i++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+x_curs_src[P]) ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+	      *pi++ = *qi++ ;
+	      x_curs_src[P] += typesize ;
+	    }
+	  }
+	}
+	else {
+          for ( i = ips ; i <= ipe ; i++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( t = 0 ; t < typesize ; t++ ) {
+                *(p+x_curs_src[P]) = 
+                               *(buf + t + typesize*(
+                                      (i-ims) + (ime-ims+1)*(
+                                      (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                x_curs_src[P]++ ;
+              }
+            }
+          }
+	}
+      } else {
+        jj = (inout)?(j/m) + (j%m)*n:(j/n) + (j%n)*m ;
+        TASK_FOR_POINT ( &ips , &jj , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+        coords[1] = Px ; coords[0] = Py ;
+        MPI_Cart_rank( *comm, coords, &P ) ;
+        p = buffer_for_proc( P , 0 , da_buf ) ;
+	if ( typesize == sizeof(int) ) {
+          for ( i = ips ; i <= ipe ; i++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+x_curs_dst[P]) ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+	      *qi++ = *pi++ ;
+	      x_curs_dst[P] += typesize ;
+	    }
+	  }
+	}
+	else {
+          for ( i = ips ; i <= ipe ; i++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( t = 0 ; t < typesize ; t++ ) {
+                               *(buf + t + typesize*(
+                                      (i-ims) + (ime-ims+1)*(
+                                      (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                *(p+x_curs_dst[P]) ;
+                x_curs_dst[P]++ ;
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+}
+
+RSL_LITE_CYCLE ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
+{
+  int me, np, np_x, np_y ;
+  int yp, ym, xp, xm, nb ;
+  MPI_Status stat ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+  int i, P ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+#if 1
+
+  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+
+/* fprintf(stderr,"RSL_LITE_CYCLE\n") ; */
+
+  for ( P = 0 ; P < np ; P++ ) {
+      nb = buffer_size_for_proc( P, RSL_RECVBUF ) ;
+/* fprintf(stderr,"posting irecv from %d, nb = %d\n",P,nb) ; */
+      MPI_Irecv ( buffer_for_proc( P, 0, RSL_RECVBUF ), nb, MPI_CHAR, P, me, comm, &(x_recv[P]) ) ;
+/* fprintf(stderr,"sending to         %d, nb = %d\n",P,x_curs_src[P]) ; */
+      MPI_Isend ( buffer_for_proc( P, 0, RSL_SENDBUF ), x_curs_src[P], MPI_CHAR, P, P, comm, &(x_send[P]) ) ;
+  }
+  for ( P = 0 ; P < np ; P++ ) {
+      MPI_Wait( &x_recv[P], &stat ) ; 
+      MPI_Wait( &x_send[P], &stat ) ; 
+  }
+#else 
+fprintf(stderr,"RSL_LITE_CYCLE disabled\n") ;
+#endif
+  for ( i = 0 ; i < np ; i++ ) {  x_curs_src[i] = 0 ; x_curs_dst[i] ; }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/f_pack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/f_pack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/f_pack.F	(revision 2744)
@@ -0,0 +1,85 @@
+     
+      SUBROUTINE f_pack_int ( inbuf, outbuf, js, je, ks, ke, is, ie,      &
+     &                        jms, jme, kms, kme, ims, ime, curs ) 
+        IMPLICIT NONE
+        INTEGER jms, jme, kms, kme, ims, ime
+        INTEGER inbuf(ims:ime,kms:kme,jms:jme), outbuf(*)
+        INTEGER js, je, ks, ke, is, ie, curs
+        ! Local
+        INTEGER i,j,k,p
+        p = 1
+        DO j = js, je
+          DO k = ks, ke
+            DO i = is, ie
+              outbuf(p) = inbuf(i,k,j)
+              p = p + 1
+            ENDDO
+          ENDDO
+        ENDDO
+        curs = p - 1
+        RETURN
+      END SUBROUTINE f_pack_int
+     
+      SUBROUTINE f_pack_lint ( inbuf, outbuf, js, je, ks, ke, is, ie,    &
+     &                         jms, jme, kms, kme, ims, ime, curs ) 
+        IMPLICIT NONE
+        INTEGER jms, jme, kms, kme, ims, ime
+        INTEGER*8 inbuf(ims:ime,kms:kme,jms:jme), outbuf(*)
+        INTEGER js, je, ks, ke, is, ie, curs
+        ! Local
+        INTEGER i,j,k,p
+        p = 1
+        DO j = js, je
+          DO k = ks, ke
+            DO i = is, ie
+              outbuf(p) = inbuf(i,k,j)
+              p = p + 1
+            ENDDO
+          ENDDO
+        ENDDO
+        curs = p - 1
+        RETURN
+      END SUBROUTINE f_pack_lint
+     
+      SUBROUTINE f_unpack_int ( inbuf, outbuf, js, je, ks, ke, is, ie,    &
+     &                          jms, jme, kms, kme, ims, ime, curs ) 
+        IMPLICIT NONE
+        INTEGER jms, jme, kms, kme, ims, ime
+        INTEGER outbuf(ims:ime,kms:kme,jms:jme), inbuf(*)
+        INTEGER js, je, ks, ke, is, ie, curs
+        ! Local
+        INTEGER i,j,k,p
+        p = 1
+        DO j = js, je
+          DO k = ks, ke
+            DO i = is, ie
+              outbuf(i,k,j) = inbuf(p)
+              p = p + 1
+            ENDDO
+          ENDDO
+        ENDDO
+        curs = p - 1
+        RETURN
+      END SUBROUTINE f_unpack_int
+     
+      SUBROUTINE f_unpack_lint ( inbuf, outbuf, js, je, ks, ke, is, ie,    &
+     &                           jms, jme, kms, kme, ims, ime, curs ) 
+        IMPLICIT NONE
+        INTEGER jms, jme, kms, kme, ims, ime
+        INTEGER*8 outbuf(ims:ime,kms:kme,jms:jme), inbuf(*)
+        INTEGER js, je, ks, ke, is, ie, curs
+        ! Local
+        INTEGER i,j,k,p
+        p = 1
+        DO j = js, je
+          DO k = ks, ke
+            DO i = is, ie
+              outbuf(i,k,j) = inbuf(p)
+              p = p + 1
+            ENDDO
+          ENDDO
+        ENDDO
+        curs = p - 1
+        RETURN
+      END SUBROUTINE f_unpack_lint
+     
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/gen_comms.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/gen_comms.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/gen_comms.c	(revision 2744)
@@ -0,0 +1,1473 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+/* For detecting variables that are members of a derived type */
+#define NULLCHARPTR   (char *) 0
+static int parent_type;
+
+int
+gen_halos ( char * dirname , char * incname , node_t * halos )
+{
+  node_t * p, * q ;
+  node_t * dimd ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN] ;
+  char commuse[NAMELEN] ;
+#define MAX_VDIMS 100
+  char vdims[MAX_VDIMS][2][80] ;
+  char s[NAMELEN], e[NAMELEN] ;
+  int vdimcurs ;
+  int maxstenwidth, stenwidth ;
+  FILE * fp ;
+  char * t1, * t2 ;
+  char * pos1 , * pos2 ;
+  char indices[NAMELEN], post[NAMELEN] ;
+  int zdex ;
+  int n2dR, n3dR ;
+  int n2dI, n3dI ;
+  int n2dD, n3dD ;
+  int n4d ;
+  int i, foundvdim ;
+#define MAX_4DARRAYS 1000
+  char name_4d[MAX_4DARRAYS][NAMELEN] ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  for ( p = halos ; p != NULL ; p = p->next )
+  {
+    if ( incname == NULL ) {
+      strcpy( commname, p->name ) ;
+      make_upper_case(commname) ;
+    } 
+    else {
+      strcpy( commname, incname ) ;
+    }
+    if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s.inc",dirname,commname) ; }
+    else                       { sprintf(fname,"%s.inc",commname) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) 
+    {
+      fprintf(stderr,"WARNING: gen_halos in registry cannot open %s for writing\n",fname ) ;
+      continue ; 
+    }
+    /* get maximum stencil width */
+    maxstenwidth = 0 ;
+    strcpy( tmp, p->comm_define ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for halo %s\n", commname ) ; exit(1) ; }
+      stenwidth = atoi (t2) ;
+      if ( stenwidth == 0 )
+       { fprintf(stderr,"* unparseable description for halo %s\n", commname ) ; exit(1) ; }
+      if      ( stenwidth == 4   || stenwidth == 8  ) stenwidth = 1 ;
+      else if ( stenwidth == 12  || stenwidth == 24 ) stenwidth = 2 ;
+      else if ( stenwidth == 48 ) stenwidth = 3 ;
+      else if ( stenwidth == 80 ) stenwidth = 4 ;
+      else if ( stenwidth == 120 ) stenwidth = 5 ;
+      else if ( stenwidth == 168 ) stenwidth = 6 ;
+      else
+       { fprintf(stderr,"%s: unknown stenci description or just too big: %d\n", commname, stenwidth ) ; exit(1) ; }
+      if ( stenwidth > maxstenwidth ) maxstenwidth = stenwidth ;
+      t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+    }
+    print_warning(fp,fname) ;
+
+fprintf(fp,"CALL wrf_debug(2,'calling %s')\n",fname) ;
+
+/* count up the number of 2d and 3d real arrays and their types */
+    n2dR = 0 ; n3dR = 0 ;
+    n2dI = 0 ; n3dI = 0 ;
+    n2dD = 0 ; n3dD = 0 ;
+    n4d = 0 ;
+    vdimcurs = 0 ;
+    strcpy( tmp, p->comm_define ) ;
+    strcpy( commuse, p->use ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    for ( i = 0 ; i < MAX_4DARRAYS ; i++ ) strcpy(name_4d[i],"") ;  /* truncate all of these */
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for halo %s\n", commname ) ; continue ; }
+      t2 = strtok_rentr(NULL,",", &pos2) ;
+      while ( t2 != NULL )
+      {
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )
+          { fprintf(stderr,"WARNING 1 : %s in halo spec %s (%s) is not defined in registry.\n",t2,commname, commuse) ; }
+        else
+        {
+          if      (  strcmp( q->type->name, "real") && strcmp( q->type->name, "integer") && strcmp( q->type->name, "doubleprecision") )
+            { fprintf(stderr,"WARNING: only type 'real', 'doubleprecision', or 'integer' can be part of halo exchange. %s in %s is %s\n",t2,commname,q->type->name) ; }
+          else if ( q->boundary_array )
+            { fprintf(stderr,"WARNING: boundary array %s cannot be member of halo spec %s.\n",t2,commname) ; }
+          else
+          {
+
+            /* 20061004 -- collect all the vertical dimensions so we can use a MAX
+	       on them when calling RSL_LITE_INIT_EXCH */
+
+            if ( q->ndims == 3 || q->node_kind & FOURD ) {
+              if ((dimd = get_dimnode_for_coord( q , COORD_Z )) != NULL ) {
+                zdex = get_index_for_coord( q , COORD_Z ) ;
+                if      ( dimd->len_defined_how == DOMAIN_STANDARD ) { 
+                  strcpy(s,"kps") ;
+                  strcpy(e,"kpe") ;
+                }
+                else if ( dimd->len_defined_how == NAMELIST ) {
+                  if ( !strcmp(dimd->assoc_nl_var_s,"1") ) {
+                    strcpy(s,"1") ;
+                    sprintf(e,"config_flags%%%s",dimd->assoc_nl_var_e) ;
+                  } else {
+                    sprintf(s,"config_flags%%%s",dimd->assoc_nl_var_s) ;
+                    sprintf(e,"config_flags%%%s",dimd->assoc_nl_var_e) ;
+                  }
+                }
+                else if ( dimd->len_defined_how == CONSTANT ) {
+                  sprintf(s,"%d",dimd->coord_start) ;
+                  sprintf(e,"%d",dimd->coord_end) ; 
+                }
+                for ( i = 0, foundvdim = 0 ; i < vdimcurs ; i++ ) {
+                  if ( !strcmp( vdims[i][1], e ) ) {
+                    foundvdim = 1 ; break ;
+                  }
+                }
+                if ( ! foundvdim ) {
+                  if (vdimcurs < 100 ) {
+                    strcpy( vdims[vdimcurs][0], s ) ;
+                    strcpy( vdims[vdimcurs][1], e ) ;
+                    vdimcurs++ ;
+                  } else {
+                    fprintf(stderr,"REGISTRY ERROR: too many different vertical dimensions (> %d).\n", MAX_VDIMS ) ;
+                    fprintf(stderr,"That seems like a lot, but if you are sure, increase MAX_VDIMS\n" ) ;
+                    fprintf(stderr,"in external/RSL_LITE/gen_comms.c and recompile\n") ;
+                    exit(5) ;
+                  }
+                }
+              }
+            }
+
+            if ( q->node_kind & FOURD ) {
+              if ( n4d < MAX_4DARRAYS ) {
+                strcpy( name_4d[n4d], q->name ) ;
+              } else { 
+                fprintf(stderr,"REGISTRY ERROR: too many 4d arrays (> %d).\n", MAX_4DARRAYS ) ;
+                fprintf(stderr,"That seems like a lot, but if you are sure, increase MAX_4DARRAYS\n" ) ;
+                fprintf(stderr,"in external/RSL_LITE/gen_comms.c and recompile\n") ;
+                exit(5) ;
+              }
+              n4d++ ;
+            }
+            else
+            {
+              if        ( ! strcmp( q->type->name, "real") ) {
+                if         ( q->ndims == 3 )      { n3dR++ ; }
+	        else    if ( q->ndims == 2 )      { n2dR++ ; }
+	      } else if ( ! strcmp( q->type->name, "integer") ) {
+                if         ( q->ndims == 3 )      { n3dI++ ; }
+	        else    if ( q->ndims == 2 )      { n2dI++ ; }
+	      } else if ( ! strcmp( q->type->name, "doubleprecision") ) {
+                if         ( q->ndims == 3 )      { n3dD++ ; }
+	        else    if ( q->ndims == 2 )      { n2dD++ ; }
+	      }
+	    }
+	  }
+	}
+        t2 = strtok_rentr( NULL , "," , &pos2 ) ;
+      }
+      t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+    }
+
+/* generate the stencil init statement for Y transfer */
+#if 0
+fprintf(fp,"CALL wrf_debug(3,'calling RSL_LITE_INIT_EXCH %d for Y %s')\n",maxstenwidth,fname) ;
+#endif
+    fprintf(fp,"CALL RSL_LITE_INIT_EXCH ( local_communicator, %d, &\n",maxstenwidth) ;
+    if ( n4d > 0 ) {
+      fprintf(fp,  "     %d  &\n", n3dR ) ;
+      for ( i = 0 ; i < n4d ; i++ ) {
+	fprintf(fp,"   + num_%s   &\n", name_4d[i] ) ;
+      }
+      fprintf(fp,"     , %d, RWORDSIZE, &\n", n2dR ) ;
+    } else {
+      fprintf(fp,"     %d, %d, RWORDSIZE, &\n", n3dR, n2dR ) ;
+    }
+    fprintf(fp,"     %d, %d, IWORDSIZE, &\n", n3dI, n2dI ) ;
+    fprintf(fp,"     %d, %d, DWORDSIZE, &\n", n3dD, n2dD ) ;
+    fprintf(fp,"      0,  0, LWORDSIZE, &\n" ) ;
+    fprintf(fp,"      mytask, ntasks, ntasks_x, ntasks_y,   &\n" ) ;
+    fprintf(fp,"      ips, ipe, jps, jpe, kps, MAX(1,1&\n") ;
+    for ( i = 0 ; i < vdimcurs ; i++ ) {
+      fprintf(fp,",%s &\n",vdims[i][1] ) ;
+    }
+    fprintf(fp,"))\n") ;
+
+/* generate packs prior to stencil exchange in Y */
+    gen_packs( fp, p, maxstenwidth, 0, 0, "RSL_LITE_PACK", "local_communicator" ) ;
+/* generate stencil exchange in Y */
+    fprintf(fp,"   CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y )\n") ;
+/* generate unpacks after stencil exchange in Y */
+    gen_packs( fp, p, maxstenwidth, 0, 1 , "RSL_LITE_PACK", "local_communicator" ) ;
+
+/* generate the stencil init statement for X transfer */
+    fprintf(fp,"CALL RSL_LITE_INIT_EXCH ( local_communicator, %d , &\n",maxstenwidth) ;
+    if ( n4d > 0 ) {
+      fprintf(fp,  "     %d  &\n", n3dR ) ;
+      for ( i = 0 ; i < n4d ; i++ ) {
+        fprintf(fp,"   + num_%s   &\n", name_4d[i] ) ;
+      }
+      fprintf(fp,"     , %d, RWORDSIZE, &\n", n2dR ) ;
+    } else {
+      fprintf(fp,"     %d, %d, RWORDSIZE, &\n", n3dR, n2dR ) ;
+    }
+    fprintf(fp,"     %d, %d, IWORDSIZE, &\n", n3dI, n2dI ) ;
+    fprintf(fp,"     %d, %d, DWORDSIZE, &\n", n3dD, n2dD ) ;
+    fprintf(fp,"      0,  0, LWORDSIZE, &\n" ) ;
+    fprintf(fp,"      mytask, ntasks, ntasks_x, ntasks_y,   &\n" ) ;
+    fprintf(fp,"      ips, ipe, jps, jpe, kps, MAX(1,1&\n") ;
+    for ( i = 0 ; i < vdimcurs ; i++ ) {
+      fprintf(fp,",%s &\n",vdims[i][1] ) ;
+    }
+    fprintf(fp,"))\n") ;
+/* generate packs prior to stencil exchange in X */
+    gen_packs( fp, p, maxstenwidth, 1, 0, "RSL_LITE_PACK", "local_communicator" ) ;
+/* generate stencil exchange in X */
+    fprintf(fp,"   CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y )\n") ;
+/* generate unpacks after stencil exchange in X */
+    gen_packs( fp, p, maxstenwidth, 1, 1, "RSL_LITE_PACK", "local_communicator" ) ;
+
+    close_the_file(fp) ;
+  }
+  return(0) ;
+}
+
+gen_packs ( FILE *fp , node_t *p, int shw, int xy /* 0=y,1=x */ , int pu /* 0=pack,1=unpack */, char * packname, char * commname )   
+{
+  node_t * q ;
+  node_t * dimd ;
+  char fname[NAMELEN] ;
+  char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN] ;
+  char commuse[NAMELEN] ;
+  int maxstenwidth, stenwidth ;
+  char * t1, * t2 , *wordsize ;
+  char varref[NAMELEN] ;
+  char * pos1 , * pos2 ;
+  char indices[NAMELEN], post[NAMELEN], memord[NAMELEN] ;
+  int zdex ;
+
+    strcpy( tmp, p->comm_define ) ;
+    strcpy( commuse, p->use ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for halo %s\n", p->name ) ; continue ; }
+      t2 = strtok_rentr(NULL,",", &pos2) ;
+      while ( t2 != NULL )
+      {
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )
+          { fprintf(stderr,"WARNING 1 : %s in halo spec %s (%s) is not defined in registry.\n",t2,p->name, commuse) ; }
+        else
+        {
+
+          strcpy( varref, t2 ) ;
+          if ( q->node_kind & FIELD  && ! (q->node_kind & I1) ) {
+             if ( !strncmp( q->use,  "dyn_", 4 )) {
+                  char * core ;
+                  core = q->use+4 ;
+                  sprintf(varref,"grid%%%s_%s",core,t2) ;
+             } else {
+                  sprintf(varref,"grid%%%s",t2) ;
+             }
+          }
+
+          if      (  strcmp( q->type->name, "real") && strcmp( q->type->name, "integer") && strcmp( q->type->name, "doubleprecision") ) { ; }
+          else if ( q->boundary_array ) { ; }
+          else
+          { 
+            if      ( ! strcmp( q->type->name, "real") )            { wordsize = "RWORDSIZE" ; }
+            else if ( ! strcmp( q->type->name, "integer") )         { wordsize = "IWORDSIZE" ; }
+            else if ( ! strcmp( q->type->name, "doubleprecision") ) { wordsize = "DWORDSIZE" ; }
+            if ( q->node_kind & FOURD )
+            {
+              node_t *member ;
+              zdex = get_index_for_coord( q , COORD_Z ) ;
+              if ( zdex >=1 && zdex <= 3 )
+              {
+                set_mem_order( q->members, memord , NAMELEN) ;
+fprintf(fp,"DO itrace = PARAM_FIRST_SCALAR, num_%s\n",q->name ) ;
+fprintf(fp," CALL %s ( %s,%s ( grid%%sm31,grid%%sm32,grid%%sm33,itrace), %d, %s, %d, %d, '%s', %d, &\n",
+                       packname, commname, varref , shw, wordsize, xy, pu, memord, q->stag_x?1:0 ) ;
+fprintf(fp,"mytask, ntasks, ntasks_x, ntasks_y,       &\n") ;
+fprintf(fp,"ids, ide, jds, jde, kds, kde,             &\n") ;
+fprintf(fp,"ims, ime, jms, jme, kms, kme,             &\n") ;
+fprintf(fp,"ips, ipe, jps, jpe, kps, kpe              )\n") ;
+fprintf(fp,"ENDDO\n") ;
+              }
+              else
+              {
+                fprintf(stderr,"WARNING: %d some dimension info missing for 4d array %s\n",zdex,t2) ;
+              }
+            }
+            else
+            {
+              set_mem_order( q, memord , NAMELEN) ;
+#if 0
+fprintf(fp,"CALL wrf_debug(3,'call %s %s shw=%d ws=%s xy=%d pu=%d m=%s')\n",packname,t2,shw,wordsize,xy,pu,memord) ;
+fprintf(fp,"write(wrf_err_message,*)' d ',ids, ide, jds, jde, kds, kde\n" ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' m ',ims, ime, jms, jme, kms, kme\n" ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' p ',ips, ipe, jps, jpe, kps, kpe\n" ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+#endif
+              if       ( q->ndims == 3 ) {
+
+                dimd = get_dimnode_for_coord( q , COORD_Z ) ;
+                zdex = get_index_for_coord( q , COORD_Z ) ;
+                if ( dimd != NULL )
+                {
+                  char s[256], e[256] ;
+
+                  if      ( dimd->len_defined_how == DOMAIN_STANDARD ) {
+#if 0
+fprintf(fp,"write(wrf_err_message,*)' d ',ids, ide, jds, jde, kds, kde\n" ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' m ',ims, ime, jms, jme, kms, kme\n" ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' p ',ips, ipe, jps, jpe, kps, kpe\n" ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+#endif
+                    fprintf(fp,"CALL %s ( %s, %s, %d, %s, %d, %d, '%s', %d, &\n", packname, commname, varref, shw, wordsize, xy, pu, memord, q->stag_x?1:0 ) ;
+                    fprintf(fp,"mytask, ntasks, ntasks_x, ntasks_y,       &\n") ;
+                    fprintf(fp,"ids, ide, jds, jde, kds, kde,             &\n") ;
+                    fprintf(fp,"ims, ime, jms, jme, kms, kme,             &\n") ;
+                    fprintf(fp,"ips, ipe, jps, jpe, kps, kpe              )\n") ;
+                  }
+                  else if ( dimd->len_defined_how == NAMELIST )
+                  {
+                    if ( !strcmp(dimd->assoc_nl_var_s,"1") ) {
+                      strcpy(s,"1") ;
+                      sprintf(e,"config_flags%%%s",dimd->assoc_nl_var_e) ;
+                    } else {
+                      sprintf(s,"config_flags%%%s",dimd->assoc_nl_var_s) ;
+                      sprintf(e,"config_flags%%%s",dimd->assoc_nl_var_e) ;
+                    }
+#if 0
+fprintf(fp,"write(wrf_err_message,*)' d ',ids, ide, jds, jde, %s, %s\n",s,e ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' m ',ims, ime, jms, jme, %s, %s\n",s,e ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' p ',ips, ipe, jps, jpe, %s, %s\n",s,e ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+#endif
+                    fprintf(fp,"CALL %s ( %s, %s, %d, %s, %d, %d, '%s', %d, &\n", packname, commname, varref, shw, wordsize, xy, pu, memord, q->stag_x?1:0 ) ;
+                    fprintf(fp,"mytask, ntasks, ntasks_x, ntasks_y,       &\n") ;
+                    fprintf(fp,"ids, ide, jds, jde, %s, %s,             &\n",s,e) ;
+                    fprintf(fp,"ims, ime, jms, jme, %s, %s,             &\n",s,e) ;
+                    fprintf(fp,"ips, ipe, jps, jpe, %s, %s              )\n",s,e) ;
+                  }
+                  else if ( dimd->len_defined_how == CONSTANT )
+                  {
+#if 0
+fprintf(fp,"write(wrf_err_message,*)' d ',ids, ide, jds, jde, %d, %d\n",dimd->coord_start,dimd->coord_end ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' m ',ims, ime, jms, jme, %d, %d\n",dimd->coord_start,dimd->coord_end ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' p ',ips, ipe, jps, jpe, %d, %d\n",dimd->coord_start,dimd->coord_end ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+#endif
+                    fprintf(fp,"CALL %s ( %s, %s, %d, %s, %d, %d, '%s', %d, &\n", packname, commname, varref, shw, wordsize, xy, pu, memord, q->stag_x?1:0 ) ;
+                    fprintf(fp,"mytask, ntasks, ntasks_x, ntasks_y,       &\n") ;
+                    fprintf(fp,"ids, ide, jds, jde, %d, %d,             &\n",dimd->coord_start,dimd->coord_end) ;
+                    fprintf(fp,"ims, ime, jms, jme, %d, %d,             &\n",dimd->coord_start,dimd->coord_end) ;
+                    fprintf(fp,"ips, ipe, jps, jpe, %d, %d              )\n",dimd->coord_start,dimd->coord_end) ;
+                  }
+                }
+              } else if ( q->ndims == 2 ) {
+#if 0
+fprintf(fp,"write(wrf_err_message,*)' d ',ids, ide, jds, jde, 1, 1\n" ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' m ',ims, ime, jms, jme, 1, 1\n" ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+fprintf(fp,"write(wrf_err_message,*)' p ',ips, ipe, jps, jpe, 1, 1\n" ) ;
+fprintf(fp,"CALL wrf_debug(3,wrf_err_message)\n") ;
+#endif
+                fprintf(fp,"CALL %s ( %s, %s, %d, %s, %d, %d, '%s', %d, &\n", packname, commname, varref, shw, wordsize, xy, pu, memord, q->stag_x?1:0 ) ;
+                fprintf(fp,"mytask, ntasks, ntasks_x, ntasks_y,       &\n") ;
+                fprintf(fp,"ids, ide, jds, jde, 1  , 1  ,             &\n") ;
+                fprintf(fp,"ims, ime, jms, jme, 1  , 1  ,             &\n") ;
+                fprintf(fp,"ips, ipe, jps, jpe, 1  , 1                )\n") ;
+              } else {
+                fprintf(stderr,"Registry WARNING: %s is neither 2 nor 3 dimensional\n",t2) ;
+              }
+#if 0
+fprintf(fp,"CALL wrf_debug(3,'back from %s')\n", packname) ;
+#endif
+            }
+          }
+          
+        }
+        t2 = strtok_rentr( NULL , "," , &pos2 ) ;
+      }
+      t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+    }
+}
+
+int
+gen_periods ( char * dirname , node_t * periods )
+{
+  node_t * p, * q ;
+  node_t * dimd ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN] ;
+  char commuse[NAMELEN] ;
+  int maxperwidth, perwidth ;
+  FILE * fp ;
+  char * t1, * t2 ;
+  char varref[NAMELEN] ;
+  char * pos1 , * pos2 ;
+  char indices[NAMELEN], post[NAMELEN] ;
+  int zdex ;
+  int n2dR, n3dR ;
+  int n2dI, n3dI ;
+  int n2dD, n3dD ;
+  int n4d ;
+  int i ;
+#define MAX_4DARRAYS 1000
+  char name_4d[MAX_4DARRAYS][NAMELEN] ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  for ( p = periods ; p != NULL ; p = p->next )
+  {
+    strcpy( commname, p->name ) ;
+    make_upper_case(commname) ;
+    if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s.inc",dirname,commname) ; }
+    else                       { sprintf(fname,"%s.inc",commname) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) 
+    {
+      fprintf(stderr,"WARNING: gen_periods in registry cannot open %s for writing\n",fname ) ;
+      continue ; 
+    }
+    /* get maximum period width */
+    maxperwidth = 0 ;
+    strcpy( tmp, p->comm_define ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for period %s\n", commname ) ; exit(1) ; }
+      perwidth = atoi (t2) ;
+      if ( perwidth > maxperwidth ) maxperwidth = perwidth ;
+      t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+    }
+    print_warning(fp,fname) ;
+
+fprintf(fp,"CALL wrf_debug(2,'calling %s')\n",fname) ;
+
+/* count up the number of 2d and 3d real arrays and their types */
+    n2dR = 0 ; n3dR = 0 ;
+    n2dI = 0 ; n3dI = 0 ;
+    n2dD = 0 ; n3dD = 0 ;
+    n4d = 0 ;
+    strcpy( tmp, p->comm_define ) ;
+    strcpy( commuse, p->use ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    for ( i = 0 ; i < MAX_4DARRAYS ; i++ ) strcpy(name_4d[i],"") ;  /* truncate all of these */
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for period %s\n", commname ) ; continue ; }
+      t2 = strtok_rentr(NULL,",", &pos2) ;
+      while ( t2 != NULL )
+      {
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )
+          { fprintf(stderr,"WARNING 1 : %s in peridod spec %s (%s) is not defined in registry.\n",t2,commname, commuse) ; }
+        else
+        {
+
+          if      (  strcmp( q->type->name, "real") && strcmp( q->type->name, "integer") && strcmp( q->type->name, "doubleprecision") )
+            { fprintf(stderr,"WARNING: only type 'real', 'doubleprecision', or 'integer' can be part of period exchange. %s in %s is %s\n",t2,commname,q->type->name) ; }
+          else if ( q->boundary_array )
+            { fprintf(stderr,"WARNING: boundary array %s cannot be member of period spec %s.\n",t2,commname) ; }
+          else
+          {
+            if ( q->node_kind & FOURD ) {
+              if ( n4d < MAX_4DARRAYS ) {
+                strcpy( name_4d[n4d], q->name ) ;
+              } else { 
+                fprintf(stderr,"REGISTRY ERROR: too many 4d arrays (> %d).\n", MAX_4DARRAYS ) ;
+                fprintf(stderr,"That seems like a lot, but if you are sure, increase MAX_4DARRAYS\n" ) ;
+                fprintf(stderr,"in external/RSL_LITE/gen_comms.c and recompile\n") ;
+                exit(5) ;
+              }
+              n4d++ ;
+            }
+            else
+            {
+              if        ( ! strcmp( q->type->name, "real") ) {
+                if         ( q->ndims == 3 )      { n3dR++ ; }
+	        else    if ( q->ndims == 2 )      { n2dR++ ; }
+	      } else if ( ! strcmp( q->type->name, "integer") ) {
+                if         ( q->ndims == 3 )      { n3dI++ ; }
+	        else    if ( q->ndims == 2 )      { n2dI++ ; }
+	      } else if ( ! strcmp( q->type->name, "doubleprecision") ) {
+                if         ( q->ndims == 3 )      { n3dD++ ; }
+	        else    if ( q->ndims == 2 )      { n2dD++ ; }
+	      }
+	    }
+	  }
+	}
+        t2 = strtok_rentr( NULL , "," , &pos2 ) ;
+      }
+      t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+    }
+
+    fprintf(fp,"IF ( config_flags%%periodic_x ) THEN\n") ;
+
+/* generate the stencil init statement for X transfer */
+    fprintf(fp,"CALL RSL_LITE_INIT_PERIOD ( local_communicator_periodic, %d , &\n",maxperwidth) ;
+
+    if ( n4d > 0 ) {
+      fprintf(fp,  "     %d  &\n", n3dR ) ;
+      for ( i = 0 ; i < n4d ; i++ ) {
+        fprintf(fp,"   + num_%s   &\n", name_4d[i] ) ;
+      }
+      fprintf(fp,"     , %d, RWORDSIZE, &\n", n2dR ) ;
+    } else {
+      fprintf(fp,"     %d, %d, RWORDSIZE, &\n", n3dR, n2dR ) ;
+    }
+
+    fprintf(fp,"     %d, %d, IWORDSIZE, &\n", n3dI, n2dI ) ;
+    fprintf(fp,"     %d, %d, DWORDSIZE, &\n", n3dD, n2dD ) ;
+    fprintf(fp,"      0,  0, LWORDSIZE, &\n" ) ;
+    fprintf(fp,"      mytask, ntasks, ntasks_x, ntasks_y,   &\n" ) ;
+    fprintf(fp,"      ips, ipe, jps, jpe, kps, kpe    )\n") ;
+/* generate packs prior to stencil exchange in X */
+    gen_packs( fp, p, maxperwidth, 1, 0, "RSL_LITE_PACK_PERIOD_X", "local_communicator_periodic" ) ;
+/* generate stencil exchange in X */
+    fprintf(fp,"   CALL RSL_LITE_EXCH_PERIOD_X ( local_communicator_periodic , mytask, ntasks, ntasks_x, ntasks_y )\n") ;
+/* generate unpacks after stencil exchange in X */
+    gen_packs( fp, p, maxperwidth, 1, 1, "RSL_LITE_PACK_PERIOD_X", "local_communicator_periodic" ) ;
+
+    fprintf(fp,"END IF\n") ;
+
+    close_the_file(fp) ;
+  }
+  return(0) ;
+}
+
+int
+gen_swaps ( char * dirname , node_t * swaps )
+{
+  node_t * p, * q ;
+  node_t * dimd ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN] ;
+  char commuse[NAMELEN] ;
+  FILE * fp ;
+  char * t1, * t2 ;
+  char * pos1 , * pos2 ;
+  char indices[NAMELEN], post[NAMELEN] ;
+  int zdex ;
+  int n2dR, n3dR ;
+  int n2dI, n3dI ;
+  int n2dD, n3dD ;
+  int n4d ;
+  int i, xy ;
+#define MAX_4DARRAYS 1000
+  char name_4d[MAX_4DARRAYS][NAMELEN] ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  for ( p = swaps ; p != NULL ; p = p->next )
+  {
+    strcpy( commname, p->name ) ;
+    make_upper_case(commname) ;
+    if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s.inc",dirname,commname) ; }
+    else                       { sprintf(fname,"%s.inc",commname) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) 
+    {
+      fprintf(stderr,"WARNING: gen_swaps in registry cannot open %s for writing\n",fname ) ;
+      continue ; 
+    }
+    print_warning(fp,fname) ;
+
+  for ( xy = 0 ; xy < 2 ; xy++ ) {
+
+fprintf(fp,"CALL wrf_debug(2,'calling %s')\n",fname) ;
+
+/* count up the number of 2d and 3d real arrays and their types */
+    n2dR = 0 ; n3dR = 0 ;
+    n2dI = 0 ; n3dI = 0 ;
+    n2dD = 0 ; n3dD = 0 ;
+    n4d = 0 ;
+    strcpy( tmp, p->comm_define ) ;
+    strcpy( commuse, p->use ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    for ( i = 0 ; i < MAX_4DARRAYS ; i++ ) strcpy(name_4d[i],"") ;  /* truncate all of these */
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for period %s\n", commname ) ; continue ; }
+      t2 = strtok_rentr(NULL,",", &pos2) ;
+      while ( t2 != NULL )
+      {
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )
+          { fprintf(stderr,"WARNING 1 : %s in swap spec %s (%s) is not defined in registry.\n",t2,commname, commuse) ; }
+        else
+        {
+          if      (  strcmp( q->type->name, "real") && strcmp( q->type->name, "integer") && strcmp( q->type->name, "doubleprecision") )
+            { fprintf(stderr,"WARNING: only type 'real', 'doubleprecision', or 'integer' can be part of swaps exchange. %s in %s is %s\n",t2,commname,q->type->name) ; }
+          else if ( q->boundary_array )
+            { fprintf(stderr,"WARNING: boundary array %s cannot be member of swaps spec %s.\n",t2,commname) ; }
+          else
+          {
+            if ( q->node_kind & FOURD ) {
+              if ( n4d < MAX_4DARRAYS ) {
+                strcpy( name_4d[n4d], q->name ) ;
+              } else { 
+                fprintf(stderr,"REGISTRY ERROR: too many 4d arrays (> %d).\n", MAX_4DARRAYS ) ;
+                fprintf(stderr,"That seems like a lot, but if you are sure, increase MAX_4DARRAYS\n" ) ;
+                fprintf(stderr,"in external/RSL_LITE/gen_comms.c and recompile\n") ;
+                exit(5) ;
+              }
+              n4d++ ;
+            }
+            else
+            {
+              if        ( ! strcmp( q->type->name, "real") ) {
+                if         ( q->ndims == 3 )      { n3dR++ ; }
+	        else    if ( q->ndims == 2 )      { n2dR++ ; }
+	      } else if ( ! strcmp( q->type->name, "integer") ) {
+                if         ( q->ndims == 3 )      { n3dI++ ; }
+	        else    if ( q->ndims == 2 )      { n2dI++ ; }
+	      } else if ( ! strcmp( q->type->name, "doubleprecision") ) {
+                if         ( q->ndims == 3 )      { n3dD++ ; }
+	        else    if ( q->ndims == 2 )      { n2dD++ ; }
+	      }
+	    }
+	  }
+	}
+        t2 = strtok_rentr( NULL , "," , &pos2 ) ;
+      }
+      t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+    }
+
+    fprintf(fp,"IF ( config_flags%%swap_%c ) THEN\n",(xy==1)?'x':'y') ;
+
+/* generate the init statement for X swap */
+    fprintf(fp,"CALL RSL_LITE_INIT_SWAP ( local_communicator, %d , &\n", xy ) ;
+    if ( n4d > 0 ) {
+      fprintf(fp,  "     %d  &\n", n3dR ) ;
+      for ( i = 0 ; i < n4d ; i++ ) {
+        fprintf(fp,"   + num_%s   &\n", name_4d[i] ) ;
+      }
+      fprintf(fp,"     , %d, RWORDSIZE, &\n", n2dR ) ;
+    } else {
+      fprintf(fp,"     %d, %d, RWORDSIZE, &\n", n3dR, n2dR ) ;
+    }
+    fprintf(fp,"     %d, %d, IWORDSIZE, &\n", n3dI, n2dI ) ;
+    fprintf(fp,"     %d, %d, DWORDSIZE, &\n", n3dD, n2dD ) ;
+    fprintf(fp,"      0,  0, LWORDSIZE, &\n" ) ;
+    fprintf(fp,"      mytask, ntasks, ntasks_x, ntasks_y,   &\n" ) ;
+    fprintf(fp,"      ids, ide, jds, jde, kds, kde,   &\n") ;
+    fprintf(fp,"      ips, ipe, jps, jpe, kps, kpe    )\n") ;
+/* generate packs prior to stencil exchange  */
+    gen_packs( fp, p, 1, xy, 0, "RSL_LITE_PACK_SWAP", "local_communicator" ) ;
+/* generate stencil exchange in X */
+    fprintf(fp,"   CALL RSL_LITE_SWAP ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y )\n") ;
+/* generate unpacks after stencil exchange  */
+    gen_packs( fp, p, 1, xy, 1, "RSL_LITE_PACK_SWAP", "local_communicator" ) ;
+
+    fprintf(fp,"END IF\n") ;
+
+  }
+    close_the_file(fp) ;
+  }
+  return(0) ;
+}
+
+int
+gen_cycles ( char * dirname , node_t * cycles )
+{
+  node_t * p, * q ;
+  node_t * dimd ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN] ;
+  char commuse[NAMELEN] ;
+  FILE * fp ;
+  char * t1, * t2 ;
+  char * pos1 , * pos2 ;
+  char indices[NAMELEN], post[NAMELEN] ;
+  int zdex ;
+  int n2dR, n3dR ;
+  int n2dI, n3dI ;
+  int n2dD, n3dD ;
+  int n4d ;
+  int i, xy, inout ;
+#define MAX_4DARRAYS 1000
+  char name_4d[MAX_4DARRAYS][NAMELEN] ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  for ( p = cycles ; p != NULL ; p = p->next )
+  {
+    strcpy( commname, p->name ) ;
+    make_upper_case(commname) ;
+    if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s.inc",dirname,commname) ; }
+    else                       { sprintf(fname,"%s.inc",commname) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) 
+    {
+      fprintf(stderr,"WARNING: gen_cycles in registry cannot open %s for writing\n",fname ) ;
+      continue ; 
+    }
+
+    /* get inout */
+    inout = 0 ;
+    strcpy( tmp, p->comm_define ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    strcpy( tmp2 , t1 ) ;
+    if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for cycle %s\n", commname ) ; exit(1) ; }
+    inout = atoi (t2) ;
+
+    print_warning(fp,fname) ;
+
+  for ( xy = 0 ; xy < 2 ; xy++ ) {
+
+fprintf(fp,"CALL wrf_debug(2,'calling %s')\n",fname) ;
+
+/* count up the number of 2d and 3d real arrays and their types */
+    n2dR = 0 ; n3dR = 0 ;
+    n2dI = 0 ; n3dI = 0 ;
+    n2dD = 0 ; n3dD = 0 ;
+    n4d = 0 ;
+    strcpy( tmp, p->comm_define ) ;
+    strcpy( commuse, p->use ) ;
+    t1 = strtok_rentr( tmp , ";" , &pos1 ) ;
+    for ( i = 0 ; i < MAX_4DARRAYS ; i++ ) strcpy(name_4d[i],"") ;  /* truncate all of these */
+    while ( t1 != NULL )
+    {
+      strcpy( tmp2 , t1 ) ;
+      if (( t2 = strtok_rentr( tmp2 , ":" , &pos2 )) == NULL )
+       { fprintf(stderr,"unparseable description for period %s\n", commname ) ; continue ; }
+      t2 = strtok_rentr(NULL,",", &pos2) ;
+      while ( t2 != NULL )
+      {
+        if ((q = get_entry_r( t2, commuse, Domain.fields )) == NULL )
+          { fprintf(stderr,"WARNING 1 : %s in swap spec %s (%s) is not defined in registry.\n",t2,commname, commuse) ; }
+        else
+        {
+          if      (  strcmp( q->type->name, "real") && strcmp( q->type->name, "integer") && strcmp( q->type->name, "doubleprecision") )
+            { fprintf(stderr,"WARNING: only type 'real', 'doubleprecision', or 'integer' can be part of cycles exchange. %s in %s is %s\n",t2,commname,q->type->name) ; }
+          else if ( q->boundary_array )
+            { fprintf(stderr,"WARNING: boundary array %s cannot be member of cycles spec %s.\n",t2,commname) ; }
+          else
+          {
+            if ( q->node_kind & FOURD ) {
+              if ( n4d < MAX_4DARRAYS ) {
+                strcpy( name_4d[n4d], q->name ) ;
+              } else { 
+                fprintf(stderr,"REGISTRY ERROR: too many 4d arrays (> %d).\n", MAX_4DARRAYS ) ;
+                fprintf(stderr,"That seems like a lot, but if you are sure, increase MAX_4DARRAYS\n" ) ;
+                fprintf(stderr,"in external/RSL_LITE/gen_comms.c and recompile\n") ;
+                exit(5) ;
+              }
+              n4d++ ;
+            }
+            else
+            {
+              if        ( ! strcmp( q->type->name, "real") ) {
+                if         ( q->ndims == 3 )      { n3dR++ ; }
+	        else    if ( q->ndims == 2 )      { n2dR++ ; }
+	      } else if ( ! strcmp( q->type->name, "integer") ) {
+                if         ( q->ndims == 3 )      { n3dI++ ; }
+	        else    if ( q->ndims == 2 )      { n2dI++ ; }
+	      } else if ( ! strcmp( q->type->name, "doubleprecision") ) {
+                if         ( q->ndims == 3 )      { n3dD++ ; }
+	        else    if ( q->ndims == 2 )      { n2dD++ ; }
+	      }
+	    }
+	  }
+	}
+        t2 = strtok_rentr( NULL , "," , &pos2 ) ;
+      }
+      t1 = strtok_rentr( NULL , ";" , &pos1 ) ;
+    }
+
+    fprintf(fp,"IF ( config_flags%%cycle_%c ) THEN\n",(xy==1)?'x':'y') ;
+
+/* generate the init statement for X swap */
+    fprintf(fp,"CALL RSL_LITE_INIT_CYCLE ( local_communicator, %d , %d, &\n", xy, inout ) ;
+    if ( n4d > 0 ) {
+      fprintf(fp,  "     %d  &\n", n3dR ) ;
+      for ( i = 0 ; i < n4d ; i++ ) {
+        fprintf(fp,"   + num_%s   &\n", name_4d[i] ) ;
+      }
+      fprintf(fp,"     , %d, RWORDSIZE, &\n", n2dR ) ;
+    } else {
+      fprintf(fp,"     %d, %d, RWORDSIZE, &\n", n3dR, n2dR ) ;
+    }
+    fprintf(fp,"     %d, %d, IWORDSIZE, &\n", n3dI, n2dI ) ;
+    fprintf(fp,"     %d, %d, DWORDSIZE, &\n", n3dD, n2dD ) ;
+    fprintf(fp,"      0,  0, LWORDSIZE, &\n" ) ;
+    fprintf(fp,"      mytask, ntasks, ntasks_x, ntasks_y,   &\n" ) ;
+    fprintf(fp,"      ids, ide, jds, jde, kds, kde,   &\n") ;
+    fprintf(fp,"      ips, ipe, jps, jpe, kps, kpe    )\n") ;
+/* generate packs prior to stencil exchange  */
+    gen_packs( fp, p, inout, xy, 0, "RSL_LITE_PACK_CYCLE", "local_communicator" ) ;
+/* generate stencil exchange in X */
+    fprintf(fp,"   CALL RSL_LITE_CYCLE ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y )\n") ;
+/* generate unpacks after stencil exchange  */
+    gen_packs( fp, p, inout, xy, 1, "RSL_LITE_PACK_CYCLE", "local_communicator" ) ;
+
+    fprintf(fp,"END IF\n") ;
+
+  }
+    close_the_file(fp) ;
+  }
+  return(0) ;
+}
+
+int
+gen_xposes ( char * dirname )
+{
+  node_t * p, * q ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN] ;
+  char commuse[NAMELEN] ;
+  FILE * fp ;
+  char * t1, * t2 ;
+  char * pos1 , * pos2 ;
+  char *xposedir[] = { "z2x" , "x2z" , "x2y" , "y2x" , "z2y" , "y2z" , 0L } ;
+  char ** x ;
+  char indices[NAMELEN], post[NAMELEN] ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  for ( p = Xposes ; p != NULL ; p = p->next )
+  {
+    for ( x = xposedir ; *x ; x++ )
+    {
+      strcpy( commname, p->name ) ;
+      make_upper_case(commname) ;
+      if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s_%s.inc",dirname,commname, *x) ; }
+      else                       { sprintf(fname,"%s_%s.inc",commname,*x) ; }
+      if ((fp = fopen( fname , "w" )) == NULL ) 
+      {
+        fprintf(stderr,"WARNING: gen_halos in registry cannot open %s for writing\n",fname ) ;
+        continue ; 
+      }
+
+      print_warning(fp,fname) ;
+      close_the_file(fp) ;
+    }
+skiperific:
+    ;
+  }
+  return(0) ;
+}
+
+int
+gen_comm_descrips ( char * dirname )
+{
+  node_t * p ;
+  char * fn = "dm_comm_cpp_flags" ;
+  char commname[NAMELEN] ;
+  char fname[NAMELEN] ;
+  FILE * fp ;
+  int ncomm ;
+
+  if ( dirname == NULL ) return(1) ;
+
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  else                       { sprintf(fname,"%s",fn) ; }
+
+  if ((fp = fopen( fname , "w" )) == NULL )
+  {
+    fprintf(stderr,"WARNING: gen_comm_descrips in registry cannot open %s for writing\n",fname ) ;
+  }
+
+  return(0) ;
+}
+
+/*
+
+
+
+*/
+
+/* for each core, generate the halo updates to allow shifting all state data */
+int
+gen_shift (  char * dirname )
+{
+  int i, ncore ;
+  FILE * fp ;
+  node_t *p, *q, *dimd ;
+  char * corename ;
+  char **direction ;
+  char *directions[] = { "x", "y", 0L } ;
+  char fname[NAMELEN], vname[NAMELEN], vname2[NAMELEN], core[NAMELEN] ;
+  char indices[NAMELEN], post[NAMELEN], tmp3[NAMELEN] ;
+  int zdex ;
+  node_t Shift ;
+int said_it = 0 ;
+
+  for ( direction = directions ; *direction != NULL ; direction++ )
+  {
+  for ( ncore = 0 ; ncore < get_num_cores() ; ncore++ )
+  {
+    corename = get_corename_i(ncore) ;
+    if ( dirname == NULL || corename == NULL ) return(1) ;
+    sprintf(fname,"%s_shift_halo_%s",corename,*direction) ;
+
+    Shift.next = NULL ;
+    sprintf( Shift.use, "dyn_%s", corename ) ;
+    strcpy( Shift.comm_define, "48:" ) ;
+    for ( p = Domain.fields ; p != NULL ; p = p->next ) {
+      if (( p->node_kind & (FIELD | FOURD) ) && p->ndims >= 2 && ! p->boundary_array &&
+          ((!strncmp(p->use,"dyn_",4) && !strcmp(corename,p->use+4)) || strncmp(p->use,"dyn_",4)))
+      {
+
+/* special cases in WRF */
+if ( !strcmp( p->name , "xf_ens" ) || !strcmp( p->name , "pr_ens" ) ||
+     !strcmp( p->name , "abstot" ) || !strcmp( p->name , "absnxt" ) ||
+     !strcmp( p->name , "emstot" ) || !strcmp( p->name , "obs_savwt" ) ) {
+  if ( sw_move && ! said_it ) { fprintf(stderr,"Info only - not an error: Moving nests not implemented for Grell Ens. Cumulus\n") ;
+                                fprintf(stderr,"Info only - not an error: Moving nests not implemented for CAM radiation\n") ;
+                                fprintf(stderr,"Info only - not an error: Moving nests not implemented for Observation Nudging\n") ;
+  said_it = 1 ; }
+  continue ;
+}
+
+/* make sure that the only things we are shifting are arrays that have a decomposed X and a Y dimension */
+        if ( get_dimnode_for_coord( p , COORD_X ) && get_dimnode_for_coord( p , COORD_Y ) ) {
+          if ( p->type->type_type == SIMPLE )
+          {
+            for ( i = 1 ; i <= p->ntl ; i++ )
+            {
+              if ( p->ntl > 1 ) sprintf(vname,"%s_%d",p->name,i ) ;
+              else              sprintf(vname,"%s",p->name ) ;
+
+              strcat( Shift.comm_define, vname ) ;
+              strcat( Shift.comm_define, "," ) ;
+            }
+          }
+        }
+      }
+    }
+    if ( strlen(Shift.comm_define) > 0 )Shift.comm_define[strlen(Shift.comm_define)-1] = '\0' ;
+
+    gen_halos( dirname , fname, &Shift ) ;
+
+    if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s_shift_halo_%s.inc",dirname,corename,*direction) ; }
+    else                       { sprintf(fname,"%s_shift_halo_%s.inc",corename,*direction) ; }
+    if ((fp = fopen( fname , "a" )) == NULL ) return(1) ;
+
+/* now generate the shifts themselves */
+    for ( p = Domain.fields ; p != NULL ; p = p->next )
+    {
+
+/* special cases in WRF */
+if ( !strcmp( p->name , "xf_ens" ) || !strcmp( p->name , "pr_ens" ) ||
+     !strcmp( p->name , "abstot" ) || !strcmp( p->name , "absnxt" ) ||
+     !strcmp( p->name , "emstot" ) || !strcmp( p->name , "obs_savwt" ) ) {
+  continue ;
+}
+
+      if (( p->node_kind & (FIELD | FOURD) ) && p->ndims >= 2 && ! p->boundary_array &&
+	  ((!strncmp(p->use,"dyn_",4) && !strcmp(corename,p->use+4)) || strncmp(p->use,"dyn_",4)))
+      {
+
+        if ( p->node_kind & FOURD ) {
+          sprintf(core,"") ;
+        } else {
+          if (!strncmp( p->use, "dyn_", 4))   sprintf(core,"%s_",corename) ;
+          else                                sprintf(core,"") ;
+        }
+
+	if ( p->type->type_type == SIMPLE )
+	{
+	  for ( i = 1 ; i <= p->ntl ; i++ )
+	  {
+            
+            if ( p->ntl > 1 ) sprintf(vname,"%s_%d",p->name,i ) ;
+            else              sprintf(vname,"%s",p->name ) ;
+            if ( p->ntl > 1 ) sprintf(vname2,"%s%s_%d",core,p->name,i ) ;
+            else              sprintf(vname2,"%s%s",core,p->name ) ;
+
+	    if ( p->node_kind & FOURD )
+            {
+              node_t *member ;
+              zdex = get_index_for_coord( p , COORD_Z ) ;
+              if ( zdex >=1 && zdex <= 3 )
+              {
+                    if ( !strcmp( *direction, "x" ) )
+                    {
+fprintf(fp, "  DO itrace = PARAM_FIRST_SCALAR, num_%s\n", p->name ) ;
+fprintf(fp, "   %s ( ips:min(ide%s,ipe),:,jms:jme,itrace) = %s (ips+px:min(ide%s,ipe)+px,:,jms:jme,itrace)\n",
+                       vname, p->members->stag_x?"":"-1", vname, p->members->stag_x?"":"-1" ) ;
+fprintf(fp, "  ENDDO\n" ) ;
+                    }
+                    else
+                    {
+fprintf(fp, "  DO itrace = PARAM_FIRST_SCALAR, num_%s\n", p->name ) ;
+fprintf(fp, "   %s ( ims:ime,:,jps:min(jde%s,jpe),itrace) = %s (ims:ime,:,jps+py:min(jde%s,jpe)+py,itrace)\n",
+                       vname, p->members->stag_y?"":"-1", vname, p->members->stag_y?"":"-1" ) ;
+fprintf(fp, "  ENDDO\n" ) ;
+                    }
+
+              }
+              else
+              {
+                fprintf(stderr,"WARNING: %d some dimension info missing for 4d array %s\n",zdex,t2) ;
+              }
+            }
+            else
+	    {
+	      char * vdim ;
+	      vdim = "" ;
+	      if ( p->ndims == 3 ) vdim = ":," ;
+              if ( !strcmp( *direction, "x" ) )
+              {
+                fprintf(fp,"grid%%%s (ips:min(ide%s,ipe),%sjms:jme) = grid%%%s (ips+px:min(ide%s,ipe)+px,%sjms:jme)\n", vname2,  p->stag_x?"":"-1", vdim, vname2, p->stag_x?"":"-1", vdim ) ;
+              }
+              else
+	      {
+                fprintf(fp,"grid%%%s (ims:ime,%sjps:min(jde%s,jpe)) = grid%%%s (ims:ime,%sjps+py:min(jde%s,jpe)+py)\n", vname2, vdim,  p->stag_y?"":"-1", vname2, vdim, p->stag_y?"":"-1" ) ;
+              }
+            }
+	  }
+	}
+      }
+    }
+
+    close_the_file(fp) ;
+  }
+  }
+}
+
+int
+gen_datacalls ( char * dirname )
+{
+  int i ;
+  FILE * fp ;
+  char * corename ;
+  char * fn = "data_calls.inc" ;
+  char fname[NAMELEN] ;
+
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+  {
+    corename = get_corename_i(i) ;
+    if ( dirname == NULL || corename == NULL ) return(1) ;
+    if ( strlen(dirname) > 0 )
+     { sprintf(fname,"%s/%s_%s",dirname,corename,fn) ; }
+    else
+     { sprintf(fname,"%s_%s",corename,fn) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+    print_warning(fp,fname) ;
+    close_the_file(fp) ;
+  }
+  return(0) ;
+}
+
+/*****************/
+/*****************/
+
+gen_nest_packing ( char * dirname )
+{
+  gen_nest_pack( dirname ) ;
+  gen_nest_unpack( dirname ) ;
+}
+
+#define PACKIT 1
+#define UNPACKIT 2
+
+int
+gen_nest_pack ( char * dirname )
+{
+  int i ;
+  FILE * fp ;
+  char * corename ;
+  char * fnlst[] = { "nest_interpdown_pack.inc" , "nest_forcedown_pack.inc" , "nest_feedbackup_pack.inc", 0L } ;
+  int down_path[] = { INTERP_DOWN , FORCE_DOWN , INTERP_UP } ;
+  int ipath ;
+  char ** fnp ; char * fn ;
+  char * shw_str ;
+  char fname[NAMELEN] ;
+  node_t *node, *p, *dim ;
+  int xdex, ydex, zdex ;
+  char ddim[3][2][NAMELEN] ;
+  char mdim[3][2][NAMELEN] ;
+  char pdim[3][2][NAMELEN] ;
+  char vname[NAMELEN] ; char tag[NAMELEN] ; char core[NAMELEN] ;
+  int d2, d3, sw ;
+  char *info_name ;
+
+  for ( fnp = fnlst , ipath = 0 ; *fnp ; fnp++ , ipath++ )
+  {
+    fn = *fnp ;
+    for ( i = 0 ; i < get_num_cores() ; i++ )
+    {
+      corename = get_corename_i(i) ;
+      if ( dirname == NULL || corename == NULL ) return(1) ;
+      if ( strlen(dirname) > 0 ) {
+       if ( strlen( corename ) > 0 )
+         { sprintf(fname,"%s/%s_%s",dirname,corename,fn) ; }
+       else
+         { sprintf(fname,"%s/%s",dirname,fn) ; }
+      } else { 
+       if ( strlen( corename ) > 0 ) 
+          { sprintf(fname,"%s_%s",corename,fn) ; }
+       else
+          { sprintf(fname,"%s",fn) ; }
+      }
+      if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+      print_warning(fp,fname) ;
+
+      d2 = 0 ;
+      d3 = 0 ;
+      node = Domain.fields ;
+
+      count_fields ( node , &d2 , &d3 , corename , down_path[ipath] ) ;
+
+      if ( d2 + d3 > 0 ) {
+        if ( down_path[ipath] == INTERP_UP )
+        {
+          info_name = "rsl_lite_to_parent_info" ;
+          sw = 0 ;
+        }
+        else
+        {
+          info_name = "rsl_lite_to_child_info" ;
+          sw = 1 ;
+        }
+
+        fprintf(fp,"msize = %d * nlev + %d\n", d3, d2 ) ;
+
+        fprintf(fp,"CALL %s( local_communicator, msize*RWORDSIZE                               &\n",info_name ) ;
+        fprintf(fp,"                        ,cips,cipe,cjps,cjpe                               &\n") ;
+if (sw) fprintf(fp,"                        ,iids,iide,ijds,ijde                               &\n") ;
+        fprintf(fp,"                        ,nids,nide,njds,njde                               &\n") ;
+if (sw) fprintf(fp,"                        ,pgr , sw                                          &\n") ;
+        fprintf(fp,"                        ,ntasks_x,ntasks_y                                 &\n") ; 
+        fprintf(fp,"                        ,icoord,jcoord                                     &\n") ;
+        fprintf(fp,"                        ,idim_cd,jdim_cd                                   &\n") ;
+        fprintf(fp,"                        ,pig,pjg,retval )\n") ;
+
+        fprintf(fp,"DO while ( retval .eq. 1 )\n") ;
+  
+        gen_nest_packunpack ( fp , Domain.fields, corename, PACKIT, down_path[ipath] ) ;
+
+        fprintf(fp,"CALL %s( local_communicator, msize*RWORDSIZE                               &\n",info_name ) ;
+        fprintf(fp,"                        ,cips,cipe,cjps,cjpe                               &\n") ;
+if (sw) fprintf(fp,"                        ,iids,iide,ijds,ijde                               &\n") ;
+        fprintf(fp,"                        ,nids,nide,njds,njde                               &\n") ;
+if (sw) fprintf(fp,"                        ,pgr , sw                                          &\n") ;
+        fprintf(fp,"                        ,ntasks_x,ntasks_y                                 &\n") ; 
+        fprintf(fp,"                        ,icoord,jcoord                                     &\n") ;
+        fprintf(fp,"                        ,idim_cd,jdim_cd                                   &\n") ;
+        fprintf(fp,"                        ,pig,pjg,retval )\n") ;
+
+        fprintf(fp,"ENDDO\n") ;
+      }
+      close_the_file(fp) ;
+    }
+  }
+  return(0) ;
+}
+
+int
+gen_nest_unpack ( char * dirname )
+{
+  int i ;
+  FILE * fp ;
+  char * corename ;
+  char * fnlst[] = { "nest_interpdown_unpack.inc" , "nest_forcedown_unpack.inc" , "nest_feedbackup_unpack.inc" , 0L } ;
+  int down_path[] = { INTERP_DOWN , FORCE_DOWN , INTERP_UP } ;
+  int ipath ;
+  char ** fnp ; char * fn ;
+  char fname[NAMELEN] ;
+  node_t *node, *p, *dim ;
+  int xdex, ydex, zdex ;
+  char ddim[3][2][NAMELEN] ;
+  char mdim[3][2][NAMELEN] ;
+  char pdim[3][2][NAMELEN] ;
+  char *info_name ;
+  char vname[NAMELEN] ; char tag[NAMELEN] ; char core[NAMELEN] ;
+  int d2, d3 ;
+
+  for ( fnp = fnlst , ipath = 0 ; *fnp ; fnp++ , ipath++ )
+  {
+    fn = *fnp ;
+    for ( i = 0 ; i < get_num_cores() ; i++ )
+    {
+      d2 = 0 ;
+      d3 = 0 ;
+      node = Domain.fields ;
+
+      corename = get_corename_i(i) ;
+      if ( dirname == NULL || corename == NULL ) return(1) ;
+      if ( strlen(dirname) > 0 )
+       { sprintf(fname,"%s/%s_%s",dirname,corename,fn) ; }
+      else
+       { sprintf(fname,"%s_%s",corename,fn) ; }
+      if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+      print_warning(fp,fname) ;
+
+      count_fields ( node , &d2 , &d3 , corename , down_path[ipath] ) ;
+
+      if ( d2 + d3 > 0 ) {
+        if ( down_path[ipath] == INTERP_UP )
+        {
+          info_name = "rsl_lite_from_child_info" ;
+        }
+        else
+        {
+          info_name = "rsl_lite_from_parent_info" ;
+        }
+
+        fprintf(fp,"CALL %s(pig,pjg,retval)\n", info_name ) ;
+        fprintf(fp,"DO while ( retval .eq. 1 )\n") ;
+        gen_nest_packunpack ( fp , Domain.fields, corename, UNPACKIT, down_path[ipath] ) ;
+        fprintf(fp,"CALL %s(pig,pjg,retval)\n", info_name ) ;
+        fprintf(fp,"ENDDO\n") ;
+      }
+      close_the_file(fp) ;
+    }
+  }
+  return(0) ;
+}
+
+int
+gen_nest_packunpack ( FILE *fp , node_t * node , char * corename, int dir, int down_path )
+{
+  int i ;
+  node_t *p, *p1, *dim ;
+  int d2, d3, xdex, ydex, zdex ;
+  int io_mask ;
+  char * grid ; 
+  char ddim[3][2][NAMELEN] ;
+  char mdim[3][2][NAMELEN] ;
+  char pdim[3][2][NAMELEN] ;
+  char vname[NAMELEN], vname2[NAMELEN], dexes[NAMELEN] ; char tag[NAMELEN] ; char core[NAMELEN] ;
+  char c, d ;
+
+  for ( p1 = node ;  p1 != NULL ; p1 = p1->next )
+  {
+
+    if ( p1->node_kind & FOURD )
+    {
+      if ( p1->members->next )
+        io_mask = p1->members->next->io_mask ;
+      else
+        continue ;
+    }
+    else
+    {
+      io_mask = p1->io_mask ;
+    }
+    p = p1 ;
+
+    if ( io_mask & down_path )
+    {
+      if ((!strncmp( p->use, "dyn_", 4) && !strcmp(p->use+4,corename)) || strncmp( p->use, "dyn_", 4))
+      {
+        if ( p->node_kind & FOURD ) {
+          if (!strncmp( p->members->next->use, "dyn_", 4))   sprintf(core,"%s",corename) ;
+          else                                               sprintf(core,"") ;
+          if ( p->members->next->ntl > 1 ) sprintf(tag,"_2") ;
+          else                             sprintf(tag,"") ;
+          set_dim_strs ( p->members , ddim , mdim , pdim , "c", 0 ) ;
+          zdex = get_index_for_coord( p->members , COORD_Z ) ;
+          xdex = get_index_for_coord( p->members , COORD_X ) ;
+          ydex = get_index_for_coord( p->members , COORD_Y ) ;
+        } else {
+          if (!strncmp( p->use, "dyn_", 4))   sprintf(core,"%s",corename) ;
+          else                                sprintf(core,"") ;
+          if ( p->ntl > 1 ) sprintf(tag,"_2") ;
+          else              sprintf(tag,"") ;
+          set_dim_strs ( p , ddim , mdim , pdim , "c", 0 ) ;
+          zdex = get_index_for_coord( p , COORD_Z ) ;
+          xdex = get_index_for_coord( p , COORD_X ) ;
+          ydex = get_index_for_coord( p , COORD_Y ) ;
+        }
+
+        if ( down_path == INTERP_UP )
+        {
+          c = ( dir == PACKIT )?'n':'p' ;
+          d = ( dir == PACKIT )?'2':'1' ;
+        } else {
+          c = ( dir == UNPACKIT )?'n':'p' ;
+          d = ( dir == UNPACKIT )?'2':'1' ;
+        }
+
+        if ( zdex >= 0 ) {
+          if      ( xdex == 0 && zdex == 1 && ydex == 2 )  sprintf(dexes,"pig,k,pjg") ;
+          else if ( zdex == 0 && xdex == 1 && ydex == 2 )  sprintf(dexes,"k,pig,pjg") ;
+          else if ( xdex == 0 && ydex == 1 && zdex == 2 )  sprintf(dexes,"pig,pjg,k") ;
+        } else {
+          if ( xdex == 0 && ydex == 1 )  sprintf(dexes,"pig,pjg") ;
+          if ( ydex == 0 && xdex == 1 )  sprintf(dexes,"pjg,pig") ;
+        }
+
+        /* construct variable name */
+        if ( p->node_kind & FOURD )
+        {
+          sprintf(vname,"%s%s(%s,itrace)",p->name,tag,dexes) ;
+          if ( strlen(core) > 0 )
+            sprintf(vname2,"%s_%s%s(%s,itrace)",core,p->use,tag,dexes) ;
+          else
+            sprintf(vname2,"%s%s(%s,itrace)",p->name,tag,dexes) ;
+        }
+        else
+        {
+          sprintf(vname,"%s%s(%s)",p->name,tag,dexes) ;
+          if ( strlen(core) > 0 )
+            sprintf(vname2,"%s_%s%s(%s)",core,p->name,tag,dexes) ;
+          else
+            sprintf(vname2,"%s%s(%s)",p->name,tag,dexes) ;
+        }
+
+        grid = "grid%" ;
+        if ( p->node_kind & FOURD )
+	{
+           grid = "" ;
+fprintf(fp,"DO itrace =  PARAM_FIRST_SCALAR, num_%s\n", p->name) ;
+	}
+
+        if ( dir == UNPACKIT ) 
+        {
+          if ( down_path == INTERP_UP )
+	  {
+            if ( zdex >= 0 ) {
+fprintf(fp,"CALL rsl_lite_from_child_msg(((%s)-(%s)+1)*RWORDSIZE,xv) ;\n",ddim[zdex][1], ddim[zdex][0] ) ;
+            } else {
+fprintf(fp,"CALL rsl_lite_from_child_msg(RWORDSIZE,xv)\n" ) ;
+            }
+fprintf(fp,"IF ( %s_cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, %s, %s ) ) THEN\n",
+                 corename, p->stag_x?".TRUE.":".FALSE." ,p->stag_y?".TRUE.":".FALSE." ) ;
+            if ( zdex >= 0 ) {
+fprintf(fp,"DO k = %s,%s\nNEST_INFLUENCE(%s%s,xv(k))\nENDDO\n", ddim[zdex][0], ddim[zdex][1], grid, vname2 ) ;
+            } else {
+              fprintf(fp,"%s%s = xv(1) ;\n", grid,vname2) ;
+            }
+fprintf(fp,"ENDIF\n") ;
+          }
+          else
+          {
+            if ( zdex >= 0 ) {
+fprintf(fp,"CALL rsl_lite_from_parent_msg(((%s)-(%s)+1)*RWORDSIZE,xv)\nDO k = %s,%s\n%s%s = xv(k)\nENDDO\n",
+                                    ddim[zdex][1], ddim[zdex][0], ddim[zdex][0], ddim[zdex][1], grid, vname2) ;
+            } else {
+fprintf(fp,"CALL rsl_lite_from_parent_msg(RWORDSIZE,xv)\n%s%s = xv(1)\n", grid, vname2) ;
+            }
+          }
+        }
+        else
+        {
+          if ( down_path == INTERP_UP )
+	  {
+            if ( zdex >= 0 ) {
+fprintf(fp,"DO k = %s,%s\nxv(k)= intermediate_grid%%%s\nENDDO\nCALL rsl_lite_to_parent_msg(((%s)-(%s)+1)*RWORDSIZE,xv)\n",
+                           ddim[zdex][0], ddim[zdex][1], vname2, ddim[zdex][1], ddim[zdex][0] ) ;
+            } else {
+fprintf(fp,"xv(1)= intermediate_grid%%%s\nCALL rsl_lite_to_parent_msg(RWORDSIZE,xv)\n", vname2) ;
+            }
+          }
+          else
+          {
+            if ( zdex >= 0 ) {
+fprintf(fp,"DO k = %s,%s\nxv(k)= %s%s\nENDDO\nCALL rsl_lite_to_child_msg(((%s)-(%s)+1)*RWORDSIZE,xv)\n",
+                           ddim[zdex][0], ddim[zdex][1], grid, vname2, ddim[zdex][1], ddim[zdex][0] ) ;
+            } else {
+fprintf(fp,"xv(1)=%s%s\nCALL rsl_lite_to_child_msg(RWORDSIZE,xv)\n", grid, vname2) ;
+            }
+          }
+        }
+        if ( p->node_kind & FOURD )
+	{
+fprintf(fp,"ENDDO\n") ;
+	}
+      }
+    }
+  }
+
+  return(0) ;
+}
+
+/*****************/
+
+int
+count_fields ( node_t * node , int * d2 , int * d3 , char * corename , int down_path )
+{
+  node_t * p ;
+  int zdex ;
+/* count up the total number of levels from all fields */
+  for ( p = node ;  p != NULL ; p = p->next )
+  {
+    if ( p->node_kind == FOURD ) 
+    {
+      count_fields( p->members , d2 , d3 , corename , down_path ) ;  /* RECURSE */
+    }
+    else
+    {
+      if ( p->io_mask & down_path )
+      {
+        if ((!strncmp( p->use, "dyn_", 4) && !strcmp(p->use+4,corename)) || strncmp( p->use, "dyn_", 4))
+        {
+          if ( p->node_kind == FOURD )
+            zdex = get_index_for_coord( p->members , COORD_Z ) ;
+          else
+            zdex = get_index_for_coord( p , COORD_Z ) ;
+  
+          if ( zdex < 0 ) {
+            (*d2)++ ;   /* if no zdex then only 2 d */
+          } else {
+            (*d3)++ ;   /* if has a zdex then 3 d */
+          }
+        }
+      }
+    }
+  }
+  return(0) ;
+}
+
+/*****************/
+
+int
+gen_comms ( char * dirname )
+{
+  if ( sw_dm_parallel )
+    fprintf(stderr,"ADVISORY: RSL_LITE version of gen_comms is linked in with registry program.\n") ;
+
+  gen_halos( "inc" , NULL, Halos ) ;
+  gen_shift( "inc" ) ;
+  gen_periods( "inc", Periods ) ;
+  gen_swaps( "inc", Swaps ) ;
+  gen_cycles( "inc", Cycles ) ;
+  gen_xposes( "inc" ) ;
+  gen_comm_descrips( "inc" ) ;
+  gen_datacalls( "inc" ) ;
+  gen_nest_packing( "inc" ) ;
+
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/makefile	(revision 2744)
@@ -0,0 +1,49 @@
+OBJSL   = c_code.o buf_for_proc.o rsl_malloc.o rsl_bcast.o task_for_point.o period.o swap.o cycle.o f_pack.o
+OBJS    = $(OBJSL)
+OPTS    =
+FFLAGS  =  $(OPTS)
+LIBS    = 
+M4      = m4 -Uinclude -Uindex -Ulen
+AR      = ar
+CFLAGS = 
+
+.SUFFIXES:      .F90 .F .f .o .code
+
+all : librsl_lite.a
+
+librsl_lite.a:          $(OBJS)
+			/bin/rm -f librsl_lite.a
+			$(AR) cr librsl_lite.a $(OBJSL)
+
+c_code.o:	        c_code.c
+			$(CC) $(CFLAGS) -c c_code.c
+
+period.o:	        period.c
+			$(CC) $(CFLAGS) -c period.c
+
+swap.o:	                swap.c
+			$(CC) $(CFLAGS) -c swap.c
+
+cycle.o:	        cycle.c
+			$(CC) $(CFLAGS) -c cycle.c
+
+rsl_bcast.o:	        rsl_bcast.c
+			$(CC) $(CFLAGS) -c rsl_bcast.c
+
+rsl_malloc.o:	        rsl_malloc.c
+			$(CC) $(CFLAGS) -c rsl_malloc.c
+
+task_for_point.o:	task_for_point.c
+			$(CC) $(CFLAGS) -c task_for_point.c
+
+buf_for_proc.o:	        buf_for_proc.c
+			$(CC) $(CFLAGS) -c buf_for_proc.c
+
+f_pack.o:	        f_pack.F
+			$(FC) $(FFLAGS) -c f_pack.F
+
+clean : 
+			/bin/rm -f *.f *.o
+
+superclean : clean
+			/bin/rm -f *.a
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/module_dm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/module_dm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/module_dm.F	(revision 2744)
@@ -0,0 +1,3238 @@
+!WRF:PACKAGE:RSL 
+!
+MODULE module_dm
+
+   USE module_machine
+   USE module_configure
+   USE module_state_description
+   USE module_wrf_error
+   IMPLICIT NONE
+
+#if ( NMM_CORE == 1 ) || defined( WRF_CHEM ) 
+   INTEGER, PARAMETER :: max_halo_width = 6
+#else
+   INTEGER, PARAMETER :: max_halo_width = 5
+#endif
+
+   INTEGER :: ips_save, ipe_save, jps_save, jpe_save, itrace
+
+   INTEGER ntasks, ntasks_y, ntasks_x, mytask, mytask_x, mytask_y
+   INTEGER local_communicator, local_communicator_periodic, local_iocommunicator
+   LOGICAL :: dm_debug_flag = .FALSE.
+
+   INTERFACE wrf_dm_maxval
+     MODULE PROCEDURE wrf_dm_maxval_real , wrf_dm_maxval_integer, wrf_dm_maxval_doubleprecision
+   END INTERFACE
+
+   INTERFACE wrf_dm_minval                       ! gopal's doing
+     MODULE PROCEDURE wrf_dm_minval_real , wrf_dm_minval_integer, wrf_dm_minval_doubleprecision
+   END INTERFACE
+
+CONTAINS
+
+
+   SUBROUTINE MPASPECT( P, MINM, MINN, PROCMIN_M, PROCMIN_N )
+      IMPLICIT NONE
+      INTEGER P, M, N, MINI, MINM, MINN, PROCMIN_M, PROCMIN_N
+      MINI = 2*P
+      MINM = 1
+      MINN = P
+      DO M = 1, P
+        IF ( MOD( P, M ) .EQ. 0 ) THEN
+          N = P / M
+          IF ( ABS(M-N) .LT. MINI                &
+               .AND. M .GE. PROCMIN_M            &
+               .AND. N .GE. PROCMIN_N            &
+             ) THEN
+            MINI = ABS(M-N)
+            MINM = M
+            MINN = N
+          ENDIF
+        ENDIF
+      ENDDO
+      IF ( MINM .LT. PROCMIN_M .OR. MINN .LT. PROCMIN_N ) THEN
+        WRITE( wrf_err_message , * )'MPASPECT: UNABLE TO GENERATE PROCESSOR MESH.  STOPPING.'
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE(0,*)' PROCMIN_M ', PROCMIN_M
+        WRITE( wrf_err_message , * )' PROCMIN_M ', PROCMIN_M
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' PROCMIN_N ', PROCMIN_N
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' P         ', P
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' MINM      ', MINM
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' MINN      ', MINN
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        CALL wrf_error_fatal ( 'module_dm: mpaspect' )
+      ENDIF
+   RETURN
+   END SUBROUTINE MPASPECT
+
+   SUBROUTINE wrf_dm_initialize
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER :: local_comm, local_comm2, new_local_comm, group, newgroup, p, p1, ierr
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ranks
+      INTEGER, DIMENSION(2) :: dims, coords
+      LOGICAL, DIMENSION(2) :: isperiodic
+      LOGICAL :: reorder_mesh
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL mpi_comm_size( local_comm, ntasks, ierr )
+      CALL nl_get_nproc_x ( 1, ntasks_x )
+      CALL nl_get_nproc_y ( 1, ntasks_y )
+      CALL nl_get_reorder_mesh( 1, reorder_mesh )
+
+! check if user has specified in the namelist
+      IF ( ntasks_x .GT. 0 .OR. ntasks_y .GT. 0 ) THEN
+        ! if only ntasks_x is specified then make it 1-d decomp in i
+        IF      ( ntasks_x .GT. 0 .AND. ntasks_y .EQ. -1 ) THEN
+          ntasks_y = ntasks / ntasks_x
+        ! if only ntasks_y is specified then make it 1-d decomp in j
+        ELSE IF ( ntasks_x .EQ. -1 .AND. ntasks_y .GT. 0 ) THEN
+          ntasks_x = ntasks / ntasks_y
+        ENDIF
+        ! make sure user knows what they're doing
+        IF ( ntasks_x * ntasks_y .NE. ntasks ) THEN
+          WRITE( wrf_err_message , * )'WRF_DM_INITIALIZE (RSL_LITE): nproc_x * nproc_y in namelist ne ',ntasks
+          CALL wrf_error_fatal ( wrf_err_message )
+        ENDIF
+      ELSE
+        ! When neither is specified, work out mesh with MPASPECT
+        ! Pass nproc_ln and nproc_nt so that number of procs in
+        ! i-dim (nproc_ln) is equal or lesser.
+        CALL mpaspect ( ntasks, ntasks_x, ntasks_y, 1, 1 )
+      ENDIF
+      WRITE( wrf_err_message , * )'Ntasks in X ',ntasks_x,', ntasks in Y ',ntasks_y
+      CALL wrf_message( wrf_err_message )
+
+      CALL mpi_comm_rank( local_comm, mytask, ierr )
+! extra code to reorder the communicator 20051212jm
+      IF ( reorder_mesh ) THEN
+write(0,*)'reordering mesh'
+        ALLOCATE (ranks(ntasks))
+        CALL mpi_comm_dup ( local_comm , local_comm2, ierr )
+        CALL mpi_comm_group ( local_comm2, group, ierr )
+        DO p1=1,ntasks
+          p = p1 - 1
+          ranks(p1) = mod( p , ntasks_x ) * ntasks_y + p / ntasks_x  
+        ENDDO
+        CALL mpi_group_incl( group, ntasks, ranks, newgroup, ierr )
+        DEALLOCATE (ranks)
+        CALL mpi_comm_create( local_comm2, newgroup, new_local_comm , ierr )
+      ELSE
+        new_local_comm = local_comm
+      ENDIF
+! end extra code to reorder the communicator 20051212jm
+      dims(1) = ntasks_y  ! rows
+      dims(2) = ntasks_x  ! columns
+      isperiodic(1) = .false.
+      isperiodic(2) = .false.
+      CALL mpi_cart_create( new_local_comm, 2, dims, isperiodic, .false., local_communicator, ierr )
+      dims(1) = ntasks_y  ! rows
+      dims(2) = ntasks_x  ! columns
+      isperiodic(1) = .true.
+      isperiodic(2) = .true.
+      CALL mpi_cart_create( new_local_comm, 2, dims, isperiodic, .false., local_communicator_periodic, ierr )
+! debug
+      CALL mpi_comm_rank( local_communicator_periodic, mytask, ierr )
+      CALL mpi_cart_coords( local_communicator_periodic, mytask, 2, coords, ierr )
+        write(0,*)'periodic coords ',mytask, coords
+
+      CALL mpi_comm_rank( local_communicator, mytask, ierr )
+      CALL mpi_cart_coords( local_communicator, mytask, 2, coords, ierr )
+        write(0,*)'non periodic coords ',mytask, coords
+      mytask_x = coords(2)   ! col task (x)
+      mytask_y = coords(1)   ! row task (y)
+      CALL nl_set_nproc_x ( 1, ntasks_x )
+      CALL nl_set_nproc_y ( 1, ntasks_y )
+      CALL wrf_set_dm_communicator ( local_communicator )
+      RETURN
+   END SUBROUTINE wrf_dm_initialize
+
+   SUBROUTINE patch_domain_rsl_lite( id  , parent, parent_id, &
+                                sd1 , ed1 , sp1 , ep1 , sm1 , em1 ,        &
+                                sd2 , ed2 , sp2 , ep2 , sm2 , em2 ,        &
+                                sd3 , ed3 , sp3 , ep3 , sm3 , em3 ,        &
+                                bdx , bdy )
+
+      USE module_domain
+      USE module_machine
+
+      IMPLICIT NONE
+      INTEGER, INTENT(IN)   :: sd1 , ed1 , sd2 , ed2 , sd3 , ed3 , bdx , bdy
+      INTEGER, INTENT(OUT)  :: sp1 , ep1 , sp2 , ep2 , sp3 , ep3 , &
+                               sm1 , em1 , sm2 , em2 , sm3 , em3
+      INTEGER, INTENT(IN)   :: id, parent_id
+      TYPE(domain),POINTER  :: parent
+
+! Local variables
+      INTEGER               :: ids, ide, jds, jde, kds, kde
+      INTEGER               :: ims, ime, jms, jme, kms, kme
+      INTEGER               :: ips, ipe, jps, jpe, kps, kpe
+
+      INTEGER               :: c_sd1 , c_ed1 , c_sd2 , c_ed2 , c_sd3 , c_ed3
+      INTEGER               :: c_sp1 , c_ep1 , c_sp2 , c_ep2 , c_sp3 , c_ep3 , &
+                               c_sm1 , c_em1 , c_sm2 , c_em2 , c_sm3 , c_em3
+      INTEGER               :: c_sp1x , c_ep1x , c_sp2x , c_ep2x , c_sp3x , c_ep3x , &
+                               c_sm1x , c_em1x , c_sm2x , c_em2x , c_sm3x , c_em3x
+      INTEGER               :: c_sp1y , c_ep1y , c_sp2y , c_ep2y , c_sp3y , c_ep3y , &
+                               c_sm1y , c_em1y , c_sm2y , c_em2y , c_sm3y , c_em3y
+
+      INTEGER               :: c_ids, c_ide, c_jds, c_jde, c_kds, c_kde
+      INTEGER               :: c_ims, c_ime, c_jms, c_jme, c_kms, c_kme
+      INTEGER               :: c_ips, c_ipe, c_jps, c_jpe, c_kps, c_kpe
+
+      INTEGER               :: idim , jdim , kdim , rem , a, b
+      INTEGER               :: i, j, ni, nj, Px, Py, P
+
+      INTEGER               :: parent_grid_ratio, i_parent_start, j_parent_start
+      INTEGER               :: shw
+      INTEGER               :: idim_cd, jdim_cd
+
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER  :: nest_grid
+
+
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_ZXY )
+            ids = sd2 ; ide = ed2 
+            jds = sd3 ; jde = ed3 
+            kds = sd1 ; kde = ed1 
+         CASE ( DATA_ORDER_XYZ )
+            ids = sd1 ; ide = ed1 
+            jds = sd2 ; jde = ed2 
+            kds = sd3 ; kde = ed3 
+         CASE ( DATA_ORDER_XZY )
+            ids = sd1 ; ide = ed1 
+            jds = sd3 ; jde = ed3 
+            kds = sd2 ; kde = ed2 
+         CASE ( DATA_ORDER_YXZ)
+            ids = sd2 ; ide = ed2 
+            jds = sd1 ; jde = ed1 
+            kds = sd3 ; kde = ed3 
+      END SELECT
+
+      CALL compute_memory_dims_rsl_lite ( 0 , bdx, bdy,   &
+                   ids, ide, jds, jde, kds, kde, &
+                   ims, ime, jms, jme, kms, kme, &
+                   ips, ipe, jps, jpe, kps, kpe )
+
+     ! ensure that the every parent domain point has a full set of nested points under it
+     ! even at the borders. Do this by making sure the number of nest points is a multiple of
+     ! the nesting ratio. Note that this is important mostly to the intermediate domain, which
+     ! is the subject of the scatter gather comms with the parent
+
+      IF ( id .GT. 1 ) THEN
+         CALL nl_get_parent_grid_ratio( id, parent_grid_ratio )
+         if ( mod(ime,parent_grid_ratio) .NE. 0 ) ime = ime + parent_grid_ratio - mod(ime,parent_grid_ratio)
+         if ( mod(jme,parent_grid_ratio) .NE. 0 ) jme = jme + parent_grid_ratio - mod(jme,parent_grid_ratio)
+      ENDIF
+
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_ZXY )
+            sp2 = ips ; ep2 = ipe ; sm2 = ims ; em2 = ime
+            sp3 = jps ; ep3 = jpe ; sm3 = jms ; em3 = jme
+            sp1 = kps ; ep1 = kpe ; sm1 = kms ; em1 = kme
+         CASE ( DATA_ORDER_XYZ )
+            sp1 = ips ; ep1 = ipe ; sm1 = ims ; em1 = ime
+            sp2 = jps ; ep2 = jpe ; sm2 = jms ; em2 = jme
+            sp3 = kps ; ep3 = kpe ; sm3 = kms ; em3 = kme
+         CASE ( DATA_ORDER_XZY )
+            sp1 = ips ; ep1 = ipe ; sm1 = ims ; em1 = ime
+            sp3 = jps ; ep3 = jpe ; sm3 = jms ; em3 = jme
+            sp2 = kps ; ep2 = kpe ; sm2 = kms ; em2 = kme
+         CASE ( DATA_ORDER_YXZ)
+            sp2 = ips ; ep2 = ipe ; sm2 = ims ; em2 = ime
+            sp1 = jps ; ep1 = jpe ; sm1 = jms ; em1 = jme
+            sp3 = kps ; ep3 = kpe ; sm3 = kms ; em3 = kme
+      END SELECT
+
+      if ( id.eq.1 ) then
+         WRITE(wrf_err_message,*)'*************************************'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'Parent domain'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ids,ide,jds,jde ',ids,ide,jds,jde
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ims,ime,jms,jme ',ims,ime,jms,jme
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ips,ipe,jps,jpe ',ips,ipe,jps,jpe
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'*************************************'
+         CALL wrf_message( TRIM(wrf_err_message) )
+      endif
+
+      IF ( id .GT. 1 ) THEN
+
+         CALL nl_get_shw( id, shw )
+         CALL nl_get_i_parent_start( id , i_parent_start )
+         CALL nl_get_j_parent_start( id , j_parent_start )
+         CALL nl_get_parent_grid_ratio( id, parent_grid_ratio )
+
+         SELECT CASE ( model_data_order )
+            ! need to finish other cases
+            CASE ( DATA_ORDER_ZXY )
+               idim = ed2-sd2+1
+               jdim = ed3-sd3+1
+               kdim = ed1-sd1+1
+            CASE ( DATA_ORDER_XYZ )
+               idim = ed1-sd1+1
+               jdim = ed2-sd2+1
+               kdim = ed3-sd3+1
+            CASE ( DATA_ORDER_XZY )
+               idim = ed1-sd1+1
+               jdim = ed3-sd3+1
+               kdim = ed2-sd2+1
+            CASE ( DATA_ORDER_YXZ)
+               idim = ed2-sd2+1
+               jdim = ed1-sd1+1
+               kdim = ed3-sd3+1
+         END SELECT
+
+         idim_cd = idim / parent_grid_ratio + 1 + 2*shw + 1
+         jdim_cd = jdim / parent_grid_ratio + 1 + 2*shw + 1
+
+         c_ids = i_parent_start-shw ; c_ide = c_ids + idim_cd - 1
+         c_jds = j_parent_start-shw ; c_jde = c_jds + jdim_cd - 1
+         c_kds = sd2                ; c_kde = ed2                   ! IKJ ONLY
+
+         ! we want the intermediate domain to be decomposed the
+         ! the same as the underlying nest. So try this:
+#if 0
+         CALL compute_memory_dims_rsl_lite ( shw, bdx, bdy,  &
+                      c_ids, c_ide, c_jds, c_jde, c_kds, c_kde, &
+                      c_ims, c_ime, c_jms, c_jme, c_kms, c_kme, &
+                      c_ips, c_ipe, c_jps, c_jpe, c_kps, c_kpe )
+#else
+
+! At such time as NMM nesting is able to use RSL_LITE (would require
+! a number of other mods to this file for that to happen), this should
+! be updated along the lines of what's done in compute_memory_dims_rsl_lite
+! below. See note dated 20051020.  JM
+
+         c_ips = -1
+         nj = ( c_jds - j_parent_start ) * parent_grid_ratio + 1 + 1 ;
+         DO i = c_ids, c_ide
+            ni = ( i - i_parent_start ) * parent_grid_ratio + 1 + 1 ;
+            CALL task_for_point ( ni, nj, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py )
+            IF ( Px .EQ. mytask_x ) THEN
+               c_ipe = i
+               IF ( c_ips .EQ. -1 ) c_ips = i
+            ENDIF
+         ENDDO
+
+         c_jps = -1
+         ni = ( c_ids - i_parent_start ) * parent_grid_ratio + 1 + 1 ;
+         DO j = c_jds, c_jde
+            nj = ( j - j_parent_start ) * parent_grid_ratio + 1 + 1 ;
+            CALL task_for_point ( ni, nj, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py )
+            IF ( Py .EQ. mytask_y ) THEN
+               c_jpe = j
+               IF ( c_jps .EQ. -1 ) c_jps = j
+            ENDIF
+         ENDDO
+
+#endif
+
+! extend the patch dimensions out shw along edges of domain
+         IF ( mytask_x .EQ. 0 ) THEN
+           c_ips = c_ips - shw
+         ENDIF
+         IF ( mytask_x .EQ. ntasks_x-1 ) THEN
+           c_ipe = c_ipe + shw
+         ENDIF
+         c_ims = max( c_ips - max(shw,max_halo_width), c_ids - bdx ) - 1
+         c_ime = min( c_ipe + max(shw,max_halo_width), c_ide + bdx ) + 1
+
+! handle j dims
+! extend the patch dimensions out shw along edges of domain
+         IF ( mytask_y .EQ. 0 ) THEN
+            c_jps = c_jps - shw
+         ENDIF
+         IF ( mytask_y .EQ. ntasks_y-1 ) THEN
+            c_jpe = c_jpe + shw
+         ENDIF
+         c_jms = max( c_jps - max(shw,max_halo_width), c_jds - bdx ) - 1
+         c_jme = min( c_jpe + max(shw,max_halo_width), c_jde + bdx ) + 1
+! handle k dims
+         c_kps = 1
+         c_kpe = c_kde
+         c_kms = 1
+         c_kme = c_kde
+
+         WRITE(wrf_err_message,*)'*************************************'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'Nesting domain'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ids,ide,jds,jde ',ids,ide,jds,jde
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ims,ime,jms,jme ',ims,ime,jms,jme
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ips,ipe,jps,jpe ',ips,ipe,jps,jpe
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'INTERMEDIATE domain'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ids,ide,jds,jde ',c_ids,c_ide,c_jds,c_jde
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ims,ime,jms,jme ',c_ims,c_ime,c_jms,c_jme
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ips,ipe,jps,jpe ',c_ips,c_ipe,c_jps,c_jpe
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'*************************************'
+         CALL wrf_message( TRIM(wrf_err_message) )
+
+         SELECT CASE ( model_data_order )
+            ! need to finish other cases
+            CASE ( DATA_ORDER_ZXY )
+               c_sd2 = c_ids ; c_ed2 = c_ide ; c_sp2 = c_ips ; c_ep2 = c_ipe ; c_sm2 = c_ims ; c_em2 = c_ime
+               c_sd3 = c_jds ; c_ed3 = c_jde ; c_sp3 = c_jps ; c_ep3 = c_jpe ; c_sm3 = c_jms ; c_em3 = c_jme
+               c_sd1 = c_kds ; c_ed1 = c_kde ; c_sp1 = c_kps ; c_ep1 = c_kpe ; c_sm1 = c_kms ; c_em1 = c_kme
+            CASE ( DATA_ORDER_XYZ )
+               c_sd1 = c_ids ; c_ed1 = c_ide ; c_sp1 = c_ips ; c_ep1 = c_ipe ; c_sm1 = c_ims ; c_em1 = c_ime
+               c_sd2 = c_jds ; c_ed2 = c_jde ; c_sp2 = c_jps ; c_ep2 = c_jpe ; c_sm2 = c_jms ; c_em2 = c_jme
+               c_sd3 = c_kds ; c_ed3 = c_kde ; c_sp3 = c_kps ; c_ep3 = c_kpe ; c_sm3 = c_kms ; c_em3 = c_kme
+            CASE ( DATA_ORDER_XZY )
+               c_sd1 = c_ids ; c_ed1 = c_ide ; c_sp1 = c_ips ; c_ep1 = c_ipe ; c_sm1 = c_ims ; c_em1 = c_ime
+               c_sd3 = c_jds ; c_ed3 = c_jde ; c_sp3 = c_jps ; c_ep3 = c_jpe ; c_sm3 = c_jms ; c_em3 = c_jme
+               c_sd2 = c_kds ; c_ed2 = c_kde ; c_sp2 = c_kps ; c_ep2 = c_kpe ; c_sm2 = c_kms ; c_em2 = c_kme
+            CASE ( DATA_ORDER_YXZ)
+               c_sd2 = c_ids ; c_ed2 = c_ide ; c_sp2 = c_ips ; c_ep2 = c_ipe ; c_sm2 = c_ims ; c_em2 = c_ime
+               c_sd1 = c_jds ; c_ed1 = c_jde ; c_sp1 = c_jps ; c_ep1 = c_jpe ; c_sm1 = c_jms ; c_em1 = c_jme
+               c_sd3 = c_kds ; c_ed3 = c_kde ; c_sp3 = c_kps ; c_ep3 = c_kpe ; c_sm3 = c_kms ; c_em3 = c_kme
+         END SELECT
+
+         ALLOCATE ( intermediate_grid )
+         ALLOCATE ( intermediate_grid%parents( max_parents ) )
+         ALLOCATE ( intermediate_grid%nests( max_nests ) )
+
+         NULLIFY( intermediate_grid%sibling )
+         DO i = 1, max_nests
+            NULLIFY( intermediate_grid%nests(i)%ptr )
+         ENDDO
+         NULLIFY  (intermediate_grid%next)
+         NULLIFY  (intermediate_grid%same_level)
+         NULLIFY  (intermediate_grid%i_start)
+         NULLIFY  (intermediate_grid%j_start)
+         NULLIFY  (intermediate_grid%i_end)
+         NULLIFY  (intermediate_grid%j_end)
+         intermediate_grid%id = id
+         intermediate_grid%num_nests = 0
+         intermediate_grid%num_siblings = 0
+         intermediate_grid%num_parents = 1
+         intermediate_grid%max_tiles   = 0
+         intermediate_grid%num_tiles_spec   = 0
+         CALL find_grid_by_id ( id, head_grid, nest_grid )
+
+         nest_grid%intermediate_grid => intermediate_grid  ! nest grid now has a pointer to this baby
+         intermediate_grid%parents(1)%ptr => nest_grid     ! the intermediate grid considers nest its parent
+         intermediate_grid%num_parents = 1
+
+         c_sm1x = 1 ; c_em1x = 1 ; c_sm2x = 1 ; c_em2x = 1 ; c_sm3x = 1 ; c_em3x = 1
+         c_sm1y = 1 ; c_em1y = 1 ; c_sm2y = 1 ; c_em2y = 1 ; c_sm3y = 1 ; c_em3y = 1
+
+         intermediate_grid%sm31x                           = c_sm1x
+         intermediate_grid%em31x                           = c_em1x
+         intermediate_grid%sm32x                           = c_sm2x
+         intermediate_grid%em32x                           = c_em2x
+         intermediate_grid%sm33x                           = c_sm3x
+         intermediate_grid%em33x                           = c_em3x
+         intermediate_grid%sm31y                           = c_sm1y
+         intermediate_grid%em31y                           = c_em1y
+         intermediate_grid%sm32y                           = c_sm2y
+         intermediate_grid%em32y                           = c_em2y
+         intermediate_grid%sm33y                           = c_sm3y
+         intermediate_grid%em33y                           = c_em3y
+
+#if 0
+         ! allocate space for the intermediate domain
+         CALL alloc_space_field ( intermediate_grid, id , 3 , .FALSE., &   ! use same id as nest
+                               c_sd1, c_ed1, c_sd2, c_ed2, c_sd3, c_ed3,       &
+                               c_sm1,  c_em1,  c_sm2,  c_em2,  c_sm3,  c_em3,  &
+                               c_sm1x, c_em1x, c_sm2x, c_em2x, c_sm3x, c_em3x, &   ! x-xpose
+                               c_sm1y, c_em1y, c_sm2y, c_em2y, c_sm3y, c_em3y  )   ! y-xpose
+#endif
+         intermediate_grid%sd31                            =   c_sd1
+         intermediate_grid%ed31                            =   c_ed1
+         intermediate_grid%sp31                            = c_sp1
+         intermediate_grid%ep31                            = c_ep1
+         intermediate_grid%sm31                            = c_sm1
+         intermediate_grid%em31                            = c_em1
+         intermediate_grid%sd32                            =   c_sd2
+         intermediate_grid%ed32                            =   c_ed2
+         intermediate_grid%sp32                            = c_sp2
+         intermediate_grid%ep32                            = c_ep2
+         intermediate_grid%sm32                            = c_sm2
+         intermediate_grid%em32                            = c_em2
+         intermediate_grid%sd33                            =   c_sd3
+         intermediate_grid%ed33                            =   c_ed3
+         intermediate_grid%sp33                            = c_sp3
+         intermediate_grid%ep33                            = c_ep3
+         intermediate_grid%sm33                            = c_sm3
+         intermediate_grid%em33                            = c_em3
+
+         CALL med_add_config_info_to_grid ( intermediate_grid )
+
+         intermediate_grid%dx = parent%dx
+         intermediate_grid%dy = parent%dy
+         intermediate_grid%dt = parent%dt
+      ENDIF
+
+      RETURN
+  END SUBROUTINE patch_domain_rsl_lite
+
+  SUBROUTINE compute_memory_dims_rsl_lite  (      &
+                   shw , bdx, bdy ,              &
+                   ids, ide, jds, jde, kds, kde, &
+                   ims, ime, jms, jme, kms, kme, &
+                   ips, ipe, jps, jpe, kps, kpe )
+
+        IMPLICIT NONE
+        INTEGER, INTENT(IN)    ::  shw, bdx, bdy
+        INTEGER, INTENT(IN)    ::  ids, ide, jds, jde, kds, kde
+        INTEGER, INTENT(OUT)    ::  ips, ipe, jps, jpe, kps, kpe
+        INTEGER, INTENT(OUT)    ::  ims, ime, jms, jme, kms, kme
+
+        INTEGER idim, jdim, kdim, rem, a, b
+        INTEGER Px, Py, P, i, j
+
+        idim = ide-ids+1 - (2*shw)
+        jdim = jde-jds+1 - (2*shw)
+        kdim = kde-kds+1
+
+#if 0
+        rem = mod(idim,ntasks_x)
+        a = ( idim / ntasks_x + 1 ) * min( rem, mytask_x )
+        b = ( idim / ntasks_x     ) * max( 0, mytask_x - rem )
+        ips = max( 1, a + b + 1 ) + shw + ids-1
+        a = ( idim / ntasks_x + 1 ) * min( rem, mytask_x+1 )
+        b = ( idim / ntasks_x     ) * max( 0, mytask_x+1 - rem )
+        ipe = a + b + shw + ids-1
+
+        rem = mod(jdim,ntasks_y)
+        a = ( jdim / ntasks_y + 1 ) * min( rem, mytask_y )
+        b = ( jdim / ntasks_y     ) * max( 0, mytask_y - rem )
+        jps = max( 1, a + b + 1 ) + shw  + jds-1
+        a = ( jdim / ntasks_y + 1 ) * min( rem, mytask_y+1 )
+        b = ( jdim / ntasks_y     ) * max( 0, mytask_y+1 - rem )
+        jpe = a + b + shw + jds-1
+#else
+# if ( ! NMM_CORE == 1 )
+        ips = -1
+        j = jds ;
+        DO i = ids, ide
+           CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py )
+           IF ( Px .EQ. mytask_x ) THEN
+              ipe = i
+              IF ( ips .EQ. -1 ) ips = i
+           ENDIF
+        ENDDO
+
+        jps = -1
+        i = ids ;
+        DO j = jds, jde
+           CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py )
+           IF ( Py .EQ. mytask_y ) THEN
+              jpe = j
+              IF ( jps .EQ. -1 ) jps = j
+           ENDIF
+        ENDDO
+# else
+
+! In case of NMM CORE, the domain only ever runs from ids..ide-1 and jds..jde-1 so
+! adjust decomposition to reflect.  20051020 JM
+
+        ips = -1
+        j = jds ;
+        DO i = ids, ide-1
+           CALL task_for_point ( i, j, ids, ide-1, jds, jde-1, ntasks_x, ntasks_y, Px, Py )
+           IF ( Px .EQ. mytask_x ) THEN
+              ipe = i
+              IF ( Px .EQ. ntasks_x-1 ) ipe = ipe + 1
+              IF ( ips .EQ. -1 ) ips = i
+           ENDIF
+        ENDDO
+
+        jps = -1
+        i = ids ;
+        DO j = jds, jde-1
+           CALL task_for_point ( i, j, ids, ide-1, jds, jde-1, ntasks_x, ntasks_y, Px, Py )
+           IF ( Py .EQ. mytask_y ) THEN
+              jpe = j
+              IF ( Py .EQ. ntasks_y-1 ) jpe = jpe + 1
+              IF ( jps .EQ. -1 ) jps = j
+           ENDIF
+        ENDDO
+# endif
+#endif
+
+! extend the patch dimensions out shw along edges of domain
+        IF ( mytask_x .EQ. 0 ) THEN
+           ips = ips - shw
+        ENDIF
+        IF ( mytask_x .EQ. ntasks_x-1 ) THEN
+           ipe = ipe + shw
+        ENDIF
+        IF ( mytask_y .EQ. 0 ) THEN
+           jps = jps - shw
+        ENDIF
+        IF ( mytask_y .EQ. ntasks_y-1 ) THEN
+           jpe = jpe + shw
+        ENDIF
+
+        kps = 1
+        kpe = kdim
+        ims = max( ips - max(shw,max_halo_width), ids - bdx ) - 1
+        ime = min( ipe + max(shw,max_halo_width), ide + bdx ) + 1
+        jms = max( jps - max(shw,max_halo_width), jds - bdy ) - 1
+        jme = min( jpe + max(shw,max_halo_width), jde + bdy ) + 1
+        kms = 1
+        kme = kdim
+
+  END SUBROUTINE compute_memory_dims_rsl_lite
+
+! internal, used below for switching the argument to MPI calls
+! if reals are being autopromoted to doubles in the build of WRF
+   INTEGER function getrealmpitype()
+#ifndef STUBMPI
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER rtypesize, dtypesize, ierr
+      CALL mpi_type_size ( MPI_REAL, rtypesize, ierr )
+      CALL mpi_type_size ( MPI_DOUBLE_PRECISION, dtypesize, ierr )
+      IF ( RWORDSIZE .EQ. rtypesize ) THEN
+        getrealmpitype = MPI_REAL
+      ELSE IF ( RWORDSIZE .EQ. dtypesize ) THEN
+        getrealmpitype = MPI_DOUBLE_PRECISION
+      ELSE
+        CALL wrf_error_fatal ( 'RWORDSIZE or DWORDSIZE does not match any MPI type' )
+      ENDIF
+#else
+! required dummy initialization for function that is never called
+      getrealmpitype = 1
+#endif
+      RETURN
+   END FUNCTION getrealmpitype
+
+   REAL FUNCTION wrf_dm_max_real ( inval )
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      REAL inval, retval
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval , 1, getrealmpitype(), MPI_MAX, local_communicator, ierr )
+      wrf_dm_max_real = retval
+   END FUNCTION wrf_dm_max_real
+
+   REAL FUNCTION wrf_dm_min_real ( inval )
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      REAL inval, retval
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval , 1, getrealmpitype(), MPI_MIN, local_communicator, ierr )
+      wrf_dm_min_real = retval
+   END FUNCTION wrf_dm_min_real
+
+   REAL FUNCTION wrf_dm_sum_real ( inval )
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      REAL inval, retval
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval , 1, getrealmpitype(), MPI_SUM, local_communicator, ierr )
+      wrf_dm_sum_real = retval
+   END FUNCTION wrf_dm_sum_real
+
+   INTEGER FUNCTION wrf_dm_sum_integer ( inval )
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER inval, retval
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval , 1, MPI_INTEGER, MPI_SUM, local_communicator, ierr )
+      wrf_dm_sum_integer = retval
+   END FUNCTION wrf_dm_sum_integer
+
+   SUBROUTINE wrf_dm_maxval_real ( val, idex, jdex )
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      REAL val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+      INTEGER i
+
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, local_communicator, ierr )
+      CALL mpi_allgather ( val, 1, getrealmpitype(), val_all , 1, getrealmpitype(), local_communicator, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .GT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+   END SUBROUTINE wrf_dm_maxval_real
+
+   SUBROUTINE wrf_dm_maxval_doubleprecision ( val, idex, jdex )
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      DOUBLE PRECISION val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+      INTEGER i
+
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, local_communicator, ierr )
+      CALL mpi_allgather ( val, 1, MPI_DOUBLE_PRECISION, val_all , 1, MPI_DOUBLE_PRECISION, local_communicator, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .GT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+   END SUBROUTINE wrf_dm_maxval_doubleprecision
+
+   SUBROUTINE wrf_dm_maxval_integer ( val, idex, jdex )
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+      INTEGER i
+
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, local_communicator, ierr )
+      CALL mpi_allgather ( val, 1, MPI_INTEGER, val_all , 1, MPI_INTEGER, local_communicator, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .GT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+   END SUBROUTINE wrf_dm_maxval_integer
+
+!  For HWRF some additional computation is required. This is gopal's doing
+
+   SUBROUTINE wrf_dm_minval_real ( val, idex, jdex )
+      IMPLICIT NONE
+      REAL val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_REAL, val_all , 1, MPI_REAL, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .LT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_minval_real
+
+   SUBROUTINE wrf_dm_minval_doubleprecision ( val, idex, jdex )
+      IMPLICIT NONE
+      DOUBLE PRECISION val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_DOUBLE_PRECISION, val_all , 1, MPI_DOUBLE_PRECISION, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .LT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_minval_doubleprecision
+
+   SUBROUTINE wrf_dm_minval_integer ( val, idex, jdex )
+      IMPLICIT NONE
+      INTEGER val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_INTEGER, val_all , 1, MPI_INTEGER, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .LT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_minval_integer     ! End of gopal's doing
+
+   SUBROUTINE init_module_dm
+      IMPLICIT NONE
+      INTEGER mpi_comm_local, ierr, mytask, nproc
+      INCLUDE 'mpif.h'
+      LOGICAL mpi_inited
+      CALL mpi_initialized( mpi_inited, ierr )
+      IF ( .NOT. mpi_inited ) THEN
+	! If MPI has not been initialized then initialize it and 
+	! make comm_world the communicator
+	! Otherwise, something else (e.g. quilt-io) has already 
+	! initialized MPI, so just grab the communicator that
+	! should already be stored and use that.
+	CALL mpi_init ( ierr )
+        CALL wrf_termio_dup
+	CALL wrf_set_dm_communicator ( MPI_COMM_WORLD )
+      ENDIF
+      CALL wrf_get_dm_communicator( mpi_comm_local )
+   END SUBROUTINE init_module_dm
+
+! stub
+   SUBROUTINE wrf_dm_move_nest ( parent, nest, dx, dy )
+      USE module_domain
+      IMPLICIT NONE
+      TYPE (domain), INTENT(INOUT) :: parent, nest
+      INTEGER, INTENT(IN)          :: dx,dy
+      RETURN
+   END SUBROUTINE wrf_dm_move_nest
+
+!------------------------------------------------------------------------------
+   SUBROUTINE get_full_obs_vector( nsta, nerrf, niobf,          &
+                                   mp_local_uobmask,            &
+                                   mp_local_vobmask,            &
+                                   mp_local_cobmask, errf )
+      
+!------------------------------------------------------------------------------
+!  PURPOSE: Do MPI allgatherv operation across processors to get the
+!           errors at each observation point on all processors. 
+!       
+!------------------------------------------------------------------------------
+#ifndef STUBMPI
+    INCLUDE 'mpif.h'
+        
+    INTEGER, INTENT(IN)   :: nsta                ! Observation index.
+    INTEGER, INTENT(IN)   :: nerrf               ! Number of error fields.
+    INTEGER, INTENT(IN)   :: niobf               ! Number of observations.
+    LOGICAL, INTENT(IN)   :: MP_LOCAL_UOBMASK(NIOBF)
+    LOGICAL, INTENT(IN)   :: MP_LOCAL_VOBMASK(NIOBF)
+    LOGICAL, INTENT(IN)   :: MP_LOCAL_COBMASK(NIOBF)
+    REAL, INTENT(INOUT)   :: errf(nerrf, niobf)
+        
+! Local declarations
+    integer i, n, nlocal_dot, nlocal_crs
+    REAL UVT_BUFFER(NIOBF)    ! Buffer for holding U, V, or T
+    REAL QRK_BUFFER(NIOBF)    ! Buffer for holding Q or RKO
+    REAL SFP_BUFFER(NIOBF)    ! Buffer for holding Surface pressure
+    INTEGER N_BUFFER(NIOBF)
+    REAL FULL_BUFFER(NIOBF)
+    INTEGER IFULL_BUFFER(NIOBF)
+    INTEGER IDISPLACEMENT(1024)   ! HARD CODED MAX NUMBER OF PROCESSORS
+    INTEGER ICOUNT(1024)          ! HARD CODED MAX NUMBER OF PROCESSORS
+
+    INTEGER :: MPI_COMM_COMP      ! MPI group communicator
+    INTEGER :: NPROCS             ! Number of processors
+    INTEGER :: IERR               ! Error code from MPI routines
+
+! Get communicator for MPI operations.
+    CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
+
+! Get rank of monitor processor and broadcast to others.
+    CALL MPI_COMM_SIZE( MPI_COMM_COMP, NPROCS, IERR )
+
+! DO THE U FIELD
+   NLOCAL_DOT = 0
+   DO N = 1, NSTA
+     IF ( MP_LOCAL_UOBMASK(N) ) THEN      ! USE U-POINT MASK
+       NLOCAL_DOT = NLOCAL_DOT + 1
+       UVT_BUFFER(NLOCAL_DOT) = ERRF(1,N)        ! U WIND COMPONENT
+       SFP_BUFFER(NLOCAL_DOT) = ERRF(7,N)        ! SURFACE PRESSURE
+       QRK_BUFFER(NLOCAL_DOT) = ERRF(9,N)        ! RKO
+       N_BUFFER(NLOCAL_DOT) = N
+     ENDIF
+   ENDDO
+   CALL MPI_ALLGATHER(NLOCAL_DOT,1,MPI_INTEGER, &
+                      ICOUNT,1,MPI_INTEGER,     &
+                      MPI_COMM_COMP,IERR)
+   I = 1
+
+   IDISPLACEMENT(1) = 0
+   DO I = 2, NPROCS
+     IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1)
+   ENDDO
+   CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_DOT, MPI_INTEGER,    &
+                        IFULL_BUFFER, ICOUNT, IDISPLACEMENT,  &
+                        MPI_INTEGER, MPI_COMM_COMP, IERR)
+! U
+   CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(1,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! SURF PRESS AT U-POINTS
+   CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(7,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! RKO
+   CALL MPI_ALLGATHERV( QRK_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(9,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+
+! DO THE V FIELD
+   NLOCAL_DOT = 0
+   DO N = 1, NSTA
+     IF ( MP_LOCAL_VOBMASK(N) ) THEN         ! USE V-POINT MASK
+       NLOCAL_DOT = NLOCAL_DOT + 1
+       UVT_BUFFER(NLOCAL_DOT) = ERRF(2,N)    ! V WIND COMPONENT
+       SFP_BUFFER(NLOCAL_DOT) = ERRF(8,N)    ! SURFACE PRESSURE
+       N_BUFFER(NLOCAL_DOT) = N
+     ENDIF
+   ENDDO
+   CALL MPI_ALLGATHER(NLOCAL_DOT,1,MPI_INTEGER, &
+                      ICOUNT,1,MPI_INTEGER,     &
+                      MPI_COMM_COMP,IERR)
+   I = 1
+
+   IDISPLACEMENT(1) = 0
+   DO I = 2, NPROCS
+     IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1)
+   ENDDO
+   CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_DOT, MPI_INTEGER,    &
+                        IFULL_BUFFER, ICOUNT, IDISPLACEMENT,  &
+                        MPI_INTEGER, MPI_COMM_COMP, IERR)
+! V
+   CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(2,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! SURF PRESS AT V-POINTS
+   CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(8,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+
+! DO THE CROSS FIELDS, T AND Q
+   NLOCAL_CRS = 0
+   DO N = 1, NSTA
+     IF ( MP_LOCAL_COBMASK(N) ) THEN       ! USE MASS-POINT MASK
+       NLOCAL_CRS = NLOCAL_CRS + 1
+       UVT_BUFFER(NLOCAL_CRS) = ERRF(3,N)     ! TEMPERATURE
+       QRK_BUFFER(NLOCAL_CRS) = ERRF(4,N)     ! MOISTURE
+       SFP_BUFFER(NLOCAL_CRS) = ERRF(6,N)     ! SURFACE PRESSURE
+       N_BUFFER(NLOCAL_CRS) = N
+     ENDIF
+   ENDDO
+   CALL MPI_ALLGATHER(NLOCAL_CRS,1,MPI_INTEGER, &
+                      ICOUNT,1,MPI_INTEGER,     &
+                      MPI_COMM_COMP,IERR)
+   IDISPLACEMENT(1) = 0
+   DO I = 2, NPROCS
+     IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1)
+   ENDDO
+   CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_CRS, MPI_INTEGER,    &
+                        IFULL_BUFFER, ICOUNT, IDISPLACEMENT,  &
+                        MPI_INTEGER, MPI_COMM_COMP, IERR)
+! T
+   CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_CRS, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+
+   DO N = 1, NSTA
+     ERRF(3,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! Q
+   CALL MPI_ALLGATHERV( QRK_BUFFER, NLOCAL_CRS, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(4,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! SURF PRESS AT MASS POINTS
+   CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_CRS, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(6,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+#endif
+   END SUBROUTINE get_full_obs_vector
+
+END MODULE module_dm
+
+!=========================================================================
+! wrf_dm_patch_domain has to be outside the module because it is called
+! by a routine in module_domain but depends on module domain
+
+SUBROUTINE wrf_dm_patch_domain ( id  , domdesc , parent_id , parent_domdesc , &
+                          sd1 , ed1 , sp1 , ep1 , sm1 , em1 , &
+                          sd2 , ed2 , sp2 , ep2 , sm2 , em2 , &
+                          sd3 , ed3 , sp3 , ep3 , sm3 , em3 , &
+                                      sp1x , ep1x , sm1x , em1x , &
+                                      sp2x , ep2x , sm2x , em2x , &
+                                      sp3x , ep3x , sm3x , em3x , &
+                                      sp1y , ep1y , sm1y , em1y , &
+                                      sp2y , ep2y , sm2y , em2y , &
+                                      sp3y , ep3y , sm3y , em3y , &
+                          bdx , bdy )
+   USE module_domain
+   USE module_dm
+   IMPLICIT NONE
+
+   INTEGER, INTENT(IN)   :: sd1 , ed1 , sd2 , ed2 , sd3 , ed3 , bdx , bdy
+   INTEGER, INTENT(OUT)  :: sp1 , ep1 , sp2 , ep2 , sp3 , ep3 , &
+                            sm1 , em1 , sm2 , em2 , sm3 , em3
+   INTEGER               :: sp1x , ep1x , sp2x , ep2x , sp3x , ep3x , &
+                            sm1x , em1x , sm2x , em2x , sm3x , em3x
+   INTEGER               :: sp1y , ep1y , sp2y , ep2y , sp3y , ep3y , &
+                            sm1y , em1y , sm2y , em2y , sm3y , em3y
+   INTEGER, INTENT(INOUT):: id  , domdesc , parent_id , parent_domdesc
+
+   TYPE(domain), POINTER :: parent
+   TYPE(domain), POINTER :: grid_ptr
+
+   ! this is necessary because we cannot pass parent directly into 
+   ! wrf_dm_patch_domain because creating the correct interface definitions
+   ! would generate a circular USE reference between module_domain and module_dm
+   ! see comment this date in module_domain for more information. JM 20020416
+
+   NULLIFY( parent )
+   grid_ptr => head_grid
+   CALL find_grid_by_id( parent_id , grid_ptr , parent )
+
+   CALL patch_domain_rsl_lite ( id  , parent, parent_id , &
+                           sd1 , ed1 , sp1 , ep1 , sm1 , em1 , & 
+                           sd2 , ed2 , sp2 , ep2 , sm2 , em2 , &
+                           sd3 , ed3 , sp3 , ep3 , sm3 , em3 , &
+                           bdx , bdy )
+
+   RETURN
+END SUBROUTINE wrf_dm_patch_domain
+
+SUBROUTINE wrf_termio_dup
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+  INTEGER mytask, ntasks, ierr
+  CALL mpi_comm_size(MPI_COMM_WORLD, ntasks, ierr )
+  CALL mpi_comm_rank(MPI_COMM_WORLD, mytask, ierr )
+  write(0,*)'starting wrf task ',mytask,' of ',ntasks
+  CALL rsl_error_dup1( mytask )
+END SUBROUTINE wrf_termio_dup
+
+SUBROUTINE wrf_get_myproc( myproc )
+  USE module_dm
+  IMPLICIT NONE
+  INTEGER myproc
+  myproc = mytask
+  RETURN
+END SUBROUTINE wrf_get_myproc
+
+SUBROUTINE wrf_get_nproc( nproc )
+  USE module_dm
+  IMPLICIT NONE
+  INTEGER nproc
+  nproc = ntasks
+  RETURN
+END SUBROUTINE wrf_get_nproc
+
+SUBROUTINE wrf_get_nprocx( nprocx )
+  USE module_dm
+  IMPLICIT NONE
+  INTEGER nprocx
+  nprocx = ntasks_x
+  RETURN
+END SUBROUTINE wrf_get_nprocx
+
+SUBROUTINE wrf_get_nprocy( nprocy )
+  USE module_dm
+  IMPLICIT NONE
+  INTEGER nprocy
+  nprocy = ntasks_y
+  RETURN
+END SUBROUTINE wrf_get_nprocy
+
+SUBROUTINE wrf_dm_bcast_bytes ( buf , size )
+   USE module_dm
+   IMPLICIT NONE
+   INCLUDE 'mpif.h'
+   INTEGER size
+#ifndef NEC
+   INTEGER*1 BUF(size)
+#else
+   CHARACTER*1 BUF(size)
+#endif
+   CALL BYTE_BCAST ( buf , size, local_communicator )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_bytes
+
+SUBROUTINE wrf_dm_bcast_string( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+! <DESCRIPTION>
+! Collective operation. Given a string and a size in characters on task zero, broadcast and return that buffer on all tasks.
+!
+! </DESCRIPTION>
+   CHARACTER*(*) buf
+   INTEGER ibuf(256),i,n
+   CHARACTER*256 tstr
+   n = n1
+   ! Root task is required to have the correct value of N1, other tasks 
+   ! might not have the correct value.  
+   CALL wrf_dm_bcast_integer( n , 1 )
+   IF (n .GT. 256) n = 256
+   IF (n .GT. 0 ) then
+     DO i = 1, n
+       ibuf(I) = ichar(buf(I:I))
+     ENDDO
+     CALL wrf_dm_bcast_integer( ibuf, n )
+     buf = ''
+     DO i = 1, n
+       buf(i:i) = char(ibuf(i))
+     ENDDO
+   ENDIF
+   RETURN
+END SUBROUTINE wrf_dm_bcast_string
+
+SUBROUTINE wrf_dm_bcast_integer( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   INTEGER  buf(*)
+   CALL wrf_dm_bcast_bytes ( BUF , N1 * IWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_integer
+
+SUBROUTINE wrf_dm_bcast_double( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   DOUBLEPRECISION  buf(*)
+   CALL wrf_dm_bcast_bytes ( BUF , N1 * DWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_double
+
+SUBROUTINE wrf_dm_bcast_real( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   REAL  buf(*)
+   CALL wrf_dm_bcast_bytes ( BUF , N1 * RWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_real
+
+SUBROUTINE wrf_dm_bcast_logical( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   LOGICAL  buf(*)
+   CALL wrf_dm_bcast_bytes ( BUF , N1 * LWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_logical
+
+SUBROUTINE write_68( grid, v , s , &
+                   ids, ide, jds, jde, kds, kde, &
+                   ims, ime, jms, jme, kms, kme, &
+                   its, ite, jts, jte, kts, kte )
+  USE module_domain
+  IMPLICIT NONE
+  TYPE(domain) , INTENT (INOUT) :: grid 
+  CHARACTER *(*) s
+  INTEGER ids, ide, jds, jde, kds, kde, &
+          ims, ime, jms, jme, kms, kme, &
+          its, ite, jts, jte, kts, kte
+  REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: v
+
+  INTEGER i,j,k,ierr
+
+  logical, external :: wrf_dm_on_monitor
+  real globbuf( ids:ide, kds:kde, jds:jde )
+  character*3 ord, stag
+
+  if ( kds == kde ) then
+    ord = 'xy'
+    stag = 'xy'
+  CALL wrf_patch_to_global_real ( v, globbuf, grid%domdesc, stag, ord, &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+  else
+
+    stag = 'xyz' 
+    ord = 'xzy'
+  CALL wrf_patch_to_global_real ( v, globbuf, grid%domdesc, stag, ord, &
+                     ids, ide, kds, kde, jds, jde, &
+                     ims, ime, kms, kme, jms, jme, &
+                     its, ite, kts, kte, jts, jte )
+  endif
+
+
+  if ( wrf_dm_on_monitor() ) THEN
+    WRITE(68,*) ide-ids+1, jde-jds+1 , s
+    DO j = jds, jde
+    DO i = ids, ide
+       WRITE(68,*) globbuf(i,1,j)
+    ENDDO
+    ENDDO
+  endif
+
+  RETURN
+END
+
+   SUBROUTINE wrf_abort
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER ierr
+      CALL mpi_abort(MPI_COMM_WORLD,1,ierr)
+   END SUBROUTINE wrf_abort
+
+   SUBROUTINE wrf_dm_shutdown
+      IMPLICIT NONE
+      INTEGER ierr
+      CALL MPI_FINALIZE( ierr )
+      RETURN
+   END SUBROUTINE wrf_dm_shutdown
+
+   LOGICAL FUNCTION wrf_dm_on_monitor()
+      USE module_dm
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER tsk, ierr, mpi_comm_local
+      CALL wrf_get_dm_communicator( mpi_comm_local )
+      CALL mpi_comm_rank ( mpi_comm_local, tsk , ierr )
+      wrf_dm_on_monitor = tsk .EQ. 0
+      RETURN
+   END FUNCTION wrf_dm_on_monitor
+
+   SUBROUTINE wrf_get_dm_communicator ( communicator )
+      USE module_dm
+      IMPLICIT NONE
+      INTEGER , INTENT(OUT) :: communicator
+      communicator = local_communicator
+      RETURN
+   END SUBROUTINE wrf_get_dm_communicator
+
+   SUBROUTINE wrf_get_dm_iocommunicator ( iocommunicator )
+      USE module_dm
+      IMPLICIT NONE
+      INTEGER , INTENT(OUT) :: iocommunicator
+      iocommunicator = local_iocommunicator
+      RETURN
+   END SUBROUTINE wrf_get_dm_iocommunicator
+
+   SUBROUTINE wrf_set_dm_communicator ( communicator )
+      USE module_dm
+      IMPLICIT NONE
+      INTEGER , INTENT(IN) :: communicator
+      local_communicator = communicator
+      RETURN
+   END SUBROUTINE wrf_set_dm_communicator
+
+   SUBROUTINE wrf_set_dm_iocommunicator ( iocommunicator )
+      USE module_dm
+      IMPLICIT NONE
+      INTEGER , INTENT(IN) :: iocommunicator
+      local_iocommunicator = iocommunicator
+      RETURN
+   END SUBROUTINE wrf_set_dm_iocommunicator
+
+
+!!!!!!!!!!!!!!!!!!!!!!! PATCH TO GLOBAL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE wrf_patch_to_global_real (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       REAL globbuf(*)
+       REAL buf(*)
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,RWORDSIZE,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_real 
+
+   SUBROUTINE wrf_patch_to_global_double (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       DOUBLEPRECISION globbuf(*)
+       DOUBLEPRECISION buf(*)
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,DWORDSIZE,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_double
+
+
+   SUBROUTINE wrf_patch_to_global_integer (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       INTEGER globbuf(*)
+       INTEGER buf(*)
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,IWORDSIZE,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_integer 
+
+
+   SUBROUTINE wrf_patch_to_global_logical (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       LOGICAL globbuf(*)
+       LOGICAL buf(*)
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,LWORDSIZE,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_logical
+
+#ifdef DEREF_KLUDGE
+#  define FRSTELEM (1)
+#else
+#  define FRSTELEM
+#endif
+
+   SUBROUTINE wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,typesize,&
+                                       DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3a )
+       USE module_driver_constants
+       USE module_timing
+       USE module_wrf_error
+       USE module_dm
+       IMPLICIT NONE
+       INTEGER                         DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3A 
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       INTEGER                         ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+       CHARACTER *(*) stagger,ordering
+       LOGICAL, EXTERNAL :: wrf_dm_on_monitor, has_char
+       INTEGER fid,domdesc,typesize,ierr
+       REAL globbuf(*)
+       REAL buf(*)
+
+       INTEGER i, j, k,  ndim
+       INTEGER  Patch(3,2), Gpatch(3,2,ntasks)
+    ! allocated further down, after the D indices are potentially recalculated for staggering
+       REAL, ALLOCATABLE :: tmpbuf( : )
+       REAL locbuf( (PE1a-PS1a+1)*(PE2a-PS2a+1)*(PE3a-PS3a+1)/RWORDSIZE*typesize+32 )
+
+       DS1 = DS1a ; DE1 = DE1a ; DS2=DS2a ; DE2 = DE2a ; DS3 = DS3a ; DE3 = DE3a
+       MS1 = MS1a ; ME1 = ME1a ; MS2=MS2a ; ME2 = ME2a ; MS3 = MS3a ; ME3 = ME3a
+       PS1 = PS1a ; PE1 = PE1a ; PS2=PS2a ; PE2 = PE2a ; PS3 = PS3a ; PE3 = PE3a
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xy', 'yx' )
+           ndim = 2
+         CASE DEFAULT
+           ndim = 3   ! where appropriate
+       END SELECT
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xyz','xy' )
+            ! the non-staggered variables come in at one-less than
+            ! domain dimensions, but code wants full domain spec, so
+            ! adjust if not staggered
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE2 = DE2+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'yxz','yx' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE1 = DE1+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'zxy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE1 = DE1+1
+         CASE ( 'xzy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE2 = DE2+1
+         CASE DEFAULT
+       END SELECT
+
+     ! moved to here to be after the potential recalculations of D dims
+       IF ( wrf_dm_on_monitor() ) THEN
+         ALLOCATE ( tmpbuf ( (DE1-DS1+1)*(DE2-DS2+1)*(DE3-DS3+1)/RWORDSIZE*typesize+32 ), STAT=ierr )
+       ELSE
+         ALLOCATE ( tmpbuf ( 1 ), STAT=ierr )
+       ENDIF
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating tmpbuf in wrf_patch_to_global_generic')
+ 
+       Patch(1,1) = ps1 ; Patch(1,2) = pe1    ! use patch dims
+       Patch(2,1) = ps2 ; Patch(2,2) = pe2
+       Patch(3,1) = ps3 ; Patch(3,2) = pe3
+
+       IF      ( typesize .EQ. RWORDSIZE ) THEN
+         CALL just_patch_r ( buf , locbuf , size(locbuf), &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. IWORDSIZE ) THEN
+         CALL just_patch_i ( buf , locbuf , size(locbuf), &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. DWORDSIZE ) THEN
+         CALL just_patch_d ( buf , locbuf , size(locbuf), &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. LWORDSIZE ) THEN
+         CALL just_patch_l ( buf , locbuf , size(locbuf), &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ENDIF
+
+! defined in external/io_quilt
+       CALL collect_on_comm0 (  local_communicator , IWORDSIZE ,  &
+                                Patch , 6 ,                       &
+                                GPatch , 6*ntasks                 )
+
+       CALL collect_on_comm0 (  local_communicator , typesize ,  &
+                                locbuf , (pe1-ps1+1)*(pe2-ps2+1)*(pe3-ps3+1),   &
+                                tmpbuf FRSTELEM , (de1-ds1+1)*(de2-ds2+1)*(de3-ds3+1) )
+
+       ndim = len(TRIM(ordering))
+
+       IF ( wrf_at_debug_level(500) ) THEN
+         CALL start_timing
+       ENDIF
+
+       IF ( ndim .GE. 2 .AND. wrf_dm_on_monitor() ) THEN
+
+         IF      ( typesize .EQ. RWORDSIZE ) THEN
+	   CALL patch_2_outbuf_r ( tmpbuf FRSTELEM , globbuf ,             &
+				   DS1, DE1, DS2, DE2, DS3, DE3 , &
+				   GPATCH                         )
+	 ELSE IF ( typesize .EQ. IWORDSIZE ) THEN
+	   CALL patch_2_outbuf_i ( tmpbuf FRSTELEM , globbuf ,             &
+				   DS1, DE1, DS2, DE2, DS3, DE3 , &
+				   GPATCH                         )
+	 ELSE IF ( typesize .EQ. DWORDSIZE ) THEN
+	   CALL patch_2_outbuf_d ( tmpbuf FRSTELEM , globbuf ,             &
+				   DS1, DE1, DS2, DE2, DS3, DE3 , &
+				   GPATCH                         )
+	 ELSE IF ( typesize .EQ. LWORDSIZE ) THEN
+	   CALL patch_2_outbuf_l ( tmpbuf FRSTELEM , globbuf ,             &
+				   DS1, DE1, DS2, DE2, DS3, DE3 , &
+				   GPATCH                         )
+	 ENDIF
+
+       ENDIF
+
+       IF ( wrf_at_debug_level(500) ) THEN
+         CALL end_timing('wrf_patch_to_global_generic')
+       ENDIF
+       DEALLOCATE( tmpbuf )
+       RETURN
+    END SUBROUTINE wrf_patch_to_global_generic
+
+  SUBROUTINE just_patch_i ( inbuf , outbuf, noutbuf,     &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER                         , INTENT(IN)  :: noutbuf
+    INTEGER    , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    INTEGER    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( icurs )  = inbuf( i, j, k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE just_patch_i
+
+  SUBROUTINE just_patch_r ( inbuf , outbuf, noutbuf,     &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER                      , INTENT(IN)  :: noutbuf
+    REAL    , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    REAL    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(in) :: inbuf
+! Local
+    INTEGER               :: i,j,k   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2 
+          DO i = PS1, PE1
+            outbuf( icurs )  = inbuf( i, j, k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE just_patch_r
+
+  SUBROUTINE just_patch_d ( inbuf , outbuf, noutbuf,     &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER                                  , INTENT(IN)  :: noutbuf
+    DOUBLE PRECISION    , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    DOUBLE PRECISION    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(in) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2 
+          DO i = PS1, PE1
+            outbuf( icurs )  = inbuf( i, j, k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE just_patch_d
+
+  SUBROUTINE just_patch_l ( inbuf , outbuf, noutbuf,     &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER                         , INTENT(IN)  :: noutbuf
+    LOGICAL    , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    LOGICAL    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(in) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2 
+          DO i = PS1, PE1
+            outbuf( icurs )  = inbuf( i, j, k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE just_patch_l
+
+
+  SUBROUTINE patch_2_outbuf_r( inbuf, outbuf,            &
+                               DS1,DE1,DS2,DE2,DS3,DE3,  &
+                               GPATCH ) 
+    USE module_dm
+    IMPLICIT NONE
+    REAL    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    REAL    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( i, j, k ) = inbuf( icurs )
+            icurs = icurs + 1
+	  ENDDO
+	ENDDO
+      ENDDO
+    ENDDO
+
+    RETURN
+  END SUBROUTINE patch_2_outbuf_r
+
+  SUBROUTINE patch_2_outbuf_i( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    INTEGER    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( i, j, k ) = inbuf( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE patch_2_outbuf_i
+
+  SUBROUTINE patch_2_outbuf_d( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    DOUBLE PRECISION    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    DOUBLE PRECISION    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( i, j, k ) = inbuf( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE patch_2_outbuf_d
+
+  SUBROUTINE patch_2_outbuf_l( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    LOGICAL    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    LOGICAL    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( i, j, k ) = inbuf( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE patch_2_outbuf_l
+
+!!!!!!!!!!!!!!!!!!!!!!! GLOBAL TO PATCH !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    SUBROUTINE wrf_global_to_patch_real (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       REAL globbuf(*)
+       REAL buf(*)
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,RWORDSIZE,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_real
+
+    SUBROUTINE wrf_global_to_patch_double (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       DOUBLEPRECISION globbuf(*)
+       DOUBLEPRECISION buf(*)
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,DWORDSIZE,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_double
+
+
+    SUBROUTINE wrf_global_to_patch_integer (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       INTEGER globbuf(*)
+       INTEGER buf(*)
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,IWORDSIZE,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_integer
+
+    SUBROUTINE wrf_global_to_patch_logical (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       LOGICAL globbuf(*)
+       LOGICAL buf(*)
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,LWORDSIZE,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_logical
+
+    SUBROUTINE wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,typesize,&
+                                       DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3a )
+       USE module_dm
+       USE module_driver_constants
+       IMPLICIT NONE
+       INTEGER                         DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3A 
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc,typesize,ierr
+       REAL globbuf(*)
+       REAL buf(*)
+       LOGICAL, EXTERNAL :: wrf_dm_on_monitor, has_char
+
+       INTEGER i,j,k,ord,ord2d,ndim
+       INTEGER  Patch(3,2), Gpatch(3,2,ntasks)
+       REAL, ALLOCATABLE :: tmpbuf( : )
+       REAL locbuf( (PE1a-PS1a+1)*(PE2a-PS2a+1)*(PE3a-PS3a+1)/RWORDSIZE*typesize+32 )
+
+       DS1 = DS1a ; DE1 = DE1a ; DS2=DS2a ; DE2 = DE2a ; DS3 = DS3a ; DE3 = DE3a
+       MS1 = MS1a ; ME1 = ME1a ; MS2=MS2a ; ME2 = ME2a ; MS3 = MS3a ; ME3 = ME3a
+       PS1 = PS1a ; PE1 = PE1a ; PS2=PS2a ; PE2 = PE2a ; PS3 = PS3a ; PE3 = PE3a
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xy', 'yx' )
+           ndim = 2
+         CASE DEFAULT
+           ndim = 3   ! where appropriate
+       END SELECT
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xyz','xy' )
+            ! the non-staggered variables come in at one-less than
+            ! domain dimensions, but code wants full domain spec, so
+            ! adjust if not staggered
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE2 = DE2+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'yxz','yx' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE1 = DE1+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'zxy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE1 = DE1+1
+         CASE ( 'xzy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE2 = DE2+1
+         CASE DEFAULT
+       END SELECT
+
+     ! moved to here to be after the potential recalculations of D dims
+       IF ( wrf_dm_on_monitor() ) THEN
+         ALLOCATE ( tmpbuf ( (DE1-DS1+1)*(DE2-DS2+1)*(DE3-DS3+1)/RWORDSIZE*typesize+32 ), STAT=ierr )
+       ELSE
+         ALLOCATE ( tmpbuf ( 1 ), STAT=ierr )
+       ENDIF
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating tmpbuf in wrf_global_to_patch_generic')
+
+       Patch(1,1) = ps1 ; Patch(1,2) = pe1    ! use patch dims
+       Patch(2,1) = ps2 ; Patch(2,2) = pe2
+       Patch(3,1) = ps3 ; Patch(3,2) = pe3
+
+! defined in external/io_quilt
+       CALL collect_on_comm0 (  local_communicator , IWORDSIZE ,  &
+                                Patch , 6 ,                       &
+                                GPatch , 6*ntasks                 )
+
+       ndim = len(TRIM(ordering))
+
+       IF ( wrf_dm_on_monitor() .AND. ndim .GE. 2 ) THEN
+         IF      ( typesize .EQ. RWORDSIZE ) THEN
+           CALL outbuf_2_patch_r ( globbuf , tmpbuf FRSTELEM ,    &
+                                   DS1, DE1, DS2, DE2, DS3, DE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3 , &
+                                   GPATCH                         )
+         ELSE IF ( typesize .EQ. IWORDSIZE ) THEN
+           CALL outbuf_2_patch_i ( globbuf , tmpbuf FRSTELEM ,    &
+                                   DS1, DE1, DS2, DE2, DS3, DE3 , &
+                                   GPATCH                         )
+         ELSE IF ( typesize .EQ. DWORDSIZE ) THEN
+           CALL outbuf_2_patch_d ( globbuf , tmpbuf FRSTELEM ,    &
+                                   DS1, DE1, DS2, DE2, DS3, DE3 , &
+                                   GPATCH                         )
+         ELSE IF ( typesize .EQ. LWORDSIZE ) THEN
+           CALL outbuf_2_patch_l ( globbuf , tmpbuf FRSTELEM ,    &
+                                   DS1, DE1, DS2, DE2, DS3, DE3 , &
+                                   GPATCH                         )
+         ENDIF
+       ENDIF
+
+       CALL dist_on_comm0 (  local_communicator , typesize ,  &
+                             tmpbuf FRSTELEM , (de1-ds1+1)*(de2-ds2+1)*(de3-ds3+1) , &
+                             locbuf    , (pe1-ps1+1)*(pe2-ps2+1)*(pe3-ps3+1) )
+
+       IF      ( typesize .EQ. RWORDSIZE ) THEN
+         CALL all_sub_r ( locbuf , buf ,             &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+
+       ELSE IF ( typesize .EQ. IWORDSIZE ) THEN
+         CALL all_sub_i ( locbuf , buf ,             &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. DWORDSIZE ) THEN
+         CALL all_sub_d ( locbuf , buf ,             &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. LWORDSIZE ) THEN
+         CALL all_sub_l ( locbuf , buf ,             &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ENDIF
+
+
+       DEALLOCATE ( tmpbuf )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_generic
+
+  SUBROUTINE all_sub_i ( inbuf , outbuf,              &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    INTEGER    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( i, j, k )  = inbuf ( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE all_sub_i
+
+  SUBROUTINE all_sub_r ( inbuf , outbuf,              &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    REAL       , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    REAL       , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( i, j, k )  = inbuf ( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+
+    RETURN
+  END SUBROUTINE all_sub_r
+
+  SUBROUTINE all_sub_d ( inbuf , outbuf,              &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    DOUBLE PRECISION    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    DOUBLE PRECISION    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( i, j, k )  = inbuf ( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE all_sub_d
+
+  SUBROUTINE all_sub_l ( inbuf , outbuf,              &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    LOGICAL    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    LOGICAL    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( i, j, k )  = inbuf ( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE all_sub_l
+
+
+  SUBROUTINE outbuf_2_patch_r( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               MS1, ME1, MS2, ME2, MS3, ME3 , &
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    REAL    , DIMENSION(*) , INTENT(OUT) :: outbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    REAL    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( icurs ) = inbuf( i,j,k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE outbuf_2_patch_r
+
+  SUBROUTINE outbuf_2_patch_i( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER    , DIMENSION(*) , INTENT(OUT) :: outbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    INTEGER    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( icurs ) = inbuf( i,j,k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE outbuf_2_patch_i
+
+  SUBROUTINE outbuf_2_patch_d( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    DOUBLE PRECISION    , DIMENSION(*) , INTENT(OUT) :: outbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    DOUBLE PRECISION    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( icurs ) = inbuf( i,j,k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE outbuf_2_patch_d
+
+  SUBROUTINE outbuf_2_patch_l( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    LOGICAL    , DIMENSION(*) , INTENT(OUT) :: outbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    LOGICAL    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( icurs ) = inbuf( i,j,k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE outbuf_2_patch_l
+
+
+
+!------------------------------------------------------------------
+
+#if ( EM_CORE == 1 )
+
+!------------------------------------------------------------------
+
+   SUBROUTINE force_domain_em_part2 ( grid, ngrid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <em_dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+#include "em_nest_interpdown_unpack.inc"
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_EM_FORCE_DOWN.inc"
+
+      ! code here to interpolate the data into the nested domain
+#  include "em_nest_forcedown_interp.inc"
+
+      RETURN
+   END SUBROUTINE force_domain_em_part2
+
+!------------------------------------------------------------------
+
+   SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_timing
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+#include <em_dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      INTEGER iparstrt,jparstrt,sw
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          iids, iide, ijds, ijde, ikds, ikde,    &
+                                iims, iime, ijms, ijme, ikms, ikme,    &
+                                iips, iipe, ijps, ijpe, ikps, ikpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+
+      INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr
+      INTEGER local_comm, myproc, nproc
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  intermediate_grid ,              &
+                                iids, iide, ijds, ijde, ikds, ikde,    &
+                                iims, iime, ijms, ijme, ikms, ikme,    &
+                                iips, iipe, ijps, ijpe, ikps, ikpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      CALL nl_get_parent_grid_ratio ( ngrid%id, pgr )
+      CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt )
+      CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt )
+      CALL nl_get_shw            ( intermediate_grid%id, sw )
+      icoord =    iparstrt - sw
+      jcoord =    jparstrt - sw
+      idim_cd = iide - iids + 1
+      jdim_cd = ijde - ijds + 1
+
+      nlev  = ckde - ckds + 1
+
+#include "em_nest_interpdown_pack.inc"
+
+      CALL rsl_lite_bcast_msgs( myproc, nproc, local_comm )
+
+      RETURN
+   END SUBROUTINE interp_domain_em_part1
+
+!------------------------------------------------------------------
+
+   SUBROUTINE interp_domain_em_part2 ( grid, ngrid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <em_dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+      INTEGER myproc
+      INTEGER ierr
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1 
+
+#include "em_nest_interpdown_unpack.inc"
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_EM_INTERP_DOWN.inc"
+
+#  include "em_nest_interpdown_interp.inc"
+
+      RETURN
+   END SUBROUTINE interp_domain_em_part2
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_nest_prep ( grid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+)
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_state_description
+      IMPLICIT NONE
+!
+      TYPE(domain), TARGET :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE (grid_config_rec_type) :: config_flags ! configureation flags, has vertical dim of 
+                                                  ! soil temp, moisture, etc., has vertical dim
+                                                  ! of soil categories
+#include <em_dummy_new_decl.inc>
+
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+
+      INTEGER       :: idum1, idum2
+
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#ifdef DM_PARALLEL
+#include "HALO_EM_INTERP_UP.inc"
+#endif
+
+   END SUBROUTINE feedback_nest_prep
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_domain_em_part1 ( grid, ngrid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <em_dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE(domain), POINTER :: xgrid
+      TYPE (grid_config_rec_type)            :: config_flags, nconfig_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER local_comm, myproc, nproc, idum1, idum2
+
+      INTERFACE
+          SUBROUTINE feedback_nest_prep ( grid, config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+)
+             USE module_domain
+             USE module_configure
+             USE module_dm
+             USE module_state_description
+!
+             TYPE (grid_config_rec_type)            :: config_flags
+             TYPE(domain), TARGET                   :: grid
+#include <em_dummy_new_decl.inc>
+          END SUBROUTINE feedback_nest_prep
+      END INTERFACE
+!
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+!
+! intermediate grid
+      CALL get_ijk_from_grid (  grid ,                                 &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+! nest grid
+      CALL get_ijk_from_grid (  ngrid ,                                &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+      ips_save = ngrid%i_parent_start   ! used in feedback_domain_em_part2 below
+      jps_save = ngrid%j_parent_start
+      ipe_save = ngrid%i_parent_start + (nide-nids+1) / ngrid%parent_grid_ratio - 1
+      jpe_save = ngrid%j_parent_start + (njde-njds+1) / ngrid%parent_grid_ratio - 1
+
+! feedback_nest_prep invokes a halo exchange on the ngrid. It is done this way
+! in a separate routine because the HALOs need the data to be dereference from the
+! grid data structure and, in this routine, the dereferenced fields are related to
+! the intermediate domain, not the nest itself. Save the current grid pointer to intermediate
+! domain, switch grid to point to ngrid, invoke feedback_nest_prep,  then restore grid
+! to point to intermediate domain.
+
+      CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags )
+      CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 )
+      xgrid => grid
+      grid => ngrid
+
+      CALL feedback_nest_prep ( grid, nconfig_flags    &
+!
+#include "em_actual_new_args.inc"
+!
+)
+
+! put things back so grid is intermediate grid
+
+      grid => xgrid
+      CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
+
+! "interp" (basically copy) ngrid onto intermediate grid
+
+#include "em_nest_feedbackup_interp.inc"
+
+      RETURN
+   END SUBROUTINE feedback_domain_em_part1
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid, ngrid , config_flags    &
+!
+#include "em_dummy_new_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_utility
+      IMPLICIT NONE
+
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+
+#include <em_dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+      INTEGER icoord, jcoord, idim_cd, jdim_cd
+      INTEGER local_comm, myproc, nproc
+      INTEGER iparstrt, jparstrt, sw
+      REAL    nest_influence
+
+      character*256 :: timestr
+      integer ierr
+
+      LOGICAL, EXTERNAL  :: em_cd_feedback_mask
+
+! On entry to this routine, 
+!  "grid" refers to the parent domain
+!  "intermediate_grid" refers to local copy of parent domain that overlies this patch of nest
+!  "ngrid" refers to the nest, which is only needed for smoothing on the parent because 
+!          the nest feedback data has already been transferred during em_nest_feedbackup_interp
+!          in part1, above.
+! The way these settings c and n dimensions are set, below, looks backwards but from the point 
+! of view of the RSL routine rsl_lite_to_parent_info(), call to which is included by 
+! em_nest_feedbackup_pack, the "n" domain represents the parent domain and the "c" domain
+! represents the intermediate domain. The backwards lookingness should be fixed in the gen_comms.c
+! registry routine that accompanies RSL_LITE but, just as it's sometimes easier to put up a road
+! sign that says "DIP" than fix the dip,  at this point it was easier just to write this comment. JM
+!
+      nest_influence = 1.
+
+      CALL domain_clock_get( grid, current_timestr=timestr )
+
+      CALL get_ijk_from_grid (  intermediate_grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  grid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt )
+      CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt )
+      CALL nl_get_shw            ( intermediate_grid%id, sw )
+      icoord =    iparstrt - sw
+      jcoord =    jparstrt - sw
+      idim_cd = cide - cids + 1
+      jdim_cd = cjde - cjds + 1
+
+      nlev  = ckde - ckds + 1
+
+#include "em_nest_feedbackup_pack.inc"
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+      CALL rsl_lite_merge_msgs( myproc, nproc, local_comm )
+
+#define NEST_INFLUENCE(A,B) A = B
+#include "em_nest_feedbackup_unpack.inc"
+
+      ! smooth coarse grid
+      CALL get_ijk_from_grid (  ngrid,                           &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_EM_INTERP_UP.inc"
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+
+#include "em_nest_feedbackup_smooth.inc"
+
+      RETURN
+   END SUBROUTINE feedback_domain_em_part2
+#endif
+
+#if ( NMM_CORE == 1 && NMM_NEST == 1 )
+!==============================================================================
+! NMM nesting infrastructure extended from EM core. This is gopal's doing.
+!==============================================================================
+
+   SUBROUTINE interp_domain_nmm_part1 ( grid, intermediate_grid, ngrid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_timing
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+#include <nmm_dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      INTEGER iparstrt,jparstrt,sw
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          iids, iide, ijds, ijde, ikds, ikde,    &
+                                iims, iime, ijms, ijme, ikms, ikme,    &
+                                iips, iipe, ijps, ijpe, ikps, ikpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+
+      INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr
+      INTEGER local_comm, myproc, nproc
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  intermediate_grid ,              &
+                                iids, iide, ijds, ijde, ikds, ikde,    &
+                                iims, iime, ijms, ijme, ikms, ikme,    &
+                                iips, iipe, ijps, ijpe, ikps, ikpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      CALL nl_get_parent_grid_ratio ( ngrid%id, pgr )
+      CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt )
+      CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt )
+      CALL nl_get_shw            ( intermediate_grid%id, sw )
+      icoord =    iparstrt - sw
+      jcoord =    jparstrt - sw
+      idim_cd = iide - iids + 1
+      jdim_cd = ijde - ijds + 1
+
+      nlev  = ckde - ckds + 1
+
+#include "nmm_nest_interpdown_pack.inc"
+
+      CALL rsl_lite_bcast_msgs( myproc, nproc, local_comm )
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+      RETURN
+   END SUBROUTINE interp_domain_nmm_part1
+
+!------------------------------------------------------------------
+
+   SUBROUTINE interp_domain_nmm_part2 ( grid, ngrid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <nmm_dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+      INTEGER myproc
+      INTEGER ierr
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+#include "deref_kludge.h"
+
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1 
+
+#include "nmm_nest_interpdown_unpack.inc"
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_NMM_INTERP_DOWN1.inc"
+
+#include "nmm_nest_interpdown_interp.inc"
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+
+      RETURN
+   END SUBROUTINE interp_domain_nmm_part2
+
+!------------------------------------------------------------------
+
+   SUBROUTINE force_domain_nmm_part1 ( grid, intermediate_grid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_timing
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+#include <nmm_dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+!
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+
+      CALL get_ijk_from_grid (  intermediate_grid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+#include "nmm_nest_forcedown_pack.inc"
+
+!   WRITE(0,*)'I have completed PACKING of BCs data successfully'
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+      RETURN
+   END SUBROUTINE force_domain_nmm_part1
+
+!==============================================================================================
+
+   SUBROUTINE force_domain_nmm_part2 ( grid, ngrid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <nmm_dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+integer myproc
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+#include "deref_kludge.h"
+
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+#include "nmm_nest_interpdown_unpack.inc"
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_NMM_FORCE_DOWN1.inc"
+
+      ! code here to interpolate the data into the nested domain
+#include "nmm_nest_forcedown_interp.inc"
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+
+      RETURN
+   END SUBROUTINE force_domain_nmm_part2
+
+!================================================================================
+!
+! This routine exists only to call a halo on a domain (the nest)
+! gets called from feedback_domain_em_part1, below.  This is needed
+! because the halo code expects the fields being exchanged to have
+! been dereferenced from the grid data structure, but in feedback_domain_em_part1
+! the grid data structure points to the coarse domain, not the nest.
+! And we want the halo exchange on the nest, so that the code in
+! em_nest_feedbackup_interp.inc will work correctly on multi-p. JM 20040308
+!
+
+   SUBROUTINE feedback_nest_prep_nmm ( grid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+)
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_state_description
+      IMPLICIT NONE
+!
+      TYPE(domain), TARGET :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE (grid_config_rec_type) :: config_flags ! configureation flags, has vertical dim of
+                                                  ! soil temp, moisture, etc., has vertical dim
+                                                  ! of soil categories
+#include <nmm_dummy_decl.inc>
+
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+
+      INTEGER       :: idum1, idum2
+
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+#include "deref_kludge.h"
+
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#ifdef DM_PARALLEL
+#include "HALO_NMM_WEIGHTS.inc"
+#endif
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+
+   END SUBROUTINE feedback_nest_prep_nmm
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_domain_nmm_part1 ( grid, ngrid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <nmm_dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE(domain), POINTER :: xgrid
+      TYPE (grid_config_rec_type)            :: config_flags, nconfig_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER local_comm, myproc, nproc, idum1, idum2
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+      INTERFACE
+          SUBROUTINE feedback_nest_prep_nmm ( grid, config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+)
+             USE module_domain
+             USE module_configure
+             USE module_dm
+             USE module_state_description
+!
+             TYPE (grid_config_rec_type)            :: config_flags
+             TYPE(domain), TARGET                   :: grid
+#include <nmm_dummy_decl.inc>
+          END SUBROUTINE feedback_nest_prep_nmm
+      END INTERFACE
+!
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+
+!
+! intermediate grid
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+! nest grid
+      CALL get_ijk_from_grid (  ngrid ,                  &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+      ips_save = ngrid%i_parent_start  ! +1 not used in ipe_save & jpe_save
+      jps_save = ngrid%j_parent_start  !  because of one extra namelist point
+      ipe_save = ngrid%i_parent_start + (nide-nids) / ngrid%parent_grid_ratio
+      jpe_save = ngrid%j_parent_start + (njde-njds) / ngrid%parent_grid_ratio
+
+! feedback_nest_prep invokes a halo exchange on the ngrid. It is done this way
+! in a separate routine because the HALOs need the data to be dereference from the
+! grid data structure and, in this routine, the dereferenced fields are related to
+! the intermediate domain, not the nest itself. Save the current grid pointer to intermediate
+! domain, switch grid to point to ngrid, invoke feedback_nest_prep,  then restore grid
+! to point to intermediate domain.
+
+      CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags )
+      CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 )
+      xgrid => grid
+      grid => ngrid
+#include "deref_kludge.h"
+      CALL feedback_nest_prep_nmm ( grid, config_flags    &
+!
+#include "nmm_actual_args.inc"
+!
+)
+
+! put things back so grid is intermediate grid
+
+      grid => xgrid
+      CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
+
+! "interp" (basically copy) ngrid onto intermediate grid
+
+#include "nmm_nest_feedbackup_interp.inc"
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+      RETURN
+   END SUBROUTINE feedback_domain_nmm_part1
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_domain_nmm_part2 ( grid, intermediate_grid, ngrid , config_flags    &
+!
+#include "nmm_dummy_args.inc"
+!
+                 )
+      USE module_domain
+      USE module_configure
+      USE module_dm
+      USE module_utility
+      IMPLICIT NONE
+
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+
+#include <nmm_dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+      INTEGER icoord, jcoord, idim_cd, jdim_cd
+      INTEGER local_comm, myproc, nproc
+      INTEGER iparstrt, jparstrt, sw
+
+      character*256 :: timestr
+      integer ierr
+
+      REAL    nest_influence
+      LOGICAL, EXTERNAL  :: nmm_cd_feedback_mask
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+#include "deref_kludge.h"
+
+#define COPY_IN
+#include <nmm_scalar_derefs.inc>
+
+! On entry to this routine,
+!  "grid" refers to the parent domain
+!  "intermediate_grid" refers to local copy of parent domain that overlies this patch of nest
+!  "ngrid" refers to the nest, which is only needed for smoothing on the parent because
+!          the nest feedback data has already been transferred during em_nest_feedbackup_interp
+!          in part1, above.
+! The way these settings c and n dimensions are set, below, looks backwards but from the point
+! of view of the RSL routine rsl_lite_to_parent_info(), call to which is included by
+! em_nest_feedbackup_pack, the "n" domain represents the parent domain and the "c" domain
+! represents the intermediate domain. The backwards lookingness should be fixed in the gen_comms.c
+! registry routine that accompanies RSL_LITE but, just as it's sometimes easier to put up a road
+! sign that says "DIP" than fix the dip,  at this point it was easier just to write this comment. JM
+!
+
+      nest_influence = 0.5
+#define NEST_INFLUENCE(A,B) A = nest_influence*(B) + (1.0-nest_influence)*(A)
+
+
+      CALL domain_clock_get( grid, current_timestr=timestr )
+
+      CALL get_ijk_from_grid (  intermediate_grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  grid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nide = nide - 1   !dusan
+      njde = njde - 1   !dusan
+
+      CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt )
+      CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt )
+      CALL nl_get_shw            ( intermediate_grid%id, sw )
+      icoord =    iparstrt  - sw
+      jcoord =    jparstrt  - sw
+      idim_cd = cide - cids + 1
+      jdim_cd = cjde - cjds + 1
+
+      nlev  = ckde - ckds + 1
+
+#include "nmm_nest_feedbackup_pack.inc"
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+      CALL rsl_lite_merge_msgs( myproc, nproc, local_comm )
+
+#include "nmm_nest_feedbackup_unpack.inc"
+
+
+      ! smooth coarse grid
+
+      CALL get_ijk_from_grid (  ngrid,                                 &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe     )
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_NMM_INTERP_UP.inc"
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+
+#include "nmm_nest_feedbackup_smooth.inc"
+
+#define COPY_OUT
+#include <nmm_scalar_derefs.inc>
+      RETURN
+   END SUBROUTINE feedback_domain_nmm_part2
+
+!=================================================================================
+!   End of gopal's doing
+!=================================================================================
+#endif
+
+!------------------------------------------------------------------
+
+   SUBROUTINE wrf_gatherv_real (Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   USE module_dm
+   IMPLICIT NONE
+   INCLUDE 'mpif.h'
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   REAL, DIMENSION(*) :: Field, globbuf
+
+           CALL mpi_gatherv( Field( field_ofst ),      &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            getrealmpitype() ,               &    ! sendtype
+                            globbuf( glob_ofst ) ,                 &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            getrealmpitype()               , &    ! recvtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+
+   END SUBROUTINE wrf_gatherv_real
+
+   SUBROUTINE wrf_gatherv_double (Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   USE module_dm
+   IMPLICIT NONE
+   INCLUDE 'mpif.h'
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   DOUBLE PRECISION, DIMENSION(*) :: Field, globbuf
+
+           CALL mpi_gatherv( Field( field_ofst ),      &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            MPI_DOUBLE_PRECISION         ,               &    ! sendtype
+                            globbuf( glob_ofst ) ,                 &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            MPI_DOUBLE_PRECISION                       , &    ! recvtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+
+   END SUBROUTINE wrf_gatherv_double
+
+   SUBROUTINE wrf_gatherv_integer (Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   IMPLICIT NONE
+   INCLUDE 'mpif.h'
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   INTEGER, DIMENSION(*) :: Field, globbuf
+
+           CALL mpi_gatherv( Field( field_ofst ),      &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            MPI_INTEGER         ,               &    ! sendtype
+                            globbuf( glob_ofst ) ,                 &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            MPI_INTEGER                       , &    ! recvtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+
+   END SUBROUTINE wrf_gatherv_integer
+
+SUBROUTINE wrf_dm_define_comms ( grid )
+   USE module_domain
+   IMPLICIT NONE
+   TYPE(domain) , INTENT (INOUT) :: grid
+   RETURN
+END SUBROUTINE wrf_dm_define_comms
+
+   SUBROUTINE set_dm_debug 
+    USE module_dm
+    IMPLICIT NONE
+    dm_debug_flag = .TRUE.
+   END SUBROUTINE set_dm_debug
+   SUBROUTINE reset_dm_debug 
+    USE module_dm
+    IMPLICIT NONE
+    dm_debug_flag = .FALSE.
+   END SUBROUTINE reset_dm_debug
+   SUBROUTINE get_dm_debug ( arg )
+    USE module_dm
+    IMPLICIT NONE
+    LOGICAL arg
+    arg = dm_debug_flag
+   END SUBROUTINE get_dm_debug
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/period.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/period.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/period.c	(revision 2744)
@@ -0,0 +1,433 @@
+#include <stdio.h>
+#include <fcntl.h>
+
+#define STANDARD_ERROR 2
+
+#define STANDARD_OUTPUT 1
+
+#include "mpi.h"
+#include "rsl_lite.h"
+
+#define F_PACK
+
+static int yp_curs, ym_curs, xp_curs, xm_curs ;
+
+RSL_LITE_INIT_PERIOD ( 
+                int * Fcomm0,
+                int * shw0,
+                int * n3dR0, int *n2dR0, int * typesizeR0 , 
+                int * n3dI0, int *n2dI0, int * typesizeI0 , 
+                int * n3dD0, int *n2dD0, int * typesizeD0 , 
+                int * n3dL0, int *n2dL0, int * typesizeL0 , 
+                int * me0, int * np0 , int * np_x0 , int * np_y0 ,
+                int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
+{
+  int n3dR, n2dR, typesizeR ;
+  int n3dI, n2dI, typesizeI ;
+  int n3dD, n2dD, typesizeD ;
+  int n3dL, n2dL, typesizeL ;
+  int shw ;
+  int me, np, np_x, np_y ;
+  int ips , ipe , jps , jpe , kps , kpe ;
+  int yp, ym, xp, xm ;
+  int nbytes ;
+  int coords[2] ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+
+  shw = *shw0 ;
+  n3dR = *n3dR0 ; n2dR = *n2dR0 ; typesizeR = *typesizeR0 ;
+  n3dI = *n3dI0 ; n2dI = *n2dI0 ; typesizeI = *typesizeI0 ;
+  n3dD = *n3dD0 ; n2dD = *n2dD0 ; typesizeD = *typesizeD0 ;
+  n3dL = *n3dL0 ; n2dL = *n2dL0 ; typesizeL = *typesizeL0 ;
+  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
+
+#if 0
+  if ( np_y > 1 ) {
+    nbytes = typesizeR*(ipe-ips+1+2*shw)*(shw+1)*(n3dR*(kpe-kps+1)+n2dR) +
+             typesizeI*(ipe-ips+1+2*shw)*(shw+1)*(n3dI*(kpe-kps+1)+n2dI) +
+             typesizeD*(ipe-ips+1+2*shw)*(shw+1)*(n3dD*(kpe-kps+1)+n2dD) +
+             typesizeL*(ipe-ips+1+2*shw)*(shw+1)*(n3dL*(kpe-kps+1)+n2dL) ;
+    MPI_Cart_shift( *comm0, 1, 1, &ym, &yp ) ;
+    if ( yp != MPI_PROC_NULL ) {
+       buffer_for_proc ( yp , nbytes, RSL_RECVBUF ) ;
+       buffer_for_proc ( yp , nbytes, RSL_SENDBUF ) ;
+    }
+    if ( ym != MPI_PROC_NULL ) {
+       buffer_for_proc ( ym , nbytes, RSL_RECVBUF ) ;
+       buffer_for_proc ( ym , nbytes, RSL_SENDBUF ) ;
+    }
+  }
+#endif
+  if ( np_x > 1 ) {
+    nbytes = typesizeR*(jpe-jps+1+2*shw)*(shw+1)*(n3dR*(kpe-kps+1)+n2dR) +
+             typesizeI*(jpe-jps+1+2*shw)*(shw+1)*(n3dI*(kpe-kps+1)+n2dI) +
+             typesizeD*(jpe-jps+1+2*shw)*(shw+1)*(n3dD*(kpe-kps+1)+n2dD) +
+             typesizeL*(jpe-jps+1+2*shw)*(shw+1)*(n3dL*(kpe-kps+1)+n2dL) ;
+
+/*
+ this assumes that the topoology associated with the communicator is periodic
+ the period routines should be called with "local_communicator_periodic", which
+ is set up in module_dm.F for RSL_LITE.  Registry generated code automaticall
+ does this (gen_comms.c for RSL_LITE).
+*/
+
+    MPI_Comm_rank( *comm0, &me ) ;
+    MPI_Cart_coords( *comm0, me, 2, coords ) ;
+    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
+    if ( xm != MPI_PROC_NULL && coords[1] == np_x - 1 ) { /* process on right hand side of mesh */
+       buffer_for_proc ( xp , nbytes, RSL_RECVBUF ) ;
+       buffer_for_proc ( xp , nbytes, RSL_SENDBUF ) ;
+    }
+    if ( xp != MPI_PROC_NULL && coords[1] == 0 ) {        /* process on left hand side of mesh */
+       buffer_for_proc ( xm,  nbytes, RSL_RECVBUF ) ;
+       buffer_for_proc ( xm , nbytes, RSL_SENDBUF ) ;
+    }
+  }
+  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
+}
+
+RSL_LITE_PACK_PERIOD_X ( int* Fcomm0, char * buf , int * shw0 , int * typesize0 , int * xy0 , int * pu0 , char * memord , int * xstag0 ,
+           int *me0, int * np0 , int * np_x0 , int * np_y0 , 
+           int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
+           int * ims0 , int * ime0 , int * jms0 , int * jme0 , int * kms0 , int * kme0 ,
+           int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
+{
+  int me, np, np_x, np_y ;
+  int shw , typesize ;
+  int ids , ide , jds , jde , kds , kde ;
+  int ims , ime , jms , jme , kms , kme ;
+  int ips , ipe , jps , jpe , kps , kpe ;
+  int xstag ;  /* 0 not stag, 1 stag */
+  int xy ;   /* y = 0 , x = 1 */
+  int pu ;   /* pack = 0 , unpack = 1 */
+  register int i, j, k, t ;
+#ifdef crayx1
+  register int i2,i3,i4,i_offset;
+#endif
+  char *p ;
+  int da_buf ;
+  int yp, ym, xp, xm ;
+  int nbytes, ierr ;
+  register int *pi, *qi ;
+  int coords[2], dims[2] ;
+  int js, je, ks, ke, is, ie, wcount ;
+float f ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+
+  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  xstag = *xstag0 ;
+  shw = *shw0 ; typesize = *typesize0 ;
+  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
+  ims = *ims0-1 ; ime = *ime0-1 ; jms = *jms0-1 ; jme = *jme0-1 ; kms = *kms0-1 ; kme = *kme0-1 ;
+  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
+  xy = *xy0 ;
+  pu = *pu0 ;
+
+  dims[0] = np_x ;
+  dims[1] = np_y ;
+
+/* need to adapt for other memory orders */
+
+#define RANGE(S1,E1,S2,E2,S3,E3,S4,E4) (((E1)-(S1)+1)*((E2)-(S2)+1)*((E3)-(S3)+1)*((E4)-(S4)+1))
+#define IMAX(A) (((A)>ids)?(A):ids)
+#define IMIN(A) (((A)<ide)?(A):ide)
+#define JMAX(A) (((A)>jds)?(A):jds)
+#define JMIN(A) (((A)<jde)?(A):jde)
+
+  da_buf = ( pu == 0 ) ? RSL_SENDBUF : RSL_RECVBUF ;
+
+  if ( np_x > 1 && xy == 1 ) {
+    MPI_Comm_rank( *comm0, &me ) ;
+    MPI_Cart_coords( *comm0, me, 2, coords ) ;
+    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
+    if ( coords[1] == np_x - 1 ) {                /* process on right hand edge of domain */
+      p = buffer_for_proc( xp , 0 , da_buf ) ;
+      if ( pu == 0 ) {
+        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
+        ks = kps           ; ke = kpe ;
+        is = ipe-shw       ; ie = ipe-1         ;
+        nbytes = buffer_size_for_proc( xp , da_buf ) ;
+        if ( xp_curs + RANGE( JMAX(jps-shw), JMIN(jpe+shw), kps, kpe, ipe-shw, ipe-1, 1, typesize ) > nbytes ) {
+	  fprintf(stderr,"memory overwrite in rsl_lite_pack_period_x, right hand X to %d, %d > %d\n",xp,
+	      xp_curs + RANGE( JMAX(jps-shw), JMIN(jpe+shw), kps, kpe, ipe-shw, ipe-1, 1, typesize ), nbytes ) ;
+	  MPI_Abort(MPI_COMM_WORLD, 98) ;
+        }
+        if ( typesize == sizeof(long int) ) {
+          F_PACK_LINT ( buf, p+xp_curs, &js, &je, &ks, &ke, &is, &ie,
+                                        &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xp_curs += wcount*typesize ;
+        } else
+	if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_PACK_INT ( buf, p+xp_curs, &js, &je, &ks, &ke, &is, &ie,
+                                       &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xp_curs += wcount*typesize ;
+#else
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+xp_curs) ;
+	      i = ipe-shw ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = ipe-shw ; i <= ipe-1 ; i++ ) {
+	        *pi++ = *qi++ ;
+	        xp_curs += typesize ;
+	      }
+	    }
+	  }
+#endif
+	}
+	else {
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = ipe-shw ; i <= ipe-1 ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                  *(p+xp_curs) = 
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                  xp_curs++ ;
+                }
+              }
+            }
+          }
+	}
+      } else {
+        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
+        ks = kps           ; ke = kpe ;
+        is = ipe           ; ie = ipe+shw-1+xstag ;
+        if ( typesize == sizeof(long int) ) {
+          F_UNPACK_LINT ( p+xp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                          &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xp_curs += wcount*typesize ;
+        } else
+	if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_UNPACK_INT ( p+xp_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                         &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xp_curs += wcount*typesize ;
+#else
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+xp_curs) ;
+	      i = ipe ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = ipe ; i <= ipe+shw-1+xstag ; i++ ) {
+	        *qi++ = *pi++ ;
+	        xp_curs += typesize ;
+	      }
+	    }
+	  }
+#endif
+	}
+	else {
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = ipe ; i <= ipe+shw-1+xstag ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                  *(p+xp_curs) ;
+                  xp_curs++ ;
+                }
+              }
+            }
+          }
+        }
+      }
+    }
+    if ( coords[1] == 0 ) {         /* process on left hand edge of domain */
+      p = buffer_for_proc( xm , 0 , da_buf ) ;
+      if ( pu == 0 ) {
+        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
+        ks = kps           ; ke = kpe ;
+        is = ips           ; ie = ips+shw-1+xstag ;
+        nbytes = buffer_size_for_proc( xm , da_buf ) ;
+        if ( xm_curs + RANGE( JMAX(jps-shw), JMIN(jpe+shw), kps, kpe, ips, ips+shw-1+xstag, 1, typesize ) > nbytes ) {
+	  fprintf(stderr,"memory overwrite in rsl_lite_pack,  left hand X to %d , %d > %d\n",xm,
+	      xm_curs + RANGE( JMAX(jps-shw), JMIN(jpe+shw), kps, kpe, ips, ips+shw-1+xstag, 1, typesize ), nbytes ) ;
+	  MPI_Abort(MPI_COMM_WORLD, 98) ;
+        }
+        if ( typesize == sizeof(long int) ) {
+          F_PACK_LINT ( buf, p+xm_curs, &js, &je, &ks, &ke, &is, &ie,
+                                        &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xm_curs += wcount*typesize ;
+        } else
+	if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_PACK_INT ( buf, p+xm_curs, &js, &je, &ks, &ke, &is, &ie,
+                                       &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xm_curs += wcount*typesize ;
+#else
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+xm_curs) ;
+	      i = ips ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = ips ; i <= ips+shw-1+xstag ; i++ ) {
+	        *pi++ = *qi++ ;
+	        xm_curs += typesize ;
+	      }
+	    }
+	  }
+#endif
+	}
+	else {
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = ips ; i <= ips+shw-1+xstag ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                  *(p+xm_curs) = 
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                  xm_curs++ ;
+                }
+              }
+            }
+          }
+        }
+      } else {
+        js = JMAX(jps-shw) ; je = JMIN(jpe+shw) ;
+        ks = kps           ; ke = kpe ;
+        is = ips-shw       ; ie = ips-1           ;
+        if ( typesize == sizeof(long int) ) {
+          F_UNPACK_LINT ( p+xm_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                          &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xm_curs += wcount*typesize ;
+        } else
+	if ( typesize == sizeof(int) ) {
+#ifdef F_PACK
+          F_UNPACK_INT ( p+xm_curs, buf, &js, &je, &ks, &ke, &is, &ie,
+                                         &jms,&jme,&kms,&kme,&ims,&ime, &wcount ) ;
+          xm_curs += wcount*typesize ;
+#else
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+xm_curs) ;
+	      i = ips-shw ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+              for ( i = ips-shw ; i <= ips-1 ; i++ ) {
+	        *qi++ = *pi++ ;
+	        xm_curs += typesize ;
+	      }
+	    }
+	  }
+#endif
+	}
+	else {
+          for ( j = JMAX(jps-shw) ; j <= JMIN(jpe+shw) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( i = ips-shw ; i <= ips-1 ; i++ ) {
+                for ( t = 0 ; t < typesize ; t++ ) {
+                                 *(buf + t + typesize*(
+                                        (i-ims) + (ime-ims+1)*(
+                                        (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                  *(p+xm_curs) ;
+                  xm_curs++ ;
+                }
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+}
+
+static MPI_Request yp_recv, ym_recv, yp_send, ym_send ;
+static MPI_Request xp_recv, xm_recv, xp_send, xm_send ;
+
+#if 0
+RSL_LITE_EXCH_PERIOD_Y ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
+{
+  int me, np, np_x, np_y ;
+  int yp, ym, xp, xm, ierr ;
+  MPI_Status stat ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+#if 1
+  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  if ( np_y > 1 ) {
+    yp = me + np_x ; ym = me - np_x ;
+    if ( yp >= 0 && yp < np ) {
+      ierr=MPI_Irecv ( buffer_for_proc( yp, yp_curs, RSL_RECVBUF ), yp_curs, MPI_CHAR, yp, me, comm, &yp_recv ) ;
+    }
+    if ( ym >= 0 && ym < np ) {
+      ierr=MPI_Irecv ( buffer_for_proc( ym, ym_curs, RSL_RECVBUF ), ym_curs, MPI_CHAR, ym, me, comm, &ym_recv ) ;
+    }
+    if ( yp >= 0 && yp < np ) {
+      ierr=MPI_Isend ( buffer_for_proc( yp, 0,       RSL_SENDBUF ), yp_curs, MPI_CHAR, yp, yp, comm, &yp_send ) ;
+    }
+    if ( ym >= 0 && ym < np ) {
+      ierr=MPI_Isend ( buffer_for_proc( ym, 0,       RSL_SENDBUF ), ym_curs, MPI_CHAR, ym, ym, comm, &ym_send ) ;
+    }
+    if ( yp >= 0 && yp < np ) MPI_Wait( &yp_recv, &stat ) ; 
+    if ( ym >= 0 && ym < np ) MPI_Wait( &ym_recv, &stat ) ; 
+    if ( yp >= 0 && yp < np ) MPI_Wait( &yp_send, &stat ) ; 
+    if ( ym >= 0 && ym < np ) MPI_Wait( &ym_send, &stat ) ;
+  }
+  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
+#else 
+fprintf(stderr,"RSL_LITE_EXCH_Y disabled\n") ;
+#endif
+}
+#endif
+
+RSL_LITE_EXCH_PERIOD_X ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
+{
+  int me, np, np_x, np_y ;
+  int yp, ym, xp, xm, nbytes ;
+  MPI_Status stat ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+  int coords[2], dims[2] ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+#if 1
+  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  dims[0] = np_x ;
+  dims[1] = np_y ;
+
+  if ( np_x > 1 ) {
+    MPI_Comm_rank( *comm0, &me ) ;
+    MPI_Cart_coords( *comm0, me, 2, coords ) ;
+    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
+    if ( coords[1] == np_x - 1 ) {   /* proc on right hand side of domain */
+      nbytes = buffer_size_for_proc( xp, RSL_RECVBUF ) ;
+      MPI_Irecv ( buffer_for_proc( xp , xp_curs, RSL_RECVBUF ), nbytes, MPI_CHAR, xp, me, comm, &xp_recv ) ;
+    }
+    if ( coords[1] == 0 ) {          /* proc on left hand side of domain */
+      nbytes = buffer_size_for_proc( xm, RSL_RECVBUF ) ;
+      MPI_Irecv ( buffer_for_proc( xm, xm_curs, RSL_RECVBUF ), nbytes, MPI_CHAR, xm, me, comm, &xm_recv ) ;
+    }
+    if ( coords[1] == np_x - 1 ) {   /* proc on right hand side of domain */
+      MPI_Isend ( buffer_for_proc( xp , 0,       RSL_SENDBUF ), xp_curs, MPI_CHAR, xp, xp, comm, &xp_send ) ;
+    }
+    if ( coords[1] == 0 ) {          /* proc on left hand side of domain */
+      MPI_Isend ( buffer_for_proc( xm, 0,       RSL_SENDBUF ), xm_curs, MPI_CHAR, xm, xm, comm, &xm_send ) ;
+    }
+    if ( coords[1] == np_x - 1 ) MPI_Wait( &xp_recv, &stat ) ; 
+    if ( coords[1] == 0        ) MPI_Wait( &xm_recv, &stat ) ; 
+    if ( coords[1] == np_x - 1 ) MPI_Wait( &xp_send, &stat ) ; 
+    if ( coords[1] == 0        ) MPI_Wait( &xm_send, &stat ) ;
+  }
+#else 
+fprintf(stderr,"RSL_LITE_EXCH_X disabled\n") ;
+#endif
+  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/rsl_bcast.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/rsl_bcast.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/rsl_bcast.c	(revision 2744)
@@ -0,0 +1,636 @@
+/* #define LEARN_BCAST */
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#define MOD_9707
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "mpi.h"
+#include "rsl_lite.h"
+
+char mess[4096] ;
+
+typedef struct bcast_point_desc {
+  int ig ;
+  int jg ;
+} bcast_point_desc_t ;
+
+
+static destroy_par_info ( p )
+  char * p ;
+{
+  if ( p != NULL ) RSL_FREE( p ) ;
+}
+
+static rsl_list_t *Xlist, *Xp, *Xprev ;
+static rsl_list_t *stage ;
+static int stage_len = 0 ;              /* 96/3/15 */
+
+static int  Sendbufsize ;
+static int  Sendbufcurs ;
+static char *Sendbuf ;
+static int  Sdisplacements[RSL_MAXPROC] ;
+static int  Ssizes[RSL_MAXPROC] ;
+
+static int  Recsizeindex ;
+
+static int  Rbufsize ;
+static int  Rbufcurs ;
+static int  Rpointcurs ;
+static char *Recvbuf ;
+static int  Rdisplacements[RSL_MAXPROC+1] ;
+static int  Rsizes[RSL_MAXPROC] ;
+static int  Rreclen ;
+
+static int s_d ;
+static int s_nst ;
+static int s_msize ;
+static int s_idim ;
+static int s_jdim ;
+static int s_idim_nst ;
+static int s_jdim_nst ;
+static int s_irax_n ;
+static int s_irax_m ;
+static int s_ntasks_x ;
+static int s_ntasks_y ;
+static rsl_list_t **Plist ;
+static int Psize[RSL_MAXPROC] ;
+static char *s_parent_msgs ;
+static int s_parent_msgs_curs ;
+static int s_remaining ;  /* number of bytes left in a parent message before
+                           the next point descriptor */
+
+/* add a field to a message outgoing for the specified child domain cell */
+/* relies on rsl_ready_bcast having been called already */
+/* sends are specified in terms of coarse domain */
+
+static int s_i, s_j, s_ig, s_jg, s_cm, s_cn,
+           s_nig, s_njg ;
+
+static int Pcurs ;
+static rsl_list_t *Pptr ; 
+
+#ifdef LEARN_BCAST
+static int s_putmsg = 0 ;
+#endif
+
+/* parent->nest */
+RSL_LITE_TO_CHILD_INFO ( Fcomm, msize_p,
+                         cips_p, cipe_p, cjps_p, cjpe_p, /* patch dims of SOURCE DOMAIN */
+                         iids_p, iide_p, ijds_p, ijde_p, /* domain dims of INTERMEDIATE DOMAIN */
+                         nids_p, nide_p, njds_p, njde_p, /* domain dims of CHILD DOMAIN */
+                         pgr_p,  shw_p ,                 /* nest ratio and stencil half width */
+                         ntasks_x_p , ntasks_y_p ,       /* proc counts in x and y */
+                         icoord_p, jcoord_p,
+                         idim_cd_p, jdim_cd_p,
+                         ig_p, jg_p,
+                         retval_p )
+  
+  int_p
+     Fcomm                            /* Fortran version of MPI communicator */
+    ,cips_p, cipe_p, cjps_p, cjpe_p   /* (i) c.d. patch dims */
+    ,iids_p, iide_p, ijds_p, ijde_p   /* (i) n.n. global dims */
+    ,nids_p, nide_p, njds_p, njde_p   /* (i) n.n. global dims */
+    ,pgr_p                            /* nesting ratio */
+    ,ntasks_x_p , ntasks_y_p          /* proc counts in x and y */
+    ,icoord_p       /* i coordinate of nest in cd */
+    ,jcoord_p       /* j coordinate of nest in cd */
+    ,shw_p          /* stencil half width */
+    ,idim_cd_p      /* i width of nest in cd */
+    ,jdim_cd_p      /* j width of nest in cd */
+    ,msize_p        /* (I) Message size in bytes. */
+    ,ig_p           /* (O) Global N index of parent domain point. */
+    ,jg_p           /* (O) Global N index of parent domain point. */
+    ,retval_p ;     /* (O) =1 if a valid point returned; =0 (zero) otherwise. */
+{
+  int P, Px, Py ;
+
+  rsl_list_t *q ;
+  int *r ;
+  int i, j, ni, nj ;
+  int coords[2] ;
+  MPI_Comm *comm, dummy_comm ;
+
+  comm = &dummy_comm ;
+  *comm = MPI_Comm_f2c( *Fcomm ) ;
+
+  if ( Plist == NULL ) {
+    s_ntasks_x = *ntasks_x_p ;
+    s_ntasks_y = *ntasks_y_p ;
+    /* construct Plist */
+    Sendbufsize = 0 ;
+    Plist = RSL_MALLOC( rsl_list_t * , s_ntasks_x * s_ntasks_y ) ;  /* big enough for nest points */
+    for ( j = 0 ; j < s_ntasks_x * s_ntasks_y ; j++ ) {
+       Plist[j] = NULL ;
+       Sdisplacements[j] = 0 ;
+       Ssizes[j] = 0 ;
+    }
+    for ( j = *cjps_p ; j <= *cjpe_p ; j++ )
+    {
+      for ( i = *cips_p ; i <= *cipe_p ; i++ )
+      {
+	if ( ( *jcoord_p <= j && j <= *jcoord_p+*jdim_cd_p-1 ) && ( *icoord_p <= i && i <= *icoord_p+*idim_cd_p-1 ) ) {
+           ni = ( i - (*icoord_p + *shw_p) ) * *pgr_p + 1 + 1 ; /* add 1 to give center point */
+           nj = ( j - (*jcoord_p + *shw_p) ) * *pgr_p + 1 + 1 ;
+
+	   TASK_FOR_POINT ( &ni, &nj, nids_p, nide_p, njds_p, njde_p, &s_ntasks_x, &s_ntasks_y, &Px, &Py ) ;
+           coords[1] = Px ; coords[0] = Py ;
+           MPI_Cart_rank( *comm, coords, &P ) ;
+
+	   q = RSL_MALLOC( rsl_list_t , 1 ) ;
+	   q->info1 = i ;
+	   q->info2 = j ;
+	   q->next = Plist[P] ;
+	   Plist[P] = q ;
+	   Sendbufsize += *msize_p + 3 * sizeof( int ) ;  /* point data plus 3 ints for i, j, and size */
+        }
+      }
+    }
+    Sendbuf = RSL_MALLOC( char , Sendbufsize ) ;
+    Sendbufcurs = 0 ;
+    Recsizeindex = -1 ;
+    Pcurs = -1 ;
+    Pptr = NULL ;
+  }
+
+  if ( Pptr != NULL ) {
+    Pptr = Pptr->next ;
+  } 
+
+  if ( Recsizeindex >= 0 ) {
+          r = (int *) &(Sendbuf[Recsizeindex]) ;
+          *r = Sendbufcurs - Recsizeindex + 2 * sizeof(int) ;
+          Ssizes[Pcurs] += *r ;
+  }
+
+  while ( Pptr == NULL ) {
+      Pcurs++ ;
+      while ( Pcurs < s_ntasks_x * s_ntasks_y && Plist[Pcurs] == NULL  ) Pcurs++ ;
+      if ( Pcurs < s_ntasks_x * s_ntasks_y ) {
+        Sdisplacements[Pcurs] = Sendbufcurs ;
+        Ssizes[Pcurs] = 0 ;
+        Pptr = Plist[Pcurs] ;
+      } else {
+        *retval_p = 0 ;
+#if 0
+fprintf(stderr,"TO _INFO: %d %d %d \n",*ig_p,*jg_p, *retval_p) ;
+#endif
+        return ;  /* done */
+      }
+  }
+
+  *ig_p = Pptr->info1 ;
+  *jg_p = Pptr->info2 ;
+
+  r = (int *) &(Sendbuf[Sendbufcurs]) ;
+  *r++ = Pptr->info1 ; Sendbufcurs += sizeof(int) ;  /* ig to buffer */
+  *r++ = Pptr->info2 ; Sendbufcurs += sizeof(int) ;  /* jg to buffer */
+  Recsizeindex = Sendbufcurs ;
+  *r++ =           0 ; Sendbufcurs += sizeof(int) ;  /* store start for size */
+  *retval_p = 1 ;
+
+#if 0
+fprintf(stderr,"TO  INFO: %d %d %d \n",*ig_p,*jg_p, *retval_p) ;
+#endif
+
+  return ;
+}
+
+/********************************************/
+
+/* nest->parent */
+RSL_LITE_TO_PARENT_INFO ( Fcomm, msize_p,
+                          nips_p, nipe_p, njps_p, njpe_p, /* patch dims of SOURCE DOMAIN (CHILD) */
+                          cids_p, cide_p, cjds_p, cjde_p, /* domain dims of TARGET DOMAIN (PARENT) */
+                          ntasks_x_p , ntasks_y_p ,       /* proc counts in x and y */
+                          icoord_p, jcoord_p,
+                          idim_cd_p, jdim_cd_p,
+                          ig_p, jg_p,
+                          retval_p )
+  int_p
+     Fcomm                            /* Fortran version of MPI communicator */
+    ,nips_p, nipe_p, njps_p, njpe_p   /* (i) n.d. patch dims */
+    ,cids_p, cide_p, cjds_p, cjde_p   /* (i) n.n. global dims */
+    ,ntasks_x_p , ntasks_y_p          /* proc counts in x and y */
+    ,icoord_p       /* i coordinate of nest in cd */
+    ,jcoord_p       /* j coordinate of nest in cd */
+    ,idim_cd_p      /* i width of nest in cd */
+    ,jdim_cd_p      /* j width of nest in cd */
+    ,msize_p        /* (I) Message size in bytes. */
+    ,ig_p           /* (O) Global N index of parent domain point. */
+    ,jg_p           /* (O) Global N index of parent domain point. */
+    ,retval_p ;     /* (O) =1 if a valid point returned; =0 (zero) otherwise. */
+{
+  int P, Px, Py ;
+  rsl_list_t *q ;
+  int *r ;
+  int i, j ;
+  int coords[2] ;
+  MPI_Comm *comm, dummy_comm ;
+
+  comm = &dummy_comm ;
+  *comm = MPI_Comm_f2c( *Fcomm ) ;
+
+  if ( Plist == NULL ) {
+    s_ntasks_x = *ntasks_x_p ;
+    s_ntasks_y = *ntasks_y_p ;
+    /* construct Plist */
+    Sendbufsize = 0 ;
+    Plist = RSL_MALLOC( rsl_list_t * , s_ntasks_x * s_ntasks_y ) ;
+    for ( j = 0 ; j < s_ntasks_x * s_ntasks_y ; j++ ) {
+       Plist[j] = NULL ;
+       Sdisplacements[j] = 0 ;
+       Ssizes[j] = 0 ;
+    }
+    for ( j = *njps_p ; j <= *njpe_p ; j++ )
+    {
+      for ( i = *nips_p ; i <= *nipe_p ; i++ )
+      {
+	if ( ( *jcoord_p <= j && j <= *jcoord_p+*jdim_cd_p-1 ) && ( *icoord_p <= i && i <= *icoord_p+*idim_cd_p-1 ) ) {
+	  TASK_FOR_POINT ( &i, &j, cids_p, cide_p, cjds_p, cjde_p, &s_ntasks_x, &s_ntasks_y, &Px, &Py ) ;
+          coords[1] = Px ; coords[0] = Py ;
+          MPI_Cart_rank( *comm, coords, &P ) ;
+	  q = RSL_MALLOC( rsl_list_t , 1 ) ;
+	  q->info1 = i ;
+	  q->info2 = j ;
+	  q->next = Plist[P] ;
+	  Plist[P] = q ;
+	  Sendbufsize += *msize_p + 3 * sizeof( int ) ;  /* point data plus 3 ints for i, j, and size */
+        }
+      }
+    }
+    Sendbuf = RSL_MALLOC( char , Sendbufsize ) ;
+    Sendbufcurs = 0 ;
+    Recsizeindex = -1 ;
+    Pcurs = -1 ;
+    Pptr = NULL ;
+  }
+  if ( Pptr != NULL ) {
+    Pptr = Pptr->next ;
+  } 
+
+  if ( Recsizeindex >= 0 ) {
+          r = (int *) &(Sendbuf[Recsizeindex]) ;
+          *r = Sendbufcurs - Recsizeindex + 2 * sizeof(int) ;
+          Ssizes[Pcurs] += *r ;
+  }
+
+  while ( Pptr == NULL ) {
+      Pcurs++ ;
+      while ( Pcurs < s_ntasks_x * s_ntasks_y && Plist[Pcurs] == NULL ) Pcurs++ ;
+      if ( Pcurs < s_ntasks_x * s_ntasks_y ) {
+        Sdisplacements[Pcurs] = Sendbufcurs ;
+        Ssizes[Pcurs] = 0 ;
+        Pptr = Plist[Pcurs] ;
+      } else {
+        *retval_p = 0 ;
+        return ;  /* done */
+      }
+  }
+
+  *ig_p = Pptr->info1 ;
+  *jg_p = Pptr->info2 ;
+
+  r = (int *) &(Sendbuf[Sendbufcurs]) ;
+  *r++ = Pptr->info1 ; Sendbufcurs += sizeof(int) ;  /* ig to buffer */
+  *r++ = Pptr->info2 ; Sendbufcurs += sizeof(int) ;  /* jg to buffer */
+  Recsizeindex = Sendbufcurs ;
+  *r++ =           0 ; Sendbufcurs += sizeof(int) ;  /* store start for size */
+  *retval_p = 1 ;
+
+  return ;
+}
+
+
+/********************************************/
+
+/*@
+  RSL_TO_CHILD_MSG -- Pack force data into a message for a nest point.
+
+@*/
+
+/* parent->nest */
+RSL_LITE_TO_CHILD_MSG ( nbuf_p, buf )
+  int_p
+    nbuf_p ;     /* (I) Number of bytes to be packed. */
+  char *
+    buf ;        /* (I) Buffer containing the data to be packed. */
+{
+   rsl_lite_to_peerpoint_msg ( nbuf_p, buf ) ;
+}
+
+/* nest->parent */
+RSL_LITE_TO_PARENT_MSG ( nbuf_p, buf )
+  int_p
+    nbuf_p ;     /* (I) Number of bytes to be packed. */
+  char *
+    buf ;        /* (I) Buffer containing the data to be packed. */
+{
+   rsl_lite_to_peerpoint_msg ( nbuf_p, buf ) ;
+}
+
+/* common code */
+rsl_lite_to_peerpoint_msg ( nbuf_p, buf )
+  int_p
+    nbuf_p ;     /* (I) Number of bytes to be packed. */
+  char *
+    buf ;        /* (I) Buffer containing the data to be packed. */
+{
+  int nbuf ;
+  int *p, *q ;
+  char *c, *d ;
+  int i ;
+
+  RSL_TEST_ERR(buf==NULL,"2nd argument is NULL.  Field allocated?") ;
+
+  nbuf = *nbuf_p ;
+
+  if ( Sendbufcurs + nbuf >= Sendbufsize ) {
+    sprintf(mess,"RSL_LITE_TO_CHILD_MSG: Sendbufcurs + nbuf (%d) would exceed Sendbufsize (%d)\n",
+           Sendbufcurs + nbuf , Sendbufsize ) ;
+    RSL_TEST_ERR(1,mess) ;
+  }
+
+  if ( nbuf % sizeof(int) == 0 ) {
+    for ( p = (int *)buf, q = (int *) &(Sendbuf[Sendbufcurs]), i = 0 ; i < nbuf ; i += sizeof(int) )
+    {
+      *q++ = *p++ ;
+    }
+  }
+  else
+  {
+    for ( c = buf, d = &(Sendbuf[Sendbufcurs]), i = 0 ; i < nbuf ; i++ )
+    {
+      *d++ = *c++ ;
+    }
+  }
+
+  Sendbufcurs += nbuf ;
+
+}
+
+/********************************************/
+
+/* parent->nest */
+RSL_LITE_BCAST_MSGS ( mytask_p, ntasks_p, Fcomm )
+  int_p mytask_p, ntasks_p, Fcomm ;
+{
+  MPI_Comm comm ;
+
+  comm = MPI_Comm_f2c( *Fcomm ) ;
+  rsl_lite_allgather_msgs ( mytask_p, ntasks_p, comm ) ;
+}
+
+/* nest->parent */
+RSL_LITE_MERGE_MSGS ( mytask_p, ntasks_p, Fcomm )
+  int_p mytask_p, ntasks_p, Fcomm ;
+{
+  MPI_Comm comm ;
+
+  comm = MPI_Comm_f2c( *Fcomm ) ;
+  rsl_lite_allgather_msgs ( mytask_p, ntasks_p, comm ) ;
+}
+
+/* common code */
+rsl_lite_allgather_msgs ( mytask_p, ntasks_p, comm )
+  int_p mytask_p, ntasks_p ;
+  MPI_Comm comm ;
+{
+  int P ;
+  char *work ;
+  int * r ;
+  bcast_point_desc_t pdesc ;
+  int curs ;
+  int msglen, mdest, mtag ;
+  int ntasks, mytask ;
+  int ii, i, j ;
+  int ig, jg ;
+  int *Psize_all ;
+  int *sp, *bp ;
+  int rc ;
+
+  ntasks = *ntasks_p ;
+  mytask = *mytask_p ;
+
+  RSL_TEST_ERR( Plist == NULL,
+    "RSL_BCAST_MSGS: rsl_to_child_info not called first" ) ;
+
+  RSL_TEST_ERR( ntasks == RSL_MAXPROC ,
+    "RSL_BCAST_MSGS: raise the compile time value of MAXPROC" ) ;
+  
+  Psize_all = RSL_MALLOC( int, ntasks * ntasks ) ;
+
+  MPI_Allgather( Ssizes, ntasks, MPI_INT , Psize_all, ntasks, MPI_INT, comm ) ;
+
+  for ( j = 0 ; j < ntasks ; j++ ) 
+    Rsizes[j] = 0 ;
+
+  for ( j = 0 ; j < ntasks ; j++ ) 
+  {
+    Rsizes[j] += Psize_all[ INDEX_2( j , mytask , ntasks ) ] ;
+  }
+
+  for ( Rbufsize = 0, P = 0, Rdisplacements[0] = 0 ; P < ntasks ; P++ )
+  {
+    Rdisplacements[P+1] = Rsizes[P] + Rdisplacements[P] ;
+    Rbufsize += Rsizes[P] ;
+  }
+
+  /* this will be freed later */
+
+  Recvbuf = RSL_MALLOC( char , Rbufsize + 3 * sizeof(int) ) ; /* for sentinal record */
+  Rbufcurs = 0 ;
+  Rreclen = 0 ;
+
+  rc = MPI_Alltoallv ( Sendbuf, Ssizes, Sdisplacements, MPI_BYTE , 
+                       Recvbuf, Rsizes, Rdisplacements, MPI_BYTE ,  comm ) ;
+
+/* add sentinel to the end of Recvbuf */
+
+  r = (int *)&(Recvbuf[Rbufsize + 2 * sizeof(int)]) ;
+  *r = RSL_INVALID ;
+
+  RSL_FREE( Sendbuf ) ;
+  RSL_FREE( Psize_all ) ;
+
+  for ( j = 0 ; j < *ntasks_p ; j++ )  {
+    destroy_list ( &(Plist[j]), NULL ) ;
+  }
+  RSL_FREE( Plist ) ;
+  Plist = NULL ;
+
+}
+
+/********************************************/
+
+/* parent->nest */
+RSL_LITE_FROM_PARENT_INFO ( ig_p, jg_p, retval_p )
+  int_p
+    ig_p        /* (O) Global index in M dimension of nest. */
+   ,jg_p        /* (O) Global index in N dimension of nest. */
+   ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
+{
+  rsl_lite_from_peerpoint_info ( ig_p, jg_p, retval_p ) ;
+}
+
+/* nest->parent */
+RSL_LITE_FROM_CHILD_INFO ( ig_p, jg_p, retval_p )
+  int_p
+    ig_p        /* (O) Global index in M dimension of nest. */
+   ,jg_p        /* (O) Global index in N dimension of nest. */
+   ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
+{
+  rsl_lite_from_peerpoint_info ( ig_p, jg_p, retval_p ) ;
+}
+
+/* common code */
+rsl_lite_from_peerpoint_info ( ig_p, jg_p, retval_p )
+  int_p
+    ig_p        /* (O) Global index in M dimension of nest. */
+   ,jg_p        /* (O) Global index in N dimension of nest. */
+   ,retval_p ;  /* (O) Return value; =1 valid point, =0 done. */
+{
+  int ii ;
+
+  Rbufcurs = Rbufcurs + Rreclen ;
+  Rpointcurs = 0 ;
+  *ig_p    = *(int *)&( Recvbuf[Rbufcurs + Rpointcurs ] ) ; Rpointcurs += sizeof(int) ;
+  *jg_p    = *(int *)&( Recvbuf[Rbufcurs + Rpointcurs ] ) ; Rpointcurs += sizeof(int) ;
+/* read sentinel */
+  Rreclen  = *(int *)&( Recvbuf[Rbufcurs + Rpointcurs ] ) ; Rpointcurs += sizeof(int) ;
+  *retval_p = 1 ;
+  if ( Rreclen == RSL_INVALID ) {
+    *retval_p = 0 ;
+    RSL_FREE( Recvbuf ) ;
+  }
+     
+#if 0
+fprintf(stderr,"FROM  INFO: %d %d %d %d %d %d\n",*ig_p,*jg_p,Rreclen, Rpointcurs, Rbufcurs + Rpointcurs, *retval_p) ;
+#endif
+  return ;
+}
+
+/********************************************/
+
+/* parent->nest */
+RSL_LITE_FROM_PARENT_MSG ( len_p, buf )
+  int_p
+    len_p ;          /* (I) Number of bytes to unpack. */
+  int *
+    buf ;            /* (O) Destination buffer. */
+{
+  rsl_lite_from_peerpoint_msg ( len_p, buf ) ;
+}
+
+/* nest->parent */
+RSL_LITE_FROM_CHILD_MSG ( len_p, buf )
+  int_p
+    len_p ;          /* (I) Number of bytes to unpack. */
+  int *
+    buf ;            /* (O) Destination buffer. */
+{
+  rsl_lite_from_peerpoint_msg ( len_p, buf ) ;
+}
+
+/* common code */
+rsl_lite_from_peerpoint_msg ( len_p, buf )
+  int_p
+    len_p ;          /* (I) Number of bytes to unpack. */
+  int *
+    buf ;            /* (O) Destination buffer. */
+{
+  int *p, *q ;
+  char *c, *d ;
+  int i ;
+
+  if ( *len_p % sizeof(int) == 0 ) {
+    for ( p = (int *)&(Recvbuf[Rbufcurs+Rpointcurs]), q = buf , i = 0 ; i < *len_p ; i += sizeof(int) ) 
+    {
+      *q++ = *p++ ;
+    }
+  } else {
+    for ( c = &(Recvbuf[Rbufcurs+Rpointcurs]), d = (char *) buf , i = 0 ; i < *len_p ; i++ )
+    {
+      *d++ = *c++ ;
+    }
+  }
+
+  Rpointcurs += *len_p ;
+}
+
+/********************************************/
+
+destroy_list( list, dfcn )
+  rsl_list_t ** list ;          /* pointer to pointer to list */
+  int (*dfcn)() ;               /* pointer to function for destroying
+                                   the data field of the list */
+{
+  rsl_list_t *p, *trash ;
+  if ( list == NULL ) return(0) ;
+  if ( *list == NULL ) return(0) ;
+  for ( p = *list ; p != NULL ; )
+  {
+    if ( dfcn != NULL ) (*dfcn)( p->data ) ;
+    trash = p ;
+    p = p->next ;
+    RSL_FREE( trash ) ;
+  }
+  *list = NULL ;
+  return(0) ;
+}
+
+/********************************************/
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/rsl_lite.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/rsl_lite.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/rsl_lite.h	(revision 2744)
@@ -0,0 +1,145 @@
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define RSL_LITE_ERROR_DUP1 rsl_error_dup1
+#      define BYTE_BCAST byte_bcast
+#      define RSL_LITE_INIT_EXCH rsl_lite_init_exch
+#      define RSL_LITE_EXCH_Y rsl_lite_exch_y
+#      define RSL_LITE_EXCH_X rsl_lite_exch_x
+#      define RSL_LITE_PACK  rsl_lite_pack
+#      define RSL_LITE_BCAST_MSGS rsl_lite_bcast_msgs
+#      define RSL_LITE_TO_CHILD_MSG rsl_lite_to_child_msg
+#      define RSL_LITE_TO_CHILD_INFO rsl_lite_to_child_info
+#      define RSL_LITE_FROM_PARENT_MSG rsl_lite_from_parent_msg
+#      define RSL_LITE_FROM_PARENT_INFO rsl_lite_from_parent_info
+#      define RSL_LITE_MERGE_MSGS rsl_lite_merge_msgs
+#      define RSL_LITE_TO_PARENT_MSG rsl_lite_to_parent_msg
+#      define RSL_LITE_TO_PARENT_INFO rsl_lite_to_parent_info
+#      define RSL_LITE_FROM_CHILD_MSG rsl_lite_from_child_msg
+#      define RSL_LITE_FROM_CHILD_INFO rsl_lite_from_child_info
+#      define RSL_INTERNAL_MILLICLOCK rsl_internal_milliclock
+#      define RSL_INTERNAL_MICROCLOCK rsl_internal_microclock
+#      define TASK_FOR_POINT task_for_point
+#      define RSL_LITE_INIT_PERIOD rsl_lite_init_period
+#      define RSL_LITE_EXCH_PERIOD_Y rsl_lite_exch_period_y
+#      define RSL_LITE_EXCH_PERIOD_X rsl_lite_exch_period_x
+#      define RSL_LITE_PACK_PERIOD_X  rsl_lite_pack_period_x
+#      define RSL_LITE_INIT_SWAP rsl_lite_init_swap
+#      define RSL_LITE_SWAP rsl_lite_swap
+#      define RSL_LITE_PACK_SWAP  rsl_lite_pack_swap
+#      define RSL_LITE_INIT_CYCLE rsl_lite_init_cycle
+#      define RSL_LITE_CYCLE rsl_lite_cycle
+#      define RSL_LITE_PACK_CYCLE rsl_lite_pack_cycle
+#      define F_PACK_LINT f_pack_lint
+#      define F_PACK_INT f_pack_int
+#      define F_UNPACK_LINT f_unpack_lint
+#      define F_UNPACK_INT f_unpack_int
+# else
+#   ifdef F2CSTYLE
+#      define RSL_LITE_ERROR_DUP1 rsl_error_dup1__
+#      define BYTE_BCAST byte_bcast__
+#      define RSL_LITE_INIT_EXCH rsl_lite_init_exch__
+#      define RSL_LITE_EXCH_Y rsl_lite_exch_y__
+#      define RSL_LITE_EXCH_X rsl_lite_exch_x__
+#      define RSL_LITE_PACK  rsl_lite_pack__
+#      define RSL_LITE_BCAST_MSGS rsl_lite_bcast_msgs__
+#      define RSL_LITE_TO_CHILD_MSG rsl_lite_to_child_msg__
+#      define RSL_LITE_TO_CHILD_INFO rsl_lite_to_child_info__
+#      define RSL_LITE_FROM_PARENT_MSG rsl_lite_from_parent_msg__
+#      define RSL_LITE_FROM_PARENT_INFO rsl_lite_from_parent_info__
+#      define RSL_LITE_MERGE_MSGS rsl_lite_merge_msgs__
+#      define RSL_LITE_TO_PARENT_MSG rsl_lite_to_parent_msg__
+#      define RSL_LITE_TO_PARENT_INFO rsl_lite_to_parent_info__
+#      define RSL_LITE_FROM_CHILD_MSG rsl_lite_from_child_msg__
+#      define RSL_LITE_FROM_CHILD_INFO rsl_lite_from_child_info__
+#      define RSL_INTERNAL_MILLICLOCK rsl_internal_milliclock__
+#      define RSL_INTERNAL_MICROCLOCK rsl_internal_microclock__
+#      define TASK_FOR_POINT task_for_point__
+#      define RSL_LITE_INIT_PERIOD rsl_lite_init_period__
+#      define RSL_LITE_EXCH_PERIOD_Y rsl_lite_exch_period_y__
+#      define RSL_LITE_EXCH_PERIOD_X rsl_lite_exch_period_x__
+#      define RSL_LITE_PACK_PERIOD_X  rsl_lite_pack_period_x__
+#      define RSL_LITE_INIT_SWAP rsl_lite_init_swap__
+#      define RSL_LITE_SWAP rsl_lite_swap__
+#      define RSL_LITE_PACK_SWAP  rsl_lite_pack_swap__
+#      define RSL_LITE_INIT_CYCLE rsl_lite_init_cycle__
+#      define RSL_LITE_CYCLE rsl_lite_cycle__
+#      define RSL_LITE_PACK_CYCLE rsl_lite_pack_cycle__
+#      define F_PACK_LINT f_pack_lint__
+#      define F_PACK_INT f_pack_int__
+#      define F_UNPACK_LINT f_unpack_lint__
+#      define F_UNPACK_INT f_unpack_int__
+#   else
+#      define RSL_LITE_ERROR_DUP1 rsl_error_dup1_
+#      define BYTE_BCAST byte_bcast_
+#      define RSL_LITE_INIT_EXCH rsl_lite_init_exch_
+#      define RSL_LITE_EXCH_Y rsl_lite_exch_y_
+#      define RSL_LITE_EXCH_X rsl_lite_exch_x_
+#      define RSL_LITE_PACK  rsl_lite_pack_
+#      define RSL_LITE_BCAST_MSGS rsl_lite_bcast_msgs_
+#      define RSL_LITE_TO_CHILD_MSG rsl_lite_to_child_msg_
+#      define RSL_LITE_TO_CHILD_INFO rsl_lite_to_child_info_
+#      define RSL_LITE_FROM_PARENT_MSG rsl_lite_from_parent_msg_
+#      define RSL_LITE_FROM_PARENT_INFO rsl_lite_from_parent_info_
+#      define RSL_LITE_MERGE_MSGS rsl_lite_merge_msgs_
+#      define RSL_LITE_TO_PARENT_MSG rsl_lite_to_parent_msg_
+#      define RSL_LITE_TO_PARENT_INFO rsl_lite_to_parent_info_
+#      define RSL_LITE_FROM_CHILD_MSG rsl_lite_from_child_msg_
+#      define RSL_LITE_FROM_CHILD_INFO rsl_lite_from_child_info_
+#      define RSL_INTERNAL_MILLICLOCK rsl_internal_milliclock_
+#      define RSL_INTERNAL_MICROCLOCK rsl_internal_microclock_
+#      define TASK_FOR_POINT task_for_point_
+#      define RSL_LITE_INIT_PERIOD rsl_lite_init_period_
+#      define RSL_LITE_EXCH_PERIOD_Y rsl_lite_exch_period_y_
+#      define RSL_LITE_EXCH_PERIOD_X rsl_lite_exch_period_x_
+#      define RSL_LITE_PACK_PERIOD_X  rsl_lite_pack_period_x_
+#      define RSL_LITE_INIT_SWAP rsl_lite_init_swap_
+#      define RSL_LITE_SWAP rsl_lite_swap_
+#      define RSL_LITE_PACK_SWAP rsl_lite_pack_swap_
+#      define RSL_LITE_INIT_CYCLE rsl_lite_init_cycle_
+#      define RSL_LITE_CYCLE rsl_lite_cycle_
+#      define RSL_LITE_PACK_CYCLE rsl_lite_pack_cycle_
+#      define F_PACK_LINT f_pack_lint_
+#      define F_PACK_INT f_pack_int_
+#      define F_UNPACK_LINT f_unpack_lint_
+#      define F_UNPACK_INT f_unpack_int_
+#   endif
+# endif
+#endif
+
+#define RSL_SENDBUF 0
+#define RSL_RECVBUF 1
+#define RSL_FREEBUF 3
+#define RSL_MAXPROC 10000
+#define RSL_INVALID -1
+
+#define RSL_MALLOC(T,N)  (T *)rsl_malloc(__FILE__,__LINE__,(sizeof(T))*(N))
+#define RSL_FREE(P)      rsl_free(P)
+
+char * buffer_for_proc ( int P, int size, int code ) ;
+void * rsl_malloc( char * f, int l, int s ) ;
+typedef int * int_p ;
+
+#define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) )
+#define INDEX_3(A,B,NB,C,NC)  INDEX_2( (A), INDEX_2( (B), (C), (NC) ), (NB)*(NC) )
+
+#define RSL_FATAL(N)     MPI_Abort(MPI_COMM_WORLD, 9)
+#define RSL_TEST_ERR(T,M) {if(T){fprintf(stderr,"rsl_lite error (\"%s\":%d) %s\n",__FILE__,__LINE__,M);RSL_FATAL(5);}}
+
+#ifndef MPI2_SUPPORT
+typedef int MPI_Fint;
+#  define MPI_Comm_c2f(comm) (MPI_Fint)(comm)
+#  define MPI_Comm_f2c(comm) (MPI_Comm)(comm)
+#endif
+
+typedef struct rsl_list {
+  struct rsl_list * next ;
+  void * data ;                 /* pointer to some node */
+#ifdef crayx1
+  int info1 ;                   /* blank info field */
+  int info2 ;                   /* blank info field */
+#else
+  short info1 ;                 /* blank info field */
+  short info2 ;                 /* blank info field */
+#endif
+} rsl_list_t ;
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/rsl_malloc.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/rsl_malloc.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/rsl_malloc.c	(revision 2744)
@@ -0,0 +1,253 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+
+#if 0
+#define PADIT		/* add page at beginning and end of allocation */
+#endif
+#if 0
+# define BASE_MALLOC   fence_malloc
+# define BASE_FREE     fence_free
+#else
+# define BASE_MALLOC   malloc
+# define BASE_FREE     free
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <malloc.h>
+#ifdef T3D
+#include <errno.h>
+#endif
+#include "mpi.h"
+#include "rsl_lite.h"
+
+/*
+extern int EF_ALIGNMENT;
+extern int EF_PROTECT_BELOW;
+extern int EF_PROTECT_FREE;
+*/
+
+/* define STUG to enable tracking of allocs and frees (performance and space penalty) */
+#ifdef STUG
+#define MAXSTUG  1000000
+struct stugtype {
+   char *  ddr ;
+   int     sz  ;
+} stug[MAXSTUG] ;
+static int stugfirst =1 ;
+int outy = 0 ;
+int nouty = 0 ;
+int maxstug = 0 ;
+int maxouty = 0 ;
+int bbb ;
+#endif
+
+
+static char zero_length_storage[] = "" ;
+
+#if !(defined(vpp) || defined(vpp2) || defined(SUN) || defined(XT3_Catamount))
+static struct mallinfo minf ;
+#endif
+
+static char *last_f ;
+static int last_l ;
+static int last_s ;
+
+#ifdef O2K
+static struct mallinfo mallinfo() {} ;
+#endif
+
+void * rsl_malloc(f,l,s)
+   char * f ;
+   int l, s ;
+{
+   char mess[128] ;
+   void *retval ;
+   int s2, tries ;
+
+/*
+EF_PROTECT_BELOW = 0 ;
+EF_PROTECT_FREE = 1 ;
+*/
+
+#ifdef STUG
+   if ( stugfirst == 1 ) {
+      stugfirst = 0 ;
+      for ( bbb = 0 ; bbb < MAXSTUG ; bbb++ ) {
+         stug[bbb].ddr = 0L ;
+         stug[bbb].sz  = 0 ;
+      }
+   }
+#endif
+
+   if ( s == 0 )
+   {
+     retval = (void *) zero_length_storage ;
+   }
+   else 
+   {
+#ifdef PADIT
+     s2 = s + 1024 ;
+#else
+     s2 = s ;
+#endif
+     tries = 0 ;
+     while ((retval=(void *)BASE_MALLOC(s2))==(void *)NULL)
+     {
+       tries++ ;
+       sprintf(mess,
+"rsl_malloc failed allocating %d bytes, called %s, line %d, try %d\n",
+       s,f,l,tries) ;
+       perror(mess) ;
+#if !(defined(vpp) || defined(vpp2) || defined(SUN) || defined(XT3_Catamount))
+       minf = mallinfo() ;
+       fprintf(stderr,"mallinfo: arena %d\n",minf.arena)  ;
+       fprintf(stderr,"mallinfo: ordblks %d\n",minf.ordblks)  ;
+       fprintf(stderr,"mallinfo: smblks %d\n",minf.smblks)  ;
+       fprintf(stderr,"mallinfo: hblks %d\n",minf.hblks)  ;
+       fprintf(stderr,"mallinfo: hblkhd %d\n",minf.hblkhd)  ;
+       fprintf(stderr,"mallinfo: usmblks %d\n",minf.usmblks)  ;
+       fprintf(stderr,"mallinfo: fsmblks %d\n",minf.fsmblks)  ;
+       fprintf(stderr,"mallinfo: uordblks %d\n",minf.uordblks)  ;
+       fprintf(stderr,"mallinfo: fordblks %d\n",minf.fordblks)  ;
+       fprintf(stderr,"mallinfo: keepcost %d\n",minf.keepcost)  ;
+#ifdef SUNINFO
+       fprintf(stderr,"mallinfo: mkfast %d\n",minf.mkfast)  ;
+       fprintf(stderr,"mallinfo: nblks %d\n",minf.nblks)  ;
+       fprintf(stderr,"mallinfo: grain %d\n",minf.grain)  ;
+       fprintf(stderr,"mallinfo: uordbytes %d\n",minf.uordbytes)  ;
+       fprintf(stderr,"mallinfo: allocated %d\n",minf.allocated)  ;
+       fprintf(stderr,"mallinfo: treeoverhead %d\n",minf.treeoverhead)  ;
+#endif
+#endif
+       if ( tries >= 2 )
+       { 
+	 system("lsps -a") ;
+	 sleep(1) ;
+       }
+       if ( tries >= 3 ) 
+       {
+	 system("lsps -a") ;
+	 RSL_FATAL(2) ;
+       }
+     }
+   }
+#if !(defined(vpp)||defined(vpp2)) || defined(sx) || defined(alphavector)
+   if ( s > 0 )
+     bzero( retval, s2 ) ;	/* return zero'd storage always */
+#else
+   if ( s > 0 )
+   { int l, lb ;
+     l = s2/sizeof(int) ;
+     lb = l*sizeof(int) ;
+     vizero_( retval, &l  ) ;
+     l = s2-lb ;
+     vbzero_( retval+lb, &l ) ;	/* return zero'd storage always */
+   }
+#endif
+
+#ifdef PADIT
+   retval = retval + 512 ;
+#endif
+
+#ifdef STUG
+for ( bbb = 0 ; bbb < MAXSTUG ; bbb++ )
+{
+   if ( stug[bbb].ddr == 0 ) break ;
+}
+if ( bbb < MAXSTUG ) {
+   stug[bbb].ddr = retval ;
+   stug[bbb].sz  = s ;
+   outy += stug[bbb].sz ;
+/* fprintf(stderr,"+ %10d.  %08x   %10d  %10d\n", bbb, stug[bbb].ddr, stug[bbb].sz, outy ) ; */
+   nouty ++ ;
+   if ( nouty > maxstug ) maxstug = nouty ;
+   if ( outy > maxouty ) maxouty = outy ;
+}else{
+fprintf(stderr,"stug full %d\n",bbb) ;
+RSL_FATAL(2) ;
+}
+#endif
+   return(retval) ;
+}
+
+rsl_free( p )
+   char * p ;
+{
+   if ( p == zero_length_storage ) return ;    /* fix from ANU */
+
+#ifdef STUG
+for ( bbb = 0 ; bbb < MAXSTUG ; bbb++ ) 
+{
+   if ( stug[bbb].ddr == p ) {
+      outy -= stug[bbb].sz ;
+/* fprintf(stderr,"- %10d.  %08x   %10d  %10d\n", bbb, stug[bbb].ddr, stug[bbb].sz, outy ) ; */
+      nouty -- ;
+      stug[bbb].ddr = 0L ;
+      break ;
+   }
+}
+#endif
+
+#ifdef PADIT
+   BASE_FREE ( p-512 ) ;
+#else
+   BASE_FREE ( p ) ;
+#endif
+   p = NULL ;
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/swap.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/swap.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/swap.c	(revision 2744)
@@ -0,0 +1,326 @@
+#include <stdio.h>
+#include <fcntl.h>
+
+#define STANDARD_ERROR 2
+
+#define STANDARD_OUTPUT 1
+
+#include "mpi.h"
+#include "rsl_lite.h"
+
+#define  UP_EVEN(A)   ((A)+abs((A)%2))
+#define  DOWN_EVEN(A) ((A) - abs((A)%2))
+#define  UP_ODD(A)    ((A) + abs(((A)+1)%2))
+#define  DOWN_ODD(A)  ((A) - abs(((A)+1)%2))
+#define  MIN(A,B)     ((A)<(B)?(A):(B))
+#define  MAX(A,B)     ((A)>(B)?(A):(B))
+
+static int *y_curs = NULL ;
+static int *x_curs = NULL ;
+static int *x_peermask = NULL ;
+static int *nbytes = NULL ; 
+static MPI_Request *x_recv = NULL , *x_send = NULL ;
+
+RSL_LITE_INIT_SWAP ( 
+                int * Fcomm ,
+                int * xy0 ,
+                int * n3dR0, int *n2dR0, int * typesizeR0 , 
+                int * n3dI0, int *n2dI0, int * typesizeI0 , 
+                int * n3dD0, int *n2dD0, int * typesizeD0 , 
+                int * n3dL0, int *n2dL0, int * typesizeL0 , 
+                int * me0, int * np0 , int * np_x0 , int * np_y0 ,
+                int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
+                int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
+{
+  int n3dR, n2dR, typesizeR ;
+  int n3dI, n2dI, typesizeI ;
+  int n3dD, n2dD, typesizeD ;
+  int n3dL, n2dL, typesizeL ;
+  int xy ;
+  int me, np, np_x, np_y ;
+  int ids , ide , jds , jde , kds , kde ;
+  int ips , ipe , jps , jpe , kps , kpe ;
+  int ips_send , ipe_send ;
+  int npts, i, ii, j, m, n, ps, pe, ops, ope ;
+  int Px, Py, P, coords[2] ;
+  int ips_swap, ipe_swap ;
+  MPI_Comm *comm, dummy_comm ;
+
+  comm = &dummy_comm ;
+  *comm = MPI_Comm_f2c( *Fcomm ) ;
+
+  xy = *xy0 ;
+  n3dR = *n3dR0 ; n2dR = *n2dR0 ; typesizeR = *typesizeR0 ;
+  n3dI = *n3dI0 ; n2dI = *n2dI0 ; typesizeI = *typesizeI0 ;
+  n3dD = *n3dD0 ; n2dD = *n2dD0 ; typesizeD = *typesizeD0 ;
+  n3dL = *n3dL0 ; n2dL = *n2dL0 ; typesizeL = *typesizeL0 ;
+  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
+  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
+
+  if ( nbytes == NULL ) nbytes = RSL_MALLOC ( int , np ) ;
+  if ( x_curs == NULL ) x_curs = RSL_MALLOC ( int , np ) ;
+  if ( x_peermask == NULL ) x_peermask = RSL_MALLOC ( int , np ) ;
+  if ( x_recv == NULL ) x_recv = RSL_MALLOC ( MPI_Request , np ) ;
+  if ( x_send == NULL ) x_send = RSL_MALLOC ( MPI_Request , np ) ;
+  for ( i = 0 ; i < np ; i++ ) { nbytes[i] = 0 ; x_curs[i] = 0 ; x_peermask[i] = 0 ; }
+
+  if ( xy == 1 ) {   /* xy = 1, swap in X, otherwise Y */
+    n = (ide-ids+1)/4*2 ;
+    m = n*2 ;
+    ps = ips ;
+    pe = ipe ;
+    ops = jps ;
+    ope = jpe ;
+  } else {
+    n = (jde-jds+1)/4*2 ;
+    m = n*2 ;
+    ps = jps ;
+    pe = jpe ;
+    ops = ips ;
+    ope = ipe ;
+  }
+
+  for ( i = UP_ODD( ps ) ; i <= MIN(pe,m) ; i+=2 ) {
+    ii = abs(i+n) % m ;
+    if ( xy == 1 ) {
+      TASK_FOR_POINT ( &ii , &jps , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+      coords[1] = Px ; coords[0] = Py ;
+      MPI_Cart_rank( *comm, coords, &P ) ;
+    } else {
+      TASK_FOR_POINT ( &ips , &ii , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+      coords[1] = Px ; coords[0] = Py ;
+      MPI_Cart_rank( *comm, coords, &P ) ;
+    }
+    nbytes[P] += typesizeR*(ope-ops+1)*(n3dR*(kpe-kps+1)+n2dR) +
+                 typesizeI*(ope-ops+1)*(n3dI*(kpe-kps+1)+n2dI) +
+                 typesizeD*(ope-ops+1)*(n3dD*(kpe-kps+1)+n2dD) +
+                 typesizeL*(ope-ops+1)*(n3dL*(kpe-kps+1)+n2dL) ;
+    x_peermask[P] = 1 ;
+  }
+
+  for ( P = 0 ; P < np ; P++ ) {
+     if ( x_peermask[P] ) {
+       buffer_for_proc ( P , nbytes[P], RSL_RECVBUF ) ;
+       buffer_for_proc ( P , nbytes[P], RSL_SENDBUF ) ;
+     }
+  }
+}
+
+RSL_LITE_PACK_SWAP ( int * Fcomm , char * buf , int * odd0 , int * typesize0 , int * xy0 , int * pu0 , char * memord , int * xstag0 ,
+           int *me0, int * np0 , int * np_x0 , int * np_y0 , 
+           int * ids0 , int * ide0 , int * jds0 , int * jde0 , int * kds0 , int * kde0 ,
+           int * ims0 , int * ime0 , int * jms0 , int * jme0 , int * kms0 , int * kme0 ,
+           int * ips0 , int * ipe0 , int * jps0 , int * jpe0 , int * kps0 , int * kpe0 )
+{
+  int me, np, np_x, np_y ;
+  int odd , typesize ;
+  int ids , ide , jds , jde , kds , kde ;
+  int ims , ime , jms , jme , kms , kme ;
+  int ips , ipe , jps , jpe , kps , kpe ;
+  int xstag ;  /* 0 not stag, 1 stag */
+  int xy ;   /* y = 0 , x = 1 */
+  int pu ;   /* pack = 0 , unpack = 1 */
+  int i, ii, j, jj, m, n  ;
+  int ps, pe, ops, ope ;
+  register int k, t ;
+#ifdef crayx1
+  register int i2,i3,i4,i_offset;
+#endif
+  char *p ;
+  int da_buf ;
+  int Px, Py, P, coords[2] ;
+  int ierr = 0 ;
+  register int *pi, *qi ;
+  float f ;
+  MPI_Comm *comm, dummy_comm ;
+
+  comm = &dummy_comm ;
+  *comm = MPI_Comm_f2c( *Fcomm ) ;
+
+  me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+  xstag = *xstag0 ;
+  odd = *odd0 ; typesize = *typesize0 ;
+  ids = *ids0-1 ; ide = *ide0-1 ; jds = *jds0-1 ; jde = *jde0-1 ; kds = *kds0-1 ; kde = *kde0-1 ;
+  ims = *ims0-1 ; ime = *ime0-1 ; jms = *jms0-1 ; jme = *jme0-1 ; kms = *kms0-1 ; kme = *kme0-1 ;
+  ips = *ips0-1 ; ipe = *ipe0-1 ; jps = *jps0-1 ; jpe = *jpe0-1 ; kps = *kps0-1 ; kpe = *kpe0-1 ;
+  xy = *xy0 ;
+  pu = *pu0 ;
+
+/* need to adapt for other memory orders */
+#define RANGE(S1,E1,S2,E2,S3,E3,S4,E4) (((E1)-(S1)+1)*((E2)-(S2)+1)*(((E3)-(S3)+1)/2)*((E4)-(S4)+1))
+#define IMAX(A) (((A)>ids)?(A):ids)
+#define IMIN(A) (((A)<ide)?(A):ide)
+#define JMAX(A) (((A)>jds)?(A):jds)
+#define JMIN(A) (((A)<jde)?(A):jde)
+
+  da_buf = ( pu == 0 ) ? RSL_SENDBUF : RSL_RECVBUF ;
+
+
+  if ( xy == 1 ) {   /* xy = 1, swap in X, otherwise Y */
+    n = (ide-ids+1)/4*2 ;
+    m = n*2 ;
+  } else {
+    n = (jde-jds+1)/4*2 ;
+    m = n*2 ;
+  }
+
+  if ( np_x > 1 && xy == 1 ) {
+
+    for ( i = UP_ODD(ips) ; i <= MIN(ipe,m) ; i+=2 ) {
+      ii = abs(i+n) % m ;
+      TASK_FOR_POINT ( &ii , &jps , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+      coords[1] = Px ; coords[0] = Py ;
+      MPI_Cart_rank( *comm, coords, &P ) ;
+      p = buffer_for_proc( P , 0 , da_buf ) ;
+      if ( pu == 0 ) {
+	if ( typesize == sizeof(int) ) {
+          for ( j = JMAX(jps) ; j <= JMIN(jpe) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+x_curs[P]) ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+	      *pi++ = *qi++ ;
+	      x_curs[P] += typesize ;
+	    }
+	  }
+	}
+	else {
+          for ( j = JMAX(jps) ; j <= JMIN(jpe) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( t = 0 ; t < typesize ; t++ ) {
+                *(p+x_curs[P]) = 
+                               *(buf + t + typesize*(
+                                      (i-ims) + (ime-ims+1)*(
+                                      (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                x_curs[P]++ ;
+              }
+            }
+          }
+	}
+      } else {
+	if ( typesize == sizeof(int) ) {
+          for ( j = JMAX(jps) ; j <= JMIN(jpe) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+x_curs[P]) ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+	      *qi++ = *pi++ ;
+	      x_curs[P] += typesize ;
+	    }
+	  }
+	}
+	else {
+          for ( j = JMAX(jps) ; j <= JMIN(jpe) ; j++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( t = 0 ; t < typesize ; t++ ) {
+                               *(buf + t + typesize*(
+                                      (i-ims) + (ime-ims+1)*(
+                                      (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                *(p+x_curs[P]) ;
+                x_curs[P]++ ;
+              }
+            }
+          }
+        }
+      }
+    }
+  } else if ( np_y > 1 && xy == 0 ) {
+    for ( j = UP_ODD(jps) ; j <= MIN(jpe,m) ; j+=2 ) {
+      jj = abs(j+n) % m ;
+      TASK_FOR_POINT ( &ips , &jj , &ids, &ide , &jds, &jde , &np_x , &np_y , &Px, &Py ) ;
+      coords[1] = Px ; coords[0] = Py ;
+      MPI_Cart_rank( *comm, coords, &P ) ;
+      p = buffer_for_proc( P , 0 , da_buf ) ;
+      if ( pu == 0 ) {
+	if ( typesize == sizeof(int) ) {
+          for ( i = IMAX(ips) ; i <= IMIN(ipe) ; i++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+x_curs[P]) ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+	      *pi++ = *qi++ ;
+	      x_curs[P] += typesize ;
+	    }
+	  }
+	}
+	else {
+          for ( i = IMAX(ips) ; i <= IMIN(ipe) ; i++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( t = 0 ; t < typesize ; t++ ) {
+                *(p+x_curs[P]) = 
+                               *(buf + t + typesize*(
+                                      (i-ims) + (ime-ims+1)*(
+                                      (k-kms) + (j-jms)*(kme-kms+1))) ) ;
+                x_curs[P]++ ;
+              }
+            }
+          }
+	}
+      } else {
+	if ( typesize == sizeof(int) ) {
+          for ( i = IMAX(ips) ; i <= IMIN(ipe) ; i++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+	      pi = (int *)(p+x_curs[P]) ;
+	      qi = (int *)((buf + typesize*( (i-ims) + (ime-ims+1)*(
+                                             (k-kms) + (j-jms)*(kme-kms+1))))) ;
+	      *qi++ = *pi++ ;
+	      x_curs[P] += typesize ;
+	    }
+	  }
+	}
+	else {
+          for ( i = IMAX(ips) ; i <= IMIN(ipe) ; i++ ) {
+            for ( k = kps ; k <= kpe ; k++ ) {
+              for ( t = 0 ; t < typesize ; t++ ) {
+                               *(buf + t + typesize*(
+                                      (i-ims) + (ime-ims+1)*(
+                                      (k-kms) + (j-jms)*(kme-kms+1))) ) =
+                *(p+x_curs[P]) ;
+                x_curs[P]++ ;
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+}
+
+RSL_LITE_SWAP ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 )
+{
+  int me, np, np_x, np_y ;
+  int yp, ym, xp, xm, nb ;
+  MPI_Status stat ;
+  MPI_Comm comm, *comm0, dummy_comm ;
+  int i, P ;
+
+  comm0 = &dummy_comm ;
+  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
+#if 1
+
+  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
+
+/* fprintf(stderr,"RSL_LITE_SWAP\n") ; */
+
+  for ( P = 0 ; P < np ; P++ ) {
+    if ( x_peermask[P] ) {
+      nb = buffer_size_for_proc( P, RSL_RECVBUF ) ;
+/* fprintf(stderr,"posting irecv from %d, nb = %d\n",P,nb) ; */
+      MPI_Irecv ( buffer_for_proc( P, x_curs[P], RSL_RECVBUF ), nb, MPI_CHAR, P, me, comm, &(x_recv[P]) ) ;
+/* fprintf(stderr,"sending to         %d, nb = %d\n",P,x_curs[P]) ; */
+      MPI_Isend ( buffer_for_proc( P, 0,         RSL_SENDBUF ), x_curs[P], MPI_CHAR, P, P, comm, &(x_send[P]) ) ;
+    }
+  }
+  for ( P = 0 ; P < np ; P++ ) {
+    if ( x_peermask[P] ) {
+      MPI_Wait( &x_recv[P], &stat ) ; 
+      MPI_Wait( &x_send[P], &stat ) ; 
+    }
+  }
+#else 
+fprintf(stderr,"RSL_LITE_SWAP disabled\n") ;
+#endif
+  for ( i = 0 ; i < np ; i++ ) {  x_curs[i] = 0 ;  }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/RSL_LITE/task_for_point.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/RSL_LITE/task_for_point.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/RSL_LITE/task_for_point.c	(revision 2744)
@@ -0,0 +1,97 @@
+#include <stdio.h>
+#include "rsl_lite.h"
+
+/* updated 20051021, new algorithm distributes the remainder, if any, at either ends of the dimension
+   rather than the first remainder number of processors in the dimension. Idea is that the processes
+   on the ends have less work because they're boundary processes.  New alg works like this:
+                     a                         b
+         + + + + + + o o o o o o o o o o o o o + + + + + +
+
+   + represents a process with an extra point (npoints is n/p+1), o processors that don't (n/p)
+   a and b are the starting process indices in the dimension of the new section of o or x.
+   JM
+*/
+
+TASK_FOR_POINT ( i_p , j_p , ids_p, ide_p , jds_p, jde_p , npx_p , npy_p , Px_p, Py_p )
+  int_p i_p , j_p , Px_p , Py_p , ids_p, ide_p , jds_p, jde_p , npx_p , npy_p ;
+{
+  int i , j , ids, ide, jds, jde, npx, npy ;  /* inputs */
+  int Px, Py ;                                /* output */
+  int idim, jdim ;
+  int rem, a, b ;
+  i = *i_p - 1 ;
+  j = *j_p - 1 ;
+  npx = *npx_p ;
+  npy = *npy_p ;
+  ids = *ids_p - 1 ; ide = *ide_p - 1 ;
+  jds = *jds_p - 1 ; jde = *jde_p - 1 ;
+  idim = ide - ids + 1 ;
+  jdim = jde - jds + 1 ;
+
+  i = i >= ids ? i : ids ; i = i <= ide ? i : ide ;
+  rem = idim % npx ;
+  a = ( rem / 2 ) * ( (idim / npx) + 1 ) ;
+  b = a + ( npx - rem ) * ( idim / npx ) ;
+  if ( i-ids < a ) {
+    Px = (i-ids) / ( (idim / npx) + 1 ) ;
+  }
+  else if ( i-ids < b ) {
+    Px = ( a / ( (idim / npx) + 1 ) ) + (i-a-ids) / ( ( b - a ) / ( npx - rem ) )     ;
+  }
+  else {
+    Px = ( a / ( (idim / npx) + 1 ) ) + (b-a-ids) / ( ( b - a ) / ( npx - rem ) ) +
+                                        (i-b-ids) / ( ( idim / npx ) + 1 )  ;
+  }
+
+  j = j >= jds ? j : jds ; j = j <= jde ? j : jde ;
+  rem = jdim % npy ;
+  a = ( rem / 2 ) * ( (jdim / npy) + 1 ) ;
+  b = a + ( npy - rem ) * ( jdim / npy ) ;
+  if ( j-jds < a ) {
+    Py = (j-jds) / ( (jdim / npy) + 1 ) ;
+  }
+  else if ( j-jds < b ) {
+    Py = ( a / ( (jdim / npy) + 1 ) ) + (j-a-jds) / ( ( b - a ) / ( npy - rem ) )     ;
+  }
+  else {
+    Py = ( a / ( (jdim / npy) + 1 ) ) + (b-a-jds) / ( ( b - a ) / ( npy - rem ) ) +
+                                        (j-b-jds) / ( ( jdim / npy ) + 1 )  ;
+  }
+
+  *Px_p = Px ;
+  *Py_p = Py ;
+}
+
+#if 0
+main()
+{
+  int ips[100], ipe[100] ;
+  int jps[100], jpe[100] ;
+  int shw, i , j , ids, ide, jds, jde, npx, npy ;  /* inputs */
+  int Px, Py, P ;                             /* output */
+  printf("i, j, ids, ide, jds, jde, npx, npy\n") ;
+  scanf("%d %d %d %d %d %d %d %d",&i, &j, &ids,&ide,&jds,&jde,&npx,&npy ) ;
+  shw =0 ;
+  for ( i = 0 ; i < 100 ; i++ ) { ips[i] = 9999999 ; ipe[i] = -99999999 ; }
+  for ( i = 0 ; i < 100 ; i++ ) { jps[i] = 9999999 ; jpe[i] = -99999999 ; }
+#if 1
+  for ( j = jds-shw ; j <= jde+shw ; j++ )
+  {
+  for ( i = ids-shw ; i <= ide+shw ; i++ )
+  {
+#endif
+  TASK_FOR_POINT ( &i , &j ,
+                   &ids, &ide, &jds, &jde , &npx , &npy ,
+                   &Px, &Py ) ;
+/*  printf("%3d",P) ; */
+#if 1
+  }
+/*  printf("\n") ; */
+  }
+for ( i = 0 ; i < npx*npy ; i++ ) {
+  fprintf(stderr,"%3d. ips %d ipe %d (%d) jps %d jpe %d (%d)\n", i, ips[i], ipe[i], ipe[i]-ips[i]+1, jps[i], jpe[i], jpe[i]-jps[i]+1 ) ;
+}
+#endif
+}
+#endif
+
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Alarm.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Alarm.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Alarm.F90	(revision 2744)
@@ -0,0 +1,960 @@
+!
+! Earth System Modeling Framework
+! Copyright 2002-2003, University Corporation for Atmospheric Research,
+! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+! Laboratory, University of Michigan, National Centers for Environmental
+! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+! NASA Goddard Space Flight Center.
+! Licensed under the GPL.
+!
+!==============================================================================
+!
+!     ESMF Alarm Module
+      module ESMF_AlarmMod
+!
+!==============================================================================
+!
+! This file contains the Alarm class definition and all Alarm class 
+! methods.
+!
+!------------------------------------------------------------------------------
+! INCLUDES
+#include <ESMF_TimeMgr.inc>
+
+!===============================================================================
+!BOPI
+!
+! !MODULE: ESMF_AlarmMod
+!
+! !DESCRIPTION:
+! Part of Time Manager F90 API wrapper of C++ implemenation
+!
+! Defines F90 wrapper entry points for corresponding
+! C++ class {\tt ESMC\_Alarm}
+!
+! See {\tt ../include/ESMC\_Alarm.h} for complete description
+!
+!------------------------------------------------------------------------------
+! !USES:
+      ! inherit from ESMF base class
+      use ESMF_BaseMod
+
+      ! associated derived types
+      use ESMF_TimeIntervalMod, only : ESMF_TimeInterval, &
+                                       ESMF_TimeIntervalAbsValue
+      use ESMF_TimeMod,         only : ESMF_Time
+
+      implicit none
+
+!------------------------------------------------------------------------------
+! !PRIVATE TYPES:
+     private
+!------------------------------------------------------------------------------
+!     ! ESMF_Alarm
+!
+!     ! F90 class type to match C++ Alarm class in size only;
+!     !  all dereferencing within class is performed by C++ implementation
+
+! internals for ESMF_Alarm
+      type ESMF_AlarmInt
+        type(ESMF_TimeInterval) :: RingInterval
+        type(ESMF_Time)  :: RingTime
+        type(ESMF_Time)  :: PrevRingTime
+        type(ESMF_Time)  :: StopTime
+        integer :: ID
+        integer :: AlarmMutex
+        logical :: Ringing
+        logical :: Enabled
+        logical :: RingTimeSet
+        logical :: RingIntervalSet
+        logical :: StopTimeSet
+      end type
+
+! Actual public type:  this bit allows easy mimic of "deep" ESMF_AlarmCreate
+! in ESMF 2.1.0+.  Note that ESMF_AlarmCreate is in a separate module to avoid 
+! cyclic dependence.  
+! NOTE:  DO NOT ADD NON-POINTER STATE TO THIS DATA TYPE.  It emulates ESMF 
+!        shallow-copy-masquerading-as-reference-copy insanity.  
+      type ESMF_Alarm
+        type(ESMF_AlarmInt), pointer :: alarmint
+      end type
+
+!------------------------------------------------------------------------------
+! !PUBLIC TYPES:
+      public ESMF_Alarm
+      public ESMF_AlarmInt   ! needed on AIX but not PGI
+!------------------------------------------------------------------------------
+
+! !PUBLIC MEMBER FUNCTIONS:
+      public ESMF_AlarmDestroy
+      public ESMF_AlarmSet
+      public ESMF_AlarmGet
+!      public ESMF_AlarmGetRingInterval
+!      public ESMF_AlarmSetRingInterval
+!      public ESMF_AlarmGetRingTime
+!      public ESMF_AlarmSetRingTime
+!      public ESMF_AlarmGetPrevRingTime
+!      public ESMF_AlarmSetPrevRingTime
+!      public ESMF_AlarmGetStopTime
+!      public ESMF_AlarmSetStopTime
+      public ESMF_AlarmEnable
+      public ESMF_AlarmDisable
+      public ESMF_AlarmRingerOn
+      public ESMF_AlarmRingerOff
+      public ESMF_AlarmIsRinging
+!      public ESMF_AlarmCheckRingTime
+      public operator(==)
+ 
+! Required inherited and overridden ESMF_Base class methods
+
+!      public ESMF_AlarmRead
+!      public ESMF_AlarmWrite
+      public ESMF_AlarmValidate
+      public ESMF_AlarmPrint
+
+! !PRIVATE MEMBER FUNCTIONS:
+      private ESMF_AlarmEQ
+!EOPI
+
+!==============================================================================
+!
+! INTERFACE BLOCKS
+!
+!==============================================================================
+!BOP
+! !INTERFACE:
+      interface operator(==)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_AlarmEQ
+
+! !DESCRIPTION:
+!     This interface overloads the == operator for the {\tt ESMF\_Alarm} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+
+!==============================================================================
+
+      contains
+
+!==============================================================================
+
+!------------------------------------------------------------------------------
+!
+! This section includes the Set methods.
+!
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_AlarmSet - Initializes an alarm
+
+! !INTERFACE:
+      subroutine ESMF_AlarmSet(alarm, RingTime, RingInterval, &
+                               StopTime, Enabled, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      type(ESMF_Time), intent(in), optional :: RingTime
+      type(ESMF_TimeInterval), intent(in), optional :: RingInterval
+      type(ESMF_Time), intent(in), optional :: StopTime
+      logical, intent(in), optional :: Enabled
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Initializes an {\tt ESMF\_Alarm}
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to initialize
+!     \item[{[RingTime]}]
+!          Optional ring time for one-shot or first repeating alarm
+!     \item[{[RingInterval]}]
+!          Optional ring interval for repeating alarms
+!     \item[{[StopTime]}]
+!          Optional stop time for repeating alarms
+!     \item[Enabled]
+!          Alarm enabled/disabled
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.1, TMG4.7
+!EOP
+      IF ( ASSOCIATED( alarm%alarmint ) ) THEN
+        alarm%alarmint%RingTimeSet = .FALSE.
+        alarm%alarmint%RingIntervalSet = .FALSE.
+        alarm%alarmint%StopTimeSet = .FALSE.
+        IF ( PRESENT( RingInterval ) ) THEN
+          ! force RingInterval to be positive
+          alarm%alarmint%RingInterval = &
+            ESMF_TimeIntervalAbsValue( RingInterval )
+          alarm%alarmint%RingIntervalSet = .TRUE.
+        ENDIF
+        IF ( PRESENT( RingTime ) ) THEN
+          alarm%alarmint%RingTime = RingTime
+          alarm%alarmint%RingTimeSet = .TRUE.
+        ENDIF
+        IF ( PRESENT( StopTime ) ) THEN
+          alarm%alarmint%StopTime = StopTime
+          alarm%alarmint%StopTimeSet = .TRUE.
+        ENDIF
+        alarm%alarmint%Enabled = .TRUE.
+        IF ( PRESENT( Enabled ) ) THEN
+          alarm%alarmint%Enabled = Enabled
+        ENDIF
+        IF ( PRESENT( rc ) ) THEN
+          rc = ESMF_SUCCESS
+        ENDIF
+        alarm%alarmint%Ringing = .FALSE.
+        alarm%alarmint%Enabled = .TRUE.
+      ELSE
+        IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      ENDIF
+
+      end subroutine ESMF_AlarmSet
+
+
+
+! Deallocate memory for ESMF_Alarm
+      SUBROUTINE ESMF_AlarmDestroy( alarm, rc )
+         TYPE(ESMF_Alarm), INTENT(INOUT) :: alarm
+         INTEGER,          INTENT(  OUT), OPTIONAL :: rc
+         IF ( ASSOCIATED( alarm%alarmint ) ) THEN
+           DEALLOCATE( alarm%alarmint )
+         ENDIF
+         ! TBH:  ignore deallocate errors, for now
+         IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+      END SUBROUTINE ESMF_AlarmDestroy
+
+
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_AlarmGetRingInterval - Get an alarm's ring interval
+!
+! !INTERFACE:
+      subroutine ESMF_AlarmGetRingInterval(alarm, RingInterval, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm
+      type(ESMF_TimeInterval), intent(out) :: RingInterval
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Alarm}'s ring interval
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to get the ring interval
+!     \item[RingInterval]
+!          The {\tt Alarm}'s ring interval
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+
+! !REQUIREMENTS:
+!     TMG4.7
+!EOP
+      RingInterval = alarm%alarmint%RingInterval
+
+      end subroutine ESMF_AlarmGetRingInterval
+ 
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_AlarmSetRingInterval - Set an alarm's ring interval
+!
+! !INTERFACE:
+      subroutine ESMF_AlarmSetRingInterval(alarm, RingInterval, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      type(ESMF_TimeInterval), intent(in) :: RingInterval
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Set an {\tt ESMF\_Alarm}'s ring interval
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to set the ring interval
+!     \item[RingInterval]
+!          The {\tt Alarm}'s ring interval
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.5.2, TMG4.7
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmSetRingInterval not supported' )
+      end subroutine ESMF_AlarmSetRingInterval
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmGetRingTime - Get an alarm's time to ring
+!
+! !INTERFACE:
+      subroutine ESMF_AlarmGetRingTime(alarm, RingTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm
+      type(ESMF_Time), intent(out) :: RingTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Alarm}'s time to ring
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to get the ring time
+!     \item[RingTime]
+!          The {\tt ESMF\_Alarm}'s ring time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.7, TMG4.8
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmGetRingTime not supported' )
+      end subroutine ESMF_AlarmGetRingTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmSetRingTime - Set an alarm's time to ring
+!
+! !INTERFACE:
+      subroutine ESMF_AlarmSetRingTime(alarm, RingTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      type(ESMF_Time), intent(in) :: RingTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Set an {\tt ESMF\_Alarm}'s time to ring
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to set the ring time
+!     \item[RingTime]
+!          The {\tt ESMF\_Alarm}'s ring time to set
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.5.1, TMG4.7, TMG4.8
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmSetRingTime not supported' )
+      end subroutine ESMF_AlarmSetRingTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmGet - Get an alarm's parameters -- compatibility with ESMF 2.0.1
+!
+! !INTERFACE:
+      subroutine ESMF_AlarmGet(alarm, PrevRingTime, RingInterval, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm
+      type(ESMF_Time), intent(out), optional :: PrevRingTime
+      type(ESMF_TimeInterval), intent(out), optional :: RingInterval
+      integer, intent(out), optional :: rc
+      integer :: ierr
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Alarm}'s previous ring time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to get the previous ring time
+!     \item[PrevRingTime]
+!          The {\tt ESMF\_Alarm}'s previous ring time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.7, TMG4.8
+!EOP
+
+      ierr = ESMF_SUCCESS
+
+      IF ( PRESENT(PrevRingTime) ) THEN
+        CALL ESMF_AlarmGetPrevRingTime(alarm, PrevRingTime, rc=ierr)
+      ENDIF
+      IF ( PRESENT(RingInterval) ) THEN
+        CALL ESMF_AlarmGetRingInterval(alarm, RingInterval, rc=ierr)
+      ENDIF
+
+      IF ( PRESENT(rc) ) THEN
+        rc = ierr
+      ENDIF
+
+      end subroutine ESMF_AlarmGet
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmGetPrevRingTime - Get an alarm's previous ring time
+!
+! !INTERFACE:
+      subroutine ESMF_AlarmGetPrevRingTime(alarm, PrevRingTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm
+      type(ESMF_Time), intent(out) :: PrevRingTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Alarm}'s previous ring time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to get the previous ring time
+!     \item[PrevRingTime]
+!          The {\tt ESMF\_Alarm}'s previous ring time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.7, TMG4.8
+!EOP
+      IF ( ASSOCIATED( alarm%alarmint ) ) THEN
+        PrevRingTime = alarm%alarmint%PrevRingTime
+        IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+      ELSE
+        IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      ENDIF
+      end subroutine ESMF_AlarmGetPrevRingTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmSetPrevRingTime - Set an alarm's previous ring time
+!
+! !INTERFACE:
+      subroutine ESMF_AlarmSetPrevRingTime(alarm, PrevRingTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      type(ESMF_Time), intent(in) :: PrevRingTime
+      integer, intent(out), optional :: rc
+   
+! !DESCRIPTION:
+!     Set an {\tt ESMF\_Alarm}'s previous ring time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to set the previous ring time
+!     \item[PrevRingTime]
+!          The {\tt ESMF\_Alarm}'s previous ring time to set
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.7, TMG4.8
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmSetPrevRingTime not supported' )
+      end subroutine ESMF_AlarmSetPrevRingTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmGetStopTime - Get an alarm's stop time
+!
+! !INTERFACE:
+      subroutine ESMF_AlarmGetStopTime(alarm, StopTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm
+      type(ESMF_Time), intent(out) :: StopTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Alarm}'s stop time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to get the stop time
+!     \item[StopTime]
+!          The {\tt ESMF\_Alarm}'s stop time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.5.2, TMG4.7
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmGetStopTime not supported' )
+      end subroutine ESMF_AlarmGetStopTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmSetStopTime - Set an alarm's stop time
+!
+! !INTERFACE:
+      subroutine ESMF_AlarmSetStopTime(alarm, StopTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      type(ESMF_Time), intent(in) :: StopTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Set an {\tt ESMF\_Alarm}'s stop time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to set the stop time
+!     \item[StopTime]
+!          The {\tt ESMF\_Alarm}'s stop time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.5.2, TMG4.7
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmSetStopTime not supported' )
+      end subroutine ESMF_AlarmSetStopTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_AlarmEnable - Enables an alarm
+
+! !INTERFACE:
+      subroutine ESMF_AlarmEnable(alarm, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Enables an {\tt ESMF\_Alarm} to function
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to enable
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+
+! !REQUIREMENTS:
+!     TMG4.5.3
+!EOP
+      IF ( ASSOCIATED( alarm%alarmint ) ) THEN
+        alarm%alarmint%Enabled = .TRUE.
+        IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+      ELSE
+        IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      ENDIF
+      end subroutine ESMF_AlarmEnable
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_AlarmDisable - Disables an alarm
+
+! !INTERFACE:
+      subroutine ESMF_AlarmDisable(alarm, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Disables an {\tt ESMF\_Alarm}
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to disable
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+
+! !REQUIREMENTS:
+!     TMG4.5.3
+!EOP
+      IF ( ASSOCIATED( alarm%alarmint ) ) THEN
+        alarm%alarmint%Enabled = .FALSE.
+        IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+      ELSE
+        IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      ENDIF
+      end subroutine ESMF_AlarmDisable
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmRingerOn - Turn on an alarm
+
+
+! !INTERFACE:
+      subroutine ESMF_AlarmRingerOn(alarm, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      integer, intent(out), optional :: rc
+    
+! !DESCRIPTION:
+!     Turn on an {\tt ESMF\_Alarm}; sets ringing state
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to turn on
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG4.6
+!EOP
+      IF ( ASSOCIATED( alarm%alarmint ) ) THEN
+        IF ( alarm%alarmint%Enabled ) THEN
+          alarm%alarmint%Ringing = .TRUE.
+          IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+        ELSE
+          alarm%alarmint%Ringing = .FALSE.
+          IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+        ENDIF
+      ELSE
+        IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      ENDIF
+
+      end subroutine ESMF_AlarmRingerOn
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmRingerOff - Turn off an alarm
+
+! !INTERFACE:
+      subroutine ESMF_AlarmRingerOff(alarm, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      integer, intent(out), optional :: rc
+    
+! !DESCRIPTION:
+!     Turn off an {\tt ESMF\_Alarm}; unsets ringing state
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to turn off   
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+
+! !REQUIREMENTS:
+!     TMG4.6
+!EOP
+      IF ( ASSOCIATED( alarm%alarmint ) ) THEN
+        alarm%alarmint%Ringing = .FALSE.
+        IF ( alarm%alarmint%Enabled ) THEN
+          IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+        ELSE
+          IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+        ENDIF
+      ELSE
+        IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      ENDIF
+      end subroutine ESMF_AlarmRingerOff
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmIsRinging - Check if alarm is ringing
+
+! !INTERFACE:
+      function ESMF_AlarmIsRinging(alarm, rc)
+!
+! !RETURN VALUE:
+      logical :: ESMF_AlarmIsRinging
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Check if {\tt ESMF\_Alarm} is ringing.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to check for ringing state  
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+
+! !REQUIREMENTS:
+!     TMG4.4
+!EOP
+      IF ( ASSOCIATED( alarm%alarmint ) ) THEN
+        IF ( alarm%alarmint%Enabled ) THEN
+          ESMF_AlarmIsRinging = alarm%alarmint%Ringing
+          IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+        ELSE
+          ESMF_AlarmIsRinging = .FALSE.
+          IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+        ENDIF
+      ELSE
+        IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      ENDIF
+      end function ESMF_AlarmIsRinging
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_AlarmCheckRingTime - Method used by a clock to check whether to trigger an alarm
+!
+! !INTERFACE:
+      function ESMF_AlarmCheckRingTime(alarm, ClockCurrTime, positive, rc)
+!
+! !RETURN VALUE:
+      logical :: ESMF_AlarmCheckRingTime
+!
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(inout) :: alarm
+      type(ESMF_Time), intent(in) :: ClockCurrTime
+      integer, intent(in) :: positive
+      integer, intent(out), optional :: rc
+!
+! !DESCRIPTION:
+!     Main method used by a {\tt ESMF\_Clock} to check whether to trigger
+!     the {\tt ESMF\_Alarm} 
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to check if time to ring   
+!     \item[ClockCurrTime]
+!          The {\tt ESMF\_Clock}'s current time
+!     \item[positive]
+!          Whether to check ring time in the positive or negative direction
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+
+! !REQUIREMENTS:
+!     TMG4.4, TMG4.6
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmCheckRingTime not supported' )
+      ESMF_AlarmCheckRingTime = .FALSE.  ! keep compilers happy
+      end function ESMF_AlarmCheckRingTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmEQ - Compare two alarms for equality
+!
+! !INTERFACE:
+      function ESMF_AlarmEQ(alarm1, alarm2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_AlarmEQ
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm1
+      type(ESMF_Alarm), intent(in) :: alarm2
+
+! !DESCRIPTION:
+!     Compare two alarms for equality; return true if equal, false otherwise
+!     Maps to overloaded (==) operator interface function
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm1]
+!          The first {\tt ESMF\_Alarm} to compare
+!     \item[alarm2]
+!          The second {\tt ESMF\_Alarm} to compare
+!     \end{description}
+!
+! !REQUIREMENTS:  
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmEQ not supported ' )
+      ESMF_AlarmEQ = .FALSE.       ! keep compilers happy
+      end function ESMF_AlarmEQ
+
+!------------------------------------------------------------------------------
+!
+! This section defines the overridden Read, Write, Validate and Print methods
+! from the ESMF_Base class
+!
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_AlarmRead - restores an alarm
+
+! !INTERFACE:
+      subroutine ESMF_AlarmRead(alarm, RingInterval, RingTime, &
+                           PrevRingTime, StopTime, Ringing, &
+                           Enabled, ID, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(out) :: alarm
+      type(ESMF_TimeInterval), intent(in) :: RingInterval
+      type(ESMF_Time), intent(in) :: RingTime
+      type(ESMF_Time), intent(in) :: PrevRingTime
+      type(ESMF_Time), intent(in) :: StopTime
+      logical, intent(in) :: Ringing
+      logical, intent(in) :: Enabled
+      integer, intent(in) :: ID
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Restores an {\tt ESMF\_Alarm}
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to restore
+!     \item[RingInterval]
+!          The ring interval for repeating alarms
+!     \item[RingTime]
+!          Ring time for one-shot or first repeating alarm
+!     \item[PrevRingTime]
+!          The {\tt ESMF\_Alarm}'s previous ring time
+!     \item[StopTime]
+!          Stop time for repeating alarms
+!     \item[Ringing]
+!          The {\tt ESMF\_Alarm}'s ringing state
+!     \item[Enabled]
+!          {\tt ESMF\_Alarm} enabled/disabled
+!     \item[ID]
+!          The {\tt ESMF\_Alarm}'s ID
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmRead not supported' )
+      end subroutine ESMF_AlarmRead
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_AlarmWrite - saves an alarm
+
+! !INTERFACE:
+      subroutine ESMF_AlarmWrite(alarm, RingInterval, RingTime, &
+                            PrevRingTime, StopTime, Ringing, &
+                            Enabled, ID, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm
+      type(ESMF_TimeInterval), intent(out) :: RingInterval
+      type(ESMF_Time), intent(out) :: RingTime
+      type(ESMF_Time), intent(out) :: PrevRingTime
+      type(ESMF_Time), intent(out) :: StopTime
+      logical, intent(out) :: Ringing
+      logical, intent(out) :: Enabled
+      integer, intent(out) :: ID
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Saves an {\tt ESMF\_Alarm}
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          The object instance to save
+!     \item[RingInterval]
+!          Ring interval for repeating alarms
+!     \item[RingTime]
+!          Ring time for one-shot or first repeating alarm
+!     \item[PrevRingTime]
+!          The {\tt ESMF\_Alarm}'s previous ring time
+!     \item[StopTime]
+!          Stop time for repeating alarms
+!     \item[Ringing]
+!          The {\tt ESMF\_Alarm}'s ringing state
+!     \item[Enabled]
+!          {\tt ESMF\_Alarm} enabled/disabled
+!     \item[ID]
+!          The {\tt ESMF\_Alarm}'s ID
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmWrite not supported' )
+      end subroutine ESMF_AlarmWrite
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmValidate - Validate an Alarm's properties
+
+! !INTERFACE:
+      subroutine ESMF_AlarmValidate(alarm, opts, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm
+      character (len=*), intent(in), optional :: opts
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Perform a validation check on a {\tt ESMF\_Alarm}'s properties
+!
+!     The arguments are:  
+!     \begin{description}
+!     \item[alarm]
+!          {\tt ESMF\_Alarm} to validate
+!     \item[{[opts]}]
+!          Validate options
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description} 
+!
+! !REQUIREMENTS:
+!     TMGn.n.n
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmValidate not supported' )
+      end subroutine ESMF_AlarmValidate
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AlarmPrint - Print out an Alarm's properties
+
+! !INTERFACE:
+      subroutine ESMF_AlarmPrint(alarm, opts, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Alarm), intent(in) :: alarm
+      character (len=*), intent(in), optional :: opts
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     To support testing/debugging, print out a {\tt ESMF\_Alarm}'s
+!     properties.
+! 
+!     The arguments are:
+!     \begin{description}
+!     \item[alarm]
+!          {\tt ESMF\_Alarm} to print out
+!     \item[{[opts]}]
+!          Print options
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMGn.n.n
+!EOP
+      CALL wrf_error_fatal( 'ESMF_AlarmPrint not supported' )
+      end subroutine ESMF_AlarmPrint
+
+!------------------------------------------------------------------------------
+
+      end module ESMF_AlarmMod
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_AlarmClock.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_AlarmClock.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_AlarmClock.F90	(revision 2744)
@@ -0,0 +1,96 @@
+!
+! Earth System Modeling Framework
+! Copyright 2002-2003, University Corporation for Atmospheric Research,
+! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+! Laboratory, University of Michigan, National Centers for Environmental
+! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+! NASA Goddard Space Flight Center.
+! Licensed under the GPL.
+!
+!==============================================================================
+!
+!     ESMF Alarm-Clock Module
+      module ESMF_AlarmClockMod
+!
+!==============================================================================
+!
+! This file contains the AlarmCreate method.
+!
+!------------------------------------------------------------------------------
+! INCLUDES
+#include <ESMF_TimeMgr.inc>
+
+!===============================================================================
+!BOPI
+!
+! !MODULE: ESMF_AlarmClockMod
+!
+! !DESCRIPTION:
+! Separate module that uses both ESMF_AlarmMod and ESMF_ClockMod.  
+! Separation is needed to avoid cyclic dependence.  
+!
+! Defines F90 wrapper entry points for corresponding
+! C++ class {\tt ESMC\_Alarm}
+!
+! See {\tt ../include/ESMC\_Alarm.h} for complete description
+!
+!------------------------------------------------------------------------------
+! !USES:
+      ! inherit ESMF_Alarm and ESMF_Clock
+      use ESMF_AlarmMod, only : ESMF_Alarm, ESMF_AlarmSet
+      use ESMF_ClockMod, only : ESMF_Clock, ESMF_ClockAddAlarm
+
+      ! associated derived types
+      use ESMF_TimeIntervalMod, only : ESMF_TimeInterval
+      use ESMF_TimeMod,         only : ESMF_Time
+
+      implicit none
+
+!------------------------------------------------------------------------------
+! !PRIVATE TYPES:
+     private
+!------------------------------------------------------------------------------
+
+! !PUBLIC MEMBER FUNCTIONS:
+      public ESMF_AlarmCreate
+
+!==============================================================================
+
+      contains
+
+!==============================================================================
+
+
+! Create ESMF_Alarm using ESMF 2.1.0+ semantics
+      FUNCTION ESMF_AlarmCreate( clock, RingTime, RingInterval, &
+                                 StopTime, Enabled, rc )
+
+        ! return value
+        type(ESMF_Alarm) :: ESMF_AlarmCreate
+        ! !ARGUMENTS:
+        type(ESMF_Clock), intent(inout), optional :: clock
+        type(ESMF_Time), intent(in), optional :: RingTime
+        type(ESMF_TimeInterval), intent(in), optional :: RingInterval
+        type(ESMF_Time), intent(in), optional :: StopTime
+        logical, intent(in), optional :: Enabled
+        integer, intent(out), optional :: rc
+        ! locals
+        type(ESMF_Alarm) :: alarmtmp
+         ! TBH:  ignore allocate errors, for now
+        ALLOCATE( alarmtmp%alarmint )
+        CALL ESMF_AlarmSet( alarmtmp,                  &
+                            RingTime=RingTime,         &
+                            RingInterval=RingInterval, &
+                            StopTime=StopTime,         &
+                            Enabled=Enabled,           &
+                            rc=rc )
+        IF ( PRESENT ( clock ) ) THEN
+          CALL ESMF_ClockAddAlarm( clock, alarmtmp, rc )
+        ENDIF
+        ESMF_AlarmCreate = alarmtmp
+      END FUNCTION ESMF_AlarmCreate
+
+
+!------------------------------------------------------------------------------
+
+      end module ESMF_AlarmClockMod
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Base.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Base.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Base.F90	(revision 2744)
@@ -0,0 +1,1082 @@
+!
+! Earth System Modeling Framework
+! Copyright 2002-2003, University Corporation for Atmospheric Research,
+! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+! Laboratory, University of Michigan, National Centers for Environmental
+! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+! NASA Goddard Space Flight Center.
+! Licensed under the GPL.
+!
+! ESMF Base Module
+!
+! (all lines between the !BOP and !EOP markers will be included in the
+! automated document processing.)
+!------------------------------------------------------------------------------
+
+!------------------------------------------------------------------------------
+! module definition
+
+      module ESMF_BaseMod
+ 
+!BOP
+! !MODULE: ESMF_BaseMod - Base class for all ESMF classes
+!
+! !DESCRIPTION:
+!
+! The code in this file implements the Base defined type
+!  and functions which operate on all types.  This is an
+!  interface to the actual C++ base class implementation in the ../src dir.
+!
+! See the ESMF Developers Guide document for more details.
+!
+!------------------------------------------------------------------------------
+
+! !USES:
+      implicit none
+!
+! !PRIVATE TYPES:
+      private
+
+!------------------------------------------------------------------------------
+!
+!    Global integer parameters, used frequently
+
+      integer, parameter :: ESMF_SUCCESS = 0, ESMF_FAILURE = -1
+      integer, parameter :: ESMF_MAXSTR = 128
+      integer, parameter :: ESMF_MAXDIM = 7, &
+                            ESMF_MAXDECOMPDIM=3, &
+                            ESMF_MAXGRIDDIM=2
+     
+      integer, parameter :: ESMF_MAJOR_VERSION = 2
+      integer, parameter :: ESMF_MINOR_VERSION = 1
+      integer, parameter :: ESMF_REVISION      = 1
+      integer, parameter :: ESMF_PATCHLEVEL    = 0
+      character(32), parameter :: ESMF_VERSION_STRING = "2.1.1"
+
+!------------------------------------------------------------------------------
+!
+      type ESMF_Status
+      private
+          integer :: status
+      end type
+
+      type(ESMF_Status), parameter :: ESMF_STATE_UNINIT = ESMF_Status(1), &
+                                      ESMF_STATE_READY = ESMF_Status(2), &
+                                      ESMF_STATE_UNALLOCATED = ESMF_Status(3), &
+                                      ESMF_STATE_ALLOCATED = ESMF_Status(4), &
+                                      ESMF_STATE_BUSY = ESMF_Status(5), &
+                                      ESMF_STATE_INVALID = ESMF_Status(6)
+ 
+!------------------------------------------------------------------------------
+!
+      type ESMF_Pointer
+      private
+          integer*8 :: ptr
+      end type
+
+      type(ESMF_Pointer), parameter :: ESMF_NULL_POINTER = ESMF_Pointer(0), &
+                                       ESMF_BAD_POINTER = ESMF_Pointer(-1)
+
+
+!------------------------------------------------------------------------------
+!
+      !! TODO: I believe if we define an assignment(=) operator to convert
+      !!   a datatype into integer, then we could use the type and kind as
+      !!   targets in a select case() statement and make the contents private.
+      !!   (see pg 248 of the "big book")
+      type ESMF_DataType
+      !!private
+          integer :: dtype
+      end type
+
+      type(ESMF_DataType), parameter :: ESMF_DATA_INTEGER = ESMF_DataType(1), &
+                                        ESMF_DATA_REAL = ESMF_DataType(2), &
+                                        ESMF_DATA_LOGICAL = ESMF_DataType(3), &
+                                        ESMF_DATA_CHARACTER = ESMF_DataType(4)
+
+!------------------------------------------------------------------------------
+
+      integer, parameter :: &
+                   ESMF_KIND_I1 = selected_int_kind(2), &
+                   ESMF_KIND_I2 = selected_int_kind(4), &
+                   ESMF_KIND_I4 = selected_int_kind(9), &
+                   ESMF_KIND_I8 = selected_int_kind(18), &
+                   ESMF_KIND_R4 = selected_real_kind(3,25), &
+                   ESMF_KIND_R8 = selected_real_kind(6,45), &
+                   ESMF_KIND_C8 = selected_real_kind(3,25), &
+                   ESMF_KIND_C16 = selected_real_kind(6,45)
+
+!------------------------------------------------------------------------------
+
+      type ESMF_DataValue
+      private
+          type(ESMF_DataType) :: dt
+          integer :: rank
+          ! how do you do values of all types here ? TODO
+          ! in C++ i'd do a union w/ overloaded access funcs
+          integer :: vi
+          !integer, dimension (:), pointer :: vip
+          !real :: vr
+          !real, dimension (:), pointer :: vrp
+          !logical :: vl
+          !logical, pointer :: vlp
+          !character (len=ESMF_MAXSTR) :: vc
+          !character, pointer :: vcp
+      end type
+
+!------------------------------------------------------------------------------
+!
+      type ESMF_Attribute
+      private
+          character (len=ESMF_MAXSTR) :: attr_name
+          type (ESMF_DataType) :: attr_type
+          type (ESMF_DataValue) :: attr_value
+      end type
+
+!------------------------------------------------------------------------------
+!
+      !! TODO: this should be a shallow object, with a simple init() and
+      !!  get() function, and the contents should go back to being private.
+      type ESMF_AxisIndex
+!     !!private
+          integer :: l
+          integer :: r
+          integer :: max
+          integer :: decomp
+          integer :: gstart
+      end type
+
+      !! TODO: same comment as above.
+      type ESMF_MemIndex
+!     !!private
+          integer :: l
+          integer :: r
+          integer :: str
+          integer :: num
+      end type
+
+!------------------------------------------------------------------------------
+!
+      type ESMF_BasePointer
+      private
+          integer*8 :: base_ptr
+      end type
+
+      integer :: global_count = 0
+
+!------------------------------------------------------------------------------
+!
+!     ! WARNING: must match corresponding values in ../include/ESMC_Base.h
+      type ESMF_Logical
+      private
+          integer :: value
+      end type
+
+      type(ESMF_Logical), parameter :: ESMF_TF_UNKNOWN  = ESMF_Logical(1), &
+                                       ESMF_TF_TRUE     = ESMF_Logical(2), &
+                                       ESMF_TF_FALSE    = ESMF_Logical(3)
+
+!------------------------------------------------------------------------------
+!
+      type ESMF_Base
+      private
+         integer :: ID
+         integer :: ref_count
+         type (ESMF_Status) :: base_status
+         character (len=ESMF_MAXSTR) :: name
+     end type
+
+! !PUBLIC TYPES:
+
+      public ESMF_STATE_INVALID
+!      public ESMF_STATE_UNINIT, ESMF_STATE_READY, &
+!             ESMF_STATE_UNALLOCATED, ESMF_STATE_ALLOCATED, &
+!             ESMF_STATE_BUSY
+
+      public ESMF_DATA_INTEGER, ESMF_DATA_REAL, &
+             ESMF_DATA_LOGICAL, ESMF_DATA_CHARACTER
+
+      public ESMF_KIND_I1, ESMF_KIND_I2, ESMF_KIND_I4, ESMF_KIND_I8, & 
+             ESMF_KIND_R4, ESMF_KIND_R8, ESMF_KIND_C8, ESMF_KIND_C16
+
+      public ESMF_NULL_POINTER, ESMF_BAD_POINTER
+
+
+      public ESMF_FAILURE, ESMF_SUCCESS
+      public ESMF_MAXSTR
+      public ESMF_MAXDIM, ESMF_MAXDECOMPDIM, ESMF_MAXGRIDDIM
+     
+      public ESMF_MAJOR_VERSION, ESMF_MINOR_VERSION, ESMF_REVISION
+      public ESMF_VERSION_STRING 
+
+      public ESMF_Status, ESMF_Pointer, ESMF_DataType
+      public ESMF_DataValue, ESMF_Attribute
+!      public ESMF_MemIndex
+!      public ESMF_BasePointer
+      public ESMF_Base
+
+      public ESMF_AxisIndex, ESMF_AxisIndexGet
+!      public ESMF_AxisIndexInit
+      public ESMF_Logical
+!      public ESMF_TF_TRUE, ESMF_TF_FALSE
+
+! !PUBLIC MEMBER FUNCTIONS:
+!
+! !DESCRIPTION:
+!     The following routines apply to any type in the system.  
+!     The attribute routines can be inherited as-is.  The other
+!     routines need to be specialized by the higher level objects.
+!
+!   Base class methods
+!      public ESMF_BaseInit
+   
+!      public ESMF_BaseGetConfig
+!      public ESMF_BaseSetConfig
+
+!      public ESMF_BaseGetInstCount
+
+!      public ESMF_BaseSetID
+!      public ESMF_BaseGetID
+
+!      public ESMF_BaseSetRefCount
+!      public ESMF_BaseGetRefCount
+
+!      public ESMF_BaseSetStatus
+!      public ESMF_BaseGetStatus
+
+!   Virtual methods to be defined by derived classes
+!      public ESMF_Read
+!      public ESMF_Write
+!      public ESMF_Validate
+!      public ESMF_Print
+
+!  Attribute methods
+      public ESMF_AttributeSet
+      public ESMF_AttributeGet
+      public ESMF_AttributeGetCount
+      public ESMF_AttributeGetbyNumber
+      public ESMF_AttributeGetNameList
+      public ESMF_AttributeSetList
+      public ESMF_AttributeGetList
+      public ESMF_AttributeSetObjectList
+      public ESMF_AttributeGetObjectList
+      public ESMF_AttributeCopy
+      public ESMF_AttributeCopyAll
+ 
+!  Misc methods
+      public ESMF_SetName
+      public ESMF_GetName
+      public ESMF_SetPointer
+      public ESMF_SetNullPointer
+      public ESMF_GetPointer
+
+!  Print methods for calling by higher level print functions
+!  (they have little formatting other than the actual values)
+      public ESMF_StatusString, ESMF_DataTypeString
+
+!  Overloaded = operator functions
+      public operator(.eq.), operator(.ne.), assignment(=)
+!
+!
+!EOP
+
+!------------------------------------------------------------------------------
+
+! overload .eq. & .ne. with additional derived types so you can compare 
+!  them as if they were simple integers.
+ 
+
+interface operator (.eq.)
+ module procedure ESMF_sfeq
+ module procedure ESMF_dteq
+ module procedure ESMF_pteq
+ module procedure ESMF_tfeq
+ module procedure ESMF_aieq
+end interface
+
+interface operator (.ne.)
+ module procedure ESMF_sfne
+ module procedure ESMF_dtne
+ module procedure ESMF_ptne
+ module procedure ESMF_tfne
+ module procedure ESMF_aine
+end interface
+
+interface assignment (=)
+ module procedure ESMF_dtas
+ module procedure ESMF_ptas
+end interface
+
+!------------------------------------------------------------------------------
+
+      contains
+
+!------------------------------------------------------------------------------
+! function to compare two ESMF_Status flags to see if they're the same or not
+
+function ESMF_sfeq(sf1, sf2)
+ logical ESMF_sfeq
+ type(ESMF_Status), intent(in) :: sf1, sf2
+
+ ESMF_sfeq = (sf1%status .eq. sf2%status)
+end function
+
+function ESMF_sfne(sf1, sf2)
+ logical ESMF_sfne
+ type(ESMF_Status), intent(in) :: sf1, sf2
+
+ ESMF_sfne = (sf1%status .ne. sf2%status)
+end function
+
+!------------------------------------------------------------------------------
+! function to compare two ESMF_DataTypes to see if they're the same or not
+
+function ESMF_dteq(dt1, dt2)
+ logical ESMF_dteq
+ type(ESMF_DataType), intent(in) :: dt1, dt2
+
+ ESMF_dteq = (dt1%dtype .eq. dt2%dtype)
+end function
+
+function ESMF_dtne(dt1, dt2)
+ logical ESMF_dtne
+ type(ESMF_DataType), intent(in) :: dt1, dt2
+
+ ESMF_dtne = (dt1%dtype .ne. dt2%dtype)
+end function
+
+subroutine ESMF_dtas(intval, dtval)
+ integer, intent(out) :: intval
+ type(ESMF_DataType), intent(in) :: dtval
+
+ intval = dtval%dtype
+end subroutine
+
+
+!------------------------------------------------------------------------------
+! function to compare two ESMF_Pointers to see if they're the same or not
+
+function ESMF_pteq(pt1, pt2)
+ logical ESMF_pteq
+ type(ESMF_Pointer), intent(in) :: pt1, pt2
+
+ ESMF_pteq = (pt1%ptr .eq. pt2%ptr)
+end function
+
+function ESMF_ptne(pt1, pt2)
+ logical ESMF_ptne
+ type(ESMF_Pointer), intent(in) :: pt1, pt2
+
+ ESMF_ptne = (pt1%ptr .ne. pt2%ptr)
+end function
+
+subroutine ESMF_ptas(ptval, intval)
+ type(ESMF_Pointer), intent(out) :: ptval
+ integer, intent(in) :: intval
+
+ ptval%ptr = intval
+end subroutine
+
+!------------------------------------------------------------------------------
+! function to compare two ESMF_Logicals to see if they're the same or not
+! also need assignment to real f90 logical?
+
+function ESMF_tfeq(tf1, tf2)
+ logical ESMF_tfeq
+ type(ESMF_Logical), intent(in) :: tf1, tf2
+
+ ESMF_tfeq = (tf1%value .eq. tf2%value)
+end function
+
+function ESMF_tfne(tf1, tf2)
+ logical ESMF_tfne
+ type(ESMF_Logical), intent(in) :: tf1, tf2
+
+ ESMF_tfne = (tf1%value .ne. tf2%value)
+end function
+
+!------------------------------------------------------------------------------
+! function to compare two ESMF_AxisIndex to see if they're the same or not
+
+function ESMF_aieq(ai1, ai2)
+ logical ESMF_aieq
+ type(ESMF_AxisIndex), intent(in) :: ai1, ai2
+
+ ESMF_aieq = ((ai1%l .eq. ai2%l) .and. &
+              (ai1%r .eq. ai2%r) .and. &
+              (ai1%max .eq. ai2%max) .and. &
+              (ai1%decomp .eq. ai2%decomp) .and. &
+              (ai1%gstart .eq. ai2%gstart))
+
+end function
+
+function ESMF_aine(ai1, ai2)
+ logical ESMF_aine
+ type(ESMF_AxisIndex), intent(in) :: ai1, ai2
+
+ ESMF_aine = ((ai1%l .ne. ai2%l) .or. &
+              (ai1%r .ne. ai2%r) .or. &
+              (ai1%max .ne. ai2%max) .or. &
+              (ai1%decomp .ne. ai2%decomp) .or. &
+              (ai1%gstart .ne. ai2%gstart))
+
+end function
+
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+! 
+! Base methods
+!
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_BaseInit - initialize a Base object
+!
+! !INTERFACE:
+      subroutine ESMF_BaseInit(base, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base) :: base                 
+      integer, intent(out), optional :: rc     
+
+!
+! !DESCRIPTION:
+!     Set initial state on a Base object.
+!
+!     \begin{description}
+!     \item [base]
+!           In the Fortran interface, this must in fact be a {\tt Base}
+!           derived type object.  It is expected that all specialized 
+!           derived types will include a {\tt Base} object as the first
+!           entry.
+!     \item [{[rc]}]
+!           Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!
+!     \end{description}
+!
+!EOP
+
+      logical :: rcpresent                          ! Return code present   
+
+!     !Initialize return code
+      rcpresent = .FALSE.
+      if(present(rc)) then
+        rcpresent = .TRUE.
+        rc = ESMF_FAILURE
+      endif
+
+      global_count = global_count + 1
+      base%ID = global_count
+      base%ref_count = 1
+      base%base_status = ESMF_STATE_READY
+      base%name = "undefined"
+
+      if (rcpresent) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_BaseInit
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_SetName - set the name of this object
+!
+! !INTERFACE:
+      subroutine ESMF_SetName(anytype, name, namespace, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base) :: anytype                 
+      character (len = *), intent(in), optional :: name   
+      character (len = *), intent(in), optional :: namespace
+      integer, intent(out), optional :: rc     
+
+!
+! !DESCRIPTION:
+!     Associate a name with any object in the system.
+!
+!     \begin{description}
+!     \item [anytype]
+!           In the Fortran interface, this must in fact be a {\tt Base}
+!           derived type object.  It is expected that all specialized 
+!           derived types will include a {\tt Base} object as the first
+!           entry.
+!     \item [[name]]
+!           Object name.  An error will be returned if a duplicate name 
+!           is specified.  If a name is not given a unique name will be
+!           generated and can be queried by the {\tt ESMF_GetName} routine.
+!     \item [[namespace]]
+!           Object namespace (e.g. "Application", "Component", "Grid", etc).
+!           If given, the name will be checked that it is unique within
+!           this namespace.  If not given, the generated name will be 
+!           unique within this namespace.  If namespace is not specified,
+!           a default "global" namespace will be assumed and the same rules
+!           for names will be followed.
+!     \item [[rc]]
+!           Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!
+!     \end{description}
+!
+! 
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.5, FLD1.5.3
+      logical :: rcpresent                          ! Return code present   
+      character (len = ESMF_MAXSTR) :: ournamespace ! Namespace if not given
+      character (len = ESMF_MAXSTR) :: defaultname  ! Name if not given
+      integer, save :: seqnum = 0       ! HACK - generate uniq names
+                                        ! but not coordinated across procs
+
+!     !Initialize return code
+      rcpresent = .FALSE.
+      if(present(rc)) then
+        rcpresent = .TRUE.
+        rc = ESMF_FAILURE
+      endif
+
+!     ! TODO: this code should generate a unique name if a name
+!     !   is not given.  If a namespace is given, the name has to
+!     !   be unique within that namespace.  Example namespaces could
+!     !   be: Applications, Components, Fields/Bundles, Grids.
+!      
+!     ! Construct a default namespace if one is not given
+      if((.not. present(namespace)) .or. (namespace .eq. "")) then
+          ournamespace = "global"
+      else
+          ournamespace = namespace
+      endif
+!     ! Construct a default name if one is not given
+      if((.not. present(name)) .or. (name .eq. "")) then
+
+          write(defaultname, 20) trim(ournamespace), seqnum
+20        format(A,I3.3)
+          seqnum = seqnum + 1
+          anytype%name = defaultname
+      else
+          anytype%name = name
+      endif
+
+      if (rcpresent) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_SetName
+
+!-------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_GetName - get the name of this object
+!
+! !INTERFACE:
+      subroutine ESMF_GetName(anytype, name, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), intent(in) :: anytype             ! any ESMF object/type
+      character (len = *), intent(out) :: name           ! object/type name
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+!     Return the name of any type in the system.
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.5, FLD1.5.3
+
+      name = anytype%name
+      if (present(rc)) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_GetName
+
+
+!-------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AttributeSet - set attribute on an ESMF type
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeSet(anytype, name, value, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
+      character (len = *), intent(in) :: name            ! attribute name
+      type(ESMF_DataValue), intent(in) :: value              ! attribute value
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+!     Associate a (name,value) pair with any type in the system.
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.5, FLD1.5.3
+
+      end subroutine ESMF_AttributeSet
+
+
+!-------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_AttributeGet - get attribute from an ESMF type
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeGet(anytype, name, type, value, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), intent(in) :: anytype           ! any ESMF type
+      character (len = *), intent(in) :: name          ! attribute name
+      type(ESMF_DataType), intent(out) :: type             ! all possible data types
+      type(ESMF_DataValue), intent(out) :: value           ! attribute value
+      integer, intent(out), optional :: rc             ! return code
+
+!
+! !DESCRIPTION:
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.5.1, FLD1.5.3
+
+      end subroutine ESMF_AttributeGet
+
+
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ESMF_AttributeGetCount - get an ESMF object's number of attributes
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeGetCount(anytype, count, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
+      integer, intent(out) :: count                      ! attribute count
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+! Returns number of attributes present.
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.7.5
+
+      end subroutine ESMF_AttributeGetCount
+
+
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ESMF_AttributeGetbyNumber - get an ESMF object's attribute by num ber
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeGetbyNumber(anytype, number, name, type, value, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
+      integer, intent(in) :: number                      ! attribute number
+      character (len = *), intent(in) :: name            ! attribute name
+      type(ESMF_DataType), intent(out) :: type               ! all possible data types
+      type(ESMF_DataValue), intent(out) :: value             ! attribute value
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+! Allows the caller to get attributes by number instead of by name.
+! This can be useful in iterating through all attributes in a loop.
+!
+!EOP
+! !REQUIREMENTS: 
+
+      end subroutine ESMF_AttributeGetbyNumber
+
+
+!-------------------------------------------------------------------------
+!BOP
+!
+!IROUTINE:  ESMF_AttributeGetNameList - get an ESMF object's attribute name list
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeGetNameList(anytype, count, namelist, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
+      integer, intent(out) :: count                      ! attribute count
+      character (len = *), dimension (:), intent(out) :: namelist   ! attribute names
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+! Return a list of all attribute names without returning the values.
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.7.3
+
+      end subroutine ESMF_AttributeGetNameList
+
+
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ESMF_AttributeSetList - set an ESMF object's attributes 
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeSetList(anytype, namelist, valuelist, rc)
+
+!
+! !ARGUMENTS:
+      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
+      character (len = *), dimension (:), intent(in) :: namelist    ! attribute names
+      type(ESMF_DataValue), dimension (:), intent(in) :: valuelist      ! attribute values
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+! Set multiple attributes on an object in one call.  Depending on what is
+! allowed by the interface, all attributes may have to have the same type.
+!
+!EOP
+! !REQUIREMENTS:  (none.  added for completeness)
+
+      end subroutine ESMF_AttributeSetList
+
+
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ESMF_AttributeGetList - get an ESMF object's attributes
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeGetList(anytype, namelist, typelist, valuelist, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
+      character (len = *), dimension (:), intent(in) :: namelist    ! attribute names
+      type(ESMF_DataType), dimension (:), intent(out) :: typelist       ! all possible data types
+      type(ESMF_DataValue), dimension (:), intent(out) :: valuelist     ! attribute values
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+! Get multiple attributes from an object in a single call.
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.7.4
+
+      end subroutine ESMF_AttributeGetList
+
+
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ESMF_AttributeSetObjectList - set an attribute on multiple ESMF objects 
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeSetObjectList(anytypelist, name, value, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), dimension (:), intent(in) :: anytypelist     ! list of any ESMF types
+      character (len = *), intent(in) :: name            ! attribute name
+      type(ESMF_DataValue), dimension (:), intent(in) :: value          ! attribute value
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+! Set the same attribute on multiple objects in one call.
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.5.5 (pri 2)
+
+      end subroutine ESMF_AttributeSetObjectList
+
+
+!-------------------------------------------------------------------------
+!BOP
+!
+!
+! !IROUTINE:  ESMF_AttributeGetObjectList - get an attribute from multiple ESMF objects 
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeGetObjectList(anytypelist, name, typelist, valuelist, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), dimension (:), intent(in) :: anytypelist     ! list of any ESMF types
+      character (len = *), intent(in) :: name            ! attribute name
+      type(ESMF_DataType), dimension (:), intent(out) :: typelist       ! all possible data types
+      type(ESMF_DataValue), dimension (:), intent(out) :: valuelist     ! attribute values
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+! Get the same attribute name from multiple objects in one call.
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.5.5 (pri 2)
+
+      end subroutine ESMF_AttributeGetObjectList
+
+
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ESMF_AttributeCopy - copy an attribute between two objects
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeCopy(name, source, destination, rc)
+!
+! !ARGUMENTS:
+      character (len = *), intent(in) :: name            ! attribute name
+      type(ESMF_Base), intent(in) :: source              ! any ESMF type
+      type(ESMF_Base), intent(in) :: destination         ! any ESMF type
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+! The specified attribute associated with the source object is
+! copied to the destination object.  << does this assume overwriting the
+! attribute if it already exists in the output or does this require yet
+! another arg to say what to do with collisions? >>
+
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.5.4
+
+      end subroutine ESMF_AttributeCopy
+
+
+!-------------------------------------------------------------------------
+!BOP
+!
+!IROUTINE:  ESMC_AttributeCopyAll - copy attributes between two objects
+
+!
+! !INTERFACE:
+      subroutine ESMF_AttributeCopyAll(source, destination, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Base), intent(in) :: source              ! any ESMF type
+      type(ESMF_Base), intent(in) :: destination         ! any ESMF type
+      integer, intent(out), optional :: rc               ! return code
+
+!
+! !DESCRIPTION:
+! All attributes associated with the source object are copied to the
+! destination object.  Some attributes will have to be considered
+! {\tt read only} and won't be updated by this call.  (e.g. an attribute
+! like {\tt name} must be unique and therefore can't be duplicated.)
+
+!
+!EOP
+! !REQUIREMENTS:  FLD1.5.4
+
+      end subroutine ESMF_AttributeCopyAll
+
+!=========================================================================
+! Misc utility routines, perhaps belongs in a utility file?
+!-------------------------------------------------------------------------
+!BOP
+!
+!IROUTINE:  ESMC_AxisIndexInit - initialize an AxisIndex object
+
+!
+! !INTERFACE:
+      subroutine ESMF_AxisIndexInit(ai, l, r, max, decomp, gstart, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_AxisIndex), intent(inout) :: ai
+      integer, intent(in) :: l, r, max, decomp, gstart
+      integer, intent(out), optional :: rc  
+!
+! !DESCRIPTION:
+!   Set the contents of an AxisIndex type.
+
+!
+!EOP
+! !REQUIREMENTS:
+
+      ai%l = l
+      ai%r = r
+      ai%max = max
+      ai%decomp = decomp
+      ai%gstart = gstart
+
+      if (present(rc)) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_AxisIndexInit
+
+!BOP
+!
+!IROUTINE:  ESMC_AxisIndexInit - initialize an AxisIndex object
+
+!
+! !INTERFACE:
+      subroutine ESMF_AxisIndexGet(ai, l, r, max, decomp, gstart, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_AxisIndex), intent(inout) :: ai
+      integer, intent(out), optional :: l, r, max, decomp, gstart
+      integer, intent(out), optional :: rc  
+!
+! !DESCRIPTION:
+!   Get the contents of an AxisIndex type.
+
+!
+!EOP
+! !REQUIREMENTS:
+
+      if (present(l)) l = ai%l
+      if (present(r)) r = ai%r
+      if (present(max)) max = ai%max
+      if (present(decomp)) decomp = ai%decomp
+      if (present(gstart)) gstart = ai%gstart
+
+      if (present(rc)) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_AxisIndexGet
+
+!-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
+!BOP
+!
+!IROUTINE:  ESMF_SetPointer - set an opaque value
+
+!
+! !INTERFACE:
+      subroutine ESMF_SetPointer(ptype, contents, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Pointer) :: ptype 
+      integer*8, intent(in) :: contents
+      integer, intent(out), optional :: rc  
+
+!
+! !DESCRIPTION:
+!   Set the contents of an opaque pointer type.
+
+!
+!EOP
+! !REQUIREMENTS:
+      ptype%ptr = contents
+      if (present(rc)) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_SetPointer
+
+!-------------------------------------------------------------------------
+!BOP
+!
+!IROUTINE:  ESMF_SetNullPointer - set an opaque value
+
+!
+! !INTERFACE:
+      subroutine ESMF_SetNullPointer(ptype, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Pointer) :: ptype 
+      integer, intent(out), optional :: rc  
+
+!
+! !DESCRIPTION:
+!   Set the contents of an opaque pointer type.
+
+!
+!EOP
+! !REQUIREMENTS:
+      integer*8, parameter :: nullp = 0
+
+      ptype%ptr = nullp
+      if (present(rc)) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_SetNullPointer
+!------------------------------------------------------------------------- 
+!BOP 
+!  !IROUTINE:  ESMF_GetPointer - get an opaque value 
+!  
+! !INTERFACE: 
+      function ESMF_GetPointer(ptype, rc) 
+!
+! !RETURN VALUE:
+      integer*8 :: ESMF_GetPointer
+
+! !ARGUMENTS:
+      type(ESMF_Pointer), intent(in) :: ptype 
+      integer, intent(out), optional :: rc  
+
+!
+! !DESCRIPTION:
+!   Get the contents of an opaque pointer type.
+
+!
+!EOP
+! !REQUIREMENTS:
+      ESMF_GetPointer = ptype%ptr
+      if (present(rc)) rc = ESMF_SUCCESS
+
+      end function ESMF_GetPointer
+
+!------------------------------------------------------------------------- 
+! misc print routines
+!------------------------------------------------------------------------- 
+!BOP 
+!  !IROUTINE:  ESMF_StatusString - Return status as a string
+!  
+! !INTERFACE: 
+      subroutine ESMF_StatusString(status, string, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Status), intent(in) :: status
+      character(len=*), intent(out) :: string
+      integer, intent(out), optional :: rc  
+
+!
+! !DESCRIPTION:
+!   Return a status variable as a string.
+
+!
+!EOP
+! !REQUIREMENTS:
+
+      if (status .eq. ESMF_STATE_UNINIT) string = "Uninitialized"
+      if (status .eq. ESMF_STATE_READY) string = "Ready"
+      if (status .eq. ESMF_STATE_UNALLOCATED) string = "Unallocated"
+      if (status .eq. ESMF_STATE_ALLOCATED) string = "Allocated"
+      if (status .eq. ESMF_STATE_BUSY) string = "Busy"
+      if (status .eq. ESMF_STATE_INVALID) string = "Invalid"
+ 
+      if (present(rc)) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_StatusString
+
+!------------------------------------------------------------------------- 
+!BOP 
+!  !IROUTINE:  ESMF_DataTypeString - Return DataType as a string
+!  
+! !INTERFACE: 
+      subroutine ESMF_DataTypeString(datatype, string, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_DataType), intent(in) :: datatype
+      character(len=*), intent(out) :: string
+      integer, intent(out), optional :: rc  
+
+!
+! !DESCRIPTION:
+!   Return a datatype variable as a string.
+
+!
+!EOP
+! !REQUIREMENTS:
+
+      if (datatype .eq. ESMF_DATA_INTEGER) string = "Integer"
+      if (datatype .eq. ESMF_DATA_REAL) string = "Real"
+      if (datatype .eq. ESMF_DATA_LOGICAL) string = "Logical"
+      if (datatype .eq. ESMF_DATA_CHARACTER) string = "Character"
+ 
+      if (present(rc)) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_DataTypeString
+
+!-------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------
+! put Print and Validate skeletons here - but they should be
+!  overridden by higher level more specialized functions.
+!-------------------------------------------------------------------------
+
+      end module ESMF_BaseMod
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_BaseTime.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_BaseTime.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_BaseTime.F90	(revision 2744)
@@ -0,0 +1,318 @@
+!
+! Earth System Modeling Framework
+! Copyright 2002-2003, University Corporation for Atmospheric Research,
+! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+! Laboratory, University of Michigan, National Centers for Environmental
+! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+! NASA Goddard Space Flight Center.
+! Licensed under the GPL.
+!
+!==============================================================================
+!
+!     ESMF BaseTime Module
+      module ESMF_BaseTimeMod
+!
+!==============================================================================
+!
+! This file contains the BaseTime class definition and all BaseTime class
+! methods.
+!
+!------------------------------------------------------------------------------
+! INCLUDES
+
+#include <ESMF_TimeMgr.inc>
+!
+!===============================================================================
+!BOPI
+! !MODULE: ESMF_BaseTimeMod - Base ESMF time definition 
+!
+! !DESCRIPTION:
+! Part of Time Manager F90 API wrapper of C++ implemenation
+!
+! This module serves only as the common Time definition inherited
+! by {\tt ESMF\_TimeInterval} and {\tt ESMF\_Time}
+!
+! See {\tt ../include/ESMC\_BaseTime.h} for complete description
+!
+!------------------------------------------------------------------------------
+! !USES:
+      use ESMF_BaseMod    ! ESMF Base class
+      implicit none
+!
+!------------------------------------------------------------------------------
+! !PRIVATE TYPES:
+      private
+!------------------------------------------------------------------------------
+!     ! ESMF_BaseTime
+!
+!     ! Base class type to match C++ BaseTime class in size only;
+!     !  all dereferencing within class is performed by C++ implementation
+
+      type ESMF_BaseTime
+        integer(ESMF_KIND_I8) :: S   ! whole seconds
+        integer(ESMF_KIND_I8) :: Sn  ! fractional seconds, numerator
+        integer(ESMF_KIND_I8) :: Sd  ! fractional seconds, denominator
+      end type
+
+!------------------------------------------------------------------------------
+! !PUBLIC TYPES:
+      public ESMF_BaseTime
+!------------------------------------------------------------------------------
+!
+! !PUBLIC MEMBER FUNCTIONS:
+!
+! overloaded operators
+      public operator(+)
+      private ESMF_BaseTimeSum
+      public operator(-)
+      private ESMF_BaseTimeDifference
+      public operator(/)
+      private ESMF_BaseTimeQuotI
+      private ESMF_BaseTimeQuotI8
+      public operator(.EQ.)
+      private ESMF_BaseTimeEQ
+      public operator(.NE.)
+      private ESMF_BaseTimeNE
+      public operator(.LT.)
+      private ESMF_BaseTimeLT
+      public operator(.GT.)
+      private ESMF_BaseTimeGT
+      public operator(.LE.)
+      private ESMF_BaseTimeLE
+      public operator(.GE.)
+      private ESMF_BaseTimeGE
+
+!==============================================================================
+!
+! INTERFACE BLOCKS
+!
+!==============================================================================
+      interface operator(+)
+        module procedure ESMF_BaseTimeSum
+      end interface
+      interface operator(-)
+        module procedure ESMF_BaseTimeDifference
+      end interface
+      interface operator(/)
+        module procedure ESMF_BaseTimeQuotI,ESMF_BaseTimeQuotI8
+      end interface
+      interface operator(.EQ.)
+        module procedure ESMF_BaseTimeEQ
+      end interface
+      interface operator(.NE.)
+        module procedure ESMF_BaseTimeNE
+      end interface
+      interface operator(.LT.)
+        module procedure ESMF_BaseTimeLT
+      end interface
+      interface operator(.GT.)
+        module procedure ESMF_BaseTimeGT
+      end interface
+      interface operator(.LE.)
+        module procedure ESMF_BaseTimeLE
+      end interface
+      interface operator(.GE.)
+        module procedure ESMF_BaseTimeGE
+      end interface
+
+
+!==============================================================================
+
+      contains
+
+!==============================================================================
+
+
+! Add two basetimes
+      FUNCTION ESMF_BaseTimeSum( basetime1, basetime2 )
+        TYPE(ESMF_BaseTime) :: ESMF_BaseTimeSum
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
+        ! locals
+        INTEGER (ESMF_KIND_I8) :: Sn1, Sd1, Sn2, Sd2, lcd
+!  PRINT *,'DEBUG:  BEGIN ESMF_BaseTimeSum()'
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  basetime1%S = ',basetime1%S
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  basetime1%Sn = ',basetime1%Sn
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  basetime1%Sd = ',basetime1%Sd
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  basetime2%S = ',basetime2%S
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  basetime2%Sn = ',basetime2%Sn
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  basetime2%Sd = ',basetime2%Sd
+        ESMF_BaseTimeSum   = basetime1
+        ESMF_BaseTimeSum%S = ESMF_BaseTimeSum%S + basetime2%S
+        Sn1 = basetime1%Sn
+        Sd1 = basetime1%Sd
+        Sn2 = basetime2%Sn
+        Sd2 = basetime2%Sd
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  Sn1 = ',Sn1
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  Sd1 = ',Sd1
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  Sn2 = ',Sn2
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  Sd2 = ',Sd2
+        IF      ( ( Sd1 .EQ. 0 ) .AND. ( Sd2 .EQ. 0 ) ) THEN
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  no fractions'
+          ESMF_BaseTimeSum%Sn = 0
+          ESMF_BaseTimeSum%Sd = 0
+        ELSE IF ( ( Sd1 .NE. 0 ) .AND. ( Sd2 .EQ. 0 ) ) THEN
+          ESMF_BaseTimeSum%Sn = Sn1
+          ESMF_BaseTimeSum%Sd = Sd1
+        ELSE IF ( ( Sd1 .EQ. 0 ) .AND. ( Sd2 .NE. 0 ) ) THEN
+          ESMF_BaseTimeSum%Sn = Sn2
+          ESMF_BaseTimeSum%Sd = Sd2
+        ELSE IF ( ( Sd1 .NE. 0 ) .AND. ( Sd2 .NE. 0 ) ) THEN
+          CALL compute_lcd( Sd1 , Sd2 , lcd )
+          ESMF_BaseTimeSum%Sd = lcd
+          ESMF_BaseTimeSum%Sn = (Sn1 * lcd / Sd1) + (Sn2 * lcd / Sd2)
+        ENDIF
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  ESMF_BaseTimeSum%S = ',ESMF_BaseTimeSum%S
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  ESMF_BaseTimeSum%Sn = ',ESMF_BaseTimeSum%Sn
+!  PRINT *,'DEBUG:  ESMF_BaseTimeSum():  ESMF_BaseTimeSum%Sd = ',ESMF_BaseTimeSum%Sd
+        CALL normalize_basetime( ESMF_BaseTimeSum )
+!  PRINT *,'DEBUG:  END ESMF_BaseTimeSum()'
+      END FUNCTION ESMF_BaseTimeSum
+
+
+! Subtract two basetimes
+      FUNCTION ESMF_BaseTimeDifference( basetime1, basetime2 )
+        TYPE(ESMF_BaseTime) :: ESMF_BaseTimeDifference
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
+        ! locals
+        TYPE(ESMF_BaseTime) :: neg2
+
+        neg2%S  = -basetime2%S
+        neg2%Sn = -basetime2%Sn
+        neg2%Sd =  basetime2%Sd
+
+        ESMF_BaseTimeDifference = basetime1 + neg2
+
+      END FUNCTION ESMF_BaseTimeDifference
+
+
+! Divide basetime by 8-byte integer
+      FUNCTION ESMF_BaseTimeQuotI8( basetime, divisor )
+        TYPE(ESMF_BaseTime) :: ESMF_BaseTimeQuotI8
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime
+        INTEGER(ESMF_KIND_I8), INTENT(IN) :: divisor
+        ! locals
+        INTEGER(ESMF_KIND_I8) :: d, n, dinit
+
+!PRINT *,'DEBUG ESMF_BaseTimeQuotI8() A:  S,Sn,Sd = ', &
+!  basetime%S,basetime%Sn,basetime%Sd
+!PRINT *,'DEBUG ESMF_BaseTimeQuotI8() A:  divisor = ', divisor
+        IF ( divisor == 0_ESMF_KIND_I8 ) THEN
+          CALL wrf_error_fatal( 'ESMF_BaseTimeQuotI8:  divide by zero' )
+        ENDIF
+
+!$$$ move to default constructor
+        ESMF_BaseTimeQuotI8%S  = 0
+        ESMF_BaseTimeQuotI8%Sn = 0
+        ESMF_BaseTimeQuotI8%Sd = 0
+
+        ! convert to a fraction and divide by multipling the denonminator by 
+        ! the divisor
+        IF ( basetime%Sd == 0 ) THEN
+          dinit = 1_ESMF_KIND_I8
+        ELSE
+          dinit = basetime%Sd
+        ENDIF
+        n = basetime%S * dinit + basetime%Sn
+        d = dinit * divisor
+!PRINT *,'DEBUG ESMF_BaseTimeQuotI8() B:  n,d = ',n,d
+        CALL simplify( n, d, ESMF_BaseTimeQuotI8%Sn, ESMF_BaseTimeQuotI8%Sd )
+!PRINT *,'DEBUG ESMF_BaseTimeQuotI8() C:  S,Sn,Sd = ', &
+!  ESMF_BaseTimeQuotI8%S,ESMF_BaseTimeQuotI8%Sn,ESMF_BaseTimeQuotI8%Sd
+        CALL normalize_basetime( ESMF_BaseTimeQuotI8 )
+!PRINT *,'DEBUG ESMF_BaseTimeQuotI8() D:  S,Sn,Sd = ', &
+!  ESMF_BaseTimeQuotI8%S,ESMF_BaseTimeQuotI8%Sn,ESMF_BaseTimeQuotI8%Sd
+      END FUNCTION ESMF_BaseTimeQuotI8
+
+! Divide basetime by integer
+      FUNCTION ESMF_BaseTimeQuotI( basetime, divisor )
+        TYPE(ESMF_BaseTime) :: ESMF_BaseTimeQuotI
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime
+        INTEGER, INTENT(IN) :: divisor
+        IF ( divisor == 0 ) THEN
+          CALL wrf_error_fatal( 'ESMF_BaseTimeQuotI:  divide by zero' )
+        ENDIF
+        ESMF_BaseTimeQuotI = basetime / INT( divisor, ESMF_KIND_I8 )
+      END FUNCTION ESMF_BaseTimeQuotI
+
+
+! .EQ. for two basetimes
+      FUNCTION ESMF_BaseTimeEQ( basetime1, basetime2 )
+        LOGICAL :: ESMF_BaseTimeEQ
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
+        INTEGER :: retval
+        CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
+                     basetime2%S, basetime2%Sn, basetime2%Sd, &
+                     retval )
+        ESMF_BaseTimeEQ = ( retval .EQ. 0 )
+      END FUNCTION ESMF_BaseTimeEQ
+
+
+! .NE. for two basetimes
+      FUNCTION ESMF_BaseTimeNE( basetime1, basetime2 )
+        LOGICAL :: ESMF_BaseTimeNE
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
+        INTEGER :: retval
+        CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
+                     basetime2%S, basetime2%Sn, basetime2%Sd, &
+                     retval )
+        ESMF_BaseTimeNE = ( retval .NE. 0 )
+      END FUNCTION ESMF_BaseTimeNE
+
+
+! .LT. for two basetimes
+      FUNCTION ESMF_BaseTimeLT( basetime1, basetime2 )
+        LOGICAL :: ESMF_BaseTimeLT
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
+        INTEGER :: retval
+        CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
+                     basetime2%S, basetime2%Sn, basetime2%Sd, &
+                     retval )
+        ESMF_BaseTimeLT = ( retval .LT. 0 )
+      END FUNCTION ESMF_BaseTimeLT
+
+
+! .GT. for two basetimes
+      FUNCTION ESMF_BaseTimeGT( basetime1, basetime2 )
+        LOGICAL :: ESMF_BaseTimeGT
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
+        INTEGER :: retval
+        CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
+                     basetime2%S, basetime2%Sn, basetime2%Sd, &
+                     retval )
+        ESMF_BaseTimeGT = ( retval .GT. 0 )
+      END FUNCTION ESMF_BaseTimeGT
+
+
+! .LE. for two basetimes
+      FUNCTION ESMF_BaseTimeLE( basetime1, basetime2 )
+        LOGICAL :: ESMF_BaseTimeLE
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
+        INTEGER :: retval
+        CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
+                     basetime2%S, basetime2%Sn, basetime2%Sd, &
+                     retval )
+        ESMF_BaseTimeLE = ( retval .LE. 0 )
+      END FUNCTION ESMF_BaseTimeLE
+
+
+! .GE. for two basetimes
+      FUNCTION ESMF_BaseTimeGE( basetime1, basetime2 )
+        LOGICAL :: ESMF_BaseTimeGE
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
+        TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
+        INTEGER :: retval
+        CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
+                     basetime2%S, basetime2%Sn, basetime2%Sd, &
+                     retval )
+        ESMF_BaseTimeGE = ( retval .GE. 0 )
+      END FUNCTION ESMF_BaseTimeGE
+
+
+      end module ESMF_BaseTimeMod
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Calendar.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Calendar.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Calendar.F90	(revision 2744)
@@ -0,0 +1,291 @@
+!
+! Earth System Modeling Framework
+! Copyright 2002-2003, University Corporation for Atmospheric Research,
+! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+! Laboratory, University of Michigan, National Centers for Environmental
+! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+! NASA Goddard Space Flight Center.
+! Licensed under the GPL.
+!
+!==============================================================================
+!
+!     ESMF Calendar Module
+      module ESMF_CalendarMod
+!
+!==============================================================================
+!
+! This file contains the Calendar class definition and all Calendar class
+! methods.
+!
+!------------------------------------------------------------------------------
+! INCLUDES
+#include <ESMF_TimeMgr.inc>
+
+!==============================================================================
+!BOPI
+! !MODULE: ESMF_CalendarMod
+!
+! !DESCRIPTION:
+! Part of Time Manager F90 API wrapper of C++ implemenation
+!
+! Defines F90 wrapper entry points for corresponding
+! C++ class { \tt ESMC\_Calendar} implementation
+!
+! See {\tt ../include/ESMC\_Calendar.h} for complete description
+!
+!------------------------------------------------------------------------------
+! !USES:
+      ! inherit from ESMF base class
+      use ESMF_BaseMod
+
+      ! inherit from base time class
+      use ESMF_BaseTimeMod
+
+      implicit none
+!
+!------------------------------------------------------------------------------
+! !PRIVATE TYPES:
+      private
+!------------------------------------------------------------------------------
+
+
+!      INTEGER, PARAMETER :: MONTHS_PER_YEAR = 07
+!      INTEGER, PARAMETER :: mday(MONTHS_PER_YEAR)   &
+!                          = (/99,99,99,99,99,99,75/)
+!      INTEGER, PARAMETER :: mdayleap(MONTHS_PER_YEAR) &
+!                          = (/99,99,99,99,99,99,75/)
+!
+!*****Similar monthes as the GCM
+      INTEGER, PARAMETER :: MONTHS_PER_YEAR = 12
+      INTEGER, PARAMETER :: mday(MONTHS_PER_YEAR)   &
+                          = (/61,66,66,65,60,54,50,46,47,47,51,56/)
+      INTEGER, PARAMETER :: mdayleap(MONTHS_PER_YEAR) &
+                          = (/61,66,66,65,60,54,50,46,47,47,51,56/)
+!*****
+      INTEGER, DIMENSION(669) :: daym
+      INTEGER, DIMENSION(669) :: daymleap
+      INTEGER :: mdaycum(0:MONTHS_PER_YEAR)
+      INTEGER :: mdayleapcum(0:MONTHS_PER_YEAR)
+      TYPE(ESMF_BaseTime), TARGET :: monthbdys(0:MONTHS_PER_YEAR)
+      TYPE(ESMF_BaseTime), TARGET :: monthbdysleap(0:MONTHS_PER_YEAR)
+
+
+!------------------------------------------------------------------------------
+!     ! ESMF_CalendarType
+!
+!     ! F90 "enum" type to match C++ ESMC_CalendarType enum
+
+      type ESMF_CalendarType
+      private
+        integer :: caltype
+      end type
+
+      type(ESMF_CalendarType), parameter :: &
+                               ESMF_CAL_GREGORIAN =  ESMF_CalendarType(1), &
+                               ESMF_CAL_JULIAN =     ESMF_CalendarType(2), &
+                           ! like Gregorian, except Feb always has 28 days
+                               ESMF_CAL_NOLEAP =     ESMF_CalendarType(3), & 
+                           ! 12 months, 30 days each
+                               ESMF_CAL_360DAY =     ESMF_CalendarType(4), & 
+                           ! user defined
+                               ESMF_CAL_GENERIC =    ESMF_CalendarType(5), &
+                           ! track base time seconds only
+                               ESMF_CAL_NOCALENDAR = ESMF_CalendarType(6)
+
+!------------------------------------------------------------------------------
+!     ! ESMF_Calendar
+!
+!     ! F90 class type to match C++ Calendar class in size only;
+!     !  all dereferencing within class is performed by C++ implementation
+!
+!------------------------------------------------------------------------------
+!
+!     ! ESMF_DaysPerYear
+!
+      type ESMF_DaysPerYear
+      private
+        integer :: D        ! whole days per year
+! Fractional days-per-year are not yet used in this implementation.  
+!        integer :: Dn       ! fractional days per year numerator
+!        integer :: Dd       ! fractional days per year denominator
+      end type              ! e.g. for Venus, D=0, Dn=926, Dd=1000
+!
+!------------------------------------------------------------------------------
+!     ! ESMF_Calendar
+!
+!
+      type ESMF_Calendar
+      private
+        type(ESMF_CalendarType) :: Type
+! TBH:  When NO_DT_COMPONENT_INIT is set, code that uses F95 compile-time 
+! TBH:  initialization of components of derived types is not included.  
+! TBH:  Some older compilers, like PGI 5.x do not support this F95 feature.  
+#ifdef NO_DT_COMPONENT_INIT
+        logical :: Set
+#else
+        logical :: Set = .false.
+#endif
+        integer, dimension(MONTHS_PER_YEAR) :: DaysPerMonth
+        integer :: SecondsPerDay
+        integer :: SecondsPerYear
+        type(ESMF_DaysPerYear) :: DaysPerYear
+      end type
+
+!------------------------------------------------------------------------------
+! !PUBLIC DATA:
+   TYPE(ESMF_Calendar), public, save, pointer :: defaultCal   ! Default Calendar
+
+
+!
+!------------------------------------------------------------------------------
+! !PUBLIC TYPES:
+      public MONTHS_PER_YEAR
+      public mday
+      public mdayleap
+      public monthbdys
+      public monthbdysleap
+      public daym
+      public daymleap
+      public mdaycum
+      public mdayleapcum
+      public ESMF_CalendarType
+      public ESMF_CAL_GREGORIAN, ESMF_CAL_NOLEAP, &
+             ESMF_CAL_360DAY, ESMF_CAL_NOCALENDAR
+!      public ESMF_CAL_JULIAN
+!      public ESMF_CAL_GENERIC
+      public ESMF_Calendar
+
+!------------------------------------------------------------------------------
+!
+! !PUBLIC MEMBER FUNCTIONS:
+      public ESMF_CalendarCreate
+
+! Required inherited and overridden ESMF_Base class methods
+
+      public ESMF_CalendarInitialized ! Only in this implementation, intended
+                                      ! to be private within ESMF methods
+!EOPI
+
+!==============================================================================
+
+      contains
+
+
+!==============================================================================
+!BOP
+! !IROUTINE: ESMF_CalendarCreate - Create a new ESMF Calendar of built-in type
+
+! !INTERFACE:
+      ! Private name; call using ESMF_CalendarCreate()
+      function ESMF_CalendarCreate(name, calendartype, rc)
+
+! !RETURN VALUE:
+      type(ESMF_Calendar) :: ESMF_CalendarCreate
+
+! !ARGUMENTS:
+      character (len=*),       intent(in),  optional :: name
+      type(ESMF_CalendarType), intent(in)            :: calendartype
+      integer,                 intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Creates and sets a {\tt calendar} to the given built-in
+!     {\tt ESMF\_CalendarType}. 
+!
+!     This is a private method; invoke via the public overloaded entry point
+!     {\tt ESMF\_CalendarCreate()}.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[{[name]}]
+!          The name for the newly created calendar.  If not specified, a
+!          default unique name will be generated: "CalendarNNN" where NNN
+!          is a unique sequence number from 001 to 999.
+!     \item[calendartype]
+!          The built-in {\tt ESMF\_CalendarType}.  Valid values are:
+!            {\tt ESMF\_CAL\_360DAY}, {\tt ESMF\_CAL\_GREGORIAN},
+!            {\tt ESMF\_CAL\_JULIANDAY}, {\tt ESMF\_CAL\_NOCALENDAR}, and
+!            {\tt ESMF\_CAL\_NOLEAP}.
+!          See the "Time Manager Reference" document for a description of
+!          each calendar type.
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!    
+!EOP
+! !REQUIREMENTS:
+!     TMGn.n.n
+      type(ESMF_DaysPerYear) :: dayspy
+
+      if ( present(rc) ) rc = ESMF_FAILURE
+! Calendar type is hard-coded.  Use ESMF library if more flexibility is 
+! needed.  
+#ifdef NO_LEAP_CALENDAR
+      if ( calendartype%caltype  /= ESMF_CAL_NOLEAP%caltype ) then
+         write(6,*) 'Not a valid calendar type for this implementation'
+         write(6,*) 'This implementation only allows ESMF_CAL_NOLEAP'
+         write(6,*) 'calender type set to     = ', calendartype%caltype
+         write(6,*) 'NO_LEAP calendar type is = ', ESMF_CAL_NOLEAP%caltype
+         return
+      end if
+      ESMF_CalendarCreate%Type = ESMF_CAL_NOLEAP
+#else
+      if ( calendartype%caltype  /= ESMF_CAL_GREGORIAN%caltype ) then
+         write(6,*) 'Not a valid calendar type for this implementation'
+         write(6,*) 'This implementation only allows ESMF_CAL_GREGORIAN'
+         write(6,*) 'calender type set to     = ', calendartype%caltype
+         write(6,*) 'GREGORIAN calendar type is = ', ESMF_CAL_GREGORIAN%caltype
+         return
+      end if
+      ESMF_CalendarCreate%Type = ESMF_CAL_GREGORIAN
+#endif
+! This is a bug on some systems -- need initial value set by compiler at 
+! startup.  
+! However, note that some older compilers do not support compile-time 
+! initialization of data members of Fortran derived data types.  For example, 
+! PGI 5.x compilers do not support this F95 feature.  See 
+! NO_DT_COMPONENT_INIT.  
+      ESMF_CalendarCreate%Set = .true.
+      ESMF_CalendarCreate%SecondsPerDay = SECONDS_PER_DAY
+! DaysPerYear and SecondsPerYear are incorrect for Gregorian calendars...  
+      dayspy%D = size(daym)
+!TBH:  TODO:  Replace DaysPerYear and SecondsPerYear with methods 
+!TBH:  TODO:  since they only make sense for the NO_LEAP calendar!  
+      ESMF_CalendarCreate%DaysPerYear = dayspy
+      ESMF_CalendarCreate%SecondsPerYear = ESMF_CalendarCreate%SecondsPerDay &
+                                       * dayspy%D
+!TBH:  TODO:  use mdayleap for leap-year calendar
+      ESMF_CalendarCreate%DaysPerMonth(:) = mday(:)
+
+      if ( present(rc) ) rc = ESMF_SUCCESS
+
+      end function ESMF_CalendarCreate
+
+
+!==============================================================================
+!BOP
+! !IROUTINE: ESMF_CalendarInitialized - check if calendar was created
+
+! !INTERFACE:
+      function ESMF_CalendarInitialized(calendar)
+
+! !RETURN VALUE:
+      logical ESMF_CalendarInitialized
+
+! !ARGUMENTS:
+      type(ESMF_Calendar), intent(in)            :: calendar
+
+! !DESCRIPTION:
+!EOP
+! !REQUIREMENTS:
+!     TMGn.n.n
+! Note that return value from this function will be bogus for older compilers 
+! that do not support compile-time initialization of data members of Fortran 
+! derived data types.  For example, PGI 5.x compilers do not support this F95 
+! feature.  At the moment, the call to this fuction is #ifdefd out when the 
+! leap-year calendar is used so this is not an issue for WRF (see 
+! NO_DT_COMPONENT_INIT).  
+        ESMF_CalendarInitialized = calendar%set
+
+     end function ESMF_CalendarInitialized
+
+      end module ESMF_CalendarMod
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Clock.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Clock.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Clock.F90	(revision 2744)
@@ -0,0 +1,1337 @@
+!
+! Earth System Modeling Framework
+! Copyright 2002-2003, University Corporation for Atmospheric Research,
+! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+! Laboratory, University of Michigan, National Centers for Environmental
+! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+! NASA Goddard Space Flight Center.
+! Licensed under the GPL.
+!
+!==============================================================================
+!
+!     ESMF Clock Module
+      module ESMF_ClockMod
+!     
+!==============================================================================
+!     
+! This file contains the Clock class definition and all Clock class methods.
+!     
+!------------------------------------------------------------------------------
+! INCLUDES
+#include <ESMF_TimeMgr.inc> 
+
+!==============================================================================
+!BOPI
+! !MODULE: ESMF_ClockMod
+!     
+! !DESCRIPTION:
+! Part of Time Manager F90 API wrapper of C++ implemenation
+!
+! Defines F90 wrapper entry points for corresponding
+! C++ class {\tt ESMC\_Time} implementation
+!     
+! See {\tt ../include/ESMC\_Clock.h} for complete description
+!
+!------------------------------------------------------------------------------
+! !USES:
+      ! inherit from ESMF base class
+      use ESMF_BaseMod
+
+      ! associated derived types
+      use ESMF_TimeIntervalMod   ! , only : ESMF_TimeInterval, &
+                                 !          ESMF_TimeIntervalIsPositive
+      use ESMF_TimeMod           ! , only : ESMF_Time
+      use ESMF_AlarmMod,        only : ESMF_Alarm
+
+      implicit none
+!
+!------------------------------------------------------------------------------
+! !PRIVATE TYPES:
+      private
+!------------------------------------------------------------------------------
+!     ! ESMF_Clock
+!     
+!     ! F90 class type to match C++ Clock class in size only;
+!     !  all dereferencing within class is performed by C++ implementation
+
+! internals for ESMF_Clock
+      type ESMF_ClockInt
+        type(ESMF_TimeInterval) :: TimeStep
+        type(ESMF_Time)  :: StartTime
+        type(ESMF_Time)  :: StopTime
+        type(ESMF_Time)  :: RefTime
+        type(ESMF_Time)  :: CurrTime
+        type(ESMF_Time)  :: PrevTime
+        integer(ESMF_KIND_I8) :: AdvanceCount
+        integer :: ClockMutex
+        integer :: NumAlarms
+        ! Note:  to mimic ESMF 2.1.0+, AlarmList is maintained 
+        ! within ESMF_Clock even though copies of each alarm are 
+        ! returned from ESMF_AlarmCreate() at the same time they 
+        ! are copied into the AlarmList!  This duplication is not 
+        ! as hideous as it might be because the ESMF_Alarm type 
+        ! has data members that are all POINTERs (thus the horrible 
+        ! shallow-copy-masquerading-as-reference-copy hack works).  
+        type(ESMF_Alarm), pointer, dimension(:) :: AlarmList
+      end type
+
+! Actual public type:  this bit allows easy mimic of "deep" ESMF_ClockCreate 
+! in ESMF 2.1.0+
+! NOTE:  DO NOT ADD NON-POINTER STATE TO THIS DATA TYPE.  It emulates ESMF 
+!        shallow-copy-masquerading-as-reference-copy.  
+      type ESMF_Clock
+        type(ESMF_ClockInt), pointer  :: clockint
+      end type
+
+!------------------------------------------------------------------------------
+! !PUBLIC TYPES:
+      public ESMF_Clock
+      public ESMF_ClockInt   ! needed on AIX but not PGI
+!------------------------------------------------------------------------------
+!
+! !PUBLIC MEMBER FUNCTIONS:
+      public ESMF_ClockCreate
+      public ESMF_ClockDestroy
+      public ESMF_ClockSet
+!      public ESMF_ClockSetOLD
+      public ESMF_ClockGet
+!      public ESMF_ClockGetAdvanceCount
+!      public ESMF_ClockGetTimeStep
+!      public ESMF_ClockSetTimeStep
+!      public ESMF_ClockGetCurrTime
+!      public ESMF_ClockSetCurrTime
+!      public ESMF_ClockGetStartTime
+!      public ESMF_ClockGetStopTime
+!      public ESMF_ClockGetRefTime
+!      public ESMF_ClockGetPrevTime
+!      public ESMF_ClockGetCurrSimTime
+!      public ESMF_ClockGetPrevSimTime
+! This must be public for ESMF_AlarmClockMod...  
+      public ESMF_ClockAddAlarm
+      public ESMF_ClockGetAlarmList
+!      public ESMF_ClockGetNumAlarms
+!      public ESMF_ClockSyncToWallClock
+      public ESMF_ClockAdvance
+      public ESMF_ClockIsStopTime
+      public ESMF_ClockStopTimeDisable
+
+! Required inherited and overridden ESMF_Base class methods
+
+!      public ESMF_ClockRead
+!      public ESMF_ClockWrite
+      public ESMF_ClockValidate
+      public ESMF_ClockPrint
+!EOPI
+
+!==============================================================================
+
+      contains
+
+!==============================================================================
+!
+! This section includes the Set methods.
+!
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockSetOLD - Initialize a clockint
+
+! !INTERFACE:
+      subroutine ESMF_ClockSetOLD(clockint, TimeStep, StartTime, &
+                                  StopTime, RefTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_ClockInt), intent(out) :: clockint
+      type(ESMF_TimeInterval), intent(in), optional :: TimeStep
+      type(ESMF_Time), intent(in) :: StartTime
+      type(ESMF_Time), intent(in) :: StopTime
+      type(ESMF_Time), intent(in), optional :: RefTime
+      integer, intent(out), optional :: rc
+! Local
+      integer i
+    
+! !DESCRIPTION:
+!     Initialize an {\tt ESMF\_Clock}
+!     
+!     The arguments are:
+!     \begin{description}
+!     \item[clockint]
+!          The object instance to initialize
+!     \item[{[TimeStep]}]
+!          The {\tt ESMF\_Clock}'s time step interval
+!     \item[StartTime]
+!          The {\tt ESMF\_Clock}'s starting time
+!     \item[StopTime]
+!          The {\tt ESMF\_Clock}'s stopping time
+!     \item[{[RefTime]}]
+!          The {\tt ESMF\_Clock}'s reference time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!     
+! !REQUIREMENTS:
+!     TMG3.1, TMG3.4.4
+!EOP
+      IF ( PRESENT(TimeStep) ) clockint%TimeStep = TimeStep
+      IF ( PRESENT(RefTime) )THEN
+         clockint%RefTime = RefTime
+      ELSE
+         clockint%RefTime = StartTime
+      END IF
+      clockint%CurrTime = StartTime
+      clockint%StartTime = StartTime
+      clockint%StopTime = StopTime
+      clockint%NumAlarms = 0
+      clockint%AdvanceCount = 0
+      ALLOCATE(clockint%AlarmList(MAX_ALARMS))
+      ! TBH:  This incredible hack can be removed once ESMF_*Validate() 
+      ! TBH:  can tell if a deep ESMF_* was created or not.  
+      DO i = 1, MAX_ALARMS
+        NULLIFY( clockint%AlarmList( i )%alarmint )
+      ENDDO
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+    
+      end subroutine ESMF_ClockSetOLD
+
+
+! !IROUTINE: ESMF_ClockSet - Set clock properties -- for compatibility with ESMF 2.0.1
+
+! !INTERFACE:
+      subroutine ESMF_ClockSet(clock, TimeStep, StartTime, StopTime, &
+                               RefTime, CurrTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(inout) :: clock
+      type(ESMF_TimeInterval), intent(in), optional :: TimeStep
+      type(ESMF_Time), intent(in), optional :: StartTime
+      type(ESMF_Time), intent(in), optional :: StopTime
+      type(ESMF_Time), intent(in), optional :: RefTime
+      type(ESMF_Time), intent(in), optional :: CurrTime
+      integer, intent(out), optional :: rc
+! Local
+      integer ierr
+    
+! !DESCRIPTION:
+!     Initialize an {\tt ESMF\_Clock}
+!     
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to initialize
+!     \item[{[TimeStep]}]
+!          The {\tt ESMF\_Clock}'s time step interval
+!     \item[StartTime]
+!          The {\tt ESMF\_Clock}'s starting time
+!     \item[StopTime]
+!          The {\tt ESMF\_Clock}'s stopping time
+!     \item[{[RefTime]}]
+!          The {\tt ESMF\_Clock}'s reference time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!     
+! !REQUIREMENTS:
+!     TMG3.1, TMG3.4.4
+!EOP
+      ierr = ESMF_SUCCESS
+      IF ( PRESENT(TimeStep) ) THEN
+        CALL ESMF_ClockSetTimeStep ( clock, TimeStep, rc=ierr )
+      ENDIF
+      IF ( PRESENT(RefTime) ) clock%clockint%RefTime = RefTime
+      IF ( PRESENT(StartTime) ) clock%clockint%StartTime = StartTime
+      IF ( PRESENT(StopTime) ) clock%clockint%StopTime = StopTime
+      IF ( PRESENT(CurrTime) ) THEN
+        CALL ESMF_ClockSetCurrTime(clock, CurrTime, rc=ierr)
+      ENDIF
+      IF ( PRESENT(rc) ) rc = ierr
+
+      end subroutine ESMF_ClockSet
+
+
+! Create ESMF_Clock using ESMF 2.1.0+ semantics
+      FUNCTION ESMF_ClockCreate( name, TimeStep, StartTime, StopTime, &
+                                 RefTime, rc )
+        ! return value
+        type(ESMF_Clock) :: ESMF_ClockCreate
+        ! !ARGUMENTS:
+        character (len=*),       intent(in),  optional :: name
+        type(ESMF_TimeInterval), intent(in), optional :: TimeStep
+        type(ESMF_Time), intent(in) :: StartTime
+        type(ESMF_Time), intent(in) :: StopTime
+        type(ESMF_Time), intent(in), optional :: RefTime
+        integer, intent(out), optional :: rc
+        ! locals
+        type(ESMF_Clock) :: clocktmp
+         ! TBH:  ignore allocate errors, for now
+        ALLOCATE( clocktmp%clockint )
+        CALL ESMF_ClockSetOLD( clocktmp%clockint,   &
+                               TimeStep= TimeStep,  &
+                               StartTime=StartTime, &
+                               StopTime= StopTime,  &
+                               RefTime=RefTime, rc=rc )
+        ESMF_ClockCreate = clocktmp
+      END FUNCTION ESMF_ClockCreate
+
+
+! Deallocate memory for ESMF_Clock
+      SUBROUTINE ESMF_ClockDestroy( clock, rc )
+         TYPE(ESMF_Clock), INTENT(INOUT) :: clock
+         INTEGER,          INTENT(  OUT), OPTIONAL :: rc
+         ! TBH:  ignore deallocate errors, for now
+         DEALLOCATE( clock%clockint%AlarmList )
+         DEALLOCATE( clock%clockint )
+         IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+      END SUBROUTINE ESMF_ClockDestroy
+
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGet - Get clock properties -- for compatibility with ESMF 2.0.1 
+
+! !INTERFACE:
+      subroutine ESMF_ClockGet(clock, StartTime, CurrTime,       &
+                               AdvanceCount, StopTime, TimeStep, &
+                               PrevTime, RefTime, &
+                               rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_Time), intent(out), optional :: StartTime
+      type(ESMF_Time), intent(out), optional :: CurrTime
+      type(ESMF_Time), intent(out), optional :: StopTime
+      type(ESMF_Time), intent(out), optional :: PrevTime
+      type(ESMF_Time), intent(out), optional :: RefTime
+      integer(ESMF_KIND_I8), intent(out), optional :: AdvanceCount
+      type(ESMF_TimeInterval), intent(out), optional :: TimeStep
+      integer, intent(out), optional :: rc
+      integer :: ierr
+
+! !DESCRIPTION:
+!     Returns the number of times the {\tt ESMF\_Clock} has been advanced
+!     (time stepped)
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the advance count from
+!     \item[StartTime]
+!          The start time
+!     \item[CurrTime]
+!          The current time
+!     \item[AdvanceCount]
+!          The number of times the {\tt ESMF\_Clock} has been advanced
+!     \item[StopTime]
+!          The {\tt ESMF\_Clock}'s stopping time
+!     \item[{[TimeStep]}]
+!          The {\tt ESMF\_Clock}'s time step interval
+!     \item[{[PrevTime]}]
+!          The {\tt ESMF\_Clock}'s previous current time
+!     \item[{[PrevTime]}]
+!          The {\tt ESMF\_Clock}'s reference time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+
+! !REQUIREMENTS:
+!     TMG3.5.1
+!EOP
+      ierr = ESMF_SUCCESS
+
+      IF ( PRESENT (StartTime) ) THEN
+        CALL ESMF_ClockGetStartTime( clock, StartTime=StartTime, rc=ierr )
+      ENDIF
+      IF ( PRESENT (CurrTime) ) THEN
+        CALL ESMF_ClockGetCurrTime( clock , CurrTime, ierr )
+      ENDIF
+      IF ( PRESENT (StopTime) ) THEN
+        CALL ESMF_ClockGetStopTime( clock , StopTime, ierr )
+      ENDIF
+      IF ( PRESENT (AdvanceCount) ) THEN
+        CALL ESMF_ClockGetAdvanceCount(clock, AdvanceCount, ierr)
+      ENDIF
+      IF ( PRESENT (TimeStep) ) THEN
+        CALL ESMF_ClockGetTimeStep(clock, TimeStep, ierr)
+      ENDIF
+      IF ( PRESENT (PrevTime) ) THEN
+        CALL ESMF_ClockGetPrevTime(clock, PrevTime, ierr)
+      ENDIF
+      IF ( PRESENT (RefTime) ) THEN
+        CALL ESMF_ClockGetRefTime(clock, RefTime, ierr)
+      ENDIF
+
+      IF ( PRESENT (rc) ) THEN
+        rc = ierr
+      ENDIF
+    
+      end subroutine ESMF_ClockGet
+
+
+! !IROUTINE: ESMF_ClockGetAdvanceCount - Get the clock's advance count
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetAdvanceCount(clock, AdvanceCount, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      integer(ESMF_KIND_I8), intent(out) :: AdvanceCount
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Returns the number of times the {\tt ESMF\_Clock} has been advanced
+!     (time stepped)
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the advance count from
+!     \item[AdvanceCount]
+!          The number of times the {\tt ESMF\_Clock} has been advanced
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+
+! !REQUIREMENTS:
+!     TMG3.5.1
+!EOP
+
+      AdvanceCount = clock%clockint%AdvanceCount
+
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+    
+      end subroutine ESMF_ClockGetAdvanceCount
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetTimeStep - Get a clock's timestep interval
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetTimeStep(clock, TimeStep, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_TimeInterval), intent(out) :: TimeStep
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Clock}'s timestep interval
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the time step from
+!     \item[TimeStep]
+!          The time step
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.5.2
+!EOP
+
+      TimeStep = clock%clockint%TimeStep
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+    
+      end subroutine ESMF_ClockGetTimeStep
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockSetTimeStep - Set a clock's timestep interval
+
+! !INTERFACE:
+      subroutine ESMF_ClockSetTimeStep(clock, TimeStep, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(out) :: clock
+      type(ESMF_TimeInterval), intent(in) :: TimeStep
+      integer, intent(out), optional      :: rc
+
+! !DESCRIPTION:
+!     Set an {\tt ESMF\_Clock}'s timestep interval
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to set the time step
+!     \item[TimeStep]
+!          The time step
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.4.2
+!EOP
+
+      clock%clockint%TimeStep = TimeStep
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_ClockSetTimeStep
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetCurrTime - Get a clock's current time
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetCurrTime(clock, CurrTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_Time), intent(out) :: CurrTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Clock}'s current time     
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the current time from
+!     \item[CurrTime]
+!          The current time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.5.4
+!EOP
+
+      CurrTime = clock%clockint%CurrTime
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+      end subroutine ESMF_ClockGetCurrTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockSetCurrTime - Set a clock's current time
+
+! !INTERFACE:
+      subroutine ESMF_ClockSetCurrTime(clock, CurrTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(out) :: clock
+      type(ESMF_Time), intent(in) :: CurrTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Set an {\tt ESMF\_Clock}'s current time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to set the current time from
+!     \item[CurrTime]
+!          The current time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.4.3
+!EOP
+
+      clock%clockint%CurrTime = CurrTime
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+    
+      end subroutine ESMF_ClockSetCurrTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetStartTime - Get a clock's start time
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetStartTime(clock, StartTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_Time), intent(out) :: StartTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Clock}'s start time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the start time from
+!     \item[StartTime]
+!          The start time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.5.3
+!EOP
+
+      StartTime = clock%clockint%StartTime
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+    
+      end subroutine ESMF_ClockGetStartTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetStopTime - Get a clock's stop time
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetStopTime(clock, StopTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_Time), intent(out) :: StopTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Clock}'s stop time
+! 
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the stop time from
+!     \item[StopTime]
+!          The stop time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.5.3
+!EOP
+
+      StopTime = clock%clockint%StopTime
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+    
+      end subroutine ESMF_ClockGetStopTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetRefTime - Get a clock's reference time
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetRefTime(clock, RefTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_Time), intent(out) :: RefTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Clock}'s reference time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the reference time from
+!     \item[RefTime]
+!          The reference time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.5.3
+!EOP
+      refTime = clock%clockint%RefTime
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+      end subroutine ESMF_ClockGetRefTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetPrevTime - Get a clock's previous current time
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetPrevTime(clock, PrevTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_Time), intent(out) :: PrevTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Clock}'s previous current time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the previous current time from
+!     \item[PrevTime]
+!          The previous current time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.5.4
+!EOP
+
+! hack for bug in PGI 5.1-x
+!      prevTime = Clock%clockint%CurrTime - Clock%clockint%TimeStep
+      prevTime = ESMF_TimeDec( Clock%clockint%CurrTime, &
+                               Clock%clockint%TimeStep )
+
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+      end subroutine ESMF_ClockGetPrevTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetCurrSimTime - Get a clock's current simulation time
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetCurrSimTime(clock, CurrSimTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_TimeInterval), intent(out) :: CurrSimTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Clock}'s current simulation time
+! 
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the current simulation time from
+!     \item[CurrSimTime]
+!          The current simulation time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.5.5
+!EOP
+      CALL wrf_error_fatal( 'ESMF_ClockGetCurrSimTime not supported' )
+      end subroutine ESMF_ClockGetCurrSimTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetPrevSimTime - Get a clock's previous simulation time
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetPrevSimTime(clock, PrevSimTime, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_TimeInterval), intent(out) :: PrevSimTime
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Clock}'s previous simulation time
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the previous simulation time from
+!     \item[PrevSimTime]
+!          The previous simulation time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG3.5.5
+!EOP
+      CALL wrf_error_fatal( 'ESMF_ClockGetPrevSimTime not supported' )
+      end subroutine ESMF_ClockGetPrevSimTime
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockAddAlarm - Add an alarm to a clock's alarm list
+
+! !INTERFACE:
+      subroutine ESMF_ClockAddAlarm(clock, Alarm, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(inout) :: clock
+      type(ESMF_Alarm), intent(inout) :: Alarm
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Add an {\tt ESMF\_Alarm} to an {\tt ESMF\_Clock}'s {\tt ESMF\_Alarm} list
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to add an {\tt ESMF\_Alarm} to
+!     \item[Alarm]
+!          The {\tt ESMF\_Alarm} to add to the {\tt ESMF\_Clock}'s
+!          {\tt ESMF\_Alarm} list
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!   
+! !REQUIREMENTS:
+!     TMG4.1, TMG4.2
+!EOP
+    
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+      clock%clockint%NumAlarms = clock%clockint%NumAlarms + 1
+      IF ( clock%clockint%NumAlarms > SIZE (clock%clockint%AlarmList) ) THEN
+        CALL wrf_error_fatal ( 'ESMF_ClockAddAlarm:  too many alarms' )
+      ELSE IF ( .NOT. ASSOCIATED( Alarm%alarmint ) ) THEN
+        CALL wrf_error_fatal ( &
+               'ESMF_ClockAddAlarm:  alarm not created' )
+      ELSE
+        IF ( Alarm%alarmint%RingTimeSet ) THEN
+           Alarm%alarmint%PrevRingTime = Alarm%alarmint%RingTime
+        ELSE
+!TBH:  This has the nasty side-effect of forcing us to explicitly turn on 
+!TBH:  alarms that are created with RingInterval only, if we want them to start 
+!TBH:  ringing right away.  And this is done (see 
+!TBH:  COMPUTE_VORTEX_CENTER_ALARM).  Straighten this out...  
+           Alarm%alarmint%PrevRingTime = clock%clockint%CurrTime
+        ENDIF
+        Alarm%alarmint%Ringing = .FALSE.
+
+        ! finally, load the alarm into the list
+        clock%clockint%AlarmList(clock%clockint%NumAlarms) = Alarm
+      ENDIF
+    
+      end subroutine ESMF_ClockAddAlarm
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetAlarmList - Get a clock's alarm list
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetAlarmList(clock, AlarmList, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_Alarm), pointer :: AlarmList(:)
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get an {\tt ESMF\_Clock}'s {\tt ESMF\_Alarm} list     
+!   
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the {\tt ESMF\_Alarm} list from
+!     \item[AlarmList]
+!          The {\tt ESMF\_Clock}'s {\tt ESMF\_Alarm} list
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!   
+! !REQUIREMENTS:
+!     TMG4.3
+!EOP
+
+      AlarmList => clock%clockint%AlarmList
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_ClockGetAlarmList
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetNumAlarms - Get the number of alarms in a clock's alarm list
+
+! !INTERFACE:
+      subroutine ESMF_ClockGetNumAlarms(clock, NumAlarms, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      integer, intent(out) :: NumAlarms
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Get the number of {\tt ESMF\_Alarm}s in an {\tt ESMF\_Clock}'s
+!       {\tt ESMF\_Alarm} list     
+!   
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to get the number of {\tt ESMF\_Alarm}s from
+!     \item[NumAlarms]
+!          The number of {\tt ESMF\_Alarm}s in the {\tt ESMF\_Clock}'s
+!            {\tt ESMF\_Alarm} list
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!   
+! !REQUIREMENTS:
+!     TMG4.3
+!EOP
+
+      NumAlarms = clock%clockint%NumAlarms
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+    
+      end subroutine ESMF_ClockGetNumAlarms
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockSyncToWallClock - Set clock's current time to wall clock time
+
+! !INTERFACE:
+      subroutine ESMF_ClockSyncToWallClock(clock, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(inout) :: clock
+      integer, intent(out), optional :: rc
+    
+! !DESCRIPTION:
+!     Set an {\tt ESMF\_Clock}'s current time to wall clock time     
+!   
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to synchronize to wall clock time
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!   
+! !REQUIREMENTS:
+!     TMG3.4.5
+!EOP
+      CALL wrf_error_fatal( 'ESMF_ClockSyncToWallClock not supported' )
+      end subroutine ESMF_ClockSyncToWallClock
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockAdvance - Advance a clock's current time by one time step
+
+! !INTERFACE:
+      subroutine ESMF_ClockAdvance(clock, RingingAlarmList, &
+                                   NumRingingAlarms, rc)
+
+use esmf_timemod
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(inout) :: clock
+      type(ESMF_Alarm), dimension(MAX_ALARMS), intent(out), optional :: &
+                                        RingingAlarmList
+      integer, intent(out), optional :: NumRingingAlarms
+      integer, intent(out), optional :: rc
+! Local
+      logical pred1, pred2, pred3
+      integer i, n
+      type(ESMF_Alarm) :: alarm
+      logical :: positive_timestep
+!   
+! !DESCRIPTION:
+!     Advance an {\tt ESMF\_Clock}'s current time by one time step
+!  
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to advance
+!     \item[{[RingingAlarmList]}]
+!          Return a list of any ringing alarms after the time step
+!     \item[{[NumRingingAlarms]}]
+!          The number of ringing alarms returned
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!  
+! !REQUIREMENTS:
+!     TMG3.4.1
+!EOP
+! hack for bug in PGI 5.1-x
+!      clock%clockint%CurrTime = clock%clockint%CurrTime + &
+!                                clock%clockint%TimeStep
+      clock%clockint%CurrTime = ESMF_TimeInc( clock%clockint%CurrTime, &
+                                              clock%clockint%TimeStep )
+      positive_timestep = ESMF_TimeIntervalIsPositive( clock%clockint%TimeStep )
+
+      IF ( Present(NumRingingAlarms) ) NumRingingAlarms = 0
+      clock%clockint%AdvanceCount = clock%clockint%AdvanceCount + 1
+      DO i = 1, MAX_ALARMS
+        alarm = clock%clockint%AlarmList(i)
+        ! TBH:  This is really dangerous.  We need to be able to NULLIFY 
+        ! TBH:  alarmint at compile-time (F95 synax) to make this safe.  
+!$$$TBH:  see if F95 compile-time pointer-nullification is supported by all 
+!$$$TBH:  compilers we support
+        IF ( ASSOCIATED( alarm%alarmint ) ) THEN
+          IF ( alarm%alarmint%Enabled ) THEN
+            IF ( alarm%alarmint%RingIntervalSet ) THEN
+              pred1 = .FALSE. ; pred2 = .FALSE. ; pred3 = .FALSE.
+              ! alarm cannot ring if clock has passed the alarms stop time
+              IF ( alarm%alarmint%StopTimeSet ) THEN
+                IF ( positive_timestep ) THEN
+! hack for bug in PGI 5.1-x
+!                  PRED1 = clock%clockint%CurrTime > alarm%alarmint%StopTime
+                  PRED1 = ESMF_TimeGT( clock%clockint%CurrTime, &
+                                       alarm%alarmint%StopTime )
+                ELSE
+                  ! in this case time step is negative and stop time is 
+                  ! less than start time
+!                  PRED1 = clock%clockint%CurrTime < alarm%alarmint%StopTime
+                  PRED1 = ESMF_TimeLT( clock%clockint%CurrTime, &
+                                       alarm%alarmint%StopTime )
+                ENDIF
+              ENDIF
+              ! one-shot alarm:  check for ring time 
+! TBH:  Need to remove duplicated code.  Need to enforce only one of 
+! TBH:  alarm%alarmint%RingTimeSet or alarm%alarmint%RingIntervalSet ever 
+! TBH:  being .TRUE. and simplify the logic.  Also, the simpler 
+! TBH:  implementation in the duplicated code below should be sufficient.  
+              IF ( alarm%alarmint%RingTimeSet ) THEN
+                IF ( positive_timestep ) THEN
+! hack for bug in PGI 5.1-x
+!                   PRED2 = ( alarm%alarmint%RingTime <= clock%clockint%CurrTime     &
+!                          .AND. clock%clockint%CurrTime < alarm%alarmint%RingTime + &
+!                                clock%clockint%TimeStep )
+                   PRED2 = ( ESMF_TimeLE( alarm%alarmint%RingTime,       &
+                                          clock%clockint%CurrTime )      &
+                             .AND. ESMF_TimeLT( clock%clockint%CurrTime, &
+                               ESMF_TimeInc( alarm%alarmint%RingTime,    &
+                                             clock%clockint%TimeStep ) ) )
+                ELSE
+                  ! in this case time step is negative and stop time is 
+                  ! less than start time
+! hack for bug in PGI 5.1-x
+!                   PRED2 = ( alarm%alarmint%RingTime >= clock%clockint%CurrTime     &
+!                          .AND. clock%clockint%CurrTime > alarm%alarmint%RingTime + &
+!                                clock%clockint%TimeStep )
+                   PRED2 = ( ESMF_TimeGE( alarm%alarmint%RingTime,       &
+                                          clock%clockint%CurrTime )      &
+                             .AND. ESMF_TimeGT( clock%clockint%CurrTime, &
+                               ESMF_TimeInc( alarm%alarmint%RingTime,    &
+                                             clock%clockint%TimeStep ) ) )
+                ENDIF
+              ENDIF
+              ! repeating alarm:  check for ring interval
+              IF ( alarm%alarmint%RingIntervalSet ) THEN
+                IF ( positive_timestep ) THEN
+! hack for bug in PGI 5.1-x
+!                   PRED3 = ( alarm%alarmint%PrevRingTime + alarm%alarmint%RingInterval <= &
+!                             clock%clockint%CurrTime )
+
+                   PRED3 = ( ESMF_TimeLE( ESMF_TimeInc(                  &
+                                          alarm%alarmint%PrevRingTime,   &
+                                          alarm%alarmint%RingInterval ), &
+                             clock%clockint%CurrTime ) )
+                ELSE
+                  ! in this case time step is negative and stop time is 
+                  ! less than start time
+                  ! ring interval must always be positive
+! hack for bug in PGI 5.1-x
+!                   PRED3 = ( alarm%alarmint%PrevRingTime - alarm%alarmint%RingInterval >= &
+!                             clock%clockint%CurrTime )
+
+                   PRED3 = ( ESMF_TimeGE( ESMF_TimeDec(                  &
+                                          alarm%alarmint%PrevRingTime,   &
+                                          alarm%alarmint%RingInterval ), &
+                             clock%clockint%CurrTime ) )
+                ENDIF
+              ENDIF
+              IF ( ( .NOT. ( pred1 ) ) .AND. &
+                   ( ( pred2 ) .OR. ( pred3 ) ) ) THEN
+                 alarm%alarmint%Ringing = .TRUE.
+                 IF ( positive_timestep ) THEN
+! hack for bug in PGI 5.1-x
+!                   IF ( PRED3) alarm%alarmint%PrevRingTime = alarm%alarmint%PrevRingTime + &
+!                                                    alarm%alarmint%RingInterval
+                   IF ( PRED3 )                                   &
+                     alarm%alarmint%PrevRingTime =                &
+                       ESMF_TimeInc( alarm%alarmint%PrevRingTime, &
+                                     alarm%alarmint%RingInterval )
+                 ELSE
+                   ! in this case time step is negative and stop time is 
+                   ! less than start time
+                   ! ring interval must always be positive
+! hack for bug in PGI 5.1-x
+!                   IF ( PRED3) alarm%alarmint%PrevRingTime = alarm%alarmint%PrevRingTime - &
+!                                                    alarm%alarmint%RingInterval
+                   IF ( PRED3 )                                   &
+                     alarm%alarmint%PrevRingTime =                &
+                       ESMF_TimeDec( alarm%alarmint%PrevRingTime, &
+                                     alarm%alarmint%RingInterval )
+                 ENDIF
+                 IF ( PRESENT( RingingAlarmList ) .AND. &
+                      PRESENT ( NumRingingAlarms ) ) THEN
+                   NumRingingAlarms = NumRingingAlarms + 1
+                   RingingAlarmList( NumRingingAlarms ) = alarm
+                 ENDIF
+              ENDIF
+            ELSE IF ( alarm%alarmint%RingTimeSet ) THEN
+! TBH:  Need to remove duplicated code.  Need to enforce only one of 
+! TBH:  alarm%alarmint%RingTimeSet or alarm%alarmint%RingIntervalSet ever 
+! TBH:  being .TRUE. and simplify the logic.  Also, the simpler 
+! TBH:  implementation in here should be sufficient.  
+              IF ( positive_timestep ) THEN
+! hack for bug in PGI 5.1-x
+!                IF ( alarm%alarmint%RingTime <= clock%clockint%CurrTime ) THEN
+                IF ( ESMF_TimeLE( alarm%alarmint%RingTime, &
+                                  clock%clockint%CurrTime ) ) THEN
+                   alarm%alarmint%Ringing = .TRUE.
+                   IF ( PRESENT( RingingAlarmList ) .AND. &
+                        PRESENT ( NumRingingAlarms ) ) THEN
+                     NumRingingAlarms = NumRingingAlarms + 1
+                     RingingAlarmList( NumRingingAlarms ) = alarm
+                   ENDIF
+                ENDIF
+              ELSE
+                ! in this case time step is negative and stop time is 
+                ! less than start time
+! hack for bug in PGI 5.1-x
+!                IF ( alarm%alarmint%RingTime >= clock%clockint%CurrTime ) THEN
+                IF ( ESMF_TimeGE( alarm%alarmint%RingTime, &
+                                  clock%clockint%CurrTime ) ) THEN
+                   alarm%alarmint%Ringing = .TRUE.
+                   IF ( PRESENT( RingingAlarmList ) .AND. &
+                        PRESENT ( NumRingingAlarms ) ) THEN
+                     NumRingingAlarms = NumRingingAlarms + 1
+                     RingingAlarmList( NumRingingAlarms ) = alarm
+                   ENDIF
+                ENDIF
+              ENDIF
+            ENDIF
+            IF ( alarm%alarmint%StopTimeSet ) THEN
+! TBH:  what is this for???  
+            ENDIF
+          ENDIF
+        ENDIF
+        clock%clockint%AlarmList(i) = alarm
+      ENDDO
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+    
+      end subroutine ESMF_ClockAdvance
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockStopTimeDisable - NOOP for compatibility with ESMF 2.1.0+
+
+! !INTERFACE:
+      subroutine ESMF_ClockStopTimeDisable(clock, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      integer, intent(out), optional :: rc
+
+      rc = ESMF_SUCCESS
+
+      end subroutine ESMF_ClockStopTimeDisable
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockIsStopTime - Has the clock reached its stop time ?
+
+! !INTERFACE:
+      function ESMF_ClockIsStopTime(clock, rc)
+!
+! !RETURN VALUE:
+      logical :: ESMF_ClockIsStopTime
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      integer, intent(out), optional :: rc
+      logical :: positive_timestep
+
+! !DESCRIPTION:
+!     Return true if {\tt ESMF\_Clock} has reached its stop time, false 
+!     otherwise     
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to check
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+
+! !REQUIREMENTS:
+!     TMG3.5.6
+!EOP
+
+      positive_timestep = ESMF_TimeIntervalIsPositive( clock%clockint%TimeStep )
+      IF ( positive_timestep ) THEN
+! hack for bug in PGI 5.1-x
+!        if ( clock%clockint%CurrTime .GE. clock%clockint%StopTime ) THEN
+        if ( ESMF_TimeGE( clock%clockint%CurrTime, &
+                          clock%clockint%StopTime ) ) THEN
+          ESMF_ClockIsStopTime = .TRUE.
+        else
+          ESMF_ClockIsStopTime = .FALSE.
+        endif
+      ELSE
+! hack for bug in PGI 5.1-x
+!        if ( clock%clockint%CurrTime .LE. clock%clockint%StopTime ) THEN
+        if ( ESMF_TimeLE( clock%clockint%CurrTime, &
+                          clock%clockint%StopTime ) ) THEN
+          ESMF_ClockIsStopTime = .TRUE.
+        else
+          ESMF_ClockIsStopTime = .FALSE.
+        endif
+      ENDIF
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+    
+      end function ESMF_ClockIsStopTime
+
+!------------------------------------------------------------------------------
+!
+! This section defines the overridden Read, Write, Validate and Print methods
+! from the ESMF_Base class
+!
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockRead - Restores a clock
+
+! !INTERFACE:
+      subroutine ESMF_ClockRead(clock, TimeStep, StartTime, StopTime, &
+                                RefTime, CurrTime, PrevTime, AdvanceCount, &
+                                AlarmList, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(out) :: clock
+      type(ESMF_TimeInterval), intent(in) :: TimeStep
+      type(ESMF_Time), intent(in) :: StartTime
+      type(ESMF_Time), intent(in) :: StopTime
+      type(ESMF_Time), intent(in) :: RefTime
+      type(ESMF_Time), intent(in) :: CurrTime
+      type(ESMF_Time), intent(in) :: PrevTime
+      integer(ESMF_KIND_I8), intent(in) :: AdvanceCount
+      type(ESMF_Alarm), dimension(MAX_ALARMS), intent(in) :: AlarmList
+      integer, intent(out), optional :: rc
+    
+! !DESCRIPTION:
+!     Restore an {\tt ESMF\_Clock}
+!     
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to restore
+!     \item[TimeStep]
+!          The {\tt ESMF\_Clock}'s time step interval
+!     \item[StartTime]
+!          The {\tt ESMF\_Clock}'s starting time
+!     \item[StopTime]
+!          The {\tt ESMF\_Clock}'s stopping time
+!     \item[RefTime]
+!          The {\tt ESMF\_Clock}'s reference time
+!     \item[CurrTime]
+!          The {\tt ESMF\_Clock}'s current time
+!     \item[PrevTime]
+!          The {\tt ESMF\_Clock}'s previous time
+!     \item[AdvanceCount]
+!          The number of times the {\tt ESMF\_Clock} has been advanced
+!     \item[AlarmList]
+!          The {\tt ESMF\_Clock}'s {\tt ESMF\_Alarm} list
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!     
+! !REQUIREMENTS:
+!EOP
+      CALL wrf_error_fatal( 'ESMF_ClockRead not supported' )
+      end subroutine ESMF_ClockRead
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockWrite - Saves a clock
+
+! !INTERFACE:
+      subroutine ESMF_ClockWrite(clock, TimeStep, StartTime, StopTime, &
+                            RefTime, CurrTime, PrevTime, AdvanceCount, &
+                            AlarmList, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      type(ESMF_TimeInterval), intent(out) :: TimeStep
+      type(ESMF_Time), intent(out) :: StartTime
+      type(ESMF_Time), intent(out) :: StopTime
+      type(ESMF_Time), intent(out) :: RefTime
+      type(ESMF_Time), intent(out) :: CurrTime
+      type(ESMF_Time), intent(out) :: PrevTime
+      integer(ESMF_KIND_I8), intent(out) :: AdvanceCount
+      type(ESMF_Alarm), dimension(MAX_ALARMS), intent(out) :: AlarmList
+      integer, intent(out), optional :: rc
+    
+! !DESCRIPTION:
+!     Save an {\tt ESMF\_Clock}
+!     
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          The object instance to save
+!     \item[TimeStep]
+!          The {\tt ESMF\_Clock}'s time step interval
+!     \item[StartTime]
+!          The {\tt ESMF\_Clock}'s starting time
+!     \item[StopTime]
+!          The {\tt ESMF\_Clock}'s stopping time
+!     \item[RefTime]
+!          The {\tt ESMF\_Clock}'s reference time
+!     \item[CurrTime]
+!          The {\tt ESMF\_Clock}'s current time
+!     \item[PrevTime]
+!          The {\tt ESMF\_Clock}'s previous time
+!     \item[AdvanceCount]
+!          The number of times the {\tt ESMF\_Clock} has been advanced
+!     \item[AlarmList]
+!          The {\tt ESMF\_Clock}'s {\tt ESMF\_Alarm} list
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!     
+! !REQUIREMENTS:
+!EOP
+      CALL wrf_error_fatal( 'ESMF_ClockWrite not supported' )
+      end subroutine ESMF_ClockWrite
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_ClockValidate - Validate a Clock's properties
+
+! !INTERFACE:
+      subroutine ESMF_ClockValidate(clock, opts, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      character (len=*), intent(in), optional :: opts
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     Perform a validation check on an {\tt ESMF\_Clock}'s properties
+!
+!     The arguments are:  
+!     \begin{description}
+!     \item[clock]
+!          {\tt ESMF\_Clock} to validate
+!     \item[{[opts]}]
+!          Validate options
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description} 
+!
+! !REQUIREMENTS:
+!     TMGn.n.n
+!EOP
+      CALL wrf_error_fatal( 'ESMF_ClockValidate not supported' )
+      end subroutine ESMF_ClockValidate
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_ClockPrint - Print out a Clock's properties
+
+! !INTERFACE:
+      subroutine ESMF_ClockPrint(clock, opts, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Clock), intent(in) :: clock
+      character (len=*), intent(in), optional :: opts
+      integer, intent(out), optional :: rc
+
+! !DESCRIPTION:
+!     To support testing/debugging, print out an {\tt ESMF\_Clock}'s
+!     properties.
+! 
+!     The arguments are:
+!     \begin{description}
+!     \item[clock]
+!          {\tt ESMF\_Clock} to print out
+!     \item[{[opts]}]
+!          Print options
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMGn.n.n
+!EOP
+      CALL wrf_error_fatal( 'ESMF_ClockPrint not supported' )
+      end subroutine ESMF_ClockPrint
+
+!------------------------------------------------------------------------------
+
+      end module ESMF_ClockMod
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Fraction.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Fraction.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Fraction.F90	(revision 2744)
@@ -0,0 +1,79 @@
+!
+! Earth System Modeling Framework
+! Copyright 2002-2003, University Corporation for Atmospheric Research,
+! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+! Laboratory, University of Michigan, National Centers for Environmental
+! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+! NASA Goddard Space Flight Center.
+! Licensed under the GPL.
+!
+! ESMF Fraction Module
+!
+!==============================================================================
+!
+!     ESMF Fraction Module
+      module ESMF_FractionMod
+!
+!==============================================================================
+!
+! This file contains the Fraction class definition and all Fraction
+! class methods.
+!
+!------------------------------------------------------------------------------
+! INCLUDES
+!
+!===============================================================================
+!BOPI
+!
+! !MODULE: ESMF_FractionMod
+!
+! !DESCRIPTION:
+! Part of ESMF F90 API wrapper of C++ implemenation
+!
+! Defines F90 wrapper entry points for corresponding
+! C++ implementaion of class {\tt ESMC\_Fraction}
+!
+! See {\tt ../include/ESMC\_Fraction.h} for complete description
+!
+!------------------------------------------------------------------------------
+! !USES:
+
+      implicit none
+!
+!------------------------------------------------------------------------------
+! !PRIVATE TYPES:
+      private
+!------------------------------------------------------------------------------
+!     ! ESMF_Fraction
+!
+      type ESMF_Fraction
+      private
+        integer :: n    ! Integer fraction (exact) n/d; numerator
+        integer :: d    ! Integer fraction (exact) n/d; denominator
+      end type
+!
+!------------------------------------------------------------------------------
+! !PUBLIC TYPES:
+      public ESMF_Fraction
+!------------------------------------------------------------------------------
+!
+! !PUBLIC MEMBER FUNCTIONS:
+
+! !PRIVATE MEMBER FUNCTIONS:
+
+!EOPI
+
+!==============================================================================
+
+!      contains
+
+!==============================================================================
+!
+! Wrappers to C++ fraction routines
+!
+!------------------------------------------------------------------------------
+!
+
+!------------------------------------------------------------------------------
+
+      end module ESMF_FractionMod
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Macros.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Macros.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Macros.inc	(revision 2744)
@@ -0,0 +1,35 @@
+#if 0
+
+Earth System Modeling Framework
+Copyright 2002-2003, University Corporation for Atmospheric Research,
+Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+Laboratory, University of Michigan, National Centers for Environmental
+Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+NASA Goddard Space Flight Center.
+Licensed under the GPL.
+
+Do not have C++ or F90 style comments in here because this file is processed
+by both C++ and F90 compilers.
+
+These lines prevent this file from being read more than once if it
+ends up being included multiple times.
+#endif
+
+#ifndef ESMF_MACROS_INC
+#define ESMF_MACROS_INC
+
+#if 0
+
+former file contents moved to ESMF_BaseMod
+so user code can be compiled without requiring
+the preprocessor.
+
+#endif 
+
+#if 0
+i left the following macro here in case it is needed for our internal use.
+#endif
+
+#define ESMF_SRCLINE __FILE__, __LINE__
+
+#endif 
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Mod.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Mod.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Mod.F90	(revision 2744)
@@ -0,0 +1,17 @@
+! TBH:  This version is for use with the ESMF library embedded in the WRF 
+! TBH:  distribution.  
+MODULE ESMF_Mod
+   USE esmf_alarmmod
+   USE esmf_basemod
+   USE esmf_basetimemod
+   USE esmf_calendarmod
+   USE esmf_clockmod
+   USE esmf_fractionmod
+   USE esmf_timeintervalmod
+   USE esmf_timemod
+   USE esmf_alarmclockmod
+   USE esmf_stubs   ! add new dummy interfaces and typedefs here as needed
+#include <ESMF_TimeMgr.inc>
+   INTEGER, PARAMETER :: ESMF_MAX_ALARMS=MAX_ALARMS
+!
+END MODULE ESMF_Mod
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Stubs.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Stubs.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Stubs.F90	(revision 2744)
@@ -0,0 +1,125 @@
+! Various dummy type definitions and routines for the sole purpose of 
+! mimicking newer ESMF interface features without necessarily implementing 
+! them.  
+
+MODULE ESMF_Stubs
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+! Bogus typedefs
+   TYPE ESMF_Grid
+      INTEGER :: dummy
+   END TYPE
+
+   TYPE ESMF_GridComp
+      INTEGER :: dummy
+   END TYPE
+
+   TYPE ESMF_State
+      INTEGER :: dummy
+   END TYPE
+
+   TYPE ESMF_VM
+      INTEGER :: dummy
+   END TYPE
+
+   TYPE ESMF_MsgType
+      INTEGER :: mtype
+   END TYPE
+   TYPE(ESMF_MsgType), PARAMETER  ::      &
+      ESMF_LOG_INFO  =   ESMF_MsgType(1), &
+      ESMF_LOG_WARNING = ESMF_MsgType(2), &
+      ESMF_LOG_ERROR =   ESMF_MsgType(3)
+
+   TYPE ESMF_LOG
+      INTEGER :: dummy
+   END TYPE
+
+   LOGICAL, private, save :: initialized = .false.
+
+   PUBLIC ESMF_Grid, ESMF_GridComp, ESMF_State, ESMF_VM
+   PUBLIC ESMF_Initialize, ESMF_Finalize, ESMF_IsInitialized
+   PUBLIC ESMF_LogWrite, ESMF_LOG, ESMF_MsgType
+   PUBLIC ESMF_LOG_INFO, ESMF_LOG_WARNING, ESMF_LOG_ERROR
+
+CONTAINS
+
+
+! NOOP
+   SUBROUTINE ESMF_Initialize( vm, defaultCalendar, rc )
+      USE esmf_basemod
+      USE esmf_calendarmod
+      TYPE(ESMF_VM),           INTENT(IN   ), OPTIONAL :: vm
+      TYPE(ESMF_CalendarType), INTENT(IN   ), OPTIONAL :: defaultCalendar
+      INTEGER,                 INTENT(  OUT), OPTIONAL :: rc
+
+      TYPE(ESMF_CalendarType) :: defaultCalType
+      INTEGER :: status
+
+      IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      ! Initialize the default time manager calendar
+      IF ( PRESENT(defaultCalendar) )THEN
+         defaultCalType = defaultCalendar
+      ELSE
+         defaultCalType = ESMF_CAL_NOLEAP
+      END IF
+      allocate( defaultCal )
+      defaultCal = ESMF_CalendarCreate( calendarType=defaultCalType, &
+                        rc=status)
+
+      ! initialize tables in time manager
+      CALL initdaym
+
+      IF (status .ne. ESMF_SUCCESS) THEN
+          PRINT *, "Error initializing the default time manager calendar"
+          RETURN
+      END IF
+      initialized = .true.
+
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+   END SUBROUTINE ESMF_Initialize
+
+
+   FUNCTION ESMF_IsInitialized()
+      LOGICAL ESMF_IsInitialized
+      ESMF_IsInitialized = initialized
+   END FUNCTION ESMF_IsInitialized
+
+
+! NOOP
+   SUBROUTINE ESMF_Finalize( rc )
+      USE esmf_basemod
+      INTEGER, INTENT(  OUT), OPTIONAL :: rc
+#if (defined SPMD) || (defined COUP_CSM)
+#include <mpif.h>
+#endif
+      INTEGER :: ier
+
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+#if (defined SPMD) || (defined COUP_CSM)
+      CALL MPI_Finalize( ier ) 
+      IF ( ier .ne. mpi_success )THEN
+        IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      END IF
+#endif
+   END SUBROUTINE ESMF_Finalize
+
+! NOOP
+   SUBROUTINE ESMF_LogWrite( msg, MsgType, line, file, method, log, rc )
+      USE esmf_basemod
+      CHARACTER(LEN=*), INTENT(IN) :: msg
+      TYPE(ESMF_MsgType), INTENT(IN) :: msgtype
+      INTEGER, INTENT(IN), OPTIONAL :: line
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: file
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: method
+      TYPE(ESMF_LOG),TARGET,OPTIONAL :: log
+      INTEGER, INTENT(OUT),OPTIONAL :: rc
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+   END SUBROUTINE ESMF_LogWrite
+
+
+END MODULE ESMF_Stubs
+
+
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Time.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Time.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_Time.F90	(revision 2744)
@@ -0,0 +1,1185 @@
+!
+! Earth System Modeling Framework
+! Copyright 2002-2003, University Corporation for Atmospheric Research,
+! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+! Laboratory, University of Michigan, National Centers for Environmental
+! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+! NASA Goddard Space Flight Center.
+! Licensed under the GPL.
+!
+!==============================================================================
+!
+!     ESMF Time Module
+      module ESMF_TimeMod
+!
+!==============================================================================
+!
+! This file contains the Time class definition and all Time class methods.
+!
+!------------------------------------------------------------------------------
+! INCLUDES
+#include <ESMF_TimeMgr.inc>
+
+!==============================================================================
+!BOPI
+! !MODULE: ESMF_TimeMod
+!
+! !DESCRIPTION:
+! Part of Time Manager F90 API wrapper of C++ implemenation
+!
+! Defines F90 wrapper entry points for corresponding
+! C++ class {\tt ESMC\_Time} implementation
+!
+! See {\tt ../include/ESMC\_Time.h} for complete description
+!
+!------------------------------------------------------------------------------
+! !USES:
+      ! inherit from ESMF base class
+      use ESMF_BaseMod
+
+      ! inherit from base time class
+      use ESMF_BaseTimeMod
+
+      ! associated derived types
+      use ESMF_TimeIntervalMod
+      use ESMF_CalendarMod
+      use ESMF_Stubs
+
+      implicit none
+!
+!------------------------------------------------------------------------------
+! !PRIVATE TYPES:
+      private
+!------------------------------------------------------------------------------
+!     ! ESMF_Time
+!
+!     ! F90 class type to match C++ Time class in size only;
+!     !  all dereferencing within class is performed by C++ implementation
+
+     type ESMF_Time
+       type(ESMF_BaseTime) :: basetime           ! inherit base class
+       ! time instant is expressed as year + basetime
+       integer :: YR
+       type(ESMF_Calendar), pointer :: calendar  ! associated calendar
+     end type
+
+!------------------------------------------------------------------------------
+! !PUBLIC TYPES:
+      public ESMF_Time
+!------------------------------------------------------------------------------
+!
+! !PUBLIC MEMBER FUNCTIONS:
+      public ESMF_TimeGet
+      public ESMF_TimeSet
+
+! Required inherited and overridden ESMF_Base class methods
+
+      public ESMF_TimeCopy
+
+! !PRIVATE MEMBER FUNCTIONS:
+
+      private ESMF_TimeGetDayOfYear
+      private ESMF_TimeGetDayOfYearInteger
+
+! Inherited and overloaded from ESMF_BaseTime
+
+      ! NOTE:  ESMF_TimeInc, ESMF_TimeDec, ESMF_TimeDiff, ESMF_TimeEQ, 
+      !        ESMF_TimeNE, ESMF_TimeLT, ESMF_TimeGT, ESMF_TimeLE, and 
+      !        ESMF_TimeGE are PUBLIC only to work around bugs in the 
+      !        PGI 5.1-x compilers.  They should all be PRIVATE.  
+
+      public operator(+)
+      public ESMF_TimeInc
+
+      public operator(-)
+      public ESMF_TimeDec
+      public ESMF_TimeDec2
+      public ESMF_TimeDiff
+
+      public operator(.EQ.)
+      public ESMF_TimeEQ
+
+      public operator(.NE.)
+      public ESMF_TimeNE
+
+      public operator(.LT.)
+      public ESMF_TimeLT
+
+      public operator(.GT.)
+      public ESMF_TimeGT
+
+      public operator(.LE.)
+      public ESMF_TimeLE
+
+      public operator(.GE.)
+      public ESMF_TimeGE
+
+!EOPI
+
+!==============================================================================
+!
+! INTERFACE BLOCKS
+!
+!==============================================================================
+!BOP
+! !INTERFACE:
+      interface ESMF_TimeGetDayOfYear
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeGetDayOfYearInteger
+
+! !DESCRIPTION:
+!     This interface overloads the {\tt ESMF\_GetDayOfYear} method
+!     for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(+)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeInc, ESMF_TimeInc2
+
+! !DESCRIPTION:
+!     This interface overloads the + operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface assignment (=)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeCopy
+
+! !DESCRIPTION:
+!     This interface overloads the = operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(-)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeDec, ESMF_TimeDec2
+
+! !DESCRIPTION:
+!     This interface overloads the - operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(-)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeDiff
+
+! !DESCRIPTION:
+!     This interface overloads the - operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.EQ.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeEQ
+
+! !DESCRIPTION:
+!     This interface overloads the .EQ. operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.NE.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeNE
+
+! !DESCRIPTION:
+!     This interface overloads the .NE. operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.LT.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeLT
+
+! !DESCRIPTION:
+!     This interface overloads the .LT. operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.GT.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeGT
+
+! !DESCRIPTION:
+!     This interface overloads the .GT. operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.LE.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeLE
+
+! !DESCRIPTION:
+!     This interface overloads the .LE. operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.GE.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeGE
+
+! !DESCRIPTION:
+!     This interface overloads the .GE. operator for the {\tt ESMF\_Time} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+
+!==============================================================================
+
+      contains
+
+!==============================================================================
+!
+! Generic Get/Set routines which use F90 optional arguments
+!
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeGet - Get value in user-specified units
+
+! !INTERFACE:
+      subroutine ESMF_TimeGet(time, YY, YRl, MM, DD, D, Dl, H, M, S, Sl, MS, &
+                              US, NS, d_, h_, m_, s_, ms_, us_, ns_, Sn, Sd, &
+                              dayOfYear, dayOfYear_r8, dayOfYear_intvl,      &
+                              timeString, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time
+      integer, intent(out), optional :: YY
+      integer(ESMF_KIND_I8), intent(out), optional :: YRl
+      integer, intent(out), optional :: MM
+      integer, intent(out), optional :: DD
+      integer, intent(out), optional :: D
+      integer(ESMF_KIND_I8), intent(out), optional :: Dl
+      integer, intent(out), optional :: H
+      integer, intent(out), optional :: M
+      integer, intent(out), optional :: S
+      integer(ESMF_KIND_I8), intent(out), optional :: Sl
+      integer, intent(out), optional :: MS
+      integer, intent(out), optional :: US
+      integer, intent(out), optional :: NS
+      double precision, intent(out), optional :: d_
+      double precision, intent(out), optional :: h_
+      double precision, intent(out), optional :: m_
+      double precision, intent(out), optional :: s_
+      double precision, intent(out), optional :: ms_
+      double precision, intent(out), optional :: us_
+      double precision, intent(out), optional :: ns_
+      integer, intent(out), optional :: Sn
+      integer, intent(out), optional :: Sd
+      integer, intent(out), optional :: dayOfYear
+      ! dayOfYear_r8 = 1.0 at 0Z on 1 January, 1.5 at 12Z on
+      ! 1 January, etc.
+      real(ESMF_KIND_R8), intent(out), optional :: dayOfYear_r8
+      character (len=*), intent(out), optional :: timeString
+      type(ESMF_TimeInterval), intent(out), optional :: dayOfYear_intvl
+      integer, intent(out), optional :: rc
+
+      type(ESMF_TimeInterval) :: day_step
+      integer :: ierr
+
+! !DESCRIPTION:
+!     Get the value of the {\tt ESMF\_Time} in units specified by the user
+!     via F90 optional arguments.
+!
+!     Time manager represents and manipulates time internally with integers
+!     to maintain precision. Hence, user-specified floating point values are
+!     converted internally from integers.
+!
+!     See {\tt ../include/ESMC\_BaseTime.h and ../include/ESMC\_Time.h} for
+!     complete description.
+!     
+!     The arguments are:
+!     \begin{description}
+!     \item[time]
+!          The object instance to query
+!     \item[{[YY]}]
+!          Integer year CCYR (>= 32-bit)
+!     \item[{[YRl]}]
+!          Integer year CCYR (large, >= 64-bit)
+!     \item[{[MM]}]
+!          Integer month 1-12
+!     \item[{[DD]}]
+!          Integer day of the month 1-31
+!     \item[{[D]}]
+!          Integer Julian days (>= 32-bit)
+!     \item[{[Dl]}]
+!          Integer Julian days (large, >= 64-bit)
+!     \item[{[H]}]
+!          Integer hours
+!     \item[{[M]}]
+!          Integer minutes
+!     \item[{[S]}]
+!          Integer seconds (>= 32-bit)
+!     \item[{[Sl]}]
+!          Integer seconds (large, >= 64-bit)
+!     \item[{[MS]}]
+!          Integer milliseconds
+!     \item[{[US]}]
+!          Integer microseconds
+!     \item[{[NS]}]
+!          Integer nanoseconds
+!     \item[{[d\_]}]
+!          Double precision days
+!     \item[{[h\_]}]
+!          Double precision hours
+!     \item[{[m\_]}]
+!          Double precision minutes
+!     \item[{[s\_]}]
+!          Double precision seconds
+!     \item[{[ms\_]}]
+!          Double precision milliseconds
+!     \item[{[us\_]}]
+!          Double precision microseconds
+!     \item[{[ns\_]}]
+!          Double precision nanoseconds
+!     \item[{[Sn]}]
+!          Integer fractional seconds - numerator
+!     \item[{[Sd]}]
+!          Integer fractional seconds - denominator
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG2.1, TMG2.5.1, TMG2.5.6
+!EOP
+      TYPE(ESMF_Time) :: begofyear
+      INTEGER :: year, month, dayofmonth, hour, minute, second
+      REAL(ESMF_KIND_R8) :: rsec
+
+      ierr = ESMF_SUCCESS
+
+      IF ( PRESENT( YY ) ) THEN
+        YY = time%YR
+      ENDIF
+      IF ( PRESENT( MM ) ) THEN
+        CALL timegetmonth( time, MM )
+      ENDIF
+      IF ( PRESENT( DD ) ) THEN
+        CALL timegetdayofmonth( time, DD )
+      ENDIF
+!
+!$$$ Push HMS down into ESMF_BaseTime from EVERYWHERE
+!$$$ and THEN add ESMF scaling behavior when other args are present...  
+      IF ( PRESENT( H ) ) THEN
+        H = mod( time%basetime%S, SECONDS_PER_DAY ) / SECONDS_PER_HOUR
+      ENDIF
+      IF ( PRESENT( M ) ) THEN
+        M = mod( time%basetime%S, SECONDS_PER_HOUR) / SECONDS_PER_MINUTE
+      ENDIF
+      IF ( PRESENT( S ) ) THEN
+        S = mod( time%basetime%S, SECONDS_PER_MINUTE )
+      ENDIF
+      ! TBH:  HACK to allow DD and S to behave as in ESMF 2.1.0+ when 
+      ! TBH:  both are present and H and M are not.  
+      IF ( PRESENT( S ) .AND. PRESENT( DD ) ) THEN
+        IF ( ( .NOT. PRESENT( H ) ) .AND. ( .NOT. PRESENT( M ) ) ) THEN
+          S = mod( time%basetime%S, SECONDS_PER_DAY )
+        ENDIF
+      ENDIF
+      IF ( PRESENT( MS ) ) THEN
+        IF ( time%basetime%Sd /= 0 ) THEN
+          MS = NINT( ( time%basetime%Sn*1.0D0 / time%basetime%Sd*1.0D0 ) * 1000.0D0 )
+        ELSE
+          MS = 0
+        ENDIF
+      ENDIF
+      IF ( PRESENT( Sd ) .AND. PRESENT( Sn ) ) THEN
+        Sd = time%basetime%Sd
+        Sn = time%basetime%Sn
+      ENDIF
+      IF ( PRESENT( dayOfYear ) ) THEN
+        CALL ESMF_TimeGetDayOfYear( time, dayOfYear, rc=ierr )
+      ENDIF
+      IF ( PRESENT( dayOfYear_r8 ) ) THEN
+        ! 64-bit IEEE 754 has 52-bit mantisssa -- only need 25 bits to hold 
+        ! number of seconds in a year...  
+        rsec = REAL( time%basetime%S, ESMF_KIND_R8 )
+        IF ( time%basetime%Sd /= 0 ) THEN
+          rsec = rsec + ( REAL( time%basetime%Sn, ESMF_KIND_R8 ) / &
+                          REAL( time%basetime%Sd, ESMF_KIND_R8 ) )
+        ENDIF
+        dayOfYear_r8 = rsec / REAL( SECONDS_PER_DAY, ESMF_KIND_R8 )
+        ! start at 1
+        dayOfYear_r8 = dayOfYear_r8 + 1.0_ESMF_KIND_R8
+      ENDIF
+      IF ( PRESENT( timeString ) ) THEN
+        ! This duplication for YMD is an optimization that avoids calling 
+        ! timegetmonth() and timegetdayofmonth() when it is not needed.  
+        year = time%YR
+        CALL timegetmonth( time, month )
+        CALL timegetdayofmonth( time, dayofmonth )
+!$$$ push HMS down into ESMF_BaseTime
+        hour = mod( time%basetime%S, SECONDS_PER_DAY ) / SECONDS_PER_HOUR
+        minute = mod( time%basetime%S, SECONDS_PER_HOUR) / SECONDS_PER_MINUTE
+        second = mod( time%basetime%S, SECONDS_PER_MINUTE )
+        CALL ESMFold_TimeGetString( year, month, dayofmonth, &
+                                    hour, minute, second, timeString )
+      ENDIF
+      IF ( PRESENT( dayOfYear_intvl ) ) THEN
+        year = time%YR
+        CALL ESMF_TimeSet( begofyear, yy=year, mm=1, dd=1, s=0, &
+                           calendar=time%calendar, rc=ierr )
+        IF ( ierr == ESMF_FAILURE)THEN
+           rc = ierr
+           RETURN
+        END IF
+        CALL ESMF_TimeIntervalSet( day_step, d=1, s=0, rc=ierr )
+        dayOfYear_intvl = time - begofyear + day_step
+      ENDIF
+
+      IF ( PRESENT( rc ) ) THEN
+        rc = ierr
+      ENDIF
+
+      end subroutine ESMF_TimeGet
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeSet - Initialize via user-specified unit set
+
+! !INTERFACE:
+      subroutine ESMF_TimeSet(time, YY, YRl, MM, DD, D, Dl, H, M, S, Sl, &
+                              MS, US, NS, d_, h_, m_, s_, ms_, us_, ns_, &
+                              Sn, Sd, calendar, rc)
+
+! !ARGUMENTS:
+      type(ESMF_Time), intent(inout) :: time
+      integer, intent(in), optional :: YY
+      integer(ESMF_KIND_I8), intent(in), optional :: YRl
+      integer, intent(in), optional :: MM
+      integer, intent(in), optional :: DD
+      integer, intent(in), optional :: D
+      integer(ESMF_KIND_I8), intent(in), optional :: Dl
+      integer, intent(in), optional :: H
+      integer, intent(in), optional :: M
+      integer, intent(in), optional :: S
+      integer(ESMF_KIND_I8), intent(in), optional :: Sl
+      integer, intent(in), optional :: MS
+      integer, intent(in), optional :: US
+      integer, intent(in), optional :: NS
+      double precision, intent(in), optional :: d_
+      double precision, intent(in), optional :: h_
+      double precision, intent(in), optional :: m_
+      double precision, intent(in), optional :: s_
+      double precision, intent(in), optional :: ms_
+      double precision, intent(in), optional :: us_
+      double precision, intent(in), optional :: ns_
+      integer, intent(in), optional :: Sn
+      integer, intent(in), optional :: Sd
+      type(ESMF_Calendar), intent(in), target, optional :: calendar
+      integer, intent(out), optional :: rc
+      ! locals
+      INTEGER :: ierr
+
+! !DESCRIPTION:
+!     Initializes a {\tt ESMF\_Time} with a set of user-specified units
+!     via F90 optional arguments.
+!
+!     Time manager represents and manipulates time internally with integers
+!     to maintain precision. Hence, user-specified floating point values are
+!     converted internally to integers.
+!
+!     See {\tt ../include/ESMC\_BaseTime.h and ../include/ESMC\_Time.h} for
+!     complete description.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time]
+!          The object instance to initialize
+!     \item[{[YY]}]
+!          Integer year CCYR (>= 32-bit)
+!     \item[{[YRl]}]
+!          Integer year CCYR (large, >= 64-bit)
+!     \item[{[MM]}]
+!          Integer month 1-12
+!     \item[{[DD]}]
+!          Integer day of the month 1-31
+!     \item[{[D]}]
+!          Integer Julian days (>= 32-bit)
+!     \item[{[Dl]}]
+!          Integer Julian days (large, >= 64-bit)
+!     \item[{[H]}]
+!          Integer hours
+!     \item[{[M]}]
+!          Integer minutes
+!     \item[{[S]}]
+!          Integer seconds (>= 32-bit)
+!     \item[{[Sl]}]
+!          Integer seconds (large, >= 64-bit)
+!     \item[{[MS]}]
+!          Integer milliseconds
+!     \item[{[US]}]
+!          Integer microseconds
+!     \item[{[NS]}]
+!          Integer nanoseconds
+!     \item[{[d\_]}]
+!          Double precision days
+!     \item[{[h\_]}]
+!          Double precision hours
+!     \item[{[m\_]}]
+!          Double precision minutes
+!     \item[{[s\_]}]
+!          Double precision seconds
+!     \item[{[ms\_]}]
+!          Double precision milliseconds
+!     \item[{[us\_]}]
+!          Double precision microseconds
+!     \item[{[ns\_]}]
+!          Double precision nanoseconds
+!     \item[{[Sn]}]
+!          Integer fractional seconds - numerator
+!     \item[{[Sd]}]
+!          Integer fractional seconds - denominator
+!     \item[{[cal]}]
+!          Associated {\tt Calendar}
+!     \item[{[tz]}]
+!          Associated timezone (hours offset from GMT, e.g. EST = -5)
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMGn.n.n
+!EOP
+!  PRINT *,'DEBUG:  BEGIN ESMF_TimeSet()'
+!$$$ push this down into ESMF_BaseTime constructor
+      time%basetime%S  = 0
+      time%basetime%Sn = 0
+      time%basetime%Sd = 0
+
+      IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+      time%YR = 0
+      IF ( PRESENT( YY ) ) THEN
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  YY = ',YY
+        time%YR = YY
+      ENDIF
+      IF ( PRESENT( MM ) ) THEN
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  MM = ',MM
+        CALL timeaddmonths( time, MM, ierr )
+        IF ( ierr == ESMF_FAILURE ) THEN
+          IF ( PRESENT( rc ) ) THEN
+            rc = ESMF_FAILURE
+            RETURN
+          ELSE
+            CALL wrf_error_fatal( 'ESMF_TimeSet:  MM out of range' )
+          ENDIF
+        ENDIF
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  back from timeaddmonths'
+      ENDIF
+      IF ( PRESENT( DD ) ) THEN
+!$$$ no check for DD in range of days of month MM yet
+!$$$ Must separate D and DD for correct interface!
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  DD = ',DD
+        time%basetime%S = time%basetime%S + &
+          ( SECONDS_PER_DAY * INT( (DD-1), ESMF_KIND_I8 ) )
+      ENDIF
+!$$$ push H,M,S,Sn,Sd,MS down into ESMF_BaseTime constructor
+      IF ( PRESENT( H ) ) THEN
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  H = ',H
+        time%basetime%S = time%basetime%S + &
+          ( SECONDS_PER_HOUR * INT( H, ESMF_KIND_I8 ) )
+      ENDIF
+      IF ( PRESENT( M ) ) THEN
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  M = ',M
+        time%basetime%S = time%basetime%S + &
+          ( SECONDS_PER_MINUTE * INT( M, ESMF_KIND_I8 ) )
+      ENDIF
+      IF ( PRESENT( S ) ) THEN
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  S = ',S
+        time%basetime%S = time%basetime%S + &
+          INT( S, ESMF_KIND_I8 )
+      ENDIF
+      IF ( PRESENT( Sn ) .AND. ( .NOT. PRESENT( Sd ) ) ) THEN
+        CALL wrf_error_fatal( &
+          "ESMF_TimeSet:  Must specify Sd if Sn is specified")
+      ENDIF
+      IF ( PRESENT( Sd ) .AND. PRESENT( MS ) ) THEN
+        CALL wrf_error_fatal( &
+          "ESMF_TimeSet:  Must not specify both Sd and MS")
+      ENDIF
+      time%basetime%Sn = 0
+      time%basetime%Sd = 0
+      IF ( PRESENT( MS ) ) THEN
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  MS = ',MS
+        time%basetime%Sn = MS
+        time%basetime%Sd = 1000_ESMF_KIND_I8
+      ELSE IF ( PRESENT( Sd ) ) THEN
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  Sd = ',Sd
+        time%basetime%Sd = Sd
+        IF ( PRESENT( Sn ) ) THEN
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  Sn = ',Sn
+          time%basetime%Sn = Sn
+        ENDIF
+      ENDIF
+      IF ( PRESENT(calendar) )THEN
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  using passed-in calendar'
+! Note that the ugly hack of wrapping the call to ESMF_CalendarInitialized() 
+! inside this #ifdef is due to lack of support for compile-time initialization 
+! of components of Fortran derived types.  Some older compilers like PGI 5.1-x 
+! do not support this F95 feature.  In this case we only lose a safety check.  
+#ifndef NO_DT_COMPONENT_INIT
+        IF ( .not. ESMF_CalendarInitialized( calendar ) )THEN
+           call wrf_error_fatal( "Error:: ESMF_CalendarCreate not "// &
+                                 "called on input Calendar")
+        END IF
+#endif
+        time%Calendar => calendar
+      ELSE
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  using default calendar'
+        IF ( .not. ESMF_IsInitialized() )THEN
+           call wrf_error_fatal( "Error:: ESMF_Initialize not called")
+        END IF
+        time%Calendar => defaultCal
+      END IF
+
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  calling normalize_time()'
+!$$$DEBUG
+!IF ( time%basetime%Sd > 0 ) THEN
+!  PRINT *,'DEBUG ESMF_TimeSet() before normalize:  S,Sn,Sd = ', &
+!    time%basetime%S, time%basetime%Sn, time%basetime%Sd
+!ENDIF
+!$$$END DEBUG
+      CALL normalize_time( time )
+!$$$DEBUG
+!IF ( time%basetime%Sd > 0 ) THEN
+!  PRINT *,'DEBUG ESMF_TimeSet() after normalize:  S,Sn,Sd = ', &
+!    time%basetime%S, time%basetime%Sn, time%basetime%Sd
+!ENDIF
+!$$$END DEBUG
+
+!  PRINT *,'DEBUG:  ESMF_TimeSet():  back from normalize_time()'
+      IF ( PRESENT( rc ) ) THEN
+        rc = ESMF_SUCCESS
+      ENDIF
+
+      end subroutine ESMF_TimeSet
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMFold_TimeGetString - Get time instant value in string format
+
+! !INTERFACE:
+      subroutine ESMFold_TimeGetString( year, month, dayofmonth, &
+                                        hour, minute, second, TimeString )
+
+! !ARGUMENTS:
+      integer, intent(in) :: year
+      integer, intent(in) :: month
+      integer, intent(in) :: dayofmonth
+      integer, intent(in) :: hour
+      integer, intent(in) :: minute
+      integer, intent(in) :: second
+      character*(*), intent(out) :: TimeString
+! !DESCRIPTION:
+!     Convert {\tt ESMF\_Time}'s value into ISO 8601 format YYYY-MM-DDThh:mm:ss
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time]
+!          The object instance to convert
+!     \item[TimeString]
+!          The string to return
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG2.4.7
+!EOP
+
+!PRINT *,'DEBUG:  ESMF_TimePrint():  YR,S,Sn,Sd = ',time%YR,time%basetime%S,time%basetime%Sn,time%basetime%Sd
+!PRINT *,'DEBUG:  ESMF_TimePrint():  year = ',year
+!PRINT *,'DEBUG:  ESMF_TimePrint():  month, dayofmonth = ',month,dayofmonth
+!PRINT *,'DEBUG:  ESMF_TimePrint():  hour = ',hour
+!PRINT *,'DEBUG:  ESMF_TimePrint():  minute = ',minute
+!PRINT *,'DEBUG:  ESMF_TimePrint():  second = ',second
+
+!$$$here...  add negative sign for YR<0
+!$$$here...  add Sn, Sd ??
+      write(TimeString,FMT="(I4.4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)") &
+             year,month,dayofmonth,hour,minute,second
+
+      end subroutine ESMFold_TimeGetString
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeGetDayOfYearInteger - Get time instant's day of the year as an integer value
+!
+! !INTERFACE:
+      subroutine ESMF_TimeGetDayOfYearInteger(time, DayOfYear, rc)
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time
+      integer, intent(out) :: DayOfYear
+      integer, intent(out), optional :: rc
+!
+! !DESCRIPTION:
+!     Get the day of the year the given {\tt ESMF\_Time} instant falls on
+!     (1-365).  Returned as an integer value
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time]
+!          The object instance to query
+!     \item[DayOfYear]
+!          The {\tt ESMF\_Time} instant's day of the year (1-365)
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!EOP
+      ! requires that time be normalized
+!$$$ bug when Sn>0?  test
+!$$$ add tests
+      DayOfYear = ( time%basetime%S / SECONDS_PER_DAY ) + 1
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+      end subroutine ESMF_TimeGetDayOfYearInteger
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeInc - Increment time instant with a time interval
+!
+! !INTERFACE:
+      function ESMF_TimeInc(time, timeinterval)
+!
+! !RETURN VALUE:
+      type(ESMF_Time) :: ESMF_TimeInc
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+! !LOCAL:
+      integer   :: rc
+!
+! !DESCRIPTION:
+!     Increment {\tt ESMF\_Time} instant with a {\tt ESMF\_TimeInterval},
+!     return resulting {\tt ESMF\_Time} instant
+!
+!     Maps overloaded (+) operator interface function to
+!     {\tt ESMF\_BaseTime} base class
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time]
+!          The given {\tt ESMF\_Time} to increment
+!     \item[timeinterval]
+!          The {\tt ESMF\_TimeInterval} to add to the given {\tt ESMF\_Time}
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
+!EOP
+
+      ! copy ESMF_Time specific properties (e.g. calendar, timezone) 
+      ESMF_TimeInc = time
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeSum(time, timeinterval, ESMF_TimeInc)
+
+      end function ESMF_TimeInc
+!
+! this is added for certain compilers that don't deal with commutativity
+!
+      function ESMF_TimeInc2(timeinterval, time)
+      type(ESMF_Time) :: ESMF_TimeInc2
+      type(ESMF_Time), intent(in) :: time
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+      ESMF_TimeInc2 = ESMF_TimeInc( time, timeinterval )
+      end function ESMF_TimeInc2
+!
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeDec - Decrement time instant with a time interval
+!
+! !INTERFACE:
+      function ESMF_TimeDec(time, timeinterval)
+!
+! !RETURN VALUE:
+      type(ESMF_Time) :: ESMF_TimeDec
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+! !LOCAL:
+      integer   :: rc
+!
+! !DESCRIPTION:
+!     Decrement {\tt ESMF\_Time} instant with a {\tt ESMF\_TimeInterval},
+!     return resulting {\tt ESMF\_Time} instant
+!
+!     Maps overloaded (-) operator interface function to
+!     {\tt ESMF\_BaseTime} base class
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time]
+!          The given {\tt ESMF\_Time} to decrement
+!     \item[timeinterval]
+!          The {\tt ESMF\_TimeInterval} to subtract from the given
+!          {\tt ESMF\_Time}
+!     \end{description}
+!     
+! !REQUIREMENTS:
+!     TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
+!EOP
+
+      ! copy ESMF_Time specific properties (e.g. calendar, timezone) 
+      ESMF_TimeDec = time
+
+      ! call ESMC_BaseTime base class function
+       call c_ESMC_BaseTimeDec(time, timeinterval, ESMF_TimeDec)
+
+      end function ESMF_TimeDec
+
+!
+! this is added for certain compilers that don't deal with commutativity
+!
+      function ESMF_TimeDec2(timeinterval, time)
+      type(ESMF_Time) :: ESMF_TimeDec2
+      type(ESMF_Time), intent(in) :: time
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+      ESMF_TimeDec2 = ESMF_TimeDec( time, timeinterval )
+      end function ESMF_TimeDec2
+!
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeDiff - Return the difference between two time instants
+!
+! !INTERFACE:
+      function ESMF_TimeDiff(time1, time2)
+!
+! !RETURN VALUE:
+      type(ESMF_TimeInterval) :: ESMF_TimeDiff
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+! !LOCAL:
+      integer :: rc
+
+! !DESCRIPTION:
+!     Return the {\tt ESMF\_TimeInterval} difference between two
+!     {\tt ESMF\_Time} instants
+!
+!     Maps overloaded (-) operator interface function to
+!     {\tt ESMF\_BaseTime} base class
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time1]
+!          The first {\tt ESMF\_Time} instant
+!     \item[time2]
+!          The second {\tt ESMF\_Time} instant
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
+!EOP
+
+      ! call ESMC_BaseTime base class function
+      CALL ESMF_TimeIntervalSet( ESMF_TimeDiff, rc=rc )
+      call c_ESMC_BaseTimeDiff(time1, time2, ESMF_TimeDiff)
+
+      end function ESMF_TimeDiff
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeEQ - Compare two times for equality
+!
+! !INTERFACE:
+      function ESMF_TimeEQ(time1, time2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeEQ
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+!
+! !DESCRIPTION:
+!     Return true if both given {\tt ESMF\_Time} instants are equal, false
+!     otherwise.  Maps overloaded (==) operator interface function to
+!     {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time1]
+!          First time instant to compare
+!     \item[time2]
+!          Second time instant to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+
+      ! invoke C to C++ entry point for ESMF_BaseTime base class function
+      call c_ESMC_BaseTimeEQ(time1, time2, ESMF_TimeEQ)
+
+      end function ESMF_TimeEQ
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeNE - Compare two times for non-equality
+!
+! !INTERFACE:
+      function ESMF_TimeNE(time1, time2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeNE
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+
+! !DESCRIPTION:
+!     Return true if both given {\tt ESMF\_Time} instants are not equal, false
+!     otherwise.  Maps overloaded (/=) operator interface function to
+!     {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time1]
+!          First time instant to compare
+!     \item[time2]
+!          Second time instant to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeNE(time1, time2, ESMF_TimeNE)
+
+      end function ESMF_TimeNE
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeLT - Time instant 1 less than time instant 2 ?
+!
+! !INTERFACE:
+      function ESMF_TimeLT(time1, time2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeLT
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+!
+! !DESCRIPTION:
+!     Return true if first {\tt ESMF\_Time} instant is less than second
+!     {\tt ESMF\_Time} instant, false otherwise.  Maps overloaded (<)
+!     operator interface function to {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time1]
+!          First time instant to compare
+!     \item[time2]
+!          Second time instant to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeLT(time1, time2, ESMF_TimeLT)
+
+      end function ESMF_TimeLT
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeGT - Time instant 1 greater than time instant 2 ?
+!
+! !INTERFACE:
+      function ESMF_TimeGT(time1, time2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeGT
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+!
+! !DESCRIPTION:
+!     Return true if first {\tt ESMF\_Time} instant is greater than second
+!     {\tt ESMF\_Time} instant, false otherwise.  Maps overloaded (>) operator
+!     interface function to {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time1]
+!          First time instant to compare
+!     \item[time2]
+!          Second time instant to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeGT(time1, time2, ESMF_TimeGT)
+
+      end function ESMF_TimeGT
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeLE - Time instant 1 less than or equal to time instant 2 ?
+!
+! !INTERFACE:
+      function ESMF_TimeLE(time1, time2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeLE
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+!
+! !DESCRIPTION:
+!     Return true if first {\tt ESMF\_Time} instant is less than or equal to
+!     second {\tt ESMF\_Time} instant, false otherwise.  Maps overloaded (<=)
+!     operator interface function to {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time1]
+!          First time instant to compare
+!     \item[time2]
+!          Second time instant to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeLE(time1, time2, ESMF_TimeLE)
+
+      end function ESMF_TimeLE
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeGE - Time instant 1 greater than or equal to time instant 2 ?
+!
+! !INTERFACE:
+      function ESMF_TimeGE(time1, time2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeGE
+!
+! !ARGUMENTS:
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+!
+! !DESCRIPTION:
+!     Return true if first {\tt ESMF\_Time} instant is greater than or equal to
+!     second {\tt ESMF\_Time} instant, false otherwise.  Maps overloaded (>=)
+!     operator interface function to {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[time1]
+!          First time instant to compare
+!     \item[time2]
+!          Second time instant to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeGE(time1, time2, ESMF_TimeGE)
+
+      end function ESMF_TimeGE
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeCopy - Copy a time-instance
+
+! !INTERFACE:
+      subroutine ESMF_TimeCopy(timeout, timein)
+
+! !ARGUMENTS:
+      type(ESMF_Time), intent(out) :: timeout
+      type(ESMF_Time), intent(in) :: timein
+
+! !DESCRIPTION:
+!     Copy a time-instance to a new instance.
+!
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMGn.n.n
+!EOP
+   
+      timeout%basetime = timein%basetime
+      timeout%YR       = timein%YR
+      timeout%Calendar => timein%Calendar
+
+      end subroutine ESMF_TimeCopy
+
+      end module ESMF_TimeMod
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_TimeInterval.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_TimeInterval.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_TimeInterval.F90	(revision 2744)
@@ -0,0 +1,1259 @@
+!
+! Earth System Modeling Framework
+! Copyright 2002-2003, University Corporation for Atmospheric Research,
+! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+! Laboratory, University of Michigan, National Centers for Environmental
+! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+! NASA Goddard Space Flight Center.
+! Licensed under the GPL.
+!
+!==============================================================================
+!
+!     ESMF TimeInterval Module
+      module ESMF_TimeIntervalMod
+!
+!==============================================================================
+!
+! This file contains the TimeInterval class definition and all TimeInterval
+! class methods.
+!
+!------------------------------------------------------------------------------
+! INCLUDES
+#include <ESMF_TimeMgr.inc>
+!
+!===============================================================================
+!BOPI
+! !MODULE: ESMF_TimeIntervalMod
+!
+! !DESCRIPTION:
+! Part of Time Manager F90 API wrapper of C++ implemenation
+!
+! Defines F90 wrapper entry points for corresponding
+! C++ implementaion of class {\tt ESMC\_TimeInterval}
+!
+! See {\tt ../include/ESMC\_TimeInterval.h} for complete description
+!
+!------------------------------------------------------------------------------
+! !USES:
+      ! inherit from ESMF base class
+      use ESMF_BaseMod
+
+      ! inherit from base time class
+      use ESMF_BaseTimeMod
+
+      ! associated derived types
+      use ESMF_FractionMod, only : ESMF_Fraction
+      use ESMF_CalendarMod
+
+      implicit none
+!
+!------------------------------------------------------------------------------
+! !PRIVATE TYPES:
+      private
+!------------------------------------------------------------------------------
+!     ! ESMF_TimeInterval
+!
+!     ! F90 class type to match C++ TimeInterval class in size only;
+!     !  all dereferencing within class is performed by C++ implementation
+
+      type ESMF_TimeInterval
+        ! time interval is expressed as basetime
+        type(ESMF_BaseTime) :: basetime  ! inherit base class
+        ! Relative year and month fields support monthly or yearly time 
+        ! intervals.  Many operations are undefined when these fields are 
+        ! non-zero!  
+        INTEGER :: YR                    ! relative year
+        INTEGER :: MM                    ! relative month
+      end type
+
+!------------------------------------------------------------------------------
+! !PUBLIC TYPES:
+      public ESMF_TimeInterval
+!------------------------------------------------------------------------------
+!
+! !PUBLIC MEMBER FUNCTIONS:
+      public ESMF_TimeIntervalGet
+      public ESMF_TimeIntervalSet
+      public ESMFold_TimeIntervalGetString
+      public ESMF_TimeIntervalAbsValue
+      public ESMF_TimeIntervalNegAbsValue
+
+! Required inherited and overridden ESMF_Base class methods
+
+!!!!!!!!! added 20051012, JM
+!      public WRFADDITION_TimeIntervalDIVQuot 
+!!!!!!!!! renamed to simplify testing 20060320, TH
+      public ESMF_TimeIntervalDIVQuot 
+
+      ! This convenience routine is only used by other modules in 
+      ! esmf_time_f90.  
+      public ESMF_TimeIntervalIsPositive
+
+
+! !PRIVATE MEMBER FUNCTIONS:
+ 
+! overloaded operator functions
+ 
+      public operator(/)
+      private ESMF_TimeIntervalQuotI
+
+      public operator(*)
+      private ESMF_TimeIntervalProdI
+
+! Inherited and overloaded from ESMF_BaseTime
+
+      public operator(+)
+      private ESMF_TimeIntervalSum
+
+      public operator(-)
+      private ESMF_TimeIntervalDiff
+
+      public operator(.EQ.)
+      private ESMF_TimeIntervalEQ
+
+      public operator(.NE.)
+      private ESMF_TimeIntervalNE
+
+      public operator(.LT.)
+      private ESMF_TimeIntervalLT
+
+      public operator(.GT.)
+      private ESMF_TimeIntervalGT
+
+      public operator(.LE.)
+      private ESMF_TimeIntervalLE
+
+      public operator(.GE.)
+      private ESMF_TimeIntervalGE
+!EOPI
+
+!==============================================================================
+!
+! INTERFACE BLOCKS
+!
+!==============================================================================
+!BOP
+! !INTERFACE:
+      interface operator(*)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalProdI
+
+! !DESCRIPTION:
+!     This interface overloads the * operator for the {\tt ESMF\_TimeInterval}
+!     class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(/)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalQuotI
+
+! !DESCRIPTION:
+!     This interface overloads the / operator for the
+!     {\tt ESMF\_TimeInterval} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(+)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalSum
+
+! !DESCRIPTION:
+!     This interface overloads the + operator for the
+!     {\tt ESMF\_TimeInterval} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(-)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalDiff
+
+! !DESCRIPTION:
+!     This interface overloads the - operator for the
+!     {\tt ESMF\_TimeInterval} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.EQ.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalEQ
+
+! !DESCRIPTION:
+!     This interface overloads the .EQ. operator for the
+!     {\tt ESMF\_TimeInterval} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.NE.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalNE
+
+! !DESCRIPTION:
+!     This interface overloads the .NE. operator for the
+!     {\tt ESMF\_TimeInterval} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.LT.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalLT
+
+! !DESCRIPTION:
+!     This interface overloads the .LT. operator for the
+!     {\tt ESMF\_TimeInterval} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.GT.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalGT
+
+! !DESCRIPTION:
+!     This interface overloads the .GT. operator for the
+!     {\tt ESMF\_TimeInterval} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.LE.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalLE
+
+! !DESCRIPTION:
+!     This interface overloads the .LE. operator for the
+!     {\tt ESMF\_TimeInterval} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+!BOP
+! !INTERFACE:
+      interface operator(.GE.)
+
+! !PRIVATE MEMBER FUNCTIONS:
+      module procedure ESMF_TimeIntervalGE
+
+! !DESCRIPTION:
+!     This interface overloads the .GE. operator for the
+!     {\tt ESMF\_TimeInterval} class
+!
+!EOP
+      end interface
+!
+!------------------------------------------------------------------------------
+
+!==============================================================================
+
+      contains
+
+!==============================================================================
+!
+! Generic Get/Set routines which use F90 optional arguments
+!
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeIntervalGet - Get value in user-specified units
+
+! !INTERFACE:
+      subroutine ESMF_TimeIntervalGet(timeinterval, D, d_r8, S, Sn, Sd, &
+                                      TimeString, rc )
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+      integer, intent(out), optional :: D
+      real(ESMF_KIND_R8),      intent(out), optional :: d_r8
+      integer, intent(out), optional :: S
+      integer, intent(out), optional :: Sn
+      integer, intent(out), optional :: Sd
+      character*(*), optional, intent(out) :: TimeString
+      integer, intent(out), optional :: rc
+
+
+! !DESCRIPTION:
+!     Get the value of the {\tt ESMF\_TimeInterval} in units specified by the
+!     user via F90 optional arguments.
+!
+!     Time manager represents and manipulates time internally with integers 
+!     to maintain precision.  Hence, user-specified floating point values are
+!     converted internally from integers.
+!
+!     See {\tt ../include/ESMC\_BaseTime.h} and
+!     {\tt ../include/ESMC\_TimeInterval.h} for complete description.
+!     
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval]
+!          The object instance to query
+!     \item[{[YY]}]
+!          Integer years (>= 32-bit)
+!     \item[{[YYl]}]
+!          Integer years (large, >= 64-bit)
+!     \item[{[MO]}]
+!          Integer months (>= 32-bit)
+!     \item[{[MOl]}]
+!          Integer months (large, >= 64-bit)
+!     \item[{[D]}]
+!          Integer days (>= 32-bit)
+!     \item[{[Dl]}]
+!          Integer days (large, >= 64-bit)
+!     \item[{[H]}]
+!          Integer hours
+!     \item[{[M]}]
+!          Integer minutes
+!     \item[{[S]}]
+!          Integer seconds (>= 32-bit)
+!     \item[{[Sl]}]
+!          Integer seconds (large, >= 64-bit)
+!     \item[{[MS]}]
+!          Integer milliseconds
+!     \item[{[US]}]
+!          Integer microseconds
+!     \item[{[NS]}]
+!          Integer nanoseconds
+!     \item[{[d\_]}]
+!          Double precision days
+!     \item[{[h\_]}]
+!          Double precision hours
+!     \item[{[m\_]}]
+!          Double precision minutes
+!     \item[{[s\_]}]
+!          Double precision seconds
+!     \item[{[ms\_]}]
+!          Double precision milliseconds
+!     \item[{[us\_]}]
+!          Double precision microseconds
+!     \item[{[ns\_]}]
+!          Double precision nanoseconds
+!     \item[{[Sn]}]
+!          Integer fractional seconds - numerator
+!     \item[{[Sd]}]
+!          Integer fractional seconds - denominator
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.1
+!EOP
+      INTEGER(ESMF_KIND_I8) :: seconds
+      INTEGER :: ierr
+
+      ierr = ESMF_SUCCESS
+      seconds = timeinterval%basetime%S
+      ! note that S is overwritten below (if present) if other args are also 
+      ! present
+      IF ( PRESENT(S) ) S = seconds
+      IF ( PRESENT( D ) ) THEN
+        D = seconds / SECONDS_PER_DAY
+        IF ( PRESENT(S) ) S = MOD( seconds, SECONDS_PER_DAY )
+      ENDIF
+      IF ( PRESENT( d_r8 ) ) THEN
+        D_r8 = REAL( seconds, ESMF_KIND_R8 ) / &
+               REAL( SECONDS_PER_DAY, ESMF_KIND_R8 )
+        IF ( PRESENT(S) ) S = MOD( seconds, SECONDS_PER_DAY )
+      ENDIF
+      IF ( PRESENT(Sn) ) THEN
+        Sn = timeinterval%basetime%Sn
+      ENDIF
+      IF ( PRESENT(Sd) ) THEN
+        Sd = timeinterval%basetime%Sd
+      ENDIF
+      IF ( PRESENT( timeString ) ) THEN
+        CALL ESMFold_TimeIntervalGetString( timeinterval, timeString, rc=ierr )
+      ENDIF
+      IF ( PRESENT(rc) ) rc = ierr
+    
+      end subroutine ESMF_TimeIntervalGet
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeIntervalSet - Initialize via user-specified unit set
+
+! !INTERFACE:
+      subroutine ESMF_TimeIntervalSet(timeinterval, YY, YYl, MM, MOl, D, Dl, &
+                                      H, M, S, Sl, MS, US, NS, &
+                                      d_, h_, m_, s_, ms_, us_, ns_, &
+                                      Sn, Sd, rc)
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(out) :: timeinterval
+      integer, intent(in), optional :: YY
+      integer(ESMF_KIND_I8), intent(in), optional :: YYl
+      integer, intent(in), optional :: MM
+      integer(ESMF_KIND_I8), intent(in), optional :: MOl
+      integer, intent(in), optional :: D
+      integer(ESMF_KIND_I8), intent(in), optional :: Dl
+      integer, intent(in), optional :: H
+      integer, intent(in), optional :: M
+      integer, intent(in), optional :: S
+      integer(ESMF_KIND_I8), intent(in), optional :: Sl
+      integer, intent(in), optional :: MS
+      integer, intent(in), optional :: US
+      integer, intent(in), optional :: NS
+      double precision, intent(in), optional :: d_
+      double precision, intent(in), optional :: h_
+      double precision, intent(in), optional :: m_
+      double precision, intent(in), optional :: s_
+      double precision, intent(in), optional :: ms_
+      double precision, intent(in), optional :: us_
+      double precision, intent(in), optional :: ns_
+      integer, intent(in), optional :: Sn
+      integer, intent(in), optional :: Sd
+      integer, intent(out), optional :: rc
+      ! locals
+      INTEGER :: nfeb
+
+! !DESCRIPTION:
+!     Set the value of the {\tt ESMF\_TimeInterval} in units specified by
+!     the user via F90 optional arguments
+!
+!     Time manager represents and manipulates time internally with integers 
+!     to maintain precision.  Hence, user-specified floating point values are
+!     converted internally to integers.
+!
+!     See {\tt ../include/ESMC\_BaseTime.h} and
+!     {\tt ../include/ESMC\_TimeInterval.h} for complete description.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval]
+!          The object instance to initialize
+!     \item[{[YY]}]
+!          Integer number of interval years (>= 32-bit)
+!     \item[{[YYl]}]
+!          Integer number of interval years (large, >= 64-bit)
+!     \item[{[MM]}]
+!          Integer number of interval months (>= 32-bit)
+!     \item[{[MOl]}]
+!          Integer number of interval months (large, >= 64-bit)
+!     \item[{[D]}]
+!          Integer number of interval days (>= 32-bit)
+!     \item[{[Dl]}]
+!          Integer number of interval days (large, >= 64-bit)
+!     \item[{[H]}]
+!          Integer hours
+!     \item[{[M]}]
+!          Integer minutes
+!     \item[{[S]}]
+!          Integer seconds (>= 32-bit)
+!     \item[{[Sl]}]
+!          Integer seconds (large, >= 64-bit)
+!     \item[{[MS]}]
+!          Integer milliseconds
+!     \item[{[US]}]
+!          Integer microseconds
+!     \item[{[NS]}]
+!          Integer nanoseconds
+!     \item[{[d\_]}]
+!          Double precision days
+!     \item[{[h\_]}]
+!          Double precision hours
+!     \item[{[m\_]}]
+!          Double precision minutes
+!     \item[{[s\_]}]
+!          Double precision seconds
+!     \item[{[ms\_]}]
+!          Double precision milliseconds
+!     \item[{[us\_]}]
+!          Double precision microseconds
+!     \item[{[ns\_]}]
+!          Double precision nanoseconds
+!     \item[{[Sn]}]
+!          Integer fractional seconds - numerator
+!     \item[{[Sd]}]
+!          Integer fractional seconds - denominator
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMGn.n.n
+!EOP
+
+      IF ( PRESENT(rc) ) rc = ESMF_FAILURE
+      ! note that YR and MM are relative
+      timeinterval%YR = 0
+      IF ( PRESENT( YY ) ) THEN
+        timeinterval%YR = YY
+      ENDIF
+      timeinterval%MM = 0
+      IF ( PRESENT( MM ) ) THEN
+        timeinterval%MM = MM
+      ENDIF
+      ! Rollover months to years
+      IF      ( abs(timeinterval%MM) .GE. MONTHS_PER_YEAR ) THEN
+        timeinterval%YR = timeinterval%YR + timeinterval%MM/MONTHS_PER_YEAR
+        timeinterval%MM = mod(timeinterval%MM,MONTHS_PER_YEAR)
+      ENDIF
+
+      timeinterval%basetime%S = 0
+      ! For 365-day calendar, immediately convert years to days since we know 
+      ! how to do it in this case.  
+!$$$ replace this hack with something saner...
+      IF ( nfeb( 2004 ) == 28 ) THEN
+        timeinterval%basetime%S = timeinterval%basetime%S + &
+          ( 365_ESMF_KIND_I8 * &
+            INT( timeinterval%YR, ESMF_KIND_I8 ) * SECONDS_PER_DAY )
+        timeinterval%YR = 0
+      ENDIF
+      IF ( PRESENT( D ) ) THEN
+        timeinterval%basetime%S = timeinterval%basetime%S + &
+          ( SECONDS_PER_DAY * INT( D, ESMF_KIND_I8 ) )
+      ENDIF
+!$$$ Push H,M,S,Sn,Sd,MS down into BaseTime constructor from EVERYWHERE
+!$$$ and THEN add ESMF scaling behavior when other args are present...  
+      IF ( PRESENT( H ) ) THEN
+        timeinterval%basetime%S = timeinterval%basetime%S + &
+          ( SECONDS_PER_HOUR * INT( H, ESMF_KIND_I8 ) )
+      ENDIF
+      IF ( PRESENT( M ) ) THEN
+        timeinterval%basetime%S = timeinterval%basetime%S + &
+          ( SECONDS_PER_MINUTE * INT( M, ESMF_KIND_I8 ) )
+      ENDIF
+      IF ( PRESENT( S ) ) THEN
+        timeinterval%basetime%S = timeinterval%basetime%S + &
+          INT( S, ESMF_KIND_I8 )
+      ENDIF
+      IF ( PRESENT( Sn ) .AND. ( .NOT. PRESENT( Sd ) ) ) THEN
+        CALL wrf_error_fatal( &
+          "ESMF_TimeIntervalSet:  Must specify Sd if Sn is specified")
+      ENDIF
+      IF ( PRESENT( Sd ) .AND. PRESENT( MS ) ) THEN
+        CALL wrf_error_fatal( &
+          "ESMF_TimeIntervalSet:  Must not specify both Sd and MS")
+      ENDIF
+      timeinterval%basetime%Sn = 0
+      timeinterval%basetime%Sd = 0
+      IF ( PRESENT( MS ) ) THEN
+        timeinterval%basetime%Sn = MS
+        timeinterval%basetime%Sd = 1000_ESMF_KIND_I8
+      ELSE IF ( PRESENT( Sd ) ) THEN
+        timeinterval%basetime%Sd = Sd
+        IF ( PRESENT( Sn ) ) THEN
+          timeinterval%basetime%Sn = Sn
+        ENDIF
+      ENDIF
+      CALL normalize_timeint( timeinterval )
+
+      IF ( PRESENT(rc) ) rc = ESMF_SUCCESS
+
+      end subroutine ESMF_TimeIntervalSet
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMFold_TimeIntervalGetString - Get time interval value in string format
+
+! !INTERFACE:
+      subroutine ESMFold_TimeIntervalGetString(timeinterval, TimeString, rc)
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+      character*(*),  intent(out) :: TimeString
+      integer, intent(out), optional :: rc
+      ! locals
+      integer :: signnormtimeint
+      LOGICAL :: negative
+      INTEGER(ESMF_KIND_I8) :: iS, iSn, iSd, H, M, S
+      character (len=1) :: signstr
+
+! !DESCRIPTION:
+!     Convert {\tt ESMF\_TimeInterval}'s value into string format
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval]
+!          The object instance to convert
+!     \item[TimeString]
+!          The string to return
+!     \item[{[rc]}]
+!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.9
+!EOP
+
+! NOTE:  YR, MM, Sn, and Sd are not yet included in the returned string...  
+!PRINT *,'DEBUG ESMFold_TimeIntervalGetString():  YR,MM,S,Sn,Sd = ', &
+!        timeinterval%YR, &
+!        timeinterval%MM, &
+!        timeinterval%basetime%S, &
+!        timeinterval%basetime%Sn, &
+!        timeinterval%basetime%Sd
+
+      negative = ( signnormtimeint( timeInterval ) == -1 )
+      IF ( negative ) THEN
+        iS = -timeinterval%basetime%S
+        iSn = -timeinterval%basetime%Sn
+        signstr = '-'
+      ELSE
+        iS = timeinterval%basetime%S
+        iSn = timeinterval%basetime%Sn
+        signstr = ''
+      ENDIF 
+      iSd = timeinterval%basetime%Sd
+
+      H = mod( iS, SECONDS_PER_DAY ) / SECONDS_PER_HOUR
+      M = mod( iS, SECONDS_PER_HOUR) / SECONDS_PER_MINUTE
+      S = mod( iS, SECONDS_PER_MINUTE )
+
+!$$$here...  need to print Sn and Sd when they are used ???
+
+      write(TimeString,FMT="(A,I10.10,'_',I3.3,':',I3.3,':',I3.3)") &
+        TRIM(signstr), ( iS / SECONDS_PER_DAY ), H, M, S
+
+!write(0,*)'TimeIntervalGetString Sn ',timeinterval%basetime%Sn,' Sd ',timeinterval%basetime%Sd
+
+      rc = ESMF_SUCCESS
+
+      end subroutine ESMFold_TimeIntervalGetString
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalAbsValue - Get the absolute value of a time interval
+
+! !INTERFACE:
+      function ESMF_TimeIntervalAbsValue(timeinterval)
+
+! !RETURN VALUE:
+      type(ESMF_TimeInterval) :: ESMF_TimeIntervalAbsValue
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+! !LOCAL:
+      integer    :: rc
+
+! !DESCRIPTION:
+!     Return a {\tt ESMF\_TimeInterval}'s absolute value.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval]
+!          The object instance to take the absolute value of.
+!          Absolute value returned as value of function.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.8
+!EOP
+      CALL timeintchecknormalized( timeinterval, 'ESMF_TimeIntervalAbsValue arg1' )
+      ESMF_TimeIntervalAbsValue = timeinterval
+!$$$here...  move implementation into BaseTime
+      ESMF_TimeIntervalAbsValue%basetime%S  = &
+        abs(ESMF_TimeIntervalAbsValue%basetime%S)
+      ESMF_TimeIntervalAbsValue%basetime%Sn = &
+        abs(ESMF_TimeIntervalAbsValue%basetime%Sn )
+
+      end function ESMF_TimeIntervalAbsValue
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalNegAbsValue - Get the negative absolute value of a time interval
+
+! !INTERFACE:
+      function ESMF_TimeIntervalNegAbsValue(timeinterval)
+
+! !RETURN VALUE:
+      type(ESMF_TimeInterval) :: ESMF_TimeIntervalNegAbsValue
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+! !LOCAL:
+      integer    :: rc
+
+! !DESCRIPTION:
+!     Return a {\tt ESMF\_TimeInterval}'s negative absolute value.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval]
+!          The object instance to take the negative absolute value of.
+!          Negative absolute value returned as value of function.
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.8
+!EOP
+      CALL timeintchecknormalized( timeinterval, 'ESMF_TimeIntervalNegAbsValue arg1' )
+    
+      ESMF_TimeIntervalNegAbsValue = timeinterval
+!$$$here...  move implementation into BaseTime
+      ESMF_TimeIntervalNegAbsValue%basetime%S  = &
+        -abs(ESMF_TimeIntervalNegAbsValue%basetime%S)
+      ESMF_TimeIntervalNegAbsValue%basetime%Sn = &
+        -abs(ESMF_TimeIntervalNegAbsValue%basetime%Sn )
+
+      end function ESMF_TimeIntervalNegAbsValue
+
+!------------------------------------------------------------------------------
+!
+! This section includes overloaded operators defined only for TimeInterval
+! (not inherited from BaseTime)
+! Note:  these functions do not have a return code, since F90 forbids more
+! than 2 arguments for arithmetic overloaded operators
+!
+!------------------------------------------------------------------------------
+
+!!!!!!!!!!!!!!!!!! added jm 20051012
+! new WRF-specific function, Divide two time intervals and return the whole integer, without remainder
+      function ESMF_TimeIntervalDIVQuot(timeinterval1, timeinterval2)
+
+! !RETURN VALUE:
+      INTEGER :: ESMF_TimeIntervalDIVQuot 
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+
+! !LOCAL
+      INTEGER :: retval, isgn, rc
+      type(ESMF_TimeInterval) :: zero, i1,i2
+
+! !DESCRIPTION:
+!     Returns timeinterval1 divided by timeinterval2 as a fraction quotient.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          The dividend
+!     \item[timeinterval2]
+!          The divisor
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.5
+!EOP
+
+      CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalDIVQuot arg1' )
+      CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalDIVQuot arg2' )
+
+      call ESMF_TimeIntervalSet( zero, rc=rc )
+      i1 = timeinterval1
+      i2 = timeinterval2
+      isgn = 1
+      if ( i1 .LT. zero ) then
+        i1 = ESMF_TimeIntervalProdI(i1, -1)
+        isgn = -isgn
+      endif
+      if ( i2 .LT. zero ) then
+        i2 = ESMF_TimeIntervalProdI(i2, -1)
+        isgn = -isgn
+      endif
+! repeated subtraction
+      retval = 0
+      DO WHILE (  i1 .GE. i2 )
+        i1 = i1 - i2
+        retval = retval + 1
+      ENDDO
+      retval = retval * isgn
+
+      ESMF_TimeIntervalDIVQuot = retval
+
+      end function ESMF_TimeIntervalDIVQuot
+!!!!!!!!!!!!!!!!!!
+
+
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalQuotI - Divide time interval by an integer, return time interval result 
+
+! !INTERFACE:
+      function ESMF_TimeIntervalQuotI(timeinterval, divisor)
+
+! !RETURN VALUE:
+      type(ESMF_TimeInterval) :: ESMF_TimeIntervalQuotI
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+      integer, intent(in) :: divisor
+
+! !DESCRIPTION:
+!     Divides a {\tt ESMF\_TimeInterval} by an integer divisor, returns
+!     quotient as a {\tt ESMF\_TimeInterval}
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval]
+!          The dividend
+!     \item[divisor]
+!          Integer divisor
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.6, TMG5.3, TMG7.2
+!EOP
+
+!PRINT *,'DEBUG ESMF_TimeIntervalQuotI() A:  S,Sn,Sd = ', &
+!  timeinterval%basetime%S,timeinterval%basetime%Sn,timeinterval%basetime%Sd
+!PRINT *,'DEBUG ESMF_TimeIntervalQuotI() A:  divisor = ', divisor
+
+      CALL timeintchecknormalized( timeinterval, 'ESMF_TimeIntervalQuotI arg1' )
+
+      IF ( divisor == 0 ) THEN
+        CALL wrf_error_fatal( 'ESMF_TimeIntervalQuotI:  divide by zero' )
+      ENDIF
+      ESMF_TimeIntervalQuotI = timeinterval
+!PRINT *,'DEBUG ESMF_TimeIntervalQuotI() B:  S,Sn,Sd = ', &
+!  ESMF_TimeIntervalQuotI%basetime%S,ESMF_TimeIntervalQuotI%basetime%Sn,ESMF_TimeIntervalQuotI%basetime%Sd
+      ESMF_TimeIntervalQuotI%basetime = &
+        timeinterval%basetime / divisor
+!PRINT *,'DEBUG ESMF_TimeIntervalQuotI() C:  S,Sn,Sd = ', &
+!  ESMF_TimeIntervalQuotI%basetime%S,ESMF_TimeIntervalQuotI%basetime%Sn,ESMF_TimeIntervalQuotI%basetime%Sd
+
+      CALL normalize_timeint( ESMF_TimeIntervalQuotI )
+!PRINT *,'DEBUG ESMF_TimeIntervalQuotI() D:  S,Sn,Sd = ', &
+!  ESMF_TimeIntervalQuotI%basetime%S,ESMF_TimeIntervalQuotI%basetime%Sn,ESMF_TimeIntervalQuotI%basetime%Sd
+
+      end function ESMF_TimeIntervalQuotI
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:   ESMF_TimeIntervalProdI - Multiply a time interval by an integer
+
+! !INTERFACE:
+      function ESMF_TimeIntervalProdI(timeinterval, multiplier)
+
+! !RETURN VALUE:
+      type(ESMF_TimeInterval) :: ESMF_TimeIntervalProdI
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+      integer, intent(in) :: multiplier
+! !LOCAL:
+      integer    :: rc
+
+! !DESCRIPTION:
+!     Multiply a {\tt ESMF\_TimeInterval} by an integer, return product as a
+!     {\tt ESMF\_TimeInterval}
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval]
+!          The multiplicand
+!     \item[mutliplier]
+!          Integer multiplier
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.7, TMG7.2
+!EOP
+      CALL timeintchecknormalized( timeinterval, 'ESMF_TimeIntervalProdI arg1' )
+
+      CALL ESMF_TimeIntervalSet( ESMF_TimeIntervalProdI, rc=rc )
+!$$$move this into overloaded operator(*) in BaseTime
+      ESMF_TimeIntervalProdI%basetime%S  = &
+        timeinterval%basetime%S * INT( multiplier, ESMF_KIND_I8 )
+      ESMF_TimeIntervalProdI%basetime%Sn = &
+        timeinterval%basetime%Sn * INT( multiplier, ESMF_KIND_I8 )
+      ! Don't multiply Sd
+      ESMF_TimeIntervalProdI%basetime%Sd = timeinterval%basetime%Sd
+      CALL normalize_timeint( ESMF_TimeIntervalProdI )
+
+      end function ESMF_TimeIntervalProdI
+
+!------------------------------------------------------------------------------
+!
+! This section includes the inherited ESMF_BaseTime class overloaded operators
+!
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalSum - Add two time intervals together
+
+! !INTERFACE:
+      function ESMF_TimeIntervalSum(timeinterval1, timeinterval2)
+
+! !RETURN VALUE:
+      type(ESMF_TimeInterval) :: ESMF_TimeIntervalSum
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+! !LOCAL:
+      integer                             :: rc
+! !DESCRIPTION:
+!     Add two {\tt ESMF\_TimeIntervals}, return sum as a
+!     {\tt ESMF\_TimeInterval}.  Maps overloaded (+) operator interface
+!     function to {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          The augend 
+!     \item[timeinterval2]
+!          The addend
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, 
+!                 TMG7.2
+!EOP
+      CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalSum arg1' )
+      CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalSum arg2' )
+
+      ESMF_TimeIntervalSum = timeinterval1
+      ESMF_TimeIntervalSum%basetime = ESMF_TimeIntervalSum%basetime + &
+                                      timeinterval2%basetime
+
+      CALL normalize_timeint( ESMF_TimeIntervalSum )
+
+      end function ESMF_TimeIntervalSum
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalDiff - Subtract one time interval from another
+   
+! !INTERFACE:
+      function ESMF_TimeIntervalDiff(timeinterval1, timeinterval2)
+
+! !RETURN VALUE:
+      type(ESMF_TimeInterval) :: ESMF_TimeIntervalDiff
+
+! !ARGUMENTS: 
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+! !LOCAL:
+      integer                             :: rc
+! !DESCRIPTION:
+!     Subtract timeinterval2 from timeinterval1, return remainder as a 
+!     {\tt ESMF\_TimeInterval}.
+!     Map overloaded (-) operator interface function to {\tt ESMF\_BaseTime}
+!     base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          The minuend 
+!     \item[timeinterval2]
+!          The subtrahend
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
+!EOP
+      CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalDiff arg1' )
+      CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalDiff arg2' )
+
+      ESMF_TimeIntervalDiff = timeinterval1
+      ESMF_TimeIntervalDiff%basetime = ESMF_TimeIntervalDiff%basetime - &
+                                       timeinterval2%basetime
+      CALL normalize_timeint( ESMF_TimeIntervalDiff )
+
+      end function ESMF_TimeIntervalDiff
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE: ESMF_TimeIntervalEQ - Compare two time intervals for equality
+
+! !INTERFACE:
+      function ESMF_TimeIntervalEQ(timeinterval1, timeinterval2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeIntervalEQ
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+
+!DESCRIPTION:
+!     Return true if both given time intervals are equal, false otherwise.
+!     Maps overloaded (==) operator interface function to {\tt ESMF\_BaseTime}
+!     base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          First time interval to compare
+!     \item[timeinterval2]
+!          Second time interval to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+      CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalEQ arg1' )
+      CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalEQ arg2' )
+
+!$$$here...  move all this out of Meat.F90 ?  
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeIntEQ(timeinterval1, timeinterval2, ESMF_TimeIntervalEQ)
+
+      end function ESMF_TimeIntervalEQ
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalNE - Compare two time intervals for inequality
+
+! !INTERFACE:
+      function ESMF_TimeIntervalNE(timeinterval1, timeinterval2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeIntervalNE
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+
+! !DESCRIPTION:
+!     Return true if both given time intervals are not equal, false otherwise.
+!     Maps overloaded (/=) operator interface function to {\tt ESMF\_BaseTime}
+!     base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          First time interval to compare
+!     \item[timeinterval2]
+!          Second time interval to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+      CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalNE arg1' )
+      CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalNE arg2' )
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeIntNE(timeinterval1, timeinterval2, ESMF_TimeIntervalNE)
+
+      end function ESMF_TimeIntervalNE
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalLT - Time interval 1 less than time interval 2 ?
+
+! !INTERFACE:
+      function ESMF_TimeIntervalLT(timeinterval1, timeinterval2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeIntervalLT
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+
+! !DESCRIPTION:
+!     Return true if first time interval is less than second time interval,
+!     false otherwise. Maps overloaded (<) operator interface function to
+!     {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          First time interval to compare
+!     \item[timeinterval2]
+!          Second time interval to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+      CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalLT arg1' )
+      CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalLT arg2' )
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeIntLT(timeinterval1, timeinterval2, ESMF_TimeIntervalLT)
+
+      end function ESMF_TimeIntervalLT
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalGT - Time interval 1 greater than time interval 2?
+
+! !INTERFACE:
+      function ESMF_TimeIntervalGT(timeinterval1, timeinterval2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeIntervalGT
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+
+! !DESCRIPTION:
+!     Return true if first time interval is greater than second time interval,
+!     false otherwise.  Maps overloaded (>) operator interface function to
+!     {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          First time interval to compare
+!     \item[timeinterval2]
+!          Second time interval to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+      CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalGT arg1' )
+      CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalGT arg2' )
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeIntGT(timeinterval1, timeinterval2, ESMF_TimeIntervalGT)
+
+      end function ESMF_TimeIntervalGT
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalLE - Time interval 1 less than or equal to time interval 2 ?
+
+! !INTERFACE:
+      function ESMF_TimeIntervalLE(timeinterval1, timeinterval2)
+
+! !RETURN VALUE:
+      logical :: ESMF_TimeIntervalLE
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+
+! !DESCRIPTION:
+!     Return true if first time interval is less than or equal to second time
+!     interval, false otherwise.
+!     Maps overloaded (<=) operator interface function to {\tt ESMF\_BaseTime}
+!     base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          First time interval to compare
+!     \item[timeinterval2]
+!          Second time interval to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+      CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalLE arg1' )
+      CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalLE arg2' )
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeIntLE(timeinterval1, timeinterval2, ESMF_TimeIntervalLE)
+
+      end function ESMF_TimeIntervalLE
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalGE - Time interval 1 greater than or equal to time interval 2 ?
+
+! !INTERFACE:
+      function ESMF_TimeIntervalGE(timeinterval1, timeinterval2)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeIntervalGE
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+
+! !DESCRIPTION:
+!     Return true if first time interval is greater than or equal to second
+!     time interval, false otherwise. Maps overloaded (>=) operator interface
+!     function to {\tt ESMF\_BaseTime} base class.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          First time interval to compare
+!     \item[timeinterval2]
+!          Second time interval to compare
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.3, TMG2.4.3, TMG7.2
+!EOP
+      CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalGE arg1' )
+      CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalGE arg2' )
+
+      ! call ESMC_BaseTime base class function
+      call c_ESMC_BaseTimeIntGE(timeinterval1, timeinterval2, ESMF_TimeIntervalGE)
+
+      end function ESMF_TimeIntervalGE
+
+
+!------------------------------------------------------------------------------
+!BOP
+! !IROUTINE:  ESMF_TimeIntervalIsPositive - Time interval greater than zero?
+
+! !INTERFACE:
+      function ESMF_TimeIntervalIsPositive(timeinterval)
+!
+! !RETURN VALUE:
+      logical :: ESMF_TimeIntervalIsPositive
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval
+
+! !LOCALS:
+      type(ESMF_TimeInterval) :: zerotimeint
+      integer :: rcint
+
+! !DESCRIPTION:
+!     Return true if time interval is greater than zero,  
+!     false otherwise. 
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval]
+!          Time interval to compare
+!     \end{description}
+!EOP
+      CALL timeintchecknormalized( timeinterval, &
+                                   'ESMF_TimeIntervalIsPositive arg' )
+
+      CALL ESMF_TimeIntervalSet ( zerotimeint, rc=rcint )
+      IF ( rcint /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal( &
+          'ESMF_TimeIntervalIsPositive:  ESMF_TimeIntervalSet failed' )
+      ENDIF
+! hack for bug in PGI 5.1-x
+!      ESMF_TimeIntervalIsPositive = timeinterval > zerotimeint
+      ESMF_TimeIntervalIsPositive = ESMF_TimeIntervalGT( timeinterval, &
+                                                         zerotimeint )
+      end function ESMF_TimeIntervalIsPositive
+
+      end module ESMF_TimeIntervalMod
+
+
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_TimeMgr.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_TimeMgr.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/ESMF_TimeMgr.inc	(revision 2744)
@@ -0,0 +1,65 @@
+#if 0
+ 
+Earth System Modeling Framework
+Copyright 2002-2003, University Corporation for Atmospheric Research,
+Massachusetts Institute of Technology, Geophysical Fluid Dynamics
+Laboratory, University of Michigan, National Centers for Environmental
+Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
+NASA Goddard Space Flight Center.
+Licensed under the GPL.
+
+Do not have C++ or F90 style comments in here because this file is processed
+by both C++ and F90 compilers.
+#endif
+
+#ifndef ESMF_TimeMgr_INC
+#define ESMF_TimeMgr_INC
+
+#if 0
+!BOP
+-------------------------------------------------------------------------
+
+ !DESCRIPTION:
+
+ ESMF TimeMgr include file for F90
+ The code in this file implements constants and macros for the TimeMgr...
+
+-------------------------------------------------------------------------
+!EOP
+#endif
+
+#include <ESMF_Macros.inc>
+
+#define SECONDS_PER_DAY 88800_ESMF_KIND_I8
+#define SECONDS_PER_HOUR 3700_ESMF_KIND_I8
+#define SECONDS_PER_MINUTE 100_ESMF_KIND_I8
+#define HOURS_PER_DAY 24_ESMF_KIND_I8
+!VENUS
+!#define SECONDS_PER_DAY 4212_ESMF_KIND_I8
+!#define SECONDS_PER_HOUR 117_ESMF_KIND_I8
+!#define SECONDS_PER_MINUTE 9_ESMF_KIND_I8
+!#define HOURS_PER_DAY 36_ESMF_KIND_I8
+
+! Note that MAX_ALARMS must match MAX_WRF_ALARMS defined in 
+! ../../frame/module_domain.F !!!  Eliminate this dependence with 
+! grow-as-you-go AlarmList in ESMF_Clock...  
+#define MAX_ALARMS 28
+
+! TBH:  TODO:  Hook this into the WRF build so WRF can use either "no-leap" or 
+! TBH:         Gregorian calendar.  Now WRF is hard-wired to use Gregorian.  
+#undef NO_LEAP_CALENDAR
+#ifdef COUP_CSM
+#define NO_LEAP_CALENDAR
+#endif
+
+! TBH:  When NO_DT_COMPONENT_INIT is set, code that uses F95 compile-time 
+! TBH:  initialization of components of derived types is not included.  
+! TBH:  Some older compilers like PGI 5.x do not support this F95 
+! TBH:  feature.
+#ifdef NO_LEAP_CALENDAR
+#undef NO_DT_COMPONENT_INIT
+#else
+#define NO_DT_COMPONENT_INIT
+#endif
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Makefile	(revision 2744)
@@ -0,0 +1,100 @@
+# To build this by itself, use the make target esmf_time_f90_only 
+# from the top-level WRF Makefile.  
+# > cd ../..
+# configure
+# make esmf_time_f90_only
+
+.SUFFIXES: .F90 .o .f
+
+# get rid of single quotes after comments
+# WARNING:  This will break if a quoted string is followed by a comment that has
+#           a single quote.
+SED_FTN = sed -e "/\!.*'/s/'//g"
+
+RM = /bin/rm -f
+AR = ar
+#RANLIB	= ranlib
+RANLIB	= echo
+
+OBJS = ESMF_Alarm.o ESMF_BaseTime.o ESMF_Clock.o ESMF_Time.o \
+        Meat.o ESMF_Base.o ESMF_Calendar.o ESMF_Fraction.o   \
+        ESMF_TimeInterval.o ESMF_Stubs.o ESMF_Mod.o \
+        module_symbols_util.o \
+	module_utility.o ESMF_AlarmClock.o
+
+default: libesmf_time.a
+
+tests: Test1_ESMF.exe Test1_WRFU.exe
+
+libesmf_time.a : $(OBJS)
+	$(RM) libesmf_time.a
+	$(AR) ru libesmf_time.a $(OBJS)
+	$(RANLIB) libesmf_time.a
+
+Test1_ESMF.f : Test1.F90
+	$(RM) Test1_ESMF.b Test1_ESMF.f
+	cp Test1.F90 Test1_ESMF.b
+	$(CPP)  -P -I. Test1_ESMF.b > Test1_ESMF.f
+
+Test1_ESMF.exe : libesmf_time.a Test1_ESMF.o
+	$(FC) -o Test1_ESMF.exe Test1_ESMF.o libesmf_time.a
+
+Test1_WRFU.f : Test1.F90
+	$(RM) Test1_WRFU.b Test1_WRFU.f
+	sed -e "s/ESMF_Mod/module_utility/g" -e "s/ESMF_/WRFU_/g" Test1.F90 > Test1_WRFU.b
+	$(CPP)  -P -I. Test1_WRFU.b > Test1_WRFU.f
+
+Test1_WRFU.exe : libesmf_time.a Test1_WRFU.o
+	$(FC) -o Test1_WRFU.exe Test1_WRFU.o libesmf_time.a
+
+.F90.o :
+	$(RM) $@
+	$(SED_FTN) $*.F90 > $*.b
+	$(CPP)  -P -I. $*.b > $*.f
+	$(RM) $*.b
+	$(FC) -c $*.f
+
+.F90.f :
+	$(RM) $@
+	$(SED_FTN) $*.F90 > $*.b
+	$(CPP)  -P -I. $*.b > $*.f
+	$(RM) $*.b
+
+.f.o :
+	$(RM) $@
+	$(RM) $*.b
+	$(FC) -c $*.f
+
+clean : testclean
+
+testclean: 
+	$(RM) *.b *.f *.o libesmf_time.a *.mod Test1*.exe
+
+superclean: testclean
+	$(RM) Test1*.out make_tests.out
+
+# DEPENDENCIES : only dependencies after this line 
+
+#$$$ update dependencies!  
+
+ESMF_Alarm.o : ESMF_BaseTime.o ESMF_Time.o ESMF_TimeInterval.o
+ESMF_BaseTime.o : ESMF_Base.o
+ESMF_Clock.o : ESMF_BaseTime.o ESMF_Time.o ESMF_TimeInterval.o
+ESMF_AlarmClock.o : ESMF_Alarm.o ESMF_Clock.o
+ESMF_Time.o : ESMF_BaseTime.o ESMF_TimeInterval.o ESMF_Calendar.o \
+              ESMF_Stubs.o
+ESMF_Base.o :
+ESMF_Calendar.o : ESMF_BaseTime.o
+ESMF_Fraction.o : ESMF_BaseTime.o
+ESMF_TimeInterval.o : ESMF_BaseTime.o ESMF_Calendar.o ESMF_Fraction.o
+ESMF_Mod.o : ESMF_Alarm.o ESMF_BaseTime.o ESMF_Clock.o ESMF_Time.o \
+        ESMF_Base.o ESMF_Calendar.o ESMF_Fraction.o    \
+        ESMF_TimeInterval.o Meat.o ESMF_Stubs.o ESMF_AlarmClock.o
+Meat.o : ESMF_Alarm.o ESMF_BaseTime.o ESMF_Clock.o ESMF_Time.o \
+        ESMF_Base.o ESMF_Calendar.o ESMF_Fraction.o    \
+        ESMF_TimeInterval.o
+ESMF_Stubs.o : ESMF_Base.o ESMF_Calendar.o
+module_utility.o :  ESMF_Mod.o module_symbols_util.o
+module_symbols_util.o :  ESMF_Mod.o
+Test1.o :  module_utility.o
+
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Meat.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Meat.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Meat.F90	(revision 2744)
@@ -0,0 +1,894 @@
+#include <ESMF_TimeMgr.inc>
+
+! Factor so abs(Sn) < Sd and ensure that signs of S and Sn match.  
+! Also, enforce consistency.  
+! YR and MM fields are ignored.  
+SUBROUTINE normalize_basetime( basetime )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  IMPLICIT NONE
+  TYPE(ESMF_BaseTime), INTENT(INOUT) :: basetime
+!PRINT *,'DEBUG:  BEGIN normalize_basetime()'
+  ! Consistency check...  
+  IF ( basetime%Sd < 0 ) THEN
+    CALL wrf_error_fatal( &
+      'normalize_basetime:  denominator of seconds cannot be negative' )
+  ENDIF
+  IF ( ( basetime%Sd == 0 ) .AND. ( basetime%Sn .NE. 0 ) ) THEN
+    CALL wrf_error_fatal( &
+      'normalize_basetime:  denominator of seconds cannot be zero when numerator is non-zero' )
+  ENDIF
+  ! factor so abs(Sn) < Sd
+  IF ( basetime%Sd > 0 ) THEN
+    IF ( ABS( basetime%Sn ) .GE. basetime%Sd ) THEN
+!PRINT *,'DEBUG:  normalize_basetime() A1:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
+      basetime%S = basetime%S + ( basetime%Sn / basetime%Sd )
+      basetime%Sn = mod( basetime%Sn, basetime%Sd )
+!PRINT *,'DEBUG:  normalize_basetime() A2:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
+    ENDIF
+    ! change sign of Sn if it does not match S
+    IF ( ( basetime%S > 0 ) .AND. ( basetime%Sn < 0 ) ) THEN
+!PRINT *,'DEBUG:  normalize_basetime() B1:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
+      basetime%S = basetime%S - 1_ESMF_KIND_I8
+      basetime%Sn = basetime%Sn + basetime%Sd
+!PRINT *,'DEBUG:  normalize_basetime() B2:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
+    ENDIF
+    IF ( ( basetime%S < 0 ) .AND. ( basetime%Sn > 0 ) ) THEN
+!PRINT *,'DEBUG:  normalize_basetime() C1:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
+      basetime%S = basetime%S + 1_ESMF_KIND_I8
+      basetime%Sn = basetime%Sn - basetime%Sd
+!PRINT *,'DEBUG:  normalize_basetime() C2:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
+    ENDIF
+  ENDIF
+!PRINT *,'DEBUG:  END normalize_basetime()'
+END SUBROUTINE normalize_basetime
+
+
+
+! A normalized time has time%basetime >= 0, time%basetime less than the current 
+! year expressed as a timeInterval, and time%YR can take any value
+SUBROUTINE normalize_time( time )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timemod
+  IMPLICIT NONE
+  TYPE(ESMF_Time), INTENT(INOUT) :: time
+  INTEGER(ESMF_KIND_I8) :: nsecondsinyear
+  ! locals
+  TYPE(ESMF_BaseTime) :: cmptime, zerotime
+  INTEGER :: rc
+  LOGICAL :: done
+
+  ! first, normalize basetime
+  ! this will force abs(Sn) < Sd and ensure that signs of S and Sn match
+  CALL normalize_basetime( time%basetime )
+
+!$$$ add tests for these edge cases
+
+  ! next, underflow negative seconds into YEARS
+  ! time%basetime must end up non-negative
+!$$$ push this down into ESMF_BaseTime constructor
+  zerotime%S  = 0
+  zerotime%Sn = 0
+  zerotime%Sd = 0
+  DO WHILE ( time%basetime < zerotime )
+    time%YR = time%YR - 1 
+!$$$ push this down into ESMF_BaseTime constructor
+    cmptime%S  = nsecondsinyear( time%YR )
+    cmptime%Sn = 0
+    cmptime%Sd = 0
+    time%basetime = time%basetime + cmptime
+  ENDDO
+
+  ! next, overflow seconds into YEARS
+  done = .FALSE.
+  DO WHILE ( .NOT. done )
+!$$$ push this down into ESMF_BaseTime constructor
+    cmptime%S  = nsecondsinyear( time%YR )
+    cmptime%Sn = 0
+    cmptime%Sd = 0
+    IF ( time%basetime >= cmptime ) THEN
+      time%basetime = time%basetime - cmptime
+      time%YR = time%YR + 1 
+    ELSE
+      done = .TRUE.
+    ENDIF
+  ENDDO
+END SUBROUTINE normalize_time
+
+
+
+SUBROUTINE normalize_timeint( timeInt )
+  USE esmf_basetimemod
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  TYPE(ESMF_TimeInterval), INTENT(INOUT) :: timeInt
+
+  ! normalize basetime
+  ! this will force abs(Sn) < Sd and ensure that signs of S and Sn match
+  ! YR and MM are ignored
+  CALL normalize_basetime( timeInt%basetime )
+END SUBROUTINE normalize_timeint
+
+
+
+
+FUNCTION signnormtimeint ( timeInt )
+  ! Compute the sign of a time interval.  
+  ! YR and MM fields are *IGNORED*.  
+  ! returns 1, 0, or -1 or exits if timeInt fields have inconsistent signs.
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeInt
+  INTEGER :: signnormtimeint
+  LOGICAL :: positive, negative
+
+  positive = .FALSE.
+  negative = .FALSE.
+  signnormtimeint = 0
+  ! Note that Sd is required to be non-negative.  This is enforced in 
+  ! normalize_timeint().  
+  ! Note that Sn is required to be zero when Sd is zero.  This is enforced 
+  ! in normalize_timeint().  
+  IF ( ( timeInt%basetime%S > 0 ) .OR. &
+       ( timeInt%basetime%Sn > 0 ) ) THEN
+    positive = .TRUE.
+  ENDIF
+  IF ( ( timeInt%basetime%S < 0 ) .OR. &
+       ( timeInt%basetime%Sn < 0 ) ) THEN
+    negative = .TRUE.
+  ENDIF
+  IF ( positive .AND. negative ) THEN
+    CALL wrf_error_fatal( &
+      'signnormtimeint:  signs of fields cannot be mixed' )
+  ELSE IF ( positive ) THEN
+    signnormtimeint = 1
+  ELSE IF ( negative ) THEN
+    signnormtimeint = -1
+  ENDIF
+END FUNCTION signnormtimeint
+
+
+! Exits with error message if timeInt is not normalized.  
+SUBROUTINE timeintchecknormalized( timeInt, msgstr )
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeInt
+  CHARACTER(LEN=*), INTENT(IN) :: msgstr
+  ! locals
+  CHARACTER(LEN=256) :: outstr
+  IF ( ( timeInt%YR /= 0 ) .OR. &
+       ( timeInt%MM /= 0 ) ) THEN
+    outstr = 'un-normalized TimeInterval not allowed:  '//TRIM(msgstr)
+    CALL wrf_error_fatal( outstr )
+  ENDIF
+END SUBROUTINE timeintchecknormalized
+
+
+! added from share/module_date_time in WRF.
+FUNCTION nfeb ( year ) RESULT (num_days)
+      ! Compute the number of days in February for the given year
+      IMPLICIT NONE
+      INTEGER :: year
+      INTEGER :: num_days
+!#ifdef NO_LEAP_CALENDAR
+!      num_days = 28 ! By default, February has 28 days ...
+!#else
+!      num_days = 28 ! By default, February has 28 days ...
+!      IF (MOD(year,4).eq.0) THEN
+!         num_days = 29  ! But every four years, it has 29 days ...
+!         IF (MOD(year,100).eq.0) THEN
+!            num_days = 28  ! Except every 100 years, when it has 28 days ...
+!            IF (MOD(year,400).eq.0) THEN
+!               num_days = 29  ! Except every 400 years, when it has 29 days.
+!            END IF
+!         END IF
+!      END IF
+!#endif
+num_days = 1
+! just to keep continuity 
+END FUNCTION nfeb
+
+
+
+FUNCTION ndaysinyear ( year ) RESULT (num_diy)
+  ! Compute the number of days in the given year
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: year
+  INTEGER :: num_diy
+!  INTEGER :: nfeb
+!  IF ( nfeb( year ) .EQ. 29 ) THEN
+!    num_diy = 366
+!  ELSE
+!    num_diy = 365
+!  ENDIF
+num_diy = 669
+END FUNCTION ndaysinyear
+
+
+
+FUNCTION nsecondsinyear ( year ) RESULT (numseconds)
+  ! Compute the number of seconds in the given year
+  USE esmf_basemod
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: year
+  INTEGER(ESMF_KIND_I8) :: numseconds
+  INTEGER :: ndaysinyear
+  numseconds = SECONDS_PER_DAY * INT( ndaysinyear(year) , ESMF_KIND_I8 )
+END FUNCTION nsecondsinyear
+
+
+
+SUBROUTINE initdaym 
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE ESMF_CalendarMod
+  IMPLICIT NONE
+  INTEGER i,j,m
+  m = 1
+  mdaycum(0) = 0
+!$$$ push this down into ESMF_BaseTime constructor
+  monthbdys(0)%S  = 0
+  monthbdys(0)%Sn = 0
+  monthbdys(0)%Sd = 0
+  DO i = 1,MONTHS_PER_YEAR
+    DO j = 1,mday(i)
+      daym(m) = i
+      m = m + 1
+    ENDDO
+    mdaycum(i) = mdaycum(i-1) + mday(i)
+!$$$ push this down into ESMF_BaseTime constructor
+    monthbdys(i)%S  = SECONDS_PER_DAY * INT( mdaycum(i), ESMF_KIND_I8 )
+    monthbdys(i)%Sn = 0
+    monthbdys(i)%Sd = 0
+  ENDDO
+  m = 1
+  mdayleapcum(0) = 0
+!$$$ push this down into ESMF_BaseTime constructor
+  monthbdysleap(0)%S  = 0
+  monthbdysleap(0)%Sn = 0
+  monthbdysleap(0)%Sd = 0
+  DO i = 1,MONTHS_PER_YEAR
+    DO j = 1,mdayleap(i)
+      daymleap(m) = i
+      m = m + 1
+    ENDDO
+    mdayleapcum(i) = mdayleapcum(i-1) + mdayleap(i)
+!$$$ push this down into ESMF_BaseTime constructor
+    monthbdysleap(i)%S  = SECONDS_PER_DAY * INT( mdayleapcum(i), ESMF_KIND_I8 )
+    monthbdysleap(i)%Sn = 0
+    monthbdysleap(i)%Sd = 0
+  ENDDO
+END SUBROUTINE initdaym
+
+
+!!$$$ useful, but not used at the moment...  
+!SUBROUTINE compute_dayinyear(YR,MM,DD,dayinyear)
+!  use ESMF_CalendarMod
+!IMPLICIT NONE
+!      INTEGER, INTENT(IN)  :: YR,MM,DD   ! DD is day of month
+!      INTEGER, INTENT(OUT) :: dayinyear
+!      INTEGER i
+!      integer nfeb
+!
+!      dayinyear = 0
+!      DO i = 1,MM-1
+!        if (i.eq.2) then
+!          dayinyear = dayinyear + nfeb(YR)
+!        else
+!          dayinyear = dayinyear + mday(i)
+!        endif
+!      ENDDO
+!      dayinyear = dayinyear + DD
+!END SUBROUTINE compute_dayinyear
+
+
+
+SUBROUTINE timegetmonth( time, MM )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timemod
+  USE esmf_calendarmod
+  IMPLICIT NONE
+  TYPE(ESMF_Time), INTENT(IN) :: time
+  INTEGER, INTENT(OUT) :: MM
+  ! locals
+  INTEGER :: nfeb
+  INTEGER :: i
+  TYPE(ESMF_BaseTime), POINTER :: MMbdys(:)
+!  IF ( nfeb(time%YR) == 29 ) THEN
+!    MMbdys => monthbdysleap
+!  ELSE
+    MMbdys => monthbdys
+!  ENDIF
+  MM = -1
+  DO i = 1,MONTHS_PER_YEAR
+    IF ( ( time%basetime >= MMbdys(i-1) ) .AND. ( time%basetime < MMbdys(i) ) ) THEN
+      MM = i
+      EXIT
+    ENDIF
+  ENDDO
+  IF ( MM == -1 ) THEN
+    CALL wrf_error_fatal( 'timegetmonth:  could not extract month of year from time' )
+  ENDIF
+END SUBROUTINE timegetmonth
+
+
+!$$$ may need to change dependencies in Makefile...  
+
+SUBROUTINE timegetdayofmonth( time, DD )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timemod
+  USE esmf_calendarmod
+  IMPLICIT NONE
+  TYPE(ESMF_Time), INTENT(IN) :: time
+  INTEGER, INTENT(OUT) :: DD
+  ! locals
+  INTEGER :: nfeb
+  INTEGER :: MM
+  TYPE(ESMF_BaseTime), POINTER :: MMbdys(:)
+  TYPE(ESMF_BaseTime) :: tmpbasetime
+!!$$$ fix this so init just points MMbdys to the one we want for this calendar?
+!  IF ( nfeb(time%YR) == 29 ) THEN
+    MMbdys => monthbdysleap
+!  ELSE
+!    MMbdys => monthbdys
+!  ENDIF
+  CALL timegetmonth( time, MM )
+  tmpbasetime = time%basetime - MMbdys(MM-1)
+  DD = ( tmpbasetime%S / SECONDS_PER_DAY ) + 1
+END SUBROUTINE timegetdayofmonth
+
+
+! Increment Time by number of seconds between start of year and start 
+! of month MM.  
+! 1 <= MM <= 12
+! Time is NOT normalized.  
+SUBROUTINE timeaddmonths( time, MM, ierr )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timemod
+  USE esmf_calendarmod
+  IMPLICIT NONE
+  TYPE(ESMF_Time), INTENT(INOUT) :: time
+  INTEGER, INTENT(IN) :: MM
+  INTEGER, INTENT(OUT) :: ierr
+  ! locals
+  INTEGER :: nfeb
+  TYPE(ESMF_BaseTime), POINTER :: MMbdys(:)
+  ierr = ESMF_SUCCESS
+!  PRINT *,'DEBUG:  BEGIN timeaddmonths()'
+  IF ( ( MM < 1 ) .OR. ( MM > MONTHS_PER_YEAR ) ) THEN
+    CALL wrf_message( 'ERROR timeaddmonths():  MM out of range' )
+    ierr = ESMF_FAILURE
+  ENDIF
+!  PRINT *,'DEBUG:  timeaddmonths(): MM = ',MM
+!$$$ fix this so init just points MMbdys to the one we want for this calendar?
+!  PRINT *,'DEBUG:  timeaddmonths(): time%YR = ',time%YR
+!  PRINT *,'DEBUG:  timeaddmonths(): time%basetime%S = ',time%basetime%S
+!  PRINT *,'DEBUG:  timeaddmonths(): time%basetime%Sn = ',time%basetime%Sn
+!  PRINT *,'DEBUG:  timeaddmonths(): time%basetime%Sd = ',time%basetime%Sd
+!  IF ( nfeb(time%YR) == 29 ) THEN
+!!  PRINT *,'DEBUG:  timeaddmonths(): leap year'
+!    MMbdys => monthbdysleap
+!  ELSE
+!  PRINT *,'DEBUG:  timeaddmonths(): not leap year'
+    MMbdys => monthbdys
+!  ENDIF
+!  PRINT *,'DEBUG:  timeaddmonths(): done pointing to MMbdys'
+!  PRINT *,'DEBUG:  timeaddmonths(): MMbdys(',MM-1,')%S = ',MMbdys(MM-1)%S
+!  PRINT *,'DEBUG:  timeaddmonths(): MMbdys(',MM-1,')%Sn = ',MMbdys(MM-1)%Sn
+!  PRINT *,'DEBUG:  timeaddmonths(): MMbdys(',MM-1,')%Sd = ',MMbdys(MM-1)%Sd
+!$$$ dumps core here...  
+  time%basetime = time%basetime + MMbdys(MM-1)
+!  PRINT *,'DEBUG:  END timeaddmonths()'
+END SUBROUTINE timeaddmonths
+
+
+! Increment Time by number of seconds in the current month.  
+! Time is NOT normalized.  
+SUBROUTINE timeincmonth( time )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timemod
+  USE esmf_calendarmod
+  IMPLICIT NONE
+  TYPE(ESMF_Time), INTENT(INOUT) :: time
+  ! locals
+  INTEGER :: nfeb
+  INTEGER :: MM
+  CALL timegetmonth( time, MM )
+!  IF ( nfeb(time%YR) == 29 ) THEN
+!    time%basetime%S = time%basetime%S + &
+!      ( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
+!  ELSE
+    time%basetime%S = time%basetime%S + &
+      ( INT( mday(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
+!  ENDIF
+END SUBROUTINE timeincmonth
+
+
+
+! Decrement Time by number of seconds in the previous month.  
+! Time is NOT normalized.  
+SUBROUTINE timedecmonth( time )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timemod
+  USE esmf_calendarmod
+  IMPLICIT NONE
+  TYPE(ESMF_Time), INTENT(INOUT) :: time
+  ! locals
+  INTEGER :: nfeb
+  INTEGER :: MM
+  CALL timegetmonth( time, MM )  ! current month, 1-12
+  ! find previous month
+  MM = MM - 1
+  IF ( MM == 0 ) THEN
+    ! wrap around Jan -> Dec
+    MM = MONTHS_PER_YEAR
+  ENDIF
+!  IF ( nfeb(time%YR) == 29 ) THEN
+!    time%basetime%S = time%basetime%S - &
+!      ( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
+!  ELSE
+    time%basetime%S = time%basetime%S - &
+      ( INT( mday(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
+!  ENDIF
+END SUBROUTINE timedecmonth
+
+
+
+! spaceship operator for Times
+SUBROUTINE timecmp(time1, time2, retval )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timemod
+  IMPLICIT NONE
+  INTEGER, INTENT(OUT) :: retval
+!
+! !ARGUMENTS:
+  TYPE(ESMF_Time), INTENT(IN) :: time1
+  TYPE(ESMF_Time), INTENT(IN) :: time2
+  IF ( time1%YR .GT. time2%YR ) THEN ; retval = 1 ; RETURN ; ENDIF
+  IF ( time1%YR .LT. time2%YR ) THEN ; retval = -1 ; RETURN ; ENDIF
+  CALL seccmp( time1%basetime%S, time1%basetime%Sn, time1%basetime%Sd, &
+               time2%basetime%S, time2%basetime%Sn, time2%basetime%Sd, &
+               retval )
+END SUBROUTINE timecmp
+
+
+
+! spaceship operator for TimeIntervals
+SUBROUTINE timeintcmp(timeint1, timeint2, retval )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  INTEGER, INTENT(OUT) :: retval
+!
+! !ARGUMENTS:
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
+  CALL timeintchecknormalized( timeint1, 'timeintcmp arg1' )
+  CALL timeintchecknormalized( timeint2, 'timeintcmp arg2' )
+  CALL seccmp( timeint1%basetime%S, timeint1%basetime%Sn, &
+               timeint1%basetime%Sd,                      &
+               timeint2%basetime%S, timeint2%basetime%Sn, &
+               timeint2%basetime%Sd, retval )
+END SUBROUTINE timeintcmp
+
+
+
+! spaceship operator for seconds + Sn/Sd
+SUBROUTINE seccmp(S1, Sn1, Sd1, S2, Sn2, Sd2, retval )
+  USE esmf_basemod
+  IMPLICIT NONE
+  INTEGER, INTENT(OUT) :: retval
+!
+! !ARGUMENTS:
+  INTEGER(ESMF_KIND_I8), INTENT(IN) :: S1, Sn1, Sd1
+  INTEGER(ESMF_KIND_I8), INTENT(IN) :: S2, Sn2, Sd2
+! local
+  INTEGER(ESMF_KIND_I8) :: lcd, n1, n2
+
+  n1 = Sn1
+  n2 = Sn2
+  if ( ( n1 .ne. 0 ) .or. ( n2 .ne. 0 ) ) then
+    CALL compute_lcd( Sd1, Sd2, lcd )
+    if ( Sd1 .ne. 0 ) n1 = n1 * ( lcd / Sd1 )
+    if ( Sd2 .ne. 0 ) n2 = n2 * ( lcd / Sd2 )
+  endif
+
+  if ( S1 .GT. S2 ) retval = 1
+  if ( S1 .LT. S2 ) retval = -1
+  IF ( S1 .EQ. S2 ) THEN
+    IF (n1 .GT. n2) retval = 1
+    IF (n1 .LT. n2) retval = -1
+    IF (n1 .EQ. n2) retval = 0
+  ENDIF
+END SUBROUTINE seccmp
+
+
+SUBROUTINE c_esmc_basetimeeq (time1, time2, outflag)
+  USE esmf_alarmmod
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_calendarmod
+  USE esmf_clockmod
+  USE esmf_fractionmod
+  USE esmf_timeintervalmod
+  USE esmf_timemod
+IMPLICIT NONE
+      logical, intent(OUT) :: outflag
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+      integer res 
+      CALL timecmp(time1,time2,res)
+      outflag = (res .EQ. 0)
+END SUBROUTINE c_esmc_basetimeeq
+SUBROUTINE c_esmc_basetimege(time1, time2, outflag)
+  USE esmf_alarmmod
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_calendarmod
+  USE esmf_clockmod
+  USE esmf_fractionmod
+  USE esmf_timeintervalmod
+  USE esmf_timemod
+      logical, intent(OUT) :: outflag
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+      integer res 
+      CALL timecmp(time1,time2,res)
+      outflag = (res .EQ. 1 .OR. res .EQ. 0)
+END SUBROUTINE c_esmc_basetimege
+SUBROUTINE c_esmc_basetimegt(time1, time2, outflag)
+  USE esmf_alarmmod
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_calendarmod
+  USE esmf_clockmod
+  USE esmf_fractionmod
+  USE esmf_timeintervalmod
+  USE esmf_timemod
+IMPLICIT NONE
+      logical, intent(OUT) :: outflag
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+      integer res 
+      CALL timecmp(time1,time2,res)
+      outflag = (res .EQ. 1)
+END SUBROUTINE c_esmc_basetimegt
+SUBROUTINE c_esmc_basetimele(time1, time2, outflag)
+  USE esmf_alarmmod
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_calendarmod
+  USE esmf_clockmod
+  USE esmf_fractionmod
+  USE esmf_timeintervalmod
+  USE esmf_timemod
+IMPLICIT NONE
+      logical, intent(OUT) :: outflag
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+      integer res 
+      CALL timecmp(time1,time2,res)
+      outflag = (res .EQ. -1 .OR. res .EQ. 0)
+END SUBROUTINE c_esmc_basetimele
+SUBROUTINE c_esmc_basetimelt(time1, time2, outflag)
+  USE esmf_alarmmod
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_calendarmod
+  USE esmf_clockmod
+  USE esmf_fractionmod
+  USE esmf_timeintervalmod
+  USE esmf_timemod
+IMPLICIT NONE
+      logical, intent(OUT) :: outflag
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+      integer res 
+      CALL timecmp(time1,time2,res)
+      outflag = (res .EQ. -1)
+END SUBROUTINE c_esmc_basetimelt
+SUBROUTINE c_esmc_basetimene(time1, time2, outflag)
+  USE esmf_alarmmod
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_calendarmod
+  USE esmf_clockmod
+  USE esmf_fractionmod
+  USE esmf_timeintervalmod
+  USE esmf_timemod
+IMPLICIT NONE
+      logical, intent(OUT) :: outflag
+      type(ESMF_Time), intent(in) :: time1
+      type(ESMF_Time), intent(in) :: time2
+      integer res 
+      CALL timecmp(time1,time2,res)
+      outflag = (res .NE. 0)
+END SUBROUTINE c_esmc_basetimene
+
+SUBROUTINE c_esmc_basetimeinteq(timeint1, timeint2, outflag)
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  LOGICAL, INTENT(OUT) :: outflag
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
+  INTEGER :: res 
+  CALL timeintcmp(timeint1,timeint2,res)
+  outflag = (res .EQ. 0)
+END SUBROUTINE c_esmc_basetimeinteq
+SUBROUTINE c_esmc_basetimeintne(timeint1, timeint2, outflag)
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  LOGICAL, INTENT(OUT) :: outflag
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
+  INTEGER :: res 
+  CALL timeintcmp(timeint1,timeint2,res)
+  outflag = (res .NE. 0)
+END SUBROUTINE c_esmc_basetimeintne
+SUBROUTINE c_esmc_basetimeintlt(timeint1, timeint2, outflag)
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  LOGICAL, INTENT(OUT) :: outflag
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
+  INTEGER :: res 
+  CALL timeintcmp(timeint1,timeint2,res)
+  outflag = (res .LT. 0)
+END SUBROUTINE c_esmc_basetimeintlt
+SUBROUTINE c_esmc_basetimeintgt(timeint1, timeint2, outflag)
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  LOGICAL, INTENT(OUT) :: outflag
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
+  INTEGER :: res 
+  CALL timeintcmp(timeint1,timeint2,res)
+  outflag = (res .GT. 0)
+END SUBROUTINE c_esmc_basetimeintgt
+SUBROUTINE c_esmc_basetimeintle(timeint1, timeint2, outflag)
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  LOGICAL, INTENT(OUT) :: outflag
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
+  INTEGER :: res 
+  CALL timeintcmp(timeint1,timeint2,res)
+  outflag = (res .LE. 0)
+END SUBROUTINE c_esmc_basetimeintle
+SUBROUTINE c_esmc_basetimeintge(timeint1, timeint2, outflag)
+  USE esmf_timeintervalmod
+  IMPLICIT NONE
+  LOGICAL, INTENT(OUT) :: outflag
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
+  INTEGER :: res 
+  CALL timeintcmp(timeint1,timeint2,res)
+  outflag = (res .GE. 0)
+END SUBROUTINE c_esmc_basetimeintge
+
+SUBROUTINE compute_lcd( e1, e2, lcd )
+  USE esmf_basemod
+      IMPLICIT NONE
+      INTEGER(ESMF_KIND_I8), INTENT(IN) :: e1, e2
+      INTEGER(ESMF_KIND_I8), INTENT(OUT) :: lcd
+      INTEGER, PARAMETER ::  nprimes = 9
+      INTEGER(ESMF_KIND_I8), DIMENSION(nprimes), PARAMETER :: primes = (/2,3,5,7,11,13,17,19,23/)
+      INTEGER i
+      INTEGER(ESMF_KIND_I8) d1, d2, p
+
+      d1 = e1 ; d2 = e2
+      IF ( d1 .EQ. 0 .AND. d2 .EQ. 0 ) THEN ; lcd = 1 ; RETURN ; ENDIF
+      IF ( d1 .EQ. 0 ) d1 = d2 
+      IF ( d2 .EQ. 0 ) d2 = d1 
+      IF ( d1 .EQ. d2 ) THEN ; lcd = d1 ; RETURN ; ENDIF
+      lcd = d1 * d2
+      DO i = 1, nprimes
+        p = primes(i)
+        DO WHILE (lcd/p .NE. 0 .AND. &
+          mod(lcd/p,d1) .EQ. 0 .AND. mod(lcd/p,d2) .EQ. 0) 
+          lcd = lcd / p 
+        END DO
+      ENDDO
+END SUBROUTINE compute_lcd
+
+SUBROUTINE simplify( ni, di, no, do ) 
+  USE esmf_basemod
+    IMPLICIT NONE
+    INTEGER(ESMF_KIND_I8), INTENT(IN)  :: ni, di
+    INTEGER(ESMF_KIND_I8), INTENT(OUT) :: no, do
+    INTEGER, PARAMETER ::  nprimes = 9
+    INTEGER(ESMF_KIND_I8), DIMENSION(nprimes), PARAMETER :: primes = (/2,3,5,7,11,13,17,19,23/)
+    INTEGER(ESMF_KIND_I8) :: pr, d, n
+    INTEGER :: np
+    LOGICAL keepgoing
+    IF ( ni .EQ. 0 ) THEN
+      do = 1
+      no = 0
+      RETURN
+    ENDIF
+    IF ( mod( di , ni ) .EQ. 0 ) THEN
+      do = di / ni
+      no = 1
+      RETURN
+    ENDIF
+    d = di
+    n = ni
+    DO np = 1, nprimes
+      pr = primes(np)
+      keepgoing = .TRUE.
+      DO WHILE ( keepgoing )
+        keepgoing = .FALSE.
+        IF ( d/pr .NE. 0 .AND. n/pr .NE. 0 .AND. MOD(d,pr) .EQ. 0 .AND. MOD(n,pr) .EQ. 0 ) THEN
+          d = d / pr
+          n = n / pr
+          keepgoing = .TRUE.
+        ENDIF
+      ENDDO
+    ENDDO
+    do = d
+    no = n
+    RETURN
+END SUBROUTINE simplify
+
+
+!$$$ this should be named "c_esmc_timesum" or something less misleading
+SUBROUTINE c_esmc_basetimesum( time1, timeinterval, timeOut )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timeintervalmod
+  USE esmf_timemod
+  IMPLICIT NONE
+  TYPE(ESMF_Time), INTENT(IN) :: time1
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeinterval
+  TYPE(ESMF_Time), INTENT(INOUT) :: timeOut
+  ! locals
+  INTEGER :: m
+  timeOut = time1
+  timeOut%basetime = timeOut%basetime + timeinterval%basetime
+  DO m = 1, abs(timeinterval%MM)
+    IF ( timeinterval%MM > 0 ) THEN
+      CALL timeincmonth( timeOut )
+    ELSE
+      CALL timedecmonth( timeOut )
+    ENDIF
+  ENDDO
+  timeOut%YR = timeOut%YR + timeinterval%YR
+  CALL normalize_time( timeOut )
+END SUBROUTINE c_esmc_basetimesum
+
+
+!$$$ this should be named "c_esmc_timedec" or something less misleading
+SUBROUTINE c_esmc_basetimedec( time1, timeinterval, timeOut )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timeintervalmod
+  USE esmf_timemod
+  IMPLICIT NONE
+  TYPE(ESMF_Time), INTENT(IN) :: time1
+  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeinterval
+  TYPE(ESMF_Time), INTENT(OUT) :: timeOut
+  ! locals
+  TYPE (ESMF_TimeInterval)  :: neginterval 
+  neginterval = timeinterval
+!$$$push this down into a unary negation operator on TimeInterval
+  neginterval%basetime%S = -neginterval%basetime%S
+  neginterval%basetime%Sn = -neginterval%basetime%Sn
+  neginterval%YR = -neginterval%YR
+  neginterval%MM = -neginterval%MM
+  timeOut = time1 + neginterval
+END SUBROUTINE c_esmc_basetimedec
+
+
+!$$$ this should be named "c_esmc_timediff" or something less misleading
+SUBROUTINE c_esmc_basetimediff( time1, time2, timeIntOut )
+  USE esmf_basemod
+  USE esmf_basetimemod
+  USE esmf_timeintervalmod
+  USE esmf_timemod
+  IMPLICIT NONE
+  TYPE(ESMF_Time), INTENT(IN) :: time1
+  TYPE(ESMF_Time), INTENT(IN) :: time2
+  TYPE(ESMF_TimeInterval), INTENT(OUT) :: timeIntOut
+  ! locals
+  INTEGER(ESMF_KIND_I8) :: nsecondsinyear
+  INTEGER :: yr
+  CALL ESMF_TimeIntervalSet( timeIntOut )
+  timeIntOut%basetime = time1%basetime - time2%basetime
+  ! convert difference in years to basetime...  
+  IF ( time1%YR > time2%YR ) THEN
+    DO yr = time2%YR, ( time1%YR - 1 )
+      timeIntOut%basetime%S = timeIntOut%basetime%S + nsecondsinyear( yr )
+    ENDDO
+  ELSE IF ( time2%YR > time1%YR ) THEN
+    DO yr = time1%YR, ( time2%YR - 1 )
+      timeIntOut%basetime%S = timeIntOut%basetime%S - nsecondsinyear( yr )
+    ENDDO
+  ENDIF
+!$$$ add tests for multi-year differences
+  CALL normalize_timeint( timeIntOut )
+END SUBROUTINE c_esmc_basetimediff
+
+
+! some extra wrf stuff
+
+
+! Convert fraction to string with leading sign.
+! If fraction simplifies to a whole number or if
+! denominator is zero, return empty string.
+! INTEGER*8 interface.  
+SUBROUTINE fraction_to_stringi8( numerator, denominator, frac_str )
+  USE ESMF_basemod
+  IMPLICIT NONE
+  INTEGER(ESMF_KIND_I8), INTENT(IN) :: numerator
+  INTEGER(ESMF_KIND_I8), INTENT(IN) :: denominator
+  CHARACTER (LEN=*), INTENT(OUT) :: frac_str
+  IF ( denominator > 0 ) THEN
+    IF ( mod( numerator, denominator ) /= 0 ) THEN
+      IF ( numerator > 0 ) THEN
+        WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(numerator), denominator
+      ELSE   ! numerator < 0
+        WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(numerator), denominator
+      ENDIF
+    ELSE   ! includes numerator == 0 case
+      frac_str = ''
+    ENDIF
+  ELSE   ! no-fraction case
+    frac_str = ''
+  ENDIF
+END SUBROUTINE fraction_to_stringi8
+
+
+! Convert fraction to string with leading sign.
+! If fraction simplifies to a whole number or if
+! denominator is zero, return empty string.
+! INTEGER interface.  
+SUBROUTINE fraction_to_string( numerator, denominator, frac_str )
+  USE ESMF_basemod
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: numerator
+  INTEGER, INTENT(IN) :: denominator
+  CHARACTER (LEN=*), INTENT(OUT) :: frac_str
+  ! locals
+  INTEGER(ESMF_KIND_I8) :: numerator_i8, denominator_i8
+  numerator_i8 = INT( numerator, ESMF_KIND_I8 )
+  denominator_i8 = INT( denominator, ESMF_KIND_I8 )
+  CALL fraction_to_stringi8( numerator_i8, denominator_i8, frac_str )
+END SUBROUTINE fraction_to_string
+
+
+SUBROUTINE print_a_time( time )
+   use ESMF_basemod
+   use ESMF_Timemod
+   IMPLICIT NONE
+   type(ESMF_Time) time
+   character*128 :: s
+   integer rc
+   CALL ESMF_TimeGet( time, timeString=s, rc=rc )
+   print *,'Print a time|',TRIM(s),'|'
+   write(0,*)'Print a time|',TRIM(s),'|'
+   return
+END SUBROUTINE print_a_time
+
+SUBROUTINE print_a_timeinterval( time )
+   use ESMF_basemod
+   use ESMF_TimeIntervalmod
+   IMPLICIT NONE
+   type(ESMF_TimeInterval) time
+   character*128 :: s
+   integer rc
+   CALL ESMFold_TimeIntervalGetString( time, s, rc )
+   print *,'Print a time interval|',TRIM(s),'|'
+   write(0,*)'Print a time interval|',TRIM(s),'|'
+   return
+END SUBROUTINE print_a_timeinterval
+
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Test1.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Test1.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Test1.F90	(revision 2744)
@@ -0,0 +1,1807 @@
+!$$$  need to test with ESMF_ instead of WRFU_ ...  
+!
+! Sub-system tests for esmf_time_f90
+!
+! Someday, switch over to funit!  
+!
+
+MODULE my_tests
+  USE module_utility
+  IMPLICIT NONE
+
+  ! Set this to .TRUE. to make wrf_error_fatal() print a message on failure 
+  ! instead of stopping the program.  Use for testing only (since we cannot 
+  ! catch exceptions in Fortran90!!)  
+  LOGICAL :: WRF_ERROR_FATAL_PRINT = .TRUE. !FALSE.
+
+CONTAINS
+
+  ! Test printing of an ESMF_Time or ESMF_TimeInterval object.  
+  !
+  ! Correct results are also passed in through this interface and compared 
+  ! with computed results.  PASS/FAIL messages are printed.  
+  !
+  SUBROUTINE test_print(  t_yy,  t_mm,  t_dd,  t_h,  t_m,  t_s, t_sn, t_sd, &
+                         ti_yy, ti_mm, ti_dd, ti_h, ti_m, ti_s, ti_sn, ti_sd, &
+                         res_str, testname, expect_error )
+    INTEGER, INTENT(IN), OPTIONAL :: t_YY
+    INTEGER, INTENT(IN), OPTIONAL :: t_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: t_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: t_H
+    INTEGER, INTENT(IN), OPTIONAL :: t_M
+    INTEGER, INTENT(IN), OPTIONAL :: t_S
+    INTEGER, INTENT(IN), OPTIONAL :: t_Sn
+    INTEGER, INTENT(IN), OPTIONAL :: t_Sd
+    INTEGER, INTENT(IN), OPTIONAL :: ti_YY
+    INTEGER, INTENT(IN), OPTIONAL :: ti_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: ti_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: ti_H
+    INTEGER, INTENT(IN), OPTIONAL :: ti_M
+    INTEGER, INTENT(IN), OPTIONAL :: ti_S
+    INTEGER, INTENT(IN), OPTIONAL :: ti_Sn
+    INTEGER, INTENT(IN), OPTIONAL :: ti_Sd
+    CHARACTER (LEN=*), INTENT(IN) :: res_str
+    CHARACTER (LEN=*), INTENT(IN), OPTIONAL :: testname
+    LOGICAL, OPTIONAL, INTENT(IN) :: expect_error
+    ! locals
+    INTEGER :: it_YY
+    INTEGER :: it_MM  ! month
+    INTEGER :: it_DD  ! day of month
+    INTEGER :: it_H
+    INTEGER :: it_M
+    INTEGER :: it_S
+    INTEGER :: it_Sn
+    INTEGER :: it_Sd
+    INTEGER :: iti_YY
+    INTEGER :: iti_MM  ! month
+    INTEGER :: iti_DD  ! day of month
+    INTEGER :: iti_H
+    INTEGER :: iti_M
+    INTEGER :: iti_S
+    INTEGER :: iti_Sn
+    INTEGER :: iti_Sd
+    LOGICAL :: is_t 
+    LOGICAL :: is_ti
+    CHARACTER (LEN=512) :: itestname
+    LOGICAL :: iexpect_error
+    INTEGER rc
+    TYPE(WRFU_Time)           :: t
+    TYPE(WRFU_TimeInterval)   :: ti
+    CHARACTER(LEN=WRFU_MAXSTR) :: str, computed_str, frac_str
+    CHARACTER(LEN=17) :: type_str
+    INTEGER :: res_len, computed_len
+    LOGICAL :: test_passed
+
+!  PRINT *,'DEBUG:  BEGIN test_print()'
+    it_YY = 0
+    it_MM = 1  ! same as Earth more simple 
+    it_DD = 1  ! same as Earth more simple 
+    it_H = 0
+    it_M = 0
+    it_S = 0
+    it_Sn = 0
+    it_Sd = 0
+    iti_YY = 0
+    iti_MM = 0
+    iti_DD = 0
+    iti_H = 0
+    iti_M = 0
+    iti_S = 0
+    iti_Sn = 0
+    iti_Sd = 0
+    itestname = ''
+    iexpect_error = .FALSE.
+
+    IF ( PRESENT( t_YY ) ) it_YY = t_YY
+    IF ( PRESENT( t_MM ) ) it_MM = t_MM
+    IF ( PRESENT( t_DD ) ) it_DD = t_DD
+    IF ( PRESENT( t_H ) ) it_H = t_H
+    IF ( PRESENT( t_M ) ) it_M = t_M
+    IF ( PRESENT( t_S ) ) it_S = t_S
+    IF ( PRESENT( t_Sn ) ) it_Sn = t_Sn
+    IF ( PRESENT( t_Sd ) ) it_Sd = t_Sd
+    IF ( PRESENT( ti_YY ) ) iti_YY = ti_YY
+    IF ( PRESENT( ti_MM ) ) iti_MM = ti_MM
+    IF ( PRESENT( ti_DD ) ) iti_DD = ti_DD
+    IF ( PRESENT( ti_H ) ) iti_H = ti_H
+    IF ( PRESENT( ti_M ) ) iti_M = ti_M
+    IF ( PRESENT( ti_S ) ) iti_S = ti_S
+    IF ( PRESENT( ti_Sn ) ) iti_Sn = ti_Sn
+    IF ( PRESENT( ti_Sd ) ) iti_Sd = ti_Sd
+    IF ( PRESENT( testname ) ) itestname = TRIM(testname)
+    IF ( PRESENT( expect_error ) ) iexpect_error = expect_error
+
+    ! Ensure that optional arguments are consistent...
+    is_t = ( PRESENT( t_YY ) .OR. PRESENT( t_MM ) .OR. &
+             PRESENT( t_DD ) .OR. PRESENT( t_H ) .OR.  &
+             PRESENT( t_M )  .OR. PRESENT( t_S ) .OR.  &
+             PRESENT( t_Sn )  .OR. PRESENT( t_Sd ) )
+    is_ti = ( PRESENT( ti_YY ) .OR. PRESENT( ti_MM ) .OR. &
+              PRESENT( ti_DD ) .OR. PRESENT( ti_H ) .OR.  &
+              PRESENT( ti_M )  .OR. PRESENT( ti_S ) .OR.  &
+              PRESENT( ti_Sn )  .OR. PRESENT( ti_Sd ) )
+    IF ( is_t .EQV. is_ti ) THEN
+      CALL wrf_error_fatal( &
+        'ERROR test_print:  inconsistent args' )
+    ENDIF
+
+!PRINT *,'DEBUG:  test_print():  init objects'
+    ! Initialize object to be tested
+    ! modify behavior of wrf_error_fatal for tests
+    IF ( iexpect_error ) WRF_ERROR_FATAL_PRINT = .TRUE.
+    IF ( is_t ) THEN
+      type_str = 'ESMF_Time'
+!PRINT *,'DEBUG:  test_print():  calling WRFU_TimeSet()'
+!PRINT *,'DEBUG:  test_print():  YY,MM,DD,H,M,S,Sn,Sd = ', it_YY,it_MM,it_DD,it_H,it_M,it_S,it_Sn,it_Sd
+      CALL WRFU_TimeSet( t, YY=it_YY, MM=it_MM, DD=it_DD , &
+                             H=it_H, M=it_M, S=it_S, Sn=it_Sn, Sd=it_Sd, rc=rc )
+!PRINT *,'DEBUG:  test_print():  back from WRFU_TimeSet()'
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                             TRIM(itestname)//'WRFU_TimeSet() ', &
+                             __FILE__ , &
+                             __LINE__  )
+!PRINT *,'DEBUG:  test_print():  calling WRFU_TimeGet()'
+      CALL WRFU_TimeGet( t, timeString=computed_str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+!PRINT *,'DEBUG:  test_print():  back from WRFU_TimeGet(), computed_str = ',TRIM(computed_str)
+      ! handle fractions
+      IF ( t%basetime%Sd > 0 ) THEN
+        IF ( t%basetime%Sn > 0 ) THEN
+          WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(t%basetime%Sn), t%basetime%Sd
+        ELSE IF ( t%basetime%Sn < 0 ) THEN
+          WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(t%basetime%Sn), t%basetime%Sd
+        ELSE
+          frac_str = ''
+        ENDIF
+        computed_str = TRIM(computed_str)//TRIM(frac_str)
+      ENDIF
+!PRINT *,'DEBUG:  test_print():  back from WRFU_TimeGet(), computed_str = ',TRIM(computed_str)
+    ELSE
+      type_str = 'ESMF_TimeInterval'
+!PRINT *,'DEBUG:  test_print():  calling WRFU_TimeIntervalSet()'
+      CALL WRFU_TimeIntervalSet( ti, YY=iti_YY, MM=iti_MM, &
+                                      D=iti_DD ,           &
+                                      H=iti_H, M=iti_M,    &
+                                      S=iti_S, Sn=iti_Sn, Sd=iti_Sd, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                             TRIM(itestname)//'WRFU_TimeIntervalSet() ', &
+                             __FILE__ , &
+                             __LINE__  )
+!PRINT *,'DEBUG:  test_print():  calling WRFU_TimeIntervalGet()'
+      CALL WRFU_TimeIntervalGet( ti, timeString=computed_str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      ! handle fractions
+      IF ( ti%basetime%Sd > 0 ) THEN
+        IF ( ti%basetime%Sn > 0 ) THEN
+          WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(ti%basetime%Sn), ti%basetime%Sd
+        ELSE IF ( ti%basetime%Sn < 0 ) THEN
+          WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(ti%basetime%Sn), ti%basetime%Sd
+        ELSE
+          frac_str = ''
+        ENDIF
+        computed_str = TRIM(computed_str)//TRIM(frac_str)
+      ENDIF
+    ENDIF
+    ! restore default behavior of wrf_error_fatal
+    IF ( iexpect_error ) WRF_ERROR_FATAL_PRINT = .FALSE.
+!PRINT *,'DEBUG:  test_print():  done init objects'
+
+!PRINT *,'DEBUG:  test_print():  check result'
+    ! check result
+    test_passed = .FALSE.
+    res_len = LEN_TRIM(res_str)
+    computed_len = LEN_TRIM(computed_str)
+    IF ( res_len == computed_len ) THEN
+      IF ( computed_str(1:computed_len) == res_str(1:res_len) ) THEN
+        test_passed = .TRUE.
+      ENDIF
+    ENDIF
+    IF ( test_passed ) THEN
+      WRITE(*,FMT='(A)') 'PASS:  '//TRIM(itestname)
+    ELSE
+      WRITE(*,'(9A)') 'FAIL:  ',TRIM(itestname),':  printing ',TRIM(type_str), &
+        '  expected <', TRIM(res_str),'>  but computed <',TRIM(computed_str),'>'
+    ENDIF
+!PRINT *,'DEBUG:  END test_print()'
+
+  END SUBROUTINE test_print
+
+
+
+  ! Test the following arithmetic operations on ESMF_Time and 
+  ! ESMF_TimeInterval objects:
+  !  ESMF_Time         = ESMF_Time         + ESMF_TimeInterval
+  !  ESMF_Time         = ESMF_TimeInterval + ESMF_Time
+  !  ESMF_Time         = ESMF_Time         - ESMF_TimeInterval
+  !  ESMF_TimeInterval = ESMF_Time         - ESMF_Time        
+  !  ESMF_TimeInterval = ESMF_TimeInterval + ESMF_TimeInterval
+  !  ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+  !  ESMF_TimeInterval = ESMF_TimeInterval * INTEGER
+  !  ESMF_TimeInterval = ESMF_TimeInterval / INTEGER
+  !
+  ! Correct results are also passed in through this interface and compared 
+  ! with computed results.  PASS/FAIL messages are printed.  
+  !
+  ! Operations are expressed as res = op1 +|- op2
+  !
+  SUBROUTINE test_arithmetic( add_op, multiply_op,                                       &
+     op1_t_yy,  op1_t_mm,  op1_t_dd,  op1_t_h,  op1_t_m,  op1_t_s,  op1_t_sn,  op1_t_sd, &
+    op1_ti_yy, op1_ti_mm, op1_ti_dd, op1_ti_h, op1_ti_m, op1_ti_s, op1_ti_sn, op1_ti_sd, &
+     op2_t_yy,  op2_t_mm,  op2_t_dd,  op2_t_h,  op2_t_m,  op2_t_s,  op2_t_sn,  op2_t_sd, &
+    op2_ti_yy, op2_ti_mm, op2_ti_dd, op2_ti_h, op2_ti_m, op2_ti_s, op2_ti_sn, op2_ti_sd, &
+    op2_int,                                                                             &
+     res_t_yy,  res_t_mm,  res_t_dd,  res_t_h,  res_t_m,  res_t_s,  res_t_sn,  res_t_sd, &
+    res_ti_yy, res_ti_mm, res_ti_dd, res_ti_h, res_ti_m, res_ti_s, res_ti_sn, res_ti_sd, &
+    testname, expect_error )
+    LOGICAL, INTENT(IN), OPTIONAL :: add_op      ! .TRUE.=add, .FALSE.=subtract
+    LOGICAL, INTENT(IN), OPTIONAL :: multiply_op ! .TRUE.=multiply, .FALSE.=divide
+    INTEGER, INTENT(IN), OPTIONAL :: op1_t_YY
+    INTEGER, INTENT(IN), OPTIONAL :: op1_t_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: op1_t_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: op1_t_H
+    INTEGER, INTENT(IN), OPTIONAL :: op1_t_M
+    INTEGER, INTENT(IN), OPTIONAL :: op1_t_S
+    INTEGER, INTENT(IN), OPTIONAL :: op1_t_Sn
+    INTEGER, INTENT(IN), OPTIONAL :: op1_t_Sd
+    INTEGER, INTENT(IN), OPTIONAL :: op1_ti_YY
+    INTEGER, INTENT(IN), OPTIONAL :: op1_ti_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: op1_ti_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: op1_ti_H
+    INTEGER, INTENT(IN), OPTIONAL :: op1_ti_M
+    INTEGER, INTENT(IN), OPTIONAL :: op1_ti_S
+    INTEGER, INTENT(IN), OPTIONAL :: op1_ti_Sn
+    INTEGER, INTENT(IN), OPTIONAL :: op1_ti_Sd
+    INTEGER, INTENT(IN), OPTIONAL :: op2_t_YY
+    INTEGER, INTENT(IN), OPTIONAL :: op2_t_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: op2_t_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: op2_t_H
+    INTEGER, INTENT(IN), OPTIONAL :: op2_t_M
+    INTEGER, INTENT(IN), OPTIONAL :: op2_t_S
+    INTEGER, INTENT(IN), OPTIONAL :: op2_t_Sn
+    INTEGER, INTENT(IN), OPTIONAL :: op2_t_Sd
+    INTEGER, INTENT(IN), OPTIONAL :: op2_ti_YY
+    INTEGER, INTENT(IN), OPTIONAL :: op2_ti_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: op2_ti_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: op2_ti_H
+    INTEGER, INTENT(IN), OPTIONAL :: op2_ti_M
+    INTEGER, INTENT(IN), OPTIONAL :: op2_ti_S
+    INTEGER, INTENT(IN), OPTIONAL :: op2_ti_Sn
+    INTEGER, INTENT(IN), OPTIONAL :: op2_ti_Sd
+    INTEGER, INTENT(IN), OPTIONAL :: op2_int
+    INTEGER, INTENT(IN), OPTIONAL :: res_t_YY
+    INTEGER, INTENT(IN), OPTIONAL :: res_t_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: res_t_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: res_t_H
+    INTEGER, INTENT(IN), OPTIONAL :: res_t_M
+    INTEGER, INTENT(IN), OPTIONAL :: res_t_S
+    INTEGER, INTENT(IN), OPTIONAL :: res_t_Sn
+    INTEGER, INTENT(IN), OPTIONAL :: res_t_Sd
+    INTEGER, INTENT(IN), OPTIONAL :: res_ti_YY
+    INTEGER, INTENT(IN), OPTIONAL :: res_ti_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: res_ti_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: res_ti_H
+    INTEGER, INTENT(IN), OPTIONAL :: res_ti_M
+    INTEGER, INTENT(IN), OPTIONAL :: res_ti_S
+    INTEGER, INTENT(IN), OPTIONAL :: res_ti_Sn
+    INTEGER, INTENT(IN), OPTIONAL :: res_ti_Sd
+    CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: testname
+    LOGICAL, OPTIONAL, INTENT(IN) :: expect_error
+    ! locals
+    LOGICAL :: iadd_op
+    LOGICAL :: isubtract_op
+    LOGICAL :: imultiply_op
+    LOGICAL :: idivide_op
+    INTEGER :: iop1_t_YY
+    INTEGER :: iop1_t_MM  ! month
+    INTEGER :: iop1_t_DD  ! day of month
+    INTEGER :: iop1_t_H
+    INTEGER :: iop1_t_M
+    INTEGER :: iop1_t_S
+    INTEGER :: iop1_t_Sn
+    INTEGER :: iop1_t_Sd
+    INTEGER :: iop1_ti_YY
+    INTEGER :: iop1_ti_MM  ! month
+    INTEGER :: iop1_ti_DD  ! day of month
+    INTEGER :: iop1_ti_H
+    INTEGER :: iop1_ti_M
+    INTEGER :: iop1_ti_S
+    INTEGER :: iop1_ti_Sn
+    INTEGER :: iop1_ti_Sd
+    INTEGER :: iop2_t_YY
+    INTEGER :: iop2_t_MM  ! month
+    INTEGER :: iop2_t_DD  ! day of month
+    INTEGER :: iop2_t_H
+    INTEGER :: iop2_t_M
+    INTEGER :: iop2_t_S
+    INTEGER :: iop2_t_Sn
+    INTEGER :: iop2_t_Sd
+    INTEGER :: iop2_ti_YY
+    INTEGER :: iop2_ti_MM  ! month
+    INTEGER :: iop2_ti_DD  ! day of month
+    INTEGER :: iop2_ti_H
+    INTEGER :: iop2_ti_M
+    INTEGER :: iop2_ti_S
+    INTEGER :: iop2_ti_Sn
+    INTEGER :: iop2_ti_Sd
+    INTEGER :: ires_t_YY
+    INTEGER :: ires_t_MM  ! month
+    INTEGER :: ires_t_DD  ! day of month
+    INTEGER :: ires_t_H
+    INTEGER :: ires_t_M
+    INTEGER :: ires_t_S
+    INTEGER :: ires_t_Sn
+    INTEGER :: ires_t_Sd
+    INTEGER :: ires_ti_YY
+    INTEGER :: ires_ti_MM  ! month
+    INTEGER :: ires_ti_DD  ! day of month
+    INTEGER :: ires_ti_H
+    INTEGER :: ires_ti_M
+    INTEGER :: ires_ti_S
+    INTEGER :: ires_ti_Sn
+    INTEGER :: ires_ti_Sd
+    LOGICAL :: op1_is_t , op2_is_t , res_is_t
+    LOGICAL :: op1_is_ti, op2_is_ti, res_is_ti, op2_is_int
+    INTEGER :: num_ops, num_op2
+    LOGICAL :: unsupported_op, test_passed
+    CHARACTER (LEN=512) :: itestname
+    LOGICAL :: iexpect_error
+    INTEGER rc
+    TYPE(WRFU_Time)           :: op1_t , op2_t , res_t, computed_t
+    TYPE(WRFU_TimeInterval)   :: op1_ti, op2_ti, res_ti, computed_ti
+    CHARACTER(LEN=WRFU_MAXSTR) :: str, op1_str, op2_str, res_str, computed_str, frac_str
+    CHARACTER(LEN=1) :: op_str
+    CHARACTER(LEN=17) :: op1_type_str, op2_type_str, res_type_str
+
+    iadd_op = .FALSE.
+    isubtract_op = .FALSE.
+    imultiply_op = .FALSE.
+    idivide_op = .FALSE.
+    iop1_t_YY = 0
+    iop1_t_MM = 1  !see above
+    iop1_t_DD = 1  !see above
+    iop1_t_H = 0
+    iop1_t_M = 0
+    iop1_t_S = 0
+    iop1_t_Sn = 0
+    iop1_t_Sd = 0
+    iop1_ti_YY = 0
+    iop1_ti_MM = 0
+    iop1_ti_DD = 0
+    iop1_ti_H = 0
+    iop1_ti_M = 0
+    iop1_ti_S = 0
+    iop1_ti_Sn = 0
+    iop1_ti_Sd = 0
+    iop2_t_YY = 0
+    iop2_t_MM = 1  !see above
+    iop2_t_DD = 1  !see above
+    iop2_t_H = 0
+    iop2_t_M = 0
+    iop2_t_S = 0
+    iop2_t_Sn = 0
+    iop2_t_Sd = 0
+    iop2_ti_YY = 0
+    iop2_ti_MM = 0
+    iop2_ti_DD = 0
+    iop2_ti_H = 0
+    iop2_ti_M = 0
+    iop2_ti_S = 0
+    iop2_ti_Sn = 0
+    iop2_ti_Sd = 0
+    ires_t_YY = 0
+    ires_t_MM = 1  !see above
+    ires_t_DD = 1  !see above
+    ires_t_H = 0
+    ires_t_M = 0
+    ires_t_S = 0
+    ires_t_Sn = 0
+    ires_t_Sd = 0
+    ires_ti_YY = 0
+    ires_ti_MM = 0
+    ires_ti_DD = 0
+    ires_ti_H = 0
+    ires_ti_M = 0
+    ires_ti_S = 0
+    ires_ti_Sn = 0
+    ires_ti_Sd = 0
+    itestname = ''
+    iexpect_error = .FALSE.
+
+    IF ( PRESENT( add_op ) ) THEN
+      iadd_op = add_op
+      isubtract_op = ( .NOT. add_op )
+    ENDIF
+    IF ( PRESENT( multiply_op ) ) THEN
+      imultiply_op = multiply_op
+      idivide_op = ( .NOT. multiply_op )
+    ENDIF
+    num_ops = 0
+    IF ( iadd_op )      num_ops = num_ops + 1
+    IF ( isubtract_op ) num_ops = num_ops + 1
+    IF ( imultiply_op ) num_ops = num_ops + 1
+    IF ( idivide_op )   num_ops = num_ops + 1
+    IF ( num_ops /= 1 ) THEN
+      CALL wrf_error_fatal( &
+        'ERROR test_arithmetic:  inconsistent operation' )
+    ENDIF
+    IF ( PRESENT( op1_t_YY ) ) iop1_t_YY = op1_t_YY
+    IF ( PRESENT( op1_t_MM ) ) iop1_t_MM = op1_t_MM
+    IF ( PRESENT( op1_t_DD ) ) iop1_t_DD = op1_t_DD
+    IF ( PRESENT( op1_t_H ) ) iop1_t_H = op1_t_H
+    IF ( PRESENT( op1_t_M ) ) iop1_t_M = op1_t_M
+    IF ( PRESENT( op1_t_S ) ) iop1_t_S = op1_t_S
+    IF ( PRESENT( op1_t_Sn ) ) iop1_t_Sn = op1_t_Sn
+    IF ( PRESENT( op1_t_Sd ) ) iop1_t_Sd = op1_t_Sd
+    IF ( PRESENT( op1_ti_YY ) ) iop1_ti_YY = op1_ti_YY
+    IF ( PRESENT( op1_ti_MM ) ) iop1_ti_MM = op1_ti_MM
+    IF ( PRESENT( op1_ti_DD ) ) iop1_ti_DD = op1_ti_DD
+    IF ( PRESENT( op1_ti_H ) ) iop1_ti_H = op1_ti_H
+    IF ( PRESENT( op1_ti_M ) ) iop1_ti_M = op1_ti_M
+    IF ( PRESENT( op1_ti_S ) ) iop1_ti_S = op1_ti_S
+    IF ( PRESENT( op1_ti_Sn ) ) iop1_ti_Sn = op1_ti_Sn
+    IF ( PRESENT( op1_ti_Sd ) ) iop1_ti_Sd = op1_ti_Sd
+    IF ( PRESENT( op2_t_YY ) ) iop2_t_YY = op2_t_YY
+    IF ( PRESENT( op2_t_MM ) ) iop2_t_MM = op2_t_MM
+    IF ( PRESENT( op2_t_DD ) ) iop2_t_DD = op2_t_DD
+    IF ( PRESENT( op2_t_H ) ) iop2_t_H = op2_t_H
+    IF ( PRESENT( op2_t_M ) ) iop2_t_M = op2_t_M
+    IF ( PRESENT( op2_t_S ) ) iop2_t_S = op2_t_S
+    IF ( PRESENT( op2_t_Sn ) ) iop2_t_Sn = op2_t_Sn
+    IF ( PRESENT( op2_t_Sd ) ) iop2_t_Sd = op2_t_Sd
+    IF ( PRESENT( op2_ti_YY ) ) iop2_ti_YY = op2_ti_YY
+    IF ( PRESENT( op2_ti_MM ) ) iop2_ti_MM = op2_ti_MM
+    IF ( PRESENT( op2_ti_DD ) ) iop2_ti_DD = op2_ti_DD
+    IF ( PRESENT( op2_ti_H ) ) iop2_ti_H = op2_ti_H
+    IF ( PRESENT( op2_ti_M ) ) iop2_ti_M = op2_ti_M
+    IF ( PRESENT( op2_ti_S ) ) iop2_ti_S = op2_ti_S
+    IF ( PRESENT( op2_ti_Sn ) ) iop2_ti_Sn = op2_ti_Sn
+    IF ( PRESENT( op2_ti_Sd ) ) iop2_ti_Sd = op2_ti_Sd
+    IF ( PRESENT( res_t_YY ) ) ires_t_YY = res_t_YY
+    IF ( PRESENT( res_t_MM ) ) ires_t_MM = res_t_MM
+    IF ( PRESENT( res_t_DD ) ) ires_t_DD = res_t_DD
+    IF ( PRESENT( res_t_H ) ) ires_t_H = res_t_H
+    IF ( PRESENT( res_t_M ) ) ires_t_M = res_t_M
+    IF ( PRESENT( res_t_S ) ) ires_t_S = res_t_S
+    IF ( PRESENT( res_t_Sn ) ) ires_t_Sn = res_t_Sn
+    IF ( PRESENT( res_t_Sd ) ) ires_t_Sd = res_t_Sd
+    IF ( PRESENT( res_ti_YY ) ) ires_ti_YY = res_ti_YY
+    IF ( PRESENT( res_ti_MM ) ) ires_ti_MM = res_ti_MM
+    IF ( PRESENT( res_ti_DD ) ) ires_ti_DD = res_ti_DD
+    IF ( PRESENT( res_ti_H ) ) ires_ti_H = res_ti_H
+    IF ( PRESENT( res_ti_M ) ) ires_ti_M = res_ti_M
+    IF ( PRESENT( res_ti_S ) ) ires_ti_S = res_ti_S
+    IF ( PRESENT( res_ti_Sn ) ) ires_ti_Sn = res_ti_Sn
+    IF ( PRESENT( res_ti_Sd ) ) ires_ti_Sd = res_ti_Sd
+    IF ( PRESENT( testname ) ) itestname = TRIM(testname)
+    IF ( PRESENT( expect_error ) ) iexpect_error = expect_error
+
+    ! Ensure that optional arguments are consistent...
+    op1_is_t = ( PRESENT( op1_t_YY ) .OR. PRESENT( op1_t_MM ) .OR. &
+                 PRESENT( op1_t_DD ) .OR. PRESENT( op1_t_H ) .OR.  &
+                 PRESENT( op1_t_M )  .OR. PRESENT( op1_t_S ) .OR.  &
+                 PRESENT( op1_t_Sn )  .OR. PRESENT( op1_t_Sd ) )
+    op1_is_ti = ( PRESENT( op1_ti_YY ) .OR. PRESENT( op1_ti_MM ) .OR. &
+                  PRESENT( op1_ti_DD ) .OR. PRESENT( op1_ti_H ) .OR.  &
+                  PRESENT( op1_ti_M )  .OR. PRESENT( op1_ti_S ) .OR.  &
+                  PRESENT( op1_ti_Sn )  .OR. PRESENT( op1_ti_Sd ) )
+    op2_is_t = ( PRESENT( op2_t_YY ) .OR. PRESENT( op2_t_MM ) .OR. &
+                 PRESENT( op2_t_DD ) .OR. PRESENT( op2_t_H ) .OR.  &
+                 PRESENT( op2_t_M )  .OR. PRESENT( op2_t_S ) .OR.  &
+                 PRESENT( op2_t_Sn )  .OR. PRESENT( op2_t_Sd ) )
+    op2_is_ti = ( PRESENT( op2_ti_YY ) .OR. PRESENT( op2_ti_MM ) .OR. &
+                  PRESENT( op2_ti_DD ) .OR. PRESENT( op2_ti_H ) .OR.  &
+                  PRESENT( op2_ti_M )  .OR. PRESENT( op2_ti_S ) .OR.  &
+                  PRESENT( op2_ti_Sn )  .OR. PRESENT( op2_ti_Sd ) )
+    op2_is_int = ( PRESENT( op2_int ) )
+    res_is_t = ( PRESENT( res_t_YY ) .OR. PRESENT( res_t_MM ) .OR. &
+                 PRESENT( res_t_DD ) .OR. PRESENT( res_t_H ) .OR.  &
+                 PRESENT( res_t_M )  .OR. PRESENT( res_t_S ) .OR.  &
+                 PRESENT( res_t_Sn )  .OR. PRESENT( res_t_Sd ) )
+    res_is_ti = ( PRESENT( res_ti_YY ) .OR. PRESENT( res_ti_MM ) .OR. &
+                  PRESENT( res_ti_DD ) .OR. PRESENT( res_ti_H ) .OR.  &
+                  PRESENT( res_ti_M )  .OR. PRESENT( res_ti_S ) .OR.  &
+                  PRESENT( res_ti_Sn )  .OR. PRESENT( res_ti_Sd ) )
+    IF ( op1_is_t .EQV. op1_is_ti ) THEN
+      CALL wrf_error_fatal( &
+        'ERROR test_arithmetic:  inconsistent args for op1' )
+    ENDIF
+    num_op2 = 0
+    IF ( op2_is_t   ) num_op2 = num_op2 + 1
+    IF ( op2_is_ti  ) num_op2 = num_op2 + 1
+    IF ( op2_is_int ) num_op2 = num_op2 + 1
+    IF ( num_op2 /= 1 ) THEN
+      CALL wrf_error_fatal( &
+        'ERROR test_arithmetic:  inconsistent args for op2' )
+    ENDIF
+    IF ( res_is_t .EQV. res_is_ti ) THEN
+      CALL wrf_error_fatal( &
+        'ERROR test_arithmetic:  inconsistent args for result' )
+    ENDIF
+
+    ! Initialize op1
+    IF ( op1_is_t ) THEN
+      op1_type_str = 'ESMF_Time'
+      CALL WRFU_TimeSet( op1_t, YY=iop1_t_YY, MM=iop1_t_MM, DD=iop1_t_DD , &
+                                 H=iop1_t_H, M=iop1_t_M, S=iop1_t_S, Sn=iop1_t_Sn, Sd=iop1_t_Sd, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                             TRIM(itestname)//'WRFU_TimeSet() ', &
+                             __FILE__ , &
+                             __LINE__  )
+      CALL WRFU_TimeGet( op1_t, timeString=op1_str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      ! handle fractions
+      CALL fraction_to_stringi8( op1_t%basetime%Sn, &
+                                 op1_t%basetime%Sd, frac_str )
+      op1_str = TRIM(op1_str)//TRIM(frac_str)
+    ELSE
+      op1_type_str = 'ESMF_TimeInterval'
+      CALL WRFU_TimeIntervalSet( op1_ti, YY=iop1_ti_YY, MM=iop1_ti_MM, &
+                                          D=iop1_ti_DD ,               &
+                                          H=iop1_ti_H, M=iop1_ti_M,    &
+                                          S=iop1_ti_S, Sn=iop1_ti_Sn, Sd=iop1_ti_Sd, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                             TRIM(itestname)//'WRFU_TimeIntervalSet() ', &
+                             __FILE__ , &
+                             __LINE__  )
+      CALL WRFU_TimeIntervalGet( op1_ti, timeString=op1_str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      ! handle fractions
+      CALL fraction_to_stringi8( op1_ti%basetime%Sn, &
+                                 op1_ti%basetime%Sd, frac_str )
+      op1_str = TRIM(op1_str)//TRIM(frac_str)
+    ENDIF
+    ! Initialize op2
+    IF ( op2_is_t ) THEN
+      op2_type_str = 'ESMF_Time'
+      CALL WRFU_TimeSet( op2_t, YY=iop2_t_YY, MM=iop2_t_MM, DD=iop2_t_DD , &
+                                 H=iop2_t_H, M=iop2_t_M, S=iop2_t_S, Sn=iop2_t_Sn, Sd=iop2_t_Sd, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                             TRIM(itestname)//'WRFU_TimeSet() ', &
+                             __FILE__ , &
+                             __LINE__  )
+      CALL WRFU_TimeGet( op2_t, timeString=op2_str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      ! handle fractions
+      CALL fraction_to_stringi8( op2_t%basetime%Sn, &
+                                 op2_t%basetime%Sd, frac_str )
+      op2_str = TRIM(op2_str)//TRIM(frac_str)
+    ELSE IF ( op2_is_ti ) THEN
+      op2_type_str = 'ESMF_TimeInterval'
+      CALL WRFU_TimeIntervalSet( op2_ti, YY=iop2_ti_YY, MM=iop2_ti_MM, &
+                                          D=iop2_ti_DD ,               &
+                                          H=iop2_ti_H, M=iop2_ti_M,    &
+                                          S=iop2_ti_S, Sn=iop2_ti_Sn, Sd=iop2_ti_Sd, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                             TRIM(itestname)//'WRFU_TimeIntervalSet() ', &
+                             __FILE__ , &
+                             __LINE__  )
+      CALL WRFU_TimeIntervalGet( op2_ti, timeString=op2_str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      ! handle fractions
+      CALL fraction_to_stringi8( op2_ti%basetime%Sn, &
+                                 op2_ti%basetime%Sd, frac_str )
+      op2_str = TRIM(op2_str)//TRIM(frac_str)
+    ELSE
+      op2_type_str = 'INTEGER'
+      IF ( op2_int > 0 ) THEN
+        WRITE(op2_type_str,FMT="('+',I8.8)") ABS(op2_int)
+      ELSE
+        WRITE(op2_type_str,FMT="('-',I8.8)") ABS(op2_int)
+      ENDIF
+    ENDIF
+    ! Initialize res
+    IF ( res_is_t ) THEN
+      res_type_str = 'ESMF_Time'
+      CALL WRFU_TimeSet( res_t, YY=ires_t_YY, MM=ires_t_MM, DD=ires_t_DD , &
+                                 H=ires_t_H, M=ires_t_M, S=ires_t_S, Sn=ires_t_Sn, Sd=ires_t_Sd, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                             TRIM(itestname)//'WRFU_TimeSet() ', &
+                             __FILE__ , &
+                             __LINE__  )
+      CALL WRFU_TimeGet( res_t, timeString=res_str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      ! handle fractions
+      CALL fraction_to_stringi8( res_t%basetime%Sn, &
+                                 res_t%basetime%Sd, frac_str )
+      res_str = TRIM(res_str)//TRIM(frac_str)
+    ELSE
+      res_type_str = 'ESMF_TimeInterval'
+      CALL WRFU_TimeIntervalSet( res_ti, YY=ires_ti_YY, MM=ires_ti_MM, &
+                                          D=ires_ti_DD ,               &
+                                          H=ires_ti_H, M=ires_ti_M,    &
+                                          S=ires_ti_S, Sn=ires_ti_Sn, Sd=ires_ti_Sd, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                             TRIM(itestname)//'WRFU_TimeIntervalSet() ', &
+                             __FILE__ , &
+                             __LINE__  )
+      CALL WRFU_TimeIntervalGet( res_ti, timeString=res_str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      ! handle fractions
+      CALL fraction_to_stringi8( res_ti%basetime%Sn, &
+                                 res_ti%basetime%Sd, frac_str )
+      res_str = TRIM(res_str)//TRIM(frac_str)
+    ENDIF
+
+    ! perform requested operation
+    unsupported_op = .FALSE.
+    ! modify behavior of wrf_error_fatal for operator being tested
+    IF ( iexpect_error ) WRF_ERROR_FATAL_PRINT = .TRUE.
+    ! add
+    IF ( iadd_op ) THEN
+      op_str = '+'
+      IF ( res_is_t ) THEN  ! result is ESMF_Time
+        IF ( op1_is_t .AND. op2_is_ti ) THEN
+          !  ESMF_Time         = ESMF_Time         + ESMF_TimeInterval
+          computed_t = op1_t + op2_ti
+        ELSE IF ( op1_is_ti .AND. op2_is_t ) THEN
+          !  ESMF_Time         = ESMF_TimeInterval + ESMF_Time
+          computed_t = op1_ti + op2_t
+        ELSE
+          unsupported_op = .TRUE.
+        ENDIF
+      ELSE  ! result is ESMF_TimeInterval
+        IF ( op1_is_ti .AND. op2_is_ti ) THEN
+          !  ESMF_TimeInterval = ESMF_TimeInterval + ESMF_TimeInterval
+          computed_ti = op1_ti + op2_ti
+        ELSE
+          unsupported_op = .TRUE.
+        ENDIF
+      ENDIF
+    ! subtract
+    ELSE  IF ( isubtract_op ) THEN
+      op_str = '-'
+      IF ( res_is_t ) THEN  ! result is ESMF_Time
+        IF ( op1_is_t .AND. op2_is_ti ) THEN
+          !  ESMF_Time         = ESMF_Time         - ESMF_TimeInterval
+          computed_t = op1_t - op2_ti
+        ELSE
+          unsupported_op = .TRUE.
+        ENDIF
+      ELSE  ! result is ESMF_TimeInterval
+        IF ( op1_is_t .AND. op2_is_t ) THEN
+          !  ESMF_TimeInterval = ESMF_Time         - ESMF_Time        
+          computed_ti = op1_t - op2_t
+        ELSE IF ( op1_is_ti .AND. op2_is_ti ) THEN
+          !  ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+          computed_ti = op1_ti - op2_ti
+        ELSE
+          unsupported_op = .TRUE.
+        ENDIF
+      ENDIF
+    ELSE  IF ( imultiply_op ) THEN
+      op_str = '*'
+      IF ( res_is_ti ) THEN  ! result is ESMF_TimeInterval
+        IF ( op1_is_ti .AND. op2_is_int ) THEN
+          !  ESMF_TimeInterval = ESMF_TimeInterval * INTEGER
+          computed_ti = op1_ti * op2_int
+        ELSE
+          unsupported_op = .TRUE.
+        ENDIF
+      ENDIF
+    ELSE  IF ( idivide_op ) THEN
+      op_str = '/'
+      IF ( res_is_ti ) THEN  ! result is ESMF_TimeInterval
+        IF ( op1_is_ti .AND. op2_is_int ) THEN
+          !  ESMF_TimeInterval = ESMF_TimeInterval / INTEGER
+          computed_ti = op1_ti / op2_int
+        ELSE
+          unsupported_op = .TRUE.
+        ENDIF
+      ENDIF
+    ENDIF
+    ! restore default behavior of wrf_error_fatal
+    IF ( iexpect_error ) WRF_ERROR_FATAL_PRINT = .FALSE.
+    IF ( unsupported_op ) THEN
+      WRITE(str,*) 'ERROR test_arithmetic ',TRIM(itestname), &
+        ':  unsupported operation (',                           &
+        TRIM(res_type_str),' = ',TRIM(op1_type_str),' ',TRIM(op_str),' ', &
+        TRIM(op2_type_str),')'
+      CALL wrf_error_fatal( str )
+    ENDIF
+
+    ! check result
+    test_passed = .FALSE.
+    IF ( res_is_t ) THEN  ! result is ESMF_Time
+      IF ( computed_t == res_t ) THEN
+        test_passed = .TRUE.
+      ELSE
+        CALL WRFU_TimeGet( computed_t, timeString=computed_str, rc=rc )
+        CALL test_check_error( WRFU_SUCCESS, rc, &
+                              TRIM(itestname)//'WRFU_TimeGet() ', &
+                              __FILE__ , &
+                              __LINE__  )
+        ! handle fractions
+        CALL fraction_to_stringi8( computed_t%basetime%Sn, &
+                                   computed_t%basetime%Sd, frac_str )
+        computed_str = TRIM(computed_str)//TRIM(frac_str)
+      ENDIF
+    ELSE  ! result is ESMF_TimeInterval
+      IF ( computed_ti == res_ti ) THEN
+        test_passed = .TRUE.
+      ELSE
+        CALL WRFU_TimeIntervalGet( computed_ti, timeString=computed_str, rc=rc )
+        CALL test_check_error( WRFU_SUCCESS, rc, &
+                              TRIM(itestname)//'WRFU_TimeGet() ', &
+                              __FILE__ , &
+                              __LINE__  )
+        ! handle fractions
+        CALL fraction_to_stringi8( computed_ti%basetime%Sn, &
+                                   computed_ti%basetime%Sd, frac_str )
+        computed_str = TRIM(computed_str)//TRIM(frac_str)
+      ENDIF
+    ENDIF
+    IF ( test_passed ) THEN
+      WRITE(*,FMT='(A)') 'PASS:  '//TRIM(itestname)
+    ELSE
+      WRITE(*,*) 'FAIL:  ',TRIM(itestname),':  (',                        &
+        TRIM(res_type_str),' = ',TRIM(op1_type_str),' ',TRIM(op_str),' ', &
+        TRIM(op2_type_str),')  expected ',                                &
+        TRIM(res_str),' = ',TRIM(op1_str),' ',TRIM(op_str),' ',           &
+        TRIM(op2_str),'  but computed ',TRIM(computed_str)
+    ENDIF
+
+  END SUBROUTINE test_arithmetic
+
+
+
+  ! Test adjust_io_timestr 
+  SUBROUTINE test_adjust_io_timestr( TI_h, TI_m, TI_s, &
+    CT_yy,  CT_mm,  CT_dd,  CT_h,  CT_m,  CT_s,        &
+    ST_yy,  ST_mm,  ST_dd,  ST_h,  ST_m,  ST_s,        &
+    res_str, testname )
+    INTEGER, INTENT(IN) :: TI_H
+    INTEGER, INTENT(IN) :: TI_M
+    INTEGER, INTENT(IN) :: TI_S
+    INTEGER, INTENT(IN) :: CT_YY
+    INTEGER, INTENT(IN) :: CT_MM  ! month
+    INTEGER, INTENT(IN) :: CT_DD  ! day of month
+    INTEGER, INTENT(IN) :: CT_H
+    INTEGER, INTENT(IN) :: CT_M
+    INTEGER, INTENT(IN) :: CT_S
+    INTEGER, INTENT(IN) :: ST_YY
+    INTEGER, INTENT(IN) :: ST_MM  ! month
+    INTEGER, INTENT(IN) :: ST_DD  ! day of month
+    INTEGER, INTENT(IN) :: ST_H
+    INTEGER, INTENT(IN) :: ST_M
+    INTEGER, INTENT(IN) :: ST_S
+    CHARACTER (LEN=*), INTENT(IN) :: res_str
+    CHARACTER (LEN=*), INTENT(IN) :: testname
+    ! locals
+    TYPE(WRFU_TimeInterval) :: TI
+    TYPE(WRFU_Time) :: CT, ST
+    LOGICAL :: test_passed
+    INTEGER :: rc
+    CHARACTER(LEN=WRFU_MAXSTR) :: TI_str, CT_str, ST_str, computed_str
+    ! TI
+    CALL WRFU_TimeIntervalSet( TI, H=TI_H, M=TI_M, S=TI_S, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                           TRIM(testname)//'WRFU_TimeIntervalSet() ', &
+                           __FILE__ , &
+                           __LINE__  )
+    CALL WRFU_TimeIntervalGet( TI, timeString=TI_str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(testname)//'WRFU_TimeGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+    ! CT
+    CALL WRFU_TimeSet( CT, YY=CT_YY, MM=CT_MM, DD=CT_DD , &
+                            H=CT_H,   M=CT_M,   S=CT_S, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                           TRIM(testname)//'WRFU_TimeSet() ', &
+                           __FILE__ , &
+                           __LINE__  )
+    CALL WRFU_TimeGet( CT, timeString=CT_str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(testname)//'WRFU_TimeGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+    ! ST
+    CALL WRFU_TimeSet( ST, YY=ST_YY, MM=ST_MM, DD=ST_DD , &
+                            H=ST_H,   M=ST_M,   S=ST_S, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                           TRIM(testname)//'WRFU_TimeSet() ', &
+                           __FILE__ , &
+                           __LINE__  )
+    CALL WRFU_TimeGet( ST, timeString=ST_str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(testname)//'WRFU_TimeGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+
+    ! Test
+    CALL adjust_io_timestr ( TI, CT, ST, computed_str )
+
+    ! check result
+    test_passed = .FALSE.
+    IF ( LEN_TRIM(res_str) == LEN_TRIM(computed_str) ) THEN
+      IF ( res_str(1:LEN_TRIM(res_str)) == computed_str(1:LEN_TRIM(computed_str)) ) THEN
+        test_passed = .TRUE.
+      ENDIF
+    ENDIF
+
+    ! print result
+    IF ( test_passed ) THEN
+      WRITE(*,FMT='(A)') 'PASS:  '//TRIM(testname)
+    ELSE
+      WRITE(*,*) 'FAIL:  ',TRIM(testname),':  adjust_io_timestr(',    &
+        TRIM(TI_str),',',TRIM(CT_str),',',TRIM(ST_str),')  expected <', &
+        TRIM(res_str),'>  but computed <',TRIM(computed_str),'>'
+    ENDIF
+
+  END SUBROUTINE test_adjust_io_timestr
+
+
+
+  ! simple clock creation and advance with add-subtract tests thrown in
+  ! no self checks (yet)
+  SUBROUTINE test_clock_advance(                                              &
+    start_yy, start_mm, start_dd, start_h, start_m, start_s,                  &
+     stop_yy,  stop_mm,  stop_dd,  stop_h,  stop_m,  stop_s,                  &
+    timestep_d, timestep_h, timestep_m, timestep_s, timestep_sn, timestep_sd, &
+    testname, increment_S, increment_Sn, increment_Sd )
+    INTEGER, INTENT(IN), OPTIONAL :: start_YY
+    INTEGER, INTENT(IN), OPTIONAL :: start_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: start_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: start_H
+    INTEGER, INTENT(IN), OPTIONAL :: start_M
+    INTEGER, INTENT(IN), OPTIONAL :: start_S
+    INTEGER, INTENT(IN), OPTIONAL :: stop_YY
+    INTEGER, INTENT(IN), OPTIONAL :: stop_MM  ! month
+    INTEGER, INTENT(IN), OPTIONAL :: stop_DD  ! day of month
+    INTEGER, INTENT(IN), OPTIONAL :: stop_H
+    INTEGER, INTENT(IN), OPTIONAL :: stop_M
+    INTEGER, INTENT(IN), OPTIONAL :: stop_S
+    INTEGER, INTENT(IN), OPTIONAL :: timestep_D  ! day
+    INTEGER, INTENT(IN), OPTIONAL :: timestep_H
+    INTEGER, INTENT(IN), OPTIONAL :: timestep_M
+    INTEGER, INTENT(IN), OPTIONAL :: timestep_S
+    INTEGER, INTENT(IN), OPTIONAL :: timestep_Sn
+    INTEGER, INTENT(IN), OPTIONAL :: timestep_Sd
+    CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: testname
+    INTEGER, INTENT(IN), OPTIONAL :: increment_S  ! add and subtract this 
+    INTEGER, INTENT(IN), OPTIONAL :: increment_Sn ! value each time step
+    INTEGER, INTENT(IN), OPTIONAL :: increment_Sd
+
+    ! locals
+    INTEGER :: istart_YY
+    INTEGER :: istart_MM  ! month
+    INTEGER :: istart_DD  ! day of month
+    INTEGER :: istart_H
+    INTEGER :: istart_M
+    INTEGER :: istart_S
+    INTEGER :: istop_YY
+    INTEGER :: istop_MM  ! month
+    INTEGER :: istop_DD  ! day of month
+    INTEGER :: istop_H
+    INTEGER :: istop_M
+    INTEGER :: istop_S
+    INTEGER :: itimestep_D  ! day
+    INTEGER :: itimestep_H
+    INTEGER :: itimestep_M
+    INTEGER :: itimestep_S
+    INTEGER :: itimestep_Sn
+    INTEGER :: itimestep_Sd
+    CHARACTER (LEN=512) :: itestname, itestfullname
+    INTEGER :: iincrement_S
+    INTEGER :: iincrement_Sn
+    INTEGER :: iincrement_Sd
+    INTEGER rc
+    TYPE(WRFU_Time)           :: start_time, stop_time, current_time
+    TYPE(WRFU_Clock), POINTER :: domain_clock
+    TYPE(WRFU_TimeInterval)   :: timestep, increment
+    TYPE(WRFU_Time)           :: add_time, subtract_time
+    INTEGER :: itimestep
+    CHARACTER(LEN=WRFU_MAXSTR) :: str, frac_str
+
+    istart_YY = 0
+    istart_MM = 1  !see above
+    istart_DD = 1  !see above
+    istart_H = 0
+    istart_M = 0
+    istart_S = 0
+    istop_YY = 0
+    istop_MM = 1  !see above
+    istop_DD = 1  !see above
+    istop_H = 0
+    istop_M = 0
+    istop_S = 0
+    itimestep_D = 0
+    itimestep_H = 0
+    itimestep_M = 0
+    itimestep_S = 0
+    itimestep_Sn = 0
+    itimestep_Sd = 0
+    itestname = ''
+    iincrement_S = 0
+    iincrement_Sn = 0
+    iincrement_Sd = 0
+
+    IF ( PRESENT( start_YY ) ) istart_YY = start_YY
+    IF ( PRESENT( start_MM ) ) istart_MM = start_MM
+    IF ( PRESENT( start_DD ) ) istart_DD = start_DD
+    IF ( PRESENT( start_H ) ) istart_H = start_H
+    IF ( PRESENT( start_M ) ) istart_M = start_M
+    IF ( PRESENT( start_S ) ) istart_S = start_S
+    IF ( PRESENT( stop_YY ) ) istop_YY = stop_YY
+    IF ( PRESENT( stop_MM ) ) istop_MM = stop_MM
+    IF ( PRESENT( stop_DD ) ) istop_DD = stop_DD
+    IF ( PRESENT( stop_H ) ) istop_H = stop_H
+    IF ( PRESENT( stop_M ) ) istop_M = stop_M
+    IF ( PRESENT( stop_S ) ) istop_S = stop_S
+    IF ( PRESENT( timestep_D ) ) itimestep_D = timestep_D
+    IF ( PRESENT( timestep_H ) ) itimestep_H = timestep_H
+    IF ( PRESENT( timestep_M ) ) itimestep_M = timestep_M
+    IF ( PRESENT( timestep_S ) ) itimestep_S = timestep_S
+    IF ( PRESENT( timestep_Sn ) ) itimestep_Sn = timestep_Sn
+    IF ( PRESENT( timestep_Sd ) ) itimestep_Sd = timestep_Sd
+    IF ( PRESENT( testname ) ) itestname = TRIM(testname)//'_'
+    IF ( PRESENT( increment_S ) ) iincrement_S = increment_S
+    IF ( PRESENT( increment_Sn ) ) iincrement_Sn = increment_Sn
+    IF ( PRESENT( increment_Sd ) ) iincrement_Sd = increment_Sd
+
+    ! Initialize start time, stop time, time step, clock for simple case. 
+    itestfullname = TRIM(itestname)//'SETUP'
+    CALL WRFU_TimeSet( start_time, YY=istart_YY, MM=istart_MM, DD=istart_DD , &
+                                   H=istart_H, M=istart_M, S=istart_S, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeSet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+
+    CALL WRFU_TimeGet( start_time, timeString=str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+    WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),':  start_time = <',TRIM(str),'>'
+
+    CALL WRFU_TimeSet( stop_time, YY=istop_YY, MM=istop_MM, DD=istop_DD , &
+                                   H=istop_H, M=istop_M, S=istop_S, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeSet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+
+    CALL WRFU_TimeGet( stop_time, timeString=str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+    WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),':  stop_time = <',TRIM(str),'>'
+
+    CALL WRFU_TimeIntervalSet( timestep, D=itimestep_D, H=itimestep_H, &
+                                         M=itimestep_M, S=itimestep_S, &
+                                         Sn=itimestep_Sn, Sd=itimestep_Sd, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeIntervalSet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+
+    CALL WRFU_TimeIntervalGet( timestep, timeString=str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeIntervalGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+    ! handle fractions
+    CALL fraction_to_stringi8( timestep%basetime%Sn, &
+                               timestep%basetime%Sd, frac_str )
+    str = TRIM(str)//TRIM(frac_str)
+    WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),':  timestep = <',TRIM(str),'>'
+
+    CALL WRFU_TimeIntervalSet( increment, S=iincrement_S, &
+                               Sn=iincrement_Sn, Sd=iincrement_Sd, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeIntervalSet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+
+    CALL WRFU_TimeIntervalGet( increment, timeString=str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeIntervalGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+    ! handle fractions
+    CALL fraction_to_stringi8( increment%basetime%Sn, &
+                               increment%basetime%Sd, frac_str )
+    str = TRIM(str)//TRIM(frac_str)
+    WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),':  increment = <',TRIM(str),'>'
+
+    ALLOCATE( domain_clock )
+    domain_clock = WRFU_ClockCreate( TimeStep= timestep,  &
+                                     StartTime=start_time, &
+                                     StopTime= stop_time,  &
+                                     rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_ClockCreate() ', &
+                          __FILE__ , &
+                          __LINE__  )
+
+    CALL WRFU_ClockGet( domain_clock, CurrTime=current_time, &
+                        rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_ClockGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+
+    CALL WRFU_TimeGet( current_time, timeString=str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+    CALL fraction_to_stringi8( current_time%basetime%Sn, &
+                               current_time%basetime%Sd, frac_str )
+    str = TRIM(str)//TRIM(frac_str)
+    WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),':  clock current_time = <',TRIM(str),'>'
+
+    subtract_time = current_time - increment
+    CALL WRFU_TimeGet( subtract_time, timeString=str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+    CALL fraction_to_stringi8( subtract_time%basetime%Sn, &
+                               subtract_time%basetime%Sd, frac_str )
+    str = TRIM(str)//TRIM(frac_str)
+    WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),':  current_time-increment = <',TRIM(str),'>'
+
+    add_time = current_time + increment
+    CALL WRFU_TimeGet( add_time, timeString=str, rc=rc )
+    CALL test_check_error( WRFU_SUCCESS, rc, &
+                          TRIM(itestfullname)//'WRFU_TimeGet() ', &
+                          __FILE__ , &
+                          __LINE__  )
+    CALL fraction_to_stringi8( add_time%basetime%Sn, &
+                               add_time%basetime%Sd, frac_str )
+    str = TRIM(str)//TRIM(frac_str)
+    WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),':  current_time+increment = <',TRIM(str),'>'
+
+    ! Advance clock.  
+    itestfullname = TRIM(itestname)//'ADVANCE'
+    itimestep = 0
+    DO WHILE ( .NOT. WRFU_ClockIsStopTime(domain_clock ,rc=rc) )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestfullname)//'WRFU_ClockIsStopTime() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      itimestep = itimestep + 1
+
+      CALL WRFU_ClockAdvance( domain_clock, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestfullname)//'WRFU_ClockAdvance() ', &
+                            __FILE__ , &
+                            __LINE__  )
+
+      CALL WRFU_ClockGet( domain_clock, CurrTime=current_time, &
+                          rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestfullname)//'WRFU_ClockGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+
+      CALL WRFU_TimeGet( current_time, timeString=str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestfullname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      CALL fraction_to_stringi8( current_time%basetime%Sn, &
+                                 current_time%basetime%Sd, frac_str )
+      str = TRIM(str)//TRIM(frac_str)
+      WRITE(*,FMT='(A,A,I6.6,A,A,A)') TRIM(itestfullname),':  count = ', &
+        itimestep,'  current_time = <',TRIM(str),'>'
+
+      subtract_time = current_time - increment
+      CALL WRFU_TimeGet( subtract_time, timeString=str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestfullname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      CALL fraction_to_stringi8( subtract_time%basetime%Sn, &
+                                 subtract_time%basetime%Sd, frac_str )
+      str = TRIM(str)//TRIM(frac_str)
+      WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),':  current_time-increment = <',TRIM(str),'>'
+
+      add_time = current_time + increment
+      CALL WRFU_TimeGet( add_time, timeString=str, rc=rc )
+      CALL test_check_error( WRFU_SUCCESS, rc, &
+                            TRIM(itestfullname)//'WRFU_TimeGet() ', &
+                            __FILE__ , &
+                            __LINE__  )
+      CALL fraction_to_stringi8( add_time%basetime%Sn, &
+                                 add_time%basetime%Sd, frac_str )
+      str = TRIM(str)//TRIM(frac_str)
+      WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),':  current_time+increment = <',TRIM(str),'>'
+
+    ENDDO
+
+    DEALLOCATE( domain_clock )
+  
+  END SUBROUTINE test_clock_advance
+
+END MODULE my_tests
+
+
+#if defined( ESMF_TIME_F90_ONLY ) 
+
+! TBH:  Improve the build of Test1.exe to use WRF versions of these 
+! TBH:  routines and remove these hacked-in duplicates!!  
+
+SUBROUTINE wrf_abort
+  IMPLICIT NONE
+#if defined( DM_PARALLEL ) && ! defined( STUBMPI )
+  INCLUDE 'mpif.h'
+  INTEGER ierr
+  CALL mpi_abort(MPI_COMM_WORLD,1,ierr)
+#else
+  STOP
+#endif
+END SUBROUTINE wrf_abort
+
+SUBROUTINE wrf_message( str )
+  IMPLICIT NONE
+  CHARACTER*(*) str
+#if defined( DM_PARALLEL ) && ! defined( STUBMPI)
+  write(0,*) str
+#endif
+  print*, str
+END SUBROUTINE wrf_message
+
+! intentionally write to stderr only
+SUBROUTINE wrf_message2( str )
+  IMPLICIT NONE
+  CHARACTER*(*) str
+  write(0,*) str
+END SUBROUTINE wrf_message2
+
+SUBROUTINE wrf_error_fatal3( file_str, line, str )
+  USE my_tests
+  IMPLICIT NONE
+  CHARACTER*(*) file_str
+  INTEGER , INTENT (IN) :: line  ! only print file and line if line > 0
+  CHARACTER*(*) str
+  CHARACTER*256 :: line_str
+  write(line_str,'(i6)') line
+  ! special behavior for testing since Fortran cannot catch exceptions
+ IF ( WRF_ERROR_FATAL_PRINT ) THEN
+  ! just print message and continue
+  CALL wrf_message( 'ERROR IN FILE:  '//TRIM(file_str)//'  LINE:  '//TRIM(line_str) )
+ ELSE
+  ! normal behavior
+#if defined( DM_PARALLEL ) && ! defined( STUBMPI )
+  CALL wrf_message( '-------------- FATAL CALLED ---------------' )
+  ! only print file and line if line is positive
+  IF ( line > 0 ) THEN
+    CALL wrf_message( 'FATAL CALLED FROM FILE:  '//file_str//'  LINE:  '//TRIM(line_str) )
+  ENDIF
+  CALL wrf_message( str )
+  CALL wrf_message( '-------------------------------------------' )
+#else
+  CALL wrf_message2( '-------------- FATAL CALLED ---------------' )
+  ! only print file and line if line is positive
+  IF ( line > 0 ) THEN
+    CALL wrf_message( 'FATAL CALLED FROM FILE:  '//file_str//'  LINE:  '//TRIM(line_str) )
+  ENDIF
+  CALL wrf_message2( str )
+  CALL wrf_message2( '-------------------------------------------' )
+#endif
+  CALL wrf_abort
+ ENDIF
+END SUBROUTINE wrf_error_fatal3
+
+SUBROUTINE wrf_error_fatal( str )
+  IMPLICIT NONE
+  CHARACTER*(*) str
+  CALL wrf_error_fatal3 ( ' ', 0, str )
+END SUBROUTINE wrf_error_fatal
+
+
+! Converts an WRFU_Time object into a WRF date-time string.
+! The format of the WRF date-time strings is a slight variant on ISO 8601:
+! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss".
+SUBROUTINE wrf_timetoa ( time, str )
+   USE module_utility
+   IMPLICIT NONE
+   TYPE(WRFU_Time),   INTENT( IN) :: time
+   CHARACTER (LEN=*), INTENT(OUT) :: str
+   INTEGER rc
+   CHARACTER (LEN=256) :: mess
+   CALL WRFU_TimeGet( time, timeString=str, rc=rc )
+   CALL test_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_TimeGet() in wrf_timetoa() FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+   ! change ISO 8601 'T' to WRF '_'
+   str(11:11) = '_'
+!   WRITE (mess,*) 'DEBUG wrf_timetoa():  returning with str = [',TRIM(str),']'
+!   CALL wrf_debug ( 150 , mess )
+   RETURN
+END SUBROUTINE wrf_timetoa
+
+
+! This is a test for the adjust_output_times capability in WRF, which is
+! implemented with the adjust_io_timestr subroutine, defined in
+! share/module_io_domain.F.
+! 
+! If the time manager (including the WRF extension
+! WRFU_TimeIntervalDIVQuot, defined as WRFADDITION_TimeIntervalDIVQuot in
+! ESMF_TimeInterval.F90) is working properly, it should behave as:
+! 
+! Given:
+! 
+!     CT = 2000-01-26_00:00:00   (current time)
+!     ST = 2000-01-24_12:00:00   (start time)
+!     TI = 00000_03:00:00        (time interval)
+! 
+! the resulting time string should be:
+! 
+!     2000-01-26_00:00:00
+! 
+! If CT is perturbed slightly, e.g. 2000-01-26_00:00:03, the resulting
+! time string should still be 2000-01-26_00:00:00
+! 
+SUBROUTINE adjust_io_timestr ( TI, CT, ST, timestr )
+   USE module_utility
+   IMPLICIT NONE
+! Args
+   TYPE(WRFU_Time), INTENT(IN)            :: ST,CT    ! domain start and current time
+   TYPE(WRFU_TimeInterval), INTENT(IN)    :: TI       ! interval
+   CHARACTER*(*), INTENT(INOUT)           :: timestr  ! returned string
+! Local
+   TYPE(WRFU_Time)                        :: OT
+   TYPE(WRFU_TimeInterval)                :: IOI
+   INTEGER                                :: n
+
+   IOI = CT-ST                               ! length of time since starting
+   n = WRFU_TimeIntervalDIVQuot( IOI , TI )  ! number of whole time intervals
+   IOI = TI * n                              ! amount of time since starting in whole time intervals
+   OT = ST + IOI                             ! previous nearest time instant
+   CALL wrf_timetoa( OT, timestr )           ! generate string
+   RETURN
+END SUBROUTINE adjust_io_timestr
+
+
+#endif
+
+
+! Check to see if expected value == actual value
+! If not, print message and exit.
+SUBROUTINE test_check_error( expected, actual, str, file_str, line )
+  IMPLICIT NONE
+  INTEGER , INTENT (IN) :: expected
+  INTEGER , INTENT (IN) :: actual
+  CHARACTER*(*) str
+  CHARACTER*(*) file_str
+  INTEGER , INTENT (IN) :: line
+  CHARACTER (LEN=512)   :: rc_str
+  CHARACTER (LEN=512)   :: str_with_rc
+  IF ( expected .ne. actual ) THEN
+    WRITE (rc_str,*) '  Routine returned error code = ',actual
+    str_with_rc = 'FAIL:  '//TRIM(str)//TRIM(rc_str)
+    CALL wrf_error_fatal3( file_str, line, str_with_rc )
+  ENDIF
+END SUBROUTINE test_check_error
+
+
+
+PROGRAM time_manager_test
+  USE module_utility
+  USE my_tests
+  IMPLICIT NONE
+  INTEGER :: rc
+
+  PRINT *,'BEGIN TEST SUITE'
+
+  CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
+  CALL test_check_error( WRFU_SUCCESS, rc, &
+                        'WRFU_Initialize() ', &
+                        __FILE__ , &
+                        __LINE__  )
+  PRINT *,'DEBUG:  back from WRFU_Initialize(), rc = ',rc
+
+!  CALL test_print(  t_yy,  t_mm,  t_dd,  t_h,  t_m,  t_s, &
+!                   ti_yy, ti_mm, ti_dd, ti_h, ti_m, ti_s, &
+!                   res_str, testname )
+
+  ! Print times
+  ! "vanilla" tests
+!  PRINT *,'DEBUG:  calling 1st test_print()'
+  CALL test_print( t_yy=2025,  t_mm=03,  t_dd=23,  t_h=1,  t_m=20,  t_s=10, &
+    res_str='2025-03-23_01:20:10', testname='printT_1' )
+!  PRINT *,'DEBUG:  back from 1st test_print()'
+  CALL test_print( t_yy=2000,  t_mm=1,  t_dd=1,  t_h=0,  t_m=0,  t_s=0, &
+    res_str='2000-01-01_00:00:00', testname='printT_2' )
+  CALL test_print( t_yy=2026,  t_mm=07,  t_dd=74,  t_h=23,  t_m=36,  t_s=90, &
+    res_str='2026-07-74_23:36:90', testname='printT_3' )
+  CALL test_print( t_yy=2026,  t_mm=07,  t_dd=75,  t_h=23,  t_m=36,  t_s=90, &
+    res_str='2026-07-75_23:36:90', testname='printT_4' )
+!  CALL test_print( t_yy=2004,  t_mm=12,  t_dd=30,  t_h=23,  t_m=59,  t_s=50, &
+!    res_str='2004-12-30_23:59:50', testname='printT_5' )
+!  CALL test_print( t_yy=2004,  t_mm=12,  t_dd=31,  t_h=23,  t_m=59,  t_s=50, &
+!    res_str='2004-12-31_23:59:50', testname='printT_6' )
+!!$$$  NOTE that this fails -- need to fix up output string for negative year
+!!  CALL test_print( t_yy=-2004,  t_mm=12,  t_dd=31,  t_h=23,  t_m=59,  t_s=50, &
+!!    res_str='-2004-12-31_23:59:50', testname='printT_6' )
+
+!  ! these test default behavior of test harness
+!  CALL test_print( t_s=0, &
+!    res_str='0000-00-00_00:00:00', testname='printT_D1' )
+!  CALL test_print( t_yy=0, &
+!    res_str='0000-00-00_00:00:00', testname='printT_D2' )
+
+  PRINT *,'yeah yeah yeah'
+
+
+!  ! fractions
+!  CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+!    t_sn=1, t_sd=3, &
+!    res_str='2001-12-03_01:20:10+01/03', testname='printT_F1' )
+!  CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+!    t_sn=4, t_sd=3, &
+!    res_str='2001-12-03_01:20:11+01/03', testname='printT_F2' )
+!  CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+!    t_sn=12, t_sd=3, &
+!    res_str='2001-12-03_01:20:14', testname='printT_F3' )
+!  CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+!    t_sn=-1, t_sd=3, &
+!    res_str='2001-12-03_01:20:09+02/03', testname='printT_F4' )
+
+  ! ERROR, MM out of range
+!$$$here...  fix so this just prints "ERROR:  <testname>" in failure case
+!$$$here...  also need "expect_fail" to reverse sense of PASS/FAIL message for 
+!$$$here...  tests that should fail
+!  CALL test_print( t_yy=2001,  t_mm=13,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+!    res_str='2002-01-03_01:20:10', testname='printT_E1', expect_error=.TRUE. )
+
+  ! Print time intervals
+  ! "vanilla" tests
+  CALL test_print( ti_yy=0,  ti_mm=0,  ti_dd=0,  ti_h=0,  ti_m=0,  ti_s=0, &
+    res_str='0000000000_000:000:000', testname='printTI_1' )
+  CALL test_print( ti_yy=0,  ti_mm=0,  ti_dd=500,  ti_h=0,  ti_m=0,  ti_s=9510, &
+    res_str='0000000500_002:021:010', testname='printTI_2' )
+
+!  ! these test default behavior of test harness
+!  CALL test_print( ti_s=0, &
+!    res_str='0000000000_000:000:000', testname='printTI_D1' )
+!  CALL test_print( ti_yy=0, &
+!    res_str='0000000000_000:000:000', testname='printTI_D2' )
+
+!  ! these test negative values
+!  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=-1,  ti_m=-20,  ti_s=-10, &
+!    res_str='-0000000003_001:020:010', testname='printTI_N1' )
+!
+!  ! these test mixed values
+!  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=1,  ti_m=20,  ti_s=10, &
+!    res_str='-0000000002_022:039:050', testname='printTI_M1' )
+!
+!  ! fractions
+!  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=3,  ti_h=1,  ti_m=20,  ti_s=10, &
+!    ti_sn=1, ti_sd=3, &
+!    res_str='0000000003_001:020:010+01/03', testname='printTI_F1' )
+!  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=3,  ti_h=1,  ti_m=20,  ti_s=10, &
+!    ti_sn=5, ti_sd=3, &
+!    res_str='0000000003_001:020:011+02/03', testname='printTI_F2' )
+!  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=-1,  ti_m=-20,  ti_s=-10, &
+!    ti_sn=-1, ti_sd=3, &
+!    res_str='-0000000003_001:020:010-01/03', testname='printTI_F3' )
+!  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=-1,  ti_m=-20,  ti_s=-10, &
+!    ti_sn=1, ti_sd=3, &
+!    res_str='-0000000003_001:020:009-02/03', testname='printTI_F4' )
+!
+
+  ! these test non-normalized values
+!  CALL test_print( ti_yy=2001,  ti_mm=1,  ti_dd=3,  ti_h=1,  ti_m=20,  ti_s=10, &
+!    res_str='02001-001-003_001:020:010', testname='printTI_NN1', expect_error=.TRUE. )
+!  CALL test_print( ti_yy=2001,  ti_mm=12,  ti_dd=3,  ti_h=1,  ti_m=20,  ti_s=10, &
+!    res_str='02002-000-003_001:020:010', testname='printTI_NN2', expect_error=.TRUE. )
+!  CALL test_print( ti_yy=2002,  ti_mm=5,  ti_dd=500,  ti_h=0,  ti_m=0,  ti_s=7270, &
+!    res_str='02002-005-500_002:001:010', testname='printTI_NN3', expect_error=.TRUE. )
+
+
+!  CALL test_arithmetic( add_op=,                                 &
+!     op1_t_yy,  op1_t_mm,  op1_t_dd,  op1_t_h,  op1_t_m,  op1_t_s, &
+!    op1_ti_yy, op1_ti_mm, op1_ti_dd, op1_ti_h, op1_ti_m, op1_ti_s, &
+!     op2_t_yy,  op2_t_mm,  op2_t_dd,  op2_t_h,  op2_t_m,  op2_t_s, &
+!    op2_ti_yy, op2_ti_mm, op2_ti_dd, op2_ti_h, op2_ti_m, op2_ti_s, &
+!     res_t_yy,  res_t_mm,  res_t_dd,  res_t_h,  res_t_m,  res_t_s, &
+!    res_ti_yy, res_ti_mm, res_ti_dd, res_ti_h, res_ti_m, res_ti_s, &
+!    testname )
+
+  ! Addition tests
+  ! ESMF_Time = ESMF_Time + ESMF_TimeInterval
+  CALL test_arithmetic( add_op=.TRUE.,                                             &
+     op1_t_yy=2026,  op1_t_mm=03,  op1_t_dd=23,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=3, op2_ti_m=10, op2_ti_s=10, &
+     res_t_yy=2026,  res_t_mm=03,  res_t_dd=23,  res_t_h=4,  res_t_m=30,  res_t_s=20, &
+    testname='AddT_T_TI1' )
+  CALL test_arithmetic( add_op=.TRUE.,                                             &
+     op1_t_yy=2001,  op1_t_mm=07,  op1_t_dd=75,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+     res_t_yy=2002,  res_t_mm= 1,  res_t_dd=1,  res_t_h=3,  res_t_m=03,  res_t_s=10, &
+    testname='AddT_T_TI2' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2004,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI3' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2005,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI4' )
+!  ! this case hung after the CCSM contribution
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2004,  res_t_mm=12,  res_t_dd=31,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI5' )
+!! NOTE:  CCSM folks need to decide what it means to add "1 month" to Feb. 29.  And all the 
+!        other very similar cases.  Then, write this unit test!  
+!!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!!!     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   2, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!!     res_t_yy=2007,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+!!    testname='AddT_T_TI6' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2005,  res_t_mm=12,  res_t_dd=30,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI7' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=367, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2006,  res_t_mm=01,  res_t_dd=01,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI8' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2004,  res_t_mm=12,  res_t_dd=29,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI9' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2004,  res_t_mm=12,  res_t_dd=30,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI10' )
+  CALL test_arithmetic( add_op=.TRUE.,                                             &
+     op1_t_yy=2003,  op1_t_mm=03,  op1_t_dd=23,  op1_t_h=0,  op1_t_m=0,  op1_t_s=0, &
+    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=675, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+     res_t_yy=2004,  res_t_mm=03,  res_t_dd=29,  res_t_h=4,  res_t_m=10,  res_t_s=10, &
+    testname='AddT_T_TI11' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=368, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2005,  res_t_mm=01,  res_t_dd=01,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI12' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2005,  res_t_mm=03,  res_t_dd=30,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI13' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2005,  res_t_mm=03,  res_t_dd=31,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI14' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2005,  res_t_mm=04,  res_t_dd=01,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_T_TI15' )
+!  ! ESMF_Time = ESMF_Time + ESMF_TimeInterval with fractions
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+!     op1_t_sn=01,  op1_t_sd=03, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!    op2_ti_sn=01, op2_ti_sd=03, &
+!     res_t_yy=2005,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+!     res_t_sn=02,  res_t_sd=03, &
+!    testname='AddT_T_TI_F1' )
+!  ! this should fail (and does)
+!!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!!     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+!!     op1_t_sn=01,  op1_t_sd=03, &
+!!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!!    op2_ti_sn=01, op2_ti_sd=03, &
+!!     res_t_yy=2005,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+!!     res_t_sn=01,  res_t_sd=03, &
+!!    testname='AddT_T_TI_F2' )
+!  ! ESMF_Time = ESMF_TimeInterval + ESMF_Time
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!    op1_ti_yy=   0, op1_ti_mm= 0, op1_ti_dd=0, op1_ti_h=3, op1_ti_m=10, op1_ti_s=10, &
+!     op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=3,  op2_t_h=1,  op2_t_m=20,  op2_t_s=10, &
+!     res_t_yy=2001,  res_t_mm=12,  res_t_dd=3,  res_t_h=4,  res_t_m=30,  res_t_s=20, &
+!    testname='AddT_TI_T1' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!    op1_ti_yy=   0, op1_ti_mm= 0, op1_ti_dd=0, op1_ti_h=4, op1_ti_m=10, op1_ti_s=10, &
+!     op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=31,  op2_t_h=22,  op2_t_m=30,  op2_t_s=00, &
+!     res_t_yy=2002,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+!    testname='AddT_TI_T2' )
+!  ! ESMF_TimeInterval = ESMF_TimeInterval + ESMF_TimeInterval
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+!    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=4, res_ti_h=2, res_ti_m=30, res_ti_s=20, &
+!    testname='AddTI_TI_TI1' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-3, op1_ti_h=-1, op1_ti_m=-20, op1_ti_s=-10, &
+!    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-2, res_ti_h=0, res_ti_m=-10, res_ti_s=00, &
+!    testname='AddTI_TI_TI2' )
+!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-3, op1_ti_h=-1, op1_ti_m=-20, op1_ti_s=-10, &
+!    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-1, op2_ti_h=-1, op2_ti_m=-10, op2_ti_s=-10, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-4, res_ti_h=-2, res_ti_m=-30, res_ti_s=-20, &
+!    testname='AddTI_TI_TI3' )
+!
+
+!  ! Subtraction tests
+!  ! ESMF_Time = ESMF_Time - ESMF_TimeInterval
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2001,  op1_t_mm=12,  op1_t_dd=3,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=3, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2001,  res_t_mm=12,  res_t_dd=2,  res_t_h=22, res_t_m=10,  res_t_s=0,  &
+!   testname='SubtractT_T_TI1' )
+! CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2005,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=0,  &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, &
+!     res_t_yy=2004,  res_t_mm=12,  res_t_dd=31, res_t_h=23, res_t_m=59,  res_t_s=50, &
+!    testname='SubtractT_T_TI2' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2004,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=0,  &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, &
+!     res_t_yy=2003,  res_t_mm=12,  res_t_dd=31, res_t_h=23, res_t_m=59,  res_t_s=50, &
+!    testname='SubtractT_T_TI3' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2003,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=0,  &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, &
+!     res_t_yy=2002,  res_t_mm=12,  res_t_dd=31, res_t_h=23, res_t_m=59,  res_t_s=50, &
+!    testname='SubtractT_T_TI4' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                             &
+!     op1_t_yy=2005,  op1_t_mm=04,  op1_t_dd=01,  op1_t_h=2,  op1_t_m=40,  op1_t_s=10, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2004,  res_t_mm=03,  res_t_dd=30,  res_t_h=4,  res_t_m=30,  res_t_s=00, &
+!    testname='SubtractT_T_TI5' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                             &
+!     op1_t_yy=2006,  op1_t_mm=01,  op1_t_dd=01,  op1_t_h=8,  op1_t_m=40,  op1_t_s=10, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=367, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+!     res_t_yy=2004,  res_t_mm=12,  res_t_dd=30,  res_t_h=4,  res_t_m=30,  res_t_s=00, &
+!    testname='SubtractT_T_TI6' )
+!  ! ESMF_Time = ESMF_Time - ESMF_TimeInterval with fractions
+!  CALL test_arithmetic( add_op=.FALSE.,                                             &
+!     op1_t_yy=2005,  op1_t_mm=01,  op1_t_dd=01,  op1_t_h=00,  op1_t_m=00,  op1_t_s=00, &
+!     op1_t_sn=00,  op1_t_sd=00, &
+!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=01, &
+!    op2_ti_sn=01, op2_ti_sd=03, &
+!     res_t_yy=2004,  res_t_mm=12,  res_t_dd=31,  res_t_h=23,  res_t_m=59,  res_t_s=58, &
+!     res_t_sn=02,  res_t_sd=03, &
+!    testname='SubtractT_T_TI_F1' )
+!  ! ESMF_TimeInterval = ESMF_Time - ESMF_Time
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2001,  op1_t_mm=12,  op1_t_dd=3,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+!     op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=1,  op2_t_h=1,  op2_t_m=10,  op2_t_s=10, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0,  &
+!    testname='SubtractTI_T_T1' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2002,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=31, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+!    testname='SubtractTI_T_T2' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2005,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2004,  op2_t_mm=12,  op2_t_dd=31, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+!    testname='SubtractTI_T_T3' )
+! CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2003,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2003,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+!    testname='SubtractTI_T_T4' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=1, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+!    testname='SubtractTI_T_T5' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2002,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+!    testname='SubtractTI_T_T6' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2003,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=365, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+!    testname='SubtractTI_T_T7' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2004,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2003,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=365, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+!    testname='SubtractTI_T_T8' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2005,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+!    testname='SubtractTI_T_T9' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2003,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+!    testname='SubtractTI_T_T10' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2005,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=367, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+!    testname='SubtractTI_T_T11' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2005,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+!    testname='SubtractTI_T_T12' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=2004,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=23, op1_t_m=59,  op1_t_s=50, &
+!     op2_t_yy=2005,  op2_t_mm=03,  op2_t_dd=01, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-366, res_ti_h=0, res_ti_m=00, res_ti_s=-10, &
+!    testname='SubtractTI_T_T13' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!     op1_t_yy=-2002,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+!     op2_t_yy=-2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+!    testname='SubtractTI_T_T14' )
+!  ! ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+!    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0,  &
+!    testname='SubtractTI_TI_TI1' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+!    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-1, op2_ti_h=-1, op2_ti_m=-10, op2_ti_s=-10, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=4, res_ti_h=2, res_ti_m=30, res_ti_s=20,  &
+!    testname='SubtractTI_TI_TI2' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-1, op1_ti_h=-1, op1_ti_m=-10, op1_ti_s=-10, &
+!    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-3, op2_ti_h=-1, op2_ti_m=-20, op2_ti_s=-10, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=00,  &
+!    testname='SubtractTI_TI_TI3' )
+!  ! Negative result ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!   op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=1, op1_ti_h=1, op1_ti_m=10, op1_ti_s=10, &
+!    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=3, op2_ti_h=1, op2_ti_m=20, op2_ti_s=10, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-2, res_ti_h=0, res_ti_m=-10, res_ti_s=0,  &
+!    testname='SubtractTI_TI_TIN1' )
+!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-1, op1_ti_h=-1, op1_ti_m=-10, op1_ti_s=-10, &
+!    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=3, op2_ti_h=1, op2_ti_m=20, op2_ti_s=10, &
+!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-4, res_ti_h=-2, res_ti_m=-30, res_ti_s=-20,  &
+!    testname='SubtractTI_TI_TIN2' )
+!
+!  ! Un-normalized ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+!  ! this is an error
+!!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+!!    op1_ti_yy=2001, op1_ti_mm=11, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+!!    op2_ti_yy=2001, op2_ti_mm=11, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+!!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0,  &
+!!    testname='SubtractTI_TI_TIU1', expect_error=.TRUE. )
+!
+!  ! this one should FAIL, and does
+!!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+!!     op1_t_yy=2001,  op1_t_mm=12,  op1_t_dd=3,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+!!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=3, op2_ti_m=10, op2_ti_s=10, &
+!!     res_t_yy=2002,  res_t_mm=12,  res_t_dd=3,  res_t_h=4,  res_t_m=30,  res_t_s=20, &
+!!    testname='AddTT1' )
+!
+!  ! Multiplication tests
+!  ! ESMF_TimeInterval = ESMF_TimeInterval * INTEGER
+!  CALL test_arithmetic( multiply_op=.TRUE.,                &
+!    op1_ti_dd=3,  op1_ti_h=12,  op1_ti_m=18,  op1_ti_s=33, &
+!    op2_int=2,                                             &
+!    res_ti_dd=6,  res_ti_h=24, res_ti_m=37,  res_ti_s=06,  &
+!    testname='MultiplyTI_TI_INT1' )
+!  CALL test_arithmetic( multiply_op=.TRUE.,                &
+!    op1_ti_dd=350,  op1_ti_h=23,  op1_ti_m=50,  op1_ti_s=50, &
+!    op2_int=2,                                             &
+!   res_ti_dd=701,  res_ti_h=23, res_ti_m=41,  res_ti_s=40,&
+!    testname='MultiplyTI_TI_INT2' )
+!  CALL test_arithmetic( multiply_op=.TRUE.,                &
+!    op1_ti_s=01, op1_ti_sn=03, op1_ti_sd=04,               &
+!    op2_int=8,                                             &
+!    res_ti_s=14,                                           &
+!   testname='MultiplyTI_TI_INT3' )
+!
+!  ! Division tests
+!  ! ESMF_TimeInterval = ESMF_TimeInterval / INTEGER
+!  CALL test_arithmetic( multiply_op=.FALSE.,               &
+!    op1_ti_dd=3,  op1_ti_h=12,  op1_ti_m=18,  op1_ti_s=33, &
+!    op2_int=3,                                             &
+!    res_ti_dd=1,  res_ti_h=04, res_ti_m=06,  res_ti_s=11,  &
+!    testname='DivideTI_TI_INT1' )
+!  CALL test_arithmetic( multiply_op=.FALSE.,               &
+!    op1_ti_dd=3,  op1_ti_h=12,  op1_ti_m=18,  op1_ti_s=33, &
+!    op2_int=4,                                             &
+!    res_ti_dd=0,  res_ti_h=21, res_ti_m=04,  res_ti_s=38,  &
+!    res_ti_sn=1,  res_ti_sd=4,                             &
+!    testname='DivideTI_TI_INT2' )
+!  CALL test_arithmetic( multiply_op=.FALSE.,               &
+!    op1_ti_s=01, op1_ti_sn=03, op1_ti_sd=04,               &
+!    op2_int=5,                                             &
+!    res_ti_s=0, res_ti_sn=7,  res_ti_sd=20,                &
+!    testname='DivideTI_TI_INT3' )
+!
+!  ! Test adjust_io_timestr()
+!!     CT = 2000-01-26_00:00:00   (current time)
+!!     ST = 2000-01-24_12:00:00   (start time)
+!!     TI = 00000_03:00:00        (time interval)
+!! the resulting time string should be:
+!!     2000-01-26_00:00:00
+!  CALL test_adjust_io_timestr( TI_h=3, TI_m=0, TI_s=0,          &
+!    CT_yy=2000,  CT_mm=1,  CT_dd=26,  CT_h=0,  CT_m=0,  CT_s=0, &
+!    ST_yy=2000,  ST_mm=1,  ST_dd=24,  ST_h=12, ST_m=0,  ST_s=0, &
+!    res_str='2000-01-26_00:00:00', testname='adjust_io_timestr_1' )
+!! this should fail (and does)
+!!  CALL test_adjust_io_timestr( TI_h=3, TI_m=0, TI_s=0,          &
+!!    CT_yy=2000,  CT_mm=1,  CT_dd=26,  CT_h=0,  CT_m=0,  CT_s=0, &
+!!    ST_yy=2000,  ST_mm=1,  ST_dd=24,  ST_h=12, ST_m=0,  ST_s=0, &
+!!    res_str='2000-01-26_00:00:01', testname='adjust_io_timestr_FAIL1' )
+!
+!$$$here...  modify these to add self-test PASS/FAIL output
+  CALL test_clock_advance(                                                    &
+    start_yy=2024, start_mm=01, start_dd=99, start_h=3, start_m=0, start_s=0, &
+     stop_yy=2024,  stop_mm=02,  stop_dd=02,  stop_h=8,  stop_m=0,  stop_s=0, &
+    timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=100,                 &
+    testname="SimpleClockAdvance" )
+
+  PRINT *,'END CLOCK ADVANCE'        
+
+  CALL test_clock_advance(                                                    &
+    start_yy=2024, start_mm=07, start_dd=74, start_h=23, start_m=00, start_s=0, &
+     stop_yy=2025,  stop_mm=01,   stop_dd=07,   stop_h=9,  stop_m=0,  stop_s=0, &
+    timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=1850,                &
+    testname="StdYearClockAdvance", increment_S=10 )
+!
+!  CALL test_clock_advance(                                                    &
+!    start_yy=2004, start_mm=12, start_dd=29, start_h=9, start_m=0, start_s=0, &
+!     stop_yy=2005,  stop_mm=1,   stop_dd=2,   stop_h=9,  stop_m=0,  stop_s=0, &
+!    timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=3600,                &
+!    testname="LeapYearClockAdvance", increment_S=10 )
+!
+!  ! NRCM domain 3 case:  120 seconds / 9 
+!  ! 18 timesteps through end of leap year
+!  CALL test_clock_advance(                                                    &
+!    start_yy=2004, start_mm=12, start_dd=31, start_h=23, start_m=58, start_s=0,&
+!     stop_yy=2005,  stop_mm=1,   stop_dd=1,   stop_h=0,  stop_m=2,  stop_s=0, &
+!    timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=13,                  &
+!    timestep_sn=1, timestep_sd=3,                                             &
+!    testname="LeapYearFractionClockAdvance",                                  &
+!    increment_S=1, increment_Sn=1, increment_Sd=3 )
+!
+  CALL WRFU_Finalize( rc=rc )
+  CALL test_check_error( WRFU_SUCCESS, rc, &
+                        'WRFU_Finalize() ', &
+                        __FILE__ , &
+                        __LINE__  )
+
+  PRINT *,'END TEST SUITE'
+
+END PROGRAM time_manager_test
+
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Test1.out.correct
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Test1.out.correct	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/Test1.out.correct	(revision 2744)
@@ -0,0 +1,1275 @@
+ BEGIN TEST SUITE
+PASS:  printT_1
+PASS:  printT_2
+PASS:  printT_3
+PASS:  printT_4
+PASS:  printT_5
+PASS:  printT_6
+PASS:  printT_D1
+PASS:  printT_D2
+PASS:  printT_F1
+PASS:  printT_F2
+PASS:  printT_F3
+PASS:  printT_F4
+PASS:  printTI_1
+PASS:  printTI_2
+PASS:  printTI_D1
+PASS:  printTI_D2
+PASS:  printTI_N1
+PASS:  printTI_M1
+PASS:  printTI_F1
+PASS:  printTI_F2
+PASS:  printTI_F3
+PASS:  printTI_F4
+PASS:  AddT_T_TI1
+PASS:  AddT_T_TI2
+PASS:  AddT_T_TI3
+PASS:  AddT_T_TI4
+PASS:  AddT_T_TI5
+PASS:  AddT_T_TI7
+PASS:  AddT_T_TI8
+PASS:  AddT_T_TI9
+PASS:  AddT_T_TI10
+PASS:  AddT_T_TI11
+PASS:  AddT_T_TI12
+PASS:  AddT_T_TI13
+PASS:  AddT_T_TI14
+PASS:  AddT_T_TI15
+PASS:  AddT_T_TI_F1
+PASS:  AddT_TI_T1
+PASS:  AddT_TI_T2
+PASS:  AddTI_TI_TI1
+PASS:  AddTI_TI_TI2
+PASS:  AddTI_TI_TI3
+PASS:  SubtractT_T_TI1
+PASS:  SubtractT_T_TI2
+PASS:  SubtractT_T_TI3
+PASS:  SubtractT_T_TI4
+PASS:  SubtractT_T_TI5
+PASS:  SubtractT_T_TI6
+PASS:  SubtractT_T_TI_F1
+PASS:  SubtractTI_T_T1
+PASS:  SubtractTI_T_T2
+PASS:  SubtractTI_T_T3
+PASS:  SubtractTI_T_T4
+PASS:  SubtractTI_T_T5
+PASS:  SubtractTI_T_T6
+PASS:  SubtractTI_T_T7
+PASS:  SubtractTI_T_T8
+PASS:  SubtractTI_T_T9
+PASS:  SubtractTI_T_T10
+PASS:  SubtractTI_T_T11
+PASS:  SubtractTI_T_T12
+PASS:  SubtractTI_T_T13
+PASS:  SubtractTI_T_T14
+PASS:  SubtractTI_TI_TI1
+PASS:  SubtractTI_TI_TI2
+PASS:  SubtractTI_TI_TI3
+PASS:  SubtractTI_TI_TIN1
+PASS:  SubtractTI_TI_TIN2
+PASS:  MultiplyTI_TI_INT1
+PASS:  MultiplyTI_TI_INT2
+PASS:  MultiplyTI_TI_INT3
+PASS:  DivideTI_TI_INT1
+PASS:  DivideTI_TI_INT2
+PASS:  DivideTI_TI_INT3
+PASS:  DivideINT_TI_TI1
+PASS:  DivideINT_TI_TI2
+PASS:  DivideINT_TI_TI3
+PASS:  DivideINT_TI_TI4
+PASS:  DivideINT_TI_TI5
+PASS:  DivideINT_TI_TI6
+PASS:  DivideINT_TI_TIR1
+PASS:  DivideINT_TI_TIR2
+PASS:  DivideINT_TI_TIF1
+PASS:  DivideINT_TI_TIF2
+PASS:  DivideINT_TI_TIF3
+PASS:  DivideINT_TI_TIF4
+PASS:  DivideINT_TI_TIN1
+PASS:  DivideINT_TI_TIN2
+PASS:  DivideINT_TI_TIN3
+SimpleClockAdvance_SETUP:  start_time = <2002-12-27_03:00:00>
+SimpleClockAdvance_SETUP:  stop_time = <2002-12-28_08:00:00>
+SimpleClockAdvance_SETUP:  timestep = <0000000000_000:010:000>
+SimpleClockAdvance_SETUP:  increment = <0000000000_000:000:000>
+SimpleClockAdvance_SETUP:  clock current_time = <2002-12-27_03:00:00>
+SimpleClockAdvance_SETUP:  current_time dayOfYear_r8 = < 361.125000 >
+SimpleClockAdvance_SETUP:  current_time-increment = <2002-12-27_03:00:00>
+SimpleClockAdvance_SETUP:  current_time+increment = <2002-12-27_03:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000001  current_time = <2002-12-27_03:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_03:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_03:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000002  current_time = <2002-12-27_03:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_03:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_03:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000003  current_time = <2002-12-27_03:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_03:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_03:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000004  current_time = <2002-12-27_03:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_03:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_03:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000005  current_time = <2002-12-27_03:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_03:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_03:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000006  current_time = <2002-12-27_04:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_04:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_04:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000007  current_time = <2002-12-27_04:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_04:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_04:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000008  current_time = <2002-12-27_04:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_04:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_04:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000009  current_time = <2002-12-27_04:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_04:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_04:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000010  current_time = <2002-12-27_04:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_04:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_04:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000011  current_time = <2002-12-27_04:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_04:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_04:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000012  current_time = <2002-12-27_05:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_05:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_05:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000013  current_time = <2002-12-27_05:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_05:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_05:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000014  current_time = <2002-12-27_05:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_05:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_05:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000015  current_time = <2002-12-27_05:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_05:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_05:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000016  current_time = <2002-12-27_05:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_05:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_05:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000017  current_time = <2002-12-27_05:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_05:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_05:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000018  current_time = <2002-12-27_06:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_06:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_06:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000019  current_time = <2002-12-27_06:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_06:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_06:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000020  current_time = <2002-12-27_06:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_06:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_06:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000021  current_time = <2002-12-27_06:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_06:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_06:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000022  current_time = <2002-12-27_06:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_06:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_06:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000023  current_time = <2002-12-27_06:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_06:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_06:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000024  current_time = <2002-12-27_07:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_07:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_07:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000025  current_time = <2002-12-27_07:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_07:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_07:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000026  current_time = <2002-12-27_07:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_07:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_07:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000027  current_time = <2002-12-27_07:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_07:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_07:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000028  current_time = <2002-12-27_07:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_07:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_07:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000029  current_time = <2002-12-27_07:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_07:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_07:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000030  current_time = <2002-12-27_08:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_08:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_08:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000031  current_time = <2002-12-27_08:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_08:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_08:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000032  current_time = <2002-12-27_08:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_08:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_08:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000033  current_time = <2002-12-27_08:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_08:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_08:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000034  current_time = <2002-12-27_08:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_08:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_08:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000035  current_time = <2002-12-27_08:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_08:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_08:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000036  current_time = <2002-12-27_09:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_09:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_09:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000037  current_time = <2002-12-27_09:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_09:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_09:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000038  current_time = <2002-12-27_09:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_09:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_09:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000039  current_time = <2002-12-27_09:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_09:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_09:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000040  current_time = <2002-12-27_09:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_09:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_09:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000041  current_time = <2002-12-27_09:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_09:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_09:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000042  current_time = <2002-12-27_10:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_10:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_10:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000043  current_time = <2002-12-27_10:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_10:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_10:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000044  current_time = <2002-12-27_10:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_10:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_10:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000045  current_time = <2002-12-27_10:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_10:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_10:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000046  current_time = <2002-12-27_10:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_10:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_10:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000047  current_time = <2002-12-27_10:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_10:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_10:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000048  current_time = <2002-12-27_11:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_11:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_11:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000049  current_time = <2002-12-27_11:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_11:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_11:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000050  current_time = <2002-12-27_11:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_11:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_11:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000051  current_time = <2002-12-27_11:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_11:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_11:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000052  current_time = <2002-12-27_11:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_11:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_11:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000053  current_time = <2002-12-27_11:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_11:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_11:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000054  current_time = <2002-12-27_12:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_12:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_12:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000055  current_time = <2002-12-27_12:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_12:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_12:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000056  current_time = <2002-12-27_12:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_12:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_12:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000057  current_time = <2002-12-27_12:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_12:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_12:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000058  current_time = <2002-12-27_12:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_12:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_12:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000059  current_time = <2002-12-27_12:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_12:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_12:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000060  current_time = <2002-12-27_13:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_13:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_13:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000061  current_time = <2002-12-27_13:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_13:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_13:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000062  current_time = <2002-12-27_13:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_13:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_13:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000063  current_time = <2002-12-27_13:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_13:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_13:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000064  current_time = <2002-12-27_13:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_13:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_13:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000065  current_time = <2002-12-27_13:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_13:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_13:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000066  current_time = <2002-12-27_14:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_14:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_14:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000067  current_time = <2002-12-27_14:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_14:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_14:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000068  current_time = <2002-12-27_14:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_14:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_14:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000069  current_time = <2002-12-27_14:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_14:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_14:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000070  current_time = <2002-12-27_14:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_14:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_14:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000071  current_time = <2002-12-27_14:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_14:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_14:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000072  current_time = <2002-12-27_15:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_15:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_15:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000073  current_time = <2002-12-27_15:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_15:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_15:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000074  current_time = <2002-12-27_15:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_15:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_15:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000075  current_time = <2002-12-27_15:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_15:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_15:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000076  current_time = <2002-12-27_15:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_15:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_15:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000077  current_time = <2002-12-27_15:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_15:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_15:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000078  current_time = <2002-12-27_16:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_16:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_16:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000079  current_time = <2002-12-27_16:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_16:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_16:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000080  current_time = <2002-12-27_16:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_16:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_16:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000081  current_time = <2002-12-27_16:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_16:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_16:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000082  current_time = <2002-12-27_16:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_16:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_16:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000083  current_time = <2002-12-27_16:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_16:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_16:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000084  current_time = <2002-12-27_17:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_17:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_17:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000085  current_time = <2002-12-27_17:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_17:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_17:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000086  current_time = <2002-12-27_17:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_17:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_17:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000087  current_time = <2002-12-27_17:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_17:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_17:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000088  current_time = <2002-12-27_17:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_17:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_17:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000089  current_time = <2002-12-27_17:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_17:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_17:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000090  current_time = <2002-12-27_18:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_18:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_18:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000091  current_time = <2002-12-27_18:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_18:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_18:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000092  current_time = <2002-12-27_18:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_18:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_18:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000093  current_time = <2002-12-27_18:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_18:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_18:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000094  current_time = <2002-12-27_18:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_18:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_18:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000095  current_time = <2002-12-27_18:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_18:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_18:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000096  current_time = <2002-12-27_19:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_19:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_19:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000097  current_time = <2002-12-27_19:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_19:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_19:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000098  current_time = <2002-12-27_19:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_19:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_19:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000099  current_time = <2002-12-27_19:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_19:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_19:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000100  current_time = <2002-12-27_19:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_19:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_19:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000101  current_time = <2002-12-27_19:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_19:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_19:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000102  current_time = <2002-12-27_20:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_20:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_20:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000103  current_time = <2002-12-27_20:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_20:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_20:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000104  current_time = <2002-12-27_20:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_20:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_20:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000105  current_time = <2002-12-27_20:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_20:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_20:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000106  current_time = <2002-12-27_20:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_20:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_20:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000107  current_time = <2002-12-27_20:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_20:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_20:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000108  current_time = <2002-12-27_21:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_21:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_21:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000109  current_time = <2002-12-27_21:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_21:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_21:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000110  current_time = <2002-12-27_21:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_21:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_21:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000111  current_time = <2002-12-27_21:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_21:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_21:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000112  current_time = <2002-12-27_21:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_21:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_21:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000113  current_time = <2002-12-27_21:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_21:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_21:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000114  current_time = <2002-12-27_22:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_22:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_22:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000115  current_time = <2002-12-27_22:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_22:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_22:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000116  current_time = <2002-12-27_22:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_22:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_22:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000117  current_time = <2002-12-27_22:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_22:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_22:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000118  current_time = <2002-12-27_22:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_22:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_22:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000119  current_time = <2002-12-27_22:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_22:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_22:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000120  current_time = <2002-12-27_23:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_23:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_23:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000121  current_time = <2002-12-27_23:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_23:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_23:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000122  current_time = <2002-12-27_23:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_23:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_23:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000123  current_time = <2002-12-27_23:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_23:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_23:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000124  current_time = <2002-12-27_23:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_23:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_23:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000125  current_time = <2002-12-27_23:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-27_23:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-27_23:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000126  current_time = <2002-12-28_00:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_00:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_00:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000127  current_time = <2002-12-28_00:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_00:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_00:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000128  current_time = <2002-12-28_00:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_00:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_00:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000129  current_time = <2002-12-28_00:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_00:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_00:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000130  current_time = <2002-12-28_00:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_00:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_00:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000131  current_time = <2002-12-28_00:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_00:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_00:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000132  current_time = <2002-12-28_01:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_01:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_01:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000133  current_time = <2002-12-28_01:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_01:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_01:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000134  current_time = <2002-12-28_01:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_01:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_01:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000135  current_time = <2002-12-28_01:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_01:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_01:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000136  current_time = <2002-12-28_01:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_01:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_01:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000137  current_time = <2002-12-28_01:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_01:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_01:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000138  current_time = <2002-12-28_02:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_02:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_02:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000139  current_time = <2002-12-28_02:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_02:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_02:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000140  current_time = <2002-12-28_02:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_02:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_02:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000141  current_time = <2002-12-28_02:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_02:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_02:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000142  current_time = <2002-12-28_02:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_02:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_02:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000143  current_time = <2002-12-28_02:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_02:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_02:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000144  current_time = <2002-12-28_03:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_03:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_03:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000145  current_time = <2002-12-28_03:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_03:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_03:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000146  current_time = <2002-12-28_03:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_03:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_03:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000147  current_time = <2002-12-28_03:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_03:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_03:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000148  current_time = <2002-12-28_03:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_03:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_03:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000149  current_time = <2002-12-28_03:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_03:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_03:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000150  current_time = <2002-12-28_04:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_04:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_04:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000151  current_time = <2002-12-28_04:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_04:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_04:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000152  current_time = <2002-12-28_04:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_04:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_04:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000153  current_time = <2002-12-28_04:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_04:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_04:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000154  current_time = <2002-12-28_04:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_04:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_04:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000155  current_time = <2002-12-28_04:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_04:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_04:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000156  current_time = <2002-12-28_05:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_05:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_05:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000157  current_time = <2002-12-28_05:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_05:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_05:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000158  current_time = <2002-12-28_05:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_05:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_05:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000159  current_time = <2002-12-28_05:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_05:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_05:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000160  current_time = <2002-12-28_05:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_05:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_05:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000161  current_time = <2002-12-28_05:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_05:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_05:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000162  current_time = <2002-12-28_06:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_06:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_06:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000163  current_time = <2002-12-28_06:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_06:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_06:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000164  current_time = <2002-12-28_06:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_06:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_06:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000165  current_time = <2002-12-28_06:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_06:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_06:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000166  current_time = <2002-12-28_06:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_06:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_06:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000167  current_time = <2002-12-28_06:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_06:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_06:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000168  current_time = <2002-12-28_07:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_07:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_07:00:00>
+SimpleClockAdvance_ADVANCE:  count = 000169  current_time = <2002-12-28_07:10:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_07:10:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_07:10:00>
+SimpleClockAdvance_ADVANCE:  count = 000170  current_time = <2002-12-28_07:20:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_07:20:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_07:20:00>
+SimpleClockAdvance_ADVANCE:  count = 000171  current_time = <2002-12-28_07:30:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_07:30:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_07:30:00>
+SimpleClockAdvance_ADVANCE:  count = 000172  current_time = <2002-12-28_07:40:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_07:40:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_07:40:00>
+SimpleClockAdvance_ADVANCE:  count = 000173  current_time = <2002-12-28_07:50:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_07:50:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_07:50:00>
+SimpleClockAdvance_ADVANCE:  count = 000174  current_time = <2002-12-28_08:00:00>
+SimpleClockAdvance_ADVANCE:  current_time-increment = <2002-12-28_08:00:00>
+SimpleClockAdvance_ADVANCE:  current_time+increment = <2002-12-28_08:00:00>
+StdYearClockAdvance_SETUP:  start_time = <2003-12-29_09:00:00>
+StdYearClockAdvance_SETUP:  stop_time = <2004-01-02_09:00:00>
+StdYearClockAdvance_SETUP:  timestep = <0000000000_001:000:000>
+StdYearClockAdvance_SETUP:  increment = <0000000000_000:000:010>
+StdYearClockAdvance_SETUP:  clock current_time = <2003-12-29_09:00:00>
+StdYearClockAdvance_SETUP:  current_time dayOfYear_r8 = < 363.375000 >
+StdYearClockAdvance_SETUP:  current_time-increment = <2003-12-29_08:59:50>
+StdYearClockAdvance_SETUP:  current_time+increment = <2003-12-29_09:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000001  current_time = <2003-12-29_10:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_09:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_10:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000002  current_time = <2003-12-29_11:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_10:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_11:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000003  current_time = <2003-12-29_12:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_11:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_12:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000004  current_time = <2003-12-29_13:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_12:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_13:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000005  current_time = <2003-12-29_14:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_13:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_14:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000006  current_time = <2003-12-29_15:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_14:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_15:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000007  current_time = <2003-12-29_16:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_15:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_16:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000008  current_time = <2003-12-29_17:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_16:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_17:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000009  current_time = <2003-12-29_18:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_17:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_18:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000010  current_time = <2003-12-29_19:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_18:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_19:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000011  current_time = <2003-12-29_20:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_19:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_20:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000012  current_time = <2003-12-29_21:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_20:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_21:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000013  current_time = <2003-12-29_22:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_21:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_22:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000014  current_time = <2003-12-29_23:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_22:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-29_23:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000015  current_time = <2003-12-30_00:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-29_23:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_00:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000016  current_time = <2003-12-30_01:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_00:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_01:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000017  current_time = <2003-12-30_02:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_01:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_02:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000018  current_time = <2003-12-30_03:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_02:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_03:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000019  current_time = <2003-12-30_04:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_03:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_04:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000020  current_time = <2003-12-30_05:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_04:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_05:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000021  current_time = <2003-12-30_06:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_05:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_06:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000022  current_time = <2003-12-30_07:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_06:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_07:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000023  current_time = <2003-12-30_08:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_07:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_08:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000024  current_time = <2003-12-30_09:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_08:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_09:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000025  current_time = <2003-12-30_10:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_09:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_10:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000026  current_time = <2003-12-30_11:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_10:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_11:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000027  current_time = <2003-12-30_12:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_11:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_12:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000028  current_time = <2003-12-30_13:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_12:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_13:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000029  current_time = <2003-12-30_14:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_13:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_14:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000030  current_time = <2003-12-30_15:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_14:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_15:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000031  current_time = <2003-12-30_16:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_15:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_16:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000032  current_time = <2003-12-30_17:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_16:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_17:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000033  current_time = <2003-12-30_18:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_17:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_18:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000034  current_time = <2003-12-30_19:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_18:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_19:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000035  current_time = <2003-12-30_20:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_19:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_20:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000036  current_time = <2003-12-30_21:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_20:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_21:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000037  current_time = <2003-12-30_22:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_21:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_22:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000038  current_time = <2003-12-30_23:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_22:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-30_23:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000039  current_time = <2003-12-31_00:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-30_23:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_00:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000040  current_time = <2003-12-31_01:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_00:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_01:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000041  current_time = <2003-12-31_02:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_01:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_02:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000042  current_time = <2003-12-31_03:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_02:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_03:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000043  current_time = <2003-12-31_04:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_03:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_04:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000044  current_time = <2003-12-31_05:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_04:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_05:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000045  current_time = <2003-12-31_06:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_05:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_06:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000046  current_time = <2003-12-31_07:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_06:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_07:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000047  current_time = <2003-12-31_08:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_07:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_08:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000048  current_time = <2003-12-31_09:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_08:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_09:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000049  current_time = <2003-12-31_10:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_09:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_10:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000050  current_time = <2003-12-31_11:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_10:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_11:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000051  current_time = <2003-12-31_12:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_11:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_12:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000052  current_time = <2003-12-31_13:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_12:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_13:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000053  current_time = <2003-12-31_14:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_13:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_14:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000054  current_time = <2003-12-31_15:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_14:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_15:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000055  current_time = <2003-12-31_16:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_15:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_16:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000056  current_time = <2003-12-31_17:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_16:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_17:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000057  current_time = <2003-12-31_18:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_17:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_18:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000058  current_time = <2003-12-31_19:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_18:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_19:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000059  current_time = <2003-12-31_20:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_19:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_20:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000060  current_time = <2003-12-31_21:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_20:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_21:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000061  current_time = <2003-12-31_22:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_21:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_22:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000062  current_time = <2003-12-31_23:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_22:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2003-12-31_23:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000063  current_time = <2004-01-01_00:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2003-12-31_23:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_00:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000064  current_time = <2004-01-01_01:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_00:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_01:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000065  current_time = <2004-01-01_02:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_01:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_02:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000066  current_time = <2004-01-01_03:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_02:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_03:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000067  current_time = <2004-01-01_04:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_03:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_04:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000068  current_time = <2004-01-01_05:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_04:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_05:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000069  current_time = <2004-01-01_06:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_05:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_06:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000070  current_time = <2004-01-01_07:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_06:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_07:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000071  current_time = <2004-01-01_08:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_07:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_08:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000072  current_time = <2004-01-01_09:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_08:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_09:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000073  current_time = <2004-01-01_10:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_09:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_10:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000074  current_time = <2004-01-01_11:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_10:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_11:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000075  current_time = <2004-01-01_12:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_11:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_12:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000076  current_time = <2004-01-01_13:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_12:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_13:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000077  current_time = <2004-01-01_14:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_13:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_14:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000078  current_time = <2004-01-01_15:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_14:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_15:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000079  current_time = <2004-01-01_16:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_15:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_16:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000080  current_time = <2004-01-01_17:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_16:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_17:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000081  current_time = <2004-01-01_18:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_17:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_18:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000082  current_time = <2004-01-01_19:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_18:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_19:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000083  current_time = <2004-01-01_20:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_19:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_20:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000084  current_time = <2004-01-01_21:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_20:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_21:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000085  current_time = <2004-01-01_22:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_21:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_22:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000086  current_time = <2004-01-01_23:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_22:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-01_23:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000087  current_time = <2004-01-02_00:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-01_23:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_00:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000088  current_time = <2004-01-02_01:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-02_00:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_01:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000089  current_time = <2004-01-02_02:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-02_01:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_02:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000090  current_time = <2004-01-02_03:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-02_02:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_03:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000091  current_time = <2004-01-02_04:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-02_03:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_04:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000092  current_time = <2004-01-02_05:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-02_04:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_05:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000093  current_time = <2004-01-02_06:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-02_05:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_06:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000094  current_time = <2004-01-02_07:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-02_06:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_07:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000095  current_time = <2004-01-02_08:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-02_07:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_08:00:10>
+StdYearClockAdvance_ADVANCE:  count = 000096  current_time = <2004-01-02_09:00:00>
+StdYearClockAdvance_ADVANCE:  current_time-increment = <2004-01-02_08:59:50>
+StdYearClockAdvance_ADVANCE:  current_time+increment = <2004-01-02_09:00:10>
+LeapYearClockAdvance_SETUP:  start_time = <2004-12-29_09:00:00>
+LeapYearClockAdvance_SETUP:  stop_time = <2005-01-02_09:00:00>
+LeapYearClockAdvance_SETUP:  timestep = <0000000000_001:000:000>
+LeapYearClockAdvance_SETUP:  increment = <0000000000_000:000:010>
+LeapYearClockAdvance_SETUP:  clock current_time = <2004-12-29_09:00:00>
+LeapYearClockAdvance_SETUP:  current_time dayOfYear_r8 = < 364.375000 >
+LeapYearClockAdvance_SETUP:  current_time-increment = <2004-12-29_08:59:50>
+LeapYearClockAdvance_SETUP:  current_time+increment = <2004-12-29_09:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000001  current_time = <2004-12-29_10:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_09:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_10:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000002  current_time = <2004-12-29_11:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_10:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_11:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000003  current_time = <2004-12-29_12:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_11:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_12:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000004  current_time = <2004-12-29_13:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_12:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_13:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000005  current_time = <2004-12-29_14:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_13:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_14:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000006  current_time = <2004-12-29_15:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_14:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_15:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000007  current_time = <2004-12-29_16:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_15:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_16:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000008  current_time = <2004-12-29_17:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_16:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_17:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000009  current_time = <2004-12-29_18:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_17:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_18:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000010  current_time = <2004-12-29_19:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_18:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_19:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000011  current_time = <2004-12-29_20:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_19:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_20:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000012  current_time = <2004-12-29_21:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_20:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_21:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000013  current_time = <2004-12-29_22:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_21:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_22:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000014  current_time = <2004-12-29_23:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_22:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-29_23:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000015  current_time = <2004-12-30_00:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-29_23:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_00:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000016  current_time = <2004-12-30_01:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_00:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_01:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000017  current_time = <2004-12-30_02:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_01:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_02:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000018  current_time = <2004-12-30_03:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_02:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_03:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000019  current_time = <2004-12-30_04:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_03:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_04:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000020  current_time = <2004-12-30_05:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_04:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_05:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000021  current_time = <2004-12-30_06:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_05:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_06:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000022  current_time = <2004-12-30_07:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_06:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_07:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000023  current_time = <2004-12-30_08:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_07:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_08:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000024  current_time = <2004-12-30_09:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_08:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_09:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000025  current_time = <2004-12-30_10:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_09:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_10:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000026  current_time = <2004-12-30_11:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_10:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_11:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000027  current_time = <2004-12-30_12:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_11:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_12:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000028  current_time = <2004-12-30_13:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_12:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_13:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000029  current_time = <2004-12-30_14:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_13:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_14:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000030  current_time = <2004-12-30_15:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_14:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_15:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000031  current_time = <2004-12-30_16:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_15:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_16:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000032  current_time = <2004-12-30_17:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_16:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_17:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000033  current_time = <2004-12-30_18:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_17:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_18:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000034  current_time = <2004-12-30_19:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_18:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_19:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000035  current_time = <2004-12-30_20:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_19:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_20:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000036  current_time = <2004-12-30_21:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_20:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_21:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000037  current_time = <2004-12-30_22:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_21:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_22:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000038  current_time = <2004-12-30_23:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_22:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-30_23:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000039  current_time = <2004-12-31_00:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-30_23:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_00:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000040  current_time = <2004-12-31_01:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_00:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_01:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000041  current_time = <2004-12-31_02:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_01:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_02:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000042  current_time = <2004-12-31_03:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_02:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_03:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000043  current_time = <2004-12-31_04:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_03:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_04:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000044  current_time = <2004-12-31_05:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_04:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_05:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000045  current_time = <2004-12-31_06:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_05:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_06:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000046  current_time = <2004-12-31_07:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_06:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_07:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000047  current_time = <2004-12-31_08:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_07:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_08:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000048  current_time = <2004-12-31_09:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_08:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_09:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000049  current_time = <2004-12-31_10:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_09:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_10:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000050  current_time = <2004-12-31_11:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_10:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_11:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000051  current_time = <2004-12-31_12:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_11:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_12:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000052  current_time = <2004-12-31_13:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_12:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_13:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000053  current_time = <2004-12-31_14:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_13:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_14:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000054  current_time = <2004-12-31_15:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_14:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_15:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000055  current_time = <2004-12-31_16:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_15:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_16:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000056  current_time = <2004-12-31_17:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_16:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_17:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000057  current_time = <2004-12-31_18:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_17:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_18:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000058  current_time = <2004-12-31_19:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_18:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_19:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000059  current_time = <2004-12-31_20:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_19:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_20:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000060  current_time = <2004-12-31_21:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_20:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_21:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000061  current_time = <2004-12-31_22:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_21:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_22:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000062  current_time = <2004-12-31_23:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_22:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_23:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000063  current_time = <2005-01-01_00:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000064  current_time = <2005-01-01_01:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_01:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000065  current_time = <2005-01-01_02:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_01:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_02:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000066  current_time = <2005-01-01_03:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_02:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_03:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000067  current_time = <2005-01-01_04:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_03:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_04:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000068  current_time = <2005-01-01_05:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_04:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_05:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000069  current_time = <2005-01-01_06:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_05:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_06:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000070  current_time = <2005-01-01_07:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_06:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_07:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000071  current_time = <2005-01-01_08:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_07:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_08:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000072  current_time = <2005-01-01_09:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_08:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_09:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000073  current_time = <2005-01-01_10:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_09:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_10:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000074  current_time = <2005-01-01_11:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_10:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_11:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000075  current_time = <2005-01-01_12:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_11:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_12:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000076  current_time = <2005-01-01_13:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_12:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_13:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000077  current_time = <2005-01-01_14:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_13:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_14:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000078  current_time = <2005-01-01_15:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_14:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_15:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000079  current_time = <2005-01-01_16:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_15:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_16:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000080  current_time = <2005-01-01_17:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_16:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_17:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000081  current_time = <2005-01-01_18:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_17:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_18:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000082  current_time = <2005-01-01_19:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_18:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_19:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000083  current_time = <2005-01-01_20:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_19:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_20:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000084  current_time = <2005-01-01_21:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_20:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_21:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000085  current_time = <2005-01-01_22:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_21:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_22:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000086  current_time = <2005-01-01_23:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_22:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_23:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000087  current_time = <2005-01-02_00:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_23:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_00:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000088  current_time = <2005-01-02_01:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-02_00:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_01:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000089  current_time = <2005-01-02_02:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-02_01:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_02:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000090  current_time = <2005-01-02_03:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-02_02:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_03:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000091  current_time = <2005-01-02_04:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-02_03:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_04:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000092  current_time = <2005-01-02_05:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-02_04:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_05:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000093  current_time = <2005-01-02_06:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-02_05:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_06:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000094  current_time = <2005-01-02_07:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-02_06:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_07:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000095  current_time = <2005-01-02_08:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-02_07:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_08:00:10>
+LeapYearClockAdvance_ADVANCE:  count = 000096  current_time = <2005-01-02_09:00:00>
+LeapYearClockAdvance_ADVANCE:  current_time-increment = <2005-01-02_08:59:50>
+LeapYearClockAdvance_ADVANCE:  current_time+increment = <2005-01-02_09:00:10>
+LeapYearFractionClockAdvance_SETUP:  start_time = <2004-12-31_23:58:00>
+LeapYearFractionClockAdvance_SETUP:  stop_time = <2005-01-01_00:02:00>
+LeapYearFractionClockAdvance_SETUP:  timestep = <0000000000_000:000:013+01/03>
+LeapYearFractionClockAdvance_SETUP:  increment = <0000000000_000:000:001+01/03>
+LeapYearFractionClockAdvance_SETUP:  clock current_time = <2004-12-31_23:58:00>
+LeapYearFractionClockAdvance_SETUP:  current_time dayOfYear_r8 = < 366.998611 >
+LeapYearFractionClockAdvance_SETUP:  current_time-increment = <2004-12-31_23:57:58+02/03>
+LeapYearFractionClockAdvance_SETUP:  current_time+increment = <2004-12-31_23:58:01+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000001  current_time = <2004-12-31_23:58:13+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:58:12>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_23:58:14+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000002  current_time = <2004-12-31_23:58:26+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:58:25+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_23:58:28>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000003  current_time = <2004-12-31_23:58:40>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:58:38+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_23:58:41+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000004  current_time = <2004-12-31_23:58:53+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:58:52>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_23:58:54+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000005  current_time = <2004-12-31_23:59:06+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:59:05+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_23:59:08>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000006  current_time = <2004-12-31_23:59:20>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:59:18+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_23:59:21+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000007  current_time = <2004-12-31_23:59:33+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:59:32>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_23:59:34+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000008  current_time = <2004-12-31_23:59:46+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:59:45+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2004-12-31_23:59:48>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000009  current_time = <2005-01-01_00:00:00>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2004-12-31_23:59:58+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:00:01+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000010  current_time = <2005-01-01_00:00:13+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:00:12>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:00:14+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000011  current_time = <2005-01-01_00:00:26+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:00:25+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:00:28>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000012  current_time = <2005-01-01_00:00:40>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:00:38+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:00:41+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000013  current_time = <2005-01-01_00:00:53+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:00:52>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:00:54+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000014  current_time = <2005-01-01_00:01:06+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:01:05+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:01:08>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000015  current_time = <2005-01-01_00:01:20>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:01:18+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:01:21+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000016  current_time = <2005-01-01_00:01:33+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:01:32>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:01:34+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000017  current_time = <2005-01-01_00:01:46+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:01:45+01/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:01:48>
+LeapYearFractionClockAdvance_ADVANCE:  count = 000018  current_time = <2005-01-01_00:02:00>
+LeapYearFractionClockAdvance_ADVANCE:  current_time-increment = <2005-01-01_00:01:58+02/03>
+LeapYearFractionClockAdvance_ADVANCE:  current_time+increment = <2005-01-01_00:02:01+01/03>
+ END TEST SUITE
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_ESMF_Calendar
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_ESMF_Calendar	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_ESMF_Calendar	(revision 2744)
@@ -0,0 +1,23 @@
+52c52,58
+< 
+---
+> !      INTEGER, PARAMETER :: MONTHS_PER_YEAR = 07
+> !      INTEGER, PARAMETER :: mday(MONTHS_PER_YEAR)   &
+> !                          = (/99,99,99,99,99,99,75/)
+> !      INTEGER, PARAMETER :: mdayleap(MONTHS_PER_YEAR) &
+> !                          = (/99,99,99,99,99,99,75/)
+> !
+> !*****Similar monthes as the GCM
+55c61
+<                           = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+---
+>                           = (/61,66,66,65,60,54,50,46,47,47,51,56/)
+57,59c63,66
+<                           = (/31,29,31,30,31,30,31,31,30,31,30,31/)
+<       INTEGER, DIMENSION(365) :: daym
+<       INTEGER, DIMENSION(366) :: daymleap
+---
+>                           = (/61,66,66,65,60,54,50,46,47,47,51,56/)
+> !*****
+>       INTEGER, DIMENSION(669) :: daym
+>       INTEGER, DIMENSION(669) :: daymleap
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_ESMF_TimeMgr
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_ESMF_TimeMgr	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_ESMF_TimeMgr	(revision 2744)
@@ -0,0 +1,8 @@
+33,35c33,35
+< #define SECONDS_PER_DAY 86400_ESMF_KIND_I8
+< #define SECONDS_PER_HOUR 3600_ESMF_KIND_I8
+< #define SECONDS_PER_MINUTE 60_ESMF_KIND_I8
+---
+> #define SECONDS_PER_DAY 88800_ESMF_KIND_I8
+> #define SECONDS_PER_HOUR 3700_ESMF_KIND_I8
+> #define SECONDS_PER_MINUTE 100_ESMF_KIND_I8
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_Meat
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_Meat	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_Meat	(revision 2744)
@@ -0,0 +1,157 @@
+176,191c176,191
+< ! TBH:  TODO:  Replace this hack with run-time decision based on 
+< ! TBH:  TODO:  passed-in calendar.  
+< #ifdef NO_LEAP_CALENDAR
+<       num_days = 28 ! By default, February has 28 days ...
+< #else
+<       num_days = 28 ! By default, February has 28 days ...
+<       IF (MOD(year,4).eq.0) THEN
+<          num_days = 29  ! But every four years, it has 29 days ...
+<          IF (MOD(year,100).eq.0) THEN
+<             num_days = 28  ! Except every 100 years, when it has 28 days ...
+<             IF (MOD(year,400).eq.0) THEN
+<                num_days = 29  ! Except every 400 years, when it has 29 days.
+<             END IF
+<          END IF
+<       END IF
+< #endif
+---
+> !#ifdef NO_LEAP_CALENDAR
+> !      num_days = 28 ! By default, February has 28 days ...
+> !#else
+> !      num_days = 28 ! By default, February has 28 days ...
+> !      IF (MOD(year,4).eq.0) THEN
+> !         num_days = 29  ! But every four years, it has 29 days ...
+> !         IF (MOD(year,100).eq.0) THEN
+> !            num_days = 28  ! Except every 100 years, when it has 28 days ...
+> !            IF (MOD(year,400).eq.0) THEN
+> !               num_days = 29  ! Except every 400 years, when it has 29 days.
+> !            END IF
+> !         END IF
+> !      END IF
+> !#endif
+> num_days = 1
+> ! just to keep continuity 
+201,206c201,207
+<   INTEGER :: nfeb
+<   IF ( nfeb( year ) .EQ. 29 ) THEN
+<     num_diy = 366
+<   ELSE
+<     num_diy = 365
+<   ENDIF
+---
+> !  INTEGER :: nfeb
+> !  IF ( nfeb( year ) .EQ. 29 ) THEN
+> !    num_diy = 366
+> !  ELSE
+> !    num_diy = 365
+> !  ENDIF
+> num_diy = 669
+266,284c267,285
+< !$$$ useful, but not used at the moment...  
+< SUBROUTINE compute_dayinyear(YR,MM,DD,dayinyear)
+<   use ESMF_CalendarMod
+< IMPLICIT NONE
+<       INTEGER, INTENT(IN)  :: YR,MM,DD   ! DD is day of month
+<       INTEGER, INTENT(OUT) :: dayinyear
+<       INTEGER i
+<       integer nfeb
+< 
+<       dayinyear = 0
+<       DO i = 1,MM-1
+<         if (i.eq.2) then
+<           dayinyear = dayinyear + nfeb(YR)
+<         else
+<           dayinyear = dayinyear + mday(i)
+<         endif
+<       ENDDO
+<       dayinyear = dayinyear + DD
+< END SUBROUTINE compute_dayinyear
+---
+> !!$$$ useful, but not used at the moment...  
+> !SUBROUTINE compute_dayinyear(YR,MM,DD,dayinyear)
+> !  use ESMF_CalendarMod
+> !IMPLICIT NONE
+> !      INTEGER, INTENT(IN)  :: YR,MM,DD   ! DD is day of month
+> !      INTEGER, INTENT(OUT) :: dayinyear
+> !      INTEGER i
+> !      integer nfeb
+> !
+> !      dayinyear = 0
+> !      DO i = 1,MM-1
+> !        if (i.eq.2) then
+> !          dayinyear = dayinyear + nfeb(YR)
+> !        else
+> !          dayinyear = dayinyear + mday(i)
+> !        endif
+> !      ENDDO
+> !      dayinyear = dayinyear + DD
+> !END SUBROUTINE compute_dayinyear
+300,302c301,303
+<   IF ( nfeb(time%YR) == 29 ) THEN
+<     MMbdys => monthbdysleap
+<   ELSE
+---
+> !  IF ( nfeb(time%YR) == 29 ) THEN
+> !    MMbdys => monthbdysleap
+> !  ELSE
+304c305
+<   ENDIF
+---
+> !  ENDIF
+333,334c334,335
+< !$$$ fix this so init just points MMbdys to the one we want for this calendar?
+<   IF ( nfeb(time%YR) == 29 ) THEN
+---
+> !!$$$ fix this so init just points MMbdys to the one we want for this calendar?
+> !  IF ( nfeb(time%YR) == 29 ) THEN
+336,338c337,339
+<   ELSE
+<     MMbdys => monthbdys
+<   ENDIF
+---
+> !  ELSE
+> !    MMbdys => monthbdys
+> !  ENDIF
+373,376c374,377
+<   IF ( nfeb(time%YR) == 29 ) THEN
+< !  PRINT *,'DEBUG:  timeaddmonths(): leap year'
+<     MMbdys => monthbdysleap
+<   ELSE
+---
+> !  IF ( nfeb(time%YR) == 29 ) THEN
+> !!  PRINT *,'DEBUG:  timeaddmonths(): leap year'
+> !    MMbdys => monthbdysleap
+> !  ELSE
+379c380
+<   ENDIF
+---
+> !  ENDIF
+403,406c404,407
+<   IF ( nfeb(time%YR) == 29 ) THEN
+<     time%basetime%S = time%basetime%S + &
+<       ( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
+<   ELSE
+---
+> !  IF ( nfeb(time%YR) == 29 ) THEN
+> !    time%basetime%S = time%basetime%S + &
+> !      ( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
+> !  ELSE
+409c410
+<   ENDIF
+---
+> !  ENDIF
+433,436c434,437
+<   IF ( nfeb(time%YR) == 29 ) THEN
+<     time%basetime%S = time%basetime%S - &
+<       ( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
+<   ELSE
+---
+> !  IF ( nfeb(time%YR) == 29 ) THEN
+> !    time%basetime%S = time%basetime%S - &
+> !      ( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
+> !  ELSE
+439c440
+<   ENDIF
+---
+> !  ENDIF
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_Test1
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_Test1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/diff_Test1	(revision 2744)
@@ -0,0 +1,884 @@
+15c15
+<   LOGICAL :: WRF_ERROR_FATAL_PRINT = .FALSE.
+---
+>   LOGICAL :: WRF_ERROR_FATAL_PRINT = .TRUE. !FALSE.
+77,78c77,78
+<     it_MM = 1
+<     it_DD = 1
+---
+>     it_MM = 1  ! same as Earth more simple 
+>     it_DD = 1  ! same as Earth more simple 
+366,367c366,367
+<     iop1_t_MM = 1
+<     iop1_t_DD = 1
+---
+>     iop1_t_MM = 1  !see above
+>     iop1_t_DD = 1  !see above
+382,383c382,383
+<     iop2_t_MM = 1
+<     iop2_t_DD = 1
+---
+>     iop2_t_MM = 1  !see above
+>     iop2_t_DD = 1  !see above
+398,399c398,399
+<     ires_t_MM = 1
+<     ires_t_DD = 1
+---
+>     ires_t_MM = 1  !see above
+>     ires_t_DD = 1  !see above
+921,922c921,922
+<     istart_MM = 1
+<     istart_DD = 1
+---
+>     istart_MM = 1  !see above
+>     istart_DD = 1  !see above
+927,928c927,928
+<     istop_MM = 1
+<     istop_DD = 1
+---
+>     istop_MM = 1  !see above
+>     istop_DD = 1  !see above
+1322c1322
+< !  PRINT *,'DEBUG:  back from WRFU_Initialize(), rc = ',rc
+---
+>   PRINT *,'DEBUG:  back from WRFU_Initialize(), rc = ',rc
+1331,1332c1331,1332
+<   CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+<     res_str='2001-12-03_01:20:10', testname='printT_1' )
+---
+>   CALL test_print( t_yy=2025,  t_mm=03,  t_dd=23,  t_h=1,  t_m=20,  t_s=10, &
+>     res_str='2025-03-23_01:20:10', testname='printT_1' )
+1334,1366c1334,1369
+<   CALL test_print( t_yy=0,  t_mm=1,  t_dd=1,  t_h=0,  t_m=0,  t_s=0, &
+<     res_str='0000-01-01_00:00:00', testname='printT_2' )
+<   CALL test_print( t_yy=2003,  t_mm=12,  t_dd=30,  t_h=23,  t_m=59,  t_s=50, &
+<     res_str='2003-12-30_23:59:50', testname='printT_3' )
+<   CALL test_print( t_yy=2003,  t_mm=12,  t_dd=31,  t_h=23,  t_m=59,  t_s=50, &
+<     res_str='2003-12-31_23:59:50', testname='printT_4' )
+<   CALL test_print( t_yy=2004,  t_mm=12,  t_dd=30,  t_h=23,  t_m=59,  t_s=50, &
+<     res_str='2004-12-30_23:59:50', testname='printT_5' )
+<   CALL test_print( t_yy=2004,  t_mm=12,  t_dd=31,  t_h=23,  t_m=59,  t_s=50, &
+<     res_str='2004-12-31_23:59:50', testname='printT_6' )
+< !$$$  NOTE that this fails -- need to fix up output string for negative year
+< !  CALL test_print( t_yy=-2004,  t_mm=12,  t_dd=31,  t_h=23,  t_m=59,  t_s=50, &
+< !    res_str='-2004-12-31_23:59:50', testname='printT_6' )
+< 
+<   ! these test default behavior of test harness
+<   CALL test_print( t_s=0, &
+<     res_str='0000-01-01_00:00:00', testname='printT_D1' )
+<   CALL test_print( t_yy=0, &
+<     res_str='0000-01-01_00:00:00', testname='printT_D2' )
+< 
+<   ! fractions
+<   CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+<     t_sn=1, t_sd=3, &
+<     res_str='2001-12-03_01:20:10+01/03', testname='printT_F1' )
+<   CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+<     t_sn=4, t_sd=3, &
+<     res_str='2001-12-03_01:20:11+01/03', testname='printT_F2' )
+<   CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+<     t_sn=12, t_sd=3, &
+<     res_str='2001-12-03_01:20:14', testname='printT_F3' )
+<   CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+<     t_sn=-1, t_sd=3, &
+<     res_str='2001-12-03_01:20:09+02/03', testname='printT_F4' )
+---
+>   CALL test_print( t_yy=2000,  t_mm=1,  t_dd=1,  t_h=0,  t_m=0,  t_s=0, &
+>     res_str='2000-01-01_00:00:00', testname='printT_2' )
+>   CALL test_print( t_yy=2026,  t_mm=07,  t_dd=74,  t_h=23,  t_m=36,  t_s=90, &
+>     res_str='2026-07-74_23:36:90', testname='printT_3' )
+>   CALL test_print( t_yy=2026,  t_mm=07,  t_dd=75,  t_h=23,  t_m=36,  t_s=90, &
+>     res_str='2026-07-75_23:36:90', testname='printT_4' )
+> !  CALL test_print( t_yy=2004,  t_mm=12,  t_dd=30,  t_h=23,  t_m=59,  t_s=50, &
+> !    res_str='2004-12-30_23:59:50', testname='printT_5' )
+> !  CALL test_print( t_yy=2004,  t_mm=12,  t_dd=31,  t_h=23,  t_m=59,  t_s=50, &
+> !    res_str='2004-12-31_23:59:50', testname='printT_6' )
+> !!$$$  NOTE that this fails -- need to fix up output string for negative year
+> !!  CALL test_print( t_yy=-2004,  t_mm=12,  t_dd=31,  t_h=23,  t_m=59,  t_s=50, &
+> !!    res_str='-2004-12-31_23:59:50', testname='printT_6' )
+> 
+> !  ! these test default behavior of test harness
+> !  CALL test_print( t_s=0, &
+> !    res_str='0000-00-00_00:00:00', testname='printT_D1' )
+> !  CALL test_print( t_yy=0, &
+> !    res_str='0000-00-00_00:00:00', testname='printT_D2' )
+> 
+>   PRINT *,'yeah yeah yeah'
+> 
+> 
+> !  ! fractions
+> !  CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+> !    t_sn=1, t_sd=3, &
+> !    res_str='2001-12-03_01:20:10+01/03', testname='printT_F1' )
+> !  CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+> !    t_sn=4, t_sd=3, &
+> !    res_str='2001-12-03_01:20:11+01/03', testname='printT_F2' )
+> !  CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+> !    t_sn=12, t_sd=3, &
+> !    res_str='2001-12-03_01:20:14', testname='printT_F3' )
+> !  CALL test_print( t_yy=2001,  t_mm=12,  t_dd=3,  t_h=1,  t_m=20,  t_s=10, &
+> !    t_sn=-1, t_sd=3, &
+> !    res_str='2001-12-03_01:20:09+02/03', testname='printT_F4' )
+1379,1380c1382,1383
+<   CALL test_print( ti_yy=0,  ti_mm=0,  ti_dd=500,  ti_h=0,  ti_m=0,  ti_s=7270, &
+<     res_str='0000000500_002:001:010', testname='printTI_2' )
+---
+>   CALL test_print( ti_yy=0,  ti_mm=0,  ti_dd=500,  ti_h=0,  ti_m=0,  ti_s=9510, &
+>     res_str='0000000500_002:021:010', testname='printTI_2' )
+1382,1408c1385,1412
+<   ! these test default behavior of test harness
+<   CALL test_print( ti_s=0, &
+<     res_str='0000000000_000:000:000', testname='printTI_D1' )
+<   CALL test_print( ti_yy=0, &
+<     res_str='0000000000_000:000:000', testname='printTI_D2' )
+< 
+<   ! these test negative values
+<   CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=-1,  ti_m=-20,  ti_s=-10, &
+<     res_str='-0000000003_001:020:010', testname='printTI_N1' )
+< 
+<   ! these test mixed values
+<   CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=1,  ti_m=20,  ti_s=10, &
+<     res_str='-0000000002_022:039:050', testname='printTI_M1' )
+< 
+<   ! fractions
+<   CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=3,  ti_h=1,  ti_m=20,  ti_s=10, &
+<     ti_sn=1, ti_sd=3, &
+<     res_str='0000000003_001:020:010+01/03', testname='printTI_F1' )
+<   CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=3,  ti_h=1,  ti_m=20,  ti_s=10, &
+<     ti_sn=5, ti_sd=3, &
+<     res_str='0000000003_001:020:011+02/03', testname='printTI_F2' )
+<   CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=-1,  ti_m=-20,  ti_s=-10, &
+<     ti_sn=-1, ti_sd=3, &
+<     res_str='-0000000003_001:020:010-01/03', testname='printTI_F3' )
+<   CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=-1,  ti_m=-20,  ti_s=-10, &
+<     ti_sn=1, ti_sd=3, &
+<     res_str='-0000000003_001:020:009-02/03', testname='printTI_F4' )
+---
+> !  ! these test default behavior of test harness
+> !  CALL test_print( ti_s=0, &
+> !    res_str='0000000000_000:000:000', testname='printTI_D1' )
+> !  CALL test_print( ti_yy=0, &
+> !    res_str='0000000000_000:000:000', testname='printTI_D2' )
+> 
+> !  ! these test negative values
+> !  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=-1,  ti_m=-20,  ti_s=-10, &
+> !    res_str='-0000000003_001:020:010', testname='printTI_N1' )
+> !
+> !  ! these test mixed values
+> !  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=1,  ti_m=20,  ti_s=10, &
+> !    res_str='-0000000002_022:039:050', testname='printTI_M1' )
+> !
+> !  ! fractions
+> !  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=3,  ti_h=1,  ti_m=20,  ti_s=10, &
+> !    ti_sn=1, ti_sd=3, &
+> !    res_str='0000000003_001:020:010+01/03', testname='printTI_F1' )
+> !  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=3,  ti_h=1,  ti_m=20,  ti_s=10, &
+> !    ti_sn=5, ti_sd=3, &
+> !    res_str='0000000003_001:020:011+02/03', testname='printTI_F2' )
+> !  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=-1,  ti_m=-20,  ti_s=-10, &
+> !    ti_sn=-1, ti_sd=3, &
+> !    res_str='-0000000003_001:020:010-01/03', testname='printTI_F3' )
+> !  CALL test_print( ti_yy=0000,  ti_mm=0,  ti_dd=-3,  ti_h=-1,  ti_m=-20,  ti_s=-10, &
+> !    ti_sn=1, ti_sd=3, &
+> !    res_str='-0000000003_001:020:009-02/03', testname='printTI_F4' )
+> !
+1417a1422
+> 
+1430c1435
+<      op1_t_yy=2001,  op1_t_mm=12,  op1_t_dd=3,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+---
+>      op1_t_yy=2026,  op1_t_mm=03,  op1_t_dd=23,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+1432c1437
+<      res_t_yy=2001,  res_t_mm=12,  res_t_dd=3,  res_t_h=4,  res_t_m=30,  res_t_s=20, &
+---
+>      res_t_yy=2026,  res_t_mm=03,  res_t_dd=23,  res_t_h=4,  res_t_m=30,  res_t_s=20, &
+1435c1440
+<      op1_t_yy=2001,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+---
+>      op1_t_yy=2001,  op1_t_mm=07,  op1_t_dd=75,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+1437c1442
+<      res_t_yy=2002,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+---
+>      res_t_yy=2002,  res_t_mm= 1,  res_t_dd=1,  res_t_h=3,  res_t_m=03,  res_t_s=10, &
+1439,1456c1444,1448
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2004,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI3' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2005,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI4' )
+<   ! this case hung after the CCSM contribution
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2004,  res_t_mm=12,  res_t_dd=31,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI5' )
+< ! NOTE:  CCSM folks need to decide what it means to add "1 month" to Feb. 29.  And all the 
+< !        other very similar cases.  Then, write this unit test!  
+---
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2004,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI3' )
+1458a1451,1463
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2005,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI4' )
+> !  ! this case hung after the CCSM contribution
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2004,  res_t_mm=12,  res_t_dd=31,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI5' )
+> !! NOTE:  CCSM folks need to decide what it means to add "1 month" to Feb. 29.  And all the 
+> !        other very similar cases.  Then, write this unit test!  
+> !!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !!!     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+1460,1481c1465,1486
+< !     res_t_yy=2007,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+< !    testname='AddT_T_TI6' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2005,  res_t_mm=12,  res_t_dd=30,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI7' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=367, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2006,  res_t_mm=01,  res_t_dd=01,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI8' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2004,  res_t_mm=12,  res_t_dd=29,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI9' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2004,  res_t_mm=12,  res_t_dd=30,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI10' )
+---
+> !!     res_t_yy=2007,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+> !!    testname='AddT_T_TI6' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2005,  res_t_mm=12,  res_t_dd=30,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI7' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=367, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2006,  res_t_mm=01,  res_t_dd=01,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI8' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2004,  res_t_mm=12,  res_t_dd=29,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI9' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2004,  res_t_mm=12,  res_t_dd=30,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI10' )
+1483,1485c1488,1490
+<      op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=367, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2004,  res_t_mm=12,  res_t_dd=31,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+---
+>      op1_t_yy=2003,  op1_t_mm=03,  op1_t_dd=23,  op1_t_h=0,  op1_t_m=0,  op1_t_s=0, &
+>     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=675, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+>      res_t_yy=2004,  res_t_mm=03,  res_t_dd=29,  res_t_h=4,  res_t_m=10,  res_t_s=10, &
+1487,1516c1492,1512
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=368, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2005,  res_t_mm=01,  res_t_dd=01,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI12' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2005,  res_t_mm=03,  res_t_dd=30,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI13' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2005,  res_t_mm=03,  res_t_dd=31,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI14' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2005,  res_t_mm=04,  res_t_dd=01,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_T_TI15' )
+<   ! ESMF_Time = ESMF_Time + ESMF_TimeInterval with fractions
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<      op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+<      op1_t_sn=01,  op1_t_sd=03, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<     op2_ti_sn=01, op2_ti_sd=03, &
+<      res_t_yy=2005,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+<      res_t_sn=02,  res_t_sd=03, &
+<     testname='AddT_T_TI_F1' )
+<   ! this should fail (and does)
+---
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2003,  op1_t_mm=12,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=368, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2005,  res_t_mm=01,  res_t_dd=01,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI12' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2005,  res_t_mm=03,  res_t_dd=30,  res_t_h=8,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI13' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2005,  res_t_mm=03,  res_t_dd=31,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI14' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !     op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=30,  op1_t_h=4,  op1_t_m=30,  op1_t_s=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2005,  res_t_mm=04,  res_t_dd=01,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_T_TI15' )
+> !  ! ESMF_Time = ESMF_Time + ESMF_TimeInterval with fractions
+1523,1691c1519,1557
+< !     res_t_sn=01,  res_t_sd=03, &
+< !    testname='AddT_T_TI_F2' )
+<   ! ESMF_Time = ESMF_TimeInterval + ESMF_Time
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<     op1_ti_yy=   0, op1_ti_mm= 0, op1_ti_dd=0, op1_ti_h=3, op1_ti_m=10, op1_ti_s=10, &
+<      op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=3,  op2_t_h=1,  op2_t_m=20,  op2_t_s=10, &
+<      res_t_yy=2001,  res_t_mm=12,  res_t_dd=3,  res_t_h=4,  res_t_m=30,  res_t_s=20, &
+<     testname='AddT_TI_T1' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<     op1_ti_yy=   0, op1_ti_mm= 0, op1_ti_dd=0, op1_ti_h=4, op1_ti_m=10, op1_ti_s=10, &
+<      op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=31,  op2_t_h=22,  op2_t_m=30,  op2_t_s=00, &
+<      res_t_yy=2002,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+<     testname='AddT_TI_T2' )
+<   ! ESMF_TimeInterval = ESMF_TimeInterval + ESMF_TimeInterval
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<     op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+<     op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=4, res_ti_h=2, res_ti_m=30, res_ti_s=20, &
+<     testname='AddTI_TI_TI1' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<     op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-3, op1_ti_h=-1, op1_ti_m=-20, op1_ti_s=-10, &
+<     op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-2, res_ti_h=0, res_ti_m=-10, res_ti_s=00, &
+<     testname='AddTI_TI_TI2' )
+<   CALL test_arithmetic( add_op=.TRUE.,                                             &
+<     op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-3, op1_ti_h=-1, op1_ti_m=-20, op1_ti_s=-10, &
+<     op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-1, op2_ti_h=-1, op2_ti_m=-10, op2_ti_s=-10, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-4, res_ti_h=-2, res_ti_m=-30, res_ti_s=-20, &
+<     testname='AddTI_TI_TI3' )
+< 
+<   ! Subtraction tests
+<   ! ESMF_Time = ESMF_Time - ESMF_TimeInterval
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2001,  op1_t_mm=12,  op1_t_dd=3,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=3, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2001,  res_t_mm=12,  res_t_dd=2,  res_t_h=22, res_t_m=10,  res_t_s=0,  &
+<     testname='SubtractT_T_TI1' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2005,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=0,  &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, &
+<      res_t_yy=2004,  res_t_mm=12,  res_t_dd=31, res_t_h=23, res_t_m=59,  res_t_s=50, &
+<     testname='SubtractT_T_TI2' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2004,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=0,  &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, &
+<      res_t_yy=2003,  res_t_mm=12,  res_t_dd=31, res_t_h=23, res_t_m=59,  res_t_s=50, &
+<     testname='SubtractT_T_TI3' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2003,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=0,  &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, &
+<      res_t_yy=2002,  res_t_mm=12,  res_t_dd=31, res_t_h=23, res_t_m=59,  res_t_s=50, &
+<     testname='SubtractT_T_TI4' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                             &
+<      op1_t_yy=2005,  op1_t_mm=04,  op1_t_dd=01,  op1_t_h=2,  op1_t_m=40,  op1_t_s=10, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2004,  res_t_mm=03,  res_t_dd=30,  res_t_h=4,  res_t_m=30,  res_t_s=00, &
+<     testname='SubtractT_T_TI5' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                             &
+<      op1_t_yy=2006,  op1_t_mm=01,  op1_t_dd=01,  op1_t_h=8,  op1_t_m=40,  op1_t_s=10, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=367, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+<      res_t_yy=2004,  res_t_mm=12,  res_t_dd=30,  res_t_h=4,  res_t_m=30,  res_t_s=00, &
+<     testname='SubtractT_T_TI6' )
+<   ! ESMF_Time = ESMF_Time - ESMF_TimeInterval with fractions
+<   CALL test_arithmetic( add_op=.FALSE.,                                             &
+<      op1_t_yy=2005,  op1_t_mm=01,  op1_t_dd=01,  op1_t_h=00,  op1_t_m=00,  op1_t_s=00, &
+<      op1_t_sn=00,  op1_t_sd=00, &
+<     op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=01, &
+<     op2_ti_sn=01, op2_ti_sd=03, &
+<      res_t_yy=2004,  res_t_mm=12,  res_t_dd=31,  res_t_h=23,  res_t_m=59,  res_t_s=58, &
+<      res_t_sn=02,  res_t_sd=03, &
+<     testname='SubtractT_T_TI_F1' )
+<   ! ESMF_TimeInterval = ESMF_Time - ESMF_Time
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2001,  op1_t_mm=12,  op1_t_dd=3,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+<      op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=1,  op2_t_h=1,  op2_t_m=10,  op2_t_s=10, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0,  &
+<     testname='SubtractTI_T_T1' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2002,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=31, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+<     testname='SubtractTI_T_T2' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2005,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2004,  op2_t_mm=12,  op2_t_dd=31, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+<     testname='SubtractTI_T_T3' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2003,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2003,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+<     testname='SubtractTI_T_T4' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=1, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+<     testname='SubtractTI_T_T5' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2002,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+<     testname='SubtractTI_T_T6' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2003,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=365, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+<     testname='SubtractTI_T_T7' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2004,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2003,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=365, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+<     testname='SubtractTI_T_T8' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2005,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+<     testname='SubtractTI_T_T9' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2003,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+<     testname='SubtractTI_T_T10' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2005,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=367, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+<     testname='SubtractTI_T_T11' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2005,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+<     testname='SubtractTI_T_T12' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=2004,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=23, op1_t_m=59,  op1_t_s=50, &
+<      op2_t_yy=2005,  op2_t_mm=03,  op2_t_dd=01, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-366, res_ti_h=0, res_ti_m=00, res_ti_s=-10, &
+<     testname='SubtractTI_T_T13' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<      op1_t_yy=-2002,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+<      op2_t_yy=-2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+<     testname='SubtractTI_T_T14' )
+<   ! ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<     op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+<     op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0,  &
+<     testname='SubtractTI_TI_TI1' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<     op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+<     op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-1, op2_ti_h=-1, op2_ti_m=-10, op2_ti_s=-10, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=4, res_ti_h=2, res_ti_m=30, res_ti_s=20,  &
+<     testname='SubtractTI_TI_TI2' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<     op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-1, op1_ti_h=-1, op1_ti_m=-10, op1_ti_s=-10, &
+<     op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-3, op2_ti_h=-1, op2_ti_m=-20, op2_ti_s=-10, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=00,  &
+<     testname='SubtractTI_TI_TI3' )
+<   ! Negative result ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<     op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=1, op1_ti_h=1, op1_ti_m=10, op1_ti_s=10, &
+<     op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=3, op2_ti_h=1, op2_ti_m=20, op2_ti_s=10, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-2, res_ti_h=0, res_ti_m=-10, res_ti_s=0,  &
+<     testname='SubtractTI_TI_TIN1' )
+<   CALL test_arithmetic( add_op=.FALSE.,                                            &
+<     op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-1, op1_ti_h=-1, op1_ti_m=-10, op1_ti_s=-10, &
+<     op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=3, op2_ti_h=1, op2_ti_m=20, op2_ti_s=10, &
+<     res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-4, res_ti_h=-2, res_ti_m=-30, res_ti_s=-20,  &
+<     testname='SubtractTI_TI_TIN2' )
+---
+> !     res_t_sn=02,  res_t_sd=03, &
+> !    testname='AddT_T_TI_F1' )
+> !  ! this should fail (and does)
+> !!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !!     op1_t_yy=2004,  op1_t_mm=12,  op1_t_dd=31,  op1_t_h=22,  op1_t_m=30,  op1_t_s=00, &
+> !!     op1_t_sn=01,  op1_t_sd=03, &
+> !!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !!    op2_ti_sn=01, op2_ti_sd=03, &
+> !!     res_t_yy=2005,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+> !!     res_t_sn=01,  res_t_sd=03, &
+> !!    testname='AddT_T_TI_F2' )
+> !  ! ESMF_Time = ESMF_TimeInterval + ESMF_Time
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !    op1_ti_yy=   0, op1_ti_mm= 0, op1_ti_dd=0, op1_ti_h=3, op1_ti_m=10, op1_ti_s=10, &
+> !     op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=3,  op2_t_h=1,  op2_t_m=20,  op2_t_s=10, &
+> !     res_t_yy=2001,  res_t_mm=12,  res_t_dd=3,  res_t_h=4,  res_t_m=30,  res_t_s=20, &
+> !    testname='AddT_TI_T1' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !    op1_ti_yy=   0, op1_ti_mm= 0, op1_ti_dd=0, op1_ti_h=4, op1_ti_m=10, op1_ti_s=10, &
+> !     op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=31,  op2_t_h=22,  op2_t_m=30,  op2_t_s=00, &
+> !     res_t_yy=2002,  res_t_mm= 1,  res_t_dd=1,  res_t_h=2,  res_t_m=40,  res_t_s=10, &
+> !    testname='AddT_TI_T2' )
+> !  ! ESMF_TimeInterval = ESMF_TimeInterval + ESMF_TimeInterval
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+> !    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=4, res_ti_h=2, res_ti_m=30, res_ti_s=20, &
+> !    testname='AddTI_TI_TI1' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-3, op1_ti_h=-1, op1_ti_m=-20, op1_ti_s=-10, &
+> !    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-2, res_ti_h=0, res_ti_m=-10, res_ti_s=00, &
+> !    testname='AddTI_TI_TI2' )
+> !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-3, op1_ti_h=-1, op1_ti_m=-20, op1_ti_s=-10, &
+> !    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-1, op2_ti_h=-1, op2_ti_m=-10, op2_ti_s=-10, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-4, res_ti_h=-2, res_ti_m=-30, res_ti_s=-20, &
+> !    testname='AddTI_TI_TI3' )
+> !
+1693,1694c1559,1560
+<   ! Un-normalized ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+<   ! this is an error
+---
+> !  ! Subtraction tests
+> !  ! ESMF_Time = ESMF_Time - ESMF_TimeInterval
+1696,1702d1561
+< !    op1_ti_yy=2001, op1_ti_mm=11, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+< !    op2_ti_yy=2001, op2_ti_mm=11, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+< !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0,  &
+< !    testname='SubtractTI_TI_TIU1', expect_error=.TRUE. )
+< 
+<   ! this one should FAIL, and does
+< !  CALL test_arithmetic( add_op=.TRUE.,                                             &
+1705,1755c1564,1756
+< !     res_t_yy=2002,  res_t_mm=12,  res_t_dd=3,  res_t_h=4,  res_t_m=30,  res_t_s=20, &
+< !    testname='AddTT1' )
+< 
+<   ! Multiplication tests
+<   ! ESMF_TimeInterval = ESMF_TimeInterval * INTEGER
+<   CALL test_arithmetic( multiply_op=.TRUE.,                &
+<     op1_ti_dd=3,  op1_ti_h=12,  op1_ti_m=18,  op1_ti_s=33, &
+<     op2_int=2,                                             &
+<     res_ti_dd=6,  res_ti_h=24, res_ti_m=37,  res_ti_s=06,  &
+<     testname='MultiplyTI_TI_INT1' )
+<   CALL test_arithmetic( multiply_op=.TRUE.,                &
+<     op1_ti_dd=350,  op1_ti_h=23,  op1_ti_m=50,  op1_ti_s=50, &
+<     op2_int=2,                                             &
+<     res_ti_dd=701,  res_ti_h=23, res_ti_m=41,  res_ti_s=40,&
+<     testname='MultiplyTI_TI_INT2' )
+<   CALL test_arithmetic( multiply_op=.TRUE.,                &
+<     op1_ti_s=01, op1_ti_sn=03, op1_ti_sd=04,               &
+<     op2_int=8,                                             &
+<     res_ti_s=14,                                           &
+<     testname='MultiplyTI_TI_INT3' )
+< 
+<   ! Division tests
+<   ! ESMF_TimeInterval = ESMF_TimeInterval / INTEGER
+<   CALL test_arithmetic( multiply_op=.FALSE.,               &
+<     op1_ti_dd=3,  op1_ti_h=12,  op1_ti_m=18,  op1_ti_s=33, &
+<     op2_int=3,                                             &
+<     res_ti_dd=1,  res_ti_h=04, res_ti_m=06,  res_ti_s=11,  &
+<     testname='DivideTI_TI_INT1' )
+<   CALL test_arithmetic( multiply_op=.FALSE.,               &
+<     op1_ti_dd=3,  op1_ti_h=12,  op1_ti_m=18,  op1_ti_s=33, &
+<     op2_int=4,                                             &
+<     res_ti_dd=0,  res_ti_h=21, res_ti_m=04,  res_ti_s=38,  &
+<     res_ti_sn=1,  res_ti_sd=4,                             &
+<     testname='DivideTI_TI_INT2' )
+<   CALL test_arithmetic( multiply_op=.FALSE.,               &
+<     op1_ti_s=01, op1_ti_sn=03, op1_ti_sd=04,               &
+<     op2_int=5,                                             &
+<     res_ti_s=0, res_ti_sn=7,  res_ti_sd=20,                &
+<     testname='DivideTI_TI_INT3' )
+< 
+<   ! Test adjust_io_timestr()
+< !     CT = 2000-01-26_00:00:00   (current time)
+< !     ST = 2000-01-24_12:00:00   (start time)
+< !     TI = 00000_03:00:00        (time interval)
+< ! the resulting time string should be:
+< !     2000-01-26_00:00:00
+<   CALL test_adjust_io_timestr( TI_h=3, TI_m=0, TI_s=0,          &
+<     CT_yy=2000,  CT_mm=1,  CT_dd=26,  CT_h=0,  CT_m=0,  CT_s=0, &
+<     ST_yy=2000,  ST_mm=1,  ST_dd=24,  ST_h=12, ST_m=0,  ST_s=0, &
+<     res_str='2000-01-26_00:00:00', testname='adjust_io_timestr_1' )
+< ! this should fail (and does)
+---
+> !     res_t_yy=2001,  res_t_mm=12,  res_t_dd=2,  res_t_h=22, res_t_m=10,  res_t_s=0,  &
+> !   testname='SubtractT_T_TI1' )
+> ! CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2005,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=0,  &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, &
+> !     res_t_yy=2004,  res_t_mm=12,  res_t_dd=31, res_t_h=23, res_t_m=59,  res_t_s=50, &
+> !    testname='SubtractT_T_TI2' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2004,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=0,  &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, &
+> !     res_t_yy=2003,  res_t_mm=12,  res_t_dd=31, res_t_h=23, res_t_m=59,  res_t_s=50, &
+> !    testname='SubtractT_T_TI3' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2003,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=0,  &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, &
+> !     res_t_yy=2002,  res_t_mm=12,  res_t_dd=31, res_t_h=23, res_t_m=59,  res_t_s=50, &
+> !    testname='SubtractT_T_TI4' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                             &
+> !     op1_t_yy=2005,  op1_t_mm=04,  op1_t_dd=01,  op1_t_h=2,  op1_t_m=40,  op1_t_s=10, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2004,  res_t_mm=03,  res_t_dd=30,  res_t_h=4,  res_t_m=30,  res_t_s=00, &
+> !    testname='SubtractT_T_TI5' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                             &
+> !     op1_t_yy=2006,  op1_t_mm=01,  op1_t_dd=01,  op1_t_h=8,  op1_t_m=40,  op1_t_s=10, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=367, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, &
+> !     res_t_yy=2004,  res_t_mm=12,  res_t_dd=30,  res_t_h=4,  res_t_m=30,  res_t_s=00, &
+> !    testname='SubtractT_T_TI6' )
+> !  ! ESMF_Time = ESMF_Time - ESMF_TimeInterval with fractions
+> !  CALL test_arithmetic( add_op=.FALSE.,                                             &
+> !     op1_t_yy=2005,  op1_t_mm=01,  op1_t_dd=01,  op1_t_h=00,  op1_t_m=00,  op1_t_s=00, &
+> !     op1_t_sn=00,  op1_t_sd=00, &
+> !    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=01, &
+> !    op2_ti_sn=01, op2_ti_sd=03, &
+> !     res_t_yy=2004,  res_t_mm=12,  res_t_dd=31,  res_t_h=23,  res_t_m=59,  res_t_s=58, &
+> !     res_t_sn=02,  res_t_sd=03, &
+> !    testname='SubtractT_T_TI_F1' )
+> !  ! ESMF_TimeInterval = ESMF_Time - ESMF_Time
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2001,  op1_t_mm=12,  op1_t_dd=3,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+> !     op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=1,  op2_t_h=1,  op2_t_m=10,  op2_t_s=10, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0,  &
+> !    testname='SubtractTI_T_T1' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2002,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2001,  op2_t_mm=12,  op2_t_dd=31, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+> !    testname='SubtractTI_T_T2' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2005,  op1_t_mm=1,   op1_t_dd=1,  op1_t_h=0,  op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2004,  op2_t_mm=12,  op2_t_dd=31, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+> !    testname='SubtractTI_T_T3' )
+> ! CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2003,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2003,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+> !    testname='SubtractTI_T_T4' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2004,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=1, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+> !    testname='SubtractTI_T_T5' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2002,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+> !    testname='SubtractTI_T_T6' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2003,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=365, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+> !    testname='SubtractTI_T_T7' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2004,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2003,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=365, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+> !    testname='SubtractTI_T_T8' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2005,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+> !    testname='SubtractTI_T_T9' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2003,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+> !    testname='SubtractTI_T_T10' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2005,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=367, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+> !    testname='SubtractTI_T_T11' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2005,  op1_t_mm=03,  op1_t_dd=01, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=2004,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=23, op2_t_m=59,  op2_t_s=50, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=10, &
+> !    testname='SubtractTI_T_T12' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=2004,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=23, op1_t_m=59,  op1_t_s=50, &
+> !     op2_t_yy=2005,  op2_t_mm=03,  op2_t_dd=01, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-366, res_ti_h=0, res_ti_m=00, res_ti_s=-10, &
+> !    testname='SubtractTI_T_T13' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !     op1_t_yy=-2002,  op1_t_mm=02,  op1_t_dd=28, op1_t_h=00, op1_t_m=00,  op1_t_s=00, &
+> !     op2_t_yy=-2002,  op2_t_mm=02,  op2_t_dd=28, op2_t_h=00, op2_t_m=00,  op2_t_s=00, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=00, &
+> !    testname='SubtractTI_T_T14' )
+> !  ! ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+> !    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0,  &
+> !    testname='SubtractTI_TI_TI1' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+> !    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-1, op2_ti_h=-1, op2_ti_m=-10, op2_ti_s=-10, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=4, res_ti_h=2, res_ti_m=30, res_ti_s=20,  &
+> !    testname='SubtractTI_TI_TI2' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-1, op1_ti_h=-1, op1_ti_m=-10, op1_ti_s=-10, &
+> !    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-3, op2_ti_h=-1, op2_ti_m=-20, op2_ti_s=-10, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=00,  &
+> !    testname='SubtractTI_TI_TI3' )
+> !  ! Negative result ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !   op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=1, op1_ti_h=1, op1_ti_m=10, op1_ti_s=10, &
+> !    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=3, op2_ti_h=1, op2_ti_m=20, op2_ti_s=10, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-2, res_ti_h=0, res_ti_m=-10, res_ti_s=0,  &
+> !    testname='SubtractTI_TI_TIN1' )
+> !  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !    op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-1, op1_ti_h=-1, op1_ti_m=-10, op1_ti_s=-10, &
+> !    op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=3, op2_ti_h=1, op2_ti_m=20, op2_ti_s=10, &
+> !    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-4, res_ti_h=-2, res_ti_m=-30, res_ti_s=-20,  &
+> !    testname='SubtractTI_TI_TIN2' )
+> !
+> !  ! Un-normalized ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval
+> !  ! this is an error
+> !!  CALL test_arithmetic( add_op=.FALSE.,                                            &
+> !!    op1_ti_yy=2001, op1_ti_mm=11, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, &
+> !!    op2_ti_yy=2001, op2_ti_mm=11, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, &
+> !!    res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0,  &
+> !!    testname='SubtractTI_TI_TIU1', expect_error=.TRUE. )
+> !
+> !  ! this one should FAIL, and does
+> !!  CALL test_arithmetic( add_op=.TRUE.,                                             &
+> !!     op1_t_yy=2001,  op1_t_mm=12,  op1_t_dd=3,  op1_t_h=1,  op1_t_m=20,  op1_t_s=10, &
+> !!    op2_ti_yy=   0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=3, op2_ti_m=10, op2_ti_s=10, &
+> !!     res_t_yy=2002,  res_t_mm=12,  res_t_dd=3,  res_t_h=4,  res_t_m=30,  res_t_s=20, &
+> !!    testname='AddTT1' )
+> !
+> !  ! Multiplication tests
+> !  ! ESMF_TimeInterval = ESMF_TimeInterval * INTEGER
+> !  CALL test_arithmetic( multiply_op=.TRUE.,                &
+> !    op1_ti_dd=3,  op1_ti_h=12,  op1_ti_m=18,  op1_ti_s=33, &
+> !    op2_int=2,                                             &
+> !    res_ti_dd=6,  res_ti_h=24, res_ti_m=37,  res_ti_s=06,  &
+> !    testname='MultiplyTI_TI_INT1' )
+> !  CALL test_arithmetic( multiply_op=.TRUE.,                &
+> !    op1_ti_dd=350,  op1_ti_h=23,  op1_ti_m=50,  op1_ti_s=50, &
+> !    op2_int=2,                                             &
+> !   res_ti_dd=701,  res_ti_h=23, res_ti_m=41,  res_ti_s=40,&
+> !    testname='MultiplyTI_TI_INT2' )
+> !  CALL test_arithmetic( multiply_op=.TRUE.,                &
+> !    op1_ti_s=01, op1_ti_sn=03, op1_ti_sd=04,               &
+> !    op2_int=8,                                             &
+> !    res_ti_s=14,                                           &
+> !   testname='MultiplyTI_TI_INT3' )
+> !
+> !  ! Division tests
+> !  ! ESMF_TimeInterval = ESMF_TimeInterval / INTEGER
+> !  CALL test_arithmetic( multiply_op=.FALSE.,               &
+> !    op1_ti_dd=3,  op1_ti_h=12,  op1_ti_m=18,  op1_ti_s=33, &
+> !    op2_int=3,                                             &
+> !    res_ti_dd=1,  res_ti_h=04, res_ti_m=06,  res_ti_s=11,  &
+> !    testname='DivideTI_TI_INT1' )
+> !  CALL test_arithmetic( multiply_op=.FALSE.,               &
+> !    op1_ti_dd=3,  op1_ti_h=12,  op1_ti_m=18,  op1_ti_s=33, &
+> !    op2_int=4,                                             &
+> !    res_ti_dd=0,  res_ti_h=21, res_ti_m=04,  res_ti_s=38,  &
+> !    res_ti_sn=1,  res_ti_sd=4,                             &
+> !    testname='DivideTI_TI_INT2' )
+> !  CALL test_arithmetic( multiply_op=.FALSE.,               &
+> !    op1_ti_s=01, op1_ti_sn=03, op1_ti_sd=04,               &
+> !    op2_int=5,                                             &
+> !    res_ti_s=0, res_ti_sn=7,  res_ti_sd=20,                &
+> !    testname='DivideTI_TI_INT3' )
+> !
+> !  ! Test adjust_io_timestr()
+> !!     CT = 2000-01-26_00:00:00   (current time)
+> !!     ST = 2000-01-24_12:00:00   (start time)
+> !!     TI = 00000_03:00:00        (time interval)
+> !! the resulting time string should be:
+> !!     2000-01-26_00:00:00
+1759,1760c1760,1766
+< !    res_str='2000-01-26_00:00:01', testname='adjust_io_timestr_FAIL1' )
+< 
+---
+> !    res_str='2000-01-26_00:00:00', testname='adjust_io_timestr_1' )
+> !! this should fail (and does)
+> !!  CALL test_adjust_io_timestr( TI_h=3, TI_m=0, TI_s=0,          &
+> !!    CT_yy=2000,  CT_mm=1,  CT_dd=26,  CT_h=0,  CT_m=0,  CT_s=0, &
+> !!    ST_yy=2000,  ST_mm=1,  ST_dd=24,  ST_h=12, ST_m=0,  ST_s=0, &
+> !!    res_str='2000-01-26_00:00:01', testname='adjust_io_timestr_FAIL1' )
+> !
+1763,1765c1769,1771
+<     start_yy=2002, start_mm=12, start_dd=27, start_h=3, start_m=0, start_s=0, &
+<      stop_yy=2002,  stop_mm=12,  stop_dd=28,  stop_h=8,  stop_m=0,  stop_s=0, &
+<     timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=600,                 &
+---
+>     start_yy=2024, start_mm=01, start_dd=99, start_h=3, start_m=0, start_s=0, &
+>      stop_yy=2024,  stop_mm=02,  stop_dd=02,  stop_h=8,  stop_m=0,  stop_s=0, &
+>     timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=100,                 &
+1768,1778c1774
+<   CALL test_clock_advance(                                                    &
+<     start_yy=2003, start_mm=12, start_dd=29, start_h=9, start_m=0, start_s=0, &
+<      stop_yy=2004,  stop_mm=1,   stop_dd=2,   stop_h=9,  stop_m=0,  stop_s=0, &
+<     timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=3600,                &
+<     testname="StdYearClockAdvance", increment_S=10 )
+< 
+<   CALL test_clock_advance(                                                    &
+<     start_yy=2004, start_mm=12, start_dd=29, start_h=9, start_m=0, start_s=0, &
+<      stop_yy=2005,  stop_mm=1,   stop_dd=2,   stop_h=9,  stop_m=0,  stop_s=0, &
+<     timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=3600,                &
+<     testname="LeapYearClockAdvance", increment_S=10 )
+---
+>   PRINT *,'END CLOCK ADVANCE'        
+1780,1781d1775
+<   ! NRCM domain 3 case:  120 seconds / 9 
+<   ! 18 timesteps through end of leap year
+1783,1789c1777,1797
+<     start_yy=2004, start_mm=12, start_dd=31, start_h=23, start_m=58, start_s=0,&
+<      stop_yy=2005,  stop_mm=1,   stop_dd=1,   stop_h=0,  stop_m=2,  stop_s=0, &
+<     timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=13,                  &
+<     timestep_sn=1, timestep_sd=3,                                             &
+<     testname="LeapYearFractionClockAdvance",                                  &
+<     increment_S=1, increment_Sn=1, increment_Sd=3 )
+< 
+---
+>     start_yy=2024, start_mm=07, start_dd=74, start_h=23, start_m=00, start_s=0, &
+>      stop_yy=2025,  stop_mm=01,   stop_dd=07,   stop_h=9,  stop_m=0,  stop_s=0, &
+>     timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=1850,                &
+>     testname="StdYearClockAdvance", increment_S=10 )
+> !
+> !  CALL test_clock_advance(                                                    &
+> !    start_yy=2004, start_mm=12, start_dd=29, start_h=9, start_m=0, start_s=0, &
+> !     stop_yy=2005,  stop_mm=1,   stop_dd=2,   stop_h=9,  stop_m=0,  stop_s=0, &
+> !    timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=3600,                &
+> !    testname="LeapYearClockAdvance", increment_S=10 )
+> !
+> !  ! NRCM domain 3 case:  120 seconds / 9 
+> !  ! 18 timesteps through end of leap year
+> !  CALL test_clock_advance(                                                    &
+> !    start_yy=2004, start_mm=12, start_dd=31, start_h=23, start_m=58, start_s=0,&
+> !     stop_yy=2005,  stop_mm=1,   stop_dd=1,   stop_h=0,  stop_m=2,  stop_s=0, &
+> !    timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=13,                  &
+> !    timestep_sn=1, timestep_sd=3,                                             &
+> !    testname="LeapYearFractionClockAdvance",                                  &
+> !    increment_S=1, increment_Sn=1, increment_Sd=3 )
+> !
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/module_symbols_util.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/module_symbols_util.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/module_symbols_util.F90	(revision 2744)
@@ -0,0 +1,122 @@
+! 
+! WARNING:  This file was automatically generated by the findsymbol script 
+! based on WRFV2_20050512_1410.  The following process was used:  
+! 
+! 1) Run the findsymbol script on a machine that has Ruby installed to 
+!    generate this file.  Type "findsymbol -h" for help using findsymbol.  
+!    For example:  
+! >> hender IN loquat:/loquat2/hender/Ruby/FortranTools/ >> findsymbol -d /users/hender/Tasks/WRF_ESMF/WRFV2_20050512_1410_WORK/WRFV2/external/esmf_time_f90 -S ESMF_ -p -g WRFU_ -o ESMF_Mod -n module_symbols_util > & ! module_symbols_util.F90
+! 
+! 2) Added this comment block by hand.
+!
+      MODULE module_symbols_util
+
+        USE ESMF_Mod, WRFU_ALARM => ESMF_ALARM
+        USE ESMF_Mod, WRFU_ALARMCREATE => ESMF_ALARMCREATE
+        USE ESMF_Mod, WRFU_ALARMDESTROY => ESMF_ALARMDESTROY
+        USE ESMF_Mod, WRFU_ALARMDISABLE => ESMF_ALARMDISABLE
+        USE ESMF_Mod, WRFU_ALARMENABLE => ESMF_ALARMENABLE
+        USE ESMF_Mod, WRFU_ALARMGET => ESMF_ALARMGET
+        USE ESMF_Mod, WRFU_ALARMISRINGING => ESMF_ALARMISRINGING
+        USE ESMF_Mod, WRFU_ALARMPRINT => ESMF_ALARMPRINT
+        USE ESMF_Mod, WRFU_ALARMRINGEROFF => ESMF_ALARMRINGEROFF
+        USE ESMF_Mod, WRFU_ALARMRINGERON => ESMF_ALARMRINGERON
+        USE ESMF_Mod, WRFU_ALARMSET => ESMF_ALARMSET
+        USE ESMF_Mod, WRFU_ALARMVALIDATE => ESMF_ALARMVALIDATE
+        USE ESMF_Mod, WRFU_ATTRIBUTE => ESMF_ATTRIBUTE
+        USE ESMF_Mod, WRFU_ATTRIBUTECOPY => ESMF_ATTRIBUTECOPY
+        USE ESMF_Mod, WRFU_ATTRIBUTECOPYALL => ESMF_ATTRIBUTECOPYALL
+        USE ESMF_Mod, WRFU_ATTRIBUTEGET => ESMF_ATTRIBUTEGET
+        USE ESMF_Mod, WRFU_ATTRIBUTEGETBYNUMBER => ESMF_ATTRIBUTEGETBYNUMBER
+        USE ESMF_Mod, WRFU_ATTRIBUTEGETCOUNT => ESMF_ATTRIBUTEGETCOUNT
+        USE ESMF_Mod, WRFU_ATTRIBUTEGETLIST => ESMF_ATTRIBUTEGETLIST
+        USE ESMF_Mod, WRFU_ATTRIBUTEGETNAMELIST => ESMF_ATTRIBUTEGETNAMELIST
+        USE ESMF_Mod, WRFU_ATTRIBUTEGETOBJECTLIST => ESMF_ATTRIBUTEGETOBJECTLIST
+        USE ESMF_Mod, WRFU_ATTRIBUTESET => ESMF_ATTRIBUTESET
+        USE ESMF_Mod, WRFU_ATTRIBUTESETLIST => ESMF_ATTRIBUTESETLIST
+        USE ESMF_Mod, WRFU_ATTRIBUTESETOBJECTLIST => ESMF_ATTRIBUTESETOBJECTLIST
+        USE ESMF_Mod, WRFU_AXISINDEX => ESMF_AXISINDEX
+        USE ESMF_Mod, WRFU_AXISINDEXGET => ESMF_AXISINDEXGET
+        USE ESMF_Mod, WRFU_BAD_POINTER => ESMF_BAD_POINTER
+        USE ESMF_Mod, WRFU_BASE => ESMF_BASE
+        USE ESMF_Mod, WRFU_BASETIME => ESMF_BASETIME
+        USE ESMF_Mod, WRFU_CALENDAR => ESMF_CALENDAR
+        USE ESMF_Mod, WRFU_CALENDARTYPE => ESMF_CALENDARTYPE
+        USE ESMF_Mod, WRFU_CAL_360DAY => ESMF_CAL_360DAY
+        USE ESMF_Mod, WRFU_CAL_GREGORIAN => ESMF_CAL_GREGORIAN
+        USE ESMF_Mod, WRFU_CAL_NOCALENDAR => ESMF_CAL_NOCALENDAR
+        USE ESMF_Mod, WRFU_CAL_NOLEAP => ESMF_CAL_NOLEAP
+        USE ESMF_Mod, WRFU_CLOCK => ESMF_CLOCK
+        USE ESMF_Mod, WRFU_CLOCKADDALARM => ESMF_CLOCKADDALARM
+        USE ESMF_Mod, WRFU_CLOCKADVANCE => ESMF_CLOCKADVANCE
+        USE ESMF_Mod, WRFU_CLOCKCREATE => ESMF_CLOCKCREATE
+        USE ESMF_Mod, WRFU_CLOCKDESTROY => ESMF_CLOCKDESTROY
+        USE ESMF_Mod, WRFU_CLOCKGET => ESMF_CLOCKGET
+        USE ESMF_Mod, WRFU_CLOCKGETALARMLIST => ESMF_CLOCKGETALARMLIST
+        USE ESMF_Mod, WRFU_CLOCKISSTOPTIME => ESMF_CLOCKISSTOPTIME
+        USE ESMF_Mod, WRFU_CLOCKPRINT => ESMF_CLOCKPRINT
+        USE ESMF_Mod, WRFU_CLOCKSET => ESMF_CLOCKSET
+        USE ESMF_Mod, WRFU_CLOCKSTOPTIMEDISABLE => ESMF_CLOCKSTOPTIMEDISABLE
+        USE ESMF_Mod, WRFU_CLOCKVALIDATE => ESMF_CLOCKVALIDATE
+        USE ESMF_Mod, WRFU_DATATYPE => ESMF_DATATYPE
+        USE ESMF_Mod, WRFU_DATATYPESTRING => ESMF_DATATYPESTRING
+        USE ESMF_Mod, WRFU_DATAVALUE => ESMF_DATAVALUE
+        USE ESMF_Mod, WRFU_DATA_CHARACTER => ESMF_DATA_CHARACTER
+        USE ESMF_Mod, WRFU_DATA_INTEGER => ESMF_DATA_INTEGER
+        USE ESMF_Mod, WRFU_DATA_LOGICAL => ESMF_DATA_LOGICAL
+        USE ESMF_Mod, WRFU_DATA_REAL => ESMF_DATA_REAL
+        USE ESMF_Mod, WRFU_FAILURE => ESMF_FAILURE
+        USE ESMF_Mod, WRFU_FINALIZE => ESMF_FINALIZE
+        USE ESMF_Mod, WRFU_FRACTION => ESMF_FRACTION
+        USE ESMF_Mod, WRFU_GETNAME => ESMF_GETNAME
+        USE ESMF_Mod, WRFU_GETPOINTER => ESMF_GETPOINTER
+        USE ESMF_Mod, WRFU_GRID => ESMF_GRID
+        USE ESMF_Mod, WRFU_GRIDCOMP => ESMF_GRIDCOMP
+        USE ESMF_Mod, WRFU_INITIALIZE => ESMF_INITIALIZE
+        USE ESMF_Mod, WRFU_ISINITIALIZED => ESMF_ISINITIALIZED
+        USE ESMF_Mod, WRFU_KIND_C16 => ESMF_KIND_C16
+        USE ESMF_Mod, WRFU_KIND_C8 => ESMF_KIND_C8
+        USE ESMF_Mod, WRFU_KIND_I1 => ESMF_KIND_I1
+        USE ESMF_Mod, WRFU_KIND_I2 => ESMF_KIND_I2
+        USE ESMF_Mod, WRFU_KIND_I4 => ESMF_KIND_I4
+        USE ESMF_Mod, WRFU_KIND_I8 => ESMF_KIND_I8
+        USE ESMF_Mod, WRFU_KIND_R4 => ESMF_KIND_R4
+        USE ESMF_Mod, WRFU_KIND_R8 => ESMF_KIND_R8
+        USE ESMF_Mod, WRFU_LOG => ESMF_LOG
+        USE ESMF_Mod, WRFU_LOGICAL => ESMF_LOGICAL
+        USE ESMF_Mod, WRFU_LOGWRITE => ESMF_LOGWRITE
+        USE ESMF_Mod, WRFU_LOG_ERROR => ESMF_LOG_ERROR
+        USE ESMF_Mod, WRFU_LOG_INFO => ESMF_LOG_INFO
+        USE ESMF_Mod, WRFU_LOG_WARNING => ESMF_LOG_WARNING
+        USE ESMF_Mod, WRFU_MAJOR_VERSION => ESMF_MAJOR_VERSION
+        USE ESMF_Mod, WRFU_MAXDECOMPDIM => ESMF_MAXDECOMPDIM
+        USE ESMF_Mod, WRFU_MAXDIM => ESMF_MAXDIM
+        USE ESMF_Mod, WRFU_MAXGRIDDIM => ESMF_MAXGRIDDIM
+        USE ESMF_Mod, WRFU_MAXSTR => ESMF_MAXSTR
+        USE ESMF_Mod, WRFU_MINOR_VERSION => ESMF_MINOR_VERSION
+        USE ESMF_Mod, WRFU_MSGTYPE => ESMF_MSGTYPE
+        USE ESMF_Mod, WRFU_NULL_POINTER => ESMF_NULL_POINTER
+        USE ESMF_Mod, WRFU_POINTER => ESMF_POINTER
+        USE ESMF_Mod, WRFU_REVISION => ESMF_REVISION
+        USE ESMF_Mod, WRFU_SETNAME => ESMF_SETNAME
+        USE ESMF_Mod, WRFU_SETNULLPOINTER => ESMF_SETNULLPOINTER
+        USE ESMF_Mod, WRFU_SETPOINTER => ESMF_SETPOINTER
+        USE ESMF_Mod, WRFU_STATE => ESMF_STATE
+        USE ESMF_Mod, WRFU_STATE_INVALID => ESMF_STATE_INVALID
+        USE ESMF_Mod, WRFU_STATUS => ESMF_STATUS
+        USE ESMF_Mod, WRFU_STATUSSTRING => ESMF_STATUSSTRING
+        USE ESMF_Mod, WRFU_SUCCESS => ESMF_SUCCESS
+        USE ESMF_Mod, WRFU_TIME => ESMF_TIME
+        USE ESMF_Mod, WRFU_TIMEGET => ESMF_TIMEGET
+        USE ESMF_Mod, WRFU_TIMEINTERVAL => ESMF_TIMEINTERVAL
+        USE ESMF_Mod, WRFU_TIMEINTERVALABSVALUE => ESMF_TIMEINTERVALABSVALUE
+        USE ESMF_Mod, WRFU_TIMEINTERVALDIVQUOT => ESMF_TIMEINTERVALDIVQUOT
+        USE ESMF_Mod, WRFU_TIMEINTERVALGET => ESMF_TIMEINTERVALGET
+        USE ESMF_Mod, WRFU_TIMEINTERVALNEGABSVALUE => ESMF_TIMEINTERVALNEGABSVALUE
+        USE ESMF_Mod, WRFU_TIMEINTERVALSET => ESMF_TIMEINTERVALSET
+        USE ESMF_Mod, WRFU_TIMESET => ESMF_TIMESET
+        USE ESMF_Mod, WRFU_VERSION_STRING => ESMF_VERSION_STRING
+        USE ESMF_Mod, WRFU_VM => ESMF_VM
+
+      END MODULE module_symbols_util
+
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/module_utility.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/module_utility.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/module_utility.F90	(revision 2744)
@@ -0,0 +1,7 @@
+
+      MODULE module_utility
+
+        USE module_symbols_util
+
+      END MODULE module_utility
+
Index: trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/testall.csh
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/testall.csh	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/esmf_time_f90/testall.csh	(revision 2744)
@@ -0,0 +1,46 @@
+#!/bin/csh
+#
+# Build and run Test1.exe and compare results with known-good output
+#
+set selflong = $0
+set self = $selflong:t
+
+if ( ! -f ../../configure.wrf ) then
+  echo "ERROR:  must run ../../configure before building esmf_time_f90 unit tests"
+  exit -1
+endif
+
+# build
+set allpass = "true"
+make superclean >& /dev/null
+cd ../.. ; make esmf_time_f90_only >&! external/esmf_time_f90/make_tests.out ; cd external/esmf_time_f90
+# run tests for both ESMF_ and WRFU_ interfaces...  
+set testoutok = "Test1.out.correct"
+foreach tst ( "ESMF" "WRFU" )
+  set testname = "Test1_${tst}"
+  ./${testname}.exe >&! ${testname}.out || echo "ERROR ${testname}:  failed to execute ./${testname}.exe, see make_tests.out" && exit 20
+  # evaluate test results
+  diff ${testoutok} ${testname}.out >& /dev/null
+  set ok = $status
+  if ( $ok == 0 ) then
+    echo "PASS ${testname}"
+  else
+    set allpass = "false"
+    echo
+    echo "FAIL ${testname}"
+    echo
+    which xxdiff >& /dev/null
+    set ok = $status
+    if ( $ok == 0 ) then
+      xxdiff ${testoutok} ${testname}.out
+    else
+      diff ${testoutok} ${testname}.out
+    endif
+  endif
+end
+# clean up if all tests passed
+if ( $allpass == "true" ) then
+#  make testclean >& /dev/null
+  make superclean >& /dev/null
+endif
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/README.io_esmf
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/README.io_esmf	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/README.io_esmf	(revision 2744)
@@ -0,0 +1,51 @@
+file README.io_esmf
+Tom Henderson                                          10/10/06
+
+This version of WRF has been tested with ESMF 2.2.0rp1.  Since ESMF interfaces 
+are still changing with each new release, it is quite likely that this version 
+of WRF will not work with other versions of ESMF.  
+
+NOTE:  ESMF 3.0.0 is available at the time of this writing.  However, 
+       ESMF 3.0.0 fails to build with IBM's xlf 10.1 compiler.  (The ESMF core 
+       team expects this problem to be resolved by a later release of xlf.)  
+       Therefore WRF was not tested with ESMF 3.0.0.  
+
+New environment variables ESMFLIB and ESMFINC may be set to trigger 
+build using a separately installed ESMF library instead of the default 
+library embedded in external/esmf_time_f90/.  These new environment variables 
+must be set to point to library and module paths for the separately 
+installed ESMF library before WRF "configure" is run.  For example, an 
+installation of ESMF on bluesky built with default ESMF settings in 
+/home/bluesky/hender/esmf requires the following settings:  
+  ESMFLIB /home/bluesky/hender/esmf/lib/libO/AIX.default.32.default
+  ESMFINC /home/bluesky/hender/esmf/mod/modO/AIX.default.32.default
+(Note that the portions of the pathnames following 
+"/home/bluesky/hender/esmf/" are defined by ESMF and described in the ESMF 
+documentation.)  
+
+When ESMFLIB and ESMFINC are set, a new main program is built in 
+main/wrf_SST_ESMF.exe.  This program is a sample coupled application in 
+which WRF is coupled to a very simple "data-ocean" component named SST via 
+a very simple coupler.  While this is a functional example of coupling WRF 
+to another ESMF component, it should be considered *HIGHLY EXPERIMENTAL*.  
+The implementation is quite primitive and has severe limitations.  
+Most important, it is only possible to couple with another component that 
+uses the exact same grid as WRF due to limitations of ESMF at the time this 
+work was done.  Also, the ESMF component only works with the DM-Parallel RSL 
+build and has only been tested on AIX.  These and a large number of other 
+issues are described in external/io_esmf/TODO.list.  
+
+Since external/io_esmf is an implementation of the WRF I/O and coupling 
+API (WRF IOAPI), ESMF coupling can be controlled by the user in the same 
+manner as other WRF I/O.  Specifically, contents of ESMF import and export 
+states are defined in the Registry (see Registry.EM_SST for example) and 
+timing of coupling is defined in namelist.input.  In the case of the WRF-SST 
+coupling example, the SST component simply reads SST values stored in a file 
+and sends it to WRF.  Since the SST component also uses the WRF IOAPI and 
+the format and metadata of SST data files is compatible with the WRF IOAPI, 
+it is possible to switch from coupled operation to stand-alone operation (in 
+which WRF reads the SST data directly via auxinput5), simply by changing 
+the io_form in the namelist.  
+
+This is a work-in-progress!  
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/TODO.list
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/TODO.list	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/TODO.list	(revision 2744)
@@ -0,0 +1,141 @@
+TODO.list
+Tom Henderson                                                           5/19/06
+
+WRF-ESMF TODO LIST:  
+
+
+WRF-ESMF is still new and experimental and has many limitations.  Many of 
+these are mentioned in the task list that follows.  
+
+
+"X" == "DONE"  
+
+The "ESMF" referred to below is version 2.2.0rp1.  
+
++ Design and Implementation:
+   - Get rid of masses of "DEBUG" code.  
+   - Fix ESMF+RSL_LITE.  Currently, only ESMF+RSL works.  
+       Patch and memory extents differ between RSL and RSL_LITE, see
+       /users/hender/Tasks/WRF_ESMF/RSL_LITE_broken/README for details.  This 
+       is almost certainly the underlying cause of the problem given the 
+       evil hackery in the current implementation of io_esmf.  
+   - Finish sequence diagram for the coupling interactions in
+     /users/hender/Tasks/WRF_ESMF/SequenceDiagram.txt ...
+   - Upgrade SST component so it can run on a subset of processors.  
+       This requires breaking the domdesc dependence for SST so SST can be 
+       run on fewer processes.  SST will need to call wrf_dm_patch_domain(), 
+       probably modified to avoid dependence on TYPE(domain) and certainly 
+       modified to avoid dependence on head_grid.  
+   - Upgrade external/io_esmf/ so more data types are supported.  
+   - Upgrade external/io_esmf/ so 3D arrays are supported (just loop over "K" 
+     at first with hard-coded names like "U_k_1", "U_k_2", etc.).  Then 
+     switch to ESMF for this once it can do it.  (Can ESMF do this now?  Check.)  
+   - Extend external/io_esmf/ (etc.) so more than one I/O stream can be used 
+     for ESMF coupling.  This would involve nested import and export states.  
+   - Exchange staggered 2D grids and test-validate (x, y, and z staggerings).  
+     Current hacked implementation should be able to handle this for 
+     horizontal staggerings, but need to test in case bugs are lurking...  
+   - Upgrade external/io_esmf/ so metadata is exchanged correctly.  Right now, 
+     metadata is ignored.  This would allow sharing of metadata and simplify 
+     implementation of components that were aware of WRF metadata.  Ultimately, 
+     CF would be the right thing here...  
+   - Fix output formatting so DOMAIN_TIME_TEST works the same way 
+     both with and without ESMF.  
+   - Fix ext_esmf_ioclose so it actually destroys ESMF objects again.  This
+     is #ifdef'd out at the moment due to difficulties with destruction.  (At 
+     present, ESMF requires users to deallocate anything they allocate, but 
+     provides no introspection so a user can figure out if who allocated 
+     something.  This leads to obfuscation of implementations...)  
+   X Make WRF-ESMF build recognize ESMF environment variables?
+     Could remove stanzas from arch/configure.defaults and avoid lots
+     of duplication and documentation.
+   - If possible, upgrade WRF ESMF component to get number of MPI tasks from 
+     VM instead of from MPI.  This may be tricky or even impractical due to 
+     startup issues...  
+   - CF conventions:  
+     * Numerous tasks here, not really a "WRF-ESMF" issue, but related...  
+         Will there be CF conventions for startTime, stopTime, timeStep, 
+         couplingInterval?
+   - Other ESMF bugs/issues:  
+     * Rip out the current hacks for grid creation in external/io_esmf/ once 
+       ESMF can support WRF map projections.  Use the "sieve" method of 
+       io_mcel.  This will take a bit of work...  
+     * Restore ESMF_LogErr calls once ESMF fixes them so they no longer 
+       truncate all of our messages (trivial for us...).  
+        * Ask when ESMF_LogErr will allow us to specify LUN.  This will
+          make it easier for us to use this utility.  
+     * Upgrade external/io_esmf/ to avoid manual CICO once ESMF can mimic WRF 
+       memory layouts.  
+     * Index ordering is hard-coded.  Fix this once ESMF supports it and 
+       connect to "MemoryOrder" argument.  
+     * Take a look at my list of reported ESMF bugs and add any I haven't 
+       reported.  
+     * Calls to ESMF_LogSet in main/wrf_ESMFApp.F cause core dumps -- why?  
+     * Calls to ESMF_ArraySpecSet() in external/io_esmf/ quietly do the wrong 
+       thing.  Why?  Once they work, uncomment this code to avoid 
+       per-data-type duplication of hard-coded alternative (gaaak).  See 
+       string DOESNOTWORK.  
+     * ESMF cannot handle "extra" rows-columns implied by horizontal
+       staggering for regional models like WRF.  Upgrade once ESMF supports 
+       this.  
+       * Re-connect "Stagger" argument to ESMF "horzrelloc" argument.  
+         Uncomment this code in external/io_esmf/.  
+       * Until then, maybe use nested ESMF_States to handle it.  This is ugly 
+         though because there are no conventions for such a thing so it will 
+         introduce dependencies with other components.  Balaji's recent 
+         proposal to standardize grid metadata within CF would be useful 
+         if we go this way.  
+     * Why can I specify start indices in the call to 
+       ESMF_GridDistribute[Vector]() but not in the call to ESMF_GridSet() ?
+     * Remove implementation of WRFU_TimeIntervalDIVQuot in 
+       external/io_esmf/module_esmf_extensions.F90 once ESMF supports this 
+       directly.  
+     * Lack of sane (or any) iterators for ESMF_State and other container 
+       classes leads to nasty user code...  
+     * Lack of adherence to Orthodox Canonical Form leads to really nasty 
+       user code (so much for "best practices"...)  
+     * Many others...  
+   - Misc. bugs/issues:
+     * Investigate odd debug prints from med_hist_out, output_wrf, input_wrf
+        med_hist_out : opening sstout_d01_000000 for writing.  86
+          I think the "86" should be "0"
+        output_wrf: fid,filestate =  2 65
+          I think the "65" should be "0"
+        input_wrf: fid,filestate =  3 804370368
+          I think the "804370368" should be something else...
+     * Find out why one new message now appears in stdout (weird).  
+         This happens with a "no-esmf" build and with an "esmf" build.  
+           INPUT LANDUSE = USGS
+           LANDUSE TYPE = USGS FOUND 24  CATEGORIES 2  SEASONS WATER CATEGORY =  16  SNOW CATEGORY =  24
+     * Replace hand-coded checks of "rc" with use of new ESMF error handler to 
+       streamline code.  
+         See /loquat2/hender/Tasks/WRF_ESMF/ESMF_FieldFromUserEx.F90
+         See /loquat2/hender/Tasks/WRF_ESMF/UserCodeMod.F90
+     * See if "#ifndef ESMFIO" hack can be removed from share/input_wrf.F.  
+     * Verify that findSymbol.rb generates module_symbols.F90 as claimed
+       in the comment block in external/io_esmf/module_symbols_util.F90.  
+       Update comments if needed.  
+       * Upgrade findSymbol.rb to track all usage starting at @old_module 
+         and exclude any symbols that are not found in the use-tree.
+       * Better yet, get rid of external/*/module_symbols_util.F90 altogether 
+         as encapsulation moves to module_domain.  
+     * Rip out WRF_CHEM from set_timekeeping.F and test...
++ Upgrade to ESMF 2.2.2r+
+   - Add an ESMF_LOG_NONE option to the "defaultLogType" argument 
+     of ESMF_Initialize() to turn off ESMF's default error logging.  
+   - Add an ESMF_KEEPMPI option to the "terminationflag" argument 
+     of ESMF_Finalize() to allow ESMF finalization without MPI 
+     shutdown.  Then clean up the current shutdown mess.  
++ Documentation:
+   - General description of and guidelines for coupling WRF with another
+     ESMF component.
+   X Description of WRF-CPL-SST "demo"
+     X Description of SST and CPL demo components
+     * Sequence diagram of component interactions
+     X Limitations of demo
+     * How to extend the demo
++ Testing
+   - Add WRF-CPL-SST tests to regtest.csh.  
+     * Generate jun01 sst warming data set and work with Dave to add new 
+       "ESMF_SST" tests to regtest.csh.  
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_open_for_read.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_open_for_read.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_open_for_read.F90	(revision 2744)
@@ -0,0 +1,67 @@
+!--- open_for_read_begin
+SUBROUTINE ext_esmf_open_for_read_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                         DataHandle , Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  CHARACTER*(*)               :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*)               :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  ! Local declarations
+  INTEGER :: i
+  TYPE(ESMF_State), POINTER :: importstate
+  TYPE(ESMF_StateType) :: statetype
+  INTEGER :: rc, itemCount
+
+  CALL int_get_fresh_handle(i)
+  okay_to_write(i) = .false.
+  okay_to_read(i) = .false.
+  opened_for_read(i) = .true.
+  opened_for_write(i) = .false.
+  DataHandle = i
+
+  ! Grab the current importState and ensure that it is empty
+  CALL ESMF_ImportStateGetCurrent(importstate, rc)
+  IF ( rc /= ESMF_SUCCESS ) THEN
+    CALL wrf_error_fatal("ext_esmf_open_for_read:  ESMF_ImportStateGetCurrent failed" )
+  ENDIF
+  ! For now, If the import state is not empty, whine and die.
+!$$$ Eventually, use nested states to allow than one auxinput stream 
+!$$$ to be supported via ESMF.  
+!$$$ Eventually, get smart about interacting with "needed" and "optional" 
+!$$$ named state items
+  CALL ESMF_StateGet( importstate, itemCount=itemCount, &
+                      statetype=statetype, rc=rc )
+  IF ( rc /= ESMF_SUCCESS ) THEN
+    CALL wrf_error_fatal("ext_esmf_open_for_read:  ESMF_ImportStateGet failed" )
+  ENDIF
+  IF ( statetype /= ESMF_STATE_IMPORT ) THEN
+    CALL wrf_error_fatal("ext_esmf_open_for_read:  not an import state" )
+  ENDIF
+  IF ( itemCount /= 0 ) THEN
+    CALL wrf_error_fatal("ext_esmf_open_for_read:  import state not empty, io_esmf is currently limited to only one auxinput stream" )
+  ENDIF
+
+  Status = 0
+  RETURN  
+END SUBROUTINE ext_esmf_open_for_read_begin
+
+
+!--- open_for_read_commit
+SUBROUTINE ext_esmf_open_for_read_commit( DataHandle , Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER , INTENT(IN ) :: DataHandle
+  INTEGER , INTENT(OUT) :: Status
+
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      okay_to_read( DataHandle ) = .true.
+    ENDIF
+  ENDIF
+
+  Status = 0
+  RETURN  
+END SUBROUTINE ext_esmf_open_for_read_commit
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_open_for_write.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_open_for_write.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_open_for_write.F90	(revision 2744)
@@ -0,0 +1,67 @@
+!--- open_for_write_begin
+SUBROUTINE ext_esmf_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                          DataHandle , Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  CHARACTER*(*)               :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*)               :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  ! Local declarations
+  INTEGER :: i
+  TYPE(ESMF_State), POINTER :: exportstate
+  TYPE(ESMF_StateType) :: statetype
+  INTEGER :: rc, itemCount
+
+  CALL int_get_fresh_handle(i)
+  okay_to_write(i) = .false.
+  okay_to_read(i) = .false.
+  opened_for_read(i) = .false.
+  opened_for_write(i) = .true.
+  DataHandle = i
+
+  ! Grab the current exportState and ensure that it is empty
+  CALL ESMF_ExportStateGetCurrent(exportstate, rc)
+  IF ( rc /= ESMF_SUCCESS ) THEN
+    CALL wrf_error_fatal("ext_esmf_open_for_write:  ESMF_ExportStateGetCurrent failed" )
+  ENDIF
+  ! For now, If the export state is not empty, whine and die.
+!$$$ Eventually, use nested states to allow than one auxhist stream 
+!$$$ to be supported via ESMF.  
+!$$$ Eventually, get smart about interacting with "needed" and "optional" 
+!$$$ named state items
+  CALL ESMF_StateGet( exportstate, itemCount=itemCount, &
+                      statetype=statetype, rc=rc )
+  IF ( rc /= ESMF_SUCCESS ) THEN
+    CALL wrf_error_fatal("ext_esmf_open_for_write:  ESMF_ExportStateGet failed" )
+  ENDIF
+  IF ( statetype /= ESMF_STATE_EXPORT ) THEN
+    CALL wrf_error_fatal("ext_esmf_open_for_write:  not an export state" )
+  ENDIF
+  IF ( itemCount /= 0 ) THEN
+    CALL wrf_error_fatal("ext_esmf_open_for_write:  export state not empty, io_esmf is currently limited to only one auxhist stream" )
+  ENDIF
+
+  Status = 0
+  RETURN  
+END SUBROUTINE ext_esmf_open_for_write_begin
+
+
+!--- open_for_write_commit
+SUBROUTINE ext_esmf_open_for_write_commit( DataHandle , Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER , INTENT(IN ) :: DataHandle
+  INTEGER , INTENT(OUT) :: Status
+
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      okay_to_write( DataHandle ) = .true.
+    ENDIF
+  ENDIF
+
+  Status = 0
+  RETURN  
+END SUBROUTINE ext_esmf_open_for_write_commit
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_read_field.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_read_field.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_read_field.F90	(revision 2744)
@@ -0,0 +1,384 @@
+
+!$$$here...  TBH:  remove duplication between ext_esmf_read_field and 
+!$$$here...  TBH:  ext_esmf_write_field
+
+!$$$here...  TBH:  how to deal with time?  (via current ESMF_Clock)
+!$$$here...  TBH:  to begin, use it as an error check!  
+
+
+!--- read_field
+SUBROUTINE ext_esmf_read_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
+                                 DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                 DomainStart , DomainEnd ,                                    &
+                                 MemoryStart , MemoryEnd ,                                    &
+                                 PatchStart , PatchEnd ,                                      &
+                                 Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER       ,INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) ,intent(inout) :: DateStr
+  CHARACTER*(*) ,intent(inout) :: VarName
+  integer       ,intent(inout) :: FieldType
+  integer       ,intent(inout) :: Comm
+  integer       ,intent(inout) :: IOComm
+  integer       ,intent(inout) :: DomainDesc
+  character*(*) ,intent(inout) :: MemoryOrder
+  character*(*) ,intent(inout) :: Stagger
+  character*(*) ,intent(inout) :: DimNames(*)
+  integer       ,intent(inout) :: DomainStart(*), DomainEnd(*)
+  integer       ,intent(inout) :: MemoryStart(*), MemoryEnd(*)
+  integer       ,intent(inout) :: PatchStart(*),  PatchEnd(*)
+  REAL          ,INTENT(INOUT) :: Field(*)
+  integer       ,intent(out)   :: Status
+  ! Local declarations
+  INTEGER :: ids,ide,jds,jde,kds,kde
+  INTEGER :: ims,ime,jms,jme,kms,kme
+  INTEGER :: ips,ipe,jps,jpe,kps,kpe
+  TYPE(ESMF_State), POINTER :: importstate
+  TYPE(ESMF_Field) :: tmpField
+  TYPE(ESMF_Array) :: tmpArray
+  TYPE(ESMF_ArraySpec) :: arrayspec
+  TYPE(ESMF_DataKind) :: esmf_kind
+  TYPE(ESMF_DataType) :: esmf_type
+  TYPE(ESMF_RelLoc) :: horzRelloc
+  REAL(ESMF_KIND_R4), POINTER :: data_esmf_real_ptr(:,:)
+  REAL(ESMF_KIND_R4), POINTER :: tmp_esmf_r4_ptr(:,:)
+  INTEGER(ESMF_KIND_I4), POINTER :: data_esmf_int_ptr(:,:)
+  INTEGER, PARAMETER :: esmf_rank = 2
+  INTEGER :: DomainEndFull(esmf_rank), idefull, jdefull, ict, i, j
+  INTEGER :: PatchEndFull(esmf_rank), ipefull, jpefull
+  ! esmf_counts is redundant.  remove it as soon as ESMF_ArrayCreate no 
+  ! longer requires it
+  INTEGER :: esmf_counts(esmf_rank)
+  INTEGER :: rc
+  LOGICAL, EXTERNAL :: has_char
+  character*256 mess
+!$$$DEBUG
+INTEGER, SAVE :: numtimes=0   ! track number of calls
+CHARACTER(LEN=256) :: timestamp
+!REAL :: debug_real(MemoryStart(1):MemoryEnd(1),MemoryStart(2):MemoryEnd(2))
+!$$$END DEBUG
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_esmf_read_field: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_esmf_read_field: DataHandle not opened" )
+  ENDIF
+  IF ( .NOT. opened_for_read( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_esmf_read_field: DataHandle not opened for read" )
+  ENDIF
+
+write(mess,*)'ext_esmf_read_field ',DataHandle, TRIM(DateStr), TRIM(VarName)
+call wrf_debug( 300, TRIM(mess) )
+
+  IF      ( FieldType .EQ. WRF_REAL ) THEN
+    esmf_type = ESMF_DATA_REAL
+    esmf_kind = ESMF_R4
+  ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+!    esmf_type = ESMF_DATA_REAL
+!    esmf_kind = ESMF_R8
+    CALL wrf_error_fatal( 'ext_esmf_read_field, WRF_DOUBLE not yet supported')
+  ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+    esmf_type = ESMF_DATA_INTEGER
+    esmf_kind = ESMF_I4
+!$$$ implement this (below)
+    CALL wrf_error_fatal( 'ext_esmf_read_field, WRF_INTEGER not yet implemented')
+  ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+    CALL wrf_error_fatal( 'ext_esmf_read_field, WRF_LOGICAL not yet supported')
+  ENDIF
+
+  ims = MemoryStart(1) ; ime = MemoryEnd(1)
+  jms = MemoryStart(2) ; jme = MemoryEnd(2)
+  kms = MemoryStart(3) ; kme = MemoryEnd(3)
+
+  ips = PatchStart(1) ; ipe = PatchEnd(1)
+  jps = PatchStart(2) ; jpe = PatchEnd(2)
+  kps = PatchStart(3) ; kpe = PatchEnd(3)
+
+  ids = DomainStart(1) ; ide = DomainEnd(1)
+  jds = DomainStart(2) ; jde = DomainEnd(2)
+  kds = DomainStart(3) ; kde = DomainEnd(3)
+
+  ! For now, treat all arrays as 2D...  
+!$$$ Eventually, use ../io_netcdf subroutines Transpose() and reorder() 
+!$$$ (and etc.) to handle general array ranks and index orderings.  
+!$$$ Some copies of these exist in ../../frame/module_io.F.  
+!$$$ Then use ESMF_ArrayDataMap class to handle index mapping.  
+  IF ( kms /= kme ) THEN
+    CALL wrf_error_fatal( 'ext_esmf_read_field:  rank > 2 not yet supported')
+  ENDIF
+
+! The non-staggered variables come in at one-less than
+! domain dimensions, but io_esmf is currently hacked to use full
+! domain spec, so adjust if not staggered.
+! $$$ TBD:  Remove EndFull hackery once ESMF can support staggered 
+! $$$ TBD:  grids in regional models.  (This hack works around the current 
+! $$$ TBD:  need to use only larger staggered dimensions for ESMF_Arrays.)  
+  CALL ioesmf_endfullhack( esmf_rank, DomainEnd, PatchEnd, Stagger, &
+                           DomainEndFull, PatchEndFull )
+  idefull = DomainEndFull(1)
+  jdefull = DomainEndFull(2)
+  ipefull = PatchEndFull(1)
+  jpefull = PatchEndFull(2)
+
+write(mess,*) ' ext_esmf_read_field: okay_to_read: ', DataHandle, okay_to_read(DataHandle)
+call wrf_debug( 300, TRIM(mess) )
+
+  ! case 1: the file is opened for read but not committed ("training")
+  IF ( .NOT. okay_to_read( DataHandle ) )  THEN
+
+    ! Training:  build the ESMF import state
+write(mess,*) ' ext_esmf_read_field: TRAINING READ:  DataHandle = ', DataHandle
+call wrf_debug( 300, TRIM(mess) )
+
+    ! First, build the ESMF_Grid for this DataHandle, if it does not 
+    ! already exist
+    CALL ioesmf_create_grid( DataHandle, esmf_rank, MemoryOrder, Stagger,      &
+                             DomainStart(1:esmf_rank), DomainEnd(1:esmf_rank), &
+                             MemoryStart(1:esmf_rank), MemoryEnd(1:esmf_rank), &
+                             PatchStart(1:esmf_rank), PatchEnd(1:esmf_rank) )
+    ! Grab the current importState and add to it...
+    CALL ESMF_ImportStateGetCurrent( importstate, rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      CALL wrf_error_fatal("ext_esmf_read_field, training:  ESMF_ImportStateGetCurrent failed" )
+    ENDIF
+! BEGIN DOESNOTWORK
+! The following code does not work for reasons as-yet unknown.  
+! A likely suspect is lbounds and ubounds which fail in other interfaces in 
+! ESMF 2.2.0rp1 ...  
+    ! Build ESMF objects...  
+    ! Build an ESMF_ArraySpec.  The use of ESMF_ArraySpec and ESMF_Array 
+    ! objects allows some of the code that follows to be type-kind-independent.  
+!    CALL ESMF_ArraySpecSet(arrayspec, rank=esmf_rank, type=esmf_type, &
+!                                      kind=esmf_kind, rc=rc)
+!    IF ( rc /= ESMF_SUCCESS ) THEN
+!      CALL wrf_error_fatal("ext_esmf_read_field:  ESMF_ArraySpecSet failed" )
+!    ENDIF
+    ! Build an ESMF_Array
+    ! Implementation note:  since we do not yet have full control over how 
+    ! ESMF chooses to lay out a "patch" within "memory", we must copy by 
+    ! hand.  (Reasons include lack of support in ESMF for asymmetric halos, 
+    ! addition of "extra" rows/columns to optimize alignment on some machines, 
+    ! handling of periodic boundary conditions, etc.)  Thus, there 
+    ! is no point in using larger "memory" sizes to build the array -- patch 
+    ! is fine.  Also, since we must copy anyway, might as well let ESMF manage 
+    ! the memory for simplicity.  
+!$$$ Once ESMF can match WRF memory-patch mapping, replace this with a more 
+!$$$ efficient solution that does not require a copy.  
+! $$$ esmf_counts is redundant.  Remove it as soon as ESMF_ArrayCreate no 
+! $$$ longer requires it.  
+!    esmf_counts(1:esmf_rank) = DomainEndFull(1:esmf_rank) - &
+!                               DomainStart(1:esmf_rank) + 1
+!    tmpArray = ESMF_ArrayCreate(arrayspec, counts=esmf_counts,      &
+!                                lbounds=DomainStart(1:esmf_rank),   &
+!                                ubounds=DomainEndFull(1:esmf_rank), &
+!                                rc=rc)
+!    IF ( rc /= ESMF_SUCCESS ) THEN
+!      WRITE(mess,*) ' ext_esmf_read_field: ESMF_ArrayCreate failed, rc = ', rc
+!      CALL wrf_error_fatal( TRIM(mess) )
+!    ENDIF
+    ! Determine grid staggering for this Field
+!    IF ( has_char( Stagger, 'x' ) .AND. has_char( Stagger, 'y' ) ) THEN
+!      CALL wrf_error_fatal( &
+!        "ext_esmf_read_field:  ESMF does not yet support XY staggering for C-grid" )
+!    ELSE IF ( has_char( Stagger, 'x' ) ) THEN
+!      horzrelloc=ESMF_CELL_WFACE
+!    ELSE IF ( has_char( Stagger, 'y' ) ) THEN
+!      horzrelloc=ESMF_CELL_SFACE
+!    ELSE
+!      horzrelloc=ESMF_CELL_CENTER
+!    ENDIF
+    ! Build an ESMF_Field
+    ! Note:  though it is counter-intuitive, ESMF uses 
+    ! shallow-copy-masquerading-as-reference to implement the 
+    ! pseudo-equivalent of POINTER assignment under-the-hood.  What this means 
+    ! here is that it is OK to pass deep object tmpArray into 
+    ! ESMF_FieldCreate() and then return from this subroutine.  Even though 
+    ! tmpArray goes out of scope, it is OK.  However, if tmpArray were to be 
+    ! modified after this call, the changes would not be guaranteed to always 
+    ! appear in tmpField.  It works that way now, but ESMF Core team has 
+    ! plans that may make it break in the future.  Build-it, attach-it, 
+    ! flush-it will work.  Build-it, attach-it, modify-it, flush-it may not 
+    ! always work.  
+    ! "Pie, pie and a fox..."  
+    ! Note:  unique Field name is required by ESMF_StateAddField().  
+!$$$here...  use CF "standard_name" once the WRF Registry supports it
+!    tmpField = ESMF_FieldCreate( grid( DataHandle )%ptr, tmpArray,          &
+!                                 copyflag=ESMF_DATA_REF,                    &
+!                                 horzrelloc=horzrelloc, name=TRIM(VarName), &
+!                                 rc=rc )
+! END DOESNOTWORK
+    !$$$here...  This is a complete HACK for debugging!!  Need to compute 
+    !$$$here...  horzrelloc from Stagger as above...  
+    horzrelloc=ESMF_CELL_CENTER
+    !$$$ TODO:  Add code for other data types here...  
+    ALLOCATE( tmp_esmf_r4_ptr(ips:ipefull,jps:jpefull) )
+    CALL wrf_debug ( 100, 'ext_esmf_read_field: calling ESMF_FieldCreate' )
+    tmpField = ESMF_FieldCreate(         &
+                 grid( DataHandle )%ptr, &
+                 tmp_esmf_r4_ptr,        &
+                 copyflag=ESMF_DATA_REF, &
+                 horzrelloc=horzrelloc,  &
+                 name=TRIM(VarName),     &
+                 rc=rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      WRITE(mess,*) ' ext_esmf_read_field: ESMF_FieldCreate failed, rc = ', rc
+      CALL wrf_error_fatal( TRIM(mess) )
+    ENDIF
+    CALL wrf_debug ( 100, 'ext_esmf_read_field: back from ESMF_FieldCreate' )
+    WRITE(mess,*) 'ext_esmf_read_field: tmp_esmf_r4_ptr(',         &
+      LBOUND(tmp_esmf_r4_ptr,1),':',UBOUND(tmp_esmf_r4_ptr,1),',', &
+      LBOUND(tmp_esmf_r4_ptr,2),':',UBOUND(tmp_esmf_r4_ptr,2),')'
+    CALL wrf_debug ( 100 , TRIM(mess) )
+    ! Add the Field to the import state...  
+!$$$here...  for now, just build ESMF_Fields and stuff them in
+!$$$here...  later, use a single ESMF_Bundle
+    CALL ESMF_StateAddField( importstate, tmpField, rc=rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      CALL wrf_error_fatal("ext_esmf_read_field:  ESMF_StateAddField failed" )
+    ENDIF
+write(mess,*) ' ext_esmf_read_field: END TRAINING READ:  DataHandle = ', DataHandle
+call wrf_debug( 300, TRIM(mess) )
+
+  ! case 2: opened for read and committed
+  ELSE IF ( okay_to_read( DataHandle ) )  THEN
+
+write(mess,*) ' ext_esmf_read_field: ACTUAL READ:  DataHandle = ', DataHandle
+call wrf_debug( 300, TRIM(mess) )
+!$$$DEBUG
+! count calls...
+numtimes = numtimes + 1
+CALL get_current_time_string( timestamp )
+!$$$END DEBUG
+
+    ! read:  extract data from the ESMF import state
+    ! Grab the current importState
+    CALL ESMF_ImportStateGetCurrent( importstate, rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      CALL wrf_error_fatal("ext_esmf_read_field:  ESMF_ImportStateGetCurrent failed" )
+    ENDIF
+    ! grab the Field
+    CALL ESMF_StateGetField( importstate, fieldName=TRIM(VarName), &
+                             field=tmpfield, rc=rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      CALL wrf_error_fatal("ext_esmf_read_field:  ESMF_StateGetField failed" )
+    ENDIF
+!$$$DEBUG
+CALL wrf_debug ( 100, 'ext_esmf_read_field '//TRIM(VarName)//':  calling ESMF_FieldPrint( tmpField ) 1' )
+CALL ESMF_FieldPrint( tmpField, rc=rc )
+CALL wrf_debug ( 100, 'ext_esmf_read_field '//TRIM(VarName)//':  back from ESMF_FieldPrint( tmpField ) 1' )
+!$$$END DEBUG
+
+    ! grab a pointer to the import state data and copy data into Field
+    IF      ( FieldType .EQ. WRF_REAL ) THEN
+      CALL ESMF_FieldGetDataPointer( tmpField, data_esmf_real_ptr, &
+                                     ESMF_DATA_REF, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal("ext_esmf_read_field:  ESMF_FieldGetDataPointer(r4) failed" )
+      ENDIF
+      IF ( ( PatchStart(1)   /= LBOUND(data_esmf_real_ptr,1) ) .OR. &
+           ( PatchEndFull(1) /= UBOUND(data_esmf_real_ptr,1) ) .OR. &
+           ( PatchStart(2)   /= LBOUND(data_esmf_real_ptr,2) ) .OR. &
+           ( PatchEndFull(2) /= UBOUND(data_esmf_real_ptr,2) ) ) THEN
+        WRITE( mess,* ) 'ESMF_FieldGetDataPointer bounds mismatch',          &
+          __FILE__ ,                                                         &
+          ', line ',                                                         &
+          __LINE__ ,                                                         &
+          ', ips:ipe,jps:jpe = ',PatchStart(1),':',PatchEndFull(1),',',      &
+                                 PatchStart(2),':',PatchEndFull(2),          &
+          ', data_esmf_real_ptr(BOUNDS) = ',                                 &
+          LBOUND(data_esmf_real_ptr,1),':',UBOUND(data_esmf_real_ptr,1),',', &
+          LBOUND(data_esmf_real_ptr,2),':',UBOUND(data_esmf_real_ptr,2)
+        CALL wrf_error_fatal ( TRIM(mess) )
+      ENDIF
+!$$$DEBUG
+WRITE( mess,* ) 'DEBUG:  ext_esmf_read_field:  ips:ipe,jps:jpe = ',  &
+  ips,':',ipe,',',jps,':',jpe,                                       &
+  ', data_esmf_real_ptr(BOUNDS) = ',                                 &
+  LBOUND(data_esmf_real_ptr,1),':',UBOUND(data_esmf_real_ptr,1),',', &
+  LBOUND(data_esmf_real_ptr,2),':',UBOUND(data_esmf_real_ptr,2)
+CALL wrf_debug( 300, TRIM(mess) )
+!DO j= jms, jme
+!  DO i= ims, ime
+!    debug_real(i,j) = -(i*1000.0 + j)/100000.0     ! obvious bad value for debugging
+!  ENDDO
+!ENDDO
+!debug_real(ips:ipe,jps:jpe) = data_esmf_real_ptr(ips:ipe,jps:jpe)
+!CALL wrf_debug( 100, 'DEBUG:  ext_esmf_read_field:  writing DEBUG1_WRFcmp_import'//TRIM(VarName)//'_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_WRFcmp_import'//TRIM(VarName)//'_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a,a,i4)') TRIM(VarName),' ',numtimes
+!DO j = jps, jpe
+!  DO i = ips, ipe
+!    WRITE (985,*) '(',i,',',j,'):  ',debug_real(i,j)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!$$$END DEBUG
+      CALL ioesmf_extract_data_real( data_esmf_real_ptr, Field,            &
+                                     ips, ipefull, jps, jpefull, kps, kpe, &
+                                     ims, ime, jms, jme, kms, kme )
+!$$$DEBUG
+!ict = 0
+!DO j= jms, jme
+!  DO i= ims, ime
+!    ict = ict + 1
+!    IF ( (i<ips) .OR. (i>ipe) .OR. (j<jps) .OR. (j>jpe) ) THEN
+!      debug_real(i,j) = -(i*1000.0 + j)/100000.0     ! obvious bad value for debugging
+!    ELSE
+!      debug_real(i,j) = Field(ict)
+!    ENDIF
+!  ENDDO
+!ENDDO
+!CALL wrf_debug( 100, 'DEBUG:  ext_esmf_read_field:  writing DEBUG1_WRFcmp_read_Field'//TRIM(VarName)//'_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_WRFcmp_read_Field'//TRIM(VarName)//'_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a,a,i4)') TRIM(VarName),' ',numtimes
+!DO j = jps, jpe
+!  DO i = ips, ipe
+!    WRITE (985,*) '(',i,',',j,'):  ',debug_real(i,j)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!$$$END DEBUG
+    ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+      CALL ESMF_FieldGetDataPointer( tmpField, data_esmf_int_ptr, &
+                                     ESMF_DATA_REF, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal("ext_esmf_read_field:  ESMF_FieldGetDataPointer(i4) failed" )
+      ENDIF
+      IF ( ( PatchStart(1)   /= LBOUND(data_esmf_int_ptr,1) ) .OR. &
+           ( PatchEndFull(1) /= UBOUND(data_esmf_int_ptr,1) ) .OR. &
+           ( PatchStart(2)   /= LBOUND(data_esmf_int_ptr,2) ) .OR. &
+           ( PatchEndFull(2) /= UBOUND(data_esmf_int_ptr,2) ) ) THEN
+        WRITE( mess,* ) 'ESMF_FieldGetDataPointer bounds mismatch',        &
+          __FILE__ ,                                                       &
+          ', line ',                                                       &
+          __LINE__ ,                                                       &
+          ', ips:ipe,jps:jpe = ',PatchStart(1),':',PatchEndFull(1),',',    &
+                                 PatchStart(2),':',PatchEndFull(2),        &
+          ', data_esmf_int_ptr(BOUNDS) = ',                                &
+          LBOUND(data_esmf_int_ptr,1),':',UBOUND(data_esmf_int_ptr,1),',', &
+          LBOUND(data_esmf_int_ptr,2),':',UBOUND(data_esmf_int_ptr,2)
+        CALL wrf_error_fatal ( TRIM(mess) )
+      ENDIF
+      CALL ioesmf_extract_data_int( data_esmf_int_ptr, Field,             &
+                                    ips, ipefull, jps, jpefull, kps, kpe, &
+                                    ims, ime, jms, jme, kms, kme )
+    ENDIF
+write(mess,*) ' ext_esmf_read_field: END ACTUAL READ:  DataHandle = ', DataHandle
+call wrf_debug( 300, TRIM(mess) )
+
+  ENDIF
+
+!$$$DEBUG
+CALL wrf_debug ( 100, 'ext_esmf_read_field '//TRIM(VarName)//':  calling ESMF_FieldPrint( tmpField ) 2' )
+CALL ESMF_FieldPrint( tmpField, rc=rc )
+CALL wrf_debug ( 100, 'ext_esmf_read_field '//TRIM(VarName)//':  back from ESMF_FieldPrint( tmpField ) 2' )
+!$$$END DEBUG
+
+  Status = 0
+
+  RETURN
+
+END SUBROUTINE ext_esmf_read_field
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_write_field.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_write_field.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/ext_esmf_write_field.F90	(revision 2744)
@@ -0,0 +1,384 @@
+
+!$$$here...  TBH:  remove duplication between ext_esmf_read_field and 
+!$$$here...  TBH:  ext_esmf_write_field
+
+!$$$here...  TBH:  how to deal with time?  (via current ESMF_Clock)
+!$$$here...  TBH:  to begin, use it as an error check!  
+
+
+!--- write_field
+SUBROUTINE ext_esmf_write_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
+                                  DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                  DomainStart , DomainEnd ,                                    &
+                                  MemoryStart , MemoryEnd ,                                    &
+                                  PatchStart , PatchEnd ,                                      &
+                                  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER       ,INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) ,intent(inout) :: DateStr
+  CHARACTER*(*) ,intent(inout) :: VarName
+  integer       ,intent(inout) :: FieldType
+  integer       ,intent(inout) :: Comm
+  integer       ,intent(inout) :: IOComm
+  integer       ,intent(inout) :: DomainDesc
+  character*(*) ,intent(inout) :: MemoryOrder
+  character*(*) ,intent(inout) :: Stagger
+  character*(*) ,intent(inout) :: DimNames(*)
+  integer       ,intent(inout) :: DomainStart(*), DomainEnd(*)
+  integer       ,intent(inout) :: MemoryStart(*), MemoryEnd(*)
+  integer       ,intent(inout) :: PatchStart(*),  PatchEnd(*)
+  REAL          ,INTENT(INOUT) :: Field(*)
+  integer       ,intent(out)   :: Status
+  ! Local declarations
+  INTEGER :: ids,ide,jds,jde,kds,kde
+  INTEGER :: ims,ime,jms,jme,kms,kme
+  INTEGER :: ips,ipe,jps,jpe,kps,kpe
+  TYPE(ESMF_State), POINTER :: exportstate
+  TYPE(ESMF_Field) :: tmpField
+  TYPE(ESMF_Array) :: tmpArray
+  TYPE(ESMF_ArraySpec) :: arrayspec
+  TYPE(ESMF_DataKind) :: esmf_kind
+  TYPE(ESMF_DataType) :: esmf_type
+  TYPE(ESMF_RelLoc) :: horzRelloc
+  REAL(ESMF_KIND_R4), POINTER :: data_esmf_real_ptr(:,:)
+  REAL(ESMF_KIND_R4), POINTER :: tmp_esmf_r4_ptr(:,:)
+  INTEGER(ESMF_KIND_I4), POINTER :: data_esmf_int_ptr(:,:)
+  INTEGER, PARAMETER :: esmf_rank = 2
+  INTEGER :: DomainEndFull(esmf_rank), idefull, jdefull, ict, i, j
+  INTEGER :: PatchEndFull(esmf_rank), ipefull, jpefull
+  ! esmf_counts is redundant.  remove it as soon as ESMF_ArrayCreate no 
+  ! longer requires it
+  INTEGER :: esmf_counts(esmf_rank)
+  INTEGER :: rc
+  LOGICAL, EXTERNAL :: has_char
+  character*256 mess
+!$$$DEBUG
+INTEGER, SAVE :: numtimes=0   ! track number of calls
+CHARACTER(LEN=256) :: timestamp
+!REAL :: debug_real(MemoryStart(1):MemoryEnd(1),MemoryStart(2):MemoryEnd(2))
+!$$$END DEBUG
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_esmf_write_field: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_esmf_write_field: DataHandle not opened" )
+  ENDIF
+  IF ( .NOT. opened_for_write( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_esmf_write_field: DataHandle not opened for write" )
+  ENDIF
+
+write(mess,*)'ext_esmf_write_field ',DataHandle, TRIM(DateStr), TRIM(VarName)
+call wrf_debug( 300, TRIM(mess) )
+
+  IF      ( FieldType .EQ. WRF_REAL ) THEN
+    esmf_type = ESMF_DATA_REAL
+    esmf_kind = ESMF_R4
+  ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+!    esmf_type = ESMF_DATA_REAL
+!    esmf_kind = ESMF_R8
+    CALL wrf_error_fatal( 'ext_esmf_write_field, WRF_DOUBLE not yet supported')
+  ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+    esmf_type = ESMF_DATA_INTEGER
+    esmf_kind = ESMF_I4
+!$$$ implement this (below)
+    CALL wrf_error_fatal( 'ext_esmf_write_field, WRF_INTEGER not yet implemented')
+  ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+    CALL wrf_error_fatal( 'ext_esmf_write_field, WRF_LOGICAL not yet supported')
+  ENDIF
+
+  ims = MemoryStart(1) ; ime = MemoryEnd(1)
+  jms = MemoryStart(2) ; jme = MemoryEnd(2)
+  kms = MemoryStart(3) ; kme = MemoryEnd(3)
+
+  ips = PatchStart(1) ; ipe = PatchEnd(1)
+  jps = PatchStart(2) ; jpe = PatchEnd(2)
+  kps = PatchStart(3) ; kpe = PatchEnd(3)
+
+  ids = DomainStart(1) ; ide = DomainEnd(1)
+  jds = DomainStart(2) ; jde = DomainEnd(2)
+  kds = DomainStart(3) ; kde = DomainEnd(3)
+
+  ! For now, treat all arrays as 2D...  
+!$$$ Eventually, use ../io_netcdf subroutines Transpose() and reorder() 
+!$$$ (and etc.) to handle general array ranks and index orderings.  
+!$$$ Some copies of these exist in ../../frame/module_io.F.  
+!$$$ Then use ESMF_ArrayDataMap class to handle index mapping.  
+  IF ( kms /= kme ) THEN
+    CALL wrf_error_fatal( 'ext_esmf_write_field:  rank > 2 not yet supported')
+  ENDIF
+
+! The non-staggered variables come in at one-less than
+! domain dimensions, but io_esmf is currently hacked to use full
+! domain spec, so adjust if not staggered.
+! $$$ TBD:  Remove EndFull hackery once ESMF can support staggered 
+! $$$ TBD:  grids in regional models.  (This hack works around the current 
+! $$$ TBD:  need to use only larger staggered dimensions for ESMF_Arrays.)  
+  CALL ioesmf_endfullhack( esmf_rank, DomainEnd, PatchEnd, Stagger, &
+                           DomainEndFull, PatchEndFull )
+  idefull = DomainEndFull(1)
+  jdefull = DomainEndFull(2)
+  ipefull = PatchEndFull(1)
+  jpefull = PatchEndFull(2)
+
+write(mess,*) ' ext_esmf_write_field: okay_to_write: ', DataHandle, okay_to_write(DataHandle)
+call wrf_debug( 300, TRIM(mess) )
+
+  ! case 1: the file is opened for write but not committed ("training")
+  IF ( .NOT. okay_to_write( DataHandle ) )  THEN
+
+    ! Training:  build the ESMF export state
+write(mess,*) ' ext_esmf_write_field: TRAINING WRITE:  DataHandle = ', DataHandle
+call wrf_debug( 300, TRIM(mess) )
+
+    ! First, build the ESMF_Grid for this DataHandle, if it does not 
+    ! already exist
+    CALL ioesmf_create_grid( DataHandle, esmf_rank, MemoryOrder, Stagger,      &
+                             DomainStart(1:esmf_rank), DomainEnd(1:esmf_rank), &
+                             MemoryStart(1:esmf_rank), MemoryEnd(1:esmf_rank), &
+                             PatchStart(1:esmf_rank), PatchEnd(1:esmf_rank) )
+    ! Grab the current exportState and add to it...
+    CALL ESMF_ExportStateGetCurrent( exportstate, rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      CALL wrf_error_fatal("ext_esmf_write_field, training:  ESMF_ExportStateGetCurrent failed" )
+    ENDIF
+! BEGIN DOESNOTWORK
+! The following code does not work for reasons as-yet unknown.  
+! A likely suspect is lbounds and ubounds which fail in other interfaces in 
+! ESMF 2.2.0rp1 ...  
+    ! Build ESMF objects...  
+    ! Build an ESMF_ArraySpec.  The use of ESMF_ArraySpec and ESMF_Array 
+    ! objects allows some of the code that follows to be type-kind-independent.  
+!    CALL ESMF_ArraySpecSet(arrayspec, rank=esmf_rank, type=esmf_type, &
+!                                      kind=esmf_kind, rc=rc)
+!    IF ( rc /= ESMF_SUCCESS ) THEN
+!      CALL wrf_error_fatal("ext_esmf_write_field:  ESMF_ArraySpecSet failed" )
+!    ENDIF
+    ! Build an ESMF_Array
+    ! Implementation note:  since we do not yet have full control over how 
+    ! ESMF chooses to lay out a "patch" within "memory", we must copy by 
+    ! hand.  (Reasons include lack of support in ESMF for asymmetric halos, 
+    ! addition of "extra" rows/columns to optimize alignment on some machines, 
+    ! handling of periodic boundary conditions, etc.)  Thus, there 
+    ! is no point in using larger "memory" sizes to build the array -- patch 
+    ! is fine.  Also, since we must copy anyway, might as well let ESMF manage 
+    ! the memory for simplicity.  
+!$$$ Once ESMF can match WRF memory-patch mapping, replace this with a more 
+!$$$ efficient solution that does not require a copy.  
+! $$$ esmf_counts is redundant.  Remove it as soon as ESMF_ArrayCreate no 
+! $$$ longer requires it.  
+!    esmf_counts(1:esmf_rank) = DomainEndFull(1:esmf_rank) - &
+!                               DomainStart(1:esmf_rank) + 1
+!    tmpArray = ESMF_ArrayCreate(arrayspec, counts=esmf_counts,      &
+!                                lbounds=DomainStart(1:esmf_rank),   &
+!                                ubounds=DomainEndFull(1:esmf_rank), &
+!                                rc=rc)
+!    IF ( rc /= ESMF_SUCCESS ) THEN
+!      WRITE(mess,*) ' ext_esmf_write_field: ESMF_ArrayCreate failed, rc = ', rc
+!      CALL wrf_error_fatal( TRIM(mess) )
+!    ENDIF
+    ! Determine grid staggering for this Field
+!    IF ( has_char( Stagger, 'x' ) .AND. has_char( Stagger, 'y' ) ) THEN
+!      CALL wrf_error_fatal( &
+!        "ext_esmf_write_field:  ESMF does not yet support XY staggering for C-grid" )
+!    ELSE IF ( has_char( Stagger, 'x' ) ) THEN
+!      horzrelloc=ESMF_CELL_WFACE
+!    ELSE IF ( has_char( Stagger, 'y' ) ) THEN
+!      horzrelloc=ESMF_CELL_SFACE
+!    ELSE
+!      horzrelloc=ESMF_CELL_CENTER
+!    ENDIF
+    ! Build an ESMF_Field
+    ! Note:  though it is counter-intuitive, ESMF uses 
+    ! shallow-copy-masquerading-as-reference to implement the 
+    ! pseudo-equivalent of POINTER assignment under-the-hood.  What this means 
+    ! here is that it is OK to pass deep object tmpArray into 
+    ! ESMF_FieldCreate() and then return from this subroutine.  Even though 
+    ! tmpArray goes out of scope, it is OK.  However, if tmpArray were to be 
+    ! modified after this call, the changes would not be guaranteed to always 
+    ! appear in tmpField.  It works that way now, but ESMF Core team has 
+    ! plans that may make it break in the future.  Build-it, attach-it, 
+    ! flush-it will work.  Build-it, attach-it, modify-it, flush-it may not 
+    ! always work.  
+    ! "Pie, pie and a fox..."  
+    ! Note:  unique Field name is required by ESMF_StateAddField().  
+!$$$here...  use CF "standard_name" once the WRF Registry supports it
+!    tmpField = ESMF_FieldCreate( grid( DataHandle )%ptr, tmpArray,          &
+!                                 copyflag=ESMF_DATA_REF,                    &
+!                                 horzrelloc=horzrelloc, name=TRIM(VarName), &
+!                                 rc=rc )
+! END DOESNOTWORK
+    !$$$here...  This is a complete HACK for debugging!!  Need to compute 
+    !$$$here...  horzrelloc from Stagger as above...  
+    horzrelloc=ESMF_CELL_CENTER
+    !$$$ TODO:  Add code for other data types here...  
+    ALLOCATE( tmp_esmf_r4_ptr(ips:ipefull,jps:jpefull) )
+    CALL wrf_debug ( 100, 'ext_esmf_write_field: calling ESMF_FieldCreate' )
+    tmpField = ESMF_FieldCreate(         &
+                 grid( DataHandle )%ptr, &
+                 tmp_esmf_r4_ptr,        &
+                 copyflag=ESMF_DATA_REF, &
+                 horzrelloc=horzrelloc,  &
+                 name=TRIM(VarName),     &
+                 rc=rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      WRITE(mess,*) ' ext_esmf_write_field: ESMF_FieldCreate failed, rc = ', rc
+      CALL wrf_error_fatal( TRIM(mess) )
+    ENDIF
+    CALL wrf_debug ( 100, 'ext_esmf_write_field: back from ESMF_FieldCreate' )
+    WRITE(mess,*) 'ext_esmf_write_field: tmp_esmf_r4_ptr(',        &
+      LBOUND(tmp_esmf_r4_ptr,1),':',UBOUND(tmp_esmf_r4_ptr,1),',', &
+      LBOUND(tmp_esmf_r4_ptr,2),':',UBOUND(tmp_esmf_r4_ptr,2),')'
+    CALL wrf_debug ( 100 , TRIM(mess) )
+    ! Add the Field to the export state...  
+!$$$here...  for now, just build ESMF_Fields and stuff them in
+!$$$here...  later, use a single ESMF_Bundle
+    CALL ESMF_StateAddField( exportstate, tmpField, rc=rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      CALL wrf_error_fatal("ext_esmf_write_field:  ESMF_StateAddField failed" )
+    ENDIF
+write(mess,*) ' ext_esmf_write_field: END TRAINING WRITE:  DataHandle = ', DataHandle
+call wrf_debug( 300, TRIM(mess) )
+
+  ! case 2: opened for write and committed
+  ELSE IF ( okay_to_write( DataHandle ) )  THEN
+
+write(mess,*) ' ext_esmf_write_field: ACTUAL WRITE:  DataHandle = ', DataHandle
+call wrf_debug( 300, TRIM(mess) )
+!$$$DEBUG
+! count calls...
+numtimes = numtimes + 1
+CALL get_current_time_string( timestamp )
+!$$$END DEBUG
+
+    ! write:  insert data into the ESMF export state
+    ! Grab the current exportState
+    CALL ESMF_ExportStateGetCurrent( exportstate, rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      CALL wrf_error_fatal("ext_esmf_write_field:  ESMF_ExportStateGetCurrent failed" )
+    ENDIF
+    ! grab the Field
+    CALL ESMF_StateGetField( exportstate, fieldName=TRIM(VarName), &
+                             field=tmpfield, rc=rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      CALL wrf_error_fatal("ext_esmf_write_field:  ESMF_StateGetField failed" )
+    ENDIF
+!$$$DEBUG
+CALL wrf_debug ( 100, 'ext_esmf_write_field '//TRIM(VarName)//':  calling ESMF_FieldPrint( tmpField ) 1' )
+CALL ESMF_FieldPrint( tmpField, rc=rc )
+CALL wrf_debug ( 100, 'ext_esmf_write_field '//TRIM(VarName)//':  back from ESMF_FieldPrint( tmpField ) 1' )
+!$$$END DEBUG
+
+    ! grab a pointer to the export state data and copy data from Field
+    IF      ( FieldType .EQ. WRF_REAL ) THEN
+      CALL ESMF_FieldGetDataPointer( tmpField, data_esmf_real_ptr, &
+                                     ESMF_DATA_REF, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal("ext_esmf_write_field:  ESMF_FieldGetDataPointer(r4) failed" )
+      ENDIF
+      IF ( ( PatchStart(1)   /= LBOUND(data_esmf_real_ptr,1) ) .OR. &
+           ( PatchEndFull(1) /= UBOUND(data_esmf_real_ptr,1) ) .OR. &
+           ( PatchStart(2)   /= LBOUND(data_esmf_real_ptr,2) ) .OR. &
+           ( PatchEndFull(2) /= UBOUND(data_esmf_real_ptr,2) ) ) THEN
+        WRITE( mess,* ) 'ESMF_FieldGetDataPointer bounds mismatch',          &
+          __FILE__ ,                                                         &
+          ', line ',                                                         &
+          __LINE__ ,                                                         &
+          ', ips:ipe,jps:jpe = ',PatchStart(1),':',PatchEndFull(1),',',      &
+                                 PatchStart(2),':',PatchEndFull(2),          &
+          ', data_esmf_real_ptr(BOUNDS) = ',                                 &
+          LBOUND(data_esmf_real_ptr,1),':',UBOUND(data_esmf_real_ptr,1),',', &
+          LBOUND(data_esmf_real_ptr,2),':',UBOUND(data_esmf_real_ptr,2)
+        CALL wrf_error_fatal ( TRIM(mess) )
+      ENDIF
+!$$$DEBUG
+WRITE( mess,* ) 'DEBUG:  ext_esmf_write_field:  ips:ipe,jps:jpe = ', &
+  ips,':',ipe,',',jps,':',jpe,                                       &
+  ', data_esmf_real_ptr(BOUNDS) = ',                                 &
+  LBOUND(data_esmf_real_ptr,1),':',UBOUND(data_esmf_real_ptr,1),',', &
+  LBOUND(data_esmf_real_ptr,2),':',UBOUND(data_esmf_real_ptr,2)
+CALL wrf_debug( 300, TRIM(mess) )
+!ict = 0
+!DO j= jms, jme
+!  DO i= ims, ime
+!    ict = ict + 1
+!    IF ( (i<ips) .OR. (i>ipe) .OR. (j<jps) .OR. (j>jpe) ) THEN
+!      debug_real(i,j) = -(i*1000.0 + j)/100000.0     ! obvious bad value for debugging
+!    ELSE
+!      debug_real(i,j) = Field(ict)
+!    ENDIF
+!  ENDDO
+!ENDDO
+!CALL wrf_debug( 100, 'DEBUG:  ext_esmf_write_field:  writing DEBUG1_WRFcmp_write_Field'//TRIM(VarName)//'_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_WRFcmp_write_Field'//TRIM(VarName)//'_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a,a,i4)') TRIM(VarName),' ',numtimes
+!DO j = jps, jpe
+!  DO i = ips, ipe
+!    WRITE (985,*) '(',i,',',j,'):  ',debug_real(i,j)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!$$$END DEBUG
+      CALL ioesmf_insert_data_real( Field, data_esmf_real_ptr,            &
+                                    ips, ipefull, jps, jpefull, kps, kpe, &
+                                    ims, ime, jms, jme, kms, kme )
+!$$$DEBUG
+!DO j= jms, jme
+!  DO i= ims, ime
+!    debug_real(i,j) = -(i*1000.0 + j)/100000.0     ! obvious bad value for debugging
+!  ENDDO
+!ENDDO
+!debug_real(ips:ipe,jps:jpe) = data_esmf_real_ptr(ips:ipe,jps:jpe)
+!CALL wrf_debug( 100, 'DEBUG:  ext_esmf_write_field:  writing DEBUG1_WRFcmp_export'//TRIM(VarName)//'_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_WRFcmp_export'//TRIM(VarName)//'_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a,a,i4)') TRIM(VarName),' ',numtimes
+!DO j = jps, jpe
+!  DO i = ips, ipe
+!    WRITE (985,*) '(',i,',',j,'):  ',debug_real(i,j)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!$$$END DEBUG
+    ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+      CALL ESMF_FieldGetDataPointer( tmpField, data_esmf_int_ptr, &
+                                     ESMF_DATA_REF, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal("ext_esmf_write_field:  ESMF_FieldGetDataPointer(i4) failed" )
+      ENDIF
+      IF ( ( PatchStart(1)   /= LBOUND(data_esmf_int_ptr,1) ) .OR. &
+           ( PatchEndFull(1) /= UBOUND(data_esmf_int_ptr,1) ) .OR. &
+           ( PatchStart(2)   /= LBOUND(data_esmf_int_ptr,2) ) .OR. &
+           ( PatchEndFull(2) /= UBOUND(data_esmf_int_ptr,2) ) ) THEN
+        WRITE( mess,* ) 'ESMF_FieldGetDataPointer bounds mismatch',        &
+          __FILE__ ,                                                       &
+          ', line ',                                                       &
+          __LINE__ ,                                                       &
+          ', ips:ipe,jps:jpe = ',PatchStart(1),':',PatchEndFull(1),',',    &
+                                 PatchStart(2),':',PatchEndFull(2),        &
+          ', data_esmf_int_ptr(BOUNDS) = ',                                &
+          LBOUND(data_esmf_int_ptr,1),':',UBOUND(data_esmf_int_ptr,1),',', &
+          LBOUND(data_esmf_int_ptr,2),':',UBOUND(data_esmf_int_ptr,2)
+        CALL wrf_error_fatal ( TRIM(mess) )
+      ENDIF
+      CALL ioesmf_insert_data_int( Field, data_esmf_int_ptr,             &
+                                   ips, ipefull, jps, jpefull, kps, kpe, &
+                                   ims, ime, jms, jme, kms, kme )
+    ENDIF
+write(mess,*) ' ext_esmf_write_field: END ACTUAL WRITE:  DataHandle = ', DataHandle
+call wrf_debug( 300, TRIM(mess) )
+
+  ENDIF
+
+!$$$DEBUG
+CALL wrf_debug ( 100, 'ext_esmf_write_field '//TRIM(VarName)//':  calling ESMF_FieldPrint( tmpField ) 2' )
+CALL ESMF_FieldPrint( tmpField, rc=rc )
+CALL wrf_debug ( 100, 'ext_esmf_write_field '//TRIM(VarName)//':  back from ESMF_FieldPrint( tmpField ) 2' )
+!$$$END DEBUG
+
+  Status = 0
+
+  RETURN
+
+END SUBROUTINE ext_esmf_write_field
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/io_esmf.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/io_esmf.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/io_esmf.F90	(revision 2744)
@@ -0,0 +1,1859 @@
+
+MODULE module_ext_esmf
+
+  USE ESMF_Mod
+  USE module_esmf_extensions
+
+  IMPLICIT NONE
+
+  TYPE grid_ptr
+    TYPE(ESMF_Grid), POINTER :: ptr
+    ! use these for error-checking for now...
+    INTEGER :: ide_save
+    INTEGER :: jde_save
+    INTEGER :: kde_save
+    LOGICAL :: in_use
+  END TYPE grid_ptr
+
+  ! TBH:  should package this state into an object...  
+  INTEGER, PARAMETER :: int_num_handles = 99
+  LOGICAL, DIMENSION(int_num_handles) :: okay_to_write, okay_to_read,       &
+                                         opened_for_write, opened_for_read, &
+                                         int_handle_in_use
+  TYPE(grid_ptr) :: grid(int_num_handles)
+
+  ! convenience...
+  CHARACTER (256) :: msg
+
+#include "wrf_io_flags.h"
+#include "wrf_status_codes.h"
+
+  CONTAINS
+
+    LOGICAL FUNCTION int_valid_handle( handle )
+      IMPLICIT NONE
+      INTEGER, INTENT(IN) ::  handle
+      int_valid_handle = ( handle .ge. 8 .and. handle .le. int_num_handles ) 
+    END FUNCTION int_valid_handle
+
+    SUBROUTINE int_get_fresh_handle( retval )
+      INTEGER i, retval
+
+      retval = -1
+! dont use first 8 handles
+      DO i = 8, int_num_handles
+        IF ( .NOT. int_handle_in_use(i) )  THEN
+          retval = i
+          GOTO 33
+        ENDIF
+      ENDDO
+33    CONTINUE
+      IF ( retval < 0 )  THEN
+        CALL wrf_error_fatal( "io_esmf.F90: int_get_fresh_handle() out of handles")
+      ENDIF
+      int_handle_in_use(retval) = .TRUE.
+    END SUBROUTINE int_get_fresh_handle
+
+! parse comma separated list of VARIABLE=VALUE strings and return the
+! value for the matching variable if such exists, otherwise return
+! the empty string
+SUBROUTINE get_value ( varname , str , retval )
+  IMPLICIT NONE
+  CHARACTER*(*) ::    varname
+  CHARACTER*(*) ::    str
+  CHARACTER*(*) ::    retval
+
+  CHARACTER (128) varstr, tstr
+  INTEGER i,j,n,varstrn
+  LOGICAL nobreak, nobreakouter
+
+  varstr = TRIM(varname)//"="
+  varstrn = len(TRIM(varstr))
+  n = len(TRIM(str))
+  retval = ""
+  i = 1
+  nobreakouter = .TRUE.
+  DO WHILE ( nobreakouter )
+    j = 1
+    nobreak = .TRUE.
+    tstr = ""
+    DO WHILE ( nobreak )
+      nobreak = .FALSE.
+      IF ( i .LE. n ) THEN
+        IF (str(i:i) .NE. ',' ) THEN
+           tstr(j:j) = str(i:i)
+           nobreak = .TRUE.
+        ENDIF
+      ENDIF
+      j = j + 1
+      i = i + 1
+    ENDDO
+    IF ( i .GT. n ) nobreakouter = .FALSE.
+    IF ( varstr(1:varstrn) .EQ. tstr(1:varstrn) ) THEN
+      retval(1:) = TRIM(tstr(varstrn+1:))
+      nobreakouter = .FALSE.
+    ENDIF
+  ENDDO
+  RETURN
+END SUBROUTINE get_value
+
+
+    !--- ioinit
+    SUBROUTINE init_module_ext_esmf
+      IMPLICIT NONE
+      INTEGER :: i
+      DO i = 1, int_num_handles
+        WRITE( msg,* ) 'init_module_ext_esmf:  calling ioesmf_nullify_grid(',i,')'
+        CALL wrf_debug ( 5, TRIM(msg) )
+        CALL ioesmf_nullify_grid( i )
+      ENDDO
+      RETURN
+    END SUBROUTINE init_module_ext_esmf
+
+
+  ! allgather for integers, ESMF_style (since ESMF does not do this yet)
+  SUBROUTINE GatherIntegerScalars_ESMF( inval, pe, numprocs, outvals )
+    INTEGER, INTENT(IN   ) :: inval                 ! input scalar on this task
+    INTEGER, INTENT(IN   ) :: pe                    ! task id
+    INTEGER, INTENT(IN   ) :: numprocs              ! number of tasks
+    INTEGER, INTENT(  OUT) :: outvals(0:numprocs-1) ! gathered output vector
+    ! Local declarations
+    TYPE(ESMF_VM) :: vm
+    INTEGER(ESMF_KIND_I4) :: allSnd(0:numprocs-1)
+    INTEGER(ESMF_KIND_I4) :: allRcv(0:numprocs-1)
+    INTEGER :: rc
+
+    ! get current ESMF virtual machine for communication
+    CALL ESMF_VMGetCurrent(vm, rc)
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      WRITE( msg,* ) 'Error in ESMF_VMGetCurrent', &
+                     __FILE__ ,                    &
+                     ', line',                     &
+                     __LINE__
+      CALL wrf_error_fatal ( msg )
+    ENDIF
+    allSnd = 0_ESMF_KIND_I4
+    allSnd(pe) = inval
+    ! Hack due to lack of ESMF_VMAllGather().  
+    CALL ESMF_VMAllReduce(vm, allSnd, allRcv, numprocs, ESMF_SUM, rc=rc )
+    IF ( rc /= ESMF_SUCCESS ) THEN
+      WRITE( msg,* ) 'Error in ESMF_VMAllReduce', &
+                     __FILE__ ,                     &
+                     ', line',                      &
+                     __LINE__
+      CALL wrf_error_fatal ( msg )
+    ENDIF
+    outvals = allRcv
+
+  END SUBROUTINE GatherIntegerScalars_ESMF
+
+
+END MODULE module_ext_esmf
+
+
+
+  ! Indexes for non-staggered variables come in at one-less than
+  ! domain dimensions, but io_esmf is currently hacked to use full 
+  ! domain spec, so adjust if not staggered.  
+  ! $$$ TBD:  remove this hackery once ESMF can support staggered 
+  ! $$$ TBD:  grids in regional models
+  SUBROUTINE ioesmf_endfullhack( numdims, DomainEnd, PatchEnd, Stagger, &
+                                 DomainEndFull, PatchEndFull )
+    IMPLICIT NONE
+    INTEGER,       INTENT(IN   ) :: numdims
+    INTEGER,       INTENT(IN   ) :: DomainEnd(numdims)
+    INTEGER,       INTENT(IN   ) :: PatchEnd(numdims)
+    CHARACTER*(*), INTENT(IN   ) :: Stagger
+    INTEGER,       INTENT(  OUT) :: DomainEndFull(numdims)
+    INTEGER,       INTENT(  OUT) :: PatchEndFull(numdims)
+    LOGICAL, EXTERNAL :: has_char
+    DomainEndFull(1:numdims) = DomainEnd(1:numdims)
+    IF ( .NOT. has_char( Stagger, 'x' ) ) DomainEndFull(1) = DomainEndFull(1) + 1
+    IF ( .NOT. has_char( Stagger, 'y' ) ) DomainEndFull(2) = DomainEndFull(2) + 1
+    PatchEndFull(1:numdims) = PatchEnd(1:numdims)
+    IF ( .NOT. has_char( Stagger, 'x' ) ) THEN
+      IF ( DomainEnd(1) == PatchEnd(1) ) PatchEndFull(1) = DomainEndFull(1)
+    ENDIF
+    IF ( .NOT. has_char( Stagger, 'y' ) ) THEN
+      IF ( DomainEnd(2) == PatchEnd(2) ) PatchEndFull(2) = DomainEndFull(2)
+    ENDIF
+  END SUBROUTINE ioesmf_endfullhack
+
+
+  ! Create the ESMF_Grid associated with index DataHandle.  
+  ! TBH:  Note that periodicity is not supported by this interface.  If 
+  ! TBH:  periodicity is needed, pass in via SysDepInfo in the call to 
+  ! TBH:  ext_esmf_ioinit().  
+  ! TBH:  Note that lat/lon coordinates are not supported by this interface 
+  ! TBH:  since general curvilinear coordindates (needed for map projections 
+  ! TBH:  used by WRF such as polar stereographic, mercator, lambert conformal)
+  ! TBH:  are not supported by ESMF as of ESMF 2.1.1.  Once they are supported, 
+  ! TBH:  add them via the "sieve" method used in ../io_mcel/.  
+  SUBROUTINE ioesmf_create_grid( DataHandle, numdims,    &
+                                 MemoryOrder, Stagger,   &
+                                 DomainStart, DomainEnd, &
+                                 MemoryStart, MemoryEnd, &
+                                 PatchStart, PatchEnd )
+    USE module_ext_esmf
+    IMPLICIT NONE
+    INTEGER,       INTENT(IN   ) :: DataHandle
+    INTEGER,       INTENT(IN   ) :: numdims
+    CHARACTER*(*), INTENT(IN   ) :: MemoryOrder            ! not used yet
+    CHARACTER*(*), INTENT(IN   ) :: Stagger
+    INTEGER,       INTENT(IN   ) :: DomainStart(numdims), DomainEnd(numdims)
+    INTEGER,       INTENT(IN   ) :: MemoryStart(numdims), MemoryEnd(numdims)
+    INTEGER,       INTENT(IN   ) :: PatchStart(numdims),  PatchEnd(numdims)
+    INTEGER :: DomainEndFull(numdims)
+    INTEGER :: PatchEndFull(numdims)
+
+    WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  begin, DataHandle = ', DataHandle
+    CALL wrf_debug ( 5, TRIM(msg) )
+    ! For now, blindly create a new grid if it does not already exist for 
+    ! this DataHandle
+! TBH:  Note that this approach will result in duplicate ESMF_Grids when 
+! TBH:  io_esmf is used for input and output.  The first ESMF_Grid will 
+! TBH:  be associated with the input handle and the second will be associated 
+! TBH:  with the output handle.  
+    IF ( .NOT. grid( DataHandle )%in_use ) THEN
+      IF ( ASSOCIATED( grid( DataHandle )%ptr ) ) THEN
+        CALL wrf_error_fatal ( 'ASSERTION ERROR:  grid(',DataHandle,') should be NULL' )
+      ENDIF
+      IF ( numdims /= 2 ) THEN
+        CALL wrf_error_fatal ( 'ERROR:  only 2D arrays supported so far with io_esmf' )
+      ELSE
+        WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  creating grid(',DataHandle,')%ptr'
+        CALL wrf_debug ( 5, TRIM(msg) )
+        ALLOCATE( grid( DataHandle )%ptr )
+        grid( DataHandle )%in_use = .TRUE.
+        ! The non-staggered variables come in at one-less than
+        ! domain dimensions, but io_esmf is currently hacked to use full 
+        ! domain spec, so adjust if not staggered.  
+        ! $$$ TBD:  remove this hackery once ESMF can support staggered 
+        ! $$$ TBD:  grids in regional models
+        CALL ioesmf_endfullhack( numdims, DomainEnd, PatchEnd, Stagger, &
+                                 DomainEndFull, PatchEndFull )
+! $$$ TBD:  at the moment this is hard-coded for 2D arrays
+! $$$ TBD:  use MemoryOrder to set these properly!
+! $$$ TBD:  also, set these once only
+! $$$ TBD:  maybe even rip this out since it depends on a hack in input_wrf.F ...
+        grid( DataHandle )%ide_save = DomainEndFull(1)
+        grid( DataHandle )%jde_save = DomainEndFull(2)
+        grid( DataHandle )%kde_save = 1
+        WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  DomainEndFull = ', DomainEndFull
+        CALL wrf_debug ( 5, TRIM(msg) )
+        WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  PatchEndFull = ', PatchEndFull
+        CALL wrf_debug ( 5, TRIM(msg) )
+        CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid:  Calling ioesmf_create_grid_int()' )
+        CALL ioesmf_create_grid_int( grid( DataHandle )%ptr,     &
+                              numdims,                    &
+                              DomainStart, DomainEndFull, &
+                              MemoryStart, MemoryEnd,     &
+                              PatchStart, PatchEndFull )
+        CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid:  back from ioesmf_create_grid_int()' )
+        WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  done creating grid(',DataHandle,')%ptr'
+        CALL wrf_debug ( 5, TRIM(msg) )
+      ENDIF
+    ENDIF
+    WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  end'
+    CALL wrf_debug ( 5, TRIM(msg) )
+
+  END SUBROUTINE ioesmf_create_grid
+
+
+
+  ! Create an ESMF_Grid that matches a WRF decomposition.  
+  ! TBH:  Note that periodicity is not supported by this interface.  If 
+  ! TBH:  periodicity is needed, pass in via SysDepInfo in the call to 
+  ! TBH:  ext_esmf_ioinit().  
+  ! TBH:  Note that lat/lon coordinates are not supported by this interface 
+  ! TBH:  since general curvilinear coordindates (needed for map projections 
+  ! TBH:  used by WRF such as polar stereographic, mercator, lambert conformal)
+  ! TBH:  are not supported by ESMF as of ESMF 2.1.1.  Once they are supported, 
+  ! TBH:  add them via the "sieve" method used in ../io_mcel/.  
+  ! $$$ TBD:  Note that DomainEnd and PatchEnd must currently include "extra" 
+  ! $$$ TBD:  points for non-periodic staggered arrays.  It may be possible to 
+  ! $$$ TBD:  remove this hackery once ESMF can support staggered 
+  ! $$$ TBD:  grids in regional models.  
+  SUBROUTINE ioesmf_create_grid_int( esmfgrid, numdims,      &
+                              DomainStart, DomainEnd, &
+                              MemoryStart, MemoryEnd, &
+                              PatchStart, PatchEnd )
+    USE module_ext_esmf
+    IMPLICIT NONE
+    TYPE(ESMF_Grid), INTENT(INOUT) :: esmfgrid
+    INTEGER,         INTENT(IN   ) :: numdims
+    INTEGER,         INTENT(IN   ) :: DomainStart(numdims), DomainEnd(numdims)
+    INTEGER,         INTENT(IN   ) :: MemoryStart(numdims), MemoryEnd(numdims)
+    INTEGER,         INTENT(IN   ) :: PatchStart(numdims),  PatchEnd(numdims)
+    ! Local declarations
+    INTEGER :: numprocs     ! total number of tasks
+    INTEGER, ALLOCATABLE :: ipatchStarts(:), jpatchStarts(:)
+    INTEGER :: numprocsX    ! number of tasks in "i" dimension
+    INTEGER :: numprocsY    ! number of tasks in "j" dimension
+    INTEGER, ALLOCATABLE :: permuteTasks(:)
+    INTEGER :: globalXcount ! staggered domain count in "i" dimension
+    INTEGER :: globalYcount ! staggered domain count in "j" dimension
+    INTEGER :: myXstart     ! task-local start in "i" dimension
+    INTEGER :: myYstart     ! task-local start in "j" dimension
+    INTEGER :: myXend       ! staggered task-local end in "i" dimension
+    INTEGER :: myYend       ! staggered task-local end in "j" dimension
+    INTEGER, ALLOCATABLE :: allXStart(:)
+    INTEGER, ALLOCATABLE :: allXCount(:)
+    INTEGER, ALLOCATABLE :: dimXCount(:)
+    INTEGER, ALLOCATABLE :: allYStart(:)
+    INTEGER, ALLOCATABLE :: allYCount(:)
+    INTEGER, ALLOCATABLE :: dimYCount(:)
+    REAL(ESMF_KIND_R8), ALLOCATABLE :: coordX(:)
+    REAL(ESMF_KIND_R8), ALLOCATABLE :: coordY(:)
+    INTEGER, ALLOCATABLE :: cellCounts(:,:)
+    INTEGER, ALLOCATABLE :: globalStarts(:,:)
+    INTEGER :: rc
+    INTEGER :: myXcount      ! task-local count in "i" dimension
+    INTEGER :: myYcount      ! task-local count in "j" dimension
+    INTEGER :: globalCellCounts(2)
+    INTEGER :: numprocsXY(2)
+    INTEGER :: myPE, i, j, pe, is, ie, js, je, is_min, js_min, ie_max, je_max
+    INTEGER :: ips, ipe, jps, jpe, ids, ide, jds, jde
+    TYPE(ESMF_VM) :: vm
+    TYPE(ESMF_DELayout) :: taskLayout
+    CHARACTER (32) :: gridname
+    INTEGER, SAVE :: gridID = 0
+
+      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  begin...' )
+      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  numdims = ',numdims
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  DomainStart = ',DomainStart(1:numdims)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  DomainEnd = ',DomainEnd(1:numdims)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  MemoryStart = ',MemoryStart(1:numdims)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  MemoryEnd = ',MemoryEnd(1:numdims)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  PatchStart = ',PatchStart(1:numdims)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  PatchEnd = ',PatchEnd(1:numdims)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      ! First, determine number of tasks and number of tasks in each decomposed 
+      ! dimension (ESMF 2.2.0 is restricted to simple task layouts)
+      ! get current ESMF virtual machine and inquire...  
+      CALL ESMF_VMGetCurrent(vm, rc)
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_VMGetCurrent', &
+                       __FILE__ ,                    &
+                       ', line',                     &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+      ! TBH:  Note (PET==MPI process) assumption here.  This is OK in ESMF 
+      ! TBH:  2.2.0 but may change in a future ESMF release.  If so, we will 
+      ! TBH:  need another way to do this.  May want to grab mpiCommunicator 
+      ! TBH:  instead and ask it directly for number of MPI tasks.  Of course, 
+      ! TBH:  what if this is a serial run?  
+      CALL ESMF_VMGet(vm, petCount=numprocs, localPet=myPE, rc=rc)
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_VMGet', &
+                       __FILE__ ,             &
+                       ', line',              &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+      ALLOCATE( ipatchStarts(0:numprocs-1), jpatchStarts(0:numprocs-1) )
+      CALL GatherIntegerScalars_ESMF(PatchStart(1), myPE, numprocs, ipatchStarts)
+      CALL GatherIntegerScalars_ESMF(PatchStart(2), myPE, numprocs, jpatchStarts)
+      numprocsX = 0
+      numprocsY = 0
+      DO pe = 0, numprocs-1
+        IF ( PatchStart(1) == ipatchStarts(pe) ) THEN
+          numprocsX = numprocsX + 1
+        ENDIF
+        IF ( PatchStart(2) == jpatchStarts(pe) ) THEN
+          numprocsY = numprocsY + 1
+        ENDIF
+      ENDDO
+      DEALLOCATE( ipatchStarts, jpatchStarts )
+      ! sanity check
+      IF ( numprocs /= numprocsX*numprocsY ) THEN
+        CALL wrf_error_fatal ( 'ASSERTION FAILED:  numprocs /= numprocsX*numprocsY' )
+      ENDIF
+      ! Next, create ESMF_DELayout
+      numprocsXY = (/ numprocsX, numprocsY /)
+      ! transpose tasks to match RSL
+      ! TBH:  1-to-1 DE to PET mapping is assumed below...  
+      ALLOCATE( permuteTasks(0:numprocs-1) )
+      pe = 0
+      DO j = 0, numprocsY-1
+        DO i = 0, numprocsX-1
+! (/ 0 2 1 3 /)
+        permuteTasks(pe) = (i*numprocsY) + j
+! (/ 0 1 2 3 /)
+!        permuteTasks(pe) = pe
+        pe = pe + 1
+        ENDDO
+      ENDDO
+!$$$DEBUG
+!      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_VMPrint' )
+!      CALL ESMF_VMPrint( vm=vm, rc=rc )
+!      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_VMPrint' )
+!$$$END DEBUG
+      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  numprocsXY = ',numprocsXY
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  permuteTasks = ',permuteTasks
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_DELayoutCreate' )
+      taskLayout = ESMF_DELayoutCreate( vm, numprocsXY, petList=permuteTasks, rc=rc ) 
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_DELayoutCreate', &
+                       __FILE__ ,                      &
+                       ', line',                       &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_DELayoutCreate' )
+      DEALLOCATE( permuteTasks )
+!$$$DEBUG
+      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_DELayoutPrint 1' )
+      CALL ESMF_DELayoutPrint( taskLayout, rc=rc )
+      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_DELayoutPrint 1' )
+!$$$END DEBUG
+      ! Compute indices for staggered grids because ESMF does not yet support addition of 
+      ! extra data points for staggered dimensions as is common in regional models.  
+      ! $$$ TBD:  Remove this hack once ESMF can handle it.  
+      ! the [ij][dp][se] bits are for convenience...  
+      ids = DomainStart(1); ide = DomainEnd(1); 
+      jds = DomainStart(2); jde = DomainEnd(2); 
+      ips = PatchStart(1);  ipe = PatchEnd(1); 
+      jps = PatchStart(2);  jpe = PatchEnd(2); 
+      globalXcount = ide - ids + 1
+      globalYcount = jde - jds + 1
+      ! task-local numbers of points in patch for staggered arrays
+      myXstart = ips
+      myYstart = jps
+      ! staggered-only for now
+      myXend = ipe
+      myYend = jpe
+!      myXend = min(ipe, ide-1)
+!      myYend = min(jpe, jde-1)
+      myXcount = myXend - myXstart + 1
+      myYcount = myYend - myYstart + 1
+!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered     ips = ', ips
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered     ipe = ', min(ipe, ide-1)
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered i count = ', myXCount
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered     jps = ', jps
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered     jpe = ', min(jpe, jde-1)
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered j count = ', myYCount
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  WRF     staggered     ips = ', ips
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  WRF     staggered     ipe = ', ipe
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  WRF     staggered i count = ', ipe-ips+1
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  WRF     staggered     jps = ', jps
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  WRF     staggered     jpe = ', jpe
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  WRF     staggered j count = ', jpe-jps+1
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      ! gather task-local information on all tasks since 
+      ! ESMF_GridDistribute[Block] interface require global knowledge to set up 
+      ! decompositions (@#$%)
+      ! Recall that coordX and coordY are coordinates of *vertices*, not cell centers.  
+      ! Thus they must be 1 bigger than the number of cells.  
+      ALLOCATE( allXStart(0:numprocs-1),  allXCount(0:numprocs-1),  &
+                allYStart(0:numprocs-1),  allYCount(0:numprocs-1),  &
+                dimXCount(0:numprocsX-1), dimYCount(0:numprocsY-1), &
+                coordX(globalXcount+1),   coordY(globalYcount+1) )
+      CALL GatherIntegerScalars_ESMF(myXcount, myPE, numprocs, allXCount)
+      CALL GatherIntegerScalars_ESMF(myXstart, myPE, numprocs, allXStart)
+      CALL GatherIntegerScalars_ESMF(myYcount, myPE, numprocs, allYCount)
+      CALL GatherIntegerScalars_ESMF(myYstart, myPE, numprocs, allYStart)
+
+      ! HACK:  ESMF does not yet support mercator, polar-stereographic, or 
+      ! HACK:  lambert-conformal projections.  Therefore, we're using fake 
+      ! HACK:  coordinates here.  This means that WRF will either have to 
+      ! HACK:  couple to models that run on the same coorindate such that 
+      ! HACK:  grid points are co-located or something else will have to 
+      ! HACK:  perform the inter-grid interpolation computations.  Replace 
+      ! HACK:  this once ESMF is upgraded to support the above map 
+      ! HACK:  projections (via general curvilinear coordinates).  
+      CALL wrf_message( 'WARNING:  Using artificial coordinates for ESMF coupling.' )
+      CALL wrf_message( 'WARNING:  ESMF coupling interpolation will be incorrect' )
+      CALL wrf_message( 'WARNING:  unless grid points in the coupled components' )
+      CALL wrf_message( 'WARNING:  are co-located.  This limitation will be removed' )
+      CALL wrf_message( 'WARNING:  once ESMF coupling supports generalized' )
+      CALL wrf_message( 'WARNING:  curvilinear coordintates needed to represent' )
+      CALL wrf_message( 'WARNING:  common map projections used by WRF and other' )
+      CALL wrf_message( 'WARNING:  regional models.' )
+      ! Note that ESMF defines coordinates at *vertices*
+      coordX(1) = 0.0
+      DO i = 2, SIZE(coordX)
+        coordX(i) = coordX(i-1) + 1.0
+      ENDDO
+      coordY(1) = 0.0
+      DO j = 2, SIZE(coordY)
+        coordY(j) = coordY(j-1) + 1.0
+      ENDDO
+      ! Create an ESMF_Grid
+      ! For now we create only a 2D grid suitable for simple coupling of 2D 
+      ! surface fields.  Later, create and subset one or more 3D grids.  
+!TBH $$$:  NOTE that we'll have to use ESMF_GRID_HORZ_STAGGER_E_?? for NMM.  
+!TBH $$$:  E-grid is not yet supported by ESMF.  Eventually pass staggering 
+!TBH $$$:  info into this routine.  For now, hard-code it for WRF-ARW.  
+      gridID = gridID + 1
+      WRITE ( gridname,'(a,i0)' ) 'WRF_grid_', gridID
+!$$$DEBUG
+CALL wrf_debug ( 5 , 'DEBUG WRF:  Calling ESMF_GridCreateHorzXY()' )
+WRITE( msg,* ) 'DEBUG WRF:  SIZE(coordX) = ', SIZE(coordX)
+CALL wrf_debug ( 5 , TRIM(msg) )
+WRITE( msg,* ) 'DEBUG WRF:  SIZE(coordY) = ', SIZE(coordY)
+CALL wrf_debug ( 5 , TRIM(msg) )
+DO i = 1, SIZE(coordX)
+  WRITE( msg,* ) 'DEBUG WRF:  coord1(',i,') = ', coordX(i)
+  CALL wrf_debug ( 5 , TRIM(msg) )
+ENDDO
+DO j = 1, SIZE(coordY)
+  WRITE( msg,* ) 'DEBUG WRF:  coord2(',j,') = ', coordY(j)
+  CALL wrf_debug ( 5 , TRIM(msg) )
+ENDDO
+WRITE( msg,* ) 'DEBUG WRF:  horzstagger = ', ESMF_GRID_HORZ_STAGGER_C_SW
+CALL wrf_debug ( 5 , TRIM(msg) )
+WRITE( msg,* ) 'DEBUG WRF:  name = ', TRIM(gridname)
+CALL wrf_debug ( 5 , TRIM(msg) )
+!$$$END DEBUG
+      esmfgrid = ESMF_GridCreateHorzXY(                     &
+                   coord1=coordX, coord2=coordY,            &
+                   horzstagger=ESMF_GRID_HORZ_STAGGER_C_SW, &
+! use this for 3D Grids once it is stable
+!                  coordorder=ESMF_COORD_ORDER_XZY,         &
+                   name=TRIM(gridname), rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_GridCreateHorzXY', &
+                       __FILE__ ,                        &
+                       ', line',                         &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+CALL wrf_debug ( 5 , 'DEBUG WRF:  back OK from ESMF_GridCreateHorzXY()' )
+      ! distribute the ESMF_Grid
+      ! ignore repeated values
+      is_min = MINVAL(allXStart)
+      js_min = MINVAL(allYStart)
+      i = 0
+      j = 0
+      WRITE( msg,* ) 'DEBUG:  is_min = ',is_min,'  allXStart = ',allXStart
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  js_min = ',js_min,'  allYStart = ',allYStart
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  allXCount = ',allXCount
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  allYCount = ',allYCount
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      DO pe = 0, numprocs-1
+        IF (allXStart(pe) == is_min) THEN
+          IF (j >= numprocsY) THEN
+            WRITE( msg,* ) 'ASSERTION FAILED in ESMF_GridCreateHorzXY', &
+                           __FILE__ ,                                   &
+                           ', line',                                    &
+                           __LINE__
+            CALL wrf_error_fatal ( msg )
+          ENDIF
+      WRITE( msg,* ) 'DEBUG:  dimYCount(',j,') == allYCount(',pe,')'
+      CALL wrf_debug ( 5 , TRIM(msg) )
+          dimYCount(j) = allYCount(pe)
+          j = j + 1
+        ENDIF
+        IF (allYStart(pe) == js_min) THEN
+          IF (i >= numprocsX) THEN
+            WRITE( msg,* ) 'ASSERTION FAILED in ESMF_GridCreateHorzXY', &
+                           __FILE__ ,                                   &
+                           ', line',                                    &
+                           __LINE__
+            CALL wrf_error_fatal ( msg )
+          ENDIF
+      WRITE( msg,* ) 'DEBUG:  dimXCount(',i,') == allXCount(',pe,')'
+      CALL wrf_debug ( 5 , TRIM(msg) )
+          dimXCount(i) = allXCount(pe)
+          i = i + 1
+        ENDIF
+      ENDDO
+      WRITE( msg,* ) 'DEBUG:  i = ',i,'  dimXCount = ',dimXCount
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  j = ',j,'  dimYCount = ',dimYCount
+      CALL wrf_debug ( 5 , TRIM(msg) )
+!$$$DEBUG
+      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_DELayoutPrint 2' )
+      CALL ESMF_DELayoutPrint( taskLayout, rc=rc )
+      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_DELayoutPrint 2' )
+!$$$END DEBUG
+! $$$  crashes here with "-g" ...
+      CALL ESMF_GridDistribute( esmfgrid,                  &
+                                delayout=taskLayout,       &
+                                countsPerDEDim1=dimXCount, &
+                                countsPerDEDim2=dimYCount, &
+                                rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_GridDistribute ', &
+                       __FILE__ ,                       &
+                       ', line ',                       &
+                       __LINE__ ,                       &
+                       ', error code = ',rc
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+CALL wrf_debug ( 5 , 'DEBUG WRF:  Calling ESMF_GridValidate()' )
+      CALL ESMF_GridValidate( esmfgrid, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_GridValidate ',   &
+                       __FILE__ ,                       &
+                       ', line ',                       &
+                       __LINE__ ,                       &
+                       ', error code = ',rc
+! TBH:  debugging error exit here...  
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+CALL wrf_debug ( 5 , 'DEBUG WRF:  back OK from ESMF_GridValidate()' )
+      DEALLOCATE( allXStart, allXCount, allYStart, allYCount, &
+                  dimXCount, dimYCount, coordX, coordY )
+
+      ! Print out the ESMF decomposition info for debug comparison with WRF 
+      ! decomposition info.  
+      ALLOCATE( cellCounts(0:numprocs-1,2), globalStarts(0:numprocs-1,2) )
+
+!      CALL ESMF_GridGet( esmfgrid,                               &
+!                         horzrelloc=ESMF_CELL_CENTER,            &
+!                         globalStartPerDEPerDim=globalStarts,    &
+!                         cellCountPerDEPerDim=cellCounts,        &
+!                         globalCellCountPerDim=globalCellCounts, &
+!                         rc=rc )
+!      IF ( rc /= ESMF_SUCCESS ) THEN
+!        WRITE( msg,* ) 'Error in ESMF_GridGet', &
+!                       __FILE__ ,               &
+!                       ', line',                &
+!                       __LINE__
+!        CALL wrf_error_fatal ( msg )
+!      ENDIF
+! note that global indices in ESMF_Grid always start at zero
+!      WRITE( msg,* ) 'DEBUG:  ESMF task-id = ',myPE
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered     ips = ',1+globalStarts(myPE,1)
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered     ipe = ',1+globalStarts(myPE,1) + cellCounts(myPE,1) - 1
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered i count = ',  cellCounts(myPE,1)
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered     jps = ',1+globalStarts(myPE,2)
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered     jpe = ',1+globalStarts(myPE,2) + cellCounts(myPE,2) - 1
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered j count = ',  cellCounts(myPE,2)
+!      CALL wrf_debug ( 5 , TRIM(msg) )
+!      is_min = globalStarts(0,1)
+!      js_min = globalStarts(0,2)
+!      ie_max = globalStarts(0,1) + cellCounts(0,1) - 1
+!      je_max = globalStarts(0,2) + cellCounts(0,2) - 1
+!      DO pe = 1, (numprocsX*numprocsY)-1
+!        js = globalStarts(pe,2)
+!        je = globalStarts(pe,2) + cellCounts(pe,2) - 1
+!        IF ( js < js_min ) js_min = js
+!        IF ( je > je_max ) je_max = je
+!        is = globalStarts(pe,1)
+!        ie = globalStarts(pe,1) + cellCounts(pe,1) - 1
+!        IF ( is < is_min ) is_min = is
+!        IF ( ie > ie_max ) ie_max = ie
+!      ENDDO
+
+      ! extract information about staggered grids for debugging
+      CALL ESMF_GridGet( esmfgrid,                               &
+                         horzrelloc=ESMF_CELL_WFACE,             &
+                         globalStartPerDEPerDim=globalStarts,    &
+                         cellCountPerDEPerDim=cellCounts,        &
+                         globalCellCountPerDim=globalCellCounts, &
+                         rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_GridGet', &
+                       __FILE__ ,               &
+                       ', line',                &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+! note that global indices in ESMF_Grid always start at zero
+      WRITE( msg,* ) 'DEBUG:  ESMF     staggered     ips = ',1+globalStarts(myPE,1)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  ESMF     staggered     ipe = ',1+globalStarts(myPE,1) + cellCounts(myPE,1) - 1
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  ESMF     staggered i count = ',  cellCounts(myPE,1)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      CALL ESMF_GridGet( esmfgrid,                               &
+                         horzrelloc=ESMF_CELL_SFACE,             &
+                         globalStartPerDEPerDim=globalStarts,    &
+                         cellCountPerDEPerDim=cellCounts,        &
+                         globalCellCountPerDim=globalCellCounts, &
+                         rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_GridGet', &
+                       __FILE__ ,               &
+                       ', line',                &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+! note that global indices in ESMF_Grid always start at zero
+      WRITE( msg,* ) 'DEBUG:  ESMF     staggered     jps = ',1+globalStarts(myPE,2)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  ESMF     staggered     jpe = ',1+globalStarts(myPE,2) + cellCounts(myPE,2) - 1
+      CALL wrf_debug ( 5 , TRIM(msg) )
+      WRITE( msg,* ) 'DEBUG:  ESMF     staggered j count = ',  cellCounts(myPE,2)
+      CALL wrf_debug ( 5 , TRIM(msg) )
+
+      DEALLOCATE( cellCounts, globalStarts )
+
+      CALL wrf_debug ( 100 , 'DEBUG ioesmf_create_grid_int:  print esmfgrid BEGIN...' )
+      CALL ESMF_GridPrint( esmfgrid, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_GridPrint', &
+                       __FILE__ ,                        &
+                       ', line',                         &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+      CALL wrf_debug ( 100 , 'DEBUG ioesmf_create_grid_int:  print esmfgrid END' )
+
+      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  returning...' )
+
+  END SUBROUTINE ioesmf_create_grid_int
+
+
+
+  ! Destroy the ESMF_Grid associated with index DataHandle.  
+  ! grid( DataHandle )%ptr is DEALLOCATED (NULLIFIED)
+  SUBROUTINE ioesmf_destroy_grid( DataHandle )
+    USE module_ext_esmf
+    IMPLICIT NONE
+    INTEGER, INTENT(IN   ) :: DataHandle
+    ! Local declarations
+    INTEGER :: id, rc
+    TYPE(ESMF_DELayout) :: taskLayout
+    LOGICAL :: noneLeft
+    IF ( grid( DataHandle )%in_use ) THEN
+WRITE( msg,* ) 'DEBUG:  ioesmf_destroy_grid( ',DataHandle,' ) begin...'
+CALL wrf_debug ( 5 , TRIM(msg) )
+      CALL ESMF_GridGet( grid( DataHandle )%ptr, delayout=taskLayout, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_GridGet', &
+                       __FILE__ ,               &
+                       ', line',                &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+      ! I "know" I created this...  (not really, but ESMF cannot tell me!)
+      CALL ESMF_DELayoutDestroy( taskLayout, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_DELayoutDestroy', &
+                       __FILE__ ,                       &
+                       ', line',                        &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+      CALL ESMF_GridDestroy( grid( DataHandle )%ptr, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        WRITE( msg,* ) 'Error in ESMF_GridDestroy', &
+                       __FILE__ ,                   &
+                       ', line',                    &
+                       __LINE__
+        CALL wrf_error_fatal ( msg )
+      ENDIF
+      DEALLOCATE( grid( DataHandle )%ptr )
+      CALL ioesmf_nullify_grid( DataHandle )
+WRITE( msg,* ) 'DEBUG:  ioesmf_destroy_grid( ',DataHandle,' ) end'
+CALL wrf_debug ( 5 , TRIM(msg) )
+    ENDIF
+
+  END SUBROUTINE ioesmf_destroy_grid
+
+
+  ! Nullify the grid_ptr associated with index DataHandle.  
+  ! grid( DataHandle )%ptr must not be associated
+  ! DataHandle must be in a valid range
+  SUBROUTINE ioesmf_nullify_grid( DataHandle )
+    USE module_ext_esmf
+    IMPLICIT NONE
+    INTEGER, INTENT(IN   ) :: DataHandle
+    NULLIFY( grid( DataHandle )%ptr )
+    grid( DataHandle )%in_use = .FALSE.
+    grid( DataHandle )%ide_save = 0
+    grid( DataHandle )%jde_save = 0
+    grid( DataHandle )%kde_save = 0
+  END SUBROUTINE ioesmf_nullify_grid
+
+
+!$$$here...  use generic explicit interfaces?  if not, why not?  
+ !$$$ remove duplication!
+ SUBROUTINE ioesmf_extract_data_real( data_esmf_real, Field,      &
+                                      ips, ipe, jps, jpe, kps, kpe, &
+                                      ims, ime, jms, jme, kms, kme )
+   USE module_ext_esmf
+   IMPLICIT NONE
+   INTEGER,            INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
+   INTEGER,            INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
+   REAL(ESMF_KIND_R4), INTENT(IN   ) :: data_esmf_real( ips:ipe, jps:jpe )
+   REAL,               INTENT(  OUT) :: Field( ims:ime, jms:jme, kms:kme )
+   Field( ips:ipe, jps:jpe, kms ) = data_esmf_real( ips:ipe, jps:jpe )
+ END SUBROUTINE ioesmf_extract_data_real
+
+
+ !$$$ remove duplication!
+ SUBROUTINE ioesmf_extract_data_int( data_esmf_int, Field,         &
+                                     ips, ipe, jps, jpe, kps, kpe, &
+                                     ims, ime, jms, jme, kms, kme )
+   USE module_ext_esmf
+   IMPLICIT NONE
+   INTEGER,               INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
+   INTEGER,               INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
+   INTEGER(ESMF_KIND_I4), INTENT(IN   ) :: data_esmf_int( ips:ipe, jps:jpe )
+   INTEGER,               INTENT(  OUT) :: Field( ims:ime, jms:jme, kms:kme )
+   Field( ips:ipe, jps:jpe, kms ) = data_esmf_int( ips:ipe, jps:jpe )
+ END SUBROUTINE ioesmf_extract_data_int
+
+
+ !$$$ remove duplication!
+ SUBROUTINE ioesmf_insert_data_real( Field, data_esmf_real,        &
+                                     ips, ipe, jps, jpe, kps, kpe, &
+                                     ims, ime, jms, jme, kms, kme )
+   USE module_ext_esmf
+   IMPLICIT NONE
+   INTEGER,               INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
+   INTEGER,               INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
+   REAL,                  INTENT(IN   ) :: Field( ims:ime, jms:jme, kms:kme )
+   REAL(ESMF_KIND_R4),    INTENT(  OUT) :: data_esmf_real( ips:ipe, jps:jpe )
+   ! $$$ TBD:  Remove this hack once we no longer have to store non-staggered 
+   ! $$$ TBD:  arrays in space dimensioned for staggered arrays.  
+   data_esmf_real = 0.0_ESMF_KIND_R4
+   data_esmf_real( ips:ipe, jps:jpe ) = Field( ips:ipe, jps:jpe, kms )
+ END SUBROUTINE ioesmf_insert_data_real
+
+
+ !$$$ remove duplication!
+ SUBROUTINE ioesmf_insert_data_int( Field, data_esmf_int,         &
+                                    ips, ipe, jps, jpe, kps, kpe, &
+                                    ims, ime, jms, jme, kms, kme )
+   USE module_ext_esmf
+   IMPLICIT NONE
+   INTEGER,               INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
+   INTEGER,               INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
+   INTEGER,               INTENT(IN   ) :: Field( ims:ime, jms:jme, kms:kme )
+   INTEGER(ESMF_KIND_I4), INTENT(  OUT) :: data_esmf_int( ips:ipe, jps:jpe )
+   ! $$$ TBD:  Remove this hack once we no longer have to store non-staggered 
+   ! $$$ TBD:  arrays in space dimensioned for staggered arrays.  
+   data_esmf_int = 0.0_ESMF_KIND_I4
+   data_esmf_int( ips:ipe, jps:jpe ) = Field( ips:ipe, jps:jpe, kms )
+ END SUBROUTINE ioesmf_insert_data_int
+
+
+!--------------
+
+SUBROUTINE ext_esmf_ioinit( SysDepInfo, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  CHARACTER*(*), INTENT(IN) :: SysDepInfo
+  INTEGER Status
+  CALL init_module_ext_esmf
+  Status = 0 
+END SUBROUTINE ext_esmf_ioinit
+
+!--- open_for_read 
+SUBROUTINE ext_esmf_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                    DataHandle , Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_open_for_read not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN  
+END SUBROUTINE ext_esmf_open_for_read
+
+
+!--- inquire_opened
+SUBROUTINE ext_esmf_inquire_opened ( DataHandle, FileName , FileStatus, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+
+  Status = 0
+
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  begin, DataHandle = ', DataHandle
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  int_valid_handle(',DataHandle,') = ', &
+                 int_valid_handle( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  int_handle_in_use(',DataHandle,') = ', &
+                 int_handle_in_use( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  opened_for_read(',DataHandle,') = ', &
+                 opened_for_read( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  okay_to_read(',DataHandle,') = ', &
+                 okay_to_read( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  opened_for_write(',DataHandle,') = ', &
+                 opened_for_write( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  okay_to_write(',DataHandle,') = ', &
+                 okay_to_write( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+
+!$$$ need to cache file name and match with FileName argument and return 
+!$$$ FileStatus = WRF_FILE_NOT_OPENED if they do not match
+
+  FileStatus = WRF_FILE_NOT_OPENED
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      IF ( opened_for_read ( DataHandle ) ) THEN
+        IF ( okay_to_read( DataHandle ) ) THEN
+           FileStatus = WRF_FILE_OPENED_FOR_READ
+        ELSE
+           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+        ENDIF
+      ELSE IF ( opened_for_write( DataHandle ) ) THEN
+        IF ( okay_to_write( DataHandle ) ) THEN
+           FileStatus = WRF_FILE_OPENED_FOR_WRITE
+        ELSE
+           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+        ENDIF
+      ELSE
+        FileStatus = WRF_FILE_NOT_OPENED
+      ENDIF
+    ENDIF
+    WRITE( msg,* ) 'ERROR ext_esmf_inquire_opened:  file handle ',DataHandle,' is invalid'
+    CALL wrf_error_fatal ( TRIM(msg) )
+  ENDIF
+
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  end, FileStatus = ', FileStatus
+  CALL wrf_debug ( 5 , TRIM(msg) )
+
+  Status = 0
+  
+  RETURN
+END SUBROUTINE ext_esmf_inquire_opened
+
+!--- inquire_filename
+SUBROUTINE ext_esmf_inquire_filename ( DataHandle, FileName , FileStatus, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER *80   SysDepInfo
+  Status = 0
+
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  begin, DataHandle = ', DataHandle
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  int_valid_handle(',DataHandle,') = ', &
+                 int_valid_handle( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  int_handle_in_use(',DataHandle,') = ', &
+                 int_handle_in_use( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  opened_for_read(',DataHandle,') = ', &
+                 opened_for_read( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  okay_to_read(',DataHandle,') = ', &
+                 okay_to_read( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  opened_for_write(',DataHandle,') = ', &
+                 opened_for_write( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  okay_to_write(',DataHandle,') = ', &
+                 okay_to_write( DataHandle )
+  CALL wrf_debug ( 5 , TRIM(msg) )
+
+!$$$ need to cache file name and return via FileName argument
+
+  FileStatus = WRF_FILE_NOT_OPENED
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      IF ( opened_for_read ( DataHandle ) ) THEN
+        IF ( okay_to_read( DataHandle ) ) THEN
+           FileStatus = WRF_FILE_OPENED_FOR_READ
+        ELSE
+           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+        ENDIF
+      ELSE IF ( opened_for_write( DataHandle ) ) THEN
+        IF ( okay_to_write( DataHandle ) ) THEN
+           FileStatus = WRF_FILE_OPENED_FOR_WRITE
+        ELSE
+           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+        ENDIF
+      ELSE
+        FileStatus = WRF_FILE_NOT_OPENED
+      ENDIF
+    ENDIF
+    WRITE( msg,* ) 'ERROR ext_esmf_inquire_filename:  file handle ',DataHandle,' is invalid'
+    CALL wrf_error_fatal ( TRIM(msg) )
+  ENDIF
+
+  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  end, FileStatus = ', FileStatus
+  CALL wrf_debug ( 5 , TRIM(msg) )
+
+  Status = 0
+  RETURN
+END SUBROUTINE ext_esmf_inquire_filename
+
+!--- sync
+SUBROUTINE ext_esmf_iosync ( DataHandle, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  Status = 0
+  RETURN
+END SUBROUTINE ext_esmf_iosync
+
+!--- close
+SUBROUTINE ext_esmf_ioclose ( DataHandle, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER DataHandle, Status
+  ! locals
+  TYPE state_ptr
+    TYPE(ESMF_State), POINTER :: stateptr
+  END TYPE state_ptr
+  TYPE(state_ptr) :: states(2)
+  TYPE(ESMF_State), POINTER :: state
+  INTEGER :: numItems, numFields, i, istate
+  TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
+  TYPE(ESMF_Field) :: tmpField
+  REAL, POINTER :: tmp_ptr(:,:)
+  CHARACTER (len=ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
+  CHARACTER (len=ESMF_MAXSTR) :: str
+  INTEGER :: rc
+
+! TODO:  The code below hangs with this error message:  
+! TODO:  "ext_esmf_ioclose:  ESMF_FieldGetDataPointer( LANDMASK) failed"
+! TODO:  Fix this so ESMF objects actually get destroyed to avoid memory 
+! TODO:  leaks and other extraordinary nastiness.  
+  CALL wrf_debug( 5, 'ext_esmf_ioclose:  WARNING:  not destroying ESMF objects' )
+#if 0
+  ! $$$ Need to upgrade this to use nested ESMF_States if we want support 
+  ! $$$ more than one auxin and one auxhist stream for ESMF.  
+  IF ( int_valid_handle (DataHandle) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      ! Iterate through importState *and* exportState, find each ESMF_Field, 
+      ! extract its data pointer and deallocate it, then destroy the 
+      ! ESMF_Field.  
+      CALL ESMF_ImportStateGetCurrent(states(1)%stateptr, rc)
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal( 'ext_esmf_ioclose:  ESMF_ImportStateGetCurrent failed' )
+      ENDIF
+      CALL ESMF_ExportStateGetCurrent(states(2)%stateptr, rc)
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal( 'ext_esmf_ioclose:  ESMF_ExportStateGetCurrent failed' )
+      ENDIF
+      DO istate=1, 2
+        state => states(istate)%stateptr   ! all this to avoid assignment (@#$%)
+        ! Since there are no convenient iterators for ESMF_State (@#$%),
+        ! write a lot of code...
+        ! Figure out how many items are in the ESMF_State
+        CALL ESMF_StateGet(state, itemCount=numItems, rc=rc)
+        IF ( rc /= ESMF_SUCCESS) THEN
+          CALL wrf_error_fatal ( 'ext_esmf_ioclose:  ESMF_StateGet(numItems) failed' )
+        ENDIF
+        ! allocate an array to hold the types of all items
+        ALLOCATE( itemTypes(numItems) )
+        ! allocate an array to hold the names of all items
+        ALLOCATE( itemNames(numItems) )
+        ! get the item types and names
+        CALL ESMF_StateGet(state, stateitemtypeList=itemTypes, &
+                           itemNameList=itemNames, rc=rc)
+        IF ( rc /= ESMF_SUCCESS) THEN
+          WRITE(str,*) 'ext_esmf_ioclose:  ESMF_StateGet itemTypes failed with rc = ', rc
+          CALL wrf_error_fatal ( str )
+        ENDIF
+        ! count how many items are ESMF_Fields
+        numFields = 0
+        DO i=1,numItems
+          IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
+            numFields = numFields + 1
+          ENDIF
+        ENDDO
+        IF ( numFields > 0) THEN
+          ! finally, extract nested ESMF_Fields by name, if there are any
+          ! (should be able to do this by index at least -- @#%$)
+          DO i=1,numItems
+            IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
+              CALL ESMF_StateGetField( state, TRIM(itemNames(i)), &
+                                       tmpField, rc=rc )
+              IF ( rc /= ESMF_SUCCESS) THEN
+                WRITE(str,*) 'ext_esmf_ioclose:  ESMF_StateGetField(',TRIM(itemNames(i)),') failed'
+                CALL wrf_error_fatal ( str )
+              ENDIF
+              ! destroy pointer in field
+              CALL ESMF_FieldGetDataPointer( tmpField, tmp_ptr, rc=rc )
+              IF (rc /= ESMF_SUCCESS) THEN
+                WRITE( str , * )                                   &
+                  'ext_esmf_ioclose:  ESMF_FieldGetDataPointer( ', &
+                  TRIM(itemNames(i)),') failed'
+                CALL wrf_error_fatal ( TRIM(str) )
+              ENDIF
+              DEALLOCATE( tmp_ptr )
+              ! destroy field
+              CALL ESMF_FieldDestroy( tmpField, rc=rc )
+              IF (rc /= ESMF_SUCCESS) THEN
+                WRITE( str , * )                            &
+                  'ext_esmf_ioclose:  ESMF_FieldDestroy( ', &
+                  TRIM(itemNames(i)),') failed'
+                CALL wrf_error_fatal ( TRIM(str) )
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDIF
+        ! deallocate locals
+        DEALLOCATE( itemTypes )
+        DEALLOCATE( itemNames )
+      ENDDO
+      ! destroy ESMF_Grid associated with DataHandle
+      CALL ioesmf_destroy_grid( DataHandle )
+    ENDIF
+  ENDIF
+#endif
+  Status = 0
+  RETURN
+END SUBROUTINE ext_esmf_ioclose
+
+!--- ioexit
+SUBROUTINE ext_esmf_ioexit( Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER :: i
+  Status = 0
+! TODO:  The code below causes ext_ncd_ioclose() to fail in the 
+! TODO:  SST component for reasons as-yet unknown.  
+! TODO:  Fix this so ESMF objects actually get destroyed to avoid memory 
+! TODO:  leaks and other extraordinary nastiness.  
+  CALL wrf_debug( 5, 'ext_esmf_ioexit:  WARNING:  not destroying ESMF objects' )
+#if 0
+  DO i = 1, int_num_handles
+    ! close any remaining open DataHandles
+    CALL ext_esmf_ioclose ( i, Status )
+    ! destroy ESMF_Grid for this DataHandle
+    CALL ioesmf_destroy_grid( i )
+  ENDDO
+  CALL wrf_debug ( 5 , &
+    'ext_esmf_ioexit:  DEBUG:  done cleaning up ESMF objects' )
+#endif
+  RETURN  
+END SUBROUTINE ext_esmf_ioexit
+
+!--- get_next_time
+SUBROUTINE ext_esmf_get_next_time ( DataHandle, DateStr, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_esmf.F90: ext_esmf_get_next_time: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_esmf.F90: ext_esmf_get_next_time: DataHandle not opened" )
+  ENDIF
+  CALL wrf_message( "ext_esmf_get_next_time() not supported yet")
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_next_time
+
+!--- set_time
+SUBROUTINE ext_esmf_set_time ( DataHandle, DateStr, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message( "ext_esmf_set_time() not supported yet")
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_set_time
+
+!--- get_var_info
+SUBROUTINE ext_esmf_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
+                                   DomainStart , DomainEnd , WrfType, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: VarName
+  integer               ,intent(out)    :: NDim
+  character*(*)         ,intent(out)    :: MemoryOrder
+  character*(*)         ,intent(out)    :: Stagger
+  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
+  integer               ,intent(out)    :: WrfType
+  integer               ,intent(out)    :: Status
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_esmf.F90: ext_esmf_get_var_info: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_esmf.F90: ext_esmf_get_var_info: DataHandle not opened" )
+  ENDIF
+  CALL wrf_message( "ext_esmf_get_var_info() not supported yet")
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_info
+
+!--- get_next_var
+SUBROUTINE ext_esmf_get_next_var ( DataHandle, VarName, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: VarName
+  INTEGER ,       INTENT(OUT) :: Status
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_esmf/io_esmf.F90: ext_esmf_get_next_var: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_esmf/io_esmf.F90: ext_esmf_get_next_var: DataHandle not opened" )
+  ENDIF
+  CALL wrf_message( "ext_esmf_get_next_var() not supported yet")
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_next_var
+
+!--- get_dom_ti_real
+SUBROUTINE ext_esmf_get_dom_ti_real ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Outcount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message( "ext_esmf_get_dom_ti_real() not supported yet")
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_ti_real 
+
+!--- put_dom_ti_real
+SUBROUTINE ext_esmf_put_dom_ti_real ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message( "ext_esmf_put_dom_ti_real() not supported yet")
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_ti_real 
+
+!--- get_dom_ti_double
+SUBROUTINE ext_esmf_get_dom_ti_double ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_dom_ti_double not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_ti_double 
+
+!--- put_dom_ti_double
+SUBROUTINE ext_esmf_put_dom_ti_double ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_dom_ti_double not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_ti_double 
+
+!--- get_dom_ti_integer
+SUBROUTINE ext_esmf_get_dom_ti_integer ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+
+  Status = 0
+  IF      ( Element == 'WEST-EAST_GRID_DIMENSION' ) THEN
+    Data(1) = grid( DataHandle )%ide_save
+    Outcount = 1
+  ELSE IF ( Element == 'SOUTH-NORTH_GRID_DIMENSION' ) THEN
+    Data(1) = grid( DataHandle )%jde_save
+    Outcount = 1
+  ELSE IF ( Element == 'BOTTOM-TOP_GRID_DIMENSION' ) THEN
+    Data(1) = grid( DataHandle )%kde_save
+    Outcount = 1
+  ELSE
+    CALL wrf_message('ext_esmf_get_dom_ti_integer not fully supported yet')
+    Status = WRF_WARN_NOTSUPPORTED
+  ENDIF
+
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_ti_integer 
+
+!--- put_dom_ti_integer
+SUBROUTINE ext_esmf_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  INTEGER ,       INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_dom_ti_integer not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_ti_integer 
+
+!--- get_dom_ti_logical
+SUBROUTINE ext_esmf_get_dom_ti_logical ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_dom_ti_logical not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_ti_logical 
+
+!--- put_dom_ti_logical
+SUBROUTINE ext_esmf_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_dom_ti_logical not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_ti_logical 
+
+!--- get_dom_ti_char
+SUBROUTINE ext_esmf_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_dom_ti_char not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_ti_char 
+
+!--- put_dom_ti_char
+SUBROUTINE ext_esmf_put_dom_ti_char ( DataHandle, Element,  Data,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_dom_ti_char not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_ti_char 
+
+!--- get_dom_td_real
+SUBROUTINE ext_esmf_get_dom_td_real ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_dom_td_real not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_td_real 
+
+!--- put_dom_td_real
+SUBROUTINE ext_esmf_put_dom_td_real ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_dom_td_real not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_td_real 
+
+!--- get_dom_td_double
+SUBROUTINE ext_esmf_get_dom_td_double ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_dom_td_double not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_td_double 
+
+!--- put_dom_td_double
+SUBROUTINE ext_esmf_put_dom_td_double ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_dom_td_double not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_td_double 
+
+!--- get_dom_td_integer
+SUBROUTINE ext_esmf_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_dom_td_integer not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_td_integer 
+
+!--- put_dom_td_integer
+SUBROUTINE ext_esmf_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_dom_td_integer not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_td_integer 
+
+!--- get_dom_td_logical
+SUBROUTINE ext_esmf_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_dom_td_logical not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_td_logical 
+
+!--- put_dom_td_logical
+SUBROUTINE ext_esmf_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_dom_td_logical not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_td_logical 
+
+!--- get_dom_td_char
+SUBROUTINE ext_esmf_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_dom_td_char not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_dom_td_char 
+
+!--- put_dom_td_char
+SUBROUTINE ext_esmf_put_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_dom_td_char not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_dom_td_char 
+
+!--- get_var_ti_real
+SUBROUTINE ext_esmf_get_var_ti_real ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_var_ti_real not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_ti_real 
+
+!--- put_var_ti_real
+SUBROUTINE ext_esmf_put_var_ti_real ( DataHandle,Element,  Varname, Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_var_ti_real not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_ti_real 
+
+!--- get_var_ti_double
+SUBROUTINE ext_esmf_get_var_ti_double ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_var_ti_double not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_ti_double 
+
+!--- put_var_ti_double
+SUBROUTINE ext_esmf_put_var_ti_double ( DataHandle,Element,  Varname, Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_var_ti_double not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_ti_double 
+
+!--- get_var_ti_integer
+SUBROUTINE ext_esmf_get_var_ti_integer ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_var_ti_integer not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_ti_integer 
+
+!--- put_var_ti_integer
+SUBROUTINE ext_esmf_put_var_ti_integer ( DataHandle,Element,  Varname, Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_var_ti_integer not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_ti_integer 
+
+!--- get_var_ti_logical
+SUBROUTINE ext_esmf_get_var_ti_logical ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_var_ti_logical not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_ti_logical 
+
+!--- put_var_ti_logical
+SUBROUTINE ext_esmf_put_var_ti_logical ( DataHandle,Element,  Varname, Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_var_ti_logical not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_ti_logical 
+
+!--- get_var_ti_char
+SUBROUTINE ext_esmf_get_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER locDataHandle, code
+  CHARACTER*132 locElement, locVarName
+  CALL wrf_message('ext_esmf_get_var_ti_char not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_ti_char 
+
+!--- put_var_ti_char
+SUBROUTINE ext_esmf_put_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  INTEGER                 :: Count
+  CALL wrf_message('ext_esmf_put_var_ti_char not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_ti_char 
+
+!--- get_var_td_real
+SUBROUTINE ext_esmf_get_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_var_td_real not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_td_real 
+
+!--- put_var_td_real
+SUBROUTINE ext_esmf_put_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_var_td_real not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_td_real 
+
+!--- get_var_td_double
+SUBROUTINE ext_esmf_get_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_var_td_double not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_td_double 
+
+!--- put_var_td_double
+SUBROUTINE ext_esmf_put_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_var_td_double not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_td_double 
+
+!--- get_var_td_integer
+SUBROUTINE ext_esmf_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_var_td_integer not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_td_integer 
+
+!--- put_var_td_integer
+SUBROUTINE ext_esmf_put_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_var_td_integer not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_td_integer 
+
+!--- get_var_td_logical
+SUBROUTINE ext_esmf_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_var_td_logical not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_td_logical 
+
+!--- put_var_td_logical
+SUBROUTINE ext_esmf_put_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_var_td_logical not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_td_logical 
+
+!--- get_var_td_char
+SUBROUTINE ext_esmf_get_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_get_var_td_char not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_get_var_td_char 
+
+!--- put_var_td_char
+SUBROUTINE ext_esmf_put_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+  USE module_ext_esmf
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_esmf_put_var_td_char not supported yet')
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_esmf_put_var_td_char 
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/makefile	(revision 2744)
@@ -0,0 +1,41 @@
+# these settings for compiling standalone on Compaq. Type "make -r"
+#CPP = /lib/cpp 
+#FC  = f90 -free
+
+.SUFFIXES: .F90 .o
+
+AR = ar
+#RANLIB	= ranlib
+RANLIB	= echo
+
+OBJS = module_symbols_util.o \
+       module_esmf_extensions.o \
+       module_utility.o \
+       io_esmf.o \
+       ext_esmf_open_for_read.o \
+       ext_esmf_open_for_write.o \
+       ext_esmf_read_field.o \
+       ext_esmf_write_field.o
+
+TARGET = libwrfio_esmf.a
+
+$(TARGET) : $(OBJS)
+	$(AR) ru $(TARGET) $(OBJS)
+	$(RANLIB) $(TARGET)
+
+.F90.o :
+	$(CPP) -I../ioapi_share  -P -DESMF_COUPLING $*.F90 > $*.f
+	$(FC) -c -g -I../ioapi_share $*.f
+
+superclean: 
+	/bin/rm -f *.f *.o $(TARGET) *.mod
+
+# DEPENDENCIES : only dependencies after this line 
+
+module_utility.o : module_symbols_util.o module_esmf_extensions.o
+io_esmf.o : module_esmf_extensions.o
+ext_esmf_open_for_read.o : io_esmf.o
+ext_esmf_open_for_write.o : io_esmf.o
+ext_esmf_read_field.o : io_esmf.o
+ext_esmf_write_field.o : io_esmf.o
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/module_esmf_extensions.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/module_esmf_extensions.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/module_esmf_extensions.F90	(revision 2744)
@@ -0,0 +1,537 @@
+
+! "module_esmf_extensions" is responsible for yet-to-be-implemented ESMF 
+! features used by the io_esmf package.  Once ESMF development is complete, 
+! this module may be removed.  
+
+! NOTE for implementation of ESMF_*GetCurrent():  
+!
+! This implementation uses interfaces that pass Fortran POINTERs around 
+! to avoid forcing use of overloaded assignment operators for shallow 
+! copies.  The goal of this approach is to be as insulated as possible 
+! from ESMF object implementations.  This avoids having to explicitly 
+! copy-in *AND* copy-out through the standard component init(), run(), 
+! and final() interfaces just to attach references to ESMF objects to 
+! other objects.  The explicit CICO *might* be required if we 
+! instead attached shallow copies of the objects to other objects!  
+! "Might" means it is not required now because ESMF objects are 
+! implemented as simple pointers.  However, Nancy Collins says that 
+! the ESMF core team plans to add more state on the Fortran side of the 
+! ESMF objects, so copy-out will eventually be required.  Thus we use 
+! POINTERs to attach references, as in other languages.  Why ESMF 
+! component interfaces aren't passing POINTERs to Fortran objects is 
+! not clear (TBH)...  
+!
+
+MODULE module_esmf_extensions
+
+  USE ESMF_Mod
+
+  IMPLICIT NONE
+
+  PRIVATE
+
+
+  ! private data
+
+  ! Data for ESMF_*GetCurrent()
+  ! These flags are set to .TRUE. iff current objects are valid.  
+  LOGICAL, SAVE                :: current_clock_valid = .FALSE.
+  TYPE(ESMF_Clock), POINTER    :: current_clock
+  LOGICAL, SAVE                :: current_importstate_valid = .FALSE.
+  TYPE(ESMF_State), POINTER    :: current_importstate
+  LOGICAL, SAVE                :: current_exportstate_valid = .FALSE.
+  TYPE(ESMF_State), POINTER    :: current_exportstate
+  LOGICAL, SAVE                :: current_gridcomp_valid = .FALSE.
+  TYPE(ESMF_GridComp), POINTER :: current_gridcomp
+
+  ! Flag for "is-initialized" inquiry
+  ! NOTE:  esmf_is_initialized is not reset to .FALSE. when ESMF_Finalize is called
+  LOGICAL, SAVE                :: esmf_is_initialized = .FALSE.
+
+
+  ! public routines
+  ! These convenience interfaces have been proposed to the ESMF core team.  
+  ! "get current" variants
+  PUBLIC ESMF_ClockGetCurrent
+  PUBLIC ESMF_ImportStateGetCurrent
+  PUBLIC ESMF_ExportStateGetCurrent
+  PUBLIC ESMF_GridCompGetCurrent
+  ! "is-initialized" inquiry
+  PUBLIC WRFU_IsInitialized
+
+  ! extensions to standard ESMF interfaces
+  ! these extensions conform to documented plans for ESMF extensions
+  ! they should be removed as ESMF implementations are released
+  PUBLIC WRFU_TimeGet
+
+  ! public routines to be replaced by ESMF internal implementations
+  ! These interfaces will not be public because ESMF will always be able 
+  ! to call them in the right places without user intervention.  
+  ! "get current" variants
+  PUBLIC ESMF_ClockSetCurrent
+  PUBLIC ESMF_ImportStateSetCurrent
+  PUBLIC ESMF_ExportStateSetCurrent
+  PUBLIC ESMF_GridCompSetCurrent
+  PUBLIC ESMF_SetCurrent
+  ! "is-initialized" inquiry
+  PUBLIC ESMF_SetInitialized
+
+!!!!!!!!! added 20051012, JM
+  ! Need to request that this interface be added...  
+  PUBLIC WRFU_TimeIntervalDIVQuot
+
+  ! duplicated routines from esmf_time_f90
+  ! move these to a common shared location later...  
+  PUBLIC fraction_to_string
+
+  ! hack for bug in PGI 5.1-x
+  PUBLIC ESMF_TimeLE
+  PUBLIC ESMF_TimeGE
+
+  ! convenience function
+  PUBLIC ESMF_TimeIntervalIsPositive
+
+CONTAINS
+
+
+! Add "is initialized" behavior to ESMF interface
+  FUNCTION WRFU_IsInitialized()
+    LOGICAL WRFU_IsInitialized
+    WRFU_IsInitialized = esmf_is_initialized
+  END FUNCTION WRFU_IsInitialized
+
+! Add "is initialized" behavior to ESMF interface
+! This interface will go away as it will be done inside ESMF_Initialize().  
+  SUBROUTINE ESMF_SetInitialized()
+    esmf_is_initialized = .TRUE.
+  END SUBROUTINE ESMF_SetInitialized
+
+
+
+! -------------------------- ESMF-public method -------------------------------
+!BOP
+! !IROUTINE: ESMF_ClockGetCurrent - Get current ESMF_Clock
+! !INTERFACE:
+  SUBROUTINE ESMF_ClockGetCurrent(clock, rc)
+! !ARGUMENTS:
+    TYPE(ESMF_Clock), POINTER      :: clock
+    INTEGER, INTENT(OUT), OPTIONAL :: rc
+!
+! !DESCRIPTION:
+!   Get the {\tt ESMF\_Clock} object of the current execution context.
+!
+!   The arguments are:
+!   \begin{description}
+!   \item[clock]
+!     Upon return this holds the {\tt ESMF\_Clock} object of the current context.
+!   \item[{[rc]}]
+!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!   \end{description}
+!
+!EOP
+! !REQUIREMENTS:  SSSn.n, GGGn.n
+!------------------------------------------------------------------------------
+    ! Assume failure until success
+    IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+    IF ( current_clock_valid ) THEN
+      clock => current_clock
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+    ENDIF
+  END SUBROUTINE ESMF_ClockGetCurrent
+!------------------------------------------------------------------------------
+
+
+
+! -------------------------- ESMF-public method -------------------------------
+!BOP
+! !IROUTINE: ESMF_ImportStateGetCurrent - Get current import ESMF_State
+! !INTERFACE:
+  SUBROUTINE ESMF_ImportStateGetCurrent(importstate, rc)
+! !ARGUMENTS:
+    TYPE(ESMF_State), POINTER      :: importstate
+    INTEGER, INTENT(OUT), OPTIONAL :: rc
+!
+! !DESCRIPTION:
+!   Get the import {\tt ESMF\_State} object of the current execution context.
+!
+!   The arguments are:
+!   \begin{description}
+!   \item[importstate]
+!     Upon return this holds the import {\tt ESMF\_State} object of the current context.
+!   \item[{[rc]}]
+!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!   \end{description}
+!
+!EOP
+! !REQUIREMENTS:  SSSn.n, GGGn.n
+!------------------------------------------------------------------------------
+    ! Assume failure until success
+    IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+    IF ( current_importstate_valid ) THEN
+      importstate => current_importstate
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+    ENDIF
+  END SUBROUTINE ESMF_ImportStateGetCurrent
+!------------------------------------------------------------------------------
+
+
+
+! -------------------------- ESMF-public method -------------------------------
+!BOP
+! !IROUTINE: ESMF_ExportStateGetCurrent - Get current export ESMF_State
+! !INTERFACE:
+  SUBROUTINE ESMF_ExportStateGetCurrent(exportstate, rc)
+! !ARGUMENTS:
+    TYPE(ESMF_State), POINTER      :: exportstate
+    INTEGER, INTENT(OUT), OPTIONAL :: rc
+!
+! !DESCRIPTION:
+!   Get the export {\tt ESMF\_State} object of the current execution context.
+!
+!   The arguments are:
+!   \begin{description}
+!   \item[exportstate]
+!     Upon return this holds the export {\tt ESMF\_State} object of the current context.
+!   \item[{[rc]}]
+!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!   \end{description}
+!
+!EOP
+! !REQUIREMENTS:  SSSn.n, GGGn.n
+!------------------------------------------------------------------------------
+    ! Assume failure until success
+    IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+    IF ( current_exportstate_valid ) THEN
+      exportstate => current_exportstate
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+    ENDIF
+  END SUBROUTINE ESMF_ExportStateGetCurrent
+!------------------------------------------------------------------------------
+
+
+
+! -------------------------- ESMF-public method -------------------------------
+!BOP
+! !IROUTINE: ESMF_GridCompGetCurrent - Get current ESMF_GridComp
+! !INTERFACE:
+  SUBROUTINE ESMF_GridCompGetCurrent(gridcomp, rc)
+! !ARGUMENTS:
+    TYPE(ESMF_GridComp), POINTER   :: gridcomp
+    INTEGER, INTENT(OUT), OPTIONAL :: rc
+!
+! !DESCRIPTION:
+!   Get the {\tt ESMF\_GridComp} object of the current execution context.
+!
+!   The arguments are:
+!   \begin{description}
+!   \item[gridcomp]
+!     Upon return this holds the {\tt ESMF\_GridComp} object of the current context.
+!   \item[{[rc]}]
+!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
+!   \end{description}
+!
+!EOP
+! !REQUIREMENTS:  SSSn.n, GGGn.n
+!------------------------------------------------------------------------------
+    ! Assume failure until success
+    IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
+    IF ( current_gridcomp_valid ) THEN
+      gridcomp => current_gridcomp
+      IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
+    ENDIF
+  END SUBROUTINE ESMF_GridCompGetCurrent
+!------------------------------------------------------------------------------
+
+
+
+
+! Temporary method, to be replaced by ESMF internal implementation
+! Sets the current ESMF_Clock to clock.  
+  SUBROUTINE ESMF_ClockSetCurrent(clock)
+    TYPE(ESMF_Clock), POINTER :: clock
+    current_clock => clock
+    current_clock_valid = .TRUE.
+  END SUBROUTINE ESMF_ClockSetCurrent
+!------------------------------------------------------------------------------
+
+
+! Temporary method, to be replaced by ESMF internal implementation
+! Sets the current import ESMF_State to importstate.  
+  SUBROUTINE ESMF_ImportStateSetCurrent(importstate)
+    TYPE(ESMF_State), POINTER :: importstate
+    current_importstate => importstate
+    current_importstate_valid = .TRUE.
+  END SUBROUTINE ESMF_ImportStateSetCurrent
+!------------------------------------------------------------------------------
+
+
+! Temporary method, to be replaced by ESMF internal implementation
+! Sets the current export ESMF_State to exportstate.  
+  SUBROUTINE ESMF_ExportStateSetCurrent(exportstate)
+    TYPE(ESMF_State), POINTER :: exportstate
+    current_exportstate => exportstate
+    current_exportstate_valid = .TRUE.
+  END SUBROUTINE ESMF_ExportStateSetCurrent
+!------------------------------------------------------------------------------
+
+
+! Temporary method, to be replaced by ESMF internal implementation
+! Sets the current ESMF_GridComp to gridcomp.  
+  SUBROUTINE ESMF_GridCompSetCurrent(gridcomp)
+    TYPE(ESMF_GridComp), POINTER :: gridcomp
+    current_gridcomp => gridcomp
+    current_gridcomp_valid = .TRUE.
+  END SUBROUTINE ESMF_GridCompSetCurrent
+!------------------------------------------------------------------------------
+
+
+! Temporary method, to be replaced by ESMF internal implementation
+! Convenience interface to set everything at once...  
+  ! This routine sets the current ESMF_GridComp, import and export
+  ! ESMF_States, and the current ESMF_Clock.
+  ! NOTE:  It will be possible to remove this routine once ESMF supports
+  !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
+  !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
+  SUBROUTINE ESMF_SetCurrent( gcomp, importState, exportState, clock )
+    TYPE(ESMF_GridComp), OPTIONAL, POINTER :: gcomp
+    TYPE(ESMF_State),    OPTIONAL, POINTER :: importState
+    TYPE(ESMF_State),    OPTIONAL, POINTER :: exportState
+    TYPE(ESMF_Clock),    OPTIONAL, POINTER :: clock
+    IF ( PRESENT( gcomp ) ) THEN
+      CALL ESMF_GridCompSetCurrent( gcomp )
+      CALL ESMF_ImportStateSetCurrent( importState )
+      CALL ESMF_ExportStateSetCurrent( exportState )
+      CALL ESMF_ClockSetCurrent( clock )
+    ENDIF
+  END SUBROUTINE ESMF_SetCurrent
+!------------------------------------------------------------------------------
+
+
+
+! begin hack for bug in PGI 5.1-x
+  function ESMF_TimeLE(time1, time2)
+    logical :: ESMF_TimeLE
+    type(ESMF_Time), intent(in) :: time1
+    type(ESMF_Time), intent(in) :: time2
+    ESMF_TimeLE = (time1.LE.time2)
+  end function ESMF_TimeLE
+  function ESMF_TimeGE(time1, time2)
+    logical :: ESMF_TimeGE
+    type(ESMF_Time), intent(in) :: time1
+    type(ESMF_Time), intent(in) :: time2
+    ESMF_TimeGE = (time1.GE.time2)
+  end function ESMF_TimeGE
+! end hack for bug in PGI 5.1-x
+
+! convenience function
+  function ESMF_TimeIntervalIsPositive(timeinterval)
+    logical :: ESMF_TimeIntervalIsPositive
+    type(ESMF_TimeInterval), intent(in) :: timeinterval
+    type(ESMF_TimeInterval) :: zerotimeint
+    integer :: rcint
+    CALL ESMF_TimeIntervalSet ( zerotimeint, rc=rcint )
+    ESMF_TimeIntervalIsPositive = (timeinterval .GT. zerotimeint)
+  end function ESMF_TimeIntervalIsPositive
+
+
+
+
+! Note:  this implementation is largely duplicated from external/esmf_time_f90
+!!!!!!!!!!!!!!!!!! added jm 20051012
+! new WRF-specific function, Divide two time intervals and return the whole integer, without remainder
+      function WRFU_TimeIntervalDIVQuot(timeinterval1, timeinterval2)
+
+! !RETURN VALUE:
+      INTEGER :: WRFU_TimeIntervalDIVQuot
+
+! !ARGUMENTS:
+      type(ESMF_TimeInterval), intent(in) :: timeinterval1
+      type(ESMF_TimeInterval), intent(in) :: timeinterval2
+
+! !LOCAL
+      INTEGER :: retval, isgn, rc
+      type(ESMF_TimeInterval) :: zero, i1,i2
+
+! !DESCRIPTION:
+!     Returns timeinterval1 divided by timeinterval2 as a fraction quotient.
+!
+!     The arguments are:
+!     \begin{description}
+!     \item[timeinterval1]
+!          The dividend
+!     \item[timeinterval2]
+!          The divisor
+!     \end{description}
+!
+! !REQUIREMENTS:
+!     TMG1.5.5
+!EOP
+      call ESMF_TimeIntervalSet( zero, rc=rc )
+      i1 = timeinterval1
+      i2 = timeinterval2
+      isgn = 1
+      if ( i1 .LT. zero ) then
+        i1 = i1 * (-1)
+        isgn = -isgn
+      endif
+      if ( i2 .LT. zero ) then
+        i2 = i2 * (-1)
+        isgn = -isgn
+      endif
+! repeated subtraction
+      retval = 0
+      DO WHILE (  i1 .GE. i2 )
+        i1 = i1 - i2
+        retval = retval + 1
+      ENDDO
+      retval = retval * isgn
+
+      WRFU_TimeIntervalDIVQuot = retval
+
+      end function WRFU_TimeIntervalDIVQuot
+!!!!!!!!!!!!!!!!!!
+
+
+
+  ! implementations of extensions to standard ESMF interfaces
+  ! these extensions conform to documented plans for ESMF extensions
+  ! they should be removed as ESMF implementations are released
+
+      ! extend ESMF_TimeGet() to make dayOfYear_r8 work...  
+      subroutine WRFU_TimeGet(time, yy, yy_i8, &
+                                    mm, dd, &
+                                    d, d_i8, &
+                                    h, m, &
+                                    s, s_i8, &
+                                    ms, us, ns, &
+                                    d_r8, h_r8, m_r8, s_r8, &
+                                    ms_r8, us_r8, ns_r8, &
+                                    sN, sD, &
+                                    calendar, calendarType, timeZone, &
+                                    timeString, timeStringISOFrac, &
+                                    dayOfWeek, midMonth, &
+                                    dayOfYear,  dayOfYear_r8, &
+                                    dayOfYear_intvl, rc)
+
+      type(ESMF_Time),         intent(in)            :: time
+      integer(ESMF_KIND_I4),   intent(out), optional :: yy
+      integer(ESMF_KIND_I8),   intent(out), optional :: yy_i8
+      integer,                 intent(out), optional :: mm
+      integer,                 intent(out), optional :: dd
+      integer(ESMF_KIND_I4),   intent(out), optional :: d
+      integer(ESMF_KIND_I8),   intent(out), optional :: d_i8
+      integer(ESMF_KIND_I4),   intent(out), optional :: h
+      integer(ESMF_KIND_I4),   intent(out), optional :: m
+      integer(ESMF_KIND_I4),   intent(out), optional :: s
+      integer(ESMF_KIND_I8),   intent(out), optional :: s_i8
+      integer(ESMF_KIND_I4),   intent(out), optional :: ms
+      integer(ESMF_KIND_I4),   intent(out), optional :: us
+      integer(ESMF_KIND_I4),   intent(out), optional :: ns
+      real(ESMF_KIND_R8),      intent(out), optional :: d_r8  ! not implemented
+      real(ESMF_KIND_R8),      intent(out), optional :: h_r8  ! not implemented
+      real(ESMF_KIND_R8),      intent(out), optional :: m_r8  ! not implemented
+      real(ESMF_KIND_R8),      intent(out), optional :: s_r8  ! not implemented
+      real(ESMF_KIND_R8),      intent(out), optional :: ms_r8 ! not implemented
+      real(ESMF_KIND_R8),      intent(out), optional :: us_r8 ! not implemented
+      real(ESMF_KIND_R8),      intent(out), optional :: ns_r8 ! not implemented
+      integer(ESMF_KIND_I4),   intent(out), optional :: sN
+      integer(ESMF_KIND_I4),   intent(out), optional :: sD
+      type(ESMF_Calendar),     intent(out), optional :: calendar
+      type(ESMF_CalendarType), intent(out), optional :: calendarType
+      integer,                 intent(out), optional :: timeZone
+      character (len=*),       intent(out), optional :: timeString
+      character (len=*),       intent(out), optional :: timeStringISOFrac
+      integer,                 intent(out), optional :: dayOfWeek
+      type(ESMF_Time),         intent(out), optional :: midMonth
+      integer(ESMF_KIND_I4),   intent(out), optional :: dayOfYear
+      real(ESMF_KIND_R8),      intent(out), optional :: dayOfYear_r8 ! NOW implemented
+      type(ESMF_TimeInterval), intent(out), optional :: dayOfYear_intvl
+      integer,                 intent(out), optional :: rc
+      REAL(ESMF_KIND_R8) :: rsec
+      INTEGER(ESMF_KIND_I4) :: year, seconds, Sn, Sd
+      INTEGER(ESMF_KIND_I8), PARAMETER :: SECONDS_PER_DAY = 86400_ESMF_KIND_I8
+
+      call ESMF_TimeGet(time, yy, yy_i8, &
+                              mm, dd, &
+                              d, d_i8, &
+                              h, m, &
+                              s, s_i8, &
+                              ms, us, ns, &
+                              d_r8, h_r8, m_r8, s_r8, &
+                              ms_r8, us_r8, ns_r8, &
+                              sN, sD, &
+                              calendar, calendarType, timeZone, &
+                              timeString, timeStringISOFrac, &
+                              dayOfWeek, midMonth, &
+                              dayOfYear,  dayOfYear_r8, &
+                              dayOfYear_intvl, rc)
+      IF ( rc == ESMF_SUCCESS ) THEN
+        IF ( PRESENT( dayOfYear_r8 ) ) THEN
+          ! get seconds since start of year and fractional seconds
+          CALL ESMF_TimeGet( time, yy=year, s=seconds, sN=Sn, sD=Sd, rc=rc )
+          IF ( rc == ESMF_SUCCESS ) THEN
+            ! 64-bit IEEE 754 has 52-bit mantisssa -- only need 25 bits to hold
+            ! number of seconds in a year...
+            rsec = REAL( seconds, ESMF_KIND_R8 )
+            IF ( Sd /= 0 ) THEN
+              rsec = rsec + ( REAL( Sn, ESMF_KIND_R8 ) / REAL( Sd, ESMF_KIND_R8 ) )
+            ENDIF
+            dayOfYear_r8 = rsec / REAL( SECONDS_PER_DAY, ESMF_KIND_R8 )
+            ! start at 1
+            dayOfYear_r8 = dayOfYear_r8 + 1.0_ESMF_KIND_R8
+          ENDIF
+        ENDIF
+      ENDIF
+
+      end subroutine WRFU_TimeGet
+
+!------------------------------------------------------------------------------
+
+
+! duplicated routines from esmf_time_f90
+! move these to a common shared location later...  
+
+! Convert fraction to string with leading sign.
+! If fraction simplifies to a whole number or if
+! denominator is zero, return empty string.
+! INTEGER*8 interface.  
+SUBROUTINE fraction_to_stringi8( numerator, denominator, frac_str )
+  INTEGER(ESMF_KIND_I8), INTENT(IN) :: numerator
+  INTEGER(ESMF_KIND_I8), INTENT(IN) :: denominator
+  CHARACTER (LEN=*), INTENT(OUT) :: frac_str
+  IF ( denominator > 0 ) THEN
+    IF ( mod( numerator, denominator ) /= 0 ) THEN
+      IF ( numerator > 0 ) THEN
+        WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(numerator), denominator
+      ELSE   ! numerator < 0
+        WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(numerator), denominator
+      ENDIF
+    ELSE   ! includes numerator == 0 case
+      frac_str = ''
+    ENDIF
+  ELSE   ! no-fraction case
+    frac_str = ''
+  ENDIF
+END SUBROUTINE fraction_to_stringi8
+
+
+! Convert fraction to string with leading sign.
+! If fraction simplifies to a whole number or if
+! denominator is zero, return empty string.
+! INTEGER interface.  
+SUBROUTINE fraction_to_string( numerator, denominator, frac_str )
+  INTEGER, INTENT(IN) :: numerator
+  INTEGER, INTENT(IN) :: denominator
+  CHARACTER (LEN=*), INTENT(OUT) :: frac_str
+  ! locals
+  INTEGER(ESMF_KIND_I8) :: numerator_i8, denominator_i8
+  numerator_i8 = INT( numerator, ESMF_KIND_I8 )
+  denominator_i8 = INT( denominator, ESMF_KIND_I8 )
+  CALL fraction_to_stringi8( numerator_i8, denominator_i8, frac_str )
+END SUBROUTINE fraction_to_string
+
+! end of duplicated routines from esmf_time_f90
+
+
+END MODULE module_esmf_extensions
+
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/module_symbols_util.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/module_symbols_util.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/module_symbols_util.F90	(revision 2744)
@@ -0,0 +1,132 @@
+! 
+! NOTE:  This file will be removed once encapsulation of bare ESMF 
+!        calls is complete within WRF non-external source code.  
+!
+      MODULE module_symbols_util
+
+        USE ESMF_Mod, WRFU_ALARM => ESMF_ALARM
+        USE ESMF_Mod, WRFU_ALARMCREATE => ESMF_ALARMCREATE
+        USE ESMF_Mod, WRFU_ALARMDESTROY => ESMF_ALARMDESTROY
+        USE ESMF_Mod, WRFU_ALARMDISABLE => ESMF_ALARMDISABLE
+        USE ESMF_Mod, WRFU_ALARMENABLE => ESMF_ALARMENABLE
+        USE ESMF_Mod, WRFU_ALARMGET => ESMF_ALARMGET
+        USE ESMF_Mod, WRFU_ALARMISENABLED => ESMF_ALARMISENABLED
+        USE ESMF_Mod, WRFU_ALARMISRINGING => ESMF_ALARMISRINGING
+        USE ESMF_Mod, WRFU_ALARMISSTICKY => ESMF_ALARMISSTICKY
+        USE ESMF_Mod, WRFU_ALARMLISTTYPE => ESMF_ALARMLISTTYPE
+        USE ESMF_Mod, WRFU_ALARMLIST_ALL => ESMF_ALARMLIST_ALL
+        USE ESMF_Mod, WRFU_ALARMLIST_NEXTRINGING => ESMF_ALARMLIST_NEXTRINGING
+        USE ESMF_Mod, WRFU_ALARMLIST_PREVRINGING => ESMF_ALARMLIST_PREVRINGING
+        USE ESMF_Mod, WRFU_ALARMLIST_RINGING => ESMF_ALARMLIST_RINGING
+        USE ESMF_Mod, WRFU_ALARMNOTSTICKY => ESMF_ALARMNOTSTICKY
+        USE ESMF_Mod, WRFU_ALARMPRINT => ESMF_ALARMPRINT
+        USE ESMF_Mod, WRFU_ALARMREADRESTART => ESMF_ALARMREADRESTART
+        USE ESMF_Mod, WRFU_ALARMRINGEROFF => ESMF_ALARMRINGEROFF
+        USE ESMF_Mod, WRFU_ALARMRINGERON => ESMF_ALARMRINGERON
+        USE ESMF_Mod, WRFU_ALARMSET => ESMF_ALARMSET
+        USE ESMF_Mod, WRFU_ALARMSTICKY => ESMF_ALARMSTICKY
+        USE ESMF_Mod, WRFU_ALARMVALIDATE => ESMF_ALARMVALIDATE
+        USE ESMF_Mod, WRFU_ALARMWASPREVRINGING => ESMF_ALARMWASPREVRINGING
+        USE ESMF_Mod, WRFU_ALARMWILLRINGNEXT => ESMF_ALARMWILLRINGNEXT
+        USE ESMF_Mod, WRFU_ALARMWRITERESTART => ESMF_ALARMWRITERESTART
+
+        USE ESMF_Mod, WRFU_CALENDAR => ESMF_CALENDAR
+        USE ESMF_Mod, WRFU_CALENDARCREATE => ESMF_CALENDARCREATE
+        USE ESMF_Mod, WRFU_CALENDARDESTROY => ESMF_CALENDARDESTROY
+        USE ESMF_Mod, WRFU_CALENDARFINALIZE => ESMF_CALENDARFINALIZE
+        USE ESMF_Mod, WRFU_CALENDARGET => ESMF_CALENDARGET
+        USE ESMF_Mod, WRFU_CALENDARINITIALIZE => ESMF_CALENDARINITIALIZE
+        USE ESMF_Mod, WRFU_CALENDARISLEAPYEAR => ESMF_CALENDARISLEAPYEAR
+        USE ESMF_Mod, WRFU_CALENDARPRINT => ESMF_CALENDARPRINT
+        USE ESMF_Mod, WRFU_CALENDARREADRESTART => ESMF_CALENDARREADRESTART
+        USE ESMF_Mod, WRFU_CALENDARSET => ESMF_CALENDARSET
+        USE ESMF_Mod, WRFU_CALENDARSETDEFAULT => ESMF_CALENDARSETDEFAULT
+        USE ESMF_Mod, WRFU_CALENDARTYPE => ESMF_CALENDARTYPE
+        USE ESMF_Mod, WRFU_CALENDARVALIDATE => ESMF_CALENDARVALIDATE
+        USE ESMF_Mod, WRFU_CALENDARWRITERESTART => ESMF_CALENDARWRITERESTART
+        USE ESMF_Mod, WRFU_CAL_360DAY => ESMF_CAL_360DAY
+        USE ESMF_Mod, WRFU_CAL_CUSTOM => ESMF_CAL_CUSTOM
+        USE ESMF_Mod, WRFU_CAL_GREGORIAN => ESMF_CAL_GREGORIAN
+        USE ESMF_Mod, WRFU_CAL_JULIAN => ESMF_CAL_JULIAN
+        USE ESMF_Mod, WRFU_CAL_JULIANDAY => ESMF_CAL_JULIANDAY
+        USE ESMF_Mod, WRFU_CAL_NOCALENDAR => ESMF_CAL_NOCALENDAR
+        USE ESMF_Mod, WRFU_CAL_NOLEAP => ESMF_CAL_NOLEAP
+        USE ESMF_Mod, WRFU_CLOCK => ESMF_CLOCK
+        USE ESMF_Mod, WRFU_CLOCKADVANCE => ESMF_CLOCKADVANCE
+        USE ESMF_Mod, WRFU_CLOCKCREATE => ESMF_CLOCKCREATE
+        USE ESMF_Mod, WRFU_CLOCKDESTROY => ESMF_CLOCKDESTROY
+        USE ESMF_Mod, WRFU_CLOCKGET => ESMF_CLOCKGET
+        USE ESMF_Mod, WRFU_CLOCKGETALARM => ESMF_CLOCKGETALARM
+        USE ESMF_Mod, WRFU_CLOCKGETALARMLIST => ESMF_CLOCKGETALARMLIST
+        USE ESMF_Mod, WRFU_CLOCKGETNEXTTIME => ESMF_CLOCKGETNEXTTIME
+        USE ESMF_Mod, WRFU_CLOCKISDONE => ESMF_CLOCKISDONE
+        USE ESMF_Mod, WRFU_CLOCKISREVERSE => ESMF_CLOCKISREVERSE
+        USE ESMF_Mod, WRFU_CLOCKISSTOPTIME => ESMF_CLOCKISSTOPTIME
+        USE ESMF_Mod, WRFU_CLOCKISSTOPTIMEENABLED => ESMF_CLOCKISSTOPTIMEENABLED
+        USE ESMF_Mod, WRFU_CLOCKPRINT => ESMF_CLOCKPRINT
+        USE ESMF_Mod, WRFU_CLOCKREADRESTART => ESMF_CLOCKREADRESTART
+        USE ESMF_Mod, WRFU_CLOCKSET => ESMF_CLOCKSET
+        USE ESMF_Mod, WRFU_CLOCKSTOPTIMEDISABLE => ESMF_CLOCKSTOPTIMEDISABLE
+        USE ESMF_Mod, WRFU_CLOCKSTOPTIMEENABLE => ESMF_CLOCKSTOPTIMEENABLE
+        USE ESMF_Mod, WRFU_CLOCKSYNCTOREALTIME => ESMF_CLOCKSYNCTOREALTIME
+        USE ESMF_Mod, WRFU_CLOCKVALIDATE => ESMF_CLOCKVALIDATE
+        USE ESMF_Mod, WRFU_CLOCKWRITERESTART => ESMF_CLOCKWRITERESTART
+        USE ESMF_Mod, WRFU_FINALIZE => ESMF_FINALIZE
+        USE ESMF_Mod, WRFU_INITIALIZE => ESMF_INITIALIZE
+        USE ESMF_Mod, WRFU_KIND_C16 => ESMF_KIND_C16
+        USE ESMF_Mod, WRFU_KIND_C8 => ESMF_KIND_C8
+        USE ESMF_Mod, WRFU_KIND_I1 => ESMF_KIND_I1
+        USE ESMF_Mod, WRFU_KIND_I2 => ESMF_KIND_I2
+        USE ESMF_Mod, WRFU_KIND_I4 => ESMF_KIND_I4
+        USE ESMF_Mod, WRFU_KIND_I8 => ESMF_KIND_I8
+        USE ESMF_Mod, WRFU_KIND_R4 => ESMF_KIND_R4
+        USE ESMF_Mod, WRFU_KIND_R8 => ESMF_KIND_R8
+        USE ESMF_Mod, WRFU_LOG => ESMF_LOG
+        USE ESMF_Mod, WRFU_LOGCLOSE => ESMF_LOGCLOSE
+        USE ESMF_Mod, WRFU_LOGFINALIZE => ESMF_LOGFINALIZE
+        USE ESMF_Mod, WRFU_LOGFLUSH => ESMF_LOGFLUSH
+        USE ESMF_Mod, WRFU_LOGFOUNDALLOCERROR => ESMF_LOGFOUNDALLOCERROR
+        USE ESMF_Mod, WRFU_LOGFOUNDERROR => ESMF_LOGFOUNDERROR
+        USE ESMF_Mod, WRFU_LOGGET => ESMF_LOGGET
+        USE ESMF_Mod, WRFU_LOGINITIALIZE => ESMF_LOGINITIALIZE
+        USE ESMF_Mod, WRFU_LOGMSGFOUNDALLOCERROR => ESMF_LOGMSGFOUNDALLOCERROR
+        USE ESMF_Mod, WRFU_LOGMSGFOUNDERROR => ESMF_LOGMSGFOUNDERROR
+        USE ESMF_Mod, WRFU_LOGMSGSETERROR => ESMF_LOGMSGSETERROR
+        USE ESMF_Mod, WRFU_LOGOPEN => ESMF_LOGOPEN
+        USE ESMF_Mod, WRFU_LOGSET => ESMF_LOGSET
+        USE ESMF_Mod, WRFU_LOGWRITE => ESMF_LOGWRITE
+        USE ESMF_Mod, WRFU_LOG_ERROR => ESMF_LOG_ERROR
+        USE ESMF_Mod, WRFU_LOG_HALTERROR => ESMF_LOG_HALTERROR
+        USE ESMF_Mod, WRFU_LOG_HALTNEVER => ESMF_LOG_HALTNEVER
+        USE ESMF_Mod, WRFU_LOG_HALTWARNING => ESMF_LOG_HALTWARNING
+        USE ESMF_Mod, WRFU_LOG_INFO => ESMF_LOG_INFO
+        USE ESMF_Mod, WRFU_LOG_MULTI => ESMF_LOG_MULTI
+        USE ESMF_Mod, WRFU_LOG_SINGLE => ESMF_LOG_SINGLE
+        USE ESMF_Mod, WRFU_LOG_WARNING => ESMF_LOG_WARNING
+        USE ESMF_Mod, WRFU_MAXSTR => ESMF_MAXSTR
+        USE ESMF_Mod, WRFU_R4 => ESMF_R4
+        USE ESMF_Mod, WRFU_R8 => ESMF_R8
+        USE ESMF_Mod, WRFU_SUCCESS => ESMF_SUCCESS
+        USE ESMF_Mod, WRFU_TIME => ESMF_TIME
+! See module_esmf_extensions for extensions to this interface.  Uncomment 
+! the line below once ESMF supports the extensions.  
+!        USE ESMF_Mod, WRFU_TIMEGET => ESMF_TIMEGET
+        USE ESMF_Mod, WRFU_TIMEINTERVAL => ESMF_TIMEINTERVAL
+        USE ESMF_Mod, WRFU_TIMEINTERVALABSVALUE => ESMF_TIMEINTERVALABSVALUE
+        USE ESMF_Mod, WRFU_TIMEINTERVALGET => ESMF_TIMEINTERVALGET
+        USE ESMF_Mod, WRFU_TIMEINTERVALNEGABSVALUE => ESMF_TIMEINTERVALNEGABSVALUE
+        USE ESMF_Mod, WRFU_TIMEINTERVALPRINT => ESMF_TIMEINTERVALPRINT
+        USE ESMF_Mod, WRFU_TIMEINTERVALREADRESTART => ESMF_TIMEINTERVALREADRESTART
+        USE ESMF_Mod, WRFU_TIMEINTERVALSET => ESMF_TIMEINTERVALSET
+        USE ESMF_Mod, WRFU_TIMEINTERVALVALIDATE => ESMF_TIMEINTERVALVALIDATE
+        USE ESMF_Mod, WRFU_TIMEINTERVALWRITERESTART => ESMF_TIMEINTERVALWRITERESTART
+        USE ESMF_Mod, WRFU_TIMEISLEAPYEAR => ESMF_TIMEISLEAPYEAR
+        USE ESMF_Mod, WRFU_TIMEISSAMECALENDAR => ESMF_TIMEISSAMECALENDAR
+        USE ESMF_Mod, WRFU_TIMEPRINT => ESMF_TIMEPRINT
+        USE ESMF_Mod, WRFU_TIMEREADRESTART => ESMF_TIMEREADRESTART
+        USE ESMF_Mod, WRFU_TIMESET => ESMF_TIMESET
+        USE ESMF_Mod, WRFU_TIMESYNCTOREALTIME => ESMF_TIMESYNCTOREALTIME
+        USE ESMF_Mod, WRFU_TIMEVALIDATE => ESMF_TIMEVALIDATE
+        USE ESMF_Mod, WRFU_TIMEWRITERESTART => ESMF_TIMEWRITERESTART
+
+      END MODULE module_symbols_util
Index: trunk/WRF.COMMON/WRFV2/external/io_esmf/module_utility.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_esmf/module_utility.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_esmf/module_utility.F90	(revision 2744)
@@ -0,0 +1,9 @@
+
+      MODULE module_utility
+
+        USE module_symbols_util
+        ! Not-yet-implemented ESMF features
+        USE module_esmf_extensions
+
+      END MODULE module_utility
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/FTP_getfile.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/FTP_getfile.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/FTP_getfile.c	(revision 2744)
@@ -0,0 +1,177 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "dprints.h"		/* Debug printing & function prototypes*/
+#include "gribfuncs.h"		/* function prototypes */
+/*
+*
+********************************************************************
+* A. FUNCTION:  FTP_getfile
+*       builds and executes a Bourne script file to retreive
+*       the file specified from remote site via Ftp call;
+*       Execute script to establish ftp session (under Userid 'anonymous' 
+*       & passwd 'gribsimp22'):
+*       Host info is retrieved from file "$pathnm/tables.cfg" whose content
+*       is a one line entry= "eifel.nrlmry.navy.mil receive/GRIB_TABLES"
+*
+*    INTERFACE:
+*       int     FTP_getfile (filenm, loc_pathnm, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*       (I)  char *filenm;       Name of file to ftp
+*       (I)  char *loc_pathnm;   Full path leading to config file 'tables.cfg'
+*       (O)  char *errmsg;       Empty array, Returns filled if error occurs;
+*
+*    RETURN CODE:
+*        0> sucessfully ftp-ed;
+*        1> error:  create script/ftp err/missing table.cfg;
+********************************************************************
+*/
+
+#if PROTOTYPE_NEEDED
+int 	FTP_getfile (char *filenm, char *loc_pathnm, char *errmsg)
+
+#else
+int	FTP_getfile (filenm, loc_pathnm, errmsg)
+	char *filenm; 
+	char *loc_pathnm; 
+	char *errmsg;
+#endif
+{
+FILE    *f1=NULL, *f2=NULL;
+char    *func="FTP_getfile";
+char    filename[200];
+char    hostnm[100];    /* name of remote site  */
+char    usernm[100];    /* using anonymous  */
+char    passwd[100];    /* anonymous  */
+char    pathnm[100];    /* full path of remote file to get  */
+int     stat;		/* return status */
+int     n;              /* working var */
+
+  DPRINT3 ("Entering %s (%s/%s)\n", func, loc_pathnm, filenm);
+/*
+*
+* A.1       SET up name of local config file     !$local_path/tables.cfg
+*           IF (unable to open config file)
+*               RETURN 1  !errmsg filled
+*           ENDIF
+*/
+
+   /*   USE SAME CONFIG FILE -- 
+	no matter if dnloading "g1tab* , or neon2gr*, or orig_ctr"
+   */
+  sprintf (filename, "%s/tables.cfg", loc_pathnm);
+  DPRINT1 ("Read Remote host info from '%s'\n", filename);
+  if ((f1=fopen (filename, "r"))==NULL) {
+        sprintf(errmsg,"%s: failed to open '%s' for reading;\n",func,filename);
+        stat=(1); goto BYE;
+        }
+/*
+*
+* A.2       READ hostname and remote pathname from file, then close it;
+*           !config entry->    "eifel.nrlmry.navy.mil receive/GRIB_TABLES"
+*
+* A.3       CLOSE config file;
+*/
+   n = fscanf (f1, "%s%s", hostnm, pathnm);
+   fclose(f1);     /* close Config File */
+/*
+*
+* A.4       IF (read failed) RETURN 1  !errmsg filled;
+*/
+  if (n  != 2) {
+        sprintf(errmsg,"%s: Fail to read 2 args from '%s'\n", func, filename);
+        stat=(1); goto BYE;
+        }
+
+/*
+*
+* A.6       SET password to "gribsimp22", userid to "anonymous"
+*/
+  strcpy (passwd, "gribsimp22");
+
+ /* Ready to build Bourne script: */
+/*
+*
+* A.7       IF (create temp script file fails)
+*               RETURN 1   !errmsg filled
+*           ENDIF
+*/
+  if ((f1=fopen ("temp_ftp_script","w"))==NULL) {
+        sprintf(errmsg,"%s:  failed to build FTP script\n", func);
+        stat=(1); goto BYE;
+        }
+/*
+*
+* A.8       CREATE ftp script to download Host's "receive/GRIB_TABLES/$fn"
+*           to $localPath/$fn locally; 
+*
+* A.9       CLOSE temp file
+*/
+        fprintf (f1,
+		"#!/bin/sh\nexec 1>&-;exec 2>&-\nftp -in %s << STOP\n" \
+		"user anonymous %s\ncd %s\nlcd %s\nget %s\nquit\n" \
+		"STOP\nexit\n", 
+		hostnm,  passwd, pathnm, loc_pathnm, filenm);
+        fclose(f1);
+
+        DPRINT5 ("execute ftp script: \n"
+		"   #!/bin/sh\n   exec 1>&-;exec 2>&-\n"
+		"   ftp -in %s << STOP\n   user anonymous %s\n"
+		"   cd %s\n   lcd %s\n   get %s\n   quit\n   STOP\n   exit\n",
+		hostnm,  passwd, pathnm, loc_pathnm, filenm);
+/*
+*
+* A.10      EXECUTE script to download lookup file
+*
+* A.11      REMOVE temp script
+*/
+  fprintf(stdout,"Attempting to get remote '%s'\n", filenm);
+  n= system ("chmod 755 temp_ftp_script;temp_ftp_script");
+  unlink ("temp_ftp_script");
+
+/*
+*
+* A.12      IF (execute script failed)
+*               RETURN 1   !errmsg filled
+*           ENDIF
+*/
+  if (n!=0) {   /* ck Stat of Systm call */
+        sprintf(errmsg,"%s:  system call to ftp failed\n", func);
+        stat=(1); goto BYE;
+        }
+
+/*
+*
+* A.13      CHECK if ftp-ed file is available & readable
+*           IF (failed)
+*               RETURN 1   !errmsg filled
+*           ENDIF
+*/
+  sprintf (filename, "%s/%s", loc_pathnm, filenm);
+  if ((f2= fopen(filename, "rb+"))==NULL) {
+        sprintf(errmsg,"%s: '%s' not avail on %s in %s\n\n", func,
+        filenm, hostnm, pathnm);
+        stat=(1); goto BYE;
+        }
+
+  DPRINT0("file downloaded successfully\n");
+  stat= 0;
+
+BYE:
+/*
+*
+* A.14      CLOSE up ftp-ed file
+*/
+  if (f2) fclose(f2);
+
+/*
+* A.15      RETURN 0 !success
+*/
+DPRINT2 ("Leaving %s, Stat=%d\n", func, stat);
+return(stat);
+/*
+* END OF FUNCTION
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/Makefile	(revision 2744)
@@ -0,0 +1,103 @@
+#------------------------------------------------------------------------------
+#  Makefile for producing libdbclient.so 
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+
+.SUFFIXES:      .c .o
+
+#
+# Specity location for Makefiles that are included.
+#
+INCLUDEDIRS = -I. -I.. -I../grib1_util
+BUILD_DIR = ../../io_grib_share/build
+#
+# Specify directory that output library is to be put in.
+#
+LIB_DEST = ..
+#
+#  SPECIFY local include directories used during compilation of source code. 
+#
+#    CXX_INCLUDES is for C++ files
+#    C_INCLUDES is for C files
+#
+C_INCLUDES   = -I.
+CXX_INCLUDES = -I.
+ARFLAGS      = ruv
+
+#
+#  SPECIFY any subdirectories containing libraries that may be dynamically
+#          linked by this library.
+#
+SUB_DIRS =
+
+#
+#  SPECIFY information for building a library:
+#
+#    LIB_NAME - Fragment of name of the library to build
+#               e.g. if library file name is libfoo.so, set LIB_NAME = foo 
+#    DEP_LIBS - The tokens required to link a shared library against other
+#               shared libraries upon which it depends.  DEP_LIBS should
+#               contain -L<dir> tokens to specify where the dependent 
+#               libraries are, and -l<lib> tokens to specify libraries to link.
+#    OBJS     - List of object files that go into the library.
+#
+#  NOTES:
+#  1. Be careful about whitespace after the last character in the LIB_NAME.
+#     These spaces will generate an error when the library is made.
+#
+LIB_NAME = io_grib1
+DEP_LIBS = 
+OBJS =  FTP_getfile.o \
+	apply_bitmap.o \
+	display_gribhdr.o \
+	gbyte.o \
+	grib_dec.o \
+	grib_enc.o \
+	grib_seek.o \
+	gribgetbds.o \
+	gribgetbms.o \
+	gribgetgds.o \
+	gribgetpds.o \
+	gribhdr2file.o \
+	gribputbds.o \
+	gribputgds.o \
+	gribputpds.o \
+	hdr_print.o \
+	init_dec_struct.o \
+	init_enc_struct.o \
+	init_gribhdr.o \
+	init_struct.o \
+	ld_dec_lookup.o \
+	ld_enc_input.o \
+	ld_enc_lookup.o \
+	ld_grib_origctrs.o \
+	make_default_grbfn.o \
+	make_grib_log.o \
+	map_lvl.o \
+	map_parm.o \
+	pack_spatial.o \
+	prt_inp_struct.o \
+	upd_child_errmsg.o \
+	prt_badmsg.o \
+	swap.o\
+	grib_uthin.o\
+	set_bytes.o
+
+# 
+# List the header files that should be installed.
+#
+HDRS =	gribfuncs.h \
+	grib.h \
+	input.h
+
+#
+#  Include the boilerplate rules for building library modules.
+#
+include $(BUILD_DIR)/library_rules.mk
+
+#
+#  Compile dependencies.  These are appended to this file by make depend. 
+#
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/README
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/README	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/README	(revision 2744)
@@ -0,0 +1,14 @@
+10/6/99
+Todd A. Hutchinson
+TASC (WSI Contractor)
+
+The code in this directory builds a library which is used to read and write 
+grib data.  The code is a modified subset of the Navy's Master Environmental 
+Laboratory's grib library.  The MEL grib library was ported to linux, then
+taken apart to fit into the standard directory structure and Makefile structure
+that we use as part of WxPredictor.
+
+For more information on the MEL Grib Library, go to 
+http://mel.dmso.mil/mel_tools/user_software.html.
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/apply_bitmap.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/apply_bitmap.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/apply_bitmap.c	(revision 2744)
@@ -0,0 +1,234 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "dprints.h"		/* debug prints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+*
+*********************************************************************
+* A. FUNCTION:  apply_bitmap
+*       apply the bitmap to the float array.  The input float array is
+*       expanded and filled with 'fill_value' in places where data
+*       points are missing.
+*
+*    INTERFACE:
+*      int  apply_bitmap (bms, pgrib_data, fill_value, bds_head, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  BMS_INPUT *bms;
+*           pointer to the internal BitMap header structure;  bit set means
+*           datapoint is present, bit clear means datapoint is missing.
+*     (I&O) float **pgrib_data;  
+*           pointer to Data that was unpacked from BDS's bitstr;  Incoming
+*           size is bms->ulbits_set or (ROW*COL - #missingpts) elements;
+*      (I)  float fill_value;    
+*           float value used for missing datapoints in expanded array;
+*      (O)  BDS_HEAD_INPUT *bds_head; 
+*           attribute 'ulGrid_size' to be updated;
+*      (O)  char *errmsg;
+*           Empty array that's returned filled if error occurred; 
+*
+*    RETURN CODE:
+*      0>  Success; float **pgrib_data probably have been expanded, OR
+*          Predefined bitmap used, no action taken (float array unchanged);
+*      1>  NULL bitmap encountered, errmsg filled;
+*      2>  Error Mallocing space for data array, errmsg filled;
+*      3>  Tried to access more than available in message, errmsg filled;
+*      4>  No bits set in BMS, errmsg filled;
+**********************************************************************
+*/ 
+#if PROTOTYPE_NEEDED
+
+int apply_bitmap ( BMS_INPUT *bms, float **pgrib_data, float fill_value,
+		BDS_HEAD_INPUT *bds_head, char *errmsg)
+#else
+
+int apply_bitmap ( bms, pgrib_data, fill_value, bds_head, errmsg)
+		BMS_INPUT *bms; 
+		float **pgrib_data; 
+		float fill_value;
+		BDS_HEAD_INPUT *bds_head; 
+		char *errmsg;
+
+#endif
+{
+  char  *func= "apply_bitmap";
+  int   i,j;			/* temp var */
+  int   val;			/* temp var */
+  int	buf_indx;		/* index for expanded float *buff array */
+  int   gribdata_indx;		/* index for float *Grid_data array */
+  int	tot_bits_set;		/* must be < expanded size */
+  char  *pbms; 			/* BIT ptr beg. at BMS data array */
+  float	*fbuff;		 	/* holds expanded float array */
+  int	 gridsize;		/* expanded size r*c */
+
+/*
+* 
+* A.0     DEBUG printing
+*/
+  DPRINT1 ("Enter %s()\n", func);
+
+/*
+*
+* A.1     IF (using pre-defined bitmap)
+*            FILL errmsg ! 'case not supported' 
+*            RETURN 0  !success
+*         ENDIF
+*/
+  if (bms->uslength == 6) /* References pre-defined bitmap */
+    {
+      /* Not currently supported.  User can add code inside this IF
+       * to retreive the bitmap from local storage if available.
+       * For now, code prints warning and leaves data array alone */
+      fprintf(stdout,
+		"\n%s Warning: Predefined bitmap encountered! Not supported; " \
+      		"Must apply bitmap to data externally.\n", func);
+      DPRINT1("Leaving %s: Predefined bitmap used, no action taken\n",func);
+      return(0);
+    }
+           
+/*
+*
+* A.2     IF (Bitmap pointer is NULL)
+*            FILL errmsg  !null pointer
+*            RETURN 1   
+*         ENDIF
+*/
+  if (bms->bit_map==NULL) {
+	DPRINT1 ("Leaving %s:  bitmap is Null, no action taken\n", func);
+	return(1); 
+	}
+
+/*
+*
+* A.3     IF (count of bits set in BMS is Zero)
+*            FILL errmsg
+*            RETURN 4   !no bits set
+*         ENDIF
+*/
+   if ((tot_bits_set=bms->ulbits_set) == 0) {
+       sprintf(errmsg,"%s: No bits set in bitmap.  No data retrieved!!\n",func); 
+       DPRINT1("Leaving %s: No bits set in bitmap\n",func); 
+       return(4);
+   }
+
+/*
+*
+* A.4     CALCULATE grid_size from total number of bits in BMS;
+*/
+  /* = (BMS length)*8 bits - 48 header bits - # of unsused bits */
+  gridsize=(bms->uslength)*8 - 48 - bms->usUnused_bits;
+
+  DPRINT2 ("Apply Bitmap: expanding array from [%d] to [%d]; ",
+  tot_bits_set, gridsize);
+
+/* 
+*
+* A.5     ALLOCATE storage for expanded array 
+*         IF (Malloc error) 
+*            RETURN 2 
+*         ENDIF
+*/
+  fbuff= (float *)malloc (gridsize * sizeof(float));
+  if (fbuff==(float *)NULL)
+	{ 
+          sprintf(errmsg, "%s: Error mallocing %ld bytes\n", func,gridsize);
+          DPRINT1 ("Leaving %s, malloc error\n",func);
+          return(2); 
+	}
+
+/*
+*
+* A.6     FOR (each point expected)
+*/
+  pbms= bms->bit_map;	/* pts to char arry bstr of BMS */
+  gribdata_indx=0;	/* index for incoming float arr */
+  for (buf_indx=0; buf_indx < gridsize; ++pbms) {
+
+/*
+* A.6.1      GET next byte from Bitmap Section Data 
+*/
+	val= (int)*pbms & 0x0000ff ;	/* BMS bitstream */
+
+/*
+* A.6.2      LOOP, check each Bit of byte read (left to rightmost)
+*/
+	for (j=7; j>=0 && buf_indx < gridsize; j--) {
+/*
+* A.6.2.1       IF (bit is set)  !means datapoint is present
+*/
+	    if (val & (1<<j))
+		{  
+/*
+* A.6.2.1.1         IF (trying to access more than #elements in Incoming Array)
+*                      FILL errmsg
+*                      RETURN 3    ! incoming float array unchanged
+*                   ENDIF
+*/
+		   if (gribdata_indx == tot_bits_set) {
+		     sprintf(errmsg,
+                    "%s:  accessing more than %d elements in Grib_data[]\n",
+			func,	tot_bits_set);
+		     DPRINT1("Leaving %s, access out of range element\n",func);
+		     return(3);  /* incoming Float array is unchanged */
+		     }
+
+/*
+* A.6.2.1.2         !still within range
+*                   STORE datapoint at correct place in expanded array
+*/
+		   fbuff[buf_indx++]= (*pgrib_data)[gribdata_indx++];
+		}
+/*
+*                ELSE  ! means data point is missing
+*/
+	    else {
+/*
+* A.6.2.2           STORE Missing Value at correct place in expanded array
+*/
+		   fbuff[buf_indx++]= fill_value;
+		}
+/*
+* A.6.2.1        ENDIF
+*/
+         }  /* bit loop */
+/*
+* A.6.2      ENDLOOP 
+*/
+
+    } /* for every datapt */
+/*
+* A.6     ENDFOR !for every datapoint
+*/
+
+/*
+*
+* A.7     STORE the grid size into caller's argument
+*/
+  bds_head->ulGrid_size= (unsigned long)gridsize;  /* store new sz */
+
+/*
+*
+* A.8      FREE old float array 
+*/
+  free (*pgrib_data);
+
+/*
+*
+* A.9      ASSIGN new expanded array to pointer
+*/
+  *pgrib_data= fbuff;	/* give it addr of expanded arr */
+/*
+*
+* A.10     RETURN 0 !success
+*/
+  DPRINT1("Leaving %s, Stat=0", func);
+  return (0); 
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/display_gribhdr.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/display_gribhdr.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/display_gribhdr.c	(revision 2744)
@@ -0,0 +1,175 @@
+/* FILE:  display_gribhdr.c  		10-OCT-96 by Alice Nakajima/SAIC */
+#include <stdio.h>              /* standard I/O header file     */
+#include <stdlib.h>
+
+#include "dprints.h"		/* function prototypes */
+#include "gribfuncs.h"		/* prototypes */
+
+#define COLS	10		/* # of cols to print per line */
+#define HALFWAY	COLS/2		/* half of #cols */
+
+/*
+**********************************************************************
+* A. FUNCTION:   display_gribhdr
+*      do a byte dump for each of the defined GRIB Sections in the 
+*      GRIB message currently stored in the Grib Header struct.
+*
+*    INTERFACE:       
+*       void display_gribhdr (gribhdr)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  GRIB_HDR *gribhdr;
+*           holds Grib header info to be printed to standard output;
+*    
+*    RETURNS:  nothing;  
+**********************************************************************
+*/
+#if PROTOTYPE_NEEDED
+void display_gribhdr ( GRIB_HDR *hdr)
+#else
+void display_gribhdr ( hdr)
+	GRIB_HDR *hdr;
+#endif
+{
+  char *func="dislay_gribhr";
+   unsigned char *ptr, *ptr2;
+   long  i, j, cnt, skip;
+   char title[200];
+
+   fprintf(stdout, "In %s: showing Grib msg in Grib Hdr:\n", func);
+/*
+*
+* A.1      IF (the entire_msg buffer is NULL) THEN
+*              PRINT error
+*              RETURN
+*          ENDIF
+*/
+   if (hdr->entire_msg == NULL) {
+	fprintf(stdout,"Entire Msg Buffer is Null, cannot proceed;\n");
+	goto RETURN;
+	}
+/*
+*
+* A.2      IF (sum of section lengths does not equal Total Msg length) THEN
+*              PRINT warning
+*          ELSE 
+*              PRINT msg_length
+*          ENDIF
+*/
+   if (hdr->msg_length != (hdr->ids_len + hdr->pds_len + hdr->gds_len 
+			   + hdr->bms_len + hdr->bds_len + hdr->eds_len))
+	fprintf(stdout,"\n*******************************************\n"\
+	"WARNING: Msg_length=%d but SUM of sect lengths= %d "\
+	"(%d+%d+%d+%d+%d+%d);\n*******************************************\n",
+   	hdr->msg_length,
+        hdr->ids_len+hdr->pds_len+hdr->gds_len+hdr->bms_len+
+	hdr->bds_len+hdr->eds_len, 
+	hdr->ids_len, hdr->pds_len, hdr->gds_len , hdr->bms_len, 
+	hdr->bds_len, hdr->eds_len);
+   else  
+	fprintf(stdout,"Msg_length=%d;  IDS=%ld,"\
+	"PDS=%ld, GDS=%ld, BMS=%ld, BDS=%ld, EDS=%ld;\n",
+   	hdr->msg_length,
+	hdr->ids_len, hdr->pds_len, hdr->gds_len , hdr->bms_len, 
+	hdr->bds_len, hdr->eds_len);
+
+   fprintf(stdout,"Printing each defined section, upto 100 bytes only\n");
+/*
+*
+* A.3      PRINT Identification Defn Section if defined;
+*          FUNCTION hdr_print   !dump out its content
+*/
+   if (hdr->ids_ptr == NULL)  fprintf(stdout,"Section 0 is Null, len=%ld;\n",
+	hdr->ids_len);
+   else {
+	cnt= (hdr->ids_len > 100 ? 100 : hdr->ids_len);
+	sprintf(title,"Section 0 Content Len=%ld (upto 100 bytes)", 
+	hdr->ids_len);
+	hdr_print (title, hdr->ids_ptr, cnt);
+	}
+	
+/*
+*
+* A.4      PRINT Product Defn Section if defined;
+*          FUNCTION hdr_print   !dump out its content
+*/
+   if (hdr->pds_ptr == NULL)  fprintf(stdout,"Product Data Section is Null, "\
+	"len=%ld;\n", hdr->pds_len);
+   else {
+	cnt= (hdr->pds_len > 100 ? 100 : hdr->pds_len);
+	sprintf(title,"PDS Content (offs=%ld, Len=%ld)",
+	(long)(hdr->pds_ptr - hdr->entire_msg), hdr->pds_len);
+	hdr_print (title, hdr->pds_ptr, cnt);
+	}
+	    
+/*
+*
+* A.5      PRINT Grid Defn Section if defined;
+*          FUNCTION hdr_print   !dump out its content
+*/
+   if (hdr->gds_ptr == NULL)  fprintf(stdout,"Grid Defn Section is Null, "\
+	"len=%ld;\n", hdr->gds_len);
+   else {
+	cnt= (hdr->gds_len > 100 ? 100 : hdr->gds_len);
+	sprintf(title,"GDS Content (offs=%ld, Len=%ld)",
+	(long)(hdr->gds_ptr - hdr->entire_msg), hdr->gds_len);
+	hdr_print (title, hdr->gds_ptr, cnt);
+	}
+	
+/*
+*
+* A.6      PRINT Bitmap Data Section if defined;
+*          FUNCTION hdr_print   !dump out its content upto 100 bytes
+*/
+   if (hdr->bms_ptr == NULL)  fprintf(stdout,"Bitmap Section is Null, "\
+	"len=%ld;\n", hdr->bms_len);
+   else {
+	cnt= (hdr->bms_len > 100 ? 100 : hdr->bms_len);
+	sprintf(title,"BMS Content (offs=%ld, Len=%ld)",
+	(long)(hdr->bms_ptr - hdr->entire_msg), hdr->bms_len);
+	hdr_print (title, hdr->bms_ptr, cnt);
+	}
+	
+/*
+*
+* A.7      PRINT Binary Defn Section if defined;
+*          FUNCTION hdr_print   !dump out its content upto 100 bytes
+*/
+   if (hdr->bds_ptr == NULL)  fprintf(stdout,"Binary Data Section is Null, "\
+	"len=%ld;\n", hdr->bds_len);
+   else {
+	cnt= (hdr->bds_len > 100 ? 100 : hdr->bds_len);
+	sprintf(title,"BDS Content (offs=%ld, Len=%ld)",
+	(long)(hdr->bds_ptr - hdr->entire_msg), hdr->bds_len);
+	hdr_print (title, hdr->bds_ptr, cnt);
+	}
+	
+/*
+*
+* A.8      PRINT End Defn Section if defined;
+*          FUNCTION hdr_print   !dump out its content
+*/
+   if (hdr->eds_ptr == NULL)  fprintf(stdout,"End Data Section is Null, "\
+	"len=%ld;\n", hdr->eds_len);
+   else {
+        cnt= (hdr->eds_len > 100 ? 100 : hdr->eds_len);
+	sprintf(title, "End Data Section (offs=%ld, size=%ld) ",
+	(long) (hdr->eds_ptr - hdr->entire_msg), hdr->eds_len); 
+	hdr_print (title, hdr->eds_ptr, cnt);
+	}
+
+RETURN:
+/*
+*
+* A.9      RETURN to caller  !return nothing
+*/
+   fprintf(stdout, "%s complete;\n", func);
+   return;
+
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/dprints.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/dprints.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/dprints.h	(revision 2744)
@@ -0,0 +1,79 @@
+/* file:  dprints.h				12/30/96 Nakajima/SAIC/MRY
+*/
+#include <stdio.h>
+
+#define p_char(expr)    fprintf(stdout," (char) " #expr "= %c\n",expr)
+#define p_string(expr)  fprintf(stdout," (char *) " #expr "= %s\n",expr)
+#define p_ushort(expr)  fprintf(stdout," (uns. short) " #expr "= %u\n",expr)
+#define p_short(expr)   fprintf(stdout," (short) " #expr "= %d\n",expr)
+#define p_int(expr)     fprintf(stdout," (int) " #expr "= %d\n",expr)
+#define p_long(expr)    fprintf(stdout," (long) " #expr "= %ld\n",expr)
+#define p_ulong(expr)   fprintf(stdout," (uns.long) " #expr "= %u\n",expr)
+#define p_float(expr)   fprintf(stdout," (float) " #expr "= %.5f\n",expr)
+#define p_double(expr)  fprintf(stdout," (double) " #expr "= %.5lf\n",expr)
+
+
+#ifdef  VERBOSE	
+/************************************************ 
+ *    DEBUG IS DESIRED (compiled with -DVERBOSE)  
+ ************************************************/
+#define VERB_ON          	1
+#define LIB_VERSION             	"verbose"
+#define DISPLAY_GRIBHDR(gh)    	  	display_gribhdr(gh)
+#define HDR_PRINT(str,addr,sz)  	hdr_print(str,addr,sz)
+#define PRT_INP_STRUCT(a,b,c,d,e)	 prt_inp_struct(a,b,c,d,e)
+#define DPRINT0(fmt)  			fprintf(stdout,(fmt))
+#define DPRINT1(fmt,a)  		fprintf(stdout,(fmt),(a))
+#define DPRINT2(fmt,a,b)  		fprintf(stdout,(fmt),(a),(b))
+#define DPRINT3(fmt,a,b,c)  		fprintf(stdout,(fmt),(a),(b),(c))
+#define DPRINT4(fmt,a,b,c,d)  		fprintf(stdout,(fmt),(a),(b),(c),(d))
+#define DPRINT5(fmt,a,b,c,d,e)  	fprintf(stdout,(fmt),\
+					(a),(b),(c),(d),(e))
+#define DPRINT6(fmt,a,b,c,d,e,f)   	fprintf(stdout,(fmt),\
+					(a),(b),(c),(d),(e),(f))
+#define DPRINT7(fmt,a,b,c,d,e,f,g) 	fprintf(stdout,(fmt), \
+					(a),(b),(c),(d),(e), (f),(g))
+#define DPRINT8(fmt,a,b,c,d,e,f,g,h) 	fprintf(stdout,(fmt),\
+					(a),(b),(c),(d),(e),(f),(g),(h))
+#define DPRINT9(fmt,a,b,c,d,e,f,g,h,i)  fprintf(stdout,(fmt),\
+					(a),(b),(c),(d),(e),(f),(g),(h),(i))
+#define P_CHAR(x)    			p_char(x)
+#define P_STRING(x)  			p_string(x)
+#define P_USHORT(x) 			p_ushort(x)
+#define P_SHORT(x)   			p_short(x)
+#define P_INT(x)    			p_int(x)
+#define P_LONG(x)    			p_long(x)
+#define P_ULONG(x)   			p_ulong(x)
+#define P_FLOAT(x)   			p_float(x)
+#define P_DOUBLE(x)  			p_double(x)
+
+#else
+/***********************************************
+*    ELSE TURN ALL DEBUG PRINTING OFF                 
+*    null out function calls
+************************************************/
+#define VERB_ON        0
+#define LIB_VERSION             "non-verbose"
+#define DISPLAY_GRIBHDR(gh)            	{}
+#define HDR_PRINT(title,addr,sz)   	{}
+#define PRT_INP_STRUCT(a,b,c,d,e)	{}
+#define DPRINT0(fmt)                    {}
+#define DPRINT1(fmt,s)                  {}
+#define DPRINT2(fmt,a,b)                {}
+#define DPRINT3(fmt,a,b,c)              {}
+#define DPRINT4(fmt,a,b,c,d)            {}
+#define DPRINT5(fmt,a,b,c,d,e)          {}
+#define DPRINT6(fmt,a,b,c,d,e,f)        {}
+#define DPRINT7(fmt,a,b,c,d,e,f,g)      {}
+#define DPRINT8(fmt,a,b,c,d,e,f,g,h)    {}
+#define DPRINT9(fmt,a,b,c,d,e,f,g,h,i)  {}
+#define P_CHAR(expr)    		{}
+#define P_STRING(expr)  		{}
+#define P_USHORT(expr)  		{}
+#define P_SHORT(expr)   		{}
+#define P_INT(expr)     		{}
+#define P_LONG(expr)    		{}
+#define P_ULONG(expr)   		{}
+#define P_FLOAT(expr)   		{}
+#define P_DOUBLE(expr)  		{}
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gbyte.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gbyte.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gbyte.c	(revision 2744)
@@ -0,0 +1,533 @@
+/* gbyte.c:
+  ADAPTED FROM THE ORIGINAL FORTRAN VERSION OF GBYTE BY:
+ 
+              DR. ROBERT C. GAMMILL, CONSULTANT
+              NATIONAL CENTER FOR ATMOSPHERIC RESEARCH
+              MAY 1972
+ 
+              CHANGES FOR FORTRAN 90
+              AUGUST 1990  RUSSELL E. JONES
+              NATIONAL WEATHER SERVICE
+              GBYTE RUN WITHOUT CHANGES ON THE FOLLOWING COMPILERS
+              MICROSOFT FORTRAN 5.0 OPTIMIZING COMPILER
+              SVS 32 386 FORTRAN 77 VERSION V2.8.1B
+              SUN FORTRAN 1.3, 1.4
+              DEC VAX FORTRAN
+              SILICONGRAPHICS 3.3, 3.4 FORTRAN 77
+              IBM370 VS COMPILER
+              INTERGRAPH GREEN HILLS FORTRAN CLIPPER 1.8.4B
+*/
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "dprints.h"	/* debug prints & func prototypes */
+#include "gribfuncs.h"		/* prototypes */
+#include "isdb.h"		/* WORD_BIT_CNT defn */
+
+/* Added by Todd Hutchinson, 8/10/05*/
+/* 
+ * gbyte requires the word bit count to be 32.  In order for this to work
+ *    on platforms with 8 byte longs, we must set WORD_BIT_CNT to 32 for
+ *    gbyte.
+ */
+
+#ifdef WORD_BIT_CNT
+#undef WORD_BIT_CNT
+#endif
+#define WORD_BIT_CNT 32  /* gbyte.c requires the word bit count to be 32! */
+
+/*
+*
+*****************************************************************
+* A.  FUNCTION:   gbyte
+*       extracts data of specified length from the specified offset
+*       from beginning of the given Data block.
+*
+*    INTERFACE:
+*      void   gbyte (inchar, iout, iskip, nbits)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) char *inchar;
+*          The fullword in memory from which unpacking is to
+*          begin, successive fullwords will be fetched as required.
+*      (O) unsigned long *iout;
+*          The value read from in memory that's returned.
+*    (I&O) unsigned long  *iskip;
+*          a fullword integer specifying the inital offset
+*          in bits of the first byte, counted from the
+*          leftmost bit in Inchar.  Gets updated upon exit;
+*      (I) unsigned long nbits;
+*          a fullword integer specifying the number of bits
+*          in each byte to be unpacked.  Legal byte widths
+*          are in the range 1 - 32, bytes of width  less than 32
+*          will be right justified in the low-order positions
+*          of the unpacked fullwords with high-order zero fill.
+*
+*    RETURN CODE:  none;
+*****************************************************************
+*
+*/
+
+#if PROTOTYPE_NEEDED
+void 	gbyte (char *inchar, unsigned long *iout, unsigned long *iskip,
+		unsigned long nbits)
+#else
+void gbyte (inchar, iout, iskip, nbits)
+	  char *inchar;         /* input */
+	  unsigned long *iout;  /* output, is the value returned */
+	  unsigned long *iskip; /* input, gets updated */
+	  unsigned long nbits;  /* input */
+#endif
+{
+   long masks[32];
+   long	icon,index,ii,mover,movel;
+   unsigned long temp, mask, inlong;
+
+
+/*
+* A.1      INITIALIZE mask possibilities of all bits set from LSB to
+*          a particular bit position;  !bit position range: 0 to 31
+*/
+   masks[0] = 1; 
+   masks[1] = 3;
+   masks[2] = 7;
+   masks[3] = 15; 
+   masks[4] = 31;
+   masks[5] = 63;
+   masks[6] = 127;
+   masks[7] = 255;
+   masks[8] = 511;
+   masks[9] = 1023;
+   masks[10] = 2047;
+   masks[11] = 4095;
+   masks[12] = 8191;
+   masks[13] = 16383;
+   masks[14] = 32767;
+   masks[15] = 65535;
+   masks[16] = 131071;
+   masks[17] = 262143;
+   masks[18] = 524287;
+   masks[19] = 1048575; 
+   masks[20] = 2097151; 
+   masks[21] = 4194303;
+   masks[22] = 8388607; 
+   masks[23] = 16777215;
+   masks[24] = 33554431;
+   masks[25] = 67108863;
+   masks[26] = 134217727;
+   masks[27] = 268435455; 
+   masks[28] = 536870911; 
+   masks[29] = 1073741823;
+   masks[30] = 2147483647;
+   masks[31] = -1;
+
+/* NBYTE MUST BE LESS THAN OR EQUAL TO WORD_BIT_CNT
+
+*
+* A.2      IF (trying to retrieve more than numbits_perword) THEN  !here, 32
+*              RETURN
+*          ENDIF
+*/
+   icon = WORD_BIT_CNT - nbits;
+   if ( icon < 0 )
+   {
+      return;
+   }
+/*
+*
+* A.3      SET up mask needed for specified #bits to retrieve
+*/
+   mask = masks[nbits-1];
+/*
+*
+* A.4      CALCULATE Index !Byte offset from 'inchar' where retrieval begins
+*/
+   index = *iskip / WORD_BIT_CNT;
+/*
+*
+* A.5      CALCULATE Bit position within byte Index where retrieval begins
+*/
+   ii = *iskip % WORD_BIT_CNT;
+
+/*
+*
+* A.6      CALCULATE #times to Right-shift the retrieved data so it 
+*          is right adjusted
+*/
+   mover = icon - ii;
+
+/*
+*
+* A.7.a    IF (need to right-adjust the byte) THEN
+*/
+   if ( mover > 0 )
+   {
+
+/*
+* A.7.a.1     RETRIEVE 4 continuous byte from offset Index in block
+*/
+     {
+       unsigned long l0, l1, l2, l3;
+       l0 = (unsigned long)inchar[index*4] << 24;
+       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
+       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
+       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
+       inlong = l0 + l1 + l2 + l3;
+     }
+/*
+* A.7.a.2     RIGHT adjust this value
+*/
+     *iout = inlong >> mover;
+/*
+* A.7.a.3     MASK out the bits wanted only    !result in *out
+*/
+     *iout = (*iout & mask);
+   } /* If */
+
+
+/*
+* A.7.b    ELSE IF (byte is split across a word break) THEN
+*/
+   else if ( mover < 0 )
+   {
+/*
+*             !
+*             !Get the valid bits out of the FIRST WORD
+*             !
+* A.7.b.1     CALCULATE #times to move retrieve data left so
+*             the 1st significant bit aligns with MSB of word
+* A.7.b.2     CALCULATE #times to move data that's aligned 
+*             with MSB so that it aligns with LSB of word
+*/
+      movel = -mover;
+      mover = WORD_BIT_CNT - movel;   /* WORD_BIT_CNT is 32 */
+
+/*
+* A.7.b.3     RETRIEVE 4-byte word from offset Index from block
+*/
+     {
+       unsigned long l0, l1, l2, l3;
+       l0 = (unsigned long)(0x000000FF & inchar[index*4]) << 24;
+       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
+       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
+       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
+       inlong = l0 + l1 + l2 + l3;
+     }
+/*
+* A.7.b.4     SHIFT retrieve this data all the way left !Left portion
+*/
+
+/*
+*             !
+*             !Now Get the valid bits out of the SECOND WORD
+*             !
+* A.7.b.5     RETRIEVE the next 4-byte word from block
+*/
+      *iout = inlong << movel;
+     {
+       unsigned long l0, l1, l2, l3;
+       l0 = (unsigned long)(0x000000FF & inchar[index*4+4]) << 24;
+       l1 = (unsigned long)(0x000000FF & inchar[index*4+5 ]) << 16;
+       l2 = (unsigned long)(0x000000FF & inchar[index*4+6 ]) << 8;
+       l3 = (unsigned long)(0x000000FF & inchar[index*4+7 ]);
+       inlong = l0 + l1 + l2 + l3;
+     }
+/* 
+* A.7.b.6     SHIFT this data all the way right   !Right portion
+* A.7.b.7     OR the Left portion and Right portion together
+* A.7.b.8     MASK out the #bits wanted only     !result in *iout
+*/
+      temp  = inlong >> mover;
+      *iout = *iout|temp;
+      *iout &= mask;
+/*
+  THE BYTE IS ALREADY RIGHT ADJUSTED.
+*/
+   }
+   else
+/*
+* A.7.c    ELSE    !the byte is already adjusted, no shifts needed
+*/
+   {
+/*
+* A.7.c.1     RETRIEVE the next 4-byte word from block
+*/
+     {
+       unsigned long l0, l1, l2, l3;
+       l0 = (unsigned long)(0x000000FF & inchar[index*4]) << 24;
+       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
+       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
+       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
+       inlong = l0 + l1 + l2 + l3;
+     }
+/*
+* A.7.c.2     MASK out the bits wanted only    !result in *out
+*/
+      *iout = inlong&mask;
+   }
+/*
+* A.7.c    ENDIF    !the byte is already adjusted
+*/
+
+/*
+*
+* A.8      DEBUG printing
+*/
+  DPRINT3 ("gbyte(skip=%d %d bits)= %lu stored as ", *iskip, nbits, *iout);
+/*
+*
+* A.9      BUMP pointer up
+*/
+	*iskip += nbits;
+/* 
+* END OF FUNCTION
+*
+*
+*/
+}
+
+/*
+*
+*****************************************************************
+* B.  FUNCTION:   gbyte_quiet
+*       called to extract data of specified length from
+*       specified offset from a block of type char;  
+*       Identical to gbyte() except it does not print out in debug mode;
+*
+*    INTERFACE:
+*      void gbyte_quiet (inchar, iout, iskip, nbits)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) char *inchar
+*          The fullword in memory from which unpacking is to
+*          begin, successive fullwords will be fetched as required.
+*      (O) unsigned long *iout
+*          The value read from memory that's being returned.
+*    (I&O) unsigned long  *iskip
+*          a fullword integer specifying the inital offset
+*          in bits of the first byte, counted from the
+*          leftmost bit in Inchar.  Gets updated upon exit;
+*      (I) unsigned long nbits
+*          a fullword integer specifying the number of bits
+*          in each byte to be unpacked.  Legal byte widths
+*          are in the range 1 - 32, bytes of width  less than 32
+*          will be right justified in the low-order positions
+*          of the unpacked fullwords with high-order zero fill.
+*
+*    RETURN CODE:  none;
+*****************************************************************
+*
+*/
+
+#if PROTOTYPE_NEEDED
+void gbyte_quiet (char *inchar, unsigned long *iout, unsigned long *iskip,
+		unsigned long nbits)
+#else
+void gbyte_quiet (inchar, iout, iskip, nbits)
+	  char *inchar;         /* input */
+	  unsigned long *iout;  /* output, is the value returned */
+	  unsigned long *iskip; /* input, gets updated */
+	  unsigned long nbits;  /* input */
+
+#endif
+{
+   long masks[32];
+   long	icon,index,ii,mover,movel;
+   unsigned long temp, mask, inlong;
+
+
+/*
+* B.1      INITIALIZE mask possibilities of all bits set from LSB to
+*          a particular bit position;  !bit position range: 0 to 31
+*/
+   masks[0] = 1; 
+   masks[1] = 3;
+   masks[2] = 7;
+   masks[3] = 15; 
+   masks[4] = 31;
+   masks[5] = 63;
+   masks[6] = 127;
+   masks[7] = 255;
+   masks[8] = 511;
+   masks[9] = 1023;
+   masks[10] = 2047;
+   masks[11] = 4095;
+   masks[12] = 8191;
+   masks[13] = 16383;
+   masks[14] = 32767;
+   masks[15] = 65535;
+   masks[16] = 131071;
+   masks[17] = 262143;
+   masks[18] = 524287;
+   masks[19] = 1048575; 
+   masks[20] = 2097151; 
+   masks[21] = 4194303;
+   masks[22] = 8388607; 
+   masks[23] = 16777215;
+   masks[24] = 33554431;
+   masks[25] = 67108863;
+   masks[26] = 134217727;
+   masks[27] = 268435455; 
+   masks[28] = 536870911; 
+   masks[29] = 1073741823;
+   masks[30] = 2147483647;
+   masks[31] = -1;
+
+/* NBYTE MUST BE LESS THAN OR EQUAL TO WORD_BIT_CNT
+
+*
+* B.2      IF (trying to retrieve more than numbits_perword) THEN  !here, 32
+*              RETURN
+*          ENDIF
+*/
+   icon = WORD_BIT_CNT - nbits;
+   if ( icon < 0 )
+   {
+      return;
+   }
+/*
+*
+* B.3      SET up mask needed for specified #bits to retrieve
+*/
+   mask = masks[nbits-1];
+/*
+*
+* B.4      CALCULATE Index !Byte offset from 'inchar' where retrieval begins
+*/
+   index = *iskip / WORD_BIT_CNT;
+/*
+*
+* B.5      CALCULATE Bit position within byte Index where retrieval begins
+*/
+   ii = *iskip % WORD_BIT_CNT;
+
+/*
+*
+* B.6      CALCULATE #times to Right-shift the retrieved data so it 
+*          is right adjusted
+*/
+   mover = icon - ii;
+
+/*
+*
+* B.7.a    IF (need to right-adjust the byte) THEN
+*/
+   if ( mover > 0 )
+   {
+
+/*
+* B.7.a.1     RETRIEVE 4 continuous byte from offset Index in block
+*/
+     {
+       unsigned long l0, l1, l2, l3;
+       l0 = (unsigned long)inchar[index*4] << 24;
+       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
+       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
+       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
+       inlong = l0 + l1 + l2 + l3;
+     }
+/*
+* B.7.a.2     RIGHT adjust this value
+*/
+     *iout = inlong >> mover;
+/*
+* B.7.a.3     MASK out the bits wanted only    !result in *out
+*/
+     *iout = (*iout & mask);
+   } /* If */
+
+
+/*
+* B.7.b    ELSE IF (byte is split across a word break) THEN
+*/
+   else if ( mover < 0 )
+   {
+/*
+*             !
+*             !Get the valid bits out of the FIRST WORD
+*             !
+* B.7.b.1     CALCULATE #times to move retrieve data left so
+*             the 1st significant bit aligns with MSB of word
+* B.7.b.2     CALCULATE #times to move data that's aligned 
+*             with MSB so that it aligns with LSB of word
+*/
+      movel = -mover;
+      mover = WORD_BIT_CNT - movel;   /* WORD_BIT_CNT is 32 */
+
+/*
+* B.7.b.3     RETRIEVE 4-byte word from offset Index from block
+*/
+     {
+       unsigned long l0, l1, l2, l3;
+       l0 = (unsigned long)(0x000000FF & inchar[index*4]) << 24;
+       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
+       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
+       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
+       inlong = l0 + l1 + l2 + l3;
+     }
+/*
+* B.7.b.4     SHIFT retrieve this data all the way left !Left portion
+*/
+
+/*
+*             !
+*             !Now Get the valid bits out of the SECOND WORD
+*             !
+* B.7.b.5     RETRIEVE the next 4-byte word from block
+*/
+      *iout = inlong << movel;
+     {
+       unsigned long l0, l1, l2, l3;
+       l0 = (unsigned long)(0x000000FF & inchar[index*4+4]) << 24;
+       l1 = (unsigned long)(0x000000FF & inchar[index*4+5 ]) << 16;
+       l2 = (unsigned long)(0x000000FF & inchar[index*4+6 ]) << 8;
+       l3 = (unsigned long)(0x000000FF & inchar[index*4+7 ]);
+       inlong = l0 + l1 + l2 + l3;
+     }
+/* 
+* B.7.b.6     SHIFT this data all the way right   !Right portion
+* B.7.b.7     OR the Left portion and Right portion together
+* B.7.b.8     MASK out the #bits wanted only     !result in *iout
+*/
+      temp  = inlong >> mover;
+      *iout = *iout|temp;
+      *iout &= mask;
+/*
+  THE BYTE IS ALREADY RIGHT ADJUSTED.
+*/
+   }
+   else
+/*
+* B.7.c    ELSE    !the byte is already adjusted, no shifts needed
+*/
+   {
+/*
+* B.7.c.1     RETRIEVE the next 4-byte word from block
+*/
+     {
+       unsigned long l0, l1, l2, l3;
+       l0 = (unsigned long)(0x000000FF & inchar[index*4]) << 24;
+       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
+       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
+       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
+       inlong = l0 + l1 + l2 + l3;
+     }
+/*
+* B.7.c.2     MASK out the bits wanted only    !result in *out
+*/
+      *iout = inlong&mask;
+   }
+/*
+* B.7.c    ENDIF    !the byte is already adjusted
+*/
+
+/*
+*
+* B.8      BUMP pointer up
+*/
+	*iskip += nbits;
+/* 
+* END OF FUNCTION
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib.h	(revision 2744)
@@ -0,0 +1,401 @@
+/*** FILE:  grib.h ***/
+/* Revisions:
+10/16/97/atn:  +usData_type to mercator, space view structs 
+11/04/97/atn:  reduced DEF+MSG_LEN  from 250k;
+02/18/98/atn:  + Projection codes; -ENC_DELIMITOR; -struct space_view;
+04/22/98/atn:  + extension flag;
+*/
+
+#define EXTENSION_FLAG 99	/* Implies extensions if equals PDS Oct41 */
+#define DEF_MSG_LEN    50000		/* size of GRIB HDR 's entire_msg */
+#define MAX_PROJ_SIZE  46               /* MaxSize of GDS minus 6 bytes*/
+					/* Currently set to LATLON; */
+/*#define MAX_INP_PROJ_SIZE 72*/	/* Size of Max Input GDS block, */
+					/* currently set to GDS_LATLON_INPUT */
+/* Todd Hutchinson 8/11/05 */
+/*
+ * The above definition for MAX_INP_PROJ_SIZE only works with machines that
+ *    have 4 byte long ints.  Here, we will quadruple this to handle up to 
+ *    16 byte long ints.  This was an issue on the IBM in 64 bit mode.
+ */
+#define MAX_INP_PROJ_SIZE 288
+
+/* WMO projection codes 
+	***  MUST keep parallel to 'prjn_name' array       *** 
+	***  IF altered, must also update the 'PRJ_COUNT'  *** 
+*/
+#define LATLON_PRJ		0
+#define MERC_PRJ		1
+#define LAMB_PRJ		3
+#define GAUSS_PRJ 	 	4
+#define POLAR_PRJ		5
+#define ALBERS_PRJ		8
+#define ROT_LATLON_PRJ		10
+#define OBLIQ_LAMB_PRJ		13
+#define ROT_GAUSS_PRJ	 	14
+#define STR_LATLON_PRJ		20
+#define STR_GAUSS_PRJ   	24
+#define STR_ROT_LATLON_PRJ	30
+#define STR_ROT_GAUSS_PRJ 	34
+
+#define PRJ_COUNT		35	/* num of elements in prjn_name[] */
+
+/* WMO projection names (use WMO codes above to index) */
+static char* 	prjn_name[] = {
+	"(0) Latitude/Longitude Grid",
+	"(1) Mercator Grid",
+	"(2) Unsupported Grid",
+	"(3) Lambert Grid",
+	"(4) Gaussian Grid",
+	"(5) Polar Grid",
+	"(6) Unsupported Grid",
+	"(7) Unsupported Grid",
+	"(8) Albers equal-area Grid",
+	"(9) Unsupported Grid",
+	"(10) Rotated Latitude/Longitude Grid",
+	"(11) Unsupported Grid",
+	"(12) Unsupported Grid",
+	"(13) Oblique Lambert Grid",
+	"(14) Rotated Gaussian Grid",
+	"(15) Unsupported Grid",
+	"(16) Unsupported Grid",
+	"(17) Unsupported Grid",
+	"(18) Unsupported Grid",
+	"(19) Unsupported Grid",
+	"(20) Stretched Latlon Grid",
+	"(21) Unsupported Grid",
+	"(22) Unsupported Grid",
+	"(23) Unsupported Grid",
+	"(24) Stretched Gaussian Grid",
+	"(25) Unsupported Grid",
+	"(26) Unsupported Grid",
+	"(27) Unsupported Grid",
+	"(28) Unsupported Grid",
+	"(29) Unsupported Grid",
+	"(30) Stretched Rotated Latlon Grid",
+	"(31) Unsupported Grid",
+	"(32) Unsupported Grid",
+	"(33) Unsupported Grid",
+	"(34) Stretched Rotated Gaussian Grid"
+	};
+	
+/*.................................................................*/
+typedef struct GRIB_HDR {	/* holds one Grib Msg & its info */
+   char shuffled;                       /* set if sections are out of order */
+   long	msg_length;			/* length in bytes of entire msg */
+   long ids_len;			/* length in bytes of Ident Sect  */
+   long pds_len; 			/* length in bytes of Prod Defn Sect */
+   long gds_len; 			/* length in bytes of Grid Defn Sect */
+   long bms_len; 			/* length in bytes of Bitmap Sect */
+   long bds_len; 			/* length in bytes of Bin Data Sect */
+   long eds_len; 			/* length in bytes of Ending Sect */
+   long abs_size;			/* num bytes malloced to entire_msg*/
+   unsigned char *entire_msg;		/* arr holding entire Grib msg */
+   unsigned char *ids_ptr;		/* pts to 'GRIB' w/in entire msg */
+   unsigned char *pds_ptr;		/* pts to PDS w/in entire msg */
+   unsigned char *gds_ptr;		/* pts to GDS w/in entire msg */
+   unsigned char *bms_ptr;		/* pts to BMS w/in entire msg */
+   unsigned char *bds_ptr;		/* pts to BDS w/in entire msg */
+   unsigned char *eds_ptr;		/* pts to '7777' w/in entire msg */
+}  GRIB_HDR;
+
+typedef struct PDS_INPUT{             /*  User input structure - PDS */
+   unsigned short   uslength;            /* PDS Length - depends on extensions */
+   unsigned short   usEd_num;            /* GRIB Edition number - #1 (IndS)  */
+   unsigned short   usParm_tbl;          /* Parameter table number (1)    */
+   unsigned short   usCenter_id;         /* Id of originating center (Table 0)*/
+   unsigned short   usProc_id;           /* Generating process Id number (Table A) */
+   unsigned short   usGrid_id;           /* Grid Identification (Table B)  */
+   unsigned short   usGds_bms_id;        /* GDS and BMS flag (Table 1)     */
+   unsigned short   usParm_id;           /* Parameter and unit id (Table 2) */
+   unsigned short   usLevel_id;          /* Type of level or layer id (Table 3/3a) */
+   unsigned short   usLevel_octets;      /* number of octets used in Table 3 (0, 1, 2 values) */
+   unsigned short   usHeight1;           /* Height1, pressure1,etc of level (Table 3)*/
+   unsigned short   usHeight2;           /* Height2, pressure2,etc of level (Table 3)*/
+   unsigned short   usYear;              /* Year of century -Initial or ref. */
+   unsigned short   usMonth;             /* Month of year   -time of forecast */
+   unsigned short   usDay;               /* Day of month                  */
+   unsigned short   usHour;              /* Hour of day                   */
+   unsigned short   usMinute;            /* Minute of hour                */
+   unsigned short   usFcst_unit_id;      /* Forecast time unit (Table 4)  */
+   unsigned long    usP1;                /* Period of time (Number of time units)  */
+   unsigned long    usP2;                /* Time interval between forecasts  */
+   unsigned short   usTime_range;        /* Time range indicator (Table 5)   */
+   unsigned short   usTime_range_avg;    /* Number included in average if flag set */
+   unsigned short   usTime_range_mis;    /* Number missing from average      */
+   unsigned short   usCentury;           /* Centry of Initial time (19)      */
+   unsigned short   usCenter_sub;        /* Oct 26: Sub Center id          */
+   short            sDec_sc_fctr;        /* Decimal scale factor             */
+   unsigned short   ausZero[12];         /* Reserved                         */
+   unsigned short   usExt_flag;	 	 /* Oct 41: Grib extensions usage flag*/
+   unsigned short   usSecond;		 /* Second of Minute	             */
+   unsigned short   usTrack_num;	 /* Tracking ID for data set	     */
+   unsigned short   usParm_sub;		 /* Sub-Table Entry for parameter and unit (Table 2) */
+   unsigned short   usSub_tbl;           /* Sub-Table version number */
+   /* WSI Extended PDS fields */
+   unsigned short PDS_41;          /* Forecast time 1 unit id - Table 4 */
+   long           PDS_42;          /* forecast time 1 (up to 4 bytes) */
+   unsigned short PDS_46;          /* Forecast time 2 unit id - Table 4 */
+   long           PDS_47;          /* forecast time 2 */
+   unsigned short PDS_51;          /* Time range indicator - Table 5 */
+  unsigned short PDS_52;           /* Top of atmosphere--used with sigma coord*/
+}PDS_INPUT;
+
+typedef struct GDS_LAM_INPUT {     /* Input: Lambert Conformal Grid */
+   unsigned short   usData_type;     /* Data representation type ( Table 6)    */
+   int		    iNx;                 /* Nx - # of points along x-axis   */
+   int		    iNy;                 /* Ny - # of points along y-axis   */
+   long             lLat1;               /* Latitude of first grid point    */
+   long             lLon1;               /* Longitude of first grid point   */
+   unsigned short   usRes_flag;          /* Resolution and component flag (Table 7)*/
+   long             lLon_orient;         /* Orientaion of grid - longitude  */
+   unsigned long    ulDx;                /* X-direction grid length         */
+   unsigned long    ulDy;                /* Y-direction grid length         */
+   unsigned short   usProj_flag;         /* Projection center flag          */
+   unsigned short   usScan_mode;         /* Scan mode                       */
+   long             lLat_cut1;           /* First latitude which secant cone cuts  */
+   long             lLat_cut2;           /* Second latitude from pole       */
+   long             lLat_southpole;      /* Latitude of southern pole (millidegree)*/
+   long             lLon_southpole;      /* Longitude of southern pole      */
+   int		    usZero;              /* Reserved (set to 0)             */
+}GDS_LAM_INPUT;
+
+typedef struct GDS_LATLON_INPUT{   /* Input: Latitude/Longitude Grid */
+   unsigned short   usData_type;     /* Data representation type ( Table 6)    */
+   int		    usNi;                /* Number of points along a parallel */
+   int		    usNj;                /* Number of points along a meridian */
+   long             lLat1;               /* Latitude of first grid point      */
+   long             lLon1;               /* Longitude of first grid point     */
+   unsigned short   usRes_flag;          /* Resolution and component flag (Table 7)*/
+   long             lLat2;               /* Latitude of last grid point       */
+   long             lLon2;               /* Longitude of last grid point      */
+   int              iDi;                 /* I-direction increment             */
+   int              iDj;                 /* J-direction increment             */
+   unsigned short   usScan_mode;         /* Scanning mode (Table 8)           */
+   long		    usZero;              /* Reserved (set to 0)               */
+   long             lLat_southpole;      /* Latitude of southern pole (millidegree)*/
+   long             lLon_southpole;      /* Longitude of southern pole        */
+   long             lRotate;             /* Angle of rotation                 */
+   long             lPole_lat;           /* Latitude of pole of stretching (millidegree) */
+   long             lPole_lon;           /* Longitude of pole of stretching   */
+   long             lStretch;            /* Stretching factor                 */
+}GDS_LATLON_INPUT;
+
+typedef struct GDS_PS_INPUT {     /* Input: Polar Stereographic Grid */
+   unsigned short   usData_type;     /* Data representation type ( Table 6)    */
+   unsigned short   usNx;                /* Nx - # of points along x-axis */
+   unsigned short   usNy;                /* Ny - # of points along y-axis */
+   long             lLat1;               /* Latitude of first grid point */
+   long             lLon1;               /* Longitude of first grid point */
+   unsigned short   usRes_flag;          /* Resolution and component flag (Table 7) */
+   long             lLon_orient;         /* Orientaion of grid - longitude */
+   unsigned long    ulDx;                /* X-direction grid length */
+   unsigned long    ulDy;                /* Y-direction grid length */
+   unsigned short   usProj_flag;         /* Projection center flag */
+   unsigned short   usScan_mode;         /* Scan mode */
+   unsigned short   usZero;              /* Reserved (set to 0) */
+} GDS_PS_INPUT;
+
+typedef struct mercator  /*  mercator grids */
+   {
+   unsigned short   usData_type;     /* Data representation type ( Table 6)    */
+   int cols;               /* Ni - Number of points along a latitude circle */
+   int rows;               /* Nj - Number of points along a longitude meridian */
+   long first_lat;         /* La1 - Latitude of first grid point */
+   long first_lon;         /* Lo1 - Longitude of first grid point */
+   unsigned short   usRes_flag;  /* Resolution and component flag (Table 7)*/
+   long La2;               /* latitude of last grid point, or # point / row */
+   long Lo2;               /* longitude of last grid point, or # point / column */
+   long latin;             /* Latin - the latitude at which the mercator 
+                                      projection intersects the earth */
+   unsigned short   usZero1;   /* Reserved (set to 0)                    */
+   unsigned short   usScan_mode; /* Scanning mode (Table 8)                */
+   float lon_inc;       /* Di - the longitudinal direction increment 
+                           (west to east) */
+   float lat_inc;       /* Dj - the latitudinal direction increment 
+                           (south to north) */
+   long             usZero;              /* Reserved (set to 0)                    */
+ }mercator;
+
+typedef struct BDS_HEAD_INPUT {          /* BDS Header Input                */
+   unsigned long    length;              /* BDS Length */
+   unsigned short   usBDS_flag;          /* BDS flag (Table 11)                    */
+   int              Bin_sc_fctr;         /* Binary scale factor                    */
+   float            fReference;          /* Reference value (minimum value)        */
+   unsigned short   usBit_pack_num;      /* Number of bits into which data is packed*/
+   unsigned long    ulGrid_size;         /* Number of grid points                  */
+   float            fPack_null;          /* Pack_null value for packing data       */
+}BDS_HEAD_INPUT;
+
+typedef struct GDS_HEAD_INPUT {        /* internal GDS Header Input */
+   unsigned short   usNum_v;             /* Number of vertical cords   */
+   unsigned short   usPl_Pv;             /* PV or PL location  */
+   unsigned short   usData_type;         /* Data representation type (Table 6)     */
+   unsigned short   uslength;            /* GDS Length - depends on projection */
+   int              *thin;               /* array to hold sizes of thinned rows */
+}GDS_HEAD_INPUT;
+
+typedef struct IDS_GRIB {              /* IDS -Indicator Section 0               */
+   unsigned char   szId[4];              /* "GRIB" Identifier                      */
+   unsigned char   achTtl_length[3];     /* Total length of GRIB msg               */
+   unsigned char   chEd_num;             /* GRIB Edition number  - #1              */
+} IDS_GRIB;
+
+typedef struct PDS_GRIB {              /* PDS -Product Definition Section 1       */
+   unsigned char    achPDS_length[3];    /* Section length (in octets)             */
+   unsigned char    chParm_tbl;          /* Parameter table number (1)             */
+   unsigned char    chCenter_id;         /* Id of originating center (Table 0)     */
+   unsigned char    chProc_id;           /* Generating process Id number (Table A) */
+   unsigned char    chGrid_id;           /* Grid Identification (Table B)          */
+   unsigned char    chGds_bms_id;        /* GDS and BMS flag (Table 1)             */
+   unsigned char    chParm_id;           /* Parameter and unit id (Table 2)        */
+   unsigned char    chLevel_id;          /* Type of level or layer id (Table 3/3a) */
+   unsigned char    achHeight[2];        /* Height, pressure,etc of level (Table 3)*/
+   unsigned char    chYear;              /* Year of century     -Initial or ref.   */
+   unsigned char    chMonth;             /* Month of year       -time of forecast  */
+   unsigned char    chDay;               /* Day of month                           */
+   unsigned char    chHour;              /* Hour of day                            */
+   unsigned char    chMinute;            /* Minute of hour                         */
+   unsigned char    chFcst_unit_id;      /* Forecast time unit (Table 4)           */
+   unsigned char    chP1;                /* Period of time (Number of time units)  */
+   unsigned char    chP2;                /* Time interval between forecasts        */
+   unsigned char    chTime_range;        /* Time range indicator (Table 5)         */
+   unsigned char    achTime_range_avg[2]; /* Number included in average if flag set */
+   unsigned char    chTime_range_mis;    /* Number missing from average            */
+   unsigned char    chCentury;           /* Centry of Initial time (19)            */
+   unsigned char    chCenter_sub;        /* Oct-26: Sub Center Id  */
+   unsigned char    achDec_sc_fctr[2];   /* Decimal scale factor                   */
+   unsigned char    achZero[12];         /* Reserved                               */
+
+   /* WSI Extended PDS fields */
+   unsigned char PDS_41;                 /* Forecast time 1 unit id - Table 4 */
+   unsigned char PDS_42[4];              /* forecast time 1 (up to 4 bytes) */
+   unsigned char PDS_46;                 /* Forecast time 2 unit id - Table 4 */
+   unsigned char PDS_47[4];              /* forecast time 2 */
+   unsigned char PDS_51;                 /* Time range indicator - Table 5 */
+   unsigned char PDS_52[2];           /* Top of atmosphere--used with sigma coord*/
+  
+  /* 
+   * The following was removed by Todd Hutchinson, WSI, 4/11/2002 
+   *   The extended pds section is now replaced with the values above
+   */
+  /* unsigned char    chExt_flag;          Oct-41: Grib extensions usage flag*/
+  /* unsigned char    chSecond;            Second of Minute                       */
+  /* unsigned char    chTrack_num[2];      Tracking ID for data set               */
+  /* unsigned char    chParm_sub;          Sub-Table Entry for parameter and unit (Table 2) */
+  /* unsigned char    chSub_tbl;           Sub-Table Version number */
+} PDS_GRIB;
+
+typedef struct GDS_HEAD {              /* GDS header                              */
+   unsigned char    achGDS_length[3];    /* Section length (in octets)             */
+   unsigned char    chNV;                /* # of vertical coord. parameters (not used)*/
+   unsigned char    chPV;                /* Location of vert. coord., 255 if none  */ 
+   unsigned char    chData_type;         /* Data representation type (Table 6)     */
+} GDS_HEAD;
+
+typedef struct LAMBERT {               /* Lambert Conformal Grid                  */
+   unsigned char    achNx[2];                /* Nx - # of points along x-axis          */
+   unsigned char    achNy[2];                /* Ny - # of points along y-axis          */
+   unsigned char    achLat1[3];          /* Latitude of first grid point           */
+   unsigned char    achLon1[3];          /* Longitude of first grid point          */
+   unsigned char    chRes_flag;          /* Resolution and component flag (Table 7)*/
+   unsigned char    achLon_orient[3];    /* Orientaion of grid - longitude         */
+   unsigned char    achDx[3];            /* X-direction grid length                */
+   unsigned char    achDy[3];            /* Y-direction grid length                */
+   unsigned char    chProj_flag;         /* Projection center flag                 */
+   unsigned char    chScan_mode;         /* Scan mode                              */
+   unsigned char    achLat_cut1[3];      /* First latitude which secant cone cuts  */
+   unsigned char    achLat_cut2[3];      /* Second latitude from pole              */
+   unsigned char    achLat_southpole[3]; /* Latitude of southern pole (millidegree)*/
+   unsigned char    achLon_southpole[3]; /* Longitude of southern pole             */
+   unsigned char    achZero[2];              /* Reserved (set to 0)                    */
+} LAMBERT;
+
+typedef struct POLAR {                   /* Polar Stereographic Grid */
+   unsigned char    achNx[2];            /* Nx - # of points along x-axis */
+   unsigned char    achNy[2];            /* Ny - # of points along y-ayis */
+   unsigned char    achLat1[3];          /* Latitude of first grid point */
+   unsigned char    achLon1[3];          /* Longitude of first grid point */
+   unsigned char    chRes_flag;          /* Resolution and component flag (Table 7) */
+   unsigned char    achLon_orient[3];    /* Orientaion of grid - longitude */
+   unsigned char    achDx[3];            /* X-direction grid length */
+   unsigned char    achDy[3];            /* Y-direction grid length */
+   unsigned char    chProj_flag;         /* Projection center flag */
+   unsigned char    chScan_mode;         /* Scan mode */
+   unsigned char    achZero[4];          /* Reserved (set to 0) */
+} POLAR;
+
+typedef struct MERCATOR {                /* Mercator Grid */
+  unsigned char     achNi[2];            /* Ni - Number of points along latitude circle */
+  unsigned char     achNj[2];            /* Nj - Number of points along longtitude meridian */
+  unsigned char     achLat1[3];          /* Latitude of first grid point */
+  unsigned char     achLon1[3];          /* Longtitude of first grid point */
+  unsigned char     chRes_flag;          /* Resolution and component flag (Table 7) */
+  unsigned char     achLat2[3];          /* latitude of last grid point */
+  unsigned char     achLon2[3];          /* longitude of last grid point */
+  unsigned char     achLatin[3];         /* latitude(s) at which the Mercator projection
+					    cylinder intersects the earth */
+  unsigned char     achZero1;            /* Reserved (set to 0) */
+  unsigned char     chScan_mode;         /* Scan mode */
+  unsigned char     achDi[3];            /* longitudinal direction increment (meters) */
+  unsigned char     achDj[3];            /* latitudinal direction increment (meters) */
+  unsigned char     achZero2[8];         /* Reserved (set to 0) */
+} MERCATOR;
+
+typedef struct LATLON {                  /* Input: Latitude/Longitude Grid          */
+   unsigned char    achNi[2];            /* Number of points along a parallel      */
+   unsigned char    achNj[2] ;           /* Number of points along a meridian      */
+   unsigned char    achLat1[3];          /* Latitude of first grid point           */
+   unsigned char    achLon1[3];          /* Longitude of first grid point          */
+   unsigned char    chRes_flag;          /* Resolution and component flag (Table 7)*/
+   unsigned char    achLat2[3];          /* Latitude of last grid point            */
+   unsigned char    achLon2[3];          /* Longitude of last grid point           */
+   unsigned char    achDi[2];             /* I-direction increment                  */
+   unsigned char    achDj[2];             /* J-direction increment                  */
+   unsigned char    chScan_mode;         /* Scanning mode (Table 8)                */
+   unsigned char    achZero[4];              /* Reserved (set to 0)                    */
+   unsigned char    achLat_southpole[3]; /* Latitude of southern pole (millidegree)*/
+   unsigned char    achLon_southpole[3]; /* Longitude of southern pole             */
+   unsigned char    achRotate[4];        /* Angle of rotation                      */
+   unsigned char    achPole_lat[3];      /* Latitude of pole of stretching (millidegree) */
+   unsigned char    achPole_lon[3];      /* Longitude of pole of stretching        */
+   unsigned char    achStretch[4];       /* Stretching factor                      */
+} LATLON;
+
+typedef struct BDS_HEAD {                /* Binary Data Section 4                     */
+   unsigned char    achBDS_length[3];    /* Section length                         */
+   unsigned char    chBDS_flag;          /* Flag (Table 11)                        */
+   unsigned char    achBin_sc_fctr[2];   /* Binary Scale Factor                    */
+   unsigned char    achReference[4];     /* Reference value (minimum value)IBM format*/
+   unsigned char    chBit_pack_num;      /* Number of bits into which data is packed*/
+} BDS_HEAD;
+
+typedef struct EDS_GRIB {                /* End Section 5                           */
+   unsigned char    szEDS_id[4];         /* "7777" Ascii characters                */
+} EDS_GRIB;
+
+typedef struct grid_desc_sec     /* Grid Description Section */
+{
+   struct GDS_HEAD_INPUT   head;     /* GDS Header section - common to all */
+   struct GDS_LATLON_INPUT llg;      /* Latitude/Longitude or Gaussian grids */
+   struct GDS_LAM_INPUT    lam;      /* lambert conformal grids */
+   struct GDS_PS_INPUT     pol;      /* polar stereographic grids */
+   struct mercator         merc;         /* mercator grids */
+}grid_desc_sec;
+
+typedef struct BMS_GRIB 		/* Bit Map Section 3 			*/
+{
+  unsigned char	 achBMS_length[3];	/* Section length			*/
+  unsigned char	 chUnused_bits;		/* #unused bits in bitmap stream	*/
+  unsigned char  achBMS_id[2];		/* 0 or a predefined bitmap id		*/
+} BMS_GRIB;
+
+typedef struct BMS_INPUT	/* User Input structure - BMS */
+{
+  unsigned long  uslength;	/* section length */
+  unsigned short usUnused_bits;	/* number of Unused bits */
+  unsigned short usBMS_id;	/* 0 or a predefined id  */
+  unsigned long  ulbits_set;	/* num of datapts present */
+  char		*bit_map;	/* pts to beg. of BM bstream */
+} BMS_INPUT;
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_dec.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_dec.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_dec.c	(revision 2744)
@@ -0,0 +1,272 @@
+#include <stdio.h>              /* standard I/O header file          */
+#include <stdlib.h>
+#include <string.h>
+#include "dprints.h"		/* for dprints & func prototype*/
+#include "gribfuncs.h"		/* prototypes */
+
+/* PROGRAMMER : Steve Lowe and Todd Kienitz, SAIC Monterey
+   DATE       : February 7, 1996
+                Oct. 1996 by Alice Nakajima, SAIC Monterey
+*
+*********************************************************************
+* A.  FUNCTION:  grib_dec
+*     decode a Gridded Binary (GRIB edition 1) format message
+*
+*    INTERFACE:
+*      int grib_dec (curr_ptr, pds, gds, bds_head, bms, ppgrib_data, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *curr_ptr;
+*           pointer to block containing GRIB message to decode;
+*      (O)  PDS_INPUT  *pds ;
+*           to be filled with decoded Product Defn Section info;
+*      (O)  grid_desc_sec  *gds;
+*           to be filled with decoded Binary Data Section info;
+*      (O)  BDS_HEAD_INPUT *bds_head;
+*           to be filled with decoded Binary Data Section info;
+*      (O)  BMS_INPUT *bms;
+*           to be filled with decoded Bitmap Section info;
+*      (O)  float **ppgrib_data;
+*           points to NULL upon entry; upon successful exit, points to newly
+*           malloced Float array filled with unpacked and restored data;
+*      (O)  char *errmsg;
+*           Empty array, Returned filled if error occurred;
+*
+*     RETURN CODE:
+*        0> Success, **ppgrib_data now points to a block containing
+*           the unpacked & restored data (float);
+*        1> Fail: first 4 bytes of curr_ptr is not 'GRIB'
+*        2> Fail: last 4 bytes of curr_ptr is not '7777'
+*        3> Fail: not Grib Edition 1
+*        4> Fail: unknown projection type;
+***********************************************************************
+*/
+
+#if PROTOTYPE_NEEDED
+int   grib_dec (char *curr_ptr, PDS_INPUT  *pds, grid_desc_sec  *gds,
+        	BDS_HEAD_INPUT *bds_head, BMS_INPUT *bms, float **ppgrib_data,
+        	char *errmsg)
+#else
+int grib_dec (curr_ptr, pds, gds, bds_head, bms, ppgrib_data, errmsg)
+  char          *curr_ptr; /*input= ptr to 1st byte of GRIB message block*/
+  PDS_INPUT     *pds;      /* output=ptr to Internal PDS struct*/
+  grid_desc_sec *gds;      /* output=ptr to Internal GDS struct*/
+  BDS_HEAD_INPUT*bds_head; /*out=ptr to Internal BDS header struct*/
+  BMS_INPUT     *bms;      /*output=ptr to Internal bitmap section struct*/
+  float         **ppgrib_data; /*outp=ptr to nothing upon entry; upon exit, */
+                           /* points to a newly malloced array of floats;  */
+  char          *errmsg;   /* output= empty unless Error happens */
+#endif
+{
+  char *func="grib_dec";
+  unsigned long lMessageSize;       /* message and section size */
+  long edition;                     /* GRIB edition number */
+  int flag;                         /* tests if a condition has happened */
+  int gds_flag;			    /* set if Gds present */
+  int nReturn = 0;
+  unsigned long skip;
+  float *outdata;
+  int xsize;
+  int j;
+
+/*
+*
+* A.0     DEBUG printing
+*/
+ DPRINT1 ("Entering %s\n", func);
+ DPRINT6 (
+  "curr_ptr=%ld, pds=%ld, gds=%ld\nbds_head=%ld, bms=%ld, ppgrib_data=%ld\n",
+  curr_ptr, pds, gds, bds_head, bms, ppgrib_data);
+/*
+*
+* A.1     IF (incoming pointer is not at 'GRIB') 
+*            RETURN 1  !errmsg filled
+*         ENDIF
+*/
+if(strncmp(curr_ptr,"GRIB",4) != 0) {
+  sprintf (errmsg,"%s:  no 'GRIB' at beg. of this msg\n", func);
+  nReturn= (1);   /* GRIB not found */
+ }
+
+/*
+*
+* A.2     FUNCTION gbyte   !get total message length from IDS 
+*/
+skip=32;
+gbyte(curr_ptr,&lMessageSize,&skip,24);
+DPRINT0 ("lMessageSize\n");
+
+/*
+*
+* A.3     IF (Message does not end with '7777') 
+*            RETURN 2  !errmsg filled
+*         ENDIF
+*/
+if(strncmp((curr_ptr + lMessageSize - 4),"7777",4)!=0) {
+  DPRINT1 ("%s:  no '7777' at end of this msg\n", func);
+  sprintf (errmsg,"%s:  no '7777' at end of this msg\n", func);
+  nReturn= 2; goto BYE;
+  }
+
+/*
+*
+* A.4     EXTRACT the  GRIB edition out of Section 0
+*         IF (not GRIB edition 1)
+*            RETURN 3  !errmsg filled
+*         ENDIF
+*/
+edition = (long) curr_ptr[7];        /* get edition */
+pds->usEd_num = (unsigned short) edition;
+if(edition != 1) {
+  DPRINT1 ("%s:  error, not Grib Edition 1 \n", func);
+  sprintf (errmsg,"%s:  not Grib Edition 1 \n", func);
+  nReturn=(3);   goto BYE;
+  }
+
+/*
+*
+* A.5     MOVE pointer to the Product Definition section
+*/
+curr_ptr = curr_ptr + 8;
+
+/* 
+*
+* A.6     FUNCTION gribgetpds  !decode the PDS 
+*         RETURN error code if fails  !errmsg filled
+*/
+if( nReturn= gribgetpds(curr_ptr, pds, errmsg)) {
+   DPRINT2 ("%s:  error=%d  in grib get pds;\n", func, nReturn);
+   upd_child_errmsg (func, errmsg);
+   goto BYE;
+  }
+
+/* 
+*
+* A.7     MOVE pointer to the end of PDS
+*/
+curr_ptr += pds->uslength;
+
+/*
+*
+* A.8     IF (GDS is present)
+*/
+gds_flag = pds->usGds_bms_id >> 7 & 1;
+if(gds_flag)  /* grid description section present */
+  {
+/*
+* A.8.1      FUNCTION gribgetgds   !decode GDS
+*            RETURN error code if fails  !errmsg filled
+*/
+   if( nReturn=gribgetgds(curr_ptr, gds, errmsg)) {
+      DPRINT2 ("%s:  error=%d  in grib get GDS;\n", func, nReturn);
+      upd_child_errmsg (func, errmsg);
+      goto BYE;
+       }
+
+/* 
+* A.8.2      MOVE the cursor to the next section (either BMS/BDS)
+*/
+   curr_ptr += gds->head.uslength;
+/* 
+* A.8.3      SET the number of data points depending on Projection
+*/
+   switch(gds->head.usData_type)
+  {
+     case LATLON_PRJ:    	/* Lat/Lon Grid */
+     case GAUSS_PRJ:    	/* Gaussian Latitude/Longitude grid */
+     case ROT_LATLON_PRJ:   	/* Rotated Lat/Lon */
+     case ROT_GAUSS_PRJ:   	/* Rotated Gaussian */
+     case STR_LATLON_PRJ:   	/* Stretched Lat/Lon */
+     case STR_GAUSS_PRJ :   	/* Stretched Gaussian */
+     case STR_ROT_LATLON_PRJ :  /* Stretched and Rotated Lat/Lon */
+     case STR_ROT_GAUSS_PRJ :   /* Stretched and Rotated Gaussian */
+       	bds_head->ulGrid_size = gds->llg.usNi * gds->llg.usNj;       
+	break;
+
+     case MERC_PRJ:  		/* Mercator Grid */
+       	bds_head->ulGrid_size = gds->merc.cols * gds->merc.rows; 
+	break;
+
+     case LAMB_PRJ:  		/* Lambert Conformal */
+     case ALBERS_PRJ:  		/* Albers equal-area */
+     case OBLIQ_LAMB_PRJ: 	/* Oblique Lambert Conformal */
+       	bds_head->ulGrid_size = gds->lam.iNx * gds->lam.iNy; 
+	break;
+
+     case POLAR_PRJ:  		/* Polar Stereographic */
+       	bds_head->ulGrid_size = gds->pol.usNx * gds->pol.usNy; 
+	break;
+
+     default: /* unknown */
+       DPRINT2 ("%s: unknown usData_type=%d\n",func,gds->head.usData_type);
+       sprintf(errmsg,"%s: unknown usData_type=%d\n", 
+	func, gds->head.usData_type);
+       nReturn= (4); goto BYE;
+     }
+  }
+/*
+* A.8     ENDIF (GDS is present)
+*/
+
+/*
+*
+* A.9     IF (bitmap Section is present)
+*/
+flag = pds->usGds_bms_id >> 6 & 1;
+if(flag)  /* bit map section present */
+  {
+/*
+* A.9.1      FUNCTION gribgetbms   !decode BMS
+*            RETURN error code if fails  !errmsg filled
+*/
+   if( nReturn=gribgetbms(curr_ptr,bms,gds_flag, bds_head->ulGrid_size,errmsg)) 
+   { 
+     DPRINT2 ("%s:  error=%d  in grib get BMS;\n",func,nReturn);
+     upd_child_errmsg (func, errmsg);
+     goto BYE;
+   } 
+
+/* 
+* A.9.2      MOVE the cursor to beginning of Binary Data Section
+*/
+     curr_ptr += bms->uslength;
+
+  } /* Bms present */
+/*
+* A.9     ENDIF  !bms present
+*/
+
+
+/*
+*
+* A.10    FUNCTION  gribgetbds()
+*         RETURN error code if failed  !errmsg filled
+*/
+  if(nReturn=gribgetbds(curr_ptr, pds->sDec_sc_fctr, bms, gds, ppgrib_data, 
+		bds_head, errmsg)) 
+   { 
+     DPRINT2 ("%s:  error=%d  in grib get BDS;\n",func,nReturn);
+     upd_child_errmsg (func, errmsg);
+     goto BYE;
+    }
+ 
+/*
+* 
+* A.11    SET return code to 0  !no errors
+*/
+  nReturn = 0;
+
+/*
+*
+* A.12    RETURN return code;
+*/
+BYE:
+  DPRINT2  ("Exit %s, Stat=%d\n", func, nReturn);
+  return(nReturn);
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+} 
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_enc.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_enc.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_enc.c	(revision 2744)
@@ -0,0 +1,599 @@
+/*
+ REVISIONS:
+ 10/15/96 A. Nakajima, SAIC:  removed 'write_grib' call; make combined lib;
+ 11/03/97 /ATN  -Realloc
+*/
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#ifdef XT3_Catamount
+#include <features.h>
+#undef htonl
+#define htonl(x)     swap_byte4(x)
+#else
+#include <netinet/in.h>
+#endif
+#include "dprints.h"		/* for dprints */
+#include "grib_lookup.h"	/* parm/model/lvl defn */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+*
+****************************************************************************
+* A.  FUNCTION:  grib_enc
+*        to encode a GRIB Edition 1 message using the three
+*        input internal structures (DATA_INPUT, USER_INPUT, GEOM_IN),
+*        and the Floating point data array;  
+*        It's ok for Float array to be null if Grib Hdr shows that
+*        it contains a predefined BDS;  that case, just exits w/ no errs;
+*
+*    INTERFACE:
+*      int grib_enc (Data_Input, User_Input, Geom_In, pfData_Array, gh, errmsg)
+*      
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  DATA_INPUT Data_Input;
+*           Structure containing input field information.  
+*      (I)  USER_INPUT User_Input;
+*           Structure containing encoder configuration data.
+*      (I)  GEOM_IN Geom_In;
+*           Structure containing grid geometry description.
+*    (I&O)  float *pfData_Array;
+*           array of float data to be packed and stored in the Binary Data 
+*           Section.  Float array may be Null if the Grib Header already
+*           contains a Binary Data Section in its attribute 'entire_msg'.
+*           That case is referred to as the 'Shuffle Mode' which results
+*           in the encoder to only create the sections which are not already
+*           in entire_msg;  
+*           Note: non-null data array will be returned with the data being 
+*           scaled up by the Decimal Scale Factor.
+*    (I&O)  GRIB_HDR *gh;
+*           Pre-malloced structure used to hold the encoded GRIB message 
+*           and its info.  It contains a large array to hold the encoded
+*           message, pointers to each of the Section along with their length,
+*           and a flag 'shuffled' which determines how the message is encoded.
+*           If 'shuffled' is zero upon entry, all 6 sections will be created 
+*           and array (float *pfData_Array) must contain the float data.
+*           If 'shuffled' is set upon entry, there is already one or more
+*           sections in Entire_msg;  Each of these pre-included sections
+*           sections will have a Non-Null pointer & a non-Zero length. 
+*           The encoder will then only create the missing sections and
+*           append them at the end of the existing sections in array
+*           'entire_msg', hence these sections may not be in the proper 
+*           order expected by GRIB.
+*      (O)  char *errmsg
+*           Empty array, returned filled if error occurred;
+*
+*    RETURN VALUE:  
+*       0>  no errors;   
+*           GRIB_HDR is returned with the encoded message in 'entire_msg',
+*           w/ total message length in msg_length,
+*           w/ pointers to each defined Grib Header Sections in
+*           ids_ptr, pds_ptr, gds_ptr, bms_ptr, gds_ptr, eds_ptr,
+*           and each section length in ids_len, pds_len, gds_len, bms_len,
+*           bds_len, eds_len;  Note that the sections may not be in order if
+*           the 'shuffled' bit is set;
+*       1>  failed,  msg in errmsg;
+****************************************************************************/
+#if PROTOTYPE_NEEDED
+int grib_enc   (DATA_INPUT Data_Input, USER_INPUT User_Input, GEOM_IN Geom_In,
+        	float *pfData_Array, GRIB_HDR *gh, char *errmsg)
+#else
+int grib_enc   (Data_Input, User_Input, Geom_In, pfData_Array, gh, errmsg)
+		DATA_INPUT Data_Input; 
+		USER_INPUT User_Input; 
+		GEOM_IN Geom_In;
+        	float *pfData_Array; 
+		GRIB_HDR *gh; 
+		char *errmsg;
+#endif
+{
+   PDS_INPUT 		*pPDS_Input= 0;		/* internal Pds struc */
+   GDS_HEAD_INPUT       *pGDS_Head_Input = 0;   /* Internal Gds struc */
+   void                 *pvGDS_Proj_Input = 0;	/* depends on Projection*/
+   BDS_HEAD_INPUT       *pBDS_Head_Input = 0;   /* Internal Bds struc */
+   char			*func= "grib_enc";
+   char 		*Sevens= "7777";
+   int                  gdsbms_flag= 0;		/* whether to include them */
+   unsigned char	*px;			/* working ptr w/in EntireMsg */
+   long			lTemp;			/* working var */
+   int			n,Stat= 1;		/* default to error */
+
+   DPRINT1 ("Entering %s...\n", func);
+/*
+*
+* A.1          IF (ptr is null or if the Entire_msg buffer is null) THEN
+*                 RETURN 1 !errmsg filled
+*              ENDIF
+*/
+   if (!gh || !gh->entire_msg) 
+	{  
+	sprintf (errmsg, "%s: expecting non-null GRIB_HDR struct\n", func);
+	goto BYE; 
+	}
+
+/*
+*
+* A.2          CREATE storage for the Internal structures;
+*                  ! PDS_INPUT
+*                  ! GDS_HEAD_INPUT
+*                  ! GDS_Proj_Input set to MAX_INP_PROJ_SIZE defined in grib.h
+*                  ! BDS_HEAD_INPUT
+*              RETURN with Malloc Err in errmsg if fails;
+*              INITIALIZE Internal structures
+*/
+   if (! (pPDS_Input= (PDS_INPUT *)malloc(sizeof(PDS_INPUT))) ||
+       ! (pGDS_Head_Input =(GDS_HEAD_INPUT*)malloc(sizeof(GDS_HEAD_INPUT))) ||
+       ! (pvGDS_Proj_Input= (void *) malloc (MAX_INP_PROJ_SIZE))  ||
+       ! (pBDS_Head_Input =(BDS_HEAD_INPUT*)malloc(sizeof(BDS_HEAD_INPUT))))
+	{
+        sprintf(errmsg,"%s:  failed to make storage for Internal Structs\n",
+	func);
+	goto BYE; 
+	}
+   memset ((void *) pPDS_Input, '\0', sizeof(PDS_INPUT));
+   memset ((void *) pGDS_Head_Input, '\0', sizeof (GDS_HEAD_INPUT));
+   memset ((void *) pvGDS_Proj_Input,'\0', MAX_INP_PROJ_SIZE);
+   memset ((void *) pBDS_Head_Input, '\0', sizeof (BDS_HEAD_INPUT));
+
+/*
+*
+* A.3          IF (creating all sections) 
+*              ! ** (shuffled == 0) **
+*              ! user passed Float data in, and the GribHdr's
+*              ! Entire_Msg array has no valid data in it;
+*              ! Must 'put' all Sections 0 thru 5 into Grib Hdr in that order;
+* A.3.a        THEN
+*/
+   if (! gh->shuffled) 
+        { 
+	/* Create All Sections mode:  user must send float data */
+        DPRINT0 ("(SHUFFLE=0)  Create ALL sections mode\n");
+
+/*
+* A.3.a.1          RETURN if Float array is Null;  !errmsg filled
+*/
+	if ( !pfData_Array) 
+	  {
+	   sprintf(errmsg,
+	  "%s: <Create-All mode>  No DataArray avail to encode\n",func);
+	   goto BYE;
+	   }
+
+/*
+* A.3.a.2          CLEAR out the length and section ptrs
+*                  ASSIGN beginning of Entire Msg to 'px', as location to 
+*                  append things to;
+*/
+	gh->msg_length= gh->eds_len= gh->pds_len= gh->gds_len= 0;
+	gh->bms_len= gh->bds_len= gh->eds_len= 0;
+	gh->eds_ptr= gh->pds_ptr= gh->gds_ptr= NULL;
+	gh->bms_ptr= gh->bds_ptr= gh->eds_ptr= NULL;
+	px = gh->entire_msg; /* append from here on */
+/*
+*
+* A.3.a.3          BUILD IDS SECTION
+*                  SET up pointer to IDS
+*                  SET up IDS length  (8 for Edition 1)
+*                  WRITE the Ident Data Section to Grib Hdr
+*                  UPDATE 'px' to end of IDS !where to write next section
+*/
+	gh->ids_len = 8; 
+	gh->msg_length += 8L;
+	gh->ids_ptr = px;
+	memcpy  ((void *) gh->ids_ptr, (void *)"GRIB....", 8);
+	px = gh->entire_msg + gh->msg_length;
+	DPRINT3 ("%s: 'putting' IDS (%ld), msg_len=%ld\n",
+	func, gh->ids_len,gh->msg_length);
+
+/*
+*
+* A.3.a.4          FUNCTION gribputpds   !Build PDS Section into GRIB_HDR
+*                  IF failed
+*                  THEN return with error !errmsg filled
+*                  ELSE  bump 'px' to end of this section
+*/
+        if (n= gribputpds (Data_Input, User_Input, pPDS_Input, &gh, errmsg)) 
+	 { 
+	   upd_child_errmsg (func, errmsg);
+	   goto BYE; 
+	 }
+	else   px = gh->entire_msg + gh->msg_length;
+
+	DPRINT3("%s: Encoding PDS (%ld), msg_len=%ld\n",
+	func, gh->pds_len,gh->msg_length);
+
+/*
+*
+* A.3.a.5          FUNCTION gribputgds  !Build GDS Section into GRIB_HDR
+*                  IF failed
+*                  THEN return with error !errmsg filled
+*                  ELSE  bump 'px' to end of this section
+*/
+ if ((int) (User_Input.usGds_bms_id) >= 128)
+      {
+           if ( n = gribputgds (Geom_In, 
+	    	       pGDS_Head_Input, &pvGDS_Proj_Input, &gh, errmsg) )
+	     { 
+	       upd_child_errmsg (func, errmsg);
+	       goto BYE; 
+	     }
+           else   px = gh->entire_msg + gh->msg_length;
+
+           DPRINT3 ("%s: Encoding  GDS (%ld), msg_len=%ld\n",
+	    func, gh->gds_len,gh->msg_length);
+      }
+        else DPRINT1 ("%s: SKIPPING GDS!\n", func);
+
+/*
+*
+* A.3.a.6          Force no BMS by default
+*/
+	gh->bms_ptr=0; gh->bms_len= 0; 
+	DPRINT1 ("%s: Skipping BMS by default\n", func);
+
+/*
+*
+* A.3.a.7          FUNCTION gribputbds  Build BDS Section into GRIB_HDR
+*                  IF failed
+*                  THEN return with error !errmsg filled
+*                  ELSE  bump 'px' to end of this section
+*/
+        if (n= gribputbds (User_Input, Geom_In.nx*Geom_In.ny, 
+			pPDS_Input->sDec_sc_fctr, 
+			pfData_Array, 
+			pBDS_Head_Input, &gh, errmsg)) 
+	 { 
+	   upd_child_errmsg (func, errmsg);
+	   goto BYE; 
+	 }
+       else   px = gh->entire_msg + gh->msg_length;
+
+       DPRINT3 ("%s: Encoding BDS (%ld), msg_len=%ld\n",
+		func, gh->bds_len,gh->msg_length);
+
+/*
+*
+* A.3.a.8          IF (Entire Msg buffer isn't big enough to hold EDS)
+*                  THEN
+*                     FUNCTION Expand_gribhdr    !make it 4 bytes larger
+*                     RETURN with Error if fails !errmsg filled
+*                  ENDIF
+*                  SET up pointer to EDS
+*                  WRITE Grib EDS section to the end of Data !"7777"
+*                  UPDATE Grib Hdr's Eds_Ptr, Eds_Len 
+*/
+       if (gh->msg_length > gh->abs_size 
+	&& Expand_gribhdr (gh, gh->msg_length, errmsg) != 0)
+	 { 
+	   upd_child_errmsg (func, errmsg); 
+	   goto BYE; 
+	 }
+
+       gh->eds_ptr= px;
+       gh->eds_len= 4;
+       gh->msg_length += gh->eds_len;
+       memcpy ((void *)gh->eds_ptr, (void*)Sevens, 4);
+       DPRINT3 ("%s: 'putting' EDS (%ld), msg_len=%ld\n",
+       func, gh->eds_len,gh->msg_length);
+
+  } /* END SHUFFLED == 0 SECTION */
+
+/*
+* A.3.b        ELSE 
+*              ! ** (shuffled == 1) **
+*              ! means that user has already put 1/more GRIB sections 
+*              ! in GRIB_HDR struct's Entire_Msg;  The already included
+*              ! Sections may not be in proper GRIB-format order, and have 
+*              ! non-null Pointers and non-zero length;  Msg_Length also 
+*              ! reflects total length of all included sections;  
+*              ! -if the Float data is Null, the Bds must already be included
+*              ! in the Grib Hdr;  Func will return error if the Bds pointer
+*              ! is Null or the Bds Len is zero;  
+*              ! -if the incoming Float data has data and the Grib hdr shows
+*              ! that BMS is already defined then the func will Ignore the
+*              ! float data;
+*              ! otherwise, the float data will be used to create a new
+*              ! Binary Data Section;
+*              ! Only need to 'put' the Sections that have not already been 
+*              ! included in the Grib Header;  
+*/
+   else {  /* Shuffle Mode:  Create Missing Sections mode */
+
+/*
+* A.3.b.1          IF (there is discrepency in section pointers and length)
+*                      RETURN 1  !errmsg filled
+*                  ENDIF
+*/
+	if (  (gh->ids_ptr && !gh->ids_len) || (gh->ids_len && !gh->ids_ptr)
+	   || (gh->pds_ptr && !gh->pds_len) || (gh->pds_len && !gh->pds_ptr)
+	   || (gh->gds_ptr && !gh->gds_len) || (gh->gds_len && !gh->gds_ptr)
+	   || (gh->bms_ptr && !gh->bms_len) || (gh->bms_len && !gh->bms_ptr)
+	   || (gh->bds_ptr && !gh->bds_len) || (gh->bds_len && !gh->bds_ptr)
+	   || (gh->eds_ptr && !gh->eds_len) || (gh->eds_len && !gh->eds_ptr)
+	   || (gh->entire_msg && !gh->msg_length) 
+	   || (gh->msg_length && !gh->entire_msg)  )
+	    {
+	    sprintf (errmsg,
+	    "%s:  GribHdr Length/Ptr to sections are not consistent\n", func); 
+	    goto BYE;  
+	    }
+
+/*
+* A.3.b.2          IF (no float array was passed in AND 
+*                      Grib Hdr shows BDS is undefined) THEN
+*                      RETURN 1 !errmsg filed
+*                  ENDIF
+*/
+	if ( !pfData_Array && !gh->bds_ptr) {
+	   sprintf(errmsg, 
+	   "%s: <Create Missing Sect mode> No DataArray avail to encode Bds\n",
+	   func);
+	   goto BYE;
+	   }
+
+/*
+* A.3.b.3          IF (user did send in float array AND 
+*                      Grib Hdr shows BDS is already defined) THEN
+*                      PRINT warning   !won't encode float array
+*                  ENDIF
+*/
+	if ( pfData_Array && gh->bds_ptr && gh->bds_len>0) {
+	   DPRINT2 ("%s: GribHdr already has a BDS (Len=%ld), " \
+	   " not going to encode the Float Data\n" , func, gh->bds_len);
+	 }
+
+	DPRINT7 ("(SHUFFLE=1)  gribhdr contains msg with totlen=%ld\n" \
+	        "   IDS(%d), PDS(%d), GDS(%d), BMS(%d), BDS(%d), EDS(%d)\n",
+		gh->msg_length, gh->ids_len, gh->pds_len, gh->gds_len,
+		gh->bms_len, gh->bds_len, gh->eds_len);
+
+/*
+* A.3.b.4          ASSIGN to local ptr 'px' the address of Msg_length bytes
+*                  away from Entire Msg, as location to append things to;
+*/
+	 px = gh->entire_msg + gh->msg_length; /* append from here */
+	  
+/*
+*
+* A.3.b.5          IF (GribHdr has no IDS yet)
+*                  THEN
+*                      SET up pointer to IDS
+*                      SET up IDS length  (8 for Edition 1)
+*                      WRITE the Ident Data Section to Grib Hdr
+*                      !use dummy message length for now
+*                      UPDATE 'px' to end of IDS !where to write next section
+*                  ENDIF
+*/
+   if ( gh->ids_ptr==NULL ) 
+     {
+	gh->ids_len = 8; 
+	gh->msg_length += 8L;
+	gh->ids_ptr = px;
+	memcpy  ((void *) gh->ids_ptr, (void *)"GRIB....", 8);
+	px = gh->entire_msg + gh->msg_length;
+	DPRINT3 ("%s: 'putting' IDS (%ld), msg_len=%ld\n",
+	func, gh->ids_len,gh->msg_length);
+    }
+  else DPRINT1 ("%s: skip writing IDS\n", func);
+
+/*
+*
+* A.3.b.6          IF (GribHdr has no PDS yet)
+*                  THEN
+*                      FUNCTION gribputpds  !Build PDS Section into GRIB_HDR
+*                      IF failed
+*                      THEN return with error !errmsg filled
+*                      ELSE  bump 'px' to end of this section
+*                  ENDIF
+*/
+   if ( gh->pds_ptr==NULL)  
+     {
+        if (n= gribputpds (Data_Input, User_Input, pPDS_Input, &gh, errmsg)) 
+	 { 
+	   DPRINT2 ("%s:  got err=%d in Grib Put Pds()\n",func,n);
+	   upd_child_errmsg (func, errmsg);
+	   goto BYE; 
+	 }
+	else   px = gh->entire_msg + gh->msg_length;
+
+	DPRINT3("%s: 'putting' PDS (%ld), msg_len=%ld\n",
+	func, gh->pds_len,gh->msg_length);
+     }
+  else DPRINT1("%s:  skip writing PDS\n", func);
+
+/*
+*
+* A.3.b.7          IF (GribHdr has no GDS yet)
+*                  THEN
+*                      FUNCTION gribputgds  !Build GDS Section into GRIB_HDR
+*                      IF failed
+*                      THEN return with error !errmsg filled
+*                      ELSE  bump 'px' to end of this section
+*                  ENDIF
+*/
+
+   if ((gh->gds_ptr==NULL) && (User_Input.usGds_bms_id >= 128))
+    {
+       if ( n = gribputgds (Geom_In, 
+	    	   pGDS_Head_Input, &pvGDS_Proj_Input, &gh, errmsg) )
+	 { 
+	   DPRINT2 ("%s:  got err=%d in Grib Put Gds()\n",func,n);
+	   upd_child_errmsg (func, errmsg);
+	   goto BYE; 
+	 }
+       else   px = gh->entire_msg + gh->msg_length;
+
+       DPRINT3 ("%s: 'putting' GDS (%ld), msg_len=%ld\n",
+	func, gh->gds_len,gh->msg_length);
+    }
+  else DPRINT1 ("%s:  skip writing GDS\n", func);
+
+/* 
+*
+* A.3.b.8          CHECK consistency on Gds/Bms flag
+*                  IF (GDS is included) 
+*                  THEN SET the GdsPresent bit
+*                  ELSE CLEAR the GdsPresent bit 
+*                  ENDIF
+*/
+  gdsbms_flag = (int)gh->pds_ptr[7] & 0x000000FF;
+  DPRINT1 ("orig gds/bms flag, pds[7] = 0x%x\n", gdsbms_flag);
+
+  if (gh->gds_ptr == NULL) {
+	 gdsbms_flag &= ~(0x00000080); 	
+	 DPRINT2 ("%s: GDS missing, so CLEAR 0x80;  newFLG=0x%x, \n", 
+	 func, gdsbms_flag);
+	}
+  else { 
+	 gdsbms_flag |= (0x00000080); 
+	 DPRINT2 ("%s: GDS Present, so SET 0x80;  newFLG=0x%x, \n", 
+	 func, gdsbms_flag);
+	 /* 
+ 	    DONOT set grid id to 255, since it is possible for user to
+	    define a new grid with id w/in range, and still include GDS;
+ 	  */
+	}
+
+/* 
+*
+* A.3.b.9          IF (BMS is there) THEN
+*                      SET the BmsPresent bit
+*                  ELSE
+*                      CLEAR the BmsPresent bit
+*                  ENDIF
+*/
+  if (gh->bms_ptr == NULL) {
+	 gdsbms_flag &= ~(0x00000040);
+	 DPRINT2 ("%s: no BMS, so CLEAR 0x40; new FLG=0x%x",func,gdsbms_flag);
+	}
+  else { gdsbms_flag |= (0x00000040);
+	 DPRINT2("%s: BMS Present, so SET 0x40; new FLG=0x%x",func,gdsbms_flag);
+	}
+
+   gh->pds_ptr[7] = (unsigned char)gdsbms_flag;
+   DPRINT1 ("; PDS_ptr[7]= %x\n",gh->pds_ptr[7]);
+
+/*
+*
+* A.3.b.10         IF (GribHdr has no BDS yet) THEN 
+*                      FUNCTION gribputBds  !Build BDS Section into GRIB_HDR
+*                      !**NOT doing anything to Data even if BMS is included ***
+*                      IF failed
+*                      THEN return with error !errmsg filled
+*                      ELSE  bump 'px' to end of this section
+*                  ENDIF
+*/
+   if ( gh->bds_ptr==NULL )
+    {
+        if (n= gribputbds (User_Input, Geom_In.nx*Geom_In.ny, 
+			pPDS_Input->sDec_sc_fctr, 
+			pfData_Array, 
+			pBDS_Head_Input, &gh, errmsg)) 
+	 { 
+	   DPRINT2 ("%s:  got err=%d in Grib Put BDS()\n",func,n);
+	   upd_child_errmsg (func, errmsg);
+	   goto BYE; 
+	 }
+       else   px = gh->entire_msg + gh->msg_length;
+
+       DPRINT3 ("%s: 'putting' BDS (%ld), msg_len=%ld\n",
+		func, gh->bds_len,gh->msg_length);
+    }
+  else DPRINT1("%s: skip writing BDS\n", func);
+
+/*
+*
+* A.3.b.11         IF (GribHdr has no EDS yet)
+*                  THEN
+*                    IF (Entire Msg buffer isn't big enough to hold EDS)
+*                     FUNCTION Expand_gribhdr    !make it 4 bytes larger
+*                     RETURN with Error if fails !errmsg filled
+*                  ENDIF
+*                  SET up pointer to EDS
+*                  WRITE Grib EDS section to the end of Data !"7777"
+*                  UPDATE Grib Hdr's Eds_Ptr, Eds_Len 
+*/
+   if ( gh->eds_ptr==NULL ) 
+   {
+       if (gh->msg_length+5L > gh->abs_size ) {
+    	  DPRINT1 ("Need to expand gribhdr (%ld) to hold EDS\n", 
+	  gh->abs_size);	  
+          /*if (NULL == (realloc (gh->entire_msg, gh->msg_length))) */
+
+	  if (Expand_gribhdr (gh, gh->msg_length+5L, errmsg) ) {
+	     upd_child_errmsg (func, errmsg);
+	     goto BYE;
+	  }
+	  DPRINT1("gribhdr now has abs_size of %ld\n",
+	  gh->abs_size);
+
+	}  /* size changed */
+
+       gh->eds_ptr= px;
+       gh->eds_len= 4;
+       gh->msg_length += gh->eds_len;
+       memcpy ((void *)gh->eds_ptr, (void*)Sevens, 4);
+       DPRINT3 ("%s: 'putting' EDS (%ld), msg_len=%ld\n",
+       func, gh->eds_len,gh->msg_length);
+  }
+  else DPRINT1 ("%s:  skip writing EDS\n", func);
+
+/*
+* A.3          ENDIF
+*/
+        } /* END SHUFFLED == 1 SECTION */
+
+/*
+*
+* A.4          UPDATE Total Msg Length in Grib Hdr's Ident Data Sect
+*/
+   set_bytes(gh->msg_length, 3, gh->ids_ptr+4);
+   
+   /* 1 is for the Edition  1 */   
+   set_bytes(1,1,gh->ids_ptr+7);
+
+/*
+*
+* A.5          SET status to 0  ! no errors
+*/
+   Stat = 0;
+   
+
+BYE:
+/*
+*
+* A.6          PRINT message if error occurred
+*/
+  if (errmsg[0]!='\0') DPRINT1("%s\n", errmsg);
+/*
+*
+* A.7          FREE up space of local Input structures
+*
+* A.8          RETURN stat
+*/
+  /* 
+   * Changed by Todd Hutchinson, TASC
+   * With this original code, not all memory was being freed
+   */
+  /* Original
+  if (! pPDS_Input)  free(pPDS_Input);
+  if (! pGDS_Head_Input) free(pGDS_Head_Input);
+  if (! pvGDS_Proj_Input) free(pvGDS_Proj_Input);
+  if (! pBDS_Head_Input) free(pBDS_Head_Input);
+  */
+  /* New: */
+  free(pPDS_Input);
+  free(pGDS_Head_Input);
+  free(pvGDS_Proj_Input);
+  free(pBDS_Head_Input);
+
+  DPRINT3 ("Leaving %s (Msglen=%ld), stat=%d\n", func, gh->msg_length,Stat);
+  return Stat;
+
+/*
+*
+* END OF FUNCTION
+*
+*
+*/ 
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_lookup.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_lookup.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_lookup.h	(revision 2744)
@@ -0,0 +1,154 @@
+/* FILE:  grib_lookup.h   
+ Decoder Lookup Table (ie. g1tab_128_2.2) shows how to convert from GRIB
+ units to DB units;
+ Encoder Lookup Table (ie. neons2grib.2.2) shows how to convert from DB
+ units to GRIB units;
+
+Revisions:
+12/96 A.Nakajima +debug print
+07/97 atn: +LPRINT, +List_xxx;
+...............................................................*/
+#include <stdio.h>
+#include <limits.h>
+#include <float.h>
+
+#ifndef  TABLES_H
+#define  TABLES_H
+#define  ADD_DEC   	1L
+#define  ADD_ENC   	2L
+#define  NEW_ENTRY 	3L
+#define  NO_NUM	   	INT_MAX	/* +32767 */
+#define  NO_FNUM   	FLT_MAX   	/*  1E+37 */
+#define  LPRINT 	if (logfile!=NULL) fprintf
+
+enum { 
+   NOTFOUND, FOUND, NULL_OK, NO_NULL, NO_SPACE, SPACE_OK, YES, NO, 
+   OK, SKIP, ABORT 
+   };
+
+/* 
+*   Use this to index the db_tbl_name[] array, so any changes would
+*   require updating db_tbl_name[] also.  
+*  To add new Parm tables, insert it before the Model_Type;
+*/
+enum struct_types {
+    	Parm0_Type=0, ParmA_Type, ParmB_Type,ParmC_Type, ParmD_Type, ParmE_Type,
+    	Model_Type, Level_Type, Geom_Type
+  };
+#define  MAX_PARM_TBLS   	(ParmE_Type-Parm0_Type + 1)
+
+static char *db_tbl_name[]= {
+    	"PARMTBL-0","PARMTBL-A","PARMTBL-B","PARMTBL-C","PARMTBL-D","PARMTBL-E",
+    	"MODEL-TBL","LEVEL-TBL","GEOM-TBL"
+   };
+
+#define  NPARM 	   256
+#define  NLEV 	   256
+#define  NGEOM 	   256
+#define  NMODEL    256
+#define  NOCTR 	   256
+#define  NCTRS     256
+
+#define  EMPTY_PARM(x)  	(!(x)->grib_dsc[0] && !(x)->db_name[0])
+#define  EMPTY_LEVEL(x) 	(!(x)->grib_dsc[0]  && !(x)->db_name[0])
+#define  EMPTY_MODEL(x) 	(!(x)->grib_dsc[0] && !(x)->db_name[0])
+#define  EMPTY_GEOM(x)  	(!(x)->grib_dsc[0] && !(x)->db_name[0])
+
+#define  PARMTBL_INDX(Parm_id, Parm_sub)   \
+	(Parm_id>249 && Parm_sub!=0 ? ((Parm_id-249)*NPARM+Parm_sub):Parm_id)
+#define  LIST_GEOM(unit,cell)  	\
+	 fprintf((unit),"Geom=%03d:\n    grib_dsc='%s'\n    db_name='%s'\n\n",\
+	 	(cell)->usGeom_id, (cell)->grib_dsc, (cell)->db_name);
+#define  LIST_PARM(unit,curr_Type,cell)	\
+	 fprintf ((unit),						\
+     		"%s  Parm_id=%d,  Parm_sub=%d  (Index= %d):\n" 		\
+     		"    Descr='%s' Unit='%s'\n"				\
+     		"    DBName='%s' Scl=%.3f Offs=%.3f DSF=%d\n\n",	\
+		db_tbl_name[curr_Type],					\
+     		(cell)->usParm_id,  (cell)->usParm_sub,			\
+     		PARMTBL_INDX ((cell)->usParm_id,(cell)->usParm_sub),	\
+     		(cell)->grib_dsc, (cell)->grib_unit_dsc, (cell)->db_name, \
+     		(cell)->fScale, (cell)->fOffset, (cell)->sDSF);
+#define  LIST_LVL(unit,cell)		\
+	fprintf ((unit), 						\
+		"Level=%03d: '%s' %d octs\n   name1='%s'\n"		\
+		"   name2='%s'\n   db_name='%s' Scl=%.3f Offs=%.3f\n\n",  \
+        	(cell)->usLevel_id, (cell)->grib_dsc, (cell)->num_octets, \
+		(cell)->lvl_name_1, (cell)->lvl_name_2, (cell)->db_name, \
+		(cell)->fScale, (cell)->fOffset);
+#define  LIST_MODEL(unit,cell)		\
+	fprintf ((unit),		\
+		"Model=%03d:\n    grib_dscr='%s'\n    db_name='%s'\n\n",\
+   		(cell)->usModel_id, (cell)->grib_dsc, (cell)->db_name);
+
+/******************************************************************
+ The following structs hold Parameter, Level, Model and Geom info;
+ They are loaded from the external 'lookup tables';
+ The following structs are used as ARRAY of structures, where # elements
+ depends on what type of structs they are (usually 256 as defined in 
+ the # defines lines above;
+ ******************************************************************/
+
+typedef struct parm_defn  { /****  PARAMETER:   GRIB vs. Neons */
+     /* for a given ParmId & ParmSub, get Index within Db_Parm_Tbl
+	via PARMTBL_INDX(Parm_id, Parm_sub)
+	Index 249 through 255 denote Sub-Tables Defs only when Parm_sub > 0;
+	In that case usParm_id tells which Sub-Tbl we're in and usParm_sub
+	tells which element of that Table to access;
+	SubTbl-A  usParm_id 249  usParm_sub
+
+	and
+        Db_Parm_Tbl[0-249,255],
+		{  usParm_id = usGribCode (1-255); SubParm=0; }
+        Db_Parm_Tbl[250-254],
+		{  usParm_id = 249/250/251/252/253/254; SubParm= usGribCode; }
+        for Main Parameter defns (Db_Parm_Tbl[0-255],
+		{  usParm_id= usGribCode (1-255); SubParm=0; }
+	Sub-Tbls A/B/C/D/E defns (Db_Parm_Tbl[256-511], [512-767] ...)
+		{  usParm_id= 250/251/252/253/254; Parmsub= usGribCode(1-255);}
+	where usGribCode is between 0-255 (DECODR: 1st col, ENCODR= 3rd col)
+     */
+
+  unsigned short usParm_id; /* see above */
+  unsigned short usParm_sub;/* see above */
+
+  char   grib_dsc[75];      /* DECODR: field parameter -   2nd col */
+  char   grib_unit_dsc[25]; /* DECODR: units -             3rd col */
+
+  char   db_name[31];       /* ENCODR: neons field name    1st col */
+  /*char   chTable_code;    /- ENCODR: 0/a/b/c/d/e table 2nd col   */
+  float  fScale;  	    /* ENCODR: binary Scale Fctor  4th col */
+  float  fOffset;           /* ENCODR: Unit offset         5th col */
+  short  sDSF;              /* ENCODR: Decimal scalefactor 6th col */
+} PARM_DEFN;
+
+
+typedef struct lvl_defn {   /****  LEVEL:  GRIB vs. Neons  */
+  unsigned short    usLevel_id;	  /* DECDR: line1 col1 &  ENCDR:  2nd col  */
+  char   grib_dsc[100];      /* DECDR: meaning of code figure line1: 2nd col*/
+  int    num_octets;         /* DECDR: #octets for contents- line1: 3rd col*/
+  char   lvl_name_1[100];    /* DECDR: contents of octets 11 & 12  : line2 */
+  char   lvl_name_2[100];    /* DECDR: contents of octets 11 & 12  : line3 */
+
+  char   db_name[31];        /* ENCODR: db db_name      1st col */
+  float  fScale;  	    /* ENCODR: binary Scale Fctor  3rd col */
+  float  fOffset;           /* ENCODR: offset              4th col */
+}  LVL_DEFN;
+
+typedef struct mdl_defn { /****  MODEL:    GRIB vs. Neons */
+  unsigned short  usModel_id;/* ENCDR & DECDR: 1st col */
+  char grib_dsc[61];         /* DECDR:   2nd col */
+  char db_name[31];          /* ENCDR:   2nd col */
+} MODEL_DEFN;
+
+typedef struct geom_defn {   /***  GEOM :   Grib vs. Neons ****/
+  unsigned short  usGeom_id; /* ENCDR & DECODR TBL: 1st col */
+  char grib_dsc[61];         /* DECODR LOOKUP TBL:   2nd col */
+  char db_name [31];         /* ENCDR LOOKUP TBL:   2nd col */
+} GEOM_DEFN;
+/*................................................................*/
+
+typedef struct  ctr_defn {  /**** ORIGINATING CENTERS INFO *****/
+  char ctr_dsc[100];	    /* orig_ctrs:  description of center */
+}  CTR_DEFN;
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_seek.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_seek.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_seek.c	(revision 2744)
@@ -0,0 +1,612 @@
+/* File:  grib_seek.c 		based on Decoder's trqgetmsg() func;
+   Revised by:
+   28oct96 Alice T. Nakajima (ATN), SAIC, Monterey
+   18jun97 ATN check Edition before reading in entire msg;
+   27aug97 ATN *SEEK_SET to 0 (gcc complains)
+   20Oct97 ATN print #bytes read when fread fails;
+   03nov97 ATN -Realloc
+   22oct98 ATN *error msg;
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+**********************************************************************
+* A.  FUNCTION: grib_seek
+*       search the input file starting at the given offset for a GRIB 
+*       message.  If found, return it in GRIB_HDR structure.
+*
+*    INTERFACE:
+*       int grib_seek (InFile, offset, Read_Index,  gh, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *InFile;
+*           name of input file to search for message;
+*     (I&O) long  *offset;
+*           number of bytes to skip from the beginning of file;
+*           gets updated upon leaving to absolute #bytes from beginning of
+*           file to beginning of message found;
+*      (I)  int  Read_Index; 
+*           if set, only proceed if 'GRIB' starts exactly at the given 
+*           byte offset;
+*      (O)  GRIB_HDR *gh;
+*           empty upon entry;  to hold the Message found and its info;
+*      (O)  char *errmsg;
+*           empty array, only filled if error occurred;
+*
+*    RETURN CODE:  
+*      0> no errors, may or may not have a valid message;
+*	  If no Msg was Found: 
+*          a)  errmsg will hold the Warning msg;
+*	   If a valid Msg was Found: 
+*	   a) long *offset: if succesful, gets updated to absolute 
+*             beginning of Mesg;
+*          b) struct GRIB_HDR holds its info:
+*            entire_msg:  is assigned to newly MAlloced 
+*                    unsigned char * array to hold entire message;
+*	     msg_length:  size of entire_msg array in bytes;
+*	     ids_len, pds_len, gds_len, bms_len, bds_len, eds_len:
+*                    size of each defined sections in bytes;
+*            ids_ptr:  pts to message's Ident Data Sect;
+*            pds_ptr:  pts to message's Prod Defn Sect;
+*            gds_ptr:  pts to message's Grid Defn Sect;
+*            bms_ptr:  pts to message's Bitmap Defn Sect;
+*            bds_ptr:  pts to message's Binary Data Sect;
+*            eds_ptr:  pts to message's End Data Sect;
+*         c) errmsg remains empty;
+*      1> fseek/fread error, all ptrs in grib_hdr set to null; errmsg filled;
+*      2> got end of file, all ptrs in grib_hdr set to null; errmsg filled;
+*      3> Null entire_msg pointer; errmsg filled;
+*      4> unable to open input file; errmsg filled;
+*
+**********************************************************************
+*/
+
+#if PROTOTYPE_NEEDED
+int 	grib_seek (	char *InFile, long *offset, int Read_Index, 
+			GRIB_HDR *gh, char *errmsg)
+#else
+int	grib_seek (InFile, offset, Read_Index,gh,errmsg)
+			char *InFile; 
+			long *offset; 
+			int Read_Index; 
+			GRIB_HDR *gh;
+			char *errmsg;
+#endif
+{
+   char *func="grib_seek";
+   FILE  *fp=NULL;
+   int status=0;
+
+   DPRINT3 ("Entering %s\nfile=%s, offs=%ld \n", func, InFile, *offset);
+
+/*
+*
+* A.2       OPEN Input file 
+*           IF (fails) RETURN w/ error stat 4 !errmsg filled
+*/
+   if ((fp = fopen (InFile, "rb")) == NULL) {
+     DPRINT2 ("%s: Cannot open input file %s\n", func,InFile );
+     sprintf (errmsg,"%s: Cannot open input file '%s'\n", func,InFile );
+     status = 4;
+     goto DONE;
+   }
+
+   status = grib_fseek(fp,offset,Read_Index,gh,errmsg);
+
+DONE:
+/*
+*
+* A.4        CLOSE input file;     !get here when found no messages
+*
+*/
+   if (fp) fclose(fp); 
+
+/*
+* A.6        RETURN with status 
+*/
+   return (status); 
+
+}
+
+
+
+#if PROTOTYPE_NEEDED
+int 	grib_fseek (	FILE *fp, long *offset, int Read_Index, 
+			GRIB_HDR *gh, char *errmsg)
+#else
+int	grib_fseek (fp, offset, Read_Index,gh,errmsg)
+			FILE *fp; 
+			long *offset; 
+			int Read_Index; 
+			GRIB_HDR *gh;
+			char *errmsg;
+#endif
+ {
+   char *func="grib_fseek";
+   char  *GG, sm_blk[5004], *fwa_msg=NULL;
+   unsigned long lMessageSize;
+   unsigned long Edition;
+   long pos;            /* current byte offs fr. beg. of file */
+   int bytenum;         /* Index w/in sm_blk */
+   int bytestoread=5004; /* #bytes to read into sm_blk at a time */
+   int check_limit;     /* #bytes in sm_blk to check */ 
+   int gotone = 0;	/* set if found good msg */
+   int nread;           /* #bytes got back from Read */
+   int status;
+   unsigned long iskip;           /* for getbyte */
+   int gdsbmsflag, bit_set, sect_len; /* working vars */
+   char *ptr, *end_ptr;
+
+   DPRINT2 ("Entering %s\n, offs=%ld \n", func, *offset);
+/*
+* A.1       INIT variables
+*           !gh structure is cleared out
+*/
+   if (gh->entire_msg==NULL) {
+	DPRINT1 ( "%s:  expecting non-null Grib Hdr;\n",func);
+	sprintf(errmsg, "%s:  expecting non-NULL Grib Hdr;\n",func);
+	status= 3;  
+	goto DONE;
+	}
+
+   gh->msg_length = 0;
+   gh->ids_ptr=gh->pds_ptr= 0;
+   gh->gds_ptr=gh->bms_ptr=gh->bds_ptr=gh->eds_ptr=0;
+   memset ((void *)gh->entire_msg, '\0', gh->abs_size);
+   DPRINT2 ("gh= %ld, gh->entire_msg=%ld\n", gh, gh->entire_msg);
+
+/*
+*
+* A.3       FOR (loop while no error)     !read a block at a time
+*/
+   
+   for (status=0, pos= *offset, gotone= 0; status == 0; pos += check_limit)
+   {
+/*
+* A.3.1        IF (cannot SET file position to correct place)
+*              THEN
+*                 SET Status to 1 !fseek err
+*                 CONTINUE (Loop around to A.3)
+*              ENDIF
+*/
+     if (fseek(fp, pos, 0)!=0) { 
+	DPRINT2 ("%s: Got fseek error to pos= %ld\n",func, pos);
+	sprintf(errmsg,"%s: Got fseek error to pos= %ld\n",func,pos);
+	perror("");
+	status = 1; 
+	goto DONE; 
+	}
+
+/*
+* A.3.2        IF (read less than 40 bytes)
+*              THEN
+*                 FILL error buffer
+*                 RETURN status 2  !eof or <40 bytes left, errmsg filled
+*              ENDIF
+*/
+     nread= fread (sm_blk,sizeof(char), bytestoread,fp);
+     if (nread <= 40) 
+	{ 
+	  if (nread<=4) {
+		DPRINT0 ("No bytes left to check for msg;\n"); 
+		/* Errmsg left blank cuz its just EOF */
+		}
+	  else {
+	    sprintf(errmsg,"%s: skip last %d bytes, too few for a Msg\n",
+	    func, nread);
+	    DPRINT1 ("Only read %d bytes, too few to check for msg;\n",nread); 
+	    }
+	  status= 2; 
+	  goto DONE; 
+	}
+     else check_limit= nread - 4; 
+
+/*
+*              ! search block for the next the 'G'
+*              ! load entire Msg if everything is ok;
+*              ! if No 'G' found, then quit right away if no 'G'
+*              ! if GRIB is not at absolute Offset address, quit too;
+*              ! 
+* A.3.3        WHILE (there is another 'G' in this block) DO
+*/
+     bytenum= 0;
+     while ((GG= (char *) memchr (sm_blk, 'G', check_limit)))
+	{
+/*--- Saw 'G' ---*/
+/*
+* A.3.3.1          IF ('RIB' is not after 'G') THEN
+*                     IF (Offset from Index file) THEN  
+*                        ABORT search;   !Break out of loop
+*                     ELSE
+*                        CLEAR out the 'G' in temp block
+*                        CONTINUE  !Loop around to A.3.3
+*                     ENDIF
+*                  ENDIF
+*/
+	   if (strncmp(GG, "GRIB",4))    /* not 'RIB' after the 'G' */
+		if ( Read_Index) 
+		   break;     /* Offset IS from Indexfile:  Quit here */
+		else  
+		{	      /* offset is NOT fr. IndexFile:  keep looping; */
+		   *GG='-';   /* no RIB after G, clear it 		*/
+		   continue;  /* let Memchr find next G in block      	*/
+		}
+
+/*--- Saw 'G R I B' ----*/
+/*
+* A.3.3.2           CALCULATE byte position within this block
+*                   where this message begins
+*/
+	   bytenum = GG - sm_blk;  /* byte pos w/in this block */
+
+/*
+* A.3.3.3           IF (offset is from Indexfile  AND
+*                       string GRIB found is not at Absolute IndexFile's offset)
+*                   THEN abort search; ENDIF
+*/
+	  DPRINT1 ("Found string 'GRIB' at %ld\n", pos+bytenum);
+	  if (Read_Index &&  *offset != (bytenum + pos))  {
+	      sprintf(errmsg,
+	      "%s:   No Grib msg found at offset= %ld;  check Index File\n",
+	      func, *offset);
+	      break;		/* Abort here, Ret w/ no errros & no msg too */
+	    }
+
+/*--- Read Mesg Length, Edition ---*/
+/*
+* A.3.3.4          FUNCTION gbyte !extract lMessageSize
+*/
+	  iskip=32;
+          gbyte (sm_blk+bytenum ,&lMessageSize, &iskip,24);
+          DPRINT0 ("lMessageSize\n");
+
+/*--- Make sure it's Edition 1 first ---*/
+/*
+* A.3.3.5          FUNCTION gbyte !extract Grib Edition Number
+*                  IF (not edition 1) THEN
+*                      CLEAR out the 'G' in temp block
+*                      CONTINUE  !Loop around to A.3.3
+*                  ENDIF
+*/
+	  gbyte (sm_blk+bytenum, &Edition, &iskip, 8);
+	  DPRINT0 ("Edition\n");
+	  if (Edition != 1) {
+	      DPRINT1 ("Edition (%d) is not 1, start over\n",
+	      Edition);
+              *GG='-';   /* blank out G of current GRIB location found */
+              continue;  /* let Memchr find next G in block        */
+	   }
+
+
+/*
+* A.3.3.6          IF (cannot MOVE ptr to start of the message) THEN
+*                     RETURN status 1   !errmsg filled
+*                  ENDIF
+*/
+          if (fseek(fp, (long)(pos+bytenum), 0)!=0) {
+		DPRINT2 (
+		"%s: FSEEK error to pos+bytenum= %ld\n",
+		func, pos+bytenum);
+		sprintf(errmsg,
+		"%s: FSEEK error to pos+bytenum= %ld\n",
+		func, pos+bytenum);
+		status= 1;
+		goto DONE;
+		}
+
+/*
+* A.3.3.7          INIT all section length to zero
+*/
+	  gh->ids_len= gh->pds_len= gh->gds_len= 0;
+	  gh->bds_len= gh->bms_len= gh->eds_len= 0;
+
+/*
+* A.3.3.8          EXPAND Entire_Msg array if it's smaller than msglen
+*                  RETURN Malloc Err (stat=2) if fails  !errmsg filled
+*/
+	   if (lMessageSize > gh->abs_size  ) {
+	      
+/* 	      if (realloc((void *)gh->entire_msg, lMessageSize) == NULL) {..}
+*	      gh->abs_size = lMessageSize;
+*/
+	      if (Expand_gribhdr (gh, lMessageSize, errmsg)) {
+	          upd_child_errmsg (func, errmsg);
+		  status = 1;   /* to get out of Outer loop */
+		  goto DONE;
+	       }
+
+	      DPRINT1 ("Expanded entire_msg to be %ld bytes long\n",
+	      gh->abs_size);
+      	    } /* size changed */
+
+/*--- READ ENTIRE MSG into GRIB HEADER's Entire_Msg ---*/
+/*
+*
+* A.3.3.9          READ the entire message into Grib Hdr's Entire_Msg;
+*                  IF (failed) THEN
+*                      RETURN Fread error stat=1  !errmsg filled
+*                  ENDIF
+*/
+	  fwa_msg = (char *)gh->entire_msg;
+          if ((nread=fread (fwa_msg, 1, lMessageSize, fp)) != lMessageSize) 
+	    {
+            DPRINT2 ( "%s:  failed to Fread EntireMsg (sz=%ld)\n",
+	    func, lMessageSize);
+	    sprintf(errmsg,
+            "%s has truncated msg @offs=%ld (got %ld out of %ld bytes)\n",
+            func, *offset, nread, lMessageSize);
+	    status= 1;  /* to get out of Outer loop */
+	    goto DONE;  /* get out of WHILE */
+	    }
+
+/*--- if see '7777', asssign GH's pointers & len  ---*/
+/*
+* A.3.3.10         IF ('7777' is where expected) THEN
+*/
+          if (!strncmp((fwa_msg + lMessageSize - 4),"7777",4))
+		/*  && fwa_msg[7]==1)  */
+	  {  
+ 	        end_ptr = fwa_msg + lMessageSize;
+
+		DPRINT0 ("Found string '7777' where expected\n");
+		gh->msg_length= lMessageSize;
+/*
+* A.3.3.10.a.1         STORE loc & len of section 0 into Grib Hdr;
+*/
+		gh->ids_ptr= (unsigned char *)fwa_msg;    /* mark sect 0 */
+		gh->ids_len= 8L;
+
+/*
+* A.3.3.10.a.2         STORE loc & len of PDS into Grib Hdr; 
+*                     FUNCTION gbyte   !get 3-byte length
+*/
+	        ptr=  fwa_msg + gh->ids_len;
+		gh->pds_ptr= (unsigned char *)ptr;            /* mark PDS */
+		iskip= 0; gbyte(ptr ,(unsigned long *)&gh->pds_len,&iskip,24); 
+		DPRINT0 (" pds length\n");
+		iskip= 8*7; gbyte(ptr ,(unsigned long*)&gdsbmsflag, &iskip, 8);
+		DPRINT1 (" (%x hex) Gds/Bms flag\n", gdsbmsflag);
+/*
+* A.3.3.10.a.3         IF (location of next Section  is out of bound) THEN
+*                        PRINT message;
+*                        GOTO drop this msg;
+*                     ENDIF
+*/
+		ptr += gh->pds_len;
+	        if (ptr > end_ptr) {
+		    sprintf(errmsg,
+		    "%s:  corrupt PDSlen= %ld, Totlen=%ld, drop msg @%ld;\n"
+		    , func,  gh->pds_len, gh->msg_length, *offset);
+		    gh->pds_len= 0;  		     /* reset */
+		    goto DROPMSG_N_LOOP;
+		    }
+
+/*
+*                     IF (Debug) FUNCTION hdr_print  !print PDS
+*/
+	        DPRINT1 ("gh->pds_len= %ld\n", gh->pds_len);
+		HDR_PRINT("Grib_Seek's PDS",gh->pds_ptr, gh->pds_len);
+
+/*
+* A.3.3.10.a.4         IF (GDS is present) THEN
+*                        STORE location & len of GDS into Grib Hdr's Gds_Ptr
+*                        FUNCTION gbyte   !get 3-byte length
+*                        IF (location of next Section  is out of bound) THEN
+*                           PRINT message;
+*                           DROP this msg & try to find another;
+*                        ENDIF
+*                        IF (Debug) FUNCTION hdr_print  !print GDS
+*                     ENDIF
+*/
+		bit_set= gdsbmsflag >> 7 & 1;	/* mark GDS if present */
+		if (bit_set) {
+		    gh->gds_ptr= (unsigned char *)ptr;
+		    iskip= 0; gbyte(ptr,(unsigned long*)&gh->gds_len,&iskip,24);
+		    DPRINT0 (" Gds length\n");
+		    ptr += gh->gds_len;	/* bump PTR to sect*/
+	             if (ptr > end_ptr) {
+		       sprintf(errmsg,
+     		       "%s: corrupt GDSlen= %ld, Totlen=%ld, drop msg @%ld\n"
+		        , func,  gh->gds_len, gh->msg_length, *offset);
+		        gh->gds_len= 0;  		/* reset */
+		        goto DROPMSG_N_LOOP;
+     		        }
+		       DPRINT1 ("gh->gds_len= %ld\n", gh->gds_len);
+		       HDR_PRINT("Grib_Seek's GDS",gh->gds_ptr,gh->gds_len);
+		    }
+
+/*
+* A.3.3.10.a.5         IF (BMS is present) THEN
+*                        STORE location & len of BMS into Grib Hdr's Bms_Ptr
+*                        FUNCTION gbyte   !get 3-byte length
+*                        IF (location of next Section  is out of bound) THEN
+*                           PRINT message;
+*                           DROP this msg & try to find another;
+*                        ENDIF
+*                        IF (Debug) FUNCTION hdr_print   !byte dump
+*                     ENDIF 
+*/
+		bit_set= gdsbmsflag >> 6 & 1;	/* mark BMS if present */
+		if (bit_set) {
+		    gh->bms_ptr= (unsigned char *)ptr; 	
+		    iskip= 0; gbyte(ptr,(unsigned long*)&gh->bms_len,&iskip,24); 
+		    DPRINT0 (" Bms length\n");
+
+		    ptr += gh->bms_len;		/* bump PTR to sect */
+	            if (ptr > end_ptr) {
+		       sprintf(errmsg,
+		       "%s: corrupt BMSlen= %ld, Totlen=%ld, drop msg @%ld\n"
+			, func, gh->bms_len, gh->msg_length, *offset);
+		        gh->bms_len= 0;  		/* reset */
+		        goto DROPMSG_N_LOOP;
+     		        }
+		     DPRINT1 ("gh->bms_len= %ld\n", gh->bms_len);
+		     HDR_PRINT ("Grib_Seek's BMS", gh->bms_ptr, 
+				(gh->bms_len>100? 100: gh->bms_len));
+		  }
+/*
+* A.3.3.10.a.6        STORE location and length of BDS into Grib Hdr's Bds_Ptr
+*                    FUNCTION gbyte !get 3-byte length
+*                    IF (location of next Section  is out of bound) THEN
+*                        PRINT message;
+*                        DROP this msg & try to find another;
+*                    ENDIF
+*                    IF (Debug) FUNCTION hdr_print   !byte dump
+*/
+
+		gh->bds_ptr= (unsigned char *)ptr; 	/* mark BDS */
+		iskip= 0; gbyte(ptr,(unsigned long*)&gh->bds_len,&iskip,24);
+		DPRINT0 (" Bds length\n");
+
+		ptr += gh->bds_len;
+	        if (ptr > end_ptr) {
+		    sprintf(errmsg,
+		    "%s:  corrupt BDSlen= %ld, Totlen=%ld, drop msg @%ld\n"
+		    , func, gh->gds_len, gh->msg_length, *offset);
+		    gh->gds_len= 0;  /* reset */
+		    goto DROPMSG_N_LOOP;
+		    }
+		    DPRINT1 ("gh->bds_len= %ld\n", gh->bds_len);
+	  	    HDR_PRINT ("Grib_Seek's BDS", gh->bds_ptr, 
+			(gh->bds_len>100? 100: gh->bds_len));
+
+/*
+* A.3.3.10.a.7        STORE location & len of EDS into Grib Hdr's Eds_Ptr
+*/
+		gh->eds_ptr= (unsigned char *)ptr;  /* mark EDS */
+		gh->eds_len= 4;   
+
+/*
+* A.3.3.10.a.8        SET 'gotone' flag 
+*                    ! Return with Msg in Grib hdr, and good stat
+*/
+	    	gotone=1; 	/* to get out of FOR loop */
+		status=0; 	/* Return with Msg , good stat */
+	        goto DONE; 
+/*
+* A.3.3.10          ENDIF 
+*/
+	   } /* saw 77s  */
+	else 
+	if (Read_Index) {
+		sprintf(errmsg,
+		"%s:  no 7777 found for msg at %ld, check indexfile\n",
+		func, *offset);
+		}
+
+/*
+*
+*          !====================================================
+*          ! Drop Msg Area:   Only get here if :
+*          ! - first G found not at Indexfile's offset;
+*          ! - no RIB after G;
+*          ! - GRIB string found not at Indexfile's offset;
+*          ! - no 7777 at expected offset;
+*          ! - got Corrupted Length; 
+*          !====================================================
+*/
+DROPMSG_N_LOOP:
+	   /* ERRMSG must already be loaded and the corrupted len reset to 0
+	      so that Display GH won't go out of bound...
+	    */
+	   DPRINT1 ("\nDropping, cause=> %s\n", errmsg);
+
+/*
+* A.3.3.11         IF (Debug mode) THEN 
+*                     FUNCTION display_gribhdr    !show what got loaded sofar
+*                  ENDIF
+*/
+	  if (gh->msg_length > 0) 
+	  DISPLAY_GRIBHDR(gh); /* before dropping msg*/
+
+/*
+*                  ! no message found yet, OR Msg Section lens are corrupted 
+* A.3.3.12         CLEAR out header struct   !data in array is not valid
+*/      
+   	  gh->msg_length =0;
+	  gh->ids_ptr=gh->pds_ptr= gh->eds_ptr=0;
+   	  gh->gds_ptr=gh->bms_ptr=gh->bds_ptr= 0;
+   	  memset ((void *)gh->entire_msg, '\0', gh->abs_size);
+
+/*
+* A.3.3.13         IF (Offset was read from Indexfile)   !quit searching
+* A.3.3.13.a       THEN
+*                      PUT Error msg in buffer
+*                      RETURN with No Error status
+* A.3.3.13.b       ELSE
+*                      CLEAR out 'G' in tmp block        !go find next 'G' 
+*                  ENDIF
+*/
+	  if (Read_Index) {
+	      status = 0; 	/* Ret w/ no errors     */
+	      goto DONE;	/* send CAUSE back in Errmsg */
+	     }
+	  else {
+	     *GG='-';    /* let Memchr find next 'G' in curr. block */
+	     DPRINT1 ("'GRIB' at location %ld is not a valid message\n",
+	     bytenum+pos);
+	     errmsg[0]='\0';  /* clear out buff */
+	     }
+/*
+* A.3.3         ENDWHILE 
+*/
+     }  /* WHILE seeing 'G'*/
+
+
+     if (Read_Index) {  /* Catch 3 cases:
+			 - if no 'G' at all ;
+			 - if no RIB after G ;
+			 - if found GRIB but not at expected place
+			*/
+	   sprintf(errmsg,
+	   "%s:  No Grib Msg found at IndexFile's offset = %ld; "\
+	   " Check Index File\n" , func, *offset);
+	   status = 0;  /* Return w/no errors  */
+	   goto DONE;	/* but w/ Warn Msg in buff*/
+	}
+
+/*
+A.3.4           DEBUG print  !no Sect0 found in this block
+*/
+      DPRINT2 ("No Section 0 found between address %ld and %ld\n", 
+      pos, pos+check_limit);
+/*
+*
+* A.3       ENDFOR    !Outer Loop,  stay until Status changes
+*/
+  }  /* check entire file */
+
+
+
+DONE:
+
+/*
+* 
+* A.5        IF (found a msg) THEN
+*                BUMP caller's Offset to absolute Begining of Msg found;
+*                DEBUG Print
+*            ENDIF
+*/
+   if (gotone)  
+       {
+       *offset = (long)(pos+bytenum);  /* bump offset to abs. beg. of Msg */
+       DPRINT3 ("Exiting %s w/stat=%d, offs=%d, msg in GRIB_HDR\n", 
+	func, status, *offset);
+       }
+   else DPRINT2 ("Exiting %s w/stat=%d, no messages\n", func, status);
+
+/*
+* A.6        RETURN with status 
+*/
+   return (status); 
+/*
+*
+* END OF FUNCTION
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_uthin.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_uthin.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/grib_uthin.c	(revision 2744)
@@ -0,0 +1,71 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+/*****************************************************************************
+ *
+ * This function "unthins" thinned grib grids.
+ * Todd Hutchinson
+ * 9/24/99
+ * tahutchinson@tasc.com
+ *
+ * Interface:
+ *   Input:
+ *     *in       - 1-d array holding input grib data (an irregular thinned 
+ *                 grid)
+ *     *rowsizes - an array holding the sizes of the thinned rows
+ *     ysize     - the number of rows
+ * 
+ *   Ouput:
+ *     *out      - 1-d array holding output grid (a rectangular unthinned grid)
+ *     *xsize    - the number of columns in the output array
+ *   
+ *   Return value
+ *      1 for success, <0 for failure
+ ******************************************************************************/
+
+int grib_unthin(float *in,float *out,int *rowsizes, int ysize, int *xsize)
+{  
+  int in_index = 0;
+  int out_index = 0;
+  int inrow_index;
+  float a, b;
+  int i, j;
+  float weight;
+
+  /* Find maximum value */
+  *xsize = 0;
+  for (j = 0; j<ysize; j++) {
+    if (rowsizes[j] > *xsize) {
+      *xsize = rowsizes[j];
+    }
+  }
+
+  for (j=0; j<ysize; j++) {
+    inrow_index = 0;
+    for (i=0; i<*xsize; i++) {
+      if (rowsizes[j] == *xsize) {
+	out[out_index] = in[in_index];
+	in_index++;
+	out_index++;
+      } else {
+	b = (((float)(*xsize)-1)/((float)rowsizes[j]-1))*(inrow_index+1);
+	if (i >= b) {
+	  inrow_index++;
+	  b = (((float)(*xsize)-1)/((float)rowsizes[j]-1))*(inrow_index+1);
+	  in_index++;
+	}
+	a = (((float)(*xsize)-1)/((float)rowsizes[j]-1))*(inrow_index);
+	weight = (i - a)/(b-a);
+	if (weight == 0) out[out_index] = in[in_index];
+	else 
+	  out[out_index] = in[in_index]+weight*(in[in_index+1]-in[in_index]);
+	out_index++;
+	/* Advance to next row */
+	if (i == (*xsize - 1)) in_index++;
+      }
+    }
+  }
+
+  return 1;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribfuncs.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribfuncs.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribfuncs.h	(revision 2744)
@@ -0,0 +1,119 @@
+#include <stdio.h>
+#include "grib.h"	/* all gribs structs */
+#include "input.h"	/* GEOM+IN, DATA+INPUT, USER_INPUT */
+
+/* check Compiler,  prototypes needed for ANSI-C */
+
+/*#if defined( __cplusplus ) || defined( __STDC__ ) || defined( __GNUC__ )*/
+/* Changed by Todd Hutchinson to force the need for PROTOTYPE */
+#if 1
+
+#define PROTOTYPE_NEEDED 1
+
+int Expand_gribhdr (GRIB_HDR *, long, char *);
+int prt_badmsg (GRIB_HDR  *gh, char *errmsg);
+int make_grib_log (char *,char *,unsigned long,long,PDS_INPUT,
+		grid_desc_sec,BDS_HEAD_INPUT,BMS_INPUT,float *,char *);
+int FTP_getfile (char *,char *,char *);
+int apply_bitmap (BMS_INPUT *,float **,float,BDS_HEAD_INPUT *,char *);
+int create_inpLambert (GEOM_IN,void **,char *);
+int create_inpLatlon (GEOM_IN,void **,char *);
+void create_inpPDS (DATA_INPUT,USER_INPUT,PDS_INPUT *);
+int create_inpPolar  (GEOM_IN,void **,char *);
+void display_gribhdr (GRIB_HDR *hdr);
+void free_gribhdr (GRIB_HDR **);
+void gbyte (char *,unsigned long *,unsigned long *,unsigned long);
+void gbyte_quiet (char *,unsigned long *,unsigned long *,unsigned long);
+int grib_dec (char *,PDS_INPUT *,grid_desc_sec *,BDS_HEAD_INPUT *,
+		BMS_INPUT *,float **,char *);
+int grib_enc (DATA_INPUT,USER_INPUT,GEOM_IN,float *,GRIB_HDR *,char *);
+float grib_ibm_local(unsigned long ibm_float);
+int grib_seek (char *,long *,int,GRIB_HDR *,char *);
+int gribgetbds (char *,short,BMS_INPUT *,grid_desc_sec *,float **,
+		BDS_HEAD_INPUT *, char *);
+int gribgetbms (char *,BMS_INPUT *,int,unsigned long,char *);
+int gribgetgds (char *,grid_desc_sec *,char *);
+int gribgetpds (char *,PDS_INPUT *,char *);
+int gribhdr2file (GRIB_HDR *,FILE *,char *);
+int gribputbds (USER_INPUT,long,short,float *,BDS_HEAD_INPUT *,
+		GRIB_HDR **,char *);
+int gribputgds (GEOM_IN,GDS_HEAD_INPUT *,void **,GRIB_HDR **,char *);
+int gribputpds(DATA_INPUT,USER_INPUT,PDS_INPUT *,GRIB_HDR**,char *);
+void hdr_print (char *,unsigned char *,int );
+void init_dec_struct (PDS_INPUT *,grid_desc_sec *,BMS_INPUT *,BDS_HEAD_INPUT *);
+void init_enc_struct (DATA_INPUT *,GEOM_IN *,USER_INPUT *);
+int init_gribhdr (GRIB_HDR **,char *);
+void init_struct (void *, int);
+int inp2Grib_Lambert (void **,LAMBERT *,long *,char *);
+int inp2grib_Latlon (void **,LATLON *,long *,char *);
+int inp2grib_PDS (PDS_INPUT *,PDS_GRIB **,char *);
+int inp2grib_PolarSt (void **,POLAR  *,long *,char *);
+int ld_dec_lookup (char *,char *);
+int ld_enc_config (char *,USER_INPUT *,char *);
+int ld_enc_ffinfo (char *, DATA_INPUT *,char *);
+int ld_enc_geomfile (char *,GEOM_IN *,char *);
+int ld_enc_ieeeff (char *,float *,int,char *);
+int ld_enc_lookup (char *,char *);
+int ld_grib_origctrs (char *,char *,char *);
+unsigned long grib_local_ibm (double local_float);
+void make_default_grbfn (DATA_INPUT,USER_INPUT,char *);
+int map_lvl (char *,DATA_INPUT *,float *,float *,char *);
+int map_parm (char *,DATA_INPUT *,float *,float *,char *);
+int pack_spatial (long *,unsigned short *,float *,float *,
+		unsigned long **,short,long *,char *);
+void prt_inp_struct (PDS_INPUT *,grid_desc_sec *, BMS_INPUT *,
+		struct BDS_HEAD_INPUT *,float **);
+void upd_child_errmsg (char *,char *);
+void w3ft33_(float *ain,float **out, int *nsflag);
+#else
+#define PROTOTYPE_NEEDED 0
+
+int Expand_gribhdr ();
+int prt_badmsg ();
+int  make_grib_log ();
+int FTP_getfile  ();
+int apply_bitmap ();
+int create_inpLambert ();
+int create_inpLatlon  ();
+void create_inpPDS ();
+int create_inpPolar   ();
+void display_gribhdr ();
+void free_gribhdr ();
+void gbyte ();
+void gbyte_quiet ();
+int grib_dec ();
+int grib_enc ();
+float grib_ibm_local();
+int grib_seek ();
+int gribgetbds ();
+int gribgetbms ();
+int gribgetgds ();
+int gribgetpds ();
+int gribhdr2file ();
+int gribputbds ( );
+int gribputgds ();
+int gribputpds();
+void hdr_print ();
+void init_dec_struct ();
+void init_enc_struct ();
+int init_gribhdr ();
+void init_struct ();
+int inp2Grib_Lambert ();
+int inp2grib_Latlon  ();
+int inp2grib_PDS ();
+int inp2grib_PolarSt ();
+int ld_dec_lookup ();
+int ld_enc_config ();
+int ld_enc_ffinfo ();
+int ld_enc_geomfile ();
+int ld_enc_ieeeff ();
+int ld_enc_lookup ();
+int ld_grib_origctrs ();
+unsigned long grib_local_ibm ();
+void make_default_grbfn ();
+int map_lvl ();
+int map_parm ();
+int pack_spatial ();
+void prt_inp_struct ();
+void upd_child_errmsg ();
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetbds.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetbds.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetbds.c	(revision 2744)
@@ -0,0 +1,439 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h> 
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+/*
+  REVISION/MODIFICATION HISTORY:
+       03/07/94 written by Mugur Georgescu CSC, Monterey CA
+       02/01/96 modified by Steve Lowe SAIC, Monterey CA
+       04/17/96 modified by Alice Nakajima SAIC, Monterey CA
+       06/19/96 add hdrprint;/nakajima
+* 
+* ********************************************************************
+* A.  FUNCTION:  gribgetbds 
+*       decodes the Binary Data Section of the GRIB message 
+*       and filling grib_data float array.
+*
+*    INTERFACE:
+*       int gribgetbds (curr_ptr, deci_scale, bms, gds, 
+*                       ppgrib_data, bds_head, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *curr_ptr;
+*           points to first Octet of the BDS to be decoded;
+*      (I)  short  deci_scale;
+*           decimal scaling factor to be applied to data;
+*      (I)  BMS_INPUT *bms;
+*           points to the decoded internal Bit Map Section Struct 
+*      (I/O) grid_desc_sec *gds
+*           points to decoded internal grid definition struct
+*      (O)  float **ppgrib_data;
+*           double pointer to array of float, null upon entry;
+*           upon successful exit, holds the unpacked and restored float data
+*           in a newly malloced array;
+*      (O)  BDS_HEAD_INPUT *bds_head; 
+*           points to Binary Data Sect hdr struct, empty upon entry;
+*           to be filled with decoded BDS info;
+*      (O)  char  *errmsg;
+*           Only returned filled when error occurred;
+*
+*      RETURN CODE:
+*        0>   no errors
+*        1>   unrecognized packing algorithm
+*        2>   number of points does not match bitmap
+*        3>   number of points does not match grid size in GDS
+*        4>   malloc error
+* ********************************************************************
+*/
+
+#if PROTOTYPE_NEEDED
+int gribgetbds ( char *curr_ptr, short  deci_scale, BMS_INPUT *bms,
+        grid_desc_sec *gds, float **ppgrib_data,
+        BDS_HEAD_INPUT *bds_head, char  *errmsg)
+#else
+int gribgetbds (curr_ptr, deci_scale, bms, gds, ppgrib_data, 
+		bds_head, errmsg)
+		char *curr_ptr; 
+		short  deci_scale; 
+		BMS_INPUT *bms;
+		grid_desc_sec *gds;
+		float **ppgrib_data; 
+		BDS_HEAD_INPUT *bds_head; 
+		char  *errmsg;
+#endif
+{
+char *func="gribgetbds";
+char *in = curr_ptr;      /* pointer to beginning of BDS */
+long length;              /* size of the Binary Data Section */
+long scale;               /* scaling factor */
+float ref_val;            /* reference value (minimum value) */
+unsigned long something;  /* generic value from message */
+long data_width;          /* number of bits that data occupies */
+int halfBYTE4;            /* the first 4 bits in 4-th byte */
+int status=0;
+int sign;                 /* sign + or - */
+float dscale;             /* 10 to the decimal scaling power */
+float bscale;             /* 2 to the binary scaling power   */
+unsigned long skip=0;              /* number of bits to be skipped */
+long c_ristic;            /* characteristic for float representation */
+long mantissa;            /* mantissa for float representation */
+long numpts;              /* number of bits left at end of bitstream */
+unsigned long data_pts;   /* number of data points in bitstream */
+unsigned long num_calc;	  /* temp work var */
+float *grib_data=0;       /* local work array for grid data */
+float fdata=0;            /* data value stored in reference */
+int	i,j;         /* array counter */
+int xsize, ysize; 
+float *outdata;
+
+  DPRINT1 ("Entering %s()\n", func);
+/*
+*
+* A.1       FUNCTION gbyte !get bds length
+*/
+
+  gbyte(in,(unsigned long *) &length,&skip,24);
+  DPRINT0 ("bds_head->length\n");
+  bds_head->length = (unsigned long) length;
+
+/*
+*
+* A.2       FUNCTION gbyte !get BDS flag 
+*/
+  gbyte(in, (unsigned long *) &halfBYTE4, &skip, 4);
+  DPRINT0 ("bds_head->usBDS_flag\n");
+  bds_head->usBDS_flag = (short) halfBYTE4;  /* get BDS Flag (Table 11) */
+
+/*
+*
+* A.3       IF (unsupported packing algorithm)  THEN
+*               RETURN 1
+*           ENDIF
+*/
+  /* need to check on packing algorithm */
+  if (halfBYTE4)  /* unrecognized packing algorithm */
+    {
+     DPRINT1 ("%s:  error, unrecognized packing algorithm\n", func);
+     sprintf(errmsg, "%s:  unrecognized packing algorithm\n", func);
+     status= (1);
+     goto BYE;
+    }
+
+/*
+*
+* A.4       FUNCTION gbyte !get number of unused bits
+*/
+  gbyte(in,(unsigned long *) &numpts,&skip,4); /* get #bits at end of BDS */
+  DPRINT0 ("numpts\n");
+
+/*
+*
+* A.5       FUNCTION gbyte !get Binary Scale Factor
+*/
+  gbyte(in,&something,&skip,16);
+  DPRINT0 ("Sign & bds_head->Bin_sc_fctr\n");
+  sign = (int)(something >> 15) & 1;  /* get sign for scale */
+  scale = (int)(something) & 32767;   /* get scale */
+  if(sign)                            /* scale negative */
+     scale = -scale;                  /* multiply scale by -1 */
+  bds_head->Bin_sc_fctr = (int) scale;  /* get binary scale factor */
+  DPRINT1 ("Binary Scale Factor = %d\n", scale);
+
+/*
+*
+* A.6       CALCULATE Reference value from IBM representation
+*             !FUNCTION gbyte !get the sign of reference
+*             !FUNCTION gbyte !get charateristic
+*             !FUNCTION gbyte !get the mantissa
+*/
+  gbyte(in,&something,&skip,8);
+  DPRINT0 ("Sign & Reference)\n");
+  sign = (int)(something >> 7) & 1; /* get the sign for reference value */
+
+  skip -= 7;
+  gbyte(in,(unsigned long *)&c_ristic,&skip,7); /*characteristic for the float*/
+  DPRINT0 ("c_ristic\n");
+
+  gbyte(in,(unsigned long*)&mantissa,&skip,24); /*mantissa for the float */
+  DPRINT0 ("mantissa\n");
+  c_ristic -= 64;                   /* subtract 64 from characteristic */
+  ref_val = (float) mantissa * (float)(pow(16.0,(double)c_ristic)) * 
+	    (pow(2.0,-24.0));
+  if(sign)                          /* negative reference value */
+     ref_val = -ref_val;            /* multiply ref_val by -1 */
+  bds_head->fReference = (float)ref_val;
+  DPRINT1 ("Reference = %f\n", ref_val);
+
+/*
+*
+* A.7       FUNCTION gbyte !get data width
+*/
+  gbyte(in, (unsigned long*) &data_width,&skip,8);       /* get data width */
+  DPRINT0 ("bds_head->usBit_pack_num\n");
+  bds_head->usBit_pack_num = (short)data_width;
+
+/*
+*
+* A.8       SET Binary and Decimal Scale Factors
+*/
+  /* set binary scale */
+  bscale = (float)pow (2.0,(double) scale);
+
+  /* set decimal scale */
+  dscale = (float)pow (10.0, (double) deci_scale);
+
+  DPRINT2 ("Scaled-up BSF= (2**%d) = %f\n", scale, bscale);
+  DPRINT2 ("Scaled-up DSF= (10**%d) = %f\n", deci_scale,dscale);
+
+/*
+*
+* A.9       IF (data_width is zero) THEN
+*               ! grid contains a constant value
+*               IF expected grid size is invalid THEN
+*                  FORCE grid size of 1
+*               ENDIF
+*               ALLOCATE array for grid of expected grid size
+*               FILL grid with the constant value
+*               RETURN 0 !success
+*           ENDIF
+*/
+  if (!data_width)   /* grid contains constant value, success, all done */
+  {
+/* Used to send back array of 1 element:
+#     bds_head->ulGrid_size = 1;
+#     fdata = (float) (ref_val / dscale);
+#     *ppgrib_data = (float *) malloc(sizeof(float));
+#     **ppgrib_data = fdata;
+*/
+
+     fdata = (float) (ref_val / dscale);
+     if (bds_head->ulGrid_size <= 0) {
+	fprintf(stdout,
+	"WARNING:  gribgetbds detects bad ulGrid_size (%ld); "\
+	"Set to 1 to hold constant value %lf\n", bds_head->ulGrid_size, fdata);
+	bds_head->ulGrid_size = 1;
+	}
+    
+     grib_data =(float *) malloc(bds_head->ulGrid_size * sizeof(float));
+     if (!grib_data) {
+	sprintf(errmsg,
+	"%s: failed to create array[%d] for grid to hold Constant data", 
+	func, bds_head->ulGrid_size);
+	goto BYE;
+	}
+
+     *ppgrib_data = grib_data;		/* store address */
+     for (i=0; i < bds_head->ulGrid_size ; ) 
+	grib_data[i++] = fdata;		/* fill grid with constant val */
+
+     DPRINT3("%s:  grid[%ld] contains convant value %lf\n",
+	func, bds_head->ulGrid_size, fdata);
+
+     status = (0);  /* no errors */
+     goto BYE;
+  }
+
+  /* fill the data array with values from message */
+  /*     - Assume that GDS may not be included so that
+   *         the number of grid points may not be defined.       
+   *     - Compute space to malloc based on BDS length,
+   *         data_width, and numpts.
+   *     - if grid_size from GDS is zero, use
+   *         computed number of points.
+   */
+
+/*
+*
+* A.10      CALCULATE number of data points actually in BDS
+*/
+  num_calc = ((length - 11)*8 - numpts) / data_width;
+
+  /* Check the number of points computed against info in the BMS
+     or GDS, if they are available */
+
+/*
+*
+* A.11      IF (BMS is present and has included bitmap) THEN
+*               IF (#calculated not same as #bits set in BMS) THEN
+*                   RETURN 2
+*               ENDIF
+*/
+
+  if (bms->uslength > 6)
+  {
+      if (bms->ulbits_set != num_calc) {
+	DPRINT3 ("%s:  BMS present, #datapts calculated (%d) " \
+	"not same as BMS's set bits (%d)\n",func, num_calc, bms->ulbits_set);
+
+	sprintf(errmsg,"%s:  BMS present, #datapts calculated (%d) " \
+	"not same as BMS's set bits (%d)\n",func, num_calc, bms->ulbits_set);
+	status= (2); goto BYE;
+	}
+  }
+/*
+* A.11.1    ELSE  !no bms
+*               IF (GDS is present AND
+*                   #calculated not same as GDS's grid size)
+*               THEN
+*                   RETURN 3
+*               ENDIF
+*/
+  
+  else
+    
+  {    
+      if (bds_head->ulGrid_size && bds_head->ulGrid_size != num_calc) {
+	DPRINT0("Averting failure of grid size test\n");
+	/*
+	DPRINT3 ( "%s:  GDS present, #datapts calculated (%d) " \
+	   "not same as GDS's grid size (%d)\n",
+	   func,num_calc,bds_head->ulGrid_size);
+
+	   sprintf(errmsg,"%s:  GDS present, #datapts calculated (%d) " \
+	   "not same as GDS's grid size (%d)\n",
+	   func,num_calc,bds_head->ulGrid_size);
+	   status=(3); goto BYE;
+	*/
+	 }          
+  }
+    
+  
+/*
+* A.11      ENDIF (BMS present)
+*/
+
+  /* Only reach this point if number of points in BDS matches info
+     in BMS or GDS.  This number is unchecked if no BMS or GDS. */
+
+  /* Make sure number of points in BDS is value used for extracting */
+/*
+*
+* A.12      SET #datapoints
+*/
+  bds_head->ulGrid_size = num_calc;
+  data_pts= num_calc;
+
+/*
+*
+* A.13      ALLOCATE storage for float array size
+*           IF (error) THEN
+*               RETURN 4
+*           ENDIF
+*/
+  grib_data =(float *) malloc(data_pts * sizeof(float));
+  if (grib_data==NULL) { 
+	DPRINT1 ("%s: failed to malloc Grib_Data\n",func);
+	sprintf(errmsg,"%s: failed to malloc Grib_Data\n",func);
+	status=(4); goto BYE; }
+
+/*
+*
+* A.14      SET data array pointer to local data array
+*/
+  *ppgrib_data = grib_data;
+
+/*
+*
+* A.15      FOR (each data point) DO
+*               FUNCTION gbyte_quiet   !get data_width bits
+*               INCREMENT skip by data_width
+*               COMPUTE and STORE value in float array
+*           ENDDO
+*/
+
+  DPRINT3 ( "Restore float data by = (float)(%f + X * %f)) / %f;\n",
+  ref_val, bscale, dscale);
+
+  for(i=0;i < data_pts ;i++)  
+     {
+     gbyte_quiet(in,&something,&skip,data_width);
+     grib_data[i]= (float)(ref_val + (something * bscale))/dscale;
+     }
+
+/*
+ * Unthin grid if it is thinned
+ */
+  if (gds->head.thin != NULL) {
+    if ((gds->head.usData_type == LATLON_PRJ) || 
+	(gds->head.usData_type == GAUSS_PRJ) ||
+	(gds->head.usData_type == ROT_LATLON_PRJ) ||
+	(gds->head.usData_type == ROT_GAUSS_PRJ) ||
+	(gds->head.usData_type == STR_LATLON_PRJ) ||
+	(gds->head.usData_type == STR_GAUSS_PRJ) ||
+	(gds->head.usData_type == STR_ROT_LATLON_PRJ) ||
+	(gds->head.usData_type == STR_ROT_GAUSS_PRJ)) {
+      ysize = gds->llg.usNj;
+    } else if (gds->head.usData_type == MERC_PRJ) {
+      ysize = gds->merc.rows;
+    } else if (gds->head.usData_type == POLAR_PRJ) {
+      ysize = gds->pol.usNy;
+    } else if ((gds->head.usData_type == LAMB_PRJ) ||
+	       (gds->head.usData_type == ALBERS_PRJ) ||
+	       (gds->head.usData_type == OBLIQ_LAMB_PRJ)) {
+      ysize = gds->lam.iNy;
+    } else {
+       DPRINT2 ("%s:  unknown datatype=%d\n",func, gds->head.usData_type);
+       sprintf(errmsg,"%s:  unknown datatype=%d\n",func, gds->head.usData_type);
+       status=1;         /* set status to failure */
+    }
+
+    xsize = 0;
+    for (j = 0; j<ysize; j++) {
+      if (gds->head.thin[j] > xsize) {
+	xsize = gds->head.thin[j];
+      }
+    }
+    outdata = (float *)malloc(ysize*xsize*sizeof(float));
+    grib_unthin(grib_data,outdata,gds->head.thin,ysize,
+	  &xsize);
+    free(grib_data);
+    grib_data = (float *)malloc(sizeof(float)*ysize*xsize);
+    *ppgrib_data = grib_data;
+    memcpy(grib_data,outdata,sizeof(float)*ysize*xsize);
+    free(outdata);
+    free(gds->head.thin);
+    gds->head.thin = NULL;
+    if ((gds->head.usData_type == LATLON_PRJ) || 
+	(gds->head.usData_type == GAUSS_PRJ) ||
+	(gds->head.usData_type == ROT_LATLON_PRJ) ||
+	(gds->head.usData_type == ROT_GAUSS_PRJ) ||
+	(gds->head.usData_type == STR_LATLON_PRJ) ||
+	(gds->head.usData_type == STR_GAUSS_PRJ) ||
+	(gds->head.usData_type == STR_ROT_LATLON_PRJ) ||
+	(gds->head.usData_type == STR_ROT_GAUSS_PRJ)) {
+      gds->llg.usNi = xsize;
+      gds->llg.iDi = abs(gds->llg.lLat2 - gds->llg.lLat1)/(xsize-1);
+    } else if (gds->head.usData_type == MERC_PRJ) {
+      gds->merc.cols = xsize;
+    } else if (gds->head.usData_type == POLAR_PRJ) {
+      gds->pol.usNx = xsize;
+    } else if ((gds->head.usData_type == LAMB_PRJ) ||
+	       (gds->head.usData_type == ALBERS_PRJ) ||
+	       (gds->head.usData_type == OBLIQ_LAMB_PRJ)) {
+      gds->lam.iNx = xsize;
+    } else {
+       DPRINT2 ("%s:  unknown datatype=%d\n",func, gds->head.usData_type);
+       sprintf(errmsg,"%s:  unknown datatype=%d\n",func, gds->head.usData_type);
+       status=1;         /* set status to failure */
+    }
+  }
+
+  DPRINT0 ("Sample of first 30 unpacked & restored datapoints=\n");
+  for (i=0; i < 30; i+=5)
+     DPRINT6 ("%03d:  %f %f %f %f %f\n",
+	i, grib_data[i], grib_data[i+1],grib_data[i+2],
+	grib_data[i+3], grib_data[i+4] );
+  
+BYE:
+/*
+*
+* A.16      RETURN Status;
+*/
+  DPRINT2 ("Exiting %s, status=%d\n", func, status);
+  return(status); 
+/* 
+* END OF FUNCTION
+*
+*/
+}    
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetbms.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetbms.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetbms.c	(revision 2744)
@@ -0,0 +1,186 @@
+/*  gribgetbms.c 		June 17, 1996 by Alice Nakajima, SAIC   */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+*
+************************************************************************
+* A.  FUNCTION:   gribgetbms
+*       decode the Bitmap Section from the provided pointer location
+*       and store its info in the internal BMS structure.
+*       Pre-defined Bitmap case is not supported.
+*               
+*    INTERFACE:
+*       int   gribgetbms ( curr_ptr, bms, gds_flag, ulGrid_size, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)   char *curr_ptr;
+*            pointer to location where Bitmap Section to decode is expected;
+*      (O)   BMS_INPUT *bms;
+*            pointer to empty BMS structure; will hold decoded BMS info;
+*      (I)   int gds_flag;      
+*            flag set if GDS is present
+*      (I)   unsigned long ulGrid_size;  
+*            size of grid as in Binary Data Section struct
+*      (O)   char *errmsg
+*            returned filled if error occurred;
+* 
+*     RETURN CODE:
+*     0>  BMS info stored in BMS structure if not using pre-defined bitmap;
+*     1>  error, corrupted bms; msg in errmsg;
+************************************************************************
+*/
+
+#if PROTOTYPE_NEEDED
+int   gribgetbms ( char *curr_ptr, BMS_INPUT *bms, int gds_flag,
+		unsigned long ulGrid_size, char *errmsg)
+#else
+int   gribgetbms (curr_ptr, bms, gds_flag, ulGrid_size, errmsg)
+		char *curr_ptr; 
+		BMS_INPUT *bms; 
+		int gds_flag;
+		unsigned long ulGrid_size; 
+		char *errmsg;
+#endif
+{
+  char *func= "gribgetbms";
+  char  *pp;
+  int totbits,val, bitpos,stopbit;  /* tmp working vars */
+  unsigned long SectLength;       /* message and section size */
+  unsigned long ulvar;		    /* tmp var */
+  unsigned long skip=0;
+
+/*
+*
+* A.0      INIT Status to no error
+*/
+int   status=0;
+
+     DPRINT0 ("Entering gribgetbms():\n");
+/* 
+*
+* A.1      FUNCTION gbyte   !get bitmap length
+*/
+    skip=0;
+    gbyte(curr_ptr,(unsigned long *)&SectLength,&skip,24); 
+    DPRINT0 ("SectLength\n");
+    bms->uslength= (unsigned long) SectLength;
+
+/* 
+*
+* A.2      FUNCTION gbyte   !get number of unused bits
+*/
+    gbyte(curr_ptr,&ulvar,&skip,8); 
+    DPRINT0 ("bms->usUnused_bits\n");
+    bms->usUnused_bits= (unsigned short) ulvar;
+
+/* 
+*
+* A.3      FUNCTION gbyte   !get bitmap id (non-zero for a pre-defined bitmap)
+*/
+    gbyte(curr_ptr,&ulvar,&skip,16); 
+    DPRINT0 ("bms->usBMS_id\n");
+    bms->usBMS_id= (unsigned short) ulvar;
+
+/*
+*
+* A.4      IF (Bitmap follows)   !not a predefined bitmap
+*/
+    if ( bms->uslength > 6)     /* Bitmap follows */
+       {
+
+/* 
+* A.4.1       CALCULATE Num of bits in bitmap
+*/
+         /* = (BMS length)*8 bits - 48 header bits - # of unsused bits */
+         totbits=SectLength*8 - 48 - bms->usUnused_bits;
+
+/*
+* A.4.2       IF (GDS is present AND 
+*                      #bits differs from Grid Size)        !Corrupted BMS
+*                 RETURN 1
+*             ENDIF
+*/
+          if (gds_flag && totbits != ulGrid_size) {
+		DPRINT3( "%s: corrupted BMS, gds_flag set but "\
+		"totbits %d != ulgrid_sz %d\n" 
+		, func, totbits, ulGrid_size);
+
+		sprintf(errmsg, "%s: corrupted BMS, gds_flag set but "\
+		"totbits %d != ulgrid_sz %d\n" , func, totbits, ulGrid_size);
+		status=  (1); /* Corrupted BMS */
+	 	goto BYE;
+		}
+
+/*
+* A.4.3       ASSIGN bitmap pointer to 6th byte of BMS
+*/
+          bms->bit_map =  curr_ptr + 6;
+          pp= bms->bit_map; 
+          bms->ulbits_set= 0; 
+/* 
+*
+* A.4.4       !SUM up total number of bits set
+*             FOR (Each 8-bit block of Total Bits Present in BMS)
+*/
+          for ( ; totbits > 0 ; totbits-=8) 
+          {
+/*
+* A.4.4.1       IF (any of the 8 bits are set) 
+*/
+             if ((val=(int)*pp++) != 0) 
+               {
+
+/*
+* A.4.4.1.1        IF (not within 8 bits of end of bitmap)
+*                      SET stopbit to 0
+*                  ELSE
+*                      SET stopbit to end of bitmap
+*                  ENDIF
+*/
+                 if (totbits > 8) stopbit=0;   /* check all 8 bits */
+                 else stopbit= 7-totbits+1;    /* stop at end of bitmap */
+
+/*
+* A.4.4.1.2        SUM up number of bits set in this BMS byte
+*/
+                 for (bitpos= 7; bitpos >= stopbit; bitpos--)
+                    if (val >> bitpos & 0x0001) bms->ulbits_set += 1;
+/*
+* A.4.4.1       ENDIF  ! any of 8 exists
+*/
+               }
+/*
+* A.4.4     ENDFOR   !each 8-bit loop
+*/
+           }
+/*
+* A.4      ENDIF	!Bitmap follows
+*/
+	}  
+
+/*  else {
+        / * Predefined Bitmap - not supported!! Could add function here 
+	    to load a bitmap from local storage * /
+         bms->uslength=6;	
+         bms->bit_map= Load_predefined_bms (bms->usBMS_id);
+       }
+*/
+
+
+BYE:
+/*
+*
+* A.5     DEBUG Print
+*
+* A.6     RETURN Status 
+*/
+    DPRINT2 ("Exiting %s, Status=%d;\n", func, status);
+    return (status);
+/*
+* END OF FUNCTION
+*/ 
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetgds.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetgds.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetgds.c	(revision 2744)
@@ -0,0 +1,694 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"		/* for dprints & func prototypes  */
+#include "gribfuncs.h"		/* prototypes */
+/*
+  REVISION/MODIFICATION HISTORY:
+       03/07/94 written by Mugur Georgescu CSC, Monterey CA
+       02/01/96 modified by Steve Lowe SAIC, Monterey CA
+       06/19/96 modified by Alice Nakajima SAIC, Monterey CA
+       10/15/97/ATN init usData_type in Projection struct too
+       02/18/98/atn replace projection ids with constants
+*
+******************************************************************* 
+* A.  FUNCTION  gribgetgds 
+*       Decode the Grid Description Section (GDS) from the provided 
+*       pointer location and store its the in the internal GDS structure;
+*
+*    INTERFACE:
+*       int gribgetgds (curr_ptr, gds, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *curr_ptr;        points to 1st octet of GDS
+*      (O)  grid_desc_sec *gds;    internal GDS structure to be filled
+*      (O)  char *errmsg;          returned filled if error occurred
+*
+*    RETURN CODE:
+*       0>  success, struct grid_desc_sec filled;
+*       1>  unsupported projection number, errmsg filled;
+*       2>  section length too short, errmsg filled;
+******************************************************************* 
+*/
+
+#if PROTOTYPE_NEEDED
+int gribgetgds ( char *curr_ptr, grid_desc_sec *gds, char *errmsg)
+#else
+int gribgetgds ( curr_ptr, gds, errmsg)
+		char *curr_ptr; 
+		grid_desc_sec *gds; 
+		char *errmsg;
+#endif
+{
+char *func= "gribgetgds";
+char *in = curr_ptr;      /* pointer to the message */
+unsigned long skip;             /* bits to be skipped */
+unsigned long something;  /* value extracted from message */
+int sign;                 /* sign + or - */
+int status;
+FILE *fp;
+int i;
+ 
+ DPRINT1 ("Entering %s\n", func);
+/*
+*
+* A.0      INIT status to good, skip to 0
+*/
+ status=0;  skip=0;
+/*
+*
+* A.1      FUNCTION gbyte  !GDS length 
+*          IF (length < 32 bytes) THEN
+*             SET error status of 2   !length too short
+*             CONTINUE to load as much info as possible into
+*             structure 'grid_desc_sec' but will return with error
+*          ENDIF
+*/
+ gbyte(in,&something,&skip,24); DPRINT0 ("gds->head.uslength\n");
+ gds->head.uslength = (unsigned short) something;  
+ if (gds->head.uslength < 32) {
+    sprintf(errmsg,
+    "GDS length too short (%ld).  Will attempt to load struct grid_desc_sec\n",
+    gds->head.uslength);
+    status = 2;		/* corrupt length */
+   }
+
+/* 
+*
+* A.2      FUNCTION gbyte  !parm_nv
+*/
+ gbyte(in,&something,&skip,8); DPRINT0 ("gds->head.usNum_v\n");
+ gds->head.usNum_v =(short) something;             
+/* 
+*
+* A.3      FUNCTION gbyte  !parm_pv_pl
+*/
+ gbyte(in,&something,&skip,8); DPRINT0 ("gds->head.usPl_Pv\n");
+ gds->head.usPl_Pv = (short) something;            
+
+/* 
+*
+* A.4      FUNCTION gbyte  !data representation type
+*/
+ gbyte(in,&something,&skip,8); DPRINT0 ("gds->head.usData_type\n");
+ gds->head.usData_type = (short) something;        
+
+/* Remainder of GDS is projection dependent */
+/*
+*
+* A.5      SWITCH (data type)
+*/
+
+ switch(gds->head.usData_type)
+  {
+   case LATLON_PRJ:    	/* Lat/Lon Grid */
+   case GAUSS_PRJ:    	/* Gaussian Latitude/Longitude grid */
+   case ROT_LATLON_PRJ:   	/* Rotated Lat/Lon */
+   case ROT_GAUSS_PRJ:   	/* Rotated Gaussian */
+   case STR_LATLON_PRJ:   	/* Stretched Lat/Lon */
+   case STR_GAUSS_PRJ :   	/* Stretched Gaussian */
+   case STR_ROT_LATLON_PRJ :  /* Stretched and Rotated Lat/Lon */
+   case STR_ROT_GAUSS_PRJ :   /* Stretched and Rotated Gaussian */
+/*
+*           case latlon: 
+*           case gaussian_latlon:
+*           case rotated gaussian:
+*           case stretched latlon:
+*           case stretched gaussian:
+*           case stretched & rotated latlon:
+*           case stretched & rotated gaussian:
+*                 Mark the Projection type 
+*                 FUNCTION gbyte !get Number of Columns
+*/
+       gds->llg.usData_type = gds->head.usData_type;
+
+       gbyte(in, &something, &skip, 16); 
+       DPRINT0 ("gds->llg.usNi\n");
+       gds->llg.usNi = (int) something;                   /* get Ni */
+
+/*
+*                 FUNCTION gbyte !get Number of Rows
+*/
+       gbyte(in, &something, &skip, 16);
+       DPRINT0 ("gds->llg.usNj\n");
+       gds->llg.usNj = (int) something;                   /* get Nj */
+
+/*
+*                 FUNCTION gbyte !get Latitude of First point
+*/
+       gbyte(in,&something,&skip,24);
+       DPRINT0 ("Sign & gds->llg.lLat1 \n");
+       sign = (int)(something >> 23) & 1;                 /* get sign */
+       gds->llg.lLat1 = (long) (something) & 8388607;     /* get La1 */
+       if(sign)                                           /* negative value */
+          gds->llg.lLat1 = - gds->llg.lLat1;              /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get Longitude of First point
+*/
+       gbyte(in,&something,&skip,24);
+       DPRINT0 ("Sign & gds->llg.lLon1 \n");
+       sign = (int)(something >> 23) & 1;                 /* get sign */
+       gds->llg.lLon1 = (long) (something) & 8388607;     /* get Lo1 */
+       if(sign)                                           /* negative value */
+           gds->llg.lLon1 = - gds->llg.lLon1;             /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get resolution & comp flags
+*/
+       gbyte(in,&something,&skip,8);
+       DPRINT0 ("gds->llg.usRes_flag\n");
+       gds->llg.usRes_flag = (short) something;           /* get resolution & comp flags */
+
+       gbyte(in,&something,&skip,24);
+       DPRINT0 ("Sign & gds->llg.lLat2 \n");
+/*
+*                 FUNCTION gbyte !get Latitude of Last point
+*/
+       sign = (int)(something >> 23) & 1;                 /* get sign */
+       gds->llg.lLat2 = (long) (something) & 8388607;     /* get La2 */
+       if(sign)                                           /* negative value */
+          gds->llg.lLat2 = - gds->llg.lLat2;              /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get Longitude of Last point
+*/
+       gbyte(in,&something,&skip,24);
+       DPRINT0 ("Sign & gds->llg.lLon2 \n");
+       sign = (int)(something >> 23) & 1;                 /* get sign */
+       gds->llg.lLon2 = (long) (something) & 8388607;     /* get Lo2 */
+       if(sign)                                           /* negative value */
+          gds->llg.lLon2 = - gds->llg.lLon2;              /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get Longitudinal Increment
+*/
+       gbyte(in,&something,&skip,16);
+       DPRINT0 ("gds->llg.iDi\n");
+       gds->llg.iDi = (int) something;			  /* get Di */
+
+/*
+*                 FUNCTION gbyte !get Latitudinal Increment
+*/
+       gbyte(in,&something,&skip,16);
+       DPRINT0 ("gds->llg.iDj\n");
+       gds->llg.iDj = (int) something;			  /* get Dj */
+
+/*
+*                 FUNCTION gbyte !get scanning mode
+*/
+       gbyte(in,&something,&skip,8);
+       DPRINT0 ("gds->llg.usScan_mode\n");
+       gds->llg.usScan_mode = (short) something;    /* get scaning mode flag */
+
+/*
+*                 FUNCTION gbyte !get reserved octets 29-32
+*/
+       gbyte(in,&something,&skip,32);
+       DPRINT0 ("gds->llg.usZero\n");
+       gds->llg.usZero = (long) something; /* get reserved octets 29 - 32 */
+
+       if (gds->head.usNum_v > 0) {
+/*
+*                 FUNCTION gbyte !get south pole lat
+*/
+	 gbyte(in,&something,&skip,24);
+	 DPRINT0 ("Sign & gds->llg.lLat_southpole \n");
+	 sign = (int)(something >> 23) & 1;                      /* get sign */
+	 gds->llg.lLat_southpole = (long)(something) & 8388607; /* southpole lat*/
+	 if(sign)                                            /* negative value */
+	   gds->llg.lLat_southpole = - gds->llg.lLat_southpole; /* multiply -1 */
+	 
+/*
+*                 FUNCTION gbyte !get south pole lon
+*/
+	 gbyte(in,&something,&skip,24);
+	 DPRINT0 ("Sign & gds->llg.lLon_southpole \n");
+	 sign = (int)(something >> 23) & 1;                      /* get sign */
+	 gds->llg.lLon_southpole =(long)(something) & 8388607; /* southpole lon*/
+	 if(sign)                 /* negative value , multiply by -1 */
+	   gds->llg.lLon_southpole = - gds->llg.lLon_southpole; 
+	 
+/*
+*                 FUNCTION gbyte !angle of rotation
+*/
+	 gbyte(in,&something,&skip,24);
+	 DPRINT0 ("gds->llg.lRotate\n");
+	 gds->llg.lRotate = (long) something;          /* get angle of rotation */
+	 
+/*
+*                 FUNCTION gbyte !get lat pole stretching
+*/
+	 gbyte(in,&something,&skip,24);
+	 DPRINT0 ("Sign & gds->llg.lPole_lat \n");
+	 sign = (int)(something >> 23) & 1;                 /* get sign */
+	 gds->llg.lPole_lat = (long)something & 8388607; /* lat pole stretching */
+	 if(sign)                                           /* negative value */
+	   gds->llg.lPole_lat = - gds->llg.lPole_lat;      /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get lon pole stretching
+*/
+	 gbyte(in,&something,&skip,24);
+	 DPRINT0 ("Sign & gds->llg.lPole_lon \n");
+	 sign = (int)(something >> 23) & 1;                 /* get sign */
+	 gds->llg.lPole_lon= (long)(something) & 8388607; /* lon pole stretching*/
+	 if(sign)                                           /* negative value */
+	   gds->llg.lPole_lon = - gds->llg.lPole_lon;      /* multiply by -1 */
+	 
+	 gbyte(in,&something,&skip,24);
+	 DPRINT0 ("gds->llg.lStretch\n");
+	 gds->llg.lStretch = (long) something;
+       }
+
+/*
+ *                FUNCTION gbyte !get number of columns in each row
+ */
+       if (gds->llg.usNi == 65535) {
+	 if (gds->head.thin == NULL) {
+	   gds->head.thin = (int *)malloc(gds->llg.usNj*sizeof(int));
+	 } else {
+	   gds->head.thin = (int *)realloc(gds->head.thin,
+					   gds->llg.usNj*sizeof(int));
+	 }
+	 if (gds->head.thin == NULL) {
+	   sprintf(errmsg,
+		   "%s: failed to create array[%d] for thinned grid information", 
+		   func, gds->head.thin);
+	   goto BYE;
+	 }
+	 for (i = 0; i<gds->llg.usNj; i++) {
+	   gbyte(in,&something,&skip,16);
+	   gds->head.thin[i] = (short)something;
+	 }
+       } else {
+	 gds->head.thin = NULL;
+       }
+       break;
+
+    case MERC_PRJ:    /* Mercator Projection Grid               */
+/*
+*           case Mercator Projection Grid:
+*                 Mark the Projection type 
+*                 FUNCTION gbyte !get Number of Columns
+*/
+       gds->merc.usData_type = gds->head.usData_type;
+
+       gbyte(in,&something,&skip,16); 
+       DPRINT0 ("gds->merc.cols\n");
+       gds->merc.cols = (int) something;                  /* get Ni */
+/*
+*                 FUNCTION gbyte !get Number of Rows
+*/
+       gbyte(in,&something,&skip,16); 
+       DPRINT0 ("gds->merc.rows\n");
+       gds->merc.rows = (int) something;                  /* get Nj */
+
+/*
+*                 FUNCTION gbyte !get Latitude of First Point
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->merc.first_lat\n");
+       sign = (int)(something >> 23) & 1;                   /* get sign */
+       gds->merc.first_lat = (long) (something) & 8388607;  /* get La1 */
+       if(sign)                                             /* negative value */
+          gds->merc.first_lat = - gds->merc.first_lat;      /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get Longitude of First Point
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->merc.first_lon\n");
+       sign = (int)(something >> 23) & 1;                   /* get sign */
+       gds->merc.first_lon = (long) (something) & 8388607;  /* get Lo1 */
+       if(sign)                                             /* negative value */
+          gds->merc.first_lon = - gds->merc.first_lon;      /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get resolution & comp flag
+*/
+       gbyte(in,&something,&skip,8); 
+       DPRINT0 ("gds->merc.usRes_flag\n");
+       gds->merc.usRes_flag = (short) something;  /* resolution & comp flags */
+
+/*
+*                 FUNCTION gbyte !get Latitude of Last point
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->merc.La2\n");
+       sign = (int)(something >> 23) & 1;                   /* get sign */
+       gds->merc.La2 = (long) (something) & 8388607;        /* get La2 */
+       if(sign)                                             /* negative value */
+          gds->merc.La2 = - gds->merc.La2;                  /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get Longitude of Last point
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->merc.Lo2\n");
+       sign = (int)(something >> 23) & 1;                   /* get sign */
+       gds->merc.Lo2 = (long) (something) & 8388607;        /* get Lo2 */
+       if(sign)                                             /* negative value */
+          gds->merc.Lo2 = - gds->merc.Lo2;                  /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get Latitude where projection intersects Earth
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->merc.latin\n");
+       sign = (int)(something >> 23) & 1;                   /* get sign */
+       gds->merc.latin = (long) (something) & 8388607;      /* get latin */
+       if(sign)                                             /* negative value */
+          gds->merc.latin = - gds->merc.latin;              /* multiply by -1 */
+
+       skip += 8;      /* skip over the reserved octet */
+
+/*
+*                 FUNCTION gbyte !get scanning mode flag
+*/
+       gbyte(in,&something,&skip,8);
+       DPRINT0 ("gds->merc.usScan_mode\n");
+       gds->merc.usScan_mode = (short) something;            /* get scaning mode flag */
+
+/*
+*                 FUNCTION gbyte !get Longitudinal Increment
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("gds->merc.lon_inc\n");
+       gds->merc.lon_inc = (float) something;               /* get Di */
+
+/*
+*                 FUNCTION gbyte !get Latitudinal Increment
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("gds->merc.lat_inc\n");
+       gds->merc.lat_inc = (float) something;               /* get Dj */
+
+       gbyte(in,&something,&skip,32);
+       DPRINT0 ("gds->merc.usZero\n");
+       gds->merc.usZero = (long) something;
+
+       if (gds->merc.cols == 65535) {
+	 gds->head.thin = (int *)calloc(gds->merc.rows,sizeof(int));
+	 if (gds->head.thin == NULL) {
+	   sprintf(errmsg,
+		   "%s: failed to create array[%d] for thinned grid information", 
+		   func, gds->head.thin);
+	   goto BYE;
+	 }
+	 for (i = 0; i<gds->merc.rows; i++) {
+	   gbyte(in,&something,&skip,16);
+	   gds->head.thin[i] = (short)something;
+	 }
+       } else {
+	 gds->head.thin = NULL;
+       }
+
+       break;
+
+    case POLAR_PRJ:    /* Polar Stereographic Projection Grid    */
+/*
+*           case Polar Stereographic Projection Grid:
+*                 Mark the Projection type 
+*                 FUNCTION gbyte !get Number of Columns
+*/
+       gds->pol.usData_type = gds->head.usData_type;
+
+       gbyte(in,&something,&skip,16); 
+       DPRINT0 ("gds->pol.usNx\n");
+       gds->pol.usNx = (short) something;                   /* get Nx */
+
+/*
+*                 FUNCTION gbyte !get Number of Rows
+*/
+       gbyte(in,&something,&skip,16); 
+       DPRINT0 ("gds->pol.usNy\n");
+       gds->pol.usNy = (short) something;                   /* get Ny */
+
+/*
+*                 FUNCTION gbyte !get Latitude of First point
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->pol.lLat1\n");
+       sign = (int)(something >> 23) & 1;                   /* get sign */
+       gds->pol.lLat1 = (long)  (something) & 8388607;      /* get La1 */
+       if(sign)                                             /* negative value */
+          gds->pol.lLat1 = - gds->pol.lLat1;                /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get Longitude of First point
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->pol.lLon1\n");
+       sign = (int)(something >> 23) & 1;                   /* get sign */
+       gds->pol.lLon1 = (long) (something) & 8388607;       /* get Lo1 */
+       if(sign)                                             /* negative value */
+          gds->pol.lLon1 = - gds->pol.lLon1;                /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get resolution & comp flag
+*/
+       gbyte(in,&something,&skip,8); 
+       DPRINT0 ("gds->pol.usRes_flag\n");
+       gds->pol.usRes_flag = (short) something;             /* get resolution & comp flags */
+
+/*
+*                 FUNCTION gbyte !get Orientation Longitude
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->pol.lLon_orient\n");
+       sign = (int)(something >> 23) & 1;                    /* get sign */
+       gds->pol.lLon_orient = (long) (something) & 8388607;  /* Orientation */
+       if(sign)      /* negative value , multiply by -1 */
+          gds->pol.lLon_orient = - gds->pol.lLon_orient;
+
+/*
+*                 FUNCTION gbyte !get Increment along a Row
+*/
+       gbyte(in,&something,&skip,24);
+       DPRINT0 ("gds->pol.ulDx\n");
+       gds->pol.ulDx = (float) something;                   /* get Dx */
+
+/*
+*                 FUNCTION gbyte !get Increment along a Column
+*/
+       gbyte(in,&something,&skip,24);
+       DPRINT0 ("gds->pol.ulDy\n");
+       gds->pol.ulDy = (float) something;                   /* get Dy */
+
+/*
+*                 FUNCTION gbyte !get projection center flag
+*/
+       gbyte(in,&something,&skip,8);
+       DPRINT0 ("gds->pol.usProj_flag\n");
+       gds->pol.usProj_flag = (short) something;  /* Projection center flag */
+
+/*
+*                 FUNCTION gbyte !get scanning mode
+*/
+       gbyte(in,&something,&skip,8);
+       DPRINT0 ("gds->pol.usScan_mode\n");
+       gds->pol.usScan_mode = (short) something;     /* get scaning mode flag */
+
+/*
+*                 FUNCTION gbyte !reserved zero
+*/
+       gbyte(in,&something,&skip,32);
+       DPRINT0 ("gds->pol.usZero\n");
+       gds->pol.usZero = (int) something;            /* get Reserved zero */
+
+       if (gds->pol.usNx == 65535) {
+	 gds->head.thin = (int *)calloc(gds->pol.usNy,sizeof(int));
+	 if (gds->head.thin == NULL) {
+	   sprintf(errmsg,
+		   "%s: failed to create array[%d] for thinned grid information", 
+		   func, gds->head.thin);
+	   goto BYE;
+	 }
+	 for (i = 0; i<gds->pol.usNy; i++) {
+	   gbyte(in,&something,&skip,16);
+	   gds->head.thin[i] = (short)something;
+	 }
+       } else {
+	 gds->head.thin = NULL;
+       }
+
+       break;
+
+   case LAMB_PRJ:  		/* Lambert Conformal */
+   case ALBERS_PRJ:  		/* Albers equal-area */
+   case OBLIQ_LAMB_PRJ: 	/* Oblique Lambert Conformal */
+/*
+*           case Lambert conformal, secant or tangent, conical or bipolar:
+*           case Albers equal-area, secant or tangent, conical or bipolar:
+*           case Oblique Lambert conformal:
+*                 Mark the Projection type 
+*                 FUNCTION gbyte !get Number of Columns
+*/
+       gds->lam.usData_type = gds->head.usData_type;
+
+       gbyte(in,&something,&skip,16); 
+       DPRINT0 ("gds->lam.iNx\n");
+       gds->lam.iNx = (int) something;                      /* get Nx */
+
+/*
+*                 FUNCTION gbyte !get Number of Rows
+*/
+       gbyte(in,&something,&skip,16); 
+       DPRINT0 ("gds->lam.iNy\n");
+       gds->lam.iNy = (int) something;                      /* get Ny */
+
+/*
+*                 FUNCTION gbyte !get Latitude of First Point
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->lam.lLat1\n");
+       sign = (int)(something >> 23) & 1;                   /* get sign */
+       gds->lam.lLat1 = (long)  (something) & 8388607;      /* get La1 */
+       if(sign)                                             /* negative value */
+          gds->lam.lLat1 = - gds->lam.lLat1;                /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get Longitude of First Point
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->lam.lLon1)\n");
+       sign = (int)(something >> 23) & 1;                   /* get sign */
+       gds->lam.lLon1 = (long) (something) & 8388607;       /* get Lo1 */
+       if(sign)                                             /* negative value */
+          gds->lam.lLon1 = - gds->lam.lLon1;                /* multiply by -1 */
+
+/*
+*                 FUNCTION gbyte !get resolution & comp flag
+*/
+       gbyte(in,&something,&skip,8); 
+       DPRINT0 ("gds->lam.usRes_flag\n");
+       gds->lam.usRes_flag = (short) something;  /* resolution & comp flags */
+
+/*
+*                 FUNCTION gbyte !get Orientation Longitude
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->lam.lLon_orient)\n");
+       sign = (int)(something >> 23) & 1;                    /* get sign */
+       gds->lam.lLon_orient = (long) (something) & 8388607;  /* Orientation */
+       if(sign)              /* negative value , multiply by -1 */
+          gds->lam.lLon_orient = - gds->lam.lLon_orient;     
+
+/*
+*                 FUNCTION gbyte !get Increment along a Row
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("gds->lam.ulDx\n");
+       gds->lam.ulDx = (float) something;                    /* get Dx */
+
+/*
+*                 FUNCTION gbyte !get Increment along a Column
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("gds->lam.ulDy\n");
+       gds->lam.ulDy = (float) something;                    /* get Dy */
+
+/*
+*                 FUNCTION gbyte !get Projection Center
+*/
+       gbyte(in,&something,&skip,8); 
+       DPRINT0 ("gds->lam.usProj_flag\n");
+       gds->lam.usProj_flag= (short) something;  /* Projection center flag */
+
+/*
+*                 FUNCTION gbyte !get scanning mode flag
+*/
+       gbyte(in,&something,&skip,8); 
+       DPRINT0 ("gds->usScan_mode\n");
+       gds->lam.usScan_mode = (short) something;    /* get scaning mode flag */
+
+/*
+*                 FUNCTION gbyte !get First lat from pole that intersects Earth
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("gds->lLat_cut1\n");
+       gds->lam.lLat_cut1 = (long) something;                /* get latin_1 */
+
+/*
+*                 FUNCTION gbyte !get Second lat from pole that intersects Earth
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("gds->lLat_cut2\n");
+       gds->lam.lLat_cut2 = (long) something;                /* get latin_2 */
+
+/*
+*                 FUNCTION gbyte !get lat of south pole
+*/
+       gbyte(in,&something,&skip,24);
+       DPRINT0 ("Sign & gds->lLat_southpole\n");
+       sign = (int)(something >> 23) & 1;                        /* get sign */
+       gds->lam.lLat_southpole = (long) (something) & 8388607;   /* lat S.pole*/
+       if(sign)      /* negative value , multiply by -1 */ 
+           gds->lam.lLat_southpole = - gds->lam.lLat_southpole;
+
+/*
+*                 FUNCTION gbyte !get lon of South pole
+*/
+       gbyte(in,&something,&skip,24); 
+       DPRINT0 ("Sign & gds->lLon_southpole\n");
+       sign = (int)(something >> 23) & 1;                        /* get sign */
+       gds->lam.lLon_southpole = (long) (something) & 8388607;/* lon S.pole */
+       if(sign)     /* negative value, multiply by -1 */ 
+           gds->lam.lLon_southpole = - gds->lam.lLon_southpole;
+
+/*
+*                 FUNCTION gbyte !get Reserved zero
+*/
+       gbyte(in,&something,&skip,16); 
+       DPRINT0 ("gds->lam.usZero\n");
+       gds->lam.usZero = (int) something;                    /* Reserved zero */
+
+       gds->head.thin = NULL;
+
+       if (gds->lam.iNx == 65535) {
+	 gds->head.thin = (int *)calloc(gds->lam.iNy,sizeof(int));
+	 if (gds->head.thin == NULL) {
+	   sprintf(errmsg,
+		   "%s: failed to create array[%d] for thinned grid information", 
+		   func, gds->head.thin);
+	   goto BYE;
+	 }
+	 for (i = 0; i<gds->lam.iNy; i++) {
+	   gbyte(in,&something,&skip,16);
+	   gds->head.thin[i] = (short)something;
+	 }
+       } else {
+	 gds->head.thin = NULL;
+       }
+
+       break;
+
+    default :             /* other cases not implemented in this version */
+/*
+*             default:   ! unsupported data types
+*                 SET Status to bad
+*/
+       DPRINT2 ("%s:  unknown datatype=%d\n",func, gds->head.usData_type);
+       sprintf(errmsg,"%s:  unknown datatype=%d\n",func, gds->head.usData_type);
+       status=1;         /* set status to failure */
+       break;
+/*
+*
+* A.5      ENDSWITCH
+*/
+  }  /* end switch on data type */
+
+/*
+*
+* A.6      DEBUG Print
+*
+* A.7      RETURN (status)
+*/
+ BYE:
+  DPRINT2 ("Exiting %s, stat=%d\n", func,status);
+  return(status);
+/*
+*  END OF FUNCTION 
+*
+*/
+}  
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetpds.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetpds.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribgetpds.c	(revision 2744)
@@ -0,0 +1,374 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+/* REVISION/MODIFICATION HISTORY:
+       03/07/94 written by Mugur Georgescu CSC, Monterey CA
+       02/01/96 modified by Steve Lowe SAIC, Monterey CA
+       06/18/96 modified by Alice T. Nakajima (ATN), SAIC, Monterey CA 
+       01/22/98 ATN, MRY SAIC
+       04/22/98 ATN change requirement for using extensions.
+*
+************************************************************************
+* A.  FUNCTION  gribgetpds
+*       Decode the Product Definition Section (PDS) from the provided 
+*       pointer location and store the info in the internal PDS structure.
+*
+*    INTERFACE:
+*       int gribgetpds (curr_ptr, pds, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *curr_ptr;    pointer to first octet of PDS
+*      (O)  PDS_INPUT *pds;    empty PDS structure to be filled
+*      (O)  char *errmsg;      returned filled if error occurred
+* 
+*     RETURN CODE:
+*     0>  Always,  PDS info stored in Pds structure;
+************************************************************************
+*/
+int get_factor(int unit);
+#if PROTOTYPE_NEEDED
+int gribgetpds ( char *curr_ptr, PDS_INPUT *pds, char *errmsg)
+#else
+
+int gribgetpds ( curr_ptr, pds, errmsg)
+		char *curr_ptr; 
+		PDS_INPUT *pds; 
+		char *errmsg;
+#endif
+{
+char *in = curr_ptr;      /* pointer to the message */
+unsigned long skip=0;              /* bits to be skipped */
+unsigned long something;  /* value extracted from message */
+int sign;                 /* sign + or - */
+ int unit;
+ int P1, P2;
+
+ DPRINT0 ("Entering gribgetpds()\n");
+/*
+*
+* A.1       FUNCTION gbyte !3-byte PDS length
+*/
+ gbyte(in,&something,&skip,24); 
+ DPRINT0 ("pds->uslength\n");
+ pds->uslength = (unsigned short) something;       
+
+/*
+*
+* A.2       FUNCTION gbyte !parameter table version
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usParm_tbl\n");
+ pds->usParm_tbl = (unsigned short) something;     
+
+/*
+*
+* A.3       FUNCTION gbyte !center identification
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usCenter_id\n");
+ pds->usCenter_id = (unsigned short) something;    
+
+/*
+*
+* A.4       FUNCTION gbyte !generating process id
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usProc_id\n");
+ pds->usProc_id = (unsigned short) something;      
+
+/*
+*
+* A.5       FUNCTION gbyte !grid identification
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usGrid_id\n");
+ pds->usGrid_id = (unsigned short) something;      
+
+/*
+*
+* A.6       FUNCTION gbyte !flag of GDS, BMS presence
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usGds_bms_id\n");
+ pds->usGds_bms_id = (unsigned short) something;   
+
+/*
+*
+* A.7       FUNCTION gbyte !parameter indicator and units 
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usParm_id\n");
+ pds->usParm_id = (unsigned short) something;      
+
+/*
+*
+* A.8       FUNCTION gbyte !level type indicator
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usLevel_id\n");
+ pds->usLevel_id = (unsigned short) something;  
+
+ /* switch on Level_id to determine if level or layer */
+/*
+*
+* A.9       SWITCH (level_id)
+*/
+ switch(pds->usLevel_id)
+    {
+    case 101: /* layer between two isobaric surfaces */
+    case 104: /* layer between two specified altitudes */
+    case 106: /* layer between two specified height levels above ground */
+    case 108: /* layer between two sigma levels */
+    case 110: /* layer between two hybrid levels */
+    case 112: /* layer between two depths below land surface */
+    case 114: /* layer between two isentropic levels */
+    case 121: /* layer between two isobaric surfaces (high precision) */
+    case 128: /* layer between two sigma levels (high precision) */
+    case 141: /* layer between two isobaric surfaces (mixed precision) */
+/*
+*              layer:
+*                 FUNCTION gbyte !top of layer
+*                 FUNCTION gbyte !bottom of layer
+*/
+       gbyte(in,&something,&skip,8);
+       DPRINT0 ("pds->usHeight1\n");
+       pds->usHeight1 = (unsigned short) something;  /* top layer */
+       gbyte(in,&something,&skip,8);
+       DPRINT0 ("pds->usHeight2\n");
+       pds->usHeight2 = (unsigned short) something;  /* bottom layer */
+       break;
+
+    default:  /* all others (levels) */
+/*
+*              default:  !assume a level
+*                 FUNCTION gbyte !level value
+*                 SET Height2 to ZERO
+*/
+       gbyte(in,&something,&skip,16);
+      DPRINT0 ("pds->usHeight1\n");
+       pds->usHeight1 = (unsigned short) something;
+       pds->usHeight2 = 0.0;                
+       break;
+    }
+/*
+* A.9       ENDSWITCH
+*/
+
+/*
+*
+* A.10      FUNCTION gbyte !year of Reference Data/Time
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usYear\n");
+ pds->usYear = (unsigned short) something;   
+
+/*
+*
+* A.11      FUNCTION gbyte !month of Reference Data/Time
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usMonth\n");
+ pds->usMonth = (unsigned short) something;   
+
+/*
+*
+* A.12      FUNCTION gbyte !day of Reference Data/Time
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usDay\n");
+ pds->usDay = (unsigned short) something;      
+
+/*
+*
+* A.13      FUNCTION gbyte !hour of Reference Data/Time
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usHour\n");
+ pds->usHour = (unsigned short) something;      
+
+/*
+*
+* A.14      FUNCTION gbyte !minute of Reference Data/Time
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usMinute\n");
+ pds->usMinute = (unsigned short) something;     
+
+/*
+*
+* A.15      FUNCTION gbyte !forecast time unit
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usFcst_unit_id\n");
+ pds->usFcst_unit_id = (unsigned short) something;
+
+/*
+*
+* A.16      FUNCTION gbyte !forecast period 1
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usP1\n");
+ pds->usP1 = (unsigned short) something;         
+
+/*
+*
+* A.17      FUNCTION gbyte !forecast period 2
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usP2\n");
+ pds->usP2 = (unsigned short) something;          
+
+/*
+*
+* A.18      FUNCTION gbyte !time range indicator
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usTime_range\n");
+ pds->usTime_range = (unsigned short) something;   
+
+/*
+*
+* A.19      FUNCTION gbyte !#included in average
+*/
+ gbyte(in,&something,&skip,16); 
+ DPRINT0 ("pds->usTime_range_avg\n");
+ pds->usTime_range_avg = (unsigned short) something;
+
+/*
+*
+* A.20      FUNCTION gbyte !#missing from average
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usTime_range_mis\n");
+ pds->usTime_range_mis = (unsigned short) something;
+
+/*
+*
+* A.21      FUNCTION gbyte !century of Reference Data/Time
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usCentury\n");
+ pds->usCentury = (unsigned short) something;  
+
+/*
+*
+* A.22      FUNCTION gbyte !originating Sub-Center  (Oct 26)
+*/
+ gbyte(in,&something,&skip,8); 
+ DPRINT0 ("pds->usCenter_sub (Oct 26)\n");
+ pds->usCenter_sub = 	(unsigned short) something;
+
+/*
+*
+* A.23      FUNCTION gbyte !decimal scale factor
+*/
+ gbyte(in,&something,&skip,16); 
+      DPRINT0 ("Sign & pds->sDec_sc_fctr\n");
+ sign = (int)(something >> 15) & 1;                /* sign bit*/
+ pds->sDec_sc_fctr = (short) (something) & 32767;  /* Decimal sclfctr D */
+ if(sign)                                          /* negative Dec. sclfctr*/
+    pds->sDec_sc_fctr = - pds->sDec_sc_fctr;       /* multiply by -1 */
+
+ /*
+  * This is the WSI extension for forecast time unit
+  */
+
+ if (pds->usTime_range == 255)
+   {
+
+     /* Skip ahead to byte 41 */
+     skip += 96;
+     
+     /* Get forecast time unit for P1 from byte 41 */
+     gbyte(in,&something,&skip,8);
+     unit = (unsigned short)something;
+     
+     /* Get P1 */
+     gbyte(in,&something,&skip,32);
+     P1 = (unsigned int)something;
+     pds->usP1 = get_factor(unit)*P1;
+
+     /* Get forecast time unit for P2 from byte 46 */
+     gbyte(in,&something,&skip,8);
+     unit = (unsigned short)something;
+
+     /* Get P2 */
+     gbyte(in,&something,&skip,32);
+     P2 = (unsigned int)something;
+     pds->usP2 = get_factor(unit)*P2;
+
+     /* Get Time Range Indicator */
+     gbyte(in,&something,&skip,8);
+     pds->usTime_range = (unsigned short)something;
+
+     /* 
+      * Set forecast time unit to seconds, since we've converted usP1 and usP2
+      *   to seconds.
+      */
+     pds->usFcst_unit_id = 254;
+   }
+
+/*
+* A.26      DEBUG Print
+*/
+  DPRINT0 ("Exiting gribgetpds(), status=0\n");
+
+/*
+* 
+* A.27      RETURN 0  !success
+*/
+return(0);
+/*
+* END OF FUNCTION
+*
+*
+*/
+} 
+/*****************************************************************************
+ *
+ * returns the multiplication factor to convert grib forecast times to 
+ *   seconds.
+ *
+ * Input: 
+ *    unit_id  - grib forecast unit id, from Table 4.
+ *
+ * Return:
+ *    conversion factor
+ *****************************************************************************/
+int get_factor(int unit)
+{
+  int factor;
+  
+  switch (unit) {
+  case 0:
+    factor = 60;
+    break;
+  case 1:
+    factor = 60*60;
+    break;
+  case 2:
+    factor = 60*60*24;
+    break;
+  case 10:
+    factor = 60*60*3;
+    break; 
+  case 11:
+    factor = 60*60*3;
+    break;
+  case 12:
+    factor = 60*60*12;
+    break;
+  case 50:
+    /* This is a WSI (non-standard) time unit of 5 minutes */
+    factor = 5*60;
+    break;
+  case 254:
+    factor = 1;
+    break;
+  default:
+    fprintf(stderr,"Invalid unit for forecast time: %d\n",unit);
+    factor = 0;
+  }
+  return factor;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribhdr2file.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribhdr2file.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribhdr2file.c	(revision 2744)
@@ -0,0 +1,222 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+/*
+*
+************************************************************************
+* A.  FUNCTION  gribhdr2file
+*       write out the Grib message stored in GRIB_HDR struct to stream;
+*       if the 'shuffle' flag is set, write each individual section out, else
+*       write 'entire_msg' all at once;
+*               
+*    INTERFACE:
+*       int    gribhdr2file (gh, fn, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) GRIB_HDR *gh    holds the GRIB message to be written out
+*      (I) FILE *stream    open strem to write to
+*      (O) char *errmsg    array returned empty unless error occurred;
+*
+*     RETURN CODE:
+*     0>  no errors,  GRIB file successfully created;
+*     1>  error; errmsg is filled;
+************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int    gribhdr2file ( GRIB_HDR *gh, FILE *stream, char *errmsg)
+#else
+int    gribhdr2file ( gh, stream, errmsg)
+			GRIB_HDR *gh; 
+			FILE *stream; 
+			char *errmsg;
+#endif
+{
+  int fd;
+  int stat;
+  char *func= "gribhdr2file";
+
+  fd = fileno(stream);
+  if (fd == -1) 
+    {
+      DPRINT1 ("%s: Invalid file stream encountered.\n", func);
+      return 1;
+      
+    }
+
+  stat = gribhdr2filed ( gh, fd, errmsg);
+  return stat;
+  
+}
+
+
+/*
+*
+************************************************************************
+* A.  FUNCTION  gribhdr2file
+*       write out the Grib message stored in GRIB_HDR struct to file 
+*       descriptor;
+*       if the 'shuffle' flag is set, write each individual section out, else
+*       write 'entire_msg' all at once;
+*               
+*    INTERFACE:
+*       int    gribhdr2file (gh, fn, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) GRIB_HDR *gh    holds the GRIB message to be written out
+*      (I) int f1          open file descriptor to write to
+*      (O) char *errmsg    array returned empty unless error occurred;
+*
+*     RETURN CODE:
+*     0>  no errors,  GRIB file successfully created;
+*     1>  error; errmsg is filled;
+************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int    gribhdr2filed ( GRIB_HDR *gh, int f1, char *errmsg)
+#else
+int    gribhdr2filed ( gh, f1, errmsg)
+			GRIB_HDR *gh; 
+			int f1; 
+			char *errmsg;
+#endif
+{
+/*
+*
+* A.0     DEFAULT to error status of 1
+*/
+char *func= "gribhdr2file";
+int  stat=1;		
+char wrstring[4];
+ int check;
+
+/*
+*
+* A.1     IF (entire msg array is null or msg length is 0)
+*         THEN 
+*            RETURN error stat !errmsg filled
+*         ENDIF
+*/
+  DPRINT1("Entering %s\n", func);
+  if (gh->entire_msg == NULL || gh->msg_length <= 0) {
+	DPRINT1 ("%s: GRIB_HDR message buffer is null, OR msg_length=0\n",func);
+	sprintf(errmsg,"%s: GRIB_HDR message buffer is null, OR msg_length=0\n",
+	func);
+	goto BYE;
+	}	
+
+/*
+*
+* A.2     IF (in Shuffle mode)
+*         THEN 
+*            IF (length of EDS/PDS/BDS/EDS is 0) THEN
+*               RETURN error stat !errmsg filled
+*            ENDIF
+*         ENDIF
+*/
+  if (gh->shuffled) {
+	if (!gh->ids_len|| !gh->pds_len || !gh->bds_len|| !gh->eds_len) {
+	   DPRINT1("%s:  Shuffle mode: Zero length encountered, quit\n", func);
+	   sprintf(errmsg,
+	   "%s:  Shuffle mode: Zero length encountered, quit\n", func);
+	   goto BYE; }
+	DPRINT1 ("%s:   this mesg is in shuffled mode;\n", func);
+	}
+
+/*
+*
+* A.4     IF (in shuffled mode) 
+* A.4.a   THEN
+*/
+  if (gh->shuffled) {
+/*
+* A.4.a.1    IF (fails to write IDS OR fails to write PDS OR
+*                (GDS exists AND fails to write GDS) OR 
+*                (BMS exists AND fails to write BMS) OR 
+*                fails to write BDS or fails to write EDS)
+*            THEN
+*               RETURN error stat !errmsg filled
+*            ENDIF
+*/
+     if (write (f1, gh->ids_ptr , gh->ids_len) != gh->ids_len)
+        {
+          DPRINT1 ("%s:  failed to write IDS to file\n", func);
+          sprintf(errmsg,"%s:  failed to write IDS to file\n", func);
+          goto BYE;
+        }
+     if (write (f1, gh->pds_ptr , gh->pds_len) != gh->pds_len)
+        {
+          DPRINT1 ("%s:  failed to write PDS to file\n", func);
+          sprintf(errmsg,"%s:  failed to write PDS to file\n", func);
+          goto BYE;
+        }
+     if (gh->gds_len)
+     if (write (f1, gh->gds_ptr , gh->gds_len) != gh->gds_len)
+        {
+          DPRINT1 ("%s:  failed to write GDS to file\n", func);
+          sprintf(errmsg,"%s:  failed to write GDS to file\n", func);
+          goto BYE;
+        }
+     if (gh->bms_len)
+     if (write (f1, gh->bms_ptr , gh->bms_len) != gh->bms_len)
+        {
+          DPRINT1 ("%s:  failed to write BMS to file\n", func);
+          sprintf(errmsg,"%s:  failed to write BMS to file\n", func);
+          goto BYE;
+        }
+     if (write (f1, gh->bds_ptr , gh->bds_len) != gh->bds_len)
+        {
+          DPRINT1 ("%s:  failed to write BDS to file\n", func);
+          sprintf(errmsg,"%s:  failed to write BDS to file\n", func);
+          goto BYE;
+        }
+     if (write (f1, gh->eds_ptr , gh->eds_len) != gh->eds_len)
+        {
+          DPRINT1 ("%s:  failed to write EDS to file\n", func);
+          sprintf(errmsg,"%s:  failed to write EDS to file\n", func);
+          goto BYE;
+        }
+     DPRINT0 ("ALL Sections to written to file successfully\n");
+     }
+/*
+* A.4.b   ELSE
+*/
+   else {
+        DPRINT0 ("Writing gh->entire_msg (non-shuffled)\n");
+/*
+* A.4.b.1    IF (fails to write msg_length byte straight from Entire_msg)
+*            THEN
+*                RETURN error stat !errmsg filled
+*            ENDIF
+*/
+        if ((check = write (f1, gh->entire_msg, gh->msg_length)) != 
+	    gh->msg_length) {
+	    DPRINT1( "%s:  failed to write GH's entire Msg to file\n",func);
+	    sprintf(errmsg,
+	    "%s:  failed to write GH's entire Msg to file %d\n",func,check);
+	    /*	    goto BYE;  */
+	   }
+  	DPRINT0 ("write GH's entire_msg to file successful\n");
+/*
+* A.4     ENDIF
+*/
+        }
+/*
+*
+* A.5     DONE, set status to 0  !no errors
+*/
+  stat = 0;
+
+BYE:
+
+/*
+*
+* A.7     RETURN with stat
+*/
+  DPRINT2 ("Leaving %s, stat=%d;\n", func, stat);
+  return stat;
+/*
+*
+* END OF FUNCTION
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribputbds.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribputbds.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribputbds.c	(revision 2744)
@@ -0,0 +1,247 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+******************************************************************************
+* A.  FUNCTION:  gribputbds
+*       Use the information provided to create a  Binary Data Section of
+*       the GRIB format and store it in the GRIB_HDR structure;
+*
+*    INTERFACE:
+*      int   gribputbds (user_input, lgrid_size, sDec_sc_fctr, pfData_Array,
+*                         pBDS_Head_Input,  pgrib_hdr, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  USER_INPUT user_input;   
+*           Structure containing encoder configuration data
+*      (I)  long lgrid_size;         
+*           number of datapoints expected for this projection
+*      (I)  short sDec_sc_fctr;
+*           Decimal Scle Factor used when packing up data 
+*    (I&O)  float *pfData_Array;
+*           float array to be packed up.  Returned scaled up by Dec Scale Fctr.
+*      (O)  BDS_HEAD_INPUT *pBDS_Head_Input  
+*           returned filled;
+*    (I&O)  GRIB_HDR **pgrib_hdr;    
+*           structure to hold encoded BDS and its info
+*      (O)  char *errmsg
+*           empty array, returned filled if error occurred;
+*
+*     RETURN CODE:
+*      0> no errors; GRIB_HDR now has a valid Binary Data Section;
+*         BDS_HEAD_INPUT filled also;
+*      1> error occurred, errmsg filled;
+*         either GRIB_HDR structure is corrupted, or
+*         non-shuffle mode but the Data array is Null, or
+*         failed to pack the Data array up, or 
+*         failed to expand 'entire_msg' in GRIB_HDR to support encoded BDS;
+******************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int   gribputbds ( USER_INPUT user_input, long lgrid_size,
+		short sDec_sc_fctr, float *pfData_Array,
+		BDS_HEAD_INPUT *pBDS_Head_Input, GRIB_HDR **pgrib_hdr,
+		char *errmsg)
+#else
+int   gribputbds ( user_input, lgrid_size, sDec_sc_fctr, pfData_Array,
+		   pBDS_Head_Input, pgrib_hdr, errmsg)
+ 
+		  USER_INPUT    user_input;             /* input */
+		  long          lgrid_size;             /* input */
+		  short                 sDec_sc_fctr;   /* input */
+		  float                 *pfData_Array;  /* input */
+		  BDS_HEAD_INPUT  *pBDS_Head_Input;     /* output */
+		  GRIB_HDR      **pgrib_hdr;            /* input & output */
+		  char          *errmsg;                /* output */
+		 
+#endif
+{
+/*
+*
+* A.0       DEFAULT to Error Stat
+*/
+char *func= "gribputbds";
+long lBDS_length= 0;    /* Rnd2_len bytes */
+void *pvbstr= 0;	/* remains null until after Inp2true_bds */
+GRIB_HDR *gh;		/* working var */
+long newsize;		/* working var */
+void  create_inpBDS();
+int  n, stat=1;
+
+    DPRINT1 ("\nEntering %s() ...\n",func);
+/*
+*
+* A.1       ASSIGN the GRIB_HDR pointer to local ptr;
+*           IF (it's null OR entire_msg is null) THEN
+*              RETURN error !errmsg filled
+*           ENDIF
+*/
+    gh= *pgrib_hdr;
+    if (!gh || !gh->entire_msg) {
+	DPRINT1( "%s:  Grib Header or its Entire_msg is NULL\n", func);
+	sprintf(errmsg,"%s:  Grib Header or its Entire_msg is NULL\n", func);
+	goto BYE;
+	}
+
+/*
+*
+* A.2       IF (the floating point array is null) THEN
+*/
+    if (pfData_Array == NULL) {
+
+/*
+* A.2.1         IF (creating all sections mode) 
+* A.2.1.a       THEN
+*                  RETURN error      !cannot go on w/o float array
+*/
+ 	  if  (! gh->shuffled) {
+	       DPRINT1 ("%s:  Float array is Null, cannot proceed;\n",func);
+	       sprintf(errmsg,
+		"%s:  Float array is Null, cannot proceed;\n",func);
+		goto BYE;
+	       }
+/*
+* A.2.1.b       ELSE   /# Create all sections mode #/
+*                  !bds must already exist & has non-zero length, else error;
+*
+*                  IF (bds is null or bdslen <=0) THEN
+*                      RETURN error    !errmsg filled
+*                  ELSE
+*                      RETURN no error !bds already defined & has nonzero len
+*                  ENDIF
+*/
+	  else {  /* create all mode */
+		if (gh->bds_ptr== NULL || gh->bds_len<=0) 
+		   {
+	            DPRINT3 ( "%s:  No FloatData avail and GribHdr "\
+		    "has no BDS yet (ptr=%ld len=%ld)\n"
+		     ,func,gh->bds_ptr,gh->bds_len); 
+	            sprintf(errmsg, 
+		    "%s:  No FloatData avail and GribHdr has no BDS yet"\
+		    "(ptr=%ld len=%ld)\n",func,gh->bds_ptr,gh->bds_len); 
+		    }
+		else { 
+		    stat= 0;
+	            DPRINT2 ("%s: No need to proceed, GribHdr already "\
+		    "has a BDS  (len=%ld)\n", func, gh->bds_len);  
+		   }
+/*
+* A.2.1         ENDIF
+*/
+	       } /* if */
+
+/*
+* A.2.2         RETURN with Stat   !not decoding anything
+*/
+	goto BYE;  /* quit */
+/*
+*
+* A.2       ENDIF    !no float data
+*/
+      }  /* no flt data */
+
+
+    DPRINT0 ("Need to pack Float Data & Store in (Char*);\n");
+
+/*
+*
+* A.3         FILL the BDS Head Input struct;
+*/
+   pBDS_Head_Input->Bin_sc_fctr = 0;     /* INPUT NOT USED AT THIS TIME */
+   pBDS_Head_Input->fReference = 0.0;    /* INPUT NOT USED AT THIS TIME */
+   pBDS_Head_Input->usBit_pack_num = user_input.usBit_pack_num;
+                                         /* #bits used for packing, 0=default*/
+   pBDS_Head_Input->ulGrid_size = (unsigned long) lgrid_size;  /* Grid size */
+   pBDS_Head_Input->fPack_null = 1e10;   /* Pack null value */
+
+   DPRINT3 ("\t bds_head_input->usBit_pack_num = %u\n" \
+           "\t bds_head_input->ulGrid_size = %u\n" \
+          "\t bds_head_input->fPack_null = %f\n",
+          pBDS_Head_Input->usBit_pack_num, pBDS_Head_Input->ulGrid_size,
+          pBDS_Head_Input->fPack_null );
+   
+/*
+*
+* A.4       FUNCTION pack_spatial !packs data into binary bitstream
+*           IF (error in pack grid routine)
+*           THEN
+*               RETURN with error !errmsg filled
+*           ENDIF
+*/
+     if ((n= pack_spatial ( (long *)&(pBDS_Head_Input->ulGrid_size),
+                    &(pBDS_Head_Input->usBit_pack_num),
+                    &(pBDS_Head_Input->fPack_null),
+                    pfData_Array, 
+		    (unsigned long **) &pvbstr, 
+		    sDec_sc_fctr, &lBDS_length, errmsg)) )
+          {
+          DPRINT2 ("%s:  Pack Spatial returned err=%d\n", func, n);
+          upd_child_errmsg (func, errmsg);
+          goto BYE;
+          }
+
+/*
+*
+* A.5       CALCULATE new message length including new BDS
+*             (Include 4 bytes for EDS to avoid another realloc)
+*/
+     newsize=  gh->msg_length + lBDS_length + 4;
+
+/* 
+*
+* A.6       IF gribhdr's buffer is too small AND
+*               FUCTION Expand_gribhdr failed 
+*           THEN
+*               RETURN with error   !errmsg filled
+*           ENDIF
+*/
+     if (newsize > gh->abs_size 
+	&& Expand_gribhdr (gh, newsize, errmsg) !=0) 
+	{
+	upd_child_errmsg (func, errmsg);
+	goto BYE;
+	}
+
+/*
+*
+* A.7       STORE bds & its info into Grib Hdr
+*           !copy true BDS struct over into entire message array
+*           !update message length also in Grib Hdr
+*           !save length of bds into Internal Struct too
+*/
+    gh->bds_ptr= gh->entire_msg + gh->msg_length;
+    memcpy ((void *) gh->bds_ptr, pvbstr, lBDS_length);
+    gh->bds_len    = lBDS_length;
+    gh->msg_length += gh->bds_len;
+
+    /* Added by Todd Hutchinson, TASC  4/16/99*/
+    /* This stops a memory leak */
+    free(pvbstr);
+
+    pBDS_Head_Input->length = lBDS_length;  /* update the Input struct too */
+
+    DPRINT2("%s: copied %ld bytes from pvbstr to BDSPTR\n", func, lBDS_length);
+
+/*
+*
+* A.8       CHANGE status to no errors
+*/
+    stat = 0;
+
+BYE:
+/*
+*
+* A.9       RETURN w/ Stat
+*/
+    DPRINT2 ("Leaving %s,  Stat=%d\n", func , stat);
+    return (stat);
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribputgds.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribputgds.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribputgds.c	(revision 2744)
@@ -0,0 +1,1472 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#ifdef XT3_Catamount
+#include <features.h>
+#undef htonl
+#define htonl(x)     swap_byte4(x)
+#else
+#include <netinet/in.h>
+#endif
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+#include <math.h>
+
+/*
+************************************************************************
+* A. FUNCTION  gribputgds
+*      used to decode Grib's Grid Defn Section.  It returns with both
+*      internal structures GDS_HEAD_INPUT and VOID* projblock filled,
+*      and also with true GDS already appended to GribHeader's Entire_Msg;
+*
+*    INTERFACE:
+*      int   gribputgds (Geom_In, pGDS_Head_Input, ppvGDS_Proj_Input,
+*                        ppgrib_hdr, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  GEOM_IN  Geom_In
+*           Geometry information used as input;
+*      (O)  GDS_HEAD_INPUT *pGDS_Head_Input
+*           this is the internal GDS structure.  Attributes (uslength, 
+*           usData_type, chData_type, usNum_v and usPl_Pv) gets updated;
+*      (O)  void  **ppvGDS_Proj_Input;  
+*           This is a pre-alloced storage of type Void and has length of
+*           MAX_INP_PROJ_SIZE bytes long.  How this block is filled depends 
+*           on the type of Projection it is.  Projections currently supported 
+*           are Spherical, Lambert, and Polar Stereographic. 
+*     (I&O) GRIB_HDR  **ppgrib_hdr
+*           may already have one or more of the other Grib Sections
+*           (IDS, PDS, BMS, BDS, or EDS).   Upon successful exit, will
+*           also contain a GDS section.
+*      (O)  char  *errmsg               
+*           empty array, returned filled if error occurred;
+*
+*      RETURN CODE:
+*      0>  no errors;  GDS appended to GRIB_HDR's entire_msg, its info 
+*          stored in bds_len & bds_ptr;  msg_length updated too;
+*      1>  error, grib hdr is null; errmsg filled;
+************************************************************************
+*/
+
+/*
+NCAR AIX does not have lrint, make one up.
+*/
+#ifdef NCARIBM_NOC99
+#define lrint(dbl) ((long)rint(dbl))
+#endif
+
+#if PROTOTYPE_NEEDED
+int   gribputgds ( GEOM_IN  Geom_In, GDS_HEAD_INPUT *pGDS_Head_Input,
+		void  **ppvGDS_Proj_Input, GRIB_HDR  **ppgrib_hdr,
+		char  *errmsg)
+#else
+int   gribputgds ( Geom_In, pGDS_Head_Input, ppvGDS_Proj_Input, 
+						ppgrib_hdr, errmsg)
+		GEOM_IN  Geom_In; 
+		GDS_HEAD_INPUT *pGDS_Head_Input;
+		void  **ppvGDS_Proj_Input; 
+		GRIB_HDR  **ppgrib_hdr;
+		char  *errmsg;
+#endif
+{
+/*
+* A.0       DEFAULT to err stat 1
+*/
+  char		  *func= "gribputgds";
+  char		  *pgds=0;	 /* true grib, GDS_HEAD + Proj block */
+  GDS_HEAD 	  *pGDS_Head=0;	 /* first 6 bytes of PGDS */
+  void 		  *pvGDS_Proj=0;  /* projection info, PGDS 7th byte and on... */
+  long 		  lProj_sz ;	 /* size of True-Grib projection block  */
+  long		  new_msgsz;	 /* size after adding GDS */
+  GRIB_HDR	  *gh=0;	 /* temp ptr to struct */
+  unsigned char   ucflag;
+  int		  tempsz, stat=  1;
+
+GDS_LATLON_INPUT *mp;
+
+
+  DPRINT0 ("\nEntering  gribputgds .....\n");
+/*
+*
+* A.1       IF (Grib Hdr is null) THEN
+*               RETURN error Stat !null ptrs msg in errmsg
+*           ENDIF
+*/
+   gh = *ppgrib_hdr; 
+   if (!gh || !gh->entire_msg) {
+ 	DPRINT1("%s: grib header is null\n", func);
+ 	sprintf(errmsg,"%s: grib header is null\n", func);
+	goto BYE;
+	}
+
+/*
+*
+* A.3       ALLOCATE space for True Grib Structs GDS_HEAD & VOID *proj;
+*           IF (fails) THEN
+*              RETURN with bad Stat !errmsg filled
+*           ELSE  
+*              CLEAR out structs
+*           ENDIF
+*/
+
+   if (! (pgds= (char *) malloc(sizeof (GDS_HEAD) + MAX_PROJ_SIZE))) { 
+	DPRINT1 ("%s: MALloced true Grib struct failed\n",func);
+	sprintf(errmsg,"%s: MALloced true Grib struct failed\n",func);
+	goto BYE; 
+	}
+   else memset ((void *)pgds, '\0', sizeof(GDS_HEAD) + MAX_PROJ_SIZE);
+
+/*
+*
+* A.4       ASSIGN (GDS_HEAD *pGDS_Head) to be beginning of local PGDS block 
+*           ASSIGN (void *pvGDS_Proj) to byte #7 of local PGDS block
+*/
+   pGDS_Head  = (GDS_HEAD *) pgds;
+   pvGDS_Proj = (void *) (pgds + sizeof(GDS_HEAD));
+	 
+/*
+*
+* A.5       INIT some fields of GDS_HEAD & GDS_HEAD_INPUT structs
+*/
+   pGDS_Head->chNV 	    = ( unsigned char ) 0;
+   pGDS_Head->chPV 	    = ( unsigned char ) 255;
+   pGDS_Head_Input->usNum_v = 0;    /* INPUT NOT USED AT THIS TIME */
+   pGDS_Head_Input->usPl_Pv = 255;    
+
+ 
+/*
+*
+*           !now fill true GRIB Grid Defn Sect depending on Projection type
+* A.6.a     IF (projection is Spherical) THEN
+*/
+   if ((strcmp(Geom_In.prjn_name,"spherical")==0) || 
+       (strcmp(Geom_In.prjn_name,"gaussian") == 0)){
+/*
+* A.6.a.1      FUNCTION create_inpLatlon !create internal Latlon struct 
+*                                        !using GEOM_IN & USER_INPUT
+* A.6.a.2      FUNCTION inp2grib_Latlon  !use internal Latlon struct to 
+*                                        !make true Latlon Grib Gds
+* A.6.a.3      IF (either failed) THEN
+*                  FUNCTION upd_child_errmsg   !tack funcname to errmsg
+*                  RETURN with error     !errmsg filled
+*              ENDIF
+*/
+
+     if ( create_inpLatlon(Geom_In, ppvGDS_Proj_Input,errmsg)
+          || inp2grib_Latlon (ppvGDS_Proj_Input, 
+		       (LATLON *)(pgds+sizeof(GDS_HEAD)),&lProj_sz, errmsg))
+	 { 
+	  upd_child_errmsg (func, errmsg); goto BYE; 
+	 }
+
+/*
+* A.6.a.4      STORE Gds len, DataType=0 into internal GDS struct
+*/
+     pGDS_Head_Input->uslength = sizeof(GDS_HEAD) + lProj_sz;
+     if (strcmp(Geom_In.prjn_name,"spherical")==0) {
+       pGDS_Head_Input->usData_type = LATLON_PRJ;
+       pGDS_Head->chData_type = 0;
+     } else {
+       pGDS_Head_Input->usData_type = GAUSS_PRJ;
+       pGDS_Head->chData_type = 4;
+     }
+   }
+
+/*
+* A.6.b     ELSE IF (projection is Lambert) THEN
+*/
+   else if (strcmp(Geom_In.prjn_name,"lambert")==0)
+   {
+ /*
+* A.6.b.1      FUNCTION create_inpLambert !create internal Lambert struct 
+*                                         !using GEOM_IN & USER_INPUT
+* A.6.b.2      FUNCTION inp2grib_Lambert  !use internal Lambert struct to 
+*                                         !make true Lambert Grib Gds
+* A.6.b.3      IF (either failed) THEN
+*                  FUNCTION upd_child_errmsg   !tack funcname to errmsg
+*                  RETURN with error           !errmsg filled
+*              ENDIF
+*/
+    if ( create_inpLambert(Geom_In,ppvGDS_Proj_Input,errmsg)
+        || inp2grib_Lambert( ppvGDS_Proj_Input, 
+		    (LAMBERT *)(pgds+sizeof(GDS_HEAD)), &lProj_sz, errmsg))
+	 { 
+	   upd_child_errmsg (func, errmsg); goto BYE; 
+	 }
+
+/*
+* A.6.b.4      STORE Gds len, DataType=3 into internal GDS struct
+*/
+     pGDS_Head_Input->uslength = sizeof(GDS_HEAD) + lProj_sz;
+     pGDS_Head_Input->usData_type = LAMB_PRJ; 
+     pGDS_Head->chData_type = 3;
+   }
+
+/*
+* A.6.c     ELSE if (projection is Polar_Stereo) THEN
+*/
+   else if (strcmp(Geom_In.prjn_name,"polar_stereo")==0)
+   {
+/*
+* A.6.c.1      FUNCTION create_inpPolar 
+*              !create internal Polar struct using GEOM_IN & USER_INPUT
+* A.6.c.2      FUNCTION inp2grib_PolarSt
+*              !use internal PolarSt struct to make true PolarSt Grib Gds
+* A.6.c.3      IF (either failed) THEN
+*                  FUNCTION upd_child_errmsg   !tack funcname to errmsg
+*                  RETURN with error           !errmsg filled
+*              ENDIF
+*/
+/* make True Grib PPVGDS_PROJ & SIZE using internal ppvGds_proj_input :  */
+
+     if (create_inpPolar(Geom_In, ppvGDS_Proj_Input,errmsg)
+         || inp2grib_PolarSt(ppvGDS_Proj_Input, 
+	     	(void *)(pgds+sizeof(GDS_HEAD)),&lProj_sz, errmsg) )
+	 { 
+	   upd_child_errmsg (func, errmsg); goto BYE; 
+	 }
+
+/*
+* A.6.c.4      STORE Gds len, DataType=5 into internal GDS struct
+*/
+     pGDS_Head_Input->uslength = sizeof(GDS_HEAD) + lProj_sz;
+     pGDS_Head_Input->usData_type = POLAR_PRJ; 
+     pGDS_Head->chData_type = 5;
+   }
+
+/*
+* A.6.c     ELSE if (projection is Mercator) THEN
+*/
+   else if (strcmp(Geom_In.prjn_name,"mercator")==0)
+   {
+/*
+* A.6.c.1      FUNCTION create_inpMercator
+*              !create internal Mercator struct using GEOM_IN & USER_INPUT
+* A.6.c.2      FUNCTION inp2grib_Mercator
+*              !use internal Mercator struct to make true PolarSt Grib Gds
+* A.6.c.3      IF (either failed) THEN
+*                  FUNCTION upd_child_errmsg   !tack funcname to errmsg
+*                  RETURN with error           !errmsg filled
+*              ENDIF
+*/
+/* make True Grib PPVGDS_PROJ & SIZE using internal ppvGds_proj_input :  */
+
+     if (create_inpMercator(Geom_In, ppvGDS_Proj_Input,errmsg)
+         || inp2grib_Mercator(ppvGDS_Proj_Input, 
+	     	(void *)(pgds+sizeof(GDS_HEAD)),&lProj_sz, errmsg) )
+	 { 
+	   upd_child_errmsg (func, errmsg); goto BYE; 
+	 }
+
+/*
+* A.6.c.4      STORE Gds len, DataType=5 into internal GDS struct
+*/
+     pGDS_Head_Input->uslength = sizeof(GDS_HEAD) + lProj_sz;
+     pGDS_Head_Input->usData_type = MERC_PRJ; 
+     pGDS_Head->chData_type = 1;
+   }
+
+/*
+* A.6.d     ELSE   ! Projection unknown
+*/
+   else {
+/*
+*              RETURN with error           !errmsg filled
+*/
+     DPRINT2 ("%s: Projection '%s' unknown\n",func,Geom_In.prjn_name);
+     sprintf (errmsg,"%s: Projection '%s' unknown\n",func,Geom_In.prjn_name);
+     goto BYE;
+/*
+* A.6.d     ENDIF
+*/
+   }
+
+/*
+*
+* A.7       STORE ptr to Gds and its Length in Grib hdr
+*/
+  gh->gds_ptr     = gh->entire_msg + gh->msg_length;
+  gh->gds_len     = sizeof(GDS_HEAD) + lProj_sz;
+  DPRINT3 ("Gds length= (%ld + %ld)= %ld \n", 
+  sizeof(GDS_HEAD), lProj_sz, gh->gds_len);
+
+/*
+*
+* A.8       STORE Gds length in the True Grib GDS block too
+*/
+  set_bytes(gh->gds_len, 3, pGDS_Head->achGDS_length);
+
+/*
+*
+* A.9       IF gribhdr's buffer is too small AND
+*               FUCTION Expand_gribhdr failed 
+*           THEN
+*               RETURN with error   !errmsg filled
+*           ENDIF
+*/
+  new_msgsz= gh->msg_length + gh->gds_len;
+
+      if (new_msgsz  > gh->abs_size
+        && Expand_gribhdr (gh, new_msgsz, errmsg) !=0)
+        {
+        upd_child_errmsg (func, errmsg);
+        goto BYE;
+        }
+
+/*
+*
+* A.10      UPDATE Grib Header Struct
+*           !copy true BDS block into Grib Header's Entire_Msg array;
+*           !add gds length to Message length 
+*/
+   memcpy ((void *)gh->gds_ptr, (void *)pgds, gh->gds_len);
+   gh->msg_length += gh->gds_len;
+   DPRINT1 ("copying %ld bytes from PGDS to gh->GDS_PTR \n", gh->gds_len);
+/*
+* 
+* A.11      CHANGE return Status to no errors
+*/
+   stat = 0;
+
+BYE:
+/*
+*
+* A.12      FREE up storage
+*
+* A.13      RETURN Status
+*/
+   if (pgds) free (pgds);
+   DPRINT3 ("Leaving %s, stat=%d, errmsg='%s'\n", func,stat,errmsg);
+   return stat;
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
+
+/*
+*
+*********************************************************************
+* B. FUNCTION:  create_inpLambert
+*       Fills Lambert Projection structure. 
+*
+*    INTERFACE:
+*       int create_inpLambert ( geom_in, ppvGDS_Proj_Input, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*     (I)  GEOM_IN geom_in            Holds info to fill local Lambert block
+*     (O)  void **ppvGDS_Proj_Input   pre-allocated block to be filled;
+*     (O)  char *errmsg               returns filled if error occurred
+*
+*     RETURN CODE
+*      0> success, ppvGDS_Proj_Input holds Lambert projection information;
+*      1> the input pre-MAlloced projection block is null;  errmsg filled;
+**********************************************************************/
+
+#if PROTOTYPE_NEEDED
+int create_inpLambert (GEOM_IN geom_in, void **ppvGDS_Proj_Input, char *errmsg)
+#else
+int create_inpLambert (geom_in, ppvGDS_Proj_Input, errmsg)
+		GEOM_IN geom_in; void **ppvGDS_Proj_Input; char *errmsg;
+#endif
+{
+char *func= "create_inpLambert";
+/*
+*
+* B.1       DEFAULT status of 0
+*/
+   int            nStatus = 0;
+   double	  cut1, cut2, tmp;
+   GDS_LAM_INPUT  *pGDS_Lam_Input;
+
+   DPRINT1 ( "   Entering %s.....\n", func );
+/*
+*
+* B.2       IF (incoming projection block is Null)
+*           THEN
+*              FILL errmsg
+*              SET return status to error
+*/
+   if (!(pGDS_Lam_Input= (GDS_LAM_INPUT *) *ppvGDS_Proj_Input) )
+     {
+      DPRINT1 ( "%s: ppvGDS_Proj_Input is null\n", func);
+      sprintf(errmsg, "%s: ppvGDS_Proj_Input is null\n", func);
+      nStatus = 1;
+      }
+/*
+* B.2.b     ELSE
+*               USE info from GEOM_IN to fill the Lambert GDS struct
+*/
+   else
+   {
+   pGDS_Lam_Input->usData_type = LAMB_PRJ; /* data type flag (Tbl  ) */
+   pGDS_Lam_Input->iNx = (int) geom_in.nx; /* #pts along x-axis */
+   pGDS_Lam_Input->iNy = (int) geom_in.ny;/* #pts along y-axis */  
+  /* latitude & lon of 1st grid point */
+   pGDS_Lam_Input->lLat1 = lrint(geom_in.first_lat *1000.); 
+   pGDS_Lam_Input->lLon1 = lrint((geom_in.first_lon) *1000.); 
+   pGDS_Lam_Input->usRes_flag = geom_in.usRes_flag;/*Resolution flags Tbl7*/
+   pGDS_Lam_Input->lLon_orient=lrint(geom_in.parm_3 *1000.);/*grid orient */
+   pGDS_Lam_Input->ulDx=(unsigned long)lrint(geom_in.x_int_dis*1000.);/*Xdir gridlen*/
+   pGDS_Lam_Input->ulDy=(unsigned long)lrint(geom_in.y_int_dis*1000.);/*Ydir gridlen*/
+   if ((geom_in.y_int_dis != 0) && (geom_in.x_int_dis != 0))
+         pGDS_Lam_Input->usRes_flag = pGDS_Lam_Input->usRes_flag + 0x80;
+   if (geom_in.parm_1 > 0) 
+     pGDS_Lam_Input->usProj_flag = 0;              /* projection flag */
+   else
+     pGDS_Lam_Input->usProj_flag = 1<<7;              /* projection flag */
+   pGDS_Lam_Input->usScan_mode = geom_in.scan; /* order of grid points (Tbl8)*/
+  /*  Make sure CUT1 is closest to Pole  */
+   cut1 = geom_in.parm_1;
+   cut2 = geom_in.parm_2;
+   if (cut1 >= 0.) {
+      if (cut2 > cut1) { tmp = cut1; cut1 = cut2; cut2 = tmp; }
+      }
+   else {
+      if (cut2 < cut1) { tmp = cut1; cut1 = cut2; cut2 = tmp; }
+      }
+    
+   pGDS_Lam_Input->lLat_cut1=lrint(cut1 *1000.);/* 1stlat fr pole secant cuts*/
+   pGDS_Lam_Input->lLat_cut2=lrint(cut2 *1000.);/* 2ndlat fr pole secant cuts*/
+   pGDS_Lam_Input->lLat_southpole = -90000; /* lat of southern pole (millidegrees) */
+   pGDS_Lam_Input->lLon_southpole = 0; /* lon of souther pole (millidegrees) */
+   pGDS_Lam_Input->usZero = 0;         /* filler zeroes */
+
+/*
+*               DEBUG print
+*/
+   DPRINT3("\t%s: usData_type = %u (%s)\n",
+   func,pGDS_Lam_Input->usData_type, prjn_name[pGDS_Lam_Input->usData_type] );
+   DPRINT2("\t%s: iNx = %d\n", func,pGDS_Lam_Input->iNx );
+   DPRINT2("\t%s: iNy = %d\n", func,pGDS_Lam_Input->iNy );
+   DPRINT2("\t%s: lLat1 = %d\n", func,pGDS_Lam_Input->lLat1 );
+   DPRINT2("\t%s: lLon1 = %d\n", func,pGDS_Lam_Input->lLon1 );
+   DPRINT2("\t%s: lLon_orient = %d\n", func,pGDS_Lam_Input->lLon_orient);
+   DPRINT2("\t%s: ulDx = %u\n", func, pGDS_Lam_Input->ulDx );
+   DPRINT2("\t%s: ulDy = %u\n", func, pGDS_Lam_Input->ulDy );
+   DPRINT2("\t%s: lLat_cut1 = %d\n", func, pGDS_Lam_Input->lLat_cut1);
+   DPRINT2("\t%s: lLat_cut2 = %d\n", func, pGDS_Lam_Input->lLat_cut2);
+   DPRINT2("\t%s: usRes_flag = %u\n", func,pGDS_Lam_Input->usRes_flag);
+   DPRINT2("\t%s: usProj_flag = %u\n", func,pGDS_Lam_Input->usProj_flag);
+   DPRINT2("\t%s: usScan_mode = %u\n", func,pGDS_Lam_Input->usScan_mode);
+/*
+* B.2       ENDIF
+*/
+   }
+
+   DPRINT1("   Exiting %s.......\n" ,func);  
+/*
+*
+* B.3       RETURN status
+*/
+   return ( nStatus );
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
+
+/*
+*
+*********************************************************************
+* C. FUNCTION:  create_inpPolar
+*      Fills Polar Stereographic Projection structure.  
+*
+*    INTERFACE:
+*      int create_inpPolar (geom_in, ppvGDS_Proj_Input, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) GEOM_IN geom_in          holds info to fill local Polar block
+*      (O) void **ppvGDS_Proj_Input  block to filled with Polar Stereo info
+*      (O) char *errmsg              empty array filled if error occurs
+*
+*    RETURN CODE:
+*       0> success, ppvGDS_Proj_Input holds Polar projection info;
+*       1> the input pre-Malloced projection block is null; errmsg filled;
+**********************************************************************/
+
+#if PROTOTYPE_NEEDED
+int create_inpPolar (GEOM_IN geom_in, void **ppvGDS_Proj_Input, char *errmsg)
+#else
+int create_inpPolar (geom_in, ppvGDS_Proj_Input, errmsg)
+		GEOM_IN geom_in; void **ppvGDS_Proj_Input; char *errmsg;
+#endif
+{
+char	*func="create_inpPolar";
+/*
+*
+* C.1       DEFAULT status of 0
+*/
+   GDS_PS_INPUT   *pGDS_PS_Input;
+   int            nStatus = 0;
+
+   DPRINT1 ("   Entering %s.....\n",func );
+/*
+*
+* C.2       IF (incoming projection block is Null)
+* C.2.a     THEN
+*              FILL errmsg
+*              CHANGE return Status to error
+*/
+   if (!(pGDS_PS_Input= (GDS_PS_INPUT *) *ppvGDS_Proj_Input) )
+     {
+      DPRINT1  ("%s: ppvGDS_Proj_Input is null\n", func);
+      sprintf(errmsg,"%s: ppvGDS_Proj_Input is null\n", func);
+      nStatus = 1;
+      }
+
+   else {
+/* 
+* C.2.b     ELSE
+* C.2.b.1      FILL elements of Polar Stereo structure 
+*/
+   pGDS_PS_Input->usData_type = POLAR_PRJ;   /* data type flag (Tbl  ) */
+   pGDS_PS_Input->usNx = (unsigned short) geom_in.nx;/* #pts along x-axis*/
+   pGDS_PS_Input->usNy = (unsigned short) geom_in.ny;/* #pts along y-axiz*/  
+   pGDS_PS_Input->lLat1 = lrint(geom_in.first_lat *1000.);/*lat of 1st gridpt*/
+   pGDS_PS_Input->lLon1 = lrint(geom_in.first_lon *1000.);/*lon of 1st gridpt*/
+   pGDS_PS_Input->usRes_flag = geom_in.usRes_flag;/* resolution flags Tbl7 */
+   pGDS_PS_Input->lLon_orient = lrint(geom_in.parm_2 *1000.);/*grid orient*/
+   pGDS_PS_Input->ulDx=(unsigned long)lrint(geom_in.x_int_dis*1000.);/*Xdir gridlen*/
+   pGDS_PS_Input->ulDy=(unsigned long)lrint(geom_in.y_int_dis*1000.);/*Ydir gridlen*/
+   if ((geom_in.y_int_dis != 0) && (geom_in.x_int_dis != 0))
+         pGDS_PS_Input->usRes_flag = pGDS_PS_Input->usRes_flag + 0x80;
+   if (geom_in.first_lat > 0) 
+     pGDS_PS_Input->usProj_flag = 0;  /* projection flag */
+   else 
+     pGDS_PS_Input->usProj_flag = 1<<7;  /* projection flag */
+
+   pGDS_PS_Input->usScan_mode = geom_in.scan; /* order of grid points (Tbl 8) */
+   pGDS_PS_Input->usZero = 0;       /* filler zeroes */
+
+/* 
+* C.2.b.2      DEBUG print
+*/
+   DPRINT3 ("\t%s: usData_type = %u (%s)\n",func,pGDS_PS_Input->usData_type,
+   prjn_name [pGDS_PS_Input->usData_type] );
+   DPRINT2("\t%s: usNx = %u\n", func,pGDS_PS_Input->usNx );
+   DPRINT2("\t%s: usNy = %u\n", func,pGDS_PS_Input->usNy );
+   DPRINT2("\t%s: lLat1 = %d\n", func,pGDS_PS_Input->lLat1 );
+   DPRINT2("\t%s: lLon1 = %d\n", func,pGDS_PS_Input->lLon1 );
+   DPRINT2("\t%s: lLon_orient = %d\n", func,pGDS_PS_Input->lLon_orient);
+   DPRINT2("\t%s: ulDx = %u\n", func,pGDS_PS_Input->ulDx);
+   DPRINT2("\t%s: ulDy = %u\n", func,pGDS_PS_Input->ulDy);
+   DPRINT2("\t%s: usRes_flag = %u\n", func,pGDS_PS_Input->usRes_flag);
+   DPRINT2("\t%s: usProj_flag = %u\n", func,pGDS_PS_Input->usProj_flag);
+   DPRINT2("\t%s: usScan_mode = %u\n", func,pGDS_PS_Input->usScan_mode);
+/*
+* C.2.b     ENDIF
+*/
+   }
+
+   DPRINT1("   Exiting %s.......\n" ,func);  
+/*
+*
+* C.3       RETURN status
+*/
+   return ( nStatus );
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
+
+
+/*
+*
+*********************************************************************
+* D. FUNCTION:  create_inpLatlon
+*       Fills Latitude Longitude Projection structure.  
+*
+*    INTERFACE:
+*       int create_inpLatlon ( geom_in, ppvGDS_Proj_Input, errmsg) 
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) GEOM_IN geom_in           holds geom info to fill local Lat/Lon block
+*      (O) void **ppvGDS_Proj_Input  to be filled with LatLon projection info
+*      (O) char *errmsg              empty array, filled if error occurred
+*
+*     OUTPUT:
+*       0> success, ppGDS_Proj_Input filled with Lat/Lon projection info
+*       1> pre-Malloced Projection block is null;  errmsg filled;
+**********************************************************************/
+
+#if PROTOTYPE_NEEDED
+int create_inpLatlon (GEOM_IN geom_in, void **ppvGDS_Proj_Input, char *errmsg)
+#else
+int create_inpLatlon (geom_in, ppvGDS_Proj_Input, errmsg)
+		GEOM_IN geom_in; void **ppvGDS_Proj_Input; char *errmsg;
+#endif
+{
+char *func= "Create_InpLatLon";
+/*
+*
+* D.0       DEFAULT to return status of 0
+*/
+   GDS_LATLON_INPUT  *pGDS_Latlon_Input;
+   int            nStatus = 0;
+
+   DPRINT1 ("  Entering %s......\n" ,func);
+/*
+*
+* D.2       IF (incoming projection block is Null)
+*           THEN
+*              FILL errmsg
+*              CHANGE stat to 1
+*/
+   if (!(pGDS_Latlon_Input= (GDS_LATLON_INPUT *) *ppvGDS_Proj_Input) )
+     {
+      DPRINT1 (" %s: ppvGDS_Proj_Input is null\n", func);
+      sprintf(errmsg," %s: ppvGDS_Proj_Input is null\n", func);
+      nStatus = 1; 
+	} 
+/* 
+* D.2.b     ELSE 
+* D.2.b.1      FILL elements of the Lat/Lon GDS block 
+*/
+   else
+   {
+   
+   pGDS_Latlon_Input->usData_type = LATLON_PRJ;  /* data type flag (Tbl  )*/
+   pGDS_Latlon_Input->usNi=(unsigned short)geom_in.nx;/*#pts along x-axis 109*/
+   pGDS_Latlon_Input->usNj=(unsigned short)geom_in.ny;/* #pts along y-axiz 82*/
+   pGDS_Latlon_Input->lLat1=lrint(geom_in.first_lat*1000.);/*lat of 1stgridpt*/
+   pGDS_Latlon_Input->lLon1=lrint(geom_in.first_lon*1000.);/*lon of 1stgridpt*/
+   pGDS_Latlon_Input->usRes_flag=geom_in.usRes_flag;/*resolution flags Tbl7*/
+   pGDS_Latlon_Input->lLat2 =lrint(geom_in.last_lat*1000.);/*lat of 2ndgridpt*/
+   pGDS_Latlon_Input->lLon2 =lrint(geom_in.last_lon*1000.);/*lon of 2ndgridpt*/
+   pGDS_Latlon_Input->iDi = lrint(geom_in.parm_2 *1000.);/* i-dir incr*/
+   pGDS_Latlon_Input->iDj = lrint(geom_in.parm_1 *1000.);/* j-dir incr*/
+   if ((geom_in.parm_1 != 0) && (geom_in.parm_2 != 0))
+         pGDS_Latlon_Input->usRes_flag = pGDS_Latlon_Input->usRes_flag + 0x80;
+   pGDS_Latlon_Input->usScan_mode = geom_in.scan; /* order ofgridpts (Tbl 8)*/
+   pGDS_Latlon_Input->usZero = 0;  /* filler zeroes*/
+   pGDS_Latlon_Input->lLat_southpole= -90000;/* lat of southern pole (millidegrees)*/
+   pGDS_Latlon_Input->lLon_southpole= 0;/* lon of southern pole (millidegrees)*/
+   pGDS_Latlon_Input->lRotate = 0;/* angle of rotation*/
+   pGDS_Latlon_Input->lPole_lat = 0;/* lat of pole of stretching (mdeg)*/
+   pGDS_Latlon_Input->lPole_lon = 0; /* lon of pole of stretching*/
+   pGDS_Latlon_Input->lStretch = 0;/* stretching factor*/
+
+/*
+* D.2.b.2      DEBUG print
+*/
+   DPRINT3("\t%s: usData_type = %u (%s)\n", func,pGDS_Latlon_Input->usData_type,
+	prjn_name[pGDS_Latlon_Input->usData_type] );
+   DPRINT2("\t%s: usNi = %u\n",func,pGDS_Latlon_Input->usNi );
+   DPRINT2("\t%s: usNj = %u\n",func,pGDS_Latlon_Input->usNj );
+   DPRINT2("\t%s: lLat1 = %d\n",func,pGDS_Latlon_Input->lLat1 );
+   DPRINT2("\t%s: lLon1 = %d\n",func,pGDS_Latlon_Input->lLon1 );
+   DPRINT2("\t%s: lLat2 = %d\n",func,pGDS_Latlon_Input->lLat2 );
+   DPRINT2("\t%s: lLon2 = %d\n",func,pGDS_Latlon_Input->lLon2 );
+   DPRINT2("\t%s: iDi = %u\n",func,pGDS_Latlon_Input->iDi );
+   DPRINT2("\t%s: iDj = %u\n",func,pGDS_Latlon_Input->iDj );
+   DPRINT2("\t%s: usRes_flag = %u\n",func,pGDS_Latlon_Input->usRes_flag );
+   DPRINT2("\t%s: usScan_mode = %u\n",func,pGDS_Latlon_Input->usScan_mode );
+   DPRINT2("\t%s: lLat_southpole = %ld\n",func,pGDS_Latlon_Input->lLat_southpole);
+   DPRINT2("\t%s: lLon_southpole = %ld\n",func,pGDS_Latlon_Input->lLon_southpole);
+   DPRINT2("\t%s: lRotate = %ld\n",func,pGDS_Latlon_Input->lRotate );
+   DPRINT2("\t%s: lPole_lat = %ld\n",func,pGDS_Latlon_Input->lPole_lat );
+   DPRINT2("\t%s: lPole_lon = %ld\n",func,pGDS_Latlon_Input->lPole_lon );
+   DPRINT2("\t%s: lStretch = %ld\n",func,pGDS_Latlon_Input->lStretch );
+/*
+* D.2.b    ENDIF
+*/
+   }
+/*
+*
+* D.3      RET2URN status
+*/
+   DPRINT1("   Exiting %s.......\n" ,func);  
+   return ( nStatus );
+/*
+* END OF FUNCTION
+*
+*/ 
+}
+
+/*
+*
+*********************************************************************
+* FUNCTION:  create_inpMercator
+*      Fills Mercator Projection structure.  
+*
+*    INTERFACE:
+*      int create_inpMercator (geom_in, ppvGDS_Proj_Input, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) GEOM_IN geom_in          holds info to fill local Mercator block
+*      (O) void **ppvGDS_Proj_Input  block to filled with Mercator info
+*      (O) char *errmsg              empty array filled if error occurs
+*
+*    RETURN CODE:
+*       0> success, ppvGDS_Proj_Input holds Mercator projection info;
+*       1> the input pre-Malloced projection block is null; errmsg filled;
+**********************************************************************/
+
+#if PROTOTYPE_NEEDED
+int create_inpMercator (GEOM_IN geom_in, void **ppvGDS_Proj_Input, char *errmsg)
+#else
+int create_inpMercator (geom_in, ppvGDS_Proj_Input, errmsg)
+		GEOM_IN geom_in; void **ppvGDS_Proj_Input; char *errmsg;
+#endif
+{
+char	*func="create_inpMercator";
+/*
+*
+* C.1       DEFAULT status of 0
+*/
+   mercator       *pGDS_mercator_Input;
+   int            nStatus = 0;
+
+   DPRINT1 ("   Entering %s.....\n",func );
+/*
+*
+* C.2       IF (incoming projection block is Null)
+* C.2.a     THEN
+*              FILL errmsg
+*              CHANGE return Status to error
+*/
+   if (!(pGDS_mercator_Input= (mercator *) *ppvGDS_Proj_Input) )
+     {
+      DPRINT1  ("%s: ppvGDS_Proj_Input is null\n", func);
+      sprintf(errmsg,"%s: ppvGDS_Proj_Input is null\n", func);
+      nStatus = 1;
+      }
+
+   else {
+/* 
+* C.2.b     ELSE
+* C.2.b.1      FILL elements of Polar Stereo structure 
+*/
+   pGDS_mercator_Input->usData_type = MERC_PRJ;   /* data type flag (Tbl  ) */
+   pGDS_mercator_Input->cols = (unsigned short) geom_in.nx;/* #pts along x-axis*/
+   pGDS_mercator_Input->rows = (unsigned short) geom_in.ny;/* #pts along y-axiz*/  
+   pGDS_mercator_Input->first_lat = lrint(geom_in.first_lat *1000.);/*lat of 1st gridpt*/
+   pGDS_mercator_Input->first_lon = lrint(geom_in.first_lon *1000.);/*lon of 1st gridpt*/
+   pGDS_mercator_Input->usRes_flag = geom_in.usRes_flag;/* resolution flags Tbl7 */
+   pGDS_mercator_Input->La2 = lrint(geom_in.last_lat *1000.);/*lat of last gridpt*/
+   pGDS_mercator_Input->Lo2 = lrint(geom_in.last_lon *1000.);/*lon of last gridpt*/
+   pGDS_mercator_Input->latin = lrint(geom_in.parm_1 *1000.);/*reference latitude*/
+   pGDS_mercator_Input->usZero1 = 0; /* filler zeroes */
+   pGDS_mercator_Input->usScan_mode = geom_in.scan; /* order of grid points (Tbl 8) */
+   pGDS_mercator_Input->lon_inc = lrint(geom_in.parm_2 *1000.);/*longitude increment*/
+   pGDS_mercator_Input->lat_inc = lrint(geom_in.parm_3 *1000.);/*latitude increment*/
+   pGDS_mercator_Input->usZero = 0;  /* filler zeroes */
+
+/* 
+* C.2.b.2      DEBUG print
+*/
+   DPRINT3 ("\t%s: usData_type = %u (%s)\n",func,pGDS_mercator_Input->usData_type,
+   prjn_name [pGDS_mercator_Input->usData_type] );
+   DPRINT2("\t%s: cols = %u\n", func,pGDS_mercator_Input->cols );
+   DPRINT2("\t%s: rows = %u\n", func,pGDS_mercator_Input->rows );
+   DPRINT2("\t%s: first_lat = %d\n", func,pGDS_mercator_Input->first_lat );
+   DPRINT2("\t%s: first_lon = %d\n", func,pGDS_mercator_Input->first_lon );
+   DPRINT2("\t%s: usRes_flag = %d\n", func,pGDS_mercator_Input->usRes_flag);
+   DPRINT2("\t%s: La2 = %d\n", func,pGDS_mercator_Input->La2);
+   DPRINT2("\t%s: Lo2 = %d\n", func,pGDS_mercator_Input->Lo2);
+   DPRINT2("\t%s: latin = %d\n", func,pGDS_mercator_Input->latin);
+   DPRINT2("\t%s: usZero1 = %d\n", func,pGDS_mercator_Input->usZero1);
+   DPRINT2("\t%s: usScan_mode = %d\n", func,pGDS_mercator_Input->usScan_mode);
+   DPRINT2("\t%s: lon_inc = %f\n", func,pGDS_mercator_Input->lon_inc);
+   DPRINT2("\t%s: lat_inc = %f\n", func,pGDS_mercator_Input->lat_inc);
+/*
+* C.2.b     ENDIF
+*/
+   }
+
+   DPRINT1("   Exiting %s.......\n" ,func);  
+/*
+*
+* C.3       RETURN status
+*/
+   return ( nStatus );
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
+
+
+
+
+
+
+
+
+/*
+*
+****************************************************************************
+* E. FUNCTION:  inp2gribLambert
+*      This routine fills the special Lambert Projection structure for
+*      the GDS.
+*
+*    INTERFACE:
+*       int inp2grib_Lambert (ppvGDS_Proj_Input, pLambert, lProj_size, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) void  **ppvGDS_Proj_Input; 
+*          pointer to struct holds Input Projection data 
+*      (O) LAMBERT *pLambert;
+*          block to be filled with Lambert Projection information
+*      (O) long  *lProj_size;
+*          to be filled with size of LAMBERT struct;
+*      (O) char *errmsg;
+*          empty array, filled if error occurred;
+*
+*    RETURN CODE:
+*      0> success,  pLambert and lProj_size filled;
+*      1> got null pointers; errmsg filled;
+****************************************************************************/
+
+#if PROTOTYPE_NEEDED
+int   inp2grib_Lambert (void **ppvGDS_Proj_Input, LAMBERT  *pLambert,
+			long *lProj_size, char *errmsg)
+#else
+int   inp2grib_Lambert (ppvGDS_Proj_Input, pLambert, lProj_size, errmsg)
+			void **ppvGDS_Proj_Input; LAMBERT  *pLambert;
+			long *lProj_size; char *errmsg;
+#endif
+{
+/*
+* E.1       INIT status to success
+*
+* E.2       DEBUG printing
+*/
+   GDS_LAM_INPUT     *vProjInp = 0;
+   long              lTemp = 0;
+   int               nStatus = 0;
+   char		     *func= "inp2grib_Lambert";
+   long              tmp_byte4;
+   DPRINT1 ("   Entering %s.....\n",func);
+
+/*
+* 
+* E.3       MAKE local ptr vProjInp point to Input Projection data block arg
+*/
+   vProjInp = ( GDS_LAM_INPUT * ) *ppvGDS_Proj_Input;    /* read fr this */
+
+/*
+* 
+* E.4       IF (either of the user's struct pointers are NUL) THEN
+*              SET status = 1
+*              RETURN
+*           ENDIF
+*/
+   if (!vProjInp || !pLambert)   {
+	DPRINT1 ("%s: the VOID *ppvGDS_Proj_Input block is null\n",func);
+	sprintf(errmsg, "%s: the VOID *ppvGDS_Proj_Input block is null\n",func);
+	nStatus=  1; 
+	goto BYE; 
+	}
+
+/*
+* E.5       FILL local block type LAMBERT
+*/
+  
+      set_bytes(vProjInp->iNx, 2, pLambert->achNx);
+      
+      set_bytes(vProjInp->iNy, 2, pLambert->achNy);
+
+/* convert lLat1 to 3chars */
+      set_bytes(vProjInp->lLat1, 3, pLambert->achLat1);
+
+/* convert lLon1 to 3chars */
+      set_bytes(vProjInp->lLon1, 3, pLambert->achLon1);
+
+      pLambert->chRes_flag = ( unsigned char ) vProjInp->usRes_flag;
+
+/* convert lLon_orient to 3 bytes */
+      set_bytes(vProjInp->lLon_orient, 3, pLambert->achLon_orient);
+
+/* convert ulDx to 3 bytes */
+      set_bytes(vProjInp->ulDx, 3, pLambert->achDx);
+   
+/* convert ulDy to 3 bytes */
+      set_bytes(vProjInp->ulDy, 3, pLambert->achDy);
+
+      pLambert->chProj_flag = ( unsigned char ) vProjInp->usProj_flag;
+      pLambert->chScan_mode = ( unsigned char ) vProjInp->usScan_mode;
+
+/* convert lLat_cut1 to 3 chars */
+      set_bytes(vProjInp->lLat_cut1, 3, pLambert->achLat_cut1);
+
+/* convert lLat_cut2 to 3 chars */
+      set_bytes(vProjInp->lLat_cut2, 3, pLambert->achLat_cut2);
+
+/* convert lLat_southpole to 3chars */
+      set_bytes(vProjInp->lLat_southpole, 3, pLambert->achLat_southpole);
+
+/* convert lLon_southpole to 3 chars */
+      set_bytes(vProjInp->lLon_southpole, 3, pLambert->achLon_southpole);
+
+      set_bytes(vProjInp->usZero, 2, pLambert->achZero);
+
+/*
+*
+* E.6       DEBUG print Grib LAMBERT block
+*/
+  DPRINT3("\t%s: achNx [%02d,%02d]\n", func,
+  pLambert->achNx[0],pLambert->achNx[1]);
+  DPRINT3("\t%s: achNy [%02d,%02d]\n", func, 
+  pLambert->achNy[0],pLambert->achNy[1]);
+  DPRINT4("\t%s: achLat1 [%02d,%02d,%02d]\n", func, 
+  pLambert->achLat1[0], pLambert->achLat1[1], pLambert->achLat1[2]);
+  DPRINT4("\t%s: achLon1 [%02d,%02d,%02d]\n", func,
+  pLambert->achLon1[0], pLambert->achLon1[1], pLambert->achLon1[2]);
+  DPRINT2("\t%s: chRes_flag [%02d]\n", func, pLambert->chRes_flag);
+  DPRINT4("\t%s: achLon_orient [%02d,%02d,%02d]\n", func, 
+  pLambert->achLon_orient[0], pLambert->achLon_orient[1], 
+  pLambert->achLon_orient[2]);
+  DPRINT4("\t%s: achDx [%02d,%02d,%02d]\n", func,
+  pLambert->achDx[0], pLambert->achDx[1], pLambert->achDx[2]);
+  DPRINT4("\t%s: achDy [%02d,%02d,%02d]\n", func, 
+  pLambert->achDy[0], pLambert->achDy[1], pLambert->achDy[2]);
+  DPRINT2("\t%s: chProj_flag [%02d]\n", func, pLambert->chProj_flag);
+  DPRINT2("\t%s: chScan_mode [%02d]\n", func, pLambert->chScan_mode);
+  DPRINT4("\t%s: achLat_cut1 [%02d,%02d,%02d]\n", func, 
+  pLambert->achLat_cut1[0], 
+  pLambert->achLat_cut1[1], pLambert->achLat_cut1[2]);
+  DPRINT4("\t%s: achLat_cut2 [%02d,%02d,%02d]\n", func, 
+  pLambert->achLat_cut2[0], 
+  pLambert->achLat_cut2[1], pLambert->achLat_cut2[2]);
+  DPRINT4("\t%s: achLat_southpole [%02d,%02d,%02d]\n",func,
+  pLambert->achLat_southpole[0], 
+  pLambert->achLat_southpole[1], pLambert->achLat_southpole[2] );
+  DPRINT4("\t%s: achLon_southpole [%02d,%02d,%02d]\n",func,
+  pLambert->achLon_southpole[0], 
+  pLambert->achLon_southpole[1], pLambert->achLon_southpole[2] );
+  DPRINT3("\t%s: achZero [%02d,%02d]\n", func, 
+  pLambert->achZero[0], pLambert->achZero[1]);
+/*******/
+
+/*
+*
+* E.7       STORE proj size of LAMBERT struct in  lProj_size 
+*/
+      
+      *lProj_size = sizeof (LAMBERT);
+
+BYE:
+      DPRINT3 ("   Exiting %s (lProj_size=%ld), stat=%d\n", func,
+      *lProj_size, nStatus);
+/*
+*
+* E.9       RETURN status
+*/
+   return ( nStatus );
+/* 
+* 
+* END OF FUNCTION
+*/ 
+}
+
+/*
+*
+****************************************************************************
+* F. FUNCTION:  inp2grib_PolarSt
+*      This routine fills the special Polar Stereo Projection structure for
+*      the GDS.
+*
+*    INTERFACE:
+*       int inp2grib_PolarSt ( ppvGDS_Proj_Input, Polar, lProj_size ,errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) void **ppvGDS_Proj_Input;  
+*          holds input projection data
+*      (O) POLAR *Polar;		
+*          to be filled with Polar Stereographic projection info
+*      (O) long *lProj_size;        
+*          to be filled with size of structure POLAR 
+*      (O) char *errmsg              
+*          empty array, filled if error occurred
+*
+*   RETURN CODE:
+*      0> success, Polar and lProj_size filled;
+*      1> pointers are null, errmsg filled;
+****************************************************************************/
+
+#if PROTOTYPE_NEEDED
+int   inp2grib_PolarSt  (void **ppvGDS_Proj_Input, POLAR *Polar, 
+			long *lProj_size , char *errmsg)
+#else
+int   inp2grib_PolarSt  (ppvGDS_Proj_Input, Polar, lProj_size , errmsg)
+			void **ppvGDS_Proj_Input; POLAR *Polar; 
+			long *lProj_size ; char *errmsg;
+#endif
+{
+/*
+* 
+* F.1       INIT variables !default stat=good
+*/
+   GDS_PS_INPUT      *pProjInp = 0;
+   int               lTemp = 0;
+   int               nStatus = 0;
+   char		     *func="inp2grib_PolarSt";
+
+   DPRINT1 ("\t Entering %s.....\n", func);
+/*
+*
+* F.2       POINT local pProjInp to incoming ppvGDS_Proj_Input
+*/
+   pProjInp = ( GDS_PS_INPUT *) *ppvGDS_Proj_Input;
+
+/*
+*
+* F.3       IF (true grib Polar proj block OR input Polar block is null) THEN
+*               SET Status=  1 
+*               RETURN;
+*           ENDIF
+*/
+    if (!Polar || !pProjInp ) 
+	{
+        DPRINT1 ( "%s:  Polar or pProjInp is null\n", func);
+        sprintf(errmsg,"%s:  Polar or pProjInp is null\n", func);
+	nStatus=  1; goto BYE; 
+	}
+
+/*
+*
+* F.4        FILL local struct from pProjInp
+*/
+/* convert usNx to 2 chars */
+      set_bytes(pProjInp->usNx, 2, Polar->achNx);
+   
+/* convert usNy to 2 chars */
+      set_bytes(pProjInp->usNy, 2, Polar->achNy);
+
+/* convert lLat1 to 3 chars */
+      set_bytes(pProjInp->lLat1, 3, Polar->achLat1);
+
+/* convert lLon1 to 3 chars */
+      set_bytes(pProjInp->lLon1, 3, Polar->achLon1);
+
+      Polar->chRes_flag = ( unsigned char ) pProjInp->usRes_flag;
+
+/* convert lLon_orient to 3 chars */
+      set_bytes(pProjInp->lLon_orient, 3, Polar->achLon_orient);
+
+/* convert ulDx to 3 char */
+      set_bytes(pProjInp->ulDx, 3, Polar->achDx);
+   
+/* convert ulDy to 3chars */
+      set_bytes(pProjInp->ulDy, 3, Polar->achDy);
+
+      Polar->chProj_flag = ( unsigned char ) pProjInp->usProj_flag;
+      Polar->chScan_mode = ( unsigned char ) pProjInp->usScan_mode;
+
+/* 4 bytes of zero */
+      memset((void*) Polar->achZero, '\0', 4);
+
+/* 
+*
+* F.5       DEBUG print GRIB Projection block
+*/
+  DPRINT3("\t%s: achNx [%02d,%02d]\n",func, Polar->achNx[0],Polar->achNx[1]);
+  DPRINT3("\t%s: achNy [%02d,%02d]\n",func, Polar->achNy[0],Polar->achNy[1]);
+  DPRINT4("\t%s: achLat1 [%02d,%02d,%02d]\n",func, Polar->achLat1[0],
+  Polar->achLat1[1], Polar->achLat1[2]);
+  DPRINT4("\t%s: achLon1 [%02d,%02d,%02d]\n",func, Polar->achLon1[0],
+   Polar->achLon1[1] , Polar->achLon1[2]);
+  DPRINT2("\t%s: chRes_flag [%02d]\n",func, Polar->chRes_flag);
+  DPRINT4("\t%s: achLon_orient [%02d,%02d,%02d]\n",func, 
+  Polar->achLon_orient[0], Polar->achLon_orient[1], Polar->achLon_orient[2]);
+  DPRINT4("\t%s: achDx [%02d,%02d,%02d]\n",func, Polar->achDx[0],
+  Polar->achDx[1], Polar->achDx[2]);
+  DPRINT4("\t%s: achDy [%02d,%02d,%02d]\n",func, Polar->achDy[0],
+  Polar->achDy[1], Polar->achDy[2]);
+  DPRINT2("\t%s: chProj_flag [%02d]\n",func, Polar->chProj_flag);
+  DPRINT2("\t%s: chScan_mode [%02d]\n",func, Polar->chScan_mode);
+  DPRINT5("\t%s: achZero [%02d,%02d,%02d,%02d]\n",func, Polar->achZero[0],
+  Polar->achZero[1],  Polar->achZero[2],  Polar->achZero[3]);
+/*******/
+
+/*
+*
+* F.7        STORE size of POLAR struct in lProj_size
+*/
+      *lProj_size = sizeof (POLAR);
+
+BYE:
+   DPRINT3 ("   Exiting %s (lProj_size=%ld), stat=%d\n", func,
+      *lProj_size, nStatus);
+/*
+*
+* F.8       RETURN Stat  ! 0 or  1
+*/
+   return ( nStatus );
+/* 
+* 
+* END OF FUNCTION
+*
+*
+*/ 
+}
+
+/*
+*
+****************************************************************************
+* G. FUNCTION:  inp2grib_Latlon
+*      This routine fills the Latitude Longitude Projection structure for
+*      the GDS.
+*
+*    INTERFACE:
+*       int inp2grib_Latlon ( ppvGDS_Proj_Input, pLatlon, lProj_size ,errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) void **ppvGDS_Proj_Input;  
+*          holds input projection data
+*      (O) LATLON *pLatlon;
+*          to be filled with Lat/Lon projection info
+*      (O) long *lProj_size;        
+*          to be filled with size of structure LATLON
+*      (O) char *errmsg;
+*          empty array, filled if error occurred
+*
+*    RETURN CODE:
+*      0>  success, pLatlon and lProj_size filled;
+*      1>  got null pointers, errmsg filled;
+****************************************************************************/
+#if PROTOTYPE_NEEDED
+int    inp2grib_Latlon  (void **ppvGDS_Proj_Input, LATLON *pLatlon,
+			long *lProj_size, char *errmsg)
+#else
+int    inp2grib_Latlon  (ppvGDS_Proj_Input, pLatlon, lProj_size, errmsg)
+			void **ppvGDS_Proj_Input; LATLON *pLatlon;
+			long *lProj_size; char *errmsg;
+#endif
+{
+   GDS_LATLON_INPUT  *Inp = 0;
+   int               lTemp = 0;
+   char 	*func= "inp2grib_Latlon";
+/*
+*
+* G.1       INIT status to success
+*/
+   int               nStatus = 0;
+   DPRINT1 ( "   Entering %s.....\n", func );
+/*
+*
+* G.2        ASSIGN arguments to local pointers
+*/
+  Inp  = (GDS_LATLON_INPUT *) *ppvGDS_Proj_Input;
+/*
+   DPRINT3("\n%s: usData_type = %u (%s)\n", func, Inp->usData_type,
+   prjn_name[Inp->usData_type] );
+   DPRINT2("\t%s: usNi = %u\n",func, Inp->usNi );
+   DPRINT2("\t%s: usNj = %u\n",func, Inp->usNj );
+   DPRINT2("\t%s: lLat1 = %d\n",func, Inp->lLat1 );
+   DPRINT2("\t%s: lLon1 = %d\n",func, Inp->lLon1 );
+   DPRINT2("\t%s: lLat2 = %d\n",func, Inp->lLat2 );
+   DPRINT2("\t%s: lLon2 = %d\n",func, Inp->lLon2 );
+   DPRINT2("\t%s: iDi = %u\n",func, Inp->iDi );
+   DPRINT2("\t%s: iDj = %u\n",func, Inp->iDj );
+   DPRINT2("\t%s: usRes_flag = %u\n",func, Inp->usRes_flag );
+   DPRINT2("\t%s: usScan_mode = %u\n",func, Inp->usScan_mode );
+   DPRINT2("\t%s: lLat_southpole = %ld\n",func, Inp->lLat_southpole);
+   DPRINT2("\t%s: lLon_southpole = %ld\n",func, Inp->lLon_southpole);
+   DPRINT2("\t%s: lRotate = %ld\n",func, Inp->lRotate );
+   DPRINT2("\t%s: lPole_lat = %ld\n",func, Inp->lPole_lat );
+   DPRINT2("\t%s: lPole_lon = %ld\n",func, Inp->lPole_lon );
+   DPRINT2("\t%s: lStretch = %ld\n",func, Inp->lStretch );
+*/
+
+/*
+*
+* G.3        IF (pointers passed in are null) THEN
+*                SET status to  1
+*                RETURN
+*            ENDIF
+*/
+  if ( !Inp || !pLatlon) { 
+	   DPRINT1 ("%s:  lLatlon_inp || pLatlon is null\n",func);
+	   sprintf(errmsg, "%s:  lLatlon_inp || pLatlon is null\n", func);
+	   nStatus =  1; 
+	   goto BYE; 
+	 }
+
+/*
+*
+* G.4       FILL local struct from Inp
+*/
+/* convert usNi & usNj to 2 chars */
+      set_bytes(Inp->usNi, 2, pLatlon->achNi);
+
+      set_bytes(Inp->usNj, 2, pLatlon->achNj);
+   
+/* convert lLat1 to 3chars */
+      set_bytes(Inp->lLat1, 3, pLatlon->achLat1);
+
+/* convert lLon1 to 3chars */
+      set_bytes(Inp->lLon1, 3, pLatlon->achLon1);
+
+      pLatlon->chRes_flag = ( unsigned char ) Inp->usRes_flag;
+
+/* convert lLat2 to 3chars */
+      set_bytes(Inp->lLat2, 3, pLatlon->achLat2);
+
+/* convert lLon2 to 3chars */
+      set_bytes(Inp->lLon2, 3, pLatlon->achLon2);
+
+/* convert lon increment to 2chars */
+      set_bytes(Inp->iDi, 2, pLatlon->achDi);
+
+/* convert lat increment to 2chars */
+      set_bytes(Inp->iDj, 2, pLatlon->achDj);
+
+/* 1 byte scan mode */
+      pLatlon->chScan_mode = ( unsigned char ) Inp->usScan_mode;
+
+/* 4 bytes of reserved zero */
+      memset ((void*)pLatlon->achZero, '\0', 4);
+
+/* convert lLat_southpole to 3chars */
+      set_bytes(Inp->lLat_southpole, 3, pLatlon->achLat_southpole);
+
+/* convert lLon_southpole to 3chars */
+      set_bytes(Inp->lLon_southpole, 3, pLatlon->achLon_southpole);
+
+/* convert lRotate to 4chars */
+      set_bytes(Inp->lRotate, 4, pLatlon->achRotate);
+
+/* convert lPole_lat to 3chars */
+      set_bytes(Inp->lPole_lat, 3, pLatlon->achPole_lat);
+
+/* convert lPole_lon to 3chars */
+      set_bytes(Inp->lPole_lon, 3, pLatlon->achPole_lon);
+
+/* convert lStretch to 4 chars */
+      set_bytes(Inp->lStretch, 4, pLatlon->achStretch);
+
+/*
+*
+* G.5       DEBUG print Input Proj Block & their equivalence in the Char array;
+*/
+  DPRINT3("\t%s: achNi [%02d,%02d]\n",func,pLatlon->achNi[0],pLatlon->achNi[1]);
+  DPRINT3("\t%s: achNj [%02d,%02d]\n",func,pLatlon->achNj[0],pLatlon->achNj[1]);
+  DPRINT4("\t%s: achLat1 [%02d,%02d,%02d]\n", 
+	func, pLatlon->achLat1[0],pLatlon->achLat1[1],pLatlon->achLat1[2]);
+  DPRINT4("\t%s: achLon1 [%02d,%02d,%02d]\n", func, 
+	pLatlon->achLon1[0],pLatlon->achLon1[1],pLatlon->achLon1[2]);
+  DPRINT2("\t%s: chRes_flag [%02d]\n", func, pLatlon->chRes_flag	);
+  DPRINT4("\t%s: achLat2 [%02d,%02d,%02d]\n", 
+	func, pLatlon->achLat2[0], pLatlon->achLat2[1], pLatlon->achLat2[2]);
+  DPRINT4("\t%s: achLon2 [%02d,%02d,%02d]\n", 
+	func, pLatlon->achLon2[0], pLatlon->achLon2[1], pLatlon->achLon2[2]);
+  DPRINT3("\t%s: achDi [%02d,%02d]\n",func,pLatlon->achDi[0],pLatlon->achDi[1]);
+  DPRINT3("\t%s: achDj [%02d,%02d]\n",func,pLatlon->achDj[0],pLatlon->achDj[1]);
+  DPRINT2("\t%s: chScan_mode [%02d]\n", func, pLatlon->chScan_mode);
+  DPRINT5("\t%s: achZero [%02d,%02d,%02d,%02d]\n", 
+	func, pLatlon->achZero[0],pLatlon->achZero[1],pLatlon->achZero[2],
+	pLatlon->achZero[3]);
+  DPRINT4("\t%s achLat_southpole [%02d,%02d,%02d]\n",
+        func, pLatlon->achLat_southpole[0],pLatlon->achLat_southpole[1],
+        pLatlon->achLat_southpole[2]);
+  DPRINT4("\t%s achLon_southpole [%02d,%02d,%02d]\n",
+        func, pLatlon->achLon_southpole[0],pLatlon->achLon_southpole[1],
+        pLatlon->achLon_southpole[2]);
+  DPRINT5("\t%s achRotate [%02d,%02d,%02d,%02d]\n",
+        func, pLatlon->achRotate[0],pLatlon->achRotate[1],
+        pLatlon->achRotate[2], pLatlon->achRotate[3]);
+  DPRINT4("\t%s achPole_lat [%02d,%02d,%02d]\n",
+        func, pLatlon->achPole_lat[0],pLatlon->achPole_lat[1],
+        pLatlon->achPole_lat[2]);
+  DPRINT4("\t%s achPole_lon [%02d,%02d,%02d]\n",
+        func, pLatlon->achPole_lon[0],pLatlon->achPole_lon[1],
+        pLatlon->achPole_lon[2]);
+  DPRINT5("\t%s achStretch [%02d,%02d,%02d,%02d]\n",
+    	func, pLatlon->achStretch[0],pLatlon->achStretch[1],
+	pLatlon->achStretch[2], pLatlon->achStretch[3]);
+/*******/
+/*
+*
+* G.6       STORE size of LATLON struct in lProj_size
+*/
+      *lProj_size = sizeof (LATLON);
+
+
+BYE:
+   DPRINT3 ("   Exiting %s (lProj_size=%ld), stat=%d\n", func,
+      *lProj_size, nStatus);
+/*
+*
+* G.7       RETURN stat 
+*/
+   return ( nStatus );
+/* 
+* 
+* END OF FUNCTION
+*
+*
+*/ 
+}
+/*
+*
+****************************************************************************
+* F. FUNCTION:  inp2grib_Mercator
+*      This routine fills the special Mercator Projection structure for
+*      the GDS.
+*
+*    INTERFACE:
+*       int inp2grib_Mercator ( ppvGDS_Proj_Input, Polar, lProj_size ,errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) void **ppvGDS_Proj_Input;  
+*          holds input projection data
+*      (O) MERCATOR *Mercator;		
+*          to be filled with Polar Stereographic projection info
+*      (O) long *lProj_size;        
+*          to be filled with size of structure POLAR 
+*      (O) char *errmsg              
+*          empty array, filled if error occurred
+*
+*   RETURN CODE:
+*      0> success, Mercator and lProj_size filled;
+*      1> pointers are null, errmsg filled;
+****************************************************************************/
+
+#if PROTOTYPE_NEEDED
+int   inp2grib_Mercator (void **ppvGDS_Proj_Input, MERCATOR *Mercator, 
+			long *lProj_size , char *errmsg)
+#else
+int   inp2grib_Mercator (ppvGDS_Proj_Input, Mercator, lProj_size , errmsg)
+			void **ppvGDS_Proj_Input; MERCATOR *Mercator; 
+			long *lProj_size ; char *errmsg;
+#endif
+{
+/*
+* 
+* F.1       INIT variables !default stat=good
+*/
+   mercator          *ProjInp = 0;
+   int               lTemp = 0;
+   int               nStatus = 0;
+   char		     *func="inp2grib_PolarSt";
+
+   DPRINT1 ("\t Entering %s.....\n", func);
+/*
+*
+* F.2       POINT local pProjInp to incoming ppvGDS_Proj_Input
+*/
+   ProjInp = ( mercator *) *ppvGDS_Proj_Input;
+
+/*
+*
+* F.3       IF (true grib Mercator proj block OR input Polar block is null) THEN
+*               SET Status=  1 
+*               RETURN;
+*           ENDIF
+*/
+    if (!Mercator || !ProjInp ) 
+	{
+        DPRINT1 ( "%s:  Mercator or ProjInp is null\n", func);
+        sprintf(errmsg,"%s: Mercator or ProjInp is null\n", func);
+	nStatus=  1; goto BYE; 
+	}
+
+/*
+*
+* F.4        FILL local struct from pProjInp
+*/
+/* convert cols to 2 chars */
+      set_bytes(ProjInp->cols, 2, Mercator->achNi);
+   
+/* convert rows to 2 chars */
+      set_bytes(ProjInp->rows, 2, Mercator->achNj);
+
+/* convert first_lat to 3 chars */
+      set_bytes(ProjInp->first_lat, 3, Mercator->achLat1);
+
+/* convert first_lon to 3 chars */
+      set_bytes(ProjInp->first_lon, 3, Mercator->achLon1);
+
+      Mercator->chRes_flag = ( unsigned char ) ProjInp->usRes_flag;
+
+/* convert La2 to 3 chars */
+      set_bytes(ProjInp->La2, 3, Mercator->achLat2);
+
+/* convert Lo2 to 3 chars */
+      set_bytes(ProjInp->Lo2, 3, Mercator->achLon2);
+
+/* convert lLon_orient to 3 chars */
+      set_bytes(ProjInp->latin, 3, Mercator->achLatin);
+
+/* convert zero fill */
+      Mercator->achZero1 = ( unsigned char ) ProjInp->usZero1;
+
+      Mercator->chScan_mode = ( unsigned char ) ProjInp->usScan_mode;
+
+/* convert ulDx to 3 char */
+      set_bytes(ProjInp->lon_inc, 3, Mercator->achDi);
+
+/* convert ulDy to 3chars */
+      set_bytes(ProjInp->lat_inc, 3, Mercator->achDj);
+
+      Mercator->chScan_mode = ( unsigned char ) ProjInp->usScan_mode;
+
+/* 8 bytes of zero */
+      memset((void*) Mercator->achZero2, '\0', 8);
+
+/* 
+*
+* F.5       DEBUG print GRIB Projection block
+*/
+  DPRINT3("\t%s: achNi [%02d,%02d]\n",func,Mercator->achNi[0],Mercator->achNi[1]);
+  DPRINT3("\t%s: achNj [%02d,%02d]\n",func, Mercator->achNj[0],Mercator->achNj[1]);
+  DPRINT4("\t%s: achLat1 [%02d,%02d,%02d]\n",func, Mercator->achLat1[0],
+  Mercator->achLat1[1], Mercator->achLat1[2]);
+  DPRINT4("\t%s: achLon1 [%02d,%02d,%02d]\n",func, Mercator->achLon1[0],
+   Mercator->achLon1[1] , Mercator->achLon1[2]);
+  DPRINT2("\t%s: chRes_flag [%02d]\n",func, Mercator->chRes_flag);
+  DPRINT4("\t%s: achLatint [%02d,%02d,%02d]\n",func, 
+  Mercator->achLatin[0], Mercator->achLatin[1], Mercator->achLatin[2]);
+  DPRINT4("\t%s: achDi [%02d,%02d,%02d]\n",func, Mercator->achDi[0],
+  Mercator->achDi[1], Mercator->achDi[2]);
+  DPRINT4("\t%s: achDj [%02d,%02d,%02d]\n",func, Mercator->achDj[0],
+  Mercator->achDj[1], Mercator->achDj[2]);
+  DPRINT5("\t%s: achZero2 [%02d,%02d,%02d,%02d]\n",func, Mercator->achZero2[0],
+  Mercator->achZero2[1],  Mercator->achZero2[2],  Mercator->achZero2[3]);
+/*******/
+
+/*
+*
+* F.7        STORE size of POLAR struct in lProj_size
+*/
+      *lProj_size = sizeof (MERCATOR);
+
+BYE:
+   DPRINT3 ("   Exiting %s (lProj_size=%ld), stat=%d\n", func,
+      *lProj_size, nStatus);
+/*
+*
+* F.8       RETURN Stat  ! 0 or  1
+*/
+   return ( nStatus );
+/* 
+* 
+* END OF FUNCTION
+*
+*
+*/ 
+}
+/*
+Old round--this is different from standard gnu round (gnu round returns a 
+float).  Depending on compile options, sometimes gnu round was used, other
+times this function was used.  Removed and replaced by lrint by T. Hutchinson,
+WSI.  4/14/05.
+long round(double value)
+{
+  long retval;
+  retval=lrint(value);
+  return retval;
+}
+*/
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribputpds.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribputpds.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/gribputpds.c	(revision 2744)
@@ -0,0 +1,511 @@
+/* FILENAME:   gribputpds.c */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdlib.h>
+#ifdef XT3_Catamount
+#include <features.h>
+#else
+#include <netinet/in.h>
+#endif
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+*
+****************************************************************************
+* A.  FUNCTION:  gribputpds
+*       Use the information provided to create a Product Defn Section of
+*       the GRIB format and store it in the GRIB_HDR structure;
+*
+*    INTERFACE:
+*       int gribputpds (Data_Input, User_Input, pPDS_Input, ppgrib_hdr, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  DATA_INPUT Data_Input;
+*           Structure containing info of this field (ids used in the Sections)
+*      (I)  USER_INPUT User_Input;
+*           Structure containing encoder configuration data
+*      (O)  PDS_INPUT  *pPDS_Input;
+*           points to an empty Structure;   to be filled with PDS info
+*           retrieved from  Data_Input and User_Input.
+*     (I&O) GRIB_HDR **ppgrib_hdr;
+*           points to Grib Header Structure;  May already have 1 or more
+*           GRIB sections in it;  Will have PDS appended to its 'entire_msg',
+*           'pds_ptr', 'pds_len' and 'mesg_len' updated also.
+*      (O)  char *errmsg;
+*           empty array, returned filled if error occurred
+* 
+*    RETURN CODE:
+*       0>  no errors;
+*           Grib Header structure now has PDS newly appended to its
+*           entire_msg buffer, its sections length, message length,
+*           and section pointers are updated.
+*	1>  error, errmsg filled;
+*           failed to make storage for PDS_GRIB, or
+*           failed to enlarge 'entire_msg' to hold new PDS block;
+*      99>  error in create_inpPDS() or inp2grib_PDS(); errmsg filled;
+****************************************************************************/
+
+#if PROTOTYPE_NEEDED
+int gribputpds ( DATA_INPUT 	Data_Input,
+		USER_INPUT 	User_Input,
+		PDS_INPUT 	*pPDS_Input,
+		GRIB_HDR 	**ppgrib_hdr,
+		char 		*errmsg)
+#else
+int gribputpds ( Data_Input, User_Input, pPDS_Input, ppgrib_hdr, errmsg)
+		DATA_INPUT 	Data_Input;
+		USER_INPUT 	User_Input;
+		PDS_INPUT 	*pPDS_Input;
+		GRIB_HDR 	**ppgrib_hdr;
+		char 		*errmsg;
+#endif
+{
+   PDS_GRIB  *pPDS_Grib=0; /* true GRIB format for pds */
+   GRIB_HDR  *gh;	   /* working var */
+   int       stat= 0;	   /* status */
+   long	     newsize=0L;   /* size of msg after adding PDS block */
+   /*void      create_inpPDS ();
+   int       inp2grib_PDS ();*/
+   char	     *func= "GribPutPDS";
+
+  DPRINT1("\nEntering %s()......\n", func);
+/*
+*
+* A.1       FUNCTION create_inpPDS   	        !void
+*           !create internal struct PDS_INPUT from DATA_INPUT & USER_INPUT
+*/
+   create_inpPDS (Data_Input, User_Input, pPDS_Input);
+
+/*
+*
+* A.2       MALLOC local struct PDS_GRIB, clear it out;
+*           IF (fails) THEN
+*               SET bad stat
+*               RETURN
+*           ELSE 
+*               CLEAR out the struct
+*           ENDIF
+*/
+  if ( !(pPDS_Grib= (PDS_GRIB *)malloc(sizeof(PDS_GRIB))) )
+    {	
+     sprintf(errmsg,"%s:  failed storage for PDS_GRIB\n",func);
+     stat=1; goto BYE; 
+    }
+   else memset ((void *)pPDS_Grib, '\0', sizeof(PDS_GRIB));
+
+/*
+*
+* A.3       FUNCTION inp2grib_PDS   
+*           !convert internal PDS_INPUT to true Grib format PDS_GRIB
+*           IF (error) THEN
+*               SAVE error from func in stat
+*               RETURN
+*           ENDIF
+*/
+   if (stat = inp2grib_PDS (pPDS_Input, &pPDS_Grib, errmsg))
+	 { upd_child_errmsg (func, errmsg);
+	   goto BYE; 
+	 }
+/*
+*
+* A.4       CALCULATE new msg length after adding new PDS
+*/
+  DPRINT0("putting Pds into Grib Hdr struct\n");
+
+  gh= *ppgrib_hdr;
+  newsize= gh->msg_length + sizeof(PDS_GRIB);
+
+/*
+*
+* A.5       IF gribhdr's buffer is too small AND
+*               FUCTION Expand_gribhdr failed 
+*           THEN
+*               SET stat = 1
+*               RETURN with error   !errmsg filled
+*           ENDIF
+*/
+     if (newsize > gh->abs_size
+        && Expand_gribhdr (gh, newsize, errmsg) !=0)
+        {
+        stat = 1;
+        upd_child_errmsg (func, errmsg);
+        goto BYE;
+        }
+
+/*
+*
+* A.6       COPY Pds and its info into Grib Header
+*           !copy PDS_GRIB struct to the end of Entire_msg array;
+*           !store pds pointer and length
+*           !update msg length
+*/
+   gh->pds_ptr= gh->entire_msg + gh->msg_length;
+   memcpy ((void *) gh->pds_ptr, (void *) pPDS_Grib, sizeof (PDS_GRIB));
+   gh->pds_len    = sizeof(PDS_GRIB);
+   gh->msg_length += gh->pds_len;
+
+   DPRINT1 ("copied PDS_GRIB(%ld) bytes from pPDS_Grib to PDS_PTR\n",
+     	sizeof(PDS_GRIB));
+
+/*
+*
+* A.7       FREE up local struct PDS_GRIB
+*
+* A.8       RETURN to caller with stat
+*/
+BYE:
+   if (pPDS_Grib!=NULL) free (pPDS_Grib);
+   DPRINT2 ("Leaving %s(), stat=%d\n", func,stat);
+   return stat;
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
+
+/*
+*
+*********************************************************************
+* B. FUNCTION:  create_inpPDS
+*        Fill the internal Product Defn Section structure with info
+*        retrieved from the 2 input structures DATA_INPUT and USER_INPUT.
+*
+*    INTERFACE:
+*        void  create_inpPDS (Data_Input, User_Input, pPDS_Input)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  DATA_INPUT Data_Input;   holds ids to be used in Sections
+*      (I)  USER_INPUT User_Input;   holds encoder configuration info
+*      (O)  PDS_INPUT *pPDS_Input;   pre-allocated structure to be filled;
+*
+*    RETURN CODE:   none;
+**********************************************************************
+*/
+#if PROTOTYPE_NEEDED
+void  create_inpPDS ( DATA_INPUT Data_Input, USER_INPUT User_Input,
+			PDS_INPUT *pPDS_Input)
+#else
+void  create_inpPDS ( Data_Input, User_Input, pPDS_Input)
+			DATA_INPUT Data_Input; 
+			USER_INPUT User_Input;
+			PDS_INPUT *pPDS_Input;
+#endif
+{
+int i;
+
+   DPRINT0 ( "Entering create_inpPDS ()\n" );
+/*
+*
+* B.1       LOAD info from struct USER_INPUT into struct PDS_INPUT 
+*/
+
+/* assigns the values from USER_INPUT to PDS_Input */
+   pPDS_Input->usEd_num = (unsigned short) 1; /* GRIB Edition num */
+   pPDS_Input->usParm_tbl = User_Input.usParm_tbl; /* GRIB TblVersion num */
+   pPDS_Input->usSub_tbl = User_Input.usSub_tbl; /* Local TblVersion num */
+   pPDS_Input->usCenter_id = User_Input.usCenter_id; /* Originating Ctr-Tbl0*/
+   pPDS_Input->usProc_id = Data_Input.usProc_id; /* Model id */
+   pPDS_Input->usGrid_id = Data_Input.usGrid_id; /* Grid id num */
+   pPDS_Input->usGds_bms_id = User_Input.usGds_bms_id; /* GDS/BMS flag-Tbl1 */
+   pPDS_Input->usParm_id = Data_Input.usParm_id; /* Parameter& Units id -Tbl2 */
+   pPDS_Input->usParm_sub = Data_Input.usParm_sub_id;/* Sub-Tblentry for Tbl2 */
+   pPDS_Input->usLevel_id = Data_Input.usLevel_id; /* Type of level/layer-Tbl3*/ /* Height, pressure of level 1  and 2 */ 
+   pPDS_Input->usHeight1 =(unsigned short)Data_Input.nLvl_1 ; 
+   pPDS_Input->usHeight2 =(unsigned short)Data_Input.nLvl_2 ; 
+   pPDS_Input->usYear =(unsigned short)( Data_Input.nYear % 100 ); /* Year */
+   pPDS_Input->usMonth =(unsigned short)Data_Input.nMonth; /* Month */
+   pPDS_Input->usDay =(unsigned short)Data_Input.nDay;/* Day of month */
+   pPDS_Input->usHour =(unsigned short)Data_Input.nHour; /* Hour of day */
+   pPDS_Input->usMinute =(unsigned short)Data_Input.nMinute; /* Minute of hour*/
+   pPDS_Input->usSecond =(unsigned short)Data_Input.nSecond; /* Secs of Min */
+   pPDS_Input->usFcst_unit_id = Data_Input.usFcst_id; /*ForecastTime unit-Tbl4*/
+   /* Period of time (tau)- 0 for analysis */
+   pPDS_Input->usP1 = Data_Input.usFcst_per1;
+   /* Period of time between analyses */
+   pPDS_Input->usP2 = Data_Input.usFcst_per2;
+   /* Time range indicator-Tbl5 */
+   pPDS_Input->usTime_range = Data_Input.usTime_range_id;
+   /* Num in average */
+   pPDS_Input->usTime_range_avg = Data_Input.usTime_range_avg;
+   /* Num missing from average */
+   pPDS_Input->usTime_range_mis = Data_Input.usTime_range_mis; 
+
+   /* Century of reference time */
+   if (Data_Input.nYear % 100 == 0) {
+     pPDS_Input->usCentury = (unsigned short)( Data_Input.nYear / 100 );
+     pPDS_Input->usYear += 100;
+   } else {
+     pPDS_Input->usCentury =(unsigned short)( Data_Input.nYear / 100 + 1);
+   }
+
+   /* Decimal scale factor */
+   pPDS_Input->sDec_sc_fctr = (short) Data_Input.nDec_sc_fctr;
+   /* reserved bytes */
+   for ( i=0 ; i< 12 ; i++)pPDS_Input->ausZero[i] = 0; /* Reserved- Set to 0 */
+   /* Oct-26 was reserved, now holds Sub-Center Id */
+   pPDS_Input->usCenter_sub =  User_Input.usCenter_sub;
+   /* Oct-41:  show that Grib Extensions are used */
+   pPDS_Input->usExt_flag = (unsigned short)EXTENSION_FLAG; 
+   /* Tracking ID for data set */
+   pPDS_Input->usTrack_num = User_Input.usTrack_num; 
+
+   /* WSI Extended PDS section: Used for extended and higher resolution time periods */
+   pPDS_Input->PDS_41 = Data_Input.PDS_41;
+   pPDS_Input->PDS_42 = Data_Input.PDS_42;
+   pPDS_Input->PDS_46 = Data_Input.PDS_46;
+   pPDS_Input->PDS_47 = Data_Input.PDS_47;
+   pPDS_Input->PDS_51 = Data_Input.PDS_51;
+   pPDS_Input->PDS_52 = Data_Input.PDS_52;
+
+/*
+*
+* B.2       ASSIGN size of PDS_GRIB into uslength of struct PDS_INPUT
+	    ** If encoding MEL GRIB messages, Pds Length should be 46 and
+	    Octet 41 should equal the Extension Flag.
+*/
+   pPDS_Input->uslength = sizeof(PDS_GRIB);
+
+/*
+*
+* B.3       DEBUG Print
+*/
+   DPRINT1("\t create_inpPDS:  uslength = %u (Size of PDS_GRIB)\n",
+   pPDS_Input->uslength );
+   DPRINT1("\t create_inpPDS:  usEd_num = %u\n", pPDS_Input->usEd_num );
+   DPRINT1("\t create_inpPDS:  usParm_tbl = %u\n", pPDS_Input->usParm_tbl );
+   DPRINT1("\t create_inpPDS:  usSub_tbl = %u\n", pPDS_Input->usSub_tbl);
+   DPRINT1("\t create_inpPDS:  usCenter_id = %u\n", pPDS_Input->usCenter_id );
+   DPRINT2("\t create_inpPDS:  usCenter_sub Oct26=%u, usExt_flag Oct41=%u\n", 
+	pPDS_Input->usCenter_sub, pPDS_Input->usExt_flag);
+   DPRINT1("\t create_inpPDS:  usProc_id = %u\n", pPDS_Input->usProc_id );
+   DPRINT1("\t create_inpPDS:  usGrid_id = %u\n", pPDS_Input->usGrid_id );
+   DPRINT1("\t create_inpPDS:  usGds_bms_id = %u\n", pPDS_Input->usGds_bms_id);
+   DPRINT1("\t create_inpPDS:  usParm_id = %u\n", pPDS_Input->usParm_id );
+   DPRINT1("\t create_inpPDS:  usParm_sub = %u\n", pPDS_Input->usParm_sub);
+   DPRINT1("\t create_inpPDS:  usLevel_id = %u\n", pPDS_Input->usLevel_id );
+   DPRINT1("\t create_inpPDS:  usHeight1 = %u\n", pPDS_Input->usHeight1 );
+   DPRINT1("\t create_inpPDS:  usHeight2 = %u\n", pPDS_Input->usHeight2 );
+   DPRINT1("\t create_inpPDS:  usCentury = %u\n", pPDS_Input->usCentury );
+   DPRINT1("\t create_inpPDS:  usYear = %u\n", pPDS_Input->usYear );
+   DPRINT1("\t create_inpPDS:  usDay = %u\n", pPDS_Input->usDay );
+   DPRINT1("\t create_inpPDS:  usHour = %u\n", pPDS_Input->usHour );
+   DPRINT1("\t create_inpPDS:  usMinute = %u\n", pPDS_Input->usMinute );
+   DPRINT1("\t create_inpPDS:  usSecond = %u\n", pPDS_Input->usSecond );
+   DPRINT1("\t create_inpPDS:  usP1 = %u\n", pPDS_Input->usP1);
+   DPRINT1("\t create_inpPDS:  sDec_sc_fctr  = %d\n", pPDS_Input->sDec_sc_fctr);
+   DPRINT1("\t create_inpPDS:  usTrack_num = %u\n", pPDS_Input->usTrack_num);
+   DPRINT0("\t create_inpPDS:  WSI Extended PDS Section: \n");
+   DPRINT1("\t create_inpPDS:  PDS_41 (Forecast time 1 unit id): %u\n",pPDS_Input->PDS_41);
+   DPRINT1("\t create_inpPDS:  PDS_42 (Forecast time 1): %u\n",pPDS_Input->PDS_42);
+   DPRINT1("\t create_inpPDS:  PDS_46 (Forecast time 2 unit id): %u\n",pPDS_Input->PDS_46);
+   DPRINT1("\t create_inpPDS:  PDS_47 (Forecast time 2 unit id): %u\n",pPDS_Input->PDS_47);
+   DPRINT1("\t create_inpPDS:  PDS_51 (Time range indicator): %u\n",pPDS_Input->PDS_51);
+   DPRINT1("\t create_inpPDS:  PDS_52 (Top of atm): %u\n",pPDS_Input->PDS_52);
+
+   
+/*
+*
+* B.4       RETURN w/nothing
+*/
+   DPRINT0 ("Exiting create_inpPDS with no errors;\n");  
+
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
+
+/*
+*
+****************************************************************************
+* C. FUNCTION:  inp2grib_PDS
+*      Use the data from the internal structure to fill the Product 
+*      Definition Section structure.
+*
+*    INTERFACE:
+*      int inp2grib_PDS ( pPDS_Input, ppPDS_Grib, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  PDS_INPUT *pPDS_Input;
+*           internal PDS structure, used for input
+*      (O)  PDS_GRIB  **ppPDS_GRIB ;
+*           pre-allocated structure to be filled;
+*      (O)  char *errmsg;
+*           empty array, returned filled if error occured;
+*
+*   RETURN CODE:
+*      0> no errors;  PDS_GRIB filled;
+*     99> unexpected null pointers, Errmsg filled;
+****************************************************************************/
+
+#if PROTOTYPE_NEEDED
+int inp2grib_PDS ( PDS_INPUT 	*pPDS_Input,
+		PDS_GRIB 	**ppPDS_Grib,
+		char 		*errmsg)
+#else
+int inp2grib_PDS ( pPDS_Input, ppPDS_Grib, errmsg)
+		PDS_INPUT 	*pPDS_Input;
+		PDS_GRIB 	**ppPDS_Grib;
+		char 		*errmsg;
+#endif
+{
+   char		    *func= "inp2grib_PDS";
+   unsigned char    ach3bytes[3];
+   unsigned long    ulPDS_length = 0;
+   short            sDec_sc_fctr = 0;
+   int              nStatus = 0;
+   int              i; 		/* loop counter */
+   long		    lTemp;	/* working var */
+   PDS_GRIB         *tpds; 	/* true grib pds, working var */
+   short            tmp_byte2;  /* working var */
+   long             tmp_byte4;  /* working var */
+
+   DPRINT0  ( "Entering inp2grib_PDS......\n" );
+
+/*
+*
+* C.1       IF (either Internal PDS_INPUT or True Grib PDS_GRIB is null) THEN
+*              SET status = 99;
+*              RETURN
+*           ENDIF
+*/
+      if ( !ppPDS_Grib  || !pPDS_Input) {
+	   sprintf(errmsg,
+	   "%s: either PDS_GRIB /PDS_INPUT/or both are Null\n",func);
+	   nStatus= 99;
+	   goto BYE;
+	}
+
+/*
+*
+* C.2       ASSIGN local ptr to point to PDS_GRIB struct;
+*/
+      tpds = *ppPDS_Grib;
+
+/*
+*
+* C.3       CREATE true Grib struct PDS_GRIB from internal PDS_INPUT
+*/
+      tpds->chParm_tbl =  ( unsigned char ) pPDS_Input->usParm_tbl;
+
+      /* Commented out by Todd Hutchinson, WSI, when Extended PDS was replaced */
+      /* tpds->chSub_tbl =  ( unsigned char ) pPDS_Input->usSub_tbl; */
+
+      tpds->chCenter_id = ( unsigned char ) pPDS_Input->usCenter_id;
+      tpds->chProc_id = ( unsigned char ) pPDS_Input->usProc_id;
+      tpds->chGrid_id = ( unsigned char ) pPDS_Input->usGrid_id;
+      tpds->chGds_bms_id = ( unsigned char ) pPDS_Input->usGds_bms_id;
+      tpds->chParm_id = ( unsigned char ) pPDS_Input->usParm_id;
+
+      /* Commented out by Todd Hutchinson, WSI, when Extended PDS was replaced */
+      /* tpds->chParm_sub= (unsigned char )  pPDS_Input->usParm_sub; */
+
+      tpds->chLevel_id = ( unsigned char ) pPDS_Input->usLevel_id;
+
+      switch(pPDS_Input->usLevel_id){
+        case   1:  /* surface(of the Earth, includes sea surface) level  */
+        case   2:  /* cloud base level  */
+        case   3:  /* cloud top level  */
+        case   4:  /* 0 deg C isotherm level */
+        case   5:  /* adiabatic condensation level  */
+        case   6:  /* maximum wind speed level  */
+        case   7:  /* tropopause level  */
+        case   8:  /* nominal top of atmosphere level  */
+        case   9:  /* sea bottom level  */
+        case 100:  /* isobaric level            */
+        case 103:  /* fixed height level        */
+        case 105:  /* fixed height above ground */
+        case 107:  /* sigma level               */
+        case 111:  /* depth below land surface  */
+        case 113:  /* isentropic (theta) level  */
+        case 115:  /* sigma-z level  */
+        case 119:  /* Eta Level */
+        case 125:  /* height level above ground (high precision) */
+        case 160:  /* depth below sea level     */
+        case 200:  /* entire atmosphere considered as a single layer */
+        case 201:  /* entire ocean considered as a single layer */
+        case 212:  /* low cloud bottom level */
+        case 213:  /* low cloud top level */
+        case 222:  /* middle cloud bottom level */
+        case 223:  /* middle cloud top level */
+        case 232:  /* high cloud bottom level */
+        case 233:  /* high cloud top level */
+	  set_bytes(pPDS_Input->usHeight1, 2, tpds->achHeight);
+          break;
+        default:
+	  set_bytes(pPDS_Input->usHeight2, 1, (tpds->achHeight));
+	  set_bytes(pPDS_Input->usHeight1, 1, (tpds->achHeight)+1);
+          break;
+      }
+
+      tpds->chYear = ( unsigned char ) pPDS_Input->usYear;
+      tpds->chMonth = ( unsigned char ) pPDS_Input->usMonth;
+      tpds->chDay = ( unsigned char ) pPDS_Input->usDay;
+      tpds->chHour = ( unsigned char ) pPDS_Input->usHour;
+      tpds->chMinute = ( unsigned char ) pPDS_Input->usMinute;
+      tpds->chFcst_unit_id = ( unsigned char ) pPDS_Input->usFcst_unit_id;
+      tpds->chP1 = ( unsigned char ) pPDS_Input->usP1;
+      tpds->chP2 = ( unsigned char ) pPDS_Input->usP2;
+      tpds->chTime_range = ( unsigned char ) pPDS_Input->usTime_range;
+
+      set_bytes(pPDS_Input->usTime_range_avg,2,tpds->achTime_range_avg);
+
+      tpds->chTime_range_mis = ( unsigned char ) pPDS_Input->usTime_range_mis;
+      tpds->chCentury = ( unsigned char ) pPDS_Input->usCentury;
+      tpds->chCenter_sub = ( unsigned char ) pPDS_Input->usCenter_sub;
+      DPRINT1("Octet-26:  tpds->usCenter_sub= %d\n", (int)tpds->chCenter_sub);
+
+      set_bytes(pPDS_Input->sDec_sc_fctr,2,tpds->achDec_sc_fctr);
+
+      for(i=0;i<12;++i)
+        tpds->achZero[i]= ( unsigned char ) pPDS_Input->ausZero[i];
+
+      /* Commented out by Todd Hutchinson, WSI, when Extended PDS was replaced */
+      /*
+      tpds->chExt_flag = (unsigned char) pPDS_Input->usExt_flag;
+      DPRINT1("Octet41:   tpds->chExt_flag= %d\n", (int)tpds->chExt_flag);
+
+      tpds->chSecond = ( unsigned char ) pPDS_Input->usSecond;
+      memcpy((void *)tpds->chTrack_num, 
+		(void *)&(pPDS_Input->usTrack_num), 2);
+      */
+      
+      /* Added by Todd Hutchinson, WSI.  Extended WSI PDS section */
+
+      tpds->PDS_41 = (unsigned char)pPDS_Input->PDS_41;
+
+      set_bytes(pPDS_Input->PDS_42,4,tpds->PDS_42);
+
+      tpds->PDS_46 = (unsigned char)pPDS_Input->PDS_46;
+
+      set_bytes(pPDS_Input->PDS_47,4,tpds->PDS_47);
+
+      tpds->PDS_51 = (unsigned char)pPDS_Input->PDS_51;
+
+      set_bytes(pPDS_Input->PDS_52,2,tpds->PDS_52);
+
+      ulPDS_length= sizeof (PDS_GRIB);
+      DPRINT1 ( "\t length of PDS_GRIB is %d\n", ulPDS_length );
+
+      set_bytes(ulPDS_length, 3, tpds->achPDS_length);
+
+     HDR_PRINT("encoded PDS", (unsigned char*)tpds, (int)ulPDS_length); 
+/*
+*
+* C.4       RETURN with Status
+*/
+BYE:
+      DPRINT1 ( "Exiting inp2grib_PDS(), stat=%d\n", nStatus);
+      return ( nStatus );
+/* 
+* 
+* END OF FUNCTION
+*
+*/ 
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/hdr_print.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/hdr_print.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/hdr_print.c	(revision 2744)
@@ -0,0 +1,66 @@
+/* FILENAME:   hdr_print.c */
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+* 
+********************************************************************
+* A. FUNCTION:  hdr_print
+*      print specified number of bytes from the block provided.
+*      does not require Debug flag to be set;
+*
+*    INTERFACE:
+*      void  hdr_print (title, block, bytestoprint)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *title;		Title string to print
+*      (I)  unsigned char *block;       Block whose content to print
+*      (I)  int bytestoprint;           Number of bytes to print 
+*
+*    RETURN CODE:   none;
+********************************************************************
+*/
+#if PROTOTYPE_NEEDED
+void  hdr_print (char *title, unsigned char *block, int bytestoprint)
+#else
+void  hdr_print (title, block, bytestoprint)
+		char *title; unsigned char *block; int bytestoprint;
+#endif
+{
+int i=0;
+/*
+*
+* A.1       PRINT title string
+*/
+   fprintf(stdout,"hdr_print %d bytes of '%s'=", bytestoprint, title);
+
+/*
+* 
+* A.2       WHILE (more bytes to print) DO
+*                PRINT byte value
+*           ENDDO
+*/
+   while (i < bytestoprint)
+    {
+	if (i % 8 == 0) {
+	   if (i+7>= bytestoprint-1)
+		fprintf(stdout,"\n[%2d-%2d]:  ",i+1, bytestoprint);
+      	   else fprintf(stdout,"\n[%2d-%2d]:  ",i+1, i+8);
+	}
+	fprintf(stdout,"%03u ", block[i++]);
+	if (i % 4 == 0) fprintf(stdout, "| ");
+    }
+   fprintf(stdout,"\n");
+/*
+*
+* A.3      RETURN w/nothing
+*/
+   fprintf(stdout,"Exiting hdr_print, no return code\n");
+/*
+*
+* END OF FUNCTION
+*
+*/ 
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_dec_struct.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_dec_struct.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_dec_struct.c	(revision 2744)
@@ -0,0 +1,78 @@
+/* FILENAME:   init_dec_struct.c 
+   DATE:         05 FEB 1996
+   PROGRAMMER:   STEVE LOWE, SAIC
+   Revisions:
+   17apr96 Alice Nakajima, SAIC: added BMS initialization
+   11jun96 Nakajima: replaced with Memset
+   10oct96 Nakajima: renamed from init_struct() to init_dec_struct()
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "dprints.h"	/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+*
+*
+*************************************************************************
+* A. FUNCTION:  init_dec_struct
+*       initializes the four internal Decoder structures 
+*    
+*    INTERFACE:
+*       void init_dec_struct ( pds, gds, bms, bds_head)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (O)  PDS_INPUT      *pds;      internal PDS struct to be initialized
+*      (O)  grid_desc_sec  *gds;      internal GDS struct to be initialized
+*      (O)  BMS_INPUT      *bms;      internal BMS struct to be initialized
+*      (O)  BDS_HEAD_INPUT *bds_head; internal BDS struct to be initialized
+*
+*    RETURN CODE:  none
+*************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+void init_dec_struct (  PDS_INPUT      *pds, grid_desc_sec  *gds,
+			BMS_INPUT      *bms, BDS_HEAD_INPUT *bds_head)
+#else
+void init_dec_struct (pds,gds,bms,bds_head)
+        PDS_INPUT      *pds;
+        grid_desc_sec  *gds;
+        BMS_INPUT      *bms;
+        BDS_HEAD_INPUT *bds_head;
+#endif
+{
+/* 
+*
+* A.0       DEBUG printing
+*/
+  DPRINT0 ("Inside init_dec_struct()\n");
+
+/* 
+*
+* A.1       INITIALIZE Product Description Section struct elements
+*/
+  memset ((void *)pds, '\0', sizeof(PDS_INPUT)); 
+
+/* 
+*
+* A.2       INITIALIZE Grid Description Section struct elements 
+*
+* A.3       INITIALIZE Bitmap Map Section  header struct elements to zero
+*
+* A.4       INITIALIZE Binary Data Section Header Struct elements  to zero
+*/
+  memset ((void *)gds, '\0', sizeof(grid_desc_sec)); 
+  gds->head.usData_type = 255;
+  memset ((void *)bms, '\0', sizeof(BMS_INPUT));
+  memset ((void *)bds_head, '\0', sizeof(BDS_HEAD_INPUT));
+
+/* 
+*
+* A.5       DEBUG printing
+*/
+  DPRINT0("Leaving init_dec_struct(), no return code\n");
+/*
+* END OF FUNCTION
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_enc_struct.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_enc_struct.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_enc_struct.c	(revision 2744)
@@ -0,0 +1,61 @@
+/* FILENAME:     init_enc_struct.c
+   DATE:         15 FEB 1996
+   PROGRAMMER:   STEVE LOWE, SAIC
+   REVISED BY:   ALICE NAKAJIMA, SAIC
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+/*
+*
+************************************************************************
+* A. FUNCTION:  init_enc_struct
+*       initializes structures DATA_INPUT and GEOM_IN
+*
+*    INTERFACE:
+*       void init_enc_struct (data_input, geom_in, user_input)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (O) DATA_INPUT *data_input;    encoder struct to be initialized
+*      (O) GEOM_IN  *geom_in;         encoder struct to be initialized
+*      (O) USER_INPUT *user_input;    encoder struct to be initialized
+*
+*      RETURN CODE:   none
+************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+void init_enc_struct ( DATA_INPUT *data_input, GEOM_IN  *geom_in,
+			USER_INPUT *user_input)
+#else
+void init_enc_struct ( data_input, geom_in, user_input)
+			DATA_INPUT *data_input; 
+			GEOM_IN  *geom_in;
+			USER_INPUT *user_input;
+#endif
+{
+  DPRINT0 ("Entering init_enc_struct()\n");
+/*
+*
+* A.1       CLEAR elements of DATA_INPUT Structure
+*
+* A.2       CLEAR elements of GEOM_IN Structure
+*
+* A.3       CLEAR elements of USER_INPUT Structure 
+*/
+  memset ((void *)data_input, '\0', sizeof (DATA_INPUT));
+  memset ((void *)geom_in, '\0', sizeof (GEOM_IN));
+  memset ((void *)user_input, '\0', sizeof (USER_INPUT));
+
+  DPRINT0 ("Exiting init_enc_struct()\n");
+/*
+*
+* A.4        RETURN
+*/
+  return;
+
+/*
+* END OF FUNCTION
+*
+*/ 
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_gribhdr.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_gribhdr.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_gribhdr.c	(revision 2744)
@@ -0,0 +1,290 @@
+/*  File:  init_gribhdr.c		Alice T. Nakajima, SAIC, 10/96
+    funcs to make storage and free up storage for Grib header struct
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+/*
+*
+****************************************************************************
+* A. FUNCTION  init_gribhdr
+*       Allocates storage for Grib Header and its entire_msg and initialize
+*       every of its attributes.
+*
+*    INTERFACE:
+*       int     init_gribhdr (ppgrib_hdr, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (O)  GRIB_HDR **ppgrib_hdr;
+*           Grib Header structure, Null upon entry;  Returns pointing to a 
+*           newly created storage.  Its attribute 'entire_msg' will point
+*           to a block of size indicated in 'abs_size' (initially set to
+*           DEF_MSG_LEN bytes, see grib.h).  'entire_msg' may later be 
+*           expanded by other functions if required, but 'abs_size' must
+*           be updated to the expanded byte length.
+*      (O)  char *errmsg;
+*           empty array, returned filled if error occurred;
+*
+*    RETURNS:  
+*     0>  no error; storage for grib header and its entire_msg array created
+*         and cleared;  msg_length and all section lengths are set to zero, 
+*         all section pointers are Null; abs_size is set to DEF_MSG_LEN;
+*         'shuffled' flag is set to zero;
+*     1>  failed, see errmsg;
+****************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int  init_gribhdr ( GRIB_HDR **ppgrib_hdr, char *errmsg)
+#else
+int  init_gribhdr ( ppgrib_hdr, errmsg)
+		GRIB_HDR **ppgrib_hdr; char *errmsg;
+#endif
+{
+/*
+* A.0       DEFAULT to error status
+*/
+char *func= "init_gribhdr";
+int	stat=1;
+
+   DPRINT1 ("Entering %s\n", func);
+/*
+*
+* A.1       ALLOCATE storage for struct GRIB_HDR
+*           IF (fails) THEN
+*               RETURN  error
+*           ELSE
+*               CLEAR out struct GRIB_HDR
+*           ENDIF
+*/
+   *ppgrib_hdr= (GRIB_HDR *)malloc(sizeof(GRIB_HDR));
+   if (*ppgrib_hdr == NULL) {
+
+	DPRINT1 ("%s:  failed to create storage for GRIB_HDR\n", func);
+	sprintf (errmsg, "%s:  failed to create storage for GRIB_HDR\n", func);
+	goto BYE;
+	}
+   else memset ((void *)*ppgrib_hdr, '\0', sizeof(GRIB_HDR));
+   DPRINT2 ("Allocate storage of GRIB_HDR struct, addr=%ld (%ld bytes)\n", 
+   *ppgrib_hdr, sizeof(GRIB_HDR));
+
+/*
+*
+* A.2       ALLOCATE storage for struct GRIB_HDR's Entire_Msg array
+*           !size DEF_MSG_LEN bytes as defined in 'grib.h'
+*           IF (fails) THEN
+*               FREE Grib Header
+*               RETURN error
+*           ELSE
+*               STORE absolute size of Entire_Msg in header's Abs_Size
+*               CLEAR out array Entire_Msg of struct
+*               SET status to good
+*           ENDIF
+*/
+   
+   (*ppgrib_hdr)->entire_msg=  (void *)malloc(DEF_MSG_LEN);
+   if ((*ppgrib_hdr)->entire_msg == NULL) {
+	DPRINT1 ( "%s:  failed to create storage for GRIB_HDR's Msg\n", func);
+	sprintf (errmsg, "%s:  failed to create storage for GRIB_HDR's Msg\n", 
+	func);
+	free (*ppgrib_hdr);
+	}
+   else {
+	(*ppgrib_hdr)->abs_size = (long)DEF_MSG_LEN;
+	memset ((void *)(*ppgrib_hdr)->entire_msg, '\0', DEF_MSG_LEN);
+	DPRINT2 (
+	"Allocate storage for GRIB_HDR->entire_msg, addr=%ld, sz= %ld bytes \n",
+	(*ppgrib_hdr)->entire_msg, (*ppgrib_hdr)->abs_size);
+	stat=0;
+	}
+
+
+/*
+*
+* A.3       RETURN status 
+*/
+BYE:
+   DPRINT2 ("Leaving %s,  stat=%d;\n", func,stat);
+   return (stat);
+
+/*
+*
+* END OF FUNCTION
+*
+*
+*/
+}
+
+/*
+*
+****************************************************************************
+* B. FUNCTION:  free_gribhdr
+*      to free up storage of Grib Header structure and all its attributes.
+*
+*    INTERFACE:
+*      void    free_gribhdr (ppgrib_hdr)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (O)  GRIB_HDR **ppgrib_hdr;
+*           Grib Header structure whose storage is released;
+*
+*    RETURN CODE:  none;
+****************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+void	free_gribhdr ( GRIB_HDR **ppgrib_hdr)
+#else
+void	free_gribhdr ( ppgrib_hdr)
+			GRIB_HDR **ppgrib_hdr;
+#endif
+{
+   char *func="free_gribhdr";
+   DPRINT1 ("Entering %s\n", func);
+/*
+*
+* B.1       IF (this struct is not null) {
+*               IF (struct's entire_msg is not null)
+*                   FREE entire msg array
+*               ENDIF
+*               FREE struct itself
+*               SET it to null
+*           ENDIF
+*/
+   if (*ppgrib_hdr != NULL) {
+       	if ((*ppgrib_hdr)->entire_msg != NULL) free((*ppgrib_hdr)->entire_msg);
+	free (*ppgrib_hdr);
+	*ppgrib_hdr= NULL;
+   }
+   DPRINT1 ("Leaving %s, no return code\n", func);
+/*
+*
+* END OF FUNCTION
+*
+*/
+}
+
+/*
+***********************************************************************
+* C. FUNCTION:  Expand_gribhdr
+*      to make Grib Header structure 's entire_msg buffer larger
+*      than its current abs_size.
+*
+*    INTERFACE:
+*      int   Expand_gribhdr (gh, newsize, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*    (I&O)  GRIB_HDR *gh;
+*           Grib Header structure whose buffer is to be expanded;
+*      (I)  long newsize;
+*           size to expand entire_msg to;
+*      (O)  char *errmsg;
+*           empty array, returned filled if error occurred;
+*
+*    RETURN CODE:  
+*      0>  newsize is smaller or equal to current size and function
+*          with return with GRIB header unchanged;  OR,
+*          successful, entire_msg now is larger & abs_size has
+*          been updated;  all of the section pointers are also 
+*          updated to point to correct location within the new
+*          larger block.
+*      1>  error occurred, Errmsg filled;
+****************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int	Expand_gribhdr (GRIB_HDR *gh, long newsize, char *errmsg)
+#else
+int	Expand_gribhdr (gh, newsize, errmsg)
+GRIB_HDR	*gh;
+long		newsize;
+char		*errmsg;
+#endif
+{
+   char *func="Expand_gribhdr";
+   unsigned char  *Buff;			/* temp array */
+
+   DPRINT1 ("Entering %s\n", func);
+/*
+* C.0       IF (grib hdr struct pointer or entire_msg is null) 
+*              RETURN with error
+*           ENDIF
+*/
+   if (gh == (GRIB_HDR *)NULL || gh->entire_msg == (unsigned char *)NULL)  {
+	sprintf(errmsg,"%s: either GRIB_HDR or Entire_msg is Null\n",
+	func);
+        DPRINT1 ("Leaving %s, with error (NULL Grib Header)\n", func);
+	return (1);
+   }
+
+/*
+* C.1       IF (new size is smaller than abs_size) THEN
+*              PRINT warning
+*              RETURN with no errors
+*           ENDIF
+*/
+   if (newsize <= gh->abs_size) {
+	fprintf(stdout,
+	"%s:  cannot expand to %ld bytes (must be bigger than abs_size= %ld)\n",
+	func, newsize, gh->abs_size);
+	return (0);
+   }
+
+   DPRINT2 ("Require %ld bytes and curr abs_size= %ld\n", 
+   newsize, gh->abs_size);
+
+/*
+* C.2       ALLOCATE a new block of 'newsize' bytes
+*           RETURN on error
+*/
+   Buff =  (unsigned char *)malloc (newsize);
+   if (Buff == NULL) {
+	sprintf(errmsg,"%s: failed to create new array (%d bytes)\n",
+	func, newsize);
+        DPRINT1 ("Leaving %s, with Malloc error\n", func);
+	return (1);
+   } 
+
+/*
+* C.3       CLEAR new array out 
+*/
+   memset ((void*)Buff, '\0', newsize);
+
+/*
+* C.4       COPY content of old buffer into new buffer
+*/
+   if (gh->msg_length > 0) {
+	DPRINT1(
+	"Copy %ld bytes of data from old buffer to new one\n",
+	gh->msg_length);
+
+	memcpy ((void*)Buff, (void*)gh->entire_msg, gh->msg_length);
+   }
+
+/*
+* C.6       UPDATE each Section that's present to point to
+*           proper location within the new larger buffer
+*/
+   if (gh->ids_ptr !=NULL) gh->ids_ptr= Buff + (gh->ids_ptr - gh->entire_msg);
+   if (gh->pds_ptr !=NULL) gh->pds_ptr= Buff + (gh->pds_ptr - gh->entire_msg);
+   if (gh->gds_ptr !=NULL) gh->gds_ptr= Buff + (gh->gds_ptr - gh->entire_msg);
+   if (gh->bms_ptr !=NULL) gh->bms_ptr= Buff + (gh->bms_ptr - gh->entire_msg);
+   if (gh->bds_ptr !=NULL) gh->bds_ptr= Buff + (gh->bds_ptr - gh->entire_msg);
+   if (gh->eds_ptr !=NULL) gh->eds_ptr= Buff + (gh->eds_ptr - gh->entire_msg);
+
+/*
+* C.5       FREE the old buffer & assign the new one to GRIB_HDR
+*/
+   free ((void *) gh->entire_msg);
+   gh->entire_msg = (unsigned char *)Buff;
+   
+/*
+* C.6       UPDATE alloc_size of GRIB_HDR
+*/
+   gh->abs_size = newsize;
+   DPRINT1 ("expanded  gh->abs_size = %ld\n", gh->abs_size);
+
+   DPRINT1 ("Leaving %s, no errors\n", func);
+   return (0);
+/*
+* END OF FUNCTION
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_struct.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_struct.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/init_struct.c	(revision 2744)
@@ -0,0 +1,55 @@
+/* FILENAME:     init_struct.c
+   DATE:         15 FEB 1997
+   PROGRAMMER:   STEVE LOWE, SAIC
+
+   27aug97 Alice Nakajima (ATN):  changed 'size_t size' to 'int' (gcc complains)
+*/ 
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"	/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+*
+************************************************************************
+* A. FUNCTION:   init_struct
+*       initializes structures DATA_INPUT and GEOM_IN
+*
+*    INTERFACE:
+*       void init_struct (generic, size)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (O)  void    *generic;   address of block to be cleared out
+*      (I)  int     size;       size of block in bytes
+*
+*    RETURN CODE:   none
+************************************************************************
+*
+*/
+#if PROTOTYPE_NEEDED
+void  init_struct ( void *generic, int size)
+#else
+void  init_struct ( generic, size)
+		void *generic; int size;
+#endif
+{
+
+  DPRINT0 ("Entering init_struct()\n");
+/*
+*
+* A.1       CLEAR elements of Structure
+*/
+  memset ((void *)generic, '\0', size);
+
+  DPRINT0 ("Exiting init_struct()\n");
+/*
+*
+* A.2        RETURN
+*/
+  return;
+
+/*
+* END OF FUNCTION
+*
+*/ 
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/input.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/input.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/input.h	(revision 2744)
@@ -0,0 +1,68 @@
+typedef struct DATA_INPUT {
+   unsigned short usProc_id;       /* Generating Process ID Number (Table A) */
+   unsigned short usGrid_id;       /* Grid Identification (Table B)          */
+   unsigned short usParm_id;       /* GRIB parameter id */
+   unsigned short usParm_sub_id;   /* GRIB parameter sub-id */
+   unsigned short usLevel_id;      /* GRIB level id */
+   int            nLvl_1;          /* 1st level value - scaled to an integer*/
+   int            nLvl_2;          /* 2nd level value - scaled to an integer*/
+   int            nYear;           /* year of data e.g. 1993 */
+   int            nMonth;          /* month of year e.g. 8 */
+   int            nDay;            /* day of month e.g. 31 */
+   int            nHour;           /* hour of day e.g. 0 */
+   int            nMinute;         /* minute of hour e.g. 0 */
+   int            nSecond;         /* second of minute e.g. 0 */
+   unsigned short usFcst_id;       /*  Forecast time unit id - Table 4 */
+   unsigned short usFcst_per1;     /* forecast time 1 (tau) e.g. 0. */
+   unsigned short usFcst_per2;     /* forecast time 2 (tau) e.g. 0. */
+   unsigned short usTime_range_id; /* Time range indicator - Table 5 */
+   unsigned short usTime_range_avg;/* Number in average */
+   unsigned short usTime_range_mis;/* Number missing from average */
+   int            nDec_sc_fctr;    /* Decimal scale factor */
+   /* WSI Extended PDS fields */
+   unsigned short PDS_41;          /* Forecast time 1 unit id - Table 4 */
+   int            PDS_42;          /* forecast time 1 (up to 4 bytes) */
+   unsigned short PDS_46;          /* Forecast time 2 unit id - Table 4 */
+   int            PDS_47;          /* forecast time 2 */
+   unsigned short PDS_51;          /* Time range indicator - Table 5 */
+  unsigned short  PDS_52;          /* Top of atmosphere--used with sigma coord*/
+} DATA_INPUT;
+
+typedef struct GEOM_IN {        /* info from tables grid_reg_geom/as_reg_im */
+    char   prjn_name[21];       /* projection name */
+    char   stor_dsc[21];        /* (+x in +y)/(+x in -y)/(-y in +x)/etc */
+    long   nx;                  /* count of columns */
+    long   ny;                  /* count of rows */
+    double lat;                 /* lat of origin in degrees */
+    double lon;                 /* lon of origin in degrees */
+    double orig_ix;             /* column # for origin, left column is 1 */
+    double orig_iy;             /* row # for origin; top row is 1 */
+    double x_int_dis;           /* distance interval between columns in km */
+    double y_int_dis;           /* distance interval between rows in km */
+    double parm_1;              /* geom parm 1, depends on projection
+				 * Spherical:	j Direction Increment (Latitude)
+				 * Lambert:*/	
+    double parm_2;              /* geom parm 2, depends on projection */
+    double parm_3;              /* geom parm 3, depends on projection */
+/* Do NOT MODIFY parameters before this point */
+/* Additional Parameters Required by GRIB */
+    double first_lat;		/* latitude of grid point (1,1) */
+    double first_lon;		/* longitude of grid point (1,1) */
+    double last_lat;		/* latitude of grid point (nx,ny) */
+    double last_lon;		/* longitude of grid point (nx,ny) */
+    unsigned short scan;	/* Scan mode value from Table 8 */
+    unsigned short usRes_flag;  /* Resolution and Component Flags (Table 7)    */
+} GEOM_IN;
+
+typedef struct USER_INPUT {         /* user's input from input.dat            */
+/* PDS Section */
+    unsigned char  chCase_id;   /* User defined case ID (1 digit alphanumeric)*/
+    unsigned short usParm_tbl;  /* GRIB Table Version Number             */
+    unsigned short usSub_tbl;   /* Local Table Version Number            */
+    unsigned short usCenter_id; /* ID of Originating Center (Table 0)     */
+    unsigned short usGds_bms_id;/* GDS and BMS Flag (Table 1)             */
+    unsigned short usCenter_sub;/* Sub-Table Entry for originating Ctr (Tbl 0)*/
+    unsigned short usTrack_num; /* Tracking ID for data set               */
+    unsigned short usBDS_flag;  /* Binary Data Section Flag (Table 11)    */
+    unsigned short usBit_pack_num; /* Number of bits into which data is packed*/
+} USER_INPUT;
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/isdb.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/isdb.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/isdb.h	(revision 2744)
@@ -0,0 +1,123 @@
+#ifndef ISDB_INCLUDE
+#define ISDB_INCLUDE
+
+#ifdef _NET_NEONS
+#include <nn_client.h>
+#endif /* _NET_NEONS */
+
+/* max value from rand; HW/OS dependent */
+#define MAX_RAND 2147483647.  	/* SUN */		
+/* #define MAX_RAND 32767.	*/		/* HP, Solaris */
+
+/* Vers 4.2.1 was installed 10/01/97 on Kelvin */
+#define NEONS_VRSN_MAJOR  4	/* major release version of NEONS software */
+#define NEONS_VRSN_MINOR  2	/* minor release version of NEONS software */
+#define NEONS_VRSN_MINOR2 1	/* (sub) minor release version of software */
+				/* (for bug fixes) 			   */
+
+#define BYTE_BIT_CNT  8		/* count of bits per byte */
+#define WORD_BIT_CNT  sizeof(long)*BYTE_BIT_CNT /* count of bits per word */
+#define WORD_BYTE_CNT 4		/* count of bytes per word */
+ 
+#define	OPN_RD    1		/* open database for read only */
+#define	OPN_WR_RD 2		/* open database for write+read */
+
+#define MAX_FILE_CNT  15	/* maximum count of open files */
+
+#define ISDB_MODE   0666 	/* mode for image files placed into db */
+#define LOCK_MODE   0200 	/* mode for locking files while writing */
+#define INGEST_OWN "dba"   	/* owner of image files before loaded in db */ 
+#define INGEST_MODE 0644 	/* mode for ingest files before loaded in db */ 
+
+
+#define CLNDR_HOUR   0		/* calendar time, units = hours */
+#define CLIMO_DAY    1		/* climatology time, units = day in year */
+#define CLIMO_WEEK   2		/* climatology time, units = week in year */
+#define CLIMO_MONTH  3		/* climatology time, units = month in year */
+#define CLIMO_SEASON 4		/* climatology time, units = season in year */
+
+typedef struct {		/* date structure */
+   int year;			/* year number since 0 BC */
+   int month;			/* month number in year */
+   int day;			/* day number in month */
+   int type;			/* time coordinate type, default time type */
+				/* is calendar time 			   */
+} DATE;
+
+typedef struct {		/* info from table as_band */
+    long   chan_num;		/* channel number within sensor */
+    char   band_name[31];	/* name of band */
+    long   bit_cnt;		/* count of bits in pixel */
+    float  scl_fctr;		/* scaling factor */
+    float  reference;		/* reference value */
+    char   unit_name[31];	/* name of physical units */
+} AS_BAND;
+
+typedef struct {		/* info from tables grid_reg_geom/as_reg_im */
+    char   prjn_name[21];	/* projection name */
+    char   stor_dsc[21];	/* (+x in +y)/(+x in -y)/(-y in +x)/etc */ 
+    long   nx;			/* count of columns */
+    long   ny;			/* count of rows */
+    double lat;			/* lat of origin in degrees */
+    double lon;			/* lon of origin in degrees */
+#ifdef OLD_REG_GEOM
+    long orig_ix;		/* column # for origin, left column is 1 */
+    long orig_iy;		/* row # for origin; top row is 1 */
+    float x_int_dis;		/* distance interval between columns in km */
+    float y_int_dis;		/* distance interval between rows in km */
+    float parm_1;		/* geom parm 1, depends on projection */
+    float parm_2;		/* geom parm 2, depends on projection */
+    float parm_3;		/* geom parm 3, depends on projection */
+#else
+    double orig_ix;		/* column # for origin, left column is 1 */
+    double orig_iy;		/* row # for origin; top row is 1 */
+    double x_int_dis;		/* distance interval between columns in km */
+    double y_int_dis;		/* distance interval between rows in km */
+    double parm_1;		/* geom parm 1, depends on projection */
+    double parm_2;		/* geom parm 2, depends on projection */
+    double parm_3;		/* geom parm 3, depends on projection */
+#endif /* OLD_REG_GEOM */
+} REG_GEOM;
+
+typedef struct {		/* info from table as_sat_im */
+    long   bgn_lin_num;		/* beginning line number in orbit or pass */ 
+    long   bgn_smp_num;		/* beginning sample number in scan line */
+    long   lin_int;		/* lin interval relative to sensor scan mode */
+    long   smp_int;		/* smp interval relative to sensor scan mode */
+    float  roll_ang;		/* satellite roll angle in degrees */
+    float  pch_ang;		/* satellite pitch angle in degrees */
+    float  yaw_ang;		/* satellite yaw angle in degrees */
+} SAT_GEOM;
+
+typedef struct {		/* info from table grid_spct_geom */
+    char   stor_dsc[21];	/* (+x in +y)/(+x in -y)/(-y in +x)/etc */ 
+    char   trnc_type[21];	/* spectral truncation type (triangular/etc) */ 
+    long   coef_cnt;		/* count of complex coefficients used */ 
+    long   max_lat_wav_num;	/* max latitudinal wavenumber (M in GRIB) */
+    long   max_lon_wav_num_1;	/* max longitudinal wavenumber 1 (J in GRIB) */
+    long   max_lon_wav_num_2;	/* max longitudinal wavenumber 2 (K in GRIB) */
+} SPCT_GEOM;
+
+typedef struct {		/* info from table sat_oe */
+    char   seq_name[21];	/* orb-elem sequence name */
+    DATE   date;		/* date for orbital elements */
+    double hour;		/* hour of day for orbital elements */
+    double parm_1;		/* orb-elem parm 1 value */
+    double parm_2;		/* orb-elem parm 2 value */
+    double parm_3;		/* orb-elem parm 3 value */
+    double parm_4;		/* orb-elem parm 4 value */
+    double parm_5;		/* orb-elem parm 5 value */
+    double parm_6;		/* orb-elem parm 6 value */
+    double parm_7;		/* orb-elem parm 7 value */
+} ORB_ELEM;
+
+typedef struct {		/* bit-map structure */
+   short lin_cnt;		/* count of lines in bitmap */
+   short smp_cnt;		/* count of samples per line in bitmap */
+   short pad_bit_cnt;		/* count of bits for padding lines in bitmap */
+   short ofst_byte_cnt;		/* byte offset into bitmap array where actual
+				   bitmap data begins */
+   unsigned char *bmap;		/* unsigned char array containing bitmap */
+} BITMAP;
+
+#endif  /* ISDB_INCLUDE */
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_dec_lookup.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_dec_lookup.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_dec_lookup.c	(revision 2744)
@@ -0,0 +1,768 @@
+/*  FILENAME:   ld_dec_lookup.c 
+Revision logs:
+16Jul97 /atn: clear Decoder section of structs only; chg warnings to Stdout;
+*/
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include "grib_lookup.h"  	/* combined lookup structs */
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+*.....................................................
+*  ld_dec_lookup.c defines the following global vars:
+*.....................................................
+*  PARM_DEFN  db_parm_tbl[NPARM*MAX_PARM_TBLS]   Parameter Conversion info
+*  LVL_DEFN   db_lvl_tbl[NLEV]                  Level Conversion info
+*  MODEL_DEFN db_mdl_tbl[NMODEL]                 Model Conversion info
+*  GEOM_DEFN  db_geom_tbl[NGEOM]                 Geom Conversion info
+*              
+*/
+PARM_DEFN   db_parm_tbl [NPARM*MAX_PARM_TBLS];/* GLOBVAR parm conversion info*/
+LVL_DEFN    db_lvl_tbl [NLEV];    /* GLOBVAR level conversion info */
+MODEL_DEFN  db_mdl_tbl [NMODEL];  /* GLOBVAR model conversion info */
+GEOM_DEFN   db_geom_tbl [NGEOM];  /* GLOBVAR Geom conversion info */
+
+/*
+**********************************************************************
+* A.  FUNCTION:      ld_dec_lookup
+*        This function reads in the information from an external Lookup
+*        table (ie: g1tab_2.1).  This info is used to convert
+*        from the Database's parameter names to the GRIB Code Numbers.
+*
+*    INTERFACE:
+*       int ld_dec_lookup (lookup_fn,  errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *lookup_fn
+*           Name of Lookup file to read from (ie:  /abspath/g1tab_128_2.1)
+*      (O)  char *errmsg
+*           empty array, returned filled if error occurred;
+*
+*     RETURN CODE:
+*        0>  successful, the 4 database tables Filled;
+*        1>  file open error or got error/eof while reading;  errmsg filled;
+**********************************************************************
+*
+-    REQUIREMENTS:  *** do not use the TAB character !!! ***
+-     Rules for creating Decoder Lookup file:
+-     a)  lines starting out with  '#' is Comment lines & are skipped;   
+-     b)  the tables within the file are defined in this order:
+-         'GRIB Table 2',
+-         'GRIB Table 2 - Sub A',
+-         'GRIB Table 2 - Sub B',
+-         'GRIB Table 2 - Sub C',
+-         'GRIB Table 2 - Sub D',
+-         'GRIB Table 2 - Sub E',
+-         'GRIB Table 3: Level Definitions',
+-         'GRIB Table - Generating Process Definitions (Octet 6 of PDS)',
+-         'GRIB Table - Pre-defined geometries (Octet 7 of PDS)'
+-     c)  Each Header section MUST start out with "GRIB Table";
+-         All Header Section except that of the LEVEL tbl MUST end with a line 
+-         containing atleast 4 consecutives '=';
+-     e)  Header lines are any number of lines before the '===' line which is
+-         considered as a the last line of this section's Header;
+-     f)  the Parameter defn (Table 2 & subTables) must have at least 2 spaces
+-         between the Field Parameter and Unit fields;
+-
+-     While getting entries for current table, the program assumes it has
+-     gotten to the end of current Table if Hdr SEction for next Table 
+-     (string "GRIB Table").
+*/
+
+#if PROTOTYPE_NEEDED
+int  ld_dec_lookup ( char *lookup_fn, char *errmsg)
+#else
+int  ld_dec_lookup ( lookup_fn, errmsg)
+		     char *lookup_fn; 
+		     char *errmsg;
+#endif
+{
+  FILE  *infile;
+  char  *func="ld_dec_lookup", line[200], temp[200], dummy;
+  char  *ptr2, *ptr, strGribCode[50], grib_dsc[150], grib_unit_dsc[150]; 
+  char  strScale[50], strOffset[50], strDSF[50];
+  char  lvl_name_1[150], lvl_name_2[150];
+  int   LineRead, indx, sub, stat=1, num, cnt, iOctets;
+  char  strOctets[30];  
+  int	GribCode;
+  PARM_DEFN *parmptr;	/* ptr to cell w/in Parm array */
+
+  DPRINT1 ("Entering %s\n", func);
+/*
+* A.0       CLEAR out all the lookup arrays's decoder part
+*/
+  for (num=0; num < NPARM ; num++) {
+	db_parm_tbl[num].usParm_id=  num;
+	db_parm_tbl[num].usParm_sub= 0;       /* not used for main tbl */
+	db_parm_tbl[num].grib_dsc[0] ='\0';
+	db_parm_tbl[num].grib_unit_dsc[0] ='\0';
+	}
+  for (num=NPARM; num < NPARM * MAX_PARM_TBLS; num++) {  /* for sub-tbls */
+	db_parm_tbl[num].usParm_id=  249 + num / NPARM;
+	db_parm_tbl[num].usParm_sub= num % NPARM;
+	db_parm_tbl[num].grib_dsc[0] ='\0';
+	db_parm_tbl[num].grib_unit_dsc[0] ='\0';
+	}
+
+  for (num=0; num < NLEV; num++) {
+        db_lvl_tbl[num].usLevel_id =  num;
+	db_lvl_tbl[num].grib_dsc[0] = '\0';
+	db_lvl_tbl[num].lvl_name_1[0] = '\0';
+	db_lvl_tbl[num].lvl_name_2[0] = '\0';
+	db_lvl_tbl[num].num_octets = 0;
+	}
+
+  for (num=0; num < NMODEL; num++) {
+	db_mdl_tbl[num].usModel_id  = num;
+	db_mdl_tbl[num].grib_dsc[0] = '\0';
+	}
+
+  for (num=0; num < NGEOM; num++) {
+	db_geom_tbl[num].usGeom_id  = num;
+	db_geom_tbl[num].grib_dsc[0] = '\0';
+	}
+
+/*
+*
+* A.1       OPEN Lookup file for reading
+*           RETURN 1 if fails;
+*/
+  infile = fopen(lookup_fn, "r");
+  if (infile==NULL) { 
+	DPRINT2 ("%s:  failed to open %s\n", func, lookup_fn);
+	sprintf (errmsg ,"%s:  failed to open %s\n", func, lookup_fn);
+	goto BYE;
+	}
+  DPRINT1 ("Loading Decoder file= '%s'\n", lookup_fn);
+
+/**** PARM SECTION (TABLE 0/A/B/C/D/E) ***
+ To be loaded continuously where Main tbl range is 0-255, B is 256-511, ...
+Sample:
+   GRIB Table 2
+   Code Figure    Field Parameter                                       Unit
+   ===========    ===============                                       ====
+   000            Reserved                                              *
+   001            Pressure                                              Pa
+   002            Pressure reduced to MSL                               Pa
+   003            Pressure tendency                                     Pa/s
+   #####################################################################
+   GRIB Table 2 - Sub A
+   Code Figure    Field Parameter                                       Unit
+   ===========    ===============                                       ====
+   ######################################################################
+   GRIB Table 2 - Sub B
+   Code Figure    Field Parameter                                       Unit
+   ===========    ===============                                       ====
+   ######################################################################
+   GRIB Table 2 - Sub C
+   Code Figure    Field Parameter                                       Unit
+   ===========    ===============                                       ====
+   ######################################################################
+   GRIB Table 2 - Sub D
+   Code Figure    Field Parameter                                       Unit
+   ===========    ===============                                       ====
+   ######################################################################
+
+*
+*           *** Parameter Conversion info ***
+* A.2       FOR (each Parameter Table/subTable to load) DO
+*/
+ LineRead = 0;
+ for (sub=0; sub < 6; sub++)   { /* 6 Parm tables altogether (0/A/B/C/D/E) */
+/*
+* A.2.1       CALCULATE the index offset for this Table within the Parm array
+*/
+     indx = sub * 256; 
+
+/*
+* A.2.2       KEEP reading until end of comment line (line with '====')
+*             RETURN error if fails
+*/
+     /* Read until last of Header line */
+     for (line[0]='\0'; ! strstr(line,"====") ; ) 
+     {
+       fgets(line, sizeof(line), infile);  ++LineRead;
+       if (feof(infile) || ferror(infile)) 
+         { sprintf(errmsg,
+	   "%s: got EOF/ERROR before PARM TABLE #%d info (Line %d in %s)\n", 
+	    func, sub, LineRead, lookup_fn);
+	   goto BYE;
+         }
+      }
+
+/*
+* A.2.3       FOR (successfully read a line from file) DO
+*                LOOP if it's a comment line
+*                BREAK out if already got to next Section (see "GRIB Table")
+*                DROP line if it's a empty line
+*/
+  DPRINT2("*** %s: Start reading Tbl2- sub#%d ***\n", func, sub);
+  for (cnt=0 ; fgets(line, sizeof(line), infile)!=NULL; ) 
+    { 
+        ++LineRead;
+       /* skip additional comments,  Break if already got to next Table Defn,
+	else replace tabs with spaces, newlines with null 
+       */
+	for (ptr=line; *ptr==' '; ptr++) ; if (*ptr == '#') continue;  
+        if (strstr(line, "GRIB Table ") != NULL) break;  /* END OF CURR SECT */
+        while (ptr=strchr(line,'\t')) *ptr=' '; 
+        if (ptr=strchr(line,'\n')) *ptr='\0'; 
+/*
+*                EXTRACT line partially  !Parmid, 1st word of Description
+*                DROP line out if extraction fails;
+*                DROP line if parmid is invalid or out or range
+*                >> Note: valid parm id range is 0-255 for main table, 
+*                1-255 for sub tables.
+*/
+	/* DO a partial read, get parm_id and 1st word of Description */
+    	if ((num=sscanf (line,"%s%s", strGribCode, temp )) !=2) {
+	    if (num>0) fprintf(stdout,
+	    "Warning: drop incomplete %s Line %d\n" ,lookup_fn, LineRead); 
+	     continue;
+	  }
+
+       /* Make sure Parmid field has a Number */
+       if (strspn (strGribCode, "0123456789") != strlen(strGribCode)) {
+	   fprintf(stdout,"Warning: Invalid Parmid '%s', drop line#%d in %s\n", 
+	   strGribCode, LineRead, lookup_fn);
+	   continue; }
+
+       GribCode =  atoi(strGribCode);
+       /* check if id is out of range */
+       if (GribCode < 0 || GribCode >= NPARM) {
+	   fprintf(stdout, 
+	   "Warning: Parm id '%d' out of range, drop %s:Line %d\n",
+	   GribCode, lookup_fn, LineRead); continue; }
+
+       /* 
+	  Can only have Parm code 0 in Main table;
+	  Donot load if parm is 0 and this is a Sub table;
+	*/
+       if (GribCode == 0 && sub!=0) {
+	   fprintf(stdout,
+	   "Warning: cannot have Gribcode 0 in Sub-tables, drop %s:Line %d\n",
+	   lookup_fn, LineRead); continue; 
+	}
+
+/* 
+*                EXTRACT Grib_Dsc & Grib_Unit_Dsc from line (both multi words)
+*                !these 2 fields must be separated by atleast 2 spaces;
+*                DROP line if cannot find Grib_Dsc/Unit;
+*/
+	/*
+	  Now, get Grib_Desc and Grib_Unit_Dsc fields, both multi words...
+	   TEMP has 1st word of the Grib_Desc;  This field ends when
+	   we see 2 consecutive spaces;
+	   locate Grib_Desc, move max of 75, then cap it where there are
+           4 consecutive spaces 
+	*/
+        if (!(ptr= strstr (line, temp)) || !(ptr2= strstr (ptr, "  ")))
+          { fprintf(stdout, 
+	    "Warning:  cannot find Grib_Dsc, drop line#%d in %s\n",
+	    LineRead, lookup_fn); continue;
+	  }
+        strncpy (grib_dsc, ptr, ptr2-ptr); /*sizeof(grib_dsc)-1); */
+	grib_dsc[ptr2 - ptr] = '\0';
+
+	/* Grib_Dsc now contains both "Desc & Unit", find where Unit begins
+	   (look for 2 consecutive spaces) then put null terminator to cap
+	   off Grib_Dsc 
+        if ((ptr= strstr (grib_dsc, "  ")) == NULL)
+	*/
+
+	while (*ptr2==' ') ptr2++;
+	if (! *ptr2) 
+          { fprintf(stdout, "Warning: cannot find Unit, drop Line %d in %s\n" , 
+	    LineRead, lookup_fn);
+	    continue;
+	  }
+	else strcpy (grib_unit_dsc, ptr2);
+	for (ptr=grib_unit_dsc + strlen(grib_unit_dsc)-1; *ptr==' '; ptr--)
+		*ptr='\0';   /* remove ending spaces */
+
+/*	
+        *ptr= '\0';    	/# cap off GribDsc, where delimitor begins #/
+	for (ptr= grib_unit_dsc+strlen(grib_unit_dsc) -1; 
+	     *ptr=='\n' || *ptr == ' '; --ptr)
+	    *ptr='\0';		/# rm ending spaces in Unit #/
+*/
+	
+      
+/*
+*                DROP defn if this parmid is already defined;
+*/
+      parmptr =  db_parm_tbl + indx + GribCode;
+      if (parmptr->grib_dsc[0] != '\0') { 
+         fprintf(stdout,
+         "Warning: duplic Parm defn #%d (Index=%d), drop line %d in %s\n",
+         GribCode, PARMTBL_INDX (parmptr->usParm_id, parmptr->usParm_sub),
+	 LineRead, lookup_fn);
+         continue;
+       }
+/*
+*                STORE info in the array cell whose index is 'parm_id'
+*                !undefined parm ids are all set to zero;
+*/
+      /* depending on which Table Code it is, entry will be stored in
+	 its corresponding Parameter Range;  
+	 >>> ENTRIES ARE STORED IN ARRAY CELL WHOSE INDEX IS 'PARM_ID'
+         >>> UNDEFINED IDS WILL HAVE CELL WITH EMPTY DEFNS;
+      */
+      /* Store entry just read in Parm Defn Array */
+
+      if (sub == 0) { /* Main Table only */
+	      parmptr->usParm_id = (unsigned short)GribCode;
+	      parmptr->usParm_sub = 0;
+	   }
+      else {	/* for all Sub-Tables (non-zero sub) */
+	      parmptr->usParm_id = sub + 249;  /* range 250 to 254 only */
+	      parmptr->usParm_sub = (unsigned short)GribCode;
+	   }
+      strcpy (parmptr->grib_dsc, grib_dsc);
+      strcpy (parmptr->grib_unit_dsc, grib_unit_dsc);
+
+      DPRINT7(
+	"(+D) T2-%d cd=%d: Parm=%d, ParmSub=%d, INDX=%d, Dscr='%s' Unit='%s'\n"
+	,sub, GribCode,
+	parmptr->usParm_id, parmptr->usParm_sub, indx+GribCode,
+	parmptr->grib_dsc, parmptr->grib_unit_dsc);
+
+      ++cnt;    /* keep track of #entries loaded */
+/*
+* A.2.3       ENDFOR 
+*/
+   }
+   DPRINT2 ("Parameter table#%d has %d entries\n", sub, cnt);
+
+/*
+* A.2       ENDFOR   !load all 6 Parameter tables
+*/
+} /* load all 6 parm tables */
+  
+
+/******** GRIB's LEVEL TABLE *******
+Sample:
+   ######################################################################
+   GRIB Table 3: Level Definitions
+   Line 1: Level ID | Number of Octets | Meaning
+   Line 2: Contents of octet 11 (optional)
+   Line 3: Contents of octet 12 (optional)
+   001  0  Ground or water surface
+   002  0  Cloud base level
+   ...
+   100  2  Isobaric surface
+   Pressure in hPa
+   ...
+   101  1  Layer between two isobaric surfaces
+   Pressure of top in kPa
+   Pressure of bottom in kPa
+   ######################################################################
+
+*
+*           *** Level Conversion info ***
+* A.3       LOOP until last line of comments ("Line3:" or "====");
+*           RETURN error if fails
+*/
+
+  DPRINT1 ("*** %s: Start reading Level Defns  ***\n", func);
+  /* Read until the last line of Comments */
+  for (line[0]='\0'; ! strstr(line,"====") && ! strstr(line,"Line 3:") ; ) 
+  {
+    fgets(line, sizeof(line), infile); 
+    ++LineRead;
+    if (feof(infile) || ferror(infile)) 
+      { sprintf(errmsg,
+	"%s: got EOF/ERROR before loading LEVEL info (Line %d in %s)\n",
+	func, LineRead, lookup_fn);
+	goto BYE;
+      }
+   }
+
+/*
+* A.4       LOOP (successfully read a line from file) DO
+*              SKIP if comment line 
+*              BREAK out of loop if see next section "GRIB Table"
+*/
+  for (cnt=0; fgets(line, sizeof(line), infile) != NULL; )  
+  {
+    ++LineRead;
+    /* skip additional comments,  Break if already got to next Table Defn,
+	else replace tabs with spaces, newlines with null 
+    */
+    for (ptr=line; *ptr==' '; ptr++); if (*ptr == '#') continue;  
+    if (strstr(line, "GRIB Table ") != NULL) break; /* end of CURR SECT */
+     while (ptr=strchr(line,'\t')) *ptr=' '; 
+     if (ptr=strchr(line,'\n')) *ptr='\0'; 
+
+/*
+*              EXTRACT next GRIB's Level info into Level Array:
+*              DROP line if extraction fails;
+*              ! line 1 format:  lvl id, #octets and Level_description
+*              DROP line if level_id is invalid or out of range
+*              DROP line if unable to extract level description 
+*/
+    /* --- Read Line 1 of Level:  frmt=  (Lvlid #octs  Multiwords Dscr) --*/
+    if ((num= sscanf (line, "%s%s%s", strGribCode, strOctets, temp))!= 3) {
+	 if (num>0) fprintf(stdout,
+	"Warning: dropping incomplete Level defn (%s:Line %d)\n",
+	lookup_fn,LineRead); 
+	 continue;
+	}
+	
+    /* Make sure Parmid field has a Number, and is within Range  */
+    if (strspn (strGribCode, "0123456789") != strlen(strGribCode)) {
+	   fprintf(stdout,"Warning: Invalid Levelid '%s', drop Line=%d in %s\n",
+	   strGribCode, LineRead, lookup_fn); 
+	   continue; }
+    else GribCode =  atoi(strGribCode);
+
+    if (GribCode < 0 || GribCode >= NLEV) {
+	 fprintf(stdout, 
+	 "Warning: Level Gribcode '%d' out of range, drop (Line %d in %s)",
+	 GribCode, LineRead, lookup_fn); 
+	 continue; 
+	}
+
+    /* Make sure #Octets field has a Number, and is within Range */
+    if (strspn (strOctets, "0123456789") != strlen(strOctets)) {
+	   fprintf(stdout,
+	   "Warning:  Invalid NumOctets '%s' for Lvl %d, drop line#%d in %s\n", 
+	   strOctets, GribCode, LineRead, lookup_fn); 
+	   continue;
+	}
+    else iOctets = atoi(strOctets);
+    if (iOctets < 0 || iOctets > 2) {
+	   fprintf(stdout,
+	   "Warning: Octets '%d' out of range (0-2 only), drop Line %d in %s\n",
+	   iOctets, LineRead, lookup_fn); 
+	   continue; 
+	}
+
+    /* TEMP here has 1st word of Lvl Descr, need to get rest of it */ 
+        if ((ptr= strstr (line, temp)) == NULL)
+          { fprintf(stdout,
+	   "Warning:   Cannot find Lvl_Dsc, drop line#%d in %s\n",
+	     LineRead, lookup_fn);
+            continue;
+	  }
+
+        strncpy (grib_dsc, ptr, sizeof(grib_dsc)-1); 
+ 	if (ptr=strstr(grib_dsc,"  ")) *ptr='\0'; /* rm trail blanks */
+/*
+*              IF (0 #octets)
+*                 SET lvl_name_1 and _2 to null;
+*              ELSE if (1 #octets)
+*                 READ in 2 more lines   !for lvl_name_1 & lvl_name_2
+*              ELSE  !2 octets
+*                 READ in 1 more line    !for lvl_name_1
+*                 SET lvl_name_2 to null;
+*              ENDIF
+*/
+    /* --- Get Optional Lvl_1 and Lvl_2 lines, depneding on #octs */
+    switch (iOctets) {
+        case 0:  lvl_name_1[0]= '\0'; lvl_name_2[0]= '\0';break;
+	case 1:  if (!fgets(lvl_name_1, sizeof(lvl_name_1), infile) ||
+		     !fgets(lvl_name_2, sizeof(lvl_name_2), infile)) {
+		    fprintf(stdout,
+		    "Warning: failed to get LvlName1/LvlName2; "
+		    "drop Level %d defn (Line#%d in %s)\n",
+		    GribCode, LineRead,  lookup_fn); 
+		    continue;
+		  }
+    		 LineRead += 2; break;
+	case 2:  if (!fgets(lvl_name_1, sizeof(lvl_name_1), infile) )
+		  { 
+		    fprintf(stdout,
+		    "Warning: failed to get LvlName1; "
+		    "drop Level %d defn (Line#%d in %s)\n",
+		    GribCode, LineRead,  lookup_fn); 
+		    continue;
+		  }
+		 lvl_name_2[0]='\0'; ++LineRead; break;
+         }
+
+   /* replace tabs w/space, replace Newline with Null terminator,
+      and  rm trail blanks ;
+   */
+   if (lvl_name_1[0]) {
+	 while (ptr=strchr(lvl_name_1,'\t')) *ptr=' '; 
+	if (ptr=strchr(lvl_name_1,'\n')) *ptr='\0'; 
+	if (ptr=strstr(lvl_name_1,"  ")) *ptr='\0'; 
+	}
+   if (lvl_name_2[0]) {
+	 while (ptr=strchr(lvl_name_2,'\t')) *ptr=' '; 
+	if (ptr=strchr(lvl_name_2,'\n')) *ptr='\0'; 
+	if (ptr=strstr(lvl_name_2,"  ")) *ptr='\0'; 
+	}
+
+/*
+*              DROP defn if this ID has already been defined;
+*/ 
+    if (db_lvl_tbl[GribCode].grib_dsc[0] != '\0') {
+        fprintf(stdout,
+        "Warning: drop duplic Level %d defn, currently at line %d in %s\n",
+	GribCode, LineRead, lookup_fn);
+	continue;
+    }
+
+/*
+*              STORE all this info into Level Array cell whose index
+*              equals the Level_id
+*/
+    db_lvl_tbl[GribCode].usLevel_id  = (unsigned short)GribCode;
+    strncpy (db_lvl_tbl[GribCode].grib_dsc, grib_dsc, 
+	    sizeof(db_lvl_tbl[GribCode].grib_dsc)-1);
+    db_lvl_tbl[GribCode].num_octets  = iOctets;
+    strncpy (db_lvl_tbl[GribCode].lvl_name_1, lvl_name_1, 
+	    sizeof(db_lvl_tbl[GribCode].lvl_name_1)-1);
+    strncpy (db_lvl_tbl[GribCode].lvl_name_2, lvl_name_2, 
+	    sizeof(db_lvl_tbl[GribCode].lvl_name_2)-1);
+
+/*
+*              DEBUG print
+*/
+    switch (iOctets) {
+     case 0:
+        DPRINT3("(+D) Lvl=%d Dsc='%s' %d octs\n",
+	db_lvl_tbl[GribCode].usLevel_id,
+	db_lvl_tbl[GribCode].grib_dsc,
+	db_lvl_tbl[GribCode].num_octets);break;
+     case 1:
+      DPRINT5(
+	"(+D) Lvl=%d Dsc='%s' %d octs\n     Name1='%s'\n     Name2='%s'\n",
+	db_lvl_tbl[GribCode].usLevel_id,
+	db_lvl_tbl[GribCode].grib_dsc,
+	db_lvl_tbl[GribCode].num_octets,
+	db_lvl_tbl[GribCode].lvl_name_1,
+	db_lvl_tbl[GribCode].lvl_name_2);break;
+     case 2:
+        DPRINT4 ("(+D) Lvl=%d Dsc='%s'  %d octs\n     Name1='%s'\n",
+	db_lvl_tbl[GribCode].usLevel_id,
+	db_lvl_tbl[GribCode].grib_dsc,
+	db_lvl_tbl[GribCode].num_octets,
+	db_lvl_tbl[GribCode].lvl_name_1);break;
+     }
+	 
+    ++cnt;  /* number loaded */
+/*
+* A.4       ENDFOR !Level defns
+*/
+  }
+  DPRINT1 ("Level table has %d entries\n", cnt);
+
+
+/*** GRIB MODEL TABLE***
+Sample:
+	######################################################################
+	GRIB Table - Generating Process Definitions (Octet 6 of PDS)
+	Code Figure    Model Name
+	===========    ==========
+	001            NORAPS
+	002            COAMPS
+	003            NOGAPS
+*
+*           *** Model Conversion info ***
+* A.5       WHILE (line is comment or header line) skip line;
+*           RETURN error if fails
+*/
+  DPRINT1 ("*** %s: Start reading Model Defns  ***\n", func);
+  /* Read until the last line of Comments */
+  for (line[0]='\0'; ! strstr(line,"====") ; ) 
+  {
+    fgets(line, sizeof(line), infile); ++LineRead;
+    if (feof(infile) || ferror(infile)) 
+      { sprintf(errmsg,
+	"%s: got EOF/ERROR before loading MODEL info %s Line %d\n", 
+	func, lookup_fn, LineRead);
+	goto BYE;
+      }
+   }
+
+/*
+*
+* A.6       FOR (successfully read a line from file) DO
+*              DROP line if comment
+*              BREAK out if see next section "GRIB Table"
+*/
+  for (cnt=0; fgets(line, sizeof(line), infile)!=NULL; ) 
+   {
+    ++LineRead;
+    /* skip additional comments,  Break if already got to next Table Defn,
+	else replace tabs with spaces, newlines with null 
+    */
+     for (ptr=line; *ptr==' '; ptr++) ; if (*ptr == '#') continue;  
+     if (strstr(line, "GRIB Table ") != NULL) break; /* end of CURR SECT */
+     while (ptr=strchr(line,'\t')) *ptr=' '; 
+     if (ptr=strchr(line,'\n')) *ptr='\0'; 
+/*
+*              EXTRACT from line the GRIB's Model info ;
+*              DROP line if extraction fails;
+*              ! frmat:    model_name model_id;
+*              DROP line if modelid is invalid or out of range
+*/
+     if ((num= sscanf (line, "%s%s", strGribCode, temp))  !=2) {
+	 if (num > 0) fprintf(stdout,
+	"Warning: Drop incomplete Model line %d in %s\n", LineRead, lookup_fn); 
+	 continue;
+	}
+     if (strspn (strGribCode, "0123456789") != strlen(strGribCode)) {
+	   fprintf(stdout,"Warning:  Invalid Level '%s', drop line=%d in %s\n", 
+	   strGribCode, LineRead, lookup_fn); 
+	   continue; 
+	}
+     else GribCode =  atoi(strGribCode);
+
+     if (GribCode < 0 || GribCode >= NMODEL) {
+	 fprintf(stdout,
+	 "Warning: Model '%d' out of range, drop %s Line %d\n",
+	 GribCode, lookup_fn, LineRead); 
+	 continue; 
+	}
+
+/*
+*              DROP line if this model is already defined
+*/
+     if (db_mdl_tbl[GribCode].grib_dsc[0] != '\0') { 
+               fprintf(stdout, 
+		"Warning: duplic Model#%d defn , drop (%s Line %d)\n",
+		 GribCode, lookup_fn, LineRead);
+               continue;
+            }
+/*
+*              STORE model info into model array cell whose index
+*              equals the model_id;
+*/
+     db_mdl_tbl[GribCode].usModel_id = (unsigned short)GribCode;
+     strncpy (db_mdl_tbl[GribCode].grib_dsc, 
+	line+(strstr(line,temp)-line),
+	sizeof(db_mdl_tbl[GribCode].grib_dsc)-1);  /* 1/more words */
+     DPRINT2 ("(+D) Mdl=%d,  Gribdscr=%s\n", 
+     db_mdl_tbl[GribCode].usModel_id, db_mdl_tbl[GribCode].grib_dsc);
+     ++cnt;  /* number loaded */
+/*
+* A.6       ENDFOR 
+*/
+   }
+  DPRINT1 ("Model table has %d entries\n", cnt);
+     
+
+/*** GRIB GEOMETRY TABLE*** 
+Sample:
+	######################################################################
+	GRIB Table - Pre-defined geometries (Octet 7 of PDS)
+	Code Figure    Geometry Name
+	===========    =============
+	001            mediterranean_109x82
+	002            persian_gulf_NORAPS_63x63
+	003            global_144x288
+	255            Undefined grid, description in GDS
+*
+*           *** Geometry Conversion info ***
+* A.7       WHILE (line is comment or header line) skip line;
+*           RETURN error if fails
+*/
+
+  DPRINT1 ("*** %s: Start reading Geom Defns  ***\n", func);
+  /* Read until the last line of Comments */
+  for (line[0]='\0'; ! strstr(line,"====") ; ) {
+    fgets(line, sizeof(line), infile); 
+    ++LineRead;
+    if (feof(infile) || ferror(infile)) 
+      { sprintf(errmsg,
+	"%s: got EOF/ERROR before loading GEOM info, %s Line %d\n",
+	func, lookup_fn, LineRead);
+	goto BYE;
+      }
+   }
+
+/*
+* A.8       FOR (successfully read a line from file) DO
+*              DROP line if comment
+*              BREAK out if see next section "GRIB Table"
+*/
+  for (cnt=0; fgets(line, sizeof(line), infile)!=NULL; ) 
+   {
+    ++LineRead;
+    /* skip additional comments,  Break if already got to next Table Defn,
+	else replace tabs with spaces, newlines with null 
+    */
+     for (ptr=line; *ptr==' '; ptr++) ; if (*ptr == '#') continue;  
+     if (strstr(line, "GRIB Table ") != NULL) break; /* end of CURR SECT */
+     while (ptr=strchr(line,'\t')) *ptr=' '; 
+     if (ptr=strchr(line,'\n')) *ptr='\0'; 
+
+/*
+*              EXTRACT next GRIB's Geometry info into Geometry Array;
+*              DROP line if extraction fails;
+*              !format:  geom_id geom_descr
+*              DROP line if geom_id is invalid or out of range
+*/
+     if ((num= sscanf (line, "%s%s", strGribCode, temp))  !=2) {
+	 if (num > 0) fprintf(stdout,
+	"Warning: drop incomplete Geom line %d in %s\n", LineRead, lookup_fn);
+	 continue;
+	}
+
+     if (strspn (strGribCode, "0123456789") != strlen(strGribCode)) {
+	   fprintf(stdout,"Warning: Invalid Geom_id '%s', drop %s line=%d\n", 
+	   strGribCode, lookup_fn, LineRead); 
+	   continue; }
+     else GribCode =  atoi(strGribCode);
+
+     if (GribCode < 0 || GribCode >= NGEOM) {
+	 fprintf(stdout, "Warning: Geomid '%d' out of range, drop %s Line %d\n",
+	 GribCode, lookup_fn, LineRead); 
+	 continue; 
+	}
+
+/*
+*              DROP line if geom_id is already defined
+*/
+     if (db_geom_tbl[GribCode].grib_dsc[0] != '\0') { 
+               fprintf(stdout, "Warning: duplic GeomID=%d, drop %s line %d\n",
+		GribCode,  lookup_fn, LineRead);
+               continue;
+            }
+/*
+*              STORE this geom info into array cell whose index
+*              equals the geom_id;
+*/
+     db_geom_tbl[GribCode].usGeom_id = (unsigned short)GribCode;
+     strncpy (db_geom_tbl[GribCode].grib_dsc, 
+	line+(strstr(line,temp)-line),
+	sizeof(db_geom_tbl[GribCode].grib_dsc)-1);  /* 1/more words */
+
+     ++cnt;  /* number loaded */
+     DPRINT2("(+D) Geom=%d,  Gribdscr=%s\n", 
+     db_geom_tbl[GribCode].usGeom_id, db_geom_tbl[GribCode].grib_dsc);
+/*
+* A.8       ENDFOR 
+*/
+   }
+  DPRINT1 ("Geometry table has %d entries\n", cnt);
+
+/*
+* 
+* A.9      SET status to 0 !success
+*/
+  stat=0;
+
+/*
+*
+* A.10     CLOSE Lookup file;
+*/
+BYE:
+  if (infile) fclose(infile);
+  DPRINT2 ("Leaving %s, stat=%d\n", func,stat);
+/*
+*
+* A.11     RETURN with status
+*/
+  return (stat);
+/*
+* END OF FUNCTION
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_enc_input.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_enc_input.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_enc_input.c	(revision 2744)
@@ -0,0 +1,699 @@
+/*
+file:  ld_enc_input.c   (Ld_enc_config, Ld_enc_ieeeff, Ld_enc_ffinfo)
+Original version from previous Encoder Library;
+Revisions:
+10/28/96 by Alice T. Nakajima, SAIC
+	replaced hard-coded $CONFIG_PATH[]/input.dat, 
+	now passes in the name of the file (with absolute path)
+	to ld as well as the Usr Input struct;
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+*********************************************************************
+* A. FUNCTION:  ld_enc_config
+*      fill struct holding user's input from config_fn that
+*      is passed in by user
+*
+*    INTERFACE:
+*      int     ld_enc_config (config_fn, User_Input, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *config_fn;         name of file to load from;
+*      (O)  USER_INPUT *User_Input;  filled with data read from file;
+*      (O)  char *errmsg             returned filled if error occurred;
+*
+*    RETURN CODE:   
+*       0>  success, file is read and closed, user_input is filled 
+*       1>  error opening file;  errmsg filled;
+*       2>  failed to get all expected arguments; errmsg filled;
+*       3>  ferror in file; errmsg filled;
+**********************************************************************/
+
+#if PROTOTYPE_NEEDED
+int  ld_enc_config (char *config_fn, USER_INPUT *User_Input, char *errmsg)
+#else
+int  ld_enc_config (config_fn, User_Input, errmsg)
+		char *config_fn; USER_INPUT *User_Input; char *errmsg;
+#endif
+{
+/* 
+*
+* A.1       DEFAULT to error stat=1;
+*/
+  char		 *func="ld_enc_config"; /* name of Func */
+  char           temp[100], dummy[100], line[200], *p1;  
+  int		 stat= 1;
+  int		 linenum=1;  /* number of lines got from the files */
+  int            num_expected= 9;  /* expecting 9 args from file */
+  FILE           *infile;   /* user input file */
+
+  DPRINT1 ("Entering %s\n", func);
+/*
+*
+* A.2       OPEN Encoder Config file for reading
+*/
+  infile = fopen(config_fn, "r");
+  if (infile==NULL) { 
+	DPRINT2 ("%s: Failed to open %s\n", func,config_fn);
+	sprintf (errmsg,"%s: Failed to open %s\n", func,config_fn);
+	goto BYE;  
+	}
+
+  DPRINT2 ("loading %d args from file:\n'%s'\n", num_expected, config_fn);
+
+/*
+*
+* A.3       WHILE (still more lines AND no error yet) DO
+*/          
+  while (!feof(infile) && !ferror(infile)) 
+  {
+/*
+* A.3.1        GET a line from the file, quit loop if failed;
+*              !format:   value  opt_comments
+* A.3.2        IF line is empty OR is a comment, Loop again;
+*/          
+        if (fgets (line, sizeof(line)-1, infile) == NULL)  break;
+	for (p1=line; *p1 && (iscntrl(*p1)|| isspace(*p1)); p1++);
+	if (p1==NULL || *p1=='#') continue;
+/*
+* A.3.3        EXTRACT first non-space argument
+*              IF (fails)  QUIT;
+*              ELSE convert argument into a number
+*/
+        if (sscanf (line, "%s%s", temp, dummy) < 1) {
+          DPRINT1 ( "%s:  failed to extract 1 arg from line\n", func);
+          sprintf (errmsg, "%s:  failed to extract arg from line:\n%s", 
+	  func, line); 
+	  break; 
+	  }
+
+	DPRINT2("  case %d, data=%s:  ", linenum, temp);
+
+/*
+* A.3.4        SWITCH (what line number we're on)
+*              ... USER_INPUT info ...
+*                  line  1:  fill User_Input->chCase_id
+*                  line  2:  fill User_Input->usParm_tbl
+*                  line  3:  fill User_Input->usSub_tbl, ->usZero (oct26)
+*                  line  4:  fill User_Input->usCenter_id
+*                  line  5:  fill User_Input->usCenter_sub
+*                  line  6:  fill User_Input->usTrack_num
+*                  line  7:  if 1, set (0x80) bit of User_Input->usGds_bms_id
+*                  line  8:  if 1, set (0x40) bit of User_Input->usGds_bms_id
+*                  line  9:  filll User_Input->usBit_pack_num
+*                  else   :  print skip line msg
+*              ENDSWITCH
+*/
+
+        switch (linenum++) {
+
+	/* USER_INPUT info: */
+         case  1: User_Input->chCase_id= temp[0]; 
+		  P_CHAR (User_Input->chCase_id); break;
+         case  2: User_Input->usParm_tbl= (unsigned short)atoi(temp); 
+		  P_USHORT (User_Input->usParm_tbl); break;
+         case  3: User_Input->usSub_tbl= (unsigned short)atoi(temp);
+		  P_USHORT (User_Input->usSub_tbl ); break;
+         case  4: User_Input->usCenter_id= (unsigned short)atoi(temp);
+		  P_USHORT (User_Input->usCenter_id ); break;
+         case  5: User_Input->usCenter_sub= (unsigned short)atoi(temp);
+		  P_USHORT (User_Input->usCenter_sub ); break;
+         case  6: User_Input->usTrack_num= (unsigned short)atoi(temp);
+		  P_USHORT (User_Input->usTrack_num ); break;
+         case  7: if (atoi(temp)) 
+		  User_Input->usGds_bms_id=0x80; 
+		  P_USHORT (User_Input->usGds_bms_id ); break;
+         case  8: if (atoi(temp)) 
+		  User_Input->usGds_bms_id +=(unsigned short)0x40;
+		  P_USHORT (User_Input->usGds_bms_id ); break;
+         case  9: User_Input->usBit_pack_num= (unsigned short)atoi(temp);
+		  P_USHORT (User_Input->usBit_pack_num ); break;
+         default: fprintf(stdout,
+		  "%s Warning: excess line from Configfile skipped=\n%s\n", 
+		  func, line); 
+		  break;
+	 }
+/*
+* A.3       ENDWHILE !more to read
+*/
+    } /* while */
+
+/*
+*
+* A.4       IF (got a reading error) THEN
+*              RETURN Stat 3
+*           ENDIF 
+*/
+  if (ferror(infile))  {
+        DPRINT1 ( "%s:  got ferror(infile)\n", func);
+        sprintf(errmsg, "%s: got ferror(infile)\n", func);
+	stat=3; 
+	}
+
+/*
+*
+* A.5       CLOSE the input file
+*/
+  if (infile) fclose (infile);
+
+/*
+*
+* A.6       IF (only received less than #required arguments) THEN
+*               PRINT warning
+*           ELSE
+*               CHANGE return status to no errors
+*           ENDIF
+*/
+  if (linenum-1 < num_expected) 
+    {
+     DPRINT4 ("%s: failed to load %s (%d/%d)\n", 
+     func, config_fn, linenum-1, num_expected);
+     sprintf(errmsg, "%s: failed to load %s (%d/%d)",
+     func, config_fn, linenum-1, num_expected);
+     stat= 2;
+     }
+  else  stat = 0;
+
+/*
+*
+* A.7       RETURN with stat
+*/
+BYE:
+  DPRINT2 ("Leaving %s, stat=%d;\n", func,stat);
+  return (stat);
+/*
+*
+* END OF FUNCTION 
+*
+*
+*/ 
+}
+
+/*
+*********************************************************************
+* B. FUNCTION:  ld_enc_ieeeff
+*       load user's pre-malloced float array with data from
+*       binary flat file passed in by user (ie:  FF*);
+*
+*    INTERFACE:
+*       int     ld_enc_ieeeff (ieee_fn, farr, elements, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) char *ieee_fn   name of IEEE Flat file (w/fullpath) to read
+*      (O) float *farr     pre-malloced array to store data from read from file
+*      (I) int elements;   number of float elements to read from file;
+*      (O) char *errmsg    returned filled if error occurred;
+*
+*    RETURN CODE:   
+*       0>  success, file is read and closed, float arr is filled 
+*       1>  error opening file; errmsg filled;
+*       2>  failed to get all expected elements;  errmsg filled;
+*       3>  incoming float array is null;  errmsg filled;
+**********************************************************************/
+
+#if PROTOTYPE_NEEDED
+int	ld_enc_ieeeff ( char 	*ieee_fn,
+			float 	*farr,
+			int 	elements,
+			char	*errmsg)
+#else
+int	ld_enc_ieeeff ( ieee_fn, farr, elements, errmsg)
+			char 	*ieee_fn;
+			float 	*farr;
+			int 	elements;
+			char	*errmsg;
+#endif
+{
+/* 
+*
+* B.1       DEFAULT no error stat=0
+*/
+  char		 *func="ld_enc_ieeeff";
+  FILE           *infile= 0;
+  int		 stat= 0;
+
+
+  DPRINT1 ("Entering %s\n",func);
+/* 
+*
+* B.2       IF (float array is null) THEN
+*               SET stat =3
+*                RETURN
+*           ENDIF
+*/
+  if (farr == NULL) {
+	DPRINT1 ("%s:  unexpected null Float array\n", func);
+	sprintf (errmsg,"%s:  unexpected null Float array\n", func);
+	stat = 3; goto BYE;
+	}
+/*
+*
+* B.3       OPEN the IEEE file for reading   !was 'temp.dat'
+*           IF (failed) RETURN err 1;
+*/
+  infile = fopen(ieee_fn, "r");
+  if (infile==NULL) 
+	{ DPRINT2 ("%s: Failed to open %s\n", func,ieee_fn);
+	  sprintf (errmsg,"%s: Failed to open %s\n", func,ieee_fn);
+	  stat = 1; goto BYE;
+	}
+  DPRINT1 ("Read %s\n", ieee_fn);
+
+/*
+*
+* B.4       READ float data from file
+*           IF (didn't get all) THEN
+*              SET status to 2
+*              RETURN
+*           ENDIF
+*/          
+      if ( fread(farr, sizeof(float), elements, infile) != elements)
+        { 
+        DPRINT3 ( "%s: failed to load %s (expecting %d float elements)\n",
+        func, ieee_fn, elements);
+        sprintf(errmsg,"%s: failed to load %s (expecting %d float elements)\n",
+        func, ieee_fn, elements);
+	stat= 2; 
+	}
+      else DPRINT1 ("Number of float elements read = %d\n", elements);
+
+BYE:
+/*
+*
+* B.5       CLOSE the input file 
+*/
+  if (infile) fclose (infile);
+
+/*
+*
+* B.6       RETURN with stat
+*/
+  DPRINT2 ("Leaving %s, stat=%d\n", func,stat);
+  return (stat);
+/*
+*
+* END OF FUNCTION 
+*
+*
+*/ 
+}
+
+/*
+*********************************************************************
+* C.  FUNCTION:  ld_enc_ffinfo
+*      fill DATA_INPUT struct from file whose name is passed in
+*
+*    INTERFACE:
+*      int  ld_enc_ffinfo (ieee_info_fn, Data_Input, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *ieee_info_fn      name of config info file to load
+*      (O)  DATA_INPUT *Data_Input  to be filled with data read from config file
+*      (O)  char *errmsg            filled if error occurred;
+*
+*     RETURN CODE:   
+*       0;  success, file is read and closed, struct is filled 
+*       1:  error opening file; 
+*       2:  failed to get all expected arguments;
+*       3:  Ferror;
+**********************************************************************/
+
+#if PROTOTYPE_NEEDED
+int	ld_enc_ffinfo ( char 		*ieee_info_fn,
+			DATA_INPUT  	*Data_Input,
+			char		*errmsg)
+#else
+int	ld_enc_ffinfo ( ieee_info_fn, Data_Input, errmsg)
+			char 		*ieee_info_fn;
+			DATA_INPUT  	*Data_Input;
+			char		*errmsg;
+#endif
+{
+/* 
+*
+* C.1       DEFAULT to no error stat= 0;
+*/
+  int		 stat= 0;
+  FILE           *infile;   /* user input file */
+  char		 *func="ld_enc_ffinfo";
+  char           temp[100], dummy[100], line[200], *p1;  
+  int		 linenum=1;  /* number of lines got from the files */
+  int            num_expected= 13;  /* expecting 13 args from file */
+  int            mdl_indx, i, iTemp;
+
+  DPRINT1 ("Entering %s\n",func);
+
+/*
+*
+* C.2       OPEN input file for reading
+*/
+  infile = fopen(ieee_info_fn, "r");
+  if (infile==NULL) { 
+	DPRINT2 ("%s: Failed to open %s\n", func,ieee_info_fn);
+	sprintf (errmsg,"%s: Failed to open %s\n", func,ieee_info_fn);
+	stat=1; goto BYE;  
+	}
+
+/*
+*
+* C.3       WHILE (still more lines AND no error yet) DO
+* C.3.1        GET a line from the file, quit loop if failed;
+*              !format:   value  opt_comments
+* C.3.2        IF line is empty OR is a comment, Loop again;
+*/          
+  while (!feof(infile) && !ferror(infile) ) 
+   {
+        if (fgets (line, sizeof(line)-1, infile) == NULL)  break;
+	for (p1=line; *p1 && (iscntrl(*p1)|| isspace(*p1)); p1++);
+	if (p1==NULL || *p1=='#') continue;
+/*
+* C.3.3        EXTRACT arguments from line
+*              IF (fails)  QUIT;
+*              ELSE convert the 2nd argument into an integer 
+*/
+        if ((i=sscanf (line, "%s", temp)) != 1)
+        { 
+	  DPRINT2( "%s:  failed to extract 1 arg reading %s\n", 
+	  func,ieee_info_fn); 
+	  sprintf(errmsg, "%s:  failed to extract 1 arg reading %s\n", 
+	  func,ieee_info_fn); 
+	  break; 
+	}
+	else iTemp = atoi(temp);
+	DPRINT2("  case %d, value=%d:  ", linenum, iTemp);
+
+/*
+* C.3.4        SWITCH (what line number we're on)
+*                  line  1: fill Data_Input->usProc_id field;
+*                  line  2: fill Data_Input->usGrid_id field;
+*                  line  3: fill Data_Input->usParm_id field;
+*                  line  4: fill Data_Input->usParm_sub_id field;
+*                  line  5: fill Data_Input->usLevel_id field;
+*                  line  6: fill Data_Input->nLvl_1 field;
+*                  line  7: fill Data_Input->nLvl_2 field;
+*                  line  8: fill Data_Input->nYear field;
+*                  line  9: fill Data_Input->nMonth field;
+*                  line 10: fill Data_Input->nDay field;
+*                  line 11: fill Data_Input->nHour field
+*                  line 12: fill Data_Input->usFcst_per1 field;
+*                  line 13: fill Data_Input->nDec_sc_fctr field;
+*              ENDSWITCH
+*/
+        switch (linenum++) {
+         case  1: Data_Input->usProc_id = (unsigned short) iTemp;
+		  P_USHORT (Data_Input->usProc_id); break;
+         case  2: Data_Input->usGrid_id = (unsigned short) iTemp;
+		  P_USHORT (Data_Input->usGrid_id); break;
+         case  3: Data_Input->usParm_id = (unsigned short) iTemp;
+		  P_USHORT (Data_Input->usParm_id); break;
+         case  4: Data_Input->usParm_sub_id = (unsigned short) iTemp;
+		  P_USHORT (Data_Input->usParm_sub_id); break;
+         case  5: Data_Input->usLevel_id = (unsigned short) iTemp;
+		  P_USHORT (Data_Input->usLevel_id); break;
+         case  6: Data_Input->nLvl_1 = iTemp;
+		  P_INT (Data_Input->nLvl_1); break;
+         case  7: Data_Input->nLvl_2 = iTemp;
+		  P_INT (Data_Input->nLvl_2); break;
+         case  8: Data_Input->nYear = iTemp;
+		  P_INT (Data_Input->nYear); break;
+         case  9: Data_Input->nMonth = iTemp;
+		  P_INT (Data_Input->nMonth); break;
+         case 10: Data_Input->nDay = iTemp;
+		  P_INT (Data_Input->nDay); break;
+         case 11: Data_Input->nHour = iTemp;
+		  P_INT (Data_Input->nHour); break;
+         case 12: Data_Input->usFcst_per1 = (unsigned short) iTemp;
+		  P_USHORT (Data_Input->usFcst_per1); break;
+         case 13: Data_Input->nDec_sc_fctr = iTemp;
+		  P_INT (Data_Input->nDec_sc_fctr); break;
+         default: fprintf(stdout,
+		  "%s Warning: excess line from file skipped=\n%s\n", 
+		  func, line); 
+		  break;
+        }
+/*
+* C.3       ENDWHILE !more to read
+*/
+    } /* while */
+
+/*
+*
+* C.4       IF (got a reading error) THEN
+*              RETURN Stat 3
+*           ENDIF 
+*/
+  if (ferror(infile))  {
+        DPRINT1 ( "%s:  got ferror(infile)\n", func);
+        sprintf(errmsg, "%s: got ferror(infile)\n", func);
+	fclose(infile);
+	stat=3; goto BYE;
+	}
+
+/*
+*
+* C.5       CLOSE the input file
+*/
+  fclose (infile);
+
+/*
+*
+* C.6       IF (only received less than #required arguments) THEN
+*               PRINT warning
+*/
+  if (linenum-1 < num_expected) {
+     DPRINT4 ( "%s: failed to load %s (%d/%d)\n",
+     func, ieee_info_fn, linenum-1, num_expected);
+
+     sprintf(errmsg, "%s: failed to load %s (%d/%d)\n",
+     func, ieee_info_fn, linenum-1, num_expected);
+     stat= 2;
+     }
+/*
+*           ELSE 
+*              HARDCODE usFcst_id to 1 (code for Hours)
+*           ENDIF
+*/
+  else {
+     Data_Input->usFcst_id        = 1;    /* Fcst Time Unit default to Hours */
+     DPRINT0("Hard-Code HOURS -> "); P_USHORT (Data_Input->usFcst_id);
+    }
+
+/*
+*
+* C.7       RETURN with stat
+*/
+BYE:
+  DPRINT2 ("Leaving %s(), stat=%d;\n", func, stat);
+  return (stat);
+/*
+*
+* END OF FUNCTION 
+*
+*
+*/ 
+}
+/*
+*********************************************************************
+* D.  FUNCTION:  ld_enc_geomfile
+*       fill GEOM_IN struct from file whose name is passed in.
+*     
+*    INTERFACE:
+*      int     ld_enc_geomfile (geom_fn, Geom_In, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *geom_fn          name of geom info file to load
+*      (O)  GEOM_IN *Geom_In       to hold geom info read from file 
+*      (O)  char  *errmsg          returned filled if error occurred
+*
+*     RETURN CODE:   
+*       0>  success, file is read and closed, struct is filled 
+*       1>  error opening file;  errmsg filled;
+*       2>  failed to get all expected arguments; errmsg filled;
+*       3>  Ferror; errmsg filled;
+**********************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int	ld_enc_geomfile (char *geom_fn, GEOM_IN *Geom_In, char	*errmsg)
+#else
+int	ld_enc_geomfile (geom_fn, Geom_In, errmsg)
+			char *geom_fn; 
+			GEOM_IN *Geom_In; 
+			char	*errmsg;
+#endif
+{
+/* 
+*
+* D.1       DEFAULT to no error stat= 0;
+*/
+  int		 i, stat= 0;
+  FILE           *infile;   /* user input file */
+  char		 *func="ld_enc_geomfile";
+  char           temp[100], dummy[100], line[200], *p1;
+  int		 linenum=1;  /* number of lines got from the files */
+  int            num_expected= 15;  /* expecting 15 args from file */
+
+  DPRINT1 ("Entering %s\n",func);
+/*
+*
+* D.2       OPEN input file for reading
+*/
+  infile = fopen(geom_fn, "r");
+  if (infile==NULL) { 
+	DPRINT2 ("%s: Failed to open %s\n", func,geom_fn);
+	sprintf (errmsg,"%s: Failed to open %s\n", func,geom_fn);
+	stat=1; goto BYE;  
+	}
+
+/*
+*
+* D.3       WHILE (still more lines AND no error yet) DO
+* D.3.1        GET a line from the file, quit loop if failed;
+*              !format:   value  opt_comments
+* D.3.2        IF line is empty OR is a comment, Loop again;
+*/          
+  while (!feof(infile) && !ferror(infile) && linenum <= num_expected) 
+  {
+        if (fgets (line, sizeof(line)-1, infile) == NULL)  break;
+	for (p1=line; *p1 && (iscntrl(*p1)|| isspace(*p1)); p1++);
+	if (p1==NULL || *p1=='#') continue;
+/*
+* D.3.3        EXTRACT non-space arguments from line
+*              !format:   value  opt_comments
+*              IF (fails)  set Stat to error 2
+*              ELSE convert the 2nd argument into an integer 
+*/
+        if (sscanf (line, "%s%s", temp, dummy) < 1) {
+          DPRINT3 ("%s:  failed to extract arg from line %d of %s\n", 
+	  func, linenum, geom_fn); 
+          sprintf(errmsg,"%s:  failed to extract arg from line %d of %s\n", 
+	  func, linenum, geom_fn); 
+	  stat=2;
+	  break;
+	}
+
+	DPRINT2("  case %2d val=%10s: ", linenum, temp);
+/*
+* D.3.4        SWITCH (what line number we're on)
+*              ... GEOM_IN info ...
+*                  line  1:  fill Geom_In->prjn_name
+*                  line  2:  fill Geom_In->nx
+*                  line  3:  fill Geom_In->ny
+*                  line  4:  fill Geom_In->x_int_dis
+*                  line  5:  fill Geom_In->y_int_dis
+*                  line  6:  fill Geom_In->parm_1
+*                  line  7:  fill Geom_In->parm_2
+*                  line  8:  fill Geom_In->parm_3
+*                  line  9:  fill Geom_In->first_lat
+*                  line 10:  fill Geom_In->first_lon
+*                  line 11:  fill Geom_In->last_lat
+*                  line 12:  fill Geom_In->last_lon
+*                  line 13:  fill Geom_In->scan
+*              ... More info (previously in file input.dat)...
+*                  line 14:  if 1, set (0x40) bit of Geom_In->usRes_flag
+*                  line 15:  if 1, set (0x08) bit of Geom_In->usRes_flag
+*                  else   :  print skip line msg
+*              ENDSWITCH
+*/
+        switch (linenum++) 
+        {
+	/* ...Geometry info */
+         case  1: strcpy (Geom_In->prjn_name, temp);
+		  P_STRING (Geom_In->prjn_name); break;
+         case  2: Geom_In->nx = (long) atoi(temp);
+		  P_INT (Geom_In->nx); break;
+         case  3: Geom_In->ny = (long) atoi(temp);
+                  P_INT (Geom_In->ny); break;
+         case  4: Geom_In->x_int_dis= (double) atof(temp);
+		  P_DOUBLE (Geom_In->x_int_dis); break;
+         case  5: Geom_In->y_int_dis= (double) atof(temp);
+                  P_DOUBLE (Geom_In->y_int_dis); break;
+         case  6: Geom_In->parm_1= (double) atof(temp);
+		  P_DOUBLE (Geom_In->parm_1); break;
+         case  7: Geom_In->parm_2= (double) atof(temp);
+                  P_DOUBLE (Geom_In->parm_2); break;
+         case  8: Geom_In->parm_3= (double) atof(temp);
+                  P_DOUBLE (Geom_In->parm_3); break;
+         case  9: Geom_In->first_lat= (double) atof(temp);
+		  P_DOUBLE (Geom_In->first_lat); break;
+         case 10: Geom_In->first_lon= (double) atof(temp);
+                  P_DOUBLE (Geom_In->first_lon); break;
+         case 11: Geom_In->last_lat= (double) atof(temp);
+		  P_DOUBLE (Geom_In->last_lat); break;
+         case 12: Geom_In->last_lon= (double) atof(temp);
+                  P_DOUBLE (Geom_In->last_lon); break;
+         case 13: Geom_In->scan= (unsigned short) atoi(temp);
+                  P_USHORT (Geom_In->scan); break;
+
+	/*... Misc. info */
+         case 14: if (atoi(temp)) 
+		  Geom_In->usRes_flag =(unsigned short)0x40;
+		  P_USHORT (Geom_In->usRes_flag ); break;
+         case 15: if (atoi(temp)) 
+		  Geom_In->usRes_flag +=(unsigned short)0x08;
+		  P_USHORT (Geom_In->usRes_flag ); break;
+         default: fprintf(stdout,
+		  "%s Warning: excess line from file skipped=\n%s\n", 
+		  func, line); 
+		  break;
+        }
+/*
+* D.3       ENDWHILE !more to read
+*/
+    } /* while */
+
+/*
+*
+* D.4       IF (got a reading error) THEN
+*              RETURN Stat 3
+*           ENDIF 
+*/
+  if (ferror(infile))  {
+        DPRINT1 ( "%s:  got ferror(infile)\n", func);
+        sprintf(errmsg, "%s: got ferror(infile)\n", func);
+	fclose(infile);
+	stat=3; goto BYE;
+	}
+
+/*
+*
+* D.5       CLOSE the input file
+*/
+  fclose (infile);
+  
+/*
+*
+* D.6       IF (Status is Good ) THEN
+*               IF (received less than #required arguments) PRINT warning
+*           ENDIF
+*/
+  if (stat == 0 ) {
+     if (linenum <= num_expected) {
+        DPRINT3 ( "%s: only loaded %d/%d args into Geom_In\n", 
+        func, linenum-1, num_expected);
+
+        sprintf(errmsg, "%s: only loaded %d/%d args into Geom_In\n", 
+        func, linenum-1, num_expected);
+        stat= 2;
+        }
+     else DPRINT1 ("Got all %d arguments; \n", num_expected);
+   }
+
+/*
+*
+* D.7       RETURN with stat
+*/
+BYE:
+  DPRINT2 ("Leaving %s, stat=%d;\n", func, stat);
+  return (stat);
+/*
+*
+* END OF FUNCTION 
+*
+*
+*/ 
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_enc_lookup.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_enc_lookup.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_enc_lookup.c	(revision 2744)
@@ -0,0 +1,503 @@
+/* Revision logs:
+16Jul97 /atn:  only clr Encoder section of db tables; chg warning to stdout;
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <stdlib.h>
+#include "grib_lookup.h"  	/* combined lookup structs */
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+extern PARM_DEFN   db_parm_tbl[];  /* parm conversion info */
+extern LVL_DEFN    db_lvl_tbl[];   /* level conversion info */
+extern MODEL_DEFN  db_mdl_tbl[];   /* model conversion info */
+extern GEOM_DEFN   db_geom_tbl[];  /* Geom conversion info */
+/*
+****************************************************************************
+* A. FUNCTION: ld_enc_lookup
+*      This function reads in the information from an external Lookup
+*      table used by the GRIB Encoder (ie: neons2grib.tab).  This info 
+*      is used to convert Databse codes to the GRIB Code Numbers.
+*
+*    INTERFACE:
+*      int ld_enc_lookup (lookup_fn, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *lookup_fn;   Name of Lookup file to read from;
+*      (O)  char *errmsg       REturned filled if error occurred;
+*
+*     RETURN CODE:
+*       0>  successful, the following pre-defined arrays required for
+*           encoding GRIB messages are filled=
+*           PARM_DEFN  db_parm_tbl[NPARM * MAX_PARM_TBLS]; (parameter info)
+*           LVL_DEFN db_lvl_tbl[NLEV];      (level info)
+*           MODEL_DEFN db_mdl_tbl[NMODEL];  (model info)
+*           GEOM_DEFN db_geom_tbl[NGEOM];   (geometry info)
+*       1>  file open error or got error/eof while reading;  errmsg filled;
+****************************************************************************
+- only break out of curr Loop if sees next section's header string;
+
+*/
+#if PROTOTYPE_NEEDED
+int ld_enc_lookup ( char *lookup_fn, char *errmsg)
+
+#else
+int ld_enc_lookup ( lookup_fn, errmsg)
+		char *lookup_fn; char *errmsg;
+#endif
+{
+  FILE  *infile;
+  char  *func="ld_enc_lookup";     /* name of function */
+  char  *ptr, temp[200], TableCode, dummy[100]; 
+  int   stat=1, num, LineRead, cnt, code=0, indx0= 0;
+  int   Indx, indxA=0, indxB=0, indxC=0, indxD=0, indxE= 0;
+  int   *indxptr;
+  char	*px;
+  char             achDBsField[30];  /* DBs Field Name                  */
+  char		   strDSF[50],strGribCode[50], strScale[50], strOffset[50];
+  char             subtbl[20];    /* (0:maintbl) or (a/b/c/d/e:subtabl)*/
+  int	GribCode;         /* GRIB Code Number                  */
+  float            fScale;             /* Scale                             */
+  float            fOffset;            /* Offset                            */
+  short            sDSF;               /* DSF                               */
+  PARM_DEFN 	   *parmptr;	       /* ptr to desired cell w/in Parm arr*/
+
+  DPRINT2 ("Entering %s\nlookup %s\n", func, lookup_fn);
+/*
+*
+* A.0       CLEAR out all lookup arrays  ! Encoder section only
+*/
+ for (num=0; num < NPARM ; num++) {
+        db_parm_tbl[num].usParm_id=  num;
+        db_parm_tbl[num].usParm_sub= 0;       /* not used for main tbl */
+        db_parm_tbl[num].db_name[0] = '\0';
+        db_parm_tbl[num].fScale     = 1.;
+        db_parm_tbl[num].fOffset    = 0.;
+        db_parm_tbl[num].sDSF 	    = 0;
+        }
+  for (num=NPARM; num < NPARM * MAX_PARM_TBLS; num++) {  /* for sub-tbls */
+        db_parm_tbl[num].usParm_id=  250 + num / NPARM;
+        db_parm_tbl[num].usParm_sub= num % NPARM;
+        db_parm_tbl[num].db_name[0] = '\0';
+        db_parm_tbl[num].fScale     = 1.;
+        db_parm_tbl[num].fOffset    = 0.;
+        db_parm_tbl[num].sDSF 	    = 0;
+        }
+
+  for (num=0; num < NLEV; num++) {
+        db_lvl_tbl[num].usLevel_id =  num;
+        db_lvl_tbl[num].db_name[0] = '\0';
+        db_lvl_tbl[num].fScale	   =  1.;
+        db_lvl_tbl[num].fOffset	   =  0.;
+        }
+
+  for (num=0; num < NMODEL; num++) {
+        db_mdl_tbl[num].usModel_id  = num;
+        db_mdl_tbl[num].db_name[0] = '\0';
+        }
+
+  for (num=0; num < NGEOM; num++) {
+        db_geom_tbl[num].usGeom_id  = num;
+        db_geom_tbl[num].db_name[0] = '\0';
+        }
+/*
+*
+* A.1       OPEN Lookup file for reading
+*           RETURN 1 if fails;
+*/
+  infile = fopen(lookup_fn, "r");
+  if (infile==NULL) { 
+	DPRINT2 ("%s:  failed to open %s\n", func, lookup_fn);
+	sprintf (errmsg ,"%s:  failed to open %s\n", func, lookup_fn);
+	goto BYE;
+	}
+
+/****Database's PARM TABLE -- (0/A/B/C/D/E) ***
+Sample:
+NEONS to GRIB Parameter Table
+NEONS FIELD             TABLE CODE    GRIB CODE     SCALE     OFFSET     DSF
+===========             ==========    =========     =====     ======     ===
+pres                        0           001           1.0        0.0      1
+pres                        0           002           1.0        0.0      1
+*
+*           *** Database's Parameter Defn conversion info ***
+* A.2       KEEP reading until last of Header/Comment line (see '===')
+*           RETURN error if fails
+*/
+  LineRead = 0;
+
+  while (strstr (temp, "===") == NULL) {
+  	fgets(temp, sizeof(temp), infile); /* skip Comment/Header lines */
+	LineRead++; 
+        if (feof(infile) || ferror(infile)) {
+    	   DPRINT1 ("%s: got EOF/ERROR before loading DBs PARM info\n", func);
+    	   sprintf(errmsg,
+    	   "%s: got EOF/ERROR before loading DBs PARM info (%s:line %d)\n",
+	    func , lookup_fn, LineRead);
+    	   goto BYE;
+    	  }
+	}
+/*
+*
+* A.3       FOR (successfully read a line from file) DO
+*              BREAK out of loop if sees Header of next Table
+*              EXTRACT next DBs's Parameter info from line read
+*              IF (fails) SKIP rest of Parm defn ;
+*              !parm_name, tblcode, parmid, scalefctr, offset, Decsclfctr;
+*              DROP line if Parm id is out of range
+*              DROP line if Table Code is not (0/A/B/C/D/E)
+*              DROP defn if Code has already been defined;
+*              STORE in Parm Array cell whose index equals Parmid
+*           ENDFOR
+*/
+  for (cnt=0; fgets(temp, sizeof(temp), infile)!=NULL; ) {
+      
+	LineRead++; 
+	for (ptr=temp; *ptr==' '; ptr++) ; if (*ptr == '#') continue;  
+        if (strstr(temp, "to GRIB Level Table") != NULL) 
+		break;  /* END OF CURR SECT */
+
+    	if ((num= sscanf (temp,"%s%s%s%s%s%s%s", achDBsField, subtbl, 
+	    strGribCode, strScale, strOffset, strDSF, dummy)) != 6) 
+	  {
+	    if (num>0)
+	    fprintf(stdout,"Warning: unmatched Parm args, drop line %d in %s\n", 
+		LineRead, lookup_fn);
+	    continue;
+	  }
+
+       for (px=strGribCode; *px; px++) 
+	  if (!isdigit(*px)) {
+		fprintf(stdout,
+		"Warning: invalid GRIB code, drop line %d in %s\n",
+		LineRead, lookup_fn);
+		continue;
+		}
+
+       GribCode =  atoi(strGribCode);
+       fScale     = (float) atof(strScale);
+       fOffset    = (float) atof(strOffset);
+       sDSF       = (short) atoi(strDSF);
+
+       if (GribCode < 0 || GribCode >= NPARM) {
+	   fprintf(stdout,
+	   "Warning:  ParmId '%d' out of range, drop line %d in %s\n",
+	   GribCode,  LineRead, lookup_fn); continue; }
+
+	if (strlen(subtbl) > 1) { fprintf(stdout,
+	   "Warning:  Invalid bad TableCode '%s', drop line %d in %s;\n",
+	   subtbl, LineRead, lookup_fn); continue; }
+
+      /* depending on which Table Code it is, entry will be stored in
+	 its corresponding Parameter Table;  
+	 >>> if Tablecode is '0', store at array index PARM_ID;
+	 >>> if Tablecode is 'A/B/C/D/E',
+	 >>> then store at array index [NPARM*(PARM_ID-249) + PARM_SUB];
+         >>> UNDEFINED IDS WILL HAVE EMPTY CELLS;
+      */
+      TableCode = (isalpha(*subtbl) ? tolower(*subtbl) : *subtbl);
+
+      if   (TableCode=='0')  {
+		Indx = 0;
+      		parmptr 	    = db_parm_tbl + GribCode;
+		parmptr->usParm_id  = (unsigned short) GribCode;
+                parmptr->usParm_sub = 0; 
+	}
+      else if (TableCode>= 'a' && TableCode <= 'e')  {
+	      if (GribCode==0) {
+		fprintf(stdout,
+	     	"Warning: Cannot use Parmid 0 for sub-tbl, drop line %d in %s\n"
+		,  LineRead, lookup_fn);
+		continue;
+		}
+	        Indx = 256 * (TableCode-'a'+1);   /* 'a':256-.. 'b':512-.. */ 
+      		parmptr = db_parm_tbl + Indx + GribCode; /* actual Index */
+	        parmptr->usParm_id  = 250 + (TableCode-'a');
+	        parmptr->usParm_sub = (unsigned short) GribCode;
+        }
+      else {  fprintf(stdout,
+	      "Warning:  Invalid Table '%s' (0,A-E only), drop line %d in %s\n",
+	      subtbl,  LineRead, lookup_fn);
+	      continue;
+        }
+	
+      if (parmptr->db_name[0] != '\0')
+	    { /* drop line if Duplicate */
+               fprintf(stdout,
+	   "Warning: duplic Parm %d in Tbl %c (Index=%d), drop line %d in %s\n",
+		parmptr->usParm_id, TableCode,
+		PARMTBL_INDX(parmptr->usParm_id, parmptr->usParm_sub),
+		LineRead, lookup_fn);
+              continue;
+            }
+
+      strcpy (parmptr->db_name, achDBsField);
+      parmptr->fScale = fScale;
+      parmptr->fOffset = fOffset;
+      parmptr->sDSF = sDSF;
+      ++cnt;    /* keep track of #entries loaded */
+
+      DPRINT9(
+ "(+)T2-%c cd=%d:  Parm=%d sub=%d, INDX=%d, dbnm=%s Scl=%.2f Ofs=%.2f D=%d\n"
+	, TableCode, GribCode,
+	parmptr->usParm_id, parmptr->usParm_sub,Indx+GribCode,  
+	parmptr->db_name, parmptr->fScale, parmptr->fOffset, parmptr->sDSF);
+   }
+  
+/*
+*          DEBUG print
+*/
+ DPRINT1("Parameter table has %d entries\n", cnt);
+
+
+/******** Database's LEVEL TABLE *******
+Sample:
+NEONS to GRIB Level Table (FNMOC VERSION)
+NEONS Level Type        GRIB CODE     SCALE     OFFSET
+================        =========     =====     ======
+surface                   001           1.0        0.0
+isth_lvl                  004           0.0      273.16
+trpp_lvl                  007           1.0        0.0
+*
+*           *** DBs's Level Defn conversion info ***
+* A.4       KEEP reading until last of Header/Comment line (see '===')
+*           RETURN error if fails
+*/
+  while (strstr (temp, "====") == NULL) {
+        fgets(temp, sizeof(temp), infile); /* skip Comment/Header lines */
+	LineRead++; 
+  	if (feof(infile) || ferror(infile)) {
+	  DPRINT1 ("%s: got EOF/ERROR before loading DBs LEVEL info\n",func);
+	  sprintf(errmsg,
+	  "%s: got EOF/ERROR before loading LEVEL info (line %d in %s)\n",
+	  func , LineRead, lookup_fn);
+	  goto BYE;
+	}
+   }
+
+/*
+* A.5       FOR (successfully read a line from file) DO
+*              BREAK out of loop if sees Header of next Table
+*              EXTRACT next DBs's Level info into Level Array:
+*              !format= level_type, level_id, scale, offset
+*              DROP line if not enough arguments
+*              DROP line if Duplicate Parm defn
+*              STORE in Level  Array cell whose index equals Level id
+*           ENDFOR
+*/
+  for (cnt=0; fgets(temp, sizeof(temp), infile) != NULL; )  
+  {
+    LineRead++;
+    if (strstr(temp, "to GRIB Model Table") != NULL) 
+	break;  /* Assume end of section */
+    for (ptr=temp; *ptr==' '; ptr++) ; if (*ptr == '#') continue;  
+    if ((num= sscanf (temp, "%s%s%s%s%s", 
+	      achDBsField, strGribCode, strScale, strOffset, dummy)) != 4) 
+	{
+	  if (num>0)
+	    fprintf(stdout,"Warning: unmatched Level args, drop line %d in %s\n",
+	    LineRead, lookup_fn);
+	  continue;
+	}
+
+    GribCode =  atoi(strGribCode);
+    fScale     = (float) atof(strScale);
+    fOffset    = (float) atof(strOffset);
+
+    if (GribCode < 0 || GribCode >= NLEV) {
+	 fprintf(stdout,
+	"Warning: Level_id '%d' out of range, drop line %d in %s\n"
+	,GribCode, LineRead, lookup_fn); 
+	 continue; 
+	}
+
+    if (db_lvl_tbl[GribCode].db_name[0] != '\0') {
+	fprintf(stdout,
+	"Warning: duplic Level %d, drop defn ending on line %d in %s\n",
+	GribCode, LineRead, lookup_fn);
+	continue;
+	}
+
+    db_lvl_tbl[GribCode].usLevel_id  = (unsigned short) GribCode;
+    strncpy (db_lvl_tbl[GribCode].db_name, achDBsField, 
+	    sizeof(db_lvl_tbl[GribCode].db_name)-1);
+    db_lvl_tbl[GribCode].fScale  = fScale;
+    db_lvl_tbl[GribCode].fOffset = fOffset;
+    ++cnt;  /* number loaded */
+
+    DPRINT4("(+)  Level=%d,  db_name=%s,  Scl=%f, Offs=%f\n", 
+	db_lvl_tbl[GribCode].usLevel_id, db_lvl_tbl[GribCode].db_name,
+	db_lvl_tbl[GribCode].fScale, db_lvl_tbl[GribCode].fOffset);
+  }
+  
+/*
+*          DEBUG print
+*/
+  DPRINT1("Level table has %d entries\n", cnt);
+
+
+/*** Database's MODEL TABLE***
+Sample:
+NEONS to GRIB Model ID Table (FNMOC VERSION)
+NEONS Model Name        GRIB CODE
+================        =========
+NORAPS                    001
+COAMPS                    002
+*
+*           *** Database 's Model Defn conversion info ***
+* A.6       KEEP reading until last of Header/Comment line (see '===')
+*           RETURN error if fails
+*/
+  while (strstr (temp, "====") == NULL) {
+        fgets(temp, sizeof(temp), infile); /* skip Comment/Header lines */
+	LineRead++;
+        if (feof(infile) || ferror(infile)) {
+          DPRINT1 ("%s: got EOF/ERROR before loading MODEL info\n",func);
+          sprintf(errmsg,
+          "%s: got EOF/ERROR before loading MODEL info (line %d in %s)\n",
+          func , LineRead, lookup_fn);
+          goto BYE;
+        }
+    }
+/*
+* A.7       FOR (successfully read a line from file) DO
+*              BREAK out of loop if sees Header of next Table
+*              EXTRACT next DBs's Model info into Model Array;
+*              DROP line if not enough arguments
+*              DROP line if Duplicate model defn
+*              ! format= model_name, model_id;
+*              STORE in Model  Array cell whose index equals Model id
+*           ENDFOR
+*/
+  for (cnt=0; fgets(temp, sizeof(temp), infile)!=NULL; ) 
+   {
+     LineRead++;
+     for (ptr=temp; *ptr==' '; ptr++) ; if (*ptr == '#') continue;  
+     if (strstr(temp, "to GRIB Geometry Table") != NULL) 
+	break; /*  Assume end of section */
+     if ((num= sscanf (temp, "%s%s%s", achDBsField, strGribCode,dummy))  !=2) {
+          if (num>0)
+            fprintf(stdout,"Warning: unmatched Model args, drop line %d in %s\n",
+            LineRead, lookup_fn);
+          continue;
+        }
+    
+     GribCode =  atoi(strGribCode);
+     if (GribCode < 0 || GribCode >= NMODEL) {
+         fprintf(stdout,
+           "Warning:  Model_id '%d' out of range, drop line %d in %s",
+           GribCode, LineRead, lookup_fn); continue; }
+
+    if (db_mdl_tbl[GribCode].db_name[0] != '\0') {
+	fprintf(stdout,
+	"Warning: duplic Model %d, drop defn ending on line %d in %s\n",
+	GribCode, LineRead, lookup_fn);
+	continue;
+	}
+
+     db_mdl_tbl[GribCode].usModel_id = (unsigned short) GribCode;
+     strcpy (db_mdl_tbl[GribCode].db_name, achDBsField);
+     ++cnt;  /* number loaded */
+     DPRINT2("(+)  Model=%d,  db_name=%s\n", 
+	db_mdl_tbl[GribCode].usModel_id, db_mdl_tbl[GribCode].db_name);
+   }
+    
+/*
+*          DEBUG print
+*/
+  DPRINT1("Model table has %d entries\n", cnt);
+     
+
+/*** Database's GEOMETRY TABLE*** 
+Sample:
+NEONS to GRIB Geometry Table
+NEONS Geometry Name     GRIB CODE
+===================     =========
+mediterranean_109x82       001
+persian_gulf_NORAPS_63x63  002
+global_144x288             003
+*
+*           *** Database's Geometry Defn conversion info ***
+* A.8       KEEP reading until last of Header/Comment line (see '===')
+*           RETURN error if fails
+*/
+  while (strstr (temp, "====") == NULL) {
+     fgets(temp, sizeof(temp), infile); /* skip Comment/Header lines */
+     LineRead++; 
+     if (feof(infile) || ferror(infile)) {
+          DPRINT1 ("%s: got EOF/ERROR before loading DBs GEOM info\n",func);
+          sprintf(errmsg,
+          "%s: got EOF/ERROR before loading GEOM info (line %d in %s)\n",
+          func , LineRead, lookup_fn);
+          goto BYE;
+        }
+    }
+/*
+* A.9       FOR (successfully read a line from file) DO
+*              EXTRACT next DBs's Geometry info into Geometry Array;
+*              IF (fails) SKIP rest of Geometry defn ;
+*              !format= parm_name, parm_id, scalefctr, offset, dec scale factor;
+*              STORE in Geom  Array cell whose index equals Geom id
+*           ENDFOR
+*/
+  for (cnt=0; fgets(temp, sizeof(temp), infile)!=NULL; ) {
+    LineRead++;
+    for (ptr=temp; *ptr==' '; ptr++) ; if (*ptr == '#') continue;  
+    if ((num= sscanf (temp, "%s%s%s", achDBsField, strGribCode, dummy))  !=2) {
+          if (num>0)
+            fprintf(stdout,"Warning: unmatched Geom args, drop line %d in %s\n",
+            LineRead, lookup_fn);
+          continue; 
+        }
+
+    GribCode =  atoi(strGribCode);
+    if (GribCode < 0 || GribCode >= NGEOM) {
+         fprintf(stdout,
+           "Warning:  Geom_id '%d' out of range, drop line %d in %s\n",
+           GribCode, LineRead, lookup_fn); continue; }
+
+    if (db_geom_tbl[GribCode].db_name[0] != '\0') {
+	fprintf(stdout,
+	"Warning: duplic Geom %d, drop defn ending on line %d in %s\n",
+	GribCode, LineRead, lookup_fn);
+	continue;
+	}
+
+    db_geom_tbl[GribCode].usGeom_id= (unsigned short) GribCode; 
+    strcpy (db_geom_tbl[GribCode].db_name, achDBsField);
+    ++cnt;
+    DPRINT2("(+) geom=%d,  db_name=%s\n", 
+	db_geom_tbl[GribCode].usGeom_id, db_geom_tbl[GribCode].db_name);
+   }
+   
+/*
+*          DEBUG print
+*/
+  DPRINT1("Geometry table has %d entries\n", cnt);
+
+/*
+* 
+* A.10     SET status to 0 !success
+*/
+  stat=0;
+
+/*
+*
+* A.11     CLOSE Lookup file;
+*/
+BYE:
+  if (infile) fclose(infile);
+  DPRINT2 ("Leaving %s(), stat=%d\n", func,stat);
+/*
+*
+* A.12     RETURN with status
+*/
+  return (stat);
+/*
+* END OF FUNCTION
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_grib_origctrs.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_grib_origctrs.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/ld_grib_origctrs.c	(revision 2744)
@@ -0,0 +1,164 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "grib_lookup.h"
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+CTR_DEFN 	db_ctr_tbl[NCTRS];   /* GLOBVARS */
+
+/*
+***************************************************************************
+* A. FUNCTION:  ld_grib_origctrs
+*      Load Originating Centers information from named file into
+*      an array of structures of type CTR_DEFN.  
+*
+*    INTERFACE:
+*      int     ld_grib_origctrs (orig_ctr_fn, pathnm,  errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) char	*orig_ctr_fn;    name of file to load
+*      (I) char *pathnm;         path where input file resides
+*      (O) char *errmsg;         returned filled if error occurred
+*
+*    RETURN CODE:
+*        0: no errors; db_ctrs_tbl array filled;
+*       -1: bad, errmsg is filled;
+***************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int  ld_grib_origctrs ( char *orig_ctr_fn, char *pathnm, char *errmsg)
+#else
+int  ld_grib_origctrs ( orig_ctr_fn, pathnm, errmsg)
+		char *orig_ctr_fn; char *pathnm; char *errmsg;
+#endif
+{
+/*
+*
+* A.0       DEFAULT to bad Status;
+*/
+char *func="ld_grib_origctrs", *ptr;
+char  strGribCode[200],Line[200], fn[200], mybuff[200];
+int ftp_already=0, usGribCode, cnt=0, stat= -1;
+FILE  *fLook;
+
+/*
+*
+* A.1       PREPARE name and path of orig ctr file
+*           CLEAR out the lookup arrays
+*/
+  DPRINT1 ("Entering %s\n", func);
+  sprintf (fn, "%s/%s", pathnm, orig_ctr_fn);
+  DPRINT1 ("Try to load= %s\n", fn);
+  memset ((void*)db_ctr_tbl, '\0', NCTRS * sizeof(CTR_DEFN));
+
+/*
+*
+* A.2       IF (unable to open OrigCtr file for reading) THEN
+*               RETURN with error status;
+*           ENDIF
+*/
+   if ( (fLook= fopen(fn,"r")) == NULL) 
+     {
+	 sprintf(errmsg,"%s: failed to load '%s';\n", func, orig_ctr_fn);
+	 goto BYE;	/* return with error status */
+     }
+
+
+      /*  Now, read:  *** ORIG_CTRS ****
+      Sample:
+
+     GRIB Table 0 - Originating Center Definitions (Octet 5 of PDS)
+     Code Figure    Model Name
+     ===========    ==========
+     007            US Weather Service - National Meteorological Center (NMC)
+     057            US Air Force - Air Force Global Weather Central
+     058            Fleet Numerical Meteorology and Oceanography Center (FNMOC)
+     059            NOAA Forecast Systems Laboratory (FSL)
+     097            European Space Agency (ESA)
+     098            European Centre for Medium Range Weather Forecasts (ECMWF)
+     128            Naval Research Laboratory (NRL) Monterey, CA
+     129            Center for Air/Sea Technology (CAST)
+     */
+
+/*
+*
+* A.3       SKIP over the comments lines 
+*/
+     /* Read until last of Header line */
+     for (Line[0]='\0'; ! strstr(Line,"====") ; ) 
+     {
+       fgets(Line, sizeof(Line), fLook); 
+       if (feof(fLook) || ferror(fLook)) 
+         { sprintf(errmsg,
+	   "%s: got EOF/ERROR skipping over Header lines in %s\n", func,fn);
+	   goto BYE;
+         }
+      }
+
+/*
+* A.4       WHILE (not end of file yet)
+*/
+    cnt=0;
+    while (!feof(fLook) && !ferror(fLook))
+      {
+/*
+*             READ a line  !stop if fails
+*             SKIP line if it doesn't have 2 args or ctr_id out of range
+*             STORE center info into db_ctr_tbl array, cell #usGribCode;
+*/
+		if (fgets(Line, sizeof(Line), fLook) == NULL) break;
+
+	       /* skip additional comments, 
+		replace tabs with spaces, newlines with null
+	       */
+		if (Line[0]=='#') continue;
+		while (ptr=strchr(Line,'\t')) *ptr=' ';
+		if (ptr=strchr(Line,'\n')) *ptr='\0';
+
+                if (sscanf(Line,"%s%s",strGribCode, mybuff) != 2) continue;
+
+	       /* Make sure Ctr_Id field has a Number */
+	       if (strspn (strGribCode, "0123456789") != strlen(strGribCode)) {
+		   sprintf(errmsg,"%s:  Invalid Ctr_id '%s', LINE=\n%s\n",
+		   func,strGribCode, Line);
+		   goto BYE; }
+
+	       	usGribCode = (unsigned short) atoi(strGribCode);
+		if (usGribCode<0 || usGribCode>= NOCTR) continue;
+
+                /* copy over to Neon Tbl, descr has more than 1 words */
+                strncpy(db_ctr_tbl[usGribCode].ctr_dsc, 
+			strstr(Line, mybuff), 
+			sizeof(db_ctr_tbl[usGribCode].ctr_dsc) -1);
+                ++cnt;
+	        DPRINT2 ("(+)  ctr_id=%d, descr=%s\n", usGribCode, 
+		db_ctr_tbl[usGribCode].ctr_dsc); 
+/*
+*           ENDWHILE    !read entries
+*/
+      } 
+
+/*
+*
+* A.5       SET Status to no errors
+*/
+    DPRINT1 ("File 'orig_ctrs' has %d entries\n", cnt);
+    stat = 0;
+
+BYE:
+/*
+*
+* A.6       CLOSE "orig_ctrs" if file is opened
+*
+* A.7       RETURN with status
+*/
+    if (fLook)  close(fLook);
+    DPRINT2 ("Exiting %s, Stat=%d\n", func, stat);
+    return (stat);
+/*
+*
+* END OF FUNCTION
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/make_default_grbfn.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/make_default_grbfn.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/make_default_grbfn.c	(revision 2744)
@@ -0,0 +1,61 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"
+#include "gribfuncs.h"		/* prototypes */
+#include "grib_lookup.h"	/* macros */
+
+/*
+****************************************************************************
+* A.  FUNCTION:   make_default_grbfn
+*        build and return default filename for current message to be encoded
+*        using the information from structures DATA_INPUT and USER_INPUT.
+*
+*    INTERFACE:
+*      void  make_default_grbfn (DATA_INPUT di, USER_INPUT ui, char *default_fn)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) DATA_INPUT  di;     contains info of msg to be encoded
+*      (I) USER_INPUT  ui;     contains the required chCase_id
+*      (O) char *default_fn;   empty string atleast 42 characters long
+*
+*     RETURN CODE: none; default_fn string contains name with format
+*       'Mid_Gid_yyyymmddhhtau_PIndx_Lid.lvl1.c.grb';
+****************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+void    make_default_grbfn  (DATA_INPUT di, USER_INPUT ui, char *default_fn)
+#else
+void    make_default_grbfn  (di,ui,default_fn)
+		DATA_INPUT di; 
+                USER_INPUT ui; 
+                char *default_fn;
+#endif
+{
+/*
+* A.1   Build the default filename:  MMM_GGG_yyyymmddhhtau_PIndx.lvl1.c.grb
+*       where
+*         MMM   : 3-dibit model id from DATA_INPUT
+*         GGG   : 3-digit geom id from DATA_INPUT
+*         yyyy  : 4-digit year of reference date/time from DATA_INPUT
+*          mm   : 2-digit month of reference date/time from DATA_INPUT
+*          dd   : 2-digit day of reference date/time from DATA_INPUT
+*          hh   : 2-digit hour of reference date/time from DATA_INPUT
+*         tau   : 3-digit forecast period  from DATA_INPUT
+*       PIndx   : 4-digit Parameter Index computed from DATA_INPUT's 
+*                 Parmid & ParmSubid
+*         Lid   : 3-digit Level id from DATA_INPUT
+*        lvl1   : 5-digit Level 1  from DATA_INPUT
+*           c   : 1-digit Case id from USER_INPUT
+*        .grb   : 4-char string, as is
+*/
+  sprintf (default_fn, 
+        "%03d_%03d_%04d%02d%02d%02d%03d_%04d_%03d.%05d.%c.grb",
+        di.usProc_id, di.usGrid_id, di.nYear, di.nMonth, di.nDay, 
+        di.nHour, di.usFcst_per1, 
+	(int)PARMTBL_INDX (di.usParm_id, di.usParm_sub_id),
+	di.usLevel_id, di.nLvl_1, 
+        ui.chCase_id);
+
+  DPRINT1("make_default_grb_fn built '%s'\n", default_fn);
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/make_grib_log.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/make_grib_log.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/make_grib_log.c	(revision 2744)
@@ -0,0 +1,851 @@
+/* Program    : make_grib_log (was printer.c)
+   Programmer : Todd J. Kienitz, SAIC
+   Date       : January 10, 1996
+   Purpose    : To produce the information file output of the GRIB message.
+   Revisions  : 
+   04/17/96 Steve Lowe, SAIC:  modified data print-out
+   04/22/96 Alice Nakajima (ATN), SAIC:  added BMS summary
+   12/12/96 ATN:  implement combined Decoder/Encdoer structs
+	    replaced  (table2 tab2[], table3 tab3[], tables mgotab); 
+   06/14/97 ATN:  print upto encoded pricision.
+   02/22/98 ATN:  replace projection id with constants, add printing for
+     prjns: Rotated Lat/Lon, Stretched Lat/Lon, Stretched Rotated Lat/Lon,
+     Rotated Gaussian, Stretched Gauss, Stretched Rotated Gaussian ,
+     Oblique Lambert, and for Albers equal-area.
+   09/10/98 ATN:  extension flag printing.
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "grib_lookup.h"	/* combined encoder/decoder structs */
+#include "dprints.h"		/* for debug printing */
+#include "gribfuncs.h"		/* prototypes */
+
+/* 
+**********************************************************************
+* A. FUNCTION: make_grib_log
+*      Produces debug file GRIB.log from the GRIB message in the Grib Header 
+*
+*    INTERFACE:
+*      int   make_grib_log (input_fn, lookup_fn, msg_length, offset,
+*                           pds, gds, bds, bms, grib_data, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) char *input_fn;            name of input GRIB file 
+*      (I) char *lookup_fn;           name of Lookup file, nil if not used 
+*      (I) unsigned long msg_length;  total length of GRIB message
+*      (I) long offset;               starting location of GRIB message in bytes
+*      (I) PDS_INPUT pds;             product definition section structure
+*      (I) grid_desc_sec gds;         grid description section structure
+*      (I) BDS_HEAD_INPUT bds;        binary data section header structure
+*      (I) BMS_INPUT bms;             bit map definition section structure
+*      (I) float *grib_data;          array of decoded data
+*
+*     ACCESSES GLOBAL VARS:
+*        int UseTables;
+*            set to one if lookup table used
+*        CTRS_DEFN  db_ctr_tbl[NCTRS];
+*            predefined array holding Originating Center info
+*        PARM_DEFN db_parm_tbl [MAX_PARM_TBLS * NPARM];
+*            predefined arr of Parameter info 
+*        LVL_DEFN db_lvl_tbl [NLVL];
+*            predefined arr of Level info struct
+*        MODEL_DEFN db_mdl_tbl [NMODEL];
+*            predefined arr of Model info struct
+*        GEOM_DEFN db_geom_tbl [NGEOM];
+*            predefined arr of Geometry info struct
+*
+*     RETURN CODE:  
+*       0> no errors; file GRIB.log has been created;
+*       1> error, errmsg filled;
+**********************************************************************
+*/
+extern int 	  UseTables; 	 /* set means use lookup tbl defns */
+extern PARM_DEFN  db_parm_tbl[]; /* parameter conversion info */
+extern MODEL_DEFN db_mdl_tbl[];  /* model conversion info */
+extern LVL_DEFN   db_lvl_tbl[];  /* level conversion info */
+extern GEOM_DEFN  db_geom_tbl[]; /* Geom conversion info  */
+extern CTR_DEFN   db_ctr_tbl[];  /* Ctr conversion info  */
+
+#if PROTOTYPE_NEEDED
+int   make_grib_log ( 	char *input_fn, 
+			char *lookup_fn, 
+			unsigned long msg_length, 
+			long offset, 
+			PDS_INPUT pds, 
+			grid_desc_sec gds,
+     		       	BDS_HEAD_INPUT bds, 
+			BMS_INPUT bms, 
+			float *grib_data, 
+			char *errmsg)
+#else
+int   make_grib_log (input_fn, lookup_fn, msg_length, offset,
+		     pds, gds, bds, bms, grib_data,errmsg)
+	char *input_fn;
+	char *lookup_fn; 
+	unsigned long msg_length; 
+	long offset; 
+	PDS_INPUT pds; 
+	grid_desc_sec gds;
+	BDS_HEAD_INPUT bds; 
+	BMS_INPUT bms; 
+	float *grib_data; 
+	char *errmsg;
+#endif
+
+{
+  char *func="make_grib_log";
+  int i, indx, k, fd, numpts=100;
+  float dsf, res, min, max;
+  FILE *fp;
+
+/*
+*
+* A.0   DEBUG printing
+*/
+  DPRINT1 ("Entering %s\n", func);
+
+/* 
+*
+* A.1   OPEN file "GRIB.log" in APPEND mode
+*/
+  fp=fopen ("GRIB.log", "a+");
+  if (!fp) {
+	DPRINT1("%s:  failed to open 'GRIB.log' for appending, skip logfile\n",
+	func); 
+	sprintf (errmsg, "%s:  failed to open 'GRIB.log'\n", func); 
+	return (1);
+	}
+
+/*
+*
+* A.2   WRITE Indicator Section information to file
+*       !message length
+*       !GRIB Edition number
+*/
+  fseek(fp, 0L, 2);
+  if (ftell(fp) == 0L)
+  fprintf (fp, 	"%s: InFile= %s\n%s: Lookup=%d, fn='%s'\n\n" ,
+	   func, input_fn, func,UseTables, lookup_fn);
+
+  fprintf (fp, "**** VALID MESSAGE FOUND AT %ld BYTES ****\n" , offset);
+
+  fprintf(fp, "\n********* SECTION 0 IDS *********\n" );
+  fprintf(fp, "Total Message length = %ld\nEdition Number = %d\n",
+	   msg_length, pds.usEd_num);
+/*
+*
+* A.3   WRITE Product Definition Section information to file
+*       !Section length
+*       !Parameter Table version
+*       !Parameter Sub-Table version if defined and flagged by Extension flag
+*       !Tracking id if defined and flagged by Extension flag
+*/
+  fprintf(fp, "\n********* SECTION 1 PDS *********\n" \
+  	"Section length = %d\nTable version = %d\n",
+	 pds.uslength, pds.usParm_tbl);
+
+  if (pds.usExt_flag == (unsigned short)EXTENSION_FLAG ) 
+   {
+    if (pds.usSub_tbl != 0) 
+        fprintf(fp,"Local Table version = %d\n",pds.usSub_tbl);
+    if(pds.usTrack_num  != 0) 
+	fprintf(fp,"Tracking ID = %d\n",pds.usTrack_num);
+   }
+   
+/*
+*       !Originating Center id
+*       !IF (using tables) Name of Originating Center
+*/
+  fprintf(fp,"Originating Center id = %d\n",pds.usCenter_id);
+  if (UseTables)
+     if ( db_ctr_tbl[pds.usCenter_id].ctr_dsc[0] )
+        fprintf(fp,"Originating Center = %s\n",
+	db_ctr_tbl[pds.usCenter_id].ctr_dsc);
+     else
+        fprintf(fp,"Originating Center ID %d not defined in current table.\n",
+	pds.usCenter_id);
+
+/*
+*       !Sub-Table Entry for Originating Center if non-zero and if
+*       !extension flag is set
+*/
+  if (pds.usExt_flag == (unsigned short)EXTENSION_FLAG && 
+	pds.usCenter_sub != 0) 
+     fprintf(fp,"Sub-Table Entry Originating Center = %d\n",pds.usCenter_sub);
+
+/*
+*       !Extension flag
+*/
+  fprintf(fp,"Extension flag = %d (extensions %s)\n", pds.usExt_flag,
+  (pds.usExt_flag == (unsigned short)EXTENSION_FLAG ? "used" : "not used"));
+
+/*
+*       !Model Identification
+*       !IF (using tables) Model Description
+*/
+  fprintf(fp,"Model id = %d\n",pds.usProc_id);
+  if (UseTables)
+     if ( db_mdl_tbl[pds.usProc_id].grib_dsc[0] )
+        fprintf(fp,"Model Description = %s\n",
+	db_mdl_tbl[pds.usProc_id].grib_dsc);
+     else
+        fprintf(fp,"Model ID %d not defined in current table.\n",
+	pds.usProc_id);
+
+/*
+*       !Grid Identification
+*       !IF (using tables) Grid Description
+*/
+  fprintf(fp,"Grid id = %d\n",pds.usGrid_id);
+  if (UseTables) 
+     if ( db_geom_tbl[pds.usGrid_id].grib_dsc[0] )
+        fprintf(fp,"Grid Description = %s\n",
+	db_geom_tbl[pds.usGrid_id].grib_dsc);
+     else
+        fprintf(fp,"Grid ID %d not defined in current table.\n",
+	pds.usGrid_id);
+
+/*
+*       !Parameter Identification
+*/
+  fprintf(fp,"Parameter id = %d\n",pds.usParm_id);
+
+/*
+*       !IF (usExt_flag is set AND
+*       !    (Parm id between 250 and 254) AND (Sub Parm ID defined)))
+*       !    PRINT Parm_sub 
+*       !ENDIF
+*/
+  if (pds.usExt_flag == (unsigned short)EXTENSION_FLAG &&
+	  pds.usParm_id>=250 && pds.usParm_id<=254 && pds.usParm_sub!=0)
+          fprintf(fp,"Parameter sub-id = %d\n",pds.usParm_sub);
+
+
+/*
+*       !IF (using lookup table) THEN
+*       !  CALCULATE index in Parm Conversion Array to use
+*       !  let index= (usParm_Id - 249)*256 + usParm_sub;
+*       !
+*       !   IF this index in Parm Conversion Array is defined THEN
+*       !       PRINT its grib_dsc and grib_unit_dsc
+*       !   ELSE 
+*       !       PRINT it's not defined mesage
+*       !   ENDIF
+*       !ENDIF
+*/
+  if(UseTables) 
+   {
+      indx = PARMTBL_INDX (pds.usParm_id, pds.usParm_sub);
+
+      if ( db_parm_tbl[indx].grib_dsc[0] ) {
+         fprintf(fp,"Parameter name = %s\n",db_parm_tbl[indx].grib_dsc);
+         fprintf(fp,"Parameter units = %s\n",db_parm_tbl[indx].grib_unit_dsc);
+          }
+      else fprintf(fp,"Parameter ID %d not defined in current table.\n",
+	 pds.usParm_id);
+    }
+
+/*
+*       !Level Id 
+*       !IF (using tables)
+*       !  Level description
+*       !  SWITCH (number of octets to store Height1)
+*       !     2: Level = Height1
+*       !     1: Bottom of Layer = Height1
+*       !        Top of Layer = Height2
+*       !     0: (no Height value required)
+*       !     default: (corrupt table entry or message)
+*       !  ENDSWITCH
+*       !ELSE (not using tables)
+*       !  Level = Height1  (Level assumed)
+*       !ENDIF
+*/
+  fprintf(fp,"Level_type = %d\n",pds.usLevel_id);
+  if(UseTables) {
+    if ( db_lvl_tbl[pds.usLevel_id].grib_dsc[0] ) {
+       fprintf(fp,"Level description = %s\n", 
+		db_lvl_tbl[pds.usLevel_id].grib_dsc);
+       switch(db_lvl_tbl[pds.usLevel_id].num_octets){
+         case 2:
+           fprintf(fp,"%s = %u\n",
+  	   db_lvl_tbl[pds.usLevel_id].lvl_name_1, pds.usHeight1);
+           break;
+         case 1:
+           fprintf(fp,"%s = %u\n%s = %u\n",
+  	   db_lvl_tbl[pds.usLevel_id].lvl_name_1, pds.usHeight1,
+  	   db_lvl_tbl[pds.usLevel_id].lvl_name_2, pds.usHeight2);
+           break;
+         case 0:
+           break;
+         default:
+           fprintf(fp,"***Number of octets for table 3 undefined - possibly "
+                   "corrupt dataset.***\n");
+       }
+    }else
+       fprintf(fp,"Level ID %d not defined in current table.\n",
+	pds.usLevel_id);
+  } /* end UseTables 'if' statement */
+  else fprintf(fp,"Level = %u\n",pds.usHeight1);
+
+/*
+*       !Reference Date/Time:
+*       !  Century
+*       !  Year
+*       !  Month
+*       !  Day
+*       !  Hour
+*       !  Minute
+*       !  Second if defined
+*/
+  fprintf(fp,
+     "Reference Date/Time of Data Set:\n" \
+     "   Century = %d\n   Year = %d\n   Month = %d\n   Day = %d\n"\
+     "   Hour = %d\n   Minute = %d\n",
+     pds.usCentury,pds.usYear,pds.usMonth,pds.usDay,pds.usHour,pds.usMinute);
+
+  if(pds.usExt_flag == (unsigned short)EXTENSION_FLAG)
+	fprintf(fp,"   Second = %d\n",pds.usSecond);
+
+/*
+*       !Forecast Time Unit
+*       !  Forecast Period 1
+*       !  Forecast Period 2
+*/
+  switch(pds.usFcst_unit_id){
+    case 0: fprintf(fp,"Forecast Time Unit = Minute\n"); break;
+    case 1: fprintf(fp,"Forecast Time Unit = Hour\n"); break;
+    case 2: fprintf(fp,"Forecast Time Unit = Day\n"); break;
+    case 3: fprintf(fp,"Forecast Time Unit = Month\n"); break;
+    case 4: fprintf(fp,"Forecast Time Unit = Year\n"); break;
+    case 5: fprintf(fp,"Forecast Time Unit = Decade (10 years)\n"); break;
+    case 6: fprintf(fp,"Forecast Time Unit = Normal (30 years)\n"); break;
+    case 7: fprintf(fp,"Forecast Time Unit = Century (100 years)\n"); break;
+    case 254: fprintf(fp,"Forecast Time Unit = Second\n"); break;
+    default: fprintf(fp,"Forecast Time Unit = UNDEFINED!!\n");
+  }
+  fprintf(fp,"   Forecast Period 1 = %d\n",pds.usP1);
+  fprintf(fp,"   Forecast Period 2 = %d\n",pds.usP2);
+
+/*
+*       !Time Range Indicator
+*       !Number in Average
+*       !Number Missing
+*/
+  fprintf(fp,"Time Range = %d\n",pds.usTime_range);
+  fprintf(fp,"Number in Average = %d\n",pds.usTime_range_avg);
+  fprintf(fp,"Number Missing = %d\n",pds.usTime_range_mis);
+
+/*
+*       !Decimal Scale Factor
+*/
+  fprintf(fp,"Decimal Scale Factor = %d\n",pds.sDec_sc_fctr);
+
+/*
+*
+* A.4   IF (GDS included) THEN
+* A.4.1    WRITE Grid Definition Section information to file
+*            !Section length
+*            !Parm_nv
+*            !Parm_pv_pl
+*            !Data type
+*/
+  if(pds.usGds_bms_id >> 7 & 1) {
+
+     fprintf(fp,"\n********* SECTION 2 GDS *********\n");
+     fprintf(fp,"Section length = %d\n",gds.head.uslength);
+     fprintf(fp,"Parm_nv = %d\n",gds.head.usNum_v);
+     fprintf(fp,"Parm_pv_pl = %d\n",gds.head.usPl_Pv);
+     fprintf(fp,"Data_type = %d\n",gds.head.usData_type);
+   
+/*
+* A.4.2    SWITCH (Data Type, Table 6)
+*                 !  For each Data Type, write the following to file:
+*                 !     Number of points along rows/columns of grid
+*                 !     Reference Lat/Lon information
+*                 !     Resolution and Component Flags (Table 7)
+*                 !       Direction increments if given
+*                 !       Assumption of Earth shape
+*                 !       U&V component orientation
+*                 !     Scanning mode flags (Table 8)
+*              Default: Projection not supported, exit;
+*/
+     fprintf(fp,"Projection = %s\n", prjn_name[gds.head.usData_type]);
+     switch(gds.head.usData_type)
+     {
+
+/*
+*               Case  0: Lat/Lon projection
+*               Case 10: Rotated Lat/Lon projection
+*               Case 20: Stretched Lat/Lon projection
+*               Case 30: Stretched Rotated Lat/Lon projection
+*/
+    case LATLON_PRJ:    	/* Lat/Lon Grid */
+    case ROT_LATLON_PRJ:   	/* Rotated Lat/Lon */
+    case STR_LATLON_PRJ:   	/* Stretched Lat/Lon */
+    case STR_ROT_LATLON_PRJ :  /* Stretched and Rotated Lat/Lon */
+
+      fprintf(fp,"Number of points along a parallel = %d\n",gds.llg.usNi);
+      fprintf(fp,"Number of points along a meridian = %d\n",gds.llg.usNj);
+      fprintf(fp,"Latitude of first grid point = %.3f deg\n",
+      ((float)gds.llg.lLat1)/1000.);
+      fprintf(fp,"Longitude of first grid point = %.3f deg\n",
+      ((float)gds.llg.lLon1)/1000.);
+      fprintf(fp,"Latitude of last grid point = %.3f deg\n",
+      ((float)gds.llg.lLat2)/1000.);
+      fprintf(fp,"Longitude of last grid point = %.3f deg\n",
+      ((float)gds.llg.lLon2)/1000.);
+
+      fprintf(fp,"Resolution and Component Flags: \n");
+      if ((gds.llg.usRes_flag >> 7) & 1) {
+         fprintf(fp,"    Longitudinal increment = %f deg\n",
+	((float)gds.llg.iDi)/1000.);
+         fprintf(fp,"    Latitudinal increment = %f deg\n",
+	((float)gds.llg.iDj)/1000.);
+      }else fprintf(fp,"    Direction increments not given.\n");
+      if ((gds.llg.usRes_flag >> 6) & 1)
+           fprintf(fp,"    Earth assumed oblate spherical.\n");
+      else fprintf(fp,"    Earth assumed spherical.\n");
+      if ((gds.llg.usRes_flag >> 3) & 1)
+           fprintf(fp,"    U&V components resolved relative to +I and "
+                   "+J\n");
+      else fprintf(fp,"    U&V components resolved relative to east "
+                   "and north.\n");
+
+      fprintf(fp,"Scanning Mode Flags: \n");
+      if ((gds.llg.usScan_mode >> 7) & 1)
+           fprintf(fp,"    Points scan in -I direction.\n");
+      else fprintf(fp,"    Points scan in +I direction.\n");
+      if ((gds.llg.usScan_mode >> 6) & 1)
+           fprintf(fp,"    Points scan in +J direction.\n");
+      else fprintf(fp,"    Points scan in -J direction.\n");
+      if ((gds.llg.usScan_mode >> 5) & 1)
+           fprintf(fp,"    Adjacent points in J direction are "
+                   "consecutive.\n");
+      else fprintf(fp,"    Adjacent points in I direction are "
+                   "consecutive.\n");
+
+      /* added 02/98
+	This code pertains only to the Stretch/Rotate grids,
+	so skip over if it's a LATLON_PRJN type;
+	*/
+      if (gds.head.usData_type != LATLON_PRJ) 
+	{
+	fprintf(fp,"    Latitude of southern pole = %.3f deg\n",
+	((float)gds.llg.lLat_southpole)/1000.);
+	fprintf(fp,"    Longitude of southern pole = %.3f deg\n",
+	((float)gds.llg.lLon_southpole)/1000.);
+
+	/* conv from 'saaaaaaa bbbbbbbb bbbbbbbb bbbbbbbb' representation
+	   a single precision floating point value */
+	fprintf(fp,"    Angle of rotation = %.3f\n", 
+	grib_ibm_local ((unsigned long) gds.llg.lRotate));
+
+	fprintf(fp,"    Latitude of pole of stretching = %.3f deg\n",
+	((float)gds.llg.lPole_lat)/1000.);
+	fprintf(fp,"    Longitude of pole of stretching = %.3f deg\n",
+	((float)gds.llg.lPole_lon)/1000.);
+
+	/* conv from 'saaaaaaa bbbbbbbb bbbbbbbb bbbbbbbb' representation
+           a single precision floating point value */
+	fprintf(fp,"    Stretching factor = %.3f\n", 
+	grib_ibm_local ((unsigned long)gds.llg.lStretch));
+	}
+      break;
+
+/*
+*               Case 1: Mercator Projection
+*/
+    case MERC_PRJ:    /* Mercator Projection Grid    */
+
+      fprintf(fp,"Number of points along a parallel = %d\n",gds.merc.cols);
+      fprintf(fp,"Number of points along a meridian = %d\n",gds.merc.rows);
+      fprintf(fp,"Latitude of first grid point = %.3f deg\n",
+      ((float)gds.merc.first_lat)/1000.);
+      fprintf(fp,"Longitude of first grid point = %.3f deg\n",
+      ((float)gds.merc.first_lon)/1000.);
+      fprintf(fp,"Latitude of last grid point = %.3f deg\n",
+      ((float)gds.merc.La2)/1000.);
+      fprintf(fp,"Longitude of last grid point = %.3f deg\n",
+      ((float)gds.merc.Lo2)/1000.);
+      fprintf(fp,"Latitude of intersection with Earth = %.3f deg\n",
+      ((float)gds.merc.latin)/1000.);
+
+      fprintf(fp,"Resolution and Component Flags: \n");
+      if ((gds.merc.usRes_flag >> 7) & 1) {
+         fprintf(fp,"    Longitudinal increment = %f deg\n",
+	 ((float)gds.merc.lon_inc)/1000.);
+         fprintf(fp,"    Latitudinal increment = %f deg\n",
+	 ((float)gds.merc.lat_inc)/1000.);
+      }else fprintf(fp,"    Direction increments not given.\n");
+      if ((gds.merc.usRes_flag >> 6) & 1)
+           fprintf(fp,"    Earth assumed oblate spherical.\n");
+      else fprintf(fp,"    Earth assumed spherical.\n");
+      if ((gds.merc.usRes_flag >> 3) & 1)
+           fprintf(fp,"    U&V components resolved relative to +I and "
+                   "+J\n");
+      else fprintf(fp,"    U&V components resolved relative to east "
+                   "and north.\n");
+
+      fprintf(fp,"Scanning Mode Flags: \n");
+      if ((gds.merc.usScan_mode >> 7) & 1)
+           fprintf(fp,"    Points scan in -I direction.\n");
+      else fprintf(fp,"    Points scan in +I direction.\n");
+      if ((gds.merc.usScan_mode >> 6) & 1)
+           fprintf(fp,"    Points scan in +J direction.\n");
+      else fprintf(fp,"    Points scan in -J direction.\n");
+      if ((gds.merc.usScan_mode >> 5) & 1)
+           fprintf(fp,"    Adjacent points in J direction are "
+                   "consecutive.\n");
+      else fprintf(fp,"    Adjacent points in I direction are "
+                   "consecutive.\n");
+      break;
+
+/*
+*               Case  3: Lambert Conformal Projection
+*               Case 13: Oblique Lambert Conformal Projection
+*               Case  8: Alberts equal-area secant/tangent conic/bipolar Prj
+*/
+    case LAMB_PRJ:  		/* Lambert Conformal */
+    case OBLIQ_LAMB_PRJ:  	/* Oblique Lambert Conformal */
+    case ALBERS_PRJ:  		/* Albers equal-area */
+                  
+      fprintf(fp,"Number of points along X-axis = %d\n",gds.lam.iNx);
+      fprintf(fp,"Number of points along Y-axis = %d\n",gds.lam.iNy);
+      fprintf(fp,"Latitude of first grid point = %.3f deg\n",
+      ((float)gds.lam.lLat1)/1000.);
+      fprintf(fp,"Longitude of first grid point = %.3f deg\n",
+      ((float)gds.lam.lLon1)/1000.);
+      fprintf(fp,"Orientation of grid = %.3f deg\n",
+      ((float)gds.lam.lLon_orient)/1000.);
+      fprintf(fp,"First Latitude Cut = %.3f deg\n",
+      ((float)gds.lam.lLat_cut1)/1000.);
+      fprintf(fp,"Second Latitude Cut = %.3f deg\n",
+      ((float)gds.lam.lLat_cut2)/1000.);
+
+      fprintf(fp,"Resolution and Component Flags: \n");
+      if ((gds.lam.usRes_flag >> 7) & 1) {
+            fprintf(fp,"    X-direction increment = %d meters\n",
+            gds.lam.ulDx);
+            fprintf(fp,"    Y-direction increment = %d meters\n",
+            gds.lam.ulDy);
+      }else fprintf(fp,"    Direction increments not given.\n");
+      if ((gds.lam.usRes_flag >> 6) & 1)
+           fprintf(fp,"    Earth assumed oblate spherical.\n");
+      else fprintf(fp,"    Earth assumed spherical.\n");
+      if ((gds.lam.usRes_flag >> 3) & 1)
+           fprintf(fp,"    U&V components resolved relative to +I and "
+                   "+J\n");
+      else fprintf(fp,"    U&V components resolved relative to east "
+                   "and north.\n");
+
+      fprintf(fp,"Scanning Mode Flags: \n");
+      if ((gds.lam.usScan_mode >> 7) & 1)
+           fprintf(fp,"    Points scan in -I direction.\n");
+      else fprintf(fp,"    Points scan in +I direction.\n");
+      if ((gds.lam.usScan_mode >> 6) & 1)
+           fprintf(fp,"    Points scan in +J direction.\n");
+      else fprintf(fp,"    Points scan in -J direction.\n");
+      if ((gds.lam.usScan_mode >> 5) & 1)
+           fprintf(fp,"    Adjacent points in J direction are "
+                   "consecutive.\n");
+      else fprintf(fp,"    Adjacent points in I direction are "
+                   "consecutive.\n");
+
+      /* 02/98 This code pertains only to the Albers projection */
+      if (gds.head.usData_type == ALBERS_PRJ) 
+	{
+	fprintf(fp,"    Latitude of the southern pole = %.3f\n",
+        ((float)gds.lam.lLat_southpole)/1000.);
+	fprintf(fp,"    Longitude of the southern pole = %.3f\n",
+        ((float)gds.lam.lLon_southpole)/1000.);
+      	}
+      break;
+
+/*
+*               Case  4: Gaussian Lat/Lon Projection
+*               Case 14: Rotated Gaussian Lat/Lon Projection
+*               Case 24: Stretched Gaussian Lat/Lon Projection
+*               Case 34: Stretched Rotated Gaussian Lat/Lon Projection
+*/
+    case GAUSS_PRJ:    		/* Gaussian Latitude/Longitude Grid */
+    case ROT_GAUSS_PRJ:   	/* Rotated Gaussian */
+    case STR_GAUSS_PRJ :   	/* Stretched Gaussian */
+    case STR_ROT_GAUSS_PRJ :   	/* Stretched and Rotated Gaussian */
+
+      fprintf(fp,"Number of points along a parallel = %d\n",gds.llg.usNi);
+      fprintf(fp,"Number of points along a meridian = %d\n",gds.llg.usNj);
+      fprintf(fp,"Latitude of first grid point = %.3f deg\n",
+      ((float)gds.llg.lLat1)/1000.);
+      fprintf(fp,"Longitude of first grid point = %.3f deg\n",
+      ((float)gds.llg.lLon1)/1000.);
+      fprintf(fp,"Latitude of last grid point = %.3f deg\n",
+      ((float)gds.llg.lLat2)/1000.);
+      fprintf(fp,"Longitude of last grid point = %.3f deg\n",
+      ((float)gds.llg.lLon2)/1000.);
+
+      fprintf(fp,"Resolution and Component Flags: \n");
+      if ((gds.llg.usRes_flag >> 7) & 1) {
+         fprintf(fp,"    i direction increment = %f deg\n",
+	((float)gds.llg.iDi)/1000.);
+         fprintf(fp,
+	"    Number of parallels between pole and equator = %d\n",
+	gds.llg.iDj);
+      }else fprintf(fp,"    Direction increments not given.\n");
+      if ((gds.llg.usRes_flag >> 6) & 1)
+           fprintf(fp,"    Earth assumed oblate spherical.\n");
+      else fprintf(fp,"    Earth assumed spherical.\n");
+      if ((gds.llg.usRes_flag >> 3) & 1)
+           fprintf(fp,"    U&V components resolved relative to +I and "
+                   "+J\n");
+      else fprintf(fp,"    U&V components resolved relative to east "
+                   "and north.\n");
+
+      fprintf(fp,"Scanning Mode Flags: \n");
+      if ((gds.llg.usScan_mode >> 7) & 1)
+           fprintf(fp,"    Points scan in -I direction.\n");
+      else fprintf(fp,"    Points scan in +I direction.\n");
+      if ((gds.llg.usScan_mode >> 6) & 1)
+           fprintf(fp,"    Points scan in +J direction.\n");
+      else fprintf(fp,"    Points scan in -J direction.\n");
+      if ((gds.llg.usScan_mode >> 5) & 1)
+           fprintf(fp,"    Adjacent points in J direction are "
+                   "consecutive.\n");
+      else fprintf(fp,"    Adjacent points in I direction are "
+                   "consecutive.\n");
+
+      /* added 02/98
+	This code pertains only to the Stretch/Rotate grids
+	*/
+      if (gds.head.usData_type != GAUSS_PRJ) 
+	{
+	fprintf(fp,"    Latitude of southern pole = %.3f deg\n",
+	((float)gds.llg.lLat_southpole)/1000.);
+	fprintf(fp,"    Longitude of southern pole = %.3f deg\n",
+	((float)gds.llg.lLon_southpole)/1000.);
+	
+       /* conv from 'saaaaaaa bbbbbbbb bbbbbbbb bbbbbbbb' representation
+           a single precision floating point value */
+        fprintf(fp,"    Angle of rotation = %.3f\n",
+        grib_ibm_local ((unsigned long) gds.llg.lRotate));
+
+	fprintf(fp,"    Latitude of pole of stretching = %.3f deg\n",
+	(float)gds.llg.lPole_lat);
+	fprintf(fp,"    Longitude of pole of stretching = %.3f deg\n",
+	(float)gds.llg.lPole_lon);
+	
+	/* conv from 'saaaaaaa bbbbbbbb bbbbbbbb bbbbbbbb' representation
+           a single precision floating point value */
+	fprintf(fp,"    Stretching factor = %.3f\n", 
+	grib_ibm_local ((unsigned long)gds.llg.lStretch));
+	}
+      break;
+
+/*
+*               Case 5: Polar Sterographic Projection
+*/
+    case POLAR_PRJ:    /* Polar Stereographic Projection Grid    */
+      fprintf(fp,"Number of points along X-axis = %d\n",gds.pol.usNx);
+      fprintf(fp,"Number of points along Y-axis = %d\n",gds.pol.usNy);
+      fprintf(fp,"Latitude of first grid point = %.3f deg\n",
+	((float)gds.pol.lLat1)/1000.);
+      fprintf(fp,"Longitude of first grid point = %.3f deg\n",
+	((float)gds.pol.lLon1)/1000.);
+      fprintf(fp,"Orientation of grid = %.3f deg\n",
+	((float)gds.pol.lLon_orient)/1000.);
+      fprintf(fp,"Projection Center: ");
+      if ((gds.pol.usProj_flag >> 7) & 1)
+           fprintf(fp,"South Pole\n");
+      else fprintf(fp,"North Pole\n");
+
+      fprintf(fp,"Resolution and Component Flags: \n");
+      if ((gds.pol.usRes_flag >> 7) & 1) {
+         fprintf(fp,"    X-direction grid length = %d meters\n",gds.pol.ulDx);
+         fprintf(fp,"    Y-direction grid length = %d meters\n",gds.pol.ulDy);
+      }else fprintf(fp,"    Direction increments not given.\n");
+      if ((gds.pol.usRes_flag >> 6) & 1)
+           fprintf(fp,"    Earth assumed oblate spherical.\n");
+      else fprintf(fp,"    Earth assumed spherical.\n");
+      if ((gds.pol.usRes_flag >> 3) & 1)
+           fprintf(fp,"    U&V components resolved relative to +I and "
+                   "+J\n");
+      else fprintf(fp,"    U&V components resolved relative to east "
+                   "and north.\n");
+
+      fprintf(fp,"Scanning Mode Flags: \n");
+      if ((gds.pol.usScan_mode >> 7) & 1)
+           fprintf(fp,"    Points scan in -I direction.\n");
+      else fprintf(fp,"    Points scan in +I direction.\n");
+      if ((gds.pol.usScan_mode >> 6) & 1)
+           fprintf(fp,"    Points scan in +J direction.\n");
+      else fprintf(fp,"    Points scan in -J direction.\n");
+      if ((gds.pol.usScan_mode >> 5) & 1)
+           fprintf(fp,"    Adjacent points in J direction are "
+                   "consecutive.\n");
+      else fprintf(fp,"    Adjacent points in I direction are "
+                   "consecutive.\n");
+      break;
+
+    default:   /* Bad projection:  ignore & continue */ 
+      fprintf(stdout, "\n\n***%s WARNING ***:\nProjection %d is INVALID;\n\n",
+      func, gds.head.usData_type);
+
+      fprintf(fp,"================================================\n"\
+	         "%s:  projection %d is not currently implemented\n"\
+      		"================================================\n",
+      func, gds.head.usData_type);
+      break;
+
+/*
+* A.4.2    ENDSWITCH (Data Type)
+*/
+     } /* Switch */
+
+  } /* gds included */
+/*
+*
+* A.4     ELSE 
+*             PRINT no Gds message
+* A.4     ENDIF
+*/
+  else fprintf(fp,"\n******* NO SECTION 2 GDS *********\n" );
+
+
+/*
+*
+* A.5   IF (Bitmap Section is present)
+*       THEN
+*          WRITE Bitmap Section information to file
+*       ELSE
+*          PRINT no bms mesg
+*       ENDIF
+*/
+  if(pds.usGds_bms_id >> 6 & 1) {
+    fprintf(fp,"\n********* SECTION 3 BMS **********\n" );
+    fprintf(fp,"Section length = %ld\n", bms.uslength);
+    if (bms.uslength <= 6)
+      fprintf(fp,"Bitmap is predefined (Not in message).\n");
+    else fprintf(fp,"Bitmap is included with message.\n");
+    fprintf(fp,"Bitmap ID = %d \n", bms.usBMS_id);
+    fprintf(fp,"Number of unused bits = %d\n", bms.usUnused_bits);
+    fprintf(fp,"Number of datapoints set = %ld\n", bms.ulbits_set);
+  }else{
+    fprintf(fp,"\n******* NO SECTION 3 BMS *********\n" );
+  }
+
+/*
+*
+* A.6   WRITE out Binary Data Section Information to file 
+*       !Section Length
+*/
+  fprintf(fp,"\n********* SECTION 4 BDS *********\n" );
+  fprintf(fp,"Section length = %ld\n",bds.length);
+
+/*
+*       !Table 11 Flags
+*/       
+  fprintf(fp,"Table 11 Flags:\n");
+  if ((bds.usBDS_flag >> 7) & 1)
+       fprintf(fp,"    Spherical harmonic coefficients.\n");
+  else fprintf(fp,"    Grid-point data.\n");
+  if ((bds.usBDS_flag >> 6) & 1)
+       fprintf(fp,"    Second-order packing.\n");
+  else fprintf(fp,"    Simple Packing.\n");
+  if ((bds.usBDS_flag >> 5) & 1)
+       fprintf(fp,"    Integer values.\n");
+  else fprintf(fp,"    Floating point values.\n");
+  if ((bds.usBDS_flag >> 4) & 1)
+       fprintf(fp,"    Octet 14 contains additional flag bits.\n");
+  else fprintf(fp,"    No additional flags at octet 14.\n");
+
+/*
+*       !Decimal Scale Factor (Repeated from PDS)
+*/
+  fprintf(fp,"\nDecimal Scale Factor = %d\n",pds.sDec_sc_fctr);
+
+/*
+*       !Binary Scale Factor
+*       !Bit Width
+*       !Number of Data Points
+*/
+  fprintf(fp,"Binary scale factor = %d\n", bds.Bin_sc_fctr);
+  fprintf(fp,"Bit width = %d\n", bds.usBit_pack_num);
+  fprintf(fp,"Number of data points = %ld\n",bds.ulGrid_size);
+
+/*
+* A.6.1   WRITE Data Summary to file
+*         !Compute Data Min/Max and Resolution
+*/
+  dsf = (float) pow( (double) 10, (double) pds.sDec_sc_fctr);
+  res = (float) pow((double)2,(double)bds.Bin_sc_fctr) / dsf;
+  min = bds.fReference / dsf;
+  max = (float) (pow((double)2, (double)bds.usBit_pack_num) - 1);
+  max = min + max * res;
+  fprintf(fp,"Data Minimum = %f\n", min );
+  fprintf(fp,"Data Maximum = %f\n", max );
+  fprintf(fp,"Resolution = %f\n",res );
+
+/*
+*         !Compute Format Specifier for printing Data
+*/
+  fd = (int) -1 * (float) log10((double) res) + .5; 
+  if (fd <= 0)
+  {
+    fd = 0;
+    fprintf(fp,"DATA will be displayed as integers (res > 0.1).\n");
+  }
+
+/*
+*         !WRITE First 100 Data Points to file up to Encoded Precision
+*/
+  if (bds.ulGrid_size > 1) {
+  if (bds.ulGrid_size < 100) numpts = bds.ulGrid_size;
+  fprintf(fp,"\nDATA ARRAY: (first %d)\n",numpts);
+  if (fd > 0)  {
+	for (i=0; i<numpts; i=i+5)
+	  if (i + 5 < numpts) 
+ 	      fprintf(fp, "%03d-  %.*f  %.*f  %.*f  %.*f  %.*f\n",
+              i,fd,grib_data[i],fd,grib_data[i+1],fd,
+              grib_data[i+2],fd,grib_data[i+3],fd,grib_data[i+4] );
+	  else  {
+	      fprintf(fp,"%03d-", i); 
+	      while (i < numpts) fprintf(fp,"  %.*f", fd, grib_data[i++]);
+	      fprintf(fp,"\n");
+	    }
+	}
+  else  {
+	for (i=0; i<numpts; i=i+5)
+	  if (i + 5 < numpts)
+    	      fprintf(fp, "%03d-  %.0f  %.0f  %.0f  %.0f  %.0f\n",
+              i,grib_data[i],grib_data[i+1],
+              grib_data[i+2],grib_data[i+3],grib_data[i+4] );
+	  else  {
+	      fprintf(fp,"%03d-", i); 
+	      while (i < numpts) fprintf(fp,"  %.0f", grib_data[i++]);
+	      fprintf(fp,"\n");
+	    }
+	}
+  
+  }
+
+  fprintf (fp,"\n******** END OF MESSAGE *******\n\n");
+
+/*
+* 
+* A.7   CLOSE file
+*/
+  fclose (fp);
+
+/*
+*
+* A.8   DEBUG printing
+*/
+  DPRINT1 ("Leaving  %s, no errors\n", func);
+  return (0);
+
+/*
+* END OF FUNCTION
+*
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/map_lvl.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/map_lvl.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/map_lvl.c	(revision 2744)
@@ -0,0 +1,107 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"	  /* for debug printing  */
+#include "grib_lookup.h"  /* LVL_DEFN */
+#include "gribfuncs.h"		/* prototypes */
+
+extern LVL_DEFN    db_lvl_tbl[NLEV];     /* defined in ld_dec_lookup.c */
+
+/*
+************************************************************************
+* A. FUNCTION:  map_lvl
+*       Map the given Level_type to its appropriate usLevelid, scale up the
+*       Level_1 and Level_2 to GRIB unit and also return the Scale Factor, 
+*       Reference.
+*
+*    INTERFACE:
+*       int map_lvl (lvl_type, data_input, lvl_scl_fctr, lvl_reference, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)   char *lvl_type;
+*            name of Level to look for in the array of Level structures;
+*      (I&O) DATA_INPUT *data_input;
+*            structure holding data pertaining to current message required by
+*            the encoder;  Three of its attributes get filled (usLevel_id, 
+*            nLvl_1, nLvl_2);
+*      (O)   float *lvl_scl_fctr, float *lvl_reference;
+*            numbers needed to scale the Level up to GRIB unit.
+*            multiply the level value by the Scale Factor, then add to the
+*            Reference to convert to GRIB unit;
+*      (O)   char *errmsg;
+*            empty array, returned filled if error occurred;
+*
+*      RETURN CODE:
+*        0: success, DATA_INPUT filled, fbuff may have changed;
+*        1: parameter not found, errmsg filled; 
+************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int   map_lvl ( char		*lvl_type,
+		DATA_INPUT  	*data_input,
+		float		*lvl_scl_fctr,
+		float		*lvl_reference,
+		char		*errmsg)
+#else
+int   map_lvl ( lvl_type, data_input, lvl_scl_fctr, lvl_reference,errmsg)
+		char		*lvl_type;
+		DATA_INPUT  	*data_input;
+		float		*lvl_scl_fctr;
+		float		*lvl_reference;
+		char		*errmsg;
+#endif
+{
+char	*func= "map_lvl";
+int	indx= 0;		/* index for array */
+int	found = 0;		/* set if located level  */
+LVL_DEFN   *PL;			/* working var */
+
+ DPRINT1 ("Entering %s\n", func);
+/*
+* A.1       SEARCH the Level info table for the given Level Type
+*/
+   for (PL=db_lvl_tbl; indx < NLEV ; PL=(++indx +db_lvl_tbl)) 
+	if (PL->db_name[0] && !strcmp (PL->db_name, lvl_type))  {
+		found=1; break; 
+	   }
+/*
+*
+* A.2       IF (cannot find it) THEN
+*              FILL errmsg with message
+*              RETURN 1  ! bad status
+*           ENDIF
+*/
+   if (!found) { 
+	DPRINT1 ("No '%s' in db_lvl_tbl;\n", lvl_type);
+	sprintf (errmsg, "%s:  no '%s' in db_lvl_tbl;", func, lvl_type);
+	return (1); 
+	}
+/*
+*
+* A.3       SCALE up nLvl_1 and nLvl_2 to GRIB's unit
+*/
+   data_input->nLvl_1 = (int)(data_input->nLvl_1 * PL->fScale + PL->fOffset);
+   data_input->nLvl_2 = (int)(data_input->nLvl_2 * PL->fScale + PL->fOffset);
+   
+/*
+*
+* A.4       FILL in Level_id DATA_INPUT struct
+*           FILL in caller's Scale factor & Reference
+*/
+   data_input->usLevel_id       = PL->usLevel_id;
+   *lvl_scl_fctr	 	= PL->fScale; 
+   *lvl_reference 		= PL->fOffset;
+
+/*
+*
+* A.5       RETURN with no errors
+*/
+   DPRINT6 (
+    "Found '%s'\nfill Data_Input->usLevel_id=%d; *lvl_scl=%lf, *lvl_ref=%lf\n"\
+    "Scaled up Data_Input->nLvl_1= %d\nScaled up Data_Input->Lvl_2= %d\n",
+    lvl_type,
+    data_input->usLevel_id , *lvl_scl_fctr ,*lvl_reference,
+    data_input->nLvl_1, data_input->nLvl_2);
+  
+   DPRINT1 ("Exiting %s with no errors\n", func);
+   return (0);
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/map_parm.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/map_parm.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/map_parm.c	(revision 2744)
@@ -0,0 +1,139 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"	  /* for debug printing  */
+#include "grib_lookup.h"  /* PARM_DEFN */
+#include "gribfuncs.h"		/* prototypes */
+
+/* DB_PARM_TBL is defined in ld_enc_inputs.c:
+#  as of 4/9/97 this tbl is the master Parameter Table holding
+#  MAX_PARM_TBLS  sets of 256 parameters (previously known as 
+#  Tbl 0/A/B/C/D/E).
+#  Index that are divisable by 256 are reserved and not used;
+#    indices   000-255:  Main parameter tbl (000 is reserved & not used)
+#    indices   256-511:  subtable A (256 is reserved & not used)
+#    indices   512-767:  subtable B (512 is reserved & not used)
+#    indices  768-1023:  subtable C (768 is reserved & not used)
+#    indices 1024-1279:  subtable D (1024 is reserved & not used)
+#    indices 1080-1535:  subtable E (1080 is reserved & not used)
+*/
+extern PARM_DEFN    db_parm_tbl[];
+
+/*
+************************************************************************
+* A. FUNCTION:  map_parm
+*      Map the given Parm_name to its appropriate usParm_id and usParm_sub
+*      within the Parameter Lookup table, and also return its
+*      Scale Factor and Reference which the caller can apply to the
+*      float dta at a later time.
+*
+*    INTERFACE
+*      int  map_parm (parm_name, data_input, parm_scl, parm_ref, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  char *parm_name
+*           Name of Parameter to look for in the array of Parameter structs
+*      (I&O) DATA_INPUT *data_input
+*           attributes (usParm_id, usParm_sub_id, nDec_sc_fctr) are filled;
+*      (O)  float *parm_scl       
+*           used along with parm_ref to convert data to GRIB unit
+*      (O)  float *parm_ref       
+*           used along with parm_scl to convert data to GRIB unit
+*                      
+*    RETURN CODE:
+*      0> success, DATA_INPUT, parm_scl and parm_ref filled 
+*      1> parameter not found, errmsg filled; 
+************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int     map_parm ( char		*parm_name,
+		DATA_INPUT  	*data_input,
+		float		*parm_scl, 
+		float		*parm_ref,
+		char		*errmsg)
+
+#else
+int     map_parm ( parm_name, data_input, parm_scl, parm_ref, errmsg)
+		char		*parm_name;
+		DATA_INPUT  	*data_input;
+		float		*parm_scl;
+		float		*parm_ref;
+		char		*errmsg;
+#endif
+{
+char	*func= "map_parm";
+int	indx= 0;		/* index for array */
+int	found = 0;		/* set if located parm */
+PARM_DEFN   *P;			/* working var */
+
+  DPRINT1 ("Entering %s\n", func);
+
+/*
+* A.1       SEARCH the Parameter info table for the given Parm Name
+*/
+   for (P=db_parm_tbl; indx < NPARM*MAX_PARM_TBLS; P=(++indx +db_parm_tbl)) 
+	if (P->db_name[0] && !strcmp (P->db_name, parm_name))  {
+		found=1; break; 
+	   }
+/*
+*
+* A.2       IF (cannot find it) THEN
+*              FILL errmsg with message
+*              RETURN 1  ! bad status
+*           ENDIF
+*/
+   if (!found) { 
+	DPRINT1 ("No '%s' in db_parm_tbl;\n", parm_name);
+	sprintf (errmsg, "%s: no '%s' in db_parm_tbl", func, parm_name);
+        DPRINT1 ("Exiting  %s, with errors\n", func);
+	return (1); 
+	}
+/*
+*
+* A.3       FILL in Parmid, subParmid, nDec_sc_fctr of DATA_INPUT struct
+*           FILL in Parm_scl and Parm_ref for caller
+*/
+   data_input->usParm_id      = P->usParm_id;
+   data_input->usParm_sub_id  = P->usParm_sub;
+   data_input->nDec_sc_fctr   = P->sDSF;
+   *parm_scl		= P->fScale;
+   *parm_ref		= P->fOffset;
+
+   DPRINT4 (
+   "Found '%s'\nfill Data_Input->Parm_id=%d; \nfill Data_Input->Parm_sub=%d;"\
+   "\nfill Data_Input->DSF=%d\n",
+   parm_name, data_input->usParm_id, data_input->usParm_sub_id,
+   data_input->nDec_sc_fctr);
+
+/*
+#*
+* A.4       /# comment #/
+#* A.4       IF (there is a scl fctr  OR nonzero Offset) THEN
+#*               APPLY Scale Fctr and Offset to Float data
+#*               for all data points in grid 
+#*           ENDIF
+##/
+#  ... where... data_pts was passed in as an argument...
+#
+#   if (P->fScale != 1.0 || P->fOffset != 0.0) {
+#	DPRINT3 ("Scaling FloatArr[%d pts] w/ Scale=%lf, Off=%lf\n",
+#	data_pts,  P->fScale , P->fOffset);
+#
+#      	for (indx=0; indx < data_pts; ++indx)
+#		fbuff[indx]=  fbuff[indx] * P->fScale + P->fOffset;
+#	}
+#   else { DPRINT2("Not scaling float dta  (Scl=%lf, Offs=%lf)\n",
+#   	 P->fScale , P->fOffset); 
+#	}
+*/
+   
+/*
+*
+* A.5       RETURN with no errors
+*/
+   DPRINT1 ("Exiting %s with no errors\n", func);
+   return (0);
+/*
+*
+* END OF FUNCTION
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/pack_spatial.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/pack_spatial.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/pack_spatial.c	(revision 2744)
@@ -0,0 +1,650 @@
+/* 20jun97/atn:  always scaling data up whether dsf is -/+; 
+*/
+#include <stdio.h> 
+#include <stdlib.h>
+#include <string.h> 
+#include <math.h>
+#ifdef XT3_Catamount
+#include <features.h>
+#undef htonl
+#define htonl(x)     swap_byte4(x)
+#else
+#include <netinet/in.h>
+#endif
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+#include "isdb.h"		/* WORD_BIT_CNT defn */
+
+/*
+****************************************************************
+* A. FUNCTION:   pack_spatial
+*      pack gridded data values into a bitstream 
+*
+*    INTERFACE:
+*      int     pack_spatial (pt_cnt, bit_cnt, pack_null, fbuff, ppbitstream,
+*                           dec_scl_fctr, BDSlength, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*     (I) long *pt_cnt;                count of points in grid 
+*     (I) long *bit_cnt;               count of bits to pack value in.  
+*                                      will be calculated if set to zero
+*     (I) float *pack_null;            parameter value for null (huge number) 
+*   (I&O) float *fbuff;                array containing grid values to pack
+*                                     returned scaled up by Decimal Scale Factor
+*     (O) unsigned long **ppbitstream; Null upon entry; 
+*                                      returned pointing to new Storage 
+*                                      holding packed bitstream;
+*     (I) short dec_scl_fctr;          decimal scale factor to apply to data
+*     (O) long  *BDSlength;            updated with #bytes in packed bitstream
+*     (O) char  *errmsg                returned filled if error occurred
+*
+*    RETURN CODE: 
+*      0> success, ppbitstream contains packed values
+*   else> error: errmsg holds msg;
+****************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int	pack_spatial ( long   		*pt_cnt,
+			unsigned short	*bit_cnt,
+			float		*pack_null,
+			float 		*fbuff,
+			unsigned long 	**ppbitstream,
+			short   	dec_scl_fctr,
+			long    	*BDSlength,
+			char    	*errmsg)
+
+#else
+int	pack_spatial (  pt_cnt, bit_cnt, pack_null, fbuff, ppbitstream,
+			dec_scl_fctr, BDSlength, errmsg)
+			long   		*pt_cnt;
+			unsigned short	*bit_cnt;
+			float		*pack_null;
+			float 		*fbuff;
+			unsigned long  	**ppbitstream;
+			short   	dec_scl_fctr;
+			long    	*BDSlength;
+			char    	*errmsg;
+#endif
+{
+    char *func="pack_spatial";
+    long ipt;			/* index over points */
+    int null_flag;		/* flag indicating presence of null values */
+    int bit1;			/* starting bit in current word */ 
+    int empty;			/* number of empty bits in word */ 
+    int diff;			/* difference of empty - bit1 */ 
+    long max_value;		/* max value storable in bit_cnt bits */
+    unsigned long itemp;	/* temporary unsigned integer */
+    unsigned long *bstr;	/* pointer running across bitstream */
+    int pack_bit_cnt;		/* count of bits to pack parameter values */ 
+    int unused_bit_cnt; 	/* count of unused bits for i2 words */
+    /*long byte4_cnt;		/- count of bytes using i4 words */
+    long byte2_cnt;		/* count of bytes using i2 words */
+    short scl_fctr;		/* scaling factor for grid values */
+    double pow_scl;		/* 2 ** (-scl_fctr) */
+    double pwr10toD;		/* 10 ** (D) */
+    float reference;		/* reference = minimum value in grid */
+    float max_grid;		/* maximum value in grid */
+    float ftemp;		/* temporary float containing grid value */
+    unsigned long *pBitstream;
+    unsigned long grib_local_ibm();
+    int wordnum;
+    int zero_cnt;
+    int prec_too_high = 0;
+    unsigned char bdshdr[14];   /* Character array to temporarily hold bds
+                                 *   header */
+    int hdrwords;
+
+    DPRINT1 ( "Entering %s....\n", func );
+
+/*
+*
+* A.1       IF (no data in grid) THEN
+*              PRINT message
+*              RETURN Stat= -1
+*           ENDIF
+*/
+    if (*pt_cnt <= 0) {
+	DPRINT2 ("%s; invalid pt_cnt = %d\n", func,*pt_cnt);
+	sprintf(errmsg, "%s; invalid pt_cnt = %d\n", func,*pt_cnt);
+	return (-1);
+    }
+
+/*
+*
+* A.2       IF (number of bits to pack into is greater than 30) THEN
+*               PRINT message
+*               RETURN Stat= -1
+*           ENDIF
+*           SET pack_bit_cnt for local use
+*/
+    if ( *bit_cnt > 30 ) {
+	DPRINT2 ("%s; invalid bit_cnt = %d\n", func,*bit_cnt);
+	sprintf(errmsg, "%s; invalid bit_cnt = %d\n", func,*bit_cnt);
+	return (-1);
+    }
+    pack_bit_cnt	= (int) *bit_cnt; 
+    DPRINT1 ("  use Pack_bit_cnt= %d\n", pack_bit_cnt);
+
+/*
+*  		
+* A.3      FOR (each data point) DO
+*              SCALE all values of data array  !multiply by 10**DSF
+*          ENDDO
+*/
+	pwr10toD=  pow ( 10., (double) dec_scl_fctr );
+	for (ipt=0; ipt < *pt_cnt; ipt++)  fbuff[ipt] *= pwr10toD;
+
+        DPRINT2 ("  Decimal Scale Fctr= %d, scale data by 10**dsf "\
+	"(Fbuff *= %lf)\n", dec_scl_fctr,  pwr10toD);
+/*
+*
+* A.4       INIT reference, max_grid, null_flag 
+*/
+    reference  	= 1.e30;
+    max_grid  	= -1.e30;
+    null_flag 	= 0;
+
+/*
+*
+* A.5       FOR (each data point) DO
+*              IF (value < reference) THEN
+*                  SET reference to this value   !smallest value
+*              ENDIF
+*              IF (value > max_grid AND not a missing value ) THEN
+*                  SET max_grid to this value    !largest value
+*              ENDIF
+*              IF (value >= missing value ) THEN
+*                  SET null_flag to 1            !grid contains nulls
+*              ENDIF
+*           ENDDO
+  Find reference (minimum) and maximum values of the grid points 
+*/
+    for (ipt = 0; ipt < *pt_cnt; ipt++) {
+	ftemp	= *(fbuff+ipt);
+	if (ftemp < reference) reference = ftemp;    /* REF is SCALED UP */
+	if (ftemp > max_grid && ftemp < *pack_null) max_grid = ftemp;
+	if (ftemp >= *pack_null) null_flag = 1;
+    }
+
+    DPRINT2 ("  Max before taking out Ref =%.4lf\n  Null flag=%d\n",
+    max_grid, null_flag);
+
+/*  Compute maximum range of grid (max_grid - reference) */
+/*
+*
+* A.6       IF (max value is same as smallest value AND
+*               null_flag is zero) THEN
+*               CLEAR pack_bit_cnt  !constant values, no nulls
+*               CLEAR max_grid      !set grid range to 0
+*/
+    if (((max_grid - reference) < 1.0) && null_flag == 0) {   
+	pack_bit_cnt = 0;
+        max_grid =  0;
+
+/*
+* A.6.a     ELSE IF (max value is same as smallest value AND
+*                    null_flag is set) THEN
+*               SET max_grid to 1      !const values, some nulls
+*/
+    } else if (((max_grid - reference) < 1.0) && null_flag == 1) {
+	max_grid = 1.;
+
+/*
+* A.6.b     ELSE IF (max value <= -1.e29 AND null_flag is set) THEN
+*               PRINT message
+*               RETURN Stat= -1
+*/
+    } else if (max_grid <= -1.e29 && null_flag == 1) {
+	DPRINT1 ("%s; Grid contains all NULLS\n",func);
+	sprintf(errmsg, "%s; Grid contains all NULLS\n",func);
+	return (-1);
+
+/*
+* A.6.c     ELSE IF (max value not equal to reference) THEN
+*               SET max_grid (max_grid-reference) !non-constant values w/wo nulls
+*/
+    } else if (max_grid != reference) {
+	max_grid -= reference;
+
+/*
+* A.6       ENDIF
+*/
+    }
+
+/*
+* 
+* A.7       DEBUG print grid range and reference value
+*/
+    DPRINT2 ( "  Reference = %f\n  Max_grid (range) = %f\n",  
+    reference, max_grid);
+
+/*  Find minimum number of bits to pack data */
+/*
+*
+* A.8.a     IF (grid range is not zero) THEN
+*/
+    if ( max_grid != 0 )    
+    {
+
+/*
+*
+* A.8.a.1      DEBUG print input bit width
+*              IF (input bit_num is zero) THEN
+*                 CALCULATE number of bits needed to store grid range
+*                 DEBUG print calculated bit count
+*              ENDIF
+*/
+       DPRINT1 ( "  Input bit cnt = %d\n", pack_bit_cnt );
+       if ( pack_bit_cnt == 0 )
+       {
+          pack_bit_cnt = (int)(floor(log10((double)max_grid) / log10(2.)) +1); 
+          DPRINT1 ( "  Calculated bit cnt = %d\n", pack_bit_cnt );
+       }
+       if ( (pack_bit_cnt < 0) || (pack_bit_cnt > 30) )
+       {
+          DPRINT1 ("%s: Calculated bit count OUT OF RANGE [0 - 30] !!\n", func);
+          sprintf (errmsg, "%s: Calculated bit count OUT OF RANGE!! bit_cnt: %d  max: %f\n", func,pack_bit_cnt,max_grid);
+          return (-1);
+       }
+/*
+*
+* A.8.a.2      CALCULATE various byte counters
+*              !itemp: #bits required for header + grid
+*              !Byte2_cnt: #bytes rounded up to next 2-byte bdry
+*              !Byte4_cnt: #bytes rounded up to next 4-byte bdry
+*              !Unused_bit_cnt: #unused bits at end using byte2_cnt
+*              DEBUG print expected length and unused bits
+*/
+       itemp = *pt_cnt * pack_bit_cnt + 11 * BYTE_BIT_CNT;
+       byte2_cnt = (long) ceil(((double) itemp / BYTE_BIT_CNT) / 2.) * 2;
+       /*byte4_cnt = (long) ceil(((double) itemp / BYTE_BIT_CNT) / 4.) * 4;*/
+       unused_bit_cnt = byte2_cnt * BYTE_BIT_CNT - itemp;
+       DPRINT1 ( "  Calculated length = %ld bytes (Rnd2)\n", byte2_cnt);
+       DPRINT1 ( "  Bitstream padding = %ld bits\n",unused_bit_cnt);
+
+/*
+*
+* A.8.a.3      CALCULATE maximum storable value 
+*              CALCULATE scl_fctr required to fit grid range
+*                        into available bit width
+*/
+       max_value = (long) pow(2., (double) pack_bit_cnt) - 1;
+       if (max_value < 2) max_value = 2;
+       scl_fctr	= -(short) floor(log10((double) (max_value-1) / 
+		  	  (double) max_grid) / log10(2.));
+       pow_scl 	= pow(2., (double) -scl_fctr); 
+       DPRINT1 ( "  Calculated Binary scale = %d\n",scl_fctr);
+    }
+
+/*
+*
+* A.8.b     ELSE       !max_grid = 0, all zero data or constant values
+*              SET number of bits to pack to zero
+*              SET lengths to 12 bytes
+*              SET unused bits to 8 (1 byte of padding)
+*              SET scl_fctr to 0
+*              DEBUG print constant grid
+*           ENDIF
+*/
+    else
+    {
+       pack_bit_cnt = 0;
+       byte2_cnt = 12;
+       /*byte4_cnt = 12;*/
+       unused_bit_cnt	= 8;
+       scl_fctr	= 0;
+       DPRINT0 ( "  Constant grid.  Using bit cnt = 0\n");
+    }
+
+/*
+*
+* A.9       MALLOC space for bitstream (Rnd2_cnt)
+*           IF (failed) THEN
+*              PRINT error mesg
+*              RETURN Stat= 999;
+*           ENDIF
+*/ 
+    pBitstream = ( unsigned long * ) malloc ( sizeof( unsigned long ) * 
+					      byte2_cnt );
+    if ( !pBitstream )
+    {
+       DPRINT1 ("%s:  MAlloc failed pBitstream\n", func );
+       sprintf(errmsg, "%s:  MAlloc failed pBitstream\n", func );
+       return (999);
+    }
+
+/*
+*
+* A.10      SET ptr to bitstream
+*           UPDATE bit_cnt for input structure
+*/
+    *bit_cnt = (unsigned short) pack_bit_cnt;
+    DPRINT1 ("  Updated input bit cnt to %d\n", *bit_cnt);
+    bstr = pBitstream;
+ 
+/*
+*
+* A.11      ZERO out entire bitstream
+*/
+   zero_cnt = ceil(byte2_cnt / (float)sizeof(long)) * sizeof(long);
+   memset ((void *)pBitstream, '\0', zero_cnt);
+
+/*
+*
+* A.12      PUT packing info into first 11 bytes: 
+*           NOTE: The Table 11 Flag stored in the first
+*                 4 bits of Octet 4 is HARDCODED to 0000.
+*                 This implies Simple packing of float
+*                 grid point data with no additional flags.
+*           Octet 1-3  = Byte2_cnt
+*           Octet 4    = Table 11 Flag & unused_bit_cnt
+*           Octet 5-6  = Scl_fctr
+*           Octet 7-10 = Reference truncated to DSF precision
+*           Octet 11   = Pack_bit_cnt
+*           Octet 12   = Bitstream starts (bit 25 of word 3)
+*/
+
+
+   set_bytes_u(byte2_cnt, 3, bdshdr);
+
+   itemp = unused_bit_cnt;
+   set_bytes_u(itemp, 1, bdshdr+3);
+
+   set_bytes_u(scl_fctr, 2, bdshdr+4);
+
+   DPRINT1 ("  Reference (%f) ", reference);
+   reference   =  floor((double) reference + .5);
+   DPRINT1 ("truncated to DSF precision= %lf\n", reference);
+   itemp        = grib_local_ibm(reference);
+   DPRINT1 ("  Reference converted to local IBM format= 0x%x\n", itemp);
+
+   set_bytes_u(itemp, 4, bdshdr+6);
+
+   set_bytes_u(pack_bit_cnt, 1, bdshdr+10);
+
+   bit1 = 25;
+
+   memcpy(bstr,bdshdr,11);
+
+   /* 
+    * For non-internet byte order machines (i.e., linux), 
+    * We reverse the order of the last byte in the bds header, since
+    *   it will be reversed once again below.
+    */
+   hdrwords = 11/(WORD_BIT_CNT/BYTE_BIT_CNT);
+   set_bytes_u(bstr[hdrwords], WORD_BIT_CNT/BYTE_BIT_CNT,
+              (char *)(bstr+hdrwords) );
+
+   bstr += hdrwords;
+
+
+/*
+    itemp	= unused_bit_cnt;
+    *bstr	= (byte2_cnt << 8) | itemp;
+    bstr++;
+    *bstr	= scl_fctr;
+
+    DPRINT1 ("  Reference (%f) ", reference);
+    reference   =  floor((double) reference + .5);
+    DPRINT1 ("truncated to DSF precision= %lf\n", reference);
+    itemp	= grib_local_ibm(reference);
+    DPRINT1 ("  Reference converted to local IBM format= 0x%x\n", itemp);
+
+    *bstr	= (*bstr << 16) | (itemp >> 16);
+    bstr++;
+    *bstr	= (itemp << 16) | (pack_bit_cnt << 8);
+    bit1	= 25;  	*/	 /* starting bit within current bstr word */
+
+/*
+*
+* A.13      IF (grid values are not constant) THEN
+*/ 
+    if (pack_bit_cnt > 0) {
+
+
+/*
+* A.13.1       SET empty value
+*/
+   	empty = WORD_BIT_CNT - pack_bit_cnt + 1;
+
+	for (ipt=0; ipt < 5; ipt++) DPRINT4 (
+	    " ITEMP= (*(fbuff+ipt) - reference) * pow_scl + .5=\n"\
+	    "        (%lf -%lf) * %lf + .5 = %lf\n",
+	    *(fbuff+ipt), reference, pow_scl, 
+	    (*(fbuff+ipt) - reference) * pow_scl + .5);
+	   
+/*
+* A.13.2       FOR (each point in bitstream) DO
+*/
+	for (ipt = 0; ipt < *pt_cnt; ipt++) {
+
+/*
+* A.13.2.1         IF ( data value < pack_null) THEN
+*                     SET itemp to (value - reference) * pow_scl + .5;
+*                  ELSE
+*                     SET itemp to max value;
+*                  ENDIF
+*/
+	    if (*(fbuff+ipt) < *pack_null) {
+	    	itemp  = (*(fbuff+ipt) - reference) * pow_scl + .5;
+	    } else {
+	    	itemp  = max_value; 
+		DPRINT1 ("%s: Setting to max_value: Precision may be too high !!\n", func);
+		sprintf (errmsg, "%s: Setting grid point to max value, precision may be too high", func);
+		/*		return (-1); */
+	    }
+
+/*
+* A.13.2.2         COMPUTE if data point can fit in current word
+*/
+	    diff	= empty - bit1;
+
+/*
+* A.13.2.3.a       IF (data point falls within word ) THEN
+*                      SHIFT value to the correct bit position 
+*                      COMBINE it with data in current word of bitstream
+*                      CALCULATE starting bit in curr word for next time
+*/
+	    if (diff > 0)
+            {
+		*bstr 	|= itemp << diff;
+		bit1 	+= pack_bit_cnt;
+	    }
+
+/*
+* A.13.2.3.b       ELSE IF (data point ends at word boundary) THEN
+*                      COMBINE value with data in current word of bitstream
+*                      SET starting bit to 1
+*                      BUMP word counter in bitstream up by 1 word
+*/
+	    else if (diff == 0) 
+            {
+	        *bstr |= itemp;
+	        bit1   = 1;
+	        bstr++;
+	    }
+
+/*
+* A.13.2.3.c       ELSE     !point crosses word boundary
+*                      STORE "diff" bits of value in current word of bitstream
+*                      BUMP word counter in bitstream up by 1 word
+*                      STORE remaining bits of value in next word
+*                      CALCULATE starting bit in curr word for next time
+*                  ENDIF    !word location check
+*/
+	    else  		/* pixel crosses word boundary */
+            {
+	        *bstr |= itemp >> -diff;
+	        bstr++;
+	        *bstr |= itemp << (WORD_BIT_CNT + diff);
+	        bit1   = -diff + 1;
+    	    }
+
+/*
+* A.13.2        ENDFOR loop over grid points
+*/
+       }
+
+/*
+* A.13       ENDIF (pack_bit_cnt > 0)
+*/
+    }
+
+/* For little endian machines, swap the bytes in the bstr pointer */
+    /*    for (wordnum = 0; */
+    for (wordnum = hdrwords;
+	 wordnum < ceil(byte2_cnt/(float)(WORD_BIT_CNT/BYTE_BIT_CNT)); 
+	 wordnum++) {
+      set_bytes_u(pBitstream[wordnum], WORD_BIT_CNT/BYTE_BIT_CNT, 
+		  (char *)(pBitstream+wordnum) );
+    }
+
+/*
+*
+* A.14       ASSIGN bitstream block to ppbitstream pointer
+*            SET BDSlength (size rnded to next 2 byte boundary)
+*            RETURN Status 0  ! success
+*/
+    *ppbitstream = pBitstream;
+    *BDSlength = (long) byte2_cnt;
+
+    DPRINT1 ("Exiting pack_spatial, BDS len=%ld,  Status=0\n" , *BDSlength);
+
+    if (prec_too_high) {
+	fprintf(stderr,"pack_spatial: Warning: Precision for a parameter may be too high in gribmap.txt\n");
+    }
+    return (0);
+/*
+* END OF FUNCTION
+*
+*/
+}
+
+/*
+*
+**************************************************************
+* B. FUNCTION  grib_local_ibm
+*      convert local_float from local floating point to
+*      IBM floating point stored in a 4-byte integer.
+*
+*    INTERFACE:
+*      unsigned long grib_local_ibm (local_float)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  double local_float      float value in local format
+*
+*    RETURNS:
+*       the actual IBM floating point value
+**************************************************************
+*
+*/
+#if PROTOTYPE_NEEDED
+unsigned long grib_local_ibm (double local_float)
+#else
+unsigned long grib_local_ibm (local_float)
+double local_float;
+#endif
+{
+    long a, b; 
+    unsigned long ibm_float;
+/*
+*
+* B.1.a     IF (local float value is zero) THEN
+*               SET the ibm float to zero too
+*/
+    if (local_float == 0.) { 
+        ibm_float = 0;
+    } else {
+/*
+* B.1.b     ELSE
+*              CONVERT to IBM floating point
+*              ! IBM floating point is stored in 4 bytes as:  
+*              ! saaaaaaa bbbbbbbb bbbbbbbb bbbbbbbb
+*              ! where s is sign bit, 0 -> positive, 1 -> negative
+*              !       a is 7-bit characteristic
+*              !       b is 24-bit fraction
+*              ! s, a and b are obtained from local_float (local 32-bit float) as
+*              !       s = sign(local_float)
+*              !       a = ceil(log10(local_float) / log10(16.)) + 64 
+*              !       b = local_float / 16**(a-64) * 2**24
+* B.1.b     ENDIF
+*/
+        a = ceil(log10(fabs(local_float)) / log10(16.)) + 64;
+	/* Added by Todd Hutchinson, 8/13/99 */
+	/* This fixes a problem when local_float == 256, etc. */
+	if ( fmod((log10(fabs(local_float))/log10(16.)),1.) == 0) {
+	  a++;
+	}
+/*      Local_float == +/-1. is a special case because of log function */
+        if ( (local_float == 1.) || (local_float == -1.)) a = 65;
+        b = (long) (fabs(local_float) * pow(16.,(double) (70 - a)) +.5)
+            & 0x00ffffff; 
+        ibm_float = (((local_float > 0.) ? 0 : 1) << 31) | (a << 24) | b;
+    }
+/*
+*
+* B.2       RETURN the ibm float value
+*/
+    return ibm_float;
+/*
+*
+* END OF FUNCTION
+*
+*/ }
+
+/*
+*
+**************************************************************
+* C. FUNCTION:   grib_ibm_local
+*      convert local_float from IBM floating point to
+*      local floating point.
+*
+*    INTERFACE:
+*      float grib_ibm_local(ibm_float)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  double local_float      float value in local format
+*
+*     RETURNS:
+*        the actual local floating point
+**************************************************************
+*/
+#if PROTOTYPE_NEEDED
+float grib_ibm_local( unsigned long ibm_float)
+#else
+float grib_ibm_local( ibm_float)
+unsigned long ibm_float;
+#endif
+{
+/*
+  Convert ibm_float from IBM floating point stored in a 4-byte integer 
+  to local floating point.
+*
+* C.1       DETERMINE local floating point
+*           ! IBM floating point is stored in 4 bytes as:  
+*           ! saaaaaaa bbbbbbbb bbbbbbbb bbbbbbbb
+*           ! where s is sign bit, 0 -> positive, 1 -> negative
+*           !       a is 7-bit characteristic
+*           !       b is 24-bit fraction
+*           ! local_float (local 32-bit float) is recovered from 
+*           ! s, a and b as
+*           ! local_float = (-1)**s * 2**(-24) * b * 16**(a-64)
+*/
+
+    long a, b;
+    float local_float;
+
+    a = (ibm_float >> 24) & 0x0000007f;
+    b = ibm_float & 0x00ffffff;
+    local_float = (float) b * pow(16., (double) (a - 70));
+    if (ibm_float >> 31) local_float = -local_float;
+/*
+*
+* C.2       RETURN floating point
+*/
+    return local_float;
+/*
+* END OF FUNCTION
+*
+*/ 
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/prt_badmsg.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/prt_badmsg.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/prt_badmsg.c	(revision 2744)
@@ -0,0 +1,328 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "gribfuncs.h"
+/*
+**************************************************************************
+* A.  FUNCTION:  prt_badmsg
+*     Print out as much information as possible from the GRIB message
+*     currently in GRIB_HDR structure.  This may be an erroneous or
+*     a partial message.
+*
+*    INTERFACE:
+*      int  prt_badmsg (gh, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I)  GRIB_HDR *gh;
+*           pointer to Grib header structure.
+*      (O)  char *errmsg;
+*           Empty array, Returned filled if error is found;
+*
+*     RETURN CODE:
+*        0> decoded message without any errors; 
+*        1> error, errmsg buffer filled;
+***********************************************************************
+*/
+#if PROTOTYPE_NEEDED
+int       prt_badmsg (GRIB_HDR *gh, char *errmsg)
+#else
+int       prt_badmsg (gh, errmsg)
+GRIB_HDR  *gh; 	                   /*input= Grib Header struct */
+char      *errmsg;                 /* output= empty unless Error happens */
+#endif
+{
+  PDS_INPUT     pds;           /* local PDS struct  */
+  grid_desc_sec gds;           /* local GDS struct  */
+  BDS_HEAD_INPUT bds_head;     /* local BDS header struct  */
+  BMS_INPUT     bms;           /* local bitmap section struct  */
+  float         *grib_data;    /* local ptr to float data  */
+  PDS_INPUT     *Tpds = NULL;  /* Null until valid PDS found*/
+  grid_desc_sec *Tgds = NULL;  /* Null until valid GDS found*/
+  BDS_HEAD_INPUT *Tbds= NULL;  /* Null until valid BDS found*/
+  BMS_INPUT     *Tbms = NULL;  /* Null until valid BMS found*/
+  char *func="prt_badmsg";     /* Function name */
+  char *curr_ptr;  		/* pts to beginning of GRIB message */
+  unsigned long lMessageSize;       /* message length  */
+  unsigned long  edition;                     /* GRIB edition number */
+  int bms_flag = 0;                 /* set if Bms present*/
+  int gds_flag = 0;                 /* set if Gds present */
+  int nReturn = 1;		    /* status, default is bad  */
+  unsigned long skip;
+
+/*
+*
+* A.1     CLEAR out local structures
+*/
+ fprintf(stdout,"\nEntering %s:  getting info from GRIB Header\n", func);
+ memset ((void *)&pds, '\0', sizeof(PDS_INPUT));
+ memset ((void *)&gds, '\0', sizeof(grid_desc_sec));
+ memset ((void *)&bds_head, '\0', sizeof(BDS_HEAD_INPUT));
+ memset ((void *)&bms, '\0', sizeof(BMS_INPUT));
+ grib_data = (float *)NULL;
+
+/*
+*
+* A.2     IF (incoming pointer is not at 'GRIB') 
+*            RETURN 1  !errmsg filled
+*         ENDIF
+*/
+curr_ptr = (char *)gh->entire_msg;  
+if(strncmp(curr_ptr,"GRIB",4) != 0) {
+  sprintf(errmsg,"%s:  no 'GRIB' at beg. of this msg.  Cannot continue.\n", 
+  func);
+  goto BYE;
+ }
+fprintf(stdout,"See 'GRIB'\n");
+
+/*
+*
+* A.3     FUNCTION gbyte   !get total message length from IDS 
+*/
+skip=32;
+gbyte(curr_ptr,&lMessageSize,&skip,24);
+if (lMessageSize <= 8) {
+	sprintf(errmsg,"Message length too short (%ld), cannot continue\n",
+	lMessageSize);
+	goto BYE;
+	}
+fprintf(stdout,"Message Length = %ld\n", lMessageSize);
+
+/*
+*
+* A.4     PRINT warning message if Message length > Buffer size
+*/
+if (lMessageSize > gh->abs_size) 
+	fprintf(stdout,
+	"*** Messagelen (%ld) > buffersize (%ld), MAY BE CORRUPTED ***\n",
+	lMessageSize, gh->abs_size);
+
+/*
+*
+* A.5     EXTRACT the  GRIB edition out of Section 0
+*/
+gbyte (curr_ptr,&edition, &skip,8);
+fprintf(stdout,"Edition = %ld\n", edition);
+
+/*
+*
+* A.6     MOVE pointer to the Product Definition section
+*/
+curr_ptr = curr_ptr + 8;
+fprintf(stdout,"Expect PDS to start at offset %ld\n", 
+(long)curr_ptr - (long)gh->entire_msg);
+
+/*
+*
+* A.7     FUNCTION gribgetpds  !decode the PDS
+*         RETURN error code if fails  !errmsg filled
+*         SAVE pointer to PDS block for printing later
+*/
+if( nReturn= gribgetpds(curr_ptr, &pds, errmsg)) {
+   fprintf(stdout,"%s:  %s;\n", func, errmsg);
+   goto BYE;
+  }
+fprintf(stdout,"got PDS\n");
+Tpds = &pds;
+
+/*
+*
+* A.8     PRINT warning if PDS length < 28 bytes
+*/
+if (pds.uslength < 28) 
+	fprintf(stdout,"*** PDS (%ld) < 28 bytes, MAY BE CORRUPTED ***\n",
+	pds.uslength);
+
+/*
+*
+* A.9     MOVE pointer to the end of PDS
+*/
+curr_ptr += pds.uslength;
+if ((long)curr_ptr > (long)gh->entire_msg + (gh->abs_size -1L)) {
+     fprintf(stdout,"PDS size is much too big, cannot step past it\n");
+     goto BYE;	
+   }	
+fprintf(stdout,"Expect next section to start at offset %ld\n", 
+(long)curr_ptr - (long)gh->entire_msg);
+
+/*
+*
+* A.10    IF (GDS is present)
+*/
+if ((gds_flag = pds.usGds_bms_id >> 7 & 1)) 
+  {
+/*
+* A.10.1      FUNCTION gribgetgds   !Exit on error
+*             SAVE pointer to GDS block for printing later
+*/
+   if ((nReturn=gribgetgds(curr_ptr, &gds, errmsg)) != 0) goto BYE;
+   fprintf(stdout,"got GDS\n");
+   Tgds = &gds;
+
+/*
+* A.10.2      SET ulGrid_size based on Projection type
+*/
+   switch(gds.head.usData_type)
+     {
+     case LATLON_PRJ:    	/* Lat/Lon Grid */
+     case GAUSS_PRJ:    	/* Gaussian Latitude/Longitude grid */
+     case ROT_LATLON_PRJ:   	/* Rotated Lat/Lon */
+     case ROT_GAUSS_PRJ:   	/* Rotated Gaussian */
+     case STR_LATLON_PRJ:   	/* Stretched Lat/Lon */
+     case STR_GAUSS_PRJ :   	/* Stretched Gaussian */
+     case STR_ROT_LATLON_PRJ :  /* Stretched and Rotated Lat/Lon */
+     case STR_ROT_GAUSS_PRJ :   /* Stretched and Rotated Gaussian */
+        bds_head.ulGrid_size = gds.llg.usNi * gds.llg.usNj; break;
+
+     case MERC_PRJ:  		/* Mercator Grid */
+        bds_head.ulGrid_size = gds.merc.cols * gds.merc.rows; break;
+
+     case LAMB_PRJ:  		/* Lambert Conformal */
+     case ALBERS_PRJ:  		/* Albers equal-area */
+     case OBLIQ_LAMB_PRJ: 	/* Oblique Lambert Conformal */
+        bds_head.ulGrid_size = gds.lam.iNx * gds.lam.iNy; break;
+
+     case POLAR_PRJ:  /* Polar Stereographic */
+        bds_head.ulGrid_size = gds.pol.usNx * gds.pol.usNy; break;
+
+     default: 
+        fprintf(stdout,"%s: unsupported usData_type=%d\n",
+	func, gds.head.usData_type);
+        sprintf(errmsg,"%s: unsupported usData_type=%d\n",
+        func, gds.head.usData_type);
+	nReturn= (1); goto BYE; 
+     }
+
+/*
+* A.10.3      PRINT warning if GDS length < 32 bytes
+*/
+   if (gds.head.uslength < 32) 
+	fprintf(stdout,"*** GDS (%d bytes) < 32 bytes, MAY BE CORRUPTED ***\n",
+	gds.head.uslength);
+
+/*
+* A.10.4      MOVE the cursor to the next section (either BMS/BDS)
+*/
+     curr_ptr += gds.head.uslength;
+     if ((long)curr_ptr > (long)gh->entire_msg + (gh->abs_size -1L)) {
+	fprintf(stdout,"GDS size is much too big, cannot step past it\n");
+	goto BYE;
+     }
+/*
+* A.10     ENDIF (GDS is present)
+*/
+  } /* gds present */
+ else fprintf(stdout,"Flag shows NO Grid Defn Sect included\n");
+
+
+fprintf(stdout,"Expect next section to start at offset %ld\n", 
+(long)curr_ptr - (long)gh->entire_msg);
+bms_flag = pds.usGds_bms_id >> 6 & 1;
+/*
+*
+* A.11     IF (bitmap Section is present)
+*/
+if(bms_flag)  /* bit map section present */
+  {
+/*
+* A.11.1      FUNCTION gribgetbms   !decode BMS
+*             RETURN error code if fails  !errmsg filled
+*             SAVE pointer to BMS block for printing later
+*/
+   if( nReturn=
+	gribgetbms(curr_ptr,&bms,gds_flag, bds_head.ulGrid_size,errmsg))
+   {
+     fprintf(stdout,"%s:  error=%d  in grib get BMS;\n",func,nReturn);
+     goto BYE;
+   }
+   fprintf(stdout,"got BMS\n");
+   Tbms = &bms;
+
+/*
+* A.11.2      PRINT warning if BMS length < 7 bytes
+*/
+   if (bms.uslength < 7) 
+	fprintf(stdout,"*** BMS (%d bytes) < 7 bytes, MAY BE CORRUPTED ***\n",
+	bms.uslength);
+
+/*
+* A.11.3      MOVE the cursor to beginning of Binary Data Section
+*/
+     curr_ptr += bms.uslength;
+     if ((long)curr_ptr > (long)gh->entire_msg + (gh->abs_size -1L)) {
+	fprintf(stdout,"BMS size is much too big, cannot step past it\n");
+	goto BYE;
+     }
+/*
+* A.11     ENDIF  !bms present
+*/
+  } /* Bms present */
+ else fprintf(stdout,"Flag shows NO Bit Map Section included\n");
+
+
+fprintf(stdout,"Expect BDS to start at offset %ld\n", 
+(long)curr_ptr - (long)gh->entire_msg);
+/*
+*
+* A.12    FUNCTION  gribgetbds()
+*         RETURN error code if failed  !errmsg filled
+*         SAVE pointer to BDS for printing later
+*/
+  if(nReturn=gribgetbds(curr_ptr, pds.sDec_sc_fctr, &bms, &gds, &grib_data,
+                &bds_head, errmsg))
+   { fprintf(stdout,"%s:  error=%d  in grib get BDS;\n",func,nReturn);
+     goto BYE;
+    }
+  fprintf(stdout,"got BDS\n");
+  Tbds= &bds_head;
+   
+/*
+* A.13    PRINT warning if BDS < 11 bytes
+*/
+   if (bds_head.length < 11) 
+	fprintf(stdout,"*** BDS (%d bytes) < 11 bytes, MAY BE CORRUPTED ***\n",
+	bds_head.length);
+
+/*
+* A.14    BUMP pointer to next section  !return on failure
+*/
+  curr_ptr += bds_head.length;
+     if ((long)curr_ptr > (long)gh->entire_msg + (gh->abs_size -1L)) {
+	fprintf(stdout,"BDS size is much too big, cannot step past it\n");
+	goto BYE;
+     }
+
+/*
+* A.15    CHECK for '7777' string 
+*         SET return code to 0 if found string 
+*/
+  fprintf(stdout,"Expect 7777 to start at offset %ld\n", 
+  (long)curr_ptr - (long)gh->entire_msg);
+  if (strncmp (curr_ptr, "7777", 4))
+	fprintf(stdout,"'7777' is NOT at expected location\n");
+  else  {
+	fprintf(stdout,"see '7777' at offset %ld\n",
+	(long)curr_ptr - (long)gh->entire_msg);
+  	nReturn = 0;
+	}
+
+
+BYE:
+/*
+*
+* A.16    FUNCTION prt_inp_struct !print as many sections as possible
+*/
+  fprintf(stdout,"\nNow will print all avail sections=\n");
+  prt_inp_struct (Tpds, Tgds, Tbms, Tbds, &grib_data);
+
+/*
+*
+* A.17    FREE data array
+*/
+ if (grib_data != NULL) free (grib_data);
+
+/*
+*
+* A.18    RETURN with exit status
+*/
+  fprintf(stdout,"Exiting %s\n", func); 
+  return (nReturn);
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/prt_inp_struct.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/prt_inp_struct.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/prt_inp_struct.c	(revision 2744)
@@ -0,0 +1,460 @@
+/* File:  prt_inp_struct.c		Alice Nakajima, SAIC, 10/96
+   Func to print content of all of the Internal structs
+Revisions:
+09/10/98 atn:  display whether or not GRIB extensions are used.
+10/22/98 atn:  +typecast for compiler;
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "grib_lookup.h"	/* for Parm/Ctr/Levl/Mdl_defn */
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/* 
+   Defines following Global var:
+   int UseTables;   flag set if using lookuptbl
+ 
+   Uses the external tables, defined in ld_enc_inputs.c:
+   PARM_DEFN  db_parm_tbl[256*MAX_PARM_TBLS]  holds Parameter lookup info;
+   LVL_DEFN   db_lvl_tbl[NLEVS]  holds Level lookup info;
+   MODEL_DEFN db_mdl_tbl[NMODEL] hold Model lookup info;
+   GEOM_DEFN  db_geom_tbl[NGEOM]   holds Geom lookup info;
+               
+*/
+int UseTables=0;       /* GLOBALVAR:   default is no lookup table used */
+
+extern PARM_DEFN  db_parm_tbl[];  	/* parameter conversion info */
+extern MODEL_DEFN db_mdl_tbl[]; 	/* model conversion info */
+extern LVL_DEFN   db_lvl_tbl[]; 	/* level conversion info */
+extern GEOM_DEFN  db_geom_tbl[];	/* Geom conversion info  */
+extern CTR_DEFN   db_ctr_tbl[];  	/* Ctr conversion info  */
+
+/*
+*
+************************************************************************
+* A. FUNCTION:  prt_inp_input
+*      to print content of the Internal Grib structures
+*
+*    INTERFACE:
+*      void  prt_inp_struct (pds, gds, bms_input, bds_head_input, ppfarr)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*      (I) PDS_INPUT *pds;                
+*          internal Product Defn Section struct to print
+*      (I) grid_desc_sec  *gds;  
+*          internal Grid Defn struct to print
+*      (I) BMS_INPUT *bms_input;          
+*          internal Bitmap Section  to print
+*      (I) struct BDS_HEAD_INPUT *bds_head_input; 
+*          internal 11-byte hdr of Binary Data Section to print
+*      (I) float **ppfarr;    
+*          unpacked & restored float data array to print
+*
+*    RETURN CODE: none
+************************************************************************
+*/
+#if PROTOTYPE_NEEDED
+void	prt_inp_struct (PDS_INPUT 	*pds,
+			grid_desc_sec   *gds,
+			BMS_INPUT 	*bms_input,
+			struct BDS_HEAD_INPUT *bds_head_input,
+			float 		**ppfarr)
+#else
+void	prt_inp_struct (pds, gds, bms_input, bds_head_input, ppfarr)
+	PDS_INPUT 	*pds;
+	grid_desc_sec   *gds;
+	BMS_INPUT 	*bms_input;
+	struct BDS_HEAD_INPUT *bds_head_input;
+	float 		**ppfarr;
+#endif
+{
+  char *func= "prt_inp_struct"; /* name of function */
+  float *farr;			/* ptr to float data aray */
+  double pwr10toD;		/* 10 to the Decimal Scl fctr */
+  int D;			/* Decimal Scl Fctr */
+  int indx,i;			/* index */
+
+   fprintf(stdout,"\n--- Entering %s ---\n", func);
+/*
+*
+* A.1       IF (PDS_INPUT struct is null) THEN
+*               PRINT message
+*           ELSE
+*               PRINT out all of its fields, values and type
+*           ENDIF
+*/
+   if (pds == NULL) fprintf(stdout,"**** PDS_INPUT is null****\n");
+   else
+   {             
+     fprintf(stdout,"***  PDS_INPUT ****\n");
+     p_ushort (pds->uslength);        
+     p_ushort (pds->usEd_num);       
+     p_ushort (pds->usParm_tbl);    
+     p_ushort (pds->usCenter_id);  
+     if (UseTables)
+        if ( db_ctr_tbl[pds->usCenter_id].ctr_dsc[0] )
+        fprintf(stdout,"\tCtr_dsc=%s\n", db_ctr_tbl[pds->usCenter_id].ctr_dsc);
+        else 
+	fprintf(stdout,
+	"\tOriginating Center ID %d not defined in current table.\n",
+	pds->usCenter_id);
+
+     p_ushort (pds->usProc_id);   
+     if (UseTables)
+     if ( db_mdl_tbl[pds->usProc_id].grib_dsc[0] )
+        fprintf(stdout,"\tModel Description = %s\n",
+	db_mdl_tbl[pds->usProc_id].grib_dsc);
+     	else
+        fprintf(stdout,"\tModel ID %d not defined in current table.\n",
+	pds->usProc_id);
+
+     p_ushort (pds->usGrid_id);  
+     if (UseTables) 
+     if ( db_geom_tbl[pds->usGrid_id].grib_dsc [0] )
+        fprintf(stdout,"\tGrid Description = %s\n",
+	db_geom_tbl[pds->usGrid_id].grib_dsc);
+     else
+        fprintf(stdout,"\tGrid ID %d not defined in current table.\n",
+	pds->usGrid_id);
+
+     p_ushort (pds->usGds_bms_id); 
+     p_ushort (pds->usParm_id);   
+
+     /*
+      * The sub-tables cannot have GribCode Zero since it's Reserved
+      * if the center doesn't use sub tables then they must set ParmSub to 0
+      * when ParmId is between 250 (Tbl-A) and 254 (Tbl-E);
+      */
+     if (pds->usParm_id>=250 && pds->usParm_id<=254 && pds->usParm_sub!=0)
+        {
+          indx = 256 * (pds->usParm_id - 249) + pds->usParm_sub;
+          p_ushort (pds->usParm_sub);
+	  fprintf(stdout,"  (pid=%d, psub=%d) is Sub-ParmTbl Indx = %d\n",
+	  pds->usParm_id, pds->usParm_sub, indx);
+        }
+      else  {
+	  indx = pds->usParm_id;
+	  fprintf(stdout,
+	  "  usParm_sub not used (%ld), default to ParmTbl Indx= %d\n",
+	  pds->usParm_sub, indx);
+	}
+
+     if(UseTables) {
+      if ( db_parm_tbl[indx].grib_dsc[0] ) {
+         fprintf(stdout,"\tParameter = %s\n",db_parm_tbl[indx].grib_dsc);
+         fprintf(stdout,"\tUnits = %s\n",db_parm_tbl[indx].grib_unit_dsc);
+      }else
+         fprintf(stdout,"\tParameter ID %d not defined in current table.\n",
+	 pds->usParm_id);
+      }
+
+     p_ushort (pds->usLevel_id); 
+     p_ushort (pds->usLevel_octets); 
+     p_ushort (pds->usHeight1);     
+     p_ushort (pds->usHeight2);    
+    if(UseTables) {
+       if ( db_lvl_tbl[pds->usLevel_id].grib_dsc[0] ) {
+          fprintf(stdout,"\tLevel description = %s\n", 
+   		db_lvl_tbl[pds->usLevel_id].grib_dsc);
+          switch(db_lvl_tbl[pds->usLevel_id].num_octets){
+            case 2: fprintf(stdout,"\t%s = %u\n",
+     	   	db_lvl_tbl[pds->usLevel_id].lvl_name_1, pds->usHeight1);
+              	break;
+            case 1: fprintf(stdout,"\t%s = %u\n\t%s = %u\n",
+     	   	db_lvl_tbl[pds->usLevel_id].lvl_name_1, pds->usHeight1,
+     	   	db_lvl_tbl[pds->usLevel_id].lvl_name_2, pds->usHeight2);
+              	break;
+            case 0: break;
+            default:
+              fprintf(stdout,"***Number of octets for table 3 undefined - possibly "
+              "corrupt dataset.***\n");
+          }
+       }
+     else fprintf(stdout,"Level ID %d not defined in current table.\n",
+   	pds->usLevel_id);
+    } /* end UseTables 'if' statement */
+
+     p_ushort (pds->usYear);      
+     p_ushort (pds->usMonth);    
+     p_ushort (pds->usDay);     
+     p_ushort (pds->usHour);   
+     p_ushort (pds->usMinute);
+     p_ushort (pds->usFcst_unit_id);   
+     p_ushort (pds->usP1);            
+     p_ushort (pds->usP2);           
+     p_ushort (pds->usTime_range);  
+     p_ushort (pds->usTime_range_avg);
+     p_ushort (pds->usTime_range_mis);
+     p_ushort (pds->usCentury); 
+     p_ushort (pds->usCenter_sub);   
+     p_short  (pds->sDec_sc_fctr);
+     /* p_ushort (pds->ausZero[0]);
+     p_ushort (pds->ausZero[1]);
+     p_ushort (pds->ausZero[2]);
+     p_ushort (pds->ausZero[3]);
+     p_ushort (pds->ausZero[4]);
+     p_ushort (pds->ausZero[5]);
+     p_ushort (pds->ausZero[6]);
+     p_ushort (pds->ausZero[7]);
+     p_ushort (pds->ausZero[8]);
+     p_ushort (pds->ausZero[9]);
+     p_ushort (pds->ausZero[10]);
+     p_ushort (pds->ausZero[11]); */
+
+     if (pds->usExt_flag == (unsigned short)EXTENSION_FLAG) {
+       fprintf(stdout,
+       " (uns. short) pds->usExt_flag  = %u (Extensions used)\n",
+       pds->usExt_flag);
+       p_ushort (pds->usSecond);
+       p_ushort (pds->usTrack_num);
+       p_ushort (pds->usParm_sub);	
+       p_ushort (pds->usSub_tbl); 
+      }
+     else fprintf(stdout,
+ 	" (uns. short) pds->usExt_flag  = %u (not used)\n" \
+ 	" (uns. short) pds->usSecond    = not avail\n" \
+ 	" (uns. short) pds->usTrack_num = not avail\n" \
+ 	" (uns. short) pds->usParm_sub  = not avail\n" \
+ 	" (uns. short) pds->usSub_tbl   = not avail\n", pds->usExt_flag );
+
+   }
+
+/*
+*
+* A.2       IF (GDS struct is null) THEN
+*               PRINT message
+*           ELSE
+*               TEST the Projection type, skip if not a supported one;
+*               PRINT out all of its fields, values and type
+*               SWITCH (type of projection)
+*                 > LatLon (0), Gaussian (4), 
+*                 > Rotated LatLon (10), Rotated Gaussian (14), 
+*                 > Stretched LatLon (20), Stretched Gaussian (24), 
+*                 > Stretched Rotated Latlon(30), Stretched Rotated Gauss(34):
+*                      CAST the projection block to type GDS_LATLON_INPUT
+*                      and print its fields, value and type;
+*                 > Lambert (3), Albers (8), Oblique Lambert Conf (13):
+*                      CAST the projection block to type GDS_LAM_INPUT
+*                      and print its fields, value and type;
+*                 > Polar (5):  
+*                      CAST the projection block to type GDS_PS_INPUT
+*                      and print its fields, value and type;
+*                 default: PRINT error  !unsupported projection
+*               ENDSWITCH
+*           ENDIF
+*/
+  if (gds == NULL) {
+	fprintf(stdout,"\n*** GDS is null ***\n");
+	goto CHECK_BMS;
+	}
+
+  fprintf(stdout,"\n*** GDS_HEAD_INPUT ***\n"); 
+  fprintf(stdout,"sizeof(GDS_GRIB + projblk)= ");
+  p_ushort (gds->head.uslength);
+  p_ushort (gds->head.usNum_v);
+  p_ushort (gds->head.usPl_Pv);
+
+  /* test to see if the Data type is out of bound, or if it's
+ 	currently not supported;  if so, print msg got print next section.
+  */
+  if (gds->head.usData_type >= (unsigned short) PRJ_COUNT  ||
+     strstr((char*)prjn_name[gds->head.usData_type],(char*)"Unsupported Grid")) 
+    {
+	fprintf(stdout,
+	"Warning:  Projection #%d is not supported, skip this section\n",
+	gds->head.usData_type);
+	goto CHECK_BMS;
+    }
+     
+  p_string (prjn_name[gds->head.usData_type]);
+  switch (gds->head.usData_type) 
+       	 {
+           case LATLON_PRJ:
+           case GAUSS_PRJ:
+           case ROT_LATLON_PRJ:
+           case ROT_GAUSS_PRJ:
+           case STR_LATLON_PRJ:
+           case STR_GAUSS_PRJ :
+           case STR_ROT_LATLON_PRJ :
+           case STR_ROT_GAUSS_PRJ :
+		   p_int (gds->llg.usNi);      
+		   p_int (gds->llg.usNj);     
+		   p_long (gds->llg.lLat1);   
+		   p_long (gds->llg.lLon1);  
+		   p_ushort (gds->llg.usRes_flag);
+		   p_long (gds->llg.lLat2);    
+		   p_long (gds->llg.lLon2);   
+		   p_int (gds->llg.iDi);    
+		   p_int (gds->llg.iDj);   
+		   p_ushort (gds->llg.usScan_mode);
+
+		   if (gds->head.usData_type == LATLON_PRJ ||
+		       gds->head.usData_type == GAUSS_PRJ) 
+		   break;
+
+		   /* 	02/98
+		   remaining code is for the Stretch/Rotate parameters 
+		   */
+		   p_long (gds->llg.lLat_southpole);
+		   p_long (gds->llg.lLon_southpole);
+		   fprintf(stdout,"gds->llg.lRotate (%ld) tofloat= %.3f\n",
+		   gds->llg.lRotate , 
+		   grib_ibm_local((unsigned long)gds->llg.lRotate));
+		   p_long (gds->llg.lPole_lat);    
+		   p_long (gds->llg.lPole_lon);   
+		   fprintf(stdout,"gds->llg.lStretch (%ld) tofloat= %.3f\n"
+		   ,gds->llg.lStretch, 
+		   grib_ibm_local((unsigned long)gds->llg.lStretch));
+		break;
+
+	   case MERC_PRJ:
+		   p_int (gds->merc.cols); 
+		   p_int (gds->merc.rows);
+		   p_long (gds->merc.first_lat); 
+		   p_long (gds->merc.first_lon);
+		   p_ushort (gds->merc.usRes_flag);          
+		   p_long (gds->merc.La2); 
+		   p_long (gds->merc.Lo2);
+		   p_long (gds->merc.latin);
+		   p_ushort (gds->merc.usScan_mode);          
+		   p_float (gds->merc.lon_inc); 
+		   p_float (gds->merc.lat_inc);
+		break;
+
+           case LAMB_PRJ:  
+           case ALBERS_PRJ:  
+           case OBLIQ_LAMB_PRJ:  
+		   p_int (gds->lam.iNx);                 
+		   p_int (gds->lam.iNy);                 
+		   p_long (gds->lam.lLat1);               
+		   p_long (gds->lam.lLon1);               
+		   p_ushort (gds->lam.usRes_flag);          
+		   p_long (gds->lam.lLon_orient);         
+		   p_ulong (gds->lam.ulDx);                
+		   p_ulong (gds->lam.ulDy);                
+		   p_ushort (gds->lam.usProj_flag);         
+		   p_ushort (gds->lam.usScan_mode);         
+		   p_long (gds->lam.lLat_cut1);          
+		   p_long (gds->lam.lLat_cut2);           
+
+		   if (gds->head.usData_type == LAMB_PRJ) break;
+		   p_long (gds->lam.lLat_southpole);      
+		   p_long (gds->lam.lLon_southpole);      
+		 break;
+
+           case POLAR_PRJ:  
+		   p_ushort (gds->pol.usNx);                
+		   p_ushort (gds->pol.usNy);                
+		   p_long (gds->pol.lLat1);               
+		   p_long (gds->pol.lLon1);               
+		   p_ushort (gds->pol.usRes_flag);          
+		   p_long (gds->pol.lLon_orient);         
+		   p_ulong (gds->pol.ulDx);                
+		   p_ulong (gds->pol.ulDy);                
+		   p_ushort (gds->pol.usProj_flag);         
+		   p_ushort (gds->pol.usScan_mode);         
+		 break;
+		
+	   default:  fprintf(stdout,
+		"Warning:  print code not available for Projection %d\n",
+		gds->head.usData_type);
+
+          } /* SWitch */
+
+
+CHECK_BMS:
+/*
+*
+* A.3       IF (BMS_INPUT struct is null) THEN
+*               PRINT message
+*           ELSE
+*               PRINT out all of its fields, values and type
+*           ENDIF
+*/
+   
+  if (bms_input==NULL || bms_input->uslength <= 0) 
+      fprintf(stdout,"\n*** BMS_INPUT is Null (no bms)  ***\n"); 
+  else {
+      fprintf(stdout,"\n*** BMS_INPUT  ***\n"); 
+      p_ushort (bms_input->uslength);
+      p_ushort (bms_input->usUnused_bits);
+      p_ushort (bms_input->usBMS_id);
+      p_ulong (bms_input->ulbits_set);
+      fprintf(stdout,"(not going to print CHAR *bit_map)\n");
+    } 
+
+/*
+*
+* A.4       IF (BDS_INPUT struct is null) THEN
+*               PRINT message
+*           ELSE
+*               PRINT out all of its fields, values and type
+*           ENDIF
+*/
+  if (bds_head_input == NULL) 
+	fprintf(stdout,"\n*** BDS_HEAD_INPUT is null ***\n");
+  else {
+    fprintf(stdout,"\n*** BDS_HEAD_INPUT ***\n");
+    p_ulong (bds_head_input->length);
+    p_ushort (bds_head_input->usBDS_flag);
+    p_int (bds_head_input->Bin_sc_fctr);
+    p_float (bds_head_input->fReference); 
+    p_ushort (bds_head_input->usBit_pack_num);
+    p_ulong (bds_head_input->ulGrid_size);  
+    p_float (bds_head_input->fPack_null);  
+  }
+
+/*
+*
+* A.5       IF (Float array is null) THEN
+*               PRINT message
+*           ELSE
+*               PRINT out up to 100 of its values (after taking out
+*               the Decimal Scale Factor)
+*           ENDIF
+*/
+  if (ppfarr == 0) fprintf(stdout,"\n*** FLOAT array is null ***\n");
+  else {
+     farr= *ppfarr;
+     fprintf(stdout,
+	"\n*** FLOAT ARRAY has %ld elements (print upto first 100) ***\n",
+	bds_head_input->ulGrid_size);
+
+     if (pds != NULL) {
+	D= pds->sDec_sc_fctr;
+	pwr10toD=  pow ( 10., (double) D );
+        fprintf(stdout,"Dec_sc_fctr=%d\n", D );
+	}
+    else { 
+	D= 0; pwr10toD = 1.; 
+	fprintf(stdout,"No PDS avail, assume Dec Scl Fctr to be 0\n");
+	}
+	
+     /* Data was scaled up in Pack_Spatial in order to get the INT values
+	to pack, so now need to change it back to its true value by
+ 	taking out the Decimal Scale Factor 
+     */
+     if (D >= 0)
+        for (i=0; i<bds_head_input->ulGrid_size && i < 100; i=i+5)
+        fprintf(stdout,"%3d-  %.*f  %.*f  %.*f  %.*f  %.*f\n", 
+	i+1, 
+	D, farr[i], D, farr[i+1], D, farr[i+2], D, farr[i+3], D, farr[i+4] );
+     else 
+        for (i=0; i<bds_head_input->ulGrid_size && i < 100; i=i+5)
+        fprintf(stdout,"%3d-  %.0f  %.0f  %.0f  %.0f  %.0f\n", 
+	i+1, farr[i], farr[i+1], farr[i+2], farr[i+3], farr[i+4] );
+   }
+/*
+*
+* A.6       RETURN w/nothing
+*
+*/
+  fprintf(stdout,"--- Leaving %s ---\n\n", func);
+
+/*
+*
+* END OF FUNCTION
+*
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/set_bytes.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/set_bytes.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/set_bytes.c	(revision 2744)
@@ -0,0 +1,29 @@
+#include <stdio.h>
+#include "isdb.h"
+
+void set_bytes(long in, int numbytes, char *out)
+{
+  int i;
+  long tmp;
+
+  tmp = abs(in);
+
+  for (i=0; i < numbytes; i++)
+    {
+      out[numbytes-1-i] = (tmp << (sizeof(long) - (i+1))*BYTE_BIT_CNT) 
+				 >> (sizeof(long) - 1)*BYTE_BIT_CNT;
+    }
+  if ( in < 0 ) out[0] |= 0x0080;
+}
+
+
+void set_bytes_u(unsigned long in, int numbytes, unsigned char *out)
+{
+  int i;
+
+  for (i=0; i < numbytes; i++)
+    {
+      out[numbytes-1-i] = (in << (sizeof(unsigned long) - (i+1))*BYTE_BIT_CNT) 
+				 >> (sizeof(unsigned long) - 1)*BYTE_BIT_CNT;
+    }
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/swap.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/swap.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/swap.c	(revision 2744)
@@ -0,0 +1,24 @@
+#include <stdio.h>
+#include <stdlib.h>
+void *swap_byte4(long *theInt)
+{
+  char tmp[4];
+  int i;
+
+  for (i=0; i<sizeof(long); i++)  
+    tmp[i] = *((char*)theInt+(sizeof(long)-1-i));
+
+  *theInt=*((long *)tmp);
+
+}
+
+void *swap_byte2(short *theInt)
+{
+  char tmp[4];
+  int i;
+
+  for (i=0; i<sizeof(short); i++)  
+    tmp[i] = *((char*)theInt+(sizeof(short)-1-i));
+
+  *theInt=*((short *)tmp);
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/test_set_bytes.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/test_set_bytes.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/test_set_bytes.c	(revision 2744)
@@ -0,0 +1,18 @@
+#include <stdio.h>
+
+main()
+{
+  int i;
+  long longint = -10342;
+  char charstring[sizeof(long)];
+  char charstring_orig[sizeof(long)];
+
+  memcpy(charstring_orig,(void *)&longint,8);
+  set_bytes(longint,3,charstring);
+  for (i=0; i < sizeof(long); i++) 
+    {
+      fprintf(stderr,"new:  %d: %d\n",i,charstring[i]);
+      /*      fprintf(stderr,"orig: %d: %d\n",i,charstring_orig[i]); */
+    }
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/upd_child_errmsg.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/upd_child_errmsg.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/MEL_grib1/upd_child_errmsg.c	(revision 2744)
@@ -0,0 +1,56 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "dprints.h"		/* for dprints */
+#include "gribfuncs.h"		/* prototypes */
+
+/*
+*********************************************************************
+* A. FUNCTION:  upd_child_errmsg
+*       Tacks the given function name in front of the error message array
+*       to show which level of the Nested Function calls the error 
+*       occured at;
+*
+*    INTERFACE:
+*       void    upd_child_errmsg (parent, errmsg)
+*
+*    ARGUMENTS (I=input, O=output, I&O=input and output):
+*       (I)   char *parent;    name of caller function
+*       (I&O) char *errmsg;    already contain error message upon entry;
+*                              will get name of parent tacked in front of 
+*                              existing array content;
+*    RETURN:   none;
+*********************************************************************
+*/
+#if PROTOTYPE_NEEDED
+void	upd_child_errmsg (char *parent, char *errmsg)
+#else
+void	upd_child_errmsg (parent, errmsg)
+char *parent; 
+char *errmsg;
+#endif
+{
+char temp[500], *func="upd_child_errmsg";
+
+    DPRINT1 ("Entering %s\n", func);
+    DPRINT2 ("Tacking '%s' in front of '%s'\n", parent, errmsg);
+/*
+*
+* A.1       IF (the error message is null) THEN
+*               RETURN error msg "FuncName:  no Error msg avail!"
+*           ELSE
+*               RETURN error msg "FuncName: " + errmsg
+*           ENDIF
+*/
+    if (errmsg[0]=='\0') 
+	 sprintf (errmsg, "%s:  no Error msg avail!\n", parent); 
+    else {
+	 sprintf (temp, "%s: %s", parent, errmsg);
+         strncpy (errmsg, temp, 500);
+	}
+
+    DPRINT1 ("ErrMsg is now-> %s\n", errmsg);
+    DPRINT1 ("Leaving %s\n", func);
+/*
+*  END OF FUNCTION
+*/
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/Makefile	(revision 2744)
@@ -0,0 +1,93 @@
+#------------------------------------------------------------------------------
+#  Makefile for producing libdbclient.so 
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+
+.SUFFIXES:      .c .o
+
+#
+# Specity location for Makefiles that are included.
+#
+INCLUDEDIRS = -I. -I./MEL_grib1 -Igrib1_util -I../io_grib_share
+BUILD_DIR = $(IO_GRIB_SHARE_DIR)../io_grib_share/build
+#
+# Specify directory that output library is to be put in.
+#
+LIB_DEST = .
+#
+#  SPECIFY local include directories used during compilation of source code. 
+#
+#    CXX_INCLUDES is for C++ files
+#    C_INCLUDES is for C files
+#
+C_INCLUDES   = $(INCLUDEDIRS)
+CXX_INCLUDES = $(INCLUDEDIRS)
+F_INCLUDES   = $(INCLUDEDIRS)
+ARFLAGS      = cruv
+
+FORMAT = $(FREE)
+
+#
+#  SPECIFY any subdirectories containing libraries that may be dynamically
+#          linked by this library.
+#
+SUB_DIRS =
+
+#
+#  SPECIFY information for building a library:
+#
+#    LIB_NAME - Fragment of name of the library to build
+#               e.g. if library file name is libfoo.so, set LIB_NAME = foo 
+#    DEP_LIBS - The tokens required to link a shared library against other
+#               shared libraries upon which it depends.  DEP_LIBS should
+#               contain -L<dir> tokens to specify where the dependent 
+#               libraries are, and -l<lib> tokens to specify libraries to link.
+#    OBJS     - List of object files that go into the library.
+#
+#  NOTES:
+#  1. Be careful about whitespace after the last character in the LIB_NAME.
+#     These spaces will generate an error when the library is made.
+#
+LIB_NAME = io_grib1
+SYS_DEFINES =
+DEP_LIBS = 
+OBJS =  \
+	grib1_routines.o \
+	gribmap.o \
+	io_grib1.o \
+	trim.o
+
+#
+#  List of subdirectories to which to pass make commands.
+#
+LIB_DIRS = \
+	MEL_grib1 \
+	grib1_util \
+	WGRIB
+EXE_DIRS =
+SUB_DIRS = $(LIB_DIRS) $(EXE_DIRS)
+
+#
+#  Clean up old build files
+#
+superclean:
+	/bin/rm -f *.o > /dev/null 2>&1
+	/bin/rm -f *.f90 > /dev/null 2>&1
+	/bin/rm -f *.mod > /dev/null 2>&1
+	/bin/rm -f *.a > /dev/null 2>&1
+	/bin/rm -f wgrid > /dev/null 2>&1
+	( cd grib1_util ; make clean )
+	( cd MEL_grib1 ; make clean )
+	( cd WGRIB ; make clean )
+
+#
+#  Include the boilerplate rules for building library modules.
+#
+include $(BUILD_DIR)/library_rules.mk
+
+#
+#  Compile dependencies.  These are appended to this file by make depend. 
+#
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/README.io_grib1
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/README.io_grib1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/README.io_grib1	(revision 2744)
@@ -0,0 +1,159 @@
+io_grib1
+
+Author: Todd Hutchinson
+        WSI
+        thutchinson@wsi.com
+
+5 August 2004
+8 February 2005 - Updated by Todd Hutchinson.  Section V was updated to 
+                  clarify the description of the decimal scale factor field 
+                  in the gribmap file.
+12 July 2005    - Updated by Todd Hutchinson.  GRIB version 1 input capability 
+                  was added to WRF. All sections in this README were updated to
+                  add information relevant for grib input capability.
+
+
+I. Introduction
+
+io_grib1 is a WRF module that allows for input and output of WRF data in GRIB 
+   version 1 format.
+
+Why would anyone use GRIB output?  
+  GRIB stores data in a compressed format so output files are much smaller 
+    than in other formats such as netCDF.  In addition, encoding in GRIB format
+    is very efficient and can be faster than writing out netCDF formatted 
+    data, especially for large grids.  (See Section V for more on performance).
+
+II. Running WRF
+  1. Set namelist entry or entries io_form_<x> to 5
+  2. Run WRF as you normally would, for example:
+     cd test/em_real
+     ./wrf.exe
+
+IV. Examining GRIB output with wgrib
+  1. wgrib is installed within external/io_grib1 
+     (See http://wesley.wwb.noaa.gov/wgrib.html for more information.)
+  2. Define the GRIBTAB environment variable:
+        For bourne shell users:
+          export GRIBTAB=<your WRF dir>/run/gribmap.txt
+        For csh users
+          setenv GRIBTAB <your WRF dir>/run/gribmap.txt
+  3. To get a listing of the records in the GRIB data:
+        <your WRF dir>/external/io_grib1/wgrib wrfout_d01_000000
+
+IV. Quilting
+  If you are running WRF using MPI, you may use a seperate processor for
+    quilting just as is done with netCDF.  Simply set the namelist variable
+    nio_tasks_per_group to 1 (or more).
+
+V. Details
+  1. gribmap.txt file
+     io_grib1 makes use of a GRIB table for encoding the WRF data into GRIB 
+        format.  The GRIB table that io_grib1 uses is contained in the 
+        WRF run directory, and is called gribmap.txt.  This file is read at
+        run-time by io_grib1.  Settings in this file are used to encode the 
+	corresponding parameters in the GRIB output files.  You may modify 
+	this file to suit your needs.
+
+      The file has the following format:
+
+      the first line of a table (note: there may be several tables in a 
+                                 gribmap.txt file)
+      -1:CENTER:SUBCENTER:PARAMETER_TABLE_VERSION
+          "-1" is an indicator for the start of a table
+          "CENTER" is generating center (PDS 5, i.e., for NCEP, this is 7)
+          "SUBCENTER" is the generating sub-center (PDS 26)
+          "PARAMETER_TABLE_VERSION" is the parameter table version (PDS 4)
+
+      Subsequent lines:
+      GRIBID:<PARAMETER>:<DESCRIPTION>:<WRF VAR>:<DECSCL>
+          "GRIBID" is the GRIB parameter id (PDS 9).
+          "PARAMETER" is the abbreviated parameter name.   
+          "DESCRIPTION" is a description of the parameter.
+          "WRF VAR" is a comma-seperated list of WRF variables that will be
+                    encoded as with PARAMETER described in the line and with 
+                    the CENTER, SUBCENTER and PARAMETER_TABLE_VERSION listed 
+                    at the beginning of the table.  WRF VAR must use 
+                    the WRF variable names that are defined in the "DNAME" 
+                    column in the WRF Registry.
+          "DECSCL" is the decimal scale factor.  It is the number of digits
+                    to the right of the decimal point that will be saved in
+                    the output data.  This number may be less than zero, in 
+                    which case, the precision of data will be truncated the 
+                    specified number of digits to the left of the decimal 
+                    point. 
+                       Examples:
+                         -2 : Data will be encoded at the hundreds level, 
+	                      i.e., 102425.231 will be encoded as 102400
+                          3 : Data will be encoded at the thousandths level, 
+			      i.e., 102425.231243 will be encoded as 1024.231
+      Example:
+           1:PRES:Pressure [Pa]:P,PSFC:1
+             In this example, GRIB parameter 1, abbreviated PRES, is 
+                pressure in pascals.  WRF variables P and PSFC (as listed in
+                the WRF Registry) will be encoded as PRES.  The data will have
+                one decimals of precision, i.e., 101323.1 Pa.
+           62:NCPCP:Large scale precipitation [kg/m^2]:NCPCP:2
+             In this example, GRIB parameter 62, abbreviated NCPCP, is 
+                Large-scale precipitation.  The WRF variables NCPCP (as listed 
+                in the WRF Registry) will be encoded as NCPCP.  The data will 
+                have two decimals of precision, i.e., 1.23 kg/m^2 (i.e., 
+                1.23 mm).
+
+      Note:
+          For GRIB encoding, parameters 1-127 are the standard parameters
+            described by the WMO GRIB convention.  Interpretation of parameters
+            128-254 vary depending on the setting of the CENTER, SUBCENTER, 
+            and PARAMETER_TABLE_VERSION.  In the default gribmap.txt file,
+            the CENTER and SUBCENTER are both set to be 255.  Five tables
+            with PARAMETER_TABLE_VERSION's varying between 2 and 6 are 
+            specified in the default gribmap.txt file.
+
+  2. Variable dimensions.
+      A GRIB file is a set of records of data.  Each record is a 2-dimensional,
+        horizontal field, i.e., temperature on a pressure surface,
+        In the case of the WRF Eulerian mass model, we have variables on Eta 
+        coordinates, so, we have, i.e., temperature on the 0.995 Eta level.
+      WRF outputs 3, 2 and 1-dimensional fields and point data.  3-dimensional 
+        (i.e., u-component of wind) fields are stored in GRIB as a series of 
+        horizontal 2-dimensional fields.  WRF horizontal 2-d fields are stored 
+        simply as horizontal 2-d fields (i.e., surface pressure).  
+        One-dimensional fields with dimension varying in the vertical (i.e., 
+        the vertical coordinate ZN), are stored as a set of 1x1 grids valid
+        at the center of the grid.  So, the third vertical level (ZN) is 
+        encoded as a 1x1 grid, valid at the center of the grid.  Point data
+        is also stored as a 1x1 grid valid at the center of the grid.
+      
+VI. Performance
+   GRIB output has proven to be very fast, as compared to netcdf output.
+
+   Listed below is a comparison of file size and run-time for io_grib1 and
+   io_netcdf.  WRF was run twice, once with GRIB output and once with netcdf
+   output.  In both cases, 32 CPUS (on 16 machines) were dedicated to 
+   model integration, and one was CPU dedicated to I/O and quilting (using 
+   nio_tasks_per_group = 1).  The run had a domain with 360x485 grid points 
+  (12 km spacing) and 10-minute output.  The model was run out to 3 hours.
+
+   Shown is the file size for one-output time, the total model run-time 
+   and the time for I/O as listed in the WRF output.  In addition, the 
+   additional time that is required for a time-step just after model output
+   is listed.
+
+   Format    File Size    Run time     I/O time   additional time after output
+   netCDF     368 MB       719 s         1.26 s            3.3 s
+   GRIB v1    109 MB       519 s         0.28 s            1.9 s
+
+
+VII. Testing
+   We (at WSI) have tested io_grib1 with WRF running on linux (redhat v 9.0).  
+   We typically use the intel fortran compiler (v8.0) and the gnu C compiler, 
+   so, that configuration has the most testing.  We have also done limited
+   testing with the Portland Group Compiler on linux.  We have not tested any
+   other platforms or compilers.
+
+io_grib1
+
+Author: Todd Hutchinson
+        WSI
+        thutchinson@wsi.com
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/BDSunpk.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/BDSunpk.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/BDSunpk.c	(revision 2744)
@@ -0,0 +1,133 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <limits.h>
+#include "grib.h"
+#include "pds4.h"
+#include "bms.h"
+#include "bds.h"
+
+/* 1996				wesley ebisuzaki
+ *
+ * Unpack BDS section
+ *
+ * input: *bits, pointer to packed integer data
+ *        *bitmap, pointer to bitmap (undefined data), NULL if none
+ *        n_bits, number of bits per packed integer
+ *        n, number of data points (includes undefined data)
+ *        ref, scale: flt[] = ref + scale*packed_int
+ * output: *flt, pointer to output array
+ *        undefined values filled with UNDEFINED
+ *
+ * note: code assumes an integer > 32 bits
+ *
+ * 7/98 v1.2.1 fix bug for bitmaps and nbit >= 25 found by Larry Brasfield
+ * 2/01 v1.2.2 changed jj from long int to double
+ * 3/02 v1.2.3 added unpacking extensions for spectral data 
+ *             Luis Kornblueh, MPIfM 
+ */
+
+static unsigned int mask[] = {0,1,3,7,15,31,63,127,255};
+static unsigned int map_masks[8] = {128, 64, 32, 16, 8, 4, 2, 1};
+static double shift[9] = {1.0, 2.0, 4.0, 8.0, 16.0, 32.0, 64.0, 128.0, 256.0};
+
+void BDS_unpack(float *flt, unsigned char *bds, unsigned char *bitmap,
+	int n_bits, int n, double ref, double scale) {
+
+    unsigned char *bits;
+
+    int i, mask_idx, t_bits, c_bits, j_bits;
+    unsigned int j, map_mask, tbits, jmask, bbits;
+    double jj;
+
+    if (BDS_Harmonic(bds)) {
+        bits = bds + 15;
+        /* fill in global mean */
+        *flt++ = BDS_Harmonic_RefValue(bds);
+        n -= 1; 
+    }
+    else {
+        bits = bds + 11;  
+    }
+
+    tbits = bbits = 0;
+
+    /* assume integer has 32+ bits */
+    if (n_bits <= 25) {
+        jmask = (1 << n_bits) - 1;
+        t_bits = 0;
+
+        if (bitmap) {
+	    for (i = 0; i < n; i++) {
+		/* check bitmap */
+		mask_idx = i & 7;
+		if (mask_idx == 0) bbits = *bitmap++;
+	        if ((bbits & map_masks[mask_idx]) == 0) {
+		    *flt++ = UNDEFINED;
+		    continue;
+	        }
+
+	        while (t_bits < n_bits) {
+	            tbits = (tbits * 256) + *bits++;
+	            t_bits += 8;
+	        }
+	        t_bits -= n_bits;
+	        j = (tbits >> t_bits) & jmask;
+	        *flt++ = ref + scale*j;
+            }
+        }
+        else {
+	    for (i = 0; i < n; i++) {
+                while (t_bits < n_bits) {
+                    tbits = (tbits * 256) + *bits++;
+                    t_bits += 8;
+                }
+                t_bits -= n_bits;
+                flt[i] = (tbits >> t_bits) & jmask;
+            }
+	    /* at least this vectorizes :) */
+	    for (i = 0; i < n; i++) {
+		flt[i] = ref + scale*flt[i];
+	    }
+        }
+    }
+    else {
+	/* older unoptimized code, not often used */
+        c_bits = 8;
+        map_mask = 128;
+        while (n-- > 0) {
+	    if (bitmap) {
+	        j = (*bitmap & map_mask);
+	        if ((map_mask >>= 1) == 0) {
+		    map_mask = 128;
+		    bitmap++;
+	        }
+	        if (j == 0) {
+		    *flt++ = UNDEFINED;
+		    continue;
+	        }
+	    }
+
+	    jj = 0.0;
+	    j_bits = n_bits;
+	    while (c_bits <= j_bits) {
+	        if (c_bits == 8) {
+		    jj = jj * 256.0  + (double) (*bits++);
+		    j_bits -= 8;
+	        }
+	        else {
+		    jj = (jj * shift[c_bits]) + (double) (*bits & mask[c_bits]);
+		    bits++;
+		    j_bits -= c_bits;
+		    c_bits = 8;
+	        }
+	    }
+	    if (j_bits) {
+	        c_bits -= j_bits;
+	        jj = (jj * shift[j_bits]) + (double) ((*bits >> c_bits) & mask[j_bits]);
+	    }
+	    *flt++ = ref + scale*jj;
+        }
+    }
+    return;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/Changes
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/Changes	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/Changes	(revision 2744)
@@ -0,0 +1,167 @@
+v1.8.0.9i: 12/04 fixed typo introduced 11/04 (table 129, entry 192)
+v1.8.0.9h: 11/04 updated table ncep-129 (strange entry)
+v1.8.0.9g: 9/04 fix if (gds && GDS_Harmonic_type(gds) == 1)
+           found by Graziano Giuliani 
+v1.8.0.9f: 8/04 added ecmwf table 151
+v1.8.0.9e: 8/04 changes of CFS time ranges
+v1.8.0.9d: 7/04 fixed reanal grib table NLON -> ELON
+v1.8.0.9c: 6/04 chaged UVI defn ncep opn table
+v1.8.0.9b: 6/04 added table 132 (global reanalysis)
+v1.8.0.9a: 6/04 updated table 129,130
+v1.8.0.9: 5/04 added new time codes 132-135, changed time code 51 (clim)
+v1.8.0.8: 4/04 added -ncep_ens option
+v1.8.0.7e: 3/04 multiple user tables (fix open)
+v1.8.0.7d: 3/04 extern minute -> extern int minute
+v1.8.0.7c: 3/04 for clim (51) don't print 'anl'
+v1.8.0.7b: 2/04 update NCEP grib table 129
+v1.8.0.7a: 11/03 update NCEP grib table 131
+v1.8.0.7: 10/03 Mods fron Norwegian Meteorological Institute
+                fixed ec table 131, and enhansed ex_ext.c
+v1.8.0.6: 9/03 added time codes 128-131 (for RR)
+v1.8.0.5: 9/03 fix scan mode and change format
+v1.8.0.4: 9/03 new dwd tables and -dwdgrib option (thanks to Helmut P. Frank)
+               updated formats_update.txt for -dwdgrib option
+v1.8.0.3k: 7/03 fixed N/S vs grid wind diagnostic with -v option
+                  found by Dusan Jovic
+v1.8.0.3j: 6/03 fixed level 206 (was 205)
+v1.8.0.3i: 5/03 updated ncep table 131 
+v1.8.0.3h: 5/03 updated ncep table 131
+v1.8.0.3g: 4/03 ecmwf table 128, 140 (names from ECMWF web site), updated 131
+v1.8.0.3f: 4/03 updated ncep131, ncep130, ncep-opn
+v1.8.0.3e: 3/03 fix level 141, update tables 130 and 131
+v1.8.0.3d: 2/03 added prelim ncep grib tables 130 and 131
+v1.8.0.3c: 1/03 Reanalysis Project updates: scan mode in english, 
+    grid vs NS winds, and dusan.jovic@noaa.gov: ss2dEGRID support
+v1.8.0.3b: 1/03 minor update: changed units of CICE in NCEP tables
+v1.8.0.3a: 11/02 update ncep_opn and add ncep_129 table
+v1.8.0.3: 10/02 update levels and ncep_opn grib table
+v1.8.0.2: 10/02 check gds before grib_check, redid level 117
+v1.8.0.1: 10/02 added cptec gribtable 254
+v1.8: 4/1/02: Decode of simple packed spectral data and some cleanup of the
+     triangular grid (Luis Kornblueh, Max-Plank Institute of Meteorology)
+v1.7.4.1a 12/01: added new entry to OMB grib table (REV)
+v1.7.4.1 12/01: D. Haalman (METEO SERVICE weather research GmbH) 
+               rewrote seekgrib.c
+v1.7.4   10/01: Merged changes made by  Helmut P. Frank (DWD) to current 
+                source code.  This adds DWD tables 1, 201, 202, and 203 
+                as well as support for triangular grids based on an icosahedron
+1.7.3.6: 5/01: added fractional mb, center to levels.c
+1.7.3.5: 2/01: Handle grib files with precision greater than 31 bits
+1.7.3.4a: 9/00: check for missing grib file
+1.7.3.4: 8/00: polar stereo + lambert, always print direction increments
+1.7.3.2: 6/00: undefined direction increments set to zero on -V output
+1.7.3.1: 8/99: added new levels
+1.7.3:   5/99: updated NCEP opn grib table
+1.7.2:   5/99: fixed fictious error message with thinned grids and bitmaps
+1.7.1:   2/99: fixed error in wrtieee_header affects only -H option
+1.7.0b7: 1/99: preliminary support for NCEP ensembles
+1.7.0b6: 1/99: changed "x12 hours" format to "hr" format
+1.7.0b5: 1/99: fixed 3/6/12 hour forecast time units
+1.7.0b4 11/98: updated (128,160) and new (129,130,131,140,150,170,180)
+        ECMWF tables
+1.7.0b3 10/98: added new time units
+1.7.0b2 8/98: allow blank gribtab lines in definition, --v
+1.7.0b 8/98: added "km" to Mercator meta-data
+1.7: 7/98: fixed bitmap when nbits > 24 (theoretical bug)
+1.6.2.5 5/98: fixed -H code so that all of GDS is written
+1.6.2.4 4/98 beta: reanalysis ID code: needed for users of 1997 Reanalysis data
+1.6.2.2 2/98 beta: rotated lat long grid (10)
+1.6.2   1/98 added Arakawa E-grid meta-data
+1.6.1b  changed 03TOT to O3TOT in ncep operational table
+           note: typo originated in the original NCEP documentation
+1.6.1a  12/97 made ncep_opn the default table
+1.6.1   9/97 Added the "-d all" option
+1.6.0   9/97 non-beta version, added operational NCEP table,
+        optimized the ieee writes (2.5x faster on Cray, 20% on linux),
+        new help screen
+1.5.0b14 fix century mark: year=100 not 0
+1.5.0b13 -4yr, use 4 digit year code
+1.5.0b12 lat-long thinned grid support
+1.5.0b11 Added -H option (PDS/GDS output to binary files)
+1.5.0b10 Changed"0hr fcst" to "anl" for TR=10 and fcstlen = 0 (non-beta release)
+1.5.0b9 Thinned grids support (preliminary)
+1.5.0b8 Changed bitmap message
+1.5.0b7 -PDS -GDS work for all inventories
+1.5.0b6 Added -verf to print "verification" time, new grib2ctl for -verf
+1.5.0b5 Added Lambert Conformal, -PDS and -GDS
+1.5.0b1 Added ECMWF parameter table #128
+
+1.5.0a  wgrib failing with no GDS and constant field.  Cannot determine 
+(9/96)  the size of data without a center-dependent lookup table.
+        Set length size of data to 1.
+
+1.5.0   -v option: major changes, now an inventory
+(9/96)  -V option: added century to date code, list parameter table number,
+           added description of variable
+        Added parameter table (NCEP-128) for the ocean modeling branch of NCEP.
+        Added user-defined parameter tables.
+        Note: changes are incompatible with grib2ctl.  Get new version.
+         (old version works by changing "wgrib -v" to "wgrib -V".)
+        V1.5.0 is the first version to be parameter-table aware.  As a
+         result, wgrib will give a warning if it cannot find a matching
+         parameter table.  The warning can be eliminated by either using
+         a user-defined parameter table or by adding your table into
+         the wgrib source.  (Contact w. ebisuzaki, Wesley.Ebisuzaki@noaa.gov).
+        Built-in tables: NCEP-2, NCEP-128, ECMWF-160.
+        Much faster flt2ieee routine, changed rounding factor in flt2ieee
+         so that IEEE machines gets the correct last bit.
+        Increased NTRY to 100 to accommodate Automation div headers.
+        The 1.4.x series didn't last long (1 revision, 3/96 to 7/96).
+
+1.4.1a  Several optimizations of the grib routines for reduced CPU usage.
+(6/96)  Updated the NCEP parameter table and altered the print statement
+        for climatological fields.
+
+
+1.4 ******************************************************************
+1.4 
+1.4 BUG: Prior to v1.4, when the start of the grib message was less
+1.4  than 160 bytes from the end of the file, wgrib would not find
+1.4  the message.  This would only occur if a short grib message (< 160 bytes)
+1.4  ended the file.  Basically I had assumed that a grib message
+1.4  had to be 160+ bytes in length.  Well someone at NCEP decided
+1.4  to write 84-byte grib messages!  About the only field that
+1.4  can be described in a 84-byte message is uniform value of zero.
+1.4
+1.4  Fixed a bug in the return code, and made the code 10% faster.
+1.4
+1.4  Since this is a bug fix PLEASE upgrade to version 1.4.
+1.4  Why not? It's free!  (3/96)
+1.4
+1.4 ******************************************************************
+
+
+1.3.4h  Complaint about wgrib failing if the file has no GDS.  Since a GDS
+(2/96)  is recommended (and is in every file that I have seen) I've never 
+        included the code to create a GDS for prespecified grids.  This 
+        version is a temporary fix. It sets the array size to NX x 1.
+        [7/96: This temporary fix will have to do.  The GDS prespecified 
+        grids are center dependent.  Since I don't have the tables, nothing
+        is planned.]
+
+1.3.4f  updated ECMWF parameter table (from M. Fiorino)
+(11/95)	support for the ECMWF stream parameter
+	clean compiles using acc (SunOS) (acc is pickier than gcc -Wall)
+
+1.3.4e  writing grib files made much faster
+(11/95)
+1.3.4d  minor change in error statement format
+(9/95)
+1.3.4c  didn't check for case where number of bits = 0! in NMC bug check
+(7/95)
+1.3.4   added check for bad bds "used bits" parameter (look for NMC bug)
+(7/95)
+1.3.3:  (preliminary) ECMWF parameter table added
+(5/95)
+1.3.2:  preliminary polar stereographics map support
+(4/95)
+
+To Do:
+   decode spherical harmonics (need some examples to test on)
+   complex packing?
+
+Adding new parameter tables is pretty easy and I'm willing to add new
+parameter tables for "operational centers". (Note, the GRIB center
+identification numbers are assigned by the WMO.)
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/Makefile	(revision 2744)
@@ -0,0 +1,29 @@
+.IGNORE:
+
+.SUFFIXES: .c .o
+
+CC=cc
+
+.c.o:
+	$(CC) -c -O2 $<
+
+obj=wgrib_main.o seekgrib.o ibm2flt.o readgrib.o intpower.o cnames.o BDSunpk.o \
+  flt2ieee.o wrtieee.o levels.o PDStimes.o missing.o  \
+  nceptable_reanal.o nceptable_opn.o ensemble.o \
+  ombtable.o ec_ext.o gribtable.o gds_grid.o PDS_date.o ectable_128.o \
+  ectable_129.o ectable_130.o ectable_131.o ectable_140.o ectable_150.o \
+  ectable_151.o ectable_160.o ectable_170.o ectable_180.o nceptab_129.o \
+  dwdtable_002.o dwdtable_201.o dwdtable_202.o dwdtable_203.o \
+  cptectable_254.o nceptab_130.o nceptab_131.o
+
+all: wgrib
+
+archive: wgrib
+
+wgrib: $(obj)
+	$(CC) -o wgrib $(obj) -lm
+	( cd .. ; \rm -f wgrib ; \ln -sf WGRIB/wgrib wgrib ; cd WGRIB )
+
+clean:	
+	\rm -f $(obj) wgrib
+	( cd .. ; \rm -f wgrib ; cd WGRIB )
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/PDS_date.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/PDS_date.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/PDS_date.c	(revision 2744)
@@ -0,0 +1,213 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <string.h>
+#include "pds4.h"
+#include "grib.h"
+
+/*
+ * PDS_date.c  v1.2 wesley ebisuzaki
+ *
+ * prints a string with a date code
+ *
+ * PDS_date(pds,option, v_time)
+ *   options=0  .. 2 digit year
+ *   options=1  .. 4 digit year
+ *
+ *   v_time=0   .. initial time
+ *   v_time=1   .. verification time
+ *
+ * assumption: P1 and P2 are unsigned integers (not clear from doc)
+ *
+ * v1.2 years that are multiple of 400 are leap years, not 500
+ * v1.2.1  make the change to the source code for v1.2
+ * v1.2.2  add 3/6/12 hour forecast time units
+ */
+
+static int msg_count = 0;
+extern int minute;
+
+int PDS_date(unsigned char *pds, int option, int v_time) {
+
+    int year, month, day, hour, min;
+
+    if (v_time == 0) {
+        year = PDS_Year4(pds);
+        month = PDS_Month(pds);
+        day  = PDS_Day(pds);
+        hour = PDS_Hour(pds);
+    }
+    else {
+        if (verf_time(pds, &year, &month, &day, &hour) != 0) {
+	    if (msg_count++ < 5) fprintf(stderr, "PDS_date: problem\n");
+	}
+    }
+    min =  PDS_Minute(pds);
+
+    switch(option) {
+	case 0:
+	    printf("%2.2d%2.2d%2.2d%2.2d", year % 100, month, day, hour);
+	    if (minute) printf("-%2.2d", min);
+	    break;
+	case 1:
+	    printf("%4.4d%2.2d%2.2d%2.2d", year, month, day, hour);
+	    if (minute) printf("-%2.2d", min);
+	    break;
+	default:
+	    fprintf(stderr,"missing code\n");
+	    exit(8);
+    }
+    return 0;
+}
+
+#define  FEB29   (31+29)
+static int monthjday[12] = {
+        0,31,59,90,120,151,181,212,243,273,304,334};
+
+static int leap(int year) {
+	if (year % 4 != 0) return 0;
+	if (year % 100 != 0) return 1;
+	return (year % 400 == 0);
+}
+
+
+int add_time(int *year, int *month, int *day, int *hour, int dtime, int unit) {
+    int y, m, d, h, jday, i;
+
+    y = *year;
+    m = *month;
+    d = *day;
+    h = *hour;
+
+    if (unit == YEAR) {
+	*year = y + dtime;
+	return 0;
+    }
+    if (unit == DECADE) {
+	*year =  y + (10 * dtime);
+	return 0;
+    }
+    if (unit == CENTURY) {
+	*year = y + (100 * dtime);
+	return 0;
+    }
+    if (unit == NORMAL) {
+	*year = y + (30 * dtime);
+	return 0;
+    }
+    if (unit == MONTH) {
+	dtime += (m - 1);
+	*year = y + (dtime / 12);
+	*month = 1 + (dtime % 12);
+	return 0;
+    }
+
+    if (unit == SECOND) {
+	dtime /= 60;
+	unit = MINUTE;
+    }
+    if (unit == MINUTE) {
+	dtime /= 60;
+	unit = HOUR;
+    }
+
+    if (unit == HOURS3) {
+        dtime *= 3;
+        unit = HOUR;
+    }
+    else if (unit == HOURS6) {
+        dtime *= 6;
+        unit = HOUR;
+    }
+    else if (unit == HOURS12) {
+        dtime *= 12;
+        unit = HOUR;
+    }
+
+    if (unit == HOUR) {
+	dtime += h;
+	*hour = dtime % 24;
+	dtime = dtime / 24;
+        unit = DAY;
+    }
+
+    /* this is the hard part */
+
+    if (unit == DAY) {
+	/* set m and day to Jan 0, and readjust dtime */
+	jday = d + monthjday[m-1];
+	if (leap(y) && m > 2) jday++;
+        dtime += jday;
+
+        /* 4 year chuncks */
+	i = dtime / (4 * 365 + 1);
+	if (i) {
+	    /* assume century years are leap */
+	    y = y + i*4;
+	    dtime -= i*(4 * 365 + 1);
+            /* see if we have gone past feb 28, 1900, 2000, etc */
+	    if ((y - 1) / 100 != (*year-1) / 100) {
+	        /* crossed the feb 28, xx00 */
+	        /* correct for only one century mark */
+		if ((y / 100) % 4 != 0) dtime++;
+	    }
+	}
+
+	/* one year chunks */
+	while (dtime > 365 + leap(y)) {
+	    dtime -= (365 + leap(y));
+	    y++;
+	}
+
+	/* calculate the month and day */
+
+	if (leap(y) && dtime == FEB29) {
+	    m = 2;
+	    d = 29;
+	}
+	else {
+	    if (leap(y) && dtime > FEB29) dtime--;
+	    for (i = 11; monthjday[i] >= dtime; --i);
+	    m = i + 1;
+	    d = dtime - monthjday[i];
+	}
+	*year = y;
+	*month = m;
+	*day = d;
+	return 0;
+   }
+   fprintf(stderr,"add_time: undefined time unit %d\n", unit);
+   return 1;
+}
+
+
+/*
+ * verf_time:
+ *
+ * this routine returns the "verification" time
+ * should have behavior similar to gribmap
+ *
+ */
+
+int verf_time(unsigned char *pds, int *year, int *month, int *day, int *hour) {
+    int tr, dtime, unit;
+
+    *year = PDS_Year4(pds);
+    *month = PDS_Month(pds);
+    *day  = PDS_Day(pds);
+    *hour = PDS_Hour(pds);
+
+    /* find time increment */
+
+    dtime = PDS_P1(pds);
+    tr = PDS_TimeRange(pds);
+    unit = PDS_ForecastTimeUnit(pds);
+
+    if (tr == 10) dtime = PDS_P1(pds) * 256 + PDS_P2(pds);
+    if (tr > 1 && tr < 6 ) dtime = PDS_P2(pds);
+
+    if (dtime == 0) return 0;
+
+    return add_time(year, month, day, hour, dtime, unit);
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/PDStimes.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/PDStimes.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/PDStimes.c	(revision 2744)
@@ -0,0 +1,216 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <string.h>
+#include "pds4.h"
+#include "grib.h"
+
+/*
+ * PDStimes.c   v1.2 wesley ebisuzaki
+ *
+ * prints something readable for time code in grib file
+ *
+ * not all cases decoded
+ * for NCEP/NCAR Reanalysis
+ *
+ * v1.2.1 1/99 fixed forecast time unit table
+ * v1.2.2 10/01 add time_range = 11 (at DWD)  Helmut P. Frank
+ */
+
+static char *units[] = {
+	"min", "hr", "d", "mon", "yr",
+	"decade", "normal", "century", "??", "??", " x3 hours", " x6 hours",
+        " x12 hours",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", "??", "??", "??", "??", "??", "??", "??", "??", "??",
+        "??", " sec"}; 
+
+void PDStimes(int time_range, int p1, int p2, int time_unit) {
+
+	char *unit;
+	enum {anal, fcst, unknown} type;
+	int fcst_len = 0;
+
+	if (time_unit >= 0 && time_unit <= sizeof(units)/sizeof(char *))
+             unit = units[time_unit];
+	else unit = "";
+
+
+        /* change x3/x6/x12 to hours */
+
+        if (time_unit == HOURS3) {
+	    p1 *= 3; p2 *= 3;
+	    time_unit = HOUR;
+        }
+        else if (time_unit == HOURS6) {
+	    p1 *= 6; p2 *= 6;
+	    time_unit = HOUR;
+        }
+        else if (time_unit == HOURS12) {
+	    p1 *= 12; p2 *= 12;
+	    time_unit = HOUR;
+        }
+
+	if (time_unit >= 0 && time_unit <= sizeof(units)/sizeof(char *))
+             unit = units[time_unit];
+	else unit = "";
+
+	/* figure out if analysis or forecast */
+	/* in GRIB, there is a difference between init and uninit analyses */
+	/* not case at NMC .. no longer run initialization */
+	/* ignore diff between init an uninit analyses */
+
+	switch (time_range) {
+
+	case 0:
+	case 1:
+	case 113:
+	case 114:
+	case 118:
+		if (p1 == 0) type = anal;
+		else {
+			type = fcst;
+			fcst_len = p1;
+		}
+		break;
+	case 10: /* way NMC uses it, should be unknown? */
+		type = fcst;
+		fcst_len = p1*256 + p2;
+		if (fcst_len == 0) type = anal;
+		break;
+
+	case 51:
+		type = unknown;
+		break;
+	case 123:
+	case 124:
+		type = anal;
+		break;
+
+	case 135:
+		type = anal;
+		break;
+
+	default: type = unknown;
+		break;
+	}
+
+	/* ----------------------------------------------- */
+
+	if (type == anal) printf("anl:");
+	else if (type == fcst) printf("%d%s fcst:",fcst_len,unit);
+
+
+	if (time_range == 123 || time_range == 124) {
+		if (p1 != 0) printf("start@%d%s:",p1,unit);
+	}
+
+
+	/* print time range */
+
+
+	switch (time_range) {
+
+	case 0:
+	case 1:
+	case 10:
+		break;
+	case 2: printf("valid %d-%d%s:",p1,p2,unit);
+		break;
+	case 3: printf("%d-%d%s ave:",p1,p2,unit);
+		break;
+	case 4: printf("%d-%d%s acc:",p1,p2,unit);
+		break;
+	case 5: printf("%d-%d%s diff:",p1,p2,unit);
+		break;
+	case 11: if (p1 > 0) {
+		    printf("init fcst %d%s:",p1,unit);
+		}
+		else {
+	            printf("time?:");
+		}
+		break;
+	case 51: if (p1 == 0) {
+		    /* printf("clim %d%s:",p2,unit); */
+		    printf("0-%d%s product:ave@1yr:",p2,unit);
+		}
+		else if (p1 == 1) {
+		    /* printf("clim (diurnal) %d%s:",p2,unit); */
+		    printf("0-%d%s product:same-hour,ave@1yr:",p2,unit);
+		}
+		else {
+		    printf("clim? p1=%d? %d%s?:",p1,p2,unit);
+		}
+		break;
+	case 113:
+	case 123:
+		printf("ave@%d%s:",p2,unit);
+		break;
+	case 114:
+	case 124:
+		printf("acc@%d%s:",p2,unit);
+		break;
+	case 115:
+		printf("ave of fcst:%d to %d%s:",p1,p2,unit);
+		break;
+	case 116:
+		printf("acc of fcst:%d to %d%s:",p1,p2,unit);
+		break;
+	case 118: 
+		printf("var@%d%s:",p2,unit);
+		break;
+	case 128:
+		printf("%d-%d%s fcst acc:ave@24hr:", p1, p2, unit);
+		break;
+	case 129:
+		printf("%d-%d%s fcst acc:ave@%d%s:", p1, p2, unit, p2-p1,unit);
+		break;
+	case 130:
+		printf("%d-%d%s fcst ave:ave@24hr:", p1, p2, unit);
+		break;
+	case 131:
+		printf("%d-%d%s fcst ave:ave@%d%s:", p1, p2, unit,p2-p1,unit);
+		break;
+		/* for CFS */
+	case 132:
+		printf("%d-%d%s anl:ave@1yr:", p1, p2, unit);
+		break;
+	case 133:
+		printf("%d-%d%s fcst:ave@1yr:", p1, p2, unit);
+		break;
+	case 134:
+		printf("%d-%d%s fcst-anl:rms@1yr:", p1, p2, unit);
+		break;
+	case 135:
+		printf("%d-%d%s fcst-fcst_mean:rms@1yr:", p1, p2, unit);
+		break;
+	case 136:
+		printf("%d-%d%s anl-anl_mean:rms@1yr:", p1, p2, unit);
+		break;
+		
+
+	default: printf("time?:");
+	}
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/README
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/README	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/README	(revision 2744)
@@ -0,0 +1,24 @@
+The wgrib program is by Wesley Ebisuzaki.  He can be
+reached at Wesley.Ebisuzaki@noaa.gov
+
+The wgrib homepage is:
+http://www.cpc.ncep.noaa.gov/products/wesley/wgrib.html
+
+This has source available, help, hints, docs, beta
+releases, etc.
+
+- - - - - - 
+
+Simple usage of the wgrib program (under the "howto:
+grib -> ieee" section of the web page:
+
+usage similar to diffwrf
+wgrib -s GRIBFILE | wgrib -s -i GRIBFILE
+This generates an ieee binary file called dump
+
+wgrib -s GRIBFILE | wgrib -s -i -text GRIBFILE
+This generates a text file called dump (text is
+50-100x slower than ieee)
+
+wgrib -s GRIBFILE | wgrib -s -i -text -o outfile GRIBFILE
+This generates a text file called outfile
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/bds.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/bds.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/bds.h	(revision 2744)
@@ -0,0 +1,49 @@
+/* 
+ * version 1.2.1 of grib headers  w. ebisuzaki 
+ *         1.2.2 added access to spectral reference value l. kornblueh
+ */
+
+#ifndef INT2
+#define INT2(a,b)   ((1-(int) ((unsigned) (a & 0x80) >> 6)) * (int) (((a & 0x7f) << 8) + b))
+#endif
+
+#define BDS_LEN(bds)		((int) ((bds[0]<<16)+(bds[1]<<8)+bds[2]))
+#define BDS_Flag(bds)		(bds[3])
+
+#define BDS_Grid(bds)		((bds[3] & 128) == 0)
+#define BDS_Harmonic(bds)	(bds[3] & 128)
+
+#define BDS_Packing(bds)	((bds[3] & 64) != 0)
+#define BDS_SimplePacking(bds)	((bds[3] & 64) == 0)
+#define BDS_ComplexPacking(bds)	((bds[3] & 64) != 0)
+
+#define BDS_OriginalType(bds)	((bds[3] & 32) != 0)
+#define BDS_OriginalFloat(bds)	((bds[3] & 32) == 0)
+#define BDS_OriginalInt(bds)	((bds[3] & 32) != 0)
+
+#define BDS_MoreFlags(bds)      ((bds[3] & 16) != 0)
+#define BDS_UnusedBits(bds)	((int) (bds[3] & 15))
+
+#define BDS_BinScale(bds)	INT2(bds[4],bds[5])
+
+#define BDS_RefValue(bds)	(ibm2flt(bds+6))
+#define BDS_NumBits(bds)	((int) bds[10])
+
+#define BDS_Harmonic_RefValue(bds) (ibm2flt(bds+11))
+
+#define BDS_DataStart(bds)      ((int) (11 + BDS_MoreFlags(bds)*3))
+
+/* breaks if BDS_NumBits(bds) == 0 */
+#define BDS_NValues(bds)        (((BDS_LEN(bds) - BDS_DataStart(bds))*8 - \
+				BDS_UnusedBits(bds)) / BDS_NumBits(bds))
+
+/*
+#define BDS_NValues(bds)        ((BDS_NumBits(bds) == 0) ? 0 : \
+				(((BDS_LEN(bds) - BDS_DataStart(bds))*8 - \
+				BDS_UnusedBits(bds)) / BDS_NumBits(bds)))
+*/
+
+
+/* undefined value -- if bitmap */
+#define UNDEFINED		9.999e20
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/bms.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/bms.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/bms.h	(revision 2744)
@@ -0,0 +1,8 @@
+/* version 1.2 of grib headers  w. ebisuzaki */
+
+#define BMS_LEN(bms)		((bms) == NULL ? 0 : (bms[0]<<16)+(bms[1]<<8)+bms[2])
+#define BMS_UnusedBits(bms)	((bms) == NULL ? 0 : bms[3])
+#define BMS_StdMap(bms)		((bms) == NULL ? 0 : ((bms[4]<<8) + bms[5]))
+#define BMS_bitmap(bms)		((bms) == NULL ? NULL : (bms)+6)
+#define BMS_nxny(bms)		((((bms) == NULL) || BMS_StdMap(bms)) \
+	? 0 : (BMS_LEN(bms)*8 - 48 - BMS_UnusedBits(bms)))
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/cnames.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/cnames.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/cnames.c	(revision 2744)
@@ -0,0 +1,141 @@
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include "cnames.h"
+#include "pds4.h"
+#include "grib.h"
+
+/* cnames.c 				Wesley Ebisuzaki
+ *
+ * returns strings with either variable name or comment field
+ * v1.4 4/98
+ * reanalysis can use process 180 and subcenter 0
+ *
+ * Add DWD tables 2, 201, 202, 203      Helmut P. Frank, DWD, FE13
+ *                                      Thu Aug 23 09:28:34 GMT 2001
+ */
+
+
+extern  struct ParmTable parm_table_ncep_opn[256];
+extern  struct ParmTable parm_table_ncep_reanal[256];
+extern  struct ParmTable parm_table_nceptab_129[256];
+extern  struct ParmTable parm_table_omb[256];
+extern  struct ParmTable parm_table_nceptab_130[256];
+extern  struct ParmTable parm_table_nceptab_131[256];
+
+extern  struct ParmTable parm_table_ecmwf_128[256];
+extern  struct ParmTable parm_table_ecmwf_129[256];
+extern  struct ParmTable parm_table_ecmwf_130[256];
+extern  struct ParmTable parm_table_ecmwf_131[256];
+extern  struct ParmTable parm_table_ecmwf_140[256];
+extern  struct ParmTable parm_table_ecmwf_150[256];
+extern  struct ParmTable parm_table_ecmwf_151[256];
+extern  struct ParmTable parm_table_ecmwf_160[256];
+extern  struct ParmTable parm_table_ecmwf_170[256];
+extern  struct ParmTable parm_table_ecmwf_180[256];
+extern  struct ParmTable parm_table_user[256];
+extern  struct ParmTable parm_table_dwd_002[256];
+extern  struct ParmTable parm_table_dwd_201[256];
+extern  struct ParmTable parm_table_dwd_202[256];
+extern  struct ParmTable parm_table_dwd_203[256];
+extern  struct ParmTable parm_table_cptec_254[256];
+
+extern enum Def_NCEP_Table def_ncep_table;
+
+/*
+ * returns pointer to the parameter table
+ */
+
+
+
+static struct ParmTable *Parm_Table(unsigned char *pds) {
+
+    int i, center, subcenter, ptable, process;
+    static int missing_count = 0, reanal_opn_count = 0;
+
+    center = PDS_Center(pds);
+    subcenter = PDS_Subcenter(pds);
+    ptable = PDS_Vsn(pds);
+
+#ifdef P_TABLE_FIRST
+    i = setup_user_table(center, subcenter, ptable);
+    if (i == 1) return &parm_table_user[0];
+#endif
+    /* figure out if NCEP opn or reanalysis */
+    if (center == NMC && ptable <= 3) {
+	if (subcenter == 1) return &parm_table_ncep_reanal[0];
+        process = PDS_Model(pds);
+	if (subcenter != 0 || (process != 80 && process != 180) || 
+		(ptable != 1 && ptable != 2)) 
+            return &parm_table_ncep_opn[0];
+
+	/* at this point could be either the opn or reanalysis table */
+	if (def_ncep_table == opn_nowarn) return &parm_table_ncep_opn[0];
+	if (def_ncep_table == rean_nowarn) return &parm_table_ncep_reanal[0];
+        if (reanal_opn_count++ == 0) {
+	    fprintf(stderr, "Using NCEP %s table, see -ncep_opn, -ncep_rean options\n",
+               (def_ncep_table == opn) ?  "opn" : "reanalysis");
+	}
+        return (def_ncep_table == opn) ?  &parm_table_ncep_opn[0] 
+		: &parm_table_ncep_reanal[0];
+    }
+
+    if (center == NMC) {
+        if (ptable == 128) return &parm_table_omb[0];
+        if (ptable == 129) return &parm_table_nceptab_129[0];
+        if (ptable == 130) return &parm_table_nceptab_130[0];
+        if (ptable == 131) return &parm_table_nceptab_131[0];
+        if (ptable == 132) return &parm_table_ncep_reanal[0];
+    }
+    if (center == ECMWF) {
+        if (ptable == 128) return &parm_table_ecmwf_128[0];
+        if (ptable == 129) return &parm_table_ecmwf_129[0];
+        if (ptable == 130) return &parm_table_ecmwf_130[0];
+        if (ptable == 131) return &parm_table_ecmwf_131[0];
+        if (ptable == 140) return &parm_table_ecmwf_140[0];
+        if (ptable == 150) return &parm_table_ecmwf_150[0];
+        if (ptable == 151) return &parm_table_ecmwf_151[0];
+        if (ptable == 160) return &parm_table_ecmwf_160[0];
+        if (ptable == 170) return &parm_table_ecmwf_170[0];
+        if (ptable == 180) return &parm_table_ecmwf_180[0];
+    }
+    if (center == DWD) {
+        if (ptable ==   2) return &parm_table_dwd_002[0];
+        if (ptable == 201) return &parm_table_dwd_201[0];
+        if (ptable == 202) return &parm_table_dwd_202[0];
+        if (ptable == 203) return &parm_table_dwd_203[0];
+    }
+    if (center == CPTEC) {
+	if (ptable == 254) return &parm_table_cptec_254[0];
+    }
+
+#ifndef P_TABLE_FIRST
+    i = setup_user_table(center, subcenter, ptable);
+    if (i == 1) return &parm_table_user[0];
+#endif
+
+    if ((ptable > 3 || (PDS_PARAM(pds)) > 127) && missing_count++ == 0) {
+	fprintf(stderr,
+            "\nUndefined parameter table (center %d-%d table %d), using NCEP-opn\n",
+            center, subcenter, ptable);
+    }
+    return &parm_table_ncep_opn[0];
+}
+
+/*
+ * return name field of PDS_PARAM(pds)
+ */
+
+char *k5toa(unsigned char *pds) {
+
+    return (Parm_Table(pds) + PDS_PARAM(pds))->name;
+}
+
+/*
+ * return comment field of the PDS_PARAM(pds)
+ */
+
+char *k5_comments(unsigned char *pds) {
+
+    return (Parm_Table(pds) + PDS_PARAM(pds))->comment;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/cnames.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/cnames.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/cnames.h	(revision 2744)
@@ -0,0 +1,29 @@
+/* cnames_file.c */
+
+/* search order for parameter names
+ *
+ * #define P_TABLE_FIRST
+ * look at external parameter table first
+ *
+ * otherwise use builtin NCEP-2 or ECMWF-160 first
+ */
+/* #define P_TABLE_FIRST */
+
+/* search order for external parameter table
+ * 1) environment variable GRIBTAB
+ * 2) environment variable gribtab
+ * 3) the file 'gribtab' in current directory
+ */
+
+
+/* cnames.c */
+/* then default values */
+char *k5toa(unsigned char *pds);
+char *k5_comments(unsigned char *pds);
+int setup_user_table(int center, int subcenter, int ptable);
+
+
+struct ParmTable {
+	char *name, *comment;
+};
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/cptectable_254.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/cptectable_254.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/cptectable_254.c	(revision 2744)
@@ -0,0 +1,261 @@
+#include "cnames.h"
+
+struct ParmTable parm_table_cptec_254[256] = {
+   /* 0 */ {"var0", "undefined"},
+   /* 1 */ {"PRES", "Pressure [hPa]"},
+   /* 2 */ {"psnm", "Pressure reduced to MSL [hPa]"},
+   /* 3 */ {"tsps", "Pressure tendency [Pa/s]"},
+   /* 4 */ {"var4", "undefined"},
+   /* 5 */ {"var5", "undefined"},
+   /* 6 */ {"geop", "Geopotential [dam]"},
+   /* 7 */ {"zgeo", "Geopotential height [gpm]"},
+   /* 8 */ {"gzge", "Geometric height [m]"},
+   /* 9 */ {"var9", "undefined"},
+   /* 10 */ {"var10", "undefined"},
+   /* 11 */ {"temp", "ABSOLUTE TEMPERATURE [K]"},
+   /* 12 */ {"vtmp", "VIRTUAL TEMPERATURE [K]"},
+   /* 13 */ {"ptmp", "POTENTIAL TEMPERATURE [K]"},
+   /* 14 */ {"psat", "PSEUDO-ADIABATIC POTENTIAL TEMPERATURE [K]"},
+   /* 15 */ {"mxtp", "MAXIMUM TEMPERATURE [K]"},
+   /* 16 */ {"mntp", "MINIMUM TEMPERATURE [K]"},
+   /* 17 */ {"tpor", "DEW POINT TEMPERATURE [K]"},
+   /* 18 */ {"dptd", "DEW POINT DEPRESSION [K]"},
+   /* 19 */ {"lpsr", "LAPSE RATE [K/m]"},
+   /* 20 */ {"var20", "undefined"},
+   /* 21 */ {"rds1", "RADAR SPECTRA(1) [non-dim]"},
+   /* 22 */ {"rds2", "RADAR SPECTRA(2) [non-dim]"},
+   /* 23 */ {"rds3", "RADAR SPECTRA(3) [non-dim]"},
+   /* 24 */ {"var24", "undefined"},
+   /* 25 */ {"tpan", "TEMPERATURE ANOMALY [K]"},
+   /* 26 */ {"psan", "PRESSURE ANOMALY [Pa hPa]"},
+   /* 27 */ {"zgan", "GEOPOT HEIGHT ANOMALY [m]"},
+   /* 28 */ {"wvs1", "WAVE SPECTRA(1) [non-dim]"},
+   /* 29 */ {"wvs2", "WAVE SPECTRA(2) [non-dim]"},
+   /* 30 */ {"wvs3", "WAVE SPECTRA(3) [non-dim]"},
+   /* 31 */ {"wind", "WIND DIRECTION  [deg]"},
+   /* 32 */ {"wins", "WIND SPEED [m/s]"},
+   /* 33 */ {"uvel", "ZONAL WIND (U) [m/s]"},
+   /* 34 */ {"vvel", "MERIDIONAL WIND (V) [m/s]"},
+   /* 35 */ {"fcor", "STREAM FUNCTION [m2/s]"},
+   /* 36 */ {"potv", "VELOCITY POTENTIAL [m2/s]"},
+   /* 37 */ {"var37", "undefined"},
+   /* 38 */ {"sgvv", "SIGMA COORD VERT VEL [sec/sec]"},
+   /* 39 */ {"omeg", "OMEGA [Pa/s]"},
+   /* 40 */ {"omg2", "VERTICAL VELOCITY [m/s]"},
+   /* 41 */ {"abvo", "ABSOLUTE VORTICITY        [10**5/sec]"},
+   /* 42 */ {"abdv", "ABSOLUTE DIVERGENCE [10**5/sec]"},
+   /* 43 */ {"vort", "VORTICITY  [1/s]"},
+   /* 44 */ {"divg", "DIVERGENCE [1/s]"},
+   /* 45 */ {"vucs", "VERTICAL U-COMP SHEAR [1/sec]"},
+   /* 46 */ {"vvcs", "VERT V-COMP SHEAR [1/sec]"},
+   /* 47 */ {"dirc", "DIRECTION OF CURRENT [deg]"},
+   /* 48 */ {"spdc", "SPEED OF CURRENT [m/s]"},
+   /* 49 */ {"ucpc", "U-COMPONENT OF CURRENT [m/s]"},
+   /* 50 */ {"vcpc", "V-COMPONENT OF CURRENT [m/s]"},
+   /* 51 */ {"umes", "SPECIFIC HUMIDITY [kg/kg]"},
+   /* 52 */ {"umrl", "RELATIVE HUMIDITY [no Dim]"},
+   /* 53 */ {"hmxr", "HUMIDITY MIXING RATIO [kg/kg]"},
+   /* 54 */ {"agpl", "INST. PRECIPITABLE WATER [Kg/m2]"},
+   /* 55 */ {"vapp", "VAPOUR PRESSURE [Pa hpa]"},
+   /* 56 */ {"sadf", "SATURATION DEFICIT        [Pa hPa]"},
+   /* 57 */ {"evap", "EVAPORATION [Kg/m2/day]"},
+   /* 58 */ {"var58", "undefined"},
+   /* 59 */ {"prcr", "PRECIPITATION RATE        [kg/m2/day]"},
+   /* 60 */ {"thpb", "THUNDER PROBABILITY [%]"},
+   /* 61 */ {"prec", "TOTAL PRECIPITATION [Kg/m2/day]"},
+   /* 62 */ {"prge", "LARGE SCALE PRECIPITATION [Kg/m2/day]"},
+   /* 63 */ {"prcv", "CONVECTIVE PRECIPITATION [Kg/m2/day]"},
+   /* 64 */ {"neve", "SNOWFALL [Kg/m2/day]"},
+   /* 65 */ {"wenv", "WAT EQUIV ACC SNOW DEPTH [kg/m2]"},
+   /* 66 */ {"nvde", "SNOW DEPTH        [cm]"},
+   /* 67 */ {"mxld", "MIXED LAYER DEPTH [m cm]"},
+   /* 68 */ {"tthd", "TRANS THERMOCLINE DEPTH [m cm]"},
+   /* 69 */ {"mthd", "MAIN THERMOCLINE DEPTH [m cm]"},
+   /* 70 */ {"mtha", "MAIN THERMOCLINE ANOM [m cm]"},
+   /* 71 */ {"cbnv", "CLOUD COVER [0-1]"},
+   /* 72 */ {"cvnv", "CONVECTIVE CLOUD COVER [0-1]"},
+   /* 73 */ {"lwnv", "LOW CLOUD COVER [0-1]"},
+   /* 74 */ {"mdnv", "MEDIUM CLOUD COVER        [0-1]"},
+   /* 75 */ {"hinv", "HIGH CLOUD COVER [0-1]"},
+   /* 76 */ {"wtnv", "CLOUD WATER [kg/m2]"},
+   /* 77 */ {"bli", "BEST LIFTED INDEX (TO 500 HPA) [K]"},
+   /* 78 */ {"var78", "undefined"},
+   /* 79 */ {"var79", "undefined"},
+   /* 80 */ {"var80", "undefined"},
+   /* 81 */ {"lsmk", "LAND SEA MASK [0,1]"},
+   /* 82 */ {"dslm", "DEV SEA_LEV FROM MEAN [m]"},
+   /* 83 */ {"zorl", "ROUGHNESS LENGTH [m]"},
+   /* 84 */ {"albe", "ALBEDO [%]"},
+   /* 85 */ {"dstp", "DEEP SOIL TEMPERATURE [K]"},
+   /* 86 */ {"soic", "SOIL MOISTURE CONTENT [Kg/m2]"},
+   /* 87 */ {"vege", "VEGETATION        [%]"},
+   /* 88 */ {"var88", "undefined"},
+   /* 89 */ {"dens", "DENSITY [kg/m3]"},
+   /* 90 */ {"var90", "Undefined"},
+   /* 91 */ {"icec", "ICE CONCENTRATION [fraction]"},
+   /* 92 */ {"icet", "ICE THICKNESS [m]"},
+   /* 93 */ {"iced", "DIRECTION OF ICE DRIFT [deg]"},
+   /* 94 */ {"ices", "SPEED OF ICE DRIFT        [m/s]"},
+   /* 95 */ {"iceu", "U-COMP OF ICE DRIFT [m/s]"},
+   /* 96 */ {"icev", "V-COMP OF ICE DRIFT [m/s]"},
+   /* 97 */ {"iceg", "ICE GROWTH        [m]"},
+   /* 98 */ {"icdv", "ICE DIVERGENCE [sec/sec]"},
+   /* 99 */ {"var99", "undefined"},
+   /* 100 */ {"shcw", "SIG HGT COM WAVE/SWELL [m]"},
+   /* 101 */ {"wwdi", "DIRECTION OF WIND WAVE [deg]"},
+   /* 102 */ {"wwsh", "SIG HGHT OF WIND WAVES [m]"},
+   /* 103 */ {"wwmp", "MEAN PERIOD WIND WAVES [sec]"},
+   /* 104 */ {"swdi", "DIRECTION OF SWELL WAVE [deg]"},
+   /* 105 */ {"swsh", "SIG HEIGHT SWELL WAVES [m]"},
+   /* 106 */ {"swmp", "MEAN PERIOD SWELL WAVES [sec]"},
+   /* 107 */ {"prwd", "PRIMARY WAVE DIRECTION [deg]"},
+   /* 108 */ {"prmp", "PRIM WAVE MEAN PERIOD [s]"},
+   /* 109 */ {"swdi", "SECOND WAVE DIRECTION [deg]"},
+   /* 110 */ {"swmp", "SECOND WAVE MEAN PERIOD [s]"},
+   /* 111 */ {"ocas", "SHORT WAVE ABSORBED AT GROUND [W/m2]"},
+   /* 112 */ {"slds", "NET LONG WAVE AT BOTTOM [W/m2]"},
+   /* 113 */ {"nswr", "NET SHORT-WAV RAD(TOP) [W/m2]"},
+   /* 114 */ {"role", "OUTGOING LONG WAVE AT TOP [W/m2]"},
+   /* 115 */ {"lwrd", "LONG-WAV RAD [W/m2]"},
+   /* 116 */ {"swea", "SHORT WAVE ABSORBED BY EARTH/ATMOSPHERE  [W/m2]"},
+   /* 117 */ {"glbr", "GLOBAL RADIATION [W/m2 ]"},
+   /* 118 */ {"var118", "undefined"},
+   /* 119 */ {"var119", "undefined"},
+   /* 120 */ {"var120", "undefined"},
+   /* 121 */ {"clsf", "LATENT HEAT FLUX FROM SURFACE [W/m2]"},
+   /* 122 */ {"cssf", "SENSIBLE HEAT FLUX FROM SURFACE [W/m2]"},
+   /* 123 */ {"blds", "BOUND LAYER DISSIPATION [W/m2]"},
+   /* 124 */ {"var124", "undefined"},
+   /* 125 */ {"var125", "undefined"},
+   /* 126 */ {"var126", "undefined"},
+   /* 127 */ {"imag", "IMAGE [image^data]"},
+   /* 128 */ {"tp2m", "2 METRE TEMPERATURE [K]"},
+   /* 129 */ {"dp2m", "2 METRE DEWPOINT TEMPERATURE [K]"},
+   /* 130 */ {"u10m", "10 METRE U-WIND COMPONENT [m/s]"},
+   /* 131 */ {"v10m", "10 METRE V-WIND COMPONENT [m/s]"},
+   /* 132 */ {"topo", "TOPOGRAPHY [m]"},
+   /* 133 */ {"gsfp", "GEOMETRIC MEAN SURFACE PRESSURE [hPa]"},
+   /* 134 */ {"lnsp", "LN SURFACE PRESSURE [hPa]"},
+   /* 135 */ {"pslc", "SURFACE PRESSURE [hPa]"},
+   /* 136 */ {"pslm", "M S L PRESSURE (MESINGER METHOD) [hPa]"},
+   /* 137 */ {"mask", "MASK  [-/+]"},
+   /* 138 */ {"mxwu", "MAXIMUM U-WIND [m/s]"},
+   /* 139 */ {"mxwv", "MAXIMUM V-WIND [m/s]"},
+   /* 140 */ {"cape", "CONVECTIVE AVAIL. POT.ENERGY [m2/s2]"},
+   /* 141 */ {"cine", "CONVECTIVE INHIB. ENERGY [m2/s2]"},
+   /* 142 */ {"lhcv", "CONVECTIVE LATENT HEATING [K/s]"},
+   /* 143 */ {"mscv", "CONVECTIVE MOISTURE SOURCE [1/s]"},
+   /* 144 */ {"scvm", "SHALLOW CONV. MOISTURE SOURCE [1/s]"},
+   /* 145 */ {"scvh", "SHALLOW CONVECTIVE HEATING [K/s]"},
+   /* 146 */ {"mxwp", "MAXIMUM WIND PRESS. LVL  [hPa]"},
+   /* 147 */ {"ustr", "STORM MOTION U-COMPONENT [m/s]"},
+   /* 148 */ {"vstr", "STORM MOTION V-COMPONENT [m/s]"},
+   /* 149 */ {"cbnt", "MEAN CLOUD COVER [0-1]"},
+   /* 150 */ {"pcbs", "PRESSURE AT CLOUD BASE [hPa]"},
+   /* 151 */ {"pctp", "PRESSURE AT CLOUD TOP [hPa]"},
+   /* 152 */ {"fzht", "FREEZING LEVEL HEIGHT [m]"},
+   /* 153 */ {"fzrh", "FREEZING LEVEL RELATIVE HUMIDITY [%]"},
+   /* 154 */ {"fdlt", "FLIGHT LEVELS TEMPERATURE [K]"},
+   /* 155 */ {"fdlu", "FLIGHT LEVELS U-WIND [m/s]"},
+   /* 156 */ {"fdlv", "FLIGHT LEVELS V-WIND [m/s]"},
+   /* 157 */ {"tppp", "TROPOPAUSE PRESSURE   [hPa]"},
+   /* 158 */ {"tppt", "TROPOPAUSE TEMPERATURE [K]"},
+   /* 159 */ {"tppu", "TROPOPAUSE U-WIND COMPONENT [m/s]"},
+   /* 160 */ {"tppv", "TROPOPAUSE v-WIND COMPONENT [m/s]"},
+   /* 161 */ {"var161", "undefined"},
+   /* 162 */ {"gvdu", "GRAVITY WAVE DRAG DU/DT [m/s2]"},
+   /* 163 */ {"gvdv", "GRAVITY WAVE DRAG DV/DT [m/s2]"},
+   /* 164 */ {"gvus", "GRAVITY WAVE DRAG SFC ZONAL STRESS  [Pa]"},
+   /* 165 */ {"gvvs", "GRAVITY WAVE DRAG SFC MERIDIONAL STRESS [Pa]"},
+   /* 166 */ {"var166", "undefined"},
+   /* 167 */ {"dvsh", "DIVERGENCE OF SPECIFIC HUMIDITY [1/s]"},
+   /* 168 */ {"hmfc", "HORIZ. MOISTURE FLUX CONV.  [1/s]"},
+   /* 169 */ {"vmfl", "VERT. INTEGRATED MOISTURE FLUX CONV. [kg/(m2*s)]"},
+   /* 170 */ {"vadv", "VERTICAL MOISTURE ADVECTION  [kg/(kg*s)]"},
+   /* 171 */ {"nhcm", "NEG. HUM. CORR. MOISTURE SOURCE [kg/(kg*s)]"},
+   /* 172 */ {"lglh", "LARGE SCALE LATENT HEATING   [K/s]"},
+   /* 173 */ {"lgms", "LARGE SCALE MOISTURE SOURCE  [1/s]"},
+   /* 174 */ {"smav", "SOIL MOISTURE AVAILABILITY  [0-1]"},
+   /* 175 */ {"tgrz", "SOIL TEMPERATURE OF ROOT ZONE [K]"},
+   /* 176 */ {"bslh", "BARE SOIL LATENT HEAT [Ws/m2]"},
+   /* 177 */ {"evpp", "POTENTIAL SFC EVAPORATION [m]"},
+   /* 178 */ {"rnof", "RUNOFF [kg/m2/s)]"},
+   /* 179 */ {"pitp", "INTERCEPTION LOSS [W/m2]"},
+   /* 180 */ {"vpca", "VAPOR PRESSURE OF CANOPY AIR SPACE [mb]"},
+   /* 181 */ {"qsfc", "SURFACE SPEC HUMIDITY   [kg/kg]"},
+   /* 182 */ {"ussl", "SOIL WETNESS OF SURFACE [0-1]"},
+   /* 183 */ {"uzrs", "SOIL WETNESS OF ROOT ZONE [0-1]"},
+   /* 184 */ {"uzds", "SOIL WETNESS OF DRAINAGE ZONE [0-1]"},
+   /* 185 */ {"amdl", "STORAGE ON CANOPY [m]"},
+   /* 186 */ {"amsl", "STORAGE ON GROUND [m]"},
+   /* 187 */ {"tsfc", "SURFACE TEMPERATURE [K]"},
+   /* 188 */ {"tems", "SURFACE ABSOLUTE TEMPERATURE [K]"},
+   /* 189 */ {"tcas", "TEMPERATURE OF CANOPY AIR SPACE [K]"},
+   /* 190 */ {"ctmp", "TEMPERATURE AT CANOPY [K]"},
+   /* 191 */ {"tgsc", "GROUND/SURFACE COVER TEMPERATURE [K]"},
+   /* 192 */ {"uves", "SURFACE ZONAL WIND (U) [m/s]"},
+   /* 193 */ {"usst", "SURFACE ZONAL WIND STRESS [Pa]"},
+   /* 194 */ {"vves", "SURFACE MERIDIONAL WIND (V) [m/s]"},
+   /* 195 */ {"vsst", "SURFACE MERIDIONAL WIND STRESS [Pa]"},
+   /* 196 */ {"suvf", "SURFACE MOMENTUM FLUX [W/m2]"},
+   /* 197 */ {"iswf", "INCIDENT SHORT WAVE FLUX [W/m2]"},
+   /* 198 */ {"ghfl", "TIME AVE GROUND HT FLX   [W/m2]"},
+   /* 199 */ {"var199", "undefined"},
+   /* 200 */ {"lwbc", "NET LONG WAVE AT BOTTOM (CLEAR) [W/m2]"},
+   /* 201 */ {"lwtc", "OUTGOING LONG WAVE AT TOP (CLEAR) [W/m2]"},
+   /* 202 */ {"swec", "SHORT WV ABSRBD BY EARTH/ATMOS (CLEAR) [W/m2]"},
+   /* 203 */ {"ocac", "SHORT WAVE ABSORBED AT GROUND (CLEAR) [W/m2]"},
+   /* 204 */ {"var204", "undefined"},
+   /* 205 */ {"lwrh", "LONG WAVE RADIATIVE HEATING  [K/s]"},
+   /* 206 */ {"swrh", "SHORT WAVE RADIATIVE HEATING [K/s]"},
+   /* 207 */ {"olis", "DOWNWARD LONG WAVE AT BOTTOM [W/m2]"},
+   /* 208 */ {"olic", "DOWNWARD LONG WAVE AT BOTTOM (CLEAR) [W/m2]"},
+   /* 209 */ {"ocis", "DOWNWARD SHORT WAVE AT GROUND [W/m2]"},
+   /* 210 */ {"ocic", "DOWNWARD SHORT WAVE AT GROUND (CLEAR) [W/m2]"},
+   /* 211 */ {"oles", "UPWARD LONG WAVE AT BOTTOM [W/m2]"},
+   /* 212 */ {"oces", "UPWARD SHORT WAVE AT GROUND [W/m2]"},
+   /* 213 */ {"swgc", "UPWARD SHORT WAVE AT GROUND (CLEAR) [W/m2]"},
+   /* 214 */ {"roce", "UPWARD SHORT WAVE AT TOP [W/m2]"},
+   /* 215 */ {"swtc", "UPWARD SHORT WAVE AT TOP (CLEAR) [W/m2]"},
+   /* 216 */ {"var216", "undefined"},
+   /* 217 */ {"var217", "undefined"},
+   /* 218 */ {"hhdf", "HORIZONTAL HEATING DIFFUSION [K/s]"},
+   /* 219 */ {"hmdf", "HORIZONTAL MOISTURE DIFFUSION [1/s]"},
+   /* 220 */ {"hddf", "HORIZONTAL DIVERGENCE DIFFUSION [1/s2]"},
+   /* 221 */ {"hvdf", "HORIZONTAL VORTICITY DIFFUSION [1/s2]"},
+   /* 222 */ {"vdms", "VERTICAL DIFF. MOISTURE SOURCE [1/s]"},
+   /* 223 */ {"vdfu", "VERTICAL DIFFUSION DU/DT [m/s2]"},
+   /* 224 */ {"vdfv", "VERTICAL DIFFUSION DV/DT [m/s2]"},
+   /* 225 */ {"vdfh", "VERTICAL DIFFUSION HEATING [K/s]"},
+   /* 226 */ {"umrs", "SURFACE RELATIVE HUMIDITY [no Dim]"},
+   /* 227 */ {"vdcc", "VERTICAL DIST TOTAL CLOUD COVER [no Dim]"},
+   /* 228 */ {"var228", "undefined"},
+   /* 229 */ {"var229", "undefined"},
+   /* 230 */ {"usmt", "TIME MEAN SURFACE ZONAL WIND (U) [m/s]"},
+   /* 231 */ {"vsmt", "TIME MEAN SURFACE MERIDIONAL WIND (V) [m/s]"},
+   /* 232 */ {"tsmt", "TIME MEAN SURFACE ABSOLUTE TEMPERATURE [K]"},
+   /* 233 */ {"rsmt", "TIME MEAN SURFACE RELATIVE HUMIDITY [no Dim]"},
+   /* 234 */ {"atmt", "TIME MEAN ABSOLUTE TEMPERATURE [K]"},
+   /* 235 */ {"stmt", "TIME MEAN DEEP SOIL TEMPERATURE [K]"},
+   /* 236 */ {"ommt", "TIME MEAN DERIVED OMEGA [Pa/s]"},
+   /* 237 */ {"dvmt", "TIME MEAN DIVERGENCE [1/s]"},
+   /* 238 */ {"zhmt", "TIME MEAN GEOPOTENTIAL HEIGHT [m]"},
+   /* 239 */ {"lnmt", "TIME MEAN LOG SURFACE PRESSURE [ln(cbar)]"},
+   /* 240 */ {"mkmt", "TIME MEAN MASK [-/+]"},
+   /* 241 */ {"vvmt", "TIME MEAN MERIDIONAL WIND (V) [m/s]"},
+   /* 242 */ {"omtm", "TIME MEAN OMEGA  [cbar/s]"},
+   /* 243 */ {"ptmt", "TIME MEAN POTENTIAL TEMPERATURE [K]"},
+   /* 244 */ {"pcmt", "TIME MEAN PRECIP. WATER  [kg/m2]"},
+   /* 245 */ {"rhmt", "TIME MEAN RELATIVE HUMIDITY [%]"},
+   /* 246 */ {"mpmt", "TIME MEAN SEA LEVEL PRESSURE [hPa]"},
+   /* 247 */ {"simt", "TIME MEAN SIGMADOT [1/s]"},
+   /* 248 */ {"uemt", "TIME MEAN SPECIFIC HUMIDITY [kg/kg]"},
+   /* 249 */ {"fcmt", "TIME MEAN STREAM FUNCTION| m2/s]"},
+   /* 250 */ {"psmt", "TIME MEAN SURFACE PRESSURE [hPa]"},
+   /* 251 */ {"tmmt", "TIME MEAN SURFACE TEMPERATURE [K]"},
+   /* 252 */ {"pvmt", "TIME MEAN VELOCITY POTENTIAL [m2/s]"},
+   /* 253 */ {"tvmt", "TIME MEAN VIRTUAL TEMPERATURE [K]"},
+   /* 254 */ {"vtmt", "TIME MEAN VORTICITY [1/s]"},
+   /* 255 */ {"uvmt", "TIME MEAN ZONAL WIND (U) [m/s]"},
+};
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_002.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_002.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_002.c	(revision 2744)
@@ -0,0 +1,266 @@
+#include "cnames.h"
+
+/*
+ * GRIB table 2 at DWD
+ *     Helmut P. Frank, 30.08.2001
+ * updated 24.07.2003: PMSL, DD, FF, W, FR_ICE, H_ICE
+ */
+
+struct ParmTable parm_table_dwd_002[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"PS", "pressure [Pa]"},
+    /* 2 */ {"PMSL", "pressure reduced to MSL [Pa]"},
+    /* 3 */ {"p-tendency", "pressure tendency [Pa/s]"},
+    /* 4 */ {"var4", "undefined"},
+    /* 5 */ {"var5", "undefined"},
+    /* 6 */ {"FI", "geopotential [(m**2)/(s**2)]"},
+    /* 7 */ {"geopot h", "geopotential height [gpm]"},
+    /* 8 */ {"geomet h", "geometrical height [m]"},
+    /* 9 */ {"dev of h", "standard deviation of height [m]"},
+    /* 10 */ {"TO3", "total ozone [Dobson Units]"},
+    /* 11 */ {"T", "temperature [K]"},
+    /* 12 */ {"virt.temp.", "virtual temperature [K]"},
+    /* 13 */ {"pot. temp.", "potential temperature [K]"},
+    /* 14 */ {"pseudo-pot", "pseudo-adiabatic potential temperature [K]"},
+    /* 15 */ {"TMAX", "maximum temperature [K]"},
+    /* 16 */ {"TMIN", "minimum temperature [K]"},
+    /* 17 */ {"TD", "dew-point temperature [K]"},
+    /* 18 */ {"dew-pnt de", "dew-point depression (or deficit) [K]"},
+    /* 19 */ {"lapse rate", "laps rate [K/m]"},
+    /* 20 */ {"visibility", "visibility [m]"},
+    /* 21 */ {"radar sp 1", "radar spectra (1) [non-dim]"},
+    /* 22 */ {"radar sp 2", "radar spectra (2) [non-dim]"},
+    /* 23 */ {"radar sp 3", "radar spectra (3) [non-dim]"},
+    /* 24 */ {"pli to 500", "parcel lifted index (to 500 hPa) [K]"},
+    /* 25 */ {"temp anom", "temperature anomaly [K]"},
+    /* 26 */ {"pres anom", "pressure anomaly [Pa]"},
+    /* 27 */ {"geop anom", "geopotential height anomaly [gpm]"},
+    /* 28 */ {"wave sp 1", "wave spaectra(1) [non-dim]"},
+    /* 29 */ {"wave sp 2", "wave spaectra(2) [non-dim]"},
+    /* 30 */ {"wave sp 3", "wave spaectra(3) [non-dim]"},
+    /* 31 */ {"DD", "wind direction [degree true]"},
+    /* 32 */ {"FF", "wind speed [m/s]"},
+    /* 33 */ {"U", "u-component (zonal) of wind [m/s]"},
+    /* 34 */ {"V", "v-component (merdional) of wind [m/s]"},
+    /* 35 */ {"stream fun", "stream function [(m**2)/s]"},
+    /* 36 */ {"vel potent", "velocity potential [(m**2)/s]"},
+    /* 37 */ {"M.stream f", "Montgomery stream function [(m**2)/(s**2)]"},
+    /* 38 */ {"sigma vert", "sigma co-ordinate vertical velocity [1/s]"},
+    /* 39 */ {"OMEGA", "vertical velocity [Pa/s]"},
+    /* 40 */ {"W", "vertical velocity [m/s]"},
+    /* 41 */ {"abs vortic", "absolute vorticity [1/s]"},
+    /* 42 */ {"abs diverg", "absolute divergence [1/s]"},
+    /* 43 */ {"rel vortic", "relative vorticity [1/s]"},
+    /* 44 */ {"rel diverg", "relative divergence [1/s]"},
+    /* 45 */ {"vert.u-shr", "vertical u-component shear [1/s]"},
+    /* 46 */ {"vert.v-shr", "vertical v-component shear [1/s]"},
+    /* 47 */ {"dir of cur", "direction of current [degree true]"},
+    /* 48 */ {"spd of cur", "speed of current [m/s]"},
+    /* 49 */ {"currcomp U", "u-component of current [m/s]"},
+    /* 50 */ {"currcomp V", "v-component of current [m/s]"},
+    /* 51 */ {"QV", "specific humidity [kg/kg]"},
+    /* 52 */ {"RELHUM", "relative humidity [%]"},
+    /* 53 */ {"hum mixrat", "humidity mixing ratio [kg/kg]"},
+    /* 54 */ {"TQV", "total precipitable water [kg/m**2]"},
+    /* 55 */ {"vapor pres", "vapor pressure [Pa]"},
+    /* 56 */ {"sat.defic.", "saturation deficit [Pa]"},
+    /* 57 */ {"evaporat.", "evaporation [kg/(m**2)]"},
+    /* 58 */ {"TQI", "total cloud ice content [kg/m**2]"},
+    /* 59 */ {"prec. rate", "precipitation rate [kg/((m**2)*s)]"},
+    /* 60 */ {"thunderst.", "thunderstorm probability [%]"},
+    /* 61 */ {"TOT_PREC", "total precipitation [kg/(m**2)]"},
+    /* 62 */ {"ls precip.", "large scale precipitation [kg/(m**2)]"},
+    /* 63 */ {"conv prec.", "convective precipitation [kg/(m**2)]"},
+    /* 64 */ {"snowf.rate", "snowfall rate water equivalent [kg/((m**2)*s)]"},
+    /* 65 */ {"W_SNOW", "water equivalent of accumulated snow depth [kg/(m**2)]"},
+    /* 66 */ {"snow depth", "snow depth [m]"},
+    /* 67 */ {"mix lay de", "mixed layer depth [m]"},
+    /* 68 */ {"tr therm d", "transient thermocline depth [m]"},
+    /* 69 */ {"ma therm d", "main thermocline depth [m]"},
+    /* 70 */ {"m therm da", "main thermocline depth anomaly [m]"},
+    /* 71 */ {"CLCT", "total cloud cover [%]"},
+    /* 72 */ {"CLC_CON", "convective cloud cover [%]"},
+    /* 73 */ {"CLCL", "low cloud cover [%]"},
+    /* 74 */ {"CLCM", "medium cloud cover [%]"},
+    /* 75 */ {"CLCH", "high cloud cover [%]"},
+    /* 76 */ {"TQC", "total cloud water content [kg/m**2]"},
+    /* 77 */ {"bli to 500", "best lifted index (to 500 hPa) [K]"},
+    /* 78 */ {"SNOW_CON", "convective snow [kg/(m**2)]"},
+    /* 79 */ {"SNOW_GSP", "large scale snow [kg/(m**2)]"},
+    /* 80 */ {"water temp", "water temperature [K]"},
+    /* 81 */ {"FR_LAND", "land cover (1=land, 0=sea) [1]"},
+    /* 82 */ {"dev sea-le", "deviation of sea-level from mean [m]"},
+    /* 83 */ {"Z0", "surface roughness [m]"},
+    /* 84 */ {"ALB_RAD", "albedo [%]"},
+    /* 85 */ {"T_soil", "soil temperature [K]"},
+    /* 86 */ {"W_soil", "soil moisture content [kg/(m**2)]"},
+    /* 87 */ {"PLCOV", "vegetation (plant cover) [%]"},
+    /* 88 */ {"salinity", "salinity [kg/kg]"},
+    /* 89 */ {"density", "density [kg/(m**3)]"},
+    /* 90 */ {"RUNOFF", "water run-off [kg/(m**2)]"},
+    /* 91 */ {"FR_ICE", "ice cover (1=ice, 0=no ice) [1]"},
+    /* 92 */ {"H_ICE", "ice thickness [m]"},
+    /* 93 */ {"dir ice dr", "direction of ice drift [degree true]"},
+    /* 94 */ {"sp ice dr", "speed of ice drift [m/s]"},
+    /* 95 */ {"ice dr u", "u-component of ice drift [m/s]"},
+    /* 96 */ {"ice dr v", "v-component of ice drift [m/s]"},
+    /* 97 */ {"ice growth", "ice growth rate [m/s]"},
+    /* 98 */ {"ice diverg", "ice divergence [1/s]"},
+    /* 99 */ {"snow melt", "snow melt [kg/(m**2)]"},
+    /* 100 */ {"winwav/swe", "significant height of comb. wind waves and swell [m]"},
+    /* 101 */ {"dir of wav", "direction of wind waves [degree true]"},
+    /* 102 */ {"hei of wav", "significant height of wind waves [m]"},
+    /* 103 */ {"MP of wiwa", "mean period of wind waves [s]"},
+    /* 104 */ {"dir of swe", "direction of swell [degree true]"},
+    /* 105 */ {"hei of swe", "significant height of swell [m]"},
+    /* 106 */ {"MP of swel", "mean period of swell [s]"},
+    /* 107 */ {"pr wave di", "primary wave direction [degree true]"},
+    /* 108 */ {"pr wave pe", "primary wave period [s]"},
+    /* 109 */ {"se wave di", "secondary wave direction [degree true]"},
+    /* 110 */ {"se wave pe", "secondary wave period [s]"},
+    /* 111 */ {"ASOB_S", "net short-wave radiation (surface) [W/(m**2)]"},
+    /* 112 */ {"ATHB_S", "net long-wave radiation (surface) [W/(m**2)]"},
+    /* 113 */ {"ASOB_T", "net short-wave radiation (top of atmosphere) [W/(m**2)]"},
+    /* 114 */ {"ATHB_T", "net long-wave radiation (top of atmosphere) [W/(m**2)]"},
+    /* 115 */ {"l-w rad.", "long-wave radiation [W/(m**2)]"},
+    /* 116 */ {"s-w rad.", "short-wave radiation [W/(m**2)]"},
+    /* 117 */ {"global rad", "global radiation [W/(m**2)]"},
+    /* 118 */ {"var118", "undefined"},
+    /* 119 */ {"var119", "undefined"},
+    /* 120 */ {"var120", "undefined"},
+    /* 121 */ {"ALHFL_S", "latent heat flux [W/(m**2)]"},
+    /* 122 */ {"ASHFL_S", "sensible heat flux [W/(m**2)]"},
+    /* 123 */ {"bound l di", "boundary layer dissipation [W/(m**2)]"},
+    /* 124 */ {"AUMFL_S", "momentum flux, u component [N/(m**2)]"},
+    /* 125 */ {"AVMFL_S", "momentum flux, v component [N/(m**2)]"},
+    /* 126 */ {"wind mix e", "wind mixing energy [J]"},
+    /* 127 */ {"image data", "image data []"},
+    /* 128 */ {"var128", "undefined"},
+    /* 129 */ {"geopot h", "geopotential height (ECMF) [gpm]"},
+    /* 130 */ {"temperatur", "temperature (ECMF) [K]"},
+    /* 131 */ {"wind compU", "u-component of wind (ECMF) [m/s]"},
+    /* 132 */ {"wind compV", "v-component of wind (ECMF) [m/s]"},
+    /* 133 */ {"var133", "undefined"},
+    /* 134 */ {"var134", "undefined"},
+    /* 135 */ {"var135", "undefined"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"var137", "undefined"},
+    /* 138 */ {"var138", "undefined"},
+    /* 139 */ {"soil temp.", "soil temperature (ECMF) [K]"},
+    /* 140 */ {"var140", "undefined"},
+    /* 141 */ {"var141", "undefined"},
+    /* 142 */ {"ls precip.", "large scale precipitation (ECMF) [kg/(m**2)]"},
+    /* 143 */ {"conv prec.", "convective precipitation (ECMF) [kg/(m**2)]"},
+    /* 144 */ {"snowfall", "snowfall (ECMF) [m of water equivalent]"},
+    /* 145 */ {"var145", "undefined"},
+    /* 146 */ {"var146", "undefined"},
+    /* 147 */ {"var147", "undefined"},
+    /* 148 */ {"var148", "undefined"},
+    /* 149 */ {"var149", "undefined"},
+    /* 150 */ {"var150", "undefined"},
+    /* 151 */ {"pressure", "pressure reduced to MSL (ECMF) [Pa]"},
+    /* 152 */ {"var152", "undefined"},
+    /* 153 */ {"var153", "undefined"},
+    /* 154 */ {"var154", "undefined"},
+    /* 155 */ {"var155", "undefined"},
+    /* 156 */ {"geopot h", "geopotential height (ECMF) [gpm]"},
+    /* 157 */ {"rel. humid", "relative humidity (ECMF) [%]"},
+    /* 158 */ {"var158", "undefined"},
+    /* 159 */ {"var159", "undefined"},
+    /* 160 */ {"var160", "undefined"},
+    /* 161 */ {"var161", "undefined"},
+    /* 162 */ {"var162", "undefined"},
+    /* 163 */ {"var163", "undefined"},
+    /* 164 */ {"cloud cov.", "total cloud cover (ECMF) [%]"},
+    /* 165 */ {"10m-wind U", "u-component of 10m-wind (ECMF) [m/s]"},
+    /* 166 */ {"10m-wind V", "v-component of 10m-wind (ECMF) [m/s]"},
+    /* 167 */ {"2m temper", "2m temperature (ECMF) [K]"},
+    /* 168 */ {"2m due-p.", "2m due-point temperature (ECMF) [K]"},
+    /* 169 */ {"var169", "undefined"},
+    /* 170 */ {"var170", "undefined"},
+    /* 171 */ {"var171", "undefined"},
+    /* 172 */ {"var172", "undefined"},
+    /* 173 */ {"var173", "undefined"},
+    /* 174 */ {"var174", "undefined"},
+    /* 175 */ {"var175", "undefined"},
+    /* 176 */ {"var176", "undefined"},
+    /* 177 */ {"var177", "undefined"},
+    /* 178 */ {"var178", "undefined"},
+    /* 179 */ {"var179", "undefined"},
+    /* 180 */ {"var180", "undefined"},
+    /* 181 */ {"var181", "undefined"},
+    /* 182 */ {"var182", "undefined"},
+    /* 183 */ {"var183", "undefined"},
+    /* 184 */ {"var184", "undefined"},
+    /* 185 */ {"var185", "undefined"},
+    /* 186 */ {"var186", "undefined"},
+    /* 187 */ {"var187", "undefined"},
+    /* 188 */ {"var188", "undefined"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"var190", "undefined"},
+    /* 191 */ {"var191", "undefined"},
+    /* 192 */ {"var192", "undefined"},
+    /* 193 */ {"var193", "undefined"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"var195", "undefined"},
+    /* 196 */ {"var196", "undefined"},
+    /* 197 */ {"var197", "undefined"},
+    /* 198 */ {"var198", "undefined"},
+    /* 199 */ {"var199", "undefined"},
+    /* 200 */ {"var200", "undefined"},
+    /* 201 */ {"var201", "undefined"},
+    /* 202 */ {"var202", "undefined"},
+    /* 203 */ {"var203", "undefined"},
+    /* 204 */ {"var204", "undefined"},
+    /* 205 */ {"var205", "undefined"},
+    /* 206 */ {"var206", "undefined"},
+    /* 207 */ {"var207", "undefined"},
+    /* 208 */ {"var208", "undefined"},
+    /* 209 */ {"var209", "undefined"},
+    /* 210 */ {"var210", "undefined"},
+    /* 211 */ {"var211", "undefined"},
+    /* 212 */ {"var212", "undefined"},
+    /* 213 */ {"var213", "undefined"},
+    /* 214 */ {"var214", "undefined"},
+    /* 215 */ {"var215", "undefined"},
+    /* 216 */ {"var216", "undefined"},
+    /* 217 */ {"var217", "undefined"},
+    /* 218 */ {"var218", "undefined"},
+    /* 219 */ {"var219", "undefined"},
+    /* 220 */ {"var220", "undefined"},
+    /* 221 */ {"var221", "undefined"},
+    /* 222 */ {"var222", "undefined"},
+    /* 223 */ {"var223", "undefined"},
+    /* 224 */ {"var224", "undefined"},
+    /* 225 */ {"var225", "undefined"},
+    /* 226 */ {"var226", "undefined"},
+    /* 227 */ {"var227", "undefined"},
+    /* 228 */ {"total prec", "total precipitation (ECMF) [m]"},
+    /* 229 */ {"seaway 01", "seaway 01 (ECMF) []"},
+    /* 230 */ {"seaway 02", "seaway 02 (ECMF) []"},
+    /* 231 */ {"seaway 03", "seaway 03 (ECMF) []"},
+    /* 232 */ {"seaway 04", "seaway 04 (ECMF) []"},
+    /* 233 */ {"seaway 05", "seaway 05 (ECMF) []"},
+    /* 234 */ {"seaway 06", "seaway 06 (ECMF) []"},
+    /* 235 */ {"seaway 07", "seaway 07 (ECMF) []"},
+    /* 236 */ {"seaway 08", "seaway 08 (ECMF) []"},
+    /* 237 */ {"seaway 09", "seaway 09 (ECMF) []"},
+    /* 238 */ {"seaway 10", "seaway 10 (ECMF) []"},
+    /* 239 */ {"seaway 11", "seaway 11 (ECMF) []"},
+    /* 240 */ {"var240", "undefined"},
+    /* 241 */ {"var241", "undefined"},
+    /* 242 */ {"var242", "undefined"},
+    /* 243 */ {"var243", "undefined"},
+    /* 244 */ {"var244", "undefined"},
+    /* 245 */ {"var245", "undefined"},
+    /* 246 */ {"var246", "undefined"},
+    /* 247 */ {"var247", "undefined"},
+    /* 248 */ {"var248", "undefined"},
+    /* 249 */ {"var249", "undefined"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_201.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_201.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_201.c	(revision 2744)
@@ -0,0 +1,266 @@
+#include "cnames.h"
+
+/*
+ * GRIB table 201 at DWD
+ *     Helmut P. Frank, 30.08.2001
+ * updated 24.07.2003:  DQC_GSP, DQI_GSP, T_SO, W_SO, W_SO_ICE, T_ICE
+ */
+
+struct ParmTable parm_table_dwd_201[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"dw sw flux", "downward shortwave radiant flux density [W/m**2]"},
+    /* 2 */ {"uw sw flux", "upward shortwave radiant flux density [W/m**2]"},
+    /* 3 */ {"dw lw flux", "downward longwave radiant flux density [W/m**2]"},
+    /* 4 */ {"uw lw flux", "upward longwave radiant flux density [W/m**2]"},
+    /* 5 */ {"APAB_S", "downwd photosynthetic active radiant flux density [W/m**2]"},
+    /* 6 */ {"net s flux", "net shortwave flux [W/m**2]"},
+    /* 7 */ {"net l flux", "net longwave flux [W/m**2]"},
+    /* 8 */ {"net flux", "total net radiative flux density [W/m**2]"},
+    /* 9 */ {"dw sw clfr", "downw shortw radiant flux density, cloudfree part [W/m**2]"},
+    /* 10 */ {"uw sw cldy", "upw shortw radiant flux density, cloudy part [W/m**2]"},
+    /* 11 */ {"dw lw clfr", "downw longw radiant flux density, cloudfree part [W/m**2]"},
+    /* 12 */ {"uw lw cldy", "upw longw radiant flux density, cloudy part [W/m**2]"},
+    /* 13 */ {"SOHR_RAD", "shortwave radiative heating rate [K/s]"},
+    /* 14 */ {"THHR_RAD", "longwave radiative heating rate [K/s]"},
+    /* 15 */ {"rad heat", "total radiative heating rate [K/s]"},
+    /* 16 */ {"soilheat S", "soil heat flux, surface [W/m**2]"},
+    /* 17 */ {"soilheat L", "soil heat flux, bottom of layer [W/m**2]"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"var19", "undefined"},
+    /* 20 */ {"var20", "undefined"},
+    /* 21 */ {"var21", "undefined"},
+    /* 22 */ {"var22", "undefined"},
+    /* 23 */ {"var23", "undefined"},
+    /* 24 */ {"var24", "undefined"},
+    /* 25 */ {"var25", "undefined"},
+    /* 26 */ {"var26", "undefined"},
+    /* 27 */ {"var27", "undefined"},
+    /* 28 */ {"var28", "undefined"},
+    /* 29 */ {"CLC", "cloud cover, grid scale + convective [1]"},
+    /* 30 */ {"clc gr sc", "cloud cover, grid scale  (0...1) [1]"},
+    /* 31 */ {"QC", "specific cloud water content, grid scale [kg/kg]"},
+    /* 32 */ {"clw gs vi", "cloud water content, grid scale, vert integrated [kg/m**2]"},
+    /* 33 */ {"QI", "specific cloud ice   content, grid scale [kg/kg]"},
+    /* 34 */ {"cli gs vi", "cloud ice content, grid scale, vert integrated [kg/m**2]"},
+    /* 35 */ {"src gr sc", "specific rainwater content, grid scale [kg/kg]"},
+    /* 36 */ {"ssc gr sc", "specific snow content, grid scale [kg/kg]"},
+    /* 37 */ {"src gs vi", "specific rainwater content, gs, vert. integrated [kg/m**2]"},
+    /* 38 */ {"ssc gs vi", "specific snow content, gs, vert. integrated [kg/m**2]"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"var40", "undefined"},
+    /* 41 */ {"tot water", "vert. integral of humidity, cloud water (and ice) [kg/(m**2)]"},
+    /* 42 */ {"hum div", "vert. integral of divergence of tot. water content [kg/(m**2)]"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"var44", "undefined"},
+    /* 45 */ {"var45", "undefined"},
+    /* 46 */ {"var46", "undefined"},
+    /* 47 */ {"var47", "undefined"},
+    /* 48 */ {"var48", "undefined"},
+    /* 49 */ {"var49", "undefined"},
+    /* 50 */ {"CH_CM_CL", "cloud covers CH_CM_CL (000...888) [1]"},
+    /* 51 */ {"cl cov. CH", "cloud cover CH (0..8) [1]"},
+    /* 52 */ {"cl cov. CM", "cloud cover CM (0..8) [1]"},
+    /* 53 */ {"cl cov. CL", "cloud cover CL (0..8) [1]"},
+    /* 54 */ {"cloud cov.", "total cloud cover (0..8) [1]"},
+    /* 55 */ {"fog", "fog (0..8) [1]"},
+    /* 56 */ {"fog", "fog [1]"},
+    /* 57 */ {"var57", "undefined"},
+    /* 58 */ {"var58", "undefined"},
+    /* 59 */ {"var59", "undefined"},
+    /* 60 */ {"clc con ci", "cloud cover, convective cirrus  (0...1) [1]"},
+    /* 61 */ {"clw con", "specific cloud water content, convective clouds [kg/kg]"},
+    /* 62 */ {"clw con vi", "cloud water content, conv clouds, vert integrated [kg/m**2]"},
+    /* 63 */ {"cli con", "specific cloud ice content, convective clouds [kg/kg]"},
+    /* 64 */ {"cli con vi", "cloud ice content, conv clouds, vert integrated [kg/m**2]"},
+    /* 65 */ {"mass fl co", "convective mass flux [kg/(s*m**2)]"},
+    /* 66 */ {"upd vel co", "updraft velocity, convection [m/s]"},
+    /* 67 */ {"entr p co", "entrainment parameter, convection [m**(-1)]"},
+    /* 68 */ {"HBAS_CON", "cloud base, convective clouds (above msl) [m]"},
+    /* 69 */ {"HTOP_CON", "cloud top, convective clouds (above msl) [m]"},
+    /* 70 */ {"con layers", "convective layers (00...77)  (BKE) [1]"},
+    /* 71 */ {"KO-index", "KO-index [1]"},
+    /* 72 */ {"BAS_CON", "convection base index [1]"},
+    /* 73 */ {"TOP_CON", "convection top index [1]"},
+    /* 74 */ {"DT_CON", "convective temperature tendency [K/s]"},
+    /* 75 */ {"DQV_CON", "convective tendency of specific humidity [s**(-1)]"},
+    /* 76 */ {"H ten co", "convective tendency of total heat [J/(kg*s)]"},
+    /* 77 */ {"QDW ten co", "convective tendency of total water [s**(-1)]"},
+    /* 78 */ {"DU_CON", "convective momentum tendency (X-component) [m/s**2]"},
+    /* 79 */ {"DV_CON", "convective momentum tendency (Y-component) [m/s**2]"},
+    /* 80 */ {"vor ten co", "convective vorticity tendency [s**(-2)]"},
+    /* 81 */ {"div ten co", "convective divergence tendency [s**(-2)]"},
+    /* 82 */ {"HTOP_DC", "top of dry convection (above msl) [m]"},
+    /* 83 */ {"top ind dc", "dry convection top index [1]"},
+    /* 84 */ {"HZEROCL", "height of 0 degree Celsius isotherm above msl [m]"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"var86", "undefined"},
+    /* 87 */ {"var87", "undefined"},
+    /* 88 */ {"var88", "undefined"},
+    /* 89 */ {"var89", "undefined"},
+    /* 90 */ {"var90", "undefined"},
+    /* 91 */ {"var91", "undefined"},
+    /* 92 */ {"var92", "undefined"},
+    /* 93 */ {"var93", "undefined"},
+    /* 94 */ {"var94", "undefined"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"QRS_GSP", "spec. content of precip. particles [kg/kg]"},
+    /* 100 */ {"PRR_GSP", "surface precipitation rate, rain, grid scale [kg/(s*m**2)]"},
+    /* 101 */ {"PRS_GSP", "surface precipitation rate, snow, grid scale [kg/(s*m**2)]"},
+    /* 102 */ {"RAIN_GSP", "surface precipitation amount, rain, grid scale [kg/m**2]"},
+    /* 103 */ {"condens gs", "condensation rate, grid scale [kg/(kg*s)]"},
+    /* 104 */ {"autocon gs", "autoconversion rate, grid scale   (C+C  --> R) [kg/(kg*s)]"},
+    /* 105 */ {"accret gs", "accretion rate, grid scale        (R+C  --> R) [kg/(kg*s)]"},
+    /* 106 */ {"nucleat gs", "nucleation rate, grid scale       (C+C  --> S) [kg/(kg*s)]"},
+    /* 107 */ {"riming gs", "riming rate, grid scale           (S+C  --> S) [kg/(kg*s)]"},
+    /* 108 */ {"deposit gs", "deposition rate, grid scale       (S+V <--> S) [kg/(kg*s)]"},
+    /* 109 */ {"melting gs", "melting rate, grid scale          (S    --> R) [kg/(kg*s)]"},
+    /* 110 */ {"evapor gs", "evaporation rate, grid scale      (R+V <--  R) [kg/(kg*s)]"},
+    /* 111 */ {"PRR_CON", "surface precipitation rate, rain, convective [kg/(s*m**2)]"},
+    /* 112 */ {"PRS_CON", "surface precipitation rate, snow, convective [kg/(s*m**2)]"},
+    /* 113 */ {"RAIN_CON", "surface precipitation amount, rain, convective [kg/m**2]"},
+    /* 114 */ {"condens co", "condensation rate, convective [kg/(kg*s)]"},
+    /* 115 */ {"autocon co", "autoconversion rate, convective [kg/(kg*s)]"},
+    /* 116 */ {"accret co", "accretion rate, convective [kg/(kg*s)]"},
+    /* 117 */ {"nucleat co", "nucleation rate, convective [kg/(kg*s)]"},
+    /* 118 */ {"riming co", "riming rate, convective [kg/(kg*s)]"},
+    /* 119 */ {"sublim co", "sublimation rate, convective [kg/(kg*s)]"},
+    /* 120 */ {"melting co", "melting rate, convective [kg/(kg*s)]"},
+    /* 121 */ {"evapor co", "evaporation rate, convective [kg/(kg*s)]"},
+    /* 122 */ {"rain am", "rain amount, grid-scale plus convective [kg/m**2]"},
+    /* 123 */ {"snow am", "snow amount, grid-scale plus convective [kg/m**2]"},
+    /* 124 */ {"DT_GSP", "temperature tendency, grid-scale condensation [K/s]"},
+    /* 125 */ {"DQV_GSP", "tendency of specific humidity, grid-scale precip. [s**(-1)]"},
+    /* 126 */ {"H ten gs", "tendency of total heat, grid-scale condensation [J/(kg*s)]"},
+    /* 127 */ {"DQC_GSP", "tendency of spec. clod liquid water due to grid-scale precip. [s**(-1)]"},
+    /* 128 */ {"snowfall", "snowfall  (dimension"},
+    /* 129 */ {"DQI_GSP", "tendency of spec. cloud ice due to grid-scale precip. [s**(-1)]"},
+    /* 130 */ {"var130", "undefined"},
+    /* 131 */ {"var131", "undefined"},
+    /* 132 */ {"var132", "undefined"},
+    /* 133 */ {"var133", "undefined"},
+    /* 134 */ {"var134", "undefined"},
+    /* 135 */ {"var135", "undefined"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"var137", "undefined"},
+    /* 138 */ {"var138", "undefined"},
+    /* 139 */ {"pprime", "deviation of pressure from reference value [Pa]"},
+    /* 140 */ {"var140", "undefined"},
+    /* 141 */ {"var141", "undefined"},
+    /* 142 */ {"var142", "undefined"},
+    /* 143 */ {"var143", "undefined"},
+    /* 144 */ {"var144", "undefined"},
+    /* 145 */ {"var145", "undefined"},
+    /* 146 */ {"var146", "undefined"},
+    /* 147 */ {"var147", "undefined"},
+    /* 148 */ {"var148", "undefined"},
+    /* 149 */ {"var149", "undefined"},
+    /* 150 */ {"hdi coeff", "coefficient of horizontal diffusion [m**2/s]"},
+    /* 151 */ {"dissp rate", "dissipation rate [W/(Pa*m**2)]"},
+    /* 152 */ {"TKE", "turbulent kinetic energy [(m/s)**2]"},
+    /* 153 */ {"TKVM", "coefficient of vertical diffusion, momentum [m**2/s]"},
+    /* 154 */ {"TKVH", "coefficient of vertical diffusion, heat [m**2/s]"},
+    /* 155 */ {"vdi coe cw", "coefficient of vertical diffusion, cloud water [m**2/s]"},
+    /* 156 */ {"vdi coe ci", "coefficient of vertical diffusion, cloud ice [m**2/s]"},
+    /* 157 */ {"vdi coe vp", "coefficient of vertical diffusion, water vapour [m**2/s]"},
+    /* 158 */ {"dis len m", "turbulent dissipation length for momentum [m]"},
+    /* 159 */ {"dis len h", "turbulent dissipation length for heat [m]"},
+    /* 160 */ {"var u mom", "variance of u-component of momentum [(m/s)**2]"},
+    /* 161 */ {"var v mom", "variance of v-component of momentum [(m/s)**2]"},
+    /* 162 */ {"var w mom", "variance of w-component of momentum [(m/s)**2]"},
+    /* 163 */ {"var temp", "variance of temperature [K**2]"},
+    /* 164 */ {"var cl wat", "variance of specific cloud water content [(kg/kg)**2]"},
+    /* 165 */ {"var cl ice", "variance of specific cloud ice content [(kg/kg)**2]"},
+    /* 166 */ {"var vap mr", "variance of water vapour mixing ratio [(kg/kg)**2]"},
+    /* 167 */ {"c wat flux", "turbulent vertical flux of spec cloud water [m/s]"},
+    /* 168 */ {"c ice flux", "turbulent vertical flux of spec cloud ice [m/s]"},
+    /* 169 */ {"w vap flux", "turbulent vertical flux of water vapour mix ratio [m/s]"},
+    /* 170 */ {"TCM", "drag coefficient CD [1]"},
+    /* 171 */ {"TCH", "transfer coefficient CH (sensible heat) [1]"},
+    /* 172 */ {"tr coef CQ", "transfer coefficient CQ (latent heat) [1]"},
+    /* 173 */ {"PBL-top h", "PBL-top h [m]"},
+    /* 174 */ {"T-jump  h", "temperature jump at PBL-top [K]"},
+    /* 175 */ {"q-jump  h", "specific humidity jump at PBL-top [kg/kg]"},
+    /* 176 */ {"entr at h", "entrainment at PBL-top [kg/(s*m**2)]"},
+    /* 177 */ {"mass fl h", "upward mass flux at PBL-top [kg/(s*m**2)]"},
+    /* 178 */ {"cl cov PBL", "cloud cover of PBL-clouds (0...1) [1]"},
+    /* 179 */ {"cl wat PBL", "specific cloud water content of PBL-clouds [kg/kg]"},
+    /* 180 */ {"cl top PBL", "cloud top of PBL-clouds [m]"},
+    /* 181 */ {"cl bas PBL", "cloud base of PBL-clouds [m]"},
+    /* 182 */ {"moun wav X", "vertical mountain wave momentum flux (X component) [kg/(m*s**2)]"},
+    /* 183 */ {"moun wav Y", "vertical mountain wave momentum flux (Y component) [kg/(m*s**2)]"},
+    /* 184 */ {"wave Ri", "wave Richardson number [1]"},
+    /* 185 */ {"wav div X", "mountain wave momentum flux divergence (X comp) [m/s**2]"},
+    /* 186 */ {"wav div Y", "mountain wave momentum flux divergence (Y comp) [m/s**2]"},
+    /* 187 */ {"VMAX_10M", "maximum wind velocity [m/s]"},
+    /* 188 */ {"wav dis vi", "mountain wave dissipation, vert integrated [W/m**2]"},
+    /* 189 */ {"wv en flux", "vertical wave energy flux [kg*m/s**4]"},
+    /* 190 */ {"var190", "undefined"},
+    /* 191 */ {"var191", "undefined"},
+    /* 192 */ {"var192", "undefined"},
+    /* 193 */ {"var193", "undefined"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"var195", "undefined"},
+    /* 196 */ {"var196", "undefined"},
+    /* 197 */ {"T_SO", "soil temperature [K]"},
+    /* 198 */ {"W_SO", "soil water content [kg/m**2]"},
+    /* 199 */ {"W_SO_ICE", "soil ice water content [kg/m**2]"},
+    /* 200 */ {"W_I", "water content of interception store [kg/(m**2)]"},
+    /* 201 */ {"interc ice", "icebit for interception store [1]"},
+    /* 202 */ {"snow fract", "snow fraction [1]"},
+    /* 203 */ {"T_SNOW", "snow temperature [K]"},
+    /* 204 */ {"foliag tem", "foliage temperature [K]"},
+    /* 205 */ {"infiltrat", "infiltration [m/s]"},
+    /* 206 */ {"runoff", "runoff [m/s]"},
+    /* 207 */ {"soil evap", "bare soil evaporation [m/s]"},
+    /* 208 */ {"plant tran", "plant transpiration [m/s]"},
+    /* 209 */ {"inter evap", "interception store evaporation [m/s]"},
+    /* 210 */ {"water evap", "evaporation from water surfaces [m/s]"},
+    /* 211 */ {"aero resis", "aerodynamic resistance [s/m]"},
+    /* 212 */ {"plant res", "plant resistance [s/m]"},
+    /* 213 */ {"soil res", "soil resistance [s/m]"},
+    /* 214 */ {"total evap", "total evaporation (water, soil, plants) [m/s]"},
+    /* 215 */ {"T_ICE", "ice surface temperature [K]"},
+    /* 216 */ {"var216", "undefined"},
+    /* 217 */ {"var217", "undefined"},
+    /* 218 */ {"var218", "undefined"},
+    /* 219 */ {"var219", "undefined"},
+    /* 220 */ {"var220", "undefined"},
+    /* 221 */ {"var221", "undefined"},
+    /* 222 */ {"var222", "undefined"},
+    /* 223 */ {"var223", "undefined"},
+    /* 224 */ {"var224", "undefined"},
+    /* 225 */ {"var225", "undefined"},
+    /* 226 */ {"var226", "undefined"},
+    /* 227 */ {"var227", "undefined"},
+    /* 228 */ {"var228", "undefined"},
+    /* 229 */ {"var229", "undefined"},
+    /* 230 */ {"XYZ", "S1 [1]"},
+    /* 231 */ {"S2", "S2 [1]"},
+    /* 232 */ {"S3", "S3 [1]"},
+    /* 233 */ {"S4", "S4 [1]"},
+    /* 234 */ {"S5", "S5 [1]"},
+    /* 235 */ {"S6", "S6 [1]"},
+    /* 236 */ {"S7", "S7 [1]"},
+    /* 237 */ {"S8", "S8 [1]"},
+    /* 238 */ {"S9", "S9 [1]"},
+    /* 239 */ {"S10", "S10 [1]"},
+    /* 240 */ {"S11", "S11 [1]"},
+    /* 241 */ {"OBS TS oc", "OBS Gewitter (occasional) [1]"},
+    /* 242 */ {"OBS TS fq", "OBS Gewitter (frequent) [1]"},
+    /* 243 */ {"MOS pTS oc", "MOS Gewitter-Wahrscheinlichkeit (occasional) [1]"},
+    /* 244 */ {"MOS pTS fq", "MOS Gewitter-Wahrscheinlichkeit (frequent) [1]"},
+    /* 245 */ {"MOS TS cov", "MOS Gewitteranteil (occasional - frequent (1 - 2)) [1]"},
+    /* 246 */ {"S17", "S17 [1]"},
+    /* 247 */ {"S18", "S18 [1]"},
+    /* 248 */ {"S19", "S19 [1]"},
+    /* 249 */ {"S20", "S20 [1]"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_202.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_202.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_202.c	(revision 2744)
@@ -0,0 +1,267 @@
+#include "cnames.h"
+
+/*
+ * GRIB table 202 at DWD
+ *     Helmut P. Frank, 30.08.2001
+ * updated 24.07.2003: UV_Ind_F_h, BasicUV_IF, UV_Ind_W_h, UV_IndmaxF,
+ *                     "gesamt O3", UV_IndmaxW, "h UV_IndMx"
+ */
+
+struct ParmTable parm_table_dwd_202[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"Seeg_peak", "jonswap parameter fm [s**(-1)]"},
+    /* 2 */ {"Seeg_alpha", "jonswap parameter alpha [1]"},
+    /* 3 */ {"Seeg_gamma", "jonswap parameter gamma [1]"},
+    /* 4 */ {"Seeg_dir", "Seegang direction [degree true]"},
+    /* 5 */ {"Seeg_energ", "Seegang energy densitiy [(m**2)*(s**2)]"},
+    /* 6 */ {"Seeg_icemk", "Seegang ice mask [1]"},
+    /* 7 */ {"peak p sw", "peak period of swell [s]"},
+    /* 8 */ {"peak p ww", "peak period of wind waves [s]"},
+    /* 9 */ {"var9", "undefined"},
+    /* 10 */ {"var10", "undefined"},
+    /* 11 */ {"var11", "undefined"},
+    /* 12 */ {"var12", "undefined"},
+    /* 13 */ {"var13", "undefined"},
+    /* 14 */ {"var14", "undefined"},
+    /* 15 */ {"var15", "undefined"},
+    /* 16 */ {"var16", "undefined"},
+    /* 17 */ {"var17", "undefined"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"var19", "undefined"},
+    /* 20 */ {"Var. Geop.", "Varianz Geopotential [(m/s)**4]"},
+    /* 21 */ {"Var. T", "Varianz Temperatur [K**2]"},
+    /* 22 */ {"Var. u", "Varianz Zonalwind [(m/s)**2]"},
+    /* 23 */ {"Var. v", "Varianz Meridionalwind [(m/s)**2]"},
+    /* 24 */ {"Var. q", "Varianz spezifische Feuchte [(kg/kg)**2]"},
+    /* 25 */ {"Mer. Imptr", "Meridionaler Impulstransport [(m/s)**2]"},
+    /* 26 */ {"Mer. TrEpt", "Meridionaler Transport potentieller Energie [(m/s)**3]"},
+    /* 27 */ {"Mer. TrsW", "Meridionaler Transport sensibler Waerme [K*(m/s)]"},
+    /* 28 */ {"Mer. TrlW", "Meridionaler Transport latenter Waerme [(kg/kg)*(m/s)]"},
+    /* 29 */ {"Ver. TrEpt", "Vertikaler Transport potentieller Energie [(m/s)**2*(Pa/s)]"},
+    /* 30 */ {"Ver. TrsW", "Vertikaler Transport sensibler Waerme [K*(Pa/s)]"},
+    /* 31 */ {"Ver.TrlW", "Vertikaler Transport latenter Waerme [(kg/kg)*(Pa/s)]"},
+    /* 32 */ {"var32", "undefined"},
+    /* 33 */ {"var33", "undefined"},
+    /* 34 */ {"var34", "undefined"},
+    /* 35 */ {"var35", "undefined"},
+    /* 36 */ {"var36", "undefined"},
+    /* 37 */ {"var37", "undefined"},
+    /* 38 */ {"var38", "undefined"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"VarAF Geop", "Varianz des Analyse-Fehlers Geopotential [(m/s)**4]"},
+    /* 41 */ {"VarAF u", "Varianz des Analyse-Fehlers Zonalwind [(m/s)**2]"},
+    /* 42 */ {"VarAF v", "Varianz des Analyse-Fehlers Meridionalwind [(m/s)**2]"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"DU_SSO", "undefined"},
+    /* 45 */ {"DV_SSO", "undefined"},
+    /* 46 */ {"SSO_STDH", "standard deviation of subgrid scale orogr. height [m]"},
+    /* 47 */ {"SSO_GAMMA", "anisotropy of topography [1]"},
+    /* 48 */ {"SSO_THETA", "angle betw. principal axis of orogr. and global E [1]"},
+    /* 49 */ {"SSO_SIGMA", "mean slope of subgrid scale orography [1]"},
+    /* 50 */ {"oro varian", "subgrid-scale variance of orography [m**2]"},
+    /* 51 */ {"E-W oro va", "E-W component of subgrid-scale variance of orogr [m**2]"},
+    /* 52 */ {"N-S oro va", "N-S component of subgrid-scale variance of orogr [m**2]"},
+    /* 53 */ {"NW-SE o va", "NW-SE component of subgrid-scale variance of orogr [m**2]"},
+    /* 54 */ {"NE-SW o va", "NE-SW component of subgrid-scale variance of orogr [m**2]"},
+    /* 55 */ {"inl w frac", "fraction of inland water [1]"},
+    /* 56 */ {"surf emiss", "surface emissivity [1]"},
+    /* 57 */ {"SOILTYP", "soil texture [1]"},
+    /* 58 */ {"soil color", "soil color [1]"},
+    /* 59 */ {"soil drain", "soil drainage [1]"},
+    /* 60 */ {"ground wat", "ground water table [m]"},
+    /* 61 */ {"LAI", "leaf area index [1]"},
+    /* 62 */ {"ROOT", "root depth [m]"},
+    /* 63 */ {"root dens", "root density [1]"},
+    /* 64 */ {"HMO3", "height of maximum of ozone concentration [Pa]"},
+    /* 65 */ {"VIO3", "total vertically integrated ozone content [Pa]"},
+    /* 66 */ {"ld-sea msk", "land-sea mask [1]"},
+    /* 67 */ {"PLCOV_MX", "ground fraction covered by plants (vegetation p.) [1]"},
+    /* 68 */ {"PLCOV_MN", "ground fraction covered by plants (time of rest) [1]"},
+    /* 69 */ {"LAI_MX", "leaf area index (vegetation period) [1]"},
+    /* 70 */ {"LAI_MN", "leaf area index (time of rest) [1]"},
+    /* 71 */ {"Orographie", "Orographie + Land-Meer-Verteilung [m]"},
+    /* 72 */ {"r length m", "roughness length momentum [m]"},
+    /* 73 */ {"r length h", "roughness length heat [m]"},
+    /* 74 */ {"var smc", "variance of soil moisture content [kg**2/m**4]"},
+    /* 75 */ {"FOR_E", "fractional coverage with evergreen forest [1]"},
+    /* 76 */ {"FOR_D", "fractional coverage with deciduous forest [1]"},
+    /* 77 */ {"var77", "undefined"},
+    /* 78 */ {"var78", "undefined"},
+    /* 79 */ {"var79", "undefined"},
+    /* 80 */ {"var80", "undefined"},
+    /* 81 */ {"var81", "undefined"},
+    /* 82 */ {"var82", "undefined"},
+    /* 83 */ {"var83", "undefined"},
+    /* 84 */ {"var84", "undefined"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"var86", "undefined"},
+    /* 87 */ {"var87", "undefined"},
+    /* 88 */ {"var88", "undefined"},
+    /* 89 */ {"var89", "undefined"},
+    /* 90 */ {"var90", "undefined"},
+    /* 91 */ {"var91", "undefined"},
+    /* 92 */ {"var92", "undefined"},
+    /* 93 */ {"var93", "undefined"},
+    /* 94 */ {"var94", "undefined"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"AER_DES", "undefined"},
+    /* 100 */ {"var100", "undefined"},
+    /* 101 */ {"tidal tend", "tidal tendencies [(m/s)**2]"},
+    /* 102 */ {"diab heatg", "sum of diabatic heating terms [K/s]"},
+    /* 103 */ {"adiab heat", "total adiabatic heating [K/s]"},
+    /* 104 */ {"adv q tend", "advective tendency of specific humidity [s**(-1)]"},
+    /* 105 */ {"nadv q ten", "non-advective tendency of specific humidity [s**(-1)]"},
+    /* 106 */ {"adv m te X", "advective momentum tendency (X component) [m/s**2]"},
+    /* 107 */ {"adv m te Y", "advective momentum tendency (Y component) [m/s**2]"},
+    /* 108 */ {"nad m te X", "non-advective momentum tendency (X component) [m/s**2]"},
+    /* 109 */ {"nad m te Y", "non-advective momentum tendency (Y component) [m/s**2]"},
+    /* 110 */ {"torque", "sum of mountain and frictional torque [kg*(m/s)**2]"},
+    /* 111 */ {"budget val", "budget values [1]"},
+    /* 112 */ {"scale fact", "scale factor [1]"},
+    /* 113 */ {"Coriol par", "Coriolis parameter [s**(-1)]"},
+    /* 114 */ {"PHI", "latitude [degr N]"},
+    /* 115 */ {"RLA", "longitude [degr E]"},
+    /* 116 */ {"relax fact", "relaxation factor (lateral boundary, LAM) [1]"},
+    /* 117 */ {"climsstint", "climatic sea surface temp interpolated in time [degr C]"},
+    /* 118 */ {"pot vortic", "potential vorticity [K*m**2/(s*kg)]"},
+    /* 119 */ {"ln ps", "log surface pressure [1]"},
+    /* 120 */ {"EXP_SI", "undefined"},
+    /* 121 */ {"RHS_SI", "undefined"},
+    /* 122 */ {"DTTDIV", "undefined"},
+    /* 123 */ {"var123", "undefined"},
+    /* 124 */ {"var124", "undefined"},
+    /* 125 */ {"var125", "undefined"},
+    /* 126 */ {"var126", "undefined"},
+    /* 127 */ {"var127", "undefined"},
+    /* 128 */ {"var128", "undefined"},
+    /* 129 */ {"var129", "undefined"},
+    /* 130 */ {"var130", "undefined"},
+    /* 131 */ {"var131", "undefined"},
+    /* 132 */ {"var132", "undefined"},
+    /* 133 */ {"var133", "undefined"},
+    /* 134 */ {"var134", "undefined"},
+    /* 135 */ {"var135", "undefined"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"var137", "undefined"},
+    /* 138 */ {"var138", "undefined"},
+    /* 139 */ {"var139", "undefined"},
+    /* 140 */ {"var140", "undefined"},
+    /* 141 */ {"var141", "undefined"},
+    /* 142 */ {"var142", "undefined"},
+    /* 143 */ {"var143", "undefined"},
+    /* 144 */ {"var144", "undefined"},
+    /* 145 */ {"var145", "undefined"},
+    /* 146 */ {"var146", "undefined"},
+    /* 147 */ {"var147", "undefined"},
+    /* 148 */ {"var148", "undefined"},
+    /* 149 */ {"var149", "undefined"},
+    /* 150 */ {"SO2-conc", "SO2-concentration [10**(-6)*g/m**3]"},
+    /* 151 */ {"SO2-dryd", "SO2-dry deposition [10**(-3)*g/m**2]"},
+    /* 152 */ {"SO2-wetd", "SO2-wet deposition [10**(-3)*g/m**2]"},
+    /* 153 */ {"SO4-conc", "SO4-concentration [10**(-6)*g/m**3]"},
+    /* 154 */ {"SO4-dryd", "SO4-dry deposition [10**(-3)*g/m**2]"},
+    /* 155 */ {"SO4-wetd", "SO4-wet deposition [10**(-3)*g/m**2]"},
+    /* 156 */ {"NO-conc", "NO-concentration [10**(-6)*g/m**3]"},
+    /* 157 */ {"NO-dryd", "NO-dry deposition [10**(-3)*g/m**2]"},
+    /* 158 */ {"NO-wetd", "NO-wet deposition [10**(-3)*g/m**2]"},
+    /* 159 */ {"NO2-conc", "NO2-concentration [10**(-6)*g/m**3]"},
+    /* 160 */ {"NO2-dryd", "NO2-dry deposition [10**(-3)*g/m**2]"},
+    /* 161 */ {"NO2-wetd", "NO2-wet deposition [10**(-3)*g/m**2]"},
+    /* 162 */ {"NO3-conc", "NO3-concentration [10**(-6)*g/m**3]"},
+    /* 163 */ {"NO3-dryd", "NO3-dry deposition [10**(-3)*g/m**2]"},
+    /* 164 */ {"NO3-wetd", "NO3-wet deposition [10**(-3)*g/m**2]"},
+    /* 165 */ {"HNO3-conc", "HNO3-concentration [10**(-6)*g/m**3]"},
+    /* 166 */ {"HNO3-dryd", "HNO3-dry deposition [10**(-3)*g/m**2]"},
+    /* 167 */ {"HNO3-wetd", "HNO3-wet deposition [10**(-3)*g/m**2]"},
+    /* 168 */ {"NH3-conc", "NH3-concentration [10**(-6)*g/m**3]"},
+    /* 169 */ {"NH3-dryd", "NH3-dry deposition [10**(-3)*g/m**2]"},
+    /* 170 */ {"NH3-wetd", "NH3-wet deposition [10**(-3)*g/m**2]"},
+    /* 171 */ {"NH4-conc", "NH4-concentration [10**(-6)*g/m**3]"},
+    /* 172 */ {"NH4-dryd", "NH4-dry deposition [10**(-3)*g/m**2]"},
+    /* 173 */ {"NH4-wetd", "NH4-wet deposition [10**(-3)*g/m**2]"},
+    /* 174 */ {"O3-conc", "O3-concentration [10**(-6)*g/m**3]"},
+    /* 175 */ {"PAN-conc", "PAN-concentration [10**(-6)*g/m**3]"},
+    /* 176 */ {"PAN-dryd", "PAN-dry deposition [10**(-3)*g/m**2]"},
+    /* 177 */ {"OH-conc", "OH-concentration [10**(-6)*g/m**3]"},
+    /* 178 */ {"O3-dryd", "O3-dry deposition [10**(-3)*g/m**2]"},
+    /* 179 */ {"O3-wetd", "O3-wet deposition [10**(-3)*g/m**2]"},
+    /* 180 */ {"O3", "O3-mixing ratio [kg/kg]"},
+    /* 181 */ {"var181", "undefined"},
+    /* 182 */ {"var182", "undefined"},
+    /* 183 */ {"var183", "undefined"},
+    /* 184 */ {"var184", "undefined"},
+    /* 185 */ {"var185", "undefined"},
+    /* 186 */ {"var186", "undefined"},
+    /* 187 */ {"var187", "undefined"},
+    /* 188 */ {"var188", "undefined"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"var190", "undefined"},
+    /* 191 */ {"var191", "undefined"},
+    /* 192 */ {"var192", "undefined"},
+    /* 193 */ {"var193", "undefined"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"var195", "undefined"},
+    /* 196 */ {"var196", "undefined"},
+    /* 197 */ {"var197", "undefined"},
+    /* 198 */ {"var198", "undefined"},
+    /* 199 */ {"var199", "undefined"},
+    /* 200 */ {"I131-conc", "I131-concentration [Bq/m**3]"},
+    /* 201 */ {"I131-dryd", "I131-dry deposition [Bq/m**2]"},
+    /* 202 */ {"I131-wetd", "I131-wet deposition [Bq/m**2]"},
+    /* 203 */ {"Cs137-conc", "Cs137-concentration [Bq/m**3]"},
+    /* 204 */ {"Cs137-dryd", "Cs1370dry deposition [Bq/m**2]"},
+    /* 205 */ {"Cs137-wetd", "Cs137-wet deposition [Bq/m**2]"},
+    /* 206 */ {"Te132-conc", "Te132-concentration [Bq/m**3]"},
+    /* 207 */ {"Te132-dryd", "Te132-dry deposition [Bq/m**2]"},
+    /* 208 */ {"Te132-wetd", "Te132-wet deposition [Bq/m**2]"},
+    /* 209 */ {"Zr95-conc", "Zr95-concentration [Bq/m**3]"},
+    /* 210 */ {"Zr95-dryd", "Zr95-dry deposition [Bq/m**2]"},
+    /* 211 */ {"Zr95-wetd", "Zr95-wet deposition [Bq/m**2]"},
+    /* 212 */ {"var212", "undefined"},
+    /* 213 */ {"var213", "undefined"},
+    /* 214 */ {"var214", "undefined"},
+    /* 215 */ {"var215", "undefined"},
+    /* 216 */ {"var216", "undefined"},
+    /* 217 */ {"var217", "undefined"},
+    /* 218 */ {"var218", "undefined"},
+    /* 219 */ {"var219", "undefined"},
+    /* 220 */ {"var220", "undefined"},
+    /* 221 */ {"var221", "undefined"},
+    /* 222 */ {"var222", "undefined"},
+    /* 223 */ {"var223", "undefined"},
+    /* 224 */ {"var224", "undefined"},
+    /* 225 */ {"var225", "undefined"},
+    /* 226 */ {"var226", "undefined"},
+    /* 227 */ {"var227", "undefined"},
+    /* 228 */ {"var228", "undefined"},
+    /* 229 */ {"var229", "undefined"},
+    /* 230 */ {"var230", "undefined"},
+    /* 231 */ {"var231", "undefined"},
+    /* 232 */ {"var232", "undefined"},
+    /* 233 */ {"var233", "undefined"},
+    /* 234 */ {"var234", "undefined"},
+    /* 235 */ {"var235", "undefined"},
+    /* 236 */ {"var236", "undefined"},
+    /* 237 */ {"var237", "undefined"},
+    /* 238 */ {"var238", "undefined"},
+    /* 239 */ {"var239", "undefined"},
+    /* 240 */ {"UV_Ind_F_h", "UV_Index corr. for albedo+altitude,cloudless(F), h [1]"},
+    /* 241 */ {"BasicUV_IF", "Basic UV_Index m.s.l.,fixed albedo,cloudless(F), h [1]"},
+    /* 242 */ {"UV_Ind_W_h", "UV_Index corrected for albedo+altitude+clouds(W),h [1]"},
+    /* 243 */ {"UV_IndmaxF", "UV_Index cloudless (F), daily maximum [1]"},
+    /* 244 */ {"SB-Index", "Sonnenbrand-Index [(W*10**(-3))/m**2]"},
+    /* 245 */ {"SB-Index W", "Sonnenbrand-Index bei mittl. Bewoelkung (08z-12z) [(W*10**(-3))/m**2]"},
+    /* 246 */ {"Kan.UVB-WI", "Kanadischer UVB-Warnindex (bew|lkungsreduziert) [(W*10**(-3))/m**2]"},
+    /* 247 */ {"gesamt O3", "total column ozone (Gesamtozon) [Dobson Unit, DU]"},
+    /* 248 */ {"UV_IndmaxW", "UV_Index clouded (W), daily maximum [1]"},
+    /* 249 */ {"h UV_IndMx", "time of UV_Index maximum [h UTC]"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_203.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_203.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/dwdtable_203.c	(revision 2744)
@@ -0,0 +1,265 @@
+#include "cnames.h"
+
+/*
+ * GRIB table 203 at DWD
+ *     Helmut P. Frank, 30.08.2001
+ */
+
+struct ParmTable parm_table_dwd_203[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"pressure", "pressure [hPa]"},
+    /* 2 */ {"geopot h", "geopotential height [10 * gpm]"},
+    /* 3 */ {"var3", "undefined"},
+    /* 4 */ {"temperatur", "temperature [1*degree Celsius]"},
+    /* 5 */ {"dew-pnt te", "dew-point temperature [1*degree Celsius]"},
+    /* 6 */ {"windcompXY", "wind components X/Y (X*100000 + ((Y*10)+5000)) [m/s]"},
+    /* 7 */ {"geomet h", "geometrical height [kft]"},
+    /* 8 */ {"geomet h", "geometrical height [hft]"},
+    /* 9 */ {"wind di/sp", "wind direction and speed (dd*1000 + ff) [1*degree, 1*kt]"},
+    /* 10 */ {"3 h pr cha", "3 hour pressure change [Pa/(3*h)]"},
+    /* 11 */ {"Schnee-Mge", "Schneemenge [mm]"},
+    /* 12 */ {"var12", "undefined"},
+    /* 13 */ {"Bod-Wass-G", "Bodenwassergehalt [mm]"},
+    /* 14 */ {"var14", "undefined"},
+    /* 15 */ {"stab. ind.", "stability index [K]"},
+    /* 16 */ {"var16", "undefined"},
+    /* 17 */ {"var17", "undefined"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"max wind", "maximum wind velocity [kt]"},
+    /* 20 */ {"wind di/sp", "wind direction and speed (dd*1000 + ff) [5*degrees, 1*(m/s)]"},
+    /* 21 */ {"wind di/sp", "wind direction and speed (dd*1000 + ff) [5*degrees, 1*kt]"},
+    /* 22 */ {"wave di/he", "direction and height of wind waves (dd*1000 + h) [1*degree, 1*cm]"},
+    /* 23 */ {"swe. di/he", "direction and height of swell (dd*1000 + h) [1*degree, 1*cm]"},
+    /* 24 */ {"wave m d/h", "mean direction and height of waves (dd*1000 + h) [1*degree, 1*cm]"},
+    /* 25 */ {"wind speed", "wind speed [kt]"},
+    /* 26 */ {"var26", "undefined"},
+    /* 27 */ {"wind compX", "wind component X-direction [kt]"},
+    /* 28 */ {"wind compY", "wind component Y-direction [kt]"},
+    /* 29 */ {"var29", "undefined"},
+    /* 30 */ {"var30", "undefined"},
+    /* 31 */ {"var31", "undefined"},
+    /* 32 */ {"var32", "undefined"},
+    /* 33 */ {"abs voradv", "absolute vorticity advection [1/(s**2)]"},
+    /* 34 */ {"var34", "undefined"},
+    /* 35 */ {"var35", "undefined"},
+    /* 36 */ {"var36", "undefined"},
+    /* 37 */ {"var37", "undefined"},
+    /* 38 */ {"var38", "undefined"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"var40", "undefined"},
+    /* 41 */ {"var41", "undefined"},
+    /* 42 */ {"vert. vel.", "vertical velocity [hPa/h]"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"var44", "undefined"},
+    /* 45 */ {"var45", "undefined"},
+    /* 46 */ {"var46", "undefined"},
+    /* 47 */ {"var47", "undefined"},
+    /* 48 */ {"var48", "undefined"},
+    /* 49 */ {"var49", "undefined"},
+    /* 50 */ {"var50", "undefined"},
+    /* 51 */ {"var51", "undefined"},
+    /* 52 */ {"var52", "undefined"},
+    /* 53 */ {"var53", "undefined"},
+    /* 54 */ {"var54", "undefined"},
+    /* 55 */ {"max. temp.", "maximum temperature [1*degree Celsius]"},
+    /* 56 */ {"min. temp.", "minimum temperature [1*degree Celsius]"},
+    /* 57 */ {"var57", "undefined"},
+    /* 58 */ {"clo", "value of isolation of clothes [1]"},
+    /* 59 */ {"pmva", "predected mean vote (angepasst) [1]"},
+    /* 60 */ {"feeled t", "feeled temperature [1*degree Celsius]"},
+    /* 61 */ {"sea temper", "sea temperature [1*degree Celsius]"},
+    /* 62 */ {"var62", "undefined"},
+    /* 63 */ {"var63", "undefined"},
+    /* 64 */ {"var64", "undefined"},
+    /* 65 */ {"var65", "undefined"},
+    /* 66 */ {"var66", "undefined"},
+    /* 67 */ {"var67", "undefined"},
+    /* 68 */ {"var68", "undefined"},
+    /* 69 */ {"var69", "undefined"},
+    /* 70 */ {"var70", "undefined"},
+    /* 71 */ {"var71", "undefined"},
+    /* 72 */ {"var72", "undefined"},
+    /* 73 */ {"var73", "undefined"},
+    /* 74 */ {"var74", "undefined"},
+    /* 75 */ {"var75", "undefined"},
+    /* 76 */ {"var76", "undefined"},
+    /* 77 */ {"var77", "undefined"},
+    /* 78 */ {"var78", "undefined"},
+    /* 79 */ {"var79", "undefined"},
+    /* 80 */ {"var80", "undefined"},
+    /* 81 */ {"var81", "undefined"},
+    /* 82 */ {"var82", "undefined"},
+    /* 83 */ {"var83", "undefined"},
+    /* 84 */ {"var84", "undefined"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"Globalstr.", "Summe der Globalstrahlung ueber einen Zeitraum [kWh/m**2]"},
+    /* 87 */ {"Nied-GW-GE", "Niederschlagsart+Gewitter+Glatteis (T23-i) (0..99) [1]"},
+    /* 88 */ {"NiedGW-Art", "Niederschlagsart+Gewitter (T23-intern)     (0..99) [1]"},
+    /* 89 */ {"NiedGE-Art", "Niederschlagsart+Glatteis (T23-intern)     (0..99) [1]"},
+    /* 90 */ {"NiedBewArt", "Kombination Niederschl.-Bew.-Blautherm. (283..407) [1]"},
+    /* 91 */ {"Konv.U-Gr.", "Hoehe der Konvektionsuntergrenze ueber Grund [m]"},
+    /* 92 */ {"Nied.-Art", "Niederschlagsart -ww- (T23-intern)         (0..99) [1]"},
+    /* 93 */ {"Konv.-Art", "Konvektionsart                              (0..4) [1]"},
+    /* 94 */ {"Konv.UG-nn", "Hoehe der Konvektionsuntergrenze ueber nn [m]"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"Wetter(ww)", "Wetter (verschluesselt nach ww-Tabelle"},
+    /* 100 */ {"geostr Vor", "geostrophische Vorticity [1/s]"},
+    /* 101 */ {"Geo VorAdv", "geostrophische  Vorticityadvektion [1/s**2]"},
+    /* 102 */ {"VerGraVoAd", "vert. Gradient der geostr. Vorticityadvektion [m/(kg*s)]"},
+    /* 103 */ {"Geo TemAdv", "geostrophische Schichtdickenadvektion [m**3/(kg*s)]"},
+    /* 104 */ {"Lap TemAdv", "Kruemmung der geostr. Schichtdickenadvektion [m/(kg*s)]"},
+    /* 105 */ {"Omega Forc", "Forcing rechte Seite Omegagleichung [m/(kg*s)]"},
+    /* 106 */ {"var106", "undefined"},
+    /* 107 */ {"Schichtd.A", "Schichtdicken-Advektion [m**3/(kg*s)]"},
+    /* 108 */ {"AdGeVoThWi", "Advektion von geostr. Vorticity mit dem therm Wind [m/(kg*s)]"},
+    /* 109 */ {"Wind-Div.", "Winddivergenz [1/s]"},
+    /* 110 */ {"Q", "Q-vector direction and speed (dd*1000 + fff*1E13) [5*deg,1E13*m**2/kg/s]"},
+    /* 111 */ {"Qx", "Q-Vektor X-Komponente [m**2/(kg*s)]"},
+    /* 112 */ {"Qy", "Q-Vektor Y-Komponente [m**2/(kg*s)]"},
+    /* 113 */ {"Div Q", "Divergenz Q [m/(kg*s)]"},
+    /* 114 */ {"FrontoGeQn", "Frontogenesefunktion, Q isother-senkrecht-Kompon. [m**2/(kg*s)]"},
+    /* 115 */ {"Qs (geo)", "Qs (geo),Komp. Q-Vektor parallel zu den Isothermen [m**2/(kg*s)]"},
+    /* 116 */ {"DivQn(geo)", "Divergenz Qn  geostrophisch [m/(kg*s)]"},
+    /* 117 */ {"DivQs(geo)", "Divergenz Qs  geostrophisch [m/(kg*s)]"},
+    /* 118 */ {"Fronto Gen", "Frontogenesefunktion [K**2/(m**2*s)]"},
+    /* 119 */ {"var119", "undefined"},
+    /* 120 */ {"var120", "undefined"},
+    /* 121 */ {"var121", "undefined"},
+    /* 122 */ {"var122", "undefined"},
+    /* 123 */ {"var123", "undefined"},
+    /* 124 */ {"FrontoGenP", "Frontogenese-Parameter [1]"},
+    /* 125 */ {"Qs-Vektor", "Qs, Komp. Q-Vektor parallel zu den Isothermen [m**2/(kg*s)]"},
+    /* 126 */ {"var126", "undefined"},
+    /* 127 */ {"Div Qs", "Divergenz Qs [m/(kg*s)]"},
+    /* 128 */ {"var128", "undefined"},
+    /* 129 */ {"var129", "undefined"},
+    /* 130 */ {"IPV", "Isentrope potentielle Vorticity [K*m**2/(s*kg)]"},
+    /* 131 */ {"Wind KompX", "Wind X-Komponente auf isentropen Flaechen [m/s]"},
+    /* 132 */ {"Wind KompY", "Wind Y-Komponente auf isentropen Flaechen [m/s]"},
+    /* 133 */ {"Druck-Ise.", "Druck einer isentropen Flaeche [hPa]"},
+    /* 134 */ {"var134", "undefined"},
+    /* 135 */ {"var135", "undefined"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"var137", "undefined"},
+    /* 138 */ {"var138", "undefined"},
+    /* 139 */ {"var139", "undefined"},
+    /* 140 */ {"KO-Index", "KO-Index [K]"},
+    /* 141 */ {"TT-Index", "Totals-Totals-Index [K]"},
+    /* 142 */ {"S-Index", "S-Index [K]"},
+    /* 143 */ {"Stein-Ind", "Steinbeck-Index [1]"},
+    /* 144 */ {"Baily-Ind", "Baily-Index [1]"},
+    /* 145 */ {"Microburst", "Microburst-Index [1]"},
+    /* 146 */ {"Cat-Index", "Clear Air Turbulence Index [1/s]"},
+    /* 147 */ {"var147", "undefined"},
+    /* 148 */ {"Lab-Energ", "Labilit{tsenergie [J/g]"},
+    /* 149 */ {"var149", "undefined"},
+    /* 150 */ {"Virt T", "Virtuelle Temperatur [K]"},
+    /* 151 */ {"Pseudo T", "Pseudo-Temperatur [K]"},
+    /* 152 */ {"Pseudo Pot", "Pseudopotentielle Temperatur [K]"},
+    /* 153 */ {"Aequi T", "Aequivalent-Temperatur [K]"},
+    /* 154 */ {"Aequi Pot", "Aequivalentpotentielle Temperatur [K]"},
+    /* 155 */ {"var155", "undefined"},
+    /* 156 */ {"var156", "undefined"},
+    /* 157 */ {"var157", "undefined"},
+    /* 158 */ {"var158", "undefined"},
+    /* 159 */ {"var159", "undefined"},
+    /* 160 */ {"Bas St Wol", "Untergrenze strat. Bew|lkung [hft]"},
+    /* 161 */ {"Bas St Wol", "Untergrenze strat. Bew|lkung [hPa]"},
+    /* 162 */ {"Bas Cu Wol", "Untergrenze cumul. Bew|lkung [hft]"},
+    /* 163 */ {"Bas Cu Wol", "Untergrenze cumul. Bew|lkung [hPa]"},
+    /* 164 */ {"Top St Wol", "Obergrenze strat. Bew|lkung [hft]"},
+    /* 165 */ {"Top St Wol", "Obergrenze strat. Bew|lkung [hPa]"},
+    /* 166 */ {"Top Cu Wol", "Obergrenze cumul. Bew|lkung [hft]"},
+    /* 167 */ {"Top Cu Wol", "Obergrenze cumul. Bew|lkung [hPa]"},
+    /* 168 */ {"var168", "undefined"},
+    /* 169 */ {"var169", "undefined"},
+    /* 170 */ {"Bas Tur Wo", "Untergrenze Wolkenturbulenz [hft]"},
+    /* 171 */ {"Bas Tur Wo", "Untergrenze Wolkenturbulenz [hPa]"},
+    /* 172 */ {"Top Tur Wo", "Obergrenze Wolkenturbulenz [hft]"},
+    /* 173 */ {"Top Tur Wo", "Obergrenze Wolkenturbulenz [hPa]"},
+    /* 174 */ {"Bas Eis Wo", "Untergrenze Vereisung in Wolken [hft]"},
+    /* 175 */ {"Bas Eis Wo", "Untergrenze Vereisung in Wolken [hPa]"},
+    /* 176 */ {"Top Eis Wo", "Obergrenze Vereisung in Wolken [hft]"},
+    /* 177 */ {"Top Eis Wo", "Obergrenze Vereisung in Wolken [hPa]"},
+    /* 178 */ {"Int Tur Wo", "Intensitaet der Turbulenz in Wolken  (0..4) [1]"},
+    /* 179 */ {"Int Eis Wo", "Intensitaet der Vereisung  (0..4) [1]"},
+    /* 180 */ {"var180", "undefined"},
+    /* 181 */ {"var181", "undefined"},
+    /* 182 */ {"var182", "undefined"},
+    /* 183 */ {"var183", "undefined"},
+    /* 184 */ {"var184", "undefined"},
+    /* 185 */ {"var185", "undefined"},
+    /* 186 */ {"var186", "undefined"},
+    /* 187 */ {"var187", "undefined"},
+    /* 188 */ {"var188", "undefined"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"Sichtweite", "Sichtweite [m]"},
+    /* 191 */ {"var191", "undefined"},
+    /* 192 */ {"var192", "undefined"},
+    /* 193 */ {"var193", "undefined"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"IcingGuess", "Icing Regime 1.Guess(1=gen,2=conv,3=strat,4=freez) [1]"},
+    /* 196 */ {"IcingGrade", "Icing Grade (1=LGT,2=MOD,3=SEV) [1]"},
+    /* 197 */ {"IcingRegim", "Icing Regime(1=general,2=convect,3=strat,4=freez) [1]"},
+    /* 198 */ {"var198", "undefined"},
+    /* 199 */ {"var199", "undefined"},
+    /* 200 */ {"Gru Wetter", "Wetter - Grundzustand   (ww"},
+    /* 201 */ {"Lok Wetter", "Wetter - 1. lokale Abweichung  (ww"},
+    /* 202 */ {"Lok Wetter", "Wetter - 2. lokale Abweichung  (ww"},
+    /* 203 */ {"CLDEPTH", "cloud depth (grey scale"},
+    /* 204 */ {"CLCT_MOD", "modified total cloud cover  (0..1) [1]"},
+    /* 205 */ {"curr weath", "current weather (symbol number"},
+    /* 206 */ {"var206", "undefined"},
+    /* 207 */ {"var207", "undefined"},
+    /* 208 */ {"var208", "undefined"},
+    /* 209 */ {"var209", "undefined"},
+    /* 210 */ {"var210", "undefined"},
+    /* 211 */ {"Cu", "Cumulus  (0..1) [1]"},
+    /* 212 */ {"Cb", "Cumulimbus  (0..1) [1]"},
+    /* 213 */ {"Sc", "Stratocumulus  (0..1) [1]"},
+    /* 214 */ {"Ac", "Altocumulus  (0..1) [1]"},
+    /* 215 */ {"Ci", "Cirrus  (0..1) [1]"},
+    /* 216 */ {"St", "Stratus  (0..1) [1]"},
+    /* 217 */ {"As", "Altostratus  (0..1) [1]"},
+    /* 218 */ {"var218", "undefined"},
+    /* 219 */ {"var219", "undefined"},
+    /* 220 */ {"var220", "undefined"},
+    /* 221 */ {"Bedeckung", "Bedeckung in Stufen [1]"},
+    /* 222 */ {"Konvektion", "Konvektion  ja/nein [1]"},
+    /* 223 */ {"MN >90%", "Gesamtbedeckung > 90%  ja/nein [1]"},
+    /* 224 */ {"RF700 >89%", "relative Feuchte 700 hPa >= 90%  ja/nein [1]"},
+    /* 225 */ {"RR12 zentr", "Niederschlag 12 std. zentriert [mm]"},
+    /* 226 */ {"RR12 <=0.5", "Niederschlag 12 std. zentriert, Werte <= 0.5mm [mm]"},
+    /* 227 */ {"RR12 SA>60", "RR12 zentriert, Schneeanteil > 60%  ja/nein [1]"},
+    /* 228 */ {"RR12 Kv>60", "RR12 zentriert, konvektiver Anteil > 60%  ja/nein [1]"},
+    /* 229 */ {"SRR12ff", "Starkniederschlag in Stufen (12 std. Folgezeitr) [1]"},
+    /* 230 */ {"RRMAX/STD", "Maximaler Starkniederschlag / std [mm/h]"},
+    /* 231 */ {"RRMAX/MIN", "Maximaler Starkniederschlag / min [mm/min]"},
+    /* 232 */ {"SN12ff >15", "Schneefall (12std. Folgezeitraum) > 15 mm  ja/nein [1]"},
+    /* 233 */ {"RRgefr12ff", "gefrierender Regen (12std. Folgezeitraum)  ja/nein [1]"},
+    /* 234 */ {"FFboe", "Boeenstaerke in Stufen [1]"},
+    /* 235 */ {"Gewitter", "Gewitter in Stufen [1]"},
+    /* 236 */ {"Tx2m12h ze", "2m Maximumtemperatur 12h zentriert [Grad Celsius]"},
+    /* 237 */ {"Tn2m12h ze", "2m Minimumtemperatur 12h zentriert [Grad Celsius]"},
+    /* 238 */ {"var238", "undefined"},
+    /* 239 */ {"var239", "undefined"},
+    /* 240 */ {"var240", "undefined"},
+    /* 241 */ {"var241", "undefined"},
+    /* 242 */ {"var242", "undefined"},
+    /* 243 */ {"var243", "undefined"},
+    /* 244 */ {"var244", "undefined"},
+    /* 245 */ {"var245", "undefined"},
+    /* 246 */ {"var246", "undefined"},
+    /* 247 */ {"var247", "undefined"},
+    /* 248 */ {"var248", "undefined"},
+    /* 249 */ {"var249", "undefined"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"SCHWUELIND", "Schwuele-Index [1]"},
+    /* 252 */ {"SMOGSTUFEN", "Smog-Intensitaetsstufen [1]"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"SMOGHOEHE", "Obergrenze Smog  ( Inversionshoehe ) [m]"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ec_ext.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ec_ext.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ec_ext.c	(revision 2744)
@@ -0,0 +1,78 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <string.h>
+
+#include "pds4.h"
+#include "grib.h"
+
+/*
+ * EC_ext	v1.0 wesley ebisuzaki
+ *
+ * prints something readable from the EC stream parameter
+ *
+ * prefix and suffix are only printed if EC_ext has text
+ */
+
+void EC_ext(unsigned char *pds, char *prefix, char *suffix) {
+
+    /* int i;
+    printf("\n");
+    for (i=0; i < PDS_LEN(pds); i++) {
+      printf("%x ",pds[i]);
+    }
+    */
+    /*
+     10/03/2000: R.Rudsar : subroutine changed.
+                 Tests for EcType and extra test for EcStream 1035
+    */
+    if (PDS_Center(pds) == ECMWF && PDS_LEN(pds) >= 43) {
+
+        switch(PDS_EcType(pds)) {
+	    case 10:
+		printf("%sControl forecast%s", prefix, suffix);
+		break;
+	    case 11:
+		printf("%sPerturbed forecasts%s", prefix, suffix);
+		break;
+	    case 14:
+		printf("%sCluster means%s", prefix, suffix);
+		break;
+	    case 15:
+		printf("%sCluster std. dev.%s", prefix, suffix);
+		break;
+	    case 16:
+		printf("%sForecast probability%s", prefix, suffix);
+		break;
+	    case 17:
+		printf("%sEnsemble means%s", prefix, suffix);
+		break;
+	    case 18:
+		printf("%sEnsemble std. dev.%s", prefix, suffix);
+		break;
+	    default:
+		printf("%sECMWF type?%s", prefix, suffix);
+		break;
+	}
+    }
+    if (PDS_Center(pds) == ECMWF && PDS_LEN(pds) >= 45) {
+
+        switch(PDS_EcStream(pds)) {
+	    case 1035:
+		printf("%sensemble forecasts%s", prefix, suffix);
+		break;
+	    case 1043:
+		printf("%smon mean%s", prefix, suffix);
+		break;
+	    case 1070:
+		printf("%smon (co)var%s", prefix, suffix);
+		break;
+	    case 1071:
+		printf("%smon mean from daily%s", prefix, suffix);
+		break;
+	    default:
+		printf("%sECMWF stream?%s", prefix, suffix);
+		break;
+	}
+    }
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_128.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_128.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_128.c	(revision 2744)
@@ -0,0 +1,264 @@
+#include "cnames.h"
+
+/*
+  Helmut Frank, updated 24.07.2003: UVB, PAR, CAPE
+*/
+
+struct ParmTable parm_table_ecmwf_128[256] = {
+      /* 0 */ {"var0", "undefined"},
+      /* 1 */ {"STRF", "Stream function [m**2 s**-1]"},
+      /* 2 */ {"VPOT", "Velocity potential [m**2 s**-1]"},
+      /* 3 */ {"PT", "Potential temperature [K]"},
+      /* 4 */ {"EQPT", "Equivalent potential temperature [K]"},
+      /* 5 */ {"SEPT", "Saturated equivalent potential temperature [K]"},
+      /* 6 */ {"var6", "Reserved for Metview"},
+      /* 7 */ {"var7", "Reserved for Metview"},
+      /* 8 */ {"var8", "Reserved for Metview"},
+      /* 9 */ {"var9", "Reserved for Metview"},
+      /* 10 */ {"var10", "Reserved for Metview"},
+      /* 11 */ {"UDVW", "U component of divergent wind [m s**-1]"},
+      /* 12 */ {"VDVW", "V component of divergent wind [m s**-1]"},
+      /* 13 */ {"URTW", "U component of rotational wind [m s**-1]"},
+      /* 14 */ {"VRTW", "V component of rotational wind [m s**-1]"},
+      /* 15 */ {"var15", "Reserved for Metview"},
+      /* 16 */ {"var16", "Reserved for Metview"},
+      /* 17 */ {"var17", "Reserved for Metview"},
+      /* 18 */ {"var18", "Reserved for Metview"},
+      /* 19 */ {"var19", "Reserved for Metview"},
+      /* 20 */ {"var20", "Reserved for Metview"},
+      /* 21 */ {"UCTP", "Unbalanced component of temperature [K]"},
+      /* 22 */ {"UCLN", "Unbalanced component of logarithm of surface pressure"},
+      /* 23 */ {"UCDV", "Unbalanced component of divergence [s**-1]"},
+      /* 24 */ {"var24", "Reserved for future unbalanced components"},
+      /* 25 */ {"var25", "Reserved for future unbalanced components"},
+      /* 26 */ {"CL", "Lake cover [(0-1)]"},
+      /* 27 */ {"CVL", "Low vegetation cover [(0-1)]"},
+      /* 28 */ {"CVH", "High vegetation cover [(0-1)]"},
+      /* 29 */ {"TVL", "Type of low vegetation"},
+      /* 30 */ {"TVH", "Type of high vegetation"},
+      /* 31 */ {"CI", "Sea-ice cover [(0-1)]"},
+      /* 32 */ {"ASN", "Snow albedo [(0-1)]"},
+      /* 33 */ {"RSN", "Snow density [kg m**-3]"},
+      /* 34 */ {"SSTK", "Sea surface temperature [K]"},
+      /* 35 */ {"ISTL1", "Ice surface temperature layer 1 [K]"},
+      /* 36 */ {"ISTL2", "Ice surface temperature layer 2 [K]"},
+      /* 37 */ {"ISTL3", "Ice surface temperature layer 3 [K]"},
+      /* 38 */ {"ISTL4", "Ice surface temperature layer 4 [K]"},
+      /* 39 */ {"SWVL1", "Volumetric soil water layer 1 [m**3 m**-3]"},
+      /* 40 */ {"SWVL2", "Volumetric soil water layer 2 [m**3 m**-3]"},
+      /* 41 */ {"SWVL3", "Volumetric soil water layer 3 [m**3 m**-3]"},
+      /* 42 */ {"SWVL4", "Volumetric soil water layer 4 [m**3 m**-3]"},
+      /* 43 */ {"SLT", "Soil type"},
+      /* 44 */ {"ES", "Snow evaporation [m of water]"},
+      /* 45 */ {"SMLT", "Snowmelt [m of water]"},
+      /* 46 */ {"SDUR", "Solar duration [s]"},
+      /* 47 */ {"DSRP", "Direct solar radiation [w m**-2]"},
+      /* 48 */ {"MAGSS", "Magnitude of surface stress [N m**-2 s]"},
+      /* 49 */ {"10FG", "Wind gust at 10 metres [m s**-1]"},
+      /* 50 */ {"LSPF", "Large-scale precipitation fraction [s]"},
+      /* 51 */ {"MX2T24", "Maximum 2 metre temperature [K]"},
+      /* 52 */ {"MN2T24", "Minimum 2 metre temperature [K]"},
+      /* 53 */ {"MONT", "Montgomery potential [m**2 s**-2]"},
+      /* 54 */ {"PRES", "Pressure [Pa]"},
+      /* 55 */ {"var55", "undefined"},
+      /* 56 */ {"var56", "undefined"},
+      /* 57 */ {"UVB", "Downward UV radiation at the surface (Ultra-violet band B) [W m**-2]"},
+      /* 58 */ {"PAR", "Photosynthetically active radiation at the surface [W m**-2]"},
+      /* 59 */ {"CAPE", "Convective available potential energy [J kg**-1]"},
+      /* 60 */ {"PV", "Potential vorticity [K m**2 kg**-1 s**-1]"},
+      /* 61 */ {"var61", "undefined"},
+      /* 62 */ {"var62", "undefined"},
+      /* 63 */ {"var63", "undefined"},
+      /* 64 */ {"var64", "undefined"},
+      /* 65 */ {"var65", "undefined"},
+      /* 66 */ {"var66", "undefined"},
+      /* 67 */ {"var67", "undefined"},
+      /* 68 */ {"var68", "undefined"},
+      /* 69 */ {"var69", "undefined"},
+      /* 70 */ {"var70", "undefined"},
+      /* 71 */ {"var71", "undefined"},
+      /* 72 */ {"var72", "undefined"},
+      /* 73 */ {"var73", "undefined"},
+      /* 74 */ {"var74", "undefined"},
+      /* 75 */ {"var75", "undefined"},
+      /* 76 */ {"var76", "undefined"},
+      /* 77 */ {"var77", "undefined"},
+      /* 78 */ {"var78", "undefined"},
+      /* 79 */ {"var79", "undefined"},
+      /* 80 */ {"var80", "undefined"},
+      /* 81 */ {"var81", "undefined"},
+      /* 82 */ {"var82", "undefined"},
+      /* 83 */ {"var83", "undefined"},
+      /* 84 */ {"var84", "undefined"},
+      /* 85 */ {"var85", "undefined"},
+      /* 86 */ {"var86", "undefined"},
+      /* 87 */ {"var87", "undefined"},
+      /* 88 */ {"var88", "undefined"},
+      /* 89 */ {"var89", "undefined"},
+      /* 90 */ {"var90", "undefined"},
+      /* 91 */ {"var91", "undefined"},
+      /* 92 */ {"var92", "undefined"},
+      /* 93 */ {"var93", "undefined"},
+      /* 94 */ {"var94", "undefined"},
+      /* 95 */ {"var95", "undefined"},
+      /* 96 */ {"var96", "undefined"},
+      /* 97 */ {"var97", "undefined"},
+      /* 98 */ {"var98", "undefined"},
+      /* 99 */ {"var99", "undefined"},
+      /* 100 */ {"100", "Experimental product [Undefined]"},
+      /* 101 */ {"101", "Experimental product [Undefined]"},
+      /* 102 */ {"102", "Experimental product [Undefined]"},
+      /* 103 */ {"103", "Experimental product [Undefined]"},
+      /* 104 */ {"104", "Experimental product [Undefined]"},
+      /* 105 */ {"105", "Experimental product [Undefined]"},
+      /* 106 */ {"106", "Experimental product [Undefined]"},
+      /* 107 */ {"107", "Experimental product [Undefined]"},
+      /* 108 */ {"108", "Experimental product [Undefined]"},
+      /* 109 */ {"109", "Experimental product [Undefined]"},
+      /* 110 */ {"110", "Experimental product [Undefined]"},
+      /* 111 */ {"111", "Experimental product [Undefined]"},
+      /* 112 */ {"112", "Experimental product [Undefined]"},
+      /* 113 */ {"113", "Experimental product [Undefined]"},
+      /* 114 */ {"114", "Experimental product [Undefined]"},
+      /* 115 */ {"115", "Experimental product [Undefined]"},
+      /* 116 */ {"116", "Experimental product [Undefined]"},
+      /* 117 */ {"117", "Experimental product [Undefined]"},
+      /* 118 */ {"118", "Experimental product [Undefined]"},
+      /* 119 */ {"119", "Experimental product [Undefined]"},
+      /* 120 */ {"120", "Experimental product [Undefined]"},
+      /* 121 */ {"var121", "undefined"},
+      /* 122 */ {"var122", "undefined"},
+      /* 123 */ {"var123", "undefined"},
+      /* 124 */ {"var124", "undefined"},
+      /* 125 */ {"var125", "undefined"},
+      /* 126 */ {"var126", "undefined"},
+      /* 127 */ {"AT", "Atmospheric tide"},
+      /* 128 */ {"BV", "Budget values"},
+      /* 129 */ {"Z", "Geopotential [m**2 s**-2]"},
+      /* 130 */ {"T", "Temperature [K]"},
+      /* 131 */ {"U", "U velocity [m s**-1]"},
+      /* 132 */ {"V", "V velocity [m s**-1]"},
+      /* 133 */ {"Q", "Specific humidity [kg kg**-1]"},
+      /* 134 */ {"SP", "Surface pressure [Pa]"},
+      /* 135 */ {"W", "Vertical velocity [Pa s**-1]"},
+      /* 136 */ {"TCW", "Total column water [kg m**-2]"},
+      /* 137 */ {"TCWV", "Total column water vapour [kg m**-2]"},
+      /* 138 */ {"VO", "Vorticity (relative) [s**-1]"},
+      /* 139 */ {"STL1", "Soil temperature level 1 [K]"},
+      /* 140 */ {"SWL1", "Soil wetness level 1 [m of water]"},
+      /* 141 */ {"SD", "Snow depth [m of water equivalent]"},
+      /* 142 */ {"LSP", "Stratiform precipitation [m]"},
+      /* 143 */ {"CP", "Convective precipitation [m]"},
+      /* 144 */ {"SF", "Snowfall (convective + stratiform) [m of water equivalent]"},
+      /* 145 */ {"BLD", "Boundary layer dissipation [W m**-2 s]"},
+      /* 146 */ {"SSHF", "Surface sensible heat flux [W m**-2 s]"},
+      /* 147 */ {"SLHF", "Surface latent heat flux [W m**-2 s]"},
+      /* 148 */ {"CHNK", "Charnock"},
+      /* 149 */ {"SNR", "Surface net radiation [W m**-2 s]"},
+      /* 150 */ {"TNR", "Top net radiation"},
+      /* 151 */ {"MSL", "Mean sea-level pressure [Pa]"},
+      /* 152 */ {"LNSP", "Logarithm of surface pressure"},
+      /* 153 */ {"SWHR", "Short-wave heating rate [K]"},
+      /* 154 */ {"LWHR", "Long-wave heating rate [K]"},
+      /* 155 */ {"D", "Divergence [s**-1]"},
+      /* 156 */ {"GH", "Height [m]"},
+      /* 157 */ {"R", "Relative humidity [%]"},
+      /* 158 */ {"TSP", "Tendency of surface pressure [Pa s**-1]"},
+      /* 159 */ {"BLH", "Boundary layer height [m]"},
+      /* 160 */ {"SDOR", "Standard deviation of orography"},
+      /* 161 */ {"ISOR", "Anisotropy of sub-gridscale orography"},
+      /* 162 */ {"ANOR", "Angle of sub-gridscale orography [rad]"},
+      /* 163 */ {"SLOR", "Slope of sub-gridscale orography"},
+      /* 164 */ {"TCC", "Total cloud cover [(0 - 1)]"},
+      /* 165 */ {"10U", "10 metre U wind component [m s**-1]"},
+      /* 166 */ {"10V", "10 metre V wind component [m s**-1]"},
+      /* 167 */ {"2T", "2 metre temperature [K]"},
+      /* 168 */ {"2D", "2 metre dewpoint temperature [K]"},
+      /* 169 */ {"SSRD", "Surface solar radiation downwards [W m**-2 s]"},
+      /* 170 */ {"STL2", "Soil temperature level 2 [K]"},
+      /* 171 */ {"SWL2", "Soil wetness level 2 [m of water]"},
+      /* 172 */ {"LSM", "Land/sea mask [(0, 1)]"},
+      /* 173 */ {"SR", "Surface roughness [m]"},
+      /* 174 */ {"AL", "Albedo [(0 - 1)]"},
+      /* 175 */ {"STRD", "Surface thermal radiation downwards [W m**-2 s]"},
+      /* 176 */ {"SSR", "Surface solar radiation [W m**-2 s]"},
+      /* 177 */ {"STR", "Surface thermal radiation [W m**-2 s]"},
+      /* 178 */ {"TSR", "Top solar radiation [W m**-2 s]"},
+      /* 179 */ {"TTR", "Top thermal radiation [W m**-2 s]"},
+      /* 180 */ {"EWSS", "East/West surface stress [N m**-2 s]"},
+      /* 181 */ {"NSSS", "North/South surface stress [N m**-2 s]"},
+      /* 182 */ {"E", "Evaporation [m of water]"},
+      /* 183 */ {"STL3", "Soil temperature level 3 [K]"},
+      /* 184 */ {"SWL3", "Soil wetness level 3 [m of water]"},
+      /* 185 */ {"CCC", "Convective cloud cover [(0 - 1)]"},
+      /* 186 */ {"LCC", "Low cloud cover [(0 - 1)]"},
+      /* 187 */ {"MCC", "Medium cloud cover [(0 - 1)]"},
+      /* 188 */ {"HCC", "High cloud cover [(0 - 1)]"},
+      /* 189 */ {"SUND", "Sunshine duration [s]"},
+      /* 190 */ {"EWOV", "EW component of subgrid orographic variance [m**2]"},
+      /* 191 */ {"NSOV", "NS component of subgrid orographic variance [m**2]"},
+      /* 192 */ {"NWOV", "NWSE component of subgrid orographic variance [m**2]"},
+      /* 193 */ {"NEOV", "NESW component of subgrid orographic variance [m**2]"},
+      /* 194 */ {"BTMP", "Brightness temperature [K]"},
+      /* 195 */ {"LGWS", "Lat. component of gravity wave stress [N m**-2 s]"},
+      /* 196 */ {"MGWS", "Meridional component of gravity wave stress [N m**-2 s]"},
+      /* 197 */ {"GWD", "Gravity wave dissipation [W m**-2 s]"},
+      /* 198 */ {"SRC", "Skin reservoir content [m of water]"},
+      /* 199 */ {"VEG", "Vegetation fraction [(0 - 1)]"},
+      /* 200 */ {"VSO", "Variance of sub-gridscale orography [m**2]"},
+      /* 201 */ {"MX2T", "Maximum 2 metre temperature since previous post-processing [K]"},
+      /* 202 */ {"MN2T", "Minimum 2 metre temperature since previous post-processing [K]"},
+      /* 203 */ {"O3", "Ozone mass mixing ratio [kg kg**-1]"},
+      /* 204 */ {"PAW", "Precipiation analysis weights"},
+      /* 205 */ {"RO", "Runoff [m]"},
+      /* 206 */ {"TCO3", "Total column ozone [Dobson]"},
+      /* 207 */ {"10SI", "10 meter windspeed [m s**-1]"},
+      /* 208 */ {"TSRC", "Top net solar radiation, clear sky [W m**-2]"},
+      /* 209 */ {"TTRC", "Top net thermal radiation, clear sky [W m**-2]"},
+      /* 210 */ {"SSRC", "Surface net solar radiation, clear sky [W m**-2]"},
+      /* 211 */ {"STRC", "Surface net thermal radiation, clear sky [W m**-2]"},
+      /* 212 */ {"SI", "Solar insolation [W m**-2]"},
+      /* 213 */ {"var213", "undefined"},
+      /* 214 */ {"DHR", "Diabatic heating by radiation [K]"},
+      /* 215 */ {"DHVD", "Diabatic heating by vertical diffusion [K]"},
+      /* 216 */ {"DHCC", "Diabatic heating by cumulus convection [K]"},
+      /* 217 */ {"DHLC", "Diabatic heating large-scale condensation [K]"},
+      /* 218 */ {"VDZW", "Vertical diffusion of zonal wind [m s**-1]"},
+      /* 219 */ {"VDMW", "Vertical diffusion of meridional wind [m s**-1]"},
+      /* 220 */ {"EWGD", "EW gravity wave drag tendency [m s**-1]"},
+      /* 221 */ {"NSGD", "NS gravity wave drag tendency [m s**-1]"},
+      /* 222 */ {"CTZW", "Convective tendency of zonal wind [m s**-1]"},
+      /* 223 */ {"CTMW", "Convective tendency of meridional wind [m s**-1]"},
+      /* 224 */ {"VDH", "Vertical diffusion of humidity [kg kg**-1]"},
+      /* 225 */ {"HTCC", "Humidity tendency by cumulus convection [kg kg**-1]"},
+      /* 226 */ {"HTLC", "Humidity tendency large-scale condensation [kg kg**-1]"},
+      /* 227 */ {"CRNH", "Change from removing negative humidity [kg kg**-1]"},
+      /* 228 */ {"TP", "Total precipitation [m]"},
+      /* 229 */ {"IEWS", "Instantaneous X surface stress [N m**-2]"},
+      /* 230 */ {"INSS", "Instantaneous Y surface stress [N m**-2]"},
+      /* 231 */ {"ISHF", "Instantaneous surface heat flux [W m**-2]"},
+      /* 232 */ {"IE", "Instantaneous moisture flux [kg m**-2 s]"},
+      /* 233 */ {"ASQ", "Apparent surface humidity [kg kg**-1]"},
+      /* 234 */ {"LSRH", "Logarithm of surface roughness length for heat"},
+      /* 235 */ {"SKT", "Skin temperature [K]"},
+      /* 236 */ {"STL4", "Soil temperature level 4 [K]"},
+      /* 237 */ {"SWL4", "Soil wetness level 4 [m]"},
+      /* 238 */ {"TSN", "Temperature of snow layer [K]"},
+      /* 239 */ {"CSF", "Convective snowfall [m of water equivalent]"},
+      /* 240 */ {"LSF", "Large-scale snowfall [m of water equivalent]"},
+      /* 241 */ {"ACF", "Accumulated cloud fraction tendency [(-1 to 1)]"},
+      /* 242 */ {"ALW", "Accumulated liquid water tendency [(-1 to 1)]"},
+      /* 243 */ {"FAL", "Forecast albedo [(0 - 1)]"},
+      /* 244 */ {"FSR", "Forecast surface roughness [m]"},
+      /* 245 */ {"FLSR", "Forecast log of surface roughness for heat"},
+      /* 246 */ {"CLWC", "Cloud liquid water content [kg kg**-1]"},
+      /* 247 */ {"CIWC", "Cloud ice water content [kg kg**-1]"},
+      /* 248 */ {"CC", "Cloud cover [(0 - 1)]"},
+      /* 249 */ {"AIW", "Accumulated ice water tendency [(-1 to 1)]"},
+      /* 250 */ {"ICE", "Ice age [1,0]"},
+      /* 251 */ {"ATTE", "Adiabatic tendency of temperature [K]"},
+      /* 252 */ {"ATHE", "Adiabatic tendency of humidity [kg kg**-1]"},
+      /* 253 */ {"ATZE", "Adiabatic tendency of zonal wind [m s**-1]"},
+      /* 254 */ {"ATMW", "Adiabatic tendency of meridional wind [m s**-1]"},
+      /* 255 */ {"var255", "Indicates a missing value"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_129.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_129.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_129.c	(revision 2744)
@@ -0,0 +1,261 @@
+#include "cnames.h"
+
+
+struct ParmTable parm_table_ecmwf_129[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"var1", "undefined"},
+    /* 2 */ {"var2", "undefined"},
+    /* 3 */ {"var3", "undefined"},
+    /* 4 */ {"var4", "undefined"},
+    /* 5 */ {"var5", "undefined"},
+    /* 6 */ {"var6", "undefined"},
+    /* 7 */ {"var7", "undefined"},
+    /* 8 */ {"var8", "undefined"},
+    /* 9 */ {"var9", "undefined"},
+    /* 10 */ {"var10", "undefined"},
+    /* 11 */ {"var11", "undefined"},
+    /* 12 */ {"var12", "undefined"},
+    /* 13 */ {"var13", "undefined"},
+    /* 14 */ {"var14", "undefined"},
+    /* 15 */ {"var15", "undefined"},
+    /* 16 */ {"var16", "undefined"},
+    /* 17 */ {"var17", "undefined"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"var19", "undefined"},
+    /* 20 */ {"var20", "undefined"},
+    /* 21 */ {"var21", "undefined"},
+    /* 22 */ {"var22", "undefined"},
+    /* 23 */ {"var23", "undefined"},
+    /* 24 */ {"var24", "undefined"},
+    /* 25 */ {"var25", "undefined"},
+    /* 26 */ {"var26", "undefined"},
+    /* 27 */ {"var27", "undefined"},
+    /* 28 */ {"var28", "undefined"},
+    /* 29 */ {"var29", "undefined"},
+    /* 30 */ {"var30", "undefined"},
+    /* 31 */ {"var31", "undefined"},
+    /* 32 */ {"var32", "undefined"},
+    /* 33 */ {"var33", "undefined"},
+    /* 34 */ {"var34", "undefined"},
+    /* 35 */ {"var35", "undefined"},
+    /* 36 */ {"var36", "undefined"},
+    /* 37 */ {"var37", "undefined"},
+    /* 38 */ {"var38", "undefined"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"var40", "undefined"},
+    /* 41 */ {"var41", "undefined"},
+    /* 42 */ {"var42", "undefined"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"var44", "undefined"},
+    /* 45 */ {"var45", "undefined"},
+    /* 46 */ {"var46", "undefined"},
+    /* 47 */ {"var47", "undefined"},
+    /* 48 */ {"var48", "undefined"},
+    /* 49 */ {"var49", "undefined"},
+    /* 50 */ {"var50", "undefined"},
+    /* 51 */ {"var51", "undefined"},
+    /* 52 */ {"var52", "undefined"},
+    /* 53 */ {"var53", "undefined"},
+    /* 54 */ {"var54", "undefined"},
+    /* 55 */ {"var55", "undefined"},
+    /* 56 */ {"var56", "undefined"},
+    /* 57 */ {"var57", "undefined"},
+    /* 58 */ {"var58", "undefined"},
+    /* 59 */ {"var59", "undefined"},
+    /* 60 */ {"var60", "undefined"},
+    /* 61 */ {"var61", "undefined"},
+    /* 62 */ {"var62", "undefined"},
+    /* 63 */ {"var63", "undefined"},
+    /* 64 */ {"var64", "undefined"},
+    /* 65 */ {"var65", "undefined"},
+    /* 66 */ {"var66", "undefined"},
+    /* 67 */ {"var67", "undefined"},
+    /* 68 */ {"var68", "undefined"},
+    /* 69 */ {"var69", "undefined"},
+    /* 70 */ {"var70", "undefined"},
+    /* 71 */ {"var71", "undefined"},
+    /* 72 */ {"var72", "undefined"},
+    /* 73 */ {"var73", "undefined"},
+    /* 74 */ {"var74", "undefined"},
+    /* 75 */ {"var75", "undefined"},
+    /* 76 */ {"var76", "undefined"},
+    /* 77 */ {"var77", "undefined"},
+    /* 78 */ {"var78", "undefined"},
+    /* 79 */ {"var79", "undefined"},
+    /* 80 */ {"var80", "undefined"},
+    /* 81 */ {"var81", "undefined"},
+    /* 82 */ {"var82", "undefined"},
+    /* 83 */ {"var83", "undefined"},
+    /* 84 */ {"var84", "undefined"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"var86", "undefined"},
+    /* 87 */ {"var87", "undefined"},
+    /* 88 */ {"var88", "undefined"},
+    /* 89 */ {"var89", "undefined"},
+    /* 90 */ {"var90", "undefined"},
+    /* 91 */ {"var91", "undefined"},
+    /* 92 */ {"var92", "undefined"},
+    /* 93 */ {"var93", "undefined"},
+    /* 94 */ {"var94", "undefined"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"var99", "undefined"},
+    /* 100 */ {"var100", "undefined"},
+    /* 101 */ {"var101", "undefined"},
+    /* 102 */ {"var102", "undefined"},
+    /* 103 */ {"var103", "undefined"},
+    /* 104 */ {"var104", "undefined"},
+    /* 105 */ {"var105", "undefined"},
+    /* 106 */ {"var106", "undefined"},
+    /* 107 */ {"var107", "undefined"},
+    /* 108 */ {"var108", "undefined"},
+    /* 109 */ {"var109", "undefined"},
+    /* 110 */ {"var110", "undefined"},
+    /* 111 */ {"var111", "undefined"},
+    /* 112 */ {"var112", "undefined"},
+    /* 113 */ {"var113", "undefined"},
+    /* 114 */ {"var114", "undefined"},
+    /* 115 */ {"var115", "undefined"},
+    /* 116 */ {"var116", "undefined"},
+    /* 117 */ {"var117", "undefined"},
+    /* 118 */ {"var118", "undefined"},
+    /* 119 */ {"var119", "undefined"},
+    /* 120 */ {"var120", "undefined"},
+    /* 121 */ {"var121", "undefined"},
+    /* 122 */ {"var122", "undefined"},
+    /* 123 */ {"var123", "undefined"},
+    /* 124 */ {"var124", "undefined"},
+    /* 125 */ {"var125", "undefined"},
+    /* 126 */ {"var126", "undefined"},
+    /* 127 */ {"AT", "Atmospheric tide+ -"},
+    /* 128 */ {"BV", "Budget values+ -"},
+    /* 129 */ {"Z", "Geopotential (at the surface=orography) m**2 s**-2"},
+    /* 130 */ {"T", "Temperature K"},
+    /* 131 */ {"U", "U-velocity m s**-1"},
+    /* 132 */ {"V", "V-velocity m s**-1"},
+    /* 133 */ {"Q", "Specific humidity kg kg**-1"},
+    /* 134 */ {"SP", "Surface pressure Pa"},
+    /* 135 */ {"W", "Vertical velocity Pa s**-1"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"PWC", "Precipitable water content kg m**-2"},
+    /* 138 */ {"VO", "Vorticity (relative) s**-1"},
+    /* 139 */ {"ST", "Surf.temp/soil temp lev 1 (from 930804) K"},
+    /* 140 */ {"SSW", "Surf soil wet/soil wet lev1(from 930803) m (of water)"},
+    /* 141 */ {"SD", "Snow depth m (of water equivalent)"},
+    /* 142 */ {"LSP", "Large scale precipitation* m"},
+    /* 143 */ {"CP", "Convective precipitation* m"},
+    /* 144 */ {"SF", "Snow fall* m(of water equivalent)"},
+    /* 145 */ {"BLD", "Boundary layer dissipation* W m**-2 s"},
+    /* 146 */ {"SSHF", "Surface sensible heat flux* W m**-2 s"},
+    /* 147 */ {"SLHF", "Surface latent heat flux* W m**-2 s"},
+    /* 148 */ {"var148", "undefined"},
+    /* 149 */ {"var149", "undefined"},
+    /* 150 */ {"var150", "undefined"},
+    /* 151 */ {"MSL", "Mean sea level pressure Pa"},
+    /* 152 */ {"LNSP", "Log surface pressure -"},
+    /* 153 */ {"var153", "undefined"},
+    /* 154 */ {"var154", "undefined"},
+    /* 155 */ {"D", "Divergence s**-1"},
+    /* 156 */ {"GH", "Height (geopotential) m"},
+    /* 157 */ {"R", "Relative humidity %"},
+    /* 158 */ {"TSP", "Tendency of surface pressure Pa s**-1"},
+    /* 159 */ {"var159", "undefined"},
+    /* 160 */ {"SDOR", "Standard deviation of orography -"},
+    /* 161 */ {"ISOR", "Anisotropy of subgrid scale orography -"},
+    /* 162 */ {"ANOR", "Angle of subgrid scale orography -"},
+    /* 163 */ {"SLOR", "Slope of subgrid scale orography -"},
+    /* 164 */ {"TCC", "Total cloud cover (0 - 1)"},
+    /* 165 */ {"10U", "10 metre u wind component m s**-1"},
+    /* 166 */ {"10V", "10 metre v wind component m s**-1"},
+    /* 167 */ {"2T", "2 metre temperature K"},
+    /* 168 */ {"2D", "2 metre dewpoint temperature K"},
+    /* 169 */ {"var169", "undefined"},
+    /* 170 */ {"DST", "Deep soil tmp/soil temp lev2(frm 930804) K"},
+    /* 171 */ {"DSW", "Deep soil wet/soil wet lev2(from 930803) m (of water)"},
+    /* 172 */ {"LSM", "Land/sea mask (0"},
+    /* 173 */ {"SR", "Surface roughness m"},
+    /* 174 */ {"AL", "Albedo -"},
+    /* 175 */ {"var175", "undefined"},
+    /* 176 */ {"SSR", "Surface solar radiation* W m**-2 s"},
+    /* 177 */ {"STR", "Surface thermal radiation* W m**-2 s"},
+    /* 178 */ {"TSR", "Top solar radiation* W m**-2 s"},
+    /* 179 */ {"TTR", "Top thermal radiation* W m**-2 s"},
+    /* 180 */ {"EWSS", "East/West surface stress* N m**-2 s"},
+    /* 181 */ {"NSSS", "North/South surface stress* N m**-2 s"},
+    /* 182 */ {"E", "Evaporation* m (of water)"},
+    /* 183 */ {"CDST", "Clim deep soil tmp/soil tmp lev3(930804) K"},
+    /* 184 */ {"CDSW", "Clim deep soil wet/soil wet lev3(930803) m (of water)"},
+    /* 185 */ {"CCC", "Convective cloud cover (0 - 1)"},
+    /* 186 */ {"LCC", "Low cloud cover (0 - 1)"},
+    /* 187 */ {"MCC", "Medium cloud cover (0 - 1)"},
+    /* 188 */ {"HCC", "High cloud cover (0 - 1)"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"EWOV", "EW component subgrid scale orographic variance m**2"},
+    /* 191 */ {"NSOV", "NS component subgrid scale orographic variance m**2"},
+    /* 192 */ {"NWOV", "NWSE component subgrid scale orographic variance m**2"},
+    /* 193 */ {"NEOV", "NESW component subgrid scale orographic variance m**2"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"LGWS", "Latitudinal component of gravity wave stress* N m**-2 s"},
+    /* 196 */ {"MGWS", "Meridional component of gravity wave stress* N m**-2 s"},
+    /* 197 */ {"GWD", "Gravity wave dissipation* W m**-2 s"},
+    /* 198 */ {"SRC", "Skin reservoir content m (of water)"},
+    /* 199 */ {"VEG", "Percentage of vegetation %"},
+    /* 200 */ {"VSO", "Variance of sub-grid scale orography m**2"},
+    /* 201 */ {"MX2T", "Max temp. at 2m since previous post-processing K"},
+    /* 202 */ {"MN2T", "Min temp. at 2m since previous post-processing K"},
+    /* 203 */ {"var203", "undefined"},
+    /* 204 */ {"PAW", "Precip. analysis weights -"},
+    /* 205 */ {"RO", "Runoff* m"},
+    /* 206 */ {"var206", "undefined"},
+    /* 207 */ {"var207", "undefined"},
+    /* 208 */ {"var208", "undefined"},
+    /* 209 */ {"var209", "undefined"},
+    /* 210 */ {"var210", "undefined"},
+    /* 211 */ {"var211", "undefined"},
+    /* 212 */ {"var212", "undefined"},
+    /* 213 */ {"var213", "undefined"},
+    /* 214 */ {"var214", "undefined"},
+    /* 215 */ {"var215", "undefined"},
+    /* 216 */ {"var216", "undefined"},
+    /* 217 */ {"var217", "undefined"},
+    /* 218 */ {"var218", "undefined"},
+    /* 219 */ {"var219", "undefined"},
+    /* 220 */ {"var220", "undefined"},
+    /* 221 */ {"var221", "undefined"},
+    /* 222 */ {"var222", "undefined"},
+    /* 223 */ {"var223", "undefined"},
+    /* 224 */ {"var224", "undefined"},
+    /* 225 */ {"var225", "undefined"},
+    /* 226 */ {"var226", "undefined"},
+    /* 227 */ {"var227", "undefined"},
+    /* 228 */ {"TP", "Total precipitation? m"},
+    /* 229 */ {"IEWS", "Instantaneous X surface stress N m**-2"},
+    /* 230 */ {"INSS", "Instantaneous Y surface stress N m**-2"},
+    /* 231 */ {"ISHF", "Instantaneous surface Heat Flux W m**-2"},
+    /* 232 */ {"IE", "Instantaneous Moisture Flux (evaporation) kg m**-2 s"},
+    /* 233 */ {"ASQ", "Apparent Surface Humidity kg kg**-1"},
+    /* 234 */ {"LSRH", "Logarithm of surface roughness length for heat -"},
+    /* 235 */ {"SKT", "Skin Temperature K"},
+    /* 236 */ {"STL4", "Soil temperature level 4 K"},
+    /* 237 */ {"SWL4", "Soil wetness level 4 m"},
+    /* 238 */ {"TSN", "Temperature of snow layer K"},
+    /* 239 */ {"CSF", "Convective snow-fall* m (of water equivalent)"},
+    /* 240 */ {"LSF", "Large scale snow-fall* m (of water equivalent)"},
+    /* 241 */ {"var241", "undefined"},
+    /* 242 */ {"var242", "undefined"},
+    /* 243 */ {"FAL", "Forecast albedo -"},
+    /* 244 */ {"FSR", "Forecast surface roughness m"},
+    /* 245 */ {"FLSR", "Forecast logarithm of surface roughness for heat -"},
+    /* 246 */ {"CLWC", "Cloud liquid water content kg kg**-1"},
+    /* 247 */ {"CIWC", "Cloud ice water content kg kg**-1"},
+    /* 248 */ {"CC", "Cloud cover (0 - 1)"},
+    /* 249 */ {"var249", "undefined"},
+    /* 250 */ {"", "Ice Age (0 first-year 1 multi-year)"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_130.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_130.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_130.c	(revision 2744)
@@ -0,0 +1,261 @@
+#include "cnames.h"
+
+
+struct ParmTable parm_table_ecmwf_130[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"var1", "undefined"},
+    /* 2 */ {"var2", "undefined"},
+    /* 3 */ {"var3", "undefined"},
+    /* 4 */ {"var4", "undefined"},
+    /* 5 */ {"var5", "undefined"},
+    /* 6 */ {"var6", "undefined"},
+    /* 7 */ {"var7", "undefined"},
+    /* 8 */ {"var8", "undefined"},
+    /* 9 */ {"var9", "undefined"},
+    /* 10 */ {"var10", "undefined"},
+    /* 11 */ {"var11", "undefined"},
+    /* 12 */ {"var12", "undefined"},
+    /* 13 */ {"var13", "undefined"},
+    /* 14 */ {"var14", "undefined"},
+    /* 15 */ {"var15", "undefined"},
+    /* 16 */ {"var16", "undefined"},
+    /* 17 */ {"var17", "undefined"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"var19", "undefined"},
+    /* 20 */ {"var20", "undefined"},
+    /* 21 */ {"var21", "undefined"},
+    /* 22 */ {"var22", "undefined"},
+    /* 23 */ {"var23", "undefined"},
+    /* 24 */ {"var24", "undefined"},
+    /* 25 */ {"var25", "undefined"},
+    /* 26 */ {"var26", "undefined"},
+    /* 27 */ {"var27", "undefined"},
+    /* 28 */ {"var28", "undefined"},
+    /* 29 */ {"var29", "undefined"},
+    /* 30 */ {"var30", "undefined"},
+    /* 31 */ {"var31", "undefined"},
+    /* 32 */ {"var32", "undefined"},
+    /* 33 */ {"var33", "undefined"},
+    /* 34 */ {"var34", "undefined"},
+    /* 35 */ {"var35", "undefined"},
+    /* 36 */ {"var36", "undefined"},
+    /* 37 */ {"var37", "undefined"},
+    /* 38 */ {"var38", "undefined"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"var40", "undefined"},
+    /* 41 */ {"var41", "undefined"},
+    /* 42 */ {"var42", "undefined"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"var44", "undefined"},
+    /* 45 */ {"var45", "undefined"},
+    /* 46 */ {"var46", "undefined"},
+    /* 47 */ {"var47", "undefined"},
+    /* 48 */ {"var48", "undefined"},
+    /* 49 */ {"var49", "undefined"},
+    /* 50 */ {"var50", "undefined"},
+    /* 51 */ {"var51", "undefined"},
+    /* 52 */ {"var52", "undefined"},
+    /* 53 */ {"var53", "undefined"},
+    /* 54 */ {"var54", "undefined"},
+    /* 55 */ {"var55", "undefined"},
+    /* 56 */ {"var56", "undefined"},
+    /* 57 */ {"var57", "undefined"},
+    /* 58 */ {"var58", "undefined"},
+    /* 59 */ {"var59", "undefined"},
+    /* 60 */ {"var60", "undefined"},
+    /* 61 */ {"var61", "undefined"},
+    /* 62 */ {"var62", "undefined"},
+    /* 63 */ {"var63", "undefined"},
+    /* 64 */ {"var64", "undefined"},
+    /* 65 */ {"var65", "undefined"},
+    /* 66 */ {"var66", "undefined"},
+    /* 67 */ {"var67", "undefined"},
+    /* 68 */ {"var68", "undefined"},
+    /* 69 */ {"var69", "undefined"},
+    /* 70 */ {"var70", "undefined"},
+    /* 71 */ {"var71", "undefined"},
+    /* 72 */ {"var72", "undefined"},
+    /* 73 */ {"var73", "undefined"},
+    /* 74 */ {"var74", "undefined"},
+    /* 75 */ {"var75", "undefined"},
+    /* 76 */ {"var76", "undefined"},
+    /* 77 */ {"var77", "undefined"},
+    /* 78 */ {"var78", "undefined"},
+    /* 79 */ {"var79", "undefined"},
+    /* 80 */ {"var80", "undefined"},
+    /* 81 */ {"var81", "undefined"},
+    /* 82 */ {"var82", "undefined"},
+    /* 83 */ {"var83", "undefined"},
+    /* 84 */ {"var84", "undefined"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"var86", "undefined"},
+    /* 87 */ {"var87", "undefined"},
+    /* 88 */ {"var88", "undefined"},
+    /* 89 */ {"var89", "undefined"},
+    /* 90 */ {"var90", "undefined"},
+    /* 91 */ {"var91", "undefined"},
+    /* 92 */ {"var92", "undefined"},
+    /* 93 */ {"var93", "undefined"},
+    /* 94 */ {"var94", "undefined"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"var99", "undefined"},
+    /* 100 */ {"var100", "undefined"},
+    /* 101 */ {"var101", "undefined"},
+    /* 102 */ {"var102", "undefined"},
+    /* 103 */ {"var103", "undefined"},
+    /* 104 */ {"var104", "undefined"},
+    /* 105 */ {"var105", "undefined"},
+    /* 106 */ {"var106", "undefined"},
+    /* 107 */ {"var107", "undefined"},
+    /* 108 */ {"var108", "undefined"},
+    /* 109 */ {"var109", "undefined"},
+    /* 110 */ {"var110", "undefined"},
+    /* 111 */ {"var111", "undefined"},
+    /* 112 */ {"var112", "undefined"},
+    /* 113 */ {"var113", "undefined"},
+    /* 114 */ {"var114", "undefined"},
+    /* 115 */ {"var115", "undefined"},
+    /* 116 */ {"var116", "undefined"},
+    /* 117 */ {"var117", "undefined"},
+    /* 118 */ {"var118", "undefined"},
+    /* 119 */ {"var119", "undefined"},
+    /* 120 */ {"var120", "undefined"},
+    /* 121 */ {"var121", "undefined"},
+    /* 122 */ {"var122", "undefined"},
+    /* 123 */ {"var123", "undefined"},
+    /* 124 */ {"var124", "undefined"},
+    /* 125 */ {"var125", "undefined"},
+    /* 126 */ {"var126", "undefined"},
+    /* 127 */ {"var127", "undefined"},
+    /* 128 */ {"var128", "undefined"},
+    /* 129 */ {"var129", "undefined"},
+    /* 130 */ {"var130", "undefined"},
+    /* 131 */ {"var131", "undefined"},
+    /* 132 */ {"var132", "undefined"},
+    /* 133 */ {"var133", "undefined"},
+    /* 134 */ {"var134", "undefined"},
+    /* 135 */ {"var135", "undefined"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"var137", "undefined"},
+    /* 138 */ {"var138", "undefined"},
+    /* 139 */ {"var139", "undefined"},
+    /* 140 */ {"var140", "undefined"},
+    /* 141 */ {"var141", "undefined"},
+    /* 142 */ {"var142", "undefined"},
+    /* 143 */ {"var143", "undefined"},
+    /* 144 */ {"var144", "undefined"},
+    /* 145 */ {"var145", "undefined"},
+    /* 146 */ {"var146", "undefined"},
+    /* 147 */ {"var147", "undefined"},
+    /* 148 */ {"var148", "undefined"},
+    /* 149 */ {"var149", "undefined"},
+    /* 150 */ {"var150", "undefined"},
+    /* 151 */ {"var151", "undefined"},
+    /* 152 */ {"var152", "undefined"},
+    /* 153 */ {"var153", "undefined"},
+    /* 154 */ {"var154", "undefined"},
+    /* 155 */ {"var155", "undefined"},
+    /* 156 */ {"var156", "undefined"},
+    /* 157 */ {"var157", "undefined"},
+    /* 158 */ {"var158", "undefined"},
+    /* 159 */ {"var159", "undefined"},
+    /* 160 */ {"var160", "undefined"},
+    /* 161 */ {"var161", "undefined"},
+    /* 162 */ {"var162", "undefined"},
+    /* 163 */ {"var163", "undefined"},
+    /* 164 */ {"var164", "undefined"},
+    /* 165 */ {"var165", "undefined"},
+    /* 166 */ {"var166", "undefined"},
+    /* 167 */ {"var167", "undefined"},
+    /* 168 */ {"var168", "undefined"},
+    /* 169 */ {"var169", "undefined"},
+    /* 170 */ {"var170", "undefined"},
+    /* 171 */ {"var171", "undefined"},
+    /* 172 */ {"var172", "undefined"},
+    /* 173 */ {"var173", "undefined"},
+    /* 174 */ {"var174", "undefined"},
+    /* 175 */ {"var175", "undefined"},
+    /* 176 */ {"var176", "undefined"},
+    /* 177 */ {"var177", "undefined"},
+    /* 178 */ {"var178", "undefined"},
+    /* 179 */ {"var179", "undefined"},
+    /* 180 */ {"var180", "undefined"},
+    /* 181 */ {"var181", "undefined"},
+    /* 182 */ {"var182", "undefined"},
+    /* 183 */ {"var183", "undefined"},
+    /* 184 */ {"var184", "undefined"},
+    /* 185 */ {"var185", "undefined"},
+    /* 186 */ {"var186", "undefined"},
+    /* 187 */ {"var187", "undefined"},
+    /* 188 */ {"var188", "undefined"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"var190", "undefined"},
+    /* 191 */ {"var191", "undefined"},
+    /* 192 */ {"var192", "undefined"},
+    /* 193 */ {"var193", "undefined"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"var195", "undefined"},
+    /* 196 */ {"var196", "undefined"},
+    /* 197 */ {"var197", "undefined"},
+    /* 198 */ {"var198", "undefined"},
+    /* 199 */ {"var199", "undefined"},
+    /* 200 */ {"var200", "undefined"},
+    /* 201 */ {"var201", "undefined"},
+    /* 202 */ {"var202", "undefined"},
+    /* 203 */ {"var203", "undefined"},
+    /* 204 */ {"var204", "undefined"},
+    /* 205 */ {"var205", "undefined"},
+    /* 206 */ {"var206", "undefined"},
+    /* 207 */ {"var207", "undefined"},
+    /* 208 */ {"TSRU", "Top solar radiation upward W m**-2"},
+    /* 209 */ {"TTRU", "Top thermal radiation upward W m**-2"},
+    /* 210 */ {"TSUC", "Top solar radiation upward clear sky W m**-2"},
+    /* 211 */ {"TTUC", "Top thermal radiation upward clear sky W m**-2"},
+    /* 212 */ {"CLW", "Cloud liquid water kg kg**-1"},
+    /* 213 */ {"CF", "Cloud fraction 0-1"},
+    /* 214 */ {"DHR", "Diabatic heating by radiation K s**-1"},
+    /* 215 */ {"DHVD", "Diabatic heating by vertical diffusion K s**-1"},
+    /* 216 */ {"DHCC", "Diabatic heating by cumulus convection K s**-1"},
+    /* 217 */ {"DHLC", "Diabatic heating by large-scale condensation K s**-1"},
+    /* 218 */ {"VDZW", "Vertical diffusion of zonal wind m**2 s**-3"},
+    /* 219 */ {"VDMW", "Vertical diffusion of meridional wind m**2 s**-3"},
+    /* 220 */ {"EWGD", "EW gravity wave drag m**2 s**-3"},
+    /* 221 */ {"NSGD", "NS gravity wave drag m**2 s**-3"},
+    /* 222 */ {"CTZW", "Convective tendency of zonal wind m**2 s**-3"},
+    /* 223 */ {"CTMW", "Convective tendency of meridional wind m**2 s**-3"},
+    /* 224 */ {"VDH", "Vertical diffusion of humidity kg kg**-1 s**-1"},
+    /* 225 */ {"HTCC", "Humidity tendency by cumulus convection kg kg**-1 s**-1"},
+    /* 226 */ {"HTLC", "Humidity tendency by large-scale condensation kg kg**-1 s**-1"},
+    /* 227 */ {"CRNH", "Change from removing negative humidity kg kg**-1 s**-1"},
+    /* 228 */ {"ATT", "Adiabatic tendency of temperature K s**-1"},
+    /* 229 */ {"ATH", "Adiabatic tendency of humidity kg kg**-1 s**-1"},
+    /* 230 */ {"ATZW", "Adiabatic tendency of zonal wind m**2 s**-3"},
+    /* 231 */ {"ATMW", "Adiabatic tendency of meridional wind m**2 s**-3"},
+    /* 232 */ {"MVV", "Mean vertical velocity Pa s**-1"},
+    /* 233 */ {"var233", "undefined"},
+    /* 234 */ {"var234", "undefined"},
+    /* 235 */ {"var235", "undefined"},
+    /* 236 */ {"var236", "undefined"},
+    /* 237 */ {"var237", "undefined"},
+    /* 238 */ {"var238", "undefined"},
+    /* 239 */ {"var239", "undefined"},
+    /* 240 */ {"var240", "undefined"},
+    /* 241 */ {"var241", "undefined"},
+    /* 242 */ {"var242", "undefined"},
+    /* 243 */ {"var243", "undefined"},
+    /* 244 */ {"var244", "undefined"},
+    /* 245 */ {"var245", "undefined"},
+    /* 246 */ {"var246", "undefined"},
+    /* 247 */ {"var247", "undefined"},
+    /* 248 */ {"var248", "undefined"},
+    /* 249 */ {"var249", "undefined"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_131.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_131.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_131.c	(revision 2744)
@@ -0,0 +1,261 @@
+#include "cnames.h"
+
+
+struct ParmTable parm_table_ecmwf_131[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"var1", "undefined"},
+    /* 2 */ {"var2", "undefined"},
+    /* 3 */ {"var3", "undefined"},
+    /* 4 */ {"var4", "undefined"},
+    /* 5 */ {"var5", "undefined"},
+    /* 6 */ {"var6", "undefined"},
+    /* 7 */ {"var7", "undefined"},
+    /* 8 */ {"var8", "undefined"},
+    /* 9 */ {"var9", "undefined"},
+    /* 10 */ {"var10", "undefined"},
+    /* 11 */ {"var11", "undefined"},
+    /* 12 */ {"var12", "undefined"},
+    /* 13 */ {"var13", "undefined"},
+    /* 14 */ {"var14", "undefined"},
+    /* 15 */ {"var15", "undefined"},
+    /* 16 */ {"var16", "undefined"},
+    /* 17 */ {"var17", "undefined"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"var19", "undefined"},
+    /* 20 */ {"var20", "undefined"},
+    /* 21 */ {"var21", "undefined"},
+    /* 22 */ {"var22", "undefined"},
+    /* 23 */ {"var23", "undefined"},
+    /* 24 */ {"var24", "undefined"},
+    /* 25 */ {"var25", "undefined"},
+    /* 26 */ {"var26", "undefined"},
+    /* 27 */ {"var27", "undefined"},
+    /* 28 */ {"var28", "undefined"},
+    /* 29 */ {"var29", "undefined"},
+    /* 30 */ {"var30", "undefined"},
+    /* 31 */ {"var31", "undefined"},
+    /* 32 */ {"var32", "undefined"},
+    /* 33 */ {"var33", "undefined"},
+    /* 34 */ {"var34", "undefined"},
+    /* 35 */ {"var35", "undefined"},
+    /* 36 */ {"var36", "undefined"},
+    /* 37 */ {"var37", "undefined"},
+    /* 38 */ {"var38", "undefined"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"var40", "undefined"},
+    /* 41 */ {"var41", "undefined"},
+    /* 42 */ {"var42", "undefined"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"var44", "undefined"},
+    /* 45 */ {"var45", "undefined"},
+    /* 46 */ {"var46", "undefined"},
+    /* 47 */ {"var47", "undefined"},
+    /* 48 */ {"var48", "undefined"},
+    /* 49 */ {"var49", "undefined"},
+    /* 50 */ {"var50", "undefined"},
+    /* 51 */ {"var51", "undefined"},
+    /* 52 */ {"var52", "undefined"},
+    /* 53 */ {"var53", "undefined"},
+    /* 54 */ {"var54", "undefined"},
+    /* 55 */ {"var55", "undefined"},
+    /* 56 */ {"var56", "undefined"},
+    /* 57 */ {"var57", "undefined"},
+    /* 58 */ {"var58", "undefined"},
+    /* 59 */ {"var59", "undefined"},
+    /* 60 */ {"var60", "undefined"},
+    /* 61 */ {"var61", "undefined"},
+    /* 62 */ {"var62", "undefined"},
+    /* 63 */ {"var63", "undefined"},
+    /* 64 */ {"var64", "undefined"},
+    /* 65 */ {"var65", "undefined"},
+    /* 66 */ {"var66", "undefined"},
+    /* 67 */ {"var67", "undefined"},
+    /* 68 */ {"var68", "undefined"},
+    /* 69 */ {"var69", "undefined"},
+    /* 70 */ {"var70", "undefined"},
+    /* 71 */ {"var71", "undefined"},
+    /* 72 */ {"var72", "undefined"},
+    /* 73 */ {"var73", "undefined"},
+    /* 74 */ {"var74", "undefined"},
+    /* 75 */ {"var75", "undefined"},
+    /* 76 */ {"var76", "undefined"},
+    /* 77 */ {"var77", "undefined"},
+    /* 78 */ {"var78", "undefined"},
+    /* 79 */ {"var79", "undefined"},
+    /* 80 */ {"var80", "undefined"},
+    /* 81 */ {"var81", "undefined"},
+    /* 82 */ {"var82", "undefined"},
+    /* 83 */ {"var83", "undefined"},
+    /* 84 */ {"var84", "undefined"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"var86", "undefined"},
+    /* 87 */ {"var87", "undefined"},
+    /* 88 */ {"var88", "undefined"},
+    /* 89 */ {"var89", "undefined"},
+    /* 90 */ {"var90", "undefined"},
+    /* 91 */ {"var91", "undefined"},
+    /* 92 */ {"var92", "undefined"},
+    /* 93 */ {"var93", "undefined"},
+    /* 94 */ {"var94", "undefined"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"var99", "undefined"},
+    /* 100 */ {"var100", "undefined"},
+    /* 101 */ {"var101", "undefined"},
+    /* 102 */ {"var102", "undefined"},
+    /* 103 */ {"var103", "undefined"},
+    /* 104 */ {"var104", "undefined"},
+    /* 105 */ {"var105", "undefined"},
+    /* 106 */ {"var106", "undefined"},
+    /* 107 */ {"var107", "undefined"},
+    /* 108 */ {"var108", "undefined"},
+    /* 109 */ {"var109", "undefined"},
+    /* 110 */ {"var110", "undefined"},
+    /* 111 */ {"var111", "undefined"},
+    /* 112 */ {"var112", "undefined"},
+    /* 113 */ {"var113", "undefined"},
+    /* 114 */ {"var114", "undefined"},
+    /* 115 */ {"var115", "undefined"},
+    /* 116 */ {"var116", "undefined"},
+    /* 117 */ {"var117", "undefined"},
+    /* 118 */ {"var118", "undefined"},
+    /* 119 */ {"var119", "undefined"},
+    /* 120 */ {"var120", "undefined"},
+    /* 121 */ {"var121", "undefined"},
+    /* 122 */ {"var122", "undefined"},
+    /* 123 */ {"var123", "undefined"},
+    /* 124 */ {"var124", "undefined"},
+    /* 125 */ {"var125", "undefined"},
+    /* 126 */ {"var126", "undefined"},
+    /* 127 */ {"var127", "undefined"},
+    /* 128 */ {"var128", "undefined"},
+    /* 129 */ {"var129", "undefined"},
+    /* 130 */ {"TAP", "Temperature anomaly probability % K"},
+    /* 131 */ {"var131", "undefined"},
+    /* 132 */ {"var132", "undefined"},
+    /* 133 */ {"var133", "undefined"},
+    /* 134 */ {"var134", "undefined"},
+    /* 135 */ {"var135", "undefined"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"var137", "undefined"},
+    /* 138 */ {"var138", "undefined"},
+    /* 139 */ {"var139", "undefined"},
+    /* 140 */ {"var140", "undefined"},
+    /* 141 */ {"var141", "undefined"},
+    /* 142 */ {"var142", "undefined"},
+    /* 143 */ {"var143", "undefined"},
+    /* 144 */ {"var144", "undefined"},
+    /* 145 */ {"var145", "undefined"},
+    /* 146 */ {"var146", "undefined"},
+    /* 147 */ {"var147", "undefined"},
+    /* 148 */ {"var148", "undefined"},
+    /* 149 */ {"var149", "undefined"},
+    /* 150 */ {"var150", "undefined"},
+    /* 151 */ {"var151", "undefined"},
+    /* 152 */ {"var152", "undefined"},
+    /* 153 */ {"var153", "undefined"},
+    /* 154 */ {"var154", "undefined"},
+    /* 155 */ {"var155", "undefined"},
+    /* 156 */ {"var156", "undefined"},
+    /* 157 */ {"var157", "undefined"},
+    /* 158 */ {"var158", "undefined"},
+    /* 159 */ {"var159", "undefined"},
+    /* 160 */ {"var160", "undefined"},
+    /* 161 */ {"var161", "undefined"},
+    /* 162 */ {"var162", "undefined"},
+    /* 163 */ {"var163", "undefined"},
+    /* 164 */ {"var164", "undefined"},
+    /* 165 */ {"10SP", "10 metre speed probability % m s**-1"},
+    /* 166 */ {"var166", "undefined"},
+    /* 167 */ {"2TP", "2 metre temperature probability %"},
+    /* 168 */ {"var168", "undefined"},
+    /* 169 */ {"var169", "undefined"},
+    /* 170 */ {"var170", "undefined"},
+    /* 171 */ {"var171", "undefined"},
+    /* 172 */ {"var172", "undefined"},
+    /* 173 */ {"var173", "undefined"},
+    /* 174 */ {"var174", "undefined"},
+    /* 175 */ {"var175", "undefined"},
+    /* 176 */ {"var176", "undefined"},
+    /* 177 */ {"var177", "undefined"},
+    /* 178 */ {"var178", "undefined"},
+    /* 179 */ {"var179", "undefined"},
+    /* 180 */ {"var180", "undefined"},
+    /* 181 */ {"var181", "undefined"},
+    /* 182 */ {"var182", "undefined"},
+    /* 183 */ {"var183", "undefined"},
+    /* 184 */ {"var184", "undefined"},
+    /* 185 */ {"var185", "undefined"},
+    /* 186 */ {"var186", "undefined"},
+    /* 187 */ {"var187", "undefined"},
+    /* 188 */ {"var188", "undefined"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"var190", "undefined"},
+    /* 191 */ {"var191", "undefined"},
+    /* 192 */ {"var192", "undefined"},
+    /* 193 */ {"var193", "undefined"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"var195", "undefined"},
+    /* 196 */ {"var196", "undefined"},
+    /* 197 */ {"var197", "undefined"},
+    /* 198 */ {"var198", "undefined"},
+    /* 199 */ {"var199", "undefined"},
+    /* 200 */ {"var200", "undefined"},
+    /* 201 */ {"var201", "undefined"},
+    /* 202 */ {"var202", "undefined"},
+    /* 203 */ {"var203", "undefined"},
+    /* 204 */ {"var204", "undefined"},
+    /* 205 */ {"var205", "undefined"},
+    /* 206 */ {"var206", "undefined"},
+    /* 207 */ {"var207", "undefined"},
+    /* 208 */ {"var208", "undefined"},
+    /* 209 */ {"var209", "undefined"},
+    /* 210 */ {"var210", "undefined"},
+    /* 211 */ {"var211", "undefined"},
+    /* 212 */ {"var212", "undefined"},
+    /* 213 */ {"var213", "undefined"},
+    /* 214 */ {"var214", "undefined"},
+    /* 215 */ {"var215", "undefined"},
+    /* 216 */ {"var216", "undefined"},
+    /* 217 */ {"var217", "undefined"},
+    /* 218 */ {"var218", "undefined"},
+    /* 219 */ {"var219", "undefined"},
+    /* 220 */ {"var220", "undefined"},
+    /* 221 */ {"var221", "undefined"},
+    /* 222 */ {"var222", "undefined"},
+    /* 223 */ {"var223", "undefined"},
+    /* 224 */ {"var224", "undefined"},
+    /* 225 */ {"var225", "undefined"},
+    /* 226 */ {"var226", "undefined"},
+    /* 227 */ {"var227", "undefined"},
+    /* 228 */ {"TPP", "Total precipitation probability % m"},
+    /* 229 */ {"var229", "undefined"},
+    /* 230 */ {"var230", "undefined"},
+    /* 231 */ {"var231", "undefined"},
+    /* 232 */ {"var232", "undefined"},
+    /* 233 */ {"var233", "undefined"},
+    /* 234 */ {"var234", "undefined"},
+    /* 235 */ {"var235", "undefined"},
+    /* 236 */ {"var236", "undefined"},
+    /* 237 */ {"var237", "undefined"},
+    /* 238 */ {"var238", "undefined"},
+    /* 239 */ {"var239", "undefined"},
+    /* 240 */ {"var240", "undefined"},
+    /* 241 */ {"var241", "undefined"},
+    /* 242 */ {"var242", "undefined"},
+    /* 243 */ {"var243", "undefined"},
+    /* 244 */ {"var244", "undefined"},
+    /* 245 */ {"var245", "undefined"},
+    /* 246 */ {"var246", "undefined"},
+    /* 247 */ {"var247", "undefined"},
+    /* 248 */ {"var248", "undefined"},
+    /* 249 */ {"var249", "undefined"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_140.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_140.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_140.c	(revision 2744)
@@ -0,0 +1,260 @@
+#include "cnames.h"
+
+struct ParmTable parm_table_ecmwf_140[256] = {
+      /* 0 */ {"var0", "undefined"},
+      /* 1 */ {"var1", "undefined"},
+      /* 2 */ {"var2", "undefined"},
+      /* 3 */ {"var3", "undefined"},
+      /* 4 */ {"var4", "undefined"},
+      /* 5 */ {"var5", "undefined"},
+      /* 6 */ {"var6", "undefined"},
+      /* 7 */ {"var7", "undefined"},
+      /* 8 */ {"var8", "undefined"},
+      /* 9 */ {"var9", "undefined"},
+      /* 10 */ {"var10", "undefined"},
+      /* 11 */ {"var11", "undefined"},
+      /* 12 */ {"var12", "undefined"},
+      /* 13 */ {"var13", "undefined"},
+      /* 14 */ {"var14", "undefined"},
+      /* 15 */ {"var15", "undefined"},
+      /* 16 */ {"var16", "undefined"},
+      /* 17 */ {"var17", "undefined"},
+      /* 18 */ {"var18", "undefined"},
+      /* 19 */ {"var19", "undefined"},
+      /* 20 */ {"var20", "undefined"},
+      /* 21 */ {"var21", "undefined"},
+      /* 22 */ {"var22", "undefined"},
+      /* 23 */ {"var23", "undefined"},
+      /* 24 */ {"var24", "undefined"},
+      /* 25 */ {"var25", "undefined"},
+      /* 26 */ {"var26", "undefined"},
+      /* 27 */ {"var27", "undefined"},
+      /* 28 */ {"var28", "undefined"},
+      /* 29 */ {"var29", "undefined"},
+      /* 30 */ {"var30", "undefined"},
+      /* 31 */ {"var31", "undefined"},
+      /* 32 */ {"var32", "undefined"},
+      /* 33 */ {"var33", "undefined"},
+      /* 34 */ {"var34", "undefined"},
+      /* 35 */ {"var35", "undefined"},
+      /* 36 */ {"var36", "undefined"},
+      /* 37 */ {"var37", "undefined"},
+      /* 38 */ {"var38", "undefined"},
+      /* 39 */ {"var39", "undefined"},
+      /* 40 */ {"var40", "undefined"},
+      /* 41 */ {"var41", "undefined"},
+      /* 42 */ {"var42", "undefined"},
+      /* 43 */ {"var43", "undefined"},
+      /* 44 */ {"var44", "undefined"},
+      /* 45 */ {"var45", "undefined"},
+      /* 46 */ {"var46", "undefined"},
+      /* 47 */ {"var47", "undefined"},
+      /* 48 */ {"var48", "undefined"},
+      /* 49 */ {"var49", "undefined"},
+      /* 50 */ {"var50", "undefined"},
+      /* 51 */ {"var51", "undefined"},
+      /* 52 */ {"var52", "undefined"},
+      /* 53 */ {"var53", "undefined"},
+      /* 54 */ {"var54", "undefined"},
+      /* 55 */ {"var55", "undefined"},
+      /* 56 */ {"var56", "undefined"},
+      /* 57 */ {"var57", "undefined"},
+      /* 58 */ {"var58", "undefined"},
+      /* 59 */ {"var59", "undefined"},
+      /* 60 */ {"var60", "undefined"},
+      /* 61 */ {"var61", "undefined"},
+      /* 62 */ {"var62", "undefined"},
+      /* 63 */ {"var63", "undefined"},
+      /* 64 */ {"var64", "undefined"},
+      /* 65 */ {"var65", "undefined"},
+      /* 66 */ {"var66", "undefined"},
+      /* 67 */ {"var67", "undefined"},
+      /* 68 */ {"var68", "undefined"},
+      /* 69 */ {"var69", "undefined"},
+      /* 70 */ {"var70", "undefined"},
+      /* 71 */ {"var71", "undefined"},
+      /* 72 */ {"var72", "undefined"},
+      /* 73 */ {"var73", "undefined"},
+      /* 74 */ {"var74", "undefined"},
+      /* 75 */ {"var75", "undefined"},
+      /* 76 */ {"var76", "undefined"},
+      /* 77 */ {"var77", "undefined"},
+      /* 78 */ {"var78", "undefined"},
+      /* 79 */ {"var79", "undefined"},
+      /* 80 */ {"var80", "undefined"},
+      /* 81 */ {"var81", "undefined"},
+      /* 82 */ {"var82", "undefined"},
+      /* 83 */ {"var83", "undefined"},
+      /* 84 */ {"var84", "undefined"},
+      /* 85 */ {"var85", "undefined"},
+      /* 86 */ {"var86", "undefined"},
+      /* 87 */ {"var87", "undefined"},
+      /* 88 */ {"var88", "undefined"},
+      /* 89 */ {"var89", "undefined"},
+      /* 90 */ {"var90", "undefined"},
+      /* 91 */ {"var91", "undefined"},
+      /* 92 */ {"var92", "undefined"},
+      /* 93 */ {"var93", "undefined"},
+      /* 94 */ {"var94", "undefined"},
+      /* 95 */ {"var95", "undefined"},
+      /* 96 */ {"var96", "undefined"},
+      /* 97 */ {"var97", "undefined"},
+      /* 98 */ {"var98", "undefined"},
+      /* 99 */ {"var99", "undefined"},
+      /* 100 */ {"var100", "undefined"},
+      /* 101 */ {"var101", "undefined"},
+      /* 102 */ {"var102", "undefined"},
+      /* 103 */ {"var103", "undefined"},
+      /* 104 */ {"var104", "undefined"},
+      /* 105 */ {"var105", "undefined"},
+      /* 106 */ {"var106", "undefined"},
+      /* 107 */ {"var107", "undefined"},
+      /* 108 */ {"var108", "undefined"},
+      /* 109 */ {"var109", "undefined"},
+      /* 110 */ {"var110", "undefined"},
+      /* 111 */ {"var111", "undefined"},
+      /* 112 */ {"var112", "undefined"},
+      /* 113 */ {"var113", "undefined"},
+      /* 114 */ {"var114", "undefined"},
+      /* 115 */ {"var115", "undefined"},
+      /* 116 */ {"var116", "undefined"},
+      /* 117 */ {"var117", "undefined"},
+      /* 118 */ {"var118", "undefined"},
+      /* 119 */ {"var119", "undefined"},
+      /* 120 */ {"var120", "undefined"},
+      /* 121 */ {"var121", "undefined"},
+      /* 122 */ {"var122", "undefined"},
+      /* 123 */ {"var123", "undefined"},
+      /* 124 */ {"var124", "undefined"},
+      /* 125 */ {"var125", "undefined"},
+      /* 126 */ {"var126", "undefined"},
+      /* 127 */ {"var127", "undefined"},
+      /* 128 */ {"var128", "undefined"},
+      /* 129 */ {"var129", "undefined"},
+      /* 130 */ {"var130", "undefined"},
+      /* 131 */ {"var131", "undefined"},
+      /* 132 */ {"var132", "undefined"},
+      /* 133 */ {"var133", "undefined"},
+      /* 134 */ {"var134", "undefined"},
+      /* 135 */ {"var135", "undefined"},
+      /* 136 */ {"var136", "undefined"},
+      /* 137 */ {"var137", "undefined"},
+      /* 138 */ {"var138", "undefined"},
+      /* 139 */ {"var139", "undefined"},
+      /* 140 */ {"var140", "undefined"},
+      /* 141 */ {"var141", "undefined"},
+      /* 142 */ {"var142", "undefined"},
+      /* 143 */ {"var143", "undefined"},
+      /* 144 */ {"var144", "undefined"},
+      /* 145 */ {"var145", "undefined"},
+      /* 146 */ {"var146", "undefined"},
+      /* 147 */ {"var147", "undefined"},
+      /* 148 */ {"var148", "undefined"},
+      /* 149 */ {"var149", "undefined"},
+      /* 150 */ {"var150", "undefined"},
+      /* 151 */ {"var151", "undefined"},
+      /* 152 */ {"var152", "undefined"},
+      /* 153 */ {"var153", "undefined"},
+      /* 154 */ {"var154", "undefined"},
+      /* 155 */ {"var155", "undefined"},
+      /* 156 */ {"var156", "undefined"},
+      /* 157 */ {"var157", "undefined"},
+      /* 158 */ {"var158", "undefined"},
+      /* 159 */ {"var159", "undefined"},
+      /* 160 */ {"var160", "undefined"},
+      /* 161 */ {"var161", "undefined"},
+      /* 162 */ {"var162", "undefined"},
+      /* 163 */ {"var163", "undefined"},
+      /* 164 */ {"var164", "undefined"},
+      /* 165 */ {"var165", "undefined"},
+      /* 166 */ {"var166", "undefined"},
+      /* 167 */ {"var167", "undefined"},
+      /* 168 */ {"var168", "undefined"},
+      /* 169 */ {"var169", "undefined"},
+      /* 170 */ {"var170", "undefined"},
+      /* 171 */ {"var171", "undefined"},
+      /* 172 */ {"var172", "undefined"},
+      /* 173 */ {"var173", "undefined"},
+      /* 174 */ {"var174", "undefined"},
+      /* 175 */ {"var175", "undefined"},
+      /* 176 */ {"var176", "undefined"},
+      /* 177 */ {"var177", "undefined"},
+      /* 178 */ {"var178", "undefined"},
+      /* 179 */ {"var179", "undefined"},
+      /* 180 */ {"var180", "undefined"},
+      /* 181 */ {"var181", "undefined"},
+      /* 182 */ {"var182", "undefined"},
+      /* 183 */ {"var183", "undefined"},
+      /* 184 */ {"var184", "undefined"},
+      /* 185 */ {"var185", "undefined"},
+      /* 186 */ {"var186", "undefined"},
+      /* 187 */ {"var187", "undefined"},
+      /* 188 */ {"var188", "undefined"},
+      /* 189 */ {"var189", "undefined"},
+      /* 190 */ {"var190", "undefined"},
+      /* 191 */ {"var191", "undefined"},
+      /* 192 */ {"var192", "undefined"},
+      /* 193 */ {"var193", "undefined"},
+      /* 194 */ {"var194", "undefined"},
+      /* 195 */ {"var195", "undefined"},
+      /* 196 */ {"var196", "undefined"},
+      /* 197 */ {"var197", "undefined"},
+      /* 198 */ {"var198", "undefined"},
+      /* 199 */ {"var199", "undefined"},
+      /* 200 */ {"var200", "undefined"},
+      /* 201 */ {"var201", "undefined"},
+      /* 202 */ {"var202", "undefined"},
+      /* 203 */ {"var203", "undefined"},
+      /* 204 */ {"var204", "undefined"},
+      /* 205 */ {"var205", "undefined"},
+      /* 206 */ {"var206", "undefined"},
+      /* 207 */ {"var207", "undefined"},
+      /* 208 */ {"var208", "undefined"},
+      /* 209 */ {"var209", "undefined"},
+      /* 210 */ {"var210", "undefined"},
+      /* 211 */ {"var211", "undefined"},
+      /* 212 */ {"var212", "undefined"},
+      /* 213 */ {"var213", "undefined"},
+      /* 214 */ {"var214", "undefined"},
+      /* 215 */ {"var215", "undefined"},
+      /* 216 */ {"var216", "undefined"},
+      /* 217 */ {"var217", "undefined"},
+      /* 218 */ {"var218", "undefined"},
+      /* 219 */ {"var219", "undefined"},
+      /* 220 */ {"MP1", "Mean wave period based on first moment [s]"},
+      /* 221 */ {"MP2", "Mean wave period based on second moment [s]"},
+      /* 222 */ {"WDW", "Wave spectral directional width"},
+      /* 223 */ {"P1WW", "Mean wave period based on first moment for wind waves [s]"},
+      /* 224 */ {"P2WW", "Mean wave period based on second moment for wind waves [s]"},
+      /* 225 */ {"DWWW", "Wave spectral directional width for wind waves"},
+      /* 226 */ {"P1PS", "Mean wave period based on first moment for swell [s]"},
+      /* 227 */ {"P2PS", "Mean wave period based on second moment for swell [s]"},
+      /* 228 */ {"DWPS", "Wave spectral directional width for swell"},
+      /* 229 */ {"SWH", "Significant wave height [m]"},
+      /* 230 */ {"MWD", "Mean wave direction [degrees]"},
+      /* 231 */ {"PP1D", "Peak period of 1D spectra [s]"},
+      /* 232 */ {"MWP", "Mean wave period [s]"},
+      /* 233 */ {"CDWW", "Coefficient of drag with waves"},
+      /* 234 */ {"SHWW", "Significant height of wind waves [m]"},
+      /* 235 */ {"MDWW", "Mean direction of wind waves [degrees]"},
+      /* 236 */ {"MPWW", "Mean period of wind waves [s]"},
+      /* 237 */ {"SHPS", "Significant height of primary swell [m]"},
+      /* 238 */ {"MDPS", "Mean direction of primary swell [degrees]"},
+      /* 239 */ {"MPPS", "Mean period of primary swell [s]"},
+      /* 240 */ {"SDHS", "Standard deviation wave height [m]"},
+      /* 241 */ {"MU10", "Mean of 10 metre windspeed [m s**-1]"},
+      /* 242 */ {"MDWI", "Mean wind direction [degrees]"},
+      /* 243 */ {"SDU", "Standard deviation of 10 metre wind speed [m s**-1]"},
+      /* 244 */ {"MSQS", "Mean square slope of waves [dimensionless]"},
+      /* 245 */ {"WIND", "10 metre wind speed [m s**-1]"},
+      /* 246 */ {"AWH", "Altimeter wave height [m]"},
+      /* 247 */ {"ACWH", "Altimeter corrected wave height [m]"},
+      /* 248 */ {"ARRC", "Altimeter range relative correction"},
+      /* 249 */ {"DWI", "10 metre wind direction [degrees]"},
+      /* 250 */ {"2DSP", "2D wave spectra (multiple) [m**2 s]"},
+      /* 251 */ {"2DFD", "2D wave spectra (single) [m**2 s]"},
+      /* 252 */ {"var252", "undefined"},
+      /* 253 */ {"var253", "undefined"},
+      /* 254 */ {"var254", "undefined"},
+      /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_150.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_150.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_150.c	(revision 2744)
@@ -0,0 +1,261 @@
+#include "cnames.h"
+
+
+struct ParmTable parm_table_ecmwf_150[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"var1", "undefined"},
+    /* 2 */ {"var2", "undefined"},
+    /* 3 */ {"var3", "undefined"},
+    /* 4 */ {"var4", "undefined"},
+    /* 5 */ {"var5", "undefined"},
+    /* 6 */ {"var6", "undefined"},
+    /* 7 */ {"var7", "undefined"},
+    /* 8 */ {"var8", "undefined"},
+    /* 9 */ {"var9", "undefined"},
+    /* 10 */ {"var10", "undefined"},
+    /* 11 */ {"var11", "undefined"},
+    /* 12 */ {"var12", "undefined"},
+    /* 13 */ {"var13", "undefined"},
+    /* 14 */ {"var14", "undefined"},
+    /* 15 */ {"var15", "undefined"},
+    /* 16 */ {"var16", "undefined"},
+    /* 17 */ {"var17", "undefined"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"var19", "undefined"},
+    /* 20 */ {"var20", "undefined"},
+    /* 21 */ {"var21", "undefined"},
+    /* 22 */ {"var22", "undefined"},
+    /* 23 */ {"var23", "undefined"},
+    /* 24 */ {"var24", "undefined"},
+    /* 25 */ {"var25", "undefined"},
+    /* 26 */ {"var26", "undefined"},
+    /* 27 */ {"var27", "undefined"},
+    /* 28 */ {"var28", "undefined"},
+    /* 29 */ {"var29", "undefined"},
+    /* 30 */ {"var30", "undefined"},
+    /* 31 */ {"var31", "undefined"},
+    /* 32 */ {"var32", "undefined"},
+    /* 33 */ {"var33", "undefined"},
+    /* 34 */ {"var34", "undefined"},
+    /* 35 */ {"var35", "undefined"},
+    /* 36 */ {"var36", "undefined"},
+    /* 37 */ {"var37", "undefined"},
+    /* 38 */ {"var38", "undefined"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"var40", "undefined"},
+    /* 41 */ {"var41", "undefined"},
+    /* 42 */ {"var42", "undefined"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"var44", "undefined"},
+    /* 45 */ {"var45", "undefined"},
+    /* 46 */ {"var46", "undefined"},
+    /* 47 */ {"var47", "undefined"},
+    /* 48 */ {"var48", "undefined"},
+    /* 49 */ {"var49", "undefined"},
+    /* 50 */ {"var50", "undefined"},
+    /* 51 */ {"var51", "undefined"},
+    /* 52 */ {"var52", "undefined"},
+    /* 53 */ {"var53", "undefined"},
+    /* 54 */ {"var54", "undefined"},
+    /* 55 */ {"var55", "undefined"},
+    /* 56 */ {"var56", "undefined"},
+    /* 57 */ {"var57", "undefined"},
+    /* 58 */ {"var58", "undefined"},
+    /* 59 */ {"var59", "undefined"},
+    /* 60 */ {"var60", "undefined"},
+    /* 61 */ {"var61", "undefined"},
+    /* 62 */ {"var62", "undefined"},
+    /* 63 */ {"var63", "undefined"},
+    /* 64 */ {"var64", "undefined"},
+    /* 65 */ {"var65", "undefined"},
+    /* 66 */ {"var66", "undefined"},
+    /* 67 */ {"var67", "undefined"},
+    /* 68 */ {"var68", "undefined"},
+    /* 69 */ {"var69", "undefined"},
+    /* 70 */ {"var70", "undefined"},
+    /* 71 */ {"var71", "undefined"},
+    /* 72 */ {"var72", "undefined"},
+    /* 73 */ {"var73", "undefined"},
+    /* 74 */ {"var74", "undefined"},
+    /* 75 */ {"var75", "undefined"},
+    /* 76 */ {"var76", "undefined"},
+    /* 77 */ {"var77", "undefined"},
+    /* 78 */ {"var78", "undefined"},
+    /* 79 */ {"var79", "undefined"},
+    /* 80 */ {"var80", "undefined"},
+    /* 81 */ {"var81", "undefined"},
+    /* 82 */ {"var82", "undefined"},
+    /* 83 */ {"var83", "undefined"},
+    /* 84 */ {"var84", "undefined"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"var86", "undefined"},
+    /* 87 */ {"var87", "undefined"},
+    /* 88 */ {"var88", "undefined"},
+    /* 89 */ {"var89", "undefined"},
+    /* 90 */ {"var90", "undefined"},
+    /* 91 */ {"var91", "undefined"},
+    /* 92 */ {"var92", "undefined"},
+    /* 93 */ {"var93", "undefined"},
+    /* 94 */ {"var94", "undefined"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"var99", "undefined"},
+    /* 100 */ {"var100", "undefined"},
+    /* 101 */ {"var101", "undefined"},
+    /* 102 */ {"var102", "undefined"},
+    /* 103 */ {"var103", "undefined"},
+    /* 104 */ {"var104", "undefined"},
+    /* 105 */ {"var105", "undefined"},
+    /* 106 */ {"var106", "undefined"},
+    /* 107 */ {"var107", "undefined"},
+    /* 108 */ {"var108", "undefined"},
+    /* 109 */ {"var109", "undefined"},
+    /* 110 */ {"var110", "undefined"},
+    /* 111 */ {"var111", "undefined"},
+    /* 112 */ {"var112", "undefined"},
+    /* 113 */ {"var113", "undefined"},
+    /* 114 */ {"var114", "undefined"},
+    /* 115 */ {"var115", "undefined"},
+    /* 116 */ {"var116", "undefined"},
+    /* 117 */ {"var117", "undefined"},
+    /* 118 */ {"var118", "undefined"},
+    /* 119 */ {"var119", "undefined"},
+    /* 120 */ {"var120", "undefined"},
+    /* 121 */ {"var121", "undefined"},
+    /* 122 */ {"var122", "undefined"},
+    /* 123 */ {"var123", "undefined"},
+    /* 124 */ {"var124", "undefined"},
+    /* 125 */ {"var125", "undefined"},
+    /* 126 */ {"var126", "undefined"},
+    /* 127 */ {"var127", "undefined"},
+    /* 128 */ {"var128", "undefined"},
+    /* 129 */ {"NONE", "Ocean potential temperature deg C"},
+    /* 130 */ {"NONE", "Ocean salinity psu"},
+    /* 131 */ {"NONE", "Ocean potential density(reference = surface) kg m**-3 -1000"},
+    /* 132 */ {"var132", "undefined"},
+    /* 133 */ {"NONE", "Ocean u velocity m s**-1"},
+    /* 134 */ {"NONE", "Ocean v velocity m s**-1"},
+    /* 135 */ {"NONE", "Ocean w velocity m s**-1"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"NONE", "Richardson number -"},
+    /* 138 */ {"var138", "undefined"},
+    /* 139 */ {"NONE", "u*v product m s**-2"},
+    /* 140 */ {"NONE", "u*T product m s**-1 deg C"},
+    /* 141 */ {"NONE", "v*T product m s**-1 deg C"},
+    /* 142 */ {"NONE", "u*u product m s**-2"},
+    /* 143 */ {"NONE", "v*v product m s**-2"},
+    /* 144 */ {"NONE", "uv - u~v~ (u~ is time-mean of u) m s**-2"},
+    /* 145 */ {"NONE", "uT - u~T~ m s**-1 deg C"},
+    /* 146 */ {"NONE", "vT - v~T~ m s**-1 deg C"},
+    /* 147 */ {"NONE", "uu - u~u~ m s**-2"},
+    /* 148 */ {"NONE", "vv - v~v~ m s**-2"},
+    /* 149 */ {"var149", "undefined"},
+    /* 150 */ {"var150", "undefined"},
+    /* 151 */ {"var151", "undefined"},
+    /* 152 */ {"NONE", "Sea level (departure from geoid tides removed)"},
+    /* 153 */ {"NONE", "Barotropic stream function -"},
+    /* 154 */ {"NONE", "Mixed layer depth (Tcr=0.5 C for HOPE model) m"},
+    /* 155 */ {"NONE", "Depth (eg of isothermal surface) m"},
+    /* 156 */ {"var156", "undefined"},
+    /* 157 */ {"var157", "undefined"},
+    /* 158 */ {"var158", "undefined"},
+    /* 159 */ {"var159", "undefined"},
+    /* 160 */ {"var160", "undefined"},
+    /* 161 */ {"var161", "undefined"},
+    /* 162 */ {"var162", "undefined"},
+    /* 163 */ {"var163", "undefined"},
+    /* 164 */ {"var164", "undefined"},
+    /* 165 */ {"var165", "undefined"},
+    /* 166 */ {"var166", "undefined"},
+    /* 167 */ {"var167", "undefined"},
+    /* 168 */ {"NONE", "U-stress Pa"},
+    /* 169 */ {"NONE", "V-stress Pa"},
+    /* 170 */ {"NONE", "Turbulent Kinetic Energy input -"},
+    /* 171 */ {"NONE", "Net surface heat flux (+ve = down) -"},
+    /* 172 */ {"NONE", "Surface solar radiation -"},
+    /* 173 */ {"NONE", "P-E -"},
+    /* 174 */ {"var174", "undefined"},
+    /* 175 */ {"var175", "undefined"},
+    /* 176 */ {"var176", "undefined"},
+    /* 177 */ {"var177", "undefined"},
+    /* 178 */ {"var178", "undefined"},
+    /* 179 */ {"var179", "undefined"},
+    /* 180 */ {"NONE", "Diagnosed SST eror deg C"},
+    /* 181 */ {"NONE", "Heat flux correction W m**-2"},
+    /* 182 */ {"NONE", "Observed SST deg C"},
+    /* 183 */ {"NONE", "Observed heat flux W m**-2"},
+    /* 184 */ {"var184", "undefined"},
+    /* 185 */ {"var185", "undefined"},
+    /* 186 */ {"var186", "undefined"},
+    /* 187 */ {"var187", "undefined"},
+    /* 188 */ {"var188", "undefined"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"var190", "undefined"},
+    /* 191 */ {"var191", "undefined"},
+    /* 192 */ {"var192", "undefined"},
+    /* 193 */ {"var193", "undefined"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"var195", "undefined"},
+    /* 196 */ {"var196", "undefined"},
+    /* 197 */ {"var197", "undefined"},
+    /* 198 */ {"var198", "undefined"},
+    /* 199 */ {"var199", "undefined"},
+    /* 200 */ {"var200", "undefined"},
+    /* 201 */ {"var201", "undefined"},
+    /* 202 */ {"var202", "undefined"},
+    /* 203 */ {"var203", "undefined"},
+    /* 204 */ {"var204", "undefined"},
+    /* 205 */ {"var205", "undefined"},
+    /* 206 */ {"var206", "undefined"},
+    /* 207 */ {"var207", "undefined"},
+    /* 208 */ {"var208", "undefined"},
+    /* 209 */ {"var209", "undefined"},
+    /* 210 */ {"var210", "undefined"},
+    /* 211 */ {"var211", "undefined"},
+    /* 212 */ {"var212", "undefined"},
+    /* 213 */ {"var213", "undefined"},
+    /* 214 */ {"var214", "undefined"},
+    /* 215 */ {"var215", "undefined"},
+    /* 216 */ {"var216", "undefined"},
+    /* 217 */ {"var217", "undefined"},
+    /* 218 */ {"var218", "undefined"},
+    /* 219 */ {"var219", "undefined"},
+    /* 220 */ {"var220", "undefined"},
+    /* 221 */ {"var221", "undefined"},
+    /* 222 */ {"var222", "undefined"},
+    /* 223 */ {"var223", "undefined"},
+    /* 224 */ {"var224", "undefined"},
+    /* 225 */ {"var225", "undefined"},
+    /* 226 */ {"var226", "undefined"},
+    /* 227 */ {"var227", "undefined"},
+    /* 228 */ {"var228", "undefined"},
+    /* 229 */ {"var229", "undefined"},
+    /* 230 */ {"var230", "undefined"},
+    /* 231 */ {"var231", "undefined"},
+    /* 232 */ {"var232", "undefined"},
+    /* 233 */ {"var233", "undefined"},
+    /* 234 */ {"var234", "undefined"},
+    /* 235 */ {"var235", "undefined"},
+    /* 236 */ {"var236", "undefined"},
+    /* 237 */ {"var237", "undefined"},
+    /* 238 */ {"var238", "undefined"},
+    /* 239 */ {"var239", "undefined"},
+    /* 240 */ {"var240", "undefined"},
+    /* 241 */ {"var241", "undefined"},
+    /* 242 */ {"var242", "undefined"},
+    /* 243 */ {"var243", "undefined"},
+    /* 244 */ {"var244", "undefined"},
+    /* 245 */ {"var245", "undefined"},
+    /* 246 */ {"var246", "undefined"},
+    /* 247 */ {"var247", "undefined"},
+    /* 248 */ {"var248", "undefined"},
+    /* 249 */ {"var249", "undefined"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_151.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_151.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_151.c	(revision 2744)
@@ -0,0 +1,260 @@
+#include "cnames.h"
+
+struct ParmTable parm_table_ecmwf_151[256] = {
+      /* 0 */ {"var0", "undefined"},
+      /* 1 */ {"T", "Accum. potential temperature deg C"},
+      /* 2 */ {"", "Accum. salinity"},
+      /* 3 */ {"", "Accum. U-velocity m s**-1"},
+      /* 4 */ {"", "Accum. V-velocity m s**-1"},
+      /* 5 */ {"V", "Accum. W-velocity m s**-1"},
+      /* 6 */ {"ST", "Accum. modulus of strain rate tensor s**-1"},
+      /* 7 */ {"VS", "Accum. vertical viscosity m**2 s**-1"},
+      /* 8 */ {"DF", "Accum. vertical diffusivity m**2 s**-1"},
+      /* 9 */ {"EP", "Accum. depth m"},
+      /* 10 */ {"STH", "Accum. sigma-theta kg m**-3"},
+      /* 11 */ {"RN", "Accum. Richardson number -"},
+      /* 12 */ {"UV", "Accum. u*v product m**2 s**-2"},
+      /* 13 */ {"UT", "Accum. u*T product m s**-1 deg C"},
+      /* 14 */ {"VT", "Accum. v*T product m s**-1 deg C"},
+      /* 15 */ {"UU", "Accum. u*u product m**2 s**-2"},
+      /* 16 */ {"VV", "Accum. v*v product m**2 s**-2"},
+      /* 17 */ {"SL", "Accum. sea level (tides removed) m"},
+      /* 18 */ {"var18", "undefined"},
+      /* 19 */ {"BSF", "Accum. barotropic streamfunction m**3 s**-1"},
+      /* 20 */ {"MLD", "Accum. mixed layer depth m"},
+      /* 21 */ {"var21", "undefined"},
+      /* 22 */ {"var22", "undefined"},
+      /* 23 */ {"var23", "undefined"},
+      /* 24 */ {"var24", "undefined"},
+      /* 25 */ {"TAX", "Accum. U-stress Pa"},
+      /* 26 */ {"TAY", "Accum. V-stress Pa"},
+      /* 27 */ {"TKI", "Accum. turbulent kinetic energy input W m**-2"},
+      /* 28 */ {"NSF", "Accum. net surface heat flux W m**-2"},
+      /* 29 */ {"ASR", "Accum. absorbed solar radiation W m**-2"},
+      /* 30 */ {"PME", "Accum. precipitation - evaporation m s**-1"},
+      /* 31 */ {"SST", "Accum. specified SST deg C"},
+      /* 32 */ {"SHF", "Accum. specified surface heat flux W m**-2"},
+      /* 33 */ {"DTE", "Accum. diagnosed SST error deg C"},
+      /* 34 */ {"HFC", "Accum. heat flux correction W m**-2"},
+      /* 35 */ {"var35", "undefined"},
+      /* 36 */ {"var36", "undefined"},
+      /* 37 */ {"var37", "undefined"},
+      /* 38 */ {"var38", "undefined"},
+      /* 39 */ {"var39", "undefined"},
+      /* 40 */ {"var40", "undefined"},
+      /* 41 */ {"var41", "undefined"},
+      /* 42 */ {"var42", "undefined"},
+      /* 43 */ {"var43", "undefined"},
+      /* 44 */ {"var44", "undefined"},
+      /* 45 */ {"var45", "undefined"},
+      /* 46 */ {"var46", "undefined"},
+      /* 47 */ {"var47", "undefined"},
+      /* 48 */ {"var48", "undefined"},
+      /* 49 */ {"var49", "undefined"},
+      /* 50 */ {"var50", "undefined"},
+      /* 51 */ {"var51", "undefined"},
+      /* 52 */ {"var52", "undefined"},
+      /* 53 */ {"var53", "undefined"},
+      /* 54 */ {"var54", "undefined"},
+      /* 55 */ {"var55", "undefined"},
+      /* 56 */ {"var56", "undefined"},
+      /* 57 */ {"var57", "undefined"},
+      /* 58 */ {"var58", "undefined"},
+      /* 59 */ {"var59", "undefined"},
+      /* 60 */ {"var60", "undefined"},
+      /* 61 */ {"var61", "undefined"},
+      /* 62 */ {"var62", "undefined"},
+      /* 63 */ {"var63", "undefined"},
+      /* 64 */ {"var64", "undefined"},
+      /* 65 */ {"var65", "undefined"},
+      /* 66 */ {"var66", "undefined"},
+      /* 67 */ {"var67", "undefined"},
+      /* 68 */ {"var68", "undefined"},
+      /* 69 */ {"var69", "undefined"},
+      /* 70 */ {"var70", "undefined"},
+      /* 71 */ {"var71", "undefined"},
+      /* 72 */ {"var72", "undefined"},
+      /* 73 */ {"var73", "undefined"},
+      /* 74 */ {"var74", "undefined"},
+      /* 75 */ {"var75", "undefined"},
+      /* 76 */ {"var76", "undefined"},
+      /* 77 */ {"var77", "undefined"},
+      /* 78 */ {"var78", "undefined"},
+      /* 79 */ {"var79", "undefined"},
+      /* 80 */ {"var80", "undefined"},
+      /* 81 */ {"var81", "undefined"},
+      /* 82 */ {"var82", "undefined"},
+      /* 83 */ {"var83", "undefined"},
+      /* 84 */ {"var84", "undefined"},
+      /* 85 */ {"var85", "undefined"},
+      /* 86 */ {"var86", "undefined"},
+      /* 87 */ {"var87", "undefined"},
+      /* 88 */ {"var88", "undefined"},
+      /* 89 */ {"var89", "undefined"},
+      /* 90 */ {"var90", "undefined"},
+      /* 91 */ {"var91", "undefined"},
+      /* 92 */ {"var92", "undefined"},
+      /* 93 */ {"var93", "undefined"},
+      /* 94 */ {"var94", "undefined"},
+      /* 95 */ {"var95", "undefined"},
+      /* 96 */ {"var96", "undefined"},
+      /* 97 */ {"var97", "undefined"},
+      /* 98 */ {"var98", "undefined"},
+      /* 99 */ {"var99", "undefined"},
+      /* 100 */ {"var100", "undefined"},
+      /* 101 */ {"var101", "undefined"},
+      /* 102 */ {"var102", "undefined"},
+      /* 103 */ {"var103", "undefined"},
+      /* 104 */ {"var104", "undefined"},
+      /* 105 */ {"var105", "undefined"},
+      /* 106 */ {"var106", "undefined"},
+      /* 107 */ {"var107", "undefined"},
+      /* 108 */ {"var108", "undefined"},
+      /* 109 */ {"var109", "undefined"},
+      /* 110 */ {"var110", "undefined"},
+      /* 111 */ {"var111", "undefined"},
+      /* 112 */ {"var112", "undefined"},
+      /* 113 */ {"var113", "undefined"},
+      /* 114 */ {"var114", "undefined"},
+      /* 115 */ {"var115", "undefined"},
+      /* 116 */ {"var116", "undefined"},
+      /* 117 */ {"var117", "undefined"},
+      /* 118 */ {"var118", "undefined"},
+      /* 119 */ {"var119", "undefined"},
+      /* 120 */ {"var120", "undefined"},
+      /* 121 */ {"var121", "undefined"},
+      /* 122 */ {"var122", "undefined"},
+      /* 123 */ {"var123", "undefined"},
+      /* 124 */ {"var124", "undefined"},
+      /* 125 */ {"var125", "undefined"},
+      /* 126 */ {"var126", "undefined"},
+      /* 127 */ {"NONE", "RESERVED"},
+      /* 128 */ {"NONE", "RESERVED"},
+      /* 129 */ {"PT", "Potential temperature deg C"},
+      /* 130 */ {"S", "Salinity"},
+      /* 131 */ {"U", "U-velocity m s**-1"},
+      /* 132 */ {"V", "V-velocity m s**-1"},
+      /* 133 */ {"WV", "W-velocity m s**-1"},
+      /* 134 */ {"MST", "Modulus of strain rate tensor s**-1"},
+      /* 135 */ {"VVS", "Vertical viscosity m**2 s**-1"},
+      /* 136 */ {"VDF", "Vertical diffusivity m**2 s**-1"},
+      /* 137 */ {"DEP", "Depth m"},
+      /* 138 */ {"STH", "Sigma-theta kg m**-3"},
+      /* 139 */ {"RN", "Richardson number -"},
+      /* 140 */ {"var140", "undefined"},
+      /* 141 */ {"var141", "undefined"},
+      /* 142 */ {"var142", "undefined"},
+      /* 143 */ {"var143", "undefined"},
+      /* 144 */ {"var144", "undefined"},
+      /* 145 */ {"SL", "Sea level (tides removed) m"},
+      /* 146 */ {"SFT", "Sea floor topography m"},
+      /* 147 */ {"BSF", "Barotropic streamfunction m**3 s**-1"},
+      /* 148 */ {"MLD", "Mixed layer depth m"},
+      /* 149 */ {"var149", "undefined"},
+      /* 150 */ {"var150", "undefined"},
+      /* 151 */ {"var151", "undefined"},
+      /* 152 */ {"NONE", "RESERVED"},
+      /* 153 */ {"TAX", "U-stress Pa"},
+      /* 154 */ {"TAY", "V-stress Pa"},
+      /* 155 */ {"TKI", "Turbulent kinetic energy input W m**-2"},
+      /* 156 */ {"NSF", "Net surface heat flux W m**-2"},
+      /* 157 */ {"ASR", "Absorbed solar radiation W m**-2"},
+      /* 158 */ {"PME", "Precipitation - evaporation m s**-1"},
+      /* 159 */ {"SST", "Specified SST deg C"},
+      /* 160 */ {"SHF", "Specified surface heat flux W m**-2"},
+      /* 161 */ {"DTE", "Diagnosed SST error deg C"},
+      /* 162 */ {"HFC", "Heat flux correction W m**-2"},
+      /* 163 */ {"var163", "undefined"},
+      /* 164 */ {"var164", "undefined"},
+      /* 165 */ {"var165", "undefined"},
+      /* 166 */ {"var166", "undefined"},
+      /* 167 */ {"var167", "undefined"},
+      /* 168 */ {"var168", "undefined"},
+      /* 169 */ {"var169", "undefined"},
+      /* 170 */ {"var170", "undefined"},
+      /* 171 */ {"var171", "undefined"},
+      /* 172 */ {"var172", "undefined"},
+      /* 173 */ {"var173", "undefined"},
+      /* 174 */ {"var174", "undefined"},
+      /* 175 */ {"var175", "undefined"},
+      /* 176 */ {"var176", "undefined"},
+      /* 177 */ {"var177", "undefined"},
+      /* 178 */ {"var178", "undefined"},
+      /* 179 */ {"var179", "undefined"},
+      /* 180 */ {"var180", "undefined"},
+      /* 181 */ {"var181", "undefined"},
+      /* 182 */ {"var182", "undefined"},
+      /* 183 */ {"var183", "undefined"},
+      /* 184 */ {"var184", "undefined"},
+      /* 185 */ {"var185", "undefined"},
+      /* 186 */ {"var186", "undefined"},
+      /* 187 */ {"var187", "undefined"},
+      /* 188 */ {"var188", "undefined"},
+      /* 189 */ {"var189", "undefined"},
+      /* 190 */ {"var190", "undefined"},
+      /* 191 */ {"var191", "undefined"},
+      /* 192 */ {"var192", "undefined"},
+      /* 193 */ {"var193", "undefined"},
+      /* 194 */ {"var194", "undefined"},
+      /* 195 */ {"var195", "undefined"},
+      /* 196 */ {"var196", "undefined"},
+      /* 197 */ {"var197", "undefined"},
+      /* 198 */ {"var198", "undefined"},
+      /* 199 */ {"var199", "undefined"},
+      /* 200 */ {"var200", "undefined"},
+      /* 201 */ {"var201", "undefined"},
+      /* 202 */ {"var202", "undefined"},
+      /* 203 */ {"var203", "undefined"},
+      /* 204 */ {"var204", "undefined"},
+      /* 205 */ {"var205", "undefined"},
+      /* 206 */ {"var206", "undefined"},
+      /* 207 */ {"var207", "undefined"},
+      /* 208 */ {"var208", "undefined"},
+      /* 209 */ {"var209", "undefined"},
+      /* 210 */ {"var210", "undefined"},
+      /* 211 */ {"var211", "undefined"},
+      /* 212 */ {"var212", "undefined"},
+      /* 213 */ {"var213", "undefined"},
+      /* 214 */ {"var214", "undefined"},
+      /* 215 */ {"var215", "undefined"},
+      /* 216 */ {"var216", "undefined"},
+      /* 217 */ {"var217", "undefined"},
+      /* 218 */ {"var218", "undefined"},
+      /* 219 */ {"var219", "undefined"},
+      /* 220 */ {"var220", "undefined"},
+      /* 221 */ {"var221", "undefined"},
+      /* 222 */ {"var222", "undefined"},
+      /* 223 */ {"var223", "undefined"},
+      /* 224 */ {"var224", "undefined"},
+      /* 225 */ {"var225", "undefined"},
+      /* 226 */ {"var226", "undefined"},
+      /* 227 */ {"var227", "undefined"},
+      /* 228 */ {"var228", "undefined"},
+      /* 229 */ {"var229", "undefined"},
+      /* 230 */ {"var230", "undefined"},
+      /* 231 */ {"var231", "undefined"},
+      /* 232 */ {"var232", "undefined"},
+      /* 233 */ {"var233", "undefined"},
+      /* 234 */ {"var234", "undefined"},
+      /* 235 */ {"var235", "undefined"},
+      /* 236 */ {"var236", "undefined"},
+      /* 237 */ {"var237", "undefined"},
+      /* 238 */ {"var238", "undefined"},
+      /* 239 */ {"var239", "undefined"},
+      /* 240 */ {"var240", "undefined"},
+      /* 241 */ {"var241", "undefined"},
+      /* 242 */ {"var242", "undefined"},
+      /* 243 */ {"var243", "undefined"},
+      /* 244 */ {"var244", "undefined"},
+      /* 245 */ {"var245", "undefined"},
+      /* 246 */ {"var246", "undefined"},
+      /* 247 */ {"var247", "undefined"},
+      /* 248 */ {"var248", "undefined"},
+      /* 249 */ {"var249", "undefined"},
+      /* 250 */ {"var250", "undefined"},
+      /* 251 */ {"var251", "undefined"},
+      /* 252 */ {"var252", "undefined"},
+      /* 253 */ {"var253", "undefined"},
+      /* 254 */ {"var254", "undefined"},
+      /* 255 */ {"NONE", "RESERVED"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_160.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_160.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_160.c	(revision 2744)
@@ -0,0 +1,261 @@
+#include "cnames.h"
+
+
+struct ParmTable parm_table_ecmwf_160[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"var1", "undefined"},
+    /* 2 */ {"var2", "undefined"},
+    /* 3 */ {"var3", "undefined"},
+    /* 4 */ {"var4", "undefined"},
+    /* 5 */ {"var5", "undefined"},
+    /* 6 */ {"var6", "undefined"},
+    /* 7 */ {"var7", "undefined"},
+    /* 8 */ {"var8", "undefined"},
+    /* 9 */ {"var9", "undefined"},
+    /* 10 */ {"var10", "undefined"},
+    /* 11 */ {"var11", "undefined"},
+    /* 12 */ {"var12", "undefined"},
+    /* 13 */ {"var13", "undefined"},
+    /* 14 */ {"var14", "undefined"},
+    /* 15 */ {"var15", "undefined"},
+    /* 16 */ {"var16", "undefined"},
+    /* 17 */ {"var17", "undefined"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"var19", "undefined"},
+    /* 20 */ {"var20", "undefined"},
+    /* 21 */ {"var21", "undefined"},
+    /* 22 */ {"var22", "undefined"},
+    /* 23 */ {"var23", "undefined"},
+    /* 24 */ {"var24", "undefined"},
+    /* 25 */ {"var25", "undefined"},
+    /* 26 */ {"var26", "undefined"},
+    /* 27 */ {"var27", "undefined"},
+    /* 28 */ {"var28", "undefined"},
+    /* 29 */ {"var29", "undefined"},
+    /* 30 */ {"var30", "undefined"},
+    /* 31 */ {"var31", "undefined"},
+    /* 32 */ {"var32", "undefined"},
+    /* 33 */ {"var33", "undefined"},
+    /* 34 */ {"var34", "undefined"},
+    /* 35 */ {"var35", "undefined"},
+    /* 36 */ {"var36", "undefined"},
+    /* 37 */ {"var37", "undefined"},
+    /* 38 */ {"var38", "undefined"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"var40", "undefined"},
+    /* 41 */ {"var41", "undefined"},
+    /* 42 */ {"var42", "undefined"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"var44", "undefined"},
+    /* 45 */ {"var45", "undefined"},
+    /* 46 */ {"var46", "undefined"},
+    /* 47 */ {"var47", "undefined"},
+    /* 48 */ {"var48", "undefined"},
+    /* 49 */ {"var49", "undefined"},
+    /* 50 */ {"var50", "undefined"},
+    /* 51 */ {"var51", "undefined"},
+    /* 52 */ {"var52", "undefined"},
+    /* 53 */ {"var53", "undefined"},
+    /* 54 */ {"var54", "undefined"},
+    /* 55 */ {"var55", "undefined"},
+    /* 56 */ {"var56", "undefined"},
+    /* 57 */ {"var57", "undefined"},
+    /* 58 */ {"var58", "undefined"},
+    /* 59 */ {"var59", "undefined"},
+    /* 60 */ {"var60", "undefined"},
+    /* 61 */ {"var61", "undefined"},
+    /* 62 */ {"var62", "undefined"},
+    /* 63 */ {"var63", "undefined"},
+    /* 64 */ {"var64", "undefined"},
+    /* 65 */ {"var65", "undefined"},
+    /* 66 */ {"var66", "undefined"},
+    /* 67 */ {"var67", "undefined"},
+    /* 68 */ {"var68", "undefined"},
+    /* 69 */ {"var69", "undefined"},
+    /* 70 */ {"var70", "undefined"},
+    /* 71 */ {"var71", "undefined"},
+    /* 72 */ {"var72", "undefined"},
+    /* 73 */ {"var73", "undefined"},
+    /* 74 */ {"var74", "undefined"},
+    /* 75 */ {"var75", "undefined"},
+    /* 76 */ {"var76", "undefined"},
+    /* 77 */ {"var77", "undefined"},
+    /* 78 */ {"var78", "undefined"},
+    /* 79 */ {"var79", "undefined"},
+    /* 80 */ {"var80", "undefined"},
+    /* 81 */ {"var81", "undefined"},
+    /* 82 */ {"var82", "undefined"},
+    /* 83 */ {"var83", "undefined"},
+    /* 84 */ {"var84", "undefined"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"var86", "undefined"},
+    /* 87 */ {"var87", "undefined"},
+    /* 88 */ {"var88", "undefined"},
+    /* 89 */ {"var89", "undefined"},
+    /* 90 */ {"var90", "undefined"},
+    /* 91 */ {"var91", "undefined"},
+    /* 92 */ {"var92", "undefined"},
+    /* 93 */ {"var93", "undefined"},
+    /* 94 */ {"var94", "undefined"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"var99", "undefined"},
+    /* 100 */ {"var100", "undefined"},
+    /* 101 */ {"var101", "undefined"},
+    /* 102 */ {"var102", "undefined"},
+    /* 103 */ {"var103", "undefined"},
+    /* 104 */ {"var104", "undefined"},
+    /* 105 */ {"var105", "undefined"},
+    /* 106 */ {"var106", "undefined"},
+    /* 107 */ {"var107", "undefined"},
+    /* 108 */ {"var108", "undefined"},
+    /* 109 */ {"var109", "undefined"},
+    /* 110 */ {"var110", "undefined"},
+    /* 111 */ {"var111", "undefined"},
+    /* 112 */ {"var112", "undefined"},
+    /* 113 */ {"var113", "undefined"},
+    /* 114 */ {"var114", "undefined"},
+    /* 115 */ {"var115", "undefined"},
+    /* 116 */ {"var116", "undefined"},
+    /* 117 */ {"var117", "undefined"},
+    /* 118 */ {"var118", "undefined"},
+    /* 119 */ {"var119", "undefined"},
+    /* 120 */ {"var120", "undefined"},
+    /* 121 */ {"var121", "undefined"},
+    /* 122 */ {"var122", "undefined"},
+    /* 123 */ {"var123", "undefined"},
+    /* 124 */ {"var124", "undefined"},
+    /* 125 */ {"var125", "undefined"},
+    /* 126 */ {"var126", "undefined"},
+    /* 127 */ {"AT", "Atmospheric tide+ -"},
+    /* 128 */ {"BV", "Budget values+ -"},
+    /* 129 */ {"Z", "Geopotential / orography m**2 s**-2"},
+    /* 130 */ {"T", "Temperature K"},
+    /* 131 */ {"U", "U-velocity m s**-1"},
+    /* 132 */ {"V", "V-velocity m s**-1"},
+    /* 133 */ {"Q", "Specific humidity kg kg**-1"},
+    /* 134 */ {"SP", "Surface pressure Pa"},
+    /* 135 */ {"W", "Vertical velocity Pa s**-1"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"PWC", "Precipitable water content kg m**-2"},
+    /* 138 */ {"VO", "Vorticity (relative) s**-1"},
+    /* 139 */ {"STL1", "Soil temperature level 1 K"},
+    /* 140 */ {"SWL1", "Soil wetness level 1 m"},
+    /* 141 */ {"SD", "Snow depth m (of water)"},
+    /* 142 */ {"LSP", "Large scale precipitation kg m**-2 s**-1"},
+    /* 143 */ {"CP", "Convective precipitation kg m**-2 s**-1"},
+    /* 144 */ {"SF", "Snow fall kg m**-2 s**-1"},
+    /* 145 */ {"BLD", "Boundary layer dissipation W m**-2"},
+    /* 146 */ {"SSHF", "Surface sensible heat flux W m**-2"},
+    /* 147 */ {"SLHF", "Surface latent heat flux W m**-2"},
+    /* 148 */ {"var148", "undefined"},
+    /* 149 */ {"var149", "undefined"},
+    /* 150 */ {"var150", "undefined"},
+    /* 151 */ {"MSL", "Mean sea level pressure Pa"},
+    /* 152 */ {"LNSP", "Ln surface pressure -"},
+    /* 153 */ {"var153", "undefined"},
+    /* 154 */ {"var154", "undefined"},
+    /* 155 */ {"D", "Divergence s**-1"},
+    /* 156 */ {"GH", "Height (geopotential) m"},
+    /* 157 */ {"R", "Relative humidity (0 - 1)"},
+    /* 158 */ {"TSP", "Tendency of surface pressure Pa s**-1"},
+    /* 159 */ {"var159", "undefined"},
+    /* 160 */ {"var160", "undefined"},
+    /* 161 */ {"var161", "undefined"},
+    /* 162 */ {"var162", "undefined"},
+    /* 163 */ {"var163", "undefined"},
+    /* 164 */ {"TCC", "Total cloud cover (0 - 1)"},
+    /* 165 */ {"10U", "10 metre u wind component m s**-1"},
+    /* 166 */ {"10V", "10 metre v wind component m s**-1"},
+    /* 167 */ {"2T", "2 metre temperature K"},
+    /* 168 */ {"2D", "2 metre dewpoint temperature K"},
+    /* 169 */ {"var169", "undefined"},
+    /* 170 */ {"STL2", "Soil temperature level 2 K"},
+    /* 171 */ {"SWL2", "Soil wetness level 2 m"},
+    /* 172 */ {"LSM", "Land/sea mask (0 - 1)"},
+    /* 173 */ {"SR", "Surface roughness m"},
+    /* 174 */ {"AL", "Albedo (0 - 1)"},
+    /* 175 */ {"var175", "undefined"},
+    /* 176 */ {"SSR", "Surface solar radiation W m**-2"},
+    /* 177 */ {"STR", "Surface thermal radiation W m**-2"},
+    /* 178 */ {"TSR", "Top solar radiation W m**-2"},
+    /* 179 */ {"TTR", "Top thermal radiation W m**-2"},
+    /* 180 */ {"EWSS", "East/west surface stress N m**-2 s**-1"},
+    /* 181 */ {"NSSS", "North/south surface stress N m**-2 s**-1"},
+    /* 182 */ {"E", "Evaporation kg m**-2 s**-1"},
+    /* 183 */ {"STL3", "Soil temperature level 3 K"},
+    /* 184 */ {"SWL3", "Soil wetness level 3 m"},
+    /* 185 */ {"CCC", "Convective cloud cover (0 - 1)"},
+    /* 186 */ {"LCC", "Low cloud cover (0 - 1)"},
+    /* 187 */ {"MCC", "Medium cloud cover (0 - 1)"},
+    /* 188 */ {"HCC", "High cloud cover (0 - 1)"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"EWOV", "EW component of sub-grid scale orographic variance m**2"},
+    /* 191 */ {"NSOV", "NS component of sub-grid scale orographic variance m**2"},
+    /* 192 */ {"NWOV", "NWSE component sub-grid scale orographic variance m**2"},
+    /* 193 */ {"NEOV", "NESW component sub-grid scale orographic variance m**2"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"LGWS", "Latitudinal component of gravity wave stress N m**-2 s"},
+    /* 196 */ {"MGWS", "Meridional component of gravity wave stress N m**-2 s"},
+    /* 197 */ {"GWD", "Gravity wave dissipation W m**-2 s"},
+    /* 198 */ {"SRC", "Skin reservoir content m (of water)"},
+    /* 199 */ {"VEG", "Percentage of vegetation %"},
+    /* 200 */ {"VSO", "Variance of sub-grid scale orography m**2"},
+    /* 201 */ {"MX2T", "Max temp.2m during averaging time K"},
+    /* 202 */ {"MN2T", "Min temp.2m during averaging time K"},
+    /* 203 */ {"var203", "undefined"},
+    /* 204 */ {"PAW", "Precip. analysis weights -"},
+    /* 205 */ {"RO", "Runoff kg m**-2 s**-1"},
+    /* 206 */ {"ZZ", "St.Dev. of Geopotential m**2 s**-2"},
+    /* 207 */ {"TZ", "Covar Temp & Geopotential K m**2 s**-2"},
+    /* 208 */ {"TT", "St.Dev. of Temperature K"},
+    /* 209 */ {"QZ", "Covar Sp.Hum. & Geopotential m**2 s**-2"},
+    /* 210 */ {"QT", "Covar Sp.Hum & Temp. K"},
+    /* 211 */ {"QQ", "St.Dev. of Specific humidity (0 - 1)"},
+    /* 212 */ {"UZ", "Covar U-comp. & Geopotential m**3 s**-3"},
+    /* 213 */ {"UT", "Covar U-comp. & Temp. K m s**-1"},
+    /* 214 */ {"UQ", "Covar U-comp. & Sp.Hum. m s**-1"},
+    /* 215 */ {"UU", "St.Dev. of U-velocity m s**-1"},
+    /* 216 */ {"VZ", "Covar V-comp. & Geopotential m**3 s**-3"},
+    /* 217 */ {"VT", "Covar V-comp. & Temp. K m s**-1"},
+    /* 218 */ {"VQ", "Covar V-comp. & Sp.Hum. m s**-1"},
+    /* 219 */ {"VU", "Covar V-comp. & U-comp m**2 s**-2"},
+    /* 220 */ {"VV", "St.Dev. of V-comp m s**-1"},
+    /* 221 */ {"WZ", "Covar W-comp. & Geopotential Pa m**2 s**-3"},
+    /* 222 */ {"WT", "Covar W-comp. & Temp. K Pa s**-1"},
+    /* 223 */ {"WQ", "Covar W-comp. & Sp.Hum. Pa s**-1"},
+    /* 224 */ {"WU", "Covar W-comp. & U-comp. Pa m s**-2"},
+    /* 225 */ {"WV", "Covar W-comp. & V-comp. Pa m s**-2"},
+    /* 226 */ {"WW", "St.Dev. of Vertical velocity Pa s**-1"},
+    /* 227 */ {"var227", "undefined"},
+    /* 228 */ {"TP", "Total precipitation m"},
+    /* 229 */ {"IEWS", "Instantaneous X surface stress N m**-2"},
+    /* 230 */ {"INSS", "Instantaneous Y surface stress N m**-2"},
+    /* 231 */ {"ISHF", "Instantaneous surface Heat Flux W m**-2"},
+    /* 232 */ {"IE", "Instantaneous Moisture Flux (evaporation) kg m**-2 s**-1"},
+    /* 233 */ {"ASQ", "Apparent Surface Humidity kg kg**-1"},
+    /* 234 */ {"LSRH", "Logarithm of surface roughness length for heat. -"},
+    /* 235 */ {"SKT", "Skin Temperature K"},
+    /* 236 */ {"STL4", "Soil temperature level 4 K"},
+    /* 237 */ {"SWL4", "Soil wetness level 4 m"},
+    /* 238 */ {"TSN", "Temperature of snow layer K"},
+    /* 239 */ {"CSF", "Convective snow-fall kg m**-2 s**-1"},
+    /* 240 */ {"LSF", "Large scale snow-fall kg m**-2 s**-1"},
+    /* 241 */ {"CLWC", "Cloud liquid water content kg kg**-1"},
+    /* 242 */ {"CC", "Cloud cover (at given level) (0 - 1)"},
+    /* 243 */ {"FAL", "Forecast albedo -"},
+    /* 244 */ {"FSR", "Forecast surface roughness m"},
+    /* 245 */ {"FLSR", "Forecast logarithm of surface roughness for heat. -"},
+    /* 246 */ {"10WS", "10m. Windspeed (irresp of dir.) m s**-1"},
+    /* 247 */ {"MOFL", "Momentum flux (irresp of dir.) N m**-2"},
+    /* 248 */ {"HSD", "Heaviside (beta) function (0 - 1)"},
+    /* 249 */ {"var249", "undefined"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_170.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_170.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_170.c	(revision 2744)
@@ -0,0 +1,261 @@
+#include "cnames.h"
+
+
+struct ParmTable parm_table_ecmwf_170[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"var1", "undefined"},
+    /* 2 */ {"var2", "undefined"},
+    /* 3 */ {"var3", "undefined"},
+    /* 4 */ {"var4", "undefined"},
+    /* 5 */ {"var5", "undefined"},
+    /* 6 */ {"var6", "undefined"},
+    /* 7 */ {"var7", "undefined"},
+    /* 8 */ {"var8", "undefined"},
+    /* 9 */ {"var9", "undefined"},
+    /* 10 */ {"var10", "undefined"},
+    /* 11 */ {"var11", "undefined"},
+    /* 12 */ {"var12", "undefined"},
+    /* 13 */ {"var13", "undefined"},
+    /* 14 */ {"var14", "undefined"},
+    /* 15 */ {"var15", "undefined"},
+    /* 16 */ {"var16", "undefined"},
+    /* 17 */ {"var17", "undefined"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"var19", "undefined"},
+    /* 20 */ {"var20", "undefined"},
+    /* 21 */ {"var21", "undefined"},
+    /* 22 */ {"var22", "undefined"},
+    /* 23 */ {"var23", "undefined"},
+    /* 24 */ {"var24", "undefined"},
+    /* 25 */ {"var25", "undefined"},
+    /* 26 */ {"var26", "undefined"},
+    /* 27 */ {"var27", "undefined"},
+    /* 28 */ {"var28", "undefined"},
+    /* 29 */ {"var29", "undefined"},
+    /* 30 */ {"var30", "undefined"},
+    /* 31 */ {"var31", "undefined"},
+    /* 32 */ {"var32", "undefined"},
+    /* 33 */ {"var33", "undefined"},
+    /* 34 */ {"var34", "undefined"},
+    /* 35 */ {"var35", "undefined"},
+    /* 36 */ {"var36", "undefined"},
+    /* 37 */ {"var37", "undefined"},
+    /* 38 */ {"var38", "undefined"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"var40", "undefined"},
+    /* 41 */ {"var41", "undefined"},
+    /* 42 */ {"var42", "undefined"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"var44", "undefined"},
+    /* 45 */ {"var45", "undefined"},
+    /* 46 */ {"var46", "undefined"},
+    /* 47 */ {"var47", "undefined"},
+    /* 48 */ {"var48", "undefined"},
+    /* 49 */ {"var49", "undefined"},
+    /* 50 */ {"var50", "undefined"},
+    /* 51 */ {"var51", "undefined"},
+    /* 52 */ {"var52", "undefined"},
+    /* 53 */ {"var53", "undefined"},
+    /* 54 */ {"var54", "undefined"},
+    /* 55 */ {"var55", "undefined"},
+    /* 56 */ {"var56", "undefined"},
+    /* 57 */ {"var57", "undefined"},
+    /* 58 */ {"var58", "undefined"},
+    /* 59 */ {"var59", "undefined"},
+    /* 60 */ {"var60", "undefined"},
+    /* 61 */ {"var61", "undefined"},
+    /* 62 */ {"var62", "undefined"},
+    /* 63 */ {"var63", "undefined"},
+    /* 64 */ {"var64", "undefined"},
+    /* 65 */ {"var65", "undefined"},
+    /* 66 */ {"var66", "undefined"},
+    /* 67 */ {"var67", "undefined"},
+    /* 68 */ {"var68", "undefined"},
+    /* 69 */ {"var69", "undefined"},
+    /* 70 */ {"var70", "undefined"},
+    /* 71 */ {"var71", "undefined"},
+    /* 72 */ {"var72", "undefined"},
+    /* 73 */ {"var73", "undefined"},
+    /* 74 */ {"var74", "undefined"},
+    /* 75 */ {"var75", "undefined"},
+    /* 76 */ {"var76", "undefined"},
+    /* 77 */ {"var77", "undefined"},
+    /* 78 */ {"var78", "undefined"},
+    /* 79 */ {"var79", "undefined"},
+    /* 80 */ {"var80", "undefined"},
+    /* 81 */ {"var81", "undefined"},
+    /* 82 */ {"var82", "undefined"},
+    /* 83 */ {"var83", "undefined"},
+    /* 84 */ {"var84", "undefined"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"var86", "undefined"},
+    /* 87 */ {"var87", "undefined"},
+    /* 88 */ {"var88", "undefined"},
+    /* 89 */ {"var89", "undefined"},
+    /* 90 */ {"var90", "undefined"},
+    /* 91 */ {"var91", "undefined"},
+    /* 92 */ {"var92", "undefined"},
+    /* 93 */ {"var93", "undefined"},
+    /* 94 */ {"var94", "undefined"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"var99", "undefined"},
+    /* 100 */ {"var100", "undefined"},
+    /* 101 */ {"var101", "undefined"},
+    /* 102 */ {"var102", "undefined"},
+    /* 103 */ {"var103", "undefined"},
+    /* 104 */ {"var104", "undefined"},
+    /* 105 */ {"var105", "undefined"},
+    /* 106 */ {"var106", "undefined"},
+    /* 107 */ {"var107", "undefined"},
+    /* 108 */ {"var108", "undefined"},
+    /* 109 */ {"var109", "undefined"},
+    /* 110 */ {"var110", "undefined"},
+    /* 111 */ {"var111", "undefined"},
+    /* 112 */ {"var112", "undefined"},
+    /* 113 */ {"var113", "undefined"},
+    /* 114 */ {"var114", "undefined"},
+    /* 115 */ {"var115", "undefined"},
+    /* 116 */ {"var116", "undefined"},
+    /* 117 */ {"var117", "undefined"},
+    /* 118 */ {"var118", "undefined"},
+    /* 119 */ {"var119", "undefined"},
+    /* 120 */ {"var120", "undefined"},
+    /* 121 */ {"var121", "undefined"},
+    /* 122 */ {"var122", "undefined"},
+    /* 123 */ {"var123", "undefined"},
+    /* 124 */ {"var124", "undefined"},
+    /* 125 */ {"var125", "undefined"},
+    /* 126 */ {"var126", "undefined"},
+    /* 127 */ {"var127", "undefined"},
+    /* 128 */ {"var128", "undefined"},
+    /* 129 */ {"Z", "Geopotential m**2 s**-2"},
+    /* 130 */ {"T", "Temperature K"},
+    /* 131 */ {"U", "U-velocity m s**-1"},
+    /* 132 */ {"V", "V-velocity m s**-1"},
+    /* 133 */ {"var133", "undefined"},
+    /* 134 */ {"var134", "undefined"},
+    /* 135 */ {"var135", "undefined"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"var137", "undefined"},
+    /* 138 */ {"VO", "Vorticity (relative) s**-1"},
+    /* 139 */ {"var139", "undefined"},
+    /* 140 */ {"SWL1", "Soil wetness level 1 m"},
+    /* 141 */ {"SD", "Snow depth m (of water equivalent)"},
+    /* 142 */ {"var142", "undefined"},
+    /* 143 */ {"var143", "undefined"},
+    /* 144 */ {"var144", "undefined"},
+    /* 145 */ {"var145", "undefined"},
+    /* 146 */ {"var146", "undefined"},
+    /* 147 */ {"var147", "undefined"},
+    /* 148 */ {"var148", "undefined"},
+    /* 149 */ {"TSW", "Total soil moisture m"},
+    /* 150 */ {"var150", "undefined"},
+    /* 151 */ {"MSL", "Mean sea level pressure Pa"},
+    /* 152 */ {"var152", "undefined"},
+    /* 153 */ {"var153", "undefined"},
+    /* 154 */ {"var154", "undefined"},
+    /* 155 */ {"D", "Divergence s**-1"},
+    /* 156 */ {"var156", "undefined"},
+    /* 157 */ {"var157", "undefined"},
+    /* 158 */ {"var158", "undefined"},
+    /* 159 */ {"var159", "undefined"},
+    /* 160 */ {"var160", "undefined"},
+    /* 161 */ {"var161", "undefined"},
+    /* 162 */ {"var162", "undefined"},
+    /* 163 */ {"var163", "undefined"},
+    /* 164 */ {"var164", "undefined"},
+    /* 165 */ {"var165", "undefined"},
+    /* 166 */ {"var166", "undefined"},
+    /* 167 */ {"var167", "undefined"},
+    /* 168 */ {"var168", "undefined"},
+    /* 169 */ {"var169", "undefined"},
+    /* 170 */ {"var170", "undefined"},
+    /* 171 */ {"SWL2", "Soil wetness level 2 m"},
+    /* 172 */ {"var172", "undefined"},
+    /* 173 */ {"var173", "undefined"},
+    /* 174 */ {"var174", "undefined"},
+    /* 175 */ {"var175", "undefined"},
+    /* 176 */ {"var176", "undefined"},
+    /* 177 */ {"var177", "undefined"},
+    /* 178 */ {"var178", "undefined"},
+    /* 179 */ {"TTR", "Top thermal radiation W m-2"},
+    /* 180 */ {"var180", "undefined"},
+    /* 181 */ {"var181", "undefined"},
+    /* 182 */ {"var182", "undefined"},
+    /* 183 */ {"var183", "undefined"},
+    /* 184 */ {"SWL3", "Soil wetness level 3 m"},
+    /* 185 */ {"var185", "undefined"},
+    /* 186 */ {"var186", "undefined"},
+    /* 187 */ {"var187", "undefined"},
+    /* 188 */ {"var188", "undefined"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"var190", "undefined"},
+    /* 191 */ {"var191", "undefined"},
+    /* 192 */ {"var192", "undefined"},
+    /* 193 */ {"var193", "undefined"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"var195", "undefined"},
+    /* 196 */ {"var196", "undefined"},
+    /* 197 */ {"var197", "undefined"},
+    /* 198 */ {"var198", "undefined"},
+    /* 199 */ {"var199", "undefined"},
+    /* 200 */ {"var200", "undefined"},
+    /* 201 */ {"MX2T", "Max temp at 2m since previous postprocess K"},
+    /* 202 */ {"MN2T", "Min temp at 2m since previous postprocess K"},
+    /* 203 */ {"var203", "undefined"},
+    /* 204 */ {"var204", "undefined"},
+    /* 205 */ {"var205", "undefined"},
+    /* 206 */ {"var206", "undefined"},
+    /* 207 */ {"var207", "undefined"},
+    /* 208 */ {"var208", "undefined"},
+    /* 209 */ {"var209", "undefined"},
+    /* 210 */ {"var210", "undefined"},
+    /* 211 */ {"var211", "undefined"},
+    /* 212 */ {"var212", "undefined"},
+    /* 213 */ {"var213", "undefined"},
+    /* 214 */ {"var214", "undefined"},
+    /* 215 */ {"var215", "undefined"},
+    /* 216 */ {"var216", "undefined"},
+    /* 217 */ {"var217", "undefined"},
+    /* 218 */ {"var218", "undefined"},
+    /* 219 */ {"var219", "undefined"},
+    /* 220 */ {"var220", "undefined"},
+    /* 221 */ {"var221", "undefined"},
+    /* 222 */ {"var222", "undefined"},
+    /* 223 */ {"var223", "undefined"},
+    /* 224 */ {"var224", "undefined"},
+    /* 225 */ {"var225", "undefined"},
+    /* 226 */ {"var226", "undefined"},
+    /* 227 */ {"var227", "undefined"},
+    /* 228 */ {"TP", "Total precipitation m"},
+    /* 229 */ {"var229", "undefined"},
+    /* 230 */ {"var230", "undefined"},
+    /* 231 */ {"var231", "undefined"},
+    /* 232 */ {"var232", "undefined"},
+    /* 233 */ {"var233", "undefined"},
+    /* 234 */ {"var234", "undefined"},
+    /* 235 */ {"var235", "undefined"},
+    /* 236 */ {"var236", "undefined"},
+    /* 237 */ {"var237", "undefined"},
+    /* 238 */ {"var238", "undefined"},
+    /* 239 */ {"var239", "undefined"},
+    /* 240 */ {"var240", "undefined"},
+    /* 241 */ {"var241", "undefined"},
+    /* 242 */ {"var242", "undefined"},
+    /* 243 */ {"var243", "undefined"},
+    /* 244 */ {"var244", "undefined"},
+    /* 245 */ {"var245", "undefined"},
+    /* 246 */ {"var246", "undefined"},
+    /* 247 */ {"var247", "undefined"},
+    /* 248 */ {"var248", "undefined"},
+    /* 249 */ {"var249", "undefined"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_180.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_180.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ectable_180.c	(revision 2744)
@@ -0,0 +1,261 @@
+#include "cnames.h"
+
+
+struct ParmTable parm_table_ecmwf_180[256] = {
+    /* 0 */ {"var0", "undefined"},
+    /* 1 */ {"var1", "undefined"},
+    /* 2 */ {"var2", "undefined"},
+    /* 3 */ {"var3", "undefined"},
+    /* 4 */ {"var4", "undefined"},
+    /* 5 */ {"var5", "undefined"},
+    /* 6 */ {"var6", "undefined"},
+    /* 7 */ {"var7", "undefined"},
+    /* 8 */ {"var8", "undefined"},
+    /* 9 */ {"var9", "undefined"},
+    /* 10 */ {"var10", "undefined"},
+    /* 11 */ {"var11", "undefined"},
+    /* 12 */ {"var12", "undefined"},
+    /* 13 */ {"var13", "undefined"},
+    /* 14 */ {"var14", "undefined"},
+    /* 15 */ {"var15", "undefined"},
+    /* 16 */ {"var16", "undefined"},
+    /* 17 */ {"var17", "undefined"},
+    /* 18 */ {"var18", "undefined"},
+    /* 19 */ {"var19", "undefined"},
+    /* 20 */ {"var20", "undefined"},
+    /* 21 */ {"var21", "undefined"},
+    /* 22 */ {"var22", "undefined"},
+    /* 23 */ {"var23", "undefined"},
+    /* 24 */ {"var24", "undefined"},
+    /* 25 */ {"var25", "undefined"},
+    /* 26 */ {"var26", "undefined"},
+    /* 27 */ {"var27", "undefined"},
+    /* 28 */ {"var28", "undefined"},
+    /* 29 */ {"var29", "undefined"},
+    /* 30 */ {"var30", "undefined"},
+    /* 31 */ {"var31", "undefined"},
+    /* 32 */ {"var32", "undefined"},
+    /* 33 */ {"var33", "undefined"},
+    /* 34 */ {"var34", "undefined"},
+    /* 35 */ {"var35", "undefined"},
+    /* 36 */ {"var36", "undefined"},
+    /* 37 */ {"var37", "undefined"},
+    /* 38 */ {"var38", "undefined"},
+    /* 39 */ {"var39", "undefined"},
+    /* 40 */ {"var40", "undefined"},
+    /* 41 */ {"var41", "undefined"},
+    /* 42 */ {"var42", "undefined"},
+    /* 43 */ {"var43", "undefined"},
+    /* 44 */ {"var44", "undefined"},
+    /* 45 */ {"var45", "undefined"},
+    /* 46 */ {"var46", "undefined"},
+    /* 47 */ {"var47", "undefined"},
+    /* 48 */ {"var48", "undefined"},
+    /* 49 */ {"var49", "undefined"},
+    /* 50 */ {"var50", "undefined"},
+    /* 51 */ {"var51", "undefined"},
+    /* 52 */ {"var52", "undefined"},
+    /* 53 */ {"var53", "undefined"},
+    /* 54 */ {"var54", "undefined"},
+    /* 55 */ {"var55", "undefined"},
+    /* 56 */ {"var56", "undefined"},
+    /* 57 */ {"var57", "undefined"},
+    /* 58 */ {"var58", "undefined"},
+    /* 59 */ {"var59", "undefined"},
+    /* 60 */ {"var60", "undefined"},
+    /* 61 */ {"var61", "undefined"},
+    /* 62 */ {"var62", "undefined"},
+    /* 63 */ {"var63", "undefined"},
+    /* 64 */ {"var64", "undefined"},
+    /* 65 */ {"var65", "undefined"},
+    /* 66 */ {"var66", "undefined"},
+    /* 67 */ {"var67", "undefined"},
+    /* 68 */ {"var68", "undefined"},
+    /* 69 */ {"var69", "undefined"},
+    /* 70 */ {"var70", "undefined"},
+    /* 71 */ {"var71", "undefined"},
+    /* 72 */ {"var72", "undefined"},
+    /* 73 */ {"var73", "undefined"},
+    /* 74 */ {"var74", "undefined"},
+    /* 75 */ {"var75", "undefined"},
+    /* 76 */ {"var76", "undefined"},
+    /* 77 */ {"var77", "undefined"},
+    /* 78 */ {"var78", "undefined"},
+    /* 79 */ {"var79", "undefined"},
+    /* 80 */ {"var80", "undefined"},
+    /* 81 */ {"var81", "undefined"},
+    /* 82 */ {"var82", "undefined"},
+    /* 83 */ {"var83", "undefined"},
+    /* 84 */ {"var84", "undefined"},
+    /* 85 */ {"var85", "undefined"},
+    /* 86 */ {"var86", "undefined"},
+    /* 87 */ {"var87", "undefined"},
+    /* 88 */ {"var88", "undefined"},
+    /* 89 */ {"var89", "undefined"},
+    /* 90 */ {"var90", "undefined"},
+    /* 91 */ {"var91", "undefined"},
+    /* 92 */ {"var92", "undefined"},
+    /* 93 */ {"var93", "undefined"},
+    /* 94 */ {"var94", "undefined"},
+    /* 95 */ {"var95", "undefined"},
+    /* 96 */ {"var96", "undefined"},
+    /* 97 */ {"var97", "undefined"},
+    /* 98 */ {"var98", "undefined"},
+    /* 99 */ {"var99", "undefined"},
+    /* 100 */ {"var100", "undefined"},
+    /* 101 */ {"var101", "undefined"},
+    /* 102 */ {"var102", "undefined"},
+    /* 103 */ {"var103", "undefined"},
+    /* 104 */ {"var104", "undefined"},
+    /* 105 */ {"var105", "undefined"},
+    /* 106 */ {"var106", "undefined"},
+    /* 107 */ {"var107", "undefined"},
+    /* 108 */ {"var108", "undefined"},
+    /* 109 */ {"var109", "undefined"},
+    /* 110 */ {"var110", "undefined"},
+    /* 111 */ {"var111", "undefined"},
+    /* 112 */ {"var112", "undefined"},
+    /* 113 */ {"var113", "undefined"},
+    /* 114 */ {"var114", "undefined"},
+    /* 115 */ {"var115", "undefined"},
+    /* 116 */ {"var116", "undefined"},
+    /* 117 */ {"var117", "undefined"},
+    /* 118 */ {"var118", "undefined"},
+    /* 119 */ {"var119", "undefined"},
+    /* 120 */ {"var120", "undefined"},
+    /* 121 */ {"var121", "undefined"},
+    /* 122 */ {"var122", "undefined"},
+    /* 123 */ {"var123", "undefined"},
+    /* 124 */ {"var124", "undefined"},
+    /* 125 */ {"var125", "undefined"},
+    /* 126 */ {"var126", "undefined"},
+    /* 127 */ {"var127", "undefined"},
+    /* 128 */ {"var128", "undefined"},
+    /* 129 */ {"Z", "Geopotential (at the surface=orography) m**2 s**-2"},
+    /* 130 */ {"T", "Temperature K"},
+    /* 131 */ {"U", "U-velocity m s**-1"},
+    /* 132 */ {"V", "V-velocity m s**-1"},
+    /* 133 */ {"Q", "Specific humidity kg kg**-1"},
+    /* 134 */ {"SP", "Surface pressure Pa"},
+    /* 135 */ {"var135", "undefined"},
+    /* 136 */ {"var136", "undefined"},
+    /* 137 */ {"TCWV", "Total column water vapour kg m**-2"},
+    /* 138 */ {"VO", "Vorticity (relative) s**-1"},
+    /* 139 */ {"var139", "undefined"},
+    /* 140 */ {"var140", "undefined"},
+    /* 141 */ {"SD", "Snow depth m (of water equivalent)"},
+    /* 142 */ {"LSP", "Large scale precipitation* m"},
+    /* 143 */ {"CP", "Convective precipitation* m"},
+    /* 144 */ {"SF", "Snow fall m(of water equivalent)"},
+    /* 145 */ {"var145", "undefined"},
+    /* 146 */ {"SSHF", "Surface sensible heat flux W m**-2 s"},
+    /* 147 */ {"SLHF", "Surface latent heat flux W m**-2 s"},
+    /* 148 */ {"var148", "undefined"},
+    /* 149 */ {"TSW", "Total soil wetness m"},
+    /* 150 */ {"var150", "undefined"},
+    /* 151 */ {"MSL", "Mean sea level pressure Pa"},
+    /* 152 */ {"var152", "undefined"},
+    /* 153 */ {"var153", "undefined"},
+    /* 154 */ {"var154", "undefined"},
+    /* 155 */ {"D", "Divergence s**-1"},
+    /* 156 */ {"var156", "undefined"},
+    /* 157 */ {"var157", "undefined"},
+    /* 158 */ {"var158", "undefined"},
+    /* 159 */ {"var159", "undefined"},
+    /* 160 */ {"var160", "undefined"},
+    /* 161 */ {"var161", "undefined"},
+    /* 162 */ {"var162", "undefined"},
+    /* 163 */ {"var163", "undefined"},
+    /* 164 */ {"TCC", "Total cloud cover (0 - 1)"},
+    /* 165 */ {"10U", "10 metre u wind component m s**-1"},
+    /* 166 */ {"10V", "10 metre v wind component m s**-1"},
+    /* 167 */ {"2T", "2 metre temperature K"},
+    /* 168 */ {"2D", "2 metre dewpoint temperature K"},
+    /* 169 */ {"var169", "undefined"},
+    /* 170 */ {"var170", "undefined"},
+    /* 171 */ {"var171", "undefined"},
+    /* 172 */ {"LSM", "Land/sea mask (0"},
+    /* 173 */ {"var173", "undefined"},
+    /* 174 */ {"var174", "undefined"},
+    /* 175 */ {"var175", "undefined"},
+    /* 176 */ {"SSR", "Surface solar radiation (net) J m**-2 s"},
+    /* 177 */ {"STR", "Surface thermal radiation (net) J m**-2 s"},
+    /* 178 */ {"TSR", "Top solar radiation (net) J m**-2 s"},
+    /* 179 */ {"TTR", "Top thermal radiation (net) J m**-2 s"},
+    /* 180 */ {"EWSS", "East/West surface stress N m**-2 s"},
+    /* 181 */ {"NSSS", "North/South surface stress N m**-2 s"},
+    /* 182 */ {"E", "Evaporation (surface) m (of water)"},
+    /* 183 */ {"var183", "undefined"},
+    /* 184 */ {"var184", "undefined"},
+    /* 185 */ {"var185", "undefined"},
+    /* 186 */ {"var186", "undefined"},
+    /* 187 */ {"var187", "undefined"},
+    /* 188 */ {"var188", "undefined"},
+    /* 189 */ {"var189", "undefined"},
+    /* 190 */ {"var190", "undefined"},
+    /* 191 */ {"var191", "undefined"},
+    /* 192 */ {"var192", "undefined"},
+    /* 193 */ {"var193", "undefined"},
+    /* 194 */ {"var194", "undefined"},
+    /* 195 */ {"var195", "undefined"},
+    /* 196 */ {"var196", "undefined"},
+    /* 197 */ {"var197", "undefined"},
+    /* 198 */ {"var198", "undefined"},
+    /* 199 */ {"var199", "undefined"},
+    /* 200 */ {"var200", "undefined"},
+    /* 201 */ {"var201", "undefined"},
+    /* 202 */ {"var202", "undefined"},
+    /* 203 */ {"var203", "undefined"},
+    /* 204 */ {"var204", "undefined"},
+    /* 205 */ {"RO", "Runoff (total) m"},
+    /* 206 */ {"var206", "undefined"},
+    /* 207 */ {"var207", "undefined"},
+    /* 208 */ {"var208", "undefined"},
+    /* 209 */ {"var209", "undefined"},
+    /* 210 */ {"var210", "undefined"},
+    /* 211 */ {"var211", "undefined"},
+    /* 212 */ {"var212", "undefined"},
+    /* 213 */ {"var213", "undefined"},
+    /* 214 */ {"var214", "undefined"},
+    /* 215 */ {"var215", "undefined"},
+    /* 216 */ {"var216", "undefined"},
+    /* 217 */ {"var217", "undefined"},
+    /* 218 */ {"var218", "undefined"},
+    /* 219 */ {"var219", "undefined"},
+    /* 220 */ {"var220", "undefined"},
+    /* 221 */ {"var221", "undefined"},
+    /* 222 */ {"var222", "undefined"},
+    /* 223 */ {"var223", "undefined"},
+    /* 224 */ {"var224", "undefined"},
+    /* 225 */ {"var225", "undefined"},
+    /* 226 */ {"var226", "undefined"},
+    /* 227 */ {"var227", "undefined"},
+    /* 228 */ {"var228", "undefined"},
+    /* 229 */ {"var229", "undefined"},
+    /* 230 */ {"var230", "undefined"},
+    /* 231 */ {"var231", "undefined"},
+    /* 232 */ {"var232", "undefined"},
+    /* 233 */ {"var233", "undefined"},
+    /* 234 */ {"var234", "undefined"},
+    /* 235 */ {"var235", "undefined"},
+    /* 236 */ {"var236", "undefined"},
+    /* 237 */ {"var237", "undefined"},
+    /* 238 */ {"var238", "undefined"},
+    /* 239 */ {"var239", "undefined"},
+    /* 240 */ {"var240", "undefined"},
+    /* 241 */ {"var241", "undefined"},
+    /* 242 */ {"var242", "undefined"},
+    /* 243 */ {"var243", "undefined"},
+    /* 244 */ {"var244", "undefined"},
+    /* 245 */ {"var245", "undefined"},
+    /* 246 */ {"var246", "undefined"},
+    /* 247 */ {"var247", "undefined"},
+    /* 248 */ {"var248", "undefined"},
+    /* 249 */ {"var249", "undefined"},
+    /* 250 */ {"var250", "undefined"},
+    /* 251 */ {"var251", "undefined"},
+    /* 252 */ {"var252", "undefined"},
+    /* 253 */ {"var253", "undefined"},
+    /* 254 */ {"var254", "undefined"},
+    /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ensemble.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ensemble.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ensemble.c	(revision 2744)
@@ -0,0 +1,103 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <string.h>
+#include "grib.h"
+#include "pds4.h"
+#include "cnames.h"
+
+/*
+ * ensemble.c   v0.1 wesley ebisuzaki
+ *
+ * prints ensemble meta-data
+ *
+ * only for NCEP and ECMWF
+ *
+ * output format:
+ *
+ *       ECMWF
+ *  ens=n/N:       n:  0=ctl, +/-ve
+ *                 N:  total number of members
+ *
+ *       NCEP
+ *  ens=n/type:    n:  0=ctl, +/-ve, CLUST, PROD/
+ *                 type: Mn, WtdMn, SDev, NSDev
+ */
+
+extern int ncep_ens;
+
+void ensemble(unsigned char *pds, int mode) {
+
+    int pdslen;
+    unsigned char ctmp;
+    char char_end;
+
+    pdslen = PDS_LEN(pds);
+    char_end = mode == 2 ? ' ' : ':';
+
+    if ((PDS_Center(pds) == NMC || ncep_ens) && pdslen >= 45 && pds[40] == 1) {
+
+	/* control run */
+
+	if (pds[41] == 1) {
+	    if (mode != 2) {
+		printf("ens%c0:", pds[42] == 1 ? '+' : '-');
+	    }
+	    else {
+		printf("%s-res_ens_control ", pds[42] == 1 ? "hi" : "low");
+	    }
+	}
+
+	/* perturbation run */
+
+	else if (pds[41] == 2 || pds[41] == 3) {
+	    if (mode != 2) {
+	        printf("ens%c%d:", pds[41] == 3 ? '+' : '-', pds[42]);
+	    }
+	    else {
+		printf("ens_perturbation=%c%d ",pds[41] == 3 ? '+' : '-', 
+		    pds[42]);
+	    }
+	}
+
+	/* ensemble mean */
+
+	else if (pds[41] == 5) {
+	    /* makes no sense to say "ensemble mean" for prob forecasts */
+            if (PDS_PARAM(pds) != 191 && PDS_PARAM(pds) != 192) {
+	        if (mode != 2 || pdslen < 61) {
+		    printf("ens-mean%c", char_end);
+		}
+		else {
+		    printf("ensemble-mean(%d members) ",pds[60]);
+		}
+	    }
+	}
+
+	/* other case .. debug code */
+
+	else {
+		printf("ens %d/%d/%d/%d:", pds[41],pds[42],pds[43],pds[44]);
+	}
+
+	/* NCEP probability limits */
+
+	if ((PDS_PARAM(pds) == 191 || PDS_PARAM(pds) == 192) && pdslen >= 47) {
+	    ctmp = PDS_PARAM(pds);
+	    PDS_PARAM(pds) = pds[45];
+	    if (pds[46] == 1 && pdslen >= 51) {
+		printf("prob(%s<%f)%c", k5toa(pds), ibm2flt(pds+47),char_end);
+	    }
+	    else if (pds[46] == 2 && pdslen >= 54) {
+		printf("prob(%s>%f)%c", k5toa(pds), ibm2flt(pds+51), char_end);
+	    }
+	    else if (pds[46] == 3 && pdslen >= 54) {
+		printf("prob(%f<%s<%f)%c", ibm2flt(pds+47), k5toa(pds), 
+			ibm2flt(pds+51), char_end);
+	    }
+            PDS_PARAM(pds) = ctmp;
+	}
+
+    }
+    /* ECMWF test should go here */
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/flt2ieee.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/flt2ieee.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/flt2ieee.c	(revision 2744)
@@ -0,0 +1,67 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <float.h>
+#include "grib.h"
+
+/*
+ * convert a float to an ieee single precision number v1.1
+ * (big endian)
+ *                      Wesley Ebisuzaki
+ *
+ * bugs: doesn't handle subnormal numbers
+ * bugs: assumes length of integer >= 25 bits
+ */
+
+int flt2ieee(float x, unsigned char *ieee) {
+
+	int sign, exp;
+        unsigned int umant;
+	double mant;
+
+	if (x == 0.0) {
+		ieee[0] = ieee[1] = ieee[2] = ieee[3] = 0;
+		return 0;
+	}
+
+	/* sign bit */
+	if (x < 0.0) {
+		sign = 128;
+		x = -x;
+	}
+	else sign = 0;
+	mant = frexp((double) x, &exp);
+
+        /* 2^24 = 16777216 */
+
+	umant = mant * 16777216 + 0.5;
+	if (umant >= 16777216) {
+            umant = umant / 2;
+            exp++;
+        }
+        /* bit 24 should be a 1 .. not used in ieee format */
+
+	exp = exp - 1 + 127;
+
+	if (exp < 0) {
+		/* signed zero */
+		ieee[0] = sign;
+		ieee[1] = ieee[2] = ieee[3] = 0;
+		return 0;
+	}
+	if (exp > 255) {
+		/* signed infinity */
+		ieee[0] = sign + 127;
+		ieee[1] = 128;
+                ieee[2] = ieee[3] = 0;
+                return 0;
+	}
+	/* normal number */
+
+	ieee[0] = sign + (exp >> 1);
+
+        ieee[3] = umant & 255;
+        ieee[2] = (umant >> 8) & 255;
+        ieee[1] = ((exp & 1) << 7) + ((umant >> 16) & 127);
+	return 0;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/gds.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/gds.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/gds.h	(revision 2744)
@@ -0,0 +1,170 @@
+/* version 1.4.3 of grib headers  w. ebisuzaki */
+/* this version is incomplete */
+/* 5/00 - dx/dy or di/dj controlled by bit 1 of resolution byte */
+/* 8/00 - dx/dy or di/dj for polar and lambert not controlled by res. byte */
+/* Added headers for the triangular grid of the gme model of DWD
+         Helmut P. Frank, 13.09.2001 */
+/* Clean up of triangular grid properties access and added spectral information
+         Luis Kornblueh, 27.03.2002 */
+
+#ifndef INT3
+#define INT3(a,b,c) ((1-(int) ((unsigned) (a & 0x80) >> 6)) * (int) (((a & 127) << 16)+(b<<8)+c))
+#endif
+#ifndef INT2
+#define INT2(a,b)   ((1-(int) ((unsigned) (a & 0x80) >> 6)) * (int) (((a & 127) << 8) + b))
+#endif
+
+#ifndef UINT4
+#define UINT4(a,b,c,d) ((int) ((a << 24) + (b << 16) + (c << 8) + (d)))
+#endif
+
+#ifndef UINT3
+#define UINT3(a,b,c) ((int) ((a << 16) + (b << 8) + (c)))
+#endif
+
+#ifndef UINT2
+#define UINT2(a,b) ((int) ((a << 8) + (b)))
+#endif
+
+
+#define GDS_Len1(gds)		(gds[0])
+#define GDS_Len2(gds)		(gds[1])
+#define GDS_Len3(gds)		(gds[2])
+#define GDS_LEN(gds)		((int) ((gds[0]<<16)+(gds[1]<<8)+gds[2]))
+
+#define GDS_NV(gds)		(gds[3])
+#define GDS_DataType(gds)	(gds[5])
+
+#define GDS_LatLon(gds)		(gds[5] == 0)
+#define GDS_Mercator(gds)	(gds[5] == 1)
+#define GDS_Gnomonic(gds)	(gds[5] == 2)
+#define GDS_Lambert(gds)	(gds[5] == 3)
+#define GDS_Gaussian(gds)	(gds[5] == 4)
+#define GDS_Polar(gds)		(gds[5] == 5)
+#define GDS_RotLL(gds)		(gds[5] == 10)
+#define GDS_Harmonic(gds)	(gds[5] == 50)
+#define GDS_Triangular(gds)	(gds[5] == 192)
+#define GDS_ssEgrid(gds)	(gds[5] == 201)	/* semi-staggered E grid */
+#define GDS_fEgrid(gds)		(gds[5] == 202) /* filled E grid */
+#define GDS_ss2dEgrid(gds)	(gds[5] == 203) /* semi-staggered E grid 2 d*/
+
+#define GDS_has_dy(mode)	((mode) & 128)
+#define GDS_LatLon_nx(gds)	((int) ((gds[6] << 8) + gds[7]))
+#define GDS_LatLon_ny(gds)	((int) ((gds[8] << 8) + gds[9]))
+#define GDS_LatLon_La1(gds)	INT3(gds[10],gds[11],gds[12])
+#define GDS_LatLon_Lo1(gds)	INT3(gds[13],gds[14],gds[15])
+#define GDS_LatLon_mode(gds)	(gds[16])
+#define GDS_LatLon_La2(gds)	INT3(gds[17],gds[18],gds[19])
+#define GDS_LatLon_Lo2(gds)	INT3(gds[20],gds[21],gds[22])
+
+#define GDS_LatLon_dx(gds)      (gds[16] & 128 ? INT2(gds[23],gds[24]) : 0)
+#define GDS_LatLon_dy(gds)      (gds[16] & 128 ? INT2(gds[25],gds[26]) : 0)
+#define GDS_Gaussian_nlat(gds)  ((gds[25]<<8)+gds[26])
+
+#define GDS_LatLon_scan(gds)	(gds[27])
+
+#define GDS_Polar_nx(gds)	((gds[6] << 8) + gds[7])
+#define GDS_Polar_ny(gds)	((gds[8] << 8) + gds[9])
+#define GDS_Polar_La1(gds)	INT3(gds[10],gds[11],gds[12])
+#define GDS_Polar_Lo1(gds)	INT3(gds[13],gds[14],gds[15])
+#define GDS_Polar_mode(gds)	(gds[16])
+#define GDS_Polar_Lov(gds)	INT3(gds[17],gds[18],gds[19])
+#define GDS_Polar_scan(gds)	(gds[27])
+#define GDS_Polar_Dx(gds)	INT3(gds[20], gds[21], gds[22])
+#define GDS_Polar_Dy(gds)	INT3(gds[23], gds[24], gds[25])
+#define GDS_Polar_pole(gds)	((gds[26] & 128) == 128)
+
+#define GDS_Lambert_nx(gds)	((gds[6] << 8) + gds[7])
+#define GDS_Lambert_ny(gds)	((gds[8] << 8) + gds[9])
+#define GDS_Lambert_La1(gds)	INT3(gds[10],gds[11],gds[12])
+#define GDS_Lambert_Lo1(gds)	INT3(gds[13],gds[14],gds[15])
+#define GDS_Lambert_mode(gds)	(gds[16])
+#define GDS_Lambert_Lov(gds)	INT3(gds[17],gds[18],gds[19])
+#define GDS_Lambert_dx(gds)	INT3(gds[20],gds[21],gds[22])
+#define GDS_Lambert_dy(gds)	INT3(gds[23],gds[24],gds[25])
+#define GDS_Lambert_NP(gds)	((gds[26] & 128) == 0)
+#define GDS_Lambert_scan(gds)   (gds[27])
+#define GDS_Lambert_Latin1(gds)	INT3(gds[28],gds[29],gds[30])
+#define GDS_Lambert_Latin2(gds)	INT3(gds[31],gds[32],gds[33])
+#define GDS_Lambert_LatSP(gds)	INT3(gds[34],gds[35],gds[36])
+#define GDS_Lambert_LonSP(gds)	INT3(gds[37],gds[37],gds[37])
+
+#define GDS_ssEgrid_n(gds)	UINT2(gds[6],gds[7])
+#define GDS_ssEgrid_n_dum(gds)  UINT2(gds[8],gds[9])
+#define GDS_ssEgrid_La1(gds)	INT3(gds[10],gds[11],gds[12])
+#define GDS_ssEgrid_Lo1(gds)	INT3(gds[13],gds[14],gds[15])
+#define GDS_ssEgrid_mode(gds)	(gds[16])
+#define GDS_ssEgrid_La2(gds)	UINT3(gds[17],gds[18],gds[19])
+#define GDS_ssEgrid_Lo2(gds)	UINT3(gds[20],gds[21],gds[22])
+#define GDS_ssEgrid_di(gds)	(gds[16] & 128 ? INT2(gds[23],gds[24]) : 0)
+#define GDS_ssEgrid_dj(gds)	(gds[16] & 128 ? INT2(gds[25],gds[26]) : 0)
+#define GDS_ssEgrid_scan(gds)	(gds[27])
+
+#define GDS_fEgrid_n(gds)	UINT2(gds[6],gds[7])
+#define GDS_fEgrid_n_dum(gds)   UINT2(gds[8],gds[9])
+#define GDS_fEgrid_La1(gds)	INT3(gds[10],gds[11],gds[12])
+#define GDS_fEgrid_Lo1(gds)	INT3(gds[13],gds[14],gds[15])
+#define GDS_fEgrid_mode(gds)	(gds[16])
+#define GDS_fEgrid_La2(gds)	UINT3(gds[17],gds[18],gds[19])
+#define GDS_fEgrid_Lo2(gds)	UINT3(gds[20],gds[21],gds[22])
+#define GDS_fEgrid_di(gds)	(gds[16] & 128 ? INT2(gds[23],gds[24]) : 0)
+#define GDS_fEgrid_dj(gds)	(gds[16] & 128 ? INT2(gds[25],gds[26]) : 0)
+#define GDS_fEgrid_scan(gds)	(gds[27])
+
+#define GDS_ss2dEgrid_nx(gds)     UINT2(gds[6],gds[7])
+#define GDS_ss2dEgrid_ny(gds)     UINT2(gds[8],gds[9])
+#define GDS_ss2dEgrid_La1(gds)    INT3(gds[10],gds[11],gds[12])
+#define GDS_ss2dEgrid_Lo1(gds)    INT3(gds[13],gds[14],gds[15])
+#define GDS_ss2dEgrid_mode(gds)   (gds[16])
+#define GDS_ss2dEgrid_La2(gds)    INT3(gds[17],gds[18],gds[19])
+#define GDS_ss2dEgrid_Lo2(gds)    INT3(gds[20],gds[21],gds[22])
+#define GDS_ss2dEgrid_di(gds)     (gds[16] & 128 ? INT2(gds[23],gds[24]) : 0)
+#define GDS_ss2dEgrid_dj(gds)     (gds[16] & 128 ? INT2(gds[25],gds[26]) : 0)
+#define GDS_ss2dEgrid_scan(gds)   (gds[27])
+
+
+#define GDS_Merc_nx(gds)	UINT2(gds[6],gds[7])
+#define GDS_Merc_ny(gds)	UINT2(gds[8],gds[9])
+#define GDS_Merc_La1(gds)	INT3(gds[10],gds[11],gds[12])
+#define GDS_Merc_Lo1(gds)	INT3(gds[13],gds[14],gds[15])
+#define GDS_Merc_mode(gds)	(gds[16])
+#define GDS_Merc_La2(gds)	INT3(gds[17],gds[18],gds[19])
+#define GDS_Merc_Lo2(gds)	INT3(gds[20],gds[21],gds[22])
+#define GDS_Merc_Latin(gds)	INT3(gds[23],gds[24],gds[25])
+#define GDS_Merc_scan(gds)	(gds[27])
+#define GDS_Merc_dx(gds)        (gds[16] & 128 ? INT3(gds[28],gds[29],gds[30]) : 0)
+#define GDS_Merc_dy(gds)        (gds[16] & 128 ? INT3(gds[31],gds[32],gds[33]) : 0)
+
+/* rotated Lat-lon grid */
+
+#define GDS_RotLL_nx(gds)	UINT2(gds[6],gds[7])
+#define GDS_RotLL_ny(gds)	UINT2(gds[8],gds[9])
+#define GDS_RotLL_La1(gds)	INT3(gds[10],gds[11],gds[12])
+#define GDS_RotLL_Lo1(gds)	INT3(gds[13],gds[14],gds[15])
+#define GDS_RotLL_mode(gds)	(gds[16])
+#define GDS_RotLL_La2(gds)	INT3(gds[17],gds[18],gds[19])
+#define GDS_RotLL_Lo2(gds)	INT3(gds[20],gds[21],gds[22])
+#define GDS_RotLL_dx(gds)       (gds[16] & 128 ? INT2(gds[23],gds[24]) : 0)
+#define GDS_RotLL_dy(gds)       (gds[16] & 128 ? INT2(gds[25],gds[26]) : 0)
+#define GDS_RotLL_scan(gds)	(gds[27])
+#define GDS_RotLL_LaSP(gds)	INT3(gds[32],gds[33],gds[34])
+#define GDS_RotLL_LoSP(gds)	INT3(gds[35],gds[36],gds[37])
+#define GDS_RotLL_RotAng(gds)	ibm2flt(&(gds[38]))
+
+/* Triangular grid of DWD */
+#define GDS_Triangular_ni2(gds)	INT2(gds[6],gds[7])
+#define GDS_Triangular_ni3(gds)	INT2(gds[8],gds[9])
+#define GDS_Triangular_ni(gds)	INT3(gds[13],gds[14],gds[15])
+#define GDS_Triangular_nd(gds)  INT3(gds[10],gds[11],gds[12])
+
+/* Harmonics data */
+#define GDS_Harmonic_nj(gds)     ((int) ((gds[6] << 8) + gds[7])) 
+#define GDS_Harmonic_nk(gds)     ((int) ((gds[8] << 8) + gds[9])) 
+#define GDS_Harmonic_nm(gds)     ((int) ((gds[10] << 8) + gds[11])) 
+#define GDS_Harmonic_type(gds)   (gds[12])
+#define GDS_Harmonic_mode(gds)   (gds[13])
+
+/* index of NV and PV */
+#define GDS_PV(gds)		((gds[3] == 0) ? -1 : (int) gds[4] - 1)
+#define GDS_PL(gds)		((gds[4] == 255) ? -1 : (int) gds[3] * 4 + (int) gds[4] - 1)
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/gds_grid.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/gds_grid.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/gds_grid.c	(revision 2744)
@@ -0,0 +1,162 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "grib.h"
+#include "bds.h"
+#include "gds.h"
+
+/*
+ * get grid size from GDS
+ *
+ * added calculation of nxny of spectral data and clean up of triangular
+ * grid nnxny calculation     l. kornblueh 
+ * 7/25/03 wind fix Dusan Jovic
+ * 9/17/03 fix scan mode
+ */
+
+int GDS_grid(unsigned char *gds, unsigned char *bds, int *nx, int *ny, 
+             long int *nxny) {
+
+    int i, d, ix, iy, pl;
+    long int isum;
+
+    *nx = ix = GDS_LatLon_nx(gds);
+    *ny = iy = GDS_LatLon_ny(gds);
+    *nxny = ix * iy;
+
+    /* thin grid */
+
+    if (GDS_Gaussian(gds) || GDS_LatLon(gds)) {
+	if (ix == 65535) {
+	    *nx = -1;
+	    /* reduced grid */
+	    isum = 0;
+	    pl = GDS_PL(gds);
+	    for (i = 0; i < iy; i++) {
+		isum += gds[pl+i*2]*256 + gds[pl+i*2+1];
+	    }
+	    *nxny = isum;
+	}
+	return 0;
+    }
+    if (GDS_Triangular(gds)) {
+        i = GDS_Triangular_ni(gds);
+        d = GDS_Triangular_nd(gds);
+	*nx = *nxny = d * (i + 1) * (i + 1);
+        *ny = 1;
+	return 0;
+    }
+    if (GDS_Harmonic(gds)) {
+        /* this code assumes j, k, m are consistent with bds */
+        *nx = *nxny = (8*(BDS_LEN(bds)-15)-BDS_UnusedBits(bds))/
+		BDS_NumBits(bds)+1;
+           if ((8*(BDS_LEN(bds)-15)-BDS_UnusedBits(bds)) % BDS_NumBits(bds)) {
+	       fprintf(stderr,"inconsistent harmonic BDS\n");
+           }
+        *ny = 1;
+    }
+    return 0;
+}
+
+#define NCOL 15
+void GDS_prt_thin_lon(unsigned char *gds) {
+    int iy, i, col, pl;
+
+    iy = GDS_LatLon_ny(gds);
+    iy = (iy + 1) / 2;
+    iy = GDS_LatLon_ny(gds);
+
+    if ((pl = GDS_PL(gds)) == -1) {
+	fprintf(stderr,"\nprogram error: GDS_prt_thin\n");
+	return;
+    }
+    for (col = i = 0; i < iy; i++) {
+	if (col == 0) printf("   ");
+	printf("%5d", (gds[pl+i*2] << 8) + gds[pl+i*2+1]);
+	col++;
+	if (col == NCOL) {
+	    col = 0;
+	    printf("\n");
+	}
+    }
+    if (col != 0) printf("\n");
+}
+
+/*
+ * prints out wind rel to grid or earth
+ */
+
+static char *scan_mode[8] = {
+	"WE:NS",
+	"NS:WE",
+
+	"WE:SN",
+	"SN:WE",
+
+        "EW:NS",
+	"NS:EW",
+
+	"EW:SN",
+	"SN:EW" };
+
+
+void GDS_winds(unsigned char *gds, int verbose) {
+    int scan = -1, mode = -1;
+
+    if (gds != NULL) {
+        if (GDS_LatLon(gds)) {
+	    scan = GDS_LatLon_scan(gds);
+	    mode = GDS_LatLon_mode(gds);
+	}
+	else if (GDS_Mercator(gds)) {
+	    scan =GDS_Merc_scan(gds);
+	    mode =GDS_Merc_mode(gds);
+	}
+	/* else if (GDS_Gnomonic(gds)) { */
+	else if (GDS_Lambert(gds)) {
+	    scan = GDS_Lambert_scan(gds);
+	    mode = GDS_Lambert_mode(gds);
+	}
+	else if (GDS_Gaussian(gds)) {
+	    scan = GDS_LatLon_scan(gds);
+	    mode = GDS_LatLon_mode(gds);
+	}
+	else if (GDS_Polar(gds)) {
+	    scan = GDS_Polar_scan(gds);
+	    mode = GDS_Polar_mode(gds);
+	}
+	else if (GDS_RotLL(gds)) {
+	    scan = GDS_RotLL_scan(gds);
+	    mode = GDS_RotLL_mode(gds);
+	}
+	/* else if (GDS_Triangular(gds)) { */
+	else if (GDS_ssEgrid(gds)) {
+	    scan = GDS_ssEgrid_scan(gds);
+	    mode = GDS_ssEgrid_mode(gds);
+	}
+	else if (GDS_fEgrid(gds)) {
+	    scan = GDS_fEgrid_scan(gds);
+	    mode = GDS_fEgrid_mode(gds);
+	}
+	else if (GDS_ss2dEgrid(gds)) {
+	    scan = GDS_ss2dEgrid_scan(gds);
+	    mode = GDS_ss2dEgrid_mode(gds);
+	}
+    }
+    if (verbose == 1) {
+	if (mode != -1) {
+	    if (mode & 8) printf("winds in grid direction:");
+	    else printf("winds are N/S:"); 
+	}
+    }
+    else if (verbose == 2) {
+	if (scan != -1) {
+	    printf(" scan: %s", scan_mode[(scan >> 5) & 7]);
+        }
+	if (mode != -1) {
+	    if (mode & 8) printf(" winds(grid) ");
+	    else printf(" winds(N/S) "); 
+	}
+    }
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/grib.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/grib.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/grib.h	(revision 2744)
@@ -0,0 +1,44 @@
+enum Def_NCEP_Table {rean, opn, rean_nowarn, opn_nowarn};
+
+unsigned char *seek_grib(FILE *file, long *pos, long *len_grib, 
+        unsigned char *buffer, unsigned int buf_len);
+
+int read_grib(FILE *file, long pos, long len_grib, unsigned char *buffer);
+
+double ibm2flt(unsigned char *ibm);
+ 
+void BDS_unpack(float *flt, unsigned char *bds, unsigned char *bitmap,
+        int n_bits, int n, double ref, double scale);
+
+double int_power(double x, int y);
+
+int flt2ieee(float x, unsigned char *ieee);
+
+int wrtieee(float *array, int n, int header, FILE *output);
+int wrtieee_header(unsigned int n, FILE *output);
+
+void levels(int, int, int);
+ 
+void PDStimes(int time_range, int p1, int p2, int time_unit);
+
+int missing_points(unsigned char *bitmap, int n);
+
+void EC_ext(unsigned char *pds, char *prefix, char *suffix);
+
+int GDS_grid(unsigned char *gds, unsigned char *bds, int *nx, int *ny, 
+             long int *nxny);
+
+void GDS_prt_thin_lon(unsigned char *gds);
+
+void GDS_winds(unsigned char *gds, int verbose);
+
+int PDS_date(unsigned char *pds, int option, int verf_time);
+
+int add_time(int *year, int *month, int *day, int *hour, int dtime, int unit);
+
+int verf_time(unsigned char *pds, int *year, int *month, int *day, int *hour);
+
+void print_pds(unsigned char *pds, int print_PDS, int print_PDS10, int verbose);
+void print_gds(unsigned char *gds, int print_GDS, int print_GDS10, int verbose);
+
+void ensemble(unsigned char *pds, int mode);
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/gribtable.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/gribtable.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/gribtable.c	(revision 2744)
@@ -0,0 +1,131 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <string.h>
+#include "cnames.h"
+
+#define START -1
+
+static int user_center = 0, user_subcenter = 0, user_ptable = 0;
+static enum {filled, not_found, not_checked, no_file, init} status = init;
+
+struct ParmTable parm_table_user[256];
+
+/*
+ * sets up user parameter table
+ */
+
+int setup_user_table(int center, int subcenter, int ptable) {
+
+    int i, j, c0, c1, c2;
+    static FILE *input;
+    static int file_open = 0;
+    char *filename, line[300];
+
+    if (status == init) {
+	for (i = 0; i < 256; i++) {
+	    parm_table_user[i].name = parm_table_user[i].comment = NULL;
+	}
+	status = not_checked;
+    }
+
+    if (status == no_file) return 0;
+
+    if ((user_center == -1 || center == user_center) &&
+	    (user_subcenter == -1 || subcenter == user_subcenter) &&
+	    (user_ptable == -1 || ptable == user_ptable)) {
+
+	if (status == filled) return 1;
+	if (status == not_found) return 0;
+    }
+
+    /* open gribtab file if not open */
+
+    if (!file_open) {
+        filename = getenv("GRIBTAB");
+        if (filename == NULL) filename = getenv("gribtab");
+        if (filename == NULL) filename = "gribtab";
+
+        if ((input = fopen(filename,"r")) == NULL) {
+            status = no_file;
+            return 0;
+        }
+	file_open = 1;
+    }
+    else {
+	rewind(input);
+    }
+
+    user_center = center;
+    user_subcenter = subcenter;
+    user_ptable = ptable;
+
+    /* scan for center & subcenter and ptable */
+    for (;;) {
+        if (fgets(line, 299, input) == NULL) {
+	    status = not_found;
+            return 0;
+        }
+	if (atoi(line) != START) continue;
+	i = sscanf(line,"%d:%d:%d:%d", &j, &center, &subcenter, &ptable);
+        if (i != 4) {
+	    fprintf(stderr,"illegal gribtab center/subcenter/ptable line: %s\n", line);
+            continue;
+        }
+	if ((center == -1 || center == user_center) &&
+	    (subcenter == -1 || subcenter == user_subcenter) &&
+	    (ptable == -1 || ptable == user_ptable)) break;
+    }
+
+    user_center = center;
+    user_subcenter = subcenter;
+    user_ptable = ptable;
+
+    /* free any used memory */
+    if (parm_table_user[i].name != NULL) {
+        for (i = 0; i < 256; i++) {
+	    free(parm_table_user[i].name);
+            free(parm_table_user[i].comment);
+        }
+    }
+
+    /* read definitions */
+
+    for (;;) {
+        if (fgets(line, 299, input) == NULL) break;
+	if ((i = atoi(line)) == START) break;
+	line[299] = 0;
+
+	/* find the colons and end-of-line */
+	for (c0 = 0; line[c0] != ':' && line[c0] != 0; c0++) ;
+        /* skip blank lines */
+        if (line[c0] == 0) continue;
+
+	for (c1 = c0 + 1; line[c1] != ':' && line[c1] != 0; c1++) ;
+	c2 = strlen(line);
+        if (line[c2-1] == '\n') line[--c2] = '\0';
+        if (c2 <= c1) {
+	    fprintf(stderr,"illegal gribtab line:%s\n", line);
+	    continue;
+	}
+	line[c0] = 0;
+	line[c1] = 0;
+
+	parm_table_user[i].name = (char *) malloc(c1 - c0);
+	parm_table_user[i].comment = (char *) malloc(c2 - c1);
+	strcpy(parm_table_user[i].name, line+c0+1);
+	strcpy(parm_table_user[i].comment, line+c1+1);
+    }
+
+    /* now to fill in undefined blanks */
+    for (i = 0; i < 255; i++) {
+	if (parm_table_user[i].name == NULL) {
+	    parm_table_user[i].name = (char *) malloc(7);
+	    sprintf(parm_table_user[i].name, "var%d", i);
+	    parm_table_user[i].comment = (char *) malloc(strlen("undefined")+1);
+	    strcpy(parm_table_user[i].comment, "undefined");
+        }
+    }
+    status = filled;
+    return 1;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ibm2flt.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ibm2flt.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ibm2flt.c	(revision 2744)
@@ -0,0 +1,43 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+/* ibm2flt       wesley ebisuzaki
+ *
+ * v1.1 .. faster
+ * v1.1 .. if mant == 0 -> quick return
+ *
+ */
+
+
+double ibm2flt(unsigned char *ibm) {
+
+	int positive, power;
+	unsigned int abspower;
+	long int mant;
+	double value, exp;
+
+	mant = (ibm[1] << 16) + (ibm[2] << 8) + ibm[3];
+        if (mant == 0) return 0.0;
+
+	positive = (ibm[0] & 0x80) == 0;
+	power = (int) (ibm[0] & 0x7f) - 64;
+	abspower = power > 0 ? power : -power;
+
+
+	/* calc exp */
+	exp = 16.0;
+	value = 1.0;
+	while (abspower) {
+		if (abspower & 1) {
+			value *= exp;
+		}
+		exp = exp * exp;
+		abspower >>= 1;
+	}
+
+	if (power < 0) value = 1.0 / value;
+	value = value * mant / 16777216.0;
+	if (positive == 0) value = -value;
+	return value;
+}
+	
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/intpower.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/intpower.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/intpower.c	(revision 2744)
@@ -0,0 +1,31 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+/*
+ * w. ebisuzaki
+ *
+ *  return x**y
+ *
+ *
+ *  input: double x
+ *	   int y
+ */
+double int_power(double x, int y) {
+
+	double value;
+
+	if (y < 0) {
+		y = -y;
+		x = 1.0 / x;
+	}
+	value = 1.0;
+
+	while (y) {
+		if (y & 1) {
+			value *= x;
+		}
+		x = x * x;
+		y >>= 1;
+	}
+	return value;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/levels.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/levels.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/levels.c	(revision 2744)
@@ -0,0 +1,178 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "pds4.h"
+#include "grib.h"
+
+/* wesley ebisuzaki v1.0
+ *
+ * levels.c
+ *
+ * prints out a simple description of kpds6, kpds7
+ *    (level/layer data)
+ *  kpds6 = octet 10 of the PDS
+ *  kpds7 = octet 11 and 12 of the PDS
+ *    (kpds values are from NMC's grib routines)
+ *  center = PDS_Center(pds) .. NMC, ECMWF, etc
+ *
+ * the description of the levels is 
+ *   (1) incomplete
+ *   (2) include some NMC-only values (>= 200?)
+ *
+ * v1.1 wgrib v1.7.3.1 updated with new levels
+ * v1.2 added new level and new parameter
+ * v1.2.1 modified level 117 pv units
+ * v1.2.2 corrected level 141
+ * v1.2.3 fixed layer 206 (was 205)
+ */
+
+void levels(int kpds6, int kpds7, int center) {
+
+	int o11, o12;
+
+	/* octets 11 and 12 */
+	o11 = kpds7 / 256;
+	o12 = kpds7 % 256;
+
+
+	switch (kpds6) {
+
+	case 1: printf("sfc");
+		break;
+	case 2: printf("cld base");
+		break;
+	case 3: printf("cld top");
+		break;
+	case 4: printf("0C isotherm");
+		break;
+	case 5: printf("cond lev");
+		break;
+	case 6: printf("max wind lev");
+		break;
+	case 7: printf("tropopause");
+		break;
+	case 8: printf("nom. top");
+		break;
+	case 9: printf("sea bottom");
+		break;
+	case 200:
+	case 10: printf("atmos col");
+		break;
+
+	case 12:
+	case 212: printf("low cld bot");
+		break;
+	case 13:
+	case 213: printf("low cld top");
+		break;
+	case 14:
+	case 214: printf("low cld lay");
+		break;
+	case 22:
+	case 222: printf("mid cld bot");
+		break;
+	case 23:
+	case 223: printf("mid cld top");
+		break;
+	case 24:
+	case 224: printf("mid cld lay");
+		break;
+	case 32:
+	case 232: printf("high cld bot");
+		break;
+	case 33:
+	case 233: printf("high cld top");
+		break;
+	case 34:
+	case 234: printf("high cld lay");
+		break;
+
+	case 201: printf("ocean column");
+		break;
+	case 204: printf("high trop freezing lvl");
+		break;
+	case 206: printf("grid-scale cld bot");
+		break;
+	case 207: printf("grid-scale cld top");
+		break;
+	case 209: printf("bndary-layer cld bot");
+		break;
+	case 210: printf("bndary-layer cld top");
+		break;
+	case 211: printf("bndary-layer cld layer");
+		break;
+	case 242: printf("convect-cld bot");
+		break;
+	case 243: printf("convect-cld top");
+		break;
+	case 244: printf("convect-cld layer");
+		break;
+	case 246: printf("max e-pot-temp lvl");
+		break;
+	case 247: printf("equilibrium lvl");
+		break;
+	case 248: printf("shallow convect-cld bot");
+		break;
+	case 249: printf("shallow convect-cld top");
+		break;
+	case 251: printf("deep convect-cld bot");
+		break;
+	case 252: printf("deep convect-cld top");
+		break;
+
+	case 100: printf("%d mb",kpds7);
+	 	break;
+	case 101: printf("%d-%d mb",o11*10,o12*10);
+	 	break;
+	case 102: printf("MSL");
+	 	break;
+	case 103: printf("%d m above MSL",kpds7);
+	 	break;
+	case 104: printf("%d-%d m above msl",o11*100,o12*100);
+	 	break;
+	case 105: printf("%d m above gnd",kpds7);
+	 	break;
+	case 106: printf("%d-%d m above gnd",o11*100,o12*100);
+	 	break;
+	case 107: printf("sigma=%.4f",kpds7/10000.0);
+	 	break;
+	case 108: printf("sigma %.2f-%.2f",o11/100.0,o12/100.0);
+	 	break;
+	case 109: printf("hybrid lev %d",kpds7);
+	 	break;
+	case 110: printf("hybrid %d-%d",o11,o12);
+	 	break;
+	case 111: printf("%d cm down",kpds7);
+	 	break;
+	case 112: printf("%d-%d cm down",o11,o12);
+	 	break;
+	case 113: printf("%dK",kpds7);
+	 	break;
+	case 114: printf("%d-%dK",475-o11,475-o12);
+	 	break;
+	case 115: printf("%d mb above gnd",kpds7);
+	 	break;
+	case 116: printf("%d-%d mb above gnd",o11,o12);
+	 	break;
+	case 117: printf("%d pv units",INT2(o11,o12)); /* units are suspect */
+	 	break;
+	case 119: printf("%.5f (ETA level)",kpds7/10000.0);
+	 	break;
+	case 120: printf("%.2f-%.2f (ETA levels)",o11/100.0,o12/100.0);
+	 	break;
+	case 121: printf("%d-%d mb",1100-o11,1100-o12);
+	 	break;
+	case 125: printf("%d cm above gnd",kpds7);
+	 	break;
+	case 126: 
+		if (center == NMC) printf("%.2f mb",kpds7*0.01);
+	 	break;
+	case 128: printf("%.3f-%.3f (sigma)",1.1-o11/1000.0, 1.1-o12/1000.0);
+	 	break;
+	case 141: printf("%d-%d mb",o11*10,1100-o12);
+	 	break;
+	case 160: printf("%d m below sea level",kpds7);
+	 	break;
+	default:
+	 	break;
+	}
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/missing.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/missing.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/missing.c	(revision 2744)
@@ -0,0 +1,48 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "grib.h"
+
+/*
+ *  number of missing data points w. ebisuzaki
+ *
+ *  v1.1: just faster my dear
+ *  v1.2: just faster my dear
+ *
+ */
+
+static int bitsum[256] = {
+    8, 7, 7, 6, 7, 6, 6, 5, 7, 6, 6, 5, 6, 5, 5, 4, 
+    7, 6, 6, 5, 6, 5, 5, 4, 6, 5, 5, 4, 5, 4, 4, 3, 
+    7, 6, 6, 5, 6, 5, 5, 4, 6, 5, 5, 4, 5, 4, 4, 3, 
+    6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, 
+    7, 6, 6, 5, 6, 5, 5, 4, 6, 5, 5, 4, 5, 4, 4, 3, 
+    6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, 
+    6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, 
+    5, 4, 4, 3, 4, 3, 3, 2, 4, 3, 3, 2, 3, 2, 2, 1, 
+    7, 6, 6, 5, 6, 5, 5, 4, 6, 5, 5, 4, 5, 4, 4, 3, 
+    6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, 
+    6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, 
+    5, 4, 4, 3, 4, 3, 3, 2, 4, 3, 3, 2, 3, 2, 2, 1, 
+    6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, 
+    5, 4, 4, 3, 4, 3, 3, 2, 4, 3, 3, 2, 3, 2, 2, 1, 
+    5, 4, 4, 3, 4, 3, 3, 2, 4, 3, 3, 2, 3, 2, 2, 1, 
+    4, 3, 3, 2, 3, 2, 2, 1, 3, 2, 2, 1, 2, 1, 1, 0};
+
+
+int missing_points(unsigned char *bitmap, int n) {
+
+    int count;
+    unsigned int tmp;
+    if (bitmap == NULL) return 0;
+
+    count = 0;
+    while (n >= 8) {
+	tmp = *bitmap++;
+	n -= 8;
+        count += bitsum[tmp];
+    }
+    tmp = *bitmap | ((1 << (8 - n)) - 1);
+    count += bitsum[tmp];
+
+    return count;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptab_129.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptab_129.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptab_129.c	(revision 2744)
@@ -0,0 +1,260 @@
+#include "cnames.h"
+
+struct ParmTable parm_table_nceptab_129[256] = {
+      /* 0 */ {"var0", "undefined"},
+      /* 1 */ {"PRES", "Pressure [Pa]"},
+      /* 2 */ {"PRMSL", "Pressure reduced to MSL [Pa]"},
+      /* 3 */ {"PTEND", "Pressure tendency [Pa/s]"},
+      /* 4 */ {"PVORT", "Pot. vorticity [km^2/kg/s]"},
+      /* 5 */ {"ICAHT", "ICAO Standard Atmosphere Reference Height [M]"},
+      /* 6 */ {"GP", "Geopotential [m^2/s^2]"},
+      /* 7 */ {"HGT", "Geopotential height [gpm]"},
+      /* 8 */ {"DIST", "Geometric height [m]"},
+      /* 9 */ {"HSTDV", "Std dev of height [m]"},
+      /* 10 */ {"TOZNE", "Total ozone [Dobson]"},
+      /* 11 */ {"TMP", "Temp. [K]"},
+      /* 12 */ {"VTMP", "Virtual temp. [K]"},
+      /* 13 */ {"POT", "Potential temp. [K]"},
+      /* 14 */ {"EPOT", "Pseudo-adiabatic pot. temp. [K]"},
+      /* 15 */ {"TMAX", "Max. temp. [K]"},
+      /* 16 */ {"TMIN", "Min. temp. [K]"},
+      /* 17 */ {"DPT", "Dew point temp. [K]"},
+      /* 18 */ {"DEPR", "Dew point depression [K]"},
+      /* 19 */ {"LAPR", "Lapse rate [K/m]"},
+      /* 20 */ {"VIS", "Visibility [m]"},
+      /* 21 */ {"RDSP1", "Radar spectra (1) [non-dim]"},
+      /* 22 */ {"RDSP2", "Radar spectra (2) [non-dim]"},
+      /* 23 */ {"RDSP3", "Radar spectra (3) [non-dim]"},
+      /* 24 */ {"PLI", "Parcel lifted index (to 500 hPa) [K]"},
+      /* 25 */ {"TMPA", "Temp. anomaly [K]"},
+      /* 26 */ {"PRESA", "Pressure anomaly [Pa]"},
+      /* 27 */ {"GPA", "Geopotential height anomaly [gpm]"},
+      /* 28 */ {"WVSP1", "Wave spectra (1) [non-dim]"},
+      /* 29 */ {"WVSP2", "Wave spectra (2) [non-dim]"},
+      /* 30 */ {"WVSP3", "Wave spectra (3) [non-dim]"},
+      /* 31 */ {"WDIR", "Wind direction [deg]"},
+      /* 32 */ {"WIND", "Wind speed [m/s]"},
+      /* 33 */ {"UGRD", "u wind [m/s]"},
+      /* 34 */ {"VGRD", "v wind [m/s]"},
+      /* 35 */ {"STRM", "Stream function [m^2/s]"},
+      /* 36 */ {"VPOT", "Velocity potential [m^2/s]"},
+      /* 37 */ {"MNTSF", "Montgomery stream function [m^2/s^2]"},
+      /* 38 */ {"SGCVV", "Sigma coord. vertical velocity [/s]"},
+      /* 39 */ {"VVEL", "Pressure vertical velocity [Pa/s]"},
+      /* 40 */ {"DZDT", "Geometric vertical velocity [m/s]"},
+      /* 41 */ {"ABSV", "Absolute vorticity [/s]"},
+      /* 42 */ {"ABSD", "Absolute divergence [/s]"},
+      /* 43 */ {"RELV", "Relative vorticity [/s]"},
+      /* 44 */ {"RELD", "Relative divergence [/s]"},
+      /* 45 */ {"VUCSH", "Vertical u shear [/s]"},
+      /* 46 */ {"VVCSH", "Vertical v shear [/s]"},
+      /* 47 */ {"DIRC", "Direction of current [deg]"},
+      /* 48 */ {"SPC", "Speed of current [m/s]"},
+      /* 49 */ {"UOGRD", "u of current [m/s]"},
+      /* 50 */ {"VOGRD", "v of current [m/s]"},
+      /* 51 */ {"SPFH", "Specific humidity [kg/kg]"},
+      /* 52 */ {"RH", "Relative humidity [%]"},
+      /* 53 */ {"MIXR", "Humidity mixing ratio [kg/kg]"},
+      /* 54 */ {"PWAT", "Precipitable water [kg/m^2]"},
+      /* 55 */ {"VAPP", "Vapor pressure [Pa]"},
+      /* 56 */ {"SATD", "Saturation deficit [Pa]"},
+      /* 57 */ {"EVP", "Evaporation [kg/m^2]"},
+      /* 58 */ {"CICE", "Cloud Ice [kg/m^2]"},
+      /* 59 */ {"PRATE", "Precipitation rate [kg/m^2/s]"},
+      /* 60 */ {"TSTM", "Thunderstorm probability [%]"},
+      /* 61 */ {"APCP", "Total precipitation [kg/m^2]"},
+      /* 62 */ {"NCPCP", "Large scale precipitation [kg/m^2]"},
+      /* 63 */ {"ACPCP", "Convective precipitation [kg/m^2]"},
+      /* 64 */ {"SRWEQ", "Snowfall rate water equiv. [kg/m^2/s]"},
+      /* 65 */ {"WEASD", "Accum. snow [kg/m^2]"},
+      /* 66 */ {"SNOD", "Snow depth [m]"},
+      /* 67 */ {"MIXHT", "Mixed layer depth [m]"},
+      /* 68 */ {"TTHDP", "Transient thermocline depth [m]"},
+      /* 69 */ {"MTHD", "Main thermocline depth [m]"},
+      /* 70 */ {"MTHA", "Main thermocline anomaly [m]"},
+      /* 71 */ {"TCDC", "Total cloud cover [%]"},
+      /* 72 */ {"CDCON", "Convective cloud cover [%]"},
+      /* 73 */ {"LCDC", "Low level cloud cover [%]"},
+      /* 74 */ {"MCDC", "Mid level cloud cover [%]"},
+      /* 75 */ {"HCDC", "High level cloud cover [%]"},
+      /* 76 */ {"CWAT", "Cloud water [kg/m^2]"},
+      /* 77 */ {"BLI", "Best lifted index (to 500 hPa) [K]"},
+      /* 78 */ {"SNOC", "Convective snow [kg/m^2]"},
+      /* 79 */ {"SNOL", "Large scale snow [kg/m^2]"},
+      /* 80 */ {"WTMP", "Water temp. [K]"},
+      /* 81 */ {"LAND", "Land cover (land=1;sea=0) [fraction]"},
+      /* 82 */ {"DSLM", "Deviation of sea level from mean [m]"},
+      /* 83 */ {"SFCR", "Surface roughness [m]"},
+      /* 84 */ {"ALBDO", "Albedo [%]"},
+      /* 85 */ {"TSOIL", "Soil temp. [K]"},
+      /* 86 */ {"SOILM", "Soil moisture content [kg/m^2]"},
+      /* 87 */ {"VEG", "Vegetation [%]"},
+      /* 88 */ {"SALTY", "Salinity [kg/kg]"},
+      /* 89 */ {"DEN", "Density [kg/m^3]"},
+      /* 90 */ {"WATR", "Water runoff [kg/m^2]"},
+      /* 91 */ {"ICEC", "Ice concentration (ice=1;no ice=0) [fraction]"},
+      /* 92 */ {"ICETK", "Ice thickness [m]"},
+      /* 93 */ {"DICED", "Direction of ice drift [deg]"},
+      /* 94 */ {"SICED", "Speed of ice drift [m/s]"},
+      /* 95 */ {"UICE", "u of ice drift [m/s]"},
+      /* 96 */ {"VICE", "v of ice drift [m/s]"},
+      /* 97 */ {"ICEG", "Ice growth rate [m/s]"},
+      /* 98 */ {"ICED", "Ice divergence [/s]"},
+      /* 99 */ {"SNOM", "Snow melt [kg/m^2]"},
+      /* 100 */ {"HTSGW", "Sig height of wind waves and swell [m]"},
+      /* 101 */ {"WVDIR", "Direction of wind waves [deg]"},
+      /* 102 */ {"WVHGT", "Sig height of wind waves [m]"},
+      /* 103 */ {"WVPER", "Mean period of wind waves [s]"},
+      /* 104 */ {"SWDIR", "Direction of swell waves [deg]"},
+      /* 105 */ {"SWELL", "Sig height of swell waves [m]"},
+      /* 106 */ {"SWPER", "Mean period of swell waves [s]"},
+      /* 107 */ {"DIRPW", "Primary wave direction [deg]"},
+      /* 108 */ {"PERPW", "Primary wave mean period [s]"},
+      /* 109 */ {"DIRSW", "Secondary wave direction [deg]"},
+      /* 110 */ {"PERSW", "Secondary wave mean period [s]"},
+      /* 111 */ {"NSWRS", "Net short wave (surface) [W/m^2]"},
+      /* 112 */ {"NLWRS", "Net long wave (surface) [W/m^2]"},
+      /* 113 */ {"NSWRT", "Net short wave (top) [W/m^2]"},
+      /* 114 */ {"NLWRT", "Net long wave (top) [W/m^2]"},
+      /* 115 */ {"LWAVR", "Long wave [W/m^2]"},
+      /* 116 */ {"SWAVR", "Short wave [W/m^2]"},
+      /* 117 */ {"GRAD", "Global radiation [W/m^2]"},
+      /* 118 */ {"BRTMP", "Brightness temperature [K]"},
+      /* 119 */ {"LWRAD", "Radiance with respect to wave no. [W/m/sr]"},
+      /* 120 */ {"SWRAD", "Radiance with respect ot wave len. [W/m^3/sr]"},
+      /* 121 */ {"LHTFL", "Latent heat flux [W/m^2]"},
+      /* 122 */ {"SHTFL", "Sensible heat flux [W/m^2]"},
+      /* 123 */ {"BLYDP", "Boundary layer dissipation [W/m^2]"},
+      /* 124 */ {"UFLX", "Zonal momentum flux [N/m^2]"},
+      /* 125 */ {"VFLX", "Meridional momentum flux [N/m^2]"},
+      /* 126 */ {"WMIXE", "Wind mixing energy [J]"},
+      /* 127 */ {"IMGD", "Image data []"},
+      /* 128 */ {"PAOT", "Probability anomaly of temp [%]"},
+      /* 129 */ {"PAOP", "Probability anomaly of precip [%]"},
+      /* 130 */ {"var130", "undefined"},
+      /* 131 */ {"FRAIN", "Rain fraction of total liquid water []"},
+      /* 132 */ {"FICE", "Ice fraction of total condensate []"},
+      /* 133 */ {"FRIME", "Rime factor []"},
+      /* 134 */ {"CUEFI", "Convective cloud efficiency []"},
+      /* 135 */ {"TCOND", "Total condensate [kg/kg]"},
+      /* 136 */ {"TCOLW", "Total column cloud water [kg/m/m]"},
+      /* 137 */ {"TCOLI", "Total column cloud ice [kg/m/m]"},
+      /* 138 */ {"TCOLR", "Total column rain [kg/m/m]"},
+      /* 139 */ {"TCOLS", "Total column snow [kg/m/m]"},
+      /* 140 */ {"TCOLC", "Total column condensate [kg/m/m]"},
+      /* 141 */ {"PLPL", "Pressure of level from which parcel was lifted [Pa]"},
+      /* 142 */ {"HLPL", "Height of level from which parcel was lifted [Pa]"},
+      /* 143 */ {"CEMS", "Cloud emissivity [fraction]"},
+      /* 144 */ {"COPD", "Cloud optical depth [non-dim]"},
+      /* 145 */ {"PSIZ", "Effective particle size [microns]"},
+      /* 146 */ {"TCWAT", "Total water cloud [%]"},
+      /* 147 */ {"TCICE", "Total ice cloud [%]"},
+      /* 148 */ {"var148", "undefined"},
+      /* 149 */ {"var149", "undefined"},
+      /* 150 */ {"PTAN", "Probabilty of Temp. above normal [%]"},
+      /* 151 */ {"PTNN", "Probabilty of Temp. near normal [%]"},
+      /* 152 */ {"PTbN", "Probabilty of Temp. below normal [%]"},
+      /* 153 */ {"PPAN", "Probabilty of Precip. above normal [%]"},
+      /* 154 */ {"PPNN", "Probabilty of Precip. near normal [%]"},
+      /* 155 */ {"PPbN", "Probabilty of Precip. below normal [%]"},
+      /* 156 */ {"var156", "undefined"},
+      /* 157 */ {"var157", "undefined"},
+      /* 158 */ {"var158", "undefined"},
+      /* 159 */ {"var159", "undefined"},
+      /* 160 */ {"var160", "undefined"},
+      /* 161 */ {"var161", "undefined"},
+      /* 162 */ {"var162", "undefined"},
+      /* 163 */ {"var163", "undefined"},
+      /* 164 */ {"var164", "undefined"},
+      /* 165 */ {"var165", "undefined"},
+      /* 166 */ {"var166", "undefined"},
+      /* 167 */ {"var167", "undefined"},
+      /* 168 */ {"var168", "undefined"},
+      /* 169 */ {"var169", "undefined"},
+      /* 170 */ {"ELRDI", "Ellrod Index [non-dim]"},
+      /* 171 */ {"TSEC", "Seconds prior to initial reference time ?? [sec]"},
+      /* 172 */ {"var172", "undefined"},
+      /* 173 */ {"var173", "undefined"},
+      /* 174 */ {"var174", "undefined"},
+      /* 175 */ {"var175", "undefined"},
+      /* 176 */ {"var176", "undefined"},
+      /* 177 */ {"var177", "undefined"},
+      /* 178 */ {"var178", "undefined"},
+      /* 179 */ {"var179", "undefined"},
+      /* 180 */ {"OZCON", "Ozone concentration [ppb]"},
+      /* 181 */ {"OZCAT", "Categorical ozone concentration [?]"},
+      /* 182 */ {"KH", "vertical heat eddy diffusivity [m^2/s]"},
+      /* 183 */ {"SIGV", "Sigma level value ?? [non-dim]"},
+      /* 184 */ {"var184", "undefined"},
+      /* 185 */ {"var185", "undefined"},
+      /* 186 */ {"var186", "undefined"},
+      /* 187 */ {"var187", "undefined"},
+      /* 188 */ {"var188", "undefined"},
+      /* 189 */ {"var189", "undefined"},
+      /* 190 */ {"USCT", "Scatterometer est. U wind component [m/s]"},
+      /* 191 */ {"VSCT", "Scatterometer est. V wind component [m/s]"},
+      /* 192 */ {"var192", "undefined"},
+      /* 193 */ {"var193", "undefined"},
+      /* 194 */ {"var194", "undefined"},
+      /* 195 */ {"var195", "undefined"},
+      /* 196 */ {"var196", "undefined"},
+      /* 197 */ {"var197", "undefined"},
+      /* 198 */ {"var198", "undefined"},
+      /* 199 */ {"var199", "undefined"},
+      /* 200 */ {"DUVB", "UV-B Downward Solar Flux [W/m^2]"},
+      /* 201 */ {"CDUVB", "Clear Sky UV-B Downward Solar Flux [W/m^2]"},
+      /* 202 */ {"THFLX", "Total downward heat flux at surface [W/m^2]"},
+      /* 203 */ {"var203", "undefined"},
+      /* 204 */ {"var204", "undefined"},
+      /* 205 */ {"var205", "undefined"},
+      /* 206 */ {"var206", "undefined"},
+      /* 207 */ {"var207", "undefined"},
+      /* 208 */ {"var208", "undefined"},
+      /* 209 */ {"var209", "undefined"},
+      /* 210 */ {"var210", "undefined"},
+      /* 211 */ {"var211", "undefined"},
+      /* 212 */ {"var212", "undefined"},
+      /* 213 */ {"var213", "undefined"},
+      /* 214 */ {"var214", "undefined"},
+      /* 215 */ {"var215", "undefined"},
+      /* 216 */ {"var216", "undefined"},
+      /* 217 */ {"var217", "undefined"},
+      /* 218 */ {"var218", "undefined"},
+      /* 219 */ {"var219", "undefined"},
+      /* 220 */ {"var220", "undefined"},
+      /* 221 */ {"var221", "undefined"},
+      /* 222 */ {"var222", "undefined"},
+      /* 223 */ {"var223", "undefined"},
+      /* 224 */ {"var224", "undefined"},
+      /* 225 */ {"var225", "undefined"},
+      /* 226 */ {"var226", "undefined"},
+      /* 227 */ {"var227", "undefined"},
+      /* 228 */ {"var228", "undefined"},
+      /* 229 */ {"var229", "undefined"},
+      /* 230 */ {"var230", "undefined"},
+      /* 231 */ {"var231", "undefined"},
+      /* 232 */ {"var232", "undefined"},
+      /* 233 */ {"var233", "undefined"},
+      /* 234 */ {"var234", "undefined"},
+      /* 235 */ {"var235", "undefined"},
+      /* 236 */ {"var236", "undefined"},
+      /* 237 */ {"var237", "undefined"},
+      /* 238 */ {"var238", "undefined"},
+      /* 239 */ {"var239", "undefined"},
+      /* 240 */ {"var240", "undefined"},
+      /* 241 */ {"var241", "undefined"},
+      /* 242 */ {"var242", "undefined"},
+      /* 243 */ {"var243", "undefined"},
+      /* 244 */ {"var244", "undefined"},
+      /* 245 */ {"var245", "undefined"},
+      /* 246 */ {"var246", "undefined"},
+      /* 247 */ {"var247", "undefined"},
+      /* 248 */ {"var248", "undefined"},
+      /* 249 */ {"var249", "undefined"},
+      /* 250 */ {"var250", "undefined"},
+      /* 251 */ {"var251", "undefined"},
+      /* 252 */ {"var252", "undefined"},
+      /* 253 */ {"var253", "undefined"},
+      /* 254 */ {"var254", "undefined"},
+      /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptab_130.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptab_130.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptab_130.c	(revision 2744)
@@ -0,0 +1,260 @@
+#include "cnames.h"
+
+struct ParmTable parm_table_nceptab_130[256] = {
+      /* 0 */ {"var0", "undefined"},
+      /* 1 */ {"PRES", "Pressure [Pa]"},
+      /* 2 */ {"PRMSL", "Pressure reduced to MSL [Pa]"},
+      /* 3 */ {"PTEND", "Pressure tendency [Pa/s]"},
+      /* 4 */ {"PVORT", "Pot. vorticity [km^2/kg/s]"},
+      /* 5 */ {"ICAHT", "ICAO Standard Atmosphere Reference Height [M]"},
+      /* 6 */ {"GP", "Geopotential [m^2/s^2]"},
+      /* 7 */ {"HGT", "Geopotential height [gpm]"},
+      /* 8 */ {"DIST", "Geometric height [m]"},
+      /* 9 */ {"HSTDV", "Std dev of height [m]"},
+      /* 10 */ {"TOZNE", "Total ozone [Dobson]"},
+      /* 11 */ {"TMP", "Temp. [K]"},
+      /* 12 */ {"VTMP", "Virtual temp. [K]"},
+      /* 13 */ {"POT", "Potential temp. [K]"},
+      /* 14 */ {"EPOT", "Pseudo-adiabatic pot. temp. [K]"},
+      /* 15 */ {"TMAX", "Max. temp. [K]"},
+      /* 16 */ {"TMIN", "Min. temp. [K]"},
+      /* 17 */ {"DPT", "Dew point temp. [K]"},
+      /* 18 */ {"DEPR", "Dew point depression [K]"},
+      /* 19 */ {"LAPR", "Lapse rate [K/m]"},
+      /* 20 */ {"VIS", "Visibility [m]"},
+      /* 21 */ {"RDSP1", "Radar spectra (1) [non-dim]"},
+      /* 22 */ {"RDSP2", "Radar spectra (2) [non-dim]"},
+      /* 23 */ {"RDSP3", "Radar spectra (3) [non-dim]"},
+      /* 24 */ {"PLI", "Parcel lifted index (to 500 hPa) [K]"},
+      /* 25 */ {"TMPA", "Temp. anomaly [K]"},
+      /* 26 */ {"PRESA", "Pressure anomaly [Pa]"},
+      /* 27 */ {"GPA", "Geopotential height anomaly [gpm]"},
+      /* 28 */ {"WVSP1", "Wave spectra (1) [non-dim]"},
+      /* 29 */ {"WVSP2", "Wave spectra (2) [non-dim]"},
+      /* 30 */ {"WVSP3", "Wave spectra (3) [non-dim]"},
+      /* 31 */ {"WDIR", "Wind direction [deg]"},
+      /* 32 */ {"WIND", "Wind speed [m/s]"},
+      /* 33 */ {"UGRD", "u wind [m/s]"},
+      /* 34 */ {"VGRD", "v wind [m/s]"},
+      /* 35 */ {"STRM", "Stream function [m^2/s]"},
+      /* 36 */ {"VPOT", "Velocity potential [m^2/s]"},
+      /* 37 */ {"MNTSF", "Montgomery stream function [m^2/s^2]"},
+      /* 38 */ {"SGCVV", "Sigma coord. vertical velocity [/s]"},
+      /* 39 */ {"VVEL", "Pressure vertical velocity [Pa/s]"},
+      /* 40 */ {"DZDT", "Geometric vertical velocity [m/s]"},
+      /* 41 */ {"ABSV", "Absolute vorticity [/s]"},
+      /* 42 */ {"ABSD", "Absolute divergence [/s]"},
+      /* 43 */ {"RELV", "Relative vorticity [/s]"},
+      /* 44 */ {"RELD", "Relative divergence [/s]"},
+      /* 45 */ {"VUCSH", "Vertical u shear [/s]"},
+      /* 46 */ {"VVCSH", "Vertical v shear [/s]"},
+      /* 47 */ {"DIRC", "Direction of current [deg]"},
+      /* 48 */ {"SPC", "Speed of current [m/s]"},
+      /* 49 */ {"UOGRD", "u of current [m/s]"},
+      /* 50 */ {"VOGRD", "v of current [m/s]"},
+      /* 51 */ {"SPFH", "Specific humidity [kg/kg]"},
+      /* 52 */ {"RH", "Relative humidity [%]"},
+      /* 53 */ {"MIXR", "Humidity mixing ratio [kg/kg]"},
+      /* 54 */ {"PWAT", "Precipitable water [kg/m^2]"},
+      /* 55 */ {"VAPP", "Vapor pressure [Pa]"},
+      /* 56 */ {"SATD", "Saturation deficit [Pa]"},
+      /* 57 */ {"EVP", "Evaporation [kg/m^2]"},
+      /* 58 */ {"CICE", "Cloud Ice [kg/m^2]"},
+      /* 59 */ {"PRATE", "Precipitation rate [kg/m^2/s]"},
+      /* 60 */ {"TSTM", "Thunderstorm probability [%]"},
+      /* 61 */ {"APCP", "Total precipitation [kg/m^2]"},
+      /* 62 */ {"NCPCP", "Large scale precipitation [kg/m^2]"},
+      /* 63 */ {"ACPCP", "Convective precipitation [kg/m^2]"},
+      /* 64 */ {"SRWEQ", "Snowfall rate water equiv. [kg/m^2/s]"},
+      /* 65 */ {"WEASD", "Accum. snow [kg/m^2]"},
+      /* 66 */ {"SNOD", "Snow depth [m]"},
+      /* 67 */ {"MIXHT", "Mixed layer depth [m]"},
+      /* 68 */ {"TTHDP", "Transient thermocline depth [m]"},
+      /* 69 */ {"MTHD", "Main thermocline depth [m]"},
+      /* 70 */ {"MTHA", "Main thermocline anomaly [m]"},
+      /* 71 */ {"TCDC", "Total cloud cover [%]"},
+      /* 72 */ {"CDCON", "Convective cloud cover [%]"},
+      /* 73 */ {"LCDC", "Low level cloud cover [%]"},
+      /* 74 */ {"MCDC", "Mid level cloud cover [%]"},
+      /* 75 */ {"HCDC", "High level cloud cover [%]"},
+      /* 76 */ {"CWAT", "Cloud water [kg/m^2]"},
+      /* 77 */ {"BLI", "Best lifted index (to 500 hPa) [K]"},
+      /* 78 */ {"SNOC", "Convective snow [kg/m^2]"},
+      /* 79 */ {"SNOL", "Large scale snow [kg/m^2]"},
+      /* 80 */ {"WTMP", "Water temp. [K]"},
+      /* 81 */ {"LAND", "Land cover (land=1;sea=0) [fraction]"},
+      /* 82 */ {"DSLM", "Deviation of sea level from mean [m]"},
+      /* 83 */ {"SFCR", "Surface roughness [m]"},
+      /* 84 */ {"ALBDO", "Albedo [%]"},
+      /* 85 */ {"TSOIL", "Soil temp. [K]"},
+      /* 86 */ {"SOILM", "Soil moisture content [kg/m^2]"},
+      /* 87 */ {"VEG", "Vegetation [%]"},
+      /* 88 */ {"SALTY", "Salinity [kg/kg]"},
+      /* 89 */ {"DEN", "Density [kg/m^3]"},
+      /* 90 */ {"WATR", "Water runoff [kg/m^2]"},
+      /* 91 */ {"ICEC", "Ice concentration (ice=1;no ice=0) [fraction]"},
+      /* 92 */ {"ICETK", "Ice thickness [m]"},
+      /* 93 */ {"DICED", "Direction of ice drift [deg]"},
+      /* 94 */ {"SICED", "Speed of ice drift [m/s]"},
+      /* 95 */ {"UICE", "u of ice drift [m/s]"},
+      /* 96 */ {"VICE", "v of ice drift [m/s]"},
+      /* 97 */ {"ICEG", "Ice growth rate [m/s]"},
+      /* 98 */ {"ICED", "Ice divergence [/s]"},
+      /* 99 */ {"SNOM", "Snow melt [kg/m^2]"},
+      /* 100 */ {"HTSGW", "Sig height of wind waves and swell [m]"},
+      /* 101 */ {"WVDIR", "Direction of wind waves [deg]"},
+      /* 102 */ {"WVHGT", "Sig height of wind waves [m]"},
+      /* 103 */ {"WVPER", "Mean period of wind waves [s]"},
+      /* 104 */ {"SWDIR", "Direction of swell waves [deg]"},
+      /* 105 */ {"SWELL", "Sig height of swell waves [m]"},
+      /* 106 */ {"SWPER", "Mean period of swell waves [s]"},
+      /* 107 */ {"DIRPW", "Primary wave direction [deg]"},
+      /* 108 */ {"PERPW", "Primary wave mean period [s]"},
+      /* 109 */ {"DIRSW", "Secondary wave direction [deg]"},
+      /* 110 */ {"PERSW", "Secondary wave mean period [s]"},
+      /* 111 */ {"NSWRS", "Net short wave (surface) [W/m^2]"},
+      /* 112 */ {"NLWRS", "Net long wave (surface) [W/m^2]"},
+      /* 113 */ {"NSWRT", "Net short wave (top) [W/m^2]"},
+      /* 114 */ {"NLWRT", "Net long wave (top) [W/m^2]"},
+      /* 115 */ {"LWAVR", "Long wave [W/m^2]"},
+      /* 116 */ {"SWAVR", "Short wave [W/m^2]"},
+      /* 117 */ {"GRAD", "Global radiation [W/m^2]"},
+      /* 118 */ {"BRTMP", "Brightness temperature [K]"},
+      /* 119 */ {"LWRAD", "Radiance with respect to wave no. [W/m/sr]"},
+      /* 120 */ {"SWRAD", "Radiance with respect ot wave len. [W/m^3/sr]"},
+      /* 121 */ {"LHTFL", "Latent heat flux [W/m^2]"},
+      /* 122 */ {"SHTFL", "Sensible heat flux [W/m^2]"},
+      /* 123 */ {"BLYDP", "Boundary layer dissipation [W/m^2]"},
+      /* 124 */ {"UFLX", "Zonal momentum flux [N/m^2]"},
+      /* 125 */ {"VFLX", "Meridional momentum flux [N/m^2]"},
+      /* 126 */ {"WMIXE", "Wind mixing energy [J]"},
+      /* 127 */ {"IMGD", "Image data []"},
+      /* 128 */ {"var128", "undefined"},
+      /* 129 */ {"var129", "undefined"},
+      /* 130 */ {"var130", "undefined"},
+      /* 131 */ {"var131", "undefined"},
+      /* 132 */ {"var132", "undefined"},
+      /* 133 */ {"var133", "undefined"},
+      /* 134 */ {"var134", "undefined"},
+      /* 135 */ {"var135", "undefined"},
+      /* 136 */ {"var136", "undefined"},
+      /* 137 */ {"var137", "undefined"},
+      /* 138 */ {"var138", "undefined"},
+      /* 139 */ {"var139", "undefined"},
+      /* 140 */ {"var140", "undefined"},
+      /* 141 */ {"var141", "undefined"},
+      /* 142 */ {"var142", "undefined"},
+      /* 143 */ {"var143", "undefined 143"},
+      /* 144 */ {"SOILW", "Volumetric soil moisture (frozen + liquid) [fraction]"},
+      /* 145 */ {"PEVPR", "Potential evaporation rate [W/m^2]"},
+      /* 146 */ {"VEGT", "Vegetation canopy temperature [K]"},
+      /* 147 */ {"BARET", "Bare soil surface skin temperature [K]"},
+      /* 148 */ {"AVSFT", "Average surface skin temperature [K]"},
+      /* 149 */ {"RADT", "Effective radiative skin temperature [K]"},
+      /* 150 */ {"SSTOR", "Surface water storage [Kg/m^2]"},
+      /* 151 */ {"LSOIL", "Liquid soil moisture content (non-frozen) [Kg/m^2]"},
+      /* 152 */ {"EWATR", "Open water evaporation (standing water) [W/m^2]"},
+      /* 153 */ {"var153", "undefined"},
+      /* 154 */ {"var154", "undefined"},
+      /* 155 */ {"GFLUX", "Ground Heat Flux [W/m^2]"},
+      /* 156 */ {"CIN", "Convective inhibition [J/Kg]"},
+      /* 157 */ {"CAPE", "Convective available potential energy [J/Kg]"},
+      /* 158 */ {"TKE", "Turbulent Kinetic Energy [J/Kg]"},
+      /* 159 */ {"MXSALB", "Maximum snow albedo [%]"},
+      /* 160 */ {"SOILL", "Liquid volumetric soil moisture (non-frozen) [fraction]"},
+      /* 161 */ {"ASNOW", "Frozen precipitation (e.g. snowfall) [Kg/m^2]"},
+      /* 162 */ {"ARAIN", "Liquid precipitation (rainfall) [Kg/m^2]"},
+      /* 163 */ {"GWREC", "Groundwater recharge [Kg/m^2]"},
+      /* 164 */ {"QREC", "Flood plain recharge [Kg/m^2]"},
+      /* 165 */ {"SNOWT", "Snow temperature, depth-avg [K]"},
+      /* 166 */ {"VBDSF", "Visible beam downward solar flux [W/m^2]"},
+      /* 167 */ {"VDDSF", "Visible diffuse downward solar flux [W/m^2]"},
+      /* 168 */ {"NBDSF", "Near IR beam downward solar flux [W/m^2]"},
+      /* 169 */ {"NDDSF", "Near IR diffuse downward solar flux [W/m^2]"},
+      /* 170 */ {"SNFALB", "Snow-free albedo [%]"},
+      /* 171 */ {"RLYRS", "Number of soil layers in root zone [non-dim]"},
+      /* 172 */ {"MFLX", "Momentum flux [N/m^2]"},
+      /* 173 */ {"var173", "undefined"},
+      /* 174 */ {"var174", "undefined"},
+      /* 175 */ {"var175", "undefined"},
+      /* 176 */ {"NLAT", "Latitude (-90 to +90) [deg]"},
+      /* 177 */ {"ELON", "East longitude (0-360) [deg]"},
+      /* 178 */ {"var178", "undefined"},
+      /* 179 */ {"ACOND", "Aerodynamic conductance [m/s]"},
+      /* 180 */ {"SNOAG", "Snow age [s]"},
+      /* 181 */ {"CCOND", "Canopy conductance [m/s]"},
+      /* 182 */ {"LAI", "Leaf area index (0-9) [non-dim]"},
+      /* 183 */ {"SFCRH", "Roughness length for heat [m]"},
+      /* 184 */ {"SALBD", "Snow albedo (over snow cover area only) [%]"},
+      /* 185 */ {"var185", "undefined"},
+      /* 186 */ {"var186", "undefined"},
+      /* 187 */ {"NDVI", "Normalized Difference Vegetation Index []"},
+      /* 188 */ {"DRIP", "Canopy drip [Kg/m^2]"},
+      /* 189 */ {"var189", "undefined"},
+      /* 190 */ {"var190", "undefined"},
+      /* 191 */ {"var191", "undefined"},
+      /* 192 */ {"var192", "undefined"},
+      /* 193 */ {"var193", "undefined"},
+      /* 194 */ {"var194", "undefined"},
+      /* 195 */ {"var195", "undefined"},
+      /* 196 */ {"var196", "undefined"},
+      /* 197 */ {"var197", "undefined"},
+      /* 198 */ {"SBSNO", "Sublimation (evaporation from snow) [W/m^2]"},
+      /* 199 */ {"EVBS", "Direct evaporation from bare soil [W/m^2]"},
+      /* 200 */ {"EVCW", "Canopy water evaporation [W/m^2]"},
+      /* 201 */ {"var201", "undefined"},
+      /* 202 */ {"var202", "undefined"},
+      /* 203 */ {"RSMIN", "Minimal stomatal resistance [s/m]"},
+      /* 204 */ {"DSWRF", "Downward shortwave radiation flux [W/m^2]"},
+      /* 205 */ {"DLWRF", "Downward longwave radiation flux [W/m^2]"},
+      /* 206 */ {"var206", "undefined"},
+      /* 207 */ {"MSTAV", "Moisture availability [%]"},
+      /* 208 */ {"SFEXC", "Exchange coefficient [(Kg/m^3)(m/s)]"},
+      /* 209 */ {"var209", "undefined"},
+      /* 210 */ {"TRANS", "Transpiration [W/m^2]"},
+      /* 211 */ {"USWRF", "Upward short wave radiation flux [W/m^2]"},
+      /* 212 */ {"ULWRF", "Upward long wave radiation flux [W/m^2]"},
+      /* 213 */ {"var213", "undefined"},
+      /* 214 */ {"var214", "undefined"},
+      /* 215 */ {"var215", "undefined"},
+      /* 216 */ {"var216", "undefined"},
+      /* 217 */ {"var217", "undefined"},
+      /* 218 */ {"var218", "undefined"},
+      /* 219 */ {"WILT", "Wilting point [fraction]"},
+      /* 220 */ {"FLDCP", "Field Capacity [fraction]"},
+      /* 221 */ {"HPBL", "Planetary boundary layer height [m]"},
+      /* 222 */ {"SLTYP", "Surface slope type [Index]"},
+      /* 223 */ {"CNWAT", "Plant canopy surface water [Kg/m^2]"},
+      /* 224 */ {"SOTYP", "Soil type [Index]"},
+      /* 225 */ {"VGTYP", "Vegetation type [Index]"},
+      /* 226 */ {"BMIXL", "Blackadars mixing length scale [m]"},
+      /* 227 */ {"AMIXL", "Asymptotic mixing length scale [m]"},
+      /* 228 */ {"PEVAP", "Potential evaporation [Kg/m^2]"},
+      /* 229 */ {"SNOHF", "Snow phase-change heat flux [W/m^2]"},
+      /* 230 */ {"SMREF", "Transpiration stress-onset (soil moisture) [fraction]"},
+      /* 231 */ {"SMDRY", "Direct evaporation cease (soil moisture) [fraction]"},
+      /* 232 */ {"var232", "undefined"},
+      /* 233 */ {"var233", "undefined"},
+      /* 234 */ {"BGRUN", "Subsurface runoff (baseflow) [Kg/m^2]"},
+      /* 235 */ {"SSRUN", "Surface runoff (non-infiltrating) [Kg/m^2]"},
+      /* 236 */ {"var236", "undefined"},
+      /* 237 */ {"var237", "undefined"},
+      /* 238 */ {"SNOWC", "Snow cover [%]"},
+      /* 239 */ {"SNOT", "Snow temperature [K]"},
+      /* 240 */ {"POROS", "Soil porosity [fraction]"},
+      /* 241 */ {"var241", "undefined"},
+      /* 242 */ {"var242", "undefined"},
+      /* 243 */ {"var243", "undefined"},
+      /* 244 */ {"var244", "undefined"},
+      /* 245 */ {"var245", "undefined"},
+      /* 246 */ {"RCS", "Solar parameter in canopy conductance [fraction]"},
+      /* 247 */ {"RCT", "Temperature parameter in canopy conductance [fraction]"},
+      /* 248 */ {"RCQ", "Humidity parameter in canopy conductance [fraction]"},
+      /* 249 */ {"RCSOL", "Soil moisture parameter in canopy conductance [fraction]"},
+      /* 250 */ {"var250", "undefined"},
+      /* 251 */ {"var251", "undefined"},
+      /* 252 */ {"CD", "Surface drag coefficient [non-dim]"},
+      /* 253 */ {"FRICV", "Surface friction velocity [m/s]"},
+      /* 254 */ {"RI", "Richardson number [non-dim]"},
+      /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptab_131.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptab_131.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptab_131.c	(revision 2744)
@@ -0,0 +1,260 @@
+#include "cnames.h"
+
+struct ParmTable parm_table_nceptab_131[256] = {
+      /* 0 */ {"var0", "undefined"},
+      /* 1 */ {"PRES", "Pressure [Pa]"},
+      /* 2 */ {"PRMSL", "Pressure reduced to MSL [Pa]"},
+      /* 3 */ {"PTEND", "Pressure tendency [Pa/s]"},
+      /* 4 */ {"PVORT", "Pot. vorticity [km^2/kg/s]"},
+      /* 5 */ {"ICAHT", "ICAO Standard Atmosphere Reference Height [M]"},
+      /* 6 */ {"GP", "Geopotential [m^2/s^2]"},
+      /* 7 */ {"HGT", "Geopotential height [gpm]"},
+      /* 8 */ {"DIST", "Geometric height [m]"},
+      /* 9 */ {"HSTDV", "Std dev of height [m]"},
+      /* 10 */ {"TOZNE", "Total ozone [Dobson]"},
+      /* 11 */ {"TMP", "Temp. [K]"},
+      /* 12 */ {"VTMP", "Virtual temp. [K]"},
+      /* 13 */ {"POT", "Potential temp. [K]"},
+      /* 14 */ {"EPOT", "Pseudo-adiabatic pot. temp. [K]"},
+      /* 15 */ {"TMAX", "Max. temp. [K]"},
+      /* 16 */ {"TMIN", "Min. temp. [K]"},
+      /* 17 */ {"DPT", "Dew point temp. [K]"},
+      /* 18 */ {"DEPR", "Dew point depression [K]"},
+      /* 19 */ {"LAPR", "Lapse rate [K/m]"},
+      /* 20 */ {"VIS", "Visibility [m]"},
+      /* 21 */ {"RDSP1", "Radar spectra (1) [non-dim]"},
+      /* 22 */ {"RDSP2", "Radar spectra (2) [non-dim]"},
+      /* 23 */ {"RDSP3", "Radar spectra (3) [non-dim]"},
+      /* 24 */ {"PLI", "Parcel lifted index (to 500 hPa) [K]"},
+      /* 25 */ {"TMPA", "Temp. anomaly [K]"},
+      /* 26 */ {"PRESA", "Pressure anomaly [Pa]"},
+      /* 27 */ {"GPA", "Geopotential height anomaly [gpm]"},
+      /* 28 */ {"WVSP1", "Wave spectra (1) [non-dim]"},
+      /* 29 */ {"WVSP2", "Wave spectra (2) [non-dim]"},
+      /* 30 */ {"WVSP3", "Wave spectra (3) [non-dim]"},
+      /* 31 */ {"WDIR", "Wind direction [deg]"},
+      /* 32 */ {"WIND", "Wind speed [m/s]"},
+      /* 33 */ {"UGRD", "u wind [m/s]"},
+      /* 34 */ {"VGRD", "v wind [m/s]"},
+      /* 35 */ {"STRM", "Stream function [m^2/s]"},
+      /* 36 */ {"VPOT", "Velocity potential [m^2/s]"},
+      /* 37 */ {"MNTSF", "Montgomery stream function [m^2/s^2]"},
+      /* 38 */ {"SGCVV", "Sigma coord. vertical velocity [/s]"},
+      /* 39 */ {"VVEL", "Pressure vertical velocity [Pa/s]"},
+      /* 40 */ {"DZDT", "Geometric vertical velocity [m/s]"},
+      /* 41 */ {"ABSV", "Absolute vorticity [/s]"},
+      /* 42 */ {"ABSD", "Absolute divergence [/s]"},
+      /* 43 */ {"RELV", "Relative vorticity [/s]"},
+      /* 44 */ {"RELD", "Relative divergence [/s]"},
+      /* 45 */ {"VUCSH", "Vertical u shear [/s]"},
+      /* 46 */ {"VVCSH", "Vertical v shear [/s]"},
+      /* 47 */ {"DIRC", "Direction of current [deg]"},
+      /* 48 */ {"SPC", "Speed of current [m/s]"},
+      /* 49 */ {"UOGRD", "u of current [m/s]"},
+      /* 50 */ {"VOGRD", "v of current [m/s]"},
+      /* 51 */ {"SPFH", "Specific humidity [kg/kg]"},
+      /* 52 */ {"RH", "Relative humidity [%]"},
+      /* 53 */ {"MIXR", "Humidity mixing ratio [kg/kg]"},
+      /* 54 */ {"PWAT", "Precipitable water [kg/m^2]"},
+      /* 55 */ {"VAPP", "Vapor pressure [Pa]"},
+      /* 56 */ {"SATD", "Saturation deficit [Pa]"},
+      /* 57 */ {"EVP", "Evaporation [kg/m^2]"},
+      /* 58 */ {"CICE", "Cloud Ice [kg/m^2]"},
+      /* 59 */ {"PRATE", "Precipitation rate [kg/m^2/s]"},
+      /* 60 */ {"TSTM", "Thunderstorm probability [%]"},
+      /* 61 */ {"APCP", "Total precipitation [kg/m^2]"},
+      /* 62 */ {"NCPCP", "Large scale precipitation [kg/m^2]"},
+      /* 63 */ {"ACPCP", "Convective precipitation [kg/m^2]"},
+      /* 64 */ {"SRWEQ", "Snowfall rate water equiv. [kg/m^2/s]"},
+      /* 65 */ {"WEASD", "Accum. snow [kg/m^2]"},
+      /* 66 */ {"SNOD", "Snow depth [m]"},
+      /* 67 */ {"MIXHT", "Mixed layer depth [m]"},
+      /* 68 */ {"TTHDP", "Transient thermocline depth [m]"},
+      /* 69 */ {"MTHD", "Main thermocline depth [m]"},
+      /* 70 */ {"MTHA", "Main thermocline anomaly [m]"},
+      /* 71 */ {"TCDC", "Total cloud cover [%]"},
+      /* 72 */ {"CDCON", "Convective cloud cover [%]"},
+      /* 73 */ {"LCDC", "Low level cloud cover [%]"},
+      /* 74 */ {"MCDC", "Mid level cloud cover [%]"},
+      /* 75 */ {"HCDC", "High level cloud cover [%]"},
+      /* 76 */ {"CWAT", "Cloud water [kg/m^2]"},
+      /* 77 */ {"BLI", "Best lifted index (to 500 hPa) [K]"},
+      /* 78 */ {"SNOC", "Convective snow [kg/m^2]"},
+      /* 79 */ {"SNOL", "Large scale snow [kg/m^2]"},
+      /* 80 */ {"WTMP", "Water temp. [K]"},
+      /* 81 */ {"LAND", "Land cover (land=1;sea=0) [fraction]"},
+      /* 82 */ {"DSLM", "Deviation of sea level from mean [m]"},
+      /* 83 */ {"SFCR", "Surface roughness [m]"},
+      /* 84 */ {"ALBDO", "Albedo [%]"},
+      /* 85 */ {"TSOIL", "Soil temp. [K]"},
+      /* 86 */ {"SOILM", "Soil moisture content [kg/m^2]"},
+      /* 87 */ {"VEG", "Vegetation [%]"},
+      /* 88 */ {"SALTY", "Salinity [kg/kg]"},
+      /* 89 */ {"DEN", "Density [kg/m^3]"},
+      /* 90 */ {"WATR", "Water runoff [kg/m^2]"},
+      /* 91 */ {"ICEC", "Ice concentration (ice=1;no ice=0) [fraction]"},
+      /* 92 */ {"ICETK", "Ice thickness [m]"},
+      /* 93 */ {"DICED", "Direction of ice drift [deg]"},
+      /* 94 */ {"SICED", "Speed of ice drift [m/s]"},
+      /* 95 */ {"UICE", "u of ice drift [m/s]"},
+      /* 96 */ {"VICE", "v of ice drift [m/s]"},
+      /* 97 */ {"ICEG", "Ice growth rate [m/s]"},
+      /* 98 */ {"ICED", "Ice divergence [/s]"},
+      /* 99 */ {"SNOM", "Snow melt [kg/m^2]"},
+      /* 100 */ {"HTSGW", "Sig height of wind waves and swell [m]"},
+      /* 101 */ {"WVDIR", "Direction of wind waves [deg]"},
+      /* 102 */ {"WVHGT", "Sig height of wind waves [m]"},
+      /* 103 */ {"WVPER", "Mean period of wind waves [s]"},
+      /* 104 */ {"SWDIR", "Direction of swell waves [deg]"},
+      /* 105 */ {"SWELL", "Sig height of swell waves [m]"},
+      /* 106 */ {"SWPER", "Mean period of swell waves [s]"},
+      /* 107 */ {"DIRPW", "Primary wave direction [deg]"},
+      /* 108 */ {"PERPW", "Primary wave mean period [s]"},
+      /* 109 */ {"DIRSW", "Secondary wave direction [deg]"},
+      /* 110 */ {"PERSW", "Secondary wave mean period [s]"},
+      /* 111 */ {"NSWRS", "Net short wave (surface) [W/m^2]"},
+      /* 112 */ {"NLWRS", "Net long wave (surface) [W/m^2]"},
+      /* 113 */ {"NSWRT", "Net short wave (top) [W/m^2]"},
+      /* 114 */ {"NLWRT", "Net long wave (top) [W/m^2]"},
+      /* 115 */ {"LWAVR", "Long wave [W/m^2]"},
+      /* 116 */ {"SWAVR", "Short wave [W/m^2]"},
+      /* 117 */ {"GRAD", "Global radiation [W/m^2]"},
+      /* 118 */ {"BRTMP", "Brightness temperature [K]"},
+      /* 119 */ {"LWRAD", "Radiance with respect to wave no. [W/m/sr]"},
+      /* 120 */ {"SWRAD", "Radiance with respect ot wave len. [W/m^3/sr]"},
+      /* 121 */ {"LHTFL", "Latent heat flux [W/m^2]"},
+      /* 122 */ {"SHTFL", "Sensible heat flux [W/m^2]"},
+      /* 123 */ {"BLYDP", "Boundary layer dissipation [W/m^2]"},
+      /* 124 */ {"UFLX", "Zonal momentum flux [N/m^2]"},
+      /* 125 */ {"VFLX", "Meridional momentum flux [N/m^2]"},
+      /* 126 */ {"WMIXE", "Wind mixing energy [J]"},
+      /* 127 */ {"IMGD", "Image data []"},
+      /* 128 */ {"MSLSA", "Mean sea level pressure (Std Atm) [Pa]"},
+      /* 129 */ {"var129", "undefined"},
+      /* 130 */ {"MSLET", "Mean sea level pressure (ETA model) [Pa]"},
+      /* 131 */ {"LFTX", "Surface lifted index [K]"},
+      /* 132 */ {"4LFTX", "Best (4-layer) lifted index [K]"},
+      /* 133 */ {"var133", "undefined"},
+      /* 134 */ {"PRESN", "Pressure (nearest grid point) [Pa]"},
+      /* 135 */ {"MCONV", "Horizontal moisture divergence [kg/kg/s]"},
+      /* 136 */ {"VWSH", "Vertical speed shear [1/s]"},
+      /* 137 */ {"var137", "undefined"},
+      /* 138 */ {"var138", "undefined"},
+      /* 139 */ {"PVMW", "Potential vorticity (mass-weighted) [1/s/m]"},
+      /* 140 */ {"CRAIN", "Categorical rain [yes=1;no=0]"},
+      /* 141 */ {"CFRZR", "Categorical freezing rain [yes=1;no=0]"},
+      /* 142 */ {"CICEP", "Categorical ice pellets [yes=1;no=0]"},
+      /* 143 */ {"CSNOW", "Categorical snow [yes=1;no=0]"},
+      /* 144 */ {"SOILW", "Volumetric soil moisture (frozen + liquid) [fraction]"},
+      /* 145 */ {"PEVPR", "Potential evaporation rate [W/m^2]"},
+      /* 146 */ {"VEGT", "Vegetation canopy temperature [K]"},
+      /* 147 */ {"BARET", "Bare soil surface skin temperature [K]"},
+      /* 148 */ {"AVSFT", "Average surface skin temperature [K]"},
+      /* 149 */ {"RADT", "Effective radiative skin temperature [K]"},
+      /* 150 */ {"SSTOR", "Surface water storage [kg/m^2]"},
+      /* 151 */ {"LSOIL", "Liquid soil moisture content (non-frozen) [kg/m^2]"},
+      /* 152 */ {"EWATR", "Open water evaporation (standing water) [W/m^2]"},
+      /* 153 */ {"CLWMR", "Cloud water [kg/kg]"},
+      /* 154 */ {"var154", "undefined"},
+      /* 155 */ {"GFLUX", "Ground Heat Flux [W/m^2]"},
+      /* 156 */ {"CIN", "Convective inhibition [J/kg]"},
+      /* 157 */ {"CAPE", "Convective available potential energy [J/kg]"},
+      /* 158 */ {"TKE", "Turbulent Kinetic Energy [J/kg]"},
+      /* 159 */ {"MXSALB", "Maximum snow albedo [%]"},
+      /* 160 */ {"SOILL", "Liquid volumetric soil moisture (non-frozen) [fraction]"},
+      /* 161 */ {"ASNOW", "Frozen precipitation (e.g. snowfall) [kg/m^2]"},
+      /* 162 */ {"ARAIN", "Liquid precipitation (rainfall) [kg/m^2]"},
+      /* 163 */ {"GWREC", "Groundwater recharge [kg/m^2]"},
+      /* 164 */ {"QREC", "Flood plain recharge [kg/m^2]"},
+      /* 165 */ {"SNOWT", "Snow temperature, depth-avg [K]"},
+      /* 166 */ {"VBDSF", "Visible beam downward solar flux [W/m^2]"},
+      /* 167 */ {"VDDSF", "Visible diffuse downward solar flux [W/m^2]"},
+      /* 168 */ {"NBDSF", "Near IR beam downward solar flux [W/m^2]"},
+      /* 169 */ {"NDDSF", "Near IR diffuse downward solar flux [W/m^2]"},
+      /* 170 */ {"SNFALB", "Snow-free albedo [%]"},
+      /* 171 */ {"RLYRS", "Number of soil layers in root zone [non-dim]"},
+      /* 172 */ {"FLX", "Momentum flux N/m2 [M]"},
+      /* 173 */ {"LMH", "Mass point model surface [non-dim]"},
+      /* 174 */ {"LMV", "Velocity point model surface [non-dim]"},
+      /* 175 */ {"MLYNO", "Model layer number (from bottom up) [non-dim]"},
+      /* 176 */ {"NLAT", "Latitude (-90 to +90) [deg]"},
+      /* 177 */ {"ELON", "East longitude (0-360) [deg]"},
+      /* 178 */ {"ICMR", "Ice mixing ratio [kg/kg]"},
+      /* 179 */ {"ACOND", "Aerodynamic conductance [m/s]"},
+      /* 180 */ {"SNOAG", "Snow age [s]"},
+      /* 181 */ {"CCOND", "Canopy conductance [m/s]"},
+      /* 182 */ {"LAI", "Leaf area index (0-9) [non-dim]"},
+      /* 183 */ {"SFCRH", "Roughness length for heat [m]"},
+      /* 184 */ {"SALBD", "Snow albedo (over snow cover area only) [%]"},
+      /* 185 */ {"var185", "undefined"},
+      /* 186 */ {"var186", "undefined"},
+      /* 187 */ {"NDVI", "Normalized Difference Vegetation Index []"},
+      /* 188 */ {"DRIP", "Rate of water dropping from canopy to gnd [kg/m^2]"},
+      /* 189 */ {"LANDN", "Land cover (nearest neighbor) [sea=0,land=1]"},
+      /* 190 */ {"HLCY", "Storm relative helicity [m^2/s^2]"},
+      /* 191 */ {"NLATN", "Latitude (nearest neigbhbor) (-90 to +90) [deg]"},
+      /* 192 */ {"ELONN", "East longitude (nearest neigbhbor) (0-360) [deg]"},
+      /* 193 */ {"var193", "undefined"},
+      /* 194 */ {"CPOFP", "Prob. of frozen precipitation [%]"},
+      /* 195 */ {"var195", "undefined"},
+      /* 196 */ {"USTM", "u-component of storm motion [m/s]"},
+      /* 197 */ {"VSTM", "v-component of storm motion [m/s]"},
+      /* 198 */ {"SBSNO", "Sublimation (evaporation from snow) [W/m^2]"},
+      /* 199 */ {"EVBS", "Direct evaporation from bare soil [W/m^2]"},
+      /* 200 */ {"EVCW", "Canopy water evaporation [W/m^2]"},
+      /* 201 */ {"var201", "undefined"},
+      /* 202 */ {"APCPN", "Total precipitation (nearest grid point) [kg/m^2]"},
+      /* 203 */ {"RSMIN", "Minimal stomatal resistance [s/m]"},
+      /* 204 */ {"DSWRF", "Downward shortwave radiation flux [W/m^2]"},
+      /* 205 */ {"DLWRF", "Downward longwave radiation flux [W/m^2]"},
+      /* 206 */ {"ACPCPN", "Convective precipitation (nearest grid point) [kg/m^2]"},
+      /* 207 */ {"MSTAV", "Moisture availability [%]"},
+      /* 208 */ {"SFEXC", "Exchange coefficient [(kg/m^3)(m/s)]"},
+      /* 209 */ {"var209", "undefined"},
+      /* 210 */ {"TRANS", "Transpiration [W/m^2]"},
+      /* 211 */ {"USWRF", "Upward short wave radiation flux [W/m^2]"},
+      /* 212 */ {"ULWRF", "Upward long wave radiation flux [W/m^2]"},
+      /* 213 */ {"CDLYR", "Non-convective cloud [%]"},
+      /* 214 */ {"CPRAT", "Convective precip. rate [kg/m^2/s]"},
+      /* 215 */ {"var215", "undefined"},
+      /* 216 */ {"TTRAD", "Temp. tendency by all radiation [K/s]"},
+      /* 217 */ {"var217", "undefined"},
+      /* 218 */ {"HGTN", "Geopotential Height (nearest grid point) [gpm]"},
+      /* 219 */ {"WILT", "Wilting point [fraction]"},
+      /* 220 */ {"FLDCP", "Field Capacity [fraction]"},
+      /* 221 */ {"HPBL", "Planetary boundary layer height [m]"},
+      /* 222 */ {"SLTYP", "Surface slope type [Index]"},
+      /* 223 */ {"CNWAT", "Plant canopy surface water [kg/m^2]"},
+      /* 224 */ {"SOTYP", "Soil type [Index]"},
+      /* 225 */ {"VGTYP", "Vegetation type [Index]"},
+      /* 226 */ {"BMIXL", "Blackadars mixing length scale [m]"},
+      /* 227 */ {"AMIXL", "Asymptotic mixing length scale [m]"},
+      /* 228 */ {"PEVAP", "Potential evaporation [kg/m^2]"},
+      /* 229 */ {"SNOHF", "Snow phase-change heat flux [W/m^2]"},
+      /* 230 */ {"SMREF", "Transpiration stress-onset (soil moisture) [fraction]"},
+      /* 231 */ {"SMDRY", "Direct evaporation cease (soil moisture) [fraction]"},
+      /* 232 */ {"WVINC", "water vapor added by precip assimilation [kg/m^2]"},
+      /* 233 */ {"WCINC", "water condensate added by precip assimilaition [kg/m^2]"},
+      /* 234 */ {"BGRUN", "Subsurface runoff (baseflow) [kg/m^2]"},
+      /* 235 */ {"SSRUN", "Surface runoff (non-infiltrating) [kg/m^2]"},
+      /* 236 */ {"var236", "undefined"},
+      /* 237 */ {"WVCONV", "Water vapor flux convergence (vertical int) [kg/m^2]"},
+      /* 238 */ {"SNOWC", "Snow cover [%]"},
+      /* 239 */ {"SNOT", "Snow temperature [K]"},
+      /* 240 */ {"POROS", "Soil porosity [fraction]"},
+      /* 241 */ {"WCCONV", "Water condensate flux convergence (vertical int) [kg/m^2]"},
+      /* 242 */ {"WVUFLX", "Water vapor zonal flux (vertical int)[kg/m]"},
+      /* 243 */ {"WVVFLX", "Water vapor meridional flux (vertical int) [kg/m]"},
+      /* 244 */ {"WCUFLX", "Water condensate zonal flux (vertical int) [kg/m]"},
+      /* 245 */ {"WCVFLX", "Water condensate meridional flux (vertical int) [kg/m]"},
+      /* 246 */ {"RCS", "Solar parameter in canopy conductance [fraction]"},
+      /* 247 */ {"RCT", "Temperature parameter in canopy conductance [fraction]"},
+      /* 248 */ {"RCQ", "Humidity parameter in canopy conductance [fraction]"},
+      /* 249 */ {"RCSOL", "Soil moisture parameter in canopy conductance [fraction]"},
+      /* 250 */ {"SWHR", "Solar radiative heating [K/s]"},
+      /* 251 */ {"LWHR", "Longwave radiative heating [K/s]"},
+      /* 252 */ {"CD", "Surface drag coefficient [non-dim]"},
+      /* 253 */ {"FRICV", "Surface friction velocity [m/s]"},
+      /* 254 */ {"RI", "Richardson number [non-dim]"},
+      /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptable_opn.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptable_opn.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptable_opn.c	(revision 2744)
@@ -0,0 +1,267 @@
+#include "cnames.h"
+
+/*
+ * parameter table for NCEP (operations)
+ * center = 7, subcenter != 2 parameter table = 1, 2, 3 etc
+ * note: see reanalysis parameter table for problems
+ * updated 3/2003
+ */
+
+struct ParmTable parm_table_ncep_opn[256] = {
+      /* 0 */ {"var0", "undefined"},
+      /* 1 */ {"PRES", "Pressure [Pa]"},
+      /* 2 */ {"PRMSL", "Pressure reduced to MSL [Pa]"},
+      /* 3 */ {"PTEND", "Pressure tendency [Pa/s]"},
+      /* 4 */ {"PVORT", "Pot. vorticity [km^2/kg/s]"},
+      /* 5 */ {"ICAHT", "ICAO Standard Atmosphere Reference Height [M]"},
+      /* 6 */ {"GP", "Geopotential [m^2/s^2]"},
+      /* 7 */ {"HGT", "Geopotential height [gpm]"},
+      /* 8 */ {"DIST", "Geometric height [m]"},
+      /* 9 */ {"HSTDV", "Std dev of height [m]"},
+      /* 10 */ {"TOZNE", "Total ozone [Dobson]"},
+      /* 11 */ {"TMP", "Temp. [K]"},
+      /* 12 */ {"VTMP", "Virtual temp. [K]"},
+      /* 13 */ {"POT", "Potential temp. [K]"},
+      /* 14 */ {"EPOT", "Pseudo-adiabatic pot. temp. [K]"},
+      /* 15 */ {"TMAX", "Max. temp. [K]"},
+      /* 16 */ {"TMIN", "Min. temp. [K]"},
+      /* 17 */ {"DPT", "Dew point temp. [K]"},
+      /* 18 */ {"DEPR", "Dew point depression [K]"},
+      /* 19 */ {"LAPR", "Lapse rate [K/m]"},
+      /* 20 */ {"VIS", "Visibility [m]"},
+      /* 21 */ {"RDSP1", "Radar spectra (1) [non-dim]"},
+      /* 22 */ {"RDSP2", "Radar spectra (2) [non-dim]"},
+      /* 23 */ {"RDSP3", "Radar spectra (3) [non-dim]"},
+      /* 24 */ {"PLI", "Parcel lifted index (to 500 hPa) [K]"},
+      /* 25 */ {"TMPA", "Temp. anomaly [K]"},
+      /* 26 */ {"PRESA", "Pressure anomaly [Pa]"},
+      /* 27 */ {"GPA", "Geopotential height anomaly [gpm]"},
+      /* 28 */ {"WVSP1", "Wave spectra (1) [non-dim]"},
+      /* 29 */ {"WVSP2", "Wave spectra (2) [non-dim]"},
+      /* 30 */ {"WVSP3", "Wave spectra (3) [non-dim]"},
+      /* 31 */ {"WDIR", "Wind direction [deg]"},
+      /* 32 */ {"WIND", "Wind speed [m/s]"},
+      /* 33 */ {"UGRD", "u wind [m/s]"},
+      /* 34 */ {"VGRD", "v wind [m/s]"},
+      /* 35 */ {"STRM", "Stream function [m^2/s]"},
+      /* 36 */ {"VPOT", "Velocity potential [m^2/s]"},
+      /* 37 */ {"MNTSF", "Montgomery stream function [m^2/s^2]"},
+      /* 38 */ {"SGCVV", "Sigma coord. vertical velocity [/s]"},
+      /* 39 */ {"VVEL", "Pressure vertical velocity [Pa/s]"},
+      /* 40 */ {"DZDT", "Geometric vertical velocity [m/s]"},
+      /* 41 */ {"ABSV", "Absolute vorticity [/s]"},
+      /* 42 */ {"ABSD", "Absolute divergence [/s]"},
+      /* 43 */ {"RELV", "Relative vorticity [/s]"},
+      /* 44 */ {"RELD", "Relative divergence [/s]"},
+      /* 45 */ {"VUCSH", "Vertical u shear [/s]"},
+      /* 46 */ {"VVCSH", "Vertical v shear [/s]"},
+      /* 47 */ {"DIRC", "Direction of current [deg]"},
+      /* 48 */ {"SPC", "Speed of current [m/s]"},
+      /* 49 */ {"UOGRD", "u of current [m/s]"},
+      /* 50 */ {"VOGRD", "v of current [m/s]"},
+      /* 51 */ {"SPFH", "Specific humidity [kg/kg]"},
+      /* 52 */ {"RH", "Relative humidity [%]"},
+      /* 53 */ {"MIXR", "Humidity mixing ratio [kg/kg]"},
+      /* 54 */ {"PWAT", "Precipitable water [kg/m^2]"},
+      /* 55 */ {"VAPP", "Vapor pressure [Pa]"},
+      /* 56 */ {"SATD", "Saturation deficit [Pa]"},
+      /* 57 */ {"EVP", "Evaporation [kg/m^2]"},
+      /* 58 */ {"CICE", "Cloud Ice [kg/m^2]"},
+      /* 59 */ {"PRATE", "Precipitation rate [kg/m^2/s]"},
+      /* 60 */ {"TSTM", "Thunderstorm probability [%]"},
+      /* 61 */ {"APCP", "Total precipitation [kg/m^2]"},
+      /* 62 */ {"NCPCP", "Large scale precipitation [kg/m^2]"},
+      /* 63 */ {"ACPCP", "Convective precipitation [kg/m^2]"},
+      /* 64 */ {"SRWEQ", "Snowfall rate water equiv. [kg/m^2/s]"},
+      /* 65 */ {"WEASD", "Accum. snow [kg/m^2]"},
+      /* 66 */ {"SNOD", "Snow depth [m]"},
+      /* 67 */ {"MIXHT", "Mixed layer depth [m]"},
+      /* 68 */ {"TTHDP", "Transient thermocline depth [m]"},
+      /* 69 */ {"MTHD", "Main thermocline depth [m]"},
+      /* 70 */ {"MTHA", "Main thermocline anomaly [m]"},
+      /* 71 */ {"TCDC", "Total cloud cover [%]"},
+      /* 72 */ {"CDCON", "Convective cloud cover [%]"},
+      /* 73 */ {"LCDC", "Low level cloud cover [%]"},
+      /* 74 */ {"MCDC", "Mid level cloud cover [%]"},
+      /* 75 */ {"HCDC", "High level cloud cover [%]"},
+      /* 76 */ {"CWAT", "Cloud water [kg/m^2]"},
+      /* 77 */ {"BLI", "Best lifted index (to 500 hPa) [K]"},
+      /* 78 */ {"SNOC", "Convective snow [kg/m^2]"},
+      /* 79 */ {"SNOL", "Large scale snow [kg/m^2]"},
+      /* 80 */ {"WTMP", "Water temp. [K]"},
+      /* 81 */ {"LAND", "Land cover (land=1;sea=0) [fraction]"},
+      /* 82 */ {"DSLM", "Deviation of sea level from mean [m]"},
+      /* 83 */ {"SFCR", "Surface roughness [m]"},
+      /* 84 */ {"ALBDO", "Albedo [%]"},
+      /* 85 */ {"TSOIL", "Soil temp. [K]"},
+      /* 86 */ {"SOILM", "Soil moisture content [kg/m^2]"},
+      /* 87 */ {"VEG", "Vegetation [%]"},
+      /* 88 */ {"SALTY", "Salinity [kg/kg]"},
+      /* 89 */ {"DEN", "Density [kg/m^3]"},
+      /* 90 */ {"WATR", "Water runoff [kg/m^2]"},
+      /* 91 */ {"ICEC", "Ice concentration (ice=1;no ice=0) [fraction]"},
+      /* 92 */ {"ICETK", "Ice thickness [m]"},
+      /* 93 */ {"DICED", "Direction of ice drift [deg]"},
+      /* 94 */ {"SICED", "Speed of ice drift [m/s]"},
+      /* 95 */ {"UICE", "u of ice drift [m/s]"},
+      /* 96 */ {"VICE", "v of ice drift [m/s]"},
+      /* 97 */ {"ICEG", "Ice growth rate [m/s]"},
+      /* 98 */ {"ICED", "Ice divergence [/s]"},
+      /* 99 */ {"SNOM", "Snow melt [kg/m^2]"},
+      /* 100 */ {"HTSGW", "Sig height of wind waves and swell [m]"},
+      /* 101 */ {"WVDIR", "Direction of wind waves [deg]"},
+      /* 102 */ {"WVHGT", "Sig height of wind waves [m]"},
+      /* 103 */ {"WVPER", "Mean period of wind waves [s]"},
+      /* 104 */ {"SWDIR", "Direction of swell waves [deg]"},
+      /* 105 */ {"SWELL", "Sig height of swell waves [m]"},
+      /* 106 */ {"SWPER", "Mean period of swell waves [s]"},
+      /* 107 */ {"DIRPW", "Primary wave direction [deg]"},
+      /* 108 */ {"PERPW", "Primary wave mean period [s]"},
+      /* 109 */ {"DIRSW", "Secondary wave direction [deg]"},
+      /* 110 */ {"PERSW", "Secondary wave mean period [s]"},
+      /* 111 */ {"NSWRS", "Net short wave (surface) [W/m^2]"},
+      /* 112 */ {"NLWRS", "Net long wave (surface) [W/m^2]"},
+      /* 113 */ {"NSWRT", "Net short wave (top) [W/m^2]"},
+      /* 114 */ {"NLWRT", "Net long wave (top) [W/m^2]"},
+      /* 115 */ {"LWAVR", "Long wave [W/m^2]"},
+      /* 116 */ {"SWAVR", "Short wave [W/m^2]"},
+      /* 117 */ {"GRAD", "Global radiation [W/m^2]"},
+      /* 118 */ {"BRTMP", "Brightness temperature [K]"},
+      /* 119 */ {"LWRAD", "Radiance with respect to wave no. [W/m/sr]"},
+      /* 120 */ {"SWRAD", "Radiance with respect ot wave len. [W/m^3/sr]"},
+      /* 121 */ {"LHTFL", "Latent heat flux [W/m^2]"},
+      /* 122 */ {"SHTFL", "Sensible heat flux [W/m^2]"},
+      /* 123 */ {"BLYDP", "Boundary layer dissipation [W/m^2]"},
+      /* 124 */ {"UFLX", "Zonal momentum flux [N/m^2]"},
+      /* 125 */ {"VFLX", "Meridional momentum flux [N/m^2]"},
+      /* 126 */ {"WMIXE", "Wind mixing energy [J]"},
+      /* 127 */ {"IMGD", "Image data []"},
+      /* 128 */ {"MSLSA", "Mean sea level pressure (Std Atm) [Pa]"},
+      /* 129 */ {"MSLMA", "Mean sea level pressure (MAPS) [Pa]"},
+      /* 130 */ {"MSLET", "Mean sea level pressure (ETA model) [Pa]"},
+      /* 131 */ {"LFTX", "Surface lifted index [K]"},
+      /* 132 */ {"4LFTX", "Best (4-layer) lifted index [K]"},
+      /* 133 */ {"KX", "K index [K]"},
+      /* 134 */ {"SX", "Sweat index [K]"},
+      /* 135 */ {"MCONV", "Horizontal moisture divergence [kg/kg/s]"},
+      /* 136 */ {"VWSH", "Vertical speed shear [1/s]"},
+      /* 137 */ {"TSLSA", "3-hr pressure tendency (Std Atmos Red) [Pa/s]"},
+      /* 138 */ {"BVF2", "Brunt-Vaisala frequency^2 [1/s^2]"},
+      /* 139 */ {"PVMW", "Potential vorticity (mass-weighted) [1/s/m]"},
+      /* 140 */ {"CRAIN", "Categorical rain [yes=1;no=0]"},
+      /* 141 */ {"CFRZR", "Categorical freezing rain [yes=1;no=0]"},
+      /* 142 */ {"CICEP", "Categorical ice pellets [yes=1;no=0]"},
+      /* 143 */ {"CSNOW", "Categorical snow [yes=1;no=0]"},
+      /* 144 */ {"SOILW", "Volumetric soil moisture [fraction]"},
+      /* 145 */ {"PEVPR", "Potential evaporation rate [W/m^2]"},
+      /* 146 */ {"CWORK", "Cloud work function [J/kg]"},
+      /* 147 */ {"U-GWD", "Zonal gravity wave stress [N/m^2]"},
+      /* 148 */ {"V-GWD", "Meridional gravity wave stress [N/m^2]"},
+      /* 149 */ {"PV", "Potential vorticity [m^2/s/kg]"},
+      /* 150 */ {"COVMZ", "Covariance between u and v [m^2/s^2]"},
+      /* 151 */ {"COVTZ", "Covariance between u and T [K*m/s]"},
+      /* 152 */ {"COVTM", "Covariance between v and T [K*m/s]"},
+      /* 153 */ {"CLWMR", "Cloud water [kg/kg]"},
+      /* 154 */ {"O3MR", "Ozone mixing ratio [kg/kg]"},
+      /* 155 */ {"GFLUX", "Ground heat flux [W/m^2]"},
+      /* 156 */ {"CIN", "Convective inhibition [J/kg]"},
+      /* 157 */ {"CAPE", "Convective Avail. Pot. Energy [J/kg]"},
+      /* 158 */ {"TKE", "Turbulent kinetic energy [J/kg]"},
+      /* 159 */ {"CONDP", "Lifted parcel condensation pressure [Pa]"},
+      /* 160 */ {"CSUSF", "Clear sky upward solar flux [W/m^2]"},
+      /* 161 */ {"CSDSF", "Clear sky downward solar flux [W/m^2]"},
+      /* 162 */ {"CSULF", "Clear sky upward long wave flux [W/m^2]"},
+      /* 163 */ {"CSDLF", "Clear sky downward long wave flux [W/m^2]"},
+      /* 164 */ {"CFNSF", "Cloud forcing net solar flux [W/m^2]"},
+      /* 165 */ {"CFNLF", "Cloud forcing net long wave flux [W/m^2]"},
+      /* 166 */ {"VBDSF", "Visible beam downward solar flux [W/m^2]"},
+      /* 167 */ {"VDDSF", "Visible diffuse downward solar flux [W/m^2]"},
+      /* 168 */ {"NBDSF", "Near IR beam downward solar flux [W/m^2]"},
+      /* 169 */ {"NDDSF", "Near IR diffuse downward solar flux [W/m^2]"},
+      /* 170 */ {"RWMR", "Rain water mixing ratio [kg/kg]"},
+      /* 171 */ {"SNMR", "Snow mixing ratio [kg/kg]"},
+      /* 172 */ {"MFLX", "Momentum flux [N/m^2]"},
+      /* 173 */ {"LMH", "Mass point model surface [non-dim]"},
+      /* 174 */ {"LMV", "Velocity point model surface [non-dim]"},
+      /* 175 */ {"MLYNO", "Model layer number (from bottom up) [non-dim]"},
+      /* 176 */ {"NLAT", "Latitude (-90 to +90) [deg]"},
+      /* 177 */ {"ELON", "East longitude (0-360) [deg]"},
+      /* 178 */ {"ICMR", "Ice mixing ratio [kg/kg]"},
+      /* 179 */ {"GRMR", "Graupel mixing ratio [kg/kg]"},
+      /* 180 */ {"GUST", "Surface wind gust [m/s]"},
+      /* 181 */ {"LPSX", "x-gradient of log pressure [1/m]"},
+      /* 182 */ {"LPSY", "y-gradient of log pressure [1/m]"},
+      /* 183 */ {"HGTX", "x-gradient of height [m/m]"},
+      /* 184 */ {"HGTY", "y-gradient of height [m/m]"},
+      /* 185 */ {"TURB", "Turbulence SIGMET/AIRMET [non-dim]"},
+      /* 186 */ {"ICNG", "Icing SIGMET/AIRMET [non-dim]"},
+      /* 187 */ {"LTNG", "Lightning [non-dim]"},
+      /* 188 */ {"DRIP", "Rate of water dropping from canopy to gnd [kg/m^2]"},
+      /* 189 */ {"VPTMP", "Virtual pot. temp. [K]"},
+      /* 190 */ {"HLCY", "Storm relative helicity [m^2/s^2]"},
+      /* 191 */ {"PROB", "Prob. from ensemble [non-dim]"},
+      /* 192 */ {"PROBN", "Prob. from ensemble norm. to clim. expect. [non-dim]"},
+      /* 193 */ {"POP", "Prob. of precipitation [%]"},
+      /* 194 */ {"CPOFP", "Prob. of frozen precipitation [%]"},
+      /* 195 */ {"CPOZP", "Prob. of freezing precipitation [%]"},
+      /* 196 */ {"USTM", "u-component of storm motion [m/s]"},
+      /* 197 */ {"VSTM", "v-component of storm motion [m/s]"},
+      /* 198 */ {"NCIP", "No. concen. ice particles []"},
+      /* 199 */ {"EVBS", "Direct evaporation from bare soil [W/m^2]"},
+      /* 200 */ {"EVCW", "Canopy water evaporation [W/m^2]"},
+      /* 201 */ {"ICWAT", "Ice-free water surface [%]"},
+      /* 202 */ {"CWDI", "Convective weather detection index []"},
+      /* 203 */ {"VAFTAD", "VAFTAD?? [??]"},
+      /* 204 */ {"DSWRF", "Downward short wave flux [W/m^2]"},
+      /* 205 */ {"DLWRF", "Downward long wave flux [W/m^2]"},
+      /* 206 */ {"UVI", "Ultraviolet index [W/m^2]"},
+      /* 207 */ {"MSTAV", "Moisture availability [%]"},
+      /* 208 */ {"SFEXC", "Exchange coefficient [(kg/m^3)(m/s)]"},
+      /* 209 */ {"MIXLY", "No. of mixed layers next to surface [integer]"},
+      /* 210 */ {"TRANS", "Transpiration [W/m^2]"},
+      /* 211 */ {"USWRF", "Upward short wave flux [W/m^2]"},
+      /* 212 */ {"ULWRF", "Upward long wave flux [W/m^2]"},
+      /* 213 */ {"CDLYR", "Non-convective cloud [%]"},
+      /* 214 */ {"CPRAT", "Convective precip. rate [kg/m^2/s]"},
+      /* 215 */ {"TTDIA", "Temp. tendency by all physics [K/s]"},
+      /* 216 */ {"TTRAD", "Temp. tendency by all radiation [K/s]"},
+      /* 217 */ {"TTPHY", "Temp. tendency by non-radiation physics [K/s]"},
+      /* 218 */ {"PREIX", "Precip index (0.0-1.00) [fraction]"},
+      /* 219 */ {"TSD1D", "Std. dev. of IR T over 1x1 deg area [K]"},
+      /* 220 */ {"NLGSP", "Natural log of surface pressure [ln(kPa)]"},
+      /* 221 */ {"HPBL", "Planetary boundary layer height [m]"},
+      /* 222 */ {"5WAVH", "5-wave geopotential height [gpm]"},
+      /* 223 */ {"CNWAT", "Plant canopy surface water [kg/m^2]"},
+      /* 224 */ {"SOTYP", "Soil type (Zobler) [0..9]"},
+      /* 225 */ {"VGTYP", "Vegetation type (as in SiB) [0..13]"},
+      /* 226 */ {"BMIXL", "Blackadar's mixing length scale [m]"},
+      /* 227 */ {"AMIXL", "Asymptotic mixing length scale [m]"},
+      /* 228 */ {"PEVAP", "Pot. evaporation [kg/m^2]"},
+      /* 229 */ {"SNOHF", "Snow phase-change heat flux [W/m^2]"},
+      /* 230 */ {"5WAVA", "5-wave geopot. height anomaly [gpm]"},
+      /* 231 */ {"MFLUX", "Convective cloud mass flux [Pa/s]"},
+      /* 232 */ {"DTRF", "Downward total radiation flux [W/m^2]"},
+      /* 233 */ {"UTRF", "Upward total radiation flux [W/m^2]"},
+      /* 234 */ {"BGRUN", "Baseflow-groundwater runoff [kg/m^2]"},
+      /* 235 */ {"SSRUN", "Storm surface runoff [kg/m^2]"},
+      /* 236 */ {"SIPD", "Supercooled large droplet (SLD) icing pot. diagn. []"},
+      /* 237 */ {"O3TOT", "Total ozone [kg/m^2]"},
+      /* 238 */ {"SNOWC", "Snow cover [%]"},
+      /* 239 */ {"SNOT", "Snow temp. [K]"},
+      /* 240 */ {"COVTW", "Covariance T and w [K*m/s]"},
+      /* 241 */ {"LRGHR", "Large scale condensation heating [K/s]"},
+      /* 242 */ {"CNVHR", "Deep convective heating [K/s]"},
+      /* 243 */ {"CNVMR", "Deep convective moistening [kg/kg/s]"},
+      /* 244 */ {"SHAHR", "Shallow convective heating [K/s]"},
+      /* 245 */ {"SHAMR", "Shallow convective moistening [kg/kg/s]"},
+      /* 246 */ {"VDFHR", "Vertical diffusion heating [K/s]"},
+      /* 247 */ {"VDFUA", "Vertical diffusion zonal accel [m/s^2]"},
+      /* 248 */ {"VDFVA", "Vertical diffusion meridional accel [m/s^2]"},
+      /* 249 */ {"VDFMR", "Vertical diffusion moistening [kg/kg/s]"},
+      /* 250 */ {"SWHR", "Solar radiative heating [K/s]"},
+      /* 251 */ {"LWHR", "Longwave radiative heating [K/s]"},
+      /* 252 */ {"CD", "Drag coefficient [non-dim]"},
+      /* 253 */ {"FRICV", "Friction velocity [m/s]"},
+      /* 254 */ {"RI", "Richardson number [non-dim]"},
+      /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptable_reanal.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptable_reanal.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/nceptable_reanal.c	(revision 2744)
@@ -0,0 +1,275 @@
+#include "cnames.h"
+
+/*
+ * parameter table for the NCEP/NCAR Reanalysis Project
+ * center = 7, subcenter = 0/2, parameter table = 1/2
+ * in a SNAFU the operational and reanalysis tables diverged
+ * and both retained the same parameter table numbers (1,2)
+ *
+ * some of the Reanalysis files have subcenter=2 while others
+ * use subcenter=0  (subcenter field is not standard (7/97))
+ *
+ * Some ways to tell Reanalysis files from OPN files
+ *  Reanalysis: always generated by process 80 - T62 28 level model
+ * Original subcenter=0 Reanalysis files had 
+ *  2.5x2.5 (144x73) lat-long grid or 192x94 Gaussian grid (PDS grid=255?)
+ */
+
+struct ParmTable parm_table_ncep_reanal[256] = {
+   /* 0 */ {"var0", "undefined"},
+   /* 1 */ {"PRES", "Pressure [Pa]"},
+   /* 2 */ {"PRMSL", "Pressure reduced to MSL [Pa]"},
+   /* 3 */ {"PTEND", "Pressure tendency [Pa/s]"},
+   /* 4 */ {"var4", "undefined"},
+   /* 5 */ {"var5", "undefined"},
+   /* 6 */ {"GP", "Geopotential [m^2/s^2]"},
+   /* 7 */ {"HGT", "Geopotential height [gpm]"},
+   /* 8 */ {"DIST", "Geometric height [m]"},
+   /* 9 */ {"HSTDV", "Std dev of height [m]"},
+   /* 10 */ {"HVAR", "Variance of height [m^2]"},
+   /* 11 */ {"TMP", "Temp. [K]"},
+   /* 12 */ {"VTMP", "Virtual temp. [K]"},
+   /* 13 */ {"POT", "Potential temp. [K]"},
+   /* 14 */ {"EPOT", "Pseudo-adiabatic pot. temp. [K]"},
+   /* 15 */ {"TMAX", "Max. temp. [K]"},
+   /* 16 */ {"TMIN", "Min. temp. [K]"},
+   /* 17 */ {"DPT", "Dew point temp. [K]"},
+   /* 18 */ {"DEPR", "Dew point depression [K]"},
+   /* 19 */ {"LAPR", "Lapse rate [K/m]"},
+   /* 20 */ {"VISIB", "Visibility [m]"},
+   /* 21 */ {"RDSP1", "Radar spectra (1) [non-dim]"},
+   /* 22 */ {"RDSP2", "Radar spectra (2) [non-dim]"},
+   /* 23 */ {"RDSP3", "Radar spectra (3) [non-dim]"},
+   /* 24 */ {"var24", "undefined"},
+   /* 25 */ {"TMPA", "Temp. anomaly [K]"},
+   /* 26 */ {"PRESA", "Pressure anomaly [Pa]"},
+   /* 27 */ {"GPA", "Geopotential height anomaly [gpm]"},
+   /* 28 */ {"WVSP1", "Wave spectra (1) [non-dim]"},
+   /* 29 */ {"WVSP2", "Wave spectra (2) [non-dim]"},
+   /* 30 */ {"WVSP3", "Wave spectra (3) [non-dim]"},
+   /* 31 */ {"WDIR", "Wind direction [deg]"},
+   /* 32 */ {"WIND", "Wind speed [m/s]"},
+   /* 33 */ {"UGRD", "u wind [m/s]"},
+   /* 34 */ {"VGRD", "v wind [m/s]"},
+   /* 35 */ {"STRM", "Stream function [m^2/s]"},
+   /* 36 */ {"VPOT", "Velocity potential [m^2/s]"},
+   /* 37 */ {"MNTSF", "Montgomery stream function [m^2/s^2]"},
+   /* 38 */ {"SGCVV", "Sigma coord. vertical velocity [/s]"},
+   /* 39 */ {"VVEL", "Pressure vertical velocity [Pa/s]"},
+   /* 40 */ {"DZDT", "Geometric vertical velocity [m/s]"},
+   /* 41 */ {"ABSV", "Absolute vorticity [/s]"},
+   /* 42 */ {"ABSD", "Absolute divergence [/s]"},
+   /* 43 */ {"RELV", "Relative vorticity [/s]"},
+   /* 44 */ {"RELD", "Relative divergence [/s]"},
+   /* 45 */ {"VUCSH", "Vertical u shear [/s]"},
+   /* 46 */ {"VVCSH", "Vertical v shear [/s]"},
+   /* 47 */ {"DIRC", "Direction of current [deg]"},
+   /* 48 */ {"SPC", "Speed of current [m/s]"},
+   /* 49 */ {"UOGRD", "u of current [m/s]"},
+   /* 50 */ {"VOGRD", "v of current [m/s]"},
+   /* 51 */ {"SPFH", "Specific humidity [kg/kg]"},
+   /* 52 */ {"RH", "Relative humidity [%]"},
+   /* 53 */ {"MIXR", "Humidity mixing ratio [kg/kg]"},
+   /* 54 */ {"PWAT", "Precipitable water [kg/m^2]"},
+   /* 55 */ {"VAPP", "Vapor pressure [Pa]"},
+   /* 56 */ {"SATD", "Saturation deficit [Pa]"},
+   /* 57 */ {"EVP", "Evaporation [kg/m^2]"},
+   /* 58 */ {"CICE", "Cloud Ice [kg/kg]"},
+   /* 59 */ {"PRATE", "Precipitation rate [kg/m^2/s]"},
+   /* 60 */ {"TSTM", "Thunderstorm probability [%]"},
+   /* 61 */ {"APCP", "Total precipitation [kg/m^2]"},
+   /* 62 */ {"NCPCP", "Large scale precipitation [kg/m^2]"},
+   /* 63 */ {"ACPCP", "Convective precipitation [kg/m^2]"},
+   /* 64 */ {"SRWEQ", "Snowfall rate water equiv. [kg/m^2/s]"},
+   /* 65 */ {"WEASD", "Accum. snow [kg/m^2]"},
+   /* 66 */ {"SNOD", "Snow depth [m]"},
+   /* 67 */ {"MIXHT", "Mixed layer depth [m]"},
+   /* 68 */ {"TTHDP", "Transient thermocline depth [m]"},
+   /* 69 */ {"MTHD", "Main thermocline depth [m]"},
+   /* 70 */ {"MTHA", "Main thermocline anomaly [m]"},
+   /* 71 */ {"TCDC", "Total cloud cover [%]"},
+   /* 72 */ {"CDCON", "Convective cloud cover [%]"},
+   /* 73 */ {"LCDC", "Low level cloud cover [%]"},
+   /* 74 */ {"MCDC", "Mid level cloud cover [%]"},
+   /* 75 */ {"HCDC", "High level cloud cover [%]"},
+   /* 76 */ {"CWAT", "Cloud water [kg/m^2]"},
+   /* 77 */ {"var77", "undefined"},
+   /* 78 */ {"SNOC", "Convective snow [kg/m^2]"},
+   /* 79 */ {"SNOL", "Large scale snow [kg/m^2]"},
+   /* 80 */ {"WTMP", "Water temp. [K]"},
+   /* 81 */ {"LAND", "Land-sea mask [1=land; 0=sea]"},
+   /* 82 */ {"DSLM", "Deviation of sea level from mean [m]"},
+   /* 83 */ {"SFCR", "Surface roughness [m]"},
+   /* 84 */ {"ALBDO", "Albedo [%]"},
+   /* 85 */ {"TSOIL", "Soil temp. [K]"},
+   /* 86 */ {"SOILM", "Soil moisture content [kg/m^2]"},
+   /* 87 */ {"VEG", "Vegetation [%]"},
+   /* 88 */ {"SALTY", "Salinity [kg/kg]"},
+   /* 89 */ {"DEN", "Density [kg/m^3]"},
+   /* 90 */ {"RUNOF", "Runoff [kg/m^2]"},
+   /* 91 */ {"ICEC", "Ice concentration [ice=1;no ice=0]"},
+   /* 92 */ {"ICETK", "Ice thickness [m]"},
+   /* 93 */ {"DICED", "Direction of ice drift [deg]"},
+   /* 94 */ {"SICED", "Speed of ice drift [m/s]"},
+   /* 95 */ {"UICE", "u of ice drift [m/s]"},
+   /* 96 */ {"VICE", "v of ice drift [m/s]"},
+   /* 97 */ {"ICEG", "Ice growth rate [m/s]"},
+   /* 98 */ {"ICED", "Ice divergence [/s]"},
+   /* 99 */ {"SNOM", "Snow melt [kg/m^2]"},
+   /* 100 */ {"HTSGW", "Sig height of wind waves and swell [m]"},
+   /* 101 */ {"WVDIR", "Direction of wind waves [deg]"},
+   /* 102 */ {"WVHGT", "Sig height of wind waves [m]"},
+   /* 103 */ {"WVPER", "Mean period of wind waves [s]"},
+   /* 104 */ {"SWDIR", "Direction of swell waves [deg]"},
+   /* 105 */ {"SWELL", "Sig height of swell waves [m]"},
+   /* 106 */ {"SWPER", "Mean period of swell waves [s]"},
+   /* 107 */ {"DIRPW", "Primary wave direction [deg]"},
+   /* 108 */ {"PERPW", "Primary wave mean period [s]"},
+   /* 109 */ {"DIRSW", "Secondary wave direction [deg]"},
+   /* 110 */ {"PERSW", "Secondary wave mean period [s]"},
+   /* 111 */ {"NSWRS", "Net short wave (surface) [W/m^2]"},
+   /* 112 */ {"NLWRS", "Net long wave (surface) [W/m^2]"},
+   /* 113 */ {"NSWRT", "Net short wave (top) [W/m^2]"},
+   /* 114 */ {"NLWRT", "Net long wave (top) [W/m^2]"},
+   /* 115 */ {"LWAVR", "Long wave [W/m^2]"},
+   /* 116 */ {"SWAVR", "Short wave [W/m^2]"},
+   /* 117 */ {"GRAD", "Global radiation [W/m^2]"},
+   /* 118 */ {"var118", "undefined"},
+   /* 119 */ {"var119", "undefined"},
+   /* 120 */ {"var120", "undefined"},
+   /* 121 */ {"LHTFL", "Latent heat flux [W/m^2]"},
+   /* 122 */ {"SHTFL", "Sensible heat flux [W/m^2]"},
+   /* 123 */ {"BLYDP", "Boundary layer dissipation [W/m^2]"},
+   /* 124 */ {"UFLX", "Zonal momentum flux [N/m^2]"},
+   /* 125 */ {"VFLX", "Meridional momentum flux [N/m^2]"},
+   /* 126 */ {"WMIXE", "Wind mixing energy [J]"},
+   /* 127 */ {"IMGD", "Image data [integer]"},
+   /* 128 */ {"MSLSA", "Mean sea level pressure (Std Atm) [Pa]"},
+   /* 129 */ {"MSLMA", "Mean sea level pressure (MAPS) [Pa]"},
+   /* 130 */ {"MSLET", "Mean sea level pressure (ETA model) [Pa]"},
+   /* 131 */ {"LFTX", "Surface lifted index [K]"},
+   /* 132 */ {"4LFTX", "Best (4-layer) lifted index [K]"},
+   /* 133 */ {"KX", "K index [K]"},
+   /* 134 */ {"SX", "Sweat index [K]"},
+   /* 135 */ {"MCONV", "Horizontal moisture divergence [kg/kg/s]"},
+   /* 136 */ {"VSSH", "Vertical speed shear [1/s]"},
+   /* 137 */ {"TSLSA", "3-hr pressure tendency [Pa/s]"},
+   /* 138 */ {"BVF2", "Brunt-Vaisala frequency^2 [1/s^2]"},
+   /* 139 */ {"PVMW", "Potential vorticity (mass-weighted) [1/s/m]"},
+   /* 140 */ {"CRAIN", "Categorical rain [yes=1;no=0]"},
+   /* 141 */ {"CFRZR", "Categorical freezing rain [yes=1;no=0]"},
+   /* 142 */ {"CICEP", "Categorical ice pellets [yes=1;no=0]"},
+   /* 143 */ {"CSNOW", "Categorical snow [yes=1;no=0]"},
+   /* 144 */ {"SOILW", "Volumetric soil moisture [fraction]"},
+   /* 145 */ {"PEVPR", "Potential evaporation rate [W/m^2]"},
+   /* 146 */ {"CWORK", "Cloud work function [J/kg]"},
+   /* 147 */ {"U-GWD", "Zonal gravity wave stress [N/m^2]"},
+   /* 148 */ {"V-GWD", "Meridional gravity wave stress [N/m^2]"},
+   /* 149 */ {"PV___", "Potential vorticity [m^2/s/kg]"},
+   /* 150 */ {"var150", "undefined"},
+   /* 151 */ {"var151", "undefined"},
+   /* 152 */ {"var152", "undefined"},
+   /* 153 */ {"MFXDV", "Moisture flux divergence [gr/gr*m/s/m]"},
+   /* 154 */ {"var154", "undefined"},
+   /* 155 */ {"GFLUX", "Ground heat flux [W/m^2]"},
+   /* 156 */ {"CIN", "Convective inhibition [J/kg]"},
+   /* 157 */ {"CAPE", "Convective Avail. Pot. Energy [J/kg]"},
+   /* 158 */ {"TKE", "Turbulent kinetic energy [J/kg]"},
+   /* 159 */ {"CONDP", "Lifted parcel condensation pressure [Pa]"},
+   /* 160 */ {"CSUSF", "Clear sky upward solar flux [W/m^2]"},
+   /* 161 */ {"CSDSF", "Clear sky downward solar flux [W/m^2]"},
+   /* 162 */ {"CSULF", "Clear sky upward long wave flux [W/m^2]"},
+   /* 163 */ {"CSDLF", "Clear sky downward long wave flux [W/m^2]"},
+   /* 164 */ {"CFNSF", "Cloud forcing net solar flux [W/m^2]"},
+   /* 165 */ {"CFNLF", "Cloud forcing net long wave flux [W/m^2]"},
+   /* 166 */ {"VBDSF", "Visible beam downward solar flux [W/m^2]"},
+   /* 167 */ {"VDDSF", "Visible diffuse downward solar flux [W/m^2]"},
+   /* 168 */ {"NBDSF", "Near IR beam downward solar flux [W/m^2]"},
+   /* 169 */ {"NDDSF", "Near IR diffuse downward solar flux [W/m^2]"},
+   /* 170 */ {"USTR", "U wind stress [N/m^2]"},
+   /* 171 */ {"VSTR", "V wind stress [N/m^2]"},
+   /* 172 */ {"MFLX", "Momentum flux [N/m^2]"},
+   /* 173 */ {"LMH", "Mass point model surface [integer]"},
+   /* 174 */ {"LMV", "Velocity point model surface [integer]"},
+   /* 175 */ {"SGLYR", "Nearby model level [integer]"},
+   /* 176 */ {"NLAT", "Latitude [deg]"},
+   /* 177 */ {"ELON", "Longitude [deg]"},
+   /* 178 */ {"UMAS", "Mass weighted u [gm/m*K*s]"},
+   /* 179 */ {"VMAS", "Mass weighted v [gm/m*K*s]"},
+   /* 180 */ {"XPRATE", "corrected precip [kg/m^2/s]"},
+   /* 181 */ {"LPSX", "x-gradient of log pressure [1/m]"},
+   /* 182 */ {"LPSY", "y-gradient of log pressure [1/m]"},
+   /* 183 */ {"HGTX", "x-gradient of height [m/m]"},
+   /* 184 */ {"HGTY", "y-gradient of height [m/m]"},
+   /* 185 */ {"STDZ", "Std dev of Geop. hgt. [m]"},
+   /* 186 */ {"STDU", "Std dev of zonal wind [m/s]"},
+   /* 187 */ {"STDV", "Std dev of meridional wind [m/s]"},
+   /* 188 */ {"STDQ", "Std dev of spec. hum. [gm/gm]"},
+   /* 189 */ {"STDT", "Std dev of temp. [K]"},
+   /* 190 */ {"CBUW", "Covar. u and omega [m/s*Pa/s]"},
+   /* 191 */ {"CBVW", "Covar. v and omega [m/s*Pa/s]"},
+   /* 192 */ {"CBUQ", "Covar. u and specific hum [m/s*gm/gm]"},
+   /* 193 */ {"CBVQ", "Covar. v and specific hum [m/s*gm/gm]"},
+   /* 194 */ {"CBTW", "Covar. T and omega [K*Pa/s]"},
+   /* 195 */ {"CBQW", "Covar. spec. hum and omega [gm/gm*Pa/s]"},
+   /* 196 */ {"CBMZW", "Covar. v and u [m^2/s^2]"},
+   /* 197 */ {"CBTZW", "Covar. u and T [K*m/s]"},
+   /* 198 */ {"CBTMW", "Covar. v and T [K*m/s]"},
+   /* 199 */ {"STDRH", "Std dev of Rel. Hum. [%]"},
+   /* 200 */ {"SDTZ", "Std dev of time tend of geop. hgt [m]"},
+   /* 201 */ {"ICWAT", "Ice-free water surface [%]"},
+   /* 202 */ {"SDTU", "Std dev of time tend of zonal wind [m/s]"},
+   /* 203 */ {"SDTV", "Std dev of time tend of merid wind [m/s]"},
+   /* 204 */ {"DSWRF", "Downward solar radiation flux [W/m^2]"},
+   /* 205 */ {"DLWRF", "Downward long wave flux [W/m^2]"},
+   /* 206 */ {"SDTQ", "Std dev of time tend of spec. hum [gm/gm]"},
+   /* 207 */ {"MSTAV", "Moisture availability [%]"},
+   /* 208 */ {"SFEXC", "Exchange coefficient [kg*m/m^3/s]"},
+   /* 209 */ {"MIXLY", "No. of mixed layers next to sfc [integer]"},
+   /* 210 */ {"SDTT", "Std dev of time tend of temp. [K]"},
+   /* 211 */ {"USWRF", "Upward solar radiation flux [W/m^2]"},
+   /* 212 */ {"ULWRF", "Upward long wave flux [W/m^2]"},
+   /* 213 */ {"CDLYR", "Non-convective cloud [%]"},
+   /* 214 */ {"CPRAT", "Convective precip. rate [kg/m^2/s]"},
+   /* 215 */ {"TTDIA", "Temp. tendency by all physics [K/s]"},
+   /* 216 */ {"TTRAD", "Temp. tendency by all radiation [K/s]"},
+   /* 217 */ {"TTPHY", "Temp. tendency by nonrad physics [K/s]"},
+   /* 218 */ {"PREIX", "Precipitation index [fraction]"},
+   /* 219 */ {"TSD1D", "Std dev of IR T over 1x1 deg area [K]"},
+   /* 220 */ {"NLSGP", "Natural log of surface pressure [ln(kPa)]"},
+   /* 221 */ {"SDTRH", "Std dev of time tend of rel hum [%]"},
+   /* 222 */ {"5WAVH", "5-wave geopotential height [gpm]"},
+   /* 223 */ {"CNWAT", "Plant canopy surface water [kg/m^2]"},
+   /* 224 */ {"PLTRS", "Max. stomato plant resistance [s/m]"},
+   /* 225 */ {"RHCLD", "RH-type cloud cover [%]"},
+   /* 226 */ {"BMIXL", "Blackadar's mixing length scale [m]"},
+   /* 227 */ {"AMIXL", "Asymptotic mixing length scale [m]"},
+   /* 228 */ {"PEVAP", "Pot. evaporation [kg/m^2]"},
+   /* 229 */ {"SNOHF", "Snow melt heat flux [W/m^2]"},
+   /* 230 */ {"SNOEV", "Snow sublimation heat flux [W/m^2]"},
+   /* 231 */ {"MFLUX", "Convective cloud mass flux [Pa/s]"},
+   /* 232 */ {"DTRF", "Downward total radiation flux [W/m^2]"},
+   /* 233 */ {"UTRF", "Upward total radiation flux [W/m^2]"},
+   /* 234 */ {"BGRUN", "Baseflow-groundwater runoff [kg/m^2]"},
+   /* 235 */ {"SSRUN", "Storm surface runoff [kg/m^2]"},
+   /* 236 */ {"var236", "undefined"},
+   /* 237 */ {"OZONE", "Total column ozone [Dobson]"},
+   /* 238 */ {"SNOWC", "Snow cover [%]"},
+   /* 239 */ {"SNOT", "Snow temp. [K]"},
+   /* 240 */ {"GLCR", "Permanent snow points [mask]"},
+   /* 241 */ {"LRGHR", "Large scale condensation heating [K/s]"},
+   /* 242 */ {"CNVHR", "Deep convective heating [K/s]"},
+   /* 243 */ {"CNVMR", "Deep convective moistening [kg/kg/s]"},
+   /* 244 */ {"SHAHR", "Shallow convective heating [K/s]"},
+   /* 245 */ {"SHAMR", "Shallow convective moistening [kg/kg/s]"},
+   /* 246 */ {"VDFHR", "Vertical diffusion heating [K/s]"},
+   /* 247 */ {"VDFUA", "Vertical diffusion zonal accel [m/s^2]"},
+   /* 248 */ {"VDFVA", "Vertical diffusion meridional accel [m/s^2]"},
+   /* 249 */ {"VDFMR", "Vertical diffusion moistening [kg/kg/s]"},
+   /* 250 */ {"SWHR", "Solar radiative heating [K/s]"},
+   /* 251 */ {"LWHR", "Longwave radiative heating [K/s]"},
+   /* 252 */ {"CD", "Drag coefficient [non-dim]"},
+   /* 253 */ {"FRICV", "Friction velocity [m/s]"},
+   /* 254 */ {"RI", "Richardson number [non-dim]"},
+   /* 255 */ {"var255", "undefined"},
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ombtable.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ombtable.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/ombtable.c	(revision 2744)
@@ -0,0 +1,265 @@
+#include "cnames.h"
+
+/* parameter table for ocean modeling branch (OMB) of NCEP */
+/* center = 7, subcenter = EMC, parameter table = 128 */
+
+/* 12/31/2001 added REV */
+
+struct ParmTable parm_table_omb[256] = {
+ {"var0", "Reserved"},
+ {"var1", "Reserved"},
+ {"GHz6", "6.6 GHz - K"},
+ {"GHz10", "10.7 GHz - K"},
+ {"GHz18", "18.0 GHz - K"},
+ {"GHz19V", "SSMI 19 GHz, Vertical Polarization - K"},
+ {"GHz19H", "SSMI 19 GHz, Horizontal Polarization - K"},
+ {"GHz21", "21.0 GHz - K"},
+ {"GHz22V", "SSMI 22 GHz, Vertical Polarization - K"},
+ {"GHz37V", "SSMI 37 GHz, Vertical Polarization - K"},
+ {"GHz37H", "SSMI 37 GHz, Horizontal Polarization - K"},
+ {"MSU1", "MSU Ch 1 - 50.30 GHz - K"},
+ {"MSU2", "MSU Ch 2 - 53.74 GHz - K"},
+ {"MSU3", "MSU Ch 3 - 54.96 GHz - K"},
+ {"MSU4", "MSU Ch 4 - 57.95 GHz - K"},
+ {"GHz85V", "SSMI 85 GHz, Vertical Polarization - K"},
+ {"GHz85H", "SSMI 85 GHz, Horizontal Polarization - K"},
+ {"GHz91", "91.65 GHz - K"},
+ {"GHz150", "150 GHz - K"},
+ {"GHz183pm7", "183 +- 7 GHz - K"},
+ {"GHz183pm3", "183 +- 3 GHz - K"},
+ {"GHz183pm1", "183 +- 1 GHz - K"},
+ {"SSMT1C1", "SSM/T1 - ch 1 - K"},
+ {"SSMT1C2", "SSM/T1 - ch 2 - K"},
+ {"SSMT1C3", "SSM/T1 - ch 3 - K"},
+ {"SSMT1C4", "SSM/T1 - ch 4 - K"},
+ {"SSMT1C5", "SSM/T1 - ch 5 - K"},
+ {"SSMT1C6", "SSM/T1 - ch 6 - K"},
+ {"SSMT1C7", "SSM/T1 - ch 7 - K"},
+ {"var29", "Reserved"},
+ {"var30", "Reserved"},
+ {"var31", "Reserved"},
+ {"var32", "Reserved"},
+ {"var33", "Reserved"},
+ {"var34", "Reserved"},
+ {"var35", "Reserved"},
+ {"var36", "Reserved"},
+ {"var37", "Reserved"},
+ {"var38", "Reserved"},
+ {"var39", "Reserved"},
+ {"var40", "Reserved"},
+ {"var41", "Reserved"},
+ {"var42", "Reserved"},
+ {"var43", "Reserved"},
+ {"var44", "Reserved"},
+ {"var45", "Reserved"},
+ {"var46", "Reserved"},
+ {"var47", "Reserved"},
+ {"var48", "Reserved"},
+ {"var49", "Reserved"},
+ {"var50", "Reserved"},
+ {"var51", "Reserved"},
+ {"var52", "Reserved"},
+ {"var53", "Reserved"},
+ {"var54", "Reserved"},
+ {"var55", "Reserved"},
+ {"var56", "Reserved"},
+ {"var57", "Reserved"},
+ {"var58", "Reserved"},
+ {"var59", "Reserved"},
+ {"MI14.95", "HIRS/2 ch 1 - 14.95 micron - K"},
+ {"MI14.71", "HIRS/2, GOES 14.71 micron - K"},
+ {"MI14.49", "HIRS/2 ch 3 - 14.49 micron - K"},
+ {"MI14.37", "GOES I-M - 14.37 micron - K"},
+ {"MI14.22", "HIRS/2 ch 4 - 14.22 micron - K"},
+ {"MI14.06", "GOES I-M - 14.06 micron - K"},
+ {"MI13.97", "HIRS/2 ch 5 - 13.97 micron - K"},
+ {"MI13.64", "HIRS/2, GOES 13.64 micron - K"},
+ {"MI13.37", "GOES I-M - 13.37 micron - K"},
+ {"MI13.35", "HIRS/2 ch 7 - 13.35 micron - K"},
+ {"MI12.66", "GOES I-M - 12.66 micron - K"},
+ {"MI12.02", "GOES I-M - 12.02 micron - K"},
+ {"MI12.00", "AVHRR ch 5 - 12.0 micron - K"},
+ {"MI11.11", "HIRS/2 ch 8 - 11.11 micron - K"},
+ {"MI11.03", "GOES I-M - 11.03 micron - K"},
+ {"MI10.80", "AVHRR ch 4 - 10.8 micron - K"},
+ {"MI9.71", "HIRS/2, GOES - 9.71 micron - K"},
+ {"var77", "Reserved"},
+ {"var78", "Reserved"},
+ {"var79", "Reserved"},
+ {"MI8.16", "HIRS/2 ch 10 - 8.16 micron - K"},
+ {"MI7.43", "GOES I-M - 7.43 micron - K"},
+ {"MI7.33", "HIRS/2 ch 11 - 7.33 micron - K"},
+ {"MI7.02", "GOES I-M - 7.02 micron - K"},
+ {"MI6.72", "HIRS/2 ch 12 - 6.72 micron - K"},
+ {"MI6.51", "GOES I-M - 6.51 micron - K"},
+ {"MI4.57", "HIRS/2, GOES - 4.57 micron - K"},
+ {"MI4.52", "HIRS/2, GOES - 4.52 micron - K"},
+ {"MI4.46", "HIRS/2 ch 15 - 4.46 micron - K"},
+ {"MI4.45", "GOES I-M - 4.45 micron - K"},
+ {"MI4.40", "HIRS/2 ch 16 - 4.40 micron - K"},
+ {"MI4.24", "HIRS/2 ch 17 - 4.24 micron - K"},
+ {"MI4.13", "GOES I-M - 4.13 micron - K"},
+ {"MI4.00", "HIRS/2 ch 18 - 4.00 micron - K"},
+ {"MI8.16", "GOES I-M - 3.98 micron - K"},
+ {"MI8.16", "HIRS/2 Window - 3.76 micron - K"},
+ {"MI8.16", "AVHRR, GOES - 3.74 micron - K"},
+ {"var97", "Reserved"},
+ {"var98", "Reserved"},
+ {"var99", "Reserved"},
+ {"MI0.91", "AVHRR ch 2 - 0.91 micron - K"},
+ {"MI0.696", "GOES I-M - 0.696 micron - K"},
+ {"MI0.69", "HIRS/2 Vis - 0.69 micron - K"},
+ {"MI0.63", "AVHRR ch 1 - 0.63 micron - K"},
+ {"var104", "Reserved"},
+ {"var105", "Reserved"},
+ {"var106", "Reserved"},
+ {"var107", "Reserved"},
+ {"var108", "Reserved"},
+ {"var109", "Reserved"},
+ {"var110", "Reserved"},
+ {"var111", "Reserved"},
+ {"var112", "Reserved"},
+ {"var113", "Reserved"},
+ {"var114", "Reserved"},
+ {"var115", "Reserved"},
+ {"var116", "Reserved"},
+ {"var117", "Reserved"},
+ {"var118", "Reserved"},
+ {"var119", "Reserved"},
+ {"var120", "Reserved"},
+ {"var121", "Reserved"},
+ {"var122", "Reserved"},
+ {"var123", "Reserved"},
+ {"var124", "Reserved"},
+ {"var125", "Reserved"},
+ {"var126", "Reserved"},
+ {"var127", "Reserved"},
+ {"AVDEPTH", "Ocean depth - mean - m"},
+ {"DEPTH", "Ocean depth - instantaneous - m"},
+ {"ELEV", "Ocean surface elevation relative to geoid - m"},
+ {"MXEL24", "Max ocean surface elevation in last 24 hours - m"},
+ {"MNEL24", "Min ocean surface elevation in last 24 hours - m"},
+ {"var133", "Reserved"},
+ {"var134", "Reserved"},
+ {"O2", "Oxygen -Mol/kg"},
+ {"PO4", "PO4 - Mol/kg"},
+ {"NO3", "NO3 - Mol/kg"},
+ {"SiO4", "SiO4 - Mol/kg"},
+ {"CO2aq", "CO2 (aq) - Mol/kg"},
+ {"HCO3", "HCO3 - - Mol/kg"},
+ {"CO3", "CO3 -- - Mol/kg"},
+ {"TCO2", "TCO2 - Mol/kg"},
+ {"TALK", "TALK - Mol/kg"},
+ {"var144", "Reserved"},
+ {"var145", "Reserved"},
+ {"S11", "S11 - 1,1 component of ice stress tensor"},
+ {"S12", "S12 - 1,2 component of ice stress tensor"},
+ {"S22", "S22 - 2,2 component of ice stress tensor"},
+ {"INV1", "T1 - First invariant of stress tensor"},
+ {"INV2", "T2 - Second invariant of stress tensor"},
+ {"var151", "Reserved"},
+ {"var152", "Reserved"},
+ {"var153", "Reserved"},
+ {"var154", "Reserved"},
+ {"WVRGH", "Wave Roughness"},
+ {"WVSTRS", "Wave Stresses"},
+ {"WHITE", "Whitecap coverage"},
+ {"SWDIRWID", "Swell direction width"},
+ {"SWFREWID", "Swell frequency width"},
+ {"WVAGE", "Wave age"},
+ {"PWVAGE", "Physical Wave age"},
+ {"var162", "Reserved"},
+ {"var163", "Reserved"},
+ {"var164", "Reserved"},
+ {"LTURB", "Master length scale (turbulence) - m"},
+ {"var166", "Reserved"},
+ {"var167", "Reserved"},
+ {"var168", "Reserved"},
+ {"var169", "Reserved"},
+ {"AIHFLX", "Net Air-Ice heat flux - W/m^2"},
+ {"AOHFLX", "Net Air-Ocean heat flux - W/m^2"},
+ {"IOHFLX", "Net Ice-Ocean heat flux - W/m^2"},
+ {"IOSFLX", "Net Ice-Ocean salt flux - kg/s"},
+ {"var174", "Reserved"},
+ {"OMLT", "Ocean Mixed Layer Temperature - K"},
+ {"OMLS", "Ocean Mixed Layer Salinity - kg/kg"},
+ {"var177", "Reserved"},
+ {"var178", "Reserved"},
+ {"var179", "Reserved"},
+ {"var180", "Reserved"},
+ {"var181", "Reserved"},
+ {"var182", "Reserved"},
+ {"var183", "Reserved"},
+ {"var184", "Reserved"},
+ {"var185", "Reserved"},
+ {"var186", "Reserved"},
+ {"var187", "Reserved"},
+ {"var188", "Reserved"},
+ {"var189", "Reserved"},
+ {"var190", "Reserved"},
+ {"var191", "Reserved"},
+ {"var192", "Reserved"},
+ {"var193", "Reserved"},
+ {"var194", "Reserved"},
+ {"var195", "Reserved"},
+ {"var196", "Reserved"},
+ {"var197", "Reserved"},
+ {"var198", "Reserved"},
+ {"var199", "Reserved"},
+ {"var200", "Reserved"},
+ {"var201", "Reserved"},
+ {"var202", "Reserved"},
+ {"var203", "Reserved"},
+ {"var204", "Reserved"},
+ {"var205", "Reserved"},
+ {"var206", "Reserved"},
+ {"var207", "Reserved"},
+ {"var208", "Reserved"},
+ {"var209", "Reserved"},
+ {"var210", "Reserved"},
+ {"var211", "Reserved"},
+ {"var212", "Reserved"},
+ {"var213", "Reserved"},
+ {"var214", "Reserved"},
+ {"var215", "Reserved"},
+ {"var216", "Reserved"},
+ {"var217", "Reserved"},
+ {"var218", "Reserved"},
+ {"var219", "Reserved"},
+ {"var220", "Reserved"},
+ {"var221", "Reserved"},
+ {"var222", "Reserved"},
+ {"var223", "Reserved"},
+ {"var224", "Reserved"},
+ {"var225", "Reserved"},
+ {"var226", "Reserved"},
+ {"var227", "Reserved"},
+ {"var228", "Reserved"},
+ {"var229", "Reserved"},
+ {"var230", "Reserved"},
+ {"var231", "Reserved"},
+ {"var232", "Reserved"},
+ {"var233", "Reserved"},
+ {"var234", "Reserved"},
+ {"var235", "Reserved"},
+ {"var236", "Reserved"},
+ {"var237", "Reserved"},
+ {"var238", "Reserved"},
+ {"var239", "Reserved"},
+ {"var240", "Reserved"},
+ {"var241", "Reserved"},
+ {"var242", "Reserved"},
+ {"var243", "Reserved"},
+ {"var244", "Reserved"},
+ {"var245", "Reserved"},
+ {"var246", "Reserved"},
+ {"var247", "Reserved"},
+ {"var248", "Reserved"},
+ {"var249", "Reserved"},
+ {"var250", "Reserved"},
+ {"var251", "Reserved"},
+ {"var252", "Reserved"},
+ {"var253", "Reserved"},
+ {"REV", "Relative Error Variance [non-dim]"},
+ {"var255", "Reserved"}
+};
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/pds4.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/pds4.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/pds4.h	(revision 2744)
@@ -0,0 +1,90 @@
+/* version 3.4 of grib headers  w. ebisuzaki */
+/* this version is incomplete */
+/* add center DWD    Helmut P. Frank */
+/* 10/02 add center CPTEC */
+
+#ifndef INT2
+#define INT2(a,b)   ((1-(int) ((unsigned) (a & 0x80) >> 6)) * (int) (((a & 0x7f) << 8) + b))
+#endif
+
+#define PDS_Len1(pds)		(pds[0])
+#define PDS_Len2(pds)		(pds[1])
+#define PDS_Len3(pds)		(pds[2])
+#define PDS_LEN(pds)		((int) ((pds[0]<<16)+(pds[1]<<8)+pds[2]))
+#define PDS_Vsn(pds)		(pds[3])
+#define PDS_Center(pds)		(pds[4])
+#define PDS_Model(pds)		(pds[5])
+#define PDS_Grid(pds)		(pds[6])
+#define PDS_HAS_GDS(pds)	((pds[7] & 128) != 0)
+#define PDS_HAS_BMS(pds)	((pds[7] & 64) != 0)
+#define PDS_PARAM(pds)		(pds[8])
+#define PDS_L_TYPE(pds)		(pds[9])
+#define PDS_LEVEL1(pds)		(pds[10])
+#define PDS_LEVEL2(pds)		(pds[11])
+
+#define PDS_KPDS5(pds)		(pds[8])
+#define PDS_KPDS6(pds)		(pds[9])
+#define PDS_KPDS7(pds)		((int) ((pds[10]<<8) + pds[11]))
+
+/* this requires a 32-bit default integer machine */
+#define PDS_Field(pds)		((pds[8]<<24)+(pds[9]<<16)+(pds[10]<<8)+pds[11])
+
+#define PDS_Year(pds)		(pds[12])
+#define PDS_Month(pds)		(pds[13])
+#define PDS_Day(pds)		(pds[14])
+#define PDS_Hour(pds)		(pds[15])
+#define PDS_Minute(pds)		(pds[16])
+#define PDS_ForecastTimeUnit(pds)	(pds[17])
+#define PDS_P1(pds)		(pds[18])
+#define PDS_P2(pds)		(pds[19])
+#define PDS_TimeRange(pds)	(pds[20])
+#define PDS_NumAve(pds)		((int) ((pds[21]<<8)+pds[22]))
+#define PDS_NumMissing(pds)	(pds[23])
+#define PDS_Century(pds)	(pds[24])
+#define PDS_Subcenter(pds)	(pds[25])
+#define PDS_DecimalScale(pds)	INT2(pds[26],pds[27])
+/* old #define PDS_Year4(pds)   (pds[12] + 100*(pds[24] - (pds[12] != 0))) */
+#define PDS_Year4(pds)          (pds[12] + 100*(pds[24] - 1))
+
+/* various centers */
+#define NMC			7
+#define ECMWF			98
+#define DWD			78
+#define CMC			54
+#define CPTEC			46
+
+/* ECMWF Extensions */
+
+#define PDS_EcLocalId(pds)	(PDS_LEN(pds) >= 41 ? (pds[40]) : 0)
+#define PDS_EcClass(pds)	(PDS_LEN(pds) >= 42 ? (pds[41]) : 0)
+#define PDS_EcType(pds)		(PDS_LEN(pds) >= 43 ? (pds[42]) : 0)
+#define PDS_EcStream(pds)	(PDS_LEN(pds) >= 45 ? (INT2(pds[43], pds[44])) : 0)
+
+#define PDS_EcENS(pds)		(PDS_LEN(pds) >= 52 && pds[40] == 1 && \
+				pds[43] * 256 + pds[44] == 1035 && pds[50] != 0)
+#define PDS_EcFcstNo(pds)	(pds[50])
+#define PDS_EcNoFcst(pds)	(pds[51])
+
+
+/* NCEP Extensions */
+
+#define PDS_NcepENS(pds)	(PDS_LEN(pds) >= 44 && pds[25] == 2 && pds[40] == 1)
+#define PDS_NcepFcstType(pds)	(pds[41])
+#define PDS_NcepFcstNo(pds)	(pds[42])
+#define PDS_NcepFcstProd(pds)	(pds[43])
+
+/* time units */
+
+#define MINUTE  0
+#define HOUR    1
+#define DAY     2
+#define MONTH   3
+#define YEAR    4
+#define DECADE  5
+#define NORMAL  6
+#define CENTURY 7
+#define HOURS3  10
+#define HOURS6  11
+#define HOURS12  12
+#define SECOND  254
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/readgrib.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/readgrib.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/readgrib.c	(revision 2744)
@@ -0,0 +1,31 @@
+/*
+ * read_grib.c
+ *
+ * reads grib message
+ *
+ * input: pos, byte position of grib message
+ *        len_grib, length of grib message
+ * output: *buffer, grib message
+ *
+ * note: call seek_grib first
+ *
+ * v1.0 9/94 Wesley Ebisuzaki
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include "grib.h"
+
+int read_grib(FILE *file, long pos, long len_grib, unsigned char *buffer) {
+
+    int i;
+
+
+    if (fseek(file, pos, SEEK_SET) == -1) {
+	    return 0;
+    }
+
+    i = fread(buffer, sizeof (unsigned char), len_grib, file);
+    return (i == len_grib);
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/seekgrib.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/seekgrib.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/seekgrib.c	(revision 2744)
@@ -0,0 +1,72 @@
+/*
+ * find next grib header
+ *
+ * file = what do you think?
+ * pos = initial position to start looking at  ( = 0 for 1st call)
+ *       returns with position of next grib header (units=bytes)
+ * len_grib = length of the grib record (bytes)
+ * buffer[buf_len] = buffer for reading/writing
+ *
+ * returns (char *) to start of GRIB header+PDS
+ *         NULL if not found
+ *
+ * adapted from SKGB (Mark Iredell)
+ *
+ * v1.1 9/94 Wesley Ebisuzaki
+ * v1.2 3/96 Wesley Ebisuzaki handles short records at end of file
+ * v1.3 8/96 Wesley Ebisuzaki increase NTRY from 3 to 100 for the folks
+ *      at Automation decided a 21 byte WMO bulletin header wasn't long 
+ *      enough and decided to go to an 8K header.  
+ * v1.4 11/10/2001 D. Haalman, looks at entire file, does not try
+ *      to read past EOF
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include "grib.h"
+
+#ifndef min
+   #define min(a,b)  ((a) < (b) ? (a) : (b))
+#endif
+
+#define NTRY 100
+/* #define LEN_HEADER_PDS (28+42+100) */
+#define LEN_HEADER_PDS (28+8)
+
+unsigned char *seek_grib(FILE *file, long *pos, long *len_grib, 
+        unsigned char *buffer, unsigned int buf_len) {
+
+    int i, j, len;
+
+    j = 1;
+    clearerr(file);
+    while ( !feof(file) ) {
+
+        if (fseek(file, *pos, SEEK_SET) == -1) break;
+        i = fread(buffer, sizeof (unsigned char), buf_len, file);     
+        if (ferror(file)) break;
+        len = i - LEN_HEADER_PDS;
+     
+        for (i = 0; i < len; i++) {
+            if (buffer[i] == 'G' && buffer[i+1] == 'R' && buffer[i+2] == 'I'
+                && buffer[i+3] == 'B' && buffer[i+7] == 1) {
+                    *pos = i + *pos;
+                    *len_grib = (buffer[i+4] << 16) + (buffer[i+5] << 8) +
+                            buffer[i+6];
+                    return (buffer+i);
+            }
+        }
+
+	if (j++ == NTRY) {
+	    fprintf(stderr,"found unidentified data \n");
+           /* break; // stop seeking after NTRY records */  
+        }
+
+	*pos = *pos + (buf_len - LEN_HEADER_PDS);
+    }
+
+    *len_grib = 0;
+    return (unsigned char *) NULL;
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/src2all
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/src2all	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/src2all	(revision 2744)
@@ -0,0 +1,35 @@
+#!/bin/sh
+#
+# combine source code into one module
+# easier to compile -- no make file needed
+#
+# pretty generic script -- just echos, cats and greps.
+# 
+
+echo "combining source code into one module"
+echo "output is wgrib.c"
+set -x
+
+h="bds.h bms.h cnames.h gds.h grib.h pds4.h"
+c="wgrib_main.c seekgrib.c ibm2flt.c readgrib.c intpower.c cnames.c \
+	BDSunpk.c flt2ieee.c wrtieee.c levels.c PDStimes.c missing.c \
+        nceptable_opn.c nceptable_reanal.c  nceptab_131.c nceptab_130.c \
+        ectable_128.c ectable_129.c ectable_130.c ectable_131.c \
+        ectable_140.c ectable_150.c ectable_151.c ectable_160.c ectable_170.c \
+        ectable_180.c nceptab_129.c \
+        ombtable.c ec_ext.c gds_grid.c gribtable.c PDS_date.c ensemble.c \
+	dwdtable_002.c dwdtable_201.c dwdtable_202.c dwdtable_203.c cptectable_254.c"
+
+echo >wgrib.c "#include <stdio.h>"
+echo >>wgrib.c "#include <stdlib.h>"
+echo >>wgrib.c "#include <string.h>"
+echo >>wgrib.c "#include <stddef.h>"
+echo >>wgrib.c "#include <math.h>"
+echo >>wgrib.c "#include <float.h>"
+
+
+cat $h >>wgrib.c
+
+cat $c | grep -v '#include' >> wgrib.c
+
+tar -cvf wgrib.tar $h $c src2all makefile Changes
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/wgrib_main.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/wgrib_main.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/wgrib_main.c	(revision 2744)
@@ -0,0 +1,839 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stddef.h>
+#include <math.h>
+#include <float.h>
+
+#include "pds4.h"
+#include "gds.h"
+#include "bms.h"
+#include "bds.h"
+#include "cnames.h"
+#include "grib.h"
+
+#define VERSION "v1.8.0.9i  (12-03-04) Wesley Ebisuzaki\n\t\tDWD-tables 2,201-203 (8-19-2003) Helmut P. Frank\n\t\tspectral: Luis Kornblueh (MPI)"
+
+#define CHECK_GRIB
+
+/*
+ * wgrib.c extract/inventory grib records
+ *
+ *                              Wesley Ebisuzaki
+ *
+ * 11/94 - v1.0
+ * 11/94 - v1.1: arbitary size grids, -i option
+ * 11/94 - v1.2: bug fixes, ieee option, more info
+ * 1/95  - v1.2.4: fix headers for SUN acc
+ * 2/95  - v1.2.5: add num_ave in -s listing
+ * 2/95  - v1.2.6: change %d to %ld
+ * 2/95  - v1.2.7: more output, added some polar stereographic support
+ * 2/95  - v1.2.8: max min format changed %f to %g, tidying up more info
+ * 3/95  - v1.3.0: fix bug with bitmap, allow numbers > UNDEFINED
+ * 3/95  - v1.3.1: print number of missing points (verbose)
+ * 3/95  - v1.3.2: -append option added
+ * 4/95  - v1.3.2a,b: more output, polar stereo support (-V option)
+ * 4/95  - v1.3.3: added ECMWF parameter table (prelim)
+ * 6/95  - v1.3.4: nxny from BDS rather than gds?
+ * 9/95  - v1.3.4d: speedup in grib write
+ * 11/95 - v1.3.4f: new ECMWF parameter table (from Mike Fiorino), EC logic
+ * 2/96  - v1.3.4g-h: prelim fix for GDS-less grib files
+ * 2/96  - v1.3.4i: faster missing(), -V: "pos n" -> "n" (field 2)
+ * 3/96  - v1.4: fix return code (!inventory), and short records near EOF
+ * 6/96  - v1.4.1a: faster grib->binary decode, updated ncep parameter table, mod. in clim. desc
+ * 7/96  - v1.5.0: parameter-table aware, -v option changed, added "comments"
+ *                 increased NTRY to 100 in seek_grib
+ * 11/96 - v1.5.0b: added ECMWF parameter table 128
+ * 1/97 - v1.5.0b2: if nxny != nx*ny { nx = nxny; ny = 1 }
+ * 3/97 - v1.5.0b5: added: -PDS -GDS, Lambert Conformal
+ * 3/97 - v1.5.0b6: added: -verf
+ * 4/97 - v1.5.0b7: added -PDS10, -GDS10 and enhanced -PDS -GDS
+ * 4/97 - v1.5.0b8: "bitmap missing x" -> "bitmap: x undef"
+ * 5/97 - v1.5.0b9: thinned grids meta data
+ * 5/97 - v1.5.0b10: changed 0hr fcst to anal for TR=10 and P1=P2=0
+ * 5/97 - v1.5.0b10: added -H option
+ * 6/97 - v1.5.0b12: thinned lat-long grids -V option
+ * 6/97 - v1.5.0b13: -4yr
+ * 6/97 - v1.5.0b14: fix century mark Y=100 not 0
+ * 7/97 - v1.5.0b15: add ncep opn grib table
+ * 12/97 - v1.6.1.a: made ncep_opn the default table
+ * 12/97 - v1.6.1.b: changed 03TOT to O3TOT in operational ncep table
+ * 1/98  - v1.6.2: added Arakawa E grid meta-data
+ * 1/98  - v1.6.2.1: added some mode data, Scan -> scan
+ * 4/98  - v1.6.2.4: reanalysis id code: subcenter==0 && process==180
+ * 5/98  - v1.6.2.5: fix -H code to write all of GDS
+ * 7/98  - v1.7: fix decoding bug for bitmap and no. bits > 24 (theoretical bug)
+ * 7/98  - v1.7.0.b1: add km to Mercator meta-data
+ * 5/99  - v1.7.2: bug with thinned grids & bitmaps (nxny != nx*ny)
+ * 5/99  - v1.7.3: updated NCEP opn grib table
+ * 8/99  - v1.7.3.1: updated level information
+ * 9/00  - v1.7.3.4a: check for missing grib file
+ * 2/01  - v1.7.3.5: handle data with precision greater than 31 bits
+ * 8/01  - vDWD   : added DWD GRIB tables 201, 202, 203, Helmut P. Frank
+ * 9/01  - vDWD   : added output "Triangular grid", Helmut P. Frank
+ * 9/01  - v1.7.4: merged Hemut P. Frank's changes to current wgrib source code
+ * 3/02  - vMPIfM: added support for spectral data type
+ * 4/02  - v1.8:   merge vMPIfM changes, some fixes/generalizations
+ * 10/02  - v1.8.0.1: added cptec table 254
+ * 10/02  - v1.8.0.2: no test of grib test if no gds, level 117 redone
+ * 10/02  - v1.8.0.3: update ncep_opn grib and levels
+ * 11/02  - v1.8.0.3a: updated ncep_opn and ncep table 129
+ * 9/03 - v1.8.0.4: update dwd tables (Helmut P. Frank), -dwdgrib option
+ * 9/03 - v1.8.0.5: fix scan mode and change format
+ * 10/03 - v1.8.0.7: Changes from Norwegian Met. Inst (ec tab #131, ex_ext)
+ * 10/03 - v1.8.0.8: added -ncep_ens option
+ *
+ */
+
+/*
+ * MSEEK = I/O buffer size for seek_grib
+ */
+
+#define MSEEK 1024
+#define BUFF_ALLOC0	40000
+
+
+#ifndef min
+#define min(a,b)  ((a) < (b) ? (a) : (b))
+#define max(a,b)  ((a) < (b) ? (b) : (a))
+#endif
+
+#ifndef DEF_T62_NCEP_TABLE
+#define DEF_T62_NCEP_TABLE	rean
+#endif
+enum Def_NCEP_Table def_ncep_table = DEF_T62_NCEP_TABLE;
+int minute = 0;
+int ncep_ens = 0;
+
+int main(int argc, char **argv) {
+
+    unsigned char *buffer;
+    float *array;
+    double temp, rmin, rmax;
+    int i, nx, ny, file_arg;
+    long int len_grib, pos = 0, nxny, buffer_size, n_dump, count = 1;
+    unsigned char *msg, *pds, *gds, *bms, *bds, *pointer;
+    FILE *input, *dump_file = NULL;
+    char line[200];
+    enum {BINARY, TEXT, IEEE, GRIB, NONE} output_type = NONE;
+    enum {DUMP_ALL, DUMP_RECORD, DUMP_POSITION, DUMP_LIST, INVENTORY} 
+	mode = INVENTORY;
+    enum {none, dwd, simple} header = simple;
+
+    long int dump = -1;
+    int verbose = 0, append = 0, v_time = 0, year_4 = 0, output_PDS_GDS = 0;
+    int print_GDS = 0, print_GDS10 = 0, print_PDS = 0, print_PDS10 = 0;
+    char *dump_file_name = "dump", open_parm[3];
+    int return_code = 0;
+
+    if (argc == 1) {
+	fprintf(stderr, "\nPortable Grib decoder for %s etc.\n",
+	    (def_ncep_table == opn_nowarn || def_ncep_table == opn) ?
+	    "NCEP Operations" : "NCEP/NCAR Reanalysis");
+	fprintf(stderr, "   it slices, dices    %s\n", VERSION);
+	fprintf(stderr, "   usage: %s [grib file] [options]\n\n", argv[0]);
+
+	fprintf(stderr, "Inventory/diagnostic-output selections\n");
+	fprintf(stderr, "   -s/-v                   short/verbose inventory\n");
+	fprintf(stderr, "   -V                      diagnostic output (not inventory)\n");
+	fprintf(stderr, "   (none)                  regular inventory\n");
+
+	fprintf(stderr, " Options\n");
+	fprintf(stderr, "   -PDS/-PDS10             print PDS in hex/decimal\n");
+	fprintf(stderr, "   -GDS/-GDS10             print GDS in hex/decimal\n");
+	fprintf(stderr, "   -verf                   print forecast verification time\n");
+	fprintf(stderr, "   -ncep_opn/-ncep_rean    default T62 NCEP grib table\n");
+	fprintf(stderr, "   -4yr                    print year using 4 digits\n");
+	fprintf(stderr, "   -min                    print minutes\n");
+	fprintf(stderr, "   -ncep_ens               ensemble info encoded in ncep format\n");
+
+	fprintf(stderr, "Decoding GRIB selection\n");
+	fprintf(stderr, "   -d [record number|all]  decode record number\n");
+	fprintf(stderr, "   -p [byte position]      decode record at byte position\n");
+	fprintf(stderr, "   -i                      decode controlled by stdin (inventory list)\n");
+	fprintf(stderr, "   (none)                  no decoding\n");
+
+	fprintf(stderr, " Options\n");
+	fprintf(stderr, "   -text/-ieee/-grib/-bin  convert to text/ieee/grib/bin (default)\n");
+	fprintf(stderr, "   -nh/-h                  output will have no headers/headers (default)\n");
+	fprintf(stderr, "   -dwdgrib                output dwd headers, grib (do not append)\n");
+	fprintf(stderr, "   -H                      output will include PDS and GDS (-bin/-ieee only)\n");
+	fprintf(stderr, "   -append                 append to output file\n");
+	fprintf(stderr, "   -o [file]               output file name, 'dump' is default\n");
+	exit(8);
+    }
+    file_arg = 0;
+    for (i = 1; i < argc; i++) {
+	if (strcmp(argv[i],"-PDS") == 0) {
+	    print_PDS = 1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-PDS10") == 0) {
+	    print_PDS10 = 1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-GDS") == 0) {
+	    print_GDS = 1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-GDS10") == 0) {
+	    print_GDS10 = 1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-v") == 0) {
+	    verbose = 1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-V") == 0) {
+	    verbose = 2;
+	    continue;
+	}
+	if (strcmp(argv[i],"-s") == 0) {
+	    verbose = -1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-text") == 0) {
+	    output_type = TEXT;
+	    continue;
+	}
+	if (strcmp(argv[i],"-bin") == 0) {
+	    output_type = BINARY;
+	    continue;
+	}
+	if (strcmp(argv[i],"-ieee") == 0) {
+	    output_type = IEEE;
+	    continue;
+	}
+	if (strcmp(argv[i],"-grib") == 0) {
+	    output_type = GRIB;
+	    continue;
+	}
+	if (strcmp(argv[i],"-nh") == 0) {
+	    header = none;
+	    continue;
+	}
+	if (strcmp(argv[i],"-h") == 0) {
+	    header = simple;
+	    continue;
+	}
+	if (strcmp(argv[i],"-dwdgrib") == 0) {
+	    header = dwd;
+	    output_type = GRIB;
+	    continue;
+	}
+	if (strcmp(argv[i],"-append") == 0) {
+	    append = 1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-verf") == 0) {
+	    v_time = 1;
+	    continue;
+        }
+	if (strcmp(argv[i],"-d") == 0) {
+	    if (strcmp(argv[i+1],"all") == 0) {
+	        mode = DUMP_ALL;
+	    }
+	    else {
+	        dump = atol(argv[i+1]);
+	        mode = DUMP_RECORD;
+	    }
+	    i++;
+	    if (output_type == NONE) output_type = BINARY;
+	    continue;
+	}
+	if (strcmp(argv[i],"-p") == 0) {
+	    pos = atol(argv[i+1]);
+	    i++;
+	    dump = 1;
+	    if (output_type == NONE) output_type = BINARY;
+	    mode = DUMP_POSITION;
+	    continue;
+	}
+	if (strcmp(argv[i],"-i") == 0) {
+	    if (output_type == NONE) output_type = BINARY;
+	    mode = DUMP_LIST;
+	    continue;
+	}
+	if (strcmp(argv[i],"-H") == 0) {
+	    output_PDS_GDS = 1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-NH") == 0) {
+	    output_PDS_GDS = 0;
+	    continue;
+	}
+	if (strcmp(argv[i],"-4yr") == 0) {
+	    year_4 = 1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-ncep_opn") == 0) {
+	    def_ncep_table = opn_nowarn;
+	    continue;
+	}
+	if (strcmp(argv[i],"-ncep_rean") == 0) {
+	    def_ncep_table = rean_nowarn;
+	    continue;
+	}
+	if (strcmp(argv[i],"-o") == 0) {
+	    dump_file_name = argv[i+1];
+	    i++;
+	    continue;
+	}
+	if (strcmp(argv[i],"--v") == 0) {
+	    printf("wgrib: %s\n", VERSION);
+	    exit(0);
+	}
+	if (strcmp(argv[i],"-min") == 0) {
+	    minute = 1;
+	    continue;
+	}
+	if (strcmp(argv[i],"-ncep_ens") == 0) {
+	    ncep_ens = 1;
+	    continue;
+	}
+	if (file_arg == 0) {
+	    file_arg = i;
+	}
+	else {
+	    fprintf(stderr,"argument: %s ????\n", argv[i]);
+	}
+    }
+    if (file_arg == 0) {
+	fprintf(stderr,"no GRIB file to process\n");
+	exit(8);
+    }
+    if ((input = fopen(argv[file_arg],"rb")) == NULL) {
+        fprintf(stderr,"could not open file: %s\n", argv[file_arg]);
+        exit(7);
+    }
+
+    if ((buffer = (unsigned char *) malloc(BUFF_ALLOC0)) == NULL) {
+	fprintf(stderr,"not enough memory\n");
+    }
+    buffer_size = BUFF_ALLOC0;
+
+    /* open output file */
+    if (mode != INVENTORY) {
+	open_parm[0] = append ? 'a' : 'w'; open_parm[1] = 'b'; open_parm[2] = '\0';
+	if (output_type == TEXT) open_parm[1] = '\0';
+
+	if ((dump_file = fopen(dump_file_name,open_parm)) == NULL) {
+	    fprintf(stderr,"could not open dump file\n");
+	    exit(8);
+        }
+	if (header == dwd && output_type == GRIB) wrtieee_header(0, dump_file);
+    }
+
+    /* skip dump - 1 records */
+    for (i = 1; i < dump; i++) {
+	msg = seek_grib(input, &pos, &len_grib, buffer, MSEEK);
+	if (msg == NULL) {
+	    fprintf(stderr, "ran out of data or bad file\n");
+	    exit(8);
+	}
+	pos += len_grib;
+    }
+    if (dump > 0) count += dump - 1;
+    n_dump = 0;
+
+    for (;;) {
+	if (n_dump == 1 && (mode == DUMP_RECORD || mode == DUMP_POSITION)) break;
+	if (mode == DUMP_LIST) {
+	    if (fgets(line,sizeof(line), stdin) == NULL) break;
+            line[sizeof(line) - 1] = 0;
+            if (sscanf(line,"%ld:%ld:", &count, &pos) != 2) {
+		fprintf(stderr,"bad input from stdin\n");
+                fprintf(stderr,"   %s\n", line);
+	        exit(8);
+	    }
+	}
+
+	msg = seek_grib(input, &pos, &len_grib, buffer, MSEEK);
+	if (msg == NULL) {
+	    if (mode == INVENTORY || mode == DUMP_ALL) break;
+	    fprintf(stderr,"missing GRIB record(s)\n");
+	    exit(8);
+	}
+
+        /* read all whole grib record */
+        if (len_grib + msg - buffer > buffer_size) {
+            buffer_size = len_grib + msg - buffer + 1000;
+            buffer = (unsigned char *) realloc((void *) buffer, buffer_size);
+            if (buffer == NULL) {
+                fprintf(stderr,"ran out of memory\n");
+                exit(8);
+            }
+        }
+        read_grib(input, pos, len_grib, buffer);
+
+	/* parse grib message */
+
+	msg = buffer;
+        pds = (msg + 8);
+        pointer = pds + PDS_LEN(pds);
+#ifdef DEBUG
+	printf("LEN_GRIB= 0x%x\n", len_grib);
+	printf("PDS_LEN= 0x%x: at 0x%x\n", PDS_LEN(pds),pds-msg);
+#endif
+        if (PDS_HAS_GDS(pds)) {
+            gds = pointer;
+            pointer += GDS_LEN(gds);
+#ifdef DEBUG
+	    printf("GDS_LEN= 0x%x: at 0x%x\n", GDS_LEN(gds), gds-msg);
+#endif
+        }
+        else {
+            gds = NULL;
+        }
+
+        if (PDS_HAS_BMS(pds)) {
+            bms = pointer;
+            pointer += BMS_LEN(bms);
+#ifdef DEBUG
+	    printf("BMS_LEN= 0x%x: at 0x%x\n", BMS_LEN(bms),bms-msg);
+#endif
+        }
+        else {
+            bms = NULL;
+        }
+
+        bds = pointer;
+        pointer += BDS_LEN(bds);
+#ifdef DEBUG
+	printf("BDS_LEN= 0x%x: at 0x%x\n", BDS_LEN(bds),bds-msg);
+#endif
+
+#ifdef DEBUG
+	printf("END_LEN= 0x%x: at 0x%x\n", 4,pointer-msg);
+	if (pointer-msg+4 != len_grib) {
+	    fprintf(stderr,"Len of grib message is inconsistent.\n");
+	}
+#endif
+
+        /* end section - "7777" in ascii */
+        if (pointer[0] != 0x37 || pointer[1] != 0x37 ||
+            pointer[2] != 0x37 || pointer[3] != 0x37) {
+            fprintf(stderr,"\n\n    missing end section\n");
+            fprintf(stderr, "%2x %2x %2x %2x\n", pointer[0], pointer[1], 
+		pointer[2], pointer[3]);
+#ifdef DEBUG
+	    printf("ignoring missing end section\n");
+#else
+	    exit(8);
+#endif
+        }
+
+	/* figure out size of array */
+	if (gds != NULL) {
+	    GDS_grid(gds, bds, &nx, &ny, &nxny);
+	}
+	else if (bms != NULL) {
+	    nxny = nx = BMS_nxny(bms);
+	    ny = 1;
+	}
+	else {
+	    if (BDS_NumBits(bds) == 0) {
+                nxny = nx = 1;
+                fprintf(stderr,"Missing GDS, constant record .. cannot "
+                    "determine number of data points\n");
+	    }
+	    else {
+	        nxny = nx = BDS_NValues(bds);
+	    }
+	    ny = 1;
+	}
+
+#ifdef CHECK_GRIB
+	if (gds && ! GDS_Harmonic(gds)) {
+	/* this grib check only works for simple packing */
+	/* turn off if harmonic */
+	    if (BDS_NumBits(bds) != 0) {
+	        i = BDS_NValues(bds);
+	        if (bms != NULL) {
+	            i += missing_points(BMS_bitmap(bms),nxny);
+	        }
+	        if (i != nxny) {
+	            fprintf(stderr,"grib header at record %ld: two values of nxny %ld %d\n",
+			count,nxny,i);
+		    fprintf(stderr,"   LEN %d DataStart %d UnusedBits %d #Bits %d nxny %ld\n",
+			BDS_LEN(bds), BDS_DataStart(bds),BDS_UnusedBits(bds),
+			BDS_NumBits(bds), nxny);
+		    return_code = 15;
+		    nxny = nx = i;
+		    ny = 1;
+	        }
+	    }
+ 
+        }
+#endif
+ 
+        if (verbose <= 0) {
+	    printf("%ld:%ld:d=", count, pos);
+	    PDS_date(pds,year_4,v_time);
+	    printf(":%s:", k5toa(pds));
+
+            if (verbose == 0) printf("kpds5=%d:kpds6=%d:kpds7=%d:TR=%d:P1=%d:P2=%d:TimeU=%d:",
+	        PDS_PARAM(pds),PDS_KPDS6(pds),PDS_KPDS7(pds),
+	        PDS_TimeRange(pds),PDS_P1(pds),PDS_P2(pds),
+                PDS_ForecastTimeUnit(pds));
+	    levels(PDS_KPDS6(pds), PDS_KPDS7(pds),PDS_Center(pds)); printf(":");
+	    PDStimes(PDS_TimeRange(pds),PDS_P1(pds),PDS_P2(pds),
+                PDS_ForecastTimeUnit(pds));
+	    if (PDS_Center(pds) == ECMWF) EC_ext(pds,"",":");
+	    ensemble(pds, verbose);
+	    printf("NAve=%d",PDS_NumAve(pds));
+	    if (print_PDS || print_PDS10) print_pds(pds, print_PDS, print_PDS10, verbose);
+	    if (gds && (print_GDS || print_GDS10)) print_gds(gds, print_GDS, print_GDS10, verbose);
+            printf("\n");
+       }
+       else if (verbose == 1) {
+	    printf("%ld:%ld:D=", count, pos);
+            PDS_date(pds, 1, v_time);
+	    printf(":%s:", k5toa(pds));
+	    levels(PDS_KPDS6(pds), PDS_KPDS7(pds), PDS_Center(pds)); printf(":");
+            printf("kpds=%d,%d,%d:",
+	        PDS_PARAM(pds),PDS_KPDS6(pds),PDS_KPDS7(pds));
+	    PDStimes(PDS_TimeRange(pds),PDS_P1(pds),PDS_P2(pds),
+                PDS_ForecastTimeUnit(pds));
+	    if (PDS_Center(pds) == ECMWF) EC_ext(pds,"",":");
+	    ensemble(pds, verbose);
+	    GDS_winds(gds, verbose);
+            printf("\"%s", k5_comments(pds));
+	    if (print_PDS || print_PDS10) print_pds(pds, print_PDS, print_PDS10, verbose);
+	    if (gds && (print_GDS || print_GDS10)) print_gds(gds, print_GDS, print_GDS10, verbose);
+            printf("\n");
+	}
+        else if (verbose == 2) {
+	    printf("rec %ld:%ld:date ", count, pos);
+	    PDS_date(pds, 1, v_time);
+	    printf(" %s kpds5=%d kpds6=%d kpds7=%d levels=(%d,%d) grid=%d ", 
+	        k5toa(pds), PDS_PARAM(pds), PDS_KPDS6(pds), PDS_KPDS7(pds), 
+                PDS_LEVEL1(pds), PDS_LEVEL2(pds), PDS_Grid(pds));
+	        levels(PDS_KPDS6(pds),PDS_KPDS7(pds),PDS_Center(pds));
+
+	    printf(" ");
+	    if (PDS_Center(pds) == ECMWF) EC_ext(pds,""," ");
+	    ensemble(pds, verbose);
+	    PDStimes(PDS_TimeRange(pds),PDS_P1(pds),PDS_P2(pds),
+                 PDS_ForecastTimeUnit(pds));
+	    if (bms != NULL) 
+		printf(" bitmap: %d undef", missing_points(BMS_bitmap(bms),nxny));
+            printf("\n  %s=%s\n", k5toa(pds), k5_comments(pds));
+	
+            printf("  timerange %d P1 %d P2 %d TimeU %d  nx %d ny %d GDS grid %d "
+		"num_in_ave %d missing %d\n", 
+	        PDS_TimeRange(pds),PDS_P1(pds),PDS_P2(pds), 
+                PDS_ForecastTimeUnit(pds), nx, ny, 
+                gds == NULL ? -1 : GDS_DataType(gds), 
+                PDS_NumAve(pds), PDS_NumMissing(pds));
+
+	    printf("  center %d subcenter %d process %d Table %d", 
+		PDS_Center(pds),PDS_Subcenter(pds),PDS_Model(pds),
+                PDS_Vsn(pds));
+	    GDS_winds(gds, verbose);
+	    printf("\n");
+
+	    if (gds && GDS_LatLon(gds) && nx != -1) 
+		printf("  latlon: lat  %f to %f by %f  nxny %ld\n"
+                       "          long %f to %f by %f, (%d x %d) scan %d "
+                       "mode %d bdsgrid %d\n",
+		  0.001*GDS_LatLon_La1(gds), 0.001*GDS_LatLon_La2(gds),
+		  0.001*GDS_LatLon_dy(gds), nxny, 0.001*GDS_LatLon_Lo1(gds),
+		  0.001*GDS_LatLon_Lo2(gds), 0.001*GDS_LatLon_dx(gds),
+	    	  nx, ny, GDS_LatLon_scan(gds), GDS_LatLon_mode(gds),
+		  BDS_Grid(bds));
+	    else if (gds && GDS_LatLon(gds) && nx == -1) {
+		printf("  thinned latlon: lat  %f to %f by %f  nxny %ld\n"
+                       "          long %f to %f, %ld grid pts   (%d x %d) scan %d"
+			" mode %d bdsgrid %d\n",
+		  0.001*GDS_LatLon_La1(gds), 0.001*GDS_LatLon_La2(gds),
+		  0.001*GDS_LatLon_dy(gds), nxny, 0.001*GDS_LatLon_Lo1(gds),
+		  0.001*GDS_LatLon_Lo2(gds),
+	    	  nxny, nx, ny, GDS_LatLon_scan(gds), GDS_LatLon_mode(gds),
+		  BDS_Grid(bds));
+		  GDS_prt_thin_lon(gds);
+	    }
+	    else if (gds && GDS_Gaussian(gds) && nx != -1)
+		printf("  gaussian: lat  %f to %f\n"
+                       "            long %f to %f by %f, (%d x %d) scan %d"
+			" mode %d bdsgrid %d\n",
+		  0.001*GDS_LatLon_La1(gds), 0.001*GDS_LatLon_La2(gds),
+		  0.001*GDS_LatLon_Lo1(gds), 0.001*GDS_LatLon_Lo2(gds), 
+		  0.001*GDS_LatLon_dx(gds),
+	    	  nx, ny, GDS_LatLon_scan(gds), GDS_LatLon_mode(gds),
+		  BDS_Grid(bds));
+	    else if (gds && GDS_Gaussian(gds) && nx == -1) {
+		printf("  thinned gaussian: lat  %f to %f\n"
+                       "     lon %f   %ld grid pts   (%d x %d) scan %d"
+			" mode %d bdsgrid %d  nlat:\n",
+		  0.001*GDS_LatLon_La1(gds), 0.001*GDS_LatLon_La2(gds),
+		  0.001*GDS_LatLon_Lo1(gds),
+	    	  nxny, nx, ny, GDS_LatLon_scan(gds), GDS_LatLon_mode(gds),
+		  BDS_Grid(bds));
+		  GDS_prt_thin_lon(gds);
+	    }
+	    else if (gds && GDS_Polar(gds))
+		printf("  polar stereo: Lat1 %f Long1 %f Orient %f\n"
+			"     %s pole (%d x %d) Dx %d Dy %d scan %d mode %d\n",
+		    0.001*GDS_Polar_La1(gds),0.001*GDS_Polar_Lo1(gds),
+		    0.001*GDS_Polar_Lov(gds),
+		    GDS_Polar_pole(gds) == 0 ? "north" : "south", nx,ny,
+		    GDS_Polar_Dx(gds),GDS_Polar_Dy(gds),
+		    GDS_Polar_scan(gds), GDS_Polar_mode(gds));
+	    else if (gds && GDS_Lambert(gds))
+		printf("  Lambert Conf: Lat1 %f Lon1 %f Lov %f\n"
+                       "      Latin1 %f Latin2 %f LatSP %f LonSP %f\n"
+                       "      %s (%d x %d) Dx %f Dy %f scan %d mode %d\n",
+                     0.001*GDS_Lambert_La1(gds),0.001*GDS_Lambert_Lo1(gds),
+                     0.001*GDS_Lambert_Lov(gds),
+                     0.001*GDS_Lambert_Latin1(gds), 0.001*GDS_Lambert_Latin2(gds),
+                     0.001*GDS_Lambert_LatSP(gds), 0.001*GDS_Lambert_LonSP(gds),
+                      GDS_Lambert_NP(gds) ? "North Pole": "South Pole",
+                     GDS_Lambert_nx(gds), GDS_Lambert_ny(gds),
+                     0.001*GDS_Lambert_dx(gds), 0.001*GDS_Lambert_dy(gds),
+                     GDS_Lambert_scan(gds), GDS_Lambert_mode(gds));
+	    else if (gds && GDS_Mercator(gds))
+		printf("  Mercator: lat  %f to %f by %f km  nxny %ld\n"
+                       "          long %f to %f by %f km, (%d x %d) scan %d"
+			" mode %d Latin %f bdsgrid %d\n",
+		  0.001*GDS_Merc_La1(gds), 0.001*GDS_Merc_La2(gds),
+		  0.001*GDS_Merc_dy(gds), nxny, 0.001*GDS_Merc_Lo1(gds),
+		  0.001*GDS_Merc_Lo2(gds), 0.001*GDS_Merc_dx(gds),
+	    	  nx, ny, GDS_Merc_scan(gds), GDS_Merc_mode(gds), 
+		  0.001*GDS_Merc_Latin(gds), BDS_Grid(bds));
+	    else if (gds && GDS_ssEgrid(gds))
+		printf("  Semi-staggered Arakawa E-Grid: lat0 %f lon0 %f nxny %d\n"
+                       "    dLat %f dLon %f (%d x %d) scan %d mode %d\n",
+		  0.001*GDS_ssEgrid_La1(gds), 0.001*GDS_ssEgrid_Lo1(gds), 
+                  GDS_ssEgrid_n(gds)*GDS_ssEgrid_n_dum(gds), 
+                  0.001*GDS_ssEgrid_dj(gds), 0.001*GDS_ssEgrid_di(gds), 
+                  GDS_ssEgrid_Lo2(gds), GDS_ssEgrid_La2(gds),
+                  GDS_ssEgrid_scan(gds), GDS_ssEgrid_mode(gds));
+            else if (gds && GDS_ss2dEgrid(gds))
+                printf("  Semi-staggered Arakawa E-Grid (2D): lat0 %f lon0 %f nxny %d\n"
+                       "    dLat %f dLon %f (tlm0d %f tph0d %f) scan %d mode %d\n",
+                   0.001*GDS_ss2dEgrid_La1(gds), 0.001*GDS_ss2dEgrid_Lo1(gds),
+                   GDS_ss2dEgrid_nx(gds)*GDS_ss2dEgrid_ny(gds),
+                   0.001*GDS_ss2dEgrid_dj(gds), 0.001*GDS_ss2dEgrid_di(gds),
+                   0.001*GDS_ss2dEgrid_Lo2(gds), 0.001*GDS_ss2dEgrid_La2(gds),
+                   GDS_ss2dEgrid_scan(gds), GDS_ss2dEgrid_mode(gds));
+	    else if (gds && GDS_fEgrid(gds)) 
+		printf("  filled Arakawa E-Grid: lat0 %f lon0 %f nxny %d\n"
+                       "    dLat %f dLon %f (%d x %d) scan %d mode %d\n",
+		  0.001*GDS_fEgrid_La1(gds), 0.001*GDS_fEgrid_Lo1(gds), 
+                  GDS_fEgrid_n(gds)*GDS_fEgrid_n_dum(gds), 
+                  0.001*GDS_fEgrid_dj(gds), 0.001*GDS_fEgrid_di(gds), 
+                  GDS_fEgrid_Lo2(gds), GDS_fEgrid_La2(gds),
+                  GDS_fEgrid_scan(gds), GDS_fEgrid_mode(gds));
+	    else if (gds && GDS_RotLL(gds))
+		printf("  rotated LatLon grid  lat %f to %f  lon %f to %f\n"
+		       "    nxny %ld  (%d x %d)  dx %d dy %d  scan %d  mode %d\n"
+		       "    transform: south pole lat %f lon %f  rot angle %f\n", 
+		   0.001*GDS_RotLL_La1(gds), 0.001*GDS_RotLL_La2(gds), 
+		   0.001*GDS_RotLL_Lo1(gds), 0.001*GDS_RotLL_Lo2(gds),
+		   nxny, GDS_RotLL_nx(gds), GDS_RotLL_ny(gds),
+		   GDS_RotLL_dx(gds), GDS_RotLL_dy(gds),
+		   GDS_RotLL_scan(gds), GDS_RotLL_mode(gds),
+		   0.001*GDS_RotLL_LaSP(gds), 0.001*GDS_RotLL_LoSP(gds),
+		   GDS_RotLL_RotAng(gds) );
+	    else if (gds && GDS_Gnomonic(gds))
+		printf("  Gnomonic grid\n");
+	    else if (gds && GDS_Harmonic(gds))
+		printf("  Harmonic (spectral):  pentagonal spectral truncation: nj %d nk %d nm %d\n",
+		       GDS_Harmonic_nj(gds), GDS_Harmonic_nk(gds),
+		       GDS_Harmonic_nm(gds));
+		if (gds && GDS_Harmonic_type(gds) == 1)
+		  printf("  Associated Legendre polynomials\n");
+            else if (gds && GDS_Triangular(gds))
+                printf("  Triangular grid:  nd %d ni %d (= 2^%d x 3^%d)\n",
+		    GDS_Triangular_nd(gds), GDS_Triangular_ni(gds), 
+                    GDS_Triangular_ni2(gds), GDS_Triangular_ni3(gds) );
+	    if (print_PDS || print_PDS10) 
+                print_pds(pds, print_PDS, print_PDS10, verbose);
+	    if (gds && (print_GDS || print_GDS10)) 
+                 print_gds(gds, print_GDS, print_GDS10, verbose);
+	}
+
+	if (mode != INVENTORY && output_type == GRIB) {
+	    if (header == dwd) wrtieee_header((int) len_grib, dump_file);
+	    fwrite((void *) msg, sizeof(char), len_grib, dump_file);
+	    if (header == dwd) wrtieee_header((int) len_grib, dump_file);
+	    n_dump++;
+	}
+
+	if ((mode != INVENTORY && output_type != GRIB) || verbose > 1) {
+	    /* decode numeric data */
+ 
+            if ((array = (float *) malloc(sizeof(float) * nxny)) == NULL) {
+                fprintf(stderr,"memory problems\n");
+                exit(8);
+            }
+
+	    temp = int_power(10.0, - PDS_DecimalScale(pds));
+
+ 	    BDS_unpack(array, bds, BMS_bitmap(bms), BDS_NumBits(bds), nxny,
+			   temp*BDS_RefValue(bds),temp*int_power(2.0, BDS_BinScale(bds)));
+
+	    if (verbose > 1) {
+		rmin = FLT_MAX;
+		rmax = -FLT_MAX;
+	        for (i = 0; i < nxny; i++) {
+		    if (fabs(array[i]-UNDEFINED) > 0.0001*UNDEFINED) {
+	                rmin = min(rmin,array[i]);
+	                rmax = max(rmax,array[i]);
+		    }
+	        }
+	        printf("  min/max data %g %g  num bits %d "
+			" BDS_Ref %g  DecScale %d BinScale %d\n", 
+		    rmin, rmax, BDS_NumBits(bds), BDS_RefValue(bds),
+		    PDS_DecimalScale(pds), BDS_BinScale(bds));
+	    }
+
+	    if (mode != INVENTORY && output_type != GRIB) {
+		/* dump code */
+		if (output_PDS_GDS == 1) {
+		    /* insert code here */
+	            if (output_type == BINARY || output_type == IEEE) {
+			/* write PDS */
+			i = PDS_LEN(pds) + 4;
+	                if (header == simple && output_type == BINARY) 
+				fwrite((void *) &i, sizeof(int), 1, dump_file);
+	                if (header == simple && output_type == IEEE) wrtieee_header(i, dump_file);
+	                fwrite((void *) "PDS ", 1, 4, dump_file);
+	                fwrite((void *) pds, 1, i - 4, dump_file);
+	                if (header == simple && output_type == BINARY) 
+				fwrite((void *) &i, sizeof(int), 1, dump_file);
+	                if (header == simple && output_type == IEEE) wrtieee_header(i, dump_file);
+
+			/* write GDS */
+			i = (gds) ?  GDS_LEN(gds) + 4 : 4;
+	                if (header == simple && output_type == BINARY) 
+				fwrite((void *) &i, sizeof(int), 1, dump_file);
+	                if (header == simple && output_type == IEEE) wrtieee_header(i, dump_file);
+	                fwrite((void *) "GDS ", 1, 4, dump_file);
+	                if (gds) fwrite((void *) gds, 1, i - 4, dump_file);
+	                if (header == simple && output_type == BINARY) 
+				fwrite((void *) &i, sizeof(int), 1, dump_file);
+	                if (header == simple && output_type == IEEE) wrtieee_header(i, dump_file);
+		    }
+		} 
+
+	        if (output_type == BINARY) {
+	            i = nxny * sizeof(float);
+	            if (header == simple) fwrite((void *) &i, sizeof(int), 1, dump_file);
+	            fwrite((void *) array, sizeof(float), nxny, dump_file);
+	            if (header == simple) fwrite((void *) &i, sizeof(int), 1, dump_file);
+	        }
+		else if (output_type == IEEE) {
+		    wrtieee(array, nxny, header, dump_file);
+		}
+	        else if (output_type == TEXT) {
+	            /* number of points in grid */
+	            if (header == simple) {
+		        if (nx <= 0 || ny <= 0 || nxny != nx*ny) {
+                            fprintf(dump_file, "%ld %d\n", nxny, 1);
+			}
+			else {
+			    fprintf(dump_file, "%d %d\n", nx, ny);
+			}
+		    }
+	            for (i = 0; i < nxny; i++) {
+		        fprintf(dump_file,"%g\n", array[i]);
+		    }
+	        }
+	        n_dump++;
+	    }
+	    free(array);
+	    if (verbose > 0) printf("\n");
+	}
+	    
+        pos += len_grib;
+        count++;
+    }
+
+    if (mode != INVENTORY) {
+	if (header == dwd && output_type == GRIB) wrtieee_header(0, dump_file);
+	if (ferror(dump_file)) {
+		fprintf(stderr,"error writing %s\n",dump_file_name);
+		exit(8);
+	}
+    }
+    fclose(input);
+    return (return_code);
+}
+
+void print_pds(unsigned char *pds, int print_PDS, int print_PDS10, int verbose) {
+    int i, j;
+
+    j = PDS_LEN(pds);
+    if (verbose < 2) {
+        if (print_PDS && verbose < 2) {
+            printf(":PDS=");
+            for (i = 0; i < j; i++) {
+                printf("%2.2x", (int) pds[i]);
+            }
+        }
+        if (print_PDS10 && verbose < 2) {
+            printf(":PDS10=");
+            for (i = 0; i < j; i++) {
+                printf(" %d", (int) pds[i]);
+            }
+        }
+    }
+    else {
+        if (print_PDS) {
+            printf("  PDS(1..%d)=",j);
+            for (i = 0; i < j; i++) {
+                if (i % 20 == 0) printf("\n    %4d:",i+1);
+                printf(" %3.2x", (int) pds[i]);
+            }
+            printf("\n");
+        }
+        if (print_PDS10) {
+            printf("  PDS10(1..%d)=",j);
+            for (i = 0; i < j; i++) {
+                if (i % 20 == 0) printf("\n    %4d:",i+1);
+                printf(" %3d", (int) pds[i]);
+            }
+            printf("\n");
+        }
+    }
+}
+
+void print_gds(unsigned char *gds, int print_GDS, int print_GDS10, int verbose) {
+    int i, j;
+
+    j = GDS_LEN(gds);
+    if (verbose < 2) {
+        if (print_GDS && verbose < 2) {
+            printf(":GDS=");
+            for (i = 0; i < j; i++) {
+                printf("%2.2x", (int) gds[i]);
+            }
+        }
+        if (print_GDS10 && verbose < 2) {
+            printf(":GDS10=");
+            for (i = 0; i < j; i++) {
+                printf(" %d", (int) gds[i]);
+            }
+        }
+    }
+    else {
+        if (print_GDS) {
+            printf("  GDS(1..%d)=",j);
+            for (i = 0; i < j; i++) {
+                if (i % 20 == 0) printf("\n    %4d:",i+1);
+                printf(" %3.2x", (int) gds[i]);
+            }
+            printf("\n");
+        }
+        if (print_GDS10) {
+            printf("  GDS10(1..%d)=",j);
+            for (i = 0; i < j; i++) {
+                if (i % 20 == 0) printf("\n    %4d:",i+1);
+                printf(" %3d", (int) gds[i]);
+            }
+            printf("\n");
+        }
+    }
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/wrtieee.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/wrtieee.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/WGRIB/wrtieee.c	(revision 2744)
@@ -0,0 +1,82 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include "grib.h"
+
+
+/* wesley ebisuzaki v1.3
+ *
+ * write ieee file -- big endian format
+ *
+ * input float *array		data to be written
+ *	 int n			size of array
+ *	 int header		1 for f77 style header 0 for none
+ *				(header is 4 byte header
+ *	 FILE *output		output file
+ *
+ * v1.2 7/97 buffered, faster
+ * v1.3 2/99 fixed (typo) error in wrtieee_header found by
+ *     Bob Farquhar
+ */
+
+#define BSIZ 1024*4
+
+int wrtieee(float *array, int n, int header, FILE *output) {
+
+	unsigned long int l;
+	int i, nbuf;
+	unsigned char buff[BSIZ];
+	unsigned char h4[4];
+
+	nbuf = 0;
+	if (header) {
+		l = n * 4;
+		for (i = 0; i < 4; i++) {
+			h4[i] = l & 255;
+			l >>= 8;
+		}
+		buff[nbuf++] = h4[3];
+		buff[nbuf++] = h4[2];
+		buff[nbuf++] = h4[1];
+		buff[nbuf++] = h4[0];
+	}
+	for (i = 0; i < n; i++) {
+		if (nbuf >= BSIZ) {
+		    fwrite(buff, 1, BSIZ, output);
+		    nbuf = 0;
+		}
+		flt2ieee(array[i], buff + nbuf);
+		nbuf += 4;
+	}
+	if (header) {
+		if (nbuf == BSIZ) {
+		    fwrite(buff, 1, BSIZ, output);
+		    nbuf = 0;
+		}
+		buff[nbuf++] = h4[3];
+		buff[nbuf++] = h4[2];
+		buff[nbuf++] = h4[1];
+		buff[nbuf++] = h4[0];
+	}
+	if (nbuf) fwrite(buff, 1, nbuf, output);
+	return 0;
+}
+
+/* write a big-endian 4 byte integer .. f77 IEEE  header */
+
+int wrtieee_header(unsigned int n, FILE *output) {
+	unsigned h4[4];
+
+	h4[0] = n & 255;
+	h4[1] = (n >> 8) & 255;
+	h4[2] = (n >> 16) & 255;
+	h4[3] = (n >> 24) & 255;
+
+	putc(h4[3],output);
+	putc(h4[2],output);
+	putc(h4[1],output);
+	putc(h4[0],output);
+
+	return 0;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/diffwrf
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/diffwrf	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/diffwrf	(revision 2744)
@@ -0,0 +1,35 @@
+#!/bin/csh
+
+if ( ${#argv} != 2 ) then
+	echo usage: diffwrf gribfile1 gribfile2
+	exit ( 1 )
+endif
+
+set file1 = $1
+set file2 = $2
+	
+if ( -e fort.88 ) rm fort.88 
+if ( -e fort.98 ) rm fort.98 
+
+if ( -e outfile1 ) rm outfile1
+if ( -e outfile2 ) rm outfile2
+
+if ( ( ! -e $file1 ) || ( ! -e $file2 ) ) then
+	touch fort.88
+	exit ( 0 ) 
+endif
+
+../../external/io_grib1/wgrib -s $file1 | ../../external/io_grib1/wgrib -s -i -o outfile1 $file1 >& /dev/null
+../../external/io_grib1/wgrib -s $file2 | ../../external/io_grib1/wgrib -s -i -o outfile2 $file2 >& /dev/null
+
+cmp outfile1 outfile2
+
+set ok = $status
+
+if ( $ok == 0 ) then
+	
+else
+	touch fort.88
+endif
+
+exit ( 0 ) 
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_routines.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_routines.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_routines.c	(revision 2744)
@@ -0,0 +1,1280 @@
+/*
+****************************************************************************
+*
+*  Routines for indexing, reading and writing grib files.  Routines
+*    are designed to be called by Fortran.
+*
+*  All routines return 0 for success, 1 for failure, unless otherwise noted. 
+*
+*  Todd Hutchinson
+*  WSI
+*  05/17/2005
+*
+****************************************************************************
+*/
+
+#include "grib1_routines.h"
+#include "gridnav.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <limits.h>
+
+char *trim (char *str);
+int index_metadata(GribInfo *gribinfo, MetaData *metadata, int fid);
+int index_times(GribInfo *gribinfo, Times *times);
+int find_time(Times *times, char valid_time[15]);
+int get_gridnav_projection(int wrf_projection);
+int get_byte(int input_int, int bytenum);
+
+/* 
+ * Allocate space for the fileindex structure
+ */
+
+int ALLOC_INDEX_FILE(FileIndex *fileindex)
+{
+  int status = 0;
+  
+  fileindex->gribinfo = (GribInfo *)malloc(sizeof(GribInfo));
+  if (fileindex->gribinfo == NULL) {
+    fprintf(stderr,"Allocating fileindex->gribinfo failed.\n");
+    status = 1;
+    return status;
+  }
+  
+  fileindex->metadata = (MetaData *)malloc(sizeof(MetaData));
+  if (fileindex->metadata == NULL) {
+    fprintf(stderr,"Allocating fileindex->metadata failed.\n");
+    status = 1;
+    return status;
+  }
+  fileindex->metadata->elements = NULL;
+  
+  fileindex->times = (Times *)malloc(sizeof(Times));
+  if (fileindex->times == NULL) {
+    fprintf(stderr,"Allocating fileindex->times failed.\n");
+    status = 1;
+    return status;
+  }
+  fileindex->times->elements = NULL;
+  
+  return status;
+}
+
+
+void FREE_INDEX_FILE(FileIndex *fileindex)
+{
+  int status = 0;
+  
+  rg_free_gribinfo_elements(fileindex->gribinfo);
+  free(fileindex->gribinfo);
+
+  free(fileindex->metadata->elements);
+  free(fileindex->metadata);
+
+  free(fileindex->times->elements);
+  free(fileindex->times);
+
+}
+
+
+int INDEX_FILE(int *fid, FileIndex *fileindex)
+{
+
+  int status;
+  /* Index the grib records */
+
+  status = rg_setup_gribinfo_i(fileindex->gribinfo,*fid,1);
+  if (status < 0) {
+    fprintf(stderr,"Error setting up gribinfo structure.\n");
+    return 1;
+  }
+
+  /* Index the metadata section */
+
+  status = index_metadata(fileindex->gribinfo, fileindex->metadata, *fid);
+  if (status != 0) {
+    fprintf(stderr,"Error setting up metadata structure.\n");
+    return 1;
+  }
+
+  /* Setup a list of times based on times in grib records */
+
+  status = index_times(fileindex->gribinfo, fileindex->times);
+  if (status != 0) {
+    fprintf(stderr,"Error indexing times in grib file.\n");
+    return 1;
+  }
+  
+  return 0;
+}
+
+
+int GET_FILEINDEX_SIZE(int *size)
+{
+  *size = sizeof(FileIndex);
+  return *size;
+}
+
+
+int GET_NUM_TIMES(FileIndex *fileindex, int *numtimes)
+{
+  *numtimes = (fileindex->times)->num_elements;
+  return *numtimes;
+}
+
+
+int GET_TIME(FileIndex *fileindex, int *idx, char time[])
+{
+  int num_times;
+  int year, month, day, minute, hour, second;
+  char time2[100];
+
+  num_times = GET_NUM_TIMES(fileindex,&num_times);
+  if (*idx > num_times) 
+    {
+      fprintf(stderr,"Tried to get time %d, but only %d times exist\n",
+	      *idx, num_times);
+      return 1;
+    }
+
+  strcpy(time,fileindex->times->elements[*idx-1].valid_time);
+  
+  /* Reformat time to meet WRF time format */
+
+  sscanf(time, "%4d%2d%2d%2d%2d%2d", 
+	 &year, &month, &day, &hour, &minute, &second);
+  sprintf(time2, "%04d-%02d-%02d_%02d:%02d:%02d", 
+	  year, month, day, hour, minute, second);
+  strncpy(time,time2,19);
+
+  return 0;
+}
+
+
+int GET_LEVEL1(FileIndex *fileindex, int *idx, int *level1)
+{
+
+  *level1 = (fileindex->gribinfo)->elements[*idx].usHeight1;
+
+  return *level1;
+
+}
+
+
+int GET_LEVEL2(FileIndex *fileindex, int *idx, int *level2)
+{
+
+  *level2 = (fileindex->gribinfo)->elements[*idx].usHeight2;
+
+  return *level2;
+
+}
+
+
+int index_metadata(GribInfo *gribinfo, MetaData *metadata, int fid)
+{
+  int status=0;
+  int end;
+  char string[11];
+  int found_metadata=0;
+  int idx;
+  int pos;
+  int fileend;
+  int seekpos;
+  int bytesread;
+  char line[1000];
+  char element[100],datestr[100],varname[100];
+  char value[1000];
+  int incomment;
+  int charidx;
+  int elemidx=0;
+  FILE *stream;
+
+
+  /* Associate a FILE *stream with the file id */
+  stream = fdopen(fid,"r");
+  if (stream == NULL) 
+    {
+      perror("Error associating stream with file descriptor");
+      status = -1;
+      return status;
+    }
+  
+  /* 
+   * First, set the position to end of grib data (the 
+   *   metadata section comes after the grib data).
+   */
+  idx = rg_num_elements(gribinfo) - 1;
+  end = rg_get_end(gribinfo,idx);
+  pos = end + 1;
+  fileend = lseek(fid,0,SEEK_END);
+
+  /*
+   * Now, start searching for metadata 
+   */
+  while (pos < (fileend - 10))
+    {
+      seekpos = pos;
+      pos = lseek(fid,seekpos,SEEK_SET);
+      if (pos != seekpos) 
+	{
+	  fprintf(stderr,"Error seeking %d bytes in file\n",end);
+	  perror("");
+	  return 1;
+	}
+
+      bytesread = read(fid,string,10);
+      if (bytesread != 10) 
+	{
+	  fprintf(stderr,"Invalid read, pos: %d :\n",pos);
+	  perror("");
+	  pos += 1;
+	  continue;
+	}
+
+      if (strncmp(string,"<METADATA>",10) == 0) 
+	{
+	  /* We found it, so break out ! */
+	  found_metadata = 1;
+	  break;
+	}
+      pos += 1;
+    }
+
+
+  /* Now, read metadata, line by line */
+  incomment = 0;
+  while(fgets(line,1000,stream) != NULL)
+    {
+      trim(line);
+
+      /* Set comment flag, if we found a comment */
+      if (strncmp(line,"<!--",4) == 0)
+	{
+	  incomment = 1;
+	  strcpy(line,line+4);
+	}
+      
+      /* Search for end of comment */
+      if (incomment)
+	{
+	  charidx = 0;
+	  while (charidx < strlen(line)) 
+	    {
+	      
+	      if (strncmp(line+charidx,"-->",3) == 0)
+		{
+		  strcpy(line,line+charidx+3);
+		  incomment = 0;
+		  break;
+		}
+	      else
+		{
+		  charidx++;
+		}
+	    }
+	}
+
+      if (incomment) continue;
+  
+
+      /* Check for end of metadata */
+      if (strncmp(line,"</METADATA>",11) == 0) 
+	{
+	  /* We found end of data, so, break out */
+	  break;
+	}
+
+      /* Skip blank lines */
+      if (strlen(line) == 0) continue;
+
+
+      /* Parse line */
+      trim(line);
+      strcpy(element,"none");
+      strcpy(datestr,"none");
+      strcpy(varname,"none");
+      strcpy(value,"none");
+      if (sscanf(line,"%[^;=];%[^;=];%[^;=]=%[^\n]",varname,datestr,
+		 element,value) == 4)
+	{
+	}
+      else if (sscanf(line,"%[^;=];%[^;=]=%[^\n]",datestr,element,value) == 3)
+	{
+	  strcpy(varname,"none");
+	}
+      else if (sscanf(line,"%[^;=]=%[^\n]",element,value) == 2)
+	{
+	  strcpy(varname,"none");
+	  strcpy(datestr,"none");
+	}
+      else 
+	{
+	  strcpy(varname,"none");
+	  strcpy(datestr,"none");
+	  strcpy(element,"none");
+	  strcpy(value,"none");
+	  fprintf(stderr,"Invalid line in metadata: \n%s",line);
+	}
+
+      trim(varname);
+      trim(datestr);
+      trim(element);
+      trim(value);
+
+      metadata->elements = 
+	(MetaData_Elements *)realloc( metadata->elements, 
+				     (elemidx+1)*sizeof(MetaData_Elements) );
+      strcpy(metadata->elements[elemidx].VarName,varname);
+      strcpy(metadata->elements[elemidx].DateStr,datestr);
+      strcpy(metadata->elements[elemidx].Element,element);
+      strcpy(metadata->elements[elemidx].Value,value);
+
+      elemidx++;
+	
+    }
+
+  metadata->num_elements = elemidx;
+  
+  return 0;
+}
+
+
+
+
+int index_times(GribInfo *gribinfo, Times *times)
+{
+  int idx;
+  int status;
+  int numtimes=0;
+  int date;
+  char valid_time[15];
+  char tmp[15];
+  int swapped;
+
+  times->num_elements = 0;
+
+  /* Loop through elements, and build list of times */
+
+  for (idx=0; idx < gribinfo->num_elements; idx++) 
+    {
+      /* Calculate valid time */
+      status = rg_get_valid_time(gribinfo,idx,valid_time);
+      if (status != 0) 
+	{
+	  fprintf(stderr,"Could not retrieve valid time for index: %d\n",idx);
+	  continue;
+	}
+
+      /* 
+       * Check if this time is already contained in times
+       *  If not, allocate space for it, and add it to list 
+       */
+      if (find_time(times,valid_time) < 0) 
+	{
+	  times->num_elements++;
+	  times->elements = 
+	    (Times_Elements *)
+	    realloc(times->elements,times->num_elements*sizeof(Times_Elements));
+	  if (times->elements == NULL) 
+	    {
+	      fprintf(stderr,"Allocating times->elements failed.\n");
+	      status = 1;
+	      return status;
+	    }
+	  strcpy(times->elements[times->num_elements - 1].valid_time,valid_time);
+	}
+    }
+
+  /* Sort times */
+  swapped = 1;
+  while (swapped)
+    {
+      swapped=0;
+      for (idx=1; idx < times->num_elements; idx++) 
+	{
+	  if (strcmp(times->elements[idx-1].valid_time,
+		     times->elements[idx].valid_time) > 0)
+	    {
+	      strcpy(tmp,times->elements[idx-1].valid_time);
+	      strcpy(times->elements[idx-1].valid_time,
+		     times->elements[idx].valid_time);
+	      strcpy(times->elements[idx].valid_time, tmp);
+	      swapped = 1;
+	    }
+	}
+    }
+
+  return 0;
+}
+
+
+
+int find_time(Times *times, char valid_time[15])
+{
+  int idx;
+  int found_elem = -1;
+
+  for (idx = 0; idx < times->num_elements; idx++) 
+    {
+      if (strcmp(times->elements[idx].valid_time,valid_time) == 0) 
+	{
+	  found_elem = idx;
+	  break;
+	}
+    }
+
+  return found_elem;
+
+}
+
+
+int GET_METADATA_VALUE(FileIndex *fileindex, char ElementIn[], 
+		       char DateStrIn[], char VarNameIn[], char Value[], 
+		       int *stat, int strlen1, int strlen2, int strlen3, 
+		       int strlen4, int strlen5)
+{
+  int elemidx;
+  int elemnum;
+  char VarName[200];
+  char DateStr[200];
+  char Element[200];
+  int Value_Len;
+
+  *stat = 0;
+
+  strncpy(Element,ElementIn,strlen2);
+  Element[strlen2] = '\0';
+  strncpy(DateStr,DateStrIn,strlen3);
+  DateStr[strlen3] = '\0';
+  strncpy(VarName,VarNameIn,strlen4);
+  VarName[strlen4] = '\0';
+  Value_Len = strlen5;
+
+  elemnum = -1;
+  for (elemidx = 0; elemidx < fileindex->metadata->num_elements; elemidx++)
+    {
+      if (strcmp(Element,fileindex->metadata->elements[elemidx].Element) == 0)
+	{
+	  if (strcmp(DateStr,fileindex->metadata->elements[elemidx].DateStr) 
+	      == 0)
+	    {
+	      if (strcmp(VarName,
+			 fileindex->metadata->elements[elemidx].VarName) == 0)
+		{
+		  elemnum = elemidx;
+		  break;
+		}
+	    }
+	}
+    }
+
+  if (elemnum != -1)
+    {
+      strncpy(Value, fileindex->metadata->elements[elemnum].Value, Value_Len);
+    } 
+  else
+    {
+      strncpy(Value, "none", Value_Len);
+      *stat = 1;
+    }
+
+  /* 
+   * Pad end of string with one space.  This allows Fortran internal
+   *   read function to work properly.
+   */
+  if (strlen(Value) < Value_Len) 
+    {
+      strcpy(Value + strlen(Value), " ");
+    }
+
+  return elemidx;
+}
+
+
+int GET_GRIB_INDEX(FileIndex *fileindex, int *center, int *subcenter, 
+		   int *parmtbl, int *parmid, char DateStrIn[], 
+		   int *leveltype, int *level1, int *level2, int *fcsttime1,
+		   int *fcsttime2, int *index, int strlen1, int strlen2)
+{
+  char DateStr[1000];
+  FindGrib findgrib;
+
+  strncpy(DateStr,DateStrIn,strlen2);
+  DateStr[strlen2] = '\0';
+  grib_time_format(DateStr,DateStr);
+
+  rg_init_findgrib(&findgrib);
+
+  strncpy(findgrib.initdate,DateStrIn,strlen2);
+  findgrib.initdate[strlen2] = '\0';
+  findgrib.parmid          = *parmid;
+  findgrib.leveltype       = *leveltype;
+  findgrib.level1          = *level1;
+  findgrib.level2          = *level2;
+  findgrib.fcsttime1       = *fcsttime1;
+  findgrib.fcsttime2       = *fcsttime2;
+  findgrib.center_id       = *center;
+  findgrib.subcenter_id    = *subcenter;
+  findgrib.parmtbl_version = *parmtbl;
+  
+  *index = rg_get_index(fileindex->gribinfo, &findgrib);
+
+  return *index;
+
+}
+
+
+int GET_GRIB_INDEX_GUESS(FileIndex *fileindex, int *center, int *subcenter, 
+			 int *parmtbl, int *parmid, char DateStrIn[], 
+			 int *leveltype, int *level1, int *level2, 
+			 int *fcsttime1,int *fcsttime2, int *guessidx, 
+			 int *index, int strlen1, int strlen2)
+{
+  char DateStr[1000];
+  FindGrib findgrib;
+
+  strncpy(DateStr,DateStrIn,strlen2);
+  DateStr[strlen2] = '\0';
+  grib_time_format(DateStr,DateStr);
+
+  rg_init_findgrib(&findgrib);
+
+  strncpy(findgrib.initdate,DateStrIn,strlen2);
+  findgrib.initdate[strlen2] = '\0';
+  findgrib.parmid          = *parmid;
+  findgrib.leveltype       = *leveltype;
+  findgrib.level1          = *level1;
+  findgrib.level2          = *level2;
+  findgrib.fcsttime1       = *fcsttime1;
+  findgrib.fcsttime2       = *fcsttime2;
+  findgrib.center_id       = *center;
+  findgrib.subcenter_id    = *subcenter;
+  findgrib.parmtbl_version = *parmtbl;
+  
+  *index = rg_get_index_guess(fileindex->gribinfo, &findgrib, *guessidx);
+
+  return *index;
+
+}
+
+
+int GET_GRIB_CENTER(FileIndex *fileindex, int *parmid, int *center)
+{
+
+  *center = rg_get_center_id(fileindex->gribinfo,*parmid);
+
+  return *center;
+
+}
+
+
+int GET_GRIB_SUBCENTER(FileIndex *fileindex, int *parmid, int *subcenter)
+{
+
+  *subcenter = rg_get_subcenter_id(fileindex->gribinfo,*parmid);
+
+  return *subcenter;
+
+}
+
+
+int GET_GRIB_TBLVERSION(FileIndex *fileindex, int *parmid, int *parmtbl)
+{
+
+  *parmtbl = rg_get_parmtbl(fileindex->gribinfo,*parmid);
+
+  return *parmtbl;
+
+}
+
+
+int GET_GRIB_PROCID(FileIndex *fileindex, int *parmid, int *proc_id)
+{
+
+  *proc_id = rg_get_proc_id(fileindex->gribinfo,*parmid);
+
+  return *proc_id;
+
+}
+
+
+int GET_GRIB_INDEX_VALIDTIME(FileIndex *fileindex, int *center, 
+		   int *subcenter, int *parmtbl, int *parmid, 
+		   char DateStrIn[], int *leveltype, int *level1, int *level2,
+		   int *index, int strlen1, int strlen2)
+{
+  char DateStr[1000];
+  FindGrib findgrib;
+
+  strncpy(DateStr,DateStrIn,strlen2);
+  DateStr[strlen2] = '\0';
+  grib_time_format(DateStr,DateStr);
+
+  rg_init_findgrib(&findgrib);
+
+  strncpy(findgrib.validdate,DateStr,strlen2);
+  findgrib.initdate[strlen2] = '\0';
+  findgrib.parmid          = *parmid;
+  findgrib.leveltype       = *leveltype;
+  findgrib.level1          = *level1;
+  findgrib.level2          = *level2;
+  findgrib.center_id       = *center;
+  findgrib.subcenter_id    = *subcenter;
+  findgrib.parmtbl_version = *parmtbl;
+  
+  *index = rg_get_index(fileindex->gribinfo, &findgrib);
+
+  return *index;
+}
+
+
+int GET_GRIB_INDEX_VALIDTIME_GUESS(FileIndex *fileindex, int *center, 
+				   int *subcenter, int *parmtbl, int *parmid, 
+				   char DateStrIn[], int *leveltype, 
+				   int *level1, int *level2, int *guessidx, 
+				   int *index, int strlen1, int strlen2)
+{
+  char DateStr[1000];
+  FindGrib findgrib;
+
+  strncpy(DateStr,DateStrIn,strlen2);
+  DateStr[strlen2] = '\0';
+  grib_time_format(DateStr,DateStr);
+
+  rg_init_findgrib(&findgrib);
+
+  strncpy(findgrib.validdate,DateStr,strlen2);
+  findgrib.initdate[strlen2] = '\0';
+  findgrib.parmid          = *parmid;
+  findgrib.leveltype       = *leveltype;
+  findgrib.level1          = *level1;
+  findgrib.level2          = *level2;
+  findgrib.center_id       = *center;
+  findgrib.subcenter_id    = *subcenter;
+  findgrib.parmtbl_version = *parmtbl;
+  
+  *index = rg_get_index_guess(fileindex->gribinfo, &findgrib, *guessidx);
+
+  return *index;
+}
+
+
+int GET_GRIB_INDICES(FileIndex *fileindex, int *center, int *subcenter, 
+		     int *parmtbl,int *parmid, char DateStrIn[], 
+		     int *leveltype, int *level1, int *level2, int *fcsttime1,
+		     int *fcsttime2, int *indices, int *num_indices, 
+		     int strlen1, int strlen2)
+{
+  char DateStr[1000];
+  int status;
+  FindGrib findgrib;
+
+  strncpy(DateStr,DateStrIn,strlen2);
+  DateStr[strlen2] = '\0';
+  grib_time_format(DateStr,DateStr);
+
+  rg_init_findgrib(&findgrib);
+
+  strncpy(findgrib.initdate,DateStrIn,strlen2);
+  findgrib.initdate[strlen2] = '\0';
+  trim(findgrib.initdate);
+  findgrib.parmid          = *parmid;
+  findgrib.leveltype       = *leveltype;
+  findgrib.level1          = *level1;
+  findgrib.level2          = *level2;
+  findgrib.fcsttime1       = *fcsttime1;
+  findgrib.fcsttime2       = *fcsttime2;
+  findgrib.center_id       = *center;
+  findgrib.subcenter_id    = *subcenter;
+  findgrib.parmtbl_version = *parmtbl;
+
+  *num_indices = rg_get_indices(fileindex->gribinfo, &findgrib, indices);
+
+  return (*num_indices);
+
+}
+
+
+int GET_GRID_INFO_SIZE(int *size)
+{
+
+  *size = sizeof(Grid_Info);
+
+  return *size;
+
+}
+
+
+int LOAD_GRID_INFO(char *varnameIn, char *initdateIn, int *leveltype, 
+		   int *level1, int *level2, float *fcst_time, 
+		   int *accum_period, int *grid_id, int *projection, 
+		   int *xpoints, int *ypoints, float *center_lat, 
+		   float *center_lon, float *Di, float *Dj,float *central_lon,
+		   int *proj_center_flag, float *latin1, 
+		   float *latin2, Grib1_Tables *grib_tables,
+		   Grid_Info *grid_info, int strlen1, int strlen2)
+{
+
+  char varname[1000], initdate[1000];
+
+  strncpy(varname,varnameIn,strlen1);
+  varname[strlen1] = '\0';
+  strncpy(initdate,initdateIn,strlen2);
+  initdate[strlen2] = '\0';
+
+  strcpy(grid_info->varname, varname);
+  strcpy(grid_info->initdate, initdate);
+  grid_info->leveltype        = *leveltype;
+  grid_info->level1           = *level1 ;
+  grid_info->level2           = *level2 ;
+  grid_info->fcst_time        = *fcst_time ;
+  grid_info->accum_period     = *accum_period ;
+  grid_info->grid_id          = *grid_id ;
+  grid_info->projection       = *projection ;
+  grid_info->xpoints          = *xpoints ;
+  grid_info->ypoints          = *ypoints ;
+  grid_info->center_lat       = *center_lat ;
+  grid_info->center_lon       = *center_lon;
+  grid_info->Di               = *Di ;
+  grid_info->Dj               = *Dj ;
+  grid_info->central_lon      = *central_lon ;
+  grid_info->proj_center_flag = *proj_center_flag ;
+  grid_info->latin1           = *latin1 ;
+  grid_info->latin2           = *latin2 ;
+  grid_info->grib_tables      = copy_grib_tables(grib_tables);
+
+  return 0;
+
+}
+
+int PRINT_GRID_INFO(Grid_Info *grid_info)
+{
+
+  fprintf(stdout,"varname        =%s\n",grid_info->varname);
+  fprintf(stdout,"initdate       =%s\n",grid_info->initdate);
+  fprintf(stdout,"leveltype      =%d\n",grid_info->leveltype);
+  fprintf(stdout,"level1         =%d\n",grid_info->level1);
+  fprintf(stdout,"level2         =%d\n",grid_info->level2);
+  fprintf(stdout,"fcst_time      =%f\n",grid_info->fcst_time);
+  fprintf(stdout,"accum_period   =%d\n",grid_info->accum_period);
+  fprintf(stdout,"grid_id        =%d\n",grid_info->grid_id);
+  fprintf(stdout,"projection     =%d\n",grid_info->projection);
+  fprintf(stdout,"xpoints        =%d\n",grid_info->xpoints);
+  fprintf(stdout,"ypoints        =%d\n",grid_info->ypoints);
+  fprintf(stdout,"center_lat     =%f\n",grid_info->center_lat);
+  fprintf(stdout,"center_lon     =%f\n",grid_info->center_lon);
+  fprintf(stdout,"Di             =%f\n",grid_info->Di);
+  fprintf(stdout,"Dj             =%f\n",grid_info->Dj);
+  fprintf(stdout,"central_lon    =%f\n",grid_info->central_lon);
+  fprintf(stdout,"proj_center_flag =%d\n",grid_info->proj_center_flag);
+  fprintf(stdout,"latin1         =%f\n",grid_info->latin1);
+  fprintf(stdout,"latin2         =%f\n",grid_info->latin2);
+
+  return 0;
+
+}
+
+
+int GET_SIZEOF_GRID(FileIndex *fileindex, int *index, int *numcols, 
+		    int *numrows)
+{
+
+  *numcols = rg_get_numcols(fileindex->gribinfo,*index);
+
+  *numrows = rg_get_numrows(fileindex->gribinfo,*index);
+
+  return (*numcols)*(*numrows);
+
+}
+
+
+void FREE_GRID_INFO(Grid_Info *grid_info)
+{
+  FREE_GRIBMAP(grid_info->grib_tables);
+}
+
+
+int READ_GRIB(FileIndex *fileindex, int *fid, int *index, float *data)
+{
+  int status;
+
+  status = rg_get_data_1d(fileindex->gribinfo,*index,data);
+
+  return status;
+}
+
+#define WRF_LATLON 0
+#define WRF_LAMBERT 1
+#define WRF_POLAR_STEREO 2
+#define WRF_MERCATOR 3
+
+#define LINESIZE 300
+
+#define SECS_IN_SEC 1
+#define SECS_IN_MIN 60
+#define MINS_IN_HOUR 60
+#define MINS_IN_5MINS 5
+#define HOURS_IN_DAY 24
+
+#define MAX_FCST 65535
+#define MAX_FCST_SECS MAX_FCST*SECS_IN_SEC
+#define MAX_FCST_MINS MAX_FCST*SECS_IN_MIN
+#define MAX_FCST_5MINS MAX_FCST*MINS_IN_5MINS*SECS_IN_MIN
+#define MAX_FCST_HOURS MAX_FCST*MINS_IN_HOUR*SECS_IN_MIN
+#define MAX_FCST_DAYS MAX_FCST*HOURS_IN_DAY*MINS_IN_HOUR*SECS_IN_MIN
+
+#define MAX1B_FCST 256
+#define MAX1B_FCST_SECS MAX1B_FCST*SECS_IN_SEC
+#define MAX1B_FCST_MINS MAX1B_FCST*SECS_IN_MIN
+#define MAX1B_FCST_5MINS MAX1B_FCST*MINS_IN_5MINS*SECS_IN_MIN
+#define MAX1B_FCST_HOURS MAX1B_FCST*MINS_IN_HOUR*SECS_IN_MIN
+#define MAX1B_FCST_DAYS MAX1B_FCST*HOURS_IN_DAY*MINS_IN_HOUR*SECS_IN_MIN
+
+#define PI 3.1415
+typedef struct {
+  int time_range;
+  int fcst_unit;
+  int P1;
+  int P2;
+
+  int time_range_ext;
+  int fcst_unit_ext_1;
+  int fcst_unit_ext_2;
+  int P1_ext;
+  int P2_ext;
+} FcstTimeStruct;
+
+int get_fcst_time(int accum_period, int fcst_secs, FcstTimeStruct *fcst_time);
+
+/****************************************************************************
+ *
+ * This function takes in metadata in the grid_info structure, output data in 
+ *   the *data array, and calls routines to write the metadata and data 
+ *   in grib version 1 format the open file descriptor filefd.
+ *
+ ****************************************************************************/
+
+int WRITE_GRIB(Grid_Info *grid_info, int *filefd, float *data)
+{
+
+  GRIB_HDR *gh=NULL;
+  DATA_INPUT data_input;
+  GEOM_IN geom_in;
+  USER_INPUT user_input;
+  int grid_projection;
+  int status;
+  float x_center, y_center;
+  GridNav gridnav;
+  float first_lat, first_lon, last_lat, last_lon;
+  int year, month, day, hour, minute;
+  float second;
+  char varname2[1000];
+  int table_index;
+  int fcst_unit;
+  int time_range;
+  int P1, P2;
+  int fcst_unit_ext_1, fcst_unit_ext_2;
+  int P1_ext, P2_ext;
+  int time_range_ext;
+  char errmsg[1000];
+  int center, subcenter, parmtbl;
+  int tablenum;
+  FcstTimeStruct fcst_time;
+
+  strcpy(varname2,grid_info->varname);
+  trim(varname2);
+
+  sscanf(grid_info->initdate,"%d-%d-%d_%d:%d:%f",
+	 &year,&month,&day,&hour,&minute,&second);
+
+  /* Get coords of center of grid */
+  x_center = (grid_info->xpoints + 1)/2.;
+  y_center = (grid_info->ypoints + 1)/2.;
+
+  grid_projection = get_gridnav_projection(grid_info->projection);
+
+ /* Initialize grid structure */
+  status = GRID_init(grid_info->center_lat, grid_info->central_lon, 
+		     grid_projection,
+		     grid_info->latin1, grid_info->latin2, 
+		     grid_info->xpoints, grid_info->ypoints, grid_info->Di, 
+		     grid_info->Dj,
+		     grid_info->center_lat, grid_info->center_lon, 
+		     x_center, y_center,
+		     &gridnav);
+  if (!status)
+    {
+      fprintf(stderr,"write_grib: error from GRID_init\n");
+    }
+
+  /* get lat/lon of lower left corner */
+  status = GRID_to_latlon(&gridnav, 1, 1, &first_lat, &first_lon);
+  if (!status)
+    {
+      fprintf(stderr,
+	      "write_grib: error from GRID_to_latlon for first lat/lon\n");
+    }
+
+  /* get lat/lon of upper right corner */
+  status = GRID_to_latlon(&gridnav, grid_info->xpoints, grid_info->ypoints, 
+			  &last_lat, &last_lon);
+  if (!status)
+    {
+      fprintf(stderr,
+	      "write_grib: error from GRID_to_latlon for last lat/lon\n");
+    }
+
+  /* Read the grib parameter table */
+  status = GET_GRIB_PARAM(grid_info->grib_tables, varname2, &center,
+			   &subcenter, &parmtbl, &tablenum, &table_index,
+			  1,strlen(varname2));
+  if (table_index < 0)
+    {
+      fprintf(stderr,\
+              "Skipping %s, Could not find parameter for %s in gribmap.txt\n",\
+              varname2,varname2);
+      return 1;
+    }
+
+  /* 
+   * We skip any parameters that are listed in parameter 255 in gribmap.txt.
+   * Parameter 255 is used to indicate that a WRF parameter should not be 
+   * output.  It is useful for parameters that are requested to be output in
+   * the WRF Registry, but are already implicitly output in grib.
+   */
+
+  if (table_index == 255)
+    {
+      return 0;
+    }
+
+  /* 
+   * Setup the geom_in structure for the grib library.  Here, we set
+   *  the generic parms.  Below, we set the projection specific parms
+   */
+  geom_in.nx = grid_info->xpoints;
+  geom_in.ny = grid_info->ypoints;
+  geom_in.first_lat = first_lat;
+  geom_in.first_lon = first_lon;
+  geom_in.last_lat = last_lat;
+  geom_in.last_lon = last_lon;
+  geom_in.scan = 64;
+
+  switch (grid_info->projection) 
+    {
+    case WRF_LATLON:
+      strcpy(geom_in.prjn_name,"spherical");
+      geom_in.parm_1 = grid_info->Dj;
+      geom_in.parm_2 = grid_info->Di;
+      geom_in.parm_3 = -1;
+      geom_in.usRes_flag = 0;  /* 
+				* Set to 0 here, MEL grib library will reset
+				*  to 128 to indicate that direction 
+				*  increments are given.
+				*/
+      break;
+    case WRF_MERCATOR:
+      strcpy(geom_in.prjn_name,"mercator");
+      geom_in.parm_1 = grid_info->latin1;
+      geom_in.parm_2 = grid_info->Di;
+      geom_in.parm_3 = grid_info->Dj;
+      geom_in.usRes_flag = 128;
+      break;
+    case WRF_LAMBERT:
+      strcpy(geom_in.prjn_name,"lambert");
+      geom_in.usRes_flag = 0;   /* Set to 0 here, MEL grib library will reset 
+				 * to 128.
+				 */
+      geom_in.parm_3 = grid_info->central_lon;
+      geom_in.x_int_dis = grid_info->Di;
+      geom_in.y_int_dis = grid_info->Dj;
+      geom_in.parm_1 = grid_info->latin1;
+      geom_in.parm_2 = grid_info->latin2;
+      break;
+    case WRF_POLAR_STEREO:
+      strcpy(geom_in.prjn_name,"polar_stereo");
+      geom_in.usRes_flag = 0;   /* Set to 0 here, MEL grib library will reset 
+				 * to 128.
+				 */
+
+      geom_in.parm_3 = -1;
+      geom_in.x_int_dis = grid_info->Di*(1.+sin(60. * PI/180.))
+	/ (1.+sin(abs(grid_info->latin1) * PI/180.));
+      geom_in.y_int_dis = grid_info->Dj*(1.+sin(60. * PI/180.))
+	/ (1.+sin(abs(grid_info->latin1) * PI/180.));
+      geom_in.parm_1 = -1;
+      geom_in.parm_2 = grid_info->central_lon;
+      break;
+    default:
+      fprintf(stderr,"Error, invalid projection: %d\n",grid_info->projection);
+      return 1;
+    }
+
+  /* 
+   * Setup the data_input structure.
+   */
+  data_input.nDec_sc_fctr = 
+    grid_info->grib_tables->grib_table_info[tablenum].dec_sc_factor[table_index];
+  data_input.usProc_id = 220;
+  data_input.usGrid_id = grid_info->grid_id;
+  data_input.usParm_id = 
+    grid_info->grib_tables->grib_table_info[tablenum].parm_id[table_index];
+  data_input.usParm_sub_id = 
+    grid_info->grib_tables->grib_table_info[tablenum].subcenter;
+  data_input.usLevel_id = grid_info->leveltype;
+
+  if (grid_info->leveltype == 112) {
+    data_input.nLvl_1 = grid_info->level2;
+    data_input.nLvl_2 = grid_info->level1;
+  } else {
+    data_input.nLvl_1 = grid_info->level1;
+    data_input.nLvl_2 = grid_info->level2;
+  }
+
+  data_input.nYear = year;
+  data_input.nMonth = month;
+  data_input.nDay = day;
+  data_input.nHour = hour;
+  data_input.nMinute = minute;
+  data_input.nSecond = second;
+
+  status = get_fcst_time(grid_info->accum_period, grid_info->fcst_time, 
+			 &fcst_time);
+
+  data_input.usFcst_id = fcst_time.fcst_unit;
+  data_input.usFcst_per1 = fcst_time.P1;
+  data_input.usFcst_per2 = fcst_time.P2;
+  data_input.usTime_range_id = fcst_time.time_range;
+  data_input.usTime_range_avg = 0;
+  data_input.usTime_range_mis = 0;
+  /* 
+   * This is for WSI's extended PDS section 
+   */
+  data_input.PDS_41 = fcst_time.fcst_unit_ext_1;
+  data_input.PDS_42 = fcst_time.P1_ext;
+  data_input.PDS_46 = fcst_time.fcst_unit_ext_2;
+  data_input.PDS_47 = fcst_time.P2_ext;
+  data_input.PDS_51 = fcst_time.time_range_ext;
+  data_input.PDS_52 = 0;
+
+
+  data_input.nDec_sc_fctr = 
+    grid_info->grib_tables->grib_table_info[tablenum].dec_sc_factor[table_index];
+  user_input.usCenter_id = 
+    grid_info->grib_tables->grib_table_info[tablenum].center;
+  user_input.usParm_tbl = 
+    grid_info->grib_tables->grib_table_info[tablenum].parmtbl;
+  user_input.chCase_id='0';
+  user_input.usSub_tbl = 0;
+  user_input.usCenter_sub = 
+    grid_info->grib_tables->grib_table_info[tablenum].subcenter;
+  user_input.usTrack_num = 0;
+  user_input.usGds_bms_id = 128;
+  user_input.usBDS_flag = 0;
+  user_input.usBit_pack_num = 0;
+
+  status = init_gribhdr(&gh,errmsg);
+  if (status != 0) {
+    fprintf (stderr,"write_grib: Error writing %s: \n\t%s\n",varname2,errmsg);
+    return 1;
+  }
+
+  status = grib_enc(data_input,user_input,geom_in,data,gh,errmsg);
+  if (status != 0) {
+    fprintf (stderr,"write_grib: Error writing %s: \n\t%s\n",varname2,errmsg);
+    fprintf (stderr,"\tCheck precision for %s in gribmap.txt.\n",
+	     varname2);
+    return 1;
+  }
+
+  status = gribhdr2filed(gh,*filefd,errmsg);
+  if (status != 0) {
+    fprintf (stderr,"write_grib: Error writing %s: \n\t%s\n",varname2,errmsg);
+    return 1;
+  }
+
+  free_gribhdr(&gh);
+
+  return 0;
+}
+
+/***************************************************************************
+ * Function to set up a structure containing forecast time parameters
+ *  This encodes the standard grib forecast time parameters as well
+ *  as WSI's extended forecast time parameters.
+ ***************************************************************************/
+
+int get_fcst_time(int accum_period, int fcst_secs, FcstTimeStruct *ft)
+{
+  /* 
+   * Added ability to output a "5-minute" forecast time unit for the
+   *   sake of WxProducer.  This allows WxPro to ingest data beyond
+   *   18 hours, and accumulation data beyond 255 units.
+   */
+
+  /*
+   * Initialize.
+   */
+  ft->time_range = 0;
+  ft->fcst_unit = 0;
+  ft->P1 = 0;
+  ft->P2 = 0;
+  ft->fcst_unit_ext_1 = 0;
+  ft->fcst_unit_ext_2 = 0;
+  ft->P1_ext = 0;
+  ft->P2_ext = 0;
+  ft->time_range_ext = 0;
+
+  if (accum_period == 0) 
+    {
+      if (fcst_secs < MAX_FCST_SECS)
+	{
+	  ft->time_range = 10;
+	  ft->fcst_unit = 254;
+	  ft->P1 = get_byte(fcst_secs,2);
+	  ft->P2 = get_byte(fcst_secs,1);
+	}
+      else if (((fcst_secs % SECS_IN_MIN) == 0) &&
+	       (fcst_secs < MAX_FCST_MINS))
+	{
+	  ft->time_range = 10;
+	  ft->fcst_unit = 0;
+	  ft->P1 = get_byte(fcst_secs/SECS_IN_MIN,2);
+	  ft->P2 = get_byte(fcst_secs/SECS_IN_MIN,1);
+	}
+      else if (((fcst_secs % SECS_IN_MIN*MINS_IN_HOUR) == 0) && 
+	       (fcst_secs < MAX_FCST_HOURS))
+	{
+	  ft->time_range = 10;
+	  ft->fcst_unit = 1;
+	  ft->P1 = get_byte(fcst_secs/(SECS_IN_MIN*MINS_IN_HOUR),2);
+	  ft->P2 = get_byte(fcst_secs/(SECS_IN_MIN*MINS_IN_HOUR),1);      
+	}
+      /* 
+       * MAX_FCST_DAYS is causing an integer overflow, so, we'll just skip 
+       *   the check here.  It's very unlikely that someone would exceed this
+       *   anyway (5.6 million days!)
+       */
+      /*
+      else if (((fcst_secs % SECS_IN_MIN*MINS_IN_HOUR*HOURS_IN_DAY) == 0) &&
+	       (fcst_secs < MAX_FCST_DAYS))
+      */
+      else if (((fcst_secs % SECS_IN_MIN*MINS_IN_HOUR*HOURS_IN_DAY) == 0))
+	{
+	  ft->time_range = 10;
+	  ft->fcst_unit = 2;
+	  ft->P1 = 
+	    get_byte(fcst_secs/(SECS_IN_MIN*MINS_IN_HOUR*HOURS_IN_DAY),2);
+	  ft->P2 = 
+	    get_byte(fcst_secs/(SECS_IN_MIN*MINS_IN_HOUR*HOURS_IN_DAY),1);
+	}
+      else if (((fcst_secs % SECS_IN_MIN*MINS_IN_5MINS) == 0)
+	       && (fcst_secs < MAX_FCST_5MINS))
+	{
+	  ft->time_range = 10;
+	  ft->fcst_unit = 50;
+	  ft->P1 = get_byte(fcst_secs/(SECS_IN_MIN*MINS_IN_5MINS),2);
+	  ft->P2 = get_byte(fcst_secs/(SECS_IN_MIN*MINS_IN_5MINS),1);
+	}
+      else 
+	{
+	  ft->time_range = 255;
+	  ft->fcst_unit = 0;
+	  ft->P1 = 0;
+	  ft->P2 = 0;
+	  
+	  ft->fcst_unit_ext_1 = 254;
+	  ft->fcst_unit_ext_2 = 254;
+	  ft->P1_ext = fcst_secs;
+	  ft->P2_ext = 0;
+	  ft->time_range_ext = 0;
+	}
+    }
+  else  /* Accumulation period is not 0 */
+    {
+      if ((fcst_secs < MAX1B_FCST_HOURS) &&
+	  (fcst_secs%(SECS_IN_MIN*MINS_IN_HOUR) == 0) && 
+	  (accum_period%(SECS_IN_MIN*MINS_IN_HOUR) == 0))
+	{
+	  ft->time_range = 4;
+	  ft->fcst_unit = 1;
+	  ft->P1 = (fcst_secs-accum_period)/(SECS_IN_MIN*MINS_IN_HOUR);
+	  ft->P2 = fcst_secs/(SECS_IN_MIN*MINS_IN_HOUR);
+	}
+      else if ((fcst_secs < MAX1B_FCST_MINS) &&
+	       ((fcst_secs-accum_period)%SECS_IN_MIN == 0) && 
+	       (fcst_secs%SECS_IN_MIN == 0))
+	{
+	  ft->time_range = 4;
+	  ft->fcst_unit = 0;
+	  ft->P1 = (fcst_secs-accum_period)/SECS_IN_MIN;
+	  ft->P2 = fcst_secs/SECS_IN_MIN;
+	}
+      else if (fcst_secs < MAX1B_FCST_SECS)
+	{
+	  ft->time_range = 4;
+	  ft->fcst_unit = 254;
+	  ft->P1 = fcst_secs-accum_period;
+	  ft->P2 = fcst_secs;
+	}
+      else if ((fcst_secs < MAX1B_FCST_5MINS) && 
+	       (fcst_secs%(SECS_IN_MIN*MINS_IN_5MINS) == 0) &&
+	       (accum_period%(SECS_IN_MIN*MINS_IN_5MINS) == 0)) 
+	{
+	  ft->time_range = 4;
+	  ft->fcst_unit = 50;
+	  ft->P1 = (fcst_secs-accum_period)/(SECS_IN_MIN*MINS_IN_5MINS);
+	  ft->P2 = fcst_secs/(SECS_IN_MIN*MINS_IN_5MINS);
+	}
+      else
+	{
+	  ft->time_range = 255;
+	  ft->fcst_unit = 0;
+	  ft->P1 = 0;
+	  ft->P2 = 0;
+	  
+	  ft->fcst_unit_ext_1 = 254;
+	  ft->fcst_unit_ext_2 = 254;
+	  ft->P1_ext = fcst_secs - accum_period;
+	  ft->P2_ext = accum_period;
+	  ft->time_range_ext = 203;    /* Duration */
+	}
+    }
+  return 0;
+}
+
+
+/******************************************************************************
+ * returns a byt from an input integer
+ *****************************************************************************/
+
+int get_byte(int input_int, int bytenum)
+{
+  int out;
+  out = ((input_int >> (bytenum-1)*8) & ~(~0 <<8));
+  return out;
+}
+
+/*************************************************************************
+ * Converts from WRF time format to time format required by grib routines
+ *************************************************************************/
+int grib_time_format(char *DateStr, char *DateStrIn)
+{
+  int year,month,day,hour,minute,second;
+
+  trim(DateStrIn);
+  if (DateStrIn[0] == '*') {
+    strcpy(DateStr,"*");
+  }
+  else
+    {
+      sscanf(DateStrIn,"%04d-%02d-%02d_%02d:%02d:%02d",
+	     &year,&month,&day,&hour,&minute,&second);
+      sprintf(DateStr,"%04d%02d%02d%02d%02d%02d",
+	      year,month,day,hour,minute,second);
+    }
+
+  return 0;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_routines.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_routines.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_routines.h	(revision 2744)
@@ -0,0 +1,233 @@
+#include "gribfuncs.h"
+#include "read_grib.h"
+#include "gribmap.h"
+
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define GET_FILEINDEX_SIZE get_fileindex_size
+#      define INDEX_FILE index_file
+#      define GET_METADATA_VALUE get_metadata_value
+#      define GET_GRIB_INDEX get_grib_index
+#      define GET_GRIB_INDEX_GUESS get_grib_index_guess
+#      define GET_GRIB_INDEX_VALIDTIME get_grib_index_validtime
+#      define GET_GRIB_INDEX_VALIDTIME_GUESS get_grib_index_validtime_guess
+#      define GET_GRIB_INDICES get_grib_indices
+#      define ALLOC_INDEX_FILE alloc_index_file
+#      define FREE_INDEX_FILE free_index_file
+#      define GET_NUM_TIMES get_num_times
+#      define GET_LEVEL1 get_level1
+#      define GET_LEVEL2 get_level2
+#      define GET_TIME get_time
+#      define GET_GRID_INFO_SIZE get_grid_info_size
+#      define LOAD_GRID_INFO load_grid_info
+#      define FREE_GRID_INFO free_grid_info
+#      define PRINT_GRID_INFO print_grid_info
+#      define READ_GRIB read_grib
+#      define WRITE_GRIB write_grib
+#      define GET_GRIB_SEARCH_SIZE get_grib_search_size
+#      define LOAD_GRIB_SEARCH load_grib_search
+#      define FREE_GRIB_SEARCH free_grib_search
+#      define GET_SIZEOF_GRID get_sizeof_grid
+#      define GET_GRIB_CENTER get_grib_center
+#      define GET_GRIB_SUBCENTER get_grib_subcenter
+#      define GET_GRIB_TBLVERSION get_grib_tblversion
+#      define GET_GRIB_PROCID get_grib_procid
+# else
+#   ifdef F2CSTYLE
+#      define GET_FILEINDEX_SIZE get_fileindex_size__
+#      define INDEX_FILE index_file__
+#      define GET_METADATA_VALUE get_metadata_value__
+#      define GET_GRIB_INDEX get_grib_index__
+#      define GET_GRIB_INDEX_GUESS get_grib_index_guess__
+#      define GET_GRIB_INDEX_VALIDTIME_GUESS get_grib_index_validtime_guess__
+#      define GET_GRIB_INDICES get_grib_indices__
+#      define ALLOC_INDEX_FILE alloc_index_file__
+#      define FREE_INDEX_FILE free_index_file__
+#      define GET_NUM_TIMES get_num_times__
+#      define GET_LEVEL1 get_level1__
+#      define GET_LEVEL2 get_level2__
+#      define GET_TIME get_time__
+#      define GET_GRID_INFO_SIZE get_grid_info_size__
+#      define LOAD_GRID_INFO load_grid_info__
+#      define FREE_GRID_INFO free_grid_info__
+#      define PRINT_GRID_INFO print_grid_info__
+#      define READ_GRIB read_grib__
+#      define WRITE_GRIB write_grib__
+#      define GET_GRIB_SEARCH_SIZE get_grib_search_size__
+#      define LOAD_GRIB_SEARCH load_grib_search__
+#      define FREE_GRIB_SEARCH free_grib_search__
+#      define GET_SIZEOF_GRID get_sizeof_grid__
+#      define GET_GRIB_CENTER get_grib_center__
+#      define GET_GRIB_SUBCENTER get_grib_subcenter__
+#      define GET_GRIB_TBLVERSION get_grib_tblversion__
+#      define GET_GRIB_PROCID get_grib_procid__
+#   else
+#      define GET_FILEINDEX_SIZE get_fileindex_size_
+#      define INDEX_FILE index_file_
+#      define GET_METADATA_VALUE get_metadata_value_
+#      define GET_GRIB_INDEX get_grib_index_
+#      define GET_GRIB_INDEX_GUESS get_grib_index_guess_
+#      define GET_GRIB_INDEX_VALIDTIME get_grib_index_validtime_
+#      define GET_GRIB_INDEX_VALIDTIME_GUESS get_grib_index_validtime_guess_
+#      define GET_GRIB_INDICES get_grib_indices_
+#      define ALLOC_INDEX_FILE alloc_index_file_
+#      define FREE_INDEX_FILE free_index_file_
+#      define GET_NUM_TIMES get_num_times_
+#      define GET_LEVEL1 get_level1_
+#      define GET_LEVEL2 get_level2_
+#      define GET_TIME get_time_
+#      define GET_GRID_INFO_SIZE get_grid_info_size_
+#      define LOAD_GRID_INFO load_grid_info_
+#      define FREE_GRID_INFO free_grid_info_
+#      define PRINT_GRID_INFO print_grid_info_
+#      define READ_GRIB read_grib_
+#      define WRITE_GRIB write_grib_
+#      define GET_GRIB_SEARCH_SIZE get_grib_search_size_
+#      define LOAD_GRIB_SEARCH load_grib_search_
+#      define FREE_GRIB_SEARCH free_grib_search_
+#      define GET_SIZEOF_GRID get_sizeof_grid_
+#      define GET_GRIB_CENTER get_grib_center_
+#      define GET_GRIB_SUBCENTER get_grib_subcenter_
+#      define GET_GRIB_TBLVERSION get_grib_tblversion_
+#      define GET_GRIB_PROCID get_grib_procid_
+#   endif
+# endif
+#endif
+
+typedef struct {
+  char VarName[100];
+  char DateStr[100];
+  char Element[100];
+  char Value[1000];
+} MetaData_Elements;
+
+typedef struct {
+  int num_elements;
+  MetaData_Elements *elements;
+} MetaData;
+
+typedef struct {
+  char valid_time[30];
+} Times_Elements;
+
+typedef struct {
+  int num_elements;
+  Times_Elements *elements;
+} Times;
+
+typedef struct {
+  MetaData *metadata;
+  GribInfo *gribinfo;
+  Times *times;
+} FileIndex;
+
+typedef struct {
+  char varname[200];
+  char initdate[20];
+  int leveltype;
+  int level1;
+  int level2;
+  float fcst_time;
+  int accum_period;
+  int grid_id;
+  int projection;
+  int xpoints;
+  int ypoints;
+  float center_lat;
+  float center_lon;
+  float Di;
+  float Dj;
+  float central_lon;
+  int proj_center_flag;
+  float latin1;
+  float latin2;
+  Grib1_Tables *grib_tables;
+} Grid_Info;
+
+int GET_FILEINDEX_SIZE(int *size);
+
+int ALLOC_INDEX_FILE(FileIndex *fileindex);
+void FREE_INDEX_FILE(FileIndex *fileindex);
+
+int INDEX_FILE(int *fid, FileIndex *fileindex);
+
+int GET_METADATA_VALUE(FileIndex *fileindex, char Element[], char DateStr[], 
+		       char VarName[], char Value[], int *stat, int strlen1, 
+		       int strlen2, int strlen3, int strlen4, int strlen5);
+
+int GET_GRIB_INDEX(FileIndex *fileindex,
+		   int *center, int *subcenter, int *parmtbl,
+		   int *parmid, char DateStrIn[], 
+		   int *leveltype, int *level1, int *level2, int *fcsttime1,
+		   int *fcsttime2, int *index, int strlen1, int strlen2);
+
+int GET_GRIB_INDEX_GUESS(FileIndex *fileindex, int *center, int *subcenter, 
+			 int *parmtbl, int *parmid, char DateStrIn[], 
+			 int *leveltype, int *level1, int *level2, 
+			 int *fcsttime1,int *fcsttime2, int *guessidx, 
+			 int *index, int strlen1, int strlen2);
+
+int GET_GRIB_INDICES(FileIndex *fileindex, int *center, int *subcenter, 
+		     int *parmtbl,int *parmid, char DateStrIn[], 
+		     int *leveltype, int *level1, int *level2, int *fcsttime1,
+		     int *fcsttime2, int *indices, int *num_indices, 
+		     int strlen1, int strlen2);
+
+int GET_NUM_TIMES(FileIndex *fileindex, int *numtimes);
+
+int GET_TIME(FileIndex *fileindex, int *idx, char time[]);
+
+int GET_GRID_INFO_SIZE(int *size);
+
+int LOAD_GRID_INFO(char *varname, char *initdate, int *leveltype, 
+		   int *level1, int *level2, float *fcst_time, 
+		   int *accum_period, int *grid_id, int *projection, 
+		   int *xpoints, int *ypoints, float *center_lat, 
+		   float *center_lon, float *Di, float *Dj,float *central_lon,
+		   int *proj_center_flag, float *latin1, 
+		   float *latin2, Grib1_Tables *grib_tables,
+		   Grid_Info *grid_info, int strlen1, int strlen2);
+
+int PRINT_GRID_INFO(Grid_Info *grid_info);
+
+int WRITE_GRIB(Grid_Info *grid_info, int *filefd, float *data);
+
+int READ_GRIB(FileIndex *fileindex, int *fid, int *index, float *data);
+
+int GET_SIZEOF_GRID(FileIndex *fileindex, int *index, int *numcols, 
+		    int *numrows);
+
+int GET_LEVEL1(FileIndex *fileindex, int *idx, int *level1);
+
+int GET_LEVEL2(FileIndex *fileindex, int *idx, int *level2);
+
+int GET_GRIB_INDEX_VALIDTIME(FileIndex *fileindex, 
+			     int *center, int *subcenter, int *parmtbl,
+			     int *parmid, 
+			     char DateStrIn[], int *leveltype, int *level1, 
+			     int *level2, int *index, int strlen1, 
+			     int strlen2);
+
+int GET_GRIB_INDEX_VALIDTIME_GUESS(FileIndex *fileindex, int *center, 
+				   int *subcenter, int *parmtbl, int *parmid, 
+				   char DateStrIn[], int *leveltype, 
+				   int *level1, int *level2, int *guessidx, 
+				   int *index, int strlen1, int strlen2);
+
+int GET_GRIB_CENTER(FileIndex *fileindex, int *parmid, int *center);
+
+int GET_GRIB_SUBCENTER(FileIndex *fileindex, int *parmid, int *subcenter);
+
+int GET_GRIB_TBLVERSION(FileIndex *fileindex, int *parmid, int *parmtbl);
+
+int GET_GRIB_PROCID(FileIndex *fileindex, int *parmid, int *proc_id);
+
+int GET_REGION_CENTER(char *MemoryOrderIn, int *projection, 
+		      float *domain_center_lat, 
+		      float *domain_center_lon, int *full_xsize, 
+		      int *full_ysize, float *dx, float *dy, 
+		      float *proj_central_lon, 
+		      int *proj_center_flag, float *truelat1, 
+		      float *truelat2, int *region_xsize, int *region_ysize, 
+		      float *region_center_lat, float *region_center_lon, 
+		      int strlen1);
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/Makefile	(revision 2744)
@@ -0,0 +1,63 @@
+#------------------------------------------------------------------------------
+#  Makefile for producing libdbclient.so 
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+
+.SUFFIXES:      .c .o
+
+# Specity location for Makefiles that are included.
+#
+BUILD_DIR = ../../io_grib_share/build
+INCLUDEDIRS = -I. -I.. -I ../MEL_grib1
+#
+# Specify directory that output library is to be put in.
+#
+LIB_DEST = ..
+#
+#  SPECIFY local include directories used during compilation of source code. 
+#
+#    CXX_INCLUDES is for C++ files
+#    C_INCLUDES is for C files
+#
+C_INCLUDES   = -I. -I../MEL_grib1
+CXX_INCLUDES = -I. -I../MEL_grib1
+ARFLAGS      = ruv
+#
+#  SPECIFY any subdirectories containing libraries that may be dynamically
+#          linked by this library.
+#
+SUB_DIRS =
+
+#
+#  SPECIFY information for building a library:
+#
+#    LIB_NAME - Fragment of name of the library to build
+#               e.g. if library file name is libfoo.so, set LIB_NAME = foo 
+#    DEP_LIBS - The tokens required to link a shared library against other
+#               shared libraries upon which it depends.  DEP_LIBS should
+#               contain -L<dir> tokens to specify where the dependent 
+#               libraries are, and -l<lib> tokens to specify libraries to link.
+#    OBJS     - List of object files that go into the library.
+#
+#  NOTES:
+#  1. Be careful about whitespace after the last character in the LIB_NAME.
+#     These spaces will generate an error when the library is made.
+#
+UNIT_TEST = test_rg
+LIB_NAME = io_grib1
+DEP_LIBS =  -L$(LIB_DEST) -lMEL_grib1
+OBJS =  alloc_2d.o \
+	read_grib.o \
+	write_grib.o
+
+#
+#  Include the boilerplate rules for building library modules.
+#
+include $(BUILD_DIR)/library_rules.mk
+
+#
+#  Compile dependencies.  These are appended to this file by make depend. 
+#
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/alloc_2d.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/alloc_2d.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/alloc_2d.c	(revision 2744)
@@ -0,0 +1,54 @@
+#include "stdio.h"
+#include <stdlib.h>
+
+/**************************************************************************
+ * alloc_float_2d - dynamically allocates a two dimensional array
+ * 
+ * Input:
+ *   firsdim   - the number of elements in the first dimension of the array
+ *   seconddim - the number of elements in the second dimension of the array
+ * Return:
+ *   On success, a newly allocated two-dimensional array 
+ *   On failure, NULL
+ * 
+ ***************************************************************************/
+float **alloc_float_2d(int firstdim,int seconddim)
+{
+  float **outvar;
+  int row, row2;
+
+  outvar = (float **)calloc(firstdim,sizeof(float *));
+  if (outvar == NULL) return NULL;
+  for (row=0; row < firstdim; row++) {
+    outvar[row] = (float *)calloc(seconddim,sizeof(float));
+    if (outvar[row] == NULL) {
+      for (row2 = 0; row2 < row; row2++) {
+	free(outvar[row]);
+      }
+      free(outvar);
+      return NULL;
+    }
+  }
+  return outvar;
+}
+
+/**************************************************************************
+ * free_float_2d - frees memory held by a two dimensional array
+ * 
+ * Input:
+ *   var       - the two-dimensional array to be freed
+ *   firsdim   - the number of elements in the first dimension of the array
+ *   seconddim - the number of elements in the second dimension of the array
+ * Return:
+ *   None
+ * 
+ ***************************************************************************/
+
+void free_float_2d(float **var, int firstdim, int seconddim)
+{
+  int row;
+  for (row=0; row < firstdim; row++) {
+    free(var[row]);
+  }
+  free(var);
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/alloc_2d.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/alloc_2d.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/alloc_2d.h	(revision 2744)
@@ -0,0 +1,2 @@
+float **alloc_float_2d(int firstdim,int seconddim);
+void free_float_2d(float **var, int firstdim, int seconddim);
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/cfortran.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/cfortran.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/cfortran.h	(revision 2744)
@@ -0,0 +1,2278 @@
+
+#define pgiFortran
+
+/* cfortran.h  4.1 */          /* anonymous ftp@zebra.desy.de */
+/* Burkhard Burow  burow@desy.de                 1990 - 1998. */
+
+#ifndef __CFORTRAN_LOADED
+#define __CFORTRAN_LOADED
+
+/* 
+   THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
+   SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
+   MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
+*/
+
+/* 
+  Avoid symbols already used by compilers and system *.h:
+  __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c
+
+ */
+
+
+/* First prepare for the C compiler. */
+
+#ifndef ANSI_C_preprocessor /* i.e. user can override. */
+#ifdef __CF__KnR
+#define ANSI_C_preprocessor 0
+#else
+#ifdef __STDC__
+#define ANSI_C_preprocessor 1
+#else
+#define _cfleft             1
+#define _cfright 
+#define _cfleft_cfright     0
+#define ANSI_C_preprocessor _cfleft/**/_cfright
+#endif
+#endif
+#endif
+
+#if ANSI_C_preprocessor
+#define _0(A,B)   A##B
+#define  _(A,B)   _0(A,B)  /* see cat,xcat of K&R ANSI C p. 231 */
+#define _2(A,B)   A##B     /* K&R ANSI C p.230: .. identifier is not replaced */
+#define _3(A,B,C) _(A,_(B,C))
+#else                      /* if it turns up again during rescanning.         */
+#define  _(A,B)   A/**/B
+#define _2(A,B)   A/**/B
+#define _3(A,B,C) A/**/B/**/C
+#endif
+
+#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
+#define VAXUltrix
+#endif
+
+#include <stdio.h>     /* NULL [in all machines stdio.h]                      */
+#include <string.h>    /* strlen, memset, memcpy, memchr.                     */
+#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
+#include <stdlib.h>    /* malloc,free                                         */
+#else
+#include <malloc.h>    /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/
+#ifdef apollo
+#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
+#endif
+#endif
+
+#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx))
+#define __CF__KnR     /* Sun, LynxOS and VAX Ultrix cc only supports K&R.     */
+                      /* Manually define __CF__KnR for HP if desired/required.*/
+#endif                /*       i.e. We will generate Kernighan and Ritchie C. */
+/* Note that you may define __CF__KnR before #include cfortran.h, in order to
+generate K&R C instead of the default ANSI C. The differences are mainly in the
+function prototypes and declarations. All machines, except the Apollo, work
+with either style. The Apollo's argument promotion rules require ANSI or use of
+the obsolete std_$call which we have not implemented here. Hence on the Apollo,
+only C calling FORTRAN subroutines will work using K&R style.*/
+
+
+/* Remainder of cfortran.h depends on the Fortran compiler. */
+
+#ifdef CLIPPERFortran
+#define f2cFortran
+#endif
+
+/* VAX/VMS does not let us \-split long #if lines. */ 
+/* Split #if into 2 because some HP-UX can't handle long #if */
+#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)||defined(pgiFortran))
+#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
+/* If no Fortran compiler is given, we choose one for the machines we know.   */
+#if defined(lynx) || defined(VAXUltrix)
+#define f2cFortran    /* Lynx:      Only support f2c at the moment.
+                         VAXUltrix: f77 behaves like f2c.
+                           Support f2c or f77 with gcc, vcc with f2c. 
+                           f77 with vcc works, missing link magic for f77 I/O.*/
+#endif
+#if defined(__hpux)             /* 921107: Use __hpux instead of __hp9000s300 */
+#define       hpuxFortran       /*         Should also allow hp9000s7/800 use.*/
+#endif
+#if       defined(apollo)
+#define           apolloFortran /* __CF__APOLLO67 also defines some behavior. */
+#endif
+#if          defined(sun) || defined(__sun) 
+#define              sunFortran
+#endif
+#if       defined(_IBMR2)
+#define            IBMR2Fortran
+#endif
+#if        defined(_CRAY)
+#define             CRAYFortran /*       _CRAYT3E also defines some behavior. */
+#endif
+#if        defined(_SX)
+#define               SXFortran
+#endif
+#if         defined(mips) || defined(__mips)
+#define             mipsFortran
+#endif
+#if          defined(vms) || defined(__vms)
+#define              vmsFortran
+#endif
+#if      defined(__alpha) && defined(__unix__)
+#define              DECFortran
+#endif
+#if   defined(__convex__)
+#define           CONVEXFortran
+#endif
+#if   defined(VISUAL_CPLUSPLUS)
+#define     PowerStationFortran
+#endif
+#endif /* ...Fortran */
+#endif /* ...Fortran */
+
+/* Split #if into 2 because some HP-UX can't handle long #if */
+#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)||defined(pgiFortran))
+#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
+/* If your compiler barfs on ' #error', replace # with the trigraph for #     */
+ #error "cfortran.h:  Can't find your environment among:\
+    - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...)     \
+    - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000     \
+    - VAX   VMS CC 3.1 and FORTRAN 5.4.                                  \
+    - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0.                           \
+    - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2          \
+    - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7.            \
+    - CRAY                                                               \
+    - NEC SX-4 SUPER-UX                                                  \
+    - CONVEX                                                             \
+    - Sun                                                                \
+    - PowerStation Fortran with Visual C++                               \
+    - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730    \
+    - LynxOS: cc or gcc with f2c.                                        \
+    - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77.             \
+    -            f77 with vcc works; but missing link magic for f77 I/O. \
+    -            NO fort. None of gcc, cc or vcc generate required names.\
+    - f2c    : Use #define    f2cFortran, or cc -Df2cFortran             \
+    - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran          \
+    - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \
+    - Absoft Pro Fortran: Use #define AbsoftProFortran \
+    - Portland Group Fortran: Use #define pgiFortran"
+/* Compiler must throw us out at this point! */
+#endif
+#endif
+
+
+#if defined(VAXC) && !defined(__VAXC)
+#define OLD_VAXC
+#pragma nostandard                       /* Prevent %CC-I-PARAMNOTUSED.       */
+#endif
+
+/* Throughout cfortran.h we use: UN = Uppercase Name.  LN = Lowercase Name.   */
+
+#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(extname) || defined(pgiFortran)
+#define CFC_(UN,LN)            _(LN,_)      /* Lowercase FORTRAN symbols.     */
+#define orig_fcallsc(UN,LN)    CFC_(UN,LN)
+#else 
+#if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran)
+#ifdef _CRAY          /* (UN), not UN, circumvents CRAY preprocessor bug.     */
+#define CFC_(UN,LN)            (UN)         /* Uppercase FORTRAN symbols.     */
+#else                 /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */
+#define CFC_(UN,LN)            UN           /* Uppercase FORTRAN symbols.     */
+#endif
+#define orig_fcallsc(UN,LN)    CFC_(UN,LN)  /* CRAY insists on arg.'s here.   */
+#else  /* For following machines one may wish to change the fcallsc default.  */
+#define CF_SAME_NAMESPACE
+#ifdef vmsFortran
+#define CFC_(UN,LN)            LN           /* Either case FORTRAN symbols.   */
+     /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/
+     /* because VAX/VMS doesn't do recursive macros.                          */
+#define orig_fcallsc(UN,LN)    UN
+#else      /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
+#define CFC_(UN,LN)            LN           /* Lowercase FORTRAN symbols.     */
+#define orig_fcallsc(UN,LN)    CFC_(UN,LN)
+#endif /*  vmsFortran */
+#endif /* CRAYFortran PowerStationFortran */
+#endif /* ....Fortran */
+
+#define fcallsc(UN,LN)               orig_fcallsc(UN,LN)
+#define preface_fcallsc(P,p,UN,LN)   CFC_(_(P,UN),_(p,LN))
+#define  append_fcallsc(P,p,UN,LN)   CFC_(_(UN,P),_(LN,p))
+
+#define C_FUNCTION(UN,LN)            fcallsc(UN,LN)      
+#define FORTRAN_FUNCTION(UN,LN)      CFC_(UN,LN)
+
+#ifndef COMMON_BLOCK
+#ifndef CONVEXFortran
+#ifndef CLIPPERFortran
+#if     !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran))
+#define COMMON_BLOCK(UN,LN)          CFC_(UN,LN)
+#else
+#define COMMON_BLOCK(UN,LN)          _(_C,LN)
+#endif  /* AbsoftUNIXFortran or AbsoftProFortran */
+#else
+#define COMMON_BLOCK(UN,LN)          _(LN,__)
+#endif  /* CLIPPERFortran */
+#else
+#define COMMON_BLOCK(UN,LN)          _3(_,LN,_)
+#endif  /* CONVEXFortran */
+#endif  /* COMMON_BLOCK */
+
+#ifndef DOUBLE_PRECISION
+#if defined(CRAYFortran) && !defined(_CRAYT3E)
+#define DOUBLE_PRECISION long double
+#else
+#define DOUBLE_PRECISION double
+#endif
+#endif
+
+#ifndef FORTRAN_REAL
+#if defined(CRAYFortran) &&  defined(_CRAYT3E)
+#define FORTRAN_REAL double
+#else
+#define FORTRAN_REAL float
+#endif
+#endif
+
+#ifdef CRAYFortran
+#ifdef _CRAY
+#include <fortran.h>
+#else
+#include "fortran.h"  /* i.e. if crosscompiling assume user has file. */
+#endif
+#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *)   /* Used for C calls FORTRAN.     */
+/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
+#define VOIDP  (void *)  /* When FORTRAN calls C, we don't know if C routine 
+                            arg.'s have been declared float *, or double *.   */
+#else
+#define FLOATVVVVVVV_cfPP
+#define VOIDP
+#endif
+
+#ifdef vmsFortran
+#if    defined(vms) || defined(__vms)
+#include <descrip.h>
+#else
+#include "descrip.h"  /* i.e. if crosscompiling assume user has file. */
+#endif
+#endif
+
+#ifdef sunFortran
+#if defined(sun) || defined(__sun)
+#include <math.h>     /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT.  */
+#else
+#include "math.h"     /* i.e. if crosscompiling assume user has file. */
+#endif
+/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3,
+ * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in
+ * <math.h>, since sun C no longer promotes C float return values to doubles.
+ * Therefore, only use them if defined.
+ * Even if gcc is being used, assume that it exhibits the Sun C compiler
+ * behavior in order to be able to use *.o from the Sun C compiler.
+ * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc.
+ */
+#endif
+
+#ifndef apolloFortran
+#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME
+#define CF_NULL_PROTO
+#else                                         /* HP doesn't understand #elif. */
+/* Without ANSI prototyping, Apollo promotes float functions to double.    */
+/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
+#define CF_NULL_PROTO ...
+#ifndef __CF__APOLLO67
+#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
+ DEFINITION NAME __attribute((__section(NAME)))
+#else
+#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
+ DEFINITION NAME #attribute[section(NAME)]
+#endif
+#endif
+
+#ifdef __cplusplus
+#undef  CF_NULL_PROTO
+#define CF_NULL_PROTO  ...
+#endif
+
+
+#ifndef USE_NEW_DELETE
+#ifdef __cplusplus
+#define USE_NEW_DELETE 1
+#else
+#define USE_NEW_DELETE 0
+#endif
+#endif
+#if USE_NEW_DELETE
+#define _cf_malloc(N) new char[N]
+#define _cf_free(P)   delete[] P
+#else
+#define _cf_malloc(N) (char *)malloc(N)
+#define _cf_free(P)   free(P)
+#endif
+
+#ifdef mipsFortran
+#define CF_DECLARE_GETARG         int f77argc; char **f77argv
+#define CF_SET_GETARG(ARGC,ARGV)  f77argc = ARGC; f77argv = ARGV
+#else
+#define CF_DECLARE_GETARG
+#define CF_SET_GETARG(ARGC,ARGV)
+#endif
+
+#ifdef OLD_VAXC                          /* Allow %CC-I-PARAMNOTUSED.         */
+#pragma standard                         
+#endif
+
+#define AcfCOMMA ,
+#define AcfCOLON ;
+
+/*-------------------------------------------------------------------------*/
+
+/*               UTILITIES USED WITHIN CFORTRAN.H                          */
+
+#define _cfMIN(A,B) (A<B?A:B)
+
+/* 970211 - XIX.145:
+   firstindexlength  - better name is all_but_last_index_lengths
+   secondindexlength - better name is         last_index_length
+ */
+#define  firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) )
+#define secondindexlength(A) (sizeof(A[0])==1 ?      sizeof(A) : sizeof(A[0])  )
+
+/* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
+Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
+f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77,
+HP-UX f77                                        : as in C.
+VAX/VMS FORTRAN, VAX Ultrix fort,
+Absoft Unix Fortran, IBM RS/6000 xlf             : LS Bit = 0/1 = TRUE/FALSE.
+Apollo                                           : neg.   = TRUE, else FALSE. 
+[Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
+[DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]   
+[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/
+
+#if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) || defined(SXFortran) || defined(pgiFortran)
+/* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F.   */
+/* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown.           */
+#define LOGICAL_STRICT      /* Other Fortran have .eqv./.neqv. == .eq./.ne.   */
+#endif
+
+#define C2FLOGICALV(A,I) \
+ do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (0)
+#define F2CLOGICALV(A,I) \
+ do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (0)
+
+#if defined(apolloFortran)
+#define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1))
+#define F2CLOGICAL(L) ((L)<0?(L):0) 
+#else
+#if defined(CRAYFortran)
+#define C2FLOGICAL(L) _btol(L)
+#define F2CLOGICAL(L) _ltob(&(L))     /* Strangely _ltob() expects a pointer. */
+#else
+#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran)
+/* How come no AbsoftProFortran ? */
+#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
+#define F2CLOGICAL(L) ((L)&1?(L):0)
+#else
+#if defined(CONVEXFortran)
+#define C2FLOGICAL(L) ((L) ? ~0 : 0 )
+#define F2CLOGICAL(L) (L)
+#else   /* others evaluate LOGICALs as for C. */
+#define C2FLOGICAL(L) (L)
+#define F2CLOGICAL(L) (L)
+#ifndef LOGICAL_STRICT
+#undef  C2FLOGICALV
+#undef  F2CLOGICALV
+#define C2FLOGICALV(A,I)
+#define F2CLOGICALV(A,I)
+#endif  /* LOGICAL_STRICT                     */
+#endif  /* CONVEXFortran || All Others        */
+#endif  /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */
+#endif  /* CRAYFortran                        */
+#endif  /* apolloFortran                      */
+
+/* 970514 - In addition to CRAY, there may be other machines
+            for which LOGICAL_STRICT makes no sense. */
+#if defined(LOGICAL_STRICT) && !defined(CRAYFortran)
+/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
+   SX/PowerStationFortran only have 0 and 1 defined.
+   Elsewhere, only needed if you want to do:
+     logical lvariable
+     if (lvariable .eq.  .true.) then       ! (1)
+   instead of
+     if (lvariable .eqv. .true.) then       ! (2)
+   - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
+     refuse to compile (1), so you are probably well advised to stay away from 
+     (1) and from LOGICAL_STRICT.
+   - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
+#undef  C2FLOGICAL
+#ifdef hpuxFortran800
+#define C2FLOGICAL(L) ((L)?0x01000000:0)
+#else
+#if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran)
+#define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/
+#else
+#define C2FLOGICAL(L) ((L)? 1:0) /* All others     use +1/0 for .true./.false.*/
+#endif
+#endif
+#endif /* LOGICAL_STRICT */
+
+/* Convert a vector of C strings into FORTRAN strings. */
+#ifndef __CF__KnR
+static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
+#else
+static char *c2fstrv(      cstr,       fstr,     elem_len,     sizeofcstr)
+                     char* cstr; char *fstr; int elem_len; int sizeofcstr;
+#endif
+{ int i,j;
+/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
+   Useful size of string must be the same in both languages. */
+for (i=0; i<sizeofcstr/elem_len; i++) {
+  for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
+  cstr += 1+elem_len-j;
+  for (; j<elem_len; j++) *fstr++ = ' ';
+} /* 95109 - Seems to be returning the original fstr. */
+return fstr-sizeofcstr+sizeofcstr/elem_len; }
+
+/* Convert a vector of FORTRAN strings into C strings. */
+#ifndef __CF__KnR
+static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
+#else
+static char *f2cstrv(      fstr,       cstr,     elem_len,     sizeofcstr)
+                     char *fstr; char* cstr; int elem_len; int sizeofcstr; 
+#endif
+{ int i,j;
+/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
+   Useful size of string must be the same in both languages. */
+cstr += sizeofcstr;
+fstr += sizeofcstr - sizeofcstr/elem_len;
+for (i=0; i<sizeofcstr/elem_len; i++) {
+  *--cstr = '\0';
+  for (j=1; j<elem_len; j++) *--cstr = *--fstr;
+} return cstr; }
+
+/* kill the trailing char t's in string s. */
+#ifndef __CF__KnR
+static char *kill_trailing(char *s, char t)
+#else
+static char *kill_trailing(      s,      t) char *s; char t;
+#endif
+{char *e; 
+e = s + strlen(s);
+if (e>s) {                           /* Need this to handle NULL string.*/
+  while (e>s && *--e==t);            /* Don't follow t's past beginning. */
+  e[*e==t?0:1] = '\0';               /* Handle s[0]=t correctly.       */
+} return s; }
+
+/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally 
+points to the terminating '\0' of s, but may actually point to anywhere in s.
+s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
+If e<s string s is left unchanged. */ 
+#ifndef __CF__KnR
+static char *kill_trailingn(char *s, char t, char *e)
+#else
+static char *kill_trailingn(      s,      t,       e) char *s; char t; char *e;
+#endif
+{ 
+if (e==s) *e = '\0';                 /* Kill the string makes sense here.*/
+else if (e>s) {                      /* Watch out for neg. length string.*/
+  while (e>s && *--e==t);            /* Don't follow t's past beginning. */
+  e[*e==t?0:1] = '\0';               /* Handle s[0]=t correctly.       */
+} return s; }
+
+/* Note the following assumes that any element which has t's to be chopped off,
+does indeed fill the entire element. */
+#ifndef __CF__KnR
+static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
+#else
+static char *vkill_trailing(      cstr,     elem_len,     sizeofcstr,      t)
+                            char* cstr; int elem_len; int sizeofcstr; char t;
+#endif
+{ int i;
+for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
+  kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
+return cstr; }
+
+#ifdef vmsFortran
+typedef struct dsc$descriptor_s fstring;
+#define DSC$DESCRIPTOR_A(DIMCT)                                                \
+struct {                                                                       \
+  unsigned short dsc$w_length;          unsigned char    dsc$b_dtype;          \
+  unsigned char  dsc$b_class;                    char   *dsc$a_pointer;        \
+           char  dsc$b_scale;           unsigned char    dsc$b_digits;         \
+  struct {                                                                     \
+    unsigned                   : 3;       unsigned dsc$v_fl_binscale : 1;      \
+    unsigned dsc$v_fl_redim    : 1;       unsigned dsc$v_fl_column   : 1;      \
+    unsigned dsc$v_fl_coeff    : 1;       unsigned dsc$v_fl_bounds   : 1;      \
+  } dsc$b_aflags;                                                              \
+  unsigned char  dsc$b_dimct;           unsigned long    dsc$l_arsize;         \
+           char *dsc$a_a0;                       long    dsc$l_m [DIMCT];      \
+  struct {                                                                     \
+    long dsc$l_l;                         long dsc$l_u;                        \
+  } dsc$bounds [DIMCT];                                                        \
+}
+typedef DSC$DESCRIPTOR_A(1) fstringvector;
+/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
+  typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
+#define initfstr(F,C,ELEMNO,ELEMLEN)                                           \
+( (F).dsc$l_arsize=  ( (F).dsc$w_length                        =(ELEMLEN) )    \
+                    *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO)  ),   \
+  (F).dsc$a_a0    =  ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length          ,(F))
+
+#else
+#define _NUM_ELEMS      -1
+#define _NUM_ELEM_ARG   -2
+#define NUM_ELEMS(A)    A,_NUM_ELEMS
+#define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG
+#define TERM_CHARS(A,B) A,B
+#ifndef __CF__KnR
+static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
+#else
+static int num_elem(      strv,          elem_len,     term_char,     num_term)
+                    char *strv; unsigned elem_len; int term_char; int num_term;
+#endif
+/* elem_len is the number of characters in each element of strv, the FORTRAN
+vector of strings. The last element of the vector must begin with at least
+num_term term_char characters, so that this routine can determine how 
+many elements are in the vector. */
+{
+unsigned num,i;
+if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG) 
+  return term_char;
+if (num_term <=0) num_term = (int)elem_len;
+for (num=0; ; num++) {
+  for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++);
+  if (i==(unsigned)num_term) break;
+  else strv += elem_len-i;
+}
+return (int)num;
+}
+#endif
+/*-------------------------------------------------------------------------*/
+
+/*           UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS       */
+
+/* C string TO Fortran Common Block STRing. */
+/* DIM is the number of DIMensions of the array in terms of strings, not
+   characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
+#define C2FCBSTR(CSTR,FSTR,DIM)                                                \
+ c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,    \
+         sizeof(FSTR)+cfelementsof(FSTR,DIM))
+
+/* Fortran Common Block string TO C STRing. */
+#define FCB2CSTR(FSTR,CSTR,DIM)                                                \
+ vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR,                            \
+                        sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,                 \
+                        sizeof(FSTR)+cfelementsof(FSTR,DIM)),                  \
+                sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,                         \
+                sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
+
+#define cfDEREFERENCE0
+#define cfDEREFERENCE1 *
+#define cfDEREFERENCE2 **
+#define cfDEREFERENCE3 ***
+#define cfDEREFERENCE4 ****
+#define cfDEREFERENCE5 *****
+#define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A)))
+
+/*-------------------------------------------------------------------------*/
+
+/*               UTILITIES FOR C TO CALL FORTRAN SUBROUTINES               */
+
+/* Define lookup tables for how to handle the various types of variables.  */
+
+#ifdef OLD_VAXC                                /* Prevent %CC-I-PARAMNOTUSED. */
+#pragma nostandard
+#endif
+
+#define ZTRINGV_NUM(I)       I
+#define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */
+#define ZTRINGV_ARGF(I) _2(A,I)
+#ifdef CFSUBASFUN
+#define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I)
+#else
+#define ZTRINGV_ARGS(I) _2(B,I)
+#endif
+
+#define    PBYTE_cfVP(A,B) PINT_cfVP(A,B)
+#define  PDOUBLE_cfVP(A,B)
+#define   PFLOAT_cfVP(A,B)
+#ifdef ZTRINGV_ARGS_allows_Pvariables
+/* This allows Pvariables for ARGS. ARGF machinery is above ARGFP.
+ * B is not needed because the variable may be changed by the Fortran routine,
+ * but because B is the only way to access an arbitrary macro argument.       */
+#define     PINT_cfVP(A,B) int  B = (int)A;              /* For ZSTRINGV_ARGS */
+#else
+#define     PINT_cfVP(A,B)
+#endif
+#define PLOGICAL_cfVP(A,B) int *B;      /* Returning LOGICAL in FUNn and SUBn */
+#define    PLONG_cfVP(A,B) PINT_cfVP(A,B)
+#define   PSHORT_cfVP(A,B) PINT_cfVP(A,B)
+
+#define        VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A;
+#define        VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B)
+/* _cfVCF table is directly mapped to _cfCCC table. */
+#define     BYTE_cfVCF(A,B)
+#define   DOUBLE_cfVCF(A,B)
+#if !defined(__CF__KnR)
+#define    FLOAT_cfVCF(A,B)
+#else
+#define    FLOAT_cfVCF(A,B) FORTRAN_REAL B = A;
+#endif
+#define      INT_cfVCF(A,B)
+#define  LOGICAL_cfVCF(A,B)
+#define     LONG_cfVCF(A,B)
+#define    SHORT_cfVCF(A,B)
+
+/* 980416
+   Cast (void (*)(CF_NULL_PROTO)) causes SunOS CC 4.2 occasionally to barf,
+   while the following equivalent typedef is fine.
+   For consistency use the typedef on all machines.
+ */
+typedef void (*cfCAST_FUNCTION)(CF_NULL_PROTO);
+
+#define VCF(TN,I)       _Icf4(4,V,TN,_(A,I),_(B,I),F)
+#define VVCF(TN,AI,BI)  _Icf4(4,V,TN,AI,BI,S)
+#define        INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B)
+#define       INTV_cfV(T,A,B,F)
+#define      INTVV_cfV(T,A,B,F)
+#define     INTVVV_cfV(T,A,B,F)
+#define    INTVVVV_cfV(T,A,B,F)
+#define   INTVVVVV_cfV(T,A,B,F)
+#define  INTVVVVVV_cfV(T,A,B,F)
+#define INTVVVVVVV_cfV(T,A,B,F)
+#define PINT_cfV(      T,A,B,F) _(T,_cfVP)(A,B)
+#define PVOID_cfV(     T,A,B,F)
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
+#define    ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (cfCAST_FUNCTION)A;
+#else
+#define    ROUTINE_cfV(T,A,B,F)
+#endif
+#define     SIMPLE_cfV(T,A,B,F)
+#ifdef vmsFortran
+#define     STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B =  \
+                                       {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
+#define    PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
+#define    STRINGV_cfV(T,A,B,F) static fstringvector B =                       \
+  {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
+#define   PSTRINGV_cfV(T,A,B,F) static fstringvector B =                       \
+          {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
+#else
+#define     STRING_cfV(T,A,B,F) struct {unsigned int clen, flen;} B;
+#define    STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen;} B;
+#define    PSTRING_cfV(T,A,B,F) int     B;
+#define   PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B;
+#endif
+#define    ZTRINGV_cfV(T,A,B,F)  STRINGV_cfV(T,A,B,F)
+#define   PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F)
+
+/* Note that the actions of the A table were performed inside the AA table.
+   VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to
+   right, so we had to split the original table into the current robust two. */
+#define ACF(NAME,TN,AI,I)      _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0)
+#define   DEFAULT_cfA(M,I,A,B)
+#define   LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B);
+#define  PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A);
+#define    STRING_cfA(M,I,A,B)  STRING_cfC(M,I,A,B,sizeof(A))
+#define   PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A))
+#ifdef vmsFortran
+#define  AATRINGV_cfA(    A,B, sA,filA,silA)                                   \
+ initfstr(B,_cf_malloc((sA)-(filA)),(filA),(silA)-1),                          \
+          c2fstrv(A,B.dsc$a_pointer,(silA),(sA));
+#define APATRINGV_cfA(    A,B, sA,filA,silA)                                   \
+ initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA));
+#else
+#define  AATRINGV_cfA(    A,B, sA,filA,silA)                                   \
+     (B.s=_cf_malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA)));
+#define APATRINGV_cfA(    A,B, sA,filA,silA)                                   \
+ B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA));
+#endif
+#define   STRINGV_cfA(M,I,A,B)                                                 \
+    AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
+#define  PSTRINGV_cfA(M,I,A,B)                                                 \
+   APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
+#define   ZTRINGV_cfA(M,I,A,B)  AATRINGV_cfA( (char *)A,B,                     \
+                    (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1),                \
+                              (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
+#define  PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B,                     \
+                    (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1),                \
+                              (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
+
+#define    PBYTE_cfAAP(A,B) &A
+#define  PDOUBLE_cfAAP(A,B) &A
+#define   PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A
+#define     PINT_cfAAP(A,B) &A
+#define PLOGICAL_cfAAP(A,B) B= &A         /* B used to keep a common W table. */
+#define    PLONG_cfAAP(A,B) &A
+#define   PSHORT_cfAAP(A,B) &A
+
+#define AACF(TN,AI,I,C) _SEP_(TN,C,cfCOMMA) _Icf(3,AA,TN,AI,_(B,I))
+#define        INT_cfAA(T,A,B) &B
+#define       INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A
+#define      INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP)  A[0]
+#define     INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP)   A[0][0]
+#define    INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP)    A[0][0][0]
+#define   INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP)     A[0][0][0][0]
+#define  INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP)      A[0][0][0][0][0]
+#define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP)       A[0][0][0][0][0][0]
+#define       PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B)
+#define      PVOID_cfAA(T,A,B) (void *) A
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
+#define    ROUTINE_cfAA(T,A,B) &B
+#else
+#define    ROUTINE_cfAA(T,A,B) (cfCAST_FUNCTION)A
+#endif
+#define     STRING_cfAA(T,A,B)  STRING_cfCC(T,A,B)
+#define    PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B)
+#ifdef vmsFortran
+#define    STRINGV_cfAA(T,A,B) &B
+#else
+#ifdef CRAYFortran
+#define    STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen)
+#else
+#define    STRINGV_cfAA(T,A,B) B.fs
+#endif
+#endif
+#define   PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
+#define    ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
+#define   PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
+
+#if defined(vmsFortran) || defined(CRAYFortran)
+#define JCF(TN,I)
+#define KCF(TN,I)
+#else
+#define JCF(TN,I)    _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0)
+#if defined(AbsoftUNIXFortran)
+#define  DEFAULT_cfJ(B) ,0
+#else
+#define  DEFAULT_cfJ(B)
+#endif
+#define  LOGICAL_cfJ(B) DEFAULT_cfJ(B)
+#define PLOGICAL_cfJ(B) DEFAULT_cfJ(B)
+#define   STRING_cfJ(B) ,B.flen
+#define  PSTRING_cfJ(B) ,B
+#define  STRINGV_cfJ(B) STRING_cfJ(B)
+#define PSTRINGV_cfJ(B) STRING_cfJ(B)
+#define  ZTRINGV_cfJ(B) STRING_cfJ(B)
+#define PZTRINGV_cfJ(B) STRING_cfJ(B)
+
+/* KCF is identical to DCF, except that KCF ZTRING is not empty. */
+#define KCF(TN,I)    _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0)
+#if defined(AbsoftUNIXFortran)
+#define  DEFAULT_cfKK(B) , unsigned B
+#else
+#define  DEFAULT_cfKK(B)
+#endif
+#define  LOGICAL_cfKK(B) DEFAULT_cfKK(B)
+#define PLOGICAL_cfKK(B) DEFAULT_cfKK(B)
+#define   STRING_cfKK(B) , unsigned B
+#define  PSTRING_cfKK(B) STRING_cfKK(B)
+#define  STRINGV_cfKK(B) STRING_cfKK(B)
+#define PSTRINGV_cfKK(B) STRING_cfKK(B)
+#define  ZTRINGV_cfKK(B) STRING_cfKK(B)
+#define PZTRINGV_cfKK(B) STRING_cfKK(B)
+#endif
+
+#define WCF(TN,AN,I)      _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0)
+#define  DEFAULT_cfW(A,B)
+#define  LOGICAL_cfW(A,B)
+#define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B);
+#define   STRING_cfW(A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0); /* A?="constnt"*/
+#define  PSTRING_cfW(A,B) kill_trailing(A,' ');
+#ifdef vmsFortran
+#define  STRINGV_cfW(A,B) _cf_free(B.dsc$a_pointer);
+#define PSTRINGV_cfW(A,B)                                                      \
+  vkill_trailing(f2cstrv((char*)A, (char*)A,                                   \
+                           B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]),     \
+                   B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
+#else
+#define  STRINGV_cfW(A,B) _cf_free(B.s);
+#define PSTRINGV_cfW(A,B) vkill_trailing(                                      \
+         f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
+#endif
+#define  ZTRINGV_cfW(A,B)      STRINGV_cfW(A,B)
+#define PZTRINGV_cfW(A,B)     PSTRINGV_cfW(A,B)
+
+#define   NCF(TN,I,C)       _SEP_(TN,C,cfCOMMA) _Icf(2,N,TN,_(A,I),0) 
+#define  NNCF(TN,I,C)        UUCF(TN,I,C)
+#define NNNCF(TN,I,C)       _SEP_(TN,C,cfCOLON) _Icf(2,N,TN,_(A,I),0) 
+#define        INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A
+#define       INTV_cfN(T,A) _(T,VVVVVV_cfTYPE)  * A
+#define      INTVV_cfN(T,A) _(T,VVVVV_cfTYPE)   * A
+#define     INTVVV_cfN(T,A) _(T,VVVV_cfTYPE)    * A
+#define    INTVVVV_cfN(T,A) _(T,VVV_cfTYPE)     * A
+#define   INTVVVVV_cfN(T,A) _(T,VV_cfTYPE)      * A
+#define  INTVVVVVV_cfN(T,A) _(T,V_cfTYPE)       * A
+#define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE)        * A
+#define       PINT_cfN(T,A) _(T,_cfTYPE)        * A
+#define      PVOID_cfN(T,A) void *                A
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
+#define    ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO)
+#else
+#define    ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO)
+#endif
+#ifdef vmsFortran
+#define     STRING_cfN(T,A) fstring *             A
+#define    STRINGV_cfN(T,A) fstringvector *       A
+#else
+#ifdef CRAYFortran
+#define     STRING_cfN(T,A) _fcd                  A
+#define    STRINGV_cfN(T,A) _fcd                  A
+#else
+#define     STRING_cfN(T,A) char *                A
+#define    STRINGV_cfN(T,A) char *                A
+#endif
+#endif
+#define    PSTRING_cfN(T,A)   STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
+#define   PNSTRING_cfN(T,A)   STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
+#define   PPSTRING_cfN(T,A)   STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
+#define   PSTRINGV_cfN(T,A)  STRINGV_cfN(T,A)
+#define    ZTRINGV_cfN(T,A)  STRINGV_cfN(T,A)
+#define   PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A)
+
+
+/* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix
+   can't hack more than 31 arg's.
+   e.g. ultrix >= 4.3 gives message:
+       zow35> cc -c -DDECFortran cfortest.c
+       cfe: Fatal: Out of memory: cfortest.c
+       zow35>
+   Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine
+   if using -Aa, otherwise we have a problem.
+ */
+#ifndef MAX_PREPRO_ARGS
+#if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR)))
+#define MAX_PREPRO_ARGS 31
+#else
+#define MAX_PREPRO_ARGS 99
+#endif
+#endif
+
+#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
+/* In addition to explicit Absoft stuff, only Absoft requires:
+   - DEFAULT coming from _cfSTR.
+     DEFAULT could have been called e.g. INT, but keep it for clarity.
+   - M term in CFARGT14 and CFARGT14FS.
+ */
+#define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0)
+#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0)
+#define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0)
+#define DEFAULT_cfABSOFT1
+#define LOGICAL_cfABSOFT1
+#define  STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING
+#define DEFAULT_cfABSOFT2
+#define LOGICAL_cfABSOFT2
+#define  STRING_cfABSOFT2 ,unsigned D0
+#define DEFAULT_cfABSOFT3
+#define LOGICAL_cfABSOFT3
+#define  STRING_cfABSOFT3 ,D0
+#else
+#define ABSOFT_cf1(T0)
+#define ABSOFT_cf2(T0)
+#define ABSOFT_cf3(T0)
+#endif
+
+/* _Z introduced to cicumvent IBM and HP silly preprocessor warning.
+   e.g. "Macro CFARGT14 invoked with a null argument."
+ */
+#define _Z
+
+#define  CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)                \
+ S(T1,1)   S(T2,2)   S(T3,3)    S(T4,4)    S(T5,5)    S(T6,6)    S(T7,7)       \
+ S(T8,8)   S(T9,9)   S(TA,10)   S(TB,11)   S(TC,12)   S(TD,13)   S(TE,14)
+#define  CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ S(T1,1)   S(T2,2)   S(T3,3)    S(T4,4)    S(T5,5)    S(T6,6)    S(T7,7)       \
+ S(T8,8)   S(T9,9)   S(TA,10)   S(TB,11)   S(TC,12)   S(TD,13)   S(TE,14)      \
+ S(TF,15)  S(TG,16)  S(TH,17)   S(TI,18)   S(TJ,19)   S(TK,20)   S(TL,21)      \
+ S(TM,22)  S(TN,23)  S(TO,24)   S(TP,25)   S(TQ,26)   S(TR,27)
+
+#define  CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)           \
+ F(T1,1,0) F(T2,2,1) F(T3,3,1)  F(T4,4,1)  F(T5,5,1)  F(T6,6,1)  F(T7,7,1)     \
+ F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)    \
+ M       CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define  CFARGT27FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ F(T1,1,0)  F(T2,2,1)  F(T3,3,1)  F(T4,4,1)  F(T5,5,1)  F(T6,6,1)  F(T7,7,1)   \
+ F(T8,8,1)  F(T9,9,1)  F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)  \
+ F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1)  \
+ F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1)             \
+ M       CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
+
+#if !(defined(PowerStationFortran)||defined(hpuxFortran800))
+/*  Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields:
+      SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c
+      "c.c", line 406: warning: argument mismatch
+    Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok.
+    Behavior is most clearly seen in example:
+      #define A 1 , 2
+      #define  C(X,Y,Z) x=X. y=Y. z=Z.
+      #define  D(X,Y,Z) C(X,Y,Z)
+      D(x,A,z)
+    Output from preprocessor is: x = x . y = 1 . z = 2 .
+ #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+       CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+*/
+#define  CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)             \
+ F(T1,1,0) F(T2,2,1) F(T3,3,1)  F(T4,4,1)  F(T5,5,1)  F(T6,6,1)  F(T7,7,1)     \
+ F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)    \
+ M       CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define  CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ F(T1,1,0)  F(T2,2,1)  F(T3,3,1)  F(T4,4,1)  F(T5,5,1)  F(T6,6,1)  F(T7,7,1)   \
+ F(T8,8,1)  F(T9,9,1)  F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)  \
+ F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1)  \
+ F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1)             \
+ M       CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
+
+#define  CFARGT20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+ F(T1,1,0)  F(T2,2,1)  F(T3,3,1)  F(T4,4,1)  F(T5,5,1)  F(T6,6,1)  F(T7,7,1)   \
+ F(T8,8,1)  F(T9,9,1)  F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)  \
+ F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1)             \
+ S(T1,1)    S(T2,2)    S(T3,3)    S(T4,4)    S(T5,5)    S(T6,6)    S(T7,7)     \
+ S(T8,8)    S(T9,9)    S(TA,10)   S(TB,11)   S(TC,12)   S(TD,13)   S(TE,14)    \
+ S(TF,15)   S(TG,16)   S(TH,17)   S(TI,18)   S(TJ,19)   S(TK,20)
+#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
+ F(T1,A1,1,0)  F(T2,A2,2,1)  F(T3,A3,3,1) F(T4,A4,4,1)  F(T5,A5,5,1)  F(T6,A6,6,1)  \
+ F(T7,A7,7,1)  F(T8,A8,8,1)  F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
+ F(TD,AD,13,1) F(TE,AE,14,1) S(T1,1)      S(T2,2)       S(T3,3)       S(T4,4)       \
+ S(T5,5)       S(T6,6)       S(T7,7)      S(T8,8)       S(T9,9)       S(TA,10)      \
+ S(TB,11)      S(TC,12)      S(TD,13)     S(TE,14)
+#if MAX_PREPRO_ARGS>31
+#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
+ F(T1,A1,1,0)  F(T2,A2,2,1)  F(T3,A3,3,1)  F(T4,A4,4,1)  F(T5,A5,5,1)  F(T6,A6,6,1)  \
+ F(T7,A7,7,1)  F(T8,A8,8,1)  F(T9,A9,9,1)  F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
+ F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \
+ F(TJ,AJ,19,1) F(TK,AK,20,1) S(T1,1)       S(T2,2)       S(T3,3)       S(T4,4)       \
+ S(T5,5)       S(T6,6)       S(T7,7)       S(T8,8)       S(T9,9)       S(TA,10)      \
+ S(TB,11)      S(TC,12)      S(TD,13)      S(TE,14)      S(TF,15)      S(TG,16)      \
+ S(TH,17)      S(TI,18)      S(TJ,19)      S(TK,20)
+#endif
+#else
+#define  CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)             \
+ F(T1,1,0) S(T1,1) F(T2,2,1)  S(T2,2)  F(T3,3,1)  S(T3,3)  F(T4,4,1)  S(T4,4)  \
+ F(T5,5,1) S(T5,5) F(T6,6,1)  S(T6,6)  F(T7,7,1)  S(T7,7)  F(T8,8,1)  S(T8,8)  \
+ F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
+ F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14)
+#define  CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ F(T1,1,0)  S(T1,1)  F(T2,2,1)  S(T2,2)  F(T3,3,1)  S(T3,3)  F(T4,4,1)  S(T4,4)  \
+ F(T5,5,1)  S(T5,5)  F(T6,6,1)  S(T6,6)  F(T7,7,1)  S(T7,7)  F(T8,8,1)  S(T8,8)  \
+ F(T9,9,1)  S(T9,9)  F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
+ F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
+ F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20)  \
+ F(TL,21,1) S(TL,21) F(TM,22,1) S(TM,22) F(TN,23,1) S(TN,23) F(TO,24,1) S(TO,24)  \
+ F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27)
+
+#define  CFARGT20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+ F(T1,1,0)  S(T1,1)  F(T2,2,1)  S(T2,2)  F(T3,3,1)  S(T3,3)  F(T4,4,1)  S(T4,4)  \
+ F(T5,5,1)  S(T5,5)  F(T6,6,1)  S(T6,6)  F(T7,7,1)  S(T7,7)  F(T8,8,1)  S(T8,8)  \
+ F(T9,9,1)  S(T9,9)  F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
+ F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
+ F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20)
+#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
+ F(T1,A1,1,0)  S(T1,1)  F(T2,A2,2,1)  S(T2,2)  F(T3,A3,3,1)  S(T3,3)           \
+ F(T4,A4,4,1)  S(T4,4)  F(T5,A5,5,1)  S(T5,5)  F(T6,A6,6,1)  S(T6,6)           \
+ F(T7,A7,7,1)  S(T7,7)  F(T8,A8,8,1)  S(T8,8)  F(T9,A9,9,1)  S(T9,9)           \
+ F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12)          \
+ F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14)
+#if MAX_PREPRO_ARGS>31
+#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
+ F(T1,A1,1,0)  S(T1,1)  F(T2,A2,2,1)  S(T2,2)  F(T3,A3,3,1)  S(T3,3)           \
+ F(T4,A4,4,1)  S(T4,4)  F(T5,A5,5,1)  S(T5,5)  F(T6,A6,6,1)  S(T6,6)           \
+ F(T7,A7,7,1)  S(T7,7)  F(T8,A8,8,1)  S(T8,8)  F(T9,A9,9,1)  S(T9,9)           \
+ F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12)          \
+ F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15)          \
+ F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18)          \
+ F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20)                
+#endif
+#endif
+
+
+#define PROTOCCALLSFSUB1( UN,LN,T1) \
+        PROTOCCALLSFSUB14(UN,LN,T1,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB2( UN,LN,T1,T2) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
+#define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
+
+
+#define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
+        PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
+        PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
+        PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
+        PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
+#define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
+        PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
+
+
+#ifndef FCALLSC_QUALIFIER
+#ifdef VISUAL_CPLUSPLUS
+#define FCALLSC_QUALIFIER __stdcall
+#else
+#define FCALLSC_QUALIFIER
+#endif
+#endif
+
+#ifdef __cplusplus
+#define CFextern extern "C"
+#else
+#define CFextern extern
+#endif
+
+
+#ifdef CFSUBASFUN
+#define PROTOCCALLSFSUB0(UN,LN) \
+   PROTOCCALLSFFUN0( VOID,UN,LN)
+#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+   PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
+   PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
+#else
+/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after 
+   #include-ing cfortran.h if calling the FORTRAN wrapper within the same 
+   source code where the wrapper is created. */
+#define PROTOCCALLSFSUB0(UN,LN)     CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)();
+#ifndef __CF__KnR
+#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) );
+#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
+ CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)( CFARGT20(NCF,KCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) );
+#else
+#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)     \
+         PROTOCCALLSFSUB0(UN,LN)
+#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+         PROTOCCALLSFSUB0(UN,LN)
+#endif
+#endif
+
+
+#ifdef OLD_VAXC                                  /* Allow %CC-I-PARAMNOTUSED. */
+#pragma standard
+#endif
+
+
+#define CCALLSFSUB1( UN,LN,T1,                        A1)         \
+        CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
+#define CCALLSFSUB2( UN,LN,T1,T2,                     A1,A2)      \
+        CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
+#define CCALLSFSUB3( UN,LN,T1,T2,T3,                  A1,A2,A3)   \
+        CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
+#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4,               A1,A2,A3,A4)\
+        CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
+#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5,            A1,A2,A3,A4,A5)          \
+        CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
+#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6,         A1,A2,A3,A4,A5,A6)       \
+        CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
+#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7,      A1,A2,A3,A4,A5,A6,A7)    \
+        CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
+#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,   A1,A2,A3,A4,A5,A6,A7,A8) \
+        CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
+#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
+        CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
+#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
+        CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
+#define CCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
+        CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
+#define CCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
+        CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
+#define CCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
+        CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
+
+#ifdef __cplusplus
+#define CPPPROTOCLSFSUB0( UN,LN)
+#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
+#else
+#define CPPPROTOCLSFSUB0(UN,LN) \
+        PROTOCCALLSFSUB0(UN,LN)
+#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)     \
+        PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+        PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
+#endif
+
+#ifdef CFSUBASFUN
+#define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN)
+#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
+        CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)
+#else
+/* do{...}while(0) allows if(a==b) FORT(); else BORT(); */
+#define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(0)
+#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
+do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5)  \
+   VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
+   VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14)             \
+   CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)          \
+   ACF(LN,T1,A1,1)  ACF(LN,T2,A2,2)  ACF(LN,T3,A3,3)                           \
+   ACF(LN,T4,A4,4)  ACF(LN,T5,A5,5)  ACF(LN,T6,A6,6)  ACF(LN,T7,A7,7)          \
+   ACF(LN,T8,A8,8)  ACF(LN,T9,A9,9)  ACF(LN,TA,AA,10) ACF(LN,TB,AB,11)         \
+   ACF(LN,TC,AC,12) ACF(LN,TD,AD,13) ACF(LN,TE,AE,14)                          \
+   CFC_(UN,LN)( CFARGTA14(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) );\
+   WCF(T1,A1,1)  WCF(T2,A2,2)  WCF(T3,A3,3)  WCF(T4,A4,4)  WCF(T5,A5,5)        \
+   WCF(T6,A6,6)  WCF(T7,A7,7)  WCF(T8,A8,8)  WCF(T9,A9,9)  WCF(TA,AA,10)       \
+   WCF(TB,AB,11) WCF(TC,AC,12) WCF(TD,AD,13) WCF(TE,AE,14)      }while(0)
+#endif
+
+
+#if MAX_PREPRO_ARGS>31
+#define CCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF)\
+        CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,0,0,0,0,0)
+#define CCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)\
+        CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,0,0,0,0)
+#define CCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH)\
+        CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,0,0,0)
+#define CCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI)\
+        CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,0,0)
+#define CCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ)\
+        CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,0)
+
+#ifdef CFSUBASFUN
+#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
+        TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
+        CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
+        TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK)
+#else
+#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
+        TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
+do{VVCF(T1,A1,B1)  VVCF(T2,A2,B2)  VVCF(T3,A3,B3)  VVCF(T4,A4,B4)  VVCF(T5,A5,B5)   \
+   VVCF(T6,A6,B6)  VVCF(T7,A7,B7)  VVCF(T8,A8,B8)  VVCF(T9,A9,B9)  VVCF(TA,AA,B10)  \
+   VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15)  \
+   VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20)  \
+   CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)  \
+   ACF(LN,T1,A1,1)  ACF(LN,T2,A2,2)  ACF(LN,T3,A3,3)  ACF(LN,T4,A4,4)          \
+   ACF(LN,T5,A5,5)  ACF(LN,T6,A6,6)  ACF(LN,T7,A7,7)  ACF(LN,T8,A8,8)          \
+   ACF(LN,T9,A9,9)  ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12)         \
+   ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16)         \
+   ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20)         \
+   CFC_(UN,LN)( CFARGTA20(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) ); \
+ WCF(T1,A1,1)  WCF(T2,A2,2)  WCF(T3,A3,3)  WCF(T4,A4,4)  WCF(T5,A5,5)  WCF(T6,A6,6)  \
+ WCF(T7,A7,7)  WCF(T8,A8,8)  WCF(T9,A9,9)  WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
+ WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
+ WCF(TJ,AJ,19) WCF(TK,AK,20) }while(0)
+#endif
+#endif         /* MAX_PREPRO_ARGS */
+
+/*-------------------------------------------------------------------------*/
+
+/*               UTILITIES FOR C TO CALL FORTRAN FUNCTIONS                 */
+
+/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
+  function is called. Therefore, especially for creator's of C header files
+  for large FORTRAN libraries which include many functions, to reduce
+  compile time and object code size, it may be desirable to create
+  preprocessor directives to allow users to create code for only those
+  functions which they use.                                                */
+
+/* The following defines the maximum length string that a function can return.
+   Of course it may be undefine-d and re-define-d before individual
+   PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived
+   from the individual machines' limits.                                      */
+#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
+
+/* The following defines a character used by CFORTRAN.H to flag the end of a
+   string coming out of a FORTRAN routine.                                 */
+#define CFORTRAN_NON_CHAR 0x7F
+
+#ifdef OLD_VAXC                                /* Prevent %CC-I-PARAMNOTUSED. */
+#pragma nostandard
+#endif
+
+#define _SEP_(TN,C,cfCOMMA)     _(__SEP_,C)(TN,cfCOMMA)
+#define __SEP_0(TN,cfCOMMA)  
+#define __SEP_1(TN,cfCOMMA)     _Icf(2,SEP,TN,cfCOMMA,0)
+#define        INT_cfSEP(T,B) _(A,B)
+#define       INTV_cfSEP(T,B) INT_cfSEP(T,B)
+#define      INTVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define     INTVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define    INTVVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define   INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define  INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define       PINT_cfSEP(T,B) INT_cfSEP(T,B)
+#define      PVOID_cfSEP(T,B) INT_cfSEP(T,B)
+#define    ROUTINE_cfSEP(T,B) INT_cfSEP(T,B)
+#define     SIMPLE_cfSEP(T,B) INT_cfSEP(T,B)
+#define       VOID_cfSEP(T,B) INT_cfSEP(T,B)    /* For FORTRAN calls C subr.s.*/
+#define     STRING_cfSEP(T,B) INT_cfSEP(T,B)
+#define    STRINGV_cfSEP(T,B) INT_cfSEP(T,B)
+#define    PSTRING_cfSEP(T,B) INT_cfSEP(T,B)
+#define   PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
+#define   PNSTRING_cfSEP(T,B) INT_cfSEP(T,B)
+#define   PPSTRING_cfSEP(T,B) INT_cfSEP(T,B)
+#define    ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
+#define   PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
+                         
+#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE)
+#ifdef OLD_VAXC
+#define INTEGER_BYTE               char    /* Old VAXC barfs on 'signed char' */
+#else
+#define INTEGER_BYTE        signed char    /* default */
+#endif
+#else
+#define INTEGER_BYTE        unsigned char
+#endif
+#define    BYTEVVVVVVV_cfTYPE INTEGER_BYTE
+#define  DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION 
+#define   FLOATVVVVVVV_cfTYPE FORTRAN_REAL
+#define     INTVVVVVVV_cfTYPE int
+#define LOGICALVVVVVVV_cfTYPE int
+#define    LONGVVVVVVV_cfTYPE long
+#define   SHORTVVVVVVV_cfTYPE short
+#define          PBYTE_cfTYPE INTEGER_BYTE
+#define        PDOUBLE_cfTYPE DOUBLE_PRECISION 
+#define         PFLOAT_cfTYPE FORTRAN_REAL
+#define           PINT_cfTYPE int
+#define       PLOGICAL_cfTYPE int
+#define          PLONG_cfTYPE long
+#define         PSHORT_cfTYPE short
+
+#define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A)
+#define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V)
+#define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W)
+#define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X)
+#define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y)
+#define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z)
+
+#define  _Icf(N,T,I,X,Y)                 _(I,_cfINT)(N,T,I,X,Y,0)
+#define _Icf4(N,T,I,X,Y,Z)               _(I,_cfINT)(N,T,I,X,Y,Z)
+#define           BYTE_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define         DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0)
+#define          FLOAT_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define            INT_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define        LOGICAL_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define           LONG_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define          SHORT_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define          PBYTE_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define        PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0)
+#define         PFLOAT_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define           PINT_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define       PLOGICAL_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define          PLONG_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define         PSHORT_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define          BYTEV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define         BYTEVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define        BYTEVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define       BYTEVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define      BYTEVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define     BYTEVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define    BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define        DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0)
+#define       DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0)
+#define      DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0)
+#define     DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0)
+#define    DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0)
+#define   DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0)
+#define  DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0)
+#define         FLOATV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define        FLOATVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define       FLOATVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define      FLOATVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define     FLOATVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define    FLOATVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define   FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define           INTV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define          INTVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define         INTVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define        INTVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define       INTVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define      INTVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define     INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define       LOGICALV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define      LOGICALVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define     LOGICALVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define    LOGICALVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define   LOGICALVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define  LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define          LONGV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define         LONGVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define        LONGVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define       LONGVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define      LONGVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define     LONGVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define    LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define         SHORTV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define        SHORTVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define       SHORTVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define      SHORTVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define     SHORTVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define    SHORTVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define   SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define          PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0)
+#define        ROUTINE_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+/*CRAY coughs on the first,
+  i.e. the usual trouble of not being able to
+  define macros to macros with arguments. 
+  New ultrix is worse, it coughs on all such uses.
+ */
+/*#define       SIMPLE_cfINT                    PVOID_cfINT*/
+#define         SIMPLE_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define           VOID_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define         STRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define        STRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define        PSTRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define       PSTRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define       PNSTRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define       PPSTRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define        ZTRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define       PZTRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
+#define           CF_0_cfINT(N,A,B,X,Y,Z)
+                         
+
+#define   UCF(TN,I,C)  _SEP_(TN,C,cfCOMMA) _Icf(2,U,TN,_(A,I),0)
+#define  UUCF(TN,I,C)  _SEP_(TN,C,cfCOMMA) _SEP_(TN,1,I) 
+#define UUUCF(TN,I,C)  _SEP_(TN,C,cfCOLON) _Icf(2,U,TN,_(A,I),0)
+#define        INT_cfU(T,A) _(T,VVVVVVV_cfTYPE)   A
+#define       INTV_cfU(T,A) _(T,VVVVVV_cfTYPE)  * A
+#define      INTVV_cfU(T,A) _(T,VVVVV_cfTYPE)   * A
+#define     INTVVV_cfU(T,A) _(T,VVVV_cfTYPE)    * A
+#define    INTVVVV_cfU(T,A) _(T,VVV_cfTYPE)     * A
+#define   INTVVVVV_cfU(T,A) _(T,VV_cfTYPE)      * A
+#define  INTVVVVVV_cfU(T,A) _(T,V_cfTYPE)       * A
+#define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE)        * A
+#define       PINT_cfU(T,A) _(T,_cfTYPE)        * A
+#define      PVOID_cfU(T,A) void  *A 
+#define    ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO) 
+#define       VOID_cfU(T,A) void   A    /* Needed for C calls FORTRAN sub.s.  */
+#define     STRING_cfU(T,A) char  *A    /*            via VOID and wrapper.   */
+#define    STRINGV_cfU(T,A) char  *A
+#define    PSTRING_cfU(T,A) char  *A
+#define   PSTRINGV_cfU(T,A) char  *A
+#define    ZTRINGV_cfU(T,A) char  *A
+#define   PZTRINGV_cfU(T,A) char  *A
+
+/* VOID breaks U into U and UU. */
+#define       INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A
+#define      VOID_cfUU(T,A)             /* Needed for FORTRAN calls C sub.s.  */
+#define    STRING_cfUU(T,A) char *A 
+
+
+#define      BYTE_cfPU(A)   CFextern INTEGER_BYTE      FCALLSC_QUALIFIER A
+#define    DOUBLE_cfPU(A)   CFextern DOUBLE_PRECISION  FCALLSC_QUALIFIER A
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#define     FLOAT_cfPU(A)   CFextern FORTRAN_REAL      FCALLSC_QUALIFIER A
+#else                                                      
+#define     FLOAT_cfPU(A)   CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A
+#endif                                                     
+#define       INT_cfPU(A)   CFextern int   FCALLSC_QUALIFIER   A
+#define   LOGICAL_cfPU(A)   CFextern int   FCALLSC_QUALIFIER   A
+#define      LONG_cfPU(A)   CFextern long  FCALLSC_QUALIFIER   A
+#define     SHORT_cfPU(A)   CFextern short FCALLSC_QUALIFIER   A
+#define    STRING_cfPU(A)   CFextern void  FCALLSC_QUALIFIER   A
+#define      VOID_cfPU(A)   CFextern void  FCALLSC_QUALIFIER   A
+
+#define    BYTE_cfE INTEGER_BYTE     A0;
+#define  DOUBLE_cfE DOUBLE_PRECISION A0;
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#define   FLOAT_cfE FORTRAN_REAL  A0;
+#else
+#define   FLOAT_cfE FORTRAN_REAL AA0;   FLOATFUNCTIONTYPE A0;
+#endif
+#define     INT_cfE int    A0;
+#define LOGICAL_cfE int    A0;
+#define    LONG_cfE long   A0;
+#define   SHORT_cfE short  A0;
+#define    VOID_cfE
+#ifdef vmsFortran
+#define  STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING];        \
+                       static fstring A0 =                                     \
+             {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
+               memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
+                                    *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
+#else
+#ifdef CRAYFortran
+#define  STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING];        \
+                   static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\
+                memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
+                            A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING);
+#else
+/* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1]; 
+ * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK.     */
+#define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING];          \
+                       memset(A0, CFORTRAN_NON_CHAR,                           \
+                              MAX_LEN_FORTRAN_FUNCTION_STRING);                \
+                       *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
+#endif
+#endif
+/* ESTRING must use static char. array which is guaranteed to exist after
+   function returns.                                                     */
+
+/* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
+       ii)That the following create an unmatched bracket, i.e. '(', which
+          must of course be matched in the call.
+       iii)Commas must be handled very carefully                         */
+#define    INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)(
+#define   VOID_cfGZ(T,UN,LN)    CFC_(UN,LN)(
+#ifdef vmsFortran
+#define STRING_cfGZ(T,UN,LN)    CFC_(UN,LN)(&A0
+#else
+#if defined(CRAYFortran) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
+#define STRING_cfGZ(T,UN,LN)    CFC_(UN,LN)( A0
+#else
+#define STRING_cfGZ(T,UN,LN)    CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING
+#endif
+#endif
+
+#define     INT_cfG(T,UN,LN)    INT_cfGZ(T,UN,LN)
+#define    VOID_cfG(T,UN,LN)   VOID_cfGZ(T,UN,LN)
+#define  STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/
+
+#define    BYTEVVVVVVV_cfPP
+#define     INTVVVVVVV_cfPP     /* These complement FLOATVVVVVVV_cfPP. */
+#define  DOUBLEVVVVVVV_cfPP
+#define LOGICALVVVVVVV_cfPP
+#define    LONGVVVVVVV_cfPP
+#define   SHORTVVVVVVV_cfPP
+#define          PBYTE_cfPP
+#define           PINT_cfPP
+#define        PDOUBLE_cfPP
+#define       PLOGICAL_cfPP
+#define          PLONG_cfPP
+#define         PSHORT_cfPP
+#define         PFLOAT_cfPP FLOATVVVVVVV_cfPP
+
+#define BCF(TN,AN,C)        _SEP_(TN,C,cfCOMMA) _Icf(2,B,TN,AN,0)
+#define        INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A
+#define       INTV_cfB(T,A)            A
+#define      INTVV_cfB(T,A)           (A)[0]
+#define     INTVVV_cfB(T,A)           (A)[0][0]
+#define    INTVVVV_cfB(T,A)           (A)[0][0][0]
+#define   INTVVVVV_cfB(T,A)           (A)[0][0][0][0]
+#define  INTVVVVVV_cfB(T,A)           (A)[0][0][0][0][0]
+#define INTVVVVVVV_cfB(T,A)           (A)[0][0][0][0][0][0]
+#define       PINT_cfB(T,A) _(T,_cfPP)&A
+#define     STRING_cfB(T,A) (char *)   A
+#define    STRINGV_cfB(T,A) (char *)   A
+#define    PSTRING_cfB(T,A) (char *)   A
+#define   PSTRINGV_cfB(T,A) (char *)   A
+#define      PVOID_cfB(T,A) (void *)   A
+#define    ROUTINE_cfB(T,A) (cfCAST_FUNCTION)A
+#define    ZTRINGV_cfB(T,A) (char *)   A
+#define   PZTRINGV_cfB(T,A) (char *)   A
+                                                                
+#define SCF(TN,NAME,I,A)    _(TN,_cfSTR)(3,S,NAME,I,A,0,0)
+#define  DEFAULT_cfS(M,I,A)
+#define  LOGICAL_cfS(M,I,A)
+#define PLOGICAL_cfS(M,I,A)
+#define   STRING_cfS(M,I,A) ,sizeof(A)
+#define  STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \
+                              +secondindexlength(A))
+#define  PSTRING_cfS(M,I,A) ,sizeof(A)
+#define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A)
+#define  ZTRINGV_cfS(M,I,A)
+#define PZTRINGV_cfS(M,I,A)
+
+#define   HCF(TN,I)         _(TN,_cfSTR)(3,H,cfCOMMA, H,_(C,I),0,0)
+#define  HHCF(TN,I)         _(TN,_cfSTR)(3,H,cfCOMMA,HH,_(C,I),0,0)
+#define HHHCF(TN,I)         _(TN,_cfSTR)(3,H,cfCOLON, H,_(C,I),0,0)
+#define  H_CF_SPECIAL       unsigned
+#define HH_CF_SPECIAL
+#define  DEFAULT_cfH(M,I,A)
+#define  LOGICAL_cfH(S,U,B)
+#define PLOGICAL_cfH(S,U,B)
+#define   STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B
+#define  STRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
+#define  PSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
+#define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
+#define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
+#define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
+#define  ZTRINGV_cfH(S,U,B)
+#define PZTRINGV_cfH(S,U,B)
+
+/* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */
+/* No spaces inside expansion. They screws up macro catenation kludge.     */
+#define           VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define           BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define          FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define            INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E)
+#define           LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define          SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define          BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define       BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define      BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define     BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define    BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define       DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define      DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define     DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define    DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define   DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define  DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define       FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define      FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define     FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define    FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define   FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define           INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define          INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define       INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define      INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define     INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define       LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define      LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define     LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define    LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define   LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define  LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define          LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define       LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define      LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define     LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define    LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define       SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define      SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define     SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define    SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define   SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define          PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define           PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define       PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E)
+#define          PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E)
+#define        PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E)
+#define        STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E)
+#define       PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E)
+#define       PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E)
+#define       PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E)
+#define          PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define         SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define        ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E)
+#define       PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E)
+#define           CF_0_cfSTR(N,T,A,B,C,D,E)
+
+/* See ACF table comments, which explain why CCF was split into two. */
+#define CCF(NAME,TN,I)     _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I))
+#define  DEFAULT_cfC(M,I,A,B,C)
+#define  LOGICAL_cfC(M,I,A,B,C)  A=C2FLOGICAL( A);
+#define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A);
+#ifdef vmsFortran
+#define   STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A,         \
+        C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen:     \
+          (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0'));
+      /* PSTRING_cfC to beware of array A which does not contain any \0.      */
+#define  PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ?         \
+             B.dsc$w_length=strlen(A):  (A[C-1]='\0',B.dsc$w_length=strlen(A), \
+       memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1));
+#else
+#define   STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),                             \
+                C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen:       \
+                        (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0'));
+#define  PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A):                \
+                    (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1));
+#endif
+          /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */
+#define  STRINGV_cfC(M,I,A,B,C) \
+        AATRINGV_cfA(    A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
+#define PSTRINGV_cfC(M,I,A,B,C) \
+       APATRINGV_cfA(    A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
+#define  ZTRINGV_cfC(M,I,A,B,C) \
+        AATRINGV_cfA(    A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1),       \
+                              (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1   )
+#define PZTRINGV_cfC(M,I,A,B,C) \
+       APATRINGV_cfA(    A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1),       \
+                              (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1   )
+
+#define     BYTE_cfCCC(A,B) &A
+#define   DOUBLE_cfCCC(A,B) &A
+#if !defined(__CF__KnR)
+#define    FLOAT_cfCCC(A,B) &A
+                               /* Although the VAX doesn't, at least the      */
+#else                          /* HP and K&R mips promote float arg.'s of     */
+#define    FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot    */
+#endif                         /* use A here to pass the argument to FORTRAN. */
+#define      INT_cfCCC(A,B) &A
+#define  LOGICAL_cfCCC(A,B) &A
+#define     LONG_cfCCC(A,B) &A
+#define    SHORT_cfCCC(A,B) &A
+#define    PBYTE_cfCCC(A,B)  A
+#define  PDOUBLE_cfCCC(A,B)  A
+#define   PFLOAT_cfCCC(A,B)  A
+#define     PINT_cfCCC(A,B)  A
+#define PLOGICAL_cfCCC(A,B)  B=A       /* B used to keep a common W table. */
+#define    PLONG_cfCCC(A,B)  A
+#define   PSHORT_cfCCC(A,B)  A
+
+#define CCCF(TN,I,M)           _SEP_(TN,M,cfCOMMA) _Icf(3,CC,TN,_(A,I),_(B,I))
+#define        INT_cfCC(T,A,B) _(T,_cfCCC)(A,B) 
+#define       INTV_cfCC(T,A,B)  A
+#define      INTVV_cfCC(T,A,B)  A
+#define     INTVVV_cfCC(T,A,B)  A
+#define    INTVVVV_cfCC(T,A,B)  A
+#define   INTVVVVV_cfCC(T,A,B)  A
+#define  INTVVVVVV_cfCC(T,A,B)  A
+#define INTVVVVVVV_cfCC(T,A,B)  A
+#define       PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B) 
+#define      PVOID_cfCC(T,A,B)  A
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
+#define    ROUTINE_cfCC(T,A,B) &A
+#else
+#define    ROUTINE_cfCC(T,A,B)  A
+#endif
+#define     SIMPLE_cfCC(T,A,B)  A
+#ifdef vmsFortran
+#define     STRING_cfCC(T,A,B) &B.f
+#define    STRINGV_cfCC(T,A,B) &B
+#define    PSTRING_cfCC(T,A,B) &B
+#define   PSTRINGV_cfCC(T,A,B) &B
+#else
+#ifdef CRAYFortran
+#define     STRING_cfCC(T,A,B) _cptofcd(A,B.flen)
+#define    STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen)
+#define    PSTRING_cfCC(T,A,B) _cptofcd(A,B)
+#define   PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen)
+#else
+#define     STRING_cfCC(T,A,B)  A
+#define    STRINGV_cfCC(T,A,B)  B.fs
+#define    PSTRING_cfCC(T,A,B)  A
+#define   PSTRINGV_cfCC(T,A,B)  B.fs
+#endif
+#endif
+#define    ZTRINGV_cfCC(T,A,B)   STRINGV_cfCC(T,A,B)
+#define   PZTRINGV_cfCC(T,A,B)  PSTRINGV_cfCC(T,A,B)
+
+#define    BYTE_cfX  return A0;
+#define  DOUBLE_cfX  return A0;
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#define   FLOAT_cfX  return A0;
+#else
+#define   FLOAT_cfX  ASSIGNFLOAT(AA0,A0); return AA0;
+#endif
+#define     INT_cfX  return A0;
+#define LOGICAL_cfX  return F2CLOGICAL(A0);
+#define    LONG_cfX  return A0;
+#define   SHORT_cfX  return A0;
+#define    VOID_cfX  return   ;
+#if defined(vmsFortran) || defined(CRAYFortran)
+#define  STRING_cfX  return kill_trailing(                                     \
+                                      kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
+#else
+#define  STRING_cfX  return kill_trailing(                                     \
+                                      kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
+#endif
+
+#define CFFUN(NAME) _(__cf__,NAME)
+
+/* Note that we don't use LN here, but we keep it for consistency. */
+#define CCALLSFFUN0(UN,LN) CFFUN(UN)()
+
+#ifdef OLD_VAXC                                  /* Allow %CC-I-PARAMNOTUSED. */
+#pragma standard
+#endif
+
+#define CCALLSFFUN1( UN,LN,T1,                        A1)         \
+        CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
+#define CCALLSFFUN2( UN,LN,T1,T2,                     A1,A2)      \
+        CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
+#define CCALLSFFUN3( UN,LN,T1,T2,T3,                  A1,A2,A3)   \
+        CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
+#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4,               A1,A2,A3,A4)\
+        CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
+#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5,            A1,A2,A3,A4,A5)          \
+        CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
+#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6,         A1,A2,A3,A4,A5,A6)       \
+        CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
+#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7,      A1,A2,A3,A4,A5,A6,A7)    \
+        CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
+#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,   A1,A2,A3,A4,A5,A6,A7,A8) \
+        CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
+#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
+        CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
+#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
+        CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
+#define CCALLSFFUN11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
+        CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
+#define CCALLSFFUN12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
+        CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
+#define CCALLSFFUN13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
+        CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
+
+#define CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
+((CFFUN(UN)(  BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \
+              BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \
+              BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1)              \
+           SCF(T1,LN,1,A1)  SCF(T2,LN,2,A2)  SCF(T3,LN,3,A3)  SCF(T4,LN,4,A4)  \
+           SCF(T5,LN,5,A5)  SCF(T6,LN,6,A6)  SCF(T7,LN,7,A7)  SCF(T8,LN,8,A8)  \
+           SCF(T9,LN,9,A9)  SCF(TA,LN,10,AA) SCF(TB,LN,11,AB) SCF(TC,LN,12,AC) \
+           SCF(TD,LN,13,AD) SCF(TE,LN,14,AE))))
+
+/*  N.B. Create a separate function instead of using (call function, function
+value here) because in order to create the variables needed for the input
+arg.'s which may be const.'s one has to do the creation within {}, but these
+can never be placed within ()'s. Therefore one must create wrapper functions.
+gcc, on the other hand may be able to avoid the wrapper functions. */
+
+/* Prototypes are needed to correctly handle the value returned correctly. N.B.
+Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN
+functions returning strings have extra arg.'s. Don't bother, since this only
+causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn
+for the same function in the same source code. Something done by the experts in
+debugging only.*/    
+
+#define PROTOCCALLSFFUN0(F,UN,LN)                                              \
+_(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO);                                       \
+static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)}
+
+#define PROTOCCALLSFFUN1( T0,UN,LN,T1)                                         \
+        PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2)                                      \
+        PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3)                                   \
+        PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0)
+#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4)                                \
+        PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0)
+#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5)                             \
+        PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6)                          \
+        PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7)                       \
+        PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)                    \
+        PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
+#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)                 \
+        PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
+#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)              \
+        PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)           \
+        PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)        \
+        PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
+#define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)     \
+        PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
+
+/* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */
+
+#ifndef __CF__KnR
+#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  \
+ _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)(     \
+   CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) )          \
+{       CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    _(T0,_cfE) \
+ CCF(LN,T1,1)  CCF(LN,T2,2)  CCF(LN,T3,3)  CCF(LN,T4,4)  CCF(LN,T5,5)          \
+ CCF(LN,T6,6)  CCF(LN,T7,7)  CCF(LN,T8,8)  CCF(LN,T9,9)  CCF(LN,TA,10)         \
+ CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14)    _Icf(3,G,T0,UN,LN) \
+ CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
+ WCF(T1,A1,1)   WCF(T2,A2,2)   WCF(T3,A3,3)   WCF(T4,A4,4)  WCF(T5,A5,5)       \
+ WCF(T6,A6,6)   WCF(T7,A7,7)   WCF(T8,A8,8)   WCF(T9,A9,9)  WCF(TA,A10,10)     \
+ WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
+#else
+#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  \
+ _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)(     \
+   CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) )        \
+ CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ;        \
+{       CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    _(T0,_cfE) \
+ CCF(LN,T1,1)  CCF(LN,T2,2)  CCF(LN,T3,3)  CCF(LN,T4,4)  CCF(LN,T5,5)          \
+ CCF(LN,T6,6)  CCF(LN,T7,7)  CCF(LN,T8,8)  CCF(LN,T9,9)  CCF(LN,TA,10)         \
+ CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14)    _Icf(3,G,T0,UN,LN) \
+ CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
+ WCF(T1,A1,1)   WCF(T2,A2,2)   WCF(T3,A3,3)   WCF(T4,A4,4)   WCF(T5,A5,5)      \
+ WCF(T6,A6,6)   WCF(T7,A7,7)   WCF(T8,A8,8)   WCF(T9,A9,9)   WCF(TA,A10,10)    \
+ WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
+#endif
+
+/*-------------------------------------------------------------------------*/
+
+/*               UTILITIES FOR FORTRAN TO CALL C ROUTINES                  */
+
+#ifdef OLD_VAXC                                /* Prevent %CC-I-PARAMNOTUSED. */
+#pragma nostandard
+#endif
+
+#if defined(vmsFortran) || defined(CRAYFortran)
+#define   DCF(TN,I)
+#define  DDCF(TN,I)
+#define DDDCF(TN,I)
+#else
+#define   DCF(TN,I)          HCF(TN,I)
+#define  DDCF(TN,I)         HHCF(TN,I)
+#define DDDCF(TN,I)        HHHCF(TN,I)
+#endif
+
+#define QCF(TN,I)       _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0)
+#define  DEFAULT_cfQ(B)
+#define  LOGICAL_cfQ(B)
+#define PLOGICAL_cfQ(B)
+#define  STRINGV_cfQ(B) char *B; unsigned int _(B,N);
+#define   STRING_cfQ(B) char *B=NULL;
+#define  PSTRING_cfQ(B) char *B=NULL;
+#define PSTRINGV_cfQ(B) STRINGV_cfQ(B)
+#define PNSTRING_cfQ(B) char *B=NULL;
+#define PPSTRING_cfQ(B)
+
+#ifdef     __sgi   /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */
+#define ROUTINE_orig    *(void**)& 
+#else
+#define ROUTINE_orig     (void *)  
+#endif
+
+#define ROUTINE_1     ROUTINE_orig   
+#define ROUTINE_2     ROUTINE_orig   
+#define ROUTINE_3     ROUTINE_orig   
+#define ROUTINE_4     ROUTINE_orig   
+#define ROUTINE_5     ROUTINE_orig   
+#define ROUTINE_6     ROUTINE_orig   
+#define ROUTINE_7     ROUTINE_orig   
+#define ROUTINE_8     ROUTINE_orig   
+#define ROUTINE_9     ROUTINE_orig   
+#define ROUTINE_10    ROUTINE_orig   
+#define ROUTINE_11    ROUTINE_orig   
+#define ROUTINE_12    ROUTINE_orig   
+#define ROUTINE_13    ROUTINE_orig   
+#define ROUTINE_14    ROUTINE_orig   
+#define ROUTINE_15    ROUTINE_orig   
+#define ROUTINE_16    ROUTINE_orig   
+#define ROUTINE_17    ROUTINE_orig   
+#define ROUTINE_18    ROUTINE_orig   
+#define ROUTINE_19    ROUTINE_orig   
+#define ROUTINE_20    ROUTINE_orig   
+#define ROUTINE_21    ROUTINE_orig   
+#define ROUTINE_22    ROUTINE_orig   
+#define ROUTINE_23    ROUTINE_orig   
+#define ROUTINE_24    ROUTINE_orig   
+#define ROUTINE_25    ROUTINE_orig   
+#define ROUTINE_26    ROUTINE_orig   
+#define ROUTINE_27    ROUTINE_orig   
+
+#define TCF(NAME,TN,I,M)              _SEP_(TN,M,cfCOMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I))
+#define           BYTE_cfT(M,I,A,B,D) *A
+#define         DOUBLE_cfT(M,I,A,B,D) *A
+#define          FLOAT_cfT(M,I,A,B,D) *A
+#define            INT_cfT(M,I,A,B,D) *A
+#define        LOGICAL_cfT(M,I,A,B,D)  F2CLOGICAL(*A)
+#define           LONG_cfT(M,I,A,B,D) *A
+#define          SHORT_cfT(M,I,A,B,D) *A
+#define          BYTEV_cfT(M,I,A,B,D)  A
+#define        DOUBLEV_cfT(M,I,A,B,D)  A
+#define         FLOATV_cfT(M,I,A,B,D)  VOIDP A
+#define           INTV_cfT(M,I,A,B,D)  A
+#define       LOGICALV_cfT(M,I,A,B,D)  A
+#define          LONGV_cfT(M,I,A,B,D)  A
+#define         SHORTV_cfT(M,I,A,B,D)  A
+#define         BYTEVV_cfT(M,I,A,B,D)  (void *)A /* We have to cast to void *,*/
+#define        BYTEVVV_cfT(M,I,A,B,D)  (void *)A /* since we don't know the   */
+#define       BYTEVVVV_cfT(M,I,A,B,D)  (void *)A /* dimensions of the array.  */
+#define      BYTEVVVVV_cfT(M,I,A,B,D)  (void *)A /* i.e. Unfortunately, can't */
+#define     BYTEVVVVVV_cfT(M,I,A,B,D)  (void *)A /* check that the type       */
+#define    BYTEVVVVVVV_cfT(M,I,A,B,D)  (void *)A /* matches the prototype.    */
+#define       DOUBLEVV_cfT(M,I,A,B,D)  (void *)A
+#define      DOUBLEVVV_cfT(M,I,A,B,D)  (void *)A
+#define     DOUBLEVVVV_cfT(M,I,A,B,D)  (void *)A
+#define    DOUBLEVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define   DOUBLEVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define  DOUBLEVVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define        FLOATVV_cfT(M,I,A,B,D)  (void *)A
+#define       FLOATVVV_cfT(M,I,A,B,D)  (void *)A
+#define      FLOATVVVV_cfT(M,I,A,B,D)  (void *)A
+#define     FLOATVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define    FLOATVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define   FLOATVVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define          INTVV_cfT(M,I,A,B,D)  (void *)A  
+#define         INTVVV_cfT(M,I,A,B,D)  (void *)A  
+#define        INTVVVV_cfT(M,I,A,B,D)  (void *)A  
+#define       INTVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define      INTVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define     INTVVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define      LOGICALVV_cfT(M,I,A,B,D)  (void *)A
+#define     LOGICALVVV_cfT(M,I,A,B,D)  (void *)A
+#define    LOGICALVVVV_cfT(M,I,A,B,D)  (void *)A
+#define   LOGICALVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define  LOGICALVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define LOGICALVVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define         LONGVV_cfT(M,I,A,B,D)  (void *)A
+#define        LONGVVV_cfT(M,I,A,B,D)  (void *)A
+#define       LONGVVVV_cfT(M,I,A,B,D)  (void *)A
+#define      LONGVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define     LONGVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define    LONGVVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define        SHORTVV_cfT(M,I,A,B,D)  (void *)A
+#define       SHORTVVV_cfT(M,I,A,B,D)  (void *)A
+#define      SHORTVVVV_cfT(M,I,A,B,D)  (void *)A
+#define     SHORTVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define    SHORTVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define   SHORTVVVVVVV_cfT(M,I,A,B,D)  (void *)A
+#define          PBYTE_cfT(M,I,A,B,D)  A
+#define        PDOUBLE_cfT(M,I,A,B,D)  A
+#define         PFLOAT_cfT(M,I,A,B,D)  VOIDP A
+#define           PINT_cfT(M,I,A,B,D)  A
+#define       PLOGICAL_cfT(M,I,A,B,D)  ((*A=F2CLOGICAL(*A)),A)
+#define          PLONG_cfT(M,I,A,B,D)  A
+#define         PSHORT_cfT(M,I,A,B,D)  A
+#define          PVOID_cfT(M,I,A,B,D)  A
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
+#define        ROUTINE_cfT(M,I,A,B,D)  _(ROUTINE_,I)  (*A)
+#else
+#define        ROUTINE_cfT(M,I,A,B,D)  _(ROUTINE_,I)    A
+#endif
+/* A == pointer to the characters
+   D == length of the string, or of an element in an array of strings
+   E == number of elements in an array of strings                             */
+#define TTSTR(    A,B,D)                                                       \
+           ((B=_cf_malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' '))
+#define TTTTSTR(  A,B,D)   (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL:              \
+                            memchr(A,'\0',D)                 ?A   : TTSTR(A,B,D)
+#define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=_cf_malloc(_(B,N)*(D+1)), (void *)      \
+  vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' '))
+#ifdef vmsFortran
+#define         STRING_cfT(M,I,A,B,D)  TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
+#define        STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(A->dsc$a_pointer, B,           \
+                                             A->dsc$w_length , A->dsc$l_m[0])
+#define        PSTRING_cfT(M,I,A,B,D)    TTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
+#define       PPSTRING_cfT(M,I,A,B,D)           A->dsc$a_pointer
+#else
+#ifdef CRAYFortran
+#define         STRING_cfT(M,I,A,B,D)  TTTTSTR( _fcdtocp(A),B,_fcdlen(A))
+#define        STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(_fcdtocp(A),B,_fcdlen(A),      \
+                              num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I)))
+#define        PSTRING_cfT(M,I,A,B,D)    TTSTR( _fcdtocp(A),B,_fcdlen(A))
+#define       PPSTRING_cfT(M,I,A,B,D)           _fcdtocp(A)
+#else
+#define         STRING_cfT(M,I,A,B,D)  TTTTSTR( A,B,D)
+#define        STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I)))
+#define        PSTRING_cfT(M,I,A,B,D)    TTSTR( A,B,D)
+#define       PPSTRING_cfT(M,I,A,B,D)           A
+#endif
+#endif
+#define       PNSTRING_cfT(M,I,A,B,D)    STRING_cfT(M,I,A,B,D)
+#define       PSTRINGV_cfT(M,I,A,B,D)   STRINGV_cfT(M,I,A,B,D)
+#define           CF_0_cfT(M,I,A,B,D)
+
+#define RCF(TN,I)           _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0)
+#define  DEFAULT_cfR(A,B,D)
+#define  LOGICAL_cfR(A,B,D)
+#define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A);
+#define   STRING_cfR(A,B,D) if (B) _cf_free(B);
+#define  STRINGV_cfR(A,B,D) _cf_free(B);
+/* A and D as defined above for TSTRING(V) */
+#define RRRRPSTR( A,B,D)    if (B) memcpy(A,B, _cfMIN(strlen(B),D)),           \
+                  (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), _cf_free(B);
+#define RRRRPSTRV(A,B,D)    c2fstrv(B,A,D+1,(D+1)*_(B,N)), _cf_free(B);
+#ifdef vmsFortran
+#define  PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length)
+#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length)
+#else
+#ifdef CRAYFortran
+#define  PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A))
+#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A))
+#else
+#define  PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D)
+#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D)
+#endif
+#endif
+#define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D)
+#define PPSTRING_cfR(A,B,D)
+
+#define    BYTE_cfFZ(UN,LN) INTEGER_BYTE     FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define  DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define     INT_cfFZ(UN,LN) int   FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define LOGICAL_cfFZ(UN,LN) int   FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define    LONG_cfFZ(UN,LN) long  FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define   SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define    VOID_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#ifndef __CF__KnR
+/* The void is req'd by the Apollo, to make this an ANSI function declaration.
+   The Apollo promotes K&R float functions to double. */
+#define   FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void
+#ifdef vmsFortran
+#define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS
+#else
+#ifdef CRAYFortran
+#define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd     AS
+#else
+#if  defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
+#define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(char    *AS
+#else
+#define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(char    *AS, unsigned D0
+#endif
+#endif
+#endif
+#else
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#define   FLOAT_cfFZ(UN,LN) FORTRAN_REAL      FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#else
+#define   FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#endif
+#if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran)
+#define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(AS
+#else
+#define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0
+#endif
+#endif
+
+#define    BYTE_cfF(UN,LN)     BYTE_cfFZ(UN,LN)
+#define  DOUBLE_cfF(UN,LN)   DOUBLE_cfFZ(UN,LN)
+#ifndef __CF_KnR
+#define   FLOAT_cfF(UN,LN)  FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#else
+#define   FLOAT_cfF(UN,LN)    FLOAT_cfFZ(UN,LN)
+#endif
+#define     INT_cfF(UN,LN)      INT_cfFZ(UN,LN)
+#define LOGICAL_cfF(UN,LN)  LOGICAL_cfFZ(UN,LN)
+#define    LONG_cfF(UN,LN)     LONG_cfFZ(UN,LN)
+#define   SHORT_cfF(UN,LN)    SHORT_cfFZ(UN,LN)
+#define    VOID_cfF(UN,LN)     VOID_cfFZ(UN,LN)
+#define  STRING_cfF(UN,LN)   STRING_cfFZ(UN,LN),
+
+#define     INT_cfFF
+#define    VOID_cfFF
+#ifdef vmsFortran
+#define  STRING_cfFF           fstring *AS; 
+#else
+#ifdef CRAYFortran
+#define  STRING_cfFF           _fcd     AS;
+#else
+#define  STRING_cfFF           char    *AS; unsigned D0;
+#endif
+#endif
+
+#define     INT_cfL            A0=
+#define  STRING_cfL            A0=
+#define    VOID_cfL                        
+
+#define    INT_cfK
+#define   VOID_cfK
+/* KSTRING copies the string into the position provided by the caller. */
+#ifdef vmsFortran
+#define STRING_cfK                                                             \
+ memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\
+ AS->dsc$w_length>(A0==NULL?0:strlen(A0))?                                     \
+  memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ',                        \
+         AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
+#else
+#ifdef CRAYFortran
+#define STRING_cfK                                                             \
+ memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) );        \
+ _fcdlen(AS)>(A0==NULL?0:strlen(A0))?                                          \
+  memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ',                             \
+         _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0;
+#else
+#define STRING_cfK         memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \
+                 D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
+                                            ' ', D0-(A0==NULL?0:strlen(A0))):0;
+#endif
+#endif
+
+/* Note that K.. and I.. can't be combined since K.. has to access data before
+R.., in order for functions returning strings which are also passed in as
+arguments to work correctly. Note that R.. frees and hence may corrupt the
+string. */
+#define    BYTE_cfI  return A0;
+#define  DOUBLE_cfI  return A0;
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#define   FLOAT_cfI  return A0;
+#else
+#define   FLOAT_cfI  RETURNFLOAT(A0);
+#endif
+#define     INT_cfI  return A0;
+#ifdef hpuxFortran800
+/* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */
+#define LOGICAL_cfI  return ((A0)?1:0);
+#else
+#define LOGICAL_cfI  return C2FLOGICAL(A0);
+#endif
+#define    LONG_cfI  return A0;
+#define   SHORT_cfI  return A0;
+#define  STRING_cfI  return   ;
+#define    VOID_cfI  return   ;
+
+#ifdef OLD_VAXC                                  /* Allow %CC-I-PARAMNOTUSED. */
+#pragma standard
+#endif
+
+#define FCALLSCSUB0( CN,UN,LN)             FCALLSCFUN0(VOID,CN,UN,LN)
+#define FCALLSCSUB1( CN,UN,LN,T1)          FCALLSCFUN1(VOID,CN,UN,LN,T1)
+#define FCALLSCSUB2( CN,UN,LN,T1,T2)       FCALLSCFUN2(VOID,CN,UN,LN,T1,T2)
+#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3)    FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3)
+#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \
+    FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4)
+#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \
+    FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5)
+#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \
+    FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6)       
+#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
+    FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7)
+#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
+    FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)
+#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
+    FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)
+#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
+   FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)
+#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
+   FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)
+#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
+   FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)
+#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
+   FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)
+#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+   FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
+   FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF)
+#define FCALLSCSUB16(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
+   FCALLSCFUN16(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)
+#define FCALLSCSUB17(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
+   FCALLSCFUN17(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH)
+#define FCALLSCSUB18(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
+   FCALLSCFUN18(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI)
+#define FCALLSCSUB19(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
+   FCALLSCFUN19(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ)
+#define FCALLSCSUB20(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+   FCALLSCFUN20(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
+#define FCALLSCSUB21(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
+   FCALLSCFUN21(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL)
+#define FCALLSCSUB22(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
+   FCALLSCFUN22(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM)
+#define FCALLSCSUB23(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
+   FCALLSCFUN23(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN)
+#define FCALLSCSUB24(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
+   FCALLSCFUN24(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO)
+#define FCALLSCSUB25(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
+   FCALLSCFUN25(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP)
+#define FCALLSCSUB26(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
+   FCALLSCFUN26(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ)
+#define FCALLSCSUB27(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+   FCALLSCFUN27(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
+
+
+#define FCALLSCFUN1( T0,CN,UN,LN,T1) \
+        FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \
+        FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0)
+#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \
+        FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0)
+#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \
+        FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0)
+#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \
+        FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \
+        FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
+        FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
+#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
+        FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
+#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
+        FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
+#define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
+        FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
+        FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
+#define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
+        FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
+#define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
+        FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
+
+
+#define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
+        FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN16(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
+        FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN17(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
+        FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0)
+#define FCALLSCFUN18(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
+        FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
+#define FCALLSCFUN19(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
+        FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
+#define FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+        FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN21(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
+        FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN22(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
+        FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN23(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
+        FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN24(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
+        FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0)
+#define FCALLSCFUN25(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
+        FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0)
+#define FCALLSCFUN26(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
+        FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0)
+
+
+#ifndef __CF__KnR
+#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0))   \
+        {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
+
+#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
+                                 CFextern _(T0,_cfF)(UN,LN)                    \
+ CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) )  \
+ {                 CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
+  _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(    TCF(LN,T1,1,0)  TCF(LN,T2,2,1) \
+    TCF(LN,T3,3,1)  TCF(LN,T4,4,1) TCF(LN,T5,5,1)  TCF(LN,T6,6,1)  TCF(LN,T7,7,1) \
+    TCF(LN,T8,8,1)  TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
+    TCF(LN,TD,13,1) TCF(LN,TE,14,1) );                          _Icf(0,K,T0,0,0) \
+                   CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  _(T0,_cfI) }
+
+#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)   \
+                                 CFextern _(T0,_cfF)(UN,LN)                    \
+ CFARGT27(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ) \
+ {                 CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)   \
+  _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(     TCF(LN,T1,1,0)  TCF(LN,T2,2,1)  \
+    TCF(LN,T3,3,1)  TCF(LN,T4,4,1)  TCF(LN,T5,5,1)  TCF(LN,T6,6,1)  TCF(LN,T7,7,1)  \
+    TCF(LN,T8,8,1)  TCF(LN,T9,9,1)  TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
+    TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
+    TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
+    TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
+                   CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)  _(T0,_cfI) }
+
+#else
+#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\
+        {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
+
+#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
+                                 CFextern _(T0,_cfF)(UN,LN)                    \
+ CFARGT14(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) _Icf(0,FF,T0,0,0) \
+       CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE);   \
+ {                 CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
+  _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(  TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
+    TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
+    TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
+    TCF(LN,TD,13,1) TCF(LN,TE,14,1) );                          _Icf(0,K,T0,0,0) \
+                   CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  _(T0,_cfI)}
+
+#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)  \
+                                 CFextern _(T0,_cfF)(UN,LN)                    \
+ CFARGT27(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)) _Icf(0,FF,T0,0,0) \
+       CFARGT27FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR); \
+ {                 CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)  \
+  _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(     TCF(LN,T1,1,0)  TCF(LN,T2,2,1)  \
+    TCF(LN,T3,3,1)  TCF(LN,T4,4,1)  TCF(LN,T5,5,1)  TCF(LN,T6,6,1)  TCF(LN,T7,7,1)  \
+    TCF(LN,T8,8,1)  TCF(LN,T9,9,1)  TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
+    TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
+    TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
+    TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
+                   CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)  _(T0,_cfI)}
+
+#endif
+
+
+#endif   /* __CFORTRAN_LOADED */
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/gribsize.incl
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/gribsize.incl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/gribsize.incl	(revision 2744)
@@ -0,0 +1,3 @@
+#define IGRIBXMAX 361
+#define JGRIBXMAX 181
+#define KGRIBXMAX 38
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/read_grib.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/read_grib.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/read_grib.c	(revision 2744)
@@ -0,0 +1,2458 @@
+ /**************************************************************************
+ * Todd Hutchinson          4/20/98
+ * tahutchinson@tasc.com    (781) 942-2000 x3108
+ * TASC 
+ * 55 Walkers Brook Drive
+ * Reading, MA  01867
+ *
+ * Functions in this file are used for decoding grib data.  Please see the
+ * headers before each function for a full descrption.
+ *
+ * Routines in this file call functions in the Naval Research Lab's grib 
+ * library.  The grib library is freely available from 
+ * http://www-mel.nrlmry.navy.mil/cgi-bin/order_grib.  This library should
+ * be installed on your system prior to using the routines in this file.
+ * Documentation for this library is available from
+ *  Master Environmental Grib Library user's manual
+ *  http://mel.dmso.mil/docs/grib.pdf
+ * Note: the standard NRL grib library does not support 
+ * "Little-Endian" platforms such as linux.  There is a version of the NRL 
+ * grib library within the WxPredictor project which does support linux.
+ *
+ * This file references the cfortran.h header file to ease the use of calling 
+ * this function from a fortran routine.  cfortran.h is a header file that 
+ * allows for simple machine-independent calls between c and fortran.  The 
+ * package is available via anonymous ftp at zebra.desy.de.
+ *
+ * The grib document "A GUIDE TO THE CODE FORM FM 92-IX Ext. GRIB" may be
+ * useful to your understanding of this code.  This document is available 
+ * via anonymous ftp from nic.fb4.noaa.gov.  Check the readme file in the
+ * root directory for further instructions.
+ *
+ ****************************************************************************/
+
+#define ERRSIZE 2000
+#define ALLOCSIZE 30
+#define MISSING -999
+
+#define EARTH_RADIUS 6371.229        /* in km */
+#define PI           3.141592654
+#define PI_OVER_180  PI/180.
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#ifdef MACOS
+#include "/usr/include/time.h"
+#else
+#include <time.h>
+#endif
+#include "cfortran.h"
+#include "gribfuncs.h"
+#include "gribsize.incl"
+#include "read_grib.h"
+
+/* Function Declarations */
+
+void remove_element(int array[],int index, int size);
+int advance_time(int *century, int year, int month, int day, int hour,
+		 int amount, int unit);
+char *advance_time_str(char startdatein[], int amount, char enddate[]);
+int date_diff(int date1,int century1,int date2,int century2);
+int hours_since_1900(int date,int century);
+int isLeapYear(int year);
+int get_factor2(int unit);
+int compare_record(GribInfo *gribinfo, FindGrib *findgrib, int gribnum);
+
+/* 
+ *These lines allow fortran routines to call the c routines.  They are
+ * used by macros defined in cfortran.h
+ */
+#define get_pressure_levels_STRV_A1 TERM_CHARS(' ',1)
+/*
+FCALLSCFUN6(INT, get_pressure_levels,GET_PRESSURE_LEVELS,
+	    get_pressure_levels,STRINGV,INTV,INTV,INTV,INT,INT)
+#define setup_gribinfo_STRV_A1 TERM_CHARS(' ',1)
+FCALLSCFUN2(INT,setup_gribinfo,SETUP_GRIBINFO,setup_gribinfo,STRINGV,INT)
+#define get_msl_indices_STRV_A1 TERM_CHARS(' ',1)
+FCALLSCFUN9(INT, get_msl_indices,GET_MSL_INDICES,get_msl_indices,
+	    STRINGV,INTV,INTV,INTV,INTV,INTV,INT,INTV,INTV)
+FCALLSCFUN5(INT, get_index,GET_INDEX,get_index,INT,INT,INT,INT,INT)
+#define read_grib_STRV_A1 TERM_CHARS(' ',1)
+FCALLSCFUN7(INT,get_dates,GET_DATES,get_dates,INTV,INTV,INTV,INT,INTV,
+	    INTV,INTV)
+FCALLSCFUN7(INT, read_grib,READ_GRIB,read_grib,
+	    STRINGV,INT,INT,INT,INT,FLOATVV,PVOID)
+FCALLSCFUN8(INT, get_index_near_date,GET_INDEX_NEAR_DATE,get_index_near_date,
+            STRING,INT,INT,INT,INTV,INTV,INTV,INT)
+*/
+/* The value for usLevel_id for isobaric levels */
+#define ISOBARIC_LEVEL_ID 100  
+
+/*************************************************************************
+ * This function reads and decodes grib records in a list of input files 
+ * and stores information about each grib record in the gribinfo array 
+ * structure.  The gribinfo structure can then be accessed by any function 
+ * within this file.
+ * 
+ * Interface:
+ *   Input:
+ *      gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *      files - a string array containing the names of the files containing
+ *              the grib data.  If called from a fortran routine, the
+ *              fortran routine must set the character size of the array to
+ *              be STRINGSIZE-1. The last filled element in the array should
+ *              be "END".
+ *      use_fcst - if TRUE, forecast fields will be included in the gribinfo
+ *              structure, otherwise, only analysis fields will be included.
+ *
+ *    Return:
+ *       1  - successful call to setup_gribinfo
+ *       -1 - call to setup_gribinfo failed
+ *
+ ***************************************************************************/
+
+int rg_setup_gribinfo(GribInfo *gribinfo, char files[][STRINGSIZE],
+		      int use_fcst)
+{
+  FILE *fp;
+  int filenum;
+  int nReturn;
+  int idx;
+  int status;
+  int start_elem;
+  
+  /* Loop through input files */
+  filenum = 0;
+  while ((strcmp(files[filenum], "end") != 0 ) && 
+	 (strcmp(files[filenum], "END") != 0 )) {
+    
+    /* 
+     * This forces gribinfo to be fully initialized.
+     */
+    if (filenum == 0) 
+      {
+	gribinfo->num_elements = 0;
+      }
+
+    start_elem = gribinfo->num_elements;
+
+    fp = fopen(files[filenum],"r");
+    if (fp == NULL)
+      {
+	fprintf(stderr,"Could not open %s\n",files[filenum]);
+	nReturn = -1;
+	break;
+      }
+    
+    status = rg_setup_gribinfo_f(gribinfo, fp, use_fcst);
+    if (status != 1) 
+      {
+	fprintf(stderr, 
+	    "rg_setup_gribinfo_f returned non-zero status (%d), skipping %s\n",
+		status,files[filenum]);
+	continue;
+      }
+
+    for (idx=start_elem; idx < gribinfo->num_elements; idx++) 
+      {
+	strcpy(gribinfo->elements[idx].filename,
+	       files[filenum]);
+      }
+
+    
+    filenum++;
+    nReturn = 1;
+  }
+
+  return nReturn;
+}
+
+
+
+/*************************************************************************
+ *
+ * Similar to rg_setup_gribinfo, except, a unix file descriptor is passed in, 
+ * rather than a list of files to open.
+ *
+ *************************************************************************/
+
+int rg_setup_gribinfo_i(GribInfo *gribinfo, int fid, int use_fcst)
+{
+  FILE *fp;
+  int status;
+  
+  fp = fdopen(fid,"r");
+  if (fp == NULL)
+    {
+      fprintf(stderr,"Could not open file descriptor %d\n",fid);
+      status = -1;
+      return status;
+    }
+  
+  /* This forces gribinfo to be initialized for the first time */
+  gribinfo->num_elements = 0;
+  
+  status = rg_setup_gribinfo_f(gribinfo, fp, use_fcst);
+  if (status != 1) 
+    {
+      fprintf(stderr, 
+	      "rg_setup_gribinfo_f returned non-zero status (%d)\n",
+	      status);
+    }
+  
+  return status;
+}
+
+/*************************************************************************
+ *
+ * Similar to rg_setup_gribinfo, except, a file pointer is passed in, rather
+ * than a list of files to open.
+ * 
+ * If gribinfo->num_elements is 0, gribinfo is initialized, otherwise, 
+ *    gribinfo is appended to.
+ *
+ *************************************************************************/
+
+int rg_setup_gribinfo_f(GribInfo *gribinfo, FILE *fp, int use_fcst)
+{
+  char errmsg[ERRSIZE];
+  int nReturn=0;
+  long offset;
+  int filenum;
+  int Rd_Indexfile=0;
+  GRIB_HDR *gh1;
+  long tmpoffset=0;
+  int century;
+  int year4d;
+  int fcsttime1=0;
+  int fcsttime2=0;
+  int factor=0;
+
+  /* Set the number of elements to be zero initially */
+  if (gribinfo->num_elements <= 0)
+    {
+      /* Allocate space for gribinfo */
+      gribinfo->elements = (Elements *)calloc(ALLOCSIZE,sizeof(Elements));
+      if (gribinfo->elements == NULL) {
+	sprintf(errmsg,"Could not allocate %d bytes for gribinfo->elements\n",
+		ALLOCSIZE*sizeof(Elements));
+	goto bail_out;
+      }
+    }
+  
+  /* Make storage for Grib Header */
+  nReturn = init_gribhdr(&gh1, errmsg);
+  /* 
+   * The grib library is setup such that, when init_gribhdr == 0, it was 
+   * successful.  If it is 1, it failed.
+   */
+  if (nReturn == 1) goto bail_out;
+  
+  /* Scan through message */
+  for (offset = 0L; nReturn == 0; offset += gh1->msg_length) {
+    if ((gribinfo->num_elements > 0) && 
+	(gribinfo->num_elements%ALLOCSIZE == 0))
+      gribinfo->elements = 
+	(Elements *)realloc(gribinfo->elements,
+			    (gribinfo->num_elements+ALLOCSIZE)*
+			    sizeof(Elements));
+
+    if (gribinfo->elements == NULL) {
+      sprintf(errmsg,"Could not allocate %d bytes for gribinfo\n",
+	      (gribinfo->num_elements + ALLOCSIZE)*sizeof(Elements));
+      goto bail_out;
+    }
+
+    /* Setup the File pointer */
+    gribinfo->elements[gribinfo->num_elements].fp = fp;
+
+    gribinfo->elements[gribinfo->num_elements].pds = 
+      (PDS_INPUT *)malloc(1*sizeof(PDS_INPUT));
+    gribinfo->elements[gribinfo->num_elements].gds = 
+      (grid_desc_sec *)malloc(1*sizeof(grid_desc_sec));
+    gribinfo->elements[gribinfo->num_elements].bms = 
+      (BMS_INPUT *)malloc(1*sizeof(BMS_INPUT));
+    gribinfo->elements[gribinfo->num_elements].bds_head = 
+      (BDS_HEAD_INPUT *)malloc(1*sizeof(BDS_HEAD_INPUT));
+    errmsg[0] = '\0';
+    nReturn = 
+      grib_fseek(fp,&offset, Rd_Indexfile, gh1, errmsg);
+    if (nReturn != 0) {
+      if (nReturn == 2) break;   /* End of file error */
+      else {
+	fprintf(stderr, "Grib_fseek returned non zero status (%d)\n",
+		nReturn);
+	goto bail_out;
+      }
+    }
+    if (errmsg[0] != '\0')
+      { /* NO errors but got a Warning msg from seek */
+	fprintf(stderr,"%s; Skip Decoding...\n",errmsg);
+	errmsg[0] = '\0';   
+	gh1->msg_length = 1L;    /* set to 1 to bump offset up */
+	continue;
+      }
+      
+    if (gh1->msg_length < 0) {
+      fprintf(stderr, "Error:  message returned had bad length (%ld)\n",
+	      gh1->msg_length);
+      goto bail_out;
+    }
+    else if (gh1->msg_length == 0) {
+      fprintf(stderr, "msg_length is Zero\n");
+      gh1->msg_length = 1L;
+      continue;
+    }
+    init_dec_struct(gribinfo->elements[gribinfo->num_elements].pds, 
+		    gribinfo->elements[gribinfo->num_elements].gds, 
+		    gribinfo->elements[gribinfo->num_elements].bms, 
+		    gribinfo->elements[gribinfo->num_elements].bds_head);
+    
+    /* 
+     * gribgetpds is an undocumented function within the grib library.
+     * gribgetpds grabs the pds section from the grib message without
+     * decoding the entire grib message.  The interface is as follows:
+     *     first input param: a pointer to the beginning of the pds 
+     *                        section.
+     *     second input param: a pointer to a structure which will hold
+     *                        the pds information
+     *     third param: the error message.
+     * 
+     * If gribgetpds ever fails, it can be replaced with the following 
+     *    nReturn = grib_dec((char *)gh1->entire_msg, &pds, &gds, &bds_head, 
+     *              &bms, &grib_data, errmsg);
+     * 
+     * This will degrade performance since this grib_dec decodes the 
+     *    entire grib message.
+     */
+    
+    nReturn = gribgetpds((char*)(gh1->entire_msg + 8),
+			 gribinfo->elements[gribinfo->num_elements].pds,
+			 errmsg);
+    if (nReturn != 0) goto bail_out;
+
+    /* Get gds if present */
+    if (gribinfo->elements[gribinfo->num_elements].pds->usGds_bms_id >> 7 
+	& 1) {
+      nReturn = 
+	gribgetgds((char*)
+		   (gh1->entire_msg+8+
+		    gribinfo->elements[gribinfo->num_elements].pds->uslength),
+		   gribinfo->elements[gribinfo->num_elements].gds,errmsg);
+      if (nReturn != 0) goto bail_out;
+    }
+
+    /* Get bms section if present */
+    if (gribinfo->elements[gribinfo->num_elements].pds->usGds_bms_id >> 6 
+	& 1) {
+      /*
+	fprintf(stderr,"grids with bms section not currently supported\n");
+	return -1;
+      */
+    }
+    
+    gribinfo->elements[gribinfo->num_elements].usGrid_id = 
+      gribinfo->elements[gribinfo->num_elements].pds->usGrid_id;
+    gribinfo->elements[gribinfo->num_elements].usParm_id = 
+      gribinfo->elements[gribinfo->num_elements].pds->usParm_id;
+    gribinfo->elements[gribinfo->num_elements].usLevel_id = 
+      gribinfo->elements[gribinfo->num_elements].pds->usLevel_id;
+    gribinfo->elements[gribinfo->num_elements].usHeight1 = 
+      gribinfo->elements[gribinfo->num_elements].pds->usHeight1;
+    gribinfo->elements[gribinfo->num_elements].usHeight2 = 
+      gribinfo->elements[gribinfo->num_elements].pds->usHeight2;
+    gribinfo->elements[gribinfo->num_elements].center_id = 
+      gribinfo->elements[gribinfo->num_elements].pds->usCenter_id;
+    gribinfo->elements[gribinfo->num_elements].parmtbl = 
+      gribinfo->elements[gribinfo->num_elements].pds->usParm_tbl;
+    gribinfo->elements[gribinfo->num_elements].proc_id = 
+      gribinfo->elements[gribinfo->num_elements].pds->usProc_id;
+    gribinfo->elements[gribinfo->num_elements].subcenter_id = 
+      gribinfo->elements[gribinfo->num_elements].pds->usCenter_sub;
+    gribinfo->elements[gribinfo->num_elements].offset = offset;
+    gribinfo->elements[gribinfo->num_elements].end = 
+      offset + gh1->msg_length - 1;
+  
+    if (use_fcst) {
+      century = gribinfo->elements[gribinfo->num_elements].pds->usCentury;
+      
+      if (gribinfo->elements[gribinfo->num_elements].pds->usTime_range == 10)
+	{
+	  fcsttime1 = gribinfo->elements[gribinfo->num_elements].pds->usP1*256 + 
+	    gribinfo->elements[gribinfo->num_elements].pds->usP2;
+	  fcsttime2 = 0;
+	}
+      else if (gribinfo->elements[gribinfo->num_elements].pds->usTime_range 
+	       == 203) {
+	/* This is the WSI extension to grib.  203 indicates "duration" */
+	fcsttime1 = gribinfo->elements[gribinfo->num_elements].pds->usP1;
+	fcsttime2 = gribinfo->elements[gribinfo->num_elements].pds->usP1 +
+	  gribinfo->elements[gribinfo->num_elements].pds->usP2;
+      } else {
+	fcsttime1 = gribinfo->elements[gribinfo->num_elements].pds->usP1;
+	fcsttime2 = gribinfo->elements[gribinfo->num_elements].pds->usP2;
+      }
+      
+      gribinfo->elements[gribinfo->num_elements].date = 
+	advance_time(&century,
+		     gribinfo->elements[gribinfo->num_elements].pds->usYear,
+		     gribinfo->elements[gribinfo->num_elements].pds->usMonth,
+		     gribinfo->elements[gribinfo->num_elements].pds->usDay,
+		     gribinfo->elements[gribinfo->num_elements].pds->usHour,
+		     fcsttime1,
+		     gribinfo->elements[gribinfo->num_elements].pds->usFcst_unit_id);
+    } 
+    else {
+      gribinfo->elements[gribinfo->num_elements].date = 
+	gribinfo->elements[gribinfo->num_elements].pds->usHour*1 + 
+	gribinfo->elements[gribinfo->num_elements].pds->usDay*100 + 
+	gribinfo->elements[gribinfo->num_elements].pds->usMonth*10000 + 
+	gribinfo->elements[gribinfo->num_elements].pds->usYear*1000000;
+    } 
+    gribinfo->elements[gribinfo->num_elements].century = 
+      gribinfo->elements[gribinfo->num_elements].pds->usCentury;
+    
+    year4d = 
+	(gribinfo->elements[gribinfo->num_elements].pds->usCentury - 1) * 100
+	+ gribinfo->elements[gribinfo->num_elements].pds->usYear;
+
+    sprintf(gribinfo->elements[gribinfo->num_elements].initdate,
+	    "%04d%02d%02d%02d%02d%02d",
+	    year4d,
+	    gribinfo->elements[gribinfo->num_elements].pds->usMonth,
+	    gribinfo->elements[gribinfo->num_elements].pds->usDay,
+	    gribinfo->elements[gribinfo->num_elements].pds->usHour,
+	    gribinfo->elements[gribinfo->num_elements].pds->usMinute,
+	    0);	      
+    
+    factor = 
+      get_factor2(gribinfo->elements[gribinfo->num_elements].pds->usFcst_unit_id);
+    gribinfo->elements[gribinfo->num_elements].fcsttime1 = 
+      fcsttime1 * factor;
+    gribinfo->elements[gribinfo->num_elements].fcsttime2 = 
+      fcsttime2 * factor;
+    
+    advance_time_str(gribinfo->elements[gribinfo->num_elements].initdate,
+		     gribinfo->elements[gribinfo->num_elements].fcsttime1,
+		     gribinfo->elements[gribinfo->num_elements].valid_time);
+
+    gribinfo->num_elements++;
+  }
+  
+  free_gribhdr(&gh1);
+  return 1;
+  
+  /* The error condition */
+ bail_out:
+  if (errmsg[0] != '\0') fprintf(stderr,"\n***ERROR: %s: %s\n",
+				 "setup_grib",errmsg);
+  if (gribinfo->elements != NULL) free(gribinfo->elements);
+  perror("System Error ");
+  return -1;
+}
+
+/*****************************************************************************
+ *
+ * Retrieve pressure levels from grib data.  This function will pass the 
+ * pressure levels for which the input parameter is available at all input 
+ * times back to the calling routine.  
+ *
+ * Interface
+ *      Input: 
+ *         gribinfo - pointer to a previously allocated gribinfo structure.  
+ *                 The gribinfo structure is filled in this function.
+ *         dates: an array of dates to check for data
+ *                format: yymmddhh
+ *                If called from a fortran routine, the fortran routine must 
+ *                set the character size of the array to be STRINGSIZE-1
+ *         centuries: an array holding the centuries for each of the 
+ *                dates in the array dates.
+ *         parm_id: the input parameter id.  From table 2 of the grib manual.
+ *      Output:
+ *         finallevels: an array of pressure levels which are contained in 
+ *                the grib data at all input times.
+ *      Return:
+ *         the number of levels in the levels array.  The levels are listing
+ *         in descending (by value) order, i.e., the value with the highest
+ *         pressure (lowest vertical level) is the first element.
+ *
+ ****************************************************************************/
+
+int rg_get_pressure_levels(GribInfo *gribinfo, int dates[], int centuries[], 
+			int parm_id[], int finallevels[],int min_pres,
+			int numparms)
+{
+  int datenum;
+  int gribnum;
+  int *levelnum;
+  int levelincluded;
+  int i,j;
+  int contains_level;
+  int **tmplevels;
+  int numfinallevels = 0;
+  int parmnum;
+  int tmpval;
+  
+  /* Allocate space */
+  levelnum = (int *)calloc(numparms,sizeof(int));
+  tmplevels = (int **)calloc(numparms,sizeof(int *));
+  for (j = 0; j < numparms; j++) {
+    tmplevels[j] = (int *)calloc(1000,sizeof(int));
+    if (tmplevels[j] == NULL) {
+      tmplevels = NULL;
+      break;
+    }
+  }
+  if ((levelnum == NULL) || (tmplevels == NULL)) {
+    fprintf(stderr,
+	    "get_pressure_levels: Allocation of space failed, returning\n");
+    return -1;
+  }
+  
+  /* Loop through all parameters */
+  for (parmnum = 0; parmnum < numparms; parmnum++) {
+
+    levelnum[parmnum] = 0;
+
+  /* Get the array of pressure levels available at the first input time */
+    datenum = 0;
+    for (gribnum = 0; gribnum < gribinfo->num_elements; gribnum++) {
+      if (gribinfo->elements[gribnum].date == dates[datenum]) {
+	if (gribinfo->elements[gribnum].century == centuries[datenum]) {
+	  if (gribinfo->elements[gribnum].usLevel_id == ISOBARIC_LEVEL_ID) {
+	    if (gribinfo->elements[gribnum].usParm_id == parm_id[parmnum]) {
+	      if (gribinfo->elements[gribnum].usHeight1 >= min_pres) {
+		levelincluded = 0;
+		for (j=0; j < levelnum[parmnum]; j++) {
+		  if (tmplevels[parmnum][j] == 
+		      gribinfo->elements[gribnum].usHeight1) {
+		    levelincluded = 1;
+		    break;
+		  }
+		}
+		if (levelincluded == 0) {
+		  tmplevels[parmnum][levelnum[parmnum]] = 
+		    gribinfo->elements[gribnum].usHeight1;
+		  levelnum[parmnum]++;
+		}
+	      }
+	    }
+	  }
+	}
+      }
+    }
+    
+    /* Remove levels that are not contained at all subsequent times */
+    datenum++;
+    while (dates[datenum] != -99){
+      for (j = 0; j < levelnum[parmnum]; j++) {
+	contains_level = 0;
+	for (gribnum = 0; gribnum < gribinfo->num_elements; gribnum++) {
+	  if (gribinfo->elements[gribnum].date == dates[datenum]) {
+	    if (gribinfo->elements[gribnum].century == centuries[datenum]) {
+	      if (gribinfo->elements[gribnum].usLevel_id == ISOBARIC_LEVEL_ID)
+		{
+		  if (gribinfo->elements[gribnum].usParm_id == 
+		      parm_id[parmnum]) {
+		    if (tmplevels[parmnum][j] == 
+			gribinfo->elements[gribnum].usHeight1)
+		      contains_level = 1;
+		  }
+		}
+	    }
+	  }
+	}
+	if (!(contains_level)) {
+	  remove_element(tmplevels[parmnum],j,levelnum[parmnum]);
+	  levelnum[parmnum]--;
+	  j--;
+	}
+      }
+      datenum++;
+    }
+
+    /* 
+     * Put the values for levels into an array.  Remove any levels that
+     * were not found at all other levels
+     */
+    if (parmnum == 0) {
+      for (j = 0; j < levelnum[parmnum]; j++) {
+	finallevels[j] = tmplevels[parmnum][j];
+	numfinallevels++;
+      }
+    } else {
+      for (i=0; i<numfinallevels; i++) {
+	contains_level = 0;
+	for (j=0; j<levelnum[parmnum]; j++) {
+	  if (finallevels[i] == tmplevels[parmnum][j]) {
+	    contains_level = 1;
+	    break;
+	  }
+	}
+	if (!contains_level) {
+	  remove_element(finallevels,i,numfinallevels);
+	  numfinallevels--;
+	  i--;
+	}
+      }
+    }
+
+  }
+
+  /* 
+   * Sort the numfinallevels array into descending order. Use straight 
+   * insertion.
+   */
+  for (j=1; j<numfinallevels; j++) {
+    tmpval = finallevels[j];
+    for (i=j-1; i >= 0; i--) {
+      if (finallevels[i] >= tmpval) break;
+      finallevels[i+1] = finallevels[i];
+    }
+    finallevels[i+1] = tmpval;
+  }
+
+  return numfinallevels;
+}
+
+/****************************************************************************
+ *
+ * Returns an array of grib indices that correspond to particular grib fields
+ * to use as sea level pressure.  There will be exactly one element for each
+ * input time.  If a field was not found, then this function returns NULL
+ *
+ * Interface:
+ *    Input:
+ *      gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *         dates: a string array of dates to check for data.
+ *                format: yymmddhh
+ *                If called from a fortran routine, the fortran routine must 
+ *                set the character size of the array to be STRINGSIZE-1
+ *         centuries: an array holding the centuries for each of the 
+ *                dates in the array dates.
+ *         usParm_id: an array of parameter identifiers that could be
+ *                    used as a sea level pressure field (From table 2 of 
+ *                    grib documentation)
+ *         usLevel_id: the level id that could be used as a sea level pressure
+ *                    field (from table 3 of the grib documentation)
+ *         usHeight1: the height for the particular parameter and level
+ *                    (in units described by the parameter index)
+ *         numparms:  the number of parameters in each of the usParm_id, 
+ *                    usLevel_id, and usHeight1 arrays.
+ *    Output:
+ *         grib_index: an array of grib indices to use for the sea level 
+ *                    pressure.  The index to grib_index corresponds to 
+ *                    the time, i.e., the first array element of grib_index 
+ *                    corresponds to the first time, the second element to 
+ *                    the second time, etc.
+ *         
+ *            Note: Values in the input arrays, usParm_id, usLevel_id, and 
+ *                    usHeight with the same array index must correspond.
+ *
+ *    Return:
+ *          1 for success
+ *          -1 if no field was found.
+ ***************************************************************************/
+
+int rg_get_msl_indices(GribInfo *gribinfo, char dates[][STRINGSIZE],
+		    int centuries[], int usParm_id[],int usLevel_id[],
+		    int usHeight1[],int infactor[],int numparms,
+		    int grib_index[],int outfactor[])
+{
+  int parmindex;
+  int datenum = 0;
+  int gribnum;
+  int foundfield=0;
+
+  for (parmindex = 0; parmindex < numparms; parmindex++) {
+
+    datenum = 0;
+    while ((strcmp(dates[datenum], "end") != 0 ) && 
+	   (strcmp(dates[datenum], "END") != 0 )) {
+
+      for (gribnum = 0; gribnum < gribinfo->num_elements; gribnum++) {
+	if (gribinfo->elements[gribnum].date == atoi(dates[datenum])) {
+	  if (gribinfo->elements[gribnum].century == centuries[datenum]) {
+	    if ((gribinfo->elements[gribnum].usParm_id == 
+		 usParm_id[parmindex]) &&
+		(gribinfo->elements[gribnum].usLevel_id == 
+		 usLevel_id[parmindex]) &&
+		(gribinfo->elements[gribnum].usHeight1 == 
+		 usHeight1[parmindex])) {
+	      grib_index[datenum] = gribnum;
+	      outfactor[datenum] = infactor[parmindex];
+	      foundfield++;
+	      break;
+	    }
+	  }
+	}
+      }
+
+      datenum++;
+
+      /* 
+       * Break out of loop and continue on to next parameter if the current 
+       * parameter was missing from a date. 
+       */
+
+      if (foundfield != datenum) break;
+    }
+
+/* 
+ * Break out of the parameter loop once we've found a field available at all 
+ * dates 
+ */
+    if (foundfield == datenum) {
+      break;
+    }
+
+  }
+
+  if (foundfield == datenum)
+    return 1;
+  else
+    return -1;
+
+}
+
+
+/***************************************************************************
+ * 
+ * This function takes an index as input and returns a 2d grib data field
+ *
+ * Interface:
+ *    input: 
+ *      gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *       index - the index of gribinfo for which data is to be retrieved
+ *       scale - the scale factor to multiply data by, i.e., if -2, 
+ *               data will be multiplied by 10^-2.
+ *    output:
+ *       grib_out - the 2 dimensional output grib data
+ *               Warning: This 2d array is setup with i being the vertical
+ *               dimension and j being the horizontal dimension.  This
+ *               is the convention used in mesoscale numerical modeling
+ *               (the MM5 in particular), so it is used here.
+ *    return:
+ *       1 for success
+ *      -1 for failure
+ ***************************************************************************/
+
+int rg_get_grib(GribInfo *gribinfo, int index,int scale,
+	     float **grib_out,int *vect_comp_flag, 
+	     GRIB_PROJECTION_INFO_DEF *Proj, BDS_HEAD_INPUT *bds_head)
+{
+  char errmsg[ERRSIZE];
+  int nReturn=0;
+  long offset;
+  int Rd_Indexfile=0;
+  BMS_INPUT bms;
+  PDS_INPUT pds;
+  BDS_HEAD_INPUT dummy;
+  grid_desc_sec gds;
+  GRIB_HDR *gh1;
+  int i,j;
+  int expandlon = 0;
+  float *grib_data;
+
+  /* Initialize Variables */
+  errmsg[0] = '\0';
+  offset = 0L;
+  grib_data = (float *)NULL;
+
+  /* Make storage for Grib Header */
+  nReturn = init_gribhdr (&gh1, errmsg);
+  if (nReturn == 1) goto bail_out;
+  
+  /* Seek to the position in the grib data */
+  offset = gribinfo->elements[index].offset;
+  nReturn = grib_fseek(gribinfo->elements[index].fp,&offset,
+		      Rd_Indexfile,gh1,errmsg);
+  if (nReturn != 1) {
+    fprintf(stderr,"Grib_fseek returned error status (%d)\n",nReturn);
+    goto bail_out;
+  }
+  if (errmsg[0] != '\0')
+    { /* NO errors but got a Warning msg from seek */ 
+      fprintf(stderr,"%s: Skip Decoding...\n",errmsg);
+      errmsg[0] = '\0';
+    }
+  if (gh1->msg_length <= 0) {
+    fprintf(stderr,"Error: message returned had bad length (%ld)\n",
+	    gh1->msg_length);
+    goto bail_out;
+  }
+  init_dec_struct(&pds, &gds, &bms, &dummy);
+ 
+  nReturn = grib_dec((char *)gh1->entire_msg, &pds, &gds, 
+		     bds_head,
+		     &bms, &grib_data, errmsg);
+ 
+  if (nReturn != 0) goto bail_out;
+  
+  if (bms.uslength > 0) {
+    nReturn = apply_bitmap(&bms, &grib_data, FILL_VALUE, bds_head, 
+			   errmsg);
+    if (nReturn != 0) goto bail_out;
+  }
+ 
+  switch(gds.head.usData_type) {
+  case 0:
+  case 4:
+    strcpy(Proj->prjnmm,"latlon");
+    Proj->colcnt = gds.llg.usNi;
+    Proj->rowcnt = gds.llg.usNj;
+    Proj->origlat = gds.llg.lLat1/1000.;
+    Proj->origlon = gds.llg.lLon1/1000.;
+    Proj->xintdis = (gds.llg.iDi/1000.)*EARTH_RADIUS*PI_OVER_180;
+    Proj->yintdis = (gds.llg.iDj/1000.)*EARTH_RADIUS*PI_OVER_180;
+    Proj->parm1 = 0.;
+    Proj->parm2 = 0.;
+    if ((gds.llg.usRes_flag >> 3) & 1) *vect_comp_flag = 1;
+    else *vect_comp_flag = 0;
+
+    /* If the grid is a global grid, we want to set the expandlon flag
+     * so that the number of columns in the array is expanded by one and
+     * the first column of data is copied to the last column.  This
+     * allows calling routines to interpolate between first and last columns
+     * of data.
+     */
+
+    if (gds.llg.usNi*gds.llg.iDi/1000. == 360)
+      expandlon = 1;
+    else
+      expandlon = 0;
+     
+    break;
+  case 1: 
+    strcpy(Proj->prjnmm,"mercator");
+    Proj->colcnt = gds.merc.cols;
+    Proj->rowcnt = gds.merc.rows;
+    Proj->origlat = gds.merc.first_lat/1000.;
+    Proj->origlon = gds.merc.first_lon/1000.;
+    Proj->xintdis = gds.merc.lon_inc/1000.;
+    Proj->yintdis = gds.merc.lat_inc/1000.;
+    Proj->parm1 = gds.merc.latin/1000.;
+    Proj->parm2 = (gds.merc.Lo2/1000. - Proj->origlon)/gds.merc.cols;
+    if ((gds.merc.usRes_flag >> 3) & 1) *vect_comp_flag = 1;
+    else *vect_comp_flag = 0;
+    break;
+  case 3:
+    strcpy(Proj->prjnmm,"lambert");
+    Proj->colcnt = gds.lam.iNx;
+    Proj->rowcnt = gds.lam.iNy;
+    Proj->origlat = gds.lam.lLat1/1000.;
+    Proj->origlon = gds.lam.lLon1/1000.;
+    Proj->xintdis = gds.lam.ulDx/1000.;
+    Proj->yintdis = gds.lam.ulDy/1000.;
+    Proj->parm1 = gds.lam.lLat_cut1/1000.;
+    Proj->parm2 = gds.lam.lLat_cut2/1000.;
+    Proj->parm3 = gds.lam.lLon_orient/1000.;
+    if ((gds.lam.usRes_flag >> 3) & 1) *vect_comp_flag = 1;
+    else *vect_comp_flag = 0;
+    break;
+  case 5:
+    strcpy(Proj->prjnmm,"polar_stereo");
+    Proj->colcnt = gds.pol.usNx;
+    Proj->rowcnt = gds.pol.usNy;
+    Proj->origlat = gds.pol.lLat1/1000.;
+    Proj->origlon = gds.pol.lLon1/1000.;
+    Proj->xintdis = gds.pol.ulDx/1000.;
+    Proj->yintdis = gds.pol.ulDy/1000.;
+    Proj->parm1 = 60.;
+    Proj->parm2 = gds.pol.lLon_orient/1000.;   
+    if ((gds.pol.usRes_flag >> 3) & 1) *vect_comp_flag = 1;
+    else *vect_comp_flag = 0;
+    break;
+  default:
+    fprintf(stderr,"Grid not supported, gds.head.usData_type = %d\n",
+	    gds.head.usData_type);
+    fprintf(stderr,"Exiting\n");
+    exit(-1);
+    break;
+  }  
+
+  strcpy(Proj->stordsc,"+y_in_+x");
+  Proj->origx = 1;
+  Proj->origy = 1;
+
+  for (j=0; j< (Proj->rowcnt); j++) {
+    for (i=0; i<(Proj->colcnt); i++) {
+      grib_out[j][i] = grib_data[i+j*Proj->colcnt]*pow(10,scale);
+    }
+  }
+
+  if (expandlon) {
+    (Proj->colcnt)++;
+    for (j = 0; j < Proj->rowcnt; j++) {
+      grib_out[j][Proj->colcnt-1] = grib_out[j][0];
+    }
+  }
+
+  /* 
+   * You only reach here when there is no error, so return successfully.
+   */
+      
+  nReturn = 0;
+
+  if (grib_data != NULL) {
+    free_gribhdr(&gh1);
+    free(grib_data);
+  } 
+
+  return 1;
+      
+  /* The error condition */
+ bail_out:
+  if (errmsg[0] != '\0') fprintf(stderr,"\n***ERROR: %s %s\n",
+				 "get_grib",errmsg);
+  if (grib_data != NULL)
+    free(grib_data);
+  free_gribhdr(&gh1);
+  return -1;
+}
+
+/***************************************************************************
+ * 
+ * This function takes an index as input and returns a 2d grib data field
+ *
+ * Interface:
+ *    input: 
+ *      gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *       index - the index of gribinfo for which data is to be retrieved
+ *    output:
+ *       data - the 2 dimensional output grib data
+ *               Warning: This 2d array is setup with i being the vertical
+ *               dimension and j being the horizontal dimension.  This
+ *               is the convention used in mesoscale numerical modeling
+ *               (the MM5 in particular), so it is used here.
+ *    return:
+ *       1 for success
+ *      -1 for failure
+ ***************************************************************************/
+
+int rg_get_data(GribInfo *gribinfo, int index, float **data)
+{
+  float *data_1d;
+  int i,j;
+  int numrows,numcols;
+  int status;
+
+  numrows = rg_get_numrows(gribinfo,index);
+  numcols = rg_get_numcols(gribinfo,index);
+  
+  data_1d = (float *)calloc(numrows*numcols,sizeof(float));
+  if (data_1d == 0)
+    {
+      fprintf(stderr,"Allocating space for data_1d failed, index: %d\n",index);
+      return -1;
+    }
+
+  status = rg_get_data_1d(gribinfo, index, data_1d);
+  if (status != 1)
+    {
+      return status;
+    }
+
+  for (j=0; j< numrows; j++) {
+    for (i=0; i < numcols; i++) {
+      data[j][i] = data_1d[i+j*numcols];
+    }
+  }
+
+  free(data_1d);
+
+  return 1;
+  
+}
+
+/***************************************************************************
+ * 
+ * This function takes an index as input and returns a 1d grib data field
+ *
+ * Interface:
+ *    input: 
+ *      gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *       index - the index of gribinfo for which data is to be retrieved
+ *    output:
+ *       data - 1 dimensional output grib data
+ *               Warning: This 2d array is setup with i being the vertical
+ *               dimension and j being the horizontal dimension.  This
+ *               is the convention used in mesoscale numerical modeling
+ *               (the MM5 in particular), so it is used here.
+ *    return:
+ *       1 for success
+ *      -1 for failure
+ ***************************************************************************/
+
+int rg_get_data_1d(GribInfo *gribinfo, int index, float *data)
+{
+  char errmsg[ERRSIZE];
+  int nReturn=0;
+  long offset;
+  int Rd_Indexfile=0;
+  BMS_INPUT bms;
+  PDS_INPUT pds;
+  BDS_HEAD_INPUT bds_head;
+  grid_desc_sec gds;
+  GRIB_HDR *gh1;
+  int i,j;
+  int numcols, numrows;
+  float *grib_data;
+
+  /* Initialize Variables */
+  errmsg[0] = '\0';
+  offset = 0L;
+  grib_data = (float *)NULL;
+
+  /* Make storage for Grib Header */
+  nReturn = init_gribhdr (&gh1, errmsg);
+  if (nReturn == 1) goto bail_out;
+  
+  /* Seek to the position in the grib data */
+  offset = gribinfo->elements[index].offset;
+  nReturn = grib_fseek(gribinfo->elements[index].fp,&offset,
+		      Rd_Indexfile,gh1,errmsg);
+  if (nReturn != 0) {
+    fprintf(stderr,"Grib_fseek returned non-zero status (%d)\n",nReturn);
+    goto bail_out;
+  }
+  if (errmsg[0] != '\0')
+    { /* NO errors but got a Warning msg from seek */ 
+      fprintf(stderr,"%s: Skip Decoding...\n",errmsg);
+      errmsg[0] = '\0';
+    }
+  if (gh1->msg_length <= 0) {
+    fprintf(stderr,"Error: message returned had bad length (%ld)\n",
+	    gh1->msg_length);
+    goto bail_out;
+  }
+
+  init_dec_struct(&pds, &gds, &bms, &bds_head);
+ 
+  nReturn = grib_dec((char *)gh1->entire_msg, &pds, &gds, 
+		     &bds_head,
+		     &bms, &grib_data, errmsg);
+ 
+  if (nReturn != 0) goto bail_out;
+  
+  if (bms.uslength > 0) {
+    nReturn = apply_bitmap(&bms, &grib_data, FILL_VALUE, &bds_head, 
+			   errmsg);
+    if (nReturn != 0) goto bail_out;
+  }
+ 
+  /*
+   * Copy the data into the permanent array
+   */ 
+  numcols = rg_get_numcols(gribinfo,index);
+  numrows = rg_get_numrows(gribinfo,index);
+  memcpy(data,grib_data,numcols*numrows*sizeof(float));
+
+  /* 
+   * You only reach here when there is no error, so return successfully.
+   */
+      
+  nReturn = 0;
+
+  if (grib_data != NULL) {
+    free_gribhdr(&gh1);
+    free(grib_data);
+  } 
+
+  return 1;
+      
+  /* The error condition */
+ bail_out:
+  if (errmsg[0] != '\0') fprintf(stderr,"\n***ERROR: %s %s\n",
+				 "get_grib",errmsg);
+  if (grib_data != NULL)
+    free(grib_data);
+  free_gribhdr(&gh1);
+  return -1;
+}
+
+/****************************************************************************
+ * Returns the index of gribinfo corresponding to the input date, level, 
+ * height, and parameter.
+ *
+ * Interface:
+ *   Input: 
+ *      gribinfo  - pointer to a previously populated gribinfo structure.  
+ *      initdate  -  initialization date in the form yyyymmdd[HHMMSS].  If any
+ *                  part of HHMMSS is not specified, it will be set to 0.
+ *      parmid    - the parameter id in the grib file
+ *      leveltype - the leveltype id from table 3/3a of the grib document.
+ *      level1    - First level of the data in units described by leveltype.
+ *      level2    - Second level of the data in units described by leveltype.
+ *      fcsttime1 - First forecast time in seconds.
+ *      fcsttime2 - Second forecast time in seconds.
+ *    Note: If an input variable is set set to -INT_MAX, then any value
+ *                will be considered a match.
+ *    Return:
+ *       if >= 0    The index of the gribinfo data that corresponds to the
+ *                  input parameters
+ *       if < 0     No field corresponding to the input parms was found.
+ *
+ ***************************************************************************/
+
+int rg_get_index(GribInfo *gribinfo, FindGrib *findgrib)
+{
+  int gribnum;
+  int grib_index=-1;
+
+  for (gribnum = 0; gribnum < gribinfo->num_elements; gribnum++) {
+    if (compare_record(gribinfo, findgrib, gribnum) == 1)
+      {
+	grib_index = gribnum;
+	break;
+      }
+  }
+  return grib_index;
+}
+
+
+/****************************************************************************
+ * Same as rg_get_index, except that a guess for the record number is given.
+ *   This "guess" record is first checked to see if it matches, if so, 
+ *      that grib record number is just returned.  If it does not match, 
+ *      full searching ensues.
+ * Returns the index of gribinfo corresponding to the input date, level, 
+ * height, and parameter.
+ *
+ * Interface:
+ *   Input: 
+ *      Same is rg_get_index, except:
+ *      guess_index  - The index to check first.
+ *    Return:
+ *      Same as rg_get_index
+ *
+ ***************************************************************************/
+
+int rg_get_index_guess(GribInfo *gribinfo, FindGrib *findgrib, int guess_index)
+{
+  int retval;
+
+  if (compare_record(gribinfo, findgrib, guess_index) == 1) {
+    retval = guess_index;
+  } else {
+    retval = rg_get_index(gribinfo, findgrib);
+  }
+
+  return retval;
+}
+
+
+/****************************************************************************
+ * Sets all values in FindGrib to missing.
+ *
+ * Interface:
+ *   Input: 
+ *      findgrib  - pointer to a previously allocated findgrib structure.
+ *
+ *    Return:
+ *       1  for success.
+ *       -1 for failure.
+ *
+ ***************************************************************************/
+int rg_init_findgrib(FindGrib *findgrib)
+{
+  strcpy(findgrib->initdate,"*");
+  strcpy(findgrib->validdate,"*");
+  findgrib->parmid          = -INT_MAX;
+  findgrib->parmid          = -INT_MAX;
+  findgrib->leveltype       = -INT_MAX;
+  findgrib->level1          = -INT_MAX;
+  findgrib->level2          = -INT_MAX;
+  findgrib->fcsttime1       = -INT_MAX;
+  findgrib->fcsttime2       = -INT_MAX;
+  findgrib->center_id       = -INT_MAX;
+  findgrib->subcenter_id    = -INT_MAX;
+  findgrib->parmtbl_version = -INT_MAX;
+  
+  return 1;
+}
+
+/****************************************************************************
+ * Returns the indices of all gribinfo entries that match the input date, 
+ * level, height, and parameter.
+ *
+ * Interface:
+ *   Input: 
+ *      gribinfo  - pointer to a previously populated gribinfo structure.  
+ *      initdate  -  initialization date in the form yyyymmdd[HHMMSS].  If any
+ *                  part of HHMMSS is not specified, it will be set to 0.
+ *      parmid    - the parameter id in the grib file
+ *      leveltype - the leveltype id from table 3/3a of the grib document.
+ *      level1    - First level of the data in units described by leveltype.
+ *      level2    - Second level of the data in units described by leveltype.
+ *      fcsttime1 - First forecast time in seconds.
+ *      fcsttime2 - Second forecast time in seconds.
+ *      indices   - an array of indices that match
+ *      num_indices - the number of matches and output indices
+ * 
+ *    Note: If an input variable is set set to -INT_MAX, then any value
+ *                will be considered a match.
+ *    Return:
+ *          The number of matching indices.
+ *
+ ***************************************************************************/
+
+int rg_get_indices(GribInfo *gribinfo, FindGrib *findgrib, int indices[])
+{
+  int gribnum;
+  int matchnum = 0;
+
+  for (gribnum = 0; gribnum < gribinfo->num_elements; gribnum++) {
+    if (compare_record(gribinfo, findgrib, gribnum) == 1) {
+      indices[matchnum] = gribnum;
+      matchnum++;
+    }    
+  }
+  return matchnum;
+}
+
+/*************************************************************************
+ *
+ * Returns an array of dates that correspond to particular input grib fields.
+ * The dates will be sorted so that the dates increase as the index increases.
+ *
+ * Interface:
+ *    Input:
+ *         gribinfo - pointer to a previously allocated gribinfo structure.  
+ *                    The gribinfo structure is filled in this function.
+ *         usParm_id: an array of parameter identifiers that could be
+ *                    used as a sea level pressure field (From table 2 of 
+ *                    grib documentation)
+ *         usLevel_id: the level id that could be used as a sea level pressure
+ *                    field (from table 3 of the grib documentation)
+ *         usHeight1: the height for the particular parameter and level
+ *                    (in units described by the parameter index)
+ *         numparms:  the number of parameters in each of the usParm_id, 
+ *                    usLevel_id, and usHeight1 arrays.
+ *    Output:
+ *         dates:     the dates for which the input fields are available.
+ *         
+ *            Note: Values in the input arrays, usParm_id, usLevel_id, and 
+ *                    usHeight with the same array index must correspond.
+ *
+ *    Return:
+ *          The number of dates found.
+ *************************************************************************/
+
+int rg_get_dates(GribInfo *gribinfo,int usParm_id[],int usLevel_id[],
+	      int usHeight1[],int numparms,int dates[],int century[],
+	      int indices[])
+{
+  int datenum=0;
+  int gribnum;
+  int parmindex;
+  int already_included;
+  int i,j;
+  int tmpval,tmpval2,tmpval3;
+
+  /* Get the dates for the given parameters */
+
+  for (parmindex = 0; parmindex < numparms; parmindex++) {
+    for (gribnum = 0; gribnum < gribinfo->num_elements; gribnum++) {
+      if ((gribinfo->elements[gribnum].usParm_id == usParm_id[parmindex]) &&
+	  (gribinfo->elements[gribnum].usLevel_id == usLevel_id[parmindex]) &&
+	  (gribinfo->elements[gribnum].usHeight1 == usHeight1[parmindex])) {
+	already_included = 0;
+	for (i = 0; i < datenum; i++){
+	  if ((dates[datenum] == gribinfo->elements[gribnum].date) && 
+	      (century[datenum] == gribinfo->elements[gribnum].century)) {
+	    already_included = 1;
+	    break;
+	  }
+	}
+	if (!already_included) {
+	  dates[datenum] = gribinfo->elements[gribnum].date;
+	  century[datenum] = gribinfo->elements[gribnum].century;
+	  indices[datenum] = gribnum;
+	  datenum++;
+	}
+      }
+    }
+  }
+
+  /* Sort the dates into increasing order */
+  for (j = 1; j < datenum; j++) {
+    tmpval = dates[j];
+    tmpval2 = indices[j];
+    tmpval3 = century[j];
+    for (i=j-1; i >= 0; i--) {
+      if (dates[i] <= tmpval) break;
+      dates[i+1] = dates[i];
+      indices[i+1] = indices[i];
+      century[i+1] = century[i];
+    }
+    dates[i+1] = tmpval;
+    indices[i+1] = tmpval2;
+    century[i+1] = tmpval3;
+  }
+
+  return datenum;
+}
+
+/****************************************************************************
+ * This function returns the pds, gds, bms, and bms_head section of the
+ * grib element
+ *
+ * Input:
+ *   gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *              gribinfo structure is filled in this function.
+ *   index - the index of the grib record to access as indexed by 
+ *           setup_gribinfo
+ *   
+ * Output:
+ *   *pds - a pointer to a structure holding the pds information
+ *   *gds - a pointer to a structure holding the gds information
+ *   *bms - a pointer to a structure holding the bms information
+ *   *bds_head - a pointer to a structure holding the binary data section
+ *             header information
+ *
+ ***************************************************************************
+ */
+int rg_get_grib_header(GribInfo *gribinfo, int index, PDS_INPUT *pds, 
+		    grid_desc_sec *gds,BMS_INPUT *bms)
+{
+  int xsize,ysize,j;
+  
+  memcpy(pds,gribinfo->elements[index].pds,sizeof(PDS_INPUT));
+  memcpy(gds,gribinfo->elements[index].gds,sizeof(grid_desc_sec));
+  memcpy(bms,gribinfo->elements[index].bms,sizeof(BMS_INPUT));
+  
+  /* Reset the dimensions for thinned grids */
+  if (gribinfo->elements[index].gds->head.thin != NULL) {
+    if (gds->head.thin != NULL) {
+      if ((gds->head.usData_type == LATLON_PRJ) || 
+	  (gds->head.usData_type == GAUSS_PRJ) ||
+	  (gds->head.usData_type == ROT_LATLON_PRJ) ||
+	  (gds->head.usData_type == ROT_GAUSS_PRJ) ||
+	  (gds->head.usData_type == STR_LATLON_PRJ) ||
+	  (gds->head.usData_type == STR_GAUSS_PRJ) ||
+	  (gds->head.usData_type == STR_ROT_LATLON_PRJ) ||
+	  (gds->head.usData_type == STR_ROT_GAUSS_PRJ)) {
+	ysize = gds->llg.usNj;
+      } else if (gds->head.usData_type == MERC_PRJ) {
+	ysize = gds->merc.rows;
+      } else if (gds->head.usData_type == POLAR_PRJ) {
+	ysize = gds->pol.usNy;
+      } else if ((gds->head.usData_type == LAMB_PRJ) ||
+		 (gds->head.usData_type == ALBERS_PRJ) ||
+		 (gds->head.usData_type == OBLIQ_LAMB_PRJ)) {
+	ysize = gds->lam.iNy;
+      }
+
+      xsize = 0;
+      for (j = 0; j<ysize; j++) {
+	if (gds->head.thin[j] > xsize) {
+	  xsize = gds->head.thin[j];
+	}
+      }
+      
+
+      if ((gds->head.usData_type == LATLON_PRJ) || 
+	  (gds->head.usData_type == GAUSS_PRJ) ||
+	  (gds->head.usData_type == ROT_LATLON_PRJ) ||
+	  (gds->head.usData_type == ROT_GAUSS_PRJ) ||
+	  (gds->head.usData_type == STR_LATLON_PRJ) ||
+	  (gds->head.usData_type == STR_GAUSS_PRJ) ||
+	  (gds->head.usData_type == STR_ROT_LATLON_PRJ) ||
+	  (gds->head.usData_type == STR_ROT_GAUSS_PRJ)) {
+	gds->llg.usNi = xsize;
+	gds->llg.iDi = abs(gds->llg.lLat2 - gds->llg.lLat1)/(xsize-1);
+      } else if (gds->head.usData_type == MERC_PRJ) {
+	gds->merc.cols = xsize;
+      } else if (gds->head.usData_type == POLAR_PRJ) {
+	gds->pol.usNx = xsize;
+      } else if ((gds->head.usData_type == LAMB_PRJ) ||
+		 (gds->head.usData_type == ALBERS_PRJ) ||
+		 (gds->head.usData_type == OBLIQ_LAMB_PRJ)) {
+	gds->lam.iNx = xsize;
+      }
+      
+    }
+  }
+  return 1;
+}
+
+/****************************************************************************
+ * This returns the index of the gribdata for paramaters which match the input
+ * parameters and for the date closest to the input targetdate.  If dates are
+ * not found either within hours_before or hours_after the time, then a missing
+ * value is returned.
+ *
+ * Interface:
+ *   Input:
+ *     gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                  gribinfo structure is filled in this function.
+ *     targetdate:  This is the date which dates in the grib data will be 
+ *                  compared to.  (format: integer yymmddhh)
+ *     hours_before: The maximum difference in time prior to the targetdate
+ *                  for which data should be searched for.
+ *     hours_after: The maximum difference in time after the targetdate for
+ *                  which data should be searched for.
+ *     usParm_id:   an array of parameter identifiers that could be
+ *                  used as a sea level pressure field (From table 2 of 
+ *                  grib documentation)
+ *     usLevel_id:  the level id that could be used as a sea level pressure
+ *                  field (from table 3 of the grib documentation)
+ *     usHeight1:   the height for the particular parameter and level
+ *                  (in units described by the parameter index)
+ *     numparms:    the number of parameters in each of the usParm_id, 
+ *                  usLevel_id, and usHeight1 arrays.
+ *   Return:
+ *     the index of the gribdata with a time closest to the target date.
+ *     -1 if there is no time within the input time limits.
+ * 
+ ****************************************************************************/
+int rg_get_index_near_date(GribInfo *gribinfo,char targetdate[STRINGSIZE],
+			int century,int hours_before,int hours_after,
+			int usParm_id[],int usLevel_id[],int usHeight1[],
+			int numparms)
+{
+  int dates[500],indices[500],centuries[500];
+  int date_before = MISSING;
+  int date_after = MISSING;
+  int century_before,century_after;
+  int date_diff_before = MISSING;
+  int date_diff_after = MISSING;
+  int index_before,index_after;
+  int numdates,datenum;
+  int index;
+  int itargetdate;
+
+  itargetdate = atoi(targetdate);
+
+  numdates = rg_get_dates(gribinfo,usParm_id,usLevel_id,usHeight1,numparms,
+			  dates,centuries,indices);
+  if (numdates <= 0) {
+    fprintf(stderr,"get_index_near_date: No dates were found\n");
+    return -1;
+  }
+  
+  for (datenum = 0; datenum < numdates; datenum++) {
+    if ((dates[datenum] > itargetdate) && (centuries[datenum] >= century)) {
+      century_after = centuries[datenum];
+      date_after = dates[datenum];
+      index_after = indices[datenum];
+      break;
+    } else {
+      century_before = centuries[datenum];
+      date_before = dates[datenum];
+      index_before = indices[datenum];
+    }
+  }
+  
+  if (date_after != MISSING)
+    date_diff_after = date_diff(date_after,century_after,itargetdate,century);
+  if (date_before != MISSING)
+    date_diff_before = 
+      date_diff(itargetdate,century,date_before,century_before);
+
+  if ((date_after != MISSING) && (date_before != MISSING)) {
+    if ((date_diff_after <= hours_after) && 
+	(date_diff_before <= hours_before)) {
+      if (date_diff_after < date_diff_before)
+	index = index_before;
+      else
+	index = index_after;
+    } else if (date_diff_after <= hours_after) {
+	index = index_after;
+    } else if (date_diff_before <= hours_before) {
+	index = index_before;
+    } else {
+      index = -1;
+    }
+  } else if (date_after != MISSING) {
+    if (date_diff_after <= hours_after)
+      index = index_after;
+    else 
+      index = -1;
+  } else if (date_before != MISSING) {
+    if (date_diff_before <= hours_before)
+      index = index_before;
+    else
+      index = -1;
+  } else {
+    index = -1;
+  }
+
+  return index;
+  
+}
+
+/*****************************************************************************
+ *
+ * returns valid time ( = init time + forecast time)
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *    index    - index number of record to get valid time from
+ *
+ * Output:
+ *    valid_time - yyyymmddhhmmss
+ *
+ * Return:
+ *    0 for success
+ *   -1 for error
+ *    
+ *****************************************************************************/
+int rg_get_valid_time(GribInfo *gribinfo, int index, char valid_time[])
+{
+  strcpy(valid_time, gribinfo->elements[index].valid_time);
+  return 0;
+}
+
+/*****************************************************************************
+ *
+ * returns generating center id
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *    index    - index number of record to get valid time from
+ *
+ * Return:
+ *    generating center id
+ *   -1 for error
+ *    
+ *****************************************************************************/
+int rg_get_center_id(GribInfo *gribinfo, int index)
+{
+  return gribinfo->elements[index].center_id;
+}
+
+/*****************************************************************************
+ *
+ * returns parameter table version number
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *    index    - index number of record to get valid time from
+ *
+ * Return:
+ *    parameter table version number
+ *   -1 for error
+ *    
+ *****************************************************************************/
+int rg_get_parmtbl(GribInfo *gribinfo, int index)
+{
+  return gribinfo->elements[index].parmtbl;
+}
+
+/*****************************************************************************
+ *
+ * returns generating process id
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *    index    - index number of record to get valid time from
+ *
+ * Return:
+ *    generating process id
+ *   -1 for error
+ *    
+ *****************************************************************************/
+int rg_get_proc_id(GribInfo *gribinfo, int index)
+{
+  return gribinfo->elements[index].proc_id;
+}
+
+/*****************************************************************************
+ *
+ * returns sub center id
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *    index    - index number of record to get valid time from
+ *
+ * Return:
+ *    sub center id
+ *   -1 for error
+ *    
+ *****************************************************************************/
+int rg_get_subcenter_id(GribInfo *gribinfo, int index)
+{
+  return gribinfo->elements[index].subcenter_id;
+}
+
+/**************************************************************************
+ *
+ * Interpolates grib grid data to a point location.
+ *
+ * Interface:
+ *     input: 
+ *       gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                  gribinfo structure is filled in this function.
+ *       index    - the index of gribinfo for which data is to be retrieved.
+ *                  the first grib record is number 1.
+ *       column   - the column of the point in grid coordinates (can be 
+ *                  floating point number).  leftmost column is 1.
+ *       row      - the row of the point in grid coordinates (can be 
+ *                  floating point number).  bottommost row is 1.
+ *
+ *    return:
+ *       on success - the interpolated value at the column,row location.
+ *       on failure - -99999
+ * 
+ ***************************************************************************/
+
+float rg_get_point(GribInfo *gribinfo, int index, float column, float row)
+{
+  int status;
+  GRIB_PROJECTION_INFO_DEF Proj;
+  BDS_HEAD_INPUT bds_head;
+  int dummy;
+  float **grib_out;
+  float y1, y2;
+  int numrows, numcols;
+  int top, left, right, bottom;
+  float outval;
+  
+  numrows = rg_get_numrows(gribinfo, index);
+  numcols = rg_get_numcols(gribinfo, index);
+
+  grib_out = (float **)alloc_float_2d(numrows,numcols);
+  if (grib_out == NULL) {
+    fprintf(stderr,"rg_get_point: Could not allocate space for grib_out\n");
+    return -99999;
+  }
+
+  status = rg_get_data(gribinfo, index, grib_out);
+  if (status < 0) {
+    fprintf(stderr,"rg_get_point: rg_get_data failed\n");
+    return -99999;
+  }
+
+  /* Do the interpolation here */
+  bottom = floor(row);
+  top = floor(row+1);
+  left = floor(column);
+  right = floor(column+1);
+  
+  y1 = (row - bottom) * (grib_out[top][left] - grib_out[bottom][left]) + 
+    grib_out[bottom][left];
+  y2 = (row - bottom) * (grib_out[top][right] - grib_out[bottom][right]) + 
+    grib_out[bottom][right];
+  outval = (y2 - y1) * (column - left) + y1;
+
+  free_float_2d(grib_out,numrows,numcols);
+
+  return outval;
+  
+}
+
+/**************************************************************************
+ *
+ * Interpolates grib grid data to a point location.
+ *
+ * Interface:
+ *     input: 
+ *       gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                  gribinfo structure is filled in this function.
+ *       index    - the index of gribinfo for which data is to be retrieved.
+ *                  the first grib record is number 1.
+ *     input and output:
+ *       pointdata- array of pointdata structures.  Only the column and
+ *                  row values in the structures need to be filled.  On
+ *                  output, the 'value' member of pointdata is filled.
+ *     input:
+ *       numpoints- number of pointdata structures in the array.
+ *
+ *    return:
+ *       on success - the interpolated value at the column,row location.
+ *       on failure - -99999
+ * 
+ ***************************************************************************/
+int rg_get_points(GribInfo *gribinfo, int index, PointData pointdata[], 
+		   int numpoints)
+{
+  int status;
+  float **grib_out;
+  float y1, y2;
+  int numrows, numcols;
+  int top, left, right, bottom;
+  float column, row;
+  int idx;
+
+  numrows = rg_get_numrows(gribinfo, index);
+  numcols = rg_get_numcols(gribinfo, index);
+
+  grib_out = (float **)alloc_float_2d(numrows,numcols);
+  if (grib_out == NULL) {
+    fprintf(stderr,"rg_get_points: Could not allocate space for grib_out\n");
+    return -99999;
+  }
+
+  status = rg_get_data(gribinfo, index, grib_out);
+  if (status < 0) {
+    fprintf(stderr,"rg_get_points: rg_get_data failed\n");
+    return -99999;
+  }
+
+  for (idx = 0; idx < numpoints; idx++) {
+
+    /* Change from 1 based to 0 based col/row */
+    row = pointdata[idx].row;
+    column = pointdata[idx].column;
+    
+    /* Do the interpolation here */
+    bottom = floor(row);
+    top = floor(row+1);
+    left = floor(column);
+    right = floor(column+1);
+    
+    y1 = (row - bottom) * (grib_out[top][left] - grib_out[bottom][left]) + 
+      grib_out[bottom][left];
+    y2 = (row - bottom) * (grib_out[top][right] - grib_out[bottom][right]) + 
+      grib_out[bottom][right];
+    pointdata[idx].value = (y2 - y1) * (column - left) + y1;
+
+  }
+
+  free_float_2d(grib_out,numrows,numcols);
+
+  return 1;
+}
+
+/**************************************************************************
+ *
+ * Remove an element from an array and decrease, by one, indices of all 
+ * elements with an index greater than the index of the element to remove.
+ *
+ * Interface:
+ *     input: 
+ *        array - the integer array to manipulate
+ *        index - the index of the element to remove
+ *        size - the number of elements in the array
+ *
+ ***************************************************************************/
+void remove_element(int array[],int index, int size)
+{
+  int j;
+  
+  for (j = index; j < size-1; j++) {
+    array[j] = array[j+1];
+  }
+
+}
+
+/****************************************************************************
+ * Advance the time by the input amount
+ *
+ * Interface:
+ *     Input: 
+ *         century - an integer value for the century (20 for 1900's)
+ *                   If the century is advanced, this value is advanced
+ *                   and output to the calling routine.
+ *         year - a 2 digit value for the year.
+ *         month - a 2 digit value for the month.
+ *         day - the day of the month
+ *         hour - the hour of the day
+ *         amount - the amount to advance the time by.
+ *         unit - the units for the amount.  These are values from table 4
+ *                of the grib manual.
+ *    return:
+ *         a date in the form yymmddhh
+ ****************************************************************************/
+
+int advance_time(int *century, int year, int month, int day, int hour,
+		 int amount, int unit)
+{
+  int daysinmonth[] = {31,28,31,30,31,30,31,31,30,31,30,31};
+  int date;
+
+  switch(unit) {
+  case 0:
+    hour += (int)((amount/60.)+0.5);
+    break;
+  case 1:
+    hour += amount;
+    break;
+  case 2:
+    day += amount;
+    break;
+  case 3:
+    month += amount;
+    break;
+  case 4:
+    year += amount;
+    break;
+  case 5:
+    year += 10*amount;
+    break;
+  case 6:
+    year += 30*amount;
+    break;
+  case 7:
+    year += 100*amount;
+    break;
+  case 10:
+    hour += 3*amount;
+    break;
+  case 11:
+    hour += 6*amount;
+    break;
+  case 12:
+    hour += 12*amount;
+    break;
+  case 50:
+    hour += (int)((amount/12.)+0.5);
+  case 254:
+    hour += (int)((amount/(60.*60.))+0.5);
+    break;
+  default:
+    fprintf(stderr,"WARNING: Could not advance time, incorrect unit: %d\n",
+	    unit);
+    return -1;
+  }
+
+  while (hour >= 24) {
+    day++;
+    hour -= 24;
+  }
+  while (month > 12) {
+    year++;
+    month -= 12;
+  }
+
+  /* if it is a leap year, change days in month for Feb now. */ 
+  if (isLeapYear(year)) daysinmonth[1] = 29;
+
+  while (day > daysinmonth[month-1]) {
+    day -= daysinmonth[month-1];
+    month++;
+    if (month > 12) {
+      year++;
+      month -= 12;
+      if (isLeapYear(year))
+	daysinmonth[1] = 29;
+      else
+	daysinmonth[1] = 28;
+    }
+  }
+
+  if (year > 100) {
+    (*century)++;
+  }
+
+  if (year >= 100) {
+    year -= 100;
+  }
+
+  date = hour*1 + day*100 + month*10000 + year*1000000;
+
+  return date;
+
+}
+/****************************************************************************
+ * Advance the time by the input amount
+ *
+ * Interface:
+ *     Input: 
+ *         startdate  - initialization date in the form yyyymmdd[HHMMSS].  If any
+ *                        part of HHMMSS is not specified, it will be set to 0.
+ *         amount     - the amount (in seconds) to advance the time by.
+ *
+ *    Output:
+ *         enddate[] - the time advanced to: yyyymmddHHMMSS format. 
+ *
+ *    Return:
+ *          1 - success
+ *         -1 - failure
+ *
+ ****************************************************************************/
+char *advance_time_str(char startdatein[], int amount, char enddate[])
+{
+  struct tm starttp;
+  struct tm endtp;
+  char startdate[15];
+  time_t time;
+
+  strcpy(startdate,startdatein);
+  while (strlen(startdate) < 14) {
+    strcpy(startdate+(strlen(startdate)),"0");
+  }
+
+  /* This forces all calculations to use GMT time */
+  putenv("TZ=GMT0");
+  tzset();
+
+  sscanf(startdate,"%4d%2d%2d%2d%2d%2d",&(starttp.tm_year),&(starttp.tm_mon),
+	 &(starttp.tm_mday),&(starttp.tm_hour),&(starttp.tm_min),
+	 &(starttp.tm_sec));
+  starttp.tm_mon -= 1;
+  starttp.tm_year -= 1900;
+  time = mktime(&starttp);
+  time += amount;
+  localtime_r(&time, &endtp);
+  strftime(enddate,15,"%Y%m%d%H%M%S",&endtp);
+  
+  return enddate;
+}
+
+/****************************************************************************
+ * Returns the difference in time in hours between date1 and date2 
+ * (date1-date2). 
+ * 
+ * Interface:
+ *   Input:
+ *     date1,date2:  dates in yymmddhh format (integers)
+ *     century1,century2: centuries for each date (20 for 1900's).
+ *   Return:
+ *     the difference in time between the first and second dates in hours.
+ ****************************************************************************/
+int date_diff(int date1,int century1,int date2,int century2)
+{
+  return (hours_since_1900(date1,century1) - 
+	   hours_since_1900(date2,century2));
+}
+
+/****************************************************************************
+ * Returns the number of hours since Jan 1, at 00:00 1900.
+ * 
+ * Interface:
+ *   Input:
+ *     date:    integer in form yymmddhh
+ *     century: 2 digit century (20 for 1900's)
+ *   Return:
+ *     the number of hours since 00:00 Jan1, 1900.
+ *
+ ****************************************************************************/
+int hours_since_1900(int date,int century)
+{
+  int daysinmonth[] = {31,28,31,30,31,30,31,31,30,31,30,31};
+  int hour,day,month,year;
+  int days_since_1900 = 0;
+  int i;
+
+  hour = date%100;
+  day = (date%10000)/100;
+  month = (date%1000000)/10000;
+  year = (date%100000000)/1000000;
+
+  days_since_1900 += day;
+  
+  if (isLeapYear((century-1)*100 + year))
+    daysinmonth[1] = 29;
+  else 
+    daysinmonth[1] = 28;
+  
+  for (i = 0; i < (month - 1); i++)
+    days_since_1900 += daysinmonth[i];
+
+  for (i=0; i < (year + ((century - 20)*100) - 1); i++) {
+    if (isLeapYear((century - 1)*100 + year))
+      days_since_1900 += 366;
+    else
+      days_since_1900 += 365;
+  }
+
+  return days_since_1900*24 + hour;
+
+}
+
+/****************************************************************************
+ *
+ * Returns true if the input year is a leap year, otherwise returns false
+ *
+ ****************************************************************************/
+int isLeapYear(int year)
+{
+  if ( (((year % 4) == 0) && ((year % 100) != 0)) 
+       || ((year % 400) == 0) ) 
+    return 1;
+  else
+    return 0;
+						  
+}
+
+/*****************************************************************************
+ *
+ * Returns the number of grib elements (gribinfo->num_elements) processsed
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ * Return:
+ *   the number of elements in the gribinfo structure
+ ****************************************************************************/
+
+int rg_num_elements(GribInfo *gribinfo){
+
+  return gribinfo->num_elements;
+
+}
+
+/*****************************************************************************
+ *
+ * Deallocates the elements in the gribinfo structure and closes the files.
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ *****************************************************************************/
+void rg_free_gribinfo_elements(GribInfo *gribinfo)
+{
+  int i;
+  
+  for (i=0; i<gribinfo->num_elements; i++) {
+    free(gribinfo->elements[i].pds);
+    free(gribinfo->elements[i].gds);
+    free(gribinfo->elements[i].bms);
+    free(gribinfo->elements[i].bds_head);
+    fclose(gribinfo->elements[i].fp);
+  }
+  free(gribinfo->elements);
+}
+
+/*****************************************************************************
+ *
+ * Returns the value for level1 (gribinfo->usHeight1)
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ * Return:
+ *   value for level1
+ ****************************************************************************/
+
+int rg_get_level1(GribInfo *gribinfo, int index)
+{
+  return gribinfo->elements[index].usHeight1;
+}
+
+/*****************************************************************************
+ *
+ * Returns the value for level2 (gribinfo->usHeight2)
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ * Return:
+ *   value for level1
+ ****************************************************************************/
+
+int rg_get_level2(GribInfo *gribinfo, int index)
+{
+  return gribinfo->elements[index].usHeight2;
+}
+
+/*****************************************************************************
+ *
+ * returns number of rows in grid
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ * Return:
+ *    number of rows in grid
+ *****************************************************************************/
+int rg_get_numrows(GribInfo *gribinfo,int index)
+{
+  if ((gribinfo->elements[index].gds->head.usData_type == LATLON_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == GAUSS_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == ROT_LATLON_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == ROT_GAUSS_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == STR_LATLON_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == STR_GAUSS_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == STR_ROT_LATLON_PRJ)|| 
+      (gribinfo->elements[index].gds->head.usData_type == STR_ROT_GAUSS_PRJ)) 
+    {
+    return gribinfo->elements[index].gds->llg.usNj;
+  } else if (gribinfo->elements[index].gds->head.usData_type == MERC_PRJ) {
+    return gribinfo->elements[index].gds->merc.rows;
+  } else if (gribinfo->elements[index].gds->head.usData_type == LAMB_PRJ) {
+    return gribinfo->elements[index].gds->lam.iNy;
+  } else if (gribinfo->elements[index].gds->head.usData_type == POLAR_PRJ) {
+    return gribinfo->elements[index].gds->pol.usNy;
+  }
+
+}
+/*****************************************************************************
+ *
+ * returns number of columns in grid
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ * Return:
+ *    number of columns in grid
+ *****************************************************************************/
+int rg_get_numcols(GribInfo *gribinfo,int index)
+{
+  if ((gribinfo->elements[index].gds->head.usData_type == LATLON_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == GAUSS_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == ROT_LATLON_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == ROT_GAUSS_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == STR_LATLON_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == STR_GAUSS_PRJ) || 
+      (gribinfo->elements[index].gds->head.usData_type == STR_ROT_LATLON_PRJ)|| 
+      (gribinfo->elements[index].gds->head.usData_type == STR_ROT_GAUSS_PRJ)) 
+    {
+      return gribinfo->elements[index].gds->llg.usNi;
+  } else if (gribinfo->elements[index].gds->head.usData_type == MERC_PRJ) {
+    return gribinfo->elements[index].gds->merc.cols;
+  } else if (gribinfo->elements[index].gds->head.usData_type == LAMB_PRJ) {
+    return gribinfo->elements[index].gds->lam.iNx;
+  } else if (gribinfo->elements[index].gds->head.usData_type == POLAR_PRJ) {
+    return gribinfo->elements[index].gds->pol.usNx;
+  }
+
+}
+/*****************************************************************************
+ *
+ * returns the offset (in bytes) from the beginning of the file.
+ *
+ * Input:
+ *    gribinfo - pointer to a filled gribinfo structure.
+ *
+ * Return:
+ *    offset (in bytes) from beginning of file
+ *****************************************************************************/
+int rg_get_offset(GribInfo *gribinfo,int index)
+{
+  return gribinfo->elements[index].offset;
+}
+/*****************************************************************************
+ *
+ * returns the grib record ending position (in bytes) from the beginning of 
+ *    the file.
+ *
+ * Input:
+ *    gribinfo - pointer to a filled gribinfo structure.
+ *
+ * Return:
+ *    position (in bytes) of the end of the grib record within the file.
+ *****************************************************************************/
+int rg_get_end(GribInfo *gribinfo,int index)
+{
+  return gribinfo->elements[index].end;
+}
+/*****************************************************************************
+ *
+ * returns grib id of input grid
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ * Return:
+ *    grib id of input grid
+ *****************************************************************************/
+int rg_get_gridnum(GribInfo *gribinfo,int index)
+{
+  return gribinfo->elements[index].pds->usGrid_id;
+}
+/*****************************************************************************
+ *
+ * returns date
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ * Return:
+ *    date (yymmddhh) in integer type
+ *****************************************************************************/
+int rg_get_date(GribInfo *gribinfo,int index)
+{
+  return gribinfo->elements[index].date;
+}
+/*****************************************************************************
+ *
+ * returns century
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ * Return:
+ *    century in integer type
+ *****************************************************************************/
+int rg_get_century(GribInfo *gribinfo,int index)
+{
+  return gribinfo->elements[index].century;
+}
+/*****************************************************************************
+ *
+ * returns forecast time
+ *
+ * Input:
+ *    gribinfo - pointer to a previously allocated gribinfo structure.  The 
+ *                 gribinfo structure is filled in this function.
+ *
+ * Return:
+ *    forecast time in units described by usFcst_unit_id
+ *****************************************************************************/
+int rg_get_forecast_time(GribInfo *gribinfo,int index)
+{
+  return gribinfo->elements[index].pds->usP1;
+}
+
+/*****************************************************************************
+ *
+ * reads the gribmap file, and stores the information in the GribParameters
+ *    structure.
+ *
+ * Input:
+ *   gribmap - pointer to a previously allocated GribParameters structure.  
+ *              The gribmap structure is filled in this function.
+ *   file - the name of the gribmap file to read.
+ *
+ *   Return:
+ *      1  - successful call to setup_gribinfo
+ *     -1 - call to setup_gribinfo failed
+ *
+ *****************************************************************************/
+int rg_setup_gribmap(GribParameters *gribmap, char filename[])
+{
+  FILE *fid;
+  char line[500];
+  int id, center, subcenter, table;
+  int idx;
+  
+  fid = fopen(filename,"r");
+  if (fid == NULL)
+    {
+      fprintf(stderr,"Could not open %s\n",filename);
+      return -1;
+    }
+
+  gribmap->parms = (GribTableEntry *)malloc(sizeof(GribTableEntry));
+
+  idx = 0;
+  while (fgets(line,500,fid) != NULL)
+    {
+      /* Skip over comments at begining of gribmap file */
+      if (line[0] == '#') continue;
+
+      sscanf(line,"%d:",&id);
+      if (id == -1) 
+	{
+	  sscanf(line,"%d:%d:%d:%d",&id,&center,&subcenter,&table);
+	} 
+      else
+	{
+	  gribmap->parms = 
+	    (GribTableEntry *)realloc(gribmap->parms,
+					(idx+1)*sizeof(GribTableEntry));
+	  gribmap->parms[idx].center = center;
+	  gribmap->parms[idx].subcenter = subcenter;
+	  gribmap->parms[idx].table = table;
+	  sscanf(line,"%d:%[^:]:%[^:]",&(gribmap->parms[idx].parmid),
+		 gribmap->parms[idx].name,
+		 gribmap->parms[idx].comment);
+	  idx++;
+	}
+    }
+
+
+  gribmap->num_entries = idx;
+
+  close(fid);
+  return 1;
+}
+
+/*****************************************************************************
+ *
+ * finds the gribmap entry described by  the gribmap file, and stores the information in the GribParameters
+ *    structure.
+ *
+ * Input:
+ *   gribmap - pointer to structure that was filled by a call to 
+ *             rg_setup_gribmap
+ *   table   - if set to -1, the first table the valid name will be used.
+ *             Otherwise, the table id must match as well.
+ *   name    - name of the parameter to find.
+ * Output
+ *   gribmap_parms - pointer to GribTableEntry structure containing 
+ *             information about the parameter that was found.
+ *
+ *   Return:
+ *      1  - successful call to setup_gribinfo
+ *     -1 - call to setup_gribinfo failed
+ *
+ *****************************************************************************/
+int rg_gribmap_parameter(GribParameters *gribmap, char name[], int table,
+			 GribTableEntry *gribmap_parms)
+{
+  int idx;
+  int found;
+
+  found = 0;
+  for (idx = 0; idx < gribmap->num_entries; idx++) 
+    {
+      
+      if (strcmp(gribmap->parms[idx].name,name) == 0)
+	{
+	  if ((table == -1) || (table == gribmap->parms[idx].table))
+	    {
+	      /* We found a match! */
+	      found = 1;
+	      break;
+	    }
+	}
+    }
+  
+  if (found) 
+    {
+      memcpy(gribmap_parms,&(gribmap->parms[idx]),sizeof(GribTableEntry));
+      return 1;
+    }
+  else
+    {
+      return -1;
+    }
+}
+
+/*****************************************************************************
+ *
+ * Deallocates the elements in the gribmap structure.
+ *
+ * Input:
+ *    gribmap - pointer to a previously allocated gribmap structure.  The 
+ *                 gribmap structure is filled in this function.
+ *
+ *****************************************************************************/
+void rg_free_gribmap_elements(GribParameters *gribmap)
+{
+  free(gribmap->parms);
+}
+
+/*****************************************************************************
+ *
+ * Compares the elements in a findgrib structure with the elements in the
+ *   gribinfo structure for the input index.  If they match, returns 1, 
+ *   otherwise, returns 0.
+ *
+ * Input:
+ *    gribinfo
+ *    findgrib
+ *    index    - the index of the grib record in gribinfo to compare to.
+ *
+ *****************************************************************************/
+int compare_record(GribInfo *gribinfo, FindGrib *findgrib, int gribnum)
+{
+
+  /* 
+   *  Note (6/20/05): This searching is very inefficient. We may need to 
+   *   improve this, since, for WRF, when searching through boundary data, 
+   *   each search is slower that the previous, since the record to be 
+   *   found turns out to be farther into the list.
+   */
+  
+  int retval = 0;
+
+  if ((findgrib->center_id == -INT_MAX) || 
+      findgrib->center_id == gribinfo->elements[gribnum].center_id) {
+    if ((findgrib->subcenter_id == -INT_MAX) ||
+	findgrib->subcenter_id == gribinfo->elements[gribnum].subcenter_id) {
+      if ((findgrib->parmtbl_version == -INT_MAX) || 
+	  findgrib->parmtbl_version == gribinfo->elements[gribnum].parmtbl) {
+	if ((strcmp(findgrib->initdate,"*") == 0) || 
+	    (strncmp(gribinfo->elements[gribnum].initdate,findgrib->initdate,
+		     strlen(findgrib->initdate)) == 0)) {
+	  if ((strcmp(findgrib->validdate,"*") == 0) || 
+	      (strncmp(gribinfo->elements[gribnum].valid_time,
+		       findgrib->validdate,
+		       strlen(findgrib->validdate)) == 0)) {
+	    if ((findgrib->parmid == -INT_MAX) || 
+		(findgrib->parmid == 
+		 gribinfo->elements[gribnum].usParm_id)) {
+	      if ((findgrib->leveltype == -INT_MAX) || 
+		  (findgrib->leveltype == 
+		   gribinfo->elements[gribnum].usLevel_id)) {
+		if ((findgrib->level1 == -INT_MAX) || 
+		    (findgrib->level1 == 
+		     gribinfo->elements[gribnum].usHeight1)) {
+		  if ((findgrib->level2 == -INT_MAX) || 
+		      (findgrib->level2 == 
+		       gribinfo->elements[gribnum].usHeight2)) {
+		    if ((findgrib->fcsttime1 == -INT_MAX) || 
+			(findgrib->fcsttime1 == 
+			 gribinfo->elements[gribnum].fcsttime1)) {
+		      if ((findgrib->fcsttime2 == -INT_MAX) || 
+			  (findgrib->fcsttime2 == 
+			   gribinfo->elements[gribnum].fcsttime2)) {
+			retval = 1;
+		      }
+		    }
+		  }
+		}
+	      }
+	    }
+	  }
+	}
+      }
+    }
+  }
+
+  return retval;
+}
+
+
+/*****************************************************************************
+ *
+ * returns the multiplication factor to convert grib forecast times to 
+ *   seconds.
+ *
+ * Input: 
+ *    unit_id  - grib forecast unit id, from Table 4.
+ *
+ * Return:
+ *    conversion factor
+ *****************************************************************************/
+int get_factor2(int unit)
+{
+  int factor;
+  
+  switch (unit) {
+  case 0:
+    factor = 60;
+    break;
+  case 1:
+    factor = 60*60;
+    break;
+  case 2:
+    factor = 60*60*24;
+    break;
+  case 10:
+    factor = 60*60*3;
+    break; 
+  case 11:
+    factor = 60*60*3;
+    break;
+  case 12:
+    factor = 60*60*12;
+    break;
+  case 50:
+    /* This is a WSI (non-standard) time unit of 5 minutes */
+    factor = 5*60;
+    break;
+  case 254:
+    factor = 1;
+    break;
+  default:
+    fprintf(stderr,"Invalid unit for forecast time: %d\n",unit);
+    factor = 0;
+  }
+  return factor;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/read_grib.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/read_grib.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/read_grib.h	(revision 2744)
@@ -0,0 +1,169 @@
+#define STRINGSIZE 160
+
+/* The value used to fill missing data points */
+#define FILL_VALUE -9999999.
+
+typedef struct {
+  int usGrid_id;
+  int usParm_id;
+  int usLevel_id;
+  int usHeight1;
+  int usHeight2;
+  int offset;
+  int end;
+  char filename[200];
+  FILE *fp;
+  char initdate[15];
+  char valid_time[15];
+  int date;
+  int century;
+  int fcsttime1;
+  int fcsttime2;
+  int center_id;
+  int parmtbl;
+  int proc_id;
+  int subcenter_id;
+  PDS_INPUT *pds;
+  grid_desc_sec *gds;
+  BMS_INPUT *bms;
+  BDS_HEAD_INPUT *bds_head;  
+} Elements;
+
+typedef struct {
+  int num_elements;
+  Elements *elements;
+} GribInfo;
+
+typedef struct {
+  char initdate[100];
+  char validdate[100];
+  int parmid;
+  int leveltype;
+  int level1;
+  int level2;
+  int fcsttime1;
+  int fcsttime2;
+  int center_id;
+  int subcenter_id;
+  int parmtbl_version;
+} FindGrib;
+
+typedef struct {
+  int center;
+  int subcenter;
+  int table;
+  int parmid;
+  char name[STRINGSIZE];
+  char comment[STRINGSIZE];
+} GribTableEntry;
+
+typedef struct {
+  int num_entries;
+  GribTableEntry *parms;
+} GribParameters;
+
+typedef struct {
+  float column;
+  float row;
+  float value;
+  char id[20];
+} PointData;
+
+typedef struct {
+  char prjnmm[24], stordsc[24];
+  int colcnt, rowcnt;
+  float origlat, origlon, origx, origy;
+  float xintdis, yintdis, parm1, parm2, parm3;
+} GRIB_PROJECTION_INFO_DEF;
+
+/* Public function definitions */
+
+int rg_setup_gribmap(GribParameters *gribmap, char file[]);
+int rg_gribmap_parameter(GribParameters *gribmap, char name[], int table,
+			 GribTableEntry *gribmap_parms);
+void rg_free_gribmap_elements(GribParameters *gribmap);
+
+int rg_setup_gribinfo(GribInfo *gribinfo, char files[][STRINGSIZE],
+		      int use_fcst);
+int rg_setup_gribinfo_f(GribInfo *gribinfo, FILE *fp, int use_fcst);
+int rg_setup_gribinfo_i(GribInfo *gribinfo, int fid, int use_fcst);
+
+int rg_get_index(GribInfo *gribinfo, FindGrib *find_grib);
+
+int rg_get_index_guess(GribInfo *gribinfo, FindGrib *findgrib, int guess_index);
+
+int rg_get_indices(GribInfo *gribinfo, FindGrib *find_grib, int *indices);
+
+int rg_init_findgrib(FindGrib *findgrib);
+
+int rg_get_grib_header(GribInfo *gribinfo, int index, PDS_INPUT *pds, 
+		    grid_desc_sec *gds,BMS_INPUT *bms);
+
+int rg_num_elements(GribInfo *gribinfo);
+
+void rg_free_gribinfo_elements(GribInfo *gribinfo);
+
+int rg_get_numrows(GribInfo *gribinfo,int index);
+
+int rg_get_numcols(GribInfo *gribinfo,int index);
+
+int rg_get_level1(GribInfo *gribinfo, int index);
+
+int rg_get_level2(GribInfo *gribinfo, int index);
+
+int rg_get_center_id(GribInfo *gribinfo, int index);
+
+int rg_get_subcenter_id(GribInfo *gribinfo, int index);
+
+int rg_get_proc_id(GribInfo *gribinfo, int index);
+
+int rg_get_tblversion(GribInfo *gribinfo, int index);
+
+float rg_get_point(GribInfo *gribinfo, int index, float column, float row);
+
+int rg_get_points(GribInfo *gribinfo, int index, PointData *pointdata, 
+		    int numpoints);
+
+int rg_get_offset(GribInfo *gribinfo, int index);
+
+int rg_get_end(GribInfo *gribinfo, int index);
+
+int rg_get_valid_time(GribInfo *gribinfo, int index, char valid_time[]);
+
+int rg_get_data(GribInfo *gribinfo, int index, float **data);
+
+int rg_get_data_1d(GribInfo *gribinfo, int index, float *data);
+
+int rg_write_grib(PDS_INPUT *pds, grid_desc_sec *gds, char filename[],
+		  float **data);
+int rg_fwrite_grib(PDS_INPUT *pds, grid_desc_sec *gds, float **data, 
+		   FILE *fid);
+
+
+
+/* The following are public functions also.  However, the interface to many
+ *   of them needs to be reworked.  For example, it is not possible to specify
+ *   a secondary height or forecast time with many of them.
+ * Note: As of 11/11/04, the functions listed above have already been reworked.
+ */
+
+int rg_get_pressure_levels(GribInfo *gribinfo, int dates[], int centuries[], 
+			int parm_id[], int finallevels[],int min_pres,
+			int numparms);
+int rg_get_msl_indices(GribInfo *gribinfo, char dates[][STRINGSIZE],
+		    int centuries[], int usParm_id[],int usLevel_id[],
+		    int usHeight1[],int infactor[],int numparms,
+		    int grib_index[],int outfactor[]);
+int rg_get_grib(GribInfo *gribinfo, int index,int scale,
+	     float **grib_out,int *vect_comp_flag, 
+	     GRIB_PROJECTION_INFO_DEF *Proj, BDS_HEAD_INPUT *bds_head);
+int rg_get_dates(GribInfo *gribinfo,int usParm_id[],int usLevel_id[],
+	      int usHeight1[],int numparms,int dates[],int century[],
+	      int indices[]);
+int rg_get_index_near_date(GribInfo *gribinfo,char targetdate[STRINGSIZE],
+			int century,int hours_before,int hours_after,
+			int usParm_id[],int usLevel_id[],int usHeight1[],
+			int numparms);
+int rg_get_date(GribInfo *gribinfo,int index);
+int rg_get_century(GribInfo *gribinfo,int index);
+int rg_get_forecast_time(GribInfo *gribinfo,int index);
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/test_advance_time_str.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/test_advance_time_str.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/test_advance_time_str.c	(revision 2744)
@@ -0,0 +1,13 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "grib.h"
+#include "read_grib.h"
+
+main(argc,argv)
+int argc;
+char *argv[];
+{
+  char enddate[15];
+  advance_time_str("200509081200",-243,enddate);
+  fprintf(stderr,"advanced to %s\n",enddate);
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/test_rg_gribmap.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/test_rg_gribmap.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/test_rg_gribmap.c	(revision 2744)
@@ -0,0 +1,36 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "grib.h"
+#include "read_grib.h"
+
+main(argc,argv)
+int argc;
+char *argv[];
+{
+
+  GribParameters gribmap;
+  GribTableEntry entry;
+
+  char infile[] = "/home/tahutchinson/projects/venture/config/grib/gribmap.txt";
+  int status;
+
+  /*
+   * This function indexes the grib file and fills the gribinfo
+   *  structure.  It needs to be called before any other
+   *  rg_ functions.
+   */
+  status = rg_setup_gribmap(&gribmap,infile);
+
+  status = rg_gribmap_parameter(&gribmap,"UGRD",-1,&entry);
+  fprintf(stderr,"%d %d %d %d %s %s\n",
+	  entry.center, entry.subcenter, entry.table, entry.parmid, 
+	  entry.name, entry.comment);
+
+  status = rg_gribmap_parameter(&gribmap,"BouPTYPE",204,&entry);
+  fprintf(stderr,"%d %d %d %d %s %s\n",
+	  entry.center, entry.subcenter, entry.table, entry.parmid, 
+	  entry.name, entry.comment);
+
+  rg_free_gribmap_elements(&gribmap);
+
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/write_grib.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/write_grib.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/grib1_util/write_grib.c	(revision 2744)
@@ -0,0 +1,190 @@
+/*
+ *****************************************************************************
+ * rg_write_grib - function which encapsulates parts of the MEL grib library
+ *              writing routines.  
+ *
+ * Todd Hutchinson
+ * TASC
+ * tahutchinson@tasc.com
+ * (781)942-2000 x3108
+ * 7/1/99
+ *
+ * Interface:
+ *   Input:
+ *     pds -      a pointer to a structure which stores information about the 
+ *                grib product definition section.
+ *     gds -      a pointer to a structure which stores information about the 
+ *                grib grid definition section.
+ *     filename - This is the output grib file which will be created if 
+ *                it does not already exist.  If this file already exists,
+ *                grib records will be appended to it.
+ *     data -     a 2-d array holding the values at grid points for the grid
+ *                that is to be output.
+ *   Return:
+ *     1 for success
+ *    -1 for failure
+ *
+ *   Caveats:   This function only supports a "latlon" grid
+ *              currently, this is equivalent to a cylindrical equidistant
+ *              projection.
+ *
+ ***************************************************************************
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "gribfuncs.h"
+
+int rg_write_grib(PDS_INPUT *pds, grid_desc_sec *gds, char filename[],
+	       float **data)
+{
+  char tmpfile[240];
+  char tmpstring[240];
+  FILE *fid;
+  int status;
+
+  sprintf(tmpfile,"/tmp/tmpgribfile_%d",getpid());
+  fid = fopen(tmpfile,"wb");
+  if (fid == NULL) {
+    fprintf(stderr,"rg_write_grib: Could not open %s\n",tmpfile);
+    return -1;
+  }
+
+  status = rg_fwrite_grib(pds,gds,data,fid);
+  if (status != 1)
+    {
+      fprintf(stderr,"rg_write_grib: rg_fwrite_grib failed\n");
+      return -1;
+    }
+  
+  /* append tmpfile to filename */
+  sprintf(tmpstring,"cat %s >> %s",tmpfile,filename);
+  system(tmpstring);
+  unlink(tmpfile);
+ 
+  close(fid);
+
+  return(1);
+}
+
+int rg_fwrite_grib(PDS_INPUT *pds, grid_desc_sec *gds, float **data, FILE *fid)
+{
+
+  GRIB_HDR *gh=NULL;
+  DATA_INPUT data_input;
+  GEOM_IN geom_in;
+  USER_INPUT user_input;
+  char errmsg[240];
+  float *data_one_d;
+  int status;
+  int i,j;
+
+  if ((gds->head.usData_type == LATLON_PRJ) || 
+      (gds->head.usData_type == GAUSS_PRJ)) {
+    if (gds->head.usData_type == GAUSS_PRJ) {
+      strcpy(geom_in.prjn_name,"gaussian");
+    } else {
+      strcpy(geom_in.prjn_name,"spherical");
+    }
+    geom_in.nx = gds->llg.usNi;
+    geom_in.ny = gds->llg.usNj;
+    geom_in.parm_1 = (gds->llg.iDj)/1000.;
+    geom_in.parm_2 = (gds->llg.iDi)/1000.;
+    geom_in.first_lat = gds->llg.lLat1/1000.;
+    geom_in.first_lon = gds->llg.lLon1/1000.;
+    geom_in.last_lat = gds->llg.lLat2/1000.;
+    geom_in.last_lon = gds->llg.lLon2/1000.;
+    geom_in.scan = gds->llg.usScan_mode;
+    geom_in.usRes_flag = gds->llg.usRes_flag;
+  } else if (gds->head.usData_type == LAMB_PRJ) {
+    strcpy(geom_in.prjn_name,"lambert");
+    geom_in.nx = gds->lam.iNx;
+    geom_in.ny = gds->lam.iNy;
+    geom_in.x_int_dis = gds->lam.ulDx/1000.;
+    geom_in.y_int_dis = gds->lam.ulDy/1000.;
+    geom_in.parm_1 = (gds->lam.lLat_cut2)/1000.;
+    geom_in.parm_2 = (gds->lam.lLat_cut1)/1000.;
+    geom_in.parm_3 = (gds->lam.lLon_orient)/1000.;
+    geom_in.first_lat = gds->lam.lLat1/1000.;
+    geom_in.first_lon = gds->lam.lLon1/1000.;
+    geom_in.scan = gds->lam.usScan_mode;
+    geom_in.usRes_flag = gds->lam.usRes_flag;    
+  } else {
+    fprintf(stderr,"rg_fwrite_grib: invalid input projection %d\n",
+	    gds->head.usData_type);
+    return -1;
+  }
+
+  data_input.usProc_id = pds->usProc_id;
+  data_input.usGrid_id = pds->usGrid_id;
+  data_input.usParm_id = pds->usParm_id;
+  data_input.usParm_sub_id = pds->usCenter_sub;
+  data_input.usLevel_id = pds->usLevel_id;
+  data_input.nLvl_1 = pds->usHeight1;
+  data_input.nLvl_2 = pds->usHeight2;
+  data_input.nYear = pds->usYear + (pds->usCentury-1)*100;
+  data_input.nMonth = pds->usMonth;
+  data_input.nDay = pds->usDay;
+  data_input.nHour = pds->usHour;
+  data_input.nMinute = pds->usMinute;
+  data_input.nSecond = 0;
+  data_input.usFcst_id = pds->usFcst_unit_id;
+  data_input.usFcst_per1 = pds->usP1;
+  data_input.usFcst_per2 = pds->usP2;
+  data_input.usTime_range_id = pds->usTime_range;
+  data_input.usTime_range_avg = pds->usTime_range_avg;
+  data_input.usTime_range_mis = pds->usTime_range_mis;
+  /* We add an extra digit here, because the grib library seems to cut off
+   *   one more than I would prefer.
+   */
+  data_input.nDec_sc_fctr = pds->sDec_sc_fctr+1;
+
+  user_input.chCase_id='0';
+  user_input.usParm_tbl=pds->usParm_tbl;
+  user_input.usSub_tbl=pds->usSub_tbl;
+  /*
+  user_input.usCenter_id=190;
+  */
+  user_input.usCenter_id = pds->usCenter_id;
+  user_input.usCenter_sub=pds->usCenter_sub;
+  user_input.usTrack_num=0;
+  user_input.usGds_bms_id = 128;
+  user_input.usBDS_flag=0;
+  user_input.usBit_pack_num=0;
+
+ 
+  data_one_d = (float *)calloc(geom_in.nx*geom_in.ny,sizeof(float));
+  if (data_one_d == NULL) {
+    fprintf(stderr,"rg_fwrite_grib: could not allocate space for data_one_d\n");
+    return -1;
+  }
+
+  for (i=0; i<geom_in.nx; i++) {
+    for (j=0; j<geom_in.ny; j++) {
+      data_one_d[i+j*geom_in.nx] = data[j][i];
+    }
+  }
+
+  status = init_gribhdr(&gh,errmsg);
+  if (status != 0) {
+    fprintf (stderr,"rg_fwrite_grib: %s",errmsg);
+    return -1;
+  }
+
+  status = grib_enc(data_input,user_input,geom_in,data_one_d,gh,errmsg);
+  if (status != 0) {
+    fprintf (stderr,"rg_fwrite_grib: %s",errmsg);
+    return -1;
+  }
+
+  status = gribhdr2file(gh,fid,errmsg);
+  if (status != 0) {
+    fprintf (stderr,"rg_fwrite_grib: %s",errmsg);
+    return -1;
+  }
+
+  free_gribhdr(&gh);
+
+  return 1;
+  
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/gribmap.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/gribmap.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/gribmap.c	(revision 2744)
@@ -0,0 +1,499 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "gribmap.h"
+
+/******************************************************************************
+ *
+ * The functions in this file are used for opening/reading, and searching for
+ *   information in a grib table.
+ *
+ * All functions return 0 for success and 1 for failure, unless otherwise 
+ *   noted.
+ *****************************************************************************/
+
+int findchar(char *line, char thechar);
+
+#ifdef TEST
+int main()
+{
+  Grib1_Tables grib_tables;
+  char filename[300];
+  int parm_id;
+  int ret;
+  int tablenum;
+  int center,subcenter,parmtbl;
+  
+  strcpy(filename,"gribmap.txt");
+  LOAD_GRIB1_TABLES(filename, &grib_tables, &ret);
+
+  GET_GRIB_PARAM (&grib_tables, "TSK", &center,&subcenter,&parmtbl,
+		  &tablenum, &parm_id);
+  fprintf(stderr,"got parm_id: %d center: %d subcenter: %d parmtbl: %d\n",
+	  parm_id,center,subcenter,parmtbl);
+
+}
+#endif
+
+/******************************************************************************
+ *
+ * read_gribmap - reads a gribmap file and puts the information into the 
+ *                 grib_table_info structure.
+ *
+ ******************************************************************************/
+
+int READ_GRIBMAP (char *filename, Grib1_Tables *grib_tables, int *ret)
+{
+
+  FILE *mapptr;
+  char line[MAX_LINE_CHARS];
+  int dummy;
+  int parmidx;
+  int nxtidx, elemidx, charidx;
+  char elems[6][MAX_LINE_CHARS];
+  int tablenum;
+
+  /* Open parameter table file */
+  mapptr = fopen(filename, "r");
+  if (mapptr == NULL)
+    {
+      fprintf(stderr,"Could not open %s\n",filename);
+      *ret=1;
+      return 1;
+    }
+
+  /* Skip over comments at begining of gribmap file */
+  while (fgets(line,500,mapptr))
+    {
+      if (line[0] != '#') break;
+    }
+
+  tablenum = 0;
+  grib_tables->num_tables = 1;
+  grib_tables->grib_table_info = 
+    (Grib1_Table_Info *)calloc(1,sizeof(Grib1_Table_Info));
+
+  if (grib_tables->grib_table_info == NULL)
+    {
+      fprintf(stderr,"Could not allocate space for grib_table_info\n");
+      *ret = 1;
+      return 1;
+    }
+  grib_tables->grib_table_info[tablenum].num_entries = 0;
+
+  sscanf(line,"%d:%d:%d:%d",&dummy,
+	 &(grib_tables->grib_table_info[tablenum].center),
+	 &(grib_tables->grib_table_info[tablenum].subcenter),
+	 &(grib_tables->grib_table_info[tablenum].parmtbl));
+
+  /* 
+   * Read each line of parameter table, and store information in the
+   *   structure.
+   */
+  while (fgets(line,MAX_LINE_CHARS,mapptr) != NULL) 
+    {
+      /* Split up the elements that are seperated by : */
+      nxtidx = 0;
+      elemidx = 0;
+      while ((charidx = findchar(line + nxtidx,':')) >= 0)
+	{
+	  strncpy(elems[elemidx],line + nxtidx,charidx);
+	  elems[elemidx][charidx] = '\0';
+	  elemidx++;
+	  nxtidx += (charidx + 1);
+	}
+
+      parmidx = atoi(elems[0]);
+
+      /* 
+       * Check to see if this line specifies the next grib table.  If so,
+       *   break out
+       */
+      if (parmidx == -1) {
+	grib_tables->num_tables++;
+	tablenum++;
+	grib_tables->grib_table_info = 
+	  (Grib1_Table_Info *)
+	  realloc(grib_tables->grib_table_info,
+		  grib_tables->num_tables*sizeof(Grib1_Table_Info));
+	
+	if (grib_tables->grib_table_info == NULL)
+	  {
+	    fprintf(stderr,
+		    "Could not re-allocate space for grib_table_info\n");
+	    *ret = 1;
+	    return 1;
+	  }
+	grib_tables->grib_table_info[tablenum].num_entries = 0;
+	sscanf(line,"%d:%d:%d:%d",&dummy,
+	       &(grib_tables->grib_table_info[tablenum].center),
+	       &(grib_tables->grib_table_info[tablenum].subcenter),
+	       &(grib_tables->grib_table_info[tablenum].parmtbl));
+	continue;
+      }
+
+      /* Assure that we have not gone beyond 256 entries! */
+      if (grib_tables->grib_table_info[tablenum].num_entries >= 256) 
+	{
+	  fprintf(stderr,
+"Error: Invalid number of lines in table %d in, \n skipping line: %s \n",
+		  tablenum,line);
+	  break;
+	}
+
+      /* Grab the last field */
+      strcpy(elems[elemidx],line + nxtidx);
+
+      /* Split up comma-seperated field of wrf varnames */
+      nxtidx = 0;
+      elemidx = 0;
+
+      /* Allocate number of elements in wrf_param */
+      grib_tables->grib_table_info[tablenum].wrf_param[parmidx] = 
+	(char **)malloc(1*sizeof(char *));
+      if (grib_tables->grib_table_info[tablenum].wrf_param[parmidx] == NULL)
+	{
+	  fprintf(stderr, "Error allocating space for wrf_param[%d], exiting\n",
+		  parmidx);
+	  *ret = 1;
+	  return 1;
+	}
+
+      while ((charidx = findchar(elems[3]+nxtidx,',')) >= 0) 
+	{
+
+	  /* Allocate number of elements in wrf_param */
+	  grib_tables->grib_table_info[tablenum].wrf_param[parmidx] = 
+	    (char **)
+	    realloc(grib_tables->grib_table_info[tablenum].wrf_param[parmidx],
+			     (elemidx+2)*sizeof(char *));
+	  if (grib_tables->grib_table_info[tablenum].wrf_param[parmidx] 
+	      == NULL)
+	    {
+	      perror("");
+	      fprintf(stderr, 
+		      "Error allocating space for wrf_param[%d], exiting\n", 
+		      parmidx);
+	      *ret = 1;
+	      return 1;
+	    }
+
+	  grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx] = 
+	    (char *)malloc((charidx+2)*sizeof(char));
+	  if (grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx]
+	      == NULL)
+	    {
+	      perror("");
+	      fprintf(stderr, 
+		      "Error allocating space for wrf_param[%d][%d], exiting\n",
+		      parmidx,elemidx);
+	      *ret = 1;
+	      return 1;
+	    }
+	  
+	  strncpy(grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx],
+		  elems[3]+nxtidx,charidx);
+	  grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx][charidx] = '\0';
+	  elemidx++;
+	  nxtidx += (charidx + 1);
+	}
+
+      /* Grab the last field */
+      if (strlen(elems[3] + nxtidx) <= 0) 
+	{
+	  /* Case for no specified WRF fields */
+	  grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx] =
+	    (char *)malloc(1*sizeof(char));
+	  if (grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx]
+	      == NULL)
+	    {
+	      perror("");
+	      fprintf(stderr, 
+		      "Error allocating space for wrf_param[%d][%d], exiting\n",
+		      parmidx,elemidx);
+	      *ret = 1;
+	      return 1;
+	    }
+	  grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx][0] 
+	    = '\0';
+	  grib_tables->grib_table_info[tablenum].num_wrf_params[parmidx] = 0;
+	}
+      else
+	{
+	  /* Allocate space for last element */
+	  grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx] =
+	    (char *)malloc((strlen(elems[3] + nxtidx)+1)*sizeof(char));
+	  if (grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx]
+	      == NULL)
+	    {
+	      perror("");
+	      fprintf(stderr, 
+		      "Error allocating space for wrf_param[%d][%d], exiting\n",
+		      parmidx,elemidx);
+	      *ret = 1;
+	      return 1;
+	    }
+	  
+	  strcpy(grib_tables->grib_table_info[tablenum].wrf_param[parmidx][elemidx],
+		 elems[3] + nxtidx);
+	  grib_tables->grib_table_info[tablenum].num_wrf_params[parmidx] = 
+	    elemidx + 1;
+	}
+  
+      grib_tables->grib_table_info[tablenum].parm_id[parmidx]=atoi(elems[0]);
+      grib_tables->grib_table_info[tablenum].dec_sc_factor[parmidx]=atoi(elems[4]);
+
+      grib_tables->grib_table_info[tablenum].num_entries++;
+    }
+
+  *ret=0;
+  return 0;
+}
+
+/******************************************************************************
+ *
+ * get_grib_param - searches through a grib_table_info structure and returns
+ *                   the index for the input "varname".
+ *
+ * returns index number, or, -1 for failure.
+ *****************************************************************************/
+
+int GET_GRIB_PARAM (Grib1_Tables *grib_tables, char *varname, int *center, 
+		    int *subcenter, int *parmtbl, int *tablenum, int *index,
+		    int strlen1, int strlen2)
+{
+  int idx;
+  int prm_idx;
+  int tableidx;
+  char varnametmp[200];
+  
+  *index = -1;
+
+  strncpy(varnametmp,varname,strlen2);
+  varnametmp[strlen2] = '\0';
+  trim(varnametmp);
+  for (tableidx = 0; tableidx < grib_tables->num_tables ;tableidx++)
+    {
+
+
+      for (idx = 0; 
+	   idx < grib_tables->grib_table_info[tableidx].num_entries;
+	   idx++) 
+	{
+	  for (prm_idx = 0; 
+	       prm_idx < 
+		 grib_tables->grib_table_info[tableidx].num_wrf_params[idx]; 
+	       prm_idx++) 
+	    {
+	      if (strcmp(varnametmp,
+			 grib_tables->grib_table_info[tableidx].wrf_param[idx][prm_idx]) 
+		  == 0) 
+		{
+		  *center = 
+		    grib_tables->grib_table_info[tableidx].center;
+		  *subcenter = grib_tables->grib_table_info[tableidx].subcenter;
+		  *parmtbl = grib_tables->grib_table_info[tableidx].parmtbl;
+		  *tablenum = tableidx;
+		  *index = idx;
+		  break;
+		}
+	    }
+	}
+      
+    }
+  return *index;
+}
+
+/******************************************************************************
+ *
+ * free_gribmap_ - returns the size (in bytes) of a grib_table_info
+ *                         structure.
+ *
+ *****************************************************************************/
+
+int FREE_GRIBMAP(Grib1_Tables *grib_tables)
+{
+  int idx, idx2;
+  int tablenum;
+  
+  for (tablenum = 0; tablenum < grib_tables->num_tables; tablenum++)
+    {
+      for (idx = 0; idx < grib_tables->grib_table_info[tablenum].num_entries; 
+	   idx++)
+	{
+	  for (idx2 = 0; 
+	       idx2 < grib_tables->grib_table_info[tablenum].num_wrf_params[idx]; 
+	       idx2++)
+	    {
+	      free(grib_tables->grib_table_info[tablenum].wrf_param[idx][idx2]);
+	    }
+	  if (grib_tables->grib_table_info[tablenum].num_wrf_params[idx] > 0)
+	    {
+	      free(grib_tables->grib_table_info[tablenum].wrf_param[idx]);
+	    }
+	}
+    }
+  free(grib_tables->grib_table_info);
+  return 0;
+}
+
+/******************************************************************************
+ *
+ * Return the character index of the first instance of "thechar" in a string.
+ *
+ ******************************************************************************/
+
+int findchar(char *line, char thechar)
+{
+  int returnidx, charnum;
+
+  returnidx = -1;
+  for (charnum = 0; charnum < strlen(line); charnum++) 
+    {
+      if (line[charnum] == thechar)
+	{
+	  returnidx = charnum;
+	  break;
+	}
+    }
+  return returnidx;
+}
+
+/******************************************************************************
+ *
+ * get_grib1_table_info_size - returns the size (in bytes) of a grib_table_info
+ *                         structure.
+ *
+ *****************************************************************************/
+
+int GET_GRIB1_TABLE_INFO_SIZE (int *size)
+{
+  *size = sizeof(Grib1_Table_Info);
+  return *size;
+}
+
+/******************************************************************************
+ *
+ * get_grib1_tables_size - returns the size (in bytes) of a grib_tables
+ *                         structure.
+ *
+ *****************************************************************************/
+
+int GET_GRIB1_TABLES_SIZE (int *size)
+{
+  *size = sizeof(Grib1_Tables);
+  return *size;
+}
+
+/******************************************************************************
+ *
+ * load_grib1_table_info - reads a gribmap file and puts the information into 
+ *                         the grib_table_info structure.
+ *
+ ******************************************************************************/
+
+int LOAD_GRIB1_TABLES (char filename[], 
+		       Grib1_Tables *grib_tables, int *ret, int strlen1)
+{
+
+  char tmpfilename[300];
+  strncpy(tmpfilename,filename,strlen1);
+  tmpfilename[strlen1] = '\0';
+
+  READ_GRIBMAP(tmpfilename, grib_tables, ret);
+
+  return *ret;
+}
+
+/******************************************************************************
+ *
+ * get_grid_info_size_ - returns the size (in bytes) of a grib_tables
+ *                         structure.
+ *
+ *****************************************************************************/
+
+int GET_GRID_INFO_SIZE (int *size)
+{
+  *size = sizeof(Grib1_Tables);
+  return *size;
+}
+
+
+/******************************************************************************
+ *
+ * copy_grib_tables - allocates and fills a grib_tables structure
+ *
+ *****************************************************************************/
+
+Grib1_Tables *copy_grib_tables(Grib1_Tables *grib_tables)
+{
+  int tblidx,prmidx,elmidx;
+  int strsiz;
+
+  Grib1_Tables *tmp;
+
+  tmp = (Grib1_Tables *)malloc(sizeof(Grib1_Tables));
+
+  memcpy(tmp,grib_tables,sizeof(Grib1_Tables));
+
+  /* Now do the grib_table_info elements within grib_tables */
+
+  tmp->grib_table_info = 
+    (Grib1_Table_Info *)
+    malloc(grib_tables->num_tables*sizeof(Grib1_Table_Info));
+  if (tmp->grib_table_info == NULL) 
+    {
+      fprintf(stderr,
+	      "copy_grib_tables: Could not allocate space for grib_table_info.  num_tables: %d\n",
+	      grib_tables->num_tables);
+      exit(1);
+    }
+
+  memcpy(tmp->grib_table_info,
+	 grib_tables->grib_table_info,
+	 grib_tables->num_tables*sizeof(Grib1_Table_Info));
+
+
+  for (tblidx = 0; tblidx < grib_tables->num_tables; tblidx++) 
+    {
+
+      for (prmidx = 0; prmidx < MAX_PARAMS; prmidx++)
+	{
+	  if (grib_tables->grib_table_info[tblidx].num_wrf_params[prmidx] <= 0)
+	    {
+	      continue;
+	    }
+
+	  tmp->grib_table_info[tblidx].wrf_param[prmidx] = (char **)
+	    malloc(grib_tables->grib_table_info[tblidx].num_wrf_params[prmidx] 
+		   * sizeof(char *));
+
+	  memcpy(tmp->grib_table_info[tblidx].wrf_param[prmidx],
+		 grib_tables->grib_table_info[tblidx].wrf_param[prmidx],
+		 grib_tables->grib_table_info[tblidx].num_wrf_params[prmidx]
+		 * sizeof(char *));
+
+	  for (elmidx = 0; 
+	       elmidx < grib_tables->grib_table_info[tblidx].num_wrf_params[prmidx]; 
+	       elmidx++) 
+	    {
+	      
+	      strsiz = 
+		strlen(grib_tables->grib_table_info[tblidx].wrf_param[prmidx][elmidx]) + 1;
+	      tmp->grib_table_info[tblidx].wrf_param[prmidx][elmidx] = 
+		(char *)
+		malloc(strsiz * sizeof(char));
+
+	      memcpy(tmp->grib_table_info[tblidx].wrf_param[prmidx][elmidx],
+		     grib_tables->grib_table_info[tblidx].wrf_param[prmidx][elmidx],
+		     strsiz * sizeof(char));
+
+	    }
+
+	}
+
+    }
+
+  return tmp;
+
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/gribmap.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/gribmap.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/gribmap.h	(revision 2744)
@@ -0,0 +1,56 @@
+#define MAX_LINE_CHARS 2500
+#define MAX_PARAMS 256
+
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define LOAD_GRIB1_TABLES load_grib1_tables
+#      define GET_GRIB_PARAM get_grib_param
+#      define FREE_GRIBMAP  free_gribmap
+#      define GET_GRIB1_TABLE_INFO_SIZE get_grib1_table_info_size
+#      define GET_GRIB1_TABLES_SIZE get_grib1_tables_size
+#      define READ_GRIBMAP read_gribmap
+# else
+#   ifdef F2CSTYLE
+#      define LOAD_GRIB1_TABLES load_grib1_tables__
+#      define GET_GRIB_PARAM get_grib_param__
+#      define FREE_GRIBMAP  free_gribmap__
+#      define GET_GRIB1_TABLES_SIZE get_grib1_tables_size__
+#      define READ_GRIBMAP read_gribmap__
+#   else
+#      define LOAD_GRIB1_TABLES load_grib1_tables_
+#      define GET_GRIB_PARAM get_grib_param_
+#      define FREE_GRIBMAP  free_gribmap_
+#      define GET_GRIB1_TABLES_SIZE get_grib1_tables_size_
+#      define READ_GRIBMAP read_gribmap_
+#   endif
+# endif
+#endif
+
+
+typedef struct {
+  int center;
+  int subcenter;
+  int parmtbl;
+  int parm_id[MAX_PARAMS];
+  int dec_sc_factor[MAX_PARAMS];
+  char **wrf_param[MAX_PARAMS];
+  int num_wrf_params[MAX_PARAMS];
+  int num_entries;
+} Grib1_Table_Info;
+
+typedef struct {
+  int num_tables;
+  Grib1_Table_Info *grib_table_info;
+} Grib1_Tables;
+
+
+int GET_GRIB_PARAM (Grib1_Tables *grib_tables, char *varname, int *center, 
+		    int *subcenter, int *parmtbl, int *tablenum, int *index,
+		    int strlen1, int strlen2);
+
+int GET_GRIB1_TABLES_SIZE (int *size);
+
+int LOAD_GRIB1_TABLES (char filename[], 
+			   Grib1_Tables *grib_tables, int *ret, int strlen1);
+
+Grib1_Tables *copy_grib_tables(Grib1_Tables *);
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/io_grib1.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/io_grib1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/io_grib1.F	(revision 2744)
@@ -0,0 +1,3351 @@
+!*-----------------------------------------------------------------------------
+!*
+!*  Todd Hutchinson
+!*  WSI
+!*  400 Minuteman Road
+!*  Andover, MA     01810
+!*  thutchinson@wsi.com
+!*
+!*-----------------------------------------------------------------------------
+
+!*
+!* This io_grib1 API is designed to read WRF input and write WRF output data
+!*   in grib version 1 format.  
+!*
+
+
+module gr1_data_info
+
+!*
+!* This module will hold data internal to this I/O implementation.  
+!*   The variables will be accessible by all functions (provided they have a 
+!*   "USE gr1_data_info" line).
+!*
+
+  integer                , parameter       :: FATAL            = 1
+  integer                , parameter       :: DEBUG            = 100
+  integer                , parameter       :: DateStrLen       = 19
+
+  integer                , parameter       :: firstFileHandle  = 8
+  integer                , parameter       :: maxFileHandles   = 200
+  integer                , parameter       :: maxLevels        = 1000
+  integer                , parameter       :: maxSoilLevels    = 100
+  integer                , parameter       :: maxDomains       = 500
+
+  logical ,      dimension(maxFileHandles) :: committed, opened, used
+  character*128, dimension(maxFileHandles) :: DataFile
+  integer,       dimension(maxFileHandles) :: FileFd
+  integer,       dimension(maxFileHandles) :: FileStatus
+  REAL,          dimension(maxLevels)      :: half_eta, full_eta
+  REAL,          dimension(maxSoilLevels)  :: soil_depth, soil_thickness
+  character*24                             :: StartDate = ''
+  character*24                             :: InputProgramName = ''
+  integer                                  :: projection
+  integer                                  :: wg_grid_id
+  real                                     :: dx,dy
+  real                                     :: truelat1, truelat2
+  real                                     :: center_lat, center_lon
+  real                                     :: proj_central_lon
+  real                                     :: timestep
+  character,     dimension(:), pointer     :: grib_tables
+  logical                                  :: table_filled = .FALSE.
+  character,     dimension(:), pointer     :: grid_info
+  integer                                  :: full_xsize, full_ysize
+  integer, dimension(maxDomains)           :: domains = -1
+  integer                                  :: max_domain = 0
+  
+  TYPE :: HandleVar
+     character, dimension(:), pointer      :: fileindex(:)
+     integer                               :: CurrentTime
+     integer                               :: NumberTimes
+     character (DateStrLen), dimension(:),pointer  :: Times(:)
+  ENDTYPE
+  TYPE (HandleVar), dimension(maxFileHandles) :: fileinfo
+
+  TYPE :: prevdata
+     integer :: fcst_secs_rainc
+     integer :: fcst_secs_rainnc
+     real, dimension(:,:), pointer         :: rainc, rainnc
+  END TYPE prevdata
+
+  TYPE :: initdata
+     real,         dimension(:,:), pointer :: snod
+  END TYPE initdata
+
+  TYPE (initdata), dimension(maxDomains)   :: firstdata
+
+  TYPE :: prestype
+     real,         dimension(:,:,:), pointer :: vals
+     logical                                :: newtime
+     character*120                          :: lastDateStr
+  END TYPE prestype
+
+  TYPE (prestype), dimension(maxDomains)   :: pressure
+
+  integer                                  :: center, subcenter, parmtbl
+
+  character(len=30000), dimension(maxFileHandles) :: td_output
+  character(len=30000), dimension(maxFileHandles) :: ti_output
+
+  logical                                  :: WrfIOnotInitialized = .true.
+
+end module gr1_data_info
+
+
+subroutine ext_gr1_ioinit(SysDepInfo,Status)
+
+  USE gr1_data_info
+  implicit none
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  CHARACTER*(*), INTENT(IN) :: SysDepInfo
+  integer ,intent(out) :: Status
+  integer :: i
+  integer :: size, istat
+  CHARACTER (LEN=300) :: wrf_err_message
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_ioinit')
+
+  do i=firstFileHandle, maxFileHandles
+        used(i) = .false.
+        committed(i) = .false.
+        opened(i) = .false.
+        td_output(i) = ''
+        ti_output(i) = ''
+  enddo
+  domains(:) = -1
+
+  do i = 1, maxDomains
+    pressure(i)%newtime = .false.
+    pressure(i)%lastDateStr = ''
+  enddo
+
+  FileStatus(1:maxFileHandles) = WRF_FILE_NOT_OPENED
+  WrfIOnotInitialized = .false.
+
+  Status = WRF_NO_ERR
+
+  return
+end subroutine ext_gr1_ioinit
+
+!*****************************************************************************
+
+subroutine ext_gr1_ioexit(Status)
+
+  USE gr1_data_info
+  implicit none
+#include "wrf_status_codes.h"
+  integer istat
+  integer ,intent(out) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_ioexit')
+
+  if (table_filled) then
+     CALL free_gribmap(grib_tables)
+     DEALLOCATE(grib_tables, stat=istat)
+     table_filled = .FALSE.
+  endif
+  IF ( ASSOCIATED ( grid_info ) ) THEN
+    DEALLOCATE(grid_info, stat=istat)
+  ENDIF
+  NULLIFY(grid_info)
+
+  Status = WRF_NO_ERR
+
+  return
+end subroutine ext_gr1_ioexit
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_open_for_read_begin ( FileName , Comm_compute, Comm_io, &
+     SysDepInfo, DataHandle , Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  integer                     :: ierr
+  integer                     :: size
+  integer                     :: idx
+  integer                     :: parmid
+  integer                     :: dpth_parmid
+  integer                     :: thk_parmid
+  integer                     :: leveltype
+  integer , DIMENSION(1000)   :: indices
+  integer                     :: numindices
+  real , DIMENSION(1000)      :: levels
+  real                        :: tmp
+  integer                     :: swapped
+  integer                     :: etaidx
+  integer                     :: grb_index
+  integer                     :: level1, level2
+  integer   :: tablenum
+  integer   :: stat
+  integer   :: endchar
+  integer   :: last_grb_index
+  CHARACTER (LEN=300) :: wrf_err_message
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_open_for_read_begin')
+
+  CALL gr1_get_new_handle(DataHandle)
+
+  if (DataHandle .GT. 0) then
+     CALL open_file(TRIM(FileName), 'r', FileFd(DataHandle), ierr)
+     if (ierr .ne. 0) then
+        Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+     else
+        opened(DataHandle) = .true.
+        DataFile(DataHandle) = TRIM(FileName)
+        FileStatus(DataHandle) = WRF_FILE_OPENED_NOT_COMMITTED
+     endif
+  else
+     Status = WRF_WARN_TOO_MANY_FILES
+     return
+  endif
+ 
+  ! Read the grib index file first
+  if (.NOT. table_filled) then
+     table_filled = .TRUE.
+     CALL GET_GRIB1_TABLES_SIZE(size)
+     ALLOCATE(grib_tables(1:size), STAT=ierr)
+     CALL LOAD_GRIB1_TABLES ("gribmap.txt", grib_tables, ierr)
+     if (ierr .ne. 0) then
+        DEALLOCATE(grib_tables)
+        WRITE( wrf_err_message , * ) &
+             'Could not open file gribmap.txt '
+        CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+        Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+        return
+     endif
+  endif
+
+  ! Begin by indexing file and reading metadata into structure.
+  CALL GET_FILEINDEX_SIZE(size)
+  ALLOCATE(fileinfo(DataHandle)%fileindex(1:size), STAT=ierr)
+
+  CALL ALLOC_INDEX_FILE(fileinfo(DataHandle)%fileindex(:))
+  CALL INDEX_FILE(FileFd(DataHandle),fileinfo(DataHandle)%fileindex(:))
+
+  ! Get times into Times variable
+  CALL GET_NUM_TIMES(fileinfo(DataHandle)%fileindex(:), &
+       fileinfo(DataHandle)%NumberTimes);
+
+  ALLOCATE(fileinfo(DataHandle)%Times(1:fileinfo(DataHandle)%NumberTimes), STAT=ierr)
+  do idx = 1,fileinfo(DataHandle)%NumberTimes
+     CALL GET_TIME(fileinfo(DataHandle)%fileindex(:),idx, &
+          fileinfo(DataHandle)%Times(idx))
+  enddo
+
+  ! CurrentTime starts as 0.  The first time in the file is 1.  So,
+  !   until set_time or get_next_time is called, the current time
+  !   is not set.
+  fileinfo(DataHandle)%CurrentTime = 0
+
+  CALL gr1_fill_eta_levels(fileinfo(DataHandle)%fileindex(:), &
+       FileFd(DataHandle), & 
+       grib_tables, "ZNW", full_eta)
+  CALL gr1_fill_eta_levels(fileinfo(DataHandle)%fileindex(:), FileFd(DataHandle), &
+       grib_tables, "ZNU", half_eta)
+
+  ! 
+  ! Now, get the soil levels
+  !
+  CALL GET_GRIB_PARAM(grib_tables, "ZS", center, subcenter, parmtbl, &
+       tablenum, dpth_parmid)
+  CALL GET_GRIB_PARAM(grib_tables,"DZS", center, subcenter, parmtbl, &
+       tablenum, thk_parmid)
+  if (dpth_parmid == -1) then
+     call wrf_message ('Error getting grib parameter')
+  endif
+
+  leveltype = 112
+
+  CALL GET_GRIB_INDICES(fileinfo(DataHandle)%fileindex(:),center, subcenter, parmtbl, &
+       dpth_parmid,"*",leveltype, &
+       -HUGE(1),-HUGE(1), -HUGE(1),-HUGE(1),indices,numindices)
+
+  last_grb_index = -1;
+  do idx = 1,numindices
+     CALL READ_GRIB(fileinfo(DataHandle)%fileindex(:), FileFd(DataHandle), &
+          indices(idx), soil_depth(idx))
+     !
+     ! Now read the soil thickenesses
+     !
+     CALL GET_LEVEL1(fileinfo(DataHandle)%fileindex(:),indices(idx),level1)
+     CALL GET_LEVEL2(fileinfo(DataHandle)%fileindex(:),indices(idx),level2)
+     CALL GET_GRIB_INDEX_GUESS(fileinfo(DataHandle)%fileindex(:), &
+          center, subcenter, parmtbl, thk_parmid,"*",leveltype, &
+          level1,level2,-HUGE(1),-HUGE(1), last_grb_index+1, grb_index)
+     CALL READ_GRIB(fileinfo(DataHandle)%fileindex(:),FileFd(DataHandle),grb_index, &
+          soil_thickness(idx))
+
+     last_grb_index = grb_index
+  enddo
+  
+
+
+  !
+  ! Fill up any variables that need to be retrieved from Metadata
+  !
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), 'PROGRAM_NAME', "none", &
+       "none", InputProgramName, stat)
+  if (stat /= 0) then
+     CALL wrf_debug (DEBUG , "PROGRAM_NAME not found in input METADATA")
+  else 
+     endchar = SCAN(InputProgramName," ")
+     InputProgramName = InputProgramName(1:endchar)
+  endif
+
+  call wrf_debug ( DEBUG , 'Exiting ext_gr1_open_for_read_begin')
+
+  RETURN
+END SUBROUTINE ext_gr1_open_for_read_begin
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_open_for_read_commit( DataHandle , Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  character(len=1000) :: msg
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_open_for_read_commit')
+
+  Status = WRF_NO_ERR
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED
+    write(msg,*) 'ext_gr1_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  committed(DataHandle) = .true.
+  FileStatus(DataHandle) = WRF_FILE_OPENED_FOR_READ
+
+  Status = WRF_NO_ERR
+
+  RETURN
+END SUBROUTINE ext_gr1_open_for_read_commit
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_open_for_read ( FileName , Comm_compute, Comm_io, &
+     SysDepInfo, DataHandle , Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_open_for_read')
+
+  DataHandle = 0   ! dummy setting to quiet warning message
+  CALL ext_gr1_open_for_read_begin( FileName, Comm_compute, Comm_io, &
+       SysDepInfo, DataHandle, Status )
+  IF ( Status .EQ. WRF_NO_ERR ) THEN
+     FileStatus(DataHandle) = WRF_FILE_OPENED_NOT_COMMITTED
+     CALL ext_gr1_open_for_read_commit( DataHandle, Status )
+  ENDIF
+  return
+
+  RETURN  
+END SUBROUTINE ext_gr1_open_for_read
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_open_for_write_begin(FileName, Comm, IOComm, SysDepInfo, &
+     DataHandle, Status)
+  
+  USE gr1_data_info
+  implicit none
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+
+  character*(*)        ,intent(in)  :: FileName
+  integer              ,intent(in)  :: Comm
+  integer              ,intent(in)  :: IOComm
+  character*(*)        ,intent(in)  :: SysDepInfo
+  integer              ,intent(out) :: DataHandle
+  integer              ,intent(out) :: Status
+  integer :: ierr
+  CHARACTER (LEN=300) :: wrf_err_message
+  integer             :: size
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_open_for_write_begin')
+
+  if (.NOT. table_filled) then
+     table_filled = .TRUE.
+     CALL GET_GRIB1_TABLES_SIZE(size)
+     ALLOCATE(grib_tables(1:size), STAT=ierr)
+     CALL LOAD_GRIB1_TABLES ("gribmap.txt", grib_tables, ierr)
+     if (ierr .ne. 0) then
+        DEALLOCATE(grib_tables)
+        WRITE( wrf_err_message , * ) &
+             'Could not open file gribmap.txt '
+        CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+        Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+        return
+     endif
+  endif
+
+  Status = WRF_NO_ERR
+  CALL gr1_get_new_handle(DataHandle)
+  if (DataHandle .GT. 0) then
+     CALL open_file(TRIM(FileName), 'w', FileFd(DataHandle), ierr)
+     if (ierr .ne. 0) then
+        Status = WRF_WARN_WRITE_RONLY_FILE
+     else
+        opened(DataHandle) = .true.
+        DataFile(DataHandle) = TRIM(FileName)
+        FileStatus(DataHandle) = WRF_FILE_OPENED_NOT_COMMITTED
+     endif
+     committed(DataHandle) = .false.
+     td_output(DataHandle) = ''
+  else
+     Status = WRF_WARN_TOO_MANY_FILES
+  endif
+
+  RETURN  
+END SUBROUTINE ext_gr1_open_for_write_begin
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_open_for_write_commit( DataHandle , Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_open_for_write_commit')
+
+  IF ( opened( DataHandle ) ) THEN
+    IF ( used( DataHandle ) ) THEN
+      committed(DataHandle) = .true.
+      FileStatus(DataHandle) = WRF_FILE_OPENED_FOR_WRITE
+    ENDIF
+  ENDIF
+
+  Status = WRF_NO_ERR
+
+  RETURN  
+END SUBROUTINE ext_gr1_open_for_write_commit
+
+!*****************************************************************************
+
+subroutine ext_gr1_inquiry (Inquiry, Result, Status)
+  use gr1_data_info
+  implicit none
+#include "wrf_status_codes.h"
+  character *(*), INTENT(IN)    :: Inquiry
+  character *(*), INTENT(OUT)   :: Result
+  integer        ,INTENT(INOUT) :: Status
+  SELECT CASE (Inquiry)
+  CASE ("RANDOM_WRITE","RANDOM_READ")
+     Result='ALLOW'
+  CASE ("SEQUENTIAL_WRITE","SEQUENTIAL_READ")
+     Result='NO'
+  CASE ("OPEN_READ", "OPEN_WRITE", "OPEN_COMMIT_WRITE")
+     Result='REQUIRE'
+  CASE ("OPEN_COMMIT_READ","PARALLEL_IO")
+     Result='NO'
+  CASE ("SELF_DESCRIBING","SUPPORT_METADATA","SUPPORT_3D_FIELDS")
+     Result='YES'
+  CASE ("MEDIUM")
+     Result ='FILE'
+  CASE DEFAULT
+     Result = 'No Result for that inquiry!'
+  END SELECT
+  Status=WRF_NO_ERR
+  return
+end subroutine ext_gr1_inquiry
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_inquire_opened ( DataHandle, FileName , FileStat, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStat
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_inquire_opened')
+
+  FileStat = WRF_NO_ERR
+  if ((DataHandle .ge. firstFileHandle) .and. &
+       (DataHandle .le. maxFileHandles)) then
+     FileStat = FileStatus(DataHandle)
+  else
+     FileStat = WRF_FILE_NOT_OPENED
+  endif
+  
+  Status = FileStat
+
+  RETURN
+END SUBROUTINE ext_gr1_inquire_opened
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_ioclose ( DataHandle, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER DataHandle, Status
+  INTEGER istat
+  INTEGER ierr
+  character(len=1000) :: outstring
+  character :: lf
+  lf=char(10)
+     
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_ioclose')
+
+  Status = WRF_NO_ERR
+
+  CALL write_file(FileFd(DataHandle), lf//'<METADATA>'//lf,ierr)
+  outstring = &
+       '<!-- The following are fields that were supplied to the WRF I/O API.'//lf//&
+       'Many variables (but not all) are redundant with the variables within '//lf//&
+       'the grib headers.  They are stored here, as METADATA, so that the '//lf//&
+       'WRF I/O API has simple access to these variables.-->'
+  CALL write_file(FileFd(DataHandle), trim(outstring), ierr)
+  if (trim(ti_output(DataHandle)) /= '') then
+     CALL write_file(FileFd(DataHandle), trim(ti_output(DataHandle)), ierr)
+     CALL write_file(FileFd(DataHandle), lf, ierr)
+  endif
+  if (trim(td_output(DataHandle)) /= '') then
+     CALL write_file(FileFd(DataHandle), trim(td_output(DataHandle)), ierr)
+     CALL write_file(FileFd(DataHandle), lf, ierr)
+  endif
+  CALL write_file(FileFd(DataHandle), '</METADATA>'//lf,ierr)
+  ti_output(DataHandle) = ''
+  td_output(DataHandle) = ''
+  if (ierr .ne. 0) then
+     Status = WRF_WARN_WRITE_RONLY_FILE
+  endif
+  CALL close_file(FileFd(DataHandle))
+
+  used(DataHandle) = .false.
+
+  RETURN
+END SUBROUTINE ext_gr1_ioclose
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_write_field( DataHandle , DateStr , VarName , &
+     Field , FieldType , Comm , IOComm, &
+     DomainDesc , MemoryOrder , Stagger , &
+     DimNames , &
+     DomainStart , DomainEnd , &
+     MemoryStart , MemoryEnd , &
+     PatchStart , PatchEnd , &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  CHARACTER*120 :: OutName
+  CHARACTER(120) :: TmpVarName
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  character*(*)                 ,intent(in)    :: Stagger
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+  integer                                      :: ierror
+  character (120)                         :: msg
+  integer :: xsize, ysize, zsize
+  integer :: x, y, z
+  integer :: x_start,x_end,y_start,y_end,z_start,z_end,ndim
+  integer :: idx
+  integer :: proj_center_flag
+  logical :: vert_stag = .false.
+  integer :: levelnum
+  real, DIMENSION(:,:), POINTER :: data,tmpdata
+  integer, DIMENSION(:), POINTER :: mold
+  integer :: istat
+  integer :: accum_period
+  integer :: size
+  integer, dimension(1000) :: level1, level2
+  real, DIMENSION( 1:1,MemoryStart(1):MemoryEnd(1), &
+                   MemoryStart(2):MemoryEnd(2), &
+                   MemoryStart(3):MemoryEnd(3) ) :: Field
+  real    :: fcst_secs
+  logical :: soil_layers, fraction
+  integer :: vert_unit
+  integer :: abc(2,2,2)
+  integer :: def(8)
+  logical :: output = .true.
+  integer :: idx1, idx2, idx3
+  integer :: this_domain
+  logical :: new_domain
+  real    :: region_center_lat, region_center_lon
+  integer :: dom_xsize, dom_ysize;
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_write_field for parameter'//VarName)
+
+  !
+  ! If DateStr is all 0's, we reset it to StartDate.  For some reason, 
+  !   in idealized simulations, StartDate is 0001-01-01_00:00:00 while
+  !   the first DateStr is 0000-00-00_00:00:00.  
+  !
+  if (DateStr .eq. '0000-00-00_00:00:00') then
+     DateStr = TRIM(StartDate)
+  endif
+
+  !
+  ! Check if this is a domain that we haven't seen yet.  If so, add it to 
+  !   the list of domains.
+  !
+  this_domain = 0
+  new_domain = .false.
+  do idx = 1, max_domain
+     if (DomainDesc .eq. domains(idx)) then
+        this_domain = idx
+     endif
+  enddo
+  if (this_domain .eq. 0) then
+     max_domain = max_domain + 1
+     domains(max_domain) = DomainDesc
+     this_domain = max_domain
+     new_domain = .true.
+  endif
+
+  output = .true.
+  zsize = 1
+  xsize = 1
+  ysize = 1
+  OutName = VarName
+  soil_layers = .false.
+  fraction = .false.
+
+  ! First, handle then special cases for the boundary data.
+
+  CALL get_dims(MemoryOrder, PatchStart, PatchEnd, ndim, x_start, x_end, &
+       y_start, y_end,z_start,z_end)
+  xsize = x_end - x_start + 1
+  ysize = y_end - y_start + 1
+  zsize = z_end - z_start + 1
+
+  do idx = 1, len(MemoryOrder)
+     if ((MemoryOrder(idx:idx) .eq. 'Z') .and. &
+          (DimNames(idx) .eq. 'soil_layers_stag')) then
+        soil_layers = .true.
+     else if ((OutName .eq. 'LANDUSEF') .or. (OutName .eq. 'SOILCBOT') .or. &
+          (OutName .eq. 'SOILCTOP')) then
+        fraction = .true.
+     endif
+  enddo
+
+  if (.not. ASSOCIATED(grid_info)) then
+     CALL get_grid_info_size(size)
+     ALLOCATE(grid_info(1:size), STAT=istat)
+     if (istat .eq. -1) then
+        DEALLOCATE(grid_info)
+        Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+        return
+     endif
+  endif
+     
+
+  if (new_domain) then
+     ALLOCATE(firstdata(this_domain)%snod(xsize,ysize))
+     firstdata(this_domain)%snod(:,:) = 0.0
+  endif
+
+  if (zsize .eq. 0) then 
+     zsize = 1
+  endif
+
+  ALLOCATE(data(1:xsize,1:ysize), STAT=istat)
+  ALLOCATE(mold(1:ysize), STAT=istat)
+  ALLOCATE(tmpdata(1:xsize,1:ysize), STAT=istat)
+
+  if (OutName .eq. 'ZNU') then
+     do idx = 1, zsize
+        half_eta(idx) = Field(1,idx,1,1)
+     enddo
+  endif
+
+  if (OutName .eq. 'ZNW') then
+     do idx = 1, zsize
+        full_eta(idx) = Field(1,idx,1,1)
+     enddo
+  endif
+
+  if (OutName .eq. 'ZS') then
+     do idx = 1, zsize
+        soil_depth(idx) = Field(1,idx,1,1)
+     enddo
+  endif
+
+  if (OutName .eq. 'DZS') then
+     do idx = 1, zsize
+        soil_thickness(idx) = Field(1,idx,1,1)
+     enddo
+  endif
+
+
+  if ((xsize .lt. 1) .or. (ysize .lt. 1)) then
+     write(msg,*) 'Cannot output field with memory order: ', &
+          MemoryOrder,Varname
+     call wrf_message(msg)
+     return
+  endif
+     
+  call get_vert_stag(OutName,Stagger,vert_stag)
+
+  do idx = 1, zsize
+     call gr1_get_levels(OutName, idx, zsize, soil_layers, vert_stag, fraction, &
+          vert_unit, level1(idx), level2(idx))
+  enddo
+
+  ! 
+  ! Get the center lat/lon for the area being output.  For some cases (such
+  !    as for boundary areas, the center of the area is different from the
+  !    center of the model grid.
+  !
+  if (index(Stagger,'X') .le. 0) then
+     dom_xsize = full_xsize - 1
+  else
+     dom_xsize = full_xsize
+  endif
+  if (index(Stagger,'Y') .le. 0) then
+     dom_ysize = full_ysize - 1
+  else
+     dom_ysize = full_ysize
+  endif
+
+  CALL get_region_center(MemoryOrder, projection, center_lat, center_lon, &
+       dom_xsize, dom_ysize, dx, dy, proj_central_lon, proj_center_flag, &
+       truelat1, truelat2, xsize, ysize, region_center_lat, region_center_lon)
+
+  if ( .not. opened(DataHandle)) then
+     Status = WRF_WARN_FILE_NOT_OPENED
+     return
+  endif
+
+
+  if (opened(DataHandle) .and. committed(DataHandle)) then
+
+
+     !
+     ! The following code to compute full pressure was removed by 
+     !  Todd Hutchinson since there are times when base-state and 
+     !  perturbation are required (i.e., for a restart)
+     !
+
+     ! 
+     ! The following is a kludge to output full pressure instead of the two 
+     !  fields of base-state pressure and pressure perturbation.
+     !
+     
+!     if ((OutName .eq. 'P') .or. (OutName.eq.'PB')) then
+!        do idx = 1, len(MemoryOrder)
+!           if (MemoryOrder(idx:idx) .eq. 'X') then
+!              idx1=idx
+!           endif
+!           if (MemoryOrder(idx:idx) .eq. 'Y') then
+!              idx2=idx
+!           endif
+!           if (MemoryOrder(idx:idx) .eq. 'Z') then
+!              idx3=idx
+!           endif
+!        enddo
+
+        ! 
+        ! Allocate space for pressure values (this variable holds 
+        !   base-state pressure or pressure perturbation to be used 
+        !   later to sum base-state and perturbation pressure to get full 
+        !   pressure).
+        !
+
+!        if (.not. ASSOCIATED(pressure(this_domain)%vals)) then
+!           ALLOCATE(pressure(this_domain)%vals(MemoryStart(1):MemoryEnd(1), &
+!                MemoryStart(2):MemoryEnd(2),MemoryStart(3):MemoryEnd(3)))
+!        endif
+!        if (DateStr .NE. &
+!             pressure(this_domain)%lastDateStr) then
+!           pressure(this_domain)%newtime = .true.
+!        endif
+!        if (pressure(this_domain)%newtime) then
+!           pressure(this_domain)%vals = Field(1,:,:,:)
+!           pressure(this_domain)%newtime = .false.
+!           output = .false.
+!        else 
+!           output = .true.
+!        endif
+!        pressure(this_domain)%lastDateStr=DateStr
+!     endif
+
+     if (output) then 
+        if (StartDate == '') then
+           StartDate = DateStr
+        endif
+        CALL geth_idts(DateStr,StartDate,fcst_secs)
+        
+        if (center_lat .lt. 0) then
+           proj_center_flag = 2
+        else
+           proj_center_flag = 1
+        endif
+         
+        do z = 1, zsize
+           SELECT CASE (MemoryOrder)
+           CASE ('XYZ')
+              data = Field(1,1:xsize,1:ysize,z)
+           CASE ('XZY')
+              data = Field(1,1:xsize,z,1:ysize)
+           CASE ('YXZ')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,y,x,z)
+                 enddo
+              enddo
+           CASE ('YZX')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,y,z,x)
+                 enddo
+              enddo
+           CASE ('ZXY')
+              data = Field(1,z,1:xsize,1:ysize)
+           CASE ('ZYX')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,z,y,x)
+                 enddo
+              enddo
+           CASE ('XY')
+              data = Field(1,1:xsize,1:ysize,1)
+           CASE ('YX')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,y,x,1)
+                 enddo
+              enddo
+
+           CASE ('XSZ')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,y,z,x)
+                 enddo
+              enddo
+           CASE ('XEZ')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,y,z,x)
+                 enddo
+              enddo
+           CASE ('YSZ')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,x,z,y)
+                 enddo
+              enddo
+           CASE ('YEZ')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,x,z,y)
+                 enddo
+              enddo
+
+           CASE ('XS')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,y,x,1)
+                 enddo
+              enddo
+           CASE ('XE')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,y,x,1)
+                 enddo
+              enddo
+           CASE ('YS')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,x,y,1)
+                 enddo
+              enddo
+           CASE ('YE')
+              do x = 1,xsize
+                 do y = 1,ysize
+                    data(x,y) = Field(1,x,y,1)
+                 enddo
+              enddo
+
+           CASE ('Z')
+              data(1,1) = Field(1,z,1,1)
+           CASE ('z')
+              data(1,1) = Field(1,z,1,1)
+           CASE ('C')
+              data = Field(1,1:xsize,1:ysize,z)
+           CASE ('c')
+              data = Field(1,1:xsize,1:ysize,z)
+           CASE ('0')
+              data(1,1) = Field(1,1,1,1)
+           END SELECT
+
+           ! 
+           ! Here, we convert any integer fields to real
+           !
+           if (FieldType == WRF_INTEGER) then
+              mold = 0
+              do idx=1,xsize
+                 !
+                 ! The parentheses around data(idx,:) are needed in order
+                 !   to fix a bug with transfer with the xlf compiler on NCAR's
+                 !   IBM (bluesky).
+                 !
+                 data(idx,:)=transfer((data(idx,:)),mold)
+              enddo
+           endif
+           ! 
+           ! Here, we do any necessary conversions to the data.
+           !
+           
+           ! Potential temperature is sometimes passed in as perturbation 
+           !   potential temperature (i.e., POT-300).  Other times (i.e., from 
+           !   WRF SI), it is passed in as full potential temperature.
+           ! Here, we convert to full potential temperature by adding 300
+           !   only if POT < 200 K.
+           !
+           if (OutName == 'T') then
+              if (data(1,1) < 200) then
+                 data = data + 300
+              endif
+           endif
+
+           ! 
+           ! For precip, we setup the accumulation period, and output a precip
+           !    rate for time-step precip.
+           !
+           if ((OutName .eq. 'RAINCV') .or. (OutName .eq. 'RAINNCV')) then
+              ! Convert time-step precip to precip rate.
+              data = data/timestep
+              accum_period = 0
+           else
+              accum_period = 0
+           endif
+
+           !
+           ! Computation of full-pressure removed since there are 
+           !  uses for base-state and perturbation (i.e., restarts
+           !
+!           if ((OutName .eq. 'P') .or. (OutName.eq.'PB')) then
+!              if (idx3 .eq. 1) then
+!                 data = data + &
+!                      pressure(this_domain)%vals(z, &
+!                      patchstart(2):patchend(2),patchstart(3):patchend(3))
+!              elseif (idx3 .eq. 2) then
+!                 data = data + &
+!                      pressure(this_domain)%vals(patchstart(1):patchend(1), &
+!                      z,patchstart(3):patchend(3))
+!              elseif (idx3 .eq. 3) then
+!                 data = data + &
+!                      pressure(this_domain)%vals(patchstart(1):patchend(1), &
+!                      patchstart(2):patchend(2),z)
+!              else
+!                 call wrf_message ('error in idx3, continuing')
+!              endif
+!
+!              OutName = 'P'
+!           endif
+
+           !
+           !    Output current level
+           !
+           CALL load_grid_info(OutName, StartDate, vert_unit, level1(z), &
+                level2(z), fcst_secs, accum_period, wg_grid_id, projection, &
+                xsize, ysize, region_center_lat, region_center_lon, dx, dy, &
+                proj_central_lon, proj_center_flag, truelat1, truelat2, &
+                grib_tables, grid_info)
+           
+           CALL write_grib(grid_info, FileFd(DataHandle), data)
+
+           CALL free_grid_info(grid_info)
+           
+        enddo
+     endif
+  endif
+
+  deallocate(data, STAT = istat)
+  deallocate(mold, STAT = istat)
+  deallocate(tmpdata, STAT = istat)
+
+  Status = WRF_NO_ERR
+
+  call wrf_debug ( DEBUG , 'Leaving ext_gr1_write_field')
+
+  RETURN
+END SUBROUTINE ext_gr1_write_field
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_read_field ( DataHandle , DateStr , VarName , Field , &
+     FieldType , Comm , IOComm, DomainDesc , MemoryOrder , Stagger ,     &
+     DimNames , DomainStart , DomainEnd , MemoryStart , MemoryEnd ,      &
+     PatchStart , PatchEnd ,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE  
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  CHARACTER (len=400) :: msg
+  integer                       ,intent(inout)    :: FieldType
+  integer                       ,intent(inout)    :: Comm
+  integer                       ,intent(inout)    :: IOComm
+  integer                       ,intent(inout)    :: DomainDesc
+  character*(*)                 ,intent(inout)    :: MemoryOrder
+  character*(*)                 ,intent(inout)    :: Stagger
+  character*(*) , dimension (*) ,intent(inout)    :: DimNames
+  integer ,dimension(*)         ,intent(inout)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(inout)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(inout)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)      :: Status
+  INTEGER                       ,intent(out)      :: Field(*)
+  integer   :: ndim,x_start,x_end,y_start,y_end,z_start,z_end
+  integer   :: zidx
+  REAL, DIMENSION(:,:), POINTER :: data
+  logical                     :: vert_stag
+  logical                     :: soil_layers
+  integer                     :: level1,level2
+
+  integer                     :: parmid
+  integer                     :: vert_unit
+  integer                     :: grb_index
+  integer                     :: numcols, numrows
+  integer                     :: data_allocated
+  integer                     :: istat
+  integer                     :: tablenum
+  integer                     :: di
+  integer                     :: last_grb_index
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_read_field')
+
+  !
+  ! Get dimensions of data.  
+  ! Assume that the domain size in the input data is the same as the Domain 
+  !     Size from the input arguments.
+  !
+  
+  CALL get_dims(MemoryOrder,DomainStart,DomainEnd,ndim,x_start,x_end,y_start, &
+       y_end,z_start,z_end) 
+
+  !
+  ! Get grib parameter id
+  !
+  CALL GET_GRIB_PARAM(grib_tables, VarName, center, subcenter, parmtbl, &
+       tablenum, parmid)
+
+  !
+  ! Setup the vertical unit and levels
+  !
+  CALL get_vert_stag(VarName,Stagger,vert_stag)
+  CALL get_soil_layers(VarName,soil_layers)
+
+  !
+  ! Loop over levels, grabbing data from each level, then assembling into a 
+  !   3D array.
+  !
+  data_allocated = 0
+  last_grb_index = -1
+  do zidx = z_start,z_end
+     
+     CALL gr1_get_levels(VarName,zidx,z_end-z_start,soil_layers,vert_stag, &
+          .false., vert_unit,level1,level2)
+     
+     CALL GET_GRIB_INDEX_VALIDTIME_GUESS(fileinfo(DataHandle)%fileindex(:), center, &
+          subcenter, parmtbl, parmid,DateStr,vert_unit,level1, &
+          level2, last_grb_index + 1, grb_index)
+     if (grb_index < 0) then
+        write(msg,*)'Field not found: parmid: ',VarName,parmid,DateStr, &
+             vert_unit,level1,level2
+        call wrf_debug (DEBUG , msg)
+        cycle
+     endif
+
+     if (data_allocated .eq. 0) then
+        CALL GET_SIZEOF_GRID(fileinfo(DataHandle)%fileindex(:),grb_index,numcols,numrows)
+        allocate(data(z_start:z_end,1:numcols*numrows),stat=istat)
+        data_allocated = 1
+     endif
+
+     CALL READ_GRIB(fileinfo(DataHandle)%fileindex(:), FileFd(DataHandle), grb_index, &
+          data(zidx,:))
+
+     !
+     ! Transpose data into the order specified by MemoryOrder, setting only 
+     !   entries within the memory dimensions
+     !
+     CALL get_dims(MemoryOrder, MemoryStart, MemoryEnd, ndim, x_start, x_end, &
+          y_start, y_end,z_start,z_end)
+
+     if(FieldType == WRF_DOUBLE) then
+        di = 2
+     else 
+        di = 1
+     endif
+
+     ! 
+     ! Here, we do any necessary conversions to the data.
+     !
+     ! The WRF executable (wrf.exe) expects perturbation potential
+     !   temperature.  However, real.exe expects full potential T.
+     ! So, if the program is WRF, subtract 300 from Potential Temperature 
+     !   to get perturbation potential temperature.
+     !
+     if (VarName == 'T') then
+        if ( &
+             (InputProgramName .eq. 'REAL_EM') .or. &
+             (InputProgramName .eq. 'IDEAL') .or. &
+             (InputProgramName .eq. 'NDOWN_EM')) then
+           data(zidx,:) = data(zidx,:) - 300
+        endif
+     endif
+
+     CALL Transpose(MemoryOrder, di, FieldType, Field, &
+          MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), &
+          MemoryStart(3), MemoryEnd(3), &
+          data(zidx,:), zidx, numrows, numcols)
+
+     if (zidx .eq. z_end) then
+        data_allocated = 0
+        deallocate(data)
+     endif
+
+     last_grb_index = grb_index
+
+  enddo
+
+  Status = WRF_NO_ERR
+  if (grb_index < 0) Status = WRF_WARN_VAR_NF
+  call wrf_debug ( DEBUG , 'Leaving ext_gr1_read_field')
+
+  RETURN
+END SUBROUTINE ext_gr1_read_field
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_next_var ( DataHandle, VarName, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: VarName
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_next_var')
+
+  Status = WRF_WARN_NOOP
+
+  RETURN
+END SUBROUTINE ext_gr1_get_next_var
+
+!*****************************************************************************
+
+subroutine ext_gr1_end_of_frame(DataHandle, Status)
+
+  USE gr1_data_info
+  implicit none
+#include "wrf_status_codes.h"
+  integer               ,intent(in)     :: DataHandle
+  integer               ,intent(out)    :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_end_of_frame')
+
+  Status = WRF_WARN_NOOP
+
+  return
+end subroutine ext_gr1_end_of_frame
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_iosync ( DataHandle, Status )
+
+  USE gr1_data_info  
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_iosync')
+
+  Status = WRF_NO_ERR
+  if (DataHandle .GT. 0) then
+     CALL flush_file(FileFd(DataHandle))
+  else
+     Status = WRF_WARN_TOO_MANY_FILES
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_iosync
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_inquire_filename ( DataHandle, FileName , FileStat, &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStat
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER *80   SysDepInfo
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_inquire_filename')
+
+  FileName = DataFile(DataHandle) 
+
+  if ((DataHandle .ge. firstFileHandle) .and. &
+       (DataHandle .le. maxFileHandles)) then
+     FileStat = FileStatus(DataHandle)
+  else
+     FileStat = WRF_FILE_NOT_OPENED
+  endif
+  
+  Status = WRF_NO_ERR
+
+  RETURN
+END SUBROUTINE ext_gr1_inquire_filename
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_info ( DataHandle , VarName , NDim , &
+     MemoryOrder , Stagger , DomainStart , DomainEnd , WrfType, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: VarName
+  integer               ,intent(out)    :: NDim
+  character*(*)         ,intent(out)    :: MemoryOrder
+  character*(*)         ,intent(out)    :: Stagger
+  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
+  integer               ,intent(out)    :: WrfType
+  integer               ,intent(out)    :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_info')
+
+  CALL wrf_message('ext_gr1_get_var_info not supported for grib version1 data')
+  Status = WRF_NO_ERR
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_info
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_set_time ( DataHandle, DateStr, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  integer       :: found_time
+  integer       :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_set_time')
+
+  found_time = 0
+  do idx = 1,fileinfo(DataHandle)%NumberTimes
+     if (fileinfo(DataHandle)%Times(idx) == DateStr) then
+        found_time = 1
+        fileinfo(DataHandle)%CurrentTime = idx
+     endif
+  enddo
+  if (found_time == 0) then 
+     Status = WRF_WARN_TIME_NF
+  else
+     Status = WRF_NO_ERR
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_set_time
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_next_time ( DataHandle, DateStr, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(OUT) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_next_time')
+
+  if (fileinfo(DataHandle)%CurrentTime == fileinfo(DataHandle)%NumberTimes) then
+     Status = WRF_WARN_TIME_EOF
+  else
+     fileinfo(DataHandle)%CurrentTime = fileinfo(DataHandle)%CurrentTime + 1
+     DateStr = fileinfo(DataHandle)%Times(fileinfo(DataHandle)%CurrentTime)
+     Status = WRF_NO_ERR
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_get_next_time
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_previous_time ( DataHandle, DateStr, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_previous_time')
+
+  if (fileinfo(DataHandle)%CurrentTime <= 0) then
+     Status = WRF_WARN_TIME_EOF
+  else
+     fileinfo(DataHandle)%CurrentTime = fileinfo(DataHandle)%CurrentTime - 1
+     DateStr = fileinfo(DataHandle)%Times(fileinfo(DataHandle)%CurrentTime)
+     Status = WRF_NO_ERR
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_get_previous_time
+
+!******************************************************************************
+!* Start of get_var_ti_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr1_get_var_ti_real ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)    :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,          INTENT(OUT)   :: Data(*)
+  INTEGER ,       INTENT(IN)    :: Count
+  INTEGER ,       INTENT(OUT)   :: OutCount
+  INTEGER ,       INTENT(OUT)   :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_ti_real')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), "none", &
+       Varname, Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+  RETURN
+END SUBROUTINE ext_gr1_get_var_ti_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_ti_real8 ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)      :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,        INTENT(OUT)     :: Data(*)
+  INTEGER ,       INTENT(IN)      :: Count
+  INTEGER ,       INTENT(OUT)     :: OutCount
+  INTEGER ,       INTENT(OUT)     :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_ti_real8')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:),TRIM(Element),&
+       "none",Varname,Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+  RETURN
+END SUBROUTINE ext_gr1_get_var_ti_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_ti_double ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_ti_double')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), &
+       "none", Varname, &
+       Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_ti_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_ti_integer ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)       :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,       INTENT(OUT)      :: Data(*)
+  INTEGER ,       INTENT(IN)       :: Count
+  INTEGER ,       INTENT(OUT)      :: OutCount
+  INTEGER ,       INTENT(OUT)      :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_ti_integer')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), &
+       "none", Varname, Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_ti_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_ti_logical ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)       :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,       INTENT(OUT)      :: Data(*)
+  INTEGER ,       INTENT(IN)       :: Count
+  INTEGER ,       INTENT(OUT)      :: OutCount
+  INTEGER ,       INTENT(OUT)      :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_ti_logical')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), &
+       "none", Varname, Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_ti_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_ti_char ( DataHandle,Element,  Varname, Data,  &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER       :: stat
+
+  Status = WRF_NO_ERR
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_ti_char')
+
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), &
+       "none", Varname, Data,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_ti_char 
+
+!******************************************************************************
+!* End of get_var_ti_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of put_var_ti_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr1_put_var_ti_real ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,          INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_ti_real')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_var_ti_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_ti_double ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_ti_double')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_var_ti_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_ti_real8 ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,        INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_ti_real8')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_var_ti_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_ti_integer ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_ti_integer')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_var_ti_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_ti_logical ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_ti_logical')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+
+  endif
+
+RETURN
+END SUBROUTINE ext_gr1_put_var_ti_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_ti_char ( DataHandle,Element,  Varname, Data,  &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER(len=*) :: Element
+  CHARACTER(len=*) :: VarName 
+  CHARACTER(len=*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  INTEGER                     :: Count
+  CHARACTER(len=1000) :: tmpstr(1)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_ti_char')
+
+  if (committed(DataHandle)) then
+
+     write(tmpstr(1),*)trim(Data)
+
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, 1, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_var_ti_char 
+
+!******************************************************************************
+!* End of put_var_ti_* routines
+!******************************************************************************
+
+!******************************************************************************
+!* Start of get_var_td_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr1_get_var_td_double ( DataHandle,Element,  DateStr, &
+     Varname, Data, Count, Outcount, Status )
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_td_double')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:),TRIM(Element),DateStr,&
+       Varname,Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+RETURN
+END SUBROUTINE ext_gr1_get_var_td_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_td_real ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,          INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_td_real')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       Varname, Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_td_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_td_real8 ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,        INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_td_real8')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:),TRIM(Element),DateStr,&
+       Varname,Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_td_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_td_integer')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       Varname, Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_td_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count, Outcount, Status )
+  
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_td_logical')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       Varname, Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_td_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_var_td_char ( DataHandle,Element,  DateStr,Varname, &
+     Data,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER       :: stat
+
+  Status = WRF_NO_ERR
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_var_td_char')
+
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       Varname, Data,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_get_var_td_char 
+
+!******************************************************************************
+!* End of get_var_td_* routines
+!******************************************************************************
+
+!******************************************************************************
+!* Start of put_var_td_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr1_put_var_td_double ( DataHandle, Element, DateStr, Varname, &
+     Data, Count,  Status )
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_td_double')
+
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr1_build_string (td_output(DataHandle), &
+          Varname//';'//DateStr//';'//Element, tmpstr, Count, Status)
+
+  endif
+
+RETURN
+END SUBROUTINE ext_gr1_put_var_td_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_td_integer ( DataHandle,Element,  DateStr, &
+     Varname, Data, Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_td_integer')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (td_output(DataHandle), &
+          Varname//';'//DateStr//';'//Element, tmpstr, Count, Status)
+
+  endif
+
+RETURN
+END SUBROUTINE ext_gr1_put_var_td_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_td_real ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,          INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_td_real')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (td_output(DataHandle), &
+          Varname//';'//DateStr//';'//Element, tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_var_td_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_td_real8 ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,        INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_td_real8')
+
+  if (committed(DataHandle)) then
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (td_output(DataHandle), &
+          Varname//';'//DateStr//';'//Element, tmpstr, Count, Status)
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_var_td_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_td_logical ( DataHandle,Element,  DateStr, &
+     Varname, Data, Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_td_logical')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr1_build_string (td_output(DataHandle), &
+          Varname//';'//DateStr//';'//Element, tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_var_td_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_var_td_char ( DataHandle,Element,  DateStr,Varname, &
+     Data,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_var_td_char')
+
+  if (committed(DataHandle)) then
+
+     write(tmpstr(idx),*)Data
+
+     CALL gr1_build_string (td_output(DataHandle), &
+          Varname//';'//DateStr//';'//Element, tmpstr, 1, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_var_td_char 
+
+!******************************************************************************
+!* End of put_var_td_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of get_dom_ti_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_ti_real ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real ,          INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Outcount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_ti_real')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), "none", &
+       "none", Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_ti_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_ti_real8 ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,        INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_ti_real8')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), "none", &
+       "none", Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_ti_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_ti_integer ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  integer ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_ti_integer Element: '//Element)
+
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), "none", &
+       "none", Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = Count
+ 
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_ti_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_ti_logical ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_ti_logical')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), "none", &
+       "none", Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_ti_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER       :: stat
+  INTEGER       :: endchar
+
+  Status = WRF_NO_ERR
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_ti_char')
+
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), "none", &
+       "none", Data, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_ti_char 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_ti_double ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_ti_double')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), "none", &
+       "none", Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+RETURN
+END SUBROUTINE ext_gr1_get_dom_ti_double
+
+!******************************************************************************
+!* End of get_dom_ti_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of put_dom_ti_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_ti_real ( DataHandle,Element,   Data, Count,  &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real ,          INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  CHARACTER(len=1000) :: tmpstr(1000)
+  character(len=2)    :: lf
+  integer             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_ti_real')
+
+  if (Element .eq. 'DX') then
+     dx = Data(1)/1000.
+  endif
+  if (Element .eq. 'DY') then
+     dy = Data(1)/1000.
+  endif
+  if (Element .eq. 'CEN_LAT') then
+     center_lat = Data(1)
+  endif
+  if (Element .eq. 'CEN_LON') then
+     center_lon = Data(1)
+  endif  
+  if (Element .eq. 'TRUELAT1') then
+     truelat1 = Data(1)
+  endif
+  if (Element .eq. 'TRUELAT2') then
+     truelat2 = Data(1)
+  endif
+  if (Element == 'STAND_LON') then
+     proj_central_lon = Data(1)
+  endif
+  if (Element == 'DT') then
+     timestep = Data(1)
+  endif
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_ti_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_ti_real8 ( DataHandle,Element,   Data, Count,  &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,        INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_ti_real8')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_ti_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  INTEGER ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_ti_integer')
+
+  if (Element == 'WEST-EAST_GRID_DIMENSION') then
+     full_xsize = Data(1)
+  else if (Element == 'SOUTH-NORTH_GRID_DIMENSION') then
+     full_ysize = Data(1)
+  else if (Element == 'MAP_PROJ') then
+     projection = Data(1)
+  endif
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+
+  endif
+
+  call wrf_debug ( DEBUG , 'Leaving ext_gr1_put_dom_ti_integer')
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_ti_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_ti_logical')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_ti_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_ti_char ( DataHandle,Element,   Data,  &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*),     INTENT(IN)  :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  CHARACTER(len=1000) :: tmpstr(1000)
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_ti_char')
+
+  if (Element .eq. 'START_DATE') then
+     StartDate = Data
+  endif
+
+  if (committed(DataHandle)) then
+
+     write(tmpstr(1),*)trim(Data)
+     
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, 1, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_ti_char
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_ti_double ( DataHandle,Element, Data, Count, &
+     Status )
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_ti_double')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr1_build_string (ti_output(DataHandle), Element, tmpstr, Count, Status)
+
+  endif
+  
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_ti_double
+
+!******************************************************************************
+!* End of put_dom_ti_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of get_dom_td_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_td_real ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,          INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_td_real')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       "none", Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_td_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_td_real8 ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,        INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_td_real8')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       "none", Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_td_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_td_integer')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       "none", Value,stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_td_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_td_logical')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       "none", Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_td_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER       :: stat
+
+  Status = WRF_NO_ERR
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_td_char')
+
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       "none", Data, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_get_dom_td_char 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_get_dom_td_double ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_get_dom_td_double')
+
+  Status = WRF_NO_ERR
+  
+  CALL GET_METADATA_VALUE(fileinfo(DataHandle)%fileindex(:), TRIM(Element), DateStr, &
+       "none", Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "GET_METADATA_VALUE failed for "//Element)
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+RETURN
+END SUBROUTINE ext_gr1_get_dom_td_double
+
+!******************************************************************************
+!* End of get_dom_td_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of put_dom_td_* routines
+!******************************************************************************
+
+
+SUBROUTINE ext_gr1_put_dom_td_real8 ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,        INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_td_real8')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr1_build_string (td_output(DataHandle), DateStr//';'//Element, tmpstr, &
+          Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_td_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_td_integer')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (td_output(DataHandle), DateStr//';'//Element, tmpstr, &
+          Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_td_integer
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_td_logical')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (td_output(DataHandle), DateStr//';'//Element, tmpstr, &
+          Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_td_logical
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_td_char ( DataHandle,Element, DateStr,  Data, &
+     Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER(len=*), INTENT(IN)  :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1)
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_td_char')
+
+  if (committed(DataHandle)) then
+
+     write(tmpstr(1),*)Data
+
+     CALL gr1_build_string (td_output(DataHandle), DateStr//';'//Element, tmpstr, &
+          1, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_td_char 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_td_double ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_td_double')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr1_build_string (td_output(DataHandle), DateStr//';'//Element, tmpstr, &
+          Count, Status)
+
+  endif
+
+RETURN
+END SUBROUTINE ext_gr1_put_dom_td_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr1_put_dom_td_real ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+
+  USE gr1_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,          INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr1_put_dom_td_real')
+
+  if (committed(DataHandle)) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr1_build_string (td_output(DataHandle), DateStr//';'//Element, tmpstr, &
+          Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr1_put_dom_td_real 
+
+
+!******************************************************************************
+!* End of put_dom_td_* routines
+!******************************************************************************
+
+
+!*****************************************************************************
+
+SUBROUTINE gr1_build_string (string, Element, Value, Count, Status)
+
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+
+  CHARACTER (LEN=*) , INTENT(INOUT) :: string
+  CHARACTER (LEN=*) , INTENT(IN)    :: Element
+  CHARACTER (LEN=*) , INTENT(IN)    :: Value(*)
+  INTEGER ,           INTENT(IN)    :: Count
+  INTEGER ,           INTENT(OUT)   :: Status
+
+  CHARACTER (LEN=2)                 :: lf
+  INTEGER                           :: IDX
+
+  lf=char(10)//' '
+  if (len_trim(string) == 0) then
+     string = lf//Element//' = '
+  else
+     string = trim(string)//lf//Element//' = '
+  endif
+  do idx = 1,Count
+     if (idx > 1) then
+        string = trim(string)//','
+     endif
+     string = trim(string)//' '//trim(adjustl(Value(idx)))
+  enddo
+
+  Status = WRF_NO_ERR
+
+END SUBROUTINE gr1_build_string
+
+!*****************************************************************************
+
+SUBROUTINE gr1_get_new_handle(DataHandle)
+  USE gr1_data_info
+  IMPLICIT NONE
+  
+  INTEGER ,       INTENT(OUT)  :: DataHandle
+  INTEGER :: i
+
+  DataHandle = -1
+  do i=firstFileHandle, maxFileHandles
+     if (.NOT. used(i)) then
+        DataHandle = i
+        used(i) = .true.
+        exit
+     endif
+  enddo
+
+  RETURN
+END SUBROUTINE gr1_get_new_handle
+
+
+!******************************************************************************
+
+
+SUBROUTINE gr1_get_levels(VarName, zidx, zsize, soil_layers, vert_stag, fraction, &
+     vert_unit, level1, level2)
+
+  use gr1_data_info
+  IMPLICIT NONE
+
+  integer :: zidx
+  integer :: zsize
+  logical :: soil_layers
+  logical :: vert_stag
+  logical :: fraction
+  integer :: vert_unit
+  integer :: level1
+  integer :: level2
+  character (LEN=*) :: VarName
+
+  ! Setup vert_unit, and vertical levels in grib units
+
+  if ((VarName .eq. 'LANDUSEF') .or. (VarName .eq. 'SOILCTOP') &
+       .or. (VarName .eq. 'SOILCBOT')) then
+     vert_unit = 109;
+     level1 = zidx
+     level2 = 0
+  else if ((zsize .gt. 1) .and. (.not. soil_layers) .and. (.not. fraction)) &
+       then
+     vert_unit = 119;
+     if (vert_stag) then
+        level1 = (10000*full_eta(zidx)+0.5)
+     else
+        level1 = (10000*half_eta(zidx)+0.5)
+     endif
+     level2 = 0
+  else
+     ! Set the vertical coordinate and level for soil and 2D fields
+     if (fraction) then
+        vert_unit = 109
+        level1 = zidx
+        level2 = 0           
+     else if (soil_layers) then
+        vert_unit = 112
+        level1 = 100*(soil_depth(zidx) - 0.5*soil_thickness(zidx))+0.5
+        level2 = 100*(soil_depth(zidx) + 0.5*soil_thickness(zidx))+0.5
+     else if (VarName .eq. 'mu') then
+        vert_unit = 200
+        level1 = 0
+        level2 = 0
+     else if ((VarName .eq. 'Q2') .or. (VarName .eq. 'TH2') .or. &
+        (VarName .eq. 'T2')) then
+        vert_unit = 105
+        level1 = 2
+        level2 = 0
+     else if ((VarName .eq. 'Q10') .or. (VarName .eq. 'TH10') .or. &
+          (VarName .eq. 'U10') .or. (VarName .eq. 'V10')) then
+        vert_unit = 105
+        level1 = 10
+        level2 = 0
+     else 
+        vert_unit = 1
+        level1 = 0
+        level2 = 0
+     endif
+  endif
+
+end SUBROUTINE gr1_get_levels
+
+!*****************************************************************************
+
+
+SUBROUTINE gr1_fill_eta_levels(fileindex, FileFd, grib_tables, VarName, eta_levels)
+  IMPLICIT NONE
+
+  CHARACTER (len=*) :: fileindex
+  INTEGER   :: FileFd
+  CHARACTER (len=*) :: grib_tables
+  character (len=*) :: VarName
+  REAL,DIMENSION(*) :: eta_levels
+
+  INTEGER   :: center, subcenter, parmtbl
+  INTEGER   :: swapped
+  INTEGER   :: leveltype
+  INTEGER   :: idx
+  INTEGER   :: parmid
+  INTEGER   :: tablenum
+  REAL      :: tmp
+  INTEGER   :: numindices
+  integer , DIMENSION(1000)   :: indices
+
+  !
+  ! Read the levels from the grib file
+  !
+  CALL GET_GRIB_PARAM(grib_tables, VarName, center, subcenter, parmtbl, &
+       tablenum, parmid)
+
+  if (parmid == -1) then
+     call wrf_message ('Error getting grib parameter')
+  endif
+
+  leveltype = 119
+
+  CALL GET_GRIB_INDICES(fileindex(:), center, subcenter, parmtbl, &
+       parmid, "*", leveltype, &
+       -HUGE(1), -HUGE(1), -HUGE(1), -HUGE(1), indices, numindices)
+
+  do idx = 1,numindices
+     CALL READ_GRIB(fileindex(:),FileFd,indices(idx),eta_levels(idx))
+  enddo
+
+  !
+  ! Sort the levels--from highest (bottom) to lowest (top)
+  !
+  swapped = 1
+  sortloop : do
+     if (swapped /= 1) exit sortloop
+     swapped = 0
+     do idx=2, numindices
+        if (eta_levels(idx) > eta_levels(idx-1)) then
+          tmp = eta_levels(idx)
+          eta_levels(idx) = eta_levels(idx - 1)
+          eta_levels(idx - 1) = tmp
+          swapped = 1
+        endif
+     enddo
+  enddo sortloop
+
+end subroutine gr1_fill_eta_levels
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/test_grib1_routines.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/test_grib1_routines.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/test_grib1_routines.F	(revision 2744)
@@ -0,0 +1,89 @@
+
+PROGRAM test_grib1_routines
+  IMPLICIT NONE
+
+  CHARACTER, DIMENSION(:), POINTER :: fileindex
+  REAL     , DIMENSION(:), POINTER :: data
+  INTEGER :: fid
+  INTEGER :: err
+  INTEGER :: ret
+  INTEGER :: size
+  INTEGER :: index
+  INTEGER :: istat
+
+  INTEGER :: parmid
+  CHARACTER(40) :: datestr
+  INTEGER :: leveltype 
+  INTEGER :: level1
+  INTEGER :: level2
+  INTEGER :: fcsttime1
+  INTEGER :: fcsttime2
+  character(200) :: value
+  character(20) :: strval
+  integer :: test
+  character(50) :: form
+  integer :: NumberTimes
+  character (19) :: Time
+  character (19), pointer  :: Times(:)
+  integer :: ierr
+  integer :: numcols, numrows
+  integer :: center, subcenter, parmtbl
+  
+
+  parmid=33
+  datestr = '2005041412'
+  leveltype = 119
+  level1 = 9965
+  level2 = -HUGE(1)
+  fcsttime1 = 0
+  fcsttime2 = -HUGE(1)
+  center = 250
+  subcenter = 2
+  parmtbl = 200
+
+  print *,'about to call GET_FILEINDEX_SIZE'
+  CALL GET_FILEINDEX_SIZE(size)
+  ALLOCATE(fileindex(1:size), STAT=istat)
+
+  print *,'about to call ALLOC_INDEX_FILE'
+  CALL ALLOC_INDEX_FILE(fileindex)
+  print *,'about to call OPEN_FILE'
+  CALL OPEN_FILE('test.grb','r',fid,err)
+  print *,'about to call INDEX_FILE'
+  CALL INDEX_FILE(fid,fileindex)
+
+  print *,'about to call GET_GRIB_INDEX'
+  CALL GET_GRIB_INDEX(fileindex, center, subcenter, parmtbl, &
+       parmid,trim(datestr),leveltype,level1,level2, &
+       fcsttime1,fcsttime2,index)
+  print *,'got grib index: ',index
+
+  print *,'about to call GET_METADATA_VALUE'
+  CALL GET_METADATA_VALUE(fileindex, 'GRIB_GRID_ID', "none", "none", &
+       Value, istat)
+
+  print *,'about to call GET_NUM_TIMES'
+  CALL GET_NUM_TIMES(fileindex, NumberTimes)
+  print *,'found ',NumberTimes,' times'
+
+  ALLOCATE(Times(1:NumberTimes), STAT=ierr)
+  print *,'about to call GET_TIME'
+  CALL GET_TIME(fileindex,1,Time)
+  print *,'Time: ',Time
+
+  print *,'about to call GET_SIZEOF_GRID'
+  CALL GET_SIZEOF_GRID(fileindex,index,numcols,numrows)
+  allocate(data(1:numcols*numrows))
+
+  print *,'about to call READ_GRIB'
+  CALL READ_GRIB(fileindex,fid,index,data)
+  print *,'data(20): ',data(20)
+
+  deallocate(data)
+
+  print *,'about to call FREE_INDEX_FILE'
+  CALL FREE_INDEX_FILE(fileindex)
+
+  print *,'program completed'
+
+END PROGRAM
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/test_gribmap.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/test_gribmap.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/test_gribmap.F90	(revision 2744)
@@ -0,0 +1,21 @@
+PROGRAM test
+  IMPLICIT NONE
+
+  CHARACTER, DIMENSION(:), POINTER :: grib_table_info
+  INTEGER :: ret
+  INTEGER :: size
+  INTEGER :: index
+  INTEGER :: istat
+
+  CALL GET_GRIB1_TABLE_INFO_SIZE(size)
+  ALLOCATE(grib_table_info(1:size), STAT=istat)
+  CALL LOAD_GRIB1_TABLE_INFO("gribmap.txt",grib_table_info,ret)
+  print *,'ret: ',ret
+  print *,'again'
+  CALL GET_GRIB_PARAM (grib_table_info, "TSK", index);
+  print *,'got index: ',index
+
+
+print *,'here1'
+
+END PROGRAM
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/test_grid_info.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/test_grid_info.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/test_grid_info.F90	(revision 2744)
@@ -0,0 +1,40 @@
+
+
+PROGRAM test
+  IMPLICIT NONE
+
+  CHARACTER, DIMENSION(:), POINTER :: grib_table_info
+  CHARACTER, DIMENSION(:), POINTER :: grid_info
+  INTEGER :: ret
+  INTEGER :: size
+  INTEGER :: index
+  INTEGER :: istat
+  
+
+  CALL GET_GRIB1_TABLE_INFO_SIZE(size)
+  ALLOCATE(grib_table_info(1:size), STAT=istat)
+  CALL LOAD_GRIB1_TABLE_INFO("gribmap.txt",grib_table_info,ret)
+  print *,'ret: ',ret
+  print *,'again'
+  CALL GET_GRIB_PARAM (grib_table_info, "TSK", index);
+  print *,'got index: ',index
+
+  CALL GET_GRID_INFO_SIZE(size)
+  ALLOCATE(grid_info(1:size), STAT=istat)
+  CALL LOAD_GRID_INFO("test", "200509081200", 1, &
+       1.0, 1.0, 1440.0, &
+       0, 240, 1, &
+       450, 250, 45.0, &
+       -100.0, 12.0, 12.0, -101.0, &
+       1, 30.0, &
+       60.0, grib_table_info, &
+       grid_info)
+
+  print *,'here!'
+  CALL PRINT_GRID_INFO(grid_info)
+  CALL FREE_GRID_INFO(grid_info)
+
+print *,'here1'
+
+END PROGRAM
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/test_io_grib1.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/test_io_grib1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/test_io_grib1.F	(revision 2744)
@@ -0,0 +1,61 @@
+PROGRAM test_io_grib2
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+
+  integer            :: Status
+  character(len=80)  :: SysDepInfo
+  character(len=80)  :: FileName = 'test.gr2'
+  integer            :: Comm
+  integer            :: IOComm
+  integer            :: DataHandle
+  integer            :: FileStat
+  real, DIMENSION( 1:1, 1:4, 1:4, 1:4) :: Field
+  integer            :: DomainDesc
+  character(len=3)   :: MemoryOrder = 'XZY'
+  character(len=3)   :: Stagger = ''
+  character(len=100) :: DimNames = ''
+  integer, dimension(3) :: DomainStart, DomainEnd, MemoryStart, &
+       MemoryEnd, PatchStart, PatchEnd
+
+  DomainStart(1) = 1
+  DomainStart(2) = 1
+  DomainStart(3) = 1
+  DomainEnd(1) = 4
+  DomainEnd(2) = 4
+  DomainEnd(3) = 4
+
+  MemoryStart(1) = 1
+  MemoryStart(2) = 1
+  MemoryStart(3) = 1
+  MemoryEnd(1) = 4
+  MemoryEnd(2) = 4
+  MemoryEnd(3) = 4
+
+  PatchStart(1) = 1
+  PatchStart(2) = 1
+  PatchStart(3) = 1
+  PatchEnd(1) = 4
+  PatchEnd(2) = 4
+  PatchEnd(3) = 4
+
+  call ext_gr1_ioinit(SysDepInfo,Status)
+
+  call ext_gr1_ioexit(Status)
+
+  call ext_gr1_open_for_write_begin(FileName, Comm, IOComm, SysDepInfo, &
+     DataHandle, Status)
+
+  call ext_gr1_open_for_write_commit( DataHandle , Status )
+
+  call ext_gr1_inquire_opened ( DataHandle, FileName , FileStat, Status )
+
+  Field(1,1,1,1) = 2.1
+  call ext_gr1_write_field ( DataHandle, "2005-07-27_12:00:00","POT",Field, &
+       WRF_REAL, Comm, IOComm, DomainDesc, MemoryOrder, Stagger, &
+       DimNames, DomainStart, DomainEnd, MemoryStart, MemoryEnd, &
+       PatchStart, PatchEnd, Status)
+
+
+  call ext_gr1_ioclose ( DataHandle, Status )
+
+END PROGRAM
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/test_read_gribmap.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/test_read_gribmap.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/test_read_gribmap.c	(revision 2744)
@@ -0,0 +1,23 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "gribmap.h"
+main()
+{
+  int center, subcenter, parmtbl, parm_id, dec_sc_factor;
+  int ret;
+  int idx;
+  Grib_Table_Info grib_table_info;
+
+  /*  get_grib_param_("gribmap.txt","TMN",&center,&subcenter,&parmtbl,&parm_id,&dec_sc_factor);
+   */
+  read_gribmap_("gribmap.txt",&grib_table_info,&ret);
+
+  fprintf(stdout,"%d:%d:%d:%d\n",grib_table_info.center,
+	  grib_table_info.subcenter,grib_table_info.parmtbl,
+	  grib_table_info.gribid);
+
+  get_grib_param_(&grib_table_info,"TMN",&idx);
+  fprintf(stdout,"idx: %d\n",idx);
+
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/test_write_grib.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/test_write_grib.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/test_write_grib.c	(revision 2744)
@@ -0,0 +1,87 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "grib1_routines.h"
+
+#define LATLON 0
+#define LAMBERT 1
+#define POLAR_STEREO 2
+#define MERCATOR 3
+
+main()
+{
+  int level;
+  int projection;
+  int xdim;
+  int ydim;
+  int grid_id;
+  float center_lat, center_lon;
+  float proj_central_lon;
+  float dx, dy;
+  int south;
+  float latin1, latin2;
+  float *data;
+  int filefd;
+  int error;
+  char datestr[200];
+  int i,j;
+  float fcst_secs;
+  int accum_period;
+  int leveltype;
+  int level2;  
+  Grib1_Tables grib1_tables;
+  int ret;
+  int status;
+  Grid_Info gridinfo;
+
+  level = 9950;
+  projection = LAMBERT;
+  xdim = 422;
+  ydim = 271;
+  center_lat = 0.0;
+  center_lon = 0.0;
+  proj_central_lon = -100.0;
+  dx = 12.0;
+  dy = 12.0;
+  south = 0;
+  latin1 = 30.0;
+  latin2 = 60.0;
+  data = (float *)calloc(xdim*ydim,sizeof(float));
+  fcst_secs = 360;
+  accum_period = 0;
+  leveltype = 119;
+  level2 = 0;
+  grid_id = 255;
+
+  read_gribmap_("gribmap.txt",&grib1_tables,&ret);
+
+  open_file_("test2.grb","w",&filefd,&error,9,1);
+  strcpy(datestr,"2005-01-01_00:00:00");
+  for (i=0; i< 1; i++) {
+    for (j=0; j<xdim*ydim; j++) {
+      /*
+      data[j] = rand()/RAND_MAX;
+      */
+      data[j] = j/(float)ydim;
+    }
+    fprintf(stderr,"Writing grib record %d\n",i);
+    status = LOAD_GRID_INFO("TSK", datestr, &leveltype, &level, 
+		   &level2, &fcst_secs, &accum_period, &grid_id, &projection, 
+		   &xdim, &ydim, &center_lat, &center_lon, &dx, &dy, 
+		   &proj_central_lon, &south, &latin1, &latin2,
+		   &grib1_tables, &gridinfo, strlen("TSK"), strlen(datestr));
+      
+    WRITE_GRIB(&gridinfo, &filefd, data);
+    /*
+    status = WRITE_GRIB("ABC",&level,&level2,&leveltype,
+		datestr,&fcst_secs,&accum_period,
+		&projection,&grid_id,&xdim,&ydim,&center_lat,
+		&center_lon,&proj_central_lon,&dx,&dy,&south,&latin1,
+		&latin2,data,&grib_table_info,&filefd,8);
+    */
+    fprintf(stderr,"status: %d\n",status);
+
+  }
+
+  FREE_GRIBMAP(&grib1_tables);
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/trim.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/trim.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/trim.c	(revision 2744)
@@ -0,0 +1,23 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+char *trim (char *str)
+{
+      char *ibuf, *obuf;
+
+      if (str)
+      {
+            for (ibuf = obuf = str; *ibuf; )
+            {
+                  while (*ibuf && (isspace (*ibuf)))
+                        ibuf++;
+                  if (*ibuf && (obuf != str))
+                        *(obuf++) = ' ';
+                  while (*ibuf && (!isspace (*ibuf)))
+                        *(obuf++) = *(ibuf++);
+            }
+            *obuf = '\0';
+      }
+      return (str);
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib1/wrf_status_codes.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib1/wrf_status_codes.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib1/wrf_status_codes.h	(revision 2744)
@@ -0,0 +1,133 @@
+  
+!WRF Error and Warning messages (1-999)
+!All i/o package-specific status codes you may want to add must be handled by your package (see below)
+! WRF handles these and netCDF messages only
+  integer, parameter  :: WRF_NO_ERR                  =  0       !no error
+  integer, parameter  :: WRF_WARN_FILE_NF            = -1       !file not found, or incomplete
+  integer, parameter  :: WRF_WARN_MD_NF              = -2       !metadata not found
+  integer, parameter  :: WRF_WARN_TIME_NF            = -3       !timestamp not found
+  integer, parameter  :: WRF_WARN_TIME_EOF           = -4       !no more timestamps
+  integer, parameter  :: WRF_WARN_VAR_NF             = -5       !variable not found
+  integer, parameter  :: WRF_WARN_VAR_EOF            = -6       !no more variables for the current time
+  integer, parameter  :: WRF_WARN_TOO_MANY_FILES     = -7       !too many open files
+  integer, parameter  :: WRF_WARN_TYPE_MISMATCH      = -8       !data type mismatch
+  integer, parameter  :: WRF_WARN_WRITE_RONLY_FILE   = -9       !attempt to write readonly file
+  integer, parameter  :: WRF_WARN_READ_WONLY_FILE    = -10      !attempt to read writeonly file
+  integer, parameter  :: WRF_WARN_FILE_NOT_OPENED    = -11      !attempt to access unopened file
+  integer, parameter  :: WRF_WARN_2DRYRUNS_1VARIABLE = -12      !attempt to do 2 trainings for 1 variable
+  integer, parameter  :: WRF_WARN_READ_PAST_EOF      = -13      !attempt to read past EOF
+  integer, parameter  :: WRF_WARN_BAD_DATA_HANDLE    = -14      !bad data handle
+  integer, parameter  :: WRF_WARN_WRTLEN_NE_DRRUNLEN = -15      !write length not equal to training length
+  integer, parameter  :: WRF_WARN_TOO_MANY_DIMS      = -16      !more dimensions requested than training
+  integer, parameter  :: WRF_WARN_COUNT_TOO_LONG     = -17      !attempt to read more data than exists
+  integer, parameter  :: WRF_WARN_DIMENSION_ERROR    = -18      !input dimension inconsistent
+  integer, parameter  :: WRF_WARN_BAD_MEMORYORDER    = -19      !input MemoryOrder not recognized
+  integer, parameter  :: WRF_WARN_DIMNAME_REDEFINED  = -20      !a dimension name with 2 different lengths
+  integer, parameter  :: WRF_WARN_CHARSTR_GT_LENDATA = -21      !string longer than provided storage
+  integer, parameter  :: WRF_WARN_NOTSUPPORTED       = -22      !function not supportable
+  integer, parameter  :: WRF_WARN_NOOP               = -23      !package implements this routine as NOOP
+
+!Fatal errors 
+  integer, parameter  :: WRF_ERR_FATAL_ALLOCATION_ERROR  = -100 !allocation error
+  integer, parameter  :: WRF_ERR_FATAL_DEALLOCATION_ERR  = -101 !dealloc error
+  integer, parameter  :: WRF_ERR_FATAL_BAD_FILE_STATUS   = -102 !bad file status
+
+
+!Package specific errors (1000+)        
+!Netcdf status codes
+!WRF will accept status codes of 1000+, but it is up to the package to handle
+! and return the status to the user.
+
+  integer, parameter  :: WRF_ERR_FATAL_BAD_VARIABLE_DIM  = -1004
+  integer, parameter  :: WRF_ERR_FATAL_MDVAR_DIM_NOT_1D  = -1005
+  integer, parameter  :: WRF_ERR_FATAL_TOO_MANY_TIMES    = -1006
+  integer, parameter  :: WRF_WARN_BAD_DATA_TYPE      = -1007    !this code not in either spec?
+  integer, parameter  :: WRF_WARN_FILE_NOT_COMMITTED = -1008    !this code not in either spec?
+  integer, parameter  :: WRF_WARN_FILE_OPEN_FOR_READ = -1009
+  integer, parameter  :: WRF_IO_NOT_INITIALIZED      = -1010
+  integer, parameter  :: WRF_WARN_MD_AFTER_OPEN      = -1011
+  integer, parameter  :: WRF_WARN_TOO_MANY_VARIABLES = -1012
+  integer, parameter  :: WRF_WARN_DRYRUN_CLOSE       = -1013
+  integer, parameter  :: WRF_WARN_DATESTR_BAD_LENGTH = -1014
+  integer, parameter  :: WRF_WARN_ZERO_LENGTH_READ   = -1015
+  integer, parameter  :: WRF_WARN_DATA_TYPE_NOT_FOUND = -1016
+  integer, parameter  :: WRF_WARN_DATESTR_ERROR      = -1017
+  integer, parameter  :: WRF_WARN_DRYRUN_READ        = -1018
+  integer, parameter  :: WRF_WARN_ZERO_LENGTH_GET    = -1019
+  integer, parameter  :: WRF_WARN_ZERO_LENGTH_PUT    = -1020
+  integer, parameter  :: WRF_WARN_NETCDF             = -1021    
+  integer, parameter  :: WRF_WARN_LENGTH_LESS_THAN_1 = -1022    
+  integer, parameter  :: WRF_WARN_MORE_DATA_IN_FILE  = -1023    
+  integer, parameter  :: WRF_WARN_DATE_LT_LAST_DATE  = -1024
+
+! For HDF5 only
+  integer, parameter  :: WRF_HDF5_ERR_FILE                 = -200
+  integer, parameter  :: WRF_HDF5_ERR_MD                   = -201
+  integer, parameter  :: WRF_HDF5_ERR_TIME                 = -202
+  integer, parameter  :: WRF_HDF5_ERR_TIME_EOF             = -203
+  integer, parameter  :: WRF_HDF5_ERR_MORE_DATA_IN_FILE    = -204
+  integer, parameter  :: WRF_HDF5_ERR_DATE_LT_LAST_DATE    = -205
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_FILES       = -206
+  integer, parameter  :: WRF_HDF5_ERR_TYPE_MISMATCH        = -207
+  integer, parameter  :: WRF_HDF5_ERR_LENGTH_LESS_THAN_1   = -208
+  integer, parameter  :: WRF_HDF5_ERR_WRITE_RONLY_FILE     = -209
+  integer, parameter  :: WRF_HDF5_ERR_READ_WONLY_FILE      = -210
+  integer, parameter  :: WRF_HDF5_ERR_FILE_NOT_OPENED      = -211
+  integer, parameter  :: WRF_HDF5_ERR_DATESTR_ERROR        = -212
+  integer, parameter  :: WRF_HDF5_ERR_DRYRUN_READ          = -213
+  integer, parameter  :: WRF_HDF5_ERR_ZERO_LENGTH_GET      = -214
+  integer, parameter  :: WRF_HDF5_ERR_ZERO_LENGTH_PUT      = -215
+  integer, parameter  :: WRF_HDF5_ERR_2DRYRUNS_1VARIABLE   = -216
+  integer, parameter  :: WRF_HDF5_ERR_DATA_TYPE_NOTFOUND   = -217
+  integer, parameter  :: WRF_HDF5_ERR_READ_PAST_EOF        = -218
+  integer, parameter  :: WRF_HDF5_ERR_BAD_DATA_HANDLE      = -219
+  integer, parameter  :: WRF_HDF5_ERR_WRTLEN_NE_DRRUNLEN   = -220
+  integer, parameter  :: WRF_HDF5_ERR_DRYRUN_CLOSE         = -221
+  integer, parameter  :: WRF_HDF5_ERR_DATESTR_BAD_LENGTH   = -222
+  integer, parameter  :: WRF_HDF5_ERR_ZERO_LENGTH_READ     = -223
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_DIMS        = -224
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_VARIABLES   = -225
+  integer, parameter  :: WRF_HDF5_ERR_COUNT_TOO_LONG       = -226
+  integer, parameter  :: WRF_HDF5_ERR_DIMENSION_ERROR      = -227
+  integer, parameter  :: WRF_HDF5_ERR_BAD_MEMORYORDER      = -228
+  integer, parameter  :: WRF_HDF5_ERR_DIMNAME_REDEFINED    = -229
+  integer, parameter  :: WRF_HDF5_ERR_MD_AFTER_OPEN        = -230
+  integer, parameter  :: WRF_HDF5_ERR_CHARSTR_GT_LENDATA   = -231
+  integer, parameter  :: WRF_HDF5_ERR_BAD_DATA_TYPE        = -232
+  integer, parameter  :: WRF_HDF5_ERR_FILE_NOT_COMMITTED   = -233
+
+  integer, parameter  :: WRF_HDF5_ERR_ALLOCATION        = -2001
+  integer, parameter  :: WRF_HDF5_ERR_DEALLOCATION      = -2002
+  integer, parameter  :: WRF_HDF5_ERR_BAD_FILE_STATUS   = -2003
+  integer, parameter  :: WRF_HDF5_ERR_BAD_VARIABLE_DIM  = -2004
+  integer, parameter  :: WRF_HDF5_ERR_MDVAR_DIM_NOT_1D  = -2005
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_TIMES    = -2006
+  integer, parameter ::  WRF_HDF5_ERR_DATA_ID_NOTFOUND  = -2007
+
+  integer, parameter ::  WRF_HDF5_ERR_DATASPACE         = -300
+  integer, parameter ::  WRF_HDF5_ERR_DATATYPE          = -301
+  integer, parameter :: WRF_HDF5_ERR_PROPERTY_LIST      = -302
+
+  integer, parameter :: WRF_HDF5_ERR_DATASET_CREATE     = -303
+  integer, parameter :: WRF_HDF5_ERR_DATASET_READ       = -304
+  integer, parameter :: WRF_HDF5_ERR_DATASET_WRITE      = -305
+  integer, parameter :: WRF_HDF5_ERR_DATASET_OPEN       = -306
+  integer, parameter :: WRF_HDF5_ERR_DATASET_GENERAL    = -307
+  integer, parameter :: WRF_HDF5_ERR_GROUP              = -308
+
+  integer, parameter :: WRF_HDF5_ERR_FILE_OPEN          = -309
+  integer, parameter :: WRF_HDF5_ERR_FILE_CREATE        = -310
+  integer, parameter :: WRF_HDF5_ERR_DATASET_CLOSE      = -311
+  integer, parameter :: WRF_HDF5_ERR_FILE_CLOSE         = -312
+  integer, parameter :: WRF_HDF5_ERR_CLOSE_GENERAL      = -313
+
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CREATE   = -314
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_READ     = -315
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_WRITE    = -316
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OPEN     = -317
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_GENERAL  = -318
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CLOSE    = -319
+
+  integer, parameter :: WRF_HDF5_ERR_OTHERS             = -320
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS   = -321
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/Makefile	(revision 2744)
@@ -0,0 +1,84 @@
+#------------------------------------------------------------------------------
+#  Makefile for producing libdbclient.so 
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+
+.SUFFIXES:      .c .o
+
+#
+# Specity location for Makefiles that are included.
+#
+INCLUDEDIRS = -I.
+BUILD_DIR = $(IO_GRIB_SHARE_DIR)../io_grib_share/build
+#
+# Specify directory that output library is to be put in.
+#
+LIB_DEST = .
+#
+#  SPECIFY local include directories used during compilation of source code. 
+#
+#    CXX_INCLUDES is for C++ files
+#    C_INCLUDES is for C files
+#
+C_INCLUDES   = -I.
+CXX_INCLUDES = -I.
+F_INCLUDES   = -I. -Ig2lib -Ibacio-1.3 -I../io_grib_share
+ARFLAGS      = cruv
+
+FORMAT = $(FREE)
+
+#
+#  List of subdirectories to which to pass make commands.
+#
+LIB_DIRS = \
+	bacio-1.3 \
+	g2lib
+EXE_DIRS =
+SUB_DIRS = $(LIB_DIRS) $(EXE_DIRS)
+
+#
+#  SPECIFY information for building a library:
+#
+#    LIB_NAME - Fragment of name of the library to build
+#               e.g. if library file name is libfoo.so, set LIB_NAME = foo 
+#    DEP_LIBS - The tokens required to link a shared library against other
+#               shared libraries upon which it depends.  DEP_LIBS should
+#               contain -L<dir> tokens to specify where the dependent 
+#               libraries are, and -l<lib> tokens to specify libraries to link.
+#    OBJS     - List of object files that go into the library.
+#
+#  NOTES:
+#  1. Be careful about whitespace after the last character in the LIB_NAME.
+#     These spaces will generate an error when the library is made.
+#
+LIB_NAME = io_grib2
+SYS_DEFINES =
+DEP_LIBS = 
+OBJS =  \
+	grib2tbls_types.o \
+	io_grib2.o \
+	read_grib2map.o
+
+#
+#  Clean up old build files
+#
+superclean:
+	/bin/rm -f *.o > /dev/null 2>&1
+	/bin/rm -f *.f90 > /dev/null 2>&1
+	/bin/rm -f *.mod > /dev/null 2>&1
+	/bin/rm -f *.a > /dev/null 2>&1
+	( cd bacio-1.3 ; make clean )
+	( cd g2lib ; make clean )
+
+
+#
+#  Include the boilerplate rules for building library modules.
+#
+include $(BUILD_DIR)/library_rules.mk
+
+#
+#  Compile dependencies.  These are appended to this file by make depend. 
+#
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/README.io_grib2
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/README.io_grib2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/README.io_grib2	(revision 2744)
@@ -0,0 +1,95 @@
+io_grib2
+
+Author: Todd Hutchinson
+        WSI
+        thutchinson@wsi.com
+
+28 September 2005
+
+I. Introduction
+
+io_grib2 is a WRF module that allows for input and output of WRF data in GRIB
+version 2 format.
+
+Why would anyone use GRIB2 output?  
+  Data stored in GRIB2 format is compressed using advanced compression 
+    (i.e., JPEG2000), so output files are much smaller than in other formats 
+    such as netCDF and grib version 1.  Better compression is achieved with 
+    larger grids.
+
+II. Prerequisites
+
+  In order to compile and link WRF using the grib2 format, one system library
+  is required:
+    libjasper.a:  http://www.ece.uvic.ca/~mdadams/jasper/
+
+  The library should be installed in a system accessible place (i.e., 
+       /usr/lib).  The paths to the jasper library and include files must be 
+       specified via environment variables prior to running ./configure .  
+       Please use the following environment variables:  
+         JASPERLIB  Path to jasper library files (libjasperlib.a)
+         JASPERINC  Path to jasper include files
+       Note that if these environment variables are not defined before 
+       ./configure is run, the Grib2 I/O package will not be built.  
+
+III. Running WRF with grib2 input/output
+  1. Set namelist entry or entries io_form_<x> to 10
+  2. Run WRF as you normally would, for example:
+     cd test/em_real
+     ./real.exe
+     ./wrf.exe
+
+IV. Quilting
+  If you are running WRF using MPI, you may use a seperate processor for
+    quilting just as is done with netCDF.  Simply set the namelist variable
+    nio_tasks_per_group to 1 (or more).
+
+V. Details
+  1. grib2map.tbl file
+     io_grib2 makes use of a table for encoding the WRF data into GRIB2 
+        format.  The table that io_grib2 uses is contained in the 
+        WRF run directory, and is called grib2map.tbl.  This file is read at
+        run-time by io_grib2.  Settings in this file are used to encode the 
+	corresponding parameters in the output files.  You may modify 
+	this file to suit your needs.
+
+      The format of the table is described within the file itself.
+
+VI. Comparison between file formats.  
+  1. The following table shows the file sizes and run times for netcdf, grib1, 
+     and grib2 format for a 6 hour simlation of the WRF jun11 test case.  The 
+     domain size in this case is 91x82 by 28 levels.  Data was output every 
+     3 hours (for a total of 3 output times).  The simulations were run on 
+     NCAR's bluesky system.
+
+                    |  Size (MB)  | WRF Time(m:s)
+            ------------------------------------
+            NETCDF  |   38.40     |     19:31   |
+            GRIB1   |   13.42     |     21:22   |
+            GRIB2   |    4.33     |     22:36   |
+            ------------------------------------
+
+VII. New namelist variables for Grib2 I/O:  
+  The following new namelist variables may be optionally used to control 
+  Grib2 I/O.  They are defined in new namelist "&grib2".  Note that the 
+  &grib2 namelist must be included in file "namelist.input" even if empty.  
+  (This annoyance is ultimately due to problems with old OSF1 Fortran90 
+  compilers.)  
+
+  background_proc_id - Background generating process identifier, typically
+  defined by the originating center to identify the background data that
+  was used in creating the data.  This is octet 13 of Section 4 in the
+  grib2 message. Default is 255.
+
+  forecast_proc_id - Analysis or generating forecast process identifier,
+  typically defined by the originating center to identify the forecast
+  process that was used to generate the data.  This is octet 14 of Section
+  4 in the grib2 message.  Default is 255.
+
+  production_status - Production status of processed data in the grib2
+  message.  See Code Table 1.3 of the grib2 manual. This is octet 20 of
+  Section 1 in the grib2 record.  Default is 255.
+
+  compression - The compression method to encode the output grib2 message.
+  Only 40 for jpeg2000 or 41 for PNG are supported.  The default is 40.
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/Makefile	(revision 2744)
@@ -0,0 +1,67 @@
+#------------------------------------------------------------------------------
+#  Makefile for producing libdbclient.so 
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+
+.SUFFIXES:      .c .o
+
+#
+# Specity location for Makefiles that are included.
+#
+INCLUDEDIRS = -I. 
+BUILD_DIR = ../../io_grib_share/build
+#
+# Specify directory that output library is to be put in.
+#
+LIB_DEST = ..
+#
+#  SPECIFY local include directories used during compilation of source code. 
+#
+#    CXX_INCLUDES is for C++ files
+#    C_INCLUDES is for C files
+#
+C_INCLUDES   = -I.
+CXX_INCLUDES = -I.
+FORMAT       = $(FREE)
+
+#
+#  SPECIFY any subdirectories containing libraries that may be dynamically
+#          linked by this library.
+#
+SUB_DIRS =
+
+#
+#  SPECIFY information for building a library:
+#
+#    LIB_NAME - Fragment of name of the library to build
+#               e.g. if library file name is libfoo.so, set LIB_NAME = foo 
+#    DEP_LIBS - The tokens required to link a shared library against other
+#               shared libraries upon which it depends.  DEP_LIBS should
+#               contain -L<dir> tokens to specify where the dependent 
+#               libraries are, and -l<lib> tokens to specify libraries to link.
+#    OBJS     - List of object files that go into the library.
+#
+#  NOTES:
+#  1. Be careful about whitespace after the last character in the LIB_NAME.
+#     These spaces will generate an error when the library is made.
+#
+LIB_NAME = io_grib2
+SYS_DEFINES = 
+DEP_LIBS = 
+FORMAT       = $(FIXED)
+ARFLAGS      = ruv
+OBJS =  \
+	bacio.v1.3.o \
+	baciof.o
+
+#
+#  Include the boilerplate rules for building library modules.
+#
+include $(BUILD_DIR)/library_rules.mk
+
+#
+#  Compile dependencies.  These are appended to this file by make depend. 
+#
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/README
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/README	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/README	(revision 2744)
@@ -0,0 +1,15 @@
+                                                           Aug 21, 2003
+                                                           W/NP11:SAG
+
+BACIO Library.
+
+This library contains Fortran 90 interface to "C"
+language I/O routines.
+
+The Fortran routines call "C" functions, which must
+follow a specific symbol naming convention used by your
+machine/loader to be linked successfully.
+If you are having trouble linking to the routines
+in this library, please make sure the appropriate 
+machine is defined in the "clib.h" file and
+recompile the library.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/bacio.v1.3.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/bacio.v1.3.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/bacio.v1.3.c	(revision 2744)
@@ -0,0 +1,541 @@
+/* Fortran-callable routines to read and write characther (bacio) and */
+/*   numeric (banio) data byte addressably                            */
+/* Robert Grumbine  16 March 1998 */
+/*  v1.1: Put diagnostic output under control of define VERBOSE or QUIET */
+/*        Add option of non-seeking read/write                           */
+/*        Return code for fewer data read/written than requested */
+/*  v1.2: Add cray compatibility  20 April 1998                  */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <malloc.h>
+#include <ctype.h>
+#include <string.h>
+
+/* Include the C library file for definition/control */
+/* Things that might be changed for new systems are there. */
+/* This source file should not (need to) be edited, merely recompiled */
+#include "clib.h"
+
+
+/* Return Codes:  */
+/*  0    All was well                                   */
+/* -1    Tried to open read only _and_ write only       */
+/* -2    Tried to read and write in the same call       */
+/* -3    Internal failure in name processing            */
+/* -4    Failure in opening file                        */
+/* -5    Tried to read on a write-only file             */ 
+/* -6    Failed in read to find the 'start' location    */
+/* -7    Tried to write to a read only file             */
+/* -8    Failed in write to find the 'start' location   */
+/* -9    Error in close                                 */
+/* -10   Read or wrote fewer data than requested        */
+
+/* Note: In your Fortran code, call bacio, not bacio_.  */
+/*int bacio_(int * mode, int * start, int * size, int * no, int * nactual,   */ 
+/*          int * fdes, const char *fname, char *data, int  namelen,         */ 
+/*          int  datanamelen)                                                */
+/* Arguments: */
+/* Mode is the integer specifying operations to be performed                 */
+/*    see the clib.inc file for the values.  Mode is obtained                */
+/*    by adding together the values corresponding to the operations          */
+/*    The best method is to include the clib.inc file and refer to the       */
+/*    names for the operations rather than rely on hard-coded values         */
+/* Start is the byte number to start your operation from.  0 is the first    */
+/*    byte in the file, not 1.                                               */
+/* Newpos is the position in the file after a read or write has been         */
+/*    performed.  You'll need this if you're doing 'seeking' read/write      */
+/* Size is the size of the objects you are trying to read.  Rely on the      */
+/*    values in the locale.inc file.  Types are CHARACTER, INTEGER, REAL,    */
+/*    COMPLEX.  Specify the correct value by using SIZEOF_type, where type   */
+/*    is one of these.  (After having included the locale.inc file)          */
+/* no is the number of things to read or write (characters, integers,        */
+/*                                                              whatever)    */
+/* nactual is the number of things actually read or written.  Check that     */
+/*    you got what you wanted.                                               */
+/* fdes is an integer 'file descriptor'.  This is not a Fortran Unit Number  */
+/*    You can use it, however, to refer to files you've previously opened.   */
+/* fname is the name of the file.  This only needs to be defined when you    */
+/*    are opening a file.  It must be (on the Fortran side) declared as      */
+/*    CHARACTER*N, where N is a length greater than or equal to the length   */
+/*    of the file name.  CHARACTER*1 fname[80] (for example) will fail.      */
+/* data is the name of the entity (variable, vector, array) that you want    */
+/*    to write data out from or read it in to.  The fact that C is declaring */
+/*    it to be a char * does not affect your fortran.                        */
+/* namelen - Do NOT specify this.  It is created automagically by the        */
+/*    Fortran compiler                                                       */
+/* datanamelen - Ditto                                                       */ 
+
+
+int BACIO
+(int * mode, int * start, int *newpos, int * size, int * no, 
+ int * nactual, int * fdes, const char *fname, char *datary, 
+ int  namelen, int  datanamelen) 
+{
+  int i, j, jret, seekret;
+  char *realname, *tempchar;
+  int tcharval;
+  size_t count;
+
+/* Initialization(s) */
+  *nactual = 0;
+
+/* Check for illegal combinations of options */
+  if (( BAOPEN_RONLY & *mode) &&
+     ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
+     #ifdef VERBOSE
+       printf("illegal -- trying to open both read only and write only\n");
+     #endif
+     return -1;
+  }
+  if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
+     #ifdef VERBOSE
+       printf("illegal -- trying to both read and write in the same call\n");
+     #endif
+     return -2;
+  }
+
+/* This section handles Fortran to C translation of strings so as to */
+/*   be able to open the files Fortran is expecting to be opened.    */
+  #ifdef CRAY90
+    namelen = _fcdlen(fcd_fname);
+    fname   = _fcdtocp(fcd_fname);
+  #endif
+
+  realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
+  if (realname == NULL) { 
+    #ifdef VERBOSE
+      printf("failed to mallocate realname %d = namelen\n", namelen);
+      fflush(stdout);
+    #endif
+    return -3;
+  }
+
+  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || 
+       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
+       (BAOPEN_RW & *mode) ) {
+    #ifdef VERBOSE
+      printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
+      printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
+    #endif
+    tempchar = (char *) malloc(sizeof(char) * 1 ) ;
+    i = 0;
+    j = 0;
+    *tempchar = fname[i];
+    tcharval = *tempchar;
+    while (i == j && i < namelen ) {
+       fflush(stdout); 
+       if ( isgraph(tcharval) ) {
+         realname[j] = fname[i];
+         j += 1;
+       }
+       i += 1;
+       *tempchar = fname[i];
+       tcharval = *tempchar;
+    }
+    #ifdef VERBOSE
+      printf("i,j = %d %d\n",i,j); fflush(stdout);
+    #endif
+    realname[j] = '\0';
+    free(tempchar);
+  } 
+   
+/* Open files with correct read/write and file permission. */
+  if (BAOPEN_RONLY & *mode) {
+    #ifdef VERBOSE
+      printf("open read only %s\n", realname);
+    #endif
+     *fdes = open(realname, O_RDONLY , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else if (BAOPEN_WONLY & *mode ) {
+    #ifdef VERBOSE
+      printf("open write only %s\n", realname);
+    #endif
+     *fdes = open(realname, O_WRONLY | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else if (BAOPEN_WONLY_TRUNC & *mode ) {
+    #ifdef VERBOSE
+      printf("open write only with truncation %s\n", realname);
+    #endif
+     *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else if (BAOPEN_WONLY_APPEND & *mode ) {
+    #ifdef VERBOSE
+      printf("open write only with append %s\n", realname);
+    #endif
+     *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else if (BAOPEN_RW & *mode) {
+    #ifdef VERBOSE
+      printf("open read-write %s\n", realname);
+    #endif
+     *fdes = open(realname, O_RDWR | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else {
+    #ifdef VERBOSE
+      printf("no openings\n");
+    #endif
+  }
+  if (*fdes < 0) {
+    #ifdef VERBOSE
+      printf("error in file descriptor! *fdes %d\n", *fdes);
+    #endif
+    return -4;
+  }
+  else {
+    #ifdef VERBOSE
+      printf("file descriptor = %d\n",*fdes );
+    #endif
+  }
+
+
+/* Read data as requested */
+  if (BAREAD & *mode &&
+   ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
+    #ifdef VERBOSE
+      printf("Error, trying to read while in write only mode!\n");
+    #endif
+    return -5;
+  }
+  else if (BAREAD & *mode ) {
+  /* Read in some data */
+    if (! (*mode & NOSEEK) ) {
+      seekret = lseek(*fdes, *start, SEEK_SET);
+      if (seekret == -1) {
+        #ifdef VERBOSE
+          printf("error in seeking to %d\n",*start);
+        #endif
+        return -6;
+      }
+      #ifdef VERBOSE
+      else {
+         printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
+      }
+      #endif
+    }
+    #ifdef CRAY90
+      datary = _fcdtocp(fcd_datary);
+    #endif
+    if (datary == NULL) {
+      printf("Massive catastrophe -- datary pointer is NULL\n");
+      return -666;
+    }
+    #ifdef VERBOSE
+      printf("file descriptor, datary = %d %d\n", *fdes, (int) datary);
+    #endif
+    count = (size_t) *no;
+    jret = read(*fdes, (void *) datary, count);
+    if (jret != *no) {
+      #ifdef VERBOSE
+        printf("did not read in the requested number of bytes\n");
+        printf("read in %d bytes instead of %d \n",jret, *no);
+      #endif
+    }  
+    else {
+    #ifdef VERBOSE
+      printf("read in %d bytes requested \n", *no);
+    #endif
+    }
+    *nactual = jret;
+    *newpos = *start + jret;
+  }
+/* Done with reading */
+ 
+/* See if we should be writing */
+  if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
+    #ifdef VERBOSE
+      printf("Trying to write on a read only file \n");
+    #endif
+     return -7;
+  }
+  else if ( BAWRITE & *mode ) {
+    if (! (*mode & NOSEEK) ) {
+      seekret = lseek(*fdes, *start, SEEK_SET);
+      if (seekret == -1) {
+      #ifdef VERBOSE
+        printf("error in seeking to %d\n",*start);
+      #endif
+        return -8;
+      }
+    }
+    #ifdef CRAY90
+      datary = _fcdtocp(fcd_datary);
+    #endif
+    if (datary == NULL) {
+      printf("Massive catastrophe -- datary pointer is NULL\n");
+      return -666;
+    }
+    #ifdef VERBOSE
+      printf("write file descriptor, datary = %d %d\n", *fdes, (int) datary);
+    #endif
+    count = (size_t) *no;
+    jret = write(*fdes, (void *) datary, count);
+    if (jret != *no) {
+    #ifdef VERBOSE
+      printf("did not write out the requested number of bytes\n");
+      printf("wrote %d bytes instead\n", jret);
+    #endif
+      *nactual = jret;
+      *newpos = *start + jret;
+    }
+    else {
+    #ifdef VERBOSE
+       printf("wrote %d bytes \n", jret);
+    #endif
+       *nactual = jret;
+       *newpos = *start + jret;
+    }
+  }
+/* Done with writing */
+    
+
+/* Close file if requested */
+  if (BACLOSE & *mode ) {
+    jret = close(*fdes);
+    if (jret != 0) { 
+    #ifdef VERBOSE
+      printf("close failed! jret = %d\n",jret);
+    #endif
+      return -9;
+    }
+  }
+/* Done closing */
+
+  free(realname);
+
+/* Check that if we were reading or writing, that we actually got what */
+/*  we expected, else return a -10.  Return 0 (success) if we're here  */
+/*  and weren't reading or writing */
+  if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
+    return -10;
+  }
+  else {
+    return 0;
+  }
+} 
+int BANIO
+(int * mode, int * start, int *newpos, int * size, int * no, 
+ int * nactual, int * fdes, const char *fname, char *datary, 
+ int  namelen ) 
+{
+  int i, j, jret, seekret;
+  char *realname, *tempchar;
+  int tcharval;
+
+/* Initialization(s) */
+  *nactual = 0;
+
+/* Check for illegal combinations of options */
+  if (( BAOPEN_RONLY & *mode) &&
+     ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
+     #ifdef VERBOSE
+       printf("illegal -- trying to open both read only and write only\n");
+     #endif
+     return -1;
+  }
+  if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
+     #ifdef VERBOSE
+       printf("illegal -- trying to both read and write in the same call\n");
+     #endif
+     return -2;
+  }
+
+/* This section handles Fortran to C translation of strings so as to */
+/*   be able to open the files Fortran is expecting to be opened.    */
+  #ifdef CRAY90
+    namelen = _fcdlen(fcd_fname);
+    fname   = _fcdtocp(fcd_fname);
+  #endif
+  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || 
+       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
+       (BAOPEN_RW & *mode) ) {
+    #ifdef VERBOSE
+      printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
+      printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
+    #endif
+    realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
+    if (realname == NULL) { 
+      #ifdef VERBOSE
+        printf("failed to mallocate realname %d = namelen\n", namelen);
+        fflush(stdout);
+      #endif
+      return -3;
+    }
+    tempchar = (char *) malloc(sizeof(char) * 1 ) ;
+    i = 0;
+    j = 0;
+    *tempchar = fname[i];
+    tcharval = *tempchar;
+    while (i == j && i < namelen ) {
+       fflush(stdout); 
+       if ( isgraph(tcharval) ) {
+         realname[j] = fname[i];
+         j += 1;
+       }
+       i += 1;
+       *tempchar = fname[i];
+       tcharval = *tempchar;
+    }
+    #ifdef VERBOSE
+      printf("i,j = %d %d\n",i,j); fflush(stdout);
+    #endif
+    realname[j] = '\0';
+  } 
+   
+/* Open files with correct read/write and file permission. */
+  if (BAOPEN_RONLY & *mode) {
+    #ifdef VERBOSE
+      printf("open read only %s\n", realname);
+    #endif
+     *fdes = open(realname, O_RDONLY , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else if (BAOPEN_WONLY & *mode ) {
+    #ifdef VERBOSE
+      printf("open write only %s\n", realname);
+    #endif
+     *fdes = open(realname, O_WRONLY | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else if (BAOPEN_WONLY_TRUNC & *mode ) {
+    #ifdef VERBOSE
+      printf("open write only with truncation %s\n", realname);
+    #endif
+     *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else if (BAOPEN_WONLY_APPEND & *mode ) {
+    #ifdef VERBOSE
+      printf("open write only with append %s\n", realname);
+    #endif
+     *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else if (BAOPEN_RW & *mode) {
+    #ifdef VERBOSE
+      printf("open read-write %s\n", realname);
+    #endif
+     *fdes = open(realname, O_RDWR | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
+  }
+  else {
+    #ifdef VERBOSE
+      printf("no openings\n");
+    #endif
+  }
+  if (*fdes < 0) {
+    #ifdef VERBOSE
+      printf("error in file descriptor! *fdes %d\n", *fdes);
+    #endif
+    return -4;
+  }
+  else {
+    #ifdef VERBOSE
+      printf("file descriptor = %d\n",*fdes );
+    #endif
+  }
+
+
+/* Read data as requested */
+  if (BAREAD & *mode &&
+   ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
+    #ifdef VERBOSE
+      printf("Error, trying to read while in write only mode!\n");
+    #endif
+    return -5;
+  }
+  else if (BAREAD & *mode ) {
+  /* Read in some data */
+    if (! (*mode & NOSEEK) ) {
+      seekret = lseek(*fdes, *start, SEEK_SET);
+      if (seekret == -1) {
+        #ifdef VERBOSE
+          printf("error in seeking to %d\n",*start);
+        #endif
+        return -6;
+      }
+      #ifdef VERBOSE
+      else {
+         printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
+      }
+      #endif
+    }
+    jret = read(*fdes, datary, *no*(*size) );
+    if (jret != *no*(*size) ) {
+      #ifdef VERBOSE
+        printf("did not read in the requested number of items\n");
+        printf("read in %d items of %d \n",jret/(*size), *no);
+      #endif
+      *nactual = jret/(*size);
+      *newpos = *start + jret;
+    }  
+    #ifdef VERBOSE
+      printf("read in %d items \n", jret/(*size));
+    #endif
+    *nactual = jret/(*size);
+    *newpos = *start + jret;
+  }
+/* Done with reading */
+ 
+/* See if we should be writing */
+  if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
+    #ifdef VERBOSE
+      printf("Trying to write on a read only file \n");
+    #endif
+     return -7;
+  }
+  else if ( BAWRITE & *mode ) {
+    if (! (*mode & NOSEEK) ) {
+      seekret = lseek(*fdes, *start, SEEK_SET);
+      if (seekret == -1) {
+      #ifdef VERBOSE
+        printf("error in seeking to %d\n",*start);
+      #endif
+        return -8;
+      }
+      #ifdef VERBOSE
+      else {
+        printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
+      }
+      #endif
+    }
+    jret = write(*fdes, datary, *no*(*size));
+    if (jret != *no*(*size)) {
+    #ifdef VERBOSE
+      printf("did not write out the requested number of items\n");
+      printf("wrote %d items instead\n", jret/(*size) );
+    #endif
+      *nactual = jret/(*size) ;
+      *newpos = *start + jret;
+    }
+    else {
+    #ifdef VERBOSE
+       printf("wrote %d items \n", jret/(*size) );
+    #endif
+       *nactual = jret/(*size) ;
+       *newpos = *start + jret;
+    }
+  }
+/* Done with writing */
+    
+
+/* Close file if requested */
+  if (BACLOSE & *mode ) {
+    jret = close(*fdes);
+    if (jret != 0) { 
+    #ifdef VERBOSE
+      printf("close failed! jret = %d\n",jret);
+    #endif
+      return -9;
+    }
+  }
+/* Done closing */
+
+/* Check that if we were reading or writing, that we actually got what */
+/*  we expected, else return a -10.  Return 0 (success) if we're here  */
+/*  and weren't reading or writing */
+  if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
+    return -10;
+  }
+  else {
+    return 0;
+  }
+} 
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/baciof.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/baciof.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/baciof.F	(revision 2744)
@@ -0,0 +1,541 @@
+C-----------------------------------------------------------------------
+      MODULE BACIO_MODULE
+C$$$  F90-MODULE DOCUMENTATION BLOCK
+C
+C F90-MODULE: BACIO_MODULE   BYTE-ADDRESSABLE I/O MODULE
+C   PRGMMR: IREDELL          ORG: NP23        DATE: 98-06-04
+C
+C ABSTRACT: MODULE TO SHARE FILE DESCRIPTORS
+C   IN THE BYTE-ADDESSABLE I/O PACKAGE.
+C
+C PROGRAM HISTORY LOG:
+C   98-06-04  IREDELL
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      INTEGER,EXTERNAL:: BACIO
+      INTEGER,DIMENSION(999),SAVE:: FD=999*0
+      INTEGER,DIMENSION(20),SAVE:: BAOPTS=0
+      INCLUDE 'baciof.h'
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE BASETO(NOPT,VOPT)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: BASETO         BYTE-ADDRESSABLE SET OPTIONS
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: SET OPTIONS FOR BYTE-ADDRESSABLE I/O.
+C   ALL OPTIONS DEFAULT TO 0.
+C   OPTION 1: BLOCKED READING OPTION
+C             IF THE OPTION VALUE IS 1, THEN THE READING IS BLOCKED
+C             INTO FOUR 4096-BYTE BUFFERS.  THIS MAY BE EFFICIENT IF
+C             THE READS WILL BE REQUESTED IN MUCH SMALLER CHUNKS.
+C             OTHERWISE, EACH CALL TO BAREAD INITIATES A PHYSICAL READ.
+C
+C PROGRAM HISTORY LOG:
+C   1998-06-04  IREDELL
+C
+C USAGE:    CALL BASETO(NOPT,VOPT)
+C   INPUT ARGUMENTS:
+C     NOPT         INTEGER OPTION NUMBER
+C     VOPT         INTEGER OPTION VALUE
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      INTEGER NOPT,VOPT
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(NOPT.GE.1.AND.NOPT.LE.20) BAOPTS(NOPT)=VOPT
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE BAOPEN(LU,CFN,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: BAOPEN         BYTE-ADDRESSABLE OPEN
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE.
+C
+C PROGRAM HISTORY LOG:
+C   1998-06-04  IREDELL
+C
+C USAGE:    CALL BAOPEN(LU,CFN,IRET)
+C   INPUT ARGUMENTS:
+C     LU           INTEGER UNIT TO OPEN
+C     CFN          CHARACTER FILENAME TO OPEN
+C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
+C   OUTPUT ARGUMENTS:
+C     IRET         INTEGER RETURN CODE
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C SUBPROGRAMS CALLED:
+C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      CHARACTER CFN*(*)
+      CHARACTER(80) CMSG
+      INTEGER SIZE = 1
+
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(LU.LT.001.OR.LU.GT.999) THEN
+        IRET=6
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IRET=BACIO(BACIO_OPENRW,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE BAOPENR(LU,CFN,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: BAOPENR        BYTE-ADDRESSABLE OPEN
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR READ ONLY.
+C
+C PROGRAM HISTORY LOG:
+C   1998-06-04  IREDELL
+C
+C USAGE:    CALL BAOPENR(LU,CFN,IRET)
+C   INPUT ARGUMENTS:
+C     LU           INTEGER UNIT TO OPEN
+C     CFN          CHARACTER FILENAME TO OPEN
+C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
+C   OUTPUT ARGUMENTS:
+C     IRET         INTEGER RETURN CODE
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C SUBPROGRAMS CALLED:
+C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      CHARACTER CFN*(*)
+      INTEGER SIZE = 1
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(LU.LT.001.OR.LU.GT.999) THEN
+        IRET=6
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IRET=BACIO(BACIO_OPENR,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE BAOPENW(LU,CFN,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: BAOPENW        BYTE-ADDRESSABLE OPEN
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR WRITE ONLY.
+C
+C PROGRAM HISTORY LOG:
+C   1998-06-04  IREDELL
+C
+C USAGE:    CALL BAOPENW(LU,CFN,IRET)
+C   INPUT ARGUMENTS:
+C     LU           INTEGER UNIT TO OPEN
+C     CFN          CHARACTER FILENAME TO OPEN
+C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
+C   OUTPUT ARGUMENTS:
+C     IRET         INTEGER RETURN CODE
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C SUBPROGRAMS CALLED:
+C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      CHARACTER CFN*(*)
+      INTEGER SIZE = 1
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(LU.LT.001.OR.LU.GT.999) THEN
+        IRET=6
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IRET=BACIO(BACIO_OPENWT,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE BAOPENWT(LU,CFN,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: BAOPENWT       BYTE-ADDRESSABLE OPEN
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR WRITE ONLY WITH TRUNCATION.
+C
+C PROGRAM HISTORY LOG:
+C   1998-06-04  IREDELL
+C
+C USAGE:    CALL BAOPENWT(LU,CFN,IRET)
+C   INPUT ARGUMENTS:
+C     LU           INTEGER UNIT TO OPEN
+C     CFN          CHARACTER FILENAME TO OPEN
+C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
+C   OUTPUT ARGUMENTS:
+C     IRET         INTEGER RETURN CODE
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C SUBPROGRAMS CALLED:
+C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      CHARACTER CFN*(*)
+      INTEGER SIZE = 1
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(LU.LT.001.OR.LU.GT.999) THEN
+        IRET=6
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IRET=BACIO(BACIO_OPENWT,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE BAOPENWA(LU,CFN,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: BAOPENWA       BYTE-ADDRESSABLE OPEN
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR WRITE ONLY WITH APPEND.
+C
+C PROGRAM HISTORY LOG:
+C   1998-06-04  IREDELL
+C
+C USAGE:    CALL BAOPENWA(LU,CFN,IRET)
+C   INPUT ARGUMENTS:
+C     LU           INTEGER UNIT TO OPEN
+C     CFN          CHARACTER FILENAME TO OPEN
+C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
+C   OUTPUT ARGUMENTS:
+C     IRET         INTEGER RETURN CODE
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C SUBPROGRAMS CALLED:
+C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      CHARACTER CFN*(*)
+      INTEGER SIZE = 1
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(LU.LT.001.OR.LU.GT.999) THEN
+        IRET=6
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IRET=BACIO(BACIO_OPENWA,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE BACLOSE(LU,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: BACLOSE        BYTE-ADDRESSABLE CLOSE
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: CLOSE A BYTE-ADDRESSABLE FILE.
+C
+C PROGRAM HISTORY LOG:
+C   1998-06-04  IREDELL
+C
+C USAGE:    CALL BACLOSE(LU,IRET)
+C   INPUT ARGUMENTS:
+C     LU           INTEGER UNIT TO CLOSE
+C   OUTPUT ARGUMENTS:
+C     IRET         INTEGER RETURN CODE
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C SUBPROGRAMS CALLED:
+C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
+C
+C REMARKS:  A BAOPEN MUST HAVE ALREADY BEEN CALLED.
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      INTEGER SIZE = 1
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(LU.LT.001.OR.LU.GT.999) THEN
+        IRET=6
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IRET=BACIO(BACIO_CLOSE,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
+      IF(IRET.EQ.0) FD(LU)=0
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE BAREAD(LU,IB,NB,KA,A)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: BAREAD         BYTE-ADDRESSABLE READ
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: READ A GIVEN NUMBER OF BYTES FROM AN UNBLOCKED FILE,
+C   SKIPPING A GIVEN NUMBER OF BYTES.
+C   THE PHYSICAL I/O IS BLOCKED INTO FOUR 4096-BYTE BUFFERS
+C   IF THE BYTE-ADDRESSABLE OPTION 1 HAS BEEN SET TO 1 BY BASETO.
+C   THIS BUFFERED READING IS INCOMPATIBLE WITH NO-SEEK READING.
+C
+C PROGRAM HISTORY LOG:
+C   1998-06-04  IREDELL
+C
+C USAGE:    CALL BAREAD(LU,IB,NB,KA,A)
+C   INPUT ARGUMENTS:
+C     LU           INTEGER UNIT TO READ
+C     IB           INTEGER NUMBER OF BYTES TO SKIP
+C                  (IF IB<0, THEN THE FILE IS ACCESSED WITH NO SEEKING)
+C     NB           INTEGER NUMBER OF BYTES TO READ
+C   OUTPUT ARGUMENTS:
+C     KA           INTEGER NUMBER OF BYTES ACTUALLY READ
+C     A            CHARACTER*1 (NB) DATA READ
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C SUBPROGRAMS CALLED:
+C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
+C
+C REMARKS:  A BAOPEN MUST HAVE ALREADY BEEN CALLED.
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      CHARACTER A(NB)
+      CHARACTER CFN
+      PARAMETER(NY=4096,MY=4)
+      INTEGER NS(MY),NN(MY)
+      CHARACTER Y(NY,MY)
+      DATA LUX/0/
+      SAVE JY,NS,NN,Y,LUX
+      INTEGER SIZE=1
+      INTEGER ZERO=0
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(FD(LU).LE.0) THEN
+        KA=0
+        RETURN
+      ENDIF
+      IF(IB.LT.0.AND.BAOPTS(1).EQ.1) THEN
+        KA=0
+        RETURN
+      ENDIF
+      IF(NB.LE.0) THEN
+        KA=0
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  UNBUFFERED I/O
+      IF(BAOPTS(1).NE.1) THEN
+        IF(IB.GE.0) THEN
+           
+          IRET=BACIO(BACIO_READ,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
+        ELSE
+          IRET=BACIO(BACIO_READ+BACIO_NOSEEK,ZERO,JB,SIZE,NB,KA,
+     &          FD(LU),CFN,A)
+        ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  BUFFERED I/O
+C  GET DATA FROM PREVIOUS CALL IF POSSIBLE
+      ELSE
+        KA=0
+        IF(LUX.NE.LU) THEN
+          JY=0
+          NS=0
+          NN=0
+        ELSE
+          DO I=1,MY
+            IY=MOD(JY+I-1,MY)+1
+            KY=IB+KA-NS(IY)
+            IF(KA.LT.NB.AND.KY.GE.0.AND.KY.LT.NN(IY)) THEN
+              K=MIN(NB-KA,NN(IY)-KY)
+              A(KA+1:KA+K)=Y(KY+1:KY+K,IY)
+              KA=KA+K
+            ENDIF
+          ENDDO
+        ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  SET POSITION AND READ BUFFER AND GET DATA
+        IF(KA.LT.NB) THEN
+          LUX=ABS(LU)
+          JY=MOD(JY,MY)+1
+          NS(JY)=IB+KA
+          IRET=BACIO(BACIO_READ,NS(JY),JB,SIZE,NY,NN(JY),
+     &               FD(LUX),CFN,Y(1,JY))
+          IF(NN(JY).GT.0) THEN
+            K=MIN(NB-KA,NN(JY))
+            A(KA+1:KA+K)=Y(1:K,JY)
+            KA=KA+K
+          ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  CONTINUE TO READ BUFFER AND GET DATA
+          DOWHILE(NN(JY).EQ.NY.AND.KA.LT.NB)
+            JY=MOD(JY,MY)+1
+            NS(JY)=NS(JY)+NN(JY)
+            IRET=BACIO(BACIO_READ+BACIO_NOSEEK,NS(JY),JB,SIZE,NY,NN(JY),
+     &                 FD(LUX),CFN,Y(1,JY))
+            IF(NN(JY).GT.0) THEN
+              K=MIN(NB-KA,NN(JY))
+              A(KA+1:KA+K)=Y(1:K,JY)
+              KA=KA+K
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE BAWRITE(LU,IB,NB,KA,A)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: BAWRITE        BYTE-ADDRESSABLE WRITE
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: WRITE A GIVEN NUMBER OF BYTES TO AN UNBLOCKED FILE,
+C   SKIPPING A GIVEN NUMBER OF BYTES.
+C
+C PROGRAM HISTORY LOG:
+C   1998-06-04  IREDELL
+C
+C USAGE:    CALL BAWRITE(LU,IB,NB,KA,A)
+C   INPUT ARGUMENTS:
+C     LU           INTEGER UNIT TO WRITE
+C     IB           INTEGER NUMBER OF BYTES TO SKIP
+C                  (IF IB<0, THEN THE FILE IS ACCESSED WITH NO SEEKING)
+C     NB           INTEGER NUMBER OF BYTES TO WRITE
+C     A            CHARACTER*1 (NB) DATA TO WRITE
+C   OUTPUT ARGUMENTS:
+C     KA           INTEGER NUMBER OF BYTES ACTUALLY WRITTEN
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C SUBPROGRAMS CALLED:
+C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
+C
+C REMARKS:  A BAOPEN MUST HAVE ALREADY BEEN CALLED.
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      CHARACTER A(NB)
+      CHARACTER CFN
+      INTEGER SIZE=1
+      INTEGER ZERO=0
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(FD(LU).LE.0) THEN
+        KA=0
+        RETURN
+      ENDIF
+      IF(NB.LE.0) THEN
+        KA=0
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(IB.GE.0) THEN
+        IRET=BACIO(BACIO_WRITE,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
+      ELSE
+        IRET=BACIO(BACIO_WRITE+BACIO_NOSEEK,ZERO,JB,SIZE,NB,KA,
+     &        FD(LU),CFN,A)
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END
+C-----------------------------------------------------------------------
+      SUBROUTINE WRYTE(LU,NB,A)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: WRYTE          WRITE DATA OUT BY BYTES
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
+C
+C ABSTRACT: WRITE A GIVEN NUMBER OF BYTES TO AN UNBLOCKED FILE.
+C
+C PROGRAM HISTORY LOG:
+C   92-10-31  IREDELL
+C   95-10-31  IREDELL     WORKSTATION VERSION
+C   1998-06-04  IREDELL   BACIO VERSION
+C
+C USAGE:    CALL WRYTE(LU,NB,A)
+C   INPUT ARGUMENTS:
+C     LU           INTEGER UNIT TO WHICH TO WRITE
+C     NB           INTEGER NUMBER OF BYTES TO WRITE
+C     A            CHARACTER*1 (NB) DATA TO WRITE
+C
+C MODULES USED:
+C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
+C
+C SUBPROGRAMS CALLED:
+C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
+C
+C REMARKS:  A BAOPEN MUST HAVE ALREADY BEEN CALLED.
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE BACIO_MODULE
+      CHARACTER A(NB)
+      CHARACTER CFN
+      INTEGER SIZE=1
+      INTEGER ZERO=0
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF(FD(LU).LE.0) THEN
+        RETURN
+      ENDIF
+      IF(NB.LE.0) THEN
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IRET=BACIO(BACIO_WRITE+BACIO_NOSEEK,ZERO,JB,SIZE,NB,KA,FD(LU),
+     &        CFN,A)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/baciof.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/baciof.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/baciof.h	(revision 2744)
@@ -0,0 +1,11 @@
+!     Include file to define variables for Fortran to C interface(s)
+!     Robert Grumbine 16 March 1998
+      INTEGER,PARAMETER:: BACIO_OPENR=1      ! Open file for read only
+      INTEGER,PARAMETER:: BACIO_OPENW=2      ! Open file for write only
+      INTEGER,PARAMETER:: BACIO_OPENRW=4     ! Open file for read or write
+      INTEGER,PARAMETER:: BACIO_CLOSE=8      ! Close file
+      INTEGER,PARAMETER:: BACIO_READ=16      ! Read from the file
+      INTEGER,PARAMETER:: BACIO_WRITE=32     ! Write to the file
+      INTEGER,PARAMETER:: BACIO_NOSEEK=64    ! Start I/O from previous spot
+      INTEGER,PARAMETER:: BACIO_OPENWT=128   ! Open for write only with truncation
+      INTEGER,PARAMETER:: BACIO_OPENWA=256   ! Open for write only with append
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/clib.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/clib.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/bacio-1.3/clib.h	(revision 2744)
@@ -0,0 +1,43 @@
+/*     Include file to define variables for Fortran to C interface(s) */
+/*     Robert Grumbine 16 March 1998                  */
+/*     NOSEEK added 25 March 1998                  */
+/*     CRAY compatibility added 20 April 1998      */
+
+/* The following line should be either undef or define VERBOSE */
+/* The latter gives noisy debugging output, while the former */
+/*   relies solely on the return codes */
+#undef  VERBOSE
+
+/* Declare the system type, supported options are: */
+/* LINUX, SGI, HP, CRAY90, IBM4, IBM8, LINUXF90 */
+#define IBM4
+
+
+#include <stdlib.h>
+
+/* Do not change things below here yourself */
+
+/*     IO-related (bacio.c, banio.c) */
+#define BAOPEN_RONLY              1
+#define BAOPEN_WONLY              2
+#define BAOPEN_RW                 4
+#define BACLOSE                   8
+#define BAREAD                   16
+#define BAWRITE                  32
+#define NOSEEK                   64
+#define BAOPEN_WONLY_TRUNC      128
+#define BAOPEN_WONLY_APPEND     256
+
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define BACIO bacio
+# else
+#   ifdef F2CSTYLE
+#      define BACIO bacio__
+#      define BANIO banio__
+#   else
+#      define BACIO bacio_
+#      define BANIO banio_
+#   endif
+# endif
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/CHANGES
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/CHANGES	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/CHANGES	(revision 2744)
@@ -0,0 +1,66 @@
+
+g2lib-1.0   - August 2003 - Original version
+
+g2lib-1.0.1 - October 2003 - Added support for Grid Definition Template 3.31
+                             Albers Equal Area.
+                           - Added new parameters to the Parameter list in
+                             params.f
+                           - Minor documentation updates.
+
+g2lib-1.0.2 - February 2004 - Added new parameters in params.f for use with 
+                              Quickscat data and Ozone (Air Quality)
+
+g2lib-1.0.3 - May 2004 - Changed most PDT templates in module pdstemplates to 
+                         allow negative surface values.
+                       - Added new routine to gridtemplates and pdstemplates 
+                         modules to return number of entries in a specified 
+                         template.
+                       - Added New routines, getgb2p getgb2rp, used to request 
+                         a packed GRIB2 message from a file.
+                       - New module g2grids can be used to return GDT entries 
+                         for a specific grid from a file containing a list of
+                         predefined grids.
+
+g2lib-1.0.4 - August 2004 - Added functionality to support encoding of 
+                            "Missing" data values within the data field when
+                            using Data Representation Templates 5.2 
+                            (complex packing) and 5.3 (complex packing and 
+                            spatial differencing).  See octets 23 - 31 in DRTs
+                            5.2 and 5.3 for more info on missing value
+                            management.
+                          - Increased the packing efficiency of Data 
+                            Representation Templates 5.2 and 5.3 by adding 
+                            MDL/Glahn algorithm for determining effective
+                            groupings.
+
+g2lib-1.0.5 - December 2004 - WMO approved the JPEG2000 and PNG Data 
+                             Representation Templates ( 5.40000 and 5.40010,
+                             respectively ) for operational use.  The templates
+                             were assigned WMO values of 5.40 and 5.41, 
+                             respectively.  Changes were made to the source to 
+                             recognize either template number.
+                           - Fixed bug encountered when packing a near constant
+                             field with DRT 5.40 or 5.40000 (JPEG2000).
+                           - Added consistency check, provided by 
+                             Arthur Taylor/MDL, used when unpacking Data 
+                             Templates 7.2 and 7.3.
+                           - Corrected the documentation for subroutine
+                             addfield in the grib2.doc file.  Incorrect
+                             arguments were specified for this routine.
+                           - Corrected bug when packing Secondary missing
+                             values in Data Representation Templates 5.2 and
+                             5.3.
+
+g2lib-1.0.6 - April 2005 - Modified the way GETGB2 manages the GRIB2 file 
+                           indexes, so that it can be more efficient and
+                           flexible when reading from multiple
+                           GRIB2 files.
+                         - Fixed bug in PUTGB2 that caused data fields to be
+                           encoded incorrectly.
+                         - Added routine gdt2gds that converts grid information
+                           from a GRIB2 Grid Description Section (GDS) and
+                           Grid Definition Template to GRIB1 GDS info.
+
+g2lib-1.0.7 - April 2005 - Fixed bug causing seg fault when using JPEG2000 
+                           encoding algorithm on a grid with an insanely large
+                           number of data points bitmapped out.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/Makefile	(revision 2744)
@@ -0,0 +1,144 @@
+#------------------------------------------------------------------------------
+#  Makefile for producing libdbclient.so 
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+
+.SUFFIXES:      .c .o
+
+#
+# Specity location for Makefiles that are included.
+#
+INCLUDEDIRS = -I.
+BUILD_DIR = ../../io_grib_share/build
+#
+# Specify directory that output library is to be put in.
+#
+LIB_DEST = ..
+#
+#  SPECIFY local include directories used during compilation of source code. 
+#
+#    CXX_INCLUDES is for C++ files
+#    C_INCLUDES is for C files
+#
+C_INCLUDES   = -I.
+CXX_INCLUDES = -I.
+F_INCLUDES   = -I. -Ig2lib
+FORMAT       = $(FIXED)
+ARFLAGS      = ruv
+#
+#  SPECIFY any subdirectories containing libraries that may be dynamically
+#          linked by this library.
+#
+SUB_DIRS =
+
+#
+#  SPECIFY information for building a library:
+#
+#    LIB_NAME - Fragment of name of the library to build
+#               e.g. if library file name is libfoo.so, set LIB_NAME = foo 
+#    DEP_LIBS - The tokens required to link a shared library against other
+#               shared libraries upon which it depends.  DEP_LIBS should
+#               contain -L<dir> tokens to specify where the dependent 
+#               libraries are, and -l<lib> tokens to specify libraries to link.
+#    OBJS     - List of object files that go into the library.
+#
+#  NOTES:
+#  1. Be careful about whitespace after the last character in the LIB_NAME.
+#     These spaces will generate an error when the library is made.
+#
+LIB_NAME = io_grib2
+CPPFLAGS = -DUSE_JPEG2000
+# 
+# To have the option of using the PNG compression scheme in the grib2 output,
+#   uncomment the following line.  In addition, you will need to assure
+#   that you have libpng and libz installed on your system.  If the libraries
+#   are not in standard system locations, you will need to modify your 
+#   configure.wrf file in order to specify the locations of the libraries.
+#
+#CPPFLAGS = -DUSE_PNG -DUSE_JPEG2000
+# 
+# In addition, you will need to add the following objects to the object list
+#   below.
+#        pngpack.o \
+#        pngunpack.o \
+#        enc_png.o \
+#        dec_png.o \
+#
+#  Further, you will need to add "-lpng" to your link line in configure.wrf
+#
+# Note: PNG functionality has only been tested on Linux.
+#
+
+DEP_LIBS = 
+OBJS =  \
+	gridtemplates.o \
+        pdstemplates.o \
+        drstemplates.o \
+        gribmod.o \
+        realloc.o \
+        addfield.o \
+        addgrid.o \
+        addlocal.o \
+        getfield.o \
+        gb_info.o \
+        gf_getfld.o \
+        gf_free.o \
+        gf_unpack1.o \
+        gf_unpack2.o \
+        gf_unpack3.o \
+        gf_unpack4.o \
+        gf_unpack5.o \
+        gf_unpack6.o \
+        gf_unpack7.o \
+        gettemplates.o \
+        getlocal.o \
+        getdim.o \
+        getpoly.o \
+        gribcreate.o \
+        gribend.o \
+        gribinfo.o \
+        mkieee.o \
+        rdieee.o \
+        simpack.o \
+        simunpack.o \
+        cmplxpack.o \
+        compack.o \
+        misspack.o \
+        pack_gp.o \
+        reduce.o \
+        comunpack.o \
+        specpack.o \
+        specunpack.o \
+        jpcpack.o \
+        jpcunpack.o \
+        enc_jpeg2000.o \
+        dec_jpeg2000.o \
+        gbytesc.o \
+        skgb.o \
+        ixgb2.o \
+        getidx.o \
+        getg2i.o \
+        getg2ir.o \
+        getgb2s.o \
+        getgb2r.o \
+        getgb2l.o \
+        getgb2.o \
+        getgb2p.o \
+        getgb2rp.o \
+        putgb2.o \
+        g2grids.o \
+        gdt2gds.o \
+        mova2i.o \
+        params.o
+
+#
+#  Include the boilerplate rules for building library modules.
+#
+include $(BUILD_DIR)/library_rules.mk
+
+#
+#  Compile dependencies.  These are appended to this file by make depend. 
+#
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/README
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/README	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/README	(revision 2744)
@@ -0,0 +1,84 @@
+                                                           Aug 21, 2003
+                                                           W/NP11:SAG
+
+g2lib Library.
+
+This library contains Fortran 90 decoder/encoder
+routines for GRIB edition 2, as well as indexing/searching
+utility routines.  The user API for the GRIB2 routines
+is described in file "grib2.doc".
+
+Some Fortran routines call "C" functions, which must
+follow a specific symbol naming convention used by your
+machine/loader to be linked successfully.
+If you are having trouble linking to the C routines
+in this library, please make sure the appropriate 
+machine is defined as an option in the CFLAGS
+variable in the makefile.  See the first few lines
+of the makefile for valid options.
+Recompile the library.
+
+We have added support for PNG and JPEG2000 image compression
+algorithms within the GRIB2 standard.  If you would like
+to compile this library to utilize these GRIB2 Templates,
+make sure that -DUSE_PNG and -DUSE_JPEG2000 are specified
+in the FDEFS variable in the makefile.  You will also need
+to download and install the external libraries listed below,
+if they are not already installed on your system.
+
+If you do not wish to bother with the external libs and
+don't need PNG and JPEG2000 support, you can remove the
+-DUSE_PNG and -DUSE_JPEG2000 flags from the FDEFS variable 
+in the makefile.
+
+
+-------------------------------------------------------------------------------
+
+     External Libraries:
+
+libjasper.a - This library is a C implementation of the JPEG-2000 Part-1 
+              standard (i.e., ISO/IEC 15444-1).  This library is required
+              if JPEG2000 support in GRIB2 is desired.  If not, remove
+              the -DUSE_JPEG2000 option from the FDEFS variable 
+              in the makefile.
+
+              Download version jasper-1.700.2 from the JasPer Project's
+              home page, http://www.ece.uvic.ca/~mdadams/jasper/.
+        
+              More information about JPEG2000 can be found at 
+              http://www.jpeg.org/JPEG2000.html.
+
+libpng.a      This library is a C implementation of the Portable Network
+              Graphics PNG image compression format.  This library is required
+              if PNG support in GRIB2 is desired.  If not, remove
+              the -DUSE_PNG option from the FDEFS variable
+              in the makefile.
+
+              If not already installed on your system, download version 
+              libpng-1.2.5 from http://www.libpng.org/pub/png/libpng.html.
+
+              More information about PNG can be found at 
+              http://www.libpng.org/pub/png/.
+
+libz.a        This library contains compression/decompression routines
+              used by libpng.a for PNG image compression support. 
+              This library is required if PNG support in GRIB2 is desired.  
+              If not, remove the -DUSE_PNG option from the FDEFS variable
+              in g2lib/makefile.
+
+              If not already installed on your system, download version 
+              zlib-1.1.4 from http://www.gzip.org/zlib/.
+
+-------------------------------------------------------------------------------
+
+A note about routine MOVA2I:
+
+Some routines in this library call subroutine MOVA2I, which is included in 
+our W3LIB library containing the GRIB1 decoder/encoder routines.  If you
+are using this library without libw3.a, you will need to compile mova2i.c 
+(included in this distribution) so it can be added to libg2.a.  Just add
+the line:
+
+        $(LIB)(mova2i.o) \
+
+to the list of routines in the makefile.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/addfield.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/addfield.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/addfield.F	(revision 2744)
@@ -0,0 +1,482 @@
+      subroutine addfield(cgrib,lcgrib,ipdsnum,ipdstmpl,ipdstmplen,
+     &                    coordlist,numcoord,idrsnum,idrstmpl,
+     &                    idrstmplen,fld,ngrdpts,ibmap,bmap,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    addfield 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-02
+!
+! ABSTRACT: This subroutine packs up Sections 4 through 7 for a given field
+!   and adds them to a GRIB2 message.  They are Product Definition Section,
+!   Data Representation Section, Bit-Map Section and Data Section, 
+!   respectively.
+!   This routine is used with routines "gribcreate", "addlocal", "addgrid",
+!   and "gribend" to create a complete GRIB2 message.  Subroutine
+!   gribcreate must be called first to initialize a new GRIB2 message.
+!   Also, subroutine addgrid must be called after gribcreate and
+!   before this routine to add the appropriate grid description to
+!   the GRIB2 message.   Also, a call to gribend is required to complete 
+!   GRIB2 message after all fields have been added.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-02  Gilbert
+! 2002-12-17  Gilbert  - Added support for new templates using
+!                        PNG and JPEG2000 algorithms/templates.
+! 2004-06-22  Gilbert  - Added check to determine if packing algorithm failed.
+!
+! USAGE:    CALL addfield(cgrib,lcgrib,ipdsnum,ipdstmpl,ipdstmplen,
+!                         coordlist,numcoord,idrsnum,idrstmpl,
+!                         idrstmplen,fld,ngrdpts,ibmap,bmap,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array to contain the GRIB2 message
+!     lcgrib   - Maximum length (bytes) of array cgrib.
+!     ipdsnum  - Product Definition Template Number ( see Code Table 4.0)
+!     ipdstmpl - Contains the data values for the specified Product Definition
+!                Template ( N=ipdsnum ).  Each element of this integer 
+!                array contains an entry (in the order specified) of Product
+!                Defintion Template 4.N
+!   ipdstmplen - Max dimension of ipdstmpl()
+!     coordlist- Array containg floating point values intended to document
+!                the vertical discretisation associated to model data
+!                on hybrid coordinate vertical levels.
+!     numcoord - number of values in array coordlist.
+!     idrsnum  - Data Representation Template Number ( see Code Table 5.0 )
+!     idrstmpl - Contains the data values for the specified Data Representation
+!                Template ( N=idrsnum ).  Each element of this integer 
+!                array contains an entry (in the order specified) of Data
+!                Representation Template 5.N
+!                Note that some values in this template (eg. reference
+!                values, number of bits, etc...) may be changed by the
+!                data packing algorithms.
+!                Use this to specify scaling factors and order of
+!                spatial differencing, if desired.
+!   idrstmplen - Max dimension of idrstmpl()
+!     fld()    - Array of data points to pack.
+!     ngrdpts  - Number of data points in grid.
+!                i.e.  size of fld and bmap.
+!     ibmap    - Bitmap indicator ( see Code Table 6.0 )
+!                0 = bitmap applies and is included in Section 6.
+!                1-253 = Predefined bitmap applies
+!                254 = Previously defined bitmap applies to this field
+!                255 = Bit map does not apply to this product.
+!     bmap()   - Logical*1 array containing bitmap to be added. 
+!                ( if ibmap=0 or ibmap=254)
+!
+!   OUTPUT ARGUMENT LIST:      
+!     cgrib    - Character array to contain the GRIB2 message
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = GRIB message was not initialized.  Need to call
+!                    routine gribcreate first.
+!                2 = GRIB message already complete.  Cannot add new section.
+!                3 = Sum of Section byte counts does not add to total 
+!                    byte count.
+!                4 = Previous Section was not 3 or 7.
+!                5 = Could not find requested Product Definition Template.
+!                6 = Section 3 (GDS) not previously defined in message
+!                7 = Tried to use unsupported Data Representationi Template
+!                8 = Specified use of a previously defined bitmap, but one
+!                    does not exist in the GRIB message.
+!                9 = GDT of one of 5.50 through 5.53 required to pack
+!                    using DRT 5.51
+!               10 = Error packing data field.
+!
+! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow
+!          Section 1 or Section 7 in a GRIB2 message.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      use pdstemplates
+      use drstemplates
+
+      character(len=1),intent(inout) :: cgrib(lcgrib)
+      integer,intent(in) :: ipdsnum,ipdstmpl(*)
+      integer,intent(in) :: idrsnum,numcoord,ipdstmplen,idrstmplen
+      integer,intent(in) :: lcgrib,ngrdpts,ibmap
+      real,intent(in) :: coordlist(numcoord)
+      real,target,intent(in) :: fld(ngrdpts)
+      integer,intent(out) :: ierr
+      integer,intent(inout) :: idrstmpl(*)
+      logical*1,intent(in) :: bmap(ngrdpts)
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4):: ctemp
+      character(len=1),allocatable :: cpack(:)
+      real,pointer,dimension(:) :: pfld
+      real(4) :: coordieee(numcoord),re00
+      integer(4) :: ire00,allones
+      integer :: mappds(ipdstmplen),intbmap(ngrdpts),mapdrs(idrstmplen)
+      integer,parameter :: zero=0,one=1,four=4,five=5,six=6,seven=7
+      integer,parameter :: minsize=50000
+      integer iofst,ibeg,lencurr,len,mappdslen,mapdrslen,lpos3
+      integer width,height,ndpts
+      integer lensec3,lensec4,lensec5,lensec6,lensec7
+      logical issec3,needext,isprevbmap
+ 
+      ierr=0
+      do jj=0,31
+         allones=ibset(allones,jj)
+      enddo
+!
+!  Check to see if beginning of GRIB message exists
+!
+      ctemp=cgrib(1)//cgrib(2)//cgrib(3)//cgrib(4)
+      if ( ctemp.ne.grib ) then
+        print *,'addfield: GRIB not found in given message.'
+        print *,'addfield: Call to routine gribcreate required',
+     &          ' to initialize GRIB messge.'
+        ierr=1
+        return
+      endif
+!
+!  Get current length of GRIB message
+!  
+      call g2lib_gbyte(cgrib,lencurr,96,32)
+!
+!  Check to see if GRIB message is already complete
+!  
+      ctemp=cgrib(lencurr-3)//cgrib(lencurr-2)//cgrib(lencurr-1)
+     &      //cgrib(lencurr)
+      if ( ctemp.eq.c7777 ) then
+        print *,'addfield: GRIB message already complete.  Cannot',
+     &          ' add new section.'
+        ierr=2
+        return
+      endif
+!
+!  Loop through all current sections of the GRIB message to
+!  find the last section number.
+!
+      issec3=.false.
+      isprevbmap=.false.
+      len=16    ! length of Section 0
+      do 
+      !    Get number and length of next section
+        iofst=len*8
+        call g2lib_gbyte(cgrib,ilen,iofst,32)
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)
+        iofst=iofst+8
+      !  Check if previous Section 3 exists and save location of
+      !  the section 3 in case needed later.
+        if (isecnum.eq.3) then
+           issec3=.true.
+           lpos3=len+1
+           lensec3=ilen
+        endif
+      !  Check if a previous defined bitmap exists
+        if (isecnum.eq.6) then
+          call g2lib_gbyte(cgrib,ibmprev,iofst,8)
+          iofst=iofst+8
+          if ((ibmprev.ge.0).and.(ibmprev.le.253)) isprevbmap=.true.
+        endif
+        len=len+ilen
+      !    Exit loop if last section reached
+        if ( len.eq.lencurr ) exit
+      !    If byte count for each section does not match current
+      !    total length, then there is a problem.
+        if ( len.gt.lencurr ) then
+          print *,'addfield: Section byte counts don''t add to total.'
+          print *,'addfield: Sum of section byte counts = ',len
+          print *,'addfield: Total byte count in Section 0 = ',lencurr
+          ierr=3
+          return
+        endif
+      enddo
+!
+!  Sections 4 through 7 can only be added after section 3 or 7.
+!
+      if ( (isecnum.ne.3) .and. (isecnum.ne.7) ) then
+        print *,'addfield: Sections 4-7 can only be added after',
+     &          ' Section 3 or 7.'
+        print *,'addfield: Section ',isecnum,' was the last found in',
+     &          ' given GRIB message.'
+        ierr=4
+        return
+!
+!  Sections 4 through 7 can only be added if section 3 was previously defined.
+!
+      elseif (.not.issec3) then
+        print *,'addfield: Sections 4-7 can only be added if Section',
+     &          ' 3 was previously included.'
+        print *,'addfield: Section 3 was not found in',
+     &          ' given GRIB message.'
+        print *,'addfield: Call to routine addgrid required',
+     &          ' to specify Grid definition.'
+        ierr=6
+        return
+      endif
+!
+!  Add Section 4  - Product Definition Section
+!
+      ibeg=lencurr*8        !   Calculate offset for beginning of section 4
+      iofst=ibeg+32         !   leave space for length of section
+      call g2lib_sbyte(cgrib,four,iofst,8)     ! Store section number ( 4 )
+      iofst=iofst+8
+      call g2lib_sbyte(cgrib,numcoord,iofst,16)   ! Store num of coordinate values
+      iofst=iofst+16
+      call g2lib_sbyte(cgrib,ipdsnum,iofst,16)    ! Store Prod Def Template num.
+      iofst=iofst+16
+      !
+      !   Get Product Definition Template
+      !
+      call getpdstemplate(ipdsnum,mappdslen,mappds,needext,iret)
+      if (iret.ne.0) then
+        ierr=5
+        return
+      endif
+      !
+      !   Extend the Product Definition Template, if necessary.
+      !   The number of values in a specific template may vary
+      !   depending on data specified in the "static" part of the
+      !   template.
+      !
+      if ( needext ) then
+        call extpdstemplate(ipdsnum,ipdstmpl,mappdslen,mappds)
+      endif
+      !
+      !   Pack up each input value in array ipdstmpl into the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mappds.
+      !
+      do i=1,mappdslen
+        nbits=iabs(mappds(i))*8
+        if ( (mappds(i).ge.0).or.(ipdstmpl(i).ge.0) ) then
+          call g2lib_sbyte(cgrib,ipdstmpl(i),iofst,nbits)
+        else
+          call g2lib_sbyte(cgrib,one,iofst,1)
+          call g2lib_sbyte(cgrib,iabs(ipdstmpl(i)),iofst+1,nbits-1)
+        endif
+        iofst=iofst+nbits
+      enddo
+      !
+      !   Add Optional list of vertical coordinate values
+      !   after the Product Definition Template, if necessary.
+      !
+      if ( numcoord .ne. 0 ) then
+        call mkieee(coordlist,coordieee,numcoord)
+        call g2lib_sbytes(cgrib,coordieee,iofst,32,0,numcoord)
+        iofst=iofst+(32*numcoord)
+      endif
+      !
+      !   Calculate length of section 4 and store it in octets
+      !   1-4 of section 4.
+      !
+      lensec4=(iofst-ibeg)/8
+      call g2lib_sbyte(cgrib,lensec4,ibeg,32)
+!
+!  Pack Data using appropriate algorithm
+!
+      !
+      !   Get Data Representation Template
+      !
+      call getdrstemplate(idrsnum,mapdrslen,mapdrs,needext,iret)
+      if (iret.ne.0) then
+        ierr=5
+        return
+      endif
+      !
+      !  contract data field, removing data at invalid grid points,
+      !  if bit-map is provided with field.
+      !
+      if ( ibmap.eq.0 .OR. ibmap.eq.254 ) then
+         allocate(pfld(ngrdpts))
+         ndpts=0;
+         do jj=1,ngrdpts
+             intbmap(jj)=0
+             if ( bmap(jj) ) then
+                intbmap(jj)=1
+                ndpts=ndpts+1
+                pfld(ndpts)=fld(jj);
+             endif
+         enddo
+      else 
+         ndpts=ngrdpts;
+         pfld=>fld;
+      endif
+      lcpack=0
+      nsize=ndpts*4
+      if (nsize .lt. minsize) nsize=minsize
+      allocate(cpack(nsize),stat=istat)
+      if (idrsnum.eq.0) then      !  Simple Packing
+        call simpack(pfld,ndpts,idrstmpl,cpack,lcpack)
+      elseif (idrsnum.eq.2.or.idrsnum.eq.3) then      !  Complex Packing
+        call cmplxpack(pfld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
+      elseif (idrsnum.eq.50) then      !  Sperical Harmonic Simple Packing
+        call simpack(pfld(2),ndpts-1,idrstmpl,cpack,lcpack)
+        call mkieee(real(pfld(1)),re00,1)  ! ensure RE(0,0) value is IEEE format
+        !call g2lib_gbyte(re00,idrstmpl(5),0,32)
+        ire00=transfer(re00,ire00)
+        idrstmpl(5)=ire00
+      elseif (idrsnum.eq.51) then      !  Sperical Harmonic Complex Packing
+           call getpoly(cgrib(lpos3),lensec3,jj,kk,mm)
+           if (jj.ne.0 .AND. kk.ne.0 .AND. mm.ne.0) then
+             call specpack(pfld,ndpts,jj,kk,mm,idrstmpl,cpack,lcpack)
+           else
+             print *,'addfield: Cannot pack DRT 5.51.'
+             ierr=9
+             return
+           endif
+#ifdef USE_JPEG2000
+      elseif (idrsnum.eq.40 .OR. idrsnum.eq.40000) then     !  JPEG2000 encoding
+        if (ibmap.eq.255) then
+           call getdim(cgrib(lpos3),lensec3,width,height,iscan)
+           if ( width.eq.0 .OR. height.eq.0 ) then
+              width=ndpts
+              height=1
+           elseif ( width.eq.allones .OR. height.eq.allones ) then
+              width=ndpts
+              height=1
+           elseif ( ibits(iscan,5,1) .eq. 1) then   ! Scanning mode: bit 3
+              itemp=width
+              width=height
+              height=itemp
+           endif
+        else
+           width=ndpts
+           height=1
+        endif
+        lcpack=nsize
+        call jpcpack(pfld,width,height,idrstmpl,cpack,lcpack,ierr)
+#endif  /* USE_JPEG2000 */
+#ifdef USE_PNG
+      elseif (idrsnum.eq.41 .OR. idrsnum.eq.40010) then      !  PNG encoding
+        if (ibmap.eq.255) then
+           call getdim(cgrib(lpos3),lensec3,width,height,iscan)
+           if ( width.eq.0 .OR. height.eq.0 ) then
+              width=ndpts
+              height=1
+           elseif ( width.eq.allones .OR. height.eq.allones ) then
+              width=ndpts
+              height=1
+           elseif ( ibits(iscan,5,1) .eq. 1) then   ! Scanning mode: bit 3
+              itemp=width
+              width=height
+              height=itemp
+           endif
+        else
+           width=ndpts
+           height=1
+        endif
+        call pngpack(pfld,width,height,idrstmpl,cpack,lcpack)
+#endif   /* USE_PNG */
+      else
+        print *,'addfield: Data Representation Template 5.',idrsnum,
+     *          ' not yet implemented.'
+        ierr=7
+        return
+      endif
+      if ( ibmap.eq.0 .OR. ibmap.eq.254 ) then
+         deallocate(pfld)
+      endif
+      if ( lcpack .lt. 0 ) then
+        if( allocated(cpack) )deallocate(cpack)
+        ierr=10
+        return
+      endif
+
+!
+!  Add Section 5  - Data Representation Section
+!
+      ibeg=iofst            !   Calculate offset for beginning of section 5
+      iofst=ibeg+32         !   leave space for length of section
+      call g2lib_sbyte(cgrib,five,iofst,8)     ! Store section number ( 5 )
+      iofst=iofst+8
+      call g2lib_sbyte(cgrib,ndpts,iofst,32)    ! Store num of actual data points
+      iofst=iofst+32
+      call g2lib_sbyte(cgrib,idrsnum,iofst,16)    ! Store Data Repr. Template num.
+      iofst=iofst+16
+      !
+      !   Pack up each input value in array idrstmpl into the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mapdrs.
+      !
+      do i=1,mapdrslen
+        nbits=iabs(mapdrs(i))*8
+        if ( (mapdrs(i).ge.0).or.(idrstmpl(i).ge.0) ) then
+          call g2lib_sbyte(cgrib,idrstmpl(i),iofst,nbits)
+        else
+          call g2lib_sbyte(cgrib,one,iofst,1)
+          call g2lib_sbyte(cgrib,iabs(idrstmpl(i)),iofst+1,nbits-1)
+        endif
+        iofst=iofst+nbits
+      enddo
+      !
+      !   Calculate length of section 5 and store it in octets
+      !   1-4 of section 5.
+      !
+      lensec5=(iofst-ibeg)/8
+      call g2lib_sbyte(cgrib,lensec5,ibeg,32)
+
+!
+!  Add Section 6  - Bit-Map Section
+!
+      ibeg=iofst            !   Calculate offset for beginning of section 6
+      iofst=ibeg+32         !   leave space for length of section
+      call g2lib_sbyte(cgrib,six,iofst,8)     ! Store section number ( 6 )
+      iofst=iofst+8
+      call g2lib_sbyte(cgrib,ibmap,iofst,8)    ! Store Bit Map indicator
+      iofst=iofst+8
+      !
+      !  Store bitmap, if supplied
+      !
+      if (ibmap.eq.0) then
+        call g2lib_sbytes(cgrib,intbmap,iofst,1,0,ngrdpts)    ! Store BitMap
+        iofst=iofst+ngrdpts
+      endif
+      !
+      !  If specifying a previously defined bit-map, make sure
+      !  one already exists in the current GRIB message.
+      !
+      if ((ibmap.eq.254).and.(.not.isprevbmap)) then
+        print *,'addfield: Requested previously defined bitmap, ',
+     &        ' but one does not exist in the current GRIB message.'
+        ierr=8
+        return
+      endif
+      !
+      !   Calculate length of section 6 and store it in octets
+      !   1-4 of section 6.  Pad to end of octect, if necessary.
+      !
+      left=8-mod(iofst,8)
+      if (left.ne.8) then
+        call g2lib_sbyte(cgrib,zero,iofst,left)     ! Pad with zeros to fill Octet
+        iofst=iofst+left
+      endif
+      lensec6=(iofst-ibeg)/8
+      call g2lib_sbyte(cgrib,lensec6,ibeg,32)
+
+!
+!  Add Section 7  - Data Section
+!
+      ibeg=iofst            !   Calculate offset for beginning of section 7
+      iofst=ibeg+32         !   leave space for length of section
+      call g2lib_sbyte(cgrib,seven,iofst,8)     ! Store section number ( 7 )
+      iofst=iofst+8
+      !      Store Packed Binary Data values, if non-constant field
+      if (lcpack.ne.0) then
+        ioctet=iofst/8           
+        cgrib(ioctet+1:ioctet+lcpack)=cpack(1:lcpack)
+        iofst=iofst+(8*lcpack)
+      endif
+      !
+      !   Calculate length of section 7 and store it in octets
+      !   1-4 of section 7.  
+      !
+      lensec7=(iofst-ibeg)/8
+      call g2lib_sbyte(cgrib,lensec7,ibeg,32)
+
+      if( allocated(cpack) )deallocate(cpack)
+!
+!  Update current byte total of message in Section 0
+!
+      newlen=lencurr+lensec4+lensec5+lensec6+lensec7
+      call g2lib_sbyte(cgrib,newlen,96,32)
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/addgrid.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/addgrid.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/addgrid.F	(revision 2744)
@@ -0,0 +1,228 @@
+      subroutine addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen,
+     &                   ideflist,idefnum,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    addgrid 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-01
+!
+! ABSTRACT: This subroutine packs up a Grid Definition Section (Section 3) 
+!   and adds it to a GRIB2 message.
+!   This routine is used with routines "gribcreate", "addlocal", "addfield",
+!   and "gribend" to create a complete GRIB2 message.  Subroutine
+!   gribcreate must be called first to initialize a new GRIB2 message.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-01  Gilbert
+!
+! USAGE:    CALL addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen,
+!                        ideflist,idefnum,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array to contain the GRIB2 message
+!     lcgrib   - Maximum length (bytes) of array cgrib.
+!     igds     - Contains information needed for GRIB Grid Definition Section 3.
+!                Must be dimensioned >= 5.
+!                igds(1)=Source of grid definition (see Code Table 3.0)
+!                igds(2)=Number of grid points in the defined grid.
+!                igds(3)=Number of octets needed for each 
+!                            additional grid points definition.  
+!                            Used to define number of
+!                            points in each row ( or column ) for
+!                            non-regular grids.  
+!                            = 0, if using regular grid.
+!                igds(4)=Interpretation of list for optional points 
+!                            definition.  (Code Table 3.11)
+!                igds(5)=Grid Definition Template Number (Code Table 3.1)
+!     igdstmpl - Contains the data values for the specified Grid Definition
+!                Template ( NN=igds(5) ).  Each element of this integer 
+!                array contains an entry (in the order specified) of Grid
+!                Defintion Template 3.NN
+!   igdstmplen - Max dimension of igdstmpl()
+!     ideflist - (Used if igds(3) .ne. 0)  This array contains the
+!                number of grid points contained in each row ( or column )
+!      idefnum - (Used if igds(3) .ne. 0)  The number of entries
+!                in array ideflist.  i.e. number of rows ( or columns )
+!                for which optional grid points are defined.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     cgrib    - Character array to contain the GRIB2 message
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = GRIB message was not initialized.  Need to call
+!                    routine gribcreate first.
+!                2 = GRIB message already complete.  Cannot add new section.
+!                3 = Sum of Section byte counts doesn't add to total byte count.
+!                4 = Previous Section was not 1, 2 or 7.
+!                5 = Could not find requested Grid Definition Template.
+!
+! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow
+!          Section 1 or Section 7 in a GRIB2 message.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      use gridtemplates
+
+      character(len=1),intent(inout) :: cgrib(lcgrib)
+      integer,intent(in) :: igds(*),igdstmpl(*),ideflist(idefnum)
+      integer,intent(in) :: lcgrib,idefnum,igdstmplen
+      integer,intent(out) :: ierr
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4):: ctemp
+      integer:: mapgrid(igdstmplen)
+      integer,parameter :: one=1,three=3
+      integer lensec3,iofst,ibeg,lencurr,len,mapgridlen
+      logical needext
+ 
+      ierr=0
+!
+!  Check to see if beginning of GRIB message exists
+!
+      ctemp=cgrib(1)//cgrib(2)//cgrib(3)//cgrib(4)
+      if ( ctemp.ne.grib ) then
+        print *,'addgrid: GRIB not found in given message.'
+        print *,'addgrid: Call to routine gribcreate required',
+     &          ' to initialize GRIB messge.'
+        ierr=1
+        return
+      endif
+!
+!  Get current length of GRIB message
+!  
+      call g2lib_gbyte(cgrib,lencurr,96,32)
+!
+!  Check to see if GRIB message is already complete
+!  
+      ctemp=cgrib(lencurr-3)//cgrib(lencurr-2)//cgrib(lencurr-1)
+     &      //cgrib(lencurr)
+      if ( ctemp.eq.c7777 ) then
+        print *,'addgrid: GRIB message already complete.  Cannot',
+     &          ' add new section.'
+        ierr=2
+        return
+      endif
+!
+!  Loop through all current sections of the GRIB message to
+!  find the last section number.
+!
+      len=16    ! length of Section 0
+      do 
+      !    Get section number and length of next section
+        iofst=len*8
+        call g2lib_gbyte(cgrib,ilen,iofst,32)
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)
+        len=len+ilen
+      !    Exit loop if last section reached
+        if ( len.eq.lencurr ) exit
+      !    If byte count for each section doesn't match current
+      !    total length, then there is a problem.
+        if ( len.gt.lencurr ) then
+          print *,'addgrid: Section byte counts don''t add to total.'
+          print *,'addgrid: Sum of section byte counts = ',len
+          print *,'addgrid: Total byte count in Section 0 = ',lencurr
+          ierr=3
+          return
+        endif
+      enddo
+!
+!  Section 3 can only be added after sections 1, 2 and 7.
+!
+      if ( (isecnum.ne.1) .and. (isecnum.ne.2) .and. 
+     &     (isecnum.ne.7) ) then
+        print *,'addgrid: Section 3 can only be added after Section',
+     &          ' 1, 2 or 7.'
+        print *,'addgrid: Section ',isecnum,' was the last found in',
+     &          ' given GRIB message.'
+        ierr=4
+        return
+      endif
+!
+!  Add Section 3  - Grid Definition Section
+!
+      ibeg=lencurr*8        !   Calculate offset for beginning of section 3
+      iofst=ibeg+32         !   leave space for length of section
+      call g2lib_sbyte(cgrib,three,iofst,8)     ! Store section number ( 3 )
+      iofst=iofst+8
+      call g2lib_sbyte(cgrib,igds(1),iofst,8)     ! Store source of Grid def.
+      iofst=iofst+8
+      call g2lib_sbyte(cgrib,igds(2),iofst,32)    ! Store number of data pts.
+      iofst=iofst+32
+      call g2lib_sbyte(cgrib,igds(3),iofst,8)     ! Store number of extra octets.
+      iofst=iofst+8
+      call g2lib_sbyte(cgrib,igds(4),iofst,8)     ! Store interp. of extra octets.
+      iofst=iofst+8
+      !   if Octet 6 is not equal to zero, Grid Definition Template may
+      !   not be supplied.
+      if ( igds(1).eq.0 ) then
+        call g2lib_sbyte(cgrib,igds(5),iofst,16)  ! Store Grid Def Template num.
+      else
+        call g2lib_sbyte(cgrib,65535,iofst,16)   ! Store missing value as Grid Def Template num.
+      endif
+      iofst=iofst+16
+      !
+      !   Get Grid Definition Template
+      !
+      if (igds(1).eq.0) then
+        call getgridtemplate(igds(5),mapgridlen,mapgrid,needext,
+     &                       iret)
+        if (iret.ne.0) then
+          ierr=5
+          return
+        endif
+        !
+        !   Extend the Grid Definition Template, if necessary.
+        !   The number of values in a specific template may vary
+        !   depending on data specified in the "static" part of the
+        !   template.
+        !
+        if ( needext ) then
+          call extgridtemplate(igds(5),igdstmpl,mapgridlen,mapgrid)
+        endif
+      else
+        mapgridlen=0
+      endif
+      !
+      !   Pack up each input value in array igdstmpl into the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mapgrid.
+      !
+      do i=1,mapgridlen
+        nbits=iabs(mapgrid(i))*8
+        if ( (mapgrid(i).ge.0).or.(igdstmpl(i).ge.0) ) then
+          call g2lib_sbyte(cgrib,igdstmpl(i),iofst,nbits)
+        else
+          call g2lib_sbyte(cgrib,one,iofst,1)
+          call g2lib_sbyte(cgrib,iabs(igdstmpl(i)),iofst+1,nbits-1)
+        endif
+        iofst=iofst+nbits
+      enddo
+      !
+      !   If requested,
+      !   Insert optional list of numbers defining number of points
+      !   in each row or column.  This is used for non regular
+      !   grids.
+      !
+      if ( igds(3).ne.0 ) then
+         nbits=igds(3)*8
+         call g2lib_sbytes(cgrib,ideflist,iofst,nbits,0,idefnum)
+         iofst=iofst+(nbits*idefnum)
+      endif
+      !
+      !   Calculate length of section 3 and store it in octets
+      !   1-4 of section 3.
+      !
+      lensec3=(iofst-ibeg)/8
+      call g2lib_sbyte(cgrib,lensec3,ibeg,32)
+
+!
+!  Update current byte total of message in Section 0
+!
+      call g2lib_sbyte(cgrib,lencurr+lensec3,96,32)
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/addlocal.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/addlocal.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/addlocal.F	(revision 2744)
@@ -0,0 +1,138 @@
+      subroutine addlocal(cgrib,lcgrib,csec2,lcsec2,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    addlocal 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-01
+!
+! ABSTRACT: This subroutine adds a Local Use Section (Section 2) to 
+!   a GRIB2 message.
+!   This routine is used with routines "gribcreate", "addgrid", "addfield",
+!   and "gribend" to create a complete GRIB2 message.  Subroutine
+!   gribcreate must be called first to initialize a new GRIB2 message.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-01  Gilbert
+!
+! USAGE:    CALL addlocal(cgrib,lcgrib,csec2,lcsec2,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array to contain the GRIB2 message
+!     lcgrib   - Maximum length (bytes) of array cgrib.
+!     csec2    - Character array containing information to be added to
+!                Section 2.
+!     lcsec2   - Number of bytes of character array csec2 to be added to
+!                Section 2.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     cgrib    - Character array to contain the GRIB2 message
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = GRIB message was not initialized.  Need to call
+!                    routine gribcreate first.
+!                2 = GRIB message already complete.  Cannot add new section.
+!                3 = Sum of Section byte counts doesn't add to total byte count.
+!                4 = Previous Section was not 1 or 7.
+!
+! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow
+!          Section 1 or Section 7 in a GRIB2 message.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(inout) :: cgrib(lcgrib)
+      character(len=1),intent(in) :: csec2(lcsec2)
+      integer,intent(in) :: lcgrib,lcsec2
+      integer,intent(out) :: ierr
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4):: ctemp
+      integer,parameter :: two=2
+      integer lensec2,iofst,ibeg,lencurr,len
+ 
+      ierr=0
+!
+!  Check to see if beginning of GRIB message exists
+!
+      ctemp=cgrib(1)//cgrib(2)//cgrib(3)//cgrib(4)
+      if ( ctemp.ne.grib ) then
+        print *,'addlocal: GRIB not found in given message.'
+        print *,'addlocal: Call to routine gribcreate required',
+     &          ' to initialize GRIB messge.'
+        ierr=1
+        return
+      endif
+!
+!  Get current length of GRIB message
+!  
+      call g2lib_gbyte(cgrib,lencurr,96,32)
+!
+!  Check to see if GRIB message is already complete
+!  
+      ctemp=cgrib(lencurr-3)//cgrib(lencurr-2)//cgrib(lencurr-1)
+     &      //cgrib(lencurr)
+      if ( ctemp.eq.c7777 ) then
+        print *,'addlocal: GRIB message already complete.  Cannot',
+     &          ' add new section.'
+        ierr=2
+        return
+      endif
+!
+!  Loop through all current sections of the GRIB message to
+!  find the last section number.
+!
+      len=16    ! length of Section 0
+      do 
+      !    Get section number and length of next section
+        iofst=len*8
+        call g2lib_gbyte(cgrib,ilen,iofst,32)
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)
+        len=len+ilen
+      !    Exit loop if last section reached
+        if ( len.eq.lencurr ) exit
+      !    If byte count for each section doesn't match current
+      !    total length, then there is a problem.
+        if ( len.gt.lencurr ) then
+          print *,'addlocal: Section byte counts don''t add to total.'
+          print *,'addlocal: Sum of section byte counts = ',len
+          print *,'addlocal: Total byte count in Section 0 = ',lencurr
+          ierr=3
+          return
+        endif
+      enddo
+!
+!  Section 2 can only be added after sections 1 and 7.
+!
+      if ( (isecnum.ne.1) .and. (isecnum.ne.7) ) then
+        print *,'addlocal: Section 2 can only be added after Section',
+     &          ' 1 or Section 7.'
+        print *,'addlocal: Section ',isecnum,' was the last found in',
+     &          ' given GRIB message.'
+        ierr=4
+        return
+      endif
+!
+!  Add Section 2  - Local Use Section
+!
+      ibeg=lencurr*8        !   Calculate offset for beginning of section 2
+      iofst=ibeg+32         !   leave space for length of section
+      call g2lib_sbyte(cgrib,two,iofst,8)     ! Store section number ( 2 )
+      istart=lencurr+5
+      cgrib(istart+1:istart+lcsec2)=csec2(1:lcsec2)
+      !
+      !   Calculate length of section 2 and store it in octets
+      !   1-4 of section 2.
+      !
+      lensec2=lcsec2+5      ! bytes
+      call g2lib_sbyte(cgrib,lensec2,ibeg,32)
+
+!
+!  Update current byte total of message in Section 0
+!
+      call g2lib_sbyte(cgrib,lencurr+lensec2,96,32)
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/cmplxpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/cmplxpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/cmplxpack.F	(revision 2744)
@@ -0,0 +1,76 @@
+      subroutine cmplxpack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    cmplxpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2004-08-27
+!
+! ABSTRACT: This subroutine packs up a data field using a complex
+!   packing algorithm as defined in the GRIB2 documention.  It
+!   supports GRIB2 complex packing templates with or without
+!   spatial differences (i.e. DRTs 5.2 and 5.3).
+!   It also fills in GRIB2 Data Representation Template 5.2 or 5.3 
+!   with the appropriate values.
+!
+! PROGRAM HISTORY LOG:
+! 2004-08-27  Gilbert
+!
+! USAGE:    CALL cmplxpack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
+!   INPUT ARGUMENT LIST:
+!     fld()    - Contains the data values to pack
+!     ndpts    - The number of data values in array fld()
+!     idrsnum  - Data Representation Template number 5.N
+!                Must equal 2 or 3.
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.2 or 5.3
+!                (1) = Reference value - ignored on input
+!                (2) = Binary Scale Factor
+!                (3) = Decimal Scale Factor
+!                    .
+!                    .
+!                (7) = Missing value management
+!                (8) = Primary missing value
+!                (9) = Secondary missing value
+!                    .
+!                    .
+!               (17) = Order of Spatial Differencing  ( 1 or 2 )
+!                    .
+!                    .
+!
+!   OUTPUT ARGUMENT LIST: 
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.3
+!                (1) = Reference value - set by compack routine.
+!                (2) = Binary Scale Factor - unchanged from input
+!                (3) = Decimal Scale Factor - unchanged from input
+!                    .
+!                    .
+!     cpack    - The packed data field (character*1 array)
+!     lcpack   - length of packed field cpack().
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,intent(in) :: ndpts,idrsnum
+      real,intent(in) :: fld(ndpts)
+      character(len=1),intent(out) :: cpack(*)
+      integer,intent(inout) :: idrstmpl(*)
+      integer,intent(out) :: lcpack
+
+      
+
+      if ( idrstmpl(7) .eq. 0 ) then       ! No internal missing values
+         call compack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
+      elseif ( idrstmpl(7).eq.1 .OR. idrstmpl(7).eq.2) then
+         call misspack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
+      else
+         print *,'cmplxpack: Don:t recognize Missing value option.'
+         lcpack=-1
+      endif
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/compack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/compack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/compack.F	(revision 2744)
@@ -0,0 +1,408 @@
+      subroutine compack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    compack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2000-06-21
+!
+! ABSTRACT: This subroutine packs up a data field using a complex
+!   packing algorithm as defined in the GRIB2 documention.  It
+!   supports GRIB2 complex packing templates with or without
+!   spatial differences (i.e. DRTs 5.2 and 5.3).
+!   It also fills in GRIB2 Data Representation Template 5.2 or 5.3 
+!   with the appropriate values.
+!
+! PROGRAM HISTORY LOG:
+! 2000-06-21  Gilbert
+!
+! USAGE:    CALL compack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
+!   INPUT ARGUMENT LIST:
+!     fld()    - Contains the data values to pack
+!     ndpts    - The number of data values in array fld()
+!     idrsnum  - Data Representation Template number 5.N
+!                Must equal 2 or 3.
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.2 or 5.3
+!                (1) = Reference value - ignored on input
+!                (2) = Binary Scale Factor
+!                (3) = Decimal Scale Factor
+!                    .
+!                    .
+!                (7) = Missing value management
+!                (8) = Primary missing value
+!                (9) = Secondary missing value
+!                    .
+!                    .
+!               (17) = Order of Spatial Differencing  ( 1 or 2 )
+!                    .
+!                    .
+!
+!   OUTPUT ARGUMENT LIST: 
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.3
+!                (1) = Reference value - set by compack routine.
+!                (2) = Binary Scale Factor - unchanged from input
+!                (3) = Decimal Scale Factor - unchanged from input
+!                    .
+!                    .
+!     cpack    - The packed data field (character*1 array)
+!     lcpack   - length of packed field cpack().
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,intent(in) :: ndpts,idrsnum
+      real,intent(in) :: fld(ndpts)
+      character(len=1),intent(out) :: cpack(*)
+      integer,intent(inout) :: idrstmpl(*)
+      integer,intent(out) :: lcpack
+
+      real(4) :: ref
+      integer(4) :: iref
+      integer,allocatable :: ifld(:)
+      integer,allocatable :: jmin(:),jmax(:),lbit(:)
+      integer,parameter :: zero=0
+      integer,allocatable :: gref(:),gwidth(:),glen(:)
+      integer :: glength,grpwidth
+      logical :: simple_alg = .false.
+      
+      alog2=alog(2.0)
+      bscale=2.0**real(-idrstmpl(2))
+      dscale=10.0**real(idrstmpl(3))
+!
+!  Find max and min values in the data
+!
+      rmax=fld(1)
+      rmin=fld(1)
+      do j=2,ndpts
+        if (fld(j).gt.rmax) rmax=fld(j)
+        if (fld(j).lt.rmin) rmin=fld(j)
+      enddo
+!
+!  If max and min values are not equal, pack up field.
+!  If they are equal, we have a constant field, and the reference
+!  value (rmin) is the value for each point in the field and
+!  set nbits to 0.
+!
+      if (rmin.ne.rmax) then
+        iofst=0
+        allocate(ifld(ndpts))
+        allocate(gref(ndpts))
+        allocate(gwidth(ndpts))
+        allocate(glen(ndpts))
+        !
+        !  Scale original data
+        !
+        if (idrstmpl(2).eq.0) then        !  No binary scaling
+           imin=nint(rmin*dscale)
+           !imax=nint(rmax*dscale)
+           rmin=real(imin)
+           do j=1,ndpts
+             ifld(j)=nint(fld(j)*dscale)-imin
+           enddo
+        else                              !  Use binary scaling factor
+           rmin=rmin*dscale
+           !rmax=rmax*dscale
+           do j=1,ndpts
+             ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale)
+           enddo
+        endif
+        !
+        !  Calculate Spatial differences, if using DRS Template 5.3
+        !
+        if (idrsnum.eq.3) then        ! spatial differences
+           if (idrstmpl(17).ne.1.and.idrstmpl(17).ne.2) idrstmpl(17)=2
+           if (idrstmpl(17).eq.1) then      ! first order
+              ival1=ifld(1)
+              do j=ndpts,2,-1
+                 ifld(j)=ifld(j)-ifld(j-1)
+              enddo
+              ifld(1)=0
+           elseif (idrstmpl(17).eq.2) then      ! second order
+              ival1=ifld(1)
+              ival2=ifld(2)
+              do j=ndpts,3,-1
+                 ifld(j)=ifld(j)-(2*ifld(j-1))+ifld(j-2)
+              enddo
+              ifld(1)=0
+              ifld(2)=0
+           endif
+           !
+           !  subtract min value from spatial diff field
+           !
+           isd=idrstmpl(17)+1
+           minsd=minval(ifld(isd:ndpts))
+           do j=isd,ndpts
+              ifld(j)=ifld(j)-minsd
+           enddo
+           !
+           !   find num of bits need to store minsd and add 1 extra bit
+           !   to indicate sign
+           !
+           temp=alog(real(abs(minsd)+1))/alog2
+           nbitsd=ceiling(temp)+1
+           !
+           !   find num of bits need to store ifld(1) ( and ifld(2)
+           !   if using 2nd order differencing )
+           !
+           maxorig=ival1
+           if (idrstmpl(17).eq.2.and.ival2.gt.ival1) maxorig=ival2
+           temp=alog(real(maxorig+1))/alog2
+           nbitorig=ceiling(temp)+1
+           if (nbitorig.gt.nbitsd) nbitsd=nbitorig
+           !   increase number of bits to even multiple of 8 ( octet )
+           if (mod(nbitsd,8).ne.0) nbitsd=nbitsd+(8-mod(nbitsd,8))
+           !
+           !  Store extra spatial differencing info into the packed
+           !  data section.
+           !
+           if (nbitsd.ne.0) then
+              !   pack first original value
+              if (ival1.ge.0) then
+                 call g2lib_sbyte(cpack,ival1,iofst,nbitsd)
+                 iofst=iofst+nbitsd
+              else
+                 call g2lib_sbyte(cpack,1,iofst,1)
+                 iofst=iofst+1
+                 call g2lib_sbyte(cpack,iabs(ival1),iofst,nbitsd-1)
+                 iofst=iofst+nbitsd-1
+              endif
+              if (idrstmpl(17).eq.2) then
+               !  pack second original value
+                 if (ival2.ge.0) then
+                    call g2lib_sbyte(cpack,ival2,iofst,nbitsd)
+                    iofst=iofst+nbitsd
+                 else
+                    call g2lib_sbyte(cpack,1,iofst,1)
+                    iofst=iofst+1
+                    call g2lib_sbyte(cpack,iabs(ival2),iofst,nbitsd-1)
+                    iofst=iofst+nbitsd-1
+                 endif
+              endif
+              !  pack overall min of spatial differences
+              if (minsd.ge.0) then
+                 call g2lib_sbyte(cpack,minsd,iofst,nbitsd)
+                 iofst=iofst+nbitsd
+              else
+                 call g2lib_sbyte(cpack,1,iofst,1)
+                 iofst=iofst+1
+                 call g2lib_sbyte(cpack,iabs(minsd),iofst,nbitsd-1)
+                 iofst=iofst+nbitsd-1
+              endif
+           endif
+         !print *,'SDp ',ival1,ival2,minsd,nbitsd
+        endif     !  end of spatial diff section
+        !
+        !   Determine Groups to be used.
+        !
+        if ( simple_alg ) then
+           !  set group length to 10 :  calculate number of groups
+           !  and length of last group
+           ngroups=ndpts/10
+           glen(1:ngroups)=10
+           itemp=mod(ndpts,10)
+           if (itemp.ne.0) then
+              ngroups=ngroups+1
+              glen(ngroups)=itemp
+           endif
+        else
+           ! Use Dr. Glahn's algorithm for determining grouping.
+           !
+           kfildo=6
+           minpk=10
+           inc=1
+           maxgrps=(ndpts/minpk)+1
+           allocate(jmin(maxgrps))
+           allocate(jmax(maxgrps))
+           allocate(lbit(maxgrps))
+           missopt=0
+           call pack_gp(kfildo,ifld,ndpts,missopt,minpk,inc,miss1,miss2,
+     &                  jmin,jmax,lbit,glen,maxgrps,ngroups,ibit,jbit,
+     &                  kbit,novref,lbitref,ier)
+           !print *,'SAGier = ',ier,ibit,jbit,kbit,novref,lbitref
+           do ng=1,ngroups
+              glen(ng)=glen(ng)+novref
+           enddo
+           deallocate(jmin)
+           deallocate(jmax)
+           deallocate(lbit)
+        endif
+        !  
+        !  For each group, find the group's reference value
+        !  and the number of bits needed to hold the remaining values
+        !
+        n=1
+        do ng=1,ngroups
+           !    find max and min values of group
+           gref(ng)=ifld(n)
+           imax=ifld(n)
+           j=n+1
+           do lg=2,glen(ng)
+              if (ifld(j).lt.gref(ng)) gref(ng)=ifld(j) 
+              if (ifld(j).gt.imax) imax=ifld(j) 
+              j=j+1
+           enddo
+           !   calc num of bits needed to hold data
+           if ( gref(ng).ne.imax ) then
+              temp=alog(real(imax-gref(ng)+1))/alog2
+              gwidth(ng)=ceiling(temp)
+           else
+              gwidth(ng)=0
+           endif
+           !   Subtract min from data
+           j=n
+           do lg=1,glen(ng)
+              ifld(j)=ifld(j)-gref(ng)
+              j=j+1
+           enddo
+           !   increment fld array counter
+           n=n+glen(ng)
+        enddo
+        !  
+        !  Find max of the group references and calc num of bits needed 
+        !  to pack each groups reference value, then
+        !  pack up group reference values
+        !
+        !write(77,*)'GREFS: ',(gref(j),j=1,ngroups)
+        igmax=maxval(gref(1:ngroups))
+        if (igmax.ne.0) then
+           temp=alog(real(igmax+1))/alog2
+           nbitsgref=ceiling(temp)
+           call g2lib_sbytes(cpack,gref,iofst,nbitsgref,0,ngroups)
+           itemp=nbitsgref*ngroups
+           iofst=iofst+itemp
+           !         Pad last octet with Zeros, if necessary,
+           if (mod(itemp,8).ne.0) then
+              left=8-mod(itemp,8)
+              call g2lib_sbyte(cpack,zero,iofst,left)
+              iofst=iofst+left
+           endif
+        else
+           nbitsgref=0
+        endif
+        !
+        !  Find max/min of the group widths and calc num of bits needed
+        !  to pack each groups width value, then
+        !  pack up group width values
+        !
+        !write(77,*)'GWIDTHS: ',(gwidth(j),j=1,ngroups)
+        iwmax=maxval(gwidth(1:ngroups))
+        ngwidthref=minval(gwidth(1:ngroups))
+        if (iwmax.ne.ngwidthref) then
+           temp=alog(real(iwmax-ngwidthref+1))/alog2
+           nbitsgwidth=ceiling(temp)
+           do i=1,ngroups
+              gwidth(i)=gwidth(i)-ngwidthref
+           enddo
+           call g2lib_sbytes(cpack,gwidth,iofst,nbitsgwidth,0,ngroups)
+           itemp=nbitsgwidth*ngroups
+           iofst=iofst+itemp
+           !         Pad last octet with Zeros, if necessary,
+           if (mod(itemp,8).ne.0) then
+              left=8-mod(itemp,8)
+              call g2lib_sbyte(cpack,zero,iofst,left)
+              iofst=iofst+left
+           endif
+        else
+           nbitsgwidth=0
+           gwidth(1:ngroups)=0
+        endif
+        !
+        !  Find max/min of the group lengths and calc num of bits needed
+        !  to pack each groups length value, then
+        !  pack up group length values
+        !
+        !write(77,*)'GLENS: ',(glen(j),j=1,ngroups)
+        ilmax=maxval(glen(1:ngroups-1))
+        nglenref=minval(glen(1:ngroups-1))
+        nglenlast=glen(ngroups)
+        if (ilmax.ne.nglenref) then
+           temp=alog(real(ilmax-nglenref+1))/alog2
+           nbitsglen=ceiling(temp)
+           do i=1,ngroups-1
+              glen(i)=glen(i)-nglenref
+           enddo
+           call g2lib_sbytes(cpack,glen,iofst,nbitsglen,0,ngroups)
+           itemp=nbitsglen*ngroups
+           iofst=iofst+itemp
+           !         Pad last octet with Zeros, if necessary,
+           if (mod(itemp,8).ne.0) then
+              left=8-mod(itemp,8)
+              call g2lib_sbyte(cpack,zero,iofst,left)
+              iofst=iofst+left
+           endif
+        else
+           nbitsglen=0
+           glen(1:ngroups)=0
+        endif
+        !
+        !  For each group, pack data values
+        !
+        !write(77,*)'IFLDS: ',(ifld(j),j=1,ndpts)
+        n=1
+        ij=0
+        do ng=1,ngroups
+           glength=glen(ng)+nglenref
+           if (ng.eq.ngroups ) glength=nglenlast
+           grpwidth=gwidth(ng)+ngwidthref
+       !write(77,*)'NGP ',ng,grpwidth,glength,gref(ng)
+           if ( grpwidth.ne.0 ) then
+              call g2lib_sbytes(cpack,ifld(n),iofst,grpwidth,0,glength)
+              iofst=iofst+(grpwidth*glength)
+           endif
+           do kk=1,glength
+              ij=ij+1
+       !write(77,*)'SAG ',ij,fld(ij),ifld(ij),gref(ng),bscale,rmin,dscale
+           enddo
+           n=n+glength
+        enddo
+        !         Pad last octet with Zeros, if necessary,
+        if (mod(iofst,8).ne.0) then
+           left=8-mod(iofst,8)
+           call g2lib_sbyte(cpack,zero,iofst,left)
+           iofst=iofst+left
+        endif
+        lcpack=iofst/8
+        !
+        if ( allocated(ifld) ) deallocate(ifld)
+        if ( allocated(gref) ) deallocate(gref)
+        if ( allocated(gwidth) ) deallocate(gwidth)
+        if ( allocated(glen) ) deallocate(glen)
+      else           !   Constant field ( max = min )
+        nbits=0
+        lcpack=0
+        nbitsgref=0
+        ngroups=0
+      endif
+
+!
+!  Fill in ref value and number of bits in Template 5.2
+!
+      call mkieee(rmin,ref,1)   ! ensure reference value is IEEE format
+!      call g2lib_gbyte(ref,idrstmpl(1),0,32)
+      iref=transfer(ref,iref)
+      idrstmpl(1)=iref
+      idrstmpl(4)=nbitsgref
+      idrstmpl(5)=0         ! original data were reals
+      idrstmpl(6)=1         ! general group splitting
+      idrstmpl(7)=0         ! No internal missing values
+      idrstmpl(8)=0         ! Primary missing value
+      idrstmpl(9)=0         ! secondary missing value
+      idrstmpl(10)=ngroups          ! Number of groups
+      idrstmpl(11)=ngwidthref       ! reference for group widths
+      idrstmpl(12)=nbitsgwidth      ! num bits used for group widths
+      idrstmpl(13)=nglenref         ! Reference for group lengths
+      idrstmpl(14)=1                ! length increment for group lengths
+      idrstmpl(15)=nglenlast        ! True length of last group
+      idrstmpl(16)=nbitsglen        ! num bits used for group lengths
+      if (idrsnum.eq.3) then
+         idrstmpl(18)=nbitsd/8      ! num bits used for extra spatial
+                                    ! differencing values
+      endif
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/comunpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/comunpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/comunpack.F	(revision 2744)
@@ -0,0 +1,336 @@
+      subroutine comunpack(cpack,len,lensec,idrsnum,idrstmpl,ndpts,
+     &                     fld,ier)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    comunpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2000-06-21
+!
+! ABSTRACT: This subroutine unpacks a data field that was packed using a
+!   complex packing algorithm as defined in the GRIB2 documention,
+!   using info from the GRIB2 Data Representation Template 5.2 or 5.3.
+!   Supports GRIB2 complex packing templates with or without
+!   spatial differences (i.e. DRTs 5.2 and 5.3).
+!
+! PROGRAM HISTORY LOG:
+! 2000-06-21  Gilbert
+! 2004-12-29  Gilbert  -  Added test ( provided by Arthur Taylor/MDL )
+!                         to verify that group widths and lengths are
+!                         consistent with section length.
+!
+! USAGE:    CALL comunpack(cpack,len,lensec,idrsnum,idrstmpl,ndpts,fld,ier)
+!   INPUT ARGUMENT LIST:
+!     cpack    - The packed data field (character*1 array)
+!     len      - length of packed field cpack().
+!     lensec   - length of section 7 (used for error checking).
+!     idrsnum  - Data Representation Template number 5.N
+!                Must equal 2 or 3.
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.2 or 5.3
+!     ndpts    - The number of data values to unpack
+!
+!   OUTPUT ARGUMENT LIST:
+!     fld()    - Contains the unpacked data values
+!     ier      - Error return:
+!                  0 = OK
+!                  1 = Problem - inconsistent group lengths of widths.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cpack(len)
+      integer,intent(in) :: ndpts,len
+      integer,intent(in) :: idrstmpl(*)
+      real,intent(out) :: fld(ndpts)
+
+      integer,allocatable :: ifld(:),ifldmiss(:)
+      integer(4) :: ieee
+      integer,allocatable :: gref(:),gwidth(:),glen(:)
+      real :: ref,bscale,dscale,rmiss1,rmiss2
+!      real :: fldo(6045)
+      integer :: totBit, totLen
+
+      ier=0
+      !print *,'IDRSTMPL: ',(idrstmpl(j),j=1,16)
+      ieee = idrstmpl(1)
+      call rdieee(ieee,ref,1)
+      bscale = 2.0**real(idrstmpl(2))
+      dscale = 10.0**real(-idrstmpl(3))
+      nbitsgref = idrstmpl(4)
+      itype = idrstmpl(5)
+      ngroups = idrstmpl(10)
+      nbitsgwidth = idrstmpl(12)
+      nbitsglen = idrstmpl(16)
+      if (idrsnum.eq.3) then
+         nbitsd=idrstmpl(18)*8
+      endif
+
+      !   Constant field
+
+      if (ngroups.eq.0) then
+         do j=1,ndpts
+           fld(j)=ref
+         enddo
+         return
+      endif
+
+      iofst=0
+      allocate(ifld(ndpts),stat=is)
+      !print *,'ALLOC ifld: ',is,ndpts
+      allocate(gref(ngroups),stat=is)
+      !print *,'ALLOC gref: ',is
+      allocate(gwidth(ngroups),stat=is)
+      !print *,'ALLOC gwidth: ',is
+!
+!  Get missing values, if supplied
+!
+      if ( idrstmpl(7).eq.1 ) then
+         if (itype.eq.0) then
+            call rdieee(idrstmpl(8),rmiss1,1)
+         else
+            rmiss1=real(idrstmpl(8))
+         endif
+      elseif ( idrstmpl(7).eq.2 ) then
+         if (itype.eq.0) then
+            call rdieee(idrstmpl(8),rmiss1,1)
+            call rdieee(idrstmpl(9),rmiss2,1)
+         else
+            rmiss1=real(idrstmpl(8))
+            rmiss2=real(idrstmpl(9))
+         endif
+      endif
+      !print *,'RMISSs: ',rmiss1,rmiss2,ref
+! 
+!  Extract Spatial differencing values, if using DRS Template 5.3
+!
+      if (idrsnum.eq.3) then
+         if (nbitsd.ne.0) then
+              call g2lib_gbyte(cpack,isign,iofst,1)
+              iofst=iofst+1
+              call g2lib_gbyte(cpack,ival1,iofst,nbitsd-1)
+              iofst=iofst+nbitsd-1
+              if (isign.eq.1) ival1=-ival1
+              if (idrstmpl(17).eq.2) then
+                 call g2lib_gbyte(cpack,isign,iofst,1)
+                 iofst=iofst+1
+                 call g2lib_gbyte(cpack,ival2,iofst,nbitsd-1)
+                 iofst=iofst+nbitsd-1
+                 if (isign.eq.1) ival2=-ival2
+              endif
+              call g2lib_gbyte(cpack,isign,iofst,1)
+              iofst=iofst+1
+              call g2lib_gbyte(cpack,minsd,iofst,nbitsd-1)
+              iofst=iofst+nbitsd-1
+              if (isign.eq.1) minsd=-minsd
+         else
+              ival1=0
+              ival2=0
+              minsd=0
+         endif
+       !print *,'SDu ',ival1,ival2,minsd,nbitsd
+      endif
+!
+!  Extract Each Group's reference value
+!
+      !print *,'SAG1: ',nbitsgref,ngroups,iofst
+      if (nbitsgref.ne.0) then
+         call g2lib_gbytes(cpack,gref,iofst,nbitsgref,0,ngroups)
+         itemp=nbitsgref*ngroups
+         iofst=iofst+(itemp)
+         if (mod(itemp,8).ne.0) iofst=iofst+(8-mod(itemp,8))
+      else
+         gref(1:ngroups)=0
+      endif
+      !write(78,*)'GREFs: ',(gref(j),j=1,ngroups)
+!
+!  Extract Each Group's bit width
+!
+      !print *,'SAG2: ',nbitsgwidth,ngroups,iofst,idrstmpl(11)
+      if (nbitsgwidth.ne.0) then
+         call g2lib_gbytes(cpack,gwidth,iofst,nbitsgwidth,0,ngroups)
+         itemp=nbitsgwidth*ngroups
+         iofst=iofst+(itemp)
+         if (mod(itemp,8).ne.0) iofst=iofst+(8-mod(itemp,8))
+      else
+         gwidth(1:ngroups)=0
+      endif
+      do j=1,ngroups
+        gwidth(j)=gwidth(j)+idrstmpl(11)
+      enddo
+      !write(78,*)'GWIDTHs: ',(gwidth(j),j=1,ngroups)
+!
+!  Extract Each Group's length (number of values in each group)
+!
+      allocate(glen(ngroups),stat=is)
+      !print *,'ALLOC glen: ',is
+      !print *,'SAG3: ',nbitsglen,ngroups,iofst,idrstmpl(14),idrstmpl(13)
+      if (nbitsglen.ne.0) then
+         call g2lib_gbytes(cpack,glen,iofst,nbitsglen,0,ngroups)
+         itemp=nbitsglen*ngroups
+         iofst=iofst+(itemp)
+         if (mod(itemp,8).ne.0) iofst=iofst+(8-mod(itemp,8))
+      else
+         glen(1:ngroups)=0
+      endif
+      do j=1,ngroups
+        glen(j)=(glen(j)*idrstmpl(14))+idrstmpl(13)
+      enddo
+      glen(ngroups)=idrstmpl(15)
+      !write(78,*)'GLENs: ',(glen(j),j=1,ngroups)
+      !print *,'GLENsum: ',sum(glen)
+!
+!  Test to see if the group widths and lengths are consistent with number of
+!  values, and length of section 7.
+!
+      totBit = 0
+      totLen = 0
+      do j=1,ngroups
+        totBit = totBit + (gwidth(j)*glen(j));
+        totLen = totLen + glen(j);
+      enddo
+      if (totLen .NE. ndpts) then
+        ier=1
+        return
+      endif
+      if ( (totBit/8) .GT. lensec) then
+        ier=1
+        return
+      endif
+!
+!  For each group, unpack data values
+!
+      if ( idrstmpl(7).eq.0 ) then        ! no missing values
+         n=1
+         do j=1,ngroups
+         !write(78,*)'NGP ',j,gwidth(j),glen(j),gref(j)
+           if (gwidth(j).ne.0) then
+             call g2lib_gbytes(cpack,ifld(n),iofst,gwidth(j),0,glen(j))
+             do k=1,glen(j)
+               ifld(n)=ifld(n)+gref(j)
+               n=n+1
+             enddo
+           else
+             ifld(n:n+glen(j)-1)=gref(j)
+             n=n+glen(j)
+           endif
+           iofst=iofst+(gwidth(j)*glen(j))
+         enddo
+      elseif ( idrstmpl(7).eq.1.OR.idrstmpl(7).eq.2 ) then
+         ! missing values included
+         allocate(ifldmiss(ndpts))
+         !ifldmiss=0
+         n=1
+         non=1
+         do j=1,ngroups
+           !print *,'SAGNGP ',j,gwidth(j),glen(j),gref(j)
+           if (gwidth(j).ne.0) then
+             msng1=(2**gwidth(j))-1
+             msng2=msng1-1
+             call g2lib_gbytes(cpack,ifld(n),iofst,gwidth(j),0,glen(j))
+             iofst=iofst+(gwidth(j)*glen(j))
+             do k=1,glen(j)
+               if (ifld(n).eq.msng1) then
+                  ifldmiss(n)=1
+               elseif (idrstmpl(7).eq.2.AND.ifld(n).eq.msng2) then
+                  ifldmiss(n)=2
+               else
+                  ifldmiss(n)=0
+                  ifld(non)=ifld(n)+gref(j)
+                  non=non+1
+               endif
+               n=n+1
+             enddo
+           else
+             msng1=(2**nbitsgref)-1
+             msng2=msng1-1
+             if (gref(j).eq.msng1) then
+                ifldmiss(n:n+glen(j)-1)=1
+                !ifld(n:n+glen(j)-1)=0
+             elseif (idrstmpl(7).eq.2.AND.gref(j).eq.msng2) then
+                ifldmiss(n:n+glen(j)-1)=2
+                !ifld(n:n+glen(j)-1)=0
+             else
+                ifldmiss(n:n+glen(j)-1)=0
+                ifld(non:non+glen(j)-1)=gref(j)
+                non=non+glen(j)
+             endif
+             n=n+glen(j)
+           endif
+         enddo
+      endif
+      !write(78,*)'IFLDs: ',(ifld(j),j=1,ndpts)
+
+      if ( allocated(gref) ) deallocate(gref)
+      if ( allocated(gwidth) ) deallocate(gwidth)
+      if ( allocated(glen) ) deallocate(glen)
+!
+!  If using spatial differences, add overall min value, and
+!  sum up recursively
+!
+      if (idrsnum.eq.3) then         ! spatial differencing
+         if (idrstmpl(17).eq.1) then      ! first order
+            ifld(1)=ival1
+            if ( idrstmpl(7).eq.0 ) then        ! no missing values
+               itemp=ndpts
+            else
+               itemp=non-1
+            endif
+            do n=2,itemp
+               ifld(n)=ifld(n)+minsd
+               ifld(n)=ifld(n)+ifld(n-1)
+            enddo
+         elseif (idrstmpl(17).eq.2) then    ! second order
+            ifld(1)=ival1
+            ifld(2)=ival2
+            if ( idrstmpl(7).eq.0 ) then        ! no missing values
+               itemp=ndpts
+            else
+               itemp=non-1
+            endif
+            do n=3,itemp
+               ifld(n)=ifld(n)+minsd
+               ifld(n)=ifld(n)+(2*ifld(n-1))-ifld(n-2)
+            enddo
+         endif
+      !write(78,*)'IFLDs: ',(ifld(j),j=1,ndpts)
+      endif
+!
+!  Scale data back to original form
+!
+      !print *,'SAGT: ',ref,bscale,dscale
+      if ( idrstmpl(7).eq.0 ) then        ! no missing values
+         do n=1,ndpts
+            fld(n)=((real(ifld(n))*bscale)+ref)*dscale
+            !write(78,*)'SAG ',n,fld(n),ifld(n),bscale,ref,1./dscale
+         enddo
+      elseif ( idrstmpl(7).eq.1.OR.idrstmpl(7).eq.2 ) then
+         ! missing values included
+         non=1
+         do n=1,ndpts
+            if ( ifldmiss(n).eq.0 ) then
+               fld(n)=((real(ifld(non))*bscale)+ref)*dscale
+               !print *,'SAG ',n,fld(n),ifld(non),bscale,ref,dscale
+               non=non+1
+            elseif ( ifldmiss(n).eq.1 ) then
+               fld(n)=rmiss1
+            elseif ( ifldmiss(n).eq.2 ) then
+               fld(n)=rmiss2
+            endif
+         enddo
+         if ( allocated(ifldmiss) ) deallocate(ifldmiss)
+      endif
+
+      if ( allocated(ifld) ) deallocate(ifld)
+
+      !open(10,form='unformatted',recl=24180,access='direct') 
+      !read(10,rec=1) (fldo(k),k=1,6045)
+      !do i =1,6045
+      !  print *,i,fldo(i),fld(i),fldo(i)-fld(i)
+      !enddo
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/dec_jpeg2000.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/dec_jpeg2000.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/dec_jpeg2000.c	(revision 2744)
@@ -0,0 +1,142 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "jasper/jasper.h"
+#include "proto.h"
+#define JAS_1_700_2
+
+#ifdef __64BIT__
+  typedef int g2int;
+#else
+  typedef long g2int;
+#endif
+
+   int DEC_JPEG2000(char *injpc,g2int *bufsize,g2int *outfld)
+/*$$$  SUBPROGRAM DOCUMENTATION BLOCK
+*                .      .    .                                       .
+* SUBPROGRAM:    dec_jpeg2000      Decodes JPEG2000 code stream
+*   PRGMMR: Gilbert          ORG: W/NP11     DATE: 2002-12-02
+*
+* ABSTRACT: This Function decodes a JPEG2000 code stream specified in the
+*   JPEG2000 Part-1 standard (i.e., ISO/IEC 15444-1) using JasPer 
+*   Software version 1.500.4 (or 1.700.2) written by the University of British
+*   Columbia and Image Power Inc, and others.
+*   JasPer is available at http://www.ece.uvic.ca/~mdadams/jasper/.
+*
+* PROGRAM HISTORY LOG:
+* 2002-12-02  Gilbert
+*
+* USAGE:     int dec_jpeg2000(char *injpc,g2int *bufsize,g2int *outfld)
+*
+*   INPUT ARGUMENTS:
+*      injpc - Input JPEG2000 code stream.
+*    bufsize - Length (in bytes) of the input JPEG2000 code stream.
+*
+*   INPUT ARGUMENTS:
+*     outfld - Output matrix of grayscale image values.
+*
+*   RETURN VALUES :
+*          0 = Successful decode
+*         -3 = Error decode jpeg2000 code stream.
+*         -5 = decoded image had multiple color components.
+*              Only grayscale is expected.
+*
+* REMARKS:
+*
+*      Requires JasPer Software version 1.500.4 or 1.700.2
+*
+* ATTRIBUTES:
+*   LANGUAGE: C
+*   MACHINE:  IBM SP
+*
+*$$$*/
+
+{
+    int ier;
+    g2int i,j,k,n;
+    jas_image_t *image=0;
+    jas_stream_t *jpcstream,*istream;
+    jas_image_cmpt_t cmpt,*pcmpt;
+    char *opts=0;
+    jas_matrix_t *data;
+
+//    jas_init();
+
+//   
+//     Create jas_stream_t containing input JPEG200 codestream in memory.
+//       
+
+    jpcstream=jas_stream_memopen(injpc,*bufsize);
+
+//   
+//     Decode JPEG200 codestream into jas_image_t structure.
+//       
+    image=jpc_decode(jpcstream,opts);
+    if ( image == 0 ) {
+       printf(" jpc_decode return = %d \n",ier);
+       return -3;
+    }
+    
+    pcmpt=image->cmpts_[0];
+/*
+    printf(" SAGOUT DECODE:\n");
+    printf(" tlx %d \n",image->tlx_);
+    printf(" tly %d \n",image->tly_);
+    printf(" brx %d \n",image->brx_);
+    printf(" bry %d \n",image->bry_);
+    printf(" numcmpts %d \n",image->numcmpts_);
+    printf(" maxcmpts %d \n",image->maxcmpts_);
+#ifdef JAS_1_500_4
+    printf(" colormodel %d \n",image->colormodel_);
+#endif
+#ifdef JAS_1_700_2
+    printf(" colorspace %d \n",image->clrspc_);
+#endif
+    printf(" inmem %d \n",image->inmem_);
+    printf(" COMPONENT:\n");
+    printf(" tlx %d \n",pcmpt->tlx_);
+    printf(" tly %d \n",pcmpt->tly_);
+    printf(" hstep %d \n",pcmpt->hstep_);
+    printf(" vstep %d \n",pcmpt->vstep_);
+    printf(" width %d \n",pcmpt->width_);
+    printf(" height %d \n",pcmpt->height_);
+    printf(" prec %d \n",pcmpt->prec_);
+    printf(" sgnd %d \n",pcmpt->sgnd_);
+    printf(" cps %d \n",pcmpt->cps_);
+#ifdef JAS_1_700_2
+    printf(" type %d \n",pcmpt->type_);
+#endif
+*/
+
+//   Expecting jpeg2000 image to be grayscale only.
+//   No color components.
+//
+    if (image->numcmpts_ != 1 ) {
+       printf("dec_jpeg2000: Found color image.  Grayscale expected.\n");
+       return (-5);
+    }
+
+// 
+//    Create a data matrix of grayscale image values decoded from
+//    the jpeg2000 codestream.
+//
+    data=jas_matrix_create(jas_image_height(image), jas_image_width(image));
+    jas_image_readcmpt(image,0,0,0,jas_image_width(image),
+                       jas_image_height(image),data);
+//
+//    Copy data matrix to output integer array.
+//
+    k=0;
+    for (i=0;i<pcmpt->height_;i++) 
+      for (j=0;j<pcmpt->width_;j++) 
+        outfld[k++]=data->rows_[i][j];
+//
+//     Clean up JasPer work structures.
+//
+    jas_matrix_destroy(data);
+    ier=jas_stream_close(jpcstream);
+    jas_image_destroy(image);
+
+    return 0;
+
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/dec_png.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/dec_png.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/dec_png.c	(revision 2744)
@@ -0,0 +1,139 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <png.h>
+#include "proto.h"
+
+#ifdef __64BIT__
+  typedef int g2int;
+#else
+  typedef long g2int;
+#endif
+
+struct png_stream {
+   unsigned char *stream_ptr;     /*  location to write PNG stream  */
+   g2int stream_len;               /*  number of bytes written       */
+};
+typedef struct png_stream png_stream;
+
+void user_read_data(png_structp , png_bytep , png_uint_32 );
+
+void user_read_data(png_structp png_ptr,png_bytep data, png_uint_32 length)
+/*
+        Custom read function used so that libpng will read a PNG stream
+        from memory instead of a file on disk.
+*/
+{
+     char *ptr;
+     g2int offset;
+     png_stream *mem;
+
+     mem=(png_stream *)png_get_io_ptr(png_ptr);
+     ptr=(void *)mem->stream_ptr;
+     offset=mem->stream_len;
+/*     printf("SAGrd %ld %ld %x\n",offset,length,ptr);  */
+     memcpy(data,ptr+offset,length);
+     mem->stream_len += length;
+}
+
+
+
+int DEC_PNG(unsigned char *pngbuf,g2int *width,g2int *height,char *cout)
+{
+    int interlace,color,compres,filter,bit_depth;
+    g2int j,k,n,bytes,clen;
+    png_structp png_ptr;
+    png_infop info_ptr,end_info;
+    png_bytepp row_pointers;
+    png_stream read_io_ptr;
+
+/*  check if stream is a valid PNG format   */
+
+    if ( png_sig_cmp(pngbuf,0,8) != 0) 
+       return (-3);
+
+/* create and initialize png_structs  */
+
+    png_ptr = png_create_read_struct(PNG_LIBPNG_VER_STRING, (png_voidp)NULL, 
+                                      NULL, NULL);
+    if (!png_ptr)
+       return (-1);
+
+    info_ptr = png_create_info_struct(png_ptr);
+    if (!info_ptr)
+    {
+       png_destroy_read_struct(&png_ptr,(png_infopp)NULL,(png_infopp)NULL);
+       return (-2);
+    }
+
+    end_info = png_create_info_struct(png_ptr);
+    if (!end_info)
+    {
+       png_destroy_read_struct(&png_ptr,(png_infopp)info_ptr,(png_infopp)NULL);
+       return (-2);
+    }
+
+/*     Set Error callback   */
+
+    if (setjmp(png_jmpbuf(png_ptr)))
+    {
+       png_destroy_read_struct(&png_ptr, &info_ptr,&end_info);
+       return (-3);
+    }
+
+/*    Initialize info for reading PNG stream from memory   */
+
+    read_io_ptr.stream_ptr=(png_voidp)pngbuf;
+    read_io_ptr.stream_len=0;
+
+/*    Set new custom read function    */
+
+    png_set_read_fn(png_ptr,(voidp)&read_io_ptr,(png_rw_ptr)user_read_data);
+/*     png_init_io(png_ptr, fptr);   */
+
+/*     Read and decode PNG stream   */
+
+    png_read_png(png_ptr, info_ptr, PNG_TRANSFORM_IDENTITY, NULL);
+
+/*     Get pointer to each row of image data   */
+
+    row_pointers = png_get_rows(png_ptr, info_ptr);
+
+/*     Get image info, such as size, depth, colortype, etc...   */
+
+    /*printf("SAGT:png %d %d %d\n",info_ptr->width,info_ptr->height,info_ptr->bit_depth);*/
+    (void)png_get_IHDR(png_ptr, info_ptr, (png_uint_32 *)width, (png_uint_32 *)height,
+               &bit_depth, &color, &interlace, &compres, &filter);
+
+/*     Check if image was grayscale      */
+
+/*
+    if (color != PNG_COLOR_TYPE_GRAY ) {
+       fprintf(stderr,"dec_png: Grayscale image was expected. \n");
+    }
+*/
+    if ( color == PNG_COLOR_TYPE_RGB ) {
+       bit_depth=24;
+    }
+    else if ( color == PNG_COLOR_TYPE_RGB_ALPHA ) {
+       bit_depth=32;
+    }
+/*     Copy image data to output string   */
+
+    n=0;
+    bytes=bit_depth/8;
+    clen=(*width)*bytes;
+    for (j=0;j<*height;j++) {
+      for (k=0;k<clen;k++) {
+        cout[n]=*(row_pointers[j]+k);
+        n++;
+      }
+    }
+
+/*      Clean up   */
+
+    png_destroy_read_struct(&png_ptr, &info_ptr, &end_info);
+    return 0;
+
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/drstemplates.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/drstemplates.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/drstemplates.F	(revision 2744)
@@ -0,0 +1,277 @@
+      module drstemplates
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! MODULE:    drstemplates 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-04-03
+!
+! ABSTRACT: This Fortran Module contains info on all the available 
+!   GRIB2 Data Representation Templates used in Section 5 (DRS).
+!   Each Template has three parts: The number of entries in the template
+!   (mapgridlen);  A map of the template (mapgrid), which contains the
+!   number of octets in which to pack each of the template values; and
+!   a logical value (needext) that indicates whether the Template needs 
+!   to be extended.  In some cases the number of entries in a template 
+!   can vary depending upon values specified in the "static" part of 
+!   the template.  ( See Template 5.1 as an example )
+!
+!   This module also contains two subroutines.  Subroutine getdrstemplate
+!   returns the octet map for a specified Template number, and
+!   subroutine extdrstemplate will calculate the extended octet map
+!   of an appropriate template given values for the "static" part of the 
+!   template.  See docblocks below for the arguments and usage of these 
+!   routines.
+!
+!   NOTE:  Array mapgrid contains the number of octets in which the 
+!   corresponding template values will be stored.  A negative value in
+!   mapgrid is used to indicate that the corresponding template entry can
+!   contain negative values.  This information is used later when packing
+!   (or unpacking) the template data values.  Negative data values in GRIB
+!   are stored with the left most bit set to one, and a negative number
+!   of octets value in mapgrid() indicates that this possibility should
+!   be considered.  The number of octets used to store the data value
+!   in this case would be the absolute value of the negative value in 
+!   mapgrid().
+!  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-11  Gilbert
+! 2002-12-11  Gilbert - Added templates for JPEG2000 and PNG encoding
+!
+! USAGE:    use drstemplates
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,parameter :: MAXLEN=200,MAXTEMP=9
+
+      type drstemplate
+          integer :: template_num
+          integer :: mapdrslen
+          integer,dimension(MAXLEN) :: mapdrs
+          logical :: needext
+      end type drstemplate
+
+      type(drstemplate),dimension(MAXTEMP) :: templates
+
+      data templates(1)%template_num /0/     !  Simple Packing
+      data templates(1)%mapdrslen /5/ 
+      data templates(1)%needext /.false./
+      data (templates(1)%mapdrs(j),j=1,5) 
+     &                             /4,-2,-2,1,1/
+
+      data templates(2)%template_num /2/     !  Complex Packing
+      data templates(2)%mapdrslen /16/
+      data templates(2)%needext /.false./
+      data (templates(2)%mapdrs(j),j=1,16)
+     &                        /4,-2,-2,1,1,1,1,4,4,4,1,1,4,1,4,1/
+
+      data templates(3)%template_num /3/     !  Complex Packing - Spatial Diff
+      data templates(3)%mapdrslen /18/
+      data templates(3)%needext /.false./
+      data (templates(3)%mapdrs(j),j=1,18)
+     &                        /4,-2,-2,1,1,1,1,4,4,4,1,1,4,1,4,1,1,1/
+
+      data templates(4)%template_num /50/     !  Simple Packing - Spectral Data
+      data templates(4)%mapdrslen /5/
+      data templates(4)%needext /.false./
+      data (templates(4)%mapdrs(j),j=1,5)
+     &                         /4,-2,-2,1,4/
+
+      data templates(5)%template_num /51/    !  Complex Packing - Spectral Data
+      data templates(5)%mapdrslen /10/
+      data templates(5)%needext /.false./
+      data (templates(5)%mapdrs(j),j=1,10)
+     &                         /4,-2,-2,1,-4,2,2,2,4,1/
+
+      data templates(6)%template_num /40000/     !  JPEG2000 Encoding
+      data templates(6)%mapdrslen /7/ 
+      data templates(6)%needext /.false./
+      data (templates(6)%mapdrs(j),j=1,7) 
+     &                             /4,-2,-2,1,1,1,1/
+
+      data templates(7)%template_num /40010/     !  PNG Encoding
+      data templates(7)%mapdrslen /5/ 
+      data templates(7)%needext /.false./
+      data (templates(7)%mapdrs(j),j=1,5) 
+     &                             /4,-2,-2,1,1/
+
+      data templates(8)%template_num /40/     !  JPEG2000 Encoding
+      data templates(8)%mapdrslen /7/ 
+      data templates(8)%needext /.false./
+      data (templates(8)%mapdrs(j),j=1,7) 
+     &                             /4,-2,-2,1,1,1,1/
+
+      data templates(9)%template_num /41/     !  PNG Encoding
+      data templates(9)%mapdrslen /5/ 
+      data templates(9)%needext /.false./
+      data (templates(9)%mapdrs(j),j=1,5) 
+     &                             /4,-2,-2,1,1/
+
+!      data templates(5)%template_num /1/      !  Simple Packing - Matrix
+!      data templates(5)%mapdrslen /15/ 
+!      data templates(5)%needext /.true./
+!      data (templates(5)%mapdrs(j),j=1,15)
+!     &                        /4,-2,-2,1,1,1,4,2,2,1,1,1,1,1,1/
+
+
+      contains
+
+         integer function getdrsindex(number)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getdrsindex 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
+!
+! ABSTRACT: This function returns the index of specified Data 
+!   Representation Template 5.NN (NN=number) in array templates.
+!
+! PROGRAM HISTORY LOG:
+! 2001-06-28  Gilbert
+!
+! USAGE:    index=getdrsindex(number)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Data Representation 
+!                Template 5.NN that is being requested.
+!
+! RETURNS:  Index of DRT 5.NN in array templates, if template exists.
+!           = -1, otherwise.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number
+
+           getdrsindex=-1
+
+           do j=1,MAXTEMP
+              if (number.eq.templates(j)%template_num) then
+                 getdrsindex=j
+                 return
+              endif
+           enddo
+
+         end function
+
+
+         subroutine getdrstemplate(number,nummap,map,needext,iret)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getdrstemplate 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
+!
+! ABSTRACT: This subroutine returns DRS template information for a 
+!   specified Data Representation Template 5.NN.
+!   The number of entries in the template is returned along with a map
+!   of the number of octets occupied by each entry.  Also, a flag is
+!   returned to indicate whether the template would need to be extended.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-11  Gilbert
+!
+! USAGE:    CALL getdrstemplate(number,nummap,map,needext,iret)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Data Representation 
+!                Template 5.NN that is being requested.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     nummap   - Number of entries in the Template
+!     map()    - An array containing the number of octets that each 
+!                template entry occupies when packed up into the DRS.
+!     needext  - Logical variable indicating whether the Data Representation
+!                Template has to be extended.  
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Undefined Data Representation Template number.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number
+           integer,intent(out) :: nummap,map(*),iret
+           logical,intent(out) :: needext
+
+           iret=0
+
+           index=getdrsindex(number)
+
+           if (index.ne.-1) then
+              nummap=templates(index)%mapdrslen
+              needext=templates(index)%needext
+              map(1:nummap)=templates(index)%mapdrs(1:nummap)
+           else
+             nummap=0
+             needext=.false.
+             print *,'getdrstemplate: DRS Template ',number,
+     &               ' not defined.'
+             iret=1
+           endif
+
+         end subroutine
+
+         subroutine extdrstemplate(number,list,nummap,map)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    extdrstemplate 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
+!
+! ABSTRACT: This subroutine generates the remaining octet map for a
+!   given Data Representation Template, if required.  Some Templates can
+!   vary depending on data values given in an earlier part of the 
+!   Template, and it is necessary to know some of the earlier entry
+!   values to generate the full octet map of the Template.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-11  Gilbert
+!
+! USAGE:    CALL extdrstemplate(number,list,nummap,map)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Data Representation 
+!                Template 5.NN that is being requested.
+!     list()   - The list of values for each entry in the 
+!                the Data Representation Template 5.NN.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     nummap   - Number of entries in the Template
+!     map()    - An array containing the number of octets that each 
+!                template entry occupies when packed up into the GDS.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number,list(*)
+           integer,intent(out) :: nummap,map(*)
+
+           index=getdrsindex(number)
+           if (index.eq.-1) return
+
+           if ( .not. templates(index)%needext ) return
+           nummap=templates(index)%mapdrslen
+           map(1:nummap)=templates(index)%mapdrs(1:nummap)
+
+           if ( number.eq.1 ) then
+              N=list(11)+list(13)
+              do i=1,N
+                map(nummap+i)=4
+              enddo
+              nummap=nummap+N
+           endif
+
+         end subroutine
+
+      end module
+
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/enc_jpeg2000.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/enc_jpeg2000.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/enc_jpeg2000.c	(revision 2744)
@@ -0,0 +1,184 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "jasper/jasper.h"
+#define JAS_1_700_2
+#include "proto.h"
+
+#ifdef __64BIT__
+  typedef int g2int;
+#else
+  typedef long g2int;
+#endif
+
+int ENC_JPEG2000(unsigned char *cin,g2int *pwidth,g2int *pheight,g2int *pnbits,
+                 g2int *ltype, g2int *ratio, g2int *retry, char *outjpc, 
+                 g2int *jpclen)
+/*$$$  SUBPROGRAM DOCUMENTATION BLOCK
+*                .      .    .                                       .
+* SUBPROGRAM:    enc_jpeg2000      Encodes JPEG2000 code stream
+*   PRGMMR: Gilbert          ORG: W/NP11     DATE: 2002-12-02
+*
+* ABSTRACT: This Function encodes a grayscale image into a JPEG2000 code stream
+*   specified in the JPEG2000 Part-1 standard (i.e., ISO/IEC 15444-1) 
+*   using JasPer Software version 1.500.4 (or 1.700.2 ) written by the 
+*   University of British Columbia, Image Power Inc, and others.
+*   JasPer is available at http://www.ece.uvic.ca/~mdadams/jasper/.
+*
+* PROGRAM HISTORY LOG:
+* 2002-12-02  Gilbert
+* 2004-07-20  GIlbert - Added retry argument/option to allow option of
+*                       increasing the maximum number of guard bits to the
+*                       JPEG2000 algorithm.
+*
+* USAGE:    int enc_jpeg2000(unsigned char *cin,g2int *pwidth,g2int *pheight,
+*                            g2int *pnbits, g2int *ltype, g2int *ratio, 
+*                            g2int *retry, char *outjpc, g2int *jpclen)
+*
+*   INPUT ARGUMENTS:
+*      cin   - Packed matrix of Grayscale image values to encode.
+*    pwidth  - Pointer to width of image
+*    pheight - Pointer to height of image
+*    pnbits  - Pointer to depth (in bits) of image.  i.e number of bits
+*              used to hold each data value
+*    ltype   - Pointer to indicator of lossless or lossy compression
+*              = 1, for lossy compression
+*              != 1, for lossless compression
+*    ratio   - Pointer to target compression ratio.  (ratio:1)
+*              Used only when *ltype == 1.
+*    retry   - Pointer to option type.
+*              1 = try increasing number of guard bits
+*              otherwise, no additional options
+*    jpclen  - Number of bytes allocated for new JPEG2000 code stream in
+*              outjpc.
+*
+*   INPUT ARGUMENTS:
+*     outjpc - Output encoded JPEG2000 code stream
+*
+*   RETURN VALUES :
+*        > 0 = Length in bytes of encoded JPEG2000 code stream
+*         -3 = Error decode jpeg2000 code stream.
+*         -5 = decoded image had multiple color components.
+*              Only grayscale is expected.
+*
+* REMARKS:
+*
+*      Requires JasPer Software version 1.500.4 or 1.700.2
+*
+* ATTRIBUTES:
+*   LANGUAGE: C
+*   MACHINE:  IBM SP
+*
+*$$$*/
+{
+    int ier,rwcnt;
+    jas_image_t image;
+    jas_stream_t *jpcstream,*istream;
+    jas_image_cmpt_t cmpt,*pcmpt;
+#define MAXOPTSSIZE 1024
+    char opts[MAXOPTSSIZE];
+
+    g2int width,height,nbits;
+    width=*pwidth;
+    height=*pheight;
+    nbits=*pnbits;
+/*
+    printf(" enc_jpeg2000:width %ld\n",width);
+    printf(" enc_jpeg2000:height %ld\n",height);
+    printf(" enc_jpeg2000:nbits %ld\n",nbits);
+    printf(" enc_jpeg2000:jpclen %ld\n",*jpclen);
+*/
+//    jas_init();
+
+//
+//    Set lossy compression options, if requested.
+//
+    if ( *ltype != 1 ) {
+       opts[0]=(char)0;
+    }
+    else {
+       snprintf(opts,MAXOPTSSIZE,"mode=real\nrate=%f",1.0/(float)*ratio);
+    }
+    if ( *retry == 1 ) {             // option to increase number of guard bits
+       strcat(opts,"\nnumgbits=4");
+    }
+    //printf("SAGopts: %s\n",opts);
+    
+//
+//     Initialize the JasPer image structure describing the grayscale
+//     image to encode into the JPEG2000 code stream.
+//
+    image.tlx_=0;
+    image.tly_=0;
+#ifdef JAS_1_500_4 
+    image.brx_=(uint_fast32_t)width;
+    image.bry_=(uint_fast32_t)height;
+#endif 
+#ifdef JAS_1_700_2
+    image.brx_=(jas_image_coord_t)width;
+    image.bry_=(jas_image_coord_t)height;
+#endif
+    image.numcmpts_=1;
+    image.maxcmpts_=1;
+#ifdef JAS_1_500_4
+    image.colormodel_=JAS_IMAGE_CM_GRAY;         /* grayscale Image */
+#endif
+#ifdef JAS_1_700_2
+    image.clrspc_=JAS_CLRSPC_SGRAY;         /* grayscale Image */
+    image.cmprof_=0; 
+#endif
+    image.inmem_=1;
+
+    cmpt.tlx_=0;
+    cmpt.tly_=0;
+    cmpt.hstep_=1;
+    cmpt.vstep_=1;
+#ifdef JAS_1_500_4
+    cmpt.width_=(uint_fast32_t)width;
+    cmpt.height_=(uint_fast32_t)height;
+#endif
+#ifdef JAS_1_700_2
+    cmpt.width_=(jas_image_coord_t)width;
+    cmpt.height_=(jas_image_coord_t)height;
+    cmpt.type_=JAS_IMAGE_CT_COLOR(JAS_CLRSPC_CHANIND_GRAY_Y);
+#endif
+    cmpt.prec_=nbits;
+    cmpt.sgnd_=0;
+    cmpt.cps_=(nbits+7)/8;
+
+    pcmpt=&cmpt;
+    image.cmpts_=&pcmpt;
+
+//
+//    Open a JasPer stream containing the input grayscale values
+//
+    istream=jas_stream_memopen((char *)cin,height*width*cmpt.cps_);
+    cmpt.stream_=istream;
+
+//
+//    Open an output stream that will contain the encoded jpeg2000
+//    code stream.
+//
+    jpcstream=jas_stream_memopen(outjpc,(int)(*jpclen));
+
+//
+//     Encode image.
+//
+    ier=jpc_encode(&image,jpcstream,opts);
+    if ( ier != 0 ) {
+       printf(" jpc_encode return = %d \n",ier);
+       return -3;
+    }
+//
+//     Clean up JasPer work structures.
+//    
+    rwcnt=jpcstream->rwcnt_;
+    ier=jas_stream_close(istream);
+    ier=jas_stream_close(jpcstream);
+//
+//      Return size of jpeg2000 code stream
+//
+    return (rwcnt);
+
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/enc_png.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/enc_png.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/enc_png.c	(revision 2744)
@@ -0,0 +1,133 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <png.h>
+#include "proto.h"
+
+#ifdef __64BIT__
+  typedef int g2int;
+#else
+  typedef long g2int;
+#endif
+
+struct png_stream {
+   unsigned char *stream_ptr;     /*  location to write PNG stream  */
+   g2int stream_len;               /*  number of bytes written       */
+};
+typedef struct png_stream png_stream;
+
+void user_write_data(png_structp ,png_bytep , png_uint_32 );
+void user_flush_data(png_structp );
+
+void user_write_data(png_structp png_ptr,png_bytep data, png_uint_32 length)
+/*
+        Custom write function used to that libpng will write
+        to memory location instead of a file on disk
+*/
+{
+     unsigned char *ptr;
+     g2int offset;
+     png_stream *mem;
+
+     mem=(png_stream *)png_get_io_ptr(png_ptr);
+     ptr=mem->stream_ptr;
+     offset=mem->stream_len;
+/*     printf("SAGwr %ld %ld %x\n",offset,length,ptr);    */
+     /*for (j=offset,k=0;k<length;j++,k++) ptr[j]=data[k];*/
+     memcpy(ptr+offset,data,length);
+     mem->stream_len += length;
+}
+
+
+void user_flush_data(png_structp png_ptr)
+/*
+        Dummy Custom flush function
+*/
+{
+   int *do_nothing=NULL;
+}
+
+
+int ENC_PNG(char *data,g2int *width,g2int *height,g2int *nbits,char *pngbuf)
+{
+ 
+    int color_type;
+    g2int j,bytes,pnglen,bit_depth;
+    png_structp png_ptr;
+    png_infop info_ptr;
+//    png_bytep *row_pointers[*height];
+    png_bytep **row_pointers;
+    png_stream write_io_ptr;
+
+/* create and initialize png_structs  */
+
+    png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING, (png_voidp)NULL, 
+                                      NULL, NULL);
+    if (!png_ptr)
+       return (-1);
+
+    info_ptr = png_create_info_struct(png_ptr);
+    if (!info_ptr)
+    {
+       png_destroy_write_struct(&png_ptr,(png_infopp)NULL);
+       return (-2);
+    }
+
+/*     Set Error callback   */
+
+    if (setjmp(png_jmpbuf(png_ptr)))
+    {
+       png_destroy_write_struct(&png_ptr, &info_ptr);
+       return (-3);
+    }
+
+/*    Initialize info for writing PNG stream to memory   */
+
+    write_io_ptr.stream_ptr=(png_voidp)pngbuf;
+    write_io_ptr.stream_len=0;
+
+/*    Set new custom write functions    */
+
+    png_set_write_fn(png_ptr,(voidp)&write_io_ptr,(png_rw_ptr)user_write_data,
+                    (png_flush_ptr)user_flush_data);
+/*    png_init_io(png_ptr, fptr);   */
+/*    png_set_compression_level(png_ptr, Z_BEST_COMPRESSION);  */
+
+/*     Set the image size, colortype, filter type, etc...      */
+
+/*    printf("SAGTsettingIHDR %d %d %d\n",*width,*height,bit_depth); */
+    bit_depth=*nbits;
+    color_type=PNG_COLOR_TYPE_GRAY;
+    if (*nbits == 24 ) {
+        bit_depth=8;
+        color_type=PNG_COLOR_TYPE_RGB;
+    }
+    else if (*nbits == 32 ) {
+        bit_depth=8;
+        color_type=PNG_COLOR_TYPE_RGB_ALPHA;
+    }
+    png_set_IHDR(png_ptr, info_ptr, *width, *height,
+       bit_depth, color_type, PNG_INTERLACE_NONE,
+       PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
+
+/*     Put image data into the PNG info structure    */
+
+    /*bytes=bit_depth/8;*/
+    bytes=*nbits/8;
+    row_pointers=malloc((*height)*sizeof(png_bytep));
+    for (j=0;j<*height;j++) row_pointers[j]=(png_bytep *)(data+(j*(*width)*bytes));
+    png_set_rows(png_ptr, info_ptr, (png_bytepp)row_pointers);
+
+/*     Do the PNG encoding, and write out PNG stream  */
+
+    png_write_png(png_ptr, info_ptr, PNG_TRANSFORM_IDENTITY, NULL);
+
+/*     Clean up   */
+
+    png_destroy_write_struct(&png_ptr, &info_ptr);
+    free(row_pointers);
+    pnglen=write_io_ptr.stream_len;
+    return pnglen;
+
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/g2grids.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/g2grids.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/g2grids.F	(revision 2744)
@@ -0,0 +1,320 @@
+      module g2grids
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! MODULE:    g2grids 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-04-27
+!
+! ABSTRACT: This Fortran Module allows access to predefined GRIB2 Grid 
+!   Definition Templates stored in a file.  The GDTs are represented by 
+!   a predefined number or a character abbreviation.
+!
+!   At the first request, all the grid GDT entries in the file associated
+!   with input Fortran file unit number, lunit, are read into a linked list
+!   named gridlist.  This list is searched for the requested entry.
+!
+!   Users of this Fortran module should only call routines getgridbynum
+!   and getgridbyname.
+!
+!   The format of the file scanned by routines in this module is as follows.
+!   Each line contains one Grid entry containing five fields, each separated
+!   by a colon, ":".  The fields are:
+!      1) - predefined grid number
+!      2) - Up to an 8 character abbreviation
+!      3) - Grid Definition Template number
+!      4) - Number of entries in the Grid Definition Template
+!      5) - A list of values for each entry in the Grid Definition Template.
+!
+!   As an example, this is the entry for the 1x1 GFS global grid 
+!   3:gbl_1deg:  0:19: 0 0 0 0 0 0 0 360 181 0 0 90000000 0 48 -90000000 359000000 1000000 1000000 0
+!
+!   Comments can be included in the file by specifying the symbol "#" as the
+!   first character on the line.  These lines are ignored.
+!
+!
+! PROGRAM HISTORY LOG:
+! 2004-04-27  Gilbert
+!
+! USAGE:    use g2grids
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,parameter :: MAXTEMP=200
+
+      type,private :: g2grid
+          integer :: grid_num
+          integer :: gdt_num
+          integer :: gdt_len
+          integer,dimension(MAXTEMP) :: gridtmpl
+          character(len=8) :: cdesc
+          type(g2grid),pointer :: next
+      end type g2grid
+
+      type(g2grid),pointer,private :: gridlist
+      integer :: num_grids=0
+
+      contains
+
+
+         integer function readgrids(lunit)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    readgrids
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
+!
+! ABSTRACT: This function reads the list of GDT entries in the file 
+!   associated with fortran unit, lunit.  All the entries are stored in a
+!   linked list called gridlist.
+!
+! PROGRAM HISTORY LOG:
+! 2001-06-28  Gilbert
+!
+! USAGE:    number=readgrids(lunit)
+!   INPUT ARGUMENT LIST:
+!     lunit   - Fortran unit number associated the the GDT file.
+!
+! RETURNS:  The number of Grid Definition Templates read in.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: lunit
+
+           integer,parameter :: linelen=1280
+           character(len=8) :: desc
+           character(len=linelen) :: cline
+           integer  ient,igdtn,igdtmpl(200),igdtlen
+           integer :: pos1,pos2,pos3,pos4
+
+           type(g2grid),pointer :: gtemp
+           type(g2grid),pointer :: prev
+           integer count
+
+           count=0
+
+           !   For each line in the file....
+           DO
+             !  Read line into buffer
+             !
+             cline(1:linelen)=' '
+             read(lunit,end=999,fmt='(a)') cline
+
+             !
+             !  Skip line if commented out
+             !
+             if (cline(1:1).eq.'#') cycle
+
+             !
+             !  find positions of delimiters, ":"
+             !
+             pos1=index(cline,':')
+             cline(pos1:pos1)=';'
+             pos2=index(cline,':')
+             cline(pos2:pos2)=';'
+             pos3=index(cline,':')
+             cline(pos3:pos3)=';'
+             pos4=index(cline,':')
+             if ( pos1.eq.0 .or. pos2.eq.0 .or. pos3.eq.0 .or. 
+     &            pos4.eq.0) cycle
+
+             !
+             !  Read each of the five fields.
+             !
+             read(cline(1:pos1-1),*) ient
+             read(cline(pos1+1:pos2-1),*) desc
+             read(cline(pos2+1:pos3-1),*) igdtn
+             read(cline(pos3+1:pos4-1),*) igdtlen
+             read(cline(pos4+1:linelen),*) (igdtmpl(j),j=1,igdtlen)
+
+             !
+             !  Allocate new type(g2grid) variable to store the GDT
+             !
+             allocate(gtemp,stat=iom)
+             count=count+1
+             gtemp%grid_num=ient
+             gtemp%gdt_num=igdtn
+             gtemp%gdt_len=igdtlen
+             gtemp%gridtmpl=igdtmpl
+             gtemp%cdesc=desc
+             nullify(gtemp%next)              ! defines end of linked list.
+             if ( count .eq. 1 ) then
+                gridlist => gtemp
+             else                       ! make sure previous entry in list
+                prev%next => gtemp      ! points to the new entry,
+             endif
+             prev => gtemp
+
+           enddo
+
+ 999       readgrids=count
+           return
+
+         end function
+
+
+         subroutine getgridbynum(lunit,number,igdtn,igdtmpl,iret)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getgridbynum 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-04-26
+!
+! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit
+!   for a Grid Definition Template assigned to the requested number. 
+!   The input file format is described at the top of this module.
+!
+! PROGRAM HISTORY LOG:
+! 2004-04-26  Gilbert
+!
+! USAGE:    CALL getgridbynum(lunit,number,igdtn,igdtmpl,iret)
+!   INPUT ARGUMENT LIST:
+!     lunit    - Unit number of file containing Grid definitions 
+!     number   - Grid number of the requested Grid definition 
+!
+!   OUTPUT ARGUMENT LIST:      
+!     igdtn    - NN, indicating the number of the Grid Definition 
+!                Template 3.NN
+!     igdtmpl()- An array containing the values of each entry in
+!                the Grid Definition Template.
+!     iret     - Error return code.
+!                0 = no error
+!               -1 = Undefined Grid number.
+!                3 = Could not read any grids from file.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: lunit,number
+           integer,intent(out) :: igdtn,igdtmpl(*),iret
+
+           type(g2grid),pointer :: tempgrid
+
+           iret=0
+           igdtn=-1
+           !igdtmpl=0
+
+           !
+           !  If no grids in list, try reading them from the file.
+           !
+           if ( num_grids .eq. 0 ) then
+              num_grids=readgrids(lunit)
+           endif
+
+           if ( num_grids .eq. 0 ) then
+              iret=3                         ! problem reading file
+              return
+           endif
+
+           tempgrid => gridlist
+
+           !
+           !  Search through list
+           !
+           do while ( associated(tempgrid) )
+               if ( number .eq. tempgrid%grid_num ) then
+                  igdtn=tempgrid%gdt_num
+                  igdtmpl(1:tempgrid%gdt_len)=
+     &                        tempgrid%gridtmpl(1:tempgrid%gdt_len)
+                  return
+               else
+                  tempgrid => tempgrid%next
+               endif
+           enddo 
+ 
+           iret=-1
+           return
+ 
+         end subroutine
+
+
+         subroutine getgridbyname(lunit,name,igdtn,igdtmpl,iret)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getgridbyname 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-04-26
+!
+! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit
+!   for a Grid Definition Template assigned to the requested name. 
+!   The input file format is described at the top of this module.
+!
+! PROGRAM HISTORY LOG:
+! 2004-04-26  Gilbert
+!
+! USAGE:    CALL getgridbyname(lunit,name,igdtn,igdtmpl,iret)
+!   INPUT ARGUMENT LIST:
+!     lunit    - Unit number of file containing Grid definitions 
+!     name     - Grid name of the requested Grid definition 
+!
+!   OUTPUT ARGUMENT LIST:      
+!     igdtn    - NN, indicating the number of the Grid Definition 
+!                Template 3.NN
+!     igdtmpl()- An array containing the values of each entry in
+!                the Grid Definition Template.
+!     iret     - Error return code.
+!                0 = no error
+!               -1 = Undefined Grid number.
+!                3 = Could not read any grids from file.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: lunit
+           character(len=8),intent(in) :: name
+           integer,intent(out) :: igdtn,igdtmpl(*),iret
+
+           type(g2grid),pointer :: tempgrid
+
+           iret=0
+           igdtn=-1
+           !igdtmpl=0
+
+           !
+           !  If no grids in list, try reading them from the file.
+           !
+           if ( num_grids .eq. 0 ) then
+              num_grids=readgrids(lunit)
+           endif
+
+           if ( num_grids .eq. 0 ) then
+              iret=3                         ! problem reading file
+              return
+           endif
+
+           tempgrid => gridlist
+
+           !
+           !  Search through list
+           !
+           do while ( associated(tempgrid) )
+               if ( name .eq. tempgrid%cdesc ) then
+                  igdtn=tempgrid%gdt_num
+                  igdtmpl(1:tempgrid%gdt_len)=
+     &                     tempgrid%gridtmpl(1:tempgrid%gdt_len)
+                  return
+               else
+                  tempgrid => tempgrid%next
+               endif
+           enddo 
+ 
+           iret=-1
+           return
+ 
+         end subroutine
+
+
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gb_info.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gb_info.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gb_info.F	(revision 2744)
@@ -0,0 +1,194 @@
+      subroutine gb_info(cgrib,lcgrib,listsec0,listsec1,
+     &                    numfields,numlocal,maxlocal,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gb_info 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-25
+!
+! ABSTRACT: This subroutine searches through a GRIB2 message and
+!   returns the number of gridded fields found in the message and
+!   the number (and maximum size) of Local Use Sections.
+!   Also various checks  are performed
+!   to see if the message is a valid GRIB2 message.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-25  Gilbert
+!
+! USAGE:    CALL gb_info(cgrib,lcgrib,listsec0,listsec1,
+!     &                    numfields,numlocal,maxlocal,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message in array cgrib.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     listsec0 - Contains information decoded from GRIB Indicator Section 0.
+!                Must be dimensioned >= 2.
+!                listsec0(1)=Discipline-GRIB Master Table Number
+!                            (see Code Table 0.0)
+!                listsec0(2)=GRIB Edition Number (currently 2)
+!                listsec0(3)=Length of GRIB message
+!     listsec1 - Contains information read from GRIB Identification Section 1.
+!                Must be dimensioned >= 13.
+!                listsec1(1)=Id of orginating centre (Common Code Table C-1)
+!                listsec1(2)=Id of orginating sub-centre (local table)
+!                listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0)
+!                listsec1(4)=GRIB Local Tables Version Number 
+!                listsec1(5)=Significance of Reference Time (Code Table 1.1)
+!                listsec1(6)=Reference Time - Year (4 digits)
+!                listsec1(7)=Reference Time - Month
+!                listsec1(8)=Reference Time - Day
+!                listsec1(9)=Reference Time - Hour
+!                listsec1(10)=Reference Time - Minute
+!                listsec1(11)=Reference Time - Second
+!                listsec1(12)=Production status of data (Code Table 1.2)
+!                listsec1(13)=Type of processed data (Code Table 1.3)
+!     numfields- The number of gridded fieldse found in the GRIB message.
+!     numlocal - The number of Local Use Sections ( Section 2 ) found in 
+!                the GRIB message.
+!     maxlocal-  The size of the largest Local Use Section ( Section 2 ).
+!                Can be used to ensure that the return array passed
+!                to subroutine getlocal is dimensioned large enough.
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Beginning characters "GRIB" not found.
+!                2 = GRIB message is not Edition 2.
+!                3 = Could not find Section 1, where expected.
+!                4 = End string "7777" found, but not where expected.
+!                5 = End string "7777" not found at end of message.
+!                6 = Invalid section number found.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(out) :: listsec0(3),listsec1(13)
+      integer,intent(out) :: numlocal,numfields,maxlocal,ierr
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4) :: ctemp
+      integer,parameter :: zero=0,one=1
+      integer,parameter :: mapsec1len=13
+      integer,parameter :: 
+     &        mapsec1(mapsec1len)=(/ 2,2,1,1,1,2,1,1,1,1,1,1,1 /)
+      integer iofst,ibeg,istart
+
+      ierr=0
+      numlocal=0
+      numfields=0
+      maxlocal=0
+!
+!  Check for beginning of GRIB message in the first 100 bytes
+!
+      istart=0
+      do j=1,100
+        ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
+        if (ctemp.eq.grib ) then
+          istart=j
+          exit
+        endif
+      enddo
+      if (istart.eq.0) then
+        print *,'gb_info:  Beginning characters GRIB not found.'
+        ierr=1
+        return
+      endif
+!
+!  Unpack Section 0 - Indicator Section 
+!
+      iofst=8*(istart+5)
+      call g2lib_gbyte(cgrib,listsec0(1),iofst,8)     ! Discipline
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,listsec0(2),iofst,8)     ! GRIB edition number
+      iofst=iofst+8
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,lengrib,iofst,32)        ! Length of GRIB message
+      iofst=iofst+32
+      listsec0(3)=lengrib
+      lensec0=16
+      ipos=istart+lensec0
+!
+!  Currently handles only GRIB Edition 2.
+!  
+      if (listsec0(2).ne.2) then
+        print *,'gb_info: can only decode GRIB edition 2.'
+        ierr=2
+        return
+      endif
+!
+!  Unpack Section 1 - Identification Section
+!
+      call g2lib_gbyte(cgrib,lensec1,iofst,32)        ! Length of Section 1
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Section number ( 1 )
+      iofst=iofst+8
+      if (isecnum.ne.1) then
+        print *,'gb_info: Could not find section 1.'
+        ierr=3
+        return
+      endif
+      !
+      !   Unpack each input value in array listsec1 into the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mapsec1.
+      !
+      do i=1,mapsec1len
+        nbits=mapsec1(i)*8
+        call g2lib_gbyte(cgrib,listsec1(i),iofst,nbits)
+        iofst=iofst+nbits
+      enddo
+      ipos=ipos+lensec1
+!
+!  Loop through the remaining sections to see if they are valid.
+!  Also count the number of times Section 2
+!  and Section 4 appear.
+!
+      do
+        ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
+        if (ctemp.eq.c7777 ) then
+          ipos=ipos+4
+          if (ipos.ne.(istart+lengrib)) then
+            print *,'gb_info: "7777" found, but not where expected.'
+            ierr=4
+            return
+          endif
+          exit
+        endif
+        iofst=(ipos-1)*8
+        call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Get Section number
+        iofst=iofst+8
+        ipos=ipos+lensec                 ! Update beginning of section pointer
+        if (ipos.gt.(istart+lengrib)) then
+          print *,'gb_info: "7777"  not found at end of GRIB message.'
+          ierr=5
+          return
+        endif
+        if ( isecnum.ge.2.AND.isecnum.le.7 ) then
+           if (isecnum.eq.2) then     ! Local Section 2
+              !   increment counter for total number of local sections found
+              numlocal=numlocal+1
+              lenposs=lensec-5
+              if ( lenposs.gt.maxlocal ) maxlocal=lenposs
+           elseif (isecnum.eq.4) then
+              !   increment counter for total number of fields found
+              numfields=numfields+1
+           endif
+        else
+           print *,'gb_info: Invalid section number found in GRIB',
+     &             ' message: ',isecnum
+           ierr=6
+           return
+        endif
+        
+      enddo
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gbytesc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gbytesc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gbytesc.F	(revision 2744)
@@ -0,0 +1,127 @@
+      SUBROUTINE G2LIB_GBYTE(IN,IOUT,ISKIP,NBYTE)
+      character*1 in(*)
+      integer iout(*)
+      CALL G2LIB_GBYTES(IN,IOUT,ISKIP,NBYTE,0,1)
+      RETURN
+      END
+
+      SUBROUTINE G2LIB_SBYTE(OUT,IN,ISKIP,NBYTE)
+      character*1 out(*)
+      integer in(*)
+      CALL G2LIB_SBYTES(OUT,IN,ISKIP,NBYTE,0,1)
+      RETURN
+      END
+
+      SUBROUTINE G2LIB_GBYTES(IN,IOUT,ISKIP,NBYTE,NSKIP,N)
+C          Get bytes - unpack bits:  Extract arbitrary size values from a
+C          packed bit string, right justifying each value in the unpacked
+C          array.
+C            IN    = character*1 array input
+C            IOUT  = unpacked array output
+C            ISKIP = initial number of bits to skip
+C            NBYTE = number of bits to take
+C            NSKIP = additional number of bits to skip on each iteration
+C            N     = number of iterations
+C v1.1
+C
+      character*1 in(*)
+      integer iout(*)
+      integer ones(8), tbit, bitcnt
+      save ones
+      data ones/1,3,7,15,31,63,127,255/
+
+c     nbit is the start position of the field in bits
+      nbit = iskip
+      do i = 1, n
+         bitcnt = nbyte
+         index=nbit/8+1
+         ibit=mod(nbit,8)
+         nbit = nbit + nbyte + nskip
+
+c        first byte
+         tbit = min(bitcnt,8-ibit)
+         itmp = iand(mova2i(in(index)),ones(8-ibit))
+         if (tbit.ne.8-ibit) itmp = ishft(itmp,tbit-8+ibit)
+         index = index + 1
+         bitcnt = bitcnt - tbit
+
+c        now transfer whole bytes
+         do while (bitcnt.ge.8)
+             itmp = ior(ishft(itmp,8),mova2i(in(index)))
+             bitcnt = bitcnt - 8
+             index = index + 1
+         enddo
+
+c        get data from last byte
+         if (bitcnt.gt.0) then
+             itmp = ior(ishft(itmp,bitcnt),iand(ishft(mova2i(in(index)),
+     1          -(8-bitcnt)),ones(bitcnt)))
+         endif
+
+         iout(i) = itmp
+      enddo
+
+      RETURN
+      END                                                                  
+
+      SUBROUTINE G2LIB_SBYTES(OUT,IN,ISKIP,NBYTE,NSKIP,N)
+C          Store bytes - pack bits:  Put arbitrary size values into a
+C          packed bit string, taking the low order bits from each value
+C          in the unpacked array.
+C            IOUT  = packed array output
+C            IN    = unpacked array input
+C            ISKIP = initial number of bits to skip
+C            NBYTE = number of bits to pack
+C            NSKIP = additional number of bits to skip on each iteration
+C            N     = number of iterations
+C v1.1
+C
+      character*1 out(*)
+      integer in(N), bitcnt, ones(8), tbit
+      save ones
+      data ones/    1,  3,  7, 15, 31, 63,127,255/
+
+c     number bits from zero to ...
+c     nbit is the last bit of the field to be filled
+
+      nbit = iskip + nbyte - 1
+      do i = 1, n
+         itmp = in(i)
+         bitcnt = nbyte
+         index=nbit/8+1
+         ibit=mod(nbit,8)
+         nbit = nbit + nbyte + nskip
+
+c        make byte aligned 
+         if (ibit.ne.7) then
+             tbit = min(bitcnt,ibit+1)
+             imask = ishft(ones(tbit),7-ibit)
+             itmp2 = iand(ishft(itmp,7-ibit),imask)
+             itmp3 = iand(mova2i(out(index)), 255-imask)
+             out(index) = char(ior(itmp2,itmp3))
+             bitcnt = bitcnt - tbit
+             itmp = ishft(itmp, -tbit)
+             index = index - 1
+         endif
+
+c        now byte aligned
+
+c        do by bytes
+         do while (bitcnt.ge.8)
+             out(index) = char(iand(itmp,255))
+             itmp = ishft(itmp,-8)
+             bitcnt = bitcnt - 8
+             index = index - 1
+         enddo
+
+c        do last byte
+
+         if (bitcnt.gt.0) then
+             itmp2 = iand(itmp,ones(bitcnt))
+             itmp3 = iand(mova2i(out(index)), 255-ones(bitcnt))
+             out(index) = char(ior(itmp2,itmp3))
+         endif
+      enddo
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gdt2gds.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gdt2gds.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gdt2gds.F	(revision 2744)
@@ -0,0 +1,266 @@
+        subroutine gdt2gds(igds,igdstmpl,idefnum,ideflist,kgds,
+     &                     igrid,iret)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C                .      .    .                                       .
+C SUBPROGRAM:    gdt2gds
+C   PRGMMR: Gilbert        ORG: W/NP11    DATE: 2003-06-17
+C
+C ABSTRACT: This routine converts grid information from a GRIB2
+C   Grid Description Section as well as its
+C   Grid Definition Template to GRIB1 GDS info.  In addition,
+C   a check is made to determine if the grid is an NCEP
+C   predefined grid.
+C
+C PROGRAM HISTORY LOG:
+C 2003-06-17  Gilbert
+C 2004-04-27  Gilbert - Added support for gaussian grids.
+C
+C USAGE:    CALL gdt2gds(igds,igdstmpl,idefnum,ideflist,kgds,igrid,iret)
+C   INPUT ARGUMENT LIST:
+C     igds()   - Contains information read from the appropriate GRIB Grid
+C                Definition Section 3 for the field being returned.
+C                Must be dimensioned >= 5.
+C                igds(1)=Source of grid definition (see Code Table 3.0)
+C                igds(2)=Number of grid points in the defined grid.
+C                igds(3)=Number of octets needed for each
+C                            additional grid points definition.
+C                            Used to define number of
+C                            points in each row ( or column ) for
+C                            non-regular grids.
+C                            = 0, if using regular grid.
+C                igds(4)=Interpretation of list for optional points
+C                            definition.  (Code Table 3.11)
+C                igds(5)=Grid Definition Template Number (Code Table 3.1)
+C     igdstmpl() - Grid Definition Template values for GDT 3.igds(5)
+C     idefnum    - The number of entries in array ideflist.  
+C                  i.e. number of rows ( or columns )
+C                  for which optional grid points are defined.
+C     ideflist() - Optional integer array containing
+C                  the number of grid points contained in each row (or column).
+C
+C   OUTPUT ARGUMENT LIST:      (INCLUDING WORK ARRAYS)
+C     kgds()   - GRIB1 GDS as described in w3fi63 format.
+C     igrid    - NCEP predifined GRIB1 grid number
+C                set to 255, if not NCEP grid
+C     iret     - Error return value:
+C                  0  = Successful
+C                  1  = Unrecognized GRIB2 GDT number 3.igds(5)
+C
+C REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION
+C
+C ATTRIBUTES:
+C   LANGUAGE: INDICATE EXTENSIONS, COMPILER OPTIONS
+C   MACHINE:  IBM SP
+C
+C$$$
+! 
+        integer,intent(in) :: idefnum
+        integer,intent(in) :: igds(*),igdstmpl(*),ideflist(*)
+        integer,intent(out) :: kgds(*),igrid,iret
+
+        integer :: kgds72(200),kgds71(200),idum(200),jdum(200)
+
+        iret=0
+        if (igds(5).eq.0) then       !  Lat/Lon grid
+           kgds(1)=0
+           kgds(2)=igdstmpl(8)            ! Ni
+           kgds(3)=igdstmpl(9)            ! Nj
+           kgds(4)=igdstmpl(12)/1000      ! Lat of 1st grid point
+           kgds(5)=igdstmpl(13)/1000      ! Long of 1st grid point
+           kgds(6)=0                      ! resolution and component flags
+           if (igdstmpl(1)==2 ) kgds(6)=64
+           if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) 
+     &         kgds(6)=kgds(6)+128
+           if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8
+           kgds(7)=igdstmpl(15)/1000      ! Lat of last grid point
+           kgds(8)=igdstmpl(16)/1000      ! Long of last grid point
+           kgds(9)=igdstmpl(17)/1000      ! Di
+           kgds(10)=igdstmpl(18)/1000     ! Dj
+           kgds(11)=igdstmpl(19)          ! Scanning mode
+           kgds(12)=0
+           kgds(13)=0
+           kgds(14)=0
+           kgds(15)=0
+           kgds(16)=0
+           kgds(17)=0
+           kgds(18)=0
+           kgds(19)=0
+           kgds(20)=255
+           kgds(21)=0
+           kgds(22)=0
+           !
+           !  Process irreg grid stuff, if necessary
+           !
+           if ( idefnum.ne.0 ) then
+              if ( igdstmpl(8).eq.-1 ) then
+                 kgds(2)=65535
+                 kgds(9)=65535
+              endif
+              if ( igdstmpl(9).eq.-1 ) then
+                 kgds(3)=65535
+                 kgds(10)=65535
+              endif
+              kgds(19)=0
+              kgds(20)=33
+              if ( kgds(1).eq.1.OR.kgds(1).eq.3 ) kgds(20)=43
+              kgds(21)=igds(2)                   ! num of grid points
+              do j=1,idefnum
+                 kgds(21+j)=ideflist(j)
+              enddo
+           endif
+        elseif (igds(5).eq.10) then       !  Mercator grid
+           kgds(1)=1                 ! Grid Definition Template number
+           kgds(2)=igdstmpl(8)            ! Ni
+           kgds(3)=igdstmpl(9)            ! Nj
+           kgds(4)=igdstmpl(10)/1000      ! Lat of 1st grid point
+           kgds(5)=igdstmpl(11)/1000      ! Long of 1st grid point
+           kgds(6)=0                      ! resolution and component flags
+           if (igdstmpl(1)==2 ) kgds(6)=64
+           if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) 
+     &         kgds(6)=kgds(6)+128
+           if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8
+           kgds(7)=igdstmpl(14)/1000      ! Lat of last grid point
+           kgds(8)=igdstmpl(15)/1000      ! Long of last grid point
+           kgds(9)=igdstmpl(13)/1000      ! Lat intersects earth
+           kgds(10)=0
+           kgds(11)=igdstmpl(16)          ! Scanning mode
+           kgds(12)=igdstmpl(18)/1000     ! Di
+           kgds(13)=igdstmpl(19)/1000     ! Dj
+           kgds(14)=0
+           kgds(15)=0
+           kgds(16)=0
+           kgds(17)=0
+           kgds(18)=0
+           kgds(19)=0
+           kgds(20)=255
+           kgds(21)=0
+           kgds(22)=0
+        elseif (igds(5).eq.30) then       ! Lambert Conformal Grid
+           kgds(1)=3
+           kgds(2)=igdstmpl(8)            ! Nx
+           kgds(3)=igdstmpl(9)            ! Ny
+           kgds(4)=igdstmpl(10)/1000      ! Lat of 1st grid point
+           kgds(5)=igdstmpl(11)/1000      ! Long of 1st grid point
+           kgds(6)=0                      ! resolution and component flags
+           if (igdstmpl(1)==2 ) kgds(6)=64
+           if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) 
+     &         kgds(6)=kgds(6)+128
+           if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8
+           kgds(7)=igdstmpl(14)/1000      ! Lon of orientation
+           kgds(8)=igdstmpl(15)/1000      ! Dx
+           kgds(9)=igdstmpl(16)/1000      ! Dy
+           kgds(10)=igdstmpl(17)          ! Projection Center Flag
+           kgds(11)=igdstmpl(18)          ! Scanning mode
+           kgds(12)=igdstmpl(19)/1000     ! Lat in 1
+           kgds(13)=igdstmpl(20)/1000     ! Lat in 2
+           kgds(14)=igdstmpl(21)/1000     ! Lat of S. Pole of projection
+           kgds(15)=igdstmpl(22)/1000     ! Lon of S. Pole of projection
+           kgds(16)=0
+           kgds(17)=0
+           kgds(18)=0
+           kgds(19)=0
+           kgds(20)=255
+           kgds(21)=0
+           kgds(22)=0
+        elseif (igds(5).eq.40) then       !  Gaussian Lat/Lon grid
+           kgds(1)=4
+           kgds(2)=igdstmpl(8)            ! Ni
+           kgds(3)=igdstmpl(9)            ! Nj
+           kgds(4)=igdstmpl(12)/1000      ! Lat of 1st grid point
+           kgds(5)=igdstmpl(13)/1000      ! Long of 1st grid point
+           kgds(6)=0                      ! resolution and component flags
+           if (igdstmpl(1)==2 ) kgds(6)=64
+           if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) 
+     &         kgds(6)=kgds(6)+128
+           if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8
+           kgds(7)=igdstmpl(15)/1000      ! Lat of last grid point
+           kgds(8)=igdstmpl(16)/1000      ! Long of last grid point
+           kgds(9)=igdstmpl(17)/1000      ! Di
+           kgds(10)=igdstmpl(18)          ! N - Number of parallels
+           kgds(11)=igdstmpl(19)          ! Scanning mode
+           kgds(12)=0
+           kgds(13)=0
+           kgds(14)=0
+           kgds(15)=0
+           kgds(16)=0
+           kgds(17)=0
+           kgds(18)=0
+           kgds(19)=0
+           kgds(20)=255
+           kgds(21)=0
+           kgds(22)=0
+        elseif (igds(5).eq.20) then       ! Polar Stereographic Grid
+           kgds(1)=5
+           kgds(2)=igdstmpl(8)            ! Nx
+           kgds(3)=igdstmpl(9)            ! Ny
+           kgds(4)=igdstmpl(10)/1000      ! Lat of 1st grid point
+           kgds(5)=igdstmpl(11)/1000      ! Long of 1st grid point
+           kgds(6)=0                      ! resolution and component flags
+           if (igdstmpl(1)==2 ) kgds(6)=64
+           if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) 
+     &         kgds(6)=kgds(6)+128
+           if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8
+           kgds(7)=igdstmpl(14)/1000      ! Lon of orientation
+           kgds(8)=igdstmpl(15)/1000      ! Dx
+           kgds(9)=igdstmpl(16)/1000      ! Dy
+           kgds(10)=igdstmpl(17)          ! Projection Center Flag
+           kgds(11)=igdstmpl(18)          ! Scanning mode
+           kgds(12)=0
+           kgds(13)=0
+           kgds(14)=0
+           kgds(15)=0
+           kgds(16)=0
+           kgds(17)=0
+           kgds(18)=0
+           kgds(19)=0
+           kgds(20)=255
+           kgds(21)=0
+           kgds(22)=0
+        else
+           Print *,'gdt2gds: Unrecognized GRIB2 GDT = 3.',igds(5)
+           iret=1
+           kgds(1:22)=0
+           return
+        endif
+!
+!   Can we determine NCEP grid number ?
+!
+        igrid=255
+        do j=254,1,-1
+        !do j=225,225
+           kgds71=0
+           kgds72=0
+           call w3fi71(j,kgds71,ierr)
+           if ( ierr.ne.0 ) cycle
+           ! convert W to E for longitudes
+           if ( kgds71(3).eq.0 ) then    ! lat/lon
+              if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7)
+              if ( kgds71(10).lt.0 ) kgds71(10)=360000+kgds71(10)
+           elseif ( kgds71(3).eq.1 ) then    ! mercator
+              if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7)
+              if ( kgds71(10).lt.0 ) kgds71(10)=360000+kgds71(10)
+           elseif ( kgds71(3).eq.3 ) then     ! lambert conformal
+              if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7)
+              if ( kgds71(9).lt.0 ) kgds71(9)=360000+kgds71(9)
+              if ( kgds71(18).lt.0 ) kgds71(18)=360000+kgds71(18)
+           elseif ( kgds71(3).eq.4 ) then     ! Guassian lat/lon
+              if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7)
+              if ( kgds71(10).lt.0 ) kgds71(10)=360000+kgds71(10)
+           elseif ( kgds71(3).eq.5 ) then     ! polar stereographic
+              if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7)
+              if ( kgds71(9).lt.0 ) kgds71(9)=360000+kgds71(9)
+           endif
+           call r63w72(idum,kgds,jdum,kgds72)
+           if ( kgds72(3).eq.3 ) kgds72(14)=0    ! lambert conformal fix
+           if ( kgds72(3).eq.1 ) kgds72(15:18)=0    ! mercator fix
+           if ( kgds72(3).eq.5 ) kgds72(14:18)=0    ! polar str fix
+           !print *,'SAGT71:',(kgds71(k),k=1,30)
+           !print *,'SAGT72:',(kgds72(k),k=1,30)
+           if ( all(kgds71.eq.kgds72) ) then
+              igrid=j
+              return
+           endif
+        enddo
+
+        return
+        end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getdim.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getdim.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getdim.F	(revision 2744)
@@ -0,0 +1,102 @@
+      subroutine getdim(csec3,lcsec3,width,height,iscan)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getdim 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-12-11
+!
+! ABSTRACT: This subroutine returns the dimensions and scanning mode of 
+!   a grid definition packed in GRIB2 Grid Definition Section 3 format.
+!
+! PROGRAM HISTORY LOG:
+! 2002-12-11  Gilbert
+!
+! USAGE:    CALL getdim(csec3,lcsec3,width,height,iscan)
+!   INPUT ARGUMENT LIST:
+!     csec3    - Character array that contains the packed GRIB2 GDS
+!    lcsec3    - Length (in octets) of section 3
+!
+!   OUTPUT ARGUMENT LIST:      
+!     width    - x (or i) dimension of the grid.
+!     height   - y (or j) dimension of the grid.
+!     iscan    - Scanning mode ( see Code Table 3.4 )
+!
+! REMARKS:  Returns width and height set to zero, if grid template
+!           not recognized.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+!      use grib_mod
+    
+      character(len=1),intent(in) :: csec3(*)
+      integer,intent(in) :: lcsec3
+      integer,intent(out) :: width,height,iscan
+      
+      integer,pointer,dimension(:) :: igdstmpl,list_opt
+      integer :: igds(5)
+      integer iofst,igdtlen,num_opt,jerr
+
+      interface
+         subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,
+     &                         mapgridlen,ideflist,idefnum,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            integer,pointer,dimension(:) :: igdstmpl,ideflist
+            integer,intent(out) :: igds(5)
+            integer,intent(out) :: ierr,idefnum
+         end subroutine gf_unpack3
+      end interface
+
+      nullify(igdstmpl,list_opt)
+        !
+      iofst=0       ! set offset to beginning of section
+      call gf_unpack3(csec3,lcsec3,iofst,igds,igdstmpl,
+     &                 igdtlen,list_opt,num_opt,jerr)
+      if (jerr.eq.0) then
+         selectcase( igds(5) )     !  Template number
+           case (0:3)   ! Lat/Lon
+              width=igdstmpl(8)
+              height=igdstmpl(9)
+              iscan=igdstmpl(19)
+           case (10)   ! Mercator
+              width=igdstmpl(8)
+              height=igdstmpl(9)
+              iscan=igdstmpl(16)
+           case (20)   ! Polar Stereographic
+              width=igdstmpl(8)
+              height=igdstmpl(9)
+              iscan=igdstmpl(18)
+           case (30)   ! Lambert Conformal
+              width=igdstmpl(8)
+              height=igdstmpl(9)
+              iscan=igdstmpl(18)
+           case (40:43)   ! Gaussian
+              width=igdstmpl(8)
+              height=igdstmpl(9)
+              iscan=igdstmpl(19)
+           case (90)   ! Space View/Orthographic
+              width=igdstmpl(8)
+              height=igdstmpl(9)
+              iscan=igdstmpl(17)
+           case (110)   ! Equatorial Azimuthal
+              width=igdstmpl(8)
+              height=igdstmpl(9)
+              iscan=igdstmpl(16)
+           case default
+              width=0
+              height=0
+              iscan=0
+         end select
+      else
+         width=0
+         height=0
+      endif
+        !
+      if (associated(igdstmpl)) deallocate(igdstmpl)
+      if (associated(list_opt)) deallocate(list_opt)
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getfield.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getfield.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getfield.F	(revision 2744)
@@ -0,0 +1,823 @@
+      subroutine getfield(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen,
+     &                    ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen,
+     &                    coordlist,numcoord,ndpts,idrsnum,idrstmpl,
+     &                    idrslen,ibmap,bmap,fld,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getfield 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine returns the Grid Definition, Product Definition,
+!   Bit-map ( if applicable ), and the unpacked data for a given data
+!   field.  Since there can be multiple data fields packed into a GRIB2
+!   message, the calling routine indicates which field is being requested
+!   with the ifldnum argument.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+!
+! USAGE:    CALL getfield(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen,
+!    &                    ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen,
+!    &                    coordlist,numcoord,ndpts,idrsnum,idrstmpl,
+!    &                    idrslen,ibmap,bmap,fld,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     ifldnum  - Specifies which field in the GRIB2 message to return.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     igds     - Contains information read from the appropriate GRIB Grid 
+!                Definition Section 3 for the field being returned.
+!                Must be dimensioned >= 5.
+!                igds(1)=Source of grid definition (see Code Table 3.0)
+!                igds(2)=Number of grid points in the defined grid.
+!                igds(3)=Number of octets needed for each 
+!                            additional grid points definition.  
+!                            Used to define number of
+!                            points in each row ( or column ) for
+!                            non-regular grids.  
+!                            = 0, if using regular grid.
+!                igds(4)=Interpretation of list for optional points 
+!                            definition.  (Code Table 3.11)
+!                igds(5)=Grid Definition Template Number (Code Table 3.1)
+!     igdstmpl - Contains the data values for the specified Grid Definition
+!                Template ( NN=igds(5) ).  Each element of this integer 
+!                array contains an entry (in the order specified) of Grid
+!                Defintion Template 3.NN
+!                A safe dimension for this array can be obtained in advance
+!                from maxvals(2), which is returned from subroutine gribinfo.
+!     igdslen  - Number of elements in igdstmpl().  i.e. number of entries
+!                in Grid Defintion Template 3.NN  ( NN=igds(5) ).
+!     ideflist - (Used if igds(3) .ne. 0)  This array contains the
+!                number of grid points contained in each row ( or column ).
+!                (part of Section 3)
+!                A safe dimension for this array can be obtained in advance
+!                from maxvals(3), which is returned from subroutine gribinfo.
+!     idefnum  - (Used if igds(3) .ne. 0)  The number of entries
+!                in array ideflist.  i.e. number of rows ( or columns )
+!                for which optional grid points are defined.
+!     ipdsnum  - Product Definition Template Number ( see Code Table 4.0)
+!     ipdstmpl - Contains the data values for the specified Product Definition
+!                Template ( N=ipdsnum ).  Each element of this integer
+!                array contains an entry (in the order specified) of Product
+!                Defintion Template 4.N
+!                A safe dimension for this array can be obtained in advance
+!                from maxvals(4), which is returned from subroutine gribinfo.
+!     ipdslen  - Number of elements in ipdstmpl().  i.e. number of entries
+!                in Product Defintion Template 4.N  ( N=ipdsnum ).
+!     coordlist- Array containg floating point values intended to document
+!                the vertical discretisation associated to model data
+!                on hybrid coordinate vertical levels.  (part of Section 4)
+!                The dimension of this array can be obtained in advance
+!                from maxvals(5), which is returned from subroutine gribinfo.
+!     numcoord - number of values in array coordlist.
+!     ndpts    - Number of data points unpacked and returned.
+!     idrsnum  - Data Representation Template Number ( see Code Table 5.0)
+!     idrstmpl - Contains the data values for the specified Data Representation
+!                Template ( N=idrsnum ).  Each element of this integer
+!                array contains an entry (in the order specified) of Product
+!                Defintion Template 5.N
+!                A safe dimension for this array can be obtained in advance
+!                from maxvals(6), which is returned from subroutine gribinfo.
+!     idrslen  - Number of elements in idrstmpl().  i.e. number of entries
+!                in Data Representation Template 5.N  ( N=idrsnum ).
+!     ibmap    - Bitmap indicator ( see Code Table 6.0 )
+!                0 = bitmap applies and is included in Section 6.
+!                1-253 = Predefined bitmap applies
+!                254 = Previously defined bitmap applies to this field
+!                255 = Bit map does not apply to this product.
+!     bmap()   - Logical*1 array containing decoded bitmap. ( if ibmap=0 )
+!                The dimension of this array can be obtained in advance
+!                from maxvals(7), which is returned from subroutine gribinfo.
+!     fld()    - Array of ndpts unpacked data points.
+!                A safe dimension for this array can be obtained in advance
+!                from maxvals(7), which is returned from subroutine gribinfo.
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Beginning characters "GRIB" not found.
+!                2 = GRIB message is not Edition 2.
+!                3 = The data field request number was not positive.
+!                4 = End string "7777" found, but not where expected.
+!                6 = GRIB message did not contain the requested number of
+!                    data fields.
+!                7 = End string "7777" not found at end of message.
+!                9 = Data Representation Template 5.NN not yet implemented.
+!               10 = Error unpacking Section 3.
+!               11 = Error unpacking Section 4.
+!               12 = Error unpacking Section 5.
+!               13 = Error unpacking Section 6.
+!               14 = Error unpacking Section 7.
+!
+! REMARKS: Note that subroutine gribinfo can be used to first determine
+!          how many data fields exist in a given GRIB message.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib,ifldnum
+      integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*)
+      integer,intent(out) :: ipdsnum,ipdstmpl(*)
+      integer,intent(out) :: idrsnum,idrstmpl(*)
+      integer,intent(out) :: ndpts,ibmap,idefnum,numcoord
+      integer,intent(out) :: ierr
+      logical*1,intent(out) :: bmap(*)
+      real,intent(out) :: fld(*),coordlist(*)
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4) :: ctemp
+      integer:: listsec0(2)
+      integer iofst,ibeg,istart
+      integer(4) :: ieee
+      logical have3,have4,have5,have6,have7
+
+      have3=.false.
+      have4=.false.
+      have5=.false.
+      have6=.false.
+      have7=.false.
+      ierr=0
+      numfld=0
+!
+!  Check for valid request number
+!  
+      if (ifldnum.le.0) then
+        print *,'getfield: Request for field number must be positive.'
+        ierr=3
+        return
+      endif
+!
+!  Check for beginning of GRIB message in the first 100 bytes
+!
+      istart=0
+      do j=1,100
+        ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
+        if (ctemp.eq.grib ) then
+          istart=j
+          exit
+        endif
+      enddo
+      if (istart.eq.0) then
+        print *,'getfield:  Beginning characters GRIB not found.'
+        ierr=1
+        return
+      endif
+!
+!  Unpack Section 0 - Indicator Section 
+!
+      iofst=8*(istart+5)
+      call g2lib_gbyte(cgrib,listsec0(1),iofst,8)     ! Discipline
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,listsec0(2),iofst,8)     ! GRIB edition number
+      iofst=iofst+8
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,lengrib,iofst,32)        ! Length of GRIB message
+      iofst=iofst+32
+      lensec0=16
+      ipos=istart+lensec0
+!
+!  Currently handles only GRIB Edition 2.
+!  
+      if (listsec0(2).ne.2) then
+        print *,'getfield: can only decode GRIB edition 2.'
+        ierr=2
+        return
+      endif
+!
+!  Loop through the remaining sections keeping track of the 
+!  length of each.  Also keep the latest Grid Definition Section info.
+!  Unpack the requested field number.
+!
+      do
+        !    Check to see if we are at end of GRIB message
+        ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
+        if (ctemp.eq.c7777 ) then
+          ipos=ipos+4
+          !    If end of GRIB message not where expected, issue error
+          if (ipos.ne.(istart+lengrib)) then
+            print *,'getfield: "7777" found, but not where expected.'
+            ierr=4
+            return
+          endif
+          exit
+        endif
+        !     Get length of Section and Section number
+        iofst=(ipos-1)*8
+        call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Get Section number
+        iofst=iofst+8
+        !print *,' lensec= ',lensec,'    secnum= ',isecnum
+        !
+        !   If found Section 3, unpack the GDS info using the 
+        !   appropriate template.  Save in case this is the latest
+        !   grid before the requested field.
+        !
+        if (isecnum.eq.3) then
+          iofst=iofst-40       ! reset offset to beginning of section
+          call unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,igdslen,
+     &                 ideflist,idefnum,jerr)
+          if (jerr.eq.0) then
+            have3=.true.
+          else
+            ierr=10
+            return
+          endif
+        endif
+        !
+        !   If found Section 4, check to see if this field is the
+        !   one requested.
+        !
+        if (isecnum.eq.4) then
+          numfld=numfld+1
+          if (numfld.eq.ifldnum) then
+            iofst=iofst-40       ! reset offset to beginning of section
+            call unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,ipdslen,
+     &                   coordlist,numcoord,jerr)
+            if (jerr.eq.0) then
+              have4=.true.
+            else
+              ierr=11
+              return
+            endif
+          endif
+        endif
+        !
+        !   If found Section 5, check to see if this field is the
+        !   one requested.
+        !
+        if ((isecnum.eq.5).and.(numfld.eq.ifldnum)) then
+          iofst=iofst-40       ! reset offset to beginning of section
+          call unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl,
+     &                 idrslen,jerr)
+          if (jerr.eq.0) then
+            have5=.true.
+          else
+            ierr=12
+            return
+          endif
+        endif
+        !
+        !   If found Section 6, Unpack bitmap.
+        !   Save in case this is the latest
+        !   bitmap before the requested field.
+        !
+        if (isecnum.eq.6) then
+          iofst=iofst-40       ! reset offset to beginning of section
+          call unpack6(cgrib,lcgrib,iofst,igds(2),ibmap,bmap,jerr)
+          if (jerr.eq.0) then
+            have6=.true.
+          else
+            ierr=13
+            return
+          endif
+        endif
+        !
+        !   If found Section 7, check to see if this field is the
+        !   one requested.
+        !
+        if ((isecnum.eq.7).and.(numfld.eq.ifldnum)) then
+          if (idrsnum.eq.0) then
+            call simunpack(cgrib(ipos+5),lensec-6,idrstmpl,ndpts,fld)
+            have7=.true.
+          elseif (idrsnum.eq.2.or.idrsnum.eq.3) then
+            call comunpack(cgrib(ipos+5),lensec-6,lensec,idrsnum,
+     &                     idrstmpl,ndpts,fld,ier)
+            if ( ier .ne. 0 ) then
+                ierr=14
+                return
+            endif
+            have7=.true.
+          elseif (idrsnum.eq.50) then
+            call simunpack(cgrib(ipos+5),lensec-6,idrstmpl,ndpts-1,
+     &                     fld(2))
+            ieee=idrstmpl(5)
+            call rdieee(ieee,fld(1),1)
+            have7=.true.
+          else
+            print *,'getfield: Data Representation Template ',idrsnum,
+     &              ' not yet implemented.'
+            ierr=9
+            return
+          endif
+        endif
+        !
+        !   Check to see if we read pass the end of the GRIB
+        !   message and missed the terminator string '7777'.
+        !
+        ipos=ipos+lensec                 ! Update beginning of section pointer
+        if (ipos.gt.(istart+lengrib)) then
+          print *,'getfield: "7777"  not found at end of GRIB message.'
+          ierr=7
+          return
+        endif
+
+        if (have3.and.have4.and.have5.and.have6.and.have7) return
+        
+      enddo
+
+!
+!  If exited from above loop, the end of the GRIB message was reached
+!  before the requested field was found.
+!
+      print *,'getfield: GRIB message contained ',numlocal,
+     &        ' different fields.'
+      print *,'getfield: The request was for the ',ifldnum,
+     &        ' field.'
+      ierr=6
+
+      return
+      end
+
+
+      subroutine unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,
+     &                   mapgridlen,ideflist,idefnum,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    unpack3 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine unpacks Section 3 (Grid Definition Section)
+!   starting at octet 6 of that Section.  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+!
+! USAGE:    CALL unpack3(cgrib,lcgrib,lensec,iofst,igds,igdstmpl,
+!    &                   mapgridlen,ideflist,idefnum,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 3.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset at the end of Section 3, returned.
+!     igds     - Contains information read from the appropriate GRIB Grid 
+!                Definition Section 3 for the field being returned.
+!                Must be dimensioned >= 5.
+!                igds(1)=Source of grid definition (see Code Table 3.0)
+!                igds(2)=Number of grid points in the defined grid.
+!                igds(3)=Number of octets needed for each 
+!                            additional grid points definition.  
+!                            Used to define number of
+!                            points in each row ( or column ) for
+!                            non-regular grids.  
+!                            = 0, if using regular grid.
+!                igds(4)=Interpretation of list for optional points 
+!                            definition.  (Code Table 3.11)
+!                igds(5)=Grid Definition Template Number (Code Table 3.1)
+!     igdstmpl - Contains the data values for the specified Grid Definition
+!                Template ( NN=igds(5) ).  Each element of this integer 
+!                array contains an entry (in the order specified) of Grid
+!                Defintion Template 3.NN
+!     mapgridlen- Number of elements in igdstmpl().  i.e. number of entries
+!                in Grid Defintion Template 3.NN  ( NN=igds(5) ).
+!     ideflist - (Used if igds(3) .ne. 0)  This array contains the
+!                number of grid points contained in each row ( or column ).
+!                (part of Section 3)
+!     idefnum  - (Used if igds(3) .ne. 0)  The number of entries
+!                in array ideflist.  i.e. number of rows ( or columns )
+!                for which optional grid points are defined.
+!     ierr     - Error return code.
+!                0 = no error
+!                5 = "GRIB" message contains an undefined Grid Definition
+!                    Template.
+!
+! REMARKS: Uses Fortran 90 module gridtemplates.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      use gridtemplates
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(inout) :: iofst
+      integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*)
+      integer,intent(out) :: ierr,idefnum
+
+      integer,allocatable :: mapgrid(:)
+      integer :: mapgridlen,ibyttem
+      logical needext
+
+      ierr=0
+
+      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+      iofst=iofst+32
+      iofst=iofst+8     ! skip section number
+
+      call g2lib_gbyte(cgrib,igds(1),iofst,8)     ! Get source of Grid def.
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,igds(2),iofst,32)    ! Get number of grid pts.
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,igds(3),iofst,8)     ! Get num octets for opt. list
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,igds(4),iofst,8)     ! Get interpret. for opt. list
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,igds(5),iofst,16)    ! Get Grid Def Template num.
+      iofst=iofst+16
+      if (igds(1).eq.0) then
+!      if (igds(1).eq.0.OR.igds(1).eq.255) then  ! FOR ECMWF TEST ONLY
+        allocate(mapgrid(lensec))
+        !   Get Grid Definition Template
+        call getgridtemplate(igds(5),mapgridlen,mapgrid,needext,
+     &                       iret)
+        if (iret.ne.0) then
+          ierr=5
+          return
+        endif
+      else
+!        igdstmpl=-1
+        mapgridlen=0
+        needext=.false.
+      endif
+      !
+      !   Unpack each value into array igdstmpl from the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mapgrid.
+      !
+      ibyttem=0
+      do i=1,mapgridlen
+        nbits=iabs(mapgrid(i))*8
+        if ( mapgrid(i).ge.0 ) then
+          call g2lib_gbyte(cgrib,igdstmpl(i),iofst,nbits)
+        else
+          call g2lib_gbyte(cgrib,isign,iofst,1)
+          call g2lib_gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1)
+          if (isign.eq.1) igdstmpl(i)=-igdstmpl(i)
+        endif
+        iofst=iofst+nbits
+        ibyttem=ibyttem+iabs(mapgrid(i))
+      enddo
+      !
+      !   Check to see if the Grid Definition Template needs to be
+      !   extended.
+      !   The number of values in a specific template may vary
+      !   depending on data specified in the "static" part of the
+      !   template.
+      !
+      if ( needext ) then
+        call extgridtemplate(igds(5),igdstmpl,newmapgridlen,mapgrid)
+        !   Unpack the rest of the Grid Definition Template
+        do i=mapgridlen+1,newmapgridlen
+          nbits=iabs(mapgrid(i))*8
+          if ( mapgrid(i).ge.0 ) then
+            call g2lib_gbyte(cgrib,igdstmpl(i),iofst,nbits)
+          else
+            call g2lib_gbyte(cgrib,isign,iofst,1)
+            call g2lib_gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1)
+            if (isign.eq.1) igdstmpl(i)=-igdstmpl(i)
+          endif
+          iofst=iofst+nbits
+          ibyttem=ibyttem+iabs(mapgrid(i))
+        enddo
+        mapgridlen=newmapgridlen
+      endif
+      !
+      !   Unpack optional list of numbers defining number of points
+      !   in each row or column, if included.  This is used for non regular
+      !   grids.
+      !
+      if ( igds(3).ne.0 ) then
+         nbits=igds(3)*8
+         idefnum=(lensec-14-ibyttem)/igds(3)
+         call g2lib_gbytes(cgrib,ideflist,iofst,nbits,0,idefnum)
+         iofst=iofst+(nbits*idefnum)
+      else
+         idefnum=0
+      endif
+      if( allocated(mapgrid) ) deallocate(mapgrid)
+      return    ! End of Section 3 processing
+      end
+
+
+      subroutine unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,mappdslen,
+     &                   coordlist,numcoord,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    unpack4 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine unpacks Section 4 (Product Definition Section)
+!   starting at octet 6 of that Section.  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+!
+! USAGE:    CALL unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,mappdslen,
+!    &                   coordlist,numcoord,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 4.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset of the end of Section 4, returned.
+!     ipdsnum  - Product Definition Template Number ( see Code Table 4.0)
+!     ipdstmpl - Contains the data values for the specified Product Definition
+!                Template ( N=ipdsnum ).  Each element of this integer
+!                array contains an entry (in the order specified) of Product
+!                Defintion Template 4.N
+!     mappdslen- Number of elements in ipdstmpl().  i.e. number of entries
+!                in Product Defintion Template 4.N  ( N=ipdsnum ).
+!     coordlist- Array containg floating point values intended to document
+!                the vertical discretisation associated to model data
+!                on hybrid coordinate vertical levels.  (part of Section 4)
+!     numcoord - number of values in array coordlist.
+!     ierr     - Error return code.
+!                0 = no error
+!                5 = "GRIB" message contains an undefined Product Definition
+!                    Template.
+!
+! REMARKS: Uses Fortran 90 module pdstemplates.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      use pdstemplates
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(inout) :: iofst
+      real,intent(out) :: coordlist(*)
+      integer,intent(out) :: ipdsnum,ipdstmpl(*)
+      integer,intent(out) :: ierr,numcoord
+
+      real(4),allocatable :: coordieee(:)
+      integer,allocatable :: mappds(:)
+      integer :: mappdslen
+      logical needext
+
+      ierr=0
+
+      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+      iofst=iofst+32
+      iofst=iofst+8     ! skip section number
+      allocate(mappds(lensec))
+
+      call g2lib_gbyte(cgrib,numcoord,iofst,16)    ! Get num of coordinate values
+      iofst=iofst+16
+      call g2lib_gbyte(cgrib,ipdsnum,iofst,16)    ! Get Prod. Def Template num.
+      iofst=iofst+16
+      !   Get Product Definition Template
+      call getpdstemplate(ipdsnum,mappdslen,mappds,needext,iret)
+      if (iret.ne.0) then
+        ierr=5
+        return
+      endif
+      !
+      !   Unpack each value into array ipdstmpl from the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mappds.
+      !
+      do i=1,mappdslen
+        nbits=iabs(mappds(i))*8
+        if ( mappds(i).ge.0 ) then
+          call g2lib_gbyte(cgrib,ipdstmpl(i),iofst,nbits)
+        else
+          call g2lib_gbyte(cgrib,isign,iofst,1)
+          call g2lib_gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1)
+          if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i)
+        endif
+        iofst=iofst+nbits
+      enddo
+      !
+      !   Check to see if the Product Definition Template needs to be
+      !   extended.
+      !   The number of values in a specific template may vary
+      !   depending on data specified in the "static" part of the
+      !   template.
+      !
+      if ( needext ) then
+        call extpdstemplate(ipdsnum,ipdstmpl,newmappdslen,mappds)
+        !   Unpack the rest of the Product Definition Template
+        do i=mappdslen+1,newmappdslen
+          nbits=iabs(mappds(i))*8
+          if ( mappds(i).ge.0 ) then
+            call g2lib_gbyte(cgrib,ipdstmpl(i),iofst,nbits)
+          else
+            call g2lib_gbyte(cgrib,isign,iofst,1)
+            call g2lib_gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1)
+            if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i)
+          endif
+          iofst=iofst+nbits
+        enddo
+        mappdslen=newmappdslen
+      endif
+      !
+      !   Get Optional list of vertical coordinate values
+      !   after the Product Definition Template, if necessary.
+      !
+      if ( numcoord .ne. 0 ) then
+        allocate (coordieee(numcoord))
+        call g2lib_gbytes(cgrib,coordieee,iofst,32,0,numcoord)
+        call rdieee(coordieee,coordlist,numcoord)
+        deallocate (coordieee)
+        iofst=iofst+(32*numcoord)
+      endif
+      if( allocated(mappds) ) deallocate(mappds)
+      return    ! End of Section 4 processing
+      end
+
+
+      subroutine unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl,
+     &                   mapdrslen,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    unpack5 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine unpacks Section 5 (Data Representation Section)
+!   starting at octet 6 of that Section.  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+!
+! USAGE:    CALL unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl,
+!                        mapdrslen,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 5.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset at the end of Section 5, returned.
+!     ndpts    - Number of data points unpacked and returned.
+!     idrsnum  - Data Representation Template Number ( see Code Table 5.0)
+!     idrstmpl - Contains the data values for the specified Data Representation
+!                Template ( N=idrsnum ).  Each element of this integer
+!                array contains an entry (in the order specified) of Data
+!                Representation Template 5.N
+!     mapdrslen- Number of elements in idrstmpl().  i.e. number of entries
+!                in Data Representation Template 5.N  ( N=idrsnum ).
+!     ierr     - Error return code.
+!                0 = no error
+!                7 = "GRIB" message contains an undefined Data
+!                    Representation Template.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      use drstemplates
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(inout) :: iofst
+      integer,intent(out) :: ndpts,idrsnum,idrstmpl(*)
+      integer,intent(out) :: ierr
+
+C      integer,allocatable :: mapdrs(:)
+      integer,allocatable :: mapdrs(:)
+      integer :: mapdrslen
+      logical needext
+
+      ierr=0
+
+      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+      iofst=iofst+32
+      iofst=iofst+8     ! skip section number
+      allocate(mapdrs(lensec))
+
+      call g2lib_gbyte(cgrib,ndpts,iofst,32)    ! Get num of data points
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,idrsnum,iofst,16)     ! Get Data Rep Template Num.
+      iofst=iofst+16
+      !   Gen Data Representation Template
+      call getdrstemplate(idrsnum,mapdrslen,mapdrs,needext,iret)
+      if (iret.ne.0) then
+        ierr=7
+        return
+      endif
+      !
+      !   Unpack each value into array ipdstmpl from the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mappds.
+      !
+      do i=1,mapdrslen
+        nbits=iabs(mapdrs(i))*8
+        if ( mapdrs(i).ge.0 ) then
+          call g2lib_gbyte(cgrib,idrstmpl(i),iofst,nbits)
+        else
+          call g2lib_gbyte(cgrib,isign,iofst,1)
+          call g2lib_gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1)
+          if (isign.eq.1) idrstmpl(i)=-idrstmpl(i)
+        endif
+        iofst=iofst+nbits
+      enddo
+      !
+      !   Check to see if the Data Representation Template needs to be
+      !   extended.
+      !   The number of values in a specific template may vary
+      !   depending on data specified in the "static" part of the
+      !   template.
+      !
+      if ( needext ) then
+        call extdrstemplate(idrsnum,idrstmpl,newmapdrslen,mapdrs)
+        !   Unpack the rest of the Data Representation Template
+        do i=mapdrslen+1,newmapdrslen
+          nbits=iabs(mapdrs(i))*8
+          if ( mapdrs(i).ge.0 ) then
+            call g2lib_gbyte(cgrib,idrstmpl(i),iofst,nbits)
+          else
+            call g2lib_gbyte(cgrib,isign,iofst,1)
+            call g2lib_gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1)
+            if (isign.eq.1) idrstmpl(i)=-idrstmpl(i)
+          endif
+          iofst=iofst+nbits
+        enddo
+        mapdrslen=newmapdrslen
+      endif
+      if( allocated(mapdrs) ) deallocate(mapdrs)
+      return    ! End of Section 5 processing
+      end
+
+
+      subroutine unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    unpack6 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine unpacks Section 6 (Bit-Map Section)
+!   starting at octet 6 of that Section.  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+!
+! USAGE:    CALL unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 6.
+!     ngpts    - Number of grid points specified in the bit-map
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset at the end of Section 6, returned.
+!     ibmap    - Bitmap indicator ( see Code Table 6.0 )
+!                0 = bitmap applies and is included in Section 6.
+!                1-253 = Predefined bitmap applies
+!                254 = Previously defined bitmap applies to this field
+!                255 = Bit map does not apply to this product.
+!     bmap()   - Logical*1 array containing decoded bitmap. ( if ibmap=0 )
+!     ierr     - Error return code.
+!                0 = no error
+!                4 = Unrecognized pre-defined bit-map.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib,ngpts
+      integer,intent(inout) :: iofst
+      integer,intent(out) :: ibmap
+      integer,intent(out) :: ierr
+      logical*1,intent(out) :: bmap(ngpts)
+
+      integer :: intbmap(ngpts)
+
+      ierr=0
+
+      iofst=iofst+32    ! skip Length of Section
+      iofst=iofst+8     ! skip section number
+
+      call g2lib_gbyte(cgrib,ibmap,iofst,8)    ! Get bit-map indicator
+      iofst=iofst+8
+
+      if (ibmap.eq.0) then               ! Unpack bitmap
+        call g2lib_gbytes(cgrib,intbmap,iofst,1,0,ngpts)
+        iofst=iofst+ngpts
+        do j=1,ngpts
+          bmap(j)=.true.
+          if (intbmap(j).eq.0) bmap(j)=.false.
+        enddo
+      elseif (ibmap.eq.254) then               ! Use previous bitmap
+        return
+      elseif (ibmap.eq.255) then               ! No bitmap in message
+        bmap(1:ngpts)=.true.
+      else
+        print *,'unpack6: Predefined bitmap ',ibmap,' not recognized.'
+        ierr=4
+      endif
+      
+      return    ! End of Section 6 processing
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getg2i.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getg2i.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getg2i.F	(revision 2744)
@@ -0,0 +1,93 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: GETG2I          READS A GRIB2 INDEX FILE
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 95-10-31
+C
+C ABSTRACT: READ A GRIB2 INDEX FILE AND RETURN ITS CONTENTS.
+C   VERSION 1 OF THE INDEX FILE HAS THE FOLLOWING FORMAT:
+C     81-BYTE S.LORD HEADER WITH 'GB2IX1' IN COLUMNS 42-47 FOLLOWED BY
+C     81-BYTE HEADER WITH NUMBER OF BYTES TO SKIP BEFORE INDEX RECORDS,
+C     TOTAL LENGTH IN BYTES OF THE INDEX RECORDS, NUMBER OF INDEX RECORDS,
+C     AND GRIB FILE BASENAME WRITTEN IN FORMAT ('IX1FORM:',3I10,2X,A40).
+C     EACH FOLLOWING INDEX RECORD CORRESPONDS TO A GRIB MESSAGE
+C     AND HAS THE INTERNAL FORMAT:
+C       BYTE 001 - 004: LENGTH OF INDEX RECORD
+C       BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
+C       BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
+C                       SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
+C       BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
+C       BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
+C       BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
+C       BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
+C       BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
+C       BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
+C       BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
+C       BYTE 042 - 042: MESSAGE DISCIPLINE
+C       BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
+C       BYTE 045 -  II: IDENTIFICATION SECTION (IDS)
+C       BYTE II+1-  JJ: GRID DEFINITION SECTION (GDS)
+C       BYTE JJ+1-  KK: PRODUCT DEFINITION SECTION (PDS)
+C       BYTE KK+1-  LL: THE DATA REPRESENTATION SECTION (DRS)
+C       BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
+C
+C PROGRAM HISTORY LOG:
+C   95-10-31  IREDELL
+C   96-10-31  IREDELL   AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
+C 2002-01-03  GILBERT   MODIFIED FROM GETGI TO WORK WITH GRIB2 
+C
+C USAGE:    CALL GETG2I(LUGI,CBUF,NLEN,NNUM,IRET)
+C   INPUT ARGUMENTS:
+C     LUGI         INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE
+C   OUTPUT ARGUMENTS:
+C     CBUF         CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
+C                  USERS SHOULD FREE MEMORY THAT CBUF POINTS TO
+C                  USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED.
+C     NLEN         INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
+C     NNUM         INTEGER NUMBER OF INDEX RECORDS
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    2      NOT ENOUGH MEMORY TO HOLD INDEX BUFFER
+C                    3      ERROR READING INDEX FILE BUFFER
+C                    4      ERROR READING INDEX FILE HEADER
+C
+C SUBPROGRAMS CALLED:
+C   BAREAD         BYTE-ADDRESSABLE READ
+C
+C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
+C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+      INTEGER,INTENT(IN) :: LUGI
+      INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET
+      CHARACTER CHEAD*162
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IF (ASSOCIATED(CBUF)) NULLIFY(CBUF)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      NLEN=0
+      NNUM=0
+      IRET=4
+      CALL BAREAD(LUGI,0,162,LHEAD,CHEAD)
+      IF(LHEAD.EQ.162.AND.CHEAD(42:47).EQ.'GB2IX1') THEN
+        READ(CHEAD(82:162),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM
+        IF(IOS.EQ.0) THEN
+          
+          ALLOCATE(CBUF(NLEN),STAT=ISTAT)    ! ALLOCATE SPACE FOR CBUF
+          IF (ISTAT.NE.0) THEN
+             IRET=2
+             RETURN
+          ENDIF
+          IRET=0
+          CALL BAREAD(LUGI,NSKP,NLEN,LBUF,CBUF)
+          IF(LBUF.NE.NLEN) IRET=3
+
+        ENDIF
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getg2ir.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getg2ir.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getg2ir.F	(revision 2744)
@@ -0,0 +1,138 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,NMESS,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: GETG2IR        CREATES AN INDEX OF A GRIB2 FILE
+C   PRGMMR: GILBERT          ORG: W/NP11      DATE: 2002-01-02
+C
+C ABSTRACT: READ A GRIB FILE AND RETURN ITS INDEX CONTENTS.
+C   THE INDEX BUFFER RETURNED CONTAINS INDEX RECORDS WITH THE INTERNAL FORMAT:
+C       BYTE 001 - 004: LENGTH OF INDEX RECORD
+C       BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
+C       BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
+C                       SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
+C       BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
+C       BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
+C       BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
+C       BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
+C       BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
+C       BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
+C       BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
+C       BYTE 042 - 042: MESSAGE DISCIPLINE
+C       BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
+C       BYTE 045 -  II: IDENTIFICATION SECTION (IDS)
+C       BYTE II+1-  JJ: GRID DEFINITION SECTION (GDS)
+C       BYTE JJ+1-  KK: PRODUCT DEFINITION SECTION (PDS)
+C       BYTE KK+1-  LL: THE DATA REPRESENTATION SECTION (DRS)
+C       BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
+C
+C PROGRAM HISTORY LOG:
+C   95-10-31  IREDELL
+C   96-10-31  IREDELL   AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
+C 2002-01-02  GILBERT   MODIFIED FROM GETGIR TO CREATE GRIB2 INDEXES
+C
+C USAGE:    CALL GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,NMESS,IRET)
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB FILE
+C     MSK1         INTEGER NUMBER OF BYTES TO SEARCH FOR FIRST MESSAGE
+C     MSK2         INTEGER NUMBER OF BYTES TO SEARCH FOR OTHER MESSAGES
+C     MNUM         INTEGER NUMBER OF GRIB MESSAGES TO SKIP (USUALLY 0)
+C   OUTPUT ARGUMENTS:
+C     CBUF         CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
+C                  USERS SHOULD FREE MEMORY THAT CBUF POINTS TO
+C                  USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED.
+C     NLEN         INTEGER TOTAL LENGTH OF INDEX RECORD BUFFER IN BYTES
+C     NNUM         INTEGER NUMBER OF INDEX RECORDS
+C                  (=0 IF NO GRIB MESSAGES ARE FOUND)
+C     NMESS        LAST GRIB MESSAGE IN FILE SUCCESSFULLY PROCESSED
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    1      NOT ENOUGH MEMORY AVAILABLE TO HOLD FULL INDEX 
+C                           BUFFER
+C                    2      NOT ENOUGH MEMORY TO ALLOCATE INITIAL INDEX BUFFER
+C
+C SUBPROGRAMS CALLED:
+C   SKGB           SEEK NEXT GRIB MESSAGE
+C   IXGB2          MAKE INDEX RECORD
+C
+C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
+C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE RE_ALLOC          ! NEEDED FOR SUBROUTINE REALLOC
+      PARAMETER(INIT=50000,NEXT=10000)
+      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+      INTEGER,INTENT(IN) :: LUGB,MSK1,MSK2,MNUM
+      INTEGER,INTENT(OUT) :: NLEN,NNUM,NMESS,IRET
+      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUFTMP
+      INTERFACE      ! REQUIRED FOR CBUF POINTER
+         SUBROUTINE IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET)
+           INTEGER,INTENT(IN) :: LUGB,LSKIP,LGRIB
+           CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+           INTEGER,INTENT(OUT) :: NUMFLD,MLEN,IRET
+         END SUBROUTINE IXGB2
+      END INTERFACE
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  INITIALIZE
+      IRET=0
+      IF (ASSOCIATED(CBUF)) NULLIFY(CBUF)
+      MBUF=INIT
+      ALLOCATE(CBUF(MBUF),STAT=ISTAT)    ! ALLOCATE INITIAL SPACE FOR CBUF
+      IF (ISTAT.NE.0) THEN
+         IRET=2
+         RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  SEARCH FOR FIRST GRIB MESSAGE
+      ISEEK=0
+      CALL SKGB(LUGB,ISEEK,MSK1,LSKIP,LGRIB)
+      DO M=1,MNUM
+        IF(LGRIB.GT.0) THEN
+          ISEEK=LSKIP+LGRIB
+          CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB)
+        ENDIF
+      ENDDO
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  GET INDEX RECORDS FOR EVERY GRIB MESSAGE FOUND
+      NLEN=0
+      NNUM=0
+      NMESS=MNUM
+      DOWHILE(IRET.EQ.0.AND.LGRIB.GT.0)
+        CALL IXGB2(LUGB,LSKIP,LGRIB,CBUFTMP,NUMFLD,NBYTES,IRET1)
+        IF (IRET1.NE.0) PRINT *,' SAGT ',NUMFLD,NBYTES,IRET1
+        IF((NBYTES+NLEN).GT.MBUF) THEN             ! ALLOCATE MORE SPACE, IF
+                                                   ! NECESSARY
+           NEWSIZE=MAX(MBUF+NEXT,MBUF+NBYTES)
+           CALL REALLOC(CBUF,NLEN,NEWSIZE,ISTAT)
+           IF ( ISTAT .NE. 0 ) THEN
+              IRET=1
+              RETURN
+           ENDIF
+           MBUF=NEWSIZE
+        ENDIF
+        !
+        !  IF INDEX RECORDS WERE RETURNED IN CBUFTMP FROM IXGB2,
+        !  COPY CBUFTMP INTO CBUF, THEN DEALLOCATE CBUFTMP WHEN DONE
+        !
+        IF ( ASSOCIATED(CBUFTMP) ) THEN
+           CBUF(NLEN+1:NLEN+NBYTES)=CBUFTMP(1:NBYTES)
+           DEALLOCATE(CBUFTMP,STAT=ISTAT)
+           IF (ISTAT.NE.0) THEN
+             PRINT *,' deallocating cbuftmp ... ',istat
+             stop 99
+           ENDIF
+           NULLIFY(CBUFTMP)
+           NNUM=NNUM+NUMFLD
+           NLEN=NLEN+NBYTES
+           NMESS=NMESS+1
+        ENDIF
+        !      LOOK FOR NEXT GRIB MESSAGE
+        ISEEK=LSKIP+LGRIB
+        CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB)
+      ENDDO
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2.F	(revision 2744)
@@ -0,0 +1,333 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE GETGB2(LUGB,LUGI,J,GUESS,JDISC,JIDS,JPDTN,JPDT,JGDTN,
+     &                  JGDT,UNPACK,K,GFLD,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: GETGB2         FINDS AND UNPACKS A GRIB MESSAGE
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 94-04-01
+C
+C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE.
+C   READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF)
+C   TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE.
+C   FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB FIELD REQUESTED.
+C   THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF FIELDS TO SKIP
+C   AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND
+C   PRODUCT DEFINTION SECTION PARAMETERS.  (A REQUESTED PARAMETER
+C   OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
+C   IF THE REQUESTED GRIB FIELD IS FOUND, THEN IT IS READ FROM THE
+C   GRIB FILE AND UNPACKED.  ITS NUMBER IS RETURNED ALONG WITH
+C   THE ASSOCIATED UNPACKED PARAMETERS.  THE BITMAP (IF ANY),
+C   AND THE DATA VALUES ARE UNPACKED ONLY IF ARGUMENT "UNPACK" IS SET TO
+C   TRUE.  IF THE GRIB FIELD IS NOT FOUND, THEN THE
+C   RETURN CODE WILL BE NONZERO.
+C
+C   The decoded information for the selected GRIB field
+C   is returned in a derived type variable, gfld.
+C   Gfld is of type gribfield, which is defined
+C   in module grib_mod, so users of this routine will need to include
+C   the line "USE GRIB_MOD" in their calling routine.  Each component of the
+C   gribfield type is described in the OUTPUT ARGUMENT LIST section below.
+C
+C PROGRAM HISTORY LOG:
+C   94-04-01  IREDELL
+C   95-10-31  IREDELL     MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS
+C                         AND ALLOWED FOR UNSPECIFIED INDEX FILE
+C 2002-01-11  GILBERT     MODIFIED FROM GETGB AND GETGBM TO WORK WITH GRIB2
+C
+C USAGE:    CALL GETGB2(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
+C    &                  UNPACK,K,GFLD,IRET)
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
+C                  FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING 
+C                  THIS ROUTINE.
+C     LUGI         INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE.
+C                  IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE 
+C                  CALLING THIS ROUTINE.
+C                  >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T
+C                       ALREADY EXIST.
+C                  =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX
+C                       DOESN"T ALREADY EXIST.
+C                  <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI).
+C                  =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB.
+C     J            INTEGER NUMBER OF FIELDS TO SKIP
+C                  (=0 TO SEARCH FROM BEGINNING)
+C     JDISC        GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
+C                  ( IF = -1, ACCEPT ANY DISCIPLINE)
+C                  ( SEE CODE TABLE 0.0 )
+C                  0 - Meteorological products
+C                  1 - Hydrological products
+C                  2 - Land surface products
+C                  3 - Space products
+C                  10 - Oceanographic products
+C     JIDS()       INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
+C                  (=-9999 FOR WILDCARD)
+C            JIDS(1)   = IDENTIFICATION OF ORIGINATING CENTRE
+C                         ( SEE COMMON CODE TABLE C-1 )
+C            JIDS(2)   = IDENTIFICATION OF ORIGINATING SUB-CENTRE
+C            JIDS(3)   = GRIB MASTER TABLES VERSION NUMBER
+C                         ( SEE CODE TABLE 1.0 )
+C                       0 - Experimental
+C                       1 - Initial operational version number
+C            JIDS(4)   = GRIB LOCAL TABLES VERSION NUMBER
+C                         ( SEE CODE TABLE 1.1 )
+C                       0     - Local tables not used
+C                       1-254 - Number of local tables version used
+C            JIDS(5)   = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
+C                       0 - Analysis
+C                       1 - Start of forecast
+C                       2 - Verifying time of forecast
+C                       3 - Observation time
+C            JIDS(6)   = YEAR ( 4 DIGITS )
+C            JIDS(7)   = MONTH
+C            JIDS(8)   = DAY
+C            JIDS(9)   = HOUR
+C            JIDS(10)  = MINUTE
+C            JIDS(11)  = SECOND
+C            JIDS(12)  = PRODUCTION STATUS OF PROCESSED DATA
+C                         ( SEE CODE TABLE 1.3 )
+C                       0 - Operational products
+C                       1 - Operational test products
+C                       2 - Research products
+C                       3 - Re-analysis products
+C            JIDS(13)  = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
+C                       0  - Analysis products
+C                       1  - Forecast products
+C                       2  - Analysis and forecast products
+C                       3  - Control forecast products
+C                       4  - Perturbed forecast products
+C                       5  - Control and perturbed forecast products
+C                       6  - Processed satellite observations
+C                       7  - Processed radar observations
+C     JPDTN        INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
+C                  ( IF = -1, DON'T BOTHER MATCHING PDT - ACCEPT ANY )
+C     JPDT()       INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION
+C                  TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
+C                  (=-9999 FOR WILDCARD)
+C     JGDTN        INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
+C                  ( IF = -1, DON'T BOTHER MATCHING GDT - ACCEPT ANY )
+C     JGDT()       INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
+C                  TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
+C                  (=-9999 FOR WILDCARD)
+C     UNPACK       LOGICAL VALUE INDICATING WHETHER TO UNPACK BITMAP/DATA
+C                  .TRUE. = UNPACK BITMAP AND DATA VALUES
+C                  .FALSE. = DO NOT UNPACK BITMAP AND DATA VALUES
+C
+C   OUTPUT ARGUMENTS:
+C     K            INTEGER FIELD NUMBER UNPACKED
+C     gfld - derived type gribfield ( defined in module grib_mod )
+C            ( NOTE: See Remarks Section )
+C        gfld%version = GRIB edition number ( currently 2 )
+C        gfld%discipline = Message Discipline ( see Code Table 0.0 )
+C        gfld%idsect() = Contains the entries in the Identification
+C                        Section ( Section 1 )
+C                        This element is actually a pointer to an array
+C                        that holds the data.
+C            gfld%idsect(1)  = Identification of originating Centre
+C                                    ( see Common Code Table C-1 )
+C                             7 - US National Weather Service
+C            gfld%idsect(2)  = Identification of originating Sub-centre
+C            gfld%idsect(3)  = GRIB Master Tables Version Number
+C                                    ( see Code Table 1.0 )
+C                             0 - Experimental
+C                             1 - Initial operational version number
+C            gfld%idsect(4)  = GRIB Local Tables Version Number
+C                                    ( see Code Table 1.1 )
+C                             0     - Local tables not used
+C                             1-254 - Number of local tables version used
+C            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
+C                             0 - Analysis
+C                             1 - Start of forecast
+C                             2 - Verifying time of forecast
+C                             3 - Observation time
+C            gfld%idsect(6)  = Year ( 4 digits )
+C            gfld%idsect(7)  = Month
+C            gfld%idsect(8)  = Day
+C            gfld%idsect(9)  = Hour
+C            gfld%idsect(10)  = Minute
+C            gfld%idsect(11)  = Second
+C            gfld%idsect(12)  = Production status of processed data
+C                                    ( see Code Table 1.3 )
+C                              0 - Operational products
+C                              1 - Operational test products
+C                              2 - Research products
+C                              3 - Re-analysis products
+C            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
+C                              0  - Analysis products
+C                              1  - Forecast products
+C                              2  - Analysis and forecast products
+C                              3  - Control forecast products
+C                              4  - Perturbed forecast products
+C                              5  - Control and perturbed forecast products
+C                              6  - Processed satellite observations
+C                              7  - Processed radar observations
+C        gfld%idsectlen = Number of elements in gfld%idsect().
+C        gfld%local() = Pointer to character array containing contents
+C                       of Local Section 2, if included
+C        gfld%locallen = length of array gfld%local()
+C        gfld%ifldnum = field number within GRIB message
+C        gfld%griddef = Source of grid definition (see Code Table 3.0)
+C                      0 - Specified in Code table 3.1
+C                      1 - Predetermined grid Defined by originating centre
+C        gfld%ngrdpts = Number of grid points in the defined grid.
+C        gfld%numoct_opt = Number of octets needed for each
+C                          additional grid points definition.
+C                          Used to define number of
+C                          points in each row ( or column ) for
+C                          non-regular grids.
+C                          = 0, if using regular grid.
+C        gfld%interp_opt = Interpretation of list for optional points
+C                          definition.  (Code Table 3.11)
+C        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
+C        gfld%igdtmpl() = Contains the data values for the specified Grid
+C                         Definition Template ( NN=gfld%igdtnum ).  Each
+C                         element of this integer array contains an entry (in
+C                         the order specified) of Grid Defintion Template 3.NN
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
+C                       entries in Grid Defintion Template 3.NN
+C                       ( NN=gfld%igdtnum ).
+C        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
+C                          contains the number of grid points contained in
+C                          each row ( or column ).  (part of Section 3)
+C                          This element is actually a pointer to an array
+C                          that holds the data.  This pointer is nullified
+C                          if gfld%numoct_opt=0.
+C        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
+C                       in array ideflist.  i.e. number of rows ( or columns )
+C                       for which optional grid points are defined.  This value
+C                       is set to zero, if gfld%numoct_opt=0.
+C        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
+C        gfld%ipdtmpl() = Contains the data values for the specified Product
+C                         Definition Template ( N=gfdl%ipdtnum ).  Each element
+C                         of this integer array contains an entry (in the
+C                         order specified) of Product Defintion Template 4.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
+C                       entries in Product Defintion Template 4.N
+C                       ( N=gfdl%ipdtnum ).
+C        gfld%coord_list() = Real array containing floating point values
+C                            intended to document the vertical discretisation
+C                            associated to model data on hybrid coordinate
+C                            vertical levels.  (part of Section 4)
+C                            This element is actually a pointer to an array
+C                            that holds the data.
+C        gfld%num_coord = number of values in array gfld%coord_list().
+C        gfld%ndpts = Number of data points unpacked and returned.
+C        gfld%idrtnum = Data Representation Template Number
+C                       ( see Code Table 5.0)
+C        gfld%idrtmpl() = Contains the data values for the specified Data
+C                         Representation Template ( N=gfld%idrtnum ).  Each
+C                         element of this integer array contains an entry
+C                         (in the order specified) of Product Defintion
+C                         Template 5.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
+C                       of entries in Data Representation Template 5.N
+C                       ( N=gfld%idrtnum ).
+C        gfld%unpacked = logical value indicating whether the bitmap and
+C                        data values were unpacked.  If false,
+C                        gfld%bmap and gfld%fld pointers are nullified.
+C        gfld%expanded = Logical value indicating whether the data field
+C                         was expanded to the grid in the case where a
+C                         bit-map is present.  If true, the data points in
+C                         gfld%fld match the grid points and zeros were
+C                         inserted at grid points where data was bit-mapped
+C                         out.  If false, the data values in gfld%fld were
+C                         not expanded to the grid and are just a consecutive
+C                         array of data points corresponding to each value of
+C                         "1" in gfld%bmap.
+C        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
+C                     0 = bitmap applies and is included in Section 6.
+C                     1-253 = Predefined bitmap applies
+C                     254 = Previously defined bitmap applies to this field
+C                     255 = Bit map does not apply to this product.
+C        gfld%bmap() = Logical*1 array containing decoded bitmap,
+C                      if ibmap=0 or ibap=254.  Otherwise nullified.
+C                      This element is actually a pointer to an array
+C                      that holds the data.
+C        gfld%fld() = Array of gfld%ndpts unpacked data points.
+C                     This element is actually a pointer to an array
+C                     that holds the data.
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    96     ERROR READING INDEX
+C                    97     ERROR READING GRIB FILE
+C                    99     REQUEST NOT FOUND
+C                    OTHER  GF_GETFLD GRIB2 UNPACKER RETURN CODE
+C
+C SUBPROGRAMS CALLED:
+C   GETIDX         GET INDEX
+C   GETGB2S        SEARCH INDEX RECORDS
+C   GETGB2R        READ AND UNPACK GRIB RECORD
+C   GF_FREE        FREES MEMORY USED BY GFLD  ( SEE REMARKS )
+C
+C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED.
+C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
+C
+C   Note that derived type gribfield contains pointers to many
+C   arrays of data.  The memory for these arrays is allocated
+C   when the values in the arrays are set, to help minimize
+C   problems with array overloading.  Because of this users
+C   are encouraged to free up this memory, when it is no longer
+C   needed, by an explicit call to subroutine gf_free.
+C   ( i.e.   CALL GF_FREE(GFLD) )
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE GRIB_MOD
+
+      INTEGER,INTENT(IN) :: LUGB,LUGI,J,JDISC,JPDTN,JGDTN
+      INTEGER,INTENT(IN) :: GUESS
+      INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*)
+      LOGICAL,INTENT(IN) :: UNPACK
+      INTEGER,INTENT(OUT) :: K,IRET
+      TYPE(GRIBFIELD),INTENT(OUT) :: GFLD
+
+      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECLARE INTERFACES (REQUIRED FOR CBUF POINTER)
+      INTERFACE
+         SUBROUTINE GETIDX(LUGB,LUGI,CBUF,NLEN,NNUM,IRGI)
+           CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+           INTEGER,INTENT(IN) :: LUGB,LUGI
+           INTEGER,INTENT(OUT) :: NLEN,NNUM,IRGI
+         END SUBROUTINE GETIDX
+      END INTERFACE
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED
+      IRGI=0
+      CALL GETIDX(LUGB,LUGI,CBUF,NLEN,NNUM,IRGI)
+      IF(IRGI.GT.1) THEN
+        IRET=96
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  SEARCH INDEX BUFFER
+      CALL GETGB2S(CBUF,NLEN,NNUM,J,GUESS,JDISC,JIDS,JPDTN,JPDT,JGDTN,
+     &             JGDT,JK,GFLD,LPOS,IRGS)
+      IF(IRGS.NE.0) THEN
+        IRET=99
+        CALL GF_FREE(GFLD)
+        RETURN
+      ENDIF
+
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  READ LOCAL USE SECTION, IF AVAILABLE
+      CALL GETGB2L(LUGB,CBUF(LPOS),GFLD,IRET)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  READ AND UNPACK GRIB RECORD
+      IF (UNPACK) THEN
+    !    NUMFLD=GFLD%IFLDNUM
+    !    CALL GF_FREE(GFLD)
+         CALL GETGB2R(LUGB,CBUF(LPOS),GFLD,IRET)
+      ENDIF
+      K=JK
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2l.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2l.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2l.F	(revision 2744)
@@ -0,0 +1,234 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE GETGB2L(LUGB,CINDEX,GFLD,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: GETGB2L        EXTRACTS LOCAL USE SECTION
+C   PRGMMR: GILBERT          ORG: W/NP11     DATE: 02-05-07
+C
+C ABSTRACT: READ AND UNPACK A LOCAL USE SECTION FROM A GRIB2 MESSAGE.
+C
+C   The decoded information for the selected GRIB field
+C   is returned in a derived type variable, gfld.
+C   Gfld is of type gribfield, which is defined
+C   in module grib_mod, so users of this routine will need to include
+C   the line "USE GRIB_MOD" in their calling routine.  Each component of the
+C   gribfield type is described in the OUTPUT ARGUMENT LIST section below.
+C
+C PROGRAM HISTORY LOG:
+C 2002-05-07  GILBERT  
+C
+C USAGE:    CALL GETGB2L(LUGB,CINDEX,GFLD,IRET)
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE
+C     CINDEX       INDEX RECORD OF THE GRIB FIELD  ( SEE DOCBLOCK OF
+C                  SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.)
+C   OUTPUT ARGUMENTS:
+C     gfld - derived type gribfield ( defined in module grib_mod )
+C            ( NOTE: See Remarks Section )
+C        gfld%version = GRIB edition number ( currently 2 )
+C        gfld%discipline = Message Discipline ( see Code Table 0.0 )
+C        gfld%idsect() = Contains the entries in the Identification
+C                        Section ( Section 1 )
+C                        This element is actually a pointer to an array
+C                        that holds the data.
+C            gfld%idsect(1)  = Identification of originating Centre
+C                                    ( see Common Code Table C-1 )
+C                             7 - US National Weather Service
+C            gfld%idsect(2)  = Identification of originating Sub-centre
+C            gfld%idsect(3)  = GRIB Master Tables Version Number
+C                                    ( see Code Table 1.0 )
+C                             0 - Experimental
+C                             1 - Initial operational version number
+C            gfld%idsect(4)  = GRIB Local Tables Version Number
+C                                    ( see Code Table 1.1 )
+C                             0     - Local tables not used
+C                             1-254 - Number of local tables version used
+C            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
+C                             0 - Analysis
+C                             1 - Start of forecast
+C                             2 - Verifying time of forecast
+C                             3 - Observation time
+C            gfld%idsect(6)  = Year ( 4 digits )
+C            gfld%idsect(7)  = Month
+C            gfld%idsect(8)  = Day
+C            gfld%idsect(9)  = Hour
+C            gfld%idsect(10)  = Minute
+C            gfld%idsect(11)  = Second
+C            gfld%idsect(12)  = Production status of processed data
+C                                    ( see Code Table 1.3 )
+C                              0 - Operational products
+C                              1 - Operational test products
+C                              2 - Research products
+C                              3 - Re-analysis products
+C            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
+C                              0  - Analysis products
+C                              1  - Forecast products
+C                              2  - Analysis and forecast products
+C                              3  - Control forecast products
+C                              4  - Perturbed forecast products
+C                              5  - Control and perturbed forecast products
+C                              6  - Processed satellite observations
+C                              7  - Processed radar observations
+C        gfld%idsectlen = Number of elements in gfld%idsect().
+C        gfld%local() = Pointer to character array containing contents
+C                       of Local Section 2, if included
+C        gfld%locallen = length of array gfld%local()
+C        gfld%ifldnum = field number within GRIB message
+C        gfld%griddef = Source of grid definition (see Code Table 3.0)
+C                      0 - Specified in Code table 3.1
+C                      1 - Predetermined grid Defined by originating centre
+C        gfld%ngrdpts = Number of grid points in the defined grid.
+C        gfld%numoct_opt = Number of octets needed for each
+C                          additional grid points definition.
+C                          Used to define number of
+C                          points in each row ( or column ) for
+C                          non-regular grids.
+C                          = 0, if using regular grid.
+C        gfld%interp_opt = Interpretation of list for optional points
+C                          definition.  (Code Table 3.11)
+C        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
+C        gfld%igdtmpl() = Contains the data values for the specified Grid
+C                         Definition Template ( NN=gfld%igdtnum ).  Each
+C                         element of this integer array contains an entry (in
+C                         the order specified) of Grid Defintion Template 3.NN
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
+C                       entries in Grid Defintion Template 3.NN
+C                       ( NN=gfld%igdtnum ).
+C        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
+C                          contains the number of grid points contained in
+C                          each row ( or column ).  (part of Section 3)
+C                          This element is actually a pointer to an array
+C                          that holds the data.  This pointer is nullified
+C                          if gfld%numoct_opt=0.
+C        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
+C                       in array ideflist.  i.e. number of rows ( or columns )
+C                       for which optional grid points are defined.  This value
+C                       is set to zero, if gfld%numoct_opt=0.
+C        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
+C        gfld%ipdtmpl() = Contains the data values for the specified Product
+C                         Definition Template ( N=gfdl%ipdtnum ).  Each element
+C                         of this integer array contains an entry (in the
+C                         order specified) of Product Defintion Template 4.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
+C                       entries in Product Defintion Template 4.N
+C                       ( N=gfdl%ipdtnum ).
+C        gfld%coord_list() = Real array containing floating point values
+C                            intended to document the vertical discretisation
+C                            associated to model data on hybrid coordinate
+C                            vertical levels.  (part of Section 4)
+C                            This element is actually a pointer to an array
+C                            that holds the data.
+C        gfld%num_coord = number of values in array gfld%coord_list().
+C        gfld%ndpts = Number of data points unpacked and returned.
+C        gfld%idrtnum = Data Representation Template Number
+C                       ( see Code Table 5.0)
+C        gfld%idrtmpl() = Contains the data values for the specified Data
+C                         Representation Template ( N=gfld%idrtnum ).  Each
+C                         element of this integer array contains an entry
+C                         (in the order specified) of Product Defintion
+C                         Template 5.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
+C                       of entries in Data Representation Template 5.N
+C                       ( N=gfld%idrtnum ).
+C        gfld%unpacked = logical value indicating whether the bitmap and
+C                        data values were unpacked.  If false,
+C                        gfld%bmap and gfld%fld pointers are nullified.
+C        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
+C                     0 = bitmap applies and is included in Section 6.
+C                     1-253 = Predefined bitmap applies
+C                     254 = Previously defined bitmap applies to this field
+C                     255 = Bit map does not apply to this product.
+C        gfld%bmap() = Logical*1 array containing decoded bitmap,
+C                      if ibmap=0 or ibap=254.  Otherwise nullified.
+C                      This element is actually a pointer to an array
+C                      that holds the data.
+C        gfld%fld() = Array of gfld%ndpts unpacked data points.
+C                     This element is actually a pointer to an array
+C                     that holds the data.
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    97     ERROR READING GRIB FILE
+C                    OTHER  GF_GETFLD GRIB UNPACKER RETURN CODE
+C
+C SUBPROGRAMS CALLED:
+C   BAREAD         BYTE-ADDRESSABLE READ
+C   GF_GETFLD       UNPACK GRIB FIELD
+C
+C REMARKS: 
+C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
+C   THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY.
+C
+C   Note that derived type gribfield contains pointers to many
+C   arrays of data.  The memory for these arrays is allocated
+C   when the values in the arrays are set, to help minimize
+C   problems with array overloading.  Because of this users
+C   are encouraged to free up this memory, when it is no longer
+C   needed, by an explicit call to subroutine gf_free.
+C   ( i.e.   CALL GF_FREE(GFLD) )
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE GRIB_MOD
+
+      INTEGER,INTENT(IN) :: LUGB
+      CHARACTER(LEN=1),INTENT(IN) :: CINDEX(*)
+      INTEGER,INTENT(OUT) :: IRET
+      TYPE(GRIBFIELD) :: GFLD
+
+      INTEGER :: LSKIP,SKIP2
+      CHARACTER(LEN=1):: CSIZE(4)
+      CHARACTER(LEN=1),ALLOCATABLE :: CTEMP(:)
+
+      interface
+         subroutine gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr)
+           character(len=1),intent(in) :: cgrib(lcgrib)
+           integer,intent(in) :: lcgrib
+           integer,intent(inout) :: iofst
+           integer,intent(out) :: lencsec2
+           integer,intent(out) :: ierr
+           character(len=1),pointer,dimension(:) :: csec2
+         end subroutine gf_unpack2
+      end interface
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  GET INFO
+      NULLIFY(gfld%local)
+      IRET=0
+      CALL G2LIB_GBYTE(CINDEX,LSKIP,4*8,4*8)
+      CALL G2LIB_GBYTE(CINDEX,SKIP2,8*8,4*8)
+
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  READ AND UNPACK LOCAL USE SECTION, IF PRESENT
+      IF ( SKIP2.NE.0 ) THEN
+         ISKIP=LSKIP+SKIP2
+         CALL BAREAD(LUGB,ISKIP,4,LREAD,CSIZE)    ! GET LENGTH OF SECTION
+         CALL G2LIB_GBYTE(CSIZE,ILEN,0,32)
+         ALLOCATE(CTEMP(ILEN))
+         CALL BAREAD(LUGB,ISKIP,ILEN,LREAD,CTEMP)  ! READ IN SECTION
+         IF (ILEN.NE.LREAD) THEN
+            IRET=97
+            DEALLOCATE(CTEMP)
+            RETURN
+         ENDIF
+         IOFST=0
+         CALL GF_UNPACK2(CTEMP,ILEN,IOFST,gfld%locallen,
+     &                   gfld%local,ierr)
+         IF (IERR.NE.0) THEN
+            IRET=98
+            DEALLOCATE(CTEMP)
+            RETURN
+         ENDIF
+         DEALLOCATE(CTEMP)
+      ELSE
+         gfld%locallen=0
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2p.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2p.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2p.F	(revision 2744)
@@ -0,0 +1,223 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE GETGB2P(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
+     &                   EXTRACT,K,GRIBM,LENG,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: GETGB2P        FINDS AND EXTRACTS A GRIB MESSAGE
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 94-04-01
+C
+C ABSTRACT: FIND AND EXTRACTS A GRIB MESSAGE FROM A FILE.
+C   READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF)
+C   TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE.
+C   FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB FIELD REQUESTED.
+C   THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF FIELDS TO SKIP
+C   AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND
+C   PRODUCT DEFINTION SECTION PARAMETERS.  (A REQUESTED PARAMETER
+C   OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
+C   IF THE REQUESTED GRIB FIELD IS FOUND, THEN IT IS READ FROM THE
+C   GRIB FILE AND RETURNED. 
+C   IF THE GRIB FIELD IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO.
+C
+C PROGRAM HISTORY LOG:
+C   94-04-01  IREDELL
+C   95-10-31  IREDELL     MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS
+C                         AND ALLOWED FOR UNSPECIFIED INDEX FILE
+C 2002-01-11  GILBERT     MODIFIED FROM GETGB AND GETGBM TO WORK WITH GRIB2
+C 2003-12-17  GILBERT     MODIFIED FROM GETGB2 TO RETURN PACKED GRIB2 MESSAGE.
+C
+C USAGE:    CALL GETGB2P(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
+C    &                  EXTRACT,K,GRIBM,LENG,IRET)
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
+C                  FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING 
+C                  THIS ROUTINE.
+C     LUGI         INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE.
+C                  IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE 
+C                  CALLING THIS ROUTINE.
+C                  (=0 TO GET INDEX BUFFER FROM THE GRIB FILE)
+C     J            INTEGER NUMBER OF FIELDS TO SKIP
+C                  (=0 TO SEARCH FROM BEGINNING)
+C     JDISC        GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
+C                  ( IF = -1, ACCEPT ANY DISCIPLINE)
+C                  ( SEE CODE TABLE 0.0 )
+C                  0 - Meteorological products
+C                  1 - Hydrological products
+C                  2 - Land surface products
+C                  3 - Space products
+C                  10 - Oceanographic products
+C     JIDS()       INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
+C                  (=-9999 FOR WILDCARD)
+C            JIDS(1)   = IDENTIFICATION OF ORIGINATING CENTRE
+C                         ( SEE COMMON CODE TABLE C-1 )
+C            JIDS(2)   = IDENTIFICATION OF ORIGINATING SUB-CENTRE
+C            JIDS(3)   = GRIB MASTER TABLES VERSION NUMBER
+C                         ( SEE CODE TABLE 1.0 )
+C                       0 - Experimental
+C                       1 - Initial operational version number
+C            JIDS(4)   = GRIB LOCAL TABLES VERSION NUMBER
+C                         ( SEE CODE TABLE 1.1 )
+C                       0     - Local tables not used
+C                       1-254 - Number of local tables version used
+C            JIDS(5)   = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
+C                       0 - Analysis
+C                       1 - Start of forecast
+C                       2 - Verifying time of forecast
+C                       3 - Observation time
+C            JIDS(6)   = YEAR ( 4 DIGITS )
+C            JIDS(7)   = MONTH
+C            JIDS(8)   = DAY
+C            JIDS(9)   = HOUR
+C            JIDS(10)  = MINUTE
+C            JIDS(11)  = SECOND
+C            JIDS(12)  = PRODUCTION STATUS OF PROCESSED DATA
+C                         ( SEE CODE TABLE 1.3 )
+C                       0 - Operational products
+C                       1 - Operational test products
+C                       2 - Research products
+C                       3 - Re-analysis products
+C            JIDS(13)  = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
+C                       0  - Analysis products
+C                       1  - Forecast products
+C                       2  - Analysis and forecast products
+C                       3  - Control forecast products
+C                       4  - Perturbed forecast products
+C                       5  - Control and perturbed forecast products
+C                       6  - Processed satellite observations
+C                       7  - Processed radar observations
+C     JPDTN        INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
+C                  ( IF = -1, DON'T BOTHER MATCHING PDT - ACCEPT ANY )
+C     JPDT()       INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION
+C                  TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
+C                  (=-9999 FOR WILDCARD)
+C     JGDTN        INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
+C                  ( IF = -1, DON'T BOTHER MATCHING GDT - ACCEPT ANY )
+C     JGDT()       INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
+C                  TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
+C                  (=-9999 FOR WILDCARD)
+C     EXTRACT       LOGICAL VALUE INDICATING WHETHER TO RETURN A GRIB2 
+C                   MESSAGE WITH JUST THE REQUESTED FIELD, OR THE ENTIRE
+C                   GRIB2 MESSAGE CONTAINING THE REQUESTED FIELD.
+C                  .TRUE. = RETURN GRIB2 MESSAGE CONTAINING ONLY THE REQUESTED
+C                           FIELD.
+C                  .FALSE. = RETURN ENTIRE GRIB2 MESSAGE CONTAINING THE
+C                            REQUESTED FIELD.
+C
+C   OUTPUT ARGUMENTS:
+C     K            INTEGER FIELD NUMBER RETURNED.
+C     GRIBM         RETURNED GRIB MESSAGE.
+C     LENG         LENGTH OF RETURNED GRIB MESSAGE IN BYTES.
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    96     ERROR READING INDEX FILE
+C                    97     ERROR READING GRIB FILE
+C                    99     REQUEST NOT FOUND
+C
+C SUBPROGRAMS CALLED:
+C   GETG2I          READ INDEX FILE
+C   GETG2IR         READ INDEX BUFFER FROM GRIB FILE
+C   GETGB2S        SEARCH INDEX RECORDS
+C   GETGB2RP        READ A PACKED GRIB RECORD
+C   GF_FREE        FREES MEMORY USED BY GFLD  ( SEE REMARKS )
+C
+C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED.
+C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
+C
+C   Note that derived type gribfield contains pointers to many
+C   arrays of data.  The memory for these arrays is allocated
+C   when the values in the arrays are set, to help minimize
+C   problems with array overloading.  Because of this users
+C   are encouraged to free up this memory, when it is no longer
+C   needed, by an explicit call to subroutine gf_free.
+C   ( i.e.   CALL GF_FREE(GFLD) )
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE GRIB_MOD
+
+      INTEGER,INTENT(IN) :: LUGB,LUGI,J,JDISC,JPDTN,JGDTN
+      INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*)
+      LOGICAL,INTENT(IN) :: EXTRACT
+      INTEGER,INTENT(OUT) :: K,IRET,LENG
+      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: GRIBM
+
+      TYPE(GRIBFIELD) :: GFLD
+
+      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+      PARAMETER(MSK1=32000,MSK2=4000)
+
+      SAVE CBUF,NLEN,NNUM
+      DATA LUX/0/
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECLARE INTERFACES (REQUIRED FOR CBUF POINTER)
+      INTERFACE
+         SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET)
+            CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+            INTEGER,INTENT(IN) :: LUGI
+            INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET
+         END SUBROUTINE GETG2I
+         SUBROUTINE GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,
+     &                      NMESS,IRET)
+            CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+            INTEGER,INTENT(IN) :: LUGB,MSK1,MSK2,MNUM
+            INTEGER,INTENT(OUT) :: NLEN,NNUM,NMESS,IRET
+         END SUBROUTINE GETG2IR
+         SUBROUTINE GETGB2RP(LUGB,CINDEX,EXTRACT,GRIBM,LENG,IRET)
+            INTEGER,INTENT(IN) :: LUGB
+            CHARACTER(LEN=1),INTENT(IN) :: CINDEX(*)
+            LOGICAL,INTENT(IN) :: EXTRACT
+            INTEGER,INTENT(OUT) :: LENG,IRET
+            CHARACTER(LEN=1),POINTER,DIMENSION(:) :: GRIBM
+         END SUBROUTINE GETGB2RP
+      END INTERFACE
+
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED
+      IRGI=0
+      IF(LUGI.GT.0.AND.LUGI.NE.LUX) THEN
+        CALL GETG2I(LUGI,CBUF,NLEN,NNUM,IRGI)
+        LUX=LUGI
+      ELSEIF(LUGI.LE.0.AND.LUGB.NE.LUX) THEN
+        MSKP=0
+        CALL GETG2IR(LUGB,MSK1,MSK2,MSKP,CBUF,NLEN,NNUM,NMESS,IRGI)
+        LUX=LUGB
+      ENDIF
+      IF(IRGI.GT.1) THEN
+        IRET=96
+        LUX=0
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  SEARCH INDEX BUFFER
+      CALL GETGB2S(CBUF,NLEN,NNUM,J,-1,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
+     &             JK,GFLD,LPOS,IRGS)
+      IF(IRGS.NE.0) THEN
+        IRET=99
+        CALL GF_FREE(GFLD)
+        RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  EXTRACT GRIB MESSAGE FROM FILE
+      CALL GETGB2RP(LUGB,CBUF(LPOS:),EXTRACT,GRIBM,LENG,IRET)
+!      IF ( EXTRACT ) THEN
+!         PRINT *,'NOT SUPPOSED TO BE HERE.'
+!      ELSE
+!         IPOS=(LPOS+3)*8
+!         CALL G2LIB_GBYTE(CBUF,ISKIP,IPOS,32)     ! BYTES TO SKIP IN FILE
+!         IPOS=IPOS+(32*8)
+!         CALL G2LIB_GBYTE(CBUF,LENG,IPOS,32)      ! LENGTH OF GRIB MESSAGE
+!         IF (.NOT. ASSOCIATED(GRIBM)) ALLOCATE(GRIBM(LENG))
+!         CALL BAREAD(LUGB,ISKIP,LENG,LREAD,GRIBM)
+!         IF ( LENG .NE. LREAD ) THEN
+!            IRET=97
+!            CALL GF_FREE(GFLD)
+!            RETURN
+!         ENDIF
+!      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      K=JK
+      CALL GF_FREE(GFLD)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2r.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2r.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2r.F	(revision 2744)
@@ -0,0 +1,304 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE GETGB2R(LUGB,CINDEX,GFLD,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: GETGB2R        READS AND UNPACKS A GRIB FIELD
+C   PRGMMR: GILBERT          ORG: W/NP11     DATE: 02-01-15
+C
+C ABSTRACT: READ AND UNPACK SECTIONS 6 AND 7 FROM A GRIB2 MESSAGE.
+C
+C   This routine assumes that the "metadata" for this field
+C   already exists in derived type gribfield.  Specifically,
+C   it requires gfld%ibmap,gfld%ngrdpts,gfld%idrtnum,gfld%idrtmpl,
+C   and gfld%ndpts.
+C   
+C   The decoded information for the selected GRIB field
+C   is returned in a derived type variable, gfld.
+C   Gfld is of type gribfield, which is defined
+C   in module grib_mod, so users of this routine will need to include
+C   the line "USE GRIB_MOD" in their calling routine.  Each component of the
+C   gribfield type is described in the OUTPUT ARGUMENT LIST section below.
+C
+C PROGRAM HISTORY LOG:
+C   95-10-31  IREDELL
+C 2002-01-11  GILBERT     MODIFIED FROM GETGB1R TO WORK WITH GRIB2
+C
+C USAGE:    CALL GETGB2R(LUGB,CINDEX,GFLD,IRET)
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE
+C     CINDEX       INDEX RECORD OF THE GRIB FIELD  ( SEE DOCBLOCK OF
+C                  SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.)
+C   OUTPUT ARGUMENTS:
+C     gfld - derived type gribfield ( defined in module grib_mod )
+C            ( NOTE: See Remarks Section )
+C        gfld%version = GRIB edition number ( currently 2 )
+C        gfld%discipline = Message Discipline ( see Code Table 0.0 )
+C        gfld%idsect() = Contains the entries in the Identification
+C                        Section ( Section 1 )
+C                        This element is actually a pointer to an array
+C                        that holds the data.
+C            gfld%idsect(1)  = Identification of originating Centre
+C                                    ( see Common Code Table C-1 )
+C                             7 - US National Weather Service
+C            gfld%idsect(2)  = Identification of originating Sub-centre
+C            gfld%idsect(3)  = GRIB Master Tables Version Number
+C                                    ( see Code Table 1.0 )
+C                             0 - Experimental
+C                             1 - Initial operational version number
+C            gfld%idsect(4)  = GRIB Local Tables Version Number
+C                                    ( see Code Table 1.1 )
+C                             0     - Local tables not used
+C                             1-254 - Number of local tables version used
+C            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
+C                             0 - Analysis
+C                             1 - Start of forecast
+C                             2 - Verifying time of forecast
+C                             3 - Observation time
+C            gfld%idsect(6)  = Year ( 4 digits )
+C            gfld%idsect(7)  = Month
+C            gfld%idsect(8)  = Day
+C            gfld%idsect(9)  = Hour
+C            gfld%idsect(10)  = Minute
+C            gfld%idsect(11)  = Second
+C            gfld%idsect(12)  = Production status of processed data
+C                                    ( see Code Table 1.3 )
+C                              0 - Operational products
+C                              1 - Operational test products
+C                              2 - Research products
+C                              3 - Re-analysis products
+C            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
+C                              0  - Analysis products
+C                              1  - Forecast products
+C                              2  - Analysis and forecast products
+C                              3  - Control forecast products
+C                              4  - Perturbed forecast products
+C                              5  - Control and perturbed forecast products
+C                              6  - Processed satellite observations
+C                              7  - Processed radar observations
+C        gfld%idsectlen = Number of elements in gfld%idsect().
+C        gfld%local() = Pointer to character array containing contents
+C                       of Local Section 2, if included
+C        gfld%locallen = length of array gfld%local()
+C        gfld%ifldnum = field number within GRIB message
+C        gfld%griddef = Source of grid definition (see Code Table 3.0)
+C                      0 - Specified in Code table 3.1
+C                      1 - Predetermined grid Defined by originating centre
+C        gfld%ngrdpts = Number of grid points in the defined grid.
+C        gfld%numoct_opt = Number of octets needed for each
+C                          additional grid points definition.
+C                          Used to define number of
+C                          points in each row ( or column ) for
+C                          non-regular grids.
+C                          = 0, if using regular grid.
+C        gfld%interp_opt = Interpretation of list for optional points
+C                          definition.  (Code Table 3.11)
+C        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
+C        gfld%igdtmpl() = Contains the data values for the specified Grid
+C                         Definition Template ( NN=gfld%igdtnum ).  Each
+C                         element of this integer array contains an entry (in
+C                         the order specified) of Grid Defintion Template 3.NN
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
+C                       entries in Grid Defintion Template 3.NN
+C                       ( NN=gfld%igdtnum ).
+C        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
+C                          contains the number of grid points contained in
+C                          each row ( or column ).  (part of Section 3)
+C                          This element is actually a pointer to an array
+C                          that holds the data.  This pointer is nullified
+C                          if gfld%numoct_opt=0.
+C        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
+C                       in array ideflist.  i.e. number of rows ( or columns )
+C                       for which optional grid points are defined.  This value
+C                       is set to zero, if gfld%numoct_opt=0.
+C        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
+C        gfld%ipdtmpl() = Contains the data values for the specified Product
+C                         Definition Template ( N=gfdl%ipdtnum ).  Each element
+C                         of this integer array contains an entry (in the
+C                         order specified) of Product Defintion Template 4.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
+C                       entries in Product Defintion Template 4.N
+C                       ( N=gfdl%ipdtnum ).
+C        gfld%coord_list() = Real array containing floating point values
+C                            intended to document the vertical discretisation
+C                            associated to model data on hybrid coordinate
+C                            vertical levels.  (part of Section 4)
+C                            This element is actually a pointer to an array
+C                            that holds the data.
+C        gfld%num_coord = number of values in array gfld%coord_list().
+C        gfld%ndpts = Number of data points unpacked and returned.
+C        gfld%idrtnum = Data Representation Template Number
+C                       ( see Code Table 5.0)
+C        gfld%idrtmpl() = Contains the data values for the specified Data
+C                         Representation Template ( N=gfld%idrtnum ).  Each
+C                         element of this integer array contains an entry
+C                         (in the order specified) of Product Defintion
+C                         Template 5.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
+C                       of entries in Data Representation Template 5.N
+C                       ( N=gfld%idrtnum ).
+C        gfld%unpacked = logical value indicating whether the bitmap and
+C                        data values were unpacked.  If false,
+C                        gfld%bmap and gfld%fld pointers are nullified.
+C        gfld%expanded = Logical value indicating whether the data field
+C                         was expanded to the grid in the case where a
+C                         bit-map is present.  If true, the data points in
+C                         gfld%fld match the grid points and zeros were
+C                         inserted at grid points where data was bit-mapped
+C                         out.  If false, the data values in gfld%fld were
+C                         not expanded to the grid and are just a consecutive
+C                         array of data points corresponding to each value of
+C                         "1" in gfld%bmap.
+C        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
+C                     0 = bitmap applies and is included in Section 6.
+C                     1-253 = Predefined bitmap applies
+C                     254 = Previously defined bitmap applies to this field
+C                     255 = Bit map does not apply to this product.
+C        gfld%bmap() = Logical*1 array containing decoded bitmap,
+C                      if ibmap=0 or ibap=254.  Otherwise nullified.
+C                      This element is actually a pointer to an array
+C                      that holds the data.
+C        gfld%fld() = Array of gfld%ndpts unpacked data points.
+C                     This element is actually a pointer to an array
+C                     that holds the data.
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    97     ERROR READING GRIB FILE
+C                    OTHER  GF_GETFLD GRIB UNPACKER RETURN CODE
+C
+C SUBPROGRAMS CALLED:
+C   BAREAD         BYTE-ADDRESSABLE READ
+C   GF_UNPACK6     UNAPCKS BIT_MAP SECTION
+C   GF_UNPACK7     UNAPCKS DATA SECTION 
+C
+C REMARKS: 
+C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
+C   THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY.
+C
+C   Note that derived type gribfield contains pointers to many
+C   arrays of data.  The memory for these arrays is allocated
+C   when the values in the arrays are set, to help minimize
+C   problems with array overloading.  Because of this, users
+C   are encouraged to free up this memory, when it is no longer
+C   needed, by an explicit call to subroutine gf_free.
+C   ( i.e.   CALL GF_FREE(GFLD) )
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE GRIB_MOD
+
+      INTEGER,INTENT(IN) :: LUGB
+      CHARACTER(LEN=1),INTENT(IN) :: CINDEX(*)
+      INTEGER,INTENT(OUT) :: IRET
+      TYPE(GRIBFIELD) :: GFLD
+
+      INTEGER :: LSKIP,SKIP6,SKIP7
+      CHARACTER(LEN=1):: CSIZE(4)
+      CHARACTER(LEN=1),ALLOCATABLE :: CTEMP(:)
+      real,pointer,dimension(:) :: newfld
+
+      interface
+         subroutine gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,
+     &                         bmap,ierr)
+           character(len=1),intent(in) :: cgrib(lcgrib)
+           integer,intent(in) :: lcgrib,ngpts
+           integer,intent(inout) :: iofst
+           integer,intent(out) :: ibmap
+           integer,intent(out) :: ierr
+           logical*1,pointer,dimension(:) :: bmap
+         end subroutine gf_unpack6
+         subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl,
+     &                         idrsnum,idrstmpl,ndpts,fld,ierr)
+           character(len=1),intent(in) :: cgrib(lcgrib)
+           integer,intent(in) :: lcgrib,ndpts,idrsnum,igdsnum
+           integer,intent(inout) :: iofst
+           integer,pointer,dimension(:) :: idrstmpl,igdstmpl
+           integer,intent(out) :: ierr
+           real,pointer,dimension(:) :: fld
+         end subroutine gf_unpack7
+      end interface
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  GET INFO
+      NULLIFY(gfld%bmap,gfld%fld)
+      IRET=0
+      CALL G2LIB_GBYTE(CINDEX,LSKIP,4*8,4*8)
+      CALL G2LIB_GBYTE(CINDEX,SKIP6,24*8,4*8)
+      CALL G2LIB_GBYTE(CINDEX,SKIP7,28*8,4*8)
+
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  READ AND UNPACK BIT_MAP, IF PRESENT
+      IF ( gfld%ibmap.eq.0.OR.gfld%ibmap.eq.254 ) THEN
+         ISKIP=LSKIP+SKIP6
+         CALL BAREAD(LUGB,ISKIP,4,LREAD,CSIZE)    ! GET LENGTH OF SECTION
+         CALL G2LIB_GBYTE(CSIZE,ILEN,0,32)
+         ALLOCATE(CTEMP(ILEN))
+         CALL BAREAD(LUGB,ISKIP,ILEN,LREAD,CTEMP)  ! READ IN SECTION
+         IF (ILEN.NE.LREAD) THEN
+            IRET=97
+            DEALLOCATE(CTEMP)
+            RETURN
+         ENDIF
+         IOFST=0
+         CALL GF_UNPACK6(CTEMP,ILEN,IOFST,gfld%ngrdpts,idum,
+     &                   gfld%bmap,ierr)
+         IF (IERR.NE.0) THEN
+            IRET=98
+            DEALLOCATE(CTEMP)
+            RETURN
+         ENDIF
+         DEALLOCATE(CTEMP)
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  READ AND UNPACK DATA FIELD 
+      ISKIP=LSKIP+SKIP7
+      CALL BAREAD(LUGB,ISKIP,4,LREAD,CSIZE)    ! GET LENGTH OF SECTION
+      CALL G2LIB_GBYTE(CSIZE,ILEN,0,32)
+      ALLOCATE(CTEMP(ILEN))
+      CALL BAREAD(LUGB,ISKIP,ILEN,LREAD,CTEMP)  ! READ IN SECTION
+      IF (ILEN.NE.LREAD) THEN
+         IRET=97
+         DEALLOCATE(CTEMP)
+         RETURN
+      ENDIF
+      IOFST=0
+      CALL GF_UNPACK7(CTEMP,ILEN,IOFST,gfld%igdtnum,gfld%igdtmpl,
+     &                   gfld%idrtnum,gfld%idrtmpl,gfld%ndpts,
+     &                   gfld%fld,ierr)
+      IF (IERR.NE.0) THEN
+         IRET=98
+         DEALLOCATE(CTEMP)
+         RETURN
+      ENDIF
+      DEALLOCATE(CTEMP)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      !  If bitmap is used with this field, expand data field
+      !  to grid, if possible.
+      if ( gfld%ibmap .ne. 255 .AND. associated(gfld%bmap) ) then
+            allocate(newfld(gfld%ngrdpts))
+            !newfld=0.0
+            !newfld=unpack(lgfld%fld,lgfld%bmap,newfld)
+            n=1
+            do j=1,gfld%ngrdpts
+                if ( gfld%bmap(j) ) then
+                  newfld(j)=gfld%fld(n)
+                  n=n+1
+                else
+                  newfld(j)=0.0
+                endif
+            enddo
+            deallocate(gfld%fld);
+            gfld%fld=>newfld;
+            gfld%expanded=.true.
+      else
+         gfld%expanded=.true.
+      endif
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2rp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2rp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2rp.F	(revision 2744)
@@ -0,0 +1,189 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE GETGB2RP(LUGB,CINDEX,EXTRACT,GRIBM,LENG,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: GETGB2RP       EXTRACTS A GRIB MESSAGE FROM A FILE
+C   PRGMMR: GILBERT          ORG: W/NMC23     DATE: 2003-12-31
+C
+C ABSTRACT: FIND AND EXTRACTS A GRIB MESSAGE FROM A FILE GIVEN THE 
+C   INDEX FOR THE REQUESTED FIELD.
+C   THE GRIB MESSAGE RETURNED CAN CONTAIN ONLY THE REQUESTED FIELD
+C   (EXTRACT=.TRUE.). OR THE COMPLETE GRIB MESSAGE ORIGINALLY CONTAINING
+C   THE DESIRED FIELD CAN BE RETURNED (EXTRACT=.FALSE.) EVEN IF OTHER
+C   FIELDS WERE INCLUDED IN THE GRIB MESSAGE.
+C   IF THE GRIB FIELD IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO.
+C
+C PROGRAM HISTORY LOG:
+C 2003-12-31  GILBERT
+C
+C USAGE:    CALL GETGB2RP(LUGB,CINDEX,EXTRACT,GRIBM,LENG,IRET)
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
+C                  FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING 
+C                  THIS ROUTINE.
+C     CINDEX       INDEX RECORD OF THE GRIB FILE  ( SEE DOCBLOCK OF
+C                  SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.)
+C     EXTRACT       LOGICAL VALUE INDICATING WHETHER TO RETURN A GRIB2 
+C                   MESSAGE WITH JUST THE REQUESTED FIELD, OR THE ENTIRE
+C                   GRIB2 MESSAGE CONTAINING THE REQUESTED FIELD.
+C                  .TRUE. = RETURN GRIB2 MESSAGE CONTAINING ONLY THE REQUESTED
+C                           FIELD.
+C                  .FALSE. = RETURN ENTIRE GRIB2 MESSAGE CONTAINING THE
+C                            REQUESTED FIELD.
+C
+C   OUTPUT ARGUMENTS:
+C     GRIBM         RETURNED GRIB MESSAGE.
+C     LENG         LENGTH OF RETURNED GRIB MESSAGE IN BYTES.
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    97     ERROR READING GRIB FILE
+C
+C SUBPROGRAMS CALLED:
+C   BAREAD          BYTE-ADDRESSABLE READ
+C
+C REMARKS: NONE 
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+
+      INTEGER,INTENT(IN) :: LUGB
+      CHARACTER(LEN=1),INTENT(IN) :: CINDEX(*)
+      LOGICAL,INTENT(IN) :: EXTRACT
+      INTEGER,INTENT(OUT) :: LENG,IRET
+      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: GRIBM
+ 
+      INTEGER,PARAMETER :: ZERO=0
+      CHARACTER(LEN=1),ALLOCATABLE,DIMENSION(:) :: CSEC2,CSEC6,CSEC7
+      CHARACTER(LEN=4) :: Ctemp
+
+      IRET=0
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  EXTRACT GRIB MESSAGE FROM FILE
+      IF ( EXTRACT ) THEN
+         LEN0=16
+         LEN8=4
+         CALL G2LIB_GBYTE(CINDEX,ISKIP,4*8,4*8)    ! BYTES TO SKIP IN FILE
+         CALL G2LIB_GBYTE(CINDEX,ISKP2,8*8,4*8)    ! BYTES TO SKIP FOR section 2
+         if ( iskp2 .gt. 0 ) then
+            CALL BAREAD(LUGB,ISKIP+ISKP2,4,LREAD,ctemp)
+            CALL G2LIB_GBYTE(Ctemp,LEN2,0,4*8)      ! LENGTH OF SECTION 2
+            ALLOCATE(csec2(len2))
+            CALL BAREAD(LUGB,ISKIP+ISKP2,LEN2,LREAD,csec2)
+         else
+            LEN2=0
+         endif
+         CALL G2LIB_GBYTE(CINDEX,LEN1,44*8,4*8)      ! LENGTH OF SECTION 1
+         IPOS=44+LEN1
+         CALL G2LIB_GBYTE(CINDEX,LEN3,IPOS*8,4*8)      ! LENGTH OF SECTION 3
+         IPOS=IPOS+LEN3
+         CALL G2LIB_GBYTE(CINDEX,LEN4,IPOS*8,4*8)      ! LENGTH OF SECTION 4
+         IPOS=IPOS+LEN4
+         CALL G2LIB_GBYTE(CINDEX,LEN5,IPOS*8,4*8)      ! LENGTH OF SECTION 5
+         IPOS=IPOS+LEN5
+         CALL G2LIB_GBYTE(CINDEX,LEN6,IPOS*8,4*8)      ! LENGTH OF SECTION 6
+         IPOS=IPOS+5
+         CALL G2LIB_GBYTE(CINDEX,IBMAP,IPOS*8,1*8)      ! Bitmap indicator
+         IF ( IBMAP .eq. 254 ) THEN
+            CALL G2LIB_GBYTE(CINDEX,ISKP6,24*8,4*8)    ! BYTES TO SKIP FOR section 6
+            CALL BAREAD(LUGB,ISKIP+ISKP6,4,LREAD,ctemp)
+            CALL G2LIB_GBYTE(Ctemp,LEN6,0,4*8)      ! LENGTH OF SECTION 6
+         ENDIF
+         !
+         !  READ IN SECTION 7 from file
+         !
+         CALL G2LIB_GBYTE(CINDEX,ISKP7,28*8,4*8)    ! BYTES TO SKIP FOR section 7
+         CALL BAREAD(LUGB,ISKIP+ISKP7,4,LREAD,ctemp)
+         CALL G2LIB_GBYTE(Ctemp,LEN7,0,4*8)      ! LENGTH OF SECTION 7
+         ALLOCATE(csec7(len7))
+         CALL BAREAD(LUGB,ISKIP+ISKP7,LEN7,LREAD,csec7)
+
+         LENG=LEN0+LEN1+LEN2+LEN3+LEN4+LEN5+LEN6+LEN7+LEN8
+         IF (.NOT. ASSOCIATED(GRIBM)) ALLOCATE(GRIBM(LENG))
+
+         ! Create Section 0
+         !
+         GRIBM(1)='G'
+         GRIBM(2)='R'
+         GRIBM(3)='I'
+         GRIBM(4)='B'
+         GRIBM(5)=CHAR(0)
+         GRIBM(6)=CHAR(0)
+         GRIBM(7)=CINDEX(42)
+         GRIBM(8)=CINDEX(41)
+         GRIBM(9)=CHAR(0)
+         GRIBM(10)=CHAR(0)
+         GRIBM(11)=CHAR(0)
+         GRIBM(12)=CHAR(0)
+         CALL G2LIB_SBYTE(GRIBM,LENG,12*8,4*8)
+         !
+         ! Copy Section 1
+         !
+         GRIBM(17:16+LEN1)=CINDEX(45:44+LEN1)
+         lencur=16+LEN1
+         ipos=44+len1
+         !
+         ! Copy Section 2, if necessary
+         !
+         if ( iskp2 .gt. 0 ) then
+           GRIBM(lencur+1:lencur+LEN2)=csec2(1:LEN2)
+           lencur=lencur+LEN2
+         endif
+         !
+         ! Copy Sections 3 through 5
+         !
+         GRIBM(lencur+1:lencur+LEN3+LEN4+LEN5)=
+     &                      CINDEX(ipos+1:ipos+LEN3+LEN4+LEN5)
+         lencur=lencur+LEN3+LEN4+LEN5
+         ipos=ipos+LEN3+LEN4+LEN5
+         !
+         ! Copy Section 6
+         !
+         if ( LEN6 .eq. 6 .AND. IBMAP .ne. 254 ) then
+            GRIBM(lencur+1:lencur+LEN6)=CINDEX(ipos+1:ipos+LEN6)
+            lencur=lencur+LEN6
+         else
+            CALL G2LIB_GBYTE(CINDEX,ISKP6,24*8,4*8)    ! BYTES TO SKIP FOR section 6
+            CALL BAREAD(LUGB,ISKIP+ISKP6,4,LREAD,ctemp)
+            CALL G2LIB_GBYTE(Ctemp,LEN6,0,4*8)      ! LENGTH OF SECTION 6
+            ALLOCATE(csec6(len6))
+            CALL BAREAD(LUGB,ISKIP+ISKP6,LEN6,LREAD,csec6)
+            GRIBM(lencur+1:lencur+LEN6)=csec6(1:LEN6)
+            lencur=lencur+LEN6
+            IF ( allocated(csec6)) DEALLOCATE(csec6)
+         endif
+         !
+         ! Copy Section 7
+         !
+         GRIBM(lencur+1:lencur+LEN7)=csec7(1:LEN7)
+         lencur=lencur+LEN7
+         !
+         ! Section 8
+         !
+         GRIBM(lencur+1)='7'
+         GRIBM(lencur+2)='7'
+         GRIBM(lencur+3)='7'
+         GRIBM(lencur+4)='7'
+
+         !  clean up
+         !
+         IF ( allocated(csec2)) DEALLOCATE(csec2)
+         IF ( allocated(csec7)) deallocate(csec7)
+
+      ELSE    ! DO NOT extract field from message :  Get entire message
+
+         CALL G2LIB_GBYTE(CINDEX,ISKIP,4*8,4*8)    ! BYTES TO SKIP IN FILE
+         CALL G2LIB_GBYTE(CINDEX,LENG,36*8,4*8)      ! LENGTH OF GRIB MESSAGE
+         IF (.NOT. ASSOCIATED(GRIBM)) ALLOCATE(GRIBM(LENG))
+         CALL BAREAD(LUGB,ISKIP,LENG,LREAD,GRIBM)
+         IF ( LENG .NE. LREAD ) THEN
+            DEALLOCATE(GRIBM)
+            NULLIFY(GRIBM)
+            IRET=97
+            RETURN
+         ENDIF
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2s.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2s.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getgb2s.F	(revision 2744)
@@ -0,0 +1,537 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE GETGB2S(CBUF,NLEN,NNUM,J,GUESS,JDISC,JIDS,JPDTN,JPDT,
+     &                   JGDTN,JGDT,K,GFLD,LPOS,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: GETGB2S        FINDS A GRIB MESSAGE
+C   PRGMMR: GILBERT          ORG: W/NP11     DATE: 02-01-15
+C
+C ABSTRACT: FIND A GRIB MESSAGE.
+C   FIND IN THE INDEX FILE A REFERENCE TO THE GRIB FIELD REQUESTED.
+C   THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP
+C   AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND 
+C   PRODUCT DEFINTION SECTION PARAMETERS.  (A REQUESTED PARAMETER
+C   OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
+C
+C           EACH INDEX RECORD HAS THE FOLLOWING FORM:
+C       BYTE 001 - 004: LENGTH OF INDEX RECORD
+C       BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
+C       BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
+C                       SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
+C       BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
+C       BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
+C       BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
+C       BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
+C       BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
+C       BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
+C       BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
+C       BYTE 042 - 042: MESSAGE DISCIPLINE
+C       BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
+C       BYTE 045 -  II: IDENTIFICATION SECTION (IDS)
+C       BYTE II+1-  JJ: GRID DEFINITION SECTION (GDS)
+C       BYTE JJ+1-  KK: PRODUCT DEFINITION SECTION (PDS)
+C       BYTE KK+1-  LL: THE DATA REPRESENTATION SECTION (DRS)
+C       BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
+C
+C   Most of the decoded information for the selected GRIB field
+C   is returned in a derived type variable, gfld.  
+C   Gfld is of type gribfield, which is defined
+C   in module grib_mod, so users of this routine will need to include
+C   the line "USE GRIB_MOD" in their calling routine.  Each component of the
+C   gribfield type is described in the OUTPUT ARGUMENT LIST section below.
+C   Only the unpacked bitmap and data field components are not set by this 
+C   routine.
+C
+C PROGRAM HISTORY LOG:
+C   95-10-31  IREDELL
+C 2002-01-02  GILBERT   MODIFIED FROM GETG1S TO WORK WITH GRIB2
+C
+C USAGE:    CALL GETGB2S(CBUF,NLEN,NNUM,J,GUESS,JDISC,JIDS,JPDTN,JPDT,JGDTN,
+C    &                   JGDT,K,GFLD,LPOS,IRET)
+C   INPUT ARGUMENTS:
+C     CBUF         CHARACTER*1 (NLEN) BUFFER CONTAINING INDEX DATA
+C     NLEN         INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
+C     NNUM         INTEGER NUMBER OF INDEX RECORDS
+C     J            INTEGER NUMBER OF MESSAGES TO SKIP
+C                  (=0 TO SEARCH FROM BEGINNING)
+C     GUESS        A GUESS FOR THE INDEX OF THE GRIB RECORD THAT CONTAINS
+C                   THE REQUESTED DATA.  IF GUESS IS CORRECT, SEARCHING
+C                   CAN BE SIGNFICANTLY FASTER, ESPECIALLY FOR FILES
+C                   WITH MANY RECORDS.  IF GUESS IS WRONG OR MISSING (<0), 
+C                   ALL RECORDS ARE SEARCHED
+C     JDISC        GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
+C                  ( IF = -1, ACCEPT ANY DISCIPLINE)
+C                  ( SEE CODE TABLE 0.0 )
+C                  0 - Meteorological products
+C                  1 - Hydrological products
+C                  2 - Land surface products
+C                  3 - Space products
+C                  10 - Oceanographic products
+C     JIDS()       INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
+C                  (=-9999 FOR WILDCARD)
+C            JIDS(1)   = IDENTIFICATION OF ORIGINATING CENTRE
+C                         ( SEE COMMON CODE TABLE C-1 )
+C            JIDS(2)   = IDENTIFICATION OF ORIGINATING SUB-CENTRE
+C            JIDS(3)   = GRIB MASTER TABLES VERSION NUMBER
+C                         ( SEE CODE TABLE 1.0 )
+C                       0 - Experimental
+C                       1 - Initial operational version number
+C            JIDS(4)   = GRIB LOCAL TABLES VERSION NUMBER
+C                         ( SEE CODE TABLE 1.1 )
+C                       0     - Local tables not used
+C                       1-254 - Number of local tables version used
+C            JIDS(5)   = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
+C                       0 - Analysis
+C                       1 - Start of forecast
+C                       2 - Verifying time of forecast
+C                       3 - Observation time
+C            JIDS(6)   = YEAR ( 4 DIGITS )
+C            JIDS(7)   = MONTH
+C            JIDS(8)   = DAY
+C            JIDS(9)   = HOUR
+C            JIDS(10)  = MINUTE
+C            JIDS(11)  = SECOND
+C            JIDS(12)  = PRODUCTION STATUS OF PROCESSED DATA
+C                         ( SEE CODE TABLE 1.3 )
+C                       0 - Operational products
+C                       1 - Operational test products
+C                       2 - Research products
+C                       3 - Re-analysis products
+C            JIDS(13)  = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
+C                       0  - Analysis products
+C                       1  - Forecast products
+C                       2  - Analysis and forecast products
+C                       3  - Control forecast products
+C                       4  - Perturbed forecast products
+C                       5  - Control and perturbed forecast products
+C                       6  - Processed satellite observations
+C                       7  - Processed radar observations
+C     JPDTN        INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
+C                  ( IF = -1, DON'T BOTHER MATCHING PDT )
+C     JPDT()       INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION 
+C                  TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
+C                  (=-9999 FOR WILDCARD)
+C     JGDTN        INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
+C                  ( IF = -1, DON'T BOTHER MATCHING GDT )
+C     JGDT()       INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
+C                  TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
+C                  (=-9999 FOR WILDCARD)
+C   OUTPUT ARGUMENTS:
+C     K            INTEGER MESSAGE NUMBER FOUND
+C                  (CAN BE SAME AS J IN CALLING PROGRAM
+C                  IN ORDER TO FACILITATE MULTIPLE SEARCHES)
+C     gfld - derived type gribfield ( defined in module grib_mod )
+C            ( NOTE: See Remarks Section )
+C        gfld%version = GRIB edition number ( currently 2 )
+C        gfld%discipline = Message Discipline ( see Code Table 0.0 )
+C        gfld%idsect() = Contains the entries in the Identification
+C                        Section ( Section 1 )
+C                        This element is actually a pointer to an array
+C                        that holds the data.
+C            gfld%idsect(1)  = Identification of originating Centre
+C                                    ( see Common Code Table C-1 )
+C                             7 - US National Weather Service
+C            gfld%idsect(2)  = Identification of originating Sub-centre
+C            gfld%idsect(3)  = GRIB Master Tables Version Number
+C                                    ( see Code Table 1.0 )
+C                             0 - Experimental
+C                             1 - Initial operational version number
+C            gfld%idsect(4)  = GRIB Local Tables Version Number
+C                                    ( see Code Table 1.1 )
+C                             0     - Local tables not used
+C                             1-254 - Number of local tables version used
+C            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
+C                             0 - Analysis
+C                             1 - Start of forecast
+C                             2 - Verifying time of forecast
+C                             3 - Observation time
+C            gfld%idsect(6)  = Year ( 4 digits )
+C            gfld%idsect(7)  = Month
+C            gfld%idsect(8)  = Day
+C            gfld%idsect(9)  = Hour
+C            gfld%idsect(10)  = Minute
+C            gfld%idsect(11)  = Second
+C            gfld%idsect(12)  = Production status of processed data
+C                                    ( see Code Table 1.3 )
+C                              0 - Operational products
+C                              1 - Operational test products
+C                              2 - Research products
+C                              3 - Re-analysis products
+C            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
+C                              0  - Analysis products
+C                              1  - Forecast products
+C                              2  - Analysis and forecast products
+C                              3  - Control forecast products
+C                              4  - Perturbed forecast products
+C                              5  - Control and perturbed forecast products
+C                              6  - Processed satellite observations
+C                              7  - Processed radar observations
+C        gfld%idsectlen = Number of elements in gfld%idsect().
+C        gfld%local() = Pointer to character array containing contents
+C                       of Local Section 2, if included
+C        gfld%locallen = length of array gfld%local()
+C        gfld%ifldnum = field number within GRIB message
+C        gfld%griddef = Source of grid definition (see Code Table 3.0)
+C                      0 - Specified in Code table 3.1
+C                      1 - Predetermined grid Defined by originating centre
+C        gfld%ngrdpts = Number of grid points in the defined grid.
+C        gfld%numoct_opt = Number of octets needed for each
+C                          additional grid points definition.
+C                          Used to define number of
+C                          points in each row ( or column ) for
+C                          non-regular grids.
+C                          = 0, if using regular grid.
+C        gfld%interp_opt = Interpretation of list for optional points
+C                          definition.  (Code Table 3.11)
+C        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
+C        gfld%igdtmpl() = Contains the data values for the specified Grid
+C                         Definition Template ( NN=gfld%igdtnum ).  Each
+C                         element of this integer array contains an entry (in
+C                         the order specified) of Grid Defintion Template 3.NN
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
+C                       entries in Grid Defintion Template 3.NN
+C                       ( NN=gfld%igdtnum ).
+C        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
+C                          contains the number of grid points contained in
+C                          each row ( or column ).  (part of Section 3)
+C                          This element is actually a pointer to an array
+C                          that holds the data.  This pointer is nullified
+C                          if gfld%numoct_opt=0.
+C        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
+C                       in array ideflist.  i.e. number of rows ( or columns )
+C                       for which optional grid points are defined.  This value
+C                       is set to zero, if gfld%numoct_opt=0.
+C        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
+C        gfld%ipdtmpl() = Contains the data values for the specified Product
+C                         Definition Template ( N=gfdl%ipdtnum ).  Each element
+C                         of this integer array contains an entry (in the
+C                         order specified) of Product Defintion Template 4.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
+C                       entries in Product Defintion Template 4.N
+C                       ( N=gfdl%ipdtnum ).
+C        gfld%coord_list() = Real array containing floating point values
+C                            intended to document the vertical discretisation
+C                            associated to model data on hybrid coordinate
+C                            vertical levels.  (part of Section 4)
+C                            This element is actually a pointer to an array
+C                            that holds the data.
+C        gfld%num_coord = number of values in array gfld%coord_list().
+C        gfld%ndpts = Number of data points unpacked and returned.
+C        gfld%idrtnum = Data Representation Template Number
+C                       ( see Code Table 5.0)
+C        gfld%idrtmpl() = Contains the data values for the specified Data
+C                         Representation Template ( N=gfld%idrtnum ).  Each
+C                         element of this integer array contains an entry
+C                         (in the order specified) of Product Defintion
+C                         Template 5.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
+C                       of entries in Data Representation Template 5.N
+C                       ( N=gfld%idrtnum ).
+C        gfld%unpacked = logical value indicating whether the bitmap and
+C                        data values were unpacked.  If false,
+C                        gfld%bmap and gfld%fld pointers are nullified.
+C                        NOTE: This routine sets this component to .FALSE.
+C        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
+C                     0 = bitmap applies and is included in Section 6.
+C                     1-253 = Predefined bitmap applies
+C                     254 = Previously defined bitmap applies to this field
+C                     255 = Bit map does not apply to this product.
+C        gfld%bmap() = Logical*1 array containing decoded bitmap,
+C                      if ibmap=0 or ibap=254.  Otherwise nullified.
+C                      This element is actually a pointer to an array
+C                      that holds the data.
+C                      NOTE: This component is not set by this routine.
+C        gfld%fld() = Array of gfld%ndpts unpacked data points.
+C                     This element is actually a pointer to an array
+C                     that holds the data.
+C                      NOTE: This component is not set by this routine.
+C     LPOS         STARTING POSITION OF THE FOUND INDEX RECORD WITHIN
+C                  THE COMPLETE INDEX BUFFER, CBUF.
+C                  = 0, IF REQUEST NOT FOUND
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    1      REQUEST NOT FOUND
+C
+C REMARKS: 
+C   THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY.
+C
+C   Note that derived type gribfield contains pointers to many
+C   arrays of data.  The memory for these arrays is allocated
+C   when the values in the arrays are set, to help minimize
+C   problems with array overloading.  Because of this users
+C   are encouraged to free up this memory, when it is no longer
+C   needed, by an explicit call to subroutine gf_free.
+C   ( i.e.   CALL GF_FREE(GFLD) )
+C
+C SUBPROGRAMS CALLED:
+C   G2LIB_GBYTE            UNPACK BYTES
+C   GF_UNPACK1          UNPACK IDS
+C   GF_UNPACK4          UNPACK PDS
+C   GF_UNPACK3          UNPACK GDS
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE GRIB_MOD
+
+!      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+      CHARACTER(LEN=1),INTENT(IN) :: CBUF(NLEN)
+      INTEGER,INTENT(IN) :: NLEN,NNUM,J,JDISC,JPDTN,JGDTN
+      INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*)
+      INTEGER,INTENT(OUT) :: K,LPOS,IRET
+      TYPE(GRIBFIELD),INTENT(OUT) :: GFLD
+      INTEGER,INTENT(IN) :: GUESS
+      INTEGER :: KGDS(5)
+      LOGICAL :: MATCH1,MATCH3,MATCH4
+      INTEGER :: SKIP
+      INTEGER :: LOOPNUM
+      logical :: skip2
+!      INTEGER,POINTER,DIMENSION(:) :: KIDS,KPDT,KGDT
+!      INTEGER,POINTER,DIMENSION(:) :: IDEF
+!      REAL,POINTER,DIMENSION(:) :: COORD
+
+      interface
+         subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            integer,pointer,dimension(:) :: ids
+            integer,intent(out) :: ierr,idslen
+         end subroutine gf_unpack1
+         subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,
+     &                         mapgridlen,ideflist,idefnum,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            integer,pointer,dimension(:) :: igdstmpl,ideflist
+            integer,intent(out) :: igds(5)
+            integer,intent(out) :: ierr,idefnum
+         end subroutine gf_unpack3
+         subroutine gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,
+     &                      mappdslen,coordlist,numcoord,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            real,pointer,dimension(:) :: coordlist
+            integer,pointer,dimension(:) :: ipdstmpl
+            integer,intent(out) :: ipdsnum
+            integer,intent(out) :: ierr,numcoord
+         end subroutine gf_unpack4
+         subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,
+     &                         idrstmpl,mapdrslen,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            integer,intent(out) :: ndpts,idrsnum
+            integer,pointer,dimension(:) :: idrstmpl
+            integer,intent(out) :: ierr
+         end subroutine gf_unpack5
+      end interface
+      
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  INITIALIZE
+
+
+      K=0
+      SKIP = J
+      LPOS=0
+      IRET=1
+      IPOS=0
+      LOOPNUM = 1
+      skip2 = .false.
+      nullify(gfld%list_opt,gfld%igdtmpl,gfld%ipdtmpl)
+      nullify(gfld%coord_list,gfld%idrtmpl,gfld%bmap,gfld%fld)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  SEARCH FOR REQUEST
+      DOWHILE(IRET.NE.0)
+
+        if (guess .gt. 0) then
+           if (loopnum .eq. 1) then
+
+              ! Check if we are at end of data., If so, search from beginning
+              if (k .ge. NNUM) then
+                 loopnum = loopnum + 1
+                 cycle
+              endif
+
+             ! Set first search to be the guess index.
+              SKIP = guess - 1
+
+           else if (loopnum .eq. 2) then
+
+             ! Set 2nd search to start from beginning.
+              if (.not. skip2) then
+                 SKIP = J
+                 K = 0
+                 ipos = 0
+                 skip2 = .true.
+              endif
+
+           endif
+        endif
+
+        if (k .ge. NNUM) then
+           exit
+        endif
+        
+
+        K=K+1
+        CALL G2LIB_GBYTE(CBUF,INLEN,IPOS*8,4*8) ! GET LENGTH OF CURRENT
+                                ! INDEX RECORD
+
+        IF ( K.LE.SKIP ) THEN   ! SKIP THIS INDEX
+           IPOS=IPOS+INLEN
+           CYCLE
+        ELSE 
+           LOOPNUM = LOOPNUM + 1
+        ENDIF
+
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  CHECK IF GRIB2 DISCIPLINE IS A MATCH
+        CALL G2LIB_GBYTE(CBUF,GFLD%DISCIPLINE,(IPOS+41)*8,1*8)
+        IF ( (JDISC.NE.-1).AND.(JDISC.NE.GFLD%DISCIPLINE) ) THEN
+           IPOS=IPOS+INLEN
+           CYCLE
+        ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  CHECK IF IDENTIFICATION SECTION IS A MATCH
+        MATCH1=.FALSE.
+        CALL G2LIB_GBYTE(CBUF,LSEC1,(IPOS+44)*8,4*8)  ! GET LENGTH OF IDS 
+        IOF=0
+        CALL GF_UNPACK1(CBUF(IPOS+45),LSEC1,IOF,GFLD%IDSECT,
+     &                  GFLD%IDSECTLEN,ICND)
+        IF ( ICND.EQ.0 ) THEN
+           MATCH1=.TRUE.
+           DO I=1,GFLD%IDSECTLEN
+              IF ( (JIDS(I).NE.-9999).AND.
+     &             (JIDS(I).NE.GFLD%IDSECT(I)) ) THEN
+                 MATCH1=.FALSE.
+                 EXIT
+              ENDIF
+           ENDDO
+        ENDIF
+        IF ( .NOT. MATCH1 ) THEN
+           DEALLOCATE(GFLD%IDSECT)
+           IPOS=IPOS+INLEN
+           CYCLE
+        ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  CHECK IF GRID DEFINITION TEMPLATE IS A MATCH
+        JPOS=IPOS+44+LSEC1
+        MATCH3=.FALSE.
+        CALL G2LIB_GBYTE(CBUF,LSEC3,JPOS*8,4*8)  ! GET LENGTH OF GDS 
+        IF ( JGDTN.EQ.-1 ) THEN
+           MATCH3=.TRUE.
+        ELSE
+           CALL G2LIB_GBYTE(CBUF,NUMGDT,(JPOS+12)*8,2*8)  ! GET GDT TEMPLATE NO.
+           IF ( JGDTN.EQ.NUMGDT ) THEN
+              IOF=0
+              CALL GF_UNPACK3(CBUF(JPOS+1),LSEC3,IOF,KGDS,GFLD%IGDTMPL,
+     &                     GFLD%IGDTLEN,GFLD%LIST_OPT,GFLD%NUM_OPT,ICND)
+              IF ( ICND.EQ.0 ) THEN
+                 MATCH3=.TRUE.
+                 DO I=1,GFLD%IGDTLEN
+                    IF ( (JGDT(I).NE.-9999).AND.
+     &                   (JGDT(I).NE.GFLD%IGDTMPL(I)) ) THEN
+                       MATCH3=.FALSE.
+                       EXIT
+                    ENDIF
+                 ENDDO
+C                 WHERE ( JGDT(1:GFLD%IGDTLEN).NE.-9999 ) 
+C     &              MATCH3=ALL(JGDT(1:GFLD%IGDTLEN).EQ.GFLD%IGDTMPL(1:GFLD%IGDTLEN))
+              ENDIF
+           ENDIF
+        ENDIF
+        IF ( .NOT. MATCH3 ) THEN
+           IF (ASSOCIATED(GFLD%IGDTMPL)) DEALLOCATE(GFLD%IGDTMPL)
+           IF (ASSOCIATED(GFLD%LIST_OPT)) DEALLOCATE(GFLD%LIST_OPT)
+           IPOS=IPOS+INLEN
+           CYCLE
+        ELSE
+           GFLD%GRIDDEF=KGDS(1)
+           GFLD%NGRDPTS=KGDS(2)
+           GFLD%NUMOCT_OPT=KGDS(3)
+           GFLD%INTERP_OPT=KGDS(4)
+           GFLD%IGDTNUM=KGDS(5)
+        ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  CHECK IF PRODUCT DEFINITION TEMPLATE IS A MATCH
+        JPOS=JPOS+LSEC3
+        MATCH4=.FALSE.
+        CALL G2LIB_GBYTE(CBUF,LSEC4,JPOS*8,4*8)  ! GET LENGTH OF PDS 
+        IF ( JPDTN.EQ.-1 ) THEN
+           MATCH4=.TRUE.
+        ELSE
+           CALL G2LIB_GBYTE(CBUF,NUMPDT,(JPOS+7)*8,2*8)  ! GET PDT TEMPLATE NO.
+           IF ( JPDTN.EQ.NUMPDT ) THEN
+              IOF=0
+              CALL GF_UNPACK4(CBUF(JPOS+1),LSEC4,IOF,GFLD%IPDTNUM,
+     &                        GFLD%IPDTMPL,GFLD%IPDTLEN,
+     &                        GFLD%COORD_LIST,GFLD%NUM_COORD,ICND)
+              IF ( ICND.EQ.0 ) THEN
+                 MATCH4=.TRUE.
+                 DO I=1,GFLD%IPDTLEN
+                    IF ( (JPDT(I).NE.-9999).AND.
+     &                   (JPDT(I).NE.GFLD%IPDTMPL(I)) ) THEN
+                       MATCH4=.FALSE.
+                       EXIT
+                    ENDIF
+                 ENDDO
+c                 WHERE ( JPDT.NE.-9999) 
+c     &              MATCH4=ALL( JPDT(1:GFLD%IPDTLEN) .EQ. GFLD%IPDTMPL(1:GFLD%IPDTLEN) )
+              ENDIF
+           ENDIF
+        ENDIF
+        IF ( .NOT. MATCH4 ) THEN
+           IF (ASSOCIATED(GFLD%IPDTMPL)) DEALLOCATE(GFLD%IPDTMPL)
+           IF (ASSOCIATED(GFLD%COORD_LIST)) DEALLOCATE(GFLD%COORD_LIST)
+        ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  IF REQUEST IS FOUND
+C  SET VALUES FOR DERIVED TYPE GFLD AND RETURN
+        IF(MATCH1.AND.MATCH3.AND.MATCH4) THEN
+           LPOS=IPOS+1
+           CALL G2LIB_GBYTE(CBUF,GFLD%VERSION,(IPOS+40)*8,1*8)
+           CALL G2LIB_GBYTE(CBUF,GFLD%IFLDNUM,(IPOS+42)*8,2*8)
+           GFLD%UNPACKED=.FALSE.
+           JPOS=IPOS+44+LSEC1
+           IF ( JGDTN.EQ.-1 ) THEN     ! UNPACK GDS, IF NOT DONE BEFORE
+              IOF=0
+              CALL GF_UNPACK3(CBUF(JPOS+1),LSEC3,IOF,KGDS,GFLD%IGDTMPL,
+     &                     GFLD%IGDTLEN,GFLD%LIST_OPT,GFLD%NUM_OPT,ICND)
+              GFLD%GRIDDEF=KGDS(1)
+              GFLD%NGRDPTS=KGDS(2)
+              GFLD%NUMOCT_OPT=KGDS(3)
+              GFLD%INTERP_OPT=KGDS(4)
+              GFLD%IGDTNUM=KGDS(5)
+           ENDIF
+           JPOS=JPOS+LSEC3
+           IF ( JPDTN.EQ.-1 ) THEN     ! UNPACK PDS, IF NOT DONE BEFORE
+              IOF=0
+              CALL GF_UNPACK4(CBUF(JPOS+1),LSEC4,IOF,GFLD%IPDTNUM,
+     &                        GFLD%IPDTMPL,GFLD%IPDTLEN,
+     &                        GFLD%COORD_LIST,GFLD%NUM_COORD,ICND)
+           ENDIF
+           JPOS=JPOS+LSEC4
+           CALL G2LIB_GBYTE(CBUF,LSEC5,JPOS*8,4*8)  ! GET LENGTH OF DRS 
+           IOF=0
+           CALL GF_UNPACK5(CBUF(JPOS+1),LSEC5,IOF,GFLD%NDPTS,
+     &                     GFLD%IDRTNUM,GFLD%IDRTMPL,
+     &                     GFLD%IDRTLEN,ICND)
+           JPOS=JPOS+LSEC5
+           CALL G2LIB_GBYTE(CBUF,GFLD%IBMAP,(JPOS+5)*8,1*8)  ! GET IBMAP
+           IRET=0
+        ELSE      ! PDT DID NOT MATCH
+           IPOS=IPOS+INLEN
+        ENDIF
+      ENDDO
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getidx.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getidx.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getidx.F	(revision 2744)
@@ -0,0 +1,143 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE GETIDX(LUGB,LUGI,CINDEX,NLEN,NNUM,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: GETIDX         FINDS, READS OR GENERATES A GRIB2 INDEX 
+C   PRGMMR: GILBERT          ORG: W/NP11     DATE: 2005-03-15
+C
+C ABSTRACT: FINDS, READS OR GENERATES A GRIB2 INDEX FOR THE GRIB2 FILE
+C  ASSOCIATED WITH UNIT LUGB.  IF THE INDEX ALREADY EXISTS, IT IS RETURNED.
+C  OTHERWISE, THE INDEX IS (1) READ FROM AN EXISTING INDEXFILE ASSOCIATED WITH
+C  UNIT LUGI. OR (2) GENERATED FROM THE GRIB2FILE LUGB ( IF LUGI=0 ). 
+C  USERS CAN FORCE A REGENERATION OF AN INDEX.  IF LUGI EQUALS LUGB, THE INDEX
+C  WILL BE REGENERATED FROM THE DATA IN FILE LUGB.  IF LUGI IS LESS THAN
+C  ZERO, THEN THE INDEX IS RE READ FROM INDEX FILE ABS(LUGI).  
+C
+C PROGRAM HISTORY LOG:
+C 2005-03-15  GILBERT
+C
+C USAGE:    CALL GETIDX(LUGB,LUGI,CINDEX,NLEN,NNUM,IRET)
+C
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
+C                  FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING 
+C                  THIS ROUTINE.
+C     LUGI         INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE.
+C                  IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE 
+C                  CALLING THIS ROUTINE.
+C                  >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T 
+C                       ALREADY EXIST.
+C                  =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX 
+C                       DOESN"T ALREADY EXIST.
+C                  <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI).
+C                  =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB.
+C
+C   OUTPUT ARGUMENTS:
+C     CINDEX       CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
+C     NLEN         INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
+C     NNUM         INTEGER NUMBER OF INDEX RECORDS
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    90     UNIT NUMBER OUT OF RANGE
+C                    96     ERROR READING/CREATING INDEX FILE
+C
+C SUBPROGRAMS CALLED:
+C   GETG2I          READ INDEX FILE
+C   GETG2IR         READ INDEX BUFFER FROM GRIB FILE
+C
+C REMARKS: 
+C
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+
+      INTEGER,INTENT(IN) :: LUGB,LUGI
+      INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET
+      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CINDEX
+
+      INTEGER,PARAMETER :: MAXIDX=100
+      INTEGER,PARAMETER :: MSK1=32000,MSK2=4000
+ 
+      TYPE GINDEX
+         integer :: nlen
+         integer :: nnum
+         character(len=1),pointer,dimension(:) :: cbuf
+      END TYPE GINDEX
+     
+      TYPE(GINDEX),SAVE :: IDXLIST(100)
+
+      DATA LUX/0/
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECLARE INTERFACES (REQUIRED FOR CBUF POINTER)
+      INTERFACE
+         SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET)
+            CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+            INTEGER,INTENT(IN) :: LUGI
+            INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET
+         END SUBROUTINE GETG2I
+         SUBROUTINE GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,
+     &                      NMESS,IRET)
+            CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+            INTEGER,INTENT(IN) :: LUGB,MSK1,MSK2,MNUM
+            INTEGER,INTENT(OUT) :: NLEN,NNUM,NMESS,IRET
+         END SUBROUTINE GETG2IR
+      END INTERFACE
+
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED
+      LUX=0
+      IRET=0
+      IF ( LUGB.LE.0 .AND. LUGB.GT.100 ) THEN
+         IRET=90
+         RETURN
+      ENDIF
+      IF (LUGI.EQ.LUGB) THEN      ! Force regeneration of index from GRIB2 File
+         IF ( ASSOCIATED( IDXLIST(LUGB)%CBUF ) ) 
+     &                  DEALLOCATE(IDXLIST(LUGB)%CBUF)
+         NULLIFY(IDXLIST(LUGB)%CBUF)
+         IDXLIST(LUGB)%NLEN=0
+         IDXLIST(LUGB)%NNUM=0
+         LUX=0
+      ENDIF
+      IF (LUGI.LT.0) THEN      ! Force re-read of index from indexfile
+                               ! associated with unit abs(lugi)
+         IF ( ASSOCIATED( IDXLIST(LUGB)%CBUF ) ) 
+     &                  DEALLOCATE(IDXLIST(LUGB)%CBUF)
+         NULLIFY(IDXLIST(LUGB)%CBUF)
+         IDXLIST(LUGB)%NLEN=0
+         IDXLIST(LUGB)%NNUM=0
+         LUX=ABS(LUGI)
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  Check if index already exists in memory
+      IF ( ASSOCIATED( IDXLIST(LUGB)%CBUF ) ) THEN
+         CINDEX => IDXLIST(LUGB)%CBUF
+         NLEN = IDXLIST(LUGB)%NLEN
+         NNUM = IDXLIST(LUGB)%NNUM
+         RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      IRGI=0
+      IF(LUX.GT.0) THEN
+        CALL GETG2I(LUX,IDXLIST(LUGB)%CBUF,NLEN,NNUM,IRGI)
+      ELSEIF(LUX.LE.0) THEN
+        MSKP=0
+        CALL GETG2IR(LUGB,MSK1,MSK2,MSKP,IDXLIST(LUGB)%CBUF,
+     &               NLEN,NNUM,NMESS,IRGI)
+      ENDIF
+      IF(IRGI.EQ.0) THEN
+         CINDEX => IDXLIST(LUGB)%CBUF
+         IDXLIST(LUGB)%NLEN = NLEN
+         IDXLIST(LUGB)%NNUM = NNUM
+      ELSE
+         NLEN = 0
+         NNUM = 0
+         IRET=96
+         RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getlocal.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getlocal.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getlocal.F	(revision 2744)
@@ -0,0 +1,168 @@
+      subroutine getlocal(cgrib,lcgrib,localnum,csec2,lcsec2,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getlocal 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-25
+!
+! ABSTRACT: This subroutine returns the contents of Section 2 ( Local 
+!   Use Section ) from a GRIB2 message.  Since there can be multiple
+!   occurrences of Section 2 within a GRIB message, the calling routine
+!   indicates which occurrence is being requested with the localnum argument.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-25  Gilbert
+!
+! USAGE:    CALL getlocal(cgrib,lcgrib,localnum,csec2,lcsec2,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message in array cgrib.
+!     localnum - The nth occurrence of Section 2 requested.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     csec2    - Character array containing information read from 
+!                Section 2.
+!                The dimension of this array can be obtained in advance
+!                from argument maxlocal, which is returned from subroutine 
+!                gb_info.
+!     lcsec2   - Number of bytes of character array csec2 read from
+!                Section 2.
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Beginning characters "GRIB" not found.
+!                2 = GRIB message is not Edition 2.
+!                3 = The section 2 request number was not positive.
+!                4 = End string "7777" found, but not where expected.
+!                5 = End string "7777" not found at end of message.
+!                6 = GRIB message did not contain the requested number of
+!                    Local Use Sections.
+!
+! REMARKS: Note that subroutine gb_info can be used to first determine
+!          how many Local Use sections exist in a given GRIB message.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib,localnum
+      character(len=1),intent(out) :: csec2(*)
+      integer,intent(out) :: lcsec2,ierr
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4) :: ctemp
+      integer :: listsec0(2)
+      integer iofst,ibeg,istart,numlocal
+
+      ierr=0
+      numlocal=0
+!
+!  Check for valid request number
+!  
+      if (localnum.le.0) then
+        print *,'getlocal: Request for local section must be positive.'
+        ierr=3
+        return
+      endif
+!
+!  Check for beginning of GRIB message in the first 100 bytes
+!
+      istart=0
+      do j=1,100
+        ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
+        if (ctemp.eq.grib ) then
+          istart=j
+          exit
+        endif
+      enddo
+      if (istart.eq.0) then
+        print *,'getlocal:  Beginning characters GRIB not found.'
+        ierr=1
+        return
+      endif
+!
+!  Unpack Section 0 - Indicator Section 
+!
+      iofst=8*(istart+5)
+      call g2lib_gbyte(cgrib,listsec0(1),iofst,8)     ! Discipline
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,listsec0(2),iofst,8)     ! GRIB edition number
+      iofst=iofst+8
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,lengrib,iofst,32)        ! Length of GRIB message
+      iofst=iofst+32
+      lensec0=16
+      ipos=istart+lensec0
+!
+!  Currently handles only GRIB Edition 2.
+!  
+      if (listsec0(2).ne.2) then
+        print *,'getlocal: can only decode GRIB edition 2.'
+        ierr=2
+        return
+      endif
+!
+!  Loop through the remaining sections keeping track of the 
+!  length of each.  Also check to see that if the current occurrence
+!  of Section 2 is the same as the one requested.
+!
+      do
+        !    Check to see if we are at end of GRIB message
+        ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
+        if (ctemp.eq.c7777 ) then
+          ipos=ipos+4
+          !    If end of GRIB message not where expected, issue error
+          if (ipos.ne.(istart+lengrib)) then
+            print *,'getlocal: "7777" found, but not where expected.'
+            ierr=4
+            return
+          endif
+          exit
+        endif
+        !     Get length of Section and Section number
+        iofst=(ipos-1)*8
+        call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Get Section number
+        iofst=iofst+8
+        !   If found the requested occurrence of Section 2,
+        !   return the section contents.
+        if (isecnum.eq.2) then
+          numlocal=numlocal+1
+          if (numlocal.eq.localnum) then
+            lcsec2=lensec-5
+            csec2(1:lcsec2)=cgrib(ipos+5:ipos+lensec-1)
+            return
+          endif
+        endif
+        !   Check to see if we read pass the end of the GRIB
+        !   message and missed the terminator string '7777'.
+        ipos=ipos+lensec                 ! Update beginning of section pointer
+        if (ipos.gt.(istart+lengrib)) then
+          print *,'getlocal: "7777"  not found at end of GRIB message.'
+          ierr=5
+          return
+        endif
+        
+      enddo
+
+!
+!  If exited from above loop, the end of the GRIB message was reached
+!  before the requested occurrence of section 2 was found.
+!
+      print *,'getlocal: GRIB message contained ',numlocal,
+     &        ' local sections.'
+      print *,'getlocal: The request was for the ',localnum,
+     &        ' occurrence.'
+      ierr=6
+
+      return
+      end
+
+
+
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getpoly.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getpoly.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/getpoly.F	(revision 2744)
@@ -0,0 +1,80 @@
+      subroutine getpoly(csec3,lcsec3,jj,kk,mm)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getpoly 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-12-11
+!
+! ABSTRACT: This subroutine returns the J, K, and M pentagonal resolution
+!   parameters specified in a GRIB Grid Definition Section used
+!   spherical harmonic coefficients using GDT 5.50 through 5.53
+!
+! PROGRAM HISTORY LOG:
+! 2002-12-11  Gilbert
+!
+! USAGE:    CALL getpoly(csec3,lcsec3,jj,kk,mm)
+!   INPUT ARGUMENT LIST:
+!     csec3    - Character array that contains the packed GRIB2 GDS
+!    lcsec3    - Length (in octets) of section 3
+!
+!   OUTPUT ARGUMENT LIST:      
+!         JJ   = J - pentagonal resolution parameter
+!         KK   = K - pentagonal resolution parameter
+!         MM   = M - pentagonal resolution parameter
+!
+! REMARKS:  Returns JJ, KK, and MM set to zero, if grid template
+!           not recognized.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+!      use grib_mod
+    
+      character(len=1),intent(in) :: csec3(*)
+      integer,intent(in) :: lcsec3
+      integer,intent(out) :: jj,kk,mm
+      
+      integer,pointer,dimension(:) :: igdstmpl,list_opt
+      integer :: igds(5)
+      integer iofst,igdtlen,num_opt,jerr
+
+      interface
+         subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,
+     &                         mapgridlen,ideflist,idefnum,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            integer,pointer,dimension(:) :: igdstmpl,ideflist
+            integer,intent(out) :: igds(5)
+            integer,intent(out) :: ierr,idefnum
+         end subroutine gf_unpack3
+      end interface
+
+      nullify(igdstmpl,list_opt)
+        !
+      iofst=0       ! set offset to beginning of section
+      call gf_unpack3(csec3,lcsec3,iofst,igds,igdstmpl,
+     &                 igdtlen,list_opt,num_opt,jerr)
+      if (jerr.eq.0) then
+         selectcase( igds(5) )     !  Template number
+           case (50:53)   ! Spherical harmonic coefficients
+              jj=igdstmpl(1)
+              kk=igdstmpl(2)
+              mm=igdstmpl(3)
+           case default
+              jj=0
+              kk=0
+              mm=0
+         end select
+      else
+         jj=0
+         kk=0
+         mm=0
+      endif
+        !
+      if (associated(igdstmpl)) deallocate(igdstmpl)
+      if (associated(list_opt)) deallocate(list_opt)
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gettemplates.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gettemplates.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gettemplates.F	(revision 2744)
@@ -0,0 +1,244 @@
+      subroutine gettemplates(cgrib,lcgrib,ifldnum,igds,igdstmpl,
+     &                    igdslen,ideflist,idefnum,ipdsnum,ipdstmpl,
+     &                    ipdslen,coordlist,numcoord,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gettemplates 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine returns the Grid Definition, and
+!   Product Definition for a given data
+!   field.  Since there can be multiple data fields packed into a GRIB2
+!   message, the calling routine indicates which field is being requested
+!   with the ifldnum argument.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+!
+! USAGE:    CALL gettemplates(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen,
+!    &                    ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen,
+!    &                    coordlist,numcoord,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     ifldnum  - Specifies which field in the GRIB2 message to return.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     igds     - Contains information read from the appropriate GRIB Grid 
+!                Definition Section 3 for the field being returned.
+!                Must be dimensioned >= 5.
+!                igds(1)=Source of grid definition (see Code Table 3.0)
+!                igds(2)=Number of grid points in the defined grid.
+!                igds(3)=Number of octets needed for each 
+!                            additional grid points definition.  
+!                            Used to define number of
+!                            points in each row ( or column ) for
+!                            non-regular grids.  
+!                            = 0, if using regular grid.
+!                igds(4)=Interpretation of list for optional points 
+!                            definition.  (Code Table 3.11)
+!                igds(5)=Grid Definition Template Number (Code Table 3.1)
+!     igdstmpl - Contains the data values for the specified Grid Definition
+!                Template ( NN=igds(5) ).  Each element of this integer 
+!                array contains an entry (in the order specified) of Grid
+!                Defintion Template 3.NN
+!                A safe dimension for this array can be obtained in advance
+!                from maxvals(2), which is returned from subroutine gribinfo.
+!     igdslen  - Number of elements in igdstmpl().  i.e. number of entries
+!                in Grid Defintion Template 3.NN  ( NN=igds(5) ).
+!     ideflist - (Used if igds(3) .ne. 0)  This array contains the
+!                number of grid points contained in each row ( or column ).
+!                (part of Section 3)
+!                A safe dimension for this array can be obtained in advance
+!                from maxvals(3), which is returned from subroutine gribinfo.
+!     idefnum  - (Used if igds(3) .ne. 0)  The number of entries
+!                in array ideflist.  i.e. number of rows ( or columns )
+!                for which optional grid points are defined.
+!     ipdsnum  - Product Definition Template Number ( see Code Table 4.0)
+!     ipdstmpl - Contains the data values for the specified Product Definition
+!                Template ( N=ipdsnum ).  Each element of this integer
+!                array contains an entry (in the order specified) of Product
+!                Defintion Template 4.N
+!                A safe dimension for this array can be obtained in advance
+!                from maxvals(4), which is returned from subroutine gribinfo.
+!     ipdslen  - Number of elements in ipdstmpl().  i.e. number of entries
+!                in Product Defintion Template 4.N  ( N=ipdsnum ).
+!     coordlist- Array containg floating point values intended to document
+!                the vertical discretisation associated to model data
+!                on hybrid coordinate vertical levels.  (part of Section 4)
+!                The dimension of this array can be obtained in advance
+!                from maxvals(5), which is returned from subroutine gribinfo.
+!     numcoord - number of values in array coordlist.
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Beginning characters "GRIB" not found.
+!                2 = GRIB message is not Edition 2.
+!                3 = The data field request number was not positive.
+!                4 = End string "7777" found, but not where expected.
+!                6 = GRIB message did not contain the requested number of
+!                    data fields.
+!                7 = End string "7777" not found at end of message.
+!               10 = Error unpacking Section 3.
+!               11 = Error unpacking Section 4.
+!
+! REMARKS: Note that subroutine gribinfo can be used to first determine
+!          how many data fields exist in the given GRIB message.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib,ifldnum
+      integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*)
+      integer,intent(out) :: ipdsnum,ipdstmpl(*)
+      integer,intent(out) :: idefnum,numcoord
+      integer,intent(out) :: ierr
+      real,intent(out) :: coordlist(*)
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4) :: ctemp
+      integer:: listsec0(2)
+      integer iofst,ibeg,istart
+      logical have3,have4
+
+      have3=.false.
+      have4=.false.
+      ierr=0
+      numfld=0
+!
+!  Check for valid request number
+!  
+      if (ifldnum.le.0) then
+        print *,'gettemplates: Request for field number must be ',
+     &          'positive.'
+        ierr=3
+        return
+      endif
+!
+!  Check for beginning of GRIB message in the first 100 bytes
+!
+      istart=0
+      do j=1,100
+        ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
+        if (ctemp.eq.grib ) then
+          istart=j
+          exit
+        endif
+      enddo
+      if (istart.eq.0) then
+        print *,'gettemplates:  Beginning characters GRIB not found.'
+        ierr=1
+        return
+      endif
+!
+!  Unpack Section 0 - Indicator Section 
+!
+      iofst=8*(istart+5)
+      call g2lib_gbyte(cgrib,listsec0(1),iofst,8)     ! Discipline
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,listsec0(2),iofst,8)     ! GRIB edition number
+      iofst=iofst+8
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,lengrib,iofst,32)        ! Length of GRIB message
+      iofst=iofst+32
+      lensec0=16
+      ipos=istart+lensec0
+!
+!  Currently handles only GRIB Edition 2.
+!  
+      if (listsec0(2).ne.2) then
+        print *,'gettemplates: can only decode GRIB edition 2.'
+        ierr=2
+        return
+      endif
+!
+!  Loop through the remaining sections keeping track of the 
+!  length of each.  Also keep the latest Grid Definition Section info.
+!  Unpack the requested field number.
+!
+      do
+        !    Check to see if we are at end of GRIB message
+        ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
+        if (ctemp.eq.c7777 ) then
+          ipos=ipos+4
+          !    If end of GRIB message not where expected, issue error
+          if (ipos.ne.(istart+lengrib)) then
+            print *,'gettemplates: "7777" found, but not where ',
+     &              'expected.'
+            ierr=4
+            return
+          endif
+          exit
+        endif
+        !     Get length of Section and Section number
+        iofst=(ipos-1)*8
+        call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Get Section number
+        iofst=iofst+8
+        !print *,' lensec= ',lensec,'    secnum= ',isecnum
+        !
+        !   If found Section 3, unpack the GDS info using the 
+        !   appropriate template.  Save in case this is the latest
+        !   grid before the requested field.
+        !
+        if (isecnum.eq.3) then
+          iofst=iofst-40       ! reset offset to beginning of section
+          call unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,igdslen,
+     &                 ideflist,idefnum,jerr)
+          if (jerr.eq.0) then
+            have3=.true.
+          else
+            ierr=10
+            return
+          endif
+        endif
+        !
+        !   If found Section 4, check to see if this field is the
+        !   one requested.
+        !
+        if (isecnum.eq.4) then
+          numfld=numfld+1
+          if (numfld.eq.ifldnum) then
+            iofst=iofst-40       ! reset offset to beginning of section
+            call unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,ipdslen,
+     &                   coordlist,numcoord,jerr)
+            if (jerr.eq.0) then
+              have4=.true.
+            else
+              ierr=11
+              return
+            endif
+          endif
+        endif
+        !
+        !   Check to see if we read pass the end of the GRIB
+        !   message and missed the terminator string '7777'.
+        !
+        ipos=ipos+lensec                 ! Update beginning of section pointer
+        if (ipos.gt.(istart+lengrib)) then
+          print *,'gettemplates: "7777"  not found at end of GRIB ',
+     &            'message.'
+          ierr=7
+          return
+        endif
+
+        if (have3.and.have4) return
+        
+      enddo
+
+!
+!  If exited from above loop, the end of the GRIB message was reached
+!  before the requested field was found.
+!
+      print *,'gettemplates: GRIB message contained ',numlocal,
+     &        ' different fields.'
+      print *,'gettemplates: The request was for the ',ifldnum,
+     &        ' field.'
+      ierr=6
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_free.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_free.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_free.F	(revision 2744)
@@ -0,0 +1,199 @@
+      subroutine gf_free(gfld)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gf_free 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine frees up memory that was used to store
+!   array values in derived type gribfield.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+!
+! USAGE:    CALL gf_free(gfld)
+!   INPUT ARGUMENT LIST:
+!     gfld - derived type gribfield ( defined in module grib_mod )
+!
+!   OUTPUT ARGUMENT LIST:      
+!     gfld - derived type gribfield ( defined in module grib_mod )
+!        gfld%version = GRIB edition number
+!        gfld%discipline = Message Discipline ( see Code Table 0.0 )
+!        gfld%idsect() = Contains the entries in the Identification
+!                        Section ( Section 1 )
+!                        This element is actually a pointer to an array
+!                        that holds the data.
+!            gfld%idsect(1)  = Identification of originating Centre
+!                                    ( see Common Code Table C-1 )
+!            gfld%idsect(2)  = Identification of originating Sub-centre
+!            gfld%idsect(3)  = GRIB Master Tables Version Number
+!                                    ( see Code Table 1.0 )
+!            gfld%idsect(4)  = GRIB Local Tables Version Number
+!                                    ( see Code Table 1.1 )
+!            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
+!            gfld%idsect(6)  = Year ( 4 digits )
+!            gfld%idsect(7)  = Month
+!            gfld%idsect(8)  = Day
+!            gfld%idsect(9)  = Hour
+!            gfld%idsect(10)  = Minute
+!            gfld%idsect(11)  = Second
+!            gfld%idsect(12)  = Production status of processed data
+!                                    ( see Code Table 1.3 )
+!            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
+!        gfld%idsectlen = Number of elements in gfld%idsect().
+!        gfld%local() = Pointer to character array containing contents
+!                       of Local Section 2, if included
+!        gfld%locallen = length of array gfld%local()
+!        gfld%ifldnum = field number within GRIB message
+!        gfld%griddef = Source of grid definition (see Code Table 3.0)
+!        gfld%ngrdpts = Number of grid points in the defined grid.
+!        gfld%numoct_opt = Number of octets needed for each 
+!                          additional grid points definition.  
+!                          Used to define number of
+!                          points in each row ( or column ) for
+!                          non-regular grids.  
+!                          = 0, if using regular grid.
+!        gfld%interp_opt = Interpretation of list for optional points 
+!                          definition.  (Code Table 3.11)
+!        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
+!        gfld%igdtmpl() = Contains the data values for the specified Grid 
+!                         Definition Template ( NN=gfld%igdtnum ).  Each 
+!                         element of this integer array contains an entry (in 
+!                         the order specified) of Grid Defintion Template 3.NN
+!                         This element is actually a pointer to an array
+!                         that holds the data.
+!        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
+!                       entries in Grid Defintion Template 3.NN  
+!                       ( NN=gfld%igdtnum ).
+!        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array 
+!                          contains the number of grid points contained in 
+!                          each row ( or column ).  (part of Section 3)
+!                          This element is actually a pointer to an array
+!                          that holds the data.  This pointer is nullified
+!                          if gfld%numoct_opt=0.
+!        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
+!                       in array ideflist.  i.e. number of rows ( or columns )
+!                       for which optional grid points are defined.  This value
+!                       is set to zero, if gfld%numoct_opt=0.
+!        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
+!        gfld%ipdtmpl() = Contains the data values for the specified Product 
+!                         Definition Template ( N=gfdl%ipdtnum ).  Each element
+!                         of this integer array contains an entry (in the 
+!                         order specified) of Product Defintion Template 4.N.
+!                         This element is actually a pointer to an array
+!                         that holds the data.
+!        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
+!                       entries in Product Defintion Template 4.N  
+!                       ( N=gfdl%ipdtnum ).
+!        gfld%coord_list() = Real array containing floating point values 
+!                            intended to document the vertical discretisation
+!                            associated to model data on hybrid coordinate
+!                            vertical levels.  (part of Section 4)
+!                            This element is actually a pointer to an array
+!                            that holds the data.
+!        gfld%num_coord = number of values in array gfld%coord_list().
+!        gfld%ndpts = Number of data points unpacked and returned.
+!        gfld%idrtnum = Data Representation Template Number 
+!                       ( see Code Table 5.0)
+!        gfld%idrtmpl() = Contains the data values for the specified Data 
+!                         Representation Template ( N=gfld%idrtnum ).  Each 
+!                         element of this integer array contains an entry 
+!                         (in the order specified) of Product Defintion 
+!                         Template 5.N.
+!                         This element is actually a pointer to an array
+!                         that holds the data.
+!        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number 
+!                       of entries in Data Representation Template 5.N 
+!                       ( N=gfld%idrtnum ).
+!        gfld%unpacked = logical value indicating whether the bitmap and
+!                        data values were unpacked.  If false, gfld%ndpts
+!                        is set to zero, and gfld%bmap and gfld%fld 
+!                        pointers are nullified.
+!        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
+!                     0 = bitmap applies and is included in Section 6.
+!                     1-253 = Predefined bitmap applies
+!                     254 = Previously defined bitmap applies to this field
+!                     255 = Bit map does not apply to this product.
+!        gfld%bmap() - Logical*1 array containing decoded bitmap, 
+!                      if ibmap=0 or ibap=254.  Otherwise nullified.
+!                      This element is actually a pointer to an array
+!                      that holds the data.
+!        gfld%fld() = Array of gfld%ndpts unpacked data points.
+!                     This element is actually a pointer to an array
+!                     that holds the data.
+!
+! REMARKS: 
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+      use grib_mod
+    
+      type(gribfield) :: gfld
+
+      if (associated(gfld%idsect)) then
+         deallocate(gfld%idsect)
+         !deallocate(gfld%idsect,stat=is)
+         !print *,'gfld%idsect: ',is
+      endif
+      nullify(gfld%idsect)
+
+      if (associated(gfld%local)) then
+         deallocate(gfld%local)
+         !deallocate(gfld%local,stat=is)
+         !print *,'gfld%local: ',is
+      endif
+      nullify(gfld%local)
+
+      if (associated(gfld%list_opt)) then
+         deallocate(gfld%list_opt)
+         !deallocate(gfld%list_opt,stat=is)
+         !print *,'gfld%list_opt: ',is
+      endif
+      nullify(gfld%list_opt)
+
+      if (associated(gfld%igdtmpl)) then
+         deallocate(gfld%igdtmpl)
+         !deallocate(gfld%igdtmpl,stat=is)
+         !print *,'gfld%igdtmpl: ',is
+      endif
+      nullify(gfld%igdtmpl)
+
+      if (associated(gfld%ipdtmpl)) then
+         deallocate(gfld%ipdtmpl)
+         !deallocate(gfld%ipdtmpl,stat=is)
+         !print *,'gfld%ipdtmpl: ',is
+      endif
+      nullify(gfld%ipdtmpl)
+
+      if (associated(gfld%coord_list)) then
+         deallocate(gfld%coord_list)
+         !deallocate(gfld%coord_list,stat=is)
+         !print *,'gfld%coord_list: ',is
+      endif
+      nullify(gfld%coord_list)
+
+      if (associated(gfld%idrtmpl)) then
+         deallocate(gfld%idrtmpl)
+         !deallocate(gfld%idrtmpl,stat=is)
+         !print *,'gfld%idrtmpl: ',is
+      endif
+      nullify(gfld%idrtmpl)
+
+      if (associated(gfld%bmap)) then
+         deallocate(gfld%bmap)
+         !deallocate(gfld%bmap,stat=is)
+         !print *,'gfld%bmap: ',is
+      endif
+      nullify(gfld%bmap)
+
+      if (associated(gfld%fld)) then
+         deallocate(gfld%fld)
+         !deallocate(gfld%fld,stat=is)
+         !print *,'gfld%fld: ',is
+      endif
+      nullify(gfld%fld)
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_getfld.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_getfld.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_getfld.F	(revision 2744)
@@ -0,0 +1,602 @@
+      subroutine gf_getfld(cgrib,lcgrib,ifldnum,unpack,expand,gfld,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gf_getfld 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine returns the Grid Definition, Product Definition,
+!   Bit-map ( if applicable ), and the unpacked data for a given data
+!   field.  All of the information returned is stored in a derived
+!   type variable, gfld.  Gfld is of type gribfield, which is defined
+!   in module grib_mod, so users of this routine will need to include
+!   the line "USE GRIB_MOD" in their calling routine.  Each component of the 
+!   gribfield type is described in the OUTPUT ARGUMENT LIST section below.
+!
+!   Since there can be multiple data fields packed into a GRIB2
+!   message, the calling routine indicates which field is being requested
+!   with the ifldnum argument.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+! 2002-01-24  Gilbert  - Changed to pass back derived type gribfield
+!                        variable through argument list, instead of
+!                        having many different arguments.
+! 2004-05-20  Gilbert  - Added check to see if previous a bit-map is specified,
+!                        but none was found.
+!
+! USAGE:    CALL gf_getfld(cgrib,lcgrib,ifldnum,unpack,expand,gfld,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     ifldnum  - Specifies which field in the GRIB2 message to return.
+!     unpack   - Logical value indicating whether to unpack bitmap/data
+!                .true. = unpack bitmap and data values
+!                .false. = do not unpack bitmap and data values
+!     expand   - Boolean value indicating whether the data points should be
+!                expanded to the correspond grid, if a bit-map is present.
+!                1 = if possible, expand data field to grid, inserting zero
+!                    values at gridpoints that are bitmapped out.
+!                    (SEE REMARKS2)
+!                0 = do not expand data field, leaving it an array of
+!                    consecutive data points for each "1" in the bitmap.
+!                This argument is ignored if unpack == 0 OR if the
+!                returned field does not contain a bit-map.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     gfld - derived type gribfield ( defined in module grib_mod )
+!            ( NOTE: See Remarks Section )
+!        gfld%version = GRIB edition number ( currently 2 )
+!        gfld%discipline = Message Discipline ( see Code Table 0.0 )
+!        gfld%idsect() = Contains the entries in the Identification
+!                        Section ( Section 1 )
+!                        This element is actually a pointer to an array
+!                        that holds the data.
+!            gfld%idsect(1)  = Identification of originating Centre 
+!                                    ( see Common Code Table C-1 )
+!                             7 - US National Weather Service
+!            gfld%idsect(2)  = Identification of originating Sub-centre
+!            gfld%idsect(3)  = GRIB Master Tables Version Number
+!                                    ( see Code Table 1.0 )
+!                             0 - Experimental
+!                             1 - Initial operational version number
+!            gfld%idsect(4)  = GRIB Local Tables Version Number
+!                                    ( see Code Table 1.1 )
+!                             0     - Local tables not used
+!                             1-254 - Number of local tables version used
+!            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
+!                             0 - Analysis
+!                             1 - Start of forecast
+!                             2 - Verifying time of forecast
+!                             3 - Observation time
+!            gfld%idsect(6)  = Year ( 4 digits )
+!            gfld%idsect(7)  = Month
+!            gfld%idsect(8)  = Day
+!            gfld%idsect(9)  = Hour
+!            gfld%idsect(10)  = Minute
+!            gfld%idsect(11)  = Second
+!            gfld%idsect(12)  = Production status of processed data
+!                                    ( see Code Table 1.3 )
+!                              0 - Operational products
+!                              1 - Operational test products
+!                              2 - Research products
+!                              3 - Re-analysis products
+!            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
+!                              0  - Analysis products
+!                              1  - Forecast products
+!                              2  - Analysis and forecast products
+!                              3  - Control forecast products
+!                              4  - Perturbed forecast products
+!                              5  - Control and perturbed forecast products
+!                              6  - Processed satellite observations
+!                              7  - Processed radar observations
+!        gfld%idsectlen = Number of elements in gfld%idsect().
+!        gfld%local() = Pointer to character array containing contents
+!                       of Local Section 2, if included
+!        gfld%locallen = length of array gfld%local()
+!        gfld%ifldnum = field number within GRIB message
+!        gfld%griddef = Source of grid definition (see Code Table 3.0)
+!                      0 - Specified in Code table 3.1
+!                      1 - Predetermined grid Defined by originating centre
+!        gfld%ngrdpts = Number of grid points in the defined grid.
+!        gfld%numoct_opt = Number of octets needed for each 
+!                          additional grid points definition.  
+!                          Used to define number of
+!                          points in each row ( or column ) for
+!                          non-regular grids.  
+!                          = 0, if using regular grid.
+!        gfld%interp_opt = Interpretation of list for optional points 
+!                          definition.  (Code Table 3.11)
+!        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
+!        gfld%igdtmpl() = Contains the data values for the specified Grid 
+!                         Definition Template ( NN=gfld%igdtnum ).  Each 
+!                         element of this integer array contains an entry (in 
+!                         the order specified) of Grid Defintion Template 3.NN
+!                         This element is actually a pointer to an array
+!                         that holds the data.
+!        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
+!                       entries in Grid Defintion Template 3.NN  
+!                       ( NN=gfld%igdtnum ).
+!        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array 
+!                          contains the number of grid points contained in 
+!                          each row ( or column ).  (part of Section 3)
+!                          This element is actually a pointer to an array
+!                          that holds the data.  This pointer is nullified
+!                          if gfld%numoct_opt=0.
+!        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
+!                       in array ideflist.  i.e. number of rows ( or columns )
+!                       for which optional grid points are defined.  This value
+!                       is set to zero, if gfld%numoct_opt=0.
+!        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
+!        gfld%ipdtmpl() = Contains the data values for the specified Product 
+!                         Definition Template ( N=gfdl%ipdtnum ).  Each element
+!                         of this integer array contains an entry (in the 
+!                         order specified) of Product Defintion Template 4.N.
+!                         This element is actually a pointer to an array
+!                         that holds the data.
+!        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
+!                       entries in Product Defintion Template 4.N  
+!                       ( N=gfdl%ipdtnum ).
+!        gfld%coord_list() = Real array containing floating point values 
+!                            intended to document the vertical discretisation
+!                            associated to model data on hybrid coordinate
+!                            vertical levels.  (part of Section 4)
+!                            This element is actually a pointer to an array
+!                            that holds the data.
+!        gfld%num_coord = number of values in array gfld%coord_list().
+!        gfld%ndpts = Number of data points unpacked and returned.
+!        gfld%idrtnum = Data Representation Template Number 
+!                       ( see Code Table 5.0)
+!        gfld%idrtmpl() = Contains the data values for the specified Data 
+!                         Representation Template ( N=gfld%idrtnum ).  Each 
+!                         element of this integer array contains an entry 
+!                         (in the order specified) of Product Defintion 
+!                         Template 5.N.
+!                         This element is actually a pointer to an array
+!                         that holds the data.
+!        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number 
+!                       of entries in Data Representation Template 5.N 
+!                       ( N=gfld%idrtnum ).
+!        gfld%unpacked = logical value indicating whether the bitmap and
+!                        data values were unpacked.  If false, 
+!                        gfld%bmap and gfld%fld pointers are nullified.
+!        gfld%expanded = Logical value indicating whether the data field
+!                         was expanded to the grid in the case where a
+!                         bit-map is present.  If true, the data points in
+!                         gfld%fld match the grid points and zeros were
+!                         inserted at grid points where data was bit-mapped
+!                         out.  If false, the data values in gfld%fld were
+!                         not expanded to the grid and are just a consecutive
+!                         array of data points corresponding to each value of
+!                         "1" in gfld%bmap.
+!        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
+!                     0 = bitmap applies and is included in Section 6.
+!                     1-253 = Predefined bitmap applies
+!                     254 = Previously defined bitmap applies to this field
+!                     255 = Bit map does not apply to this product.
+!        gfld%bmap() = Logical*1 array containing decoded bitmap, 
+!                      if ibmap=0 or ibap=254.  Otherwise nullified.
+!                      This element is actually a pointer to an array
+!                      that holds the data.
+!        gfld%fld() = Array of gfld%ndpts unpacked data points.
+!                     This element is actually a pointer to an array
+!                     that holds the data.
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Beginning characters "GRIB" not found.
+!                2 = GRIB message is not Edition 2.
+!                3 = The data field request number was not positive.
+!                4 = End string "7777" found, but not where expected.
+!                6 = GRIB message did not contain the requested number of
+!                    data fields.
+!                7 = End string "7777" not found at end of message.
+!                8 = Unrecognized Section encountered.
+!                9 = Data Representation Template 5.NN not yet implemented.
+!               15 = Error unpacking Section 1.
+!               16 = Error unpacking Section 2.
+!               10 = Error unpacking Section 3.
+!               11 = Error unpacking Section 4.
+!               12 = Error unpacking Section 5.
+!               13 = Error unpacking Section 6.
+!               14 = Error unpacking Section 7.
+!               17 = Previous bitmap specified, but none exists.
+!
+! REMARKS: Note that derived type gribfield contains pointers to many
+!          arrays of data.  The memory for these arrays is allocated
+!          when the values in the arrays are set, to help minimize
+!          problems with array overloading.  Because of this users
+!          are encouraged to free up this memory, when it is no longer
+!          needed, by an explicit call to subroutine gf_free.
+!          ( i.e.   CALL GF_FREE(GFLD) )
+!
+!          Subroutine gb_info can be used to first determine
+!          how many data fields exist in a given GRIB message.
+!
+! REMARKS2: It may not always be possible to expand a bit-mapped data field.
+!           If a pre-defined bit-map is used and not included in the GRIB2
+!           message itself, this routine would not have the necessary
+!           information to expand the data.  In this case, gfld%expanded would
+!           would be set to 0 (false), regardless of the value of input
+!           argument expand.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+      use grib_mod
+    
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib,ifldnum
+      logical,intent(in) :: unpack,expand
+      type(gribfield),intent(out) :: gfld
+      integer,intent(out) :: ierr
+!      integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*)
+!      integer,intent(out) :: ipdsnum,ipdstmpl(*)
+!      integer,intent(out) :: idrsnum,idrstmpl(*)
+!      integer,intent(out) :: ndpts,ibmap,idefnum,numcoord
+!      logical*1,intent(out) :: bmap(*)
+!      real,intent(out) :: fld(*),coordlist(*)
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4) :: ctemp
+      real,pointer,dimension(:) :: newfld
+      integer:: listsec0(2),igds(5)
+      integer iofst,ibeg,istart
+      integer(4) :: ieee
+      logical*1,pointer,dimension(:) :: bmpsave
+      logical have3,have4,have5,have6,have7
+
+      interface
+         subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            integer,pointer,dimension(:) :: ids
+            integer,intent(out) :: ierr,idslen
+         end subroutine gf_unpack1
+         subroutine gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            integer,intent(out) :: lencsec2
+            integer,intent(out) :: ierr
+            character(len=1),pointer,dimension(:) :: csec2
+         end subroutine gf_unpack2
+         subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,
+     &                         mapgridlen,ideflist,idefnum,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            integer,pointer,dimension(:) :: igdstmpl,ideflist
+            integer,intent(out) :: igds(5)
+            integer,intent(out) :: ierr,idefnum
+         end subroutine gf_unpack3
+         subroutine gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,
+     &                      mappdslen,coordlist,numcoord,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            real,pointer,dimension(:) :: coordlist
+            integer,pointer,dimension(:) :: ipdstmpl
+            integer,intent(out) :: ipdsnum
+            integer,intent(out) :: ierr,numcoord
+         end subroutine gf_unpack4
+         subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,
+     &                         idrstmpl,mapdrslen,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib
+            integer,intent(inout) :: iofst
+            integer,intent(out) :: ndpts,idrsnum
+            integer,pointer,dimension(:) :: idrstmpl
+            integer,intent(out) :: ierr
+         end subroutine gf_unpack5
+         subroutine gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib,ngpts
+            integer,intent(inout) :: iofst
+            integer,intent(out) :: ibmap
+            integer,intent(out) :: ierr
+            logical*1,pointer,dimension(:) :: bmap
+         end subroutine gf_unpack6
+         subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl,
+     &                         idrsnum,idrstmpl,ndpts,fld,ierr)
+            character(len=1),intent(in) :: cgrib(lcgrib)
+            integer,intent(in) :: lcgrib,ndpts,idrsnum,igdsnum
+            integer,intent(inout) :: iofst
+            integer,pointer,dimension(:) :: idrstmpl,igdstmpl
+            integer,intent(out) :: ierr
+            real,pointer,dimension(:) :: fld
+         end subroutine gf_unpack7
+      end interface
+
+      have3=.false.
+      have4=.false.
+      have5=.false.
+      have6=.false.
+      have7=.false.
+      ierr=0
+      numfld=0
+      gfld%locallen=0
+      nullify(gfld%list_opt,gfld%igdtmpl,gfld%ipdtmpl)
+      nullify(gfld%coord_list,gfld%idrtmpl,gfld%bmap,gfld%fld)
+!
+!  Check for valid request number
+!  
+      if (ifldnum.le.0) then
+        print *,'gf_getfld: Request for field number must be positive.'
+        ierr=3
+        return
+      endif
+!
+!  Check for beginning of GRIB message in the first 100 bytes
+!
+      istart=0
+      do j=1,100
+        ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
+        if (ctemp.eq.grib ) then
+          istart=j
+          exit
+        endif
+      enddo
+      if (istart.eq.0) then
+        print *,'gf_getfld:  Beginning characters GRIB not found.'
+        ierr=1
+        return
+      endif
+!
+!  Unpack Section 0 - Indicator Section 
+!
+      iofst=8*(istart+5)
+      call g2lib_gbyte(cgrib,listsec0(1),iofst,8)     ! Discipline
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,listsec0(2),iofst,8)     ! GRIB edition number
+      iofst=iofst+8
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,lengrib,iofst,32)        ! Length of GRIB message
+      iofst=iofst+32
+      lensec0=16
+      ipos=istart+lensec0
+!
+!  Currently handles only GRIB Edition 2.
+!  
+      if (listsec0(2).ne.2) then
+        print *,'gf_getfld: can only decode GRIB edition 2.'
+        ierr=2
+        return
+      endif
+!
+!  Loop through the remaining sections keeping track of the 
+!  length of each.  Also keep the latest Grid Definition Section info.
+!  Unpack the requested field number.
+!
+      do
+        !    Check to see if we are at end of GRIB message
+        ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
+        if (ctemp.eq.c7777 ) then
+          ipos=ipos+4
+          !    If end of GRIB message not where expected, issue error
+          if (ipos.ne.(istart+lengrib)) then
+            print *,'gf_getfld: "7777" found, but not where expected.'
+            ierr=4
+            return
+          endif
+          exit
+        endif
+        !     Get length of Section and Section number
+        iofst=(ipos-1)*8
+        call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Get Section number
+        iofst=iofst+8
+        !print *,' lensec= ',lensec,'    secnum= ',isecnum
+        !
+        !  Check to see if section number is valid
+        !
+        if ( (isecnum.lt.1).OR.(isecnum.gt.7) ) then
+          print *,'gf_getfld: Unrecognized Section Encountered=',isecnum     
+          ierr=8
+          return
+        endif
+        !
+        !   If found Section 1, decode elements in Identification Section
+        !
+        if (isecnum.eq.1) then
+          iofst=iofst-40       ! reset offset to beginning of section
+          call gf_unpack1(cgrib,lcgrib,iofst,gfld%idsect,
+     &                    gfld%idsectlen,jerr)
+          if (jerr.ne.0) then
+            ierr=15
+            return
+          endif
+        endif
+        !
+        !   If found Section 2, Grab local section
+        !   Save in case this is the latest one before the requested field.
+        !
+        if (isecnum.eq.2) then
+          iofst=iofst-40       ! reset offset to beginning of section
+          if (associated(gfld%local)) deallocate(gfld%local)
+          call gf_unpack2(cgrib,lcgrib,iofst,gfld%locallen,
+     &                    gfld%local,jerr)
+          if (jerr.ne.0) then
+            ierr=16
+            return
+          endif
+        endif
+        !
+        !   If found Section 3, unpack the GDS info using the 
+        !   appropriate template.  Save in case this is the latest
+        !   grid before the requested field.
+        !
+        if (isecnum.eq.3) then
+          iofst=iofst-40       ! reset offset to beginning of section
+          if (associated(gfld%igdtmpl)) deallocate(gfld%igdtmpl)
+          if (associated(gfld%list_opt)) deallocate(gfld%list_opt)
+          call gf_unpack3(cgrib,lcgrib,iofst,igds,gfld%igdtmpl,
+     &                 gfld%igdtlen,gfld%list_opt,gfld%num_opt,jerr)
+          if (jerr.eq.0) then
+            have3=.true.
+            gfld%griddef=igds(1)
+            gfld%ngrdpts=igds(2)
+            gfld%numoct_opt=igds(3)
+            gfld%interp_opt=igds(4)
+            gfld%igdtnum=igds(5)
+          else
+            ierr=10
+            return
+          endif
+        endif
+        !
+        !   If found Section 4, check to see if this field is the
+        !   one requested.
+        !
+        if (isecnum.eq.4) then
+          numfld=numfld+1
+          if (numfld.eq.ifldnum) then
+            gfld%discipline=listsec0(1)
+            gfld%version=listsec0(2)
+            gfld%ifldnum=ifldnum
+            gfld%unpacked=unpack
+            gfld%expanded=.false.
+            iofst=iofst-40       ! reset offset to beginning of section
+            call gf_unpack4(cgrib,lcgrib,iofst,gfld%ipdtnum,
+     &                      gfld%ipdtmpl,gfld%ipdtlen,gfld%coord_list,
+     &                      gfld%num_coord,jerr)
+            if (jerr.eq.0) then
+              have4=.true.
+            else
+              ierr=11
+              return
+            endif
+          endif
+        endif
+        !
+        !   If found Section 5, check to see if this field is the
+        !   one requested.
+        !
+        if ((isecnum.eq.5).and.(numfld.eq.ifldnum)) then
+          iofst=iofst-40       ! reset offset to beginning of section
+          call gf_unpack5(cgrib,lcgrib,iofst,gfld%ndpts,gfld%idrtnum,
+     &                    gfld%idrtmpl,gfld%idrtlen,jerr)
+          if (jerr.eq.0) then
+            have5=.true.
+          else
+            ierr=12
+            return
+          endif
+        endif
+        !
+        !   If found Section 6, Unpack bitmap.
+        !   Save in case this is the latest
+        !   bitmap before the requested field.
+        !
+        if (isecnum.eq.6) then
+          if (unpack) then   ! unpack bitmap
+            iofst=iofst-40       ! reset offset to beginning of section
+            bmpsave=>gfld%bmap      ! save pointer to previous bitmap
+            call gf_unpack6(cgrib,lcgrib,iofst,gfld%ngrdpts,gfld%ibmap,
+     &                   gfld%bmap,jerr)
+            if (jerr.eq.0) then
+              have6=.true.
+              if (gfld%ibmap .eq. 254) then    ! use previously specified bitmap
+                 if ( associated(bmpsave) ) then
+                    gfld%bmap=>bmpsave
+                 else
+                    print *,'gf_getfld:  Previous bit-map specified,',
+     &                       ' but none exists,'
+                    ierr=17
+                    return
+                 endif
+              else                             ! get rid of it
+                 if ( associated(bmpsave) ) deallocate(bmpsave)
+              endif
+            else
+              ierr=13
+              return
+            endif
+          else    ! do not unpack bitmap
+            call g2lib_gbyte(cgrib,gfld%ibmap,iofst,8)      ! Get BitMap Indicator
+            have6=.true.
+          endif
+        endif
+        !
+        !   If found Section 7, check to see if this field is the
+        !   one requested.
+        !
+        if ((isecnum.eq.7).and.(numfld.eq.ifldnum).and.unpack) then
+          iofst=iofst-40       ! reset offset to beginning of section
+          call gf_unpack7(cgrib,lcgrib,iofst,gfld%igdtnum,
+     &                    gfld%igdtmpl,gfld%idrtnum,
+     &                    gfld%idrtmpl,gfld%ndpts,
+     &                    gfld%fld,jerr)
+          if (jerr.eq.0) then
+            have7=.true.
+            !  If bitmap is used with this field, expand data field
+            !  to grid, if possible.
+            if ( gfld%ibmap .ne. 255 .AND. associated(gfld%bmap) ) then
+               if ( expand ) then
+                  allocate(newfld(gfld%ngrdpts))
+                  !newfld(1:gfld%ngrdpts)=0.0
+                  !newfld=unpack(gfld%fld,gfld%bmap,newfld)
+                  n=1
+                  do j=1,gfld%ngrdpts
+                      if ( gfld%bmap(j) ) then
+                        newfld(j)=gfld%fld(n)
+                        n=n+1
+                      else
+                        newfld(j)=0.0
+                      endif
+                  enddo
+                  deallocate(gfld%fld);
+                  gfld%fld=>newfld;
+                  gfld%expanded=.true.
+               else 
+                  gfld%expanded=.false.
+               endif
+            else 
+               gfld%expanded=.true.
+            endif
+          else
+            print *,'gf_getfld: return from gf_unpack7 = ',jerr
+            ierr=14
+            return
+          endif
+        endif
+        !
+        !   Check to see if we read pass the end of the GRIB
+        !   message and missed the terminator string '7777'.
+        !
+        ipos=ipos+lensec                 ! Update beginning of section pointer
+        if (ipos.gt.(istart+lengrib)) then
+          print *,'gf_getfld: "7777"  not found at end of GRIB message.'
+          ierr=7
+          return
+        endif
+        !
+        !  If unpacking requested, return when all sections have been
+        !  processed
+        !
+        if (unpack.and.have3.and.have4.and.have5.and.have6.and.have7)
+     &      return
+        !
+        !  If unpacking is not requested, return when sections 
+        !  3 through 6 have been processed
+        !
+        if ((.NOT.unpack).and.have3.and.have4.and.have5.and.have6)
+     &      return
+        
+      enddo
+
+!
+!  If exited from above loop, the end of the GRIB message was reached
+!  before the requested field was found.
+!
+      print *,'gf_getfld: GRIB message contained ',numlocal,
+     &        ' different fields.'
+      print *,'gf_getfld: The request was for the ',ifldnum,
+     &        ' field.'
+      ierr=6
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack1.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack1.F	(revision 2744)
@@ -0,0 +1,93 @@
+      subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gf_unpack1 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine unpacks Section 1 (Identification Section)
+!   starting at octet 6 of that Section.  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+! 2002-01-24  Gilbert  - Changed to dynamically allocate arrays
+!                        and to pass pointers to those arrays through
+!                        the argument list.
+!
+! USAGE:    CALL gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array containing Section 1 of the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 1.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset at the end of Section 1, returned.
+!     ids      - Pointer to integer array containing information read from 
+!                Section 1, the Identification section.
+!            ids(1)  = Identification of originating Centre
+!                                 ( see Common Code Table C-1 )
+!            ids(2)  = Identification of originating Sub-centre
+!            ids(3)  = GRIB Master Tables Version Number
+!                                 ( see Code Table 1.0 )
+!            ids(4)  = GRIB Local Tables Version Number
+!                                 ( see Code Table 1.1 )
+!            ids(5)  = Significance of Reference Time (Code Table 1.2)
+!            ids(6)  = Year ( 4 digits )
+!            ids(7)  = Month
+!            ids(8)  = Day
+!            ids(9)  = Hour
+!            ids(10)  = Minute
+!            ids(11)  = Second
+!            ids(12)  = Production status of processed data
+!                                 ( see Code Table 1.3 )
+!            ids(13)  = Type of processed data ( see Code Table 1.4 )
+!     idslen   - Number of elements in ids().
+!     ierr     - Error return code.
+!                0 = no error
+!                6 = memory allocation error
+!
+! REMARKS: 
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(inout) :: iofst
+      integer,pointer,dimension(:) :: ids
+      integer,intent(out) :: ierr,idslen
+
+      integer,dimension(:) :: mapid(13)
+
+      data mapid /2,2,1,1,1,2,1,1,1,1,1,1,1/
+
+      ierr=0
+      idslen=13
+      nullify(ids)
+
+      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+      iofst=iofst+32
+      iofst=iofst+8     ! skip section number
+      !
+      !   Unpack each value into array ids from the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mapid.
+      !
+      istat=0
+      allocate(ids(idslen),stat=istat)
+      if (istat.ne.0) then
+         ierr=6
+         nullify(ids)
+         return
+      endif
+      
+      do i=1,idslen
+        nbits=mapid(i)*8
+        call g2lib_gbyte(cgrib,ids(i),iofst,nbits)
+        iofst=iofst+nbits
+      enddo
+      
+      return    ! End of Section 1 processing
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack2.F	(revision 2744)
@@ -0,0 +1,72 @@
+      subroutine gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gf_unpack2 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-04-09
+!
+! ABSTRACT: This subroutine unpacks Section 2 (Local Use Section)
+!           as defined in GRIB Edition 2.
+!
+! PROGRAM HISTORY LOG:
+! 2002-04-09  Gilbert
+!
+! USAGE:    CALL gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array containing Section 2 of the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 2.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset at the end of Section 2, returned.
+!     lencsec2 - Length (in octets) of Local Use data
+!     csec2()  - Pointer to a character*1 array containing local use data
+!     ierr     - Error return code.
+!                0 = no error
+!                2 = Array passed is not section 2
+!                6 = memory allocation error
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(inout) :: iofst
+      integer,intent(out) :: lencsec2
+      integer,intent(out) :: ierr
+      character(len=1),pointer,dimension(:) :: csec2
+
+      ierr=0
+      lencsec2=0
+      nullify(csec2)
+
+      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+      iofst=iofst+32    
+      lencsec2=lensec-5
+      call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Get Section Number
+      iofst=iofst+8     
+      ipos=(iofst/8)+1
+
+      if ( isecnum.ne.2 ) then
+         ierr=6
+         print *,'gf_unpack2: Not Section 2 data. '
+         return
+      endif
+
+      allocate(csec2(lencsec2),stat=istat)
+      if (istat.ne.0) then
+         ierr=6
+         nullify(csec2)
+         return
+      endif
+      
+      csec2(1:lencsec2)=cgrib(ipos:ipos+lencsec2-1)
+      iofst=iofst+(lencsec2*8)
+
+      return    ! End of Section 2 processing
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack3.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack3.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack3.F	(revision 2744)
@@ -0,0 +1,189 @@
+      subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,
+     &                   mapgridlen,ideflist,idefnum,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gf_unpack3 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine unpacks Section 3 (Grid Definition Section)
+!   starting at octet 6 of that Section.  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+! 2002-01-24  Gilbert  - Changed to dynamically allocate arrays
+!                        and to pass pointers to those arrays through
+!                        the argument list.
+!
+! USAGE:    CALL gf_unpack3(cgrib,lcgrib,lensec,iofst,igds,igdstmpl,
+!    &                   mapgridlen,ideflist,idefnum,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 3.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset at the end of Section 3, returned.
+!     igds     - Contains information read from the appropriate GRIB Grid 
+!                Definition Section 3 for the field being returned.
+!                Must be dimensioned >= 5.
+!                igds(1)=Source of grid definition (see Code Table 3.0)
+!                igds(2)=Number of grid points in the defined grid.
+!                igds(3)=Number of octets needed for each 
+!                            additional grid points definition.  
+!                            Used to define number of
+!                            points in each row ( or column ) for
+!                            non-regular grids.  
+!                            = 0, if using regular grid.
+!                igds(4)=Interpretation of list for optional points 
+!                            definition.  (Code Table 3.11)
+!                igds(5)=Grid Definition Template Number (Code Table 3.1)
+!     igdstmpl - Pointer to integer array containing the data values for 
+!                the specified Grid Definition
+!                Template ( NN=igds(5) ).  Each element of this integer 
+!                array contains an entry (in the order specified) of Grid
+!                Defintion Template 3.NN
+!     mapgridlen- Number of elements in igdstmpl().  i.e. number of entries
+!                in Grid Defintion Template 3.NN  ( NN=igds(5) ).
+!     ideflist - (Used if igds(3) .ne. 0)  Pointer to integer array containing
+!                the number of grid points contained in each row ( or column ).
+!                (part of Section 3)
+!     idefnum  - (Used if igds(3) .ne. 0)  The number of entries
+!                in array ideflist.  i.e. number of rows ( or columns )
+!                for which optional grid points are defined.
+!     ierr     - Error return code.
+!                0 = no error
+!                5 = "GRIB" message contains an undefined Grid Definition
+!                    Template.
+!                6 = memory allocation error
+!
+! REMARKS: Uses Fortran 90 module gridtemplates and module re_alloc.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      use gridtemplates
+      use re_alloc        !  needed for subroutine realloc
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(inout) :: iofst
+      integer,pointer,dimension(:) :: igdstmpl,ideflist
+      integer,intent(out) :: igds(5)
+      integer,intent(out) :: ierr,idefnum
+
+      integer,allocatable :: mapgrid(:)
+      integer :: mapgridlen,ibyttem
+      logical needext
+
+      ierr=0
+      nullify(igdstmpl,ideflist)
+
+      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+      iofst=iofst+32
+      iofst=iofst+8     ! skip section number
+
+      call g2lib_gbyte(cgrib,igds(1),iofst,8)     ! Get source of Grid def.
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,igds(2),iofst,32)    ! Get number of grid pts.
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,igds(3),iofst,8)     ! Get num octets for opt. list
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,igds(4),iofst,8)     ! Get interpret. for opt. list
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,igds(5),iofst,16)    ! Get Grid Def Template num.
+      iofst=iofst+16
+!      if (igds(1).eq.0) then
+      if (igds(1).eq.0.OR.igds(1).eq.255) then  ! FOR ECMWF TEST ONLY
+        allocate(mapgrid(lensec))
+        !   Get Grid Definition Template
+        call getgridtemplate(igds(5),mapgridlen,mapgrid,needext,
+     &                       iret)
+        if (iret.ne.0) then
+          ierr=5
+          if( allocated(mapgrid) ) deallocate(mapgrid)
+          return
+        endif
+      else
+!        igdstmpl=-1
+        mapgridlen=0
+        needext=.false.
+      endif
+      !
+      !   Unpack each value into array igdstmpl from the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mapgrid.
+      !
+      istat=0
+      if (mapgridlen.gt.0) allocate(igdstmpl(mapgridlen),stat=istat)
+      if (istat.ne.0) then
+         ierr=6
+         nullify(igdstmpl)
+         if( allocated(mapgrid) ) deallocate(mapgrid)
+         return
+      endif
+      ibyttem=0
+      do i=1,mapgridlen
+        nbits=iabs(mapgrid(i))*8
+        if ( mapgrid(i).ge.0 ) then
+          call g2lib_gbyte(cgrib,igdstmpl(i),iofst,nbits)
+        else
+          call g2lib_gbyte(cgrib,isign,iofst,1)
+          call g2lib_gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1)
+          if (isign.eq.1) igdstmpl(i)=-igdstmpl(i)
+        endif
+        iofst=iofst+nbits
+        ibyttem=ibyttem+iabs(mapgrid(i))
+      enddo
+      !
+      !   Check to see if the Grid Definition Template needs to be
+      !   extended.
+      !   The number of values in a specific template may vary
+      !   depending on data specified in the "static" part of the
+      !   template.
+      !
+      if ( needext ) then
+        call extgridtemplate(igds(5),igdstmpl,newmapgridlen,mapgrid)
+        !   Unpack the rest of the Grid Definition Template
+        call realloc(igdstmpl,mapgridlen,newmapgridlen,istat)
+        do i=mapgridlen+1,newmapgridlen
+          nbits=iabs(mapgrid(i))*8
+          if ( mapgrid(i).ge.0 ) then
+            call g2lib_gbyte(cgrib,igdstmpl(i),iofst,nbits)
+          else
+            call g2lib_gbyte(cgrib,isign,iofst,1)
+            call g2lib_gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1)
+            if (isign.eq.1) igdstmpl(i)=-igdstmpl(i)
+          endif
+          iofst=iofst+nbits
+          ibyttem=ibyttem+iabs(mapgrid(i))
+        enddo
+        mapgridlen=newmapgridlen
+      endif
+      if( allocated(mapgrid) ) deallocate(mapgrid)
+      !
+      !   Unpack optional list of numbers defining number of points
+      !   in each row or column, if included.  This is used for non regular
+      !   grids.
+      !
+      if ( igds(3).ne.0 ) then
+         nbits=igds(3)*8
+         idefnum=(lensec-14-ibyttem)/igds(3)
+         istat=0
+         if (idefnum.gt.0) allocate(ideflist(idefnum),stat=istat)
+         if (istat.ne.0) then
+            ierr=6
+            nullify(ideflist)
+            return
+         endif
+         call g2lib_gbytes(cgrib,ideflist,iofst,nbits,0,idefnum)
+         iofst=iofst+(nbits*idefnum)
+      else
+         idefnum=0
+         nullify(ideflist)
+      endif
+      
+      return    ! End of Section 3 processing
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack4.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack4.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack4.F	(revision 2744)
@@ -0,0 +1,159 @@
+      subroutine gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,
+     &                      mappdslen,coordlist,numcoord,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gf_unpack4 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine unpacks Section 4 (Product Definition Section)
+!   starting at octet 6 of that Section.  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+! 2002-01-24  Gilbert  - Changed to dynamically allocate arrays
+!                        and to pass pointers to those arrays through
+!                        the argument list.
+!
+! USAGE:    CALL gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,mappdslen,
+!    &                   coordlist,numcoord,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 4.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset of the end of Section 4, returned.
+!     ipdsnum  - Product Definition Template Number ( see Code Table 4.0)
+!     ipdstmpl - Pointer to integer array containing the data values for 
+!                the specified Product Definition
+!                Template ( N=ipdsnum ).  Each element of this integer
+!                array contains an entry (in the order specified) of Product
+!                Defintion Template 4.N
+!     mappdslen- Number of elements in ipdstmpl().  i.e. number of entries
+!                in Product Defintion Template 4.N  ( N=ipdsnum ).
+!     coordlist- Pointer to real array containing floating point values 
+!                intended to document
+!                the vertical discretisation associated to model data
+!                on hybrid coordinate vertical levels.  (part of Section 4)
+!     numcoord - number of values in array coordlist.
+!     ierr     - Error return code.
+!                0 = no error
+!                5 = "GRIB" message contains an undefined Product Definition
+!                    Template.
+!                6 = memory allocation error
+!
+! REMARKS: Uses Fortran 90 module pdstemplates and module re_alloc.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      use pdstemplates
+      use re_alloc        !  needed for subroutine realloc
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(inout) :: iofst
+      real,pointer,dimension(:) :: coordlist
+      integer,pointer,dimension(:) :: ipdstmpl
+      integer,intent(out) :: ipdsnum
+      integer,intent(out) :: ierr,numcoord
+
+      real(4),allocatable :: coordieee(:)
+      integer,allocatable :: mappds(:)
+      integer :: mappdslen
+      logical needext
+
+      ierr=0
+      nullify(ipdstmpl,coordlist)
+
+      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+      iofst=iofst+32
+      iofst=iofst+8     ! skip section number
+      allocate(mappds(lensec))
+
+      call g2lib_gbyte(cgrib,numcoord,iofst,16)    ! Get num of coordinate values
+      iofst=iofst+16
+      call g2lib_gbyte(cgrib,ipdsnum,iofst,16)    ! Get Prod. Def Template num.
+      iofst=iofst+16
+      !   Get Product Definition Template
+      call getpdstemplate(ipdsnum,mappdslen,mappds,needext,iret)
+      if (iret.ne.0) then
+        ierr=5
+        if( allocated(mappds) ) deallocate(mappds)
+        return
+      endif
+      !
+      !   Unpack each value into array ipdstmpl from the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mappds.
+      !
+      istat=0
+      if (mappdslen.gt.0) allocate(ipdstmpl(mappdslen),stat=istat)
+      if (istat.ne.0) then
+         ierr=6
+         nullify(ipdstmpl)
+         if( allocated(mappds) ) deallocate(mappds)
+         return
+      endif
+      do i=1,mappdslen
+        nbits=iabs(mappds(i))*8
+        if ( mappds(i).ge.0 ) then
+          call g2lib_gbyte(cgrib,ipdstmpl(i),iofst,nbits)
+        else
+          call g2lib_gbyte(cgrib,isign,iofst,1)
+          call g2lib_gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1)
+          if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i)
+        endif
+        iofst=iofst+nbits
+      enddo
+      !
+      !   Check to see if the Product Definition Template needs to be
+      !   extended.
+      !   The number of values in a specific template may vary
+      !   depending on data specified in the "static" part of the
+      !   template.
+      !
+      if ( needext ) then
+        call extpdstemplate(ipdsnum,ipdstmpl,newmappdslen,mappds)
+        call realloc(ipdstmpl,mappdslen,newmappdslen,istat)
+        !   Unpack the rest of the Product Definition Template
+        do i=mappdslen+1,newmappdslen
+          nbits=iabs(mappds(i))*8
+          if ( mappds(i).ge.0 ) then
+            call g2lib_gbyte(cgrib,ipdstmpl(i),iofst,nbits)
+          else
+            call g2lib_gbyte(cgrib,isign,iofst,1)
+            call g2lib_gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1)
+            if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i)
+          endif
+          iofst=iofst+nbits
+        enddo
+        mappdslen=newmappdslen
+      endif
+      if( allocated(mappds) ) deallocate(mappds)
+      !
+      !   Get Optional list of vertical coordinate values
+      !   after the Product Definition Template, if necessary.
+      !
+      nullify(coordlist)
+      if ( numcoord .ne. 0 ) then
+         allocate (coordieee(numcoord),stat=istat1)
+         allocate(coordlist(numcoord),stat=istat)
+         if ((istat1+istat).ne.0) then
+            ierr=6
+            nullify(coordlist)
+            if( allocated(coordieee) ) deallocate(coordieee)
+            return
+         endif
+        call g2lib_gbytes(cgrib,coordieee,iofst,32,0,numcoord)
+        call rdieee(coordieee,coordlist,numcoord)
+        deallocate (coordieee)
+        iofst=iofst+(32*numcoord)
+      endif
+      
+      return    ! End of Section 4 processing
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack5.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack5.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack5.F	(revision 2744)
@@ -0,0 +1,134 @@
+      subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl,
+     &                   mapdrslen,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gf_unpack5 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine unpacks Section 5 (Data Representation Section)
+!   starting at octet 6 of that Section.  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+! 2002-01-24  Gilbert  - Changed to dynamically allocate arrays
+!                        and to pass pointers to those arrays through
+!                        the argument list.
+!
+! USAGE:    CALL gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl,
+!                        mapdrslen,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 5.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset at the end of Section 5, returned.
+!     ndpts    - Number of data points unpacked and returned.
+!     idrsnum  - Data Representation Template Number ( see Code Table 5.0)
+!     idrstmpl - Pointer to an integer array containing the data values for 
+!                the specified Data Representation
+!                Template ( N=idrsnum ).  Each element of this integer
+!                array contains an entry (in the order specified) of Data
+!                Representation Template 5.N
+!     mapdrslen- Number of elements in idrstmpl().  i.e. number of entries
+!                in Data Representation Template 5.N  ( N=idrsnum ).
+!     ierr     - Error return code.
+!                0 = no error
+!                6 = memory allocation error
+!                7 = "GRIB" message contains an undefined Data
+!                    Representation Template.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      use drstemplates
+      use re_alloc        !  needed for subroutine realloc
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(inout) :: iofst
+      integer,intent(out) :: ndpts,idrsnum
+      integer,pointer,dimension(:) :: idrstmpl
+      integer,intent(out) :: ierr
+
+      integer,allocatable :: mapdrs(:)
+      integer :: mapdrslen
+      logical needext
+
+      ierr=0
+      nullify(idrstmpl)
+
+      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+      iofst=iofst+32
+      iofst=iofst+8     ! skip section number
+      allocate(mapdrs(lensec))
+
+      call g2lib_gbyte(cgrib,ndpts,iofst,32)    ! Get num of data points
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,idrsnum,iofst,16)     ! Get Data Rep Template Num.
+      iofst=iofst+16
+      !   Gen Data Representation Template
+      call getdrstemplate(idrsnum,mapdrslen,mapdrs,needext,iret)
+      if (iret.ne.0) then
+        ierr=7
+        if( allocated(mapdrs) ) deallocate(mapdrs)
+        return
+      endif
+      !
+      !   Unpack each value into array ipdstmpl from the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mappds.
+      !
+      istat=0
+      if (mapdrslen.gt.0) allocate(idrstmpl(mapdrslen),stat=istat)
+      if (istat.ne.0) then
+         ierr=6
+         nullify(idrstmpl)
+         if( allocated(mapdrs) ) deallocate(mapdrs)
+         return
+      endif
+      do i=1,mapdrslen
+        nbits=iabs(mapdrs(i))*8
+        if ( mapdrs(i).ge.0 ) then
+          call g2lib_gbyte(cgrib,idrstmpl(i),iofst,nbits)
+        else
+          call g2lib_gbyte(cgrib,isign,iofst,1)
+          call g2lib_gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1)
+          if (isign.eq.1) idrstmpl(i)=-idrstmpl(i)
+        endif
+        iofst=iofst+nbits
+      enddo
+      !
+      !   Check to see if the Data Representation Template needs to be
+      !   extended.
+      !   The number of values in a specific template may vary
+      !   depending on data specified in the "static" part of the
+      !   template.
+      !
+      if ( needext ) then
+        call extdrstemplate(idrsnum,idrstmpl,newmapdrslen,mapdrs)
+        call realloc(idrstmpl,mapdrslen,newmapdrslen,istat)
+        !   Unpack the rest of the Data Representation Template
+        do i=mapdrslen+1,newmapdrslen
+          nbits=iabs(mapdrs(i))*8
+          if ( mapdrs(i).ge.0 ) then
+            call g2lib_gbyte(cgrib,idrstmpl(i),iofst,nbits)
+          else
+            call g2lib_gbyte(cgrib,isign,iofst,1)
+            call g2lib_gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1)
+            if (isign.eq.1) idrstmpl(i)=-idrstmpl(i)
+          endif
+          iofst=iofst+nbits
+        enddo
+        mapdrslen=newmapdrslen
+      endif
+      if( allocated(mapdrs) ) deallocate(mapdrs)
+
+      return    ! End of Section 5 processing
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack6.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack6.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack6.F	(revision 2744)
@@ -0,0 +1,88 @@
+      subroutine gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gf_unpack6 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
+!
+! ABSTRACT: This subroutine unpacks Section 6 (Bit-Map Section)
+!   starting at octet 6 of that Section.  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-26  Gilbert
+! 2002-01-24  Gilbert  - Changed to dynamically allocate arrays
+!                        and to pass pointers to those arrays through
+!                        the argument list.
+!
+! USAGE:    CALL gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 6.
+!     ngpts    - Number of grid points specified in the bit-map
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset at the end of Section 6, returned.
+!     ibmap    - Bitmap indicator ( see Code Table 6.0 )
+!                0 = bitmap applies and is included in Section 6.
+!                1-253 = Predefined bitmap applies
+!                254 = Previously defined bitmap applies to this field
+!                255 = Bit map does not apply to this product.
+!     bmap()   - Pointer to a logical*1 array containing decoded bitmap. 
+!                ( if ibmap=0 )
+!     ierr     - Error return code.
+!                0 = no error
+!                4 = Unrecognized pre-defined bit-map.
+!                6 = memory allocation error
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib,ngpts
+      integer,intent(inout) :: iofst
+      integer,intent(out) :: ibmap
+      integer,intent(out) :: ierr
+      logical*1,pointer,dimension(:) :: bmap
+
+      integer :: intbmap(ngpts)
+
+      ierr=0
+      nullify(bmap)
+
+      iofst=iofst+32    ! skip Length of Section
+      iofst=iofst+8     ! skip section number
+
+      call g2lib_gbyte(cgrib,ibmap,iofst,8)    ! Get bit-map indicator
+      iofst=iofst+8
+
+      if (ibmap.eq.0) then               ! Unpack bitmap
+         istat=0
+         if (ngpts.gt.0) allocate(bmap(ngpts),stat=istat)
+         if (istat.ne.0) then
+            ierr=6
+            nullify(bmap)
+            return
+         endif
+         call g2lib_gbytes(cgrib,intbmap,iofst,1,0,ngpts)
+         iofst=iofst+ngpts
+         do j=1,ngpts
+           bmap(j)=.true.
+           if (intbmap(j).eq.0) bmap(j)=.false.
+         enddo
+!      elseif (ibmap.eq.254) then               ! Use previous bitmap
+!        return
+!      elseif (ibmap.eq.255) then               ! No bitmap in message
+!        bmap(1:ngpts)=.true.
+!      else
+!        print *,'gf_unpack6: Predefined bitmap ',ibmap,' not recognized.'
+!        ierr=4
+      endif
+      
+      return    ! End of Section 6 processing
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack7.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack7.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gf_unpack7.F	(revision 2744)
@@ -0,0 +1,124 @@
+      subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl,
+     &                      idrsnum,idrstmpl,ndpts,fld,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gf_unpack7 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-01-24
+!
+! ABSTRACT: This subroutine unpacks GRIB2 Section 7 (Data Section).
+!
+! PROGRAM HISTORY LOG:
+! 2002-01-24  Gilbert
+! 2002-12-17  Gilbert  - Added support for new templates using 
+!                        PNG and JPEG2000 algorithms/templates.
+! 2004-12-29  Gilbert  - Added check on comunpack return code.
+!
+! USAGE:    CALL gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl,
+!    &                      idrsnum,idrstmpl,ndpts,fld,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
+!     iofst    - Bit offset of the beginning of Section 7.
+!     igdsnum  - Grid Definition Template Number ( see Code Table 3.0)
+!                (Only required to unpack DRT 5.51)
+!     igdstmpl - Pointer to an integer array containing the data values for
+!                the specified Grid Definition
+!                Template ( N=igdsnum ).  Each element of this integer
+!                array contains an entry (in the order specified) of Grid
+!                Definition Template 3.N
+!                (Only required to unpack DRT 5.51)
+!     idrsnum  - Data Representation Template Number ( see Code Table 5.0)
+!     idrstmpl - Pointer to an integer array containing the data values for
+!                the specified Data Representation
+!                Template ( N=idrsnum ).  Each element of this integer
+!                array contains an entry (in the order specified) of Data
+!                Representation Template 5.N
+!     ndpts    - Number of data points unpacked and returned.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     iofst    - Bit offset at the end of Section 7, returned.
+!     fld()    - Pointer to a real array containing the unpacked data field.
+!     ierr     - Error return code.
+!                0 = no error
+!                4 = Unrecognized Data Representation Template
+!                5 = One of GDT 3.50 through 3.53 required to unpack DRT 5.51
+!                6 = memory allocation error
+!                7 = corrupt section 7.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib,ndpts,igdsnum,idrsnum
+      integer,intent(inout) :: iofst
+      integer,pointer,dimension(:) :: igdstmpl,idrstmpl
+      integer,intent(out) :: ierr
+      real,pointer,dimension(:) :: fld
+
+
+      ierr=0
+      nullify(fld)
+
+      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+      iofst=iofst+32    
+      iofst=iofst+8     ! skip section number
+
+      ipos=(iofst/8)+1
+      istat=0
+      allocate(fld(ndpts),stat=istat)
+      if (istat.ne.0) then
+         ierr=6
+         return
+      endif
+
+      if (idrsnum.eq.0) then
+        call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld)
+      elseif (idrsnum.eq.2.or.idrsnum.eq.3) then
+        call comunpack(cgrib(ipos),lensec-5,lensec,idrsnum,idrstmpl,
+     &                 ndpts,fld,ier)
+        if ( ier .NE. 0 ) then
+           ierr=7
+           return
+        endif
+      elseif (idrsnum.eq.50) then      !  Spectral simple
+        call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts-1,
+     &                 fld(2))
+        ieee=idrstmpl(5)
+        call rdieee(ieee,fld(1),1)
+      elseif (idrsnum.eq.51) then      !  Spectral complex
+        if (igdsnum.ge.50.AND.igdsnum.le.53) then
+          call specunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,
+     &                    igdstmpl(1),igdstmpl(2),igdstmpl(3),fld)
+        else
+          print *,'gf_unpack7: Cannot use GDT 3.',igdsnum,
+     &            ' to unpack Data Section 5.51.'
+          ierr=5
+          nullify(fld)
+          return
+        endif
+#ifdef USE_JPEG2000
+      elseif (idrsnum.eq.40 .OR. idrsnum.eq.40000) then
+        call jpcunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld)
+#endif  /* USE_JPEG2000 */
+#ifdef USE_PNG
+      elseif (idrsnum.eq.41 .OR. idrsnum.eq.40010) then
+        call pngunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld)
+#endif  /* USE_PNG */
+      else
+        print *,'gf_unpack7: Data Representation Template ',idrsnum,
+     &          ' not yet implemented.'
+        ierr=4
+        nullify(fld)
+        return
+      endif
+
+      iofst=iofst+(8*lensec)
+      
+      return    ! End of Section 7 processing
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribcreate.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribcreate.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribcreate.F	(revision 2744)
@@ -0,0 +1,123 @@
+      subroutine gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gribcreate 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-04-28
+!
+! ABSTRACT: This subroutine initializes a new GRIB2 message and packs
+!   GRIB2 sections 0 (Indicator Section) and 1 (Identification Section).
+!   This routine is used with routines "addlocal", "addgrid", "addfield",
+!   and "gribend" to create a complete GRIB2 message.  Subroutine
+!   gribcreate must be called first to initialize a new GRIB2 message.
+!   Also, a call to gribend is required to complete GRIB2 message
+!   after all fields have been added.
+!
+! PROGRAM HISTORY LOG:
+! 2000-04-28  Gilbert
+!
+! USAGE:    CALL gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array to contain the GRIB2 message
+!     lcgrib   - Maximum length (bytes) of array cgrib.
+!     listsec0 - Contains information needed for GRIB Indicator Section 0.
+!                Must be dimensioned >= 2.
+!                listsec0(1)=Discipline-GRIB Master Table Number
+!                            (see Code Table 0.0)
+!                listsec0(2)=GRIB Edition Number (currently 2)
+!     listsec1 - Contains information needed for GRIB Identification Section 1.
+!                Must be dimensioned >= 13.
+!                listsec1(1)=Id of orginating centre (Common Code Table C-1)
+!                listsec1(2)=Id of orginating sub-centre (local table)
+!                listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0)
+!                listsec1(4)=GRIB Local Tables Version Number (Code Table 1.1)
+!                listsec1(5)=Significance of Reference Time (Code Table 1.2)
+!                listsec1(6)=Reference Time - Year (4 digits)
+!                listsec1(7)=Reference Time - Month
+!                listsec1(8)=Reference Time - Day
+!                listsec1(9)=Reference Time - Hour
+!                listsec1(10)=Reference Time - Minute
+!                listsec1(11)=Reference Time - Second
+!                listsec1(12)=Production status of data (Code Table 1.3)
+!                listsec1(13)=Type of processed data (Code Table 1.4)
+!
+!   OUTPUT ARGUMENT LIST:      
+!     cgrib    - Character array to contain the GRIB2 message
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Tried to use for version other than GRIB Edition 2
+!
+! REMARKS: This routine is intended for use with routines "addlocal", 
+!          "addgrid", "addfield", and "gribend" to create a complete 
+!          GRIB2 message.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(inout) :: cgrib(lcgrib)
+      integer,intent(in) :: listsec0(*),listsec1(*)
+      integer,intent(in) :: lcgrib
+      integer,intent(out) :: ierr
+      
+      character(len=4),parameter :: grib='GRIB'
+      integer,parameter :: zero=0,one=1
+      integer,parameter :: mapsec1len=13
+      integer,parameter :: 
+     &        mapsec1(mapsec1len)=(/ 2,2,1,1,1,2,1,1,1,1,1,1,1 /)
+      integer lensec0,iofst,ibeg
+
+      ierr=0
+!
+!  Currently handles only GRIB Edition 2.
+!  
+      if (listsec0(2).ne.2) then
+        print *,'gribcreate: can only code GRIB edition 2.'
+        ierr=1
+        return
+      endif
+!
+!  Pack Section 0 - Indicator Section 
+!  ( except for total length of GRIB message )
+!
+!      cgrib=' '
+      cgrib(1)=grib(1:1)                     ! Beginning of GRIB message
+      cgrib(2)=grib(2:2)   
+      cgrib(3)=grib(3:3)   
+      cgrib(4)=grib(4:4)   
+      call g2lib_sbyte(cgrib,zero,32,16)           ! reserved for future use
+      call g2lib_sbyte(cgrib,listsec0(1),48,8)     ! Discipline
+      call g2lib_sbyte(cgrib,listsec0(2),56,8)     ! GRIB edition number
+      lensec0=16      ! bytes (octets)
+!
+!  Pack Section 1 - Identification Section
+!
+      ibeg=lensec0*8        !   Calculate offset for beginning of section 1
+      iofst=ibeg+32         !   leave space for length of section
+      call g2lib_sbyte(cgrib,one,iofst,8)     ! Store section number ( 1 )
+      iofst=iofst+8
+      !
+      !   Pack up each input value in array listsec1 into the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mapsec1.
+      !
+      do i=1,mapsec1len
+        nbits=mapsec1(i)*8
+        call g2lib_sbyte(cgrib,listsec1(i),iofst,nbits)
+        iofst=iofst+nbits
+      enddo
+      !
+      !   Calculate length of section 1 and store it in octets
+      !   1-4 of section 1.
+      !
+      lensec1=(iofst-ibeg)/8
+      call g2lib_sbyte(cgrib,lensec1,ibeg,32)
+!
+!  Put current byte total of message into Section 0
+!
+      call g2lib_sbyte(cgrib,zero,64,32)
+      call g2lib_sbyte(cgrib,lensec0+lensec1,96,32)
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribend.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribend.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribend.F	(revision 2744)
@@ -0,0 +1,126 @@
+      subroutine gribend(cgrib,lcgrib,lengrib,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gribend 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-02
+!
+! ABSTRACT: This subroutine finalizes a GRIB message after all grids
+!   and fields have been added.  It adds the End Section ( "7777" )
+!   to the end of the GRIB message and calculates the length and stores
+!   it in the appropriate place in Section 0.
+!   This routine is used with routines "gribcreate", "addlocal", "addgrid",
+!   and "addfield" to create a complete GRIB2 message.  Subroutine
+!   gribcreate must be called first to initialize a new GRIB2 message.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-02  Gilbert
+!
+! USAGE:    CALL gribend(cgrib,lcgrib,lengrib,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array to contain the GRIB2 message
+!     lcgrib   - Maximum length (bytes) of array cgrib.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     cgrib    - Character array to contain the GRIB2 message
+!     lengrib  - Length of the final GRIB2 message in octets (bytes)
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = GRIB message was not initialized.  Need to call
+!                    routine gribcreate first.
+!                2 = GRIB message already complete.  
+!                3 = Sum of Section byte counts doesn't add to total byte count.
+!                4 = Previous Section was not 7.
+!
+! REMARKS: This routine is intended for use with routines "gribcreate", 
+!          "addlocal", "addgrid", and "addfield" to create a complete 
+!          GRIB2 message.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(inout) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(out) :: lengrib,ierr
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4):: ctemp
+      integer iofst,ibeg,lencurr,len
+ 
+      ierr=0
+!
+!  Check to see if beginning of GRIB message exists
+!
+      ctemp=cgrib(1)//cgrib(2)//cgrib(3)//cgrib(4)
+      if ( ctemp.ne.grib ) then
+        print *,'gribend: GRIB not found in given message.'
+        ierr=1
+        return
+      endif
+!
+!  Get current length of GRIB message
+!  
+      call g2lib_gbyte(cgrib,lencurr,96,32)
+!
+!  Check to see if GRIB message is already complete
+!
+!      ctemp=cgrib(lencurr-3)//cgrib(lencurr-2)//cgrib(lencurr-1)
+!     &      //cgrib(lencurr)
+!      if ( ctemp.eq.c7777 ) then
+!        print *,'gribend: GRIB message already complete.'
+!        ierr=2
+!        return
+!      endif
+!
+!  Loop through all current sections of the GRIB message to
+!  find the last section number.
+!
+      len=16    ! Length of Section 0
+      do 
+      !    Get number and length of next section
+        iofst=len*8
+        call g2lib_gbyte(cgrib,ilen,iofst,32)
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)
+        len=len+ilen
+      !    Exit loop if last section reached
+        if ( len.eq.lencurr ) exit
+      !    If byte count for each section doesn't match current
+      !    total length, then there is a problem.
+        if ( len.gt.lencurr ) then
+          print *,'gribend: Section byte counts don''t add to total.'
+          print *,'gribend: Sum of section byte counts = ',len
+          print *,'gribend: Total byte count in Section 0 = ',lencurr
+          ierr=3
+          return
+        endif
+      enddo
+!
+!  Can only add End Section (Section 8) after Section 7.
+!
+      if ( isecnum.ne.7 ) then
+        print *,'gribend: Section 8 can only be added after Section 7.'
+        print *,'gribend: Section ',isecnum,' was the last found in',
+     &          ' given GRIB message.'
+        ierr=4
+        return
+      endif
+!
+!  Add Section 8  - End Section
+!
+      cgrib(lencurr+1:lencurr+4)=c7777
+
+!
+!  Update current byte total of message in Section 0
+!
+      lengrib=lencurr+4
+      call g2lib_sbyte(cgrib,lengrib,96,32)
+
+      return
+      end
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribinfo.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribinfo.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribinfo.F	(revision 2744)
@@ -0,0 +1,243 @@
+      subroutine gribinfo(cgrib,lcgrib,listsec0,listsec1,
+     &                    numlocal,numfields,maxvals,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    gribinfo 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-25
+!
+! ABSTRACT: This subroutine searches through a GRIB2 message and
+!   returns the number of Local Use Sections and number of gridded
+!   fields found in the message.  It also performs various checks 
+!   to see if the message is a valid GRIB2 message.
+!   Last, a list of safe array dimensions is returned for use in 
+!   allocating return arrays from routines getlocal, gettemplates, and 
+!   getfields.  (See maxvals and REMARKS)
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-25  Gilbert
+!
+! USAGE:    CALL gribinfo(cgrib,lcgrib,listsec0,listsec1,
+!     &                    numlocal,numfields,ierr)
+!   INPUT ARGUMENT LIST:
+!     cgrib    - Character array that contains the GRIB2 message
+!     lcgrib   - Length (in bytes) of GRIB message in array cgrib.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     listsec0 - Contains information decoded from GRIB Indicator Section 0.
+!                Must be dimensioned >= 2.
+!                listsec0(1)=Discipline-GRIB Master Table Number
+!                            (see Code Table 0.0)
+!                listsec0(2)=GRIB Edition Number (currently 2)
+!                listsec0(3)=Length of GRIB message
+!     listsec1 - Contains information read from GRIB Identification Section 1.
+!                Must be dimensioned >= 13.
+!                listsec1(1)=Id of orginating centre (Common Code Table C-1)
+!                listsec1(2)=Id of orginating sub-centre (local table)
+!                listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0)
+!                listsec1(4)=GRIB Local Tables Version Number 
+!                listsec1(5)=Significance of Reference Time (Code Table 1.1)
+!                listsec1(6)=Reference Time - Year (4 digits)
+!                listsec1(7)=Reference Time - Month
+!                listsec1(8)=Reference Time - Day
+!                listsec1(9)=Reference Time - Hour
+!                listsec1(10)=Reference Time - Minute
+!                listsec1(11)=Reference Time - Second
+!                listsec1(12)=Production status of data (Code Table 1.2)
+!                listsec1(13)=Type of processed data (Code Table 1.3)
+!     numlocal - The number of Local Use Sections ( Section 2 ) found in 
+!                the GRIB message.
+!     numfields- The number of gridded fieldse found in the GRIB message.
+!     maxvals()- The maximum number of elements that could be returned
+!                in various arrays from this GRIB2 message. (see REMARKS)
+!                maxvals(1)=max length of local section 2 (for getlocal)
+!                maxvals(2)=max length of GDS Template (for gettemplates 
+!                                                       and getfield)
+!                maxvals(3)=max length of GDS Optional list (for getfield)
+!                maxvals(4)=max length of PDS Template (for gettemplates 
+!                                                       and getfield)
+!                maxvals(5)=max length of PDS Optional list (for getfield)
+!                maxvals(6)=max length of DRS Template (for gettemplates 
+!                                                       and getfield)
+!                maxvals(7)=max number of gridpoints (for getfield)
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Beginning characters "GRIB" not found.
+!                2 = GRIB message is not Edition 2.
+!                3 = Could not find Section 1, where expected.
+!                4 = End string "7777" found, but not where expected.
+!                5 = End string "7777" not found at end of message.
+!
+! REMARKS: Array maxvals contains the maximum possible 
+!          number of values that will be returned in argument arrays
+!          for routines getlocal, gettemplates, and getfields.  
+!          Users can use this info to determine if their arrays are 
+!          dimensioned large enough for the data that may be returned
+!          from the above routines, or to dynamically allocate arrays
+!          with a reasonable size.
+!          NOTE that the actual number of values in these arrays is returned
+!          from the routines and will likely be less than the values 
+!          calculated by this routine.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cgrib(lcgrib)
+      integer,intent(in) :: lcgrib
+      integer,intent(out) :: listsec0(3),listsec1(13),maxvals(7)
+      integer,intent(out) :: numlocal,numfields,ierr
+      
+      character(len=4),parameter :: grib='GRIB',c7777='7777'
+      character(len=4) :: ctemp
+      integer,parameter :: zero=0,one=1
+      integer,parameter :: mapsec1len=13
+      integer,parameter :: 
+     &        mapsec1(mapsec1len)=(/ 2,2,1,1,1,2,1,1,1,1,1,1,1 /)
+      integer iofst,ibeg,istart
+
+      ierr=0
+      numlocal=0
+      numfields=0
+      maxsec2len=1
+      maxgdstmpl=1
+      maxdeflist=1
+      maxpdstmpl=1
+      maxcoordlist=1
+      maxdrstmpl=1
+      maxgridpts=0
+!
+!  Check for beginning of GRIB message in the first 100 bytes
+!
+      istart=0
+      do j=1,100
+        ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
+        if (ctemp.eq.grib ) then
+          istart=j
+          exit
+        endif
+      enddo
+      if (istart.eq.0) then
+        print *,'gribinfo:  Beginning characters GRIB not found.'
+        ierr=1
+        return
+      endif
+!
+!  Unpack Section 0 - Indicator Section 
+!
+      iofst=8*(istart+5)
+      call g2lib_gbyte(cgrib,listsec0(1),iofst,8)     ! Discipline
+      iofst=iofst+8
+      call g2lib_gbyte(cgrib,listsec0(2),iofst,8)     ! GRIB edition number
+      iofst=iofst+8
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,lengrib,iofst,32)        ! Length of GRIB message
+      iofst=iofst+32
+      listsec0(3)=lengrib
+      lensec0=16
+      ipos=istart+lensec0
+!
+!  Currently handles only GRIB Edition 2.
+!  
+      if (listsec0(2).ne.2) then
+        print *,'gribinfo: can only decode GRIB edition 2.'
+        ierr=2
+        return
+      endif
+!
+!  Unpack Section 1 - Identification Section
+!
+      call g2lib_gbyte(cgrib,lensec1,iofst,32)        ! Length of Section 1
+      iofst=iofst+32
+      call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Section number ( 1 )
+      iofst=iofst+8
+      if (isecnum.ne.1) then
+        print *,'gribinfo: Could not find section 1.'
+        ierr=3
+        return
+      endif
+      !
+      !   Unpack each input value in array listsec1 into the
+      !   the appropriate number of octets, which are specified in
+      !   corresponding entries in array mapsec1.
+      !
+      do i=1,mapsec1len
+        nbits=mapsec1(i)*8
+        call g2lib_gbyte(cgrib,listsec1(i),iofst,nbits)
+        iofst=iofst+nbits
+      enddo
+      ipos=ipos+lensec1
+!
+!  Loop through the remaining sections keeping track of the 
+!  length of each.  Also count the number of times Section 2
+!  and Section 4 appear.
+!
+      do
+        ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
+        if (ctemp.eq.c7777 ) then
+          ipos=ipos+4
+          if (ipos.ne.(istart+lengrib)) then
+            print *,'gribinfo: "7777" found, but not where expected.'
+            ierr=4
+            return
+          endif
+          exit
+        endif
+        iofst=(ipos-1)*8
+        call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
+        iofst=iofst+32
+        call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Get Section number
+        iofst=iofst+8
+        ipos=ipos+lensec                 ! Update beginning of section pointer
+        if (ipos.gt.(istart+lengrib)) then
+          print *,'gribinfo: "7777"  not found at end of GRIB message.'
+          ierr=5
+          return
+        endif
+        if (isecnum.eq.2) then     ! Local Section 2
+           !   increment counter for total number of local sections found
+           !   and determine largest Section 2 in message
+           numlocal=numlocal+1
+           lenposs=lensec-5
+           if ( lenposs.gt.maxsec2len ) maxsec2len=lenposs
+        elseif (isecnum.eq.3) then
+           iofst=iofst+8                      ! skip source of grid def.
+           call g2lib_gbyte(cgrib,ngdpts,iofst,32)         ! Get Num of Grid Points
+           iofst=iofst+32
+           call g2lib_gbyte(cgrib,nbyte,iofst,8)      ! Get Num octets for opt. list
+           iofst=iofst+8
+           if (ngdpts.gt.maxgridpts) maxgridpts=ngdpts
+           lenposs=lensec-14
+           if ( lenposs.gt.maxgdstmpl ) maxgdstmpl=lenposs
+           if (nbyte.ne.0) then
+              lenposs=lenposs/nbyte
+              if ( lenposs.gt.maxdeflist ) maxdeflist=lenposs
+           endif
+        elseif (isecnum.eq.4) then
+          numfields=numfields+1
+           call g2lib_gbyte(cgrib,numcoord,iofst,16)      ! Get Num of Coord Values
+           iofst=iofst+16
+           if (numcoord.ne.0) then
+              if (numcoord.gt.maxcoordlist) maxcoordlist=numcoord
+           endif
+           lenposs=lensec-9
+           if ( lenposs.gt.maxpdstmpl ) maxpdstmpl=lenposs
+        elseif (isecnum.eq.5) then
+           lenposs=lensec-11
+           if ( lenposs.gt.maxdrstmpl ) maxdrstmpl=lenposs
+        endif
+        
+      enddo
+
+      maxvals(1)=maxsec2len
+      maxvals(2)=maxgdstmpl
+      maxvals(3)=maxdeflist
+      maxvals(4)=maxpdstmpl
+      maxvals(5)=maxcoordlist
+      maxvals(6)=maxdrstmpl
+      maxvals(7)=maxgridpts
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribmod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribmod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gribmod.F	(revision 2744)
@@ -0,0 +1,187 @@
+      module grib_mod
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! MODULE:    grib_mod 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-01-23
+!
+! ABSTRACT: This Fortran Module contains the declaration
+!   of derived type gribfield.
+!   If variable gfld is declared of type gribfield 
+!   ( i.e. TYPE(GRIBFIELD) :: GFLD ), it would have the following componenets:
+!
+!        gfld%version = GRIB edition number ( currently 2 )
+!        gfld%discipline = Message Discipline ( see Code Table 0.0 )
+!        gfld%idsect() = Contains the entries in the Identification
+!                        Section ( Section 1 )
+!                        This element is actually a pointer to an array
+!                        that holds the data.
+!            gfld%idsect(1)  = Identification of originating Centre
+!                                    ( see Common Code Table C-1 )
+!                             7 - US National Weather Service
+!            gfld%idsect(2)  = Identification of originating Sub-centre
+!            gfld%idsect(3)  = GRIB Master Tables Version Number
+!                                    ( see Code Table 1.0 )
+!                             0 - Experimental
+!                             1 - Initial operational version number
+!            gfld%idsect(4)  = GRIB Local Tables Version Number
+!                                    ( see Code Table 1.1 )
+!                             0     - Local tables not used
+!                             1-254 - Number of local tables version used
+!            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
+!                             0 - Analysis
+!                             1 - Start of forecast
+!                             2 - Verifying time of forecast
+!                             3 - Observation time
+!            gfld%idsect(6)  = Year ( 4 digits )
+!            gfld%idsect(7)  = Month
+!            gfld%idsect(8)  = Day
+!            gfld%idsect(9)  = Hour
+!            gfld%idsect(10)  = Minute
+!            gfld%idsect(11)  = Second
+!            gfld%idsect(12)  = Production status of processed data
+!                                    ( see Code Table 1.3 )
+!                              0 - Operational products
+!                              1 - Operational test products
+!                              2 - Research products
+!                              3 - Re-analysis products
+!            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
+!                              0  - Analysis products
+!                              1  - Forecast products
+!                              2  - Analysis and forecast products
+!                              3  - Control forecast products
+!                              4  - Perturbed forecast products
+!                              5  - Control and perturbed forecast products
+!                              6  - Processed satellite observations
+!                              7  - Processed radar observations
+!        gfld%idsectlen = Number of elements in gfld%idsect().
+!        gfld%local() = Pointer to character array containing contents
+!                       of Local Section 2, if included
+!        gfld%locallen = length of array gfld%local()
+!        gfld%ifldnum = field number within GRIB message
+!        gfld%griddef = Source of grid definition (see Code Table 3.0)
+!                      0 - Specified in Code table 3.1
+!                      1 - Predetermined grid Defined by originating centre
+!        gfld%ngrdpts = Number of grid points in the defined grid.
+!        gfld%numoct_opt = Number of octets needed for each
+!                          additional grid points definition.
+!                          Used to define number of
+!                          points in each row ( or column ) for
+!                          non-regular grids.
+!                          = 0, if using regular grid.
+!        gfld%interp_opt = Interpretation of list for optional points
+!                          definition.  (Code Table 3.11)
+!        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
+!        gfld%igdtmpl() = Contains the data values for the specified Grid
+!                         Definition Template ( NN=gfld%igdtnum ).  Each
+!                         element of this integer array contains an entry (in
+!                         the order specified) of Grid Defintion Template 3.NN
+!                         This element is actually a pointer to an array
+!                         that holds the data.
+!        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
+!                       entries in Grid Defintion Template 3.NN
+!                       ( NN=gfld%igdtnum ).
+!        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
+!                          contains the number of grid points contained in
+!                          each row ( or column ).  (part of Section 3)
+!                          This element is actually a pointer to an array
+!                          that holds the data.  This pointer is nullified
+!                          if gfld%numoct_opt=0.
+!        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
+!                       in array ideflist.  i.e. number of rows ( or columns )
+!                       for which optional grid points are defined.  This value
+!                       is set to zero, if gfld%numoct_opt=0.
+!        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
+!        gfld%ipdtmpl() = Contains the data values for the specified Product
+!                         Definition Template ( N=gfdl%ipdtnum ).  Each element
+!                         of this integer array contains an entry (in the
+!                         order specified) of Product Defintion Template 4.N.
+!                         This element is actually a pointer to an array
+!                         that holds the data.
+!        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
+!                       entries in Product Defintion Template 4.N
+!                       ( N=gfdl%ipdtnum ).
+!        gfld%coord_list() = Real array containing floating point values
+!                            intended to document the vertical discretisation
+!                            associated to model data on hybrid coordinate
+!                            vertical levels.  (part of Section 4)
+!                            This element is actually a pointer to an array
+!                            that holds the data.
+!        gfld%num_coord = number of values in array gfld%coord_list().
+!        gfld%ndpts = Number of data points unpacked and returned.
+!        gfld%idrtnum = Data Representation Template Number
+!                       ( see Code Table 5.0)
+!        gfld%idrtmpl() = Contains the data values for the specified Data
+!                         Representation Template ( N=gfld%idrtnum ).  Each
+!                         element of this integer array contains an entry
+!                         (in the order specified) of Product Defintion
+!                         Template 5.N.
+!                         This element is actually a pointer to an array
+!                         that holds the data.
+!        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
+!                       of entries in Data Representation Template 5.N
+!                       ( N=gfld%idrtnum ).
+!        gfld%unpacked = logical value indicating whether the bitmap and
+!                        data values were unpacked.  If false,
+!                        gfld%bmap and gfld%fld pointers are nullified.
+!        gfld%expanded = Logical value indicating whether the data field
+!                         was expanded to the grid in the case where a
+!                         bit-map is present.  If true, the data points in
+!                         gfld%fld match the grid points and zeros were
+!                         inserted at grid points where data was bit-mapped
+!                         out.  If false, the data values in gfld%fld were
+!                         not expanded to the grid and are just a consecutive
+!                         array of data points corresponding to each value of
+!                         "1" in gfld%bmap.
+!        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
+!                     0 = bitmap applies and is included in Section 6.
+!                     1-253 = Predefined bitmap applies
+!                     254 = Previously defined bitmap applies to this field
+!                     255 = Bit map does not apply to this product.
+!        gfld%bmap() = Logical*1 array containing decoded bitmap,
+!                      if ibmap=0 or ibap=254.  Otherwise nullified.
+!                      This element is actually a pointer to an array
+!                      that holds the data.
+!        gfld%fld() = Array of gfld%ndpts unpacked data points.
+!                     This element is actually a pointer to an array
+!                     that holds the data.
+!
+!
+! PROGRAM HISTORY LOG:
+! 2002-01-23  Gilbert
+!
+! USAGE:    use grib_mod
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=12) :: G2_VERSION="g2lib-1.0.7"
+
+      type gribfield
+          integer :: version,discipline
+          integer,pointer,dimension(:) :: idsect
+          integer :: idsectlen
+          character(len=1),pointer,dimension(:) :: local
+          integer :: locallen
+          integer :: ifldnum
+          integer :: griddef,ngrdpts
+          integer :: numoct_opt,interp_opt,num_opt
+          integer,pointer,dimension(:) :: list_opt
+          integer :: igdtnum,igdtlen
+          integer,pointer,dimension(:) :: igdtmpl
+          integer :: ipdtnum,ipdtlen
+          integer,pointer,dimension(:) :: ipdtmpl
+          integer :: num_coord
+          real,pointer,dimension(:) :: coord_list
+          integer :: ndpts,idrtnum,idrtlen
+          integer,pointer,dimension(:) :: idrtmpl
+          logical :: unpacked
+          logical :: expanded
+          integer :: ibmap
+          logical*1,pointer,dimension(:) :: bmap
+          real,pointer,dimension(:) :: fld
+      end type gribfield
+
+      end module
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gridtemplates.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gridtemplates.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/gridtemplates.F	(revision 2744)
@@ -0,0 +1,403 @@
+      module gridtemplates
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! MODULE:    gridtemplates 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-09
+!
+! ABSTRACT: This Fortran Module contains info on all the available 
+!   GRIB2 Grid Definition Templates used in Section 3 (GDS).
+!   Each Template has three parts: The number of entries in the template
+!   (mapgridlen);  A map of the template (mapgrid), which contains the
+!   number of octets in which to pack each of the template values; and
+!   a logical value (needext) that indicates whether the Template needs 
+!   to be extended.  In some cases the number of entries in a template 
+!   can vary depending upon values specified in the "static" part of 
+!   the template.  ( See Template 3.120 as an example )
+!
+!   This module also contains two subroutines.  Subroutine getgridtemplate
+!   returns the octet map for a specified Template number, and
+!   subroutine extgridtemplate will calculate the extended octet map
+!   of an appropriate template given values for the "static" part of the 
+!   template.  See docblocks below for the arguments and usage of these 
+!   routines.
+!
+!   NOTE:  Array mapgrid contains the number of octets in which the 
+!   corresponding template values will be stored.  A negative value in
+!   mapgrid is used to indicate that the corresponding template entry can
+!   contain negative values.  This information is used later when packing
+!   (or unpacking) the template data values.  Negative data values in GRIB
+!   are stored with the left most bit set to one, and a negative number
+!   of octets value in mapgrid() indicates that this possibility should
+!   be considered.  The number of octets used to store the data value
+!   in this case would be the absolute value of the negative value in 
+!   mapgrid().
+!  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-09  Gilbert
+! 2003-09-02  Gilbert   -  Added GDT 3.31 - Albers Equal Area
+!
+! USAGE:    use gridtemplates
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,parameter :: MAXLEN=200,MAXTEMP=23
+
+      type gridtemplate
+          integer :: template_num
+          integer :: mapgridlen
+          integer,dimension(MAXLEN) :: mapgrid
+          logical :: needext
+      end type gridtemplate
+
+      type(gridtemplate),dimension(MAXTEMP) :: templates
+
+      data templates(1)%template_num /0/     !  Lat/Lon 
+      data templates(1)%mapgridlen /19/
+      data templates(1)%needext /.false./
+      data (templates(1)%mapgrid(j),j=1,19) 
+     &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1/
+
+      data templates(2)%template_num /1/     !  Rotated Lat/Lon 
+      data templates(2)%mapgridlen /22/
+      data templates(2)%needext /.false./
+      data (templates(2)%mapgrid(j),j=1,22) 
+     &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4/
+
+      data templates(3)%template_num /2/     !  Stretched Lat/Lon 
+      data templates(3)%mapgridlen /22/
+      data templates(3)%needext /.false./
+      data (templates(3)%mapgrid(j),j=1,22) 
+     &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,-4/
+
+      data templates(4)%template_num /3/     !  Stretched & Rotated Lat/Lon 
+      data templates(4)%mapgridlen /25/
+      data templates(4)%needext /.false./
+      data (templates(4)%mapgrid(j),j=1,25) 
+     &       /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4,-4,4,-4/
+
+      data templates(5)%template_num /10/     !  Mercator
+      data templates(5)%mapgridlen /19/
+      data templates(5)%needext /.false./
+      data (templates(5)%mapgrid(j),j=1,19)
+     &              /1,1,4,1,4,1,4,4,4,-4,4,1,-4,-4,4,1,4,4,4/
+
+      data templates(6)%template_num /20/     !  Polar Stereographic
+      data templates(6)%mapgridlen /18/
+      data templates(6)%needext /.false./
+      data (templates(6)%mapgrid(j),j=1,18) 
+     &              /1,1,4,1,4,1,4,4,4,-4,4,1,-4,4,4,4,1,1/
+
+      data templates(7)%template_num /30/     !  Lambert Conformal
+      data templates(7)%mapgridlen /22/
+      data templates(7)%needext /.false./
+      data (templates(7)%mapgrid(j),j=1,22) 
+     &              /1,1,4,1,4,1,4,4,4,-4,4,1,-4,4,4,4,1,1,-4,-4,-4,4/
+
+      data templates(8)%template_num /40/     !  Gaussian Lat/Lon
+      data templates(8)%mapgridlen /19/
+      data templates(8)%needext /.false./
+      data (templates(8)%mapgrid(j),j=1,19) 
+     &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1/
+
+      data templates(9)%template_num /41/     !  Rotated Gaussian Lat/Lon
+      data templates(9)%mapgridlen /22/
+      data templates(9)%needext /.false./
+      data (templates(9)%mapgrid(j),j=1,22) 
+     &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4/
+
+      data templates(10)%template_num /42/     !  Stretched Gaussian Lat/Lon
+      data templates(10)%mapgridlen /22/
+      data templates(10)%needext /.false./
+      data (templates(10)%mapgrid(j),j=1,22) 
+     &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,-4/
+
+      data templates(11)%template_num /43/     !  Strtchd and Rot'd Gaus Lat/Lon
+      data templates(11)%mapgridlen /25/
+      data templates(11)%needext /.false./
+      data (templates(11)%mapgrid(j),j=1,25) 
+     &          /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4,-4,4,-4/
+
+      data templates(12)%template_num /50/    !  Spherical Harmonic Coefficients
+      data templates(12)%mapgridlen /5/
+      data templates(12)%needext /.false./
+      data (templates(12)%mapgrid(j),j=1,5) /4,4,4,1,1/
+
+      data templates(13)%template_num /51/   !  Rotated Spherical Harmonic Coeff
+      data templates(13)%mapgridlen /8/
+      data templates(13)%needext /.false./
+      data (templates(13)%mapgrid(j),j=1,8) /4,4,4,1,1,-4,4,4/
+
+      data templates(14)%template_num /52/   !  Stretch Spherical Harmonic Coeff
+      data templates(14)%mapgridlen /8/
+      data templates(14)%needext /.false./
+      data (templates(14)%mapgrid(j),j=1,8) /4,4,4,1,1,-4,4,-4/
+
+      data templates(15)%template_num /53/   !  Strch and Rot Spher Harm Coeffs
+      data templates(15)%mapgridlen /11/
+      data templates(15)%needext /.false./
+      data (templates(15)%mapgrid(j),j=1,11) /4,4,4,1,1,-4,4,4,-4,4,-4/
+
+      data templates(16)%template_num /90/     !  Space view Perspective
+      data templates(16)%mapgridlen /21/
+      data templates(16)%needext /.false./
+      data (templates(16)%mapgrid(j),j=1,21) 
+     &              /1,1,4,1,4,1,4,4,4,-4,4,1,4,4,4,4,1,4,4,4,4/
+
+      data templates(17)%template_num /100/    !  Triangular grid (icosahedron)
+      data templates(17)%mapgridlen /11/
+      data templates(17)%needext /.false./
+      data (templates(17)%mapgrid(j),j=1,11) /1,1,2,1,-4,4,4,1,1,1,4/
+
+      data templates(18)%template_num /110/ !  Equatorial Azimuthal equidistant
+      data templates(18)%mapgridlen /16/
+      data templates(18)%needext /.false./
+      data (templates(18)%mapgrid(j),j=1,16) 
+     &              /1,1,4,1,4,1,4,4,4,-4,4,1,4,4,1,1/
+
+       data templates(19)%template_num /120/     !  Azimuth-range 
+       data templates(19)%mapgridlen /7/
+       data templates(19)%needext /.true./
+       data (templates(19)%mapgrid(j),j=1,7) /4,4,-4,4,4,4,1/
+
+       data templates(20)%template_num /1000/     !  Cross Section Grid 
+       data templates(20)%mapgridlen /20/
+       data templates(20)%needext /.true./
+       data (templates(20)%mapgrid(j),j=1,20) 
+     &              /1,1,4,1,4,1,4,4,4,4,-4,4,1,4,4,1,2,1,1,2/
+
+       data templates(21)%template_num /1100/     !  Hovmoller Diagram Grid 
+       data templates(21)%mapgridlen /28/
+       data templates(21)%needext /.false./
+       data (templates(21)%mapgrid(j),j=1,28) 
+     &    /1,1,4,1,4,1,4,4,4,4,-4,4,1,-4,4,1,4,1,-4,1,1,-4,2,1,1,1,1,1/
+
+       data templates(22)%template_num /1200/     !  Time Section Grid 
+       data templates(22)%mapgridlen /16/
+       data templates(22)%needext /.true./
+       data (templates(22)%mapgrid(j),j=1,16) 
+     &              /4,1,-4,1,1,-4,2,1,1,1,1,1,2,1,1,2/
+
+      data templates(23)%template_num /31/     !  Albers Equal Area
+      data templates(23)%mapgridlen /22/
+      data templates(23)%needext /.false./
+      data (templates(23)%mapgrid(j),j=1,22) 
+     &              /1,1,4,1,4,1,4,4,4,-4,4,1,-4,4,4,4,1,1,-4,-4,-4,4/
+
+      contains
+
+
+         integer function getgridindex(number)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getgridindex
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
+!
+! ABSTRACT: This function returns the index of specified Grid
+!   Definition Template 3.NN (NN=number) in array templates.
+!
+! PROGRAM HISTORY LOG:
+! 2001-06-28  Gilbert
+!
+! USAGE:    index=getgridindex(number)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Grid Definition
+!                Template 3.NN that is being requested.
+!
+! RETURNS:  Index of GDT 3.NN in array templates, if template exists.
+!           = -1, otherwise.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number
+
+           getgridindex=-1
+
+           do j=1,MAXTEMP
+              if (number.eq.templates(j)%template_num) then
+                 getgridindex=j
+                 return
+              endif
+           enddo
+
+         end function
+
+
+         subroutine getgridtemplate(number,nummap,map,needext,iret)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getgridtemplate 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-09
+!
+! ABSTRACT: This subroutine returns grid template information for a 
+!   specified Grid Definition Template 3.NN.
+!   The number of entries in the template is returned along with a map
+!   of the number of octets occupied by each entry.  Also, a flag is
+!   returned to indicate whether the template would need to be extended.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-09  Gilbert
+!
+! USAGE:    CALL getgridtemplate(number,nummap,map,needext,iret)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Grid Definition 
+!                Template 3.NN that is being requested.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     nummap   - Number of entries in the Template
+!     map()    - An array containing the number of octets that each 
+!                template entry occupies when packed up into the GDS.
+!     needext  - Logical variable indicating whether the Grid Defintion
+!                Template has to be extended.  
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Undefine Grid Template number.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number
+           integer,intent(out) :: nummap,map(*),iret
+           logical,intent(out) :: needext
+
+           iret=0
+
+           index=getgridindex(number)
+
+           if (index.ne.-1) then
+              nummap=templates(index)%mapgridlen
+              needext=templates(index)%needext
+              map(1:nummap)=templates(index)%mapgrid(1:nummap)
+           else
+             nummap=0
+             needext=.false.
+             print *,'getgridtemplate: Grid Template ',number,
+     &               ' not defined.'
+             iret=1
+           endif
+
+         end subroutine
+
+
+         subroutine extgridtemplate(number,list,nummap,map)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    extgridtemplate 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-09
+!
+! ABSTRACT: This subroutine generates the remaining octet map for a 
+!   given Grid Definition Template, if required.  Some Templates can 
+!   vary depending on data values given in an earlier part of the 
+!   Template, and it is necessary to know some of the earlier entry
+!   values to generate the full octet map of the Template.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-09  Gilbert
+!
+! USAGE:    CALL extgridtemplate(number,list,nummap,map)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Grid Definition 
+!                Template 3.NN that is being requested.
+!     list()   - The list of values for each entry in 
+!                the Grid Definition Template.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     nummap   - Number of entries in the Template
+!     map()    - An array containing the number of octets that each 
+!                template entry occupies when packed up into the GDS.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number,list(*)
+           integer,intent(out) :: nummap,map(*)
+
+           index=getgridindex(number)
+           if (index.eq.-1) return
+
+           if ( .not. templates(index)%needext ) return
+           nummap=templates(index)%mapgridlen
+           map(1:nummap)=templates(index)%mapgrid(1:nummap)
+
+           if ( number.eq.120 ) then
+              N=list(2)
+              do i=1,N
+                map(nummap+1)=2
+                map(nummap+2)=-2
+                nummap=nummap+2
+              enddo
+           elseif ( number.eq.1000 ) then
+              N=list(20)
+              do i=1,N
+                map(nummap+1)=4
+                nummap=nummap+1
+              enddo
+           elseif ( number.eq.1200 ) then
+              N=list(16)
+              do i=1,N
+                map(nummap+1)=4
+                nummap=nummap+1
+              enddo
+           endif
+
+         end subroutine
+
+         integer function getgdtlen(number)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getgdtlen
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-05-11
+!
+! ABSTRACT: This function returns the initial length (number of entries) in
+!   the "static" part of specified Grid Definition Template 3.number.
+!
+! PROGRAM HISTORY LOG:
+! 2004-05-11  Gilbert
+!
+! USAGE:    CALL getgdtlen(number)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Grid Definition
+!                Template 3.NN that is being requested.
+!
+! RETURNS:     Number of entries in the "static" part of GDT 3.number
+!              OR returns 0, if requested template is not found.
+!
+! REMARKS: If user needs the full length of a specific template that
+!    contains additional entries based on values set in the "static" part
+!    of the GDT, subroutine extgridtemplate can be used.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number
+
+           getgdtlen=0
+
+           index=getgridindex(number)
+
+           if (index.ne.-1) then
+              getgdtlen=templates(index)%mapgridlen
+           endif
+
+         end function
+
+
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/ixgb2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/ixgb2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/ixgb2.F	(revision 2744)
@@ -0,0 +1,206 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: IXGB2          MAKE INDEX RECORDS FOR FIELDS IN A GRIB2 MESSAGE
+C   PRGMMR: GILBERT          ORG: W/NP11      DATE: 2001-12-10
+C
+C ABSTRACT: THIS SUBPROGRAM GENERATES AN INDEX RECORD FOR EACH FIELD IN A
+C           GRIB2 MESSAGE.  THE INDEX RECORDS ARE WRITTEN TO INDEX BUFFER
+C           POINTED TO BY CBUF.
+C
+C           EACH INDEX RECORD HAS THE FOLLOWING FORM:
+C       BYTE 001 - 004: LENGTH OF INDEX RECORD
+C       BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
+C       BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
+C                       SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
+C       BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
+C       BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
+C       BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
+C       BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
+C       BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
+C       BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
+C       BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
+C       BYTE 042 - 042: MESSAGE DISCIPLINE
+C       BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
+C       BYTE 045 -  II: IDENTIFICATION SECTION (IDS) 
+C       BYTE II+1-  JJ: GRID DEFINITION SECTION (GDS) 
+C       BYTE JJ+1-  KK: PRODUCT DEFINITION SECTION (PDS)
+C       BYTE KK+1-  LL: THE DATA REPRESENTATION SECTION (DRS)
+C       BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
+C
+C PROGRAM HISTORY LOG:
+C   95-10-31  IREDELL
+C   96-10-31  IREDELL   AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
+C 2001-12-10  GILBERT   MODIFIED FROM IXGB TO CREATE GRIB2 INDEXES
+C 2002-01-31  GILBERT   ADDED IDENTIFICATION SECTION TO INDEX RECORD
+C
+C USAGE:    CALL IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET)
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER LOGICAL UNIT OF INPUT GRIB FILE
+C     LSKIP        INTEGER NUMBER OF BYTES TO SKIP BEFORE GRIB MESSAGE
+C     LGRIB        INTEGER NUMBER OF BYTES IN GRIB MESSAGE
+C   OUTPUT ARGUMENTS:
+C     CBUF         CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
+C                  USERS SHOULD FREE MEMORY THAT CBUF POINTS TO
+C                  USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED.
+C     NUMFLD       INTEGER NUMBER OF INDEX RECORDS CREATED.
+C                  = 0, IF PROBLEMS
+C     MLEN         INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
+C     IRET         INTEGER RETURN CODE
+C                  =0, ALL OK
+C                  =1, NOT ENOUGH MEMORY TO ALLOCATE INITIAL INDEX BUFFER
+C                  =2, I/O ERROR IN READ
+C                  =3, GRIB MESSAGE IS NOT EDITION 2
+C                  =4, NOT ENOUGH MEMORY TO ALLOCATE EXTENT TO INDEX BUFFER
+C                  =5, UNIDENTIFIED GRIB SECTION ENCOUNTERED...PROBLEM 
+C                      SOMEWHERE.
+C
+C SUBPROGRAMS CALLED:
+C   G2LIB_GBYTE        GET INTEGER DATA FROM BYTES
+C   G2LIB_SBYTE        STORE INTEGER DATA IN BYTES
+C   BAREAD       BYTE-ADDRESSABLE READ
+C   REALLOC      RE-ALLOCATES MORE MEMORY
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE RE_ALLOC          ! NEEDED FOR SUBROUTINE REALLOC
+      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
+      PARAMETER(LINMAX=5000,INIT=50000,NEXT=10000)
+      PARAMETER(IXSKP=4,IXLUS=8,IXSGD=12,IXSPD=16,IXSDR=20,IXSBM=24,
+     &          IXDS=28,IXLEN=36,IXFLD=42,IXIDS=44)
+      PARAMETER(MXSKP=4,MXLUS=4,MXSGD=4,MXSPD=4,MXSDR=4,MXSBM=4,
+     &          MXDS=4,MXLEN=4,MXFLD=2,MXBMS=6)
+      CHARACTER CBREAD(LINMAX),CINDEX(LINMAX)
+      CHARACTER CVER,CDISC
+      CHARACTER CIDS(LINMAX),CGDS(LINMAX),CBMS(6)
+      CHARACTER(LEN=4) :: CTEMP
+      INTEGER LOCLUS,LOCGDS,LENGDS,LOCBMS
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      LOCLUS=0
+      IRET=0
+      MLEN=0
+      NUMFLD=0
+      IF (ASSOCIATED(CBUF)) NULLIFY(CBUF)
+      MBUF=INIT
+      ALLOCATE(CBUF(MBUF),STAT=ISTAT)    ! ALLOCATE INITIAL SPACE FOR CBUF
+      IF (ISTAT.NE.0) THEN
+         IRET=1
+         RETURN
+      ENDIF
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  READ SECTIONS 0 AND 1 FOR VERSIN NUMBER AND DISCIPLINE
+      IBREAD=MIN(LGRIB,LINMAX)
+      CALL BAREAD(LUGB,LSKIP,IBREAD,LBREAD,CBREAD)
+      IF(LBREAD.NE.IBREAD) THEN
+         IRET=2
+         RETURN
+      ENDIF
+      IF(CBREAD(8).NE.CHAR(2)) THEN          !  NOT GRIB EDITION 2
+         IRET=3
+         RETURN
+      ENDIF
+      CVER=CBREAD(8)
+      CDISC=CBREAD(7)
+      CALL G2LIB_GBYTE(CBREAD,LENSEC1,16*8,4*8)
+      LENSEC1=MIN(LENSEC1,IBREAD)
+      CIDS(1:LENSEC1)=CBREAD(17:16+LENSEC1)
+      IBSKIP=LSKIP+16+LENSEC1
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  LOOP THROUGH REMAINING SECTIONS CREATING AN INDEX FOR EACH FIELD
+      IBREAD=MAX(5,MXBMS)
+      DO
+         CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)     
+         CTEMP=CBREAD(1)//CBREAD(2)//CBREAD(3)//CBREAD(4)
+         IF (CTEMP.EQ.'7777') RETURN        ! END OF MESSAGE FOUND
+         IF(LBREAD.NE.IBREAD) THEN
+            IRET=2
+            RETURN
+         ENDIF
+         CALL G2LIB_GBYTE(CBREAD,LENSEC,0*8,4*8)
+         CALL G2LIB_GBYTE(CBREAD,NUMSEC,4*8,1*8)
+
+         IF (NUMSEC.EQ.2) THEN                 ! SAVE LOCAL USE LOCATION
+            LOCLUS=IBSKIP-LSKIP
+         ELSEIF (NUMSEC.EQ.3) THEN                 ! SAVE GDS INFO
+            LENGDS=LENSEC
+            CGDS=CHAR(0)
+            CALL BAREAD(LUGB,IBSKIP,LENGDS,LBREAD,CGDS)     
+            IF(LBREAD.NE.LENGDS) THEN
+               IRET=2
+               RETURN
+            ENDIF
+            LOCGDS=IBSKIP-LSKIP
+         ELSEIF (NUMSEC.EQ.4) THEN                 ! FOUND PDS
+            CINDEX=CHAR(0)
+            CALL G2LIB_SBYTE(CINDEX,LSKIP,8*IXSKP,8*MXSKP)    ! BYTES TO SKIP
+            CALL G2LIB_SBYTE(CINDEX,LOCLUS,8*IXLUS,8*MXLUS)   ! LOCATION OF LOCAL USE
+            CALL G2LIB_SBYTE(CINDEX,LOCGDS,8*IXSGD,8*MXSGD)   ! LOCATION OF GDS
+            CALL G2LIB_SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSPD,8*MXSPD)  ! LOCATION OF PDS
+            CALL G2LIB_SBYTE(CINDEX,LGRIB,8*IXLEN,8*MXLEN)    ! LEN OF GRIB2
+            CINDEX(41)=CVER
+            CINDEX(42)=CDISC
+            CALL G2LIB_SBYTE(CINDEX,NUMFLD+1,8*IXFLD,8*MXFLD)   ! FIELD NUM
+            CINDEX(IXIDS+1:IXIDS+LENSEC1)=CIDS(1:LENSEC1)
+            LINDEX=IXIDS+LENSEC1
+            CINDEX(LINDEX+1:LINDEX+LENGDS)=CGDS(1:LENGDS)
+            LINDEX=LINDEX+LENGDS
+            ILNPDS=LENSEC
+            CALL BAREAD(LUGB,IBSKIP,ILNPDS,LBREAD,CINDEX(LINDEX+1))     
+            IF(LBREAD.NE.ILNPDS) THEN
+               IRET=2
+               RETURN
+            ENDIF
+            !   CINDEX(LINDEX+1:LINDEX+ILNPDS)=CBREAD(1:ILNPDS)
+            LINDEX=LINDEX+ILNPDS
+         ELSEIF (NUMSEC.EQ.5) THEN                 ! FOUND DRS
+            CALL G2LIB_SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSDR,8*MXSDR)  ! LOCATION OF DRS
+            ILNDRS=LENSEC
+            CALL BAREAD(LUGB,IBSKIP,ILNDRS,LBREAD,CINDEX(LINDEX+1))     
+            IF(LBREAD.NE.ILNDRS) THEN
+               IRET=2
+               RETURN
+            ENDIF
+            !   CINDEX(LINDEX+1:LINDEX+ILNDRS)=CBREAD(1:ILNDRS)
+            LINDEX=LINDEX+ILNDRS
+         ELSEIF (NUMSEC.EQ.6) THEN                 ! FOUND BMS
+            INDBMP=MOVA2I(CBREAD(6))
+            IF ( INDBMP.LT.254 ) THEN
+               LOCBMS=IBSKIP-LSKIP
+               CALL G2LIB_SBYTE(CINDEX,LOCBMS,8*IXSBM,8*MXSBM)  ! LOC. OF BMS
+            ELSEIF ( INDBMP.EQ.254 ) THEN
+               CALL G2LIB_SBYTE(CINDEX,LOCBMS,8*IXSBM,8*MXSBM)  ! LOC. OF BMS
+            ELSEIF ( INDBMP.EQ.255 ) THEN
+               CALL G2LIB_SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSBM,8*MXSBM)  ! LOC. OF BMS
+            ENDIF
+            CINDEX(LINDEX+1:LINDEX+MXBMS)=CBREAD(1:MXBMS)
+            LINDEX=LINDEX+MXBMS
+            CALL G2LIB_SBYTE(CINDEX,LINDEX,0,8*4)    ! NUM BYTES IN INDEX RECORD
+         ELSEIF (NUMSEC.EQ.7) THEN                 ! FOUND DATA SECTION
+            CALL G2LIB_SBYTE(CINDEX,IBSKIP-LSKIP,8*IXDS,8*MXDS)   ! LOC. OF DATA SEC.
+            NUMFLD=NUMFLD+1
+            IF ((LINDEX+MLEN).GT.MBUF) THEN        ! ALLOCATE MORE SPACE IF
+                                                   ! NECESSARY
+               NEWSIZE=MAX(MBUF+NEXT,MBUF+LINDEX)
+               CALL REALLOC(CBUF,MLEN,NEWSIZE,ISTAT)
+               IF ( ISTAT .NE. 0 ) THEN
+                  NUMFLD=NUMFLD-1
+                  IRET=4
+                  RETURN
+               ENDIF
+               MBUF=NEWSIZE
+            ENDIF
+            CBUF(MLEN+1:MLEN+LINDEX)=CINDEX(1:LINDEX)
+            MLEN=MLEN+LINDEX
+         ELSE                           ! UNRECOGNIZED SECTION
+            IRET=5
+            RETURN
+         ENDIF
+         IBSKIP=IBSKIP+LENSEC
+      ENDDO
+
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/jpcpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/jpcpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/jpcpack.F	(revision 2744)
@@ -0,0 +1,236 @@
+      subroutine jpcpack(fld,width,height,idrstmpl,cpack,lcpack,ierr)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    jpcpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2002-12-17
+!
+! ABSTRACT: This subroutine packs up a data field into a JPEG2000 code stream.
+!   After the data field is scaled, and the reference value is subtracted out,
+!   it is treated as a grayscale image and passed to a JPEG2000 encoder.
+!   It also fills in GRIB2 Data Representation Template 5.40 or 5.40000 with the
+!   appropriate values.
+!
+! PROGRAM HISTORY LOG:
+! 2002-12-17  Gilbert
+! 2004-07-19  Gilbert - Added check on whether the jpeg2000 encoding was
+!                       successful.  If not, try again with different encoder
+!                       options.
+!
+! USAGE:    CALL jpcpack(fld,width,height,idrstmpl,cpack,lcpack)
+!   INPUT ARGUMENT LIST:
+!     fld()    - Contains the data values to pack
+!     width    - number of points in the x direction
+!     height   - number of points in the y direction
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.40 or 5.40000
+!                (1) = Reference value - ignored on input
+!                (2) = Binary Scale Factor
+!                (3) = Decimal Scale Factor
+!                (4) = number of bits for each data value - ignored on input
+!                (5) = Original field type - currently ignored on input
+!                      Data values assumed to be reals.
+!                (6) = 0 - use lossless compression
+!                    = 1 - use lossy compression
+!                (7) = Desired compression ratio, if idrstmpl(6)=1.
+!                      Set to 255, if idrstmpl(6)=0.
+!     lcpack   - size of array cpack().
+!
+!   OUTPUT ARGUMENT LIST: 
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.0
+!                (1) = Reference value - set by jpcpack routine.
+!                (2) = Binary Scale Factor - unchanged from input
+!                (3) = Decimal Scale Factor - unchanged from input
+!                (4) = Number of bits containing each grayscale pixel value
+!                (5) = Original field type - currently set = 0 on output.
+!                      Data values assumed to be reals.
+!                (6) = 0 - use lossless compression
+!                    = 1 - use lossy compression
+!                (7) = Desired compression ratio, if idrstmpl(6)=1
+!     cpack    - The packed data field (character*1 array)
+!     lcpack   - length of packed field in cpack().
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,intent(in) :: width,height
+      real,intent(in) :: fld(width*height)
+      character(len=1),intent(out) :: cpack(*)
+      integer,intent(inout) :: idrstmpl(*)
+      integer,intent(inout) :: lcpack
+      integer,intent(out)   :: ierr
+
+      real(4) :: ref
+      integer(4) :: iref
+      integer :: ifld(width*height),retry
+      integer,parameter :: zero=0
+      integer :: enc_jpeg2000
+      character(len=1),allocatable :: ctemp(:)
+      integer :: orig_dscalefct
+      integer :: orig_bscalefct
+      integer(8) :: maxdif,imin,imax
+      
+      ierr = 0
+
+      ndpts=width*height
+      bscale=2.0**real(-idrstmpl(2))
+      dscale=10.0**real(idrstmpl(3))
+
+      orig_bscalefct = idrstmpl(2)
+      orig_dscalefct = idrstmpl(3)
+
+!
+!  Find max and min values in the data
+!
+      rmax=fld(1)
+      rmin=fld(1)
+      do j=2,ndpts
+        if (fld(j).gt.rmax) rmax=fld(j)
+        if (fld(j).lt.rmin) rmin=fld(j)
+      enddo
+      if (idrstmpl(2).eq.0) then
+         maxdif=nint(rmax*dscale,8)-nint(rmin*dscale,8)
+      else
+         maxdif=nint((rmax-rmin)*dscale*bscale,8)
+      endif
+!
+!  If max and min values are not equal, pack up field.
+!  If they are equal, we have a constant field, and the reference
+!  value (rmin) is the value for each point in the field and
+!  set nbits to 0.
+!
+      if (rmin.ne.rmax .AND. maxdif.ne.0) then
+        !
+        !  Determine which algorithm to use based on user-supplied 
+        !  binary scale factor and number of bits.
+        !
+
+        if (idrstmpl(2).eq.0) then
+           !
+           !  No binary scaling and calculate minimum number of 
+           !  bits in which the data will fit.
+           !
+
+           nbits = 25
+
+           do while (nbits .gt. 24) 
+              imin=nint(rmin*dscale,8)
+              imax=nint(rmax*dscale,8)
+              maxdif=imax-imin
+              temp=alog(real(maxdif+1))/alog(2.0)
+              nbits=ceiling(temp)
+              !
+              ! These lines assure that we do no overflow
+              !
+              !  Todd Hutchinson, WSI 9/23/05
+              !
+              if (nbits .le. 24) then 
+                 exit
+              else
+                 idrstmpl(3) = idrstmpl(3) - 1
+                 dscale=10.0**real(idrstmpl(3))
+              endif
+           enddo
+
+           rmin=real(imin)
+           !   scale data
+           do j=1,ndpts
+             ifld(j)=nint(fld(j)*dscale)-imin
+           enddo
+        else
+           !
+           !  Use binary scaling factor and calculate minimum number of 
+           !  bits in which the data will fit.
+           !
+           nbits = 25
+
+           do while (nbits .gt. 24) 
+              rmin=rmin*dscale
+              rmax=rmax*dscale
+              maxdif=nint((rmax-rmin)*bscale)
+              temp=alog(real(maxdif+1))/alog(2.0)
+              nbits=ceiling(temp)
+              !
+              ! These lines assure that we do no overflow
+              !
+              !  Todd Hutchinson, WSI 9/23/05
+              !
+              if (nbits .le. 24) then 
+                 exit
+              else
+                 idrstmpl(2) = idrstmpl(2) + 1
+                 bscale=2.0**real(-idrstmpl(2))
+              endif              
+           enddo
+           !   scale data
+           do j=1,ndpts
+             ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale)
+           enddo
+        endif
+
+        if (idrstmpl(2) .ne. orig_bscalefct) then 
+           write(6,'(A,I2,A,I2,A)')
+     &          ' JPCPACK: Reduced binary scale fctr from ',
+     &          orig_bscalefct,' to ',idrstmpl(2),
+     &          ' to prevent overflow'
+           ierr = 12
+        endif
+
+        if (idrstmpl(3) .ne. orig_dscalefct) then 
+           write(6,'(A,I2,A,I2,A)')
+     &          ' JPCPACK: Reduced decimal scale fctr from ',
+     &          orig_dscalefct,' to ',idrstmpl(3), 
+     &          ' to prevent overflow'
+           ierr = 11
+        endif
+
+        !
+        !  Pack data into full octets, then do JPEG2000 encode.
+        !  and calculate the length of the packed data in bytes
+        !
+        retry=0
+        nbytes=(nbits+7)/8
+        nsize=lcpack      ! needed for input to enc_jpeg2000
+        allocate(ctemp(nbytes*ndpts))
+        call g2lib_sbytes(ctemp,ifld,0,nbytes*8,0,ndpts)
+        lcpack=enc_jpeg2000(ctemp,width,height,nbits,idrstmpl(6),
+     &                      idrstmpl(7),retry,cpack,nsize)
+        if (lcpack.le.0) then
+           print *,'jpcpack: ERROR Packing JPC=',lcpack
+           if (lcpack.eq.-3) then
+              retry=1
+              print *,'jpcpack: Retrying....'
+              lcpack=enc_jpeg2000(ctemp,width,height,nbits,idrstmpl(6),
+     &                         idrstmpl(7),retry,cpack,nsize)
+              if (lcpack.le.0) then
+                 print *,'jpcpack: Retry Failed.'
+              else
+                 print *,'jpcpack: Retry Successful.'
+              endif
+           endif
+        endif
+        deallocate(ctemp)
+
+      else
+        nbits=0
+        lcpack=0
+      endif
+
+!
+!  Fill in ref value and number of bits in Template 5.0
+!
+      call mkieee(rmin,ref,1)   ! ensure reference value is IEEE format
+!      call g2lib_gbyte(ref,idrstmpl(1),0,32)
+      iref=transfer(ref,iref)
+      idrstmpl(1)=iref
+      idrstmpl(4)=nbits
+      idrstmpl(5)=0         ! original data were reals
+      if (idrstmpl(6).eq.0) idrstmpl(7)=255       ! lossy not used
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/jpcunpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/jpcunpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/jpcunpack.F	(revision 2744)
@@ -0,0 +1,66 @@
+      subroutine jpcunpack(cpack,len,idrstmpl,ndpts,fld)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    jpcunpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2002-12-17
+!
+! ABSTRACT: This subroutine unpacks a data field that was packed into a 
+!   JPEG2000 code stream
+!   using info from the GRIB2 Data Representation Template 5.40 or 5.40000.
+!
+! PROGRAM HISTORY LOG:
+! 2002-12-17  Gilbert
+!
+! USAGE:    CALL jpcunpack(cpack,len,idrstmpl,ndpts,fld)
+!   INPUT ARGUMENT LIST:
+!     cpack    - The packed data field (character*1 array)
+!     len      - length of packed field cpack().
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.40 or 5.40000
+!     ndpts    - The number of data values to unpack
+!
+!   OUTPUT ARGUMENT LIST:
+!     fld()    - Contains the unpacked data values
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cpack(len)
+      integer,intent(in) :: ndpts,len
+      integer,intent(in) :: idrstmpl(*)
+      real,intent(out) :: fld(ndpts)
+
+      integer :: ifld(ndpts)
+      integer(4) :: ieee
+      real :: ref,bscale,dscale
+      integer :: dec_jpeg2000
+
+      ieee = idrstmpl(1)
+      call rdieee(ieee,ref,1)
+      bscale = 2.0**real(idrstmpl(2))
+      dscale = 10.0**real(-idrstmpl(3))
+      nbits = idrstmpl(4)
+!
+!  if nbits equals 0, we have a constant field where the reference value
+!  is the data value at each gridpoint
+!
+      if (nbits.ne.0) then
+!         call g2lib_gbytes(cpack,ifld,0,nbits,0,ndpts)
+         iret=dec_jpeg2000(cpack,len,ifld)
+         do j=1,ndpts
+           fld(j)=((real(ifld(j))*bscale)+ref)*dscale
+         enddo
+      else
+         do j=1,ndpts
+           fld(j)=ref
+         enddo
+      endif
+
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/misspack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/misspack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/misspack.F	(revision 2744)
@@ -0,0 +1,499 @@
+      subroutine misspack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    misspack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2000-06-21
+!
+! ABSTRACT: This subroutine packs up a data field using a complex
+!   packing algorithm as defined in the GRIB2 documention.  It
+!   supports GRIB2 complex packing templates with or without
+!   spatial differences (i.e. DRTs 5.2 and 5.3).
+!   It also fills in GRIB2 Data Representation Template 5.2 or 5.3 
+!   with the appropriate values.
+!   This version assumes that Missing Value Management is being used and that
+!   1 or 2 missing values appear in the data.
+!
+! PROGRAM HISTORY LOG:
+! 2000-06-21  Gilbert
+! 2004-12-29  Gilbert  -  Corrected bug when encoding secondary missing values.
+!
+! USAGE:    CALL misspack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
+!   INPUT ARGUMENT LIST:
+!     fld()    - Contains the data values to pack
+!     ndpts    - The number of data values in array fld()
+!     idrsnum  - Data Representation Template number 5.N
+!                Must equal 2 or 3.
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.2 or 5.3
+!                (1) = Reference value - ignored on input
+!                (2) = Binary Scale Factor
+!                (3) = Decimal Scale Factor
+!                    .
+!                    .
+!                (7) = Missing value management
+!                (8) = Primary missing value
+!                (9) = Secondary missing value
+!                    .
+!                    .
+!               (17) = Order of Spatial Differencing  ( 1 or 2 )
+!                    .
+!                    .
+!
+!   OUTPUT ARGUMENT LIST: 
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.3
+!                (1) = Reference value - set by misspack routine.
+!                (2) = Binary Scale Factor - unchanged from input
+!                (3) = Decimal Scale Factor - unchanged from input
+!                    .
+!                    .
+!     cpack    - The packed data field (character*1 array)
+!     lcpack   - length of packed field cpack().
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,intent(in) :: ndpts,idrsnum
+      real,intent(in) :: fld(ndpts)
+      character(len=1),intent(out) :: cpack(*)
+      integer,intent(inout) :: idrstmpl(*)
+      integer,intent(out) :: lcpack
+
+      real(4) :: ref
+      integer(4) :: iref
+      integer,allocatable :: ifld(:),ifldmiss(:),jfld(:)
+      integer,allocatable :: jmin(:),jmax(:),lbit(:)
+      integer,parameter :: zero=0
+      integer,allocatable :: gref(:),gwidth(:),glen(:)
+      integer :: glength,grpwidth
+      logical :: simple_alg = .false.
+      
+      alog2=alog(2.0)
+      bscale=2.0**real(-idrstmpl(2))
+      dscale=10.0**real(idrstmpl(3))
+      missopt=idrstmpl(7)
+      if ( missopt.ne.1 .AND. missopt.ne.2 ) then
+         print *,'misspack: Unrecognized option.'
+         lcpack=-1
+         return
+      else     !  Get missing values
+         call rdieee(idrstmpl(8),rmissp,1)
+         if (missopt.eq.2) call rdieee(idrstmpl(9),rmisss,1)
+      endif
+!
+!  Find min value of non-missing values in the data,
+!  AND set up missing value mapping of the field.
+!
+      allocate(ifldmiss(ndpts))
+      rmin=huge(rmin)
+      if ( missopt .eq. 1 ) then        ! Primary missing value only
+         do j=1,ndpts
+           if (fld(j).eq.rmissp) then
+              ifldmiss(j)=1
+           else
+              ifldmiss(j)=0
+              if (fld(j).lt.rmin) rmin=fld(j)
+           endif
+         enddo
+      endif
+      if ( missopt .eq. 2 ) then        ! Primary and secondary missing values
+         do j=1,ndpts
+           if (fld(j).eq.rmissp) then
+              ifldmiss(j)=1
+           elseif (fld(j).eq.rmisss) then
+              ifldmiss(j)=2
+           else
+              ifldmiss(j)=0
+              if (fld(j).lt.rmin) rmin=fld(j)
+           endif
+         enddo
+      endif
+!
+!  Allocate work arrays:
+!  Note: -ifldmiss(j),j=1,ndpts is a map of original field indicating 
+!         which of the original data values
+!         are primary missing (1), sencondary missing (2) or non-missing (0).
+!        -jfld(j),j=1,nonmiss is a subarray of just the non-missing values from
+!         the original field.
+!
+      !if (rmin.ne.rmax) then
+        iofst=0
+        allocate(ifld(ndpts))
+        allocate(jfld(ndpts))
+        allocate(gref(ndpts))
+        allocate(gwidth(ndpts))
+        allocate(glen(ndpts))
+        !
+        !  Scale original data
+        !
+        nonmiss=0
+        if (idrstmpl(2).eq.0) then        !  No binary scaling
+           imin=nint(rmin*dscale)
+           !imax=nint(rmax*dscale)
+           rmin=real(imin)
+           do j=1,ndpts
+              if (ifldmiss(j).eq.0) then
+                nonmiss=nonmiss+1
+                jfld(nonmiss)=nint(fld(j)*dscale)-imin
+              endif
+           enddo
+        else                              !  Use binary scaling factor
+           rmin=rmin*dscale
+           !rmax=rmax*dscale
+           do j=1,ndpts
+              if (ifldmiss(j).eq.0) then
+                nonmiss=nonmiss+1
+                jfld(nonmiss)=nint(((fld(j)*dscale)-rmin)*bscale)
+              endif
+           enddo
+        endif
+        !
+        !  Calculate Spatial differences, if using DRS Template 5.3
+        !
+        if (idrsnum.eq.3) then        ! spatial differences
+           if (idrstmpl(17).ne.1.and.idrstmpl(17).ne.2) idrstmpl(17)=2
+           if (idrstmpl(17).eq.1) then      ! first order
+              ival1=jfld(1)
+              do j=nonmiss,2,-1
+                 jfld(j)=jfld(j)-jfld(j-1)
+              enddo
+              jfld(1)=0
+           elseif (idrstmpl(17).eq.2) then      ! second order
+              ival1=jfld(1)
+              ival2=jfld(2)
+              do j=nonmiss,3,-1
+                 jfld(j)=jfld(j)-(2*jfld(j-1))+jfld(j-2)
+              enddo
+              jfld(1)=0
+              jfld(2)=0
+           endif
+           !
+           !  subtract min value from spatial diff field
+           !
+           isd=idrstmpl(17)+1
+           minsd=minval(jfld(isd:nonmiss))
+           do j=isd,nonmiss
+              jfld(j)=jfld(j)-minsd
+           enddo
+           !
+           !   find num of bits need to store minsd and add 1 extra bit
+           !   to indicate sign
+           !
+           temp=alog(real(abs(minsd)+1))/alog2
+           nbitsd=ceiling(temp)+1
+           !
+           !   find num of bits need to store ifld(1) ( and ifld(2)
+           !   if using 2nd order differencing )
+           !
+           maxorig=ival1
+           if (idrstmpl(17).eq.2.and.ival2.gt.ival1) maxorig=ival2
+           temp=alog(real(maxorig+1))/alog2
+           nbitorig=ceiling(temp)+1
+           if (nbitorig.gt.nbitsd) nbitsd=nbitorig
+           !   increase number of bits to even multiple of 8 ( octet )
+           if (mod(nbitsd,8).ne.0) nbitsd=nbitsd+(8-mod(nbitsd,8))
+           !
+           !  Store extra spatial differencing info into the packed
+           !  data section.
+           !
+           if (nbitsd.ne.0) then
+              !   pack first original value
+              if (ival1.ge.0) then
+                 call g2lib_sbyte(cpack,ival1,iofst,nbitsd)
+                 iofst=iofst+nbitsd
+              else
+                 call g2lib_sbyte(cpack,1,iofst,1)
+                 iofst=iofst+1
+                 call g2lib_sbyte(cpack,iabs(ival1),iofst,nbitsd-1)
+                 iofst=iofst+nbitsd-1
+              endif
+              if (idrstmpl(17).eq.2) then
+               !  pack second original value
+                 if (ival2.ge.0) then
+                    call g2lib_sbyte(cpack,ival2,iofst,nbitsd)
+                    iofst=iofst+nbitsd
+                 else
+                    call g2lib_sbyte(cpack,1,iofst,1)
+                    iofst=iofst+1
+                    call g2lib_sbyte(cpack,iabs(ival2),iofst,nbitsd-1)
+                    iofst=iofst+nbitsd-1
+                 endif
+              endif
+              !  pack overall min of spatial differences
+              if (minsd.ge.0) then
+                 call g2lib_sbyte(cpack,minsd,iofst,nbitsd)
+                 iofst=iofst+nbitsd
+              else
+                 call g2lib_sbyte(cpack,1,iofst,1)
+                 iofst=iofst+1
+                 call g2lib_sbyte(cpack,iabs(minsd),iofst,nbitsd-1)
+                 iofst=iofst+nbitsd-1
+              endif
+           endif
+         !print *,'SDp ',ival1,ival2,minsd,nbitsd
+        endif     !  end of spatial diff section
+        !
+        !  Expand non-missing data values to original grid.
+        !
+        miss1=minval(jfld(1:nonmiss))-1
+        miss2=miss1-1
+        n=0
+        do j=1,ndpts
+           if ( ifldmiss(j).eq.0 ) then
+              n=n+1
+              ifld(j)=jfld(n)
+           elseif ( ifldmiss(j).eq.1 ) then
+              ifld(j)=miss1
+           elseif ( ifldmiss(j).eq.2 ) then
+              ifld(j)=miss2
+           endif
+        enddo
+        !
+        !   Determine Groups to be used.
+        !
+        if ( simple_alg ) then
+           !  set group length to 10 :  calculate number of groups
+           !  and length of last group
+           ngroups=ndpts/10
+           glen(1:ngroups)=10
+           itemp=mod(ndpts,10)
+           if (itemp.ne.0) then
+              ngroups=ngroups+1
+              glen(ngroups)=itemp
+           endif
+        else
+           ! Use Dr. Glahn's algorithm for determining grouping.
+           !
+           kfildo=6
+           minpk=10 
+           inc=1
+           maxgrps=(ndpts/minpk)+1
+           allocate(jmin(maxgrps))
+           allocate(jmax(maxgrps))
+           allocate(lbit(maxgrps))
+           call pack_gp(kfildo,ifld,ndpts,missopt,minpk,inc,miss1,miss2,
+     &                  jmin,jmax,lbit,glen,maxgrps,ngroups,ibit,jbit,
+     &                  kbit,novref,lbitref,ier)
+           !print *,'SAGier = ',ier,ibit,jbit,kbit,novref,lbitref
+           do ng=1,ngroups
+              glen(ng)=glen(ng)+novref
+           enddo
+           deallocate(jmin)
+           deallocate(jmax)
+           deallocate(lbit)
+        endif
+        !  
+        !  For each group, find the group's reference value (min)
+        !  and the number of bits needed to hold the remaining values
+        !
+        n=1
+        do ng=1,ngroups
+           !  how many of each type?
+           num0=count(ifldmiss(n:n+glen(ng)-1) .EQ. 0)
+           num1=count(ifldmiss(n:n+glen(ng)-1) .EQ. 1)
+           num2=count(ifldmiss(n:n+glen(ng)-1) .EQ. 2)
+           if ( num0.eq.0 ) then      ! all missing values
+              if ( num1.eq.0 ) then       ! all secondary missing
+                gref(ng)=-2
+                gwidth(ng)=0
+              elseif ( num2.eq.0 ) then       ! all primary missing
+                gref(ng)=-1
+                gwidth(ng)=0
+              else                           ! both primary and secondary
+                gref(ng)=0
+                gwidth(ng)=1
+              endif
+           else                       ! contains some non-missing data
+             !    find max and min values of group
+             gref(ng)=huge(n)
+             imax=-1*huge(n)
+             j=n
+             do lg=1,glen(ng)
+                if ( ifldmiss(j).eq.0 ) then
+                  if (ifld(j).lt.gref(ng)) gref(ng)=ifld(j) 
+                  if (ifld(j).gt.imax) imax=ifld(j) 
+                endif
+                j=j+1
+             enddo
+             if (missopt.eq.1) imax=imax+1
+             if (missopt.eq.2) imax=imax+2
+             !   calc num of bits needed to hold data
+             if ( gref(ng).ne.imax ) then
+                temp=alog(real(imax-gref(ng)+1))/alog2
+                gwidth(ng)=ceiling(temp)
+             else
+                gwidth(ng)=0
+             endif
+           endif
+           !   Subtract min from data
+           j=n
+           mtemp=2**gwidth(ng)
+           do lg=1,glen(ng)
+              if (ifldmiss(j).eq.0) then       ! non-missing
+                 ifld(j)=ifld(j)-gref(ng)
+              elseif (ifldmiss(j).eq.1) then    ! primary missing
+                 ifld(j)=mtemp-1
+              elseif (ifldmiss(j).eq.2) then    ! secondary missing
+                 ifld(j)=mtemp-2
+              endif
+              j=j+1
+           enddo
+           !   increment fld array counter
+           n=n+glen(ng)
+        enddo
+        !  
+        !  Find max of the group references and calc num of bits needed 
+        !  to pack each groups reference value, then
+        !  pack up group reference values
+        !
+        !write(77,*)'GREFS: ',(gref(j),j=1,ngroups)
+        igmax=maxval(gref(1:ngroups))
+        if (missopt.eq.1) igmax=igmax+1
+        if (missopt.eq.2) igmax=igmax+2
+        if (igmax.ne.0) then
+           temp=alog(real(igmax+1))/alog2
+           nbitsgref=ceiling(temp)
+           ! restet the ref values of any "missing only" groups.
+           mtemp=2**nbitsgref
+           do j=1,ngroups
+               if (gref(j).eq.-1) gref(j)=mtemp-1
+               if (gref(j).eq.-2) gref(j)=mtemp-2
+           enddo
+           call g2lib_sbytes(cpack,gref,iofst,nbitsgref,0,ngroups)
+           itemp=nbitsgref*ngroups
+           iofst=iofst+itemp
+           !         Pad last octet with Zeros, if necessary,
+           if (mod(itemp,8).ne.0) then
+              left=8-mod(itemp,8)
+              call g2lib_sbyte(cpack,zero,iofst,left)
+              iofst=iofst+left
+           endif
+        else
+           nbitsgref=0
+        endif
+        !
+        !  Find max/min of the group widths and calc num of bits needed
+        !  to pack each groups width value, then
+        !  pack up group width values
+        !
+        !write(77,*)'GWIDTHS: ',(gwidth(j),j=1,ngroups)
+        iwmax=maxval(gwidth(1:ngroups))
+        ngwidthref=minval(gwidth(1:ngroups))
+        if (iwmax.ne.ngwidthref) then
+           temp=alog(real(iwmax-ngwidthref+1))/alog2
+           nbitsgwidth=ceiling(temp)
+           do i=1,ngroups
+              gwidth(i)=gwidth(i)-ngwidthref
+           enddo
+           call g2lib_sbytes(cpack,gwidth,iofst,nbitsgwidth,0,ngroups)
+           itemp=nbitsgwidth*ngroups
+           iofst=iofst+itemp
+           !         Pad last octet with Zeros, if necessary,
+           if (mod(itemp,8).ne.0) then
+              left=8-mod(itemp,8)
+              call g2lib_sbyte(cpack,zero,iofst,left)
+              iofst=iofst+left
+           endif
+        else
+           nbitsgwidth=0
+           gwidth(1:ngroups)=0
+        endif
+        !
+        !  Find max/min of the group lengths and calc num of bits needed
+        !  to pack each groups length value, then
+        !  pack up group length values
+        !
+        !write(77,*)'GLENS: ',(glen(j),j=1,ngroups)
+        ilmax=maxval(glen(1:ngroups-1))
+        nglenref=minval(glen(1:ngroups-1))
+        nglenlast=glen(ngroups)
+        if (ilmax.ne.nglenref) then
+           temp=alog(real(ilmax-nglenref+1))/alog2
+           nbitsglen=ceiling(temp)
+           do i=1,ngroups-1
+              glen(i)=glen(i)-nglenref
+           enddo
+           call g2lib_sbytes(cpack,glen,iofst,nbitsglen,0,ngroups)
+           itemp=nbitsglen*ngroups
+           iofst=iofst+itemp
+           !         Pad last octet with Zeros, if necessary,
+           if (mod(itemp,8).ne.0) then
+              left=8-mod(itemp,8)
+              call g2lib_sbyte(cpack,zero,iofst,left)
+              iofst=iofst+left
+           endif
+        else
+           nbitsglen=0
+           glen(1:ngroups)=0
+        endif
+        !
+        !  For each group, pack data values
+        !
+        !write(77,*)'IFLDS: ',(ifld(j),j=1,ndpts)
+        n=1
+        ij=0
+        do ng=1,ngroups
+           glength=glen(ng)+nglenref
+           if (ng.eq.ngroups ) glength=nglenlast
+           grpwidth=gwidth(ng)+ngwidthref
+       !write(77,*)'NGP ',ng,grpwidth,glength,gref(ng)
+           if ( grpwidth.ne.0 ) then
+              call g2lib_sbytes(cpack,ifld(n),iofst,grpwidth,0,glength)
+              iofst=iofst+(grpwidth*glength)
+           endif
+           do kk=1,glength
+              ij=ij+1
+        !write(77,*)'SAG ',ij,fld(ij),ifld(ij),gref(ng),bscale,rmin,dscale
+           enddo
+           n=n+glength
+        enddo
+        !         Pad last octet with Zeros, if necessary,
+        if (mod(iofst,8).ne.0) then
+           left=8-mod(iofst,8)
+           call g2lib_sbyte(cpack,zero,iofst,left)
+           iofst=iofst+left
+        endif
+        lcpack=iofst/8
+        !
+        if ( allocated(ifld) ) deallocate(ifld)
+        if ( allocated(jfld) ) deallocate(jfld)
+        if ( allocated(ifldmiss) ) deallocate(ifldmiss)
+        if ( allocated(gref) ) deallocate(gref)
+        if ( allocated(gwidth) ) deallocate(gwidth)
+        if ( allocated(glen) ) deallocate(glen)
+      !else           !   Constant field ( max = min )
+      !  nbits=0
+      !  lcpack=0
+      !  nbitsgref=0
+      !  ngroups=0
+      !endif
+
+!
+!  Fill in ref value and number of bits in Template 5.2
+!
+      call mkieee(rmin,ref,1)   ! ensure reference value is IEEE format
+!      call g2lib_gbyte(ref,idrstmpl(1),0,32)
+      iref=transfer(ref,iref)
+      idrstmpl(1)=iref
+      idrstmpl(4)=nbitsgref
+      idrstmpl(5)=0         ! original data were reals
+      idrstmpl(6)=1         ! general group splitting
+      idrstmpl(10)=ngroups          ! Number of groups
+      idrstmpl(11)=ngwidthref       ! reference for group widths
+      idrstmpl(12)=nbitsgwidth      ! num bits used for group widths
+      idrstmpl(13)=nglenref         ! Reference for group lengths
+      idrstmpl(14)=1                ! length increment for group lengths
+      idrstmpl(15)=nglenlast        ! True length of last group
+      idrstmpl(16)=nbitsglen        ! num bits used for group lengths
+      if (idrsnum.eq.3) then
+         idrstmpl(18)=nbitsd/8      ! num bits used for extra spatial
+                                    ! differencing values
+      endif
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/mkieee.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/mkieee.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/mkieee.F	(revision 2744)
@@ -0,0 +1,103 @@
+      subroutine mkieee(a,rieee,num)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    mkieee 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-09
+!
+! ABSTRACT: This subroutine stores a list of real values in 
+!   32-bit IEEE floating point format.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-09  Gilbert
+!
+! USAGE:    CALL mkieee(a,rieee,num)
+!   INPUT ARGUMENT LIST:
+!     a        - Input array of floating point values.
+!     num      - Number of floating point values to convert.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     rieee    - Output array of floating point values in 32-bit IEEE format.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      real,intent(in) :: a(num)
+      real(4),intent(out) :: rieee(num)
+      integer,intent(in) :: num
+
+      integer(4) :: ieee 
+
+      real,save :: two23
+      real,save :: two126
+      integer,save :: once=0
+
+      if ( once .EQ. 0 ) then
+         once=1
+         two23=scale(1.0,23)
+         two126=scale(1.0,126)
+      endif
+
+      alog2=alog(2.0)
+
+      do j=1,num
+        ieee=0
+
+        if (a(j).eq.0.) then
+          ieee=0
+          rieee(j)=transfer(ieee,rieee(j))
+!       write(6,fmt='(f20.10,5x,b32)') a,a
+!       write(6,fmt='(f20.10,5x,b32)') rieee,rieee
+          cycle
+        endif
+        
+!
+!  Set Sign bit (bit 31 - leftmost bit)
+!
+        if (a(j).lt.0.0) then
+          ieee=ibset(ieee,31)
+          atemp=abs(a(j))
+        else
+          ieee=ibclr(ieee,31)
+          atemp=a(j)
+        endif
+!
+!  Determine exponent n with base 2
+!
+        n=floor(alog(atemp)/alog2)
+        iexp=n+127
+        if (n.gt.127) iexp=255     ! overflow
+        if (n.lt.-127) iexp=0
+        !      set exponent bits ( bits 30-23 )
+        call mvbits(iexp,0,8,ieee,23)
+!
+!  Determine Mantissa
+! 
+        if (iexp.ne.255) then
+          if (iexp.ne.0) then
+            atemp=(atemp/(2.0**n))-1.0
+          else
+            atemp=atemp*two126
+          endif
+          imant=nint(atemp*two23)
+        else
+          imant=0
+        endif
+        !      set mantissa bits ( bits 22-0 )
+        call mvbits(imant,0,23,ieee,0)
+!
+!  Transfer IEEE bit string to real variable
+!
+        rieee(j)=transfer(ieee,rieee(j))
+!       write(6,fmt='(f20.10,5x,b32)') a,a
+!       write(6,fmt='(f20.10,5x,b32)') rieee,rieee
+
+      enddo
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/mova2i.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/mova2i.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/mova2i.c	(revision 2744)
@@ -0,0 +1,42 @@
+/*$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C                .      .    .                                       .
+C SUBPROGRAM:    mova2i      Moves a bit string from a char*1 to int
+C   PRGMMR: Gilbert          ORG: W/NP11     DATE: 02-08-15
+C
+C ABSTRACT: This Function copies a bit string from a Character*1 variable
+C   to an integer variable.  It is intended to replace the Fortran Intrinsic
+C   Function ICHAR, which only supports 0 <= ICHAR(a) <= 127 on the
+C   IBM SP.  If "a" is greater than 127 in the collating sequence,
+C   ICHAR(a) does not return the expected bit value.
+C   This function can be used for all values 0 <= ICHAR(a) <= 255.
+C
+C PROGRAM HISTORY LOG:
+C   98-12-15  Gilbert
+C
+C USAGE:     I = mova2i(a)
+C
+C   INPUT ARGUMENT :
+C
+C          a - Character*1 variable that holds the bitstring to extract
+C
+C   RETURN ARGUMENT :
+C
+C          mova2i - Integer value of the bitstring in character a
+C
+C REMARKS:
+C
+C      None
+C
+C ATTRIBUTES:
+C   LANGUAGE: C
+C   MACHINE:  IBM SP
+
+C
+C$$$i*/
+
+#include "proto.h"
+
+int MOVA2I(unsigned char *a)
+{
+    return (int)(*a);
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pack_gp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pack_gp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pack_gp.F	(revision 2744)
@@ -0,0 +1,1195 @@
+      SUBROUTINE PACK_GP(KFILDO,IC,NXY,IS523,MINPK,INC,MISSP,MISSS,
+     1                   JMIN,JMAX,LBIT,NOV,NDG,LX,IBIT,JBIT,KBIT,
+     2                   NOVREF,LBITREF,IER)            
+C
+C        FEBRUARY 1994   GLAHN   TDL   MOS-2000
+C        JUNE     1995   GLAHN   MODIFIED FOR LMISS ERROR.
+C        JULY     1996   GLAHN   ADDED MISSS
+C        FEBRUARY 1997   GLAHN   REMOVED 4 REDUNDANT TESTS FOR
+C                                MISSP.EQ.0; INSERTED A TEST TO BETTER
+C                                HANDLE A STRING OF 9999'S
+C        FEBRUARY 1997   GLAHN   ADDED LOOPS TO ELIMINATE TEST FOR 
+C                                MISSS WHEN MISSS = 0
+C        MARCH    1997   GLAHN   CORRECTED FOR SECONDARY MISSING VALUE
+C        MARCH    1997   GLAHN   CORRECTED FOR USE OF LOCAL VALUE
+C                                OF MINPK
+C        MARCH    1997   GLAHN   CORRECTED FOR SECONDARY MISSING VALUE
+C        MARCH    1997   GLAHN   CHANGED CALCULATING NUMBER OF BITS 
+C                                THROUGH EXPONENTS TO AN ARRAY (IMPROVED
+C                                OVERALL PACKING PERFORMANCE BY ABOUT
+C                                35 PERCENT!).  ALLOWED 0 BITS FOR
+C                                PACKING JMIN( ), LBIT( ), AND NOV( ).
+C        MAY      1997   GLAHN   A NUMBER OF CHANGES FOR EFFICIENCY.
+C                                MOD FUNCTIONS ELIMINATED AND ONE
+C                                IFTHEN ADDED.  JOUNT REMOVED.
+C                                RECOMPUTATION OF BITS NOT MADE UNLESS
+C                                NECESSARY AFTER MOVING POINTS FROM
+C                                ONE GROUP TO ANOTHER.  NENDB ADJUSTED
+C                                TO ELIMINATE POSSIBILITY OF VERY
+C                                SMALL GROUP AT THE END. 
+C                                ABOUT 8 PERCENT IMPROVEMENT IN
+C                                OVERALL PACKING.  ISKIPA REMOVED;
+C                                THERE IS ALWAYS A GROUP B THAT CAN
+C                                BECOME GROUP A.  CONTROL ON SIZE 
+C                                OF GROUP B (STATEMENT BELOW 150)
+C                                ADDED.  ADDED ADDA, AND USE
+C                                OF GE AND LE INSTEAD OF GT AND LT
+C                                IN LOOPS BETWEEN 150 AND 160.
+C                                IBITBS ADDED TO SHORTEN TRIPS 
+C                                THROUGH LOOP.
+C        MARCH    2000   GLAHN   MODIFIED FOR GRIB2; CHANGED NAME FROM 
+C                                PACKGP
+C        JANUARY  2001   GLAHN   COMMENTS; IER = 706 SUBSTITUTED FOR
+C                                STOPS; ADDED RETURN1; REMOVED STATEMENT
+C                                NUMBER 110; ADDED IER AND * RETURN
+C        NOVEMBER 2001   GLAHN   CHANGED SOME DIAGNOSTIC FORMATS TO 
+C                                ALLOW PRINTING LARGER NUMBERS
+C        NOVEMBER 2001   GLAHN   ADDED MISSLX( ) TO PUT MAXIMUM VALUE
+C                                INTO JMIN( ) WHEN ALL VALUES MISSING
+C                                TO AGREE WITH GRIB STANDARD.
+C        NOVEMBER 2001   GLAHN   CHANGED TWO TESTS ON MISSP AND MISSS
+C                                EQ 0 TO TESTS ON IS523.  HOWEVER,
+C                                MISSP AND MISSS CANNOT IN GENERAL BE
+C                                = 0.
+C        NOVEMBER 2001   GLAHN   ADDED CALL TO REDUCE; DEFINED ITEST
+C                                BEFORE LOOPS TO REDUCE COMPUTATION;
+C                                STARTED LARGE GROUP WHEN ALL SAME
+C                                VALUE
+C        DECEMBER 2001   GLAHN   MODIFIED AND ADDED A FEW COMMENTS
+C        JANUARY  2002   GLAHN   REMOVED LOOP BEFORE 150 TO DETERMINE
+C                                A GROUP OF ALL SAME VALUE
+C        JANUARY  2002   GLAHN   CHANGED MALLOW FROM 9999999 TO 2**30+1,
+C                                AND MADE IT A PARAMETER
+C        MARCH    2002   GLAHN   ADDED NON FATAL IER = 716, 717;
+C                                REMOVED NENDB=NXY ABOVE 150;
+C                                ADDED IERSAV=0; COMMENTS
+C
+C        PURPOSE
+C            DETERMINES GROUPS OF VARIABLE SIZE, BUT AT LEAST OF
+C            SIZE MINPK, THE ASSOCIATED MAX (JMAX( )) AND MIN (JMIN( )),
+C            THE NUMBER OF BITS NECESSARY TO HOLD THE VALUES IN EACH
+C            GROUP (LBIT( )), THE NUMBER OF VALUES IN EACH GROUP
+C            (NOV( )), THE NUMBER OF BITS NECESSARY TO PACK THE JMIN( )
+C            VALUES (IBIT), THE NUMBER OF BITS NECESSARY TO PACK THE
+C            LBIT( ) VALUES (JBIT), AND THE NUMBER OF BITS NECESSARY
+C            TO PACK THE NOV( ) VALUES (KBIT).  THE ROUTINE IS DESIGNED
+C            TO DETERMINE THE GROUPS SUCH THAT A SMALL NUMBER OF BITS
+C            IS NECESSARY TO PACK THE DATA WITHOUT EXCESSIVE
+C            COMPUTATIONS.  IF ALL VALUES IN THE GROUP ARE ZERO, THE
+C            NUMBER OF BITS TO USE IN PACKING IS DEFINED AS ZERO WHEN
+C            THERE CAN BE NO MISSING VALUES; WHEN THERE CAN BE MISSING
+C            VALUES, THE NUMBER OF BITS MUST BE AT LEAST 1 TO HAVE
+C            THE CAPABILITY TO RECOGNIZE THE MISSING VALUE.  HOWEVER,
+C            IF ALL VALUES IN A GROUP ARE MISSING, THE NUMBER OF BITS
+C            NEEDED IS 0, AND THE UNPACKER RECOGNIZES THIS.
+C            ALL VARIABLES ARE INTEGER.  EVEN THOUGH THE GROUPS ARE 
+C            INITIALLY OF SIZE MINPK OR LARGER, AN ADJUSTMENT BETWEEN
+C            TWO GROUPS (THE LOOKBACK PROCEDURE) MAY MAKE A GROUP 
+C            SMALLER THAN MINPK.  THE CONTROL ON GROUP SIZE IS THAT
+C            THE SUM OF THE SIZES OF THE TWO CONSECUTIVE GROUPS, EACH OF
+C            SIZE MINPK OR LARGER, IS NOT DECREASED.  WHEN DETERMINING
+C            THE NUMBER OF BITS NECESSARY FOR PACKING, THE LARGEST
+C            VALUE THAT CAN BE ACCOMMODATED IN, SAY, MBITS, IS
+C            2**MBITS-1; THIS LARGEST VALUE (AND THE NEXT SMALLEST
+C            VALUE) IS RESERVED FOR THE MISSING VALUE INDICATOR (ONLY)
+C            WHEN IS523 NE 0.  IF THE DIMENSION NDG
+C            IS NOT LARGE ENOUGH TO HOLD ALL THE GROUPS, THE LOCAL VALUE
+C            OF MINPK IS INCREASED BY 50 PERCENT.  THIS IS REPEATED
+C            UNTIL NDG WILL SUFFICE.  A DIAGNOSTIC IS PRINTED WHENEVER
+C            THIS HAPPENS, WHICH SHOULD BE VERY RARELY.  IF IT HAPPENS
+C            OFTEN, NDG IN SUBROUTINE PACK SHOULD BE INCREASED AND
+C            A CORRESPONDING INCREASE IN SUBROUTINE UNPACK MADE. 
+C            CONSIDERABLE CODE IS PROVIDED SO THAT NO MORE CHECKING
+C            FOR MISSING VALUES WITHIN LOOPS IS DONE THAN NECESSARY;
+C            THE ADDED EFFICIENCY OF THIS IS RELATIVELY MINOR,
+C            BUT DOES NO HARM.  FOR GRIB2, THE REFERENCE VALUE FOR
+C            THE LENGTH OF GROUPS IN NOV( ) AND FOR THE NUMBER OF
+C            BITS NECESSARY TO PACK GROUP VALUES ARE DETERMINED,
+C            AND SUBTRACTED BEFORE JBIT AND KBIT ARE DETERMINED.
+C
+C            WHEN 1 OR MORE GROUPS ARE LARGE COMPARED TO THE OTHERS,
+C            THE WIDTH OF ALL GROUPS MUST BE AS LARGE AS THE LARGEST.
+C            A SUBROUTINE REDUCE BREAKS UP LARGE GROUPS INTO 2 OR
+C            MORE TO REDUCE TOTAL BITS REQUIRED.  IF REDUCE SHOULD
+C            ABORT, PACK_GP WILL BE EXECUTED AGAIN WITHOUT THE CALL
+C            TO REDUCE.
+C
+C        DATA SET USE 
+C           KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) 
+C
+C        VARIABLES IN CALL SEQUENCE 
+C              KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE.  (INPUT)
+C               IC( ) = ARRAY TO HOLD DATA FOR PACKING.  THE VALUES
+C                       DO NOT HAVE TO BE POSITIVE AT THIS POINT, BUT
+C                       MUST BE IN THE RANGE -2**30 TO +2**30 (THE 
+C                       THE VALUE OF MALLOW).  THESE INTEGER VALUES
+C                       WILL BE RETAINED EXACTLY THROUGH PACKING AND
+C                       UNPACKING.  (INPUT)
+C                 NXY = NUMBER OF VALUES IN IC( ).  ALSO TREATED
+C                       AS ITS DIMENSION.  (INPUT)
+C              IS523  = missing value management
+C                       0=data contains no missing values
+C                       1=data contains Primary missing values
+C                       2=data contains Primary and secondary missing values
+C                       (INPUT)
+C               MINPK = THE MINIMUM SIZE OF EACH GROUP, EXCEPT POSSIBLY
+C                       THE LAST ONE.  (INPUT)
+C                 INC = THE NUMBER OF VALUES TO ADD TO AN ALREADY
+C                       EXISTING GROUP IN DETERMINING WHETHER OR NOT
+C                       TO START A NEW GROUP.  IDEALLY, THIS WOULD BE
+C                       1, BUT EACH TIME INC VALUES ARE ATTEMPTED, THE
+C                       MAX AND MIN OF THE NEXT MINPK VALUES MUST BE
+C                       FOUND.  THIS IS "A LOOP WITHIN A LOOP," AND
+C                       A SLIGHTLY LARGER VALUE MAY GIVE ABOUT AS GOOD
+C                       RESULTS WITH SLIGHTLY LESS COMPUTATIONAL TIME.
+C                       IF INC IS LE 0, 1 IS USED, AND A DIAGNOSTIC IS
+C                       OUTPUT.  NOTE:  IT IS EXPECTED THAT INC WILL
+C                       EQUAL 1.  THE CODE USES INC PRIMARILY IN THE
+C                       LOOPS STARTING AT STATEMENT 180.  IF INC
+C                       WERE 1, THERE WOULD NOT NEED TO BE LOOPS
+C                       AS SUCH.  HOWEVER, KINC (THE LOCAL VALUE OF
+C                       INC) IS SET GE 1 WHEN NEAR THE END OF THE DATA
+C                       TO FORESTALL A VERY SMALL GROUP AT THE END. 
+C                       (INPUT)
+C               MISSP = WHEN MISSING POINTS CAN BE PRESENT IN THE DATA,
+C                       THEY WILL HAVE THE VALUE MISSP OR MISSS.
+C                       MISSP IS THE PRIMARY MISSING VALUE AND  MISSS
+C                       IS THE SECONDARY MISSING VALUE .  THESE MUST
+C                       NOT BE VALUES THAT WOULD OCCUR WITH SUBTRACTING
+C                       THE MINIMUM (REFERENCE) VALUE OR SCALING.
+C                       FOR EXAMPLE, MISSP = 0 WOULD NOT BE ADVISABLE.
+C                       (INPUT)
+C               MISSS = SECONDARY MISSING VALUE INDICATOR (SEE MISSP).
+C                       (INPUT)
+C             JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX).  (OUTPUT)
+C             JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX).  THIS IS
+C                       NOT REALLY NEEDED, BUT SINCE THE MAX OF EACH
+C                       GROUP MUST BE FOUND, SAVING IT HERE IS CHEAP
+C                       IN CASE THE USER WANTS IT.  (OUTPUT)
+C             LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP
+C                       (J=1,LX).  IT IS ASSUMED THE MINIMUM OF EACH
+C                       GROUP WILL BE REMOVED BEFORE PACKING, AND THE
+C                       VALUES TO PACK WILL, THEREFORE, ALL BE POSITIVE.
+C                       HOWEVER, IC( ) DOES NOT NECESSARILY CONTAIN
+C                       ALL POSITIVE VALUES.  IF THE OVERALL MINIMUM
+C                       HAS BEEN REMOVED (THE USUAL CASE), THEN IC( )
+C                       WILL CONTAIN ONLY POSITIVE VALUES.  (OUTPUT)
+C              NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX).
+C                       (OUTPUT)
+C                 NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND
+C                       NOV( ).  (INPUT)
+C                  LX = THE NUMBER OF GROUPS DETERMINED.  (OUTPUT)
+C                IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J)
+C                       VALUES, J=1,LX.  (OUTPUT)
+C                JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J)
+C                       VALUES, J=1,LX.  (OUTPUT)
+C                KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J)
+C                       VALUES, J=1,LX.  (OUTPUT)
+C              NOVREF = REFERENCE VALUE FOR NOV( ).  (OUTPUT)
+C             LBITREF = REFERENCE VALUE FOR LBIT( ).  (OUTPUT)
+C                 IER = ERROR RETURN.
+C                       706 = VALUE WILL NOT PACK IN 30 BITS--FATAL
+C                       714 = ERROR IN REDUCE--NON-FATAL
+C                       715 = NGP NOT LARGE ENOUGH IN REDUCE--NON-FATAL
+C                       716 = MINPK INCEASED--NON-FATAL
+C                       717 = INC SET = 1--NON-FATAL
+C                       (OUTPUT)
+C                   * = ALTERNATE RETURN WHEN IER NE 0 AND FATAL ERROR.
+C
+C        INTERNAL VARIABLES 
+C               CFEED = CONTAINS THE CHARACTER REPRESENTATION
+C                       OF A PRINTER FORM FEED.
+C               IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER
+C                       FORM FEED.
+C                KINC = WORKING COPY OF INC.  MAY BE MODIFIED.
+C                MINA = MINIMUM VALUE IN GROUP A.
+C                MAXA = MAXIMUM VALUE IN GROUP A.
+C               NENDA = THE PLACE IN IC( ) WHERE GROUP A ENDS.
+C              KSTART = THE PLACE IN IC( ) WHERE GROUP A STARTS.
+C               IBITA = NUMBER OF BITS NEEDED TO HOLD VALUES IN GROUP A.
+C                MINB = MINIMUM VALUE IN GROUP B.
+C                MAXB = MAXIMUM VALUE IN GROUP B.
+C               NENDB = THE PLACE IN IC( ) WHERE GROUP B ENDS.
+C               IBITB = NUMBER OF BITS NEEDED TO HOLD VALUES IN GROUP B.
+C                MINC = MINIMUM VALUE IN GROUP C.
+C                MAXC = MAXIMUM VALUE IN GROUP C.
+C              KTOTAL = COUNT OF NUMBER OF VALUES IN IC( ) PROCESSED.
+C               NOUNT = NUMBER OF VALUES ADDED TO GROUP A.
+C               LMISS = 0 WHEN IS523 = 0.  WHEN PACKING INTO A 
+C                       SPECIFIC NUMBER OF BITS, SAY MBITS,
+C                       THE MAXIMUM VALUE THAT CAN BE HANDLED IS
+C                       2**MBITS-1.  WHEN IS523 = 1, INDICATING
+C                       PRIMARY MISSING VALUES, THIS MAXIMUM VALUE 
+C                       IS RESERVED TO HOLD THE PRIMARY MISSING VALUE 
+C                       INDICATOR AND LMISS = 1.  WHEN IS523 = 2,
+C                       THE VALUE JUST BELOW THE MAXIMUM (I.E.,
+C                       2**MBITS-2) IS RESERVED TO HOLD THE SECONDARY 
+C                       MISSING VALUE INDICATOR AND LMISS = 2.
+C              LMINPK = LOCAL VALUE OF MINPK.  THIS WILL BE ADJUSTED
+C                       UPWARD WHENEVER NDG IS NOT LARGE ENOUGH TO HOLD
+C                       ALL THE GROUPS.
+C              MALLOW = THE LARGEST ALLOWABLE VALUE FOR PACKING.
+C              MISLLA = SET TO 1 WHEN ALL VALUES IN GROUP A ARE MISSING.
+C                       THIS IS USED TO DISTINGUISH BETWEEN A REAL
+C                       MINIMUM WHEN ALL VALUES ARE NOT MISSING
+C                       AND A MINIMUM THAT HAS BEEN SET TO ZERO WHEN
+C                       ALL VALUES ARE MISSING.  0 OTHERWISE.
+C                       NOTE THAT THIS DOES NOT DISTINGUISH BETWEEN
+C                       PRIMARY AND SECONDARY MISSINGS WHEN SECONDARY
+C                       MISSINGS ARE PRESENT.  THIS MEANS THAT 
+C                       LBIT( ) WILL NOT BE ZERO WITH THE RESULTING
+C                       COMPRESSION EFFICIENCY WHEN SECONDARY MISSINGS
+C                       ARE PRESENT.  ALSO NOTE THAT A CHECK HAS BEEN
+C                       MADE EARLIER TO DETERMINE THAT SECONDARY
+C                       MISSINGS ARE REALLY THERE.
+C              MISLLB = SET TO 1 WHEN ALL VALUES IN GROUP B ARE MISSING.
+C                       THIS IS USED TO DISTINGUISH BETWEEN A REAL
+C                       MINIMUM WHEN ALL VALUES ARE NOT MISSING
+C                       AND A MINIMUM THAT HAS BEEN SET TO ZERO WHEN
+C                       ALL VALUES ARE MISSING.  0 OTHERWISE.
+C              MISLLC = PERFORMS THE SAME FUNCTION FOR GROUP C THAT
+C                       MISLLA AND MISLLB DO FOR GROUPS B AND C,
+C                       RESPECTIVELY.
+C            IBXX2(J) = AN ARRAY THAT WHEN THIS ROUTINE IS FIRST ENTERED
+C                       IS SET TO 2**J, J=0,30. IBXX2(30) = 2**30, WHICH
+C                       IS THE LARGEST VALUE PACKABLE, BECAUSE 2**31
+C                       IS LARGER THAN THE INTEGER WORD SIZE.
+C              IFIRST = SET BY DATA STATEMENT TO 0.  CHANGED TO 1 ON
+C                       FIRST
+C                       ENTRY WHEN IBXX2( ) IS FILLED.
+C               MINAK = KEEPS TRACK OF THE LOCATION IN IC( ) WHERE THE 
+C                       MINIMUM VALUE IN GROUP A IS LOCATED.
+C               MAXAK = DOES THE SAME AS MINAK, EXCEPT FOR THE MAXIMUM.
+C               MINBK = THE SAME AS MINAK FOR GROUP B.
+C               MAXBK = THE SAME AS MAXAK FOR GROUP B.
+C               MINCK = THE SAME AS MINAK FOR GROUP C.
+C               MAXCK = THE SAME AS MAXAK FOR GROUP C.
+C                ADDA = KEEPS TRACK WHETHER OR NOT AN ATTEMPT TO ADD
+C                       POINTS TO GROUP A WAS MADE.  IF SO, THEN ADDA
+C                       KEEPS FROM TRYING TO PUT ONE BACK INTO B.
+C                       (LOGICAL)
+C              IBITBS = KEEPS CURRENT VALUE IF IBITB SO THAT LOOP
+C                       ENDING AT 166 DOESN'T HAVE TO START AT
+C                       IBITB = 0 EVERY TIME.
+C           MISSLX(J) = MALLOW EXCEPT WHEN A GROUP IS ALL ONE VALUE (AND
+C                       LBIT(J) = 0) AND THAT VALUE IS MISSING.  IN
+C                       THAT CASE, MISSLX(J) IS MISSP OR MISSS.  THIS
+C                       GETS INSERTED INTO JMIN(J) LATER AS THE 
+C                       MISSING INDICATOR; IT CAN'T BE PUT IN UNTIL
+C                       THE END, BECAUSE JMIN( ) IS USED TO CALCULATE
+C                       THE MAXIMUM NUMBER OF BITS (IBITS) NEEDED TO
+C                       PACK JMIN( ).
+C        1         2         3         4         5         6         7 X
+C
+C        NON SYSTEM SUBROUTINES CALLED 
+C           NONE
+C
+      PARAMETER (MALLOW=2**30+1)
+C
+      CHARACTER*1 CFEED
+      LOGICAL ADDA
+C
+      DIMENSION IC(NXY)
+      DIMENSION JMIN(NDG),JMAX(NDG),LBIT(NDG),NOV(NDG)
+      DIMENSION MISSLX(NDG)
+C        MISSLX( ) IS AN AUTOMATIC ARRAY.
+      DIMENSION IBXX2(0:30)
+C
+      SAVE IBXX2
+C
+      DATA IFEED/12/
+      DATA IFIRST/0/
+C
+      IER=0
+      IERSAV=0
+C     CALL TIMPR(KFILDO,KFILDO,'START PACK_GP        ')
+      CFEED=CHAR(IFEED)
+C
+      IRED=0
+C        IRED IS A FLAG.  WHEN ZERO, REDUCE WILL BE CALLED.
+C        IF REDUCE ABORTS, IRED = 1 AND IS NOT CALLED.  IN
+C        THIS CASE PACK_GP EXECUTES AGAIN EXCEPT FOR REDUCE.
+C
+      IF(INC.LE.0)THEN
+         IERSAV=717
+C        WRITE(KFILDO,101)INC
+C101     FORMAT(/' ****INC ='I8,' NOT CORRECT IN PACK_GP.  1 IS USED.')
+      ENDIF
+C
+C        THERE WILL BE A RESTART OF PACK_GP IF SUBROUTINE REDUCE
+C        ABORTS.  THIS SHOULD NOT HAPPEN, BUT IF IT DOES, PACK_GP
+C        WILL COMPLETE WITHOUT SUBROUTINE REDUCE.  A NON FATAL
+C        DIAGNOSTIC RETURN IS PROVIDED.
+C
+ 102  KINC=MAX(INC,1)
+      LMINPK=MINPK
+C
+C         CALCULATE THE POWERS OF 2 THE FIRST TIME ENTERED.
+C
+      IF(IFIRST.EQ.0)THEN
+         IFIRST=1
+         IBXX2(0)=1
+C
+         DO 104 J=1,30
+         IBXX2(J)=IBXX2(J-1)*2
+ 104     CONTINUE
+C
+      ENDIF
+C
+C        THERE WILL BE A RESTART AT 105 IS NDG IS NOT LARGE ENOUGH.
+C        A NON FATAL DIAGNOSTIC RETURN IS PROVIDED.
+C
+ 105  KSTART=1
+      KTOTAL=0
+      LX=0
+      ADDA=.FALSE.
+      LMISS=0
+      IF(IS523.EQ.1)LMISS=1
+      IF(IS523.EQ.2)LMISS=2
+C
+C        *************************************
+C
+C        THIS SECTION COMPUTES STATISTICS FOR GROUP A.  GROUP A IS
+C        A GROUP OF SIZE LMINPK.
+C
+C        *************************************
+C
+      IBITA=0
+      MINA=MALLOW
+      MAXA=-MALLOW
+      MINAK=MALLOW
+      MAXAK=-MALLOW
+C
+C        FIND THE MIN AND MAX OF GROUP A.  THIS WILL INITIALLY BE OF
+C        SIZE LMINPK (IF THERE ARE STILL LMINPK VALUES IN IC( )), BUT
+C        WILL INCREASE IN SIZE IN INCREMENTS OF INC UNTIL A NEW
+C        GROUP IS STARTED.  THE DEFINITION OF GROUP A IS DONE HERE
+C        ONLY ONCE (UPON INITIAL ENTRY), BECAUSE A GROUP B CAN ALWAYS
+C        BECOME A NEW GROUP A AFTER A IS PACKED, EXCEPT IF LMINPK 
+C        HAS TO BE INCREASED BECAUSE NDG IS TOO SMALL.  THEREFORE,
+C        THE SEPARATE LOOPS FOR MISSING AND NON-MISSING HERE BUYS
+C        ALMOST NOTHING.
+C
+      NENDA=MIN(KSTART+LMINPK-1,NXY)
+      IF(NXY-NENDA.LE.LMINPK/2)NENDA=NXY
+C        ABOVE STATEMENT GUARANTEES THE LAST GROUP IS GT LMINPK/2 BY 
+C        MAKING THE ACTUAL GROUP LARGER.  IF A PROVISION LIKE THIS IS 
+C        NOT INCLUDED, THERE WILL MANY TIMES BE A VERY SMALL GROUP
+C        AT THE END.  USE SEPARATE LOOPS FOR MISSING AND NO MISSING
+C        VALUES FOR EFFICIENCY.
+C
+C        DETERMINE WHETHER THERE IS A LONG STRING OF THE SAME VALUE
+C        UNLESS NENDA = NXY.  THIS MAY ALLOW A LARGE GROUP A TO
+C        START WITH, AS WITH MISSING VALUES.   SEPARATE LOOPS FOR
+C        MISSING OPTIONS.  THIS SECTION IS ONLY EXECUTED ONCE,
+C        IN DETERMINING THE FIRST GROUP.  IT HELPS FOR AN ARRAY
+C        OF MOSTLY MISSING VALUES OR OF ONE VALUE, SUCH AS
+C        RADAR OR PRECIP DATA.
+C
+      IF(NENDA.NE.NXY.AND.IC(KSTART).EQ.IC(KSTART+1))THEN
+C           NO NEED TO EXECUTE IF FIRST TWO VALUES ARE NOT EQUAL.
+C
+         IF(IS523.EQ.0)THEN
+C              THIS LOOP IS FOR NO MISSING VALUES.
+C
+            DO 111 K=KSTART+1,NXY
+C
+               IF(IC(K).NE.IC(KSTART))THEN
+                  NENDA=MAX(NENDA,K-1)
+                  GO TO 114
+               ENDIF
+C
+ 111        CONTINUE
+C
+            NENDA=NXY
+C              FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME.
+C
+         ELSEIF(IS523.EQ.1)THEN
+C              THIS LOOP IS FOR PRIMARY MISSING VALUES ONLY.
+C
+            DO 112 K=KSTART+1,NXY
+C        
+               IF(IC(K).NE.MISSP)THEN
+C
+                  IF(IC(K).NE.IC(KSTART))THEN
+                     NENDA=MAX(NENDA,K-1)
+                     GO TO 114
+                  ENDIF
+C
+               ENDIF
+C
+ 112        CONTINUE
+C
+            NENDA=NXY
+C              FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME.
+C
+         ELSE
+C              THIS LOOP IS FOR PRIMARY AND SECONDARY MISSING VALUES.
+C
+            DO 113 K=KSTART+1,NXY
+C        
+               IF(IC(K).NE.MISSP.AND.IC(K).NE.MISSS)THEN
+C
+                  IF(IC(K).NE.IC(KSTART))THEN
+                     NENDA=MAX(NENDA,K-1)
+                     GO TO 114
+                  ENDIF
+C
+               ENDIF
+C
+ 113        CONTINUE
+C
+            NENDA=NXY
+C              FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME.
+         ENDIF
+C
+      ENDIF
+C
+ 114  IF(IS523.EQ.0)THEN
+C
+         DO 115 K=KSTART,NENDA
+         IF(IC(K).LT.MINA)THEN
+            MINA=IC(K)
+            MINAK=K
+         ENDIF
+         IF(IC(K).GT.MAXA)THEN
+            MAXA=IC(K)
+            MAXAK=K
+         ENDIF
+ 115     CONTINUE
+C
+      ELSEIF(IS523.EQ.1)THEN
+C
+         DO 117 K=KSTART,NENDA
+         IF(IC(K).EQ.MISSP)GO TO 117
+         IF(IC(K).LT.MINA)THEN
+            MINA=IC(K)
+            MINAK=K
+         ENDIF
+         IF(IC(K).GT.MAXA)THEN
+            MAXA=IC(K)
+            MAXAK=K
+         ENDIF
+ 117     CONTINUE
+C
+      ELSE
+C
+         DO 120 K=KSTART,NENDA
+         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 120
+         IF(IC(K).LT.MINA)THEN
+            MINA=IC(K)
+            MINAK=K
+         ENDIF
+         IF(IC(K).GT.MAXA)THEN
+            MAXA=IC(K)
+            MAXAK=K
+         ENDIF
+ 120     CONTINUE
+C
+      ENDIF
+C
+      KOUNTA=NENDA-KSTART+1
+C
+C        INCREMENT KTOTAL AND FIND THE BITS NEEDED TO PACK THE A GROUP.
+C
+      KTOTAL=KTOTAL+KOUNTA
+      MISLLA=0
+      IF(MINA.NE.MALLOW)GO TO 125
+C        ALL MISSING VALUES MUST BE ACCOMMODATED.
+      MINA=0
+      MAXA=0
+      MISLLA=1
+      IBITB=0
+      IF(IS523.NE.2)GO TO 130
+C        WHEN ALL VALUES ARE MISSING AND THERE ARE NO
+C        SECONDARY MISSING VALUES, IBITA = 0.
+C        OTHERWISE, IBITA MUST BE CALCULATED.
+C
+ 125  ITEST=MAXA-MINA+LMISS
+C  
+      DO 126 IBITA=0,30
+      IF(ITEST.LT.IBXX2(IBITA))GO TO 130
+C***        THIS TEST IS THE SAME AS:
+C***     IF(MAXA-MINA.LT.IBXX2(IBITA)-LMISS)GO TO 130
+ 126  CONTINUE
+C
+C     WRITE(KFILDO,127)MAXA,MINA
+C127  FORMAT(' ****ERROR IN PACK_GP.  VALUE WILL NOT PACK IN 30 BITS.',
+C    1       '  MAXA ='I13,'  MINA ='I13,'.  ERROR AT 127.')
+      IER=706
+      GO TO 900
+C
+ 130  CONTINUE
+C
+C***D     WRITE(KFILDO,131)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA
+C***D131  FORMAT(' AT 130, KOUNTA ='I8,'  KTOTAL ='I8,'  MINA ='I8,
+C***D    1       '  MAXA ='I8,'  IBITA ='I3,'  MISLLA ='I3) 
+C
+ 133  IF(KTOTAL.GE.NXY)GO TO 200
+C
+C        *************************************
+C
+C        THIS SECTION COMPUTES STATISTICS FOR GROUP B.  GROUP B IS A
+C        GROUP OF SIZE LMINPK IMMEDIATELY FOLLOWING GROUP A.
+C
+C        *************************************
+C
+ 140  MINB=MALLOW
+      MAXB=-MALLOW
+      MINBK=MALLOW
+      MAXBK=-MALLOW
+      IBITBS=0
+      MSTART=KTOTAL+1
+C
+C        DETERMINE WHETHER THERE IS A LONG STRING OF THE SAME VALUE.
+C        THIS WORKS WHEN THERE ARE NO MISSING VALUES.
+C
+      NENDB=1
+C
+      IF(MSTART.LT.NXY)THEN
+C
+         IF(IS523.EQ.0)THEN
+C              THIS LOOP IS FOR NO MISSING VALUES.
+C
+            DO 145 K=MSTART+1,NXY
+C
+               IF(IC(K).NE.IC(MSTART))THEN
+                  NENDB=K-1
+                  GO TO 150
+               ENDIF
+C
+ 145        CONTINUE
+C
+            NENDB=NXY
+C              FALL THROUGH THE LOOP MEANS ALL REMAINING VALUES
+C              ARE THE SAME.
+         ENDIF
+C
+      ENDIF
+C         
+ 150  NENDB=MAX(NENDB,MIN(KTOTAL+LMINPK,NXY))
+C**** 150  NENDB=MIN(KTOTAL+LMINPK,NXY)
+C
+      IF(NXY-NENDB.LE.LMINPK/2)NENDB=NXY
+C        ABOVE STATEMENT GUARANTEES THE LAST GROUP IS GT LMINPK/2 BY 
+C        MAKING THE ACTUAL GROUP LARGER.  IF A PROVISION LIKE THIS IS 
+C        NOT INCLUDED, THERE WILL MANY TIMES BE A VERY SMALL GROUP
+C        AT THE END.  USE SEPARATE LOOPS FOR MISSING AND NO MISSING
+C
+C        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES
+C        FOR EFFICIENCY.
+C
+      IF(IS523.EQ.0)THEN
+C              
+         DO 155 K=MSTART,NENDB
+         IF(IC(K).LE.MINB)THEN
+            MINB=IC(K)
+C              NOTE LE, NOT LT.  LT COULD BE USED BUT THEN A 
+C              RECOMPUTE OVER THE WHOLE GROUP WOULD BE NEEDED
+C              MORE OFTEN.  SAME REASONING FOR GE AND OTHER
+C              LOOPS BELOW.
+            MINBK=K
+         ENDIF
+         IF(IC(K).GE.MAXB)THEN
+            MAXB=IC(K)
+            MAXBK=K
+         ENDIF
+ 155     CONTINUE
+C
+      ELSEIF(IS523.EQ.1)THEN
+C
+         DO 157 K=MSTART,NENDB
+         IF(IC(K).EQ.MISSP)GO TO 157
+         IF(IC(K).LE.MINB)THEN
+            MINB=IC(K)
+            MINBK=K
+         ENDIF
+         IF(IC(K).GE.MAXB)THEN
+            MAXB=IC(K)
+            MAXBK=K
+         ENDIF
+ 157     CONTINUE
+C
+      ELSE
+C
+         DO 160 K=MSTART,NENDB
+         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 160
+         IF(IC(K).LE.MINB)THEN
+            MINB=IC(K)
+            MINBK=K
+         ENDIF
+         IF(IC(K).GE.MAXB)THEN
+            MAXB=IC(K)
+            MAXBK=K
+         ENDIF
+ 160     CONTINUE
+C
+      ENDIF
+C
+      KOUNTB=NENDB-KTOTAL
+      MISLLB=0
+      IF(MINB.NE.MALLOW)GO TO 165
+C        ALL MISSING VALUES MUST BE ACCOMMODATED.
+      MINB=0
+      MAXB=0
+      MISLLB=1
+      IBITB=0
+C
+      IF(IS523.NE.2)GO TO 170
+C        WHEN ALL VALUES ARE MISSING AND THERE ARE NO SECONDARY
+C        MISSING VALUES, IBITB = 0.  OTHERWISE, IBITB MUST BE
+C        CALCULATED.
+C
+ 165  DO 166 IBITB=IBITBS,30
+         IF(MAXB-MINB.LT.IBXX2(IBITB)-LMISS)GO TO 170
+ 166  CONTINUE
+C
+C     WRITE(KFILDO,167)MAXB,MINB
+C167  FORMAT(' ****ERROR IN PACK_GP.  VALUE WILL NOT PACK IN 30 BITS.',
+C    1       '  MAXB ='I13,'  MINB ='I13,'.  ERROR AT 167.')
+      IER=706
+      GO TO 900
+C
+C        COMPARE THE BITS NEEDED TO PACK GROUP B WITH THOSE NEEDED
+C        TO PACK GROUP A.  IF IBITB GE IBITA, TRY TO ADD TO GROUP A.
+C        IF NOT, TRY TO ADD A'S POINTS TO B, UNLESS ADDITION TO A
+C        HAS BEEN DONE.  THIS LATTER IS CONTROLLED WITH ADDA.
+C
+ 170  CONTINUE
+C
+C***D     WRITE(KFILDO,171)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA,
+C***D    1                               MINB,MAXB,IBITB,MISLLB
+C***D171  FORMAT(' AT 171, KOUNTA ='I8,'  KTOTAL ='I8,'  MINA ='I8,
+C***D    1       '  MAXA ='I8,'  IBITA ='I3,'  MISLLA ='I3,
+C***D    2       '  MINB ='I8,'  MAXB ='I8,'  IBITB ='I3,'  MISLLB ='I3)  
+C
+      IF(IBITB.GE.IBITA)GO TO 180
+      IF(ADDA)GO TO 200
+C
+C        *************************************
+C
+C        GROUP B REQUIRES LESS BITS THAN GROUP A.  PUT AS MANY OF A'S
+C        POINTS INTO B AS POSSIBLE WITHOUT EXCEEDING THE NUMBER OF
+C        BITS NECESSARY TO PACK GROUP B.
+C
+C        *************************************
+C
+      KOUNTS=KOUNTA
+C        KOUNTA REFERS TO THE PRESENT GROUP A.
+      MINTST=MINB
+      MAXTST=MAXB
+      MINTSTK=MINBK
+      MAXTSTK=MAXBK
+C
+C        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES
+C        FOR EFFICIENCY.
+C
+      IF(IS523.EQ.0)THEN
+C 
+         DO 1715 K=KTOTAL,KSTART,-1
+C           START WITH THE END OF THE GROUP AND WORK BACKWARDS.
+         IF(IC(K).LT.MINB)THEN
+            MINTST=IC(K)
+            MINTSTK=K
+         ELSEIF(IC(K).GT.MAXB)THEN
+            MAXTST=IC(K)
+            MAXTSTK=K
+         ENDIF
+         IF(MAXTST-MINTST.GE.IBXX2(IBITB))GO TO 174
+C           NOTE THAT FOR THIS LOOP, LMISS = 0.
+         MINB=MINTST
+         MAXB=MAXTST
+         MINBK=MINTSTK
+         MAXBK=MAXTSTK
+         KOUNTA=KOUNTA-1
+C           THERE IS ONE LESS POINT NOW IN A.
+ 1715    CONTINUE  
+C
+      ELSEIF(IS523.EQ.1)THEN            
+C
+         DO 1719 K=KTOTAL,KSTART,-1
+C           START WITH THE END OF THE GROUP AND WORK BACKWARDS.
+         IF(IC(K).EQ.MISSP)GO TO 1718
+         IF(IC(K).LT.MINB)THEN
+            MINTST=IC(K)
+            MINTSTK=K
+         ELSEIF(IC(K).GT.MAXB)THEN
+            MAXTST=IC(K)
+            MAXTSTK=K
+         ENDIF
+         IF(MAXTST-MINTST.GE.IBXX2(IBITB)-LMISS)GO TO 174
+C           FOR THIS LOOP, LMISS = 1.
+         MINB=MINTST
+         MAXB=MAXTST
+         MINBK=MINTSTK
+         MAXBK=MAXTSTK
+         MISLLB=0
+C           WHEN THE POINT IS NON MISSING, MISLLB SET = 0.
+ 1718    KOUNTA=KOUNTA-1
+C           THERE IS ONE LESS POINT NOW IN A.
+ 1719    CONTINUE  
+C
+      ELSE             
+C
+         DO 173 K=KTOTAL,KSTART,-1
+C           START WITH THE END OF THE GROUP AND WORK BACKWARDS.
+         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 1729
+         IF(IC(K).LT.MINB)THEN
+            MINTST=IC(K)
+            MINTSTK=K
+         ELSEIF(IC(K).GT.MAXB)THEN
+            MAXTST=IC(K)
+            MAXTSTK=K
+         ENDIF
+         IF(MAXTST-MINTST.GE.IBXX2(IBITB)-LMISS)GO TO 174
+C           FOR THIS LOOP, LMISS = 2.
+         MINB=MINTST
+         MAXB=MAXTST
+         MINBK=MINTSTK
+         MAXBK=MAXTSTK
+         MISLLB=0
+C           WHEN THE POINT IS NON MISSING, MISLLB SET = 0.
+ 1729    KOUNTA=KOUNTA-1
+C           THERE IS ONE LESS POINT NOW IN A.
+ 173     CONTINUE  
+C
+      ENDIF
+C
+C        AT THIS POINT, KOUNTA CONTAINS THE NUMBER OF POINTS TO CLOSE
+C        OUT GROUP A WITH.  GROUP B NOW STARTS WITH KSTART+KOUNTA AND
+C        ENDS WITH NENDB.  MINB AND MAXB HAVE BEEN ADJUSTED AS
+C        NECESSARY TO REFLECT GROUP B (EVEN THOUGH THE NUMBER OF BITS
+C        NEEDED TO PACK GROUP B HAVE NOT INCREASED, THE END POINTS
+C        OF THE RANGE MAY HAVE).
+C
+ 174  IF(KOUNTA.EQ.KOUNTS)GO TO 200
+C        ON TRANSFER, GROUP A WAS NOT CHANGED.  CLOSE IT OUT.
+C
+C        ONE OR MORE POINTS WERE TAKEN OUT OF A.  RANGE AND IBITA
+C        MAY HAVE TO BE RECOMPUTED; IBITA COULD BE LESS THAN
+C        ORIGINALLY COMPUTED.  IN FACT, GROUP A CAN NOW CONTAIN
+C        ONLY ONE POINT AND BE PACKED WITH ZERO BITS
+C        (UNLESS MISSS NE 0).
+C
+      NOUTA=KOUNTS-KOUNTA
+      KTOTAL=KTOTAL-NOUTA
+      KOUNTB=KOUNTB+NOUTA
+      IF(NENDA-NOUTA.GT.MINAK.AND.NENDA-NOUTA.GT.MAXAK)GO TO 200
+C        WHEN THE ABOVE TEST IS MET, THE MIN AND MAX OF THE 
+C        CURRENT GROUP A WERE WITHIN THE OLD GROUP A, SO THE
+C        RANGE AND IBITA DO NOT NEED TO BE RECOMPUTED.
+C        NOTE THAT MINAK AND MAXAK ARE NO LONGER NEEDED.
+      IBITA=0
+      MINA=MALLOW
+      MAXA=-MALLOW
+C
+C        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES
+C        FOR EFFICIENCY.
+C
+      IF(IS523.EQ.0)THEN
+C 
+         DO 1742 K=KSTART,NENDA-NOUTA
+         IF(IC(K).LT.MINA)THEN
+            MINA=IC(K)
+         ENDIF
+         IF(IC(K).GT.MAXA)THEN
+            MAXA=IC(K)
+         ENDIF
+ 1742    CONTINUE
+C
+      ELSEIF(IS523.EQ.1)THEN 
+C
+         DO 1744 K=KSTART,NENDA-NOUTA
+         IF(IC(K).EQ.MISSP)GO TO 1744
+         IF(IC(K).LT.MINA)THEN
+            MINA=IC(K)
+         ENDIF
+         IF(IC(K).GT.MAXA)THEN
+            MAXA=IC(K)
+         ENDIF
+ 1744    CONTINUE
+C
+      ELSE 
+C
+         DO 175 K=KSTART,NENDA-NOUTA
+         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 175
+         IF(IC(K).LT.MINA)THEN
+            MINA=IC(K)
+         ENDIF
+         IF(IC(K).GT.MAXA)THEN
+            MAXA=IC(K)
+         ENDIF
+ 175     CONTINUE
+C
+      ENDIF
+C
+      MISLLA=0
+      IF(MINA.NE.MALLOW)GO TO 1750
+C        ALL MISSING VALUES MUST BE ACCOMMODATED.
+      MINA=0
+      MAXA=0
+      MISLLA=1
+      IF(IS523.NE.2)GO TO 177
+C        WHEN ALL VALUES ARE MISSING AND THERE ARE NO SECONDARY
+C        MISSING VALUES IBITA = 0 AS ORIGINALLY SET.  OTHERWISE,
+C        IBITA MUST BE CALCULATED.
+C
+ 1750 ITEST=MAXA-MINA+LMISS
+C
+      DO 176 IBITA=0,30
+      IF(ITEST.LT.IBXX2(IBITA))GO TO 177
+C***        THIS TEST IS THE SAME AS:
+C***         IF(MAXA-MINA.LT.IBXX2(IBITA)-LMISS)GO TO 177
+ 176  CONTINUE
+C
+C     WRITE(KFILDO,1760)MAXA,MINA
+C1760 FORMAT(' ****ERROR IN PACK_GP.  VALUE WILL NOT PACK IN 30 BITS.',
+C    1       '  MAXA ='I13,'  MINA ='I13,'.  ERROR AT 1760.')
+      IER=706
+      GO TO 900
+C
+ 177  CONTINUE
+      GO TO 200
+C
+C        *************************************
+C
+C        AT THIS POINT, GROUP B REQUIRES AS MANY BITS TO PACK AS GROUPA.
+C        THEREFORE, TRY TO ADD INC POINTS TO GROUP A WITHOUT INCREASING
+C        IBITA.  THIS AUGMENTED GROUP IS CALLED GROUP C.
+C
+C        *************************************
+C
+ 180  IF(MISLLA.EQ.1)THEN
+         MINC=MALLOW
+         MINCK=MALLOW
+         MAXC=-MALLOW
+         MAXCK=-MALLOW
+      ELSE
+         MINC=MINA
+         MAXC=MAXA
+         MINCK=MINAK
+         MAXCK=MINAK
+      ENDIF
+C
+      NOUNT=0
+      IF(NXY-(KTOTAL+KINC).LE.LMINPK/2)KINC=NXY-KTOTAL
+C        ABOVE STATEMENT CONSTRAINS THE LAST GROUP TO BE NOT LESS THAN
+C        LMINPK/2 IN SIZE.  IF A PROVISION LIKE THIS IS NOT INCLUDED,
+C        THERE WILL MANY TIMES BE A VERY SMALL GROUP AT THE END.
+C
+C        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES
+C        FOR EFFICIENCY.  SINCE KINC IS USUALLY 1, USING SEPARATE
+C        LOOPS HERE DOESN'T BUY MUCH.  A MISSING VALUE WILL ALWAYS
+C        TRANSFER BACK TO GROUP A.
+C
+      IF(IS523.EQ.0)THEN
+C
+         DO 185 K=KTOTAL+1,MIN(KTOTAL+KINC,NXY)
+         IF(IC(K).LT.MINC)THEN
+            MINC=IC(K)
+            MINCK=K
+         ENDIF
+         IF(IC(K).GT.MAXC)THEN
+            MAXC=IC(K)
+            MAXCK=K
+         ENDIF
+         NOUNT=NOUNT+1
+ 185     CONTINUE
+C
+      ELSEIF(IS523.EQ.1)THEN
+C
+         DO 187 K=KTOTAL+1,MIN(KTOTAL+KINC,NXY)
+         IF(IC(K).EQ.MISSP)GO TO 186
+         IF(IC(K).LT.MINC)THEN
+            MINC=IC(K)
+            MINCK=K
+         ENDIF
+         IF(IC(K).GT.MAXC)THEN
+            MAXC=IC(K)
+            MAXCK=K
+         ENDIF
+ 186     NOUNT=NOUNT+1
+ 187     CONTINUE
+C
+      ELSE
+C
+         DO 190 K=KTOTAL+1,MIN(KTOTAL+KINC,NXY)
+         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 189
+         IF(IC(K).LT.MINC)THEN
+            MINC=IC(K)
+            MINCK=K
+         ENDIF
+         IF(IC(K).GT.MAXC)THEN
+            MAXC=IC(K)
+            MAXCK=K
+         ENDIF
+ 189     NOUNT=NOUNT+1
+ 190     CONTINUE
+C
+      ENDIF
+C
+C***D     WRITE(KFILDO,191)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA,
+C***D    1   MINC,MAXC,NOUNT,IC(KTOTAL),IC(KTOTAL+1)
+C***D191  FORMAT(' AT 191, KOUNTA ='I8,'  KTOTAL ='I8,'  MINA ='I8,
+C***D    1       '  MAXA ='I8,'  IBITA ='I3,'  MISLLA ='I3,
+C***D    2       '  MINC ='I8,'  MAXC ='I8,
+C***D    3       '  NOUNT ='I5,'  IC(KTOTAL) ='I9,'  IC(KTOTAL+1) =',I9) 
+C
+C        IF THE NUMBER OF BITS NEEDED FOR GROUP C IS GT IBITA,
+C        THEN THIS GROUP A IS A GROUP TO PACK.
+C
+      IF(MINC.EQ.MALLOW)THEN
+         MINC=MINA
+         MAXC=MAXA
+         MINCK=MINAK
+         MAXCK=MAXAK
+         MISLLC=1
+         GO TO 195
+C           WHEN THE NEW VALUE(S) ARE MISSING, THEY CAN ALWAYS
+C           BE ADDED.
+C
+      ELSE
+         MISLLC=0
+      ENDIF
+C
+      IF(MAXC-MINC.GE.IBXX2(IBITA)-LMISS) GO TO 200
+C
+C        THE BITS NECESSARY FOR GROUP C HAS NOT INCREASED FROM THE
+C        BITS NECESSARY FOR GROUP A.  ADD THIS POINT(S) TO GROUP A.
+C        COMPUTE THE NEXT GROUP B, ETC., UNLESS ALL POINTS HAVE BEEN
+C        USED.
+C 
+ 195  KTOTAL=KTOTAL+NOUNT
+      KOUNTA=KOUNTA+NOUNT
+      MINA=MINC
+      MAXA=MAXC
+      MINAK=MINCK
+      MAXAK=MAXCK
+      MISLLA=MISLLC
+      ADDA=.TRUE.
+      IF(KTOTAL.GE.NXY)GO TO 200
+C
+      IF(MINBK.GT.KTOTAL.AND.MAXBK.GT.KTOTAL)THEN
+         MSTART=NENDB+1
+C           THE MAX AND MIN OF GROUP B WERE NOT FROM THE POINTS
+C           REMOVED, SO THE WHOLE GROUP DOES NOT HAVE TO BE LOOKED
+C           AT TO DETERMINE THE NEW MAX AND MIN.  RATHER START
+C           JUST BEYOND THE OLD NENDB.
+         IBITBS=IBITB
+         NENDB=1
+         GO TO 150
+      ELSE
+         GO TO 140
+      ENDIF
+C
+C        *************************************
+C
+C        GROUP A IS TO BE PACKED.  STORE VALUES IN JMIN( ), JMAX( ),
+C        LBIT( ), AND NOV( ).
+C
+C        *************************************
+C
+ 200  LX=LX+1
+      IF(LX.LE.NDG)GO TO 205
+      LMINPK=LMINPK+LMINPK/2
+C     WRITE(KFILDO,201)NDG,LMINPK,LX
+C201  FORMAT(' ****NDG ='I5,' NOT LARGE ENOUGH.',
+C    1       '  LMINPK IS INCREASED TO 'I3,' FOR THIS FIELD.'/
+C    2       '  LX = 'I10)
+      IERSAV=716
+      GO TO 105
+C
+ 205  JMIN(LX)=MINA
+      JMAX(LX)=MAXA
+      LBIT(LX)=IBITA
+      NOV(LX)=KOUNTA
+      KSTART=KTOTAL+1
+C
+      IF(MISLLA.EQ.0)THEN
+         MISSLX(LX)=MALLOW
+      ELSE
+         MISSLX(LX)=IC(KTOTAL)
+C           IC(KTOTAL) WAS THE LAST VALUE PROCESSED.  IF MISLLA NE 0,
+C           THIS MUST BE THE MISSING VALUE FOR THIS GROUP.
+      ENDIF
+C
+C***D     WRITE(KFILDO,206)MISLLA,IC(KTOTAL),KTOTAL,LX,JMIN(LX),JMAX(LX),
+C***D    1                 LBIT(LX),NOV(LX),MISSLX(LX)
+C***D206  FORMAT(' AT 206,  MISLLA ='I2,'  IC(KTOTAL) ='I5,'  KTOTAL ='I8,
+C***D    1       '  LX ='I6,'  JMIN(LX) ='I8,'  JMAX(LX) ='I8,
+C***D    2       '  LBIT(LX) ='I5,'  NOV(LX) ='I8,'  MISSLX(LX) =',I7) 
+C
+      IF(KTOTAL.GE.NXY)GO TO 209
+C
+C        THE NEW GROUP A WILL BE THE PREVIOUS GROUP B.  SET LIMITS, ETC.
+C
+      IBITA=IBITB
+      MINA=MINB
+      MAXA=MAXB
+      MINAK=MINBK
+      MAXAK=MAXBK
+      MISLLA=MISLLB
+      NENDA=NENDB
+      KOUNTA=KOUNTB
+      KTOTAL=KTOTAL+KOUNTA
+      ADDA=.FALSE.
+      GO TO 133
+C
+C        *************************************
+C
+C        CALCULATE IBIT, THE NUMBER OF BITS NEEDED TO HOLD THE GROUP
+C        MINIMUM VALUES.
+C
+C        *************************************
+C
+ 209  IBIT=0
+C
+      DO 220 L=1,LX
+ 210  IF(JMIN(L).LT.IBXX2(IBIT))GO TO 220
+      IBIT=IBIT+1
+      GO TO 210
+ 220  CONTINUE
+C
+C        INSERT THE VALUE IN JMIN( ) TO BE USED FOR ALL MISSING
+C        VALUES WHEN LBIT( ) = 0.  WHEN SECONDARY MISSING 
+C        VALUES CAN BE PRESENT, LBIT(L) WILL NOT = 0.
+C
+      IF(IS523.EQ.1)THEN
+C
+         DO 226 L=1,LX
+C   
+         IF(LBIT(L).EQ.0)THEN
+C
+            IF(MISSLX(L).EQ.MISSP)THEN
+               JMIN(L)=IBXX2(IBIT)-1
+            ENDIF
+C
+         ENDIF
+C
+ 226     CONTINUE
+C
+      ENDIF
+C
+C        *************************************
+C
+C        CALCULATE JBIT, THE NUMBER OF BITS NEEDED TO HOLD THE BITS
+C        NEEDED TO PACK THE VALUES IN THE GROUPS.  BUT FIND AND
+C        REMOVE THE REFERENCE VALUE FIRST.
+C
+C        *************************************
+C
+C     WRITE(KFILDO,228)CFEED,LX
+C228  FORMAT(A1,/' *****************************************'
+C    1          /' THE GROUP WIDTHS LBIT( ) FOR ',I8,' GROUPS'
+C    2          /' *****************************************')
+C     WRITE(KFILDO,229) (LBIT(J),J=1,MIN(LX,100))
+C229  FORMAT(/' '20I6)
+C
+      LBITREF=LBIT(1)
+C
+      DO 230 K=1,LX
+      IF(LBIT(K).LT.LBITREF)LBITREF=LBIT(K)
+ 230  CONTINUE
+C
+      IF(LBITREF.NE.0)THEN
+C
+         DO 240 K=1,LX
+         LBIT(K)=LBIT(K)-LBITREF
+ 240     CONTINUE
+C
+      ENDIF
+C
+C     WRITE(KFILDO,241)CFEED,LBITREF
+C241  FORMAT(A1,/' *****************************************'
+C    1          /' THE GROUP WIDTHS LBIT( ) AFTER REMOVING REFERENCE ',
+C    2             I8,
+C    3          /' *****************************************')
+C     WRITE(KFILDO,242) (LBIT(J),J=1,MIN(LX,100))
+C242  FORMAT(/' '20I6)
+C
+      JBIT=0
+C
+      DO 320 K=1,LX
+ 310  IF(LBIT(K).LT.IBXX2(JBIT))GO TO 320
+      JBIT=JBIT+1
+      GO TO 310
+ 320  CONTINUE
+C
+C        *************************************
+C
+C        CALCULATE KBIT, THE NUMBER OF BITS NEEDED TO HOLD THE NUMBER
+C        OF VALUES IN THE GROUPS.  BUT FIND AND REMOVE THE
+C        REFERENCE FIRST.
+C
+C        *************************************
+C
+C     WRITE(KFILDO,321)CFEED,LX
+C321  FORMAT(A1,/' *****************************************'
+C    1          /' THE GROUP SIZES NOV( ) FOR ',I8,' GROUPS'
+C    2          /' *****************************************')
+C     WRITE(KFILDO,322) (NOV(J),J=1,MIN(LX,100))
+C322  FORMAT(/' '20I6)
+C
+      NOVREF=NOV(1)
+C
+      DO 400 K=1,LX
+      IF(NOV(K).LT.NOVREF)NOVREF=NOV(K)
+ 400  CONTINUE
+C
+      IF(NOVREF.GT.0)THEN
+C
+         DO 405 K=1,LX
+         NOV(K)=NOV(K)-NOVREF
+ 405     CONTINUE
+C
+      ENDIF
+C
+C     WRITE(KFILDO,406)CFEED,NOVREF
+C406  FORMAT(A1,/' *****************************************'
+C    1          /' THE GROUP SIZES NOV( ) AFTER REMOVING REFERENCE ',I8,
+C    2          /' *****************************************')
+C     WRITE(KFILDO,407) (NOV(J),J=1,MIN(LX,100))
+C407  FORMAT(/' '20I6)
+C     WRITE(KFILDO,408)CFEED
+C408  FORMAT(A1,/' *****************************************'
+C    1          /' THE GROUP REFERENCES JMIN( )'
+C    2          /' *****************************************')
+C     WRITE(KFILDO,409) (JMIN(J),J=1,MIN(LX,100))
+C409  FORMAT(/' '20I6)
+C
+      KBIT=0
+C
+      DO 420 K=1,LX
+ 410  IF(NOV(K).LT.IBXX2(KBIT))GO TO 420
+      KBIT=KBIT+1
+      GO TO 410
+ 420  CONTINUE
+C
+C        DETERMINE WHETHER THE GROUP SIZES SHOULD BE REDUCED
+C        FOR SPACE EFFICIENCY.
+C
+      IF(IRED.EQ.0)THEN
+         CALL REDUCE(KFILDO,JMIN,JMAX,LBIT,NOV,LX,NDG,IBIT,JBIT,KBIT,
+     1               NOVREF,IBXX2,IER)
+C
+         IF(IER.EQ.714.OR.IER.EQ.715)THEN
+C              REDUCE HAS ABORTED.  REEXECUTE PACK_GP WITHOUT REDUCE.
+C              PROVIDE FOR A NON FATAL RETURN FROM REDUCE.  
+            IERSAV=IER
+            IRED=1
+            IER=0
+            GO TO 102 
+         ENDIF
+C
+      ENDIF         
+C
+C     CALL TIMPR(KFILDO,KFILDO,'END   PACK_GP        ')
+      IF(IERSAV.NE.0)THEN
+         IER=IERSAV
+         RETURN
+      ENDIF
+C
+C 900  IF(IER.NE.0)RETURN1
+C
+ 900  RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/params.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/params.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/params.F	(revision 2744)
@@ -0,0 +1,1281 @@
+      module params
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! MODULE:    params
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-05
+!
+! ABSTRACT: This Fortran Module contains info on all the available 
+!           GRIB Parameters.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-11  Gilbert
+! 2003-08-07  Gilbert  -  Added more parameters
+! 2003-09-26  Gilbert  -  Added more parameters
+!
+! USAGE:    use params
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,parameter :: MAXPARAM=212
+
+      type gribparam
+          integer :: g1tblver
+          integer :: grib1val
+          integer :: grib2dsc
+          integer :: grib2cat
+          integer :: grib2num
+          character(len=8) :: abbrev
+      end type gribparam
+
+      type(gribparam),dimension(MAXPARAM) :: paramlist
+
+      data paramlist(1)%g1tblver /2/ 
+      data paramlist(1)%grib1val /1/ 
+      data paramlist(1)%grib2dsc /0/ 
+      data paramlist(1)%grib2cat /3/ 
+      data paramlist(1)%grib2num /0/ 
+      data paramlist(1)%abbrev   /'PRES    '/ 
+      data paramlist(2)%g1tblver /2/ 
+      data paramlist(2)%grib1val /2/ 
+      data paramlist(2)%grib2dsc /0/ 
+      data paramlist(2)%grib2cat /3/ 
+      data paramlist(2)%grib2num /1/ 
+      data paramlist(2)%abbrev   /'PRMSL   '/ 
+      data paramlist(3)%g1tblver /2/ 
+      data paramlist(3)%grib1val /3/ 
+      data paramlist(3)%grib2dsc /0/ 
+      data paramlist(3)%grib2cat /3/ 
+      data paramlist(3)%grib2num /2/ 
+      data paramlist(3)%abbrev   /'PTEND   '/ 
+      data paramlist(4)%g1tblver /2/ 
+      data paramlist(4)%grib1val /4/ 
+      data paramlist(4)%grib2dsc /0/ 
+      data paramlist(4)%grib2cat /2/ 
+      data paramlist(4)%grib2num /14/ 
+      data paramlist(4)%abbrev   /'PVORT   '/ 
+      data paramlist(5)%g1tblver /2/ 
+      data paramlist(5)%grib1val /5/ 
+      data paramlist(5)%grib2dsc /0/ 
+      data paramlist(5)%grib2cat /3/ 
+      data paramlist(5)%grib2num /3/ 
+      data paramlist(5)%abbrev   /'ICAHT   '/ 
+      data paramlist(6)%g1tblver /2/ 
+      data paramlist(6)%grib1val /6/ 
+      data paramlist(6)%grib2dsc /0/ 
+      data paramlist(6)%grib2cat /3/ 
+      data paramlist(6)%grib2num /4/ 
+      data paramlist(6)%abbrev   /'GP      '/ 
+      data paramlist(7)%g1tblver /2/ 
+      data paramlist(7)%grib1val /7/ 
+      data paramlist(7)%grib2dsc /0/ 
+      data paramlist(7)%grib2cat /3/ 
+      data paramlist(7)%grib2num /5/ 
+      data paramlist(7)%abbrev   /'HGT     '/ 
+      data paramlist(8)%g1tblver /2/ 
+      data paramlist(8)%grib1val /8/ 
+      data paramlist(8)%grib2dsc /0/ 
+      data paramlist(8)%grib2cat /3/ 
+      data paramlist(8)%grib2num /6/ 
+      data paramlist(8)%abbrev   /'DIST    '/ 
+      data paramlist(9)%g1tblver /2/ 
+      data paramlist(9)%grib1val /9/ 
+      data paramlist(9)%grib2dsc /0/ 
+      data paramlist(9)%grib2cat /3/ 
+      data paramlist(9)%grib2num /7/ 
+      data paramlist(9)%abbrev   /'HSTDV   '/ 
+      data paramlist(10)%g1tblver /2/ 
+      data paramlist(10)%grib1val /10/ 
+      data paramlist(10)%grib2dsc /0/ 
+      data paramlist(10)%grib2cat /14/ 
+      data paramlist(10)%grib2num /0/ 
+      data paramlist(10)%abbrev   /'TOZNE   '/ 
+      data paramlist(11)%g1tblver /2/ 
+      data paramlist(11)%grib1val /11/ 
+      data paramlist(11)%grib2dsc /0/ 
+      data paramlist(11)%grib2cat /0/ 
+      data paramlist(11)%grib2num /0/ 
+      data paramlist(11)%abbrev   /'TMP     '/ 
+      data paramlist(12)%g1tblver /2/ 
+      data paramlist(12)%grib1val /12/ 
+      data paramlist(12)%grib2dsc /0/ 
+      data paramlist(12)%grib2cat /0/ 
+      data paramlist(12)%grib2num /1/ 
+      data paramlist(12)%abbrev   /'VTMP    '/ 
+      data paramlist(13)%g1tblver /2/ 
+      data paramlist(13)%grib1val /13/ 
+      data paramlist(13)%grib2dsc /0/ 
+      data paramlist(13)%grib2cat /0/ 
+      data paramlist(13)%grib2num /2/ 
+      data paramlist(13)%abbrev   /'POT     '/ 
+      data paramlist(14)%g1tblver /2/ 
+      data paramlist(14)%grib1val /14/ 
+      data paramlist(14)%grib2dsc /0/ 
+      data paramlist(14)%grib2cat /0/ 
+      data paramlist(14)%grib2num /3/ 
+      data paramlist(14)%abbrev   /'EPOT    '/ 
+      data paramlist(15)%g1tblver /2/ 
+      data paramlist(15)%grib1val /15/ 
+      data paramlist(15)%grib2dsc /0/ 
+      data paramlist(15)%grib2cat /0/ 
+      data paramlist(15)%grib2num /4/ 
+      data paramlist(15)%abbrev   /'T MAX   '/ 
+      data paramlist(16)%g1tblver /2/ 
+      data paramlist(16)%grib1val /16/ 
+      data paramlist(16)%grib2dsc /0/ 
+      data paramlist(16)%grib2cat /0/ 
+      data paramlist(16)%grib2num /5/ 
+      data paramlist(16)%abbrev   /'T MIN   '/ 
+      data paramlist(17)%g1tblver /2/ 
+      data paramlist(17)%grib1val /17/ 
+      data paramlist(17)%grib2dsc /0/ 
+      data paramlist(17)%grib2cat /0/ 
+      data paramlist(17)%grib2num /6/ 
+      data paramlist(17)%abbrev   /'DPT     '/ 
+      data paramlist(18)%g1tblver /2/ 
+      data paramlist(18)%grib1val /18/ 
+      data paramlist(18)%grib2dsc /0/ 
+      data paramlist(18)%grib2cat /0/ 
+      data paramlist(18)%grib2num /7/ 
+      data paramlist(18)%abbrev   /'DEPR    '/ 
+      data paramlist(19)%g1tblver /2/ 
+      data paramlist(19)%grib1val /19/ 
+      data paramlist(19)%grib2dsc /0/ 
+      data paramlist(19)%grib2cat /0/ 
+      data paramlist(19)%grib2num /8/ 
+      data paramlist(19)%abbrev   /'LAPR    '/ 
+      data paramlist(20)%g1tblver /2/ 
+      data paramlist(20)%grib1val /20/ 
+      data paramlist(20)%grib2dsc /0/ 
+      data paramlist(20)%grib2cat /19/ 
+      data paramlist(20)%grib2num /0/ 
+      data paramlist(20)%abbrev   /'VIS     '/ 
+      data paramlist(21)%g1tblver /2/ 
+      data paramlist(21)%grib1val /21/ 
+      data paramlist(21)%grib2dsc /0/ 
+      data paramlist(21)%grib2cat /15/ 
+      data paramlist(21)%grib2num /6/ 
+      data paramlist(21)%abbrev   /'RDSP1   '/ 
+      data paramlist(22)%g1tblver /2/ 
+      data paramlist(22)%grib1val /22/ 
+      data paramlist(22)%grib2dsc /0/ 
+      data paramlist(22)%grib2cat /15/ 
+      data paramlist(22)%grib2num /7/ 
+      data paramlist(22)%abbrev   /'RDSP2   '/ 
+      data paramlist(23)%g1tblver /2/ 
+      data paramlist(23)%grib1val /23/ 
+      data paramlist(23)%grib2dsc /0/ 
+      data paramlist(23)%grib2cat /15/ 
+      data paramlist(23)%grib2num /8/ 
+      data paramlist(23)%abbrev   /'RDSP3   '/ 
+      data paramlist(24)%g1tblver /2/ 
+      data paramlist(24)%grib1val /24/ 
+      data paramlist(24)%grib2dsc /0/ 
+      data paramlist(24)%grib2cat /7/ 
+      data paramlist(24)%grib2num /0/ 
+      data paramlist(24)%abbrev   /'PLI     '/ 
+      data paramlist(25)%g1tblver /2/ 
+      data paramlist(25)%grib1val /25/ 
+      data paramlist(25)%grib2dsc /0/ 
+      data paramlist(25)%grib2cat /0/ 
+      data paramlist(25)%grib2num /9/ 
+      data paramlist(25)%abbrev   /'TMP A   '/ 
+      data paramlist(26)%g1tblver /2/ 
+      data paramlist(26)%grib1val /26/ 
+      data paramlist(26)%grib2dsc /0/ 
+      data paramlist(26)%grib2cat /3/ 
+      data paramlist(26)%grib2num /8/ 
+      data paramlist(26)%abbrev   /'PRESA   '/ 
+      data paramlist(27)%g1tblver /2/ 
+      data paramlist(27)%grib1val /27/ 
+      data paramlist(27)%grib2dsc /0/ 
+      data paramlist(27)%grib2cat /3/ 
+      data paramlist(27)%grib2num /9/ 
+      data paramlist(27)%abbrev   /'GP A    '/ 
+      data paramlist(28)%g1tblver /2/ 
+      data paramlist(28)%grib1val /28/ 
+      data paramlist(28)%grib2dsc /10/ 
+      data paramlist(28)%grib2cat /0/ 
+      data paramlist(28)%grib2num /0/ 
+      data paramlist(28)%abbrev   /'WVSP1   '/ 
+      data paramlist(29)%g1tblver /2/ 
+      data paramlist(29)%grib1val /29/ 
+      data paramlist(29)%grib2dsc /10/ 
+      data paramlist(29)%grib2cat /0/ 
+      data paramlist(29)%grib2num /1/ 
+      data paramlist(29)%abbrev   /'WVSP2   '/ 
+      data paramlist(30)%g1tblver /2/ 
+      data paramlist(30)%grib1val /30/ 
+      data paramlist(30)%grib2dsc /10/ 
+      data paramlist(30)%grib2cat /0/ 
+      data paramlist(30)%grib2num /2/ 
+      data paramlist(30)%abbrev   /'WVSP3   '/ 
+      data paramlist(31)%g1tblver /2/ 
+      data paramlist(31)%grib1val /31/ 
+      data paramlist(31)%grib2dsc /0/ 
+      data paramlist(31)%grib2cat /2/ 
+      data paramlist(31)%grib2num /0/ 
+      data paramlist(31)%abbrev   /'WDIR    '/ 
+      data paramlist(32)%g1tblver /2/ 
+      data paramlist(32)%grib1val /32/ 
+      data paramlist(32)%grib2dsc /0/ 
+      data paramlist(32)%grib2cat /2/ 
+      data paramlist(32)%grib2num /1/ 
+      data paramlist(32)%abbrev   /'WIND    '/ 
+      data paramlist(33)%g1tblver /2/ 
+      data paramlist(33)%grib1val /33/ 
+      data paramlist(33)%grib2dsc /0/ 
+      data paramlist(33)%grib2cat /2/ 
+      data paramlist(33)%grib2num /2/ 
+      data paramlist(33)%abbrev   /'U GRD   '/ 
+      data paramlist(34)%g1tblver /2/ 
+      data paramlist(34)%grib1val /34/ 
+      data paramlist(34)%grib2dsc /0/ 
+      data paramlist(34)%grib2cat /2/ 
+      data paramlist(34)%grib2num /3/ 
+      data paramlist(34)%abbrev   /'V GRD   '/ 
+      data paramlist(35)%g1tblver /2/ 
+      data paramlist(35)%grib1val /35/ 
+      data paramlist(35)%grib2dsc /0/ 
+      data paramlist(35)%grib2cat /2/ 
+      data paramlist(35)%grib2num /4/ 
+      data paramlist(35)%abbrev   /'STRM    '/ 
+      data paramlist(36)%g1tblver /2/ 
+      data paramlist(36)%grib1val /36/ 
+      data paramlist(36)%grib2dsc /0/ 
+      data paramlist(36)%grib2cat /2/ 
+      data paramlist(36)%grib2num /5/ 
+      data paramlist(36)%abbrev   /'V POT   '/ 
+      data paramlist(37)%g1tblver /2/ 
+      data paramlist(37)%grib1val /37/ 
+      data paramlist(37)%grib2dsc /0/ 
+      data paramlist(37)%grib2cat /2/ 
+      data paramlist(37)%grib2num /6/ 
+      data paramlist(37)%abbrev   /'MNTSF   '/ 
+      data paramlist(38)%g1tblver /2/ 
+      data paramlist(38)%grib1val /38/ 
+      data paramlist(38)%grib2dsc /0/ 
+      data paramlist(38)%grib2cat /2/ 
+      data paramlist(38)%grib2num /7/ 
+      data paramlist(38)%abbrev   /'SGCVV   '/ 
+      data paramlist(39)%g1tblver /2/ 
+      data paramlist(39)%grib1val /39/ 
+      data paramlist(39)%grib2dsc /0/ 
+      data paramlist(39)%grib2cat /2/ 
+      data paramlist(39)%grib2num /8/ 
+      data paramlist(39)%abbrev   /'V VEL   '/ 
+      data paramlist(40)%g1tblver /2/ 
+      data paramlist(40)%grib1val /40/ 
+      data paramlist(40)%grib2dsc /0/ 
+      data paramlist(40)%grib2cat /2/ 
+      data paramlist(40)%grib2num /9/ 
+      data paramlist(40)%abbrev   /'DZDT    '/ 
+      data paramlist(41)%g1tblver /2/ 
+      data paramlist(41)%grib1val /41/ 
+      data paramlist(41)%grib2dsc /0/ 
+      data paramlist(41)%grib2cat /2/ 
+      data paramlist(41)%grib2num /10/ 
+      data paramlist(41)%abbrev   /'ABS V   '/ 
+      data paramlist(42)%g1tblver /2/ 
+      data paramlist(42)%grib1val /42/ 
+      data paramlist(42)%grib2dsc /0/ 
+      data paramlist(42)%grib2cat /2/ 
+      data paramlist(42)%grib2num /11/ 
+      data paramlist(42)%abbrev   /'ABS D   '/ 
+      data paramlist(43)%g1tblver /2/ 
+      data paramlist(43)%grib1val /43/ 
+      data paramlist(43)%grib2dsc /0/ 
+      data paramlist(43)%grib2cat /2/ 
+      data paramlist(43)%grib2num /12/ 
+      data paramlist(43)%abbrev   /'REL V   '/ 
+      data paramlist(44)%g1tblver /2/ 
+      data paramlist(44)%grib1val /44/ 
+      data paramlist(44)%grib2dsc /0/ 
+      data paramlist(44)%grib2cat /2/ 
+      data paramlist(44)%grib2num /13/ 
+      data paramlist(44)%abbrev   /'REL D   '/ 
+      data paramlist(45)%g1tblver /2/ 
+      data paramlist(45)%grib1val /45/ 
+      data paramlist(45)%grib2dsc /0/ 
+      data paramlist(45)%grib2cat /2/ 
+      data paramlist(45)%grib2num /15/ 
+      data paramlist(45)%abbrev   /'VUCSH   '/ 
+      data paramlist(46)%g1tblver /2/ 
+      data paramlist(46)%grib1val /46/ 
+      data paramlist(46)%grib2dsc /0/ 
+      data paramlist(46)%grib2cat /2/ 
+      data paramlist(46)%grib2num /16/ 
+      data paramlist(46)%abbrev   /'VVCSH   '/ 
+      data paramlist(47)%g1tblver /2/ 
+      data paramlist(47)%grib1val /47/ 
+      data paramlist(47)%grib2dsc /10/ 
+      data paramlist(47)%grib2cat /1/ 
+      data paramlist(47)%grib2num /0/ 
+      data paramlist(47)%abbrev   /'DIR C   '/ 
+      data paramlist(48)%g1tblver /2/ 
+      data paramlist(48)%grib1val /48/ 
+      data paramlist(48)%grib2dsc /10/ 
+      data paramlist(48)%grib2cat /1/ 
+      data paramlist(48)%grib2num /1/ 
+      data paramlist(48)%abbrev   /'SP C    '/ 
+      data paramlist(49)%g1tblver /2/ 
+      data paramlist(49)%grib1val /49/ 
+      data paramlist(49)%grib2dsc /10/ 
+      data paramlist(49)%grib2cat /1/ 
+      data paramlist(49)%grib2num /2/ 
+      data paramlist(49)%abbrev   /'UOGRD   '/ 
+      data paramlist(50)%g1tblver /2/ 
+      data paramlist(50)%grib1val /50/ 
+      data paramlist(50)%grib2dsc /10/ 
+      data paramlist(50)%grib2cat /1/ 
+      data paramlist(50)%grib2num /3/ 
+      data paramlist(50)%abbrev   /'VOGRD   '/ 
+      data paramlist(51)%g1tblver /2/ 
+      data paramlist(51)%grib1val /51/ 
+      data paramlist(51)%grib2dsc /0/ 
+      data paramlist(51)%grib2cat /1/ 
+      data paramlist(51)%grib2num /0/ 
+      data paramlist(51)%abbrev   /'SPF H   '/ 
+      data paramlist(52)%g1tblver /2/ 
+      data paramlist(52)%grib1val /52/ 
+      data paramlist(52)%grib2dsc /0/ 
+      data paramlist(52)%grib2cat /1/ 
+      data paramlist(52)%grib2num /1/ 
+      data paramlist(52)%abbrev   /'R H     '/ 
+      data paramlist(53)%g1tblver /2/ 
+      data paramlist(53)%grib1val /53/ 
+      data paramlist(53)%grib2dsc /0/ 
+      data paramlist(53)%grib2cat /1/ 
+      data paramlist(53)%grib2num /2/ 
+      data paramlist(53)%abbrev   /'MIXR    '/ 
+      data paramlist(54)%g1tblver /2/ 
+      data paramlist(54)%grib1val /54/ 
+      data paramlist(54)%grib2dsc /0/ 
+      data paramlist(54)%grib2cat /1/ 
+      data paramlist(54)%grib2num /3/ 
+      data paramlist(54)%abbrev   /'P WAT   '/ 
+      data paramlist(55)%g1tblver /2/ 
+      data paramlist(55)%grib1val /55/ 
+      data paramlist(55)%grib2dsc /0/ 
+      data paramlist(55)%grib2cat /1/ 
+      data paramlist(55)%grib2num /4/ 
+      data paramlist(55)%abbrev   /'VAPP    '/ 
+      data paramlist(56)%g1tblver /2/ 
+      data paramlist(56)%grib1val /56/ 
+      data paramlist(56)%grib2dsc /0/ 
+      data paramlist(56)%grib2cat /1/ 
+      data paramlist(56)%grib2num /5/ 
+      data paramlist(56)%abbrev   /'SAT D   '/ 
+      data paramlist(57)%g1tblver /2/ 
+      data paramlist(57)%grib1val /57/ 
+      data paramlist(57)%grib2dsc /0/ 
+      data paramlist(57)%grib2cat /1/ 
+      data paramlist(57)%grib2num /6/ 
+      data paramlist(57)%abbrev   /'EVP     '/ 
+      data paramlist(58)%g1tblver /2/ 
+      data paramlist(58)%grib1val /58/ 
+      data paramlist(58)%grib2dsc /0/ 
+      data paramlist(58)%grib2cat /6/ 
+      data paramlist(58)%grib2num /0/ 
+      data paramlist(58)%abbrev   /'C ICE   '/ 
+      data paramlist(59)%g1tblver /2/ 
+      data paramlist(59)%grib1val /59/ 
+      data paramlist(59)%grib2dsc /0/ 
+      data paramlist(59)%grib2cat /1/ 
+      data paramlist(59)%grib2num /7/ 
+      data paramlist(59)%abbrev   /'PRATE   '/ 
+      data paramlist(60)%g1tblver /2/ 
+      data paramlist(60)%grib1val /60/ 
+      data paramlist(60)%grib2dsc /0/ 
+      data paramlist(60)%grib2cat /19/ 
+      data paramlist(60)%grib2num /2/ 
+      data paramlist(60)%abbrev   /'TSTM    '/ 
+      data paramlist(61)%g1tblver /2/ 
+      data paramlist(61)%grib1val /61/ 
+      data paramlist(61)%grib2dsc /0/ 
+      data paramlist(61)%grib2cat /1/ 
+      data paramlist(61)%grib2num /8/ 
+      data paramlist(61)%abbrev   /'A PCP   '/ 
+      data paramlist(62)%g1tblver /2/ 
+      data paramlist(62)%grib1val /62/ 
+      data paramlist(62)%grib2dsc /0/ 
+      data paramlist(62)%grib2cat /1/ 
+      data paramlist(62)%grib2num /9/ 
+      data paramlist(62)%abbrev   /'NCPCP   '/ 
+      data paramlist(63)%g1tblver /2/ 
+      data paramlist(63)%grib1val /63/ 
+      data paramlist(63)%grib2dsc /0/ 
+      data paramlist(63)%grib2cat /1/ 
+      data paramlist(63)%grib2num /10/ 
+      data paramlist(63)%abbrev   /'ACPCP   '/ 
+      data paramlist(64)%g1tblver /2/ 
+      data paramlist(64)%grib1val /64/ 
+      data paramlist(64)%grib2dsc /0/ 
+      data paramlist(64)%grib2cat /1/ 
+      data paramlist(64)%grib2num /12/ 
+      data paramlist(64)%abbrev   /'SRWEQ   '/ 
+      data paramlist(65)%g1tblver /2/ 
+      data paramlist(65)%grib1val /65/ 
+      data paramlist(65)%grib2dsc /0/ 
+      data paramlist(65)%grib2cat /1/ 
+      data paramlist(65)%grib2num /13/ 
+      data paramlist(65)%abbrev   /'WEASD   '/ 
+      data paramlist(66)%g1tblver /2/ 
+      data paramlist(66)%grib1val /66/ 
+      data paramlist(66)%grib2dsc /0/ 
+      data paramlist(66)%grib2cat /1/ 
+      data paramlist(66)%grib2num /11/ 
+      data paramlist(66)%abbrev   /'SNO D   '/ 
+      data paramlist(67)%g1tblver /2/ 
+      data paramlist(67)%grib1val /67/ 
+      data paramlist(67)%grib2dsc /0/ 
+      data paramlist(67)%grib2cat /19/ 
+      data paramlist(67)%grib2num /3/ 
+      data paramlist(67)%abbrev   /'MIXHT   '/ 
+      data paramlist(68)%g1tblver /2/ 
+      data paramlist(68)%grib1val /68/ 
+      data paramlist(68)%grib2dsc /10/ 
+      data paramlist(68)%grib2cat /5/ 
+      data paramlist(68)%grib2num /2/ 
+      data paramlist(68)%abbrev   /'TTHDP   '/ 
+      data paramlist(69)%g1tblver /2/ 
+      data paramlist(69)%grib1val /69/ 
+      data paramlist(69)%grib2dsc /10/ 
+      data paramlist(69)%grib2cat /5/ 
+      data paramlist(69)%grib2num /0/ 
+      data paramlist(69)%abbrev   /'MTHD    '/ 
+      data paramlist(70)%g1tblver /2/ 
+      data paramlist(70)%grib1val /70/ 
+      data paramlist(70)%grib2dsc /10/ 
+      data paramlist(70)%grib2cat /5/ 
+      data paramlist(70)%grib2num /1/ 
+      data paramlist(70)%abbrev   /'MTH A   '/ 
+      data paramlist(71)%g1tblver /2/ 
+      data paramlist(71)%grib1val /71/ 
+      data paramlist(71)%grib2dsc /0/ 
+      data paramlist(71)%grib2cat /6/ 
+      data paramlist(71)%grib2num /1/ 
+      data paramlist(71)%abbrev   /'T CDC   '/ 
+      data paramlist(72)%g1tblver /2/ 
+      data paramlist(72)%grib1val /72/ 
+      data paramlist(72)%grib2dsc /0/ 
+      data paramlist(72)%grib2cat /6/ 
+      data paramlist(72)%grib2num /2/ 
+      data paramlist(72)%abbrev   /'CDCON   '/ 
+      data paramlist(73)%g1tblver /2/ 
+      data paramlist(73)%grib1val /73/ 
+      data paramlist(73)%grib2dsc /0/ 
+      data paramlist(73)%grib2cat /6/ 
+      data paramlist(73)%grib2num /3/ 
+      data paramlist(73)%abbrev   /'L CDC   '/ 
+      data paramlist(74)%g1tblver /2/ 
+      data paramlist(74)%grib1val /74/ 
+      data paramlist(74)%grib2dsc /0/ 
+      data paramlist(74)%grib2cat /6/ 
+      data paramlist(74)%grib2num /4/ 
+      data paramlist(74)%abbrev   /'M CDC   '/ 
+      data paramlist(75)%g1tblver /2/ 
+      data paramlist(75)%grib1val /75/ 
+      data paramlist(75)%grib2dsc /0/ 
+      data paramlist(75)%grib2cat /6/ 
+      data paramlist(75)%grib2num /5/ 
+      data paramlist(75)%abbrev   /'H CDC   '/ 
+      data paramlist(76)%g1tblver /2/ 
+      data paramlist(76)%grib1val /76/ 
+      data paramlist(76)%grib2dsc /0/ 
+      data paramlist(76)%grib2cat /6/ 
+      data paramlist(76)%grib2num /6/ 
+      data paramlist(76)%abbrev   /'C WAT   '/ 
+      data paramlist(77)%g1tblver /2/ 
+      data paramlist(77)%grib1val /77/ 
+      data paramlist(77)%grib2dsc /0/ 
+      data paramlist(77)%grib2cat /7/ 
+      data paramlist(77)%grib2num /1/ 
+      data paramlist(77)%abbrev   /'BLI     '/ 
+      data paramlist(78)%g1tblver /2/ 
+      data paramlist(78)%grib1val /78/ 
+      data paramlist(78)%grib2dsc /0/ 
+      data paramlist(78)%grib2cat /1/ 
+      data paramlist(78)%grib2num /14/ 
+      data paramlist(78)%abbrev   /'SNO C   '/ 
+      data paramlist(79)%g1tblver /2/ 
+      data paramlist(79)%grib1val /79/ 
+      data paramlist(79)%grib2dsc /0/ 
+      data paramlist(79)%grib2cat /1/ 
+      data paramlist(79)%grib2num /15/ 
+      data paramlist(79)%abbrev   /'SNO L   '/ 
+      data paramlist(80)%g1tblver /2/ 
+      data paramlist(80)%grib1val /80/ 
+      data paramlist(80)%grib2dsc /10/ 
+      data paramlist(80)%grib2cat /4/ 
+      data paramlist(80)%grib2num /0/ 
+      data paramlist(80)%abbrev   /'WTMP    '/ 
+      data paramlist(81)%g1tblver /2/ 
+      data paramlist(81)%grib1val /81/ 
+      data paramlist(81)%grib2dsc /2/ 
+      data paramlist(81)%grib2cat /0/ 
+      data paramlist(81)%grib2num /0/ 
+      data paramlist(81)%abbrev   /'LAND    '/ 
+      data paramlist(82)%g1tblver /2/ 
+      data paramlist(82)%grib1val /82/ 
+      data paramlist(82)%grib2dsc /10/ 
+      data paramlist(82)%grib2cat /4/ 
+      data paramlist(82)%grib2num /1/ 
+      data paramlist(82)%abbrev   /'DSL M   '/ 
+      data paramlist(83)%g1tblver /2/ 
+      data paramlist(83)%grib1val /83/ 
+      data paramlist(83)%grib2dsc /2/ 
+      data paramlist(83)%grib2cat /0/ 
+      data paramlist(83)%grib2num /1/ 
+      data paramlist(83)%abbrev   /'SFC R   '/ 
+      data paramlist(84)%g1tblver /2/ 
+      data paramlist(84)%grib1val /84/ 
+      data paramlist(84)%grib2dsc /0/ 
+      data paramlist(84)%grib2cat /19/ 
+      data paramlist(84)%grib2num /1/ 
+      data paramlist(84)%abbrev   /'ALBDO   '/ 
+      data paramlist(85)%g1tblver /2/ 
+      data paramlist(85)%grib1val /85/ 
+      data paramlist(85)%grib2dsc /2/ 
+      data paramlist(85)%grib2cat /0/ 
+      data paramlist(85)%grib2num /2/ 
+      data paramlist(85)%abbrev   /'TSOIL   '/ 
+      data paramlist(86)%g1tblver /2/ 
+      data paramlist(86)%grib1val /86/ 
+      data paramlist(86)%grib2dsc /2/ 
+      data paramlist(86)%grib2cat /0/ 
+      data paramlist(86)%grib2num /3/ 
+      data paramlist(86)%abbrev   /'SOIL M '/ 
+      data paramlist(87)%g1tblver /2/ 
+      data paramlist(87)%grib1val /87/ 
+      data paramlist(87)%grib2dsc /2/ 
+      data paramlist(87)%grib2cat /0/ 
+      data paramlist(87)%grib2num /4/ 
+      data paramlist(87)%abbrev   /'VEG    '/ 
+      data paramlist(88)%g1tblver /2/ 
+      data paramlist(88)%grib1val /88/ 
+      data paramlist(88)%grib2dsc /10/ 
+      data paramlist(88)%grib2cat /5/ 
+      data paramlist(88)%grib2num /3/ 
+      data paramlist(88)%abbrev   /'SALTY  '/ 
+      data paramlist(89)%g1tblver /2/ 
+      data paramlist(89)%grib1val /89/ 
+      data paramlist(89)%grib2dsc /0/ 
+      data paramlist(89)%grib2cat /3/ 
+      data paramlist(89)%grib2num /10/ 
+      data paramlist(89)%abbrev   /'DEN    '/ 
+      data paramlist(90)%g1tblver /2/ 
+      data paramlist(90)%grib1val /90/ 
+      data paramlist(90)%grib2dsc /2/ 
+      data paramlist(90)%grib2cat /0/ 
+      data paramlist(90)%grib2num /5/ 
+      data paramlist(90)%abbrev   /'WATR   '/ 
+      data paramlist(91)%g1tblver /2/ 
+      data paramlist(91)%grib1val /91/ 
+      data paramlist(91)%grib2dsc /10/ 
+      data paramlist(91)%grib2cat /2/ 
+      data paramlist(91)%grib2num /0/ 
+      data paramlist(91)%abbrev   /'ICE C  '/ 
+      data paramlist(92)%g1tblver /2/ 
+      data paramlist(92)%grib1val /92/ 
+      data paramlist(92)%grib2dsc /10/ 
+      data paramlist(92)%grib2cat /2/ 
+      data paramlist(92)%grib2num /1/ 
+      data paramlist(92)%abbrev   /'ICETK  '/ 
+      data paramlist(93)%g1tblver /2/ 
+      data paramlist(93)%grib1val /93/ 
+      data paramlist(93)%grib2dsc /10/ 
+      data paramlist(93)%grib2cat /2/ 
+      data paramlist(93)%grib2num /2/ 
+      data paramlist(93)%abbrev   /'DICED  '/ 
+      data paramlist(94)%g1tblver /2/ 
+      data paramlist(94)%grib1val /94/ 
+      data paramlist(94)%grib2dsc /10/ 
+      data paramlist(94)%grib2cat /2/ 
+      data paramlist(94)%grib2num /3/ 
+      data paramlist(94)%abbrev   /'SICED  '/ 
+      data paramlist(95)%g1tblver /2/ 
+      data paramlist(95)%grib1val /95/ 
+      data paramlist(95)%grib2dsc /10/ 
+      data paramlist(95)%grib2cat /2/ 
+      data paramlist(95)%grib2num /4/ 
+      data paramlist(95)%abbrev   /'U ICE  '/ 
+      data paramlist(96)%g1tblver /2/ 
+      data paramlist(96)%grib1val /96/ 
+      data paramlist(96)%grib2dsc /10/ 
+      data paramlist(96)%grib2cat /2/ 
+      data paramlist(96)%grib2num /5/ 
+      data paramlist(96)%abbrev   /'V ICE  '/ 
+      data paramlist(97)%g1tblver /2/ 
+      data paramlist(97)%grib1val /97/ 
+      data paramlist(97)%grib2dsc /10/ 
+      data paramlist(97)%grib2cat /2/ 
+      data paramlist(97)%grib2num /6/ 
+      data paramlist(97)%abbrev   /'ICE G  '/ 
+      data paramlist(98)%g1tblver /2/ 
+      data paramlist(98)%grib1val /98/ 
+      data paramlist(98)%grib2dsc /10/ 
+      data paramlist(98)%grib2cat /2/ 
+      data paramlist(98)%grib2num /7/ 
+      data paramlist(98)%abbrev   /'ICE D  '/ 
+      data paramlist(99)%g1tblver /2/ 
+      data paramlist(99)%grib1val /99/ 
+      data paramlist(99)%grib2dsc /0/ 
+      data paramlist(99)%grib2cat /1/ 
+      data paramlist(99)%grib2num /16/ 
+      data paramlist(99)%abbrev   /'SNO M  '/ 
+      data paramlist(100)%g1tblver /2/ 
+      data paramlist(100)%grib1val /100/ 
+      data paramlist(100)%grib2dsc /10/ 
+      data paramlist(100)%grib2cat /0/ 
+      data paramlist(100)%grib2num /3/ 
+      data paramlist(100)%abbrev   /'HTSGW  '/ 
+      data paramlist(101)%g1tblver /2/ 
+      data paramlist(101)%grib1val /101/ 
+      data paramlist(101)%grib2dsc /10/ 
+      data paramlist(101)%grib2cat /0/ 
+      data paramlist(101)%grib2num /4/ 
+      data paramlist(101)%abbrev   /'WVDIR  '/ 
+      data paramlist(102)%g1tblver /2/ 
+      data paramlist(102)%grib1val /102/ 
+      data paramlist(102)%grib2dsc /10/ 
+      data paramlist(102)%grib2cat /0/ 
+      data paramlist(102)%grib2num /5/ 
+      data paramlist(102)%abbrev   /'WVHGT  '/ 
+      data paramlist(103)%g1tblver /2/ 
+      data paramlist(103)%grib1val /103/ 
+      data paramlist(103)%grib2dsc /10/ 
+      data paramlist(103)%grib2cat /0/ 
+      data paramlist(103)%grib2num /6/ 
+      data paramlist(103)%abbrev   /'WVPER  '/ 
+      data paramlist(104)%g1tblver /2/ 
+      data paramlist(104)%grib1val /104/ 
+      data paramlist(104)%grib2dsc /10/ 
+      data paramlist(104)%grib2cat /0/ 
+      data paramlist(104)%grib2num /7/ 
+      data paramlist(104)%abbrev   /'SWDIR  '/ 
+      data paramlist(105)%g1tblver /2/ 
+      data paramlist(105)%grib1val /105/ 
+      data paramlist(105)%grib2dsc /10/ 
+      data paramlist(105)%grib2cat /0/ 
+      data paramlist(105)%grib2num /8/ 
+      data paramlist(105)%abbrev   /'SWELL  '/ 
+      data paramlist(106)%g1tblver /2/ 
+      data paramlist(106)%grib1val /106/ 
+      data paramlist(106)%grib2dsc /10/ 
+      data paramlist(106)%grib2cat /0/ 
+      data paramlist(106)%grib2num /9/ 
+      data paramlist(106)%abbrev   /'SWPER  '/ 
+      data paramlist(107)%g1tblver /2/ 
+      data paramlist(107)%grib1val /107/ 
+      data paramlist(107)%grib2dsc /10/ 
+      data paramlist(107)%grib2cat /0/ 
+      data paramlist(107)%grib2num /10/ 
+      data paramlist(107)%abbrev   /'DIRPW  '/ 
+      data paramlist(108)%g1tblver /2/ 
+      data paramlist(108)%grib1val /108/ 
+      data paramlist(108)%grib2dsc /10/ 
+      data paramlist(108)%grib2cat /0/ 
+      data paramlist(108)%grib2num /11/ 
+      data paramlist(108)%abbrev   /'PERPW  '/ 
+      data paramlist(109)%g1tblver /2/ 
+      data paramlist(109)%grib1val /109/ 
+      data paramlist(109)%grib2dsc /10/ 
+      data paramlist(109)%grib2cat /0/ 
+      data paramlist(109)%grib2num /12/ 
+      data paramlist(109)%abbrev   /'DIRSW  '/ 
+      data paramlist(110)%g1tblver /2/ 
+      data paramlist(110)%grib1val /110/ 
+      data paramlist(110)%grib2dsc /10/ 
+      data paramlist(110)%grib2cat /0/ 
+      data paramlist(110)%grib2num /13/ 
+      data paramlist(110)%abbrev   /'PERSW  '/ 
+      data paramlist(111)%g1tblver /2/ 
+      data paramlist(111)%grib1val /111/ 
+      data paramlist(111)%grib2dsc /0/ 
+      data paramlist(111)%grib2cat /4/ 
+      data paramlist(111)%grib2num /0/ 
+      data paramlist(111)%abbrev   /'NSWRS  '/ 
+      data paramlist(112)%g1tblver /2/ 
+      data paramlist(112)%grib1val /112/ 
+      data paramlist(112)%grib2dsc /0/ 
+      data paramlist(112)%grib2cat /5/ 
+      data paramlist(112)%grib2num /0/ 
+      data paramlist(112)%abbrev   /'NLWRS  '/ 
+      data paramlist(113)%g1tblver /2/ 
+      data paramlist(113)%grib1val /113/ 
+      data paramlist(113)%grib2dsc /0/ 
+      data paramlist(113)%grib2cat /4/ 
+      data paramlist(113)%grib2num /1/ 
+      data paramlist(113)%abbrev   /'NSWRT  '/ 
+      data paramlist(114)%g1tblver /2/ 
+      data paramlist(114)%grib1val /114/ 
+      data paramlist(114)%grib2dsc /0/ 
+      data paramlist(114)%grib2cat /5/ 
+      data paramlist(114)%grib2num /1/ 
+      data paramlist(114)%abbrev   /'NLWRT  '/ 
+      data paramlist(115)%g1tblver /2/ 
+      data paramlist(115)%grib1val /115/ 
+      data paramlist(115)%grib2dsc /0/ 
+      data paramlist(115)%grib2cat /5/ 
+      data paramlist(115)%grib2num /2/ 
+      data paramlist(115)%abbrev   /'LWAVR  '/ 
+      data paramlist(116)%g1tblver /2/ 
+      data paramlist(116)%grib1val /116/ 
+      data paramlist(116)%grib2dsc /0/ 
+      data paramlist(116)%grib2cat /4/ 
+      data paramlist(116)%grib2num /2/ 
+      data paramlist(116)%abbrev   /'SWAVR  '/ 
+      data paramlist(117)%g1tblver /2/ 
+      data paramlist(117)%grib1val /117/ 
+      data paramlist(117)%grib2dsc /0/ 
+      data paramlist(117)%grib2cat /4/ 
+      data paramlist(117)%grib2num /3/ 
+      data paramlist(117)%abbrev   /'G RAD  '/ 
+      data paramlist(118)%g1tblver /2/ 
+      data paramlist(118)%grib1val /118/ 
+      data paramlist(118)%grib2dsc /0/ 
+      data paramlist(118)%grib2cat /4/ 
+      data paramlist(118)%grib2num /4/ 
+      data paramlist(118)%abbrev   /'BRTMP  '/ 
+      data paramlist(119)%g1tblver /2/ 
+      data paramlist(119)%grib1val /119/ 
+      data paramlist(119)%grib2dsc /0/ 
+      data paramlist(119)%grib2cat /4/ 
+      data paramlist(119)%grib2num /5/ 
+      data paramlist(119)%abbrev   /'LWRAD  '/ 
+      data paramlist(120)%g1tblver /2/ 
+      data paramlist(120)%grib1val /120/ 
+      data paramlist(120)%grib2dsc /0/ 
+      data paramlist(120)%grib2cat /4/ 
+      data paramlist(120)%grib2num /6/ 
+      data paramlist(120)%abbrev   /'SWRAD  '/ 
+      data paramlist(121)%g1tblver /2/ 
+      data paramlist(121)%grib1val /121/ 
+      data paramlist(121)%grib2dsc /0/ 
+      data paramlist(121)%grib2cat /0/ 
+      data paramlist(121)%grib2num /10/ 
+      data paramlist(121)%abbrev   /'LHTFL  '/ 
+      data paramlist(122)%g1tblver /2/ 
+      data paramlist(122)%grib1val /122/ 
+      data paramlist(122)%grib2dsc /0/ 
+      data paramlist(122)%grib2cat /0/ 
+      data paramlist(122)%grib2num /11/ 
+      data paramlist(122)%abbrev   /'SHTFL  '/ 
+      data paramlist(123)%g1tblver /2/ 
+      data paramlist(123)%grib1val /123/ 
+      data paramlist(123)%grib2dsc /0/ 
+      data paramlist(123)%grib2cat /2/ 
+      data paramlist(123)%grib2num /20/ 
+      data paramlist(123)%abbrev   /'BLYDP  '/ 
+      data paramlist(124)%g1tblver /2/ 
+      data paramlist(124)%grib1val /124/ 
+      data paramlist(124)%grib2dsc /0/ 
+      data paramlist(124)%grib2cat /2/ 
+      data paramlist(124)%grib2num /17/ 
+      data paramlist(124)%abbrev   /'U FLX  '/ 
+      data paramlist(125)%g1tblver /2/ 
+      data paramlist(125)%grib1val /125/ 
+      data paramlist(125)%grib2dsc /0/ 
+      data paramlist(125)%grib2cat /2/ 
+      data paramlist(125)%grib2num /18/ 
+      data paramlist(125)%abbrev   /'V FLX  '/ 
+      data paramlist(126)%g1tblver /2/ 
+      data paramlist(126)%grib1val /126/ 
+      data paramlist(126)%grib2dsc /0/ 
+      data paramlist(126)%grib2cat /2/ 
+      data paramlist(126)%grib2num /19/ 
+      data paramlist(126)%abbrev   /'WMIXE  '/ 
+      data paramlist(127)%g1tblver /2/ 
+      data paramlist(127)%grib1val /127/ 
+      data paramlist(127)%grib2dsc /255/ 
+      data paramlist(127)%grib2cat /255/ 
+      data paramlist(127)%grib2num /255/ 
+      data paramlist(127)%abbrev   /'IMG D  '/ 
+!
+!  GRIB1 parameters in NCEP Local Table version 2
+!  Added 8/07/2003
+!
+      data paramlist(128)%g1tblver /2/ 
+      data paramlist(128)%grib1val /229/ 
+      data paramlist(128)%grib2dsc /0/ 
+      data paramlist(128)%grib2cat /0/ 
+      data paramlist(128)%grib2num /192/ 
+      data paramlist(128)%abbrev   /'SNOHF  '/ 
+      data paramlist(129)%g1tblver /2/ 
+      data paramlist(129)%grib1val /153/ 
+      data paramlist(129)%grib2dsc /0/ 
+      data paramlist(129)%grib2cat /1/ 
+      data paramlist(129)%grib2num /22/ 
+      data paramlist(129)%abbrev   /'CLWMR  '/ 
+      data paramlist(130)%g1tblver /2/ 
+      data paramlist(130)%grib1val /140/ 
+      data paramlist(130)%grib2dsc /0/ 
+      data paramlist(130)%grib2cat /1/ 
+      data paramlist(130)%grib2num /192/ 
+      data paramlist(130)%abbrev   /'CRAIN  '/ 
+      data paramlist(131)%g1tblver /2/ 
+      data paramlist(131)%grib1val /141/ 
+      data paramlist(131)%grib2dsc /0/ 
+      data paramlist(131)%grib2cat /1/ 
+      data paramlist(131)%grib2num /193/ 
+      data paramlist(131)%abbrev   /'CFRZR  '/ 
+      data paramlist(132)%g1tblver /2/ 
+      data paramlist(132)%grib1val /142/ 
+      data paramlist(132)%grib2dsc /0/ 
+      data paramlist(132)%grib2cat /1/ 
+      data paramlist(132)%grib2num /194/ 
+      data paramlist(132)%abbrev   /'CICEP  '/ 
+      data paramlist(133)%g1tblver /2/ 
+      data paramlist(133)%grib1val /143/ 
+      data paramlist(133)%grib2dsc /0/ 
+      data paramlist(133)%grib2cat /1/ 
+      data paramlist(133)%grib2num /195/ 
+      data paramlist(133)%abbrev   /'CSNOW  '/ 
+      data paramlist(134)%g1tblver /2/ 
+      data paramlist(134)%grib1val /214/ 
+      data paramlist(134)%grib2dsc /0/ 
+      data paramlist(134)%grib2cat /1/ 
+      data paramlist(134)%grib2num /196/ 
+      data paramlist(134)%abbrev   /'CPRAT  '/ 
+      data paramlist(135)%g1tblver /2/ 
+      data paramlist(135)%grib1val /135/ 
+      data paramlist(135)%grib2dsc /0/ 
+      data paramlist(135)%grib2cat /1/ 
+      data paramlist(135)%grib2num /197/ 
+      data paramlist(135)%abbrev   /'MCONV  '/ 
+      data paramlist(136)%g1tblver /2/ 
+      data paramlist(136)%grib1val /194/ 
+      data paramlist(136)%grib2dsc /1/ 
+      data paramlist(136)%grib2cat /1/ 
+      data paramlist(136)%grib2num /193/ 
+      data paramlist(136)%abbrev   /'CPOFP  '/ 
+      data paramlist(137)%g1tblver /2/ 
+      data paramlist(137)%grib1val /228/ 
+      data paramlist(137)%grib2dsc /0/ 
+      data paramlist(137)%grib2cat /1/ 
+      data paramlist(137)%grib2num /199/ 
+      data paramlist(137)%abbrev   /'PEVAP  '/ 
+      data paramlist(138)%g1tblver /2/ 
+      data paramlist(138)%grib1val /136/ 
+      data paramlist(138)%grib2dsc /0/ 
+      data paramlist(138)%grib2cat /2/ 
+      data paramlist(138)%grib2num /192/ 
+      data paramlist(138)%abbrev   /'VW SH  '/ 
+      data paramlist(139)%g1tblver /2/ 
+      data paramlist(139)%grib1val /172/ 
+      data paramlist(139)%grib2dsc /0/ 
+      data paramlist(139)%grib2cat /2/ 
+      data paramlist(139)%grib2num /193/ 
+      data paramlist(139)%abbrev   /'M FLX  '/ 
+      data paramlist(140)%g1tblver /2/ 
+      data paramlist(140)%grib1val /196/ 
+      data paramlist(140)%grib2dsc /0/ 
+      data paramlist(140)%grib2cat /2/ 
+      data paramlist(140)%grib2num /194/ 
+      data paramlist(140)%abbrev   /'USTM   '/ 
+      data paramlist(141)%g1tblver /2/ 
+      data paramlist(141)%grib1val /197/ 
+      data paramlist(141)%grib2dsc /0/ 
+      data paramlist(141)%grib2cat /2/ 
+      data paramlist(141)%grib2num /195/ 
+      data paramlist(141)%abbrev   /'VSTM   '/ 
+      data paramlist(142)%g1tblver /2/ 
+      data paramlist(142)%grib1val /252/ 
+      data paramlist(142)%grib2dsc /0/ 
+      data paramlist(142)%grib2cat /2/ 
+      data paramlist(142)%grib2num /196/ 
+      data paramlist(142)%abbrev   /'CD     '/ 
+      data paramlist(143)%g1tblver /2/ 
+      data paramlist(143)%grib1val /253/ 
+      data paramlist(143)%grib2dsc /0/ 
+      data paramlist(143)%grib2cat /2/ 
+      data paramlist(143)%grib2num /197/ 
+      data paramlist(143)%abbrev   /'FRICV  '/ 
+      data paramlist(144)%g1tblver /2/ 
+      data paramlist(144)%grib1val /130/ 
+      data paramlist(144)%grib2dsc /0/ 
+      data paramlist(144)%grib2cat /3/ 
+      data paramlist(144)%grib2num /192/ 
+      data paramlist(144)%abbrev   /'MSLET  '/ 
+      data paramlist(145)%g1tblver /2/ 
+      data paramlist(145)%grib1val /204/ 
+      data paramlist(145)%grib2dsc /0/ 
+      data paramlist(145)%grib2cat /4/ 
+      data paramlist(145)%grib2num /192/ 
+      data paramlist(145)%abbrev   /'DSWRF  '/ 
+      data paramlist(146)%g1tblver /2/ 
+      data paramlist(146)%grib1val /211/ 
+      data paramlist(146)%grib2dsc /0/ 
+      data paramlist(146)%grib2cat /4/ 
+      data paramlist(146)%grib2num /193/ 
+      data paramlist(146)%abbrev   /'USWRF  '/ 
+      data paramlist(147)%g1tblver /2/ 
+      data paramlist(147)%grib1val /205/ 
+      data paramlist(147)%grib2dsc /0/ 
+      data paramlist(147)%grib2cat /5/ 
+      data paramlist(147)%grib2num /192/ 
+      data paramlist(147)%abbrev   /'DLWRF  '/ 
+      data paramlist(148)%g1tblver /2/ 
+      data paramlist(148)%grib1val /212/ 
+      data paramlist(148)%grib2dsc /0/ 
+      data paramlist(148)%grib2cat /5/ 
+      data paramlist(148)%grib2num /193/ 
+      data paramlist(148)%abbrev   /'ULWRF  '/ 
+      data paramlist(149)%g1tblver /2/ 
+      data paramlist(149)%grib1val /213/ 
+      data paramlist(149)%grib2dsc /0/ 
+      data paramlist(149)%grib2cat /6/ 
+      data paramlist(149)%grib2num /192/ 
+      data paramlist(149)%abbrev   /'CDLYR  '/ 
+      data paramlist(150)%g1tblver /2/ 
+      data paramlist(150)%grib1val /132/ 
+      data paramlist(150)%grib2dsc /0/ 
+      data paramlist(150)%grib2cat /7/ 
+      data paramlist(150)%grib2num /193/ 
+      data paramlist(150)%abbrev   /'4LFTX  '/ 
+      data paramlist(151)%g1tblver /2/ 
+      data paramlist(151)%grib1val /157/ 
+      data paramlist(151)%grib2dsc /0/ 
+      data paramlist(151)%grib2cat /7/ 
+      data paramlist(151)%grib2num /6/ 
+      data paramlist(151)%abbrev   /'CAPE   '/ 
+      data paramlist(152)%g1tblver /2/ 
+      data paramlist(152)%grib1val /156/ 
+      data paramlist(152)%grib2dsc /0/ 
+      data paramlist(152)%grib2cat /7/ 
+      data paramlist(152)%grib2num /7/ 
+      data paramlist(152)%abbrev   /'CIN    '/ 
+      data paramlist(153)%g1tblver /2/ 
+      data paramlist(153)%grib1val /190/ 
+      data paramlist(153)%grib2dsc /0/ 
+      data paramlist(153)%grib2cat /7/ 
+      data paramlist(153)%grib2num /8/ 
+      data paramlist(153)%abbrev   /'HLCY   '/ 
+      data paramlist(154)%g1tblver /2/ 
+      data paramlist(154)%grib1val /131/ 
+      data paramlist(154)%grib2dsc /0/ 
+      data paramlist(154)%grib2cat /7/ 
+      data paramlist(154)%grib2num /192/ 
+      data paramlist(154)%abbrev   /'LFT X  '/ 
+      data paramlist(155)%g1tblver /2/ 
+      data paramlist(155)%grib1val /158/ 
+      data paramlist(155)%grib2dsc /0/ 
+      data paramlist(155)%grib2cat /19/ 
+      data paramlist(155)%grib2num /11/ 
+      data paramlist(155)%abbrev   /'TKE    '/ 
+      data paramlist(156)%g1tblver /2/ 
+      data paramlist(156)%grib1val /176/ 
+      data paramlist(156)%grib2dsc /0/ 
+      data paramlist(156)%grib2cat /191/ 
+      data paramlist(156)%grib2num /192/ 
+      data paramlist(156)%abbrev   /'NLAT   '/ 
+      data paramlist(157)%g1tblver /2/ 
+      data paramlist(157)%grib1val /177/ 
+      data paramlist(157)%grib2dsc /0/ 
+      data paramlist(157)%grib2cat /191/ 
+      data paramlist(157)%grib2num /193/ 
+      data paramlist(157)%abbrev   /'ELON   '/ 
+      data paramlist(158)%g1tblver /2/ 
+      data paramlist(158)%grib1val /234/ 
+      data paramlist(158)%grib2dsc /1/ 
+      data paramlist(158)%grib2cat /0/ 
+      data paramlist(158)%grib2num /192/ 
+      data paramlist(158)%abbrev   /'BGRUN  '/ 
+      data paramlist(159)%g1tblver /2/ 
+      data paramlist(159)%grib1val /235/ 
+      data paramlist(159)%grib2dsc /1/ 
+      data paramlist(159)%grib2cat /0/ 
+      data paramlist(159)%grib2num /193/ 
+      data paramlist(159)%abbrev   /'SSRUN  '/ 
+      data paramlist(160)%g1tblver /2/ 
+      data paramlist(160)%grib1val /144/ 
+      data paramlist(160)%grib2dsc /2/ 
+      data paramlist(160)%grib2cat /0/ 
+      data paramlist(160)%grib2num /192/ 
+      data paramlist(160)%abbrev   /'SOILW  '/ 
+      data paramlist(161)%g1tblver /2/ 
+      data paramlist(161)%grib1val /155/ 
+      data paramlist(161)%grib2dsc /2/ 
+      data paramlist(161)%grib2cat /0/ 
+      data paramlist(161)%grib2num /193/ 
+      data paramlist(161)%abbrev   /'GFLUX  '/ 
+      data paramlist(162)%g1tblver /2/ 
+      data paramlist(162)%grib1val /207/ 
+      data paramlist(162)%grib2dsc /2/ 
+      data paramlist(162)%grib2cat /0/ 
+      data paramlist(162)%grib2num /194/ 
+      data paramlist(162)%abbrev   /'MSTAV  '/ 
+      data paramlist(163)%g1tblver /2/ 
+      data paramlist(163)%grib1val /208/ 
+      data paramlist(163)%grib2dsc /2/ 
+      data paramlist(163)%grib2cat /0/ 
+      data paramlist(163)%grib2num /195/ 
+      data paramlist(163)%abbrev   /'SFEXC  '/ 
+      data paramlist(164)%g1tblver /2/ 
+      data paramlist(164)%grib1val /223/ 
+      data paramlist(164)%grib2dsc /2/ 
+      data paramlist(164)%grib2cat /0/ 
+      data paramlist(164)%grib2num /196/ 
+      data paramlist(164)%abbrev   /'CNWAT  '/ 
+      data paramlist(165)%g1tblver /2/ 
+      data paramlist(165)%grib1val /226/ 
+      data paramlist(165)%grib2dsc /2/ 
+      data paramlist(165)%grib2cat /0/ 
+      data paramlist(165)%grib2num /197/ 
+      data paramlist(165)%abbrev   /'BMIXL  '/ 
+      data paramlist(166)%g1tblver /2/ 
+      data paramlist(166)%grib1val /154/ 
+      data paramlist(166)%grib2dsc /0/ 
+      data paramlist(166)%grib2cat /14/ 
+      data paramlist(166)%grib2num /192/ 
+      data paramlist(166)%abbrev   /'O3MR   '/ 
+      data paramlist(167)%g1tblver /2/ 
+      data paramlist(167)%grib1val /222/ 
+      data paramlist(167)%grib2dsc /0/ 
+      data paramlist(167)%grib2cat /3/ 
+      data paramlist(167)%grib2num /193/ 
+      data paramlist(167)%abbrev   /'5WAVH  '/ 
+      data paramlist(168)%g1tblver /2/ 
+      data paramlist(168)%grib1val /145/ 
+      data paramlist(168)%grib2dsc /0/ 
+      data paramlist(168)%grib2cat /1/ 
+      data paramlist(168)%grib2num /200/ 
+      data paramlist(168)%abbrev   /'PEVPR  '/ 
+      data paramlist(169)%g1tblver /2/ 
+      data paramlist(169)%grib1val /146/ 
+      data paramlist(169)%grib2dsc /0/ 
+      data paramlist(169)%grib2cat /6/ 
+      data paramlist(169)%grib2num /193/ 
+      data paramlist(169)%abbrev   /'CWORK  '/ 
+      data paramlist(170)%g1tblver /2/ 
+      data paramlist(170)%grib1val /147/ 
+      data paramlist(170)%grib2dsc /0/ 
+      data paramlist(170)%grib2cat /3/ 
+      data paramlist(170)%grib2num /194/ 
+      data paramlist(170)%abbrev   /'U-GWD  '/ 
+      data paramlist(171)%g1tblver /2/ 
+      data paramlist(171)%grib1val /148/ 
+      data paramlist(171)%grib2dsc /0/ 
+      data paramlist(171)%grib2cat /3/ 
+      data paramlist(171)%grib2num /195/ 
+      data paramlist(171)%abbrev   /'V-GWD  '/ 
+      data paramlist(172)%g1tblver /2/ 
+      data paramlist(172)%grib1val /221/ 
+      data paramlist(172)%grib2dsc /0/ 
+      data paramlist(172)%grib2cat /3/ 
+      data paramlist(172)%grib2num /196/ 
+      data paramlist(172)%abbrev   /'HPBL   '/ 
+      data paramlist(173)%g1tblver /2/ 
+      data paramlist(173)%grib1val /230/ 
+      data paramlist(173)%grib2dsc /0/ 
+      data paramlist(173)%grib2cat /3/ 
+      data paramlist(173)%grib2num /197/ 
+      data paramlist(173)%abbrev   /'5WAVA  '/ 
+! Added 9/26/2003
+      data paramlist(174) /gribparam(130,160,2,3,192,'SOILL   ')/
+      data paramlist(175) /gribparam(130,171,2,3,193,'UNKNOWN ')/
+      data paramlist(176) /gribparam(130,219,2,0,201,'WILT    ')/
+      data paramlist(177) /gribparam(130,222,2,3,194,'SLTYP   ')/
+      data paramlist(178) /gribparam(2,224,2,3,0,'SOTYP   ')/
+      data paramlist(179) /gribparam(2,225,2,0,198,'VGTYP   ')/
+      data paramlist(180) /gribparam(130,230,2,3,195,'SMREF   ')/
+      data paramlist(181) /gribparam(130,231,2,3,196,'SMDRY   ')/
+      data paramlist(182) /gribparam(2,238,0,1,201,'SNOWC   ')/
+      data paramlist(183) /gribparam(130,240,2,3,197,'POROS   ')/
+      data paramlist(184) /gribparam(129,131,0,1,202,'FRAIN   ')/
+      data paramlist(185) /gribparam(129,132,0,6,199,'FICE    ')/
+      data paramlist(186) /gribparam(129,133,0,1,203,'FRIME   ')/
+      data paramlist(187) /gribparam(129,134,0,6,194,'CUEFI   ')/
+      data paramlist(188) /gribparam(129,135,0,6,195,'TCOND   ')/
+      data paramlist(189) /gribparam(129,136,0,6,196,'TCOLW   ')/
+      data paramlist(190) /gribparam(129,137,0,6,197,'TCOLI   ')/
+      data paramlist(191) /gribparam(129,138,0,1,204,'TCOLR   ')/
+      data paramlist(192) /gribparam(129,139,0,1,205,'TCOLS   ')/
+      data paramlist(193) /gribparam(129,140,0,6,198,'TCOLC   ')/
+      data paramlist(194) /gribparam(130,159,0,19,192,'MXSALB  ')/
+      data paramlist(195) /gribparam(130,170,0,19,193,'SNFALB  ')/
+      data paramlist(196) /gribparam(2,170,0,1,24,'RWMR    ')/
+      data paramlist(197) /gribparam(2,171,0,1,25,'SNMR    ')/
+      data paramlist(198) /gribparam(130,181,2,0,199,'CCOND   ')/
+      data paramlist(199) /gribparam(130,203,2,0,200,'RSMIN   ')/
+      data paramlist(200) /gribparam(130,246,2,0,202,'RCS     ')/
+      data paramlist(201) /gribparam(130,247,2,0,203,'RCT     ')/
+      data paramlist(202) /gribparam(130,248,2,0,204,'RCQ     ')/
+      data paramlist(203) /gribparam(130,249,2,0,205,'RCSOL   ')/
+      data paramlist(204) /gribparam(2,254,0,7,194,'RI      ')/
+      data paramlist(205) /gribparam(129,190,3,1,192,'USCT    ')/
+      data paramlist(206) /gribparam(129,191,3,1,193,'VSCT    ')/
+      data paramlist(207) /gribparam(129,171,0,191,194,'TSEC    ')/
+      data paramlist(208) /gribparam(129,180,0,14,193,'OZCON   ')/
+      data paramlist(209) /gribparam(129,181,0,14,194,'OZCAT   ')/
+      data paramlist(210) /gribparam(2,193,1,1,2,'POP     ')/
+      data paramlist(211) /gribparam(2,195,1,1,192,'CPOZP   ')/
+      data paramlist(212) /gribparam(2,180,0,2,22,'GUST    ')/
+
+
+      contains
+
+
+         subroutine param_g1_to_g2(g1val,g1ver,g2disc,g2cat,g2num)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    param_g1_to_g2 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-05
+!
+! ABSTRACT: This subroutine returns the corresponding GRIB2 Discipline
+!   Category and Number for a given GRIB1 parameter value and table version.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-11  Gilbert
+!
+! USAGE:    CALL param_g1_to_g2(g1val,g1ver,g2disc,g2cat,g2num)
+!   INPUT ARGUMENT LIST:
+!     g1val    - GRIB1 parameter number for which discipline is requested
+!     g1ver    - GRIB1 parameter table version number
+!
+!   OUTPUT ARGUMENT LIST:      
+!     g2disc   - corresponding GRIB2 Discipline number
+!     g2cat    - corresponding GRIB2 Category number
+!     g2num    - corresponding GRIB2 Parameter number within Category g2cat
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: g1val,g1ver
+           integer,intent(out) :: g2disc,g2cat,g2num
+
+           g2disc=255
+           g2cat=255
+           g2num=255
+! for testing
+!           g2num=g1val
+! for testing
+
+           do n=1,MAXPARAM
+              if (paramlist(n)%grib1val.eq.g1val .AND.
+     &            paramlist(n)%g1tblver.eq.g1ver ) then
+                 g2disc=paramlist(n)%grib2dsc
+                 g2cat=paramlist(n)%grib2cat
+                 g2num=paramlist(n)%grib2num
+                 return
+              endif
+           enddo
+
+           print *,'param_g1_to_g2:GRIB1 param ',g1val,' not found.',
+     &             ' for table version ',g1ver
+           return
+         end subroutine
+
+         character(len=8) function param_get_abbrev(g2disc,g2cat,g2num)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    param_get_abbrev 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-01-04
+!
+! ABSTRACT: This function returns the parameter abbreviation for
+!   a given GRIB2 Discipline, Category and Parameter number.
+!
+! PROGRAM HISTORY LOG:
+! 2001-06-05  Gilbert
+!
+! USAGE:     abrev=param_get_abbrev(g2disc,g2cat,g2num)
+!   INPUT ARGUMENT LIST:
+!     g2disc   - GRIB2 discipline number (See Code Table 0.0)
+!     g2cat    - corresponding GRIB2 Category number
+!     g2num    - corresponding GRIB2 Parameter number within Category g2cat
+!
+! RETURNS:  ASCII Paramter Abbreviation
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: g2disc,g2cat,g2num
+
+           param_get_abbrev='UNKNOWN '
+
+           do n=1,MAXPARAM
+              if (paramlist(n)%grib2dsc.eq.g2disc.AND.
+     &             paramlist(n)%grib2cat.eq.g2cat.AND.
+     &             paramlist(n)%grib2num.eq.g2num) then
+                 param_get_abbrev=paramlist(n)%abbrev
+                 return
+              endif
+           enddo
+
+!           print *,'param_get_abbrev:GRIB2 param ',g2disc,g2cat,
+!     &              g2num,' not found.'
+           return
+         end function
+
+
+         subroutine param_g2_to_g1(g2disc,g2cat,g2num,g1val,g1ver)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    param_g2_to_g1 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-01-04
+!
+! ABSTRACT: This function returns the GRIB 1 parameter number for 
+!   a given GRIB2 Discipline, Category and Parameter number.
+!
+! PROGRAM HISTORY LOG:
+! 2001-06-05  Gilbert
+!
+! USAGE:     call param_g2_to_g1(g2disc,g2cat,g2num,g1val,g1ver)
+!   INPUT ARGUMENT LIST:
+!     g2disc   - GRIB2 discipline number (See Code Table 0.0)
+!     g2cat    - corresponding GRIB2 Category number
+!     g2num    - corresponding GRIB2 Parameter number within Category g2cat
+!
+!   OUTPUT ARGUMENT LIST:      
+!     g1val    - GRIB1 parameter number for which discipline is requested
+!     g1ver    - GRIB1 parameter table version number
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: g2disc,g2cat,g2num
+           integer,intent(out) :: g1val,g1ver
+
+           g1val=255
+           g1ver=255
+
+! for testing
+!           if ( g2disc.eq.255.and.g2cat.eq.255 ) then
+!             g1val=g2num
+!             g1ver=2
+!             return
+!           endif
+! for testing
+
+           do n=1,MAXPARAM
+              if (paramlist(n)%grib2dsc.eq.g2disc.AND.
+     &             paramlist(n)%grib2cat.eq.g2cat.AND.
+     &             paramlist(n)%grib2num.eq.g2num) then
+                 g1val=paramlist(n)%grib1val
+                 g1ver=paramlist(n)%g1tblver
+                 return
+              endif
+           enddo
+
+           print *,'param_g2_to_g1:GRIB2 param ',g2disc,g2cat,
+     &              g2num,' not found.'
+           return
+         end subroutine
+
+
+      end module
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pdstemplates.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pdstemplates.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pdstemplates.F	(revision 2744)
@@ -0,0 +1,494 @@
+      module pdstemplates
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! MODULE:    pdstemplates 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
+!
+! ABSTRACT: This Fortran Module contains info on all the available 
+!   GRIB2 Product Definition Templates used in Section 4 (PDS).
+!   Each Template has three parts: The number of entries in the template
+!   (mapgridlen);  A map of the template (mapgrid), which contains the
+!   number of octets in which to pack each of the template values; and
+!   a logical value (needext) that indicates whether the Template needs 
+!   to be extended.  In some cases the number of entries in a template 
+!   can vary depending upon values specified in the "static" part of 
+!   the template.  ( See Template 4.3 as an example )
+!
+!   This module also contains two subroutines.  Subroutine getpdstemplate
+!   returns the octet map for a specified Template number, and
+!   subroutine extpdstemplate will calculate the extended octet map
+!   of an appropriate template given values for the "static" part of the 
+!   template.  See docblocks below for the arguments and usage of these 
+!   routines.
+!
+!   NOTE:  Array mapgrid contains the number of octets in which the 
+!   corresponding template values will be stored.  A negative value in
+!   mapgrid is used to indicate that the corresponding template entry can
+!   contain negative values.  This information is used later when packing
+!   (or unpacking) the template data values.  Negative data values in GRIB
+!   are stored with the left most bit set to one, and a negative number
+!   of octets value in mapgrid() indicates that this possibility should
+!   be considered.  The number of octets used to store the data value
+!   in this case would be the absolute value of the negative value in 
+!   mapgrid().
+!  
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-11  Gilbert
+! 2001-12-04  Gilbert  -  Added Templates 4.12, 4.12, 4.14,
+!                         4.1000, 4.1001, 4.1002, 4.1100 and 4.1101
+!
+! USAGE:    use pdstemplates
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,parameter :: MAXLEN=200,MAXTEMP=23
+
+      type pdstemplate
+          integer :: template_num
+          integer :: mappdslen
+          integer,dimension(MAXLEN) :: mappds
+          logical :: needext
+      end type pdstemplate
+
+      type(pdstemplate),dimension(MAXTEMP) :: templates
+
+      data templates(1)%template_num /0/     !  Fcst at Level/Layer
+      data templates(1)%mappdslen /15/
+      data templates(1)%needext /.false./
+      data (templates(1)%mappds(j),j=1,15) 
+     &                             /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
+
+      data templates(2)%template_num /1/     !  Ens fcst at level/layer
+      data templates(2)%mappdslen /18/
+      data templates(2)%needext /.false./
+      data (templates(2)%mappds(j),j=1,18)
+     &                        /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/
+
+      data templates(3)%template_num /2/     !  Derived Ens fcst at level/layer
+      data templates(3)%mappdslen /17/
+      data templates(3)%needext /.false./
+      data (templates(3)%mappds(j),j=1,17)
+     &                      /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1/
+
+      data templates(4)%template_num /3/     !  Ens cluster fcst rect. area
+      data templates(4)%mappdslen /31/
+      data templates(4)%needext /.true./
+      data (templates(4)%mappds(j),j=1,31)
+     &       /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,-4,4,4,
+     &        1,-1,4,-1,4/
+
+      data templates(5)%template_num /4/     !  Ens cluster fcst circ. area
+      data templates(5)%mappdslen /30/
+      data templates(5)%needext /.true./
+      data (templates(5)%mappds(j),j=1,30)
+     &       /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,4,4,
+     &        1,-1,4,-1,4/
+
+      data templates(6)%template_num /5/     !  Prob fcst at level/layer
+      data templates(6)%mappdslen /22/
+      data templates(6)%needext /.false./
+      data (templates(6)%mappds(j),j=1,22)
+     &               /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,4,1,4/
+
+      data templates(7)%template_num /6/     !  Percentile fcst at level/layer
+      data templates(7)%mappdslen /16/
+      data templates(7)%needext /.false./
+      data (templates(7)%mappds(j),j=1,16)
+     &                     /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1/
+
+      data templates(8)%template_num /7/     !  Error at level/layer
+      data templates(8)%mappdslen /15/
+      data templates(8)%needext /.false./
+      data (templates(8)%mappds(j),j=1,15)
+     &                     /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
+
+      data templates(9)%template_num /8/     !  Ave or Accum at level/layer
+      data templates(9)%mappdslen /29/
+      data templates(9)%needext /.true./
+      data (templates(9)%mappds(j),j=1,29)
+     &  /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/
+
+      data templates(10)%template_num /9/     !  Prob over time interval
+      data templates(10)%mappdslen /36/
+      data templates(10)%needext /.true./
+      data (templates(10)%mappds(j),j=1,36)
+     &  /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,-1,4,-1,4,2,1,1,1,1,1,
+     &   1,4,1,1,1,4,1,4/
+
+      data templates(11)%template_num /10/     !  Percentile over time interval
+      data templates(11)%mappdslen /30/
+      data templates(11)%needext /.true./
+      data (templates(11)%mappds(j),j=1,30)
+     &    /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,2,1,1,1,1,1,1,4,
+     &     1,1,1,4,1,4/
+
+      data templates(12)%template_num /11/     !  Ens member over time interval
+      data templates(12)%mappdslen /32/
+      data templates(12)%needext /.true./
+      data (templates(12)%mappds(j),j=1,32)
+     &    /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,2,1,1,1,1,1,1,
+     &     4,1,1,1,4,1,4/
+
+      data templates(13)%template_num /12/     !  Derived Ens fcst over time int
+      data templates(13)%mappdslen /31/
+      data templates(13)%needext /.true./
+      data (templates(13)%mappds(j),j=1,31)
+     &                   /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,
+     &                    2,1,1,1,1,1,1,4,1,1,1,4,1,4/
+
+      data templates(14)%template_num /13/     !  Ens cluster fcst rect. area
+      data templates(14)%mappdslen /45/
+      data templates(14)%needext /.true./
+      data (templates(14)%mappds(j),j=1,45)
+     &       /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,-4,4,4,
+     &        1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/
+
+      data templates(15)%template_num /14/     !  Ens cluster fcst circ. area
+      data templates(15)%mappdslen /44/
+      data templates(15)%needext /.true./
+      data (templates(15)%mappds(j),j=1,44)
+     &       /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,4,4,
+     &        1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/
+
+      data templates(16)%template_num /20/     !  Radar Product
+      data templates(16)%mappdslen /19/
+      data templates(16)%needext /.false./
+      data (templates(16)%mappds(j),j=1,19)
+     &                     /1,1,1,1,1,-4,4,2,4,2,1,1,1,1,1,2,1,3,2/
+
+      data templates(17)%template_num /30/     !  Satellite Product
+      data templates(17)%mappdslen /5/
+      data templates(17)%needext /.true./
+      data (templates(17)%mappds(j),j=1,5)
+     &                            /1,1,1,1,1/
+
+      data templates(18)%template_num /254/     !  CCITTIA5 Character String
+      data templates(18)%mappdslen /3/
+      data templates(18)%needext /.false./
+      data (templates(18)%mappds(j),j=1,3)
+     &                     /1,1,4/
+
+      data templates(19)%template_num /1000/     !  Cross section
+      data templates(19)%mappdslen /9/
+      data templates(19)%needext /.false./
+      data (templates(19)%mappds(j),j=1,9)
+     &                     /1,1,1,1,1,2,1,1,4/
+
+      data templates(20)%template_num /1001/     !  Cross section over time
+      data templates(20)%mappdslen /16/
+      data templates(20)%needext /.false./
+      data (templates(20)%mappds(j),j=1,16)
+     &                     /1,1,1,1,1,2,1,1,4,4,1,1,1,4,1,4/
+
+      data templates(21)%template_num /1002/     !  Cross section processed time
+      data templates(21)%mappdslen /15/
+      data templates(21)%needext /.false./
+      data (templates(21)%mappds(j),j=1,15)
+     &                     /1,1,1,1,1,2,1,1,4,1,1,1,4,4,2/
+
+      data templates(22)%template_num /1100/     !  Hovmoller grid
+      data templates(22)%mappdslen /15/
+      data templates(22)%needext /.false./
+      data (templates(22)%mappds(j),j=1,15)
+     &                     /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
+
+      data templates(23)%template_num /1101/     !  Hovmoller with stat proc
+      data templates(23)%mappdslen /22/
+      data templates(23)%needext /.false./
+      data (templates(23)%mappds(j),j=1,22)
+     &               /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,4,1,1,1,4,1,4/
+
+
+      contains
+
+         integer function getpdsindex(number)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getpdsindex
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
+!
+! ABSTRACT: This function returns the index of specified Product
+!   Definition Template 4.NN (NN=number) in array templates.
+!
+! PROGRAM HISTORY LOG:
+! 2001-06-28  Gilbert
+!
+! USAGE:    index=getpdsindex(number)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Product Definition
+!                Template 4.NN that is being requested.
+!
+! RETURNS:  Index of PDT 4.NN in array templates, if template exists.
+!           = -1, otherwise.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number
+
+           getpdsindex=-1
+
+           do j=1,MAXTEMP
+              if (number.eq.templates(j)%template_num) then
+                 getpdsindex=j
+                 return
+              endif
+           enddo
+
+         end function
+
+
+
+
+         subroutine getpdstemplate(number,nummap,map,needext,iret)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getpdstemplate 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
+!
+! ABSTRACT: This subroutine returns PDS template information for a 
+!   specified Product Definition Template 4.NN.
+!   The number of entries in the template is returned along with a map
+!   of the number of octets occupied by each entry.  Also, a flag is
+!   returned to indicate whether the template would need to be extended.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-11  Gilbert
+!
+! USAGE:    CALL getpdstemplate(number,nummap,map,needext,iret)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Product Definition 
+!                Template 4.NN that is being requested.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     nummap   - Number of entries in the Template
+!     map()    - An array containing the number of octets that each 
+!                template entry occupies when packed up into the PDS.
+!     needext  - Logical variable indicating whether the Product Defintion
+!                Template has to be extended.  
+!     ierr     - Error return code.
+!                0 = no error
+!                1 = Undefine Product Template number.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number
+           integer,intent(out) :: nummap,map(*),iret
+           logical,intent(out) :: needext
+
+           iret=0
+
+           index=getpdsindex(number)
+
+           if (index.ne.-1) then
+              nummap=templates(index)%mappdslen
+              needext=templates(index)%needext
+              map(1:nummap)=templates(index)%mappds(1:nummap)
+           else
+             nummap=0
+             needext=.false.
+             print *,'getpdstemplate: PDS Template ',number,
+     &               ' not defined.'
+             iret=1
+           endif
+
+         end subroutine
+
+         subroutine extpdstemplate(number,list,nummap,map)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    extpdstemplate 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
+!
+! ABSTRACT: This subroutine generates the remaining octet map for a
+!   given Product Definition Template, if required.  Some Templates can
+!   vary depending on data values given in an earlier part of the 
+!   Template, and it is necessary to know some of the earlier entry
+!   values to generate the full octet map of the Template.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-11  Gilbert
+!
+! USAGE:    CALL extpdstemplate(number,list,nummap,map)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Product Definition 
+!                Template 4.NN that is being requested.
+!     list()   - The list of values for each entry in the 
+!                the Product Definition Template 4.NN.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     nummap   - Number of entries in the Template
+!     map()    - An array containing the number of octets that each 
+!                template entry occupies when packed up into the GDS.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number,list(*)
+           integer,intent(out) :: nummap,map(*)
+
+           index=getpdsindex(number)
+           if (index.eq.-1) return
+
+           if ( .not. templates(index)%needext ) return
+           nummap=templates(index)%mappdslen
+           map(1:nummap)=templates(index)%mappds(1:nummap)
+
+           if ( number.eq.3 ) then
+              N=list(27)
+              do i=1,N
+                map(nummap+i)=1
+              enddo
+              nummap=nummap+N
+           elseif ( number.eq.4 ) then
+              N=list(26)
+              do i=1,N
+                map(nummap+i)=1
+              enddo
+              nummap=nummap+N
+           elseif ( number.eq.8 ) then
+              if ( list(22).gt.1 ) then
+                do j=2,list(22)
+                  do k=1,6
+                    map(nummap+k)=map(23+k)
+                  enddo
+                  nummap=nummap+6
+                enddo
+              endif
+           elseif ( number.eq.9 ) then
+              if ( list(29).gt.1 ) then
+                do j=2,list(29)
+                  do k=1,6
+                    map(nummap+k)=map(30+k)
+                  enddo
+                  nummap=nummap+6
+                enddo
+              endif
+           elseif ( number.eq.10 ) then
+              if ( list(23).gt.1 ) then
+                do j=2,list(23)
+                  do k=1,6
+                    map(nummap+k)=map(24+k)
+                  enddo
+                  nummap=nummap+6
+                enddo
+              endif
+           elseif ( number.eq.11 ) then
+              if ( list(25).gt.1 ) then
+                do j=2,list(25)
+                  do k=1,6
+                    map(nummap+k)=map(26+k)
+                  enddo
+                  nummap=nummap+6
+                enddo
+              endif
+           elseif ( number.eq.12 ) then
+              if ( list(24).gt.1 ) then
+                do j=2,list(24)
+                  do k=1,6
+                    map(nummap+k)=map(25+k)
+                  enddo
+                  nummap=nummap+6
+                enddo
+              endif
+           elseif ( number.eq.13 ) then
+              if ( list(38).gt.1 ) then
+                do j=2,list(38)
+                  do k=1,6
+                    map(nummap+k)=map(39+k)
+                  enddo
+                  nummap=nummap+6
+                enddo
+              endif
+              N=list(27)
+              do i=1,N
+                map(nummap+i)=1
+              enddo
+              nummap=nummap+N
+           elseif ( number.eq.14 ) then
+              if ( list(37).gt.1 ) then
+                do j=2,list(37)
+                  do k=1,6
+                    map(nummap+k)=map(38+k)
+                  enddo
+                  nummap=nummap+6
+                enddo
+              endif
+              N=list(26)
+              do i=1,N
+                map(nummap+i)=1
+              enddo
+              nummap=nummap+N
+           elseif ( number.eq.30 ) then
+              do j=1,list(5)
+                map(nummap+1)=2
+                map(nummap+2)=2
+                map(nummap+3)=1
+                map(nummap+4)=1
+                map(nummap+5)=4
+                nummap=nummap+5
+              enddo
+           endif
+
+         end subroutine
+
+         integer function getpdtlen(number)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    getpdtlen
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-05-11
+!
+! ABSTRACT: This function returns the initial length (number of entries) in 
+!   the "static" part of specified Product Definition Template 4.number.
+!
+! PROGRAM HISTORY LOG:
+! 2004-05-11  Gilbert
+!
+! USAGE:    CALL getpdtlen(number)
+!   INPUT ARGUMENT LIST:
+!     number   - NN, indicating the number of the Product Definition 
+!                Template 4.NN that is being requested.
+!
+! RETURNS:     Number of entries in the "static" part of PDT 4.number
+!              OR returns 0, if requested template is not found.
+!
+! REMARKS: If user needs the full length of a specific template that
+!    contains additional entries based on values set in the "static" part
+!    of the PDT, subroutine extpdstemplate can be used.
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+           integer,intent(in) :: number
+
+           getpdtlen=0
+
+           index=getpdsindex(number)
+
+           if (index.ne.-1) then
+              getpdtlen=templates(index)%mappdslen
+           endif
+
+         end function
+
+
+      end module
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pngpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pngpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pngpack.F	(revision 2744)
@@ -0,0 +1,158 @@
+      subroutine pngpack(fld,width,height,idrstmpl,cpack,lcpack)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    pngpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2002-12-21
+!
+! ABSTRACT: This subroutine packs up a data field into PNG image format.
+!   After the data field is scaled, and the reference value is subtracted out,
+!   it is treated as a grayscale image and passed to a PNG encoder.
+!   It also fills in GRIB2 Data Representation Template 5.41 or 5.40010 with the
+!   appropriate values.
+!
+! PROGRAM HISTORY LOG:
+! 2002-12-21  Gilbert
+!
+! USAGE:    CALL pngpack(fld,width,height,idrstmpl,cpack,lcpack)
+!   INPUT ARGUMENT LIST:
+!     fld()    - Contains the data values to pack
+!     width    - number of points in the x direction
+!     height   - number of points in the y direction
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.41 or 5.40010
+!                (1) = Reference value - ignored on input
+!                (2) = Binary Scale Factor
+!                (3) = Decimal Scale Factor
+!                (4) = number of bits for each data value - ignored on input
+!                (5) = Original field type - currently ignored on input
+!                      Data values assumed to be reals.
+!
+!   OUTPUT ARGUMENT LIST: 
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.41 or 5.40010
+!                (1) = Reference value - set by pngpack routine.
+!                (2) = Binary Scale Factor - unchanged from input
+!                (3) = Decimal Scale Factor - unchanged from input
+!                (4) = Number of bits containing each grayscale pixel value
+!                (5) = Original field type - currently set = 0 on output.
+!                      Data values assumed to be reals.
+!     cpack    - The packed data field (character*1 array)
+!     lcpack   - length of packed field cpack().
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,intent(in) :: width,height
+      real,intent(in) :: fld(width*height)
+      character(len=1),intent(out) :: cpack(*)
+      integer,intent(inout) :: idrstmpl(*)
+      integer,intent(out) :: lcpack
+
+      real(4) :: ref
+      integer(4) :: iref
+      integer :: ifld(width*height)
+      integer,parameter :: zero=0
+      integer :: enc_png
+      character(len=1),allocatable :: ctemp(:)
+      
+      ndpts=width*height
+      bscale=2.0**real(-idrstmpl(2))
+      dscale=10.0**real(idrstmpl(3))
+!
+!  Find max and min values in the data
+!
+      rmax=fld(1)
+      rmin=fld(1)
+      do j=2,ndpts
+        if (fld(j).gt.rmax) rmax=fld(j)
+        if (fld(j).lt.rmin) rmin=fld(j)
+      enddo
+      maxdif=nint((rmax-rmin)*dscale*bscale)
+!
+!  If max and min values are not equal, pack up field.
+!  If they are equal, we have a constant field, and the reference
+!  value (rmin) is the value for each point in the field and
+!  set nbits to 0.
+!
+      if (rmin.ne.rmax .AND. maxdif.ne.0) then
+        !
+        !  Determine which algorithm to use based on user-supplied 
+        !  binary scale factor and number of bits.
+        !
+        if (idrstmpl(2).eq.0) then
+           !
+           !  No binary scaling and calculate minimum number of 
+           !  bits in which the data will fit.
+           !
+           imin=nint(rmin*dscale)
+           imax=nint(rmax*dscale)
+           maxdif=imax-imin
+           temp=alog(real(maxdif+1))/alog(2.0)
+           nbits=ceiling(temp)
+           rmin=real(imin)
+           !   scale data
+           do j=1,ndpts
+             ifld(j)=nint(fld(j)*dscale)-imin
+           enddo
+        else
+           !
+           !  Use binary scaling factor and calculate minimum number of 
+           !  bits in which the data will fit.
+           !
+           rmin=rmin*dscale
+           rmax=rmax*dscale
+           maxdif=nint((rmax-rmin)*bscale)
+           temp=alog(real(maxdif+1))/alog(2.0)
+           nbits=ceiling(temp)
+           !   scale data
+           do j=1,ndpts
+             ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale)
+           enddo
+        endif
+        !
+        !  Pack data into full octets, then do PNG encode.
+        !  and calculate the length of the packed data in bytes
+        !
+        if (nbits.le.8) then
+            nbits=8
+        elseif (nbits.le.16) then
+            nbits=16
+        elseif (nbits.le.24) then
+            nbits=24
+        else 
+            nbits=32
+        endif
+        nbytes=(nbits/8)*ndpts
+        allocate(ctemp(nbytes))
+        call g2lib_sbytes(ctemp,ifld,0,nbits,0,ndpts)
+        !
+        !  Encode data into PNG Format.
+        !
+        lcpack=enc_png(ctemp,width,height,nbits,cpack)
+        if (lcpack.le.0) then
+           print *,'pngpack: ERROR Encoding PNG = ',lcpack
+        endif
+        deallocate(ctemp)
+
+      else
+        nbits=0
+        lcpack=0
+      endif
+
+!
+!  Fill in ref value and number of bits in Template 5.0
+!
+      call mkieee(rmin,ref,1)   ! ensure reference value is IEEE format
+!      call g2lib_gbyte(ref,idrstmpl(1),0,32)
+      iref=transfer(ref,iref)
+      idrstmpl(1)=iref
+      idrstmpl(4)=nbits
+      idrstmpl(5)=0         ! original data were reals
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pngunpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pngunpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/pngunpack.F	(revision 2744)
@@ -0,0 +1,70 @@
+      subroutine pngunpack(cpack,len,idrstmpl,ndpts,fld)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    pngunpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2000-06-21
+!
+! ABSTRACT: This subroutine unpacks a data field that was packed into a
+!   PNG image format 
+!   using info from the GRIB2 Data Representation Template 5.41 or 5.40010.
+!
+! PROGRAM HISTORY LOG:
+! 2000-06-21  Gilbert
+!
+! USAGE:    CALL pngunpack(cpack,len,idrstmpl,ndpts,fld)
+!   INPUT ARGUMENT LIST:
+!     cpack    - The packed data field (character*1 array)
+!     len      - length of packed field cpack().
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.41 or 5.40010
+!     ndpts    - The number of data values to unpack
+!
+!   OUTPUT ARGUMENT LIST:
+!     fld()    - Contains the unpacked data values
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cpack(len)
+      integer,intent(in) :: ndpts,len
+      integer,intent(in) :: idrstmpl(*)
+      real,intent(out) :: fld(ndpts)
+
+      integer :: ifld(ndpts)
+      character(len=1),allocatable :: ctemp(:)
+      integer(4) :: ieee
+      real :: ref,bscale,dscale
+      integer :: dec_png,width,height
+
+      ieee = idrstmpl(1)
+      call rdieee(ieee,ref,1)
+      bscale = 2.0**real(idrstmpl(2))
+      dscale = 10.0**real(-idrstmpl(3))
+      nbits = idrstmpl(4)
+      itype = idrstmpl(5)
+!
+!  if nbits equals 0, we have a constant field where the reference value
+!  is the data value at each gridpoint
+!
+      if (nbits.ne.0) then
+         allocate(ctemp(ndpts*4))
+         iret=dec_png(cpack,width,height,ctemp)
+         call g2lib_gbytes(ctemp,ifld,0,nbits,0,ndpts)
+         deallocate(ctemp)
+         do j=1,ndpts
+           fld(j)=((real(ifld(j))*bscale)+ref)*dscale
+         enddo
+      else
+         do j=1,ndpts
+           fld(j)=ref
+         enddo
+      endif
+
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/proto.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/proto.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/proto.h	(revision 2744)
@@ -0,0 +1,24 @@
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define MOVA2I mova2i
+#      define DEC_JPEG2000 dec_jpeg2000
+#      define ENC_JPEG2000 enc_jpeg2000
+#      define ENC_PNG enc_png
+#      define DEC_PNG dec_png
+# else
+#   ifdef F2CSTYLE
+#      define MOVA2I mova2i__
+#      define DEC_JPEG2000 dec_jpeg2000__
+#      define ENC_JPEG2000 enc_jpeg2000__
+#      define ENC_PNG enc_png__
+#      define DEC_PNG dec_png__
+#   else
+#      define MOVA2I mova2i_
+#      define DEC_JPEG2000 dec_jpeg2000_
+#      define ENC_JPEG2000 enc_jpeg2000_
+#      define ENC_PNG enc_png_
+#      define DEC_PNG dec_png_
+#   endif
+# endif
+#endif
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/putgb2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/putgb2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/putgb2.F	(revision 2744)
@@ -0,0 +1,273 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE PUTGB2(LUGB,GFLD,IRET)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: PUTGB2         PACKS AND WRITES A GRIB2 MESSAGE
+C   PRGMMR: GILBERT          ORG: W/NP11     DATE: 2002-04-22
+C
+C ABSTRACT: PACKS A SINGLE FIELD INTO A GRIB2 MESSAGE
+C   AND WRITES OUT THAT MESSAGE TO THE FILE ASSOCIATED WITH UNIT LUGB.
+C   NOTE THAT FILE/UNIT LUGB SHOULD BE OPENED WOTH A CALL TO 
+C   SUBROUTINE BAOPENW BEFORE THIS ROUTINE IS CALLED.
+C
+C   The information to be packed into the GRIB field
+C   is stored in a derived type variable, gfld.
+C   Gfld is of type gribfield, which is defined
+C   in module grib_mod, so users of this routine will need to include
+C   the line "USE GRIB_MOD" in their calling routine.  Each component of the
+C   gribfield type is described in the INPUT ARGUMENT LIST section below.
+C
+C PROGRAM HISTORY LOG:
+C 2002-04-22  GILBERT  
+C 2005-02-28  GILBERT   - Changed dimension of array cgrib to be a multiple
+C                         of gfld%ngrdpts instead of gfld%ndpts.
+C
+C USAGE:    CALL PUTGB2(LUGB,GFLD,IRET)
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
+C                  FILE MUST BE OPENED WITH BAOPEN OR BAOPENW BEFORE CALLING 
+C                  THIS ROUTINE.
+C     gfld - derived type gribfield ( defined in module grib_mod )
+C            ( NOTE: See Remarks Section )
+C        gfld%version = GRIB edition number ( currently 2 )
+C        gfld%discipline = Message Discipline ( see Code Table 0.0 )
+C        gfld%idsect() = Contains the entries in the Identification
+C                        Section ( Section 1 )
+C                        This element is actually a pointer to an array
+C                        that holds the data.
+C            gfld%idsect(1)  = Identification of originating Centre
+C                                    ( see Common Code Table C-1 )
+C                             7 - US National Weather Service
+C            gfld%idsect(2)  = Identification of originating Sub-centre
+C            gfld%idsect(3)  = GRIB Master Tables Version Number
+C                                    ( see Code Table 1.0 )
+C                             0 - Experimental
+C                             1 - Initial operational version number
+C            gfld%idsect(4)  = GRIB Local Tables Version Number
+C                                    ( see Code Table 1.1 )
+C                             0     - Local tables not used
+C                             1-254 - Number of local tables version used
+C            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
+C                             0 - Analysis
+C                             1 - Start of forecast
+C                             2 - Verifying time of forecast
+C                             3 - Observation time
+C            gfld%idsect(6)  = Year ( 4 digits )
+C            gfld%idsect(7)  = Month
+C            gfld%idsect(8)  = Day
+C            gfld%idsect(9)  = Hour
+C            gfld%idsect(10)  = Minute
+C            gfld%idsect(11)  = Second
+C            gfld%idsect(12)  = Production status of processed data
+C                                    ( see Code Table 1.3 )
+C                              0 - Operational products
+C                              1 - Operational test products
+C                              2 - Research products
+C                              3 - Re-analysis products
+C            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
+C                              0  - Analysis products
+C                              1  - Forecast products
+C                              2  - Analysis and forecast products
+C                              3  - Control forecast products
+C                              4  - Perturbed forecast products
+C                              5  - Control and perturbed forecast products
+C                              6  - Processed satellite observations
+C                              7  - Processed radar observations
+C        gfld%idsectlen = Number of elements in gfld%idsect().
+C        gfld%local() = Pointer to character array containing contents
+C                       of Local Section 2, if included
+C        gfld%locallen = length of array gfld%local()
+C        gfld%ifldnum = field number within GRIB message
+C        gfld%griddef = Source of grid definition (see Code Table 3.0)
+C                      0 - Specified in Code table 3.1
+C                      1 - Predetermined grid Defined by originating centre
+C        gfld%ngrdpts = Number of grid points in the defined grid.
+C        gfld%numoct_opt = Number of octets needed for each
+C                          additional grid points definition.
+C                          Used to define number of
+C                          points in each row ( or column ) for
+C                          non-regular grids.
+C                          = 0, if using regular grid.
+C        gfld%interp_opt = Interpretation of list for optional points
+C                          definition.  (Code Table 3.11)
+C        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
+C        gfld%igdtmpl() = Contains the data values for the specified Grid
+C                         Definition Template ( NN=gfld%igdtnum ).  Each
+C                         element of this integer array contains an entry (in
+C                         the order specified) of Grid Defintion Template 3.NN
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
+C                       entries in Grid Defintion Template 3.NN
+C                       ( NN=gfld%igdtnum ).
+C        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
+C                          contains the number of grid points contained in
+C                          each row ( or column ).  (part of Section 3)
+C                          This element is actually a pointer to an array
+C                          that holds the data.  This pointer is nullified
+C                          if gfld%numoct_opt=0.
+C        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
+C                       in array ideflist.  i.e. number of rows ( or columns )
+C                       for which optional grid points are defined.  This value
+C                       is set to zero, if gfld%numoct_opt=0.
+C        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
+C        gfld%ipdtmpl() = Contains the data values for the specified Product
+C                         Definition Template ( N=gfdl%ipdtnum ).  Each element
+C                         of this integer array contains an entry (in the
+C                         order specified) of Product Defintion Template 4.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
+C                       entries in Product Defintion Template 4.N
+C                       ( N=gfdl%ipdtnum ).
+C        gfld%coord_list() = Real array containing floating point values
+C                            intended to document the vertical discretisation
+C                            associated to model data on hybrid coordinate
+C                            vertical levels.  (part of Section 4)
+C                            This element is actually a pointer to an array
+C                            that holds the data.
+C        gfld%num_coord = number of values in array gfld%coord_list().
+C        gfld%ndpts = Number of data points unpacked and returned.
+C        gfld%idrtnum = Data Representation Template Number
+C                       ( see Code Table 5.0)
+C        gfld%idrtmpl() = Contains the data values for the specified Data
+C                         Representation Template ( N=gfld%idrtnum ).  Each
+C                         element of this integer array contains an entry
+C                         (in the order specified) of Product Defintion
+C                         Template 5.N.
+C                         This element is actually a pointer to an array
+C                         that holds the data.
+C        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
+C                       of entries in Data Representation Template 5.N
+C                       ( N=gfld%idrtnum ).
+C        gfld%unpacked = logical value indicating whether the bitmap and
+C                        data values were unpacked.  If false,
+C                        gfld%bmap and gfld%fld pointers are nullified.
+C        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
+C                     0 = bitmap applies and is included in Section 6.
+C                     1-253 = Predefined bitmap applies
+C                     254 = Previously defined bitmap applies to this field
+C                     255 = Bit map does not apply to this product.
+C        gfld%bmap() = Logical*1 array containing decoded bitmap,
+C                      if ibmap=0 or ibap=254.  Otherwise nullified.
+C                      This element is actually a pointer to an array
+C                      that holds the data.
+C        gfld%fld() = Array of gfld%ndpts unpacked data points.
+C                     This element is actually a pointer to an array
+C                     that holds the data.
+C
+C   OUTPUT ARGUMENTS:
+C     IRET         INTEGER RETURN CODE
+C                    0      ALL OK
+C                    2      MEMORY ALLOCATION ERROR
+C                    10     No Section 1 info available
+C                    11     No Grid Definition Template info available
+C                    12     Missing some required data field info
+C
+C SUBPROGRAMS CALLED:
+C   gribcreate     Start a new grib2 message
+C   addlocal       Add local section to a GRIB2 message
+C   addgrid        Add grid info to a GRIB2 message
+C   addfield       Add data field to a GRIB2 message
+C   gribend        End GRIB2 message
+C
+C REMARKS: 
+C
+C   Note that derived type gribfield contains pointers to many
+C   arrays of data.  The memory for these arrays is allocated
+C   when the values in the arrays are set, to help minimize
+C   problems with array overloading.  Because of this users
+C   are encouraged to free up this memory, when it is no longer
+C   needed, by an explicit call to subroutine gf_free.
+C   ( i.e.   CALL GF_FREE(GFLD) )
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN 90
+C
+C$$$
+      USE GRIB_MOD
+
+      INTEGER,INTENT(IN) :: LUGB
+      TYPE(GRIBFIELD),INTENT(IN) :: GFLD
+      INTEGER,INTENT(OUT) :: IRET
+
+      CHARACTER(LEN=1),ALLOCATABLE,DIMENSION(:) :: CGRIB
+      integer :: listsec0(2)=(/0,2/)
+      integer :: igds(5)=(/0,0,0,0,0/)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  ALLOCATE ARRAY FOR GRIB2 FIELD
+      lcgrib=gfld%ngrdpts*4
+      allocate(cgrib(lcgrib),stat=is)
+      if ( is.ne.0 ) then
+         print *,'putgb2: cannot allocate memory. ',is
+         iret=2
+      endif
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  CREATE NEW MESSAGE
+      listsec0(1)=gfld%discipline
+      listsec0(2)=gfld%version
+      if ( associated(gfld%idsect) ) then
+         call gribcreate(cgrib,lcgrib,listsec0,gfld%idsect,ierr)
+         if (ierr.ne.0) then
+            write(6,*) 'putgb2: ERROR creating new GRIB2 field = ',ierr
+         endif
+      else
+         print *,'putgb2: No Section 1 info available. '
+         iret=10
+         deallocate(cgrib)
+         return
+      endif
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  ADD LOCAL USE SECTION TO GRIB2 MESSAGE
+      if ( associated(gfld%local).AND.gfld%locallen.gt.0 ) then
+         call addlocal(cgrib,lcgrib,gfld%local,gfld%locallen,ierr)
+         if (ierr.ne.0) then
+            write(6,*) 'putgb2: ERROR adding local info = ',ierr
+         endif
+      endif
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  ADD GRID TO GRIB2 MESSAGE
+      igds(1)=gfld%griddef
+      igds(2)=gfld%ngrdpts
+      igds(3)=gfld%numoct_opt
+      igds(4)=gfld%interp_opt
+      igds(5)=gfld%igdtnum
+      if ( associated(gfld%igdtmpl) ) then
+         call addgrid(cgrib,lcgrib,igds,gfld%igdtmpl,gfld%igdtlen,
+     &                gfld%list_opt,gfld%num_opt,ierr)
+         if (ierr.ne.0) then
+            write(6,*) 'putgb2: ERROR adding grid info = ',ierr
+         endif
+      else
+         print *,'putgb2: No GDT info available. '
+         iret=11
+         deallocate(cgrib)
+         return
+      endif
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  ADD DATA FIELD TO GRIB2 MESSAGE
+      if ( associated(gfld%ipdtmpl).AND.
+     &     associated(gfld%idrtmpl).AND.
+     &     associated(gfld%fld) ) then
+         call addfield(cgrib,lcgrib,gfld%ipdtnum,gfld%ipdtmpl,
+     &                 gfld%ipdtlen,gfld%coord_list,gfld%num_coord,
+     &                 gfld%idrtnum,gfld%idrtmpl,gfld%idrtlen,
+     &                 gfld%fld,gfld%ngrdpts,gfld%ibmap,gfld%bmap,
+     &                 ierr)
+         if (ierr.ne.0) then
+            write(6,*) 'putgb2: ERROR adding data field = ',ierr
+         endif
+      else
+         print *,'putgb2: Missing some field info. '
+         iret=12
+         deallocate(cgrib)
+         return
+      endif
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  CLOSE GRIB2 MESSAGE AND WRITE TO FILE
+      call gribend(cgrib,lcgrib,lengrib,ierr)
+      call wryte(lugb,lengrib,cgrib)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      deallocate(cgrib)
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/rdieee.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/rdieee.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/rdieee.F	(revision 2744)
@@ -0,0 +1,79 @@
+      subroutine rdieee(rieee,a,num)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    rdieee 
+!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-09
+!
+! ABSTRACT: This subroutine reads a list of real values in 
+!   32-bit IEEE floating point format.
+!
+! PROGRAM HISTORY LOG:
+! 2000-05-09  Gilbert
+!
+! USAGE:    CALL rdieee(rieee,a,num)
+!   INPUT ARGUMENT LIST:
+!     rieee    - Input array of floating point values in 32-bit IEEE format.
+!     num      - Number of floating point values to convert.
+!
+!   OUTPUT ARGUMENT LIST:      
+!     a        - Output array of real values.
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      real(4),intent(in) :: rieee(num)
+      real,intent(out) :: a(num)
+      integer,intent(in) :: num
+
+      integer(4) :: ieee
+
+      real,save :: two23
+      real,save :: two126
+      integer,save :: once=0
+
+      if ( once .EQ. 0 ) then
+         once=1
+         two23=scale(1.0,-23)
+         two126=scale(1.0,-126)
+      endif
+
+      do j=1,num
+!
+!  Transfer IEEE bit string to integer variable
+!
+        ieee=transfer(rieee(j),ieee)
+!
+!  Extract sign bit, exponent, and mantissa
+!
+        isign=ibits(ieee,31,1)
+        iexp=ibits(ieee,23,8)
+        imant=ibits(ieee,0,23)
+        sign=1.0
+        if (isign.eq.1) sign=-1.0
+        
+        if ( (iexp.gt.0).and.(iexp.lt.255) ) then
+          temp=2.0**(iexp-127)
+          a(j)=sign*temp*(1.0+(two23*real(imant)))
+
+        elseif ( iexp.eq.0 ) then
+          if ( imant.ne.0 ) then
+            a(j)=sign*two126*two23*real(imant)
+          else
+            a(j)=sign*0.0
+          endif
+
+        elseif ( iexp.eq.255 ) then
+          a(j)=sign*huge(a(j))
+
+        endif
+
+      enddo
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/realloc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/realloc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/realloc.F	(revision 2744)
@@ -0,0 +1,125 @@
+      module re_alloc
+
+      interface realloc
+         module procedure realloc_c1
+         module procedure realloc_r
+         module procedure realloc_i
+!!         subroutine realloc_c1(c,n,m,istat)
+!!            character(len=1),pointer,dimension(:) :: c
+!!            integer :: n,m
+!!            integer :: istat
+!!         end subroutine
+!!         subroutine realloc_r(c,n,m,istat)
+!!            real,pointer,dimension(:) :: c
+!!            integer :: n,m
+!!            integer :: istat
+!!         end subroutine
+!!         subroutine realloc_i(c,n,m,istat)
+!!            integer,pointer,dimension(:) :: c
+!!            integer :: n,m
+!!            integer :: istat
+!!         end subroutine
+      end interface
+
+      contains
+
+         subroutine realloc_c1(c,n,m,istat)
+            character(len=1),pointer,dimension(:) :: c
+            integer,intent(in) :: n,m
+            integer,intent(out) :: istat
+            integer :: num
+            character(len=1),pointer,dimension(:) :: tmp
+
+            istat=0
+            if ( (n<0) .OR. (m<=0) ) then
+               istat=10
+               return
+            endif
+ 
+            if ( .not. associated(c) ) then
+               allocate(c(m),stat=istat)   ! allocate new memory
+               return
+            endif
+
+            tmp=>c                      ! save pointer to original mem
+            nullify(c)
+            allocate(c(m),stat=istat)   ! allocate new memory
+            if ( istat /= 0 ) then
+               c=>tmp
+               return
+            endif
+            if ( n /= 0 ) then
+               num=min(n,m)
+               c(1:num)=tmp(1:num)      ! copy data from orig mem to new loc.
+            endif
+            deallocate(tmp)             ! deallocate original memory
+            return
+         end subroutine
+
+         subroutine realloc_r(c,n,m,istat)
+            real,pointer,dimension(:) :: c
+            integer,intent(in) :: n,m
+            integer,intent(out) :: istat
+            integer :: num
+            real,pointer,dimension(:) :: tmp
+
+            istat=0
+            if ( (n<0) .OR. (m<=0) ) then
+               istat=10
+               return
+            endif
+ 
+            if ( .not. associated(c) ) then
+               allocate(c(m),stat=istat)   ! allocate new memory
+               return
+            endif
+
+            tmp=>c                      ! save pointer to original mem
+            nullify(c)
+            allocate(c(m),stat=istat)   ! allocate new memory
+            if ( istat /= 0 ) then
+               c=>tmp
+               return
+            endif
+            if ( n /= 0 ) then
+               num=min(n,m)
+               c(1:num)=tmp(1:num)      ! copy data from orig mem to new loc.
+            endif
+            deallocate(tmp)             ! deallocate original memory
+            return
+         end subroutine
+
+         subroutine realloc_i(c,n,m,istat)
+            integer,pointer,dimension(:) :: c
+            integer,intent(in) :: n,m
+            integer,intent(out) :: istat
+            integer :: num
+            integer,pointer,dimension(:) :: tmp
+
+            istat=0
+            if ( (n<0) .OR. (m<=0) ) then
+               istat=10
+               return
+            endif
+ 
+            if ( .not. associated(c) ) then
+               allocate(c(m),stat=istat)   ! allocate new memory
+               return
+            endif
+
+            tmp=>c                      ! save pointer to original mem
+            nullify(c)
+            allocate(c(m),stat=istat)   ! allocate new memory
+            if ( istat /= 0 ) then
+               c=>tmp
+               return
+            endif
+            if ( n /= 0 ) then
+               num=min(n,m)
+               c(1:num)=tmp(1:num)      ! copy data from orig mem to new loc.
+            endif
+            deallocate(tmp)             ! deallocate original memory
+            return
+         end subroutine
+
+      end module re_alloc
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/reduce.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/reduce.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/reduce.F	(revision 2744)
@@ -0,0 +1,343 @@
+      SUBROUTINE REDUCE(KFILDO,JMIN,JMAX,LBIT,NOV,LX,NDG,IBIT,JBIT,KBIT,
+     1                  NOVREF,IBXX2,IER)            
+C
+C        NOVEMBER 2001   GLAHN   TDL   GRIB2
+C        MARCH    2002   GLAHN   COMMENT IER = 715
+C        MARCH    2002   GLAHN   MODIFIED TO ACCOMMODATE LX=1 ON ENTRY
+C
+C        PURPOSE
+C            DETERMINES WHETHER THE NUMBER OF GROUPS SHOULD BE
+C            INCREASED IN ORDER TO REDUCE THE SIZE OF THE LARGE
+C            GROUPS, AND TO MAKE THAT ADJUSTMENT.  BY REDUCING THE
+C            SIZE OF THE LARGE GROUPS, LESS BITS MAY BE NECESSARY
+C            FOR PACKING THE GROUP SIZES AND ALL THE INFORMATION
+C            ABOUT THE GROUPS.
+C
+C            THE REFERENCE FOR NOV( ) WAS REMOVED IN THE CALLING
+C            ROUTINE SO THAT KBIT COULD BE DETERMINED.  THIS
+C            FURNISHES A STARTING POINT FOR THE ITERATIONS IN REDUCE.
+C            HOWEVER, THE REFERENCE MUST BE CONSIDERED.
+C
+C        DATA SET USE 
+C           KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) 
+C
+C        VARIABLES IN CALL SEQUENCE 
+C              KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE.  (INPUT)
+C             JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX).  IT IS
+C                       POSSIBLE AFTER SPLITTING THE GROUPS, JMIN( )
+C                       WILL NOT BE THE MINIMUM OF THE NEW GROUP.
+C                       THIS DOESN'T MATTER; JMIN( ) IS REALLY THE
+C                       GROUP REFERENCE AND DOESN'T HAVE TO BE THE
+C                       SMALLEST VALUE.  (INPUT/OUTPUT)
+C             JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX). 
+C                       (INPUT/OUTPUT)
+C             LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP
+C                       (J=1,LX).  (INPUT/OUTPUT)
+C              NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX).
+C                       (INPUT/OUTPUT)
+C                  LX = THE NUMBER OF GROUPS.  THIS WILL BE INCREASED
+C                       IF GROUPS ARE SPLIT.  (INPUT/OUTPUT)
+C                 NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND
+C                       NOV( ).  (INPUT)
+C                IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J)
+C                       VALUES, J=1,LX.  (INPUT)
+C                JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J)
+C                       VALUES, J=1,LX.  (INPUT)
+C                KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J)
+C                       VALUES, J=1,LX.  IF THE GROUPS ARE SPLIT, KBIT
+C                       IS REDUCED.  (INPUT/OUTPUT)
+C              NOVREF = REFERENCE VALUE FOR NOV( ).  (INPUT)
+C            IBXX2(J) = 2**J (J=0,30).  (INPUT)
+C                 IER = ERROR RETURN.  (OUTPUT)
+C                         0 = GOOD RETURN.
+C                       714 = PROBLEM IN ALGORITHM.  REDUCE ABORTED.
+C                       715 = NGP NOT LARGE ENOUGH.  REDUCE ABORTED.
+C           NTOTBT(J) = THE TOTAL BITS USED FOR THE PACKING BITS J
+C                       (J=1,30).  (INTERNAL)
+C            NBOXJ(J) = NEW BOXES NEEDED FOR THE PACKING BITS J
+C                       (J=1,30).  (INTERNAL)
+C           NEWBOX(L) = NUMBER OF NEW BOXES (GROUPS) FOR EACH ORIGINAL
+C                       GROUP (L=1,LX) FOR THE CURRENT J.  (AUTOMATIC)
+C                       (INTERNAL)
+C          NEWBOXP(L) = SAME AS NEWBOX( ) BUT FOR THE PREVIOUS J.
+C                       THIS ELIMINATES RECOMPUTATION.  (AUTOMATIC)
+C                       (INTERNAL)
+C               CFEED = CONTAINS THE CHARACTER REPRESENTATION
+C                       OF A PRINTER FORM FEED.  (CHARACTER) (INTERNAL)
+C               IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER
+C                       FORM FEED.  (INTERNAL)
+C              IORIGB = THE ORIGINAL NUMBER OF BITS NECESSARY
+C                       FOR THE GROUP VALUES.  (INTERNAL)
+C        1         2         3         4         5         6         7 X
+C
+C        NON SYSTEM SUBROUTINES CALLED 
+C           NONE
+c
+      CHARACTER*1 CFEED
+C
+      DIMENSION JMIN(NDG),JMAX(NDG),LBIT(NDG),NOV(NDG)
+      DIMENSION NEWBOX(NDG),NEWBOXP(NDG)
+C        NEWBOX( ) AND NEWBOXP( ) ARE AUTOMATIC ARRAYS.
+      DIMENSION NTOTBT(31),NBOXJ(31)
+      DIMENSION IBXX2(0:30)
+C
+      DATA IFEED/12/
+C
+      IER=0
+      IF(LX.EQ.1)GO TO 410
+C        IF THERE IS ONLY ONE GROUP, RETURN.
+C
+      CFEED=CHAR(IFEED)
+C
+C        INITIALIZE NUMBER OF NEW BOXES PER GROUP TO ZERO.
+C
+      DO 110 L=1,LX
+         NEWBOX(L)=0
+ 110  CONTINUE
+C
+C        INITIALIZE NUMBER OF TOTAL NEW BOXES PER J TO ZERO.
+C
+      DO 112 J=1,31
+         NTOTBT(J)=999999999
+         NBOXJ(J)=0
+ 112  CONTINUE
+C
+      IORIGB=(IBIT+JBIT+KBIT)*LX
+C        IBIT = BITS TO PACK THE JMIN( ).
+C        JBIT = BITS TO PACK THE LBIT( ).
+C        KBIT = BITS TO PACK THE NOV( ).
+C        LX = NUMBER OF GROUPS.
+         NTOTBT(KBIT)=IORIGB
+C           THIS IS THE VALUE OF TOTAL BITS FOR THE ORIGINAL LX
+C           GROUPS, WHICH REQUIRES KBITS TO PACK THE GROUP
+C           LENGHTS.  SETTING THIS HERE MAKES ONE LESS LOOPS
+C           NECESSARY BELOW.
+C
+C        COMPUTE BITS NOW USED FOR THE PARAMETERS DEFINED.
+C
+C        DETERMINE OTHER POSSIBILITES BY INCREASING LX AND DECREASING
+C        NOV( ) WITH VALUES GREATER THAN THRESHOLDS.  ASSUME A GROUP IS
+C        SPLIT INTO 2 OR MORE GROUPS SO THAT KBIT IS REDUCED WITHOUT
+C        CHANGING IBIT OR JBIT.
+C
+      JJ=0
+C
+      DO 200 J=MIN(30,KBIT-1),2,-1
+C           VALUES GE KBIT WILL NOT REQUIRE SPLITS.  ONCE THE TOTAL
+C           BITS START INCREASING WITH DECREASING J, STOP.  ALSO, THE
+C           NUMBER OF BITS REQUIRED IS KNOWN FOR KBITS = NTOTBT(KBIT).
+C
+         NEWBOXT=0
+C
+         DO 190 L=1,LX
+C
+            IF(NOV(L).LT.IBXX2(J))THEN
+               NEWBOX(L)=0
+C                 NO SPLITS OR NEW BOXES.
+               GO TO 190
+            ELSE
+               NOVL=NOV(L)
+C
+               M=(NOV(L)-1)/(IBXX2(J)-1)+1
+C                 M IS FOUND BY SOLVING THE EQUATION BELOW FOR M:
+C                 (NOV(L)+M-1)/M LT IBXX2(J)
+C                 M GT (NOV(L)-1)/(IBXX2(J)-1)
+C                 SET M = (NOV(L)-1)/(IBXX2(J)-1)+1
+ 130           NOVL=(NOV(L)+M-1)/M
+C                 THE +M-1 IS NECESSARY.  FOR INSTANCE, 15 WILL FIT
+C                 INTO A BOX 4 BITS WIDE, BUT WON'T DIVIDE INTO
+C                 TWO BOXES 3 BITS WIDE EACH.
+C      
+               IF(NOVL.LT.IBXX2(J))THEN
+                  GO TO 185
+               ELSE
+                  M=M+1
+C***                  WRITE(KFILDO,135)L,NOV(L),NOVL,M,J,IBXX2(J)
+C*** 135              FORMAT(/' AT 135--L,NOV(L),NOVL,M,J,IBXX2(J)',6I10)               
+                  GO TO 130
+               ENDIF
+C
+C                 THE ABOVE DO LOOP WILL NEVER COMPLETE.
+            ENDIF
+C
+ 185        NEWBOX(L)=M-1
+            NEWBOXT=NEWBOXT+M-1
+ 190     CONTINUE
+C
+         NBOXJ(J)=NEWBOXT
+         NTOTPR=NTOTBT(J+1)
+         NTOTBT(J)=(IBIT+JBIT)*(LX+NEWBOXT)+J*(LX+NEWBOXT)
+C
+         IF(NTOTBT(J).GE.NTOTPR)THEN
+            JJ=J+1
+C              THE PLUS IS USED BECAUSE J DECREASES PER ITERATION.
+            GO TO 250
+         ELSE
+C
+C              SAVE THE TOTAL NEW BOXES AND NEWBOX( ) IN CASE THIS
+C              IS THE J TO USE.
+C
+            NEWBOXTP=NEWBOXT
+C
+            DO 195 L=1,LX
+               NEWBOXP(L)=NEWBOX(L)
+ 195        CONTINUE
+C
+C           WRITE(KFILDO,197)NEWBOXT,IBXX2(J)
+C197        FORMAT(/' *****************************************'
+C    1             /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL',
+C    2              I10,' FOR GROUP MAXSIZE PLUS 1 ='I10
+C    3             /' *****************************************')
+C           WRITE(KFILDO,198) (NEWBOX(L),L=1,LX)
+C198        FORMAT(/' '20I6/(' '20I6))
+    
+         ENDIF
+C        
+C205     WRITE(KFILDO,209)KBIT,IORIGB
+C209     FORMAT(/' ORIGINAL BITS WITH KBIT OF',I5,' =',I10)
+C        WRITE(KFILDO,210)(N,N=2,10),(IBXX2(N),N=2,10),
+C    1                    (NTOTBT(N),N=2,10),(NBOXJ(N),N=2,10),
+C    2                    (N,N=11,20),(IBXX2(N),N=11,20),
+C    3                    (NTOTBT(N),N=11,20),(NBOXJ(N),N=11,20),
+C    4                    (N,N=21,30),(IBXX2(N),N=11,20),
+C    5                    (NTOTBT(N),N=21,30),(NBOXJ(N),N=21,30)
+C210     FORMAT(/' THE TOTAL BYTES FOR MAXIMUM GROUP LENGTHS BY ROW'//
+C    1      '   J         = THE NUMBER OF BITS PER GROUP LENGTH'/
+C    2      '   IBXX2(J)  = THE MAXIMUM GROUP LENGTH PLUS 1 FOR THIS J'/
+C    3      '   NTOTBT(J) = THE TOTAL BITS FOR THIS J'/
+C    4      '   NBOXJ(J)  = THE NEW GROUPS FOR THIS J'/
+C    5      4(/10X,9I10)/4(/10I10)/4(/10I10))
+C
+ 200  CONTINUE
+C
+ 250  PIMP=((IORIGB-NTOTBT(JJ))/FLOAT(IORIGB))*100.
+C     WRITE(KFILDO,252)PIMP,KBIT,JJ
+C252  FORMAT(/' PERCENT IMPROVEMENT =',F6.1,
+C    1        ' BY DECREASING GROUP LENGTHS FROM',I4,' TO',I4,' BITS')
+      IF(PIMP.GE.2.)THEN
+C
+C        WRITE(KFILDO,255)CFEED,NEWBOXTP,IBXX2(JJ)
+C255     FORMAT(A1,/' *****************************************'
+C    1             /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL',
+C    2             I10,' FOR GROUP MAXSIZE PLUS 1 ='I10
+C    2             /' *****************************************')
+C        WRITE(KFILDO,256) (NEWBOXP(L),L=1,LX)
+C256     FORMAT(/' '20I6)
+C
+C           ADJUST GROUP LENGTHS FOR MAXIMUM LENGTH OF JJ BITS.
+C           THE MIN PER GROUP AND THE NUMBER OF BITS REQUIRED
+C           PER GROUP ARE NOT CHANGED.  THIS MAY MEAN THAT A
+C           GROUP HAS A MIN (OR REFERENCE) THAT IS NOT ZERO.
+C           THIS SHOULD NOT MATTER TO THE UNPACKER.
+C
+         LXNKP=LX+NEWBOXTP
+C           LXNKP = THE NEW NUMBER OF BOXES
+C  
+         IF(LXNKP.GT.NDG)THEN
+C              DIMENSIONS NOT LARGE ENOUGH.  PROBABLY AN ERROR
+C              OF SOME SORT.  ABORT.
+C           WRITE(KFILDO,257)NDG,LXNPK
+C        1         2         3         4         5         6         7 X
+C257        FORMAT(/' DIMENSIONS OF JMIN, ETC. IN REDUCE =',I8,
+C    1              ' NOT LARGE ENOUGH FOR THE EXPANDED NUMBER OF',
+C    2              ' GROUPS =',I8,'.  ABORT REDUCE.')
+            IER=715
+            GO TO 410
+C              AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE 
+C              WITHOUT CALLING REDUCE.
+         ENDIF
+C
+         LXN=LXNKP
+C           LXN IS THE NUMBER OF THE BOX IN THE NEW SERIES BEING
+C           FILLED.  IT DECREASES PER ITERATION.
+         IBXX2M1=IBXX2(JJ)-1
+C           IBXX2M1 IS THE MAXIMUM NUMBER OF VALUES PER GROUP.
+C
+         DO 300 L=LX,1,-1
+C
+C              THE VALUES IS NOV( ) REPRESENT THOSE VALUES + NOVREF.
+C              WHEN VALUES ARE MOVED TO ANOTHER BOX, EACH VALUE
+C              MOVED TO A NEW BOX REPRESENTS THAT VALUE + NOVREF.
+C              THIS HAS TO BE CONSIDERED IN MOVING VALUES.
+C
+            IF(NEWBOXP(L)*(IBXX2M1+NOVREF)+NOVREF.GT.NOV(L)+NOVREF)THEN
+C                 IF THE ABOVE TEST IS MET, THEN MOVING IBXX2M1 VALUES
+C                 FOR ALL NEW BOXES WILL LEAVE A NEGATIVE NUMBER FOR
+C                 THE LAST BOX.  NOT A TOLERABLE SITUATION.
+               MOVMIN=(NOV(L)-(NEWBOXP(L))*NOVREF)/NEWBOXP(L)
+               LEFT=NOV(L)
+C                 LEFT = THE NUMBER OF VALUES TO MOVE FROM THE ORIGINAL
+C                 BOX TO EACH NEW BOX EXCEPT THE LAST.  LEFT IS THE
+C                 NUMBER LEFT TO MOVE.
+            ELSE
+               MOVMIN=IBXX2M1
+C                 MOVMIN VALUES CAN BE MOVED FOR EACH NEW BOX.
+               LEFT=NOV(L)
+C                 LEFT IS THE NUMBER OF VALUES LEFT TO MOVE.
+            ENDIF
+C
+            IF(NEWBOXP(L).GT.0)THEN
+               IF((MOVMIN+NOVREF)*NEWBOXP(L)+NOVREF.LE.NOV(L)+NOVREF.
+     1          AND.(MOVMIN+NOVREF)*(NEWBOXP(L)+1).GE.NOV(L)+NOVREF)THEN
+                  GO TO 288
+               ELSE
+C***D                 WRITE(KFILDO,287)L,MOVMIN,NOVREF,NEWBOXP(L),NOV(L)
+C***D287              FORMAT(/' AT 287 IN REDUCE--L,MOVMIN,NOVREF,',
+C***D    1                    'NEWBOXP(L),NOV(L)',5I12
+C***D    2                    ' REDUCE ABORTED.')
+C              WRITE(KFILDO,2870)
+C2870          FORMAT(/' AN ERROR IN REDUCE ALGORITHM.  ABORT REDUCE.')
+               IER=714
+               GO TO 410
+C                 AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE 
+C                 WITHOUT CALLING REDUCE.
+               ENDIF
+C
+            ENDIF
+C
+ 288        DO 290 J=1,NEWBOXP(L)+1
+               MOVE=MIN(MOVMIN,LEFT)
+               JMIN(LXN)=JMIN(L)
+               JMAX(LXN)=JMAX(L)
+               LBIT(LXN)=LBIT(L)
+               NOV(LXN)=MOVE
+               LXN=LXN-1
+               LEFT=LEFT-(MOVE+NOVREF)
+C                 THE MOVE OF MOVE VALUES REALLY REPRESENTS A MOVE OF
+C                 MOVE + NOVREF VALUES.
+ 290        CONTINUE
+C
+            IF(LEFT.NE.-NOVREF)THEN
+C***               WRITE(KFILDO,292)L,LXN,MOVE,LXNKP,IBXX2(JJ),LEFT,NOV(L),
+C***     1                          MOVMIN
+C*** 292           FORMAT(' AT 292 IN REDUCE--L,LXN,MOVE,LXNKP,',
+C***     1                'IBXX2(JJ),LEFT,NOV(L),MOVMIN'/8I12)
+            ENDIF
+C     
+ 300     CONTINUE
+C
+         LX=LXNKP
+C           LX IS NOW THE NEW NUMBER OF GROUPS.
+         KBIT=JJ
+C           KBIT IS NOW THE NEW NUMBER OF BITS REQUIRED FOR PACKING
+C           GROUP LENGHTS.
+      ENDIF
+C
+C     WRITE(KFILDO,406)CFEED,LX
+C406  FORMAT(A1,/' *****************************************'
+C    1          /' THE GROUP SIZES NOV( ) AFTER REDUCTION IN SIZE',
+C    2           ' FOR'I10,' GROUPS',
+C    3          /' *****************************************')
+C     WRITE(KFILDO,407) (NOV(J),J=1,LX)
+C407  FORMAT(/' '20I6)
+C     WRITE(KFILDO,408)CFEED,LX
+C408  FORMAT(A1,/' *****************************************'
+C    1          /' THE GROUP MINIMA JMIN( ) AFTER REDUCTION IN SIZE',
+C    2           ' FOR'I10,' GROUPS',
+C    3          /' *****************************************')
+C     WRITE(KFILDO,409) (JMIN(J),J=1,LX)
+C409  FORMAT(/' '20I6)
+C
+ 410  RETURN
+      END
+      
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/simpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/simpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/simpack.F	(revision 2744)
@@ -0,0 +1,180 @@
+      subroutine simpack(fld,ndpts,idrstmpl,cpack,lcpack)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    simpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2000-06-21
+!
+! ABSTRACT: This subroutine packs up a data field using a simple
+!   packing algorithm as defined in the GRIB2 documention.  It
+!   also fills in GRIB2 Data Representation Template 5.0 with the
+!   appropriate values.
+!
+! PROGRAM HISTORY LOG:
+! 2000-06-21  Gilbert
+!
+! USAGE:    CALL simpack(fld,ndpts,idrstmpl,cpack,lcpack)
+!   INPUT ARGUMENT LIST:
+!     fld()    - Contains the data values to pack
+!     ndpts    - The number of data values in array fld()
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.0
+!                (1) = Reference value - ignored on input
+!                (2) = Binary Scale Factor
+!                (3) = Decimal Scale Factor
+!                (4) = Number of bits used to pack data, if value is
+!                      > 0 and  <= 31.
+!                      If this input value is 0 or outside above range
+!                      then the num of bits is calculated based on given 
+!                      data and scale factors.
+!                (5) = Original field type - currently ignored on input
+!                      Data values assumed to be reals.
+!
+!   OUTPUT ARGUMENT LIST: 
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.0
+!                (1) = Reference value - set by simpack routine.
+!                (2) = Binary Scale Factor - unchanged from input
+!                (3) = Decimal Scale Factor - unchanged from input
+!                (4) = Number of bits used to pack data, unchanged from 
+!                      input if value is between 0 and 31.
+!                      If this input value is 0 or outside above range
+!                      then the num of bits is calculated based on given 
+!                      data and scale factors.
+!                (5) = Original field type - currently set = 0 on output.
+!                      Data values assumed to be reals.
+!     cpack    - The packed data field (character*1 array)
+!     lcpack   - length of packed field cpack().
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      integer,intent(in) :: ndpts
+      real,intent(in) :: fld(ndpts)
+      character(len=1),intent(out) :: cpack(*)
+      integer,intent(inout) :: idrstmpl(*)
+      integer,intent(out) :: lcpack
+
+      real(4) :: ref
+      integer(4) :: iref
+      integer :: ifld(ndpts)
+      integer,parameter :: zero=0
+      
+      bscale=2.0**real(-idrstmpl(2))
+      dscale=10.0**real(idrstmpl(3))
+      if (idrstmpl(4).le.0.OR.idrstmpl(4).gt.31) then
+         nbits=0
+      else
+         nbits=idrstmpl(4)
+      endif
+!
+!  Find max and min values in the data
+!
+      rmax=fld(1)
+      rmin=fld(1)
+      do j=2,ndpts
+        if (fld(j).gt.rmax) rmax=fld(j)
+        if (fld(j).lt.rmin) rmin=fld(j)
+      enddo
+!
+!  If max and min values are not equal, pack up field.
+!  If they are equal, we have a constant field, and the reference
+!  value (rmin) is the value for each point in the field and
+!  set nbits to 0.
+!
+      if (rmin.ne.rmax) then
+        !
+        !  Determine which algorithm to use based on user-supplied 
+        !  binary scale factor and number of bits.
+        !
+        if (nbits.eq.0.AND.idrstmpl(2).eq.0) then
+           !
+           !  No binary scaling and calculate minumum number of 
+           !  bits in which the data will fit.
+           !
+           imin=nint(rmin*dscale)
+           imax=nint(rmax*dscale)
+           maxdif=imax-imin
+           temp=alog(real(maxdif+1))/alog(2.0)
+           nbits=ceiling(temp)
+           rmin=real(imin)
+           !   scale data
+           do j=1,ndpts
+             ifld(j)=nint(fld(j)*dscale)-imin
+           enddo
+        elseif (nbits.ne.0.AND.idrstmpl(2).eq.0) then
+           !
+           !  Use minimum number of bits specified by user and
+           !  adjust binary scaling factor to accomodate data.
+           !
+           rmin=rmin*dscale
+           rmax=rmax*dscale
+           maxnum=(2**nbits)-1
+           temp=alog(real(maxnum)/(rmax-rmin))/alog(2.0)
+           idrstmpl(2)=ceiling(-1.0*temp)
+           bscale=2.0**real(-idrstmpl(2))
+           !   scale data
+           do j=1,ndpts
+             ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale)
+           enddo
+        elseif (nbits.eq.0.AND.idrstmpl(2).ne.0) then
+           !
+           !  Use binary scaling factor and calculate minumum number of 
+           !  bits in which the data will fit.
+           !
+           rmin=rmin*dscale
+           rmax=rmax*dscale
+           maxdif=nint((rmax-rmin)*bscale)
+           temp=alog(real(maxdif+1))/alog(2.0)
+           nbits=ceiling(temp)
+           !   scale data
+           do j=1,ndpts
+             ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale)
+           enddo
+        elseif (nbits.ne.0.AND.idrstmpl(2).ne.0) then
+           !
+           !  Use binary scaling factor and use minumum number of 
+           !  bits specified by user.   Dangerous - may loose
+           !  information if binary scale factor and nbits not set
+           !  properly by user.
+           !
+           rmin=rmin*dscale
+           !   scale data
+           do j=1,ndpts
+             ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale)
+           enddo
+        endif
+        !
+        !  Pack data, Pad last octet with Zeros, if necessary,
+        !  and calculate the length of the packed data in bytes
+        !
+        call g2lib_sbytes(cpack,ifld,0,nbits,0,ndpts)
+        nbittot=nbits*ndpts
+        left=8-mod(nbittot,8)
+        if (left.ne.8) then
+          call g2lib_sbyte(cpack,zero,nbittot,left)    ! Pad with zeros to fill Octet
+          nbittot=nbittot+left
+        endif
+        lcpack=nbittot/8
+
+      else
+        nbits=0
+        lcpack=0
+      endif
+
+!
+!  Fill in ref value and number of bits in Template 5.0
+!
+      call mkieee(rmin,ref,1)   ! ensure reference value is IEEE format
+!      call g2lib_gbyte(ref,idrstmpl(1),0,32)
+      iref=transfer(ref,iref)
+      idrstmpl(1)=iref
+      idrstmpl(4)=nbits
+      idrstmpl(5)=0         ! original data were reals
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/simunpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/simunpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/simunpack.F	(revision 2744)
@@ -0,0 +1,65 @@
+      subroutine simunpack(cpack,len,idrstmpl,ndpts,fld)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    simunpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2000-06-21
+!
+! ABSTRACT: This subroutine unpacks a data field that was packed using a 
+!   simple packing algorithm as defined in the GRIB2 documention,
+!   using info from the GRIB2 Data Representation Template 5.0.
+!
+! PROGRAM HISTORY LOG:
+! 2000-06-21  Gilbert
+!
+! USAGE:    CALL simunpack(cpack,len,idrstmpl,ndpts,fld)
+!   INPUT ARGUMENT LIST:
+!     cpack    - The packed data field (character*1 array)
+!     len      - length of packed field cpack().
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.0
+!     ndpts    - The number of data values to unpack
+!
+!   OUTPUT ARGUMENT LIST:
+!     fld()    - Contains the unpacked data values
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cpack(len)
+      integer,intent(in) :: ndpts,len
+      integer,intent(in) :: idrstmpl(*)
+      real,intent(out) :: fld(ndpts)
+
+      integer :: ifld(ndpts)
+      integer(4) :: ieee
+      real :: ref,bscale,dscale
+
+      ieee = idrstmpl(1)
+      call rdieee(ieee,ref,1)
+      bscale = 2.0**real(idrstmpl(2))
+      dscale = 10.0**real(-idrstmpl(3))
+      nbits = idrstmpl(4)
+      itype = idrstmpl(5)
+!
+!  if nbits equals 0, we have a constant field where the reference value
+!  is the data value at each gridpoint
+!
+      if (nbits.ne.0) then
+         call g2lib_gbytes(cpack,ifld,0,nbits,0,ndpts)
+         do j=1,ndpts
+           fld(j)=((real(ifld(j))*bscale)+ref)*dscale
+         enddo
+      else
+         do j=1,ndpts
+           fld(j)=ref
+         enddo
+      endif
+
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/skgb.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/skgb.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/skgb.F	(revision 2744)
@@ -0,0 +1,78 @@
+C-----------------------------------------------------------------------
+      SUBROUTINE SKGB(LUGB,ISEEK,MSEEK,LSKIP,LGRIB)
+C$$$  SUBPROGRAM DOCUMENTATION BLOCK
+C
+C SUBPROGRAM: SKGB           SEARCH FOR NEXT GRIB MESSAGE
+C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 93-11-22
+C
+C ABSTRACT: THIS SUBPROGRAM SEARCHES A FILE FOR THE NEXT GRIB 1 MESSAGE.
+C   A GRIB 1 MESSAGE IS IDENTIFIED BY ITS INDICATOR SECTION, I.E.
+C   AN 8-BYTE SEQUENCE WITH 'GRIB' IN BYTES 1-4 AND 1 IN BYTE 8.
+C   IF FOUND, THE LENGTH OF THE MESSAGE IS DECODED FROM BYTES 5-7.
+C   THE SEARCH IS DONE OVER A GIVEN SECTION OF THE FILE.
+C   THE SEARCH IS TERMINATED IF AN EOF OR I/O ERROR IS ENCOUNTERED.
+C
+C PROGRAM HISTORY LOG:
+C   93-11-22  IREDELL
+C   95-10-31  IREDELL   ADD CALL TO BAREAD 
+C   97-03-14  IREDELL   CHECK FOR '7777'
+C 2001-12-05  GILBERT   MODIFIED TO ALSO LOOK FOR GRIB2 MESSAGES
+C
+C USAGE:    CALL SKGB(LUGB,ISEEK,MSEEK,LSKIP,LGRIB)
+C   INPUT ARGUMENTS:
+C     LUGB         INTEGER LOGICAL UNIT OF INPUT GRIB FILE
+C     ISEEK        INTEGER NUMBER OF BYTES TO SKIP BEFORE SEARCH
+C     MSEEK        INTEGER MAXIMUM NUMBER OF BYTES TO SEARCH
+C   OUTPUT ARGUMENTS:
+C     LSKIP        INTEGER NUMBER OF BYTES TO SKIP BEFORE MESSAGE
+C     LGRIB        INTEGER NUMBER OF BYTES IN MESSAGE (0 IF NOT FOUND)
+C
+C SUBPROGRAMS CALLED:
+C   BAREAD       BYTE-ADDRESSABLE READ
+C   G2LIB_GBYTE         GET INTEGER DATA FROM BYTES
+C
+C ATTRIBUTES:
+C   LANGUAGE: FORTRAN
+C
+C$$$
+      PARAMETER(LSEEK=128)
+      CHARACTER Z(LSEEK)
+      CHARACTER Z4(4)
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      LGRIB=0
+      KS=ISEEK
+      KN=MIN(LSEEK,MSEEK)
+      KZ=LSEEK
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  LOOP UNTIL GRIB MESSAGE IS FOUND
+      DOWHILE(LGRIB.EQ.0.AND.KN.GE.8.AND.KZ.EQ.LSEEK)
+C  READ PARTIAL SECTION
+        CALL BAREAD(LUGB,KS,KN,KZ,Z)
+        KM=KZ-8+1
+        K=0
+C  LOOK FOR 'GRIB...1' IN PARTIAL SECTION
+        DOWHILE(LGRIB.EQ.0.AND.K.LT.KM)
+          CALL G2LIB_GBYTE(Z,I4,(K+0)*8,4*8)
+          CALL G2LIB_GBYTE(Z,I1,(K+7)*8,1*8)
+          IF(I4.EQ.1196575042.AND.(I1.EQ.1.OR.I1.EQ.2)) THEN
+C  LOOK FOR '7777' AT END OF GRIB MESSAGE
+            IF (I1.EQ.1) CALL G2LIB_GBYTE(Z,KG,(K+4)*8,3*8)
+            IF (I1.EQ.2) CALL G2LIB_GBYTE(Z,KG,(K+12)*8,4*8)
+            CALL BAREAD(LUGB,KS+K+KG-4,4,K4,Z4)
+            IF(K4.EQ.4) THEN
+              CALL G2LIB_GBYTE(Z4,I4,0,4*8)
+              IF(I4.EQ.926365495) THEN
+C  GRIB MESSAGE FOUND
+                LSKIP=KS+K
+                LGRIB=KG
+              ENDIF
+            ENDIF
+          ENDIF
+          K=K+1
+        ENDDO
+        KS=KS+KM
+        KN=MIN(LSEEK,ISEEK+MSEEK-KS)
+      ENDDO
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/specpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/specpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/specpack.F	(revision 2744)
@@ -0,0 +1,124 @@
+      subroutine specpack(fld,ndpts,JJ,KK,MM,idrstmpl,cpack,lcpack)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    specpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2002-12-19
+!
+! ABSTRACT: This subroutine packs a spectral data field using the complex
+!   packing algorithm for spherical harmonic data as 
+!   defined in the GRIB2 Data Representation Template 5.51.
+!
+! PROGRAM HISTORY LOG:
+! 2002-12-19  Gilbert
+!
+! USAGE:    CALL specpack(fld,ndpts,JJ,KK,MM,idrstmpl,cpack,lcpack)
+!   INPUT ARGUMENT LIST:
+!     fld()    - Contains the packed data values
+!     ndpts    - The number of data values to pack
+!     JJ       - J - pentagonal resolution parameter
+!     KK       - K - pentagonal resolution parameter
+!     MM       - M - pentagonal resolution parameter
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.51
+!
+!   OUTPUT ARGUMENT LIST:
+!     cpack    - The packed data field (character*1 array)
+!     lcpack   - length of packed field cpack().
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      real,intent(in) :: fld(ndpts)
+      integer,intent(in) :: ndpts,JJ,KK,MM
+      integer,intent(inout) :: idrstmpl(*)
+      character(len=1),intent(out) :: cpack(*)
+      integer,intent(out) :: lcpack
+
+      integer :: ifld(ndpts),Ts,tmplsim(5)
+      real :: bscale,dscale,unpk(ndpts),tfld(ndpts)
+      real,allocatable :: pscale(:)
+
+      bscale = 2.0**real(-idrstmpl(2))
+      dscale = 10.0**real(idrstmpl(3))
+      nbits = idrstmpl(4)
+      Js=idrstmpl(6)
+      Ks=idrstmpl(7)
+      Ms=idrstmpl(8)
+      Ts=idrstmpl(9)
+
+!
+!   Calculate Laplacian scaling factors for each possible wave number.
+!
+      allocate(pscale(JJ+MM))
+      tscale=real(idrstmpl(5))*1E-6
+      do n=Js,JJ+MM
+         pscale(n)=real(n*(n+1))**(tscale)
+      enddo
+!
+!   Separate spectral coeffs into two lists; one to contain unpacked
+!   values within the sub-spectrum Js, Ks, Ms, and the other with values 
+!   outside of the sub-spectrum to be packed.
+!
+      inc=1
+      incu=1
+      incp=1
+      do m=0,MM
+         Nm=JJ      ! triangular or trapezoidal
+         if ( KK .eq. JJ+MM ) Nm=JJ+m          ! rhombodial
+         Ns=Js      ! triangular or trapezoidal
+         if ( Ks .eq. Js+Ms ) Ns=Js+m          ! rhombodial
+         do n=m,Nm
+            if (n.le.Ns .AND. m.le.Ms) then    ! save unpacked value
+               unpk(incu)=fld(inc)         ! real part
+               unpk(incu+1)=fld(inc+1)     ! imaginary part
+               inc=inc+2
+               incu=incu+2
+            else                         ! Save value to be packed and scale
+                                         ! Laplacian scale factor
+               tfld(incp)=fld(inc)*pscale(n)         ! real part
+               tfld(incp+1)=fld(inc+1)*pscale(n)     ! imaginary part
+               inc=inc+2
+               incp=incp+2
+            endif
+         enddo
+      enddo
+
+      deallocate(pscale)
+
+      incu=incu-1
+      if (incu .ne. Ts) then
+         print *,'specpack: Incorrect number of unpacked values ',
+     &           'given:',Ts     
+         print *,'specpack: Resetting idrstmpl(9) to ',incu
+         Ts=incu
+      endif
+!
+!  Add unpacked values to the packed data array in 32-bit IEEE format
+!
+      call mkieee(unpk,cpack,Ts)
+      ipos=4*Ts
+!
+!  Scale and pack the rest of the coefficients
+! 
+      tmplsim(2)=idrstmpl(2)
+      tmplsim(3)=idrstmpl(3)
+      tmplsim(4)=idrstmpl(4)
+      call simpack(tfld,ndpts-Ts,tmplsim,cpack(ipos+1),lcpack)
+      lcpack=lcpack+ipos
+!
+!  Fill in Template 5.51
+!
+      idrstmpl(1)=tmplsim(1)
+      idrstmpl(2)=tmplsim(2)
+      idrstmpl(3)=tmplsim(3)
+      idrstmpl(4)=tmplsim(4)
+      idrstmpl(9)=Ts
+      idrstmpl(10)=1         ! Unpacked spectral data is 32-bit IEEE
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/specunpack.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/specunpack.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/specunpack.F	(revision 2744)
@@ -0,0 +1,107 @@
+      subroutine specunpack(cpack,len,idrstmpl,ndpts,JJ,KK,MM,fld)
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    specunpack
+!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2002-12-19
+!
+! ABSTRACT: This subroutine unpacks a spectral data field that was packed 
+!   using the complex packing algorithm for spherical harmonic data as 
+!   defined in the GRIB2 documention,
+!   using info from the GRIB2 Data Representation Template 5.51.
+!
+! PROGRAM HISTORY LOG:
+! 2002-12-19  Gilbert
+!
+! USAGE:    CALL specunpack(cpack,len,idrstmpl,ndpts,JJ,KK,MM,fld)
+!   INPUT ARGUMENT LIST:
+!     cpack    - The packed data field (character*1 array)
+!     len      - length of packed field cpack().
+!     idrstmpl - Contains the array of values for Data Representation
+!                Template 5.51
+!     ndpts    - The number of data values to unpack
+!     JJ       - J - pentagonal resolution parameter
+!     KK       - K - pentagonal resolution parameter
+!     MM       - M - pentagonal resolution parameter
+!
+!   OUTPUT ARGUMENT LIST:
+!     fld()    - Contains the unpacked data values
+!
+! REMARKS: None
+!
+! ATTRIBUTES:
+!   LANGUAGE: XL Fortran 90
+!   MACHINE:  IBM SP
+!
+!$$$
+
+      character(len=1),intent(in) :: cpack(len)
+      integer,intent(in) :: ndpts,len,JJ,KK,MM
+      integer,intent(in) :: idrstmpl(*)
+      real,intent(out) :: fld(ndpts)
+
+      integer :: ifld(ndpts),Ts
+      integer(4) :: ieee
+      real :: ref,bscale,dscale,unpk(ndpts)
+      real,allocatable :: pscale(:)
+
+      ieee = idrstmpl(1)
+      call rdieee(ieee,ref,1)
+      bscale = 2.0**real(idrstmpl(2))
+      dscale = 10.0**real(-idrstmpl(3))
+      nbits = idrstmpl(4)
+      Js=idrstmpl(6)
+      Ks=idrstmpl(7)
+      Ms=idrstmpl(8)
+      Ts=idrstmpl(9)
+
+      if (idrstmpl(10).eq.1) then           ! unpacked floats are 32-bit IEEE
+         !call g2lib_gbytes(cpack,ifld,0,32,0,Ts)
+         call rdieee(cpack,unpk,Ts)          ! read IEEE unpacked floats
+         iofst=32*Ts
+         call g2lib_gbytes(cpack,ifld,iofst,nbits,0,ndpts-Ts)  ! unpack scaled data
+!
+!   Calculate Laplacian scaling factors for each possible wave number.
+!
+         allocate(pscale(JJ+MM))
+         tscale=real(idrstmpl(5))*1E-6
+         do n=Js,JJ+MM
+            pscale(n)=real(n*(n+1))**(-tscale)
+         enddo
+!
+!   Assemble spectral coeffs back to original order.
+!
+         inc=1
+         incu=1
+         incp=1
+         do m=0,MM
+            Nm=JJ      ! triangular or trapezoidal
+            if ( KK .eq. JJ+MM ) Nm=JJ+m          ! rhombodial
+            Ns=Js      ! triangular or trapezoidal
+            if ( Ks .eq. Js+Ms ) Ns=Js+m          ! rhombodial
+            do n=m,Nm
+               if (n.le.Ns .AND. m.le.Ms) then    ! grab unpacked value
+                  fld(inc)=unpk(incu)         ! real part
+                  fld(inc+1)=unpk(incu+1)     ! imaginary part
+                  inc=inc+2
+                  incu=incu+2
+               else                         ! Calc coeff from packed value
+                  fld(inc)=((real(ifld(incp))*bscale)+ref)*
+     &                      dscale*pscale(n)           ! real part
+                  fld(inc+1)=((real(ifld(incp+1))*bscale)+ref)*
+     &                      dscale*pscale(n)           ! imaginary part
+                  inc=inc+2
+                  incp=incp+2
+               endif
+            enddo
+         enddo
+
+         deallocate(pscale)
+
+      else
+         print *,'specunpack: Cannot handle 64 or 128-bit floats.'
+         fld=0.0
+         return
+      endif
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/utest/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/utest/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/utest/Makefile	(revision 2744)
@@ -0,0 +1,69 @@
+#------------------------------------------------------------------------------
+#  Makefile for producing libdbclient.so 
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+
+.SUFFIXES:      .c .o
+
+#
+# Specity location for Makefiles that are included.
+#
+INCLUDEDIRS = -I.
+BUILD_DIR = ../../../io_grib_share/build
+#
+# Specify directory that output library is to be put in.
+#
+LIB_DEST = ..
+#
+#  SPECIFY local include directories used during compilation of source code. 
+#
+#    CXX_INCLUDES is for C++ files
+#    C_INCLUDES is for C files
+#
+C_INCLUDES   = -I.
+CXX_INCLUDES = -I.
+F_INCLUDES   = -I. -Ig2lib
+FORMAT       = 
+#
+#  SPECIFY any subdirectories containing libraries that may be dynamically
+#          linked by this library.
+#
+SUB_DIRS =
+
+#
+#  SPECIFY information for building a library:
+#
+#    LIB_NAME - Fragment of name of the library to build
+#               e.g. if library file name is libfoo.so, set LIB_NAME = foo 
+#    DEP_LIBS - The tokens required to link a shared library against other
+#               shared libraries upon which it depends.  DEP_LIBS should
+#               contain -L<dir> tokens to specify where the dependent 
+#               libraries are, and -l<lib> tokens to specify libraries to link.
+#    OBJS     - List of object files that go into the library.
+#
+#  NOTES:
+#  1. Be careful about whitespace after the last character in the LIB_NAME.
+#     These spaces will generate an error when the library is made.
+#
+LIB_NAME = io_grib2
+CPPFLAGS =
+
+DEP_LIBS = -lio_grib2 -L../.. -lio_grib_share -L../../../io_grib_share -lpng -ljasper
+
+FC = ifort -FR
+CPP = /lib/cpp -traditional -C -P
+LDD = ifort
+MAIN_OBJS =  \
+	test_g2lib.o
+
+#
+#  Include the boilerplate rules for building library modules.
+#
+include $(BUILD_DIR)/utest_rules.mk
+
+#
+#  Compile dependencies.  These are appended to this file by make depend. 
+#
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/utest/test_g2lib.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/utest/test_g2lib.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/utest/test_g2lib.F	(revision 2744)
@@ -0,0 +1,141 @@
+PROGRAM test_g2lib
+  implicit none
+
+  integer , dimension(13)      :: listsec1
+  integer , dimension(2)       :: listsec0
+  integer                      :: ierr
+  integer , parameter          :: lcgrib = 2000000
+  character (lcgrib)           :: cgrib
+
+  integer, dimension(5)                     :: igds
+  integer, parameter                        :: igdstmplen = 25
+  integer, dimension(igdstmplen)            :: igdstmpl
+  integer, parameter                        :: idefnum = 0
+  integer, dimension(idefnum)               :: ideflist
+
+  integer                                   :: ipdsnum
+  integer, parameter                        :: ipdstmplen = 15
+  integer, dimension(ipdstmplen)            :: ipdstmpl
+  integer                                   :: numcoord
+  integer, dimension(1)                     :: coordlist
+  integer                                   :: idrsnum
+  integer, parameter                        :: idrstmplen = 7
+  integer, dimension(idrstmplen)            :: idrstmpl
+  integer                                   :: ibmap
+  integer, dimension(1)                     :: bmap
+  integer, parameter                        :: ngrdpts=20*25
+  real                                      :: fld(ngrdpts)
+
+  ! 
+  ! Create the grib message
+  !
+  listsec0(1) = 0          ! Discipline (Table 0.0)
+  listsec0(2) = 2          ! Grib edition number
+
+  listsec1(1) = 255        ! Id of Originating Center (255 for missing)
+  listsec1(2) = 255        ! Id of originating sub-center (255 for missing)
+  listsec1(3) = 1          ! Master Table Version #
+  listsec1(4) = 1          ! Local table version #
+  listsec1(5) = 1          ! Significance of reference time, 1 indicates start of forecast
+
+  listsec1(6) = 2005       ! Year of reference
+  listsec1(7) = 09         ! Month of reference
+  listsec1(8) = 30         ! Month of reference
+  listsec1(9) = 0          ! Hour
+  listsec1(10) = 0         ! Minute
+  listsec1(11) = 0         ! Second
+  listsec1(12) = 255       ! Production Status
+  listsec1(13) = 1         ! Type of data (1 for forecast)
+
+  call gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr)
+  if (ierr .ne. 0) then
+     print *, 'gribcreate failed with ierr: ',ierr
+  endif
+
+
+  igds(1) = 0      ! Source of grid definition
+  igds(2) = ngrdpts! Number of points in grid
+  igds(3) = 0      ! 
+  igds(4) = 0
+
+  ! Here, setup the parameters that are common to all WRF projections
+
+  igdstmpl(1) = 1       ! Shape of earth (1 for spherical with specified radius)
+  igdstmpl(2) = 1       ! Scale factor for earth radius
+  igdstmpl(3) = 6370*1000 ! Radius of earth
+  igdstmpl(4) = 0       ! Scale factor for major axis
+  igdstmpl(5) = 0       ! Major axis
+  igdstmpl(6) = 0       ! Scale factor for minor axis
+  igdstmpl(7) = 0       ! Minor axis
+  igdstmpl(8) = 20      ! Number of points along x axis
+  igdstmpl(9) = 25      ! Number of points along y axis
+
+
+  ! This is the setup for lat/lon projection
+  igds(5) = 0
+  igdstmpl(10) = 0    ! Basic Angle of init projection (not important to us)
+  igdstmpl(11) = 0    ! Subdivision of basic angle
+  igdstmpl(12) = -20*1000000
+  igdstmpl(13) = 20*1000000
+  igdstmpl(14) = 128  ! Resolution and component flags
+  igdstmpl(15) = 0*1000000
+  igdstmpl(16) = 40*1000000
+  
+  ! Warning, the following assumes that dx and dy are valid at the equator.
+  !    It is not clear in WRF where dx and dy are valid for latlon projections
+  igdstmpl(17) = 12000 ! i-direction increment in micro degs
+  igdstmpl(18) = 12000 ! j-direction increment in micro degs
+  
+  igdstmpl(19) = 64   ! Scanning mode
+
+  call addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen,ideflist,idefnum,ierr)
+  if (ierr .ne. 0) then
+     print *, 'addgrid failed with ierr: ',ierr
+  endif
+
+
+  ipdsnum = 0              ! Product definition template (0 for horiz grid)
+
+  ipdstmpl(1) = 0          ! Parameter category
+  ipdstmpl(2) = 1          ! Parameter number
+  ipdstmpl(3) = 2          ! Type of generating process (2 for forecast)
+  ipdstmpl(4) = 255        ! Background generating process id
+  ipdstmpl(5) = 255        ! Analysis or forecast generating process id
+  ipdstmpl(6) = 0          ! Data cutoff period (Hours)
+  ipdstmpl(7) = 0          ! Data cutoff period (minutes)
+  ipdstmpl(8) = 13         ! Time range indicator (13 for seconds)
+  ipdstmpl(9) = 10800      ! Forecast time
+
+  ipdstmpl(10) = 111       ! Type of first surface (111 for Eta level)
+  ipdstmpl(11) = 0         ! Scale factor for 1st surface
+  ipdstmpl(12) = 9965      ! First fixed surface
+  ipdstmpl(13) = 255    ! Type of second fixed surface
+  ipdstmpl(14) = 255 ! Scale factor for 2nd surface
+  ipdstmpl(15) = 0
+  numcoord = 0
+  coordlist(1) = 0
+  
+  ! Set Data Representation templ (40 for JPEG2000, 41 for PNG)  
+  idrsnum = 40
+  idrstmpl(1) = 255       ! Reference value - ignored on input
+  idrstmpl(2) = 0         ! Binary scale factor
+  idrstmpl(3) = 3         ! Decimal scale factor 
+  idrstmpl(4) = 0         ! number of bits for each data value - ignored on
+  idrstmpl(5) = 0         ! Original field type - ignored on input
+  idrstmpl(6) = 0         ! 0 for lossless compression
+  idrstmpl(7) = 255       ! Desired compression ratio if idrstmpl(6) != 0
+  ibmap = 255                ! Flag for bitmap
+  
+  fld = 1.2
+
+  call addfield(cgrib, lcgrib, ipdsnum, ipdstmpl, ipdstmplen, coordlist,      &
+       numcoord, idrsnum, idrstmpl, idrstmplen, fld, ngrdpts, ibmap,          &
+       bmap, ierr)
+  
+  if (ierr .ne. 0) then
+     print *, 'addfield failed with ierr: ',ierr
+  endif
+  
+  
+end PROGRAM test_g2lib
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/grib2tbls_types.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/grib2tbls_types.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/grib2tbls_types.F	(revision 2744)
@@ -0,0 +1,42 @@
+module grib2tbls_types
+
+!*
+!* This module will hold data from a grib2map.tbl table
+!*   The variables will be accessible by all functions (provided they have a
+!*   "USE grb2tbls" line).
+!*
+
+  integer, parameter                          :: MaxNames = 40
+  integer, parameter                          :: maxLineSize = 500
+
+  TYPE :: grib2Entries_type
+     integer                                  :: Disc
+     integer                                  :: Category
+     integer                                  :: ParmNum
+     character(len=maxLineSize)               :: WRFNameString
+     character(len=30), dimension(MaxNames)   :: WRFNames
+     integer                                  :: numWRFNames
+     character(len=200)                       :: Description
+     integer                                  :: DecScl
+     integer                                  :: BinScl
+     TYPE(grib2Entries_type), pointer         :: next
+     TYPE(grib2Entries_type), pointer         :: previous
+  END TYPE grib2Entries_type
+
+  TYPE :: grib2tbls_type
+     integer                                  :: center
+     integer                                  :: subcenter
+     integer                                  :: MasterTblV
+     integer                                  :: LocalTblV
+     integer                                  :: numEntries
+     TYPE(grib2Entries_type),pointer          :: ParmHead
+     TYPE(grib2Entries_type),pointer          :: ParmTail
+     TYPE(grib2tbls_type),pointer             :: next
+     TYPE(grib2tbls_type),pointer             :: previous
+  END TYPE grib2tbls_type
+
+  TYPE(grib2tbls_type), pointer               :: TblHead
+  TYPE(grib2tbls_type), pointer               :: TblTail
+
+end module grib2tbls_types
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/io_grib2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/io_grib2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/io_grib2.F	(revision 2744)
@@ -0,0 +1,4535 @@
+!*-----------------------------------------------------------------------------
+!*
+!*  Todd Hutchinson
+!*  WSI
+!*  400 Minuteman Road
+!*  Andover, MA     01810
+!*  thutchinson@wsi.com
+!*
+!*  August, 2005
+!*-----------------------------------------------------------------------------
+
+!*
+!* This io_grib2 API is designed to read WRF input and write WRF output data
+!*   in grib version 2 format.  
+!*
+
+
+#include "wrf_projection.h"
+
+module gr2_data_info
+
+!*
+!* This module will hold data internal to this I/O implementation.
+!*   The variables will be accessible by all functions (provided they have a
+!*   "USE gr2_data_info" line).
+!*
+
+  USE grib2tbls_types
+
+  integer                , parameter       :: FATAL            = 1
+  integer                , parameter       :: DEBUG            = 100
+  integer                , parameter       :: DateStrLen       = 19
+  integer                , parameter       :: maxMsgSize       = 300
+  integer                , parameter       :: firstFileHandle  = 8
+  integer                , parameter       :: maxFileHandles   = 200
+  integer                , parameter       :: maxLevels        = 1000
+  integer                , parameter       :: maxSoilLevels    = 100
+  integer                , parameter       :: maxDomains       = 500
+  character(200)                           :: mapfilename = 'grib2map.tbl'
+
+  integer                , parameter       :: JIDSSIZE = 13
+  integer                , parameter       :: JPDTSIZE = 15
+  integer                , parameter       :: JGDTSIZE = 30
+
+  logical                                  :: grib2map_table_filled = .FALSE.
+
+  logical                                  :: WrfIOnotInitialized = .true.
+
+  integer, dimension(maxDomains)           :: domains
+  integer                                  :: max_domain = 0
+
+  character*24                             :: StartDate = ''
+  character*24                             :: InputProgramName = ''
+  real                                     :: timestep
+  integer                                  :: full_xsize, full_ysize
+  REAL,          dimension(maxSoilLevels)  :: soil_depth, soil_thickness
+  REAL,          dimension(maxLevels)      :: half_eta, full_eta
+
+  integer                                  :: wrf_projection
+  integer                                  :: background_proc_id
+  integer                                  :: forecast_proc_id
+  integer                                  :: production_status
+  integer                                  :: compression
+  real                                     :: center_lat, center_lon
+  real                                     :: dx,dy
+  real                                     :: truelat1, truelat2
+  real                                     :: proj_central_lon
+
+  TYPE :: HandleVar
+     character, dimension(:), pointer      :: fileindex(:)
+     integer                               :: CurrentTime
+     integer                               :: NumberTimes
+     integer                               :: sizeAllocated = 0
+     logical                               :: write = .FALSE.
+     character (DateStrLen), dimension(:),allocatable  :: Times(:)
+     logical                               :: committed, opened, used
+     character*128                         :: DataFile
+     integer                               :: FileFd
+     integer                               :: FileStatus
+     integer                               :: recnum
+     real                                  :: last_scalar_time_written
+  ENDTYPE
+  TYPE (HandleVar), dimension(maxFileHandles),SAVE :: fileinfo
+
+  character(len=30000), dimension(maxFileHandles) :: td_output
+  character(len=30000), dimension(maxFileHandles) :: ti_output
+  character(len=30000), dimension(maxFileHandles) :: scalar_output
+  character(len=30000), dimension(maxFileHandles) :: global_input = ''
+  character(len=30000), dimension(maxFileHandles) :: scalar_input = ''
+
+  real                                     :: last_fcst_secs
+  real                                     :: fcst_secs
+
+  logical                                  :: half_eta_init       = .FALSE.
+  logical                                  :: full_eta_init       = .FALSE.
+  logical                                  :: soil_thickness_init = .FALSE.
+  logical                                  :: soil_depth_init     = .FALSE.
+
+end module gr2_data_info
+
+
+!*****************************************************************************
+
+subroutine ext_gr2_ioinit(SysDepInfo,Status)
+
+  USE gr2_data_info
+  implicit none
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  CHARACTER*(*), INTENT(IN) :: SysDepInfo
+  integer ,intent(out) :: Status
+  integer :: i
+  CHARACTER (LEN=300) :: wrf_err_message
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_ioinit')
+
+  do i=firstFileHandle, maxFileHandles
+        fileinfo(i)%used = .false.
+        fileinfo(i)%committed = .false.
+        fileinfo(i)%opened = .false.
+        td_output(i) = ''
+        ti_output(i) = ''
+        scalar_output(i) = ''
+  enddo
+  domains(:) = -1
+  last_fcst_secs = -1.0
+
+  fileinfo(1:maxFileHandles)%FileStatus = WRF_FILE_NOT_OPENED
+  WrfIOnotInitialized = .false.
+
+  Status = WRF_NO_ERR
+
+  return
+end subroutine ext_gr2_ioinit
+
+!*****************************************************************************
+
+subroutine ext_gr2_ioexit(Status)
+
+  USE gr2_data_info
+  implicit none
+#include "wrf_status_codes.h"
+  integer ,intent(out) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_ioexit')
+
+  Status = WRF_NO_ERR
+
+  if (grib2map_table_filled) then
+     call free_grib2map()
+     grib2map_table_filled = .FALSE.
+  endif
+
+  return
+end subroutine ext_gr2_ioexit
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_open_for_read_begin ( FileName , Comm_compute, Comm_io, &
+     SysDepInfo, DataHandle , Status )
+
+  USE gr2_data_info
+  USE grib2tbls_types
+  USE grib_mod
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER (LEN=maxMsgSize) :: msg
+
+  integer :: center, subcenter, MasterTblV, &
+       LocalTblV, Disc, Category, ParmNum, DecScl, BinScl
+
+  integer :: fields_to_skip
+  integer :: JIDS(JIDSSIZE), JPDTN, JPDT(JPDTSIZE), JGDTN, &
+       JGDT(JGDTSIZE)
+  logical :: UNPACK
+  character*(100) :: VarName
+  type(gribfield) :: gfld
+  integer         :: idx
+  character(len=DateStrLen) :: theTime,refTime
+  integer         :: time_range_convert(13)
+  integer         :: fcstsecs
+  integer         :: endchar
+  integer         :: ierr
+
+  INTERFACE
+     Subroutine load_grib2map (filename, message, status)
+       USE grib2tbls_types
+       character*(*), intent(in)                   :: filename
+       character*(*), intent(inout)                :: message
+       integer      , intent(out)                  :: status
+     END subroutine load_grib2map
+  END INTERFACE
+
+  call wrf_debug ( DEBUG , &
+       'Entering ext_gr2_open_for_read_begin, opening '//trim(FileName))
+
+  CALL gr2_get_new_handle(DataHandle)
+
+  !
+  ! Open grib file
+  !
+  if (DataHandle .GT. 0) then
+     
+     call baopenr(DataHandle,trim(FileName),status)
+
+     if (status .ne. 0) then
+        Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+     else
+        fileinfo(DataHandle)%opened = .true.
+        fileinfo(DataHandle)%DataFile = TRIM(FileName)
+        fileinfo(DataHandle)%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+!        fileinfo(DataHandle)%CurrentTime = 1
+     endif
+  else
+     Status = WRF_WARN_TOO_MANY_FILES
+     return
+  endif
+ 
+  fileinfo(DataHandle)%recnum = -1
+
+  !
+  ! Fill up the grib2tbls structure from data in the grib2map file.
+  !
+  if (.NOT. grib2map_table_filled) then
+     grib2map_table_filled = .TRUE.
+     CALL load_grib2map(mapfilename, msg, status)
+     if (status .ne. 0) then
+        call wrf_message(trim(msg))
+        Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+        return
+     endif
+  endif
+
+
+  !
+  ! Get the parameter info for metadata
+  !
+  VarName = "WRF_GLOBAL"
+  CALL get_parminfo(VarName, center, subcenter, MasterTblV, &
+       LocalTblV, Disc, Category, ParmNum, DecScl, BinScl, status)
+  if (status .ne. 0) then
+     write(msg,*) 'Could not find parameter for '//   &
+          trim(VarName)//'   Skipping output of '//trim(VarName)
+     call wrf_message(trim(msg))
+     Status =  WRF_GRIB2_ERR_GRIB2MAP
+     return
+  endif
+
+  !
+  ! Read the metadata
+  !
+  fields_to_skip = 0
+  
+  !
+  ! First, set all values to the wildcard, then reset values that we wish
+  !    to specify.
+  !
+  call gr2_g2lib_wildcard(JIDS, JPDT, JGDT)
+  
+  JIDS(1) = center
+  JIDS(2) = subcenter
+  JIDS(3) = MasterTblV
+  JIDS(4) = LocalTblV
+  JIDS(5) = 1           ! Indicates that time is "Start of Forecast"
+  JIDS(13) = 1          ! Type of processed data (1 for forecast products)
+  
+  JPDTN = 0             ! Product definition template number
+  JPDT(1) = Category
+  JPDT(2) = ParmNum
+  JPDT(3) = 2           ! Generating process id
+  JPDT(9) = 0           ! Forecast time 
+
+  JGDTN    = -1         ! Indicates that any Grid Display Template is a match
+  
+  UNPACK   = .FALSE.    ! Dont unpack bitmap and data values
+
+  CALL GETGB2(DataHandle, DataHandle, fields_to_skip, -1, Disc, JIDS, JPDTN, &
+       JPDT, JGDTN, JGDT, UNPACK, fileinfo(DataHandle)%recnum, gfld, status)
+  if (status .ne. 0) then
+     if (status .eq. 99) then
+        write(msg,*)'Could not find metadata field named '//trim(VarName)
+     else
+        write(msg,*)'Retrieving grib field '//trim(VarName)//' failed, ',status
+     endif
+     call wrf_message(trim(msg))
+     status = WRF_GRIB2_ERR_GETGB2
+     return
+  endif
+
+  global_input(DataHandle) = transfer(gfld%local,global_input(DataHandle))
+  global_input(DataHandle)(gfld%locallen+1:30000) = ' '
+
+  call gf_free(gfld)
+
+  !
+  ! Read and index all scalar data
+  !
+  VarName = "WRF_SCALAR"
+  CALL get_parminfo(VarName, center, subcenter, MasterTblV, &
+       LocalTblV, Disc, Category, ParmNum, DecScl, BinScl, status)
+  if (status .ne. 0) then
+     write(msg,*) 'Could not find parameter for '//   &
+          trim(VarName)//'   Skipping reading of '//trim(VarName)
+     call wrf_message(trim(msg))
+     Status =  WRF_GRIB2_ERR_GRIB2MAP
+     return
+  endif
+
+  !
+  ! Read the metadata
+  !
+  ! First, set all values to wild, then specify necessary values
+  !
+  call gr2_g2lib_wildcard(JIDS, JPDT, JGDT)
+
+  JIDS(1) = center
+  JIDS(2) = subcenter
+  JIDS(3) = MasterTblV
+  JIDS(4) = LocalTblV
+
+  JIDS(5) = 1           ! Indicates that time is "Start of Forecast"
+  JIDS(13) = 1          ! Type of processed data (1 for forecast products)
+  
+  JPDTN = 0             ! Product definition template number
+  JPDT(1) = Category
+  JPDT(2) = ParmNum
+  JPDT(3) = 2           ! Generating process id
+
+  JGDTN    = -1         ! Indicates that any Grid Display Template is a match
+  
+  UNPACK   = .FALSE.    ! Dont unpack bitmap and data values
+
+  fields_to_skip = 0
+  do while (status .eq. 0) 
+     CALL GETGB2(DataHandle, 0, fields_to_skip, -1, -1, JIDS, JPDTN, &
+          JPDT, JGDTN, JGDT, UNPACK, fileinfo(DataHandle)%recnum, &
+          gfld, status)
+     if (status .eq. 99) then
+        exit
+     else if (status .ne. 0) then
+        write(msg,*)'Finding data field '//trim(VarName)//' failed 1.'
+        call wrf_message(trim(msg))
+        Status = WRF_GRIB2_ERR_READ
+        return
+     endif
+     
+     ! Build times list here
+     write(refTime,'(I4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2)')      &
+          gfld%idsect(6),'-',gfld%idsect(7),'-',gfld%idsect(8),'_',&
+          gfld%idsect(9),':',gfld%idsect(10),':',gfld%idsect(11)
+
+     time_range_convert(:) = -1
+     time_range_convert(1) = 60
+     time_range_convert(2) = 60*60
+     time_range_convert(3) = 24*60*60
+     time_range_convert(10) = 3*60*60
+     time_range_convert(11) = 6*60*60
+     time_range_convert(12) = 12*60*60
+     time_range_convert(13) = 1
+     
+     if (time_range_convert(gfld%ipdtmpl(8)) .gt. 0) then
+        fcstsecs = gfld%ipdtmpl(9)*time_range_convert(gfld%ipdtmpl(8))
+     else 
+        write(msg,*)'Invalid time range in input data: ',gfld%ipdtmpl(8),&
+             ' Skipping'
+        call wrf_message(trim(msg))
+        call gf_free(gfld)
+        cycle
+     endif
+     call advance_wrf_time(refTime,fcstsecs,theTime)
+
+     call gr2_add_time(DataHandle,theTime)
+
+     fields_to_skip = fields_to_skip + fileinfo(DataHandle)%recnum
+
+     scalar_input(DataHandle) = transfer(gfld%local,scalar_input(DataHandle))
+     scalar_input(DataHandle)(gfld%locallen+1:30000) = ' '
+     
+     call gf_free(gfld)
+  enddo
+
+  !
+  ! Fill up the eta levels variables
+  !
+
+  if (.not. full_eta_init) then
+     CALL gr2_fill_levels(DataHandle, "ZNW", full_eta, ierr)
+     if (ierr .eq. 0) then
+        full_eta_init = .TRUE.
+     endif
+  endif
+  if (.not. half_eta_init) then
+     CALL gr2_fill_levels(DataHandle, "ZNU", half_eta, ierr)
+     if (ierr .eq. 0) then 
+        half_eta_init = .TRUE.
+     endif
+  endif
+  !
+  ! Fill up the soil levels
+  !
+  if (.not. soil_depth_init) then
+     call gr2_fill_levels(DataHandle,"ZS",soil_depth, ierr)
+     if (ierr .eq. 0) then
+        soil_depth_init = .TRUE.
+     endif
+  endif
+  if (.not. soil_thickness_init) then
+     call gr2_fill_levels(DataHandle,"DZS",soil_thickness, ierr)
+     if (ierr .eq. 0) then
+        soil_thickness_init = .TRUE.
+     endif
+  endif
+
+  ! 
+  ! Fill up any variables from the global metadata
+  !
+
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       'START_DATE', StartDate, status)
+  if (status .ne. 0) then
+     write(msg,*)'Could not find metadata value for START_DATE, continuing'
+     call wrf_message(trim(msg))
+  endif
+ 
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       'PROGRAM_NAME', InputProgramName, status)
+  if (status .ne. 0) then
+     write(msg,*)'Could not find metadata value for PROGRAM_NAME, continuing'
+     call wrf_message(trim(msg))
+  else
+     endchar = SCAN(InputProgramName," ")
+     InputProgramName = InputProgramName(1:endchar)
+  endif
+
+
+  Status = WRF_NO_ERR
+
+  call wrf_debug ( DEBUG , 'Exiting ext_gr2_open_for_read_begin')
+
+  RETURN
+END SUBROUTINE ext_gr2_open_for_read_begin
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_open_for_read_commit( DataHandle , Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  character(len=maxMsgSize) :: msg
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_open_for_read_commit')
+
+  Status = WRF_NO_ERR
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED
+    write(msg,*) 'ext_gr2_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  fileinfo(DataHandle)%committed = .true.
+  fileinfo(DataHandle)%FileStatus = WRF_FILE_OPENED_FOR_READ
+
+  Status = WRF_NO_ERR
+
+  RETURN
+END SUBROUTINE ext_gr2_open_for_read_commit
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_open_for_read ( FileName , Comm_compute, Comm_io, &
+     SysDepInfo, DataHandle , Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_open_for_read')
+
+  DataHandle = 0   ! dummy setting to quiet warning message
+  CALL ext_gr2_open_for_read_begin( FileName, Comm_compute, Comm_io, &
+       SysDepInfo, DataHandle, Status )
+  IF ( Status .EQ. WRF_NO_ERR ) THEN
+    CALL ext_gr2_open_for_read_commit( DataHandle, Status )
+  ENDIF
+  return
+
+  RETURN  
+END SUBROUTINE ext_gr2_open_for_read
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_open_for_write_begin(FileName, Comm, IOComm, SysDepInfo, &
+     DataHandle, Status)
+  
+  USE gr2_data_info
+  implicit none
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+
+  character*(*)        ,intent(in)  :: FileName
+  integer              ,intent(in)  :: Comm
+  integer              ,intent(in)  :: IOComm
+  character*(*)        ,intent(in)  :: SysDepInfo
+  integer              ,intent(out) :: DataHandle
+  integer              ,intent(out) :: Status
+  integer :: ierr
+  CHARACTER (LEN=maxMsgSize) :: msg
+
+  INTERFACE
+     Subroutine load_grib2map (filename, message, status)
+       USE grib2tbls_types
+       character*(*), intent(in)                   :: filename
+       character*(*), intent(inout)                :: message
+       integer      , intent(out)                  :: status
+     END subroutine load_grib2map
+  END INTERFACE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_open_for_write_begin')
+
+  Status = WRF_NO_ERR
+
+  if (.NOT. grib2map_table_filled) then
+     grib2map_table_filled = .TRUE.
+     CALL load_grib2map(mapfilename, msg, status)
+     if (status .ne. 0) then
+        call wrf_message(trim(msg))
+        Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+        return
+     endif
+  endif
+
+  CALL gr2_get_new_handle(DataHandle)
+
+  if (DataHandle .GT. 0) then
+
+     call baopenw(DataHandle,trim(FileName),ierr)
+
+     if (ierr .ne. 0) then
+        Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+     else
+        fileinfo(DataHandle)%opened = .true.
+        fileinfo(DataHandle)%DataFile = TRIM(FileName)
+        fileinfo(DataHandle)%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+     endif
+     fileinfo(DataHandle)%last_scalar_time_written = -1
+     fileinfo(DataHandle)%committed = .false.
+     td_output(DataHandle) = ''
+     ti_output(DataHandle) = ''
+     scalar_output(DataHandle) = ''
+     fileinfo(DataHandle)%write = .true.
+  else
+     Status = WRF_WARN_TOO_MANY_FILES
+  endif
+
+  RETURN  
+END SUBROUTINE ext_gr2_open_for_write_begin
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_open_for_write_commit( DataHandle , Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_open_for_write_commit')
+
+  IF ( fileinfo(DataHandle)%opened ) THEN
+    IF ( fileinfo(DataHandle)%used ) THEN
+      fileinfo(DataHandle)%committed = .true.
+      fileinfo(DataHandle)%FileStatus = WRF_FILE_OPENED_FOR_WRITE
+    ENDIF
+  ENDIF
+
+  Status = WRF_NO_ERR
+
+  RETURN  
+END SUBROUTINE ext_gr2_open_for_write_commit
+
+!*****************************************************************************
+
+subroutine ext_gr2_inquiry (Inquiry, Result, Status)
+  use gr2_data_info
+  implicit none
+#include "wrf_status_codes.h"
+  character *(*), INTENT(IN)    :: Inquiry
+  character *(*), INTENT(OUT)   :: Result
+  integer        ,INTENT(INOUT) :: Status
+  SELECT CASE (Inquiry)
+  CASE ("RANDOM_WRITE","RANDOM_READ")
+     Result='ALLOW'
+  CASE ("SEQUENTIAL_WRITE","SEQUENTIAL_READ")
+     Result='NO'
+  CASE ("OPEN_READ", "OPEN_WRITE", "OPEN_COMMIT_WRITE")
+     Result='REQUIRE'
+  CASE ("OPEN_COMMIT_READ","PARALLEL_IO")
+     Result='NO'
+  CASE ("SELF_DESCRIBING","SUPPORT_METADATA","SUPPORT_3D_FIELDS")
+     Result='YES'
+  CASE ("MEDIUM")
+     Result ='FILE'
+  CASE DEFAULT
+     Result = 'No Result for that inquiry!'
+  END SELECT
+  Status=WRF_NO_ERR
+  return
+end subroutine ext_gr2_inquiry
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_inquire_opened ( DataHandle, FileName , FileStat, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStat
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_inquire_opened')
+
+  FileStat = WRF_NO_ERR
+  if ((DataHandle .ge. firstFileHandle) .and. &
+       (DataHandle .le. maxFileHandles)) then
+     FileStat = fileinfo(DataHandle)%FileStatus
+  else
+     FileStat = WRF_FILE_NOT_OPENED
+  endif
+  
+  Status = FileStat
+
+  RETURN
+END SUBROUTINE ext_gr2_inquire_opened
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_ioclose ( DataHandle, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER DataHandle, Status
+  INTEGER istat
+  character(len=1000) :: outstring
+  character :: lf
+  character*(maxMsgSize) :: msg
+  integer   :: idx
+
+  lf=char(10)
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_ioclose')
+
+  Status = WRF_NO_ERR
+
+  if (fileinfo(DataHandle)%write .eqv. .TRUE.) then
+     call gr2_fill_local_use(DataHandle,scalar_output(DataHandle),&
+          "WRF_SCALAR",fcst_secs,msg,status)
+     if (status .ne. 0) then
+        call wrf_message(trim(msg))
+        return
+     endif
+     fileinfo(DataHandle)%last_scalar_time_written = fcst_secs
+     scalar_output(DataHandle) = ''
+     
+     call gr2_fill_local_use(DataHandle,&
+          trim(ti_output(DataHandle))//trim(td_output(DataHandle)),&
+          "WRF_GLOBAL",0,msg,status)
+     if (status .ne. 0) then
+        call wrf_message(trim(msg))
+        return
+     endif
+     ti_output(DataHandle) = ''
+     td_output(DataHandle) = ''
+  endif
+
+  do idx = 1,fileinfo(DataHandle)%NumberTimes 
+     if (allocated(fileinfo(DataHandle)%Times)) then
+        deallocate(fileinfo(DataHandle)%Times)
+     endif
+  enddo
+  fileinfo(DataHandle)%NumberTimes = 0
+  fileinfo(DataHandle)%sizeAllocated = 0
+  fileinfo(DataHandle)%CurrentTime = 0
+  fileinfo(DataHandle)%write = .FALSE.
+
+  call baclose(DataHandle,status)
+  if (status .ne. 0) then
+     call wrf_message("Closing file failed, continuing")
+  else
+     fileinfo(DataHandle)%opened = .true.
+     fileinfo(DataHandle)%DataFile = ''
+     fileinfo(DataHandle)%FileStatus = WRF_FILE_NOT_OPENED
+  endif
+
+  fileinfo(DataHandle)%used = .false.
+
+  RETURN
+END SUBROUTINE ext_gr2_ioclose
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_write_field( DataHandle , DateStrIn , VarName , &
+     Field , FieldType , Comm , IOComm, &
+     DomainDesc , MemoryOrder , Stagger , &
+     DimNames , &
+     DomainStart , DomainEnd , &
+     MemoryStart , MemoryEnd , &
+     PatchStart , PatchEnd , &
+     Status )
+
+  USE gr2_data_info
+  USE grib2tbls_types
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  integer                       ,intent(in)    :: DataHandle 
+  character*(*)                 ,intent(in)    :: DateStrIn
+  character*(*)                 ,intent(in)    :: VarName
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  character*(*)                 ,intent(in)    :: Stagger
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+
+  real                          , intent(in), &
+       dimension( 1:1,MemoryStart(1):MemoryEnd(1), &
+       MemoryStart(2):MemoryEnd(2), &
+       MemoryStart(3):MemoryEnd(3) )           :: Field
+
+
+  character (120)                              :: DateStr
+
+  character (maxMsgSize)                       :: msg
+  integer                                      :: xsize, ysize, zsize
+  integer                                      :: x, y, z
+  integer                                      :: &
+       x_start,x_end,y_start,y_end,z_start,z_end
+  integer                                      :: idx
+  integer                                      :: proj_center_flag
+  logical                                      :: vert_stag = .false.
+  real,    dimension(:,:), pointer             :: data
+  integer                                      :: istat
+  integer                                      :: accum_period
+  integer, dimension(maxLevels)                :: level1, level2
+  integer, dimension(maxLevels)                :: grib_levels
+  logical                                      :: soil_layers, fraction
+  integer                                      :: vert_unit1, vert_unit2
+  integer                                      :: vert_sclFctr1, vert_sclFctr2
+  integer                                      :: this_domain
+  logical                                      :: new_domain
+  real                                         :: &
+       region_center_lat, region_center_lon
+  integer                                      :: dom_xsize, dom_ysize;
+  integer , parameter                          :: lcgrib = 2000000
+  character (lcgrib)                           :: cgrib
+  integer                                      :: ierr
+  integer                                      :: lengrib
+
+  integer                                     :: center, subcenter, &
+       MasterTblV, LocalTblV, Disc, Category, ParmNum, DecScl, BinScl
+  CHARACTER(len=100)  :: tmpstr
+  integer             :: ndims
+  integer             :: dim1size, dim2size, dim3size, dim3
+  integer             :: numlevels
+  integer             :: ngrdpts
+  integer             :: bytes_written
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_write_field for parameter '//&
+       VarName)
+
+  !
+  ! If DateStr is all 0s, we reset it to StartDate.  For some reason, 
+  !   in idealized simulations, StartDate is 0001-01-01_00:00:00 while
+  !   the first DateStr is 0000-00-00_00:00:00.  
+  !
+  if (DateStrIn .eq. '0000-00-00_00:00:00') then
+     DateStr = TRIM(StartDate)
+  else
+     DateStr = DateStrIn
+  endif
+
+  !
+  ! Check if this is a domain that we haven t seen yet.  If so, add it to 
+  !   the list of domains.
+  !
+  this_domain = 0
+  new_domain = .false.
+  do idx = 1, max_domain
+     if (DomainDesc .eq. domains(idx)) then
+        this_domain = idx
+     endif
+  enddo
+  if (this_domain .eq. 0) then
+     max_domain = max_domain + 1
+     domains(max_domain) = DomainDesc
+     this_domain = max_domain
+     new_domain = .true.
+  endif
+
+  zsize = 1
+  xsize = 1
+  ysize = 1
+  soil_layers = .false.
+  fraction = .false.
+
+  ! First, handle then special cases for the boundary data.
+
+  CALL get_dims(MemoryOrder, PatchStart, PatchEnd, ndims, x_start, x_end, &
+       y_start, y_end,z_start,z_end)
+  xsize = x_end - x_start + 1
+  ysize = y_end - y_start + 1
+  zsize = z_end - z_start + 1
+
+  do idx = 1, len(MemoryOrder)
+     if ((MemoryOrder(idx:idx) .eq. 'Z') .and. &
+          (DimNames(idx) .eq. 'soil_layers_stag')) then
+        soil_layers = .true.
+     else if ((VarName .eq. 'LANDUSEF') .or. (VarName .eq. 'SOILCBOT') .or. &
+          (VarName .eq. 'SOILCTOP')) then
+        fraction = .true.
+     endif
+  enddo
+
+  if (zsize .eq. 0) then 
+     zsize = 1
+  endif
+
+  !
+  ! Fill up the variables that hold the vertical coordinate data
+  !
+
+  if (VarName .eq. 'ZNU') then
+     do idx = 1, zsize
+        half_eta(idx) = Field(1,idx,1,1)
+     enddo
+     half_eta_init = .TRUE.
+  endif
+
+  if (VarName .eq. 'ZNW') then
+     do idx = 1, zsize
+        full_eta(idx) = Field(1,idx,1,1)
+     enddo
+     full_eta_init = .TRUE.
+  endif
+  
+  if (VarName .eq. 'ZS') then
+     do idx = 1, zsize
+        soil_depth(idx) = Field(1,idx,1,1)
+     enddo
+     soil_depth_init = .TRUE.
+  endif
+
+  if (VarName .eq. 'DZS') then
+     do idx = 1, zsize
+        soil_thickness(idx) = Field(1,idx,1,1)
+     enddo
+     soil_thickness_init = .TRUE.
+  endif
+
+  ! 
+  ! Check to assure that dimensions are valid
+  !
+
+  if ((xsize .lt. 1) .or. (ysize .lt. 1) .or. (zsize .lt. 1)) then
+     write(msg,*) 'Cannot output field with memory order: ', &
+          MemoryOrder,Varname
+     call wrf_message(trim(msg))
+     return
+  endif
+     
+
+  if (fileinfo(DataHandle)%opened .and. fileinfo(DataHandle)%committed) then
+
+     if (StartDate == '') then
+        StartDate = DateStr
+     endif
+     
+     CALL geth_idts(DateStr,StartDate,fcst_secs)
+
+     !
+     ! If this is a new forecast time, and we have not written the 
+     !   last_fcst_secs scalar output yet, then write it here.
+     !
+
+     if ((abs(fcst_secs - 0.0) .gt. 0.01) .and. &
+          (last_fcst_secs .ge. 0) .and. &
+          (abs(fcst_secs - last_fcst_secs) .gt. 0.01) .and. &
+          (abs(last_fcst_secs - fileinfo(DataHandle)%last_scalar_time_written) .gt. 0.01) ) then
+        call gr2_fill_local_use(DataHandle,scalar_output(DataHandle),&
+             "WRF_SCALAR",last_fcst_secs,msg,status)
+        if (status .ne. 0) then
+           call wrf_message(trim(msg))
+           return
+        endif
+        fileinfo(DataHandle)%last_scalar_time_written = last_fcst_secs
+        scalar_output(DataHandle) = ''
+     endif
+
+     call get_vert_stag(VarName,Stagger,vert_stag)
+     
+     do idx = 1, zsize
+        call gr2_get_levels(VarName, idx, zsize, soil_layers, vert_stag, &
+             fraction, vert_unit1, vert_unit2, vert_sclFctr1, &
+             vert_sclFctr2, level1(idx), level2(idx))
+     enddo
+     
+     ! 
+     ! Get the center lat/lon for the area being output.  For some cases (such
+     !    as for boundary areas, the center of the area is different from the
+     !    center of the model grid.
+     !
+     if (index(Stagger,'X') .le. 0) then
+        dom_xsize = full_xsize - 1
+     else
+        dom_xsize = full_xsize
+     endif
+     if (index(Stagger,'Y') .le. 0) then
+        dom_ysize = full_ysize - 1
+     else
+        dom_ysize = full_ysize
+     endif
+     
+
+     CALL get_region_center(MemoryOrder, wrf_projection, center_lat, &
+          center_lon, dom_xsize, dom_ysize, dx, dy, proj_central_lon, &
+          proj_center_flag, truelat1, truelat2, xsize, ysize, &
+          region_center_lat, region_center_lon)
+     
+
+     if (ndims .eq. 0) then        ! Scalar quantity
+
+        ALLOCATE(data(1:1,1:1), STAT=istat)
+
+        call gr2_retrieve_data(MemoryOrder, MemoryStart, MemoryEnd, &
+             xsize, ysize, zsize, z, FieldType, Field, data)
+        write(tmpstr,'(G17.10)')data(1,1)
+        CALL gr2_build_string (scalar_output(DataHandle), &
+             trim(adjustl(VarName)), tmpstr, 1, Status)
+
+        DEALLOCATE(data)
+
+     else if (ndims .ge. 1) then   ! Vector (1-D) and 2/3 D quantities
+
+        if (ndims .eq. 1) then     ! Handle Vector (1-D) parameters
+           dim1size = zsize
+           dim2size = 1
+           dim3size = 1
+        else                       ! Handle 2/3 D parameters
+           dim1size = xsize
+           dim2size = ysize
+           dim3size = zsize
+        endif
+        
+        ALLOCATE(data(1:dim1size,1:dim2size), STAT=istat)
+
+        CALL get_parminfo(VarName, center, subcenter, MasterTblV, &
+             LocalTblV, Disc, Category, ParmNum, DecScl, BinScl, status)
+        if (status .ne. 0) then
+           write(msg,*) 'Could not find parameter for '//   &
+                trim(VarName)//'   Skipping output of '//trim(VarName)
+           call wrf_message(trim(msg))
+           Status =  WRF_GRIB2_ERR_GRIB2MAP
+           return
+        endif
+
+        VERTDIM : do dim3 = 1, dim3size
+
+           call gr2_retrieve_data(MemoryOrder, MemoryStart, MemoryEnd, xsize, &
+                ysize, zsize, dim3, FieldType, Field, data)
+        
+           ! 
+           ! Here, we do any necessary conversions to the data.
+           !
+           
+           ! Potential temperature is sometimes passed in as perturbation 
+           !   potential temperature (i.e., POT-300).  Other times (i.e., from 
+           !   WRF SI), it is passed in as full potential temperature.
+           ! Here, we convert to full potential temperature by adding 300
+           !   only if POT < 200 K.
+           !
+           if (VarName == 'T') then
+              if ((data(1,1) < 200) .and. (data(1,1) .ne. 0)) then
+                 data = data + 300
+              endif
+           endif
+           
+           ! 
+           ! For precip, we setup the accumulation period, and output a precip
+           !    rate for time-step precip.
+           !
+           if ((VarName .eq. 'RAINCV') .or. (VarName .eq. 'RAINNCV')) then
+              ! Convert time-step precip to precip rate.
+              data = data/timestep
+              accum_period = 0
+           else
+              accum_period = 0
+           endif
+           
+           !
+           ! Create indicator and identification sections (sections 0 and 1)
+           !
+           CALL gr2_create_w(StartDate, cgrib, lcgrib, production_status, &
+                Disc, center, subcenter, MasterTblV, LocalTblV, ierr, msg)
+           if (ierr .ne. 0) then
+              call wrf_message(trim(msg))
+              Status = WRF_GRIB2_ERR_GRIBCREATE
+              return
+           endif
+
+           !
+           ! Add the grid definition section (section 3) using a 1x1 grid
+           !
+           call gr2_addgrid_w(cgrib, lcgrib, center_lat, proj_central_lon,  &
+                wrf_projection, truelat1, truelat2, xsize, ysize, dx, dy, &
+                region_center_lat, region_center_lon, ierr, msg)
+           if (ierr .ne. 0) then
+              call wrf_message(trim(msg))
+              Status = WRF_GRIB2_ERR_ADDGRIB
+              return
+           endif
+
+           if (ndims .eq. 1) then
+              numlevels = zsize
+              grib_levels(:) = level1(:)
+              ngrdpts = zsize
+           else
+              numlevels = 2
+              grib_levels(1) = level1(dim3)
+              grib_levels(2) = level2(dim3)
+              ngrdpts = xsize*ysize
+           endif
+           
+           !
+           ! Add the Product Definition, Data representation, bitmap 
+           !      and data sections (sections 4-7)
+           !
+           
+           call gr2_addfield_w(cgrib, lcgrib, VarName, Category, ParmNum, &
+                DecScl, BinScl, fcst_secs, vert_unit1, vert_unit2, &
+                vert_sclFctr1, vert_sclFctr2, numlevels, &
+                grib_levels, ngrdpts,  background_proc_id, forecast_proc_id, &
+                compression, data, ierr, msg)
+           if (ierr .eq. 11) then
+              write(msg,'(A,I7,A)') 'WARNING: decimal scale for field '//&
+                   trim(VarName)//' at level ',grib_levels(1),&
+                   ' was reduced to fit field into 24 bits.  '//&
+                   ' Some precision may be lost!'//&
+                   '     To prevent this message, reduce decimal scale '//&
+                   'factor in '//trim(mapfilename)
+              call wrf_message(trim(msg))
+           else if (ierr .eq. 12) then
+              write(msg,'(A,I7,A)') 'WARNING: binary scale for field '//&
+                   trim(VarName)//' at level ',grib_levels(1), &
+                   ' was reduced to fit field into 24 bits.  '//&
+                   ' Some precision may be lost!'//&
+                   '     To prevent this message, reduce binary scale '//&
+                   'factor in '//trim(mapfilename)
+              call wrf_message(trim(msg))
+           else if (ierr .ne. 0) then
+              call wrf_message(trim(msg))
+              Status = WRF_GRIB2_ERR_ADDFIELD
+              return
+           endif
+
+           !
+           ! Close out the message
+           !
+           
+           call gribend(cgrib,lcgrib,lengrib,ierr)
+           if (ierr .ne. 0) then
+              write(msg,*) 'gribend failed with ierr: ',ierr     
+              call wrf_message(trim(msg))
+              Status = WRF_GRIB2_ERR_GRIBEND
+              return
+           endif
+
+           ! 
+           ! Write the data to the file
+           !
+           
+!           call write_file_n(fileinfo(DataHandle)%FileFd, cgrib, lengrib, ierr)
+           call bawrite(DataHandle, -1, lengrib, bytes_written, cgrib)
+           if (bytes_written .ne. lengrib) then
+              write(msg,*) '1 Error writing cgrib to file, wrote: ', &
+                   bytes_written, ' bytes.  Tried to write ', lengrib, ' bytes'
+              call wrf_message(trim(msg))
+              Status = WRF_GRIB2_ERR_WRITE
+              return
+           endif
+
+        ENDDO VERTDIM
+        
+        DEALLOCATE(data)
+
+     endif
+
+     last_fcst_secs = fcst_secs
+
+  endif
+
+  deallocate(data, STAT = istat)
+
+  Status = WRF_NO_ERR
+
+  call wrf_debug ( DEBUG , 'Leaving ext_gr2_write_field')
+
+  RETURN
+END SUBROUTINE ext_gr2_write_field
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_read_field ( DataHandle , DateStr , VarName , Field , &
+     FieldType , Comm , IOComm, DomainDesc , MemoryOrder , Stagger ,     &
+     DimNames , DomainStart , DomainEnd , MemoryStart , MemoryEnd ,      &
+     PatchStart , PatchEnd ,  Status )
+
+  USE gr2_data_info
+  USE grib_mod
+  IMPLICIT NONE  
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER                       ,intent(in)       :: DataHandle 
+  CHARACTER*(*)                 ,intent(in)       :: DateStr
+  CHARACTER*(*)                 ,intent(in)       :: VarName
+  integer                       ,intent(inout)    :: FieldType
+  integer                       ,intent(inout)    :: Comm
+  integer                       ,intent(inout)    :: IOComm
+  integer                       ,intent(inout)    :: DomainDesc
+  character*(*)                 ,intent(inout)    :: MemoryOrder
+  character*(*)                 ,intent(inout)    :: Stagger
+  character*(*) , dimension (*) ,intent(inout)    :: DimNames
+  integer ,dimension(*)         ,intent(inout)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(inout)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(inout)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)      :: Status
+  INTEGER                       ,intent(out)      :: Field(*)
+  integer                       :: xsize,ysize,zsize
+  integer                       :: x_start,x_end,y_start,y_end,z_start,z_end
+  integer                       :: ndims
+  character (len=1000)          :: Value
+  character (maxMsgSize)        :: msg
+  integer                       :: ierr
+  real                          :: Data
+  integer                       :: center, subcenter, MasterTblV, &
+       LocalTblV, Disc, Category, ParmNum, DecScl, BinScl
+  integer                       :: dim1size,dim2size,dim3size,dim3
+
+  integer :: idx
+  integer :: fields_to_skip
+  integer :: JIDS(JIDSSIZE), JPDTN, JPDT(JPDTSIZE), JGDTN, &
+       JGDT(JGDTSIZE)
+  logical :: UNPACK
+  type(gribfield) :: gfld
+  logical                                      :: soil_layers, fraction
+  logical                                      :: vert_stag = .false.
+  integer                                      :: vert_unit1, vert_unit2
+  integer                                      :: vert_sclFctr1, vert_sclFctr2
+  integer                                      :: level1, level2
+  integer                                      :: di
+  real                                         :: tmpreal
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_read_field'//fileinfo(DataHandle)%DataFile)
+  
+  CALL get_dims(MemoryOrder, PatchStart, PatchEnd, ndims, x_start, x_end, &
+       y_start, y_end,z_start,z_end)
+  xsize = x_end - x_start + 1
+  ysize = y_end - y_start + 1
+  zsize = z_end - z_start + 1
+
+  ! 
+  ! Check to assure that dimensions are valid
+  !
+
+  if ((xsize .lt. 1) .or. (ysize .lt. 1) .or. (zsize .lt. 1)) then
+     write(msg,*) 'Cannot retrieve field with memory order: ', &
+          MemoryOrder,Varname
+     Status = WRF_GRIB2_ERR_READ
+     call wrf_message(trim(msg))
+     return
+  endif
+     
+
+  if (ndims .eq. 0) then    ! Scalar quantity
+
+     call gr2_get_metadata_value(scalar_input(DataHandle),trim(VarName),&
+          Value,ierr)
+     if (ierr /= 0) then
+        Status = WRF_GRIB2_ERR_READ
+        CALL wrf_message ( &
+             "gr2_get_metadata_value failed for Scalar variable "//&
+             trim(VarName))
+        return
+     endif
+
+     READ(Value,*,IOSTAT=ierr)Data
+     if (ierr .ne. 0) then
+        CALL wrf_message("Reading data from "//trim(VarName)//" failed")
+        Status = WRF_GRIB2_ERR_READ
+        return
+     endif
+
+     if (FieldType .eq. WRF_INTEGER) then
+        Field(1:1) = data
+     else if ((FieldType .eq. WRF_REAL) .or. (FieldType .eq. WRF_DOUBLE)) then
+        Field(1:1) = TRANSFER(data,Field(1),1)
+     else
+        write (msg,*)'Reading of type ',FieldType,'from grib data not supported, not reading ',VarName
+        call wrf_message(msg)
+     endif
+
+  else if (ndims .ge. 1) then   ! Vector (1-D) and 2/3 D quantities
+     
+     if (ndims .eq. 1) then     ! Handle Vector (1-D) parameters
+        dim1size = zsize
+        dim2size = 1
+        dim3size = 1
+     else                       ! Handle 2/3 D parameters
+        dim1size = xsize
+        dim2size = ysize
+        dim3size = zsize
+     endif
+     
+     CALL get_parminfo(VarName, center, subcenter, MasterTblV, &
+          LocalTblV, Disc, Category, ParmNum, DecScl, BinScl, status)
+     if (status .ne. 0) then
+        write(msg,*) 'Could not find parameter for '//   &
+             trim(VarName)//'   Skipping output of '//trim(VarName)
+        call wrf_message(trim(msg))
+        Status =  WRF_GRIB2_ERR_GRIB2MAP
+        return
+     endif
+     
+     CALL get_vert_stag(VarName,Stagger,vert_stag)
+     CALL get_soil_layers(VarName,soil_layers)
+
+     VERTDIM : do dim3 = 1, dim3size
+
+        fields_to_skip = 0
+
+        !
+        ! First, set all values to wild, then specify necessary values
+        !
+        call gr2_g2lib_wildcard(JIDS, JPDT, JGDT)
+
+        JIDS(1) = center
+        JIDS(2) = subcenter
+        JIDS(3) = MasterTblV
+        JIDS(4) = LocalTblV
+        JIDS(5) = 1           ! Indicates that time is "Start of Forecast"
+        
+        READ (StartDate,'(I4.4,1X,I2.2,1X,I2.2,1X,I2.2,1X,I2.2,1X,I2.2)') &
+             (JIDS(idx),idx=6,11)
+        JIDS(13) = 1          ! Type of processed data(1 for forecast products)
+        
+        JPDT(1) = Category
+        JPDT(2) = ParmNum
+        JPDT(3) = 2           ! Generating process id
+
+        CALL geth_idts(DateStr,StartDate,tmpreal)  ! Forecast time 
+        
+        JPDT(9) = NINT(tmpreal)
+
+        if (ndims .eq. 1) then
+           jpdtn = 1000       ! Product definition tmplate (1000 for cross-sxn)
+        else
+           call gr2_get_levels(VarName, dim3, dim3size, soil_layers, &
+                vert_stag, .false., vert_unit1, vert_unit2, vert_sclFctr1, &
+                vert_sclFctr2, level1, level2)
+           
+           jpdtn = 0          ! Product definition template (0 for horiz grid)
+           JPDT(10) = vert_unit1     ! Type of first surface
+           JPDT(11) = vert_sclFctr1  ! Scale factor first surface
+           JPDT(12) = level1         ! First surface
+           JPDT(13) = vert_unit2     ! Type of second surface
+           JPDT(14) = vert_sclFctr2  ! Scale factor second surface
+           JPDT(15) = level2         ! Second fixed surface
+        endif
+
+        JGDTN    = -1    ! Indicates that any Grid Display Template is a match
+        
+        UNPACK   = .TRUE.! Unpack bitmap and data values
+        
+        fields_to_skip = 0
+        CALL GETGB2(DataHandle, 0, fields_to_skip, &
+             fileinfo(DataHandle)%recnum+1, &
+             Disc, JIDS, JPDTN, JPDT, JGDTN, JGDT, UNPACK, &
+             fileinfo(DataHandle)%recnum, gfld, status)
+        if (status .eq. 99) then
+           write(msg,*)'Could not find data for field '//trim(VarName)//&
+                ' in file '//trim(fileinfo(DataHandle)%DataFile)
+           call wrf_message(trim(msg))
+           Status = WRF_GRIB2_ERR_READ
+           return
+        else if (status .ne. 0) then
+           write(msg,*)'Retrieving data field '//trim(VarName)//' failed 2.',status,dim3,DataHandle
+           call wrf_message(trim(msg))
+           Status = WRF_GRIB2_ERR_READ
+           return
+        endif
+
+        if(FieldType == WRF_DOUBLE) then
+           di = 2
+        else 
+           di = 1
+        endif
+
+        ! 
+        ! Here, we do any necessary conversions to the data.
+        !
+        ! The WRF executable (wrf.exe) expects perturbation potential
+        !   temperature.  However, real.exe expects full potential T.
+        ! So, if the program is WRF, subtract 300 from Potential Temperature 
+        !   to get perturbation potential temperature.
+        !
+        if (VarName == 'T') then
+           if ( &
+                (InputProgramName .eq. 'REAL_EM') .or. &
+                (InputProgramName .eq. 'IDEAL') .or. &
+                (InputProgramName .eq. 'NDOWN_EM')) then
+              gfld%fld = gfld%fld - 300
+           endif
+        endif
+
+
+        if (ndims .eq. 1) then
+           CALL Transpose1D(MemoryOrder, di, FieldType, Field, &
+                MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), &
+                MemoryStart(3), MemoryEnd(3), &
+                gfld%fld, zsize)
+        else
+           CALL Transpose(MemoryOrder, di, FieldType, Field, &
+                MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), &
+                MemoryStart(3), MemoryEnd(3), &
+                gfld%fld, dim3, ysize,xsize)
+        endif
+!        CALL Transpose_new(MemoryOrder, di, FieldType, Field, &
+!             MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), &
+!             MemoryStart(3), MemoryEnd(3), &
+!             gfld%fld, dim1size,dim2size,dim3)
+        
+        call gf_free(gfld)
+        
+     enddo VERTDIM
+  endif
+
+  Status = WRF_NO_ERR
+
+
+  call wrf_debug ( DEBUG , 'Leaving ext_gr2_read_field')
+
+  RETURN
+END SUBROUTINE ext_gr2_read_field
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_next_var ( DataHandle, VarName, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: VarName
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_next_var')
+
+  Status = WRF_WARN_NOOP
+
+  RETURN
+END SUBROUTINE ext_gr2_get_next_var
+
+!*****************************************************************************
+
+subroutine ext_gr2_end_of_frame(DataHandle, Status)
+
+  USE gr2_data_info
+  implicit none
+#include "wrf_status_codes.h"
+  integer               ,intent(in)     :: DataHandle
+  integer               ,intent(out)    :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_end_of_frame')
+
+  Status = WRF_WARN_NOOP
+
+  return
+end subroutine ext_gr2_end_of_frame
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_iosync ( DataHandle, Status )
+
+  USE gr2_data_info  
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  integer                     :: ierror
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_iosync')
+
+  Status = WRF_NO_ERR
+  if (DataHandle .GT. 0) then
+     CALL flush_file(fileinfo(DataHandle)%FileFd)
+  else
+     Status = WRF_WARN_TOO_MANY_FILES
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_iosync
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_inquire_filename ( DataHandle, FileName , FileStat, &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStat
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER *80   SysDepInfo
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_inquire_filename')
+
+  FileName = fileinfo(DataHandle)%DataFile 
+
+  if ((DataHandle .ge. firstFileHandle) .and. &
+       (DataHandle .le. maxFileHandles)) then
+     FileStat = fileinfo(DataHandle)%FileStatus
+  else
+     FileStat = WRF_FILE_NOT_OPENED
+  endif
+  Status = WRF_NO_ERR
+
+  RETURN
+END SUBROUTINE ext_gr2_inquire_filename
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_info ( DataHandle , VarName , NDim , &
+     MemoryOrder , Stagger , DomainStart , DomainEnd , WrfType, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: VarName
+  integer               ,intent(out)    :: NDim
+  character*(*)         ,intent(out)    :: MemoryOrder
+  character*(*)         ,intent(out)    :: Stagger
+  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
+  integer               ,intent(out)    :: WrfType
+  integer               ,intent(out)    :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_info')
+
+  MemoryOrder = ""
+  Stagger = ""
+  DomainStart(1) = 0
+  DomainEnd(1) = 0
+  WrfType = 0
+  NDim = 0
+
+  CALL wrf_message('ext_gr2_get_var_info not supported for grib version2 data')
+  Status = WRF_NO_ERR
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_info
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_set_time ( DataHandle, DateStr, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  integer       :: found_time
+  integer       :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_set_time')
+
+  found_time = 0
+  do idx = 1,fileinfo(DataHandle)%NumberTimes
+     if (fileinfo(DataHandle)%Times(idx) == DateStr) then
+        found_time = 1
+        fileinfo(DataHandle)%CurrentTime = idx
+     endif
+  enddo
+  if (found_time == 0) then 
+     Status = WRF_WARN_TIME_NF
+  else
+     Status = WRF_NO_ERR
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_set_time
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_next_time ( DataHandle, DateStr, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(OUT) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_next_time')
+
+  if (fileinfo(DataHandle)%CurrentTime == fileinfo(DataHandle)%NumberTimes) then
+     Status = WRF_WARN_TIME_EOF
+  else
+     fileinfo(DataHandle)%CurrentTime = fileinfo(DataHandle)%CurrentTime + 1
+     DateStr = fileinfo(DataHandle)%Times(fileinfo(DataHandle)%CurrentTime)
+     Status = WRF_NO_ERR
+  endif
+
+  call wrf_debug ( DEBUG , 'Leaving ext_gr2_get_next_time, got time '//DateStr)
+
+  RETURN
+END SUBROUTINE ext_gr2_get_next_time
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_previous_time ( DataHandle, DateStr, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_previous_time')
+
+  if (fileinfo(DataHandle)%CurrentTime <= 0) then
+     Status = WRF_WARN_TIME_EOF
+  else
+     fileinfo(DataHandle)%CurrentTime = fileinfo(DataHandle)%CurrentTime - 1
+     DateStr = fileinfo(DataHandle)%Times(fileinfo(DataHandle)%CurrentTime)
+     Status = WRF_NO_ERR
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_get_previous_time
+
+!******************************************************************************
+!* Start of get_var_ti_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr2_get_var_ti_real ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)    :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,          INTENT(OUT)   :: Data(*)
+  INTEGER ,       INTENT(IN)    :: Count
+  INTEGER ,       INTENT(OUT)   :: OutCount
+  INTEGER ,       INTENT(OUT)   :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER(len=100)  :: Value
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_ti_real')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+  RETURN
+END SUBROUTINE ext_gr2_get_var_ti_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_ti_real8 ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)      :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,        INTENT(OUT)     :: Data(*)
+  INTEGER ,       INTENT(IN)      :: Count
+  INTEGER ,       INTENT(OUT)     :: OutCount
+  INTEGER ,       INTENT(OUT)     :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(100)  :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_ti_real8')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+  RETURN
+END SUBROUTINE ext_gr2_get_var_ti_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_ti_double ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(100)  :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_ti_double')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_ti_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_ti_integer ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)       :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,       INTENT(OUT)      :: Data(*)
+  INTEGER ,       INTENT(IN)       :: Count
+  INTEGER ,       INTENT(OUT)      :: OutCount
+  INTEGER ,       INTENT(OUT)      :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_ti_integer')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_ti_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_ti_logical ( DataHandle,Element,  Varname, Data, &
+     Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)       :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,       INTENT(OUT)      :: Data(*)
+  INTEGER ,       INTENT(IN)       :: Count
+  INTEGER ,       INTENT(OUT)      :: OutCount
+  INTEGER ,       INTENT(OUT)      :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(100) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_ti_logical')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_ti_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_ti_char ( DataHandle,Element,  Varname, Data,  &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER       :: stat
+
+  Status = WRF_NO_ERR
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_ti_char')
+
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(Element), Data, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_ti_char 
+
+!******************************************************************************
+!* End of get_var_ti_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of put_var_ti_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr2_put_var_ti_real ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,          INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_ti_real')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr2_build_string (ti_output(DataHandle), &
+          trim(VarName)//';'//trim(Element), tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_var_ti_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_ti_double ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_ti_double')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (ti_output(DataHandle), &
+          trim(VarName)//';'//trim(Element), tmpstr, Count, Status)
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_var_ti_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_ti_real8 ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,        INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_ti_real8')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (ti_output(DataHandle), &
+          trim(VarName)//';'//trim(Element), tmpstr, Count, Status)
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_var_ti_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_ti_integer ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_ti_integer')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (ti_output(DataHandle), &
+          trim(VarName)//';'//trim(Element), tmpstr, Count, Status)
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_var_ti_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_ti_logical ( DataHandle,Element,  Varname, Data, &
+     Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_ti_logical')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (ti_output(DataHandle), &
+          trim(Varname)//';'//trim(Element), tmpstr, Count, Status)
+
+  endif
+
+RETURN
+END SUBROUTINE ext_gr2_put_var_ti_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_ti_char ( DataHandle,Element,  Varname, Data,  &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER(len=*) :: Element
+  CHARACTER(len=*) :: VarName 
+  CHARACTER(len=*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  INTEGER                     :: Count
+  CHARACTER(len=1000) :: tmpstr(1)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_ti_char')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     write(tmpstr(1),*)trim(Data)
+
+     CALL gr2_build_string (ti_output(DataHandle), &
+          trim(VarName)//';'//trim(Element), tmpstr, 1, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_var_ti_char 
+
+!******************************************************************************
+!* End of put_var_ti_* routines
+!******************************************************************************
+
+!******************************************************************************
+!* Start of get_var_td_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr2_get_var_td_double ( DataHandle,Element,  DateStr, &
+     Varname, Data, Count, Outcount, Status )
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_td_double')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+RETURN
+END SUBROUTINE ext_gr2_get_var_td_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_td_real ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,          INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_td_real')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_td_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_td_real8 ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,        INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_td_real8')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_td_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_td_integer')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_td_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count, Outcount, Status )
+  
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_td_logical')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_td_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_var_td_char ( DataHandle,Element,  DateStr,Varname, &
+     Data,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER       :: stat
+
+  Status = WRF_NO_ERR
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_var_td_char')
+
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(VarName)//';'//trim(DateStr)//';'//trim(Element), Data, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(VarName)//';'//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_get_var_td_char 
+
+!******************************************************************************
+!* End of get_var_td_* routines
+!******************************************************************************
+
+!******************************************************************************
+!* Start of put_var_td_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr2_put_var_td_double ( DataHandle, Element, DateStr, Varname, &
+     Data, Count,  Status )
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_td_double')
+
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(Varname)//';'//trim(DateStr)//';'//trim(Element), &
+          tmpstr, Count, Status)
+
+  endif
+
+RETURN
+END SUBROUTINE ext_gr2_put_var_td_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_td_integer ( DataHandle,Element,  DateStr, &
+     Varname, Data, Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_td_integer')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(Varname)//';'//trim(DateStr)//';'//trim(Element), &
+          tmpstr, Count, Status)
+
+  endif
+
+RETURN
+END SUBROUTINE ext_gr2_put_var_td_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_td_real ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,          INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_td_real')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(Varname)//';'//trim(DateStr)//';'//trim(Element), &
+          tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_var_td_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_td_real8 ( DataHandle,Element,  DateStr,Varname, &
+     Data, Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,        INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_td_real8')
+
+  if (fileinfo(DataHandle)%committed) then
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(Varname)//';'//trim(DateStr)//';'//trim(Element), &
+          tmpstr, Count, Status)
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_var_td_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_td_logical ( DataHandle,Element,  DateStr, &
+     Varname, Data, Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_td_logical')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(Varname)//';'//trim(DateStr)//';'//trim(Element), &
+          tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_var_td_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_var_td_char ( DataHandle,Element,  DateStr,Varname, &
+     Data,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_var_td_char')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     write(tmpstr(idx),*)Data
+
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(Varname)//';'//trim(DateStr)//';'//trim(Element), &
+          tmpstr, 1, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_var_td_char 
+
+!******************************************************************************
+!* End of put_var_td_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of get_dom_ti_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_ti_real ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real ,          INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Outcount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_ti_real')
+
+  Status = WRF_NO_ERR
+
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_ti_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_ti_real8 ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,        INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_ti_real8')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_ti_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_ti_integer ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  integer ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_ti_integer Element: '//Element)
+
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = Count
+ 
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_ti_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_ti_logical ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_ti_logical')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_ti_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER       :: stat
+  INTEGER       :: endchar
+
+  Status = WRF_NO_ERR
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_ti_char')
+
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(Element), Data, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_ti_char 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_ti_double ( DataHandle,Element,   Data, Count, &
+     Outcount, Status )
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_ti_double')
+
+  Status = WRF_NO_ERR
+   
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+ 
+RETURN
+END SUBROUTINE ext_gr2_get_dom_ti_double
+
+!******************************************************************************
+!* End of get_dom_ti_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of put_dom_ti_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_ti_real ( DataHandle,Element,   Data, Count,  &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real ,          INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  CHARACTER(len=1000) :: tmpstr(1000)
+  character(len=2)    :: lf
+  integer             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_ti_real')
+
+  if (Element .eq. 'DX') then
+     dx = Data(1)/1000.
+  endif
+  if (Element .eq. 'DY') then
+     dy = Data(1)/1000.
+  endif
+  if (Element .eq. 'CEN_LAT') then
+     center_lat = Data(1)
+  endif
+  if (Element .eq. 'CEN_LON') then
+     center_lon = Data(1)
+  endif  
+  if (Element .eq. 'TRUELAT1') then
+     truelat1 = Data(1)
+  endif
+  if (Element .eq. 'TRUELAT2') then
+     truelat2 = Data(1)
+  endif
+  if (Element == 'STAND_LON') then
+     proj_central_lon = Data(1)
+  endif
+  if (Element == 'DT') then
+     timestep = Data(1)
+  endif
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (ti_output(DataHandle), Element, &
+          tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_ti_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_ti_real8 ( DataHandle,Element,   Data, Count,  &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,        INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_ti_real8')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (ti_output(DataHandle), Element, &
+          tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_ti_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  INTEGER ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_ti_integer')
+
+  if (Element == 'WEST-EAST_GRID_DIMENSION') then
+     full_xsize = Data(1)
+  else if (Element == 'SOUTH-NORTH_GRID_DIMENSION') then
+     full_ysize = Data(1)
+  else if (Element == 'MAP_PROJ') then
+     wrf_projection = Data(1)
+  else if (Element == 'BACKGROUND_PROC_ID') then
+     background_proc_id = Data(1)
+  else if (Element == 'FORECAST_PROC_ID') then
+     forecast_proc_id = Data(1)
+  else if (Element == 'PRODUCTION_STATUS') then
+     production_status = Data(1)
+  else if (Element == 'COMPRESSION') then
+     compression = Data(1)
+  endif
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (ti_output(DataHandle), Element, &
+          tmpstr, Count, Status)
+
+  endif
+
+  call wrf_debug ( DEBUG , 'Leaving ext_gr2_put_dom_ti_integer')
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_ti_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_ti_logical')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (ti_output(DataHandle), Element, &
+          tmpstr, Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_ti_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_ti_char ( DataHandle,Element,   Data,  &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*),     INTENT(IN)  :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  CHARACTER(len=1000) :: tmpstr
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_ti_char')
+
+  if (Element .eq. 'START_DATE') then
+
+     !
+     ! This is just a hack to fix a problem when outputting restart.  WRF
+     !   outputs both the initialization time and the time of the restart 
+     !   as the StartDate.  So, we ll just take the earliest.
+     !
+     if ((StartDate .eq. '') .or. (Data .le. StartDate)) then
+        StartDate = Data
+     endif
+
+  endif
+
+  if (fileinfo(DataHandle)%committed) then
+
+     write(tmpstr,*)trim(Data)
+     
+     CALL gr2_build_string (ti_output(DataHandle), Element, &
+          tmpstr, 1, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_ti_char
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_ti_double ( DataHandle,Element, Data, Count, &
+     Status )
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_ti_double')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr2_build_string (ti_output(DataHandle), Element, &
+          tmpstr, Count, Status)
+
+  endif
+  
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_ti_double
+
+!******************************************************************************
+!* End of put_dom_ti_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of get_dom_td_* routines
+!******************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_td_real ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,          INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_td_real')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_td_real 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_td_real8 ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,        INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_td_real8')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_td_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_td_integer')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_td_integer 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,       INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_td_logical')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_td_logical 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER       :: stat
+
+  Status = WRF_NO_ERR
+  
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_td_char')
+
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(DateStr)//';'//trim(Element), Data, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_get_dom_td_char 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_get_dom_td_double ( DataHandle,Element, DateStr,  Data, &
+     Count, Outcount, Status )
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER          :: idx
+  INTEGER          :: stat
+  CHARACTER*(1000) :: VALUE
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_get_dom_td_double')
+
+  Status = WRF_NO_ERR
+  
+  CALL gr2_get_metadata_value(global_input(DataHandle), &
+       trim(DateStr)//';'//trim(Element), Value, stat)
+  if (stat /= 0) then
+     CALL wrf_debug ( DEBUG , "gr2_get_metadata_value failed for "//trim(DateStr)//';'//trim(Element))
+     Status = WRF_WARN_VAR_NF
+     RETURN
+  endif
+
+  READ(Value,*,IOSTAT=stat)(Data(idx),idx=1,Count)
+  if (stat .ne. 0) then
+     CALL wrf_message("Reading data from"//Value//"failed")
+     Status = WRF_WARN_COUNT_TOO_LONG
+     RETURN
+  endif
+  Outcount = idx
+
+RETURN
+END SUBROUTINE ext_gr2_get_dom_td_double
+
+!******************************************************************************
+!* End of get_dom_td_* routines
+!******************************************************************************
+
+
+!******************************************************************************
+!* Start of put_dom_td_* routines
+!******************************************************************************
+
+
+SUBROUTINE ext_gr2_put_dom_td_real8 ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,        INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_td_real8')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(DateStr)//';'//trim(Element), tmpstr, &
+          Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_td_real8 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_td_integer')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(DateStr)//';'//trim(Element), tmpstr, &
+          Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_td_integer
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_td_logical')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(DateStr)//';'//trim(Element), tmpstr, &
+          Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_td_logical
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_td_char ( DataHandle,Element, DateStr,  Data, &
+     Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER(len=*), INTENT(IN)  :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1)
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_td_char')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     write(tmpstr(1),*)Data
+
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(DateStr)//';'//trim(Element), tmpstr, &
+          1, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_td_char 
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_td_double ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_td_double')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(DateStr)//';'//trim(Element), tmpstr, &
+          Count, Status)
+
+  endif
+
+RETURN
+END SUBROUTINE ext_gr2_put_dom_td_double
+
+!*****************************************************************************
+
+SUBROUTINE ext_gr2_put_dom_td_real ( DataHandle,Element, DateStr,  Data, &
+     Count,  Status )
+
+  USE gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,          INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER(len=1000) :: tmpstr(1000)
+  INTEGER             :: idx
+
+  call wrf_debug ( DEBUG , 'Entering ext_gr2_put_dom_td_real')
+
+  if (fileinfo(DataHandle)%committed) then
+
+     do idx = 1,Count
+        write(tmpstr(idx),'(G17.10)')Data(idx)
+     enddo
+     
+     CALL gr2_build_string (td_output(DataHandle), &
+          trim(DateStr)//';'//trim(Element), tmpstr, &
+          Count, Status)
+
+  endif
+
+  RETURN
+END SUBROUTINE ext_gr2_put_dom_td_real 
+
+
+!******************************************************************************
+!* End of put_dom_td_* routines
+!******************************************************************************
+
+
+SUBROUTINE gr2_get_new_handle(DataHandle)
+  USE gr2_data_info
+  IMPLICIT NONE
+  
+  INTEGER ,       INTENT(OUT)  :: DataHandle
+  INTEGER :: i
+
+  DataHandle = -1
+  do i=firstFileHandle, maxFileHandles
+     if (.NOT. fileinfo(i)%used) then
+        DataHandle = i
+        fileinfo(i)%used = .true.
+        exit
+     endif
+  enddo
+
+  RETURN
+END SUBROUTINE gr2_get_new_handle
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!*****************************************************************************
+
+SUBROUTINE gr2_retrieve_data (MemoryOrder, MemoryStart, MemoryEnd, xsize, ysize, &
+     zsize, z, FieldType, Field, data)
+  
+  IMPLICIT NONE
+
+#include "wrf_io_flags.h"
+
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  integer                       ,intent(in)    :: xsize, ysize, zsize
+  integer                       ,intent(in)    :: z
+  integer,dimension(*)          ,intent(in)    :: MemoryStart, MemoryEnd
+  integer                       ,intent(in)    :: FieldType
+  real                          ,intent(in),       &
+       dimension( 1:1,MemoryStart(1):MemoryEnd(1), &
+       MemoryStart(2):MemoryEnd(2), &
+       MemoryStart(3):MemoryEnd(3) )           :: Field
+  real   ,dimension(1:xsize,1:ysize),intent(inout) :: data
+
+  integer                                      :: x, y, idx
+  integer, dimension(:,:),   pointer           :: mold
+  integer                                      :: istat
+  integer                                      :: dim1
+  
+  ALLOCATE(mold(1:xsize,1:ysize), STAT=istat)
+  if (istat .ne. 0) then
+     print *,'Could not allocate space for mold, returning'
+     return
+  endif
+
+  !
+  ! Set the size of the first dimension of the data array (dim1) to xsize.  
+  !    If the MemoryOrder is Z or z, dim1 is overridden below.
+  !
+  dim1 = xsize
+
+  SELECT CASE (MemoryOrder)
+  CASE ('XYZ')
+     data = Field(1,1:xsize,1:ysize,z)
+  CASE ('C')
+     data = Field(1,1:xsize,1:ysize,z)
+  CASE ('XZY')
+     data = Field(1,1:xsize,z,1:ysize)
+  CASE ('YXZ')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,y,x,z)
+        enddo
+     enddo
+  CASE ('YZX')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,y,z,x)
+        enddo
+     enddo
+  CASE ('ZXY')
+     data = Field(1,z,1:xsize,1:ysize)
+  CASE ('ZYX')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,z,y,x)
+        enddo
+     enddo
+  CASE ('XY')
+     data = Field(1,1:xsize,1:ysize,1)
+  CASE ('YX')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,y,x,1)
+        enddo
+     enddo
+     
+  CASE ('XSZ')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,y,z,x)
+        enddo
+     enddo
+  CASE ('XEZ')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,y,z,x)
+        enddo
+     enddo
+  CASE ('YSZ')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,x,z,y)
+        enddo
+     enddo
+  CASE ('YEZ')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,x,z,y)
+        enddo
+     enddo
+     
+  CASE ('XS')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,y,x,1)
+        enddo
+     enddo
+  CASE ('XE')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,y,x,1)
+        enddo
+     enddo
+  CASE ('YS')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,x,y,1)
+        enddo
+     enddo
+  CASE ('YE')
+     do x = 1,xsize
+        do y = 1,ysize
+           data(x,y) = Field(1,x,y,1)
+        enddo
+     enddo
+  CASE ('Z')
+     data(1:zsize,1) = Field(1,1:zsize,1,1)
+     dim1 = zsize
+  CASE ('z')
+     data(1:zsize,1) = Field(1,zsize:1,1,1)
+     dim1 = zsize
+  CASE ('0')
+     data(1,1) = Field(1,1,1,1)
+  END SELECT
+  
+  ! 
+  ! Here, we convert any integer fields to real
+  !
+  if (FieldType == WRF_INTEGER) then
+     mold = 0
+     do idx=1,dim1
+        !
+        ! The parentheses around data(idx,:) are needed in order
+        !   to fix a bug with transfer with the xlf compiler on NCARs
+        !   IBM (bluesky).
+        !
+        data(idx,:)=transfer((data(idx,:)),mold)
+     enddo
+  endif
+
+  deallocate(mold)
+  
+  return
+
+end subroutine gr2_retrieve_data
+
+!*****************************************************************************
+
+SUBROUTINE gr2_get_levels(VarName, zidx, zsize, soil_layers, vert_stag, &
+     fraction, vert_unit1, vert_unit2, vert_sclFctr1, vert_sclFctr2, &
+     level1, level2)
+
+  use gr2_data_info
+  IMPLICIT NONE
+
+  integer :: zidx
+  integer :: zsize
+  logical :: soil_layers
+  logical :: vert_stag
+  logical :: fraction
+  integer :: vert_unit1, vert_unit2
+  integer :: vert_sclFctr1, vert_sclFctr2
+  integer :: level1
+  integer :: level2
+  character (LEN=*) :: VarName
+
+  ! Setup vert_unit, and vertical levels in grib units
+
+  if ((VarName .eq. 'LANDUSEF') .or. (VarName .eq. 'SOILCTOP') &
+       .or. (VarName .eq. 'SOILCBOT')) then
+     vert_unit1 = 105;
+     vert_unit2 = 255;
+     vert_sclFctr1 = 0
+     vert_sclFctr2 = 0
+     level1 = zidx
+     level2 = 0
+  else if ((zsize .gt. 1) .and. (.not. soil_layers) .and. (.not. fraction)) &
+       then
+     vert_unit1 = 111;
+     vert_unit2 = 255;
+     vert_sclFctr1 = 4
+     vert_sclFctr2 = 4
+     if (vert_stag) then
+        level1 = (10000*full_eta(zidx)+0.5)
+     else
+        level1 = (10000*half_eta(zidx)+0.5)
+     endif
+     level2 = 0
+  else
+     ! Set the vertical coordinate and level for soil and 2D fields
+     if (fraction) then
+        vert_unit1 = 105
+        vert_unit2 = 255
+        level1 = zidx
+        level2 = 0
+        vert_sclFctr1 = 0
+        vert_sclFctr2 = 0
+     else if (soil_layers) then
+        vert_unit1 = 106
+        vert_unit2 = 106
+        level1 = 100*(soil_depth(zidx) - 0.5*soil_thickness(zidx))+0.5
+        level2 = 100*(soil_depth(zidx) + 0.5*soil_thickness(zidx))+0.5
+        vert_sclFctr1 = 2
+        vert_sclFctr2 = 2
+     else if (VarName .eq. 'mu') then
+        vert_unit1 = 105
+        vert_unit2 = 255
+        level1 = 0
+        level2 = 0
+        vert_sclFctr1 = 0
+        vert_sclFctr2 = 0
+     else if ((VarName .eq. 'Q2') .or. (VarName .eq. 'TH2') .or. &
+        (VarName .eq. 'T2')) then
+        vert_unit1 = 103
+        vert_unit2 = 255
+        level1 = 2
+        level2 = 0
+        vert_sclFctr1 = 0
+        vert_sclFctr2 = 0
+     else if ((VarName .eq. 'Q10') .or. (VarName .eq. 'TH10') .or. &
+          (VarName .eq. 'U10') .or. (VarName .eq. 'V10')) then
+        vert_unit1 = 103
+        vert_unit2 = 255
+        level1 = 10
+        level2 = 0
+        vert_sclFctr1 = 0
+        vert_sclFctr2 = 0
+     else 
+        vert_unit1 = 1
+        vert_unit2 = 255
+        level1 = 0
+        level2 = 0
+        vert_sclFctr1 = 0
+        vert_sclFctr2 = 0
+     endif
+  endif
+
+end SUBROUTINE gr2_get_levels
+
+!*****************************************************************************
+
+subroutine gr2_create_w(StartDate, cgrib, lcgrib, production_status, Disc, &
+     center, subcenter, MasterTblV, LocalTblV, ierr, msg)
+
+  implicit none
+
+  character*24 ,intent(in)     :: StartDate
+  character*(*),intent(inout)  :: cgrib
+  integer      ,intent(in)     :: lcgrib
+  integer      ,intent(in)     :: production_status
+  integer      ,intent(out)    :: ierr
+  character*(*),intent(out)    :: msg
+  integer , dimension(13)      :: listsec1
+  integer , dimension(2)       :: listsec0
+  integer                      :: slen
+  integer , intent(in)         :: Disc, center, subcenter, MasterTblV, LocalTblV
+
+  ! 
+  ! Create the grib message
+  !
+  listsec0(1) = Disc       ! Discipline (Table 0.0)
+  listsec0(2) = 2          ! Grib edition number
+
+  listsec1(1) = center     ! Id of Originating Center (255 for missing)
+  listsec1(2) = subcenter  ! Id of originating sub-center (255 for missing)
+  listsec1(3) = MasterTblV ! Master Table Version #
+  listsec1(4) = LocalTblV  ! Local table version #
+  listsec1(5) = 1          ! Significance of reference time, 1 indicates start of forecast
+
+  READ(StartDate(1:4),  '(I4)') listsec1(6) ! Year of reference
+
+  READ(StartDate(6:7),  '(I2)') listsec1(7) ! Month of reference
+
+  READ(StartDate(9:10), '(I2)') listsec1(8) ! Day of reference
+
+  slen = LEN(StartDate)
+
+  if (slen.GE.13) then
+     read(StartDate(12:13),'(I2)') listsec1(9)
+  else
+     listsec1(9) = 0
+  endif
+
+  if (slen.GE.16) then
+     read(StartDate(15:16),'(I2)') listsec1(10)
+  else
+     listsec1(10) = 0
+  endif
+
+  if (slen.GE.19) then
+     read(StartDate(18:19),'(I2)') listsec1(11)
+  else
+     listsec1(11) = 0
+  end if
+
+  listsec1(12) = production_status  ! Production status of data
+  listsec1(13) = 1     ! Type of data (1 indicates forecast products)
+
+  call gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr)
+
+  if (ierr .ne. 0) then
+     write(msg,*) 'gribcreate failed with ierr: ',ierr
+  else
+     msg = ''
+  endif
+  
+end SUBROUTINE gr2_create_w
+
+
+!*****************************************************************************
+subroutine gr2_addgrid_w(cgrib, lcgrib, central_lat, central_lon, wrf_projection, &
+     latin1, latin2, nx, ny, dx, dy, center_lat, center_lon, ierr,msg)
+  
+  implicit none
+
+  character*(*)            ,intent(inout)   :: cgrib
+  integer                  ,intent(in)      :: lcgrib
+  real                     ,intent(in)      :: central_lat
+  real                     ,intent(in)      :: central_lon
+  integer                  ,intent(in)      :: wrf_projection
+  real                     ,intent(in)      :: latin1
+  real                     ,intent(in)      :: latin2
+  integer                  ,intent(in)      :: nx
+  integer                  ,intent(in)      :: ny
+  real                     ,intent(in)      :: dx
+  real                     ,intent(in)      :: dy
+  real                     ,intent(in)      :: center_lat
+  real                     ,intent(in)      :: center_lon
+  integer                  ,intent(out)     :: ierr
+  character*(*)            ,intent(out)     :: msg
+  integer, dimension(5)                     :: igds
+  integer, parameter                        :: igdstmplen = 25
+  integer, dimension(igdstmplen)            :: igdstmpl
+  integer, parameter                        :: idefnum = 0
+  integer, dimension(idefnum)               :: ideflist
+  real                                      :: LLLa, LLLo, URLa, URLo
+  real                                      :: incrx, incry
+  real, parameter                           :: deg_to_microdeg = 1e6
+  real, parameter                           :: km_to_mm = 1e6
+  real, parameter                           :: km_to_m = 1e3
+  real, parameter                           :: PI = 3.141593
+  real, parameter                           :: DEG_TO_RAD = PI/180
+  real, parameter                           :: RAD_TO_DEG = 180/PI
+  real, parameter                           :: ERADIUS = 6370.0
+
+  igds(1) = 0      ! Source of grid definition
+  igds(2) = nx*ny  ! Number of points in grid
+  igds(3) = 0      ! 
+  igds(4) = 0
+
+  ! Here, setup the parameters that are common to all WRF projections
+
+  igdstmpl(1) = 1       ! Shape of earth (1 for spherical with specified radius)
+  igdstmpl(2) = 1       ! Scale factor for earth radius
+  igdstmpl(3) = ERADIUS*km_to_m ! Radius of earth
+  igdstmpl(4) = 0       ! Scale factor for major axis
+  igdstmpl(5) = 0       ! Major axis
+  igdstmpl(6) = 0       ! Scale factor for minor axis
+  igdstmpl(7) = 0       ! Minor axis
+  igdstmpl(8) = nx      ! Number of points along x axis
+  igdstmpl(9) = ny      ! Number of points along y axis
+  
+  !
+  ! Setup increments in "x" and "y" direction.  For LATLON projection
+  !   increments need to be in degrees.  For all other projections, 
+  !   increments are in km.
+  !
+
+  if (wrf_projection .eq. WRF_LATLON) then
+     incrx = RAD_TO_DEG*(dx/(ERADIUS*cos(latin1*DEG_TO_RAD)))
+     incry = RAD_TO_DEG*(dy/ERADIUS)
+  else
+     incrx = dx
+     incry = dy
+  endif
+
+  ! Latitude and longitude of first (i.e., lower left) grid point
+  call get_ll_latlon(central_lat, central_lon, wrf_projection, &
+       latin1, latin2, nx, ny, incrx, incry, center_lat, center_lon, &
+       LLLa, LLLo, URLa, URLo, ierr);
+
+  select case (wrf_projection)
+
+  case(WRF_LATLON)
+     igds(5) = 0
+     igdstmpl(10) = 0    ! Basic Angle of init projection (not important to us)
+     igdstmpl(11) = 0    ! Subdivision of basic angle
+     igdstmpl(12) = LLLa*deg_to_microdeg
+     igdstmpl(13) = LLLo*deg_to_microdeg
+     call gr2_convert_lon(igdstmpl(13))
+     igdstmpl(14) = 128  ! Resolution and component flags
+     igdstmpl(15) = URLa*deg_to_microdeg
+     igdstmpl(16) = URLo*deg_to_microdeg
+     call gr2_convert_lon(igdstmpl(16))
+
+     ! Warning, the following assumes that dx and dy are valid at the equator.
+     !    It is not clear in WRF where dx and dy are valid for latlon projections
+     igdstmpl(17) = incrx*deg_to_microdeg ! i-direction increment in micro degs
+     igdstmpl(18) = incry*deg_to_microdeg ! j-direction increment in micro degs
+
+     igdstmpl(19) = 64   ! Scanning mode
+  case(WRF_MERCATOR)
+     igds(5) = 10
+     igdstmpl(10) = LLLa*deg_to_microdeg
+     igdstmpl(11) = LLLo*deg_to_microdeg
+     call gr2_convert_lon(igdstmpl(11))
+     igdstmpl(12) = 128  ! Resolution and component flags
+     igdstmpl(13) = latin1*deg_to_microdeg  ! "True" latitude
+     igdstmpl(14) = URLa*deg_to_microdeg
+     igdstmpl(15) = URLo*deg_to_microdeg
+     call gr2_convert_lon(igdstmpl(15))
+     igdstmpl(16) = 64   ! Scanning mode
+     igdstmpl(17) = 0    ! Orientation of grid between i-direction and equator
+     igdstmpl(18) = dx*km_to_mm   ! i-direction increment
+     igdstmpl(19) = dy*km_to_mm   ! j-direction increment
+  case(WRF_LAMBERT)
+     igds(5) = 30
+     
+     igdstmpl(10) = LLLa*deg_to_microdeg
+     igdstmpl(11) = LLLo*deg_to_microdeg
+     call gr2_convert_lon(igdstmpl(11))
+     igdstmpl(12) = 128 ! Resolution and component flag
+     igdstmpl(13) = latin1*deg_to_microdeg ! Latitude where Dx and Dy are specified
+     igdstmpl(14) = central_lon*deg_to_microdeg
+     call gr2_convert_lon(igdstmpl(14))
+     igdstmpl(15) = dx*km_to_mm  ! x-dimension grid-spacing  in units of m^-3
+     igdstmpl(16) = dy*km_to_mm
+     if (center_lat .lt. 0) then
+        igdstmpl(17) = 1
+     else
+        igdstmpl(17) = 0
+     endif
+     igdstmpl(18) = 64   ! Scanning mode
+     igdstmpl(19) = latin1*deg_to_microdeg
+     igdstmpl(20) = latin2*deg_to_microdeg
+     igdstmpl(21) = -90*deg_to_microdeg
+     igdstmpl(22) = central_lon*deg_to_microdeg
+     call gr2_convert_lon(igdstmpl(22))
+
+  case(WRF_POLAR_STEREO)
+     igds(5) = 20
+     igdstmpl(10) = LLLa*deg_to_microdeg
+     igdstmpl(11) = LLLo*deg_to_microdeg
+     call gr2_convert_lon(igdstmpl(11))
+     igdstmpl(12) = 128 ! Resolution and component flag
+     igdstmpl(13) = latin1*deg_to_microdeg ! Latitude where Dx and Dy are specified
+     igdstmpl(14) = central_lon*deg_to_microdeg
+     call gr2_convert_lon(igdstmpl(14))
+     igdstmpl(15) = dx*km_to_mm  ! x-dimension grid-spacing  in units of m^-3
+     igdstmpl(16) = dy*km_to_mm
+     if (center_lat .lt. 0) then
+        igdstmpl(17) = 1
+     else
+        igdstmpl(17) = 0
+     endif
+     igdstmpl(18) = 64   ! Scanning mode
+
+  case default
+     write(msg,*) 'invalid WRF projection: ',wrf_projection
+     ierr = -1
+     return
+  end select
+
+
+  call addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen,ideflist,idefnum,ierr)
+  if (ierr .ne. 0) then
+     write(msg,*) 'addgrid failed with ierr: ',ierr
+  else
+     msg = ''
+  endif
+
+end subroutine gr2_addgrid_w
+
+!*****************************************************************************
+
+subroutine gr2_addfield_w(cgrib, lcgrib, VarName, parmcat, parmnum, DecScl, &
+     BinScl, fcst_secs, vert_unit1, vert_unit2, vert_sclFctr1, vert_sclFctr2, &
+     numlevels, levels, ngrdpts, background_proc_id, forecast_proc_id, &
+     compression, fld, ierr, msg)
+  
+  implicit none
+
+  character*(*)            ,intent(inout)   :: cgrib
+  integer                  ,intent(in)      :: lcgrib
+  character (LEN=*)        ,intent(in)      :: VarName
+  integer                  ,intent(in)      :: parmcat,parmnum,DecScl,BinScl
+  real                     ,intent(in)      :: fcst_secs
+  integer                  ,intent(in)      :: vert_unit1, vert_unit2
+  integer                  ,intent(in)      :: vert_sclFctr1, vert_sclFctr2
+  integer                  ,intent(in)      :: numlevels
+  integer, dimension(*)    ,intent(in)      :: levels
+  integer                  ,intent(in)      :: ngrdpts
+  real                     ,intent(in)      :: fld(ngrdpts)
+  integer                  ,intent(in)      :: background_proc_id
+  integer                  ,intent(in)      :: forecast_proc_id
+  integer                  ,intent(in)      :: compression
+  integer                  ,intent(out)     :: ierr
+  character*(*)            ,intent(out)     :: msg
+  integer                                   :: ipdsnum
+  integer, parameter                        :: ipdstmplen = 15
+  integer, dimension(ipdstmplen)            :: ipdstmpl
+  integer                                   :: numcoord
+  integer, dimension(numlevels)             :: coordlist
+  integer                                   :: idrsnum
+  integer, parameter                        :: idrstmplen = 7
+  integer, dimension(idrstmplen)            :: idrstmpl
+  integer                                   :: ibmap
+  integer, dimension(1)                     :: bmap
+
+  if (numlevels .gt. 2) then
+     ipdsnum = 1000           ! Product definition tmplate (1000 for cross-sxn)
+  else
+     ipdsnum = 0              ! Product definition template (0 for horiz grid)
+  endif
+
+  ipdstmpl(1) = parmcat    ! Parameter category
+  ipdstmpl(2) = parmnum    ! Parameter number
+  ipdstmpl(3) = 2          ! Type of generating process (2 for forecast)
+  ipdstmpl(4) = background_proc_id ! Background generating process id
+  ipdstmpl(5) = forecast_proc_id   ! Analysis or forecast generating process id
+  ipdstmpl(6) = 0          ! Data cutoff period (Hours)
+  ipdstmpl(7) = 0          ! Data cutoff period (minutes)
+  ipdstmpl(8) = 13         ! Time range indicator (13 for seconds)
+  ipdstmpl(9) = NINT(fcst_secs) ! Forecast time
+
+  if (ipdsnum .eq. 1000) then
+     numcoord = numlevels
+     coordlist = levels(1:numlevels)
+
+     !
+     ! Set Data Representation templ (Use 0 for vertical cross sections,
+     !    since there seems to be a bug in g2lib for JPEG2000 and PNG)
+     !
+     idrsnum = 0
+
+  else if (ipdsnum .eq. 0) then
+     ipdstmpl(10) = vert_unit1    ! Type of first surface (111 for Eta level)
+     ipdstmpl(11) = vert_sclFctr1 ! Scale factor for 1st surface
+     ipdstmpl(12) = levels(1)     ! First fixed surface
+     ipdstmpl(13) = vert_unit2    ! Type of second fixed surface
+     ipdstmpl(14) = vert_sclFctr2 ! Scale factor for 2nd surface
+     if (numlevels .eq. 2) then 
+        ipdstmpl(15) = levels(2)
+     else
+        ipdstmpl(15) = 0
+     endif
+     numcoord = 0
+     coordlist(1) = 0
+
+     ! Set Data Representation templ (40 for JPEG2000, 41 for PNG)  
+     idrsnum = compression
+
+  endif
+
+
+  if (idrsnum == 40) then    ! JPEG 2000
+
+     idrstmpl(1) = 255       ! Reference value - ignored on input
+     idrstmpl(2) = BinScl    ! Binary scale factor
+     idrstmpl(3) = DecScl    ! Decimal scale factor 
+     idrstmpl(4) = 0         ! number of bits for each data value - ignored on input
+     idrstmpl(5) = 0         ! Original field type - ignored on input
+     idrstmpl(6) = 0         ! 0 for lossless compression
+     idrstmpl(7) = 255       ! Desired compression ratio if idrstmpl(6) != 0
+
+  else if (idrsnum == 41) then ! PNG
+
+     idrstmpl(1) = 255       ! Reference value - ignored on input
+     idrstmpl(2) = BinScl    ! Binary scale factor
+     idrstmpl(3) = DecScl    ! Decimal scale factor 
+     idrstmpl(4) = 0         ! number of bits for each data value - ignored on input
+     idrstmpl(5) = 0         ! Original field type - ignored on input
+
+  else if (idrsnum == 0) then! Simple packing 
+
+     idrstmpl(1) = 255       ! Reference value - ignored on input
+     idrstmpl(2) = BinScl    ! Binary scale factor
+     idrstmpl(3) = DecScl    ! Decimal scale factor 
+     idrstmpl(4) = 0         ! number of bits for each data value - ignored on input
+     idrstmpl(5) = 0         ! Original field type - ignored on input
+     
+  else
+     
+     write (msg,*) 'addfield failed because Data Representation template',&
+          idrsnum,' is invalid'
+     ierr = 1
+     return
+
+  endif
+
+  ibmap = 255                ! Flag for bitmap
+  
+  call addfield(cgrib, lcgrib, ipdsnum, ipdstmpl, ipdstmplen, coordlist,      &
+       numcoord, idrsnum, idrstmpl, idrstmplen, fld, ngrdpts, ibmap,          &
+       bmap, ierr)
+
+  if (ierr .ne. 0) then
+     write(msg,*) 'addfield failed with ierr: ',ierr
+  else
+     msg = ''
+  endif
+
+end subroutine gr2_addfield_w
+
+!*****************************************************************************
+
+subroutine gr2_fill_local_use(DataHandle,string,VarName,fcsts,msg,status)
+
+  use gr2_data_info
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+
+  integer,         intent(in)    :: DataHandle
+  character*(*)   ,intent(inout) :: string
+  character*(*)   ,intent(in)    :: VarName
+  integer                        :: center, subcenter, MasterTblV, LocalTblV, &
+       Disc, Category, ParmNum, DecScl, BinScl
+  integer         ,intent(out)   :: status
+  character*(*)   ,intent(out)   :: msg
+  integer , parameter            :: lcgrib = 1000000
+  character (lcgrib)             :: cgrib
+  real, dimension(1,1)           :: data
+  integer                        :: lengrib
+  integer                        :: lcsec2
+  integer                        :: fcsts
+  integer                        :: bytes_written
+  
+  ! 
+  ! Set data to a default dummy value.
+  !
+  data = 1.0
+
+  !
+  ! This statement prevents problems when calling addlocal in the grib2
+  !   library.  Basically, if addlocal is called with an empty string, it
+  !   will be encoded correctly by the grib2 routine, but the grib2 routines
+  !   that read the data (i.e., getgb2) will segfault.  This prevents that 
+  !   segfault.
+  !
+
+  if (string .eq. '') string = 'none'
+
+  CALL get_parminfo(VarName, center, subcenter, MasterTblV, &
+       LocalTblV, Disc, Category, ParmNum, DecScl, BinScl, status)
+  if (status .ne. 0) then
+     write(msg,*) 'Could not find parameter for '//   &
+          trim(VarName)//'   Skipping output of '//trim(VarName)
+     call wrf_message(trim(msg))
+     Status =  WRF_GRIB2_ERR_GRIB2MAP
+     return
+  endif
+
+  !
+  ! Create the indicator and identification sections (sections 0 and 1)
+  !
+  CALL gr2_create_w(StartDate, cgrib, lcgrib, production_status, Disc, &
+             center, subcenter, MasterTblV, LocalTblV, status, msg)
+  if (status .ne. 0) then
+     call wrf_message(trim(msg))
+     Status = WRF_GRIB2_ERR_GRIBCREATE
+     return
+  endif
+
+  ! 
+  ! Add the local use section
+  !
+  lcsec2 = len_trim(string)
+  call addlocal(cgrib,lcgrib,string,lcsec2,status)
+  if (status .ne. 0) then
+     call wrf_message(trim(msg))
+     Status = WRF_GRIB2_ERR_ADDLOCAL
+     return
+  endif
+
+  !
+  ! Add the grid definition section (section 3) using a 1x1 grid
+  !
+  call gr2_addgrid_w(cgrib, lcgrib, center_lat, proj_central_lon,  &
+       wrf_projection, truelat1, truelat2, 1, 1, dx, dy,       &
+       center_lat, center_lon, status, msg)
+  if (status .ne. 0) then
+     call wrf_message(trim(msg))
+     Status = WRF_GRIB2_ERR_ADDGRIB
+     return
+  endif
+
+  !
+  ! Add the Product Definition, Data representation, bitmap 
+  !      and data sections (sections 4-7)
+  !
+  call gr2_addfield_w(cgrib, lcgrib, VarName, Category, ParmNum, DecScl, &
+       BinScl, fcsts, 1, 255, 0, 0, 1, 0, 1, &
+       background_proc_id, forecast_proc_id, compression, data, status, msg)
+  if (status .ne. 0) then
+     call wrf_message(trim(msg))
+     Status = WRF_GRIB2_ERR_ADDFIELD
+     return
+  endif
+
+  !
+  ! Close out the message
+  !
+  
+  call gribend(cgrib,lcgrib,lengrib,status)
+  if (status .ne. 0) then
+     write(msg,*) 'gribend failed with status: ',status     
+     call wrf_message(trim(msg))
+     Status = WRF_GRIB2_ERR_GRIBEND
+     return
+  endif
+
+  ! 
+  ! Write the data to the file
+  !
+  
+  call bawrite(DataHandle, -1, lengrib, bytes_written, cgrib)
+!!  call write_file_n(fileinfo(DataHandle)%FileFd, cgrib, lengrib, status)
+  if (bytes_written .ne. lengrib) then
+     write(msg,*) '2 Error writing cgrib to file, wrote: ', &
+          bytes_written, ' bytes.  Tried to write ', lengrib, ' bytes'
+     call wrf_message(trim(msg))
+     Status = WRF_GRIB2_ERR_WRITE
+     return
+  endif
+
+  ! Set string back to the original blank value
+  if (string .eq. '') string = ''
+
+  return
+
+end subroutine gr2_fill_local_use
+
+!*****************************************************************************
+!
+! Set longitude to be in the range of 0-360 degrees.
+!
+!*****************************************************************************
+
+subroutine gr2_convert_lon(value)
+
+  IMPLICIT NONE
+
+  integer, intent(inout) :: value
+  real, parameter                           :: deg_to_microdeg = 1e6
+
+  do while (value .lt. 0) 
+     value = value + 360*deg_to_microdeg
+  enddo
+
+  do while (value .gt. 360*deg_to_microdeg) 
+     value = value - 360*deg_to_microdeg
+  enddo
+
+end subroutine gr2_convert_lon
+
+
+!*****************************************************************************
+!
+! Add a time to the list of times
+!
+!*****************************************************************************
+
+subroutine gr2_add_time(DataHandle,addTime)
+
+  USE gr2_data_info
+  IMPLICIT NONE
+
+  integer           :: DataHandle
+  character (len=*) :: addTime
+  integer           :: idx
+  logical           :: already_have = .false.
+  logical           :: swap
+  character (len=len(addTime)) :: tmp
+  character (DateStrLen), dimension(:),pointer  :: tmpTimes(:)
+  integer,parameter :: allsize = 50
+  integer           :: ierr
+  
+  already_have = .false.
+  do idx = 1,fileinfo(DataHandle)%NumberTimes 
+     if (addTime .eq. fileinfo(DataHandle)%Times(idx)) then
+        already_have = .true.
+     endif
+  enddo
+  
+  if (.not. already_have) then
+     fileinfo(DataHandle)%NumberTimes = fileinfo(DataHandle)%NumberTimes + 1
+
+     if (fileinfo(DataHandle)%NumberTimes .gt. &
+          fileinfo(DataHandle)%sizeAllocated) then
+
+        if (fileinfo(DataHandle)%NumberTimes .eq. 1) then
+
+           if (allocated(fileinfo(DataHandle)%Times)) &
+                deallocate(fileinfo(DataHandle)%Times)
+
+           allocate(fileinfo(DataHandle)%Times(allsize), stat = ierr)
+           if (ierr .ne. 0) then
+              call wrf_message('Could not allocate space for Times 1, exiting')
+              stop
+           endif
+
+           fileinfo(DataHandle)%sizeAllocated = allsize
+
+        else
+
+           allocate(tmpTimes(fileinfo(DataHandle)%NumberTimes), stat=ierr)
+
+           tmpTimes = &
+                fileinfo(DataHandle)%Times(1:fileinfo(DataHandle)%NumberTimes)
+
+           deallocate(fileinfo(DataHandle)%Times)
+
+           allocate(&
+                fileinfo(DataHandle)%Times(fileinfo(DataHandle)%sizeAllocated+allsize), stat=ierr)
+
+           if (ierr .ne. 0) then
+              call wrf_message('Could not allocate space for Times 2, exiting')
+              stop
+           endif
+
+           fileinfo(DataHandle)%Times(1:fileinfo(DataHandle)%NumberTimes) = &
+                tmpTimes
+
+           deallocate(tmpTimes)
+           
+        endif
+        
+     endif
+
+     fileinfo(DataHandle)%Times(fileinfo(DataHandle)%NumberTimes) = addTime
+  
+     ! Sort the Times array
+
+     swap = .true.
+     do while (swap)
+        swap = .false.
+        do idx = 1,fileinfo(DataHandle)%NumberTimes - 1
+           if (fileinfo(DataHandle)%Times(idx) .gt. fileinfo(DataHandle)%Times(idx+1)) then
+              tmp = fileinfo(DataHandle)%Times(idx)
+              fileinfo(DataHandle)%Times(idx) = fileinfo(DataHandle)%Times(idx+1)
+              fileinfo(DataHandle)%Times(idx+1) = tmp
+              swap = .true.
+           endif
+        enddo
+     enddo
+
+  endif
+
+  return
+
+end subroutine gr2_add_time
+
+
+!*****************************************************************************
+!
+! Fill an array of levels
+!
+!*****************************************************************************
+
+subroutine gr2_fill_levels(DataHandle,VarName,levels,ierr)
+
+  USE gr2_data_info
+  USE grib_mod
+  IMPLICIT NONE
+
+#include "wrf_status_codes.h"
+
+
+  integer            :: DataHandle
+  character (len=*)  :: VarName
+  REAL,DIMENSION(*)  :: levels
+  integer            :: ierr
+  integer :: JIDS(JIDSSIZE), JPDTN, JPDT(JPDTSIZE), JGDTN, &
+       JGDT(JGDTSIZE)
+  type(gribfield)    :: gfld
+  integer            :: status, fields_to_skip
+  logical            :: unpack
+  integer            :: center, subcenter, MasterTblV, LocalTblV, &
+       Disc, Category, ParmNum, DecScl, BinScl
+  CHARACTER (LEN=maxMsgSize) :: msg
+
+
+  CALL get_parminfo(VarName, center, subcenter, MasterTblV, &
+       LocalTblV, Disc, Category, ParmNum, DecScl, BinScl, status)
+  if (status .ne. 0) then
+     write(msg,*) 'Could not find parameter for '//   &
+          trim(VarName)//'   Skipping output of '//trim(VarName)
+     call wrf_message(trim(msg))
+     ierr = -1
+     return
+  endif
+
+
+  !
+  ! First, set all values to wild, then specify necessary values
+  !
+  call gr2_g2lib_wildcard(JIDS, JPDT, JGDT)
+
+  JIDS(1) = center
+  JIDS(2) = subcenter
+  JIDS(3) = MasterTblV
+  JIDS(4) = LocalTblV
+  JIDS(5) = 1           ! Indicates that time is "Start of Forecast"
+  JIDS(13) = 1          ! Type of processed data (1 for forecast products)
+  
+  JPDTN = 1000          ! Product definition template number
+  JPDT(1) = Category
+  JPDT(2) = ParmNum
+  JPDT(3) = 2           ! Generating process id
+
+  JGDTN    = -1         ! Indicates that any Grid Display Template is a match
+  
+  UNPACK   = .TRUE.     ! Unpack bitmap and data values
+
+
+  fields_to_skip = 0
+
+  CALL GETGB2(DataHandle, 0, fields_to_skip, -1, Disc, JIDS, JPDTN, &
+       JPDT, JGDTN, JGDT, UNPACK, fileinfo(DataHandle)%recnum, &
+       gfld, status)
+  if (status .eq. 99) then
+     write(msg,*)'Could not find field '//trim(VarName)//&
+          ' continuing.'
+     call wrf_message(trim(msg))
+     ierr = -1
+     return
+  else if (status .ne. 0) then
+     write(msg,*)'Retrieving scalar data field '//trim(VarName)//&
+          ' failed, continuing.'
+     call wrf_message(trim(msg))
+     ierr = -1
+     return
+  endif
+  
+  levels(1:gfld%ndpts) = gfld%fld(1:gfld%ndpts)
+  ierr = 0
+  
+end subroutine gr2_fill_levels
+
+
+!*****************************************************************************
+!
+! Set values for search array arguments for getgb2 to missing.
+!
+!*****************************************************************************
+
+subroutine gr2_g2lib_wildcard(JIDS, JPDT, JGDT)
+
+  USE gr2_data_info
+  integer :: JIDS(*), JPDT(*), JGDT(*)
+
+  do idx = 1,JIDSSIZE
+     JIDS(idx) = -9999
+  enddo
+  
+  do idx=1,JPDTSIZE
+     JPDT(idx) = -9999
+  enddo
+  
+  do idx = 1,JGDTSIZE
+     JGDT(idx) = -9999
+  enddo
+
+  return
+
+end subroutine gr2_g2lib_wildcard
+!*****************************************************************************
+!
+! Retrieve a metadata value from the input string
+!
+!*****************************************************************************
+
+subroutine gr2_get_metadata_value(instring, Key, Value, stat)
+  character(len=*),intent(in)  :: instring
+  character(len=*),intent(in)  :: Key
+  character(len=*),intent(out) :: Value
+  integer         ,intent(out) :: stat
+  integer :: Key_pos, equals_pos, line_end
+  character :: lf
+
+  lf=char(10)
+
+  Value = 'abc'
+
+  !
+  ! Find Starting position of Key
+  !
+  Key_pos = index(instring, lf//' '//Key//' =')
+  if (Key_pos .eq. 0) then
+     stat = -1
+     return
+  endif
+
+  !
+  ! Find position of the "=" after the Key
+  !
+  equals_pos = index(instring(Key_pos:len(instring)), "=") + Key_pos
+  if (equals_pos .eq. Key_pos) then
+     stat = -1
+     return
+  endif
+
+  !
+  ! Find end of line
+  !
+  line_end = index(instring(equals_pos:len(instring)), lf) + equals_pos
+
+  !
+  ! Handle the case for the last line in the string
+  !
+  if (line_end .eq. equals_pos) then
+     line_end = len(trim(instring))
+  endif
+
+  !
+  ! Set value
+  !
+  if ( (equals_pos + 1) .le. (line_end - 2) ) then
+     Value = trim(adjustl(instring(equals_pos+1:line_end-2)))
+  else
+     Value = ""
+  endif
+  
+  stat = 0
+  
+
+end subroutine gr2_get_metadata_value
+
+!*****************************************************************************
+!
+! Build onto a metadata string with the input value
+!
+!*****************************************************************************
+
+SUBROUTINE gr2_build_string (string, Element, Value, Count, Status)
+
+  IMPLICIT NONE
+#include "wrf_status_codes.h"
+
+  CHARACTER (LEN=*) , INTENT(INOUT) :: string
+  CHARACTER (LEN=*) , INTENT(IN)    :: Element
+  CHARACTER (LEN=*) , INTENT(IN)    :: Value(*)
+  INTEGER ,           INTENT(IN)    :: Count
+  INTEGER ,           INTENT(OUT)   :: Status
+
+  CHARACTER (LEN=2)                 :: lf
+  INTEGER                           :: IDX
+
+  lf=char(10)//' '
+
+  if (index(string,lf//Element//' =') .gt. 0) then
+     ! We do nothing, since we dont want to add the same variable twice.
+  else 
+     if (len_trim(string) == 0) then
+        string = lf//Element//' = '
+     else
+        string = trim(string)//lf//Element//' = '
+     endif
+     do idx = 1,Count
+        if (idx > 1) then
+           string = trim(string)//','
+        endif
+        string = trim(string)//' '//trim(adjustl(Value(idx)))
+     enddo
+  endif
+
+  Status = WRF_NO_ERR
+
+END SUBROUTINE gr2_build_string
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/read_grib2map.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/read_grib2map.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/read_grib2map.F	(revision 2744)
@@ -0,0 +1,444 @@
+!*****************************************************************************
+!
+! Routine to fill a grib2map structure (linked list).
+!
+!*****************************************************************************
+
+subroutine load_grib2map(filename, msg, ierr)
+
+  USE grib2tbls_types
+  Implicit None
+
+  character*(*), intent(in)                   :: filename
+  character*(*), intent(inout)                :: msg
+  integer      , intent(out)                  :: ierr
+  integer                                     :: status = 0
+  integer                                     :: fileunit
+  logical                                     :: foundunit
+  character*(maxLineSize)                     :: line
+  integer                                     :: firstval
+  integer                                     :: numtables = 0
+  character*(1)                               :: delim
+  integer                                     :: lastpos
+  integer                                     :: pos
+  integer                                     :: idx
+  integer                                     :: end
+  logical                                     :: lerr
+
+  ! Open the file
+
+  ! First pass:
+  !  Scan the file to determine how many tables are included, and how many
+  !     entries are in each table.
+  !
+
+  ! Find an open fileunit
+  foundunit = .false.
+  do fileunit = 10,100 
+     inquire(unit=fileunit,opened=lerr)
+     if (lerr .eqv. .false.) then
+        foundunit = .true.
+        exit
+     endif
+  enddo
+  if (foundunit .neqv. .true.) then
+     write(msg, *)'Could not find unit to open ',filename
+     ierr = -1
+     return
+  endif
+
+  ! Open the file
+  open ( unit = fileunit, file=filename, status = 'old', iostat = status)
+  if (status .ne. 0) then
+     write(msg, *)'Could not open file ',filename
+     ierr = -1
+     return
+  endif
+
+  ! Loop through each line to count the number of tables and entries in 
+  !   each table.
+  
+  READLINE: do
+     !
+     ! Read the line, skip line if line is comment, blank or invalid
+     !
+     read(fileunit,'(A)',iostat=status) line
+     line = adjustl(line)
+     if (status .lt. 0) then
+        exit
+     endif
+     if (len_trim(line) .eq. 0) then
+        cycle READLINE
+     endif
+     if (line(1:1) .eq. '#') then
+        cycle READLINE
+     endif
+
+     !
+     ! Read the first value in the line
+     !
+     read(line,*,iostat=status) firstval
+     if (status .ne. 0) then
+        print *,'Skipping Invalid line in',trim(filename),':'
+        print *,'''',trim(line),''''
+        cycle READLINE
+     endif
+
+
+     ! 
+     ! If the first value is -1, weve found a new table.  Allocate
+     !    a new member in the linked list, and add the information
+     !    to that member
+     !
+     if (firstval .eq. -1) then
+        numtables = numtables + 1
+
+        !
+        ! Create and allocate the next member of the linked list
+        !
+        if (.NOT. ASSOCIATED(TblHead)) THEN
+           ALLOCATE (TblHead, stat=status)
+           if (status .ne. 0) then
+              print *,'Could not allocate space for TblHead'
+              exit READLINE
+           endif
+           TblTail => TblHead
+        else
+           ALLOCATE (TblTail%next, STAT=status)
+           if (status .ne. 0) then
+              print *,'Could not allocate space for TblTail%next, continuing'
+              cycle READLINE
+           endif
+           TblTail%previous => TblTail
+           TblTail => TblTail%next
+        endif
+        nullify(TblTail%next)
+        nullify(TblTail%ParmHead)
+        
+        !
+        ! Parse the header line
+        !
+        lastpos = 0
+        do idx = 1,5
+           pos = index(line(lastpos+1:maxLineSize), "|")
+
+           if (pos .lt. 0) then
+              print *,'Found invalid header line: '
+              print *,'''',trim(line),''''
+              if (associated(TblTail%previous)) then
+                 TblTail => TblTail%previous
+              else
+                 nullify(TblTail)
+              endif
+              cycle READLINE
+           endif
+
+           SELECT CASE (idx)
+           CASE (1)
+              ! Do nothing, since this is just the indicator value
+           CASE (2)
+              read(line(lastpos+1:lastpos+pos-1),*,iostat=status) TblTail%center
+              if (status .ne. 0) then
+                 print *,'Found invalid header line: '
+                 print *,'''',trim(line),''''
+                 cycle READLINE
+              endif
+           CASE (3)
+              read(line(lastpos+1:lastpos+pos-1),*,iostat=status) TblTail%subcenter
+              if (status .ne. 0) then
+                 print *,'Found invalid header line: '
+                 print *,'''',trim(line),''''
+                 cycle READLINE
+              endif
+           CASE (4)
+              read(line(lastpos+1:lastpos+pos-1),*,iostat=status) TblTail%MasterTblV
+              if (status .ne. 0) then
+                 print *,'Found invalid header line: '
+                 print *,'''',trim(line),''''
+                 cycle READLINE
+              endif
+           CASE (5)
+              read(line(lastpos+1:lastpos+pos-1),*,iostat=status) TblTail%LocalTblV
+              if (status .ne. 0) then
+                 print *,'Found invalid header line: '
+                 print *,'''',trim(line),''''
+                 cycle READLINE
+              endif
+           END SELECT
+
+           lastpos = lastpos+pos
+
+        enddo
+
+#ifdef TEST
+! Test
+        print *,'Header Line: '
+        print *,TblTail%center, TblTail%subcenter, TblTail%MasterTblV, &
+              TblTail%LocalTblV
+#endif
+
+
+        !
+        ! We found the header, cycle so that the header is not interpereted
+        !   as a parameter line.
+        !
+        cycle READLINE
+
+     endif
+
+     if (.NOT. ASSOCIATED(TblTail%ParmHead)) then
+        ALLOCATE (TblTail%ParmHead, stat=status)
+        if (status .ne. 0) then
+           print *,'Could not allocate space for TblTail%ParmHead, continuing'
+           cycle READLINE
+        endif
+        TblTail%ParmTail => TblTail%ParmHead
+     else
+        ALLOCATE (TblTail%ParmTail%next, STAT=status)
+        if (status .ne. 0) then
+           print *,'Could not allocate space for TblTail%ParmTail%next, continuing'
+           cycle READLINE
+        endif
+        TblTail%ParmTail%previous => TblTail%ParmTail
+        TblTail%ParmTail => TblTail%ParmTail%next
+     endif
+     nullify(TblTail%ParmTail%next)
+
+     !
+     ! Parse the Parameter line
+     !
+     lastpos = 0
+     do idx = 1,7
+        pos = index(line(lastpos+1:maxLineSize), "|")
+        
+        if (pos .lt. 0) then
+           print *,'Found invalid header line: '
+           print *,'''',trim(line),''''
+           if (associated(TblTail%previous)) then
+              TblTail => TblTail%previous
+           else
+              nullify(TblTail)
+           endif
+           cycle READLINE
+        endif
+        
+        SELECT CASE (idx)
+        CASE (1)
+           read(line(lastpos+1:lastpos+pos-1),*,iostat=status) TblTail%ParmTail%Disc
+           if (status .ne. 0) then
+              print *,'Found invalid line: '
+              print *,'''',trim(line),''''
+              cycle READLINE
+           endif
+        CASE (2)
+           read(line(lastpos+1:lastpos+pos-1),*,iostat=status) TblTail%ParmTail%Category
+           if (status .ne. 0) then
+              print *,'Found invalid line: '
+              print *,'''',trim(line),''''
+              cycle READLINE
+           endif
+        CASE (3)
+           read(line(lastpos+1:lastpos+pos-1),*,iostat=status) TblTail%ParmTail%ParmNum
+           if (status .ne. 0) then
+              print *,'Found invalid line: '
+              print *,'''',trim(line),''''
+              cycle READLINE
+           endif
+        CASE (4)
+           TblTail%ParmTail%WRFNameString = &
+                trim(adjustl(line(lastpos+1:lastpos+pos-1)))
+        CASE (5)
+           TblTail%ParmTail%Description = &
+                trim(adjustl(line(lastpos+1:lastpos+pos-1)))
+        CASE (6)
+           read(line(lastpos+1:lastpos+pos-1),*,iostat=status) TblTail%ParmTail%DecScl
+           if (status .ne. 0) then
+              print *,'Found invalid line: '
+              print *,'''',trim(line),''''
+              cycle READLINE
+           endif
+        CASE (7)
+           read(line(lastpos+1:lastpos+pos-1),*,iostat=status) TblTail%ParmTail%BinScl
+           if (status .ne. 0) then
+              print *,'Found invalid line: '
+              print *,'''',trim(line),''''
+              cycle READLINE
+           endif
+        END SELECT
+        
+        lastpos = lastpos+pos
+        
+     enddo
+      
+#ifdef TEST
+! Test Code
+     delim = '|'
+     write(6,'(I4,A1,I4,A1,I4,A1,A12,A1,A42,A1,I4,A1,I4,A1)')          &
+          TblTail%ParmTail%Disc,        delim,                         &
+          TblTail%ParmTail%Category,    delim,                         &
+          TblTail%ParmTail%ParmNum,     delim,                         &
+          trim(TblTail%ParmTail%WRFNameString), delim,                 &
+          trim(TblTail%ParmTail%Description), delim,                   &
+          TblTail%ParmTail%DecScl,      delim,                         &
+          TblTail%ParmTail%BinScl,      delim
+#endif
+
+     !
+     ! Parse the WRFNameString
+     !
+     status = 0
+     lastpos = 0
+     idx = 1
+     do while (pos .gt. 0) 
+        pos = index(TblTail%ParmTail%WRFNameString(lastpos+1:maxLineSize), ",")
+        if (pos .le. 0) then
+           end = lastpos+maxLineSize
+        else
+           end = lastpos+pos-1
+        endif
+        read(TblTail%ParmTail%WRFNameString(lastpos+1:end),*) &
+             TblTail%ParmTail%WRFNames(idx)
+        lastpos = lastpos + pos
+        idx = idx + 1
+     enddo
+     TblTail%ParmTail%numWRFNames = idx-1
+
+#ifdef TEST
+     write(6,*)'WRFNames: ',&
+          (trim(TblTail%ParmTail%WRFNames(idx)),' ', &
+          idx=1,TblTail%ParmTail%numWRFNames)
+#endif
+
+  enddo READLINE
+
+  close ( unit = fileunit)
+
+end subroutine load_grib2map
+
+!*****************************************************************************
+!
+! Routine to find and return the grib2 information associated with a WRF 
+!    parameter.
+!
+!*****************************************************************************
+
+subroutine get_parminfo(parmname, center, subcenter, MasterTblV, &
+     LocalTblV, Disc, Category, ParmNum, DecScl, BinScl, ierr)
+  
+  USE grib2tbls_types
+  Implicit None
+
+  character*(*),intent(in)  :: parmname
+  integer     ,intent(out)  :: center, subcenter, MasterTblV, LocalTblV, &
+       Disc, Category, ParmNum, DecScl, BinScl
+  TYPE (grib2Entries_type), pointer            :: ParmPtr
+  TYPE (grib2tbls_type) , pointer              :: TblPtr
+  integer                                      :: idx
+  logical                                      :: found
+  integer                                      :: ierr
+
+
+  !
+  ! Loop through tables
+  !
+
+  found = .false.
+  TblPtr => TblHead
+  TABLE : DO
+
+     if ( .not. associated(TblPtr)) then
+        exit TABLE
+     endif
+
+     !
+     ! Loop through parameters
+     !
+     ParmPtr => TblPtr%ParmHead
+
+     PARAMETER : DO 
+
+        if ( .not. associated(ParmPtr)) then
+           exit PARAMETER
+        endif
+
+        ! 
+        ! Loop through WRF parameter names for the table parameter entry
+        !
+        WRFNAME : do idx = 1,ParmPtr%numWRFNames
+           if (parmname .eq. ParmPtr%WRFNames(idx)) then
+              found = .true.
+              exit TABLE
+           endif
+        enddo WRFNAME
+
+        ParmPtr => ParmPtr%next
+
+     ENDDO PARAMETER
+
+     TblPtr => TblPtr%next
+  ENDDO TABLE
+
+  if (found) then
+     center     = TblPtr%center
+     subcenter  = TblPtr%subcenter
+     MasterTblV = TblPtr%MasterTblV
+     LocalTblV  = TblPtr%LocalTblV
+     Disc       = ParmPtr%Disc
+     Category   = ParmPtr%Category
+     ParmNum    = ParmPtr%ParmNum
+     DecScl     = ParmPtr%DecScl
+     BinScl     = ParmPtr%BinScl
+     ierr       = 0
+  else
+     ierr       = 1
+  endif
+
+end subroutine get_parminfo
+
+!*****************************************************************************
+!
+! Routine to free the lists.
+!
+!*****************************************************************************
+
+subroutine free_grib2map()
+  USE grib2tbls_types
+  Implicit None
+
+  TYPE (grib2Entries_type), pointer            :: ParmPtr
+  TYPE (grib2Entries_type), pointer            :: ParmSave
+  TYPE (grib2tbls_type) , pointer              :: TblPtr
+  TYPE (grib2tbls_type) , pointer              :: TblSave
+
+  TblPtr => TblHead
+  TABLE : DO
+
+     if ( .not. associated(TblPtr)) then
+        exit TABLE
+     endif
+
+     !
+     ! Loop through parameters
+     !
+     ParmPtr => TblPtr%ParmHead
+
+     PARAMETER : DO 
+
+        if ( .not. associated(ParmPtr)) then
+           exit PARAMETER
+        endif
+
+        ParmSave => ParmPtr%next
+        deallocate(ParmPtr)
+        ParmPtr => ParmSave
+
+     ENDDO PARAMETER
+
+     
+     TblSave => TblPtr%next
+     deallocate(TblPtr)
+     TblPtr => TblSave
+
+  ENDDO TABLE
+
+end subroutine free_grib2map
Index: trunk/WRF.COMMON/WRFV2/external/io_grib2/test_read_grib2map.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib2/test_read_grib2map.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib2/test_read_grib2map.F	(revision 2744)
@@ -0,0 +1,46 @@
+PROGRAM test_read_grib2map
+
+  USE grib2tbls_types
+  Implicit None
+
+  INTERFACE
+     Subroutine load_grib2map (filename, grib2tbls)
+       USE grib2tbls_types
+       character*(*), intent(in)                   :: filename
+       TYPE(grib2tbls_type), dimension(:), pointer :: grib2tbls
+     END subroutine load_grib2map
+  END INTERFACE
+
+  TYPE(grib2tbls_type), dimension(:), pointer :: grib2tbls
+  character(200)                              :: filename = 'grib2map.tbl'
+
+  character*30              :: parmname
+  integer                   :: center, subcenter, MasterTblV, LocalTblV, &
+       Disc, Category, ParmNum, DecScl, BinScl
+  integer                   :: ierr
+
+
+  CALL load_grib2map(filename,grib2tbls)
+
+  parmname = 'T2'
+  CALL get_parminfo(parmname, center, subcenter, MasterTblV, &
+     LocalTblV, Disc, Category, ParmNum, DecScl, BinScl, ierr)
+
+  if (ierr .ne. 0) then
+     print *,'Could not find match for parameter: ',parmname
+  else
+     print *,'Found match: '
+     print *, '  center:    ',center
+     print *, '  subcenter: ',subcenter
+     print *, '  MasterTblV ',MasterTblV
+     print *, '  LocalTblV  ',LocalTblV
+     print *, '  Disc       ',Disc
+     print *, '  Category   ',Category
+     print *, '  ParmNum    ',ParmNum
+     print *, '  DecScl     ',DecScl
+     print *, '  BinScl     ',BinScl
+  endif
+  
+  CALL free_grib2map(grib2tbls)
+
+END PROGRAM
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/Makefile	(revision 2744)
@@ -0,0 +1,87 @@
+#------------------------------------------------------------------------------
+#  Makefile for producing libdbclient.so 
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+
+.SUFFIXES:      .c .o
+
+#
+# Specity location for Makefiles that are included.
+#
+INCLUDEDIRS = -I.
+BUILD_DIR = $(IO_GRIB_SHARE_DIR)./build
+#
+# Specify directory that output library is to be put in.
+#
+LIB_DEST = .
+#
+#  SPECIFY local include directories used during compilation of source code. 
+#
+#    CXX_INCLUDES is for C++ files
+#    C_INCLUDES is for C files
+#
+C_INCLUDES   = -I.
+CXX_INCLUDES = -I.
+F_INCLUDES   = -I.
+ARFLAGS      = cruv
+
+FORMAT = $(FREE)
+
+#
+#  SPECIFY any subdirectories containing libraries that may be dynamically
+#          linked by this library.
+#
+SUB_DIRS =
+
+#
+#  SPECIFY information for building a library:
+#
+#    LIB_NAME - Fragment of name of the library to build
+#               e.g. if library file name is libfoo.so, set LIB_NAME = foo 
+#    DEP_LIBS - The tokens required to link a shared library against other
+#               shared libraries upon which it depends.  DEP_LIBS should
+#               contain -L<dir> tokens to specify where the dependent 
+#               libraries are, and -l<lib> tokens to specify libraries to link.
+#    OBJS     - List of object files that go into the library.
+#
+#  NOTES:
+#  1. Be careful about whitespace after the last character in the LIB_NAME.
+#     These spaces will generate an error when the library is made.
+#
+LIB_NAME = io_grib_share
+SYS_DEFINES =
+DEP_LIBS = 
+OBJS =  \
+	io_grib_share.o \
+	get_region_center.o \
+	gridnav.o \
+	open_file.o
+
+#
+#  List of subdirectories to which to pass make commands.
+#
+LIB_DIRS = 
+EXE_DIRS =
+SUB_DIRS = $(LIB_DIRS) $(EXE_DIRS)
+
+#
+#  Clean up old build files
+#
+superclean:
+	/bin/rm -f *.o > /dev/null 2>&1
+	/bin/rm -f *.f90 > /dev/null 2>&1
+	/bin/rm -f *.mod > /dev/null 2>&1
+	/bin/rm -f *.a > /dev/null 2>&1
+
+
+#
+#  Include the boilerplate rules for building library modules.
+#
+include $(BUILD_DIR)/library_rules.mk
+
+#
+#  Compile dependencies.  These are appended to this file by make depend. 
+#
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/TEST_RESULTS
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/TEST_RESULTS	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/TEST_RESULTS	(revision 2744)
@@ -0,0 +1,134 @@
+file TEST_RESULTS
+Tom Henderson
+
+A series of tests were run on AIX and OSF1 machines prior to committing 
+Todd Hutchinson's grib1 and grib2 packages to the repository.  These are 
+described in detail below.  
+
+In addition, Todd ran many tests on his Linux systems, including a pass 
+through vgrind for memory checking.  
+
+
+NOTE ONE KNOWN BUG:  
+  RUC LSM fails in lsmrucinit() when grib1 input is used (divide-by-zero 
+  error).  Not sure if this is due to compression (accuracy -- sure hope 
+  not!) or due to some mis-configuration of gribmap.txt, or something 
+  else.  
+
+
++------------------+
+| TEST DEFINITIONS |
++------------------+
+ALL TESTS were run with the jan00 test case using default settings from 
+test/em_real/namelist.input.jan01 unless otherwise indicated below.  
+
+TESTan:  Read netCDF, write netCDF, 1 MPI task
+TESTbn:  Read netCDF, write netCDF, 4 MPI tasks
+TESTcn:  Read netCDF, write netCDF bitwise identical, 1 vs. 4 MPI tasks
+TESTdn:  Write netCDF from real
+TESTqn:  Read netCDF, write netCDF, 4 MPI tasks + 2 MPI quilt tasks
+TESTrn:  TESTqn wrfout file vs. TESTan, bitwise identical
+TESTa1:  Read netCDF, write grib1, 1 MPI task
+TESTb1:  Read netCDF, write grib1, 4 MPI tasks
+TESTc1:  Read netCDF, write grib1 bitwise identical, 1 vs. 4 MPI tasks
+TESTd1:  Write grib1 from real
+TESTe1:  Read grib1, write netCDF, 1 MPI task
+TESTf1:  Read grib1, write netCDF, 4 MPI tasks
+TESTg1:  Read grib1, write netCDF bitwise identical, 1 vs. 4 MPI tasks 
+TESTh1:  TESTe1 wrfout file vs. TESTan, bitwise identical
+TESTq1:  Read netCDF, write grib1, 4 MPI tasks + 2 MPI quilt tasks
+TESTr1:  TESTq1 wrfout file vs. TESTa1, bitwise identical
+TESTa2:  Read netCDF, write grib2, 1 MPI task
+TESTb2:  Read netCDF, write grib2, 4 MPI tasks
+TESTc2:  Read netCDF, write grib2 bitwise identical, 1 vs. 4 MPI tasks
+TESTd2:  Write grib2 from real
+TESTe2:  Read grib2, write netCDF, 1 MPI task
+TESTf2:  Read grib2, write netCDF, 4 MPI tasks
+TESTg2:  Read grib2, write netCDF bitwise identical, 1 vs. 4 MPI tasks
+TESTh2:  TESTe2 wrfout file vs. TESTan, bitwise identical
+TESTq2:  Read netCDF, write grib2, 4 MPI tasks + 2 MPI quilt tasks
+TESTr2:  TESTq2 wrfout file vs. TESTa2, bitwise identical
+TESTab:  Read netCDF, write binary, 1 MPI task
+TESTbb:  Read netCDF, write binary, 4 MPI tasks
+TESTcb:  Read netCDF, write binary bitwise identical, 1 vs. 4 MPI tasks
+TESTdb:  Write binary from real
+TESTeb:  Read binary, write netCDF, 1 MPI task
+TESTfb:  Read binary, write netCDF, 4 MPI tasks
+TESTgb:  Read binary, write netCDF bitwise identical, 1 vs. 4 MPI tasks
+TESThb:  TESTeb wrfout file vs. TESTan, bitwise identical
+TESTib:  Read binary, write binary, 4 MPI tasks
+TESTjb:  TESTbb wrfout file vs. TESTib, bitwise identical
+TESTqb:  Read netCDF, write binary, 4 MPI tasks + 2 MPI quilt tasks
+TESTrb:  TESTqb wrfout file vs. TESTab, bitwise identical
+
+
++-------------------+
+| TEST RESULT TABLE |
++-------------------+
+TEST RESULT TABLE KEYS:  
+Tested Configurations:
+  v6j  bluevista, config=3, OBJECT_MODE=64,  built with    jasper
+  v6   bluevista, config=3, OBJECT_MODE=64,  built without jasper
+  s3j  bluesky,   config=3, OBJECT_MODE=32,  built with    jasper
+  s3   bluesky,   config=3, OBJECT_MODE=32,  built without jasper
+  s6j  bluesky,   config=3, OBJECT_MODE=64,  built with    jasper
+  j    joshua,    config=5, no optimization, built without jasper
+Test Results:
+  'P'  PASS
+  'P1' PASS, but see note "1"
+  'F'  FAIL
+  'X'  Skip test.  (For example, grib2 tests cannot be done without jasper).  
+  ' '  To Be Done
++------------------------------------------+---+---+---+---+---+---+
+| VERSION:   trunk_r1718_WORK       Config |v6j|v6 |s3j|s3 |s6j| j |
++------------------------------------------+---+---+---+---+---+---+
+| TESTan:  RnetCDF WnetCDF 1 MPI           | P | P | P | P | P | P |
+| TESTbn:  RnetCDF WnetCDF 4 MPI           | P | P | P | P | P | P |
+| TESTcn:  RnetCDF WnetCDF 1 vs. 4 MPI     | P | P | P | P | P | P |
+| TESTdn:  WnetCDF from real               | P | P | P | P | P | P |
+| TESTqn:  RnetCDF WnetCDF 4 MPI + 2 quilt | P | P | P | P | P | P |
+| TESTrn:  TESTan vs. TESTqn               | P | P | P | P | P | P |
+| TESTa1:  RnetCDF Wgrib1 1 MPI            | P | P | P | P | P | P |
+| TESTb1:  RnetCDF Wgrib1 4 MPI            | P | P | P | P | P | P |
+| TESTc1:  RnetCDF Wgrib1 1 vs. 4 MPI      | P | P | P | P | P | P |
+| TESTd1:  Wgrib1 from real                | P | P | P | P | P | P |
+| TESTe1:  Rgrib1 WnetCDF 1 MPI            | P | P | P | P | P | P |
+| TESTf1:  Rgrib1 WnetCDF 4 MPI            | P | P | P | P | P | P |
+| TESTg1:  Rgrib1 WnetCDF 1 vs. 4 MPI      | P | P | P | P | P | P |
+| TESTh1:  TESTe1 vs. all-netCDF           | P*| P*| P*| P*| P*|   |
+| TESTq1:  RnetCDF Wgrib1 4 MPI + 2 quilt  | P | P | P | P | P | P |
+| TESTr1:  TESTa1 vs. TESTq1               | P1| P1| P1| P1| P1| P1|
+| TESTa2:  RnetCDF Wgrib2 1 MPI            | P | X | P | X | P | X |
+| TESTb2:  RnetCDF Wgrib2 4 MPI            | P | X | P | X | P | X |
+| TESTc2:  RnetCDF Wgrib2 1 vs. 4 MPI      | P | X | P | X | P | X |
+| TESTd2:  Wgrib2 from real                | P | X | P | X | P | X |
+| TESTe2:  Rgrib2 WnetCDF 1 MPI            | P | X | P | X | P | X |
+| TESTf2:  Rgrib2 WnetCDF 4 MPI            | P | X | P | X | P | X |
+| TESTg2:  Rgrib2 WnetCDF 1 vs. 4 MPI      | P | X | P | X | P | X |
+| TESTh2:  TESTe2 vs. all-netCDF           |   | X |   | X |   | X |
+| TESTq2:  RnetCDF Wgrib2 4 MPI + 2 quilt  | P | X | P | X | P | X |
+| TESTr2:  TESTa2 vs. TESTq2               | P3| X | P3| X | P3| X |
+| TESTab:  RnetCDF Wbinary 1 MPI           | P | P | P | P | P | P |
+| TESTbb:  RnetCDF Wbinary 4 MPI           | P | P | P | P | P | P |
+| TESTcb:  RnetCDF Wbinary 1 vs. 4 MPI     | P | P | P | P | P | P2|
+| TESTdb:  Wbinary from real               | P | P | P | P | P | P |
+| TESTeb:  Rbinary WnetCDF 1 MPI           | P | P | P | P | P | P |
+| TESTfb:  Rbinary WnetCDF 4 MPI           | P | P | P | P | P | P |
+| TESTgb:  Rbinary WnetCDF 1 vs. 4 MPI     | P | P | P | P | P | P |
+| TESThb:  TESTeb vs. all-netCDF           | P | P | P | P | P | P |
+| TESTib:  Rbinary Wbinary 4 MPI           | P | P | P | P | P | P |
+| TESTjb:  TESTbb vs. TESTib               | P2| P2| P2| P2| P2| P2|
+| TESTqb:  RnetCDF Wbinary 4 MPI + 2 quilt | P | P | P | P | P | P |
+| TESTrb:  TESTab vs. TESTqb               | P2| P2| P2| P2| P2| P2|
++------------------------------------------+---+---+---+---+---+---+
+| NOTES:                                                       |
+|   * Jimy says this looks OK but someone should compare       |
+|     plots...                                                 |
+|   1 For TESTr1, some bytes differ but                        |
+|     external/io_grib1/diffwrf says files match.              |
+|   2 For TESTjb and TESTrb, some bytes differ but             |
+|     external/io_int/diffwrf says files match.                |
+|   3 For TESTr2, some bytes differ, need to test with grib2   |
+|     version of diffwrf.                                      |
++--------------------------------------------------------------+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/application_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/application_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/application_rules.mk	(revision 2744)
@@ -0,0 +1,74 @@
+#------------------------------------------------------------------------------
+#  Make rules for building an application program.
+#
+#  This file is intended for use in Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/application_rules.mk
+#
+#  It is assumed that the environment has been set by sourcing the build
+#  resource file (buildrc).
+# 
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  RULES for building one or more applications programs.
+#  Each APPNAME is comprised of the same object files. 
+# 
+all: exe config
+
+exe: $(OBJS) 
+	@for p in $(APPNAMES); do \
+		echo "Building application program $$p..." ; \
+		$(LDD) $(DEBUG) $(OPTIMIZE) $(APP_DEFS) -o $$p $(OBJS) $(DEP_LIBS) ;\
+		mv -f $$p $(BIN_DEST) ;\
+	done
+
+#
+#  Include the RULES for compilation and installation of config files.
+#
+include $(BUILD_DIR)/compile_rules.mk
+include $(BUILD_DIR)/config_rules.mk
+
+#
+#  RULE for building a library
+#
+#  For exe modules, these do nothing, but we define one so that make lib 
+#  can be passed down to all source directories.
+#
+lib:
+	@echo "make lib does nothing for application modules"
+
+#
+#  RULES for cleaning up derived files.
+#
+#  'clean' removes all objects produced by this file, as well as other 
+#      extraneous artifacts of compiling and building applications.
+# 
+#      A subsequent make will both recompile the source code and recreate
+#      the executable.  clean also removes files core files and other
+#      auxilliary files created during compilation.
+#
+#  'clean_exe' removes application programs.
+#
+clean: 
+	@/bin/rm -f *.o core so_locations Makefile.bak *~ #*#
+	@/bin/rm -fr ii_files
+
+clean_exe:
+	@/bin/rm -f $(BIN_DEST)/$(APP_NAME)
+
+#
+#  RULES for creating the include dependencies.
+#
+include $(BUILD_DIR)/depend_rules.mk
+
+clean_depend: generic_clean_depend
+
+depend: generic_depend
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/binary_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/binary_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/binary_rules.mk	(revision 2744)
@@ -0,0 +1,122 @@
+#------------------------------------------------------------------------------
+#  Make rules for installing binary files to a specified destination
+#
+#  This file is intended for use in Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/binary_rules.mk
+#
+#  It is assumed that the environment has been set by sourcing the build
+#  resource file (buildrc).
+# 
+#  This file defines the following rules for binary files:
+#
+#      all, binary, utest, exe, clean, clean_lib, clean_exe,
+#      clean_depend, depend.
+#
+#  Copyright (C) 2002, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  RULES for installing scripts and script modules 
+#
+#    EXE_SRC specifies a list of files that contain executable scripts.
+#    Each file in the list will be installed in the $(BIN_DEST) directory
+#    and will be given executable permissions.  If the variable EXE_EXT is
+#    set, this extension will be stripped from the end of the source file
+#    when it is installed, e.g. if EXE_SRC = "foo.pl" and EXE_EXT = ".pl",
+#    the executable installed in BIN_DEST will be named "foo". 
+#
+#    For tcl packages, MOD_SRC specifies a list of files that contain the
+#    source code that will make up the package.  MOD_NAME specifies the 
+#    file name for the package (this is typically the module name with a 
+#    ".tcl" extension). In addition, the Makefile *MUST* specify a 
+#    destination directory for installation.  Typically, this is set to a 
+#    subdirectory of BASE_DIR, e.g. MOD_DEST = $(BASE_DIR)/perllib for perl 
+#    modules. 
+#
+#    The EXE_SRC variable only needs to be set executable scripts need to be
+#    built.  Likewise MOD_SRC determines if script modules should be built.
+#    The logic to set "src" to "invalid" is used to prevent shell errors
+#    if either or both of these variables are not set. 
+#
+#    However, if MOD_SRC is set, MOD_DEST must also be set to the location
+#    of a valid directory.  The same is also true for EXE_SRC and BIN_DEST,
+#    but BIN_DEST is properly set when the buildrc resource file is sourced. 
+#
+all : binary
+
+binary:
+	@src="$(BIN_SRC)" ; \
+	if [ -z "$${src}" ]; then \
+		src="invalid" ;\
+	else if [ -z "$(BIN_DEST)" ]; then \
+		echo "Error: Binary installation directory BIN_DEST not set" 1>&2;\
+		src="invalid" ;\
+	fi; fi; \
+	for s in $${src}; do \
+		if [ -f $(BIN_DEST)/$${s} ]; then \
+			echo "    Removing $(BIN_DEST)/$${s}"; \
+			rm -f $(BIN_DEST)/$${s}; \
+		fi; \
+		if [ "$${s}" = "invalid" ]; then \
+			continue;\
+		fi;\
+		echo "    Copying $$s to $(BIN_DEST)/$${s}" ; \
+		cp $$s $(BIN_DEST)/$${s} ; \
+	done; \
+
+#
+#  Include rules for installation of configuration files.
+#
+include $(BUILD_DIR)/config_rules.mk
+
+#
+#  RULES that are not implemented. 
+#
+archive linked_lib: .FORCE
+	@echo "    make $@ is not implemented for binary modules" 1>&2
+
+#
+#  RULE for building unit test programs. 
+#
+utest: .FORCE
+	@echo "    make $@ is not implemented for binary modules" 1>&2
+
+.FORCE:
+
+#
+#  RULES for cleaning up derived files.
+#
+#  'clean' removes any extraneous artifacts of producing script modules or
+#      executables. make clean also removes files core files and backup
+#      files. 
+#
+#  'clean_lib' removes the installed libraries or modules
+#  'clean_exe' removes the installed executable scripts
+#
+#      A subsequent make will recreate the shared library from the compiled
+#      object files.
+#
+clean_exe: 
+	@echo "    make $@ is not implemented for binary modules" 1>&2
+
+clean_lib: 
+	@echo "    make $@ is not implemented for binary modules" 1>&2
+
+clean: 
+	@echo "    Cleaning up binary directory `pwd`" ;\
+	/bin/rm -f Makefile.bak core *~ #*#
+
+#
+#  Rules for making dependencies.
+#  These are not implemented for scripts, so the rules do nothing.
+#
+depend clean_depend: .FORCE
+	@:
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/compile_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/compile_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/compile_rules.mk	(revision 2744)
@@ -0,0 +1,46 @@
+#------------------------------------------------------------------------------
+#  Make rules for compiling source code files. 
+#
+#  This file is intended for use in a Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/compile_rules.mk
+#
+#  It may also be include by other rule files in this directory.
+#  
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  Define all the extensions and include directories we will handle in the 
+#  compile rules. Currently it is just C and C++.
+#
+SRC_EXTENSIONS=.C .c .cpp .cxx .F90 .F .f90
+
+#
+#  RULES for compilation of C and C++ code
+#
+.SUFFIXES: .c .C .cpp .cxx .F90 .F .f90
+.C.o:
+	$(CXX) $(SYS_CXX_INCLUDES) $(SYS_C_INCLUDES) $(CXX_INCLUDES) $(CXXFLAGS) $(SYS_DEFINES) $(DEBUG) -c $<
+.c.o:
+	$(CC) $(SYS_C_INCLUDES) $(C_INCLUDES) $(CFLAGS) $(SYS_DEFINES) $(DEBUG) -c $<
+.cxx.o:
+	$(CXX) $(SYS_CXX_INCLUDES) $(SYS_C_INCLUDES) $(CXX_INCLUDES) $(CXXFLAGS) $(SYS_DEFINES) $(DEBUG) -c $<
+.cpp.o:
+	$(CXX) $(SYS_CXX_INCLUDES) $(SYS_C_INCLUDES) $(CXX_INCLUDES) $(CXXFLAGS) $(SYS_DEFINES) $(DEBUG) -c $<
+
+.F90.o:
+	$(FC) $(SYS_F_INCLUDES) $(F_INCLUDES) $(FCFLAGS) $(SYS_DEFINES) $(DEBUG) $(FORMAT) -c $<
+
+.F.o:
+	$(RM) $@
+	$(CPP) $(CPPFLAGS) $(SYS_F_INCLUDES) $(F_INCLUDES) $*.F > $*.f90
+	$(FC) $(SYS_F_INCLUDES) $(F_INCLUDES) $(FCFLAGS) $(SYS_DEFINES) $(DEBUG) $(FORMAT) -c $*.f90
+
+.f90.o:
+	$(FC) $(SYS_F_INCLUDES) $(F_INCLUDES) $(FCFLAGS) $(SYS_DEFINES) $(DEBUG) $(FORMAT) -c $<
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/config_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/config_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/config_rules.mk	(revision 2744)
@@ -0,0 +1,52 @@
+#------------------------------------------------------------------------------
+#  Make rules for installing optional configuration files. 
+#
+#  This file is intended for use in Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/config_rules.mk
+#
+#  It is assumed that the environment has been set by sourcing the build
+#  resource file (buildrc).
+# 
+#  This file defines the following rules:
+#
+#      config 
+#
+#  Copyright (C) 2002, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  The config rules install any files under the directory config into the
+#  project's configuration directory.  Any directory structure beneath
+#  the local config directory will be preserved.  However, the special 
+#  CVS directory will NOT be copied.
+#
+config: .FORCE
+	@if [ -d config ]; then\
+		cd config;\
+		l=* ; \
+		if [ -z "$${l}" ]; then \
+			echo "Error: empty config directory.";\
+			l="CVS" ;\
+		fi;\
+		for f in $$l; do\
+			if [ "$$f" = "CVS" ]; then\
+				continue;\
+			fi;\
+			cp -ur $$f $(BASE_DIR)/config;\
+			if [ -d $$f ]; then\
+				find $(BASE_DIR)/config/$$f -name 'CVS' -exec rm -fr {} > /dev/null 2>&1 \;  ;\
+			fi;\
+		done;\
+		cd ..;\
+	fi 
+
+.FORCE:
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/depend_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/depend_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/depend_rules.mk	(revision 2744)
@@ -0,0 +1,78 @@
+#------------------------------------------------------------------------------
+#  Make rules for determining the dependencies between source files. 
+#
+#  This file is intended for use in a Makefile via the include directive, e.g.
+#
+#      include $(BUID_DIR)/depend_rules.mk
+#
+#  It may also be include by other rule files in this directory.
+#
+#  These rules rely upon proper setting of OBJS and SRC_EXTENSIONS.
+#  
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  RULES for creating the source code dependencies.
+#
+#  These are typically used to implement the rules depend and clean_depend
+#  in other make rule files.
+#
+#  'generic_depend' creates the dependencies and appends them to a separate 
+#      file in the same directory as the source code, called .depend.   
+#      Depend uses some customized logic to determine the name of the source
+#      code file associated with each object file in OBJS.  This means that we
+#      can mix source code extensions in the same library (e.g. use C and C++
+#      source interchangeably).  See compile_rules.mk for supported file name
+#      extensions for C and C++ development.
+#
+#  'generic_clean_depend' removes the dependencies file .depend.
+#
+generic_clean_depend:
+	@rm -f .depend
+
+generic_depend: 
+	@srcs="" ;\
+	if [ -z "$(OBJS)" ]; then\
+		objs="foobar";\
+	else\
+		objs="$(OBJS)";\
+	fi;\
+	for o in $${objs}; do\
+		if [ $$o = "foobar" ]; then\
+			echo "Error: no objects were specified in OBJS.";\
+			continue;\
+		fi;\
+		b=`echo $$o | sed -e 's/\.o//'` ;\
+		f="" ;\
+		for e in $(SRC_EXTENSIONS) ; do \
+			s="$$b$$e" ;\
+			if [ -r "$$s" ]; then\
+				srcs="$${srcs} $$s" ;\
+				f=1 ;\
+				break ;\
+			fi; \
+		done ;\
+		if [ -z "$$f" ]; then\
+			echo "Could not find source file for object file $$o";\
+		fi ;\
+	done ;\
+	make_opts="";\
+	if [ "$(SYS_CXX_INCLUDES)" ]; then\
+		make_opts="-I+ $(SYS_CXX_INCLUDES)";\
+	fi;\
+	if [ "$(SYS_C_INCLUDES)" ]; then\
+		make_opts="$${make_opts} -I+ $(SYS_C_INCLUDES)";\
+	fi;\
+	if [ "$(C_INCLUDES)" ]; then\
+		make_opts="$${make_opts} -I+ $(C_INCLUDES)";\
+	fi;\
+	if [ "$(CXX_INCLUDES)" ]; then\
+		make_opts="$${make_opts} -I+ $(CXX_INCLUDES)";\
+	fi;\
+	makedepend $${make_opts} -f- $${srcs} > .depend;
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/library_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/library_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/library_rules.mk	(revision 2744)
@@ -0,0 +1,197 @@
+#------------------------------------------------------------------------------
+#  Make rules for producing a library module.
+#
+#  This file is intended for use in Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/library_rules.mk
+#
+#  It is assumed that the environment has been set by sourcing the build
+#  resource file (buildrc).
+# 
+#  This file defines the following rules for library modules:
+#
+#      all, lib, archive, linked_lib, utest, exe, clean, clean_lib, 
+#      clean_depend, depend.
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+MAKE=make
+
+#
+#  RULES that can be passed through to subdirectories. 
+#
+#    Each of these rules executes the rule on this directory, then executes
+#    the same rule on each subdirectory specified in SUB_DIRS.
+#
+#    The rules for this directory are specified as thisdir_<rulename> in
+#    this file, e.g. "thisdir_all" implements "make all" for this directory. 
+#
+#    The SUB_DIRS variable only needs to be set if building of subdirectories
+#    is desired.  In this case, the list of subdirectories ($$s) is set to the
+#    no-op value of "foobar" to prevent the shell for seeing errors in the 
+#    subsequent for loop when SUB_DIRS is not set. 
+#
+all lib archive linked_lib clean depend clean_depend clean_lib:
+	@s="$(SUB_DIRS)" ; \
+	if [ -z "$${s}" ]; then \
+		s="foobar" ;\
+	fi; \
+	for d in $$s ; do \
+		if [ "$$d" = "foobar" ]; then\
+			continue ;\
+		fi ; \
+		if [ ! -d "$$d" ]; then \
+			echo "        Error: subdir $$d is NOT a directory!"; \
+			contiuue ;\
+		fi ; \
+		if [ ! -r "$$d/Makefile" ]; then\
+			echo "        Error: subdir $$d does NOT contain a Makefile!"; \
+			continue ;\
+		fi ; \
+		echo "        Doing make $@ on library subdirectory $$d" ;\
+		cd $$d ; \
+		$(MAKE) $@;\
+		cd ..; \
+	done; \
+	$(MAKE) thisdir_$@
+
+clean_exe:
+	@echo "make clean_exe does nothing for library modules"
+
+thisdir_all: thisdir_linked_lib config 
+
+#
+#  Include the RULES for compilation and installing config files
+#
+include $(BUILD_DIR)/compile_rules.mk
+include $(BUILD_DIR)/config_rules.mk
+
+#
+#  RULES for building a library.
+#
+#  - 'lib' builds the library as a shared library.
+#  - 'archive' builds the library as an archive library.
+#  - 'linked_lib' builds the library as a shared library (if necessary), and
+#    links the shared library to its dependent libraries.
+#  - Specific library names are built depending on the update status of the
+#    library of the same name installed in $(LIB_DEST).
+#  - Libraries are built depending on the status of its object files (OBJS)
+#
+#  NOTE: Shared libraries are linked against the libraries upon which they
+#        depend.  This is not possible with archive libraries.
+# 
+thisdir_lib: lib$(LIB_NAME).$(LIB_EXT)
+
+lib$(LIB_NAME).$(LIB_EXT): $(LIB_DEST)/lib$(LIB_NAME).$(LIB_EXT)
+
+$(LIB_DEST)/lib$(LIB_NAME).$(LIB_EXT): $(OBJS)
+	$(CXX) $(LIB_FLAGS) -o $@ $(OBJS)
+
+thisdir_linked_lib: $(OBJS)
+	$(CXX) $(LIB_FLAGS) -o $(LIB_DEST)/lib$(LIB_NAME).$(LIB_EXT) $(OBJS) $(DEP_LIBS)
+	@if [ `echo $(LIB_NAME) | grep Pkg` ] ; then \
+		pwd = `pwd` ; \
+		cd $(LIB_DEST) ; \
+		echo "    Creating tcl package index in $(MOD_DEST)" ;\
+		exec echo "pkg_mkIndex . \*Pkg.so \*.tcl" | tclsh;\
+		cd "$$(pwd)"; \
+	fi
+
+thisdir_archive: $(OBJS) .FORCE 
+	ar $(ARFLAGS) $(LIB_DEST)/lib$(LIB_NAME).a $(OBJS)
+
+#thisdir_archive: lib$(LIB_NAME).a .FORCE
+#
+#lib$(LIB_NAME).a: $(LIB_DEST)/lib$(LIB_NAME).a .FORCE
+#
+#$(LIB_DEST)/lib$(LIB_NAME).a: .FORCE $(OBJS)
+#	ar cruv $@ $(OBJS)
+
+#
+#  RULE for building unit test programs. 
+#
+
+utest: .FORCE
+	@if [ -d utest ] ; then \
+		echo "Making unit tests for `pwd`"; \
+		cd utest; \
+		make; \
+		cd ..; \
+	fi 
+
+.FORCE:
+
+#
+#  RULE for building an executable.
+#
+#  For library modules, these do nothing, but we define one so that make exe
+#  can be passed down to all source directories.
+#
+exe:
+	@echo "make exe does nothing for library modules"
+
+#
+#  RULES for cleaning up derived files.
+#
+#  'clean' removes all objects produced by this file, as well as other 
+#      extraneous artifacts of compiling and building libraries.
+# 
+#      A subsequent make will both recompile the source code and recreate
+#      the shared library.  clean also removes files core files and other
+#      auxilliary files created during compilation.
+#
+#  'clean_lib' removes only the libraries, both shared and archive.
+#
+#      A subsequent make will recreate the shared library from the compiled
+#      object files.
+#
+thisdir_clean: thisdir_clean_lib
+	@/bin/rm -f *.o *.mod *.f90 core so_locations Makefile.bak *~ #*#
+	@/bin/rm -fr ii_files
+	@if [ -d utest ] ; then \
+		echo "        Doing make clean on utest subdirectory"; \
+		cd utest; \
+		make clean; \
+		cd ..; \
+	fi 
+
+thisdir_clean_lib: 
+	@/bin/rm -f $(LIB_DEST)/lib$(LIB_NAME).*	
+
+#
+#  RULES for creating the include dependencies.
+#
+#  'depend' creates the dependencies and appends them to the end of this file.
+#      Depend uses some customized logic to determine the name of the source
+#      code file associated with each object file in OBJS.  This means that we
+#      can mix source code extensions in the same library (e.g. use C and C++
+#      source interchangeably).  See compile_rules.mk for supported file name
+#      extensions.
+#
+#  'clean_depend' removes the dependencies from this file, which makes the
+#      Makefile much smaller.  make clean_depend should be done before
+#      checking a Makefile into revision control.
+#
+thisdir_clean_depend: generic_clean_depend 
+	@if [ -d utest ] ; then \
+		echo "        Doing make clean_depend on utest subdirectory"; \
+		cd utest; \
+		$(MAKE) clean_depend; \
+		cd ..; \
+	fi 
+
+thisdir_depend: generic_depend
+	@if [ -d utest ] ; then \
+		echo "        Doing make depend on utest subdirectory"; \
+		cd utest; \
+		$(MAKE) depend; \
+		cd ..; \
+	fi 
+
+include $(BUILD_DIR)/depend_rules.mk
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/package_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/package_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/package_rules.mk	(revision 2744)
@@ -0,0 +1,131 @@
+#------------------------------------------------------------------------------
+#  Make rules for building and installing a 3rdparty package.
+#
+#  This file is intended for use in Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/package_rules.mk
+#
+#  It is assumed that the environment has been set by sourcing the build
+#  resource file (buildrc).
+# 
+#  This file defines the following rules for library modules:
+#
+#      all, clean, install 
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  RULE for building a package. 
+#
+#  make all will decompress the package from a compressed tar file. 
+#  If decompression is successful, the tar file will be removed.
+#
+#  It will then configure, make, check, and install the package using the
+#  standard GNU mechanisms.  It uses make -i to ignore errors.
+#
+#  After the standard GNU make is complete, an executable called custom_build 
+#  will be executed, if such a script is found in the same directory as the 
+#  Makefile that includes these rules.  The custom_build executable should
+#  accept the PACKAGE and INSTALLDIR as arguments.
+# 
+#  This relies on settings for the variables:
+#    BASEDIR    - absolute path where Makefile resides.
+#    PACKAGE    - directory relative to BASEDIR containing package to build.
+#    INSTALLDIR - directory relative to BASEDIR into which to install package.
+# 
+all:
+	@if [ ! -d $(PACKAGE) ]; then \
+		if [ -e $(PACKAGE).tar.gz ]; then \
+			gunzip $(PACKAGE).tar.gz ; \
+			tar -xf $(PACKAGE).tar ; \
+			rm -f $(PACKAGE).tar ; \
+		fi ; \
+	fi ; \
+	if [ ! -d $(PACKAGE) ]; then \
+        echo "Could not find or successfully decompress package " $(PACKAGE) ;\
+		exit 1 ; \
+	fi ; \
+	if [ ! -d $(INSTALLDIR) ]; then \
+		mkdir $(INSTALLDIR) ; \
+		if [ ! -d $(INSTALLDIR) ]; then \
+			echo "Cannot create installation directory " $(INSTALLDIR) ;\
+		fi ; \
+	fi ; \
+	cd $(PACKAGE) ;\
+	sh ./configure --prefix=$(BASEDIR)/$(INSTALLDIR) ;\
+	make ;\
+	make check ;\
+	make install ;\
+	cd .. ;\
+	if [ -x ./custom_build ]; then \
+		./custom_build $(PACKAGE) $(INSTALLDIR) ;\
+	fi;
+
+#
+#  RULE for installing a package.
+#
+#    This copies files from the packages install directory into the bin,
+#    lib, or src/3rdparty directories associated with a product source tree. 
+#
+#    Relies on proper setting of INSTALLDIR (explained above).
+#    Also relies on paths setup in buildrc. 
+#
+install:
+	@cd $(INSTALLDIR) ; \
+	if [ -d bin ]; then \
+		cd bin ;\
+		echo "    Installing executables in $(BIN_DEST)" ;\
+		for f in *; do \
+			if [ ! -d $$f ]; then \
+				echo "      $$f"; \
+				cp $$f $(BIN_DEST) ;\
+			fi ;\
+		done ;\
+		cd .. ; \
+	fi; \
+	if [ -d lib ]; then \
+		cd lib ;\
+		echo "    Installing libraries in $(LIB_DEST)" ;\
+		for f in *; do \
+			if [ ! -d $$f ]; then \
+				echo "      $$f"; \
+				cp $$f $(LIB_DEST) ;\
+			fi ;\
+		done ;\
+		cd .. ; \
+	fi; \
+	if [ -d include ]; then \
+		cd include ;\
+		echo "    Installing header files in $(THIRDPARTY_DIR)" ;\
+		for f in *; do \
+			if [ ! -d $$f ]; then \
+				echo "      $$f"; \
+				cp $$f $(THIRDPARTY_DIR) ;\
+			fi ;\
+		done ;\
+		cd .. ; \
+	fi; 
+
+#
+#  RULE for cleaning up a package.
+#
+#  make clean will do both the standard GNU make clean and make distclean rules.
+#  After that, it will tar and compress the package.
+#
+clean:
+	@if [ -d $(PACKAGE) ]; then \
+		cd $(PACKAGE) ;\
+		make clean;\
+		make distclean;\
+		cd ..;\
+		tar -cf $(PACKAGE).tar $(PACKAGE);\
+		rm -fr $(PACKAGE);\
+		gzip $(PACKAGE).tar ; \
+	fi;
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/script_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/script_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/script_rules.mk	(revision 2744)
@@ -0,0 +1,186 @@
+#------------------------------------------------------------------------------
+#  Make rules for installing scripts and script-modules. 
+#
+#  This file is intended for use in Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/script_rules.mk
+#
+#  It is assumed that the environment has been set by sourcing the build
+#  resource file (buildrc).
+# 
+#  This file defines the following rules for library modules:
+#
+#      all, lib, archive, linked_lib, utest, exe, clean, clean_lib, clean_exe,
+#      clean_depend, depend.
+#
+#  Copyright (C) 2002, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  RULES for installing scripts and script modules 
+#
+#    EXE_SRC specifies a list of files that contain executable scripts.
+#    Each file in the list will be installed in the $(BIN_DEST) directory
+#    and will be given executable permissions.  If the variable EXE_EXT is
+#    set, this extension will be stripped from the end of the source file
+#    when it is installed, e.g. if EXE_SRC = "foo.pl" and EXE_EXT = ".pl",
+#    the executable installed in BIN_DEST will be named "foo". 
+#
+#    Installation of library modules works in a similiar fashion, with the
+#    variables MOD_SRC and MOD_EXT taking the place of EXE_SRC and EXE_EXT.
+#    In addition, the Makefile *MUST* specify a destination directory for
+#    installation.  Typically, this is set to a subdirectory of BASE_DIR,
+#    e.g. MOD_DEST = $(BASE_DIR)/perllib for perl modules. 
+#
+#    The EXE_SRC variable only needs to be set executable scripts need to be
+#    built.  Likewise MOD_SRC determines if script modules should be built.
+#    The logic to set "src" to "invalid" is used to prevent shell errors
+#    if either or both of these variables are not set. 
+#
+#    However, if MOD_SRC is set, MOD_DEST must also be set to the location
+#    of a valid directory.  The same is also true for EXE_SRC and BIN_DEST,
+#    but BIN_DEST is properly set when the buildrc resource file is sourced. 
+#
+all : exe lib config
+
+exe:
+	@src="$(EXE_SRC)" ; \
+	if [ -z "$${src}" ]; then \
+		src="invalid" ;\
+	else if [ -z "$(BIN_DEST)" ]; then \
+		echo "Error: Binary installation directory BIN_DEST not set" 1>&2;\
+		src="invalid" ;\
+	else if [ ! -d "$(BIN_DEST)" ]; then \
+		echo "Error: BIN_DEST directory $(BIN_DEST) not found" 1>&2 ;\
+		src="invalid" ;\
+	fi; fi; fi; \
+	for s in $${src}; do \
+		if [ "$${s}" = "invalid" ]; then \
+			continue ; \
+		fi ; \
+		out=`echo $${s} | egrep '.*\.cgi'` > /dev/null 2>&1; \
+		if [ "$${out}" != "" ]; then \
+		   e="$${s}" ; \
+		else \
+		   e=`echo $$s | sed -e 's/\..*//'` ; \
+		fi ; \
+		echo "    Installing $$e in $(BIN_DEST)" ; \
+		cp -f $$s $(BIN_DEST)/$$e ; \
+		chmod 555 $(BIN_DEST)/$$e ; \
+	done
+
+lib:
+	@src="$(MOD_SRC)" ; \
+	if [ -z "$${src}" ]; then \
+		src="invalid" ;\
+	else if [ -z "$(MOD_DEST)" ]; then \
+		echo "Error: Module installation directory MOD_DEST not set" 1>&2;\
+	src="invalid" ;\
+	else if [ ! -d "$(MOD_DEST)" ]; then \
+		echo "Error: MOD_DEST directory $(MOD_DEST) not found" 1>&2 ;\
+		src="invalid" ;\
+	fi; fi; fi; \
+	for s in $${src}; do \
+		if [ "$${s}" = "invalid" ]; then \
+			continue;\
+		fi;\
+		e=`basename $$s $(MOD_EXT)` ; \
+		echo "    Installing $$e in $(MOD_DEST)" ; \
+		cp -f $$s $(MOD_DEST)/$$e ; \
+		chmod 444 $(MOD_DEST)/$$e ; \
+	done
+
+#
+#  Include rules for installation of configuration files.
+#
+include $(BUILD_DIR)/config_rules.mk
+
+#
+#  RULES that are not implemented. 
+#
+archive linked_lib: .FORCE
+	@echo "    make $@ is not implemented for script modules" 1>&2
+
+#
+#  RULE for building unit test programs. 
+#
+utest: .FORCE
+	@if [ -d utest ] ; then \
+		echo "Making unit tests for `pwd`"; \
+		cd utest; \
+		make; \
+		cd ..; \
+	fi 
+
+.FORCE:
+
+#
+#  RULES for cleaning up derived files.
+#
+#  'clean' removes any extraneous artifacts of producing script modules or
+#      executables. make clean also removes files core files and backup
+#      files. 
+#
+#  'clean_lib' removes the installed libraries or modules
+#  'clean_exe' removes the installed executable scripts
+#
+#      A subsequent make will recreate the shared library from the compiled
+#      object files.
+#
+clean_exe: 
+	@src="$(EXE_SRC)" ; \
+	if [ -z "$${src}" ]; then \
+		src="invalid" ;\
+	else if [ -z "$(BIN_DEST)" ]; then \
+		echo "Error: Binary installation directory BIN_DEST not set" 1>&2;\
+		src="invalid" ;\
+	else if [ ! -d "$(BIN_DEST)" ]; then \
+		echo "Error: BIN_DEST directory $(BIN_DEST) not found" 1>&2 ;\
+		src="invalid" ;\
+	fi; fi; fi; \
+	for s in $${src}; do \
+		if [ "$${s}" = "invalid" ]; then \
+			continue ; \
+		fi ; \
+		e=`echo $$s | sed -e 's/\..*//'` ;\
+		echo "    Removing $$e from $(BIN_DEST)" ; \
+		rm -f $(BIN_DEST)/$$e ; \
+	done
+
+clean_lib: 
+	@src="$(MOD_SRC)" ; \
+	if [ -z "$${src}" ]; then \
+		src="invalid" ;\
+	else if [ -z "$(MOD_DEST)" ]; then \
+		echo "Error: Module installation directory MOD_DEST not set" 1>&2;\
+		src="invalid" ;\
+	else if [ ! -d "$(MOD_DEST)" ]; then \
+		echo "Error: MOD_DEST directory $(MOD_DEST) not found" 1>&2 ;\
+		src="invalid" ;\
+	fi; fi; fi; \
+	for s in $${src}; do \
+		if [ "$${s}" = "invalid" ]; then \
+			continue ; \
+		fi ; \
+		e=`basename $$s $(MOD_EXT)` ; \
+		echo "    Removing $$e from $(MOD_DEST)" ; \
+		rm -f $(MOD_DEST)/$$e ; \
+	done
+
+clean: 
+	@echo "    Cleaning up script directory `pwd`" ;\
+	/bin/rm -f Makefile.bak core *~ #*#
+
+#
+#  Rules for making dependencies.
+#  These are not implemented for scripts, so the rules do nothing.
+#
+depend clean_depend: .FORCE
+	@:
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/tcl_script_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/tcl_script_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/tcl_script_rules.mk	(revision 2744)
@@ -0,0 +1,195 @@
+#------------------------------------------------------------------------------
+#  Make rules for installing tcl scripts and script-modules. 
+#
+#  This file is intended for use in Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/tcl_script_rules.mk
+#
+#  It is assumed that the environment has been set by sourcing the build
+#  resource file (buildrc).
+# 
+#  This file defines the following rules for library modules:
+#
+#      all, lib, archive, linked_lib, utest, exe, clean, clean_lib, clean_exe,
+#      clean_depend, depend.
+#
+#  Copyright (C) 2002, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  RULES for installing scripts and script modules 
+#
+#    EXE_SRC specifies a list of files that contain executable scripts.
+#    Each file in the list will be installed in the $(BIN_DEST) directory
+#    and will be given executable permissions.  If the variable EXE_EXT is
+#    set, this extension will be stripped from the end of the source file
+#    when it is installed, e.g. if EXE_SRC = "foo.pl" and EXE_EXT = ".pl",
+#    the executable installed in BIN_DEST will be named "foo". 
+#
+#    For tcl packages, MOD_SRC specifies a list of files that contain the
+#    source code that will make up the package.  MOD_NAME specifies the 
+#    file name for the package (this is typically the module name with a 
+#    ".tcl" extension). In addition, the Makefile *MUST* specify a 
+#    destination directory for installation.  Typically, this is set to a 
+#    subdirectory of BASE_DIR, e.g. MOD_DEST = $(BASE_DIR)/perllib for perl 
+#    modules. 
+#
+#    The EXE_SRC variable only needs to be set executable scripts need to be
+#    built.  Likewise MOD_SRC determines if script modules should be built.
+#    The logic to set "src" to "invalid" is used to prevent shell errors
+#    if either or both of these variables are not set. 
+#
+#    However, if MOD_SRC is set, MOD_DEST must also be set to the location
+#    of a valid directory.  The same is also true for EXE_SRC and BIN_DEST,
+#    but BIN_DEST is properly set when the buildrc resource file is sourced. 
+#
+all : exe lib config
+
+exe:
+	@src="$(EXE_SRC)" ; \
+	if [ -z "$${src}" ]; then \
+		src="invalid" ;\
+	else if [ -z "$(BIN_DEST)" ]; then \
+		echo "Error: Binary installation directory BIN_DEST not set" 1>&2;\
+		src="invalid" ;\
+	else if [ ! -d "$(BIN_DEST)" ]; then \
+		echo "Error: BIN_DEST directory $(BIN_DEST) not found" 1>&2 ;\
+		src="invalid" ;\
+	fi; fi; fi; \
+	for s in $${src}; do \
+		if [ "$${s}" = "invalid" ]; then \
+			continue ; \
+		fi ; \
+		e=`echo $$s | sed -e 's/\..*//'` ;\
+		echo "    Installing $$e in $(BIN_DEST)" ; \
+		cp -f $$s $(BIN_DEST)/$$e ; \
+		chmod 555 $(BIN_DEST)/$$e ; \
+	done
+
+lib:
+	@src="$(MOD_SRC)" ; \
+	if [ -z "$${src}" ]; then \
+		src="invalid" ;\
+	else if [ -z "$(MOD_DEST)" ]; then \
+		echo "Error: Module installation directory MOD_DEST not set" 1>&2;\
+	src="invalid" ;\
+	else if [ ! -d "$(MOD_DEST)" ]; then \
+		echo "Error: MOD_DEST directory $(MOD_DEST) not found" 1>&2 ;\
+		src="invalid" ;\
+	fi; fi; fi; \
+	pwd=`pwd` ; \
+	if [ -f $(MOD_DEST)/$(MOD_NAME) ]; then \
+		echo "    Removing $(MOD_DEST)/$(MOD_NAME)"; \
+		rm -f $(MOD_DEST)/$(MOD_NAME); \
+	fi; \
+	for s in $${src}; do \
+		if [ "$${s}" = "invalid" ]; then \
+			continue;\
+		fi;\
+		echo "    Appending $$s to $(MOD_DEST)/$(MOD_NAME)" ; \
+		cat $$s >> $(MOD_DEST)/$(MOD_NAME) ; \
+		if [ $$? != 0 ]; then \
+		   echo "Error with cat $$s"; \
+		fi; \
+		ext=`echo $$s | sed -e 's/.*\.//'` ;\
+	done; \
+	chmod 444 $(MOD_DEST)/$(MOD_NAME) ; \
+	cd $(MOD_DEST) ; \
+	echo "    Creating tcl package index in $(MOD_DEST)" ;\
+	exec echo "pkg_mkIndex . \*Pkg.so \*.tcl" | tclsh;\
+	cd "$$(pwd)"
+
+#
+#  Include rules for installation of configuration files.
+#
+include $(BUILD_DIR)/config_rules.mk
+
+#
+#  RULES that are not implemented. 
+#
+archive linked_lib: .FORCE
+	@echo "    make $@ is not implemented for script modules" 1>&2
+
+#
+#  RULE for building unit test programs. 
+#
+utest: .FORCE
+	@if [ -d utest ] ; then \
+		echo "Making unit tests for `pwd`"; \
+		cd utest; \
+		make; \
+		cd ..; \
+	fi 
+
+.FORCE:
+
+#
+#  RULES for cleaning up derived files.
+#
+#  'clean' removes any extraneous artifacts of producing script modules or
+#      executables. make clean also removes files core files and backup
+#      files. 
+#
+#  'clean_lib' removes the installed libraries or modules
+#  'clean_exe' removes the installed executable scripts
+#
+#      A subsequent make will recreate the shared library from the compiled
+#      object files.
+#
+clean_exe: 
+	@src="$(EXE_SRC)" ; \
+	if [ -z "$${src}" ]; then \
+		src="invalid" ;\
+	else if [ -z "$(BIN_DEST)" ]; then \
+		echo "Error: Binary installation directory BIN_DEST not set" 1>&2;\
+		src="invalid" ;\
+	else if [ ! -d "$(BIN_DEST)" ]; then \
+		echo "Error: BIN_DEST directory $(BIN_DEST) not found" 1>&2 ;\
+		src="invalid" ;\
+	fi; fi; fi; \
+	for s in $${src}; do \
+		if [ "$${s}" = "invalid" ]; then \
+			continue ; \
+		fi ; \
+		e=`echo $$s | sed -e 's/\..*//'` ;\
+		echo "    Removing $$e from $(BIN_DEST)" ; \
+		rm -f $(BIN_DEST)/$$e ; \
+	done
+
+clean_lib: 
+	@name="$(MOD_NAME)" ; \
+	if [ -z "$${src}" ]; then \
+		src="invalid" ;\
+	else if [ -z "$(MOD_DEST)" ]; then \
+		echo "Error: Module installation directory MOD_DEST not set" 1>&2;\
+		src="invalid" ;\
+	else if [ ! -d "$(MOD_DEST)" ]; then \
+		echo "Error: MOD_DEST directory $(MOD_DEST) not found" 1>&2 ;\
+		src="invalid" ;\
+	fi; fi; fi; \
+	for s in $${name}; do \
+		if [ "$${s}" = "invalid" ]; then \
+			continue ; \
+		fi ; \
+		e=`basename $$s $(MOD_EXT)` ; \
+		echo "    Removing $$e from $(MOD_DEST)" ; \
+		rm -f $(MOD_DEST)/$$e ; \
+	done
+
+clean: 
+	@echo "    Cleaning up script directory `pwd`" ;\
+	/bin/rm -f Makefile.bak core *~ #*#
+
+#
+#  Rules for making dependencies.
+#  These are not implemented for scripts, so the rules do nothing.
+#
+depend clean_depend: .FORCE
+	@:
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/utest_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/utest_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/utest_rules.mk	(revision 2744)
@@ -0,0 +1,78 @@
+#------------------------------------------------------------------------------
+#  Make rules for building one or more unit test programs.  These are used to
+#  test library modules. 
+#
+#  This file is intended for use in Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/utest_rules.mk
+#
+#  It is assumed that the environment has been set by sourcing the build
+#  resource file (buildrc).
+# 
+#  This file defines the following rules for library modules:
+#
+#      all, exe
+#
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  RULES for building one or more unit test programs. 
+# 
+all: exe 
+exe: utest
+
+utest: $(MAIN_OBJS) 
+	@for o in $(MAIN_OBJS); do \
+        p=`basename $$o '.o'` ; \
+		echo "          Building test program $$p..." ; \
+		echo "$(LDD) $(DEBUG) $(OPTIMIZE) -o $$p $$o $(DEP_LIBS)" ;\
+	    $(LDD) $(DEBUG) $(OPTIMIZE) -o $$p $$o $(DEP_LIBS) ;\
+	done
+
+#
+#  Include the RULES for compilation. 
+#
+include $(BUILD_DIR)/compile_rules.mk
+
+#
+#  RULE for building a library
+#
+#  For exe modules, these do nothing, but we define one so that make lib 
+#  can be passed down to all source directories.
+#
+lib:
+	@echo "make lib does nothing for unit test modules"
+
+#
+#  RULES for cleaning up derived files.
+#
+#  'clean' removes all objects produced by this file, as well as other 
+#      extraneous artifacts of compiling and building libraries.
+# 
+#      A subsequent make will both recompile the source code and recreate
+#      the executable.  clean also removes files core files and other
+#      auxilliary files created during compilation.
+#
+clean: 
+	@/bin/rm -f *.o core so_locations Makefile.bak *~ #*#
+	@/bin/rm -fr ii_files
+	@for o in $(MAIN_OBJS); do \
+            p=`basename $$o '.o'` ; \
+	    rm -f $$p;\
+	done
+
+#
+#  RULES for creating the include dependencies.
+#
+OBJS=$(MAIN_OBJS)
+include $(BUILD_DIR)/depend_rules.mk
+
+clean_depend: generic_clean_depend
+
+depend: generic_depend
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/utility_rules.mk
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/utility_rules.mk	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/build/utility_rules.mk	(revision 2744)
@@ -0,0 +1,76 @@
+#------------------------------------------------------------------------------
+#  Make rules for building an application program.
+#
+#  This file is intended for use in Makefile via the include directive, e.g.
+#
+#      include $(BUILD_DIR)/application_rules.mk
+#
+#  It is assumed that the environment has been set by sourcing the build
+#  resource file (buildrc).
+# 
+#  Copyright (C) 2001, WSI Corporation
+#------------------------------------------------------------------------------
+#
+#  For portability, use the Bourne shell within Makefiles. 
+#  There have been problems using the C-shell under Linux.
+#
+SHELL=/bin/sh
+
+#
+#  RULES for building a single utility program.
+#        The program will be named $(EXE_NAME).
+#        The objects files used to create the utility should be $(OBJS).  
+#        The libraries that should be linked should be $(DEP_LIBS).
+# 
+all: exe config
+
+exe: $(OBJS) 
+	@echo "    Building utility program $(EXE_NAME)" ; \
+	$(LDD) $(DEBUG) $(OPTIMIZE) -o $(EXE_NAME) $(OBJS) $(DEP_LIBS) ;\
+	mv -f $(EXE_NAME) $(BIN_DEST) ;
+
+#
+#  Include the RULES for compilation and installation of config files
+#
+include $(BUILD_DIR)/compile_rules.mk
+include $(BUILD_DIR)/config_rules.mk
+
+#
+#  RULE for building a library
+#
+#  For exe modules, these do nothing, but we define one so that make lib 
+#  can be passed down to all source directories.
+#
+lib:
+	@echo "make lib does nothing for utility modules"
+
+#
+#  RULES for cleaning up derived files.
+#
+#  'clean' removes all objects produced by this file, as well as other 
+#      extraneous artifacts of compiling and building applications.
+# 
+#      A subsequent make will both recompile the source code and recreate
+#      the executable.  clean also removes files core files and other
+#      auxilliary files created during compilation.
+#
+#  'clean_exe' removes the utility program.
+#
+clean: 
+	@/bin/rm -f *.o core* so_locations Makefile.bak *~ #*#
+	@/bin/rm -fr ii_files
+
+clean_exe:
+	@/bin/rm -f $(BIN_DEST)/$(EXE_NAME)
+
+clean_lib:
+	@echo "       make clean_lib does nothing for utility modules"
+
+#
+#  RULES for creating the include dependencies.
+#
+include $(BUILD_DIR)/depend_rules.mk
+
+clean_depend: generic_clean_depend
+
+depend: generic_depend
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/get_region_center.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/get_region_center.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/get_region_center.c	(revision 2744)
@@ -0,0 +1,207 @@
+#include "get_region_center.h"
+#include "gridnav.h"
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "wrf_projection.h"
+
+int get_gridnav_projection(int wrf_projection);
+
+/****************************************************************************
+ *
+ * This function calculates the center lat and lon of a region within a larger
+ *   domain.  It is useful for calculating the center of the boundary regions
+ *   in a domain.
+ *
+ ****************************************************************************/
+
+
+int GET_REGION_CENTER(char *MemoryOrderIn, int *projection, 
+		      float *domain_center_lat, 
+		      float *domain_center_lon, int *full_xsize, 
+		      int *full_ysize, float *dx, float *dy, 
+		      float *proj_central_lon, 
+		      int *proj_center_flag, float *truelat1, 
+		      float *truelat2, int *region_xsize, int *region_ysize, 
+		      float *region_center_lat, float *region_center_lon, 
+		      int strlen1)
+{
+
+  char *MemoryOrder;
+  int grid_projection;
+  float full_xcenter, full_ycenter;
+  float region_xcenter, region_ycenter;
+  int status;
+  int orig;
+  int x_pos, y_pos;
+  GridNav gridnav;
+
+  MemoryOrder = (char *)malloc((strlen1+1)*sizeof(char));
+  memcpy(MemoryOrder,MemoryOrderIn,strlen1);
+  MemoryOrder[strlen1] = '\0';
+
+  grid_projection = get_gridnav_projection(*projection);
+
+  full_xcenter = (*full_xsize - 1) / 2.;
+  full_ycenter = (*full_ysize - 1) / 2.;
+  region_xcenter = (*region_xsize - 1) / 2.;
+  region_ycenter = (*region_ysize - 1) / 2.;
+
+  orig = 0;
+
+  if (strncmp(MemoryOrder,"XS", 2) == 0) 
+    {
+      x_pos = region_xcenter;
+      y_pos = full_ycenter;
+    }
+  else if (strncmp(MemoryOrder,"XE", 2) == 0)
+    {
+      x_pos = (*full_xsize - 1) - region_xcenter;
+      y_pos = full_ycenter;
+    }
+  else if (strncmp(MemoryOrder,"YS", 2) == 0) 
+    {
+      x_pos = full_xcenter;
+      y_pos = region_ycenter;
+    }
+  else if (strncmp(MemoryOrder,"YE", 2) == 0) 
+    {
+      x_pos = full_xcenter;
+      y_pos = (*full_ysize - 1) - region_ycenter;
+    }
+  else
+    {
+      orig = 1;
+    }
+
+  if (orig == 1)
+    {
+      *region_center_lat = *domain_center_lat;
+      *region_center_lon = *domain_center_lon;
+      status = 0;
+    } 
+  else
+    {
+      /* Initialize grid structure */
+      /*
+      status = GRID_init(grid_info->center_lat, grid_info->central_lon, 
+			 grid_projection,
+			 grid_info->latin1, grid_info->latin2, 
+			 grid_info->xpoints, grid_info->ypoints, 
+			 grid_info->Di, grid_info->Dj,
+			 grid_info->center_lat, grid_info->center_lon, 
+			 x_center, y_center,
+			 &gridnav);
+      */
+      status = GRID_init(*domain_center_lat, *proj_central_lon, 
+			 grid_projection,
+			 *truelat1, *truelat2, 
+			 *full_xsize, *full_ysize, *dx, *dy,
+			 *domain_center_lat, *domain_center_lon, 
+			 full_xcenter, full_ycenter,
+			 &gridnav);
+      if (!status)
+	{
+	  fprintf(stderr,"get_region_center: error from GRID_init\n");
+	}
+
+      /* get lat/lon of center of region */
+      status = GRID_to_latlon(&gridnav, x_pos, y_pos, region_center_lat, 
+			      region_center_lon);
+      if (!status)
+	{
+	  fprintf(stderr,
+		  "get_region_cneter: error from GRID_to_latlon for first lat/lon\n");
+	}
+      
+    }
+
+  free(MemoryOrder);
+  return status;
+
+}
+/******************************************************************************
+ * translates the grid projection identifier from the WRF id to the grib id.
+ *****************************************************************************/
+
+int get_gridnav_projection(int wrf_projection)
+{
+  int gridnav_projection;
+
+  /* Set the grid projection in the gridnav units */
+  switch (wrf_projection) 
+    {
+    case WRF_LATLON:
+      gridnav_projection = GRID_LATLON;
+      break;
+    case WRF_MERCATOR:
+      gridnav_projection = GRID_MERCATOR;
+      break;
+    case WRF_LAMBERT:
+      gridnav_projection = GRID_LAMCON;
+      break;
+    case WRF_POLAR_STEREO:
+      gridnav_projection = GRID_POLSTR;
+      break;
+    default:
+      fprintf(stderr,"Error, invalid projection: %d\n",wrf_projection);
+      gridnav_projection = -1;
+    }
+  
+  return gridnav_projection;
+}
+
+int GET_LL_LATLON(float *central_lat, float *central_lon, int *projection,
+		  float *latin1, float *latin2, int *nx, int *ny, 
+		  float *dx, float *dy, float *center_lat, float *center_lon,
+		  float *LLLa, float *LLLo, float *URLa, float *URLo, int *ierr)
+{
+
+  int grid_projection;
+  float x_center;
+  float y_center;
+  GridNav gridnav;
+  int status;
+
+  grid_projection = get_gridnav_projection(*projection);
+
+  /* Get coords of center of grid */
+  x_center = (*nx + 1)/2.;
+  y_center = (*ny + 1)/2.;
+
+ /* Initialize grid structure */
+  status = GRID_init(*central_lat, *central_lon, grid_projection,
+		     *latin1, *latin2, *nx, *ny, *dx, *dy,
+		     *center_lat, *center_lon, x_center, y_center,
+		     &gridnav);
+  if (!status)
+    {
+      fprintf(stderr,"write_grib: error from GRID_init\n");
+      *ierr = 1;
+      return;
+    }
+
+  /* get lat/lon of lower left corner */
+  status = GRID_to_latlon(&gridnav, 1, 1, LLLa, LLLo);
+  if (!status)
+    {
+      fprintf(stderr,
+	      "write_grib: error from GRID_to_latlon for first lat/lon\n");
+      *ierr = 1;
+      return;
+    }
+
+  /* get lat/lon of upper right corner */
+  status = GRID_to_latlon(&gridnav, *nx, *ny, URLa, URLo);
+  if (!status)
+    {
+      fprintf(stderr,
+	      "write_grib: error from GRID_to_latlon for first lat/lon\n");
+      *ierr = 1;
+      return;
+    }
+
+  *ierr = 0;
+  return;
+
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/get_region_center.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/get_region_center.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/get_region_center.h	(revision 2744)
@@ -0,0 +1,14 @@
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define GET_REGION_CENTER get_region_center
+#      define GET_LL_LATLON get_ll_latlon
+# else
+#   ifdef F2CSTYLE
+#      define GET_REGION_CENTER get_region_center__
+#      define GET_LL_LATLON get_ll_latlon__
+#   else
+#      define GET_REGION_CENTER get_region_center_
+#      define GET_LL_LATLON get_ll_latlon_
+#   endif
+# endif
+#endif
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/gridnav.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/gridnav.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/gridnav.c	(revision 2744)
@@ -0,0 +1,485 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "gridnav.h"
+
+#define MISSING -999
+#define PI 3.1415927
+#define RAD_TO_DEG 57.29577951
+#define EARTH_RAD 6371.200
+
+int fill_proj_parms(GridNav *gridnav);
+
+/*****************************************************************************
+ * Fills up the gridnav structure using arguments input to the function
+ *
+ * input:
+ *   central_lat - the central latitude of the projection, in degrees
+ *   central_lon - the central longitude of the projection, in degrees
+ *   projection  - the projection number (defined by #define's in gridnav.h)
+ *   truelat1    - the first "true" latitude.  Only has an effect with 
+ *                 polar stereographic and lambert projections
+ *   truelat2    - the second true latitude.  Only has an effect with lambert
+ *                 projection
+ *   num_columns - number of columns in grid
+ *   num_rows    - number of rows in grid
+ *   dx,dy       - east-west (dx) and north-south (dy) distance between grid 
+ *                 points, in degrees for latlon (i.e., cylindrical 
+ *                 equidistant) projection, in km for all other projections 
+ *                 (including mercator).
+ *   lat_origin  - latitude of grid point defined in origin_column, origin_row
+ *   lon_origin  - longitude of grid point defined in origin_column, origin_row
+ *   origin_column - column for lat_origin, long_origin pair
+ *   origin_row  - row for lat_origin, long_origin pair
+ *  
+ * output:
+ *   gridnav - filled gridnav structure
+ *
+ *****************************************************************************/
+
+int GRID_init(float central_lat, float central_lon, int projection, 
+	      float truelat1, float truelat2, int num_columns, 
+	      int num_rows, float dx, float dy, float lat_origin, 
+	      float lon_origin, float origin_column, float origin_row, 
+	      GridNav *gridnav)
+{
+
+  int status = 1;
+
+  gridnav->proj.central_lon = central_lon;
+  gridnav->proj.central_lat = central_lat;
+  gridnav->proj.map_proj = projection;
+  gridnav->proj.truelat1 = truelat1;
+  gridnav->proj.truelat2 = truelat2;
+
+  gridnav->grid.num_columns = num_columns;
+  gridnav->grid.num_rows = num_rows;
+  gridnav->grid.dx = dx;
+  gridnav->grid.dy = dy;
+  gridnav->grid.lat_origin = lat_origin;
+  gridnav->grid.lon_origin = lon_origin;
+  gridnav->grid.origin_column = origin_column;
+  gridnav->grid.origin_row = origin_row;
+
+  fill_proj_parms(gridnav);
+
+  return status;
+}
+
+/*****************************************************************************
+ * Outputs the latitude and longitude of a grid point.
+ *
+ * input:
+ *   *gridnav - a pointer to a filled gridnav structure.  The gridnav 
+ *              structure should have been filled using one of the init 
+ *              functions.
+ *   column   - the column in the grid to retrieve.
+ *   row      - the row in the grid to retrieve.
+ * 
+ * output:
+ *   *lat - pointer to output latitude
+ *   *lon - pointer to output longitude
+ *
+ *****************************************************************************/
+
+int GRID_to_latlon(GridNav *gridnav, float column, float row, float *lat, 
+		   float *lon)
+{
+    /* 
+     * Calculate the latitude and longitude for an input grid point location 
+     */
+    double X, Y, R;
+    int status = 1;
+
+    switch (gridnav->proj.map_proj)
+	{
+	case GRID_MERCATOR:
+	    *lat = 2 * RAD_TO_DEG *
+		atan(exp((gridnav->proj_transform.parm2 + gridnav->grid.dx *
+			  (row - gridnav->grid.origin_row)) /
+			 gridnav->proj_transform.parm1 )) - 90;
+	    *lon = gridnav->grid.lon_origin + RAD_TO_DEG * gridnav->grid.dx *
+		(column - gridnav->grid.origin_column) /
+		gridnav->proj_transform.parm1;
+	    break;
+
+	case GRID_LAMCON:
+	    X = (column - gridnav->grid.origin_column) * gridnav->grid.dx +
+		gridnav->proj_transform.parm6;
+	    Y = (row - gridnav->grid.origin_row) * gridnav->grid.dy +
+		gridnav->proj_transform.parm3 + gridnav->proj_transform.parm7;
+	    R = sqrt(X*X + Y*Y);
+	    *lat = gridnav->proj_transform.parm5 * 90 - 
+		2 * RAD_TO_DEG * atan(gridnav->proj_transform.parm4 * 
+				      pow(R, 1 / 
+					  gridnav->proj_transform.parm2));
+	    *lon = gridnav->proj.central_lon + 
+		RAD_TO_DEG / gridnav->proj_transform.parm2 *
+		atan(X / (gridnav->proj_transform.parm5 * -Y));
+	    while (*lon > 180) *lon -= 360;
+	    while (*lon <= -180) *lon += 360;
+	    break;
+
+	case GRID_POLSTR:
+	    X = (column - gridnav->grid.origin_column)*gridnav->grid.dx;
+	    Y = (row - gridnav->grid.origin_row)*gridnav->grid.dy + 
+		gridnav->proj_transform.parm3;
+	    R = sqrt(X*X + Y*Y);
+	    *lat = gridnav->proj_transform.parm5*90 - 2 * RAD_TO_DEG *
+		atan((gridnav->proj_transform.parm5*R/EARTH_RAD)/
+		     (1+cos(gridnav->proj_transform.parm1)));
+	    *lon = gridnav->grid.lon_origin + RAD_TO_DEG * 
+		atan(X/(gridnav->proj_transform.parm5 * -Y));
+	    while (*lon > 180) *lon -= 360;
+	    while (*lon <= -180) *lon += 360;
+	    break;
+      
+	case GRID_LATLON:
+	    *lat = (row - gridnav->grid.origin_row)*gridnav->grid.dy +
+		gridnav->grid.lat_origin;
+	    *lon = (column - gridnav->grid.origin_column)*gridnav->grid.dx +
+		gridnav->grid.lon_origin;
+	    break;
+
+	default:
+	    /* 
+	     *  Unsupported map projection: set lat-lon to no-data values. 
+	     */ 
+	    fprintf(stderr,"GRID_to_latlon: Unsupport map projection type %d\n", 
+		    gridnav->proj.map_proj); 
+	    *lon = -9999; 
+	    *lat = -9999; 
+	    status = 0; 
+	    break; 
+
+	} /* end of switch on map projection type */
+
+
+    return status;
+}
+
+
+/*****************************************************************************
+ * Outputs grid point indices, given lat/lon location.
+ *
+ * input:
+ *   *gridnav - a pointer to a filled gridnav structure.  The gridnav 
+ *              structure should have been filled using one of the init 
+ *              functions.
+ *   lat      - latitude for location
+ *   lon      - longitude for location
+ * output:
+ *   *column  - pointer to value for column
+ *   *row     - pointer to value for row
+ *
+ *****************************************************************************/
+
+int GRID_from_latlon(GridNav *gridnav, float lat, float lon, float *column, 
+		     float *row)
+{
+    double X, Y, Rs;
+    double lat_rad;
+    int status = 1;
+
+    switch (gridnav->proj.map_proj) 
+	{
+	case GRID_MERCATOR:
+	    X = gridnav->proj_transform.parm1 *
+		((lon - gridnav->grid.lon_origin) / RAD_TO_DEG);
+	    *column = gridnav->grid.origin_column + X / gridnav->grid.dx;
+	    lat_rad = lat / RAD_TO_DEG;
+	    Y = gridnav->proj_transform.parm1 * log((1 + sin(lat_rad)) / 
+						    cos(lat_rad));
+	    *row = gridnav->grid.origin_row + 
+		((Y-gridnav->proj_transform.parm2) / gridnav->grid.dy);;
+	    break;
+
+	case GRID_LAMCON:
+	    Rs = (EARTH_RAD / gridnav->proj_transform.parm2) *
+		sin(gridnav->proj_transform.parm1) *
+		pow(tan((gridnav->proj_transform.parm5 * 90 - lat) / 
+			(2 * RAD_TO_DEG))/
+		    tan(gridnav->proj_transform.parm1 / 2),
+		    gridnav->proj_transform.parm2);
+	    *row = gridnav->grid.origin_row - 
+		(1 / gridnav->grid.dy) * 
+		(gridnav->proj_transform.parm3 + 
+		 Rs * cos(gridnav->proj_transform.parm2*
+			  (lon - gridnav->proj.central_lon) / RAD_TO_DEG)) -
+		gridnav->proj_transform.parm7 / gridnav->grid.dy;
+	    *column = gridnav->grid.origin_column + 
+		( gridnav->proj_transform.parm5*
+		((Rs / gridnav->grid.dx)*
+		 sin(gridnav->proj_transform.parm2 * 
+		     (lon - gridnav->proj.central_lon) / RAD_TO_DEG) - 
+		  gridnav->proj_transform.parm6 / gridnav->grid.dx));
+	    break;
+
+	case GRID_POLSTR:
+	    Rs = EARTH_RAD * sin((gridnav->proj_transform.parm5 * 90 - lat) 
+				 / RAD_TO_DEG)*
+		((1 + cos(gridnav->proj_transform.parm1)) /
+		 (1 + cos((gridnav->proj_transform.parm5 * 90 - lat) 
+			  / RAD_TO_DEG)) );
+	    *row = gridnav->grid.origin_row - 
+		(1 / gridnav->grid.dy) * 
+		(gridnav->proj_transform.parm3 + 
+		 Rs * cos((lon - gridnav->grid.lon_origin) / RAD_TO_DEG));
+	    *column = gridnav->grid.origin_column + 
+		gridnav->proj_transform.parm5 *
+		((Rs / gridnav->grid.dx) *
+		 sin((lon - gridnav->grid.lon_origin) / RAD_TO_DEG));
+	    break;
+    
+	case GRID_LATLON:
+	    *row = ((lat - gridnav->grid.lat_origin) / gridnav->grid.dy) +
+		gridnav->grid.origin_row;
+	    /* If lon is negative, make it positive */
+	    while (lon < 0) lon += 360.;
+	    *column = ((lon - gridnav->grid.lon_origin) / gridnav->grid.dx) +
+		gridnav->grid.origin_column;
+	    break;
+
+	default:
+	    fprintf(stderr,"GRID_from_latlon: Unsupported map projection type %d\n",
+		    gridnav->proj.map_proj);
+	    *column = -9999;
+	    *row = -9999;
+	    status = 0;
+	    break;
+
+	} /* End of switch on map projection type */
+
+    return status;
+}
+
+int fill_proj_parms(GridNav *gridnav)
+{
+    double orig_lat_rad;
+    double R_orig;
+    int hemifactor;
+  
+    switch (gridnav->proj.map_proj) 
+	{
+	case GRID_MERCATOR:
+	    gridnav->proj_transform.parm1 = 
+		EARTH_RAD * cos(gridnav->proj.truelat1 / RAD_TO_DEG);
+	    orig_lat_rad = (gridnav->grid.lat_origin) / RAD_TO_DEG;
+	    gridnav->proj_transform.parm2 = 
+		gridnav->proj_transform.parm1 *
+		log((1. + sin(orig_lat_rad)) / cos(orig_lat_rad));
+	    gridnav->proj_transform.parm3 = MISSING;
+	    gridnav->proj_transform.parm4 = MISSING;
+	    gridnav->proj_transform.parm5 = MISSING;
+	    break;
+	case GRID_LAMCON:
+	    if (gridnav->proj.truelat1 >= 0) 
+		{
+		    hemifactor = 1;
+		} 
+	    else 
+		{
+		    hemifactor = -1;
+		}
+	    /* This is Psi1 in MM5 speak */
+	    gridnav->proj_transform.parm1 = 
+		hemifactor*(PI/2 - fabs(gridnav->proj.truelat1) / RAD_TO_DEG);
+	    /* This is Kappa in MM5 speak */
+            if (fabs(gridnav->proj.truelat1 - gridnav->proj.truelat2) < .01) 
+		{
+		    gridnav->proj_transform.parm2 = 
+			sin(gridnav->proj.truelat1 / RAD_TO_DEG);
+		}
+	    else 
+		{
+		    gridnav->proj_transform.parm2 = 
+			(log10(cos(gridnav->proj.truelat1 / RAD_TO_DEG)) - 
+			 log10(cos(gridnav->proj.truelat2 / RAD_TO_DEG))) /
+			(log10(tan((45 - fabs(gridnav->proj.truelat1) / 2) / RAD_TO_DEG)) - 
+			 log10(tan((45 - fabs(gridnav->proj.truelat2) / 2) / RAD_TO_DEG)));
+		}
+	    /* This is Yc in MM5 speak */
+	    gridnav->proj_transform.parm3 = 
+		-EARTH_RAD/gridnav->proj_transform.parm2 * 
+		sin(gridnav->proj_transform.parm1) *
+		pow(
+		    (tan((hemifactor * 90 - gridnav->grid.lat_origin) / 
+			 (RAD_TO_DEG * 2)) /
+		     tan(gridnav->proj_transform.parm1 / 2)),
+		    gridnav->proj_transform.parm2);
+	    gridnav->proj_transform.parm4 = 
+		tan(gridnav->proj_transform.parm1 / 2)*
+		pow(hemifactor * (gridnav->proj_transform.parm2)/
+		    (EARTH_RAD * sin(gridnav->proj_transform.parm1)),
+		    1 / gridnav->proj_transform.parm2);
+	    gridnav->proj_transform.parm5 = hemifactor;
+	    R_orig = (EARTH_RAD / gridnav->proj_transform.parm2) *
+		sin(gridnav->proj_transform.parm1) *
+		pow(tan((gridnav->proj_transform.parm5 * 90 - 
+			 gridnav->grid.lat_origin) / 
+			(2 * RAD_TO_DEG))/
+		    tan(gridnav->proj_transform.parm1 / 2),
+		    gridnav->proj_transform.parm2);
+	    /* X origin */
+	    gridnav->proj_transform.parm6 = 
+		R_orig * sin(gridnav->proj_transform.parm2 * 
+			     (gridnav->grid.lon_origin - 
+			      gridnav->proj.central_lon) / RAD_TO_DEG);
+
+	    /* Y origin */
+	    gridnav->proj_transform.parm7 = -(gridnav->proj_transform.parm3 + 
+		R_orig * cos(gridnav->proj_transform.parm2 * 
+			     (gridnav->grid.lon_origin - 
+			      gridnav->proj.central_lon) / RAD_TO_DEG));
+	    break;
+	case GRID_POLSTR:
+	    if (gridnav->proj.truelat1 > 0) 
+		{
+		    hemifactor = 1;
+		} 
+	    else 
+		{
+		    hemifactor = -1;
+		}
+
+	    /* This is Psi1 in MM5 speak */
+	    gridnav->proj_transform.parm1 = 
+		hemifactor * (PI/2 - fabs(gridnav->proj.truelat1) / RAD_TO_DEG);
+	    gridnav->proj_transform.parm2 = 
+		(1+log10(cos(gridnav->proj.truelat1 / RAD_TO_DEG))) / 
+		( -log10(tan(45 / RAD_TO_DEG - hemifactor * 
+			     gridnav->proj.truelat1 /
+			     (2 * RAD_TO_DEG) )) );
+	    /* This is Yc in MM5 speak */
+	    gridnav->proj_transform.parm3 = 
+		-EARTH_RAD * sin((hemifactor * 90 - 
+				  gridnav->grid.lat_origin) / RAD_TO_DEG)*
+		( (1 + cos(gridnav->proj_transform.parm1))/
+		  (1 + cos((hemifactor*90 - gridnav->grid.lat_origin) / 
+			   RAD_TO_DEG)) );
+	    gridnav->proj_transform.parm4 = MISSING;
+	    gridnav->proj_transform.parm5 = hemifactor;
+	    break;
+	case GRID_LATLON:
+	  gridnav->proj_transform.parm1 = MISSING;
+	  gridnav->proj_transform.parm2 = MISSING;
+	  gridnav->proj_transform.parm3 = MISSING;
+	  gridnav->proj_transform.parm4 = MISSING;
+	  gridnav->proj_transform.parm5 = MISSING;
+	  break;
+
+	default:
+	    fprintf(stderr,"GRID_init_mm5data: Invalid Projection\n");
+	    return 0;
+	}
+    return 1;
+}
+
+/*****************************************************************************
+ * Rotates u and v components of wind, from being relative to earth, to 
+ *  relative to grid.
+ *
+ * input:
+ *   *gridnav - a pointer to a filled gridnav structure.  The gridnav 
+ *              structure should have been filled using one of the init 
+ *              functions.
+ *   lon      - longitude for location
+ *   u_earth  - the u component of the wind in earth (north-relative) 
+ *              coordinates.
+ *   v_earth  - the v component of the wind in earth (north-relative) 
+ *              coordinates.
+ * output:
+ *   *u_grid  - pointer to value for u in grid coordinates
+ *   *v_grid  - pointer to value for v in grid coordinates
+ *
+ *****************************************************************************/
+
+int GRID_rotate_from_earth_coords(GridNav *gridnav, float lon, float u_earth, 
+				  float v_earth, float *u_grid, float *v_grid)
+{
+    float speed, dir;
+    float dir_grid;
+
+    /* Calculate Speed and Direction from u,v */
+    switch (gridnav->proj.map_proj) 
+	{
+	case GRID_MERCATOR:
+	    *u_grid = u_earth;
+	    *v_grid = v_earth;
+	    break;
+	case GRID_POLSTR: case GRID_LAMCON:
+	    speed = sqrt(u_earth * u_earth + v_earth * v_earth);
+	    dir = RAD_TO_DEG * atan2(-u_earth,-v_earth);
+	    while (dir >= 360) dir -= 360;
+	    while (dir < 0) dir += 360;
+	    
+	    dir_grid = dir - (lon - gridnav->proj.central_lon) * 
+		gridnav->proj_transform.parm2;
+	    while (dir_grid >= 360) dir_grid -= 360;
+	    while (dir_grid < 0) dir_grid += 360;
+	    
+	    *u_grid = -1. * speed * sin(dir_grid / RAD_TO_DEG);
+	    *v_grid = -1. * speed * cos(dir_grid / RAD_TO_DEG);
+	    break;
+	default:
+	    fprintf(stderr,
+		    "GRID_rotate_from_earth_coords: Invalid Projection\n");
+	    return 0;
+	}  /* End of switch projection */
+
+    return 1;
+}
+
+/*****************************************************************************
+ * Rotates u and v components of wind, from being relative to earth, to 
+ *  relative to grid.
+ *
+ * input:
+ *   *gridnav - a pointer to a filled gridnav structure.  The gridnav 
+ *              structure should have been filled using one of the init 
+ *              functions.
+ *   lon      - longitude for location
+ *   u_grid   - the u component of the wind in grid coordinates 
+ *   v_grid   - the v component of the wind in grid coordinates
+ *
+ * output:
+ *   *u_earth - pointer to value for u in earth-relative coordinates
+ *   *v_grid  - pointer to value for v in earth-relative coordinates
+ *
+ *****************************************************************************/
+
+int GRID_rotate_to_earth_coords(GridNav *gridnav, float lon, float u_grid, 
+				float v_grid, float *u_earth, float *v_earth)
+{
+    float speed, dir_grid;
+    float dir_earth;
+    
+    /* Calculate Speed and Direction from u,v */
+    switch (gridnav->proj.map_proj) 
+	{
+	case GRID_MERCATOR:
+	    *u_earth = u_grid;
+	    *v_earth = v_grid;
+	    break;
+	case GRID_POLSTR: case GRID_LAMCON:
+	    speed = sqrt(u_grid * u_grid + v_grid * v_grid);
+	    dir_grid = RAD_TO_DEG * atan2(-u_grid, -v_grid);
+	    while (dir_grid >= 360) dir_grid -= 360;
+	    while (dir_grid < 0) dir_grid += 360;
+	    
+	    dir_earth = dir_grid + (lon - gridnav->proj.central_lon) *
+		gridnav->proj_transform.parm2;
+	    
+	    while (dir_earth >= 360) dir_earth -= 360;
+	    while (dir_earth < 0) dir_earth += 360;
+	    
+	    *u_earth = -1. * speed * sin(dir_earth / RAD_TO_DEG);
+	    *v_earth = -1. * speed * cos(dir_earth / RAD_TO_DEG);
+	    break;
+	default:
+	    fprintf(stderr,
+		    "GRID_rotate_to_earth_coords: Invalid Projection\n");
+	    return 0;
+	}  /* End of switch projection */
+    return 1;
+}
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/gridnav.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/gridnav.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/gridnav.h	(revision 2744)
@@ -0,0 +1,64 @@
+/*****************************************************************************
+ * Todd Hutchinson
+ * WSI Corporation
+ * Billerica, MA
+ *****************************************************************************/
+
+/* This header contains the public interface to the GridNav API. */
+
+typedef struct {
+  float central_lat;
+  float central_lon;
+  int map_proj; 
+  float truelat1;
+  float truelat2;
+} Projection;
+
+typedef struct {
+  int num_columns;
+  int num_rows;
+  float dx;
+  float dy;
+  float lat_origin;
+  float lon_origin;
+  float origin_column;
+  float origin_row;
+} GridStruct;
+
+typedef struct {
+  double parm1;
+  double parm2;
+  double parm3;
+  double parm4;
+  double parm5;
+  double parm6;
+  double parm7;
+} ProjTransform;
+
+typedef struct {
+  Projection proj;
+  GridStruct grid;
+  ProjTransform proj_transform;
+} GridNav;
+
+
+/* Public Interface */
+
+int GRID_init(float center_lat, float center_lon, int projection, 
+	      float truelat1, float truelat2, int num_columns, 
+	      int num_rows, float dx, float dy, float lat_origin, 
+	      float lon_origin, float origin_column, float origin_row, 
+	      GridNav *gridnav);
+int GRID_to_latlon(GridNav *gridnav, float column, float row, float *lat, 
+		   float *lon);
+int GRID_from_latlon(GridNav *gridnav, float lat, float lon, float *column, 
+		     float *row);
+int GRID_rotate_from_earth_coords(GridNav *gridnav, float lon, float u_earth, 
+				  float v_earth, float *u_grid, float *v_grid);
+int GRID_rotate_to_earth_coords(GridNav *gridnav, float lon, float u_grid, 
+				float v_grid, float *u_earth, float *v_earth);
+
+#define GRID_LATLON   0
+#define GRID_MERCATOR 1
+#define GRID_LAMCON   3
+#define GRID_POLSTR   5
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/io_grib_share.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/io_grib_share.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/io_grib_share.F	(revision 2744)
@@ -0,0 +1,682 @@
+!
+! Todd Hutchinson
+! WSI
+! August 17, 2005
+!
+! Routines in this file are shared by io_grib1 and io_grib2
+!
+
+!*****************************************************************************
+
+SUBROUTINE get_dims(MemoryOrder, Start, End, ndim, x_start, x_end, y_start, &
+     y_end, z_start, z_end)
+  IMPLICIT NONE
+  CHARACTER (LEN=*)    ,INTENT(IN)    :: MemoryOrder
+  INTEGER              ,INTENT(OUT)   :: ndim,x_start,x_end,y_start
+  INTEGER              ,INTENT(OUT)   :: y_end,z_start,z_end
+  integer ,dimension(*),intent(in)    :: Start, End
+  CHARACTER (LEN=1)                   :: char
+  INTEGER                             :: idx
+  CHARACTER (LEN=3)                   :: MemoryOrderLcl
+
+  x_start = 1
+  x_end   = 1
+  y_start = 1
+  y_end   = 1
+  z_start = 1
+  z_end   = 1
+
+  !
+  ! Note: Need to add "char == 'S'" for boundary conditions
+  !
+
+  ndim = 0
+
+  ! Fix for out-of-bounds references
+  MemoryOrderLcl = '   '
+  do idx=1,len_trim(MemoryOrder)
+     MemoryOrderLcl(idx:idx) = MemoryOrder(idx:idx)
+  enddo
+  !
+  ! First, do the special boundary cases.  These do not seem to 
+  !    
+  if ((MemoryOrderLcl(1:3) .eq. 'XSZ') &
+       .or. (MemoryOrderLcl(1:3) .eq. 'XEZ')) then
+     x_start = Start(3)
+     x_end = End(3)
+     y_start = Start(1)
+     y_end = End(1)
+     z_start = Start(2)
+     z_end = End(2)
+     ndim = 3
+  else if ((MemoryOrderLcl(1:3) .eq. 'YSZ') .or. &
+       (MemoryOrderLcl(1:3) .eq. 'YEZ')) then
+     x_start = Start(1)
+     x_end = End(1)
+     y_start = Start(3)
+     y_end = End(3)
+     z_start = Start(2)
+     z_end = End(2)
+     ndim = 3
+  else if ((MemoryOrderLcl(1:2) .eq. 'YS') .or. &
+       (MemoryOrderLcl(1:2) .eq. 'YE')) then
+     x_start = Start(1)
+     x_end = End(1)
+     y_start = Start(2)
+     y_end = End(2)
+     ndim = 2
+  else if ((MemoryOrderLcl(1:2) .eq. 'XS') .or. &
+       (MemoryOrderLcl(1:2) .eq. 'XE')) then
+     x_start = Start(2)
+     x_end = End(2)
+     y_start = Start(1)
+     y_end = End(1)
+     ndim = 2
+  else if ((MemoryOrderLcl(1:1) .eq. 'C') .or. (MemoryOrderLcl(1:1) .eq. 'c')) then 
+     ! This is for "non-decomposed" fields
+     x_start = Start(1)
+     x_end = End(1)
+!     y_start = Start(2)
+!     y_end = End(2)
+!     z_start = Start(3)
+!     z_end = End(3)
+     ndim = 3
+  else
+     do idx=1,len_trim(MemoryOrderLcl)
+        char = MemoryOrderLcl(idx:idx)
+        if ((char == 'X') .or. (char == 'x')) then
+           x_start = Start(idx)
+           x_end   = End(idx)
+           ndim = ndim + 1
+        else if ((char == 'Y') .or. (char == 'y')) then
+           y_start = Start(idx)
+           y_end   = End(idx)
+           ndim = ndim + 1
+        else if ((char == 'Z') .or. (char == 'z')) then
+           z_start = Start(idx)
+           z_end   = End(idx)
+           ndim = ndim + 1
+        else if (char == '0') then
+           ! Do nothing, this indicates field is a scalar.
+           ndim = 0
+        else
+           call wrf_message('Invalid Dimension in get_dims: '//char)
+        endif
+     enddo
+  endif
+
+END SUBROUTINE get_dims
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE geth_idts (ndate, odate, idts)
+
+  IMPLICIT NONE
+
+  !  From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'), 
+  !  compute the time difference.
+
+  !  on entry     -  ndate  -  the new hdate.
+  !                  odate  -  the old hdate.
+
+  !  on exit      -  idts    -  the change in time in seconds.
+
+  CHARACTER (LEN=*) , INTENT(INOUT) :: ndate, odate
+  REAL              , INTENT(OUT)   :: idts
+
+  !  Local Variables
+
+  !  yrnew    -  indicates the year associated with "ndate"
+  !  yrold    -  indicates the year associated with "odate"
+  !  monew    -  indicates the month associated with "ndate"
+  !  moold    -  indicates the month associated with "odate"
+  !  dynew    -  indicates the day associated with "ndate"
+  !  dyold    -  indicates the day associated with "odate"
+  !  hrnew    -  indicates the hour associated with "ndate"
+  !  hrold    -  indicates the hour associated with "odate"
+  !  minew    -  indicates the minute associated with "ndate"
+  !  miold    -  indicates the minute associated with "odate"
+  !  scnew    -  indicates the second associated with "ndate"
+  !  scold    -  indicates the second associated with "odate"
+  !  i        -  loop counter
+  !  mday     -  a list assigning the number of days in each month
+
+  CHARACTER (LEN=24) :: tdate
+  INTEGER :: olen, nlen
+  INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew
+  INTEGER :: yrold, moold, dyold, hrold, miold, scold
+  INTEGER :: mday(12), i, newdys, olddys
+  LOGICAL :: npass, opass
+  INTEGER :: isign
+  CHARACTER (LEN=300) :: wrf_err_message
+  INTEGER :: ndfeb
+
+  IF (odate.GT.ndate) THEN
+     isign = -1
+     tdate=ndate
+     ndate=odate
+     odate=tdate
+  ELSE
+     isign = 1
+  END IF
+
+  !  Assign the number of days in a months
+
+  mday( 1) = 31
+  mday( 2) = 28
+  mday( 3) = 31
+  mday( 4) = 30
+  mday( 5) = 31
+  mday( 6) = 30
+  mday( 7) = 31
+  mday( 8) = 31
+  mday( 9) = 30
+  mday(10) = 31
+  mday(11) = 30
+  mday(12) = 31
+
+  !  Break down old hdate into parts
+
+  hrold = 0
+  miold = 0
+  scold = 0
+  olen = LEN(odate)
+
+  READ(odate(1:4),  '(I4)') yrold
+  READ(odate(6:7),  '(I2)') moold
+  READ(odate(9:10), '(I2)') dyold
+  IF (olen.GE.13) THEN
+     READ(odate(12:13),'(I2)') hrold
+     IF (olen.GE.16) THEN
+        READ(odate(15:16),'(I2)') miold
+        IF (olen.GE.19) THEN
+           READ(odate(18:19),'(I2)') scold
+        END IF
+     END IF
+  END IF
+
+  !  Break down new hdate into parts
+
+  hrnew = 0
+  minew = 0
+  scnew = 0
+  nlen = LEN(ndate)
+
+  READ(ndate(1:4),  '(I4)') yrnew
+  READ(ndate(6:7),  '(I2)') monew
+  READ(ndate(9:10), '(I2)') dynew
+  IF (nlen.GE.13) THEN
+     READ(ndate(12:13),'(I2)') hrnew
+     IF (nlen.GE.16) THEN
+        READ(ndate(15:16),'(I2)') minew
+        IF (nlen.GE.19) THEN
+           READ(ndate(18:19),'(I2)') scnew
+        END IF
+     END IF
+  END IF
+
+  !  Check that the dates make sense.
+
+  npass = .true.
+  opass = .true.
+
+  !  Check that the month of NDATE makes sense.
+
+  IF ((monew.GT.12).or.(monew.LT.1)) THEN
+     PRINT*, 'GETH_IDTS:  Month of NDATE = ', monew
+     npass = .false.
+  END IF
+
+  !  Check that the month of ODATE makes sense.
+
+  IF ((moold.GT.12).or.(moold.LT.1)) THEN
+     PRINT*, 'GETH_IDTS:  Month of ODATE = ', moold
+     opass = .false.
+  END IF
+
+  !  Check that the day of NDATE makes sense.
+
+  IF (monew.ne.2) THEN
+     ! ...... For all months but February
+     IF ((dynew.GT.mday(monew)).or.(dynew.LT.1)) THEN
+        PRINT*, 'GETH_IDTS:  Day of NDATE = ', dynew
+        npass = .false.
+     END IF
+  ELSE IF (monew.eq.2) THEN
+     ! ...... For February
+     IF ((dynew.GT.ndfeb(yrnew)).OR.(dynew.LT.1)) THEN
+        PRINT*, 'GETH_IDTS:  Day of NDATE = ', dynew
+        npass = .false.
+     END IF
+  END IF
+
+  !  Check that the day of ODATE makes sense.
+
+  IF (moold.ne.2) THEN
+     ! ...... For all months but February
+     IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
+        PRINT*, 'GETH_IDTS:  Day of ODATE = ', dyold
+        opass = .false.
+     END IF
+  ELSE IF (moold.eq.2) THEN
+     ! ....... For February
+     IF ((dyold.GT.ndfeb(yrold)).or.(dyold.LT.1)) THEN
+        PRINT*, 'GETH_IDTS:  Day of ODATE = ', dyold
+        opass = .false.
+     END IF
+  END IF
+
+  !  Check that the hour of NDATE makes sense.
+
+  IF ((hrnew.GT.23).or.(hrnew.LT.0)) THEN
+     PRINT*, 'GETH_IDTS:  Hour of NDATE = ', hrnew
+     npass = .false.
+  END IF
+
+  !  Check that the hour of ODATE makes sense.
+
+  IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
+     PRINT*, 'GETH_IDTS:  Hour of ODATE = ', hrold
+     opass = .false.
+  END IF
+
+  !  Check that the minute of NDATE makes sense.
+
+  IF ((minew.GT.59).or.(minew.LT.0)) THEN
+     PRINT*, 'GETH_IDTS:  Minute of NDATE = ', minew
+     npass = .false.
+  END IF
+
+  !  Check that the minute of ODATE makes sense.
+
+  IF ((miold.GT.59).or.(miold.LT.0)) THEN
+     PRINT*, 'GETH_IDTS:  Minute of ODATE = ', miold
+     opass = .false.
+  END IF
+
+  !  Check that the second of NDATE makes sense.
+
+  IF ((scnew.GT.59).or.(scnew.LT.0)) THEN
+     PRINT*, 'GETH_IDTS:  SECOND of NDATE = ', scnew
+     npass = .false.
+  END IF
+
+  !  Check that the second of ODATE makes sense.
+
+  IF ((scold.GT.59).or.(scold.LT.0)) THEN
+     PRINT*, 'GETH_IDTS:  Second of ODATE = ', scold
+     opass = .false.
+  END IF
+
+  IF (.not. npass) THEN
+     WRITE( wrf_err_message , * ) &
+          'module_date_time: geth_idts: Bad NDATE: ', ndate(1:nlen)
+     CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+  END IF
+
+  IF (.not. opass) THEN
+     WRITE( wrf_err_message , * ) &
+          'module_date_time: geth_idts: Bad ODATE: ', odate(1:olen)
+     CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+  END IF
+
+  !  Date Checks are completed.  Continue.
+
+  !  Compute number of days from 1 January ODATE, 00:00:00 until ndate
+  !  Compute number of hours from 1 January ODATE, 00:00:00 until ndate
+  !  Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
+
+  newdys = 0
+  DO i = yrold, yrnew - 1
+     newdys = newdys + (365 + (ndfeb(i)-28))
+  END DO
+
+  IF (monew .GT. 1) THEN
+     mday(2) = ndfeb(yrnew)
+     DO i = 1, monew - 1
+        newdys = newdys + mday(i)
+     END DO
+     mday(2) = 28
+  END IF
+
+  newdys = newdys + dynew-1
+
+  !  Compute number of hours from 1 January ODATE, 00:00:00 until odate
+  !  Compute number of minutes from 1 January ODATE, 00:00:00 until odate
+
+  olddys = 0
+
+  IF (moold .GT. 1) THEN
+     mday(2) = ndfeb(yrold)
+     DO i = 1, moold - 1
+        olddys = olddys + mday(i)
+     END DO
+     mday(2) = 28
+  END IF
+
+  olddys = olddys + dyold-1
+
+  !  Determine the time difference in seconds
+
+  idts = (newdys - olddys) * 86400
+  idts = idts + (hrnew - hrold) * 3600
+  idts = idts + (minew - miold) * 60
+  idts = idts + (scnew - scold)
+
+  IF (isign .eq. -1) THEN
+     tdate=ndate
+     ndate=odate
+     odate=tdate
+     idts = idts * isign
+  END IF
+
+END SUBROUTINE geth_idts
+
+!*****************************************************************************
+
+SUBROUTINE get_vert_stag(VarName,Stagger,vert_stag)
+  
+  character (LEN=*) :: VarName
+  character (LEN=*) :: Stagger
+  logical           :: vert_stag
+
+  if ((index(Stagger,'Z') > 0) .or. (VarName .eq. 'DNW') &
+       .or.(VarName .eq. 'RDNW')) then
+     vert_stag = .true.
+  else
+     vert_stag = .false.
+  endif
+end SUBROUTINE
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+FUNCTION ndfeb ( year ) RESULT (num_days)
+  
+  ! Compute the number of days in February for the given year
+  
+  IMPLICIT NONE
+  
+  INTEGER :: year
+  INTEGER :: num_days
+  
+  num_days = 28 ! By default, February has 28 days ...
+  IF (MOD(year,4).eq.0) THEN  
+     num_days = 29  ! But every four years, it has 29 days ...
+     IF (MOD(year,100).eq.0) THEN
+        num_days = 28  ! Except every 100 years, when it has 28 days ...
+        IF (MOD(year,400).eq.0) THEN
+           num_days = 29  ! Except every 400 years, when it has 29 days.
+        END IF
+     END IF
+  END IF
+  
+END FUNCTION ndfeb
+
+!*****************************************************************************
+
+SUBROUTINE get_dimvals(MemoryOrder,x,y,z,dims)
+
+  IMPLICIT NONE
+  CHARACTER (LEN=*)    ,INTENT(IN)    :: MemoryOrder
+  INTEGER              ,INTENT(IN)    :: x,y,z
+  INTEGER, DIMENSION(*),INTENT(OUT)   :: dims
+  INTEGER                             :: idx
+  CHARACTER (LEN=1) :: char
+  CHARACTER (LEN=3) :: MemoryOrderLcl
+
+  dims(1) = 1
+  dims(2) = 1
+  dims(3) = 1
+
+  ! Fix for out-of-bounds references
+  MemoryOrderLcl = '   '
+  do idx=1,len_trim(MemoryOrder)
+     MemoryOrderLcl(idx:idx) = MemoryOrder(idx:idx)
+  enddo
+
+  !
+  ! Note: Need to add "char == 'S'" for boundary conditions
+  !
+
+  if ((MemoryOrderLcl(1:3) .eq. 'XSZ') &
+       .or. (MemoryOrderLcl(1:3) .eq. 'XEZ')) then
+     dims(1) = y
+     dims(2) = z
+     dims(3) = x
+  else if ((MemoryOrderLcl(1:3) .eq. 'YSZ') .or. &
+       (MemoryOrderLcl(1:3) .eq. 'YEZ')) then
+     dims(1) = x
+     dims(2) = z
+     dims(3) = y
+  else if ((MemoryOrderLcl(1:2) .eq. 'YS') .or. &
+       (MemoryOrderLcl(1:2) .eq. 'YE')) then
+     dims(1) = x
+     dims(2) = y
+     dims(3) = z
+  else if ((MemoryOrderLcl(1:2) .eq. 'XS') .or. &
+       (MemoryOrderLcl(1:2) .eq. 'XE')) then
+     dims(1) = y
+     dims(2) = x
+     dims(3) = z
+  else if ((MemoryOrderLcl(1:1) .eq. 'C') .or. &
+       (MemoryOrderLcl(1:1) .eq. 'c')) then
+     ! Non-decomposed field
+     dims(1) = x
+     dims(2) = y
+     dims(3) = z
+  else 
+     do idx=1,len_trim(MemoryOrderLcl)
+        char = MemoryOrderLcl(idx:idx)
+        if ((char == 'X') .or. (char == 'x')) then
+           dims(idx) = x
+        else if ((char == 'Y') .or. (char == 'y')) then
+           dims(idx) = y
+        else if ((char == 'Z') .or. (char == 'z')) then
+           dims(idx) = z
+        else if (char == '0') then
+           ! This is a scalar, do nothing.
+        else
+           call wrf_message ('Invalid Dimension in get_dimvals: '//char)
+        endif
+     enddo
+  endif
+
+END SUBROUTINE get_dimvals
+
+!*****************************************************************************
+
+SUBROUTINE get_soil_layers(VarName,soil_layers)
+  
+  character (LEN=*) :: VarName
+  logical           :: soil_layers
+
+  if ((VarName .eq. 'ZS') .or. (VarName .eq. 'DZS') &
+       .or.(VarName .eq. 'TSLB') .or. (VarName .eq. 'SMOIS') &
+       .or. (VarName .eq. 'SH2O') .or. (VarName .eq. 'KEEPFR3DFLAG') &
+       .or. (VarName .eq. 'SMFR3D')) then
+     soil_layers = .true.
+  else
+     soil_layers = .false.
+  endif
+end SUBROUTINE
+
+!*****************************************************************************
+
+SUBROUTINE Transpose(MemoryOrder, di, FieldType, Field, &
+     Start1, End1, Start2, End2, Start3, End3, data, zidx, numrows, numcols)
+
+  IMPLICIT NONE
+
+#include "wrf_io_flags.h"
+
+  CHARACTER (LEN=*),INTENT(IN)    :: MemoryOrder
+  INTEGER          ,INTENT(IN)    :: Start1,End1,Start2,End2,Start3,End3
+  INTEGER          ,INTENT(IN)    :: di
+  integer          ,intent(inout) :: &
+       Field(di,Start1:End1,Start2:End2,Start3:End3)
+  INTEGER          ,intent(in)    :: FieldType
+  real             ,intent(in)    :: data(*)
+  INTEGER          ,INTENT(IN)    :: zidx, numcols, numrows
+  INTEGER, DIMENSION(3)           :: dims
+  INTEGER                         :: col, row
+  LOGICAL                         :: logicaltype
+  CHARACTER (LEN=1000)            :: msg
+     
+  if ((FieldType == WRF_REAL) .or. (FieldType == WRF_DOUBLE)) then
+     do col=1,numcols
+        do row=1,numrows
+           call get_dimvals(MemoryOrder,col,row,zidx,dims)
+           Field(1:di,dims(1),dims(2),dims(3)) = &
+                TRANSFER(data((row-1)*numcols+col),Field,1)
+        enddo
+     enddo
+  else if (FieldType == WRF_INTEGER) then
+     do col=1,numcols
+        do row=1,numrows
+           call get_dimvals(MemoryOrder,col,row,zidx,dims)
+           Field(1:di,dims(1),dims(2),dims(3)) = data((row-1)*numcols+col)
+        enddo
+     enddo
+  else
+     write (msg,*)'Reading of type ',FieldType,'from grib data not supported'
+     call wrf_message(msg)
+  endif
+
+!
+! This following seciton is for the logical type.  This caused some problems
+!   on certain platforms.
+! 
+!  else if (FieldType == WRF_LOGICAL) then
+!     do col=1,numcols
+!        do row=1,numrows
+!           call get_dimvals(MemoryOrder,col,row,zidx,dims)
+!           Field(1:di,dims(1),dims(2),dims(3)) = &
+!                TRANSFER(data((row-1)*numcols+col),logicaltype,1)
+!        enddo
+!     enddo
+  
+  
+end SUBROUTINE
+
+!*****************************************************************************
+
+SUBROUTINE Transpose1D(MemoryOrder, di, FieldType, Field, &
+     Start1, End1, Start2, End2, Start3, End3, data, nelems)
+
+  IMPLICIT NONE
+
+#include "wrf_io_flags.h"
+
+  CHARACTER (LEN=*),INTENT(IN)    :: MemoryOrder
+  INTEGER          ,INTENT(IN)    :: Start1,End1,Start2,End2,Start3,End3
+  INTEGER          ,INTENT(IN)    :: di
+  integer          ,intent(inout) :: &
+       Field(di,Start1:End1,Start2:End2,Start3:End3)
+  INTEGER          ,intent(in)    :: FieldType
+  real             ,intent(in)    :: data(*)
+  LOGICAL                         :: logicaltype
+  CHARACTER (LEN=1000)            :: msg
+  integer                         :: elemnum,nelems
+
+  if ((FieldType == WRF_REAL) .or. (FieldType == WRF_DOUBLE)) then
+     do elemnum=1,nelems
+        Field(1:di,elemnum,1,1) = TRANSFER(data(elemnum),Field,1)
+     enddo
+  else if (FieldType == WRF_INTEGER) then
+     do elemnum=1,nelems
+        Field(1:di,elemnum,1,1) = TRANSFER(data(elemnum),Field,1)
+     enddo
+  else
+     write (msg,*)'Reading of type ',FieldType,'from grib1 data not supported'
+     call wrf_message(msg)
+  endif
+
+!
+! This following seciton is for the logical type.  This caused some problems
+!   on certain platforms.
+! 
+!  else if (FieldType == WRF_LOGICAL) then
+!     do col=1,numcols
+!        do row=1,numrows
+!           call get_dimvals(MemoryOrder,col,row,zidx,dims)
+!           Field(1:di,dims(1),dims(2),dims(3)) = &
+!                TRANSFER(data((row-1)*numcols+col),logicaltype,1)
+!        enddo
+!     enddo
+  
+  
+end SUBROUTINE Transpose1D
+
+!*****************************************************************************
+!
+! Takes a starting date (startTime) in WRF format (yyyy-mm-dd_hh:mm:ss), 
+!   adds an input number of seconds to the time, and outputs a new date 
+!   (endTime) in WRF format.
+!
+!*****************************************************************************
+
+subroutine advance_wrf_time(startTime, addsecs, endTime)
+  implicit none
+
+  integer          , intent(in)  :: addsecs
+  character (len=*), intent(in)  :: startTime
+  character (len=*), intent(out) :: endTime
+  integer :: syear,smonth,sday,shour,smin,ssec
+  integer :: days_in_month(12)
+
+  read(startTime,'(I4.4,1X,I2.2,1X,I2.2,1X,I2.2,1X,I2.2,1X,I2.2)') &
+       syear,smonth,sday,shour,smin,ssec
+  
+  ssec = ssec + addsecs
+
+  do while (ssec .ge. 60) 
+     smin = smin + 1
+     ssec = ssec - 60
+  enddo
+
+  do while (smin .ge. 60)
+     shour = shour + 1
+     smin = smin - 60
+  enddo
+
+  do while (shour .ge. 24)
+     sday = sday + 1
+     shour = shour - 24
+  enddo
+
+
+  days_in_month(1) = 31
+  if (((mod(syear,4) .eq. 0) .and. (mod(syear,100) .ne. 0)) &
+       .or. (mod(syear,400) .eq. 0)) then
+     days_in_month(2) = 29
+  else
+     days_in_month(2) = 28
+  endif
+  days_in_month(3) = 31
+  days_in_month(4) = 30
+  days_in_month(5) = 31
+  days_in_month(6) = 30
+  days_in_month(7) = 31
+  days_in_month(8) = 31
+  days_in_month(9) = 30
+  days_in_month(10) = 31
+  days_in_month(11) = 30
+  days_in_month(12) = 31
+
+
+  do while (sday .gt. days_in_month(smonth))
+     sday = sday - days_in_month(smonth)
+     smonth = smonth + 1
+     if (smonth .gt. 12) then
+        smonth = 1
+        syear = syear + 1
+     endif
+  enddo
+  
+
+  write(endTime,'(I4.4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2)') &
+       syear,'-',smonth,'-',sday,'_',shour,':',smin,':',ssec
+
+  return
+
+end subroutine
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/open_file.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/open_file.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/open_file.c	(revision 2744)
@@ -0,0 +1,109 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <fcntl.h>
+
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define OPEN_FILE open_file
+#      define CLOSE_FILE close_file
+#      define WRITE_FILE write_file
+#      define WRITE_FILE_N write_file_n
+#      define FLUSH_FILE flush_file
+# else
+#   ifdef F2CSTYLE
+#      define OPEN_FILE open_file__
+#      define CLOSE_FILE close_file__
+#      define WRITE_FILE write_file__
+#      define WRITE_FILE_N write_file_n__
+#      define FLUSH_FILE flush_file__
+#   else
+#      define OPEN_FILE open_file_
+#      define CLOSE_FILE close_file_
+#      define WRITE_FILE write_file_
+#      define WRITE_FILE_N write_file_n_
+#      define FLUSH_FILE flush_file_
+#   endif
+# endif
+#endif
+
+/* 
+ * Fortran-callable function to open/close files
+ */
+int OPEN_FILE (char *filename, char *permissions, int *outfd, int *ierr, 
+	       int strlen1, int strlen2)
+{
+  char filename2[1000];
+  char permstring[1000];
+  int permvals;
+
+  strncpy(filename2,filename,strlen1);
+  filename2[strlen1]='\0';
+
+  strncpy(permstring,permissions,strlen2);
+  permstring[strlen2]='\0';
+
+  if (strcmp(permstring,"w") == 0) {
+    permvals = O_CREAT|O_WRONLY|O_TRUNC;
+  } else {
+    permvals = O_RDONLY;
+  }
+
+  *outfd = open(filename2,permvals,0644);
+  if (*outfd == -1) 
+    {
+      fprintf(stderr,"setting ierr to -1, filename: %s\n",filename);
+      perror("");
+      *ierr = -1;
+      return -1;
+    }
+  else
+    {
+      *ierr = 0;
+      return 0;
+    }
+}
+
+int WRITE_FILE(int *fd, char *buf, int *ierr, int strlen)
+{
+  int nbytes;
+
+  nbytes = write(*fd,buf,strlen);
+  if (nbytes != strlen)
+    {
+      *ierr = -1;
+    }
+  else
+    {
+      *ierr = 0;
+    }
+  return *ierr;
+}
+
+int WRITE_FILE_N(int *fd, char *buf, int *nbytes, int *ierr)
+{
+  int bytes_written;
+
+  bytes_written = write(*fd,buf,*nbytes);
+  if (bytes_written != *nbytes)
+    {
+      *ierr = -1;
+    }
+  else
+    {
+      *ierr = 0;
+    }
+  return *ierr;
+}
+
+int CLOSE_FILE (int *fd)
+{
+  close(*fd);
+  return 0;
+}
+
+int FLUSH_FILE (int *fd)
+{
+  fsync(*fd);
+  return 0;
+}
+
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/wrf_io_flags.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/wrf_io_flags.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/wrf_io_flags.h	(revision 2744)
@@ -0,0 +1,16 @@
+      integer, parameter  :: WRF_FILE_NOT_OPENED                  = 100
+      integer, parameter  :: WRF_FILE_OPENED_NOT_COMMITTED        = 101
+      integer, parameter  :: WRF_FILE_OPENED_FOR_WRITE            = 102
+      integer, parameter  :: WRF_FILE_OPENED_FOR_READ             = 103
+      integer, parameter  :: WRF_REAL                             = 104
+      integer, parameter  :: WRF_DOUBLE                           = 105
+#ifdef PROMOTE_FLOAT 
+      integer, parameter  :: WRF_FLOAT=WRF_DOUBLE
+#else      
+      integer, parameter  :: WRF_FLOAT=WRF_REAL
+#endif      
+      integer, parameter  :: WRF_INTEGER                          = 106
+      integer, parameter  :: WRF_LOGICAL                          = 107
+      integer, parameter  :: WRF_COMPLEX                          = 108
+      integer, parameter  :: WRF_DOUBLE_COMPLEX                   = 109
+      integer, parameter  :: WRF_FILE_OPENED_FOR_UPDATE           = 110
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/wrf_projection.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/wrf_projection.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/wrf_projection.h	(revision 2744)
@@ -0,0 +1,4 @@
+#define WRF_LATLON 0
+#define WRF_LAMBERT 1
+#define WRF_POLAR_STEREO 2
+#define WRF_MERCATOR 3
Index: trunk/WRF.COMMON/WRFV2/external/io_grib_share/wrf_status_codes.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_grib_share/wrf_status_codes.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_grib_share/wrf_status_codes.h	(revision 2744)
@@ -0,0 +1,142 @@
+  
+!WRF Error and Warning messages (1-999)
+!All i/o package-specific status codes you may want to add must be handled by your package (see below)
+! WRF handles these and netCDF messages only
+  integer, parameter  :: WRF_NO_ERR                  =  0       !no error
+  integer, parameter  :: WRF_WARN_FILE_NF            = -1       !file not found, or incomplete
+  integer, parameter  :: WRF_WARN_MD_NF              = -2       !metadata not found
+  integer, parameter  :: WRF_WARN_TIME_NF            = -3       !timestamp not found
+  integer, parameter  :: WRF_WARN_TIME_EOF           = -4       !no more timestamps
+  integer, parameter  :: WRF_WARN_VAR_NF             = -5       !variable not found
+  integer, parameter  :: WRF_WARN_VAR_EOF            = -6       !no more variables for the current time
+  integer, parameter  :: WRF_WARN_TOO_MANY_FILES     = -7       !too many open files
+  integer, parameter  :: WRF_WARN_TYPE_MISMATCH      = -8       !data type mismatch
+  integer, parameter  :: WRF_WARN_WRITE_RONLY_FILE   = -9       !attempt to write readonly file
+  integer, parameter  :: WRF_WARN_READ_WONLY_FILE    = -10      !attempt to read writeonly file
+  integer, parameter  :: WRF_WARN_FILE_NOT_OPENED    = -11      !attempt to access unopened file
+  integer, parameter  :: WRF_WARN_2DRYRUNS_1VARIABLE = -12      !attempt to do 2 trainings for 1 variable
+  integer, parameter  :: WRF_WARN_READ_PAST_EOF      = -13      !attempt to read past EOF
+  integer, parameter  :: WRF_WARN_BAD_DATA_HANDLE    = -14      !bad data handle
+  integer, parameter  :: WRF_WARN_WRTLEN_NE_DRRUNLEN = -15      !write length not equal to training length
+  integer, parameter  :: WRF_WARN_TOO_MANY_DIMS      = -16      !more dimensions requested than training
+  integer, parameter  :: WRF_WARN_COUNT_TOO_LONG     = -17      !attempt to read more data than exists
+  integer, parameter  :: WRF_WARN_DIMENSION_ERROR    = -18      !input dimension inconsistent
+  integer, parameter  :: WRF_WARN_BAD_MEMORYORDER    = -19      !input MemoryOrder not recognized
+  integer, parameter  :: WRF_WARN_DIMNAME_REDEFINED  = -20      !a dimension name with 2 different lengths
+  integer, parameter  :: WRF_WARN_CHARSTR_GT_LENDATA = -21      !string longer than provided storage
+  integer, parameter  :: WRF_WARN_NOTSUPPORTED       = -22      !function not supportable
+  integer, parameter  :: WRF_WARN_NOOP               = -23      !package implements this routine as NOOP
+
+!Fatal errors 
+  integer, parameter  :: WRF_ERR_FATAL_ALLOCATION_ERROR  = -100 !allocation error
+  integer, parameter  :: WRF_ERR_FATAL_DEALLOCATION_ERR  = -101 !dealloc error
+  integer, parameter  :: WRF_ERR_FATAL_BAD_FILE_STATUS   = -102 !bad file status
+
+
+!Package specific errors (1000+)        
+!Netcdf status codes
+!WRF will accept status codes of 1000+, but it is up to the package to handle
+! and return the status to the user.
+
+  integer, parameter  :: WRF_ERR_FATAL_BAD_VARIABLE_DIM  = -1004
+  integer, parameter  :: WRF_ERR_FATAL_MDVAR_DIM_NOT_1D  = -1005
+  integer, parameter  :: WRF_ERR_FATAL_TOO_MANY_TIMES    = -1006
+  integer, parameter  :: WRF_WARN_BAD_DATA_TYPE      = -1007    !this code not in either spec?
+  integer, parameter  :: WRF_WARN_FILE_NOT_COMMITTED = -1008    !this code not in either spec?
+  integer, parameter  :: WRF_WARN_FILE_OPEN_FOR_READ = -1009
+  integer, parameter  :: WRF_IO_NOT_INITIALIZED      = -1010
+  integer, parameter  :: WRF_WARN_MD_AFTER_OPEN      = -1011
+  integer, parameter  :: WRF_WARN_TOO_MANY_VARIABLES = -1012
+  integer, parameter  :: WRF_WARN_DRYRUN_CLOSE       = -1013
+  integer, parameter  :: WRF_WARN_DATESTR_BAD_LENGTH = -1014
+  integer, parameter  :: WRF_WARN_ZERO_LENGTH_READ   = -1015
+  integer, parameter  :: WRF_WARN_DATA_TYPE_NOT_FOUND = -1016
+  integer, parameter  :: WRF_WARN_DATESTR_ERROR      = -1017
+  integer, parameter  :: WRF_WARN_DRYRUN_READ        = -1018
+  integer, parameter  :: WRF_WARN_ZERO_LENGTH_GET    = -1019
+  integer, parameter  :: WRF_WARN_ZERO_LENGTH_PUT    = -1020
+  integer, parameter  :: WRF_WARN_NETCDF             = -1021    
+  integer, parameter  :: WRF_WARN_LENGTH_LESS_THAN_1 = -1022    
+  integer, parameter  :: WRF_WARN_MORE_DATA_IN_FILE  = -1023    
+  integer, parameter  :: WRF_WARN_DATE_LT_LAST_DATE  = -1024
+
+! For HDF5 only
+  integer, parameter  :: WRF_HDF5_ERR_FILE                 = -200
+  integer, parameter  :: WRF_HDF5_ERR_MD                   = -201
+  integer, parameter  :: WRF_HDF5_ERR_TIME                 = -202
+  integer, parameter  :: WRF_HDF5_ERR_TIME_EOF             = -203
+  integer, parameter  :: WRF_HDF5_ERR_MORE_DATA_IN_FILE    = -204
+  integer, parameter  :: WRF_HDF5_ERR_DATE_LT_LAST_DATE    = -205
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_FILES       = -206
+  integer, parameter  :: WRF_HDF5_ERR_TYPE_MISMATCH        = -207
+  integer, parameter  :: WRF_HDF5_ERR_LENGTH_LESS_THAN_1   = -208
+  integer, parameter  :: WRF_HDF5_ERR_WRITE_RONLY_FILE     = -209
+  integer, parameter  :: WRF_HDF5_ERR_READ_WONLY_FILE      = -210
+  integer, parameter  :: WRF_HDF5_ERR_FILE_NOT_OPENED      = -211
+  integer, parameter  :: WRF_HDF5_ERR_DATESTR_ERROR        = -212
+  integer, parameter  :: WRF_HDF5_ERR_DRYRUN_READ          = -213
+  integer, parameter  :: WRF_HDF5_ERR_ZERO_LENGTH_GET      = -214
+  integer, parameter  :: WRF_HDF5_ERR_ZERO_LENGTH_PUT      = -215
+  integer, parameter  :: WRF_HDF5_ERR_2DRYRUNS_1VARIABLE   = -216
+  integer, parameter  :: WRF_HDF5_ERR_DATA_TYPE_NOTFOUND   = -217
+  integer, parameter  :: WRF_HDF5_ERR_READ_PAST_EOF        = -218
+  integer, parameter  :: WRF_HDF5_ERR_BAD_DATA_HANDLE      = -219
+  integer, parameter  :: WRF_HDF5_ERR_WRTLEN_NE_DRRUNLEN   = -220
+  integer, parameter  :: WRF_HDF5_ERR_DRYRUN_CLOSE         = -221
+  integer, parameter  :: WRF_HDF5_ERR_DATESTR_BAD_LENGTH   = -222
+  integer, parameter  :: WRF_HDF5_ERR_ZERO_LENGTH_READ     = -223
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_DIMS        = -224
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_VARIABLES   = -225
+  integer, parameter  :: WRF_HDF5_ERR_COUNT_TOO_LONG       = -226
+  integer, parameter  :: WRF_HDF5_ERR_DIMENSION_ERROR      = -227
+  integer, parameter  :: WRF_HDF5_ERR_BAD_MEMORYORDER      = -228
+  integer, parameter  :: WRF_HDF5_ERR_DIMNAME_REDEFINED    = -229
+  integer, parameter  :: WRF_HDF5_ERR_MD_AFTER_OPEN        = -230
+  integer, parameter  :: WRF_HDF5_ERR_CHARSTR_GT_LENDATA   = -231
+  integer, parameter  :: WRF_HDF5_ERR_BAD_DATA_TYPE        = -232
+  integer, parameter  :: WRF_HDF5_ERR_FILE_NOT_COMMITTED   = -233
+
+  integer, parameter  :: WRF_HDF5_ERR_ALLOCATION        = -2001
+  integer, parameter  :: WRF_HDF5_ERR_DEALLOCATION      = -2002
+  integer, parameter  :: WRF_HDF5_ERR_BAD_FILE_STATUS   = -2003
+  integer, parameter  :: WRF_HDF5_ERR_BAD_VARIABLE_DIM  = -2004
+  integer, parameter  :: WRF_HDF5_ERR_MDVAR_DIM_NOT_1D  = -2005
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_TIMES    = -2006
+  integer, parameter ::  WRF_HDF5_ERR_DATA_ID_NOTFOUND  = -2007
+
+  integer, parameter ::  WRF_HDF5_ERR_DATASPACE         = -300
+  integer, parameter ::  WRF_HDF5_ERR_DATATYPE          = -301
+  integer, parameter :: WRF_HDF5_ERR_PROPERTY_LIST      = -302
+
+  integer, parameter :: WRF_HDF5_ERR_DATASET_CREATE     = -303
+  integer, parameter :: WRF_HDF5_ERR_DATASET_READ       = -304
+  integer, parameter :: WRF_HDF5_ERR_DATASET_WRITE      = -305
+  integer, parameter :: WRF_HDF5_ERR_DATASET_OPEN       = -306
+  integer, parameter :: WRF_HDF5_ERR_DATASET_GENERAL    = -307
+  integer, parameter :: WRF_HDF5_ERR_GROUP              = -308
+
+  integer, parameter :: WRF_HDF5_ERR_FILE_OPEN          = -309
+  integer, parameter :: WRF_HDF5_ERR_FILE_CREATE        = -310
+  integer, parameter :: WRF_HDF5_ERR_DATASET_CLOSE      = -311
+  integer, parameter :: WRF_HDF5_ERR_FILE_CLOSE         = -312
+  integer, parameter :: WRF_HDF5_ERR_CLOSE_GENERAL      = -313
+
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CREATE   = -314
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_READ     = -315
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_WRITE    = -316
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OPEN     = -317
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_GENERAL  = -318
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CLOSE    = -319
+
+  integer, parameter :: WRF_HDF5_ERR_OTHERS             = -320
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS   = -321
+
+  integer, parameter :: WRF_GRIB2_ERR_GRIBCREATE        = -401
+  integer, parameter :: WRF_GRIB2_ERR_ADDLOCAL          = -402
+  integer, parameter :: WRF_GRIB2_ERR_ADDGRIB           = -403
+  integer, parameter :: WRF_GRIB2_ERR_ADDFIELD          = -404
+  integer, parameter :: WRF_GRIB2_ERR_GRIBEND           = -405
+  integer, parameter :: WRF_GRIB2_ERR_WRITE             = -406
+  integer, parameter :: WRF_GRIB2_ERR_GRIB2MAP          = -407
+  integer, parameter :: WRF_GRIB2_ERR_GETGB2            = -408
+  integer, parameter :: WRF_GRIB2_ERR_READ              = -409
Index: trunk/WRF.COMMON/WRFV2/external/io_int/diffwrf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_int/diffwrf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_int/diffwrf.F	(revision 2744)
@@ -0,0 +1,459 @@
+module read_util_module
+
+#ifdef crayx1
+#define iargc ipxfargc
+#endif
+
+contains
+
+#ifdef crayx1
+   subroutine getarg(i, harg)
+     implicit none
+     character(len=*) :: harg
+     integer :: ierr, ilen, i
+
+     call pxfgetarg(i, harg, ilen, ierr)
+     return
+   end subroutine getarg
+#endif
+
+   subroutine arguments(v2file, lmore)
+     implicit none
+     character(len=*) :: v2file
+     character(len=120) :: harg
+     logical :: lmore
+   
+     integer :: ierr, i, numarg
+     integer, external :: iargc
+   
+     numarg = iargc()
+   
+     i = 1
+     lmore = .false.
+   
+     do while ( i < numarg) 
+        call getarg(i, harg)
+        print*, 'harg = ', trim(harg)
+   
+        if (harg == "-v") then
+           i = i + 1
+           lmore = .true.
+        elseif (harg == "-h") then
+           call help
+        endif
+   
+     enddo
+   
+     call getarg(i,harg)
+     v2file = harg
+   end subroutine arguments
+   
+   subroutine help
+     implicit none
+     character(len=120) :: cmd
+     call getarg(0, cmd)
+   
+     write(*,'(/,"Usage: ", A, " [-v] v2file ")') trim(cmd)
+     write(*,'(8x, "-v     : Print extra info")')
+     write(*,'(8x, "v3file : MM5v3 file name to read.")')
+     write(*,'(8x, "-h     : print this help message and exit.",/)')
+     stop
+   end subroutine help
+end module read_util_module
+
+ program readv3
+  use read_util_module
+  use module_ext_internal
+  implicit none
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  character(len=120) :: flnm
+  character(len=120) :: flnm2
+  character(len=120) :: arg3
+  character(len=19) :: DateStr
+  character(len=19) :: DateStr2
+  character(len=31) :: VarName
+  character(len=31) :: VarName2
+  integer dh1, dh2
+
+  integer :: flag, flag2
+  integer :: iunit, iunit2
+  integer :: WrfType, WrfType2
+
+  integer :: i,j,k
+  integer :: levlim
+  integer :: cross
+  integer :: ndim, ndim2
+  real :: time, time2
+  real*8 :: a, b
+  real*8 :: sumE, sum1, sum2, diff1, diff2, serr, perr, rmse, rms1, rms2, tmp1, tmp2
+  integer digits,d1, d2
+  integer, dimension(4) :: start_index, end_index, start_index2, end_index2
+  integer , Dimension(3) :: MemS,MemE,PatS,PatE
+  character (len= 4) :: staggering,   staggering2
+  character (len= 3) :: ordering,     ordering2, ord
+  character (len=24) :: start_date,   start_date2
+  character (len=24) :: current_date, current_date2
+  character (len=31) :: name,         name2,  tmpname
+  character (len=25) :: units,        units2
+  character (len=46) :: description,  description2
+
+  character (len=80), dimension(3)  ::  dimnames
+
+  integer :: l, n
+  integer :: ikdiffs, ifdiffs
+
+  real, allocatable, dimension(:,:,:,:) :: data,data2
+
+  integer :: ierr, ierr2, ier, ier2, Status, Status_next_time, Status_next_time2, Status_next_var, Status_next_var_2
+
+  logical :: newtime = .TRUE.
+  logical :: justplot, efound
+
+  integer, external :: iargc
+  logical, external :: iveceq
+
+  levlim = -1
+
+  call ext_int_ioinit(' ', Status)
+
+  Justplot = .false.
+! get arguments
+  if ( iargc() .ge. 2 ) then
+    call getarg(1,flnm)
+    call getarg(2,flnm2)
+    ierr = 0
+    call ext_int_open_for_read( trim(flnm), 0, 0, "", dh1, Status)
+    if ( Status /= 0 ) then 
+      print*,'error opening ',flnm, ' Status = ', Status ; stop
+    endif
+    call ext_int_open_for_read( trim(flnm2), 0, 0, "", dh2, Status)
+    if ( Status /= 0 ) go to 923
+    goto 924
+923    continue
+
+! bounce here if second name is not openable -- this would mean that
+! it is a field name instead.
+
+    print*,'could not open ',flnm2
+    name = flnm2
+    Justplot = .true.
+924    continue
+  if ( iargc() .eq. 3 ) then
+    call getarg(3,arg3)
+    read(arg3,*)levlim
+    print*,'LEVLIM = ',LEVLIM
+  endif
+  else
+     print*,'Usage: command file1 file2'
+     stop
+  endif
+
+print*,'Just plot ',Justplot
+
+if ( Justplot ) then
+  print*, 'flnm = ', trim(flnm)
+
+   call ext_int_get_next_time(dh1, DateStr, Status_next_time)
+
+   DO WHILE ( Status_next_time .eq. 0 )
+    write(*,*)'Next Time ',TRIM(Datestr)
+    call ext_int_get_next_var (dh1, VarName, Status_next_var)
+    DO WHILE ( Status_next_var .eq. 0 )
+!    write(*,*)'Next Var |',TRIM(VarName),'|'
+
+      start_index = 1
+      end_index = 1
+      call ext_int_get_var_info (dh1,VarName,ndim,ordering,staggering,start_index,end_index, WrfType, ierr )
+      if(WrfType /= WRF_REAL .AND. WrfType /= WRF_DOUBLE) then
+        call ext_int_get_next_var (dh1, VarName, Status_next_var)
+        cycle
+      endif
+
+      write(*,'(A9,1x,I1,3(1x,I5),1x,A,1x,A)')&
+               VarName, ndim, end_index(1), end_index(2), end_index(3), &
+               trim(ordering), trim(DateStr)
+
+      if ( VarName .eq. name ) then
+        write(*,*)'Writing fort.88 file for ', trim(name)
+
+        allocate(data(end_index(1), end_index(2), end_index(3), 1))
+
+        if ( ndim .eq. 3 ) then
+          ord = 'XYZ'
+        else if ( ndim .eq. 2 ) then
+          ord = 'XY'
+        else if ( ndim .eq. 1 ) then
+          ord = 'Z'
+        else if ( ndim .eq. 0 ) then
+          ord = '0'
+        endif
+
+        call ext_int_read_field(dh1,DateStr,TRIM(name),data,WRF_REAL,0,0,0,ord,   &
+                            staggering,          &
+                            dimnames,         &
+                            start_index,end_index,                      & !dom              
+                            start_index,end_index,                      & !mem
+                            start_index,end_index,                      & !pat
+                            ierr)
+
+        if ( ierr/=0 ) then
+             write(*,*)'error reading data record'
+             write(*,*)'  ndim = ', ndim
+             write(*,*)'  end_index(1) ',end_index(1)
+             write(*,*)'  end_index(2) ',end_index(2)
+             write(*,*)'  end_index(3) ',end_index(3)
+        endif
+
+
+        IF ( ndim .eq. 3 ) THEN
+        do k = start_index(2), end_index(2)
+          if ( levlim .eq. -1 .or. k .eq. levlim ) then
+            write(88,*)end_index(1),end_index(3),' ',trim(name),' ',k,' time ',n
+            do j = 1, end_index(3)
+              do i = 1, end_index(1)
+                write(88,*) data(i,k,j,1)
+              enddo
+            enddo
+          endif
+        enddo
+        ELSE IF ( ndim .eq. 2 ) THEN
+            k = 1
+            write(88,*)end_index(1),end_index(2),' ',trim(name),' ',k,' time ',n
+            do j = 1, end_index(2)
+              do i = 1, end_index(1)
+                write(88,*) data(i,j,1,1)
+              enddo
+            enddo
+        ENDIF
+        deallocate(data)
+      endif
+      call ext_int_get_next_var (dh1, VarName, Status_next_var)
+    enddo
+    call ext_int_get_next_time(dh1, DateStr, Status_next_time)
+  enddo
+else
+  print*,'Diffing ',trim(flnm),' ',trim(flnm2)
+
+  call ext_int_get_next_time(dh1, DateStr, Status_next_time)
+  call ext_int_get_next_time(dh2, DateStr2, Status_next_time2)
+
+  IF ( DateStr .NE. DateStr2 ) THEN
+    print*,'They differ big time.  Dates do not match'
+    print*,'   ',flnm,' ',DateStr
+    print*,'   ',flnm2,' ',DateStr2
+    Status_next_time = 1
+  ENDIF
+
+  DO WHILE ( Status_next_time .eq. 0 .AND. Status_next_time2 .eq. 0 )
+!write(*,*)'Next Time ',TRIM(Datestr)
+    print 76
+    call ext_int_get_next_var (dh1, VarName, Status_next_var)
+    call ext_int_get_next_var (dh2, VarName, Status_next_var)
+    DO WHILE ( Status_next_var .eq. 0 )
+
+!write(*,*)'Next Var |',TRIM(VarName),'|'
+
+      start_index = 1
+      end_index = 1
+      call ext_int_get_var_info (dh1,VarName,ndim,ordering,staggering,start_index,end_index, WrfType, ierr )
+      call ext_int_get_var_info (dh2,VarName,ndim2,ordering2,staggering2,start_index2,end_index2, WrfType2, ierr2 )
+
+!write(*,*)'ierr , err2 ',TRIM(VarName), ierr , ierr2, ' ',ordering, ' ', ordering2
+
+      IF ( ierr /= 0 ) THEN
+        write(*,*)'Big difference: ',VarName,' not found in ',flnm2
+        GOTO 1234
+      ENDIF
+      IF ( ndim /= ndim2 ) THEN
+        write(*,*)'Big difference: Number of dimensions for ',Varname,' differs in ',flnm2,'(',ndim,') /= (',ndim2
+        GOTO 1234
+      ENDIF
+
+      IF ( WrfType /= WrfType2 ) THEN
+        write(*,*)'Big difference: The types do not match', WrfType, WrfType2
+        GOTO 1234
+      ENDIF
+
+      if( WrfType == WRF_REAL) then
+
+        DO i = 1, ndim
+          IF ( end_index(i) /= end_index2(i) ) THEN
+            write(*,*)'Big difference: dim ',i,' lengths differ for ',Varname,' differ in ',flnm2
+            GOTO 1234
+          ENDIF
+        ENDDO
+
+        DO i = ndim+1,3
+          start_index(i) = 1
+          end_index(i) = 1
+          start_index2(i) = 1
+          end_index2(i) = 1
+        ENDDO
+
+!      write(*,'(A9,1x,I1,3(1x,I3),1x,A,1x,A)')&
+!               VarName, ndim, end_index(1), end_index(2), end_index(3), &
+!               trim(ordering), trim(DateStr)
+
+        allocate(data (end_index(1), end_index(2), end_index(3), 1))
+        allocate(data2(end_index(1), end_index(2), end_index(3), 1))
+
+        if ( ndim .eq. 3 ) then
+          ord = 'XYZ'
+        else if ( ndim .eq. 2 ) then
+          ord = 'XY'
+        else if ( ndim .eq. 1 ) then
+          ord = 'Z'
+        else if ( ndim .eq. 0 ) then
+          ord = '0'
+        endif
+
+        call ext_int_read_field(dh1,DateStr,TRIM(VarName),data,WRF_REAL,0,0,0,ord,   &
+                            staggering,          &
+                            dimnames,         &
+                            start_index,end_index,                      & !dom              
+                            start_index,end_index,                      & !mem
+                            start_index,end_index,                      & !pat
+                            ierr)
+
+        IF ( ierr /= 0 ) THEN
+          write(*,*)'Error reading ',Varname,' from ',flnm
+          write(*,*)'  ndim = ', ndim
+          write(*,*)'  end_index(1) ',end_index(1)
+          write(*,*)'  end_index(2) ',end_index(2)
+          write(*,*)'  end_index(3) ',end_index(3)
+        ENDIF
+
+        call ext_int_read_field(dh2,DateStr,TRIM(VarName),data2,WRF_REAL,0,0,0,ord,   &
+                            staggering,          &
+                            dimnames,         &
+                            start_index,end_index,                      & !dom              
+                            start_index,end_index,                      & !mem
+                            start_index,end_index,                      & !pat
+                            ierr)
+
+        IF ( ierr /= 0 ) THEN
+          write(*,*)'Error reading ',Varname,' from ',flnm2
+          write(*,*)'  ndim = ', ndim
+          write(*,*)'  end_index(1) ',end_index(1)
+          write(*,*)'  end_index(2) ',end_index(2)
+          write(*,*)'  end_index(3) ',end_index(3)
+        ENDIF
+
+        IFDIFFS=0
+        sumE = 0.0
+        sum1 = 0.0
+        sum2 = 0.0
+        diff1 = 0.0
+        diff2 = 0.0
+        n = 0
+        DO K = 1,end_index(3)-start_index(3)+1
+         IF (LEVLIM.EQ.-1.OR.K.EQ.LEVLIM.OR.NDIM.eq.2) THEN
+          cross = 0 
+          IKDIFFS = 0
+          do i = 1, end_index(1)-cross
+            do j = 1, end_index(2)-cross
+              a = data(I,J,K,1)
+              b = data2(I,J,K,1)
+              ! borrowed from  Thomas Oppe's comp program
+              sumE = sumE + ( a - b ) * ( a - b )
+              sum1 = sum1 + a * a
+              sum2 = sum2 + b * b
+              diff1 = max ( diff1 , abs ( a - b ) )
+              diff2 = max ( diff2 , abs ( b ) )
+              n = n + 1
+              IF (a .ne. b) then
+                IKDIFFS = IKDIFFS + 1
+                IFDIFFS = IFDIFFS + 1
+              ENDIF
+            ENDDO
+          ENDDO
+         ENDIF
+        enddo
+        rmsE = sqrt ( sumE / dble( n ) )
+        rms1 = sqrt ( sum1 / dble( n ) )
+        rms2 = sqrt ( sum2 / dble( n ) )
+        serr = 0.0
+        IF ( sum2 .GT. 0.0d0 ) THEN
+          serr = sqrt ( sumE / sum2 )
+        ELSE
+          IF ( sumE .GT. 0.0d0 ) serr = 1.0
+        ENDIF
+        perr = 0.0
+        IF ( diff2 .GT. 0.0d0 ) THEN
+          perr = diff1/diff2
+        ELSE
+          IF ( diff1 .GT. 0.0d0 ) perr = 1.0
+        ENDIF
+
+        digits = 0
+        IF ( rms1 - rms2 .EQ. 0.0d0 ) THEN
+          digits = 15
+        ENDIF
+        IF ( rms2 .NE. 0 ) THEN
+          tmp1 = 1.0d0/( ( abs( rms1 - rms2 ) ) / rms2 )
+          IF ( tmp1 .NE. 0 ) THEN
+            digits = log10(tmp1)
+          ENDIF
+        ENDIF
+
+        IF (IFDIFFS .NE. 0 ) THEN
+           ! create the fort.88 and fort.98 files because regression scripts will
+           ! look for these to see if there were differences.
+           write(88,*)trim(varname)
+           write(98,*)trim(varname)
+           PRINT 77,trim(varname), IFDIFFS, ndim, rms1, rms2, digits, rmsE, perr
+ 76 FORMAT (5x,'Field ',2x,'Ndifs',4x,'Dims ',6x,'RMS (1)',12x,'RMS (2)',5x,'DIGITS',4x,'RMSE',5x,'pntwise max')
+ 77 FORMAT ( A10,1x,I9,2x,I3,1x,e18.10,1x,e18.10,1x,i3,1x,e12.4,1x,e12.4 )
+        ENDIF
+        deallocate(data)
+        deallocate(data2)
+
+      endif
+1234  CONTINUE
+      call ext_int_get_next_var (dh1, VarName, Status_next_var)
+      call ext_int_get_next_var (dh2, VarName, Status_next_var)
+    enddo
+    call ext_int_get_next_time(dh1, DateStr, Status_next_time)
+    call ext_int_get_next_time(dh2, DateStr2, Status_next_time2)
+    IF ( DateStr .NE. DateStr2 ) THEN
+      print*,'They differ big time.  Dates do not match'
+      print*,'They differ big time.  Dates do not match'
+      print*,'   ',flnm,' ',DateStr
+      print*,'   ',flnm2,' ',DateStr2
+      Status_next_time = 1
+    ENDIF
+  enddo
+
+endif
+
+end program readv3
+
+logical function iveceq( a, b, n )
+  implicit none
+  integer n
+  integer a(n), b(n)
+  integer i
+  iveceq = .true.
+  do i = 1,n
+    if ( a(i) .ne. b(i) ) iveceq = .false.
+  enddo
+  return
+end function iveceq
+
+
+! stubs for routines called by module_wrf_error (used by this implementation of IO api)
+SUBROUTINE wrf_abort
+  STOP
+END SUBROUTINE wrf_abort
+
+SUBROUTINE get_current_time_string( time_str )
+  CHARACTER(LEN=*), INTENT(OUT) :: time_str
+  time_str = ''
+END SUBROUTINE get_current_time_string
+
+SUBROUTINE get_current_grid_name( grid_str )
+  CHARACTER(LEN=*), INTENT(OUT) :: grid_str
+  grid_str = ''
+END SUBROUTINE get_current_grid_name
+
Index: trunk/WRF.COMMON/WRFV2/external/io_int/io_int.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_int/io_int.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_int/io_int.F90	(revision 2744)
@@ -0,0 +1,1641 @@
+! (old comment from when this file was a template)
+! This is a template for adding a package-dependent implemetnation of
+! the I/O API.  You can use the name xxx since that is already set up
+! as a placeholder in module_io.F, md_calls.m4, and the Registry, or
+! you can change the name here and in those other places.  For additional
+! information on adding a package to WRF, see the latest version of the
+! WRF Design and Implementation Document 1.1 (Draft). June 21, 2001
+!
+! Uses header manipulation routines in module_io_quilt.F
+!
+
+MODULE module_ext_internal
+
+  USE module_internal_header_util
+
+  INTEGER, PARAMETER :: int_num_handles = 99
+  LOGICAL, DIMENSION(int_num_handles) :: okay_for_io, int_handle_in_use, okay_to_commit
+  INTEGER, DIMENSION(int_num_handles) :: int_num_bytes_to_write
+! first_operation is set to .TRUE. when a new handle is allocated 
+! or when open-for-write or open-for-read are committed.  It is set 
+! to .FALSE. when the first field is read or written.  
+  LOGICAL, DIMENSION(int_num_handles) :: first_operation
+! TBH:  file_status is checked by routines that call the WRF IOAPI.  It is not 
+! TBH:  yet cleanly integrated with okay_for_io, int_handle_in_use, 
+! TBH:  okay_to_commit.  Fix this later...  
+  INTEGER, DIMENSION(int_num_handles) :: file_status
+! TBH:  This flag goes along with file_status and is set as early as possible.  
+  LOGICAL, DIMENSION(int_num_handles) :: file_read_only
+  CHARACTER*128, DIMENSION(int_num_handles) :: CurrentDateInFile
+  REAL, POINTER    :: int_local_output_buffer(:)
+  INTEGER          :: int_local_output_cursor
+
+  INTEGER, PARAMETER           :: onebyte = 1
+  INTEGER comm_io_servers, iserver, hdrbufsize, obufsize
+  INTEGER itypesize, rtypesize, typesize
+  INTEGER, DIMENSION(512)     :: hdrbuf
+  INTEGER, DIMENSION(int_num_handles)       :: handle
+  INTEGER, DIMENSION(512, int_num_handles)  :: open_file_descriptors
+
+  CHARACTER*132 last_next_var( int_num_handles )
+
+  CONTAINS
+
+    LOGICAL FUNCTION int_valid_handle( handle )
+      IMPLICIT NONE
+      INTEGER, INTENT(IN) ::  handle
+      int_valid_handle = ( handle .ge. 8 .and. handle .le. int_num_handles ) 
+    END FUNCTION int_valid_handle
+
+    SUBROUTINE int_get_fresh_handle( retval )
+#include "wrf_io_flags.h"
+      INTEGER i, retval
+      retval = -1
+! dont use first 8 handles
+      DO i = 8, int_num_handles
+        IF ( .NOT. int_handle_in_use(i) )  THEN
+          retval = i
+          GOTO 33
+        ENDIF
+      ENDDO
+33    CONTINUE
+      IF ( retval < 0 )  THEN
+        CALL wrf_error_fatal("io_int.F90: int_get_fresh_handle() can not get new handle")
+      ENDIF
+      int_handle_in_use(i) = .TRUE.
+      first_operation(i) = .TRUE.
+      file_status(i) = WRF_FILE_NOT_OPENED
+      NULLIFY ( int_local_output_buffer )
+    END SUBROUTINE int_get_fresh_handle
+
+    SUBROUTINE release_handle( i )
+#include "wrf_io_flags.h"
+      INTEGER, INTENT(IN) :: i
+      IF ( i .LT. 8 .OR. i .GT. int_num_handles ) RETURN
+      IF ( .NOT. int_handle_in_use(i) ) RETURN
+      int_handle_in_use(i) = .FALSE.
+      RETURN
+    END SUBROUTINE release_handle
+
+      
+
+    !--- ioinit
+    SUBROUTINE init_module_ext_internal
+      IMPLICIT NONE
+      INTEGER i
+      CALL wrf_sizeof_integer( itypesize )
+      CALL wrf_sizeof_real   ( rtypesize )
+      DO i = 1, int_num_handles
+         last_next_var( i ) = ' '
+      ENDDO
+    END SUBROUTINE init_module_ext_internal
+
+! Returns .TRUE. iff it is OK to write time-independent domain metadata to the 
+! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is 
+! returned.  
+LOGICAL FUNCTION int_ok_to_put_dom_ti( DataHandle )
+#include "wrf_io_flags.h"
+    INTEGER, INTENT(IN) :: DataHandle 
+    CHARACTER*256 :: fname
+    INTEGER :: filestate
+    INTEGER :: Status
+    LOGICAL :: dryrun, first_output, retval
+    call ext_int_inquire_filename( DataHandle, fname, filestate, Status )
+    IF ( Status /= 0 ) THEN
+      retval = .FALSE.
+    ELSE
+      dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+      first_output = int_is_first_operation( DataHandle )
+      ! Note that we want to REPLICATE time-independent domain metadata in the 
+      ! output files so the metadata is available during reads.  Fortran 
+      ! unformatted I/O must be sequential because we don't have fixed record 
+      ! lengths.  
+      ! retval = .NOT. dryrun .AND. first_output
+      retval = .NOT. dryrun
+    ENDIF
+    int_ok_to_put_dom_ti = retval
+    RETURN
+END FUNCTION int_ok_to_put_dom_ti
+
+! Returns .TRUE. iff it is OK to read time-independent domain metadata from the 
+! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is 
+! returned.  
+LOGICAL FUNCTION int_ok_to_get_dom_ti( DataHandle )
+#include "wrf_io_flags.h"
+    INTEGER, INTENT(IN) :: DataHandle 
+    CHARACTER*256 :: fname
+    INTEGER :: filestate
+    INTEGER :: Status
+    LOGICAL :: dryrun, retval
+    call ext_int_inquire_filename( DataHandle, fname, filestate, Status )
+    IF ( Status /= 0 ) THEN
+      retval = .FALSE.
+    ELSE
+      dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+      retval = .NOT. dryrun
+    ENDIF
+    int_ok_to_get_dom_ti = retval
+    RETURN
+END FUNCTION int_ok_to_get_dom_ti
+
+! Returns .TRUE. iff nothing has been read from or written to the file 
+! referenced by DataHandle.  If DataHandle is invalid, .FALSE. is returned.  
+LOGICAL FUNCTION int_is_first_operation( DataHandle )
+    INTEGER, INTENT(IN) :: DataHandle 
+    LOGICAL :: retval
+    retval = .FALSE.
+    IF ( int_valid_handle ( DataHandle ) ) THEN
+      IF ( int_handle_in_use( DataHandle ) ) THEN
+        retval = first_operation( DataHandle )
+      ENDIF
+    ENDIF
+    int_is_first_operation = retval
+    RETURN
+END FUNCTION int_is_first_operation
+
+END MODULE module_ext_internal
+
+SUBROUTINE ext_int_ioinit( SysDepInfo, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  CHARACTER*(*), INTENT(IN) :: SysDepInfo
+  INTEGER Status
+  CALL init_module_ext_internal
+END SUBROUTINE ext_int_ioinit
+
+!--- open_for_write
+SUBROUTINE ext_int_open_for_write( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                   DataHandle , Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  CALL ext_int_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                     DataHandle , Status )
+  IF ( Status .NE. 0 ) RETURN
+  CALL ext_int_open_for_write_commit( DataHandle , Status )
+  RETURN
+END SUBROUTINE ext_int_open_for_write
+
+!--- open_for_write_begin
+SUBROUTINE ext_int_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                         DataHandle , Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+#include "wrf_io_flags.h"
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i, tasks_in_group, ierr, comm_io_group
+  LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+  REAL dummy
+  INTEGER io_form
+  CHARACTER*256 :: fname
+
+  CALL int_get_fresh_handle(i)
+  okay_for_io(i) = .false.
+  DataHandle = i
+
+  io_form = 100 ! dummy value
+  fname = TRIM(FileName)
+  CALL int_gen_ofwb_header( open_file_descriptors(1,i), hdrbufsize, itypesize, &
+                            fname,SysDepInfo,io_form,DataHandle )
+
+  OPEN ( unit=DataHandle, file=TRIM(FileName), form='unformatted', iostat=Status )
+
+  file_status(DataHandle) = WRF_FILE_OPENED_NOT_COMMITTED
+  file_read_only(DataHandle) = .FALSE.
+
+  Status = 0
+  RETURN  
+END SUBROUTINE ext_int_open_for_write_begin
+
+!--- open_for_write_commit
+SUBROUTINE ext_int_open_for_write_commit( DataHandle , Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+
+  IF ( int_valid_handle ( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      okay_for_io( DataHandle ) = .true.
+    ENDIF
+  ENDIF
+
+  first_operation( DataHandle ) = .TRUE.
+  file_status(DataHandle) = WRF_FILE_OPENED_FOR_WRITE
+
+  Status = 0
+
+  RETURN  
+END SUBROUTINE ext_int_open_for_write_commit
+
+!--- open_for_read 
+SUBROUTINE ext_int_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                               DataHandle , Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i
+  CHARACTER*256 :: fname
+
+  CALL int_get_fresh_handle(i)
+  DataHandle = i
+  CurrentDateInFile(i) = ""
+  fname = TRIM(FileName)
+
+  CALL int_gen_ofr_header( open_file_descriptors(1,i), hdrbufsize, itypesize, &
+                            fname,SysDepInfo,DataHandle )
+
+  OPEN ( unit=DataHandle, status="old", file=TRIM(FileName), form='unformatted', iostat=Status )
+  okay_for_io(DataHandle) = .true.
+  file_status(DataHandle) = WRF_FILE_OPENED_FOR_READ
+  file_read_only(DataHandle) = .TRUE.
+
+  RETURN  
+END SUBROUTINE ext_int_open_for_read
+
+!--- inquire_opened
+SUBROUTINE ext_int_inquire_opened ( DataHandle, FileName , FileStatus, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER*256 :: fname
+
+  Status = 0
+
+  CALL ext_int_inquire_filename ( DataHandle, fname, FileStatus, Status )
+  IF ( fname /= TRIM(FileName) ) THEN
+    FileStatus = WRF_FILE_NOT_OPENED
+  ENDIF
+
+  Status = 0
+  
+  RETURN
+END SUBROUTINE ext_int_inquire_opened
+
+!--- inquire_filename
+SUBROUTINE ext_int_inquire_filename ( DataHandle, FileName , FileStatus, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER *4096   SysDepInfo
+  INTEGER locDataHandle
+  CHARACTER*256 :: fname
+  INTEGER io_form
+  Status = 0
+  SysDepInfo = ""
+  FileStatus = WRF_FILE_NOT_OPENED
+  FileName = ""
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      ! Note that the formats for these headers differ.  
+      IF ( file_read_only(DataHandle) ) THEN
+        CALL int_get_ofr_header( open_file_descriptors(1,DataHandle), hdrbufsize, itypesize, &
+                                 fname,SysDepInfo,locDataHandle )
+      ELSE
+        CALL int_get_ofwb_header( open_file_descriptors(1,DataHandle), hdrbufsize, itypesize, &
+                                  fname,SysDepInfo,io_form,locDataHandle )
+      ENDIF
+      FileName = TRIM(fname)
+      FileStatus = file_status(DataHandle)
+    ENDIF
+  ENDIF
+  Status = 0
+END SUBROUTINE ext_int_inquire_filename
+
+!--- sync
+SUBROUTINE ext_int_iosync ( DataHandle, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  Status = 0
+  RETURN
+END SUBROUTINE ext_int_iosync
+
+!--- close
+SUBROUTINE ext_int_ioclose ( DataHandle, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INTEGER DataHandle, Status
+
+  IF ( int_valid_handle (DataHandle) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      CLOSE ( DataHandle ) 
+    ENDIF
+    CALL release_handle(DataHandle)
+  ENDIF
+
+  Status = 0
+
+  RETURN
+END SUBROUTINE ext_int_ioclose
+
+!--- ioexit
+SUBROUTINE ext_int_ioexit( Status )
+
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER                     :: DataHandle
+  INTEGER i,ierr
+  REAL dummy
+
+  RETURN  
+END SUBROUTINE ext_int_ioexit
+
+!--- get_next_time
+SUBROUTINE ext_int_get_next_time ( DataHandle, DateStr, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER         code
+  CHARACTER*132   locElement, dummyvar
+  INTEGER istat
+
+!local
+  INTEGER                        :: locDataHandle
+  CHARACTER*132                  :: locDateStr
+  CHARACTER*132                  :: locData
+  CHARACTER*132                  :: locVarName
+  integer                        :: locFieldType
+  integer                        :: locComm
+  integer                        :: locIOComm
+  integer                        :: locDomainDesc
+  character*132                  :: locMemoryOrder
+  character*132                  :: locStagger
+  character*132 , dimension (3)  :: locDimNames
+  integer ,dimension(3)          :: locDomainStart, locDomainEnd
+  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
+  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
+  integer loccode
+
+  character*132 mess
+  integer ii,jj,kk,myrank
+  INTEGER inttypesize, realtypesize
+  REAL, DIMENSION(1)    :: Field  ! dummy
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_get_next_time: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_get_next_time: DataHandle not opened" )
+  ENDIF
+  inttypesize = itypesize
+  realtypesize = rtypesize
+  DO WHILE ( .TRUE. )
+    READ( unit=DataHandle, iostat=istat ) hdrbuf   ! this is okay as long as no other record type has data that follows
+    IF ( istat .EQ. 0 ) THEN
+      code = hdrbuf(2)
+      IF ( code .EQ. int_field ) THEN
+        CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
+                                 locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm,  &
+                                 locDomainDesc , locMemoryOrder , locStagger , locDimNames ,              &
+                                 locDomainStart , locDomainEnd ,                                    &
+                                 locMemoryStart , locMemoryEnd ,                                    &
+                                 locPatchStart , locPatchEnd )
+        IF ( TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle) ) ) THEN  ! control break, return this date
+          DateStr = TRIM(locDateStr)
+          CurrentDateInFile(DataHandle) = TRIM(DateStr)
+          BACKSPACE ( unit=DataHandle )
+          Status = 0
+          GOTO 7717
+        ELSE
+          READ( unit=DataHandle, iostat=istat )
+        ENDIF
+      ELSE IF ( code .EQ. int_dom_td_char ) THEN
+        CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, &
+                              locDataHandle, locDateStr, locElement, locData, loccode )
+        IF ( TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle) ) ) THEN  ! control break, return this date
+          DateStr = TRIM(locDateStr)
+          CurrentDateInFile(DataHandle) = TRIM(DateStr)
+          BACKSPACE ( unit=DataHandle )
+          Status = 0
+          GOTO 7717
+        ELSE
+          READ( unit=DataHandle, iostat=istat )
+        ENDIF
+      ENDIF
+    ELSE
+      Status = 1
+      GOTO 7717
+    ENDIF
+  ENDDO
+7717 CONTINUE
+
+  RETURN
+END SUBROUTINE ext_int_get_next_time
+
+!--- set_time
+SUBROUTINE ext_int_set_time ( DataHandle, DateStr, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+
+  CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize,        &
+                               DataHandle, "TIMESTAMP", "", TRIM(DateStr), int_set_time )
+  WRITE( unit=DataHandle ) hdrbuf
+  Status = 0
+  RETURN
+END SUBROUTINE ext_int_set_time
+
+!--- get_var_info
+SUBROUTINE ext_int_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
+                              DomainStart , DomainEnd , WrfType, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: VarName
+  integer               ,intent(out)    :: NDim
+  character*(*)         ,intent(out)    :: MemoryOrder
+  character*(*)         ,intent(out)    :: Stagger
+  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
+  integer               ,intent(out)    :: WrfType
+  integer               ,intent(out)    :: Status
+
+!local
+  INTEGER                        :: locDataHandle
+  CHARACTER*132                  :: locDateStr
+  CHARACTER*132                  :: locVarName
+  integer                        :: locFieldType
+  integer                        :: locComm
+  integer                        :: locIOComm
+  integer                        :: locDomainDesc
+  character*132                  :: locMemoryOrder
+  character*132                  :: locStagger
+  character*132 , dimension (3)  :: locDimNames
+  integer ,dimension(3)          :: locDomainStart, locDomainEnd
+  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
+  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
+
+  character*132 mess
+  integer ii,jj,kk,myrank
+  INTEGER inttypesize, realtypesize, istat, code
+  REAL, DIMENSION(1)    :: Field   ! dummy
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_get_var_info: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_get_var_info: DataHandle not opened" )
+  ENDIF
+  inttypesize = itypesize
+  realtypesize = rtypesize
+  DO WHILE ( .TRUE. )
+    READ( unit=DataHandle, iostat=istat ) hdrbuf   ! this is okay as long as no other record type has data that follows
+    IF ( istat .EQ. 0 ) THEN
+      code = hdrbuf(2)
+      IF ( code .EQ. int_field ) THEN
+        CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
+                                 locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm,  &
+                                 locDomainDesc , MemoryOrder , locStagger , locDimNames ,              &
+                                 locDomainStart , locDomainEnd ,                                    &
+                                 locMemoryStart , locMemoryEnd ,                                    &
+                                 locPatchStart , locPatchEnd )
+        
+        IF ( LEN(TRIM(MemoryOrder)) .EQ. 3 ) THEN
+          NDim = 3
+        ELSE IF ( LEN(TRIM(MemoryOrder)) .EQ. 2 ) THEN
+          NDim = 2
+        ELSE IF ( TRIM(MemoryOrder) .EQ. '0' ) THEN
+          NDim = 0
+        ELSE 
+          NDim = 1
+        ENDIF
+        Stagger = locStagger
+        DomainStart(1:3) = locDomainStart(1:3)
+        DomainEnd(1:3) = locDomainEnd(1:3)
+        WrfType = locFieldType
+        BACKSPACE ( unit=DataHandle )
+        Status = 0
+        GOTO 7717
+      ENDIF
+    ELSE
+      Status = 1
+      GOTO 7717
+    ENDIF
+  ENDDO
+7717 CONTINUE
+
+RETURN
+END SUBROUTINE ext_int_get_var_info
+
+!--- get_next_var
+SUBROUTINE ext_int_get_next_var ( DataHandle, VarName, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  include 'intio_tags.h'
+  include 'wrf_status_codes.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: VarName
+  INTEGER ,       INTENT(OUT) :: Status
+
+!local
+  INTEGER                        :: locDataHandle
+  CHARACTER*132                  :: locDateStr
+  CHARACTER*132                  :: locVarName
+  integer                        :: locFieldType
+  integer                        :: locComm
+  integer                        :: locIOComm
+  integer                        :: locDomainDesc
+  character*132                  :: locMemoryOrder
+  character*132                  :: locStagger
+  character*132 , dimension (3)  :: locDimNames
+  integer ,dimension(3)          :: locDomainStart, locDomainEnd
+  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
+  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
+
+character*128 locElement, strData, dumstr
+integer loccode, loccount
+integer idata(128)
+real    rdata(128)
+
+  character*132 mess
+  integer ii,jj,kk,myrank
+  INTEGER inttypesize, realtypesize, istat, code
+  REAL, DIMENSION(1)    :: Field  ! dummy
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_get_next_var: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_get_next_var: DataHandle not opened" )
+  ENDIF
+  inttypesize = itypesize
+  realtypesize = rtypesize
+  DO WHILE ( .TRUE. )
+7727 CONTINUE
+    READ( unit=DataHandle, iostat=istat ) hdrbuf   ! this is okay as long as no other record type has data that follows
+    IF ( istat .EQ. 0 ) THEN
+      code = hdrbuf(2)
+#if 1
+      IF ( code .EQ. int_dom_ti_char ) THEN
+        CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                                         locDataHandle, locElement, dumstr, strData, loccode )
+      ENDIF
+      IF ( code .EQ. int_dom_ti_integer ) THEN
+        CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
+                                locDataHandle, locElement, iData, loccount, code )
+      ENDIF
+      IF ( code .EQ. int_dom_ti_real ) THEN
+        CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
+                                locDataHandle, locElement, rData, loccount, code )
+      ENDIF
+#endif
+      IF ( code .EQ. int_field ) THEN
+        CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
+                                 locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm,  &
+                                 locDomainDesc , locMemoryOrder , locStagger , locDimNames ,              &
+                                 locDomainStart , locDomainEnd ,                                    &
+                                 locMemoryStart , locMemoryEnd ,                                    &
+                                 locPatchStart , locPatchEnd )
+
+        IF (TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle))) THEN
+          Status = WRF_WARN_VAR_EOF !-6 ! signal past last var in time frame
+          BACKSPACE ( unit=DataHandle )
+          last_next_var( DataHandle )  = ""
+          GOTO 7717
+        ELSE
+          VarName = TRIM(locVarName)
+          IF ( last_next_var( DataHandle )  .NE. VarName ) THEN
+            BACKSPACE ( unit=DataHandle )
+            last_next_var( DataHandle )  = VarName
+          ELSE
+            READ( unit=DataHandle, iostat=istat )
+            GOTO 7727
+          ENDIF
+          Status = 0
+          GOTO 7717
+        ENDIF
+      ELSE
+        GOTO 7727
+      ENDIF
+    ELSE
+      Status = 1
+      GOTO 7717
+    ENDIF
+  ENDDO
+7717 CONTINUE
+  RETURN
+END SUBROUTINE ext_int_get_next_var
+
+!--- get_dom_ti_real
+SUBROUTINE ext_int_get_dom_ti_real ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  REAL ,          INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Outcount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER loccount, code, istat, locDataHandle
+  CHARACTER*132                :: locElement, mess
+  LOGICAL keepgoing
+
+  Status = 0
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+     ! Do nothing unless it is time to read time-independent domain metadata.
+     IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
+      keepgoing = .true.
+      DO WHILE ( keepgoing ) 
+        READ( unit=DataHandle , iostat = istat ) hdrbuf
+        IF ( istat .EQ. 0 ) THEN
+          code = hdrbuf(2)
+          IF ( code .EQ. int_dom_ti_real ) THEN
+            CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
+                                    locDataHandle, locElement, Data, loccount, code )
+            IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
+              IF ( loccount .GT. Count ) THEN
+                CALL wrf_error_fatal( 'io_int.F90: ext_int_get_dom_ti_real: loccount .GT. Count' )
+              ENDIF
+              keepgoing = .false. ;  Status = 0
+            ENDIF
+          ELSE IF ( .NOT. ( code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_logical .OR. &
+                            code .EQ. int_dom_ti_char    .OR. code .EQ. int_dom_ti_double  .OR. &
+                            code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_logical .OR. &
+                            code .EQ. int_dom_td_char    .OR. code .EQ. int_dom_td_double  .OR. &
+                            code .EQ. int_dom_td_real                                  ) ) THEN
+            BACKSPACE ( unit=DataHandle )
+            keepgoing = .false. ; Status = 2
+          ENDIF
+        ELSE
+          keepgoing = .false. ; Status = 1
+        ENDIF
+      ENDDO
+     ENDIF
+    ENDIF
+  ENDIF
+RETURN
+END SUBROUTINE ext_int_get_dom_ti_real 
+
+!--- put_dom_ti_real
+SUBROUTINE ext_int_put_dom_ti_real ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  REAL ,          INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+!
+
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      ! Do nothing unless it is time to write time-independent domain metadata.
+      IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
+        CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
+                                DataHandle, Element, Data, Count, int_dom_ti_real )
+        WRITE( unit=DataHandle ) hdrbuf
+      ENDIF
+    ENDIF
+  ENDIF
+  Status = 0
+RETURN
+END SUBROUTINE ext_int_put_dom_ti_real 
+
+!--- get_dom_ti_double
+SUBROUTINE ext_int_get_dom_ti_double ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  ! Do nothing unless it is time to read time-independent domain metadata.
+  IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
+    CALL wrf_error_fatal('ext_int_get_dom_ti_double not supported yet')
+  ENDIF
+RETURN
+END SUBROUTINE ext_int_get_dom_ti_double 
+
+!--- put_dom_ti_double
+SUBROUTINE ext_int_put_dom_ti_double ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  ! Do nothing unless it is time to write time-independent domain metadata.
+  IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
+    CALL wrf_error_fatal('ext_int_put_dom_ti_double not supported yet')
+  ENDIF
+RETURN
+END SUBROUTINE ext_int_put_dom_ti_double 
+
+!--- get_dom_ti_integer
+SUBROUTINE ext_int_get_dom_ti_integer ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER loccount, code, istat, locDataHandle
+  CHARACTER*132   locElement, mess
+  LOGICAL keepgoing
+
+  Status = 0
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+     ! Do nothing unless it is time to read time-independent domain metadata.
+     IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
+      keepgoing = .true.
+      DO WHILE ( keepgoing )
+        READ( unit=DataHandle , iostat = istat ) hdrbuf
+        IF ( istat .EQ. 0 ) THEN
+          code = hdrbuf(2)
+          IF ( code .EQ. int_dom_ti_integer ) THEN
+            CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
+                                    locDataHandle, locElement, Data, loccount, code )
+            IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
+              IF ( loccount .GT. Count ) THEN
+                CALL wrf_error_fatal( 'io_int.F90: ext_int_get_dom_ti_integer: loccount .GT. Count' )
+              ENDIF
+              keepgoing = .false. ;  Status = 0
+            ENDIF
+
+          ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real    .OR.   code .EQ. int_dom_ti_logical .OR. &
+                            code .EQ. int_dom_ti_char    .OR.   code .EQ. int_dom_ti_double  .OR. &
+                            code .EQ. int_dom_td_real    .OR.   code .EQ. int_dom_td_logical .OR. &
+                            code .EQ. int_dom_td_char    .OR.   code .EQ. int_dom_td_double  .OR. &
+                            code .EQ. int_dom_td_integer )                                           ) THEN
+            BACKSPACE ( unit=DataHandle )
+            keepgoing = .false. ; Status = 1
+          ENDIF
+        ELSE
+          keepgoing = .false. ; Status = 1
+        ENDIF
+      ENDDO
+     ENDIF
+    ENDIF
+  ENDIF
+RETURN
+END SUBROUTINE ext_int_get_dom_ti_integer 
+
+!--- put_dom_ti_integer
+SUBROUTINE ext_int_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  INTEGER ,       INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+!
+  IF ( int_valid_handle ( Datahandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      ! Do nothing unless it is time to write time-independent domain metadata.
+      IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
+        CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, itypesize, &
+                                DataHandle, Element, Data, Count, int_dom_ti_integer )
+        WRITE( unit=DataHandle ) hdrbuf 
+      ENDIF
+    ENDIF
+  ENDIF
+  Status = 0
+RETURN
+END SUBROUTINE ext_int_put_dom_ti_integer 
+
+!--- get_dom_ti_logical
+SUBROUTINE ext_int_get_dom_ti_logical ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  ! Do nothing unless it is time to read time-independent domain metadata.
+  IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
+    CALL wrf_message('ext_int_get_dom_ti_logical not supported yet')
+  ENDIF
+RETURN
+END SUBROUTINE ext_int_get_dom_ti_logical 
+
+!--- put_dom_ti_logical
+SUBROUTINE ext_int_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  ! Do nothing unless it is time to write time-independent domain metadata.
+  IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
+    CALL wrf_message('ext_int_put_dom_ti_logical not supported yet')
+  ENDIF
+RETURN
+END SUBROUTINE ext_int_put_dom_ti_logical 
+
+!--- get_dom_ti_char
+SUBROUTINE ext_int_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER istat, code, i
+  CHARACTER*79 dumstr, locElement
+  INTEGER locDataHandle
+  LOGICAL keepgoing
+
+  Status = 0
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+     ! Do nothing unless it is time to read time-independent domain metadata.
+     IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
+      keepgoing = .true.
+      DO WHILE ( keepgoing )
+        READ( unit=DataHandle , iostat = istat ) hdrbuf
+
+        IF ( istat .EQ. 0 ) THEN
+          code = hdrbuf(2)
+          IF ( code .EQ. int_dom_ti_char ) THEN
+            CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                                         locDataHandle, locElement, dumstr, Data, code )
+            IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
+              keepgoing = .false. ;  Status = 0
+            ENDIF
+          ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real    .OR. code .EQ. int_dom_ti_logical .OR. &
+                            code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_double  .OR. &
+                            code .EQ. int_dom_td_real    .OR. code .EQ. int_dom_td_logical .OR. &
+                            code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_double  .OR. &
+                            code .EQ. int_dom_td_char                                             ) ) THEN
+            BACKSPACE ( unit=DataHandle )
+            keepgoing = .false. ; Status = 1
+          ENDIF
+        ELSE
+          keepgoing = .false. ; Status = 1
+        ENDIF
+      ENDDO
+     ENDIF
+    ENDIF
+  ENDIF
+RETURN
+END SUBROUTINE ext_int_get_dom_ti_char 
+
+!--- put_dom_ti_char
+SUBROUTINE ext_int_put_dom_ti_char ( DataHandle, Element,  Data,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i
+  REAL dummy
+  INTEGER                 :: Count
+
+  IF ( int_valid_handle ( Datahandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      ! Do nothing unless it is time to write time-independent domain metadata.
+      IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
+        CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize,  &
+                                     DataHandle, Element, "", Data, int_dom_ti_char )
+        WRITE( unit=DataHandle ) hdrbuf 
+      ENDIF
+    ENDIF
+  ENDIF
+  Status = 0
+RETURN
+END SUBROUTINE ext_int_put_dom_ti_char 
+
+!--- get_dom_td_real
+SUBROUTINE ext_int_get_dom_td_real ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_dom_td_real 
+
+!--- put_dom_td_real
+SUBROUTINE ext_int_put_dom_td_real ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_dom_td_real 
+
+!--- get_dom_td_double
+SUBROUTINE ext_int_get_dom_td_double ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+    CALL wrf_error_fatal('ext_int_get_dom_td_double not supported yet')
+RETURN
+END SUBROUTINE ext_int_get_dom_td_double 
+
+!--- put_dom_td_double
+SUBROUTINE ext_int_put_dom_td_double ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+    CALL wrf_error_fatal('ext_int_get_dom_td_double not supported yet')
+RETURN
+END SUBROUTINE ext_int_put_dom_td_double 
+
+!--- get_dom_td_integer
+SUBROUTINE ext_int_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_dom_td_integer 
+
+!--- put_dom_td_integer
+SUBROUTINE ext_int_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_dom_td_integer 
+
+!--- get_dom_td_logical
+SUBROUTINE ext_int_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_dom_td_logical 
+
+!--- put_dom_td_logical
+SUBROUTINE ext_int_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_dom_td_logical 
+
+!--- get_dom_td_char
+SUBROUTINE ext_int_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data, DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER istat, code, i
+  CHARACTER*79 dumstr, locElement, locDatestr
+  INTEGER locDataHandle
+  LOGICAL keepgoing
+
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      keepgoing = .true.
+      DO WHILE ( keepgoing )
+        READ( unit=DataHandle , iostat = istat ) hdrbuf
+
+        IF ( istat .EQ. 0 ) THEN
+          code = hdrbuf(2)
+          IF ( code .EQ. int_dom_td_char ) THEN
+            CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, &
+                                         locDataHandle, locDateStr, locElement, Data, code )
+            IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
+              keepgoing = .false. ;  Status = 0
+            ENDIF
+          ELSE 
+            BACKSPACE ( unit=DataHandle )
+            keepgoing = .false. ; Status = 1
+          ENDIF
+        ELSE
+          keepgoing = .false. ; Status = 1
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+RETURN
+END SUBROUTINE ext_int_get_dom_td_char
+
+!--- put_dom_td_char
+SUBROUTINE ext_int_put_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data, DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i
+  REAL dummy
+  INTEGER                 :: Count
+  IF ( int_valid_handle ( Datahandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      CALL int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize,  &
+                                   DataHandle, DateStr, Element, Data, int_dom_td_char )
+      WRITE( unit=DataHandle ) hdrbuf
+    ENDIF
+  ENDIF
+  Status = 0
+RETURN
+END SUBROUTINE ext_int_put_dom_td_char
+
+!--- get_var_ti_real
+SUBROUTINE ext_int_get_var_ti_real ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_var_ti_real 
+
+!--- put_var_ti_real
+SUBROUTINE ext_int_put_var_ti_real ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_var_ti_real 
+
+!--- get_var_ti_double
+SUBROUTINE ext_int_get_var_ti_double ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+    CALL wrf_error_fatal('ext_int_get_var_ti_double not supported yet')
+RETURN
+END SUBROUTINE ext_int_get_var_ti_double 
+
+!--- put_var_ti_double
+SUBROUTINE ext_int_put_var_ti_double ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+    CALL wrf_error_fatal('ext_int_put_var_ti_double not supported yet')
+RETURN
+END SUBROUTINE ext_int_put_var_ti_double 
+
+!--- get_var_ti_integer
+SUBROUTINE ext_int_get_var_ti_integer ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_var_ti_integer 
+
+!--- put_var_ti_integer
+SUBROUTINE ext_int_put_var_ti_integer ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_var_ti_integer 
+
+!--- get_var_ti_logical
+SUBROUTINE ext_int_get_var_ti_logical ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_var_ti_logical 
+
+!--- put_var_ti_logical
+SUBROUTINE ext_int_put_var_ti_logical ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_var_ti_logical 
+
+!--- get_var_ti_char
+SUBROUTINE ext_int_get_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER locDataHandle, code
+  CHARACTER*132 locElement, locVarName
+  IF ( int_valid_handle (DataHandle) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      READ( unit=DataHandle ) hdrbuf
+      IF ( hdrbuf(2) .EQ. int_var_ti_char ) THEN
+        CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                                locDataHandle, locElement, locVarName, Data, code )
+        IF ( .NOT. ( code .EQ. int_var_ti_real    .OR.   code .EQ. int_var_ti_logical .OR. &
+                     code .EQ. int_var_ti_char    .OR.   code .EQ. int_var_ti_double ) ) THEN 
+            BACKSPACE ( unit=DataHandle )
+            Status = 1
+            return
+        ENDIF
+      ELSE
+        BACKSPACE ( unit=DataHandle )
+        Status = 1
+        return
+      ENDIF
+    ELSE
+      Status = 1
+      return
+    ENDIF
+  ELSE
+    Status = 1
+    return
+  ENDIF
+  Status = 0
+RETURN
+END SUBROUTINE ext_int_get_var_ti_char 
+
+!--- put_var_ti_char
+SUBROUTINE ext_int_put_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  INTEGER                 :: Count
+  IF ( int_valid_handle (DataHandle) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize,  &
+                              DataHandle, TRIM(Element), TRIM(VarName), TRIM(Data), int_var_ti_char )
+      WRITE( unit=DataHandle ) hdrbuf
+    ENDIF
+  ENDIF
+  Status = 0
+RETURN
+END SUBROUTINE ext_int_put_var_ti_char 
+
+!--- get_var_td_real
+SUBROUTINE ext_int_get_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_var_td_real 
+
+!--- put_var_td_real
+SUBROUTINE ext_int_put_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_var_td_real 
+
+!--- get_var_td_double
+SUBROUTINE ext_int_get_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+    CALL wrf_error_fatal('ext_int_get_var_td_double not supported yet')
+RETURN
+END SUBROUTINE ext_int_get_var_td_double 
+
+!--- put_var_td_double
+SUBROUTINE ext_int_put_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+    CALL wrf_error_fatal('ext_int_put_var_td_double not supported yet')
+RETURN
+END SUBROUTINE ext_int_put_var_td_double 
+
+!--- get_var_td_integer
+SUBROUTINE ext_int_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_var_td_integer 
+
+!--- put_var_td_integer
+SUBROUTINE ext_int_put_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_var_td_integer 
+
+!--- get_var_td_logical
+SUBROUTINE ext_int_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_var_td_logical 
+
+!--- put_var_td_logical
+SUBROUTINE ext_int_put_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_var_td_logical 
+
+!--- get_var_td_char
+SUBROUTINE ext_int_get_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_get_var_td_char 
+
+!--- put_var_td_char
+SUBROUTINE ext_int_put_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_int_put_var_td_char 
+
+!--- read_field
+SUBROUTINE ext_int_read_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
+                            DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                            DomainStart , DomainEnd ,                                    &
+                            MemoryStart , MemoryEnd ,                                    &
+                            PatchStart , PatchEnd ,                                      &
+                            Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  include 'intio_tags.h'
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  integer                       ,intent(inout)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(inout)    :: DomainDesc
+  character*(*)                 ,intent(inout)    :: MemoryOrder
+  character*(*)                 ,intent(inout)    :: Stagger
+  character*(*) , dimension (*) ,intent(inout)    :: DimNames
+  integer ,dimension(*)         ,intent(inout)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(inout)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(inout)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+
+!local
+  INTEGER                        :: locDataHandle
+  CHARACTER*132                  :: locDateStr
+  CHARACTER*132                  :: locVarName
+  integer                        :: locFieldType
+  integer                        :: locComm
+  integer                        :: locIOComm
+  integer                        :: locDomainDesc
+  character*132                  :: locMemoryOrder
+  character*132                  :: locStagger
+  character*132 , dimension (3)  :: locDimNames
+  integer ,dimension(3)          :: locDomainStart, locDomainEnd
+  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
+  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
+
+  character*132 mess
+
+  integer ii,jj,kk,myrank
+
+
+  REAL, DIMENSION(*)    :: Field
+
+  INTEGER inttypesize, realtypesize, istat, code
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_read_field: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_read_field: DataHandle not opened" )
+  ENDIF
+
+  inttypesize = itypesize
+  realtypesize = rtypesize
+
+  DO WHILE ( .TRUE. ) 
+    READ( unit=DataHandle, iostat=istat ) hdrbuf   ! this is okay as long as no other record type has data that follows
+    IF ( istat .EQ. 0 ) THEN
+      code = hdrbuf(2)
+      IF ( code .EQ. int_field ) THEN
+        CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
+                                 locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm,  &
+                                 locDomainDesc , locMemoryOrder , locStagger , locDimNames ,              &
+                                 locDomainStart , locDomainEnd ,                                    &
+                                 locMemoryStart , locMemoryEnd ,                                    &
+                                 locPatchStart , locPatchEnd )
+        IF ( TRIM(locVarName) .EQ. TRIM(VarName) ) THEN
+          IF      ( FieldType .EQ. WRF_REAL ) THEN
+            CALL rfieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
+          ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+            CALL ifieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
+          ELSE
+            CALL wrf_message('io_int.F90: ext_int_read_field: types other than WRF_REAL not supported yet')
+            READ( unit=DataHandle )
+          ENDIF
+        ELSE
+          WRITE(mess,*)'ext_int_read_field: ',TRIM(locVarName),' NE ',TRIM(VarName)
+          CALL wrf_message(mess)
+          READ( unit=DataHandle )
+        ENDIF
+        Status = 0
+        GOTO 7717
+      ENDIF
+    ELSE
+      Status = 1
+      GOTO 7717
+    ENDIF
+  ENDDO
+
+7717 CONTINUE
+
+  first_operation( DataHandle ) = .FALSE.
+  RETURN
+
+END SUBROUTINE ext_int_read_field
+
+!--- write_field
+SUBROUTINE ext_int_write_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm,  &
+                             DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                             DomainStart , DomainEnd ,                                    &
+                             MemoryStart , MemoryEnd ,                                    &
+                             PatchStart , PatchEnd ,                                      &
+                             Status )
+  USE module_ext_internal
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  character*(*)                 ,intent(in)    :: Stagger
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+
+  integer ii,jj,kk,myrank
+
+!  REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
+!                   MemoryStart(2):MemoryEnd(2), &
+!                   MemoryStart(3):MemoryEnd(3) ) :: Field
+
+  REAL, DIMENSION(*)    :: Field
+
+  INTEGER inttypesize, realtypesize
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_write_field: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("io_int.F90: ext_int_write_field: DataHandle not opened" )
+  ENDIF
+
+  inttypesize = itypesize
+  realtypesize = rtypesize
+  IF      ( FieldType .EQ. WRF_REAL .OR. FieldType .EQ. WRF_DOUBLE) THEN
+    typesize = rtypesize
+  ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+    CALL wrf_error_fatal( 'io_int.F90: ext_int_write_field, WRF_DOUBLE not yet supported')
+  ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+    typesize = itypesize
+  ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+    CALL wrf_error_fatal( 'io_int.F90: ext_int_write_field, WRF_LOGICAL not yet supported')
+  ENDIF
+
+  IF ( okay_for_io( DataHandle ) ) THEN
+
+    CALL int_gen_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
+                             DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm,  &
+                             DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                             DomainStart , DomainEnd ,                                    &
+                             MemoryStart , MemoryEnd ,                                    &
+                             PatchStart , PatchEnd )
+    WRITE( unit=DataHandle ) hdrbuf
+    IF      ( FieldType .EQ. WRF_REAL ) THEN
+      CALL rfieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
+    ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+      CALL ifieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
+    ENDIF
+  ENDIF
+  first_operation( DataHandle ) = .FALSE.
+  Status = 0
+  RETURN
+END SUBROUTINE ext_int_write_field
+
+SUBROUTINE rfieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
+                   MemoryStart(2):MemoryEnd(2), &
+                   MemoryStart(3):MemoryEnd(3) ) :: Field
+  WRITE( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
+  RETURN
+END SUBROUTINE rfieldwrite
+
+SUBROUTINE ifieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER, DIMENSION( MemoryStart(1):MemoryEnd(1), &
+                      MemoryStart(2):MemoryEnd(2), &
+                      MemoryStart(3):MemoryEnd(3) ) :: Field
+  WRITE( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
+  RETURN
+END SUBROUTINE ifieldwrite
+
+SUBROUTINE rfieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
+  INTEGER ,       INTENT(IN)    :: DataHandle
+  INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
+                   MemoryStart(2):MemoryEnd(2), &
+                   MemoryStart(3):MemoryEnd(3) ) :: Field
+  READ( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
+  RETURN
+END SUBROUTINE rfieldread
+
+SUBROUTINE ifieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
+  INTEGER ,       INTENT(IN)    :: DataHandle
+  INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER, DIMENSION( MemoryStart(1):MemoryEnd(1), &
+                      MemoryStart(2):MemoryEnd(2), &
+                      MemoryStart(3):MemoryEnd(3) ) :: Field
+  READ( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
+  RETURN
+END SUBROUTINE ifieldread
+
Index: trunk/WRF.COMMON/WRFV2/external/io_int/makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_int/makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_int/makefile	(revision 2744)
@@ -0,0 +1,53 @@
+#makefile to build io_int that does binary i/o
+
+OBJSL   = io_int.o 
+OBJS    = $(OBJSL)
+FFLAGS  = $(FCFLAGS)
+LIBS    = 
+CPP1    = $(CPP) $(TRADFLAG)
+M4      = m4 -Uinclude -Uindex -Ulen
+AR      = ar
+
+.SUFFIXES:      .F90 .F .f .o .code
+
+all : libwrfio_int.a diffwrf
+
+libwrfio_int.a:		$(OBJS)
+			/bin/rm -f libwrfio_int.a
+			$(AR) cr libwrfio_int.a $(OBJSL)
+			$(RANLIB) libwrfio_int.a
+
+io_int.o:               io_int.F90 module_internal_header_util.o
+			$(CPP1)  -I../ioapi_share io_int.F90 | $(M4) - > io_int.f
+			$(FC) $(FFLAGS) -I. -I../ioapi_share -c io_int.f
+			/bin/rm -f module_internal_header_util.o
+			/bin/rm -f intio_tags.h
+
+# this is just so we can get the .mod file, it will be recompiled in frame again as part of WRF frmwk
+module_internal_header_util.o :
+			cp ../../frame/module_internal_header_util.F module_internal_header_util.b
+			cp ../../inc/intio_tags.h intio_tags.h
+			/bin/rm -f module_internal_header_util.f
+			$(CPP1)  -I../ioapi_share module_internal_header_util.b > module_internal_header_util.f
+			$(FC) $(FFLAGS) -I. -c module_internal_header_util.f
+			/bin/rm -f module_internal_header_util.b
+
+diffwrf:                diffwrf.F ../../frame/pack_utils.o ../../frame/module_machine.o ../../frame/module_wrf_error.o \
+				../../frame/wrf_debug.o libwrfio_int.a $(ESMF_MOD_DEPENDENCE)
+			if [ -f ../../frame/pack_utils.o ] ; then \
+			mv diffwrf.F diffwrf.F90    ; \
+			$(CPP1)  -I../ioapi_share diffwrf.F90 > diffwrf.f  ; \
+			$(SFC) -c $(FFLAGS) -I../ioapi_share diffwrf.f    ; \
+			mv diffwrf.F90 diffwrf.F ; \
+			$(SFC) $(FFLAGS) $(LDFLAGS) -o diffwrf diffwrf.o $(OBJSL) \
+                        ../../frame/pack_utils.o ../../frame/module_internal_header_util.o \
+                        ../../frame/module_driver_constants.o \
+			../../frame/module_machine.o ../../frame/wrf_debug.o ../../frame/module_wrf_error.o \
+			$(ESMF_IO_LIB_EXT) ; fi
+
+../../frame/pack_utils.o ../../frame/internal_header_util.o ../../frame/module_machine.o ../../frame/module_wrf_error.o \
+../../frame/wrf_debug.o $(ESMF_MOD_DEPENDENCE) :
+			@echo "Diffwrf io_int will be built later on in this compile. No need to rerun compile. "
+
+superclean:
+			/bin/rm -f *.f *.o *.mod libwrfio_int.a diffwrf 
Index: trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_open_for_read.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_open_for_read.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_open_for_read.F90	(revision 2744)
@@ -0,0 +1,129 @@
+!--- open_for_read_begin
+SUBROUTINE ext_mcel_open_for_read_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                         DataHandle , Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i, tasks_in_group, ierr, comm_io_group
+  LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+  REAL dummy
+  INTEGER io_form
+  CHARACTER*80 read_mode, grid_type, filter_handle, use_mask
+  CHARACTER*256   tstr
+
+  CALL int_get_fresh_handle(i)
+  okay_to_write(i) = .false.
+  okay_to_read(i) = .false.
+  opened_for_read(i) = .true.
+  opened_for_write(i) = .false.
+  mcel_grid_defined(i) = .false.
+  mcel_finalized(i) = .false.
+  DataHandle = i
+  ListOfFields(i) = " "
+
+! recover the names of the strings that contain georeference and mask data, if avail
+  lat_r(i) = ""
+  lon_r(i) = ""
+  landmask_i(i) = ""
+  read_mode = ""
+  grid_type = "STRUCTURED"
+  filter_handle = "Filter"
+  use_mask = ""
+  CALL get_value( "LAT_R", SysDepInfo, lat_r(i) )
+  CALL get_value( "LON_R", SysDepInfo, lon_r(i) )
+  CALL get_value( "LANDMASK_I", SysDepInfo, landmask_i(i) )
+  CALL get_value( "READ_MODE", SysDepInfo, read_mode )
+write(0,*)'open_for_write_begin: SysDepInfo ', TRIM(SysDepInfo)
+write(0,*)'open_for_write_begin: read_mode ', read_mode
+  CALL get_value( "MCEL_GRIDTYPE", SysDepInfo, grid_type )
+  CALL get_value( "FILTER_HANDLE", SysDepInfo, filter_handle )
+  CALL get_value( "USE_MASK", SysDepInfo, use_mask )
+  IF ( TRIM(read_mode) .EQ. 'UPDATE' ) THEN
+    opened_for_update( i ) = .true.
+  ELSE
+    opened_for_update( i ) = .false.
+  ENDIF
+write(0,*)'opened_for_update(i) ', opened_for_update(i)
+
+  usemask(i) = MCEL_MASK_ALLVALID
+  IF ( trim(use_mask) .NE. "" ) read( use_mask , '(I)' ) usemask(i)
+write(0,*)'ofrb use_mask ',trim(use_mask)
+write(0,*)'ofrb filter_handle ',trim(filter_handle)
+write(0,*)'ofrb usemask(',i,') = ',usemask(i)
+
+  mcel_npglobal=-1 ; mcel_mystart=-1 ; mcel_mnproc=-1 ; mcel_myproc=-1
+
+  CALL get_value( "MCEL_NPGLOBAL", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(I)' ) mcel_npglobal
+  CALL get_value( "MCEL_MYSTART", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(I)' ) mcel_mystart
+  CALL get_value( "MCEL_MNPROC", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(I)' ) mcel_mnproc
+  CALL get_value( "MCEL_MYPROC", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(I)' ) mcel_myproc
+  deltax = -1
+  CALL get_value( "MCEL_DELTA_X", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(f15.8)' ) deltax
+  deltay = -1
+  CALL get_value( "MCEL_DELTA_Y", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(f15.8)' ) deltay
+  originx = -1
+  CALL get_value( "MCEL_ORIGIN_X", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(f15.8)' ) originx
+  originy = -1
+  CALL get_value( "MCEL_ORIGIN_Y", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(f15.8)' ) originy
+
+  IF ( trim(grid_type) .EQ. 'UNSTRUCTURED' ) THEN
+    CALL newGrid( open_file_descriptors(2,i), 2, MCEL_GRIDTYPE_UNSTRUCTURED, &
+                  MCEL_GRIDCENT_NODAL, MCEL_GRIDCOORD_LATLONG, &
+                  ierr )
+  ELSE
+    CALL newGrid( open_file_descriptors(2,i), 2, MCEL_GRIDTYPE_STRUCTURED, &
+                  MCEL_GRIDCENT_NODAL, MCEL_GRIDCOORD_LATLONG, &
+                  ierr )
+  ENDIF
+  IF ( ierr .NE. 0 ) CALL wrf_error_fatal( "ext_mcel_open_for_read_begin: newGrid" )
+
+!  IF ( opened_for_update( i ) ) THEN
+    ! right now the name of the ior file is coming in as the file name; whereis for writing the
+    ! file name is the program name.  Needs to be resolved for this call to newfilter. 
+    ! Make the FileName the program name and find a different way to bring in the ior file; sysdepinfo? environ?
+    CALL newfilter ( open_file_descriptors(1,i), 'relfile:/' // TRIM(FileName), filter_handle, ierr )
+    IF ( ierr .NE. 0 ) CALL wrf_error_fatal( "ext_mcel_open_for_read_begin: newfilter" )
+!  ELSE
+!    CALL newProgram ( open_file_descriptors(1,i), TRIM(FileName), ierr )
+!    IF ( ierr .NE. 0 ) CALL wrf_error_fatal( "ext_mcel_open_for_read_begin: newProgram" )
+!  ENDIF
+
+  Status = 0
+  RETURN  
+END SUBROUTINE ext_mcel_open_for_read_begin
+
+!--- open_for_read_commit
+SUBROUTINE ext_mcel_open_for_read_commit( DataHandle , Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER*80   FileName,SysDepInfo, mess
+  REAL dummy
+  INTEGER ierr
+
+  IF ( int_valid_handle ( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      if ( opened_for_update( DataHandle ) ) okay_to_write( DataHandle ) = .true.
+      okay_to_read( DataHandle ) = .true.
+    ENDIF
+  ENDIF
+
+! everything else will be handled in lazy fashion by first operation
+
+  Status = 0
+
+  RETURN  
+END SUBROUTINE ext_mcel_open_for_read_commit
Index: trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_open_for_write.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_open_for_write.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_open_for_write.F90	(revision 2744)
@@ -0,0 +1,111 @@
+!--- open_for_write_begin
+SUBROUTINE ext_mcel_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                         DataHandle , Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i, tasks_in_group, ierr, comm_io_group
+  LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+  REAL dummy
+  INTEGER io_form
+  CHARACTER*256   fname
+  CHARACTER*256   grid_type
+  CHARACTER*256   tstr
+
+  fname = FileName
+
+  CALL int_get_fresh_handle(i)
+  okay_to_write(i) = .false.
+  okay_to_read(i) = .false.
+  opened_for_update(i) = .false.
+  opened_for_read(i) = .false.
+  opened_for_write(i) = .true.
+  mcel_grid_defined(i) = .false.
+  mcel_finalized(i) = .false.
+  DataHandle = i
+
+! right now only 2d -- extend later to 3d, 1d, 0d
+
+  CALL get_value ( 'MCEL_GRIDTYPE', SysDepInfo, grid_type )
+
+  LAT_R(i) = ""
+  LON_R(i) = ""
+  LANDMASK_I(i) = ""
+  CALL get_value( "LAT_R", SysDepInfo, LAT_R(i) )
+  CALL get_value( "LON_R", SysDepInfo, LON_R(i) )
+  CALL get_value( "LANDMASK_I", SysDepInfo, LANDMASK_I(i) )
+
+  mcel_npglobal=-1 ; mcel_mystart=-1 ; mcel_mnproc=-1 ; mcel_myproc=-1  
+
+  CALL get_value( "MCEL_NPGLOBAL", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(I)' ) mcel_npglobal
+  CALL get_value( "MCEL_MYSTART", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(I)' ) mcel_mystart
+  CALL get_value( "MCEL_MNPROC", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(I)' ) mcel_mnproc
+  CALL get_value( "MCEL_MYPROC", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(I)' ) mcel_myproc
+
+  deltax = -1
+  CALL get_value( "MCEL_DELTA_X", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(f15.8)' ) deltax
+  deltay = -1
+  CALL get_value( "MCEL_DELTA_Y", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(f15.8)' ) deltay
+  originx = -1
+  CALL get_value( "MCEL_ORIGIN_X", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(f15.8)' ) originx
+  originy = -1
+  CALL get_value( "MCEL_ORIGIN_Y", SysDepInfo, tstr )
+  IF ( tstr .NE. "" ) READ( tstr, '(f15.8)' ) originy
+
+
+  IF ( TRIM(grid_type) .EQ. 'UNSTRUCTURED' ) THEN
+     CALL newGrid( open_file_descriptors(2,i), 2, MCEL_GRIDTYPE_UNSTRUCTURED, &
+                   MCEL_GRIDCENT_NODAL, MCEL_GRIDCOORD_LATLONG, &
+                   ierr )
+  ELSE
+
+     CALL newGrid( open_file_descriptors(2,i), 2, MCEL_GRIDTYPE_STRUCTURED, &
+                   MCEL_GRIDCENT_NODAL, MCEL_GRIDCOORD_LATLONG, &
+                   ierr )
+  ENDIF
+
+  IF ( ierr .NE. 0 ) CALL wrf_error_fatal( "ext_mcel_open_for_write_begin: newGrid" )
+
+  CALL newProgram ( open_file_descriptors(1,i), TRIM(fname), ierr )
+
+  IF ( ierr .NE. 0 ) CALL wrf_error_fatal( "ext_mcel_open_for_write_begin: newProgram" )
+
+  Status = 0
+  RETURN  
+END SUBROUTINE ext_mcel_open_for_write_begin
+
+!--- open_for_write_commit
+SUBROUTINE ext_mcel_open_for_write_commit( DataHandle , Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER*80   FileName,SysDepInfo, mess
+  REAL dummy
+  INTEGER ierr
+
+  IF ( int_valid_handle ( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      okay_to_write( DataHandle ) = .true.
+      okay_to_read( DataHandle ) = .true.
+      opened_for_update( DataHandle ) = .false.
+    ENDIF
+  ENDIF
+
+! rest of this is handled lazy on first write
+
+  Status = 0
+
+  RETURN  
+END SUBROUTINE ext_mcel_open_for_write_commit
Index: trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_read_field.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_read_field.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_read_field.F90	(revision 2744)
@@ -0,0 +1,340 @@
+!--- read_field
+SUBROUTINE ext_mcel_read_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
+                            DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                            DomainStart , DomainEnd ,                                    &
+                            MemoryStart , MemoryEnd ,                                    &
+                            PatchStart , PatchEnd ,                                      &
+                            Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  integer                       ,intent(inout)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(inout)    :: DomainDesc
+  character*(*)                 ,intent(inout)    :: MemoryOrder
+  character*(*)                 ,intent(inout)    :: Stagger
+  character*(*) , dimension (*) ,intent(inout)    :: DimNames
+  integer ,dimension(*)         ,intent(inout)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(inout)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(inout)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+
+!local
+  INTEGER                        :: locDataHandle
+  CHARACTER*132                  :: locDateStr
+  CHARACTER*132                  :: locVarName
+  integer                        :: locFieldType
+  integer                        :: locComm
+  integer                        :: locIOComm
+  integer                        :: locDomainDesc
+  character*132                  :: locMemoryOrder
+  character*132                  :: locStagger
+  character*132 , dimension (3)  :: locDimNames
+  integer ,dimension(3)          :: locDomainStart, locDomainEnd
+  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
+  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
+  real, allocatable, dimension(:,:) :: temp
+  doubleprecision, allocatable, dimension(:,:) :: dtemp
+  integer gSize(2)
+  INTEGER, EXTERNAL :: cast_to_int
+integer myproc
+
+  character*132 mess
+  integer ips,ipe,jps,jpe
+  integer ims,ime,jms,jme
+  integer idex,ierr,i,j
+
+  integer ii,jj,kk,myrank,ierr, mcel_type
+  real*8 data_time
+  character*14 timestr
+  
+
+
+!  REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
+!                   MemoryStart(2):MemoryEnd(2), &
+!                   MemoryStart(3):MemoryEnd(3) ) :: Field
+  REAL, DIMENSION(*)    :: Field
+
+  INTEGER inttypesize, realtypesize, istat, code
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_read_field: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_read_field: DataHandle not opened" )
+  ENDIF
+
+
+  ips = PatchStart(1) ; ipe = PatchEnd(1) 
+  jps = PatchStart(2) ; jpe = PatchEnd(2) 
+  ims = MemoryStart(1) ; ime = MemoryEnd(1)
+  jms = MemoryStart(2) ; jme = MemoryEnd(2)
+
+write(0,*)'ext_mcel_read_field ',DataHandle, TRIM(DateStr), TRIM(VarName)
+
+  inttypesize = itypesize
+  realtypesize = rtypesize
+  IF      ( FieldType .EQ. WRF_REAL ) THEN
+    typesize = rtypesize
+    mcel_type = MCEL_DATATYPE_REAL
+  ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+    mcel_type = MCEL_DATATYPE_DOUBLE
+  ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+    typesize = itypesize
+    mcel_type = MCEL_DATATYPE_INT32
+  ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+    CALL wrf_error_fatal( 'io_int.F90: ext_mcel_write_field, WRF_LOGICAL not yet supported')
+  ENDIF
+
+  ! case 1: the file is opened but not commited for update 
+write(0,*)' read_field: okay_to_read: ', DataHandle, okay_to_read(DataHandle)
+write(0,*)' read_field: opened_for_update: ', DataHandle, opened_for_update(DataHandle)
+  if ( .not. okay_to_read( DataHandle ) )  then
+    IF ( opened_for_update( DataHandle) ) THEN
+write(0,*)'ext_mcel_read_field tr calling ext_mcel_write_field ', TRIM(DateStr), TRIM(VarName)
+      CALL ext_mcel_write_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
+                                  DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                  DomainStart , DomainEnd ,                                    &
+                                  MemoryStart , MemoryEnd ,                                    &
+                                  PatchStart , PatchEnd ,                                      &
+                                  ierr )
+      IF ( TRIM(VarName) .NE. TRIM(LAT_R(DataHandle)) .AND. TRIM(VarName) .NE. TRIM(LON_R(DataHandle)) .AND. &
+           TRIM(VarName) .NE. TRIM(LANDMASK_I(DataHandle)) ) THEN
+        ListOfFields(DataHandle) = TRIM(ListOfFields(DataHandle)) // ',' // TRIM(VarName)
+      ENDIF
+write(0,*)'ext_mcel_read_field tr back from ext_mcel_write_field ', TRIM(DateStr), TRIM(VarName), ierr
+    ELSE
+
+! these will have been set in the call to open_for_read_begin from sysdepinfo
+      IF ( mcel_npglobal .NE. -1 .AND. mcel_mystart .NE. -1 .AND.  &
+           mcel_mnproc   .NE. -1 .AND. mcel_myproc  .NE. -1     ) THEN
+write(0,*)'ext_mcel_read_field tr setglobalsize ', TRIM(VarName), mcel_npglobal
+        call setglobalsize(open_file_descriptors(2,DataHandle),mcel_npglobal,ierr)
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_read_field: setglobalsize")
+write(0,*)'ext_mcel_read_field tr setglobalstart ', TRIM(VarName), mcel_mystart
+        call setglobalstart(open_file_descriptors(2,DataHandle),mcel_mystart,ierr)
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_read_field: setglobalstart")
+#if 0
+        call setprocinfo(open_file_descriptors(1,DataHandle),mcel_mnproc,mcel_myproc,ierr)
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_read_field: setprocinfo")
+#endif
+      ENDIF
+      mcel_npglobal=-1 ; mcel_mystart=-1 ; mcel_mnproc=-1 ; mcel_myproc=-1
+
+      ! sieve the fields coming in and grab the ones we need for geo registration
+      IF      ( TRIM(VarName) .EQ. TRIM(LAT_R(DataHandle)) ) THEN
+        IF ( ALLOCATED(xlat) ) THEN
+          DEALLOCATE(xlat)
+        ENDIF
+        ALLOCATE(xlat(ips:ipe,jps:jpe))
+        IF      ( FieldType .EQ. WRF_REAL ) THEN
+          CALL copy_field_to_cache_r2d ( Field, xlat, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+          CALL copy_field_to_cache_d2d ( Field, xlat, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        ENDIF
+
+      ELSE IF ( TRIM(VarName) .EQ. TRIM(LON_R(DataHandle)) ) THEN
+        IF ( ALLOCATED(xlong) ) THEN
+          DEALLOCATE(xlong)
+        ENDIF
+        ALLOCATE(xlong(ips:ipe,jps:jpe))
+        IF      ( FieldType .EQ. WRF_REAL ) THEN
+          CALL copy_field_to_cache_r2d ( Field, xlong, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+          CALL copy_field_to_cache_d2d ( Field, xlong, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        ENDIF
+      ELSE IF ( TRIM(VarName) .EQ. TRIM(LANDMASK_I(DataHandle)) ) THEN
+        IF ( ALLOCATED(mask) ) THEN
+          DEALLOCATE(mask)
+        ENDIF
+        ALLOCATE(mask(ips:ipe,jps:jpe))
+        IF ( FieldType .EQ. WRF_INTEGER ) THEN
+          CALL copy_field_to_cache_int ( Field, mask, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        ELSE IF ( FieldType .EQ. WRF_REAL ) THEN
+          ALLOCATE(rmask(ips:ipe,jps:jpe))
+          CALL copy_field_to_cache_r2r ( Field, rmask, ips, ipe, jps, jpe, ims, ime, jms, jme )
+          mask = NINT( rmask )
+          DEALLOCATE(rmask)
+        ELSE IF (FieldType .EQ. WRF_DOUBLE ) THEN
+          ALLOCATE(dmask(ips:ipe,jps:jpe))
+          CALL copy_field_to_cache_d2d ( Field, dmask, ips, ipe, jps, jpe, ims, ime, jms, jme )
+          mask = NINT( dmask )
+          DEALLOCATE(dmask)
+        ENDIF
+      ELSE
+        IF ( .NOT. mcel_grid_defined( DataHandle ) ) THEN
+          mcel_grid_defined( DataHandle ) = .true.
+          gSize(1) = ipe-ips+1
+          gSize(2) = jpe-jps+1
+write(0,*)'ext_mcel_read_field tr setSize ', TRIM(VarName), gSize
+          CALL setSize ( open_file_descriptors(2,DataHandle), gSize, ierr )
+          IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: setSize")
+        ENDIF
+write(0,*)'ext_mcel_read_field tr addSources ', TRIM(VarName), mcel_type
+        CALL addSources ( open_file_descriptors(1,DataHandle), MCEL_SERVER,  &
+  &       TRIM(VarName),1, mcel_type, ierr )
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: addSources")
+write(0,*)'ext_mcel_read_field tr addOutputs ', TRIM(VarName), mcel_type
+        CALL addOutputs ( open_file_descriptors(1,DataHandle),   &
+  &       TRIM(VarName),1, mcel_type, ierr )
+! add this field to the list that we know something about
+        ListOfFields(DataHandle) = TRIM(ListOfFields(DataHandle)) // ',' // TRIM(VarName)
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: addOutputs")
+      ENDIF
+    ENDIF
+
+  ! case 2: opened for update and committed
+!  else if ( okay_to_write( DataHandle ) .and. opened_for_update( DataHandle) )  then
+  else if ( okay_to_read( DataHandle ) )  then
+
+write(0,*)'ext_mcel_read_field ok ', Trim(VarName)
+write(0,*)'ext_mcel_read_field LAT_R ', Trim(LAT_R(DataHandle))
+write(0,*)'ext_mcel_read_field LON_R ', Trim(LON_R(DataHandle))
+write(0,*)'ext_mcel_read_field LANDMASK_I ', Trim(LANDMASK_I(DataHandle))
+    IF ( TRIM(VarName) .NE. TRIM(LAT_R(DataHandle)) .AND. TRIM(VarName) .NE. TRIM(LON_R(DataHandle)) .AND. &
+         TRIM(VarName) .NE. TRIM(LANDMASK_I(DataHandle)) ) THEN
+      IF ( .NOT. mcel_finalized( DataHandle ) ) THEN
+        IF ( ALLOCATED( xlat ) .AND. ALLOCATED( xlong ) ) THEN
+write(0,*)'ext_mcel_read_field ok setlocationsXY ', Trim(VarName)
+
+!call wrf_get_myproc(myproc)
+!write(90+myproc,*)ipe-ips+1,jpe-jps+1,' xlong in read_field before setMask'
+!do j=jps,jpe
+!do i=ips,ipe
+!write(90+myproc,*)xlong(i,j)
+!enddo
+!enddo
+!write(90+myproc,*)ipe-ips+1,jpe-jps+1,' xlat in read_field before setMask'
+!do j=jps,jpe
+!do i=ips,ipe
+!write(90+myproc,*)xlat(i,j)
+!enddo
+!enddo
+
+          CALL setLocationsXY( open_file_descriptors(2,DataHandle), xlong, xlat, ierr )
+          IF ( ierr .NE. 0 ) CALL wrf_error_fatal( "ext_mcel_open_read_field: setLocationsXY" )
+        ELSE IF ( deltax .gt. 0. .and. deltay .gt. 0. .and. originx .gt. 0. .and. originy .gt. 0. ) THEN
+          dxm(1) = deltax
+          dxm(2) = deltay
+          call SetDX ( open_file_descriptors(2,DataHandle), dxm, ierr)
+          origin(1) = originx
+          origin(2) = originy
+          call SetOrigin ( open_file_descriptors(2,DataHandle), origin, ierr)
+        ELSE
+          CALL wrf_error_fatal( "ext_mcel_read_field:noLocationsXY or dx/dy")
+        ENDIF
+        IF ( ALLOCATED(mask) ) THEN
+
+!write(0,*)'ext_mcel_read_field ok setMask ', Trim(VarName)
+!call wrf_get_myproc(myproc)
+!write(90+myproc,*)ipe-ips+1,jpe-jps+1,' mask in read_field before setMask'
+!do j=jps,jpe
+!do i=ips,ipe
+!write(90+myproc,*)mask(i,j)
+!enddo
+!enddo
+
+          CALL setMask ( open_file_descriptors(2,DataHandle) , mask, ierr )
+          IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_read_field: setMask")
+        ENDIF
+write(0,*)'ext_mcel_read_field ok setoutputgrid ', Trim(VarName)
+        CALL setoutputgrid ( open_file_descriptors(1,DataHandle), open_file_descriptors(2,DataHandle), ierr )
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_read_field: setoutputgrid")
+write(0,*)'ext_mcel_read_field ok finalizefilters ', Trim(VarName)
+        CALL finalizefilters ( open_file_descriptors(1,DataHandle), ierr )
+        IF ( ierr .GT. 0 .and. ierr .ne. 3 ) THEN
+           write(mess,*)'ext_mcel_open_for_read_field: finalizefilters ierr=',ierr
+           CALL wrf_error_fatal( TRIM(mess) )
+        ENDIF
+        mcel_finalized( DataHandle ) = .TRUE.
+      ENDIF
+
+      ! a little string munging, assumes that we're getting an ISO compliant date string
+      ! basically removing the delimeters
+
+      timestr = "              "
+      timestr(1:4)   = DateStr(1:4)    ! YYYY
+      timestr(5:6)   = DateStr(6:7)    ! MM
+      timestr(7:8)   = DateStr(9:10)   ! DD
+      timestr(9:10)  = DateStr(12:13)  ! HH
+      timestr(11:12) = DateStr(15:16)  ! MM
+      timestr(13:14) = DateStr(18:19)  ! SS
+
+      CALL YYYYMMDDHHMMSS2SECS( timestr, data_time )
+
+write(0,*)'TRIM( VarName ) ',TRIM( VarName )
+write(0,*)'TRIM( ListOfFields(DataHandle) ) ',TRIM( ListOfFields(DataHandle) )
+write(0,*)'INDEX( TRIM( ListOfFields(DataHandle) ), TRIM( VarName ) )', INDEX( TRIM( ListOfFields(DataHandle) ), TRIM( VarName ) )
+
+      IF ( INDEX( TRIM( ListOfFields(DataHandle) ), TRIM( VarName ) ) .EQ. 0 ) THEN
+        write(mess,*)'ext_mcel_open_for_read_field: ',TRIM( VarName ),' is not a field set up for DataHandle ', DataHandle
+        CALL wrf_error_fatal( TRIM(mess) )
+      ENDIF
+
+      IF ( FieldType .EQ. WRF_REAL ) THEN
+        ALLOCATE(temp(ips:ipe,jps:jpe))
+write(0,*)'ext_mcel_read_field opened_for_update(DataHandle) ',opened_for_update(DataHandle)
+        IF ( opened_for_update(DataHandle) ) THEN
+          CALL copy_field_to_cache_r2r ( Field, temp, ips, ipe, jps, jpe, ims, ime, jms, jme )
+!call wrf_get_myproc(myproc)
+!write(90+myproc,*)ipe-ips+1,jpe-jps+1,' temp in read_field before getData'
+!do j=jps,jpe
+!do i=ips,ipe
+!write(90+myproc,*)temp(i,j)
+!enddo
+!enddo
+          call getData(open_file_descriptors(1,DataHandle),TRIM(VarName),temp,                 &
+            data_time,data_time,MCEL_TIMECENT_POINT,usemask(DataHandle),                       &
+            MCEL_FETCHPOLICY_KEEPBLOCK,ierr)
+!write(90+myproc,*)ipe-ips+1,jpe-jps+1,' temp in read_field after getData'
+!do j=jps,jpe
+!do i=ips,ipe
+!write(90+myproc,*)temp(i,j)
+!enddo
+!enddo
+!write(0,*)'ext_mcel_read_field ok getData returns ',ierr, Trim(VarName)
+
+        ELSE
+! the difference is there is no KEEP in the FETCHPOLICY
+write(0,*)'ext_mcel_read_field ok getData ', Trim(VarName)
+          call getData(open_file_descriptors(1,DataHandle),TRIM(VarName),temp,                 &
+            data_time,data_time,MCEL_TIMECENT_POINT,usemask(DataHandle),                      &
+            MCEL_FETCHPOLICY_BLOCK,ierr)
+write(0,*)'ext_mcel_read_field ok getData returns ',ierr, Trim(VarName)
+        ENDIF
+        CALL copy_cache_to_field_r2r ( temp, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        DEALLOCATE(temp)
+      ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+
+        ALLOCATE(dtemp(ips:ipe,jps:jpe))
+write(0,*)'ext_mcel_read_field opened_for_update(DataHandle) ',opened_for_update(DataHandle)
+        IF ( opened_for_update(DataHandle) ) THEN
+          CALL copy_field_to_cache_d2d ( Field, dtemp, ips, ipe, jps, jpe, ims, ime, jms, jme )
+write(0,*)'ext_mcel_read_field ok getData returns ',ierr, Trim(VarName)
+          call getData(open_file_descriptors(1,DataHandle),TRIM(VarName),dtemp,                 &
+            data_time,data_time,MCEL_TIMECENT_POINT,usemask(DataHandle),                       &
+            MCEL_FETCHPOLICY_KEEPBLOCK,ierr)
+        ELSE
+! the difference is there is no KEEP in the FETCHPOLICY
+write(0,*)'ext_mcel_read_field ok getData ', Trim(VarName)
+          call getData(open_file_descriptors(1,DataHandle),TRIM(VarName),dtemp,                 &
+            data_time,data_time,MCEL_TIMECENT_POINT,usemask(DataHandle),                      &
+            MCEL_FETCHPOLICY_BLOCK,ierr)
+write(0,*)'ext_mcel_read_field ok getData returns ',ierr, Trim(VarName)
+        ENDIF
+        CALL copy_cache_to_field_d2d ( dtemp, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
+
+        DEALLOCATE(dtemp)
+
+      ENDIF
+    ENDIF
+  endif
+
+  Status = 0
+
+  RETURN
+
+END SUBROUTINE ext_mcel_read_field
Index: trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_write_field.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_write_field.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_mcel/ext_mcel_write_field.F90	(revision 2744)
@@ -0,0 +1,229 @@
+!--- write_field
+SUBROUTINE ext_mcel_write_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm,  &
+                             DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                             DomainStart , DomainEnd ,                                    &
+                             MemoryStart , MemoryEnd ,                                    &
+                             PatchStart , PatchEnd ,                                      &
+                             Status )
+  USE module_ext_mcel
+!  USE module_date_time   ! defined in share
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  character*(*)                 ,intent(in)    :: Stagger
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+
+  integer ips,ipe,jps,jpe
+  integer ims,ime,jms,jme
+  integer idex,ierr,i,j
+
+  integer ii,jj,kk,myrank,mcel_type
+  integer gSize(2)
+  integer idts
+  real*8 data_time
+  CHARACTER*256 RollOverDeathDate
+  CHARACTER*80 mess, timestr
+  INTEGER, EXTERNAL :: cast_to_int
+
+!  REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
+!                   MemoryStart(2):MemoryEnd(2), &
+!                   MemoryStart(3):MemoryEnd(3) ) :: Field
+
+  REAL, DIMENSION(*)    :: Field
+
+  real, allocatable, dimension(:,:) :: temp
+  integer, allocatable, dimension(:,:) :: itemp
+  doubleprecision, allocatable, dimension(:,:) :: dtemp
+
+  INTEGER inttypesize, realtypesize
+
+write(0,*)"write field : called "
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_mcel_write_field: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_mcel_write_field: DataHandle not opened" )
+  ENDIF
+
+  inttypesize = itypesize
+  realtypesize = rtypesize
+  IF      ( FieldType .EQ. WRF_REAL ) THEN
+    typesize = rtypesize
+    mcel_type = MCEL_DATATYPE_REAL
+  ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+    mcel_type = MCEL_DATATYPE_DOUBLE
+  ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+    typesize = itypesize
+    mcel_type = MCEL_DATATYPE_INT32
+  ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+    CALL wrf_error_fatal( 'io_int.F90: ext_mcel_write_field, WRF_LOGICAL not yet supported')
+  ENDIF
+
+  ips = PatchStart(1) ; ipe = PatchEnd(1) 
+  jps = PatchStart(2) ; jpe = PatchEnd(2) 
+  ims = MemoryStart(1) ; ime = MemoryEnd(1)
+  jms = MemoryStart(2) ; jme = MemoryEnd(2)
+
+write(0,*)"write field : okay_to_write ",okay_to_write( DataHandle )
+
+  IF ( okay_to_write( DataHandle ) ) THEN
+    IF ( TRIM(VarName) .NE. TRIM(LAT_R(DataHandle)) .AND. TRIM(VarName) .NE. TRIM(LON_R(DataHandle)) .AND. &
+         TRIM(VarName) .NE. TRIM(LANDMASK_I(DataHandle)) ) THEN
+      IF ( .NOT. mcel_finalized( DataHandle ) ) THEN
+        IF ( ALLOCATED( xlat ) .AND. ALLOCATED( xlong ) ) THEN
+          CALL setLocationsXY( open_file_descriptors(2,DataHandle), xlong, xlat, ierr )
+          IF ( ierr .NE. 0 ) CALL wrf_error_fatal( "ext_mcel_write_field: setLocationsXY" )
+        ELSE IF ( deltax .gt. 0. .and. deltay .gt. 0. .and. originx .gt. 0. .and. originy .gt. 0. ) THEN
+          dxm(1) = deltax
+          dxm(2) = deltay
+          call SetDX ( open_file_descriptors(2,DataHandle), dxm, ierr)
+          origin(1) = originx
+          origin(2) = originy
+          call SetOrigin ( open_file_descriptors(2,DataHandle), origin, ierr)
+        ELSE
+          CALL wrf_error_fatal( "ext_mcel_write_field:noLocationsXY")
+        ENDIF
+        IF ( ALLOCATED(mask) ) THEN
+          CALL setMask ( open_file_descriptors(2,DataHandle) , mask, ierr )
+          IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: setMask")
+        ENDIF
+        CALL setGrid ( open_file_descriptors(1,DataHandle), open_file_descriptors(2,DataHandle), ierr )
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: setGrid")
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: setoutputgrid")
+        CALL finalize ( open_file_descriptors(1,DataHandle), ierr )
+        IF ( ierr .GT. 0 ) THEN
+           write(mess,*)'ext_mcel_write_field: finalize ierr=',ierr
+           CALL wrf_error_fatal( TRIM(mess) )
+        ENDIF
+        mcel_finalized( DataHandle ) = .TRUE.
+      ENDIF
+
+      timestr(1:4)   = DateStr(1:4)    ! YYYY
+      timestr(5:6)   = DateStr(6:7)    ! MM
+      timestr(7:8)   = DateStr(9:10)   ! DD
+      timestr(9:10)  = DateStr(12:13)  ! HH
+      timestr(11:12) = DateStr(15:16)  ! MM
+      timestr(13:14) = DateStr(18:19)  ! SS
+      CALL YYYYMMDDHHMMSS2SECS( timestr, data_time )
+
+      IF ( FieldType .EQ. WRF_INTEGER ) THEN
+        ALLOCATE(itemp(ips:ipe,jps:jpe))
+        DO j = jps, jpe
+          DO i = ips, ipe
+            idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+            itemp(i,j) = cast_to_int(Field( idex ))
+          ENDDO
+        ENDDO
+        CALL storeData( open_file_descriptors(1,DataHandle), TRIM(Varname), &
+                        itemp, &
+                        data_time, data_time,  &
+                        MCEL_TIMECENT_POINT, ierr )
+        DEALLOCATE(itemp)
+      ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+        ALLOCATE(dtemp(ips:ipe,jps:jpe))
+        CALL copy_field_to_cache_d2d ( Field, dtemp, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        CALL storeData( open_file_descriptors(1,DataHandle), TRIM(Varname), &
+                        dtemp, &
+                        data_time, data_time,  &
+                        MCEL_TIMECENT_POINT, ierr )
+        DEALLOCATE(dtemp)
+      ELSE IF ( FieldType .EQ. WRF_REAL ) THEN
+        ALLOCATE(temp(ips:ipe,jps:jpe))
+        CALL copy_field_to_cache_r2r ( Field, temp, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        CALL storeData( open_file_descriptors(1,DataHandle), TRIM(Varname), &
+                        temp, &
+                        data_time, data_time,  &
+                        MCEL_TIMECENT_POINT, ierr )
+        DEALLOCATE(temp)
+      ENDIF
+
+      IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: storeData")
+
+    ENDIF
+  ELSE   ! opened for training
+
+    ! sieve the fields coming in and grab the ones we need for geo registration
+    IF      ( TRIM(VarName) .EQ. TRIM(LAT_R(DataHandle)) ) THEN
+      IF ( ALLOCATED(xlat) ) THEN
+        DEALLOCATE(xlat)
+      ENDIF
+      ALLOCATE(xlat(ips:ipe,jps:jpe))
+      IF      ( FieldType .EQ. WRF_REAL ) THEN
+        CALL copy_field_to_cache_r2d ( Field, xlat, ips, ipe, jps, jpe, ims, ime, jms, jme )
+      ELSE IF (FieldType .EQ. WRF_DOUBLE ) THEN
+        CALL copy_field_to_cache_d2d ( Field, xlat, ips, ipe, jps, jpe, ims, ime, jms, jme )
+      ENDIF
+    ELSE IF ( TRIM(VarName) .EQ. TRIM(LON_R(DataHandle)) ) THEN
+      IF ( ALLOCATED(xlong) ) THEN
+        DEALLOCATE(xlong)
+      ENDIF
+      ALLOCATE(xlong(ips:ipe,jps:jpe))
+      IF      ( FieldType .EQ. WRF_REAL ) THEN
+        CALL copy_field_to_cache_r2d ( Field, xlong, ips, ipe, jps, jpe, ims, ime, jms, jme )
+      ELSE IF (FieldType .EQ. WRF_DOUBLE ) THEN
+        CALL copy_field_to_cache_d2d ( Field, xlong, ips, ipe, jps, jpe, ims, ime, jms, jme )
+      ENDIF
+    ELSE IF ( TRIM(VarName) .EQ. TRIM(LANDMASK_I(DataHandle)) ) THEN
+write(0,*)'write_field: ALLOCATED(mask)', ALLOCATED(mask)
+      IF ( ALLOCATED(mask) ) THEN
+        DEALLOCATE(mask)
+      ENDIF
+      ALLOCATE(mask(ips:ipe,jps:jpe))
+      IF ( FieldType .EQ. WRF_INTEGER ) THEN
+        CALL copy_field_to_cache_int ( Field, mask, ips, ipe, jps, jpe, ims, ime, jms, jme )
+      ELSE IF ( FieldType .EQ. WRF_REAL ) THEN
+        ALLOCATE(rmask(ips:ipe,jps:jpe))
+        CALL copy_field_to_cache_r2r ( Field, rmask, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        mask = NINT( rmask )
+        DEALLOCATE(rmask)
+      ELSE IF (FieldType .EQ. WRF_DOUBLE ) THEN
+        ALLOCATE(dmask(ips:ipe,jps:jpe))
+        CALL copy_field_to_cache_d2d ( Field, rmask, ips, ipe, jps, jpe, ims, ime, jms, jme )
+        mask = NINT( dmask )
+        DEALLOCATE(dmask)
+      ENDIF
+    ELSE
+      IF ( .NOT. mcel_grid_defined( DataHandle ) ) THEN
+        mcel_grid_defined( DataHandle ) = .true.
+
+        gSize(1) = ipe-ips+1
+        gSize(2) = jpe-jps+1
+        CALL setSize ( open_file_descriptors(2,DataHandle), gSize, ierr )
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: setSize")
+
+! these will have been set in the call to open_for_write_begin from sysdepinfo
+        IF ( mcel_npglobal .NE. -1 .AND. mcel_mystart .NE. -1 .AND.  &
+             mcel_mnproc   .NE. -1 .AND. mcel_myproc  .NE. -1     ) THEN
+          call setglobalsize(open_file_descriptors(2,DataHandle),mcel_npglobal,ierr)
+          call setglobalstart(open_file_descriptors(2,DataHandle),mcel_mystart,ierr)
+          call setprocinfo(open_file_descriptors(1,DataHandle),mcel_mnproc,mcel_myproc,ierr)
+        ENDIF
+        mcel_npglobal=-1 ; mcel_mystart=-1 ; mcel_mnproc=-1 ; mcel_myproc=-1
+
+      ENDIF
+      IF ( opened_for_read( DataHandle) ) THEN
+        CALL addSources ( open_file_descriptors(1,DataHandle), MCEL_SERVER,  &
+  &       TRIM(VarName),1, mcel_type, ierr )
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: addSources")
+        CALL addOutputs ( open_file_descriptors(1,DataHandle),   &
+  &       TRIM(VarName),1, mcel_type, ierr )
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: addOutputs")
+      ELSE
+        CALL addVar ( open_file_descriptors(1,DataHandle), TRIM(VarName), mcel_type, ierr )
+        IF ( ierr .NE. 0 ) CALL wrf_error_fatal("ext_mcel_write_field: addVar")
+      ENDIF
+    ENDIF
+  ENDIF
+  Status = 0
+  RETURN
+END SUBROUTINE ext_mcel_write_field
Index: trunk/WRF.COMMON/WRFV2/external/io_mcel/io_mcel.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_mcel/io_mcel.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_mcel/io_mcel.F90	(revision 2744)
@@ -0,0 +1,1187 @@
+MODULE module_ext_mcel
+
+  INTEGER, PARAMETER :: int_num_handles = 99
+  LOGICAL, DIMENSION(int_num_handles) :: okay_to_write, okay_to_read,                     &
+                                         opened_for_write, opened_for_update,             &
+                                         opened_for_read,                                 &
+                                         int_handle_in_use, okay_to_commit
+  LOGICAL, DIMENSION(int_num_handles) :: mcel_grid_defined, mcel_finalized
+  INTEGER, DIMENSION(int_num_handles) :: int_num_bytes_to_write
+  INTEGER, DIMENSION(int_num_handles) :: usemask
+  CHARACTER*256, DIMENSION(int_num_handles) :: CurrentDateInFile
+  CHARACTER*8092, DIMENSION(int_num_handles) :: ListOfFields
+  REAL, POINTER    :: int_local_output_buffer(:)
+  INTEGER          :: int_local_output_cursor
+  INTEGER          :: mcel_npglobal, mcel_mystart, mcel_mnproc, mcel_myproc
+
+  INTEGER, PARAMETER           :: onebyte = 1
+  INTEGER comm_io_servers, iserver, hdrbufsize, obufsize
+  INTEGER itypesize, rtypesize, typesize
+  INTEGER, DIMENSION(512)     :: hdrbuf
+  INTEGER, DIMENSION(int_num_handles)       :: handle
+  INTEGER, DIMENSION(512, int_num_handles)  :: open_file_descriptors
+  INCLUDE "MCEL.inc"
+  INCLUDE 'intio_tags.h'
+  INCLUDE 'wrf_io_flags.h'
+  INCLUDE 'wrf_status_codes.h'
+  CHARACTER*80  LAT_R(int_num_handles), LON_R(int_num_handles), LANDMASK_I(int_num_handles)
+
+  REAL*8, ALLOCATABLE :: xlat(:,:), xlong(:,:)
+  REAL*8              :: deltax, deltay, dxm(2)
+  REAL*8              :: originx, originy, origin(2)
+  INTEGER, ALLOCATABLE :: mask(:,:)
+  REAL, ALLOCATABLE :: rmask(:,:)
+  DOUBLEPRECISION, ALLOCATABLE :: dmask(:,:)
+
+  CHARACTER*132 last_next_var 
+
+  CONTAINS
+
+    LOGICAL FUNCTION int_valid_handle( handle )
+      IMPLICIT NONE
+      INTEGER, INTENT(IN) ::  handle
+      int_valid_handle = ( handle .ge. 8 .and. handle .le. int_num_handles ) 
+    END FUNCTION int_valid_handle
+
+    SUBROUTINE int_get_fresh_handle( retval )
+!      USE wrf_data, ONLY : wrf_data_handle
+!      USE ext_ncd_support_routines, ONLY : allocHandle
+!      type(wrf_data_handle),pointer     :: DH
+!      INTEGER i, retval, comm, Status
+      INTEGER i, retval
+
+#if 0
+      CALL allocHandle(retval,DH,Comm,Status)
+#endif
+
+      retval = -1
+! dont use first 8 handles
+      DO i = 8, int_num_handles
+        IF ( .NOT. int_handle_in_use(i) )  THEN
+          retval = i
+          GOTO 33
+        ENDIF
+      ENDDO
+33    CONTINUE
+      IF ( retval < 0 )  THEN
+        CALL wrf_error_fatal("external/io_quilt/io_int.F90: int_get_fresh_handle() can not")
+      ENDIF
+      int_handle_in_use(retval) = .TRUE.
+      NULLIFY ( int_local_output_buffer )
+    END SUBROUTINE int_get_fresh_handle
+
+! parse comma separated list of VARIABLE=VALUE strings and return the
+! value for the matching variable if such exists, otherwise return
+! the empty string
+SUBROUTINE get_value ( varname , str , retval )
+  IMPLICIT NONE
+  CHARACTER*(*) ::    varname
+  CHARACTER*(*) ::    str
+  CHARACTER*(*) ::    retval
+
+  CHARACTER (128) varstr, tstr
+  INTEGER i,j,n,varstrn
+  LOGICAL nobreak, nobreakouter
+
+  varstr = TRIM(varname)//"="
+  varstrn = len(TRIM(varstr))
+  n = len(TRIM(str))
+  retval = ""
+  i = 1
+  nobreakouter = .TRUE.
+  DO WHILE ( nobreakouter )
+    j = 1
+    nobreak = .TRUE.
+    tstr = ""
+    DO WHILE ( nobreak )
+      nobreak = .FALSE.
+      IF ( i .LE. n ) THEN
+        IF (str(i:i) .NE. ',' ) THEN
+           tstr(j:j) = str(i:i)
+           nobreak = .TRUE.
+        ENDIF
+      ENDIF
+      j = j + 1
+      i = i + 1
+    ENDDO
+    IF ( i .GT. n ) nobreakouter = .FALSE.
+    IF ( varstr(1:varstrn) .EQ. tstr(1:varstrn) ) THEN
+      retval(1:) = TRIM(tstr(varstrn+1:))
+      nobreakouter = .FALSE.
+    ENDIF
+  ENDDO
+  RETURN
+END SUBROUTINE get_value
+
+
+    !--- ioinit
+    SUBROUTINE init_module_ext_mcel
+      IMPLICIT NONE
+      CALL wrf_sizeof_integer( itypesize )
+      CALL wrf_sizeof_real   ( rtypesize )
+    END SUBROUTINE init_module_ext_mcel
+
+END MODULE module_ext_mcel
+
+ SUBROUTINE copy_field_to_cache_r2r ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
+   USE module_ext_mcel
+   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
+   INTEGER idex, i, j
+   REAL             Field(*)
+   REAL             cache(ips:ipe,jps:jpe)
+   DO j = jps, jpe
+     DO i = ips, ipe
+        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+        cache(i,j) = Field( idex )
+     ENDDO
+   ENDDO
+ END SUBROUTINE copy_field_to_cache_r2r
+
+ SUBROUTINE copy_field_to_cache_r2d ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
+   USE module_ext_mcel
+   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
+   INTEGER idex, i, j
+   REAL             Field(*)
+   DOUBLE PRECISION cache(ips:ipe,jps:jpe)
+   DO j = jps, jpe
+     DO i = ips, ipe
+        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+        cache(i,j) = Field( idex )
+     ENDDO
+   ENDDO
+ END SUBROUTINE copy_field_to_cache_r2d
+
+ SUBROUTINE copy_field_to_cache_d2r ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
+   USE module_ext_mcel
+   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
+   INTEGER idex, i, j
+   DOUBLE PRECISION Field(*) 
+   REAL             cache(ips:ipe,jps:jpe)
+   DO j = jps, jpe
+     DO i = ips, ipe
+        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+        cache(i,j) = Field( idex )
+     ENDDO
+   ENDDO
+ END SUBROUTINE copy_field_to_cache_d2r
+
+ SUBROUTINE copy_field_to_cache_d2d ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
+   USE module_ext_mcel
+   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
+   INTEGER idex, i, j
+   DOUBLE PRECISION Field(*) 
+   DOUBLE PRECISION cache(ips:ipe,jps:jpe)
+   DO j = jps, jpe
+     DO i = ips, ipe
+        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+        cache(i,j) = Field( idex )
+     ENDDO
+   ENDDO
+ END SUBROUTINE copy_field_to_cache_d2d
+
+ SUBROUTINE copy_field_to_cache_int ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
+   USE module_ext_mcel
+   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
+   INTEGER idex, i, j
+   INTEGER Field(*)
+   INTEGER cache(ips:ipe,jps:jpe)
+   DO j = jps, jpe
+     DO i = ips, ipe
+        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+        cache(i,j) = Field( idex )
+     ENDDO
+   ENDDO
+ END SUBROUTINE copy_field_to_cache_int
+
+ SUBROUTINE copy_cache_to_field_r2r ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
+   USE module_ext_mcel
+   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
+   INTEGER idex, i, j
+   REAL            cache(ips:ipe,jps:jpe)
+   REAL            Field(*)
+   DO j = jps, jpe
+     DO i = ips, ipe
+        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+        Field( idex ) = cache(i,j)
+     ENDDO
+   ENDDO
+ END SUBROUTINE copy_cache_to_field_r2r
+
+ SUBROUTINE copy_cache_to_field_r2d ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
+   USE module_ext_mcel
+   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
+   INTEGER idex, i, j
+   REAL             cache(ips:ipe,jps:jpe)
+   DOUBLEPRECISION  Field(*)
+   DO j = jps, jpe
+     DO i = ips, ipe
+        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+        Field( idex ) = cache(i,j)
+     ENDDO
+   ENDDO
+ END SUBROUTINE copy_cache_to_field_r2d
+
+ SUBROUTINE copy_cache_to_field_d2r ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
+   USE module_ext_mcel
+   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
+   INTEGER idex, i, j
+   DOUBLEPRECISION  cache(ips:ipe,jps:jpe)
+   REAL             Field(*)
+   DO j = jps, jpe
+     DO i = ips, ipe
+        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+        Field( idex ) = cache(i,j)
+     ENDDO
+   ENDDO
+ END SUBROUTINE copy_cache_to_field_d2r
+
+ SUBROUTINE copy_cache_to_field_d2d ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
+   USE module_ext_mcel
+   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
+   INTEGER idex, i, j
+   DOUBLEPRECISION  cache(ips:ipe,jps:jpe)
+   DOUBLEPRECISION  Field(*)
+   DO j = jps, jpe
+     DO i = ips, ipe
+        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+        Field( idex ) = cache(i,j)
+     ENDDO
+   ENDDO
+ END SUBROUTINE copy_cache_to_field_d2d
+
+!--------------
+
+SUBROUTINE ext_mcel_ioinit( SysDepInfo, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  CHARACTER*(*), INTENT(IN) :: SysDepInfo
+  INTEGER Status
+  CALL init_module_ext_mcel
+  Status = 0 
+END SUBROUTINE ext_mcel_ioinit
+
+!--- open_for_read 
+SUBROUTINE ext_mcel_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                               DataHandle , Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i
+
+  CALL int_get_fresh_handle(i)
+  okay_to_write(i) = .false.
+  DataHandle = i
+  CurrentDateInFile(i) = ""
+  Status = WRF_WARN_NOTSUPPORTED
+
+  RETURN  
+END SUBROUTINE ext_mcel_open_for_read
+
+
+!--- inquire_opened
+SUBROUTINE ext_mcel_inquire_opened ( DataHandle, FileName , FileStatus, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+
+  Status = 0
+
+  FileStatus = WRF_FILE_NOT_OPENED
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
+    IF      ( int_handle_in_use( DataHandle ) .AND. opened_for_read ( DataHandle ) ) THEN
+      IF ( okay_to_read ( DataHandle ) ) THEN
+        FileStatus = WRF_FILE_OPENED_FOR_READ
+      ELSE
+        FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+      ENDIF
+    ELSE IF ( int_handle_in_use( DataHandle ) .AND. opened_for_write ( DataHandle ) ) THEN
+      IF ( okay_to_write ( DataHandle ) ) THEN
+        FileStatus = WRF_FILE_OPENED_FOR_WRITE
+      ELSE
+        FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+      ENDIF
+    ENDIF
+  ENDIF
+  Status = 0
+  
+  RETURN
+END SUBROUTINE ext_mcel_inquire_opened
+
+!--- inquire_filename
+SUBROUTINE ext_mcel_inquire_filename ( DataHandle, FileName , FileStatus, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+  CHARACTER *80   SysDepInfo
+  Status = 0
+  FileStatus = WRF_FILE_NOT_OPENED
+  IF ( int_valid_handle( DataHandle ) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      IF ( opened_for_read ( DataHandle ) ) THEN
+        IF ( okay_to_read( DataHandle ) ) THEN
+           FileStatus = WRF_FILE_OPENED_FOR_READ
+        ELSE
+           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+        ENDIF
+      ELSE IF ( opened_for_write( DataHandle ) ) THEN
+        IF ( okay_to_write( DataHandle ) ) THEN
+           FileStatus = WRF_FILE_OPENED_FOR_WRITE
+        ELSE
+           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+        ENDIF
+      ELSE
+        FileStatus = WRF_FILE_NOT_OPENED
+      ENDIF
+    ENDIF
+  ENDIF
+  Status = 0
+END SUBROUTINE ext_mcel_inquire_filename
+
+!--- sync
+SUBROUTINE ext_mcel_iosync ( DataHandle, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  Status = 0
+  RETURN
+END SUBROUTINE ext_mcel_iosync
+
+!--- close
+SUBROUTINE ext_mcel_ioclose ( DataHandle, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER DataHandle, Status
+
+  IF ( int_valid_handle (DataHandle) ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      CLOSE ( DataHandle ) 
+    ENDIF
+  ENDIF
+
+  Status = 0
+
+  RETURN
+END SUBROUTINE ext_mcel_ioclose
+
+!--- ioexit
+SUBROUTINE ext_mcel_ioexit( Status )
+
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER                     :: DataHandle
+  INTEGER i,ierr
+  REAL dummy
+
+  RETURN  
+END SUBROUTINE ext_mcel_ioexit
+
+!--- get_next_time
+SUBROUTINE ext_mcel_get_next_time ( DataHandle, DateStr, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER         code
+  CHARACTER*132   locElement, dummyvar
+  INTEGER istat
+
+!local
+  INTEGER                        :: locDataHandle
+  CHARACTER*132                  :: locDateStr
+  CHARACTER*132                  :: locVarName
+  integer                        :: locFieldType
+  integer                        :: locComm
+  integer                        :: locIOComm
+  integer                        :: locDomainDesc
+  character*132                  :: locMemoryOrder
+  character*132                  :: locStagger
+  character*132 , dimension (3)  :: locDimNames
+  integer ,dimension(3)          :: locDomainStart, locDomainEnd
+  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
+  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
+
+  character*132 mess
+  integer ii,jj,kk,myrank
+  INTEGER inttypesize, realtypesize
+  REAL, DIMENSION( 1 ) :: Field
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_time: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_time: DataHandle not opened" )
+  ENDIF
+  inttypesize = itypesize
+  realtypesize = rtypesize
+
+  Status = WRF_WARN_NOTSUPPORTED
+
+  RETURN
+END SUBROUTINE ext_mcel_get_next_time
+
+!--- set_time
+SUBROUTINE ext_mcel_set_time ( DataHandle, DateStr, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+
+  Status = WRF_WARN_NOTSUPPORTED
+  RETURN
+END SUBROUTINE ext_mcel_set_time
+
+!--- get_var_info
+SUBROUTINE ext_mcel_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
+                              DomainStart , DomainEnd , WrfType, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: VarName
+  integer               ,intent(out)    :: NDim
+  character*(*)         ,intent(out)    :: MemoryOrder
+  character*(*)         ,intent(out)    :: Stagger
+  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
+  integer               ,intent(out)    :: WrfType
+  integer               ,intent(out)    :: Status
+
+!local
+  INTEGER                        :: locDataHandle
+  CHARACTER*132                  :: locDateStr
+  CHARACTER*132                  :: locVarName
+  integer                        :: locFieldType
+  integer                        :: locComm
+  integer                        :: locIOComm
+  integer                        :: locDomainDesc
+  character*132                  :: locMemoryOrder
+  character*132                  :: locStagger
+  character*132 , dimension (3)  :: locDimNames
+  integer ,dimension(3)          :: locDomainStart, locDomainEnd
+  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
+  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
+
+  character*132 mess
+  integer ii,jj,kk,myrank
+  INTEGER inttypesize, realtypesize, istat, code
+  REAL, DIMENSION( 1 ) :: Field
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_var_info: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_var_info: DataHandle not opened" )
+  ENDIF
+  inttypesize = itypesize
+  realtypesize = rtypesize
+  Status = 0
+
+RETURN
+END SUBROUTINE ext_mcel_get_var_info
+
+!--- get_next_var  (not defined for IntIO)
+SUBROUTINE ext_mcel_get_next_var ( DataHandle, VarName, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: VarName
+  INTEGER ,       INTENT(OUT) :: Status
+
+!local
+  INTEGER                        :: locDataHandle
+  CHARACTER*132                  :: locDateStr
+  CHARACTER*132                  :: locVarName
+  integer                        :: locFieldType
+  integer                        :: locComm
+  integer                        :: locIOComm
+  integer                        :: locDomainDesc
+  character*132                  :: locMemoryOrder
+  character*132                  :: locStagger
+  character*132 , dimension (3)  :: locDimNames
+  integer ,dimension(3)          :: locDomainStart, locDomainEnd
+  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
+  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
+
+character*128 locElement, strData, dumstr
+integer loccode, loccount
+integer idata(128)
+real    rdata(128)
+
+  character*132 mess
+  integer ii,jj,kk,myrank
+  INTEGER inttypesize, realtypesize, istat, code
+  REAL, DIMENSION( 1 ) :: Field
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_var: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_var: DataHandle not opened" )
+  ENDIF
+  inttypesize = itypesize
+  realtypesize = rtypesize
+
+  Status = 0
+
+  RETURN
+END SUBROUTINE ext_mcel_get_next_var
+
+!--- get_dom_ti_real
+SUBROUTINE ext_mcel_get_dom_ti_real ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Outcount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER loccount, code, istat, locDataHandle
+  CHARACTER*132                :: locElement, mess
+  LOGICAL keepgoing
+
+  Status = 0
+
+RETURN
+END SUBROUTINE ext_mcel_get_dom_ti_real 
+
+!--- put_dom_ti_real
+SUBROUTINE ext_mcel_put_dom_ti_real ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+!
+
+  Status = 0
+RETURN
+END SUBROUTINE ext_mcel_put_dom_ti_real 
+
+!--- get_dom_ti_double
+SUBROUTINE ext_mcel_get_dom_ti_double ( DataHandle,Element,   Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_mcel_get_dom_ti_double not supported yet')
+RETURN
+END SUBROUTINE ext_mcel_get_dom_ti_double 
+
+!--- put_dom_ti_double
+SUBROUTINE ext_mcel_put_dom_ti_double ( DataHandle,Element,   Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_mcel_put_dom_ti_double not supported yet')
+RETURN
+END SUBROUTINE ext_mcel_put_dom_ti_double 
+
+!--- get_dom_ti_integer
+SUBROUTINE ext_mcel_get_dom_ti_integer ( DataHandle,Element,   Data, Count, Outcount, Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER loccount, code, istat, locDataHandle
+  CHARACTER*132   locElement, mess
+  LOGICAL keepgoing
+
+  Status = 0
+RETURN
+END SUBROUTINE ext_mcel_get_dom_ti_integer 
+
+!--- put_dom_ti_integer
+SUBROUTINE ext_mcel_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  INTEGER ,       INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+!
+  Status = 0
+RETURN
+END SUBROUTINE ext_mcel_put_dom_ti_integer 
+
+!--- get_dom_ti_logical
+SUBROUTINE ext_mcel_get_dom_ti_logical ( DataHandle,Element,   Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_mcel_get_dom_ti_logical not supported yet')
+RETURN
+END SUBROUTINE ext_mcel_get_dom_ti_logical 
+
+!--- put_dom_ti_logical
+SUBROUTINE ext_mcel_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_message('ext_mcel_put_dom_ti_logical not supported yet')
+RETURN
+END SUBROUTINE ext_mcel_put_dom_ti_logical 
+
+!--- get_dom_ti_char
+SUBROUTINE ext_mcel_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER istat, code, i
+  CHARACTER*79 dumstr, locElement
+  INTEGER locDataHandle
+  LOGICAL keepgoing
+
+  Status = 0
+RETURN
+END SUBROUTINE ext_mcel_get_dom_ti_char 
+
+!--- put_dom_ti_char
+SUBROUTINE ext_mcel_put_dom_ti_char ( DataHandle, Element,  Data,  Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i
+  REAL dummy
+  INTEGER                 :: Count
+
+! TBH:  Not sure what this is doing here.  2004_11_15
+! JGM:  You are right. It does not belong here.  2006_09_28
+!  IF ( int_valid_handle ( Datahandle ) ) THEN
+!    IF ( int_handle_in_use( DataHandle ) ) THEN
+!      CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize,  &
+!                                   DataHandle, Element, "", Data, int_dom_ti_char )
+!      WRITE( unit=DataHandle ) hdrbuf 
+!    ENDIF
+!  ENDIF
+  Status = 0
+RETURN
+END SUBROUTINE ext_mcel_put_dom_ti_char 
+
+!--- get_dom_td_real
+SUBROUTINE ext_mcel_get_dom_td_real ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_dom_td_real 
+
+!--- put_dom_td_real
+SUBROUTINE ext_mcel_put_dom_td_real ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_dom_td_real 
+
+!--- get_dom_td_double
+SUBROUTINE ext_mcel_get_dom_td_double ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_dom_td_double 
+
+!--- put_dom_td_double
+SUBROUTINE ext_mcel_put_dom_td_double ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_dom_td_double 
+
+!--- get_dom_td_integer
+SUBROUTINE ext_mcel_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_dom_td_integer 
+
+!--- put_dom_td_integer
+SUBROUTINE ext_mcel_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_dom_td_integer 
+
+!--- get_dom_td_logical
+SUBROUTINE ext_mcel_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_dom_td_logical 
+
+!--- put_dom_td_logical
+SUBROUTINE ext_mcel_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_dom_td_logical 
+
+!--- get_dom_td_char
+SUBROUTINE ext_mcel_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_dom_td_char 
+
+!--- put_dom_td_char
+SUBROUTINE ext_mcel_put_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_dom_td_char 
+
+!--- get_var_ti_real
+SUBROUTINE ext_mcel_get_var_ti_real ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_var_ti_real 
+
+!--- put_var_ti_real
+SUBROUTINE ext_mcel_put_var_ti_real ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_var_ti_real 
+
+!--- get_var_ti_double
+SUBROUTINE ext_mcel_get_var_ti_double ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_var_ti_double 
+
+!--- put_var_ti_double
+SUBROUTINE ext_mcel_put_var_ti_double ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_var_ti_double 
+
+!--- get_var_ti_integer
+SUBROUTINE ext_mcel_get_var_ti_integer ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_var_ti_integer 
+
+!--- put_var_ti_integer
+SUBROUTINE ext_mcel_put_var_ti_integer ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_var_ti_integer 
+
+!--- get_var_ti_logical
+SUBROUTINE ext_mcel_get_var_ti_logical ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_var_ti_logical 
+
+!--- put_var_ti_logical
+SUBROUTINE ext_mcel_put_var_ti_logical ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_var_ti_logical 
+
+!--- get_var_ti_char
+SUBROUTINE ext_mcel_get_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER locDataHandle, code
+  CHARACTER*132 locElement, locVarName
+  Status = 0
+RETURN
+END SUBROUTINE ext_mcel_get_var_ti_char 
+
+!--- put_var_ti_char
+SUBROUTINE ext_mcel_put_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+  REAL dummy
+  INTEGER                 :: Count
+  Status = 0
+RETURN
+END SUBROUTINE ext_mcel_put_var_ti_char 
+
+!--- get_var_td_real
+SUBROUTINE ext_mcel_get_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_var_td_real 
+
+!--- put_var_td_real
+SUBROUTINE ext_mcel_put_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_var_td_real 
+
+!--- get_var_td_double
+SUBROUTINE ext_mcel_get_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_var_td_double 
+
+!--- put_var_td_double
+SUBROUTINE ext_mcel_put_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_var_td_double 
+
+!--- get_var_td_integer
+SUBROUTINE ext_mcel_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_var_td_integer 
+
+!--- put_var_td_integer
+SUBROUTINE ext_mcel_put_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_var_td_integer 
+
+!--- get_var_td_logical
+SUBROUTINE ext_mcel_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_var_td_logical 
+
+!--- put_var_td_logical
+SUBROUTINE ext_mcel_put_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_var_td_logical 
+
+!--- get_var_td_char
+SUBROUTINE ext_mcel_get_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_get_var_td_char 
+
+!--- put_var_td_char
+SUBROUTINE ext_mcel_put_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: Element
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName 
+  CHARACTER*(*) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_mcel_put_var_td_char 
+
+SUBROUTINE ext_mcel_georegister( DataHandle, inlon, inlat,                                    &
+                                 MemoryStart , MemoryEnd ,                                    &
+                                 PatchStart , PatchEnd ,                                      &
+                                 Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  integer                       ,intent(in)    :: DataHandle
+  integer                       ,intent(inout) :: Status
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  REAL , DIMENSION(MemoryStart(1):MemoryEnd(1),MemoryStart(2):MemoryEnd(2)), INTENT(IN) :: inlon, inlat
+  integer ips,ipe,jps,jpe
+  integer ims,ime,jms,jme
+  integer idex,ierr,i,j
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_mcel_georegister: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_mcel_georegister: DataHandle not opened" )
+  ENDIF
+  IF ( mcel_finalized( DataHandle ) ) THEN
+    CALL wrf_error_fatal( "ext_mcel_georegister: called after first read/write operation" ) ;
+  ENDIF
+
+  ips = PatchStart(1) ; ipe = PatchEnd(1)
+  jps = PatchStart(2) ; jpe = PatchEnd(2)
+  ims = MemoryStart(1) ; ime = MemoryEnd(1)
+  jms = MemoryStart(2) ; jme = MemoryEnd(2)
+
+  IF ( ALLOCATED(xlat) ) THEN
+    DEALLOCATE(xlat)
+  ENDIF
+  IF ( ALLOCATED(xlong) ) THEN
+    DEALLOCATE(xlong)
+  ENDIF
+  ALLOCATE(xlat(ips:ipe,jps:jpe))
+  DO j = jps, jpe
+    DO i = ips, ipe
+      idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+      xlat(i,j) = inlat( i,j)  ! idex )
+    ENDDO
+  ENDDO
+  ALLOCATE(xlong(ips:ipe,jps:jpe))
+  DO j = jps, jpe
+    DO i = ips, ipe
+      idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+      xlong(i,j) = inlon( i,j ) ! idex )
+    ENDDO
+  ENDDO
+  RETURN
+END SUBROUTINE ext_mcel_georegister
+
+SUBROUTINE ext_mcel_mask ( DataHandle, inmask,                                          &
+                           MemoryStart , MemoryEnd ,                                    &
+                           PatchStart , PatchEnd ,                                      &
+                           Status )
+  USE module_ext_mcel
+  IMPLICIT NONE
+  integer                       ,intent(in)    :: DataHandle
+  integer                       ,intent(inout) :: Status
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  INTEGER , DIMENSION(MemoryStart(1):MemoryEnd(1),MemoryStart(2):MemoryEnd(2)), INTENT(IN) :: inmask
+  integer ips,ipe,jps,jpe
+  integer ims,ime,jms,jme
+  integer idex,ierr,i,j
+
+  ips = PatchStart(1) ; ipe = PatchEnd(1)
+  jps = PatchStart(2) ; jpe = PatchEnd(2)
+  ims = MemoryStart(1) ; ime = MemoryEnd(1)
+  jms = MemoryStart(2) ; jme = MemoryEnd(2)
+
+  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_mcel_mask: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("ext_mcel_mask: DataHandle not opened" )
+  ENDIF
+  IF ( mcel_finalized( DataHandle ) ) THEN
+    CALL wrf_error_fatal( "ext_mcel_mask: called after first read/write operation" ) ;
+  ENDIF
+
+  IF ( ALLOCATED(mask) ) THEN
+    DEALLOCATE(mask)
+  ENDIF
+  ALLOCATE(mask(ips:ipe,jps:jpe))
+  DO j = jps, jpe
+    DO i = ips, ipe
+      idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
+      mask(i,j) = inmask( i,j ) ! idex )
+    ENDDO
+  ENDDO
+  RETURN
+END SUBROUTINE ext_mcel_mask
+
+INTEGER FUNCTION cast_to_int( a )
+  INTEGER a
+  cast_to_int = a
+  RETURN
+END FUNCTION cast_to_int
+
Index: trunk/WRF.COMMON/WRFV2/external/io_mcel/makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_mcel/makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_mcel/makefile	(revision 2744)
@@ -0,0 +1,35 @@
+#makefile to build io_mcel that does binary i/o
+
+OBJSL   = io_mcel.o ext_mcel_open_for_read.o ext_mcel_open_for_write.o ext_mcel_read_field.o ext_mcel_write_field.o
+OBJS    = $(OBJSL)
+OPTS    =
+FFLAGS  =  $(OPTS) -w -g
+LIBS    = 
+CPP     = /lib/cpp  -P $(TRADFLAG)
+M4      = m4 -Uinclude -Uindex -Ulen
+AR      = ar
+RANLIB  = echo
+
+.SUFFIXES:      .F90 .F .f .o .code
+
+all : libwrfio_mcel.a
+
+libwrfio_mcel.a:		$(OBJS)
+			/bin/rm -f libwrfio_mcel.a
+			$(AR) cr libwrfio_mcel.a $(OBJSL)
+			$(RANLIB) libwrfio_mcel.a
+
+.F90.o:
+			$(CPP) $*.F90 | $(M4) - > $*.f
+			$(FC) $(FFLAGS) -I../ioapi_share -c $*.f
+
+superclean:
+			/bin/rm -f *.f *.o libwrfio_mcel.a
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+ext_mcel_open_for_read.o : io_mcel.o
+ext_mcel_open_for_write.o : io_mcel.o
+ext_mcel_read_field.o : io_mcel.o
+ext_mcel_write_field.o : io_mcel.o
+
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/README
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/README	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/README	(revision 2744)
@@ -0,0 +1,38 @@
+This is a tar file of the WRF NetCDF I/O library.
+
+The tar file contains these files:
+
+-rw-r--r--   1 jacquesm ad           1968 Nov 27 13:43 README
+-rw-r--r--   1 jacquesm ad          15121 Nov 27 11:44 WRFIO.doc
+-rw-r--r--   1 jacquesm ad           4447 Nov 14 16:26 ext_get_glb_md.code
+-rw-r--r--   1 jacquesm ad           5068 Nov 17 14:56 ext_get_var_md.code
+-rw-r--r--   1 jacquesm ad           6766 Nov 17 15:12 ext_get_vartime_md.code
+-rw-r--r--   1 jacquesm ad           4106 Nov 14 15:04 ext_put_glb_md.code
+-rw-r--r--   1 jacquesm ad           4124 Nov 14 15:04 ext_put_var_md.code
+-rw-r--r--   1 jacquesm ad           7147 Nov 14 15:04 ext_put_vartime_md.code
+-rw-r--r--   1 jacquesm ad           6222 Nov 27 11:30 field_routines.F90
+-rw-r--r--   1 jacquesm ad             47 Oct 18 11:59 howto.ncdump
+-rw-r--r--   1 jacquesm ad           1218 Oct 26 15:16 makefile
+-rw-r--r--   1 jacquesm ad           2546 Nov 16 12:53 testWRFReadXYZ.F90
+-rw-r--r--   1 jacquesm ad           9555 Nov 27 11:25 testWRFReadfoo2.F90
+-rw-r--r--   1 jacquesm ad           7354 Nov 27 11:23 testWRFReadjfm.F90
+-rw-r--r--   1 jacquesm ad           2994 Nov 16 12:53 testWRFWriteXYZ.F90
+-rw-r--r--   1 jacquesm ad          16391 Nov 27 11:25 testWRFWritefoo2.F90
+-rw-r--r--   1 jacquesm ad           8896 Nov 27 11:25 testWRFWritejfm.F90
+-rw-r--r--   1 jacquesm ad            462 Oct 27 16:44 transpose.code
+-rw-r--r--   1 jacquesm ad          78533 Nov 27 11:22 wrf_io.F90
+-rw-r--r--   1 jacquesm ad           2715 Nov 21 12:06 wrf_status_codes.h
+
+The test* routines are test programs and one pair must be copied to
+testWRFWrite.F90 and testWRFRead.F90.  The other files comprise the WRF
+NetCDF I/O library.  In the makefile, you may need to redefine the path to
+NetCDF.  To run the test files, do:
+
+     make
+     testWRFWrite
+     testWRFRead
+
+testWRFWrite will create a NetCDF file called foo.nc and testWRFRead will
+read it.  Status codes and some values will be printed.
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/diffwrf.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/diffwrf.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/diffwrf.F90	(revision 2744)
@@ -0,0 +1,456 @@
+module read_util_module
+
+#ifdef crayx1
+#define iargc ipxfargc
+#endif
+
+contains
+
+#ifdef crayx1
+   subroutine getarg(i, harg)
+     implicit none
+     character(len=*) :: harg
+     integer :: ierr, ilen, i
+
+     call pxfgetarg(i, harg, ilen, ierr)
+     return
+   end subroutine getarg
+#endif
+
+   subroutine arguments(v2file, lmore)
+     implicit none
+     character(len=*) :: v2file
+     character(len=120) :: harg
+     logical :: lmore
+   
+     integer :: ierr, i, numarg
+     integer, external :: iargc
+   
+     numarg = iargc()
+   
+     i = 1
+     lmore = .false.
+   
+     do while ( i < numarg) 
+        call getarg(i, harg)
+        print*, 'harg = ', trim(harg)
+   
+        if (harg == "-v") then
+           i = i + 1
+           lmore = .true.
+        elseif (harg == "-h") then
+           call help
+        endif
+   
+     enddo
+   
+     call getarg(i,harg)
+     v2file = harg
+   end subroutine arguments
+   
+   subroutine help
+     implicit none
+     character(len=120) :: cmd
+     call getarg(0, cmd)
+   
+     write(*,'(/,"Usage: ", A, " [-v] v2file ")') trim(cmd)
+     write(*,'(8x, "-v     : Print extra info")')
+     write(*,'(8x, "v3file : MM5v3 file name to read.")')
+     write(*,'(8x, "-h     : print this help message and exit.",/)')
+     stop
+   end subroutine help
+end module read_util_module
+
+
+
+ program readv3
+  use wrf_data
+  use read_util_module
+  implicit none
+#include "wrf_status_codes.h"
+#include "netcdf.inc"
+  character(len=120) :: flnm
+  character(len=120) :: flnm2
+  character(len=120) :: arg3
+  character(len=19) :: DateStr
+  character(len=19) :: DateStr2
+  character(len=31) :: VarName
+  character(len=31) :: VarName2
+  integer dh1, dh2
+
+  integer :: flag, flag2
+  integer :: iunit, iunit2
+
+  integer :: i,j,k
+  integer :: levlim
+  integer :: cross
+  integer :: ndim, ndim2
+  integer :: WrfType, WrfType2
+  real :: time, time2
+  real*8 :: a, b
+  real*8 :: sumE, sum1, sum2, diff1, diff2, serr, perr, rmse, rms1, rms2, tmp1, tmp2
+  integer digits,d1, d2
+  integer, dimension(4) :: start_index, end_index, start_index2, end_index2
+  integer , Dimension(3) :: MemS,MemE,PatS,PatE
+  character (len= 4) :: staggering,   staggering2
+  character (len= 3) :: ordering,     ordering2, ord
+  character (len=24) :: start_date,   start_date2
+  character (len=24) :: current_date, current_date2
+  character (len=31) :: name,         name2,  tmpname
+  character (len=25) :: units,        units2
+  character (len=46) :: description,  description2
+
+  character (len=80), dimension(3)  ::  dimnames
+  character (len=80) :: SysDepInfo
+
+  integer :: l, n
+  integer :: ikdiffs, ifdiffs
+
+  real, allocatable, dimension(:,:,:,:) :: data,data2
+
+  integer :: ierr, ierr2, ier, ier2, Status, Status_next_time, Status_next_time2, Status_next_var, Status_next_var_2
+
+  logical :: newtime = .TRUE.
+  logical :: justplot, efound
+
+  integer, external :: iargc
+  logical, external :: iveceq
+
+  levlim = -1
+
+  call ext_ncd_ioinit(SysDepInfo,Status)
+  call set_wrf_debug_level ( 1 )
+
+
+  Justplot = .false.
+! get arguments
+  if ( iargc() .ge. 2 ) then
+    call getarg(1,flnm)
+    call getarg(2,flnm2)
+    ierr = 0
+    call ext_ncd_open_for_read( trim(flnm), 0, 0, "", dh1, Status)
+    if ( Status /= 0 ) then 
+      print*,'error opening ',flnm, ' Status = ', Status ; stop 
+    endif
+    call ext_ncd_open_for_read( trim(flnm2), 0, 0, "", dh2, Status)
+    if ( Status /= 0 ) go to 923
+    goto 924
+923    continue
+
+! bounce here if second name is not openable -- this would mean that
+! it is a field name instead.
+
+    print*,'could not open ',flnm2
+    name = flnm2
+    Justplot = .true.
+924    continue
+  if ( iargc() .eq. 3 ) then
+    call getarg(3,arg3)
+    read(arg3,*)levlim
+    print*,'LEVLIM = ',LEVLIM
+  endif
+  else
+     print*,'Usage: command file1 file2'
+     stop
+  endif
+
+print*,'Just plot ',Justplot
+
+if ( Justplot ) then
+  print*, 'flnm = ', trim(flnm)
+
+  call ext_ncd_get_next_time(dh1, DateStr, Status_next_time)
+
+  DO WHILE ( Status_next_time .eq. 0 )
+    write(*,*)'Next Time ',TRIM(Datestr)
+    call ext_ncd_get_next_var (dh1, VarName, Status_next_var)
+    DO WHILE ( Status_next_var .eq. 0 )
+!    write(*,*)'Next Var |',TRIM(VarName),'|'
+
+      start_index = 1
+      end_index = 1
+      call ext_ncd_get_var_info (dh1,VarName,ndim,ordering,staggering,start_index,end_index, WrfType, ierr )
+      if(WrfType /= WRF_REAL .AND. WrfType /= WRF_DOUBLE) then 
+        call ext_ncd_get_next_var (dh1, VarName, Status_next_var) 
+        cycle 
+      endif 
+      write(*,'(A9,1x,I1,3(1x,I5),1x,A,1x,A)')&
+               VarName, ndim, end_index(1), end_index(2), end_index(3), &
+               trim(ordering), trim(DateStr)
+
+      if ( VarName .eq. name ) then
+        write(*,*)'Writing fort.88 file for ', trim(name)
+
+        allocate(data(end_index(1), end_index(2), end_index(3), 1))
+
+        if ( ndim .eq. 3 ) then
+          ord = 'XYZ'
+        else if ( ndim .eq. 2 ) then
+          ord = 'XY'
+        else if ( ndim .eq. 1 ) then
+          ord = 'Z'
+        else if ( ndim .eq. 0 ) then
+          ord = '0'
+        endif
+
+        call ext_ncd_read_field(dh1,DateStr,TRIM(name),data,WRF_REAL,0,0,0,ord, &
+                            staggering, dimnames ,                      &
+                            start_index,end_index,                      & !dom
+                            start_index,end_index,                      & !mem
+                            start_index,end_index,                      & !pat
+                            ierr)
+
+        if ( ierr/=0 ) then
+             write(*,*)'error reading data record'
+             write(*,*)'  ndim = ', ndim
+             write(*,*)'  end_index(1) ',end_index(1)
+             write(*,*)'  end_index(2) ',end_index(2)
+             write(*,*)'  end_index(3) ',end_index(3)
+        endif
+
+
+#if 0
+! uncomment this to have the code give i-slices 
+        do i = 1, end_index(1)
+          if ( levlim .eq. -1 .or. i .eq. levlim ) then
+            write(88,*)end_index(2),end_index(3),' ',trim(name),' ',k,' time ',TRIM(Datestr)
+            do k = start_index(3), end_index(3)
+            do j = 1, end_index(2)
+                write(88,*) data(i,j,k,1)
+              enddo
+            enddo
+          endif
+        enddo
+#else
+! give k-slices 
+        do k = start_index(3), end_index(3)
+          if ( levlim .eq. -1 .or. k .eq. levlim ) then
+            write(88,*)end_index(1),end_index(2),' ',trim(name),' ',k,' time ',TRIM(Datestr)
+            do j = 1, end_index(2)
+              do i = 1, end_index(1)
+                write(88,*) data(i,j,k,1)
+              enddo
+            enddo
+          endif
+        enddo
+#endif
+
+        deallocate(data)
+      endif
+      call ext_ncd_get_next_var (dh1, VarName, Status_next_var)
+    enddo
+    call ext_ncd_get_next_time(dh1, DateStr, Status_next_time)
+  enddo
+else
+  print*,'Diffing ',trim(flnm),' ',trim(flnm2)
+
+  call ext_ncd_get_next_time(dh1, DateStr, Status_next_time)
+  call ext_ncd_get_next_time(dh2, DateStr2, Status_next_time2)
+
+  IF ( DateStr .NE. DateStr2 ) THEN
+    print*,'They differ big time.  Dates do not match'
+    print*,'   ',flnm,' ',DateStr
+    print*,'   ',flnm2,' ',DateStr2
+    Status_next_time = 1
+  ENDIF
+
+  DO WHILE ( Status_next_time .eq. 0 .AND. Status_next_time2 .eq. 0 )
+    write(*,*)'Next Time ',TRIM(Datestr)
+    print 76
+    call ext_ncd_get_next_var (dh1, VarName, Status_next_var)
+    DO WHILE ( Status_next_var .eq. 0 )
+!    write(*,*)'Next Var |',TRIM(VarName),'|'
+
+      start_index = 1
+      end_index = 1
+      start_index2 = 1
+      end_index2 = 1
+
+      call ext_ncd_get_var_info (dh1,VarName,ndim,ordering,staggering,start_index,end_index, WrfType, ierr )
+      call ext_ncd_get_var_info (dh2,VarName,ndim2,ordering2,staggering2,start_index2,end_index2, WrfType2, ierr )
+      IF ( ierr /= 0 ) THEN
+        write(*,*)'Big difference: ',VarName,' not found in ',flnm2
+        GOTO 1234
+      ENDIF
+      IF ( ndim /= ndim2 ) THEN
+        write(*,*)'Big difference: Number of dimensions for ',Varname,' differs in ',flnm2,'(',ndim,') /= (',ndim2
+        GOTO 1234
+      ENDIF
+      IF ( WrfType /= WrfType2 ) THEN
+        write(*,*)'Big difference: The types do not match'
+        GOTO 1234
+      ENDIF
+      if( WrfType == WRF_REAL) then
+        DO i = 1, ndim
+          IF ( end_index(i) /= end_index2(i) ) THEN
+            write(*,*)'Big difference: dim ',i,' lengths differ for ',Varname,' differ in ',flnm2
+            GOTO 1234
+          ENDIF
+        ENDDO
+        DO i = ndim+1,3
+          start_index(i) = 1
+          end_index(i) = 1
+          start_index2(i) = 1
+          end_index2(i) = 1
+        ENDDO
+
+!        write(*,'(A9,1x,I1,3(1x,I3),1x,A,1x,A)')&
+!                 VarName, ndim, end_index(1), end_index(2), end_index(3), &
+!                 trim(ordering), trim(DateStr)
+
+        allocate(data (end_index(1), end_index(2), end_index(3), 1))
+        allocate(data2(end_index(1), end_index(2), end_index(3), 1))
+
+        if ( ndim .eq. 3 ) then
+          ord = 'XYZ'
+        else if ( ndim .eq. 2 ) then
+          ord = 'XY'
+        else if ( ndim .eq. 1 ) then
+          ord = 'Z'
+        else if ( ndim .eq. 0 ) then
+          ord = '0'
+        endif
+
+        call ext_ncd_read_field(dh1,DateStr,TRIM(VarName),data,WRF_REAL,0,0,0,ord,&
+                            staggering, dimnames ,                      &
+                            start_index,end_index,                      & !dom 
+                            start_index,end_index,                      & !mem
+                            start_index,end_index,                      & !pat
+                            ierr)
+
+        IF ( ierr /= 0 ) THEN
+          write(*,*)'Error reading ',Varname,' from ',flnm
+          write(*,*)'  ndim = ', ndim
+          write(*,*)'  end_index(1) ',end_index(1)
+          write(*,*)'  end_index(2) ',end_index(2)
+          write(*,*)'  end_index(3) ',end_index(3)
+        ENDIF
+        call ext_ncd_read_field(dh2,DateStr,TRIM(VarName),data2,WRF_REAL,0,0,0,ord,&
+                            staggering, dimnames ,                      &
+                            start_index,end_index,                      & !dom 
+                            start_index,end_index,                      & !mem
+                            start_index,end_index,                      & !pat
+                            ierr)
+        IF ( ierr /= 0 ) THEN
+          write(*,*)'Error reading ',Varname,' from ',flnm2
+          write(*,*)'  ndim = ', ndim
+          write(*,*)'  end_index(1) ',end_index(1)
+          write(*,*)'  end_index(2) ',end_index(2)
+          write(*,*)'  end_index(3) ',end_index(3)
+        ENDIF
+
+        IFDIFFS=0
+        sumE = 0.0
+        sum1 = 0.0
+        sum2 = 0.0
+        diff1 = 0.0
+        diff2 = 0.0
+        n = 0 
+        DO K = 1,end_index(3)-start_index(3)+1
+         IF (LEVLIM.EQ.-1.OR.K.EQ.LEVLIM.OR.NDIM.eq.2) THEN
+          cross = 0 
+          IKDIFFS = 0
+          do i = 1, end_index(1)-cross
+            do j = 1, end_index(2)-cross
+              a = data(I,J,K,1)
+              b = data2(I,J,K,1)
+              ! borrowed from  Thomas Oppe's comp program
+              sumE = sumE + ( a - b ) * ( a - b )
+              sum1 = sum1 + a * a
+              sum2 = sum2 + b * b
+              diff1 = max ( diff1 , abs ( a - b ) )
+              diff2 = max ( diff2 , abs ( b ) )
+              n = n + 1
+              IF (a .ne. b) then
+                IKDIFFS = IKDIFFS + 1
+                IFDIFFS = IFDIFFS + 1
+              ENDIF
+            ENDDO
+          ENDDO
+         ENDIF
+        enddo
+        rmsE = sqrt ( sumE / dble( n ) )
+        rms1 = sqrt ( sum1 / dble( n ) )
+        rms2 = sqrt ( sum2 / dble( n ) )
+        serr = 0.0
+        IF ( sum2 .GT. 0.0d0 ) THEN
+          serr = sqrt ( sumE / sum2 )
+        ELSE
+          IF ( sumE .GT. 0.0d0 ) serr = 1.0
+        ENDIF
+        perr = 0.0
+        IF ( diff2 .GT. 0.0d0 ) THEN
+          perr = diff1/diff2
+        ELSE
+          IF ( diff1 .GT. 0.0d0 ) perr = 1.0
+        ENDIF
+
+        IF ( rms1 - rms2 .EQ. 0.0d0 ) THEN
+          digits = 15
+        ELSE
+          IF ( rms2 .NE. 0 ) THEN
+            tmp1 = 1.0d0/( ( abs( rms1 - rms2 ) ) / rms2 )
+            IF ( tmp1 .NE. 0 ) THEN
+              digits = log10(tmp1)
+            ENDIF
+          ENDIF
+        ENDIF
+
+        IF (IFDIFFS .NE. 0 ) THEN
+           ! create the fort.88 and fort.98 files because regression scripts will
+           ! look for these to see if there were differences.
+           write(88,*)trim(varname)
+           write(98,*)trim(varname)
+           PRINT 77,trim(varname), IFDIFFS, ndim, rms1, rms2, digits, rmsE, perr
+ 76 FORMAT (5x,'Field ',2x,'Ndifs',4x,'Dims ',6x,'RMS (1)',12x,'RMS (2)',5x,'DIGITS',4x,'RMSE',5x,'pntwise max')
+ 77 FORMAT ( A10,1x,I9,2x,I3,1x,e18.10,1x,e18.10,1x,i3,1x,e12.4,1x,e12.4 )
+        ENDIF
+        deallocate(data)
+        deallocate(data2)
+
+      endif
+ 1234 CONTINUE
+      call ext_ncd_get_next_var (dh1, VarName, Status_next_var)
+    enddo
+    call ext_ncd_get_next_time(dh1, DateStr, Status_next_time)
+    call ext_ncd_get_next_time(dh2, DateStr2, Status_next_time2)
+    IF ( DateStr .NE. DateStr2 ) THEN
+      print*,'They differ big time.  Dates do not match'
+      print*,'They differ big time.  Dates do not match'
+      print*,'   ',flnm,' ',DateStr
+      print*,'   ',flnm2,' ',DateStr2
+      Status_next_time = 1
+    ENDIF
+  enddo
+
+endif
+
+end program readv3
+
+logical function iveceq( a, b, n )
+  implicit none
+  integer n
+  integer a(n), b(n)
+  integer i
+  iveceq = .true.
+  do i = 1,n
+    if ( a(i) .ne. b(i) ) iveceq = .false.
+  enddo
+  return
+end function iveceq
+
+! stubs for routines called by module_wrf_error (used by netcdf implementation of IO api)
+SUBROUTINE wrf_abort
+  STOP
+END SUBROUTINE wrf_abort
+
+SUBROUTINE get_current_time_string( time_str )
+  CHARACTER(LEN=*), INTENT(OUT) :: time_str
+  time_str = ''
+END SUBROUTINE get_current_time_string
+
+SUBROUTINE get_current_grid_name( grid_str )
+  CHARACTER(LEN=*), INTENT(OUT) :: grid_str
+  grid_str = ''
+END SUBROUTINE get_current_grid_name
+
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_dom_ti.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_dom_ti.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_dom_ti.code	(revision 2744)
@@ -0,0 +1,157 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  TYPE_DATA
+  TYPE_COUNT
+  TYPE_OUTCOUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: XType
+  integer                               :: Len
+  integer                               :: stat
+  TYPE_BUFFER
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg) 
+    return
+  endif
+! Do nothing unless it is time to read time-independent domain metadata.  
+IF ( ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED   
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ   
+    write(msg,*) &
+'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE   
+    write(msg,*) &
+'Warning READ WRITE ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    stat = NF_INQ_ATT(DH%NCID,NF_GLOBAL,Element, XType, Len)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then
+      if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then
+        Status = WRF_WARN_TYPE_MISMATCH   
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    else
+      if( XType/=NF_TYPE) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    endif
+    if(Len<=0) then
+      Status = WRF_WARN_LENGTH_LESS_THAN_1  
+      write(msg,*) &
+'Warning LENGTH < 1 in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+#ifndef CHAR_TYPE 
+    allocate(Buffer(Len), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR  
+      write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,Buffer)
+#else
+    Data = ''
+    stat = NF_GET_ATT_TEXT(DH%NCID,NF_GLOBAL,Element,Data)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+#ifndef CHAR_TYPE 
+    COPY
+    deallocate(Buffer, STAT=stat)
+    if(stat/= WRF_NO_ERR) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
+      write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    if(Len > Count) then
+      OutCount = Count
+      Status = WRF_WARN_MORE_DATA_IN_FILE  
+    else
+      OutCount = Len
+      Status = WRF_NO_ERR
+    endif
+#endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS  
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+ENDIF
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_var_td.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_var_td.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_var_td.code	(revision 2744)
@@ -0,0 +1,227 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'netcdf.inc'
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character (DateStrLen),intent(in)     :: DateStr
+  character*(*)         ,intent(in)     :: Var
+  TYPE_DATA
+  TYPE_COUNT
+  TYPE_OUTCOUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  character (VarNameLen)                :: VarName
+  character (40+len(Element))           :: Name
+  character (40+len(Element))           :: FName
+  integer                               :: stat
+  TYPE_BUFFER           ,allocatable    :: Buffer(:)
+  integer                               :: i
+  integer                               :: VDims (2)
+  integer                               :: VStart(2)
+  integer                               :: VCount(2)
+  integer                               :: NVar
+  integer                               :: TimeIndex
+  integer                               :: NCID
+  integer                               :: DimIDs(2)
+  integer                               :: VarID
+  integer                               :: XType
+  integer                               :: NDims
+  integer                               :: NAtts
+  integer                               :: Len1
+
+  if(Count <= 0) then
+    Status = WRF_WARN_ZERO_LENGTH_GET  
+    write(msg,*) &
+'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  VarName = Var
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  NCID = DH%NCID
+  call GetName(Element, VarName, Name, Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ  
+    write(msg,*) &
+'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE  
+    write(msg,*) &
+'Warning READ WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    stat = NF_INQ_VARID(NCID,Name,VarID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    stat = NF_INQ_VAR(NCID,VarID,FName,XType,NDims,DimIDs,NAtts)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then
+      if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    else
+      if(XType /= NF_TYPE) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    endif
+    if(NDims /= NMDVarDims) then
+      Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D   
+      write(msg,*) &
+'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    stat = NF_INQ_DIMLEN(NCID,DimIDs(1),Len1)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    VStart(1) = 1
+    VStart(2) = TimeIndex
+    VCount(1) = LENGTH
+    VCount(2) = 1
+#ifndef CHAR_TYPE
+    allocate(Buffer(VCount(1)), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR   
+      write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    stat = NF_ROUTINE (NCID,VarID,VStart,VCount,Buffer)
+#else
+    if(Len1 > len(Data)) then
+      Status = WRF_WARN_CHARSTR_GT_LENDATA  
+      write(msg,*) &
+'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    Data = ''
+    stat = NF_GET_VARA_TEXT (NCID,VarID,VStart,VCount,Data)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+#ifndef CHAR_TYPE
+    COPY
+    deallocate(Buffer, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR  
+      write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    if(Len1 > Count) then
+      OutCount = Count
+      Status = WRF_WARN_MORE_DATA_IN_FILE  
+    else
+      OutCount = Len1
+      Status = WRF_NO_ERR   
+    endif
+#endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS  
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_var_ti.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_var_ti.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_var_ti.code	(revision 2744)
@@ -0,0 +1,174 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var
+  TYPE_DATA
+  TYPE_COUNT
+  TYPE_OUTCOUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: XLen
+  TYPE_BUFFER
+  character (VarNameLen)                :: VarName
+  integer                               :: stat
+  integer                               :: NVar
+  integer                               :: XType
+
+  if(Count <= 0) then
+    Status = WRF_WARN_ZERO_LENGTH_GET  
+    write(msg,*) &
+'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  VarName = Var
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ  
+    write(msg,*) &
+'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE 
+    write(msg,*) &
+'Warning READ WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    do NVar=1,DH%NumVars
+      if(DH%VarNames(NVar) == VarName) then
+        exit
+      elseif(NVar == DH%NumVars) then
+        Status = WRF_WARN_VAR_NF  
+        write(msg,*) &
+'Warning VARIABLE NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+    stat = NF_INQ_ATT(DH%NCID,DH%VarIDs(NVar),trim(Element),XType,XLen)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+    endif
+    if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then
+      if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    else
+      if(XType /= NF_TYPE) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    endif
+#ifndef CHAR_TYPE
+    allocate(Buffer(XLen), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+      write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), Buffer )
+#else
+    if(XLen > len(Data)) then
+      Status = WRF_WARN_CHARSTR_GT_LENDATA   
+      write(msg,*) &
+'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), Data )
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+    endif
+    COPY
+#ifndef CHAR_TYPE
+    deallocate(Buffer, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR  
+      write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    if(XLen > Count) then
+      OutCount = Count
+      Status   = WRF_WARN_MORE_DATA_IN_FILE  
+    else
+      OutCount = XLen
+      Status   = WRF_NO_ERR
+    endif
+#endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS  
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_put_dom_ti.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_put_dom_ti.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_put_dom_ti.code	(revision 2744)
@@ -0,0 +1,164 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  TYPE_DATA
+  TYPE_COUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: stat
+  integer                               :: stat2
+  integer               ,allocatable    :: Buffer(:)
+  integer                               :: i
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+! Do nothing unless it is time to write time-independent domain metadata.  
+IF ( ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    STATUS = WRF_WARN_WRITE_RONLY_FILE  
+    write(msg,*) &
+'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+#ifdef LOG
+      allocate(Buffer(Count), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      do i=1,Count
+        if(data(i)) then
+           Buffer(i)=1
+        else
+           Buffer(i)=0
+        endif
+      enddo
+      stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
+      deallocate(Buffer, STAT=stat2)
+      if(stat2/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+#else
+      stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+  elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    stat = NF_REDEF(DH%NCID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+#ifdef LOG
+      allocate(Buffer(Count), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+        write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      do i=1,Count
+        if(data(i)) then
+           Buffer(i)=1
+        else
+           Buffer(i)=0
+        endif
+      enddo
+      stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
+      deallocate(Buffer, STAT=stat2)
+      if(stat2/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR  
+        write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+#else
+      stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    stat = NF_ENDDEF(DH%NCID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS  
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+ENDIF
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_put_var_td.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_put_var_td.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_put_var_td.code	(revision 2744)
@@ -0,0 +1,233 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  character*(*)         ,intent(in)     :: Var
+  TYPE_DATA
+  TYPE_COUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  character (VarNameLen)                :: VarName
+  character (40+len(Element))           :: Name
+  integer                               :: stat
+  integer                               :: stat2
+  integer               ,allocatable    :: Buffer(:)
+  integer                               :: i
+  integer                               :: VDims (2)
+  integer                               :: VStart(2)
+  integer                               :: VCount(2)
+  integer                               :: NVar
+  integer                               :: TimeIndex
+  integer                               :: NCID
+
+  VarName = Var
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  NCID = DH%NCID
+  call GetName(Element, VarName, Name, Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_WRITE_RONLY_FILE  
+    write(msg,*) &
+'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    if(LENGTH < 1) then
+      Status = WRF_WARN_ZERO_LENGTH_PUT  
+      return
+    endif
+    do NVar=1,MaxVars
+      if(DH%MDVarNames(NVar) == Name) then
+        Status = WRF_WARN_2DRYRUNS_1VARIABLE  
+        return
+      elseif(DH%MDVarNames(NVar) == NO_NAME) then
+        DH%MDVarNames(NVar) = Name
+        exit
+      elseif(NVar == MaxVars) then
+        Status = WRF_WARN_TOO_MANY_VARIABLES  
+        write(msg,*) &
+'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+    do i=1,MaxDims
+      if(DH%DimLengths(i) == LENGTH) then
+        exit
+      elseif(DH%DimLengths(i) == NO_DIM) then
+        stat = NF_DEF_DIM(NCID,DH%DimNames(i),LENGTH,DH%DimIDs(i))
+        call netcdf_err(stat,Status)
+        if(Status /= WRF_NO_ERR) then
+          write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+          call wrf_debug ( WARN , msg)
+          return
+        endif
+        DH%DimLengths(i) = LENGTH
+        exit
+      elseif(i == MaxDims) then
+        Status = WRF_WARN_TOO_MANY_DIMS  
+        write(msg,*) &
+'Warning TOO MANY DIMENSIONS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+    DH%MDVarDimLens(NVar) = LENGTH
+    VDims(1) = DH%DimIDs(i)
+    VDims(2) = DH%DimUnlimID
+    stat = NF_DEF_VAR(NCID,Name,NF_TYPE,2,VDims,DH%MDVarIDs(NVar))
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    do NVar=1,MaxVars
+      if(DH%MDVarNames(NVar) == Name) then
+        exit
+      elseif(DH%MDVarNames(NVar) == NO_NAME) then
+        Status = WRF_WARN_MD_NF  
+        write(msg,*) &
+'Warning METADATA NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      elseif(NVar == MaxVars) then
+        Status = WRF_WARN_TOO_MANY_VARIABLES  
+        write(msg,*) &
+'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+    if(LENGTH > DH%MDVarDimLens(NVar)) then
+      Status = WRF_WARN_COUNT_TOO_LONG 
+      write(msg,*) &
+'Warning COUNT TOO LONG in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    elseif(LENGTH < 1) then
+      Status = WRF_WARN_ZERO_LENGTH_PUT  
+      write(msg,*) &
+'Warning ZERO LENGTH PUT in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    VStart(1) = 1
+    VStart(2) = TimeIndex
+    VCount(1) = LENGTH
+    VCount(2) = 1
+#ifdef LOG
+      allocate(Buffer(LENGTH), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+        write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      do i=1,Count
+        if(data(i)) then
+           Buffer(i)=1
+        else
+           Buffer(i)=0
+        endif
+      enddo
+      stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),VStart,VCount,Buffer)
+      deallocate(Buffer, STAT=stat2)
+      if(stat2/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
+        write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+#else
+      stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),VStart,VCount,Data)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_put_var_ti.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_put_var_ti.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_put_var_ti.code	(revision 2744)
@@ -0,0 +1,144 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var
+  TYPE_DATA
+  TYPE_COUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  character (VarNameLen)                :: VarName
+  integer                               :: stat
+  integer               ,allocatable    :: Buffer(:)
+  integer                               :: i
+  integer                               :: NVar
+  character*1                           :: null
+
+  null=char(0)
+  VarName = Var
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_WRITE_RONLY_FILE  
+    write(msg,*) &
+'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_MD_AFTER_OPEN  
+    write(msg,*) &
+'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    do NVar=1,MaxVars
+      if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
+        exit
+      elseif(NVar == MaxVars) then
+        Status = WRF_WARN_VAR_NF 
+        write(msg,*) &
+'Warning VARIABLE NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ &
+                        ,NVar,VarName
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+#ifdef LOG
+    allocate(Buffer(Count), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+      write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    do i=1,Count
+      if(data(i)) then
+         Buffer(i)=1
+      else
+         Buffer(i)=0
+      endif
+    enddo
+#endif
+#ifdef CHAR_TYPE
+    if(len_trim(Data).le.0) then
+      stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element),len_trim(null),null)
+    else
+      stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), ARGS )
+    endif
+#else
+    stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), ARGS )
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error for Var ',TRIM(Var),&
+        ' Element ',trim(Element),' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+    endif
+#ifdef LOG
+    deallocate(Buffer, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
+      write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+#endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS 
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/field_routines.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/field_routines.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/field_routines.F90	(revision 2744)
@@ -0,0 +1,175 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+subroutine ext_ncd_RealFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character (*)               ,intent(in)    :: IO
+  integer                     ,intent(in)    :: NCID
+  integer                     ,intent(in)    :: VarID
+  integer ,dimension(NVarDims),intent(in)    :: VStart
+  integer ,dimension(NVarDims),intent(in)    :: VCount
+  real, dimension(*)          ,intent(inout) :: Data
+  integer                     ,intent(out)   :: Status
+  integer                                    :: stat
+
+  if(IO == 'write') then
+    stat = NF_PUT_VARA_REAL(NCID,VarID,VStart,VCount,Data)
+  else
+    stat = NF_GET_VARA_REAL(NCID,VarID,VStart,VCount,Data)
+  endif
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  endif
+  return
+end subroutine ext_ncd_RealFieldIO
+
+subroutine ext_ncd_DoubleFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character (*)               ,intent(in)    :: IO
+  integer                     ,intent(in)    :: NCID
+  integer                     ,intent(in)    :: VarID
+  integer ,dimension(NVarDims),intent(in)    :: VStart
+  integer ,dimension(NVarDims),intent(in)    :: VCount
+  real*8                      ,intent(inout) :: Data
+  integer                     ,intent(out)   :: Status
+  integer                                    :: stat
+
+  if(IO == 'write') then
+    stat = NF_PUT_VARA_DOUBLE(NCID,VarID,VStart,VCount,Data)
+  else
+    stat = NF_GET_VARA_DOUBLE(NCID,VarID,VStart,VCount,Data)
+  endif
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  endif
+  return
+end subroutine ext_ncd_DoubleFieldIO
+
+subroutine ext_ncd_IntFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character (*)               ,intent(in)    :: IO
+  integer                     ,intent(in)    :: NCID
+  integer                     ,intent(in)    :: VarID
+  integer ,dimension(NVarDims),intent(in)    :: VStart
+  integer ,dimension(NVarDims),intent(in)    :: VCount
+  integer                     ,intent(inout) :: Data
+  integer                     ,intent(out)   :: Status
+  integer                                    :: stat
+
+  if(IO == 'write') then
+    stat = NF_PUT_VARA_INT(NCID,VarID,VStart,VCount,Data)
+  else
+    stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Data)
+  endif
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  endif
+  return
+end subroutine ext_ncd_IntFieldIO
+
+subroutine ext_ncd_LogicalFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character (*)                                   ,intent(in)    :: IO
+  integer                                         ,intent(in)    :: NCID
+  integer                                         ,intent(in)    :: VarID
+  integer,dimension(NVarDims)                     ,intent(in)    :: VStart
+  integer,dimension(NVarDims)                     ,intent(in)    :: VCount
+  logical,dimension(VCount(1),VCount(2),VCount(3)),intent(inout) :: Data
+  integer                                         ,intent(out)   :: Status
+  integer,dimension(:,:,:),allocatable                           :: Buffer
+  integer                                                        :: stat
+  integer                                                        :: i,j,k
+
+  allocate(Buffer(VCount(1),VCount(2),VCount(3)), STAT=stat)
+  if(stat/= 0) then
+    Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+    write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  if(IO == 'write') then
+    do k=1,VCount(3)
+      do j=1,VCount(2)
+        do i=1,VCount(1)
+          if(data(i,j,k)) then
+            Buffer(i,j,k)=1
+          else
+            Buffer(i,j,k)=0
+          endif
+        enddo
+      enddo
+    enddo
+    stat = NF_PUT_VARA_INT(NCID,VarID,VStart,VCount,Buffer)
+  else
+    stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Buffer)
+    Data = Buffer == 1
+  endif
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  deallocate(Buffer, STAT=stat)
+  if(stat/= 0) then
+    Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+    write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  return
+end subroutine ext_ncd_LogicalFieldIO
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/makefile	(revision 2744)
@@ -0,0 +1,47 @@
+#makefile to build a wrf_io with netCDF
+
+OBJSL   = wrf_io.o field_routines.o module_wrfsi_static.o
+OBJS    = $(OBJSL)
+CODE    = ext_ncd_get_dom_ti.code ext_ncd_get_var_td.code ext_ncd_get_var_ti.code ext_ncd_put_dom_ti.code ext_ncd_put_var_td.code ext_ncd_put_var_ti.code transpose.code 
+FFLAGS  =  $(FCFLAGS) -I$(NETCDFPATH)/include -I../ioapi_share
+LIBS    = -L$(NETCDFPATH)/lib -lnetcdf
+CPP1    = $(CPP)  -P $(TRADFLAG)
+M4      = m4 -Uinclude -Uindex -Ulen
+AR      = ar
+
+.SUFFIXES:      .F90 .f .o .code
+
+all : libwrfio_nf.a 
+
+libwrfio_nf.a:		$(OBJS) $(CODE)
+			/bin/rm -f libwrfio_nf.a
+			$(AR) cr libwrfio_nf.a $(OBJSL)
+			$(RANLIB) libwrfio_nf.a
+
+wrf_io.o:               wrf_io.F90 $(CODE)
+			$(CPP1) -I../ioapi_share wrf_io.F90 | $(M4) - > wrf_io.f
+			$(FC) $(FFLAGS) -c wrf_io.f
+
+module_wrfsi_static.o:  module_wrfsi_static.F90
+			$(CPP1) -I../ioapi_share module_wrfsi_static.F90 > module_wrfsi_static.f
+			$(FC) $(FFLAGS) -c module_wrfsi_static.f
+
+diffwrf:                diffwrf.F90
+			$(CPP1) -I$(NETCDFPATH)/include -I../ioapi_share diffwrf.F90 > diffwrf.f
+			$(FC) -c $(FFLAGS) diffwrf.f
+			@if [ \( -f ../../frame/wrf_debug.o \) -a \( -f ../../frame/module_wrf_error.o \) -a \( -f $(ESMF_MOD_DEPENDENCE) \) ] ; then \
+			echo "diffwrf io_netcdf is being built now. "; \
+			  $(FC) $(FFLAGS) $(LDFLAGS) -o diffwrf diffwrf.o $(OBJSL) $(LIBS) ../../frame/wrf_debug.o ../../frame/module_wrf_error.o $(ESMF_IO_LIB_EXT) ;\
+                        else \
+			  echo "***************************************************************************** " ; \
+			  echo "*** Rerun compile to make diffwrf in external/io_netcdf directory         *** " ; \
+			  echo "***************************************************************************** " ; \
+                        fi
+
+field_routines.o:	field_routines.F90
+			$(CPP1) -I../ioapi_share field_routines.F90 > field_routines.f
+			$(FC) $(FFLAGS) -c field_routines.f
+
+superclean:
+			/bin/rm -f *.f *.o testWRFWrite testWRFRead \
+			*.mod libwrfio_nf.a diffwrf
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/module_wrfsi_static.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/module_wrfsi_static.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/module_wrfsi_static.F90	(revision 2744)
@@ -0,0 +1,96 @@
+MODULE wrfsi_static
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+CONTAINS
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE open_wrfsi_static(dataroot,cdfid)
+  
+    IMPLICIT NONE
+    INCLUDE "netcdf.inc"
+    CHARACTER(LEN=*), INTENT(IN)   :: dataroot
+    INTEGER, INTENT(OUT)           :: cdfid
+    CHARACTER(LEN=255)            :: staticfile
+    LOGICAL                       :: static_exists
+    INTEGER                       :: status
+
+    staticfile = TRIM(dataroot) // '/static/static.wrfsi'
+    INQUIRE(FILE=staticfile, EXIST=static_exists)
+    IF (static_exists) THEN
+      status = NF_OPEN(TRIM(staticfile),NF_NOWRITE,cdfid)
+      IF (status .NE. NF_NOERR) THEN
+        PRINT '(A,I5)', 'NetCDF error opening WRF static file: ',status
+        STOP 'open_wrfsi_static'
+      END IF 
+
+    ELSE
+
+!mp
+!	search for rotlat version??
+!      PRINT '(A)', 'Static file not found ', staticfile
+!      PRINT '(A)', 'Look for NMM version'
+      staticfile = TRIM(dataroot) // '/static/static.wrfsi.rotlat'
+      INQUIRE(FILE=staticfile, EXIST=static_exists)
+		    IF (static_exists) THEN
+		 status = NF_OPEN(TRIM(staticfile),NF_NOWRITE,cdfid)
+      IF (status .NE. NF_NOERR) THEN
+        PRINT '(A,I5)', 'NetCDF error opening WRF static file: ',status
+        STOP 'open_wrfsi_static'
+      END IF
+		    ELSE
+
+      PRINT '(A)', 'rotlat Static file not found, either: ', staticfile
+      STOP 'open_wrfsi_static'
+  		    ENDIF
+
+	ENDIF
+
+    RETURN
+  END SUBROUTINE open_wrfsi_static      
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE get_wrfsi_static_dims(dataroot, nx, ny)
+  
+    ! Subroutine to return the horizontal dimensions of WRF static file
+    ! contained in the input dataroot
+
+    IMPLICIT NONE
+    INCLUDE "netcdf.inc"
+    CHARACTER(LEN=*), INTENT(IN)  :: dataroot
+    INTEGER         , INTENT(OUT) :: nx
+    INTEGER         , INTENT(OUT) :: ny
+
+    INTEGER                       :: cdfid,vid, status
+
+    CALL open_wrfsi_static(dataroot,cdfid)
+    status = NF_INQ_DIMID(cdfid, 'x', vid)
+    status = NF_INQ_DIMLEN(cdfid, vid, nx)
+    status = NF_INQ_DIMID(cdfid, 'y', vid)
+    status = NF_INQ_DIMLEN(cdfid, vid, ny) 
+      PRINT '(A,I5,A,I5)', 'WRF X-dimension = ',nx, &
+        ' WRF Y-dimension = ',ny  
+    status = NF_CLOSE(cdfid)  
+    RETURN
+  END SUBROUTINE get_wrfsi_static_dims     
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE get_wrfsi_static_2d(dataroot, varname, data)
+
+    IMPLICIT NONE
+    INCLUDE "netcdf.inc"
+    ! Gets any 2D variable from the static file
+    CHARACTER(LEN=*), INTENT(IN)  :: dataroot
+    CHARACTER(LEN=*), INTENT(IN)  :: varname
+    REAL, INTENT(OUT)             :: data(:,:)
+ 
+    INTEGER                             :: cdfid, vid, status
+   
+    CALL open_wrfsi_static(dataroot,cdfid)
+    status = NF_INQ_VARID(cdfid,varname,vid)
+    status = NF_GET_VAR_REAL(cdfid,vid,data)
+    IF (status .NE. NF_NOERR) THEN
+      PRINT '(A)', 'Problem getting 2D data.'
+    ENDIF 
+    status = NF_CLOSE(cdfid) 
+    RETURN
+  END SUBROUTINE get_wrfsi_static_2d    
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  
+END MODULE wrfsi_static
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/testWRFRead.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/testWRFRead.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/testWRFRead.F90	(revision 2744)
@@ -0,0 +1,138 @@
+program testread_john
+  use wrf_data
+  implicit none
+#include "wrf_status_codes.h"
+#include <netcdf.inc>
+  character (80) FileName
+  integer Comm
+  character (80) SysDepInfo
+  integer     :: DataHandle
+  integer Status
+  integer NCID
+  real data(200)
+  integer idata(200)
+  real*8 ddata(200)
+  logical ldata(200)
+  character (80) cdata
+  integer OutCount
+  integer i,j,k
+
+  integer, parameter ::    pad = 3
+  integer, parameter ::    jds=1       , jde=6      , &
+                           ids=1       , ide=9      , &
+                           kds=1       , kde=5
+  integer, parameter ::    jms=jds-pad , jme=jde+pad , &
+                           ims=ids-pad , ime=ide+pad , &
+                           kms=kds     , kme=kde
+  integer, parameter ::    jps=jds     , jpe=jde    , &
+                           ips=ids     , ipe=ide    , &
+                           kps=kds     , kpe=kde
+
+  real u( ims:ime , kms:kme , jms:jme )
+  real v( ims:ime , kms:kme , jms:jme )
+  real rho( ims:ime , kms:kme , jms:jme )
+  real u2( ims:ime , jms:jme )
+  real u1( ims:ime )
+
+  integer int( ims:ime , kms:kme , jms:jme )
+  real*8  r8 ( ims:ime , kms:kme , jms:jme )
+
+  integer Dom
+  character*3 MemOrd
+  integer , Dimension(3) :: DomS,DomE,MemS,MemE,PatS,PatE
+  integer , Dimension(2) :: Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E
+  integer                   Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E
+  character (19) Time, DateStr
+  character (31) VarName
+  character (19) Date
+
+  print *, 'Testing wrf read'
+  Date = '2000-09-18_16:42:01'
+  call ext_init(Status)
+  print *,'After call ext_init, Status =',Status
+  FileName = 'foo.nc'
+  Comm = 1
+  SysDepInfo = 'sys info'
+  call ext_open_for_read( FileName, Comm, SysDepInfo, DataHandle, Status)
+  print *, 'Status = ',Status,DataHandle
+
+  MemOrd = "XZY"
+
+  DomS(1) = ids
+  DomE(1) = ide
+  DomS(2) = kds
+  DomE(2) = kde
+  DomS(3) = jds
+  DomE(3) = jde
+
+  PatS(1) = ips
+  PatE(1) = ipe
+  PatS(2) = kps
+  PatE(2) = kpe
+  PatS(3) = jps
+  PatE(3) = jpe
+
+  MemS(1) = ims
+  MemE(1) = ime
+  MemS(2) = kms
+  MemE(2) = kme
+  MemS(3) = jms
+  MemE(3) = jme
+
+  Dom2S(1) = ids
+  Dom2S(2) = jds
+  Dom2E(1) = ide
+  Dom2E(2) = jde
+  Mem2S(1) = ims
+  Mem2S(2) = jms
+  Mem2E(1) = ime
+  Mem2E(2) = jme
+  Pat2S(1) = ips
+  Pat2S(2) = jps
+  Pat2E(1) = ipe
+  Pat2E(2) = jpe
+
+  Dom1S = ids
+  Dom1E = ide
+  Mem1S = ims
+  Mem1E = ime
+  Pat1S = ips
+  Pat1E = ipe
+
+  call ext_get_next_time(DataHandle, Time, Status)
+  print *, Time, Status
+
+  call ext_read_field(DataHandle,Time,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' u(2,3,4) ', u(2,3,4) 
+  call ext_read_field(DataHandle,Time,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' v(4,3,2) ', v(4,3,2)
+  call ext_read_field(DataHandle,Time,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' rho(3,4,5) ' , rho(3,4,5)
+  call ext_read_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
+  print *,'ext_read_field Status = ',Status, ' u2(6,5) ', u2(6,5) 
+  call ext_read_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' u(2,3,4) ', u(2,3,4) 
+  call ext_read_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
+  print *,'ext_read_field Status = ',Status, ' u1(9) ', u1(9)
+
+  call ext_read_field(DataHandle,Time,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' int(8,5,6) ', int(8,5,6) 
+  call ext_read_field(DataHandle,Time,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' r8(7,4,5) ', r8(7,4,5) 
+
+  call ext_get_next_time(DataHandle, Time, Status)
+  print *, Time, Status
+
+  call ext_read_field(DataHandle,Time,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'> ext_read_field Status = ',Status, ' u(3,3,3) ' ,u(3,3,3)
+  call ext_read_field(DataHandle,Time,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'> ext_read_field Status = ',Status, ' v(4,4,4) ' ,v(4,4,4)
+  call ext_read_field(DataHandle,Time,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'> ext_read_field Status = ',Status, ' rho(3,4,5) ' ,rho(3,4,5)
+
+  call ext_close( DataHandle, Status)
+  print *, 'After ext_close, Status = ',Status
+  call ext_exit(Status)
+  print *,'End of test program',Status
+  stop
+  end program testread_john
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/testWRFWrite.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/testWRFWrite.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/testWRFWrite.F90	(revision 2744)
@@ -0,0 +1,184 @@
+program testwrite_john
+  use wrf_data
+  implicit none
+#include "wrf_status_codes.h"
+#include <netcdf.inc>
+  character (80) FileName
+  integer Comm
+  character (80) SysDepInfo
+  integer     :: DataHandle
+  integer Status
+  integer NCID
+  real data(200)
+  integer idata(200)
+  real*8 ddata(200)
+  logical ldata(200)
+  character (80) cdata
+  integer OutCount
+  integer i,j,k
+
+  integer, parameter ::    pad = 3  
+  integer, parameter ::    jds=1       , jde=6      , &
+                           ids=1       , ide=9      , &
+                           kds=1       , kde=5         
+  integer, parameter ::    jms=jds-pad , jme=jde+pad , &
+                           ims=ids-pad , ime=ide+pad , &
+                           kms=kds     , kme=kde       
+  integer, parameter ::    jps=jds     , jpe=jde    , &
+                           ips=ids     , ipe=ide    , &
+                           kps=kds     , kpe=kde       
+
+  real u( ims:ime , kms:kme , jms:jme )
+  real v( ims:ime , kms:kme , jms:jme )
+  real rho( ims:ime , kms:kme , jms:jme )
+  real u2( ims:ime , jms:jme )
+  real u1( ims:ime )
+
+  integer int( ims:ime , kms:kme , jms:jme )
+  real*8  r8 ( ims:ime , kms:kme , jms:jme )
+
+  integer Dom
+  character*3 MemOrd
+  character (19) Date
+  character (19) Date2
+  integer , Dimension(3) :: DomS,DomE,MemS,MemE,PatS,PatE
+  integer , Dimension(2) :: Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E
+  integer , Dimension(1) :: Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E
+  print *, 'Testing wrf write'
+  print *, ims,ime , kms,kme , jms,jme
+  Date = '2000-09-18_16:42:01'
+  Date2 = '2000-09-18_16:52:01'
+  call ext_init(Status)
+  print *,'After call ext_init, Status =',Status
+  FileName = 'foo.nc'
+  Comm = 1
+  SysDepInfo = 'sys info'
+
+print*,'!!!!!!!!!!!!!!!!!!!!!!! ext_open_for_write_begin'
+
+  call ext_open_for_write_begin( FileName, Comm, SysDepInfo, DataHandle, Status)
+  print *, ' ext_open_for_write_begin Status = ',Status,DataHandle
+
+  MemOrd = "XZY"
+
+  DomS(1) = ids
+  DomE(1) = ide
+  DomS(2) = kds
+  DomE(2) = kde
+  DomS(3) = jds
+  DomE(3) = jde
+
+  PatS(1) = ips
+  PatE(1) = ipe
+  PatS(2) = kps
+  PatE(2) = kpe
+  PatS(3) = jps
+  PatE(3) = jpe
+
+  MemS(1) = ims
+  MemE(1) = ime
+  MemS(2) = kms
+  MemE(2) = kme
+  MemS(3) = jms
+  MemE(3) = jme
+
+  Dom2S(1) = ids
+  Dom2S(2) = jds
+  Dom2E(1) = ide
+  Dom2E(2) = jde
+  Mem2S(1) = ims
+  Mem2S(2) = jms
+  Mem2E(1) = ime
+  Mem2E(2) = jme
+  Pat2S(1) = ips
+  Pat2S(2) = jps
+  Pat2E(1) = ipe
+  Pat2E(2) = jpe
+
+  Dom1S = ids
+  Dom1E = ide
+  Mem1S = ims
+  Mem1E = ime
+  Pat1S = ips
+  Pat1E = ipe
+
+  call ext_write_field(DataHandle,Date,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+
+  call ext_open_for_write_commit(DataHandle, Status)
+  print *, '             ext_open_for_write_commit Status = ', Status,DataHandle
+
+  do j=jds,jde
+    do k=kds,kde
+      do i=ids,ide
+        u  (i,k,j) = 100*i+j+10*k
+        v  (i,k,j) = 100*i+j+10*k
+        rho(i,k,j) = 100*i+j+10*k
+        int(i,k,j) = 100*i+j+10*k
+        r8 (i,k,j) = 100*i+j+10*k
+      enddo
+    enddo
+  enddo
+  do j=jds,jde
+    do i=ids,ide
+      u2(i,j) = 10*i+j
+    enddo
+  enddo
+  do i=ids,ide
+    u1(i) = i
+  enddo
+
+  print *,'testWRFWrite u  (2,3,4) = ',u(2,3,4)
+  print *,'testWRFWrite v  (4,3,2) = ',v(4,3,2)
+  print *,'testWRFWrite rho(3,4,5) = ',rho(3,4,5)
+  print *,'testWRFWrite u2 (6,5)   = ',u2(6,5)
+  print *,'testWRFWrite u1 (9)     = ',u1(9)
+  print *,'testWRFWrite int(8,5,6) = ',int(8,5,6)
+  print *,'testWRFWrite r8 (7,4,5) = ',r8(7,4,5)
+  call ext_write_field(DataHandle,Date,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+
+  print *,'2nd : testWRFWrite u(3,3,3) = ',u(3,3,3)
+  print *,'2nd : testWRFWrite v(4,4,4) = ',v(4,4,4)
+  print *,'2nd : testWRFWrite rho(3,4,5) = ',rho(3,4,5)
+  call ext_write_field(DataHandle,Date2,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              2nd write : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date2,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              2nd write : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date2,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              2nd write : ext_write_field Status = ',Status
+
+  call ext_close( DataHandle, Status)
+  print *, '             After ext_close, Status = ',Status
+  call ext_exit(Status)
+  print *,'              End of test program',Status
+  stop
+  end program testwrite_john
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/transpose.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/transpose.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/transpose.code	(revision 2744)
@@ -0,0 +1,36 @@
+  ix=0
+  jx=0
+  kx=0
+  call reorder(MemoryOrder,MemO)
+  if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1
+  if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1
+  if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1
+
+! pjj/cray
+  if(IO == 'write') then
+!dir$ concurrent
+  do k=k1,k2
+    do j=j1,j2
+!dir$ prefervector
+!dir$ concurrent
+!cdir select(vector)
+      do i=i1,i2
+          DFIELD = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k))
+      enddo
+    enddo
+  enddo
+else
+!dir$ concurrent
+  do k=k1,k2
+    do j=j1,j2
+!dir$ prefervector
+!dir$ concurrent
+!cdir select(vector)
+      do i=i1,i2
+          Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = DFIELD
+      enddo
+    enddo
+  enddo
+endif
+
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/vort.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/vort.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/vort.F90	(revision 2744)
@@ -0,0 +1,265 @@
+! on linux, compile wrf then compile as:
+! pgf90 -Mfree -I ../../main -I ../../inc -I /usr/local/netcdf-pgi/include vort.F90 libwrfio_nf.a /usr/local/netcdf-pgi/lib/libnetcdf.a ../../main/libwrflib.a
+! on AIX, compile wrf then compile as:
+! /lib/cpp -C -P vort.F90 > vort.f
+! mpxlf -qfree=f90 -I ../../share -I ../../main -I ../../inc -I /usr/local/netcdf/include vort.f libwrfio_nf.a /usr/local/netcdf/lib/libnetcdf.a ../../main/libwrflib.a
+
+module read_util_module
+
+#ifdef crayx1
+#define iargc ipxfargc
+#endif
+
+contains
+
+#ifdef crayx1
+   subroutine getarg(i, harg)
+     implicit none
+     character(len=*) :: harg
+     integer :: ierr, ilen, i
+
+     call pxfgetarg(i, harg, ilen, ierr)
+     return
+   end subroutine getarg
+#endif
+
+   subroutine arguments(v2file, lmore)
+     implicit none
+     character(len=*) :: v2file
+     character(len=120) :: harg
+     logical :: lmore
+   
+     integer :: ierr, i, numarg
+     integer, external :: iargc
+   
+     numarg = iargc()
+   
+     i = 1
+     lmore = .false.
+   
+     do while ( i < numarg) 
+        call getarg(i, harg)
+        print*, 'harg = ', trim(harg)
+   
+        if (harg == "-v") then
+           i = i + 1
+           lmore = .true.
+        elseif (harg == "-h") then
+           call help
+        endif
+   
+     enddo
+   
+     call getarg(i,harg)
+     v2file = harg
+   end subroutine arguments
+   
+   subroutine help
+     implicit none
+     character(len=120) :: cmd
+     call getarg(0, cmd)
+   
+     write(*,'(/,"Usage: ", A, " [-v] v2file ")') trim(cmd)
+     write(*,'(8x, "-v     : Print extra info")')
+     write(*,'(8x, "v3file : MM5v3 file name to read.")')
+     write(*,'(8x, "-h     : print this help message and exit.",/)')
+     stop
+   end subroutine help
+end module read_util_module
+
+
+
+ program readv3
+  use wrf_data
+  use read_util_module
+  use module_compute_geop
+
+
+  implicit none
+#include "wrf_status_codes.h"
+#include <netcdf.inc>
+  character(len=120) :: flnm
+  character(len=120) :: flnm2
+  character(len=120) :: arg3
+  character(len=19) :: DateStr
+  character(len=19) :: DateStr2
+  character(len=31) :: VarName
+  character(len=31) :: VarName2
+  integer dh1, dh2
+
+  integer :: flag, flag2
+  integer :: iunit, iunit2
+
+  integer :: i,j,k
+  integer :: levlim
+  integer :: cross
+  integer :: ndim, ndim2
+  integer :: WrfType, WrfType2
+  real :: time, time2
+  real*8 :: a, b
+  real*8 :: sum1, sum2, diff1, diff2, serr, perr, rms
+  integer, dimension(4) :: start_index, end_index, start_index2, end_index2, end_index_u, end_index_uz
+  integer , Dimension(3) :: MemS,MemE,PatS,PatE
+  character (len= 4) :: staggering,   staggering2
+  character (len= 3) :: ordering,     ordering2, ord
+  character (len=24) :: start_date,   start_date2
+  character (len=24) :: current_date, current_date2
+  character (len=31) :: name,         name2,  tmpname
+  character (len=25) :: units,        units2
+  character (len=46) :: description,  description2
+
+  real, allocatable, dimension(:,:,:) :: ph, phb, p, pb
+  real, allocatable, dimension(:,:)   :: height
+
+  integer ::  ids, ide, jds, jde, kds, kde,    &
+              ims, ime, jms, jme, kms, kme,    &
+              its, ite, jts, jte, kts, kte
+  integer outcount
+
+
+  character (len=80), dimension(3)  ::  dimnames
+  character (len=80) :: SysDepInfo
+
+  integer :: l, n
+  integer :: ikdiffs, ifdiffs
+
+  real, allocatable, dimension(:,:,:,:) :: data,data2
+
+  integer :: ierr, ierr2, ier, ier2, Status, Status_next_time, Status_next_time2, Status_next_var, Status_next_var_2
+
+  logical :: newtime = .TRUE.
+  logical :: justplot, efound
+
+  integer, external :: iargc
+  logical, external :: iveceq
+
+  levlim = -1
+
+  call ext_ncd_ioinit(SysDepInfo,Status)
+  call set_wrf_debug_level ( 1 )
+
+
+  Justplot = .true.
+
+! get arguments
+!  if ( iargc() .ge. 2 ) then
+    call getarg(1,flnm)
+!    call getarg(2,flnm2)
+    ierr = 0
+    call ext_ncd_open_for_read( trim(flnm), 0, 0, "", dh1, Status)
+    if ( Status /= 0 ) then 
+      print*,'error opening ',flnm, ' Status = ', Status ; stop 
+    endif
+!    call ext_ncd_open_for_read( trim(flnm2), 0, 0, "", dh2, Status)
+!    if ( Status /= 0 ) go to 923
+!    goto 924
+!923    continue
+!
+!! bounce here if second name is not openable -- this would mean that
+!! it is a field name instead.
+!
+!    print*,'could not open ',flnm2
+!    name = flnm2
+!    Justplot = .true.
+!924    continue
+!  if ( iargc() .eq. 3 ) then
+!    call getarg(3,arg3)
+!    read(arg3,*)levlim
+!    print*,'LEVLIM = ',LEVLIM
+!  endif
+!  else
+!     print*,'Usage: command file1 file2'
+!     stop
+!  endif
+
+!print*,'Just plot ',Justplot
+
+start_index = 1
+end_index = 0
+
+CALL ext_ncd_get_dom_ti_integer(dh1,'WEST-EAST_GRID_DIMENSION',end_index(1),1,OutCount,Status)
+CALL ext_ncd_get_dom_ti_integer(dh1,'BOTTOM-TOP_GRID_DIMENSION',end_index(2),1,OutCount,Status)
+CALL ext_ncd_get_dom_ti_integer(dh1,'SOUTH-NORTH_GRID_DIMENSION',end_index(3),1,OutCount,Status)
+ord = 'XZY'
+staggering = ' '
+
+
+
+allocate(ph(end_index(1),end_index(2),end_index(3)))
+allocate(phb(end_index(1),end_index(2),end_index(3)))
+allocate(p(end_index(1),end_index(2),end_index(3)))
+allocate(pb(end_index(1),end_index(2),end_index(3)))
+allocate(height(end_index(1),end_index(3)))
+
+ids=start_index(1); ide=end_index(1); jds=start_index(3); jde=end_index(3); kds=start_index(2); kde=end_index(2)
+ims=start_index(1); ime=end_index(1);   jms=start_index(3); jme=end_index(3);   kms=start_index(2); kme=end_index(2)
+its=start_index(1); ite=end_index(1)-1; jts=start_index(3); jte=end_index(3)-1; kts=start_index(2); kte=end_index(2)-1
+
+end_index_u  = end_index - 1
+end_index_uz = end_index - 1
+end_index_uz(2) = end_index_uz(2) + 1
+
+
+
+if ( Justplot ) then
+  print*, 'flnm = ', trim(flnm)
+
+  call ext_ncd_get_next_time(dh1, DateStr, Status_next_time)
+
+  DO WHILE ( Status_next_time .eq. 0 )
+    write(*,*)'Next Time ',TRIM(Datestr)
+
+    staggering = 'Z'
+    name = 'PH'
+    call ext_ncd_read_field(dh1,DateStr,TRIM(name),ph,WRF_REAL,0,0,0,ord, &
+                            staggering, dimnames ,                      &
+                            start_index,end_index_uz,                      & !dom
+                            start_index,end_index,                      & !mem
+                            start_index,end_index_uz,                      & !pat
+                            ierr)
+    name = 'PHB'
+    call ext_ncd_read_field(dh1,DateStr,TRIM(name),phb,WRF_REAL,0,0,0,ord, &
+                            staggering, dimnames ,                      &
+                            start_index,end_index_uz,                      & !dom
+                            start_index,end_index,                      & !mem
+                            start_index,end_index_uz,                      & !pat
+                            ierr)
+    staggering = ' '
+    name = 'P'
+    call ext_ncd_read_field(dh1,DateStr,TRIM(name),p,WRF_REAL,0,0,0,ord, &
+                            staggering, dimnames ,                      &
+                            start_index,end_index_u,                      & !dom
+                            start_index,end_index,                      & !mem
+                            start_index,end_index_u,                      & !pat
+                            ierr)
+    name = 'PB'
+    call ext_ncd_read_field(dh1,DateStr,TRIM(name),pb,WRF_REAL,0,0,0,ord, &
+                            staggering, dimnames ,                      &
+                            start_index,end_index_u,                      & !dom
+                            start_index,end_index,                      & !mem
+                            start_index,end_index_u,                      & !pat
+                            ierr)
+
+    CALL compute_500mb_height  ( ph, phb, p, pb,                  &
+                                   height,                          &
+                                   ids, ide, jds, jde, kds, kde,    &
+                                   ims, ime, jms, jme, kms, kme,    &
+                                   its, ite, jts, jte, kts, kte    )
+
+    write(88,*)end_index_u(1),end_index_u(3),' height ',trim(Datestr)
+    do j = 1, end_index_u(3)
+      do i = 1, end_index_u(1)
+        write(88,*) height(i,j)
+      enddo
+    enddo
+
+    call ext_ncd_get_next_time(dh1, DateStr, Status_next_time)
+  enddo
+endif
+
+end program readv3
+
+! stub for routine called by module_wrf_error (used by netcdf implementation of IO api)
+SUBROUTINE wrf_abort
+  STOP
+END SUBROUTINE wrf_abort
Index: trunk/WRF.COMMON/WRFV2/external/io_netcdf/wrf_io.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_netcdf/wrf_io.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_netcdf/wrf_io.F90	(revision 2744)
@@ -0,0 +1,3388 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+module wrf_data
+
+  integer                , parameter      :: FATAL            = 1
+  integer                , parameter      :: WARN             = 1
+  integer                , parameter      :: WrfDataHandleMax = 99
+  integer                , parameter      :: MaxDims          = 2000 ! = NF_MAX_VARS
+  integer                , parameter      :: MaxVars          = 2000
+  integer                , parameter      :: MaxTimes         = 9000
+  integer                , parameter      :: DateStrLen       = 19
+  integer                , parameter      :: VarNameLen       = 31
+  integer                , parameter      :: NO_DIM           = 0
+  integer                , parameter      :: NVarDims         = 4
+  integer                , parameter      :: NMDVarDims       = 2
+  character (8)          , parameter      :: NO_NAME          = 'NULL'
+  character (DateStrLen) , parameter      :: ZeroDate = '0000-00-00-00:00:00'
+
+#include "wrf_io_flags.h"
+
+  character (256)                         :: msg
+  logical                                 :: WrfIOnotInitialized = .true.
+
+  type :: wrf_data_handle
+    character (255)                       :: FileName
+    integer                               :: FileStatus
+    integer                               :: Comm
+    integer                               :: NCID
+    logical                               :: Free
+    logical                               :: Write
+    character (5)                         :: TimesName
+    integer                               :: TimeIndex
+    integer                               :: CurrentTime  !Only used for read
+    integer                               :: NumberTimes  !Only used for read
+    character (DateStrLen), pointer       :: Times(:)
+    integer                               :: TimesVarID
+    integer               , pointer       :: DimLengths(:)
+    integer               , pointer       :: DimIDs(:)
+    character (31)        , pointer       :: DimNames(:)
+    integer                               :: DimUnlimID
+    character (9)                         :: DimUnlimName
+    integer       , dimension(NVarDims)   :: DimID
+    integer       , dimension(NVarDims)   :: Dimension
+    integer               , pointer       :: MDVarIDs(:)
+    integer               , pointer       :: MDVarDimLens(:)
+    character (80)        , pointer       :: MDVarNames(:)
+    integer               , pointer       :: VarIDs(:)
+    integer               , pointer       :: VarDimLens(:,:)
+    character (VarNameLen), pointer       :: VarNames(:)
+    integer                               :: CurrentVariable  !Only used for read
+    integer                               :: NumVars
+! first_operation is set to .TRUE. when a new handle is allocated 
+! or when open-for-write or open-for-read are committed.  It is set 
+! to .FALSE. when the first field is read or written.  
+    logical                               :: first_operation
+  end type wrf_data_handle
+  type(wrf_data_handle),target            :: WrfDataHandles(WrfDataHandleMax)
+end module wrf_data
+
+module ext_ncd_support_routines
+
+  implicit none
+
+CONTAINS
+
+subroutine allocHandle(DataHandle,DH,Comm,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  integer              ,intent(out) :: DataHandle
+  type(wrf_data_handle),pointer     :: DH
+  integer              ,intent(IN)  :: Comm
+  integer              ,intent(out) :: Status
+  integer                           :: i
+  integer                           :: stat
+
+  do i=1,WrfDataHandleMax
+    if(WrfDataHandles(i)%Free) then
+      DH => WrfDataHandles(i)
+      DataHandle = i
+      allocate(DH%Times(MaxTimes), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%DimLengths(MaxDims), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%DimIDs(MaxDims), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%DimNames(MaxDims), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%MDVarIDs(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%MDVarDimLens(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%MDVarNames(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%VarIDs(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%VarDimLens(NVarDims-1,MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%VarNames(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      exit
+    endif
+    if(i==WrfDataHandleMax) then
+      Status = WRF_WARN_TOO_MANY_FILES
+      write(msg,*) 'Warning TOO MANY FILES in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      write(msg,*) 'Did you call ext_ncd_ioinit?'
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+  enddo
+  DH%Free      =.false.
+  DH%Comm      = Comm
+  DH%Write     =.false.
+  DH%first_operation  = .TRUE.
+  Status = WRF_NO_ERR
+end subroutine allocHandle
+
+subroutine deallocHandle(DataHandle, Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  integer              ,intent(in) :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: i
+  integer                           :: stat
+
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. WrfDataHandleMax ) THEN
+    if(.NOT. WrfDataHandles(DataHandle)%Free) then
+      DH => WrfDataHandles(DataHandle)
+      deallocate(DH%Times, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%DimLengths, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%DimIDs, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%DimNames, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%MDVarIDs, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%MDVarDimLens, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%MDVarNames, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%VarIDs, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%VarDimLens, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%VarNames, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      DH%Free      =.TRUE.
+    endif
+  ENDIF
+  Status = WRF_NO_ERR
+end subroutine deallocHandle
+
+subroutine GetDH(DataHandle,DH,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  type(wrf_data_handle) ,pointer        :: DH
+  integer               ,intent(out)    :: Status
+
+  if(DataHandle < 1 .or. DataHandle > WrfDataHandleMax) then
+    Status = WRF_WARN_BAD_DATA_HANDLE
+    return
+  endif
+  DH => WrfDataHandles(DataHandle)
+  if(DH%Free) then
+    Status = WRF_WARN_BAD_DATA_HANDLE
+    return
+  endif
+  Status = WRF_NO_ERR
+  return
+end subroutine GetDH
+
+subroutine DateCheck(Date,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  character*(*) ,intent(in)      :: Date
+  integer       ,intent(out)     :: Status
+  
+  if(len(Date) /= DateStrLen) then
+    Status = WRF_WARN_DATESTR_BAD_LENGTH
+  else  
+    Status = WRF_NO_ERR
+  endif
+  return
+end subroutine DateCheck
+
+subroutine GetName(Element,Var,Name,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  character*(*) ,intent(in)     :: Element
+  character*(*) ,intent(in)     :: Var
+  character*(*) ,intent(out)    :: Name
+  integer       ,intent(out)    :: Status
+  character (VarNameLen)        :: VarName
+  character (1)                 :: c
+  integer                       :: i
+  integer, parameter            ::  upper_to_lower =IACHAR('a')-IACHAR('A')
+
+  VarName = Var
+  Name = 'MD___'//trim(Element)//VarName
+  do i=1,len(Name)
+    c=Name(i:i)
+    if('A'<=c .and. c <='Z') Name(i:i)=achar(iachar(c)+upper_to_lower)
+    if(c=='-'.or.c==':') Name(i:i)='_'
+  enddo
+  Status = WRF_NO_ERR
+  return
+end subroutine GetName
+
+subroutine GetTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character (*)         ,intent(in)     :: IO
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: DateStr
+  integer               ,intent(out)    :: TimeIndex
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: VStart(2)
+  integer                               :: VCount(2)
+  integer                               :: stat
+  integer                               :: i
+
+  DH => WrfDataHandles(DataHandle)
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    Status =  WRF_WARN_DATESTR_ERROR
+    write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(IO == 'write') then
+    TimeIndex = DH%TimeIndex
+    if(TimeIndex <= 0) then
+      TimeIndex = 1
+    elseif(DateStr == DH%Times(TimeIndex)) then
+      Status = WRF_NO_ERR
+      return
+    else
+      TimeIndex = TimeIndex +1
+      if(TimeIndex > MaxTimes) then
+        Status = WRF_WARN_TIME_EOF
+        write(msg,*) 'Warning TIME EOF in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    endif
+    DH%TimeIndex        = TimeIndex
+    DH%Times(TimeIndex) = DateStr
+    VStart(1) = 1
+    VStart(2) = TimeIndex
+    VCount(1) = DateStrLen
+    VCount(2) = 1
+    stat = NF_PUT_VARA_TEXT(DH%NCID,DH%TimesVarID,VStart,VCount,DateStr)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+  else
+    do i=1,MaxTimes
+      if(DH%Times(i)==DateStr) then
+        Status = WRF_NO_ERR
+        TimeIndex = i
+        exit
+      endif
+      if(i==MaxTimes) then
+        Status = WRF_WARN_TIME_NF
+        write(msg,*) 'Warning TIME ',DateStr,' NOT FOUND in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+  endif
+  return
+end subroutine GetTimeIndex
+
+subroutine GetDim(MemoryOrder,NDim,Status)
+  include 'wrf_status_codes.h'
+  character*(*) ,intent(in)  :: MemoryOrder
+  integer       ,intent(out) :: NDim
+  integer       ,intent(out) :: Status
+  character*3                :: MemOrd
+
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+    case ('xyz','xzy','yxz','yzx','zxy','zyx','xsz','xez','ysz','yez')
+      NDim = 3
+    case ('xy','yx','xs','xe','ys','ye')
+      NDim = 2
+    case ('z','c')
+      NDim = 1
+    case ('0')  ! NDim=0 for scalars.  TBH:  20060502
+      NDim = 0
+    case default
+      print *, 'memory order = ',MemOrd,'  ',MemoryOrder
+      Status = WRF_WARN_BAD_MEMORYORDER
+      return
+  end select
+  Status = WRF_NO_ERR
+  return
+end subroutine GetDim
+
+subroutine GetIndices(NDim,Start,End,i1,i2,j1,j2,k1,k2)
+  integer              ,intent(in)  :: NDim
+  integer ,dimension(*),intent(in)  :: Start,End
+  integer              ,intent(out) :: i1,i2,j1,j2,k1,k2
+
+  i1=1
+  i2=1
+  j1=1
+  j2=1
+  k1=1
+  k2=1
+  if(NDim == 0) return  ! NDim=0 for scalars.  TBH:  20060502
+  i1 = Start(1)
+  i2 = End  (1)
+  if(NDim == 1) return
+  j1 = Start(2)
+  j2 = End  (2)
+  if(NDim == 2) return
+  k1 = Start(3)
+  k2 = End  (3)
+  return
+end subroutine GetIndices
+
+subroutine ExtOrder(MemoryOrder,Vector,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  character*(*)              ,intent(in)    :: MemoryOrder
+  integer,dimension(*)       ,intent(inout) :: Vector
+  integer                    ,intent(out)   :: Status
+  integer                                   :: NDim
+  integer,dimension(NVarDims)               :: temp
+  character*3                               :: MemOrd
+
+  call GetDim(MemoryOrder,NDim,Status)
+  temp(1:NDim) = Vector(1:NDim)
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+
+    case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c')
+      continue
+    case ('0')
+      continue  ! NDim=0 for scalars.  TBH:  20060502
+    case ('xzy')
+      Vector(2) = temp(3)
+      Vector(3) = temp(2)
+    case ('yxz')
+      Vector(1) = temp(2)
+      Vector(2) = temp(1)
+    case ('yzx')
+      Vector(1) = temp(3)
+      Vector(2) = temp(1)
+      Vector(3) = temp(2)
+    case ('zxy')
+      Vector(1) = temp(2)
+      Vector(2) = temp(3)
+      Vector(3) = temp(1)
+    case ('zyx')
+      Vector(1) = temp(3)
+      Vector(3) = temp(1)
+    case ('yx')
+      Vector(1) = temp(2)
+      Vector(2) = temp(1)
+    case default
+      Status = WRF_WARN_BAD_MEMORYORDER
+      return
+  end select
+  Status = WRF_NO_ERR
+  return
+end subroutine ExtOrder
+
+subroutine ExtOrderStr(MemoryOrder,Vector,ROVector,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  character*(*)                    ,intent(in)    :: MemoryOrder
+  character*(*),dimension(*)       ,intent(in)    :: Vector
+  character(80),dimension(NVarDims),intent(out)   :: ROVector
+  integer                          ,intent(out)   :: Status
+  integer                                         :: NDim
+  character*3                                     :: MemOrd
+
+  call GetDim(MemoryOrder,NDim,Status)
+  ROVector(1:NDim) = Vector(1:NDim)
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+
+    case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c')
+      continue
+    case ('0')
+      continue  ! NDim=0 for scalars.  TBH:  20060502
+    case ('xzy')
+      ROVector(2) = Vector(3)
+      ROVector(3) = Vector(2)
+    case ('yxz')
+      ROVector(1) = Vector(2)
+      ROVector(2) = Vector(1)
+    case ('yzx')
+      ROVector(1) = Vector(3)
+      ROVector(2) = Vector(1)
+      ROVector(3) = Vector(2)
+    case ('zxy')
+      ROVector(1) = Vector(2)
+      ROVector(2) = Vector(3)
+      ROVector(3) = Vector(1)
+    case ('zyx')
+      ROVector(1) = Vector(3)
+      ROVector(3) = Vector(1)
+    case ('yx')
+      ROVector(1) = Vector(2)
+      ROVector(2) = Vector(1)
+    case default
+      Status = WRF_WARN_BAD_MEMORYORDER
+      return
+  end select
+  Status = WRF_NO_ERR
+  return
+end subroutine ExtOrderStr
+
+
+subroutine LowerCase(MemoryOrder,MemOrd)
+  character*(*) ,intent(in)  :: MemoryOrder
+  character*(*) ,intent(out) :: MemOrd
+  character*1                :: c
+  integer       ,parameter   :: upper_to_lower =IACHAR('a')-IACHAR('A')
+  integer                    :: i,N
+
+  MemOrd = ' '
+  N = len(MemoryOrder)
+  MemOrd(1:N) = MemoryOrder(1:N)
+  do i=1,N
+    c = MemoryOrder(i:i)
+    if('A'<=c .and. c <='Z') MemOrd(i:i)=achar(iachar(c)+upper_to_lower)
+  enddo
+  return
+end subroutine LowerCase
+
+subroutine UpperCase(MemoryOrder,MemOrd)
+  character*(*) ,intent(in)  :: MemoryOrder
+  character*(*) ,intent(out) :: MemOrd
+  character*1                :: c
+  integer     ,parameter     :: lower_to_upper =IACHAR('A')-IACHAR('a')
+  integer                    :: i,N
+
+  MemOrd = ' '
+  N = len(MemoryOrder)
+  MemOrd(1:N) = MemoryOrder(1:N)
+  do i=1,N
+    c = MemoryOrder(i:i)
+    if('a'<=c .and. c <='z') MemOrd(i:i)=achar(iachar(c)+lower_to_upper)
+  enddo
+  return
+end subroutine UpperCase
+
+subroutine netcdf_err(err,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer  ,intent(in)  :: err
+  integer  ,intent(out) :: Status
+  character(len=80)     :: errmsg
+  integer               :: stat
+
+  if( err==NF_NOERR )then
+    Status = WRF_NO_ERR
+  else
+    errmsg = NF_STRERROR(err) 
+    write(msg,*) 'NetCDF error: ',errmsg
+    call wrf_debug ( WARN , TRIM(msg))
+    Status = WRF_WARN_NETCDF
+  endif
+  return
+end subroutine netcdf_err
+
+subroutine FieldIO(IO,DataHandle,DateStr,Length,MemoryOrder &
+                     ,FieldType,NCID,VarID,XField,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character (*)              ,intent(in)    :: IO
+  integer                    ,intent(in)    :: DataHandle
+  character*(*)              ,intent(in)    :: DateStr
+  integer,dimension(NVarDims),intent(in)    :: Length
+  character*(*)              ,intent(in)    :: MemoryOrder
+  integer                    ,intent(in)    :: FieldType
+  integer                    ,intent(in)    :: NCID
+  integer                    ,intent(in)    :: VarID
+  integer,dimension(*)       ,intent(inout) :: XField
+  integer                    ,intent(out)   :: Status
+  integer                                   :: TimeIndex
+  integer                                   :: NDim
+  integer,dimension(NVarDims)               :: VStart
+  integer,dimension(NVarDims)               :: VCount
+
+  call GetTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    write(msg,*) '  Bad time index for DateStr = ',DateStr
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  call GetDim(MemoryOrder,NDim,Status)
+VStart(:) = 1
+VCount(:) = 1
+  VStart(1:NDim) = 1
+  VCount(1:NDim) = Length(1:NDim)
+  VStart(NDim+1) = TimeIndex
+  VCount(NDim+1) = 1
+
+  ! Do not use SELECT statement here as sometimes WRF_REAL=WRF_DOUBLE
+  IF (FieldType == WRF_REAL) THEN
+    call ext_ncd_RealFieldIO    (IO,NCID,VarID,VStart,VCount,XField,Status)
+  ELSE IF (FieldType == WRF_DOUBLE) THEN
+    call ext_ncd_DoubleFieldIO  (IO,NCID,VarID,VStart,VCount,XField,Status)
+  ELSE IF (FieldType == WRF_INTEGER) THEN
+    call ext_ncd_IntFieldIO     (IO,NCID,VarID,VStart,VCount,XField,Status)
+  ELSE IF (FieldType == WRF_LOGICAL) THEN
+    call ext_ncd_LogicalFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status)
+    if(Status /= WRF_NO_ERR) return
+  ELSE
+!for wrf_complex, double_complex
+      Status = WRF_WARN_DATA_TYPE_NOT_FOUND
+      write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+  END IF
+
+  return
+end subroutine FieldIO
+
+subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
+                                      ,XField,x1,x2,y1,y2,z1,z2 &
+                                             ,i1,i2,j1,j2,k1,k2 )
+  character*(*)     ,intent(in)    :: IO
+  character*(*)     ,intent(in)    :: MemoryOrder
+  integer           ,intent(in)    :: l1,l2,m1,m2,n1,n2
+  integer           ,intent(in)    :: di
+  integer           ,intent(in)    :: x1,x2,y1,y2,z1,z2
+  integer           ,intent(in)    :: i1,i2,j1,j2,k1,k2
+  integer           ,intent(inout) ::  Field(di,l1:l2,m1:m2,n1:n2)
+!jm 010827  integer           ,intent(inout) :: XField(di,x1:x2,y1:y2,z1:z2)
+  integer           ,intent(inout) :: XField(di,(i2-i1+1)*(j2-j1+1)*(k2-k1+1))
+  character*3                      :: MemOrd
+  character*3                      :: MemO
+  integer           ,parameter     :: MaxUpperCase=IACHAR('Z')
+  integer                          :: i,j,k,ix,jx,kx
+
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+
+!#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1))
+! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1))))
+
+    case ('xzy')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(i,k,j))
+#include "transpose.code"
+    case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c','0')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(i,j,k))
+#include "transpose.code"
+    case ('yxz')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(j,i,k))
+#include "transpose.code"
+    case ('zxy')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(k,i,j))
+#include "transpose.code"
+    case ('yzx')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(j,k,i))
+#include "transpose.code"
+    case ('zyx')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(k,j,i))
+#include "transpose.code"
+    case ('yx')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(j,i,k))
+#include "transpose.code"
+  end select
+  return
+end subroutine Transpose
+
+subroutine reorder (MemoryOrder,MemO)
+  character*(*)     ,intent(in)    :: MemoryOrder
+  character*3       ,intent(out)   :: MemO
+  character*3                      :: MemOrd
+  integer                          :: N,i,i1,i2,i3
+
+  MemO = MemoryOrder
+  N = len_trim(MemoryOrder)
+  if(N == 1) return
+  call lowercase(MemoryOrder,MemOrd)
+! never invert the boundary codes
+  select case ( MemOrd )
+     case ( 'xsz','xez','ysz','yez' )
+       return
+     case default
+       continue
+  end select
+  i1 = 1
+  i3 = 1
+  do i=2,N
+    if(ichar(MemOrd(i:i)) < ichar(MemOrd(i1:i1))) I1 = i
+    if(ichar(MemOrd(i:i)) > ichar(MemOrd(i3:i3))) I3 = i
+  enddo
+  if(N == 2) then
+    i2=i3
+  else
+    i2 = 6-i1-i3
+  endif
+  MemO(1:1) = MemoryOrder(i1:i1)
+  MemO(2:2) = MemoryOrder(i2:i2)
+  if(N == 3) MemO(3:3) = MemoryOrder(i3:i3)
+  if(MemOrd(i1:i1) == 's' .or. MemOrd(i1:i1) == 'e') then
+    MemO(1:N-1) = MemO(2:N)
+    MemO(N:N  ) = MemoryOrder(i1:i1)
+  endif
+  return
+end subroutine reorder
+  
+! Returns .TRUE. iff it is OK to write time-independent domain metadata to the 
+! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is 
+! returned.  
+LOGICAL FUNCTION ncd_ok_to_put_dom_ti( DataHandle )
+    USE wrf_data
+    include 'wrf_status_codes.h'
+    INTEGER, INTENT(IN) :: DataHandle 
+    CHARACTER*80 :: fname
+    INTEGER :: filestate
+    INTEGER :: Status
+    LOGICAL :: dryrun, first_output, retval
+    call ext_ncd_inquire_filename( DataHandle, fname, filestate, Status )
+    IF ( Status /= WRF_NO_ERR ) THEN
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+                   ', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg) )
+      retval = .FALSE.
+    ELSE
+      dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+      first_output = ncd_is_first_operation( DataHandle )
+      retval = .NOT. dryrun .AND. first_output
+    ENDIF
+    ncd_ok_to_put_dom_ti = retval
+    RETURN
+END FUNCTION ncd_ok_to_put_dom_ti
+
+! Returns .TRUE. iff it is OK to read time-independent domain metadata from the 
+! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is 
+! returned.  
+LOGICAL FUNCTION ncd_ok_to_get_dom_ti( DataHandle )
+    USE wrf_data
+    include 'wrf_status_codes.h'
+    INTEGER, INTENT(IN) :: DataHandle 
+    CHARACTER*80 :: fname
+    INTEGER :: filestate
+    INTEGER :: Status
+    LOGICAL :: dryrun, retval
+    call ext_ncd_inquire_filename( DataHandle, fname, filestate, Status )
+    IF ( Status /= WRF_NO_ERR ) THEN
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+                   ', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg) )
+      retval = .FALSE.
+    ELSE
+      dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+      retval = .NOT. dryrun
+    ENDIF
+    ncd_ok_to_get_dom_ti = retval
+    RETURN
+END FUNCTION ncd_ok_to_get_dom_ti
+
+! Returns .TRUE. iff nothing has been read from or written to the file 
+! referenced by DataHandle.  If DataHandle is invalid, .FALSE. is returned.  
+LOGICAL FUNCTION ncd_is_first_operation( DataHandle )
+    USE wrf_data
+    INCLUDE 'wrf_status_codes.h'
+    INTEGER, INTENT(IN) :: DataHandle 
+    TYPE(wrf_data_handle) ,POINTER :: DH
+    INTEGER :: Status
+    LOGICAL :: retval
+    CALL GetDH( DataHandle, DH, Status )
+    IF ( Status /= WRF_NO_ERR ) THEN
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+                   ', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg) )
+      retval = .FALSE.
+    ELSE
+      retval = DH%first_operation
+    ENDIF
+    ncd_is_first_operation = retval
+    RETURN
+END FUNCTION ncd_is_first_operation
+
+end module ext_ncd_support_routines
+
+subroutine ext_ncd_open_for_read(DatasetName, Comm1, Comm2, SysDepInfo, DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character *(*), INTENT(IN)   :: DatasetName
+  integer       , INTENT(IN)   :: Comm1, Comm2
+  character *(*), INTENT(IN)   :: SysDepInfo
+  integer       , INTENT(OUT)  :: DataHandle
+  integer       , INTENT(OUT)  :: Status
+  DataHandle = 0   ! dummy setting to quiet warning message
+  CALL ext_ncd_open_for_read_begin( DatasetName, Comm1, Comm2, SysDepInfo, DataHandle, Status )
+  IF ( Status .EQ. WRF_NO_ERR ) THEN
+    CALL ext_ncd_open_for_read_commit( DataHandle, Status )
+  ENDIF
+  return
+end subroutine ext_ncd_open_for_read
+
+!ends training phase; switches internal flag to enable input
+!must be paired with call to ext_ncd_open_for_read_begin
+subroutine ext_ncd_open_for_read_commit(DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer, intent(in) :: DataHandle
+  integer, intent(out) :: Status
+  type(wrf_data_handle) ,pointer         :: DH
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED
+    write(msg,*) 'ext_ncd_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus      = WRF_FILE_OPENED_FOR_READ
+  DH%first_operation  = .TRUE.
+  Status = WRF_NO_ERR
+  return
+end subroutine ext_ncd_open_for_read_commit
+
+subroutine ext_ncd_open_for_read_begin( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character*(*)         ,intent(IN)      :: FileName
+  integer               ,intent(IN)      :: Comm
+  integer               ,intent(IN)      :: IOComm
+  character*(*)         ,intent(in)      :: SysDepInfo
+  integer               ,intent(out)     :: DataHandle
+  integer               ,intent(out)     :: Status
+  type(wrf_data_handle) ,pointer         :: DH
+  integer                                :: XType
+  integer                                :: stat
+  integer               ,allocatable     :: Buffer(:)
+  integer                                :: VarID
+  integer                                :: StoredDim
+  integer                                :: NAtts
+  integer                                :: DimIDs(2)
+  integer                                :: VStart(2)
+  integer                                :: VLen(2)
+  integer                                :: TotalNumVars
+  integer                                :: NumVars
+  integer                                :: i
+  character (NF_MAX_NAME)                :: Name
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_ncd_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call allocHandle(DataHandle,DH,Comm,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_OPEN(FileName, NF_NOWRITE, DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_VARID(DH%NCID,DH%TimesName,VarID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_VAR(DH%NCID,VarID,DH%TimesName, XType, StoredDim, DimIDs, NAtts)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(XType/=NF_CHAR) then
+    Status = WRF_WARN_TYPE_MISMATCH
+    write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_DIMLEN(DH%NCID,DimIDs(1),VLen(1))  
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(VLen(1) /= DateStrLen) then
+    Status = WRF_WARN_DATESTR_BAD_LENGTH
+    write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_DIMLEN(DH%NCID,DimIDs(2),VLen(2))
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(VLen(2) > MaxTimes) then
+    Status = WRF_ERR_FATAL_TOO_MANY_TIMES
+    write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  VStart(1) = 1
+  VStart(2) = 1
+  stat = NF_GET_VARA_TEXT(DH%NCID,VarID,VStart,VLen,DH%Times)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_NVARS(DH%NCID,TotalNumVars)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  NumVars = 0
+  do i=1,TotalNumVars
+    stat = NF_INQ_VARNAME(DH%NCID,i,Name)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then
+      NumVars              = NumVars+1
+      DH%VarNames(NumVars) = Name
+      DH%VarIDs(NumVars)   = i
+    endif      
+  enddo
+  DH%NumVars         = NumVars
+  DH%NumberTimes     = VLen(2)
+  DH%FileStatus      = WRF_FILE_OPENED_NOT_COMMITTED
+  DH%FileName        = FileName
+  DH%CurrentVariable = 0
+  DH%CurrentTime     = 0
+  DH%TimesVarID      = VarID
+  DH%TimeIndex       = 0
+  return
+end subroutine ext_ncd_open_for_read_begin
+
+subroutine ext_ncd_open_for_update( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character*(*)         ,intent(IN)      :: FileName
+  integer               ,intent(IN)      :: Comm
+  integer               ,intent(IN)      :: IOComm
+  character*(*)         ,intent(in)      :: SysDepInfo
+  integer               ,intent(out)     :: DataHandle
+  integer               ,intent(out)     :: Status
+  type(wrf_data_handle) ,pointer         :: DH
+  integer                                :: XType
+  integer                                :: stat
+  integer               ,allocatable     :: Buffer(:)
+  integer                                :: VarID
+  integer                                :: StoredDim
+  integer                                :: NAtts
+  integer                                :: DimIDs(2)
+  integer                                :: VStart(2)
+  integer                                :: VLen(2)
+  integer                                :: TotalNumVars
+  integer                                :: NumVars
+  integer                                :: i
+  character (NF_MAX_NAME)                :: Name
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_ncd_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call allocHandle(DataHandle,DH,Comm,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_OPEN(FileName, NF_WRITE, DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_VARID(DH%NCID,DH%TimesName,VarID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_VAR(DH%NCID,VarID,DH%TimesName, XType, StoredDim, DimIDs, NAtts)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(XType/=NF_CHAR) then
+    Status = WRF_WARN_TYPE_MISMATCH
+    write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_DIMLEN(DH%NCID,DimIDs(1),VLen(1))  
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(VLen(1) /= DateStrLen) then
+    Status = WRF_WARN_DATESTR_BAD_LENGTH
+    write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_DIMLEN(DH%NCID,DimIDs(2),VLen(2))
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(VLen(2) > MaxTimes) then
+    Status = WRF_ERR_FATAL_TOO_MANY_TIMES
+    write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  VStart(1) = 1
+  VStart(2) = 1
+  stat = NF_GET_VARA_TEXT(DH%NCID,VarID,VStart,VLen,DH%Times)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NF_INQ_NVARS(DH%NCID,TotalNumVars)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  NumVars = 0
+  do i=1,TotalNumVars
+    stat = NF_INQ_VARNAME(DH%NCID,i,Name)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then
+      NumVars              = NumVars+1
+      DH%VarNames(NumVars) = Name
+      DH%VarIDs(NumVars)   = i
+    endif      
+  enddo
+  DH%NumVars         = NumVars
+  DH%NumberTimes     = VLen(2)
+  DH%FileStatus      = WRF_FILE_OPENED_FOR_UPDATE
+  DH%FileName        = FileName
+  DH%CurrentVariable = 0
+  DH%CurrentTime     = 0
+  DH%TimesVarID      = VarID
+  DH%TimeIndex       = 0
+  return
+end subroutine ext_ncd_open_for_update
+
+
+SUBROUTINE ext_ncd_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,DataHandle,Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character*(*)        ,intent(in)  :: FileName
+  integer              ,intent(in)  :: Comm
+  integer              ,intent(in)  :: IOComm
+  character*(*)        ,intent(in)  :: SysDepInfo
+  integer              ,intent(out) :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: i
+  integer                           :: stat
+  character (7)                     :: Buffer
+  integer                           :: VDimIDs(2)
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_ncd_open_for_write_begin: ext_ncd_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call allocHandle(DataHandle,DH,Comm,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Fatal ALLOCATION ERROR in ext_ncd_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  DH%TimeIndex = 0
+  DH%Times     = ZeroDate
+  stat = NF_CREATE(FileName, NF_CLOBBER, DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_ncd_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus  = WRF_FILE_OPENED_NOT_COMMITTED
+  DH%FileName    = FileName
+  stat = NF_DEF_DIM(DH%NCID,DH%DimUnlimName,NF_UNLIMITED,DH%DimUnlimID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_ncd_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%VarNames  (1:MaxVars) = NO_NAME
+  DH%MDVarNames(1:MaxVars) = NO_NAME
+  do i=1,MaxDims
+    write(Buffer,FMT="('DIM',i4.4)") i
+    DH%DimNames  (i) = Buffer
+    DH%DimLengths(i) = NO_DIM
+  enddo
+  DH%DimNames(1) = 'DateStrLen'
+  stat = NF_DEF_DIM(DH%NCID,DH%DimNames(1),DateStrLen,DH%DimIDs(1))
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_ncd_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  VDimIDs(1) = DH%DimIDs(1)
+  VDimIDs(2) = DH%DimUnlimID
+  stat = NF_DEF_VAR(DH%NCID,DH%TimesName,NF_CHAR,2,VDimIDs,DH%TimesVarID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_ncd_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%DimLengths(1) = DateStrLen
+  return
+end subroutine ext_ncd_open_for_write_begin
+
+!stub
+!opens a file for writing or coupler datastream for sending messages.
+!no training phase for this version of the open stmt.
+subroutine ext_ncd_open_for_write (DatasetName, Comm1, Comm2, &
+                                   SysDepInfo, DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character *(*), intent(in)  ::DatasetName
+  integer       , intent(in)  ::Comm1, Comm2
+  character *(*), intent(in)  ::SysDepInfo
+  integer       , intent(out) :: DataHandle
+  integer       , intent(out) :: Status
+  Status=WRF_WARN_NOOP
+  DataHandle = 0    ! dummy setting to quiet warning message
+  return
+end subroutine ext_ncd_open_for_write
+
+SUBROUTINE ext_ncd_open_for_write_commit(DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: i
+  integer                           :: stat
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_ncd_open_for_write_commit: ext_ncd_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ext_ncd_open_for_write_commit ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg)) 
+    return
+  endif
+  stat = NF_ENDDEF(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_ncd_open_for_write_commit ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus  = WRF_FILE_OPENED_FOR_WRITE
+  DH%first_operation  = .TRUE.
+  return
+end subroutine ext_ncd_open_for_write_commit
+
+subroutine ext_ncd_ioclose(DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: stat
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ext_ncd_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ext_ncd_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_CLOSE
+    write(msg,*) 'Warning TRY TO CLOSE DRYRUN in ext_ncd_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    continue    
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    continue
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
+    continue
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ext_ncd_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+
+  stat = NF_CLOSE(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_ncd_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  CALL deallocHandle( DataHandle, Status )
+  DH%Free=.true.
+  return
+end subroutine ext_ncd_ioclose
+
+subroutine ext_ncd_iosync( DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: stat
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ext_ncd_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ext_ncd_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_FILE_NOT_COMMITTED
+    write(msg,*) 'Warning FILE NOT COMMITTED in ext_ncd_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    continue
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    continue
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ext_ncd_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  stat = NF_SYNC(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_ncd_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  return
+end subroutine ext_ncd_iosync
+
+
+
+subroutine ext_ncd_redef( DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: stat
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_FILE_NOT_COMMITTED
+    write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    continue
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_FILE_OPEN_FOR_READ
+    write(msg,*) 'Warning FILE OPEN FOR READ in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  stat = NF_REDEF(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus  = WRF_FILE_OPENED_NOT_COMMITTED
+  return
+end subroutine ext_ncd_redef
+
+subroutine ext_ncd_enddef( DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: stat
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_FILE_NOT_COMMITTED
+    write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    continue
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_FILE_OPEN_FOR_READ
+    write(msg,*) 'Warning FILE OPEN FOR READ in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  stat = NF_ENDDEF(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus  = WRF_FILE_OPENED_FOR_WRITE
+  return
+end subroutine ext_ncd_enddef
+
+subroutine ext_ncd_ioinit(SysDepInfo, Status)
+  use wrf_data
+  implicit none
+  include 'wrf_status_codes.h'
+  CHARACTER*(*), INTENT(IN) :: SysDepInfo
+  INTEGER ,INTENT(INOUT)    :: Status
+
+  WrfIOnotInitialized                             = .false.
+  WrfDataHandles(1:WrfDataHandleMax)%Free         = .true.
+  WrfDataHandles(1:WrfDataHandleMax)%TimesName    = 'Times'
+  WrfDataHandles(1:WrfDataHandleMax)%DimUnlimName = 'Time'
+  WrfDataHandles(1:WrfDataHandleMax)%FileStatus   = WRF_FILE_NOT_OPENED
+  Status = WRF_NO_ERR
+  return
+end subroutine ext_ncd_ioinit
+
+
+subroutine ext_ncd_inquiry (Inquiry, Result, Status)
+  use wrf_data
+  implicit none
+  include 'wrf_status_codes.h'
+  character *(*), INTENT(IN)    :: Inquiry
+  character *(*), INTENT(OUT)   :: Result
+  integer        ,INTENT(INOUT) :: Status
+  SELECT CASE (Inquiry)
+  CASE ("RANDOM_WRITE","RANDOM_READ","SEQUENTIAL_WRITE","SEQUENTIAL_READ")
+        Result='ALLOW'
+  CASE ("OPEN_READ","OPEN_COMMIT_WRITE")
+        Result='REQUIRE'
+  CASE ("OPEN_WRITE","OPEN_COMMIT_READ","PARALLEL_IO")
+        Result='NO'
+  CASE ("SELF_DESCRIBING","SUPPORT_METADATA","SUPPORT_3D_FIELDS")
+        Result='YES'
+  CASE ("MEDIUM")
+        Result ='FILE'
+  CASE DEFAULT
+      Result = 'No Result for that inquiry!'
+  END SELECT
+  Status=WRF_NO_ERR
+  return
+end subroutine ext_ncd_inquiry
+
+
+
+
+subroutine ext_ncd_ioexit(Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer       , INTENT(INOUT)     ::Status
+  integer                           :: error
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: i
+  integer                           :: stat
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_ncd_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  do i=1,WrfDataHandleMax
+    CALL deallocHandle( i , stat ) 
+  enddo
+  return
+end subroutine ext_ncd_ioexit
+
+subroutine ext_ncd_get_dom_ti_real(DataHandle,Element,Data,Count,OutCount,Status)
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA real,intent(out) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCOunt
+#define TYPE_BUFFER  real,allocatable :: Buffer(:)
+#define NF_TYPE NF_FLOAT
+#define NF_ROUTINE NF_GET_ATT_REAL 
+#define COPY   Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
+#include "ext_ncd_get_dom_ti.code"
+end subroutine ext_ncd_get_dom_ti_real
+
+subroutine ext_ncd_get_dom_ti_integer(DataHandle,Element,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA 
+#undef TYPE_BUFFER
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA integer,intent(out) :: Data(*)
+#define TYPE_BUFFER  integer,allocatable :: Buffer(:)
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NF_GET_ATT_INT
+#define COPY   Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
+#include "ext_ncd_get_dom_ti.code"
+end subroutine ext_ncd_get_dom_ti_integer
+
+subroutine ext_ncd_get_dom_ti_double(DataHandle,Element,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA 
+#undef TYPE_BUFFER
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA real*8,intent(out) :: Data(*)
+#define TYPE_BUFFER  real*8,allocatable :: Buffer(:)
+#define NF_TYPE NF_DOUBLE
+#define NF_ROUTINE NF_GET_ATT_DOUBLE
+#define COPY   Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
+#include "ext_ncd_get_dom_ti.code"
+end subroutine ext_ncd_get_dom_ti_double
+
+subroutine ext_ncd_get_dom_ti_logical(DataHandle,Element,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA 
+#undef TYPE_BUFFER
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA logical,intent(out) :: Data(*)
+#define TYPE_BUFFER  integer,allocatable :: Buffer(:)
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NF_GET_ATT_INT
+#define COPY   Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))==1
+#include "ext_ncd_get_dom_ti.code"
+end subroutine ext_ncd_get_dom_ti_logical
+
+subroutine ext_ncd_get_dom_ti_char(DataHandle,Element,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef TYPE_BUFFER
+#undef NF_TYPE
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA character*(*),intent(out) :: Data
+#define TYPE_COUNT
+#define TYPE_OUTCOUNT
+#define TYPE_BUFFER
+#define NF_TYPE NF_CHAR
+#define CHAR_TYPE
+#include "ext_ncd_get_dom_ti.code"
+#undef CHAR_TYPE
+end subroutine ext_ncd_get_dom_ti_char
+
+subroutine ext_ncd_put_dom_ti_real(DataHandle,Element,Data,Count,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA 
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA  real   ,intent(in) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_ATT_REAL
+#define ARGS NF_FLOAT,Count,Data
+#include "ext_ncd_put_dom_ti.code"
+end subroutine ext_ncd_put_dom_ti_real
+
+subroutine ext_ncd_put_dom_ti_integer(DataHandle,Element,Data,Count,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA  integer,intent(in) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_ATT_INT
+#define ARGS NF_INT,Count,Data
+#include "ext_ncd_put_dom_ti.code"
+end subroutine ext_ncd_put_dom_ti_integer
+
+subroutine ext_ncd_put_dom_ti_double(DataHandle,Element,Data,Count,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA  real*8 ,intent(in) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_ATT_DOUBLE
+#define ARGS NF_DOUBLE,Count,Data
+#include "ext_ncd_put_dom_ti.code"
+end subroutine ext_ncd_put_dom_ti_double
+
+subroutine ext_ncd_put_dom_ti_logical(DataHandle,Element,Data,Count,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA  logical,intent(in) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_ATT_INT
+#define ARGS NF_INT,Count,Buffer
+#define LOG
+#include "ext_ncd_put_dom_ti.code"
+end subroutine ext_ncd_put_dom_ti_logical
+
+subroutine ext_ncd_put_dom_ti_char(DataHandle,Element,Data,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA  character*(*),intent(in) :: Data
+#define TYPE_COUNT integer,parameter :: Count=1
+#define NF_ROUTINE NF_PUT_ATT_TEXT
+#define ARGS len_trim(Data),Data
+#include "ext_ncd_put_dom_ti.code"
+end subroutine ext_ncd_put_dom_ti_char
+
+subroutine ext_ncd_put_var_ti_real(DataHandle,Element,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA  real    ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_ATT_REAL
+#define ARGS NF_FLOAT,Count,Data
+#include "ext_ncd_put_var_ti.code"
+end subroutine ext_ncd_put_var_ti_real
+
+subroutine ext_ncd_put_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#undef LOG
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA  real    ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_VARA_REAL
+#define NF_TYPE NF_FLOAT
+#define LENGTH Count
+#define ARG 
+#include "ext_ncd_put_var_td.code"
+end subroutine ext_ncd_put_var_td_real
+
+subroutine ext_ncd_put_var_ti_double(DataHandle,Element,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA  real*8 ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_ATT_DOUBLE
+#define ARGS NF_DOUBLE,Count,Data
+#include "ext_ncd_put_var_ti.code"
+end subroutine ext_ncd_put_var_ti_double
+
+subroutine ext_ncd_put_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#undef LOG
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA  real*8,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_VARA_DOUBLE
+#define NF_TYPE NF_DOUBLE
+#define LENGTH Count
+#define ARG 
+#include "ext_ncd_put_var_td.code"
+end subroutine ext_ncd_put_var_td_double
+
+subroutine ext_ncd_put_var_ti_integer(DataHandle,Element,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA  integer ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_ATT_INT
+#define ARGS NF_INT,Count,Data 
+#include "ext_ncd_put_var_ti.code"
+end subroutine ext_ncd_put_var_ti_integer
+
+subroutine ext_ncd_put_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#undef LOG
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA  integer ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_VARA_INT
+#define NF_TYPE NF_INT
+#define LENGTH Count
+#define ARG 
+#include "ext_ncd_put_var_td.code"
+end subroutine ext_ncd_put_var_td_integer
+
+subroutine ext_ncd_put_var_ti_logical(DataHandle,Element,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS 
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA  logical ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_ATT_INT
+#define LOG
+#define ARGS NF_INT,Count,Buffer
+#include "ext_ncd_put_var_ti.code"
+end subroutine ext_ncd_put_var_ti_logical
+
+subroutine ext_ncd_put_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA  logical ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NF_PUT_VARA_INT
+#define NF_TYPE NF_INT
+#define LOG
+#define LENGTH Count
+#define ARG 
+#include "ext_ncd_put_var_td.code"
+end subroutine ext_ncd_put_var_td_logical
+
+subroutine ext_ncd_put_var_ti_char(DataHandle,Element,Var,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA  character*(*) ,intent(in) :: Data
+#define TYPE_COUNT 
+#define NF_ROUTINE NF_PUT_ATT_TEXT
+#define ARGS len_trim(Data),trim(Data)
+#define CHAR_TYPE
+#include "ext_ncd_put_var_ti.code"
+#undef CHAR_TYPE
+end subroutine ext_ncd_put_var_ti_char
+
+subroutine ext_ncd_put_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#undef LOG
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA  character*(*) ,intent(in) :: Data
+#define TYPE_COUNT 
+#define NF_ROUTINE NF_PUT_VARA_TEXT
+#define NF_TYPE NF_CHAR
+#define LENGTH len(Data)
+#include "ext_ncd_put_var_td.code"
+end subroutine ext_ncd_put_var_td_char
+
+subroutine ext_ncd_get_var_ti_real(DataHandle,Element,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA     real   ,intent(out) :: Data(*)
+#define TYPE_BUFFER   real   ,allocatable :: Buffer(:)
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_FLOAT
+#define NF_ROUTINE NF_GET_ATT_REAL
+#define COPY   Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
+#include "ext_ncd_get_var_ti.code"
+end subroutine ext_ncd_get_var_ti_real
+
+subroutine ext_ncd_get_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#undef COPY
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA     real   ,intent(out) :: Data(*)
+#define TYPE_BUFFER real
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_FLOAT
+#define NF_ROUTINE NF_GET_VARA_REAL
+#define LENGTH min(Count,Len1)
+#define COPY   Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
+#include "ext_ncd_get_var_td.code"
+end subroutine ext_ncd_get_var_td_real
+
+subroutine ext_ncd_get_var_ti_double(DataHandle,Element,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA     real*8 ,intent(out) :: Data(*)
+#define TYPE_BUFFER   real*8 ,allocatable :: Buffer(:)
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_DOUBLE
+#define NF_ROUTINE NF_GET_ATT_DOUBLE
+#define COPY   Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
+#include "ext_ncd_get_var_ti.code"
+end subroutine ext_ncd_get_var_ti_double
+
+subroutine ext_ncd_get_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#undef COPY
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA     real*8 ,intent(out) :: Data(*)
+#define TYPE_BUFFER real*8
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_DOUBLE
+#define NF_ROUTINE NF_GET_VARA_DOUBLE
+#define LENGTH min(Count,Len1)
+#define COPY   Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
+#include "ext_ncd_get_var_td.code"
+end subroutine ext_ncd_get_var_td_double
+
+subroutine ext_ncd_get_var_ti_integer(DataHandle,Element,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA     integer,intent(out) :: Data(*)
+#define TYPE_BUFFER   integer,allocatable :: Buffer(:)
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NF_GET_ATT_INT
+#define COPY   Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
+#include "ext_ncd_get_var_ti.code"
+end subroutine ext_ncd_get_var_ti_integer
+
+subroutine ext_ncd_get_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#undef COPY
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA     integer,intent(out) :: Data(*)
+#define TYPE_BUFFER integer
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NF_GET_VARA_INT
+#define LENGTH min(Count,Len1)
+#define COPY   Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
+#include "ext_ncd_get_var_td.code"
+end subroutine ext_ncd_get_var_td_integer
+
+subroutine ext_ncd_get_var_ti_logical(DataHandle,Element,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA     logical,intent(out) :: Data(*)
+#define TYPE_BUFFER   integer,allocatable :: Buffer(:)
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NF_GET_ATT_INT
+#define COPY   Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))==1
+#include "ext_ncd_get_var_ti.code"
+end subroutine ext_ncd_get_var_ti_logical
+
+subroutine ext_ncd_get_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#undef COPY
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA     logical,intent(out) :: Data(*)
+#define TYPE_BUFFER   integer
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NF_GET_VARA_INT
+#define LENGTH min(Count,Len1)
+#define COPY   Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))==1
+#include "ext_ncd_get_var_td.code"
+end subroutine ext_ncd_get_var_td_logical
+
+subroutine ext_ncd_get_var_ti_char(DataHandle,Element,Var,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA   character*(*) ,intent(out) :: Data
+#define TYPE_BUFFER
+#define TYPE_COUNT integer :: Count = 1
+#define TYPE_OUTCOUNT
+#define NF_TYPE NF_CHAR
+#define NF_ROUTINE NF_GET_ATT_TEXT
+#define COPY 
+#define CHAR_TYPE
+#include "ext_ncd_get_var_ti.code"
+#undef CHAR_TYPE
+end subroutine ext_ncd_get_var_ti_char
+
+subroutine ext_ncd_get_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA character*(*) ,intent(out)    :: Data
+#define TYPE_BUFFER character (80)
+#define TYPE_COUNT integer :: Count = 1
+#define TYPE_OUTCOUNT
+#define NF_TYPE NF_CHAR
+#define NF_ROUTINE NF_GET_VARA_TEXT
+#define LENGTH Len1
+#define CHAR_TYPE
+#include "ext_ncd_get_var_td.code"
+#undef CHAR_TYPE
+end subroutine ext_ncd_get_var_td_char
+
+subroutine ext_ncd_put_dom_td_real(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real                  ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_ncd_put_var_td_real(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status)
+  return
+end subroutine ext_ncd_put_dom_td_real
+
+subroutine ext_ncd_put_dom_td_integer(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  integer               ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_ncd_put_var_td_integer(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,Status)
+  return
+end subroutine ext_ncd_put_dom_td_integer
+
+subroutine ext_ncd_put_dom_td_double(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real*8                ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_ncd_put_var_td_double(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'   ,Data,Count,Status)
+  return
+end subroutine ext_ncd_put_dom_td_double
+
+subroutine ext_ncd_put_dom_td_logical(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  logical               ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_ncd_put_var_td_logical(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,Status)
+  return
+end subroutine ext_ncd_put_dom_td_logical
+
+subroutine ext_ncd_put_dom_td_char(DataHandle,Element,DateStr,Data,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  character*(*)         ,intent(in)     :: Data
+  integer               ,intent(out)    :: Status
+
+  call ext_ncd_put_var_td_char(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
+  return
+end subroutine ext_ncd_put_dom_td_char
+
+subroutine ext_ncd_get_dom_td_real(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real                  ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  call ext_ncd_get_var_td_real(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status)
+  return
+end subroutine ext_ncd_get_dom_td_real
+
+subroutine ext_ncd_get_dom_td_integer(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  integer               ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  call ext_ncd_get_var_td_integer(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,OutCount,Status)
+  return
+end subroutine ext_ncd_get_dom_td_integer
+
+subroutine ext_ncd_get_dom_td_double(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real*8                ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  call ext_ncd_get_var_td_double(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'   ,Data,Count,OutCount,Status)
+  return
+end subroutine ext_ncd_get_dom_td_double
+
+subroutine ext_ncd_get_dom_td_logical(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  logical               ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  call ext_ncd_get_var_td_logical(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,OutCount,Status)
+  return
+end subroutine ext_ncd_get_dom_td_logical
+
+subroutine ext_ncd_get_dom_td_char(DataHandle,Element,DateStr,Data,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  character*(*)         ,intent(out)    :: Data
+  integer               ,intent(out)    :: Status
+  call ext_ncd_get_var_td_char(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
+  return
+end subroutine ext_ncd_get_dom_td_char
+
+
+subroutine ext_ncd_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm, &
+  IOComm, DomainDesc, MemoryOrdIn, Stagger,  DimNames,                      &
+  DomainStart,DomainEnd,MemoryStart,MemoryEnd,PatchStart,PatchEnd,Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer                       ,intent(in)    :: DataHandle
+  character*(*)                 ,intent(in)    :: DateStr
+  character*(*)                 ,intent(in)    :: Var
+  integer                       ,intent(inout) :: Field(*)
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrdIn
+  character*(*)                 ,intent(in)    :: Stagger ! Dummy for now
+  character*(*) ,dimension(*)   ,intent(in)    :: DimNames
+  integer       ,dimension(*)   ,intent(in)    :: DomainStart, DomainEnd
+  integer       ,dimension(*)   ,intent(in)    :: MemoryStart, MemoryEnd
+  integer       ,dimension(*)   ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+  character (3)                                :: MemoryOrder
+  type(wrf_data_handle)         ,pointer       :: DH
+  integer                                      :: NCID
+  integer                                      :: NDim
+  character (VarNameLen)                       :: VarName
+  character (3)                                :: MemO
+  character (3)                                :: UCMemO
+  integer                                      :: VarID
+  integer      ,dimension(NVarDims)            :: Length
+  integer      ,dimension(NVarDims)            :: VDimIDs
+  character(80),dimension(NVarDims)            :: RODimNames
+  integer      ,dimension(NVarDims)            :: StoredStart
+  integer      ,dimension(:,:,:,:),allocatable :: XField
+  integer                                      :: stat
+  integer                                      :: NVar
+  integer                                      :: i,j
+  integer                                      :: i1,i2,j1,j2,k1,k2
+  integer                                      :: x1,x2,y1,y2,z1,z2
+  integer                                      :: l1,l2,m1,m2,n1,n2
+  integer                                      :: XType
+  integer                                      :: di
+  character (80)                               :: NullName
+  logical                                      :: NotFound
+
+  MemoryOrder = trim(adjustl(MemoryOrdIn))
+  NullName=char(0)
+  call GetDim(MemoryOrder,NDim,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning BAD MEMORY ORDER |',MemoryOrder,'| in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning DATE STRING ERROR |',DateStr,'| in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  VarName = Var
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  NCID = DH%NCID
+
+  write(msg,*)'ext_ncd_write_field: called for ',TRIM(Var)
+
+!jm 010827  Length(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1
+
+  Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
+
+  call ExtOrder(MemoryOrder,Length,Status)
+  call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status)
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_WRITE_RONLY_FILE
+    write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    do NVar=1,MaxVars
+      if(DH%VarNames(NVar) == VarName ) then
+        Status = WRF_WARN_2DRYRUNS_1VARIABLE
+        write(msg,*) 'Warning 2 DRYRUNS 1 VARIABLE in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      elseif(DH%VarNames(NVar) == NO_NAME) then
+        DH%VarNames(NVar) = VarName
+        DH%NumVars        = NVar
+        exit
+      elseif(NVar == MaxVars) then
+        Status = WRF_WARN_TOO_MANY_VARIABLES
+        write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+    do j = 1,NDim
+      if(RODimNames(j) == NullName .or. RODimNames(j) == '') then
+        do i=1,MaxDims
+          if(DH%DimLengths(i) == Length(j)) then
+            exit
+          elseif(DH%DimLengths(i) == NO_DIM) then
+            stat = NF_DEF_DIM(NCID,DH%DimNames(i),Length(j),DH%DimIDs(i))
+            call netcdf_err(stat,Status)
+            if(Status /= WRF_NO_ERR) then
+              write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+              call wrf_debug ( WARN , TRIM(msg))
+              return
+            endif
+            DH%DimLengths(i) = Length(j)
+            exit
+          elseif(i == MaxDims) then
+            Status = WRF_WARN_TOO_MANY_DIMS
+            write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ 
+            call wrf_debug ( WARN , TRIM(msg))
+            return
+          endif
+        enddo
+      else !look for input name and check if already defined
+        NotFound = .true.
+        do i=1,MaxDims
+          if (DH%DimNames(i) == RODimNames(j)) then
+            if (DH%DimLengths(i) == Length(j)) then
+              NotFound = .false.
+              exit
+            else
+              Status = WRF_WARN_DIMNAME_REDEFINED
+              write(msg,*) 'Warning DIM ',i,', NAME ',TRIM(DH%DimNames(i)),' REDIFINED  by var ', &
+                           TRIM(Var),' ',DH%DimLengths(i),Length(j) ,' in ', __FILE__ ,' line', __LINE__ 
+              call wrf_debug ( WARN , TRIM(msg))
+              return
+            endif
+          endif
+        enddo
+        if (NotFound) then
+          do i=1,MaxDims
+            if (DH%DimLengths(i) == NO_DIM) then
+              DH%DimNames(i) = RODimNames(j)
+              stat = NF_DEF_DIM(NCID,DH%DimNames(i),Length(j),DH%DimIDs(i))
+              call netcdf_err(stat,Status)
+              if(Status /= WRF_NO_ERR) then
+                write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+                call wrf_debug ( WARN , TRIM(msg))
+                return
+              endif
+              DH%DimLengths(i) = Length(j)
+              exit
+            elseif(i == MaxDims) then
+              Status = WRF_WARN_TOO_MANY_DIMS
+              write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ 
+              call wrf_debug ( WARN , TRIM(msg))
+              return
+            endif
+          enddo
+        endif
+      endif
+      VDimIDs(j) = DH%DimIDs(i)
+      DH%VarDimLens(j,NVar) = Length(j)
+    enddo
+    VDimIDs(NDim+1) = DH%DimUnlimID
+
+    ! Do not use SELECT statement here as sometimes WRF_REAL=WRF_DOUBLE
+    IF (FieldType == WRF_REAL) THEN
+      XType = NF_FLOAT
+    ELSE IF (FieldType == WRF_DOUBLE) THEN
+      Xtype = NF_DOUBLE
+    ELSE IF (FieldType == WRF_INTEGER) THEN
+      XType = NF_INT
+    ELSE IF (FieldType == WRF_LOGICAL) THEN
+      XType = NF_INT
+    ELSE
+        Status = WRF_WARN_DATA_TYPE_NOT_FOUND
+        write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+    END IF
+
+    stat = NF_DEF_VAR(NCID,VarName,XType,NDim+1,VDimIDs,VarID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'ext_ncd_write_field: NetCDF error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    DH%VarIDs(NVar) = VarID
+    stat = NF_PUT_ATT_INT(NCID,VarID,'FieldType',NF_INT,1,FieldType)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'ext_ncd_write_field: NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    call reorder(MemoryOrder,MemO)
+    call uppercase(MemO,UCMemO)
+    stat = NF_PUT_ATT_TEXT(NCID,VarID,'MemoryOrder',3,UCMemO)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'ext_ncd_write_field: NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
+    do NVar=1,DH%NumVars
+      if(DH%VarNames(NVar) == VarName) then
+        exit
+      elseif(NVar == DH%NumVars) then
+        Status = WRF_WARN_VAR_NF
+        write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+    VarID = DH%VarIDs(NVar)
+    do j=1,NDim
+      if(Length(j) /= DH%VarDimLens(j,NVar) .AND. DH%FileStatus /= WRF_FILE_OPENED_FOR_UPDATE ) then
+        Status = WRF_WARN_WRTLEN_NE_DRRUNLEN
+        write(msg,*) 'Warning LENGTH != DRY RUN LENGTH for |',   &
+                     VarName,'| dim ',j,' in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        write(msg,*) '   LENGTH ',Length(j),' DRY RUN LENGTH ',DH%VarDimLens(j,NVar)
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+!jm 010825      elseif(DomainStart(j) < MemoryStart(j)) then
+      elseif(PatchStart(j) < MemoryStart(j)) then
+        Status = WRF_WARN_DIMENSION_ERROR
+        write(msg,*) 'Warning DIMENSION ERROR for |',VarName,    &
+                     '| in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+    StoredStart = 1
+    call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
+    call GetIndices(NDim,StoredStart,Length   ,x1,x2,y1,y2,z1,z2)
+    call GetIndices(NDim,PatchStart, PatchEnd ,i1,i2,j1,j2,k1,k2)
+    di=1
+    if(FieldType == WRF_DOUBLE) di=2
+    allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+      write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+      call wrf_debug ( FATAL , TRIM(msg))
+      return
+    endif
+    call Transpose('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
+                                         ,XField,x1,x2,y1,y2,z1,z2 &
+                                                ,i1,i2,j1,j2,k1,k2 )
+    call FieldIO('write',DataHandle,DateStr,Length,MemoryOrder, &
+                  FieldType,NCID,VarID,XField,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    deallocate(XField, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+      call wrf_debug ( FATAL , TRIM(msg))
+      return
+    endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , TRIM(msg))
+  endif
+  DH%first_operation  = .FALSE.
+  return
+end subroutine ext_ncd_write_field
+
+subroutine ext_ncd_read_field(DataHandle,DateStr,Var,Field,FieldType,Comm,  &
+  IOComm, DomainDesc, MemoryOrdIn, Stagger, DimNames,                       &
+  DomainStart,DomainEnd,MemoryStart,MemoryEnd,PatchStart,PatchEnd,Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer                       ,intent(in)    :: DataHandle
+  character*(*)                 ,intent(in)    :: DateStr
+  character*(*)                 ,intent(in)    :: Var
+  integer                       ,intent(out)   :: Field(*)
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrdIn
+  character*(*)                 ,intent(in)    :: Stagger ! Dummy for now
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+  character (3)                                :: MemoryOrder
+  character (NF_MAX_NAME)                      :: dimname
+  type(wrf_data_handle)         ,pointer       :: DH
+  integer                                      :: NDim
+  integer                                      :: NCID
+  character (VarNameLen)                       :: VarName
+  integer                                      :: VarID
+  integer ,dimension(NVarDims)                 :: VCount
+  integer ,dimension(NVarDims)                 :: VStart
+  integer ,dimension(NVarDims)                 :: Length
+  integer ,dimension(NVarDims)                 :: VDimIDs
+  integer ,dimension(NVarDims)                 :: MemS
+  integer ,dimension(NVarDims)                 :: MemE
+  integer ,dimension(NVarDims)                 :: StoredStart
+  integer ,dimension(NVarDims)                 :: StoredLen
+  integer ,dimension(:,:,:,:)   ,allocatable   :: XField
+  integer                                      :: NVar
+  integer                                      :: j
+  integer                                      :: i1,i2,j1,j2,k1,k2
+  integer                                      :: x1,x2,y1,y2,z1,z2
+  integer                                      :: l1,l2,m1,m2,n1,n2
+  character (VarNameLen)                       :: Name
+  integer                                      :: XType
+  integer                                      :: StoredDim
+  integer                                      :: NAtts
+  integer                                      :: Len
+  integer                                      :: stat
+  integer                                      :: di
+  integer                                      :: FType
+
+  MemoryOrder = trim(adjustl(MemoryOrdIn))
+  call GetDim(MemoryOrder,NDim,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning BAD MEMORY ORDER |',TRIM(MemoryOrder),'| for |', &
+                 TRIM(Var),'| in ext_ncd_read_field ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning DATE STRING ERROR |',TRIM(DateStr),'| for |',TRIM(Var), &
+                 '| in ext_ncd_read_field ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  VarName = Var
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ext_ncd_read_field ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+! jm it is okay to have a dry run read. means read is called between ofrb and ofrc. Just return.
+!    Status = WRF_WARN_DRYRUN_READ
+!    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+!    call wrf_debug ( WARN , TRIM(msg))
+    Status = WRF_NO_ERR
+    RETURN
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then
+    NCID = DH%NCID
+
+!jm    Length(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1
+    Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
+    call ExtOrder(MemoryOrder,Length,Status)
+    stat = NF_INQ_VARID(NCID,VarName,VarID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Varname ',Varname
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NF_INQ_VAR(NCID,VarID,Name,XType,StoredDim,VDimIDs,NAtts)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NF_GET_ATT_INT(NCID,VarID,'FieldType',FType)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+! allow coercion between double and single prec real
+!jm    if(FieldType /= Ftype) then
+    if( (FieldType == WRF_REAL .OR. FieldType == WRF_DOUBLE) ) then
+      if ( .NOT. (Ftype     == WRF_REAL .OR. Ftype     == WRF_DOUBLE ))  then
+        Status = WRF_WARN_TYPE_MISMATCH
+        write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    else if(FieldType /= Ftype) then
+      Status = WRF_WARN_TYPE_MISMATCH
+      write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif      
+      
+    ! Do not use SELECT statement here as sometimes WRF_REAL=WRF_DOUBLE
+    IF (FieldType == WRF_REAL) THEN
+! allow coercion between double and single prec real
+        if(.NOT. (XType == NF_FLOAT .OR. XType == NF_DOUBLE) )  then
+          Status = WRF_WARN_TYPE_MISMATCH
+          write(msg,*) 'Warning REAL TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        endif
+    ELSE IF (FieldType == WRF_DOUBLE) THEN
+! allow coercion between double and single prec real
+        if(.NOT. (XType == NF_FLOAT .OR. XType == NF_DOUBLE) )  then
+          Status = WRF_WARN_TYPE_MISMATCH
+          write(msg,*) 'Warning DOUBLE TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        endif
+    ELSE IF (FieldType == WRF_INTEGER) THEN
+        if(XType /= NF_INT)  then 
+          Status = WRF_WARN_TYPE_MISMATCH
+          write(msg,*) 'Warning INTEGER TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        endif
+    ELSE IF (FieldType == WRF_LOGICAL) THEN
+        if(XType /= NF_INT)  then
+          Status = WRF_WARN_TYPE_MISMATCH
+          write(msg,*) 'Warning LOGICAL TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        endif
+    ELSE
+        Status = WRF_WARN_DATA_TYPE_NOT_FOUND
+        write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
+    END IF
+
+    if(Status /= WRF_NO_ERR) then
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    ! NDim=0 for scalars.  Handle read of old NDim=1 files.  TBH:  20060502
+    IF ( ( NDim == 0 ) .AND. ( StoredDim == 2 ) ) THEN
+      stat = NF_INQ_DIMNAME(NCID,VDimIDs(1),dimname)
+      call netcdf_err(stat,Status)
+      if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+      IF ( dimname(1:10) == 'ext_scalar' ) THEN
+        NDim = 1
+        Length(1) = 1
+      ENDIF
+    ENDIF
+    if(StoredDim /= NDim+1) then
+      Status = WRF_ERR_FATAL_BAD_VARIABLE_DIM
+      write(msg,*) 'Fatal error BAD VARIABLE DIMENSION in ext_ncd_read_field ',TRIM(Var),TRIM(DateStr)
+      call wrf_debug ( FATAL , msg)
+      write(msg,*) '  StoredDim ', StoredDim, ' .NE. NDim+1 ', NDim+1
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    do j=1,NDim
+      stat = NF_INQ_DIMLEN(NCID,VDimIDs(j),StoredLen(j))
+      call netcdf_err(stat,Status)
+      if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+      if(Length(j) > StoredLen(j)) then
+        Status = WRF_WARN_READ_PAST_EOF
+        write(msg,*) 'Warning READ PAST EOF in ext_ncd_read_field of ',TRIM(Var),Length(j),'>',StoredLen(j)
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      elseif(Length(j) <= 0) then
+        Status = WRF_WARN_ZERO_LENGTH_READ
+        write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      elseif(DomainStart(j) < MemoryStart(j)) then
+        Status = WRF_WARN_DIMENSION_ERROR
+        write(msg,*) 'Warning dim ',j,' DomainStart (',DomainStart(j), &
+                     ') < MemoryStart (',MemoryStart(j),') in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , TRIM(msg))
+!        return
+      endif
+    enddo
+
+    StoredStart = 1
+    call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
+    call GetIndices(NDim,StoredStart,StoredLen,x1,x2,y1,y2,z1,z2)
+!jm    call GetIndices(NDim,DomainStart,DomainEnd,i1,i2,j1,j2,k1,k2)
+    call GetIndices(NDim,PatchStart,PatchEnd,i1,i2,j1,j2,k1,k2)
+
+    di=1
+    if(FieldType == WRF_DOUBLE) di=2
+    allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+      write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    call FieldIO('read',DataHandle,DateStr,Length,MemoryOrder, &
+                  FieldType,NCID,VarID,XField,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    call Transpose('read',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
+                                        ,XField,x1,x2,y1,y2,z1,z2 &
+                                               ,i1,i2,j1,j2,k1,k2 )
+    deallocate(XField, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  DH%first_operation  = .FALSE.
+  return
+end subroutine ext_ncd_read_field
+
+subroutine ext_ncd_inquire_opened( DataHandle, FileName , FileStatus, Status )
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: FileName
+  integer               ,intent(out)    :: FileStatus
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    FileStatus = WRF_FILE_NOT_OPENED
+    return
+  endif
+  if(FileName /= DH%FileName) then
+    FileStatus = WRF_FILE_NOT_OPENED
+  else
+    FileStatus = DH%FileStatus
+  endif
+  Status = WRF_NO_ERR
+  return
+end subroutine ext_ncd_inquire_opened
+
+subroutine ext_ncd_inquire_filename( Datahandle, FileName,  FileStatus, Status )
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(out)    :: FileName
+  integer               ,intent(out)    :: FileStatus
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  FileStatus = WRF_FILE_NOT_OPENED
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  FileName = DH%FileName
+  FileStatus = DH%FileStatus
+  Status = WRF_NO_ERR
+  return
+end subroutine ext_ncd_inquire_filename
+
+subroutine ext_ncd_set_time(DataHandle, DateStr, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: DateStr
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: i
+
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_FILE_NOT_COMMITTED
+    write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    do i=1,MaxTimes
+      if(DH%Times(i)==DateStr) then
+        DH%CurrentTime = i
+        exit
+      endif
+      if(i==MaxTimes) then
+        Status = WRF_WARN_TIME_NF
+        return
+      endif
+    enddo
+    DH%CurrentVariable = 0
+    Status = WRF_NO_ERR
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_ncd_set_time
+
+subroutine ext_ncd_get_next_time(DataHandle, DateStr, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(out)    :: DateStr
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ
+    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then
+    if(DH%CurrentTime >= DH%NumberTimes) then
+      Status = WRF_WARN_TIME_EOF
+      return
+    endif
+    DH%CurrentTime     = DH%CurrentTime +1
+    DateStr            = DH%Times(DH%CurrentTime)
+    DH%CurrentVariable = 0
+    Status = WRF_NO_ERR
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_ncd_get_next_time
+
+subroutine ext_ncd_get_previous_time(DataHandle, DateStr, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(out)    :: DateStr
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ
+    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    if(DH%CurrentTime.GT.0) then
+      DH%CurrentTime     = DH%CurrentTime -1
+    endif
+    DateStr            = DH%Times(DH%CurrentTime)
+    DH%CurrentVariable = 0
+    Status = WRF_NO_ERR
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_ncd_get_previous_time
+
+subroutine ext_ncd_get_next_var(DataHandle, VarName, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(out)    :: VarName
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: stat
+  character (80)                        :: Name
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ
+    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
+
+    DH%CurrentVariable = DH%CurrentVariable +1
+    if(DH%CurrentVariable > DH%NumVars) then
+      Status = WRF_WARN_VAR_EOF
+      return
+    endif
+    VarName = DH%VarNames(DH%CurrentVariable)
+    Status  = WRF_NO_ERR
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_ncd_get_next_var
+
+subroutine ext_ncd_end_of_frame(DataHandle, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'netcdf.inc'
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  return
+end subroutine ext_ncd_end_of_frame
+
+! NOTE:  For scalar variables NDim is set to zero and DomainStart and 
+! NOTE:  DomainEnd are left unmodified.  
+subroutine ext_ncd_get_var_info(DataHandle,Name,NDim,MemoryOrder,Stagger,DomainStart,DomainEnd,WrfType,Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'netcdf.inc'
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Name
+  integer               ,intent(out)    :: NDim
+  character*(*)         ,intent(out)    :: MemoryOrder
+  character*(*)                         :: Stagger ! Dummy for now
+  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
+  integer               ,intent(out)    :: WrfType
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: VarID
+  integer ,dimension(NVarDims)          :: VDimIDs
+  integer                               :: j
+  integer                               :: stat
+  integer                               :: XType
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ
+    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
+    stat = NF_INQ_VARID(DH%NCID,Name,VarID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NF_INQ_VARTYPE(DH%NCID,VarID,XType)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NF_GET_ATT_INT(DH%NCID,VarID,'FieldType',WrfType)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    select case (XType)
+      case (NF_BYTE)
+        Status = WRF_WARN_BAD_DATA_TYPE
+        write(msg,*) 'Warning BYTE IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      case (NF_CHAR)
+        Status = WRF_WARN_BAD_DATA_TYPE
+        write(msg,*) 'Warning CHAR IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      case (NF_SHORT)
+        Status = WRF_WARN_BAD_DATA_TYPE
+        write(msg,*) 'Warning SHORT IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      case (NF_INT)
+        if(WrfType /= WRF_INTEGER .and. WrfType /= WRF_LOGICAL) then
+          Status = WRF_WARN_BAD_DATA_TYPE
+          write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+          call wrf_debug ( WARN , TRIM(msg))
+          return
+        endif
+      case (NF_FLOAT)
+        if(WrfType /= WRF_REAL) then
+          Status = WRF_WARN_BAD_DATA_TYPE
+          write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+          call wrf_debug ( WARN , TRIM(msg))
+          return
+        endif
+      case (NF_DOUBLE)
+        if(WrfType /= WRF_DOUBLE) then
+          Status = WRF_WARN_BAD_DATA_TYPE
+          write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+          call wrf_debug ( WARN , TRIM(msg))
+          return
+        endif
+      case default
+        Status = WRF_WARN_DATA_TYPE_NOT_FOUND
+        write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+    end select
+
+    stat = NF_GET_ATT_TEXT(DH%NCID,VarID,'MemoryOrder',MemoryOrder)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    call GetDim(MemoryOrder,NDim,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'Warning BAD MEMORY ORDER ',TRIM(MemoryOrder),' in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NF_INQ_VARDIMID(DH%NCID,VarID,VDimIDs)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    do j = 1, NDim
+      DomainStart(j) = 1
+      stat = NF_INQ_DIMLEN(DH%NCID,VDimIDs(j),DomainEnd(j))
+      call netcdf_err(stat,Status)
+      if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_ncd_get_var_info
+
+subroutine ext_ncd_warning_str( Code, ReturnString, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'netcdf.inc'
+  include 'wrf_status_codes.h'
+  
+  integer  , intent(in)  ::Code
+  character *(*), intent(out) :: ReturnString
+  integer, intent(out) ::Status
+  
+  SELECT CASE (Code)
+  CASE (0)
+      ReturnString='No error'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1)
+      ReturnString= 'File not found (or file is incomplete)'
+      Status=WRF_NO_ERR
+      return
+  CASE (-2)
+      ReturnString='Metadata not found'
+      Status=WRF_NO_ERR
+      return
+  CASE (-3)
+      ReturnString= 'Timestamp not found'
+      Status=WRF_NO_ERR
+      return
+  CASE (-4)
+      ReturnString= 'No more timestamps'
+      Status=WRF_NO_ERR
+      return
+  CASE (-5)
+      ReturnString= 'Variable not found'
+      Status=WRF_NO_ERR
+      return
+  CASE (-6)
+      ReturnString= 'No more variables for the current time'
+      Status=WRF_NO_ERR
+      return
+  CASE (-7)
+      ReturnString= 'Too many open files'
+      Status=WRF_NO_ERR
+      return
+  CASE (-8)
+      ReturnString= 'Data type mismatch'
+      Status=WRF_NO_ERR
+      return
+  CASE (-9)
+      ReturnString= 'Attempt to write read-only file'
+      Status=WRF_NO_ERR
+      return
+  CASE (-10)
+      ReturnString= 'Attempt to read write-only file'
+      Status=WRF_NO_ERR
+      return
+  CASE (-11)
+      ReturnString= 'Attempt to access unopened file'
+      Status=WRF_NO_ERR
+      return
+  CASE (-12)
+      ReturnString= 'Attempt to do 2 trainings for 1 variable'
+      Status=WRF_NO_ERR
+      return
+  CASE (-13)
+      ReturnString= 'Attempt to read past EOF'
+      Status=WRF_NO_ERR
+      return
+  CASE (-14)
+      ReturnString= 'Bad data handle'
+      Status=WRF_NO_ERR
+      return
+  CASE (-15)
+      ReturnString= 'Write length not equal to training length'
+      Status=WRF_NO_ERR
+      return
+  CASE (-16)
+      ReturnString= 'More dimensions requested than training'
+      Status=WRF_NO_ERR
+      return
+  CASE (-17)
+      ReturnString= 'Attempt to read more data than exists'
+      Status=WRF_NO_ERR
+      return
+  CASE (-18)
+      ReturnString= 'Input dimensions inconsistent'
+      Status=WRF_NO_ERR
+      return
+  CASE (-19)
+      ReturnString= 'Input MemoryOrder not recognized'
+      Status=WRF_NO_ERR
+      return
+  CASE (-20)
+      ReturnString= 'A dimension name with 2 different lengths'
+      Status=WRF_NO_ERR
+      return
+  CASE (-21)
+      ReturnString= 'String longer than provided storage'
+      Status=WRF_NO_ERR
+      return
+  CASE (-22)
+      ReturnString= 'Function not supportable'
+      Status=WRF_NO_ERR
+      return
+  CASE (-23)
+      ReturnString= 'Package implements this routine as NOOP'
+      Status=WRF_NO_ERR
+      return
+
+!netcdf-specific warning messages
+  CASE (-1007)
+      ReturnString= 'Bad data type'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1008)
+      ReturnString= 'File not committed'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1009)
+      ReturnString= 'File is opened for reading'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1011)
+      ReturnString= 'Attempt to write metadata after open commit'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1010)
+      ReturnString= 'I/O not initialized'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1012)
+     ReturnString=  'Too many variables requested'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1013)
+     ReturnString=  'Attempt to close file during a dry run'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1014)
+      ReturnString= 'Date string not 19 characters in length'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1015)
+      ReturnString= 'Attempt to read zero length words'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1016)
+      ReturnString= 'Data type not found'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1017)
+      ReturnString= 'Badly formatted date string'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1018)
+      ReturnString= 'Attempt at read during a dry run'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1019)
+      ReturnString= 'Attempt to get zero words'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1020)
+      ReturnString= 'Attempt to put zero length words'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1021)
+      ReturnString= 'NetCDF error'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1022)
+      ReturnString= 'Requested length <= 1'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1023)
+      ReturnString= 'More data available than requested'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1024)
+      ReturnString= 'New date less than previous date'
+      Status=WRF_NO_ERR
+      return
+
+  CASE DEFAULT
+      ReturnString= 'This warning code is not supported or handled directly by WRF and NetCDF. &
+      & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need &
+      & to be calling a package-specific routine to return a message for this warning code.'
+      Status=WRF_NO_ERR
+  END SELECT
+
+  return
+end subroutine ext_ncd_warning_str
+
+
+!returns message string for all WRF and netCDF warning/error status codes
+!Other i/o packages must  provide their own routines to return their own status messages
+subroutine ext_ncd_error_str( Code, ReturnString, Status)
+  use wrf_data
+  use ext_ncd_support_routines
+  implicit none
+  include 'netcdf.inc'
+  include 'wrf_status_codes.h'
+
+  integer  , intent(in)  ::Code
+  character *(*), intent(out) :: ReturnString
+  integer, intent(out) ::Status
+
+  SELECT CASE (Code)
+  CASE (-100)
+      ReturnString= 'Allocation Error'
+      Status=WRF_NO_ERR
+      return
+  CASE (-101)
+      ReturnString= 'Deallocation Error'
+      Status=WRF_NO_ERR
+      return
+  CASE (-102)
+      ReturnString= 'Bad File Status'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1004)
+      ReturnString= 'Variable on disk is not 3D'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1005)
+      ReturnString= 'Metadata on disk is not 1D'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1006)
+      ReturnString= 'Time dimension too small'
+      Status=WRF_NO_ERR
+      return
+  CASE DEFAULT
+      ReturnString= 'This error code is not supported or handled directly by WRF and NetCDF. &
+      & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need & 
+      & to be calling a package-specific routine to return a message for this error code.'
+      Status=WRF_NO_ERR
+  END SELECT
+
+  return
+end subroutine ext_ncd_error_str
Index: trunk/WRF.COMMON/WRFV2/external/io_phdf5/INSTALL.htm
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_phdf5/INSTALL.htm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_phdf5/INSTALL.htm	(revision 2744)
@@ -0,0 +1,1207 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"><html><head>
+<meta http-equiv="Content-Language" content="en-us">
+<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
+<meta name="ProgId" content="FrontPage.Editor.Document">
+<meta http-equiv="Content-Type" content="text/html; charset=windows-1252"><title>To integrate HDF5</title></head><body><big><big><b>Build and Install the HDF5-WRF IO Module</b></big></big><br>
+<br>
+There are two HDF5 WRF IO modules, <i>sequential</i> and <i>parallel.</i>  The either or both modules can be configured as optional IO modules for WRF.<br>
+<br>
+The sequential HDF module (<i>io_hdf5</i>) uses the serial HDF5 library.  The parallel
+HDF module (<i>io_phdf5</i>) uses parallel HDF5 (which requires MPI-IO).<br>
+<br>
+The installation for the two modules is similar.<br>
+<br>
+<big><b>Prerequisites</b></big><br>
+<br>
+<b>WRF 1.3</b><br>
+<br>
+The HDF5 WRF IO modules require Version 1.3 of WRF.  Information and downloads are available at:<br>
+ 
+<blockquote><a href="http://www.mmm.ucar.edu/wrf/users/user_main.html">http://www.mmm.ucar.edu/wrf/users/user_main.html</a><br>
+</blockquote>
+<br>
+<b>HDF5-1.6 .2 or later</b><br>
+<br>
+The HDF5 WRF IO modules require HDF5-1.6.2 or more recent. The parallel HDF5
+WRF module requires parallel HDF5 (which requires MPI IO). <br>
+<br>
+Installing HDF5<br>
+<blockquote>
+  </blockquote>
+<ol>
+  <li>To obtain 
+  HDF5, download from to <a href="http://hdf.ncsa.uiuc.edu/HDF5/release/obtain5.html">
+  http://hdf.ncsa.uiuc.edu/HDF5/release/obtain5.html</a>. Install HDF5 according to the instructions. The HDF5 library must have he Fortran 90 interface installed. <br><br>
+ For the sequential WRF module,  SZIP compression can be enabled.  </li>
+  <li>
+For the parallel WRF module, parallel HDF5 must be installed (this requires MPI-IO). <br>
+Set the environment variable PHDF5 = &lt;&lt;path where phdf5 is installed&gt;&gt;.
+  
+   </li>
+
+  <li>For the sequential HDF WRF IO module, either serial or parallel HDF must be installed.<br>
+The HDF library may be installed with the optional SZIP compression enabled. <br>
+Set the environment variable HDF5 = &lt;&lt;path where hdf5 is installed&gt;&gt;.
+  
+  <br>
+  </li>
+</ol>
+<br>
+<big><b>Platforms</b></big><br>
+<p><small><small><font size="5"><small><small>This prototype has been tested
+on a few platforms. The HDF WRF IO modules should work on any platform that
+WRF3.1 and HDF5 support, although the details of the configuration may need
+to be worked out.<br>
+</small></small></font></small></small></p>
+<table cellpadding="2" cellspacing="2" border="1" width="100%">
+  <tbody>
+    <tr>
+      <td valign="top"><b>Module<br>
+      </b></td>
+      <td valign="top"><b>Platforms<br>
+      </b></td>
+      <td valign="top"><b>Notes<br>
+      </b></td>
+    </tr>
+    <tr>
+      <td valign="top">Sequential <br>
+      </td>
+      <td valign="top"><small><small><font size="5"><small><small> 
+NCSA IBM P690</small></small></font></small></small>.<br>
+      <small><small><font size="5"><small><small> NCAR IBM SP3 </small></small></font></small></small><br>
+      <small><small><font size="5"><small><small>PC Linux </small></small></font></small></small>with PGI Fortran 90 Compiler, Vers. 4<br>
+      <small><small><font size="5"><small><small>SGI IRIX6.5-64 bi</small></small></font></small></small>t<br>
+      </td>
+      <td valign="top">To date, WRF3.1 does not work on Linux with PGF, version 5.<br>
+      </td>
+    </tr>
+    <tr>
+      <td valign="top">Parallel<br>
+      </td>
+      <td valign="top"><small><small><font size="5"><small><small> 
+NCSA IBM P690</small></small></font></small></small>.<br>
+
+      <small><small><font size="5"><small><small> NCAR IBM SP3 </small></small></font></small></small><br>
+      </td>
+      <td valign="top"><br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+<br>
+<br>
+<big><b>Installation of the HDF5 WRF IO Modules</b></big><br>
+<br>
+The HDF5 WRF IO modules are used by adding it to a standard WRF configuration.  This process has four main steps<br>
+<ol>
+  <li>Downoad the HDF WRF IO module(s)</li><li>Add the HDF5 WRF IO module(s) as an "extern" module</li>
+
+  <li>Modifying relevant files in the WRF distribution</li>
+  <li>Compile WRF following the usual procedures<br>
+  </li>
+
+</ol>
+The parallel, sequential, or both may be configured.<br>
+<br>
+<b>1. Download the WRD-HDF5 IO modules</b><br>
+<br>
+The HDF WRF IO modules are available from:<br>
+<ul>
+  <li>sequential: <a href="ftp://ftp.ncsa.uiuc.edu/HDF/pub/outgoing/wrf-hdf5-modules/io_hdf5.tar">
+    ftp://ftp.ncsa.uiuc.edu/HDF/pub/outgoing/wrf-hdf5-modules/io_hdf5.tar</a></li>
+  <li>parallel: 
+    <a href="ftp://ftp.ncsa.uiuc.edu/HDF/pub/outgoing/wrf-hdf5-modules/io_phdf5.tar">
+    ftp://ftp.ncsa.uiuc.edu/HDF/pub/outgoing/wrf-hdf5-modules/io_phdf5.tar</a><br>
+  </li>
+</ul>
+<blockquote><p></p>
+</blockquote>
+<p><b><small>
+    <font size="4"><small>2. Add WRF-HDF5 IO module(s) to the WRF source</small></font></small></b></p>
+
+    
+<p>
+    The HDF5 WRF IO modules are added as sub-directories in the 'external' directory of the WRF source.<br>
+</p>
+<blockquote><blockquote>
+    
+    
+    <p> cd external;<br>
+tar xvf io_hdf5.tar<br>
+tar xvf io_phdf5.tar<br>
+    </p>
+</blockquote></blockquote>
+
+<p>
+  </p>
+
+<table cellpadding="2" cellspacing="2" border="1" width="90%" align="center">
+
+
+    <tbody>
+      <tr>
+        <td valign="top">contents of the sequential HDF WRF IO module:<br>
+      <br>
+  ./io_hdf5<br>  ./io_hdf5/wrf-hdf5.F90<br>  ./io_hdf5/wrf_status_codes.h<br>  ./io_hdf5/Makefile<br>  ./io_hdf5/wrf-hdf5attr.F90<br>  ./io_hdf5/wrf-hdf5support.F90<br>  ./io_hdf5/wrf_io_flags.h<br>
+        </td>
+      </tr>
+    </tbody>
+  
+</table>
+
+
+<br>
+
+<br>
+
+
+  
+<table cellpadding="2" cellspacing="2" border="1" width="90%" align="center">
+
+
+    <tbody>
+      <tr>
+        <td valign="top">contents of the sequential HDF WRF IO module:<br>
+      <br>
+  ./io_phdf5/<br>  ./io_phdf5/Makefile<br>  ./io_phdf5/wrf_status_codes.h<br>  ./io_phdf5/wrf-phdf5attr.F90<br>  ./io_phdf5/wrf-phdf5support.F90<br>  ./io_phdf5/wrf_io_flags.h<br>  ./io_phdf5/wrf-phdf5.F90<br>
+        </td>
+      </tr>
+    </tbody>
+  
+</table>
+
+
+<br>
+
+
+<p><b><small><small><font size="5"><small><small>Design note:</small></small></font></small></small></b></p>
+
+<p><small><small><font size="5"><small><small>In the sequential HDF5 WRF
+IO modules, arrays larger thatn 8096 bytes are compressed by default. In
+this case, the HDF5 dataset is configured to use the shuffle filter plus deflate
+(GZIP) compression, with compression level 6.  <br>
+</small></small></font></small></small></p>
+
+
+<p><small><small><font size="5"><small><small>In the current prototype, there is no option in the namelist for 
+users to change this default. To modify this behavior, it is necessary to modify the source code.</small></small></font><br>
+<font size="5"><small><small><br>
+<i>To disable compression:</i></small></small></font></small></small></p>
+
+
+
+<blockquote>
+  <p><small><font size="5"><small><small>Edit</small></small></font><font size="4"><small> the file '</small></font></small><small><font size="4"><small>wrf/external/io_hdf5/</small></font></small><small><font size="4"><small>wrf-hdf5.F90</small></font></small><small><font size="4"><small>'<br>
+</small></font></small></p>
+  <p><small><font size="4"><small>Comment out the lines: </small></font></small></p>
+  <p><small><font face="Arial" size="4"><small>            
+call h5pset_shuffle_f(crp_list,hdf5err) </small></font></small></p>
+  <p><small><font size="4"><small>                
+and </small></font></small></p>
+  <p><small><font size="4" face="Arial"><small>            
+call h5pset_deflate_f(crp_list,6,hdf5err) </small></font></small></p>
+</blockquote>
+
+
+
+
+
+
+
+
+
+<p><i><small><small><font size="5"><small><small>To use  SZIP compression instead:</small></small></font></small></small></i></p>
+
+
+<blockquote>
+  <p><small><font size="4"><small>For SZIP information and downloads, see the szip at 
+<a href="http://hdf.ncsa.uiuc.edu/doc_resource/SZIP/">
+http://hdf.ncsa.uiuc.edu/doc_resource/SZIP/</a>.<br>
+</small></font></small></p>
+  <p><small><font size="4"><small>Edit the file 'wrf/external/io_hdf5/</small></font></small><small><font size="4"><small>wrf-hdf5.F90'.</small></font></small></p>
+  <p><small><font size="4"><small>Comment out the lines: </small></font></small></p>
+  <p><small><font face="Arial" size="4"><small>            
+call h5pset_shuffle_f(crp_list,hdf5err) </small></font></small></p>
+  <p><small><font size="4"><small>                
+and </small></font></small></p>
+  <p><small><font size="4" face="Arial"><small>            
+call h5pset_deflate_f(crp_list,6,hdf5err) </small></font></small></p>
+  <p><small><font size="4"><small>Uncomment the line:
+</small></font></small></p>
+  <p><small><font size="4"><small>             
+<font face="Arial">call 
+h5pset_szip_f(crp_list,H5_SZIP_AK13_OM_F+H5_SZIP_NN_OM_F,8,hdf5err)</font><br>
+</small></font></small></p>
+  <p><small><font size="4"><small>Change the value 
+of the parameters in the function <i>h5pset_szip_f</i> if necessary.</small></font></small>  See the SZIP documentation for more information about the parameters.<br>
+  </p>
+</blockquote>
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+<p><br>
+</p>
+<p><font size="4"><b><small>3. Modifications to WRF files</small></b><br>
+</font></p>
+
+<p><font size="4"><small>In order to add a new IO module to WRF,  several
+files in the WRF source code must be changed. The following files need to be
+modified:<br>
+</small></font></p>
+<table cellpadding="2" cellspacing="2" border="1" width="50%" align="center">
+  <tbody>
+    <tr>
+      <td valign="top">WRFV1/configure<br>
+WRFV1/Registry/Registry<br>
+WRFV1/arch/Config.pl<br>
+WRFV1/arch/configure.defaults<br>
+WRFV1/frame/md_calls.m4<br>
+WRFV1/frame/module_io.F<br>
+WRFV1/share/module_io_wrf.F<br>
+WRFV1/external/Makefile<br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+<br>
+The exact changes depend on how WRF has been configured on the sytsem.  <br>
+<p>Examples of the changes to the files of the WRF1.3 distribution are available at:<br>
+</p>
+<p> 
+    
+    <a href="ftp://ftp.ncsa.uiuc.edu/HDF/pub/outgoing/wrf-hdf5-modules">
+    ftp://ftp.ncsa.uiuc.edu/HDF/pub/outgoing/wrf-hdf5-modules</a><br>
+</p>
+
+<blockquote>
+  </blockquote>
+<p><i><b>WRF configuration files<br>
+</b></i>
+</p>
+<p>The 'configure' file must be updated to add the HDF5 and PHDF5 variables.<br>
+</p>
+<table cellpadding="2" cellspacing="2" border="1" align="center" width="90%">
+  <tbody>
+    <tr>
+      <td valign="top">*** ../WRFV1/configure	Thu Feb  6 13:10:56 2003<br>
+--- ./WRFV1-with-hdf/configure	Thu May 13 12:18:40 2004<br>
+***************<br>
+*** 206,211 ****<br>
+--- 206,223 ----<br>
+    echo "Will configure for use without NetCDF"<br>
+  fi<br>
+  <br>
++ if [ -n "$HDF5" ] ; then<br>
++   echo "Will use HDF5 in dir: $HDF5"<br>
++ else<br>
++   echo "Will configure for use without HDF5"<br>
++ fi<br>
++ <br>
++ if [ -n "$PHDF5" ] ; then<br>
++   echo "Will use PHDF5 in dir: $PHDF5"<br>
++ else<br>
++   echo "Will configure for use without PHDF5"<br>
++ fi<br>
++ <br>
+  # if the uname command exists, give it a shot and see if<br>
+  # we can narrow the choices; otherwise, spam 'em<br>
+  os="ARCH"<br>
+***************<br>
+*** 227,232 ****<br>
+  <br>
+  # Found perl, so proceed with configuration<br>
+  if test -n "$PERL" ; then<br>
+!   $PERL arch/Config.pl -perl=$PERL -netcdf=$NETCDF -os=$os -mach=$mach<br>
+  fi<br>
+  <br>
+--- 239,244 ----<br>
+  <br>
+  # Found perl, so proceed with configuration<br>
+  if test -n "$PERL" ; then<br>
+!   $PERL arch/Config.pl -perl=$PERL -netcdf=$NETCDF -hdf5=$HDF5 -phdf5=$PHDF5 -os=$os -mach=$mach<br>
+  fi<br>
+  <br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+<p>The file 'Registry/Registry' must be updated to add the HDF IO modules (<i>io_hdf5</i> and <i>io_phdf5</i>).<br>
+</p>
+<table cellpadding="2" cellspacing="2" border="1" width="90%" align="center">
+  <tbody>
+    <tr>
+      <td valign="top">*** ../WRFV1/Registry/Registry	Wed Feb 12 09:28:28 2003<br>
+--- ./WRFV1-with-hdf/Registry/Registry	Thu May 13 12:18:39 2004<br>
+***************<br>
+*** 738,745 ****<br>
+  # Four placeholders for additional packages (we can go beyond zzz <br>
+  # but that will entail modifying frame/module_io.F and frame/md_calls.m4)<br>
+  # Please note these are placeholders; HDF has not been implemented yet.<br>
+! package   io_hdf      io_form_restart==3                     -             -<br>
+! package   io_xxx      io_form_restart==4                     -             -<br>
+  package   io_yyy      io_form_restart==5                     -             -<br>
+  package   io_zzz      io_form_restart==6                     -             -<br>
+                                                  <br>
+--- 738,745 ----<br>
+  # Four placeholders for additional packages (we can go beyond zzz <br>
+  # but that will entail modifying frame/module_io.F and frame/md_calls.m4)<br>
+  # Please note these are placeholders; HDF has not been implemented yet.<br>
+! package   io_hdf5     io_form_restart==3                     -             -<br>
+! package   io_phdf5    io_form_restart==4                     -             -<br>
+  package   io_yyy      io_form_restart==5                     -             -<br>
+  package   io_zzz      io_form_restart==6                     -             -<br>
+                                                 <br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+<p>The file 'arch/Config.pl' needs to be changed to add the code to use the HDF5 and PHDF5 variables.<br>
+</p>
+<table cellpadding="2" cellspacing="2" border="1" width="90%" align="center">
+  <tbody>
+    <tr>
+      <td valign="top">*** ../WRFV1/arch/Config.pl	Fri Mar 16 12:06:46 2001<br>
+--- ./WRFV1-with-hdf/arch/Config.pl	Thu May 13 12:18:37 2004<br>
+***************<br>
+*** 7,12 ****<br>
+--- 7,14 ----<br>
+  <br>
+  $sw_perl_path = perl ;<br>
+  $sw_netcdf_path = "" ;<br>
++ $sw_hdf5_path ="";<br>
++ $sw_phdf5_path=""; <br>
+  $sw_os = "ARCH" ;           # ARCH will match any<br>
+  $sw_mach = "ARCH" ;         # ARCH will match any<br>
+  <br>
+***************<br>
+*** 20,25 ****<br>
+--- 22,35 ----<br>
+    {<br>
+      $sw_netcdf_path = substr( $ARGV[0], 8 ) ;<br>
+    }<br>
++   if ( substr( $ARGV[0], 1, 5 ) eq "hdf5=" )<br>
++   {<br>
++     $sw_hdf5_path = substr( $ARGV[0], 6 ) ;<br>
++   }<br>
++   if ( substr( $ARGV[0], 1, 6 ) eq "phdf5=" )<br>
++   {<br>
++     $sw_phdf5_path = substr( $ARGV[0], 7 ) ;<br>
++   }<br>
+    if ( substr( $ARGV[0], 1, 3 ) eq "os=" )<br>
+    {<br>
+      $sw_os = substr( $ARGV[0], 4 ) ;<br>
+***************<br>
+*** 89,94 ****<br>
+--- 99,106 ----<br>
+    {<br>
+      $_ =~ s/CONFIGURE_PERL_PATH/$sw_perl_path/g ;<br>
+      $_ =~ s/CONFIGURE_NETCDF_PATH/$sw_netcdf_path/g ;<br>
++     $_ =~ s/CONFIGURE_HDF5_PATH/$sw_hdf5_path/g ;<br>
++     $_ =~ s/CONFIGURE_PHDF5_PATH/$sw_phdf5_path/g ;<br>
+      if ( $sw_netcdf_path ) <br>
+        { $_ =~ s/CONFIGURE_WRFIO_NF/wrfio_nf/g ;<br>
+  	$_ =~ s:CONFIGURE_NETCDF_FLAG:-DNETCDF: ;<br>
+***************<br>
+*** 99,104 ****<br>
+--- 111,140 ----<br>
+  	$_ =~ s:CONFIGURE_NETCDF_FLAG::g ;<br>
+  	$_ =~ s:CONFIGURE_NETCDF_LIB_PATH::g ;<br>
+  	 }<br>
++ <br>
++     if ( $sw_hdf5_path ) <br>
++ <br>
++       { $_ =~ s/CONFIGURE_WRFIO_HDF5/wrfio_hdf5/g ;<br>
++ 	$_ =~ s:CONFIGURE_HDF5_FLAG:-DHDF5: ;<br>
++ 	$_ =~ s:CONFIGURE_HDF5_LIB_PATH:-L../external/io_hdf5 -lwrfio_hdf5 -L$sw_hdf5_path/lib
+-lhdf5_fortran -lhdf5 -lm -lz -L$sw_hdf5_path/lib -lsz: ;<br>
++ 	 }<br>
++     else                   <br>
++       { $_ =~ s/CONFIGURE_WRFIO_HDF5//g ;<br>
++ 	$_ =~ s:CONFIGURE_HDF5_FLAG::g ;<br>
++ 	$_ =~ s:CONFIGURE_HDF5_LIB_PATH::g ;<br>
++ 	 }<br>
++ <br>
++     if ( $sw_phdf5_path ) <br>
++ <br>
++       { $_ =~ s/CONFIGURE_WRFIO_PHDF5/wrfio_phdf5/g ;<br>
++ 	$_ =~ s:CONFIGURE_PHDF5_FLAG:-DPHDF5: ;<br>
++ 	$_ =~ s:CONFIGURE_PHDF5_LIB_PATH:-L../external/io_phdf5 -lwrfio_phdf5 -L$sw_phdf5_path/lib -lhdf5_fortran -lhdf5 -lm -lz: ;<br>
++ 	 }<br>
++     else                   <br>
++       { $_ =~ s/CONFIGURE_WRFIO_PHDF5//g ;<br>
++ 	$_ =~ s:CONFIGURE_PHDF5_FLAG::g ;<br>
++ 	$_ =~ s:CONFIGURE_PHDF5_LIB_PATH::g ;<br>
++ 	 }<br>
+      @machopts = ( @machopts, $_ ) ;<br>
+    }<br>
+    if ( substr( $_, 0, 5 ) eq "#ARCH" &amp;&amp; $latchon == 0 )<br>
+      <br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+<p>The file 'arch/configure.defauts' must be edited to reflect the configuration of the current system.<br>
+</p>
+<table cellpadding="2" cellspacing="2" border="1" width="90%" align="center">
+  <tbody>
+    <tr>
+      <td valign="top">*** ../WRFV1/arch/configure.defaults	Fri Mar 28 14:08:48 2003<br>
+--- ./WRFV1-with-hdf/arch/configure.defaults	Thu May 13 12:18:40 2004<br>
+***************<br>
+*** 732,758 ****<br>
+  <br>
+  <br>
+  ###########################################################<br>
+! #ARCH	AIX DM          (RSL-IO, IBM-MPI)<br>
+  #<br>
+  DMPARALLEL      =       1<br>
+! SFC             =       xlf90_r<br>
+  SCC             =       xlc_r<br>
+! FC              =       mpxlf90_r<br>
+  CC              =       mpcc_r<br>
+  CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \<br>
+                          -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)<br>
+! FCOPTIM         =       -O2 -qarch=auto -qmaxmem=32676<br>
+  FCDEBUG         =       # -g -qfullpath<br>
+  FCBASEOPTS      =       -qspill=20000 $(FCDEBUG)<br>
+  FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)<br>
+! INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_int  \<br>
+                          -I../frame -I../share -I../phys -I../inc<br>
+  EXTRAMODULES    =       <br>
+  ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DRWORDSIZE=4 \<br>
+!                         -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG -DTRIEDNTRUE -DONLY_WRFMODEL_IO -DINTIO<br>
+  PERL            =       perl<br>
+  REGISTRY        =       Registry<br>
+! LIB             =       CONFIGURE_NETCDF_LIB_PATH -L../external/RSL/RSL -lrsl -lmass \<br>
+                          -L../external/io_int -lwrfio_int  \<br>
+  			../frame/internal_header_util.o ../frame/pack_utils.o<br>
+  LDFLAGS         =	-bmaxstack:256000000<br>
+--- 732,823 ----<br>
+  <br>
+  <br>
+  ###########################################################<br>
+! #ARCH	AIX DM          (RSL-IO, IBM-MPI)(PARALLEL HDF5)<br>
+  #<br>
+  DMPARALLEL      =       1<br>
+! SFC             =       xlf90_r <br>
+  SCC             =       xlc_r<br>
+! FC              =       mpxlf90_r <br>
+  CC              =       mpcc_r<br>
+  CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \<br>
+                          -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)<br>
+! FCOPTIM         =       -O1 -qarch=auto -qmaxmem=-1<br>
+! #FCOPTIM         =       -O2 <br>
+! FCDEBUG         =       -g -qfullpath<br>
+! FCBASEOPTS      =       -qspill=20000 $(FCDEBUG)<br>
+! FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)<br>
+! INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_phdf5 -I../external/io_int  \<br>
+!                         -I../frame -I../share -I../phys -I../inc<br>
+! EXTRAMODULES    =       <br>
+! ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DRWORDSIZE=4 \<br>
+!                         -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_PHDF5_FLAG -DTRIEDNTRUE -DONLY_WRFMODEL_IO -DINTIO<br>
+! PERL            =       perl<br>
+! REGISTRY        =       Registry<br>
+! LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PHDF5_LIB_PATH -L../external/RSL/RSL -lrsl -lmass \<br>
+!                         -L../external/io_int -lwrfio_int  \<br>
+! 			../frame/internal_header_util.o ../frame/pack_utils.o<br>
+! LDFLAGS         =	-bmaxstack:256000000 -bmaxdata:0x80000000<br>
+! CPP		=	/lib/cpp<br>
+! CPPFLAGS	=	-I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL/RSL `cat ../inc/dm_comm_cpp_flags`<br>
+! MAX_DOMAINS     =       4<br>
+! MAX_PROC        =       1024<br>
+! AR              =       ar ru<br>
+! M4              =       m4 -B 8000<br>
+! RANLIB          =       ranlib<br>
+! <br>
+! externals : CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PHDF5 ../external/RSL/RSL/librsl.a wrfio_int<br>
+! 	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c
+&gt;&gt; ../tools/gen_comms.c ;  \<br>
+!           /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F &gt;&gt; module_dm.F )<br>
+! <br>
+! wrfio_nf : <br>
+! 	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(SFC)
+$(FCDEBUG) -qarch=auto -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h
+../../inc )<br>
+! <br>
+! wrfio_phdf5 : <br>
+! 	( cd ../external/io_phdf5 ; make PHDF5PATH=CONFIGURE_PHDF5_PATH FC="$(FC)
+$(FCDEBUG) -qarch=auto -qfree=F90 -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h
+../../inc )<br>
+! <br>
+! wrfio_int : <br>
+! 	( cd ../external/io_int ; \<br>
+!           make CC=$(CC) FC="$(SFC) $(FCDEBUG) -qarch=auto -qzerosize" all diffwrf )<br>
+! <br>
+! ../external/RSL/RSL/librsl.a :<br>
+! 	( cd ../external/RSL/RSL ; make MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST sp2 )<br>
+! <br>
+! # compile these without high optimization to speed compile<br>
+! mediation_force_domain.o : mediation_force_domain.F<br>
+! mediation_interp_domain.o : mediation_interp_domain.F<br>
+! <br>
+! mediation_force_domain.o \<br>
+! mediation_interp_domain.o :<br>
+! 	$(RM) $@<br>
+! 	sed /\!.\*\'/s/\'//g $*.F &gt; $*.b<br>
+! 	$(CPP) -I../inc $(CPPFLAGS) $*.b  &gt; $*.f<br>
+! 	$(RM) $*.b<br>
+! 	$(FC) -c $(FCBASEOPTS) $(MODULE_DIRS) $*.f<br>
+! <br>
+! ###########################################################<br>
+! #ARCH	AIX DM          (RSL-IO, IBM-MPI)(SERIAL HDF5)<br>
+! #<br>
+! DMPARALLEL      =       1<br>
+! SFC             =       xlf90_r <br>
+! SCC             =       xlc_r<br>
+! FC              =       mpxlf90_r <br>
+! CC              =       mpcc_r<br>
+! CFLAGS          =       -DNOUNDERSCORE -DWRF_RSL_IO  -I../external/RSL/RSL -DDM_PARALLEL  \<br>
+!                         -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC)<br>
+! FCOPTIM         =       -O1 -qarch=auto -qmaxmem=32676<br>
+! #FCOPTIM         =       -O2 <br>
+  FCDEBUG         =       # -g -qfullpath<br>
+  FCBASEOPTS      =       -qspill=20000 $(FCDEBUG)<br>
+  FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)<br>
+! INCLUDE_MODULES =       -I../external/io_netcdf -I../external/io_hdf5 -I../external/io_int  \<br>
+                          -I../frame -I../share -I../phys -I../inc<br>
+  EXTRAMODULES    =       <br>
+  ARCHFLAGS       =       -DWRF_RSL_IO -DRSL -DDM_PARALLEL -DIWORDSIZE=4 -DRWORDSIZE=4 \<br>
+!                         -DLWORDSIZE=4 CONFIGURE_NETCDF_FLAG CONFIGURE_HDF5_FLAG -DTRIEDNTRUE -DONLY_WRFMODEL_IO -DINTIO<br>
+  PERL            =       perl<br>
+  REGISTRY        =       Registry<br>
+! LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_HDF5_LIB_PATH  \<br>
+!                         -L../external/RSL/RSL -lrsl -lmass \<br>
+                          -L../external/io_int -lwrfio_int  \<br>
+  			../frame/internal_header_util.o ../frame/pack_utils.o<br>
+  LDFLAGS         =	-bmaxstack:256000000<br>
+***************<br>
+*** 764,776 ****<br>
+  M4              =       m4 -B 8000<br>
+  RANLIB          =       ranlib<br>
+  <br>
+! externals : CONFIGURE_WRFIO_NF ../external/RSL/RSL/librsl.a wrfio_int<br>
+  	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c
+&gt;&gt; ../tools/gen_comms.c ;  \<br>
+            /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F &gt;&gt; module_dm.F )<br>
+  <br>
+  wrfio_nf : <br>
+  	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(SFC)
+$(FCDEBUG) -qarch=auto -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h
+../../inc )<br>
+  <br>
+  wrfio_int : <br>
+  	( cd ../external/io_int ; \<br>
+            make CC=$(CC) FC="$(SFC) $(FCDEBUG) -qarch=auto -qzerosize" all diffwrf )<br>
+--- 829,844 ----<br>
+  M4              =       m4 -B 8000<br>
+  RANLIB          =       ranlib<br>
+  <br>
+! externals : CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_HDF5 ../external/RSL/RSL/librsl.a wrfio_int<br>
+  	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; cat ../external/RSL/gen_comms.c
+&gt;&gt; ../tools/gen_comms.c ;  \<br>
+            /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL/module_dm.F &gt;&gt; module_dm.F )<br>
+  <br>
+  wrfio_nf : <br>
+  	( cd ../external/io_netcdf ; make NETCDFPATH=CONFIGURE_NETCDF_PATH FC="$(SFC)
+$(FCDEBUG) -qarch=auto -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h
+../../inc )<br>
+  <br>
++ wrfio_hdf5 : <br>
++ 	( cd ../external/io_hdf5 ; make HDF5PATH=CONFIGURE_HDF5_PATH FC="$(SFC)
+$(FCDEBUG) -qarch=auto -qfree=F90 -qzerosize" ; /bin/cp wrf_io_flags.h wrf_status_codes.h
+../../inc )<br>
++ <br>
+  wrfio_int : <br>
+  	( cd ../external/io_int ; \<br>
+            make CC=$(CC) FC="$(SFC) $(FCDEBUG) -qarch=auto -qzerosize" all diffwrf )<br>
+***************<br>
+*** 1650,1663 ****<br>
+  FCBASEOPTS      =       -byteswapio -Ktrap=fp -Mfree -tp p6 $(FCDEBUG)<br>
+  FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)<br>
+  ARCHFLAGS       =       -DDEREF_KLUDGE -DIO_DEREF_KLUDGE -DIWORDSIZE=4 -DRWORDSIZE=4 -DLWORDSIZE=4 \<br>
+!                          CONFIGURE_NETCDF_FLAG \<br>
+                          -DTRIEDNTRUE -DONLY_WRFMODEL_IO<br>
+! INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int \<br>
+                          -I../frame -I../share -I../phys -I../inc<br>
+  EXTRAMODULES    =       <br>
+  PERL            =       perl<br>
+  REGISTRY        =       Registry<br>
+! LIB             =       CONFIGURE_NETCDF_LIB_PATH \<br>
+  			../frame/internal_header_util.o ../frame/pack_utils.o<br>
+  LDFLAGS         =<br>
+  CPP             =       /lib/cpp<br>
+--- 1718,1731 ----<br>
+  FCBASEOPTS      =       -byteswapio -Ktrap=fp -Mfree -tp p6 $(FCDEBUG)<br>
+  FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)<br>
+  ARCHFLAGS       =       -DDEREF_KLUDGE -DIO_DEREF_KLUDGE -DIWORDSIZE=4 -DRWORDSIZE=4 -DLWORDSIZE=4 \<br>
+!                          CONFIGURE_NETCDF_FLAG CONFIGURE_HDF5_FLAG\<br>
+                          -DTRIEDNTRUE -DONLY_WRFMODEL_IO<br>
+! INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_hdf5 -I../external/io_int \<br>
+                          -I../frame -I../share -I../phys -I../inc<br>
+  EXTRAMODULES    =       <br>
+  PERL            =       perl<br>
+  REGISTRY        =       Registry<br>
+! LIB             =       CONFIGURE_NETCDF_LIB_PATH CONFIGURE_HDF5_LIB_PATH \<br>
+  			../frame/internal_header_util.o ../frame/pack_utils.o<br>
+  LDFLAGS         =<br>
+  CPP             =       /lib/cpp<br>
+***************<br>
+*** 1666,1672 ****<br>
+  M4              =       m4<br>
+  RANLIB          =       ranlib<br>
+  <br>
+! externals : CONFIGURE_WRFIO_NF wrfio_int<br>
+  	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F &gt;&gt; module_dm.F )<br>
+  <br>
+  wrfio_nf : <br>
+--- 1734,1740 ----<br>
+  M4              =       m4<br>
+  RANLIB          =       ranlib<br>
+  <br>
+! externals : CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_HDF5 wrfio_int<br>
+  	( /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F &gt;&gt; module_dm.F )<br>
+  <br>
+  wrfio_nf : <br>
+***************<br>
+*** 1675,1680 ****<br>
+--- 1743,1754 ----<br>
+            FFLAGS='$(FCFLAGS) -ICONFIGURE_NETCDF_PATH/include' ; \<br>
+            /bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc )<br>
+  <br>
++ wrfio_hdf5 : <br>
++ 	( cd ../external/io_hdf5 ; \<br>
++           make HDF5PATH=CONFIGURE_HDF5_PATH FC=$(FC) TRADFLAG="-traditional" \<br>
++           FFLAGS='$(FCFLAGS) -ICONFIGURE_HDF5_PATH/lib' ; \<br>
++           /bin/cp wrf_io_flags.h wrf_status_codes.h ../../inc )<br>
++ <br>
+  wrfio_int : <br>
+  	( cd ../external/io_int ; \<br>
+            make CC=$(CC) FC="$(SFC) $(FCDEBUG) $(FCBASEOPTS)" \<br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+<p><br>
+
+  </p>
+<blockquote>
+  <ul>
+    </ul><p></p>
+  </blockquote>
+<p><i>Modifications of source code inside WRF</i><b><br>
+</b></p>
+<p>The<i> io_hdf5</i> and/or<i> io_phdf5</i> modules must be added to the WRF source. In addition, the WRF source must be modified in a few places.<br>
+</p>
+<p>The 'frame/md_calls.m4' must be modified to recognize the HDF modules.<br>
+</p>
+<blockquote>
+  </blockquote>
+<table cellpadding="2" cellspacing="2" border="1" width="90%" align="center">
+  <tbody>
+    <tr>
+      <td valign="top">*** ../WRFV1/frame/md_calls.m4	Mon Dec 10 18:10:43 2001<br>
+--- ./WRFV1-with-hdf/frame/md_calls.m4	Thu May 13 12:18:44 2004<br>
+***************<br>
+*** 70,78 ****<br>
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )<br>
+          ENDIF<br>
+  #endif<br>
+! #ifdef HDF<br>
+!       CASE ( IO_HDF   )<br>
+!         CALL ext_hdf_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &amp;<br>
+                                ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )<br>
+  #endif<br>
+  #ifdef XXX<br>
+--- 70,99 ----<br>
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )<br>
+          ENDIF<br>
+  #endif<br>
+! #ifdef HDF5<br>
+!       CASE ( IO_HDF5   )<br>
+!         IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN<br>
+!            CALL ext_hdf5_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &amp;<br>
+!                               ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )<br>
+!         ENDIF <br>
+!         IF ( .NOT. multi_files(io_form) ) THEN<br>
+!           ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))<br>
+!           ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( Data, IWORDSIZE*locCount )'))<br>
+!           ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))<br>
+!           ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( Data, RWORDSIZE*locCount )'))<br>
+!           ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))<br>
+!           ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( Data, LWORDSIZE*locCount )'))<br>
+!           ifelse($1,get,ifelse($4,char,   `len_of_str = LEN(Data)'))<br>
+!           ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_bytes( len_of_str, IWORDSIZE )'))<br>
+!           ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_string( Data, len_of_str )'))<br>
+!           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )<br>
+!         ENDIF<br>
+!        <br>
+! <br>
+! #endif<br>
+! #ifdef PHDF5<br>
+!       CASE ( IO_PHDF5   )<br>
+!            CALL ext_phdf5_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &amp;<br>
+                                ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )<br>
+  #endif<br>
+  #ifdef XXX<br>
+      <br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+<p><br>
+The 'frame/module_io.F' file must be modified to add code to call the HDF5 modules if selected.<br>
+</p>
+<table cellpadding="2" cellspacing="2" border="1" width="90%" align="center">
+  <tbody>
+    <tr>
+      <td valign="top">*** ../WRFV1/frame/module_io.F	Tue Dec  3 14:10:48 2002<br>
+--- ./WRFV1-with-hdf/frame/module_io.F	Thu May 13 12:18:45 2004<br>
+***************<br>
+*** 34,39 ****<br>
+--- 34,48 ----<br>
+  #ifdef NETCDF<br>
+    CALL ext_ncd_ioinit( SysDepInfo, Status )<br>
+  #endif<br>
++ <br>
++ #ifdef HDF5<br>
++   CALL ext_hdf5_ioinit(SysDepInfo, Status)<br>
++ #endif<br>
++ <br>
++ #ifdef PHDF5<br>
++   CALL ext_phdf5_ioinit(SysDepInfo, Status)<br>
++ #endif<br>
++  <br>
+  END SUBROUTINE wrf_ioinit<br>
+  <br>
+  !--- ioexit<br>
+***************<br>
+*** 47,52 ****<br>
+--- 56,70 ----<br>
+  #ifdef NETCDF<br>
+    CALL ext_ncd_ioexit( Status )<br>
+  #endif<br>
++ <br>
++ #ifdef HDF5<br>
++   CALL ext_hdf5_ioexit(Status)<br>
++ #endif<br>
++ <br>
++ #ifdef PHDF5<br>
++   CALL ext_phdf5_ioexit(Status)<br>
++ #endif<br>
++ <br>
+    IF ( use_output_servers() ) CALL ext_quilt_ioexit( Status )<br>
+  END SUBROUTINE<br>
+  <br>
+***************<br>
+*** 134,139 ****<br>
+--- 152,179 ----<br>
+          CALL ext_hdf_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &amp;<br>
+                                              Hndl , Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++       CASE ( IO_HDF5   )<br>
++         IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN<br>
++           IF ( multi_files(io_form) ) THEN<br>
++             CALL wrf_get_myproc ( myproc )<br>
++             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )<br>
++           ELSE<br>
++             LocFilename = FileName<br>
++           ENDIF<br>
++           CALL ext_hdf5_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &amp;<br>
++                                               Hndl , Status )<br>
++         ENDIF<br>
++         IF ( .NOT. multi_files(io_form) ) THEN<br>
++           CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )<br>
++           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )<br>
++         ENDIF<br>
++ #endif<br>
++ #ifdef PHDF5<br>
++       CASE ( IO_PHDF5   )<br>
++           CALL ext_phdf5_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &amp;<br>
++                                               Hndl , Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+        CASE ( IO_XXX   )<br>
+          CALL ext_xxx_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &amp;<br>
+***************<br>
+*** 214,219 ****<br>
+--- 254,270 ----<br>
+        CASE ( IO_HDF   )<br>
+          CALL ext_hdf_open_for_write_commit ( Hndl , Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++       CASE ( IO_HDF5   )<br>
++           IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN<br>
++             CALL ext_hdf5_open_for_write_commit ( Hndl , Status )<br>
++           ENDIF<br>
++           IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )<br>
++ #endif<br>
++ #ifdef PHDF5<br>
++       CASE ( IO_PHDF5   )<br>
++             CALL ext_phdf5_open_for_write_commit ( Hndl , Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+        CASE ( IO_XXX   )<br>
+          CALL ext_xxx_open_for_write_commit ( Hndl , Status )<br>
+***************<br>
+*** 316,321 ****<br>
+--- 367,388 ----<br>
+        CALL ext_hdf_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &amp;<br>
+                                 Hndl , Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++     CASE ( IO_HDF5   )<br>
++       IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN<br>
++         CALL ext_hdf5_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &amp;<br>
++                                      Hndl , Status )<br>
++       ENDIF<br>
++       IF ( .NOT. multi_files(io_form) ) THEN<br>
++         CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )<br>
++         CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )<br>
++       ENDIF<br>
++ #endif<br>
++ #ifdef PHDF5<br>
++     CASE ( IO_PHDF5   )<br>
++         CALL ext_phdf5_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &amp;<br>
++                                      Hndl , Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+      CASE ( IO_XXX   )<br>
+        CALL ext_xxx_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &amp;<br>
+***************<br>
+*** 420,425 ****<br>
+--- 487,502 ----<br>
+        CASE ( IO_HDF   )<br>
+            CALL ext_hdf_inquire_opened ( Hndl, FileName , FileStatus, Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++       CASE ( IO_HDF5   )<br>
++           IF (wrf_dm_on_monitor()) CALL ext_hdf5_inquire_opened ( Hndl, FileName , FileStatus, Status )<br>
++           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )<br>
++           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )<br>
++ #endif<br>
++ #ifdef PHDF5<br>
++       CASE ( IO_PHDF5   )<br>
++           CALL ext_phdf5_inquire_opened ( Hndl, FileName , FileStatus, Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+        CASE ( IO_XXX   )<br>
+            CALL ext_xxx_inquire_opened ( Hndl, FileName , FileStatus, Status )<br>
+***************<br>
+*** 486,491 ****<br>
+--- 563,578 ----<br>
+          CASE ( IO_HDF   )<br>
+            CALL ext_hdf_inquire_filename ( Hndl, FileName , FileStatus, Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++         CASE ( IO_HDF5   )<br>
++           IF (wrf_dm_on_monitor()) CALL ext_hdf5_inquire_filename ( Hndl, FileName , FileStatus, Status )<br>
++           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )<br>
++           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )<br>
++ #endif<br>
++ #ifdef PHDF5<br>
++         CASE ( IO_PHDF5   )<br>
++           CALL ext_phdf5_inquire_filename ( Hndl, FileName , FileStatus, Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+          CASE ( IO_XXX   )<br>
+            CALL ext_xxx_inquire_filename ( Hndl, FileName , FileStatus, Status )<br>
+***************<br>
+*** 607,612 ****<br>
+--- 694,708 ----<br>
+          CASE ( IO_HDF   )<br>
+            CALL ext_ncd_ioclose( Hndl, Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++         CASE ( IO_HDF5   )<br>
++           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_hdf5_ioclose( Hndl, Status )<br>
++           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )<br>
++ #endif<br>
++ #ifdef PHDF5<br>
++         CASE ( IO_PHDF5   )<br>
++           CALL ext_phdf5_ioclose( Hndl, Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+          CASE ( IO_XXX   )<br>
+            CALL ext_xxx_ioclose( Hndl, Status )<br>
+***************<br>
+*** 675,680 ****<br>
+--- 771,790 ----<br>
+          CASE ( IO_HDF   )<br>
+            CALL ext_hdf_get_next_time( Hndl, DateStr, Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++         CASE ( IO_HDF5   )<br>
++           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_hdf5_get_next_time( Hndl, DateStr, Status )<br>
++           IF ( .NOT. multi_files(io_form) ) THEN<br>
++             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )<br>
++             len_of_str = LEN(DateStr)<br>
++             CALL wrf_dm_bcast_bytes( len_of_str, IWORDSIZE )<br>
++             CALL wrf_dm_bcast_string ( DateStr , len_of_str )<br>
++           ENDIF<br>
++ #endif<br>
++ #ifdef PHDF5<br>
++         CASE ( IO_PHDF5   )<br>
++           CALL ext_phdf5_get_next_time( Hndl, DateStr, Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+          CASE ( IO_XXX   )<br>
+            CALL ext_xxx_get_next_time( Hndl, DateStr, Status )<br>
+***************<br>
+*** 742,747 ****<br>
+--- 852,866 ----<br>
+          CASE ( IO_HDF   )<br>
+            CALL ext_hdf_set_time( Hndl, DateStr, Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++         CASE ( IO_HDF5   )<br>
++           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_hdf5_set_time( Hndl, DateStr, Status )<br>
++           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )<br>
++ #endif<br>
++ #ifdef PHDF5<br>
++         CASE ( IO_PHDF5   )<br>
++           CALL ext_phdf5_set_time( Hndl, DateStr, Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+          CASE ( IO_XXX   )<br>
+            CALL ext_xxx_set_time( Hndl, DateStr, Status )<br>
+***************<br>
+*** 875,880 ****<br>
+--- 994,1002 ----<br>
+  #ifdef HDF<br>
+    EXTERNAL ext_hdf_read_field<br>
+  #endif<br>
++ #ifdef HDF5<br>
++   EXTERNAL ext_hdf5_read_field<br>
++ #endif<br>
+  #ifdef XXX<br>
+    EXTERNAL ext_xxx_read_field<br>
+  #endif<br>
+***************<br>
+*** 911,916 ****<br>
+--- 1033,1058 ----<br>
+                                       PatchStart , PatchEnd ,                                      &amp;<br>
+                                       Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++         CASE ( IO_HDF5 )<br>
++           CALL call_pkg_and_dist   ( ext_hdf5_read_field, multi_files(io_form),                  &amp;<br>
++                                      Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &amp;<br>
++                                      DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &amp;<br>
++                                      DomainStart , DomainEnd ,                                    &amp;<br>
++                                      MemoryStart , MemoryEnd ,                                    &amp;<br>
++                                      PatchStart , PatchEnd ,                                      &amp;<br>
++                                      Status )<br>
++ #endif<br>
++ #ifdef PHDF5                                                                                                              <br>
++        CASE (IO_PHDF5)<br>
++           CALL  ext_phdf5_read_field  (                 &amp;<br>
++                                      Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &amp;<br>
++                                      DomainDesc ,  MemoryOrder , Stagger , DimNames ,              &amp;<br>
++                                      DomainStart , DomainEnd ,                                    &amp;<br>
++                                      MemoryStart , MemoryEnd ,                                    &amp;<br>
++                                      PatchStart , PatchEnd ,                                      &amp;<br>
++                                      Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+          CASE ( IO_XXX )<br>
+            CALL call_pkg_and_dist   ( ext_xxx_read_field, multi_files(io_form),                  &amp;<br>
+***************<br>
+*** 994,999 ****<br>
+--- 1136,1144 ----<br>
+  #ifdef HDF<br>
+    EXTERNAL ext_hdf_write_field<br>
+  #endif<br>
++ #ifdef HDF5<br>
++   EXTERNAL ext_hdf5_write_field<br>
++ #endif<br>
+  #ifdef XXX<br>
+    EXTERNAL ext_xxx_write_field<br>
+  #endif<br>
+***************<br>
+*** 1028,1033 ****<br>
+--- 1173,1198 ----<br>
+                                       PatchStart , PatchEnd ,                                      &amp;<br>
+                                       Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++         CASE ( IO_HDF5 )<br>
++           CALL collect_fld_and_call_pkg ( ext_hdf5_write_field, multi_files(io_form),                  &amp;<br>
++                                      Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &amp;<br>
++                                      DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &amp;<br>
++                                      DomainStart , DomainEnd ,                                    &amp;<br>
++                                      MemoryStart , MemoryEnd ,                                    &amp;<br>
++                                      PatchStart , PatchEnd ,                                      &amp;<br>
++                                      Status )<br>
++ #endif<br>
++ #ifdef PHDF5<br>
++         CASE ( IO_PHDF5 )<br>
++           CALL ext_phdf5_write_field (                  &amp;<br>
++                                      Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &amp;<br>
++                                      DomainDesc , MemoryOrder , Stagger , DimNames ,              &amp;<br>
++                                      DomainStart , DomainEnd ,                                    &amp;<br>
++                                      MemoryStart , MemoryEnd ,                                    &amp;<br>
++                                      PatchStart , PatchEnd ,                                      &amp;<br>
++                                      Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+          CASE ( IO_XXX )<br>
+            CALL collect_fld_and_call_pkg ( ext_xxx_write_field, multi_files(io_form),                  &amp;<br>
+***************<br>
+*** 1115,1120 ****<br>
+--- 1280,1293 ----<br>
+                                        DomainStart , DomainEnd ,                &amp;<br>
+                                        Status )<br>
+  #endif<br>
++ #ifdef HDF5<br>
++         CASE ( IO_HDF5 )<br>
++          write(*,*) "NOT IMPLEMENT at HDF5" <br>
++          ! CALL ext_hdf5_get_var_info ( Hndl , VarName , NDim ,            &amp;<br>
++          !                             MemoryOrder , Stagger ,                  &amp;<br>
++          !                             DomainStart , DomainEnd ,                &amp;<br>
++          !                             Status )<br>
++ #endif<br>
+  #ifdef XXX<br>
+          CASE ( IO_XXX )<br>
+            CALL ext_xxx_get_var_info ( Hndl , VarName , NDim ,            &amp;<br>
+      <br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+<p><br>
+The 'share/module_io.F' file must be modified to recognize the HDF5 options for IO.<br>
+</p>
+<table cellpadding="2" cellspacing="2" border="1" width="90%" align="center">
+  <tbody>
+    <tr>
+      <td valign="top">*** ../WRFV1/share/module_io_wrf.F	Tue Feb 18 14:26:22 2003<br>
+--- ./WRFV1-with-hdf/share/module_io_wrf.F	Thu May 13 12:18:46 2004<br>
+***************<br>
+*** 1032,1037 ****<br>
+--- 1032,1079 ----<br>
+  		      ,Status )<br>
+      ENDIF<br>
+  <br>
++     IF (io_form .EQ. IO_HDF5) THEN<br>
++       CALL wrf_put_var_ti_char( &amp;<br>
++                        DataHandle                 &amp;  ! DataHandle<br>
++ 		      ,"description"              &amp;  ! Element<br>
++                       ,Var                        &amp;  ! Data Name<br>
++                       ,Desc                       &amp;  ! Data<br>
++ 		      ,Status )<br>
++       CALL wrf_put_var_ti_char( &amp;<br>
++                        DataHandle                 &amp;  ! DataHandle<br>
++ 		      ,"units"                    &amp;  ! Element<br>
++                       ,Var                        &amp;  ! Data Name<br>
++                       ,Units                      &amp;  ! Data<br>
++ 		      ,Status )<br>
++       CALL wrf_put_var_ti_char( &amp;<br>
++                        DataHandle                 &amp;  ! DataHandle<br>
++ 		      ,"stagger"                  &amp;  ! Element<br>
++                       ,Var                        &amp;  ! Data Name<br>
++                       ,Stagger                    &amp;  ! Data<br>
+4/ Build WRF<br>
+      <br>
++ 		      ,Status )<br>
++     ENDIF<br>
++ <br>
++     IF (io_form .EQ. IO_PHDF5) THEN<br>
++       CALL wrf_put_var_ti_char( &amp;<br>
++                        DataHandle                 &amp;  ! DataHandle<br>
++ 		      ,"description"              &amp;  ! Element<br>
++                       ,Var                        &amp;  ! Data Name<br>
++                       ,Desc                       &amp;  ! Data<br>
++ 		      ,Status )<br>
++       CALL wrf_put_var_ti_char( &amp;<br>
++                        DataHandle                 &amp;  ! DataHandle<br>
++ 		      ,"units"                    &amp;  ! Element<br>
++                       ,Var                        &amp;  ! Data Name<br>
++                       ,Units                      &amp;  ! Data<br>
++ 		      ,Status )<br>
++       CALL wrf_put_var_ti_char( &amp;<br>
++                        DataHandle                 &amp;  ! DataHandle<br>
++ 		      ,"stagger"                  &amp;  ! Element<br>
++                       ,Var                        &amp;  ! Data Name<br>
++                       ,Stagger                    &amp;  ! Data<br>
++ 		      ,Status )<br>
++     ENDIF<br>
++ <br>
+      IF ( wrf_at_debug_level(300) ) THEN<br>
+        WRITE(wrf_err_message,*) debug_message,' Status = ',Status<br>
+        CALL wrf_message ( TRIM(wrf_err_message) )<br>
+      <br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+<p>The 'Makefile' for the 'external' directory must be updated to build the new IO modules.<br>
+</p>
+<table cellpadding="2" cellspacing="2" border="1" width="90%" align="center">
+  <tbody>
+    <tr>
+      <td valign="top">*** ../WRFV1/external/Makefile	Mon Dec 10 18:07:21 2001<br>
+--- ./WRFV1-with-hdf/external/Makefile	Thu May 13 12:18:38 2004<br>
+***************<br>
+*** 3,12 ****<br>
+  	( cd RSL/RSL ; make clean )<br>
+  	( cd io_netcdf ; make clean )<br>
+  	( cd io_int ; make clean )<br>
+  <br>
+  superclean : clean<br>
+  	/bin/rm -f RSL/RSL/librsl.a RSL/RSL/rsl.inc<br>
+  	/bin/rm -f io_netcdf/libwrfio_nf.a io_netcdf/diffwrf io_netcdf/*.o io_netcdf/*.f \<br>
+                     io_int/libwrfio_int.a io_int/diffwrf        */*.mod<br>
+! <br>
+! <br>
+--- 3,14 ----<br>
+  	( cd RSL/RSL ; make clean )<br>
+  	( cd io_netcdf ; make clean )<br>
+  	( cd io_int ; make clean )<br>
++ 	(cd io_hdf5; make clean)<br>
++ 	(cd io_phdf5; make clean)<br>
+  <br>
+  superclean : clean<br>
+  	/bin/rm -f RSL/RSL/librsl.a RSL/RSL/rsl.inc<br>
+  	/bin/rm -f io_netcdf/libwrfio_nf.a io_netcdf/diffwrf io_netcdf/*.o io_netcdf/*.f \<br>
+                     io_int/libwrfio_int.a io_int/diffwrf        */*.mod<br>
+! 	/bin/rm -f io_phdf5/*.a io_phdf5/*.o  *.f *.mod<br>
+! 	/bin/rm -f io_hdf5/*.a io_hdf5/*.o *.f *.mod<br>
+      <br>
+      <br>
+      </td>
+    </tr>
+  </tbody>
+</table>
+
+
+    <p><b><small>
+    <font size="4"><small></small></font></small></b><br>
+</p>
+<p><i>Last Modified: 17 May 2004 </i></p>
+<blockquote>
+  <blockquote>
+    
+    <p> </p>
+  </blockquote>
+
+</blockquote>
+
+
+<br>
+<br>
+</body></html>
Index: trunk/WRF.COMMON/WRFV2/external/io_phdf5/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_phdf5/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_phdf5/Makefile	(revision 2744)
@@ -0,0 +1,39 @@
+#makefile to build a wrf-phdf5 with netCDF
+
+OBJSL   = wrf-phdf5.o wrf-phdf5attr.o wrf-phdf5support.o
+OBJS    = $(OBJSL)
+OPTS    = -bmaxdata:0x80000000
+FFLAGS  =  $(OPTS) -I$(PHDF5PATH)/lib -I../ioapi_share
+FORTRANLIB=-I$(PHDF5PATH)/lib $(PHDF5PATH)/lib/libhdf5_fortran.a
+LIBSHDF = $(FORTRANLIB) $(PHDF5PATH)/lib/libhdf5.a
+LIB     =-lm -lz
+CPP     = /lib/cpp  -P $(TRADFLAG)
+M4      = m4 -Uinclude -Uindex -Ulen
+AR      = ar
+
+.SUFFIXES:      .F90 .f90 .o .code
+
+all : libwrfio_phdf5.a 
+
+libwrfio_phdf5.a:		$(OBJS)
+			/bin/rm -f libwrfio_phdf5.a
+			$(AR) cr libwrfio_phdf5.a $(OBJSL)
+			$(RANLIB) libwrfio_phdf5.a
+
+wrf-phdf5support.o:      wrf-phdf5support.F90 
+			$(CPP) -I../ioapi_share wrf-phdf5support.F90 | $(M4) - > wrf-phdf5support.f90
+			$(FC) $(FFLAGS) -c wrf-phdf5support.f90
+wrf-phdf5attr.o:         wrf-phdf5attr.F90 wrf-phdf5support.o
+			$(CPP) wrf-phdf5attr.F90 | $(M4) - > wrf-phdf5attr.f90
+			$(FC) $(FFLAGS) -c wrf-phdf5attr.f90
+
+wrf-phdf5.o:             wrf-phdf5.F90 wrf-phdf5attr.o wrf-phdf5support.o
+			$(CPP) wrf-phdf5.F90 | $(M4) - > wrf-phdf5.f90
+			$(FC) $(FFLAGS) -c wrf-phdf5.f90
+
+clean:
+	/bin/rm -f *.f90 *.o *.mod
+
+superclean: clean
+	/bin/rm -f libwrfio_phdf5.a
+
Index: trunk/WRF.COMMON/WRFV2/external/io_phdf5/README.phdf5
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_phdf5/README.phdf5	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_phdf5/README.phdf5	(revision 2744)
@@ -0,0 +1,29 @@
+This directory has the parallel HDF5 WRF IO module.
+
+This module requires parallel HDF5, version 1.6.2 or later.
+
+See 'Install.htm' for instrutions.
+
+For more information, please see:
+    http://hdf.ncsa.uiuc.edu/apps/WRF-ROMS                               
+
+----
+
+The HDF5 WRF IO module was written by the the HDF Group at NCSA, the     
+National Center for Supercomputing Applications.                         
+    HDF Group                                                            
+    National Center for Supercomputing Applications                      
+    University of Illinois at Urbana-Champaign			    
+    605 E. Springfield, Champaign IL 61820                               
+    http://hdf.ncsa.uiuc.edu/                                            
+                                                                         
+Copyright 2004 by the Board of Trustees, University of Illinois,         
+                                                                         
+Redistribution or use of this IO module, with or without modification,   
+is permitted for any purpose, including commercial  purposes.            
+                                                                         
+This software is an unsupported prototype.  Use at your own risk.        
+                                                                         
+This work was funded by the MEAD expedition at the National Center       
+for Supercomputing Applications, NCSA.  For more information see:        
+    http://www.ncsa.uiuc.edu/expeditions/MEAD                            
Index: trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5.F90	(revision 2744)
@@ -0,0 +1,5378 @@
+!/***************************************************************************
+!* The HDF5 WRF IO module was written by the the HDF Group at NCSA, the     *
+!* National Center for Supercomputing Applications.                         *
+!*     HDF Group                                                            *
+!*     National Center for Supercomputing Applications                      *
+!*     University of Illinois at Urbana-Champaign                           *
+!*     605 E. Springfield, Champaign IL 61820                               *
+!*     http://hdf.ncsa.uiuc.edu/                                            *
+!*                                                                          *
+!* Copyright 2004 by the Board of Trustees, University of Illinois,         *
+!*                                                                          *
+!* Redistribution or use of this IO module, with or without modification,   *
+!* is permitted for any purpose, including commercial  purposes.            *
+!*                                                                          *
+!* This software is an unsupported prototype.  Use at your own risk.        *
+!*     http://hdf.ncsa.uiuc.edu/apps/WRF-ROMS                               *
+!*                                                                          *
+!* This work was funded by the MEAD expedition at the National Center       *
+!* for Supercomputing Applications, NCSA.  For more information see:        *
+!*     http://www.ncsa.uiuc.edu/expeditions/MEAD                            *
+!*                                                                          *
+!*                                                                          *
+!****************************************************************************/
+
+
+subroutine HDF5IOWRITE(DataHandle,Comm,DateStr,Length,DomainStart,DomainEnd &
+     ,PatchStart,PatchEnd,MemoryOrder &
+     ,WrfDType,FieldType,groupID,TimeIndex &
+     ,DimRank ,DatasetName,XField,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'mpif.h'
+  include 'wrf_status_codes.h'
+
+  integer                     ,intent(in)     :: DataHandle
+  integer                     ,intent(inout)  :: Comm
+  character*(*)               ,intent(in)     :: DateStr
+  integer,dimension(NVarDims) ,intent(in)     :: Length
+
+  integer,dimension(NVarDims) ,intent(in)     :: DomainStart
+  integer,dimension(NVarDims) ,intent(in)     :: DomainEnd
+  integer,dimension(NVarDims) ,intent(in)     :: PatchStart
+  integer,dimension(NVarDims) ,intent(in)     :: PatchEnd
+
+  character*(*)               ,intent(in)     :: MemoryOrder
+
+  integer                     ,intent(in)     :: WrfDType
+  integer(hid_t)              ,intent(in)     :: FieldType
+  integer(hid_t)              ,intent(in)     :: groupID
+  integer                     ,intent(in)     :: TimeIndex
+
+  integer,dimension(*)        ,intent(in)     :: DimRank
+  character (*)               ,intent(in)     :: DatasetName
+  integer,dimension(*)        ,intent(inout)  :: XField
+  integer                     ,intent(out)    :: Status
+
+  integer(hid_t)                              :: dset_id
+  integer                                     :: NDim
+  integer,dimension(NVarDims)                 :: VStart
+  integer,dimension(NVarDims)                 :: VCount
+  character (3)                               :: Mem0
+  character (3)                               :: UCMem0
+  type(wrf_phdf5_data_handle) ,pointer         :: DH
+
+  ! attribute defination
+  integer(hid_t)                              :: dimaspace_id  ! DimRank dataspace id
+  integer(hid_t)                              :: dimattr_id    ! DimRank attribute id
+  integer(hsize_t) ,dimension(1)              :: dim_space
+  INTEGER(HID_T)                              :: dspace_id     ! Raw Data memory Dataspace id
+  INTEGER(HID_T)                              :: fspace_id     ! Raw Data file Dataspace id
+  INTEGER(HID_T)                              :: crp_list      ! chunk  identifier
+  integer(hid_t)                              :: h5_atypeid    ! for fieldtype,memorder attribute
+  integer(hid_t)                              :: h5_aspaceid   ! for fieldtype,memorder  
+  integer(hid_t)                              :: h5_attrid     ! for fieldtype,memorder
+  integer(hsize_t), dimension(7)              :: adata_dims
+  integer                                     :: routine_atype
+
+
+  integer,          dimension(:),allocatable  :: dimrank_data
+
+  INTEGER(HSIZE_T), dimension(:),allocatable  :: dims  ! Dataset dimensions
+  INTEGER(HSIZE_T), dimension(:),allocatable  :: sizes ! Dataset dimensions
+  INTEGER(HSIZE_T), dimension(:),allocatable  :: chunk_dims 
+  INTEGER(HSIZE_T), dimension(:),allocatable  :: hdf5_maxdims
+  INTEGER(HSIZE_T), dimension(:),allocatable  :: offset 
+  INTEGER(HSIZE_T), dimension(:),allocatable  :: count  
+  INTEGER(HSIZE_T), DIMENSION(7)              :: dimsfi
+  integer                                     :: hdf5err
+  integer                                     :: i,j
+  integer(size_t)                             :: dsetsize
+
+  ! FOR PARALLEL IO
+  integer(hid_t)                              :: xfer_list
+  logical                                     :: no_par
+
+
+  ! get the handle 
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! get the rank of the dimension
+  call GetDim(MemoryOrder,NDim,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! If patch is equal to domain, the parallel is not necessary, sequential is used.
+  ! In this version, we haven't implemented this yet.
+  ! We use no_par to check whether we can use compact data storage.
+  no_par = .TRUE.
+  do i = 1,NDim
+     if((PatchStart(i)/=DomainStart(i)).or.(PatchEnd(i)/=DomainEnd(i))) then
+        no_par = .FALSE.
+        exit
+     endif
+  enddo
+
+  ! change the different Memory Order to XYZ for patch and domain
+  if(MemoryOrder.NE.'0') then
+     call ExtOrder(MemoryOrder,PatchStart,Status)
+     call ExtOrder(MemoryOrder,PatchEnd,Status)
+     call ExtOrder(MemoryOrder,DomainStart,Status)
+     call ExtOrder(MemoryOrder,DomainEnd,Status)
+  endif
+
+  ! allocating memory for dynamic arrays; 
+  ! since the time step is always 1, we may ignore the fourth
+  ! dimension time; now keep it to make it consistent with sequential version
+  allocate(dims(NDim+1))
+  allocate(count(NDim+1))
+  allocate(offset(NDim+1))
+  allocate(sizes(NDim+1))
+
+
+  ! arrange offset, count for each hyperslab
+  dims(1:NDim)   = DomainEnd(1:NDim) - DomainStart(1:NDim) + 1
+  dims(NDim+1)   = 1
+
+  count(NDim+1)  = 1
+  count(1:NDim)  = Length(1:NDim)
+
+  offset(NDim+1) = 0
+  offset(1:NDim) = PatchStart(1:NDim) - 1
+
+
+  ! allocate the dataspace to write hyperslab data
+
+  dimsfi = 0
+  do i = 1, NDim + 1
+     dimsfi(i) = count(i)
+  enddo
+
+  ! create the memory space id
+  call h5screate_simple_f(NDim+1,count,dspace_id,hdf5err,count)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+
+
+  ! create file space
+  call h5screate_simple_f(NDim+1,dims,fspace_id,hdf5err,dims)
+  if(hdf5err.lt.0) then        
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+
+  ! compact storage when the patch is equal to the whole domain
+  ! calculate the non-decomposed dataset size
+
+  call h5tget_size_f(FieldType,dsetsize,hdf5err)
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+
+  do i =1,NDim
+     dsetsize = dsetsize*dims(i)
+  enddo
+  if(no_par.and.(dsetsize.le.CompDsetSize)) then
+     call h5pcreate_f(H5P_DATASET_CREATE_F,crp_list,hdf5err)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_PROPERTY_LIST
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(dims)
+        deallocate(count)
+        deallocate(offset)
+        deallocate(sizes)
+        return
+     endif
+     call h5pset_layout_f(crp_list,0,hdf5err)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_PROPERTY_LIST
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(dims)
+        deallocate(count)
+        deallocate(offset)
+        deallocate(sizes)
+        return
+     endif
+     call h5dcreate_f(DH%TgroupIDs(TimeIndex),DatasetName,FieldType,fspace_id,dset_id,&
+          hdf5err,crp_list)
+     call h5pclose_f(crp_list,hdf5err)
+  else
+     call h5dcreate_f(DH%TgroupIDs(TimeIndex),DatasetName,FieldType,fspace_id,dset_id,hdf5err)
+  endif
+
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASET_CREATE 
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+
+  ! select the correct hyperslab for file space id
+  CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, offset, count &
+       ,hdf5err) 
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASET_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+
+  ! Create property list for collective dataset write
+  CALL h5pcreate_f(H5P_DATASET_XFER_F, xfer_list, hdf5err)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+
+  CALL h5pset_dxpl_mpio_f(xfer_list, H5FD_MPIO_COLLECTIVE_F&
+       ,hdf5err)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+
+
+  ! write the data in memory space to file space
+  CALL h5dwrite_f(dset_id,FieldType,XField,dimsfi,hdf5err,&
+       mem_space_id =dspace_id,file_space_id =fspace_id, &
+       xfer_prp = xfer_list)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASET_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+
+  CALL h5pclose_f(xfer_list,hdf5err)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+
+  if(TimeIndex == 1) then
+     do i =1, MaxVars
+        if(DH%dsetids(i) == -1) then
+           DH%dsetids(i) = dset_id
+           DH%VarNames(i) = DataSetName
+           exit
+        endif
+     enddo
+     ! Only writing attributes when TimeIndex ==1
+     call write_hdf5_attributes(DataHandle,MemoryOrder,WrfDType,DimRank,&
+          NDim,dset_id,Status)
+  endif
+
+  call h5sclose_f(fspace_id,hdf5err)
+  call h5sclose_f(dspace_id,hdf5err)
+  if(TimeIndex /= 1) then
+     call h5dclose_f(dset_id,hdf5err)  
+  endif
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASPACE  
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dims)
+     deallocate(count)
+     deallocate(offset)
+     deallocate(sizes)
+     return
+  endif
+  Status = WRF_NO_ERR
+  return
+end subroutine  HDF5IOWRITE
+
+
+subroutine ext_phdf5_ioinit(SysDepInfo, Status)
+
+  use wrf_phdf5_data
+  use HDF5
+  implicit none
+
+  include 'wrf_status_codes.h'
+  include 'mpif.h'
+
+  CHARACTER*(*), INTENT(IN) :: SysDepInfo
+  integer, intent(out) :: status
+  integer              :: hdf5err
+
+  ! set up some variables inside the derived type
+  WrfDataHandles(1:WrfDataHandleMax)%Free = .true.
+  ! ?
+  WrfDataHandles(1:WrfDataHandleMax)%TimesName    = 'Times' 
+  WrfDataHandles(1:WrfDataHandleMax)%DimUnlimName = 'Time'  
+
+  ! set up HDF5 global variables
+  call h5open_f(hdf5err)
+  if(hdf5err .lt.0) then 
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+  return
+end subroutine ext_phdf5_ioinit
+
+
+subroutine ext_phdf5_ioclose( DataHandle, Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use hdf5
+  implicit none
+  include 'wrf_status_codes.h'   
+  include 'mpif.h'
+
+  integer              ,intent(in)       :: DataHandle
+  integer              ,intent(out)      :: Status
+  type(wrf_phdf5_data_handle),pointer     :: DH
+  integer                                :: stat
+  integer                                :: NVar
+  integer                                :: hdferr
+  integer                                :: table_length
+  integer                                :: i
+  integer(hid_t)                         :: dtype_id
+  integer                                :: obj_count
+  integer(hid_t),allocatable,dimension(:) :: obj_ids
+  character(len=100)                       :: buf
+  integer(size_t)                        :: name_size
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', 906
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  ! THE FOLLOWING section writes dimscale information to the data set,may be put into a subroutine
+
+  ! check the file status, should be either open_for_read or opened_and_committed
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+     Status = WRF_HDF5_ERR_FILE_OPEN
+     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_HDF5_ERR_DRYRUN_CLOSE
+     write(msg,*) 'Warning TRY TO CLOSE DRYRUN in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+
+  elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+     ! Handle dim. scale
+     ! STORE "Times" as the first element of the dimensional table
+
+     DH%DIMTABLE(1)%dim_name  = 'Time'
+     DH%DIMTABLE(1)%Length    = DH%TimeIndex
+     DH%DIMTABLE(1)%unlimited = 1
+
+     do i =1,MaxTabDims
+        if(DH%DIMTABLE(i)%dim_name== NO_NAME) then
+           exit
+        endif
+     enddo
+
+     table_length = i-1
+     call store_table(DataHandle,table_length,Status)
+     if(Status.ne.WRF_NO_ERR) then
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+     continue    
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+     !     call h5dclose_f(DH%TimesID,hdferr)
+     !     if(hdferr.lt.0) then 
+     !       Status =  WRF_HDF5_ERR_DATASET_CLOSE
+     !       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     !       call wrf_debug ( WARN , msg) 
+     !       return
+     !     endif
+     continue
+  else
+     Status = WRF_HDF5_ERR_BAD_FILE_STATUS
+     write(msg,*) 'Fatal hdf5err BAD FILE STATUS in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+
+  ! close HDF5 APIs 
+  do NVar = 1, MaxVars
+     if(DH%DsetIDs(NVar) /= -1) then
+        call h5dclose_f(DH%DsetIDs(NVar),hdferr)
+        if(hdferr .ne. 0) then
+           Status =  WRF_HDF5_ERR_DATASET_CLOSE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+     endif
+  enddo
+
+  do i = 1, MaxTimes
+     if(DH%TgroupIDs(i) /= -1) then
+        call h5gclose_f(DH%TgroupIDs(i),hdferr)
+        if(hdferr .ne. 0) then
+           Status =  WRF_HDF5_ERR_DATASET_CLOSE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+     endif
+  enddo
+
+  call h5gclose_f(DH%GroupID,hdferr)
+  if(hdferr .ne. 0) then
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5gclose_f(DH%DimGroupID,hdferr)
+  if(hdferr .ne. 0) then
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'HDF5 IO CLOSE error in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  call h5fclose_f(DH%FileID,hdferr)
+  if(hdferr .ne. 0) then
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'HDF5 IO CLOSE error in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  call free_memory(DataHandle,Status)
+  if(Status /= WRF_NO_ERR) then
+     Status = WRF_HDF5_ERR_OTHERS
+     write(msg,*) 'Warning Status = ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  DH%Free=.true.
+  return
+end subroutine ext_phdf5_ioclose
+
+
+subroutine ext_phdf5_ioexit(Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'mpif.h'
+
+  integer              ,intent(out)      :: Status
+  integer                                :: hdf5err
+  type(wrf_phdf5_data_handle),pointer     :: DH
+  integer                                :: i
+  integer                                :: stat
+
+
+  ! free memories 
+  do i=1,WrfDataHandleMax
+     if(.not.WrfDataHandles(i)%Free) then
+        call free_memory(i,Status)
+        exit
+     endif
+  enddo
+
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'free resources error in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  CALL h5close_f(hdf5err)
+
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_ioexit
+
+
+
+!! This routine will set up everything to read HDF5 files
+subroutine ext_phdf5_open_for_read(FileName,Comm,iocomm,SysDepInfo,DataHandle,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'mpif.h'
+  include 'wrf_status_codes.h'
+
+  character*(*),intent(in)                     :: FileName
+  integer      ,intent(in)                     :: Comm
+  integer      ,intent(in)                     :: iocomm
+  character*(*),intent(in)                     :: SysDepInfo
+  integer      ,intent(out)                    :: DataHandle
+  type(wrf_phdf5_data_handle),pointer          :: DH
+  integer      ,intent(out)                    :: Status
+
+  integer(hid_t)                               :: Fileid
+  integer(hid_t)                               :: tgroupid
+  integer(hid_t)                               :: dsetid
+  integer(hid_t)                               :: dspaceid
+  integer(hid_t)                               :: dtypeid
+  integer(hid_t)                               :: acc_plist
+  integer                                      :: nmembers
+  integer                                      :: submembers
+  integer                                      :: tmembers
+  integer                                      :: ObjType
+  character(len= 256)                           :: ObjName
+  character(len= 256)                           :: GroupName
+
+  integer                                      :: i,j
+  integer(hsize_t), dimension(7)               :: data_dims
+  integer(hsize_t), dimension(1)               :: h5dims
+  integer(hsize_t), dimension(1)               :: h5maxdims
+  integer                                      :: StoredDim
+  integer                                      :: NumVars
+
+  integer                                      :: hdf5err
+  integer                                      :: info,mpi_size,mpi_rank  
+  character(Len = MaxTimeSLen)                 :: tname
+  character(Len = 512)                         :: tgroupname
+
+
+  ! Allocating the data handle
+  call allocHandle(DataHandle,DH,Comm,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5pcreate_f(H5P_FILE_ACCESS_F,acc_plist,hdf5err)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  info = MPI_INFO_NULL
+  CALL h5pset_fapl_mpio_f(acc_plist, comm, info, hdf5err) 
+  !   call h5pset_fapl_mpiposix_f(acc_plist,comm,.false.,hdf5err)
+  if(hdf5err .lt. 0) then
+     Status = WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+  !close every objects when closing HDF5 file.
+  call h5pset_fclose_degree_f(acc_plist,H5F_CLOSE_STRONG_F,hdf5err)
+  if(hdf5err .lt. 0) then
+     Status = WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  ! Open the file
+  call h5fopen_f(FileName,H5F_ACC_RDWR_F,Fileid,hdf5err &
+       ,acc_plist)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_FILE_OPEN
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+  call h5pclose_f(acc_plist,hdf5err)
+  if(hdf5err .lt. 0) then
+     Status = WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  ! Obtain the number of group
+  DH%FileID = Fileid
+  call h5gn_members_f(Fileid,"/",nmembers,hdf5err)
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_GROUP
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! Retrieve group id and dimensional group id, the index must be from 0
+  do i = 0, nmembers - 1
+     call h5gget_obj_info_idx_f(Fileid,"/",i,ObjName,ObjType,&
+          hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_GROUP
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     if(ObjName=='DIM_GROUP') then
+
+        call h5gopen_f(Fileid,"/DIM_GROUP",DH%DimGroupID,hdf5err)
+        if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_GROUP
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        ! For WRF model, the first seven character must be DATASET
+     else if(ObjName(1:7)=='DATASET')then
+
+        GroupName="/"//ObjName
+        call h5gopen_f(Fileid,GroupName,DH%GroupID,hdf5err)
+        if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_GROUP
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        call h5gn_members_f(FileID,GroupName,submembers,Status)
+        if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_GROUP
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        do j = 0, submembers -1
+           call h5gget_obj_info_idx_f(Fileid,GroupName,j,ObjName,ObjType,hdf5err)
+           if(hdf5err.lt.0) then
+              Status = WRF_HDF5_ERR_GROUP
+              write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+              call wrf_debug ( WARN , msg) 
+              return
+           endif
+           call numtochar(j+1,tname)
+           tgroupname = 'TIME_STAMP_'//tname
+
+           if(ObjName(1:17)==tgroupname) then
+              call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
+              if(hdf5err.lt.0) then
+                 Status = WRF_HDF5_ERR_GROUP
+                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+                 call wrf_debug ( WARN , msg) 
+                 return
+              endif
+              call h5gn_members_f(DH%GroupID,tgroupname,tmembers,hdf5err)
+              if(hdf5err.lt.0) then
+                 Status = WRF_HDF5_ERR_GROUP
+                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+                 call wrf_debug ( WARN , msg) 
+                 return
+              endif
+              call h5dopen_f(tgroupid,"Times",dsetid,hdf5err)
+              if(hdf5err.lt.0) then
+                 Status = WRF_HDF5_ERR_DATASET_OPEN
+                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+                 call wrf_debug ( WARN , msg) 
+                 return
+              endif
+              call h5dget_space_f(dsetid,dspaceid,hdf5err)
+              if(hdf5err.lt.0) then
+                 Status = WRF_HDF5_ERR_DATASPACE
+                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+                 call wrf_debug ( WARN , msg) 
+                 return
+              endif
+              call h5sget_simple_extent_ndims_f(dspaceid,StoredDim,hdf5err)
+              if(hdf5err.lt.0) then
+                 Status = WRF_HDF5_ERR_DATASPACE
+                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+                 call wrf_debug ( WARN , msg) 
+                 return
+              endif
+              call h5sget_simple_extent_dims_f(dspaceid,h5dims,h5maxdims,hdf5err)  
+              if(hdf5err.lt.0) then
+                 Status = WRF_HDF5_ERR_DATASPACE
+                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+                 call wrf_debug ( WARN , msg) 
+                 return
+              endif
+	      data_dims(1) = h5dims(1)
+              call h5dget_type_f(dsetid,dtypeid,hdf5err)
+              if(hdf5err.lt.0) then
+                 Status = WRF_HDF5_ERR_DATATYPE
+                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+                 call wrf_debug ( WARN , msg) 
+                 return
+              endif
+              call h5dread_f(dsetid,dtypeid,DH%Times(j+1),data_dims,hdf5err)
+              if(hdf5err.lt.0) then
+                 Status = WRF_HDF5_ERR_DATASET_READ
+                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+                 call wrf_debug ( WARN , msg) 
+                 return
+              endif
+              DH%CurrentVariable = 0
+              DH%CurrentTime     = 0
+              DH%TimeIndex       = 0 
+              call h5tclose_f(dtypeid,hdf5err)
+              call h5sclose_f(dspaceid,hdf5err)
+           endif
+        enddo
+        DH%NumberTimes = submembers
+
+        !       the total member of HDF5 dataset. 
+        DH%NumVars = tmembers*submembers
+     else
+        Status = WRF_HDF5_ERR_OTHERS
+     endif
+  enddo
+
+  DH%FileStatus      = WRF_FILE_OPENED_FOR_READ
+  DH%FileName        = FileName
+
+  ! obtain dimensional scale table
+  call retrieve_table(DataHandle,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+  return
+
+end subroutine ext_phdf5_open_for_read
+
+
+subroutine ext_phdf5_inquire_opened(DataHandle,FileName,FileStatus,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+  integer                    ,intent(in)     :: DataHandle
+  character*(*)              ,intent(in)     :: FileName
+  integer                    ,intent(out)    :: FileStatus
+  integer                    ,intent(out)    :: Status
+  type(wrf_phdf5_data_handle) ,pointer       :: DH
+
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     FileStatus = WRF_FILE_NOT_OPENED
+     return
+  endif
+  if(FileName /= DH%FileName) then
+     FileStatus = WRF_FILE_NOT_OPENED
+  else
+     FileStatus = DH%FileStatus
+  endif
+  Status = WRF_NO_ERR
+  return
+end subroutine ext_phdf5_inquire_opened
+
+
+subroutine ext_phdf5_inquire_filename(DataHandle,FileName,FileStatus,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(out)     :: FileName
+  integer               ,intent(out)    :: FileStatus
+  integer               ,intent(out)    :: Status
+  type(wrf_phdf5_data_handle) ,pointer        :: DH
+
+  ! This line is added to make sure the wrong file will not be opened 
+  FileStatus = WRF_FILE_NOT_OPENED
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,',line',__LINE__
+     call wrf_debug (WARN, msg)
+     return
+  endif
+
+  FileName = DH%FileName
+  FileStatus = DH%FileStatus
+  Status = WRF_NO_ERR
+
+  return 
+end subroutine ext_phdf5_inquire_filename
+
+
+! The real routine to read HDF5 files
+subroutine ext_phdf5_read_field(DataHandle,DateStr,Var,Field,FieldType,Comm,  &
+     IOComm, DomainDesc, MemoryOrder, Stagger, DimNames, &
+     DomainStart,DomainEnd,MemoryStart,MemoryEnd, &
+     PatchStart,PatchEnd,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+
+  implicit none
+  include 'wrf_status_codes.h'
+  integer                       ,intent(in)    :: DataHandle
+  character*(*)                 ,intent(in)    :: DateStr
+  character*(*)                 ,intent(in)    :: Var
+  integer                       ,intent(out)   :: Field(*)
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  character*(*)                 ,intent(in)    :: Stagger ! Dummy for now
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+
+  type(wrf_phdf5_data_handle)    ,pointer       :: DH
+  integer                                      :: NDim
+  integer(hid_t)                               :: GroupID
+  character (VarNameLen)                       :: VarName
+  integer ,dimension(NVarDims)                 :: Length
+  integer ,dimension(NVarDims)                 :: StoredStart
+  integer ,dimension(NVarDims)                 :: StoredLen
+  integer, dimension(NVarDims)                 :: TemDataStart
+  integer ,dimension(:,:,:,:)  ,allocatable    :: XField
+  integer                                      :: NVar
+  integer                                      :: j
+  integer                                      :: i1,i2,j1,j2,k1,k2
+  integer                                      :: x1,x2,y1,y2,z1,z2
+  integer                                      :: l1,l2,m1,m2,n1,n2
+  character (VarNameLen)                       :: Name
+  integer                                      :: XType
+  integer                                      :: StoredDim
+  integer                                      :: NAtts
+  integer                                      :: Len
+  integer                                      :: stat
+  integer                                      :: di
+  integer                                      :: FType
+  integer(hsize_t),dimension(7)                :: data_dims
+  integer(hsize_t),dimension(:) ,allocatable   :: h5_dims
+  integer(hsize_t),dimension(:) ,allocatable   :: h5_maxdims
+  integer(hsize_t),dimension(:) ,allocatable   :: DataStart
+  integer(hsize_t),dimension(:) ,allocatable   :: Datacount
+  integer(hid_t)                               :: tgroupid
+  integer(hid_t)                               :: dsetid
+  integer(hid_t)                               :: dtype_id
+  integer(hid_t)                               :: dmemtype_id
+  integer(hid_t)                               :: dspace_id
+  integer(hid_t)                               :: memspace_id
+  integer                                      :: class_type
+  integer                                      :: TimeIndex
+  logical                                      :: flag
+  integer                                      :: hdf5err
+
+  character(Len = MaxTimeSLen)                 :: tname
+  character(Len = 512)                         :: tgroupname
+
+
+  ! FOR PARALLEL IO
+  integer                                      :: mpi_rank
+  integer(hid_t)                               :: xfer_list
+
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+     Status = WRF_HDF5_ERR_FILE_NOT_OPENED
+     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_HDF5_ERR_DRYRUN_READ
+     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+     Status = WRF_HDF5_ERR_READ_WONLY_FILE
+     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+
+     ! obtain TimeIndex
+     call GetDataTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
+
+     ! obtain the absolute name of the group where the dataset is located
+     call numtochar(TimeIndex,tname)
+     tgroupname = 'TIME_STAMP_'//tname
+
+     call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_GROUP
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5dopen_f(tgroupid,Var,dsetid,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_OPEN
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     ! Obtain the memory datatype
+     select case(FieldType)
+     case (WRF_REAL)
+        dmemtype_id = H5T_NATIVE_REAL
+     case (WRF_DOUBLE)
+        dmemtype_id = H5T_NATIVE_DOUBLE
+     case (WRF_INTEGER)
+        dmemtype_id = H5T_NATIVE_INTEGER
+     case (WRF_LOGICAL)
+        dmemtype_id = DH%EnumID
+     case default
+        Status = WRF_HDF5_ERR_DATA_TYPE_NOTFOUND
+        write(msg,*) 'Warning BAD Memory Data type in ',__FILE__,',line',__LINE__
+        call wrf_debug(WARN,msg)
+        return
+     end select
+
+     ! Obtain the datatype
+     call h5dget_type_f(dsetid,dtype_id,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     ! double check whether the Fieldtype is the type of the dataset
+     ! we may do the force coercion between real and double
+     call h5tget_class_f(dtype_id,class_type,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     if( (FieldType == WRF_REAL .OR. FieldType == WRF_DOUBLE) ) then
+        if ( class_type /= H5T_FLOAT_F)  then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     else if(FieldType == WRF_CHARACTER) then
+        if(class_type /= H5T_STRING_F) then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     else if(FieldType == WRF_INTEGER) then 
+        if(class_type /= H5T_INTEGER_F) then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     else if(FieldType == WRF_LOGICAL) then
+        if(class_type /= H5T_ENUM_F) then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+        call h5tequal_f(dtype_id,DH%EnumID,flag,hdf5err)
+        if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASET_OPEN
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+        if(flag .EQV. .FALSE.) then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     else 
+        Status = WRF_HDF5_ERR_BAD_DATA_TYPE
+        write(msg,*)'Fatal Non-WRF supported TYPE in ',__FILE__,', line',__LINE__
+        call wrf_debug(FATAL, msg)
+        return
+     endif
+
+     ! Obtain the dataspace, check whether the dataspace is within the range
+     ! transpose the memory order to the disk order
+     call h5dget_space_f(dsetid,dspace_id,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call GetDim(MemoryOrder,NDim,Status)
+
+     Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
+     call ExtOrder(MemoryOrder,Length,Status)
+
+     ! Obtain the rank of the dimension
+     call h5sget_simple_extent_ndims_f(dspace_id,StoredDim,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     ! From NetCDF implementation, only do error handling
+     if((NDim+1) /= StoredDim) then
+        Status = WRF_HDF5_ERR_BAD_VARIABLE_DIM
+        write(msg,*) 'Fatal error BAD VARIABLE DIMENSION in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+     endif
+     allocate(h5_dims(StoredDim))
+     allocate(h5_maxdims(StoredDim))
+     allocate(DataStart(StoredDim))
+     allocate(DataCount(StoredDim))
+
+     call h5sget_simple_extent_dims_f(dspace_id,h5_dims,h5_maxdims,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     ! This part of code needs to be adjusted, currently use NetCDF convention  
+     do j = 1, NDim
+        if(Length(j) > h5_dims(j)) then
+           Status = WRF_HDF5_ERR_READ_PAST_EOF
+           write(msg,*) 'Warning READ PAST EOF in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        elseif(Length(j) <= 0) then
+           Status = WRF_HDF5_ERR_ZERO_LENGTH_READ
+           write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     enddo
+
+     ! create memspace_id 
+     data_dims(1:NDim) = Length(1:NDim)
+     data_dims(NDim+1) = 1
+
+     call h5screate_simple_f(NDim+1,data_dims,memspace_id,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     ! DataStart can start from PatchStart.
+     TEMDataStart(1:NDim) = PatchStart(1:NDim)-1
+
+     if(MemoryOrder.NE.'0') then
+        call ExtOrder(MemoryOrder,TEMDataStart,Status)
+     endif
+
+     DataStart(1:NDim) = TEMDataStart(1:NDim)
+     DataStart(NDim+1) = 0
+     DataCount(1:NDim) = Length(1:NDim)
+     DataCount(NDim+1) = 1
+
+     ! transpose the data XField to Field
+     call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
+     StoredStart = 1
+     StoredLen(1:NDim) = Length(1:NDim)
+
+     ! the dimensional information inside the disk may be greater than
+     ! the dimension(PatchEnd-PatchStart); here we can speed up
+     ! the performance by using hyperslab selection
+     call GetIndices(NDim,StoredStart,StoredLen,x1,x2,y1,y2,z1,z2)
+     call GetIndices(NDim,PatchStart,PatchEnd,i1,i2,j1,j2,k1,k2)
+
+     ! di is for double type data
+     di = 1 
+     if(FieldType == WRF_DOUBLE) di = 2
+     allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
+
+     ! use hyperslab to only read this current timestamp
+     call h5sselect_hyperslab_f(dspace_id,H5S_SELECT_SET_F, &
+          DataStart,DataCount,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     ! read the data in this time stamp
+     call h5dread_f(dsetid,dmemtype_id,XField,data_dims,hdf5err, &
+          memspace_id,dspace_id,H5P_DEFAULT_F)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_READ
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call transpose('read',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
+          ,XField,x1,x2,y1,y2,z1,z2 &
+          ,i1,i2,j1,j2,k1,k2 )
+
+     deallocate(XField, STAT=stat)
+     if(stat/= 0) then
+        Status = WRF_HDF5_ERR_DEALLOCATION
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+     endif
+
+     call h5dclose_f(dsetid,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_CLOSE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+     deallocate(h5_dims)
+     deallocate(h5_maxdims)
+     deallocate(DataStart)
+     deallocate(DataCount)
+  else 
+     Status = WRF_HDF5_ERR_BAD_FILE_STATUS
+     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( FATAL , msg)
+  endif
+
+  DH%first_operation  = .FALSE.
+
+  return
+end subroutine ext_phdf5_read_field
+
+!! This routine essentially sets up everything to write HDF5 files
+SUBROUTINE ext_phdf5_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,DataHandle,Status)
+
+  use wrf_phdf5_data
+  use HDF5
+  use ext_phdf5_support_routines
+  implicit none
+  include 'mpif.h'
+  include 'wrf_status_codes.h'
+
+  character*(*)        ,intent(in)            :: FileName
+  integer              ,intent(in)            :: Comm
+  integer              ,intent(in)            :: IOComm
+  character*(*)        ,intent(in)            :: SysDepInfo
+  integer              ,intent(out)           :: DataHandle
+  integer              ,intent(out)           :: Status
+  type(wrf_phdf5_data_handle),pointer          :: DH
+  integer(hid_t)                              :: file5_id
+  integer(hid_t)                              :: g_id
+  integer(hid_t)                              :: gdim_id
+  integer                                     :: hdferr
+  integer                                     :: i
+  integer                                     :: stat
+  character (7)                               :: Buffer
+  integer                                     :: VDimIDs(2)
+  character(Len = 512)                        :: groupname
+
+  ! For parallel IO
+  integer(hid_t)                              :: plist_id
+  integer                                     :: hdf5_comm,info,mpi_size,mpi_rank  
+
+
+  call allocHandle(DataHandle,DH,Comm,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  DH%TimeIndex = 0
+  DH%Times     = ZeroDate
+
+  CALL h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
+  if(hdferr .lt. 0) then
+     Status = WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  info      = MPI_INFO_NULL
+
+  CALL h5pset_fapl_mpio_f(plist_id, comm, info, hdferr)
+
+  if(hdferr .lt. 0) then
+     Status = WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5fcreate_f(FileName,H5F_ACC_TRUNC_F,file5_id,hdferr &
+       ,access_prp = plist_id)
+  if(hdferr .lt. 0) then
+     Status = WRF_HDF5_ERR_FILE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5pclose_f(plist_id,hdferr)
+  if(hdferr .lt. 0) then
+     Status = WRF_HDF5_ERR_PROPERTY_LIST
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  DH%FileStatus            = WRF_FILE_OPENED_NOT_COMMITTED
+  DH%FileName              = FileName
+  ! should add a check to see whether the file opened has been used by previous handles
+  DH%VarNames  (1:MaxVars) = NO_NAME
+  DH%MDVarNames(1:MaxVars) = NO_NAME
+
+  ! group name information is stored at SysDepInfo 
+  groupname = "/"//SysDepInfo
+!  write(*,*) "groupname ",groupname
+  call h5gcreate_f(file5_id,groupname,g_id,hdferr)
+  if(hdferr .lt. 0) then
+     Status = WRF_HDF5_ERR_GROUP
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! create dimensional group id
+  call h5gcreate_f(file5_id,"/DIM_GROUP",gdim_id,hdferr)
+  if(hdferr .lt. 0) then
+     Status = WRF_HDF5_ERR_GROUP
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  DH%FileID     = file5_id
+  DH%GroupID    = g_id
+  DH%DIMGroupID = gdim_id
+
+  return
+
+end subroutine ext_phdf5_open_for_write_begin
+
+! HDF5 doesnot need this stage, basically this routine
+! just updates the File status.
+SUBROUTINE ext_phdf5_open_for_write_commit(DataHandle, Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer              ,intent(in)       :: DataHandle
+  integer              ,intent(out)      :: Status
+  type(wrf_phdf5_data_handle),pointer     :: DH
+  integer(hid_t)                         :: enum_type
+  integer                                :: i
+  integer                                :: stat
+
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  DH%FileStatus  = WRF_FILE_OPENED_AND_COMMITTED
+  DH%first_operation  = .TRUE.
+  return
+end subroutine ext_phdf5_open_for_write_commit
+
+! The real routine to write HDF5 file
+subroutine ext_phdf5_write_field(DataHandle,DateStr,Var,Field,FieldType,&
+     Comm,IOComm,DomainDesc,MemoryOrder,  &
+     Stagger,DimNames,DomainStart,DomainEnd,&
+     MemoryStart,MemoryEnd,PatchStart,PatchEnd,&
+     Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer                       ,intent(in)      :: DataHandle
+  character*(*)                 ,intent(in)      :: DateStr
+  character*(*)                 ,intent(in)      :: Var
+  integer                       ,intent(inout)   :: Field(*)
+  integer                       ,intent(in)      :: FieldType
+  integer                       ,intent(inout)   :: Comm
+  integer                       ,intent(inout)   :: IOComm
+  integer                       ,intent(in)      :: DomainDesc
+  character*(*)                 ,intent(in)      :: MemoryOrder
+  character*(*)                 ,intent(in)      :: Stagger ! Dummy for now
+  character*(*) , dimension (*) ,intent(in)      :: DimNames
+  integer ,dimension(*)         ,intent(in)      :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)      :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)      :: PatchStart,  PatchEnd
+  integer                       ,intent(out)     :: Status
+
+  type(wrf_phdf5_data_handle)    ,pointer        :: DH
+  integer(hid_t)                                 :: GroupID
+  integer                                        :: NDim
+  character (VarNameLen)                         :: VarName
+  character (3)                                  :: MemO
+  character (3)                                  :: UCMemO
+  integer(hid_t)                                 :: DsetID
+  integer      ,dimension(NVarDims)              :: Length
+  integer      ,dimension(NVarDims)              :: DomLength
+  integer      ,dimension(NVarDims+1)            :: DimRank
+  character(256),dimension(NVarDims)              :: RODimNames
+  integer      ,dimension(NVarDims)              :: StoredStart
+  integer      ,dimension(:,:,:,:),allocatable   :: XField
+  integer      ,dimension(:,:,:,:),allocatable   :: BUFFER! for logical field
+  integer                                        :: stat
+  integer                                        :: NVar
+  integer                                        :: i,j,k,m,dim_flag
+  integer                                        :: i1,i2,j1,j2,k1,k2
+  integer                                        :: x1,x2,y1,y2,z1,z2
+  integer                                        :: l1,l2,m1,m2,n1,n2
+  integer(hid_t)                                 :: XType
+  integer                                        :: di
+  character (256)                                 :: NullName
+  integer                                        :: TimeIndex
+  integer ,dimension(NVarDims+1)                 :: temprank
+  logical                                        :: NotFound
+
+
+  NullName = char(0)
+  dim_flag = 0
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  ! Examine here, Nov. 7th, 2003
+  if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then 
+
+     ! obtain group id and initialize the rank of dimensional attributes
+     GroupID = DH%GroupID
+     DimRank = -1
+
+     ! get the rank of the dimension based on MemoryOrder string(cleaver from NetCDF)
+     call GetDim(MemoryOrder,NDim,Status)
+     if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'Warning BAD MEMORY ORDER in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+
+     ! check whether the DateStr is the correct length
+     call DateCheck(DateStr,Status)
+     if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+
+     ! get the dataset name and dimensional information of the data
+     VarName           = Var
+     Length(1:NDim)    = PatchEnd(1:NDim) - PatchStart(1:NDim) + 1
+     DomLength(1:NDim) = DomainEnd(1:NDim) - DomainStart(1:NDim) + 1
+
+     ! Transposing the data order and dim. string order, store to RODimNames
+     call ExtOrder(MemoryOrder,Length,Status)
+     call ExtOrder(MemoryOrder,DomLength,Status)
+     if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'Warning BAD MEMORY ORDER in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+
+     ! Map datatype from WRF to HDF5
+     select case (FieldType)
+     case (WRF_REAL)
+        XType = H5T_NATIVE_REAL
+     case (WRF_DOUBLE)
+        Xtype = H5T_NATIVE_DOUBLE
+     case (WRF_INTEGER)
+        XType = H5T_NATIVE_INTEGER
+     case (WRF_LOGICAL)
+        XType = DH%EnumID
+     case default
+        Status = WRF_HDF5_ERR_DATA_TYPE_NOTFOUND
+        return
+     end select
+
+     ! HANDLE  with dim. scale 
+     ! handle dimensional scale data; search and store them in a table.
+     ! The table is one dimensional array of compound data type. One member of
+     ! the type is HDF5 string, representing the name of the dim(west_east_stag eg.)
+     ! Another number is the length of the dimension(west_east_stag = 31)
+     ! In this part, we will not store TIME but leave it at the end since the time
+     ! index won't be known until the end of the run; since all fields(HDF5 datasets)
+     ! have the same timestamp, writing it once should be fine.
+
+     ! 1) create a loop for dimensions
+     call GetDataTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     if(TimeIndex == 1) then
+
+        ! 2) get the dim. name, the first dim. is reserved for time, 
+        call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status)
+        if(Status /= WRF_NO_ERR) then
+           write(msg,*) 'Warning BAD MEMORY ORDER in ',__FILE__,', line', __LINE__ 
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+        ! 3) get the dim. length
+        ! 4) inside the loop, search the table for dimensional name( table module)
+        !    IF FOUND, go to the next dimension, return the table dimensional rank
+        !    (For example, find west_east_stag in the table, the rank of "west_east_stag"
+        !     is 3; so return 3 for the array dimrank.)
+        !    in the table; so through the table, we can find the information
+        !    such as names, length of this dimension
+        ! 4.1) save the rank into an array for attribute
+        !      if not found,  go to 5)
+        ! 4)' the first dimension is reserved for time, so table starts from j = 2 
+        !
+        ! 5) NOT FOUND, inside the loop add the new dimensional information to the 
+        ! table(table module)
+
+        ! The first dimension of the field is always "time" and "time"
+        ! is also the first dimension of the "table".
+        k = 2
+        DimRank(1) = 1
+
+        do i = 1,NDim
+           do j = 2,MaxTabDims
+
+              ! Search for the table and see if we are at the end of the table
+              if (DH%DIMTABLE(j)%dim_name == NO_NAME) then
+
+                 ! Sometimes the RODimNames is NULLName or ''. If that happens,
+                 ! we will search the table from the beginning and see 
+                 ! whether the name is FAKEDIM(the default name) and  the 
+                 ! current length of the dim. is the same as that of FAKEDIM; 
+                 ! if yes, use this FAKEDIM for the current field dim. 
+
+                 if(RODimNames(i) ==''.or. RODimNames(i)==NullName) then
+                    do m = 2,j
+                       if(DomLength(i)==DH%DIMTABLE(m)%Length.and. &
+                            DH%DIMTABLE(m)%dim_name(1:7)=='FAKEDIM')then
+                          DimRank(k) = m
+                          k = k + 1
+                          dim_flag = 1
+                          exit
+                       endif
+                    enddo
+                    ! No FAKEDIM and the same length dim. is found,
+                    ! Add another dimension "FAKEDIM + j", with the length
+                    ! as DomLength(i)
+                    if (dim_flag == 1) then 
+                       dim_flag = 0
+                    else   
+                       RODimNames(i) = 'FAKEDIM'//achar(j+iachar('0'))
+                       DH%DIMTABLE(j)%dim_name  = RODimNames(i)
+                       DH%DIMTABLE(j)%length    = DomLength(i)
+                       DimRank(k) = j
+                       k          = k + 1
+                    endif
+                    ! no '' or NULLName is found, then assign this RODimNames
+                    ! to the dim. table.
+                 else
+                    DH%DIMTABLE(j)%dim_name  = RODimNames(i)
+                    DH%DIMTABLE(j)%length    = DomLength(i)
+                    DimRank(k)               = j
+                    k = k + 1
+                 endif
+                 exit
+                 ! If we found the current dim. in the table already,save the rank
+              else if(DH%DIMTABLE(j)%dim_name == RODimNames(i)) then
+                 ! remember the rank of dimensional scale
+                 DimRank(k) = j
+                 k = k + 1
+                 exit
+              else
+                 continue
+              endif
+           enddo
+        enddo
+     endif ! end of timeindex of 1
+
+     ! 6) create an attribute array called DimRank to store the rank of the attribute.
+     !    This will be done in the HDF5IOWRITE routine        
+
+     ! 7) before the end of the run, 1) update time, 2) write the table to HDF5.
+
+     ! get the index of l1,.......for writing HDF5 file.
+     StoredStart = 1
+     call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
+     call GetIndices(NDim,StoredStart,Length   ,x1,x2,y1,y2,z1,z2)
+     call GetIndices(NDim,PatchStart, PatchEnd ,i1,i2,j1,j2,k1,k2)
+     di=1
+     if(FieldType == WRF_DOUBLE) di = 2
+     allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
+     if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line',__LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+     endif
+
+     ! Transpose the real data for tools people
+     call Transpose('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
+          ,XField,x1,x2,y1,y2,z1,z2 &
+          ,i1,i2,j1,j2,k1,k2 )
+
+     ! handle with logical data separately,because of not able to 
+     ! map Fortran Logical type to C type
+     if(FieldType .eq. WRF_LOGICAL) then
+        allocate(BUFFER(di,x1:x2,y1:y2,z1:z2), STAT=stat)
+        do k =z1,z2
+           do j = y1,y2
+              do i = x1,x2
+                 do m = 1,di
+                    if(XField(m,i,j,k)/= 0) then
+                       BUFFER(m,i,j,k) = 1
+                    else
+                       BUFFER(m,i,j,k) = 0
+                    endif
+                 enddo
+              enddo
+           enddo
+        enddo
+        call HDF5IOWRITE(DataHandle,Comm,DateStr,Length,DomainStart, DomainEnd &
+             ,PatchStart,PatchEnd, MemoryOrder &
+             ,FieldType,XType,groupID,TimeIndex,DimRank &
+             ,Var,BUFFER,Status)
+        deallocate(BUFFER,STAT=stat)
+        if(stat/=0) then
+           Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+           write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line',__LINE__
+           call wrf_debug ( FATAL , msg)
+           return
+        endif
+     else 
+        call HDF5IOWRITE(DataHandle,Comm,DateStr,Length, DomainStart, DomainEnd &
+             ,PatchStart, PatchEnd, MemoryOrder &
+             ,FieldType,XType,groupID,TimeIndex,DimRank &
+             ,Var,XField,Status)
+     endif
+
+     if (Status /= WRF_NO_ERR) then 
+        return
+     endif
+
+     deallocate(XField,STAT=stat)
+     if(stat/=0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line',__LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+     endif
+  endif
+
+  DH%first_operation  = .FALSE.
+
+  return 
+
+end subroutine ext_phdf5_write_field
+
+! set_time routine is only used for open_for_read
+subroutine ext_phdf5_set_time(DataHandle, DateStr, Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)          :: DataHandle
+  character*(*)         ,intent(in)          :: DateStr
+  integer               ,intent(out)         :: Status
+  type(wrf_phdf5_data_handle) ,pointer        :: DH
+  integer                                    :: i
+
+  ! check whether the Date length is equal to DateStrLen defined at wrf_phdf5_data
+  ! sees not enough, leave it for the time being 3/12/2003
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+     Status = WRF_HDF5_ERR_FILE_NOT_OPENED
+     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_HDF5_ERR_FILE_NOT_COMMITTED
+     write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+     Status = WRF_HDF5_ERR_READ_WONLY_FILE
+     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+     do i=1,MaxTimes
+        if(DH%Times(i)==DateStr) then
+           DH%CurrentTime = i
+           exit
+        endif
+        if(i==MaxTimes) then
+           Status = WRF_HDF5_ERR_TIME
+           return
+        endif
+     enddo
+     DH%CurrentVariable = 0
+     Status = WRF_NO_ERR
+  else
+     Status = WRF_HDF5_ERR_BAD_FILE_STATUS
+     write(msg,*) 'FATAL BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_phdf5_set_time
+
+! get_next_time routine is only used for open_for_read
+subroutine ext_phdf5_get_next_time(DataHandle, DateStr, Status)
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)          :: DataHandle
+  character*(*)         ,intent(out)         :: DateStr
+  integer               ,intent(out)         :: Status
+  type(wrf_phdf5_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+     Status = WRF_HDF5_ERR_FILE_NOT_OPENED
+     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_HDF5_ERR_DRYRUN_READ
+     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+     Status = WRF_HDF5_ERR_READ_WONLY_FILE
+     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+     if(DH%CurrentTime >= DH%NumberTimes) then
+        Status = WRF_HDF5_ERR_TIME
+        write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+     DH%CurrentTime     = DH%CurrentTime +1
+     DateStr            = DH%Times(DH%CurrentTime)
+     DH%CurrentVariable = 0
+     Status = WRF_NO_ERR
+  else
+     Status = WRF_HDF5_ERR_BAD_FILE_STATUS
+     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_phdf5_get_next_time
+
+! get_previous_time routine
+subroutine ext_phdf5_get_previous_time(DataHandle, DateStr, Status)
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)          :: DataHandle
+  character*(*)         ,intent(out)         :: DateStr
+  integer               ,intent(out)         :: Status
+  type(wrf_phdf5_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+     Status = WRF_HDF5_ERR_FILE_NOT_OPENED
+     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_HDF5_ERR_DRYRUN_READ
+     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+     Status = WRF_HDF5_ERR_READ_WONLY_FILE
+     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+     if(DH%CurrentTime.GT.0) then
+       DH%CurrentTime = DH%CurrentTime - 1
+     endif
+     DateStr            = DH%Times(DH%CurrentTime)
+     DH%CurrentVariable = 0
+     Status = WRF_NO_ERR
+  else
+     Status = WRF_HDF5_ERR_BAD_FILE_STATUS
+     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_phdf5_get_previous_time
+
+subroutine ext_phdf5_get_var_info(DataHandle,Name,NDim,MemoryOrder,Stagger,DomainStart,DomainEnd,WrfType,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Name
+  integer               ,intent(out)    :: NDim
+  character*(*)         ,intent(out)    :: MemoryOrder
+  character*(*)         ,intent(out)    :: Stagger ! Dummy for now
+  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
+  integer               ,intent(out)    :: WrfType
+  integer               ,intent(out)    :: Status
+  type(wrf_phdf5_data_handle) ,pointer   :: DH
+  integer                               :: VarID
+  integer ,dimension(NVarDims)          :: VDimIDs
+  integer                               :: j
+  integer                               :: hdf5err
+  integer                               :: XType
+
+  character(Len =MaxTimeSLen)           :: tname
+  character(Len = 512)                  :: tgroupname
+  integer(hid_t)                        :: tgroupid
+  integer(hid_t)                        :: dsetid
+  integer(hid_t)                        :: dspaceid
+  integer                               :: HDF5_NDim
+  integer(hsize_t),dimension(:),allocatable         :: h5dims
+  integer(hsize_t),dimension(:),allocatable         :: h5maxdims
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , TRIM(msg))
+     return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+     Status = WRF_HDF5_ERR_FILE_NOT_OPENED
+     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , TRIM(msg))
+     return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_HDF5_ERR_DRYRUN_READ
+     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , TRIM(msg))
+     return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+     Status = WRF_HDF5_ERR_READ_WONLY_FILE
+     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__    
+     call wrf_debug ( WARN , TRIM(msg))
+     return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+     if(Name /= "Times") then
+        call numtochar(1,tname)
+        tgroupname = 'TIME_STAMP_'//tname
+        call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
+        if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_GROUP
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+        call h5dopen_f(tgroupid,Name,dsetid,hdf5err)
+        if(hdf5err /= 0) then
+           STATUS = WRF_HDF5_ERR_DATASET_OPEN
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+        call h5dget_space_f(dsetid,dspaceid,hdf5err)
+        if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASPACE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        call h5sget_simple_extent_ndims_f(dspaceid,HDF5_NDim,hdf5err)
+        if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASPACE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        call ext_phdf5_get_var_ti_char(DataHandle,"MemoryOrder",Name,MemoryOrder,Status)
+        if(Status /= WRF_NO_ERR) then
+           Status = WRF_HDF5_ERR_ATTRIBUTE_GENERAL
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        ! get the rank of the dimension
+        call GetDim(MemoryOrder,NDim,Status)
+        if(Status /= WRF_NO_ERR) then
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+        if((NDim+1)/= HDF5_NDim)then
+           Status = WRF_HDF5_ERR_DATASPACE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+        call ext_phdf5_get_var_ti_char(DataHandle,"Stagger",Name,Stagger,Status)
+        if(Status /= WRF_NO_ERR) then
+           Status = WRF_HDF5_ERR_ATTRIBUTE_GENERAL
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+        call ext_phdf5_get_var_ti_integer(DataHandle,"FieldType",Name,WrfType,Status)
+        if(Status /= WRF_NO_ERR) then
+           Status = WRF_HDF5_ERR_ATTRIBUTE_GENERAL
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        ! obtain Domain Start and Domain End.
+        allocate(h5dims(NDim+1))
+        allocate(h5maxdims(NDim+1))
+        call h5sget_simple_extent_dims_f(dspaceid,h5dims,h5maxdims,hdf5err)
+        if(hdf5err .lt. 0) then
+           Status = WRF_HDF5_ERR_DATASPACE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        do j =1, NDim 
+           DomainStart(j) = 1
+           DomainEnd(j) = h5dims(j)
+        enddo
+        deallocate(h5dims)
+        deallocate(h5maxdims)
+     endif
+     return
+  endif
+  return
+end subroutine ext_phdf5_get_var_info
+
+! obtain the domain time independent attribute with REAL type
+subroutine ext_phdf5_get_dom_ti_real(DataHandle,Element,Data,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  real                  ,intent(out)    :: Data(*)
+  real    ,dimension(:),allocatable     :: buffer
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer                               :: rank
+  integer(hid_t)                        :: attr_type 
+  integer(hsize_t), dimension(7)        :: h5_dims
+  integer                               :: hdf5err
+
+  ! Do nothing unless it is time to read time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  attr_type = H5T_NATIVE_REAL
+
+  call get_attrid(DataHandle,Element,h5_attrid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if (Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  allocate(buffer(OutCount))
+
+  h5_dims(1) = OutCount
+  call h5aread_f(h5_attrid,attr_type,buffer,h5_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(buffer)
+     return
+  endif
+
+  data(1:OutCount) = buffer(1:OutCount)
+
+  deallocate(buffer)
+
+  return
+
+end subroutine ext_phdf5_get_dom_ti_real
+
+! obtain the domain time independent attribute with REAL8 type
+subroutine ext_phdf5_get_dom_ti_double(DataHandle,Element,Data,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  real*8                ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer                               :: rank
+  integer                               :: hdf5err
+  integer(hid_t)                        :: attr_type 
+  integer(hsize_t), dimension(7)        :: h5_dims
+
+  ! Do nothing unless it is time to read time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  attr_type = H5T_NATIVE_DOUBLE
+  call get_attrid(DataHandle,Element,h5_attrid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if (Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  h5_dims(1) = OutCount
+  call h5aread_f(h5_attrid,attr_type,data,h5_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_get_dom_ti_double
+
+
+! obtain the domain time independent attribute with integer type
+subroutine ext_phdf5_get_dom_ti_integer(DataHandle,Element,Data,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  integer               ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer                               :: rank
+  integer(hid_t)                        :: attr_type 
+  integer(hsize_t), dimension(7)        :: h5_dims
+  integer                               :: hdf5err
+
+  ! Do nothing unless it is time to read time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  attr_type = H5T_NATIVE_INTEGER
+
+  call get_attrid(DataHandle,Element,h5_attrid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if (Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  h5_dims(1) = OutCount
+  call h5aread_f(h5_attrid,attr_type,Data,h5_dims,Status)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_get_dom_ti_integer
+
+
+subroutine ext_phdf5_get_dom_ti_logical(DataHandle,Element,Data,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)           :: DataHandle
+  character*(*)         ,intent(in)           :: Element
+  logical               ,intent(out)          :: Data(*)
+  integer,       dimension(:),allocatable     :: buffer
+  integer               ,intent(in)           :: Count
+  integer               ,intent(out)          :: OutCount
+  integer               ,intent(out)          :: Status
+  integer(hid_t)                              :: h5_atypeid
+  integer(hid_t)                              :: h5_aspaceid
+  integer(hid_t)                              :: h5_attrid
+  integer                                     :: rank
+  integer(hid_t)                              :: attr_type 
+  type(wrf_phdf5_data_handle),pointer          :: DH
+  integer(hsize_t), dimension(7)              :: h5_dims
+  integer                                     :: hdf5err
+
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! Do nothing unless it is time to read time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  attr_type = DH%EnumID
+  call get_attrid(DataHandle,Element,h5_attrid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if (Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  h5_dims(1) = OutCount
+
+  allocate(buffer(OutCount))
+
+  call h5aread_f(h5_attrid,attr_type,buffer,h5_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(buffer)
+     return
+  endif
+
+  Data(1:OutCount) = buffer(1:OutCount)==1
+  deallocate(buffer)
+  return
+end subroutine ext_phdf5_get_dom_ti_logical
+
+! obtain the domain time independent attribute with char type
+subroutine ext_phdf5_get_dom_ti_char(DataHandle,Element,Data,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(out)    :: Data
+  integer                               :: Count
+  integer                               :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer                               :: rank
+  integer(hid_t)                        :: attr_type 
+  integer(hsize_t), dimension(7)        :: h5_dims
+  integer                               :: hdf5err
+
+  ! Do nothing unless it is time to read time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  attr_type = H5T_NATIVE_CHARACTER
+
+  call get_attrid(DataHandle,Element,h5_attrid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  h5_dims(1) = OutCount
+  call h5aread_f(h5_attrid,h5_atypeid,data,h5_dims,hdf5err) 
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_get_dom_ti_char
+
+subroutine ext_phdf5_put_dom_td_real(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real                  ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_phdf5_put_var_td_real(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
+       Data,Count,Status)
+  return
+end subroutine ext_phdf5_put_dom_td_real
+
+subroutine ext_phdf5_put_dom_td_double(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real*8                ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_phdf5_put_var_td_double(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
+       Data,Count,Status)
+  return
+end subroutine ext_phdf5_put_dom_td_double
+
+subroutine ext_phdf5_put_dom_td_logical(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  logical               ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_phdf5_put_var_td_logical(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
+       Data,Count,Status)
+  return
+
+end subroutine ext_phdf5_put_dom_td_logical
+subroutine ext_phdf5_put_dom_td_integer(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  integer               ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_phdf5_put_var_td_integer(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
+       Data,Count,Status)
+  return
+end subroutine ext_phdf5_put_dom_td_integer
+
+subroutine ext_phdf5_put_dom_td_char(DataHandle,Element,DateStr,Data,Status)
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  character*(*)         ,intent(in)     :: Data
+  integer               ,intent(out)    :: Status
+
+  call ext_phdf5_put_var_td_char(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
+       Data,Status)
+  return
+
+end subroutine ext_phdf5_put_dom_td_char
+
+subroutine ext_phdf5_get_dom_td_real(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  real                  ,intent(out)            :: Data(*)
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: OutCount
+  integer               ,intent(out)            :: Status
+
+  call ext_phdf5_get_var_td_real(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Count,OutCount,Status)
+  return
+end subroutine ext_phdf5_get_dom_td_real
+
+subroutine ext_phdf5_get_dom_td_double(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  real*8                ,intent(out)            :: Data(*)
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: OutCount
+  integer               ,intent(out)            :: Status
+
+  call ext_phdf5_get_var_td_double(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Count,OutCount,Status)
+  return
+end subroutine ext_phdf5_get_dom_td_double
+
+
+subroutine ext_phdf5_get_dom_td_integer(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  integer               ,intent(out)            :: Data(*)
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: OutCount
+  integer               ,intent(out)            :: Status
+
+  call ext_phdf5_get_var_td_integer(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Count,OutCount,Status)
+  return
+
+end subroutine ext_phdf5_get_dom_td_integer
+
+subroutine ext_phdf5_get_dom_td_logical(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  logical               ,intent(out)            :: Data(*)
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: OutCount
+  integer               ,intent(out)            :: Status
+
+  call ext_phdf5_get_var_td_logical(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Count,OutCount,Status)
+  return
+
+end subroutine ext_phdf5_get_dom_td_logical
+
+
+subroutine ext_phdf5_get_dom_td_char(DataHandle,Element,DateStr,Data,Status)
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(out)            :: Data
+  integer               ,intent(out)            :: Status
+
+
+  call ext_phdf5_get_var_td_char(DataHandle,Element,DateStr,&
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Status)
+  return
+
+
+end subroutine ext_phdf5_get_dom_td_char
+
+subroutine ext_phdf5_put_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len = 256)                           :: DataSetName
+  real                  ,intent(in)             :: Data(*)
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer           :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: fspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(1)                 :: dims              
+  integer                                       :: hdf5err
+  integer                                       :: i
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+
+     dims(1) = Count
+
+     ! Get the time index
+     call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! Set up dataspace,property list
+     call GetName(Element,Var,DataSetName,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     call setup_wrtd_dataset(DataHandle,DataSetName,H5T_NATIVE_REAL,Count,&
+          dset_id,dspaceid,fspaceid,tgroupid,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     call h5dwrite_f(dset_id,H5T_NATIVE_REAL,Data,dims,hdf5err,dspaceid,&
+          fspaceid)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+     call h5dclose_f(dset_id,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5sclose_f(fspaceid,hdf5err)
+!     call h5gclose_f(tgroupid,hdf5err)
+  endif
+  return
+end subroutine ext_phdf5_put_var_td_real
+
+subroutine ext_phdf5_put_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,Status)
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len = 256)                           :: DataSetName
+  real*8                ,intent(in)             :: Data(*)
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer            :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: fspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(1)                 :: dims              
+  integer                                       :: hdf5err
+  integer                                       :: i
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+
+
+     dims(1) = Count
+     ! Get the time index
+     call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! Set up dataspace,property list
+     call GetName(Element,Var,DataSetName,Status)
+     call setup_wrtd_dataset(DataHandle,DataSetName,H5T_NATIVE_DOUBLE,Count,&
+          dset_id,dspaceid,fspaceid,tgroupid,TimeIndex,Status) 
+
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     call h5dwrite_f(dset_id,H5T_NATIVE_DOUBLE,Data,dims,hdf5err,dspaceid,&
+          fspaceid)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5dclose_f(dset_id,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5sclose_f(fspaceid,hdf5err)
+!     call h5gclose_f(tgroupid,hdf5err)
+
+  endif
+  return
+end subroutine ext_phdf5_put_var_td_double
+
+subroutine ext_phdf5_put_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len = 256)                           :: DataSetName
+  integer               ,intent(in)             :: Data(*)
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer            :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: fspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(1)                 :: dims              
+  integer                                       :: hdf5err
+  integer                                       :: i
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+
+
+     dims(1) = Count
+     ! Get the time index
+     call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! Set up dataspace,property list
+     call GetName(Element,Var,DataSetName,Status)
+
+     call setup_wrtd_dataset(DataHandle,DataSetName,H5T_NATIVE_INTEGER, &
+          Count,dset_id,dspaceid,fspaceid,tgroupid,  &
+          TimeIndex, Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     call h5dwrite_f(dset_id,H5T_NATIVE_INTEGER,Data,dims,hdf5err,dspaceid,&
+          fspaceid)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5dclose_f(dset_id,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5sclose_f(fspaceid,hdf5err)
+!     call h5gclose_f(tgroupid,hdf5err)
+
+  endif
+  return
+
+end subroutine ext_phdf5_put_var_td_integer
+
+subroutine ext_phdf5_put_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len = 256)                           :: DataSetName
+  logical               ,intent(in)             :: Data(*)
+  integer ,dimension(:),allocatable             :: Buffer              
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer            :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: fspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(1)                 :: dims              
+  integer                                       :: hdf5err
+  integer                                       :: i
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+
+     allocate(buffer(count))
+     do i = 1, count
+        if(data(i).EQV..TRUE.) then
+           buffer(i) = 1
+        else
+           buffer(i) = 0
+        endif
+     enddo
+
+     dims(1) = Count
+     ! Get the time index
+     call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! Set up dataspace,property list
+     call GetName(Element,Var,DataSetName,Status)
+
+     call setup_wrtd_dataset(DataHandle,DataSetName,DH%EnumID, &
+          Count,dset_id,dspaceid,           &
+          fspaceid,tgroupid,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     call h5dwrite_f(dset_id,DH%EnumID,Buffer,dims,hdf5err,dspaceid,&
+          fspaceid)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+     call h5dclose_f(dset_id,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5sclose_f(fspaceid,hdf5err)
+!     call h5gclose_f(tgroupid,hdf5err)
+     deallocate(Buffer)
+  endif
+  return 
+end subroutine ext_phdf5_put_var_td_logical
+
+subroutine ext_phdf5_put_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len = 256)                           :: DataSetName
+  character*(*)         ,intent(in)             :: Data
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer           :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: fspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(1)                 :: dims              
+  integer                                       :: hdf5err
+  integer                                       :: i
+
+  integer                                       :: str_id
+  integer                                       :: str_len
+  integer                                       :: count
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+
+     dims(1) = 1
+
+     ! Get the time index
+     call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! make str id
+     str_len = len_trim(Data)
+     call make_strid(str_len,str_id,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! assign count of the string to 1
+     count = 1
+
+     ! Set up dataspace,property list
+     call GetName(Element,Var,DataSetName,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+     call setup_wrtd_dataset(DataHandle,DataSetName,str_id, &
+          count,dset_id,dspaceid,        &
+          fspaceid,tgroupid,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     call h5dwrite_f(dset_id,str_id,Data,dims,hdf5err,dspaceid,&
+          fspaceid)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     ! close the string id
+     call h5tclose_f(str_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+     call h5dclose_f(dset_id,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5sclose_f(fspaceid,hdf5err)
+!     call h5gclose_f(tgroupid,hdf5err)
+
+  endif
+  return
+
+end subroutine ext_phdf5_put_var_td_char
+
+subroutine ext_phdf5_get_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len =256)                            :: DataSetName
+  real                  ,intent(out)            :: Data(*)
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: OutCount
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer            :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: memspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(7)                 :: data_dims              
+  integer                                       :: hdf5err
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+
+     ! get the time-dependent attribute name
+     
+     call GetName(Element,Var,DataSetName,Status)
+
+     ! get time index of the time-dependent attribute
+     call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! For parallel, find the group and obtain the attribute.
+     ! set up for reading the time-dependent attribute
+     call setup_rdtd_dataset(DataHandle,DataSetName,H5T_NATIVE_REAL,TimeIndex,&
+          Count,OutCount,dset_id,memspaceid,dspaceid,tgroupid,&
+          Status)
+     if(Status /= WRF_NO_ERR) then
+	return
+     endif
+
+     data_dims(1) = OutCount
+
+     ! read the dataset
+     call h5dread_f(dset_id,H5T_NATIVE_REAL,data,data_dims,hdf5err, &
+          memspaceid,dspaceid,H5P_DEFAULT_F)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_READ
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+     call h5sclose_f(memspaceid,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5dclose_f(dset_id,hdf5err)
+     call h5gclose_f(tgroupid,hdf5err)
+  endif
+
+end subroutine ext_phdf5_get_var_td_real
+
+subroutine ext_phdf5_get_var_td_double(DataHandle,Element,DateStr,Var,Data,&
+     Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len =256)                            :: DataSetName
+  real*8                ,intent(out)            :: Data(*)
+  integer               ,intent(in)             :: Count
+  integer              ,intent(out)            :: OutCount
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer            :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: memspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(7)                 :: data_dims              
+  integer                                       :: hdf5err
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+
+     ! get the time-dependent attribute name
+     call GetName(Element,Var,DataSetName,Status)
+
+     ! get time index of the time-dependent attribute
+     call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! set up for reading the time-dependent attribute
+     call setup_rdtd_dataset(DataHandle,DataSetName,H5T_NATIVE_DOUBLE,TimeIndex,&
+          Count,OutCount,dset_id,memspaceid,dspaceid,tgroupid,&
+          Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     data_dims(1) = OutCount
+
+     ! read the dataset
+     call h5dread_f(dset_id,H5T_NATIVE_DOUBLE,data,data_dims,hdf5err, &
+          memspaceid,dspaceid,H5P_DEFAULT_F)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_READ
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5sclose_f(memspaceid,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5dclose_f(dset_id,hdf5err)
+     call h5gclose_f(tgroupid,hdf5err)
+
+  endif
+
+end subroutine ext_phdf5_get_var_td_double
+
+subroutine ext_phdf5_get_var_td_integer(DataHandle,Element,DateStr,Var,Data,&
+     Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len =256)                            :: DataSetName
+  integer               ,intent(out)             :: Data(*)
+  integer               ,intent(in)             :: Count
+  INTEGER    		,intent(out)            :: OutCount
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer            :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: memspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(7)                 :: data_dims              
+  integer                                       :: hdf5err
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+
+     ! get the time-dependent attribute name
+     call GetName(Element,Var,DataSetName,Status)
+
+     ! get time index of the time-dependent attribute
+     call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! set up for reading the time-dependent attribute
+     call setup_rdtd_dataset(DataHandle,DataSetName,H5T_NATIVE_INTEGER,TimeIndex,&
+          Count,OutCount,dset_id,memspaceid,dspaceid,tgroupid,&
+          Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     data_dims(1) = OutCount
+
+     ! read the dataset
+     call h5dread_f(dset_id,H5T_NATIVE_INTEGER,data,data_dims,hdf5err, &
+          memspaceid,dspaceid,H5P_DEFAULT_F)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_READ
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5sclose_f(memspaceid,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5dclose_f(dset_id,hdf5err)
+     call h5gclose_f(tgroupid,hdf5err)
+  endif
+end subroutine ext_phdf5_get_var_td_integer
+
+subroutine ext_phdf5_get_var_td_logical(DataHandle,Element,DateStr,Var,Data,&
+     Count,OutCount,Status)
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len =256)                            :: DataSetName
+  logical               ,intent(out)            :: Data(*)
+  integer,         dimension(:),allocatable     :: Buffer   
+  integer               ,intent(in)             :: Count
+  integer               ,intent(out)            :: OutCount
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer            :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: memspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(7)                 :: data_dims              
+  integer                                       :: hdf5err
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+
+     ! get the time-dependent attribute name
+     call GetName(Element,Var,DataSetName,Status)
+
+     ! get time index of the time-dependent attribute
+     call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! set up for reading the time-dependent attribute
+     call setup_rdtd_dataset(DataHandle,DataSetName,DH%EnumID,TimeIndex,&
+          Count,OutCount,dset_id,memspaceid,dspaceid,&
+          tgroupid,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     data_dims(1) = OutCount
+     ! read the dataset
+
+     allocate(Buffer(OutCount))
+     call h5dread_f(dset_id,DH%EnumID,buffer,data_dims,hdf5err, &
+          memspaceid,dspaceid,H5P_DEFAULT_F)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_READ
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+     data(1:OutCount) = buffer(1:OutCount) == 1
+     deallocate(buffer)
+     call h5sclose_f(memspaceid,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5dclose_f(dset_id,hdf5err)
+     call h5gclose_f(tgroupid,hdf5err)
+  endif
+
+end subroutine ext_phdf5_get_var_td_logical
+
+subroutine ext_phdf5_get_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: Element
+  character*(*)         ,intent(in)             :: DateStr
+  character*(*)         ,intent(in)             :: Var
+  character(len =256)                            :: DataSetName
+  character*(*)         ,intent(out)             :: Data
+  integer                                       :: Count
+  integer                                       :: OutCount
+  integer               ,intent(out)            :: Status
+  type(wrf_phdf5_data_handle),pointer            :: DH
+  integer                                       :: TimeIndex
+  integer(hid_t)                                :: dset_id
+  integer(hid_t)                                :: dspaceid
+  integer(hid_t)                                :: memspaceid
+  integer(hid_t)                                :: tgroupid
+  integer(hsize_t),dimension(7)                 :: data_dims              
+  integer                                       :: hdf5err
+
+  integer(hid_t)                                :: str_id
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! check whether the DateStr is the correct length
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+
+     ! get the time-dependent attribute name
+     call GetName(Element,Var,DataSetName,Status)
+
+     ! get time index of the time-dependent attribute
+     call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     ! set up for reading the time-dependent attribute
+     str_id = H5T_NATIVE_CHARACTER
+     Count  = 1
+     call setup_rdtd_dataset(DataHandle,DataSetName,str_id,TimeIndex,&
+          Count,OutCount,dset_id,memspaceid,dspaceid,&
+          tgroupid,Status)
+     if(Status /= WRF_NO_ERR) then
+        return
+     endif
+
+     data_dims(1) = Count
+
+     ! read the dataset
+     call h5dread_f(dset_id,str_id,data,data_dims,hdf5err, &
+          memspaceid,dspaceid,H5P_DEFAULT_F)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_READ
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+     call h5sclose_f(memspaceid,hdf5err)
+     call h5sclose_f(dspaceid,hdf5err)
+     call h5dclose_f(dset_id,hdf5err)
+     call h5gclose_f(tgroupid,hdf5err)
+  endif
+
+end subroutine ext_phdf5_get_var_td_char
+
+! obtain the variable time independent attribute with REAL type
+subroutine ext_phdf5_get_var_ti_real(DataHandle,Element,Var,Data,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var
+  real                  ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hid_t)                        :: attr_type 
+  integer(hsize_t), dimension(7)        :: h5_dims
+  integer                               :: hdf5err
+
+  attr_type = H5T_NATIVE_REAL
+
+  call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (status /= WRF_NO_ERR) then 
+     return
+  endif
+
+  call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  h5_dims(1) = OutCount
+  call h5aread_f(h5_attrid,attr_type,data,h5_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_get_var_ti_real
+
+! obtain the variable time independent attribute with REAL8 type
+subroutine ext_phdf5_get_var_ti_double(DataHandle,Element,Var,Data,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var
+  real*8                ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hid_t)                        :: attr_type 
+  integer(hsize_t), dimension(7)        :: h5_dims
+  integer                               :: hdf5err
+
+  attr_type = H5T_NATIVE_DOUBLE
+
+  call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (status /= WRF_NO_ERR) then 
+     return
+  endif
+
+  call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  h5_dims(1) = OutCount
+  call h5aread_f(h5_attrid,attr_type,data,h5_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+end subroutine ext_phdf5_get_var_ti_double
+
+! obtain the variable time independent attribute with integer type
+subroutine ext_phdf5_get_var_ti_integer(DataHandle,Element,Var,Data,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var
+  integer               ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hid_t)                        :: attr_type 
+  integer(hsize_t), dimension(7)        :: h5_dims
+  integer                               :: hdf5err
+
+  attr_type = H5T_NATIVE_INTEGER
+
+  call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  h5_dims(1) = OutCount
+  call h5aread_f(h5_attrid,attr_type,data,h5_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  return
+
+end subroutine ext_phdf5_get_var_ti_integer
+
+! obtain the variable time independent attribute with logical type
+subroutine ext_phdf5_get_var_ti_logical(DataHandle,Element,Var,Data,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var
+  logical               ,intent(out)    :: Data(*)
+  integer, dimension(:),allocatable     :: Buffer
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hid_t)                        :: attr_type 
+  type(wrf_phdf5_data_handle),pointer    :: DH
+  integer(hsize_t), dimension(7)        :: h5_dims
+  integer                               :: hdf5err
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  attr_type = DH%EnumID
+  call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  h5_dims(1) = OutCount
+
+  allocate(buffer(OutCount))
+  call h5aread_f(h5_attrid,attr_type,buffer,h5_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(buffer)
+     return
+  endif
+
+  Data(1:OutCount) = buffer(1:OutCount)==1
+  deallocate(buffer)
+  return
+
+end subroutine ext_phdf5_get_var_ti_logical
+
+
+! obtain the domain variable independent attribute with Char type
+subroutine ext_phdf5_get_var_ti_char(DataHandle,Element,Var,Data,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  use get_attrid_routine
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var
+  character*(*)         ,intent(out)    :: Data
+  integer               ,intent(out)    :: Status
+
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hid_t)                        :: attr_type 
+  integer(hsize_t), dimension(7)        :: h5_dims
+  integer                               :: Count
+  integer                               :: OutCount
+  integer                               :: hdf5err
+
+  attr_type = H5T_NATIVE_CHARACTER
+  call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call check_type(DataHandle,attr_type,h5_attrid,Status)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
+       Count,OutCount,Status)
+  if (status /= WRF_NO_ERR) then
+     return
+  endif
+
+  if(OutCount /= 1) then
+     Status = WRF_HDF5_ERR_ATTRIBUTE_OTHERS
+  endif
+  h5_dims(1) = OutCount
+  call h5aread_f(h5_attrid,h5_atypeid,data,h5_dims,hdf5err) 
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  return
+
+end subroutine ext_phdf5_get_var_ti_char
+
+
+! write the domain time independent attribute with real type
+subroutine ext_phdf5_put_dom_ti_real(DataHandle,Element,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  real                  ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  integer(hid_t)                        :: h5_objid
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hsize_t), dimension(7)        :: adata_dims
+  character*3                           :: routine_type
+  integer                               :: routine_atype
+  integer                               :: str_flag = 0 ! not a string type
+  integer(hid_t)                        :: hdf5err
+  character(VarNameLen)                 :: var
+
+  ! Do nothing unless it is time to write time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  var = 'DUMMY'
+  routine_type = 'DOM'
+  routine_atype = WRF_REAL
+  adata_dims(1) = Count
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_put_dom_ti_real
+
+! write the domain time independent attribute with integer type
+subroutine ext_phdf5_put_dom_ti_integer(DataHandle,Element,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  integer               ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_objid
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hsize_t), dimension(7)        :: adata_dims
+  character*3                           :: routine_type
+  integer                               :: routine_atype
+  integer                               :: str_flag = 0 ! not a string type
+  integer(hid_t)                        :: hdf5err
+  character(VarNameLen)                 :: var
+
+  ! Do nothing unless it is time to write time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  var = 'DUMMY'
+  routine_type = 'DOM'
+  routine_atype = WRF_INTEGER
+  adata_dims(1) = Count
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_put_dom_ti_integer
+
+! write the domain time independent attribute with double type
+subroutine ext_phdf5_put_dom_ti_double(DataHandle,Element,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  real*8                ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_objid
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hsize_t), dimension(7)        :: adata_dims
+
+  character*3                           :: routine_type
+  integer                               :: routine_atype
+  integer                               :: str_flag = 0 ! not a string type
+  integer(hid_t)                        :: hdf5err
+  character(VarNameLen)                 :: var
+
+  ! Do nothing unless it is time to write time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  var           = 'DUMMY'
+  routine_type  = 'DOM'
+  routine_atype = WRF_DOUBLE
+  adata_dims(1) = Count
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+  return
+
+end subroutine ext_phdf5_put_dom_ti_double
+
+! write the domain time independent attribute with logical type
+subroutine ext_phdf5_put_dom_ti_logical(DataHandle,Element,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)      :: DataHandle
+  character*(*)         ,intent(in)      :: Element
+  logical               ,intent(in)      :: Data(*)
+  integer     ,dimension(:),allocatable  :: Buffer
+  integer               ,intent(in)      :: Count
+  integer               ,intent(out)     :: Status
+
+  integer                                :: i
+  integer(hid_t)                         :: h5_objid
+  integer(hid_t)                         :: h5_atypeid
+  integer(hid_t)                         :: h5_aspaceid
+  integer(hid_t)                         :: h5_attrid
+  integer(hsize_t), dimension(7)         :: adata_dims
+
+  character*3                            :: routine_type
+  integer                                :: routine_atype
+  integer                                :: str_flag = 0 ! not a string type
+  integer(hid_t)                         :: hdf5err
+  character(VarNameLen)                  :: var
+
+  ! Do nothing unless it is time to write time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  var           = 'DUMMY'
+  routine_type  = 'DOM'
+  routine_atype = WRF_LOGICAL
+  adata_dims(1) = Count
+
+  allocate(Buffer(Count))
+
+  do i = 1,Count
+     if(Data(i) .EQV. .TRUE.) then
+        Buffer(i) = 1
+     else
+        Buffer(i) = 0
+     endif
+  enddo
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status,DataHandle)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(buffer)
+     return
+  endif
+
+  call h5awrite_f(h5_attrid,h5_atypeid,Buffer,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(buffer)
+     return
+  endif
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  deallocate(Buffer)
+
+end subroutine ext_phdf5_put_dom_ti_logical
+
+
+! write the domain time independent attribute with char type
+subroutine ext_phdf5_put_dom_ti_char(DataHandle,Element,Data,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+!!!! Need more work.
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Data
+  integer                               :: Count ! always 1 for char
+  integer               ,intent(out)    :: Status
+
+  integer(hid_t)                        :: h5_objid
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hsize_t), dimension(7)        :: adata_dims
+  character*3                           :: routine_type
+  integer                               :: routine_atype
+  integer                               :: str_flag = 1 ! is a string type
+  integer(hid_t)                        :: hdf5err
+  integer                               :: len_str
+  character(VarNameLen)                 :: var
+  character(1)                          :: RepData =' '
+
+  ! Do nothing unless it is time to write time-independent domain metadata.
+  IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
+    Status = WRF_NO_ERR
+    return
+  ENDIF
+
+  Count = 1
+  var = 'DUMMY'
+  routine_type = 'DOM'
+  routine_atype = WRF_CHARACTER
+  adata_dims(1) = Count
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  ! This part may need more work, a special case is that the length of the
+  ! string may be 0, HDF5 cannot handle 0 length string(?),so set the length
+  ! to 1
+
+  len_str = len_trim(Data)
+  if(len_str == 0) then
+     len_str = 1
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,len_str,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  if(len_trim(Data) == 0) then
+
+     call h5awrite_f(h5_attrid,h5_atypeid,RepData,adata_dims,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+  else
+
+     call h5awrite_f(h5_attrid,h5_atypeid,trim(Data),adata_dims,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+  endif
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_put_dom_ti_char
+
+! write the variable time independent attribute with real type
+subroutine ext_phdf5_put_var_ti_real(DataHandle,Element,Var,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var      
+  real                  ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  integer(hid_t)                        :: h5_objid
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hsize_t), dimension(7)        :: adata_dims
+  character*3                           :: routine_type
+  integer                               :: routine_atype
+  integer                               :: str_flag = 0 ! not a string type
+  integer(hid_t)                        :: hdf5err
+  type(wrf_phdf5_data_handle),pointer    :: DH
+
+
+  routine_type = 'VAR'
+  routine_atype = WRF_REAL
+  adata_dims(1) = Count
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  ! The following two checks must be here to avoid duplicating attributes
+  if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_NO_ERR
+     return
+  endif
+  if(DH%TimeIndex > 1) then
+     Status = WRF_NO_ERR
+     return   
+  endif
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,Var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_put_var_ti_real
+
+! write the variable time independent attribute with double type
+subroutine ext_phdf5_put_var_ti_double(DataHandle,Element,Var,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  real*8                ,intent(in)     :: Data(*)
+  character*(*)         ,intent(in)     :: Var      
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  integer(hid_t)                        :: h5_objid
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hsize_t), dimension(7)        :: adata_dims
+
+  character*3                           :: routine_type
+  integer                               :: routine_atype
+  integer                               :: str_flag = 0 ! not a string type
+  integer(hid_t)                        :: hdf5err
+  type(wrf_phdf5_data_handle),pointer    :: DH
+
+  routine_type  = 'VAR'
+  routine_atype = WRF_DOUBLE
+  adata_dims(1) = Count
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_NO_ERR
+     return
+  endif
+  if(DH%TimeIndex > 1) then
+     Status = WRF_NO_ERR
+     return   
+  endif
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,Var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  return
+
+end subroutine ext_phdf5_put_var_ti_double
+
+! write the variable time independent attribute with integer type
+subroutine ext_phdf5_put_var_ti_integer(DataHandle,Element,Var,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var      
+  integer               ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  integer(hid_t)                        :: h5_objid
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hsize_t), dimension(7)        :: adata_dims
+
+  character*3                           :: routine_type
+  integer                               :: routine_atype
+  integer                               :: str_flag = 0 ! not a string type
+  integer(hid_t)                        :: hdf5err
+  type(wrf_phdf5_data_handle),pointer    :: DH
+
+  routine_type = 'VAR'
+  routine_atype = WRF_INTEGER
+  adata_dims(1) = Count
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  ! The following two checks must be here to avoid duplicating attributes
+  if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_NO_ERR
+     return
+  endif
+  if(DH%TimeIndex > 1) then
+     Status = WRF_NO_ERR
+     return   
+  endif
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,Var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_put_var_ti_integer
+
+
+! write the variable time independent attribute with logical type
+subroutine ext_phdf5_put_var_ti_logical(DataHandle,Element,Var,Data,Count,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var      
+  logical               ,intent(in)     :: Data(*)
+  integer     ,dimension(:),allocatable :: Buffer
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  integer                                :: i
+  integer(hid_t)                        :: h5_objid
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hsize_t), dimension(7)        :: adata_dims
+
+  character*3                           :: routine_type
+  integer                               :: routine_atype
+  integer                               :: str_flag = 0 ! not a string type
+  integer(hid_t)                        :: hdf5err
+  type(wrf_phdf5_data_handle),pointer    :: DH
+
+  routine_type = 'VAR'
+  routine_atype = WRF_LOGICAL
+  adata_dims(1) = Count
+
+  allocate(Buffer(Count))
+
+  do i = 1,Count
+     if(Data(i) .EQV. .TRUE.) then
+        Buffer(i) = 1
+     else
+        Buffer(i) = 0
+     endif
+  enddo
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  ! The following two checks must be here to avoid duplicating attributes
+  if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_NO_ERR
+     return
+  endif
+
+  if(DH%TimeIndex > 1) then
+     Status = WRF_NO_ERR
+     return   
+  endif
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(buffer)
+     return
+  endif
+
+
+  call h5awrite_f(h5_attrid,h5_atypeid,Buffer,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(buffer)
+     return
+  endif
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_put_var_ti_logical
+
+! write the variable time independent attribute with char type
+subroutine ext_phdf5_put_var_ti_char(DataHandle,Element,Var,Data,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Data
+  character*(*)         ,intent(in)     :: Var      
+  integer                               :: Count
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_objid
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_aspaceid
+  integer(hid_t)                        :: h5_attrid
+  integer(hsize_t), dimension(7)        :: adata_dims
+
+  character*3                           :: routine_type
+  integer                               :: routine_atype
+  integer                               :: str_flag = 1 ! IS  string type
+  integer(hid_t)                        :: hdf5err
+  integer                               :: len_str
+  character(1)                          :: RepData = ' '
+  type(wrf_phdf5_data_handle),pointer    :: DH
+
+  Count         = 1
+  routine_type  = 'VAR'
+  routine_atype = WRF_CHARACTER
+  adata_dims(1) = Count
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+          ', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  ! The following two checks must be here to avoid duplicating attributes
+  if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+     Status = WRF_NO_ERR
+     return
+  endif
+
+  if(DH%TimeIndex > 1) then
+     Status = WRF_NO_ERR
+     return   
+  endif
+
+  call create_phdf5_objid(DataHandle,h5_objid,routine_type,Var,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  len_str = len_trim(Data)
+
+  if(len_str .eq. 0) then
+     len_str = 1
+  endif
+
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,len_str,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  if(len_trim(Data) == 0) then
+
+     call h5awrite_f(h5_attrid,h5_atypeid,RepData,adata_dims,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+  else
+     call h5awrite_f(h5_attrid,h5_atypeid,trim(Data),adata_dims,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+  endif
+
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  return
+end subroutine ext_phdf5_put_var_ti_char
+
+
+
+! This routine will retrieve the dimensional table, should be useful
+! for tool developers.
+
+subroutine retrieve_table(DataHandle,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use hdf5
+  implicit none
+  include 'wrf_status_codes.h'   
+
+  character*256,dimension(MaxTabDims)    :: dim_name
+  integer,dimension(:),allocatable      :: length
+  integer,dimension(:),allocatable      :: unlimited
+  integer, intent(in)                   :: DataHandle
+  integer, intent(out)                  :: Status
+
+  integer(hid_t)                        :: dset_id
+  integer(hid_t)                        :: dataspace_id
+  integer(hid_t)                        :: dtstr_id
+  integer(hid_t)                        :: dt1_id
+  integer(hid_t)                        :: dtint1_id
+  integer(hid_t)                        :: dtint2_id
+  integer(size_t)                       :: type_sizei
+  integer(size_t)                       :: offset
+  integer                               :: table_length
+  integer(size_t)                       :: string_size
+  integer(hsize_t),dimension(7)         :: data_dims
+  integer(hsize_t)                      :: table_size
+  integer                               :: i
+  integer                               :: hdf5err
+
+  type(wrf_phdf5_data_handle),pointer    :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  call h5dopen_f(DH%DimGroupID,"h5dim_table",dset_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASET_OPEN
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5dget_space_f(dset_id,dataspace_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5sget_simple_extent_npoints_f(dataspace_id,table_size,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  data_dims(1) = table_size
+  allocate(length(table_size))
+  allocate(unlimited(table_size))
+
+
+  ! the name of the dimension
+  call h5tcopy_f(H5T_NATIVE_CHARACTER,dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  string_size = 256
+  call h5tset_size_f(dtstr_id,string_size,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  call h5tcreate_f(H5T_COMPOUND_F,string_size,dt1_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  offset = 0
+  call h5tinsert_f(dt1_id,"dim_name",offset,dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  call h5dread_f(dset_id,dt1_id,dim_name,data_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASET_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  ! the length of the dimension
+  call h5tget_size_f(H5T_NATIVE_INTEGER,type_sizei,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  call h5tcreate_f(H5T_COMPOUND_F,type_sizei,dtint1_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  offset = 0
+  call h5tinsert_f(dtint1_id,"dim_length",offset,H5T_NATIVE_INTEGER,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  call h5dread_f(dset_id,dtint1_id,length,data_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASET_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+
+  ! the unlimited info. of the dimension
+  call h5tget_size_f(H5T_NATIVE_INTEGER,type_sizei,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  call h5tcreate_f(H5T_COMPOUND_F,type_sizei,dtint2_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  offset = 0
+  call h5tinsert_f(dtint2_id,"dim_unlimited",offset,H5T_NATIVE_INTEGER,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  call h5dread_f(dset_id,dtint2_id,unlimited,data_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASET_READ
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  ! Store the information to the table array
+  do i =1,table_size
+     DH%DIMTABLE(i)%dim_name = dim_name(i)
+     DH%DIMTABLE(i)%length   = length(i)
+     DH%DIMTABLE(i)%unlimited = unlimited(i)
+  enddo
+
+  deallocate(length)
+  deallocate(unlimited)
+
+  call h5tclose_f(dtint1_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tclose_f(dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tclose_f(dtint2_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tclose_f(dt1_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5sclose_f(dataspace_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5dclose_f(dset_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASET_CLOSE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  Status = WRF_NO_ERR
+  return
+end subroutine retrieve_table
+
+! store(write) the dimensional table into the HDF5 file
+subroutine store_table(DataHandle,table_length,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use hdf5
+  implicit none
+  include 'wrf_status_codes.h'   
+
+  integer ,intent(in)                            :: DataHandle
+  integer, intent(in)                            :: table_length
+  integer, intent(out)                           :: Status
+
+  type(wrf_phdf5_data_handle),pointer             :: DH
+
+  integer(hid_t)                                 :: group_id
+  integer(hid_t)                                 :: dset_id
+  integer(hid_t)                                 :: dtype_id
+  integer(hid_t)                                 :: dtstr_id
+  integer(hid_t)                                 :: dtstrm_id
+  integer(hid_t)                                 :: dtint1_id
+  integer(hid_t)                                 :: dtint2_id
+  integer(hid_t)                                 :: plist_id
+  integer(size_t)                                :: type_size
+  integer(size_t)                                :: type_sizes
+  integer(size_t)                                :: type_sizei
+  integer(size_t)                                :: offset
+  character*256      ,dimension(MaxTabDims)       :: dim_name
+  integer           ,dimension(:),allocatable    :: length
+  integer           ,dimension(:),allocatable    :: unlimited
+  integer(hid_t)                                 :: dspace_id
+  integer(hsize_t)  ,dimension(1)                :: table_dims
+  integer                                        :: table_rank
+  integer(hsize_t) ,dimension(7)                 :: data_dims
+  integer                                        :: i,j
+  integer                                        :: hdf5err
+
+  data_dims(1) = table_length
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+          ', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  call create_h5filetype(dtype_id,Status)
+  if(Status /= WRF_NO_ERR) then
+     return
+  endif
+
+  ! obtain group id
+  group_id = DH%DimGroupID
+
+  ! create data space
+  table_rank    = 1
+  table_dims(1) = table_length
+
+  call h5screate_simple_f(table_rank,table_dims,dspace_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! obtain the data  
+  allocate(length(table_length))
+  allocate(unlimited(table_length))
+
+  do i =1, table_length
+     length(i)    = DH%DIMTABLE(i)%length
+     unlimited(i) = DH%DIMTABLE(i)%unlimited
+  enddo
+
+  do i=1,table_length
+     do j=1,256
+        dim_name(i)(j:j)=DH%DIMTABLE(i)%dim_name(j:j)
+     enddo
+  enddo
+
+  ! under dimensional group
+  call h5dcreate_f(group_id,"h5dim_table",dtype_id,dspace_id,&
+       dset_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASET_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  ! create memory types
+  call h5tget_size_f(H5T_NATIVE_INTEGER,type_sizei,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  ! FOR string, it needs extra handling
+  call h5tcopy_f(H5T_NATIVE_CHARACTER,dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(length)
+     deallocate(unlimited)
+     return
+  endif
+
+  type_size = 256
+
+     call h5tset_size_f(dtstr_id, type_size,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     call h5tget_size_f(dtstr_id, type_size,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     call h5tcreate_f(H5T_COMPOUND_F,type_size,dtstrm_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     offset = 0
+     call h5tinsert_f(dtstrm_id,"dim_name",offset,dtstr_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     call h5tcreate_f(H5T_COMPOUND_F,type_sizei,dtint1_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     offset = 0
+     call h5tinsert_f(dtint1_id,"dim_length",offset,H5T_NATIVE_INTEGER,&
+          hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     call h5tcreate_f(H5T_COMPOUND_F,type_sizei,dtint2_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     offset = 0
+     call h5tinsert_f(dtint2_id,"dim_unlimited",offset,H5T_NATIVE_INTEGER,&
+          hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     ! write data by fields in the datatype,but first create a property list
+
+     call h5pcreate_f(H5P_DATASET_XFER_F,plist_id, hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_PROPERTY_LIST
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     call h5pset_preserve_f(plist_id,.TRUE.,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_PROPERTY_LIST
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     call h5dwrite_f(dset_id,dtstrm_id,dim_name,data_dims,hdf5err,&
+          xfer_prp = plist_id)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     call h5dwrite_f(dset_id,dtint1_id,length,data_dims,hdf5err,&
+          xfer_prp = plist_id)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     call h5dwrite_f(dset_id,dtint2_id,unlimited,data_dims,hdf5err,&
+          xfer_prp = plist_id)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        deallocate(length)
+        deallocate(unlimited)
+        return
+     endif
+
+     deallocate(length)
+     deallocate(unlimited)
+
+     ! release resources
+
+     call h5tclose_f(dtstr_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5tclose_f(dtstrm_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5tclose_f(dtint1_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5tclose_f(dtint2_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5tclose_f(dtype_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5pclose_f(plist_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5dclose_f(dset_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_CLOSE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5sclose_f(dspace_id,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     return
+end subroutine store_table
+
+
+subroutine free_memory(DataHandle,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'mpif.h'
+
+  integer              ,intent(in)       :: DataHandle
+  integer              ,intent(out)      :: Status
+  integer                                :: hdf5err
+  type(wrf_phdf5_data_handle),pointer    :: DH
+  integer                                :: i
+  integer                                :: stat
+  real*8                                 :: timeaw,timebw
+
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(DH%Free) then
+     Status = WRF_HDF5_ERR_OTHERS
+     write(msg,*) '',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  deallocate(DH%Times, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%DimLengths, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%DimIDs, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%DimNames, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%DIMTABLE, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%MDDsetIDs, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%MDVarDimLens, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%MDVarNames, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%DsetIDs, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%VarDimLens, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  deallocate(DH%VarNames, STAT=stat)
+  if(stat/= 0) then
+     Status = WRF_HDF5_ERR_DEALLOCATION
+     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+     call wrf_debug ( FATAL , msg)
+     return
+  endif
+  return
+end subroutine free_memory
+
+subroutine write_hdf5_attributes(DataHandle,MemoryOrder,WrfDType,DimRank,&
+     NDim,dset_id,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'mpif.h'
+  include 'wrf_status_codes.h'
+
+
+  integer                     ,intent(in)     :: DataHandle
+  character*(*)               ,intent(in)     :: MemoryOrder	
+  integer                     ,intent(in)     :: WrfDType
+  integer,dimension(*)        ,intent(in)     :: DimRank
+
+  integer                     ,intent(in)     :: NDim
+
+  integer(hid_t)              ,intent(in)     :: dset_id
+  integer                     ,intent(out)    :: Status
+
+  character (3)                               :: Mem0
+  character (3)                               :: UCMem0
+  type(wrf_phdf5_data_handle) ,pointer        :: DH
+
+  ! attribute defination
+  integer(hid_t)                              :: dimaspace_id  ! DimRank dataspace id
+  integer(hid_t)                              :: dimattr_id    ! DimRank attribute id
+  integer(hsize_t) ,dimension(1)              :: dim_space
+
+  integer(hid_t)                              :: h5_atypeid    ! for fieldtype,memorder attribute
+  integer(hid_t)                              :: h5_aspaceid   ! for fieldtype,memorder  
+  integer(hid_t)                              :: h5_attrid     ! for fieldtype,memorder
+  integer(hsize_t), dimension(7)              :: adata_dims
+  integer                                     :: routine_atype
+  integer,          dimension(:),allocatable  :: dimrank_data
+  integer                                     :: hdf5err
+  integer                                     :: j
+
+  !  For time function
+  real*8                                     :: timebw
+  real*8                                     :: timeaw
+  integer                                    :: total_ele
+
+  ! 
+  ! write dimensional rank attribute. This is the temporary fix for dim. scale
+  ! the first dimension is always time
+  allocate(dimrank_data(NDim+1))
+  do j =1, NDim+1
+     dimrank_data(j)  = DimRank(j)
+  enddo
+
+  dim_space(1)  = NDim+1
+  adata_dims(1) = NDim+1
+  call h5screate_simple_f(1,dim_space,dimaspace_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dimrank_data)
+     return
+  endif
+
+  call h5acreate_f(dset_id,'H5_DimRank',H5T_NATIVE_INTEGER,dimaspace_id, &
+       dimattr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dimrank_data)
+     return
+  endif
+
+  call h5awrite_f(dimattr_id,H5T_NATIVE_INTEGER,dimrank_data,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     deallocate(dimrank_data)
+     return
+  endif
+  deallocate(dimrank_data)
+
+  ! close space and attribute id
+  call clean_phdf5_attrids(H5T_NATIVE_INTEGER,dimaspace_id,dimattr_id,0,Status)
+  if(Status.ne.WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+  ! Write memory order and FieldType attribute, both MemoryOrder and FieldType are 1 element
+  adata_dims(1) = 1
+
+  ! output memoryorder attribute
+  call reorder(MemoryOrder,Mem0)
+  call uppercase(Mem0,UCMem0)
+
+  routine_atype = WRF_CHARACTER
+
+  ! The size of memoryorder string is always MemOrdLen
+  call create_phdf5_adtypeid(h5_atypeid,routine_atype,MemOrdLen,Status)
+  if(Status.ne.WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! Count for string attribute is always 1 
+  call create_phdf5_adspaceid(1,1,h5_aspaceid,Status)
+  if(Status.ne.WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+  call h5acreate_f(dset_id,'MemoryOrder',h5_atypeid,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5awrite_f(h5_attrid,h5_atypeid,UCMem0,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+  call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,1,Status)
+  if(Status.ne.WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! output fieldtype attribute
+  call create_phdf5_adspaceid(1,1,h5_aspaceid,Status)
+  if(Status.ne.WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5acreate_f(dset_id,'FieldType',H5T_NATIVE_INTEGER,h5_aspaceid, &
+       h5_attrid, hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5awrite_f(h5_attrid,H5T_NATIVE_INTEGER,WrfDType,adata_dims,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+  call clean_phdf5_attrids(H5T_NATIVE_INTEGER,h5_aspaceid,h5_attrid,0,Status)
+  if(Status.ne.WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+end subroutine write_hdf5_attributes
Index: trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5attr.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5attr.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5attr.F90	(revision 2744)
@@ -0,0 +1,1013 @@
+!***************************************************************************
+!* The HDF5 WRF IO module was written by the the HDF Group at NCSA, the     *
+!* National Center for Supercomputing Applications.                         *
+!*     HDF Group                                                            *
+!*     National Center for Supercomputing Applications                      *
+!*     University of Illinois at Urbana-Champaign                           *
+!*     605 E. Springfield, Champaign IL 61820                               *
+!*     http://hdf.ncsa.uiuc.edu/                                            *
+!*                                                                          *
+!* Copyright 2004 by the Board of Trustees, University of Illinois,         *
+!*                                                                          *
+!* Redistribution or use of this IO module, with or without modification,   *
+!* is permitted for any purpose, including commercial  purposes.            *
+!*                                                                          *
+!* This software is an unsupported prototype.  Use at your own risk.        *
+!*     http://hdf.ncsa.uiuc.edu/apps/WRF-ROMS                               *
+!*                                                                          *
+!* This work was funded by the MEAD expedition at the National Center       *
+!* for Supercomputing Applications, NCSA.  For more information see:        *
+!*     http://www.ncsa.uiuc.edu/expeditions/MEAD                            *
+!*                                                                          *
+!*                                                                          *
+!****************************************************************************/
+
+module get_attrid_routine
+
+  Interface get_attrid
+     module  procedure get_attrid
+  end interface
+
+contains
+
+  subroutine get_attrid(DataHandle,Element,h5_attrid,Status,VAR)
+
+    use wrf_phdf5_data
+    use ext_phdf5_support_routines
+    USE HDF5 ! This module contains all necessary modules 
+    implicit none
+    include 'wrf_status_codes.h'
+
+    character*(*)         ,intent(in)             :: Element
+    integer               ,intent(in)             :: DataHandle
+    integer(hid_t)        ,intent(out)            :: h5_attrid
+    integer(hid_t)                                :: dset_id
+    integer               ,intent(out)            :: Status
+    character*(*)         ,intent(in),optional    :: VAR
+    integer(hid_t)                                :: hdf5err
+    type(wrf_phdf5_data_handle),pointer           :: DH
+
+    character(Len = MaxTimeSLen)                  :: tname
+    character(Len = 512)                          :: tgroupname
+    integer(hid_t)                                :: tgroup_id
+
+    call GetDH(DataHandle,DH,Status)
+    if(Status /= WRF_NO_ERR) then
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+    if(present(VAR)) then
+       call numtochar(1,tname)
+       tgroupname = 'TIME_STAMP_'//tname
+       call h5gopen_f(DH%GroupID,tgroupname,tgroup_id,hdf5err)
+       if(hdf5err.lt.0) then 
+          Status =  WRF_HDF5_ERR_GROUP
+          write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+          call wrf_debug ( WARN , msg) 
+          return
+       endif
+       call h5dopen_f(tgroup_id,VAR,dset_id,hdf5err)
+       if(hdf5err.lt.0) then 
+          Status =  WRF_HDF5_ERR_DATASET_OPEN
+          write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+          call wrf_debug ( WARN , msg) 
+          return
+       endif
+
+       call h5aopen_name_f(dset_id,Element,h5_attrid,hdf5err)
+       if(hdf5err.lt.0) then 
+          Status =  WRF_HDF5_ERR_ATTRIBUTE_OPEN
+          write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+          call wrf_debug ( WARN , msg) 
+          return
+       endif
+       call h5dclose_f(dset_id,hdf5err)
+       call h5gclose_f(tgroup_id,hdf5err)
+    else
+       call h5aopen_name_f(DH%GroupID,Element,h5_attrid,hdf5err)
+       write(*,*) "Element ",Element
+       if(hdf5err.lt.0) then 
+          Status =  WRF_HDF5_ERR_ATTRIBUTE_OPEN
+          write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+          call wrf_debug ( WARN , msg) 
+          return
+       endif
+    endif
+    return
+  end subroutine get_attrid
+end module get_attrid_routine
+
+subroutine create_phdf5_objid(DataHandle,obj_id,routine_type,var,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer                                      :: i
+  integer                       ,intent(in)    :: DataHandle
+  integer(hid_t)                ,intent(out)   :: obj_id
+  character*3                   ,intent(in)    :: routine_type
+  character*(*)                 ,intent(in)    :: var
+  integer                       ,intent(out)   :: Status
+  integer(hid_t)                               :: hdf5err
+  type(wrf_phdf5_data_handle),pointer           :: DH
+
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(routine_type == 'DOM') then
+
+     if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+        obj_id = DH%GroupID
+     endif
+
+  else if(routine_type == 'VAR') then
+
+     if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+        do i = 1, MaxVars
+           if(DH%VarNames(i) == var) then
+              obj_id = DH%dsetids(i)
+              exit
+           endif
+        enddo
+     endif
+
+  else
+     Status = WRF_HDF5_ERR_DATA_ID_NOTFOUND
+     write(msg,*) 'CANNOT FIND DATASET ID of the attribute in',__FILE__,&
+          ', line',__LINE__
+  endif
+
+  return 
+end subroutine create_phdf5_objid
+
+
+subroutine create_phdf5_adtypeid(h5_atypeid,routine_datatype,Count,Status,DataHandle)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer                                      :: i
+  integer(hid_t)                ,intent(out)   :: h5_atypeid
+  integer                       ,intent(in)    :: routine_datatype
+  integer                       ,intent(in)    :: Count
+  integer                       ,intent(out)   :: Status
+  integer(hid_t)                               :: hdf5err
+  integer, intent(in), optional                :: DataHandle
+  integer(size_t)                              :: count_size
+
+  type(wrf_phdf5_data_handle),pointer           :: DH
+
+  if(routine_datatype == WRF_LOGICAL)then
+     call GetDH(DataHandle,DH,Status)
+     if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+  endif
+
+  select case(routine_datatype) 
+  case (WRF_REAL)
+     h5_atypeid = H5T_NATIVE_REAL
+  case (WRF_DOUBLE)
+     h5_atypeid = H5T_NATIVE_DOUBLE
+  case (WRF_INTEGER)
+     h5_atypeid = H5T_NATIVE_INTEGER
+  case (WRF_LOGICAL)
+     h5_atypeid = DH%EnumID
+  case (WRF_CHARACTER)
+
+     call h5tcopy_f(H5T_NATIVE_CHARACTER,h5_atypeid,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     count_size = count
+     call h5tset_size_f(h5_atypeid,count_size,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5tset_strpad_f(h5_atypeid,H5T_STR_SPACEPAD_F,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+  case default
+     Status = WRF_HDF5_ERR_DATATYPE
+     return
+  end select
+
+  Status = WRF_NO_ERR
+
+  return
+end subroutine create_phdf5_adtypeid
+
+subroutine create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+
+  use wrf_phdf5_data
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer                                      :: i
+  integer                       ,intent(in)    :: Count
+  integer                       ,intent(in)    :: str_flag
+  integer                       ,intent(out)   :: Status
+
+  integer(hsize_t)              , dimension(1) :: adims
+  integer(hid_t)                               :: hdf5err
+  integer(hid_t)                ,intent(out)   :: h5_aspaceid
+  integer                                      :: arank = 1
+
+  ! if string, count is always 1
+  if(str_flag == 1) then 
+     adims(1) = 1
+     call h5screate_simple_f(arank,adims,h5_aspaceid,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+  else
+     adims(1) = Count
+     call h5screate_simple_f(arank,adims,h5_aspaceid,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+  endif
+
+  Status = WRF_NO_ERR
+
+  return 
+end subroutine create_phdf5_adspaceid
+
+
+subroutine clean_phdf5_attrids(h5_attr_typeid,h5_space_typeid, &
+     h5_attrid,str_flag,Status)
+
+  use wrf_phdf5_data
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+  integer                       ,intent(out)   :: Status
+  integer(hid_t)                ,intent(in)    :: h5_attr_typeid
+  integer(hid_t)                ,intent(in)    :: h5_space_typeid
+  integer(hid_t)                ,intent(in)    :: h5_attrid
+  integer                       ,intent(in)    :: str_flag
+  integer                                      :: hdf5err
+
+  if(str_flag == 1) then
+     call h5tclose_f(h5_attr_typeid,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+  endif
+
+  call h5sclose_f(h5_space_typeid,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+  call h5aclose_f(h5_attrid,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_ATTRIBUTE_CLOSE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  Status = WRF_NO_ERR
+
+  return
+
+end subroutine clean_phdf5_attrids
+
+
+subroutine create_h5filetype(dtype_id,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use hdf5
+  implicit none
+  include 'wrf_status_codes.h'   
+
+  integer(hid_t),intent(out)              :: dtype_id
+  integer(hid_t)                         :: dtstr_id
+  integer(size_t)                        :: type_size
+  integer(size_t)                        :: type_sizes
+  integer(size_t)                        :: type_sizei
+  integer(size_t)                        :: offset
+  integer,     intent(out)               :: Status
+  integer(hid_t)                         :: hdf5err
+
+  call h5tcopy_f(H5T_NATIVE_CHARACTER,dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  type_size = 256
+
+  call h5tset_size_f(dtstr_id,type_size,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tget_size_f(dtstr_id,type_sizes,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tget_size_f(H5T_NATIVE_INTEGER,type_sizei,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  type_size = type_sizes + 2*type_sizei
+
+  call h5tcreate_f(H5T_COMPOUND_F,type_size,dtype_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  offset = 0
+
+  call h5tinsert_f(dtype_id,"dim_name",offset,dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  offset = offset + type_sizes
+  call h5tinsert_f(dtype_id,"dim_length",offset,H5T_NATIVE_INTEGER,&
+       hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  offset = offset + type_sizei
+
+  call h5tinsert_f(dtype_id,"dim_unlimited",offset,H5T_NATIVE_INTEGER,&
+       hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  call h5tclose_f(dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  Status = WRF_NO_ERR
+  return 
+end subroutine  create_h5filetype
+
+! check whether two types are equal, attr_type and h5_attrid
+subroutine check_type(DataHandle,attr_type,h5_attrid,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  integer(hid_t)        ,intent(in)     :: attr_type
+  integer(hid_t)       ,intent(in)      :: h5_attrid
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_atypeid
+  integer(hid_t)                        :: h5_classid
+  integer(hid_t)                        :: h5_wrfclassid
+  logical                               :: flag
+  integer                               :: hdf5err
+  type(wrf_phdf5_data_handle),pointer    :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5aget_type_f(h5_attrid,h5_atypeid,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tget_class_f(h5_atypeid,h5_classid,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tget_class_f(attr_type,h5_wrfclassid,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  if((h5_classid==H5T_STRING_F).AND.&
+       (attr_type==H5T_NATIVE_CHARACTER)) then 
+     flag = .TRUE.
+  else 
+     if(h5_classid .NE. h5_wrfclassid) then
+        flag = .FALSE.
+     else
+        flag = .TRUE.
+     endif
+  endif
+
+  if(flag .EQV. .FALSE.) then
+     Status = WRF_HDF5_ERR_TYPE_MISMATCH
+     return 
+  endif
+
+  Status = WRF_NO_ERR
+  return
+end subroutine check_type
+
+
+subroutine retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)     :: DataHandle
+  integer               ,intent(in)     :: h5_attrid
+  integer(hid_t)        ,intent(out)    :: h5_atypeid
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_aspaceid
+  integer                               :: typeclass
+  integer                               :: hdf5err
+  integer                               :: rank
+  integer(hsize_t)                      :: npoints
+
+  type(wrf_phdf5_data_handle),pointer    :: DH
+
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+
+     call h5aget_type_f(h5_attrid,h5_atypeid,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5aget_space_f(h5_attrid,h5_aspaceid,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5sget_simple_extent_ndims_f(h5_aspaceid,rank,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     if(rank > 1) then
+        ! The rank can be either 0 or 1
+        Status = WRF_HDF5_ERR_OTHERS
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5sget_simple_extent_npoints_f(h5_aspaceid,npoints,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     OutCount = npoints
+     call h5tget_class_f(h5_atypeid,typeclass,hdf5err)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATATYPE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__   
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+     if((npoints > Count).and.(typeclass.ne.H5T_STRING_F)) then
+        OutCount = Count
+        Status = WRF_HDF5_ERR_MORE_DATA_IN_FILE
+     else
+        OutCount = npoints
+     endif
+  endif
+  return
+end subroutine retrieve_ti_info
+
+subroutine setup_wrtd_dataset(DataHandle,DataSetName,dtypeid,countmd,&
+     dsetid,dspace_id,fspace_id,tgroupid,   &
+     TimeIndex,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: DataSetName
+  integer(hid_t)        ,intent(in)             :: dtypeid
+  integer               ,intent(in)             :: countmd
+  integer               ,intent(in)             :: TimeIndex
+
+  integer(hid_t)        ,intent(out)            :: dsetid
+  integer(hid_t)        ,intent(out)            :: dspace_id
+  integer(hid_t)        ,intent(out)            :: fspace_id
+  integer(hid_t)        ,intent(out)            :: tgroupid
+  integer(hid_t)                                :: crp_list
+  integer               ,intent(out)            :: Status
+
+  integer(hsize_t)      ,dimension(1)           :: sizes
+  integer(hsize_t)      ,dimension(1)           :: chunk_dims
+  integer(hsize_t)      ,dimension(1)           :: dims
+  integer(hsize_t)      ,dimension(1)           :: hdf5_maxdims
+  integer(hsize_t)      ,dimension(1)           :: offset
+  integer(hsize_t)      ,dimension(1)           :: count
+  type(wrf_phdf5_data_handle),pointer           :: DH
+
+  character(Len = MaxTimeSLen)                 :: tname
+  character(Len = 512)                         :: tgroupname                           
+  integer                                       :: hdf5err
+
+
+  ! get datahandle
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+
+  chunk_dims(1)   = countmd
+
+  dims(1)         = countmd
+
+  count(1)        = countmd
+
+  offset(1)       = 0
+
+  sizes(1)        = countmd
+
+  hdf5_maxdims(1) = countmd
+
+  ! create the memory space id
+  call h5screate_simple_f(1,dims,dspace_id,hdf5err,dims)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! create file space(for parallel module, each dataset per time step)
+  call h5screate_simple_f(1,dims,fspace_id,hdf5err,hdf5_maxdims)
+  if(hdf5err.lt.0) then        
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! obtain the absolute name of the group where the dataset is located
+  call numtochar(TimeIndex,tname)
+  tgroupname = 'TIME_STAMP_'//tname
+  if(DH%TgroupIDs(TimeIndex) /= -1) then
+    tgroupid = DH%TgroupIDs(TimeIndex) 
+!  call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
+  else 
+   call h5gcreate_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
+   if(hdf5err.lt.0) then                                            
+     Status =  WRF_HDF5_ERR_GROUP                  
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__     
+     call wrf_debug(WARN,msg)
+     return                                                                               
+   endif          
+   DH%TgroupIDs(TimeIndex) = tgroupid
+  endif
+
+  ! create dataset
+  call h5dcreate_f(tgroupid,DatasetName,dtypeid,fspace_id,&
+       dsetid,hdf5err)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASET_CREATE 
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  return
+end subroutine setup_wrtd_dataset
+
+subroutine extend_wrtd_dataset(DataHandle,TimeIndex,countmd,dsetid,dspaceid,&
+     fspaceid,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  integer               ,intent(in)             :: countmd
+  integer               ,intent(in)             :: TimeIndex
+
+  integer(hid_t)        ,intent(out)            :: dsetid
+  integer(hid_t)        ,intent(out)            :: dspaceid
+  integer(hid_t)        ,intent(out)            :: fspaceid
+  integer               ,intent(out)            :: Status
+
+  integer(hsize_t)      ,dimension(2)           :: sizes
+  integer(hsize_t)      ,dimension(2)           :: chunk_dims
+  integer(hsize_t)      ,dimension(2)           :: dims
+  integer(hsize_t)      ,dimension(2)           :: hdf5_maxdims
+  integer(hsize_t)      ,dimension(2)           :: offset
+  integer(hsize_t)      ,dimension(2)           :: count
+
+  integer                                       :: hdf5err
+
+  sizes(1)    = countmd
+  sizes(2)    = TimeIndex
+  offset(1)   = 0
+  offset(2)   = TimeIndex - 1
+  count(1)    = countmd
+  count(2)    = 1
+  dims(1)     = countmd
+  dims(2)     = 1
+
+  ! extend the dataset
+  CALL h5dextend_f(dsetid,sizes,hdf5err)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASET_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! obtain file space id
+  CALL h5dget_space_f(dsetid,fspaceid,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  CALL h5sselect_hyperslab_f(fspaceid, H5S_SELECT_SET_F, &
+       offset, count, hdf5err) 
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASET_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! create the memory space id
+  call h5screate_simple_f(2,dims,dspaceid,hdf5err,dims)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  return
+end subroutine extend_wrtd_dataset
+
+subroutine setup_rdtd_dataset(DataHandle,DataSetName,mtypeid,TimeIndex,&
+     countmd,outcountmd,dset_id,memspaceid,    &
+     dspace_id,tgroupid,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: DataSetName
+  integer               ,intent(in)             :: countmd
+  integer               ,intent(out)            :: outcountmd
+  integer               ,intent(inout)          :: mtypeid
+  integer               ,intent(in)             :: TimeIndex
+
+  integer(hid_t)        ,intent(out)            :: dset_id
+  integer(hid_t)        ,intent(out)            :: dspace_id
+  integer(hid_t)        ,intent(out)            :: memspaceid
+  integer(hid_t)        ,intent(out)            :: tgroupid
+  integer               ,intent(out)            :: Status
+
+  integer(hid_t)                                :: dtype_id
+  integer(hid_t)                                :: class_type
+  integer(hsize_t)      ,dimension(1)           :: sizes
+  integer(hsize_t)      ,dimension(1)           :: dims
+  integer(hsize_t)      ,dimension(1)           :: h5_dims
+  integer(hsize_t)      ,dimension(1)           :: hdf5_maxdims
+  integer(hsize_t)      ,dimension(1)           :: offset
+  integer(hsize_t)      ,dimension(1)           :: count
+  integer                                       :: StoredDim
+  type(wrf_phdf5_data_handle),pointer            :: DH
+
+  logical                                       :: flag
+  integer                                       :: hdf5err
+
+  character(Len = MaxTimeSLen)                 :: tname
+  character(Len = 512)                         :: tgroupname      
+  ! get datahandle
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  ! obtain the absolute name of the group where the dataset is located
+  call numtochar(TimeIndex,tname)
+  tgroupname = 'TIME_STAMP_'//tname
+  call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
+
+  ! Obtain HDF5 dataset id  
+  call h5dopen_f(tgroupid,DataSetName,dset_id,hdf5err)
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_DATASET_OPEN
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! Obtain the datatype
+  call h5dget_type_f(dset_id,dtype_id,hdf5err)
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_DATASET_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tget_class_f(dtype_id,class_type,hdf5err)
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  if(mtypeid == H5T_NATIVE_REAL .or. mtypeid == H5T_NATIVE_DOUBLE) then
+     if( class_type /= H5T_FLOAT_F)  then
+        Status = WRF_HDF5_ERR_TYPE_MISMATCH
+        write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+  else if(mtypeid ==H5T_NATIVE_CHARACTER) then
+     if(class_type /= H5T_STRING_F) then
+        Status = WRF_HDF5_ERR_TYPE_MISMATCH
+        write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+  else if(mtypeid == H5T_NATIVE_INTEGER) then 
+     if(class_type /= H5T_INTEGER_F) then
+        Status = WRF_HDF5_ERR_TYPE_MISMATCH
+        write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+  else if(mtypeid == DH%EnumID) then
+     if(class_type /= H5T_ENUM_F) then
+        Status = WRF_HDF5_ERR_TYPE_MISMATCH
+        write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+     call h5tequal_f(dtype_id,DH%EnumID,flag,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_OPEN
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+     if(flag .EQV. .FALSE.) then
+        Status = WRF_HDF5_ERR_TYPE_MISMATCH
+        write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+     endif
+  else 
+     Status = WRF_HDF5_ERR_BAD_DATA_TYPE
+     write(msg,*)'Fatal Non-WRF supported TYPE in ',__FILE__,', line',__LINE__
+     call wrf_debug(FATAL, msg)
+     return
+  endif
+  ! update string id
+  if(mtypeid == H5T_NATIVE_CHARACTER) then
+     mtypeid = dtype_id
+  endif
+
+  ! Obtain the dataspace
+  call h5dget_space_f(dset_id,dspace_id,hdf5err)
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! Obtain the rank of the dimension
+  call h5sget_simple_extent_ndims_f(dspace_id,StoredDim,hdf5err)
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  if(StoredDim /=1) then
+     Status = WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  call h5sget_simple_extent_dims_f(dspace_id,h5_dims,hdf5_maxdims,hdf5err)
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+
+  if(countmd <= 0) then
+     Status = WRF_HDF5_ERR_ZERO_LENGTH_READ
+     write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(countmd .lt. h5_dims(1)) then
+     outcountmd = countmd
+  else
+     outcountmd = h5_dims(1)
+  endif
+
+  ! create memspace_id
+  dims(1) = outcountmd
+
+  call h5screate_simple_f(1,dims,memspaceid,hdf5err)
+  if(hdf5err.lt.0) then
+     Status = WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  offset(1) = 0
+  count(1)  = outcountmd
+
+  return
+end subroutine setup_rdtd_dataset
+
+subroutine make_strid(str_len,str_id,Status) 
+
+  use wrf_phdf5_data
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer      ,intent(in)         :: str_len
+  integer(hid_t),intent(out)       :: str_id
+  integer       ,intent(out)       :: Status
+  integer(size_t)                  :: str_lensize
+  integer                          :: hdf5err
+
+  Status = WRF_NO_ERR
+  if(str_len <= 0) then
+     Status = WRF_HDF5_ERR_ATTRIBUTE_GENERAL
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tcopy_f(H5T_NATIVE_CHARACTER,str_id,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  str_lensize = str_len
+  call h5tset_size_f(str_id,str_lensize,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5tset_strpad_f(str_id,H5T_STR_SPACEPAD_F,hdf5err)
+  if(hdf5err.lt.0) then 
+     Status =  WRF_HDF5_ERR_DATATYPE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+end subroutine make_strid
Index: trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5attr.F90btg
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5attr.F90btg	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5attr.F90btg	(revision 2744)
@@ -0,0 +1,977 @@
+!/****************************************************************************
+!* NCSA HDF								    *
+!*     *
+!* National Center for Supercomputing Applications			    *
+!* University of Illinois at Urbana-Champaign				    *
+!* 605 E. Springfield, Champaign IL 61820				    *
+!*									    *
+!* For conditions of distribution and use, see the accompanying		    *
+!* hdf/COPYING file.							    *
+!*									    *
+!****************************************************************************/
+
+module get_attrid_routine
+
+Interface get_attrid
+ module  procedure get_attrid
+end interface 
+
+ contains
+ 
+subroutine get_attrid(DataHandle,Element,h5_attrid,Status,VAR)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  character*(*)         ,intent(in)             :: Element
+  integer               ,intent(in)             :: DataHandle
+  integer(hid_t)        ,intent(out)            :: h5_attrid
+  integer(hid_t)                                :: dset_id
+  integer               ,intent(out)            :: Status
+  character*(*)         ,intent(in),optional    :: VAR
+  integer(hid_t)                                :: hdf5err
+  type(wrf_phdf5_data_handle),pointer           :: DH
+
+  character(Len = MaxTimeSLen)                  :: tname
+  character(Len = 256)                          :: tgroupname
+  integer(hid_t)                                :: tgroup_id
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  if(present(VAR)) then
+      call numtochar(1,tname)
+      tgroupname = 'TIME_STAMP_'//tname
+      call h5gopen_f(DH%GroupID,tgroupname,tgroup_id,hdf5err)
+      call h5dopen_f(tgroup_id,VAR,dset_id,hdf5err)
+      if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_DATASET_OPEN
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+      endif
+      
+      call h5aopen_name_f(dset_id,Element,h5_attrid,hdf5err)
+      if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_ATTRIBUTE_OPEN
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+      endif
+      call h5dclose_f(dset_id,hdf5err)
+      call h5gclose_f(tgroup_id,hdf5err)
+  else
+     call h5aopen_name_f(DH%GroupID,Element,h5_attrid,hdf5err)
+     if(hdf5err.lt.0) then 
+        Status =  WRF_HDF5_ERR_ATTRIBUTE_OPEN
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+      endif
+  endif
+  return
+ end subroutine get_attrid
+end module get_attrid_routine
+
+subroutine create_phdf5_objid(DataHandle,obj_id,routine_type,var,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer                                      :: i
+  integer                       ,intent(in)    :: DataHandle
+  integer(hid_t)                ,intent(out)   :: obj_id
+  character*3                   ,intent(in)    :: routine_type
+  character*(*)                 ,intent(in)    :: var
+  integer                       ,intent(out)   :: Status
+  integer(hid_t)                               :: hdf5err
+  type(wrf_phdf5_data_handle),pointer           :: DH
+
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(routine_type == 'DOM') then
+
+     if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+        obj_id = DH%GroupID
+     endif
+
+  else if(routine_type == 'VAR') then
+
+     if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
+        do i = 1, MaxVars
+           if(DH%VarNames(i) == var) then
+              obj_id = DH%dsetids(i)
+		write(*,*) "obj_id at attribute",obj_id
+		write(*,*) "DH%VarNames(i)",DH%VarNames(i)
+              exit
+           endif
+        enddo
+     endif
+
+  else
+     Status = WRF_HDF5_ERR_DATA_ID_NOTFOUND
+     write(msg,*) 'CANNOT FIND DATASET ID of the attribute in',__FILE__,&
+     ', line',__LINE__
+  endif
+
+  return 
+end subroutine create_phdf5_objid
+
+
+subroutine create_phdf5_adtypeid(h5_atypeid,routine_datatype,Count,Status,DataHandle)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer                                      :: i
+  integer(hid_t)                ,intent(out)   :: h5_atypeid
+  integer                       ,intent(in)    :: routine_datatype
+  integer                       ,intent(in)    :: Count
+  integer                       ,intent(out)   :: Status
+  integer(hid_t)                               :: hdf5err
+  integer, intent(in), optional                :: DataHandle
+  integer(size_t)                              :: count_size
+
+  type(wrf_phdf5_data_handle),pointer           :: DH
+
+  if(routine_datatype == WRF_LOGICAL)then
+     call GetDH(DataHandle,DH,Status)
+     if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+  endif
+
+  select case(routine_datatype) 
+  case (WRF_REAL)
+     h5_atypeid = H5T_NATIVE_REAL
+  case (WRF_DOUBLE)
+     h5_atypeid = H5T_NATIVE_DOUBLE
+  case (WRF_INTEGER)
+     h5_atypeid = H5T_NATIVE_INTEGER
+  case (WRF_LOGICAL)
+     h5_atypeid = DH%EnumID
+  case (WRF_CHARACTER)
+
+     call h5tcopy_f(H5T_NATIVE_CHARACTER,h5_atypeid,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+     count_size = count
+     call h5tset_size_f(h5_atypeid,count_size,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+     call h5tset_strpad_f(h5_atypeid,H5T_STR_SPACEPAD_F,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+  case default
+     Status = WRF_HDF5_ERR_DATATYPE
+     return
+  end select
+
+  Status = WRF_NO_ERR
+
+  return
+end subroutine create_phdf5_adtypeid
+
+subroutine create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
+
+  use wrf_phdf5_data
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer                                      :: i
+  integer                       ,intent(in)    :: Count
+  integer                       ,intent(in)    :: str_flag
+  integer                       ,intent(out)   :: Status
+
+  integer(hsize_t)              , dimension(1) :: adims
+  integer(hid_t)                               :: hdf5err
+  integer(hid_t)                ,intent(out)   :: h5_aspaceid
+  integer                                      :: arank = 1
+
+  ! if string, count is always 1
+  if(str_flag == 1) then 
+     adims(1) = 1
+     call h5screate_simple_f(arank,adims,h5_aspaceid,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATASPACE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+     endif
+
+  else
+     adims(1) = Count
+     call h5screate_simple_f(arank,adims,h5_aspaceid,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATASPACE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+     endif
+
+  endif
+
+  Status = WRF_NO_ERR
+  
+  return 
+end subroutine create_phdf5_adspaceid
+
+
+subroutine clean_phdf5_attrids(h5_attr_typeid,h5_space_typeid, &
+     h5_attrid,str_flag,Status)
+
+  use wrf_phdf5_data
+  use HDF5
+  implicit none
+  include 'wrf_status_codes.h'
+  integer                       ,intent(out)   :: Status
+  integer(hid_t)                ,intent(in)    :: h5_attr_typeid
+  integer(hid_t)                ,intent(in)    :: h5_space_typeid
+  integer(hid_t)                ,intent(in)    :: h5_attrid
+  integer                       ,intent(in)    :: str_flag
+  integer                                      :: hdf5err
+
+  if(str_flag == 1) then
+     call h5tclose_f(h5_attr_typeid,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+  endif
+
+  call h5sclose_f(h5_space_typeid,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+  call h5aclose_f(h5_attrid,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_ATTRIBUTE_CLOSE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+  Status = WRF_NO_ERR
+
+  return
+
+end subroutine clean_phdf5_attrids
+
+
+subroutine create_h5filetype(dtype_id,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  use hdf5
+  implicit none
+  include 'wrf_status_codes.h'   
+
+  integer(hid_t),intent(out)              :: dtype_id
+  integer(hid_t)                         :: dtstr_id
+  integer(size_t)                        :: type_size
+  integer(size_t)                        :: type_sizes
+  integer(size_t)                        :: type_sizei
+  integer(size_t)                        :: offset
+  integer,     intent(out)               :: Status
+  integer(hid_t)                         :: hdf5err
+
+  call h5tcopy_f(H5T_NATIVE_CHARACTER,dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+   endif
+
+  type_size = 80
+  call h5tset_size_f(dtstr_id,type_size,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+  call h5tget_size_f(dtstr_id,type_sizes,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+  call h5tget_size_f(H5T_NATIVE_INTEGER,type_sizei,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+  type_size = type_sizes + 2*type_sizei
+  call h5tcreate_f(H5T_COMPOUND_F,type_size,dtype_id,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+
+  offset = 0
+  call h5tinsert_f(dtype_id,"dim_name",offset,dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+   endif
+
+  offset = offset + type_sizes
+  call h5tinsert_f(dtype_id,"dim_length",offset,H5T_NATIVE_INTEGER,&
+       hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+  offset = offset + type_sizei
+
+  call h5tinsert_f(dtype_id,"dim_unlimited",offset,H5T_NATIVE_INTEGER,&
+       hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+
+  call h5tclose_f(dtstr_id,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_CLOSE_GENERAL
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+  Status = WRF_NO_ERR
+  return 
+end subroutine  create_h5filetype
+  
+! check whether two types are equal, attr_type and h5_attrid
+subroutine check_type(DataHandle,attr_type,h5_attrid,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+   integer               ,intent(in)     :: DataHandle
+   integer(hid_t)        ,intent(in)     :: attr_type
+   integer(hid_t)       ,intent(in)      :: h5_attrid
+   integer               ,intent(out)    :: Status
+   integer(hid_t)                        :: h5_atypeid
+   integer(hid_t)                        :: h5_classid
+   integer(hid_t)                        :: h5_wrfclassid
+   logical                               :: flag
+   integer                               :: hdf5err
+   type(wrf_phdf5_data_handle),pointer    :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call h5aget_type_f(h5_attrid,h5_atypeid,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+  call h5tget_class_f(h5_atypeid,h5_classid,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+  call h5tget_class_f(attr_type,h5_wrfclassid,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+  if((h5_classid==H5T_STRING_F).AND.&
+      (attr_type==H5T_NATIVE_CHARACTER)) then 
+     flag = .TRUE.
+  else 
+     if(h5_classid .NE. h5_wrfclassid) then
+	flag = .FALSE.
+     else
+	flag = .TRUE.
+     endif
+  endif
+
+  if(flag .EQV. .FALSE.) then
+     Status = WRF_HDF5_ERR_TYPE_MISMATCH
+     return 
+  endif
+
+  Status = WRF_NO_ERR
+  return
+end subroutine check_type
+
+ 
+subroutine retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,Count,OutCount,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+  
+  integer               ,intent(in)     :: DataHandle
+  integer               ,intent(in)     :: h5_attrid
+  integer(hid_t)        ,intent(out)    :: h5_atypeid
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  integer(hid_t)                        :: h5_aspaceid
+  integer                               :: hdf5err
+  integer                               :: rank
+  integer(hsize_t)                      :: npoints
+
+  type(wrf_phdf5_data_handle),pointer    :: DH
+ 
+  
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+  
+  if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+
+     call h5aget_type_f(h5_attrid,h5_atypeid,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+     call h5aget_space_f(h5_attrid,h5_aspaceid,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATASPACE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+     call h5sget_simple_extent_ndims_f(h5_aspaceid,rank,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATASPACE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+     endif
+
+     if(rank > 1) then
+        ! The rank can be either 0 or 1
+        Status = WRF_HDF5_ERR_OTHERS
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5sget_simple_extent_npoints_f(h5_aspaceid,npoints,hdf5err)
+     if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATASPACE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+     endif
+
+     OutCount = npoints
+     if(npoints > Count) then
+        OutCount = Count
+        Status = WRF_ERR_WARN_MORE_DATA_IN_FILE
+     else
+        OutCount = npoints
+     endif
+  endif
+  return
+end subroutine retrieve_ti_info
+
+subroutine setup_wrtd_dataset(DataHandle,DataSetName,dtypeid,countmd,&
+                              dsetid,dspace_id,fspace_id,tgroupid,   &
+			      TimeIndex,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: DataSetName
+  integer(hid_t)        ,intent(in)             :: dtypeid
+  integer               ,intent(in)             :: countmd
+  integer               ,intent(in)             :: TimeIndex
+
+  integer(hid_t)        ,intent(out)            :: dsetid
+  integer(hid_t)        ,intent(out)            :: dspace_id
+  integer(hid_t)        ,intent(out)            :: fspace_id
+  integer(hid_t)        ,intent(out)            :: tgroupid
+  integer(hid_t)                                :: crp_list
+  integer               ,intent(out)            :: Status
+
+  integer(hsize_t)      ,dimension(1)           :: sizes
+  integer(hsize_t)      ,dimension(1)           :: chunk_dims
+  integer(hsize_t)      ,dimension(1)           :: dims
+  integer(hsize_t)      ,dimension(1)           :: hdf5_maxdims
+  integer(hsize_t)      ,dimension(1)           :: offset
+  integer(hsize_t)      ,dimension(1)           :: count
+  type(wrf_phdf5_data_handle),pointer           :: DH
+
+  character(Len = MaxTimeSLen)                 :: tname
+  character(Len = 256)                         :: tgroupname                           
+  integer                                       :: hdf5err
+  
+
+  ! get datahandle
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+   
+ 
+  chunk_dims(1)   = countmd
+
+  dims(1)         = countmd
+
+  count(1)        = countmd
+
+  offset(1)       = 0
+
+  sizes(1)        = countmd
+
+  hdf5_maxdims(1) = countmd
+
+  ! create the memory space id
+  call h5screate_simple_f(1,dims,dspace_id,hdf5err,dims)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  ! create file space(for parallel module, each dataset per time step)
+  call h5screate_simple_f(1,dims,fspace_id,hdf5err,hdf5_maxdims)
+  if(hdf5err.lt.0) then        
+       Status =  WRF_HDF5_ERR_DATASPACE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+   endif
+
+  ! obtain the absolute name of the group where the dataset is located
+  call numtochar(TimeIndex,tname)
+  tgroupname = 'TIME_STAMP_'//tname
+  call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
+   
+   ! create dataset
+  call h5dcreate_f(tgroupid,DatasetName,H5T_NATIVE_REAL,fspace_id,&
+                    dsetid,hdf5err)
+   if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASET_CREATE 
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+        write(*,*) "cannot create an HDF5 dataset "
+        return
+   endif
+    
+   return
+ end subroutine setup_wrtd_dataset
+
+ subroutine extend_wrtd_dataset(DataHandle,TimeIndex,countmd,dsetid,dspaceid,&
+                                fspaceid,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  integer               ,intent(in)             :: countmd
+  integer               ,intent(in)             :: TimeIndex
+
+  integer(hid_t)        ,intent(out)            :: dsetid
+  integer(hid_t)        ,intent(out)            :: dspaceid
+  integer(hid_t)        ,intent(out)            :: fspaceid
+  integer               ,intent(out)            :: Status
+
+  integer(hsize_t)      ,dimension(2)           :: sizes
+  integer(hsize_t)      ,dimension(2)           :: chunk_dims
+  integer(hsize_t)      ,dimension(2)           :: dims
+  integer(hsize_t)      ,dimension(2)           :: hdf5_maxdims
+  integer(hsize_t)      ,dimension(2)           :: offset
+  integer(hsize_t)      ,dimension(2)           :: count
+
+  integer                                       :: hdf5err
+
+  sizes(1)    = countmd
+  sizes(2)    = TimeIndex
+  offset(1)   = 0
+  offset(2)   = TimeIndex - 1
+  count(1)    = countmd
+  count(2)    = 1
+  dims(1)     = countmd
+  dims(2)     = 1
+
+  ! extend the dataset
+  CALL h5dextend_f(dsetid,sizes,hdf5err)
+  if(hdf5err.lt.0) then
+       Status =  WRF_HDF5_ERR_DATASET_GENERAL
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+        write(*,*) "cannot extend an HDF5 dataset in index ",TimeIndex
+        return
+  endif
+
+  ! obtain file space id
+  CALL h5dget_space_f(dsetid,fspaceid,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATASPACE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+  
+  CALL h5sselect_hyperslab_f(fspaceid, H5S_SELECT_SET_F, &
+          			offset, count, hdf5err) 
+  if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASET_GENERAL
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+        write(*,*) "cannot select hyperslab"
+        return
+  endif
+  
+  ! create the memory space id
+  call h5screate_simple_f(2,dims,dspaceid,hdf5err,dims)
+  if(hdf5err.lt.0) then
+     Status =  WRF_HDF5_ERR_DATASPACE
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     write(*,*) "cannot create HDF5 memory data space"
+     return
+  endif
+
+  return
+end subroutine extend_wrtd_dataset
+
+subroutine setup_rdtd_dataset(DataHandle,DataSetName,mtypeid,TimeIndex,&
+			     countmd,outcountmd,dset_id,memspaceid,    &
+	                     dspace_id,tgroupid,Status)
+
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer               ,intent(in)             :: DataHandle
+  character*(*)         ,intent(in)             :: DataSetName
+  integer               ,intent(in)             :: countmd
+  integer               ,intent(out)            :: outcountmd
+  integer               ,intent(inout)          :: mtypeid
+  integer               ,intent(in)             :: TimeIndex
+
+  integer(hid_t)        ,intent(out)            :: dset_id
+  integer(hid_t)        ,intent(out)            :: dspace_id
+  integer(hid_t)        ,intent(out)            :: memspaceid
+  integer(hid_t)        ,intent(out)            :: tgroupid
+  integer               ,intent(out)            :: Status
+
+  integer(hid_t)                                :: dtype_id
+  integer(hid_t)                                :: class_type
+  integer(hsize_t)      ,dimension(1)           :: sizes
+  integer(hsize_t)      ,dimension(1)           :: dims
+  integer(hsize_t)      ,dimension(1)           :: h5_dims
+  integer(hsize_t)      ,dimension(1)           :: hdf5_maxdims
+  integer(hsize_t)      ,dimension(1)           :: offset
+  integer(hsize_t)      ,dimension(1)           :: count
+  integer                                       :: StoredDim
+  type(wrf_phdf5_data_handle),pointer            :: DH
+  
+  logical                                       :: flag
+  integer                                       :: hdf5err
+
+  character(Len = MaxTimeSLen)                 :: tname
+  character(Len = 256)                         :: tgroupname      
+  ! get datahandle
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  ! obtain the absolute name of the group where the dataset is located
+  call numtochar(TimeIndex,tname)
+  tgroupname = 'TIME_STAMP_'//tname
+  call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
+
+  ! Obtain HDF5 dataset id  
+  call h5dopen_f(tgroupid,DataSetName,dset_id,hdf5err)
+  if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASET_OPEN
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+  endif
+
+  ! Obtain the datatype
+   call h5dget_type_f(dset_id,dtype_id,hdf5err)
+   if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASET_GENERAL
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+   endif
+
+    call h5tget_class_f(dtype_id,class_type,hdf5err)
+    if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATATYPE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+    endif
+
+ 
+    if(mtypeid == H5T_NATIVE_REAL .or. mtypeid == H5T_NATIVE_DOUBLE) then
+       if( class_type /= H5T_FLOAT_F)  then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     else if(mtypeid ==H5T_NATIVE_CHARACTER) then
+        if(class_type /= H5T_STRING_F) then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     else if(mtypeid == H5T_NATIVE_INTEGER) then 
+        if(class_type /= H5T_INTEGER_F) then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     else if(mtypeid == DH%EnumID) then
+        if(class_type /= H5T_ENUM_F) then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+        call h5tequal_f(dtype_id,DH%EnumID,flag,hdf5err)
+        if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASET_OPEN
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+        if(flag .EQV. .FALSE.) then
+           Status = WRF_HDF5_ERR_TYPE_MISMATCH
+           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     else 
+        Status = WRF_HDF5_ERR_BAD_DATA_TYPE
+        write(msg,*)'Fatal Non-WRF supported TYPE in ',__FILE__,', line',__LINE__
+        call wrf_debug(FATAL, msg)
+        return
+     endif
+     ! update string id
+     if(mtypeid == H5T_NATIVE_CHARACTER) then
+ 	    mtypeid = dtype_id
+     endif
+
+     ! Obtain the dataspace
+     call h5dget_space_f(dset_id,dspace_id,hdf5err)
+     if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASPACE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+     endif
+
+     ! Obtain the rank of the dimension
+     call h5sget_simple_extent_ndims_f(dspace_id,StoredDim,hdf5err)
+     if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASPACE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+     endif
+
+ 
+     if(StoredDim /=1) then
+          Status = WRF_HDF5_ERR_DATASPACE
+          write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+          call wrf_debug ( WARN , msg) 
+          return
+     endif
+
+          
+     call h5sget_simple_extent_dims_f(dspace_id,h5_dims,hdf5_maxdims,hdf5err)
+     if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASPACE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+     endif
+
+     
+     if(countmd <= 0) then
+           Status = WRF_HDF5_ERR_ZERO_LENGTH_READ
+           write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+     endif
+     
+     if(countmd .lt. h5_dims(1)) then
+	outcountmd = countmd
+     else
+        outcountmd = h5_dims(1)
+     endif
+     
+     ! create memspace_id
+     dims(1) = outcountmd
+
+     call h5screate_simple_f(1,dims,memspaceid,hdf5err)
+     if(hdf5err.lt.0) then
+           Status = WRF_HDF5_ERR_DATASPACE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+     endif
+
+     offset(1) = 0
+     count(1)  = outcountmd
+
+     return
+end subroutine setup_rdtd_dataset
+
+subroutine make_strid(str_len,str_id,Status) 
+
+  use wrf_phdf5_data
+  USE HDF5 ! This module contains all necessary modules 
+  implicit none
+  include 'wrf_status_codes.h'
+
+  integer      ,intent(in)         :: str_len
+  integer(hid_t),intent(out)       :: str_id
+  integer       ,intent(out)       :: Status
+  integer(size_t)                  :: str_lensize
+  integer                          :: hdf5err
+
+  Status = WRF_NO_ERR
+  if(str_len <= 0) then
+    Status = WRF_HDF5_ERR_ATTRIBUTE_GENERAL
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , msg) 
+    return
+  endif
+
+  call h5tcopy_f(H5T_NATIVE_CHARACTER,str_id,hdf5err)
+  if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+  endif
+
+   str_lensize = str_len
+   call h5tset_size_f(str_id,str_lensize,hdf5err)
+   if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+   call h5tset_strpad_f(str_id,H5T_STR_SPACEPAD_F,hdf5err)
+    if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+end subroutine make_strid
Index: trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5support.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5support.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_phdf5/wrf-phdf5support.F90	(revision 2744)
@@ -0,0 +1,1395 @@
+!/***************************************************************************
+!* The HDF5 WRF IO module was written by the the HDF Group at NCSA, the     *
+!* National Center for Supercomputing Applications.                         *
+!*     HDF Group                                                            *
+!*     National Center for Supercomputing Applications                      *
+!*     University of Illinois at Urbana-Champaign                           *
+!*     605 E. Springfield, Champaign IL 61820                               *
+!*     http://hdf.ncsa.uiuc.edu/                                            *
+!*                                                                          *
+!* Copyright 2004 by the Board of Trustees, University of Illinois,         *
+!*                                                                          *
+!* Redistribution or use of this IO module, with or without modification,   *
+!* is permitted for any purpose, including commercial  purposes.            *
+!*                                                                          *
+!* This software is an unsupported prototype.  Use at your own risk.        *
+!*     http://hdf.ncsa.uiuc.edu/apps/WRF-ROMS                               *
+!*                                                                          *
+!* This work was funded by the MEAD expedition at the National Center       *
+!* for Supercomputing Applications, NCSA.  For more information see:        *
+!*     http://www.ncsa.uiuc.edu/expeditions/MEAD                            *
+!*                                                                          *
+!*                                                                          *
+!****************************************************************************/
+
+module wrf_phdf5_data
+
+  use HDF5
+  integer                , parameter      :: FATAL            = 1
+  integer                , parameter      :: WARN             = 1
+  integer                , parameter      :: WrfDataHandleMax = 99
+  integer                , parameter      :: MaxDims          = 2000 ! = NF_MAX_VARS
+  integer                , parameter      :: MaxTabDims       = 100  ! temporary,changable
+  integer                , parameter      :: MaxVars          = 2000
+  integer                , parameter      :: MaxTimes         = 9999 ! temporary, changable
+  integer                , parameter      :: MaxTimeSLen      = 6    ! not exceed 1,000,000 timestamp
+  integer                , parameter      :: DateStrLen       = 19
+  integer                , parameter      :: VarNameLen       = 31
+  integer                , parameter      :: NO_DIM           = 0
+  integer                , parameter      :: NVarDims         = 4
+  integer                , parameter      :: NMDVarDims       = 2
+  integer                , parameter      :: CompDsetSize     = 64256 ! set to 63K
+  character (8)          , parameter      :: NO_NAME          = 'NULL'
+  character(4)           , parameter      :: hdf5_true        ='TRUE'
+  character(5)           , parameter      :: hdf5_false       ='FALSE'
+  integer                , parameter      :: MemOrdLen        = 3
+  character (DateStrLen) , parameter      :: ZeroDate = '0000-00-00-00:00:00'
+
+#include "wrf_io_flags.h"
+! This is a hack.  WRF IOAPI no longer supports WRF_CHARACTER.  Rip this out!  
+  integer, parameter  :: WRF_CHARACTER                        = 1080
+
+  character (120)                         :: msg
+
+  ! derived data type for dimensional table
+  type :: dim_scale
+     character (len = 256) :: dim_name
+     integer              :: length
+     integer              :: unlimited
+  end type dim_scale
+
+  type :: wrf_phdf5_data_handle
+     character (256)                        :: FileName
+     integer                               :: FileStatus
+     integer                               :: Comm
+     integer(hid_t)                        :: FileID
+     integer(hid_t)                        :: GroupID
+     integer(hid_t)                        :: DimGroupID
+     integer(hid_t)                        :: EnumID
+     character (256)                       :: GroupName 
+     character (256)                       :: DimGroupName 
+     logical                               :: Free
+     logical                               :: Write
+     character (5)                         :: TimesName
+     integer                               :: TimeIndex
+     integer                               :: MaxTimeCount
+     integer                               :: CurrentTime  !Only used for read
+     integer                               :: NumberTimes  !Only used for read
+     character (DateStrLen), pointer       :: Times(:)
+     integer(hid_t)                        :: TimesID
+     integer(hid_t)                        :: str_id
+     integer               , pointer       :: DimLengths(:)
+     integer               , pointer       :: DimIDs(:)
+     character (31)        , pointer       :: DimNames(:)
+     integer                               :: DimUnlimID
+     character (9)                         :: DimUnlimName
+     type (dim_scale)      , pointer       :: DIMTABLE(:)
+     integer       , dimension(NVarDims)   :: DimID
+     integer       , dimension(NVarDims)   :: Dimension
+     !     integer               , pointer       :: MDDsetIDs(:)
+     integer               , pointer       :: MDVarDimLens(:)
+     character (256)        , pointer       :: MDVarNames(:)
+     integer(hid_t)        , pointer       :: TgroupIDs(:)
+     integer(hid_t)        , pointer       :: DsetIDs(:)
+     integer(hid_t)        , pointer       :: MDDsetIDs(:)
+     !     integer(hid_t)                        :: DimTableID
+     integer               , pointer       :: VarDimLens(:,:)
+     character (VarNameLen), pointer       :: VarNames(:)
+     integer                               :: CurrentVariable  !Only used for read
+     integer                               :: NumVars
+! first_operation is set to .TRUE. when a new handle is allocated
+! or when open-for-write or open-for-read are committed.  It is set
+! to .FALSE. when the first field is read or written.
+     logical                               :: first_operation
+  end type wrf_phdf5_data_handle
+  type(wrf_phdf5_data_handle),target        :: WrfDataHandles(WrfDataHandleMax)
+
+end module wrf_phdf5_data
+
+
+module ext_phdf5_support_routines
+
+  implicit none
+
+CONTAINS
+
+  subroutine allocHandle(DataHandle,DH,Comm,Status)
+
+    use wrf_phdf5_data
+    use HDF5
+    include 'wrf_status_codes.h'
+
+    integer              ,intent(out) :: DataHandle
+    type(wrf_phdf5_data_handle),pointer:: DH
+    integer              ,intent(IN)  :: Comm
+    integer              ,intent(out) :: Status
+    integer                           :: i
+    integer                           :: j
+    integer                           :: stat
+    integer(hid_t)                    :: enum_type  
+    !    character (256)                    :: NullName
+
+    !    NullName = char(0)
+
+    do i=1,WrfDataHandleMax
+       if(WrfDataHandles(i)%Free) then
+          DH => WrfDataHandles(i)
+          DataHandle = i
+          DH%MaxTimeCount = 1
+
+          DH%FileID = -1
+          DH%GroupID = -1
+          DH%DimGroupID = -1
+
+          call SetUp_EnumID(enum_type,Status)
+          if(Status /= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal enum ALLOCATION ERROR in ',__FILE__,', line',__LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+          DH%EnumID = enum_type
+
+          allocate(DH%Times(MaxTimes), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line',__LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+          ! wait in the future
+          !          DH%Times(1:MaxTimes) = NullName
+
+          allocate(DH%DimLengths(MaxDims), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line',__LINE__
+
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+
+          allocate(DH%DimIDs(MaxDims), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+
+          allocate(DH%DimNames(MaxDims), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+
+          allocate(DH%DIMTABLE(MaxTabDims), STAT = stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+
+          do j =1,MaxTabDims
+             DH%DIMTABLE(j)%dim_name = NO_NAME
+             DH%DIMTABLE(j)%unlimited = -1
+          enddo
+
+          allocate(DH%MDDsetIDs(MaxVars), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+
+          allocate(DH%MDVarDimLens(MaxVars), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+
+          allocate(DH%MDVarNames(MaxVars), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+
+          allocate(DH%DsetIDs(MaxVars), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+          DH%DsetIDs = -1
+
+          allocate(DH%TgroupIDs(MaxTimes), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+          DH%TgroupIDs = -1
+
+          allocate(DH%VarDimLens(NVarDims-1,MaxVars), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+
+          allocate(DH%VarNames(MaxVars), STAT=stat)
+          if(stat/= 0) then
+             Status = WRF_HDF5_ERR_ALLOCATION
+             write(msg,*) 'Fatal ALLOCATION ERROR in ',"__FILE__",', line', __LINE__
+             call wrf_debug ( FATAL , msg)
+             return
+          endif
+          exit
+       endif
+
+       if(i==WrfDataHandleMax) then
+          Status = WRF_HDF5_ERR_TOO_MANY_FILES
+          write(msg,*) 'Warning TOO MANY FILES in ',"__FILE__",', line', __LINE__
+          call wrf_debug ( WARN , msg)
+          return
+       endif
+    enddo
+
+
+    DH%Free      =.false.
+    DH%Comm      = Comm
+    DH%Write     =.false.
+    DH%first_operation  = .TRUE.
+    Status       = WRF_NO_ERR
+  end subroutine allocHandle
+
+  ! Obtain data handler
+  subroutine GetDH(DataHandle,DH,Status)
+
+    use wrf_phdf5_data
+    include 'wrf_status_codes.h'
+    integer               ,intent(in)          :: DataHandle
+    type(wrf_phdf5_data_handle) ,pointer        :: DH
+    integer               ,intent(out)         :: Status
+
+    if(DataHandle < 1 .or. DataHandle > WrfDataHandleMax) then
+       Status = WRF_HDF5_ERR_BAD_DATA_HANDLE
+       return
+    endif
+    DH => WrfDataHandles(DataHandle)
+    if(DH%Free) then
+       Status = WRF_HDF5_ERR_BAD_DATA_HANDLE
+       return
+    endif
+    Status = WRF_NO_ERR
+    return
+  end subroutine GetDH
+
+  ! Set up eumerate datatype for possible logical type
+  subroutine SetUp_EnumID(enum_type,Status)
+
+    use wrf_phdf5_data
+    use HDF5
+    implicit none
+    include 'wrf_status_codes.h'
+    integer(hid_t)              ,intent(out)  :: enum_type
+    integer                     ,intent(out)  :: Status
+    integer                                   :: hdf5err
+    integer, dimension(2)                     :: data
+
+    data(1) = 1
+    data(2) = 0
+
+    call h5tenum_create_f(H5T_NATIVE_INTEGER,enum_type,hdf5err)
+    if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+    call h5tenum_insert_f(enum_type,hdf5_true,data(1),hdf5err)
+    if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+    call h5tenum_insert_f(enum_type,hdf5_false,data(2),Status)
+    if(hdf5err.lt.0) then 
+       Status =  WRF_HDF5_ERR_DATATYPE
+       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+       call wrf_debug ( WARN , msg) 
+       return
+    endif
+
+    Status = WRF_NO_ERR
+    return
+  end subroutine SetUp_EnumID
+
+! Returns .TRUE. iff it is OK to write time-independent domain metadata to the
+! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is
+! returned.
+LOGICAL FUNCTION phdf5_ok_to_put_dom_ti( DataHandle )
+    use wrf_phdf5_data
+    include 'wrf_status_codes.h'
+    INTEGER, INTENT(IN) :: DataHandle
+    CHARACTER*80 :: fname
+    INTEGER :: filestate
+    INTEGER :: Status
+    LOGICAL :: dryrun, first_output, retval
+    call ext_phdf5_inquire_filename( DataHandle, fname, filestate, Status )
+    IF ( Status /= WRF_NO_ERR ) THEN
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+                   ', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg) )
+      retval = .FALSE.
+    ELSE
+      dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+      first_output = phdf5_is_first_operation( DataHandle )
+      retval = .NOT. dryrun .AND. first_output
+    ENDIF
+    phdf5_ok_to_put_dom_ti = retval
+    RETURN
+END FUNCTION phdf5_ok_to_put_dom_ti
+
+! Returns .TRUE. iff it is OK to read time-independent domain metadata from the
+! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is
+! returned.
+LOGICAL FUNCTION phdf5_ok_to_get_dom_ti( DataHandle )
+    use wrf_phdf5_data
+    include 'wrf_status_codes.h'
+    INTEGER, INTENT(IN) :: DataHandle
+    CHARACTER*80 :: fname
+    INTEGER :: filestate
+    INTEGER :: Status
+    LOGICAL :: dryrun, retval
+    call ext_phdf5_inquire_filename( DataHandle, fname, filestate, Status )
+    IF ( Status /= WRF_NO_ERR ) THEN
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+                   ', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg) )
+      retval = .FALSE.
+    ELSE
+      dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+      retval = .NOT. dryrun
+    ENDIF
+    phdf5_ok_to_get_dom_ti = retval
+    RETURN
+END FUNCTION phdf5_ok_to_get_dom_ti
+
+! Returns .TRUE. iff nothing has been read from or written to the file
+! referenced by DataHandle.  If DataHandle is invalid, .FALSE. is returned.
+LOGICAL FUNCTION phdf5_is_first_operation( DataHandle )
+    use wrf_phdf5_data
+    INCLUDE 'wrf_status_codes.h'
+    INTEGER, INTENT(IN) :: DataHandle
+    TYPE(wrf_phdf5_data_handle) ,POINTER :: DH
+    INTEGER :: Status
+    LOGICAL :: retval
+    CALL GetDH( DataHandle, DH, Status )
+    IF ( Status /= WRF_NO_ERR ) THEN
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+                   ', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg) )
+      retval = .FALSE.
+    ELSE
+      retval = DH%first_operation
+    ENDIF
+    phdf5_is_first_operation = retval
+    RETURN
+END FUNCTION phdf5_is_first_operation
+
+end module ext_phdf5_support_routines
+
+!module wrf_phdf5_opt_data
+!  integer       ,parameter  :: MaxOptVars = 100
+!end module wrf_phdf5_opt_data
+
+!module opt_data_module
+
+!use wrf_phdf5_opt_data
+!   type :: field
+
+!	logical         :: Free
+!	integer,pointer :: darrays(:)
+!	integer         :: index
+!   end type field
+!   type(field),target :: fieldhandle(MaxOptVars)
+!end module opt_data_module
+
+!module opt_support_module
+!   implicit none
+!contains
+!   subroutine alloc_opt_handle(ODH)
+!   use opt_data_module
+!   type(field),pointer::DH
+!   integer            :: i
+
+!   do i =1,MaxOptVars
+!	DH=>fieldhandle(i)
+!        DH%index = 0
+!   enddo
+!end module opt_support_module
+
+! check the date, only use the length 
+subroutine DateCheck(Date,Status)
+  use wrf_phdf5_data
+  include 'wrf_status_codes.h'
+  character*(*) ,intent(in)      :: Date
+  integer       ,intent(out)     :: Status
+
+  if(len(Date) /= DateStrLen) then
+     Status = WRF_HDF5_ERR_DATESTR_BAD_LENGTH
+  else  
+     Status = WRF_NO_ERR
+  endif
+  return
+end subroutine DateCheck
+
+! This routine is for meta-data time dependent varible attribute 
+subroutine GetName(Element,Var,Name,Status)
+
+  use wrf_phdf5_data
+  include 'wrf_status_codes.h'
+  character*(*) ,intent(in)     :: Element
+  character*(*) ,intent(in)     :: Var
+  character*(*) ,intent(out)    :: Name
+  integer       ,intent(out)    :: Status
+  character (VarNameLen)        :: VarName
+  character (1)                 :: c
+  integer                       :: i
+  integer, parameter            ::  upper_to_lower =IACHAR('a')-IACHAR('A')
+
+  VarName = Var
+  Name = 'MD___'//trim(Element)//VarName
+  do i=1,len(Name)
+     c=Name(i:i)
+     if('A'<=c .and. c <='Z') Name(i:i)=achar(iachar(c)+upper_to_lower)
+     if(c=='-'.or.c==':') Name(i:i)='_'
+  enddo
+  Status = WRF_NO_ERR
+  return
+end subroutine GetName
+
+! Obtain TimeIndex 
+subroutine GetDataTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status)
+
+  use HDF5
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+
+  implicit none
+  include 'wrf_status_codes.h'
+
+  character (*)         ,intent(in)          :: IO
+  integer               ,intent(in)          :: DataHandle
+  character*(*)         ,intent(in)          :: DateStr
+  character (DateStrLen), pointer            :: TempTimes(:)
+  integer               ,intent(out)         :: TimeIndex
+  integer               ,intent(out)         :: Status
+
+  type(wrf_phdf5_data_handle) ,pointer        :: DH
+  integer                                    :: VStart(2)
+  integer                                    :: VCount(2)
+  integer                                    :: stat
+  integer                                    :: i
+  integer                                    :: PreTimeCount
+
+  integer                                    :: rank
+  integer(hsize_t), dimension(1)             :: chunk_dims =(/1/)
+  integer(hsize_t), dimension(1)             :: dims
+  integer(hsize_t), dimension(1)             :: hdf5_maxdims
+  integer(hsize_t), dimension(1)             :: offset
+  integer(hsize_t), dimension(1)             :: count
+  integer(hsize_t), dimension(1)             :: sizes
+
+  INTEGER(HID_T)                             :: dset_id   ! Dataset ID 
+  INTEGER(HID_T)                             :: dspace_id ! Dataspace ID
+  INTEGER(HID_T)                             :: fspace_id ! Dataspace ID
+  INTEGER(HID_T)                             :: crp_list  ! chunk ID
+  integer(hid_t)                             :: str_id    ! string ID
+  integer                                    :: hdf5err
+
+  integer(hid_t)                             :: group_id
+  character(Len = 512)                       :: groupname
+
+  ! for debug
+
+  character(len=100)                        :: buf
+  integer(size_t)                            :: name_size
+  integer(size_t)                            :: datelen_size
+  ! suppose the output will not exceed 100,0000 timesteps.
+  character(Len = MaxTimeSLen)               :: tname
+
+
+  !  DH => WrfDataHandles(DataHandle), don't know why NetCDF doesn't use GetDH
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     Status =  WRF_HDF5_ERR_DATESTR_ERROR
+     write(msg,*) 'Warning DATE STRING ERROR in ',"__FILE__",', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(IO == 'write') then
+     TimeIndex = DH%TimeIndex
+     if(TimeIndex <= 0) then
+        TimeIndex = 1
+     elseif(DateStr < DH%Times(TimeIndex)) then
+        Status = WRF_HDF5_ERR_DATE_LT_LAST_DATE
+        write(msg,*) 'Warning DATE < LAST DATE in ',"__FILE__",', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+     elseif(DateStr == DH%Times(TimeIndex)) then
+        Status = WRF_NO_ERR
+        return
+     else
+        TimeIndex = TimeIndex + 1
+        !       If exceeding the maximum timestep, updating the maximum timestep
+        if(TimeIndex > MaxTimes*(DH%MaxTimeCount)) then
+           PreTimeCount = DH%MaxTimeCount
+           allocate(TempTimes(PreTimeCount*MaxTimes))
+           TempTimes(1:MaxTimes*PreTimeCount)=DH%Times(1:MaxTimes &
+                *PreTimeCount)
+           DH%MaxTimeCount = DH%MaxTimeCount +1
+           deallocate(DH%Times)
+           allocate(DH%Times(DH%MaxTimeCount*MaxTimes))
+           DH%Times(1:MaxTimes*PreTimeCount)=TempTimes(1:MaxTimes &
+                *PreTimeCount)
+           deallocate(TempTimes)
+        endif
+     endif
+     DH%TimeIndex        = TimeIndex
+     DH%Times(TimeIndex) = DateStr
+     !    From NetCDF implementation, keep it in case it can be used.
+     !     VStart(1) = 1
+     !     VStart(2) = TimeIndex
+     !     VCount(1) = DateStrLen
+     !     VCount(2) = 1
+
+     ! create memory dataspace id and file dataspace id
+     dims(1)   = 1
+     count(1)  = 1
+     offset(1) = TimeIndex -1
+     sizes(1)  = TimeIndex
+
+     ! create group id for different time stamp
+     call numtochar(TimeIndex,tname)
+     groupname = 'TIME_STAMP_'//tname
+!     call h5gn_members_f(DH%GroupID,DH%GroupName,nmembers,hdf5err)
+!     do i = 0, nmembers - 1
+!        call h5gget_obj_info_idx_f(DH%GroupID,DH%GroupName,i,ObjName, ObjType, &
+!                                   hdf5err)
+        
+!        if(ObjName(1:17) == groupname) then
+!          call h5gopen_f(DH%GroupID,groupname,tgroupid,hdf5err)
+!          exit
+!        endif
+!     enddo 
+           
+     if(DH%Tgroupids(TimeIndex) == -1) then 
+       call h5gcreate_f(DH%groupid,groupname,group_id,hdf5err)
+       if(hdf5err .lt. 0) then
+        Status = WRF_HDF5_ERR_GROUP
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+       endif
+       DH%Tgroupids(TimeIndex) = group_id
+     else
+!        call h5gopen_f(DH%groupid,groupname,group_id,
+       group_id = DH%Tgroupids(TimeIndex) 
+     endif
+
+     call h5screate_simple_f(1,dims,dspace_id,hdf5err,dims)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+
+     ! create HDF5 string handler for time 
+     if(TimeIndex == 1) then
+        call h5tcopy_f(H5T_NATIVE_CHARACTER, str_id, hdf5err)
+        if(hdf5err.lt.0) then 
+           Status =  WRF_HDF5_ERR_DATATYPE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        datelen_size = DateStrLen
+        call h5tset_size_f(str_id,datelen_size,hdf5err)
+        if(hdf5err.lt.0) then 
+           Status =  WRF_HDF5_ERR_DATATYPE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+     else 
+        str_id = DH%str_id
+     endif
+
+     call h5dcreate_f(group_id,DH%TimesName,str_id,dspace_id,&
+          DH%TimesID, hdf5err)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASET_CREATE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+
+     ! write the data in memory space to file space
+     CALL h5dwrite_f(DH%TimesID,str_id,DateStr,dims,hdf5err,dspace_id,dspace_id)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     if(TimeIndex == 1) then
+        DH%str_id = str_id
+     endif
+
+
+     call h5sclose_f(dspace_id,hdf5err)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5dclose_f(DH%TimesID,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+  else
+     ! This is for IO read
+     ! Find the timeIndex(very expensive for large
+     ! time stamp, should use hashing table)
+
+     do i=1,MaxTimes*DH%MaxTimeCount
+
+        !       For handling reading maximum timestamp greater than 9000 in the future        
+        !        if(DH%Times(i) == NullName) then
+        !           Status = WRF_HDF5_ERR_TIME
+        !           write(msg,*) 'Warning TIME ',DateStr,' NOT FOUND in ',"__FILE__",&
+        !               ', line', __LINE__
+        !           call wrf_debug ( WARN , msg)
+        !           return
+        !        endif
+
+        if(DH%Times(i) == DateStr) then
+           Status = WRF_NO_ERR
+           TimeIndex = i
+           exit
+        endif
+
+        ! Need a recursive function to handle this
+        ! This is a potential bug 
+        if(i == MaxTimes*DH%MaxTimeCount) then
+           !           PreTimeCount = DH%MaxTimeCount
+           !           allocate(TempTimes(PreTimeCount*MaxTimes))
+           !           TempTimes(1:MaxTimes*PreTimeCount)=DH%Times(1:MaxTimes &
+           !                *PreTimeCount)
+           !           DH%MaxTimeCount = DH%MaxTimeCount +1
+           !           deallocate(DH%Times)
+           !           allocate(DH%Times(DH%MaxTimeCount*MaxTimes))
+           !           DH%Times(1:MaxTimes*PreTimeCount)=TempTimes(1:MaxTimes &
+           !                *PreTimeCount)
+           !           deallocate(TempTimes)
+           Status = WRF_HDF5_ERR_TIME
+           write(msg,*) 'Warning TIME ',DateStr,' NOT FOUND in ',"__FILE__",&
+                ', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     enddo
+
+     ! do the hyperslab selection
+
+  endif
+  return
+end subroutine GetDataTimeIndex
+
+subroutine GetAttrTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status)
+
+  use HDF5
+  use wrf_phdf5_data
+  use ext_phdf5_support_routines
+
+  implicit none
+  include 'wrf_status_codes.h'
+
+  character (*)         ,intent(in)          :: IO
+  integer               ,intent(in)          :: DataHandle
+  character*(*)         ,intent(in)          :: DateStr
+  character (DateStrLen), pointer            :: TempTimes(:)
+  integer               ,intent(out)         :: TimeIndex
+  integer               ,intent(out)         :: Status
+
+  type(wrf_phdf5_data_handle) ,pointer        :: DH
+  integer                                    :: VStart(2)
+  integer                                    :: VCount(2)
+  integer                                    :: stat
+  integer                                    :: i
+  integer                                    :: PreTimeCount
+
+  integer                                    :: rank
+  integer(hsize_t), dimension(1)             :: chunk_dims =(/1/)
+  integer(hsize_t), dimension(1)             :: dims
+  integer(hsize_t), dimension(1)             :: hdf5_maxdims
+  integer(hsize_t), dimension(1)             :: offset
+  integer(hsize_t), dimension(1)             :: count
+  integer(hsize_t), dimension(1)             :: sizes
+
+  INTEGER(HID_T)                             :: dset_id   ! Dataset ID 
+  INTEGER(HID_T)                             :: dspace_id ! Dataspace ID
+  INTEGER(HID_T)                             :: fspace_id ! Dataspace ID
+  INTEGER(HID_T)                             :: crp_list  ! chunk ID
+  integer(hid_t)                             :: str_id    ! string ID
+  integer                                    :: hdf5err
+
+  integer(size_t)                            :: datelen_size
+  integer(hid_t)                             :: group_id
+  character(Len = 512)                       :: groupname
+
+  ! suppose the output will not exceed 100,0000 timesteps. 
+  character(Len = MaxTimeSLen)               :: tname  
+
+  !  DH => WrfDataHandles(DataHandle), don't know why NetCDF doesn't use GetDH
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+     call wrf_debug ( WARN , msg) 
+     return
+  endif
+
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+     Status =  WRF_HDF5_ERR_DATESTR_ERROR
+     write(msg,*) 'Warning DATE STRING ERROR in ',"__FILE__",', line', __LINE__
+     call wrf_debug ( WARN , msg)
+     return
+  endif
+
+  if(IO == 'write') then
+     TimeIndex = DH%TimeIndex
+     if(TimeIndex <= 0) then
+        TimeIndex = 1
+     elseif(DateStr < DH%Times(TimeIndex)) then
+        Status = WRF_HDF5_ERR_DATE_LT_LAST_DATE
+        write(msg,*) 'Warning DATE < LAST DATE in ',"__FILE__",', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+     elseif(DateStr == DH%Times(TimeIndex)) then
+        Status = WRF_NO_ERR
+        return
+     else
+        TimeIndex = TimeIndex + 1
+        !       If exceeding the maximum timestep, updating the maximum timestep
+        if(TimeIndex > MaxTimes*(DH%MaxTimeCount)) then
+           PreTimeCount = DH%MaxTimeCount
+           allocate(TempTimes(PreTimeCount*MaxTimes))
+           TempTimes(1:MaxTimes*PreTimeCount)=DH%Times(1:MaxTimes &
+                *PreTimeCount)
+           DH%MaxTimeCount = DH%MaxTimeCount +1
+           deallocate(DH%Times)
+           allocate(DH%Times(DH%MaxTimeCount*MaxTimes))
+           DH%Times(1:MaxTimes*PreTimeCount)=TempTimes(1:MaxTimes &
+                *PreTimeCount)
+           deallocate(TempTimes)
+        endif
+     endif
+     DH%TimeIndex        = TimeIndex
+     DH%Times(TimeIndex) = DateStr
+
+     !    From NetCDF implementation, keep it in case it can be used.
+     !     VStart(1) = 1
+     !     VStart(2) = TimeIndex
+     !     VCount(1) = DateStrLen
+     !     VCount(2) = 1
+
+     ! create memory dataspace id and file dataspace id
+     dims(1)   = 1
+     count(1)  = 1
+     offset(1) = TimeIndex -1
+     sizes(1)  = TimeIndex
+
+     ! create group id for different time stamp
+     call numtochar(TimeIndex,tname)
+     groupname = 'TIME_STAMP_'//tname
+           
+     if(DH%Tgroupids(TimeIndex) == -1) then 
+       call h5gcreate_f(DH%groupid,groupname,group_id,hdf5err)
+       if(hdf5err .lt. 0) then
+        Status = WRF_HDF5_ERR_GROUP
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+       endif
+       DH%Tgroupids(TimeIndex) = group_id
+     else
+!        call h5gopen_f(DH%groupid,groupname,group_id,
+       group_id = DH%Tgroupids(TimeIndex) 
+     endif
+
+     call h5screate_simple_f(1,dims,dspace_id,hdf5err,dims)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+
+     ! create HDF5 string handler for time 
+     if(TimeIndex == 1) then
+        call h5tcopy_f(H5T_NATIVE_CHARACTER, str_id, hdf5err)
+        if(hdf5err.lt.0) then 
+           Status =  WRF_HDF5_ERR_DATATYPE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+
+        datelen_size = DateStrLen
+        call h5tset_size_f(str_id,datelen_size,hdf5err)
+        if(hdf5err.lt.0) then 
+           Status =  WRF_HDF5_ERR_DATATYPE
+           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+           call wrf_debug ( WARN , msg) 
+           return
+        endif
+     else 
+        str_id = DH%str_id
+     endif
+
+     call h5dcreate_f(group_id,DH%TimesName,str_id,dspace_id,&
+          DH%TimesID, hdf5err)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASET_CREATE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+
+     ! write the data in memory space to file space
+     CALL h5dwrite_f(DH%TimesID,str_id,DateStr,dims,hdf5err,dspace_id,dspace_id)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASET_WRITE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     if(TimeIndex == 1) then
+        DH%str_id = str_id
+     endif
+
+
+     call h5sclose_f(dspace_id,hdf5err)
+     if(hdf5err.lt.0) then
+        Status =  WRF_HDF5_ERR_DATASPACE
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+     call h5dclose_f(DH%TimesID,hdf5err)
+     if(hdf5err.lt.0) then
+        Status = WRF_HDF5_ERR_DATASET_GENERAL
+        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , msg) 
+        return
+     endif
+
+  else
+     ! This is for IO read
+     ! Find the timeIndex(very expensive for large
+     ! time stamp, should use hashing table)
+
+     do i=1,MaxTimes*DH%MaxTimeCount
+
+
+        if(DH%Times(i) == DateStr) then
+           Status = WRF_NO_ERR
+           TimeIndex = i
+           exit
+        endif
+
+        ! Need a recursive function to handle this
+        ! This is a potential bug 
+        if(i == MaxTimes*DH%MaxTimeCount) then
+           Status = WRF_HDF5_ERR_TIME
+           write(msg,*) 'Warning TIME ',DateStr,' NOT FOUND in ',"__FILE__",&
+                ', line', __LINE__
+           call wrf_debug ( WARN , msg)
+           return
+        endif
+     enddo
+
+     ! do the hyperslab selection
+
+  endif
+  return
+end subroutine GetAttrTimeIndex
+
+
+! Obtain the rank of the dimension
+subroutine GetDim(MemoryOrder,NDim,Status)
+
+  include 'wrf_status_codes.h'
+  character*(*) ,intent(in)  :: MemoryOrder
+  integer       ,intent(out) :: NDim
+  integer       ,intent(out) :: Status
+  character*3                :: MemOrd
+
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+  case ('xyz','xzy','yxz','yzx','zxy','zyx','xsz','xez','ysz','yez')
+     NDim = 3
+  case ('xy','yx','xs','xe','ys','ye')
+     NDim = 2
+  case ('z','c','0')
+     NDim = 1
+  case default
+     Status = WRF_HDF5_ERR_BAD_MEMORYORDER
+     return
+  end select
+  Status = WRF_NO_ERR
+  return
+end subroutine GetDim
+
+! Obtain the index for transposing
+subroutine GetIndices(NDim,Start,End,i1,i2,j1,j2,k1,k2)
+  integer              ,intent(in)  :: NDim
+  integer ,dimension(*),intent(in)  :: Start,End
+  integer              ,intent(out) :: i1,i2,j1,j2,k1,k2
+
+  i1=1
+  i2=1
+  j1=1
+  j2=1
+  k1=1
+  k2=1
+  i1 = Start(1)
+  i2 = End  (1)
+  if(NDim == 1) return
+  j1 = Start(2)
+  j2 = End  (2)
+  if(NDim == 2) return
+  k1 = Start(3)
+  k2 = End  (3)
+  return
+end subroutine GetIndices
+
+! shuffling the memory order to XYZ order
+subroutine ExtOrder(MemoryOrder,Vector,Status)
+  use wrf_phdf5_data
+  include 'wrf_status_codes.h'
+  character*(*)              ,intent(in)    :: MemoryOrder
+  integer,dimension(*)       ,intent(inout) :: Vector
+  integer                    ,intent(out)   :: Status
+  integer                                   :: NDim
+  integer,dimension(NVarDims)               :: temp
+  character*3                               :: MemOrd
+
+  call GetDim(MemoryOrder,NDim,Status)
+  temp(1:NDim) = Vector(1:NDim)
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+
+  case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c')
+     continue
+  case ('0')
+     Vector(1) = 1
+  case ('xzy')
+     Vector(2) = temp(3)
+     Vector(3) = temp(2)
+  case ('yxz')
+     Vector(1) = temp(2)
+     Vector(2) = temp(1)
+  case ('yzx')
+     Vector(1) = temp(3)
+     Vector(2) = temp(1)
+     Vector(3) = temp(2)
+  case ('zxy')
+     Vector(1) = temp(2)
+     Vector(2) = temp(3)
+     Vector(3) = temp(1)
+  case ('zyx')
+     Vector(1) = temp(3)
+     Vector(3) = temp(1)
+  case ('yx')
+     Vector(1) = temp(2)
+     Vector(2) = temp(1)
+  case default
+     Status = WRF_HDF5_ERR_BAD_MEMORYORDER
+     return
+  end select
+  Status = WRF_NO_ERR
+  return
+end subroutine ExtOrder
+
+! shuffling the dimensional name order
+subroutine ExtOrderStr(MemoryOrder,Vector,ROVector,Status)
+  use wrf_phdf5_data
+  include 'wrf_status_codes.h'
+  character*(*)                    ,intent(in)    :: MemoryOrder
+  character*(*),dimension(*)       ,intent(in)    :: Vector
+  character(256),dimension(NVarDims),intent(out)   :: ROVector
+  integer                          ,intent(out)   :: Status
+  integer                                         :: NDim
+  character*3                                     :: MemOrd
+
+  call GetDim(MemoryOrder,NDim,Status)
+  ROVector(1:NDim) = Vector(1:NDim)
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+
+  case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c')
+     continue
+  case ('0')
+     ROVector(1) = 'ext_scalar'
+  case ('xzy')
+     ROVector(2) = Vector(3)
+     ROVector(3) = Vector(2)
+  case ('yxz')
+     ROVector(1) = Vector(2)
+     ROVector(2) = Vector(1)
+  case ('yzx')
+     ROVector(1) = Vector(3)
+     ROVector(2) = Vector(1)
+     ROVector(3) = Vector(2)
+  case ('zxy')
+     ROVector(1) = Vector(2)
+     ROVector(2) = Vector(3)
+     ROVector(3) = Vector(1)
+  case ('zyx')
+     ROVector(1) = Vector(3)
+     ROVector(3) = Vector(1)
+  case ('yx')
+     ROVector(1) = Vector(2)
+     ROVector(2) = Vector(1)
+  case default
+     Status = WRF_HDF5_ERR_BAD_MEMORYORDER
+     return
+  end select
+  Status = WRF_NO_ERR
+  return
+end subroutine ExtOrderStr
+
+
+subroutine LowerCase(MemoryOrder,MemOrd)
+  character*(*) ,intent(in)  :: MemoryOrder
+  character*(*) ,intent(out) :: MemOrd
+  character*3                :: c
+  integer       ,parameter   :: upper_to_lower =IACHAR('a')-IACHAR('A')
+  integer                    :: i,N
+
+  MemOrd = ' '
+  N = len(MemoryOrder)
+  MemOrd(1:N) = MemoryOrder(1:N)
+  do i=1,N
+     c = MemoryOrder(i:i)
+     if('A'<=c .and. c <='Z') MemOrd(i:i)=achar(iachar(c)+upper_to_lower)
+  enddo
+  return
+end subroutine LowerCase
+
+subroutine UpperCase(MemoryOrder,MemOrd)
+  character*(*) ,intent(in)  :: MemoryOrder
+  character*(*) ,intent(out) :: MemOrd
+  character*3                :: c
+  integer     ,parameter     :: lower_to_upper =IACHAR('A')-IACHAR('a')
+  integer                    :: i,N
+
+  MemOrd = ' '
+  N = len(MemoryOrder)
+  MemOrd(1:N) = MemoryOrder(1:N)
+  do i=1,N
+     c = MemoryOrder(i:i)
+     if('a'<=c .and. c <='z') MemOrd(i:i)=achar(iachar(c)+lower_to_upper)
+  enddo
+  return
+end subroutine UpperCase
+
+! subroutine used in transpose routine
+subroutine reorder (MemoryOrder,MemO)
+  character*(*)     ,intent(in)    :: MemoryOrder
+  character*3       ,intent(out)   :: MemO
+  character*3                      :: MemOrd
+  integer                          :: N,i,i1,i2,i3
+
+  MemO = MemoryOrder
+  N = len_trim(MemoryOrder)
+  if(N == 1) return
+  call lowercase(MemoryOrder,MemOrd)
+  i1 = 1
+  i3 = 1
+  do i=2,N
+     if(ichar(MemOrd(i:i)) < ichar(MemOrd(i1:i1))) I1 = i
+     if(ichar(MemOrd(i:i)) > ichar(MemOrd(i3:i3))) I3 = i
+  enddo
+  if(N == 2) then
+     i2=i3
+  else
+     i2 = 6-i1-i3
+  endif
+  MemO(1:1) = MemoryOrder(i1:i1)
+  MemO(2:2) = MemoryOrder(i2:i2)
+  if(N == 3) MemO(3:3) = MemoryOrder(i3:i3)
+  if(MemOrd(i1:i1) == 's' .or. MemOrd(i1:i1) == 'e') then
+     MemO(1:N-1) = MemO(2:N)
+     MemO(N:N  ) = MemoryOrder(i1:i1)
+  endif
+  return
+end subroutine reorder
+
+subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
+     ,XField,x1,x2,y1,y2,z1,z2 &
+     ,i1,i2,j1,j2,k1,k2 )
+  character*(*)     ,intent(in)    :: IO
+  character*(*)     ,intent(in)    :: MemoryOrder
+  integer           ,intent(in)    :: l1,l2,m1,m2,n1,n2
+  integer           ,intent(in)    :: di
+  integer           ,intent(in)    :: x1,x2,y1,y2,z1,z2
+  integer           ,intent(in)    :: i1,i2,j1,j2,k1,k2
+  integer           ,intent(inout) ::  Field(di,l1:l2,m1:m2,n1:n2)
+  !jm 010827  integer           ,intent(inout) :: XField(di,x1:x2,y1:y2,z1:z2)
+  integer           ,intent(inout) :: XField(di,(i2-i1+1)*(j2-j1+1)*(k2-k1+1))
+  character*3                      :: MemOrd
+  character*3                      :: MemO
+  integer           ,parameter     :: MaxUpperCase=IACHAR('Z')
+  integer                          :: i,j,k,ix,jx,kx
+
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+
+     !#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1))
+
+
+  case ('xzy')
+
+     ix=0
+     jx=0
+     kx=0
+     call reorder(MemoryOrder,MemO)
+     if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1
+     if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1
+     if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1
+     do k=k1,k2
+        do j=j1,j2
+           do i=i1,i2
+              if(IO == 'write') then
+                 XField(1:di,(i-i1+1+(i2-i1+1)*((k-k1)+(j-j1)*(k2-k1+1)))) = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k))
+              else
+                 Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = XField(1:di,(i-i1+1+(i2-i1+1)*((k-k1)+(j-j1)*(k2-k1+1))))
+              endif
+           enddo
+        enddo
+     enddo
+     return
+
+  case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c','0')
+
+
+     ix=0
+     jx=0
+     kx=0
+     call reorder(MemoryOrder,MemO)
+     if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1
+     if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1
+     if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1
+     do k=k1,k2
+        do j=j1,j2
+           do i=i1,i2
+              if(IO == 'write') then
+                 XField(1:di,(i-i1+1+(i2-i1+1)*((j-j1)+(k-k1)*(j2-j1+1)))) = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k))
+              else
+                 Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = XField(1:di,(i-i1+1+(i2-i1+1)*((j-j1)+(k-k1)*(j2-j1+1))))
+              endif
+           enddo
+        enddo
+     enddo
+     return
+
+  case ('yxz')
+
+
+     ix=0
+     jx=0
+     kx=0
+     call reorder(MemoryOrder,MemO)
+     if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1
+     if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1
+     if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1
+     do k=k1,k2
+        do j=j1,j2
+           do i=i1,i2
+              if(IO == 'write') then
+                 XField(1:di,(j-j1+1+(j2-j1+1)*((i-i1)+(k-k1)*(i2-i1+1)))) = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k))
+              else
+                 Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = XField(1:di,(j-j1+1+(j2-j1+1)*((i-i1)+(k-k1)*(i2-i1+1))))
+              endif
+           enddo
+        enddo
+     enddo
+     return
+
+  case ('zxy')
+
+
+     ix=0
+     jx=0
+     kx=0
+     call reorder(MemoryOrder,MemO)
+     if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1
+     if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1
+     if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1
+     do k=k1,k2
+        do j=j1,j2
+           do i=i1,i2
+              if(IO == 'write') then
+                 XField(1:di,(k-k1+1+(k2-k1+1)*((i-i1)+(j-j1)*(i2-i1+1)))) = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k))
+              else
+                 Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = XField(1:di,(k-k1+1+(k2-k1+1)*((i-i1)+(j-j1)*(i2-i1+1))))
+              endif
+           enddo
+        enddo
+     enddo
+     return
+
+  case ('yzx')
+
+
+     ix=0
+     jx=0
+     kx=0
+     call reorder(MemoryOrder,MemO)
+     if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1
+     if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1
+     if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1
+     do k=k1,k2
+        do j=j1,j2
+           do i=i1,i2
+              if(IO == 'write') then
+                 XField(1:di,(j-j1+1+(j2-j1+1)*((k-k1)+(i-i1)*(k2-k1+1)))) = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k))
+              else
+                 Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = XField(1:di,(j-j1+1+(j2-j1+1)*((k-k1)+(i-i1)*(k2-k1+1))))
+              endif
+           enddo
+        enddo
+     enddo
+     return
+
+  case ('zyx')
+
+
+     ix=0
+     jx=0
+     kx=0
+     call reorder(MemoryOrder,MemO)
+     if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1
+     if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1
+     if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1
+     do k=k1,k2
+        do j=j1,j2
+           do i=i1,i2
+              if(IO == 'write') then
+                 XField(1:di,(k-k1+1+(k2-k1+1)*((j-j1)+(i-i1)*(j2-j1+1)))) = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k))
+              else
+                 Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = XField(1:di,(k-k1+1+(k2-k1+1)*((j-j1)+(i-i1)*(j2-j1+1))))
+              endif
+           enddo
+        enddo
+     enddo
+     return
+
+  case ('yx')
+
+
+     ix=0
+     jx=0
+     kx=0
+     call reorder(MemoryOrder,MemO)
+     if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1
+     if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1
+     if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1
+     do k=k1,k2
+        do j=j1,j2
+           do i=i1,i2
+              if(IO == 'write') then
+                 XField(1:di,(j-j1+1+(j2-j1+1)*((i-i1)+(k-k1)*(i2-i1+1)))) = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k))
+              else
+                 Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = XField(1:di,(j-j1+1+(j2-j1+1)*((i-i1)+(k-k1)*(i2-i1+1))))
+              endif
+           enddo
+        enddo
+     enddo
+     return
+
+  end select
+  return
+end subroutine Transpose
+
+subroutine numtochar(TimeIndex,tname,Status)
+
+  use wrf_phdf5_data
+  integer, intent(in) :: TimeIndex
+  character(len=MaxTimeSLen),intent(out)::tname
+  integer                   ,intent(out)::Status
+  integer             :: i,ten_pow,temp
+  integer             :: maxtimestep
+
+  maxtimestep =1 
+  do i =1,MaxTimeSLen
+     maxtimestep = maxtimestep * 10
+  enddo
+  if(TimeIndex >= maxtimestep) then
+     Status = WRF_HDF5_ERR_OTHERS
+     write(msg,*) 'Cannot exceed the maximum timestep',maxtimestep,'in',__FILE__,' line',__LINE__
+     call wrf_debug(FATAL,msg)
+     return
+  endif
+
+  ten_pow = 1
+  temp =10
+  do i =1,MaxTimeSLen
+     tname(MaxTimeSLen+1-i:MaxTimeSLen+1-i) = achar(modulo(TimeIndex/ten_pow,temp)+iachar('0'))
+     ten_pow  = 10* ten_pow
+  enddo
+
+  return
+end subroutine numtochar
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/README
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/README	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/README	(revision 2744)
@@ -0,0 +1,38 @@
+This is a tar file of the WRF NetCDF I/O library.
+
+The tar file contains these files:
+
+-rw-r--r--   1 jacquesm ad           1968 Nov 27 13:43 README
+-rw-r--r--   1 jacquesm ad          15121 Nov 27 11:44 WRFIO.doc
+-rw-r--r--   1 jacquesm ad           4447 Nov 14 16:26 ext_get_glb_md.code
+-rw-r--r--   1 jacquesm ad           5068 Nov 17 14:56 ext_get_var_md.code
+-rw-r--r--   1 jacquesm ad           6766 Nov 17 15:12 ext_get_vartime_md.code
+-rw-r--r--   1 jacquesm ad           4106 Nov 14 15:04 ext_put_glb_md.code
+-rw-r--r--   1 jacquesm ad           4124 Nov 14 15:04 ext_put_var_md.code
+-rw-r--r--   1 jacquesm ad           7147 Nov 14 15:04 ext_put_vartime_md.code
+-rw-r--r--   1 jacquesm ad           6222 Nov 27 11:30 field_routines.F90
+-rw-r--r--   1 jacquesm ad             47 Oct 18 11:59 howto.ncdump
+-rw-r--r--   1 jacquesm ad           1218 Oct 26 15:16 makefile
+-rw-r--r--   1 jacquesm ad           2546 Nov 16 12:53 testWRFReadXYZ.F90
+-rw-r--r--   1 jacquesm ad           9555 Nov 27 11:25 testWRFReadfoo2.F90
+-rw-r--r--   1 jacquesm ad           7354 Nov 27 11:23 testWRFReadjfm.F90
+-rw-r--r--   1 jacquesm ad           2994 Nov 16 12:53 testWRFWriteXYZ.F90
+-rw-r--r--   1 jacquesm ad          16391 Nov 27 11:25 testWRFWritefoo2.F90
+-rw-r--r--   1 jacquesm ad           8896 Nov 27 11:25 testWRFWritejfm.F90
+-rw-r--r--   1 jacquesm ad            462 Oct 27 16:44 transpose.code
+-rw-r--r--   1 jacquesm ad          78533 Nov 27 11:22 wrf_io.F90
+-rw-r--r--   1 jacquesm ad           2715 Nov 21 12:06 wrf_status_codes.h
+
+The test* routines are test programs and one pair must be copied to
+testWRFWrite.F90 and testWRFRead.F90.  The other files comprise the WRF
+NetCDF I/O library.  In the makefile, you may need to redefine the path to
+NetCDF.  To run the test files, do:
+
+     make
+     testWRFWrite
+     testWRFRead
+
+testWRFWrite will create a NetCDF file called foo.nc and testWRFRead will
+read it.  Status codes and some values will be printed.
+
+
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_get_dom_ti.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_get_dom_ti.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_get_dom_ti.code	(revision 2744)
@@ -0,0 +1,159 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  TYPE_DATA
+  TYPE_COUNT
+  TYPE_OUTCOUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: XType
+  integer(KIND=MPI_OFFSET_KIND)         :: Len_okind
+  integer                               :: Len
+  integer                               :: stat
+  TYPE_BUFFER
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg) 
+    return
+  endif
+! Do nothing unless it is time to read time-independent domain metadata.  
+IF ( ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED   
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ   
+    write(msg,*) &
+'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE   
+    write(msg,*) &
+'Warning READ WRITE ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    stat = NFMPI_INQ_ATT(DH%NCID,NF_GLOBAL,Element, XType, Len_okind)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',trim(Element)
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    Len = Len_okind
+    if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then
+      if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then
+        Status = WRF_WARN_TYPE_MISMATCH   
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ', trim(Element)
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    else
+      if( XType/=NF_TYPE) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ', trim(Element)
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    endif
+    if(Len<=0) then
+      Status = WRF_WARN_LENGTH_LESS_THAN_1  
+      write(msg,*) &
+'Warning LENGTH < 1 in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ', trim(Element)
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+#ifndef CHAR_TYPE 
+    allocate(Buffer(Len), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR  
+      write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,Buffer)
+#else
+    Data = ''
+    stat = NFMPI_GET_ATT_TEXT(DH%NCID,NF_GLOBAL,Element,Data)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+#ifndef CHAR_TYPE 
+    COPY
+    deallocate(Buffer, STAT=stat)
+    if(stat/= WRF_NO_ERR) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
+      write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    if(Len > Count) then
+      OutCount = Count
+      Status = WRF_WARN_MORE_DATA_IN_FILE  
+    else
+      OutCount = Len
+      Status = WRF_NO_ERR
+    endif
+#endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS  
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+ENDIF
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_get_var_td.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_get_var_td.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_get_var_td.code	(revision 2744)
@@ -0,0 +1,229 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+#  include "pnetcdf.inc"
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character (DateStrLen),intent(in)     :: DateStr
+  character*(*)         ,intent(in)     :: Var
+  TYPE_DATA
+  TYPE_COUNT
+  TYPE_OUTCOUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  character (VarNameLen)                :: VarName
+  character (40+len(Element))           :: Name
+  character (40+len(Element))           :: FName
+  integer                               :: stat
+  TYPE_BUFFER           ,allocatable    :: Buffer(:)
+  integer                               :: i
+  integer                               :: VDims (2)
+  integer(KIND=MPI_OFFSET_KIND)         :: VStart(2)
+  integer(KIND=MPI_OFFSET_KIND)         :: VCount(2)
+  integer                               :: NVar
+  integer                               :: TimeIndex
+  integer                               :: NCID
+  integer                               :: DimIDs(2)
+  integer                               :: VarID
+  integer                               :: XType
+  integer                               :: NDims
+  integer                               :: NAtts
+  integer(KIND=MPI_OFFSET_KIND)         :: Len1_okind
+  integer                               :: Len1
+
+  if(Count <= 0) then
+    Status = WRF_WARN_ZERO_LENGTH_GET  
+    write(msg,*) &
+'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  VarName = Var
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  NCID = DH%NCID
+  call GetName(Element, VarName, Name, Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ  
+    write(msg,*) &
+'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE  
+    write(msg,*) &
+'Warning READ WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    stat = NFMPI_INQ_VARID(NCID,Name,VarID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    stat = NFMPI_INQ_VAR(NCID,VarID,FName,XType,NDims,DimIDs,NAtts)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then
+      if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    else
+      if(XType /= NF_TYPE) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    endif
+    if(NDims /= NMDVarDims) then
+      Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D   
+      write(msg,*) &
+'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    stat = NFMPI_INQ_DIMLEN(NCID,DimIDs(1),Len1_okind)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    Len1 = Len1_okind
+    call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    VStart(1) = 1
+    VStart(2) = TimeIndex
+    VCount(1) = LENGTH
+    VCount(2) = 1
+#ifndef CHAR_TYPE
+    allocate(Buffer(VCount(1)), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR   
+      write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    stat = NF_ROUTINE (NCID,VarID,VStart,VCount,Buffer)
+#else
+    if(Len1 > len(Data)) then
+      Status = WRF_WARN_CHARSTR_GT_LENDATA  
+      write(msg,*) &
+'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    Data = ''
+    stat = NFMPI_GET_VARA_TEXT_ALL (NCID,VarID,VStart,VCount,Data)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+#ifndef CHAR_TYPE
+    COPY
+    deallocate(Buffer, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR  
+      write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    if(Len1 > Count) then
+      OutCount = Count
+      Status = WRF_WARN_MORE_DATA_IN_FILE  
+    else
+      OutCount = Len1
+      Status = WRF_NO_ERR   
+    endif
+#endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS  
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_get_var_ti.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_get_var_ti.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_get_var_ti.code	(revision 2744)
@@ -0,0 +1,177 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var
+  TYPE_DATA
+  TYPE_COUNT
+  TYPE_OUTCOUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: XLen
+  integer(KIND=MPI_OFFSET_KIND)         :: XLen_offset
+  TYPE_BUFFER
+  character (VarNameLen)                :: VarName
+  integer                               :: stat
+  integer                               :: NVar
+  integer                               :: XType
+
+  if(Count <= 0) then
+    Status = WRF_WARN_ZERO_LENGTH_GET  
+    write(msg,*) &
+'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  VarName = Var
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ  
+    write(msg,*) &
+'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE 
+    write(msg,*) &
+'Warning READ WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    do NVar=1,DH%NumVars
+      if(DH%VarNames(NVar) == VarName) then
+        exit
+      elseif(NVar == DH%NumVars) then
+        Status = WRF_WARN_VAR_NF  
+        write(msg,*) &
+'Warning VARIABLE NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+    XLen_offset = i2offset(XLen)
+    stat = NFMPI_INQ_ATT(DH%NCID,DH%VarIDs(NVar),trim(Element),XType,XLen_offset)
+    XLen = XLen_offset
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+    endif
+    if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then
+      if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    else
+      if(XType /= NF_TYPE) then
+        Status = WRF_WARN_TYPE_MISMATCH  
+        write(msg,*) &
+'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    endif
+#ifndef CHAR_TYPE
+    allocate(Buffer(XLen), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+      write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), Buffer )
+#else
+    if(XLen > len(Data)) then
+      Status = WRF_WARN_CHARSTR_GT_LENDATA   
+      write(msg,*) &
+'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), Data )
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+    endif
+    COPY
+#ifndef CHAR_TYPE
+    deallocate(Buffer, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR  
+      write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    if(XLen > Count) then
+      OutCount = Count
+      Status   = WRF_WARN_MORE_DATA_IN_FILE  
+    else
+      OutCount = XLen
+      Status   = WRF_NO_ERR
+    endif
+#endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS  
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_put_dom_ti.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_put_dom_ti.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_put_dom_ti.code	(revision 2744)
@@ -0,0 +1,164 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  TYPE_DATA
+  TYPE_COUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: stat
+  integer                               :: stat2
+  integer               ,allocatable    :: Buffer(:)
+  integer                               :: i
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+! Do nothing unless it is time to write time-independent domain metadata.  
+IF ( ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    STATUS = WRF_WARN_WRITE_RONLY_FILE  
+    write(msg,*) &
+'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+#ifdef LOG
+      allocate(Buffer(Count), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      do i=1,Count
+        if(data(i)) then
+           Buffer(i)=1
+        else
+           Buffer(i)=0
+        endif
+      enddo
+      stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
+      deallocate(Buffer, STAT=stat2)
+      if(stat2/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+#else
+      stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+  elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    stat = NFMPI_REDEF(DH%NCID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+#ifdef LOG
+      allocate(Buffer(Count), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+        write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      do i=1,Count
+        if(data(i)) then
+           Buffer(i)=1
+        else
+           Buffer(i)=0
+        endif
+      enddo
+      stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
+      deallocate(Buffer, STAT=stat2)
+      if(stat2/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR  
+        write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+#else
+      stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    stat = NFMPI_ENDDEF(DH%NCID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS  
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+ENDIF
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_put_var_td.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_put_var_td.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_put_var_td.code	(revision 2744)
@@ -0,0 +1,233 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  character*(*)         ,intent(in)     :: Var
+  TYPE_DATA
+  TYPE_COUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  character (VarNameLen)                :: VarName
+  character (40+len(Element))           :: Name
+  integer                               :: stat
+  integer                               :: stat2
+  integer               ,allocatable    :: Buffer(:)
+  integer                               :: i
+  integer                               :: VDims (2)
+  integer(KIND=MPI_OFFSET_KIND)         :: VStart(2)
+  integer(KIND=MPI_OFFSET_KIND)         :: VCount(2)
+  integer                               :: NVar
+  integer                               :: TimeIndex
+  integer                               :: NCID
+
+  VarName = Var
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  NCID = DH%NCID
+  call GetName(Element, VarName, Name, Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_WRITE_RONLY_FILE  
+    write(msg,*) &
+'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    if(LENGTH < 1) then
+      Status = WRF_WARN_ZERO_LENGTH_PUT  
+      return
+    endif
+    do NVar=1,MaxVars
+      if(DH%MDVarNames(NVar) == Name) then
+        Status = WRF_WARN_2DRYRUNS_1VARIABLE  
+        return
+      elseif(DH%MDVarNames(NVar) == NO_NAME) then
+        DH%MDVarNames(NVar) = Name
+        exit
+      elseif(NVar == MaxVars) then
+        Status = WRF_WARN_TOO_MANY_VARIABLES  
+        write(msg,*) &
+'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+    do i=1,MaxDims
+      if(DH%DimLengths(i) == LENGTH) then
+        exit
+      elseif(DH%DimLengths(i) == NO_DIM) then
+        stat = NFMPI_DEF_DIM(NCID,DH%DimNames(i),i2offset(LENGTH),DH%DimIDs(i))
+        call netcdf_err(stat,Status)
+        if(Status /= WRF_NO_ERR) then
+          write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+          call wrf_debug ( WARN , msg)
+          return
+        endif
+        DH%DimLengths(i) = LENGTH
+        exit
+      elseif(i == MaxDims) then
+        Status = WRF_WARN_TOO_MANY_DIMS  
+        write(msg,*) &
+'Warning TOO MANY DIMENSIONS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+    DH%MDVarDimLens(NVar) = LENGTH
+    VDims(1) = DH%DimIDs(i)
+    VDims(2) = DH%DimUnlimID
+    stat = NFMPI_DEF_VAR(NCID,Name,NF_TYPE,2,VDims,DH%MDVarIDs(NVar))
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    do NVar=1,MaxVars
+      if(DH%MDVarNames(NVar) == Name) then
+        exit
+      elseif(DH%MDVarNames(NVar) == NO_NAME) then
+        Status = WRF_WARN_MD_NF  
+        write(msg,*) &
+'Warning METADATA NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( WARN , msg)
+        return
+      elseif(NVar == MaxVars) then
+        Status = WRF_WARN_TOO_MANY_VARIABLES  
+        write(msg,*) &
+'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+    if(LENGTH > DH%MDVarDimLens(NVar)) then
+      Status = WRF_WARN_COUNT_TOO_LONG 
+      write(msg,*) &
+'Warning COUNT TOO LONG in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    elseif(LENGTH < 1) then
+      Status = WRF_WARN_ZERO_LENGTH_PUT  
+      write(msg,*) &
+'Warning ZERO LENGTH PUT in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+    VStart(1) = 1
+    VStart(2) = TimeIndex
+    VCount(1) = LENGTH
+    VCount(2) = 1
+#ifdef LOG
+      allocate(Buffer(LENGTH), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+        write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      do i=1,Count
+        if(data(i)) then
+           Buffer(i)=1
+        else
+           Buffer(i)=0
+        endif
+      enddo
+      stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),VStart,VCount,Buffer)
+      deallocate(Buffer, STAT=stat2)
+      if(stat2/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
+        write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+#else
+      stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),VStart,VCount,Data)
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
+      call wrf_debug ( WARN , msg)
+      return
+    endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_put_var_ti.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_put_var_ti.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/ext_pnc_put_var_ti.code	(revision 2744)
@@ -0,0 +1,144 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: Var
+  TYPE_DATA
+  TYPE_COUNT
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  character (VarNameLen)                :: VarName
+  integer                               :: stat
+  integer               ,allocatable    :: Buffer(:)
+  integer                               :: i
+  integer                               :: NVar
+  character*1                           :: null
+
+  null=char(0)
+  VarName = Var
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) &
+'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED  
+    write(msg,*) &
+'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_WRITE_RONLY_FILE  
+    write(msg,*) &
+'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( WARN , msg)
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_MD_AFTER_OPEN  
+    write(msg,*) &
+'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    do NVar=1,MaxVars
+      if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
+        exit
+      elseif(NVar == MaxVars) then
+        Status = WRF_WARN_VAR_NF 
+        write(msg,*) &
+'Warning VARIABLE NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ &
+                        ,NVar,VarName
+        call wrf_debug ( WARN , msg)
+        return
+      endif
+    enddo
+#ifdef LOG
+    allocate(Buffer(Count), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
+      write(msg,*) &
+'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    do i=1,Count
+      if(data(i)) then
+         Buffer(i)=1
+      else
+         Buffer(i)=0
+      endif
+    enddo
+#endif
+#ifdef CHAR_TYPE
+    if(len_trim(Data).le.0) then
+      stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element),i2offset(len_trim(null)),null)
+    else
+      stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), ARGS )
+    endif
+#else
+    stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), ARGS )
+#endif
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) &
+'NetCDF error for Var ',TRIM(Var),&
+        ' Element ',trim(Element),' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( WARN , msg)
+    endif
+#ifdef LOG
+    deallocate(Buffer, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
+      write(msg,*) &
+'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+#endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS 
+    write(msg,*) &
+'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/field_routines.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/field_routines.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/field_routines.F90	(revision 2744)
@@ -0,0 +1,191 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+subroutine ext_pnc_RealFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character (*)               ,intent(in)    :: IO
+  integer                     ,intent(in)    :: NCID
+  integer                     ,intent(in)    :: VarID
+  integer ,dimension(NVarDims),intent(in)    :: VStart
+  integer ,dimension(NVarDims),intent(in)    :: VCount
+  real, dimension(*)          ,intent(inout) :: Data
+  integer                     ,intent(out)   :: Status
+  integer                                    :: stat
+!local
+  integer(KIND=MPI_OFFSET_KIND), dimension(NVarDims)    :: VStart_mpi, VCount_mpi
+  VStart_mpi = VStart
+  VCount_mpi = VCount
+
+  if(IO == 'write') then
+    stat = NFMPI_PUT_VARA_REAL_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
+  else
+    stat = NFMPI_GET_VARA_REAL_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
+  endif
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  endif
+  return
+end subroutine ext_pnc_RealFieldIO
+
+subroutine ext_pnc_DoubleFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character (*)               ,intent(in)    :: IO
+  integer                     ,intent(in)    :: NCID
+  integer                     ,intent(in)    :: VarID
+  integer ,dimension(NVarDims),intent(in)    :: VStart
+  integer ,dimension(NVarDims),intent(in)    :: VCount
+  real*8                      ,intent(inout) :: Data
+  integer                     ,intent(out)   :: Status
+  integer                                    :: stat
+!local
+  integer(KIND=MPI_OFFSET_KIND), dimension(NVarDims)    :: VStart_mpi, VCount_mpi
+  VStart_mpi = VStart
+  VCount_mpi = VCount
+
+  if(IO == 'write') then
+    stat = NFMPI_PUT_VARA_DOUBLE_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
+  else
+    stat = NFMPI_GET_VARA_DOUBLE_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
+  endif
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  endif
+  return
+end subroutine ext_pnc_DoubleFieldIO
+
+subroutine ext_pnc_IntFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character (*)               ,intent(in)    :: IO
+  integer                     ,intent(in)    :: NCID
+  integer                     ,intent(in)    :: VarID
+  integer ,dimension(NVarDims),intent(in)    :: VStart
+  integer ,dimension(NVarDims),intent(in)    :: VCount
+  integer                     ,intent(inout) :: Data
+  integer                     ,intent(out)   :: Status
+  integer                                    :: stat
+!local
+  integer(KIND=MPI_OFFSET_KIND), dimension(NVarDims)    :: VStart_mpi, VCount_mpi
+  VStart_mpi = VStart
+  VCount_mpi = VCount
+
+  if(IO == 'write') then
+    stat = NFMPI_PUT_VARA_INT_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
+  else
+    stat = NFMPI_GET_VARA_INT_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
+  endif
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+  endif
+  return
+end subroutine ext_pnc_IntFieldIO
+
+subroutine ext_pnc_LogicalFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character (*)                                   ,intent(in)    :: IO
+  integer                                         ,intent(in)    :: NCID
+  integer                                         ,intent(in)    :: VarID
+  integer,dimension(NVarDims)                     ,intent(in)    :: VStart
+  integer,dimension(NVarDims)                     ,intent(in)    :: VCount
+  logical,dimension(VCount(1),VCount(2),VCount(3)),intent(inout) :: Data
+  integer                                         ,intent(out)   :: Status
+  integer,dimension(:,:,:),allocatable                           :: Buffer
+  integer                                                        :: stat
+  integer                                                        :: i,j,k
+!local
+  integer(KIND=MPI_OFFSET_KIND), dimension(NVarDims)    :: VStart_mpi, VCount_mpi
+  VStart_mpi = VStart
+  VCount_mpi = VCount
+
+  allocate(Buffer(VCount(1),VCount(2),VCount(3)), STAT=stat)
+  if(stat/= 0) then
+    Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+    write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  if(IO == 'write') then
+    do k=1,VCount(3)
+      do j=1,VCount(2)
+        do i=1,VCount(1)
+          if(data(i,j,k)) then
+            Buffer(i,j,k)=1
+          else
+            Buffer(i,j,k)=0
+          endif
+        enddo
+      enddo
+    enddo
+    stat = NFMPI_PUT_VARA_INT_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Buffer)
+  else
+    stat = NFMPI_GET_VARA_INT_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Buffer)
+    Data = Buffer == 1
+  endif
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , msg)
+    return
+  endif
+  deallocate(Buffer, STAT=stat)
+  if(stat/= 0) then
+    Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+    write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  return
+end subroutine ext_pnc_LogicalFieldIO
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/makefile	(revision 2744)
@@ -0,0 +1,35 @@
+#makefile to build a wrf_io with netCDF
+
+OBJSL   = wrf_io.o field_routines.o module_wrfsi_static.o
+OBJS    = $(OBJSL)
+CODE    = ext_pnc_get_dom_ti.code ext_pnc_get_var_td.code ext_pnc_get_var_ti.code ext_pnc_put_dom_ti.code ext_pnc_put_var_td.code ext_pnc_put_var_ti.code transpose.code 
+FFLAGS  =  $(FCFLAGS) -I$(NETCDFPATH)/include -I../ioapi_share
+LIBS    = -L$(NETCDFPATH)/lib -lnetcdf
+CPP1    = $(CPP)  -P $(TRADFLAG)
+M4      = m4 -Uinclude -Uindex -Ulen
+AR      = ar
+
+.SUFFIXES:      .F90 .f .o .code
+
+all : libwrfio_pnf.a 
+
+libwrfio_pnf.a:		$(OBJS) $(CODE)
+			/bin/rm -f libwrfio_pnf.a
+			$(AR) cr libwrfio_pnf.a $(OBJSL)
+			$(RANLIB) libwrfio_pnf.a
+
+wrf_io.o:               wrf_io.F90 $(CODE)
+			$(CPP1) -I$(NETCDFPATH)/include -I../ioapi_share wrf_io.F90 | $(M4) - > wrf_io.f
+			$(FC) $(FFLAGS) -c wrf_io.f
+
+module_wrfsi_static.o:  module_wrfsi_static.F90
+			$(CPP1) -I$(NETCDFPATH)/include -I../ioapi_share module_wrfsi_static.F90 > module_wrfsi_static.f
+			$(FC) $(FFLAGS) -c module_wrfsi_static.f
+
+field_routines.o:	field_routines.F90
+			$(CPP1) -I$(NETCDFPATH)/include -I../ioapi_share field_routines.F90 > field_routines.f
+			$(FC) $(FFLAGS) -c field_routines.f
+
+superclean:
+			/bin/rm -f *.f *.o testWRFWrite testWRFRead \
+			*.mod libwrfio_pnf.a
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/module_wrfsi_static.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/module_wrfsi_static.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/module_wrfsi_static.F90	(revision 2744)
@@ -0,0 +1,96 @@
+MODULE wrfsi_static
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+CONTAINS
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE open_wrfsi_static(dataroot,cdfid)
+  
+    IMPLICIT NONE
+#    include "pnetcdf.inc"
+    CHARACTER(LEN=*), INTENT(IN)   :: dataroot
+    INTEGER, INTENT(OUT)           :: cdfid
+    CHARACTER(LEN=255)            :: staticfile
+    LOGICAL                       :: static_exists
+    INTEGER                       :: status
+
+    staticfile = TRIM(dataroot) // '/static/static.wrfsi'
+    INQUIRE(FILE=staticfile, EXIST=static_exists)
+    IF (static_exists) THEN
+      status = nfmpi_open(TRIM(staticfile),NF_NOWRITE,cdfid)
+      IF (status .NE. NF_NOERR) THEN
+        PRINT '(A,I5)', 'NetCDF error opening WRF static file: ',status
+        STOP 'open_wrfsi_static'
+      END IF 
+
+    ELSE
+
+!mp
+!	search for rotlat version??
+!      PRINT '(A)', 'Static file not found ', staticfile
+!      PRINT '(A)', 'Look for NMM version'
+      staticfile = TRIM(dataroot) // '/static/static.wrfsi.rotlat'
+      INQUIRE(FILE=staticfile, EXIST=static_exists)
+		    IF (static_exists) THEN
+		 status = nfmpi_open(TRIM(staticfile),NF_NOWRITE,cdfid)
+      IF (status .NE. NF_NOERR) THEN
+        PRINT '(A,I5)', 'NetCDF error opening WRF static file: ',status
+        STOP 'open_wrfsi_static'
+      END IF
+		    ELSE
+
+      PRINT '(A)', 'rotlat Static file not found, either: ', staticfile
+      STOP 'open_wrfsi_static'
+  		    ENDIF
+
+	ENDIF
+
+    RETURN
+  END SUBROUTINE open_wrfsi_static      
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE get_wrfsi_static_dims(dataroot, nx, ny)
+  
+    ! Subroutine to return the horizontal dimensions of WRF static file
+    ! contained in the input dataroot
+
+    IMPLICIT NONE
+#    include "pnetcdf.inc"
+    CHARACTER(LEN=*), INTENT(IN)  :: dataroot
+    INTEGER         , INTENT(OUT) :: nx
+    INTEGER         , INTENT(OUT) :: ny
+
+    INTEGER                       :: cdfid,vid, status
+
+    CALL open_wrfsi_static(dataroot,cdfid)
+    status = nfmpi_inq_dimid(cdfid, 'x', vid)
+    status = nfmpi_inq_dimlen(cdfid, vid, nx)
+    status = nfmpi_inq_dimid(cdfid, 'y', vid)
+    status = nfmpi_inq_dimlen(cdfid, vid, ny) 
+      PRINT '(A,I5,A,I5)', 'WRF X-dimension = ',nx, &
+        ' WRF Y-dimension = ',ny  
+    status = nfmpi_close(cdfid)  
+    RETURN
+  END SUBROUTINE get_wrfsi_static_dims     
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE get_wrfsi_static_2d(dataroot, varname, data)
+
+    IMPLICIT NONE
+#    include "pnetcdf.inc"
+    ! Gets any 2D variable from the static file
+    CHARACTER(LEN=*), INTENT(IN)  :: dataroot
+    CHARACTER(LEN=*), INTENT(IN)  :: varname
+    REAL, INTENT(OUT)             :: data(:,:)
+ 
+    INTEGER                             :: cdfid, vid, status
+   
+    CALL open_wrfsi_static(dataroot,cdfid)
+    status = nfmpi_inq_varid(cdfid,varname,vid)
+    status = nfmpi_get_var_real(cdfid,vid,data)
+    IF (status .NE. NF_NOERR) THEN
+      PRINT '(A)', 'Problem getting 2D data.'
+    ENDIF 
+    status = nfmpi_close(cdfid) 
+    RETURN
+  END SUBROUTINE get_wrfsi_static_2d    
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  
+END MODULE wrfsi_static
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/testWRFRead.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/testWRFRead.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/testWRFRead.F90	(revision 2744)
@@ -0,0 +1,138 @@
+program testread_john
+  use wrf_data
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character (80) FileName
+  integer Comm
+  character (80) SysDepInfo
+  integer     :: DataHandle
+  integer Status
+  integer NCID
+  real data(200)
+  integer idata(200)
+  real*8 ddata(200)
+  logical ldata(200)
+  character (80) cdata
+  integer OutCount
+  integer i,j,k
+
+  integer, parameter ::    pad = 3
+  integer, parameter ::    jds=1       , jde=6      , &
+                           ids=1       , ide=9      , &
+                           kds=1       , kde=5
+  integer, parameter ::    jms=jds-pad , jme=jde+pad , &
+                           ims=ids-pad , ime=ide+pad , &
+                           kms=kds     , kme=kde
+  integer, parameter ::    jps=jds     , jpe=jde    , &
+                           ips=ids     , ipe=ide    , &
+                           kps=kds     , kpe=kde
+
+  real u( ims:ime , kms:kme , jms:jme )
+  real v( ims:ime , kms:kme , jms:jme )
+  real rho( ims:ime , kms:kme , jms:jme )
+  real u2( ims:ime , jms:jme )
+  real u1( ims:ime )
+
+  integer int( ims:ime , kms:kme , jms:jme )
+  real*8  r8 ( ims:ime , kms:kme , jms:jme )
+
+  integer Dom
+  character*3 MemOrd
+  integer , Dimension(3) :: DomS,DomE,MemS,MemE,PatS,PatE
+  integer , Dimension(2) :: Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E
+  integer                   Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E
+  character (19) Time, DateStr
+  character (31) VarName
+  character (19) Date
+
+  print *, 'Testing wrf read'
+  Date = '2000-09-18_16:42:01'
+  call ext_init(Status)
+  print *,'After call ext_init, Status =',Status
+  FileName = 'foo.nc'
+  Comm = 1
+  SysDepInfo = 'sys info'
+  call ext_open_for_read( FileName, Comm, SysDepInfo, DataHandle, Status)
+  print *, 'Status = ',Status,DataHandle
+
+  MemOrd = "XZY"
+
+  DomS(1) = ids
+  DomE(1) = ide
+  DomS(2) = kds
+  DomE(2) = kde
+  DomS(3) = jds
+  DomE(3) = jde
+
+  PatS(1) = ips
+  PatE(1) = ipe
+  PatS(2) = kps
+  PatE(2) = kpe
+  PatS(3) = jps
+  PatE(3) = jpe
+
+  MemS(1) = ims
+  MemE(1) = ime
+  MemS(2) = kms
+  MemE(2) = kme
+  MemS(3) = jms
+  MemE(3) = jme
+
+  Dom2S(1) = ids
+  Dom2S(2) = jds
+  Dom2E(1) = ide
+  Dom2E(2) = jde
+  Mem2S(1) = ims
+  Mem2S(2) = jms
+  Mem2E(1) = ime
+  Mem2E(2) = jme
+  Pat2S(1) = ips
+  Pat2S(2) = jps
+  Pat2E(1) = ipe
+  Pat2E(2) = jpe
+
+  Dom1S = ids
+  Dom1E = ide
+  Mem1S = ims
+  Mem1E = ime
+  Pat1S = ips
+  Pat1E = ipe
+
+  call ext_get_next_time(DataHandle, Time, Status)
+  print *, Time, Status
+
+  call ext_read_field(DataHandle,Time,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' u(2,3,4) ', u(2,3,4) 
+  call ext_read_field(DataHandle,Time,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' v(4,3,2) ', v(4,3,2)
+  call ext_read_field(DataHandle,Time,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' rho(3,4,5) ' , rho(3,4,5)
+  call ext_read_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
+  print *,'ext_read_field Status = ',Status, ' u2(6,5) ', u2(6,5) 
+  call ext_read_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' u(2,3,4) ', u(2,3,4) 
+  call ext_read_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
+  print *,'ext_read_field Status = ',Status, ' u1(9) ', u1(9)
+
+  call ext_read_field(DataHandle,Time,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' int(8,5,6) ', int(8,5,6) 
+  call ext_read_field(DataHandle,Time,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'ext_read_field Status = ',Status, ' r8(7,4,5) ', r8(7,4,5) 
+
+  call ext_get_next_time(DataHandle, Time, Status)
+  print *, Time, Status
+
+  call ext_read_field(DataHandle,Time,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'> ext_read_field Status = ',Status, ' u(3,3,3) ' ,u(3,3,3)
+  call ext_read_field(DataHandle,Time,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'> ext_read_field Status = ',Status, ' v(4,4,4) ' ,v(4,4,4)
+  call ext_read_field(DataHandle,Time,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'> ext_read_field Status = ',Status, ' rho(3,4,5) ' ,rho(3,4,5)
+
+  call ext_close( DataHandle, Status)
+  print *, 'After ext_close, Status = ',Status
+  call ext_exit(Status)
+  print *,'End of test program',Status
+  stop
+  end program testread_john
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/testWRFWrite.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/testWRFWrite.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/testWRFWrite.F90	(revision 2744)
@@ -0,0 +1,184 @@
+program testwrite_john
+  use wrf_data
+  implicit none
+  include 'wrf_status_codes.h'
+  include 'netcdf.inc'
+  character (80) FileName
+  integer Comm
+  character (80) SysDepInfo
+  integer     :: DataHandle
+  integer Status
+  integer NCID
+  real data(200)
+  integer idata(200)
+  real*8 ddata(200)
+  logical ldata(200)
+  character (80) cdata
+  integer OutCount
+  integer i,j,k
+
+  integer, parameter ::    pad = 3  
+  integer, parameter ::    jds=1       , jde=6      , &
+                           ids=1       , ide=9      , &
+                           kds=1       , kde=5         
+  integer, parameter ::    jms=jds-pad , jme=jde+pad , &
+                           ims=ids-pad , ime=ide+pad , &
+                           kms=kds     , kme=kde       
+  integer, parameter ::    jps=jds     , jpe=jde    , &
+                           ips=ids     , ipe=ide    , &
+                           kps=kds     , kpe=kde       
+
+  real u( ims:ime , kms:kme , jms:jme )
+  real v( ims:ime , kms:kme , jms:jme )
+  real rho( ims:ime , kms:kme , jms:jme )
+  real u2( ims:ime , jms:jme )
+  real u1( ims:ime )
+
+  integer int( ims:ime , kms:kme , jms:jme )
+  real*8  r8 ( ims:ime , kms:kme , jms:jme )
+
+  integer Dom
+  character*3 MemOrd
+  character (19) Date
+  character (19) Date2
+  integer , Dimension(3) :: DomS,DomE,MemS,MemE,PatS,PatE
+  integer , Dimension(2) :: Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E
+  integer , Dimension(1) :: Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E
+  print *, 'Testing wrf write'
+  print *, ims,ime , kms,kme , jms,jme
+  Date = '2000-09-18_16:42:01'
+  Date2 = '2000-09-18_16:52:01'
+  call ext_init(Status)
+  print *,'After call ext_init, Status =',Status
+  FileName = 'foo.nc'
+  Comm = 1
+  SysDepInfo = 'sys info'
+
+print*,'!!!!!!!!!!!!!!!!!!!!!!! ext_open_for_write_begin'
+
+  call ext_open_for_write_begin( FileName, Comm, SysDepInfo, DataHandle, Status)
+  print *, ' ext_open_for_write_begin Status = ',Status,DataHandle
+
+  MemOrd = "XZY"
+
+  DomS(1) = ids
+  DomE(1) = ide
+  DomS(2) = kds
+  DomE(2) = kde
+  DomS(3) = jds
+  DomE(3) = jde
+
+  PatS(1) = ips
+  PatE(1) = ipe
+  PatS(2) = kps
+  PatE(2) = kpe
+  PatS(3) = jps
+  PatE(3) = jpe
+
+  MemS(1) = ims
+  MemE(1) = ime
+  MemS(2) = kms
+  MemE(2) = kme
+  MemS(3) = jms
+  MemE(3) = jme
+
+  Dom2S(1) = ids
+  Dom2S(2) = jds
+  Dom2E(1) = ide
+  Dom2E(2) = jde
+  Mem2S(1) = ims
+  Mem2S(2) = jms
+  Mem2E(1) = ime
+  Mem2E(2) = jme
+  Pat2S(1) = ips
+  Pat2S(2) = jps
+  Pat2E(1) = ipe
+  Pat2E(2) = jpe
+
+  Dom1S = ids
+  Dom1E = ide
+  Mem1S = ims
+  Mem1E = ime
+  Pat1S = ips
+  Pat1E = ipe
+
+  call ext_write_field(DataHandle,Date,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+
+  call ext_open_for_write_commit(DataHandle, Status)
+  print *, '             ext_open_for_write_commit Status = ', Status,DataHandle
+
+  do j=jds,jde
+    do k=kds,kde
+      do i=ids,ide
+        u  (i,k,j) = 100*i+j+10*k
+        v  (i,k,j) = 100*i+j+10*k
+        rho(i,k,j) = 100*i+j+10*k
+        int(i,k,j) = 100*i+j+10*k
+        r8 (i,k,j) = 100*i+j+10*k
+      enddo
+    enddo
+  enddo
+  do j=jds,jde
+    do i=ids,ide
+      u2(i,j) = 10*i+j
+    enddo
+  enddo
+  do i=ids,ide
+    u1(i) = i
+  enddo
+
+  print *,'testWRFWrite u  (2,3,4) = ',u(2,3,4)
+  print *,'testWRFWrite v  (4,3,2) = ',v(4,3,2)
+  print *,'testWRFWrite rho(3,4,5) = ',rho(3,4,5)
+  print *,'testWRFWrite u2 (6,5)   = ',u2(6,5)
+  print *,'testWRFWrite u1 (9)     = ',u1(9)
+  print *,'testWRFWrite int(8,5,6) = ',int(8,5,6)
+  print *,'testWRFWrite r8 (7,4,5) = ',r8(7,4,5)
+  call ext_write_field(DataHandle,Date,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              first write: ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'             dry run : ext_write_field Status = ',Status
+
+  print *,'2nd : testWRFWrite u(3,3,3) = ',u(3,3,3)
+  print *,'2nd : testWRFWrite v(4,4,4) = ',v(4,4,4)
+  print *,'2nd : testWRFWrite rho(3,4,5) = ',rho(3,4,5)
+  call ext_write_field(DataHandle,Date2,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              2nd write : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date2,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              2nd write : ext_write_field Status = ',Status
+  call ext_write_field(DataHandle,Date2,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
+  print *,'              2nd write : ext_write_field Status = ',Status
+
+  call ext_close( DataHandle, Status)
+  print *, '             After ext_close, Status = ',Status
+  call ext_exit(Status)
+  print *,'              End of test program',Status
+  stop
+  end program testwrite_john
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/transpose.code
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/transpose.code	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/transpose.code	(revision 2744)
@@ -0,0 +1,36 @@
+  ix=0
+  jx=0
+  kx=0
+  call reorder(MemoryOrder,MemO)
+  if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1
+  if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1
+  if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1
+
+! pjj/cray
+  if(IO == 'write') then
+!dir$ concurrent
+  do k=k1,k2
+    do j=j1,j2
+!dir$ prefervector
+!dir$ concurrent
+!cdir select(vector)
+      do i=i1,i2
+          DFIELD = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k))
+      enddo
+    enddo
+  enddo
+else
+!dir$ concurrent
+  do k=k1,k2
+    do j=j1,j2
+!dir$ prefervector
+!dir$ concurrent
+!cdir select(vector)
+      do i=i1,i2
+          Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = DFIELD
+      enddo
+    enddo
+  enddo
+endif
+
+  return
Index: trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/wrf_io.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/wrf_io.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/io_pnetcdf/wrf_io.F90	(revision 2744)
@@ -0,0 +1,3408 @@
+!*------------------------------------------------------------------------------
+!*  Standard Disclaimer
+!*
+!*  Forecast Systems Laboratory
+!*  NOAA/OAR/ERL/FSL
+!*  325 Broadway
+!*  Boulder, CO     80303
+!*
+!*  AVIATION DIVISION
+!*  ADVANCED COMPUTING BRANCH
+!*  SMS/NNT Version: 2.0.0 
+!*
+!*  This software and its documentation are in the public domain and
+!*  are furnished "as is".  The United States government, its 
+!*  instrumentalities, officers, employees, and agents make no 
+!*  warranty, express or implied, as to the usefulness of the software 
+!*  and documentation for any purpose.  They assume no 
+!*  responsibility (1) for the use of the software and documentation; 
+!*  or (2) to provide technical support to users.
+!* 
+!*  Permission to use, copy, modify, and distribute this software is
+!*  hereby granted, provided that this disclaimer notice appears in 
+!*  all copies.  All modifications to this software must be clearly
+!*  documented, and are solely the responsibility of the agent making
+!*  the modification.  If significant modifications or enhancements
+!*  are made to this software, the SMS Development team
+!*  (sms-info@fsl.noaa.gov) should be notified.
+!*
+!*----------------------------------------------------------------------------
+!*
+!*  WRF NetCDF I/O
+!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
+!*  Date:    October 6, 2000
+!*
+!*----------------------------------------------------------------------------
+
+module wrf_data
+
+  integer                , parameter      :: FATAL            = 1
+  integer                , parameter      :: WARN             = 1
+  integer                , parameter      :: WrfDataHandleMax = 99
+  integer                , parameter      :: MaxDims          = 2000 ! = NF_MAX_VARS
+  integer                , parameter      :: MaxVars          = 2000
+  integer                , parameter      :: MaxTimes         = 9000
+  integer                , parameter      :: DateStrLen       = 19
+  integer                , parameter      :: VarNameLen       = 31
+  integer                , parameter      :: NO_DIM           = 0
+  integer                , parameter      :: NVarDims         = 4
+  integer                , parameter      :: NMDVarDims       = 2
+  character (8)          , parameter      :: NO_NAME          = 'NULL'
+  character (DateStrLen) , parameter      :: ZeroDate = '0000-00-00-00:00:00'
+
+# include "wrf_io_flags.h"
+
+  character (256)                         :: msg
+  logical                                 :: WrfIOnotInitialized = .true.
+
+  type :: wrf_data_handle
+    character (255)                       :: FileName
+    integer                               :: FileStatus
+    integer                               :: Comm
+    integer                               :: NCID
+    logical                               :: Free
+    logical                               :: Write
+    character (5)                         :: TimesName
+    integer                               :: TimeIndex
+    integer                               :: CurrentTime  !Only used for read
+    integer                               :: NumberTimes  !Only used for read
+    character (DateStrLen), pointer       :: Times(:)
+    integer                               :: TimesVarID
+    integer               , pointer       :: DimLengths(:)
+    integer               , pointer       :: DimIDs(:)
+    character (31)        , pointer       :: DimNames(:)
+    integer                               :: DimUnlimID
+    character (9)                         :: DimUnlimName
+    integer       , dimension(NVarDims)   :: DimID
+    integer       , dimension(NVarDims)   :: Dimension
+    integer               , pointer       :: MDVarIDs(:)
+    integer               , pointer       :: MDVarDimLens(:)
+    character (80)        , pointer       :: MDVarNames(:)
+    integer               , pointer       :: VarIDs(:)
+    integer               , pointer       :: VarDimLens(:,:)
+    character (VarNameLen), pointer       :: VarNames(:)
+    integer                               :: CurrentVariable  !Only used for read
+    integer                               :: NumVars
+! first_operation is set to .TRUE. when a new handle is allocated 
+! or when open-for-write or open-for-read are committed.  It is set 
+! to .FALSE. when the first field is read or written.  
+    logical                               :: first_operation
+  end type wrf_data_handle
+  type(wrf_data_handle),target            :: WrfDataHandles(WrfDataHandleMax)
+end module wrf_data
+
+module ext_pnc_support_routines
+
+  implicit none
+  include 'mpif.h'
+
+CONTAINS
+
+integer(KIND=MPI_OFFSET_KIND) function i2offset(i)
+  integer i
+  i2offset = i
+  return
+end function i2offset
+
+subroutine allocHandle(DataHandle,DH,Comm,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  integer              ,intent(out) :: DataHandle
+  type(wrf_data_handle),pointer     :: DH
+  integer              ,intent(IN)  :: Comm
+  integer              ,intent(out) :: Status
+  integer                           :: i
+  integer                           :: stat
+
+  do i=1,WrfDataHandleMax
+    if(WrfDataHandles(i)%Free) then
+      DH => WrfDataHandles(i)
+      DataHandle = i
+      allocate(DH%Times(MaxTimes), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%DimLengths(MaxDims), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%DimIDs(MaxDims), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%DimNames(MaxDims), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%MDVarIDs(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%MDVarDimLens(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%MDVarNames(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%VarIDs(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%VarDimLens(NVarDims-1,MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      allocate(DH%VarNames(MaxVars), STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      exit
+    endif
+    if(i==WrfDataHandleMax) then
+      Status = WRF_WARN_TOO_MANY_FILES
+      write(msg,*) 'Warning TOO MANY FILES in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      write(msg,*) 'Did you call ext_pnc_ioinit?'
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+  enddo
+  DH%Free      =.false.
+  DH%Comm      = Comm
+  DH%Write     =.false.
+  DH%first_operation  = .TRUE.
+  Status = WRF_NO_ERR
+end subroutine allocHandle
+
+subroutine deallocHandle(DataHandle, Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  integer              ,intent(in) :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: i
+  integer                           :: stat
+
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. WrfDataHandleMax ) THEN
+    if(.NOT. WrfDataHandles(DataHandle)%Free) then
+      DH => WrfDataHandles(DataHandle)
+      deallocate(DH%Times, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%DimLengths, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%DimIDs, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%DimNames, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%MDVarIDs, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%MDVarDimLens, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%MDVarNames, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%VarIDs, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%VarDimLens, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      deallocate(DH%VarNames, STAT=stat)
+      if(stat/= 0) then
+        Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+        call wrf_debug ( FATAL , msg)
+        return
+      endif
+      DH%Free      =.TRUE.
+    endif
+  ENDIF
+  Status = WRF_NO_ERR
+end subroutine deallocHandle
+
+subroutine GetDH(DataHandle,DH,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  type(wrf_data_handle) ,pointer        :: DH
+  integer               ,intent(out)    :: Status
+
+  if(DataHandle < 1 .or. DataHandle > WrfDataHandleMax) then
+    Status = WRF_WARN_BAD_DATA_HANDLE
+    return
+  endif
+  DH => WrfDataHandles(DataHandle)
+  if(DH%Free) then
+    Status = WRF_WARN_BAD_DATA_HANDLE
+    return
+  endif
+  Status = WRF_NO_ERR
+  return
+end subroutine GetDH
+
+subroutine DateCheck(Date,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  character*(*) ,intent(in)      :: Date
+  integer       ,intent(out)     :: Status
+  
+  if(len(Date) /= DateStrLen) then
+    Status = WRF_WARN_DATESTR_BAD_LENGTH
+  else  
+    Status = WRF_NO_ERR
+  endif
+  return
+end subroutine DateCheck
+
+subroutine GetName(Element,Var,Name,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  character*(*) ,intent(in)     :: Element
+  character*(*) ,intent(in)     :: Var
+  character*(*) ,intent(out)    :: Name
+  integer       ,intent(out)    :: Status
+  character (VarNameLen)        :: VarName
+  character (1)                 :: c
+  integer                       :: i
+  integer, parameter            ::  upper_to_lower =IACHAR('a')-IACHAR('A')
+
+  VarName = Var
+  Name = 'MD___'//trim(Element)//VarName
+  do i=1,len(Name)
+    c=Name(i:i)
+    if('A'<=c .and. c <='Z') Name(i:i)=achar(iachar(c)+upper_to_lower)
+    if(c=='-'.or.c==':') Name(i:i)='_'
+  enddo
+  Status = WRF_NO_ERR
+  return
+end subroutine GetName
+
+subroutine GetTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character (*)         ,intent(in)     :: IO
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: DateStr
+  integer               ,intent(out)    :: TimeIndex
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer(KIND=MPI_OFFSET_KIND)         :: VStart(2)
+  integer(KIND=MPI_OFFSET_KIND)         :: VCount(2)
+  integer                               :: stat
+  integer                               :: i
+
+  DH => WrfDataHandles(DataHandle)
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    Status =  WRF_WARN_DATESTR_ERROR
+    write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(IO == 'write') then
+    TimeIndex = DH%TimeIndex
+    if(TimeIndex <= 0) then
+      TimeIndex = 1
+    elseif(DateStr == DH%Times(TimeIndex)) then
+      Status = WRF_NO_ERR
+      return
+    else
+      TimeIndex = TimeIndex +1
+      if(TimeIndex > MaxTimes) then
+        Status = WRF_WARN_TIME_EOF
+        write(msg,*) 'Warning TIME EOF in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    endif
+    DH%TimeIndex        = TimeIndex
+    DH%Times(TimeIndex) = DateStr
+    VStart(1) = 1
+    VStart(2) = TimeIndex
+    VCount(1) = DateStrLen
+    VCount(2) = 1
+    stat = NFMPI_PUT_VARA_TEXT_ALL(DH%NCID,DH%TimesVarID,VStart,VCount,DateStr)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+  else
+    do i=1,MaxTimes
+      if(DH%Times(i)==DateStr) then
+        Status = WRF_NO_ERR
+        TimeIndex = i
+        exit
+      endif
+      if(i==MaxTimes) then
+        Status = WRF_WARN_TIME_NF
+        write(msg,*) 'Warning TIME ',DateStr,' NOT FOUND in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+  endif
+  return
+end subroutine GetTimeIndex
+
+subroutine GetDim(MemoryOrder,NDim,Status)
+  include 'wrf_status_codes.h'
+  character*(*) ,intent(in)  :: MemoryOrder
+  integer       ,intent(out) :: NDim
+  integer       ,intent(out) :: Status
+  character*3                :: MemOrd
+
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+    case ('xyz','xzy','yxz','yzx','zxy','zyx','xsz','xez','ysz','yez')
+      NDim = 3
+    case ('xy','yx','xs','xe','ys','ye')
+      NDim = 2
+    case ('z','c')
+      NDim = 1
+    case ('0')  ! NDim=0 for scalars.  TBH:  20060502
+      NDim = 0
+    case default
+      print *, 'memory order = ',MemOrd,'  ',MemoryOrder
+      Status = WRF_WARN_BAD_MEMORYORDER
+      return
+  end select
+  Status = WRF_NO_ERR
+  return
+end subroutine GetDim
+
+subroutine GetIndices(NDim,Start,End,i1,i2,j1,j2,k1,k2)
+  integer              ,intent(in)  :: NDim
+  integer ,dimension(*),intent(in)  :: Start,End
+  integer              ,intent(out) :: i1,i2,j1,j2,k1,k2
+
+  i1=1
+  i2=1
+  j1=1
+  j2=1
+  k1=1
+  k2=1
+  if(NDim == 0) return  ! NDim=0 for scalars.  TBH:  20060502
+  i1 = Start(1)
+  i2 = End  (1)
+  if(NDim == 1) return
+  j1 = Start(2)
+  j2 = End  (2)
+  if(NDim == 2) return
+  k1 = Start(3)
+  k2 = End  (3)
+  return
+end subroutine GetIndices
+
+subroutine ExtOrder(MemoryOrder,Vector,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  character*(*)              ,intent(in)    :: MemoryOrder
+  integer,dimension(*)       ,intent(inout) :: Vector
+  integer                    ,intent(out)   :: Status
+  integer                                   :: NDim
+  integer,dimension(NVarDims)               :: temp
+  character*3                               :: MemOrd
+
+  call GetDim(MemoryOrder,NDim,Status)
+  temp(1:NDim) = Vector(1:NDim)
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+
+    case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c')
+      continue
+    case ('0')
+      continue  ! NDim=0 for scalars.  TBH:  20060502
+    case ('xzy')
+      Vector(2) = temp(3)
+      Vector(3) = temp(2)
+    case ('yxz')
+      Vector(1) = temp(2)
+      Vector(2) = temp(1)
+    case ('yzx')
+      Vector(1) = temp(3)
+      Vector(2) = temp(1)
+      Vector(3) = temp(2)
+    case ('zxy')
+      Vector(1) = temp(2)
+      Vector(2) = temp(3)
+      Vector(3) = temp(1)
+    case ('zyx')
+      Vector(1) = temp(3)
+      Vector(3) = temp(1)
+    case ('yx')
+      Vector(1) = temp(2)
+      Vector(2) = temp(1)
+    case default
+      Status = WRF_WARN_BAD_MEMORYORDER
+      return
+  end select
+  Status = WRF_NO_ERR
+  return
+end subroutine ExtOrder
+
+subroutine ExtOrderStr(MemoryOrder,Vector,ROVector,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+  character*(*)                    ,intent(in)    :: MemoryOrder
+  character*(*),dimension(*)       ,intent(in)    :: Vector
+  character(80),dimension(NVarDims),intent(out)   :: ROVector
+  integer                          ,intent(out)   :: Status
+  integer                                         :: NDim
+  character*3                                     :: MemOrd
+
+  call GetDim(MemoryOrder,NDim,Status)
+  ROVector(1:NDim) = Vector(1:NDim)
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+
+    case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c')
+      continue
+    case ('0')
+      continue  ! NDim=0 for scalars.  TBH:  20060502
+    case ('xzy')
+      ROVector(2) = Vector(3)
+      ROVector(3) = Vector(2)
+    case ('yxz')
+      ROVector(1) = Vector(2)
+      ROVector(2) = Vector(1)
+    case ('yzx')
+      ROVector(1) = Vector(3)
+      ROVector(2) = Vector(1)
+      ROVector(3) = Vector(2)
+    case ('zxy')
+      ROVector(1) = Vector(2)
+      ROVector(2) = Vector(3)
+      ROVector(3) = Vector(1)
+    case ('zyx')
+      ROVector(1) = Vector(3)
+      ROVector(3) = Vector(1)
+    case ('yx')
+      ROVector(1) = Vector(2)
+      ROVector(2) = Vector(1)
+    case default
+      Status = WRF_WARN_BAD_MEMORYORDER
+      return
+  end select
+  Status = WRF_NO_ERR
+  return
+end subroutine ExtOrderStr
+
+
+subroutine LowerCase(MemoryOrder,MemOrd)
+  character*(*) ,intent(in)  :: MemoryOrder
+  character*(*) ,intent(out) :: MemOrd
+  character*1                :: c
+  integer       ,parameter   :: upper_to_lower =IACHAR('a')-IACHAR('A')
+  integer                    :: i,N
+
+  MemOrd = ' '
+  N = len(MemoryOrder)
+  MemOrd(1:N) = MemoryOrder(1:N)
+  do i=1,N
+    c = MemoryOrder(i:i)
+    if('A'<=c .and. c <='Z') MemOrd(i:i)=achar(iachar(c)+upper_to_lower)
+  enddo
+  return
+end subroutine LowerCase
+
+subroutine UpperCase(MemoryOrder,MemOrd)
+  character*(*) ,intent(in)  :: MemoryOrder
+  character*(*) ,intent(out) :: MemOrd
+  character*1                :: c
+  integer     ,parameter     :: lower_to_upper =IACHAR('A')-IACHAR('a')
+  integer                    :: i,N
+
+  MemOrd = ' '
+  N = len(MemoryOrder)
+  MemOrd(1:N) = MemoryOrder(1:N)
+  do i=1,N
+    c = MemoryOrder(i:i)
+    if('a'<=c .and. c <='z') MemOrd(i:i)=achar(iachar(c)+lower_to_upper)
+  enddo
+  return
+end subroutine UpperCase
+
+subroutine netcdf_err(err,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer  ,intent(in)  :: err
+  integer  ,intent(out) :: Status
+  character(len=80)     :: errmsg
+  integer               :: stat
+
+  if( err==NF_NOERR )then
+    Status = WRF_NO_ERR
+  else
+    errmsg = NFMPI_STRERROR(err) 
+    write(msg,*) 'NetCDF error: ',errmsg
+    call wrf_debug ( WARN , TRIM(msg))
+    Status = WRF_WARN_NETCDF
+  endif
+  return
+end subroutine netcdf_err
+
+subroutine FieldIO(IO,DataHandle,DateStr,Starts,Length,MemoryOrder &
+                     ,FieldType,NCID,VarID,XField,Status)
+  use wrf_data
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character (*)              ,intent(in)    :: IO
+  integer                    ,intent(in)    :: DataHandle
+  character*(*)              ,intent(in)    :: DateStr
+  integer,dimension(NVarDims),intent(in)    :: Starts
+  integer,dimension(NVarDims),intent(in)    :: Length
+  character*(*)              ,intent(in)    :: MemoryOrder
+  integer                    ,intent(in)    :: FieldType
+  integer                    ,intent(in)    :: NCID
+  integer                    ,intent(in)    :: VarID
+  integer,dimension(*)       ,intent(inout) :: XField
+  integer                    ,intent(out)   :: Status
+  integer                                   :: TimeIndex
+  integer                                   :: NDim
+  integer,dimension(NVarDims)               :: VStart
+  integer,dimension(NVarDims)               :: VCount
+
+  call GetTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    write(msg,*) '  Bad time index for DateStr = ',DateStr
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  call GetDim(MemoryOrder,NDim,Status)
+VStart(:) = 1
+VCount(:) = 1
+!jm for parallel netcef  VStart(1:NDim) = 1
+  VStart(1:NDim) = Starts(1:NDim)
+  VCount(1:NDim) = Length(1:NDim)
+  VStart(NDim+1) = TimeIndex
+  VCount(NDim+1) = 1
+  select case (FieldType)
+    case (WRF_REAL)
+      call ext_pnc_RealFieldIO    (IO,NCID,VarID,VStart,VCount,XField,Status)
+    case (WRF_DOUBLE)
+      call ext_pnc_DoubleFieldIO  (IO,NCID,VarID,VStart,VCount,XField,Status)
+    case (WRF_INTEGER)
+      call ext_pnc_IntFieldIO     (IO,NCID,VarID,VStart,VCount,XField,Status)
+    case (WRF_LOGICAL)
+      call ext_pnc_LogicalFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status)
+      if(Status /= WRF_NO_ERR) return
+    case default
+!for wrf_complex, double_complex
+      Status = WRF_WARN_DATA_TYPE_NOT_FOUND
+      write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+  end select
+  return
+end subroutine FieldIO
+
+subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
+                                      ,XField,x1,x2,y1,y2,z1,z2 &
+                                             ,i1,i2,j1,j2,k1,k2 )
+  character*(*)     ,intent(in)    :: IO
+  character*(*)     ,intent(in)    :: MemoryOrder
+  integer           ,intent(in)    :: l1,l2,m1,m2,n1,n2
+  integer           ,intent(in)    :: di
+  integer           ,intent(in)    :: x1,x2,y1,y2,z1,z2
+  integer           ,intent(in)    :: i1,i2,j1,j2,k1,k2
+  integer           ,intent(inout) ::  Field(di,l1:l2,m1:m2,n1:n2)
+!jm 010827  integer           ,intent(inout) :: XField(di,x1:x2,y1:y2,z1:z2)
+  integer           ,intent(inout) :: XField(di,(i2-i1+1)*(j2-j1+1)*(k2-k1+1))
+  character*3                      :: MemOrd
+  character*3                      :: MemO
+  integer           ,parameter     :: MaxUpperCase=IACHAR('Z')
+  integer                          :: i,j,k,ix,jx,kx
+
+  call LowerCase(MemoryOrder,MemOrd)
+  select case (MemOrd)
+
+!#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1))
+! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1))))
+
+    case ('xzy')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(i,k,j))
+#include "transpose.code"
+    case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c','0')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(i,j,k))
+#include "transpose.code"
+    case ('yxz')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(j,i,k))
+#include "transpose.code"
+    case ('zxy')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(k,i,j))
+#include "transpose.code"
+    case ('yzx')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(j,k,i))
+#include "transpose.code"
+    case ('zyx')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(k,j,i))
+#include "transpose.code"
+    case ('yx')
+#undef  DFIELD
+#define DFIELD XField(1:di,XDEX(j,i,k))
+#include "transpose.code"
+  end select
+  return
+end subroutine Transpose
+
+subroutine reorder (MemoryOrder,MemO)
+  character*(*)     ,intent(in)    :: MemoryOrder
+  character*3       ,intent(out)   :: MemO
+  character*3                      :: MemOrd
+  integer                          :: N,i,i1,i2,i3
+
+  MemO = MemoryOrder
+  N = len_trim(MemoryOrder)
+  if(N == 1) return
+  call lowercase(MemoryOrder,MemOrd)
+! never invert the boundary codes
+  select case ( MemOrd )
+     case ( 'xsz','xez','ysz','yez' )
+       return
+     case default
+       continue
+  end select
+  i1 = 1
+  i3 = 1
+  do i=2,N
+    if(ichar(MemOrd(i:i)) < ichar(MemOrd(i1:i1))) I1 = i
+    if(ichar(MemOrd(i:i)) > ichar(MemOrd(i3:i3))) I3 = i
+  enddo
+  if(N == 2) then
+    i2=i3
+  else
+    i2 = 6-i1-i3
+  endif
+  MemO(1:1) = MemoryOrder(i1:i1)
+  MemO(2:2) = MemoryOrder(i2:i2)
+  if(N == 3) MemO(3:3) = MemoryOrder(i3:i3)
+  if(MemOrd(i1:i1) == 's' .or. MemOrd(i1:i1) == 'e') then
+    MemO(1:N-1) = MemO(2:N)
+    MemO(N:N  ) = MemoryOrder(i1:i1)
+  endif
+  return
+end subroutine reorder
+  
+! Returns .TRUE. iff it is OK to write time-independent domain metadata to the 
+! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is 
+! returned.  
+LOGICAL FUNCTION ncd_ok_to_put_dom_ti( DataHandle )
+    USE wrf_data
+    include 'wrf_status_codes.h'
+    INTEGER, INTENT(IN) :: DataHandle 
+    CHARACTER*80 :: fname
+    INTEGER :: filestate
+    INTEGER :: Status
+    LOGICAL :: dryrun, first_output, retval
+    call ext_pnc_inquire_filename( DataHandle, fname, filestate, Status )
+    IF ( Status /= WRF_NO_ERR ) THEN
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+                   ', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg) )
+      retval = .FALSE.
+    ELSE
+      dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+      first_output = ncd_is_first_operation( DataHandle )
+      retval = .NOT. dryrun .AND. first_output
+    ENDIF
+    ncd_ok_to_put_dom_ti = retval
+    RETURN
+END FUNCTION ncd_ok_to_put_dom_ti
+
+! Returns .TRUE. iff it is OK to read time-independent domain metadata from the 
+! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is 
+! returned.  
+LOGICAL FUNCTION ncd_ok_to_get_dom_ti( DataHandle )
+    USE wrf_data
+    include 'wrf_status_codes.h'
+    INTEGER, INTENT(IN) :: DataHandle 
+    CHARACTER*80 :: fname
+    INTEGER :: filestate
+    INTEGER :: Status
+    LOGICAL :: dryrun, retval
+    call ext_pnc_inquire_filename( DataHandle, fname, filestate, Status )
+    IF ( Status /= WRF_NO_ERR ) THEN
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+                   ', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg) )
+      retval = .FALSE.
+    ELSE
+      dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+      retval = .NOT. dryrun
+    ENDIF
+    ncd_ok_to_get_dom_ti = retval
+    RETURN
+END FUNCTION ncd_ok_to_get_dom_ti
+
+! Returns .TRUE. iff nothing has been read from or written to the file 
+! referenced by DataHandle.  If DataHandle is invalid, .FALSE. is returned.  
+LOGICAL FUNCTION ncd_is_first_operation( DataHandle )
+    USE wrf_data
+    INCLUDE 'wrf_status_codes.h'
+    INTEGER, INTENT(IN) :: DataHandle 
+    TYPE(wrf_data_handle) ,POINTER :: DH
+    INTEGER :: Status
+    LOGICAL :: retval
+    CALL GetDH( DataHandle, DH, Status )
+    IF ( Status /= WRF_NO_ERR ) THEN
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
+                   ', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg) )
+      retval = .FALSE.
+    ELSE
+      retval = DH%first_operation
+    ENDIF
+    ncd_is_first_operation = retval
+    RETURN
+END FUNCTION ncd_is_first_operation
+
+end module ext_pnc_support_routines
+
+subroutine ext_pnc_open_for_read(DatasetName, Comm1, Comm2, SysDepInfo, DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character *(*), INTENT(IN)   :: DatasetName
+  integer       , INTENT(IN)   :: Comm1, Comm2
+  character *(*), INTENT(IN)   :: SysDepInfo
+  integer       , INTENT(OUT)  :: DataHandle
+  integer       , INTENT(OUT)  :: Status
+  DataHandle = 0   ! dummy setting to quiet warning message
+  CALL ext_pnc_open_for_read_begin( DatasetName, Comm1, Comm2, SysDepInfo, DataHandle, Status )
+  IF ( Status .EQ. WRF_NO_ERR ) THEN
+    CALL ext_pnc_open_for_read_commit( DataHandle, Status )
+  ENDIF
+  return
+end subroutine ext_pnc_open_for_read
+
+!ends training phase; switches internal flag to enable input
+!must be paired with call to ext_pnc_open_for_read_begin
+subroutine ext_pnc_open_for_read_commit(DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer, intent(in) :: DataHandle
+  integer, intent(out) :: Status
+  type(wrf_data_handle) ,pointer         :: DH
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED
+    write(msg,*) 'ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus      = WRF_FILE_OPENED_FOR_READ
+  DH%first_operation  = .TRUE.
+  Status = WRF_NO_ERR
+  return
+end subroutine ext_pnc_open_for_read_commit
+
+subroutine ext_pnc_open_for_read_begin( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character*(*)         ,intent(IN)      :: FileName
+  integer               ,intent(IN)      :: Comm
+  integer               ,intent(IN)      :: IOComm
+  character*(*)         ,intent(in)      :: SysDepInfo
+  integer               ,intent(out)     :: DataHandle
+  integer               ,intent(out)     :: Status
+  type(wrf_data_handle) ,pointer         :: DH
+  integer                                :: XType
+  integer                                :: stat
+  integer               ,allocatable     :: Buffer(:)
+  integer                                :: VarID
+  integer                                :: StoredDim
+  integer                                :: NAtts
+  integer                                :: DimIDs(2)
+  integer(KIND=MPI_OFFSET_KIND)          :: VStart(2)
+  integer(KIND=MPI_OFFSET_KIND)          :: VLen(2)
+  integer                                :: TotalNumVars
+  integer                                :: NumVars
+  integer                                :: i
+  character (NF_MAX_NAME)                :: Name
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call allocHandle(DataHandle,DH,Comm,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_OPEN(Comm, FileName, NF_NOWRITE, MPI_INFO_NULL, DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_VARID(DH%NCID,DH%TimesName,VarID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_VAR(DH%NCID,VarID,DH%TimesName, XType, StoredDim, DimIDs, NAtts)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(XType/=NF_CHAR) then
+    Status = WRF_WARN_TYPE_MISMATCH
+    write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_DIMLEN(DH%NCID,DimIDs(1),VLen(1))  
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(VLen(1) /= DateStrLen) then
+    Status = WRF_WARN_DATESTR_BAD_LENGTH
+    write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_DIMLEN(DH%NCID,DimIDs(2),VLen(2))
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(VLen(2) > MaxTimes) then
+    Status = WRF_ERR_FATAL_TOO_MANY_TIMES
+    write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  VStart(1) = 1
+  VStart(2) = 1
+  stat = NFMPI_GET_VARA_TEXT_ALL(DH%NCID,VarID,VStart,VLen,DH%Times)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_NVARS(DH%NCID,TotalNumVars)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  NumVars = 0
+  do i=1,TotalNumVars
+    stat = NFMPI_INQ_VARNAME(DH%NCID,i,Name)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then
+      NumVars              = NumVars+1
+      DH%VarNames(NumVars) = Name
+      DH%VarIDs(NumVars)   = i
+    endif      
+  enddo
+  DH%NumVars         = NumVars
+  DH%NumberTimes     = VLen(2)
+  DH%FileStatus      = WRF_FILE_OPENED_NOT_COMMITTED
+  DH%FileName        = FileName
+  DH%CurrentVariable = 0
+  DH%CurrentTime     = 0
+  DH%TimesVarID      = VarID
+  DH%TimeIndex       = 0
+  return
+end subroutine ext_pnc_open_for_read_begin
+
+subroutine ext_pnc_open_for_update( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character*(*)         ,intent(IN)      :: FileName
+  integer               ,intent(IN)      :: Comm
+  integer               ,intent(IN)      :: IOComm
+  character*(*)         ,intent(in)      :: SysDepInfo
+  integer               ,intent(out)     :: DataHandle
+  integer               ,intent(out)     :: Status
+  type(wrf_data_handle) ,pointer         :: DH
+  integer                                :: XType
+  integer                                :: stat
+  integer               ,allocatable     :: Buffer(:)
+  integer                                :: VarID
+  integer                                :: StoredDim
+  integer                                :: NAtts
+  integer                                :: DimIDs(2)
+  integer                                :: VStart(2)
+  integer                                :: VLen(2)
+  integer                                :: TotalNumVars
+  integer                                :: NumVars
+  integer                                :: i
+  character (NF_MAX_NAME)                :: Name
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call allocHandle(DataHandle,DH,Comm,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_OPEN(Comm, FileName, NF_WRITE, MPI_INFO_NULL, DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_VARID(DH%NCID,DH%TimesName,VarID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_VAR(DH%NCID,VarID,DH%TimesName, XType, StoredDim, DimIDs, NAtts)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(XType/=NF_CHAR) then
+    Status = WRF_WARN_TYPE_MISMATCH
+    write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_DIMLEN(DH%NCID,DimIDs(1),VLen(1))  
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(VLen(1) /= DateStrLen) then
+    Status = WRF_WARN_DATESTR_BAD_LENGTH
+    write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_DIMLEN(DH%NCID,DimIDs(2),VLen(2))
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(VLen(2) > MaxTimes) then
+    Status = WRF_ERR_FATAL_TOO_MANY_TIMES
+    write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  VStart(1) = 1
+  VStart(2) = 1
+  stat = NFMPI_GET_VARA_TEXT_ALL(DH%NCID,VarID,VStart,VLen,DH%Times)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_INQ_NVARS(DH%NCID,TotalNumVars)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  NumVars = 0
+  do i=1,TotalNumVars
+    stat = NFMPI_INQ_VARNAME(DH%NCID,i,Name)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then
+      NumVars              = NumVars+1
+      DH%VarNames(NumVars) = Name
+      DH%VarIDs(NumVars)   = i
+    endif      
+  enddo
+  DH%NumVars         = NumVars
+  DH%NumberTimes     = VLen(2)
+  DH%FileStatus      = WRF_FILE_OPENED_FOR_UPDATE
+  DH%FileName        = FileName
+  DH%CurrentVariable = 0
+  DH%CurrentTime     = 0
+  DH%TimesVarID      = VarID
+  DH%TimeIndex       = 0
+  return
+end subroutine ext_pnc_open_for_update
+
+
+SUBROUTINE ext_pnc_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,DataHandle,Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character*(*)        ,intent(in)  :: FileName
+  integer              ,intent(in)  :: Comm
+  integer              ,intent(in)  :: IOComm
+  character*(*)        ,intent(in)  :: SysDepInfo
+  integer              ,intent(out) :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: i
+  integer                           :: stat
+  character (7)                     :: Buffer
+  integer                           :: VDimIDs(2)
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_pnc_open_for_write_begin: ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call allocHandle(DataHandle,DH,Comm,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Fatal ALLOCATION ERROR in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  DH%TimeIndex = 0
+  DH%Times     = ZeroDate
+  stat = NFMPI_CREATE(Comm, FileName, NF_CLOBBER, MPI_INFO_NULL, DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus  = WRF_FILE_OPENED_NOT_COMMITTED
+  DH%FileName    = FileName
+  stat = NFMPI_DEF_DIM(DH%NCID,DH%DimUnlimName,i2offset(NF_UNLIMITED),DH%DimUnlimID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%VarNames  (1:MaxVars) = NO_NAME
+  DH%MDVarNames(1:MaxVars) = NO_NAME
+  do i=1,MaxDims
+    write(Buffer,FMT="('DIM',i4.4)") i
+    DH%DimNames  (i) = Buffer
+    DH%DimLengths(i) = NO_DIM
+  enddo
+  DH%DimNames(1) = 'DateStrLen'
+  stat = NFMPI_DEF_DIM(DH%NCID,DH%DimNames(1),i2offset(DateStrLen),DH%DimIDs(1))
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  VDimIDs(1) = DH%DimIDs(1)
+  VDimIDs(2) = DH%DimUnlimID
+  stat = NFMPI_DEF_VAR(DH%NCID,DH%TimesName,NF_CHAR,2,VDimIDs,DH%TimesVarID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%DimLengths(1) = DateStrLen
+  return
+end subroutine ext_pnc_open_for_write_begin
+
+!stub
+!opens a file for writing or coupler datastream for sending messages.
+!no training phase for this version of the open stmt.
+subroutine ext_pnc_open_for_write (DatasetName, Comm1, Comm2, &
+                                   SysDepInfo, DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  character *(*), intent(in)  ::DatasetName
+  integer       , intent(in)  ::Comm1, Comm2
+  character *(*), intent(in)  ::SysDepInfo
+  integer       , intent(out) :: DataHandle
+  integer       , intent(out) :: Status
+  Status=WRF_WARN_NOOP
+  DataHandle = 0    ! dummy setting to quiet warning message
+  return
+end subroutine ext_pnc_open_for_write
+
+SUBROUTINE ext_pnc_open_for_write_commit(DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: i
+  integer                           :: stat
+
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_pnc_open_for_write_commit: ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ext_pnc_open_for_write_commit ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg)) 
+    return
+  endif
+  stat = NFMPI_ENDDEF(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_pnc_open_for_write_commit ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus  = WRF_FILE_OPENED_FOR_WRITE
+  DH%first_operation  = .TRUE.
+  return
+end subroutine ext_pnc_open_for_write_commit
+
+subroutine ext_pnc_ioclose(DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: stat
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ext_pnc_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ext_pnc_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_CLOSE
+    write(msg,*) 'Warning TRY TO CLOSE DRYRUN in ext_pnc_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    continue    
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    continue
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
+    continue
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ext_pnc_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+
+  stat = NFMPI_CLOSE(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_pnc_ioclose ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  CALL deallocHandle( DataHandle, Status )
+  DH%Free=.true.
+  return
+end subroutine ext_pnc_ioclose
+
+subroutine ext_pnc_iosync( DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: stat
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ext_pnc_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ext_pnc_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_FILE_NOT_COMMITTED
+    write(msg,*) 'Warning FILE NOT COMMITTED in ext_pnc_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    continue
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    continue
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ext_pnc_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_SYNC(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ext_pnc_iosync ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  return
+end subroutine ext_pnc_iosync
+
+
+
+subroutine ext_pnc_redef( DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: stat
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_FILE_NOT_COMMITTED
+    write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    continue
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_FILE_OPEN_FOR_READ
+    write(msg,*) 'Warning FILE OPEN FOR READ in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_REDEF(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus  = WRF_FILE_OPENED_NOT_COMMITTED
+  return
+end subroutine ext_pnc_redef
+
+subroutine ext_pnc_enddef( DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer              ,intent(in)  :: DataHandle
+  integer              ,intent(out) :: Status
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: stat
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_FILE_NOT_COMMITTED
+    write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    continue
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_FILE_OPEN_FOR_READ
+    write(msg,*) 'Warning FILE OPEN FOR READ in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , TRIM(msg))
+    return
+  endif
+  stat = NFMPI_ENDDEF(DH%NCID)
+  call netcdf_err(stat,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  DH%FileStatus  = WRF_FILE_OPENED_FOR_WRITE
+  return
+end subroutine ext_pnc_enddef
+
+subroutine ext_pnc_ioinit(SysDepInfo, Status)
+  use wrf_data
+  implicit none
+  include 'wrf_status_codes.h'
+  CHARACTER*(*), INTENT(IN) :: SysDepInfo
+  INTEGER ,INTENT(INOUT)    :: Status
+
+  WrfIOnotInitialized                             = .false.
+  WrfDataHandles(1:WrfDataHandleMax)%Free         = .true.
+  WrfDataHandles(1:WrfDataHandleMax)%TimesName    = 'Times'
+  WrfDataHandles(1:WrfDataHandleMax)%DimUnlimName = 'Time'
+  WrfDataHandles(1:WrfDataHandleMax)%FileStatus   = WRF_FILE_NOT_OPENED
+  Status = WRF_NO_ERR
+  return
+end subroutine ext_pnc_ioinit
+
+
+subroutine ext_pnc_inquiry (Inquiry, Result, Status)
+  use wrf_data
+  implicit none
+  include 'wrf_status_codes.h'
+  character *(*), INTENT(IN)    :: Inquiry
+  character *(*), INTENT(OUT)   :: Result
+  integer        ,INTENT(INOUT) :: Status
+  SELECT CASE (Inquiry)
+  CASE ("RANDOM_WRITE","RANDOM_READ","SEQUENTIAL_WRITE","SEQUENTIAL_READ")
+        Result='ALLOW'
+  CASE ("OPEN_READ","OPEN_COMMIT_WRITE")
+        Result='REQUIRE'
+  CASE ("OPEN_WRITE","OPEN_COMMIT_READ","PARALLEL_IO")
+        Result='NO'
+  CASE ("SELF_DESCRIBING","SUPPORT_METADATA","SUPPORT_3D_FIELDS")
+        Result='YES'
+  CASE ("MEDIUM")
+        Result ='FILE'
+  CASE DEFAULT
+      Result = 'No Result for that inquiry!'
+  END SELECT
+  Status=WRF_NO_ERR
+  return
+end subroutine ext_pnc_inquiry
+
+
+
+
+subroutine ext_pnc_ioexit(Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer       , INTENT(INOUT)     ::Status
+  integer                           :: error
+  type(wrf_data_handle),pointer     :: DH
+  integer                           :: i
+  integer                           :: stat
+  if(WrfIOnotInitialized) then
+    Status = WRF_IO_NOT_INITIALIZED 
+    write(msg,*) 'ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
+    call wrf_debug ( FATAL , msg)
+    return
+  endif
+  do i=1,WrfDataHandleMax
+    CALL deallocHandle( i , stat ) 
+  enddo
+  return
+end subroutine ext_pnc_ioexit
+
+subroutine ext_pnc_get_dom_ti_real(DataHandle,Element,Data,Count,OutCount,Status)
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA real,intent(out) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCOunt
+#define TYPE_BUFFER  real,allocatable :: Buffer(:)
+#define NF_TYPE NF_FLOAT
+#define NF_ROUTINE NFMPI_GET_ATT_REAL 
+#define COPY   Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
+#include "ext_pnc_get_dom_ti.code"
+end subroutine ext_pnc_get_dom_ti_real
+
+subroutine ext_pnc_get_dom_ti_integer(DataHandle,Element,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA 
+#undef TYPE_BUFFER
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA integer,intent(out) :: Data(*)
+#define TYPE_BUFFER  integer,allocatable :: Buffer(:)
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NFMPI_GET_ATT_INT
+#define COPY   Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
+#include "ext_pnc_get_dom_ti.code"
+end subroutine ext_pnc_get_dom_ti_integer
+
+subroutine ext_pnc_get_dom_ti_double(DataHandle,Element,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA 
+#undef TYPE_BUFFER
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA real*8,intent(out) :: Data(*)
+#define TYPE_BUFFER  real*8,allocatable :: Buffer(:)
+#define NF_TYPE NF_DOUBLE
+#define NF_ROUTINE NFMPI_GET_ATT_DOUBLE
+#define COPY   Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
+#include "ext_pnc_get_dom_ti.code"
+end subroutine ext_pnc_get_dom_ti_double
+
+subroutine ext_pnc_get_dom_ti_logical(DataHandle,Element,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA 
+#undef TYPE_BUFFER
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA logical,intent(out) :: Data(*)
+#define TYPE_BUFFER  integer,allocatable :: Buffer(:)
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NFMPI_GET_ATT_INT
+#define COPY   Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))==1
+#include "ext_pnc_get_dom_ti.code"
+end subroutine ext_pnc_get_dom_ti_logical
+
+subroutine ext_pnc_get_dom_ti_char(DataHandle,Element,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef TYPE_BUFFER
+#undef NF_TYPE
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA character*(*),intent(out) :: Data
+#define TYPE_COUNT
+#define TYPE_OUTCOUNT
+#define TYPE_BUFFER
+#define NF_TYPE NF_CHAR
+#define CHAR_TYPE
+#include "ext_pnc_get_dom_ti.code"
+#undef CHAR_TYPE
+end subroutine ext_pnc_get_dom_ti_char
+
+subroutine ext_pnc_put_dom_ti_real(DataHandle,Element,Data,Count,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA 
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA  real   ,intent(in) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_ATT_REAL
+#define ARGS NF_FLOAT,i2offset(Count),Data
+#include "ext_pnc_put_dom_ti.code"
+end subroutine ext_pnc_put_dom_ti_real
+
+subroutine ext_pnc_put_dom_ti_integer(DataHandle,Element,Data,Count,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA  integer,intent(in) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_ATT_INT
+#define ARGS NF_INT,i2offset(Count),Data
+#include "ext_pnc_put_dom_ti.code"
+end subroutine ext_pnc_put_dom_ti_integer
+
+subroutine ext_pnc_put_dom_ti_double(DataHandle,Element,Data,Count,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA  real*8 ,intent(in) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_ATT_DOUBLE
+#define ARGS NF_DOUBLE,i2offset(Count),Data
+#include "ext_pnc_put_dom_ti.code"
+end subroutine ext_pnc_put_dom_ti_double
+
+subroutine ext_pnc_put_dom_ti_logical(DataHandle,Element,Data,Count,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA  logical,intent(in) :: Data(*)
+#define TYPE_COUNT integer,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_ATT_INT
+#define ARGS NF_INT,i2offset(Count),Buffer
+#define LOG
+#include "ext_pnc_put_dom_ti.code"
+end subroutine ext_pnc_put_dom_ti_logical
+
+subroutine ext_pnc_put_dom_ti_char(DataHandle,Element,Data,Status)
+#undef ROUTINE_TYPE 
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA  character*(*),intent(in) :: Data
+#define TYPE_COUNT integer,parameter :: Count=1
+#define NF_ROUTINE NFMPI_PUT_ATT_TEXT
+#define ARGS i2offset(len_trim(Data)),Data
+#include "ext_pnc_put_dom_ti.code"
+end subroutine ext_pnc_put_dom_ti_char
+
+subroutine ext_pnc_put_var_ti_real(DataHandle,Element,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA  real    ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_ATT_REAL
+#define ARGS NF_FLOAT,i2offset(Count),Data
+#include "ext_pnc_put_var_ti.code"
+end subroutine ext_pnc_put_var_ti_real
+
+subroutine ext_pnc_put_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#undef LOG
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA  real    ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_VARA_REAL_ALL
+#define NF_TYPE NF_FLOAT
+#define LENGTH Count
+#define ARG 
+#include "ext_pnc_put_var_td.code"
+end subroutine ext_pnc_put_var_td_real
+
+subroutine ext_pnc_put_var_ti_double(DataHandle,Element,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA  real*8 ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_ATT_DOUBLE
+#define ARGS NF_DOUBLE,i2offset(Count),Data
+#include "ext_pnc_put_var_ti.code"
+end subroutine ext_pnc_put_var_ti_double
+
+subroutine ext_pnc_put_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#undef LOG
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA  real*8,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_VARA_DOUBLE_ALL
+#define NF_TYPE NF_DOUBLE
+#define LENGTH Count
+#define ARG 
+#include "ext_pnc_put_var_td.code"
+end subroutine ext_pnc_put_var_td_double
+
+subroutine ext_pnc_put_var_ti_integer(DataHandle,Element,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA  integer ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_ATT_INT
+#define ARGS NF_INT,i2offset(Count),Data 
+#include "ext_pnc_put_var_ti.code"
+end subroutine ext_pnc_put_var_ti_integer
+
+subroutine ext_pnc_put_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#undef LOG
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA  integer ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_VARA_INT_ALL
+#define NF_TYPE NF_INT
+#define LENGTH Count
+#define ARG 
+#include "ext_pnc_put_var_td.code"
+end subroutine ext_pnc_put_var_td_integer
+
+subroutine ext_pnc_put_var_ti_logical(DataHandle,Element,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS 
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA  logical ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_ATT_INT
+#define LOG
+#define ARGS NF_INT,i2offset(Count),Buffer
+#include "ext_pnc_put_var_ti.code"
+end subroutine ext_pnc_put_var_ti_logical
+
+subroutine ext_pnc_put_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA  logical ,intent(in) :: Data(*)
+#define TYPE_COUNT integer ,intent(in) :: Count
+#define NF_ROUTINE NFMPI_PUT_VARA_INT_ALL
+#define NF_TYPE NF_INT
+#define LOG
+#define LENGTH Count
+#define ARG 
+#include "ext_pnc_put_var_td.code"
+end subroutine ext_pnc_put_var_td_logical
+
+subroutine ext_pnc_put_var_ti_char(DataHandle,Element,Var,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef ARGS
+#undef LOG
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA  character*(*) ,intent(in) :: Data
+#define TYPE_COUNT 
+#define NF_ROUTINE NFMPI_PUT_ATT_TEXT
+#define ARGS i2offset(len_trim(Data)),trim(Data)
+#define CHAR_TYPE
+#include "ext_pnc_put_var_ti.code"
+#undef CHAR_TYPE
+end subroutine ext_pnc_put_var_ti_char
+
+subroutine ext_pnc_put_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_COUNT
+#undef NF_ROUTINE
+#undef NF_TYPE
+#undef LENGTH
+#undef ARG
+#undef LOG
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA  character*(*) ,intent(in) :: Data
+#define TYPE_COUNT 
+#define NF_ROUTINE NFMPI_PUT_VARA_TEXT_ALL
+#define NF_TYPE NF_CHAR
+#define LENGTH len(Data)
+#include "ext_pnc_put_var_td.code"
+end subroutine ext_pnc_put_var_td_char
+
+subroutine ext_pnc_get_var_ti_real(DataHandle,Element,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA     real   ,intent(out) :: Data(*)
+#define TYPE_BUFFER   real   ,allocatable :: Buffer(:)
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_FLOAT
+#define NF_ROUTINE NFMPI_GET_ATT_REAL
+#define COPY   Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
+#include "ext_pnc_get_var_ti.code"
+end subroutine ext_pnc_get_var_ti_real
+
+subroutine ext_pnc_get_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#undef COPY
+#define ROUTINE_TYPE 'REAL'
+#define TYPE_DATA     real   ,intent(out) :: Data(*)
+#define TYPE_BUFFER real
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_FLOAT
+#define NF_ROUTINE NFMPI_GET_VARA_REAL_ALL
+#define LENGTH min(Count,Len1)
+#define COPY   Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
+#include "ext_pnc_get_var_td.code"
+end subroutine ext_pnc_get_var_td_real
+
+subroutine ext_pnc_get_var_ti_double(DataHandle,Element,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA     real*8 ,intent(out) :: Data(*)
+#define TYPE_BUFFER   real*8 ,allocatable :: Buffer(:)
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_DOUBLE
+#define NF_ROUTINE NFMPI_GET_ATT_DOUBLE
+#define COPY   Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
+#include "ext_pnc_get_var_ti.code"
+end subroutine ext_pnc_get_var_ti_double
+
+subroutine ext_pnc_get_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#undef COPY
+#define ROUTINE_TYPE 'DOUBLE'
+#define TYPE_DATA     real*8 ,intent(out) :: Data(*)
+#define TYPE_BUFFER real*8
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_DOUBLE
+#define NF_ROUTINE NFMPI_GET_VARA_DOUBLE_ALL
+#define LENGTH min(Count,Len1)
+#define COPY   Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
+#include "ext_pnc_get_var_td.code"
+end subroutine ext_pnc_get_var_td_double
+
+subroutine ext_pnc_get_var_ti_integer(DataHandle,Element,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA     integer,intent(out) :: Data(*)
+#define TYPE_BUFFER   integer,allocatable :: Buffer(:)
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NFMPI_GET_ATT_INT
+#define COPY   Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
+#include "ext_pnc_get_var_ti.code"
+end subroutine ext_pnc_get_var_ti_integer
+
+subroutine ext_pnc_get_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#undef COPY
+#define ROUTINE_TYPE 'INTEGER'
+#define TYPE_DATA     integer,intent(out) :: Data(*)
+#define TYPE_BUFFER integer
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NFMPI_GET_VARA_INT_ALL
+#define LENGTH min(Count,Len1)
+#define COPY   Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
+#include "ext_pnc_get_var_td.code"
+end subroutine ext_pnc_get_var_td_integer
+
+subroutine ext_pnc_get_var_ti_logical(DataHandle,Element,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA     logical,intent(out) :: Data(*)
+#define TYPE_BUFFER   integer,allocatable :: Buffer(:)
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NFMPI_GET_ATT_INT
+#define COPY   Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))==1
+#include "ext_pnc_get_var_ti.code"
+end subroutine ext_pnc_get_var_ti_logical
+
+subroutine ext_pnc_get_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#undef COPY
+#define ROUTINE_TYPE 'LOGICAL'
+#define TYPE_DATA     logical,intent(out) :: Data(*)
+#define TYPE_BUFFER   integer
+#define TYPE_COUNT    integer,intent(in)  :: Count
+#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
+#define NF_TYPE NF_INT
+#define NF_ROUTINE NFMPI_GET_VARA_INT_ALL
+#define LENGTH min(Count,Len1)
+#define COPY   Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))==1
+#include "ext_pnc_get_var_td.code"
+end subroutine ext_pnc_get_var_td_logical
+
+subroutine ext_pnc_get_var_ti_char(DataHandle,Element,Var,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef COPY
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA   character*(*) ,intent(out) :: Data
+#define TYPE_BUFFER
+#define TYPE_COUNT integer :: Count = 1
+#define TYPE_OUTCOUNT
+#define NF_TYPE NF_CHAR
+#define NF_ROUTINE NFMPI_GET_ATT_TEXT
+#define COPY 
+#define CHAR_TYPE
+#include "ext_pnc_get_var_ti.code"
+#undef CHAR_TYPE
+end subroutine ext_pnc_get_var_ti_char
+
+subroutine ext_pnc_get_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
+#undef ROUTINE_TYPE
+#undef TYPE_DATA
+#undef TYPE_BUFFER
+#undef TYPE_COUNT
+#undef TYPE_OUTCOUNT
+#undef NF_TYPE
+#undef NF_ROUTINE
+#undef LENGTH
+#define ROUTINE_TYPE 'CHAR'
+#define TYPE_DATA character*(*) ,intent(out)    :: Data
+#define TYPE_BUFFER character (80)
+#define TYPE_COUNT integer :: Count = 1
+#define TYPE_OUTCOUNT
+#define NF_TYPE NF_CHAR
+#define NF_ROUTINE NFMPI_GET_VARA_TEXT_ALL
+#define LENGTH Len1
+#define CHAR_TYPE
+#include "ext_pnc_get_var_td.code"
+#undef CHAR_TYPE
+end subroutine ext_pnc_get_var_td_char
+
+subroutine ext_pnc_put_dom_td_real(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real                  ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_pnc_put_var_td_real(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status)
+  return
+end subroutine ext_pnc_put_dom_td_real
+
+subroutine ext_pnc_put_dom_td_integer(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  integer               ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_pnc_put_var_td_integer(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,Status)
+  return
+end subroutine ext_pnc_put_dom_td_integer
+
+subroutine ext_pnc_put_dom_td_double(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real*8                ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_pnc_put_var_td_double(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'   ,Data,Count,Status)
+  return
+end subroutine ext_pnc_put_dom_td_double
+
+subroutine ext_pnc_put_dom_td_logical(DataHandle,Element,DateStr,Data,Count,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  logical               ,intent(in)     :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: Status
+
+  call ext_pnc_put_var_td_logical(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,Status)
+  return
+end subroutine ext_pnc_put_dom_td_logical
+
+subroutine ext_pnc_put_dom_td_char(DataHandle,Element,DateStr,Data,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  character*(*)         ,intent(in)     :: Data
+  integer               ,intent(out)    :: Status
+
+  call ext_pnc_put_var_td_char(DataHandle,Element,DateStr, &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
+  return
+end subroutine ext_pnc_put_dom_td_char
+
+subroutine ext_pnc_get_dom_td_real(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real                  ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  call ext_pnc_get_var_td_real(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status)
+  return
+end subroutine ext_pnc_get_dom_td_real
+
+subroutine ext_pnc_get_dom_td_integer(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  integer               ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  call ext_pnc_get_var_td_integer(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,OutCount,Status)
+  return
+end subroutine ext_pnc_get_dom_td_integer
+
+subroutine ext_pnc_get_dom_td_double(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  real*8                ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  call ext_pnc_get_var_td_double(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'   ,Data,Count,OutCount,Status)
+  return
+end subroutine ext_pnc_get_dom_td_double
+
+subroutine ext_pnc_get_dom_td_logical(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  logical               ,intent(out)    :: Data(*)
+  integer               ,intent(in)     :: Count
+  integer               ,intent(out)    :: OutCount
+  integer               ,intent(out)    :: Status
+  call ext_pnc_get_var_td_logical(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,OutCount,Status)
+  return
+end subroutine ext_pnc_get_dom_td_logical
+
+subroutine ext_pnc_get_dom_td_char(DataHandle,Element,DateStr,Data,Status)
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Element
+  character*(*)         ,intent(in)     :: DateStr
+  character*(*)         ,intent(out)    :: Data
+  integer               ,intent(out)    :: Status
+  call ext_pnc_get_var_td_char(DataHandle,Element,DateStr,          &
+       'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
+  return
+end subroutine ext_pnc_get_dom_td_char
+
+
+subroutine ext_pnc_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm, &
+  IOComm, DomainDesc, MemoryOrdIn, Stagger,  DimNames,                      &
+  DomainStart,DomainEnd,MemoryStart,MemoryEnd,PatchStart,PatchEnd,Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer                       ,intent(in)    :: DataHandle
+  character*(*)                 ,intent(in)    :: DateStr
+  character*(*)                 ,intent(in)    :: Var
+  integer                       ,intent(inout) :: Field(*)
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrdIn
+  character*(*)                 ,intent(in)    :: Stagger ! Dummy for now
+  character*(*) ,dimension(*)   ,intent(in)    :: DimNames
+  integer       ,dimension(*)   ,intent(in)    :: DomainStart, DomainEnd
+  integer       ,dimension(*)   ,intent(in)    :: MemoryStart, MemoryEnd
+  integer       ,dimension(*)   ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+  character (3)                                :: MemoryOrder
+  type(wrf_data_handle)         ,pointer       :: DH
+  integer                                      :: NCID
+  integer                                      :: NDim
+  character (VarNameLen)                       :: VarName
+  character (3)                                :: MemO
+  character (3)                                :: UCMemO
+  integer                                      :: VarID
+  integer      ,dimension(NVarDims)            :: Length_global
+  integer      ,dimension(NVarDims)            :: Length
+  integer      ,dimension(NVarDims)            :: VDimIDs
+  character(80),dimension(NVarDims)            :: RODimNames
+  integer      ,dimension(NVarDims)            :: StoredStart
+  integer      ,dimension(:,:,:,:),allocatable :: XField
+  integer                                      :: stat
+  integer                                      :: NVar
+  integer                                      :: i,j
+  integer                                      :: i1,i2,j1,j2,k1,k2
+  integer                                      :: x1,x2,y1,y2,z1,z2
+  integer                                      :: l1,l2,m1,m2,n1,n2
+  integer                                      :: XType
+  integer                                      :: di
+  character (80)                               :: NullName
+  logical                                      :: NotFound
+
+  MemoryOrder = trim(adjustl(MemoryOrdIn))
+  NullName=char(0)
+  call GetDim(MemoryOrder,NDim,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning BAD MEMORY ORDER |',MemoryOrder,'| in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning DATE STRING ERROR |',DateStr,'| in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  VarName = Var
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  NCID = DH%NCID
+
+  write(msg,*)'ext_pnc_write_field: called for ',TRIM(Var)
+
+!jm 20061024
+  Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
+  Length_global(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1
+
+
+  call ExtOrder(MemoryOrder,Length,Status)
+  call ExtOrder(MemoryOrder,Length_global,Status)
+
+  call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status)
+
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    Status = WRF_WARN_WRITE_RONLY_FILE
+    write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    do NVar=1,MaxVars
+      if(DH%VarNames(NVar) == VarName ) then
+        Status = WRF_WARN_2DRYRUNS_1VARIABLE
+        write(msg,*) 'Warning 2 DRYRUNS 1 VARIABLE in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      elseif(DH%VarNames(NVar) == NO_NAME) then
+        DH%VarNames(NVar) = VarName
+        DH%NumVars        = NVar
+        exit
+      elseif(NVar == MaxVars) then
+        Status = WRF_WARN_TOO_MANY_VARIABLES
+        write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+    do j = 1,NDim
+      if(RODimNames(j) == NullName .or. RODimNames(j) == '') then
+        do i=1,MaxDims
+          if(DH%DimLengths(i) == Length_global(j)) then
+            exit
+          elseif(DH%DimLengths(i) == NO_DIM) then
+            stat = NFMPI_DEF_DIM(NCID,DH%DimNames(i),i2offset(Length_global(j)),DH%DimIDs(i))
+            call netcdf_err(stat,Status)
+            if(Status /= WRF_NO_ERR) then
+              write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+              call wrf_debug ( WARN , TRIM(msg))
+              return
+            endif
+            DH%DimLengths(i) = Length_global(j)
+            exit
+          elseif(i == MaxDims) then
+            Status = WRF_WARN_TOO_MANY_DIMS
+            write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ 
+            call wrf_debug ( WARN , TRIM(msg))
+            return
+          endif
+        enddo
+      else !look for input name and check if already defined
+        NotFound = .true.
+        do i=1,MaxDims
+          if (DH%DimNames(i) == RODimNames(j)) then
+            if (DH%DimLengths(i) == Length_global(j)) then
+              NotFound = .false.
+              exit
+            else
+              Status = WRF_WARN_DIMNAME_REDEFINED
+              write(msg,*) 'Warning DIM ',i,', NAME ',TRIM(DH%DimNames(i)),' REDIFINED  by var ', &
+                           TRIM(Var),' ',DH%DimLengths(i),Length_global(j) ,' in ', __FILE__ ,' line', __LINE__ 
+              call wrf_debug ( WARN , TRIM(msg))
+              return
+            endif
+          endif
+        enddo
+        if (NotFound) then
+          do i=1,MaxDims
+            if (DH%DimLengths(i) == NO_DIM) then
+              DH%DimNames(i) = RODimNames(j)
+              stat = NFMPI_DEF_DIM(NCID,DH%DimNames(i),i2offset(Length_global(j)),DH%DimIDs(i))
+              call netcdf_err(stat,Status)
+              if(Status /= WRF_NO_ERR) then
+                write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
+                call wrf_debug ( WARN , TRIM(msg))
+                return
+              endif
+              DH%DimLengths(i) = Length_global(j)
+              exit
+            elseif(i == MaxDims) then
+              Status = WRF_WARN_TOO_MANY_DIMS
+              write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ 
+              call wrf_debug ( WARN , TRIM(msg))
+              return
+            endif
+          enddo
+        endif
+      endif
+      VDimIDs(j) = DH%DimIDs(i)
+      DH%VarDimLens(j,NVar) = Length_global(j)
+    enddo
+    VDimIDs(NDim+1) = DH%DimUnlimID
+    select case (FieldType)
+      case (WRF_REAL)
+        XType = NF_FLOAT
+      case (WRF_DOUBLE)
+        Xtype = NF_DOUBLE
+      case (WRF_INTEGER)
+        XType = NF_INT
+      case (WRF_LOGICAL)
+        XType = NF_INT
+      case default
+        Status = WRF_WARN_DATA_TYPE_NOT_FOUND
+        write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+    end select
+
+
+    stat = NFMPI_DEF_VAR(NCID,VarName,XType,NDim+1,VDimIDs,VarID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'ext_pnc_write_field: NetCDF error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    DH%VarIDs(NVar) = VarID
+    stat = NFMPI_PUT_ATT_INT(NCID,VarID,'FieldType',NF_INT,i2offset(1),FieldType)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'ext_pnc_write_field: NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    call reorder(MemoryOrder,MemO)
+    call uppercase(MemO,UCMemO)
+    stat = NFMPI_PUT_ATT_TEXT(NCID,VarID,'MemoryOrder',i2offset(3),UCMemO)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'ext_pnc_write_field: NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
+    do NVar=1,DH%NumVars
+      if(DH%VarNames(NVar) == VarName) then
+        exit
+      elseif(NVar == DH%NumVars) then
+        Status = WRF_WARN_VAR_NF
+        write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+    VarID = DH%VarIDs(NVar)
+    do j=1,NDim
+      if(Length_global(j) /= DH%VarDimLens(j,NVar) .AND. DH%FileStatus /= WRF_FILE_OPENED_FOR_UPDATE ) then
+        Status = WRF_WARN_WRTLEN_NE_DRRUNLEN
+        write(msg,*) 'Warning LENGTH != DRY RUN LENGTH for |',   &
+                     VarName,'| dim ',j,' in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        write(msg,*) '   LENGTH ',Length_global(j),' DRY RUN LENGTH ',DH%VarDimLens(j,NVar)
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+!jm 061024      elseif(PatchStart(j) < MemoryStart(j)) then
+!jm      elseif(DomainStart(j) < MemoryStart(j)) then
+      elseif(PatchStart(j) < MemoryStart(j)) then
+        Status = WRF_WARN_DIMENSION_ERROR
+        write(msg,*) 'Warning DIMENSION ERROR for |',VarName,    &
+                     '| in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+    StoredStart = 1
+    call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
+    call GetIndices(NDim,StoredStart,Length   ,x1,x2,y1,y2,z1,z2)
+    call GetIndices(NDim,PatchStart, PatchEnd ,i1,i2,j1,j2,k1,k2)
+    di=1
+    if(FieldType == WRF_DOUBLE) di=2
+    allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+      write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+      call wrf_debug ( FATAL , TRIM(msg))
+      return
+    endif
+    call Transpose('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
+                                         ,XField,x1,x2,y1,y2,z1,z2 &
+                                                ,i1,i2,j1,j2,k1,k2 )
+    StoredStart(1:NDim) = PatchStart(1:NDim)
+    call ExtOrder(MemoryOrder,StoredStart,Status)
+    call FieldIO('write',DataHandle,DateStr,StoredStart,Length,MemoryOrder, &
+                  FieldType,NCID,VarID,XField,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    deallocate(XField, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+      call wrf_debug ( FATAL , TRIM(msg))
+      return
+    endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , TRIM(msg))
+  endif
+  DH%first_operation  = .FALSE.
+  return
+end subroutine ext_pnc_write_field
+
+subroutine ext_pnc_read_field(DataHandle,DateStr,Var,Field,FieldType,Comm,  &
+  IOComm, DomainDesc, MemoryOrdIn, Stagger, DimNames,                       &
+  DomainStart,DomainEnd,MemoryStart,MemoryEnd,PatchStart,PatchEnd,Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer                       ,intent(in)    :: DataHandle
+  character*(*)                 ,intent(in)    :: DateStr
+  character*(*)                 ,intent(in)    :: Var
+  integer                       ,intent(out)   :: Field(*)
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrdIn
+  character*(*)                 ,intent(in)    :: Stagger ! Dummy for now
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+  character (3)                                :: MemoryOrder
+  character (NF_MAX_NAME)                      :: dimname
+  type(wrf_data_handle)         ,pointer       :: DH
+  integer                                      :: NDim
+  integer                                      :: NCID
+  character (VarNameLen)                       :: VarName
+  integer                                      :: VarID
+  integer ,dimension(NVarDims)                 :: VCount
+  integer ,dimension(NVarDims)                 :: VStart
+  integer ,dimension(NVarDims)                 :: Length
+  integer ,dimension(NVarDims)                 :: VDimIDs
+  integer ,dimension(NVarDims)                 :: MemS
+  integer ,dimension(NVarDims)                 :: MemE
+  integer ,dimension(NVarDims)                 :: StoredStart
+  integer ,dimension(NVarDims)                 :: StoredLen
+  integer(KIND=MPI_OFFSET_KIND) ,dimension(NVarDims)                 :: StoredLen_okind
+  integer ,dimension(:,:,:,:)   ,allocatable   :: XField
+  integer                                      :: NVar
+  integer                                      :: j
+  integer                                      :: i1,i2,j1,j2,k1,k2
+  integer                                      :: x1,x2,y1,y2,z1,z2
+  integer                                      :: l1,l2,m1,m2,n1,n2
+  character (VarNameLen)                       :: Name
+  integer                                      :: XType
+  integer                                      :: StoredDim
+  integer                                      :: NAtts
+  integer(KIND=MPI_OFFSET_KIND)                                      :: Len
+  integer                                      :: stat
+  integer                                      :: di
+  integer                                      :: FType
+
+  MemoryOrder = trim(adjustl(MemoryOrdIn))
+  call GetDim(MemoryOrder,NDim,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning BAD MEMORY ORDER |',TRIM(MemoryOrder),'| for |', &
+                 TRIM(Var),'| in ext_pnc_read_field ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning DATE STRING ERROR |',TRIM(DateStr),'| for |',TRIM(Var), &
+                 '| in ext_pnc_read_field ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  VarName = Var
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ext_pnc_read_field ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+! jm it is okay to have a dry run read. means read is called between ofrb and ofrc. Just return.
+!    Status = WRF_WARN_DRYRUN_READ
+!    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+!    call wrf_debug ( WARN , TRIM(msg))
+    Status = WRF_NO_ERR
+    RETURN
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then
+    NCID = DH%NCID
+
+    Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
+    StoredStart(1:NDim) = PatchStart(1:NDim)
+
+    call ExtOrder(MemoryOrder,Length,Status)
+
+    stat = NFMPI_INQ_VARID(NCID,VarName,VarID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Varname ',Varname
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NFMPI_INQ_VAR(NCID,VarID,Name,XType,StoredDim,VDimIDs,NAtts)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NFMPI_GET_ATT_INT(NCID,VarID,'FieldType',FType)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+! allow coercion between double and single prec real
+!jm    if(FieldType /= Ftype) then
+    if( (FieldType == WRF_REAL .OR. FieldType == WRF_DOUBLE) ) then
+      if ( .NOT. (Ftype     == WRF_REAL .OR. Ftype     == WRF_DOUBLE ))  then
+        Status = WRF_WARN_TYPE_MISMATCH
+        write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    else if(FieldType /= Ftype) then
+      Status = WRF_WARN_TYPE_MISMATCH
+      write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif      
+    select case (FieldType)
+      case (WRF_REAL)
+! allow coercion between double and single prec real
+        if(.NOT. (XType == NF_FLOAT .OR. XType == NF_DOUBLE) )  then
+          Status = WRF_WARN_TYPE_MISMATCH
+          write(msg,*) 'Warning REAL TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        endif
+      case (WRF_DOUBLE)
+! allow coercion between double and single prec real
+        if(.NOT. (XType == NF_FLOAT .OR. XType == NF_DOUBLE) )  then
+          Status = WRF_WARN_TYPE_MISMATCH
+          write(msg,*) 'Warning DOUBLE TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        endif
+      case (WRF_INTEGER)
+        if(XType /= NF_INT)  then 
+          Status = WRF_WARN_TYPE_MISMATCH
+          write(msg,*) 'Warning INTEGER TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        endif
+      case (WRF_LOGICAL)
+        if(XType /= NF_INT)  then
+          Status = WRF_WARN_TYPE_MISMATCH
+          write(msg,*) 'Warning LOGICAL TYPE MISMATCH in ',__FILE__,', line', __LINE__
+        endif
+      case default
+        Status = WRF_WARN_DATA_TYPE_NOT_FOUND
+        write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
+    end select
+    if(Status /= WRF_NO_ERR) then
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    ! NDim=0 for scalars.  Handle read of old NDim=1 files.  TBH:  20060502
+    IF ( ( NDim == 0 ) .AND. ( StoredDim == 2 ) ) THEN
+      stat = NFMPI_INQ_DIMNAME(NCID,VDimIDs(1),dimname)
+      call netcdf_err(stat,Status)
+      if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+      IF ( dimname(1:10) == 'ext_scalar' ) THEN
+        NDim = 1
+        Length(1) = 1
+      ENDIF
+    ENDIF
+    if(StoredDim /= NDim+1) then
+      Status = WRF_ERR_FATAL_BAD_VARIABLE_DIM
+      write(msg,*) 'Fatal error BAD VARIABLE DIMENSION in ext_pnc_read_field ',TRIM(Var),TRIM(DateStr)
+      call wrf_debug ( FATAL , msg)
+      write(msg,*) '  StoredDim ', StoredDim, ' .NE. NDim+1 ', NDim+1
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    do j=1,NDim
+      stat = NFMPI_INQ_DIMLEN(NCID,VDimIDs(j),StoredLen_okind(j))
+      call netcdf_err(stat,Status)
+      if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+      StoredLen(j) = StoredLen_okind(j)
+      if(Length(j) > StoredLen(j)) then
+        Status = WRF_WARN_READ_PAST_EOF
+        write(msg,*) 'Warning READ PAST EOF in ext_pnc_read_field of ',TRIM(Var),Length(j),'>',StoredLen(j)
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      elseif(Length(j) <= 0) then
+        Status = WRF_WARN_ZERO_LENGTH_READ
+        write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      elseif(DomainStart(j) < MemoryStart(j)) then
+        Status = WRF_WARN_DIMENSION_ERROR
+        write(msg,*) 'Warning dim ',j,' DomainStart (',DomainStart(j), &
+                     ') < MemoryStart (',MemoryStart(j),') in ',__FILE__,', line', __LINE__
+        call wrf_debug ( WARN , TRIM(msg))
+!        return
+      endif
+    enddo
+
+    StoredStart = 1
+    call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
+    call GetIndices(NDim,StoredStart,StoredLen,x1,x2,y1,y2,z1,z2)
+!jm    call GetIndices(NDim,DomainStart,DomainEnd,i1,i2,j1,j2,k1,k2)
+    call GetIndices(NDim,PatchStart,PatchEnd,i1,i2,j1,j2,k1,k2)
+    
+    StoredStart(1:NDim) = PatchStart(1:NDim)
+    call ExtOrder(MemoryOrder,StoredStart,Status)
+
+    di=1
+    if(FieldType == WRF_DOUBLE) di=2
+    allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_ALLOCATION_ERROR
+      write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+    call FieldIO('read',DataHandle,DateStr,StoredStart,Length,MemoryOrder, &
+                  FieldType,NCID,VarID,XField,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    call Transpose('read',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
+                                        ,XField,x1,x2,y1,y2,z1,z2 &
+                                               ,i1,i2,j1,j2,k1,k2 )
+    deallocate(XField, STAT=stat)
+    if(stat/= 0) then
+      Status = WRF_ERR_FATAL_DEALLOCATION_ERR
+      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
+      call wrf_debug ( FATAL , msg)
+      return
+    endif
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  DH%first_operation  = .FALSE.
+  return
+end subroutine ext_pnc_read_field
+
+subroutine ext_pnc_inquire_opened( DataHandle, FileName , FileStatus, Status )
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: FileName
+  integer               ,intent(out)    :: FileStatus
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    FileStatus = WRF_FILE_NOT_OPENED
+    return
+  endif
+  if(FileName /= DH%FileName) then
+    FileStatus = WRF_FILE_NOT_OPENED
+  else
+    FileStatus = DH%FileStatus
+  endif
+  Status = WRF_NO_ERR
+  return
+end subroutine ext_pnc_inquire_opened
+
+subroutine ext_pnc_inquire_filename( Datahandle, FileName,  FileStatus, Status )
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(out)    :: FileName
+  integer               ,intent(out)    :: FileStatus
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  FileStatus = WRF_FILE_NOT_OPENED
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  FileName = DH%FileName
+  FileStatus = DH%FileStatus
+  Status = WRF_NO_ERR
+  return
+end subroutine ext_pnc_inquire_filename
+
+subroutine ext_pnc_set_time(DataHandle, DateStr, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: DateStr
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: i
+
+  call DateCheck(DateStr,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_FILE_NOT_COMMITTED
+    write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    do i=1,MaxTimes
+      if(DH%Times(i)==DateStr) then
+        DH%CurrentTime = i
+        exit
+      endif
+      if(i==MaxTimes) then
+        Status = WRF_WARN_TIME_NF
+        return
+      endif
+    enddo
+    DH%CurrentVariable = 0
+    Status = WRF_NO_ERR
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_pnc_set_time
+
+subroutine ext_pnc_get_next_time(DataHandle, DateStr, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(out)    :: DateStr
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ
+    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then
+    if(DH%CurrentTime >= DH%NumberTimes) then
+      Status = WRF_WARN_TIME_EOF
+      return
+    endif
+    DH%CurrentTime     = DH%CurrentTime +1
+    DateStr            = DH%Times(DH%CurrentTime)
+    DH%CurrentVariable = 0
+    Status = WRF_NO_ERR
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_pnc_get_next_time
+
+subroutine ext_pnc_get_previous_time(DataHandle, DateStr, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(out)    :: DateStr
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ
+    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
+    if(DH%CurrentTime.GT.0) then
+      DH%CurrentTime     = DH%CurrentTime -1
+    endif
+    DateStr            = DH%Times(DH%CurrentTime)
+    DH%CurrentVariable = 0
+    Status = WRF_NO_ERR
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_pnc_get_previous_time
+
+subroutine ext_pnc_get_next_var(DataHandle, VarName, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+  include 'wrf_status_codes.h'
+#  include "pnetcdf.inc"
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(out)    :: VarName
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: stat
+  character (80)                        :: Name
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ
+    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
+
+    DH%CurrentVariable = DH%CurrentVariable +1
+    if(DH%CurrentVariable > DH%NumVars) then
+      Status = WRF_WARN_VAR_EOF
+      return
+    endif
+    VarName = DH%VarNames(DH%CurrentVariable)
+    Status  = WRF_NO_ERR
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_pnc_get_next_var
+
+subroutine ext_pnc_end_of_frame(DataHandle, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+#  include "pnetcdf.inc"
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+
+  call GetDH(DataHandle,DH,Status)
+  return
+end subroutine ext_pnc_end_of_frame
+
+! NOTE:  For scalar variables NDim is set to zero and DomainStart and 
+! NOTE:  DomainEnd are left unmodified.  
+subroutine ext_pnc_get_var_info(DataHandle,Name,NDim,MemoryOrder,Stagger,DomainStart,DomainEnd,WrfType,Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+#  include "pnetcdf.inc"
+  include 'wrf_status_codes.h'
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: Name
+  integer               ,intent(out)    :: NDim
+  character*(*)         ,intent(out)    :: MemoryOrder
+  character*(*)                         :: Stagger ! Dummy for now
+  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
+  integer               ,intent(out)    :: WrfType
+  integer               ,intent(out)    :: Status
+  type(wrf_data_handle) ,pointer        :: DH
+  integer                               :: VarID
+  integer ,dimension(NVarDims)          :: VDimIDs
+  integer                               :: j
+  integer                               :: stat
+  integer                               :: XType
+
+  call GetDH(DataHandle,DH,Status)
+  if(Status /= WRF_NO_ERR) then
+    write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  endif
+  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
+    Status = WRF_WARN_FILE_NOT_OPENED
+    write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
+    Status = WRF_WARN_DRYRUN_READ
+    write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
+    Status = WRF_WARN_READ_WONLY_FILE
+    write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( WARN , TRIM(msg))
+    return
+  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
+    stat = NFMPI_INQ_VARID(DH%NCID,Name,VarID)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NFMPI_INQ_VARTYPE(DH%NCID,VarID,XType)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NFMPI_GET_ATT_INT(DH%NCID,VarID,'FieldType',WrfType)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    select case (XType)
+      case (NF_BYTE)
+        Status = WRF_WARN_BAD_DATA_TYPE
+        write(msg,*) 'Warning BYTE IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      case (NF_CHAR)
+        Status = WRF_WARN_BAD_DATA_TYPE
+        write(msg,*) 'Warning CHAR IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      case (NF_SHORT)
+        Status = WRF_WARN_BAD_DATA_TYPE
+        write(msg,*) 'Warning SHORT IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      case (NF_INT)
+        if(WrfType /= WRF_INTEGER .and. WrfType /= WRF_LOGICAL) then
+          Status = WRF_WARN_BAD_DATA_TYPE
+          write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+          call wrf_debug ( WARN , TRIM(msg))
+          return
+        endif
+      case (NF_FLOAT)
+        if(WrfType /= WRF_REAL) then
+          Status = WRF_WARN_BAD_DATA_TYPE
+          write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+          call wrf_debug ( WARN , TRIM(msg))
+          return
+        endif
+      case (NF_DOUBLE)
+        if(WrfType /= WRF_DOUBLE) then
+          Status = WRF_WARN_BAD_DATA_TYPE
+          write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ 
+          call wrf_debug ( WARN , TRIM(msg))
+          return
+        endif
+      case default
+        Status = WRF_WARN_DATA_TYPE_NOT_FOUND
+        write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+    end select
+
+    stat = NFMPI_GET_ATT_TEXT(DH%NCID,VarID,'MemoryOrder',MemoryOrder)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    call GetDim(MemoryOrder,NDim,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'Warning BAD MEMORY ORDER ',TRIM(MemoryOrder),' in ',__FILE__,', line', __LINE__
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    stat = NFMPI_INQ_VARDIMID(DH%NCID,VarID,VDimIDs)
+    call netcdf_err(stat,Status)
+    if(Status /= WRF_NO_ERR) then
+      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+      call wrf_debug ( WARN , TRIM(msg))
+      return
+    endif
+    do j = 1, NDim
+      DomainStart(j) = 1
+      stat = NFMPI_INQ_DIMLEN(DH%NCID,VDimIDs(j),DomainEnd(j))
+      call netcdf_err(stat,Status)
+      if(Status /= WRF_NO_ERR) then
+        write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ 
+        call wrf_debug ( WARN , TRIM(msg))
+        return
+      endif
+    enddo
+  else
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+    write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
+    call wrf_debug ( FATAL , msg)
+  endif
+  return
+end subroutine ext_pnc_get_var_info
+
+subroutine ext_pnc_warning_str( Code, ReturnString, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+#  include "pnetcdf.inc"
+  include 'wrf_status_codes.h'
+  
+  integer  , intent(in)  ::Code
+  character *(*), intent(out) :: ReturnString
+  integer, intent(out) ::Status
+  
+  SELECT CASE (Code)
+  CASE (0)
+      ReturnString='No error'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1)
+      ReturnString= 'File not found (or file is incomplete)'
+      Status=WRF_NO_ERR
+      return
+  CASE (-2)
+      ReturnString='Metadata not found'
+      Status=WRF_NO_ERR
+      return
+  CASE (-3)
+      ReturnString= 'Timestamp not found'
+      Status=WRF_NO_ERR
+      return
+  CASE (-4)
+      ReturnString= 'No more timestamps'
+      Status=WRF_NO_ERR
+      return
+  CASE (-5)
+      ReturnString= 'Variable not found'
+      Status=WRF_NO_ERR
+      return
+  CASE (-6)
+      ReturnString= 'No more variables for the current time'
+      Status=WRF_NO_ERR
+      return
+  CASE (-7)
+      ReturnString= 'Too many open files'
+      Status=WRF_NO_ERR
+      return
+  CASE (-8)
+      ReturnString= 'Data type mismatch'
+      Status=WRF_NO_ERR
+      return
+  CASE (-9)
+      ReturnString= 'Attempt to write read-only file'
+      Status=WRF_NO_ERR
+      return
+  CASE (-10)
+      ReturnString= 'Attempt to read write-only file'
+      Status=WRF_NO_ERR
+      return
+  CASE (-11)
+      ReturnString= 'Attempt to access unopened file'
+      Status=WRF_NO_ERR
+      return
+  CASE (-12)
+      ReturnString= 'Attempt to do 2 trainings for 1 variable'
+      Status=WRF_NO_ERR
+      return
+  CASE (-13)
+      ReturnString= 'Attempt to read past EOF'
+      Status=WRF_NO_ERR
+      return
+  CASE (-14)
+      ReturnString= 'Bad data handle'
+      Status=WRF_NO_ERR
+      return
+  CASE (-15)
+      ReturnString= 'Write length not equal to training length'
+      Status=WRF_NO_ERR
+      return
+  CASE (-16)
+      ReturnString= 'More dimensions requested than training'
+      Status=WRF_NO_ERR
+      return
+  CASE (-17)
+      ReturnString= 'Attempt to read more data than exists'
+      Status=WRF_NO_ERR
+      return
+  CASE (-18)
+      ReturnString= 'Input dimensions inconsistent'
+      Status=WRF_NO_ERR
+      return
+  CASE (-19)
+      ReturnString= 'Input MemoryOrder not recognized'
+      Status=WRF_NO_ERR
+      return
+  CASE (-20)
+      ReturnString= 'A dimension name with 2 different lengths'
+      Status=WRF_NO_ERR
+      return
+  CASE (-21)
+      ReturnString= 'String longer than provided storage'
+      Status=WRF_NO_ERR
+      return
+  CASE (-22)
+      ReturnString= 'Function not supportable'
+      Status=WRF_NO_ERR
+      return
+  CASE (-23)
+      ReturnString= 'Package implements this routine as NOOP'
+      Status=WRF_NO_ERR
+      return
+
+!netcdf-specific warning messages
+  CASE (-1007)
+      ReturnString= 'Bad data type'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1008)
+      ReturnString= 'File not committed'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1009)
+      ReturnString= 'File is opened for reading'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1011)
+      ReturnString= 'Attempt to write metadata after open commit'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1010)
+      ReturnString= 'I/O not initialized'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1012)
+     ReturnString=  'Too many variables requested'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1013)
+     ReturnString=  'Attempt to close file during a dry run'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1014)
+      ReturnString= 'Date string not 19 characters in length'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1015)
+      ReturnString= 'Attempt to read zero length words'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1016)
+      ReturnString= 'Data type not found'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1017)
+      ReturnString= 'Badly formatted date string'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1018)
+      ReturnString= 'Attempt at read during a dry run'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1019)
+      ReturnString= 'Attempt to get zero words'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1020)
+      ReturnString= 'Attempt to put zero length words'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1021)
+      ReturnString= 'NetCDF error'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1022)
+      ReturnString= 'Requested length <= 1'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1023)
+      ReturnString= 'More data available than requested'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1024)
+      ReturnString= 'New date less than previous date'
+      Status=WRF_NO_ERR
+      return
+
+  CASE DEFAULT
+      ReturnString= 'This warning code is not supported or handled directly by WRF and NetCDF. &
+      & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need &
+      & to be calling a package-specific routine to return a message for this warning code.'
+      Status=WRF_NO_ERR
+  END SELECT
+
+  return
+end subroutine ext_pnc_warning_str
+
+
+!returns message string for all WRF and netCDF warning/error status codes
+!Other i/o packages must  provide their own routines to return their own status messages
+subroutine ext_pnc_error_str( Code, ReturnString, Status)
+  use wrf_data
+  use ext_pnc_support_routines
+  implicit none
+#  include "pnetcdf.inc"
+  include 'wrf_status_codes.h'
+
+  integer  , intent(in)  ::Code
+  character *(*), intent(out) :: ReturnString
+  integer, intent(out) ::Status
+
+  SELECT CASE (Code)
+  CASE (-100)
+      ReturnString= 'Allocation Error'
+      Status=WRF_NO_ERR
+      return
+  CASE (-101)
+      ReturnString= 'Deallocation Error'
+      Status=WRF_NO_ERR
+      return
+  CASE (-102)
+      ReturnString= 'Bad File Status'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1004)
+      ReturnString= 'Variable on disk is not 3D'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1005)
+      ReturnString= 'Metadata on disk is not 1D'
+      Status=WRF_NO_ERR
+      return
+  CASE (-1006)
+      ReturnString= 'Time dimension too small'
+      Status=WRF_NO_ERR
+      return
+  CASE DEFAULT
+      ReturnString= 'This error code is not supported or handled directly by WRF and NetCDF. &
+      & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need & 
+      & to be calling a package-specific routine to return a message for this error code.'
+      Status=WRF_NO_ERR
+  END SELECT
+
+  return
+end subroutine ext_pnc_error_str
Index: trunk/WRF.COMMON/WRFV2/external/ioapi_share/makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/ioapi_share/makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/ioapi_share/makefile	(revision 2744)
@@ -0,0 +1,25 @@
+# Makefile for variants of wrf_io_flags.h and wrf_status_codes.h that live in 
+# ../../inc
+
+all: ../../inc/wrf_io_flags.h ../../inc/wrf_status_codes.h
+
+# The if statement below modifies WRF data type codes for builds made with 
+# compiler autopromotion of REAL -> DOUBLE.  
+../../inc/wrf_io_flags.h : wrf_io_flags.h ../../configure.wrf
+	( /bin/rm -f ../../inc/wrf_io_flags.h foo_io_flags.h; \
+	/bin/cp wrf_io_flags.h foo_io_flags.h; \
+	if [ $(RWORDSIZE) -ne $(NATIVE_RWORDSIZE) ] ; then \
+	  /bin/rm -f foo_io_flags.h; \
+	  sed -e 's/104/105/' wrf_io_flags.h > foo_io_flags.h ;\
+	fi ; \
+	/bin/mv foo_io_flags.h ../../inc/wrf_io_flags.h )
+
+../../inc/wrf_status_codes.h : wrf_status_codes.h
+	/bin/rm -f ../../inc/wrf_status_codes.h
+	/bin/cp wrf_status_codes.h ../../inc
+
+superclean: 
+	/bin/rm -f ../../inc/wrf_io_flags.h ../../inc/wrf_status_codes.h
+
+# DEPENDENCIES : only dependencies after this line 
+
Index: trunk/WRF.COMMON/WRFV2/external/ioapi_share/wrf_io_flags.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/ioapi_share/wrf_io_flags.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/ioapi_share/wrf_io_flags.h	(revision 2744)
@@ -0,0 +1,19 @@
+      integer, parameter  :: WRF_FILE_NOT_OPENED                  = 100
+      integer, parameter  :: WRF_FILE_OPENED_NOT_COMMITTED        = 101
+      integer, parameter  :: WRF_FILE_OPENED_FOR_WRITE            = 102
+      integer, parameter  :: WRF_FILE_OPENED_FOR_READ             = 103
+      integer, parameter  :: WRF_REAL                             = 104
+      integer, parameter  :: WRF_DOUBLE                           = 105
+#ifdef PROMOTE_FLOAT 
+      integer, parameter  :: WRF_FLOAT=WRF_DOUBLE
+#else      
+      integer, parameter  :: WRF_FLOAT=WRF_REAL
+#endif      
+      integer, parameter  :: WRF_INTEGER                          = 106
+      integer, parameter  :: WRF_LOGICAL                          = 107
+      integer, parameter  :: WRF_COMPLEX                          = 108
+      integer, parameter  :: WRF_DOUBLE_COMPLEX                   = 109
+      integer, parameter  :: WRF_FILE_OPENED_FOR_UPDATE           = 110
+! This bit is for backwards compatibility with old variants of these flags 
+! that are still being used in io_grib1 and io_phdf5.  It should be removed!  
+      integer, parameter  :: WRF_FILE_OPENED_AND_COMMITTED        = 102
Index: trunk/WRF.COMMON/WRFV2/external/ioapi_share/wrf_status_codes.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/external/ioapi_share/wrf_status_codes.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external/ioapi_share/wrf_status_codes.h	(revision 2744)
@@ -0,0 +1,133 @@
+  
+!WRF Error and Warning messages (1-999)
+!All i/o package-specific status codes you may want to add must be handled by your package (see below)
+! WRF handles these and netCDF messages only
+  integer, parameter  :: WRF_NO_ERR                  =  0       !no error
+  integer, parameter  :: WRF_WARN_FILE_NF            = -1       !file not found, or incomplete
+  integer, parameter  :: WRF_WARN_MD_NF              = -2       !metadata not found
+  integer, parameter  :: WRF_WARN_TIME_NF            = -3       !timestamp not found
+  integer, parameter  :: WRF_WARN_TIME_EOF           = -4       !no more timestamps
+  integer, parameter  :: WRF_WARN_VAR_NF             = -5       !variable not found
+  integer, parameter  :: WRF_WARN_VAR_EOF            = -6       !no more variables for the current time
+  integer, parameter  :: WRF_WARN_TOO_MANY_FILES     = -7       !too many open files
+  integer, parameter  :: WRF_WARN_TYPE_MISMATCH      = -8       !data type mismatch
+  integer, parameter  :: WRF_WARN_WRITE_RONLY_FILE   = -9       !attempt to write readonly file
+  integer, parameter  :: WRF_WARN_READ_WONLY_FILE    = -10      !attempt to read writeonly file
+  integer, parameter  :: WRF_WARN_FILE_NOT_OPENED    = -11      !attempt to access unopened file
+  integer, parameter  :: WRF_WARN_2DRYRUNS_1VARIABLE = -12      !attempt to do 2 trainings for 1 variable
+  integer, parameter  :: WRF_WARN_READ_PAST_EOF      = -13      !attempt to read past EOF
+  integer, parameter  :: WRF_WARN_BAD_DATA_HANDLE    = -14      !bad data handle
+  integer, parameter  :: WRF_WARN_WRTLEN_NE_DRRUNLEN = -15      !write length not equal to training length
+  integer, parameter  :: WRF_WARN_TOO_MANY_DIMS      = -16      !more dimensions requested than training
+  integer, parameter  :: WRF_WARN_COUNT_TOO_LONG     = -17      !attempt to read more data than exists
+  integer, parameter  :: WRF_WARN_DIMENSION_ERROR    = -18      !input dimension inconsistent
+  integer, parameter  :: WRF_WARN_BAD_MEMORYORDER    = -19      !input MemoryOrder not recognized
+  integer, parameter  :: WRF_WARN_DIMNAME_REDEFINED  = -20      !a dimension name with 2 different lengths
+  integer, parameter  :: WRF_WARN_CHARSTR_GT_LENDATA = -21      !string longer than provided storage
+  integer, parameter  :: WRF_WARN_NOTSUPPORTED       = -22      !function not supportable
+  integer, parameter  :: WRF_WARN_NOOP               = -23      !package implements this routine as NOOP
+
+!Fatal errors 
+  integer, parameter  :: WRF_ERR_FATAL_ALLOCATION_ERROR  = -100 !allocation error
+  integer, parameter  :: WRF_ERR_FATAL_DEALLOCATION_ERR  = -101 !dealloc error
+  integer, parameter  :: WRF_ERR_FATAL_BAD_FILE_STATUS   = -102 !bad file status
+
+
+!Package specific errors (1000+)        
+!Netcdf status codes
+!WRF will accept status codes of 1000+, but it is up to the package to handle
+! and return the status to the user.
+
+  integer, parameter  :: WRF_ERR_FATAL_BAD_VARIABLE_DIM  = -1004
+  integer, parameter  :: WRF_ERR_FATAL_MDVAR_DIM_NOT_1D  = -1005
+  integer, parameter  :: WRF_ERR_FATAL_TOO_MANY_TIMES    = -1006
+  integer, parameter  :: WRF_WARN_BAD_DATA_TYPE      = -1007    !this code not in either spec?
+  integer, parameter  :: WRF_WARN_FILE_NOT_COMMITTED = -1008    !this code not in either spec?
+  integer, parameter  :: WRF_WARN_FILE_OPEN_FOR_READ = -1009
+  integer, parameter  :: WRF_IO_NOT_INITIALIZED      = -1010
+  integer, parameter  :: WRF_WARN_MD_AFTER_OPEN      = -1011
+  integer, parameter  :: WRF_WARN_TOO_MANY_VARIABLES = -1012
+  integer, parameter  :: WRF_WARN_DRYRUN_CLOSE       = -1013
+  integer, parameter  :: WRF_WARN_DATESTR_BAD_LENGTH = -1014
+  integer, parameter  :: WRF_WARN_ZERO_LENGTH_READ   = -1015
+  integer, parameter  :: WRF_WARN_DATA_TYPE_NOT_FOUND = -1016
+  integer, parameter  :: WRF_WARN_DATESTR_ERROR      = -1017
+  integer, parameter  :: WRF_WARN_DRYRUN_READ        = -1018
+  integer, parameter  :: WRF_WARN_ZERO_LENGTH_GET    = -1019
+  integer, parameter  :: WRF_WARN_ZERO_LENGTH_PUT    = -1020
+  integer, parameter  :: WRF_WARN_NETCDF             = -1021    
+  integer, parameter  :: WRF_WARN_LENGTH_LESS_THAN_1 = -1022    
+  integer, parameter  :: WRF_WARN_MORE_DATA_IN_FILE  = -1023    
+  integer, parameter  :: WRF_WARN_DATE_LT_LAST_DATE  = -1024
+
+! For HDF5 only
+  integer, parameter  :: WRF_HDF5_ERR_FILE                 = -200
+  integer, parameter  :: WRF_HDF5_ERR_MD                   = -201
+  integer, parameter  :: WRF_HDF5_ERR_TIME                 = -202
+  integer, parameter  :: WRF_HDF5_ERR_TIME_EOF             = -203
+  integer, parameter  :: WRF_HDF5_ERR_MORE_DATA_IN_FILE    = -204
+  integer, parameter  :: WRF_HDF5_ERR_DATE_LT_LAST_DATE    = -205
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_FILES       = -206
+  integer, parameter  :: WRF_HDF5_ERR_TYPE_MISMATCH        = -207
+  integer, parameter  :: WRF_HDF5_ERR_LENGTH_LESS_THAN_1   = -208
+  integer, parameter  :: WRF_HDF5_ERR_WRITE_RONLY_FILE     = -209
+  integer, parameter  :: WRF_HDF5_ERR_READ_WONLY_FILE      = -210
+  integer, parameter  :: WRF_HDF5_ERR_FILE_NOT_OPENED      = -211
+  integer, parameter  :: WRF_HDF5_ERR_DATESTR_ERROR        = -212
+  integer, parameter  :: WRF_HDF5_ERR_DRYRUN_READ          = -213
+  integer, parameter  :: WRF_HDF5_ERR_ZERO_LENGTH_GET      = -214
+  integer, parameter  :: WRF_HDF5_ERR_ZERO_LENGTH_PUT      = -215
+  integer, parameter  :: WRF_HDF5_ERR_2DRYRUNS_1VARIABLE   = -216
+  integer, parameter  :: WRF_HDF5_ERR_DATA_TYPE_NOTFOUND   = -217
+  integer, parameter  :: WRF_HDF5_ERR_READ_PAST_EOF        = -218
+  integer, parameter  :: WRF_HDF5_ERR_BAD_DATA_HANDLE      = -219
+  integer, parameter  :: WRF_HDF5_ERR_WRTLEN_NE_DRRUNLEN   = -220
+  integer, parameter  :: WRF_HDF5_ERR_DRYRUN_CLOSE         = -221
+  integer, parameter  :: WRF_HDF5_ERR_DATESTR_BAD_LENGTH   = -222
+  integer, parameter  :: WRF_HDF5_ERR_ZERO_LENGTH_READ     = -223
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_DIMS        = -224
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_VARIABLES   = -225
+  integer, parameter  :: WRF_HDF5_ERR_COUNT_TOO_LONG       = -226
+  integer, parameter  :: WRF_HDF5_ERR_DIMENSION_ERROR      = -227
+  integer, parameter  :: WRF_HDF5_ERR_BAD_MEMORYORDER      = -228
+  integer, parameter  :: WRF_HDF5_ERR_DIMNAME_REDEFINED    = -229
+  integer, parameter  :: WRF_HDF5_ERR_MD_AFTER_OPEN        = -230
+  integer, parameter  :: WRF_HDF5_ERR_CHARSTR_GT_LENDATA   = -231
+  integer, parameter  :: WRF_HDF5_ERR_BAD_DATA_TYPE        = -232
+  integer, parameter  :: WRF_HDF5_ERR_FILE_NOT_COMMITTED   = -233
+
+  integer, parameter  :: WRF_HDF5_ERR_ALLOCATION        = -2001
+  integer, parameter  :: WRF_HDF5_ERR_DEALLOCATION      = -2002
+  integer, parameter  :: WRF_HDF5_ERR_BAD_FILE_STATUS   = -2003
+  integer, parameter  :: WRF_HDF5_ERR_BAD_VARIABLE_DIM  = -2004
+  integer, parameter  :: WRF_HDF5_ERR_MDVAR_DIM_NOT_1D  = -2005
+  integer, parameter  :: WRF_HDF5_ERR_TOO_MANY_TIMES    = -2006
+  integer, parameter ::  WRF_HDF5_ERR_DATA_ID_NOTFOUND  = -2007
+
+  integer, parameter ::  WRF_HDF5_ERR_DATASPACE         = -300
+  integer, parameter ::  WRF_HDF5_ERR_DATATYPE          = -301
+  integer, parameter :: WRF_HDF5_ERR_PROPERTY_LIST      = -302
+
+  integer, parameter :: WRF_HDF5_ERR_DATASET_CREATE     = -303
+  integer, parameter :: WRF_HDF5_ERR_DATASET_READ       = -304
+  integer, parameter :: WRF_HDF5_ERR_DATASET_WRITE      = -305
+  integer, parameter :: WRF_HDF5_ERR_DATASET_OPEN       = -306
+  integer, parameter :: WRF_HDF5_ERR_DATASET_GENERAL    = -307
+  integer, parameter :: WRF_HDF5_ERR_GROUP              = -308
+
+  integer, parameter :: WRF_HDF5_ERR_FILE_OPEN          = -309
+  integer, parameter :: WRF_HDF5_ERR_FILE_CREATE        = -310
+  integer, parameter :: WRF_HDF5_ERR_DATASET_CLOSE      = -311
+  integer, parameter :: WRF_HDF5_ERR_FILE_CLOSE         = -312
+  integer, parameter :: WRF_HDF5_ERR_CLOSE_GENERAL      = -313
+
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CREATE   = -314
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_READ     = -315
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_WRITE    = -316
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OPEN     = -317
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_GENERAL  = -318
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CLOSE    = -319
+
+  integer, parameter :: WRF_HDF5_ERR_OTHERS             = -320
+  integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS   = -321
+
Index: trunk/WRF.COMMON/WRFV2/external_save
===================================================================
--- trunk/WRF.COMMON/WRFV2/external_save	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/external_save	(revision 2744)
@@ -0,0 +1,10 @@
+mkdir save/external 
+mkdir save/external/esmf_time_f90
+cp -rf external/esmf_time_f90/diff_ESMF_TimeMgr save/external/esmf_time_f90
+cp -rf external/esmf_time_f90/diff_Meat save/external/esmf_time_f90
+cp -rf external/esmf_time_f90/diff_Test1 save/external/esmf_time_f90
+cp -rf external/esmf_time_f90/ESMF_Calendar.F90 save/external/esmf_time_f90
+cp -rf external/esmf_time_f90/ESMF_TimeMgr.inc save/external/esmf_time_f90
+cp -rf external/esmf_time_f90/Meat.F90 save/external/esmf_time_f90
+cp -rf external/esmf_time_f90/Test1.F90 save/external/esmf_time_f90
+cp -rf external/esmf_time_f90/diff_ESMF_Calendar save/external/esmf_time_f90
Index: trunk/WRF.COMMON/WRFV2/frame/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/Makefile	(revision 2744)
@@ -0,0 +1,128 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+
+
+MODULES =       module_driver_constants.o  \
+                module_domain.o            \
+                module_integrate.o         \
+                module_timing.o            \
+                module_configure.o         \
+                module_tiles.o             \
+                module_machine.o           \
+                module_nesting.o           \
+                module_wrf_error.o         \
+                module_state_description.o \
+                module_sm.o                \
+                module_io.o                \
+                module_dm.o                \
+                module_quilt_outbuf_ops.o  \
+                module_io_quilt.o
+
+OBJS    =       wrf_num_bytes_between.o    \
+                wrf_shutdown.o             \
+                wrf_debug.o                \
+                libmassv.o                 \
+                collect_on_comm.o
+
+#compile as a .o but do not link into the main library
+SPECIAL =       module_internal_header_util.o pack_utils.o
+   
+
+include ../configure.wrf
+
+LIBTARGET    =  framework
+TARGETDIR    =  ./
+$(LIBTARGET) :  $(MODULES) $(OBJS) $(SPECIAL)
+		$(AR) ../main/libwrflib.a $(MODULES) $(OBJS)
+		$(RANLIB) ../main/libwrflib.a
+
+
+wrf_num_bytes_between.o :
+	$(CC) -c $(CFLAGS) wrf_num_bytes_between.c
+
+clean:
+	@ echo 'use the clean script'
+
+module_state_description.F : ../Registry/$(REGISTRY)
+		( cd .. ; tools/registry $(ARCHFLAGS) Registry/$(REGISTRY) )
+
+md_calls.inc : md_calls.m4
+	$(M4) md_calls.m4 > md_calls.inc
+
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+
+module_configure.o: \
+		module_state_description.o \
+                module_wrf_error.o \
+		module_driver_constants.o 
+
+module_dm.o: module_machine.o module_state_description.o module_wrf_error.o \
+		module_domain.o \
+		module_driver_constants.o \
+		module_timing.o \
+		module_configure.o 
+
+module_dm_stubs.F: module_domain.o
+
+module_domain.o: module_driver_constants.o \
+		module_configure.o \
+		module_machine.o  \
+		module_state_description.o \
+                module_wrf_error.o \
+		$(ESMF_MOD_DEPENDENCE)
+
+module_driver_constants.o: \
+		module_state_description.o \
+                module_wrf_error.o
+
+module_integrate.o: module_domain.o \
+		module_timing.o \
+		module_driver_constants.o \
+		module_state_description.o \
+		module_nesting.o \
+		module_configure.o \
+		$(ESMF_MOD_DEPENDENCE)
+
+module_io.o : md_calls.inc \
+		module_state_description.o \
+		module_configure.o  \
+		module_driver_constants.o 
+
+module_io_quilt.o: module_state_description.o \
+		module_internal_header_util.o \
+		module_quilt_outbuf_ops.o 
+
+module_machine.o: module_driver_constants.o
+
+module_nesting.o: module_machine.o \
+		module_driver_constants.o \
+		module_configure.o \
+		$(ESMF_MOD_DEPENDENCE) \
+		module_domain.o 
+
+module_quilt_outbuf_ops.o: module_state_description.o
+
+module_tiles.o: module_domain.o \
+		module_driver_constants.o \
+		module_machine.o  \
+		module_configure.o  \
+                module_wrf_error.o
+ 
+module_timing.o: \
+		module_state_description.o \
+                module_wrf_error.o
+
+module_wrf_error.o: \
+		wrf_shutdown.o \
+		$(ESMF_MOD_DEPENDENCE)
+
+wrf_debug.o: \
+		module_wrf_error.o
+
+# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV2/frame/collect_on_comm.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/collect_on_comm.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/collect_on_comm.c	(revision 2744)
@@ -0,0 +1,215 @@
+#include <stdio.h>
+#include <stdlib.h>
+#if defined( DM_PARALLEL ) && ! defined( STUBMPI )
+# include <mpi.h>
+#endif
+
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define COLLECT_ON_COMM  collect_on_comm
+#      define COLLECT_ON_COMM0 collect_on_comm0
+#      define DIST_ON_COMM  dist_on_comm
+#      define DIST_ON_COMM0 dist_on_comm0
+#      define INT_PACK_DATA  int_pack_data
+#      define INT_GET_TI_HEADER_C  int_get_ti_header_c
+#      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c
+# else
+#   ifdef F2CSTYLE
+#      define COLLECT_ON_COMM  collect_on_comm__
+#      define COLLECT_ON_COMM0 collect_on_comm0__
+#      define DIST_ON_COMM  dist_on_comm__
+#      define DIST_ON_COMM0 dist_on_comm0__
+#      define INT_PACK_DATA  int_pack_data__
+#      define INT_GET_TI_HEADER_C  int_get_ti_header_c__
+#      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c__
+#   else
+#      define COLLECT_ON_COMM  collect_on_comm_
+#      define COLLECT_ON_COMM0 collect_on_comm0_
+#      define DIST_ON_COMM  dist_on_comm_
+#      define DIST_ON_COMM0 dist_on_comm0_
+#      define INT_PACK_DATA  int_pack_data_
+#      define INT_GET_TI_HEADER_C  int_get_ti_header_c_
+#      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c_
+#   endif
+# endif
+#endif
+
+COLLECT_ON_COMM ( int * comm, int * typesize ,
+                 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
+{
+  col_on_comm ( comm, typesize ,
+                inbuf, ninbuf , outbuf, noutbuf, 1 ) ;
+}
+
+/* collect on node 0*/
+COLLECT_ON_COMM0 ( int * comm, int * typesize ,
+                 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
+{
+  col_on_comm ( comm, typesize ,
+                inbuf, ninbuf , outbuf, noutbuf, 0 ) ;
+}
+
+col_on_comm ( int * Fcomm, int * typesize ,
+              void * inbuf, int *ninbuf , void * outbuf, int * noutbuf, int sw )
+{
+#if defined( DM_PARALLEL ) && !(STUBMPI)
+  int mytask, ntasks, p ;
+  int *recvcounts ;
+  int *displace ;
+  int noutbuf_loc ;
+  int root_task ;
+  MPI_Comm *comm, dummy_comm ;
+
+  comm = &dummy_comm ;
+  *comm = MPI_Comm_f2c( *Fcomm ) ;
+  MPI_Comm_size ( *comm, &ntasks ) ;
+  MPI_Comm_rank ( *comm, &mytask ) ;
+  recvcounts = (int *) malloc( ntasks * sizeof(int)) ;
+  displace   = (int *) malloc( ntasks * sizeof(int)) ;
+  root_task = ( sw == 0 ) ? 0 : ntasks-1 ;
+
+  /* collect up recvcounts */
+  MPI_Gather( ninbuf , 1 , MPI_INT , recvcounts , 1 , MPI_INT , root_task , *comm ) ;
+
+  if ( mytask == root_task ) {
+
+    /* figure out displacements */
+    for ( p = 1 , displace[0] = 0 , noutbuf_loc = recvcounts[0] ; p < ntasks ; p++ ) {
+      displace[p] = displace[p-1]+recvcounts[p-1] ;
+      noutbuf_loc = noutbuf_loc + recvcounts[p] ;
+    }
+
+    if ( noutbuf_loc > * noutbuf )
+    {
+      fprintf(stderr,"FATAL ERROR: collect_on_comm: noutbuf_loc (%d) > noutbuf (%d)\n",
+		      noutbuf_loc , * noutbuf ) ; 
+      fprintf(stderr,"WILL NOT perform the collection operation\n") ;
+      MPI_Abort(MPI_COMM_WORLD,1) ;
+    }
+
+    /* multiply everything by the size of the type */
+    for ( p = 0 ; p < ntasks ; p++ ) {
+      displace[p] *= *typesize ;
+      recvcounts[p] *= *typesize ;
+    }
+  }
+
+  MPI_Gatherv( inbuf  , *ninbuf * *typesize  , MPI_CHAR ,
+               outbuf , recvcounts , displace, MPI_CHAR ,
+               root_task , *comm ) ;
+
+  free(recvcounts) ;
+  free(displace) ;
+#endif
+  return(0) ;
+}
+
+
+DIST_ON_COMM ( int * comm, int * typesize ,
+                 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
+{
+  dst_on_comm ( comm, typesize ,
+                inbuf, ninbuf , outbuf, noutbuf, 1 ) ;
+}
+
+DIST_ON_COMM0 ( int * comm, int * typesize ,
+                 void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
+{
+  dst_on_comm ( comm, typesize ,
+                inbuf, ninbuf , outbuf, noutbuf, 0 ) ;
+}
+
+dst_on_comm ( int * Fcomm, int * typesize ,
+              void * inbuf, int *ninbuf , void * outbuf, int * noutbuf, int sw )
+{
+#if defined(DM_PARALLEL) && ! defined(STUBMPI)
+  int mytask, ntasks, p ;
+  int *sendcounts ;
+  int *displace ;
+  int noutbuf_loc ;
+  int root_task ;
+  MPI_Comm *comm, dummy_comm ;
+
+  comm = &dummy_comm ;
+  *comm = MPI_Comm_f2c( *Fcomm ) ;
+  MPI_Comm_size ( *comm, &ntasks ) ;
+  MPI_Comm_rank ( *comm, &mytask ) ;
+  sendcounts = (int *) malloc( ntasks * sizeof(int)) ;
+  displace   = (int *) malloc( ntasks * sizeof(int)) ;
+  root_task = ( sw == 0 ) ? 0 : ntasks-1 ;
+
+  /* collect up sendcounts */
+  MPI_Gather( noutbuf , 1 , MPI_INT , sendcounts , 1 , MPI_INT , root_task , *comm ) ;
+
+  if ( mytask == root_task ) {
+
+    /* figure out displacements */
+    for ( p = 1 , displace[0] = 0 , noutbuf_loc = sendcounts[0] ; p < ntasks ; p++ ) {
+      displace[p] = displace[p-1]+sendcounts[p-1] ;
+      noutbuf_loc = noutbuf_loc + sendcounts[p] ;
+    }
+
+    /* multiply everything by the size of the type */
+    for ( p = 0 ; p < ntasks ; p++ ) {
+      displace[p] *= *typesize ;
+      sendcounts[p] *= *typesize ;
+    }
+  }
+
+  MPI_Scatterv( inbuf   , sendcounts , displace, MPI_CHAR ,
+                outbuf  , *noutbuf * *typesize  , MPI_CHAR ,
+                root_task , *comm ) ;
+
+  free(sendcounts) ;
+  free(displace) ;
+#endif
+  return(0) ;
+}
+
+#ifndef MACOS
+#  include <malloc.h>
+#  include <sys/resource.h>
+#endif
+
+#if 0
+  int getrusage(
+          int who,
+          struct rusage *r_usage);
+#endif
+
+#if 0
+extern int outy ;
+extern int maxstug, nouty, maxouty ;
+#endif
+
+#if 0
+#include <unistd.h>
+#include <sys/times.h>
+/*  used internally for chasing memory leaks on ibm  */
+rlim_ ()
+{
+#ifndef MACOS
+
+   struct rusage r_usage ;
+   struct mallinfo minf ;
+   struct tms  tm ;
+   long tick, tock ;
+
+   tick = sysconf( _SC_CLK_TCK ) ;
+   times( &tm ) ;
+   tock = (tm.tms_utime + tm.tms_stime)*tick ;
+
+   getrusage ( RUSAGE_SELF, &r_usage ) ;
+   if ( tock != 0 ) {
+     fprintf(stderr,"sm %ld d %ld s %ld maxrss %ld %d %d %ld\n",r_usage.ru_ixrss/tock,r_usage.ru_idrss/tock,r_usage.ru_isrss/tock, r
+_usage.ru_maxrss,tick,tock,r_usage.ru_ixrss) ;
+   }
+   minf = mallinfo() ;
+   fprintf(stderr,"a %ld usm %ld fsm %ld uord %ld ford %ld hblkhd %d\n",minf.arena,minf.usmblks,minf.fsmblks,minf.uordblks,minf.ford
+blks,minf.hblkhd) ;
+# if 0
+   fprintf(stderr," outy %d  nouty %d  maxstug %d maxouty %d \n", outy, nouty, maxstug, maxouty ) ;
+# endif
+#endif
+}
+#endif
Index: trunk/WRF.COMMON/WRFV2/frame/libmassv.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/libmassv.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/libmassv.F	(revision 2744)
@@ -0,0 +1,385 @@
+! IBM libmassv compatibility library
+! 
+
+#ifndef NATIVE_MASSV
+      subroutine vdiv(z,x,y,n)
+      real*8 x(*),y(*),z(*)
+      do 10 j=1,n
+      z(j)=x(j)/y(j)
+   10 continue
+      return
+      end
+
+      subroutine vsdiv(z,x,y,n)
+      real*4 x(*),y(*),z(*)
+      do 10 j=1,n
+      z(j)=x(j)/y(j)
+   10 continue
+      return
+      end
+
+      subroutine vexp(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=exp(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vsexp(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=exp(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vlog(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=log(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vslog(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=log(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vrec(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=1.d0/x(j)
+   10 continue
+      return
+      end
+
+      subroutine vsrec(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=1.d0/x(j)
+   10 continue
+      return
+      end
+
+      subroutine vrsqrt(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=1.d0/sqrt(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vsrsqrt(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=1.d0/sqrt(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vsincos(x,y,z,n)
+      real*8 x(*),y(*),z(*)
+      do 10 j=1,n
+      x(j)=sin(z(j))
+      y(j)=cos(z(j))
+   10 continue
+      return
+      end
+
+      subroutine vssincos(x,y,z,n)
+      real*4 x(*),y(*),z(*)
+      do 10 j=1,n
+      x(j)=sin(z(j))
+      y(j)=cos(z(j))
+   10 continue
+      return
+      end
+
+      subroutine vsqrt(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=sqrt(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vssqrt(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=sqrt(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vtan(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=tan(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vstan(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=tan(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vatan2(z,y,x,n)
+      real*8 x(*),y(*),z(*)
+      do 10 j=1,n
+      z(j)=atan2(y(j),x(j))
+   10 continue
+      return
+      end
+
+      subroutine vsatan2(z,y,x,n)
+      real*4 x(*),y(*),z(*)
+      do 10 j=1,n
+      z(j)=atan2(y(j),x(j))
+   10 continue
+      return
+      end
+
+      subroutine vasin(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=asin(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vsin(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=sin(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vssin(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=sin(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vacos(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=acos(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vcos(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=cos(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vscos(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=cos(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vcosisin(y,x,n)
+      complex*16 y(*)
+      real*8 x(*)
+      do 10 j=1,n
+      y(j)=dcmplx(cos(x(j)),sin(x(j)))
+   10 continue
+      return
+      end
+
+      subroutine vscosisin(y,x,n)
+      complex*8 y(*)
+      real*4 x(*)
+      do 10 j=1,n
+      y(j)= cmplx(cos(x(j)),sin(x(j)))
+   10 continue
+      return
+      end
+
+      subroutine vdint(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+!     y(j)=dint(x(j))
+      y(j)=int(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vdnint(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+!     y(j)=dnint(x(j))
+      y(j)=nint(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vlog10(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=log10(x(j))
+   10 continue
+      return
+      end
+
+!      subroutine vlog1p(y,x,n)
+!      real*8 x(*),y(*)
+!      interface
+!        real*8 function log1p(%val(x))
+!          real*8 x
+!        end function log1p
+!      end interface
+!      do 10 j=1,n
+!      y(j)=log1p(x(j))
+!   10 continue
+!      return
+!      end
+
+      subroutine vcosh(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=cosh(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vsinh(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=sinh(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vtanh(y,x,n)
+      real*8 x(*),y(*)
+      do 10 j=1,n
+      y(j)=tanh(x(j))
+   10 continue
+      return
+      end
+
+!      subroutine vexpm1(y,x,n)
+!      real*8 x(*),y(*)
+!      interface
+!        real*8 function expm1(%val(x))
+!          real*8 x
+!        end function expm1
+!      end interface 
+!      do 10 j=1,n
+!      y(j)=expm1(x(j))
+!   10 continue
+!      return
+!      end
+
+
+      subroutine vsasin(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=asin(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vsacos(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=acos(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vscosh(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=cosh(x(j))
+   10 continue
+      return
+      end
+
+!      subroutine vsexpm1(y,x,n)
+!      real*4 x(*),y(*)
+!      interface
+!        real*8 function expm1(%val(x))
+!          real*8 x
+!        end function expm1
+!      end interface
+!      do 10 j=1,n
+!      y(j)=expm1(real(x(j),8))
+!   10 continue
+!      return
+!      end
+
+      subroutine vslog10(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=log10(x(j))
+   10 continue
+      return
+      end
+
+!      subroutine vslog1p(y,x,n)
+!      real*4 x(*),y(*)
+!      interface
+!        real*8 function log1p(%val(x))
+!          real*8 x
+!        end function log1p
+!      end interface
+!      do 10 j=1,n
+!      y(j)=log1p(real(x(j),8))
+!   10 continue
+!      return
+!      end
+
+
+      subroutine vssinh(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=sinh(x(j))
+   10 continue
+      return
+      end
+
+      subroutine vstanh(y,x,n)
+      real*4 x(*),y(*)
+      do 10 j=1,n
+      y(j)=tanh(x(j))
+   10 continue
+      return
+      end
+#endif
+
+      subroutine vspow(z,y,x,n)
+      real*4 x(*),y(*),z(*)
+      do 10 j=1,n
+      z(j)=y(j)**x(j)
+   10 continue
+      return
+      end
+
+      subroutine vpow(z,y,x,n)
+      real*8 x(*),y(*),z(*)
+      do 10 j=1,n
+      z(j)=y(j)**x(j)
+   10 continue
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/frame/md_calls.m4
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/md_calls.m4	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/md_calls.m4	(revision 2744)
@@ -0,0 +1,354 @@
+!
+! WRF io macro file
+!
+! This file is used to generate the series of 40 meta-data get and 
+! put calls in the WRF I/O API.  It contains an M4 macro and then
+! a series of invocations of the macro to generate the subroutine
+! definitions, which are then included by the file module_io.F
+!
+
+! $1 = get|put $2=dom|var $3=type $4=[char] $5=td|ti
+
+define( md_call_2,
+`!--- $1_$2_$6_$3$4
+
+SUBROUTINE wrf_$1_$2_$6_$3$4_$5 ( DataHandle,Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, ifelse($4,char,,`Count, ifelse($1,get,`Outcount,')') Status )
+!<DESCRIPTION>
+!<PRE>
+!
+! ifelse($1,get,`Attempt to read',`Write') ifelse($4,char,,ifelse($5,arr,`Count words of '))time ifelse($6,ti,`in')dependent
+! ifelse($2,var,`attribute "Element" of variable "Varname"',`domain metadata named "Element"') ifelse($6,td,`valid at time DateStr') 
+! ifelse($1,get,`from',`to') the open dataset described by DataHandle.  
+! ifelse($2,var,`Attribute',`Metadata') of type $3$4 ifelse($2,var,`is',`are')
+! ifelse($1,put,`copied from',`stored in') ifelse($4,char,`string',ifelse($5,arr,`array',`scalar')) Data.
+! ifelse($4,char,,ifelse($5,arr,ifelse($1,get,`Actual number of words read is returned in OutCount.')))
+!
+!</PRE>
+!</DESCRIPTION>
+USE module_state_description
+IMPLICIT NONE
+INTEGER ,       INTENT(IN)  :: DataHandle
+CHARACTER*(*) , INTENT(IN)  :: Element
+ifelse($6,td,`CHARACTER*(*) , INTENT(IN)  :: DateStr')
+ifelse($2,var,`CHARACTER*(*) , INTENT(IN)  :: VarName') 
+
+ ifelse($4,char,`CHARACTER*(*)  :: Data', `ifelse($3,double,real*8,$3)  :: Data ifelse($5,arr,(*),)')
+
+ifelse($4,char,,`INTEGER ,       INTENT(IN)  :: Count')
+ifelse($4,char,,`ifelse($1,get,`INTEGER ,       INTENT(OUT)  :: OutCount')')
+INTEGER ,       INTENT(OUT) :: Status
+
+#include <wrf_status_codes.h>
+INTEGER                     :: len_of_str
+LOGICAL                     :: for_out
+INTEGER, EXTERNAL           :: use_package
+LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+INTEGER                     :: locCount
+
+INTEGER io_form , Hndl
+
+CALL wrf_debug( DEBUG_LVL, "module_io.F (md_calls.m4) : in wrf_$1_$2_$6_$3$4_$5 " )
+
+ifelse($3,integer,`locCount = Count')
+ifelse($3,real,`locCount = Count')
+ifelse($3,logical,`locCount = Count')
+
+Status = 0
+CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+IF ( Hndl .GT. -1 ) THEN
+  IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+    SELECT CASE ( use_package( io_form ) )
+#ifdef NETCDF
+      CASE ( IO_NETCDF   )
+        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+ifelse($3,real,
+`#  if ( RWORDSIZE == DWORDSIZE )
+           CALL ext_ncd_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  else
+           CALL ext_ncd_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  endif',
+`           CALL ext_ncd_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( Data, IWORDSIZE*locCount )'))
+          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( Data, RWORDSIZE*locCount )'))
+          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( Data, LWORDSIZE*locCount )'))
+          ifelse($1,get,ifelse($4,char,   `len_of_str = LEN(Data)'))
+          ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_string( Data, len_of_str )'))
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef PNETCDF
+      CASE ( IO_PNETCDF   )
+ifelse($3,real,
+`#  if ( RWORDSIZE == DWORDSIZE )
+        CALL ext_pnc_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  else
+        CALL ext_pnc_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  endif',
+`        CALL ext_pnc_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
+#endif
+#ifdef PHDF5
+      CASE ( IO_PHDF5   )
+ifelse($3,real,
+`#  if ( RWORDSIZE == DWORDSIZE )
+        CALL ext_phdf5_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  else
+        CALL ext_phdf5_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  endif',
+`        CALL ext_phdf5_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
+#endif
+#ifdef ESMFIO
+      CASE ( IO_ESMF )
+ifelse($3,real,
+`#  if ( RWORDSIZE == DWORDSIZE )
+        CALL ext_esmf_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  else
+        CALL ext_esmf_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  endif',
+`        CALL ext_esmf_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
+#endif
+#ifdef XXX
+      CASE ( IO_XXX   )
+ifelse($3,real,
+`#  if ( RWORDSIZE == DWORDSIZE )
+        CALL ext_xxx_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  else
+        CALL ext_xxx_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  endif',
+`        CALL ext_xxx_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
+#endif
+#ifdef YYY
+      CASE ( IO_YYY   )
+ifelse($3,real,
+`#  if ( RWORDSIZE == DWORDSIZE )
+        CALL ext_yyy_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  else
+        CALL ext_yyy_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  endif',
+`        CALL ext_yyy_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
+#endif
+#ifdef GRIB1
+      CASE ( IO_GRIB1   )
+        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+ifelse($3,real,
+`#  if ( RWORDSIZE == DWORDSIZE )
+           CALL ext_gr1_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  else
+           CALL ext_gr1_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  endif',
+`           CALL ext_gr1_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( Data, IWORDSIZE*locCount )'))
+          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( Data, RWORDSIZE*locCount )'))
+          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( Data, LWORDSIZE*locCount )'))
+          ifelse($1,get,ifelse($4,char,   `len_of_str = LEN(Data)'))
+          ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_string( Data, len_of_str )'))
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef GRIB2
+      CASE ( IO_GRIB2   )
+        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+ifelse($3,real,
+`#  if ( RWORDSIZE == DWORDSIZE )
+           CALL ext_gr2_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  else
+           CALL ext_gr2_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  endif',
+`           CALL ext_gr2_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( Data, IWORDSIZE*locCount )'))
+          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( Data, RWORDSIZE*locCount )'))
+          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( Data, LWORDSIZE*locCount )'))
+          ifelse($1,get,ifelse($4,char,   `len_of_str = LEN(Data)'))
+          ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_string( Data, len_of_str )'))
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef INTIO
+      CASE ( IO_INTIO   )
+        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+ifelse($3,real,
+`#  if ( RWORDSIZE == DWORDSIZE )
+           CALL ext_int_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  else
+           CALL ext_int_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+#  endif',
+`           CALL ext_int_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+           ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+           ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( Data, IWORDSIZE*locCount )'))
+           ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+           ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( Data, RWORDSIZE*locCount )'))
+           ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
+           ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( Data, LWORDSIZE*locCount )'))
+           ifelse($1,get,ifelse($4,char,   `len_of_str = LEN(Data)'))
+           ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_string( Data, len_of_str )'))
+           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        ENDIF
+#endif
+      CASE DEFAULT
+    END SELECT
+  ELSE IF ( for_out .AND. use_output_servers() ) THEN
+    CALL wrf_quilt_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
+                          ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
+  ELSE
+    Status = 0
+ENDIF
+ELSE
+  Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+ENDIF
+RETURN
+END SUBROUTINE wrf_$1_$2_$6_$3$4_$5' )
+
+define( md_call,
+`ifelse($4,char,
+`md_call_2($1,$2,$3,$4,arr,$5)'
+,
+`md_call_2($1,$2,$3,$4,arr,$5)
+md_call_2($1,$2,$3,$4,sca,$5)'
+)'
+)
+
+define( md_interface,
+`ifelse($4,char,
+`INTERFACE wrf_$1_$2_$5_$3$4
+  MODULE PROCEDURE wrf_$1_$2_$5_$3$4_arr
+END INTERFACE'
+,
+`INTERFACE wrf_$1_$2_$5_$3$4
+  MODULE PROCEDURE wrf_$1_$2_$5_$3$4_arr, wrf_$1_$2_$5_$3$4_sca
+END INTERFACE'
+)'
+)
+
+md_interface(get,dom,real,,ti)
+md_interface(put,dom,real,,ti)
+md_interface(get,dom,double,,ti)
+md_interface(put,dom,double,,ti)
+md_interface(get,dom,integer,,ti)
+md_interface(put,dom,integer,,ti)
+md_interface(get,dom,logical,,ti)
+md_interface(put,dom,logical,,ti)
+md_interface(get,dom,,char,ti)
+md_interface(put,dom,,char,ti)
+
+md_interface(get,dom,real,,td)
+md_interface(put,dom,real,,td)
+md_interface(get,dom,double,,td)
+md_interface(put,dom,double,,td)
+md_interface(get,dom,integer,,td)
+md_interface(put,dom,integer,,td)
+md_interface(get,dom,logical,,td)
+md_interface(put,dom,logical,,td)
+md_interface(get,dom,,char,td)
+md_interface(put,dom,,char,td)
+
+md_interface(get,var,real,,ti)
+md_interface(put,var,real,,ti)
+md_interface(get,var,double,,ti)
+md_interface(put,var,double,,ti)
+md_interface(get,var,integer,,ti)
+md_interface(put,var,integer,,ti)
+md_interface(get,var,logical,,ti)
+md_interface(put,var,logical,,ti)
+md_interface(get,var,,char,ti)
+md_interface(put,var,,char,ti)
+
+md_interface(get,var,real,,td)
+md_interface(put,var,real,,td)
+md_interface(get,var,double,,td)
+md_interface(put,var,double,,td)
+md_interface(get,var,integer,,td)
+md_interface(put,var,integer,,td)
+md_interface(get,var,logical,,td)
+md_interface(put,var,logical,,td)
+md_interface(get,var,,char,td)
+md_interface(put,var,,char,td)
+
+CONTAINS
+
+md_call(get,dom,real,,ti)
+md_call(put,dom,real,,ti)
+md_call(get,dom,double,,ti)
+md_call(put,dom,double,,ti)
+md_call(get,dom,integer,,ti)
+md_call(put,dom,integer,,ti)
+md_call(get,dom,logical,,ti)
+md_call(put,dom,logical,,ti)
+md_call(get,dom,,char,ti)
+md_call(put,dom,,char,ti)
+
+md_call(get,dom,real,,td)
+md_call(put,dom,real,,td)
+md_call(get,dom,double,,td)
+md_call(put,dom,double,,td)
+md_call(get,dom,integer,,td)
+md_call(put,dom,integer,,td)
+md_call(get,dom,logical,,td)
+md_call(put,dom,logical,,td)
+md_call(get,dom,,char,td)
+md_call(put,dom,,char,td)
+
+md_call(get,var,real,,ti)
+md_call(put,var,real,,ti)
+md_call(get,var,double,,ti)
+md_call(put,var,double,,ti)
+md_call(get,var,integer,,ti)
+md_call(put,var,integer,,ti)
+md_call(get,var,logical,,ti)
+md_call(put,var,logical,,ti)
+md_call(get,var,,char,ti)
+md_call(put,var,,char,ti)
+
+md_call(get,var,real,,td)
+md_call(put,var,real,,td)
+md_call(get,var,double,,td)
+md_call(put,var,double,,td)
+md_call(get,var,integer,,td)
+md_call(put,var,integer,,td)
+md_call(get,var,logical,,td)
+md_call(put,var,logical,,td)
+md_call(get,var,,char,td)
+md_call(put,var,,char,td)
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_configure.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_configure.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_configure.F	(revision 2744)
@@ -0,0 +1,345 @@
+!WRF:DRIVER_LAYER:CONFIGURATION
+!
+MODULE module_configure
+
+   USE module_driver_constants
+   USE module_state_description
+   USE module_wrf_error
+
+   TYPE model_config_rec_type
+      SEQUENCE
+! Statements that declare namelist variables are in this file
+! Note that the namelist is SEQUENCE and generated such that the first item is an
+! integer, first_item_in_struct and the last is an integer last_item_in_struct
+! this provides a way of converting this to a buffer for passing to and from
+! the driver.
+#include <namelist_defines.inc>
+   END TYPE model_config_rec_type
+
+   TYPE grid_config_rec_type
+#include <namelist_defines2.inc>
+   END TYPE grid_config_rec_type
+
+   TYPE(model_config_rec_type) :: model_config_rec
+
+#include <scalar_tables.inc>
+
+! special entries (put here but not enshrined in Registry for one reason or other)
+
+   CHARACTER (LEN=4) :: mminlu = '    '         ! character string for landuse table
+
+CONTAINS
+
+
+! Model layer, even though it does I/O -- special case of namelist I/O.
+
+   SUBROUTINE initial_config
+!<DESCRIPTION>
+! This routine reads in the namelist.input file and sets
+! module_config_rec, a structure of TYPE(model_config_rec_type), which is is seen via USE association by any
+! subprogram that uses module_configure.  The module_config_rec structure
+! contains all namelist settings for all domains.  Variables that apply
+! to the entire run and have only one value regardless of domain are
+! scalars.  Variables that allow different settings for each domain are
+! defined as arrays of dimension max_domains (defined in
+! frame/module_driver_constants.F, from a setting passed in from
+! configure.wrf). There is another type in WRF, TYPE(grid_config_rec_type), in which
+! all fields pertain only to a single domain (and are all scalars). The subroutine
+! model_to_grid_config_rec(), also in frame/module_configure.F, is used to retrieve
+! the settings for a given domain from a TYPE(module_config_rec_type) and put them into
+! a TYPE(grid_config_rec_type), variables of which type are often called <em>config_flags</em>
+! in the WRF code.
+! 
+! Most of the code in this routine is generated from the Registry file
+! rconfig entries and included from the following files (found in the inc directory):
+! 
+! <pre>
+! namelist_defines.inc	declarations of namelist variables (local to this routine)
+! namelist_statements.inc	NAMELIST statements for each variable
+! namelist_defaults.inc	assignment to default values if specified in Registry
+! config_reads.inc		read statements for each namelist record
+! config_assigns.inc	assign each variable to field in module_config_rec
+! </pre>
+!
+!NOTE: generated subroutines from Registry file rconfig entries are renamed nl_
+! instead of rconfig_ due to length limits for subroutine names.
+!
+! Note for version WRF 2.0: there is code here to force all domains to
+! have the same mp_physics setting. This is because different mp_physics
+! packages have different numbers of tracers but the nest forcing and
+! feedback code relies on the parent and nest having the same number and
+! kind of tracers. This means that the microphysics option
+! specified on the highest numbered domain is the microphysics
+! option for <em>all</em> domains in the run. This will be revisited.
+! 
+!</DESCRIPTION>
+      IMPLICIT NONE
+
+      INTEGER              :: io_status, nml_unit
+      INTEGER              :: i
+
+! define as temporaries
+#include <namelist_defines.inc>
+
+! Statements that specify the namelists
+#include <namelist_statements.inc>
+
+      OPEN ( UNIT   = 10               ,      &
+             FILE   = "namelist.input" ,      &
+             FORM   = "FORMATTED"      ,      &
+             STATUS = "OLD"            ,      &
+             IOSTAT = io_status         )
+
+      IF ( io_status .NE. 0 ) THEN
+        CALL WRF_ERROR_FATAL ( 'ERROR OPENING namelist.input' )
+      ENDIF
+
+      nml_unit = 10
+
+! Statements that set the namelist vars to default vals
+#  include <namelist_defaults.inc>
+
+! Statements that read the namelist are in this file
+#  define NAMELIST_READ_ERROR_LABEL 9200
+#  include <config_reads.inc>
+
+! 2004/04/28  JM (with consensus by the group of developers)
+! This is needed to ensure that nesting will work, since
+! different mp_physics packages have different numbers of 
+! tracers. Basically, this says that the microphysics option
+! specified on the highest numbered domain *is* the microphysics
+! option for the run. Not the best solution but okay for 2.0.
+!
+
+      DO i = 1, max_dom
+         mp_physics(i) = mp_physics(max_dom)
+      ENDDO
+
+! Statements that assign the variables to the cfg record are in this file
+! except the namelist_derived variables where are assigned below
+#undef SOURCE_RECORD
+#undef DEST_RECORD
+#undef SOURCE_REC_DEX
+#define SOURCE_RECORD 
+#define DEST_RECORD model_config_rec %
+#define SOURCE_REC_DEX
+#include <config_assigns.inc>
+
+      CLOSE ( UNIT = 10 , IOSTAT = io_status )
+
+      IF ( io_status .NE. 0 ) THEN
+        CALL WRF_ERROR_FATAL ( 'ERROR CLOSING namelist.input' )
+      ENDIF
+
+      RETURN
+9200  CONTINUE
+      CALL wrf_error_fatal( 'module_configure: initial_config: error reading namelist' )
+
+   END SUBROUTINE initial_config
+
+#if 1
+   SUBROUTINE get_config_as_buffer( buffer, buflen, ncopied )
+! note that model_config_rec_type must be defined as a sequence derived type
+      INTEGER,   INTENT(INOUT) ::  buffer(*)
+      INTEGER,   INTENT(IN)    ::  buflen
+      INTEGER,   INTENT(OUT)   ::  ncopied
+!      TYPE(model_config_rec_type) :: model_config_rec
+      INTEGER :: nbytes
+      CALL wrf_num_bytes_between ( model_config_rec%last_item_in_struct ,   &
+                                   model_config_rec%first_item_in_struct ,  &
+                                   nbytes )
+!      nbytes = loc(model_config_rec%last_item_in_struct) - &
+!               loc(model_config_rec%first_item_in_struct)
+      IF ( nbytes .gt. buflen ) THEN
+        CALL wrf_error_fatal( &
+        "get_config_rec_as_buffer: buffer size to small for config_rec" )
+      ENDIF
+      CALL wrf_mem_copy( model_config_rec, buffer, nbytes )
+      ncopied = nbytes
+      RETURN
+   END SUBROUTINE get_config_as_buffer
+
+   SUBROUTINE set_config_as_buffer( buffer, buflen )
+! note that model_config_rec_type must be defined as a sequence derived type
+      INTEGER,   INTENT(INOUT) ::  buffer(*)
+      INTEGER,   INTENT(IN)    ::  buflen
+!      TYPE(model_config_rec_type) :: model_config_rec
+      INTEGER :: nbytes
+      CALL wrf_num_bytes_between ( model_config_rec%last_item_in_struct ,  &
+                                   model_config_rec%first_item_in_struct , &
+                                   nbytes )
+!      nbytes = loc(model_config_rec%last_item_in_struct) - &
+!               loc(model_config_rec%first_item_in_struct)
+      IF ( nbytes .gt. buflen ) THEN
+        CALL wrf_error_fatal( &
+        "set_config_rec_as_buffer: buffer length too small to fill model config record" )
+      ENDIF
+      CALL wrf_mem_copy( buffer, model_config_rec, nbytes )
+      RETURN
+   END SUBROUTINE set_config_as_buffer
+#else
+   SUBROUTINE get_config_as_buffer( buffer, buflen, ncopied )
+! note that model_config_rec_type must be defined as a sequence derived type
+      INTEGER*1, INTENT(INOUT) ::  buffer(*)
+      INTEGER,   INTENT(IN)    ::  buflen
+      INTEGER,   INTENT(OUT)   ::  ncopied
+!      TYPE(model_config_rec_type) :: model_config_rec
+      INTEGER :: nbytes
+      nbytes = loc(model_config_rec%last_item_in_struct) - &
+               loc(model_config_rec%first_item_in_struct)
+      IF ( nbytes .gt. buflen ) THEN
+        CALL wrf_error_fatal( &
+        "get_config_rec_as_buffer: buffer size to small for config_rec" )
+      ENDIF
+      CALL wrf_mem_copy( model_config_rec, buffer, nbytes )
+      ncopied = nbytes
+      RETURN
+   END SUBROUTINE get_config_as_buffer
+
+   SUBROUTINE set_config_as_buffer( buffer, buflen )
+! note that model_config_rec_type must be defined as a sequence derived type
+      INTEGER*1, INTENT(INOUT) ::  buffer(*)
+      INTEGER,   INTENT(IN)    ::  buflen
+!      TYPE(model_config_rec_type) :: model_config_rec
+      INTEGER :: nbytes
+      nbytes = loc(model_config_rec%last_item_in_struct) - &
+               loc(model_config_rec%first_item_in_struct)
+      IF ( nbytes .gt. buflen ) THEN
+        CALL wrf_error_fatal( &
+        "set_config_rec_as_buffer: buffer length too small to fill model config record" )
+      ENDIF
+      CALL wrf_mem_copy( buffer, model_config_rec, nbytes )
+      RETURN
+   END SUBROUTINE set_config_as_buffer
+#endif
+
+   SUBROUTINE model_to_grid_config_rec ( id_id , model_config_rec , grid_config_rec )
+      INTEGER , INTENT(IN)                         ::  id_id
+      TYPE ( model_config_rec_type ) , INTENT(IN)  ::  model_config_rec
+      TYPE ( grid_config_rec_type  ) , INTENT(OUT) ::  grid_config_rec
+! <DESCRIPTION>
+! This routine is called to populate a domain specific configuration
+! record of TYPE(grid_config_rec_type) with the configuration information
+! for that domain that is stored in TYPE(model_config_rec). Both types
+! are defined in frame/module_configure.F.  The input argument is the
+! record of type model_config_rec_type contains the model-wide
+! configuration information (that is, settings that apply to the model in
+! general) and configuration information for each individual domain.  The
+! output argument is the record of type grid_config_rec_type which
+! contains the model-wide configuration information and the
+! domain-specific information for this domain only.  In the
+! model_config_rec, the domain specific information is arrays, indexed by
+! the grid id's.  In the grid_config_rec the domain-specific information
+! is scalar and for the specific domain.  The first argument to this
+! routine is the grid id (top-most domain is always 1) as specified in
+! the domain-specific namelist variable grid_id.
+! 
+! The actual assignments form the model_config_rec_type to the
+! grid_config_rec_type are generate from the rconfig entries in the
+! Registry file and included by this routine from the file
+! inc/config_assigns.inc.
+!
+!NOTE: generated subroutines from Registry file rconfig entries are renamed nl_
+! instead of rconfig_ due to length limits for subroutine names.
+!
+! 
+! </DESCRIPTION>
+#undef SOURCE_RECORD
+#undef SOURCE_REC_DEX
+#undef DEST_RECORD
+#define SOURCE_RECORD model_config_rec %
+#define SOURCE_REC_DEX (id_id)
+#define DEST_RECORD   grid_config_rec %
+#include <config_assigns.inc>
+   END SUBROUTINE model_to_grid_config_rec
+
+! Include the definitions of all the routines that return a namelist values
+! back to the driver. These are generated by the registry
+
+   SUBROUTINE init_module_configure
+     IMPLICIT NONE
+     ! Local vars
+
+     INTEGER i , j
+
+     DO j = 1, max_domains
+#include <scalar_tables_init.inc>
+     END DO
+   END SUBROUTINE init_module_configure
+
+! When the compiler has Intel Inside (TM) (that is, ifort), the large
+! number of nl_get and nl_set routines inside the module causes the
+! compiler to never finish with this routine. For ifort, move the
+! routines outside the module. Note, the registry generates a 
+! USE module_configure for all the nl_get and nl_set routines
+! if IFORT_KLUDGE is in effect.
+#ifdef IFORT_KLUDGE
+
+END MODULE module_configure
+
+# include <get_nl_config.inc>
+
+#else
+
+# include <get_nl_config.inc>
+
+END MODULE module_configure
+
+#endif
+
+! Special (outside registry)
+SUBROUTINE nl_get_mminlu ( idum , retval )
+  USE module_configure
+  CHARACTER(LEN=4)  :: retval
+  INTEGER idum
+  retval(1:4) = mminlu(1:4)   ! mminlu is defined in module_configure
+  RETURN
+END SUBROUTINE nl_get_mminlu
+SUBROUTINE nl_set_mminlu ( idum, inval )
+  USE module_configure
+  CHARACTER(LEN=4) :: inval
+  INTEGER idum
+  mminlu(1:4) = inval(1:4)    ! mminlu is defined in module_configure
+  RETURN
+END SUBROUTINE nl_set_mminlu
+
+
+SUBROUTINE set_scalar_indices_from_config ( idomain , dummy2, dummy1 )
+  USE module_driver_constants
+  USE module_state_description
+  USE module_wrf_error
+  USE module_configure
+  IMPLICIT NONE
+  INTEGER , INTENT(IN)  :: idomain
+  INTEGER               :: dummy1
+  INTEGER               :: dummy2
+
+!<DESCRIPTION>
+!This routine is called to adjust the integer variables that are defined
+!in frame/module_state_description.F (Registry-generated) and that serve
+!as indices into 4D tracer arrays for moisture, chemistry, etc.
+!Different domains (different grid data structures) are allowed to have
+!different sets of tracers so these indices can vary from domain to
+!domain. However, since the indices are defined globally in
+!module_state_description (a shortcoming in the current software), it is
+!necessary that these indices be reset each time a different grid is to
+!be computed on.
+!
+!The scalar idices are set according to the particular physics
+!packages -- more specifically in the case of the moisture tracers, microphysics
+!packages -- that are stored for each domain in model_config_rec and
+!indexed by the grid id, passed in as an argument to this routine.  (The
+!initial_config() routine in module_configure is what reads the
+!namelist.input file and sets model_config_rec.)
+!
+!The actual code for calculating the scalar indices on a particular
+!domain is generated from the Registry state array definitions for the
+!4d tracers and from the package definitions that indicate which physics
+!packages use which tracers.
+!
+!</DESCRIPTION>
+
+#include <scalar_indices.inc>
+#include <scalar_indices_init.inc>
+  RETURN
+END SUBROUTINE set_scalar_indices_from_config
Index: trunk/WRF.COMMON/WRFV2/frame/module_dm_stubs.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_dm_stubs.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_dm_stubs.F	(revision 2744)
@@ -0,0 +1,300 @@
+!WRF:PACKAGE:NODM
+!
+MODULE module_dm
+
+  CONTAINS
+   SUBROUTINE init_module_dm
+   END SUBROUTINE init_module_dm
+
+   REAL FUNCTION wrf_dm_max_real ( inval )
+      IMPLICIT NONE
+      REAL inval
+      wrf_dm_max_real = inval
+   END FUNCTION wrf_dm_max_real
+
+   REAL FUNCTION wrf_dm_min_real ( inval )
+      IMPLICIT NONE
+      REAL inval
+      wrf_dm_min_real = inval
+   END FUNCTION wrf_dm_min_real
+
+   REAL FUNCTION wrf_dm_sum_real ( inval )
+      IMPLICIT NONE
+      REAL inval
+      wrf_dm_sum_real = inval
+   END FUNCTION wrf_dm_sum_real
+
+   INTEGER FUNCTION wrf_dm_sum_integer ( inval )
+      IMPLICIT NONE
+      INTEGER inval
+      wrf_dm_sum_integer = inval
+   END FUNCTION wrf_dm_sum_integer
+
+   SUBROUTINE wrf_dm_maxval ( val, idex, jdex )
+      IMPLICIT NONE
+      REAL val
+      INTEGER idex, jdex
+      RETURN
+   END SUBROUTINE wrf_dm_maxval
+
+! stub
+   SUBROUTINE wrf_dm_move_nest ( parent, nest, dx, dy )
+      USE module_domain
+      TYPE (domain), INTENT(INOUT) :: parent, nest
+      INTEGER, INTENT(IN)          :: dx,dy
+      RETURN
+   END SUBROUTINE wrf_dm_move_nest
+
+END MODULE module_dm
+
+!=========================================================================
+
+! These are stub functions that do the right thing (usually nothing)
+! in case DM_PARALLEL is not compiled for.
+! This file, src/module_dm_stubs.F is copied to src/module_dm.F  when
+! the code is built.
+! If, on the other hand, a DM package is specified, the module_dm.F 
+! provided with that package (e.g. RSL) is copied from /external/RSL/module_dm.F
+! into src/module_dm.F.
+! It is important to recognize this, because changes directly to src/module_dm.F
+! will be lost!
+
+LOGICAL FUNCTION wrf_dm_on_monitor()
+  wrf_dm_on_monitor = .true.
+END FUNCTION wrf_dm_on_monitor
+
+SUBROUTINE wrf_get_myproc( myproc )
+  IMPLICIT NONE
+  INTEGER myproc
+  myproc = 0
+  RETURN
+END SUBROUTINE wrf_get_myproc
+
+SUBROUTINE wrf_get_nproc( nprocs )
+  IMPLICIT NONE
+  INTEGER nprocs
+  nprocs = 1
+  RETURN
+END SUBROUTINE wrf_get_nproc
+
+SUBROUTINE wrf_get_nprocx( nprocs )
+  IMPLICIT NONE
+  INTEGER nprocs
+  nprocs = 1
+  RETURN
+END SUBROUTINE wrf_get_nprocx
+
+SUBROUTINE wrf_get_nprocy( nprocs )
+  IMPLICIT NONE
+  INTEGER nprocs
+  nprocs = 1
+  RETURN
+END SUBROUTINE wrf_get_nprocy
+
+SUBROUTINE wrf_dm_bcast_string ( buf , size )
+  IMPLICIT NONE
+  INTEGER size
+  INTEGER BUF(*)
+  RETURN
+END SUBROUTINE wrf_dm_bcast_string
+
+SUBROUTINE wrf_dm_bcast_bytes ( buf , size )
+  IMPLICIT NONE
+  INTEGER size
+  INTEGER BUF(*)
+  RETURN
+END SUBROUTINE wrf_dm_bcast_bytes
+
+SUBROUTINE wrf_dm_bcast_integer( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   INTEGER  buf(*)
+   RETURN
+END SUBROUTINE wrf_dm_bcast_integer
+
+SUBROUTINE wrf_dm_bcast_real( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   REAL  buf(*)
+   RETURN
+END SUBROUTINE wrf_dm_bcast_real
+
+SUBROUTINE wrf_dm_bcast_logical( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   LOGICAL  buf(*)
+   RETURN
+END SUBROUTINE wrf_dm_bcast_logical
+
+SUBROUTINE wrf_dm_halo ( domdesc , comms , stencil_id )
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , stencil_id
+   RETURN
+END SUBROUTINE wrf_dm_halo
+
+SUBROUTINE wrf_dm_boundary ( domdesc , comms , period_id , &
+                             periodic_x , periodic_y )
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*) , period_id
+   LOGICAL , INTENT(IN)      :: periodic_x, periodic_y
+   RETURN
+END SUBROUTINE wrf_dm_boundary
+
+SUBROUTINE wrf_dm_xpose_z2x ( domdesc , comms , xpose_id  )
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*), xpose_id
+   RETURN
+END SUBROUTINE wrf_dm_xpose_z2x
+SUBROUTINE wrf_dm_xpose_x2y ( domdesc , comms , xpose_id  )
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*), xpose_id
+   RETURN
+END SUBROUTINE wrf_dm_xpose_x2y
+SUBROUTINE wrf_dm_xpose_y2z ( domdesc , comms , xpose_id  )
+   IMPLICIT NONE
+   INTEGER domdesc , comms(*), xpose_id
+   RETURN
+END SUBROUTINE wrf_dm_xpose_y2z
+
+SUBROUTINE wrf_dm_define_comms ( grid )
+   USE module_domain
+   IMPLICIT NONE
+   TYPE(domain) , INTENT (INOUT) :: grid
+   RETURN
+END SUBROUTINE wrf_dm_define_comms
+
+SUBROUTINE wrf_get_dm_communicator ( communicator )
+   IMPLICIT NONE
+   INTEGER , INTENT(OUT) :: communicator
+   communicator = 0
+   RETURN
+END SUBROUTINE wrf_get_dm_communicator
+
+SUBROUTINE wrf_get_dm_iocommunicator ( iocommunicator )
+   IMPLICIT NONE
+   INTEGER , INTENT(OUT) :: iocommunicator
+   iocommunicator = 0
+   RETURN
+END SUBROUTINE wrf_get_dm_iocommunicator
+
+SUBROUTINE wrf_dm_shutdown
+      RETURN
+END SUBROUTINE wrf_dm_shutdown
+SUBROUTINE wrf_abort
+      STOP 'wrf_abort'
+END SUBROUTINE wrf_abort
+
+SUBROUTINE wrf_patch_to_global_real (buf,globbuf,domdesc,ndim,&
+                                       ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe )
+   IMPLICIT NONE
+   INTEGER                             ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+   INTEGER fid,domdesc,ndim,glen(3),llen(3)
+   REAL globbuf(*)
+   REAL buf(*)
+   RETURN
+END SUBROUTINE wrf_patch_to_global_real
+
+SUBROUTINE wrf_global_to_patch_real (globbuf,buf,domdesc,ndim,&
+                                       ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe )
+   IMPLICIT NONE
+   INTEGER                             ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+   INTEGER fid,domdesc,ndim,glen(3),llen(3)
+   REAL globbuf(*)
+   REAL buf(*)
+   RETURN
+END SUBROUTINE wrf_global_to_patch_real
+
+
+SUBROUTINE wrf_patch_to_global_double (buf,globbuf,domdesc,ndim,&
+                                       ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe )
+   IMPLICIT NONE
+   INTEGER                             ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+   INTEGER fid,domdesc,ndim,glen(3),llen(3)
+   DOUBLE PRECISION globbuf(*)
+   DOUBLE PRECISION buf(*)
+   RETURN
+END SUBROUTINE wrf_patch_to_global_double
+
+SUBROUTINE wrf_global_to_patch_double (globbuf,buf,domdesc,ndim,&
+                                       ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe )
+   IMPLICIT NONE
+   INTEGER                             ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+   INTEGER fid,domdesc,ndim,glen(3),llen(3)
+   DOUBLE PRECISION globbuf(*)
+   DOUBLE PRECISION buf(*)
+   RETURN
+END SUBROUTINE wrf_global_to_patch_double
+
+SUBROUTINE wrf_patch_to_global_integer (buf,globbuf,domdesc,ndim,&
+                                       ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe )
+   IMPLICIT NONE
+   INTEGER                             ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+   INTEGER fid,domdesc,ndim,glen(3),llen(3)
+   INTEGER globbuf(*)
+   INTEGER buf(*)
+   RETURN
+END SUBROUTINE wrf_patch_to_global_integer
+
+SUBROUTINE wrf_global_to_patch_integer (globbuf,buf,domdesc,ndim,&
+                                       ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe )
+   IMPLICIT NONE
+   INTEGER                             ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+   INTEGER fid,domdesc,ndim,glen(3),llen(3)
+   INTEGER globbuf(*)
+   INTEGER buf(*)
+   RETURN
+END SUBROUTINE wrf_global_to_patch_integer
+
+SUBROUTINE wrf_patch_to_global_logical (buf,globbuf,domdesc,ndim,&
+                                       ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe )
+   IMPLICIT NONE
+   INTEGER                             ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+   INTEGER fid,domdesc,ndim,glen(3),llen(3)
+   LOGICAL globbuf(*)
+   LOGICAL buf(*)
+   RETURN
+END SUBROUTINE wrf_patch_to_global_logical
+
+SUBROUTINE wrf_global_to_patch_LOGICAL (globbuf,buf,domdesc,ndim,&
+                                       ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe )
+   IMPLICIT NONE
+   INTEGER                             ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+   INTEGER fid,domdesc,ndim,glen(3),llen(3)
+   LOGICAL globbuf(*)
+   LOGICAL buf(*)
+   RETURN
+END SUBROUTINE wrf_global_to_patch_LOGICAL
+
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_dm_warning
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_dm_warning	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_dm_warning	(revision 2744)
@@ -0,0 +1,14 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!                  W A R N I N G
+!!
+!!  This is a temporary version of module_dm.F
+!!  It has been compied from somewhere else
+!!  (If not DM_PARALLEL then this is module_dm_stubs.F;
+!!  otherwise, it is from one of the external package
+!!  directories.)
+!!
+!!                B E   A D V I S E D
+!!
+!!  Changes to this file are liable to be LOST.
+!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/WRF.COMMON/WRFV2/frame/module_domain.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_domain.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_domain.F	(revision 2744)
@@ -0,0 +1,2373 @@
+!WRF:DRIVER_LAYER:DOMAIN_OBJECT
+!
+!  Following are the routines contained within this MODULE:
+
+!  alloc_and_configure_domain        1. Allocate the space for a single domain (constants
+!                                       and null terminate pointers).
+!                                    2. Connect the domains as a linked list.
+!                                    3. Store all of the domain constants.
+!                                    4. CALL alloc_space_field.
+
+!  alloc_space_field                 1. Allocate space for the gridded data required for
+!                                       each domain.
+
+!  dealloc_space_domain              1. Reconnect linked list nodes since the current
+!                                       node is removed.
+!                                    2. CALL dealloc_space_field.
+!                                    3. Deallocate single domain.
+
+!  dealloc_space_field               1. Deallocate each of the fields for a particular
+!                                       domain.
+
+!  first_loc_integer                 1. Find the first incidence of a particular
+!                                       domain identifier from an array of domain
+!                                       identifiers.
+
+MODULE module_domain
+
+   USE module_driver_constants
+   USE module_machine
+   USE module_state_description
+   USE module_configure
+   USE module_wrf_error
+   USE module_utility
+
+   CHARACTER (LEN=80) program_name
+
+   !  An entire domain.  This contains multiple meteorological fields by having
+   !  arrays (such as "data_3d") of pointers for each field.  Also inside each
+   !  domain is a link to a couple of other domains, one is just the 
+   !  "next" domain that is to be stored, the other is the next domain which 
+   !  happens to also be on the "same_level".
+
+   TYPE domain_ptr
+      TYPE(domain), POINTER :: ptr
+   END TYPE domain_ptr
+
+   INTEGER, PARAMETER :: HISTORY_ALARM=1, AUXHIST1_ALARM=2, AUXHIST2_ALARM=3,     &
+                         AUXHIST3_ALARM=4, AUXHIST4_ALARM=5, AUXHIST5_ALARM=6,    &
+                         AUXHIST6_ALARM=7, AUXHIST7_ALARM=8, AUXHIST8_ALARM=9,    &
+                         AUXHIST9_ALARM=10, AUXHIST10_ALARM=11, AUXHIST11_ALARM=12,    &
+                         AUXINPUT1_ALARM=13, AUXINPUT2_ALARM=14, AUXINPUT3_ALARM=15, &
+                         AUXINPUT4_ALARM=16, AUXINPUT5_ALARM=17,                  &
+                         AUXINPUT6_ALARM=18, AUXINPUT7_ALARM=19, AUXINPUT8_ALARM=20, &
+                         AUXINPUT9_ALARM=21, AUXINPUT10_ALARM=22, AUXINPUT11_ALARM=23, &
+                         RESTART_ALARM=24, BOUNDARY_ALARM=25, INPUTOUT_ALARM=26,  &  ! for outputing input (e.g. for 3dvar)
+                         ALARM_SUBTIME=27,                                        &
+#ifdef MOVE_NESTS
+                         COMPUTE_VORTEX_CENTER_ALARM=28,                          &
+                         MAX_WRF_ALARMS=28  ! WARNING:  MAX_WRF_ALARMS must be 
+                                            ! large enough to include all of 
+                                            ! the alarms declared above.  
+#else
+                         MAX_WRF_ALARMS=27  ! WARNING:  MAX_WRF_ALARMS must be 
+                                            ! large enough to include all of 
+                                            ! the alarms declared above.  
+#endif
+
+#include <state_subtypes.inc>
+
+   TYPE domain
+
+! SEE THE INCLUDE FILE FOR DEFINITIONS OF STATE FIELDS WITHIN THE DOMAIN DATA STRUCTURE
+#include <state_struct.inc>
+
+      INTEGER                                             :: comms( max_comms ), shift_x, shift_y
+
+      INTEGER                                             :: id
+      INTEGER                                             :: domdesc
+      INTEGER                                             :: communicator
+      INTEGER                                             :: iocommunicator
+      INTEGER,POINTER                                     :: mapping(:,:)
+      INTEGER,POINTER                                     :: i_start(:),i_end(:)
+      INTEGER,POINTER                                     :: j_start(:),j_end(:)
+      INTEGER                                             :: max_tiles
+      INTEGER                                             :: num_tiles        ! taken out of namelist 20000908
+      INTEGER                                             :: num_tiles_x      ! taken out of namelist 20000908
+      INTEGER                                             :: num_tiles_y      ! taken out of namelist 20000908
+      INTEGER                                             :: num_tiles_spec   ! place to store number of tiles computed from 
+                                                                              ! externally specified params
+
+      TYPE(domain_ptr) , DIMENSION( : ) , POINTER         :: parents                            
+      TYPE(domain_ptr) , DIMENSION( : ) , POINTER         :: nests                            
+      TYPE(domain) , POINTER                              :: sibling ! overlapped domains at same lev
+      TYPE(domain) , POINTER                              :: intermediate_grid
+      INTEGER                                             :: num_parents, num_nests, num_siblings
+      INTEGER      , DIMENSION( max_parents )             :: child_of_parent
+      INTEGER      , DIMENSION( max_nests )               :: active
+
+      INTEGER      , DIMENSION(0:5)                       :: nframes          ! frames per outfile for history 
+                                                                              ! streams (0 is main history)                  
+
+      TYPE(domain) , POINTER                              :: next
+      TYPE(domain) , POINTER                              :: same_level
+
+      LOGICAL      , DIMENSION ( 4 )                      :: bdy_mask         ! which boundaries are on processor
+
+      LOGICAL                                             :: first_force
+
+      ! domain dimensions
+
+      INTEGER    :: sd31,   ed31,   sd32,   ed32,   sd33,   ed33,         &
+                    sd21,   ed21,   sd22,   ed22,                         &
+                    sd11,   ed11
+
+      INTEGER    :: sp31,   ep31,   sp32,   ep32,   sp33,   ep33,         &
+                    sp21,   ep21,   sp22,   ep22,                         &
+                    sp11,   ep11,                                         &
+                    sm31,   em31,   sm32,   em32,   sm33,   em33,         &
+                    sm21,   em21,   sm22,   em22,                         &
+                    sm11,   em11,                                         &
+                    sp31x,  ep31x,  sp32x,  ep32x,  sp33x,  ep33x,        &
+                    sp21x,  ep21x,  sp22x,  ep22x,                        &
+                    sm31x,  em31x,  sm32x,  em32x,  sm33x,  em33x,        &
+                    sm21x,  em21x,  sm22x,  em22x,                        &
+                    sp31y,  ep31y,  sp32y,  ep32y,  sp33y,  ep33y,        &
+                    sp21y,  ep21y,  sp22y,  ep22y,                        &
+                    sm31y,  em31y,  sm32y,  em32y,  sm33y,  em33y,        &
+                    sm21y,  em21y,  sm22y,  em22y
+      Type(WRFU_Clock), POINTER                           :: domain_clock
+      Type(WRFU_Time)                                     :: start_subtime, stop_subtime
+      Type(WRFU_Time)                                     :: this_bdy_time, next_bdy_time
+      Type(WRFU_Time)                                     :: this_emi_time, next_emi_time
+      Type(WRFU_TimeInterval), DIMENSION(MAX_WRF_ALARMS)  :: io_intervals
+      Type(WRFU_Alarm), POINTER :: alarms(:)
+! This awful hackery accounts for the fact that ESMF2.2.0 objects cannot tell 
+! us if they have ever been created or not.  So, we have to keep track of this 
+! ourselves to avoid destroying an object that has never been created!  Rip 
+! this out once ESMF has useful introspection for creation...  
+      LOGICAL :: domain_clock_created
+      LOGICAL, POINTER :: alarms_created(:)
+
+      ! Have clocks and times been initialized yet?
+      LOGICAL :: time_set
+      ! This flag controls first-time-step behavior for ESMF runs 
+      ! which require components to return to the top-level driver 
+      ! after initializing import and export states.  In WRF, this 
+      ! initialization is done in the "training phase" of 
+      ! med_before_solve_io().  
+      LOGICAL                                             :: return_after_training_io
+
+   END TYPE domain
+
+   !  Now that a "domain" TYPE exists, we can use it to store a few pointers
+   !  to this type.  These are primarily for use in traversing the linked list.
+   !  The "head_grid" is always the pointer to the first domain that is
+   !  allocated.  This is available and is not to be changed.  The others are
+   !  just temporary pointers.
+
+   TYPE(domain) , POINTER :: head_grid , new_grid , next_grid , old_grid
+
+   !  To facilitate an easy integration of each of the domains that are on the
+   !  same level, we have an array for the head pointer for each level.  This
+   !  removed the need to search through the linked list at each time step to
+   !  find which domains are to be active.
+
+   TYPE domain_levels
+      TYPE(domain) , POINTER                              :: first_domain
+   END TYPE domain_levels
+
+   TYPE(domain_levels) , DIMENSION(max_levels)            :: head_for_each_level
+
+   ! Use this to support debugging features, giving easy access to clock, etc.  
+   TYPE(domain), POINTER :: current_grid
+   LOGICAL, SAVE :: current_grid_set = .FALSE.
+
+   ! internal routines
+   PRIVATE domain_time_test_print
+   PRIVATE test_adjust_io_timestr
+
+CONTAINS
+
+   SUBROUTINE adjust_domain_dims_for_move( grid , dx, dy )
+    IMPLICIT NONE
+
+    TYPE( domain ), POINTER   :: grid
+    INTEGER, INTENT(IN) ::  dx, dy
+
+    data_ordering : SELECT CASE ( model_data_order )
+       CASE  ( DATA_ORDER_XYZ )
+            grid%sm31  =             grid%sm31 + dx
+            grid%em31  =             grid%em31 + dx
+            grid%sm32  =             grid%sm32 + dy
+            grid%em32  =             grid%em32 + dy
+            grid%sp31  =             grid%sp31 + dx
+            grid%ep31  =             grid%ep31 + dx
+            grid%sp32  =             grid%sp32 + dy
+            grid%ep32  =             grid%ep32 + dy
+            grid%sd31  =             grid%sd31 + dx
+            grid%ed31  =             grid%ed31 + dx
+            grid%sd32  =             grid%sd32 + dy
+            grid%ed32  =             grid%ed32 + dy
+
+       CASE  ( DATA_ORDER_YXZ )
+            grid%sm31  =             grid%sm31 + dy
+            grid%em31  =             grid%em31 + dy
+            grid%sm32  =             grid%sm32 + dx
+            grid%em32  =             grid%em32 + dx
+            grid%sp31  =             grid%sp31 + dy
+            grid%ep31  =             grid%ep31 + dy
+            grid%sp32  =             grid%sp32 + dx
+            grid%ep32  =             grid%ep32 + dx
+            grid%sd31  =             grid%sd31 + dy
+            grid%ed31  =             grid%ed31 + dy
+            grid%sd32  =             grid%sd32 + dx
+            grid%ed32  =             grid%ed32 + dx
+
+       CASE  ( DATA_ORDER_ZXY )
+            grid%sm32  =             grid%sm32 + dx
+            grid%em32  =             grid%em32 + dx
+            grid%sm33  =             grid%sm33 + dy
+            grid%em33  =             grid%em33 + dy
+            grid%sp32  =             grid%sp32 + dx
+            grid%ep32  =             grid%ep32 + dx
+            grid%sp33  =             grid%sp33 + dy
+            grid%ep33  =             grid%ep33 + dy
+            grid%sd32  =             grid%sd32 + dx
+            grid%ed32  =             grid%ed32 + dx
+            grid%sd33  =             grid%sd33 + dy
+            grid%ed33  =             grid%ed33 + dy
+
+       CASE  ( DATA_ORDER_ZYX )
+            grid%sm32  =             grid%sm32 + dy
+            grid%em32  =             grid%em32 + dy
+            grid%sm33  =             grid%sm33 + dx
+            grid%em33  =             grid%em33 + dx
+            grid%sp32  =             grid%sp32 + dy
+            grid%ep32  =             grid%ep32 + dy
+            grid%sp33  =             grid%sp33 + dx
+            grid%ep33  =             grid%ep33 + dx
+            grid%sd32  =             grid%sd32 + dy
+            grid%ed32  =             grid%ed32 + dy
+            grid%sd33  =             grid%sd33 + dx
+            grid%ed33  =             grid%ed33 + dx
+
+       CASE  ( DATA_ORDER_XZY )
+            grid%sm31  =             grid%sm31 + dx
+            grid%em31  =             grid%em31 + dx
+            grid%sm33  =             grid%sm33 + dy
+            grid%em33  =             grid%em33 + dy
+            grid%sp31  =             grid%sp31 + dx
+            grid%ep31  =             grid%ep31 + dx
+            grid%sp33  =             grid%sp33 + dy
+            grid%ep33  =             grid%ep33 + dy
+            grid%sd31  =             grid%sd31 + dx
+            grid%ed31  =             grid%ed31 + dx
+            grid%sd33  =             grid%sd33 + dy
+            grid%ed33  =             grid%ed33 + dy
+
+       CASE  ( DATA_ORDER_YZX )
+            grid%sm31  =             grid%sm31 + dy
+            grid%em31  =             grid%em31 + dy
+            grid%sm33  =             grid%sm33 + dx
+            grid%em33  =             grid%em33 + dx
+            grid%sp31  =             grid%sp31 + dy
+            grid%ep31  =             grid%ep31 + dy
+            grid%sp33  =             grid%sp33 + dx
+            grid%ep33  =             grid%ep33 + dx
+            grid%sd31  =             grid%sd31 + dy
+            grid%ed31  =             grid%ed31 + dy
+            grid%sd33  =             grid%sd33 + dx
+            grid%ed33  =             grid%ed33 + dx
+
+    END SELECT data_ordering
+
+#if 0
+    CALL dealloc_space_field ( grid )
+
+    CALL alloc_space_field ( grid, grid%id , 1 , 2 , .FALSE. ,     &
+                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
+                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
+                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
+                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
+      )
+#endif
+
+    RETURN
+
+   END SUBROUTINE adjust_domain_dims_for_move
+
+
+   SUBROUTINE get_ijk_from_grid (  grid ,                   &
+                           ids, ide, jds, jde, kds, kde,    &
+                           ims, ime, jms, jme, kms, kme,    &
+                           ips, ipe, jps, jpe, kps, kpe    )
+
+    IMPLICIT NONE
+
+    TYPE( domain ), INTENT (IN)  :: grid
+    INTEGER, INTENT(OUT) ::                                 &
+                           ids, ide, jds, jde, kds, kde,    &
+                           ims, ime, jms, jme, kms, kme,    &
+                           ips, ipe, jps, jpe, kps, kpe
+
+    data_ordering : SELECT CASE ( model_data_order )
+       CASE  ( DATA_ORDER_XYZ )
+           ids             = grid%sd31 
+           ide             = grid%ed31 
+           jds             = grid%sd32 
+           jde             = grid%ed32 
+           kds             = grid%sd33 
+           kde             = grid%ed33 
+           ims             = grid%sm31 
+           ime             = grid%em31 
+           jms             = grid%sm32 
+           jme             = grid%em32 
+           kms             = grid%sm33 
+           kme             = grid%em33 
+           ips             = grid%sp31 
+           ipe             = grid%ep31 
+           jps             = grid%sp32 
+           jpe             = grid%ep32 
+           kps             = grid%sp33 
+           kpe             = grid%ep33 
+
+       CASE  ( DATA_ORDER_YXZ )
+           ids             = grid%sd32 
+           ide             = grid%ed32 
+           jds             = grid%sd31 
+           jde             = grid%ed31 
+           kds             = grid%sd33 
+           kde             = grid%ed33 
+           ims             = grid%sm32 
+           ime             = grid%em32 
+           jms             = grid%sm31 
+           jme             = grid%em31 
+           kms             = grid%sm33 
+           kme             = grid%em33 
+           ips             = grid%sp32 
+           ipe             = grid%ep32 
+           jps             = grid%sp31 
+           jpe             = grid%ep31 
+           kps             = grid%sp33 
+           kpe             = grid%ep33 
+
+       CASE  ( DATA_ORDER_ZXY )
+           ids             = grid%sd32 
+           ide             = grid%ed32 
+           jds             = grid%sd33 
+           jde             = grid%ed33 
+           kds             = grid%sd31 
+           kde             = grid%ed31 
+           ims             = grid%sm32 
+           ime             = grid%em32 
+           jms             = grid%sm33 
+           jme             = grid%em33 
+           kms             = grid%sm31 
+           kme             = grid%em31 
+           ips             = grid%sp32 
+           ipe             = grid%ep32 
+           jps             = grid%sp33 
+           jpe             = grid%ep33 
+           kps             = grid%sp31 
+           kpe             = grid%ep31 
+
+       CASE  ( DATA_ORDER_ZYX )
+           ids             = grid%sd33 
+           ide             = grid%ed33 
+           jds             = grid%sd32 
+           jde             = grid%ed32 
+           kds             = grid%sd31 
+           kde             = grid%ed31 
+           ims             = grid%sm33 
+           ime             = grid%em33 
+           jms             = grid%sm32 
+           jme             = grid%em32 
+           kms             = grid%sm31 
+           kme             = grid%em31 
+           ips             = grid%sp33 
+           ipe             = grid%ep33 
+           jps             = grid%sp32 
+           jpe             = grid%ep32 
+           kps             = grid%sp31 
+           kpe             = grid%ep31 
+
+       CASE  ( DATA_ORDER_XZY )
+           ids             = grid%sd31 
+           ide             = grid%ed31 
+           jds             = grid%sd33 
+           jde             = grid%ed33 
+           kds             = grid%sd32 
+           kde             = grid%ed32 
+           ims             = grid%sm31 
+           ime             = grid%em31 
+           jms             = grid%sm33 
+           jme             = grid%em33 
+           kms             = grid%sm32 
+           kme             = grid%em32 
+           ips             = grid%sp31 
+           ipe             = grid%ep31 
+           jps             = grid%sp33 
+           jpe             = grid%ep33 
+           kps             = grid%sp32 
+           kpe             = grid%ep32 
+
+       CASE  ( DATA_ORDER_YZX )
+           ids             = grid%sd33 
+           ide             = grid%ed33 
+           jds             = grid%sd31 
+           jde             = grid%ed31 
+           kds             = grid%sd32 
+           kde             = grid%ed32 
+           ims             = grid%sm33 
+           ime             = grid%em33 
+           jms             = grid%sm31 
+           jme             = grid%em31 
+           kms             = grid%sm32 
+           kme             = grid%em32 
+           ips             = grid%sp33 
+           ipe             = grid%ep33 
+           jps             = grid%sp31 
+           jpe             = grid%ep31 
+           kps             = grid%sp32 
+           kpe             = grid%ep32 
+
+    END SELECT data_ordering
+   END SUBROUTINE get_ijk_from_grid
+
+! Default version ; Otherwise module containing interface to DM library will provide
+
+   SUBROUTINE wrf_patch_domain( id , domdesc , parent, parent_id , parent_domdesc , &
+                            sd1 , ed1 , sp1 , ep1 , sm1 , em1 , &
+                            sd2 , ed2 , sp2 , ep2 , sm2 , em2 , &
+                            sd3 , ed3 , sp3 , ep3 , sm3 , em3 , &
+                                        sp1x , ep1x , sm1x , em1x , &
+                                        sp2x , ep2x , sm2x , em2x , &
+                                        sp3x , ep3x , sm3x , em3x , &
+                                        sp1y , ep1y , sm1y , em1y , &
+                                        sp2y , ep2y , sm2y , em2y , &
+                                        sp3y , ep3y , sm3y , em3y , &
+                            bdx , bdy , bdy_mask )
+!<DESCRIPTION>
+! Wrf_patch_domain is called as part of the process of initiating a new
+! domain.  Based on the global domain dimension information that is
+! passed in it computes the patch and memory dimensions on this
+! distributed-memory process for parallel compilation when DM_PARALLEL is
+! defined in configure.wrf.  In this case, it relies on an external
+! communications package-contributed routine, wrf_dm_patch_domain. For
+! non-parallel compiles, it returns the patch and memory dimensions based
+! on the entire domain. In either case, the memory dimensions will be
+! larger than the patch dimensions, since they allow for distributed
+! memory halo regions (DM_PARALLEL only) and for boundary regions around
+! the domain (used for idealized cases only).  The width of the boundary
+! regions to be accommodated is passed in as bdx and bdy.
+! 
+! The bdy_mask argument is a four-dimensional logical array, each element
+! of which is set to true for any boundaries that this process's patch
+! contains (all four are true in the non-DM_PARALLEL case) and false
+! otherwise. The indices into the bdy_mask are defined in
+! frame/module_state_description.F. P_XSB corresponds boundary that
+! exists at the beginning of the X-dimension; ie. the western boundary;
+! P_XEB to the boundary that corresponds to the end of the X-dimension
+! (east). Likewise for Y (south and north respectively).
+! 
+! The correspondence of the first, second, and third dimension of each
+! set (domain, memory, and patch) with the coordinate axes of the model
+! domain is based on the setting of the variable model_data_order, which
+! comes into this routine through USE association of
+! module_driver_constants in the enclosing module of this routine,
+! module_domain.  Model_data_order is defined by the Registry, based on
+! the dimspec entries which associate dimension specifiers (e.g. 'k') in
+! the Registry with a coordinate axis and specify which dimension of the
+! arrays they represent. For WRF, the sd1 , ed1 , sp1 , ep1 , sm1 , and
+! em1 correspond to the starts and ends of the global, patch, and memory
+! dimensions in X; those with 2 specify Z (vertical); and those with 3
+! specify Y.  Note that the WRF convention is to overdimension to allow
+! for staggered fields so that sd<em>n</em>:ed<em>n</em> are the starts
+! and ends of the staggered domains in X.  The non-staggered grid runs
+! sd<em>n</em>:ed<em>n</em>-1. The extra row or column on the north or
+! east boundaries is not used for non-staggered fields.
+! 
+! The domdesc and parent_domdesc arguments are for external communication
+! packages (e.g. RSL) that establish and return to WRF integer handles
+! for referring to operations on domains.  These descriptors are not set
+! or used otherwise and they are opaque, which means they are never
+! accessed or modified in WRF; they are only only passed between calls to
+! the external package.
+!</DESCRIPTION>
+
+   USE module_machine
+   IMPLICIT NONE
+   LOGICAL, DIMENSION(4), INTENT(OUT)  :: bdy_mask
+   INTEGER, INTENT(IN)   :: sd1 , ed1 , sd2 , ed2 , sd3 , ed3 , bdx , bdy
+   INTEGER, INTENT(OUT)  :: sp1  , ep1  , sp2  , ep2  , sp3  , ep3  , &  ! z-xpose (std)
+                            sm1  , em1  , sm2  , em2  , sm3  , em3
+   INTEGER, INTENT(OUT)  :: sp1x , ep1x , sp2x , ep2x , sp3x , ep3x , &  ! x-xpose
+                            sm1x , em1x , sm2x , em2x , sm3x , em3x
+   INTEGER, INTENT(OUT)  :: sp1y , ep1y , sp2y , ep2y , sp3y , ep3y , &  ! y-xpose
+                            sm1y , em1y , sm2y , em2y , sm3y , em3y
+   INTEGER, INTENT(IN)   :: id , parent_id , parent_domdesc
+   INTEGER, INTENT(INOUT)  :: domdesc
+   TYPE(domain), POINTER :: parent
+
+!local data
+
+   INTEGER spec_bdy_width
+
+   CALL nl_get_spec_bdy_width( 1, spec_bdy_width )
+
+#ifndef DM_PARALLEL
+
+   bdy_mask = .true.     ! only one processor so all 4 boundaries are there
+
+! this is a trivial version -- 1 patch per processor; 
+! use version in module_dm to compute for DM
+   sp1 = sd1 ; sp2 = sd2 ; sp3 = sd3
+   ep1 = ed1 ; ep2 = ed2 ; ep3 = ed3
+   SELECT CASE ( model_data_order )
+      CASE ( DATA_ORDER_XYZ )
+         sm1  = sp1 - bdx ; em1 = ep1 + bdx
+         sm2  = sp2 - bdy ; em2 = ep2 + bdy
+         sm3  = sp3       ; em3 = ep3
+      CASE ( DATA_ORDER_YXZ )
+         sm1 = sp1 - bdy ; em1 = ep1 + bdy
+         sm2 = sp2 - bdx ; em2 = ep2 + bdx
+         sm3 = sp3       ; em3 = ep3
+      CASE ( DATA_ORDER_ZXY )
+         sm1 = sp1       ; em1 = ep1
+         sm2 = sp2 - bdx ; em2 = ep2 + bdx
+         sm3 = sp3 - bdy ; em3 = ep3 + bdy
+      CASE ( DATA_ORDER_ZYX )
+         sm1 = sp1       ; em1 = ep1
+         sm2 = sp2 - bdy ; em2 = ep2 + bdy
+         sm3 = sp3 - bdx ; em3 = ep3 + bdx
+      CASE ( DATA_ORDER_XZY )
+         sm1 = sp1 - bdx ; em1 = ep1 + bdx
+         sm2 = sp2       ; em2 = ep2
+         sm3 = sp3 - bdy ; em3 = ep3 + bdy
+      CASE ( DATA_ORDER_YZX )
+         sm1 = sp1 - bdy ; em1 = ep1 + bdy
+         sm2 = sp2       ; em2 = ep2
+         sm3 = sp3 - bdx ; em3 = ep3 + bdx
+   END SELECT
+   sm1x = sm1       ; em1x = em1    ! just copy
+   sm2x = sm2       ; em2x = em2
+   sm3x = sm3       ; em3x = em3
+   sm1y = sm1       ; em1y = em1    ! just copy
+   sm2y = sm2       ; em2y = em2
+   sm3y = sm3       ; em3y = em3
+! assigns mostly just to suppress warning messages that INTENT OUT vars not assigned
+   sp1x = sp1 ; ep1x = ep1 ; sp2x = sp2 ; ep2x = ep2 ; sp3x = sp3 ; ep3x = ep3
+   sp1y = sp1 ; ep1y = ep1 ; sp2y = sp2 ; ep2y = ep2 ; sp3y = sp3 ; ep3y = ep3
+
+#else
+! This is supplied by the package specific version of module_dm, which
+! is supplied by the external package and copied into the src directory
+! when the code is compiled. The cp command will be found in the externals
+! target of the configure.wrf file for this architecture.  Eg: for RSL
+! routine is defined in external/RSL/module_dm.F .
+! Note, it would be very nice to be able to pass parent to this routine;
+! however, there doesn't seem to be a way to do that in F90. That is because
+! to pass a pointer to a domain structure, this call requires an interface
+! definition for wrf_dm_patch_domain (otherwise it will try to convert the
+! pointer to something). In order to provide an interface definition, we
+! would need to either USE module_dm or use an interface block. In either
+! case it generates a circular USE reference, since module_dm uses
+! module_domain.  JM 20020416
+
+   CALL wrf_dm_patch_domain( id , domdesc , parent_id , parent_domdesc , &
+                             sd1 , ed1 , sp1 , ep1 , sm1 , em1 , &
+                             sd2 , ed2 , sp2 , ep2 , sm2 , em2 , &
+                             sd3 , ed3 , sp3 , ep3 , sm3 , em3 , &
+                                         sp1x , ep1x , sm1x , em1x , &
+                                         sp2x , ep2x , sm2x , em2x , &
+                                         sp3x , ep3x , sm3x , em3x , &
+                                         sp1y , ep1y , sm1y , em1y , &
+                                         sp2y , ep2y , sm2y , em2y , &
+                                         sp3y , ep3y , sm3y , em3y , &
+                             bdx , bdy )
+
+   SELECT CASE ( model_data_order )
+      CASE ( DATA_ORDER_XYZ )
+   bdy_mask( P_XSB ) = ( sp1 <= sd1 .AND. sd1 <= ep1 .AND. sp1 <= sd1+spec_bdy_width-1 .AND. sd1+spec_bdy_width-1 <= ep1 )
+   bdy_mask( P_YSB ) = ( sp2 <= sd2 .AND. sd2 <= ep2 .AND. sp2 <= sd2+spec_bdy_width-1 .AND. sd2+spec_bdy_width-1 <= ep2 )
+   bdy_mask( P_XEB ) = ( sp1 <= ed1 .AND. ed1 <= ep1 .AND. sp1 <= ed1-spec_bdy_width-1 .AND. ed1-spec_bdy_width-1 <= ep1 )
+   bdy_mask( P_YEB ) = ( sp2 <= ed2 .AND. ed2 <= ep2 .AND. sp2 <= ed2-spec_bdy_width-1 .AND. ed2-spec_bdy_width-1 <= ep2 )
+      CASE ( DATA_ORDER_YXZ )
+   bdy_mask( P_XSB ) = ( sp2 <= sd2 .AND. sd2 <= ep2 .AND. sp2 <= sd2+spec_bdy_width-1 .AND. sd2+spec_bdy_width-1 <= ep2 )
+   bdy_mask( P_YSB ) = ( sp1 <= sd1 .AND. sd1 <= ep1 .AND. sp1 <= sd1+spec_bdy_width-1 .AND. sd1+spec_bdy_width-1 <= ep1 )
+   bdy_mask( P_XEB ) = ( sp2 <= ed2 .AND. ed2 <= ep2 .AND. sp2 <= ed2-spec_bdy_width-1 .AND. ed2-spec_bdy_width-1 <= ep2 )
+   bdy_mask( P_YEB ) = ( sp1 <= ed1 .AND. ed1 <= ep1 .AND. sp1 <= ed1-spec_bdy_width-1 .AND. ed1-spec_bdy_width-1 <= ep1 )
+      CASE ( DATA_ORDER_ZXY )
+   bdy_mask( P_XSB ) = ( sp2 <= sd2 .AND. sd2 <= ep2 .AND. sp2 <= sd2+spec_bdy_width-1 .AND. sd2+spec_bdy_width-1 <= ep2 )
+   bdy_mask( P_YSB ) = ( sp3 <= sd3 .AND. sd3 <= ep3 .AND. sp3 <= sd3+spec_bdy_width-1 .AND. sd3+spec_bdy_width-1 <= ep3 )
+   bdy_mask( P_XEB ) = ( sp2 <= ed2 .AND. ed2 <= ep2 .AND. sp2 <= ed2-spec_bdy_width-1 .AND. ed2-spec_bdy_width-1 <= ep2 )
+   bdy_mask( P_YEB ) = ( sp3 <= ed3 .AND. ed3 <= ep3 .AND. sp3 <= ed3-spec_bdy_width-1 .AND. ed3-spec_bdy_width-1 <= ep3 )
+      CASE ( DATA_ORDER_ZYX )
+   bdy_mask( P_XSB ) = ( sp3 <= sd3 .AND. sd3 <= ep3 .AND. sp3 <= sd3+spec_bdy_width-1 .AND. sd3+spec_bdy_width-1 <= ep3 )
+   bdy_mask( P_YSB ) = ( sp2 <= sd2 .AND. sd2 <= ep2 .AND. sp2 <= sd2+spec_bdy_width-1 .AND. sd2+spec_bdy_width-1 <= ep2 )
+   bdy_mask( P_XEB ) = ( sp3 <= ed3 .AND. ed3 <= ep3 .AND. sp3 <= ed3-spec_bdy_width-1 .AND. ed3-spec_bdy_width-1 <= ep3 )
+   bdy_mask( P_YEB ) = ( sp2 <= ed2 .AND. ed2 <= ep2 .AND. sp2 <= ed2-spec_bdy_width-1 .AND. ed2-spec_bdy_width-1 <= ep2 )
+      CASE ( DATA_ORDER_XZY )
+   bdy_mask( P_XSB ) = ( sp1 <= sd1 .AND. sd1 <= ep1 .AND. sp1 <= sd1+spec_bdy_width-1 .AND. sd1+spec_bdy_width-1 <= ep1 )
+   bdy_mask( P_YSB ) = ( sp3 <= sd3 .AND. sd3 <= ep3 .AND. sp3 <= sd3+spec_bdy_width-1 .AND. sd3+spec_bdy_width-1 <= ep3 )
+   bdy_mask( P_XEB ) = ( sp1 <= ed1 .AND. ed1 <= ep1 .AND. sp1 <= ed1-spec_bdy_width-1 .AND. ed1-spec_bdy_width-1 <= ep1 )
+   bdy_mask( P_YEB ) = ( sp3 <= ed3 .AND. ed3 <= ep3 .AND. sp3 <= ed3-spec_bdy_width-1 .AND. ed3-spec_bdy_width-1 <= ep3 )
+      CASE ( DATA_ORDER_YZX )
+   bdy_mask( P_XSB ) = ( sp3 <= sd3 .AND. sd3 <= ep3 .AND. sp3 <= sd3+spec_bdy_width-1 .AND. sd3+spec_bdy_width-1 <= ep3 )
+   bdy_mask( P_YSB ) = ( sp1 <= sd1 .AND. sd1 <= ep1 .AND. sp1 <= sd1+spec_bdy_width-1 .AND. sd1+spec_bdy_width-1 <= ep1 )
+   bdy_mask( P_XEB ) = ( sp3 <= ed3 .AND. ed3 <= ep3 .AND. sp3 <= ed3-spec_bdy_width-1 .AND. ed3-spec_bdy_width-1 <= ep3 )
+   bdy_mask( P_YEB ) = ( sp1 <= ed1 .AND. ed1 <= ep1 .AND. sp1 <= ed1-spec_bdy_width-1 .AND. ed1-spec_bdy_width-1 <= ep1 )
+   END SELECT
+
+#endif
+
+   RETURN
+   END SUBROUTINE wrf_patch_domain
+!
+   SUBROUTINE alloc_and_configure_domain ( domain_id , grid , parent, kid )
+
+!<DESCRIPTION>
+! This subroutine is used to allocate a domain data structure of
+! TYPE(DOMAIN) pointed to by the argument <em>grid</em>, link it into the
+! nested domain hierarchy, and set it's configuration information from
+! the appropriate settings in the WRF namelist file. Specifically, if the
+! domain being allocated and configured is nest, the <em>parent</em>
+! argument will point to the already existing domain data structure for
+! the parent domain and the <em>kid</em> argument will be set to an
+! integer indicating which child of the parent this grid will be (child
+! indices start at 1).  If this is the top-level domain, the parent and
+! kid arguments are ignored.  <b>WRF domains may have multiple children
+! but only ever have one parent.</b>
+!
+! The <em>domain_id</em> argument is the
+! integer handle by which this new domain will be referred; it comes from
+! the grid_id setting in the namelist, and these grid ids correspond to
+! the ordering of settings in the namelist, starting with 1 for the
+! top-level domain. The id of 1 always corresponds to the top-level
+! domain.  and these grid ids correspond to the ordering of settings in
+! the namelist, starting with 1 for the top-level domain.
+! 
+! Model_data_order is provide by USE association of
+! module_driver_constants and is set from dimspec entries in the
+! Registry.
+! 
+! The allocation of the TYPE(DOMAIN) itself occurs in this routine.
+! However, the numerous multi-dimensional arrays that make up the members
+! of the domain are allocated in the call to alloc_space_field, after
+! wrf_patch_domain has been called to determine the dimensions in memory
+! that should be allocated.  It bears noting here that arrays and code
+! that indexes these arrays are always global, regardless of how the
+! model is decomposed over patches. Thus, when arrays are allocated on a
+! given process, the start and end of an array dimension are the global
+! indices of the start and end of that process's subdomain.
+! 
+! Configuration information for the domain (that is, information from the
+! namelist) is added by the call to <a href=med_add_config_info_to_grid.html>med_add_config_info_to_grid</a>, defined
+! in share/mediation_wrfmain.F. 
+!</DESCRIPTION>
+
+      
+      IMPLICIT NONE
+
+      !  Input data.
+
+      INTEGER , INTENT(IN)                           :: domain_id
+      TYPE( domain ) , POINTER                       :: grid
+      TYPE( domain ) , POINTER                       :: parent
+      INTEGER , INTENT(IN)                           :: kid    ! which kid of parent am I?
+
+      !  Local data.
+      INTEGER                     :: sd1 , ed1 , sp1 , ep1 , sm1 , em1
+      INTEGER                     :: sd2 , ed2 , sp2 , ep2 , sm2 , em2
+      INTEGER                     :: sd3 , ed3 , sp3 , ep3 , sm3 , em3
+
+      INTEGER                     :: sd1x , ed1x , sp1x , ep1x , sm1x , em1x
+      INTEGER                     :: sd2x , ed2x , sp2x , ep2x , sm2x , em2x
+      INTEGER                     :: sd3x , ed3x , sp3x , ep3x , sm3x , em3x
+
+      INTEGER                     :: sd1y , ed1y , sp1y , ep1y , sm1y , em1y
+      INTEGER                     :: sd2y , ed2y , sp2y , ep2y , sm2y , em2y
+      INTEGER                     :: sd3y , ed3y , sp3y , ep3y , sm3y , em3y
+
+      TYPE(domain) , POINTER      :: new_grid
+      INTEGER                     :: i
+      INTEGER                     :: parent_id , parent_domdesc , new_domdesc
+      INTEGER                     :: bdyzone_x , bdyzone_y
+      INTEGER                     :: nx, ny
+
+
+! This next step uses information that is listed in the registry as namelist_derived
+! to properly size the domain and the patches; this in turn is stored in the new_grid
+! data structure
+
+
+      data_ordering : SELECT CASE ( model_data_order )
+        CASE  ( DATA_ORDER_XYZ )
+
+          CALL nl_get_s_we( domain_id , sd1 )
+          CALL nl_get_e_we( domain_id , ed1 )
+          CALL nl_get_s_sn( domain_id , sd2 )
+          CALL nl_get_e_sn( domain_id , ed2 )
+          CALL nl_get_s_vert( domain_id , sd3 )
+          CALL nl_get_e_vert( domain_id , ed3 )
+          nx = ed1-sd1+1
+          ny = ed2-sd2+1
+
+        CASE  ( DATA_ORDER_YXZ )
+
+          CALL nl_get_s_sn( domain_id , sd1 )
+          CALL nl_get_e_sn( domain_id , ed1 )
+          CALL nl_get_s_we( domain_id , sd2 )
+          CALL nl_get_e_we( domain_id , ed2 )
+          CALL nl_get_s_vert( domain_id , sd3 )
+          CALL nl_get_e_vert( domain_id , ed3 )
+          nx = ed2-sd2+1
+          ny = ed1-sd1+1
+
+        CASE  ( DATA_ORDER_ZXY )
+
+          CALL nl_get_s_vert( domain_id , sd1 )
+          CALL nl_get_e_vert( domain_id , ed1 )
+          CALL nl_get_s_we( domain_id , sd2 )
+          CALL nl_get_e_we( domain_id , ed2 )
+          CALL nl_get_s_sn( domain_id , sd3 )
+          CALL nl_get_e_sn( domain_id , ed3 )
+          nx = ed2-sd2+1
+          ny = ed3-sd3+1
+
+        CASE  ( DATA_ORDER_ZYX )
+
+          CALL nl_get_s_vert( domain_id , sd1 )
+          CALL nl_get_e_vert( domain_id , ed1 )
+          CALL nl_get_s_sn( domain_id , sd2 )
+          CALL nl_get_e_sn( domain_id , ed2 )
+          CALL nl_get_s_we( domain_id , sd3 )
+          CALL nl_get_e_we( domain_id , ed3 )
+          nx = ed3-sd3+1
+          ny = ed2-sd2+1
+
+        CASE  ( DATA_ORDER_XZY )
+
+          CALL nl_get_s_we( domain_id , sd1 )
+          CALL nl_get_e_we( domain_id , ed1 )
+          CALL nl_get_s_vert( domain_id , sd2 )
+          CALL nl_get_e_vert( domain_id , ed2 )
+          CALL nl_get_s_sn( domain_id , sd3 )
+          CALL nl_get_e_sn( domain_id , ed3 )
+          nx = ed1-sd1+1
+          ny = ed3-sd3+1
+
+        CASE  ( DATA_ORDER_YZX )
+
+          CALL nl_get_s_sn( domain_id , sd1 )
+          CALL nl_get_e_sn( domain_id , ed1 )
+          CALL nl_get_s_vert( domain_id , sd2 )
+          CALL nl_get_e_vert( domain_id , ed2 )
+          CALL nl_get_s_we( domain_id , sd3 )
+          CALL nl_get_e_we( domain_id , ed3 )
+          nx = ed3-sd3+1
+          ny = ed1-sd1+1
+
+      END SELECT data_ordering
+
+
+#ifdef RSL
+! Check domain size to be sure it is within RSLs limit
+      IF ( nx .GE. 1024 .OR. ny .GE. 1024 ) THEN
+        WRITE ( wrf_err_message , * ) &
+         'domain too large for RSL. Use RSL_LITE or other comm package.'
+        CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+      ENDIF
+
+#endif
+
+      IF ( num_time_levels > 3 ) THEN
+        WRITE ( wrf_err_message , * ) 'alloc_and_configure_domain: ', &
+          'Incorrect value for num_time_levels ', num_time_levels
+        CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+      ENDIF
+
+      IF (ASSOCIATED(parent)) THEN
+        parent_id = parent%id
+        parent_domdesc = parent%domdesc
+      ELSE
+        parent_id = -1
+        parent_domdesc = -1
+      ENDIF
+
+! provided by application, WRF defines in share/module_bc.F
+      CALL get_bdyzone_x( bdyzone_x )
+      CALL get_bdyzone_y( bdyzone_y )
+
+      ALLOCATE ( new_grid )
+      ALLOCATE ( new_grid%parents( max_parents ) )
+      ALLOCATE ( new_grid%nests( max_nests ) )
+      NULLIFY( new_grid%sibling )
+      DO i = 1, max_nests
+         NULLIFY( new_grid%nests(i)%ptr )
+      ENDDO
+      NULLIFY  (new_grid%next)
+      NULLIFY  (new_grid%same_level)
+      NULLIFY  (new_grid%i_start)
+      NULLIFY  (new_grid%j_start)
+      NULLIFY  (new_grid%i_end)
+      NULLIFY  (new_grid%j_end)
+      ALLOCATE( new_grid%domain_clock )
+      new_grid%domain_clock_created = .FALSE.
+      ALLOCATE( new_grid%alarms( MAX_WRF_ALARMS ) )    ! initialize in setup_timekeeping
+      ALLOCATE( new_grid%alarms_created( MAX_WRF_ALARMS ) )
+      DO i = 1, MAX_WRF_ALARMS
+        new_grid%alarms_created( i ) = .FALSE.
+      ENDDO
+      new_grid%time_set = .FALSE.
+      new_grid%return_after_training_io = .FALSE.
+
+      ! set up the pointers that represent the nest hierarchy
+      ! set this up *prior* to calling the patching or allocation
+      ! routines so that implementations of these routines can
+      ! traverse the nest hierarchy (through the root head_grid)
+      ! if they need to 
+
+ 
+      IF ( domain_id .NE. 1 ) THEN
+         new_grid%parents(1)%ptr => parent
+         new_grid%num_parents = 1
+         parent%nests(kid)%ptr => new_grid
+         new_grid%child_of_parent(1) = kid    ! note assumption that nest can have only 1 parent
+         parent%num_nests = parent%num_nests + 1
+      END IF
+      new_grid%id = domain_id                 ! this needs to be assigned prior to calling wrf_patch_domain
+
+      CALL wrf_patch_domain( domain_id  , new_domdesc , parent, parent_id, parent_domdesc , &
+
+                             sd1 , ed1 , sp1 , ep1 , sm1 , em1 , &     ! z-xpose dims
+                             sd2 , ed2 , sp2 , ep2 , sm2 , em2 , &     ! (standard)
+                             sd3 , ed3 , sp3 , ep3 , sm3 , em3 , &
+
+                                     sp1x , ep1x , sm1x , em1x , &     ! x-xpose dims
+                                     sp2x , ep2x , sm2x , em2x , &
+                                     sp3x , ep3x , sm3x , em3x , &
+
+                                     sp1y , ep1y , sm1y , em1y , &     ! y-xpose dims
+                                     sp2y , ep2y , sm2y , em2y , &
+                                     sp3y , ep3y , sm3y , em3y , &
+
+                         bdyzone_x  , bdyzone_y , new_grid%bdy_mask &
+      ) 
+
+
+      new_grid%domdesc = new_domdesc
+      new_grid%num_nests = 0
+      new_grid%num_siblings = 0
+      new_grid%num_parents = 0
+      new_grid%max_tiles   = 0
+      new_grid%num_tiles_spec   = 0
+      new_grid%nframes   = 0         ! initialize the number of frames per file (array assignment)
+
+      CALL alloc_space_field ( new_grid, domain_id , 3 , 3 , .FALSE. ,      &
+                               sd1, ed1, sd2, ed2, sd3, ed3,       &
+                               sm1,  em1,  sm2,  em2,  sm3,  em3,  &
+                               sm1x, em1x, sm2x, em2x, sm3x, em3x, &   ! x-xpose
+                               sm1y, em1y, sm2y, em2y, sm3y, em3y  &   ! y-xpose
+      )
+#if MOVE_NESTS
+!set these here, after alloc_space_field, which initializes vc_i, vc_j to zero
+      new_grid%xi = -1.0
+      new_grid%xj = -1.0
+      new_grid%vc_i = -1.0
+      new_grid%vc_j = -1.0
+#endif
+
+      new_grid%sd31                            = sd1 
+      new_grid%ed31                            = ed1
+      new_grid%sp31                            = sp1 
+      new_grid%ep31                            = ep1 
+      new_grid%sm31                            = sm1 
+      new_grid%em31                            = em1
+      new_grid%sd32                            = sd2 
+      new_grid%ed32                            = ed2
+      new_grid%sp32                            = sp2 
+      new_grid%ep32                            = ep2 
+      new_grid%sm32                            = sm2 
+      new_grid%em32                            = em2
+      new_grid%sd33                            = sd3 
+      new_grid%ed33                            = ed3
+      new_grid%sp33                            = sp3 
+      new_grid%ep33                            = ep3 
+      new_grid%sm33                            = sm3 
+      new_grid%em33                            = em3
+
+      new_grid%sp31x                           = sp1x
+      new_grid%ep31x                           = ep1x
+      new_grid%sm31x                           = sm1x
+      new_grid%em31x                           = em1x
+      new_grid%sp32x                           = sp2x
+      new_grid%ep32x                           = ep2x
+      new_grid%sm32x                           = sm2x
+      new_grid%em32x                           = em2x
+      new_grid%sp33x                           = sp3x
+      new_grid%ep33x                           = ep3x
+      new_grid%sm33x                           = sm3x
+      new_grid%em33x                           = em3x
+
+      new_grid%sp31y                           = sp1y
+      new_grid%ep31y                           = ep1y
+      new_grid%sm31y                           = sm1y
+      new_grid%em31y                           = em1y
+      new_grid%sp32y                           = sp2y
+      new_grid%ep32y                           = ep2y
+      new_grid%sm32y                           = sm2y
+      new_grid%em32y                           = em2y
+      new_grid%sp33y                           = sp3y
+      new_grid%ep33y                           = ep3y
+      new_grid%sm33y                           = sm3y
+      new_grid%em33y                           = em3y
+
+      SELECT CASE ( model_data_order )
+         CASE  ( DATA_ORDER_XYZ )
+            new_grid%sd21 = sd1 ; new_grid%sd22 = sd2 ;
+            new_grid%ed21 = ed1 ; new_grid%ed22 = ed2 ;
+            new_grid%sp21 = sp1 ; new_grid%sp22 = sp2 ;
+            new_grid%ep21 = ep1 ; new_grid%ep22 = ep2 ;
+            new_grid%sm21 = sm1 ; new_grid%sm22 = sm2 ;
+            new_grid%em21 = em1 ; new_grid%em22 = em2 ;
+            new_grid%sd11 = sd1
+            new_grid%ed11 = ed1
+            new_grid%sp11 = sp1
+            new_grid%ep11 = ep1
+            new_grid%sm11 = sm1
+            new_grid%em11 = em1
+         CASE  ( DATA_ORDER_YXZ )
+            new_grid%sd21 = sd1 ; new_grid%sd22 = sd2 ;
+            new_grid%ed21 = ed1 ; new_grid%ed22 = ed2 ;
+            new_grid%sp21 = sp1 ; new_grid%sp22 = sp2 ;
+            new_grid%ep21 = ep1 ; new_grid%ep22 = ep2 ;
+            new_grid%sm21 = sm1 ; new_grid%sm22 = sm2 ;
+            new_grid%em21 = em1 ; new_grid%em22 = em2 ;
+            new_grid%sd11 = sd1
+            new_grid%ed11 = ed1
+            new_grid%sp11 = sp1
+            new_grid%ep11 = ep1
+            new_grid%sm11 = sm1
+            new_grid%em11 = em1
+         CASE  ( DATA_ORDER_ZXY )
+            new_grid%sd21 = sd2 ; new_grid%sd22 = sd3 ;
+            new_grid%ed21 = ed2 ; new_grid%ed22 = ed3 ;
+            new_grid%sp21 = sp2 ; new_grid%sp22 = sp3 ;
+            new_grid%ep21 = ep2 ; new_grid%ep22 = ep3 ;
+            new_grid%sm21 = sm2 ; new_grid%sm22 = sm3 ;
+            new_grid%em21 = em2 ; new_grid%em22 = em3 ;
+            new_grid%sd11 = sd2
+            new_grid%ed11 = ed2
+            new_grid%sp11 = sp2
+            new_grid%ep11 = ep2
+            new_grid%sm11 = sm2
+            new_grid%em11 = em2
+         CASE  ( DATA_ORDER_ZYX )
+            new_grid%sd21 = sd2 ; new_grid%sd22 = sd3 ;
+            new_grid%ed21 = ed2 ; new_grid%ed22 = ed3 ;
+            new_grid%sp21 = sp2 ; new_grid%sp22 = sp3 ;
+            new_grid%ep21 = ep2 ; new_grid%ep22 = ep3 ;
+            new_grid%sm21 = sm2 ; new_grid%sm22 = sm3 ;
+            new_grid%em21 = em2 ; new_grid%em22 = em3 ;
+            new_grid%sd11 = sd2
+            new_grid%ed11 = ed2
+            new_grid%sp11 = sp2
+            new_grid%ep11 = ep2
+            new_grid%sm11 = sm2
+            new_grid%em11 = em2
+         CASE  ( DATA_ORDER_XZY )
+            new_grid%sd21 = sd1 ; new_grid%sd22 = sd3 ;
+            new_grid%ed21 = ed1 ; new_grid%ed22 = ed3 ;
+            new_grid%sp21 = sp1 ; new_grid%sp22 = sp3 ;
+            new_grid%ep21 = ep1 ; new_grid%ep22 = ep3 ;
+            new_grid%sm21 = sm1 ; new_grid%sm22 = sm3 ;
+            new_grid%em21 = em1 ; new_grid%em22 = em3 ;
+            new_grid%sd11 = sd1
+            new_grid%ed11 = ed1
+            new_grid%sp11 = sp1
+            new_grid%ep11 = ep1
+            new_grid%sm11 = sm1
+            new_grid%em11 = em1
+         CASE  ( DATA_ORDER_YZX )
+            new_grid%sd21 = sd1 ; new_grid%sd22 = sd3 ;
+            new_grid%ed21 = ed1 ; new_grid%ed22 = ed3 ;
+            new_grid%sp21 = sp1 ; new_grid%sp22 = sp3 ;
+            new_grid%ep21 = ep1 ; new_grid%ep22 = ep3 ;
+            new_grid%sm21 = sm1 ; new_grid%sm22 = sm3 ;
+            new_grid%em21 = em1 ; new_grid%em22 = em3 ;
+            new_grid%sd11 = sd1
+            new_grid%ed11 = ed1
+            new_grid%sp11 = sp1
+            new_grid%ep11 = ep1
+            new_grid%sm11 = sm1
+            new_grid%em11 = em1
+      END SELECT
+
+      CALL med_add_config_info_to_grid ( new_grid )           ! this is a mediation layer routine
+
+! Some miscellaneous state that is in the Registry but not namelist data
+
+      new_grid%tiled                           = .false.
+      new_grid%patched                         = .false.
+      NULLIFY(new_grid%mapping)
+
+! This next set of includes causes all but the namelist_derived variables to be
+! properly assigned to the new_grid record
+
+      grid => new_grid
+
+#ifdef DM_PARALLEL
+      CALL wrf_get_dm_communicator ( grid%communicator )
+      CALL wrf_dm_define_comms( grid )
+#endif
+
+   END SUBROUTINE alloc_and_configure_domain
+
+!
+
+!  This routine ALLOCATEs the required space for the meteorological fields
+!  for a specific domain.  The fields are simply ALLOCATEd as an -1.  They
+!  are referenced as wind, temperature, moisture, etc. in routines that are
+!  below this top-level of data allocation and management (in the solve routine
+!  and below).
+
+   SUBROUTINE alloc_space_field ( grid,   id, setinitval_in ,  tl_in , inter_domain_in ,   &
+                                  sd31, ed31, sd32, ed32, sd33, ed33, &
+                                  sm31 , em31 , sm32 , em32 , sm33 , em33 , &
+                                  sm31x, em31x, sm32x, em32x, sm33x, em33x, &
+                                  sm31y, em31y, sm32y, em32y, sm33y, em33y )
+
+      
+      USE module_configure
+      IMPLICIT NONE
+ 
+
+      !  Input data.
+
+      TYPE(domain)               , POINTER          :: grid
+      INTEGER , INTENT(IN)            :: id
+      INTEGER , INTENT(IN)            :: setinitval_in   ! 3 = everything, 1 = arrays only, 0 = none
+      INTEGER , INTENT(IN)            :: sd31, ed31, sd32, ed32, sd33, ed33
+      INTEGER , INTENT(IN)            :: sm31, em31, sm32, em32, sm33, em33
+      INTEGER , INTENT(IN)            :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+      INTEGER , INTENT(IN)            :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+
+      ! this argument is a bitmask. First bit is time level 1, second is time level 2, and so on.
+      ! e.g. to set both 1st and second time level, use 3
+      !      to set only 1st                        use 1
+      !      to set only 2st                        use 2
+      INTEGER , INTENT(IN)            :: tl_in
+  
+      ! true if the allocation is for an intermediate domain (for nesting); only certain fields allocated
+      ! false otherwise (all allocated, modulo tl above)
+      LOGICAL , INTENT(IN)            :: inter_domain_in
+
+      !  Local data.
+      INTEGER dyn_opt, idum1, idum2, spec_bdy_width
+      INTEGER num_bytes_allocated
+      REAL    initial_data_value
+      CHARACTER (LEN=256) message
+      INTEGER tl
+      LOGICAL inter_domain
+      INTEGER setinitval
+
+      !declare ierr variable for error checking ALLOCATE calls
+      INTEGER ierr
+
+      INTEGER                              :: loop
+
+#if 1
+      tl = tl_in
+      inter_domain = inter_domain_in
+#else
+      tl = 3
+      inter_domain = .FALSE.
+#endif
+
+#if ( RWORDSIZE == 8 )
+      initial_data_value = 0.
+#else
+      CALL get_initial_data_value ( initial_data_value )
+#endif
+
+#ifdef NO_INITIAL_DATA_VALUE
+      setinitval = 0
+#else
+      setinitval = setinitval_in
+#endif
+
+      CALL nl_get_dyn_opt( 1, dyn_opt )
+      CALL nl_get_spec_bdy_width( 1, spec_bdy_width )
+
+      CALL set_scalar_indices_from_config( id , idum1 , idum2 )
+
+      num_bytes_allocated = 0 
+
+
+      IF ( dyn_opt == DYN_NODYN ) THEN
+
+        IF ( grid%id .EQ. 1 ) &
+          CALL wrf_message ( 'DYNAMICS OPTION: dynamics disabled ' )
+
+#if ALLOW_NODYN
+# include <nodyn_allocs.inc>
+#else
+        WRITE(message,*)                                        &
+          "To run the the NODYN option, recompile ",            &
+          "-DALLOW_NODYN in ARCHFLAGS settings of configure.wrf"
+        CALL wrf_error_fatal( message )
+#endif
+
+#if (EM_CORE == 1)
+      ELSE IF ( dyn_opt == DYN_EM ) THEN
+        IF ( grid%id .EQ. 1 ) CALL wrf_message ( &
+          'DYNAMICS OPTION: Eulerian Mass Coordinate ')
+# include <em_allocs.inc>
+#endif
+#if (NMM_CORE == 1)
+      ELSE IF ( dyn_opt == DYN_NMM ) THEN
+        IF ( grid%id .EQ. 1 ) &
+          CALL wrf_message ( 'DYNAMICS OPTION: nmm dyncore' )
+# include <nmm_allocs.inc>
+#endif
+#if (COAMPS_CORE == 1)
+      ELSE IF ( dyn_opt == DYN_COAMPS ) THEN
+        IF ( grid%id .EQ. 1 ) &
+          CALL wrf_message ( 'DYNAMICS OPTION: coamps dyncore' )
+# include <coamps_allocs.inc>
+#endif
+#if (EXP_CORE==1)
+      ELSE IF ( dyn_opt == DYN_EXP ) THEN
+        IF ( grid%id .EQ. 1 ) &
+          CALL wrf_message ( 'DYNAMICS OPTION: experimental dyncore' )
+# include <exp_allocs.inc>
+#endif
+
+      ELSE
+      
+        WRITE( wrf_err_message , * )&
+          'Invalid specification of dynamics: dyn_opt = ',dyn_opt
+        CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+      ENDIF
+
+      WRITE(message,*)&
+          'alloc_space_field: domain ',id,' ',num_bytes_allocated
+      CALL  wrf_debug( 1, message )
+
+   END SUBROUTINE alloc_space_field
+
+
+!  This routine is used to DEALLOCATE space for a single domain and remove 
+!  it from the linked list.  First the pointers in the linked list are fixed 
+!  (so the one in the middle can be removed).  Then the domain itself is 
+!  DEALLOCATEd via a call to domain_destroy().  
+
+   SUBROUTINE dealloc_space_domain ( id )
+      
+      IMPLICIT NONE
+
+      !  Input data.
+
+      INTEGER , INTENT(IN)            :: id
+
+      !  Local data.
+
+      TYPE(domain) , POINTER          :: grid
+      LOGICAL                         :: found
+
+      !  Initializations required to start the routine.
+
+      grid => head_grid
+      old_grid => head_grid
+      found = .FALSE.
+
+      !  The identity of the domain to delete is based upon the "id".
+      !  We search all of the possible grids.  It is required to find a domain
+      !  otherwise it is a fatal error.  
+
+      find_grid : DO WHILE ( ASSOCIATED(grid) ) 
+         IF ( grid%id == id ) THEN
+            found = .TRUE.
+            old_grid%next => grid%next
+            CALL domain_destroy( grid )
+            EXIT find_grid
+         END IF
+         old_grid => grid
+         grid     => grid%next
+      END DO find_grid
+
+      IF ( .NOT. found ) THEN
+         WRITE ( wrf_err_message , * ) 'module_domain: ', &
+           'dealloc_space_domain: Could not de-allocate grid id ',id
+         CALL wrf_error_fatal ( TRIM( wrf_err_message ) ) 
+      END IF
+
+   END SUBROUTINE dealloc_space_domain
+
+
+
+!  This routine is used to DEALLOCATE space for a single domain type.  
+!  First, the field data are all removed through a CALL to the 
+!  dealloc_space_field routine.  Then the pointer to the domain
+!  itself is DEALLOCATEd.
+
+   SUBROUTINE domain_destroy ( grid )
+      
+      IMPLICIT NONE
+
+      !  Input data.
+
+      TYPE(domain) , POINTER          :: grid
+
+      CALL dealloc_space_field ( grid )
+      DEALLOCATE( grid%parents )
+      DEALLOCATE( grid%nests )
+      ! clean up time manager bits
+      CALL domain_clock_destroy( grid )
+      CALL domain_alarms_destroy( grid )
+      IF ( ASSOCIATED( grid%i_start ) ) THEN
+        DEALLOCATE( grid%i_start ) 
+      ENDIF
+      IF ( ASSOCIATED( grid%i_end ) ) THEN
+        DEALLOCATE( grid%i_end )
+      ENDIF
+      IF ( ASSOCIATED( grid%j_start ) ) THEN
+        DEALLOCATE( grid%j_start )
+      ENDIF
+      IF ( ASSOCIATED( grid%j_end ) ) THEN
+        DEALLOCATE( grid%j_end )
+      ENDIF
+      DEALLOCATE( grid )
+      NULLIFY( grid )
+
+   END SUBROUTINE domain_destroy
+
+   RECURSIVE SUBROUTINE show_nest_subtree ( grid )
+      TYPE(domain), POINTER :: grid
+      INTEGER myid
+      INTEGER kid
+      IF ( .NOT. ASSOCIATED( grid ) ) RETURN
+      myid = grid%id
+      write(0,*)'show_nest_subtree ',myid
+      DO kid = 1, max_nests
+        IF ( ASSOCIATED( grid%nests(kid)%ptr ) ) THEN
+          IF ( grid%nests(kid)%ptr%id .EQ. myid ) THEN
+            CALL wrf_error_fatal( 'show_nest_subtree: nest hierarchy corrupted' )
+          ENDIF
+          CALL show_nest_subtree( grid%nests(kid)%ptr )
+        ENDIF
+      ENDDO
+   END SUBROUTINE show_nest_subtree
+   
+
+!
+
+!  This routine DEALLOCATEs each gridded field for this domain.  For each type of
+!  different array (1d, 2d, 3d, etc.), the space for each pointer is DEALLOCATEd
+!  for every -1 (i.e., each different meteorological field).
+
+   SUBROUTINE dealloc_space_field ( grid )
+      
+      IMPLICIT NONE
+
+      !  Input data.
+
+      TYPE(domain)              , POINTER :: grid
+
+      !  Local data.
+
+      INTEGER                             :: dyn_opt, ierr
+
+      CALL nl_get_dyn_opt( 1, dyn_opt )
+
+      IF      ( .FALSE. )           THEN
+
+#if (EM_CORE == 1)
+      ELSE IF ( dyn_opt == DYN_EM ) THEN
+# include <em_deallocs.inc>
+#endif
+#if (NMM_CORE == 1)
+      ELSE IF ( dyn_opt == DYN_NMM ) THEN
+# include <nmm_deallocs.inc>
+#endif
+#if (COAMPS_CORE == 1)
+      ELSE IF ( dyn_opt == DYN_COAMPS ) THEN
+# include <coamps_deallocs.inc>
+#endif
+#if (EXP_CORE==1)
+      ELSE IF ( dyn_opt == DYN_EXP ) THEN
+# include <exp_deallocs.inc>
+#endif
+      ELSE
+        WRITE( wrf_err_message , * )'dealloc_space_field: ', &
+          'Invalid specification of dynamics: dyn_opt = ',dyn_opt
+        CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+      ENDIF
+
+   END SUBROUTINE dealloc_space_field
+
+!
+!
+   RECURSIVE SUBROUTINE find_grid_by_id ( id, in_grid, result_grid )
+      IMPLICIT NONE
+      INTEGER, INTENT(IN) :: id
+      TYPE(domain), POINTER     :: in_grid 
+      TYPE(domain), POINTER     :: result_grid
+! <DESCRIPTION>
+! This is a recursive subroutine that traverses the domain hierarchy rooted
+! at the input argument <em>in_grid</em>, a pointer to TYPE(domain), and returns
+! a pointer to the domain matching the integer argument <em>id</em> if it exists.
+!
+! </DESCRIPTION>
+      TYPE(domain), POINTER     :: grid_ptr
+      INTEGER                   :: kid
+      LOGICAL                   :: found
+      found = .FALSE.
+      IF ( ASSOCIATED( in_grid ) ) THEN
+      IF ( in_grid%id .EQ. id ) THEN
+         result_grid => in_grid
+      ELSE
+         grid_ptr => in_grid
+         DO WHILE ( ASSOCIATED( grid_ptr ) .AND. .NOT. found )
+            DO kid = 1, max_nests
+               IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) .AND. .NOT. found ) THEN
+                  CALL find_grid_by_id ( id, grid_ptr%nests(kid)%ptr, result_grid )
+                  IF ( ASSOCIATED( result_grid ) ) THEN
+                    IF ( result_grid%id .EQ. id ) found = .TRUE.
+                  ENDIF
+               ENDIF
+            ENDDO
+            IF ( .NOT. found ) grid_ptr => grid_ptr%sibling
+         ENDDO
+      ENDIF
+      ENDIF
+      RETURN
+   END SUBROUTINE find_grid_by_id
+
+
+   FUNCTION first_loc_integer ( array , search ) RESULT ( loc ) 
+ 
+      IMPLICIT NONE
+
+      !  Input data.
+
+      INTEGER , INTENT(IN) , DIMENSION(:) :: array
+      INTEGER , INTENT(IN)                :: search
+
+      !  Output data.
+
+      INTEGER                             :: loc
+
+!<DESCRIPTION>
+!  This routine is used to find a specific domain identifier in an array
+!  of domain identifiers.
+!
+!</DESCRIPTION>
+      
+      !  Local data.
+
+      INTEGER :: loop
+
+      loc = -1
+      find : DO loop = 1 , SIZE(array)
+         IF ( search == array(loop) ) THEN         
+            loc = loop
+            EXIT find
+         END IF
+      END DO find
+
+   END FUNCTION first_loc_integer
+!
+   SUBROUTINE init_module_domain
+   END SUBROUTINE init_module_domain
+
+
+! <DESCRIPTION>
+!
+! The following routines named domain_*() are convenience routines that 
+! eliminate many duplicated bits of code.  They provide shortcuts for the 
+! most common operations on the domain_clock field of TYPE(domain).  
+!
+! </DESCRIPTION>
+
+      FUNCTION domain_get_current_time ( grid ) RESULT ( current_time ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns the current time for domain grid.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        TYPE(WRFU_Time) :: current_time
+        ! locals
+        INTEGER :: rc
+        CALL WRFU_ClockGet( grid%domain_clock, CurrTime=current_time, &
+                            rc=rc )
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_get_current_time:  WRFU_ClockGet failed' )
+        ENDIF
+      END FUNCTION domain_get_current_time
+
+
+      FUNCTION domain_get_start_time ( grid ) RESULT ( start_time ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns the start time for domain grid.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        TYPE(WRFU_Time) :: start_time
+        ! locals
+        INTEGER :: rc
+        CALL WRFU_ClockGet( grid%domain_clock, StartTime=start_time, &
+                            rc=rc )
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_get_start_time:  WRFU_ClockGet failed' )
+        ENDIF
+      END FUNCTION domain_get_start_time
+
+
+      FUNCTION domain_get_stop_time ( grid ) RESULT ( stop_time ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns the stop time for domain grid.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        TYPE(WRFU_Time) :: stop_time
+        ! locals
+        INTEGER :: rc
+        CALL WRFU_ClockGet( grid%domain_clock, StopTime=stop_time, &
+                            rc=rc )
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_get_stop_time:  WRFU_ClockGet failed' )
+        ENDIF
+      END FUNCTION domain_get_stop_time
+
+
+      FUNCTION domain_get_time_step ( grid ) RESULT ( time_step ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns the time step for domain grid.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        TYPE(WRFU_TimeInterval) :: time_step
+        ! locals
+        INTEGER :: rc
+        CALL WRFU_ClockGet( grid%domain_clock, timeStep=time_step, &
+                            rc=rc )
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_get_time_step:  WRFU_ClockGet failed' )
+        ENDIF
+      END FUNCTION domain_get_time_step
+
+
+      FUNCTION domain_get_advanceCount ( grid ) RESULT ( advanceCount ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns the time step for domain grid.  
+! Also converts from INTEGER(WRFU_KIND_I8) to INTEGER.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        INTEGER :: advanceCount
+        ! locals
+        INTEGER(WRFU_KIND_I8) :: advanceCountLcl
+        INTEGER :: rc
+        CALL WRFU_ClockGet( grid%domain_clock, &
+                            advanceCount=advanceCountLcl, &
+                            rc=rc )
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_get_advanceCount:  WRFU_ClockGet failed' )
+        ENDIF
+        advanceCount = advanceCountLcl
+      END FUNCTION domain_get_advanceCount
+
+
+      SUBROUTINE domain_alarms_destroy ( grid )
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience routine destroys and deallocates all alarms associated 
+! with grid.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(INOUT) :: grid
+        !  Local data.
+        INTEGER                     :: alarmid
+
+        IF ( ASSOCIATED( grid%alarms ) .AND. &
+             ASSOCIATED( grid%alarms_created ) ) THEN
+          DO alarmid = 1, MAX_WRF_ALARMS
+            IF ( grid%alarms_created( alarmid ) ) THEN
+              CALL WRFU_AlarmDestroy( grid%alarms( alarmid ) )
+              grid%alarms_created( alarmid ) = .FALSE.
+            ENDIF
+          ENDDO
+          DEALLOCATE( grid%alarms )
+          NULLIFY( grid%alarms )
+          DEALLOCATE( grid%alarms_created )
+          NULLIFY( grid%alarms_created )
+        ENDIF
+      END SUBROUTINE domain_alarms_destroy
+
+
+      SUBROUTINE domain_clock_destroy ( grid )
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience routine destroys and deallocates the domain clock.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(INOUT) :: grid
+        IF ( ASSOCIATED( grid%domain_clock ) ) THEN
+          IF ( grid%domain_clock_created ) THEN
+            CALL WRFU_ClockDestroy( grid%domain_clock )
+            grid%domain_clock_created = .FALSE.
+          ENDIF
+          DEALLOCATE( grid%domain_clock )
+          NULLIFY( grid%domain_clock )
+        ENDIF
+      END SUBROUTINE domain_clock_destroy
+
+
+      FUNCTION domain_last_time_step ( grid ) RESULT ( LAST_TIME ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns .TRUE. if this is the last time 
+! step for domain grid.  Thanks to Tom Black.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        LOGICAL :: LAST_TIME
+        LAST_TIME =   domain_get_stop_time( grid ) .EQ. &
+                    ( domain_get_current_time( grid ) + &
+                      domain_get_time_step( grid ) )
+      END FUNCTION domain_last_time_step
+
+
+
+      FUNCTION domain_clockisstoptime ( grid ) RESULT ( is_stop_time ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns .TRUE. iff grid%clock has reached its 
+! stop time.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        LOGICAL :: is_stop_time
+        INTEGER :: rc
+        is_stop_time = WRFU_ClockIsStopTime( grid%domain_clock , rc=rc )
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_clockisstoptime:  WRFU_ClockIsStopTime() failed' )
+        ENDIF
+      END FUNCTION domain_clockisstoptime
+
+
+
+      FUNCTION domain_clockisstopsubtime ( grid ) RESULT ( is_stop_subtime ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns .TRUE. iff grid%clock has reached its 
+! grid%stop_subtime.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        LOGICAL :: is_stop_subtime
+        INTEGER :: rc
+        TYPE(WRFU_TimeInterval) :: timeStep
+        TYPE(WRFU_Time) :: currentTime
+        LOGICAL :: positive_timestep
+        is_stop_subtime = .FALSE.
+        CALL domain_clock_get( grid, time_step=timeStep, &
+                                     current_time=currentTime )
+        positive_timestep = ESMF_TimeIntervalIsPositive( timeStep )
+        IF ( positive_timestep ) THEN
+! hack for bug in PGI 5.1-x
+!        IF ( currentTime .GE. grid%stop_subtime ) THEN
+          IF ( ESMF_TimeGE( currentTime, grid%stop_subtime ) ) THEN
+            is_stop_subtime = .TRUE.
+          ENDIF
+        ELSE
+! hack for bug in PGI 5.1-x
+!        IF ( currentTime .LE. grid%stop_subtime ) THEN
+          IF ( ESMF_TimeLE( currentTime, grid%stop_subtime ) ) THEN
+            is_stop_subtime = .TRUE.
+          ENDIF
+        ENDIF
+      END FUNCTION domain_clockisstopsubtime
+
+
+
+
+      FUNCTION domain_get_sim_start_time ( grid ) RESULT ( simulationStartTime ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience routine returns simulation start time for domain grid as 
+! a time instant.  
+!
+! If this is not a restart run, the start_time of head_grid%clock is returned 
+! instead.  
+!
+! Note that simulation start time remains constant through restarts while 
+! the start_time of head_grid%clock always refers to the start time of the 
+! current run (restart or otherwise).  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        TYPE(WRFU_Time) :: simulationStartTime
+        ! Locals
+        INTEGER :: rc
+        INTEGER :: simulation_start_year,   simulation_start_month, &
+                   simulation_start_day,    simulation_start_hour , &
+                   simulation_start_minute, simulation_start_second
+        CALL nl_get_simulation_start_year   ( 1, simulation_start_year   )
+        CALL nl_get_simulation_start_month  ( 1, simulation_start_month  )
+        CALL nl_get_simulation_start_day    ( 1, simulation_start_day    )
+        CALL nl_get_simulation_start_hour   ( 1, simulation_start_hour   )
+        CALL nl_get_simulation_start_minute ( 1, simulation_start_minute )
+        CALL nl_get_simulation_start_second ( 1, simulation_start_second )
+        CALL WRFU_TimeSet( simulationStartTime,       &
+                           YY=simulation_start_year,  &
+                           MM=simulation_start_month, &
+                           DD=simulation_start_day,   &
+                           H=simulation_start_hour,   &
+                           M=simulation_start_minute, &
+                           S=simulation_start_second, &
+                           rc=rc )
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL nl_get_start_year   ( 1, simulation_start_year   )
+          CALL nl_get_start_month  ( 1, simulation_start_month  )
+          CALL nl_get_start_day    ( 1, simulation_start_day    )
+          CALL nl_get_start_hour   ( 1, simulation_start_hour   )
+          CALL nl_get_start_minute ( 1, simulation_start_minute )
+          CALL nl_get_start_second ( 1, simulation_start_second )
+          CALL wrf_debug( 150, "WARNING:  domain_get_sim_start_time using head_grid start time from namelist" )
+          CALL WRFU_TimeSet( simulationStartTime,       &
+                             YY=simulation_start_year,  &
+                             MM=simulation_start_month, &
+                             DD=simulation_start_day,   &
+                             H=simulation_start_hour,   &
+                             M=simulation_start_minute, &
+                             S=simulation_start_second, &
+                             rc=rc )
+        ENDIF
+        RETURN
+      END FUNCTION domain_get_sim_start_time
+
+      FUNCTION domain_get_time_since_sim_start ( grid ) RESULT ( time_since_sim_start ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns the time elapsed since start of 
+! simulation for domain grid.  
+!
+! Note that simulation start time remains constant through restarts while 
+! the start_time of grid%clock always refers to the start time of the 
+! current run (restart or otherwise).  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        TYPE(WRFU_TimeInterval) :: time_since_sim_start
+        ! locals
+        TYPE(WRFU_Time) :: lcl_currtime, lcl_simstarttime
+        lcl_simstarttime = domain_get_sim_start_time( grid )
+        lcl_currtime = domain_get_current_time ( grid )
+        time_since_sim_start = lcl_currtime - lcl_simstarttime
+      END FUNCTION domain_get_time_since_sim_start
+
+
+
+
+      SUBROUTINE domain_clock_get( grid, current_time,                &
+                                         current_timestr,             &
+                                         current_timestr_frac,        &
+                                         start_time, start_timestr,   &
+                                         stop_time, stop_timestr,     &
+                                         time_step, time_stepstr,     &
+                                         time_stepstr_frac,           &
+                                         advanceCount,                &
+                                         currentDayOfYearReal,        &
+                                         minutesSinceSimulationStart, &
+                                         timeSinceSimulationStart,    &
+                                         simulationStartTime,         &
+                                         simulationStartTimeStr )
+        IMPLICIT NONE
+        TYPE(domain),            INTENT(IN)              :: grid
+        TYPE(WRFU_Time),         INTENT(  OUT), OPTIONAL :: current_time
+        CHARACTER (LEN=*),       INTENT(  OUT), OPTIONAL :: current_timestr
+        CHARACTER (LEN=*),       INTENT(  OUT), OPTIONAL :: current_timestr_frac
+        TYPE(WRFU_Time),         INTENT(  OUT), OPTIONAL :: start_time
+        CHARACTER (LEN=*),       INTENT(  OUT), OPTIONAL :: start_timestr
+        TYPE(WRFU_Time),         INTENT(  OUT), OPTIONAL :: stop_time
+        CHARACTER (LEN=*),       INTENT(  OUT), OPTIONAL :: stop_timestr
+        TYPE(WRFU_TimeInterval), INTENT(  OUT), OPTIONAL :: time_step
+        CHARACTER (LEN=*),       INTENT(  OUT), OPTIONAL :: time_stepstr
+        CHARACTER (LEN=*),       INTENT(  OUT), OPTIONAL :: time_stepstr_frac
+        INTEGER,                 INTENT(  OUT), OPTIONAL :: advanceCount
+        ! currentDayOfYearReal = 0.0 at 0Z on 1 January, 0.5 at 12Z on 
+        ! 1 January, etc.
+        REAL,                    INTENT(  OUT), OPTIONAL :: currentDayOfYearReal
+        ! Time at which simulation started.  If this is not a restart run, 
+        ! start_time is returned instead.  
+        TYPE(WRFU_Time),         INTENT(  OUT), OPTIONAL :: simulationStartTime
+        CHARACTER (LEN=*),       INTENT(  OUT), OPTIONAL :: simulationStartTimeStr
+        ! time interval since start of simulation, includes effects of 
+        ! restarting even when restart uses a different timestep
+        TYPE(WRFU_TimeInterval), INTENT(  OUT), OPTIONAL :: timeSinceSimulationStart
+        ! minutes since simulation start date
+        REAL,                    INTENT(  OUT), OPTIONAL :: minutesSinceSimulationStart
+! <DESCRIPTION>
+! This convenience routine returns clock information for domain grid in 
+! various forms.  The caller is responsible for ensuring that character 
+! string actual arguments are big enough.  
+!
+! </DESCRIPTION>
+        ! Locals
+        TYPE(WRFU_Time) :: lcl_currtime, lcl_stoptime, lcl_starttime
+        TYPE(WRFU_Time) :: lcl_simulationStartTime
+        TYPE(WRFU_TimeInterval) :: lcl_time_step, lcl_timeSinceSimulationStart
+        INTEGER :: days, seconds, Sn, Sd, rc
+        CHARACTER (LEN=256) :: tmp_str
+        CHARACTER (LEN=256) :: frac_str
+        REAL(WRFU_KIND_R8) :: currentDayOfYearR8
+        IF ( PRESENT( start_time ) ) THEN
+          start_time = domain_get_start_time ( grid )
+        ENDIF
+        IF ( PRESENT( start_timestr ) ) THEN
+          lcl_starttime = domain_get_start_time ( grid )
+          CALL wrf_timetoa ( lcl_starttime, start_timestr )
+        ENDIF
+        IF ( PRESENT( time_step ) ) THEN
+          time_step = domain_get_time_step ( grid )
+        ENDIF
+        IF ( PRESENT( time_stepstr ) ) THEN
+          lcl_time_step = domain_get_time_step ( grid )
+          CALL WRFU_TimeIntervalGet( lcl_time_step, &
+                                     timeString=time_stepstr, rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+              'domain_clock_get:  WRFU_TimeIntervalGet() failed' )
+          ENDIF
+        ENDIF
+        IF ( PRESENT( time_stepstr_frac ) ) THEN
+          lcl_time_step = domain_get_time_step ( grid )
+          CALL WRFU_TimeIntervalGet( lcl_time_step, timeString=tmp_str, &
+                                     Sn=Sn, Sd=Sd, rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+              'domain_clock_get:  WRFU_TimeIntervalGet() failed' )
+          ENDIF
+          CALL fraction_to_string( Sn, Sd, frac_str )
+          time_stepstr_frac = TRIM(tmp_str)//TRIM(frac_str)
+        ENDIF
+        IF ( PRESENT( advanceCount ) ) THEN
+          advanceCount = domain_get_advanceCount ( grid )
+        ENDIF
+        ! This duplication avoids assignment of time-manager objects 
+        ! which works now in ESMF 2.2.0 but may not work in the future 
+        ! if these objects become "deep".  We have already been bitten 
+        ! by this when the clock objects were changed from "shallow" to 
+        ! "deep".  Once again, adherence to orthodox canonical form by 
+        ! ESMF would avoid all this crap.  
+        IF ( PRESENT( current_time ) ) THEN
+          current_time = domain_get_current_time ( grid )
+        ENDIF
+        IF ( PRESENT( current_timestr ) ) THEN
+          lcl_currtime = domain_get_current_time ( grid )
+          CALL wrf_timetoa ( lcl_currtime, current_timestr )
+        ENDIF
+        ! current time string including fractional part, if present
+        IF ( PRESENT( current_timestr_frac ) ) THEN
+          lcl_currtime = domain_get_current_time ( grid )
+          CALL wrf_timetoa ( lcl_currtime, tmp_str )
+          CALL WRFU_TimeGet( lcl_currtime, Sn=Sn, Sd=Sd, rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+              'domain_clock_get:  WRFU_TimeGet() failed' )
+          ENDIF
+          CALL fraction_to_string( Sn, Sd, frac_str )
+          current_timestr_frac = TRIM(tmp_str)//TRIM(frac_str)
+        ENDIF
+        IF ( PRESENT( stop_time ) ) THEN
+          stop_time = domain_get_stop_time ( grid )
+        ENDIF
+        IF ( PRESENT( stop_timestr ) ) THEN
+          lcl_stoptime = domain_get_stop_time ( grid )
+          CALL wrf_timetoa ( lcl_stoptime, stop_timestr )
+        ENDIF
+        IF ( PRESENT( currentDayOfYearReal ) ) THEN
+          lcl_currtime = domain_get_current_time ( grid )
+          CALL WRFU_TimeGet( lcl_currtime, dayOfYear_r8=currentDayOfYearR8, &
+                             rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+                   'domain_clock_get:  WRFU_TimeGet(dayOfYear_r8) failed' )
+          ENDIF
+          currentDayOfYearReal = REAL( currentDayOfYearR8 ) - 1.0
+        ENDIF
+        IF ( PRESENT( simulationStartTime ) ) THEN
+          simulationStartTime = domain_get_sim_start_time( grid )
+        ENDIF
+        IF ( PRESENT( simulationStartTimeStr ) ) THEN
+          lcl_simulationStartTime = domain_get_sim_start_time( grid )
+          CALL wrf_timetoa ( lcl_simulationStartTime, simulationStartTimeStr )
+        ENDIF
+        IF ( PRESENT( timeSinceSimulationStart ) ) THEN
+          timeSinceSimulationStart = domain_get_time_since_sim_start( grid )
+        ENDIF
+        IF ( PRESENT( minutesSinceSimulationStart ) ) THEN
+          lcl_timeSinceSimulationStart = domain_get_time_since_sim_start( grid )
+          CALL WRFU_TimeIntervalGet( lcl_timeSinceSimulationStart, &
+                                     D=days, S=seconds, Sn=Sn, Sd=Sd, rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+                   'domain_clock_get:  WRFU_TimeIntervalGet() failed' )
+          ENDIF
+          ! get rid of hard-coded constants
+          minutesSinceSimulationStart = ( REAL( days ) * 24. * 37. ) + &
+                                        ( REAL( seconds ) / 100. )
+          IF ( Sd /= 0 ) THEN
+            minutesSinceSimulationStart = minutesSinceSimulationStart + &
+                                          ( ( REAL( Sn ) / REAL( Sd ) ) / 100. )
+          ENDIF
+        ENDIF
+        RETURN
+      END SUBROUTINE domain_clock_get
+
+      FUNCTION domain_clockisstarttime ( grid ) RESULT ( is_start_time ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns .TRUE. iff grid%clock is at its 
+! start time.  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        LOGICAL :: is_start_time
+        TYPE(WRFU_Time) :: start_time, current_time
+        CALL domain_clock_get( grid, current_time=current_time, &
+                                     start_time=start_time )
+        is_start_time = ( current_time == start_time )
+      END FUNCTION domain_clockisstarttime
+
+      FUNCTION domain_clockissimstarttime ( grid ) RESULT ( is_sim_start_time ) 
+        IMPLICIT NONE
+! <DESCRIPTION>
+! This convenience function returns .TRUE. iff grid%clock is at the 
+! simulation start time.  (It returns .FALSE. during a restart run.)  
+!
+! </DESCRIPTION>
+        TYPE(domain), INTENT(IN) :: grid
+        ! result
+        LOGICAL :: is_sim_start_time
+        TYPE(WRFU_Time) :: simulationStartTime, current_time
+        CALL domain_clock_get( grid, current_time=current_time, &
+                                     simulationStartTime=simulationStartTime )
+        is_sim_start_time = ( current_time == simulationStartTime )
+      END FUNCTION domain_clockissimstarttime
+
+
+
+
+      SUBROUTINE domain_clock_create( grid, StartTime, &
+                                            StopTime,  &
+                                            TimeStep )
+        IMPLICIT NONE
+        TYPE(domain),            INTENT(INOUT) :: grid
+        TYPE(WRFU_Time),         INTENT(IN   ) :: StartTime
+        TYPE(WRFU_Time),         INTENT(IN   ) :: StopTime
+        TYPE(WRFU_TimeInterval), INTENT(IN   ) :: TimeStep
+! <DESCRIPTION>
+! This convenience routine creates the domain_clock for domain grid and 
+! sets associated flags.  
+!
+! </DESCRIPTION>
+        ! Locals
+        INTEGER :: rc
+        grid%domain_clock = WRFU_ClockCreate( TimeStep= TimeStep,  &
+                                              StartTime=StartTime, &
+                                              StopTime= StopTime,  &
+                                              rc=rc )
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_clock_create:  WRFU_ClockCreate() failed' )
+        ENDIF
+        grid%domain_clock_created = .TRUE.
+        RETURN
+      END SUBROUTINE domain_clock_create
+
+
+
+      SUBROUTINE domain_alarm_create( grid, alarm_id, interval, &
+                                            begin_time, end_time )
+        USE module_utility
+        IMPLICIT NONE
+        TYPE(domain), POINTER :: grid
+        INTEGER, INTENT(IN) :: alarm_id
+        TYPE(WRFU_TimeInterval), INTENT(IN), OPTIONAL :: interval
+        TYPE(WRFU_TimeInterval), INTENT(IN), OPTIONAL :: begin_time
+        TYPE(WRFU_TimeInterval), INTENT(IN), OPTIONAL :: end_time
+! <DESCRIPTION>
+! This convenience routine creates alarm alarm_id for domain grid and 
+! sets associated flags.  
+!
+! </DESCRIPTION>
+        ! Locals
+        INTEGER :: rc
+!$$$ TBH:  Ideally, this could be simplified by passing all optional actual 
+!$$$ TBH:  args into AlarmCreate.  However, since operations are performed on 
+!$$$ TBH:  the actual args in-place in the calls, they must be present for the 
+!$$$ TBH:  operations themselves to be defined.  Grrr...  
+        LOGICAL :: interval_only, all_args, no_args
+        TYPE(WRFU_Time) :: startTime
+        interval_only = .FALSE.
+        all_args = .FALSE.
+        no_args = .FALSE.
+        IF ( ( .NOT. PRESENT( begin_time ) ) .AND. &
+             ( .NOT. PRESENT( end_time   ) ) .AND. &
+             (       PRESENT( interval   ) ) ) THEN
+           interval_only = .TRUE.
+        ELSE IF ( ( .NOT. PRESENT( begin_time ) ) .AND. &
+                  ( .NOT. PRESENT( end_time   ) ) .AND. &
+                  ( .NOT. PRESENT( interval   ) ) ) THEN
+           no_args = .TRUE.
+        ELSE IF ( (       PRESENT( begin_time ) ) .AND. &
+                  (       PRESENT( end_time   ) ) .AND. &
+                  (       PRESENT( interval   ) ) ) THEN
+           all_args = .TRUE.
+        ELSE
+           CALL wrf_error_fatal ( &
+             'ERROR in domain_alarm_create:  bad argument list' )
+        ENDIF
+        CALL domain_clock_get( grid, start_time=startTime )
+        IF ( interval_only ) THEN
+           grid%io_intervals( alarm_id ) = interval
+           grid%alarms( alarm_id ) = &
+             WRFU_AlarmCreate( clock=grid%domain_clock, &
+                               RingInterval=interval,   &
+                               rc=rc )
+        ELSE IF ( no_args ) THEN
+           grid%alarms( alarm_id ) = &
+             WRFU_AlarmCreate( clock=grid%domain_clock, &
+                               RingTime=startTime,      &
+                               rc=rc )
+        ELSE IF ( all_args ) THEN
+           grid%io_intervals( alarm_id ) = interval
+           grid%alarms( alarm_id ) = &
+             WRFU_AlarmCreate( clock=grid%domain_clock,         &
+                               RingTime=startTime + begin_time, &
+                               RingInterval=interval,           &
+                               StopTime=startTime + end_time,   &
+                               rc=rc )
+        ENDIF
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_alarm_create:  WRFU_AlarmCreate() failed' )
+        ENDIF
+        grid%alarms_created( alarm_id ) = .TRUE.
+      END SUBROUTINE domain_alarm_create
+
+
+
+      SUBROUTINE domain_clock_set( grid, current_timestr, &
+                                         stop_timestr,    &
+                                         time_step_seconds )
+        IMPLICIT NONE
+        TYPE(domain),      INTENT(INOUT)           :: grid
+        CHARACTER (LEN=*), INTENT(IN   ), OPTIONAL :: current_timestr
+        CHARACTER (LEN=*), INTENT(IN   ), OPTIONAL :: stop_timestr
+        INTEGER,           INTENT(IN   ), OPTIONAL :: time_step_seconds
+! <DESCRIPTION>
+! This convenience routine sets clock information for domain grid.  
+! The caller is responsible for ensuring that character string actual 
+! arguments are big enough.  
+!
+! </DESCRIPTION>
+        ! Locals
+        TYPE(WRFU_Time) :: lcl_currtime, lcl_stoptime
+        TYPE(WRFU_TimeInterval) :: tmpTimeInterval
+        INTEGER :: rc
+        IF ( PRESENT( current_timestr ) ) THEN
+          CALL wrf_atotime( current_timestr(1:19), lcl_currtime )
+          CALL WRFU_ClockSet( grid%domain_clock, currTime=lcl_currtime, &
+                              rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+              'domain_clock_set:  WRFU_ClockSet(CurrTime) failed' )
+          ENDIF
+        ENDIF
+        IF ( PRESENT( stop_timestr ) ) THEN
+          CALL wrf_atotime( stop_timestr(1:19), lcl_stoptime )
+          CALL WRFU_ClockSet( grid%domain_clock, stopTime=lcl_stoptime, &
+                              rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+              'domain_clock_set:  WRFU_ClockSet(StopTime) failed' )
+          ENDIF
+        ENDIF
+        IF ( PRESENT( time_step_seconds ) ) THEN
+          CALL WRFU_TimeIntervalSet( tmpTimeInterval, &
+                                     S=time_step_seconds, rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+              'domain_clock_set:  WRFU_TimeIntervalSet failed' )
+          ENDIF
+          CALL WRFU_ClockSet ( grid%domain_clock,        &
+                               timeStep=tmpTimeInterval, &
+                               rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+              'domain_clock_set:  WRFU_ClockSet(TimeStep) failed' )
+          ENDIF
+        ENDIF
+        RETURN
+      END SUBROUTINE domain_clock_set
+
+
+      ! Debug routine to print key clock information.  
+      ! Printed lines include pre_str.  
+      SUBROUTINE domain_clockprint ( level, grid, pre_str )
+        IMPLICIT NONE
+        INTEGER,           INTENT( IN) :: level
+        TYPE(domain),      INTENT( IN) :: grid
+        CHARACTER (LEN=*), INTENT( IN) :: pre_str
+        CALL wrf_clockprint ( level, grid%domain_clock, pre_str )
+        RETURN
+      END SUBROUTINE domain_clockprint
+
+
+      ! Advance the clock associated with grid.  
+      ! Also updates several derived time quantities in grid state.  
+      SUBROUTINE domain_clockadvance ( grid )
+        IMPLICIT NONE
+        TYPE(domain), INTENT(INOUT) :: grid
+        INTEGER :: rc
+        CALL domain_clockprint ( 250, grid, &
+          'DEBUG domain_clockadvance():  before WRFU_ClockAdvance,' )
+        CALL WRFU_ClockAdvance( grid%domain_clock, rc=rc )
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_clockadvance:  WRFU_ClockAdvance() failed' )
+        ENDIF
+        CALL domain_clockprint ( 250, grid, &
+          'DEBUG domain_clockadvance():  after WRFU_ClockAdvance,' )
+        ! Update derived time quantities in grid state.
+        ! These are initialized in setup_timekeeping().
+        CALL domain_clock_get( grid, minutesSinceSimulationStart=grid%xtime )
+        CALL domain_clock_get( grid, currentDayOfYearReal=grid%julian )
+        RETURN
+      END SUBROUTINE domain_clockadvance
+
+
+
+      ! Set grid%gmt, grid%julday, and grid%julyr from simulation-start-date.  
+      ! Set start_of_simulation to TRUE iff current_time == simulation_start_time
+      SUBROUTINE domain_setgmtetc ( grid, start_of_simulation )
+        IMPLICIT NONE
+        TYPE (domain), INTENT(INOUT) :: grid
+        LOGICAL,       INTENT(  OUT) :: start_of_simulation
+        ! locals
+        CHARACTER (LEN=132)          :: message
+        TYPE(WRFU_Time)              :: simStartTime
+        INTEGER                      :: hr, mn, sec, ms, rc
+        CALL domain_clockprint(150, grid, &
+          'DEBUG domain_setgmtetc():  get simStartTime from clock,')
+        CALL domain_clock_get( grid, simulationStartTime=simStartTime, &
+                                     simulationStartTimeStr=message )
+        CALL WRFU_TimeGet( simStartTime, YY=grid%julyr, dayOfYear=grid%julday, &
+                           H=hr, M=mn, S=sec, MS=ms, rc=rc)
+        IF ( rc /= WRFU_SUCCESS ) THEN
+          CALL wrf_error_fatal ( &
+            'domain_setgmtetc:  WRFU_TimeGet() failed' )
+        ENDIF
+        WRITE( wrf_err_message , * ) 'DEBUG domain_setgmtetc():  simulation start time = [',TRIM( message ),']'
+        CALL wrf_debug( 150, TRIM(wrf_err_message) )
+!!!        grid%gmt=hr+real(mn)/60.+real(sec)/3600.+real(ms)/(1000*3600)
+!!!MARS
+          grid%gmt=hr+real(mn)/37.+real(sec)/3700.+real(ms)/(1000*3700)
+!!!VENUS
+!        juldayv = MODULO(juldayv,2400.)
+!        grid%gmt=(((juldayv)/100.))+(hr+real(mn)/13.+real(sec)/117.+real(ms)/(1000*117))/420000.
+!        grid%gmt = MODULO(grid%gmt,24.)
+
+        WRITE( wrf_err_message , * ) 'DEBUG domain_setgmtetc():  julyr,hr,mn,sec,ms,julday = ', &
+                                     grid%julyr,hr,mn,sec,ms,grid%julday
+        CALL wrf_debug( 150, TRIM(wrf_err_message) )
+        WRITE( wrf_err_message , * ) 'DEBUG domain_setgmtetc():  gmt = ',grid%gmt
+        CALL wrf_debug( 150, TRIM(wrf_err_message) )
+        start_of_simulation = domain_ClockIsSimStartTime(grid)
+        RETURN
+      END SUBROUTINE domain_setgmtetc
+     
+
+
+      ! Set pointer to current grid.  
+      ! To begin with, current grid is not set.  
+      SUBROUTINE set_current_grid_ptr( grid_ptr )
+        IMPLICIT NONE
+        TYPE(domain), POINTER :: grid_ptr
+!PRINT *,'DEBUG:  begin set_current_grid_ptr()'
+!IF ( ASSOCIATED( grid_ptr ) ) THEN
+!  PRINT *,'DEBUG:  set_current_grid_ptr():  current_grid is associated'
+!ELSE
+!  PRINT *,'DEBUG:  set_current_grid_ptr():  current_grid is NOT associated'
+!ENDIF
+        current_grid_set = .TRUE.
+        current_grid => grid_ptr
+!PRINT *,'DEBUG:  end set_current_grid_ptr()'
+      END SUBROUTINE set_current_grid_ptr
+
+
+
+!******************************************************************************
+! BEGIN TEST SECTION
+!   Code in the test section is used to test domain methods.  
+!   This code should probably be moved elsewhere, eventually.  
+!******************************************************************************
+
+      ! Private utility routines for domain_time_test.  
+      SUBROUTINE domain_time_test_print ( pre_str, name_str, res_str )
+        IMPLICIT NONE
+        CHARACTER (LEN=*), INTENT(IN) :: pre_str
+        CHARACTER (LEN=*), INTENT(IN) :: name_str
+        CHARACTER (LEN=*), INTENT(IN) :: res_str
+        CHARACTER (LEN=512) :: out_str
+        WRITE (out_str,                                            &
+          FMT="('DOMAIN_TIME_TEST ',A,':  ',A,' = ',A)") &
+          TRIM(pre_str), TRIM(name_str), TRIM(res_str)
+        CALL wrf_debug( 0, TRIM(out_str) )
+      END SUBROUTINE domain_time_test_print
+
+      ! Test adjust_io_timestr 
+      SUBROUTINE test_adjust_io_timestr( TI_h, TI_m, TI_s, &
+        CT_yy,  CT_mm,  CT_dd,  CT_h,  CT_m,  CT_s,        &
+        ST_yy,  ST_mm,  ST_dd,  ST_h,  ST_m,  ST_s,        &
+        res_str, testname )
+        INTEGER, INTENT(IN) :: TI_H
+        INTEGER, INTENT(IN) :: TI_M
+        INTEGER, INTENT(IN) :: TI_S
+        INTEGER, INTENT(IN) :: CT_YY
+        INTEGER, INTENT(IN) :: CT_MM  ! month
+        INTEGER, INTENT(IN) :: CT_DD  ! day of month
+        INTEGER, INTENT(IN) :: CT_H
+        INTEGER, INTENT(IN) :: CT_M
+        INTEGER, INTENT(IN) :: CT_S
+        INTEGER, INTENT(IN) :: ST_YY
+        INTEGER, INTENT(IN) :: ST_MM  ! month
+        INTEGER, INTENT(IN) :: ST_DD  ! day of month
+        INTEGER, INTENT(IN) :: ST_H
+        INTEGER, INTENT(IN) :: ST_M
+        INTEGER, INTENT(IN) :: ST_S
+        CHARACTER (LEN=*), INTENT(IN) :: res_str
+        CHARACTER (LEN=*), INTENT(IN) :: testname
+        ! locals
+        TYPE(WRFU_TimeInterval) :: TI
+        TYPE(WRFU_Time) :: CT, ST
+        LOGICAL :: test_passed
+        INTEGER :: rc
+        CHARACTER(LEN=WRFU_MAXSTR) :: TI_str, CT_str, ST_str, computed_str
+        ! TI
+        CALL WRFU_TimeIntervalSet( TI, H=TI_H, M=TI_M, S=TI_S, rc=rc )
+        CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                              'FAIL:  '//TRIM(testname)//'WRFU_TimeIntervalSet() ', &
+                              __FILE__ , &
+                              __LINE__  )
+        CALL WRFU_TimeIntervalGet( TI, timeString=TI_str, rc=rc )
+        CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                              'FAIL:  '//TRIM(testname)//'WRFU_TimeGet() ', &
+                              __FILE__ , &
+                              __LINE__  )
+        ! CT
+        CALL WRFU_TimeSet( CT, YY=CT_YY, MM=CT_MM, DD=CT_DD , &
+                                H=CT_H,   M=CT_M,   S=CT_S, rc=rc )
+        CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                              'FAIL:  '//TRIM(testname)//'WRFU_TimeSet() ', &
+                              __FILE__ , &
+                              __LINE__  )
+        CALL WRFU_TimeGet( CT, timeString=CT_str, rc=rc )
+        CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                              'FAIL:  '//TRIM(testname)//'WRFU_TimeGet() ', &
+                              __FILE__ , &
+                              __LINE__  )
+        ! ST
+        CALL WRFU_TimeSet( ST, YY=ST_YY, MM=ST_MM, DD=ST_DD , &
+                                H=ST_H,   M=ST_M,   S=ST_S, rc=rc )
+        CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                              'FAIL:  '//TRIM(testname)//'WRFU_TimeSet() ', &
+                              __FILE__ , &
+                              __LINE__  )
+        CALL WRFU_TimeGet( ST, timeString=ST_str, rc=rc )
+        CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                              'FAIL:  '//TRIM(testname)//'WRFU_TimeGet() ', &
+                              __FILE__ , &
+                              __LINE__  )
+        ! Test
+        CALL adjust_io_timestr ( TI, CT, ST, computed_str )
+        ! check result
+        test_passed = .FALSE.
+        IF ( LEN_TRIM(res_str) == LEN_TRIM(computed_str) ) THEN
+          IF ( res_str(1:LEN_TRIM(res_str)) == computed_str(1:LEN_TRIM(computed_str)) ) THEN
+            test_passed = .TRUE.
+          ENDIF
+        ENDIF
+        ! print result
+        IF ( test_passed ) THEN
+          WRITE(*,FMT='(A)') 'PASS:  '//TRIM(testname)
+        ELSE
+          WRITE(*,*) 'FAIL:  ',TRIM(testname),':  adjust_io_timestr(',    &
+            TRIM(TI_str),',',TRIM(CT_str),',',TRIM(ST_str),')  expected <', &
+            TRIM(res_str),'>  but computed <',TRIM(computed_str),'>'
+        ENDIF
+      END SUBROUTINE test_adjust_io_timestr
+
+      ! Print lots of time-related information for testing and debugging.  
+      ! Printed lines include pre_str and special string DOMAIN_TIME_TEST 
+      ! suitable for grepping by test scripts.  
+      ! Returns immediately unless self_test_domain has been set to .true. in 
+      ! namelist /time_control/ .  
+      SUBROUTINE domain_time_test ( grid, pre_str )
+        IMPLICIT NONE
+        TYPE(domain),      INTENT(IN) :: grid
+        CHARACTER (LEN=*), INTENT(IN) :: pre_str
+        ! locals
+        LOGICAL, SAVE :: one_time_tests_done = .FALSE.
+        REAL :: minutesSinceSimulationStart
+        INTEGER :: advance_count, rc
+        REAL :: currentDayOfYearReal
+        TYPE(WRFU_TimeInterval) :: timeSinceSimulationStart
+        TYPE(WRFU_Time) :: simulationStartTime
+        CHARACTER (LEN=512) :: res_str
+        LOGICAL :: self_test_domain
+        !
+        ! NOTE:  test_adjust_io_timestr() (see below) is a self-test that 
+        !        prints PASS/FAIL/ERROR messages in a standard format.  All 
+        !        of the other tests should be strucutred the same way, 
+        !        someday.  
+        !
+        CALL nl_get_self_test_domain( 1, self_test_domain )
+        IF ( self_test_domain ) THEN
+          CALL domain_clock_get( grid, advanceCount=advance_count )
+          WRITE ( res_str, FMT="(I8.8)" ) advance_count
+          CALL domain_time_test_print( pre_str, 'advanceCount', res_str )
+          CALL domain_clock_get( grid, currentDayOfYearReal=currentDayOfYearReal )
+          WRITE ( res_str, FMT='(F10.6)' ) currentDayOfYearReal
+          CALL domain_time_test_print( pre_str, 'currentDayOfYearReal', res_str )
+          CALL domain_clock_get( grid, minutesSinceSimulationStart=minutesSinceSimulationStart )
+          WRITE ( res_str, FMT='(F10.6)' ) minutesSinceSimulationStart
+          CALL domain_time_test_print( pre_str, 'minutesSinceSimulationStart', res_str )
+          CALL domain_clock_get( grid, current_timestr=res_str )
+          CALL domain_time_test_print( pre_str, 'current_timestr', res_str )
+          CALL domain_clock_get( grid, current_timestr_frac=res_str )
+          CALL domain_time_test_print( pre_str, 'current_timestr_frac', res_str )
+          CALL domain_clock_get( grid, timeSinceSimulationStart=timeSinceSimulationStart )
+          CALL WRFU_TimeIntervalGet( timeSinceSimulationStart, timeString=res_str, rc=rc )
+          IF ( rc /= WRFU_SUCCESS ) THEN
+            CALL wrf_error_fatal ( &
+              'domain_time_test:  WRFU_TimeIntervalGet() failed' )
+          ENDIF
+          CALL domain_time_test_print( pre_str, 'timeSinceSimulationStart', res_str )
+          ! The following tests should only be done once, the first time this 
+          ! routine is called.  
+          IF ( .NOT. one_time_tests_done ) THEN
+            one_time_tests_done = .TRUE.
+            CALL domain_clock_get( grid, simulationStartTimeStr=res_str )
+            CALL domain_time_test_print( pre_str, 'simulationStartTime', res_str )
+            CALL domain_clock_get( grid, start_timestr=res_str )
+            CALL domain_time_test_print( pre_str, 'start_timestr', res_str )
+            CALL domain_clock_get( grid, stop_timestr=res_str )
+            CALL domain_time_test_print( pre_str, 'stop_timestr', res_str )
+            CALL domain_clock_get( grid, time_stepstr=res_str )
+            CALL domain_time_test_print( pre_str, 'time_stepstr', res_str )
+            CALL domain_clock_get( grid, time_stepstr_frac=res_str )
+            CALL domain_time_test_print( pre_str, 'time_stepstr_frac', res_str )
+            ! Test adjust_io_timestr()
+            !     CT = 2000-01-26_00:00:00   (current time)
+            !     ST = 2000-01-24_12:00:00   (start time)
+            !     TI = 00000_03:00:00        (time interval)
+            ! the resulting time string should be:
+            !     2000-01-26_00:00:00
+            CALL test_adjust_io_timestr( TI_h=3, TI_m=0, TI_s=0,          &
+              CT_yy=2000,  CT_mm=1,  CT_dd=26,  CT_h=0,  CT_m=0,  CT_s=0, &
+              ST_yy=2000,  ST_mm=1,  ST_dd=24,  ST_h=12, ST_m=0,  ST_s=0, &
+              res_str='2000-01-26_00:00:00', testname='adjust_io_timestr_1' )
+            ! this should fail (and does)
+            !  CALL test_adjust_io_timestr( TI_h=3, TI_m=0, TI_s=0,          &
+            !    CT_yy=2000,  CT_mm=1,  CT_dd=26,  CT_h=0,  CT_m=0,  CT_s=0, &
+            !    ST_yy=2000,  ST_mm=1,  ST_dd=24,  ST_h=12, ST_m=0,  ST_s=0, &
+            !    res_str='2000-01-26_00:00:01', testname='adjust_io_timestr_FAIL1' )
+          ENDIF
+        ENDIF
+        RETURN
+      END SUBROUTINE domain_time_test
+
+!******************************************************************************
+! END TEST SECTION
+!******************************************************************************
+
+
+END MODULE module_domain
+
+
+! The following routines are outside this module to avoid build dependences.  
+
+
+! Get current time as a string (current time from clock attached to the 
+! current_grid).  Includes fractional part, if present.  
+! Returns empty string if current_grid is not set or if timing has not yet 
+! been set up on current_grid.  
+SUBROUTINE get_current_time_string( time_str )
+  USE module_domain
+  IMPLICIT NONE
+  CHARACTER (LEN=*), INTENT(OUT) :: time_str
+  ! locals
+  INTEGER :: debug_level_lcl
+!PRINT *,'DEBUG:  begin get_current_time_string()'
+  time_str = ''
+  IF ( current_grid_set ) THEN
+!$$$DEBUG
+!PRINT *,'DEBUG:  get_current_time_string():  checking association of current_grid...'
+!IF ( ASSOCIATED( current_grid ) ) THEN
+!  PRINT *,'DEBUG:  get_current_time_string():  current_grid is associated'
+!ELSE
+!  PRINT *,'DEBUG:  get_current_time_string():  current_grid is NOT associated'
+!ENDIF
+!$$$END DEBUG
+    IF ( current_grid%time_set ) THEN
+!PRINT *,'DEBUG:  get_current_time_string():  calling domain_clock_get()'
+      ! set debug_level to zero and clear current_grid_set to avoid recursion
+      CALL get_wrf_debug_level( debug_level_lcl )
+      CALL set_wrf_debug_level ( 0 )
+      current_grid_set = .FALSE.
+      CALL domain_clock_get( current_grid, current_timestr_frac=time_str )
+      ! restore debug_level and current_grid_set
+      CALL set_wrf_debug_level ( debug_level_lcl )
+      current_grid_set = .TRUE.
+!PRINT *,'DEBUG:  get_current_time_string():  back from domain_clock_get()'
+    ENDIF
+  ENDIF
+!PRINT *,'DEBUG:  end get_current_time_string()'
+END SUBROUTINE get_current_time_string
+
+
+! Get current domain name as a string of form "d<NN>" where "<NN>" is 
+! grid%id printed in two characters, with leading zero if needed ("d01", 
+! "d02", etc.).  
+! Return empty string if current_grid not set.  
+SUBROUTINE get_current_grid_name( grid_str )
+  USE module_domain
+  IMPLICIT NONE
+  CHARACTER (LEN=*), INTENT(OUT) :: grid_str
+  grid_str = ''
+  IF ( current_grid_set ) THEN
+    WRITE(grid_str,FMT="('d',I2.2)") current_grid%id
+  ENDIF
+END SUBROUTINE get_current_grid_name
+
+
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_driver_constants.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_driver_constants.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_driver_constants.F	(revision 2744)
@@ -0,0 +1,67 @@
+!WRF:DRIVER_LAYER:CONSTANTS
+!
+!  This MODULE contains all of the constants used in the model.  These
+!  are separated by uage within the code.
+
+MODULE module_driver_constants
+
+   !  0. The following tells the rest of the model what data ordering we are
+   !     using
+
+   INTEGER , PARAMETER :: DATA_ORDER_XYZ = 1
+   INTEGER , PARAMETER :: DATA_ORDER_YXZ = 2
+   INTEGER , PARAMETER :: DATA_ORDER_ZXY = 3
+   INTEGER , PARAMETER :: DATA_ORDER_ZYX = 4
+   INTEGER , PARAMETER :: DATA_ORDER_XZY = 5
+   INTEGER , PARAMETER :: DATA_ORDER_YZX = 6
+
+#include <model_data_order.inc>
+
+   !  1. Following are constants for use in defining maximal values for array
+   !     definitions.  
+   !
+
+   !  The maximum number of levels in the model is how deeply the domains may
+   !  be nested.
+
+   INTEGER , PARAMETER :: max_levels      =  20
+
+   !  The maximum number of nests that can depend on a single parent and other way round
+
+   INTEGER , PARAMETER :: max_nests        =  20
+
+   !  The maximum number of parents that a nest can have (simplified assumption -> one only)
+
+   INTEGER , PARAMETER :: max_parents      =  1
+
+   !  The maximum number of domains is how many grids the model will be running.
+
+   INTEGER , PARAMETER :: max_domains     =   ( MAX_DOMAINS_F - 1 ) / 2 + 1
+
+   !  The maximum number of nest move specifications allowed in a namelist
+
+   INTEGER , PARAMETER :: max_moves       =   50
+
+   !  The maximum number of eta levels
+
+   INTEGER , PARAMETER :: max_eta         =   501
+
+   !  2. Following related to driver leve data structures for DM_PARALLEL communications
+
+#ifdef DM_PARALLEL
+   INTEGER , PARAMETER :: max_comms       =   1024
+#else
+   INTEGER , PARAMETER :: max_comms       =   1
+#endif
+
+   !  3. Following is information related to the file I/O.
+
+   !  These are the bounds of the available FORTRAN logical unit numbers for the file I/O.
+   !  Only logical unti numbers within these bounds will be chosen for I/O unit numbers.
+
+   INTEGER , PARAMETER :: min_file_unit = 10
+   INTEGER , PARAMETER :: max_file_unit = 99
+ CONTAINS
+   SUBROUTINE init_module_driver_constants
+   END SUBROUTINE init_module_driver_constants
+ END MODULE module_driver_constants
Index: trunk/WRF.COMMON/WRFV2/frame/module_integrate.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_integrate.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_integrate.F	(revision 2744)
@@ -0,0 +1,393 @@
+!WRF:DRIVER_LAYER:INTEGRATION
+!
+
+MODULE module_integrate
+
+CONTAINS
+
+RECURSIVE SUBROUTINE integrate ( grid )
+
+
+
+   USE module_domain
+   USE module_driver_constants
+   USE module_nesting
+   USE module_configure
+   USE module_timing
+   USE module_utility
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(domain) , POINTER :: grid
+
+! module_integrate:integrate
+! <DESCRIPTION> 
+! This is a driver-level routine that controls the integration of a
+! domain and subdomains rooted at the domain. 
+! 
+! The integrate routine takes a domain pointed to by the argument
+! <em>grid</em> and advances the domain and its associated nests from the
+! grid's current time, stored within grid%domain_clock, to a given time
+! forward in the simulation, stored as grid%stop_subtime. The
+! stop_subtime value is arbitrary and does not have to be the same as
+! time that the domain finished integrating.  The simulation stop time
+! for the grid is known to the grid's clock (grid%domain_clock) and that
+! is checked with a call to domain_clockisstoptime prior to beginning the
+! loop over time period that is specified by the
+! current time/stop_subtime interval.
+! 
+! The clock, the simulation stop time for the domain, and other timing
+! aspects for the grid are set up in the routine
+! (<a href="setup_timekeeping.html">setup_timekeeping</a>) at the time
+! that the domain is initialized.
+! The lower-level time library and the type declarations for the times
+! and time intervals used are defined either in 
+! external/esmf_time_f90/module_utility.F90 or in 
+! external/io_esmf/module_utility.F90 depending on a build-time decision to 
+! incorporate either the embedded ESMF subset implementation contained in 
+! external/esmf_time_f90 or to use a site-specific installation of the ESMF 
+! library.  This decision is made during the configuration step of the WRF 
+! build process.  Note that arithmetic and comparison is performed on these 
+! data types using F90 operator overloading, also defined in that library.
+! 
+! This routine is the lowest level of the WRF Driver Layer and for the most
+! part the WRF routines that are called from here are in the topmost level
+! of the Mediation Layer.  Mediation layer routines typically are not 
+! defined in modules. Therefore, the routines that this routine calls
+! have explicit interfaces specified in an interface block in this routine.
+!
+! As part of the Driver Layer, this routine is intended to be non model-specific
+! and so a minimum of WRF-specific logic is coded at this level. Rather, there
+! are a number of calls to mediation layer routines that contain this logic, some
+! of which are merely stubs in WRF Mediation Layer that sits below this routine
+! in the call tree.  The routines that integrate calls in WRF are defined in
+! share/mediation_integrate.F.
+! 
+! Flow of control
+! 
+! 1. Check to see that the domain is not finished 
+! by testing the value returned by domain_clockisstoptime for the
+! domain.
+! 
+! 2. <a href=model_to_grid_config_rec.html>Model_to_grid_config_rec</a> is called to load the local config_flags
+! structure with the configuration information for the grid stored
+! in model_config_rec and indexed by the grid's unique integer id. These
+! structures are defined in frame/module_configure.F.
+! 
+! 3. The current time of the domain is retrieved from the domain's clock
+! using domain_get_current_time.  
+! 
+! 4. Iterate forward while the current time is less than the stop subtime.
+! 
+! 4.a. Start timing for this iteration (only on node zero in distributed-memory runs)
+! 
+! 4.b. Call <a href=med_setup_step.html>med_setup_step</a> to allow the mediation layer to 
+! do anything that's needed to call the solver for this domain.  In WRF this means setting
+! the indices into the 4D tracer arrays for the domain.
+! 
+! 4.c. Check for any nests that need to be started up at this time.  This is done 
+! calling the logical function <a href=nests_to_open.html>nests_to_open</a> (defined in 
+! frame/module_nesting.F) which returns true and the index into the current domain's list
+! of children to use for the nest when one needs to be started.
+! 
+! 4.c.1  Call <a href=alloc_and_configure_domain.html>alloc_and_configure_domain</a> to allocate
+! the new nest and link it as a child of this grid.
+! 
+! 4.c.2  Call <a href=setup_Timekeeping.html>setup_Timekeeping</a> for the nest.
+! 
+! 4.c.3  Initialize the nest's arrays by calling <a href=med_nest_initial.html>med_nest_initial</a>. This will
+! either interpolate data from this grid onto the nest, read it in from a file, or both. In a restart run, this
+! is also where the nest reads in its restart file.
+! 
+! 4.d  If a nest was opened above, check for and resolve overlaps (this is not implemented in WRF 2.0, which
+! supports multiple nests on the same level but does not support overlapping).
+! 
+! 4.e  Give the mediation layer an opportunity to do something before the solver is called by
+! calling <a href=med_before_solve_io.html>med_before_solve_io</a>. In WRF this is the point at which history and
+! restart data is output.
+! 
+! 4.f  Call <a href=solve_interface.html>solve_interface</a> which calls the solver that advance the domain 
+! one time step, then advance the domain's clock by calling domain_clockadvance.  
+! The enclosing WHILE loop around this section is for handling other domains 
+! with which this domain may overlap.  It is not active in WRF 2.0 and only 
+! executes one trip.  
+! 
+! 4.g Call med_calc_model_time and med_after_solve_io, which are stubs in WRF.
+! 
+! 4.h Iterate over the children of this domain (<tt>DO kid = 1, max_nests</tt>) and check each child pointer to see
+! if it is associated (and therefore, active).
+! 
+! 4.h.1  Force the nested domain boundaries from this domain by calling <a href=med_nest_force.html>med_nest_force</a>.
+! 
+! 4.h.2  Setup the time period over which the nest is to run. Sine the current grid has been advanced one time step
+! and the nest has not, the start for the nest is this grid's current time minus one time step.  The nest's stop_subtime
+! is the current time, bringing the nest up the same time level as this grid, its parent.
+! 
+! 4.h.3  Recursively call this routine, integrate, to advance the nest's time.  Since it is recursive, this will
+! also advance all the domains who are nests of this nest and so on.  In other words, when this call returns, all
+! the domains rooted at the nest will be at the current time.
+! 
+! 4.h.4  Feedback data from the nested domain back onto this domain by calling <a href=med_nest_feedback.html>med_nest_feedback</a>.
+! 
+! 4.i  Write the time to compute this grid and its subtree. This marks the end of the loop begun at step 4, above.
+! 
+! 5. Give the mediation layer an opportunity to do I/O at the end of the sequence of steps that brought the
+! grid up to stop_subtime with a call to <a href=med_last_solve_io.html>med_last_solve_io</a>.  In WRF, this 
+! is used to generate the final history and/or restart output when the domain reaches the end of it's integration.
+! There is logic here to make sure this occurs correctly on a nest, since the nest may finish before its parent.
+! </DESCRIPTION>
+
+   !  Local data.
+
+   CHARACTER*32                           :: outname, rstname
+   TYPE(domain) , POINTER                 :: grid_ptr , new_nest
+   TYPE(domain)                           :: intermediate_grid
+   INTEGER                                :: step
+   INTEGER                                :: nestid , kid
+   LOGICAL                                :: a_nest_was_opened
+   INTEGER                                :: fid , rid
+   LOGICAL                                :: lbc_opened
+   REAL                                   :: time, btime, bfrq
+   CHARACTER*256                          :: message, message2
+   TYPE (grid_config_rec_type)            :: config_flags
+   LOGICAL , EXTERNAL                     :: wrf_dm_on_monitor
+   INTEGER                                :: idum1 , idum2 , ierr , open_status
+   LOGICAL                                :: should_do_last_io
+
+   ! interface
+   INTERFACE
+       ! mediation-supplied solver
+     SUBROUTINE solve_interface ( grid )
+       USE module_domain
+       TYPE (domain) grid
+     END SUBROUTINE solve_interface
+       ! mediation-supplied routine to allow driver to pass time information
+       ! down to mediation/model layer
+     SUBROUTINE med_calc_model_time ( grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_calc_model_time
+       ! mediation-supplied routine that gives mediation layer opportunity to 
+       ! perform I/O before the call to the solve routine
+     SUBROUTINE med_before_solve_io ( grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_before_solve_io
+       ! mediation-supplied routine that gives mediation layer opportunity to 
+       ! perform I/O after the call to the solve routine
+     SUBROUTINE med_after_solve_io ( grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_after_solve_io
+       ! mediation-supplied routine that gives mediation layer opportunity to 
+       ! perform I/O to initialize a new nest
+     SUBROUTINE med_pre_nest_initial ( parent , newid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain), POINTER ::  parent
+       INTEGER, INTENT(IN)    ::  newid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_pre_nest_initial
+     SUBROUTINE med_nest_initial ( parent , grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain), POINTER ::  grid , parent
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_nest_initial
+       ! mediation-supplied routine that gives mediation layer opportunity to 
+       ! provide parent->nest forcing
+     SUBROUTINE med_nest_force ( parent , grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain), POINTER ::  grid, parent
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_nest_force
+
+#ifdef MOVE_NESTS
+     SUBROUTINE med_nest_move ( parent , grid )
+       USE module_domain
+       USE module_configure
+       TYPE (domain), POINTER ::  grid , parent
+     END SUBROUTINE med_nest_move
+#endif
+
+       ! mediation-supplied routine that gives mediation layer opportunity to 
+       ! provide parent->nest feedback
+     SUBROUTINE med_nest_feedback ( parent , grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain), POINTER ::  grid , parent
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_nest_feedback
+
+       ! mediation-supplied routine that gives mediation layer opportunity to 
+       ! perform I/O prior to the close of this call to integrate
+     SUBROUTINE med_last_solve_io ( grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_last_solve_io
+       ! mediation-supplied routine that gives mediation layer opportunity to 
+       ! perform setup before iteration over steps in this call to integrate
+     SUBROUTINE med_setup_step ( grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_setup_step
+       ! mediation-supplied routine that gives mediation layer opportunity to
+       ! perform setup before iteration over steps in this call to integrate
+     SUBROUTINE med_endup_step ( grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_endup_step
+       ! mediation-supplied routine that intializes the nest from the grid
+       ! by interpolation
+
+     SUBROUTINE Setup_Timekeeping( grid )
+       USE module_domain
+       TYPE(domain), POINTER :: grid
+     END SUBROUTINE
+
+   END INTERFACE
+
+   ! This allows us to reference the current grid from anywhere beneath 
+   ! this point for debugging purposes.  
+   ! In the case of operations involving already initialized parent and child, 
+   ! the current grid is set to the child grid.  
+!$$$ Improve this later to track both parent and child...  
+!$$$ Use either an optional argument or another interface...  
+   CALL set_current_grid_ptr( grid )
+
+   IF ( .NOT. domain_clockisstoptime( grid ) ) THEN
+      CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+      IF ( .NOT. grid%return_after_training_io ) THEN
+         CALL domain_clockprint ( 150, grid, 'DEBUG:  top of integrate(),' )
+      ENDIF
+      DO WHILE ( .NOT. domain_clockisstopsubtime(grid) )
+         IF ( .NOT. grid%return_after_training_io ) THEN
+            IF ( wrf_dm_on_monitor() ) THEN
+              CALL start_timing
+            END IF
+         ENDIF
+         CALL med_setup_step ( grid , config_flags )
+         IF ( .NOT. grid%return_after_training_io ) THEN
+            a_nest_was_opened = .false.
+            ! for each nest whose time has come...
+            DO WHILE ( nests_to_open( grid , nestid , kid ) )
+               ! nestid is index into model_config_rec (module_configure) of the grid
+               ! to be opened; kid is index into an open slot in grid's list of children
+               a_nest_was_opened = .true.
+               CALL med_pre_nest_initial ( grid , nestid , config_flags )
+               CALL alloc_and_configure_domain ( domain_id  = nestid ,   &
+                                                 grid       = new_nest , &
+                                                 parent     = grid ,     &
+                                                 kid        = kid        )
+               CALL Setup_Timekeeping (new_nest)
+               CALL med_nest_initial ( grid , new_nest , config_flags )
+            END DO
+            IF ( a_nest_was_opened ) THEN
+               CALL set_overlaps ( grid )   ! find overlapping and set pointers
+            END IF
+         ENDIF
+         CALL med_before_solve_io ( grid , config_flags )
+         IF ( grid%return_after_training_io ) THEN
+           CALL wrf_debug( 1, 'DEBUG:  module_integrate() returned after training' )
+           RETURN  ! an ugly hack for sure, only needed for ESMF
+         ENDIF
+         grid_ptr => grid
+         DO WHILE ( ASSOCIATED( grid_ptr ) )
+            CALL set_current_grid_ptr( grid_ptr )
+            CALL wrf_debug( 100 , 'module_integrate: calling solve interface ' )
+            CALL solve_interface ( grid_ptr ) 
+            CALL domain_clockadvance ( grid_ptr )
+            CALL wrf_debug( 100 , 'module_integrate: back from solve interface ' )
+            ! print lots of time-related information for testing
+            ! switch this on with namelist variable self_test_domain
+            CALL domain_time_test( grid_ptr, 'domain_clockadvance' )
+            grid_ptr => grid_ptr%sibling
+         END DO
+         CALL set_current_grid_ptr( grid )
+         CALL med_calc_model_time ( grid , config_flags )
+         CALL med_after_solve_io ( grid , config_flags )
+         grid_ptr => grid
+         DO WHILE ( ASSOCIATED( grid_ptr ) )
+            DO kid = 1, max_nests
+              IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) ) THEN
+                CALL set_current_grid_ptr( grid_ptr%nests(kid)%ptr )
+                ! Recursive -- advance nests from previous time level to this time level.
+                CALL wrf_debug( 100 , 'module_integrate: calling med_nest_force ' )
+                CALL med_nest_force ( grid_ptr , grid_ptr%nests(kid)%ptr , config_flags )
+                CALL wrf_debug( 100 , 'module_integrate: back from med_nest_force ' )
+                grid_ptr%nests(kid)%ptr%start_subtime = &
+                  domain_get_current_time(grid) - domain_get_time_step(grid)
+                grid_ptr%nests(kid)%ptr%stop_subtime = &
+                  domain_get_current_time(grid)
+                CALL integrate ( grid_ptr%nests(kid)%ptr ) 
+                CALL wrf_debug( 100 , 'module_integrate: back from recursive call to integrate ' )
+                CALL wrf_debug( 100 , 'module_integrate: calling med_nest_feedback ' )
+                CALL med_nest_feedback ( grid_ptr , grid_ptr%nests(kid)%ptr , config_flags )
+                CALL wrf_debug( 100 , 'module_integrate: back from med_nest_feedback ' )
+#ifdef MOVE_NESTS
+                IF ( .NOT. domain_clockisstoptime( head_grid ) ) THEN
+                  CALL med_nest_move ( grid_ptr , grid_ptr%nests(kid)%ptr )
+                ENDIF
+#endif
+              END IF
+            END DO
+            grid_ptr => grid_ptr%sibling
+         END DO
+         CALL set_current_grid_ptr( grid )
+         !  Report on the timing for a single time step.
+         IF ( wrf_dm_on_monitor() ) THEN
+! begin KLUDGE
+! ia32 pgi 6.0-2 and prescribed moving nest: the returned date string message2 is
+! corrupt after the first specified move UNLESS the string is initialized to all 
+! spaces - REMOVE THIS INIT OF MESSAGE2 WHEN POSSIBLE 
+! 2005 10 28
+            message2='                                                                ' // &
+                     '                                                                ' // &
+                     '                                                                ' // &
+                     '                                                                '
+! end KLUDGE
+           CALL domain_clock_get ( grid, current_timestr=message2 )
+           WRITE ( message , FMT = '("main: time ",A," on domain ",I3)' ) TRIM(message2), grid%id
+           CALL end_timing ( TRIM(message) )
+         END IF
+         CALL med_endup_step ( grid , config_flags )
+      END DO
+      ! Avoid double writes on nests if this is not really the last time;
+      ! Do check for write if the parent domain is ending.
+      IF ( grid%id .EQ. 1 ) THEN               ! head_grid
+        CALL med_last_solve_io ( grid , config_flags )
+      ELSE
+
+! zip up the tree and see if any ancestor is at its stop time
+        
+        should_do_last_io = domain_clockisstoptime( head_grid )
+        grid_ptr => grid 
+        DO WHILE ( grid_ptr%id .NE. 1 )
+           IF ( domain_clockisstoptime( grid_ptr ) ) should_do_last_io = .TRUE. 
+           grid_ptr => grid_ptr%parents(1)%ptr
+        ENDDO
+        IF ( should_do_last_io ) THEN 
+           CALL med_last_solve_io ( grid , config_flags )
+        ENDIF
+      ENDIF
+   END IF
+
+END SUBROUTINE integrate
+
+END MODULE module_integrate
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_internal_header_util.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_internal_header_util.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_internal_header_util.F	(revision 2744)
@@ -0,0 +1,1081 @@
+MODULE module_internal_header_util
+
+!<DESCRIPTION>
+!<PRE>
+! Subroutines defined in this module are used to generate (put together) and get (take apart) 
+! data headers stored in the form of integer vectors.
+! 
+! Data headers serve two purposes:  
+!   - Provide a package-independent metadata storage and retrieval mechanism 
+!     for I/O packages that do not support native metadata.  
+!   - Provide a mechanism for communicating I/O commands from compute 
+!     tasks to quilt tasks when I/O quilt servers are enabled.  
+! 
+! Within a data header, character strings are stored one character per integer.  
+! The number of characters is stored immediately before the first character of 
+! each string.
+!
+! In an I/O package that does not support native metadata, routines 
+! int_gen_*_header() are called to pack information into data headers that 
+! are then written to files.  Routines int_get_*_header() are called to 
+! extract information from a data headers after they have been read from a 
+! file.  
+!
+! When I/O quilt server tasks are used, routines int_gen_*_header() 
+! are called by compute tasks to pack information into data headers 
+! (commands) that are then sent to the I/O quilt servers.  Routines 
+! int_get_*_header() are called by I/O quilt servers to extract 
+! information from data headers (commands) received from the compute 
+! tasks.  
+!
+!</PRE>
+!</DESCRIPTION>
+
+INTERFACE int_get_ti_header
+   MODULE PROCEDURE int_get_ti_header_integer, int_get_ti_header_real
+END INTERFACE
+INTERFACE int_gen_ti_header
+   MODULE PROCEDURE int_gen_ti_header_integer, int_gen_ti_header_real
+END INTERFACE
+INTERFACE int_get_td_header
+   MODULE PROCEDURE int_get_td_header_integer, int_get_td_header_real
+END INTERFACE
+INTERFACE int_gen_td_header
+   MODULE PROCEDURE int_gen_td_header_integer, int_gen_td_header_real
+END INTERFACE
+
+PRIVATE :: int_pack_string, int_unpack_string
+
+CONTAINS
+!!!!!!!!!!!!! header manipulation routines !!!!!!!!!!!!!!!
+
+INTEGER FUNCTION get_hdr_tag( hdrbuf )
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: hdrbuf(*)
+  get_hdr_tag = hdrbuf(2)
+  RETURN
+END FUNCTION get_hdr_tag
+
+INTEGER FUNCTION get_hdr_rec_size( hdrbuf )
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: hdrbuf(*)
+  get_hdr_rec_size = hdrbuf(1)
+  RETURN
+END FUNCTION get_hdr_rec_size
+
+SUBROUTINE int_gen_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize, &
+                                        DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, &
+                                        DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                        DomainStart , DomainEnd ,                                    &
+                                        MemoryStart , MemoryEnd ,                                    &
+                                        PatchStart , PatchEnd )
+!<DESCRIPTION>
+!<PRE>
+! Items and their starting locations within a "write field" data header.  
+! Assume that the data header is stored in integer vector "hdrbuf":  
+!  hdrbuf(1) = hdrbufsize
+!  hdrbuf(2) = headerTag
+!  hdrbuf(3) = ftypesize
+!  hdrbuf(4) = DataHandle
+!  hdrbuf(5) = LEN(TRIM(DateStr))
+!  hdrbuf(6:5+n1) = DateStr                                          ! n1 = LEN(TRIM(DateStr)) + 1
+!  hdrbuf(6+n1) = LEN(TRIM(VarName))
+!  hdrbuf(7+n1:6+n1+n2) = VarName                                    ! n2 = LEN(TRIM(VarName)) + 1
+!  hdrbuf(7+n1+n2) = FieldType
+!  hdrbuf(8+n1+n2) = LEN(TRIM(MemoryOrder))
+!  hdrbuf(9+n1+n2:8+n1+n2+n3) = MemoryOrder                          ! n3 = LEN(TRIM(MemoryOrder)) + 1
+!  hdrbuf(9+n1+n2+n3) = LEN(TRIM(Stagger))
+!  hdrbuf(9+n1+n2+n3:8+n1+n2+n3+n4) = Stagger                        ! n4 = LEN(TRIM(Stagger)) + 1
+!  hdrbuf(9+n1+n2+n3+n4) = LEN(TRIM(DimNames(1)))
+!  hdrbuf(9+n1+n2+n3+n4:8+n1+n2+n3+n4+n5) = DimNames(1)              ! n5 = LEN(TRIM(DimNames(1))) + 1
+!  hdrbuf(9+n1+n2+n3+n4+n5) = LEN(TRIM(DimNames(2)))
+!  hdrbuf(9+n1+n2+n3+n4+n5:8+n1+n2+n3+n4+n5+n6) = DimNames(2)        ! n6 = LEN(TRIM(DimNames(2))) + 1
+!  hdrbuf(9+n1+n2+n3+n4+n5+n6) = LEN(TRIM(DimNames(3)))
+!  hdrbuf(9+n1+n2+n3+n4+n5+n6:8+n1+n2+n3+n4+n5+n6+n7) = DimNames(3)  ! n7 = LEN(TRIM(DimNames(3))) + 1
+!  hdrbuf(9+n1+n2+n3+n4+n5+n6+n7) = DomainStart(1)
+!  hdrbuf(10+n1+n2+n3+n4+n5+n6+n7) = DomainStart(2)
+!  hdrbuf(11+n1+n2+n3+n4+n5+n6+n7) = DomainStart(3)
+!  hdrbuf(12+n1+n2+n3+n4+n5+n6+n7) = DomainEnd(1)
+!  hdrbuf(13+n1+n2+n3+n4+n5+n6+n7) = DomainEnd(2)
+!  hdrbuf(14+n1+n2+n3+n4+n5+n6+n7) = DomainEnd(3)
+!  hdrbuf(15+n1+n2+n3+n4+n5+n6+n7) = PatchStart(1)
+!  hdrbuf(16+n1+n2+n3+n4+n5+n6+n7) = PatchStart(2)
+!  hdrbuf(17+n1+n2+n3+n4+n5+n6+n7) = PatchStart(3)
+!  hdrbuf(18+n1+n2+n3+n4+n5+n6+n7) = PatchEnd(1)
+!  hdrbuf(19+n1+n2+n3+n4+n5+n6+n7) = PatchEnd(2)
+!  hdrbuf(20+n1+n2+n3+n4+n5+n6+n7) = PatchEnd(3)
+!  hdrbuf(21+n1+n2+n3+n4+n5+n6+n7) = DomainDesc
+!
+! Further details for some items:  
+!  hdrbufsize:  Size of this data header in bytes.  
+!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
+!               header this is.  For a "write field" header it must be set to 
+!               int_field.  See file intio_tags.h for a complete list of 
+!               these tags.  
+!  ftypesize:   Size of field data type in bytes.  
+!  DataHandle:  Descriptor for an open data set.  
+!  DomainDesc:  Additional argument that may be used by some packages as a 
+!               package-specific domain descriptor.  
+!  Other items are described in detail in the "WRF I/O and Model Coupling API 
+!  Specification".  
+!
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER,       INTENT(INOUT)  ::  hdrbuf(*)
+  INTEGER,       INTENT(INOUT)  ::  hdrbufsize
+  INTEGER,       INTENT(INOUT)  ::  itypesize, ftypesize
+  INTEGER ,      INTENT(IN)     :: DataHandle
+  CHARACTER*(*), INTENT(IN)  :: DateStr
+  CHARACTER*(*), INTENT(IN)  :: VarName
+  REAL, DIMENSION(*)            :: Dummy
+  INTEGER                       ,intent(in)    :: FieldType
+  INTEGER                       ,intent(inout) :: Comm
+  INTEGER                       ,intent(inout) :: IOComm
+  INTEGER                       ,intent(in)    :: DomainDesc
+  CHARACTER*(*)                 ,intent(in)    :: MemoryOrder
+  CHARACTER*(*)                 ,intent(in)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,intent(in)    :: DimNames
+  INTEGER ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+
+  INTEGER i, n
+
+
+  hdrbuf(1) = 0 ! deferred -- this will be length of header
+  hdrbuf(2) = int_field
+  hdrbuf(3) = ftypesize
+
+  i = 4
+  hdrbuf(i) = DataHandle      ; i = i+1
+  call int_pack_string( DateStr, hdrbuf(i), n ) ; i = i + n
+  call int_pack_string( VarName, hdrbuf(i), n ) ; i = i + n
+  hdrbuf(i) = FieldType       ; i = i+1
+  call int_pack_string( MemoryOrder, hdrbuf(i), n ) ; i = i + n
+  call int_pack_string( Stagger,     hdrbuf(i), n ) ; i = i + n
+  call int_pack_string( DimNames(1), hdrbuf(i), n ) ; i = i + n
+  call int_pack_string( DimNames(2), hdrbuf(i), n ) ; i = i + n
+  call int_pack_string( DimNames(3), hdrbuf(i), n ) ; i = i + n
+  hdrbuf(i) = DomainStart(1)     ; i = i+1
+  hdrbuf(i) = DomainStart(2)     ; i = i+1
+  hdrbuf(i) = DomainStart(3)     ; i = i+1
+  hdrbuf(i) = DomainEnd(1)       ; i = i+1
+  hdrbuf(i) = DomainEnd(2)       ; i = i+1
+  hdrbuf(i) = DomainEnd(3)       ; i = i+1
+  hdrbuf(i) = PatchStart(1)     ; i = i+1
+  hdrbuf(i) = PatchStart(2)     ; i = i+1
+  hdrbuf(i) = PatchStart(3)     ; i = i+1
+  hdrbuf(i) = PatchEnd(1)       ; i = i+1
+  hdrbuf(i) = PatchEnd(2)       ; i = i+1
+  hdrbuf(i) = PatchEnd(3)       ; i = i+1
+  hdrbuf(i) = DomainDesc        ; i = i+1
+
+  hdrbufsize = (i-1) * itypesize  ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+
+  RETURN
+END SUBROUTINE int_gen_write_field_header
+
+
+SUBROUTINE int_get_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize, &
+                                        DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm,  &
+                                        DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                        DomainStart , DomainEnd ,                                    &
+                                        MemoryStart , MemoryEnd ,                                    &
+                                        PatchStart , PatchEnd )
+!<DESCRIPTION>
+!<PRE>
+! See documentation block in int_gen_write_field_header() for 
+! a description of a "write field" header.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER,       INTENT(INOUT)  ::  hdrbuf(*)
+  INTEGER,       INTENT(OUT)    ::  hdrbufsize
+  INTEGER,       INTENT(INOUT)  ::  itypesize, ftypesize
+  INTEGER ,      INTENT(OUT)    :: DataHandle
+  CHARACTER*(*), INTENT(INOUT)  :: DateStr
+  CHARACTER*(*), INTENT(INOUT)  :: VarName
+  REAL, DIMENSION(*)            :: Dummy
+  INTEGER                                       :: FieldType
+  INTEGER                                       :: Comm
+  INTEGER                                       :: IOComm
+  INTEGER                                       :: DomainDesc
+  CHARACTER*(*)                                 :: MemoryOrder
+  CHARACTER*(*)                                 :: Stagger
+  CHARACTER*(*) , dimension (*)                 :: DimNames
+  INTEGER ,dimension(*)                         :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)                         :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)                         :: PatchStart,  PatchEnd
+!Local
+  CHARACTER*132 mess
+  INTEGER i, n
+
+  hdrbufsize = hdrbuf(1)
+  IF ( hdrbuf(2) .NE. int_field ) THEN
+    write(mess,*)'int_get_write_field_header: hdrbuf(2) ne int_field ',hdrbuf(2),int_field
+    CALL wrf_error_fatal ( mess )
+  ENDIF
+  ftypesize = hdrbuf(3)
+
+   i = 4
+   DataHandle = hdrbuf(i)     ; i = i+1
+  call int_unpack_string( DateStr, hdrbuf(i), n )     ; i = i+n
+  call int_unpack_string( VarName, hdrbuf(i), n )     ; i = i+n
+   FieldType = hdrbuf(i)      ; i = i+1
+  call int_unpack_string( MemoryOrder, hdrbuf(i), n ) ; i = i+n
+  call int_unpack_string( Stagger, hdrbuf(i), n )     ; i = i+n
+  call int_unpack_string( DimNames(1), hdrbuf(i), n ) ; i = i+n
+  call int_unpack_string( DimNames(2), hdrbuf(i), n ) ; i = i+n
+  call int_unpack_string( DimNames(3), hdrbuf(i), n ) ; i = i+n
+   DomainStart(1) = hdrbuf(i)    ; i = i+1
+   DomainStart(2) = hdrbuf(i)    ; i = i+1
+   DomainStart(3) = hdrbuf(i)    ; i = i+1
+   DomainEnd(1) = hdrbuf(i)       ; i = i+1
+   DomainEnd(2) = hdrbuf(i)       ; i = i+1
+   DomainEnd(3) = hdrbuf(i)       ; i = i+1
+   PatchStart(1) = hdrbuf(i)     ; i = i+1
+   PatchStart(2) = hdrbuf(i)     ; i = i+1
+   PatchStart(3) = hdrbuf(i)     ; i = i+1
+   PatchEnd(1) = hdrbuf(i)       ; i = i+1
+   PatchEnd(2) = hdrbuf(i)       ; i = i+1
+   PatchEnd(3) = hdrbuf(i)       ; i = i+1
+   DomainDesc = hdrbuf(i)       ; i = i+1
+
+  RETURN
+END SUBROUTINE int_get_write_field_header
+
+!!!!!!!!
+
+!generate open for read header
+SUBROUTINE int_gen_ofr_header( hdrbuf, hdrbufsize, itypesize, &
+                                FileName, SysDepInfo, DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! Items and their starting locations within a "open for read" data header.  
+! Assume that the data header is stored in integer vector "hdrbuf":  
+!  hdrbuf(1) = hdrbufsize
+!  hdrbuf(2) = headerTag
+!  hdrbuf(3) = DataHandle
+!  hdrbuf(4) = LEN(TRIM(FileName))
+!  hdrbuf(5:4+n1) = FileName             ! n1 = LEN(TRIM(FileName)) + 1
+!  hdrbuf(5+n1) = LEN(TRIM(SysDepInfo))
+!  hdrbuf(6+n1:5+n1+n2) = SysDepInfo     ! n2 = LEN(TRIM(SysDepInfo)) + 1
+!
+! Further details for some items:  
+!  hdrbufsize:  Size of this data header in bytes.  
+!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
+!               header this is.  For an "open for read" header it must be set to 
+!               int_open_for_read.  See file intio_tags.h for a complete list of 
+!               these tags.  
+!  DataHandle:  Descriptor for an open data set.  
+!  FileName:    File name.  
+!  SysDepInfo:  System dependent information used for optional additional 
+!               I/O control information.  
+!  Other items are described in detail in the "WRF I/O and Model Coupling API 
+!  Specification".  
+!
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER,       INTENT(INOUT) ::  hdrbuf(*)
+  INTEGER,       INTENT(OUT)   ::  hdrbufsize
+  INTEGER,       INTENT(INOUT) ::  itypesize
+  INTEGER ,      INTENT(IN)    :: DataHandle
+  CHARACTER*(*), INTENT(INOUT) :: FileName
+  CHARACTER*(*), INTENT(INOUT) :: SysDepInfo
+!Local
+  INTEGER i, n, i1
+!
+  hdrbuf(1) = 0  !deferred
+  hdrbuf(2) = int_open_for_read
+  i = 3
+  hdrbuf(i) = DataHandle     ; i = i+1
+
+  call int_pack_string( TRIM(FileName), hdrbuf(i), n )   ; i = i + n
+  call int_pack_string( TRIM(SysDepInfo), hdrbuf(i), n ) ; i = i + n
+  hdrbufsize = (i-1) * itypesize  ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+  RETURN
+END SUBROUTINE int_gen_ofr_header
+
+!get open for read header
+SUBROUTINE int_get_ofr_header( hdrbuf, hdrbufsize, itypesize, &
+                                FileName, SysDepInfo, DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! See documentation block in int_gen_ofr_header() for 
+! a description of a "open for read" header.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER,       INTENT(INOUT) ::  hdrbuf(*)
+  INTEGER,       INTENT(OUT)   ::  hdrbufsize
+  INTEGER,       INTENT(INOUT) ::  itypesize
+  INTEGER ,      INTENT(OUT)   :: DataHandle
+  CHARACTER*(*), INTENT(INOUT) :: FileName
+  CHARACTER*(*), INTENT(INOUT) :: SysDepInfo
+!Local
+  INTEGER i, n
+!
+  hdrbufsize = hdrbuf(1)
+!  IF ( hdrbuf(2) .NE. int_open_for_read ) THEN
+!    CALL wrf_error_fatal ( "int_get_ofr_header: hdrbuf ne int_open_for_read")
+!  ENDIF
+  i = 3
+  DataHandle = hdrbuf(i)    ; i = i+1
+  call int_unpack_string( FileName, hdrbuf(i), n ) ; i = i+n
+  call int_unpack_string( SysDepInfo, hdrbuf(i), n ) ; i = i+n
+  RETURN
+END SUBROUTINE int_get_ofr_header
+
+!!!!!!!!
+
+!generate open for write begin header
+SUBROUTINE int_gen_ofwb_header( hdrbuf, hdrbufsize, itypesize, &
+                                FileName, SysDepInfo, io_form, DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! Items and their starting locations within a "open for write begin" data 
+! header.  Assume that the data header is stored in integer vector "hdrbuf":  
+!  hdrbuf(1) = hdrbufsize
+!  hdrbuf(2) = headerTag
+!  hdrbuf(3) = DataHandle
+!  hdrbuf(4) = io_form
+!  hdrbuf(5) = LEN(TRIM(FileName))
+!  hdrbuf(6:5+n1) = FileName             ! n1 = LEN(TRIM(FileName)) + 1
+!  hdrbuf(6+n1) = LEN(TRIM(SysDepInfo))
+!  hdrbuf(7+n1:6+n1+n2) = SysDepInfo     ! n2 = LEN(TRIM(SysDepInfo)) + 1
+!
+! Further details for some items:  
+!  hdrbufsize:  Size of this data header in bytes.  
+!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
+!               header this is.  For an "open for write begin" header it must be set to 
+!               int_open_for_write_begin.  See file intio_tags.h for a complete list of 
+!               these tags.  
+!  DataHandle:  Descriptor for an open data set.  
+!  io_form:     I/O format for this file (netCDF, etc.).  
+!  FileName:    File name.  
+!  SysDepInfo:  System dependent information used for optional additional 
+!               I/O control information.  
+!  Other items are described in detail in the "WRF I/O and Model Coupling API 
+!  Specification".  
+!
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER,       INTENT(INOUT) :: hdrbuf(*)
+  INTEGER,       INTENT(OUT)   :: hdrbufsize
+  INTEGER,       INTENT(INOUT) :: itypesize
+  INTEGER ,      INTENT(IN)    :: io_form
+  INTEGER ,      INTENT(IN)    :: DataHandle
+  CHARACTER*(*), INTENT(INOUT) :: FileName
+  CHARACTER*(*), INTENT(INOUT) :: SysDepInfo
+!Local
+  INTEGER i, n, j
+!
+  hdrbuf(1) = 0  !deferred
+  hdrbuf(2) = int_open_for_write_begin
+  i = 3
+  hdrbuf(i) = DataHandle     ; i = i+1
+  hdrbuf(i) = io_form        ; i = i+1
+!j = i
+  call int_pack_string( FileName, hdrbuf(i), n )   ; i = i + n
+!write(0,*)'int_gen_ofwb_header FileName ',TRIM(FileName),hdrbuf(j),n
+!j = i
+  call int_pack_string( SysDepInfo, hdrbuf(i), n ) ; i = i + n
+!write(0,*)'int_gen_ofwb_header SysDepInfo ',TRIM(SysDepInfo),hdrbuf(j),n
+  hdrbufsize = (i-1) * itypesize  ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+!write(0,*)'int_gen_ofwb_header hdrbuf(1) ',hdrbuf(1)
+  RETURN
+END SUBROUTINE int_gen_ofwb_header
+
+!get open for write begin header
+SUBROUTINE int_get_ofwb_header( hdrbuf, hdrbufsize, itypesize, &
+                                FileName, SysDepInfo, io_form, DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! See documentation block in int_gen_ofwb_header() for 
+! a description of a "open for write begin" header.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER,       INTENT(INOUT)  :: hdrbuf(*)
+  INTEGER,       INTENT(OUT)    :: hdrbufsize
+  INTEGER,       INTENT(INOUT)  :: itypesize
+  INTEGER ,      INTENT(OUT)    :: DataHandle
+  INTEGER ,      INTENT(OUT)    :: io_form
+  CHARACTER*(*), INTENT (INOUT) :: FileName
+  CHARACTER*(*), INTENT (INOUT) :: SysDepInfo
+!Local
+  INTEGER i, n, j
+!
+  hdrbufsize = hdrbuf(1)
+!write(0,*)' int_get_ofwb_header next rec start ',hdrbuf(hdrbufsize+1)
+!  IF ( hdrbuf(2) .NE. int_open_for_write_begin ) THEN
+!    CALL wrf_error_fatal ( "int_get_ofwb_header: hdrbuf ne int_open_for_write_begin") 
+!  ENDIF
+  i = 3
+  DataHandle = hdrbuf(i)    ; i = i+1
+!write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1)
+  io_form    = hdrbuf(i)    ; i = i+1
+!write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1)
+
+!j = i
+  call int_unpack_string( FileName, hdrbuf(i), n ) ; i = i+n
+!write(0,*)'int_get_ofwb_header FileName ',TRIM(FileName),hdrbuf(j),n
+!write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1)
+!j = i
+  call int_unpack_string( SysDepInfo, hdrbuf(i), n ) ; i = i+n
+!write(0,*)'int_get_ofwb_header SysDepInfo ',TRIM(SysDepInfo),hdrbuf(j),n
+!write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1)
+!write(0,*)'int_get_ofwb_header hdrbufsize ',hdrbufsize
+  RETURN
+END SUBROUTINE int_get_ofwb_header
+
+!!!!!!!!!!
+
+SUBROUTINE int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, &
+                                DataHandle , code )
+!<DESCRIPTION>
+!<PRE>
+! Items and their starting locations within a "generic handle" data header.  
+! Several types of data headers contain only a DataHandle and a header tag 
+! (I/O command).  This routine is used for all of them.  Assume that 
+! the data header is stored in integer vector "hdrbuf":  
+!  hdrbuf(1) = hdrbufsize
+!  hdrbuf(2) = headerTag
+!  hdrbuf(3) = DataHandle
+!
+! Further details for some items:  
+!  hdrbufsize:  Size of this data header in bytes.  
+!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
+!               header this is.  For a "generic handle" header there are 
+!               several possible values.  In this routine, dummy argument 
+!               "code" is used as headerTag.  
+!  DataHandle:  Descriptor for an open data set.  
+!
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT) ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)   ::  hdrbufsize
+  INTEGER, INTENT(INOUT) ::  itypesize
+  INTEGER ,INTENT(IN)    :: DataHandle, code
+!Local
+  INTEGER i
+!
+  hdrbuf(1) = 0  !deferred
+  hdrbuf(2) = code
+  i = 3
+  hdrbuf(i) = DataHandle     ; i = i+1
+  hdrbufsize = (i-1) * itypesize  ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+  RETURN
+END SUBROUTINE int_gen_handle_header
+
+SUBROUTINE int_get_handle_header( hdrbuf, hdrbufsize, itypesize, &
+                                DataHandle , code )
+!<DESCRIPTION>
+!<PRE>
+! See documentation block in int_gen_handle_header() for 
+! a description of a "generic handle" header.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT) ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)   ::  hdrbufsize
+  INTEGER, INTENT(INOUT) ::  itypesize
+  INTEGER ,INTENT(OUT)   :: DataHandle, code
+!Local
+  INTEGER i
+!
+  hdrbufsize = hdrbuf(1)
+  code       = hdrbuf(2)
+  i = 3
+  DataHandle = hdrbuf(i)    ; i = i+1
+  RETURN
+END SUBROUTINE int_get_handle_header
+
+!!!!!!!!!!!!
+
+SUBROUTINE int_gen_ti_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, &
+                                      DataHandle, Element, Data, Count, code )
+!<DESCRIPTION>
+!<PRE>
+! Items and their starting locations within a "time-independent integer" 
+! data header.  Assume that the data header is stored in integer vector 
+! "hdrbuf":  
+!  hdrbuf(1) = hdrbufsize
+!  hdrbuf(2) = headerTag
+!  hdrbuf(3) = DataHandle
+!  hdrbuf(4) = typesize
+!  hdrbuf(5) = Count
+!  hdrbuf(6:6+n1) = Data              ! n1 = (Count * typesize / itypesize) + 1
+!  hdrbuf(7+n1) = LEN(TRIM(Element))
+!  hdrbuf(8+n1:7+n1+n2) = Element     ! n2 = LEN(TRIM(Element)) + 1
+!
+! Further details for some items:  
+!  hdrbufsize:  Size of this data header in bytes.  
+!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
+!               header this is.  For an "time-independent integer" header it must be 
+!               set to int_dom_ti_integer.  See file intio_tags.h for a complete 
+!               list of these tags.  
+!  DataHandle:  Descriptor for an open data set.  
+!  typesize:    Size in bytes of each element of Data.  
+!  Count:       Number of elements in Data.  
+!  Data:        Data to write to file.  
+!  Element:     Name of the data.  
+!  Other items are described in detail in the "WRF I/O and Model Coupling API 
+!  Specification".  
+!
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize, typesize
+  CHARACTER*(*), INTENT(INOUT) ::  Element
+  INTEGER, INTENT(IN)          ::  Data(*)
+  INTEGER, INTENT(IN)          ::  DataHandle, Count, code
+!Local
+  INTEGER i, n
+!
+  CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, &
+                             DataHandle, Data, Count, code )
+  i = hdrbufsize/itypesize + 1 ;
+!write(0,*)'int_gen_ti_header_integer ',TRIM(Element)
+  CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
+  hdrbufsize = n * itypesize + hdrbufsize ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+  RETURN
+END SUBROUTINE int_gen_ti_header_integer
+
+SUBROUTINE int_gen_ti_header_real( hdrbuf, hdrbufsize, itypesize, typesize, &
+                                   DataHandle, Element, Data, Count, code )
+!<DESCRIPTION>
+!<PRE>
+! Same as int_gen_ti_header_integer except that Data has type REAL.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize, typesize
+  CHARACTER*(*), INTENT(INOUT) ::  Element
+  REAL, INTENT(IN)             ::  Data(*)
+  INTEGER, INTENT(IN)          ::  DataHandle, Count, code
+!Local
+  INTEGER i, n
+!
+  CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, &
+                             DataHandle, Data, Count, code )
+  i = hdrbufsize/itypesize + 1 ;
+!write(0,*)'int_gen_ti_header_real ',TRIM(Element)
+  CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
+  hdrbufsize = n * itypesize + hdrbufsize ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+  RETURN
+END SUBROUTINE int_gen_ti_header_real
+
+SUBROUTINE int_get_ti_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, &
+                              DataHandle, Element, Data, Count, code )
+!<DESCRIPTION>
+!<PRE>
+! Same as int_gen_ti_header_integer except that Data is read from 
+! the file.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize, typesize
+  CHARACTER*(*), INTENT(INOUT) ::  Element
+  INTEGER, INTENT(OUT)         ::  Data(*)
+  INTEGER, INTENT(OUT)         ::  DataHandle, Count, code
+!Local
+  INTEGER i, n
+!
+
+  CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
+                           DataHandle, Data, Count, code )
+  i = 1 
+  CALL int_unpack_string ( Element, hdrbuf( n/itypesize + 1 ), n ) ;
+!write(0,*)'int_get_ti_header_integer ',TRIM(Element), Data(1)
+  hdrbufsize = hdrbuf(1)
+  RETURN
+END SUBROUTINE int_get_ti_header_integer
+
+SUBROUTINE int_get_ti_header_real( hdrbuf, hdrbufsize, itypesize, typesize, &
+                              DataHandle, Element, Data, Count, code )
+!<DESCRIPTION>
+!<PRE>
+! Same as int_gen_ti_header_real except that Data is read from 
+! the file.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize, typesize
+  CHARACTER*(*), INTENT(INOUT) ::  Element
+  REAL, INTENT(OUT)            ::  Data(*)
+  INTEGER, INTENT(OUT)         ::  DataHandle, Count, code
+!Local
+  INTEGER i, n
+!
+
+  CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
+                           DataHandle, Data, Count, code )
+  i = 1
+  CALL int_unpack_string ( Element, hdrbuf( n/itypesize + 1 ), n ) ;
+!write(0,*)'int_get_ti_header_real ',TRIM(Element), Data(1)
+  hdrbufsize = hdrbuf(1)
+  RETURN
+END SUBROUTINE int_get_ti_header_real
+
+!!!!!!!!!!!!
+
+SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                              DataHandle, Element, VarName, Data, code )
+!<DESCRIPTION>
+!<PRE>
+! Items and their starting locations within a "time-independent string" 
+! data header.  Assume that the data header is stored in integer vector 
+! "hdrbuf":  
+!  hdrbuf(1) = hdrbufsize
+!  hdrbuf(2) = headerTag
+!  hdrbuf(3) = DataHandle
+!  hdrbuf(4) = typesize
+!  hdrbuf(5) = LEN(TRIM(Element))
+!  hdrbuf(6:5+n1) = Element                ! n1 = LEN(TRIM(Element)) + 1
+!  hdrbuf(6+n1) = LEN(TRIM(Data))
+!  hdrbuf(7+n1:6+n1+n2) = Data             ! n2 = LEN(TRIM(Data)) + 1
+!  hdrbuf(7+n1+n2) = LEN(TRIM(VarName))
+!  hdrbuf(8+n1+n2:7+n1+n2+n3) = VarName    ! n3 = LEN(TRIM(VarName)) + 1
+!
+! Further details for some items:  
+!  hdrbufsize:  Size of this data header in bytes.  
+!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
+!               header this is.  For an "time-independent string" header it must be 
+!               set to int_dom_ti_char.  See file intio_tags.h for a complete 
+!               list of these tags.  
+!  DataHandle:  Descriptor for an open data set.  
+!  typesize:    1 (size in bytes of a single CHARACTER).  
+!  Element:     Name of the data.  
+!  Data:        Data to write to file.  
+!  VarName:     Variable name.  Used for *_<get|put>_var_ti_char but not for 
+!               *_<get|put>_dom_ti_char.  
+!  Other items are described in detail in the "WRF I/O and Model Coupling API 
+!  Specification".  
+!
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize
+  CHARACTER*(*), INTENT(IN)    :: Element, Data, VarName
+  INTEGER, INTENT(IN)          ::  DataHandle, code
+!Local
+  INTEGER                      ::  DummyData
+  INTEGER i, n, Count, DummyCount
+!
+  DummyCount = 0
+  CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, 1, &
+                             DataHandle, DummyData, DummyCount, code )
+  i = hdrbufsize/itypesize+1 ;
+  CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
+  CALL int_pack_string ( Data   , hdrbuf( i ), n ) ; i = i + n
+  CALL int_pack_string ( VarName   , hdrbuf( i ), n ) ; i = i + n
+  hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+  RETURN
+END SUBROUTINE int_gen_ti_header_char
+
+SUBROUTINE int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                              DataHandle, Element, VarName, Data, code )
+!<DESCRIPTION>
+!<PRE>
+! Same as int_gen_ti_header_char except that Data is read from 
+! the file.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize
+  CHARACTER*(*), INTENT(INOUT) ::  Element, Data, VarName
+  INTEGER, INTENT(OUT)         ::  DataHandle, code
+!Local
+  INTEGER i, n, DummyCount, typesize
+  CHARACTER * 132  dummyData
+!
+  CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
+                           DataHandle, dummyData, DummyCount, code )
+  i = n/itypesize+1 ;
+  CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n
+  CALL int_unpack_string ( Data   , hdrbuf( i ), n ) ; i = i + n
+  CALL int_unpack_string ( VarName  , hdrbuf( i ), n ) ; i = i + n
+  hdrbufsize = hdrbuf(1)
+
+  RETURN
+END SUBROUTINE int_get_ti_header_char
+
+
+!!!!!!!!!!!!
+
+SUBROUTINE int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize, &
+                              DataHandle, DateStr, Element, Data, code )
+!<DESCRIPTION>
+!<PRE>
+! Items and their starting locations within a "time-dependent string" 
+! data header.  Assume that the data header is stored in integer vector 
+! "hdrbuf":  
+!  hdrbuf(1) = hdrbufsize
+!  hdrbuf(2) = headerTag
+!  hdrbuf(3) = DataHandle
+!  hdrbuf(4) = typesize
+!  hdrbuf(5) = LEN(TRIM(Element))
+!  hdrbuf(6:5+n1) = Element            ! n1 = LEN(TRIM(Element)) + 1
+!  hdrbuf(6+n1) = LEN(TRIM(DateStr))
+!  hdrbuf(7+n1:6+n1+n2) = DateStr      ! n2 = LEN(TRIM(DateStr)) + 1
+!  hdrbuf(7+n1+n2) = LEN(TRIM(Data))
+!  hdrbuf(8+n1+n2:7+n1+n2+n3) = Data   ! n3 = LEN(TRIM(Data)) + 1
+!
+! Further details for some items:  
+!  hdrbufsize:  Size of this data header in bytes.  
+!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
+!               header this is.  For an "time-dependent string" header it must be 
+!               set to int_dom_td_char.  See file intio_tags.h for a complete 
+!               list of these tags.  
+!  DataHandle:  Descriptor for an open data set.  
+!  typesize:    1 (size in bytes of a single CHARACTER).  
+!  Element:     Name of the data.  
+!  Data:        Data to write to file.  
+!  Other items are described in detail in the "WRF I/O and Model Coupling API 
+!  Specification".  
+!
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize
+  CHARACTER*(*), INTENT(INOUT) ::  DateStr, Element, Data
+  INTEGER, INTENT(IN)          ::  DataHandle, code
+!Local
+  INTEGER i, n, DummyCount, DummyData
+!
+  DummyCount = 0
+
+  CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, 1, &
+                           DataHandle, DummyData, DummyCount, code )
+  i = hdrbufsize/itypesize + 1 ;
+  CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
+  CALL int_pack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n
+  CALL int_pack_string ( Data   , hdrbuf( i ), n ) ; i = i + n
+  hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+  RETURN
+END SUBROUTINE int_gen_td_header_char
+
+SUBROUTINE int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, &
+                              DataHandle, DateStr, Element, Data, code )
+!<DESCRIPTION>
+!<PRE>
+! Same as int_gen_td_header_char except that Data is read from 
+! the file.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize
+  CHARACTER*(*), INTENT(INOUT) ::  DateStr, Element, Data
+  INTEGER, INTENT(OUT)         ::  DataHandle, code
+!Local
+  INTEGER i, n, Count, typesize
+!
+
+  CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
+                           DataHandle, Data, Count, code )
+  i = n/itypesize + 1 ;
+  CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n ;
+  CALL int_unpack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n ;
+  CALL int_unpack_string ( Data   , hdrbuf( i ), n ) ; i = i + n ;
+  hdrbufsize = hdrbuf(1)
+  RETURN
+END SUBROUTINE int_get_td_header_char
+
+SUBROUTINE int_gen_td_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, &
+                                      DataHandle, DateStr, Element, Data, Count, code )
+!<DESCRIPTION>
+!<PRE>
+! Items and their starting locations within a "time-dependent integer" 
+! data header.  Assume that the data header is stored in integer vector 
+! "hdrbuf":  
+!  hdrbuf(1) = hdrbufsize
+!  hdrbuf(2) = headerTag
+!  hdrbuf(3) = DataHandle
+!  hdrbuf(4) = typesize
+!  hdrbuf(5) = Count
+!  hdrbuf(6:6+n1) = Data              ! n1 = (Count * typesize / itypesize) + 1
+!  hdrbuf(7+n1) = LEN(TRIM(DateStr))
+!  hdrbuf(8+n1:7+n1+n2) = DateStr      ! n2 = LEN(TRIM(DateStr)) + 1
+!  hdrbuf(8+n1+n2) = LEN(TRIM(Element))
+!  hdrbuf(9+n1+n2:8+n1+n2+n3) = Element   ! n3 = LEN(TRIM(Element)) + 1
+!
+! Further details for some items:  
+!  hdrbufsize:  Size of this data header in bytes.  
+!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
+!               header this is.  For an "time-dependent integer" header it must be 
+!               set to int_dom_td_integer.  See file intio_tags.h for a complete 
+!               list of these tags.  
+!  DataHandle:  Descriptor for an open data set.  
+!  typesize:    1 (size in bytes of a single CHARACTER).  
+!  Element:     Name of the data.  
+!  Count:       Number of elements in Data.  
+!  Data:        Data to write to file.  
+!  Other items are described in detail in the "WRF I/O and Model Coupling API 
+!  Specification".  
+!
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize, typesize
+  CHARACTER*(*), INTENT(INOUT) ::  DateStr, Element
+  INTEGER, INTENT(IN)          ::  Data(*)
+  INTEGER, INTENT(IN)          ::  DataHandle, Count, code
+!Local
+  INTEGER i, n
+!
+
+  CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, &
+                           DataHandle, Data, Count, code )
+  i = hdrbufsize/itypesize + 1 ;
+  CALL int_pack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n
+  CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
+  hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+  RETURN
+END SUBROUTINE int_gen_td_header_integer
+
+SUBROUTINE int_gen_td_header_real( hdrbuf, hdrbufsize, itypesize, typesize, &
+                                   DataHandle, DateStr, Element, Data, Count, code )
+!<DESCRIPTION>
+!<PRE>
+! Same as int_gen_td_header_integer except that Data has type REAL.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize, typesize
+  CHARACTER*(*), INTENT(INOUT) ::  DateStr, Element
+  REAL, INTENT(IN)             ::  Data(*)
+  INTEGER, INTENT(IN)          ::  DataHandle, Count, code
+!Local
+  INTEGER i, n
+!
+
+  CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, &
+                           DataHandle, Data, Count, code )
+  i = hdrbufsize/itypesize + 1 ;
+  CALL int_pack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n
+  CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
+  hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+  RETURN
+END SUBROUTINE int_gen_td_header_real
+
+SUBROUTINE int_get_td_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, &
+                              DataHandle, DateStr, Element, Data, Count, code )
+!<DESCRIPTION>
+!<PRE>
+! Same as int_gen_td_header_integer except that Data is read from 
+! the file.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize, typesize
+  CHARACTER*(*), INTENT(INOUT) ::  DateStr, Element
+  INTEGER, INTENT(OUT)         ::  Data(*)
+  INTEGER, INTENT(OUT)         ::  DataHandle, Count, code
+!Local
+  INTEGER i, n
+!
+
+  CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
+                           DataHandle, Data, Count, code )
+  i = n/itypesize + 1 ;
+  CALL int_unpack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n ;
+  CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n ;
+  hdrbufsize = hdrbuf(1)
+  RETURN
+END SUBROUTINE int_get_td_header_integer
+
+SUBROUTINE int_get_td_header_real( hdrbuf, hdrbufsize, itypesize, typesize, &
+                              DataHandle, DateStr, Element, Data, Count, code )
+!<DESCRIPTION>
+!<PRE>
+! Same as int_gen_td_header_real except that Data is read from 
+! the file.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT)       ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)         ::  hdrbufsize
+  INTEGER, INTENT(IN)          ::  itypesize, typesize
+  CHARACTER*(*), INTENT(INOUT) ::  DateStr, Element
+  REAL , INTENT(OUT)           ::  Data(*)
+  INTEGER, INTENT(OUT)         ::  DataHandle, Count, code
+!Local
+  INTEGER i, n
+!
+
+  CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
+                           DataHandle, Data, Count, code )
+  i = n/itypesize + 1 ;
+  CALL int_unpack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n ;
+  CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n ;
+  hdrbufsize = hdrbuf(1)
+  RETURN
+END SUBROUTINE int_get_td_header_real
+
+!!!!!!!!!!!!!!
+
+SUBROUTINE int_gen_noop_header ( hdrbuf, hdrbufsize, itypesize )
+  IMPLICIT NONE
+!<DESCRIPTION>
+!<PRE>
+! Items and their starting locations within a "no-operation" 
+! data header.  Assume that the data header is stored in integer vector 
+! "hdrbuf":  
+!  hdrbuf(1) = hdrbufsize
+!  hdrbuf(2) = headerTag
+!
+! Further details for some items:  
+!  hdrbufsize:  Size of this data header in bytes.  
+!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
+!               header this is.  For an "no-operation" header it must be 
+!               set to int_noop.  See file intio_tags.h for a complete 
+!               list of these tags.  
+!
+!</PRE>
+!</DESCRIPTION>
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT) ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)   ::  hdrbufsize
+  INTEGER, INTENT(INOUT) ::  itypesize
+!Local
+  INTEGER i
+!
+  hdrbuf(1) = 0  !deferred
+  hdrbuf(2) = int_noop
+  i = 3
+  hdrbufsize = (i-1) * itypesize  ! return the number in bytes
+  hdrbuf(1) = hdrbufsize
+  RETURN
+END SUBROUTINE int_gen_noop_header
+
+SUBROUTINE int_get_noop_header( hdrbuf, hdrbufsize, itypesize )
+!<DESCRIPTION>
+!<PRE>
+! See documentation block in int_gen_noop_header() for 
+! a description of a "no-operation" header.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INCLUDE 'intio_tags.h'
+  INTEGER, INTENT(INOUT) ::  hdrbuf(*)
+  INTEGER, INTENT(OUT)   ::  hdrbufsize
+  INTEGER, INTENT(INOUT) ::  itypesize
+!Local
+  INTEGER i
+!
+  hdrbufsize = hdrbuf(1)
+  IF ( hdrbuf(2) .NE. int_noop ) THEN
+    CALL wrf_error_fatal ( "int_get_noop_header: hdrbuf ne int_noop")
+  ENDIF
+  i = 3
+  RETURN
+END SUBROUTINE int_get_noop_header
+
+
+! first int is length of string to follow then string encodes as ints
+SUBROUTINE int_pack_string ( str, buf, n )
+  IMPLICIT NONE
+!<DESCRIPTION>
+!<PRE>
+! This routine is used to store a string as a sequence of integers.  
+! The first integer is the string length.  
+!</PRE>
+!</DESCRIPTION>
+  CHARACTER*(*), INTENT(IN)          :: str
+  INTEGER, INTENT(OUT)               :: n    ! on return, N is the number of ints stored in buf
+  INTEGER, INTENT(OUT), DIMENSION(*) :: buf
+!Local
+  INTEGER i
+!
+  n = 1
+  buf(n) = LEN(TRIM(str))
+  n = n+1
+  DO i = 1, LEN(TRIM(str))
+    buf(n) = ichar(str(i:i))
+    n = n+1
+  ENDDO
+  n = n - 1
+END SUBROUTINE int_pack_string
+
+SUBROUTINE int_unpack_string ( str, buf, n )
+  IMPLICIT NONE
+!<DESCRIPTION>
+!<PRE>
+! This routine is used to extract a string from a sequence of integers.  
+! The first integer is the string length.  
+!</PRE>
+!</DESCRIPTION>
+  CHARACTER*(*), INTENT(OUT)        :: str
+  INTEGER, INTENT(OUT)              :: n       ! on return, N is the number of ints copied from buf
+  INTEGER, INTENT(IN), DIMENSION(*) :: buf
+!Local
+  INTEGER i
+  INTEGER strlen
+
+  strlen = buf(1)
+  str = ""
+  DO i = 1, strlen
+    str(i:i) = char(buf(i+1))
+  ENDDO
+  n = strlen + 1
+END SUBROUTINE int_unpack_string
+
+END MODULE module_internal_header_util
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_io.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_io.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_io.F	(revision 2744)
@@ -0,0 +1,3937 @@
+!WRF:DRIVER_LAYER:IO
+!
+#define DEBUG_LVL 500
+
+MODULE module_io
+!<DESCRIPTION>
+!<PRE>
+! WRF-specific package-independent interface to package-dependent WRF-specific
+! I/O packages.
+!
+! These routines have the same names as those specified in the WRF I/O API 
+! except that:
+! - Routines defined in this file and called by users of this module have 
+!   the "wrf_" prefix.  
+! - Routines defined in the I/O packages and called from routines in this 
+!   file have the "ext_" prefix.  
+! - Routines called from routines in this file to initiate communication 
+!   with I/O quilt servers have the "wrf_quilt_" prefix.  
+!
+! See http://www.mmm.ucar.edu/wrf/WG2/software_2.0/IOAPI.doc for the latest 
+! version of the WRF I/O API.  This document includes detailed descriptions 
+! of subroutines and their arguments that are not duplicated in this file.  
+!
+! We wish to be able to link to different packages depending on whether
+! the I/O is restart, initial, history, or boundary.  
+!</PRE>
+!</DESCRIPTION>
+
+  USE module_configure
+
+  LOGICAL :: is_inited = .FALSE.
+  INTEGER, PARAMETER, PRIVATE :: MAX_WRF_IO_HANDLE = 1000
+  INTEGER :: wrf_io_handles(MAX_WRF_IO_HANDLE), how_opened(MAX_WRF_IO_HANDLE) 
+  LOGICAL :: for_output(MAX_WRF_IO_HANDLE), first_operation(MAX_WRF_IO_HANDLE)
+  INTEGER :: filtno = 0
+
+!<DESCRIPTION>
+!<PRE>
+!
+! include the file generated from md_calls.m4 using the m4 preprocessor
+! note that this file also includes the CONTAINS declaration for the module
+!
+!</PRE>
+!</DESCRIPTION>
+#include "md_calls.inc"
+
+!--- ioinit
+
+SUBROUTINE wrf_ioinit( Status )
+!<DESCRIPTION>
+!<PRE>
+! Initialize the WRF I/O system.
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(INOUT) :: Status
+!Local
+  CHARACTER(len=80) :: SysDepInfo
+  INTEGER :: ierr(10), minerr, maxerr
+!
+  Status = 0
+  ierr = 0
+  SysDepInfo = " "
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_ioinit' )
+  CALL init_io_handles    ! defined below
+#ifdef NETCDF
+  CALL ext_ncd_ioinit(   SysDepInfo, ierr(1) )
+#endif
+#ifdef INTIO
+  CALL ext_int_ioinit(   SysDepInfo, ierr(2) )
+#endif
+#ifdef PHDF5
+  CALL ext_phdf5_ioinit( SysDepInfo, ierr(3) )
+#endif
+#ifdef PNETCDF
+  CALL ext_pnc_ioinit( SysDepInfo, ierr(3) )
+#endif
+#ifdef MCELIO
+  CALL ext_mcel_ioinit(  SysDepInfo, ierr(4) )
+#endif
+#ifdef XXX
+  CALL ext_xxx_ioinit(   SysDepInfo, ierr(5) )
+#endif
+#ifdef YYY
+  CALL ext_yyy_ioinit(   SysDepInfo, ierr(6) )
+#endif
+#ifdef ZZZ
+  CALL ext_zzz_ioinit(   SysDepInfo, ierr(7) )
+#endif
+#ifdef ESMFIO
+  CALL ext_esmf_ioinit(  SysDepInfo, ierr(8) )
+#endif
+#ifdef GRIB1
+  CALL ext_gr1_ioinit(   SysDepInfo, ierr(9) )
+#endif
+#ifdef GRIB2
+  CALL ext_gr2_ioinit(   SysDepInfo, ierr(10) )
+#endif
+  minerr = MINVAL(ierr)
+  maxerr = MAXVAL(ierr)
+  IF ( minerr < 0 ) THEN
+    Status = minerr
+  ELSE IF ( maxerr > 0 ) THEN
+    Status = maxerr
+  ELSE
+    Status = 0
+  ENDIF
+END SUBROUTINE wrf_ioinit
+
+!--- ioexit
+
+SUBROUTINE wrf_ioexit( Status )
+!<DESCRIPTION>
+!<PRE>
+! Shut down the WRF I/O system.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(INOUT) :: Status
+!Local
+  LOGICAL, EXTERNAL :: use_output_servers
+  INTEGER :: ierr(11), minerr, maxerr
+!
+  Status = 0
+  ierr = 0
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_ioexit' )
+#ifdef NETCDF
+  CALL ext_ncd_ioexit(  ierr(1) )
+#endif
+#ifdef INTIO
+  CALL ext_int_ioexit(  ierr(2) )
+#endif
+#ifdef PHDF5
+  CALL ext_phdf5_ioexit(ierr(3) )
+#endif
+#ifdef PNETCDF
+  CALL ext_pnc_ioexit(ierr(3) )
+#endif
+#ifdef MCELIO
+  CALL ext_mcel_ioexit( ierr(4) )
+#endif
+#ifdef XXX
+  CALL ext_xxx_ioexit(  ierr(5) )
+#endif
+#ifdef YYY
+  CALL ext_yyy_ioexit(  ierr(6) )
+#endif
+#ifdef ZZZ
+  CALL ext_zzz_ioexit(  ierr(7) )
+#endif
+#ifdef ESMFIO
+  CALL ext_esmf_ioexit( ierr(8) )
+#endif
+#ifdef GRIB1
+  CALL ext_gr1_ioexit(  ierr(9) )
+#endif
+#ifdef GRIB2
+  CALL ext_gr2_ioexit(  ierr(10) )
+#endif
+ 
+  IF ( use_output_servers() ) CALL wrf_quilt_ioexit( ierr(11) )
+  minerr = MINVAL(ierr)
+  maxerr = MAXVAL(ierr)
+  IF ( minerr < 0 ) THEN
+    Status = minerr
+  ELSE IF ( maxerr > 0 ) THEN
+    Status = maxerr
+  ELSE
+    Status = 0
+  ENDIF
+END SUBROUTINE wrf_ioexit
+
+!--- open_for_write_begin
+
+SUBROUTINE wrf_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                     DataHandle , Status )
+!<DESCRIPTION>
+!<PRE>
+! Begin data definition ("training") phase for writing to WRF dataset 
+! FileName.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*), INTENT(INOUT):: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+ !Local 
+  CHARACTER*128               :: DataSet
+  INTEGER                     :: io_form
+  INTEGER                     :: Hndl
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+  CHARACTER*128     :: LocFilename   ! for appending the process ID if necessary
+  INTEGER           :: myproc
+  CHARACTER*128     :: mess
+  CHARACTER*1028    :: tstr
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_open_for_write_begin' )
+
+  CALL get_value_from_pairs ( "DATASET" , SysDepInfo , DataSet )
+
+  IF      ( DataSet .eq. 'RESTART' ) THEN
+    CALL nl_get_io_form_restart( 1, io_form )
+  ELSE IF ( DataSet .eq. 'INPUT' ) THEN
+    CALL nl_get_io_form_input( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT1' ) THEN
+    CALL nl_get_io_form_auxinput1( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT2' ) THEN
+    CALL nl_get_io_form_auxinput2( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT3' ) THEN
+    CALL nl_get_io_form_auxinput3( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT4' ) THEN
+    CALL nl_get_io_form_auxinput4( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT5' ) THEN
+    CALL nl_get_io_form_auxinput5( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT6' ) THEN
+    CALL nl_get_io_form_auxinput6( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT7' ) THEN
+    CALL nl_get_io_form_auxinput7( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT8' ) THEN
+    CALL nl_get_io_form_auxinput8( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT9' ) THEN
+    CALL nl_get_io_form_auxinput9( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT10' ) THEN
+    CALL nl_get_io_form_gfdda( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT11' ) THEN
+    CALL nl_get_io_form_auxinput11( 1, io_form )
+
+  ELSE IF ( DataSet .eq. 'HISTORY' ) THEN
+    CALL nl_get_io_form_history( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST1' ) THEN
+    CALL nl_get_io_form_auxhist1( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST2' ) THEN
+    CALL nl_get_io_form_auxhist2( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST3' ) THEN
+    CALL nl_get_io_form_auxhist3( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST4' ) THEN
+    CALL nl_get_io_form_auxhist4( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST5' ) THEN
+    CALL nl_get_io_form_auxhist5( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST6' ) THEN
+    CALL nl_get_io_form_auxhist6( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST7' ) THEN
+    CALL nl_get_io_form_auxhist7( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST8' ) THEN
+    CALL nl_get_io_form_auxhist8( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST9' ) THEN
+    CALL nl_get_io_form_auxhist9( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST10' ) THEN
+    CALL nl_get_io_form_auxhist10( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST11' ) THEN
+    CALL nl_get_io_form_auxhist11( 1, io_form )
+
+  ELSE IF ( DataSet .eq. 'BOUNDARY' ) THEN
+    CALL nl_get_io_form_boundary( 1, io_form )
+  ELSE  ! default if nothing is set in SysDepInfo; use history
+    CALL nl_get_io_form_history( 1, io_form )
+  ENDIF
+
+  Status = 0
+  Hndl = -1
+  IF ( multi_files( io_form ) .OR. .NOT. use_output_servers() ) THEN
+    SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+      CASE ( IO_NETCDF   )
+        IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+          IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+          ELSE
+            LocFilename = FileName
+          ENDIF
+          CALL ext_ncd_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
+                                              Hndl , Status )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef PHDF5
+      CASE (IO_PHDF5  )
+        CALL ext_phdf5_open_for_write_begin( FileName, Comm_compute, Comm_io, SysDepInfo, &
+                                            Hndl, Status)
+#endif
+#ifdef PNETCDF
+      CASE (IO_PNETCDF  )
+        CALL ext_pnc_open_for_write_begin( FileName, Comm_compute, Comm_io, SysDepInfo, &
+                                            Hndl, Status)
+#endif
+#ifdef XXX
+      CASE ( IO_XXX   )
+        CALL ext_xxx_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                            Hndl , Status )
+#endif
+#ifdef YYY
+      CASE ( IO_YYY   )
+        IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+          IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+          ELSE
+            LocFilename = FileName
+          ENDIF
+          CALL ext_yyy_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
+                                              Hndl , Status )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef ZZZ
+      CASE ( IO_ZZZ   )
+        CALL ext_zzz_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                            Hndl , Status )
+#endif
+#ifdef GRIB1
+      CASE ( IO_GRIB1   )
+        IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+          IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+          ELSE
+            LocFilename = FileName
+          ENDIF
+          CALL ext_gr1_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
+                                              Hndl , Status )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef GRIB2
+      CASE ( IO_GRIB2   )
+        IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+          IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+          ELSE
+            LocFilename = FileName
+          ENDIF
+          CALL ext_gr2_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
+                                              Hndl , Status )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef MCELIO
+      CASE ( IO_MCEL )
+        IF ( wrf_dm_on_monitor() ) THEN
+          tstr = TRIM(SysDepInfo) // ',' // 'LAT_R=XLAT,LON_R=XLONG,LANDMASK_I=LU_MASK'
+          CALL ext_mcel_open_for_write_begin ( FileName , Comm_compute, Comm_io, tstr, &
+                                               Hndl , Status )
+        ENDIF
+        CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+        CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef ESMFIO
+      CASE ( IO_ESMF )
+        CALL ext_esmf_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                             Hndl , Status )
+#endif
+#ifdef INTIO
+      CASE ( IO_INTIO   )
+        IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+          IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+          ELSE
+            LocFilename = FileName
+          ENDIF
+          CALL ext_int_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
+                                              Hndl , Status )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        ENDIF
+#endif
+      CASE DEFAULT
+        IF ( io_form .NE. 0 ) THEN
+          WRITE(mess,*)'Tried to open ',FileName,' writing: no valid io_form (',io_form,')'
+          CALL wrf_debug(1, mess)
+          Status = WRF_FILE_NOT_OPENED
+        ENDIF
+    END SELECT
+  ELSE IF ( use_output_servers() ) THEN
+    IF ( io_form .GT. 0 ) THEN
+      CALL wrf_quilt_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                            Hndl , io_form, Status )
+    ENDIF
+  ELSE
+    Status = 0
+  ENDIF
+  CALL add_new_handle( Hndl, io_form, .TRUE., DataHandle )
+END SUBROUTINE wrf_open_for_write_begin
+
+!--- open_for_write_commit
+
+SUBROUTINE wrf_open_for_write_commit( DataHandle , Status )
+!<DESCRIPTION>
+!<PRE>
+! This routine switches an internal flag to enable output for the data set 
+! referenced by DataHandle. The call to wrf_open_for_write_commit() must be 
+! paired with a call to wrf_open_for_write_begin().
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+ 
+  CHARACTER (128)             :: DataSet
+  INTEGER                     :: io_form
+  INTEGER                     :: Hndl
+  LOGICAL                     :: for_out
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+#include "wrf_io_flags.h"
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_open_for_write_commit' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  CALL set_first_operation( DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+            CALL ext_ncd_open_for_write_commit ( Hndl , Status )
+          ENDIF
+          IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef MCELIO
+        CASE ( IO_MCEL   )
+          IF ( wrf_dm_on_monitor() ) THEN
+            CALL ext_mcel_open_for_write_commit ( Hndl , Status )
+          ENDIF
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef ESMFIO
+        CASE ( IO_ESMF )
+          CALL ext_esmf_open_for_write_commit ( Hndl , Status )
+#endif
+#ifdef PHDF5
+      CASE ( IO_PHDF5  )
+        CALL ext_phdf5_open_for_write_commit ( Hndl , Status )
+#endif
+#ifdef PNETCDF
+      CASE ( IO_PNETCDF  )
+        CALL ext_pnc_open_for_write_commit ( Hndl , Status )
+#endif
+#ifdef XXX
+      CASE ( IO_XXX   )
+        CALL ext_xxx_open_for_write_commit ( Hndl , Status )
+#endif
+#ifdef YYY
+      CASE ( IO_YYY   )
+         IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+            CALL ext_yyy_open_for_write_commit ( Hndl , Status )
+         ENDIF
+         IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef ZZZ
+      CASE ( IO_ZZZ   )
+        CALL ext_zzz_open_for_write_commit ( Hndl , Status )
+#endif
+#ifdef GRIB1
+      CASE ( IO_GRIB1   )
+         IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+            CALL ext_gr1_open_for_write_commit ( Hndl , Status )
+         ENDIF
+         IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef GRIB2
+      CASE ( IO_GRIB2   )
+         IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+            CALL ext_gr2_open_for_write_commit ( Hndl , Status )
+         ENDIF
+         IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef INTIO
+      CASE ( IO_INTIO   )
+        CALL ext_int_open_for_write_commit ( Hndl , Status )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_open_for_write_commit ( Hndl , Status )
+    ELSE
+      Status = 0
+    ENDIF
+  ELSE
+    Status = 0
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_open_for_write_commit
+
+!--- open_for_read_begin
+
+SUBROUTINE wrf_open_for_read_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                     DataHandle , Status )
+!<DESCRIPTION>
+!<PRE>
+! Begin data definition ("training") phase for reading from WRF dataset 
+! FileName.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  
+  CHARACTER*128               :: DataSet
+  INTEGER                     :: io_form
+  INTEGER                     :: Hndl
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+
+  CHARACTER*128     :: LocFilename   ! for appending the process ID if necessary
+  INTEGER     myproc
+  CHARACTER*128     :: mess, fhand
+  CHARACTER*1028    :: tstr
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_open_for_read_begin' )
+
+  CALL get_value_from_pairs ( "DATASET" , SysDepInfo , DataSet )
+  IF      ( DataSet .eq. 'RESTART' ) THEN
+    CALL nl_get_io_form_restart( 1, io_form )
+  ELSE IF ( DataSet .eq. 'INPUT' ) THEN
+    CALL nl_get_io_form_input( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT1' ) THEN
+    CALL nl_get_io_form_auxinput1( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT2' ) THEN
+    CALL nl_get_io_form_auxinput2( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT3' ) THEN
+    CALL nl_get_io_form_auxinput3( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT4' ) THEN
+    CALL nl_get_io_form_auxinput4( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT5' ) THEN
+    CALL nl_get_io_form_auxinput5( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT6' ) THEN
+    CALL nl_get_io_form_auxinput6( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT7' ) THEN
+    CALL nl_get_io_form_auxinput7( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT8' ) THEN
+    CALL nl_get_io_form_auxinput8( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT9' ) THEN
+    CALL nl_get_io_form_auxinput9( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT10' ) THEN
+    CALL nl_get_io_form_gfdda( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT11' ) THEN
+    CALL nl_get_io_form_auxinput11( 1, io_form )
+
+  ELSE IF ( DataSet .eq. 'HISTORY' ) THEN
+    CALL nl_get_io_form_history( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST1' ) THEN
+    CALL nl_get_io_form_auxhist1( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST2' ) THEN
+    CALL nl_get_io_form_auxhist2( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST3' ) THEN
+    CALL nl_get_io_form_auxhist3( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST4' ) THEN
+    CALL nl_get_io_form_auxhist4( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST5' ) THEN
+    CALL nl_get_io_form_auxhist5( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST6' ) THEN
+    CALL nl_get_io_form_auxhist6( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST7' ) THEN
+    CALL nl_get_io_form_auxhist7( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST8' ) THEN
+    CALL nl_get_io_form_auxhist8( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST9' ) THEN
+    CALL nl_get_io_form_auxhist9( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST10' ) THEN
+    CALL nl_get_io_form_auxhist10( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST11' ) THEN
+    CALL nl_get_io_form_auxhist11( 1, io_form )
+
+  ELSE IF ( DataSet .eq. 'BOUNDARY' ) THEN
+    CALL nl_get_io_form_boundary( 1, io_form )
+  ELSE  ! default if nothing is set in SysDepInfo; use history
+    CALL nl_get_io_form_history( 1, io_form )
+  ENDIF
+
+  Status = 0
+  Hndl = -1
+  IF ( .NOT. use_output_servers() ) THEN
+    SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+      CASE ( IO_NETCDF   )
+        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+          IF ( multi_files(io_form) ) THEN
+              CALL wrf_get_myproc ( myproc )
+              CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+          ELSE
+              LocFilename = FileName
+          ENDIF
+          CALL ext_ncd_open_for_read_begin ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
+                                       Hndl , Status )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef XXX
+      CASE ( IO_XXX   )
+        CALL ext_xxx_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                            Hndl , Status )
+#endif
+#ifdef YYY
+      CASE ( IO_YYY   )
+        CALL ext_yyy_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                            Hndl , Status )
+#endif
+#ifdef ZZZ
+      CASE ( IO_ZZZ   )
+        CALL ext_zzz_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                            Hndl , Status )
+#endif
+#ifdef MCELIO
+      CASE ( IO_MCEL )
+        IF ( wrf_dm_on_monitor() ) THEN
+          
+        WRITE(fhand,'(a,i0)')"filter_",filtno
+        filtno = filtno + 1
+tstr = TRIM(SysDepInfo) // ',' // 'READ_MODE=UPDATE,LAT_R=XLAT,LON_R=XLONG,LANDMASK_I=LU_MASK,FILTER_HANDLE=' // TRIM(fhand)
+          CALL ext_mcel_open_for_read_begin ( FileName , Comm_compute, Comm_io, tstr, &
+                                               Hndl , Status )
+        ENDIF
+        CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+        CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef ESMFIO
+      CASE ( IO_ESMF )
+        CALL ext_esmf_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                            Hndl , Status )
+#endif
+#ifdef GRIB1
+      CASE ( IO_GRIB1   )
+        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+          IF ( multi_files(io_form) ) THEN
+              CALL wrf_get_myproc ( myproc )
+              CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+          ELSE
+              LocFilename = FileName
+          ENDIF
+          CALL ext_gr1_open_for_read_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
+               Hndl , Status )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef GRIB2
+      CASE ( IO_GRIB2   )
+        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+          IF ( multi_files(io_form) ) THEN
+              CALL wrf_get_myproc ( myproc )
+              CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+          ELSE
+              LocFilename = FileName
+          ENDIF
+          CALL ext_gr2_open_for_read_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
+               Hndl , Status )
+        ENDIF
+        IF ( .NOT. multi_files(io_form) ) THEN
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+        ENDIF
+#endif
+#ifdef INTIO
+      CASE ( IO_INTIO   )
+#endif
+      CASE DEFAULT
+        IF ( io_form .NE. 0 ) THEN
+          WRITE(mess,*)'Tried to open ',FileName,' reading: no valid io_form (',io_form,')'
+          CALL wrf_message(mess)
+        ENDIF
+        Status = WRF_FILE_NOT_OPENED
+    END SELECT
+  ELSE
+    Status = 0
+  ENDIF
+  CALL add_new_handle( Hndl, io_form, .TRUE., DataHandle )
+END SUBROUTINE wrf_open_for_read_begin
+
+!--- open_for_read_commit
+
+SUBROUTINE wrf_open_for_read_commit( DataHandle , Status )
+!<DESCRIPTION>
+!<PRE>
+! End "training" phase for WRF dataset FileName.  The call to 
+! wrf_open_for_read_commit() must be paired with a call to 
+! wrf_open_for_read_begin().
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+ 
+  CHARACTER (128)             :: DataSet
+  INTEGER                     :: io_form
+  INTEGER                     :: Hndl
+  LOGICAL                     :: for_out
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+#include "wrf_io_flags.h"
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_open_for_read_commit' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  CALL set_first_operation( DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
+            CALL ext_ncd_open_for_read_commit ( Hndl , Status )
+          ENDIF
+          IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef MCELIO
+        CASE ( IO_MCEL   )
+          IF ( wrf_dm_on_monitor() ) THEN
+            CALL ext_mcel_open_for_read_commit ( Hndl , Status )
+          ENDIF
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef ESMFIO
+        CASE ( IO_ESMF )
+          CALL ext_esmf_open_for_read_commit ( Hndl , Status )
+#endif
+#ifdef XXX
+      CASE ( IO_XXX   )
+        CALL ext_xxx_open_for_read_commit ( Hndl , Status )
+#endif
+#ifdef YYY
+      CASE ( IO_YYY   )
+        CALL ext_yyy_open_for_read_commit ( Hndl , Status )
+#endif
+#ifdef ZZZ
+      CASE ( IO_ZZZ   )
+        CALL ext_zzz_open_for_read_commit ( Hndl , Status )
+#endif
+#ifdef GRIB1
+      CASE ( IO_GRIB1   )
+        CALL ext_gr1_open_for_read_commit ( Hndl , Status )
+#endif
+#ifdef GRIB2
+      CASE ( IO_GRIB2   )
+        CALL ext_gr2_open_for_read_commit ( Hndl , Status )
+#endif
+#ifdef INTIO
+      CASE ( IO_INTIO   )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE
+      Status = 0
+    ENDIF
+  ELSE
+    Status = WRF_FILE_NOT_OPENED
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_open_for_read_commit
+
+!--- open_for_read 
+
+SUBROUTINE wrf_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                               DataHandle , Status )
+!<DESCRIPTION>
+!<PRE>
+! Opens a WRF dataset for reading.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER*(*) :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  CHARACTER (128)             :: DataSet, LocFileName
+  INTEGER                     :: io_form, myproc
+  INTEGER                     :: Hndl
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_open_for_read' )
+
+  CALL get_value_from_pairs ( "DATASET" , SysDepInfo , DataSet )
+  IF      ( DataSet .eq. 'RESTART' ) THEN
+    CALL nl_get_io_form_restart( 1, io_form )
+  ELSE IF ( DataSet .eq. 'INPUT' ) THEN
+    CALL nl_get_io_form_input( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT1' ) THEN
+    CALL nl_get_io_form_auxinput1( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT2' ) THEN
+    CALL nl_get_io_form_auxinput2( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT3' ) THEN
+    CALL nl_get_io_form_auxinput3( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT4' ) THEN
+    CALL nl_get_io_form_auxinput4( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT5' ) THEN
+    CALL nl_get_io_form_auxinput5( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT6' ) THEN
+    CALL nl_get_io_form_auxinput6( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT7' ) THEN
+    CALL nl_get_io_form_auxinput7( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT8' ) THEN
+    CALL nl_get_io_form_auxinput8( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT9' ) THEN
+    CALL nl_get_io_form_auxinput9( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT10' ) THEN
+    CALL nl_get_io_form_gfdda( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXINPUT11' ) THEN
+    CALL nl_get_io_form_auxinput11( 1, io_form )
+
+    CALL nl_get_io_form_auxinput5( 1, io_form )
+  ELSE IF ( DataSet .eq. 'HISTORY' ) THEN
+    CALL nl_get_io_form_history( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST1' ) THEN
+    CALL nl_get_io_form_auxhist1( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST2' ) THEN
+    CALL nl_get_io_form_auxhist2( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST3' ) THEN
+    CALL nl_get_io_form_auxhist3( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST4' ) THEN
+    CALL nl_get_io_form_auxhist4( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST5' ) THEN
+    CALL nl_get_io_form_auxhist5( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST6' ) THEN
+    CALL nl_get_io_form_auxhist6( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST7' ) THEN
+    CALL nl_get_io_form_auxhist7( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST8' ) THEN
+    CALL nl_get_io_form_auxhist8( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST9' ) THEN
+    CALL nl_get_io_form_auxhist9( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST10' ) THEN
+    CALL nl_get_io_form_auxhist10( 1, io_form )
+  ELSE IF ( DataSet .eq. 'AUXHIST11' ) THEN
+    CALL nl_get_io_form_auxhist11( 1, io_form )
+
+  ELSE IF ( DataSet .eq. 'BOUNDARY' ) THEN
+    CALL nl_get_io_form_boundary( 1, io_form )
+  ELSE  ! default if nothing is set in SysDepInfo; use history
+    CALL nl_get_io_form_history( 1, io_form )
+  ENDIF
+
+  Hndl = -1
+  Status = 0
+  SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+    CASE ( IO_NETCDF   )
+      IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+        IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+        ELSE
+            LocFilename = FileName
+        ENDIF
+
+        CALL ext_ncd_open_for_read ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
+                                     Hndl , Status )
+      ENDIF
+      IF ( .NOT. multi_files(io_form) ) THEN
+        CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+      ENDIF
+#endif
+#ifdef PHDF5
+    CASE ( IO_PHDF5  )
+      CALL ext_phdf5_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                               Hndl , Status )
+#endif
+#ifdef PNETCDF
+    CASE ( IO_PNETCDF  )
+      CALL ext_pnc_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                               Hndl , Status )
+#endif
+#ifdef XXX
+    CASE ( IO_XXX   )
+      CALL ext_xxx_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                               Hndl , Status )
+#endif
+#ifdef YYY
+    CASE ( IO_YYY   )
+      IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+        IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+        ELSE
+            LocFilename = FileName
+        ENDIF
+
+        CALL ext_yyy_open_for_read ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
+                                     Hndl , Status )
+      ENDIF
+      IF ( .NOT. multi_files(io_form) ) THEN
+        CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+      ENDIF
+#endif
+#ifdef ZZZ
+    CASE ( IO_ZZZ   )
+      CALL ext_zzz_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                               Hndl , Status )
+#endif
+#ifdef GRIB1
+    CASE ( IO_GRIB1   )
+      IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+        IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+        ELSE
+            LocFilename = FileName
+        ENDIF
+
+        CALL ext_gr1_open_for_read ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
+                                     Hndl , Status )
+      ENDIF
+      IF ( .NOT. multi_files(io_form) ) THEN
+        CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+      ENDIF
+#endif
+#ifdef GRIB2
+    CASE ( IO_GRIB2   )
+      IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+        IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+        ELSE
+            LocFilename = FileName
+        ENDIF
+
+        CALL ext_gr2_open_for_read ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
+                                     Hndl , Status )
+      ENDIF
+      IF ( .NOT. multi_files(io_form) ) THEN
+        CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+      ENDIF
+#endif
+#ifdef INTIO
+    CASE ( IO_INTIO   )
+      IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
+        IF ( multi_files(io_form) ) THEN
+            CALL wrf_get_myproc ( myproc )
+            CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
+        ELSE
+            LocFilename = FileName
+        ENDIF
+        CALL ext_int_open_for_read ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
+                                     Hndl , Status )
+      ENDIF
+      IF ( .NOT. multi_files(io_form) ) THEN
+        CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+        CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
+      ENDIF
+#endif
+    CASE DEFAULT
+        Status = 0
+  END SELECT
+  CALL add_new_handle( Hndl, io_form, .FALSE., DataHandle )
+  RETURN  
+END SUBROUTINE wrf_open_for_read
+
+!--- inquire_opened
+
+SUBROUTINE wrf_inquire_opened ( DataHandle, FileName , FileStatus, Status )
+!<DESCRIPTION>
+!<PRE>
+! Inquire if the dataset referenced by DataHandle is open.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+  LOGICAL                     :: for_out
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+#include "wrf_io_flags.h"
+#include "wrf_status_codes.h"
+
+  INTEGER io_form , Hndl
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_inquire_opened' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF (wrf_dm_on_monitor()) CALL ext_ncd_inquire_opened ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef PHDF5
+      CASE ( IO_PHDF5   )
+          CALL ext_phdf5_inquire_opened ( Hndl, FileName , FileStatus, Status )
+#endif
+#ifdef PNETCDF
+      CASE ( IO_PNETCDF   )
+          CALL ext_pnc_inquire_opened ( Hndl, FileName , FileStatus, Status )
+#endif
+#ifdef XXX
+      CASE ( IO_XXX   )
+          CALL ext_xxx_inquire_opened ( Hndl, FileName , FileStatus, Status )
+#endif
+#ifdef YYY
+      CASE ( IO_YYY   )
+          IF (wrf_dm_on_monitor()) CALL ext_yyy_inquire_opened ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef ZZZ
+      CASE ( IO_ZZZ   )
+          CALL ext_zzz_inquire_opened ( Hndl, FileName , FileStatus, Status )
+#endif
+#ifdef GRIB1
+      CASE ( IO_GRIB1   )
+          IF (wrf_dm_on_monitor()) CALL ext_gr1_inquire_opened ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef GRIB2
+      CASE ( IO_GRIB2   )
+          IF (wrf_dm_on_monitor()) CALL ext_gr2_inquire_opened ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef INTIO
+      CASE ( IO_INTIO   )
+          IF (wrf_dm_on_monitor()) CALL ext_int_inquire_opened ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+        CASE DEFAULT
+          FileStatus = WRF_FILE_NOT_OPENED
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_inquire_opened ( Hndl, FileName , FileStatus, Status )
+    ENDIF
+  ELSE
+    FileStatus = WRF_FILE_NOT_OPENED
+    Status = 0
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_inquire_opened
+
+!--- inquire_filename
+
+
+SUBROUTINE wrf_inquire_filename ( DataHandle, FileName , FileStatus, Status )
+!<DESCRIPTION>
+!<PRE>
+! Returns the Filename and FileStatus associated with DataHandle.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+#include "wrf_status_codes.h"
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+  LOGICAL                     :: for_out
+
+  INTEGER io_form , Hndl
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_inquire_filename' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package( io_form ) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF (wrf_dm_on_monitor()) CALL ext_ncd_inquire_filename ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef PHDF5
+        CASE ( IO_PHDF5   )
+          CALL ext_phdf5_inquire_filename ( Hndl, FileName , FileStatus, Status )
+#endif
+#ifdef PNETCDF
+        CASE ( IO_PNETCDF   )
+          CALL ext_pnc_inquire_filename ( Hndl, FileName , FileStatus, Status )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX   )
+          CALL ext_xxx_inquire_filename ( Hndl, FileName , FileStatus, Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY   )
+          IF (wrf_dm_on_monitor()) CALL ext_yyy_inquire_filename ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef ZZZ
+        CASE ( IO_ZZZ   )
+            CALL ext_zzz_inquire_filename ( Hndl, FileName , FileStatus, Status )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1   )
+          IF (wrf_dm_on_monitor()) CALL ext_gr1_inquire_filename ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2   )
+          IF (wrf_dm_on_monitor()) CALL ext_gr2_inquire_filename ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef INTIO
+        CASE ( IO_INTIO   )
+          IF (wrf_dm_on_monitor()) CALL ext_int_inquire_filename ( Hndl, FileName , FileStatus, Status )
+          CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_inquire_filename ( Hndl, FileName , FileStatus, Status )
+    ENDIF
+  ELSE
+    FileName = ""
+    Status = 0
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_inquire_filename
+
+!--- sync
+
+SUBROUTINE wrf_iosync ( DataHandle, Status )
+!<DESCRIPTION>
+!<PRE>
+! Synchronize the disk copy of a dataset with memory buffers.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+#include "wrf_status_codes.h"
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+  LOGICAL                     :: for_out
+
+  INTEGER io_form , Hndl
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_iosync' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_ncd_iosync( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX   )
+          CALL ext_xxx_iosync( Hndl, Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY   )
+          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_yyy_iosync( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1   )
+          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_gr1_iosync( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2   )
+          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_gr2_iosync( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+#ifdef ZZZ
+        CASE ( IO_ZZZ   )
+          CALL ext_zzz_iosync( Hndl, Status )
+#endif
+#ifdef INTIO
+        CASE ( IO_INTIO   )
+          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_int_iosync( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_iosync( Hndl, Status )
+    ELSE
+      Status = 0
+    ENDIF
+  ELSE
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_iosync
+
+!--- close
+
+SUBROUTINE wrf_ioclose ( DataHandle, Status )
+!<DESCRIPTION>
+!<PRE>
+! Close the dataset referenced by DataHandle.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+#include "wrf_status_codes.h"
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+  INTEGER io_form , Hndl
+  LOGICAL                     :: for_out
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_ioclose' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_ncd_ioclose( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef PHDF5
+        CASE ( IO_PHDF5  )
+          CALL ext_phdf5_ioclose( Hndl, Status )
+#endif
+#ifdef PNETCDF
+        CASE ( IO_PNETCDF  )
+          CALL ext_pnc_ioclose( Hndl, Status )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX   )
+          CALL ext_xxx_ioclose( Hndl, Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_yyy_ioclose( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef ZZZ
+        CASE ( IO_ZZZ   )
+          CALL ext_zzz_ioclose( Hndl, Status )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr1_ioclose( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr2_ioclose( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef MCELIO
+        CASE ( IO_MCEL   )
+          CALL ext_mcel_ioclose( Hndl, Status )
+#endif
+#ifdef ESMFIO
+        CASE ( IO_ESMF )
+          CALL ext_esmf_ioclose( Hndl, Status )
+#endif
+#ifdef INTIO
+        CASE ( IO_INTIO   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_int_ioclose( Hndl, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_ioclose( Hndl, Status )
+    ELSE
+      Status = 0
+    ENDIF
+    CALL free_handle( DataHandle )
+  ELSE
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_ioclose
+
+!--- get_next_time (not defined for IntIO )
+
+SUBROUTINE wrf_get_next_time ( DataHandle, DateStr, Status )
+!<DESCRIPTION>
+!<PRE>
+! Returns the next time stamp.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+#include "wrf_status_codes.h"
+
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+  INTEGER io_form , Hndl, len_of_str
+  LOGICAL                     :: for_out
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_get_next_time' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_ncd_get_next_time( Hndl, DateStr, Status )
+          IF ( .NOT. multi_files(io_form) ) THEN
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+            len_of_str = LEN(DateStr)
+            CALL wrf_dm_bcast_string ( DateStr , len_of_str )
+          ENDIF
+#endif
+#ifdef PHDF5
+        CASE ( IO_PHDF5   )
+          CALL ext_phdf5_get_next_time( Hndl, DateStr, Status )
+#endif
+#ifdef PNETCDF
+        CASE ( IO_PNETCDF   )
+          CALL ext_pnc_get_next_time( Hndl, DateStr, Status )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX   )
+          CALL ext_xxx_get_next_time( Hndl, DateStr, Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_yyy_get_next_time( Hndl, DateStr, Status )
+          IF ( .NOT. multi_files(io_form) ) THEN
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+            len_of_str = LEN(DateStr)
+            CALL wrf_dm_bcast_string ( DateStr , len_of_str )
+          ENDIF
+#endif
+#ifdef ZZZ
+        CASE ( IO_ZZZ   )
+          CALL ext_zzz_get_next_time( Hndl, DateStr, Status )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr1_get_next_time( Hndl, DateStr, Status )
+          IF ( .NOT. multi_files(io_form) ) THEN
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+            len_of_str = LEN(DateStr)
+            CALL wrf_dm_bcast_string ( DateStr , len_of_str )
+          ENDIF
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr2_get_next_time( Hndl, DateStr, Status )
+          IF ( .NOT. multi_files(io_form) ) THEN
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+            len_of_str = LEN(DateStr)
+            CALL wrf_dm_bcast_string ( DateStr , len_of_str )
+          ENDIF
+#endif
+#ifdef INTIO
+        CASE ( IO_INTIO   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_int_get_next_time( Hndl, DateStr, Status )
+          IF ( .NOT. multi_files(io_form) ) THEN
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+            len_of_str = LEN(DateStr)
+            CALL wrf_dm_bcast_string ( DateStr , len_of_str )
+          ENDIF
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_get_next_time( Hndl, DateStr, Status )
+    ELSE
+      Status = 0
+    ENDIF
+  ELSE
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_get_next_time
+
+!--- get_previous_time (not defined for IntIO )
+
+SUBROUTINE wrf_get_previous_time ( DataHandle, DateStr, Status )
+!<DESCRIPTION>
+!<PRE>
+! Returns the previous time stamp.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+#include "wrf_status_codes.h"
+
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+  INTEGER io_form , Hndl, len_of_str
+  LOGICAL                     :: for_out
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_get_previous_time' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_ncd_get_previous_time( Hndl, DateStr, Status )
+          IF ( .NOT. multi_files(io_form) ) THEN
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+            len_of_str = LEN(DateStr)
+            CALL wrf_dm_bcast_string ( DateStr , len_of_str )
+          ENDIF
+#endif
+#ifdef PHDF5
+        CASE ( IO_PHDF5   )
+          CALL ext_phdf5_get_previous_time( Hndl, DateStr, Status )
+#endif
+#ifdef PNETCDF
+        CASE ( IO_PNETCDF   )
+          CALL ext_pnc_get_previous_time( Hndl, DateStr, Status )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX   )
+          CALL ext_xxx_get_previous_time( Hndl, DateStr, Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_yyy_get_previous_time( Hndl, DateStr, Status )
+          IF ( .NOT. multi_files(io_form) ) THEN
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+            len_of_str = LEN(DateStr)
+            CALL wrf_dm_bcast_string ( DateStr , len_of_str )
+         ENDIF
+#endif
+#ifdef ZZZ
+        CASE ( IO_ZZZ   )
+          CALL ext_zzz_get_previous_time( Hndl, DateStr, Status )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr1_get_previous_time( Hndl, DateStr, Status )
+          IF ( .NOT. multi_files(io_form) ) THEN
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+            len_of_str = LEN(DateStr)
+            CALL wrf_dm_bcast_string ( DateStr , len_of_str )
+         ENDIF
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr2_get_previous_time( Hndl, DateStr, Status )
+          IF ( .NOT. multi_files(io_form) ) THEN
+            CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+            len_of_str = LEN(DateStr)
+            CALL wrf_dm_bcast_string ( DateStr , len_of_str )
+         ENDIF
+#endif
+#ifdef INTIO
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_get_previous_time( Hndl, DateStr, Status )
+    ELSE
+      Status = 0
+    ENDIF
+  ELSE
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_get_previous_time
+
+!--- set_time
+
+SUBROUTINE wrf_set_time ( DataHandle, DateStr, Status )
+!<DESCRIPTION>
+!<PRE>
+! Sets the time stamp.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+#include "wrf_status_codes.h"
+
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+  INTEGER io_form , Hndl
+  LOGICAL                     :: for_out
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_set_time' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package( io_form ) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_ncd_set_time( Hndl, DateStr, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef PHDF5
+        CASE ( IO_PHDF5  )
+          CALL ext_phdf5_set_time( Hndl, DateStr, Status )
+#endif
+#ifdef PNETCDF
+        CASE ( IO_PNETCDF  )
+          CALL ext_pnc_set_time( Hndl, DateStr, Status )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX   )
+          CALL ext_xxx_set_time( Hndl, DateStr, Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_yyy_set_time( Hndl, DateStr, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef ZZZ
+        CASE ( IO_ZZZ   )
+          CALL ext_zzz_set_time( Hndl, DateStr, Status )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr1_set_time( Hndl, DateStr, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr2_set_time( Hndl, DateStr, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef INTIO
+        CASE ( IO_INTIO   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_int_set_time( Hndl, DateStr, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_set_time( Hndl, DateStr, Status )
+    ELSE
+      Status = 0
+    ENDIF
+  ELSE
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_set_time
+
+!--- get_next_var  (not defined for IntIO)
+
+SUBROUTINE wrf_get_next_var ( DataHandle, VarName, Status )
+!<DESCRIPTION>
+!<PRE>
+! On reading, this routine returns the name of the next variable in the 
+! current time frame.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) :: VarName
+  INTEGER ,       INTENT(OUT) :: Status
+#include "wrf_status_codes.h"
+
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+  INTEGER io_form , Hndl
+  LOGICAL                     :: for_out
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_get_next_var' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package( io_form ) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_ncd_get_next_var( Hndl, VarName, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX   )
+          CALL ext_xxx_get_next_var( Hndl, VarName, Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_yyy_get_next_var( Hndl, VarName, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef ZZZ
+        CASE ( IO_ZZZ   )
+          CALL ext_zzz_get_next_var( Hndl, VarName, Status )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr1_get_next_var( Hndl, VarName, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr2_get_next_var( Hndl, VarName, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+#ifdef INTIO
+        CASE ( IO_INTIO   )
+          IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_int_get_next_var( Hndl, VarName, Status )
+          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_get_next_var( Hndl, VarName, Status )
+    ELSE
+      Status = 0
+    ENDIF
+  ELSE
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_get_next_var
+
+
+! wrf_get_var_info  (not implemented for IntIO)
+
+SUBROUTINE wrf_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
+                              DomainStart , DomainEnd , Status )
+!<DESCRIPTION>
+!<PRE>
+! This routine applies only to a dataset that is open for read.  It returns 
+! information about a variable.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  IMPLICIT NONE
+  INTEGER               ,INTENT(IN)     :: DataHandle
+  CHARACTER*(*)         ,INTENT(IN)     :: VarName
+  INTEGER               ,INTENT(OUT)    :: NDim
+  CHARACTER*(*)         ,INTENT(OUT)    :: MemoryOrder
+  CHARACTER*(*)         ,INTENT(OUT)    :: Stagger
+  INTEGER ,dimension(*) ,INTENT(OUT)    :: DomainStart, DomainEnd
+  INTEGER               ,INTENT(OUT)    :: Status
+#include "wrf_status_codes.h"
+  INTEGER io_form , Hndl
+  LOGICAL                     :: for_out
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_get_var_info' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF (( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) .AND. .NOT. (for_out .AND. use_output_servers()) ) THEN
+      SELECT CASE ( use_package( io_form ) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          CALL ext_ncd_get_var_info ( Hndl , VarName , NDim ,            &
+                                      MemoryOrder , Stagger ,                  &
+                                      DomainStart , DomainEnd ,                &
+                                      Status )
+#endif
+#ifdef PHDF5
+        CASE ( IO_PHDF5)
+          CALL ext_phdf5_get_var_info ( Hndl , VarName , NDim ,            &
+                                      MemoryOrder , Stagger ,                  &
+                                      DomainStart , DomainEnd ,                &
+                                      Status )
+#endif
+#ifdef PNETCDF
+        CASE ( IO_PNETCDF)
+          CALL ext_pnc_get_var_info ( Hndl , VarName , NDim ,            &
+                                      MemoryOrder , Stagger ,                  &
+                                      DomainStart , DomainEnd ,                &
+                                      Status )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX )
+          CALL ext_xxx_get_var_info ( Hndl , VarName , NDim ,            &
+                                      MemoryOrder , Stagger ,                  &
+                                      DomainStart , DomainEnd ,                &
+                                      Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY )
+          CALL ext_yyy_get_var_info ( Hndl , VarName , NDim ,            &
+                                      MemoryOrder , Stagger ,                  &
+                                      DomainStart , DomainEnd ,                &
+                                      Status )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1 )
+          CALL ext_gr1_get_var_info ( Hndl , VarName , NDim ,            &
+                                      MemoryOrder , Stagger ,                  &
+                                      DomainStart , DomainEnd ,                &
+                                      Status )
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2 )
+          CALL ext_gr2_get_var_info ( Hndl , VarName , NDim ,            &
+                                      MemoryOrder , Stagger ,                  &
+                                      DomainStart , DomainEnd ,                &
+                                      Status )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
+      CALL wrf_quilt_get_var_info ( Hndl , VarName , NDim ,            &
+                                    MemoryOrder , Stagger ,                  &
+                                    DomainStart , DomainEnd ,                &
+                                    Status )
+    ELSE
+      Status = 0
+    ENDIF
+  ELSE
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+  ENDIF
+  RETURN
+
+END SUBROUTINE wrf_get_var_info
+
+
+
+!---------------------------------------------------------------------------------
+
+
+SUBROUTINE init_io_handles()
+!<DESCRIPTION>
+!<PRE>
+! Initialize all I/O handles.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER i
+  IF ( .NOT. is_inited ) THEN
+    DO i = 1, MAX_WRF_IO_HANDLE
+      wrf_io_handles(i) = -999319
+    ENDDO
+    is_inited = .TRUE.
+  ENDIF
+  RETURN
+END SUBROUTINE init_io_handles
+
+SUBROUTINE add_new_handle( Hndl, Hopened, for_out, DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! Stash the package-specific I/O handle (Hndl) and return a WRF I/O handle 
+! (DataHandle).  
+! File format ID is passed in via Hopened.  
+! for_out will be .TRUE. if this routine was called from an 
+! open-for-read/write-begin operation and .FALSE. otherwise.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(IN)     :: Hndl
+  INTEGER, INTENT(IN)     :: Hopened
+  LOGICAL, INTENT(IN)     :: for_out
+  INTEGER, INTENT(OUT)    :: DataHandle
+  INTEGER i
+  INTEGER, EXTERNAL       :: use_package
+  LOGICAL, EXTERNAL       :: multi_files
+  IF ( .NOT. is_inited ) THEN
+    CALL wrf_error_fatal( 'add_new_handle: not initialized' )
+  ENDIF
+  IF ( multi_files( Hopened ) ) THEN
+    SELECT CASE ( use_package( Hopened ) )
+      CASE ( IO_PHDF5  )
+        CALL wrf_error_fatal( 'add_new_handle:  multiple output files not supported for PHDF5' )
+      CASE ( IO_PNETCDF  )
+        CALL wrf_error_fatal( 'add_new_handle:  multiple output files not supported for PNETCDF' )
+#ifdef MCELIO
+      CASE ( IO_MCEL   )
+        CALL wrf_error_fatal( 'add_new_handle:  multiple output files not supported for MCEL' )
+#endif
+#ifdef ESMFIO
+      CASE ( IO_ESMF )
+        CALL wrf_error_fatal( 'add_new_handle:  multiple output files not supported for ESMF' )
+#endif
+    END SELECT
+  ENDIF
+  DataHandle = -1
+  DO i = 1, MAX_WRF_IO_HANDLE
+    IF ( wrf_io_handles(i) .EQ. -999319 ) THEN
+      DataHandle = i 
+      wrf_io_handles(i) = Hndl
+      how_opened(i)     = Hopened
+      for_output(DataHandle) = for_out
+      first_operation(DataHandle) = .TRUE.
+      EXIT
+    ENDIF
+  ENDDO
+  IF ( DataHandle .EQ. -1 ) THEN
+    CALL wrf_error_fatal( 'add_new_handle: no handles left' )
+  ENDIF
+  RETURN
+END SUBROUTINE add_new_handle
+
+SUBROUTINE get_handle ( Hndl, Hopened, for_out, DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! Return the package-specific handle (Hndl) from a WRF handle 
+! (DataHandle).  
+! Return file format ID via Hopened.  
+! Also, for_out will be set to .TRUE. if the file was opened 
+! with an open-for-read/write-begin operation and .FALSE. 
+! otherwise.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(OUT)     :: Hndl
+  INTEGER, INTENT(OUT)     :: Hopened
+  LOGICAL, INTENT(OUT)     :: for_out
+  INTEGER, INTENT(IN)    :: DataHandle
+  CHARACTER*128 mess
+  INTEGER i
+  IF ( .NOT. is_inited ) THEN
+    CALL wrf_error_fatal( 'module_io.F: get_handle: not initialized' )
+  ENDIF
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. MAX_WRF_IO_HANDLE ) THEN
+    Hndl = wrf_io_handles(DataHandle)
+    Hopened = how_opened(DataHandle)
+    for_out = for_output(DataHandle)
+  ELSE
+    Hndl = -1
+  ENDIF
+  RETURN
+END SUBROUTINE get_handle
+
+SUBROUTINE set_first_operation( DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! Sets internal flag to indicate that the first read or write has not yet 
+! happened for the dataset referenced by DataHandle.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(IN)    :: DataHandle
+  IF ( .NOT. is_inited ) THEN
+    CALL wrf_error_fatal( 'module_io.F: get_handle: not initialized' )
+  ENDIF
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. MAX_WRF_IO_HANDLE ) THEN
+    first_operation(DataHandle) = .TRUE.
+  ENDIF
+  RETURN
+END SUBROUTINE set_first_operation
+
+SUBROUTINE reset_first_operation( DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! Resets internal flag to indicate that the first read or write has already 
+! happened for the dataset referenced by DataHandle.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(IN)    :: DataHandle
+  IF ( .NOT. is_inited ) THEN
+    CALL wrf_error_fatal( 'module_io.F: get_handle: not initialized' )
+  ENDIF
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. MAX_WRF_IO_HANDLE ) THEN
+    first_operation(DataHandle) = .FALSE.
+  ENDIF
+  RETURN
+END SUBROUTINE reset_first_operation
+
+LOGICAL FUNCTION is_first_operation( DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! Returns .TRUE. the first read or write has not yet happened for the dataset 
+! referenced by DataHandle.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(IN)    :: DataHandle
+  IF ( .NOT. is_inited ) THEN
+    CALL wrf_error_fatal( 'module_io.F: get_handle: not initialized' )
+  ENDIF
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. MAX_WRF_IO_HANDLE ) THEN
+    is_first_operation = first_operation(DataHandle)
+  ENDIF
+  RETURN
+END FUNCTION is_first_operation
+
+SUBROUTINE free_handle ( DataHandle )
+!<DESCRIPTION>
+!<PRE>
+! Trash a handle and return to "unused" pool.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(IN)    :: DataHandle
+  INTEGER i
+  IF ( .NOT. is_inited ) THEN
+    CALL wrf_error_fatal( 'free_handle: not initialized' )
+  ENDIF
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. MAX_WRF_IO_HANDLE ) THEN
+    wrf_io_handles(DataHandle) = -999319
+  ENDIF
+  RETURN
+END SUBROUTINE free_handle
+
+!--------------------------------------------------------------
+
+SUBROUTINE init_module_io
+!<DESCRIPTION>
+!<PRE>
+! Initialize this module.  Must be called before any other operations are 
+! attempted.  
+!</PRE>
+!</DESCRIPTION>
+  CALL init_io_handles
+END SUBROUTINE init_module_io
+END MODULE module_io
+
+
+!<DESCRIPTION>
+!<PRE>
+! Remaining routines in this file are defined outside of the module to 
+! defeat arg/param type checking.  
+!</PRE>
+!</DESCRIPTION>
+SUBROUTINE wrf_read_field ( DataHandle , DateStr , VarName , Field , FieldType ,         &
+                            Comm       , IOComm  ,                                       &
+                            DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                            DomainStart , DomainEnd ,                                    &
+                            MemoryStart , MemoryEnd ,                                    &
+                            PatchStart , PatchEnd ,                                      &
+                            Status )
+!<DESCRIPTION>
+!<PRE>
+! Read the variable named VarName from the dataset pointed to by DataHandle.
+! This routine is a wrapper that ensures uniform treatment of logicals across 
+! platforms by reading as integer and then converting to logical.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  USE module_configure
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)    :: DataHandle
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  LOGICAL ,       INTENT(INOUT) :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)                        :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(OUT)   :: Status
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER, ALLOCATABLE        :: ICAST(:)
+  LOGICAL perturb_input
+  IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+    ALLOCATE(ICAST((MemoryEnd(1)-MemoryStart(1)+1)*(MemoryEnd(2)-MemoryStart(2)+1)*(MemoryEnd(3)-MemoryStart(3)+1)))
+
+    CALL wrf_read_field1 ( DataHandle , DateStr , VarName , ICAST , WRF_INTEGER ,         &
+                           Comm       , IOComm  ,                                       &
+                           DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                           DomainStart , DomainEnd ,                                    &
+                           MemoryStart , MemoryEnd ,                                    &
+                           PatchStart , PatchEnd ,                                      &
+                           Status )
+    Field(1:(MemoryEnd(1)-MemoryStart(1)+1)*(MemoryEnd(2)-MemoryStart(2)+1)*(MemoryEnd(3)-MemoryStart(3)+1)) = ICAST == 1
+    DEALLOCATE(ICAST)
+  ELSE
+    CALL wrf_read_field1 ( DataHandle , DateStr , VarName , Field , FieldType ,         &
+                           Comm       , IOComm  ,                                       &
+                           DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                           DomainStart , DomainEnd ,                                    &
+                           MemoryStart , MemoryEnd ,                                    &
+                           PatchStart , PatchEnd ,                                      &
+                           Status )
+    CALL nl_get_perturb_input( 1, perturb_input )
+    IF ( perturb_input .AND. FieldType .EQ. WRF_FLOAT .AND. TRIM(MemoryOrder) .EQ. 'XZY' ) THEN
+       CALL perturb_real ( Field, DomainStart, DomainEnd,        &
+                                  MemoryStart, MemoryEnd,        &
+                                  PatchStart, PatchEnd )
+    ENDIF
+  ENDIF
+END SUBROUTINE wrf_read_field
+
+SUBROUTINE wrf_read_field1 ( DataHandle , DateStr , VarName , Field , FieldType ,         &
+                            Comm       , IOComm  ,                                       &
+                            DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                            DomainStart , DomainEnd ,                                    &
+                            MemoryStart , MemoryEnd ,                                    &
+                            PatchStart , PatchEnd ,                                      &
+                            Status )
+!<DESCRIPTION>
+!<PRE>
+! Read the variable named VarName from the dataset pointed to by DataHandle.
+! Calls ext_pkg_read_field() via call_pkg_and_dist().  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  USE module_configure
+  USE module_io
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  INTEGER ,       INTENT(INOUT) :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm 
+  INTEGER                       ,INTENT(INOUT) :: IOComm 
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)                        :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(OUT)   :: Status
+#include "wrf_status_codes.h"
+  INTEGER io_form , Hndl
+  LOGICAL                     :: for_out
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers, use_input_servers
+#ifdef NETCDF
+  EXTERNAL     ext_ncd_read_field
+#endif
+#ifdef MCELIO
+  EXTERNAL     ext_mcel_read_field
+#endif
+#ifdef ESMFIO
+  EXTERNAL     ext_esmf_read_field
+#endif
+#ifdef INTIO
+  EXTERNAL     ext_int_read_field
+#endif
+#ifdef XXX
+  EXTERNAL ext_xxx_read_field
+#endif
+#ifdef YYY
+  EXTERNAL ext_yyy_read_field
+#endif
+#ifdef GRIB1
+  EXTERNAL ext_gr1_read_field
+#endif
+#ifdef GRIB2
+  EXTERNAL ext_gr2_read_field
+#endif
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_read_field' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  CALL reset_first_operation( DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( .NOT. io_form .GT. 0 ) THEN
+      Status = 0 
+    ELSE IF ( .NOT. use_input_servers() ) THEN
+      SELECT CASE ( use_package( io_form ) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+
+          CALL call_pkg_and_dist   ( ext_ncd_read_field, multi_files(io_form), .false. ,        &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+
+#endif
+#ifdef PHDF5
+        CASE ( IO_PHDF5)
+          CALL ext_phdf5_read_field   (                   &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef PNETCDF
+        CASE ( IO_PNETCDF)
+          CALL ext_pnc_read_field   (                   &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef MCELIO
+        CASE ( IO_MCEL   )
+          CALL call_pkg_and_dist   ( ext_mcel_read_field, multi_files(io_form), .true. ,         &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef ESMFIO
+        CASE ( IO_ESMF )
+          CALL ext_esmf_read_field( Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                    DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                    DomainStart , DomainEnd ,                                    &
+                                    MemoryStart , MemoryEnd ,                                    &
+                                    PatchStart , PatchEnd ,                                      &
+                                    Status )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX )
+          CALL call_pkg_and_dist   ( ext_xxx_read_field, multi_files(io_form), .false.,         &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY )
+          CALL call_pkg_and_dist   ( ext_yyy_read_field, multi_files(io_form), .false.,         &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef INTIO
+        CASE ( IO_INTIO )
+          CALL call_pkg_and_dist   ( ext_int_read_field, multi_files(io_form), .false.,         &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1 )
+          CALL call_pkg_and_dist   ( ext_gr1_read_field, multi_files(io_form), .false.,         &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2 )
+          CALL call_pkg_and_dist   ( ext_gr2_read_field, multi_files(io_form), .false.,         &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE
+      CALL wrf_error_fatal('module_io.F: wrf_read_field: input_servers not implemented yet')
+    ENDIF
+  ELSE
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_read_field1
+
+SUBROUTINE wrf_write_field ( DataHandle , DateStr , VarName , Field , FieldType ,         &
+                             Comm       , IOComm  ,                                       &
+                             DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                             DomainStart , DomainEnd ,                                    &
+                             MemoryStart , MemoryEnd ,                                    &
+                             PatchStart , PatchEnd ,                                      &
+                             Status )
+!<DESCRIPTION>
+!<PRE>
+! Write the variable named VarName to the dataset pointed to by DataHandle.
+! This routine is a wrapper that ensures uniform treatment of logicals across 
+! platforms by converting to integer before writing.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  USE module_configure
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)    :: DataHandle
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  LOGICAL ,       INTENT(IN)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)         ,INTENT(IN)    :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(OUT)   :: Status
+#include "wrf_status_codes.h"
+#include "wrf_io_flags.h"
+  INTEGER, ALLOCATABLE        :: ICAST(:)
+  IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+      ALLOCATE(ICAST((MemoryEnd(1)-MemoryStart(1)+1)*(MemoryEnd(2)-MemoryStart(2)+1)*(MemoryEnd(3)-MemoryStart(3)+1)))
+      ICAST = 0
+      WHERE ( Field(1:(MemoryEnd(1)-MemoryStart(1)+1)*(MemoryEnd(2)-MemoryStart(2)+1)*(MemoryEnd(3)-MemoryStart(3)+1)) )
+        ICAST = 1
+      END WHERE
+    CALL wrf_write_field1 ( DataHandle , DateStr , VarName , ICAST , WRF_INTEGER ,         &
+                            Comm       , IOComm  ,                                       &
+                            DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                            DomainStart , DomainEnd ,                                    &
+                            MemoryStart , MemoryEnd ,                                    &
+                            PatchStart , PatchEnd ,                                      &
+                            Status )
+      DEALLOCATE(ICAST)
+  ELSE
+    CALL wrf_write_field1 ( DataHandle , DateStr , VarName , Field , FieldType ,         &
+                            Comm       , IOComm  ,                                       &
+                            DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                            DomainStart , DomainEnd ,                                    &
+                            MemoryStart , MemoryEnd ,                                    &
+                            PatchStart , PatchEnd ,                                      &
+                            Status )
+  ENDIF
+END SUBROUTINE wrf_write_field
+
+SUBROUTINE wrf_write_field1 ( DataHandle , DateStr , VarName , Field , FieldType ,         &
+                             Comm       , IOComm  ,                                       &
+                             DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                             DomainStart , DomainEnd ,                                    &
+                             MemoryStart , MemoryEnd ,                                    &
+                             PatchStart , PatchEnd ,                                      &
+                             Status )
+!<DESCRIPTION>
+!<PRE>
+! Write the variable named VarName to the dataset pointed to by DataHandle.
+! Calls ext_pkg_write_field() via collect_fld_and_call_pkg().  
+!</PRE>
+!</DESCRIPTION>
+
+  USE module_state_description
+  USE module_configure
+  USE module_io
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  INTEGER ,       INTENT(IN)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)         ,INTENT(IN)    :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(OUT)   :: Status
+#include "wrf_status_codes.h"
+  INTEGER, DIMENSION(3) :: starts, ends
+  INTEGER io_form , Hndl
+  CHARACTER*3 MemOrd
+  LOGICAL                     :: for_out, okay_to_call
+  INTEGER, EXTERNAL           :: use_package
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
+#ifdef NETCDF
+  EXTERNAL     ext_ncd_write_field
+#endif
+#ifdef MCELIO
+  EXTERNAL     ext_mcel_write_field
+#endif
+#ifdef ESMFIO
+  EXTERNAL     ext_esmf_write_field
+#endif
+#ifdef INTIO
+  EXTERNAL     ext_int_write_field
+#endif
+#ifdef XXX
+  EXTERNAL ext_xxx_write_field
+#endif
+#ifdef YYY
+  EXTERNAL ext_yyy_write_field
+#endif
+#ifdef GRIB1
+  EXTERNAL ext_gr1_write_field
+#endif
+#ifdef GRIB2
+  EXTERNAL ext_gr2_write_field
+#endif
+
+  CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_write_field' )
+
+  Status = 0
+  CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+  CALL reset_first_operation ( DataHandle )
+  IF ( Hndl .GT. -1 ) THEN
+    IF ( multi_files( io_form ) .OR. .NOT. use_output_servers() ) THEN
+      SELECT CASE ( use_package( io_form ) )
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+          CALL collect_fld_and_call_pkg ( ext_ncd_write_field, multi_files(io_form),                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef MCELIO
+        CASE ( IO_MCEL   )
+          CALL collect_fld_and_call_pkg ( ext_mcel_write_field, multi_files(io_form),                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef ESMFIO
+        CASE ( IO_ESMF )
+          CALL ext_esmf_write_field( Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef PHDF5
+        CASE ( IO_PHDF5 )
+          CALL ext_phdf5_write_field(                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef PNETCDF
+        CASE ( IO_PNETCDF )
+          CALL lower_case( MemoryOrder, MemOrd )
+          okay_to_call = .TRUE.
+          IF ((TRIM(MemOrd).EQ.'xsz' .OR. TRIM(MemOrd).EQ.'xs').AND. .NOT. bdy_mask(P_XSB)) okay_to_call = .FALSE.
+          IF ((TRIM(MemOrd).EQ.'xez' .OR. TRIM(MemOrd).EQ.'xe').AND. .NOT. bdy_mask(P_XEB)) okay_to_call = .FALSE.
+          IF ((TRIM(MemOrd).EQ.'ysz' .OR. TRIM(MemOrd).EQ.'ys').AND. .NOT. bdy_mask(P_YSB)) okay_to_call = .FALSE.
+          IF ((TRIM(MemOrd).EQ.'yez' .OR. TRIM(MemOrd).EQ.'ye').AND. .NOT. bdy_mask(P_YEB)) okay_to_call = .FALSE.
+          IF ( okay_to_call ) THEN
+             starts(1:3) = PatchStart(1:3) ; ends(1:3) = PatchEnd(1:3)
+          ELSE
+             starts(1:3) = PatchStart(1:3) ; ends(1:3) = PatchStart(1:3)-1
+          ENDIF
+
+               CALL ext_pnc_write_field(                  &
+                                       Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                       DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                       DomainStart , DomainEnd ,                                    &
+                                       MemoryStart , MemoryEnd ,                                    &
+                                       starts , ends ,                                      &
+                                       Status )
+#endif
+#ifdef XXX
+        CASE ( IO_XXX )
+          CALL collect_fld_and_call_pkg ( ext_xxx_write_field, multi_files(io_form),                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef YYY
+        CASE ( IO_YYY )
+          CALL collect_fld_and_call_pkg ( ext_yyy_write_field, multi_files(io_form),                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef GRIB1
+        CASE ( IO_GRIB1 )
+          CALL collect_fld_and_call_pkg ( ext_gr1_write_field, multi_files(io_form),                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef GRIB2
+        CASE ( IO_GRIB2 )
+          CALL collect_fld_and_call_pkg ( ext_gr2_write_field, multi_files(io_form),                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+#ifdef INTIO
+        CASE ( IO_INTIO )
+          CALL collect_fld_and_call_pkg ( ext_int_write_field, multi_files(io_form),                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+#endif
+        CASE DEFAULT
+          Status = 0
+      END SELECT
+    ELSE IF ( use_output_servers() ) THEN
+      IF ( io_form .GT. 0 ) THEN
+      CALL wrf_quilt_write_field ( Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                   DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                   DomainStart , DomainEnd ,                                    &
+                                   MemoryStart , MemoryEnd ,                                    &
+                                   PatchStart , PatchEnd ,                                      &
+                                   Status )
+      ENDIF
+    ENDIF
+  ELSE
+    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
+  ENDIF
+  RETURN
+END SUBROUTINE wrf_write_field1
+
+SUBROUTINE get_value_from_pairs ( varname , str , retval )
+!<DESCRIPTION>
+!<PRE>
+! parse comma separated list of VARIABLE=VALUE strings and return the
+! value for the matching variable if such exists, otherwise return
+! the empty string
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  CHARACTER*(*) ::    varname
+  CHARACTER*(*) ::    str
+  CHARACTER*(*) ::    retval
+
+  CHARACTER (128) varstr, tstr
+  INTEGER i,j,n,varstrn
+  LOGICAL nobreak, nobreakouter
+
+  varstr = TRIM(varname)//"="
+  varstrn = len(TRIM(varstr))
+  n = len(str)
+  retval = ""
+  i = 1
+  nobreakouter = .TRUE.
+  DO WHILE ( nobreakouter )
+    j = 1
+    nobreak = .TRUE.
+    tstr = ""
+! Potential for out of bounds array ref on str(i:i) for i > n; reported by jedwards
+!    DO WHILE ( nobreak )
+!      IF ( str(i:i) .NE. ',' .AND. i .LE. n ) THEN
+!        tstr(j:j) = str(i:i)
+!      ELSE
+!        nobreak = .FALSE.
+!      ENDIF
+!      j = j + 1
+!      i = i + 1
+!    ENDDO
+! fix 20021112, JM
+    DO WHILE ( nobreak )
+      nobreak = .FALSE.
+      IF ( i .LE. n ) THEN
+        IF (str(i:i) .NE. ',' ) THEN
+           tstr(j:j) = str(i:i)
+           nobreak = .TRUE.
+        ENDIF
+      ENDIF
+      j = j + 1
+      i = i + 1
+    ENDDO
+    IF ( i .GT. n ) nobreakouter = .FALSE.
+    IF ( varstr(1:varstrn) .EQ. tstr(1:varstrn) ) THEN
+      retval(1:) = TRIM(tstr(varstrn+1:))
+      nobreakouter = .FALSE.
+    ENDIF
+  ENDDO
+  RETURN
+END SUBROUTINE get_value_from_pairs
+
+LOGICAL FUNCTION multi_files ( io_form )
+!<DESCRIPTION>
+!<PRE>
+! Returns .TRUE. iff io_form is a multi-file format.  A multi-file format 
+! results in one file for each compute process and can be used with any 
+! I/O package.  A multi-file dataset can only be read by the same number 
+! of tasks that were used to write it.  This feature can be useful for 
+! speeding up restarts on machines that support efficient parallel I/O.  
+! Multi-file formats cannot be used with I/O quilt servers.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: io_form
+#ifdef DM_PARALLEL
+  multi_files = io_form > 99
+#else
+  multi_files = .FALSE.
+#endif
+END FUNCTION multi_files
+
+INTEGER FUNCTION use_package ( io_form )
+!<DESCRIPTION>
+!<PRE>
+! Returns the ID of the external I/O package referenced by io_form.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: io_form
+  use_package = MOD( io_form, 100 )
+END FUNCTION use_package
+
+
+SUBROUTINE collect_fld_and_call_pkg (    fcn, donotcollect_arg,                                       &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The collect_*_and_call_pkg routines collect a distributed array onto one 
+! processor and then call an I/O function to write the result (or in the 
+! case of replicated data simply write monitor node's copy of the data)
+! This routine handle cases where collection can be skipped and deals with 
+! different data types for Field.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  EXTERNAL fcn
+  LOGICAL,        INTENT(IN)    :: donotcollect_arg
+  INTEGER ,       INTENT(IN)    :: Hndl
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  INTEGER ,       INTENT(IN)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)                        :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(OUT)   :: Status
+  LOGICAL donotcollect
+  INTEGER ndims, nproc
+
+  CALL dim_from_memorder( MemoryOrder , ndims)
+  CALL wrf_get_nproc( nproc )
+  donotcollect = donotcollect_arg .OR. (nproc .EQ. 1)
+
+  IF ( donotcollect ) THEN
+
+    CALL fcn ( Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , MemoryOrder , Stagger , DimNames ,                &
+               DomainStart , DomainEnd ,                                      &
+               MemoryStart , MemoryEnd ,                                      &
+               PatchStart , PatchEnd ,                                        &
+               Status )
+
+  ELSE IF ( FieldType .EQ. WRF_DOUBLE  ) THEN
+
+     CALL collect_double_and_call_pkg ( fcn,                                        &
+               Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+               DomainStart , DomainEnd ,                                    &
+               MemoryStart , MemoryEnd ,                                    &
+               PatchStart , PatchEnd ,                                      &
+               Status )
+
+  ELSE IF ( FieldType .EQ. WRF_FLOAT ) THEN
+
+     CALL collect_real_and_call_pkg ( fcn,                                        &
+               Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+               DomainStart , DomainEnd ,                                    &
+               MemoryStart , MemoryEnd ,                                    &
+               PatchStart , PatchEnd ,                                      &
+               Status )
+
+  ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+
+     CALL collect_int_and_call_pkg ( fcn,                                        &
+               Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+               DomainStart , DomainEnd ,                                    &
+               MemoryStart , MemoryEnd ,                                    &
+               PatchStart , PatchEnd ,                                      &
+               Status )
+
+  ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+
+     CALL collect_logical_and_call_pkg ( fcn,                                        &
+               Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+               DomainStart , DomainEnd ,                                    &
+               MemoryStart , MemoryEnd ,                                    &
+               PatchStart , PatchEnd ,                                      &
+               Status )
+
+  ENDIF
+  RETURN
+END SUBROUTINE collect_fld_and_call_pkg
+
+SUBROUTINE collect_real_and_call_pkg (   fcn,                                                     &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,    &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The collect_*_and_call_pkg routines collect a distributed array onto one 
+! processor and then call an I/O function to write the result (or in the 
+! case of replicated data simply write monitor node's copy of the data)
+! The sole purpose of this wrapper is to allocate a big real buffer and 
+! pass it down to collect_generic_and_call_pkg() to do the actual work.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  USE module_driver_constants
+  IMPLICIT NONE
+  EXTERNAL fcn
+  INTEGER ,       INTENT(IN)    :: Hndl
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  REAL    ,       INTENT(IN)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)                        :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(INOUT)   :: Status
+  REAL, ALLOCATABLE :: globbuf (:)
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    ALLOCATE( globbuf( (DomainEnd(1)-DomainStart(1)+3)*(DomainEnd(2)-DomainStart(2)+3)*(DomainEnd(3)-DomainStart(3)+3) ) )
+  ELSE
+    ALLOCATE( globbuf( 1 ) )
+  ENDIF
+
+#ifdef DEREF_KLUDGE
+# define FRSTELEM (1)
+#else
+# define FRSTELEM
+#endif
+  
+  CALL collect_generic_and_call_pkg (   fcn, globbuf FRSTELEM,                                    &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,    &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+  DEALLOCATE ( globbuf )
+  RETURN
+
+END SUBROUTINE collect_real_and_call_pkg
+
+SUBROUTINE collect_int_and_call_pkg (   fcn,                                                     &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,    &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The collect_*_and_call_pkg routines collect a distributed array onto one 
+! processor and then call an I/O function to write the result (or in the 
+! case of replicated data simply write monitor node's copy of the data)
+! The sole purpose of this wrapper is to allocate a big integer buffer and 
+! pass it down to collect_generic_and_call_pkg() to do the actual work.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  USE module_driver_constants
+  IMPLICIT NONE
+  EXTERNAL fcn
+  INTEGER ,       INTENT(IN)    :: Hndl
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  INTEGER    ,       INTENT(IN)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)                        :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(INOUT)   :: Status
+  INTEGER, ALLOCATABLE :: globbuf (:)
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    ALLOCATE( globbuf( (DomainEnd(1)-DomainStart(1)+3)*(DomainEnd(2)-DomainStart(2)+3)*(DomainEnd(3)-DomainStart(3)+3) ) )
+  ELSE
+    ALLOCATE( globbuf( 1 ) )
+  ENDIF
+
+  CALL collect_generic_and_call_pkg (   fcn, globbuf FRSTELEM ,                                   &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,    &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+  DEALLOCATE ( globbuf )
+  RETURN
+
+END SUBROUTINE collect_int_and_call_pkg
+
+SUBROUTINE collect_double_and_call_pkg (   fcn,                                                     &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,    &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The collect_*_and_call_pkg routines collect a distributed array onto one 
+! processor and then call an I/O function to write the result (or in the 
+! case of replicated data simply write monitor node's copy of the data)
+! The sole purpose of this wrapper is to allocate a big double precision 
+! buffer and pass it down to collect_generic_and_call_pkg() to do the 
+! actual work.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  USE module_driver_constants
+  IMPLICIT NONE
+  EXTERNAL fcn
+  INTEGER ,       INTENT(IN)    :: Hndl
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  DOUBLE PRECISION    ,       INTENT(IN)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)                        :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(INOUT)   :: Status
+  DOUBLE PRECISION, ALLOCATABLE :: globbuf (:)
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    ALLOCATE( globbuf( (DomainEnd(1)-DomainStart(1)+3)*(DomainEnd(2)-DomainStart(2)+3)*(DomainEnd(3)-DomainStart(3)+3) ) )
+  ELSE
+    ALLOCATE( globbuf( 1 ) )
+  ENDIF
+
+  CALL collect_generic_and_call_pkg (   fcn, globbuf FRSTELEM ,                                   &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,    &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+  DEALLOCATE ( globbuf )
+  RETURN
+
+END SUBROUTINE collect_double_and_call_pkg
+
+SUBROUTINE collect_logical_and_call_pkg (   fcn,                                                     &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,    &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The collect_*_and_call_pkg routines collect a distributed array onto one 
+! processor and then call an I/O function to write the result (or in the 
+! case of replicated data simply write monitor node's copy of the data)
+! The sole purpose of this wrapper is to allocate a big logical buffer 
+! and pass it down to collect_generic_and_call_pkg() to do the actual work.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  USE module_driver_constants
+  IMPLICIT NONE
+  EXTERNAL fcn
+  INTEGER ,       INTENT(IN)    :: Hndl
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  LOGICAL    ,       INTENT(IN)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)                        :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(INOUT)   :: Status
+  LOGICAL, ALLOCATABLE :: globbuf (:)
+  LOGICAL, EXTERNAL           :: wrf_dm_on_monitor
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    ALLOCATE( globbuf( (DomainEnd(1)-DomainStart(1)+3)*(DomainEnd(2)-DomainStart(2)+3)*(DomainEnd(3)-DomainStart(3)+3) ) )
+  ELSE
+    ALLOCATE( globbuf( 1 ) )
+  ENDIF
+
+  CALL collect_generic_and_call_pkg (   fcn, globbuf FRSTELEM ,                                   &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,    &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+  DEALLOCATE ( globbuf )
+  RETURN
+
+END SUBROUTINE collect_logical_and_call_pkg
+
+
+SUBROUTINE collect_generic_and_call_pkg ( fcn, globbuf,                                           &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,    &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The collect_*_and_call_pkg routines collect a distributed array onto one 
+! processor and then call an I/O function to write the result (or in the 
+! case of replicated data simply write monitor node's copy of the data)
+! This routine calls the distributed memory communication routines that 
+! collect the array and then calls I/O function fcn to write it to disk.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_state_description
+  USE module_driver_constants
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+#if defined( DM_PARALLEL ) && ! defined(STUBMPI)
+include "mpif.h"
+#endif
+  EXTERNAL fcn
+  REAL , DIMENSION(*) , INTENT(INOUT) :: globbuf
+  INTEGER ,       INTENT(IN)    :: Hndl
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  REAL    ,       INTENT(IN)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  LOGICAL, DIMENSION(4)                        :: bdy_mask
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(OUT)   :: Status
+  CHARACTER*3 MemOrd
+  LOGICAL, EXTERNAL :: has_char
+  INTEGER ids, ide, jds, jde, kds, kde
+  INTEGER ims, ime, jms, jme, kms, kme
+  INTEGER ips, ipe, jps, jpe, kps, kpe
+  INTEGER nproc, communicator, displs(10*1024), mpi_bdyslice_type, ierr, my_displ, recv_count, root_proc, send_count, itype
+  INTEGER my_count, counts(10*1024)
+  INTEGER , dimension(3)                       :: dom_end_rev
+  LOGICAL, EXTERNAL         :: wrf_dm_on_monitor
+  LOGICAL     distributed_field
+  INTEGER i,j,k,idx,lx,idx2,lx2
+
+  CALL wrf_get_nproc( nproc )
+  CALL wrf_get_dm_communicator ( communicator )
+  CALL lower_case( MemoryOrder, MemOrd )
+
+  dom_end_rev(1) = DomainEnd(1)
+  dom_end_rev(2) = DomainEnd(2)
+  dom_end_rev(3) = DomainEnd(3)
+
+  SELECT CASE (TRIM(MemOrd))
+    CASE (  'xzy' )
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'z' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(3) = dom_end_rev(3) + 1
+    CASE (  'zxy' )
+      IF ( .NOT. has_char( Stagger, 'z' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(3) = dom_end_rev(3) + 1
+    CASE (  'xyz' )
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+      IF ( .NOT. has_char( Stagger, 'z' ) ) dom_end_rev(3) = dom_end_rev(3) + 1
+    CASE (  'xy' )
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+    CASE (  'yxz' )
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+      IF ( .NOT. has_char( Stagger, 'z' ) ) dom_end_rev(3) = dom_end_rev(3) + 1
+    CASE (  'yx' )
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+    CASE DEFAULT
+      ! do nothing; the boundary orders and others either dont care or set themselves
+  END SELECT
+
+  SELECT CASE (TRIM(MemOrd))
+#ifndef STUBMPI
+    CASE (  'xzy','zxy','xyz','yxz','xy','yx' )
+
+      distributed_field = .TRUE.
+      IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+        CALL wrf_patch_to_global_double ( Field  , globbuf , DomainDesc, Stagger, MemOrd ,             &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3) )
+      ELSE IF ( FieldType .EQ. WRF_FLOAT ) THEN
+        CALL wrf_patch_to_global_real ( Field  , globbuf , DomainDesc, Stagger, MemOrd ,             &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3) )
+      ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+        CALL wrf_patch_to_global_integer ( Field  , globbuf , DomainDesc, Stagger, MemOrd ,             &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3) )
+      ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+        CALL wrf_patch_to_global_logical ( Field  , globbuf , DomainDesc, Stagger, MemOrd ,             &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3) )
+      ENDIF
+
+#if defined(DM_PARALLEL) && !defined(STUBMPI)
+    CASE ( 'xsz', 'xez' )
+      distributed_field = .FALSE.
+      IF ( nproc .GT. 1 ) THEN
+        jds = DomainStart(1) ; jde = DomainEnd(1) ; IF ( .NOT. has_char( Stagger, 'y' ) ) jde = jde+1  ! ns strip
+        kds = DomainStart(2) ; kde = DomainEnd(2) ; IF ( .NOT. has_char( Stagger, 'z' ) ) kde = kde+1  ! levels
+        ids = DomainStart(3) ; ide = DomainEnd(3) ; !  bdy_width
+        dom_end_rev(1) = jde
+        dom_end_rev(2) = kde
+        dom_end_rev(3) = ide
+        distributed_field = .TRUE.
+        IF ( (MemOrd .eq. 'xsz' .AND. bdy_mask( P_XSB )) .OR.     &
+             (MemOrd .eq. 'xez' .AND. bdy_mask( P_XEB ))       ) THEN
+          my_displ = PatchStart(1)-1
+          my_count = PatchEnd(1)-PatchStart(1)+1
+        ELSE
+          my_displ = 0
+          my_count = 0
+        ENDIF
+        CALL mpi_gather( my_displ, 1, MPI_INTEGER, displs, 1, MPI_INTEGER, 0, communicator, ierr )
+        CALL mpi_gather( my_count, 1, MPI_INTEGER, counts, 1, MPI_INTEGER, 0, communicator, ierr )
+        do i = DomainStart(3),DomainEnd(3)    ! bdy_width
+        do k = DomainStart(2),DomainEnd(2)    ! levels
+           lx   = MemoryEnd(1)-MemoryStart(1)+1
+           lx2  = dom_end_rev(1)-DomainStart(1)+1
+           idx  = lx*((k-1)+(i-1)*(MemoryEnd(2)-MemoryStart(2)+1))
+           idx2 = lx2*((k-1)+(i-1)*(MemoryEnd(2)-MemoryStart(2)+1))
+           IF ( FieldType .EQ. WRF_DOUBLE  ) THEN
+
+             CALL wrf_gatherv_double ( Field, PatchStart(1)+idx , &
+                             my_count ,                       &    ! sendcount
+                             globbuf, 1+idx2 ,                &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+
+           ELSE IF ( FieldType .EQ. WRF_FLOAT ) THEN
+
+             CALL wrf_gatherv_real ( Field, PatchStart(1)+idx , &
+                             my_count ,                       &    ! sendcount
+                             globbuf, 1+idx2 ,                &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+
+           ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+
+             CALL wrf_gatherv_integer ( Field, PatchStart(1)+idx , &
+                             my_count ,                       &    ! sendcount
+                             globbuf, 1+idx2 ,                &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+           ENDIF
+
+        enddo
+        enddo
+      ENDIF
+    CASE ( 'xs', 'xe' )
+      distributed_field = .FALSE.
+      IF ( nproc .GT. 1 ) THEN
+        jds = DomainStart(1) ; jde = DomainEnd(1) ; IF ( .NOT. has_char( Stagger, 'y' ) ) jde = jde+1  ! ns strip
+        ids = DomainStart(2) ; ide = DomainEnd(2) ; !  bdy_width
+        dom_end_rev(1) = jde
+        dom_end_rev(2) = ide
+        distributed_field = .TRUE.
+        IF ( (MemOrd .eq. 'xs' .AND. bdy_mask( P_XSB )) .OR.     &
+             (MemOrd .eq. 'xe' .AND. bdy_mask( P_XEB ))       ) THEN
+          my_displ = PatchStart(1)-1
+          my_count = PatchEnd(1)-PatchStart(1)+1
+        ELSE
+          my_displ = 0
+          my_count = 0
+        ENDIF
+        CALL mpi_gather( my_displ, 1, MPI_INTEGER, displs, 1, MPI_INTEGER, 0, communicator, ierr )
+        CALL mpi_gather( my_count, 1, MPI_INTEGER, counts, 1, MPI_INTEGER, 0, communicator, ierr )
+        do i = DomainStart(2),DomainEnd(2)    ! bdy_width
+           lx   = MemoryEnd(1)-MemoryStart(1)+1
+           idx  = lx*(i-1)
+           lx2  = dom_end_rev(1)-DomainStart(1)+1
+           idx2 = lx2*(i-1)
+           IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+
+             CALL wrf_gatherv_double ( Field, PatchStart(1)+idx , &
+                             my_count ,                       &    ! sendcount
+                             globbuf, 1+idx2 ,                &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+
+           ELSE IF ( FieldType .EQ. WRF_FLOAT ) THEN
+
+             CALL wrf_gatherv_real ( Field, PatchStart(1)+idx , &
+                             my_count ,                       &    ! sendcount
+                             globbuf, 1+idx2 ,                &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+
+           ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+
+             CALL wrf_gatherv_integer ( Field, PatchStart(1)+idx , &
+                             my_count ,                       &    ! sendcount
+                             globbuf, 1+idx2 ,                &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+           ENDIF
+
+        enddo
+      ENDIF
+    CASE ( 'ysz', 'yez' )
+      distributed_field = .FALSE.
+      IF ( nproc .GT. 1 ) THEN
+        ids = DomainStart(1) ; ide = DomainEnd(1) ; IF ( .NOT. has_char( Stagger, 'y' ) ) ide = ide+1  ! ns strip
+        kds = DomainStart(2) ; kde = DomainEnd(2) ; IF ( .NOT. has_char( Stagger, 'z' ) ) kde = kde+1  ! levels
+        jds = DomainStart(3) ; jde = DomainEnd(3) ; !  bdy_width
+        dom_end_rev(1) = ide
+        dom_end_rev(2) = kde
+        dom_end_rev(3) = jde
+        distributed_field = .TRUE.
+        IF ( (MemOrd .eq. 'ysz' .AND. bdy_mask( P_YSB )) .OR.     &
+             (MemOrd .eq. 'yez' .AND. bdy_mask( P_YEB ))       ) THEN
+          my_displ = PatchStart(1)-1
+          my_count = PatchEnd(1)-PatchStart(1)+1
+        ELSE
+          my_displ = 0
+          my_count = 0
+        ENDIF
+        CALL mpi_gather( my_displ, 1, MPI_INTEGER, displs, 1, MPI_INTEGER, 0, communicator, ierr )
+        CALL mpi_gather( my_count, 1, MPI_INTEGER, counts, 1, MPI_INTEGER, 0, communicator, ierr )
+        do j = DomainStart(3),DomainEnd(3)    ! bdy_width
+        do k = DomainStart(2),DomainEnd(2)    ! levels
+           lx   = MemoryEnd(1)-MemoryStart(1)+1
+           lx2  = dom_end_rev(1)-DomainStart(1)+1
+           idx  = lx*((k-1)+(j-1)*(MemoryEnd(2)-MemoryStart(2)+1))
+           idx2 = lx2*((k-1)+(j-1)*(MemoryEnd(2)-MemoryStart(2)+1))
+
+           IF ( FieldType .EQ. WRF_DOUBLE ) THEN 
+
+             CALL wrf_gatherv_double ( Field, PatchStart(1)+idx ,      &    ! sendbuf
+                             my_count                       , &    ! sendcount
+                             globbuf, 1+idx2                , &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+
+           ELSE IF ( FieldType .EQ. WRF_FLOAT ) THEN
+
+             CALL wrf_gatherv_real( Field, PatchStart(1)+idx ,      &    ! sendbuf
+                             my_count                       , &    ! sendcount
+                             globbuf, 1+idx2                , &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+
+           ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+
+             CALL wrf_gatherv_integer( Field, PatchStart(1)+idx ,      &    ! sendbuf
+                             my_count                       , &    ! sendcount
+                             globbuf, 1+idx2                , &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+           ENDIF
+
+        enddo
+        enddo
+      ENDIF
+    CASE ( 'ys', 'ye' )
+      distributed_field = .FALSE.
+      IF ( nproc .GT. 1 ) THEN
+        ids = DomainStart(1) ; ide = DomainEnd(1) ; IF ( .NOT. has_char( Stagger, 'y' ) ) ide = ide+1  ! ns strip
+        jds = DomainStart(2) ; jde = DomainEnd(2) ; !  bdy_width
+        dom_end_rev(1) = ide
+        dom_end_rev(2) = jde
+        distributed_field = .TRUE.
+        IF ( (MemOrd .eq. 'ys' .AND. bdy_mask( P_YSB )) .OR.     &
+             (MemOrd .eq. 'ye' .AND. bdy_mask( P_YEB ))       ) THEN
+          my_displ = PatchStart(1)-1
+          my_count = PatchEnd(1)-PatchStart(1)+1
+        ELSE
+          my_displ = 0
+          my_count = 0
+        ENDIF
+        CALL mpi_gather( my_displ, 1, MPI_INTEGER, displs, 1, MPI_INTEGER, 0, communicator, ierr )
+        CALL mpi_gather( my_count, 1, MPI_INTEGER, counts, 1, MPI_INTEGER, 0, communicator, ierr )
+        do j = DomainStart(2),DomainEnd(2)    ! bdy_width
+           lx   = MemoryEnd(1)-MemoryStart(1)+1
+           idx  = lx*(j-1)
+           lx2  = dom_end_rev(1)-DomainStart(1)+1
+           idx2 = lx2*(j-1)
+
+           IF ( FieldType .EQ. WRF_DOUBLE ) THEN 
+
+             CALL wrf_gatherv_double( Field, PatchStart(1)+idx ,      &    ! sendbuf
+                             my_count                       , &    ! sendcount
+                             globbuf, 1+idx2                , &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+
+           ELSE IF ( FieldType .EQ. WRF_FLOAT ) THEN
+
+             CALL wrf_gatherv_real( Field, PatchStart(1)+idx ,      &    ! sendbuf
+                             my_count                       , &    ! sendcount
+                             globbuf, 1+idx2                , &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+
+           ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+
+             CALL wrf_gatherv_integer( Field, PatchStart(1)+idx ,      &    ! sendbuf
+                             my_count                       , &    ! sendcount
+                             globbuf, 1+idx2                , &    ! recvbuf
+                             counts                         , &    ! recvcounts
+                             displs                         , &    ! displs
+                             0                              , &    ! root
+                             communicator                   , &    ! communicator
+                             ierr )
+           ENDIF
+
+        enddo
+      ENDIF
+#endif
+#endif
+    CASE DEFAULT
+      distributed_field = .FALSE.
+  END SELECT
+  IF ( wrf_dm_on_monitor() ) THEN
+    IF ( distributed_field ) THEN
+      CALL fcn ( Hndl , DateStr , VarName , globbuf , FieldType , Comm , IOComm , &
+                 DomainDesc , MemoryOrder , Stagger , DimNames ,                  &
+                 DomainStart , DomainEnd ,                                        &
+                 DomainStart , dom_end_rev ,                                      &  ! memory dims adjust out for unstag
+                 DomainStart , DomainEnd ,                                        &
+                 Status )
+    ELSE
+      CALL fcn ( Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                 DomainDesc , MemoryOrder , Stagger , DimNames ,                  &
+                 DomainStart , DomainEnd ,                                        &
+                 MemoryStart , MemoryEnd ,                                        &
+                 PatchStart  , PatchEnd  ,                                        &
+                 Status )
+    ENDIF
+  ENDIF
+  CALL wrf_dm_bcast_bytes( Status , IWORDSIZE )
+  RETURN
+END SUBROUTINE collect_generic_and_call_pkg
+
+
+SUBROUTINE call_pkg_and_dist (       fcn, donotdist_arg, update_arg,                           &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , bdy_mask, MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The call_pkg_and_dist* routines call an I/O function to read a field and then 
+! distribute or replicate the field across compute tasks.  
+! This routine handle cases where distribution/replication can be skipped and 
+! deals with different data types for Field.
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  EXTERNAL fcn
+  LOGICAL,        INTENT(IN)    :: donotdist_arg, update_arg  ! update means collect old field update it and dist
+  INTEGER ,       INTENT(IN)    :: Hndl
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  INTEGER                          :: Field(*)
+  INTEGER                                      :: FieldType
+  INTEGER                                      :: Comm
+  INTEGER                                      :: IOComm
+  INTEGER                                      :: DomainDesc
+  LOGICAL, DIMENSION(4)                        :: bdy_mask
+  CHARACTER*(*)                                :: MemoryOrder
+  CHARACTER*(*)                                :: Stagger
+  CHARACTER*(*) , dimension (*)                :: DimNames
+  INTEGER ,dimension(*)                        :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)                        :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)                        :: PatchStart,  PatchEnd
+  INTEGER                                      :: Status
+  LOGICAL donotdist
+  INTEGER ndims, nproc
+
+  CALL dim_from_memorder( MemoryOrder , ndims)
+  CALL wrf_get_nproc( nproc )
+  donotdist = donotdist_arg .OR. (nproc .EQ. 1)
+
+  IF ( donotdist ) THEN
+    CALL fcn ( Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , MemoryOrder , Stagger , DimNames ,                &
+               DomainStart , DomainEnd ,                                      &
+               MemoryStart , MemoryEnd ,                                      &
+               PatchStart , PatchEnd ,                                        &
+               Status )
+
+  ELSE IF (FieldType .EQ. WRF_DOUBLE) THEN
+
+     CALL call_pkg_and_dist_double ( fcn, update_arg,                            &
+               Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+               DomainStart , DomainEnd ,                                    &
+               MemoryStart , MemoryEnd ,                                    &
+               PatchStart , PatchEnd ,                                      &
+               Status )
+
+  ELSE IF (FieldType .EQ. WRF_FLOAT) THEN
+
+     CALL call_pkg_and_dist_real ( fcn, update_arg,                            &
+               Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+               DomainStart , DomainEnd ,                                    &
+               MemoryStart , MemoryEnd ,                                    &
+               PatchStart , PatchEnd ,                                      &
+               Status )
+
+  ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+
+     CALL call_pkg_and_dist_int ( fcn, update_arg,                            &
+               Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+               DomainStart , DomainEnd ,                                    &
+               MemoryStart , MemoryEnd ,                                    &
+               PatchStart , PatchEnd ,                                      &
+               Status )
+
+  ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+
+     CALL call_pkg_and_dist_logical ( fcn, update_arg,                            &
+               Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+               DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+               DomainStart , DomainEnd ,                                    &
+               MemoryStart , MemoryEnd ,                                    &
+               PatchStart , PatchEnd ,                                      &
+               Status )
+
+  ENDIF
+  RETURN
+END SUBROUTINE call_pkg_and_dist
+
+SUBROUTINE call_pkg_and_dist_real (  fcn, update_arg,                                             &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The call_pkg_and_dist* routines call an I/O function to read a field and then 
+! distribute or replicate the field across compute tasks.  
+! The sole purpose of this wrapper is to allocate a big real buffer and
+! pass it down to call_pkg_and_dist_generic() to do the actual work.
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  EXTERNAL fcn
+  INTEGER ,       INTENT(IN)    :: Hndl
+  LOGICAL ,       INTENT(IN)    :: update_arg
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  REAL    ,       INTENT(INOUT)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(INOUT)   :: Status
+  REAL, ALLOCATABLE :: globbuf (:)
+  LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    ALLOCATE( globbuf( (DomainEnd(1)-DomainStart(1)+3)*(DomainEnd(2)-DomainStart(2)+3)*(DomainEnd(3)-DomainStart(3)+3) ) )
+  ELSE
+    ALLOCATE( globbuf( 1 ) )
+  ENDIF
+
+  globbuf = 0.
+  CALL call_pkg_and_dist_generic (   fcn, globbuf FRSTELEM , update_arg,                          &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+  DEALLOCATE ( globbuf )
+  RETURN
+END SUBROUTINE call_pkg_and_dist_real
+
+
+SUBROUTINE call_pkg_and_dist_double  (  fcn, update_arg ,                                            &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The call_pkg_and_dist* routines call an I/O function to read a field and then 
+! distribute or replicate the field across compute tasks.  
+! The sole purpose of this wrapper is to allocate a big double precision buffer 
+! and pass it down to call_pkg_and_dist_generic() to do the actual work.
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  EXTERNAL fcn
+  INTEGER ,       INTENT(IN)    :: Hndl
+  LOGICAL ,       INTENT(IN)    :: update_arg
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  DOUBLE PRECISION   ,       INTENT(INOUT)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(INOUT)   :: Status
+  DOUBLE PRECISION , ALLOCATABLE :: globbuf (:)
+  LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    ALLOCATE( globbuf( (DomainEnd(1)-DomainStart(1)+3)*(DomainEnd(2)-DomainStart(2)+3)*(DomainEnd(3)-DomainStart(3)+3) ) )
+  ELSE
+    ALLOCATE( globbuf( 1 ) )
+  ENDIF
+
+  globbuf = 0
+
+  CALL call_pkg_and_dist_generic (   fcn, globbuf FRSTELEM , update_arg ,                         &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+  DEALLOCATE ( globbuf )
+  RETURN
+END SUBROUTINE call_pkg_and_dist_double
+
+
+SUBROUTINE call_pkg_and_dist_int  (  fcn, update_arg ,                                            &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The call_pkg_and_dist* routines call an I/O function to read a field and then 
+! distribute or replicate the field across compute tasks.  
+! The sole purpose of this wrapper is to allocate a big integer buffer and 
+! pass it down to call_pkg_and_dist_generic() to do the actual work.
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  EXTERNAL fcn
+  INTEGER ,       INTENT(IN)    :: Hndl
+  LOGICAL ,       INTENT(IN)    :: update_arg
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  INTEGER    ,       INTENT(INOUT)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(INOUT)   :: Status
+  INTEGER , ALLOCATABLE :: globbuf (:)
+  LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    ALLOCATE( globbuf( (DomainEnd(1)-DomainStart(1)+3)*(DomainEnd(2)-DomainStart(2)+3)*(DomainEnd(3)-DomainStart(3)+3) ) )
+  ELSE
+    ALLOCATE( globbuf( 1 ) )
+  ENDIF
+
+  globbuf = 0
+
+  CALL call_pkg_and_dist_generic (   fcn, globbuf FRSTELEM , update_arg ,                                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+  DEALLOCATE ( globbuf )
+  RETURN
+END SUBROUTINE call_pkg_and_dist_int
+
+
+SUBROUTINE call_pkg_and_dist_logical  (  fcn, update_arg ,                                            &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+!<DESCRIPTION>
+!<PRE>
+! The call_pkg_and_dist* routines call an I/O function to read a field and then 
+! distribute or replicate the field across compute tasks.  
+! The sole purpose of this wrapper is to allocate a big logical buffer and 
+! pass it down to call_pkg_and_dist_generic() to do the actual work.
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  EXTERNAL fcn
+  INTEGER ,       INTENT(IN)    :: Hndl
+  LOGICAL ,       INTENT(IN)    :: update_arg
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  logical    ,       INTENT(INOUT)    :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(INOUT)   :: Status
+  LOGICAL , ALLOCATABLE :: globbuf (:)
+  LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    ALLOCATE( globbuf( (DomainEnd(1)-DomainStart(1)+3)*(DomainEnd(2)-DomainStart(2)+3)*(DomainEnd(3)-DomainStart(3)+3) ) )
+  ELSE
+    ALLOCATE( globbuf( 1 ) )
+  ENDIF
+
+  globbuf = .false.
+
+  CALL call_pkg_and_dist_generic (   fcn, globbuf FRSTELEM , update_arg ,                         &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+  DEALLOCATE ( globbuf )
+  RETURN
+END SUBROUTINE call_pkg_and_dist_logical
+
+SUBROUTINE call_pkg_and_dist_generic (   fcn, globbuf , update_arg ,                                  &
+                                     Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                                     DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                     DomainStart , DomainEnd ,                                    &
+                                     MemoryStart , MemoryEnd ,                                    &
+                                     PatchStart , PatchEnd ,                                      &
+                                     Status )
+
+!<DESCRIPTION>
+!<PRE>
+! The call_pkg_and_dist* routines call an I/O function to read a field and then 
+! distribute or replicate the field across compute tasks.  
+! This routine calls I/O function fcn to read the field from disk and then calls 
+! the distributed memory communication routines that distribute or replicate the 
+! array.  
+!</PRE>
+!</DESCRIPTION>
+  USE module_driver_constants
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  EXTERNAL fcn
+  REAL, DIMENSION(*) ::  globbuf
+  INTEGER ,       INTENT(IN)    :: Hndl
+  LOGICAL ,       INTENT(IN)    :: update_arg
+  CHARACTER*(*) :: DateStr
+  CHARACTER*(*) :: VarName
+  REAL                           :: Field(*)
+  INTEGER                       ,INTENT(IN)    :: FieldType
+  INTEGER                       ,INTENT(INOUT) :: Comm
+  INTEGER                       ,INTENT(INOUT) :: IOComm
+  INTEGER                       ,INTENT(IN)    :: DomainDesc
+  CHARACTER*(*)                 ,INTENT(IN)    :: MemoryOrder
+  CHARACTER*(*)                 ,INTENT(IN)    :: Stagger
+  CHARACTER*(*) , dimension (*) ,INTENT(IN)    :: DimNames
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: DomainStart, DomainEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
+  INTEGER ,dimension(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
+  INTEGER                       ,INTENT(OUT)   :: Status
+  CHARACTER*3 MemOrd
+  LOGICAL, EXTERNAL :: has_char
+  INTEGER ids, ide, jds, jde, kds, kde
+  INTEGER ims, ime, jms, jme, kms, kme
+  INTEGER ips, ipe, jps, jpe, kps, kpe
+  INTEGER , dimension(3)                       :: dom_end_rev
+  INTEGER memsize
+  LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+  LOGICAL distributed_field
+
+  CALL lower_case( MemoryOrder, MemOrd )
+
+  dom_end_rev(1) = DomainEnd(1)
+  dom_end_rev(2) = DomainEnd(2)
+  dom_end_rev(3) = DomainEnd(3)
+
+  SELECT CASE (TRIM(MemOrd))
+    CASE (  'xzy' )
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'z' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(3) = dom_end_rev(3) + 1
+    CASE (  'zxy' )
+      IF ( .NOT. has_char( Stagger, 'z' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(3) = dom_end_rev(3) + 1
+    CASE (  'xyz' )
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+      IF ( .NOT. has_char( Stagger, 'z' ) ) dom_end_rev(3) = dom_end_rev(3) + 1
+    CASE (  'xy' )
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+    CASE (  'yxz' )
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+      IF ( .NOT. has_char( Stagger, 'z' ) ) dom_end_rev(3) = dom_end_rev(3) + 1
+    CASE (  'yx' )
+      IF ( .NOT. has_char( Stagger, 'y' ) ) dom_end_rev(1) = dom_end_rev(1) + 1
+      IF ( .NOT. has_char( Stagger, 'x' ) ) dom_end_rev(2) = dom_end_rev(2) + 1
+    CASE DEFAULT
+      ! do nothing; the boundary orders and others either dont care or set themselves
+  END SELECT
+
+  SELECT CASE (MemOrd)
+    CASE ( 'xzy' )
+      distributed_field = .TRUE.
+    CASE ( 'xyz' )
+      distributed_field = .TRUE.
+    CASE ( 'yxz' )
+      distributed_field = .TRUE.
+    CASE ( 'zxy' )
+      distributed_field = .TRUE.
+    CASE ( 'xy' )
+      distributed_field = .TRUE.
+    CASE ( 'yx' )
+      distributed_field = .TRUE.
+    CASE DEFAULT
+      ! all other memory orders are replicated
+      distributed_field = .FALSE.
+  END SELECT
+
+  IF ( distributed_field ) THEN
+
+! added 8/2004 for interfaces, like MCEL, that want the old values so they can be updated
+    IF ( update_arg ) THEN
+      SELECT CASE (TRIM(MemOrd))
+        CASE (  'xzy','zxy','xyz','yxz','xy','yx' )
+          IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+            CALL wrf_patch_to_global_double ( Field  , globbuf , DomainDesc, Stagger, MemOrd ,             &
+               DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+               MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+               PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3) )
+          ELSE IF (  FieldType .EQ. WRF_FLOAT ) THEN
+            CALL wrf_patch_to_global_real ( Field  , globbuf , DomainDesc, Stagger, MemOrd ,             &
+               DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+               MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+               PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3) )
+          ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+            CALL wrf_patch_to_global_integer ( Field  , globbuf , DomainDesc, Stagger, MemOrd ,             &
+               DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+               MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+               PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3) )
+          ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+            CALL wrf_patch_to_global_logical ( Field  , globbuf , DomainDesc, Stagger, MemOrd ,             &
+               DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+               MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+               PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3) )
+          ENDIF
+        CASE DEFAULT
+      END SELECT
+    ENDIF
+
+    IF ( wrf_dm_on_monitor()) THEN
+      CALL fcn ( Hndl , DateStr , VarName , globbuf , FieldType , Comm , IOComm , &
+                 DomainDesc , MemoryOrder , Stagger , DimNames ,                  &
+                 DomainStart , DomainEnd ,                                        &
+                 DomainStart , dom_end_rev ,                                        &
+                 DomainStart , DomainEnd ,                                          &
+                 Status )
+
+    ENDIF
+
+    CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+  
+    CALL lower_case( MemoryOrder, MemOrd )
+    IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+
+      SELECT CASE (MemOrd)
+      CASE ( 'xzy','xyz','yxz','zxy' )
+        CALL wrf_global_to_patch_double (  globbuf,  Field  , DomainDesc, Stagger, MemOrd ,    &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3)  )
+      CASE ( 'xy','yx' )
+        CALL wrf_global_to_patch_double (  globbuf, Field ,  DomainDesc, Stagger, MemOrd ,  &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), 1            , 1 , &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), 1            , 1 , &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , 1            , 1   )
+      END SELECT
+
+    ELSE IF ( FieldType .EQ. WRF_FLOAT ) THEN
+
+      SELECT CASE (MemOrd)
+      CASE ( 'xzy','xyz','yxz','zxy' )
+        CALL wrf_global_to_patch_real (  globbuf,  Field  , DomainDesc, Stagger, MemOrd ,    &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3)  )
+      CASE ( 'xy','yx' )
+        CALL wrf_global_to_patch_real (  globbuf, Field ,  DomainDesc, Stagger, MemOrd ,  &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), 1            , 1 , &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), 1            , 1 , &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , 1            , 1   )
+      END SELECT
+
+    ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+
+      SELECT CASE (MemOrd)
+      CASE ( 'xzy','xyz','yxz','zxy' )
+        CALL wrf_global_to_patch_integer (  globbuf,  Field  , DomainDesc, Stagger, MemOrd ,    &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3)  )
+      CASE ( 'xy','yx' )
+        CALL wrf_global_to_patch_integer (  globbuf, Field ,  DomainDesc, Stagger, MemOrd ,  &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), 1            , 1 , &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), 1            , 1 , &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , 1            , 1   )
+      END SELECT
+
+    ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+
+      SELECT CASE (MemOrd)
+      CASE ( 'xzy','xyz','yxz','zxy' )
+        CALL wrf_global_to_patch_logical (  globbuf,  Field  , DomainDesc, Stagger, MemOrd ,    &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), DomainStart(3), DomainEnd(3), &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), MemoryStart(3), MemoryEnd(3), &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , PatchStart(3) , PatchEnd(3)  )
+      CASE ( 'xy','yx' )
+        CALL wrf_global_to_patch_logical (  globbuf, Field ,  DomainDesc, Stagger, MemOrd ,  &
+           DomainStart(1), DomainEnd(1), DomainStart(2), DomainEnd(2), 1            , 1 , &
+           MemoryStart(1), MemoryEnd(1), MemoryStart(2), MemoryEnd(2), 1            , 1 , &
+           PatchStart(1) , PatchEnd(1) , PatchStart(2) , PatchEnd(2) , 1            , 1   )
+      END SELECT
+
+    ENDIF
+  ELSE
+    IF ( wrf_dm_on_monitor()) THEN
+      CALL fcn ( Hndl , DateStr , VarName , Field   , FieldType , Comm , IOComm , &
+                 DomainDesc , MemoryOrder , Stagger , DimNames ,                  &
+                 DomainStart , DomainEnd ,                                        &
+                 MemoryStart , MemoryEnd ,                                        &
+                 PatchStart  , PatchEnd  ,                                        &
+                 Status )
+    ENDIF
+    CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
+    memsize = (MemoryEnd(1)-MemoryStart(1)+1)*(MemoryEnd(2)-MemoryStart(2)+1)*(MemoryEnd(3)-MemoryStart(3)+1)
+    IF ( FieldType .EQ. WRF_DOUBLE ) THEN 
+      CALL wrf_dm_bcast_bytes( Field , DWORDSIZE*memsize )
+    ELSE IF ( FieldType .EQ. WRF_FLOAT) THEN
+      CALL wrf_dm_bcast_bytes( Field , RWORDSIZE*memsize )
+    ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+      CALL wrf_dm_bcast_bytes( Field , IWORDSIZE*memsize )
+    ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+      CALL wrf_dm_bcast_bytes( Field , LWORDSIZE*memsize )
+    ENDIF
+  ENDIF
+
+
+  RETURN
+END SUBROUTINE call_pkg_and_dist_generic
+
+!!!!!!  Miscellaneous routines
+
+! stole these routines from io_netcdf external package; changed names to avoid collisions
+SUBROUTINE dim_from_memorder(MemoryOrder,NDim)
+!<DESCRIPTION>
+!<PRE>
+! Decodes array ranks from memory order.  
+!</PRE>
+!</DESCRIPTION>
+  CHARACTER*(*) ,INTENT(IN)  :: MemoryOrder
+  INTEGER       ,INTENT(OUT) :: NDim
+!Local
+  CHARACTER*3                :: MemOrd
+!
+  CALL Lower_Case(MemoryOrder,MemOrd)
+  SELECT CASE (MemOrd)
+    CASE ('xyz','xzy','yxz','yzx','zxy','zyx')
+      NDim = 3
+    CASE ('xy','yx')
+      NDim = 2
+    CASE ('z','c','0')
+      NDim = 1
+    CASE DEFAULT
+      NDim = 0
+      RETURN
+  END SELECT
+  RETURN
+END SUBROUTINE dim_from_memorder
+
+SUBROUTINE lower_case(MemoryOrder,MemOrd)
+!<DESCRIPTION>
+!<PRE>
+! Translates upper-case characters to lower-case.  
+!</PRE>
+!</DESCRIPTION>
+  CHARACTER*(*) ,INTENT(IN)  :: MemoryOrder
+  CHARACTER*(*) ,INTENT(OUT) :: MemOrd
+!Local
+  CHARACTER*1                :: c
+  INTEGER       ,PARAMETER   :: upper_to_lower =IACHAR('a')-IACHAR('A')
+  INTEGER                    :: i,n
+!
+  MemOrd = ' '
+  N = len(MemoryOrder)
+  MemOrd(1:N) = MemoryOrder(1:N)
+  DO i=1,N
+    c = MemoryOrder(i:i)
+    if('A'<=c .and. c <='Z') MemOrd(i:i)=achar(iachar(c)+upper_to_lower)
+  ENDDO
+  RETURN
+END SUBROUTINE Lower_Case
+
+LOGICAL FUNCTION has_char( str, c )
+!<DESCRIPTION>
+!<PRE>
+! Returns .TRUE. iff string str contains character c.  Ignores character case.  
+!</PRE>
+!</DESCRIPTION>
+  IMPLICIT NONE
+  CHARACTER*(*) str
+  CHARACTER c, d
+  CHARACTER*80 str1, str2, str3
+  INTEGER i
+
+  CALL lower_case( TRIM(str), str1 )
+  str2 = ""
+  str2(1:1) = c
+  CALL lower_case( str2, str3 )
+  d = str3(1:1)
+  DO i = 1, LEN(TRIM(str1))
+    IF ( str1(i:i) .EQ. d ) THEN
+      has_char = .TRUE.
+      RETURN
+    ENDIF
+  ENDDO
+  has_char = .FALSE.
+  RETURN
+END FUNCTION has_char
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_io_quilt.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_io_quilt.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_io_quilt.F	(revision 2744)
@@ -0,0 +1,3261 @@
+!WRF:DRIVER_LAYER:IO
+!
+#define DEBUG_LVL 50
+!#define mpi_x_comm_size(i,j,k)  Mpi_Comm_Size ( i,j,k ) ; write(0,*) __LINE__
+#define mpi_x_comm_size(i,j,k)  Mpi_Comm_Size ( i,j,k )
+
+MODULE module_wrf_quilt
+!<DESCRIPTION>
+!<PRE>
+! This module contains WRF-specific I/O quilt routines called by both 
+! client (compute) and server (I/O quilt) tasks.  I/O quilt servers are 
+! a run-time optimization that allow I/O operations, executed on the I/O 
+! quilt server tasks, to be overlapped with useful computation, executed on 
+! the compute tasks.  Since I/O operations are often quite slow compared to 
+! computation, this performance optimization can increase parallel 
+! efficiency.  
+!
+! Currently, one group of I/O servers can be specified at run-time.  Namelist 
+! variable "nio_tasks_per_group" is used to specify the number of I/O server 
+! tasks in this group.  In most cases, parallel efficiency is optimized when 
+! the minimum number of I/O server tasks are used.  If memory needed to cache 
+! I/O operations fits on a single processor, then set nio_tasks_per_group=1.  
+! If not, increase the number of I/O server tasks until I/O operations fit in 
+! memory.  In the future, multiple groups of I/O server tasks will be 
+! supported.  The number of groups will be specified by namelist variable 
+! "nio_groups".  For now, nio_groups must be set to 1.  Currently, I/O servers 
+! only support overlap of output operations with computation.  Also, only I/O 
+! packages that do no support native parallel I/O may be used with I/O server 
+! tasks.  This excludes PHDF5 and MCEL.  
+!
+! In this module, the I/O quilt server tasks call package-dependent 
+! WRF-specific I/O interfaces to perform I/O operations requested by the 
+! client (compute) tasks.  All of these calls occur inside subroutine 
+! quilt().  
+! 
+! The client (compute) tasks call package-independent WRF-specific "quilt I/O" 
+! interfaces that send requests to the I/O quilt servers.  All of these calls 
+! are made from module_io.F.  
+!
+! These routines have the same names and (roughly) the same arguments as those 
+! specified in the WRF I/O API except that:
+! - "Quilt I/O" routines defined in this file and called by routines in 
+!   module_io.F have the "wrf_quilt_" prefix.
+! - Package-dependent routines called from routines in this file are defined 
+!   in the external I/O packages and have the "ext_" prefix.
+!
+! Both client (compute) and server tasks call routine init_module_wrf_quilt() 
+! which then calls setup_quilt_servers() determine which tasks are compute 
+! tasks and which are server tasks.  Before the end of init_module_wrf_quilt() 
+! server tasks call routine quilt() and remain there for the rest of the model 
+! run.  Compute tasks return from init_module_wrf_quilt() to perform model 
+! computations.  
+!
+! See http://www.mmm.ucar.edu/wrf/WG2/software_2.0/IOAPI.doc for the latest
+! version of the WRF I/O API.  This document includes detailed descriptions
+! of subroutines and their arguments that are not duplicated here.
+!</PRE>
+!</DESCRIPTION>
+  USE module_internal_header_util
+  USE module_timing
+
+  INTEGER, PARAMETER :: int_num_handles = 99
+  LOGICAL, DIMENSION(int_num_handles) :: okay_to_write, int_handle_in_use, okay_to_commit
+  INTEGER, DIMENSION(int_num_handles) :: int_num_bytes_to_write, io_form
+  REAL, POINTER    :: int_local_output_buffer(:)
+  INTEGER          :: int_local_output_cursor
+  LOGICAL          :: quilting_enabled
+  LOGICAL          :: disable_quilt = .FALSE.
+  INTEGER          :: prev_server_for_handle = -1
+  INTEGER          :: server_for_handle(int_num_handles)
+  INTEGER          :: reduced(2), reduced_dummy(2)
+  LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+  INTEGER nio_groups
+#ifdef DM_PARALLEL
+  INTEGER mpi_comm_local
+  INTEGER mpi_comm_io_groups(100)
+  INTEGER nio_tasks_in_group
+  INTEGER nio_tasks_per_group
+  INTEGER ncompute_tasks
+  INTEGER ntasks
+  INTEGER mytask
+
+  INTEGER, PARAMETER           :: onebyte = 1
+  INTEGER comm_io_servers, iserver, hdrbufsize, obufsize
+  INTEGER, DIMENSION(4096)     :: hdrbuf
+  INTEGER, DIMENSION(int_num_handles)     :: handle
+#endif
+
+  CONTAINS
+
+#if  defined(DM_PARALLEL)  &&  !defined( STUBMPI )
+    INTEGER FUNCTION get_server_id ( dhandle )
+!<DESCRIPTION>
+! Logic in the client side to know which io server
+! group to send to. If the unit corresponds to a file that's
+! already been opened, then we have no choice but to send the
+! data to that group again, regardless of whether there are
+! other server-groups. If it's a new file, we can chose a new
+! server group. I.e. opening a file locks it onto a server
+! group. Closing the file unlocks it.
+!</DESCRIPTION>
+      IMPLICIT NONE
+      INTEGER, INTENT(IN) :: dhandle
+      IF ( dhandle .GE. 1 .AND. dhandle .LE. int_num_handles ) THEN
+        IF ( server_for_handle ( dhandle ) .GE. 1 ) THEN
+          get_server_id = server_for_handle ( dhandle )
+        ELSE
+          prev_server_for_handle = mod ( prev_server_for_handle + 1 , nio_groups )
+          server_for_handle( dhandle ) = prev_server_for_handle+1
+          get_server_id = prev_server_for_handle+1
+        ENDIF
+      ELSE
+         CALL wrf_message('module_io_quilt: get_server_id bad dhandle' )
+      ENDIF
+    END FUNCTION get_server_id
+#endif
+
+    SUBROUTINE set_server_id ( dhandle, value )
+       IMPLICIT NONE
+       INTEGER, INTENT(IN) :: dhandle, value
+       IF ( dhandle .GE. 1 .AND. dhandle .LE. int_num_handles ) THEN
+         server_for_handle(dhandle) = value
+       ELSE
+         CALL wrf_message('module_io_quilt: set_server_id bad dhandle' )
+       ENDIF
+    END SUBROUTINE set_server_id
+
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+    SUBROUTINE int_get_fresh_handle( retval )
+!<DESCRIPTION>
+! Find an unused "client file handle" and return it in retval.
+! The "client file handle" is used to remember how a file was opened
+! so clients do not need to ask the I/O quilt servers for this information.
+! It is also used as a file identifier in communications with the I/O
+! server task.
+!
+! Note that client tasks know nothing about package-specific handles.
+! Only the I/O quilt servers know about them.
+!</DESCRIPTION>
+      INTEGER i, retval
+      retval = -1
+      DO i = 1, int_num_handles
+        IF ( .NOT. int_handle_in_use(i) )  THEN
+          retval = i
+          GOTO 33
+        ENDIF
+      ENDDO
+33    CONTINUE
+      IF ( retval < 0 )  THEN
+        CALL wrf_error_fatal("frame/module_io_quilt.F: int_get_fresh_handle() can not")
+      ENDIF
+      int_handle_in_use(i) = .TRUE.
+      NULLIFY ( int_local_output_buffer )
+    END SUBROUTINE int_get_fresh_handle
+
+    SUBROUTINE setup_quilt_servers ( nio_tasks_per_group,     &
+                                     mytask,                  &
+                                     ntasks,                  &
+                                     n_groups_arg,            &
+                                     nio,                     &
+                                     mpi_comm_wrld,           &
+                                     mpi_comm_local,          &
+                                     mpi_comm_io_groups)
+!<DESCRIPTION>
+! Both client (compute) and server tasks call this routine to 
+! determine which tasks are compute tasks and which are I/O server tasks.  
+!
+! Module variables MPI_COMM_LOCAL and MPI_COMM_IO_GROUPS(:) are set up to 
+! contain MPI communicators as follows:  
+!
+! MPI_COMM_LOCAL is the Communicator for the local groups of tasks. For the 
+! compute tasks it is the group of compute tasks; for a server group it the 
+! communicator of tasks in the server group.
+!
+! Elements of MPI_COMM_IO_GROUPS are communicators that each contain one or 
+! more compute tasks and a single I/O server assigned to those compute tasks.  
+! The I/O server tasks is always the last task in these communicators.  
+! On a compute task, which has a single associate in each of the server 
+! groups, MPI_COMM_IO_GROUPS is treated as an array; each element corresponds 
+! to a different server group. 
+! On a server task only the first element of MPI_COMM_IO_GROUPS is used 
+! because each server task is part of only one io_group.  
+!
+! I/O server tasks in each I/O server group are divided among compute tasks as 
+! evenly as possible.  
+!
+! When multiple I/O server groups are used, each must have the same number of 
+! tasks.  When the total number of extra I/O tasks does not divide evenly by 
+! the number of io server groups requested, the remainder tasks are not used 
+! (wasted).  
+!
+! For example, communicator membership for 18 tasks with nio_groups=2 and 
+! nio_tasks_per_group=3 is shown below:  
+!
+!<PRE>
+! Membership for MPI_COMM_LOCAL communicators:
+!   COMPUTE TASKS:          0   1   2   3   4   5   6   7   8   9  10  11
+!   1ST I/O SERVER GROUP:  12  13  14
+!   2ND I/O SERVER GROUP:  15  16  17
+!
+! Membership for MPI_COMM_IO_GROUPS(1):  
+!   COMPUTE TASKS 0, 3, 6, 9:   0   3   6   9  12
+!   COMPUTE TASKS 1, 4, 7,10:   1   4   7  10  13
+!   COMPUTE TASKS 2, 5, 8,11:   2   5   8  11  14
+!   I/O SERVER TASK       12:   0   3   6   9  12
+!   I/O SERVER TASK       13:   1   4   7  10  13
+!   I/O SERVER TASK       14:   2   5   8  11  14
+!   I/O SERVER TASK       15:   0   3   6   9  15
+!   I/O SERVER TASK       16:   1   4   7  10  16
+!   I/O SERVER TASK       17:   2   5   8  11  17
+!
+! Membership for MPI_COMM_IO_GROUPS(2):  
+!   COMPUTE TASKS 0, 3, 6, 9:   0   3   6   9  15
+!   COMPUTE TASKS 1, 4, 7,10:   1   4   7  10  16
+!   COMPUTE TASKS 2, 5, 8,11:   2   5   8  11  17
+!   I/O SERVER TASK       12:  ** not used **
+!   I/O SERVER TASK       13:  ** not used **
+!   I/O SERVER TASK       14:  ** not used **
+!   I/O SERVER TASK       15:  ** not used **
+!   I/O SERVER TASK       16:  ** not used **
+!   I/O SERVER TASK       17:  ** not used **
+!</PRE>
+!</DESCRIPTION>
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER,                      INTENT(IN)  :: nio_tasks_per_group, mytask, ntasks, &
+                                                   n_groups_arg, mpi_comm_wrld
+      INTEGER,  INTENT(OUT)                     :: mpi_comm_local, nio
+      INTEGER, DIMENSION(100),      INTENT(OUT) :: mpi_comm_io_groups
+! Local
+      INTEGER                     :: i, j, ii, comdup, ierr, niotasks, n_groups, iisize
+      INTEGER, DIMENSION(ntasks)  :: icolor
+      CHARACTER*128 mess
+
+      n_groups = n_groups_arg
+      IF ( n_groups .LT. 1 ) n_groups = 1
+
+!<DESCRIPTION>
+! nio is number of io tasks per group.  If there arent enough tasks to satisfy
+! the requirement that there be at least as many compute tasks as io tasks in
+! each group, then just print a warning and dump out of quilting
+!</DESCRIPTION>
+
+      nio = nio_tasks_per_group
+      ncompute_tasks = ntasks - (nio * n_groups)
+      IF ( ncompute_tasks .LT. nio ) THEN 
+        WRITE(mess,'("Not enough tasks to have ",I3," groups of ",I3," I/O tasks. No quilting.")')n_groups,nio
+        nio            = 0
+        ncompute_tasks = ntasks
+      ELSE                                   
+        WRITE(mess,'("Quilting with ",I3," groups of ",I3," I/O tasks.")')n_groups,nio
+      ENDIF                                   
+      CALL wrf_message(mess)
+    
+      IF ( nio .LT. 0 ) THEN
+        nio = 0
+      ENDIF
+      IF ( nio .EQ. 0 ) THEN
+        quilting_enabled = .FALSE.
+        mpi_comm_local = MPI_COMM_WORLD
+        mpi_comm_io_groups = MPI_COMM_WORLD
+        RETURN
+      ENDIF
+      quilting_enabled = .TRUE.
+
+! First construct the local communicators
+! prepare to split the communicator by designating compute-only tasks
+      DO i = 1, ncompute_tasks
+        icolor(i) = 0
+      ENDDO
+      ii = 1
+! and designating the groups of i/o tasks
+      DO i = ncompute_tasks+1, ntasks, nio
+        DO j = i, i+nio-1
+          icolor(j) = ii
+        ENDDO
+        ii = ii+1
+      ENDDO
+      CALL MPI_Comm_dup(mpi_comm_wrld,comdup,ierr)
+      CALL MPI_Comm_split(comdup,icolor(mytask+1),mytask,mpi_comm_local,ierr)
+
+! Now construct the communicators for the io_groups; round-robining the compute tasks
+      DO i = 1, ncompute_tasks
+        icolor(i) = mod(i-1,nio)
+      ENDDO
+! ... and add the io servers as the last task in each group
+      DO j = 1, n_groups
+        ! TBH:  each I/O group will contain only one I/O server
+        DO i = ncompute_tasks+1,ntasks
+          icolor(i) = MPI_UNDEFINED
+        ENDDO
+        ii = 0
+        DO i = ncompute_tasks+(j-1)*nio+1,ncompute_tasks+j*nio
+          icolor(i) = ii
+          ii = ii+1
+        ENDDO
+        CALL MPI_Comm_dup(mpi_comm_wrld,comdup,ierr)
+        CALL MPI_Comm_split(comdup,icolor(mytask+1),mytask,mpi_comm_io_groups(j),ierr)
+!CALL MPI_Comm_Size( mpi_comm_io_groups(j) , iisize, ierr )
+      ENDDO
+! If I am an I/O server, figure out which group I'm in and make that group's
+! communicator the first element in the mpi_comm_io_groups array (I will ignore
+! all of the other elements).
+      IF ( mytask+1 .GT. ncompute_tasks ) THEN
+        niotasks = ntasks - ncompute_tasks
+        i = mytask - ncompute_tasks
+        j = i / nio + 1
+        mpi_comm_io_groups(1) = mpi_comm_io_groups(j)
+      ENDIF
+
+    END SUBROUTINE setup_quilt_servers
+
+    SUBROUTINE quilt
+!<DESCRIPTION>
+! I/O server tasks call this routine and remain in it for the rest of the 
+! model run.  I/O servers receive I/O requests from compute tasks and 
+! perform requested I/O operations by calling package-dependent WRF-specific 
+! I/O interfaces.  Requests are sent in the form of "data headers".  Each 
+! request has a unique "header" message associated with it.  For requests that 
+! contain large amounts of data, the data is appended to the header.  See 
+! file module_internal_header_util.F for detailed descriptions of all 
+! headers.  
+!
+! We wish to be able to link to different packages depending on whether
+! the I/O is restart, initial, history, or boundary.
+!</DESCRIPTION>
+      USE module_state_description
+      USE module_quilt_outbuf_ops
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+#include "intio_tags.h"
+#include "wrf_io_flags.h"
+      INTEGER itag, ninbuf, ntasks_io_group, ntasks_local_group, mytask_local, ierr
+      INTEGER istat
+      INTEGER mytask_io_group
+      INTEGER   :: nout_set = 0
+      INTEGER   :: obufsize, bigbufsize, inttypesize, chunksize, sz
+      REAL, DIMENSION(1)      :: dummy
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: obuf, bigbuf
+      REAL,    ALLOCATABLE, DIMENSION(:) :: RDATA
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IDATA
+      CHARACTER (LEN=512) :: CDATA
+      CHARACTER (LEN=80) :: fname
+      INTEGER icurs, hdrbufsize, itypesize, ftypesize, Status, fstat, io_form_arg
+      INTEGER :: DataHandle, FieldType, Comm, IOComm, DomainDesc, code, Count
+      INTEGER, DIMENSION(3) :: DomainStart , DomainEnd , MemoryStart , MemoryEnd , PatchStart , PatchEnd
+      INTEGER :: dummybuf(1)
+      CHARACTER (len=80) :: DateStr , Element, VarName, MemoryOrder , Stagger , DimNames(3), FileName, SysDepInfo, mess
+      INTEGER, EXTERNAL :: use_package
+      LOGICAL           :: stored_write_record, retval
+      INTEGER iii, jjj, vid
+
+!
+
+! Call ext_pkg_ioinit() routines to initialize I/O packages.  
+      SysDepInfo = " "
+#ifdef NETCDF
+      CALL ext_ncd_ioinit( SysDepInfo, ierr)
+#endif
+#ifdef INTIO
+      CALL ext_int_ioinit( SysDepInfo, ierr )
+#endif
+#ifdef XXX
+      CALL ext_xxx_ioinit( SysDepInfo, ierr)
+#endif
+#ifdef YYY
+      CALL ext_yyy_ioinit( SysDepInfo, ierr)
+#endif
+#ifdef ZZZ
+      CALL ext_zzz_ioinit( SysDepInfo, ierr)
+#endif
+#ifdef GRIB1
+      CALL ext_gr1_ioinit( SysDepInfo, ierr)
+#endif
+#ifdef GRIB2
+      CALL ext_gr2_ioinit( SysDepInfo, ierr)
+#endif
+
+      okay_to_commit = .false.
+      stored_write_record = .false.
+      ninbuf = 0
+      ! get info. about the I/O server group that this I/O server task
+      ! belongs to
+      ! Last task in this I/O server group is the I/O server "root"
+      ! The I/O server "root" actually writes data to disk
+      ! TBH:  WARNING:  This is also implicit in the call to collect_on_comm().
+      CALL mpi_x_comm_size( mpi_comm_io_groups(1), ntasks_io_group,    ierr )
+      CALL MPI_COMM_RANK( mpi_comm_io_groups(1), mytask_io_group,    ierr )
+      CALL mpi_x_comm_size( mpi_comm_local,        ntasks_local_group, ierr )
+      CALL MPI_COMM_RANK( mpi_comm_local,        mytask_local,       ierr )
+
+      CALL MPI_TYPE_SIZE( MPI_INTEGER, inttypesize, ierr )
+      IF ( inttypesize <= 0 ) THEN
+        CALL wrf_error_fatal("external/RSL/module_dm.F: quilt: type size <= 0 invalid")
+      ENDIF
+! infinite loop until shutdown message received
+! This is the main request-handling loop.  I/O quilt servers stay in this loop 
+! until the model run ends.  
+      DO WHILE (.TRUE.)
+
+!<DESCRIPTION>
+! Each I/O server receives requests from its compute tasks.  Each request
+! is contained in a data header (see module_internal_header_util.F for
+! detailed descriptions of data headers).
+! Each request is sent in two phases.  First, sizes of all messages that 
+! will be sent from the compute tasks to this I/O server are summed on the 
+! I/O server via MPI_reduce().  The I/O server then allocates buffer "obuf" 
+! and receives concatenated messages from the compute tasks in it via the 
+! call to collect_on_comm().  Note that "sizes" are generally expressed in 
+! *bytes* in this code so conversion to "count" (number of Fortran words) is 
+! required for Fortran indexing and MPI calls.  
+!</DESCRIPTION>
+        ! wait for info from compute tasks in the I/O group that we're ready to rock
+        ! obufsize will contain number of *bytes*
+!JMTIMINGCALL start_timing
+        ! first element of reduced is obufsize, second is DataHandle 
+        ! if needed (currently needed only for ioclose).
+        reduced_dummy = 0
+        CALL MPI_Reduce( reduced_dummy, reduced, 2, MPI_INTEGER,  &
+                         MPI_SUM, mytask_io_group,          &
+                         mpi_comm_io_groups(1), ierr )
+        obufsize = reduced(1)
+!JMTIMING CALL end_timing("MPI_Reduce at top of forever loop") 
+!JMDEBUGwrite(0,*)'obufsize = ',obufsize
+!write(0,*)'ninbuf ',ninbuf,' obufsize ', obufsize
+! Negative obufsize will trigger I/O server exit.  
+        IF ( obufsize .LT. 0 ) THEN
+          IF ( obufsize .EQ. -100 ) THEN         ! magic number
+#ifdef NETCDF
+            CALL ext_ncd_ioexit( Status )
+#endif
+#ifdef INTIO
+            CALL ext_int_ioexit( Status )
+#endif
+#ifdef XXX
+            CALL ext_xxx_ioexit( Status )
+#endif
+#ifdef YYY
+            CALL ext_yyy_ioexit( Status )
+#endif
+#ifdef ZZZ
+            CALL ext_zzz_ioexit( Status )
+#endif
+#ifdef GRIB1
+            CALL ext_gr1_ioexit( Status )
+#endif
+#ifdef GRIB2
+            CALL ext_gr2_ioexit( Status )
+#endif
+            CALL wrf_message ( 'I/O QUILT SERVERS DONE' )
+            CALL mpi_finalize(ierr)
+            STOP
+          ELSE
+            CALL wrf_error_fatal('Possible 32-bit overflow on output server. Try larger nio_tasks_per_group in namelist.')
+          ENDIF
+        ENDIF
+
+!JMTIMING        CALL start_timing
+! Obufsize of zero signals a close
+
+! Allocate buffer obuf to be big enough for the data the compute tasks
+! will send.  Note: obuf is size in *bytes* so we need to pare this 
+! down, since the buffer is INTEGER.  
+        IF ( obufsize .GT. 0 ) THEN
+          ALLOCATE( obuf( (obufsize+1)/inttypesize ) )
+
+! let's roll; get the data from the compute procs and put in obuf
+          CALL collect_on_comm( mpi_comm_io_groups(1),        &
+                                onebyte,                      &
+                                dummy, 0,                     &
+                                obuf, obufsize )
+!JMTIMING           CALL end_timing( "quilt on server: collecting data from compute procs" )
+        ELSE
+          ! Necessarily, the compute processes send the ioclose signal,
+          ! if there is one, after the iosync, which means they 
+          ! will stall on the ioclose message waiting for the quilt 
+          ! processes if we handle the way other messages are collected,
+          ! using collect_on_comm.  This avoids this, but we need
+          ! a special signal (obufsize zero) and the DataHandle
+          ! to be closed. That handle is send as the second
+          ! word of the io_close message received by the MPI_Reduce above.
+          ! Then a header representing the ioclose message is constructed
+          ! here and handled below as if it were received from the 
+          ! compute processes. The clients (compute processes) must be
+          ! careful to send this correctly (one compule process sends the actual
+          ! handle and everone else sends a zero, so the result sums to 
+          ! the value of the handle).
+          !
+          ALLOCATE( obuf( 4096 ) )
+          ! DataHandle is provided as second element of reduced
+          CALL int_gen_handle_header( obuf, obufsize, itypesize, &
+                                      reduced(2) , int_ioclose )
+
+        ENDIF
+
+!write(0,*)'calling init_store_piece_of_field'
+! Now all messages received from the compute clients are stored in 
+! obuf.  Scan through obuf and extract headers and field data and store in 
+! internal buffers.  The scan is done twice, first to determine sizes of 
+! internal buffers required for storage of headers and fields and second to 
+! actually store the headers and fields.  This bit of code does not do the 
+! "quilting" (assembly of patches into full domains).  For each field, it 
+! simply concatenates all received patches for the field into a separate 
+! internal buffer (i.e. one buffer per field).  Quilting is done later by 
+! routine store_patch_in_outbuf().  
+        CALL init_store_piece_of_field
+        CALL mpi_type_size ( MPI_INTEGER , itypesize , ierr )
+!write(0,*)'mpi_type_size returns ', itypesize
+! Scan obuf the first time to calculate the size of the buffer required for 
+! each field.  Calls to add_to_bufsize_for_field() accumulate sizes.  
+        vid = 0
+        icurs = inttypesize
+        DO WHILE ( icurs .lt. obufsize )
+          SELECT CASE ( get_hdr_tag( obuf ( icurs / inttypesize ) ) )
+            CASE ( int_field )
+              CALL int_get_write_field_header ( obuf(icurs/inttypesize), hdrbufsize, itypesize, ftypesize,  &
+                                                DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, &
+                                                DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                                DomainStart , DomainEnd ,                                    &
+                                                MemoryStart , MemoryEnd ,                                    &
+                                                PatchStart , PatchEnd )
+              chunksize = (PatchEnd(1)-PatchStart(1)+1)*(PatchEnd(2)-PatchStart(2)+1)* &
+                          (PatchEnd(3)-PatchStart(3)+1)*ftypesize
+
+!write(0,*) 'X-1', hdrbufsize, get_hdr_tag( obuf ( icurs / inttypesize ) ) , get_hdr_rec_size( obuf ( icurs / inttypesize ) ), TRIM(VarName)
+              call add_to_bufsize_for_field( VarName, hdrbufsize )
+              icurs = icurs + hdrbufsize
+              ! If this is a real write (i.e. not a training write), accumulate
+              ! buffersize for this field.
+              IF ( DomainDesc .NE. 333933 ) THEN   ! magic number
+!write(0,*) 'X-1a', chunksize, TRIM(VarName)
+                call add_to_bufsize_for_field( VarName, chunksize )
+                icurs = icurs + chunksize
+              ENDIF
+            CASE DEFAULT
+              hdrbufsize = obuf(icurs/inttypesize)
+              write(VarName,'(I5.5)')vid 
+!write(0,*) 'X-2', hdrbufsize, get_hdr_tag( obuf ( icurs / inttypesize ) ) , get_hdr_rec_size( obuf ( icurs / inttypesize ) ), TRIM(VarName)
+              call add_to_bufsize_for_field( VarName, hdrbufsize )
+              icurs = icurs + hdrbufsize
+              vid = vid+1
+          END SELECT
+        ENDDO
+! Store the headers and field data in internal buffers.  The first call to 
+! store_piece_of_field() allocates internal buffers using sizes computed by 
+! calls to add_to_bufsize_for_field().  
+        vid = 0
+        icurs = inttypesize
+        DO WHILE ( icurs .lt. obufsize )
+!write(0,*) 'A icurs ', icurs, ' obufsize ', obufsize
+          SELECT CASE ( get_hdr_tag( obuf ( icurs / inttypesize ) ) )
+            CASE ( int_field )
+              CALL int_get_write_field_header ( obuf(icurs/inttypesize), hdrbufsize, itypesize, ftypesize,  &
+                                                DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, &
+                                                DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                                DomainStart , DomainEnd ,                                    &
+                                                MemoryStart , MemoryEnd ,                                    &
+                                                PatchStart , PatchEnd )
+              chunksize = (PatchEnd(1)-PatchStart(1)+1)*(PatchEnd(2)-PatchStart(2)+1)* &
+                          (PatchEnd(3)-PatchStart(3)+1)*ftypesize
+
+
+              call store_piece_of_field( obuf(icurs/inttypesize), VarName, hdrbufsize )
+!write(0,*) 'A-1', hdrbufsize, get_hdr_tag( obuf ( icurs / inttypesize ) ) , get_hdr_rec_size( obuf ( icurs / inttypesize ) ), TRIM(VarName)
+              icurs = icurs + hdrbufsize
+              ! If this is a real write (i.e. not a training write), store
+              ! this piece of this field.
+              IF ( DomainDesc .NE. 333933 ) THEN   ! magic number
+!write(0,*) 'A-1a', chunksize, TRIM(VarName)
+                call store_piece_of_field( obuf(icurs/inttypesize), VarName, chunksize )
+                icurs = icurs + chunksize
+              ENDIF
+            CASE DEFAULT
+              hdrbufsize = obuf(icurs/inttypesize)
+              write(VarName,'(I5.5)')vid 
+              call store_piece_of_field( obuf(icurs/inttypesize), VarName, hdrbufsize )
+!write(0,*) 'A-2', hdrbufsize, get_hdr_tag( obuf ( icurs / inttypesize ) ) , get_hdr_rec_size( obuf ( icurs / inttypesize ) ), TRIM(VarName)
+              icurs = icurs + hdrbufsize
+              vid = vid+1
+          END SELECT
+        ENDDO
+
+!call mpi_comm_size( mpi_comm_local, iii, ierr )
+!write(0,*)'mpi_comm_size mpi_comm_local ',iii
+!call mpi_comm_rank( mpi_comm_local, iii, ierr )
+!write(0,*)'mpi_comm_rank mpi_comm_local ',iii
+
+!write(0,*)'calling init_retrieve_pieces_of_field '
+! Now, for each field, retrieve headers and patches (data) from the internal 
+! buffers and collect them all on the I/O quilt server "root" task.
+        CALL init_retrieve_pieces_of_field
+! Retrieve header and all patches for the first field from the internal 
+! buffers.  
+        CALL retrieve_pieces_of_field ( obuf , VarName, obufsize, sz, retval )
+!write(0,*)'calling first retrieve_pieces_of_field ',TRIM(VarName),obufsize,sz,retval
+! Sum sizes of all headers and patches (data) for this field from all I/O 
+! servers in this I/O server group onto the I/O server "root".
+        CALL MPI_Reduce( sz, bigbufsize, 1, MPI_INTEGER,  &
+                         MPI_SUM, ntasks_local_group-1,         &
+                         mpi_comm_local, ierr )
+!write(0,*)'after MPI_Reduce ',sz, bigbufsize
+
+! Loop until there are no more fields to retrieve from the internal buffers.
+        DO WHILE ( retval )
+
+!write(0,*)' VarName ',TRIM(VarName),' sz ',sz,' bigbufsize ',bigbufsize
+
+! I/O server "root" allocates space to collect headers and fields from all
+! other servers in this I/O server group.
+          IF ( mytask_local .EQ. ntasks_local_group-1 ) THEN
+!write(0,*)'allocating bufbuf ', (bigbufsize+1)/inttypesize
+            ALLOCATE( bigbuf( (bigbufsize+1)/inttypesize ) )
+          ENDIF
+
+!write(0,*)'before collect_on_comm tag,size ',Trim(VarName),get_hdr_tag(obuf),get_hdr_rec_size(obuf)
+! Collect buffers and fields from all I/O servers in this I/O server group
+! onto the I/O server "root"
+          CALL collect_on_comm( mpi_comm_local,                    &
+                                onebyte,                           &
+                                obuf, sz,  &
+                                bigbuf, bigbufsize )
+!write(0,*)'after collect_on_comm ', sz, bigbufsize
+! The I/O server "root" now handles collected requests from all compute 
+! tasks served by this I/O server group (i.e. all compute tasks).  
+          IF ( mytask_local .EQ. ntasks_local_group-1 ) THEN
+!jjj = 4
+!do iii = 1, ntasks_local_group
+!  write(0,*)'i,j,tag,size ', iii, jjj, get_hdr_tag(bigbuf(jjj/4)),get_hdr_rec_size(bigbuf(jjj/4))
+!  jjj = jjj + get_hdr_rec_size(bigbuf(jjj/4))
+!enddo
+
+            icurs = inttypesize  ! icurs is a byte counter, but buffer is integer
+
+            stored_write_record = .false.
+
+! The I/O server "root" loops over the collected requests.  
+            DO WHILE ( icurs .lt. bigbufsize )
+              CALL mpi_type_size ( MPI_INTEGER , itypesize , ierr )
+
+!write(0,*)'B tag,size ',icurs,get_hdr_tag( bigbuf(icurs/inttypesize) ),get_hdr_rec_size( bigbuf(icurs/inttypesize) )
+!write(0,*)'   inttypesize ',inttypesize,' itypesize ',itypesize,' icurs/inttypesize ',icurs/inttypesize
+! The I/O server "root" gets the request out of the next header and
+! handles it by, in most cases, calling the appropriate external I/O package
+! interface.
+              SELECT CASE ( get_hdr_tag( bigbuf(icurs/inttypesize) ) )
+! The I/O server "root" handles the "noop" (do nothing) request.  This is 
+! actually quite easy.  "Noop" requests exist to help avoid race conditions.  
+! In some cases, only one compute task will everything about a request so 
+! other compute tasks send "noop" requests.  
+                CASE ( int_noop )
+!write(0,*)' int_noop '
+                  CALL int_get_noop_header( bigbuf(icurs/inttypesize), hdrbufsize, itypesize )
+                  icurs = icurs + hdrbufsize
+
+! The I/O server "root" handles the "put_dom_td_real" request.
+                CASE ( int_dom_td_real )
+!write(0,*)' int_dom_td_real '
+                  CALL mpi_type_size( MPI_REAL, ftypesize, ierr )
+                  ALLOCATE( RData( bigbuf(icurs/inttypesize + 4 ) ) )      ! 5 is the count of data items for this record ; defined in collect_on_comm.c
+                  CALL int_get_td_header( bigbuf(icurs/inttypesize:), hdrbufsize, inttypesize, ftypesize, &
+                                          DataHandle, DateStr, Element, RData, Count, code )
+                  icurs = icurs + hdrbufsize
+
+                  SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                    CASE ( IO_NETCDF   )
+                      CALL ext_ncd_put_dom_td_real( handle(DataHandle),TRIM(Element),TRIM(DateStr),RData, Count, Status )
+#endif
+#ifdef INTIO
+                    CASE ( IO_INTIO   )
+                      CALL ext_int_put_dom_td_real( handle(DataHandle),TRIM(Element),TRIM(DateStr),RData, Count, Status )
+#endif
+#ifdef YYY
+                 CASE ( IO_YYY )
+                    CALL ext_yyy_put_dom_td_real( handle(DataHandle),TRIM(Element),TRIM(DateStr),RData, Count, Status )
+#endif
+#ifdef GRIB1
+                 CASE ( IO_GRIB1 )
+                    CALL ext_gr1_put_dom_td_real( handle(DataHandle),TRIM(Element),TRIM(DateStr),RData, Count, Status )
+#endif
+#ifdef GRIB2
+                 CASE ( IO_GRIB2 )
+                    CALL ext_gr2_put_dom_td_real( handle(DataHandle),TRIM(Element),TRIM(DateStr),RData, Count, Status )
+#endif
+                     CASE DEFAULT
+                      Status = 0
+                  END SELECT
+
+                  DEALLOCATE( RData )
+! The I/O server "root" handles the "put_dom_ti_real" request.
+                CASE ( int_dom_ti_real )
+!write(0,*)' int_dom_ti_real '
+                  CALL mpi_type_size( MPI_REAL, ftypesize, ierr )
+                  ALLOCATE( RData( bigbuf(icurs/inttypesize + 4 ) ) )      ! 5 is the count of data items for this record ; defined in collect_on_comm.c
+                  CALL int_get_ti_header( bigbuf(icurs/inttypesize:), hdrbufsize, inttypesize, ftypesize, &
+                                          DataHandle, Element, RData, Count, code )
+                  icurs = icurs + hdrbufsize
+
+                  SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                    CASE ( IO_NETCDF   )
+                      CALL ext_ncd_put_dom_ti_real( handle(DataHandle),TRIM(Element), RData, Count, Status )
+!write(0,*)'ext_ncd_put_dom_ti_real ',handle(DataHandle),TRIM(Element),RData,Status
+#endif
+#ifdef INTIO
+                    CASE ( IO_INTIO   )
+                      CALL ext_int_put_dom_ti_real( handle(DataHandle),TRIM(Element), RData, Count, Status )
+#endif
+#ifdef YYY
+                 CASE ( IO_YYY )
+                    CALL ext_yyy_put_dom_ti_real( handle(DataHandle),TRIM(Element), RData, Count, Status )
+#endif
+#ifdef GRIB1
+                 CASE ( IO_GRIB1 )
+                    CALL ext_gr1_put_dom_ti_real( handle(DataHandle),TRIM(Element), RData, Count, Status )
+#endif
+#ifdef GRIB2
+                 CASE ( IO_GRIB2 )
+                    CALL ext_gr2_put_dom_ti_real( handle(DataHandle),TRIM(Element), RData, Count, Status )
+#endif
+                    CASE DEFAULT
+                      Status = 0
+                  END SELECT
+
+                  DEALLOCATE( RData )
+
+! The I/O server "root" handles the "put_dom_td_integer" request.
+                CASE ( int_dom_td_integer )
+!write(0,*)' int_dom_td_integer '
+                  CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr )
+                  ALLOCATE( IData( bigbuf(icurs/inttypesize + 4 ) ) )      ! 5 is the count of data items for this record ; defined in collect_on_comm.c
+                  CALL int_get_td_header( bigbuf(icurs/inttypesize:), hdrbufsize, inttypesize, ftypesize, &
+                                          DataHandle, DateStr, Element, IData, Count, code )
+                  icurs = icurs + hdrbufsize
+
+                  SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                    CASE ( IO_NETCDF   )
+                      CALL ext_ncd_put_dom_td_integer( handle(DataHandle),TRIM(Element), Trim(DateStr), IData, Count, Status )
+#endif
+#ifdef INTIO
+                    CASE ( IO_INTIO   )
+                      CALL ext_int_put_dom_td_integer( handle(DataHandle),TRIM(Element), Trim(DateStr), IData, Count, Status )
+#endif
+#ifdef YYY
+                 CASE ( IO_YYY )
+                    CALL ext_yyy_put_dom_td_integer( handle(DataHandle),TRIM(Element), Trim(DateStr), IData, Count, Status )
+#endif
+#ifdef GRIB1
+                 CASE ( IO_GRIB1 )
+                    CALL ext_gr1_put_dom_td_integer( handle(DataHandle),TRIM(Element), Trim(DateStr), IData, Count, Status )
+#endif
+#ifdef GRIB2
+                 CASE ( IO_GRIB2 )
+                    CALL ext_gr2_put_dom_td_integer( handle(DataHandle),TRIM(Element), Trim(DateStr), IData, Count, Status )
+#endif
+                    CASE DEFAULT
+                      Status = 0
+                  END SELECT
+
+                  DEALLOCATE( IData )
+
+! The I/O server "root" handles the "put_dom_ti_integer" request.
+                CASE ( int_dom_ti_integer )
+!write(0,*)' int_dom_ti_integer '
+
+                  CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr )
+                  ALLOCATE( IData( bigbuf(icurs/inttypesize + 4 ) ) )      ! 5 is the count of data items for this record ; defined in collect_on_comm.c
+                  CALL int_get_ti_header( bigbuf(icurs/inttypesize:), hdrbufsize, inttypesize, ftypesize, &
+                                          DataHandle, Element, IData, Count, code )
+                  icurs = icurs + hdrbufsize
+                  SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                    CASE ( IO_NETCDF   )
+                      CALL ext_ncd_put_dom_ti_integer( handle(DataHandle),TRIM(Element), IData, Count, Status )
+!write(0,*)'ext_ncd_put_dom_ti_integer ',handle(DataHandle),TRIM(Element),IData,Status
+#endif
+#ifdef INTIO
+                    CASE ( IO_INTIO   )
+                      CALL ext_int_put_dom_ti_integer( handle(DataHandle),TRIM(Element), IData, Count, Status )
+#endif
+#ifdef YYY
+                 CASE ( IO_YYY )
+                    CALL ext_yyy_put_dom_ti_integer( handle(DataHandle),TRIM(Element), IData, Count, Status )
+#endif
+#ifdef GRIB1
+                 CASE ( IO_GRIB1 )
+                    CALL ext_gr1_put_dom_ti_integer( handle(DataHandle),TRIM(Element), IData, Count, Status )
+#endif
+#ifdef GRIB2
+                 CASE ( IO_GRIB2 )
+                    CALL ext_gr2_put_dom_ti_integer( handle(DataHandle),TRIM(Element), IData, Count, Status )
+#endif
+
+                    CASE DEFAULT
+                      Status = 0
+                  END SELECT
+
+                  DEALLOCATE( IData)
+ 
+! The I/O server "root" handles the "set_time" request.
+                CASE ( int_set_time )
+!write(0,*)' int_set_time '
+                  CALL int_get_ti_header_char( bigbuf(icurs/inttypesize), hdrbufsize, inttypesize, &
+                                               DataHandle, Element, VarName, CData, code )
+                  SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef INTIO
+                    CASE ( IO_INTIO   )
+                      CALL ext_int_set_time ( handle(DataHandle), TRIM(CData), Status)
+#endif
+                    CASE DEFAULT
+                      Status = 0
+                  END SELECT
+
+                  icurs = icurs + hdrbufsize
+
+! The I/O server "root" handles the "put_dom_ti_char" request.
+                CASE ( int_dom_ti_char )
+!write(0,*)' before int_get_ti_header_char '
+                  CALL int_get_ti_header_char( bigbuf(icurs/inttypesize), hdrbufsize, inttypesize, &
+                                               DataHandle, Element, VarName, CData, code )
+!write(0,*)' after int_get_ti_header_char ',VarName
+
+                  SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                    CASE ( IO_NETCDF   )
+                      CALL ext_ncd_put_dom_ti_char ( handle(DataHandle), TRIM(Element), TRIM(CData), Status)
+#endif
+#ifdef INTIO
+                    CASE ( IO_INTIO   )
+                      CALL ext_int_put_dom_ti_char ( handle(DataHandle), TRIM(Element), TRIM(CData), Status)
+#endif
+#ifdef YYY
+                 CASE ( IO_YYY )
+                    CALL ext_yyy_put_dom_ti_char ( handle(DataHandle), TRIM(Element), TRIM(CData), Status)
+#endif
+#ifdef GRIB1
+                 CASE ( IO_GRIB1 )
+                    CALL ext_gr1_put_dom_ti_char ( handle(DataHandle), TRIM(Element), TRIM(CData), Status)
+#endif
+#ifdef GRIB2
+                 CASE ( IO_GRIB2 )
+                    CALL ext_gr2_put_dom_ti_char ( handle(DataHandle), TRIM(Element), TRIM(CData), Status)
+#endif
+                    CASE DEFAULT
+                      Status = 0
+                  END SELECT
+
+                  icurs = icurs + hdrbufsize
+
+! The I/O server "root" handles the "put_var_ti_char" request.
+                CASE ( int_var_ti_char )
+!write(0,*)' int_var_ti_char '
+                  CALL int_get_ti_header_char( bigbuf(icurs/inttypesize), hdrbufsize, inttypesize, &
+                                               DataHandle, Element, VarName, CData, code )
+
+                  SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                    CASE ( IO_NETCDF   )
+                      CALL ext_ncd_put_var_ti_char ( handle(DataHandle), TRIM(Element), TRIM(VarName), TRIM(CData), Status)
+#endif
+#ifdef INTIO
+                    CASE ( IO_INTIO   )
+                      CALL ext_int_put_var_ti_char ( handle(DataHandle), TRIM(Element), TRIM(VarName), TRIM(CData), Status)
+#endif
+#ifdef YYY
+                 CASE ( IO_YYY )
+                    CALL ext_yyy_put_var_ti_char ( handle(DataHandle), TRIM(Element), TRIM(VarName), TRIM(CData), Status)
+#endif
+#ifdef GRIB1
+                 CASE ( IO_GRIB1 )
+                    CALL ext_gr1_put_var_ti_char ( handle(DataHandle), TRIM(Element), TRIM(VarName), TRIM(CData), Status)
+#endif
+#ifdef GRIB2
+                 CASE ( IO_GRIB2 )
+                    CALL ext_gr2_put_var_ti_char ( handle(DataHandle), TRIM(Element), TRIM(VarName), TRIM(CData), Status)
+#endif
+                    CASE DEFAULT
+                      Status = 0
+                  END SELECT
+
+                  icurs = icurs + hdrbufsize
+
+                CASE ( int_ioexit )
+! ioexit is now handled by sending negative message length to server
+                  CALL wrf_error_fatal( &
+                         "quilt: should have handled int_ioexit already")
+! The I/O server "root" handles the "ioclose" request.
+                CASE ( int_ioclose )
+                  CALL int_get_handle_header( bigbuf(icurs/inttypesize), hdrbufsize, itypesize, &
+                                              DataHandle , code )
+                  icurs = icurs + hdrbufsize
+
+                  IF ( DataHandle .GE. 1 ) THEN
+!JMDEBUGwrite(0,*)'closing DataHandle ',DataHandle
+
+                  SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                    CASE ( IO_NETCDF   )
+                      CALL ext_ncd_inquire_filename( handle(DataHandle), fname, fstat, Status )
+                      IF ( fstat .EQ. WRF_FILE_OPENED_FOR_WRITE .OR. fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+                        CALL ext_ncd_ioclose(handle(DataHandle),Status)
+                      ENDIF
+#endif
+#ifdef INTIO
+                    CASE ( IO_INTIO   )
+                      CALL ext_int_inquire_filename( handle(DataHandle), fname, fstat, Status )
+                      IF ( fstat .EQ. WRF_FILE_OPENED_FOR_WRITE .OR. fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+                        CALL ext_int_ioclose(handle(DataHandle),Status)
+                      ENDIF
+#endif
+#ifdef YYY
+                 CASE ( IO_YYY )
+                    CALL ext_yyy_inquire_filename( handle(DataHandle), fname, fstat, Status )
+                    IF ( fstat .EQ. WRF_FILE_OPENED_FOR_WRITE .OR. fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+                      CALL ext_yyy_ioclose(handle(DataHandle),Status)
+                    ENDIF
+#endif
+#ifdef GRIB1
+                 CASE ( IO_GRIB1 )
+                    CALL ext_gr1_inquire_filename( handle(DataHandle), fname, fstat, Status )
+                    IF ( fstat .EQ. WRF_FILE_OPENED_FOR_WRITE .OR. fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+                      CALL ext_gr1_ioclose(handle(DataHandle),Status)
+                    ENDIF
+#endif
+#ifdef GRIB2
+                 CASE ( IO_GRIB2 )
+                    CALL ext_gr2_inquire_filename( handle(DataHandle), fname, fstat, Status )
+                    IF ( fstat .EQ. WRF_FILE_OPENED_FOR_WRITE .OR. fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+                      CALL ext_gr2_ioclose(handle(DataHandle),Status)
+                    ENDIF
+#endif
+                    CASE DEFAULT
+                      Status = 0
+                  END SELECT
+                  ENDIF
+
+! The I/O server "root" handles the "open_for_write_begin" request.
+                CASE ( int_open_for_write_begin )
+
+                  CALL int_get_ofwb_header( bigbuf(icurs/inttypesize), hdrbufsize, itypesize, &
+                                            FileName,SysDepInfo,io_form_arg,DataHandle )
+
+!write(0,*)' int_open_for_write_begin inttypesize ',inttypesize,' itypesize ',itypesize
+!write(0,*)' int_open_for_write_begin icurs ', icurs, hdrbufsize
+!JMDEBUGwrite(0,*)' int_open_for_write_begin FileName ',TRIM(FileName) , ' DataHandle ', DataHandle
+!write(0,*)' int_open_for_write_begin SysDepInfo ',TRIM(SysDepInfo) 
+                  icurs = icurs + hdrbufsize
+!write(0,*)' int_open_for_write_begin new icurs,tag,size ', icurs, get_hdr_tag( bigbuf(icurs/inttypesize) ),get_hdr_rec_size( bigbuf(icurs/inttypesize) )
+                
+                  io_form(DataHandle) = io_form_arg
+
+                  SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                    CASE ( IO_NETCDF   )
+                      CALL ext_ncd_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,handle(DataHandle),Status)
+!write(0,*)'ext_ncd_open_for_write_begin ',Trim(FileName),DataHandle,handle(DataHandle),Status
+#endif
+#ifdef INTIO
+                    CASE ( IO_INTIO   )
+                      CALL ext_int_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,handle(DataHandle),Status)
+#endif
+#ifdef YYY
+                    CASE ( IO_YYY )
+                       CALL ext_yyy_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,handle(DataHandle),Status)
+#endif
+#ifdef GRIB1
+                    CASE ( IO_GRIB1 )
+                       CALL ext_gr1_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,handle(DataHandle),Status)
+#endif
+#ifdef GRIB2
+                    CASE ( IO_GRIB2 )
+                       CALL ext_gr2_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,handle(DataHandle),Status)
+#endif
+                    CASE DEFAULT
+                      Status = 0
+                  END SELECT
+                
+                  okay_to_write(DataHandle) = .false.
+
+! The I/O server "root" handles the "open_for_write_commit" request.
+! In this case, the "okay_to_commit" is simply set to .true. so "write_field"
+! requests will initiate writes to disk.  Actual commit will be done after
+! all requests in this batch have been handled.
+                CASE ( int_open_for_write_commit )
+
+                  CALL int_get_handle_header( bigbuf(icurs/inttypesize), hdrbufsize, itypesize, &
+                                              DataHandle , code )
+!write(0,*)' int_open_for_write_commit icurs ', icurs, hdrbufsize
+                  icurs = icurs + hdrbufsize
+                  okay_to_commit(DataHandle) = .true.
+
+! The I/O server "root" handles the "write_field" (int_field) request.
+! If okay_to_write(DataHandle) is .true. then the patch in the
+! header (bigbuf) is written to a globally-sized internal output buffer via
+! the call to store_patch_in_outbuf().  Note that this is where the actual
+! "quilting" (reassembly of patches onto a full-size domain) is done.  If
+! okay_to_write(DataHandle) is .false. then external I/O package interfaces
+! are called to write metadata for I/O formats that support native metadata.
+!
+! NOTE that the I/O server "root" will only see write_field (int_field)
+! requests AFTER an "iosync" request.
+                CASE ( int_field )
+!write(0,*)' int_field '
+                  CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr )
+                  CALL int_get_write_field_header ( bigbuf(icurs/inttypesize), hdrbufsize, itypesize, ftypesize,  &
+                                                    DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, &
+                                                    DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                                                    DomainStart , DomainEnd ,                                    &
+                                                    MemoryStart , MemoryEnd ,                                    &
+                                                    PatchStart , PatchEnd )
+                  icurs = icurs + hdrbufsize
+
+                  IF ( okay_to_write(DataHandle) ) THEN
+
+!                   WRITE(*,*)'>>> ',TRIM(DateStr), ' ', TRIM(VarName), ' ', TRIM(MemoryOrder), ' ', &
+!                        (PatchEnd(1)-PatchStart(1)+1)*(PatchEnd(2)-PatchStart(2)+1)*(PatchEnd(3)-PatchStart(3)+1)
+
+                    IF ( FieldType .EQ. WRF_FLOAT .OR. FieldType .EQ. WRF_DOUBLE)  THEN
+                      ! Note that the WRF_DOUBLE branch of this IF statement must come first since 
+                      ! WRF_FLOAT is set equal to WRF_DOUBLE during autopromotion builds.  
+                      IF ( FieldType .EQ. WRF_DOUBLE)  THEN
+! this branch has not been tested TBH: 20050406
+                        CALL mpi_type_size( MPI_DOUBLE_PRECISION, ftypesize, ierr )
+                      ELSE
+                        CALL mpi_type_size( MPI_REAL, ftypesize, ierr )
+                      ENDIF
+                      stored_write_record = .true.
+                      CALL store_patch_in_outbuf ( bigbuf(icurs/inttypesize), dummybuf, TRIM(DateStr), TRIM(VarName) , &
+                                                   FieldType, TRIM(MemoryOrder), TRIM(Stagger), DimNames, &
+                                                   DomainStart , DomainEnd , &
+                                                   MemoryStart , MemoryEnd , &
+                                                   PatchStart , PatchEnd )
+
+                    ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+                      CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr )
+                      stored_write_record = .true.
+                      CALL store_patch_in_outbuf ( dummybuf, bigbuf(icurs/inttypesize), TRIM(DateStr), TRIM(VarName) , &
+                                                   FieldType, TRIM(MemoryOrder), TRIM(Stagger), DimNames, &
+                                                   DomainStart , DomainEnd , &
+                                                   MemoryStart , MemoryEnd , &
+                                                   PatchStart , PatchEnd )
+                    ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+                      ftypesize = LWORDSIZE
+                    ENDIF
+                    icurs = icurs + (PatchEnd(1)-PatchStart(1)+1)*(PatchEnd(2)-PatchStart(2)+1)* &
+                                    (PatchEnd(3)-PatchStart(3)+1)*ftypesize
+                  ELSE
+                    SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                      CASE ( IO_NETCDF   )
+                        CALL ext_ncd_write_field ( handle(DataHandle) , TRIM(DateStr) ,         &
+                                   TRIM(VarName) , dummy , FieldType , Comm , IOComm,           &
+                                   DomainDesc , TRIM(MemoryOrder) , TRIM(Stagger) , DimNames ,  &
+                                   DomainStart , DomainEnd ,                                    &
+                                   DomainStart , DomainEnd ,                                    &
+                                   DomainStart , DomainEnd ,                                    &
+                                   Status )
+#endif
+#if 0
+! since this is training and the grib output doesn't need training, disable this branch.
+#ifdef YYY
+                 CASE ( IO_YYY )
+                      CALL ext_YYY_write_field ( handle(DataHandle) , TRIM(DateStr) ,         &
+                                 TRIM(VarName) , dummy , FieldType , Comm , IOComm,           &
+                                 DomainDesc , TRIM(MemoryOrder) , TRIM(Stagger) , DimNames ,  &
+                                 DomainStart , DomainEnd ,                                    &
+                                 DomainStart , DomainEnd ,                                    &
+                                 DomainStart , DomainEnd ,                                    &
+                                 Status )
+#endif
+#endif
+                      CASE DEFAULT
+                        Status = 0
+                    END SELECT
+                  ENDIF
+                CASE ( int_iosync )
+!write(0,*)' int_iosync '
+                  CALL int_get_handle_header( bigbuf(icurs/inttypesize), hdrbufsize, itypesize, &
+                                            DataHandle , code )
+                  icurs = icurs + hdrbufsize
+                CASE DEFAULT
+                  WRITE(mess,*)'quilt: bad tag: ',get_hdr_tag( bigbuf(icurs/inttypesize) ),' icurs ',icurs/inttypesize
+                  CALL wrf_error_fatal( mess )
+              END SELECT
+
+            ENDDO
+! Now, the I/O server "root" has finshed handling all commands from the latest
+! call to retrieve_pieces_of_field().
+
+            IF (stored_write_record) THEN
+!write(0,*)'calling write_outbuf ',DataHandle
+! If any fields have been stored in a globally-sized internal output buffer
+! (via a call to store_patch_in_outbuf()) then call write_outbuf() to write
+! them to disk now.
+! NOTE that the I/O server "root" will only have called
+! store_patch_in_outbuf() when handling write_field (int_field)
+! commands which only arrive AFTER an "iosync" command.
+!JMTIMING              CALL start_timing
+              CALL write_outbuf ( handle(DataHandle), use_package(io_form(DataHandle))) 
+!JMTIMING               CALL end_timing( "quilt: call to write_outbuf" ) 
+!write(0,*)'back from write_outbuf ',DataHandle
+            ENDIF
+
+! If one or more "open_for_write_commit" commands were encountered from the
+! latest call to retrieve_pieces_of_field() then call the package-specific
+! routine to do the commit.
+            IF (okay_to_commit(DataHandle)) THEN
+
+              SELECT CASE (use_package(io_form(DataHandle)))
+#ifdef NETCDF
+                CASE ( IO_NETCDF   )
+                  CALL ext_ncd_inquire_filename( handle(DataHandle), fname, fstat, Status )
+!write(0,*)'preparing to commit ', DataHandle, fstat, fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED
+                  IF ( fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+!write(0,*)'calling ext_ncd_open_for_write_commit ', handle(DataHandle), DataHandle
+                    CALL ext_ncd_open_for_write_commit(handle(DataHandle),Status)
+!write(0,*)'back from ext_ncd_open_for_write_commit ', Status
+                    okay_to_write(DataHandle) = .true.
+                  ENDIF
+#endif
+#ifdef INTIO
+                CASE ( IO_INTIO   )
+                  CALL ext_int_inquire_filename( handle(DataHandle), fname, fstat, Status )
+                  IF ( fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+                    CALL ext_int_open_for_write_commit(handle(DataHandle),Status)
+                    okay_to_write(DataHandle) = .true.
+                  ENDIF
+#endif
+#ifdef YYY
+                 CASE ( IO_YYY )
+                    CALL ext_yyy_inquire_filename( handle(DataHandle), fname, fstat, Status )
+                    IF ( fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+                       CALL ext_yyy_open_for_write_commit(handle(DataHandle),Status)
+                       okay_to_write(DataHandle) = .true.
+                    ENDIF
+#endif
+#ifdef GRIB1
+                 CASE ( IO_GRIB1 )
+                    CALL ext_gr1_inquire_filename( handle(DataHandle), fname, fstat, Status )
+                    IF ( fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+                       CALL ext_gr1_open_for_write_commit(handle(DataHandle),Status)
+                       okay_to_write(DataHandle) = .true.
+                    ENDIF
+#endif
+#ifdef GRIB2
+                 CASE ( IO_GRIB2 )
+                    CALL ext_gr2_inquire_filename( handle(DataHandle), fname, fstat, Status )
+                    IF ( fstat .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) THEN
+                       CALL ext_gr2_open_for_write_commit(handle(DataHandle),Status)
+                       okay_to_write(DataHandle) = .true.
+                    ENDIF
+#endif
+
+                CASE DEFAULT
+                  Status = 0
+              END SELECT
+
+            okay_to_commit(DataHandle) = .false.
+          ENDIF
+          DEALLOCATE( bigbuf )
+        ENDIF
+
+! Retrieve header and all patches for the next field from the internal 
+! buffers.  
+        CALL retrieve_pieces_of_field ( obuf , VarName, obufsize, sz, retval )
+!write(0,*)'calling next retrieve_pieces_of_field ',trim(VarName),obufsize,sz,retval
+! Sum sizes of all headers and patches (data) for this field from all I/O 
+! servers in this I/O server group onto the I/O server "root".
+        CALL MPI_Reduce( sz, bigbufsize, 1, MPI_INTEGER,  &
+                         MPI_SUM, ntasks_local_group-1,         &
+                         mpi_comm_local, ierr )
+! Then, return to the top of the loop to collect headers and data from all 
+! I/O servers in this I/O server group onto the I/O server "root" and handle 
+! the next batch of commands.  
+!write(0,*)'after MPI_Reduce ',sz, bigbufsize
+      END DO
+
+      DEALLOCATE( obuf )
+
+      ! flush output files if needed
+      IF (stored_write_record) THEN
+!JMTIMING        CALL start_timing
+        SELECT CASE ( use_package(io_form) )
+#ifdef NETCDF
+          CASE ( IO_NETCDF   )
+            CALL ext_ncd_iosync( handle(DataHandle), Status )
+#endif
+#ifdef XXX
+          CASE ( IO_XXX   )
+            CALL ext_xxx_iosync( handle(DataHandle), Status )
+#endif
+#ifdef YYY
+          CASE ( IO_YYY   )
+            CALL ext_yyy_iosync( handle(DataHandle), Status )
+#endif
+#ifdef ZZZ
+          CASE ( IO_ZZZ   )
+            CALL ext_zzz_iosync( handle(DataHandle), Status )
+#endif
+#ifdef GRIB1
+          CASE ( IO_GRIB1   )
+            CALL ext_gr1_iosync( handle(DataHandle), Status )
+#endif
+#ifdef GRIB2
+          CASE ( IO_GRIB2   )
+            CALL ext_gr2_iosync( handle(DataHandle), Status )
+#endif
+#ifdef INTIO
+          CASE ( IO_INTIO   )
+            CALL ext_int_iosync( handle(DataHandle), Status )
+#endif
+          CASE DEFAULT
+            Status = 0
+        END SELECT
+!JMTIMING         CALL end_timing( "quilt: flush" )
+      ENDIF
+
+      END DO
+
+    END SUBROUTINE quilt
+
+! end of #endif of DM_PARALLEL
+#endif
+
+    SUBROUTINE init_module_wrf_quilt
+!<DESCRIPTION>
+! Both client (compute) and server tasks call this routine to initialize the 
+! module.  Routine setup_quilt_servers() is called from this routine to 
+! determine which tasks are compute tasks and which are server tasks.  Server 
+! tasks then call routine quilt() and remain there for the rest of the model 
+! run.  Compute tasks return from init_module_wrf_quilt() to perform model 
+! computations.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER i
+      NAMELIST /namelist_quilt/ nio_tasks_per_group, nio_groups
+      INTEGER ntasks, mytask, ierr, io_status
+      LOGICAL mpi_inited
+
+      quilting_enabled = .FALSE.
+      IF ( disable_quilt ) RETURN
+
+      DO i = 1,int_num_handles
+        okay_to_write(i) = .FALSE.
+        int_handle_in_use(i) = .FALSE.
+        server_for_handle(i) = 0 
+        int_num_bytes_to_write(i) = 0
+      ENDDO
+
+      CALL MPI_INITIALIZED( mpi_inited, ierr )
+      IF ( mpi_inited ) THEN
+        CALL wrf_error_fatal("frame/module_io_quilt.F: quilt initialization "// &
+                             "must be called before MPI_Init") ;
+      ENDIF
+
+      CALL mpi_init ( ierr )
+      CALL wrf_set_dm_communicator( MPI_COMM_WORLD )
+      CALL wrf_termio_dup
+      CALL MPI_Comm_rank ( MPI_COMM_WORLD, mytask, ierr ) ;
+      CALL mpi_x_comm_size ( MPI_COMM_WORLD, ntasks, ierr ) ;
+
+      IF ( mytask .EQ. 0 ) THEN
+        OPEN ( unit=27, file="namelist.input", form="formatted", status="old" )
+        nio_groups = 1
+        nio_tasks_per_group  = 0
+        READ ( 27 , NML = namelist_quilt, IOSTAT=io_status )
+        IF (io_status .NE. 0) THEN
+          CALL wrf_error_fatal( "ERROR reading namelist namelist_quilt" )
+        ENDIF
+        CLOSE ( 27 )
+      ENDIF
+      CALL mpi_bcast( nio_tasks_per_group  , 1 , MPI_INTEGER , 0 , MPI_COMM_WORLD, ierr )
+      CALL mpi_bcast( nio_groups , 1 , MPI_INTEGER , 0 , MPI_COMM_WORLD, ierr )
+
+      CALL setup_quilt_servers( nio_tasks_per_group,            &
+                                mytask,               &
+                                ntasks,               &
+                                nio_groups,           &
+                                nio_tasks_in_group,   &
+                                MPI_COMM_WORLD,       &
+                                mpi_comm_local,       &
+                                mpi_comm_io_groups)
+
+       ! provide the communicator for the integration tasks to RSL
+       IF ( mytask .lt. ncompute_tasks ) THEN
+          CALL wrf_set_dm_communicator( mpi_comm_local )
+       ELSE
+          CALL quilt    ! will not return on io server tasks
+       ENDIF
+#endif
+      RETURN
+    END SUBROUTINE init_module_wrf_quilt
+END MODULE module_wrf_quilt
+
+!<DESCRIPTION>
+! Remaining routines in this file are defined outside of the module
+! either to defeat arg/param type checking or to avoid an explicit use
+! dependence.
+!</DESCRIPTION>
+
+SUBROUTINE disable_quilting
+!<DESCRIPTION>
+! Call this in programs that you never want to be quilting (e.g. real)
+! Must call before call to init_module_wrf_quilt().  
+!</DESCRIPTION>
+  USE module_wrf_quilt
+  disable_quilt = .TRUE.
+  RETURN
+END SUBROUTINE disable_quilting
+
+LOGICAL FUNCTION  use_output_servers()
+!<DESCRIPTION>
+! Returns .TRUE. if I/O quilt servers are in-use for write operations.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+  USE module_wrf_quilt
+  use_output_servers = quilting_enabled
+  RETURN
+END FUNCTION use_output_servers
+
+LOGICAL FUNCTION  use_input_servers()
+!<DESCRIPTION>
+! Returns .TRUE. if I/O quilt servers are in-use for read operations.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+  USE module_wrf_quilt
+  use_input_servers = .FALSE.
+  RETURN
+END FUNCTION use_input_servers
+
+SUBROUTINE wrf_quilt_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                     DataHandle , io_form_arg, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to begin data definition ("training") phase
+! for writing to WRF dataset FileName.  io_form_arg indicates file format.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "intio_tags.h"
+  CHARACTER *(*), INTENT(IN)  :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER *(*), INTENT(IN)  :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(IN)  :: io_form_arg
+  INTEGER ,       INTENT(OUT) :: Status
+! Local
+  CHARACTER*132   :: locFileName, locSysDepInfo
+  INTEGER i, itypesize, tasks_in_group, ierr, comm_io_group
+  REAL dummy
+
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_open_for_write_begin' ) 
+  CALL int_get_fresh_handle(i)
+  okay_to_write(i) = .false.
+  DataHandle = i
+
+  locFileName = FileName
+  locSysDepInfo = SysDepInfo
+
+  CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+  IF ( wrf_dm_on_monitor() ) THEN
+    CALL int_gen_ofwb_header( hdrbuf, hdrbufsize, itypesize, &
+                            locFileName,locSysDepInfo,io_form_arg,DataHandle )
+  ELSE
+    CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize )
+  ENDIF
+
+  iserver = get_server_id ( DataHandle )
+!JMDEBUGwrite(0,*)'wrf_quilt_open_for_write_begin iserver = ', iserver
+  CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+!JMDEBUGwrite(0,*)'wrf_quilt_open_for_write_begin comm_io_group  = ', comm_io_group 
+
+  CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+!JMDEBUGwrite(0,*)'mpi_x_comm_size tasks_in_group ',tasks_in_group, ierr
+
+!JMTIMING  CALL start_timing
+  ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+  reduced = 0
+  reduced(1) = hdrbufsize 
+  IF ( wrf_dm_on_monitor() )  reduced(2) = i 
+  CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                   MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                   comm_io_group, ierr )
+!JMTIMING   CALL end_timing("MPI_Reduce in wrf_quilt_open_for_write_begin")
+
+  ! send data to the i/o processor
+  CALL collect_on_comm( comm_io_group,            &
+                        onebyte,                       &
+                        hdrbuf, hdrbufsize , &
+                        dummy, 0 )
+
+  Status = 0
+
+
+#endif
+  RETURN  
+END SUBROUTINE wrf_quilt_open_for_write_begin
+
+SUBROUTINE wrf_quilt_open_for_write_commit( DataHandle , Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to switch an internal flag to enable output
+! for the dataset referenced by DataHandle.  The call to
+! wrf_quilt_open_for_write_commit() must be paired with a call to
+! wrf_quilt_open_for_write_begin().
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "intio_tags.h"
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i, itypesize, tasks_in_group, ierr, comm_io_group
+  REAL dummy
+
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_open_for_write_commit' ) 
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      okay_to_write( DataHandle ) = .true.
+    ENDIF
+  ENDIF
+
+  CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+  CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, &
+                              DataHandle, int_open_for_write_commit )
+
+  iserver = get_server_id ( DataHandle )
+  CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+
+  CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+
+!JMTIMING  CALL start_timing
+  ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+  reduced = 0
+  reduced(1) = hdrbufsize 
+  IF ( wrf_dm_on_monitor() )  reduced(2) = DataHandle
+  CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                   MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                   comm_io_group, ierr )
+!JMTIMING   CALL end_timing("MPI_Reduce in wrf_quilt_open_for_write_commit")
+
+  ! send data to the i/o processor
+  CALL collect_on_comm( comm_io_group,            &
+                        onebyte,                       &
+                        hdrbuf, hdrbufsize , &
+                        dummy, 0 )
+
+  Status = 0
+
+#endif
+  RETURN  
+END SUBROUTINE wrf_quilt_open_for_write_commit
+
+SUBROUTINE wrf_quilt_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                               DataHandle , Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to open WRF dataset FileName for reading.
+! This routine is called only by client (compute) tasks.  
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  CHARACTER *(*), INTENT(IN)  :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER *(*), INTENT(IN)  :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_open_for_read' ) 
+  DataHandle = -1
+  Status = -1
+  CALL wrf_error_fatal ( "frame/module_io_quilt.F: wrf_quilt_open_for_read not yet supported" )
+#endif
+  RETURN  
+END SUBROUTINE wrf_quilt_open_for_read
+
+SUBROUTINE wrf_quilt_inquire_opened ( DataHandle, FileName , FileStatus, Status )
+!<DESCRIPTION>
+! Inquire if the dataset referenced by DataHandle is open.
+! Does not require communication with I/O servers.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_wrf_quilt
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER *(*), INTENT(IN)  :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+
+  Status = 0
+
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_inquire_opened' ) 
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      IF ( okay_to_write( DataHandle ) ) THEN
+        FileStatus = WRF_FILE_OPENED_FOR_WRITE
+      ENDIF
+    ENDIF
+  ENDIF
+  Status = 0
+  
+#endif
+  RETURN
+END SUBROUTINE wrf_quilt_inquire_opened
+
+SUBROUTINE wrf_quilt_inquire_filename ( DataHandle, FileName , FileStatus, Status )
+!<DESCRIPTION>
+! Return the Filename and FileStatus associated with DataHandle.
+! Does not require communication with I/O servers.
+!
+! Note that the current implementation does not actually return FileName.
+! Currenlty, WRF does not use this returned value.  Fixing this would simply
+! require saving the file names on the client tasks in an array similar to
+! okay_to_write().
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_wrf_quilt
+  IMPLICIT NONE
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER *(*), INTENT(OUT) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_inquire_filename' ) 
+  Status = 0
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      IF ( okay_to_write( DataHandle ) ) THEN
+        FileStatus = WRF_FILE_OPENED_FOR_WRITE
+      ELSE
+        FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
+      ENDIF
+    ELSE
+        FileStatus = WRF_FILE_NOT_OPENED
+    ENDIF
+    Status = 0
+    FileName = "bogusfornow"
+  ELSE
+    Status = -1
+  ENDIF
+#endif
+  RETURN
+END SUBROUTINE wrf_quilt_inquire_filename
+
+SUBROUTINE wrf_quilt_iosync ( DataHandle, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to synchronize the disk copy of a dataset
+! with memory buffers.
+!
+! After the "iosync" header (request) is sent to the I/O quilt server,
+! the compute tasks will then send the entire contents (headers and data) of
+! int_local_output_buffer to their I/O quilt server.  This communication is
+! done in subroutine send_to_io_quilt_servers().  After the I/O quilt servers
+! receive this data, they will write all accumulated fields to disk.
+!
+! Significant time may be required for the I/O quilt servers to organize
+! fields and write them to disk.  Therefore, the "iosync" request should be
+! sent only when the compute tasks are ready to run for a while without
+! needing to communicate with the servers.  Otherwise, the compute tasks
+! will end up waiting for the servers to finish writing to disk, thus wasting
+! any performance benefits of having servers at all.
+!
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if  defined( DM_PARALLEL ) && ! defined (STUBMPI) 
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  include "mpif.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+
+  INTEGER locsize , inttypesize
+  INTEGER ierr, tasks_in_group, comm_io_group, dummy, i
+
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_iosync' ) 
+
+!JMTIMING  CALL start_timing
+  IF ( associated ( int_local_output_buffer ) ) THEN
+
+    iserver = get_server_id ( DataHandle )
+    CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+
+    CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+
+    locsize = int_num_bytes_to_write(DataHandle)
+
+!JMTIMING    CALL start_timing
+    ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+    reduced = 0
+    reduced(1) = locsize 
+    IF ( wrf_dm_on_monitor() )  reduced(2) = DataHandle
+    CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                     MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                     comm_io_group, ierr )
+!JMTIMING     CALL end_timing("MPI_Reduce in wrf_quilt_iosync")
+
+    ! send data to the i/o processor
+#ifdef DEREF_KLUDGE
+    CALL collect_on_comm( comm_io_group,            &
+                          onebyte,                       &
+                          int_local_output_buffer(1), locsize , &
+                          dummy, 0 )
+#else
+    CALL collect_on_comm( comm_io_group,            &
+                          onebyte,                       &
+                          int_local_output_buffer, locsize , &
+                          dummy, 0 )
+#endif
+
+
+    int_local_output_cursor = 1
+!    int_num_bytes_to_write(DataHandle) = 0
+    DEALLOCATE ( int_local_output_buffer )
+    NULLIFY ( int_local_output_buffer )
+  ELSE
+    CALL wrf_message ("frame/module_io_quilt.F: wrf_quilt_iosync: no buffer allocated")
+  ENDIF
+!JMTIMING   CALL end_timing("wrf_quilt_iosync")
+  Status = 0
+#endif
+  RETURN
+END SUBROUTINE wrf_quilt_iosync
+
+SUBROUTINE wrf_quilt_ioclose ( DataHandle, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to close the dataset referenced by
+! DataHandle.
+! This routine also clears the client file handle and, if needed, deallocates
+! int_local_output_buffer.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && ! defined( STUBMPI) 
+  USE module_wrf_quilt
+  USE module_timing
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "intio_tags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER i, itypesize, tasks_in_group, comm_io_group, ierr
+  REAL dummy
+
+!JMTIMING  CALL start_timing
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_ioclose' ) 
+  CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, &
+                                DataHandle , int_ioclose )
+  ELSE
+    CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize )
+  ENDIF
+
+  iserver = get_server_id ( DataHandle )
+  CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+
+  CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+
+!JMTIMING  CALL start_timing
+  ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+  reduced = 0
+  IF ( wrf_dm_on_monitor() )  reduced(2) = DataHandle
+!JMDEBUGwrite(0,*)'before MPI_Reduce in ioclose: reduced ', reduced
+  CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                   MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                   comm_io_group, ierr )
+!JMTIMING   CALL end_timing("MPI_Reduce in ioclose")
+
+#if 0
+  ! send data to the i/o processor
+!JMTIMING  CALL start_timing
+  CALL collect_on_comm( comm_io_group,            &
+                        onebyte,                       &
+                        hdrbuf, hdrbufsize , &
+                        dummy, 0 )
+!JMTIMING   CALL end_timing("collect_on_comm in io_close")
+#endif
+
+  int_handle_in_use(DataHandle) = .false.
+  CALL set_server_id( DataHandle, 0 ) 
+  okay_to_write(DataHandle) = .false.
+  okay_to_commit(DataHandle) = .false.
+  int_local_output_cursor = 1
+  int_num_bytes_to_write(DataHandle) = 0
+  IF ( associated ( int_local_output_buffer ) ) THEN
+    DEALLOCATE ( int_local_output_buffer )
+    NULLIFY ( int_local_output_buffer )
+  ENDIF
+
+  Status = 0
+!JMTIMING   CALL end_timing( "wrf_quilt_ioclose" )
+
+#endif
+  RETURN
+END SUBROUTINE wrf_quilt_ioclose
+
+SUBROUTINE wrf_quilt_ioexit( Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to shut down the WRF I/O system.
+! Do not call any wrf_quilt_*() routines after this routine has been called.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && ! defined (STUBMPI ) 
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "intio_tags.h"
+  INTEGER ,       INTENT(OUT) :: Status
+  INTEGER                     :: DataHandle
+  INTEGER i, itypesize, tasks_in_group, comm_io_group, me, ierr 
+  REAL dummy
+
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_ioexit' ) 
+  CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+
+  IF ( wrf_dm_on_monitor() ) THEN
+    CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, &
+                                DataHandle , int_ioexit )  ! Handle is dummy
+  ELSE
+    CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize )
+  ENDIF
+
+  DO iserver = 1, nio_groups
+    CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+
+    CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+    CALL mpi_comm_rank( comm_io_group , me , ierr )
+
+! BY SENDING A NEGATIVE SIZE WE GET THE SERVERS TO SHUT DOWN
+    hdrbufsize = -100 
+    reduced = 0
+    IF ( me .eq. 0 ) reduced(1) = hdrbufsize 
+    CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                     MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                     comm_io_group, ierr )
+
+  ENDDO
+  Status = 0
+
+#endif
+  RETURN  
+END SUBROUTINE wrf_quilt_ioexit
+
+SUBROUTINE wrf_quilt_get_next_time ( DataHandle, DateStr, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to return the next time stamp.
+! This is not yet supported.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && ! defined (STUBMPI) 
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*)               :: DateStr
+  INTEGER                     :: Status
+#endif
+  RETURN
+END SUBROUTINE wrf_quilt_get_next_time
+
+SUBROUTINE wrf_quilt_get_previous_time ( DataHandle, DateStr, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to return the previous time stamp.
+! This is not yet supported.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && ! defined (STUBMPI)
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*)               :: DateStr
+  INTEGER                     :: Status
+#endif
+  RETURN
+END SUBROUTINE wrf_quilt_get_previous_time
+
+SUBROUTINE wrf_quilt_set_time ( DataHandle, Data,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to set the time stamp in the dataset
+! referenced by DataHandle.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "intio_tags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Data
+  INTEGER                     :: Status
+  INTEGER i, itypesize, tasks_in_group, ierr, comm_io_group
+  REAL dummy
+  INTEGER                 :: Count
+!
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_set_time' )
+
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+      Count = 0   ! there is no count for character strings
+      CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                              DataHandle, "TIMESTAMP", "", Data, int_set_time )
+      iserver = get_server_id ( DataHandle )
+      CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+      CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+
+      ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+      reduced = 0
+      reduced(1) = hdrbufsize 
+      IF ( wrf_dm_on_monitor() )  reduced(2) = DataHandle
+      CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                       MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                       comm_io_group, ierr )
+      ! send data to the i/o processor
+      CALL collect_on_comm( comm_io_group,            &
+                            onebyte,                       &
+                            hdrbuf, hdrbufsize , &
+                            dummy, 0 )
+    ENDIF
+  ENDIF
+
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_set_time
+
+SUBROUTINE wrf_quilt_get_next_var ( DataHandle, VarName, Status )
+!<DESCRIPTION>
+! When reading, instruct the I/O quilt servers to return the name of the next
+! variable in the current time frame.
+! This is not yet supported.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*)               :: VarName
+  INTEGER                     :: Status
+#endif
+  RETURN
+END SUBROUTINE wrf_quilt_get_next_var
+
+SUBROUTINE wrf_quilt_get_dom_ti_real ( DataHandle,Element,   Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! independent domain metadata named "Element"
+! from the open dataset described by DataHandle.
+! Metadata of type real are
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  REAL,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Outcount
+  INTEGER                     :: Status
+  CALL wrf_message('wrf_quilt_get_dom_ti_real not supported yet')
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_ti_real 
+
+SUBROUTINE wrf_quilt_put_dom_ti_real ( DataHandle,Element,   Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time independent
+! domain metadata named "Element"
+! to the open dataset described by DataHandle.
+! Metadata of type real are
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "intio_tags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+!Local
+  CHARACTER*132   :: locElement
+  INTEGER i, typesize, itypesize, tasks_in_group, ierr, comm_io_group
+  REAL dummy
+!
+!JMTIMING  CALL start_timing
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_put_dom_ti_real' ) 
+  CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+  locElement = Element
+
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+      CALL MPI_TYPE_SIZE( MPI_REAL, typesize, ierr )
+      IF ( wrf_dm_on_monitor() ) THEN
+        CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, &
+                                DataHandle, locElement, Data, Count, int_dom_ti_real )
+      ELSE
+        CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize )
+      ENDIF
+      iserver = get_server_id ( DataHandle )
+      CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+      CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+
+!JMTIMING      CALL start_timing
+      ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+      reduced = 0
+      reduced(1) = hdrbufsize 
+      IF ( wrf_dm_on_monitor() )  reduced(2) = DataHandle
+      CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                       MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                       comm_io_group, ierr )
+!JMTIMING       CALL end_timing("MPI_Reduce in wrf_quilt_put_dom_ti_real")
+      ! send data to the i/o processor
+      CALL collect_on_comm( comm_io_group,            &
+                            onebyte,                       &
+                            hdrbuf, hdrbufsize , &
+                            dummy, 0 )
+    ENDIF
+  ENDIF
+
+  Status = 0
+!JMTIMING   CALL end_timing("wrf_quilt_put_dom_ti_real")
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_ti_real 
+
+SUBROUTINE wrf_quilt_get_dom_ti_double ( DataHandle,Element,   Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! independent domain metadata named "Element"
+! from the open dataset described by DataHandle.
+! Metadata of type double are
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real*8                      :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: OutCount
+  INTEGER                     :: Status
+  CALL wrf_error_fatal('wrf_quilt_get_dom_ti_double not supported yet')
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_ti_double 
+
+SUBROUTINE wrf_quilt_put_dom_ti_double ( DataHandle,Element,   Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time independent
+! domain metadata named "Element"
+! to the open dataset described by DataHandle.
+! Metadata of type double are
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+  CALL wrf_error_fatal('wrf_quilt_put_dom_ti_double not supported yet')
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_ti_double 
+
+SUBROUTINE wrf_quilt_get_dom_ti_integer ( DataHandle,Element,   Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! independent domain metadata named "Element"
+! from the open dataset described by DataHandle.
+! Metadata of type integer are
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  integer                     :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                      :: OutCount
+  INTEGER                     :: Status
+  CALL wrf_message('wrf_quilt_get_dom_ti_integer not supported yet')
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_ti_integer 
+
+SUBROUTINE wrf_quilt_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time independent
+! domain metadata named "Element"
+! to the open dataset described by DataHandle.
+! Metadata of type integer are
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "intio_tags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  INTEGER ,       INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+! Local
+  CHARACTER*132   :: locElement
+  INTEGER i, typesize, itypesize, tasks_in_group, ierr, comm_io_group
+  REAL dummy
+!
+
+!JMTIMING  CALL start_timing
+  locElement = Element
+
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_put_dom_ti_integer' ) 
+
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+      CALL MPI_TYPE_SIZE( MPI_INTEGER, typesize, ierr )
+      IF ( wrf_dm_on_monitor() ) THEN
+        CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, &
+                                DataHandle, locElement, Data, Count, int_dom_ti_integer )
+      ELSE
+        CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize )
+      ENDIF
+      iserver = get_server_id ( DataHandle )
+      CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+      CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+
+!JMTIMING      CALL start_timing
+      ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+      reduced = 0
+      reduced(1) = hdrbufsize 
+      IF ( wrf_dm_on_monitor() )  reduced(2) = DataHandle
+      CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                       MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                       comm_io_group, ierr )
+
+!JMTIMING       CALL end_timing("MPI_Reduce in wrf_quilt_put_dom_ti_integer")
+      ! send data to the i/o processor
+      CALL collect_on_comm( comm_io_group,            &
+                            onebyte,                       &
+                            hdrbuf, hdrbufsize , &
+                            dummy, 0 )
+    ENDIF
+  ENDIF
+  CALL wrf_debug ( DEBUG_LVL, 'returning from wrf_quilt_put_dom_ti_integer' ) 
+!JMTIMING   CALL end_timing("wrf_quilt_put_dom_ti_integer" )
+
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_ti_integer 
+
+SUBROUTINE wrf_quilt_get_dom_ti_logical ( DataHandle,Element,   Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! independent domain metadata named "Element"
+! from the open dataset described by DataHandle.
+! Metadata of type logical are
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  logical                     :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                      :: OutCount
+  INTEGER                     :: Status
+!  CALL wrf_message('wrf_quilt_get_dom_ti_logical not supported yet')
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_ti_logical 
+
+SUBROUTINE wrf_quilt_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time independent
+! domain metadata named "Element"
+! to the open dataset described by DataHandle.
+! Metadata of type logical are
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+! Local
+  INTEGER i
+  INTEGER one_or_zero(Count)
+
+  DO i = 1, Count
+    IF ( Data(i) ) THEN
+      one_or_zero(i) = 1
+    ELSE
+      one_or_zero(i) = 0
+    ENDIF
+  ENDDO
+
+  CALL wrf_quilt_put_dom_ti_integer ( DataHandle,Element,   one_or_zero, Count,  Status )
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_ti_logical 
+
+SUBROUTINE wrf_quilt_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read time independent
+! domain metadata named "Element"
+! from the open dataset described by DataHandle.
+! Metadata of type char are
+! stored in string Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*)               :: Data
+  INTEGER                     :: Status
+  CALL wrf_message('wrf_quilt_get_dom_ti_char not supported yet')
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_ti_char 
+
+SUBROUTINE wrf_quilt_put_dom_ti_char ( DataHandle, Element,  Data,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write time independent
+! domain metadata named "Element"
+! to the open dataset described by DataHandle.
+! Metadata of type char are
+! copied from string Data.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "intio_tags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: Data
+  INTEGER                     :: Status
+  INTEGER i, itypesize, tasks_in_group, ierr, comm_io_group, me
+  REAL dummy
+!
+!JMTIMING  CALL start_timing
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_put_dom_ti_char' ) 
+
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+      IF ( wrf_dm_on_monitor() ) THEN
+        CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                                DataHandle, Element, "", Data, int_dom_ti_char )
+      ELSE
+        CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize )
+      ENDIF
+      iserver = get_server_id ( DataHandle )
+!  write(0,*)'wrf_quilt_put_dom_ti_char ',iserver
+      CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+      CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+      ! send the size of my local buffer to the i/o task (obufsize doesnt mean anything here)
+!JMTIMING!  CALL start_timing
+!write(0,*)'calling MPI_Barrier'
+!  CALL MPI_Barrier( mpi_comm_local, ierr )
+!write(0,*)'back from MPI_Barrier'
+!JMTIMING!   CALL end_timing("MPI_Barrier in wrf_quilt_put_dom_ti_char")
+
+!JMTIMING      CALL start_timing
+      ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+      reduced_dummy = 0 
+      reduced = 0
+      reduced(1) = hdrbufsize 
+      IF ( wrf_dm_on_monitor() )  reduced(2) = DataHandle
+
+!call mpi_comm_rank( comm_io_group , me, ierr )
+!write(0,*)'calling MPI_Reduce me and tasks_in_group and comm_io_group',me,tasks_in_group ,comm_io_group
+
+      CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                       MPI_SUM, tasks_in_group-1,          &   ! nio_tasks_in_group-1 is me
+                       comm_io_group, ierr )
+
+!JMTIMING       CALL end_timing("MPI_Reduce in wrf_quilt_put_dom_ti_char")
+      ! send data to the i/o processor
+!JMTIMING  CALL start_timing
+
+      CALL collect_on_comm( comm_io_group,            &
+                            onebyte,                       &
+                            hdrbuf, hdrbufsize , &
+                            dummy, 0 )
+!JMTIMING   CALL end_timing("collect_on_comm in wrf_quilt_put_dom_ti_char")
+    ENDIF
+  ENDIF
+!JMTIMING   CALL end_timing("wrf_quilt_put_dom_ti_char")
+
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_ti_char 
+
+SUBROUTINE wrf_quilt_get_dom_td_real ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! dependent domain metadata named "Element" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Metadata of type real are
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real                        :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: OutCount
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_td_real 
+
+SUBROUTINE wrf_quilt_put_dom_td_real ( DataHandle,Element, DateStr,  Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time dependent
+! domain metadata named "Element" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Metadata of type real are
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_td_real 
+
+SUBROUTINE wrf_quilt_get_dom_td_double ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! dependent domain metadata named "Element" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Metadata of type double are
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real*8                          :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                      :: OutCount
+  INTEGER                     :: Status
+#endif
+  CALL wrf_error_fatal('wrf_quilt_get_dom_td_double not supported yet')
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_td_double 
+
+SUBROUTINE wrf_quilt_put_dom_td_double ( DataHandle,Element, DateStr,  Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time dependent
+! domain metadata named "Element" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Metadata of type double are
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+  CALL wrf_error_fatal('wrf_quilt_put_dom_td_double not supported yet')
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_td_double 
+
+SUBROUTINE wrf_quilt_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! dependent domain metadata named "Element" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Metadata of type integer are
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  integer                          :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                      :: OutCount
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_td_integer 
+
+SUBROUTINE wrf_quilt_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time dependent
+! domain metadata named "Element" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Metadata of type integer are
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_td_integer 
+
+SUBROUTINE wrf_quilt_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! dependent domain metadata named "Element" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Metadata of type logical are
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  logical                          :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                      :: OutCount
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_td_logical 
+
+SUBROUTINE wrf_quilt_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time dependent
+! domain metadata named "Element" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Metadata of type logical are
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_td_logical 
+
+SUBROUTINE wrf_quilt_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read time dependent
+! domain metadata named "Element" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Metadata of type char are
+! stored in string Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*)               :: Data
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_dom_td_char 
+
+SUBROUTINE wrf_quilt_put_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+!<DESCRIPTION>
+! Instruct $he I/O quilt servers to write time dependent
+! domain metadata named "Element" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Metadata of type char are
+! copied from string Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN) :: Data
+  INTEGER                          :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_dom_td_char 
+
+SUBROUTINE wrf_quilt_get_var_ti_real ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! independent attribute "Element" of variable "Varname"
+! from the open dataset described by DataHandle.
+! Attribute of type real is
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real                          :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: OutCount
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_var_ti_real 
+
+SUBROUTINE wrf_quilt_put_var_ti_real ( DataHandle,Element,  Varname, Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time independent
+! attribute "Element" of variable "Varname"
+! to the open dataset described by DataHandle.
+! Attribute of type real is
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_var_ti_real 
+
+SUBROUTINE wrf_quilt_get_var_ti_double ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! independent attribute "Element" of variable "Varname"
+! from the open dataset described by DataHandle.
+! Attribute of type double is
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real*8                      :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: OutCount
+  INTEGER                     :: Status
+#endif
+  CALL wrf_error_fatal('wrf_quilt_get_var_ti_double not supported yet')
+RETURN
+END SUBROUTINE wrf_quilt_get_var_ti_double 
+
+SUBROUTINE wrf_quilt_put_var_ti_double ( DataHandle,Element,  Varname, Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time independent
+! attribute "Element" of variable "Varname"
+! to the open dataset described by DataHandle.
+! Attribute of type double is
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real*8 ,        INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+  CALL wrf_error_fatal('wrf_quilt_put_var_ti_double not supported yet')
+RETURN
+END SUBROUTINE wrf_quilt_put_var_ti_double 
+
+SUBROUTINE wrf_quilt_get_var_ti_integer ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! independent attribute "Element" of variable "Varname"
+! from the open dataset described by DataHandle.
+! Attribute of type integer is
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  integer                     :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: OutCount
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_var_ti_integer 
+
+SUBROUTINE wrf_quilt_put_var_ti_integer ( DataHandle,Element,  Varname, Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time independent
+! attribute "Element" of variable "Varname"
+! to the open dataset described by DataHandle.
+! Attribute of type integer is
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_var_ti_integer 
+
+SUBROUTINE wrf_quilt_get_var_ti_logical ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! independent attribute "Element" of variable "Varname"
+! from the open dataset described by DataHandle.
+! Attribute of type logical is
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  logical                     :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: OutCount
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_var_ti_logical 
+
+SUBROUTINE wrf_quilt_put_var_ti_logical ( DataHandle,Element,  Varname, Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time independent
+! attribute "Element" of variable "Varname"
+! to the open dataset described by DataHandle.
+! Attribute of type logical is
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_var_ti_logical 
+
+SUBROUTINE wrf_quilt_get_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read time independent
+! attribute "Element" of variable "Varname"
+! from the open dataset described by DataHandle.
+! Attribute of type char is
+! stored in string Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  CHARACTER*(*)               :: Data
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_var_ti_char 
+
+SUBROUTINE wrf_quilt_put_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write time independent
+! attribute "Element" of variable "Varname"
+! to the open dataset described by DataHandle.
+! Attribute of type char is
+! copied from string Data.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "intio_tags.h"
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  CHARACTER*(*) , INTENT(IN)  :: Data
+  INTEGER                     :: Status
+  INTEGER i, itypesize, tasks_in_group, ierr, comm_io_group
+  REAL dummy
+!
+
+!JMTIMING  CALL start_timing
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_put_var_ti_char' ) 
+
+  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
+    IF ( int_handle_in_use( DataHandle ) ) THEN
+      CALL MPI_TYPE_SIZE( MPI_INTEGER, itypesize, ierr )
+      IF ( wrf_dm_on_monitor() ) THEN
+        CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                                DataHandle, TRIM(Element), TRIM(VarName), TRIM(Data), int_var_ti_char )
+      ELSE
+        CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize )
+      ENDIF
+      iserver = get_server_id ( DataHandle )
+      CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+      CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+
+!JMTIMING      CALL start_timing
+      ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+      reduced = 0
+      reduced(1) = hdrbufsize 
+      IF ( wrf_dm_on_monitor() )  reduced(2) = DataHandle
+      CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                       MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                       comm_io_group, ierr )
+!JMTIMING       CALL end_timing("MPI_Reduce in wrf_quilt_put_var_ti_char")
+      ! send data to the i/o processor
+      CALL collect_on_comm( comm_io_group,            &
+                            onebyte,                       &
+                            hdrbuf, hdrbufsize , &
+                            dummy, 0 )
+    ENDIF
+  ENDIF
+!JMTIMING   CALL end_timing("wrf_quilt_put_dom_ti_char" )
+
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_var_ti_char 
+
+SUBROUTINE wrf_quilt_get_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! dependent attribute "Element" of variable "Varname" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Attribute of type real is
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real                        :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: OutCount
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_var_td_real 
+
+SUBROUTINE wrf_quilt_put_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time dependent
+! attribute "Element" of variable "Varname" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Attribute of type real is
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_var_td_real 
+
+SUBROUTINE wrf_quilt_get_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! dependent attribute "Element" of variable "Varname" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Attribute of type double is
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real*8                      :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: OutCount
+  INTEGER                     :: Status
+#endif
+  CALL wrf_error_fatal('wrf_quilt_get_var_td_double not supported yet')
+RETURN
+END SUBROUTINE wrf_quilt_get_var_td_double 
+
+SUBROUTINE wrf_quilt_put_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time dependent
+! attribute "Element" of variable "Varname" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Attribute of type double is
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+  CALL wrf_error_fatal('wrf_quilt_put_var_td_double not supported yet')
+RETURN
+END SUBROUTINE wrf_quilt_put_var_td_double 
+
+SUBROUTINE wrf_quilt_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount,Status)
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! dependent attribute "Element" of variable "Varname" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Attribute of type integer is
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  integer                     :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: OutCount
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_var_td_integer 
+
+SUBROUTINE wrf_quilt_put_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time dependent
+! attribute "Element" of variable "Varname" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Attribute of type integer is
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  integer ,       INTENT(IN)  :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_var_td_integer 
+
+SUBROUTINE wrf_quilt_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read Count words of time
+! dependent attribute "Element" of variable "Varname" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Attribute of type logical is
+! stored in array Data.
+! Actual number of words read is returned in OutCount.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  logical                          :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                      :: OutCount
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_var_td_logical 
+
+SUBROUTINE wrf_quilt_put_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write Count words of time dependent
+! attribute "Element" of variable "Varname" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Attribute of type logical is
+! copied from array Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_var_td_logical 
+
+SUBROUTINE wrf_quilt_get_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to attempt to read time dependent
+! attribute "Element" of variable "Varname" valid at time DateStr
+! from the open dataset described by DataHandle.
+! Attribute of type char is
+! stored in string Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  CHARACTER*(*)               :: Data
+  INTEGER                     :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_var_td_char 
+
+SUBROUTINE wrf_quilt_put_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to write time dependent
+! attribute "Element" of variable "Varname" valid at time DateStr
+! to the open dataset described by DataHandle.
+! Attribute of type char is
+! copied from string Data.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  CHARACTER*(*) , INTENT(IN) :: Data
+  INTEGER                    :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_put_var_td_char 
+
+SUBROUTINE wrf_quilt_read_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
+                            DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                            DomainStart , DomainEnd ,                                    &
+                            MemoryStart , MemoryEnd ,                                    &
+                            PatchStart , PatchEnd ,                                      &
+                            Status )
+!<DESCRIPTION>
+! Instruct the I/O quilt servers to read the variable named VarName from the
+! dataset pointed to by DataHandle.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) , INTENT(INOUT) :: DateStr
+  CHARACTER*(*) , INTENT(INOUT) :: VarName
+  INTEGER ,       INTENT(INOUT) :: Field(*)
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  character*(*)                 ,intent(in)    :: Stagger
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+  Status = 0
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_read_field
+
+SUBROUTINE wrf_quilt_write_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm,  &
+                             DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                             DomainStart , DomainEnd ,                                    &
+                             MemoryStart , MemoryEnd ,                                    &
+                             PatchStart , PatchEnd ,                                      &
+                             Status )
+!<DESCRIPTION>
+! Prepare instructions for the I/O quilt servers to write the variable named
+! VarName to the dataset pointed to by DataHandle.
+!
+! During a "training" write this routine accumulates number and sizes of
+! messages that will be sent to the I/O server associated with this compute
+! (client) task.
+!
+! During a "real" write, this routine begins by allocating
+! int_local_output_buffer if it has not already been allocated.  Sizes
+! accumulated during "training" are used to determine how big
+! int_local_output_buffer must be.  This routine then stores "int_field"
+! headers and associated field data in int_local_output_buffer.  The contents
+! of int_local_output_buffer are actually sent to the I/O quilt server in
+! routine wrf_quilt_iosync().  This scheme allows output of multiple variables
+! to be aggregated into a single "iosync" operation.
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  USE module_state_description
+  USE module_wrf_quilt
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+#include "wrf_io_flags.h"
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) , INTENT(IN)    :: DateStr
+  CHARACTER*(*) , INTENT(IN)    :: VarName
+!  INTEGER ,       INTENT(IN)    :: Field(*)
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  character*(*)                 ,intent(in)    :: Stagger
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+
+  integer ii,jj,kk,myrank
+
+  REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
+                   MemoryStart(2):MemoryEnd(2), &
+                   MemoryStart(3):MemoryEnd(3) ) :: Field
+  INTEGER locsize , typesize, inttypesize
+  INTEGER ierr, tasks_in_group, comm_io_group, dummy, i
+  INTEGER, EXTERNAL :: use_package
+
+!JMTIMING  CALL start_timing
+  CALL wrf_debug ( DEBUG_LVL, 'in wrf_quilt_write_field' ) 
+
+  IF ( .NOT. (DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles) ) THEN
+    CALL wrf_error_fatal("frame/module_io_quilt.F: wrf_quilt_write_field: invalid data handle" )
+  ENDIF
+  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
+    CALL wrf_error_fatal("frame/module_io_quilt.F: wrf_quilt_write_field: DataHandle not opened" )
+  ENDIF
+
+  locsize = (PatchEnd(1)-PatchStart(1)+1)* &
+            (PatchEnd(2)-PatchStart(2)+1)* &
+            (PatchEnd(3)-PatchStart(3)+1)
+
+  CALL mpi_type_size( MPI_INTEGER, inttypesize, ierr )
+  ! Note that the WRF_DOUBLE branch of this IF statement must come first since 
+  ! WRF_FLOAT is set equal to WRF_DOUBLE during autopromotion builds.  
+  IF ( FieldType .EQ. WRF_DOUBLE ) THEN
+    CALL mpi_type_size( MPI_DOUBLE_PRECISION, typesize, ierr )
+  ELSE IF ( FieldType .EQ. WRF_FLOAT ) THEN
+    CALL mpi_type_size( MPI_REAL, typesize, ierr )
+  ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+    CALL mpi_type_size( MPI_INTEGER, typesize, ierr )
+  ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
+    CALL mpi_type_size( MPI_LOGICAL, typesize, ierr )
+  ENDIF
+
+  IF ( .NOT. okay_to_write( DataHandle ) ) THEN
+
+      ! This is a "training" write.
+      ! it is not okay to actually write; what we do here is just "bookkeep": count up
+      ! the number and size of messages that we will output to io server associated with
+      ! this task
+
+      CALL int_gen_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
+                               DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm,  &
+                               333933         , MemoryOrder , Stagger , DimNames ,              &   ! 333933 means training; magic number
+                               DomainStart , DomainEnd ,                                    &
+                               MemoryStart , MemoryEnd ,                                    &
+                               PatchStart , PatchEnd )
+
+      int_num_bytes_to_write(DataHandle) = int_num_bytes_to_write(DataHandle) + locsize * typesize + hdrbufsize
+
+      ! Send the hdr for the write in case the interface is calling the I/O API in "learn" mode
+
+      iserver = get_server_id ( DataHandle )
+!JMDEBUGwrite(0,*)'wrf_quilt_write_field (dryrun) ',iserver
+      CALL get_mpi_comm_io_groups( comm_io_group , iserver )
+      ! send the size of my local buffer to the i/o task (obufsize doesnt mean anything here)
+
+      CALL mpi_x_comm_size( comm_io_group , tasks_in_group , ierr )
+
+      IF ( .NOT. wrf_dm_on_monitor() ) THEN     ! only one task in compute grid sends this message; send noops on others
+        CALL int_gen_noop_header( hdrbuf, hdrbufsize, inttypesize )
+      ENDIF
+
+
+!JMTIMING      CALL start_timing
+      ! send the size of my local buffer to the i/o task (reduced_dummy doesnt mean anything on client side)
+      reduced = 0
+      reduced(1) = hdrbufsize 
+      IF ( wrf_dm_on_monitor() )  reduced(2) = DataHandle
+      CALL MPI_Reduce( reduced, reduced_dummy, 2, MPI_INTEGER,  &
+                       MPI_SUM, tasks_in_group-1,          &   ! root = nio_tasks_in_group-1 is me
+                       comm_io_group, ierr )
+!JMTIMING       CALL end_timing("MPI_Reduce in wrf_quilt_write_field dryrun")
+      ! send data to the i/o processor
+
+      CALL collect_on_comm( comm_io_group,                   &
+                            onebyte,                          &
+                            hdrbuf, hdrbufsize ,                 &
+                            dummy, 0 )
+
+  ELSE
+
+    IF ( .NOT. associated( int_local_output_buffer ) ) THEN
+      ALLOCATE ( int_local_output_buffer( (int_num_bytes_to_write( DataHandle )+1)/inttypesize ) )
+      int_local_output_cursor = 1
+    ENDIF
+      iserver = get_server_id ( DataHandle )
+!JMDEBUGwrite(0,*)'wrf_quilt_write_field (writing) ',iserver
+
+    ! This is NOT a "training" write.  It is OK to write now.
+    CALL int_gen_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
+                             DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm,  &
+                             0          , MemoryOrder , Stagger , DimNames ,              &   ! non-333933 means okay to write; magic number
+                             DomainStart , DomainEnd ,                                    &
+                             MemoryStart , MemoryEnd ,                                    &
+                             PatchStart , PatchEnd )
+
+    ! Pack header into int_local_output_buffer.  It will be sent to the 
+    ! I/O servers during the next "iosync" operation.  
+#ifdef DEREF_KLUDGE
+    CALL int_pack_data ( hdrbuf , hdrbufsize , int_local_output_buffer(1), int_local_output_cursor )
+#else
+    CALL int_pack_data ( hdrbuf , hdrbufsize , int_local_output_buffer, int_local_output_cursor )
+#endif
+
+    ! Pack field data into int_local_output_buffer.  It will be sent to the 
+    ! I/O servers during the next "iosync" operation.  
+#ifdef DEREF_KLUDGE
+    CALL int_pack_data ( Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3) ), &
+                                  locsize * typesize , int_local_output_buffer(1), int_local_output_cursor )
+#else
+    CALL int_pack_data ( Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3) ), &
+                                  locsize * typesize , int_local_output_buffer, int_local_output_cursor )
+#endif
+
+  ENDIF
+  Status = 0
+!JMTIMING   CALL end_timing("wrf_quilt_write_field")
+
+#endif
+  RETURN
+END SUBROUTINE wrf_quilt_write_field
+
+SUBROUTINE wrf_quilt_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
+                              DomainStart , DomainEnd , Status )
+!<DESCRIPTION>
+! This routine applies only to a dataset that is open for read.  It instructs
+! the I/O quilt servers to return information about variable VarName.
+! This routine is called only by client (compute) tasks.  
+!
+! This is not yet supported.
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+  IMPLICIT NONE
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: VarName
+  integer                               :: NDim
+  character*(*)                         :: MemoryOrder
+  character*(*)                         :: Stagger
+  integer ,dimension(*)                 :: DomainStart, DomainEnd
+  integer                               :: Status
+#endif
+RETURN
+END SUBROUTINE wrf_quilt_get_var_info
+
+SUBROUTINE get_mpi_comm_io_groups( retval, isrvr )
+!<DESCRIPTION>
+! This routine returns the compute+io communicator to which this
+! compute task belongs for I/O server group "isrvr".
+! This routine is called only by client (compute) tasks.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+      USE module_wrf_quilt
+      IMPLICIT NONE
+      INTEGER, INTENT(IN ) :: isrvr
+      INTEGER, INTENT(OUT) :: retval
+      retval = mpi_comm_io_groups(isrvr)
+#endif
+      RETURN
+END SUBROUTINE get_mpi_comm_io_groups
+
+SUBROUTINE get_nio_tasks_in_group( retval )
+!<DESCRIPTION>
+! This routine returns the number of I/O server tasks in each 
+! I/O server group.  It can be called by both clients and 
+! servers.  
+!</DESCRIPTION>
+#if defined( DM_PARALLEL ) && !defined( STUBMPI )
+      USE module_wrf_quilt
+      IMPLICIT NONE
+      INTEGER, INTENT(OUT) :: retval
+      retval = nio_tasks_in_group
+#endif
+      RETURN
+END SUBROUTINE get_nio_tasks_in_group
+
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_machine.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_machine.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_machine.F	(revision 2744)
@@ -0,0 +1,177 @@
+!WRF:DRIVER_LAYER:DECOMPOSITION
+!
+
+MODULE module_machine
+
+   USE module_driver_constants
+
+   !  Machine characteristics and utilities here.
+
+   ! Tile strategy defined constants
+   INTEGER, PARAMETER :: TILE_X = 1, TILE_Y = 2, TILE_XY = 3
+
+   TYPE machine_type
+      INTEGER                       :: tile_strategy
+   END TYPE machine_type
+
+   TYPE (machine_type) machine_info
+
+   CONTAINS
+
+   RECURSIVE SUBROUTINE rlocproc(p,maxi,nproc,ml,mr,ret)
+   IMPLICIT NONE
+   INTEGER, INTENT(IN)  :: p, maxi, nproc, ml, mr
+   INTEGER, INTENT(OUT) :: ret
+   INTEGER              :: width, rem, ret2, bl, br, mid, adjust, &
+                           p_r, maxi_r, nproc_r, zero
+   adjust = 0
+   rem = mod( maxi, nproc )
+   width = maxi / nproc
+   mid = maxi / 2
+   IF ( rem>0 .AND. (((mod(rem,2).EQ.0).OR.(rem.GT.2)).OR.(p.LE.mid))) THEN
+     width = width + 1
+   END IF
+   IF ( p.LE.mid .AND. mod(rem,2).NE.0 ) THEN
+     adjust = adjust + 1
+   END IF
+   bl = max(width,ml) ;
+   br = max(width,mr) ;
+   IF      (p<bl) THEN
+     ret = 0
+   ELSE IF (p>maxi-br-1) THEN
+     ret = nproc-1
+   ELSE
+     p_r = p - bl
+     maxi_r = maxi-bl-br+adjust
+     nproc_r = max(nproc-2,1)
+     zero = 0
+     CALL rlocproc( p_r, maxi_r, nproc_r, zero, zero, ret2 )  ! Recursive
+     ret = ret2 + 1
+   END IF
+   RETURN
+   END SUBROUTINE rlocproc
+
+   INTEGER FUNCTION locproc( i, m, numpart )
+   implicit none
+   integer, intent(in) :: i, m, numpart 
+   integer             :: retval, ii, im, inumpart, zero
+   ii = i
+   im = m
+   inumpart = numpart
+   zero = 0
+   CALL rlocproc( ii, im, inumpart, zero, zero, retval )
+   locproc = retval
+   RETURN
+   END FUNCTION locproc
+
+   SUBROUTINE patchmap( res, y, x, py, px )
+   implicit none
+   INTEGER, INTENT(IN)                    :: y, x, py, px
+   INTEGER, DIMENSION(x,y), INTENT(OUT)   :: res
+   INTEGER                                :: i, j, p_min, p_maj
+   DO j = 0,y-1
+     p_maj = locproc( j, y, py )
+     DO i = 0,x-1
+       p_min = locproc( i, x, px )
+       res(i+1,j+1) = p_min + px*p_maj
+     END DO
+   END DO
+   RETURN
+   END SUBROUTINE patchmap
+
+   SUBROUTINE region_bounds( region_start, region_end, &
+                             num_p, p,                 &
+                             patch_start, patch_end )
+   ! 1-D decomposition routine: Given starting and ending indices of a
+   ! vector, the number of patches dividing the vector, and the number of
+   ! the patch, give the start and ending indices of the patch within the
+   ! vector.  This will work with tiles too.  Implementation note.  This is
+   ! implemented somewhat inefficiently, now, with a loop, so we can use the
+   ! locproc function above, which returns processor number for a given
+   ! index, whereas what we want is index for a given processor number.
+   ! With a little thought and a lot of debugging, we can come up with a
+   ! direct expression for what we want.  For time being, we loop...
+   ! Remember that processor numbering starts with zero.
+                      
+   IMPLICIT NONE
+   INTEGER, INTENT(IN)                    :: region_start, region_end, num_p, p
+   INTEGER, INTENT(OUT)                   :: patch_start, patch_end
+   INTEGER                                :: offset, i
+   patch_end = -999999999
+   patch_start = 999999999
+   offset = region_start
+   do i = 0, region_end - offset
+     if ( locproc( i, region_end-region_start+1, num_p ) == p ) then
+       patch_end = max(patch_end,i)
+       patch_start = min(patch_start,i)
+     endif
+   enddo
+   patch_start = patch_start + offset
+   patch_end   = patch_end   + offset
+   RETURN
+   END SUBROUTINE region_bounds
+
+   SUBROUTINE least_aspect( nparts, minparts_y, minparts_x, nparts_y, nparts_x )
+   IMPLICIT NONE
+   !  Input data.
+   INTEGER, INTENT(IN)           :: nparts,                &
+                                    minparts_y, minparts_x
+   ! Output data. 
+   INTEGER, INTENT(OUT)          :: nparts_y, nparts_x
+   ! Local data.
+   INTEGER                       :: x, y, mini
+   mini = 2*nparts
+   nparts_y = 1
+   nparts_x = nparts
+   DO y = 1, nparts
+      IF ( mod( nparts, y ) .eq. 0 ) THEN
+         x = nparts / y
+         IF (       abs( y-x ) .LT. mini       &
+              .AND. y .GE. minparts_y                &
+              .AND. x .GE. minparts_x    ) THEN
+            mini = abs( y-x )
+            nparts_y = y
+            nparts_x = x
+         END IF
+      END IF
+   END DO
+   END SUBROUTINE least_aspect
+
+   SUBROUTINE init_module_machine
+      machine_info%tile_strategy = TILE_Y
+   END SUBROUTINE init_module_machine
+
+END MODULE module_machine
+
+SUBROUTINE wrf_sizeof_integer( retval )
+  IMPLICIT NONE
+  INTEGER retval
+! IWORDSIZE is defined by CPP
+  retval = IWORDSIZE
+  RETURN
+END SUBROUTINE wrf_sizeof_integer
+
+SUBROUTINE wrf_sizeof_real( retval )
+  IMPLICIT NONE
+  INTEGER retval
+! RWORDSIZE is defined by CPP
+  retval = RWORDSIZE
+  RETURN
+END SUBROUTINE wrf_sizeof_real
+
+SUBROUTINE wrf_sizeof_doubleprecision( retval )
+  IMPLICIT NONE
+  INTEGER retval
+! DWORDSIZE is defined by CPP
+  retval = DWORDSIZE
+  RETURN
+END SUBROUTINE wrf_sizeof_doubleprecision
+
+SUBROUTINE wrf_sizeof_logical( retval )
+  IMPLICIT NONE
+  INTEGER retval
+! LWORDSIZE is defined by CPP
+  retval = LWORDSIZE
+  RETURN
+END SUBROUTINE wrf_sizeof_logical
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_nesting.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_nesting.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_nesting.F	(revision 2744)
@@ -0,0 +1,82 @@
+!WRF:DRIVER_LAYER:NESTING
+!
+
+
+MODULE module_nesting
+
+   USE module_machine
+   USE module_driver_constants
+   USE module_domain
+   USE module_configure
+   USE module_utility
+
+   LOGICAL, DIMENSION( max_domains )              :: active_domain
+
+CONTAINS
+
+   LOGICAL FUNCTION nests_to_open ( parent , nestid , kid )
+      IMPLICIT NONE
+      TYPE(domain) , INTENT(IN)  :: parent
+      INTEGER, INTENT(OUT)       :: nestid , kid
+      ! Local data
+      INTEGER                    :: parent_id
+      INTEGER                    :: rent
+      INTEGER                    :: s_yr,s_mm,s_dd,s_h,s_m,s_s,rc
+      INTEGER                    :: e_yr,e_mm,e_dd,e_h,e_m,e_s
+      INTEGER                    :: max_dom
+      TYPE (WRFU_Time)           :: nest_start, nest_stop
+!#define STUB_FOR_NOW
+#ifndef STUB_FOR_NOW
+      nestid = 0
+      kid = 0
+      nests_to_open = .false.
+      CALL nl_get_max_dom( 1, max_dom )
+      DO nestid = 2, max_dom
+        IF ( .NOT. active_domain( nestid ) ) THEN
+          CALL nl_get_parent_id( nestid, parent_id )  ! from namelist
+          IF ( parent_id .EQ. parent%id ) THEN
+            CALL nl_get_start_year(nestid,s_yr)   ; CALL nl_get_end_year(nestid,e_yr)
+            CALL nl_get_start_month(nestid,s_mm)  ; CALL nl_get_end_month(nestid,e_mm)
+            CALL nl_get_start_day(nestid,s_dd)    ; CALL nl_get_end_day(nestid,e_dd)
+            CALL nl_get_start_hour(nestid,s_h)    ; CALL nl_get_end_hour(nestid,e_h)
+            CALL nl_get_start_minute(nestid,s_m)  ; CALL nl_get_end_minute(nestid,e_m)
+            CALL nl_get_start_second(nestid,s_s)  ; CALL nl_get_end_second(nestid,e_s)
+            CALL WRFU_TimeSet( nest_start,YY=s_yr,MM=s_mm,DD=s_dd,H=s_h,M=s_m,S=s_s,rc=rc)
+            CALL WRFU_TimeSet( nest_stop,YY=e_yr,MM=e_mm,DD=e_dd,H=e_h,M=e_m,S=e_s,rc=rc)
+            IF ( nest_start .LE. domain_get_current_time(head_grid) .AND. &
+                 nest_stop  .GT. domain_get_current_time(head_grid) ) THEN
+              DO kid = 1 , max_nests
+                IF ( .NOT. ASSOCIATED ( parent%nests(kid)%ptr ) ) THEN
+                  active_domain( nestid ) = .true.
+                  nests_to_open = .true.
+                  RETURN
+                END IF
+              END DO
+            END IF
+          END IF
+        END IF
+      END DO
+#else
+      nestid = 0
+      kid = 0
+      nests_to_open = .false.
+#endif
+      RETURN
+   END FUNCTION nests_to_open
+
+   ! Descend tree rooted at grid and set sibling pointers for
+   ! grids that overlap.  We need some kind of global point space
+   ! for working this out.
+
+   SUBROUTINE set_overlaps ( grid )
+      IMPLICIT NONE
+      TYPE (domain), INTENT(INOUT)    :: grid
+      ! stub
+   END SUBROUTINE set_overlaps
+
+   SUBROUTINE init_module_nesting
+      active_domain = .FALSE.
+   END SUBROUTINE init_module_nesting
+
+END MODULE module_nesting
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_quilt_outbuf_ops.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_quilt_outbuf_ops.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_quilt_outbuf_ops.F	(revision 2744)
@@ -0,0 +1,495 @@
+MODULE module_quilt_outbuf_ops
+!<DESCRIPTION>
+!<PRE>
+! This module contains routines and data structures used by the I/O quilt 
+! servers to assemble fields ("quilting") and write them to disk.  
+!</PRE>
+!</DESCRIPTION>
+  INTEGER, PARAMETER :: tabsize = 1000
+  INTEGER            :: num_entries
+
+  TYPE outrec
+    CHARACTER*80                       :: VarName, DateStr, MemoryOrder, Stagger, DimNames(3)
+    INTEGER                            :: ndim
+    INTEGER, DIMENSION(3)              :: DomainStart, DomainEnd
+    INTEGER                            :: FieldType
+    REAL,    POINTER, DIMENSION(:,:,:) :: rptr 
+    INTEGER, POINTER, DIMENSION(:,:,:) :: iptr
+  END TYPE outrec
+
+  TYPE(outrec), DIMENSION(tabsize) :: outbuf_table
+
+CONTAINS
+
+  SUBROUTINE init_outbuf
+!<DESCRIPTION>
+!<PRE>
+! This routine re-initializes module data structures.  
+!</PRE>
+!</DESCRIPTION>
+    IMPLICIT NONE
+    INTEGER i
+    DO i = 1, tabsize
+      outbuf_table(i)%VarName = ""
+      outbuf_table(i)%DateStr = ""
+      outbuf_table(i)%MemoryOrder = ""
+      outbuf_table(i)%Stagger = ""
+      outbuf_table(i)%DimNames(1) = ""
+      outbuf_table(i)%DimNames(2) = ""
+      outbuf_table(i)%DimNames(3) = ""
+      outbuf_table(i)%ndim = 0
+      NULLIFY( outbuf_table(i)%rptr )
+      NULLIFY( outbuf_table(i)%iptr )
+    ENDDO
+    num_entries = 0
+  END SUBROUTINE init_outbuf
+
+
+  SUBROUTINE write_outbuf ( DataHandle , io_form_arg )
+!<DESCRIPTION>
+!<PRE>
+! This routine writes all of the records stored in outbuf_table to the 
+! file referenced by DataHandle using format specified by io_form_arg.  
+! This routine calls the package-specific I/O routines to accomplish 
+! the write.  
+! It then re-initializes module data structures.  
+!</PRE>
+!</DESCRIPTION>
+    USE module_state_description
+    IMPLICIT NONE
+#include "wrf_io_flags.h"
+    INTEGER , INTENT(IN)  :: DataHandle, io_form_arg
+    INTEGER               :: ii,ds1,de1,ds2,de2,ds3,de3
+    INTEGER               :: Comm, IOComm, DomainDesc ! dummy
+    INTEGER               :: Status
+    CHARACTER*80          :: mess
+    Comm = 0 ; IOComm = 0 ; DomainDesc = 0 
+    DO ii = 1, num_entries
+      WRITE(mess,*)'writing ', &
+                    TRIM(outbuf_table(ii)%DateStr)," ",                                   &
+                    TRIM(outbuf_table(ii)%VarName)," ",                                   &
+                    TRIM(outbuf_table(ii)%MemoryOrder)
+      ds1 = outbuf_table(ii)%DomainStart(1) ; de1 = outbuf_table(ii)%DomainEnd(1)
+      ds2 = outbuf_table(ii)%DomainStart(2) ; de2 = outbuf_table(ii)%DomainEnd(2)
+      ds3 = outbuf_table(ii)%DomainStart(3) ; de3 = outbuf_table(ii)%DomainEnd(3)
+
+      SELECT CASE ( io_form_arg )
+
+#ifdef NETCDF
+        CASE ( IO_NETCDF   )
+
+          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
+
+          CALL ext_ncd_write_field ( DataHandle ,                                     &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+
+          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
+          CALL ext_ncd_write_field ( DataHandle ,                                     &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+          ENDIF
+#endif
+#ifdef YYY
+      CASE ( IO_YYY   )
+
+          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
+
+          CALL ext_yyy_write_field ( DataHandle ,                                     &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+
+          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
+          CALL ext_yyy_write_field ( DataHandle ,                                     &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+          ENDIF
+#endif
+#ifdef GRIB1
+      CASE ( IO_GRIB1   )
+
+          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
+
+          CALL ext_gr1_write_field ( DataHandle ,                                   &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+
+          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
+          CALL ext_gr1_write_field ( DataHandle ,                                   &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+          ENDIF
+#endif
+#ifdef GRIB2
+      CASE ( IO_GRIB2   )
+
+          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
+
+          CALL ext_gr2_write_field ( DataHandle ,                                   &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+
+          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
+          CALL ext_gr2_write_field ( DataHandle ,                                   &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+          ENDIF
+#endif
+#ifdef INTIO
+        CASE ( IO_INTIO  )
+          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
+
+          CALL ext_int_write_field ( DataHandle ,                                     &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+
+          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
+
+          CALL ext_int_write_field ( DataHandle ,                                     &
+                                 TRIM(outbuf_table(ii)%DateStr),                      &
+                                 TRIM(outbuf_table(ii)%VarName),                      &
+                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
+                                 outbuf_table(ii)%FieldType,                          &  !*
+                                 Comm, IOComm, DomainDesc ,                           &
+                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
+                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
+                                 outbuf_table(ii)%DimNames ,                          &  !*
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 outbuf_table(ii)%DomainStart,                        &
+                                 outbuf_table(ii)%DomainEnd,                          &
+                                 Status )
+
+          ENDIF
+#endif
+        CASE DEFAULT
+      END SELECT
+
+
+      IF ( ASSOCIATED( outbuf_table(ii)%rptr) ) DEALLOCATE(outbuf_table(ii)%rptr)
+      IF ( ASSOCIATED( outbuf_table(ii)%iptr) ) DEALLOCATE(outbuf_table(ii)%iptr)
+      NULLIFY( outbuf_table(ii)%rptr )
+      NULLIFY( outbuf_table(ii)%iptr )
+    ENDDO
+    CALL init_outbuf
+  END SUBROUTINE write_outbuf
+
+END MODULE module_quilt_outbuf_ops
+
+! don't let other programs see the definition of this; type mismatches
+! on inbuf will result;  may want to make a module program at some point 
+  SUBROUTINE store_patch_in_outbuf( inbuf_r, inbuf_i, DateStr, VarName , FieldType, MemoryOrder, Stagger, DimNames, &
+                                    DomainStart , DomainEnd , &
+                                    MemoryStart , MemoryEnd , &
+                                    PatchStart , PatchEnd )
+!<DESCRIPTION>
+!<PRE>
+! This routine does the "output quilting".  
+!
+! It stores a patch in the appropriate location in a domain-sized array 
+! within an element of the outbuf_table data structure.  DateStr, VarName, and 
+! MemoryOrder are used to uniquely identify which element of outbuf_table is 
+! associated with this array.  If no element is associated, then this routine 
+! first assigns an unused element and allocates space within that element for 
+! the globally-sized array.  This routine also stores DateStr, VarName, 
+! FieldType, MemoryOrder, Stagger, DimNames, DomainStart, and DomainEnd within 
+! the same element of outbuf.  
+!</PRE>
+!</DESCRIPTION>
+    USE module_quilt_outbuf_ops
+    IMPLICIT NONE
+#include "wrf_io_flags.h"
+    INTEGER ,                INTENT(IN) :: FieldType
+    REAL    , DIMENSION(*) , INTENT(IN) :: inbuf_r
+    INTEGER , DIMENSION(*) , INTENT(IN) :: inbuf_i
+    INTEGER , DIMENSION(3) , INTENT(IN) :: DomainStart , DomainEnd , MemoryStart , MemoryEnd , PatchStart , PatchEnd
+    CHARACTER*(*)    , INTENT(IN) :: DateStr , VarName, MemoryOrder , Stagger, DimNames(3)
+! Local
+    CHARACTER*120 mess
+    INTEGER               :: l,m,n,ii,jj
+    LOGICAL               :: found
+
+    ! Find the VarName if it's in the buffer already
+    ii = 1
+    found = .false.
+    DO WHILE ( .NOT. found .AND. ii .LE. num_entries )
+      !TBH:  need to test other attributes too!  
+      IF ( TRIM(VarName) .EQ. TRIM(outbuf_table(ii)%VarName) ) THEN
+        IF ( TRIM(DateStr) .EQ. TRIM(outbuf_table(ii)%DateStr) ) THEN
+          IF ( TRIM(MemoryOrder) .EQ. TRIM(outbuf_table(ii)%MemoryOrder) ) THEN
+            found = .true.
+          ELSE
+            CALL wrf_error_fatal("store_patch_in_outbuf: memory order disagreement")
+          ENDIF
+        ELSE
+          CALL wrf_error_fatal("store_patch_in_outbuf: multiple dates in buffer")
+        ENDIF
+      ELSE
+        ii = ii + 1
+      ENDIF
+    ENDDO
+    IF ( .NOT. found ) THEN
+      num_entries = num_entries + 1
+      IF      ( FieldType .EQ. WRF_FLOAT ) THEN
+        ALLOCATE( outbuf_table(num_entries)%rptr(DomainStart(1):DomainEnd(1), &
+                                                 DomainStart(2):DomainEnd(2),DomainStart(3):DomainEnd(3)) )
+      ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
+        ALLOCATE( outbuf_table(num_entries)%iptr(DomainStart(1):DomainEnd(1), &
+                                                 DomainStart(2):DomainEnd(2),DomainStart(3):DomainEnd(3)) )
+      ELSE
+        write(mess,*)"store_patch_in_outbuf: unsupported type ", FieldType
+        CALL wrf_error_fatal(mess)
+      ENDIF
+      outbuf_table(num_entries)%VarName = TRIM(VarName)
+      outbuf_table(num_entries)%DateStr = TRIM(DateStr)
+      outbuf_table(num_entries)%MemoryOrder = TRIM(MemoryOrder)
+      outbuf_table(num_entries)%Stagger = TRIM(Stagger)
+      outbuf_table(num_entries)%DimNames(1) = TRIM(DimNames(1))
+      outbuf_table(num_entries)%DimNames(2) = TRIM(DimNames(2))
+      outbuf_table(num_entries)%DimNames(3) = TRIM(DimNames(3))
+      outbuf_table(num_entries)%DomainStart = DomainStart
+      outbuf_table(num_entries)%DomainEnd = DomainEnd
+      outbuf_table(num_entries)%FieldType = FieldType
+      ii = num_entries
+    ENDIF
+    jj = 1
+    IF (  FieldType .EQ. WRF_FLOAT ) THEN
+      DO n = PatchStart(3),PatchEnd(3)
+        DO m = PatchStart(2),PatchEnd(2)
+          DO l = PatchStart(1),PatchEnd(1)
+            outbuf_table(ii)%rptr(l,m,n) = inbuf_r(jj)
+            jj = jj + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDIF
+    IF (  FieldType .EQ. WRF_INTEGER ) THEN
+      DO n = PatchStart(3),PatchEnd(3)
+        DO m = PatchStart(2),PatchEnd(2)
+          DO l = PatchStart(1),PatchEnd(1)
+            outbuf_table(ii)%iptr(l,m,n) = inbuf_i(jj)
+            jj = jj + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDIF
+
+    RETURN
+
+  END SUBROUTINE store_patch_in_outbuf
+
+!call add_to_bufsize_for_field( VarName, hdrbufsize+chunksize )
+
+  SUBROUTINE add_to_bufsize_for_field( VarName, Nbytes )
+!<DESCRIPTION>
+!<PRE>
+! This routine is a wrapper for C routine add_to_bufsize_for_field_c() that 
+! is used to accumulate buffer sizes.  Buffer size Nbytes is added to the 
+! curent buffer size for the buffer named VarName.  Any buffer space 
+! associated with VarName is freed.  If a buffer named VarName does not exist, 
+! a new one is assigned and its size is set to Nbytes.  
+!</PRE>
+!</DESCRIPTION>
+    USE module_quilt_outbuf_ops
+    IMPLICIT NONE
+    CHARACTER*(*)    , INTENT(IN) :: VarName
+    INTEGER          , INTENT(IN) :: Nbytes
+! Local
+    CHARACTER*120 mess
+    INTEGER               :: i, ierr
+    INTEGER               :: VarNameAsInts( 256 )
+    VarNameAsInts( 1 ) = len(trim(VarName))
+    DO i = 2, len(trim(VarName)) + 1
+      VarNameAsInts( i ) = ICHAR( VarName(i-1:i-1) )
+    ENDDO
+    CALL add_to_bufsize_for_field_c ( VarNameAsInts, Nbytes )
+    RETURN
+  END SUBROUTINE add_to_bufsize_for_field
+  
+  SUBROUTINE store_piece_of_field( inbuf, VarName, Nbytes )
+!<DESCRIPTION>
+!<PRE>
+! This routine is a wrapper for C routine store_piece_of_field_c() that 
+! is used to store pieces of a field in an internal buffer.  Nbytes bytes of 
+! buffer inbuf are appended to the end of the internal buffer named VarName.  
+! An error occurs if either an internal buffer named VarName does not exist or 
+! if there are fewer than Nbytes bytes left in the internal buffer.  
+!</PRE>
+!</DESCRIPTION>
+    USE module_quilt_outbuf_ops
+    IMPLICIT NONE
+    INTEGER ,                INTENT(IN) :: Nbytes
+    INTEGER , DIMENSION(*) , INTENT(IN) :: inbuf
+    CHARACTER*(*)    , INTENT(IN) :: VarName
+! Local
+    CHARACTER*120 mess
+    INTEGER               :: i, ierr
+    INTEGER               :: VarNameAsInts( 256 )
+
+    VarNameAsInts( 1 ) = len(trim(VarName))
+    DO i = 2, len(trim(VarName)) + 1
+      VarNameAsInts( i ) = ICHAR( VarName(i-1:i-1) )
+    ENDDO
+    CALL store_piece_of_field_c ( inbuf, VarNameAsInts, Nbytes, ierr )
+    IF ( ierr .NE. 0 ) CALL wrf_error_fatal ( "store_piece_of_field" )
+    RETURN
+  END SUBROUTINE store_piece_of_field
+
+  SUBROUTINE retrieve_pieces_of_field( outbuf, VarName, obufsz, Nbytes_tot, lret )
+!<DESCRIPTION>
+!<PRE>
+! This routine is a wrapper for C routine retrieve_pieces_of_field_c() that 
+! is used to extract the entire contents (i.e. all previously stored pieces of 
+! fields) of the next internal buffer.  The name associated with this internal 
+! buffer is returned in VarName.  The number of bytes read is returned in 
+! Nbytes_tot.  Bytes are stored in outbuf whose size (in bytes) is obufsz.  
+! If there are more than obufsz bytes left in the next internal buffer, then 
+! only obufsz bytes are returned and the rest are discarded (probably an error 
+! in the making!).  The internal buffer is then freed.  Flag lret is set to 
+! .TRUE. iff there are more fields left to extract.  
+!</PRE>
+!</DESCRIPTION>
+    USE module_quilt_outbuf_ops
+    IMPLICIT NONE
+    INTEGER ,                INTENT(IN) :: obufsz
+    INTEGER ,                INTENT(OUT) :: Nbytes_tot
+    INTEGER , DIMENSION(*) , INTENT(OUT) :: outbuf
+    CHARACTER*(*)    , INTENT(OUT) :: VarName
+    LOGICAL                       :: lret   ! true if more, false if not
+! Local
+    CHARACTER*120 mess
+    INTEGER               :: i, iret
+    INTEGER               :: VarNameAsInts( 256 )
+
+    CALL retrieve_pieces_of_field_c ( outbuf, VarNameAsInts, obufsz, Nbytes_tot, iret )
+    IF ( iret .NE.  0 ) THEN
+       lret = .FALSE.
+    ELSE
+       lret = .TRUE.
+       VarName = ' '
+       DO i = 2, VarNameAsInts(1) + 1
+         VarName(i-1:i-1) = CHAR(VarNameAsInts( i ))
+       ENDDO
+    ENDIF
+    RETURN
+  END SUBROUTINE retrieve_pieces_of_field
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_sm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_sm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_sm.F	(revision 2744)
@@ -0,0 +1,55 @@
+!WRF:PACKAGE:OPENMP
+!
+
+MODULE module_sm
+
+#ifdef _OPENMP
+
+   !  There are a few functions in the OpenMP library,
+   !  and to use them easily, we need to define the 
+   !  return types of these functions.
+
+   INTEGER , EXTERNAL :: omp_get_num_threads , &
+                         omp_get_max_threads , &
+                         omp_get_thread_num  , &
+                         omp_get_num_procs
+
+   LOGICAL , EXTERNAL :: omp_in_parallel        
+#endif
+
+CONTAINS
+
+   SUBROUTINE omp_info
+
+#ifdef _OPENMP
+
+      IMPLICIT NONE
+
+      PRINT '(/A,/,A,/,A,I2/)','omp_get_num_threads:', &
+                              'Number of threads currently in the team executing', &
+                              'the parallel region = ',omp_get_num_threads()
+
+      PRINT '(A,/,A,/,A,I2/)', 'omp_get_max_threads:', &
+                              'Maximum value that can be returned by the',&
+                              'omp_get_num_threads function = ',omp_get_max_threads()
+
+      PRINT '(A,/,A,/,A,I2/)', 'omp_get_thread_num:', &
+                              'Returns the thread number, within the team, between', &
+                              '0 and omp_get_num_threads-1, inclusive = ',omp_get_thread_num()
+
+      PRINT '(A,/,A,/,A,I2/)', 'omp_get_num_procs:', &
+                              'Returns the number of processors that are available', &
+                              'to the program = ',omp_get_num_procs()
+
+      PRINT '(A,/,A,/,A,L7/)','omp_in_parallel:', &
+                              'Returns .TRUE. if called with the dynamic extent of a region', &
+                              'executing in parallel, and otherwise .FALSE. = ',omp_in_parallel()
+
+#endif
+
+   END SUBROUTINE omp_info
+
+   SUBROUTINE init_module_sm
+   END SUBROUTINE init_module_sm
+
+END MODULE module_sm
Index: trunk/WRF.COMMON/WRFV2/frame/module_tiles.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_tiles.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_tiles.F	(revision 2744)
@@ -0,0 +1,425 @@
+!WRF:DRIVER_LAYER:TILING
+!
+
+MODULE module_tiles
+
+  USE module_configure
+
+  INTERFACE set_tiles
+    MODULE PROCEDURE set_tiles1 , set_tiles2, set_tiles3
+  END INTERFACE
+
+CONTAINS
+
+! CPP macro for error checking
+#define ERROR_TEST(A,O,B) IF( A O B )THEN;WRITE(mess,'(3A4)')'A','O','B';CALL WRF_ERROR_FATAL(mess);ENDIF
+
+! this version is used to compute only on a boundary of some width
+! The ids, ide, jds, and jde arguments specify the edge of the boundary (a way of
+! accounting for staggering, and the bdyw gives the number of cells
+! (idea: if bdyw is negative, have it do the reverse and specify the 
+! interior, less the boundary.
+
+  SUBROUTINE set_tiles1 ( grid , ids , ide , jds , jde , bdyw )
+
+     USE module_domain
+     USE module_driver_constants
+     USE module_machine
+     USE module_wrf_error
+
+     IMPLICIT NONE
+  
+     !  Input data.
+  
+     TYPE(domain)                   , INTENT(INOUT)  :: grid
+     INTEGER                        , INTENT(IN)     :: ids , ide , jds , jde , bdyw
+
+     !  Local data
+
+     INTEGER                                :: spx, epx, spy, epy, t, tt, ts, te
+     INTEGER                                :: smx, emx, smy, emy
+     INTEGER                                :: ntiles , num_tiles
+
+     CHARACTER*80              :: mess
+
+     data_ordering : SELECT CASE ( model_data_order )
+       CASE  ( DATA_ORDER_XYZ )
+         spx = grid%sp31 ; epx = grid%ep31 ; spy = grid%sp32 ; epy = grid%ep32
+       CASE  ( DATA_ORDER_YXZ )
+         spx = grid%sp32 ; epx = grid%ep32 ; spy = grid%sp31 ; epy = grid%ep31
+       CASE  ( DATA_ORDER_ZXY )
+         spx = grid%sp32 ; epx = grid%ep32 ; spy = grid%sp33 ; epy = grid%ep33
+       CASE  ( DATA_ORDER_ZYX )
+         spx = grid%sp33 ; epx = grid%ep33 ; spy = grid%sp32 ; epy = grid%ep32
+       CASE  ( DATA_ORDER_XZY )
+         spx = grid%sp31 ; epx = grid%ep31 ; spy = grid%sp33 ; epy = grid%ep33
+       CASE  ( DATA_ORDER_YZX )
+         spx = grid%sp33 ; epx = grid%ep33 ; spy = grid%sp31 ; epy = grid%ep31
+     END SELECT data_ordering
+
+     num_tiles = 4
+
+     IF ( num_tiles > grid%max_tiles ) THEN
+       IF ( ASSOCIATED(grid%i_start) ) THEN ; DEALLOCATE( grid%i_start ) ; NULLIFY( grid%i_start ) ; ENDIF
+       IF ( ASSOCIATED(grid%i_end) )   THEN ; DEALLOCATE( grid%i_end   ) ; NULLIFY( grid%i_end   ) ; ENDIF
+       IF ( ASSOCIATED(grid%j_start) ) THEN ; DEALLOCATE( grid%j_start ) ; NULLIFY( grid%j_start ) ; ENDIF
+       IF ( ASSOCIATED(grid%j_end) )   THEN ; DEALLOCATE( grid%j_end   ) ; NULLIFY( grid%j_end   ) ; ENDIF
+       ALLOCATE(grid%i_start(num_tiles))
+       ALLOCATE(grid%i_end(num_tiles))
+       ALLOCATE(grid%j_start(num_tiles))
+       ALLOCATE(grid%j_end(num_tiles))
+       grid%max_tiles = num_tiles
+     ENDIF
+
+! XS boundary
+     IF      ( ids .ge. spx .and. ids .le. epx ) THEN
+        grid%i_start(1) = ids
+        grid%i_end(1)   = min( ids+bdyw-1 , epx )
+        grid%j_start(1) = max( spy , jds )
+        grid%j_end(1)   = min( epy , jde )
+     ELSEIF  ( (ids+bdyw-1) .ge. spx .and. (ids+bdyw-1) .le. epx ) THEN
+        grid%i_start(1) = max( ids , spx )
+        grid%i_end(1)   = ids+bdyw-1
+        grid%j_start(1) = max( spy , jds )
+        grid%j_end(1)   = min( epy , jde )
+     ELSE
+        grid%i_start(1) = 1
+        grid%i_end(1)   = -1
+        grid%j_start(1) = 1
+        grid%j_end(1)   = -1
+     ENDIF
+
+! XE boundary
+     IF      ( ide .ge. spx .and. ide .le. epx ) THEN
+        grid%i_start(2) = max( ide-bdyw+1 , spx )
+        grid%i_end(2)   = ide
+        grid%j_start(2) = max( spy , jds )
+        grid%j_end(2)   = min( epy , jde )
+     ELSEIF  ( (ide-bdyw+1) .ge. spx .and. (ide-bdyw+1) .le. epx ) THEN
+        grid%i_start(2) = ide-bdyw+1
+        grid%i_end(2)   = min( ide , epx )
+        grid%j_start(2) = max( spy , jds )
+        grid%j_end(2)   = min( epy , jde )
+     ELSE
+        grid%i_start(2) = 1
+        grid%i_end(2)   = -1
+        grid%j_start(2) = 1
+        grid%j_end(2)   = -1
+     ENDIF
+
+! YS boundary (note that the corners may already be done by XS and XE)
+     IF      ( jds .ge. spy .and. jds .le. epy ) THEN
+        grid%j_start(3) = jds
+        grid%j_end(3)   = min( jds+bdyw-1 , epy )
+        grid%i_start(3) = max( spx , ids+bdyw )
+        grid%i_end(3)   = min( epx , ide-bdyw )
+     ELSEIF  ( (jds+bdyw-1) .ge. spy .and. (jds+bdyw-1) .le. epy ) THEN
+        grid%j_start(3) = max( jds , spy )
+        grid%j_end(3)   = jds+bdyw-1
+        grid%i_start(3) = max( spx , ids+bdyw )
+        grid%i_end(3)   = min( epx , ide-bdyw )
+     ELSE
+        grid%j_start(3) = 1
+        grid%j_end(3)   = -1
+        grid%i_start(3) = 1
+        grid%i_end(3)   = -1
+     ENDIF
+
+! YE boundary (note that the corners may already be done by XS and XE)
+     IF      ( jde .ge. spy .and. jde .le. epy ) THEN
+        grid%j_start(4) = max( jde-bdyw+1 , spy )
+        grid%j_end(4)   = jde
+        grid%i_start(4) = max( spx , ids+bdyw )
+        grid%i_end(4)   = min( epx , ide-bdyw )
+     ELSEIF  ( (jde-bdyw+1) .ge. spy .and. (jde-bdyw+1) .le. epy ) THEN
+        grid%j_start(4) = jde-bdyw+1
+        grid%j_end(4)   = min( jde , epy )
+        grid%i_start(4) = max( spx , ids+bdyw )
+        grid%i_end(4)   = min( epx , ide-bdyw )
+     ELSE
+        grid%j_start(4) = 1
+        grid%j_end(4)   = -1
+        grid%i_start(4) = 1
+        grid%i_end(4)   = -1
+     ENDIF
+
+     grid%num_tiles = num_tiles
+
+     RETURN
+  END SUBROUTINE set_tiles1
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! this version is used to limit the domain or compute onto halos
+  SUBROUTINE set_tiles2 ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
+     USE module_domain
+     USE module_driver_constants
+     USE module_machine
+     USE module_wrf_error
+
+     IMPLICIT NONE
+  
+     !  Input data.
+  
+     TYPE(domain)                   , INTENT(INOUT)  :: grid
+     INTEGER                        , INTENT(IN)     :: ids , ide , jds , jde
+     INTEGER                        , INTENT(IN)     :: ips , ipe , jps , jpe
+
+     !  Output data.
+
+     !  Local data.
+  
+     INTEGER                                :: num_tiles_x, num_tiles_y, num_tiles
+     INTEGER                                :: tile_sz_x, tile_sz_y
+     INTEGER                                :: spx, epx, spy, epy, t, tt, ts, te
+     INTEGER                                :: smx, emx, smy, emy
+     INTEGER                                :: ntiles
+     INTEGER                                :: one
+#ifdef _OPENMP
+     INTEGER , EXTERNAL        :: omp_get_max_threads
+#endif
+     CHARACTER*80              :: mess
+
+     data_ordering : SELECT CASE ( model_data_order )
+       CASE  ( DATA_ORDER_XYZ )
+         spx = grid%sp31 ; epx = grid%ep31 ; spy = grid%sp32 ; epy = grid%ep32
+         smx = grid%sm31 ; emx = grid%em31 ; smy = grid%sm32 ; emy = grid%em32
+       CASE  ( DATA_ORDER_YXZ )
+         spx = grid%sp32 ; epx = grid%ep32 ; spy = grid%sp31 ; epy = grid%ep31
+         smx = grid%sm32 ; emx = grid%em32 ; smy = grid%sm31 ; emy = grid%em31
+       CASE  ( DATA_ORDER_ZXY )
+         spx = grid%sp32 ; epx = grid%ep32 ; spy = grid%sp33 ; epy = grid%ep33
+         smx = grid%sm32 ; emx = grid%em32 ; smy = grid%sm33 ; emy = grid%em33
+       CASE  ( DATA_ORDER_ZYX )
+         spx = grid%sp33 ; epx = grid%ep33 ; spy = grid%sp32 ; epy = grid%ep32
+         smx = grid%sm33 ; emx = grid%em33 ; smy = grid%sm32 ; emy = grid%em32
+       CASE  ( DATA_ORDER_XZY )
+         spx = grid%sp31 ; epx = grid%ep31 ; spy = grid%sp33 ; epy = grid%ep33
+         smx = grid%sm31 ; emx = grid%em31 ; smy = grid%sm33 ; emy = grid%em33
+       CASE  ( DATA_ORDER_YZX )
+         spx = grid%sp33 ; epx = grid%ep33 ; spy = grid%sp31 ; epy = grid%ep31
+         smx = grid%sm33 ; emx = grid%em33 ; smy = grid%sm31 ; emy = grid%em31
+     END SELECT data_ordering
+
+     ERROR_TEST(ips,<,smx)
+     ERROR_TEST(ipe,>,emx)
+     ERROR_TEST(jps,<,smy)
+     ERROR_TEST(jpe,>,emy)
+
+     ! Here's how the number of tiles is arrived at:
+     !
+     !          if tile sizes are specified use those otherwise
+     !          if num_tiles is specified use that otherwise
+     !          if omp provides a value use that otherwise
+     !          use 1.
+     !
+
+     IF ( grid%num_tiles_spec .EQ. 0 ) THEN
+       CALL nl_get_numtiles( 1, num_tiles )
+       IF ( num_tiles .EQ. 1 ) THEN
+#ifdef _OPENMP
+         num_tiles = omp_get_max_threads()
+         WRITE(mess,'("WRF NUMBER OF TILES FROM OMP_GET_MAX_THREADS = ",I3)')num_tiles
+         CALL WRF_MESSAGE ( mess )
+#else
+         num_tiles = 1
+#endif
+       ENDIF
+! override num_tiles setting (however gotten) if tile sizes are specified
+       CALL nl_get_tile_sz_x( 1, tile_sz_x )
+       CALL nl_get_tile_sz_y( 1, tile_sz_y )
+       IF ( tile_sz_x >= 1 .and. tile_sz_y >= 1 ) THEN
+        ! figure number of whole tiles and add 1 for any partials in each dim
+          num_tiles_x = (epx-spx+1) / tile_sz_x
+          if ( tile_sz_x*num_tiles_x < epx-spx+1 ) num_tiles_x = num_tiles_x + 1
+          num_tiles_y = (epy-spy+1) / tile_sz_y
+          if ( tile_sz_y*num_tiles_y < epy-spy+1 ) num_tiles_y = num_tiles_y + 1
+          num_tiles = num_tiles_x * num_tiles_y
+       ELSE
+         IF      ( machine_info%tile_strategy == TILE_X ) THEN
+           num_tiles_x = num_tiles
+           num_tiles_y = 1
+         ELSE IF ( machine_info%tile_strategy == TILE_Y ) THEN
+           num_tiles_x = 1
+           num_tiles_y = num_tiles
+         ELSE ! Default ( machine_info%tile_strategy == TILE_XY ) THEN
+           one = 1
+           call least_aspect( num_tiles, one, one, num_tiles_y, num_tiles_x )
+         ENDIF
+       ENDIF
+       grid%num_tiles_spec = num_tiles
+       grid%num_tiles_x = num_tiles_x
+       grid%num_tiles_y = num_tiles_y
+       WRITE(mess,'("WRF NUMBER OF TILES = ",I3)')num_tiles
+       CALL WRF_MESSAGE ( mess )
+     ENDIF
+
+     num_tiles   = grid%num_tiles_spec
+     num_tiles_x = grid%num_tiles_x
+     num_tiles_y = grid%num_tiles_y
+
+     IF ( num_tiles > grid%max_tiles ) THEN
+       IF ( ASSOCIATED(grid%i_start) ) THEN ; DEALLOCATE( grid%i_start ) ; NULLIFY( grid%i_start ) ; ENDIF
+       IF ( ASSOCIATED(grid%i_end) )   THEN ; DEALLOCATE( grid%i_end   ) ; NULLIFY( grid%i_end   ) ; ENDIF
+       IF ( ASSOCIATED(grid%j_start) ) THEN ; DEALLOCATE( grid%j_start ) ; NULLIFY( grid%j_start ) ; ENDIF
+       IF ( ASSOCIATED(grid%j_end) )   THEN ; DEALLOCATE( grid%j_end   ) ; NULLIFY( grid%j_end   ) ; ENDIF
+       ALLOCATE(grid%i_start(num_tiles))
+       ALLOCATE(grid%i_end(num_tiles))
+       ALLOCATE(grid%j_start(num_tiles))
+       ALLOCATE(grid%j_end(num_tiles))
+       grid%max_tiles = num_tiles
+     ENDIF
+
+     DO t = 0, num_tiles-1
+        ntiles = mod(t,num_tiles_x)
+        CALL region_bounds( spx, epx,                                  &
+                            num_tiles_x, ntiles,                       &
+                            ts, te )
+!!!
+! This bit allows the user to specify execution out onto the halo region
+! in the call to set_tiles. If the low patch boundary specified by the arguments
+! is less than what the model already knows to be the patch boundary and if
+! the user hasn't erred by specifying something that would fall off memory
+! (safety tests are higher up in this routine, outside the IF) then adjust
+! the tile boundary of the low edge tiles accordingly. Likewise for high edges.
+        IF ( ips .lt. spx .and. ts .eq. spx ) ts = ips ;
+        IF ( ipe .gt. epx .and. te .eq. epx ) te = ipe ;
+!!!
+        grid%i_start(t+1) = max ( ts , ids )
+        grid%i_end(t+1)   = min ( te , ide )
+        ntiles = t / num_tiles_x
+        CALL region_bounds( spy, epy,                                  &
+                            num_tiles_y, ntiles,                       &
+                            ts, te )
+!
+        IF ( jps .lt. spy .and. ts .eq. spy ) ts = jps ;
+        IF ( jpe .gt. epy .and. te .eq. epy ) te = jpe ;
+!
+        grid%j_start(t+1) = max ( ts , jds )
+        grid%j_end(t+1)   = min ( te , jde )
+     END DO
+     grid%num_tiles = num_tiles
+
+     RETURN
+  END SUBROUTINE set_tiles2
+  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! this version sets the tiles based on a passed in integer mask
+! the assumption here is that the mask is relatively straigthforward
+! and coverable with 2 or three rectangles. No weird stuff...
+
+  SUBROUTINE set_tiles3 ( grid , imask, ims, ime, jms, jme, ips, ipe, jps, jpe )
+     USE module_domain
+     USE module_driver_constants
+     USE module_machine
+     USE module_wrf_error
+
+     IMPLICIT NONE
+  
+     !  Input data.
+  
+     TYPE(domain)                   , INTENT(INOUT)  :: grid
+     INTEGER                        , INTENT(IN)     :: ims , ime , jms , jme
+     INTEGER                        , INTENT(IN)     :: ips , ipe , jps , jpe
+     INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: imask
+     INTEGER                :: num_tiles
+     INTEGER, DIMENSION(50) :: i_start, i_end, j_start, j_end
+
+     !  Output data.
+
+     !  Local data.
+  
+     CHARACTER*80              :: mess
+
+     CALL set_tiles_masked ( imask, ims, ime, jms, jme, ips, ipe, jps, jpe, &
+                             num_tiles, i_start, i_end, j_start, j_end )
+
+     IF ( num_tiles > grid%max_tiles ) THEN
+       IF ( ASSOCIATED(grid%i_start) ) THEN ; DEALLOCATE( grid%i_start ) ; NULLIFY( grid%i_start ) ; ENDIF
+       IF ( ASSOCIATED(grid%i_end) )   THEN ; DEALLOCATE( grid%i_end   ) ; NULLIFY( grid%i_end   ) ; ENDIF
+       IF ( ASSOCIATED(grid%j_start) ) THEN ; DEALLOCATE( grid%j_start ) ; NULLIFY( grid%j_start ) ; ENDIF
+       IF ( ASSOCIATED(grid%j_end) )   THEN ; DEALLOCATE( grid%j_end   ) ; NULLIFY( grid%j_end   ) ; ENDIF
+       ALLOCATE(grid%i_start(num_tiles))
+       ALLOCATE(grid%i_end(num_tiles))
+       ALLOCATE(grid%j_start(num_tiles))
+       ALLOCATE(grid%j_end(num_tiles))
+       grid%max_tiles = num_tiles
+     ENDIF
+     grid%num_tiles = num_tiles
+     grid%i_start(1:num_tiles) = i_start(1:num_tiles)
+     grid%i_end(1:num_tiles)   = i_end(1:num_tiles)
+     grid%j_start(1:num_tiles) = j_start(1:num_tiles)
+     grid%j_end(1:num_tiles)   = j_end(1:num_tiles)
+
+     RETURN
+  END SUBROUTINE set_tiles3
+
+  SUBROUTINE set_tiles_masked ( imask, ims, ime, jms, jme, ips, ipe, jps, jpe, &
+                                num_tiles, istarts, iends, jstarts, jends )
+
+      IMPLICIT NONE
+
+      !  Arguments
+
+      INTEGER                        , INTENT(IN)     :: ims , ime , jms , jme
+      INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: imask
+      INTEGER                        , INTENT(IN)     :: ips , ipe , jps , jpe
+      INTEGER                        , INTENT(OUT)    :: num_tiles
+      INTEGER, DIMENSION(*)          , INTENT(OUT)    :: istarts, iends
+      INTEGER, DIMENSION(*)          , INTENT(OUT)    :: jstarts, jends
+
+      !  Output data.
+
+      !  Local data.
+      CHARACTER*80              :: mess
+      INTEGER :: i, j, ir, jr
+      INTEGER :: imaskcopy(ips:ipe,jps:jpe)    ! copy of imask to write on
+
+      imaskcopy = imask(ips:ipe,jps:jpe)
+      num_tiles = 0
+      ! simple multi-pass scheme, optimize later...
+      DO WHILE (ANY(imaskcopy == 1))
+        DO j = jps,jpe
+          DO i = ips,ipe
+            ! find first "1" and build a rectangle from it
+            IF ( imaskcopy(i,j) == 1 ) THEN
+              num_tiles = num_tiles + 1
+              istarts(num_tiles) = i
+              iends(num_tiles)   = i
+              jstarts(num_tiles) = j
+              jends(num_tiles)   = j
+              ! don't check this point again
+              imaskcopy(i,j) = 0
+              ! find length of first row
+              DO ir = istarts(num_tiles)+1,ipe
+                IF ( imaskcopy(ir,j) == 1 ) THEN
+                  iends(num_tiles) = ir
+                  ! don't check this point again
+                  imaskcopy(ir,j) = 0
+                ELSE
+                  EXIT
+                ENDIF
+              ENDDO
+              ! find number of rows
+              DO jr = jstarts(num_tiles)+1,jpe
+                IF (ALL(imaskcopy(istarts(num_tiles):iends(num_tiles),jr) == 1)) THEN
+                  jends(num_tiles) = jr
+                  ! don't check these points again
+                  imaskcopy(istarts(num_tiles):iends(num_tiles),jr) = 0
+                ELSE
+                  EXIT
+                ENDIF
+              ENDDO
+            ENDIF   ! if ( imaskcopy(i,j) == 1 )
+          ENDDO
+        ENDDO
+      ENDDO
+      RETURN
+  END SUBROUTINE set_tiles_masked
+
+  
+  SUBROUTINE init_module_tiles
+  END SUBROUTINE init_module_tiles
+
+END MODULE module_tiles
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_timing.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_timing.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_timing.F	(revision 2744)
@@ -0,0 +1,72 @@
+!WRF:DRIVER_LAYER:UTIL
+!
+
+MODULE module_timing
+
+   INTEGER, PARAMETER, PRIVATE :: cnmax = 30
+   INTEGER, PRIVATE, DIMENSION(cnmax) :: count_int1 , count_rate_int1 , count_max_int1
+   INTEGER, PRIVATE, DIMENSION(cnmax) :: count_int2 , count_rate_int2 , count_max_int2
+   INTEGER, PRIVATE :: cn = 0 
+   REAL, PRIVATE    :: elapsed_seconds , elapsed_seconds_total = 0
+   REAL, PRIVATE    :: cpu_1 , cpu_2 , cpu_seconds , cpu_seconds_total = 0
+
+CONTAINS
+
+   SUBROUTINE init_module_timing
+      cn = 0
+   END SUBROUTINE init_module_timing
+
+
+   SUBROUTINE start_timing
+
+      IMPLICIT NONE
+
+      cn = cn + 1
+      IF ( cn .gt. cnmax ) THEN
+        CALL wrf_error_fatal( 'module_timing: clock nesting error (too many nests)' )
+        RETURN
+      ENDIF
+      CALL SYSTEM_CLOCK ( count_int1(cn) , count_rate_int1(cn) , count_max_int1(cn) )
+!     CALL CPU_TIME ( cpu_1 )
+
+   END SUBROUTINE start_timing
+
+
+   SUBROUTINE end_timing ( string )
+   
+      IMPLICIT NONE
+
+      CHARACTER *(*) :: string
+
+      IF ( cn .lt. 1 ) THEN
+        CALL wrf_error_fatal( 'module_timing: clock nesting error, cn<1' ) 
+      ELSE IF ( cn .gt. cnmax ) THEN
+        CALL wrf_error_fatal( 'module_timing: clock nesting error, cn>cnmax' ) 
+      ENDIF
+
+      CALL SYSTEM_CLOCK ( count_int2(cn) , count_rate_int2(cn) , count_max_int2(cn) )
+!     CALL CPU_TIME ( cpu_2 )
+
+      IF ( count_int2(cn) < count_int1(cn) ) THEN
+         count_int2(cn) = count_int2(cn) + count_max_int2(cn)
+      ENDIF
+
+      count_int2(cn) = count_int2(cn) - count_int1(cn)
+      elapsed_seconds = REAL(count_int2(cn)) / REAL(count_rate_int2(cn))
+      elapsed_seconds_total = elapsed_seconds_total + elapsed_seconds
+
+      WRITE(6,'(A,A,A,F10.5,A)') 'Timing for ',TRIM(string),': ',elapsed_seconds,' elapsed seconds.'
+#if defined(DM_PARALLEL) && ! defined(STUBMPI)
+      WRITE(0,'(A,A,A,F10.5,A)') 'Timing for ',TRIM(string),': ',elapsed_seconds,' elapsed seconds.'
+#endif
+
+!     cpu_seconds = cpu_2 - cpu_1
+!     cpu_seconds_total = cpu_seconds_total + cpu_seconds
+!     PRINT '(A,A,A,F10.5,A)' ,'Timing for ',TRIM(string),': ',cpu_seconds,' cpu seconds.'
+
+      cn = cn - 1
+
+   END SUBROUTINE end_timing
+
+END MODULE module_timing
+
Index: trunk/WRF.COMMON/WRFV2/frame/module_wrf_error.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/module_wrf_error.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/module_wrf_error.F	(revision 2744)
@@ -0,0 +1,93 @@
+!WRF:DRIVER_LAYER:UTIL
+!
+
+MODULE module_wrf_error
+  INTEGER           :: wrf_debug_level = 0
+  CHARACTER*256     :: wrf_err_message
+CONTAINS
+
+  LOGICAL FUNCTION wrf_at_debug_level ( level )
+    IMPLICIT NONE
+    INTEGER , INTENT(IN) :: level
+    wrf_at_debug_level = ( level .LE. wrf_debug_level )
+    RETURN
+  END FUNCTION wrf_at_debug_level
+
+  SUBROUTINE init_module_wrf_error
+  END SUBROUTINE init_module_wrf_error
+
+END MODULE module_wrf_error
+
+SUBROUTINE wrf_message( str )
+  IMPLICIT NONE
+  CHARACTER*(*) str
+#if defined( DM_PARALLEL ) && ! defined( STUBMPI) 
+  write(0,*) TRIM(str)
+#endif
+  print*, TRIM(str)
+END SUBROUTINE wrf_message
+
+! intentionally write to stderr only
+SUBROUTINE wrf_message2( str )
+  IMPLICIT NONE
+  CHARACTER*(*) str
+  write(0,*) str
+END SUBROUTINE wrf_message2
+
+SUBROUTINE wrf_error_fatal3( file_str, line, str )
+  USE module_wrf_error
+  IMPLICIT NONE
+  CHARACTER*(*) file_str
+  INTEGER , INTENT (IN) :: line  ! only print file and line if line > 0
+  CHARACTER*(*) str
+  CHARACTER*256 :: line_str
+
+  write(line_str,'(i6)') line
+#if defined( DM_PARALLEL ) && ! defined( STUBMPI )
+  CALL wrf_message( '-------------- FATAL CALLED ---------------' )
+  ! only print file and line if line is positive
+  IF ( line > 0 ) THEN
+    CALL wrf_message( 'FATAL CALLED FROM FILE:  '//file_str//'  LINE:  '//TRIM(line_str) )
+  ENDIF
+  CALL wrf_message( str )
+  CALL wrf_message( '-------------------------------------------' )
+#else
+  CALL wrf_message2( '-------------- FATAL CALLED ---------------' )
+  ! only print file and line if line is positive
+  IF ( line > 0 ) THEN
+    CALL wrf_message( 'FATAL CALLED FROM FILE:  '//file_str//'  LINE:  '//TRIM(line_str) )
+  ENDIF
+  CALL wrf_message2( str )
+  CALL wrf_message2( '-------------------------------------------' )
+#endif
+  CALL wrf_abort
+END SUBROUTINE wrf_error_fatal3
+
+SUBROUTINE wrf_error_fatal( str )
+  USE module_wrf_error
+  IMPLICIT NONE
+  CHARACTER*(*) str
+  CALL wrf_error_fatal3 ( ' ', 0, str )
+END SUBROUTINE wrf_error_fatal
+
+! Check to see if expected value == actual value
+! If not, print message and exit.  
+SUBROUTINE wrf_check_error( expected, actual, str, file_str, line )
+  USE module_wrf_error
+  IMPLICIT NONE
+  INTEGER , INTENT (IN) :: expected
+  INTEGER , INTENT (IN) :: actual
+  CHARACTER*(*) str
+  CHARACTER*(*) file_str
+  INTEGER , INTENT (IN) :: line
+  CHARACTER (LEN=512)   :: rc_str
+  CHARACTER (LEN=512)   :: str_with_rc
+
+  IF ( expected .ne. actual ) THEN
+    WRITE (rc_str,*) '  Routine returned error code = ',actual
+    str_with_rc = TRIM(str // rc_str)
+    CALL wrf_error_fatal3 ( file_str, line, str_with_rc )
+  ENDIF
+END SUBROUTINE wrf_check_error
+
+
Index: trunk/WRF.COMMON/WRFV2/frame/pack_utils.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/pack_utils.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/pack_utils.c	(revision 2744)
@@ -0,0 +1,250 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define INT_PACK_DATA  int_pack_data
+#      define INT_GET_TI_HEADER_C  int_get_ti_header_c
+#      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c
+#      define ADD_TO_BUFSIZE_FOR_FIELD_C  add_to_bufsize_for_field_c
+#      define STORE_PIECE_OF_FIELD_C  store_piece_of_field_c
+#      define RETRIEVE_PIECES_OF_FIELD_C  retrieve_pieces_of_field_c
+#      define INIT_STORE_PIECE_OF_FIELD init_store_piece_of_field
+#      define INIT_RETRIEVE_PIECES_OF_FIELD init_retrieve_pieces_of_field
+#      define PERTURB_REAL perturb_real
+# else
+#   ifdef F2CSTYLE
+#      define INT_PACK_DATA  int_pack_data__
+#      define INT_GET_TI_HEADER_C  int_get_ti_header_c__
+#      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c__
+#      define ADD_TO_BUFSIZE_FOR_FIELD_C  add_to_bufsize_for_field_c__
+#      define STORE_PIECE_OF_FIELD_C  store_piece_of_field_c__
+#      define RETRIEVE_PIECES_OF_FIELD_C  retrieve_pieces_of_field_c__
+#      define INIT_STORE_PIECE_OF_FIELD init_store_piece_of_field__
+#      define INIT_RETRIEVE_PIECES_OF_FIELD init_retrieve_pieces_of_field__
+#      define PERTURB_REAL perturb_real__
+#   else
+#      define INT_PACK_DATA  int_pack_data_
+#      define INT_GET_TI_HEADER_C  int_get_ti_header_c_
+#      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c_
+#      define ADD_TO_BUFSIZE_FOR_FIELD_C  add_to_bufsize_for_field_c_
+#      define STORE_PIECE_OF_FIELD_C  store_piece_of_field_c_
+#      define RETRIEVE_PIECES_OF_FIELD_C  retrieve_pieces_of_field_c_
+#      define INIT_STORE_PIECE_OF_FIELD init_store_piece_of_field_
+#      define INIT_RETRIEVE_PIECES_OF_FIELD init_retrieve_pieces_of_field_
+#      define PERTURB_REAL perturb_real_
+#   endif
+# endif
+#endif
+
+/*    CALL int_pack_data ( hdrbuf , hdrbufsiz * inttypesize , int_local_output_buffer, int_local_output_cursor ) */
+
+INT_PACK_DATA ( unsigned char *buf , int *ninbytes , unsigned char *obuf, int *cursor )
+{
+  int i, lcurs ;
+  lcurs = *cursor - 1 ;
+  for ( i = 0 ; i < *ninbytes ; i++ )
+  {
+    obuf[lcurs++] = buf[i] ;
+  }
+  *cursor = lcurs+1 ;
+}
+
+int
+INT_GEN_TI_HEADER_C ( char * hdrbuf, int * hdrbufsize,           /* hdrbufsize is in bytes */
+                    int * itypesize, int * typesize,
+                    int * DataHandle, char * Data,
+                    int * Count, int * code )
+{
+  int i ;
+  char * p ;
+  p = hdrbuf ;
+  p += sizeof(int) ;
+  bcopy( code, p, sizeof(int) ) ; p += sizeof(int) ;       /* 2 */
+  bcopy( DataHandle, p, sizeof(int) ) ; p += sizeof(int) ; /* 3 */
+  bcopy( typesize, p, sizeof(int) ) ; p += sizeof(int) ;   /* 4 */
+  bcopy( Count, p, sizeof(int) ) ; p += sizeof(int) ;      /* 5 */
+  bcopy( Data, p, *Count * *typesize ) ; p += *Count * *typesize ; /* 6++ */
+  *hdrbufsize = (int) (p - hdrbuf) ;
+  bcopy( hdrbufsize, hdrbuf, sizeof(int) ) ;
+  return(0) ;
+}
+
+int
+INT_GET_TI_HEADER_C ( char * hdrbuf, int * hdrbufsize, int * n,  /* hdrbufsize and n are in bytes */
+                    int * itypesize, int * typesize,
+                    int * DataHandle, char * Data,
+                    int * Count, int * code )
+{
+  int i ;
+  char * p ;
+  p = hdrbuf ;
+  bcopy( p, hdrbufsize, sizeof(int) ) ;     p += sizeof(int) ;        /* 1 */
+  bcopy( p, code, sizeof(int) ) ;           p += sizeof(int) ;        /* 2 */
+  bcopy( p, DataHandle, sizeof(int) ) ;     p += sizeof(int) ;        /* 3 */
+  bcopy( p, typesize, sizeof(int) ) ;       p += sizeof(int) ;        /* 4 */
+  bcopy( p, Count, sizeof(int) ) ;          p += sizeof(int) ;        /* 5 */
+  if ( *Count * *typesize > 0 ) {
+  bcopy( p, Data, *Count * *typesize ) ;  p += *Count * *typesize ; /* 6++ */
+  }
+  *n = (int)( p - hdrbuf ) ;
+  return(0) ;
+}
+
+#define MAX_FLDS 2000
+static char fld_name[MAX_FLDS][256] ;
+static char *fld_cache[MAX_FLDS] ;
+static int fld_curs[MAX_FLDS] ;
+static int fld_bufsize[MAX_FLDS] ;
+static int fld     = 0 ;
+static int numflds = 0 ;
+static int frst = 1 ;
+
+int INIT_STORE_PIECE_OF_FIELD ()
+{
+  int i ;
+  if ( frst ) {
+    for ( i = 0 ; i < MAX_FLDS ; i++ ) {
+      fld_cache[i] = NULL ;
+    }
+    frst = 0 ; 
+  }
+  numflds = 0 ;
+  for ( i = 0 ; i < MAX_FLDS ; i++ ) {
+    strcpy( fld_name[i], "" ) ;
+    if ( fld_cache[i] != NULL ) free( fld_cache[i] ) ;
+    fld_cache[i] = NULL ;
+    fld_curs[i] = 0 ;
+    fld_bufsize[i] = 0 ;
+  }
+  return(0) ;
+}
+
+int INIT_RETRIEVE_PIECES_OF_FIELD ()
+{
+  fld = 0 ;
+  return(0) ;
+}
+
+int
+ADD_TO_BUFSIZE_FOR_FIELD_C ( int varname[], int * chunksize )
+{
+  int i, n ;
+  int found ;
+  char vname[256] ;
+
+  n = varname[0] ;
+  for ( i = 1; i <= n ; i++ ) { vname[i-1] = varname[i] ; }
+  vname[n] = '\0' ;
+
+  found = -1 ;
+  for ( i = 0 ; i < numflds ; i++ ) { if ( !strcmp( fld_name[i], vname ) ) { found = i ; break ; } }
+  if ( found == -1 ) {
+    found = numflds++ ;
+    strcpy( fld_name[found], vname ) ;
+    fld_bufsize[found] = *chunksize ;
+  }
+  else
+  {
+    fld_bufsize[found] += *chunksize ;
+  }
+  if ( fld_cache[found] != NULL ) { free( fld_cache[found] ) ; }
+  fld_cache[found] = NULL ;
+  return(0) ;
+}
+
+int
+STORE_PIECE_OF_FIELD_C ( char * buf , int varname[], int * chunksize, int *retval )
+{
+  int i, n ;
+  int found ;
+  char vname[256] ;
+
+  n = varname[0] ;
+  for ( i = 1; i <= n ; i++ ) { vname[i-1] = varname[i] ; }
+  vname[n] = '\0' ;
+
+  found = -1 ;
+  for ( i = 0 ; i < numflds ; i++ ) { if ( !strcmp( fld_name[i], vname ) ) { found = i ; break ; } }
+  if ( found == -1 ) { 
+    fprintf(stderr,"frame/pack_utils.c: field (%s) not found; was not set up with add_to_bufsize_for_field\n",vname ) ;
+    *retval = 1 ;
+    return(0)  ;
+  }
+
+  if ( fld_cache[found] == NULL ) {
+     fld_cache[found] = (char *) malloc( fld_bufsize[found] ) ;
+     fld_curs[found] = 0 ;
+  }
+
+  if ( fld_curs[found] + *chunksize > fld_bufsize[found] ) {
+    fprintf(stderr,
+"frame/pack_utils.c: %s would overwrite %d + %d  > %d [%d]\n",vname, fld_curs[found], *chunksize, fld_bufsize[found], found ) ;
+    *retval = 1 ;
+    return(0)  ;
+  }
+
+  bcopy( buf, fld_cache[found]+fld_curs[found], *chunksize ) ;
+  fld_curs[found] += *chunksize ;
+  *retval = 0 ;
+  return(0) ;
+}
+
+int
+RETRIEVE_PIECES_OF_FIELD_C ( char * buf , int varname[], int * insize, int * outsize, int *retval )
+{
+  int i, n ;
+  int found ;
+  char vname[256] ;
+
+  if ( fld < numflds ) {
+    if ( fld_curs[fld] > *insize ) {
+      fprintf(stderr,"retrieve: fld_curs[%d] (%d) > *insize (%d)\n",fld,fld_curs[fld], *insize ) ;
+    }
+    *outsize = ( fld_curs[fld] <= *insize ) ? fld_curs[fld] : *insize ;
+    varname[0] = (int) strlen( fld_name[fld] ) ;
+    for ( i = 1 ; i <= varname[0] ; i++ ) varname[i] = fld_name[fld][i-1] ;
+    for ( i = 0 ; i < *outsize ; i++ )  buf[i] = fld_cache[fld][i] ;
+    if ( fld_cache[fld] != NULL ) free ( fld_cache[fld] ) ;
+    fld_cache[fld] = NULL ;
+    fld_bufsize[fld] = 0 ;
+    fld++ ;
+    *retval = 0 ;
+  }
+  else {
+    numflds = 0 ;
+    *retval = -1 ;
+  }
+  return(0) ;
+}
+
+#define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) )
+#define INDEX_3(A,B,C)  INDEX_2( (A), INDEX_2( (B), (C), (me[1]-ms[1]+1) ), (me[1]-ms[1]+1)*(me[0]-ms[0]+1) )
+/* flip low order bit of fp number */
+int
+PERTURB_REAL ( float * field, int ds[], int de[], int ms[], int me[], int ps[], int pe[] )
+{
+   int i,j,k ;
+   int le ; /* index of little end */
+   float x = 2.0 ;
+   unsigned int y ; 
+   unsigned char a[4], *p ;
+   if ( sizeof(float) != 4 ) return(-1) ;
+   /* check endianness of machine */
+   bcopy ( &x, a, 4 ) ;
+   le = 0 ;
+   if ( a[0] == 0x40 ) le = 3 ;
+   for ( k = ps[2]-1 ; k <= pe[2]-1 ; k++ )
+     for ( j = ps[1]-1 ; j <= pe[1]-1 ; j++ )
+       for ( i = ps[0]-1 ; i <= pe[0]-1 ; i++ )
+       {
+          /* do not change zeros */
+          if ( field[ INDEX_3(k,j,i) ] != 0.0 ) {
+             p = (unsigned char *)&(field[ INDEX_3(k,j,i) ] ) ; 
+             if ( *(p+le) & 1 ) { *(p+le) &= 0x7e ; }
+             else               { *(p+le) |= 1 ; }
+          }
+       }
+   return(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/frame/wrf_debug.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/wrf_debug.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/wrf_debug.F	(revision 2744)
@@ -0,0 +1,43 @@
+SUBROUTINE set_wrf_debug_level ( level ) 
+  USE module_wrf_error 
+  IMPLICIT NONE 
+  INTEGER , INTENT(IN) :: level 
+  wrf_debug_level = level 
+  RETURN 
+END SUBROUTINE set_wrf_debug_level 
+ 
+SUBROUTINE get_wrf_debug_level ( level ) 
+  USE module_wrf_error 
+  IMPLICIT NONE 
+  INTEGER , INTENT(OUT) :: level 
+  level = wrf_debug_level 
+  RETURN 
+END SUBROUTINE get_wrf_debug_level 
+ 
+SUBROUTINE wrf_debug( level , str ) 
+  USE module_wrf_error 
+  IMPLICIT NONE 
+  CHARACTER*(*) str 
+  INTEGER , INTENT (IN) :: level 
+  INTEGER :: debug_level 
+  CHARACTER (LEN=256) :: time_str 
+  CHARACTER (LEN=256) :: grid_str 
+  CHARACTER (LEN=512) :: out_str 
+  CALL get_wrf_debug_level( debug_level ) 
+  IF ( level .LE. debug_level ) THEN 
+#ifdef _OPENMP 
+  ! old behavior 
+  CALL wrf_message( str ) 
+#else 
+  ! TBH: This fails on pgf90 6.1-4 when built with OpenMP and using more 
+  ! TBH: than one thread. It works fine multi-threaded on AIX with xlf 
+  ! TBH: 10.1.0.0 . Hence the cpp nastiness. 
+  ! new behavior: include domain name and time-stamp 
+  CALL get_current_time_string( time_str ) 
+  CALL get_current_grid_name( grid_str ) 
+  out_str = TRIM(grid_str)//' '//TRIM(time_str)//' '//TRIM(str) 
+  CALL wrf_message( TRIM(out_str) ) 
+#endif 
+  ENDIF 
+  RETURN 
+END SUBROUTINE wrf_debug 
Index: trunk/WRF.COMMON/WRFV2/frame/wrf_num_bytes_between.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/wrf_num_bytes_between.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/wrf_num_bytes_between.c	(revision 2744)
@@ -0,0 +1,79 @@
+#include <stdio.h>
+
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#  define WRF_NUM_BYTES_BETWEEN wrf_num_bytes_between
+#  define GET_INITIAL_DATA_VALUE get_initial_data_value
+#  define WHAT_IS_A_NAN  what_is_a_nan
+#  define WRF_MEM_COPY  wrf_mem_copy
+# else
+#   ifdef F2CSTYLE
+#  define WRF_NUM_BYTES_BETWEEN wrf_num_bytes_between__
+#  define GET_INITIAL_DATA_VALUE get_initial_data_value__
+#  define WHAT_IS_A_NAN  what_is_a_nan__
+#  define WRF_MEM_COPY  wrf_mem_copy__
+#   else
+#  define WRF_NUM_BYTES_BETWEEN wrf_num_bytes_between_
+#  define GET_INITIAL_DATA_VALUE get_initial_data_value_
+#  define WHAT_IS_A_NAN  what_is_a_nan_
+#  define WRF_MEM_COPY  wrf_mem_copy_
+#   endif
+# endif
+#endif
+
+WRF_NUM_BYTES_BETWEEN ( a , b , n )
+  char * a ;
+  char * b ;
+  int * n ;
+{
+  *n = a - b ;
+  if ( *n < 0 ) *n = -(*n) ;
+}
+
+/*#define NAN_VALUE */
+#ifdef NAN_VALUE
+GET_INITIAL_DATA_VALUE ( n )
+  int * n ;
+{
+  *n = 0xffc00000 ;
+}
+#else
+GET_INITIAL_DATA_VALUE ( n )
+  float * n ;
+{
+  *n = 0. ;
+}
+#endif
+
+WHAT_IS_A_NAN ( n )
+  int * n ;
+{
+  *n = 0xffc00000 ;
+#if 0
+*n = 0. ;
+fprintf(stderr,"WHAT_IS_NAN disabled\n") ;
+#endif
+}
+
+/* SUBROUTINE wrf_mem_copy( a, b, n )
+   INTEGER*1, INTENT (INOUT) :: a(*), b(*)
+   INTEGER,   INTENT (IN)    :: n
+   INTEGER                   :: i
+   DO i = 1, n
+     b(i) = a(i)
+    ENDDO
+    RETURN
+    END SUBROUTINE wrf_mem_copy */
+
+WRF_MEM_COPY ( a , b, n )
+  char * a ; 
+  char * b ; 
+  int * n ;
+{
+  int i ;
+  for ( i = 0 ; i < *n ; i++ )
+  {
+    *b++ = *a++ ;
+  }
+}
+
Index: trunk/WRF.COMMON/WRFV2/frame/wrf_shutdown.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/wrf_shutdown.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/wrf_shutdown.F	(revision 2744)
@@ -0,0 +1,15 @@
+!WRF:DRIVER_LAYER:UTIL
+!
+SUBROUTINE wrf_shutdown
+#ifdef DM_PARALLEL
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_shutdown
+#endif
+#ifdef DM_PARALLEL
+    CALL wrf_dm_shutdown
+#else
+    STOP
+#endif
+END SUBROUTINE wrf_shutdown
+
Index: trunk/WRF.COMMON/WRFV2/frame/xxx_template_ioapi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/frame/xxx_template_ioapi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/frame/xxx_template_ioapi.F	(revision 2744)
@@ -0,0 +1,763 @@
+!
+! This is a template for adding a package-dependent implemetnation of
+! the I/O API.  You can use the name xxx since that is already set up
+! as a placeholder in module_io.F, md_calls.m4, and the Registry, or
+! you can change the name here and in those other places.  For additional
+! information on adding a package to WRF, see the latest version of the
+! WRF Design and Implementation Document 1.1 (Draft). June 21, 2001
+!
+
+!--- ioinit
+SUBROUTINE ext_xxx_ioinit( SysDepInfo,Status )
+  IMPLICIT NONE
+  CHARACTER (LEN=80), INTENT(IN) :: SysDepInfo
+  INTEGER, INTENT(INOUT) :: Status
+  RETURN  
+END SUBROUTINE ext_xxx_ioinit
+
+SUBROUTINE ext_xxx_inquiry( Inquiry, Result,Status )
+  IMPLICIT NONE
+  CHARACTER *(*), INTENT(IN) :: Inquiry
+  CHARACTER *(*), INTENT(OUT) :: Result
+  INTEGER, INTENT(INOUT) :: Status
+  RETURN  
+END SUBROUTINE ext_xxx_inquiry
+
+!--- ioexit
+SUBROUTINE ext_xxx_ioexit( Status )
+  IMPLICIT NONE
+  INTEGER, INTENT(INOUT) :: Status
+  RETURN  
+END SUBROUTINE
+
+!--- open_for_write_begin
+SUBROUTINE ext_xxx_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                                     DataHandle , Status )
+  IMPLICIT NONE
+  CHARACTER *(*), INTENT(IN)  :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER *(*), INTENT(IN)  :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  RETURN  
+END SUBROUTINE ext_xxx_open_for_write_begin
+
+!--- open_for_write_commit
+SUBROUTINE ext_xxx_open_for_write_commit( DataHandle , Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN ) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  RETURN  
+END SUBROUTINE ext_xxx_open_for_write_commit
+
+!--- open_for_read 
+SUBROUTINE ext_xxx_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
+                               DataHandle , Status )
+  IMPLICIT NONE
+  CHARACTER *(*), INTENT(IN)  :: FileName
+  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
+  CHARACTER *(*), INTENT(IN)  :: SysDepInfo
+  INTEGER ,       INTENT(OUT) :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  RETURN  
+END SUBROUTINE ext_xxx_open_for_read
+
+!--- inquire_opened
+SUBROUTINE ext_xxx_inquire_opened ( DataHandle, FileName , FileStatus, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER *(*), INTENT(IN)  :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+  RETURN
+END SUBROUTINE ext_xxx_inquire_opened
+
+!--- inquire_filename
+SUBROUTINE ext_xxx_inquire_filename ( DataHandle, FileName , FileStatus, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER *(*), INTENT(OUT) :: FileName
+  INTEGER ,       INTENT(OUT) :: FileStatus
+  INTEGER ,       INTENT(OUT) :: Status
+END SUBROUTINE ext_xxx_inquire_filename
+
+!--- sync
+SUBROUTINE ext_xxx_iosync ( DataHandle, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  RETURN
+END SUBROUTINE ext_xxx_iosync
+
+!--- close
+SUBROUTINE ext_xxx_ioclose ( DataHandle, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  INTEGER ,       INTENT(OUT) :: Status
+  RETURN
+END SUBROUTINE ext_xxx_ioclose
+
+!--- get_next_time (not defined for IntIO )
+SUBROUTINE ext_xxx_get_next_time ( DataHandle, DateStr, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(OUT) :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  RETURN
+END SUBROUTINE ext_xxx_get_next_time
+
+!--- set_time
+SUBROUTINE ext_xxx_set_time ( DataHandle, DateStr, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  INTEGER ,       INTENT(OUT) :: Status
+  RETURN
+END SUBROUTINE ext_xxx_set_time
+
+!--- get_next_var  (not defined for IntIO)
+SUBROUTINE ext_xxx_get_next_var ( DataHandle, VarName, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(OUT) :: VarName
+  INTEGER ,       INTENT(OUT) :: Status
+  RETURN
+END SUBROUTINE ext_xxx_get_next_var
+
+!--- get_dom_ti_real
+SUBROUTINE ext_xxx_get_dom_ti_real ( DataHandle,Element,   Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+RETURN
+END SUBROUTINE ext_xxx_get_dom_ti_real 
+
+!--- put_dom_ti_real
+SUBROUTINE ext_xxx_put_dom_ti_real ( DataHandle,Element,   Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_ti_real 
+
+!--- get_dom_ti_double
+SUBROUTINE ext_xxx_get_dom_ti_double ( DataHandle,Element,   Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_dom_ti_double 
+
+!--- put_dom_ti_double
+SUBROUTINE ext_xxx_put_dom_ti_double ( DataHandle,Element,   Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_ti_double 
+
+!--- get_dom_ti_integer
+SUBROUTINE ext_xxx_get_dom_ti_integer ( DataHandle,Element,   Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_dom_ti_integer 
+
+!--- put_dom_ti_integer
+SUBROUTINE ext_xxx_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_ti_integer 
+
+!--- get_dom_ti_logical
+SUBROUTINE ext_xxx_get_dom_ti_logical ( DataHandle,Element,   Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_dom_ti_logical 
+
+!--- put_dom_ti_logical
+SUBROUTINE ext_xxx_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_ti_logical 
+
+!--- get_dom_ti_char
+SUBROUTINE ext_xxx_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(OUT) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_dom_ti_char 
+
+!--- put_dom_ti_char
+SUBROUTINE ext_xxx_put_dom_ti_char ( DataHandle,Element,   Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_ti_char 
+
+!--- get_dom_td_real
+SUBROUTINE ext_xxx_get_dom_td_real ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_dom_td_real 
+
+!--- put_dom_td_real
+SUBROUTINE ext_xxx_put_dom_td_real ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_td_real 
+
+!--- get_dom_td_double
+SUBROUTINE ext_xxx_get_dom_td_double ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_dom_td_double 
+
+!--- put_dom_td_double
+SUBROUTINE ext_xxx_put_dom_td_double ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_td_double 
+
+!--- get_dom_td_integer
+SUBROUTINE ext_xxx_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_dom_td_integer 
+
+!--- put_dom_td_integer
+SUBROUTINE ext_xxx_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_td_integer 
+
+!--- get_dom_td_logical
+SUBROUTINE ext_xxx_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_dom_td_logical 
+
+!--- put_dom_td_logical
+SUBROUTINE ext_xxx_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_td_logical 
+
+!--- get_dom_td_char
+SUBROUTINE ext_xxx_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(OUT) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_dom_td_char 
+
+!--- put_dom_td_char
+SUBROUTINE ext_xxx_put_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_dom_td_char 
+
+!--- get_var_ti_real
+SUBROUTINE ext_xxx_get_var_ti_real ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_ti_real 
+
+!--- put_var_ti_real
+SUBROUTINE ext_xxx_put_var_ti_real ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_ti_real 
+
+!--- get_var_ti_double
+SUBROUTINE ext_xxx_get_var_ti_double ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_ti_double 
+
+!--- put_var_ti_double
+SUBROUTINE ext_xxx_put_var_ti_double ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_ti_double 
+
+!--- get_var_ti_integer
+SUBROUTINE ext_xxx_get_var_ti_integer ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_ti_integer 
+
+!--- put_var_ti_integer
+SUBROUTINE ext_xxx_put_var_ti_integer ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_ti_integer 
+
+!--- get_var_ti_logical
+SUBROUTINE ext_xxx_get_var_ti_logical ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_ti_logical 
+
+!--- put_var_ti_logical
+SUBROUTINE ext_xxx_put_var_ti_logical ( DataHandle,Element,  Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_ti_logical 
+
+!--- get_var_ti_char
+SUBROUTINE ext_xxx_get_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  CHARACTER*(*) , INTENT(OUT) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_ti_char 
+
+!--- put_var_ti_char
+SUBROUTINE ext_xxx_put_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  CHARACTER*(*) , INTENT(IN) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_ti_char 
+
+!--- get_var_td_real
+SUBROUTINE ext_xxx_get_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_td_real 
+
+!--- put_var_td_real
+SUBROUTINE ext_xxx_put_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_td_real 
+
+!--- get_var_td_double
+SUBROUTINE ext_xxx_get_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real*8 ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_td_double 
+
+!--- put_var_td_double
+SUBROUTINE ext_xxx_put_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  real*8 ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_td_double 
+
+!--- get_var_td_integer
+SUBROUTINE ext_xxx_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  integer ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_td_integer 
+
+!--- put_var_td_integer
+SUBROUTINE ext_xxx_put_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  integer ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_td_integer 
+
+!--- get_var_td_logical
+SUBROUTINE ext_xxx_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  logical ,            INTENT(OUT) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT)  :: OutCount
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_td_logical 
+
+!--- put_var_td_logical
+SUBROUTINE ext_xxx_put_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  logical ,            INTENT(IN) :: Data(*)
+  INTEGER ,       INTENT(IN)  :: Count
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_td_logical 
+
+!--- get_var_td_char
+SUBROUTINE ext_xxx_get_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  CHARACTER*(*) , INTENT(OUT) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_td_char 
+
+!--- put_var_td_char
+SUBROUTINE ext_xxx_put_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)  :: DataHandle
+  CHARACTER*(*) , INTENT(IN)  :: Element
+  CHARACTER*(*) , INTENT(IN)  :: DateStr
+  CHARACTER*(*) , INTENT(IN)  :: VarName 
+  CHARACTER*(*) , INTENT(IN) :: Data
+  INTEGER ,       INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_put_var_td_char 
+
+!--- read_field
+SUBROUTINE ext_xxx_read_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm &
+                            DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                            DomainStart , DomainEnd ,                                    &
+                            MemoryStart , MemoryEnd ,                                    &
+                            PatchStart , PatchEnd ,                                      &
+                            Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) , INTENT(INOUT) :: DateStr
+  CHARACTER*(*) , INTENT(INOUT) :: VarName
+  INTEGER ,       INTENT(INOUT) :: Field(*)
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  character*(*)                 ,intent(in)    :: Stagger
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+RETURN
+END SUBROUTINE ext_xxx_read_field
+
+!--- write_field
+SUBROUTINE ext_xxx_write_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm , &
+                             DomainDesc , MemoryOrder , Stagger , DimNames ,              &
+                             DomainStart , DomainEnd ,                                    &
+                             MemoryStart , MemoryEnd ,                                    &
+                             PatchStart , PatchEnd ,                                      &
+                             Status )
+  IMPLICIT NONE
+  INTEGER ,       INTENT(IN)    :: DataHandle 
+  CHARACTER*(*) , INTENT(IN)    :: DateStr
+  CHARACTER*(*) , INTENT(IN)    :: VarName
+  INTEGER ,       INTENT(IN)    :: Field(*)
+  integer                       ,intent(in)    :: FieldType
+  integer                       ,intent(inout) :: Comm
+  integer                       ,intent(inout) :: IOComm
+  integer                       ,intent(in)    :: DomainDesc
+  character*(*)                 ,intent(in)    :: MemoryOrder
+  character*(*)                 ,intent(in)    :: Stagger
+  character*(*) , dimension (*) ,intent(in)    :: DimNames
+  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
+  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
+  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
+  integer                       ,intent(out)   :: Status
+RETURN
+END SUBROUTINE ext_xxx_write_field
+
+!--- get_var_info  (not implemented for IntIO)
+SUBROUTINE ext_xxx_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
+                              DomainStart , DomainEnd , Status )
+  IMPLICIT NONE
+  integer               ,intent(in)     :: DataHandle
+  character*(*)         ,intent(in)     :: VarName
+  integer               ,intent(out)    :: NDim
+  character*(*)         ,intent(out)    :: MemoryOrder
+  character*(*)         ,intent(out)    :: Stagger
+  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
+  integer               ,intent(out)    :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_var_info
+
+
+!--- end_of_frame
+SUBROUTINE ext_xxx_end_of_frame(DataHandle, Status)
+  IMPLICIT NONE
+  INTEGER, INTENT(IN)  :: DataHandle
+  INTEGER, INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_end_of_frame
+
+
+!--- error_str
+SUBROUTINE ext_xxx_error_str( Code, ReturnString, Status)
+  IMPLICIT NONE
+  INTEGER       , INTENT(IN)  :: Code
+  CHARACTER *(*), INTENT(OUT) :: ReturnString
+  INTEGER       , INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_error_str
+
+
+!--- get_previous_time
+SUBROUTINE ext_xxx_get_previous_time(DataHandle, DateStr, Status)
+  IMPLICIT NONE
+  INTEGER      , INTENT(IN)  :: DataHandle
+  CHARACTER*(*), INTENT(OUT) :: DateStr
+  INTEGER      , INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_get_previous_time
+
+
+!--- open_for_read_begin
+SUBROUTINE ext_xxx_open_for_read_begin( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status)
+  IMPLICIT NONE
+  CHARACTER*(*), INTENT(IN)      :: FileName
+  INTEGER      , INTENT(IN)      :: Comm
+  INTEGER      , INTENT(IN)      :: IOComm
+  CHARACTER*(*), INTENT(IN)      :: SysDepInfo
+  INTEGER      , INTENT(OUT)     :: DataHandle
+  INTEGER      , INTENT(OUT)     :: Status
+RETURN
+END SUBROUTINE ext_xxx_open_for_read_begin
+
+
+!--- open_for_read_commit
+SUBROUTINE ext_xxx_open_for_read_commit(DataHandle, Status)
+  IMPLICIT NONE
+  INTEGER, INTENT(IN)  :: DataHandle
+  INTEGER, INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_open_for_read_commit
+
+
+!--- open_for_update
+SUBROUTINE ext_xxx_open_for_update( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status)
+  IMPLICIT NONE
+  CHARACTER*(*), INTENT(IN)  :: FileName
+  INTEGER      , INTENT(IN)  :: Comm
+  INTEGER      , INTENT(IN)  :: IOComm
+  CHARACTER*(*), INTENT(IN)  :: SysDepInfo
+  INTEGER      , INTENT(OUT) :: DataHandle
+  INTEGER      , INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_open_for_update
+
+
+!--- open_for_write
+SUBROUTINE ext_xxx_open_for_write (DatasetName, Comm1, Comm2, &
+                                   SysDepInfo, DataHandle, Status)
+  IMPLICIT NONE
+  CHARACTER *(*), INTENT(IN)  :: DatasetName
+  INTEGER       , INTENT(IN)  :: Comm1, Comm2
+  CHARACTER *(*), INTENT(IN)  :: SysDepInfo
+  INTEGER       , INTENT(OUT) :: DataHandle
+  INTEGER       , INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_open_for_write
+
+
+!--- warning_str
+SUBROUTINE ext_xxx_warning_str( Code, ReturnString, Status)
+  IMPLICIT NONE
+  INTEGER       , INTENT(IN)  :: Code
+  CHARACTER *(*), INTENT(OUT) :: ReturnString
+  INTEGER       , INTENT(OUT) :: Status
+RETURN
+END SUBROUTINE ext_xxx_warning_str
+
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/arch
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/arch	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/arch	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON//arch/
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/build_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/build_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/build_gcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/build_gcm
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/create_make_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/create_make_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/create_make_gcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/create_make_gcm
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/ioipsl
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/ioipsl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/ioipsl	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/ioipsl/
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/aeronostd
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/aeronostd	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/aeronostd	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/aeronostd
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/dyn3d
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/dyn3d	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/dyn3d	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/dyn3d
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/dynphy_lonlat
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/dynphy_lonlat	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/dynphy_lonlat	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/dynphy_lonlat
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/filtrez
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/filtrez	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/filtrez	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/filtrez
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/grid
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/grid	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/grid	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/grid
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/misc
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/misc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/misc	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/misc
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/phy_common
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/phy_common	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/phy_common	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/phy_common
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/phystd
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/phystd	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf/phystd	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/phystd
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/libf_gcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.GENERIC/libf/
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/makegcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/makegcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/makegcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON//makegcm
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/makelmdz
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/makelmdz	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/makelmdz	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON//makelmdz
Index: trunk/WRF.COMMON/WRFV2/generic_lmd_new/makelmdz_fcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/generic_lmd_new/makelmdz_fcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/generic_lmd_new/makelmdz_fcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON//makelmdz_fcm
Index: trunk/WRF.COMMON/WRFV2/inc/.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/inc/.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/inc/.inc	(revision 2744)
@@ -0,0 +1,71 @@
+!
+! WARNING This file is generated automatically by use_registry
+! using the data base in the file named Registry.
+! Do not edit.  Your changes to this file will be lost.
+!
+! This file contains a list of the dummy arguments for
+! solve or any routine (there are others) that take
+! all of the state data through thier argument list.  A
+! subroutine definition should look like this:
+!
+! SUBROUTINE solve ( grid ,                      &
+! !
+! #include "solve_dummy_args.inc"
+! !
+!                  )
+!
+! Please note that the comment lines around the include are necessary.
+! These arguments are defined by including solve_dummy_arg_defines.inc
+! in the declaration section of the subroutine.
+!
+! Contains dummy arguments to solve.
+!
+  chem_1 , &
+  chem_2 , &
+  moist_1 , &
+  moist_2 , &
+, ru_1 , ru_2 , rv_1 , rv_2  & 
+, rw_1 , rw_2 , rrp_1 , rrp_2  & 
+, rr_1 , rr_2 , rtp_1 , rtp_2  & 
+, rom_1 , rom_2 , ru_1 , ru_2  & 
+, rv_1 , rv_2 , rw_1 , rw_2  & 
+, rrp_1 , rrp_2 , rr_1 , rr_2  & 
+, rtp_1 , rtp_2 , rom_1 , rom_2  & 
+, pip , pp , du , dv  & 
+, pib , r , rtb , rrb  & 
+, zx , zy , z , pb  & 
+, h_diabatic , zeta_z , z_zeta , msft  & 
+, msfu , msfv , f , e  & 
+, sina , cosa , ht , cofwr  & 
+, cofrz , u_base , v_base , qv_base  & 
+, rdzu , rdzw , fzm , fzp  & 
+, zeta , zetaw , dzeta , dzetaw  & 
+, rdx , rdy , dts , dtseps  & 
+, resm , zetatop , cf1 , cf2  & 
+, cf3 , sp31 , ep31 , sp32  & 
+, ep32 , sp33 , ep33 , sp34  & 
+, ep34 , sp21 , ep21 , sp22  & 
+, ep22 , sp23 , ep23 , sp11  & 
+, ep11 , sp12 , ep12 , sm31  & 
+, em31 , sm32 , em32 , sm33  & 
+, em33 , sm34 , em34 , sm21  & 
+, em21 , sm22 , em22 , sm23  & 
+, em23 , sm11 , em11 , sm12  & 
+, em12 , number_at_same_level , halo_x , halo_y  & 
+, num_tiles , num_tiles_x , num_tiles_y , tiled  & 
+, patched , time_step_max , max_dom , dyn_opt  & 
+, id , level , s_we , e_we  & 
+, s_sn , e_sn , s_vert , e_vert  & 
+, time_step_count_start , time_step_count_end , time_step_count_output , time_step_sound  & 
+, mother_id , i_mother_start , j_mother_start , i_mother_end  & 
+, j_mother_end , mother_grid_ratio , mother_time_step_ratio , moad_grid_ratio  & 
+, moad_time_step_ratio , dx , dy , dt  & 
+, smdiv , epssm , khdif , kvdif  & 
+, periodic_x , symmetric_xs , symmetric_xe , open_xs  & 
+, open_xe , periodic_y , symmetric_ys , symmetric_ye  & 
+, open_ys , open_ye , nested , specified  & 
+, top_radiation , sd31 , ed31 , sd32  & 
+, ed32 , sd33 , ed33 , sd34  & 
+, ed34 , sd21 , ed21 , sd22  & 
+, ed22 , sd23 , ed23 , sd11  & 
+, ed11 , sd12 , ed12 , total_time_steps  & 
Index: trunk/WRF.COMMON/WRFV2/inc/bench_solve_em_def.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/inc/bench_solve_em_def.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/inc/bench_solve_em_def.h	(revision 2744)
@@ -0,0 +1,69 @@
+#ifdef BENCH
+   INTEGER, EXTERNAL :: rsl_internal_microclock
+   INTEGER btimex, solve_tim
+#define SOLVE_START     solve_tim = rsl_internal_microclock()
+#define SOLVE_END       solve_tim = rsl_internal_microclock() - solve_tim
+#define BENCH_DECL(A)   integer A
+#define BENCH_INIT(A)   A=0
+#define BENCH_START(A)  btimex=rsl_internal_microclock()
+#define BENCH_END(A)    A=A+rsl_internal_microclock()-btimex
+#define BENCH_REPORT(A) write(0,*)'A= ',A
+BENCH_DECL(step_prep_tim)
+BENCH_DECL(set_phys_bc_tim)
+BENCH_DECL(init_zero_tend_tim)
+BENCH_DECL(phy_prep_tim)
+BENCH_DECL(rad_driver_tim)
+BENCH_DECL(surf_driver_tim)
+BENCH_DECL(pbl_driver_tim)
+BENCH_DECL(cu_driver_tim)
+BENCH_DECL(fdda_driver_tim)
+BENCH_DECL(cal_phy_tend)
+BENCH_DECL(comp_diff_metrics_tim)
+BENCH_DECL(tke_diff_bc_tim)
+BENCH_DECL(deform_div_tim)
+BENCH_DECL(calc_tke_tim)
+BENCH_DECL(phy_bc_tim)
+BENCH_DECL(update_phy_ten_tim)
+BENCH_DECL(tke_rhs_tim)
+BENCH_DECL(vert_diff_tim)
+BENCH_DECL(hor_diff_tim)
+BENCH_DECL(rk_tend_tim)
+BENCH_DECL(relax_bdy_dry_tim)
+BENCH_DECL(small_step_prep_tim)
+BENCH_DECL(set_phys_bc2_tim)
+BENCH_DECL(advance_uv_tim)
+BENCH_DECL(spec_bdy_uv_tim)
+BENCH_DECL(advance_mu_t_tim)
+BENCH_DECL(spec_bdy_t_tim)
+BENCH_DECL(sumflux_tim)
+BENCH_DECL(advance_w_tim)
+BENCH_DECL(spec_bdynhyd_tim)
+BENCH_DECL(cald_p_rho_tim)
+BENCH_DECL(phys_bc_tim)
+BENCH_DECL(calc_mu_uv_tim)
+BENCH_DECL(small_step_finish_tim)
+BENCH_DECL(rk_scalar_tend_tim)
+BENCH_DECL(rlx_bdy_scalar_tim)
+BENCH_DECL(update_scal_tim)
+BENCH_DECL(flow_depbdy_tim)
+BENCH_DECL(tke_adv_tim)
+BENCH_DECL(chem_adv_tim)
+BENCH_DECL(calc_p_rho_tim)
+BENCH_DECL(diag_w_tim)
+BENCH_DECL(bc_end_tim)
+BENCH_DECL(advance_ppt_tim)
+BENCH_DECL(moist_physics_prep_tim)
+BENCH_DECL(micro_driver_tim)
+BENCH_DECL(moist_phys_end_tim)
+BENCH_DECL(time_filt_tim)
+BENCH_DECL(bc_2d_tim)
+BENCH_DECL(microswap_1)
+BENCH_DECL(microswap_2)
+#else
+#define SOLVE_START
+#define SOLVE_END
+#define BENCH_INIT(A)
+#define BENCH_START(A)
+#define BENCH_END(A)
+#define BENCH_REPORT(A)
+#endif
Index: trunk/WRF.COMMON/WRFV2/inc/bench_solve_em_end.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/inc/bench_solve_em_end.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/inc/bench_solve_em_end.h	(revision 2744)
@@ -0,0 +1,53 @@
+SOLVE_END
+BENCH_REPORT(solve_tim)
+BENCH_REPORT(step_prep_tim)
+BENCH_REPORT(set_phys_bc_tim)
+BENCH_REPORT(init_zero_tend_tim)
+BENCH_REPORT(phy_prep_tim)
+BENCH_REPORT(rad_driver_tim)
+BENCH_REPORT(surf_driver_tim)
+BENCH_REPORT(pbl_driver_tim)
+BENCH_REPORT(cu_driver_tim)
+BENCH_REPORT(fdda_driver_tim)
+BENCH_REPORT(cal_phy_tend)
+BENCH_REPORT(comp_diff_metrics_tim)
+BENCH_REPORT(tke_diff_bc_tim)
+BENCH_REPORT(deform_div_tim)
+BENCH_REPORT(calc_tke_tim)
+BENCH_REPORT(phy_bc_tim)
+BENCH_REPORT(update_phy_ten_tim)
+BENCH_REPORT(tke_rhs_tim)
+BENCH_REPORT(vert_diff_tim)
+BENCH_REPORT(hor_diff_tim)
+BENCH_REPORT(rk_tend_tim)
+BENCH_REPORT(relax_bdy_dry_tim)
+BENCH_REPORT(small_step_prep_tim)
+BENCH_REPORT(set_phys_bc2_tim)
+BENCH_REPORT(advance_uv_tim)
+BENCH_REPORT(spec_bdy_uv_tim)
+BENCH_REPORT(advance_mu_t_tim)
+BENCH_REPORT(spec_bdy_t_tim)
+BENCH_REPORT(sumflux_tim)
+BENCH_REPORT(advance_w_tim)
+BENCH_REPORT(spec_bdynhyd_tim)
+BENCH_REPORT(cald_p_rho_tim)
+BENCH_REPORT(phys_bc_tim)
+BENCH_REPORT(calc_mu_uv_tim)
+BENCH_REPORT(small_step_finish_tim)
+BENCH_REPORT(rk_scalar_tend_tim)
+BENCH_REPORT(rlx_bdy_scalar_tim)
+BENCH_REPORT(update_scal_tim)
+BENCH_REPORT(flow_depbdy_tim)
+BENCH_REPORT(tke_adv_tim)
+BENCH_REPORT(chem_adv_tim)
+BENCH_REPORT(calc_p_rho_tim)
+BENCH_REPORT(diag_w_tim)
+BENCH_REPORT(bc_end_tim)
+BENCH_REPORT(advance_ppt_tim)
+BENCH_REPORT(moist_physics_prep_tim)
+BENCH_REPORT(micro_driver_tim)
+BENCH_REPORT(moist_phys_end_tim)
+BENCH_REPORT(time_filt_tim)
+BENCH_REPORT(bc_2d_tim)
+BENCH_REPORT(microswap_1)
+BENCH_REPORT(microswap_2)
Index: trunk/WRF.COMMON/WRFV2/inc/bench_solve_em_init.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/inc/bench_solve_em_init.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/inc/bench_solve_em_init.h	(revision 2744)
@@ -0,0 +1,52 @@
+BENCH_INIT(step_prep_tim)
+BENCH_INIT(set_phys_bc_tim)
+BENCH_INIT(init_zero_tend_tim)
+BENCH_INIT(phy_prep_tim)
+BENCH_INIT(rad_driver_tim)
+BENCH_INIT(surf_driver_tim)
+BENCH_INIT(pbl_driver_tim)
+BENCH_INIT(cu_driver_tim)
+BENCH_INIT(fdda_driver_tim)
+BENCH_INIT(cal_phy_tend)
+BENCH_INIT(comp_diff_metrics_tim)
+BENCH_INIT(tke_diff_bc_tim)
+BENCH_INIT(deform_div_tim)
+BENCH_INIT(calc_tke_tim)
+BENCH_INIT(phy_bc_tim)
+BENCH_INIT(update_phy_ten_tim)
+BENCH_INIT(tke_rhs_tim)
+BENCH_INIT(vert_diff_tim)
+BENCH_INIT(hor_diff_tim)
+BENCH_INIT(rk_tend_tim)
+BENCH_INIT(relax_bdy_dry_tim)
+BENCH_INIT(small_step_prep_tim)
+BENCH_INIT(set_phys_bc2_tim)
+BENCH_INIT(advance_uv_tim)
+BENCH_INIT(spec_bdy_uv_tim)
+BENCH_INIT(advance_mu_t_tim)
+BENCH_INIT(spec_bdy_t_tim)
+BENCH_INIT(sumflux_tim)
+BENCH_INIT(advance_w_tim)
+BENCH_INIT(spec_bdynhyd_tim)
+BENCH_INIT(cald_p_rho_tim)
+BENCH_INIT(phys_bc_tim)
+BENCH_INIT(calc_mu_uv_tim)
+BENCH_INIT(small_step_finish_tim)
+BENCH_INIT(rk_scalar_tend_tim)
+BENCH_INIT(rlx_bdy_scalar_tim)
+BENCH_INIT(update_scal_tim)
+BENCH_INIT(flow_depbdy_tim)
+BENCH_INIT(tke_adv_tim)
+BENCH_INIT(chem_adv_tim)
+BENCH_INIT(calc_p_rho_tim)
+BENCH_INIT(diag_w_tim)
+BENCH_INIT(bc_end_tim)
+BENCH_INIT(advance_ppt_tim)
+BENCH_INIT(moist_physics_prep_tim)
+BENCH_INIT(micro_driver_tim)
+BENCH_INIT(moist_phys_end_tim)
+BENCH_INIT(time_filt_tim)
+BENCH_INIT(bc_2d_tim)
+BENCH_INIT(microswap_1)
+BENCH_INIT(microswap_2)
+SOLVE_START
Index: trunk/WRF.COMMON/WRFV2/inc/deref_kludge.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/inc/deref_kludge.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/inc/deref_kludge.h	(revision 2744)
@@ -0,0 +1,23 @@
+#ifdef DEREF_KLUDGE
+         sm31             = grid%sm31
+         em31             = grid%em31
+         sm32             = grid%sm32
+         em32             = grid%em32
+         sm33             = grid%sm33
+         em33             = grid%em33
+
+         sm31x            = grid%sm31x
+         em31x            = grid%em31x
+         sm32x            = grid%sm32x
+         em32x            = grid%em32x
+         sm33x            = grid%sm33x
+         em33x            = grid%em33x
+
+         sm31y            = grid%sm31y
+         em31y            = grid%em31y
+         sm32y            = grid%sm32y
+         em32y            = grid%em32y
+         sm33y            = grid%sm33y
+         em33y            = grid%em33y
+#endif
+
Index: trunk/WRF.COMMON/WRFV2/inc/intio_tags.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/inc/intio_tags.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/inc/intio_tags.h	(revision 2744)
@@ -0,0 +1,34 @@
+  INTEGER, PARAMETER ::  int_ioexit			=  	     10
+  INTEGER, PARAMETER ::  int_open_for_write_begin	=  	     20
+  INTEGER, PARAMETER ::  int_open_for_write_commit	=  	     30
+  INTEGER, PARAMETER ::  int_open_for_read 		=  	     40
+  INTEGER, PARAMETER ::  int_inquire_opened 		=  	     60
+  INTEGER, PARAMETER ::  int_inquire_filename 		=  	     70
+  INTEGER, PARAMETER ::  int_iosync 			=  	     80
+  INTEGER, PARAMETER ::  int_ioclose 			=  	     90
+  INTEGER, PARAMETER ::  int_next_time 			=  	    100
+  INTEGER, PARAMETER ::  int_set_time 			=  	    110
+  INTEGER, PARAMETER ::  int_next_var 			=  	    120
+  INTEGER, PARAMETER ::  int_dom_ti_real 		=  	    140
+  INTEGER, PARAMETER ::  int_dom_ti_double 		=  	    160
+  INTEGER, PARAMETER ::  int_dom_ti_integer 		=  	    180
+  INTEGER, PARAMETER ::  int_dom_ti_logical 		=  	    200
+  INTEGER, PARAMETER ::  int_dom_ti_char 		=  	    220
+  INTEGER, PARAMETER ::  int_dom_td_real 		=  	    240
+  INTEGER, PARAMETER ::  int_dom_td_double 		=  	    260
+  INTEGER, PARAMETER ::  int_dom_td_integer 		=  	    280
+  INTEGER, PARAMETER ::  int_dom_td_logical 		=  	    300
+  INTEGER, PARAMETER ::  int_dom_td_char 		=  	    320
+  INTEGER, PARAMETER ::  int_var_ti_real 		=  	    340
+  INTEGER, PARAMETER ::  int_var_ti_double 		=  	    360
+  INTEGER, PARAMETER ::  int_var_ti_integer 		=  	    380
+  INTEGER, PARAMETER ::  int_var_ti_logical 		=  	    400
+  INTEGER, PARAMETER ::  int_var_ti_char 		=  	    420
+  INTEGER, PARAMETER ::  int_var_td_real 		=  	    440
+  INTEGER, PARAMETER ::  int_var_td_double 		=  	    460
+  INTEGER, PARAMETER ::  int_var_td_integer 		=  	    480
+  INTEGER, PARAMETER ::  int_var_td_logical 		=  	    500
+  INTEGER, PARAMETER ::  int_var_td_char 		=  	    520
+  INTEGER, PARAMETER ::  int_field 			=  	    530
+  INTEGER, PARAMETER ::  int_var_info 			=  	    540
+  INTEGER, PARAMETER ::  int_noop 			=  	    550
Index: trunk/WRF.COMMON/WRFV2/inc/rsl_cpp_flags
===================================================================
--- trunk/WRF.COMMON/WRFV2/inc/rsl_cpp_flags	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/inc/rsl_cpp_flags	(revision 2744)
@@ -0,0 +1,58 @@
+-DXPOSE_A=1
+-DHALO_RK_INIT=2
+-DHALO_RK_A_3=3
+-DHALO_RK_A_5=4
+-DHALO_RK_B=5
+-DHALO_RK_C=6
+-DHALO_RK_D_3=7
+-DHALO_RK_D_5=8
+-DHALO_RK_E_3=9
+-DHALO_RK_E_5=10
+-DHALO_RK_PHYS_A=11
+-DHALO_RK_PHYS_PBL=12
+-DHALO_RK_PHYS_DIFFUSION=13
+-DHALO_RK_TKE_3=14
+-DHALO_RK_TKE_5=15
+-DHALO_RK_CHEM_3=16
+-DHALO_RK_CHEM_5=17
+-DHALO_RK_MOIST_3=18
+-DHALO_RK_MOIST_5=19
+-DPERIOD_BDY_RK_MOUNTAIN=20
+-DPERIOD_BDY_RK_INIT=21
+-DPERIOD_BDY_RK_A=22
+-DPERIOD_BDY_RK_B=23
+-DPERIOD_BDY_RK_C=24
+-DPERIOD_BDY_RK_D=25
+-DPERIOD_BDY_RK_PHY_BC=26
+-DPERIOD_BDY_RK_MOIST=27
+-DPERIOD_BDY_RK_CHEM=28
+-DWRF_RSL_NCOMMS=28
+-DXPOSE_A=1
+-DHALO_RK_INIT=2
+-DHALO_RK_A_3=3
+-DHALO_RK_A_5=4
+-DHALO_RK_B=5
+-DHALO_RK_C=6
+-DHALO_RK_D_3=7
+-DHALO_RK_D_5=8
+-DHALO_RK_E_3=9
+-DHALO_RK_E_5=10
+-DHALO_RK_PHYS_A=11
+-DHALO_RK_PHYS_PBL=12
+-DHALO_RK_PHYS_DIFFUSION=13
+-DHALO_RK_TKE_3=14
+-DHALO_RK_TKE_5=15
+-DHALO_RK_CHEM_3=16
+-DHALO_RK_CHEM_5=17
+-DHALO_RK_MOIST_3=18
+-DHALO_RK_MOIST_5=19
+-DPERIOD_BDY_RK_MOUNTAIN=20
+-DPERIOD_BDY_RK_INIT=21
+-DPERIOD_BDY_RK_A=22
+-DPERIOD_BDY_RK_B=23
+-DPERIOD_BDY_RK_C=24
+-DPERIOD_BDY_RK_D=25
+-DPERIOD_BDY_RK_PHY_BC=26
+-DPERIOD_BDY_RK_MOIST=27
+-DPERIOD_BDY_RK_CHEM=28
+-DWRF_RSL_NCOMMS=28
Index: trunk/WRF.COMMON/WRFV2/inc/version_decl
===================================================================
--- trunk/WRF.COMMON/WRFV2/inc/version_decl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/inc/version_decl	(revision 2744)
@@ -0,0 +1,1 @@
+   CHARACTER (LEN=10) :: release_version = 'V2.2      '
Index: trunk/WRF.COMMON/WRFV2/main/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/Makefile	(revision 2744)
@@ -0,0 +1,158 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+MODULES = 
+
+OBJS    =
+
+LIBPATHS = 
+
+include ../configure.wrf
+
+$(SOLVER)_wrf : wrf.o
+	$(RANLIB) libwrflib.a
+	$(LD) -o wrf.exe $(LDFLAGS) wrf.o libwrflib.a $(LIB)
+
+$(SOLVER)_wrf_ESMFApp : wrf_ESMFMod.o wrf_ESMFApp.o wrf_SST_ESMF.o
+	$(RANLIB) libwrflib.a
+	$(LD) -o wrf_ESMFApp.exe $(LDFLAGS) wrf_ESMFApp.o wrf_ESMFMod.o libwrflib.a $(LIB)
+	$(LD) -o wrf_SST_ESMF.exe $(LDFLAGS) wrf_SST_ESMF.o wrf_ESMFMod.o libwrflib.a $(LIB)
+
+$(SOLVER)_ideal : module_initialize ideal.o
+	$(RANLIB) libwrflib.a
+	$(LD) -o ideal.exe $(LDFLAGS) ideal.o ../dyn_$(SOLVER)/module_initialize_$(IDEAL_CASE).o libwrflib.a $(LIB)
+
+$(SOLVER)_real : module_initialize real_$(SOLVER).o ndown_$(SOLVER).o nup_$(SOLVER).o
+	$(RANLIB) libwrflib.a
+	$(LD) -o real.exe $(LDFLAGS) real_$(SOLVER).o ../dyn_$(SOLVER)/module_initialize_$(IDEAL_CASE).o libwrflib.a $(LIB)
+	$(LD) -o ndown.exe $(LDFLAGS) ndown_$(SOLVER).o  ../dyn_$(SOLVER)/module_initialize_$(IDEAL_CASE).o libwrflib.a $(LIB)
+	$(LD) -o nup.exe $(LDFLAGS) nup_$(SOLVER).o  ../dyn_$(SOLVER)/module_initialize_$(IDEAL_CASE).o libwrflib.a $(LIB)
+
+convert_em : convert_em.o
+	$(RANLIB) libwrflib.a
+	$(LD) -o convert_em.exe $(LDFLAGS) convert_em.o libwrflib.a $(LIB)
+
+convert_nmm : convert_nmm.o
+	$(RANLIB) libwrflib.a
+	$(FC) -o convert_nmm.exe $(LDFLAGS) convert_nmm.o libwrflib.a $(LIB)
+
+real_nmm : real_nmm.o
+	( cd ../dyn_nmm ;  $(MAKE) module_initialize_real.o )
+	$(RANLIB) libwrflib.a
+	$(FC) -o real_nmm.exe $(LDFLAGS) real_nmm.o ../dyn_nmm/module_initialize_real.o ../share/module_optional_si_input.o ../share/input_wrf.o ../share/module_io_domain.o libwrflib.a $(LIB)
+
+module_initialize :
+	( cd ../dyn_$(SOLVER) ;  $(MAKE) module_initialize_$(IDEAL_CASE).o )
+
+## prevent real being compiled for OMP -- only for regtesting
+#$(SOLVER)_real : module_initialize real_$(SOLVER).o
+#	$(RANLIB) libwrflib.a
+#	if [ -z "$(OMP)" ] ; then $(FC) -o real.exe $(LDFLAGS) real_$(SOLVER).o ../dyn_$(SOLVER)/module_initialize_$(IDEAL_CASE).o libwrflib.a $(LIB) ; fi
+#
+## prevent module_initialize being compiled for OMP --remove after IBM debugging
+#module_initialize :
+#	if [ -z "$(OMP)" ] ; then ( cd ../dyn_$(SOLVER) ;  $(MAKE) module_initialize_$(IDEAL_CASE).o ) ; fi
+# end of regtest changes
+
+clean:
+	@ echo 'use the clean script'
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+convert_nmm.o: \
+	../frame/module_machine.o \
+	../frame/module_domain.o \
+	../frame/module_driver_constants.o \
+	../frame/module_configure.o \
+	../frame/module_timing.o \
+	../frame/module_dm.o \
+	../share/module_bc.o \
+	../share/module_io_domain.o \
+	$(ESMF_MOD_DEPENDENCE)
+
+convert_em.o: \
+	../frame/module_machine.o \
+	../frame/module_domain.o \
+	../frame/module_driver_constants.o \
+	../frame/module_configure.o \
+	../frame/module_timing.o \
+	../frame/module_dm.o \
+	../share/module_bc.o \
+	../share/module_io_domain.o \
+	$(ESMF_MOD_DEPENDENCE)
+
+ideal.o: \
+	../frame/module_machine.o \
+	../frame/module_domain.o \
+	../frame/module_driver_constants.o \
+	../frame/module_configure.o \
+	../frame/module_timing.o \
+	../frame/module_dm.o \
+	../share/module_io_domain.o \
+	../dyn_$(SOLVER)/$(CASE_MODULE) \
+	$(ESMF_MOD_DEPENDENCE)
+
+ndown_em.o: \
+	../frame/module_machine.o \
+	../frame/module_domain.o \
+	../frame/module_driver_constants.o \
+	../frame/module_configure.o \
+	../frame/module_timing.o \
+	../frame/module_dm.o \
+	../frame/module_wrf_error.o \
+	../frame/module_integrate.o \
+	../share/module_bc.o \
+	../share/module_io_domain.o \
+	../share/module_get_file_names.o \
+	../share/module_soil_pre.o \
+	../dyn_em/module_initialize_real.o \
+	../dyn_em/module_big_step_utilities_em.o \
+	$(ESMF_MOD_DEPENDENCE)
+
+nup_em.o: \
+	../frame/module_machine.o \
+	../frame/module_domain.o \
+	../frame/module_driver_constants.o \
+	../frame/module_configure.o \
+	../frame/module_timing.o \
+	../frame/module_dm.o \
+	../frame/module_wrf_error.o \
+	../frame/module_integrate.o \
+	../share/module_bc.o \
+	../share/module_io_domain.o \
+	../share/module_get_file_names.o \
+	../share/module_soil_pre.o \
+	../dyn_em/module_initialize_real.o \
+	../dyn_em/module_big_step_utilities_em.o \
+	$(ESMF_MOD_DEPENDENCE)
+
+# this already built above :../dyn_em/module_initialize.real.o \
+real_em.o: \
+	../frame/module_machine.o \
+	../frame/module_domain.o \
+	../frame/module_driver_constants.o \
+	../frame/module_configure.o \
+	../frame/module_timing.o \
+	../frame/module_dm.o \
+	../dyn_em/module_si_io_em.o \
+	../dyn_em/module_big_step_utilities_em.o \
+	../share/module_io_domain.o \
+	../share/module_date_time.o \
+	../share/module_optional_si_input.o \
+	../share/module_bc_time_utilities.o \
+	$(ESMF_MOD_DEPENDENCE)
+#	../chem/module_input_chem_data.o \
+#	../chem/module_input_chem_bioemiss.o \
+
+wrf.o:  ../share/module_wrf_top.o
+
+wrf_ESMFMod.o:  ../share/module_wrf_top.o
+
+wrf_ESMFApp.o:  wrf_ESMFMod.o
+
+wrf_SST_ESMF.o:  wrf_ESMFMod.o
+
+# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV2/main/convert_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/convert_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/convert_em.F	(revision 2744)
@@ -0,0 +1,163 @@
+!This is a data converter program. Its actions are controlled by
+!the registry and the namelist.  It will read variables on the
+!'i' stream output and output variables on the 'o' stream as
+!indicated in the registry. The input and output forms are 
+!controlled by io_form_input and io_form_history in the namelist.input.
+
+
+PROGRAM convert_data
+
+   USE module_machine
+   USE module_domain
+   USE module_io_domain
+   USE module_driver_constants
+   USE module_configure
+   USE module_timing
+#ifdef WRF_CHEM
+   USE module_input_chem_data
+   USE module_input_chem_bioemiss
+#endif
+   USE module_utility
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+   IMPLICIT NONE
+
+#ifdef WRF_CHEM
+  ! interface
+   INTERFACE
+     ! mediation-supplied 
+     SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
+       USE module_domain
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_read_wrf_chem_bioemiss
+   END INTERFACE
+#endif
+
+   REAL    :: time , bdyfrq
+
+   INTEGER :: debug_level, fid, ierr
+   CHARACTER*256 :: timestr, inpname
+
+
+   TYPE(domain) , POINTER :: null_domain
+   TYPE(domain) , POINTER :: grid
+   TYPE (grid_config_rec_type)              :: config_flags
+   INTEGER                :: number_at_same_level
+
+   INTEGER :: max_dom, domain_id
+   INTEGER :: idum1, idum2 
+#ifdef DM_PARALLEL
+   INTEGER                 :: nbytes
+   INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
+   INTEGER                 :: configbuf( configbuflen )
+   LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+#endif
+
+   INTEGER :: ids , ide , jds , jde , kds , kde
+   INTEGER :: ims , ime , jms , jme , kms , kme
+   INTEGER :: ips , ipe , jps , jpe , kps , kpe
+   INTEGER :: ijds , ijde , spec_bdy_width
+   INTEGER :: i , j , k , idts, rc
+
+   CHARACTER (LEN=80)     :: message
+
+   INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
+   INTEGER ::   end_year ,   end_month ,   end_day ,   end_hour ,   end_minute ,   end_second
+   INTEGER :: interval_seconds , real_data_init_type
+   INTEGER :: time_loop_max , time_loop
+real::t1,t2
+   INTERFACE
+     SUBROUTINE Setup_Timekeeping( grid )
+      USE module_domain
+      TYPE(domain), POINTER :: grid
+     END SUBROUTINE Setup_Timekeeping
+   END INTERFACE
+
+   !  Define the name of this program (program_name defined in module_domain)
+
+   ! NOTE: share/input_wrf.F tests first 7 chars of this name to decide 
+   ! whether to read P_TOP as metadata from the SI (yes, if .eq. REAL_EM)
+
+   program_name = "CONVERT V2.1 "
+
+#ifdef DM_PARALLEL
+   CALL disable_quilting
+#endif
+
+   !  Initialize the modules used by the WRF system.  Many of the CALLs made from the
+   !  init_modules routine are NO-OPs.  Typical initializations are: the size of a
+   !  REAL, setting the file handles to a pre-use value, defining moisture and
+   !  chemistry indices, etc.
+
+   CALL       wrf_debug ( 100 , 'convert_em: calling init_modules ' )
+   CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
+   CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
+   CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
+
+   !  The configuration switches mostly come from the NAMELIST input.
+
+#ifdef DM_PARALLEL
+   IF ( wrf_dm_on_monitor() ) THEN
+      CALL initial_config
+   ENDIF
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+   CALL wrf_dm_initialize
+#else
+   CALL initial_config
+#endif
+
+   CALL nl_get_debug_level ( 1, debug_level )
+   CALL set_wrf_debug_level ( debug_level )
+
+   CALL  wrf_message ( program_name )
+
+   !  Allocate the space for the mother of all domains.
+
+   NULLIFY( null_domain )
+   CALL       wrf_debug ( 100 , 'convert_em: calling alloc_and_configure_domain ' )
+   CALL alloc_and_configure_domain ( domain_id  = 1           , &
+                                     grid       = head_grid   , &
+                                     parent     = null_domain , &
+                                     kid        = -1            )
+
+   grid => head_grid
+
+   CALL Setup_Timekeeping ( grid )
+
+
+   CALL       wrf_debug ( 100 , 'convert_em: calling set_scalar_indices_from_config ' )
+   CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
+
+   CALL       wrf_debug ( 100 , 'convert_em: calling model_to_grid_config_rec ' )
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+   !  Initialize the WRF IO: open files, init file handles, etc.
+
+   CALL       wrf_debug ( 100 , 'convert_em: calling init_wrfio' )
+   CALL init_wrfio
+
+#ifdef DM_PARALLEL
+   CALL       wrf_debug ( 100 , 'convert_em: re-broadcast the configuration records' )
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+#endif
+
+   CALL domain_clock_get( grid, current_timestr=timestr )
+   CALL construct_filename2a ( inpname , config_flags%input_inname , grid%id , 2 , timestr )
+   CALL open_r_dataset ( fid, TRIM(inpname) , grid , config_flags , "DATASET=INPUT", ierr )
+   CALL input_model_input      ( fid ,  grid , config_flags , ierr )
+
+   CALL med_hist_out ( head_grid , 0, config_flags )
+
+   CALL wrf_shutdown
+
+   CALL WRFU_Finalize( rc=rc )
+
+END PROGRAM convert_data
+
Index: trunk/WRF.COMMON/WRFV2/main/ideal.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/ideal.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/ideal.F	(revision 2744)
@@ -0,0 +1,204 @@
+!IDEAL:DRIVER_LAYER
+!
+! create an initial data set for the WRF model based on an ideal condition
+PROGRAM ideal
+
+   USE module_machine
+   USE module_domain
+   USE module_initialize
+   USE module_driver_constants
+   USE module_configure
+
+   USE module_timing
+   USE module_wrf_error
+   USE module_utility
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+   USE module_date_time
+
+   IMPLICIT NONE
+
+   REAL    :: time
+
+   INTEGER :: loop , &
+              levels_to_process
+
+
+   TYPE(domain) , POINTER :: keep_grid, grid_ptr, null_domain, grid
+   TYPE(domain)           :: dummy
+   TYPE (grid_config_rec_type)              :: config_flags
+   TYPE (WRFU_Time) startTime, stopTime, currentTime
+   TYPE (WRFU_TimeInterval) stepTime
+
+   INTEGER :: max_dom , domain_id , fid , oid , idum1 , idum2 , ierr
+   INTEGER :: debug_level, rc
+   LOGICAL :: input_from_file
+
+   INTERFACE
+     SUBROUTINE med_initialdata_output ( grid , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain) , POINTER :: grid
+       TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+     END SUBROUTINE med_initialdata_output 
+   END INTERFACE
+
+#include "version_decl"
+
+
+#ifdef DM_PARALLEL
+   INTEGER                 :: nbytes
+   INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
+   INTEGER                 :: configbuf( configbuflen )
+   LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+#endif
+
+   CHARACTER (LEN=80)     :: message
+
+   !  Define the name of this program (program_name defined in module_domain)
+
+   program_name = "IDEAL " // TRIM(release_version) // " PREPROCESSOR"
+
+   !  Get the NAMELIST data for input.
+
+   CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
+   CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
+   CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
+
+#ifdef DM_PARALLEL
+   IF ( wrf_dm_on_monitor() ) THEN
+     CALL initial_config
+   ENDIF
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+   CALL wrf_dm_initialize
+#else
+   CALL initial_config
+#endif
+   CALL nl_get_debug_level ( 1, debug_level )
+   CALL set_wrf_debug_level ( debug_level )
+
+   CALL  wrf_message ( program_name )
+
+
+   ! allocated and configure the mother domain
+
+   NULLIFY( null_domain )
+
+   CALL alloc_and_configure_domain ( domain_id  = 1 ,                  &
+                                     grid       = head_grid ,          &
+                                     parent     = null_domain ,        &
+                                     kid        = -1                   )
+
+   grid => head_grid
+   ! TBH:  Note that historically, IDEAL did not set up clocks.  These 
+   ! TBH:  are explicit replacements for old default initializations...  They 
+   ! TBH:  are needed to ensure that time manager calls do not fail due to 
+   ! TBH:  uninitialized clock.  Clean this up later...  
+   CALL WRFU_TimeSet(startTime, YY=1, MM=1, DD=1, H=0, M=0, S=0, rc=rc)
+   stopTime = startTime
+   currentTime = startTime
+   ! TBH:  Bogus time step value -- clock is never advanced...  
+   CALL WRFU_TimeIntervalSet(stepTime, S=180, rc=rc)
+   grid%domain_clock = WRFU_ClockCreate( TimeStep= stepTime,  &
+                                         StartTime=startTime, &
+                                         StopTime= stopTime,  &
+                                         rc=rc )
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'grid%domain_clock = WRFU_ClockCreate() FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+   CALL       wrf_debug ( 100 , 'wrf: calling model_to_grid_config_rec ' )
+   CALL model_to_grid_config_rec ( head_grid%id , model_config_rec , config_flags )
+   CALL       wrf_debug ( 100 , 'wrf: calling set_scalar_indices_from_config ' )
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   WRITE ( current_date , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2,".0000")' ) &
+           config_flags%start_year, &
+           config_flags%start_month, &
+           config_flags%start_day, &
+           config_flags%start_hour, &
+           config_flags%start_minute, &
+           config_flags%start_second 
+   CALL domain_clockprint ( 150, grid, &
+          'DEBUG assemble_output:  clock before 1st currTime set,' )
+   WRITE (wrf_err_message,*) &
+        'DEBUG assemble_output:  before 1st currTime set, current_date = ',TRIM(current_date)
+   CALL wrf_debug ( 150 , wrf_err_message )
+   CALL domain_clock_set( grid, current_timestr=current_date(1:19) )
+   CALL domain_clockprint ( 150, grid, &
+          'DEBUG assemble_output:  clock after 1st currTime set,' )
+
+   CALL       wrf_debug ( 100 , 'wrf: calling init_wrfio' )
+   CALL init_wrfio
+
+#ifdef DM_PARALLEL
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+#endif
+
+   CALL med_initialdata_output( head_grid , config_flags )
+
+   CALL       wrf_debug (   0 , 'wrf: SUCCESS COMPLETE IDEAL INIT' )
+   CALL med_shutdown_io ( head_grid , config_flags )
+   CALL wrf_shutdown
+
+   CALL WRFU_Finalize( rc=rc )
+
+END PROGRAM ideal
+
+SUBROUTINE med_initialdata_output ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+   USE module_initialize
+  ! Model layer
+   USE module_configure
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)  , POINTER                    :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+  ! Local
+   INTEGER                :: time_step_begin_restart
+   INTEGER                :: fid , ierr , id
+   CHARACTER (LEN=80)      :: rstname
+   CHARACTER (LEN=80)      :: message
+   CHARACTER (LEN=80)      :: inpname , bdyname
+
+   !  Initialize the mother domain.
+
+   grid%input_from_file = .false.
+   CALL init_domain (  grid )
+   CALL calc_current_date ( grid%id, 0.)
+
+   CALL construct_filename1 ( inpname , 'wrfinput' , grid%id , 2 )
+   CALL open_w_dataset ( id, TRIM(inpname) , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
+   IF ( ierr .NE. 0 ) THEN
+     WRITE (wrf_err_message,*)'ideal: error opening wrfinput for writing ',ierr
+     CALL wrf_error_fatal( wrf_err_message )
+   ENDIF
+   CALL output_model_input ( id, grid , config_flags , ierr )
+   CALL close_dataset ( id , config_flags, "DATASET=INPUT" )
+
+
+   IF ( config_flags%specified ) THEN
+ 
+     CALL construct_filename1 ( bdyname , 'wrfbdy' , grid%id , 2 )
+     CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
+     IF ( ierr .NE. 0 ) THEN
+       WRITE (wrf_err_message,*)'ideal: error opening wrfbdy for writing ',ierr
+       CALL wrf_error_fatal( wrf_err_message )
+     ENDIF
+     CALL output_boundary ( id, grid , config_flags , ierr )
+     CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
+ 
+   ENDIF
+
+   RETURN
+END SUBROUTINE med_initialdata_output
+
Index: trunk/WRF.COMMON/WRFV2/main/ndown_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/ndown_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/ndown_em.F	(revision 2744)
@@ -0,0 +1,1279 @@
+!WRF:DRIVER_LAYER:MAIN
+!
+
+PROGRAM ndown_em
+
+   USE module_machine
+   USE module_domain
+   USE module_initialize
+   USE module_integrate
+   USE module_driver_constants
+   USE module_configure
+   USE module_io_domain
+   USE module_utility
+
+   USE module_timing
+   USE module_wrf_error
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!new for bc
+   USE module_bc
+   USE module_big_step_utilities_em
+   USE module_get_file_names
+#ifdef WRF_CHEM
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! for chemistry
+   USE module_input_chem_data
+!  USE module_input_chem_bioemiss
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+#endif
+
+   IMPLICIT NONE
+ ! interface
+   INTERFACE
+     ! mediation-supplied
+     SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
+       USE module_domain
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_read_wrf_chem_bioemiss
+
+     SUBROUTINE init_domain_constants_em_ptr ( parent , nest )
+       USE module_domain
+       USE module_configure
+       TYPE(domain), POINTER  :: parent , nest
+     END SUBROUTINE init_domain_constants_em_ptr
+
+   END INTERFACE
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!new for bc
+   INTEGER :: ids , ide , jds , jde , kds , kde
+   INTEGER :: ims , ime , jms , jme , kms , kme
+   INTEGER :: ips , ipe , jps , jpe , kps , kpe
+   INTEGER :: its , ite , jts , jte , kts , kte
+   INTEGER :: ijds , ijde , spec_bdy_width
+   INTEGER :: i , j , k , nvchem
+   INTEGER :: time_loop_max , time_loop
+   INTEGER :: total_time_sec , file_counter
+   INTEGER :: julyr , julday , iswater , map_proj
+   INTEGER :: icnt
+
+   REAL    :: dt , new_bdy_frq
+   REAL    :: gmt , cen_lat , cen_lon , dx , dy , truelat1 , truelat2 , moad_cen_lat , stand_lon
+
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE :: mbdy2dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE :: mbdy2dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE :: cbdy3dtemp1 , cbdy3dtemp2 
+   REAL , DIMENSION(:,:,:,:) , ALLOCATABLE :: cbdy3dtemp0
+
+   CHARACTER(LEN=19) :: start_date_char , current_date_char , end_date_char
+   CHARACTER(LEN=19) :: stopTimeStr
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+
+   REAL    :: time
+   INTEGER :: rc
+
+   INTEGER :: loop , levels_to_process
+   INTEGER , PARAMETER :: max_sanity_file_loop = 100
+
+   TYPE (domain) , POINTER :: keep_grid, grid_ptr, null_domain, parent_grid , nested_grid
+   TYPE (domain)           :: dummy
+   TYPE (grid_config_rec_type)              :: config_flags
+   INTEGER                 :: number_at_same_level
+   INTEGER                 :: time_step_begin_restart
+
+   INTEGER :: max_dom , domain_id , fid , fido, fidb , oid , idum1 , idum2 , ierr
+   INTEGER :: status_next_var
+   INTEGER :: debug_level
+   LOGICAL :: input_from_file , need_new_file
+   CHARACTER (LEN=19) :: date_string
+
+#ifdef DM_PARALLEL
+   INTEGER                 :: nbytes
+   INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
+   INTEGER                 :: configbuf( configbuflen )
+   LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+#endif
+
+   INTEGER                 :: idsi
+   CHARACTER (LEN=80)      :: inpname , outname , bdyname
+   CHARACTER (LEN=80)      :: si_inpname
+character *19 :: temp19
+character *24 :: temp24 , temp24b
+character(len=24) :: start_date_hold
+
+   CHARACTER (LEN=80)      :: message
+integer :: ii
+
+#include "version_decl"
+
+   !  Interface block for routine that passes pointers and needs to know that they
+   !  are receiving pointers.
+
+   INTERFACE
+
+      SUBROUTINE med_interp_domain ( parent_grid , nested_grid )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: parent_grid , nested_grid
+      END SUBROUTINE med_interp_domain
+
+      SUBROUTINE Setup_Timekeeping( parent_grid )
+         USE module_domain
+         TYPE(domain), POINTER :: parent_grid
+      END SUBROUTINE Setup_Timekeeping
+
+   END INTERFACE
+
+   !  Define the name of this program (program_name defined in module_domain)
+
+   program_name = "NDOWN_EM " // TRIM(release_version) // " PREPROCESSOR"
+
+#ifdef DM_PARALLEL
+   CALL disable_quilting
+#endif
+
+   !  Initialize the modules used by the WRF system.  Many of the CALLs made from the
+   !  init_modules routine are NO-OPs.  Typical initializations are: the size of a 
+   !  REAL, setting the file handles to a pre-use value, defining moisture and 
+   !  chemistry indices, etc.
+
+   CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
+   CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
+   CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
+
+   !  Get the NAMELIST data.  This is handled in the initial_config routine.  All of the
+   !  NAMELIST input variables are assigned to the model_config_rec structure.  Below,
+   !  note for parallel processing, only the monitor processor handles the raw Fortran
+   !  I/O, and then broadcasts the info to each of the other nodes.
+
+#ifdef DM_PARALLEL
+   IF ( wrf_dm_on_monitor() ) THEN
+     CALL initial_config
+   ENDIF
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+   CALL wrf_dm_initialize
+#else
+   CALL initial_config
+#endif
+
+   !  And here is an instance of using the information in the NAMELIST.  
+
+   CALL nl_get_debug_level ( 1, debug_level )
+   CALL set_wrf_debug_level ( debug_level )
+
+   !  Allocated and configure the mother domain.  Since we are in the nesting down
+   !  mode, we know a) we got a nest, and b) we only got 1 nest.
+
+   NULLIFY( null_domain )
+
+   CALL       wrf_message ( program_name )
+   CALL       wrf_debug ( 100 , 'ndown_em: calling alloc_and_configure_domain coarse ' )
+   CALL alloc_and_configure_domain ( domain_id  = 1 ,                  &
+                                     grid       = head_grid ,          &
+                                     parent     = null_domain ,        &
+                                     kid        = -1                   )
+
+   parent_grid => head_grid
+
+   !  Set up time initializations.
+
+   CALL Setup_Timekeeping ( parent_grid )
+
+   CALL domain_clock_set( head_grid, &
+                          time_step_seconds=model_config_rec%interval_seconds )
+   CALL       wrf_debug ( 100 , 'ndown_em: calling model_to_grid_config_rec ' )
+   CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
+   CALL       wrf_debug ( 100 , 'ndown_em: calling set_scalar_indices_from_config ' )
+   CALL set_scalar_indices_from_config ( parent_grid%id , idum1, idum2 )
+
+   !  Initialize the I/O for WRF.
+
+   CALL       wrf_debug ( 100 , 'ndown_em: calling init_wrfio' )
+   CALL init_wrfio
+
+   !  Some of the configuration values may have been modified from the initial READ
+   !  of the NAMELIST, so we re-broadcast the configuration records.
+
+#ifdef DM_PARALLEL
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+#endif
+
+   !  We need to current and starting dates for the output files.  The times need to be incremented
+   !  so that the lateral BC files are not overwritten.
+
+   WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
+           model_config_rec%start_year  (parent_grid%id) , &
+           model_config_rec%start_month (parent_grid%id) , &
+           model_config_rec%start_day   (parent_grid%id) , &
+           model_config_rec%start_hour  (parent_grid%id) , &
+           model_config_rec%start_minute(parent_grid%id) , &
+           model_config_rec%start_second(parent_grid%id) 
+
+   WRITE (   end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
+           model_config_rec%  end_year  (parent_grid%id) , &
+           model_config_rec%  end_month (parent_grid%id) , &
+           model_config_rec%  end_day   (parent_grid%id) , &
+           model_config_rec%  end_hour  (parent_grid%id) , &
+           model_config_rec%  end_minute(parent_grid%id) , &
+           model_config_rec%  end_second(parent_grid%id) 
+
+   !  Override stop time with value computed above.
+   CALL domain_clock_set( parent_grid, stop_timestr=end_date_char )
+
+   CALL geth_idts ( end_date_char , start_date_char , total_time_sec ) 
+
+   new_bdy_frq = model_config_rec%interval_seconds
+   time_loop_max = total_time_sec / model_config_rec%interval_seconds + 1
+
+   start_date        = start_date_char // '.0000' 
+   current_date      = start_date_char // '.0000' 
+   start_date_hold   = start_date_char // '.0000'
+   current_date_char = start_date_char
+
+   !  Get a list of available file names to try.  This fills up the eligible_file_name
+   !  array with number_of_eligible_files entries.  This routine issues a nonstandard
+   !  call (system).
+
+   file_counter = 1
+   need_new_file = .FALSE.
+   CALL unix_ls ( 'wrfout' , parent_grid%id )
+
+   !  Open the input data (wrfout_d01_xxxxxx) for reading.
+   
+   CALL wrf_debug          ( 100 , 'ndown_em main: calling open_r_dataset for ' // TRIM(eligible_file_name(file_counter)) )
+   CALL open_r_dataset     ( fid, TRIM(eligible_file_name(file_counter)) , head_grid , config_flags , "DATASET=AUXINPUT1", ierr )
+   IF ( ierr .NE. 0 ) THEN
+      WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(eligible_file_name(file_counter)), &
+                                                  ' for reading ierr=',ierr
+      CALL WRF_ERROR_FATAL ( wrf_err_message )
+   ENDIF
+
+   !  We know how many time periods to process, so we begin.
+
+   big_time_loop_thingy : DO time_loop = 1 , time_loop_max
+
+      !  Which date are we currently soliciting?
+
+      CALL geth_newdate ( date_string , start_date_char , ( time_loop - 1 ) * NINT ( new_bdy_frq) )
+print *,'-------->>>  Processing data: loop=',time_loop,'  date/time = ',date_string
+      current_date_char = date_string
+      current_date      = date_string // '.0000'
+      start_date        = date_string // '.0000'
+print *,'loopmax = ', time_loop_max, '   ending date = ',end_date_char
+      CALL domain_clock_set( parent_grid, &
+                             current_timestr=current_date(1:19) )
+
+      !  Which times are in this file, and more importantly, are any of them the
+      !  ones that we want?  We need to loop over times in each files, loop
+      !  over files.
+
+      get_the_right_time : DO
+      
+         CALL wrf_get_next_time ( fid , date_string , status_next_var )
+print *,'file date/time = ',date_string,'     desired date = ',current_date_char,'     status = ', status_next_var
+
+         IF      (  status_next_var .NE. 0 ) THEN
+            CALL wrf_debug          ( 100 , 'ndown_em main: calling close_dataset  for ' // TRIM(eligible_file_name(file_counter)) )
+            CALL close_dataset      ( fid , config_flags , "DATASET=INPUT" )
+            file_counter = file_counter + 1
+            IF ( file_counter .GT. number_of_eligible_files ) THEN
+               WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: opening too many files'
+               CALL WRF_ERROR_FATAL ( wrf_err_message )
+            END IF
+            CALL wrf_debug      ( 100 , 'ndown_em main: calling open_r_dataset for ' // TRIM(eligible_file_name(file_counter)) )
+            CALL open_r_dataset ( fid, TRIM(eligible_file_name(file_counter)) , head_grid , config_flags , "DATASET=INPUT", ierr )
+            IF ( ierr .NE. 0 ) THEN
+               WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(eligible_file_name(file_counter)), &
+                                                           ' for reading ierr=',ierr
+               CALL WRF_ERROR_FATAL ( wrf_err_message )
+            ENDIF
+            CYCLE get_the_right_time
+         ELSE IF ( TRIM(date_string) .LT. TRIM(current_date_char) ) THEN
+            CYCLE get_the_right_time
+         ELSE IF ( TRIM(date_string) .EQ. TRIM(current_date_char) ) THEN
+            EXIT get_the_right_time
+         ELSE IF ( TRIM(date_string) .GT. TRIM(current_date_char) ) THEN
+            WRITE( wrf_err_message , FMT='(A,A,A,A,A)' ) 'Found ',TRIM(date_string),' before I found ',TRIM(current_date_char),'.'
+            CALL WRF_ERROR_FATAL ( wrf_err_message )
+         END IF
+      END DO get_the_right_time 
+
+      CALL wrf_debug          ( 100 , 'wrf: calling input_history' )
+      CALL wrf_get_previous_time ( fid , date_string , status_next_var )
+      CALL input_history      ( fid , head_grid , config_flags, ierr )
+      CALL wrf_debug          ( 100 , 'wrf: back from input_history' )
+
+      !  Get the coarse grid info for later transfer to the fine grid domain.
+
+      CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' , map_proj , 1 , icnt , ierr ) 
+      CALL wrf_get_dom_ti_real    ( fid , 'DX'  , dx  , 1 , icnt , ierr ) 
+      CALL wrf_get_dom_ti_real    ( fid , 'DY'  , dy  , 1 , icnt , ierr ) 
+      CALL wrf_get_dom_ti_real    ( fid , 'CEN_LAT' , cen_lat , 1 , icnt , ierr ) 
+      CALL wrf_get_dom_ti_real    ( fid , 'CEN_LON' , cen_lon , 1 , icnt , ierr ) 
+      CALL wrf_get_dom_ti_real    ( fid , 'TRUELAT1' , truelat1 , 1 , icnt , ierr ) 
+      CALL wrf_get_dom_ti_real    ( fid , 'TRUELAT2' , truelat2 , 1 , icnt , ierr ) 
+      CALL wrf_get_dom_ti_real    ( fid , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , icnt , ierr ) 
+      CALL wrf_get_dom_ti_real    ( fid , 'STAND_LON' , stand_lon , 1 , icnt , ierr ) 
+!     CALL wrf_get_dom_ti_real    ( fid , 'GMT' , gmt , 1 , icnt , ierr ) 
+!     CALL wrf_get_dom_ti_integer ( fid , 'JULYR' , julyr , 1 , icnt , ierr ) 
+!     CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' , julday , 1 , icnt , ierr ) 
+      CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' , iswater , 1 , icnt , ierr ) 
+
+      !  First time in, do this: allocate sapce for the fine grid, get the config flags, open the 
+      !  wrfinput and wrfbdy files.  This COULD be done outside the time loop, I think, so check it
+      !  out and move it up if you can.
+
+      IF ( time_loop .EQ. 1 ) THEN
+
+         CALL       wrf_message ( program_name )
+         CALL       wrf_debug ( 100 , 'wrf: calling alloc_and_configure_domain fine ' )
+         CALL alloc_and_configure_domain ( domain_id  = 2 ,                  &
+                                           grid       = nested_grid ,        &
+                                           parent     = parent_grid ,        &
+                                           kid        = 1                   )
+   
+         CALL       wrf_debug ( 100 , 'wrf: calling model_to_grid_config_rec ' )
+         CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+         CALL       wrf_debug ( 100 , 'wrf: calling set_scalar_indices_from_config ' )
+         CALL set_scalar_indices_from_config ( nested_grid%id , idum1, idum2 )
+
+         !  Set up time initializations for the fine grid.
+
+         CALL Setup_Timekeeping ( nested_grid )
+         ! Strictly speaking, nest stop time should come from model_config_rec...  
+         CALL domain_clock_get( parent_grid, stop_timestr=stopTimeStr )
+         CALL domain_clock_set( nested_grid,                        &
+                                current_timestr=current_date(1:19), &
+                                stop_timestr=stopTimeStr ,          &
+                                time_step_seconds=                  &
+                                  model_config_rec%interval_seconds )
+
+         !  Generate an output file from this program, which will be an input file to WRF.
+
+         CALL nl_set_bdyfrq ( nested_grid%id , new_bdy_frq )
+         config_flags%bdyfrq = new_bdy_frq
+
+#ifdef WRF_CHEM
+nested_grid%chem_opt    = parent_grid%chem_opt
+nested_grid%chem_in_opt = parent_grid%chem_in_opt
+#endif
+
+         !  Initialize constants and 1d arrays in fine grid from the parent.
+
+         CALL init_domain_constants_em_ptr ( parent_grid , nested_grid ) 
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   
+         CALL wrf_debug          ( 100 , 'ndown_em main: calling open_w_dataset for wrfinput' )
+         CALL construct_filename1( outname , 'wrfinput' , nested_grid%id , 2 )
+         CALL open_w_dataset     ( fido, TRIM(outname) , nested_grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
+         IF ( ierr .NE. 0 ) THEN
+            WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(outname),' for reading ierr=',ierr
+            CALL WRF_ERROR_FATAL ( wrf_err_message )
+         ENDIF
+
+         !  Various sizes that we need to be concerned about.
+
+         ids = nested_grid%sd31
+         ide = nested_grid%ed31
+         kds = nested_grid%sd32
+         kde = nested_grid%ed32
+         jds = nested_grid%sd33
+         jde = nested_grid%ed33
+
+         ims = nested_grid%sm31
+         ime = nested_grid%em31
+         kms = nested_grid%sm32
+         kme = nested_grid%em32
+         jms = nested_grid%sm33
+         jme = nested_grid%em33
+
+         ips = nested_grid%sp31
+         ipe = nested_grid%ep31
+         kps = nested_grid%sp32
+         kpe = nested_grid%ep32
+         jps = nested_grid%sp33
+         jpe = nested_grid%ep33
+
+         ijds = MIN ( ids , jds )
+         ijde = MAX ( ide , jde )
+
+         print *, ids , ide , jds , jde , kds , kde
+         print *, ims , ime , jms , jme , kms , kme
+         print *, ips , ipe , jps , jpe , kps , kpe
+         print *, ijds , ijde
+
+         spec_bdy_width = model_config_rec%spec_bdy_width
+         print *,'spec_bdy_width=',spec_bdy_width
+
+         !  This is the space needed to save the current 3d data for use in computing
+         !  the lateral boundary tendencies.
+
+         ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( pbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( mbdy2dtemp1(ims:ime,1:1,    jms:jme) )
+         ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( pbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( mbdy2dtemp2(ims:ime,1:1,    jms:jme) )
+         ALLOCATE ( cbdy3dtemp0(ims:ime,kms:kme,jms:jme,1:num_chem) )
+         ALLOCATE ( cbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+         ALLOCATE ( cbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+
+      END IF
+
+      CALL domain_clock_set( nested_grid,                        &
+                             current_timestr=current_date(1:19), &
+                             time_step_seconds=                  &
+                               model_config_rec%interval_seconds )
+
+      !  Do the horizontal interpolation.
+
+      nested_grid%imask_nostag = 1
+      nested_grid%imask_xstag = 1
+      nested_grid%imask_ystag = 1
+      nested_grid%imask_xystag = 1
+      CALL med_interp_domain ( head_grid , nested_grid )
+      nested_grid%ht_int = nested_grid%ht
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      IF ( time_loop .EQ. 1 ) THEN
+
+         !  Open the fine grid SI static file.
+   
+         CALL construct_filename1( si_inpname , 'wrfndi' , nested_grid%id , 2 )
+         CALL       wrf_debug ( 100 , 'med_sidata_input: calling open_r_dataset for ' // TRIM(si_inpname) )
+         CALL open_r_dataset ( idsi, TRIM(si_inpname) , nested_grid , config_flags , "DATASET=INPUT", ierr )
+         IF ( ierr .NE. 0 ) THEN
+            CALL wrf_error_fatal( 'real: error opening FG input for reading: ' // TRIM (si_inpname) )
+         END IF
+
+         !  Input data.
+   
+         CALL       wrf_debug ( 100 , 'ndown_em: calling input_aux_model_input2' )
+         CALL input_aux_model_input2 ( idsi , nested_grid , config_flags , ierr )
+         nested_grid%ht_input = nested_grid%ht
+   
+         !  Close this fine grid static input file.
+   
+         CALL       wrf_debug ( 100 , 'ndown_em: closing fine grid static input' )
+         CALL close_dataset ( idsi , config_flags , "DATASET=INPUT" )
+
+         !  We need a fine grid landuse in the interpolation.  So we need to generate
+         !  that field now.
+
+         IF      ( ( nested_grid%ivgtyp(ips,jps) .GT. 0 ) .AND. &
+                   ( nested_grid%isltyp(ips,jps) .GT. 0 ) ) THEN
+            DO j = jps, MIN(jde-1,jpe)
+               DO i = ips, MIN(ide-1,ipe)
+                  nested_grid% vegcat(i,j) = nested_grid%ivgtyp(i,j)
+                  nested_grid%soilcat(i,j) = nested_grid%isltyp(i,j)
+               END DO
+            END DO
+
+         ELSE IF ( ( nested_grid% vegcat(ips,jps) .GT. 0.5 ) .AND. &
+                   ( nested_grid%soilcat(ips,jps) .GT. 0.5 ) ) THEN
+            DO j = jps, MIN(jde-1,jpe)
+               DO i = ips, MIN(ide-1,ipe)
+                  nested_grid%ivgtyp(i,j) = NINT(nested_grid% vegcat(i,j))
+                  nested_grid%isltyp(i,j) = NINT(nested_grid%soilcat(i,j))
+               END DO
+            END DO
+
+         ELSE
+            num_veg_cat      = SIZE ( nested_grid%landusef , DIM=2 )
+            num_soil_top_cat = SIZE ( nested_grid%soilctop , DIM=2 )
+            num_soil_bot_cat = SIZE ( nested_grid%soilcbot , DIM=2 )
+   
+            CALL land_percentages (  nested_grid%xland , &
+                                     nested_grid%landusef , nested_grid%soilctop , nested_grid%soilcbot , &
+                                     nested_grid%isltyp , nested_grid%ivgtyp , &
+                                     num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     ips , ipe , jps , jpe , kps , kpe , &
+                                     model_config_rec%iswater(nested_grid%id) )
+
+          END IF
+
+          DO j = jps, MIN(jde-1,jpe)
+            DO i = ips, MIN(ide-1,ipe)
+               nested_grid%lu_index(i,j) = nested_grid%ivgtyp(i,j)
+            END DO
+         END DO
+
+         CALL check_consistency ( nested_grid%ivgtyp , nested_grid%isltyp , nested_grid%landmask , &
+                                  ids , ide , jds , jde , kds , kde , &
+                                  ims , ime , jms , jme , kms , kme , &
+                                  ips , ipe , jps , jpe , kps , kpe , &
+                                  model_config_rec%iswater(nested_grid%id) )
+
+         CALL check_consistency2( nested_grid%ivgtyp , nested_grid%isltyp , nested_grid%landmask , &
+                                  nested_grid%tmn , nested_grid%tsk , nested_grid%sst , nested_grid%xland , &
+                                  nested_grid%tslb , nested_grid%smois , nested_grid%sh2o , &
+                                  config_flags%num_soil_layers , nested_grid%id , &
+                                  ids , ide , jds , jde , kds , kde , &
+                                  ims , ime , jms , jme , kms , kme , &
+                                  ips , ipe , jps , jpe , kps , kpe , &
+                                  model_config_rec%iswater(nested_grid%id) )
+
+      END IF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   
+      !  We have 2 terrain elevations.  One is from input and the other is from the
+      !  the horizontal interpolation.
+
+      nested_grid%ht_fine = nested_grid%ht_input
+      nested_grid%ht      = nested_grid%ht_int
+
+      !  We have both the interpolated fields and the higher-resolution static fields.  From these
+      !  the rebalancing is now done.  Note also that the field nested_grid%ht is now from the 
+      !  fine grid input file (after this call is completed).
+
+      CALL rebalance_driver ( nested_grid ) 
+
+      !  Different things happen during the different time loops:
+      !      first loop - write wrfinput file, close data set, copy files to holder arrays
+      !      middle loops - diff 3d/2d arrays, compute and output bc
+      !      last loop - diff 3d/2d arrays, compute and output bc, write wrfbdy file, close wrfbdy file
+
+      IF ( time_loop .EQ. 1 ) THEN
+
+         !  Set the time info.
+
+         print *,'current_date = ',current_date
+         CALL domain_clock_set( nested_grid, &
+                                current_timestr=current_date(1:19) )
+#ifdef WRF_CHEM
+!
+! SEP     Put in chemistry data
+!
+         IF( nested_grid%chem_opt .NE. 0 ) then
+!           IF( nested_grid%chem_in_opt .EQ. 0 ) then
+             ! Read the chemistry data from a previous wrf forecast (wrfout file)
+              ! Generate chemistry data from a idealized vertical profile
+!             message = 'STARTING WITH BACKGROUND CHEMISTRY '
+              CALL  wrf_message ( message )
+
+!             CALL input_chem_profile ( nested_grid )
+
+              if( nested_grid%bio_emiss_opt .eq. 2 )then
+                 message = 'READING BEIS3.11 EMISSIONS DATA'
+                 CALL  wrf_message ( message )
+                 CALL med_read_wrf_chem_bioemiss ( nested_grid , config_flags)
+              endif
+!           ELSE
+!             message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
+!             CALL  wrf_message ( message )
+!           ENDIF
+         ENDIF
+#endif
+
+         !  Output the first time period of the data.
+   
+         CALL output_model_input ( fido , nested_grid , config_flags , ierr )
+
+         CALL wrf_put_dom_ti_integer ( fido , 'MAP_PROJ' , map_proj , 1 , ierr ) 
+!        CALL wrf_put_dom_ti_real    ( fido , 'DX'  , dx  , 1 , ierr ) 
+!        CALL wrf_put_dom_ti_real    ( fido , 'DY'  , dy  , 1 , ierr ) 
+         CALL wrf_put_dom_ti_real    ( fido , 'CEN_LAT' , cen_lat , 1 , ierr ) 
+         CALL wrf_put_dom_ti_real    ( fido , 'CEN_LON' , cen_lon , 1 , ierr ) 
+         CALL wrf_put_dom_ti_real    ( fido , 'TRUELAT1' , truelat1 , 1 , ierr ) 
+         CALL wrf_put_dom_ti_real    ( fido , 'TRUELAT2' , truelat2 , 1 , ierr ) 
+         CALL wrf_put_dom_ti_real    ( fido , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , ierr ) 
+         CALL wrf_put_dom_ti_real    ( fido , 'STAND_LON' , stand_lon , 1 , ierr ) 
+         CALL wrf_put_dom_ti_integer ( fido , 'ISWATER' , iswater , 1 , ierr ) 
+
+         !  These change if the initial time for the nest is not the same as the
+         !  first time period in the WRF output file.
+         !  Now that we know the starting date, we need to set the GMT, JULYR, and JULDAY
+         !  values for the global attributes.  This call is based on the setting of the 
+         !  current_date string.
+
+         CALL geth_julgmt ( julyr , julday , gmt)
+         CALL nl_set_julyr  ( nested_grid%id , julyr  )
+         CALL nl_set_julday ( nested_grid%id , julday )
+         CALL nl_set_gmt    ( nested_grid%id , gmt    )
+         CALL wrf_put_dom_ti_real    ( fido , 'GMT' , gmt , 1 , ierr ) 
+         CALL wrf_put_dom_ti_integer ( fido , 'JULYR' , julyr , 1 , ierr ) 
+         CALL wrf_put_dom_ti_integer ( fido , 'JULDAY' , julday , 1 , ierr ) 
+print *,'current_date =',current_date
+print *,'julyr=',julyr
+print *,'julday=',julday
+print *,'gmt=',gmt
+         
+         !  Close the input (wrfout_d01_000000, for example) file.  That's right, the 
+         !  input is an output file.  Who'd've thunk.
+   
+         CALL close_dataset      ( fido , config_flags , "DATASET=INPUT" )
+
+         !  We need to save the 3d/2d data to compute a difference during the next loop.  Couple the
+         !  3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
+
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , ubdy3dtemp1 , nested_grid%em_u_2                 , &
+                       'u' , nested_grid%msfu , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , vbdy3dtemp1 , nested_grid%em_v_2                 , &
+                       'v' , nested_grid%msfv , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , tbdy3dtemp1 , nested_grid%em_t_2                 , &
+                       't' , nested_grid%msft , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , pbdy3dtemp1 , nested_grid%em_ph_2                , &
+                       'h' , nested_grid%msft , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , qbdy3dtemp1 , nested_grid%moist(:,:,:,P_QV)    , &
+                       't' , nested_grid%msft , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+
+          DO j = jps , jpe
+             DO i = ips , ipe
+                mbdy2dtemp1(i,1,j) = nested_grid%em_mu_2(i,j)
+             END DO
+          END DO
+
+         !  There are 2 components to the lateral boundaries.  First, there is the starting
+         !  point of this time period - just the outer few rows and columns.
+
+         CALL stuff_bdy     ( ubdy3dtemp1 , nested_grid%em_u_b     , 'U' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( vbdy3dtemp1 , nested_grid%em_v_b     , 'V' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( tbdy3dtemp1 , nested_grid%em_t_b     , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( pbdy3dtemp1 , nested_grid%em_ph_b    , 'W' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( qbdy3dtemp1 , nested_grid%moist_b(:,:,:,:,P_QV)                                  &
+                                                                   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( mbdy2dtemp1 , nested_grid%em_mu_b    , 'M' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , 1 , 1 , &
+                                                                           ims , ime , jms , jme , 1 , 1 , &
+                                                                           ips , ipe , jps , jpe , 1 , 1 )
+#ifdef WRF_CHEM
+         do nvchem=1,num_chem
+!        if(nvchem.eq.p_o3)then
+!          write(0,*)'fill ch_b',cbdy3dtemp1(5,1,5),nvchem
+!        endif
+         cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=nested_grid%chem(ips:ipe,kps:kpe,jps:jpe,nvchem)
+!        if(nvchem.eq.p_o3)then
+!          write(0,*)'fill ch_b',cbdy3dtemp1(5,1,5)
+!        endif
+         CALL stuff_bdy     ( cbdy3dtemp1 , nested_grid%chem_b(:,:,:,:,nvchem)                                  &
+                                                                   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+           cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)=cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)
+!        if(nvchem.eq.p_o3)then
+!          write(0,*)'filled ch_b',time_loop,cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem)
+!        endif
+         enddo
+#endif
+      ELSE IF ( ( time_loop .GT. 1 ) .AND. ( time_loop .LT. time_loop_max ) ) THEN
+
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , ubdy3dtemp2 , nested_grid%em_u_2                 , &
+                       'u' , nested_grid%msfu , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , vbdy3dtemp2 , nested_grid%em_v_2                 , &
+                       'v' , nested_grid%msfv , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , tbdy3dtemp2 , nested_grid%em_t_2                 , &
+                       't' , nested_grid%msft , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , pbdy3dtemp2 , nested_grid%em_ph_2                , &
+                       'h' , nested_grid%msft , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , qbdy3dtemp2 , nested_grid%moist(:,:,:,P_QV)    , &
+                       't' , nested_grid%msft , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+
+          DO j = jps , jpe
+             DO i = ips , ipe
+                mbdy2dtemp2(i,1,j) = nested_grid%em_mu_2(i,j)
+             END DO
+          END DO
+
+         !  During all of the loops after the first loop, we first compute the boundary
+         !  tendencies with the current data values and the previously save information
+         !  stored in the *bdy3dtemp1 arrays.
+
+         CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , new_bdy_frq , nested_grid%em_u_bt  , 'U'  , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , new_bdy_frq , nested_grid%em_v_bt  , 'V'  , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , new_bdy_frq , nested_grid%em_t_bt  , 'T'  , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , new_bdy_frq , nested_grid%em_ph_bt  , 'W' , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , new_bdy_frq , nested_grid%moist_bt(:,:,:,:,P_QV), 'T' , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , new_bdy_frq , nested_grid%em_mu_bt  , 'M' , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , 1 , 1 , &
+                                                                  ims , ime , jms , jme , 1 , 1 , &
+                                                                  ips , ipe , jps , jpe , 1 , 1 )
+#ifdef WRF_CHEM
+         do nvchem=1,num_chem
+         cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem) 
+         cbdy3dtemp2(ips:ipe,kps:kpe,jps:jpe)=nested_grid%chem(ips:ipe,kps:kpe,jps:jpe,nvchem)
+!        if(nvchem.eq.p_o3)then
+!          write(0,*)'fill 1ch_b2',time_loop,cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem),cbdy3dtemp2(ips,kps,jps)
+!        endif
+         CALL stuff_bdytend ( cbdy3dtemp2 , cbdy3dtemp1 , new_bdy_frq , nested_grid%chem_bt(:,:,:,:,nvchem), 'T' , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)=cbdy3dtemp2(ips:ipe,kps:kpe,jps:jpe) 
+!        if(nvchem.eq.p_o3)then
+!          write(0,*)'fill 2ch_b2',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem),cbdy3dtemp2(ips,kps,jps)
+!        endif
+         enddo
+#endif
+         IF ( time_loop .EQ. 2 ) THEN
+   
+            !  Generate an output file from this program, which will be an input file to WRF.
+
+            CALL wrf_debug          ( 100 , 'ndown_em main: calling open_w_dataset for wrfbdy' )
+            CALL construct_filename1( bdyname , 'wrfbdy' , nested_grid%id , 2 )
+            CALL open_w_dataset     ( fidb, TRIM(bdyname) , nested_grid , config_flags , output_boundary , &
+                                      "DATASET=BOUNDARY", ierr )
+            IF ( ierr .NE. 0 ) THEN
+               WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(bdyname),' for reading ierr=',ierr
+               CALL WRF_ERROR_FATAL ( wrf_err_message )
+            ENDIF
+
+         END IF
+
+         !  Both pieces of the boundary data are now available to be written.
+         
+      CALL domain_clock_set( nested_grid, &
+                             current_timestr=current_date(1:19) )
+      temp24= current_date
+      temp24b=start_date_hold
+      start_date = start_date_hold
+      CALL geth_newdate ( temp19 , temp24b(1:19) , (time_loop-2) * model_config_rec%interval_seconds )
+      current_date = temp19 //  '.0000'
+      CALL geth_julgmt ( julyr , julday , gmt)
+      CALL nl_set_julyr  ( nested_grid%id , julyr  )
+      CALL nl_set_julday ( nested_grid%id , julday )
+      CALL nl_set_gmt    ( nested_grid%id , gmt    )
+      CALL wrf_put_dom_ti_real    ( fidb , 'GMT' , gmt , 1 , ierr ) 
+      CALL wrf_put_dom_ti_integer ( fidb , 'JULYR' , julyr , 1 , ierr ) 
+      CALL wrf_put_dom_ti_integer ( fidb , 'JULDAY' , julday , 1 , ierr ) 
+      CALL domain_clock_set( nested_grid, &
+                             current_timestr=current_date(1:19) )
+print *,'bdy time = ',time_loop-1,'  bdy date = ',current_date,' ',start_date
+      CALL output_boundary ( fidb , nested_grid , config_flags , ierr )
+      current_date = temp24
+      start_date = temp24b
+      CALL domain_clock_set( nested_grid, &
+                             current_timestr=current_date(1:19) )
+
+         IF ( time_loop .EQ. 2 ) THEN
+            CALL wrf_put_dom_ti_real    ( fidb , 'BDYFRQ' , new_bdy_frq , 1 , ierr ) 
+         END IF
+
+         !  We need to save the 3d data to compute a difference during the next loop.  Couple the
+         !  3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
+         !  We load up the boundary data again for use in the next loop.
+
+          DO j = jps , jpe
+             DO k = kps , kpe
+                DO i = ips , ipe
+                   ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
+                   vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
+                   tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
+                   pbdy3dtemp1(i,k,j) = pbdy3dtemp2(i,k,j)
+                   qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
+                END DO
+             END DO
+          END DO
+
+          DO j = jps , jpe
+             DO i = ips , ipe
+                mbdy2dtemp1(i,1,j) = mbdy2dtemp2(i,1,j)
+             END DO
+          END DO
+
+         !  There are 2 components to the lateral boundaries.  First, there is the starting
+         !  point of this time period - just the outer few rows and columns.
+
+         CALL stuff_bdy     ( ubdy3dtemp1 , nested_grid%em_u_b     , 'U' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( vbdy3dtemp1 , nested_grid%em_v_b     , 'V' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( tbdy3dtemp1 , nested_grid%em_t_b     , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( pbdy3dtemp1 , nested_grid%em_ph_b    , 'W' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( qbdy3dtemp1 , nested_grid%moist_b(:,:,:,:,P_QV)   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+#ifdef WRF_CHEM
+         do nvchem=1,num_chem
+         cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem) 
+!        if(nvchem.eq.p_o3)then
+!          write(0,*)'fill 2ch_b3',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem)
+!        endif
+         CALL stuff_bdy     ( cbdy3dtemp1 , nested_grid%chem_b(:,:,:,:,nvchem)                                  &
+                                                                   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , kds , kde , &
+                                                                           ims , ime , jms , jme , kms , kme , &
+                                                                           ips , ipe , jps , jpe , kps , kpe )
+!          cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)=cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)
+!        if(nvchem.eq.p_o3)then
+!          write(0,*)'fill 2ch_b3',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem)
+!        endif
+         enddo
+#endif
+         CALL stuff_bdy     ( mbdy2dtemp1 , nested_grid%em_mu_b    , 'M' , ijds , ijde , spec_bdy_width      , &
+                                                                           ids , ide , jds , jde , 1 , 1 , &
+                                                                           ims , ime , jms , jme , 1 , 1 , &
+                                                                           ips , ipe , jps , jpe , 1 , 1 )
+
+      ELSE IF ( time_loop .EQ. time_loop_max ) THEN
+
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , ubdy3dtemp2 , nested_grid%em_u_2                 , &
+                       'u' , nested_grid%msfu , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , vbdy3dtemp2 , nested_grid%em_v_2                 , &
+                       'v' , nested_grid%msfv , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , tbdy3dtemp2 , nested_grid%em_t_2                 , &
+                       't' , nested_grid%msft , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , pbdy3dtemp2 , nested_grid%em_ph_2                , &
+                       'h' , nested_grid%msft , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , qbdy3dtemp2 , nested_grid%moist(:,:,:,P_QV)    , &
+                       't' , nested_grid%msft , &
+                       ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+         mbdy2dtemp2(:,1,:) = nested_grid%em_mu_2(:,:)
+
+         !  During all of the loops after the first loop, we first compute the boundary
+         !  tendencies with the current data values and the previously save information
+         !  stored in the *bdy3dtemp1 arrays.
+#ifdef WRF_CHEM
+         do nvchem=1,num_chem
+         cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem) 
+         cbdy3dtemp2(ips:ipe,kps:kpe,jps:jpe)=nested_grid%chem(ips:ipe,kps:kpe,jps:jpe,nvchem)
+!        if(nvchem.eq.p_o3)then
+!          write(0,*)'fill 1ch_b4',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem),cbdy3dtemp2(ips,kps,jps)
+!        endif
+         CALL stuff_bdytend ( cbdy3dtemp2 , cbdy3dtemp1 , new_bdy_frq , nested_grid%chem_bt(:,:,:,:,nvchem), 'T' , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)=cbdy3dtemp2(ips:ipe,kps:kpe,jps:jpe) 
+!        if(nvchem.eq.p_o3)then
+!          write(0,*)'fill 2ch_b4',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem),cbdy3dtemp2(ips,kps,jps)
+!        endif
+         enddo
+#endif
+
+         CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , new_bdy_frq , nested_grid%em_u_bt  , 'U'  , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , new_bdy_frq , nested_grid%em_v_bt  , 'V'  , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , new_bdy_frq , nested_grid%em_t_bt  , 'T'  , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , new_bdy_frq , nested_grid%em_ph_bt  , 'W' , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , new_bdy_frq , nested_grid%moist_bt(:,:,:,:,P_QV) , 'T' , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , kds , kde , &
+                                                                  ims , ime , jms , jme , kms , kme , &
+                                                                  ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , new_bdy_frq , nested_grid%em_mu_bt  , 'M' , &
+                                                                  ijds , ijde , spec_bdy_width      , &
+                                                                  ids , ide , jds , jde , 1 , 1 , &
+                                                                  ims , ime , jms , jme , 1 , 1 , &
+                                                                  ips , ipe , jps , jpe , 1 , 1 )
+
+         IF ( time_loop .EQ. 2 ) THEN
+   
+            !  Generate an output file from this program, which will be an input file to WRF.
+
+            CALL wrf_debug          ( 100 , 'ndown_em main: calling open_w_dataset for wrfbdy' )
+            CALL construct_filename1( bdyname , 'wrfbdy' , nested_grid%id , 2 )
+            CALL open_w_dataset     ( fidb, TRIM(bdyname) , nested_grid , config_flags , output_boundary , &
+                                      "DATASET=BOUNDARY", ierr )
+            IF ( ierr .NE. 0 ) THEN
+               WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(bdyname),' for reading ierr=',ierr
+               CALL WRF_ERROR_FATAL ( wrf_err_message )
+            ENDIF
+
+         END IF
+
+         !  Both pieces of the boundary data are now available to be written.
+
+      CALL domain_clock_set( nested_grid, &
+                             current_timestr=current_date(1:19) )
+      temp24= current_date
+      temp24b=start_date_hold
+      start_date = start_date_hold
+      CALL geth_newdate ( temp19 , temp24b(1:19) , (time_loop-2) * model_config_rec%interval_seconds )
+      current_date = temp19 //  '.0000'
+      CALL geth_julgmt ( julyr , julday , gmt)
+      CALL nl_set_julyr  ( nested_grid%id , julyr  )
+      CALL nl_set_julday ( nested_grid%id , julday )
+      CALL nl_set_gmt    ( nested_grid%id , gmt    )
+      CALL wrf_put_dom_ti_real    ( fidb , 'GMT' , gmt , 1 , ierr ) 
+      CALL wrf_put_dom_ti_integer ( fidb , 'JULYR' , julyr , 1 , ierr ) 
+      CALL wrf_put_dom_ti_integer ( fidb , 'JULDAY' , julday , 1 , ierr ) 
+      CALL domain_clock_set( nested_grid, &
+                             current_timestr=current_date(1:19) )
+      CALL output_boundary ( fidb , nested_grid , config_flags , ierr )
+      current_date = temp24
+      start_date = temp24b
+      CALL domain_clock_set( nested_grid, &
+                             current_timestr=current_date(1:19) )
+
+         IF ( time_loop .EQ. 2 ) THEN
+            CALL wrf_put_dom_ti_real    ( fidb , 'BDYFRQ' , new_bdy_frq , 1 , ierr ) 
+         END IF
+
+         !  Since this is the last time through here, we need to close the boundary file.
+
+         CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+         CALL close_dataset ( fidb , config_flags , "DATASET=BOUNDARY" )
+
+
+      END IF
+
+      !  Process which time now?
+
+   END DO big_time_loop_thingy
+
+   CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
+   CALL med_shutdown_io ( parent_grid , config_flags )
+
+   CALL wrf_debug ( 0 , 'ndown_em: SUCCESS COMPLETE NDOWN_EM INIT' )
+
+   CALL wrf_shutdown
+
+   CALL WRFU_Finalize( rc=rc )
+
+END PROGRAM ndown_em
+
+SUBROUTINE land_percentages ( xland , &
+                              landuse_frac , soil_top_cat , soil_bot_cat , &
+                              isltyp , ivgtyp , &
+                              num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                              ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              iswater )
+   USE module_soil_pre
+
+   IMPLICIT NONE
+
+   INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte , &
+                           iswater
+
+   INTEGER , INTENT(IN) :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+   REAL , DIMENSION(ims:ime,1:num_veg_cat,jms:jme) , INTENT(INOUT):: landuse_frac
+   REAL , DIMENSION(ims:ime,1:num_soil_top_cat,jms:jme) , INTENT(IN):: soil_top_cat
+   REAL , DIMENSION(ims:ime,1:num_soil_bot_cat,jms:jme) , INTENT(IN):: soil_bot_cat
+   INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: isltyp , ivgtyp
+   REAL , DIMENSION(ims:ime,jms:jme) , INTENT(OUT) :: xland
+
+   CALL process_percent_cat_new ( xland , &
+                                  landuse_frac , soil_top_cat , soil_bot_cat , &
+                                  isltyp , ivgtyp , &
+                                  num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                  ids , ide , jds , jde , kds , kde , &
+                                  ims , ime , jms , jme , kms , kme , &
+                                  its , ite , jts , jte , kts , kte , &
+                                  iswater )
+
+END SUBROUTINE land_percentages
+
+SUBROUTINE check_consistency ( ivgtyp , isltyp , landmask , &
+                                  ids , ide , jds , jde , kds , kde , &
+                                  ims , ime , jms , jme , kms , kme , &
+                                  its , ite , jts , jte , kts , kte , &
+                                  iswater )
+
+   IMPLICIT NONE
+
+   INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte , &
+                           iswater
+   INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: isltyp , ivgtyp
+   REAL    , DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: landmask
+
+   LOGICAL :: oops
+   INTEGER :: oops_count , i , j
+
+   oops = .FALSE.
+   oops_count = 0
+
+   DO j = jts, MIN(jde-1,jte)
+      DO i = its, MIN(ide-1,ite)
+         IF ( ( ( landmask(i,j) .LT. 0.5 ) .AND. ( ivgtyp(i,j) .NE. iswater ) ) .OR. &
+              ( ( landmask(i,j) .GT. 0.5 ) .AND. ( ivgtyp(i,j) .EQ. iswater ) ) ) THEN
+            print *,'mismatch in landmask and veg type'
+            print *,'i,j=',i,j, '  landmask =',NINT(landmask(i,j)),'  ivgtyp=',ivgtyp(i,j)
+            oops = .TRUE.
+            oops_count = oops_count + 1
+landmask(i,j) = 0
+ivgtyp(i,j)=16
+isltyp(i,j)=14
+         END IF
+      END DO
+   END DO
+
+   IF ( oops ) THEN
+      CALL wrf_debug( 0, 'mismatch in check_consistency, turned to water points, be careful' )
+   END IF
+
+END SUBROUTINE check_consistency
+
+SUBROUTINE check_consistency2( ivgtyp , isltyp , landmask , &
+                               tmn , tsk , sst , xland , &
+                               tslb , smois , sh2o , &
+                               num_soil_layers , id , &
+                               ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte , &
+                               iswater )
+
+   USE module_configure
+   USE module_optional_si_input
+
+   INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte 
+   INTEGER , INTENT(IN) :: num_soil_layers , id
+
+   INTEGER , DIMENSION(ims:ime,jms:jme) :: ivgtyp , isltyp
+   REAL    , DIMENSION(ims:ime,jms:jme) :: landmask , tmn , tsk , sst , xland
+   REAL    , DIMENSION(ims:ime,num_soil_layers,jms:jme) :: tslb , smois , sh2o
+
+   INTEGER :: oops1 , oops2
+   INTEGER :: i , j , k
+
+      fix_tsk_tmn : SELECT CASE ( model_config_rec%sf_surface_physics(id) )
+
+         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+            DO j = jts, MIN(jde-1,jte)
+               DO i = its, MIN(ide-1,ite)
+                  IF ( ( landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) ) THEN
+                     tmn(i,j) = sst(i,j)
+                     tsk(i,j) = sst(i,j)
+                  ELSE IF ( landmask(i,j) .LT. 0.5 ) THEN
+                     tmn(i,j) = tsk(i,j)
+                  END IF
+               END DO
+            END DO
+      END SELECT fix_tsk_tmn
+
+      !  Is the TSK reasonable?
+
+      DO j = jts, MIN(jde-1,jte)
+         DO i = its, MIN(ide-1,ite)
+            IF ( tsk(i,j) .LT. 170 .or. tsk(i,j) .GT. 400. ) THEN
+               print *,'error in the TSK'
+               print *,'i,j=',i,j
+               print *,'landmask=',landmask(i,j)
+               print *,'tsk, sst, tmn=',tsk(i,j),sst(i,j),tmn(i,j)
+               if(tmn(i,j).gt.170. .and. tmn(i,j).lt.400.)then
+                  tsk(i,j)=tmn(i,j)
+               else if(sst(i,j).gt.170. .and. sst(i,j).lt.400.)then
+                  tsk(i,j)=sst(i,j)
+               else
+                  CALL wrf_error_fatal ( 'TSK unreasonable' )
+               end if
+            END IF
+         END DO
+      END DO
+
+      !  Is the TMN reasonable?
+
+      DO j = jts, MIN(jde-1,jte)
+         DO i = its, MIN(ide-1,ite)
+            IF ( ( ( tmn(i,j) .LT. 170. ) .OR. ( tmn(i,j) .GT. 400. ) ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
+                  print *,'error in the TMN'
+                  print *,'i,j=',i,j
+                  print *,'landmask=',landmask(i,j)
+                  print *,'tsk, sst, tmn=',tsk(i,j),sst(i,j),tmn(i,j)
+               if(tsk(i,j).gt.170. .and. tsk(i,j).lt.400.)then
+                  tmn(i,j)=tsk(i,j)
+               else if(sst(i,j).gt.170. .and. sst(i,j).lt.400.)then
+                  tmn(i,j)=sst(i,j)
+               else
+                  CALL wrf_error_fatal ( 'TMN unreasonable' )
+               endif
+            END IF
+         END DO
+      END DO
+
+      !  Is the TSLB reasonable?
+
+      DO j = jts, MIN(jde-1,jte)
+         DO i = its, MIN(ide-1,ite)
+            IF ( ( ( tslb(i,1,j) .LT. 170. ) .OR. ( tslb(i,1,j) .GT. 400. ) ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
+                  print *,'error in the TSLB'
+                  print *,'i,j=',i,j
+                  print *,'landmask=',landmask(i,j)
+                  print *,'tsk, sst, tmn=',tsk(i,j),sst(i,j),tmn(i,j)
+                  print *,'tslb = ',tslb(i,:,j)
+                  print *,'old smois = ',smois(i,:,j)
+                  DO l = 1 , num_soil_layers
+                     sh2o(i,l,j) = 0.0
+                  END DO
+                  DO l = 1 , num_soil_layers
+                     smois(i,l,j) = 0.3
+                  END DO
+                  if(tsk(i,j).gt.170. .and. tsk(i,j).lt.400.)then
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)=tsk(i,j)
+                     END DO
+                  else if(sst(i,j).gt.170. .and. sst(i,j).lt.400.)then
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)=sst(i,j)
+                     END DO
+                  else if(tmn(i,j).gt.170. .and. tmn(i,j).lt.400.)then
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)=tmn(i,j)
+                     END DO
+                  else
+                     CALL wrf_error_fatal ( 'TSLB unreasonable' )
+                  endif
+            END IF
+         END DO
+      END DO
+
+      !  Let us make sure (again) that the landmask and the veg/soil categories match.
+
+oops1=0
+oops2=0
+      DO j = jts, MIN(jde-1,jte)
+         DO i = its, MIN(ide-1,ite)
+            IF ( ( ( landmask(i,j) .LT. 0.5 ) .AND. ( ivgtyp(i,j) .NE. iswater .OR. isltyp(i,j) .NE. 14 ) ) .OR. &
+                 ( ( landmask(i,j) .GT. 0.5 ) .AND. ( ivgtyp(i,j) .EQ. iswater .OR. isltyp(i,j) .EQ. 14 ) ) ) THEN
+               IF ( tslb(i,1,j) .GT. 1. ) THEN
+oops1=oops1+1
+                  ivgtyp(i,j) = 5
+                  isltyp(i,j) = 8
+                  landmask(i,j) = 1
+                  xland(i,j) = 1
+               ELSE IF ( sst(i,j) .GT. 1. ) THEN
+oops2=oops2+1
+                  ivgtyp(i,j) = iswater
+                  isltyp(i,j) = 14
+                  landmask(i,j) = 0
+                  xland(i,j) = 2
+               ELSE
+                  print *,'the landmask and soil/veg cats do not match'
+                  print *,'i,j=',i,j
+                  print *,'landmask=',landmask(i,j)
+                  print *,'ivgtyp=',ivgtyp(i,j)
+                  print *,'isltyp=',isltyp(i,j)
+                  print *,'iswater=', iswater
+                  print *,'tslb=',tslb(i,:,j)
+                  print *,'sst=',sst(i,j)
+                  CALL wrf_error_fatal ( 'mismatch_landmask_ivgtyp' )
+               END IF
+            END IF
+         END DO
+      END DO
+if (oops1.gt.0) then
+print *,'points artificially set to land : ',oops1
+endif
+if(oops2.gt.0) then
+print *,'points artificially set to water: ',oops2
+endif
+
+END SUBROUTINE check_consistency2
+
+SUBROUTINE init_domain_constants_em_ptr ( parent , nest ) 
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain), POINTER  :: parent , nest
+   INTERFACE 
+   SUBROUTINE init_domain_constants_em ( parent , nest )
+      USE module_domain
+      USE module_configure
+      TYPE(domain)  :: parent , nest
+   END SUBROUTINE init_domain_constants_em
+   END INTERFACE 
+   CALL init_domain_constants_em ( parent , nest )
+END SUBROUTINE init_domain_constants_em_ptr
Index: trunk/WRF.COMMON/WRFV2/main/nup_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/nup_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/nup_em.F	(revision 2744)
@@ -0,0 +1,907 @@
+!WRF:DRIVER_LAYER:MAIN
+!
+
+! "Nest up" program in WRFV2.
+! 
+! Description:
+! 
+! The nest up (nup.exe) program reads from wrfout_d02_<date> files for
+! the nest and generates wrfout_d01_<date> files for the same periods as
+! are in the input files.  The fields in the output are the fields in the
+! input for state variables that have 'h' and 'u' in the I/O string of
+! the Registry.  In other words, these are the fields that are normally
+! fed back from nest->parent during 2-way nesting.  It will read and
+! output over multiple files of nest data and generate an equivalent
+! number of files of parent data.  The dimensions of the fields in the
+! output are the size of the nest fields divided by the nesting ratio.
+! 
+! Source file:   main/nup_em.F
+! 
+! Compile with WRF: compile em_real
+! 
+! Resulting executable:  
+! 
+!     main/nup.exe 
+!      -and-
+!     symbolic link in test/em_real/nup.exe
+! 
+! Run as:  nup.exe (no arguments)
+! 
+! Namelist information:
+! 
+! Nup.exe uses the same namelist as a nested run of the wrf.exe.
+! Important settings are:
+! 
+!  &time_control
+! 
+!    start_*            <start time information for both domains>
+!    end_*              <start time information for both domains>
+!    history_interval   <interval between frames in input/output files>
+!    frames_per_outfile <number of frames in input/output files>
+!    io_form_history    <2 for NetCDF>
+! 
+!  &domains
+!     ...
+!    max_dom            <number of domains; must be 2>
+!    e_we               <col 2 is size of nested grid in west-east>
+!                       <col 1 is ignored in the namelist>
+!    e_sn               <col 2 is size of nested grid in south-north>
+!                       <col 1 is ignored in the namelist>
+!    parent_grid_ratio  <col 2 is nesting ratio in both dims>
+!    feedback           <must be 1>
+!    smooth_option      <recommend 0>
+! 
+!  &physics
+!             <all options in this section should be the same
+!              as the run that generated the nest data>
+! 
+!  created: JM 2006 01 25 
+
+PROGRAM nup_em
+
+   USE module_machine
+   USE module_domain
+   USE module_initialize
+   USE module_integrate
+   USE module_driver_constants
+   USE module_configure
+   USE module_io_domain
+   USE module_utility
+
+   USE module_timing
+   USE module_wrf_error
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+   USE read_util_module
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!new for bc
+   USE module_bc
+   USE module_big_step_utilities_em
+   USE module_get_file_names
+#ifdef WRF_CHEM
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! for chemistry
+   USE module_input_chem_data
+!  USE module_input_chem_bioemiss
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+#endif
+
+   IMPLICIT NONE
+ ! interface
+   INTERFACE
+     ! mediation-supplied
+     SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
+       USE module_domain
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_read_wrf_chem_bioemiss
+     SUBROUTINE nup ( parent_grid , nested_grid, in_id, out_id, newly_opened )
+       USE module_domain
+       TYPE (domain), POINTER :: parent_grid, nested_grid
+       INTEGER, INTENT(IN) :: in_id, out_id    ! io units
+       LOGICAL, INTENT(IN) :: newly_opened     ! whether to add global metadata
+     END SUBROUTINE nup
+
+   END INTERFACE
+
+   TYPE(WRFU_TimeInterval) :: RingInterval
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!new for bc
+   INTEGER :: ids , ide , jds , jde , kds , kde
+   INTEGER :: ims , ime , jms , jme , kms , kme
+   INTEGER :: ips , ipe , jps , jpe , kps , kpe
+   INTEGER :: its , ite , jts , jte , kts , kte
+   INTEGER :: ijds , ijde , spec_bdy_width
+   INTEGER :: i , j , k
+   INTEGER :: time_loop_max , time_loop
+   INTEGER :: total_time_sec , file_counter
+   INTEGER :: julyr , julday , iswater , map_proj
+   INTEGER :: icnt
+
+   REAL    :: dt , new_bdy_frq
+   REAL    :: gmt , cen_lat , cen_lon , dx , dy , truelat1 , truelat2 , moad_cen_lat , stand_lon
+
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE :: mbdy2dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE :: mbdy2dtemp2
+
+   CHARACTER(LEN=19) :: start_timestr , current_timestr , end_timestr, timestr
+   CHARACTER(LEN=19) :: stopTimeStr
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+
+   REAL    :: time
+   INTEGER :: rc
+
+   INTEGER :: loop , levels_to_process
+   INTEGER , PARAMETER :: max_sanity_file_loop = 100
+
+   TYPE (domain) , POINTER :: keep_grid, grid_ptr, null_domain, parent_grid , nested_grid
+   TYPE (domain)           :: dummy
+   TYPE (grid_config_rec_type)              :: config_flags
+   INTEGER                 :: number_at_same_level
+   INTEGER                 :: time_step_begin_restart
+
+   INTEGER :: max_dom , domain_id , fid , fido, fidb , idum1 , idum2 , ierr
+   INTEGER :: status_next_var
+   INTEGER :: debug_level
+   LOGICAL :: newly_opened
+   CHARACTER (LEN=19) :: date_string
+
+#ifdef DM_PARALLEL
+   INTEGER                 :: nbytes
+   INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
+   INTEGER                 :: configbuf( configbuflen )
+   LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+#endif
+
+   INTEGER                 :: idsi, in_id, out_id
+   INTEGER                 :: e_sn, e_we, pgr
+   CHARACTER (LEN=80)      :: inpname , outname , bdyname
+   CHARACTER (LEN=80)      :: si_inpname
+   CHARACTER *19 :: temp19
+   CHARACTER *24 :: temp24 , temp24b
+   CHARACTER *132 :: fname
+   CHARACTER(len=24) :: start_date_hold
+
+   CHARACTER (LEN=80)      :: message
+integer :: ii
+
+#include "version_decl"
+
+   !  Interface block for routine that passes pointers and needs to know that they
+   !  are receiving pointers.
+
+   INTERFACE
+
+      SUBROUTINE med_feedback_domain ( parent_grid , nested_grid )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: parent_grid , nested_grid
+      END SUBROUTINE med_feedback_domain
+
+      SUBROUTINE Setup_Timekeeping( parent_grid )
+         USE module_domain
+         TYPE(domain), POINTER :: parent_grid
+      END SUBROUTINE Setup_Timekeeping
+
+   END INTERFACE
+
+   !  Define the name of this program (program_name defined in module_domain)
+
+   program_name = "NUP_EM " // TRIM(release_version) // " PREPROCESSOR"
+
+#ifdef DM_PARALLEL
+   CALL disable_quilting
+#endif
+
+   !  Initialize the modules used by the WRF system.  Many of the CALLs made from the
+   !  init_modules routine are NO-OPs.  Typical initializations are: the size of a 
+   !  REAL, setting the file handles to a pre-use value, defining moisture and 
+   !  chemistry indices, etc.
+
+   CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
+   CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
+   CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
+
+   !  Get the NAMELIST data.  This is handled in the initial_config routine.  All of the
+   !  NAMELIST input variables are assigned to the model_config_rec structure.  Below,
+   !  note for parallel processing, only the monitor processor handles the raw Fortran
+   !  I/O, and then broadcasts the info to each of the other nodes.
+
+#ifdef DM_PARALLEL
+   IF ( wrf_dm_on_monitor() ) THEN
+     CALL initial_config
+   ENDIF
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+   CALL wrf_dm_initialize
+#else
+   CALL initial_config
+#endif
+
+   !  And here is an instance of using the information in the NAMELIST.  
+
+   CALL nl_get_debug_level ( 1, debug_level )
+   CALL set_wrf_debug_level ( debug_level )
+
+   ! set the specified boundary to zero so the feedback goes all the way
+   ! to the edge of the coarse domain
+   CALL nl_set_spec_zone( 1, 0 )
+
+   !  Allocated and configure the mother domain.  Since we are in the nesting down
+   !  mode, we know a) we got a nest, and b) we only got 1 nest.
+
+   NULLIFY( null_domain )
+
+!!!! set up the parent grid  (for nup_em, this is the grid we do output from)
+
+   CALL       nl_set_shw( 1, 0 )
+   CALL       nl_set_shw( 2, 0 )
+   CALL       nl_set_i_parent_start( 2, 1 )
+   CALL       nl_set_j_parent_start( 2, 1 )
+   CALL       nl_get_e_we( 2, e_we )
+   CALL       nl_get_e_sn( 2, e_sn )
+   CALL       nl_get_parent_grid_ratio( 2, pgr )
+
+   ! parent grid must cover the entire nest, which is always dimensioned a factor of 3 + 1
+   ! so add two here temporarily, then remove later after nest is allocated. 
+
+   e_we = e_we / pgr + 2
+   e_sn = e_sn / pgr + 2 
+   CALL       nl_set_e_we( 1, e_we )
+   CALL       nl_set_e_sn( 1, e_sn )
+
+   CALL       wrf_message ( program_name )
+   CALL       wrf_debug ( 100 , 'nup_em: calling alloc_and_configure_domain coarse ' )
+   CALL alloc_and_configure_domain ( domain_id  = 1 ,                  &
+                                     grid       = head_grid ,          &
+                                     parent     = null_domain ,        &
+                                     kid        = -1                   )
+
+   parent_grid => head_grid
+
+   !  Set up time initializations.
+
+   CALL Setup_Timekeeping ( parent_grid )
+
+   CALL domain_clock_set( head_grid, &
+                          time_step_seconds=model_config_rec%interval_seconds )
+
+   CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
+   CALL set_scalar_indices_from_config ( parent_grid%id , idum1, idum2 )
+
+!!!! set up the fine grid  (for nup_em, this is the grid we do input into)
+
+   CALL       wrf_message ( program_name )
+   CALL       wrf_debug ( 100 , 'wrf: calling alloc_and_configure_domain fine ' )
+   CALL alloc_and_configure_domain ( domain_id  = 2 ,                  &
+                                     grid       = nested_grid ,        &
+                                     parent     = parent_grid ,        &
+                                     kid        = 1                   )
+
+! now that the nest is allocated, pinch off the extra two rows/columns of the parent
+! note the IKJ assumption here.
+   parent_grid%ed31 = parent_grid%ed31 - 2
+   parent_grid%ed33 = parent_grid%ed33 - 2
+   CALL       nl_set_e_we( 1, e_we-2 )
+   CALL       nl_set_e_sn( 1, e_sn-2 )
+
+write(0,*)'after alloc_and_configure_domain ',associated(nested_grid%intermediate_grid)
+
+   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+   CALL set_scalar_indices_from_config ( nested_grid%id , idum1, idum2 )
+
+   !  Set up time initializations for the fine grid.
+
+   CALL Setup_Timekeeping ( nested_grid )
+   !  Adjust the time step on the clock so that it's the same as the history interval
+
+   CALL WRFU_AlarmGet( nested_grid%alarms(HISTORY_ALARM), RingInterval=RingInterval )
+   CALL WRFU_ClockSet( nested_grid%domain_clock, TimeStep=RingInterval, rc=rc )
+   CALL WRFU_ClockSet( parent_grid%domain_clock, TimeStep=RingInterval, rc=rc )
+   
+   !  Get and store the history interval from the fine grid; use for time loop 
+
+
+   !  Initialize the I/O for WRF.
+
+   CALL init_wrfio
+
+   !  Some of the configuration values may have been modified from the initial READ
+   !  of the NAMELIST, so we re-broadcast the configuration records.
+
+#ifdef DM_PARALLEL
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+#endif
+
+   !  Open the input data (wrfout_d01_xxxxxx) for reading.
+   in_id = 0
+   out_id = 0
+   main_loop : DO WHILE ( domain_get_current_time(nested_grid) .LT. domain_get_stop_time(nested_grid) )
+
+      IF( WRFU_AlarmIsRinging( nested_grid%alarms( HISTORY_ALARM ), rc=rc ) ) THEN
+        CALL domain_clock_get( nested_grid, current_timestr=timestr )
+        newly_opened = .FALSE.
+        IF ( in_id.EQ. 0 ) THEN
+          CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+          CALL construct_filename2a ( fname , config_flags%history_outname , nested_grid%id , 2 , timestr )
+          CALL open_r_dataset ( in_id, TRIM(fname), nested_grid ,  &
+                                 config_flags , 'DATASET=HISTORY' , ierr )
+          IF ( ierr .NE. 0 ) THEN
+            WRITE(message,*)'Failed to open ',TRIM(fname),' for reading. '
+            CALL wrf_message(message)
+            EXIT main_loop
+          ENDIF
+
+          CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
+          CALL construct_filename2a ( fname , config_flags%history_outname , parent_grid%id , 2 , timestr )
+          CALL open_w_dataset ( out_id, TRIM(fname), parent_grid ,  &
+                                 config_flags , output_history, 'DATASET=HISTORY' , ierr )
+          IF ( ierr .NE. 0 ) THEN
+            WRITE(message,*)'Failed to open ',TRIM(fname),' for writing. '
+            CALL wrf_message(message)
+            EXIT main_loop
+          ENDIF
+          newly_opened = .TRUE.
+        ENDIF
+
+        CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+        CALL input_history ( in_id, nested_grid , config_flags , ierr )
+        IF ( ierr .NE. 0 ) THEN
+          WRITE(message,*)'Unable to read time ',timestr
+          CALL wrf_message(message)
+          EXIT main_loop
+        ENDIF
+!
+        CALL nup ( nested_grid , parent_grid, in_id, out_id, newly_opened  )
+!
+        CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
+        CALL output_history ( out_id, parent_grid , config_flags , ierr )
+        IF ( ierr .NE. 0 ) THEN
+          WRITE(message,*)'Unable to write time ',timestr
+          CALL wrf_message(message)
+          EXIT main_loop
+        ENDIF
+
+        nested_grid%nframes(0) = nested_grid%nframes(0) + 1
+        IF ( nested_grid%nframes(0) >= config_flags%frames_per_outfile ) THEN
+          CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+          CALL close_dataset ( in_id , config_flags , "DATASET=HISTORY" )
+          CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
+          CALL close_dataset ( out_id , config_flags , "DATASET=HISTORY" )
+          in_id = 0
+          out_id = 0
+          nested_grid%nframes(0) = 0
+        ENDIF
+        CALL WRFU_AlarmRingerOff( nested_grid%alarms( HISTORY_ALARM ), rc=rc )
+      ENDIF
+      CALL domain_clockadvance( nested_grid )
+      CALL domain_clockadvance( parent_grid )
+   ENDDO main_loop
+   CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
+   CALL med_shutdown_io ( parent_grid , config_flags )
+
+   CALL wrf_debug ( 0 , 'nup_em: SUCCESS COMPLETE NUP_EM INIT' )
+
+!  CALL wrf_shutdown
+
+   CALL WRFU_Finalize( rc=rc )
+
+END PROGRAM nup_em
+
+SUBROUTINE nup ( nested_grid, parent_grid , in_id, out_id, newly_opened ) 
+  USE module_domain
+  USE module_io_domain
+  USE module_utility
+  USE module_timing
+  USE module_wrf_error
+!
+  IMPLICIT NONE
+
+! Args
+  TYPE(domain), POINTER :: parent_grid, nested_grid
+  INTEGER, INTENT(IN) :: in_id, out_id    ! io descriptors 
+  LOGICAL, INTENT(IN) :: newly_opened     ! whether to add global metadata
+! Local
+  INTEGER :: julyr , julday , iswater , map_proj
+  INTEGER :: icnt, ierr
+  REAL    :: dt , new_bdy_frq
+  REAL    :: gmt , cen_lat , cen_lon , dx , dy , truelat1 , truelat2 , moad_cen_lat , stand_lon
+  REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
+  REAL , DIMENSION(:,:,:) , ALLOCATABLE :: mbdy2dtemp1
+  REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
+  REAL , DIMENSION(:,:,:) , ALLOCATABLE :: mbdy2dtemp2
+  INTEGER :: ids , ide , jds , jde , kds , kde
+  INTEGER :: ims , ime , jms , jme , kms , kme
+  INTEGER :: ips , ipe , jps , jpe , kps , kpe
+  INTEGER :: its , ite , jts , jte , kts , kte
+
+  INTERFACE
+     SUBROUTINE med_feedback_domain ( parent_grid , nested_grid )
+        USE module_domain
+        USE module_configure
+        TYPE(domain), POINTER :: parent_grid , nested_grid
+     END SUBROUTINE med_feedback_domain
+     SUBROUTINE med_interp_domain ( parent_grid , nested_grid )
+        USE module_domain
+        USE module_configure
+        TYPE(domain), POINTER :: parent_grid , nested_grid
+     END SUBROUTINE med_interp_domain
+  END INTERFACE
+
+  IF ( newly_opened ) THEN
+    CALL wrf_get_dom_ti_integer ( in_id , 'MAP_PROJ' , map_proj , 1 , icnt , ierr ) 
+    CALL wrf_get_dom_ti_real    ( in_id , 'DX'  , dx  , 1 , icnt , ierr ) 
+    CALL wrf_get_dom_ti_real    ( in_id , 'DY'  , dy  , 1 , icnt , ierr ) 
+    CALL wrf_get_dom_ti_real    ( in_id , 'CEN_LAT' , cen_lat , 1 , icnt , ierr ) 
+    CALL wrf_get_dom_ti_real    ( in_id , 'CEN_LON' , cen_lon , 1 , icnt , ierr ) 
+    CALL wrf_get_dom_ti_real    ( in_id , 'TRUELAT1' , truelat1 , 1 , icnt , ierr ) 
+    CALL wrf_get_dom_ti_real    ( in_id , 'TRUELAT2' , truelat2 , 1 , icnt , ierr ) 
+    CALL wrf_get_dom_ti_real    ( in_id , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , icnt , ierr ) 
+    CALL wrf_get_dom_ti_real    ( in_id , 'STAND_LON' , stand_lon , 1 , icnt , ierr ) 
+!     CALL wrf_get_dom_ti_real    ( in_id , 'GMT' , gmt , 1 , icnt , ierr ) 
+!     CALL wrf_get_dom_ti_integer ( in_id , 'JULYR' , julyr , 1 , icnt , ierr ) 
+!     CALL wrf_get_dom_ti_integer ( in_id , 'JULDAY' , julday , 1 , icnt , ierr ) 
+    CALL wrf_get_dom_ti_integer ( in_id , 'ISWATER' , iswater , 1 , icnt , ierr ) 
+  ENDIF
+
+  parent_grid%em_fnm    = nested_grid%em_fnm
+  parent_grid%em_fnp    = nested_grid%em_fnp
+  parent_grid%em_rdnw   = nested_grid%em_rdnw
+  parent_grid%em_rdn    = nested_grid%em_rdn
+  parent_grid%em_dnw    = nested_grid%em_dnw
+  parent_grid%em_dn     = nested_grid%em_dn 
+  parent_grid%em_znu    = nested_grid%em_znu
+  parent_grid%em_znw    = nested_grid%em_znw
+
+  parent_grid%zs        = nested_grid%zs
+  parent_grid%dzs       = nested_grid%dzs
+
+  parent_grid%p_top     = nested_grid%p_top
+  parent_grid%rdx       = nested_grid%rdx * 3.
+  parent_grid%rdy       = nested_grid%rdy * 3.
+  parent_grid%resm      = nested_grid%resm
+  parent_grid%zetatop   = nested_grid%zetatop
+  parent_grid%cf1       = nested_grid%cf1
+  parent_grid%cf2       = nested_grid%cf2
+  parent_grid%cf3       = nested_grid%cf3
+
+  parent_grid%cfn       = nested_grid%cfn 
+  parent_grid%cfn1      = nested_grid%cfn1
+
+#ifdef WRF_CHEM
+  parent_grid%chem_opt    = nested_grid%chem_opt
+  parent_grid%chem_in_opt = nested_grid%chem_in_opt
+#endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !  Various sizes that we need to be concerned about.
+
+  ids = parent_grid%sd31
+  ide = parent_grid%ed31
+  kds = parent_grid%sd32
+  kde = parent_grid%ed32
+  jds = parent_grid%sd33
+  jde = parent_grid%ed33
+
+  ims = parent_grid%sm31
+  ime = parent_grid%em31
+  kms = parent_grid%sm32
+  kme = parent_grid%em32
+  jms = parent_grid%sm33
+  jme = parent_grid%em33
+
+  ips = parent_grid%sp31
+  ipe = parent_grid%ep31
+  kps = parent_grid%sp32
+  kpe = parent_grid%ep32
+  jps = parent_grid%sp33
+  jpe = parent_grid%ep33
+
+  nested_grid%imask_nostag = 1
+  nested_grid%imask_xstag = 1
+  nested_grid%imask_ystag = 1
+  nested_grid%imask_xystag = 1
+
+! Interpolate from nested_grid back onto parent_grid
+  CALL med_feedback_domain ( parent_grid , nested_grid )
+
+  parent_grid%ht_int = parent_grid%ht
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+#if 0
+         CALL construct_filename2( si_inpname , 'wrf_real_input_em' , parent_grid%id , 2 , start_date_char )
+         CALL       wrf_debug ( 100 , 'med_sidata_input: calling open_r_dataset for ' // TRIM(si_inpname) )
+         CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
+         CALL open_r_dataset ( idsi, TRIM(si_inpname) , parent_grid , config_flags , "DATASET=INPUT", ierr )
+         IF ( ierr .NE. 0 ) THEN
+            CALL wrf_error_fatal( 'real: error opening wrf_real_input_em for reading: ' // TRIM (si_inpname) )
+         END IF
+
+         !  Input data.
+   
+         CALL       wrf_debug ( 100 , 'nup_em: calling input_aux_model_input2' )
+         CALL input_aux_model_input2 ( idsi , parent_grid , config_flags , ierr )
+         parent_grid%ht_input = parent_grid%ht
+   
+         !  Close this fine grid static input file.
+   
+         CALL       wrf_debug ( 100 , 'nup_em: closing fine grid static input' )
+         CALL close_dataset ( idsi , config_flags , "DATASET=INPUT" )
+
+         !  We need a parent grid landuse in the interpolation.  So we need to generate
+         !  that field now.
+
+         IF      ( ( parent_grid%ivgtyp(ips,jps) .GT. 0 ) .AND. &
+                   ( parent_grid%isltyp(ips,jps) .GT. 0 ) ) THEN
+            DO j = jps, MIN(jde-1,jpe)
+               DO i = ips, MIN(ide-1,ipe)
+                  parent_grid% vegcat(i,j) = parent_grid%ivgtyp(i,j)
+                  parent_grid%soilcat(i,j) = parent_grid%isltyp(i,j)
+               END DO
+            END DO
+
+         ELSE IF ( ( parent_grid% vegcat(ips,jps) .GT. 0.5 ) .AND. &
+                   ( parent_grid%soilcat(ips,jps) .GT. 0.5 ) ) THEN
+            DO j = jps, MIN(jde-1,jpe)
+               DO i = ips, MIN(ide-1,ipe)
+                  parent_grid%ivgtyp(i,j) = NINT(parent_grid% vegcat(i,j))
+                  parent_grid%isltyp(i,j) = NINT(parent_grid%soilcat(i,j))
+               END DO
+            END DO
+
+         ELSE
+            num_veg_cat      = SIZE ( parent_grid%landusef , DIM=2 )
+            num_soil_top_cat = SIZE ( parent_grid%soilctop , DIM=2 )
+            num_soil_bot_cat = SIZE ( parent_grid%soilcbot , DIM=2 )
+   
+            CALL land_percentages (  parent_grid%xland , &
+                                     parent_grid%landusef , parent_grid%soilctop , parent_grid%soilcbot , &
+                                     parent_grid%isltyp , parent_grid%ivgtyp , &
+                                     num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                     ids , ide , jds , jde , kds , kde , &
+                                     ims , ime , jms , jme , kms , kme , &
+                                     ips , ipe , jps , jpe , kps , kpe , &
+                                     model_config_rec%iswater(parent_grid%id) )
+
+          END IF
+
+          DO j = jps, MIN(jde-1,jpe)
+            DO i = ips, MIN(ide-1,ipe)
+               parent_grid%lu_index(i,j) = parent_grid%ivgtyp(i,j)
+            END DO
+         END DO
+
+         CALL check_consistency ( parent_grid%ivgtyp , parent_grid%isltyp , parent_grid%landmask , &
+                                  ids , ide , jds , jde , kds , kde , &
+                                  ims , ime , jms , jme , kms , kme , &
+                                  ips , ipe , jps , jpe , kps , kpe , &
+                                  model_config_rec%iswater(parent_grid%id) )
+
+         CALL check_consistency2( parent_grid%ivgtyp , parent_grid%isltyp , parent_grid%landmask , &
+                                  parent_grid%tmn , parent_grid%tsk , parent_grid%sst , parent_grid%xland , &
+                                  parent_grid%tslb , parent_grid%smois , parent_grid%sh2o , &
+                                  config_flags%num_soil_layers , parent_grid%id , &
+                                  ids , ide , jds , jde , kds , kde , &
+                                  ims , ime , jms , jme , kms , kme , &
+                                  ips , ipe , jps , jpe , kps , kpe , &
+                                  model_config_rec%iswater(parent_grid%id) )
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   
+      !  We have 2 terrain elevations.  One is from input and the other is from the
+      !  the horizontal interpolation.
+
+      parent_grid%ht_fine = parent_grid%ht_input
+      parent_grid%ht      = parent_grid%ht_int
+
+      !  We have both the interpolated fields and the higher-resolution static fields.  From these
+      !  the rebalancing is now done.  Note also that the field parent_grid%ht is now from the 
+      !  fine grid input file (after this call is completed).
+
+      CALL rebalance_driver ( parent_grid ) 
+
+      !  Different things happen during the different time loops:
+      !      first loop - write wrfinput file, close data set, copy files to holder arrays
+      !      middle loops - diff 3d/2d arrays, compute and output bc
+      !      last loop - diff 3d/2d arrays, compute and output bc, write wrfbdy file, close wrfbdy file
+
+         !  Set the time info.
+
+         print *,'current_date = ',current_date
+         CALL domain_clock_set( parent_grid, &
+                                current_timestr=current_date(1:19) )
+!
+! SEP     Put in chemistry data
+!
+#ifdef WRF_CHEM
+         IF( parent_grid%chem_opt .NE. 0 ) then
+            IF( parent_grid%chem_in_opt .EQ. 0 ) then
+             ! Read the chemistry data from a previous wrf forecast (wrfout file)
+              ! Generate chemistry data from a idealized vertical profile
+              message = 'STARTING WITH BACKGROUND CHEMISTRY '
+              CALL  wrf_message ( message )
+
+              CALL input_chem_profile ( parent_grid )
+
+              message = 'READING BEIS3.11 EMISSIONS DATA'
+              CALL  wrf_message ( message )
+
+              CALL med_read_wrf_chem_bioemiss ( parent_grid , config_flags)
+            ELSE
+              message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
+              CALL  wrf_message ( message )
+            ENDIF
+         ENDIF
+#endif
+
+#endif
+
+         !  Output the first time period of the data.
+   
+  IF ( newly_opened ) THEN
+    CALL wrf_put_dom_ti_integer ( out_id , 'MAP_PROJ' , map_proj , 1 , ierr ) 
+!     CALL wrf_put_dom_ti_real    ( out_id , 'DX'  , dx  , 1 , ierr ) 
+!     CALL wrf_put_dom_ti_real    ( out_id , 'DY'  , dy  , 1 , ierr ) 
+    CALL wrf_put_dom_ti_real    ( out_id , 'CEN_LAT' , cen_lat , 1 , ierr ) 
+    CALL wrf_put_dom_ti_real    ( out_id , 'CEN_LON' , cen_lon , 1 , ierr ) 
+    CALL wrf_put_dom_ti_real    ( out_id , 'TRUELAT1' , truelat1 , 1 , ierr ) 
+    CALL wrf_put_dom_ti_real    ( out_id , 'TRUELAT2' , truelat2 , 1 , ierr ) 
+    CALL wrf_put_dom_ti_real    ( out_id , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , ierr ) 
+    CALL wrf_put_dom_ti_real    ( out_id , 'STAND_LON' , stand_lon , 1 , ierr ) 
+    CALL wrf_put_dom_ti_integer ( out_id , 'ISWATER' , iswater , 1 , ierr ) 
+
+    CALL wrf_put_dom_ti_real    ( out_id , 'GMT' , gmt , 1 , ierr ) 
+    CALL wrf_put_dom_ti_integer ( out_id , 'JULYR' , julyr , 1 , ierr ) 
+    CALL wrf_put_dom_ti_integer ( out_id , 'JULDAY' , julday , 1 , ierr ) 
+  ENDIF
+
+END SUBROUTINE nup
+
+SUBROUTINE land_percentages ( xland , &
+                              landuse_frac , soil_top_cat , soil_bot_cat , &
+                              isltyp , ivgtyp , &
+                              num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                              ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              iswater )
+   USE module_soil_pre
+
+   IMPLICIT NONE
+
+   INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte , &
+                           iswater
+
+   INTEGER , INTENT(IN) :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+   REAL , DIMENSION(ims:ime,1:num_veg_cat,jms:jme) , INTENT(INOUT):: landuse_frac
+   REAL , DIMENSION(ims:ime,1:num_soil_top_cat,jms:jme) , INTENT(IN):: soil_top_cat
+   REAL , DIMENSION(ims:ime,1:num_soil_bot_cat,jms:jme) , INTENT(IN):: soil_bot_cat
+   INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: isltyp , ivgtyp
+   REAL , DIMENSION(ims:ime,jms:jme) , INTENT(OUT) :: xland
+
+   CALL process_percent_cat_new ( xland , &
+                                  landuse_frac , soil_top_cat , soil_bot_cat , &
+                                  isltyp , ivgtyp , &
+                                  num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                  ids , ide , jds , jde , kds , kde , &
+                                  ims , ime , jms , jme , kms , kme , &
+                                  its , ite , jts , jte , kts , kte , &
+                                  iswater )
+
+END SUBROUTINE land_percentages
+
+SUBROUTINE check_consistency ( ivgtyp , isltyp , landmask , &
+                                  ids , ide , jds , jde , kds , kde , &
+                                  ims , ime , jms , jme , kms , kme , &
+                                  its , ite , jts , jte , kts , kte , &
+                                  iswater )
+
+   IMPLICIT NONE
+
+   INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte , &
+                           iswater
+   INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: isltyp , ivgtyp
+   REAL    , DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: landmask
+
+   LOGICAL :: oops
+   INTEGER :: oops_count , i , j
+
+   oops = .FALSE.
+   oops_count = 0
+
+   DO j = jts, MIN(jde-1,jte)
+      DO i = its, MIN(ide-1,ite)
+         IF ( ( ( landmask(i,j) .LT. 0.5 ) .AND. ( ivgtyp(i,j) .NE. iswater ) ) .OR. &
+              ( ( landmask(i,j) .GT. 0.5 ) .AND. ( ivgtyp(i,j) .EQ. iswater ) ) ) THEN
+            print *,'mismatch in landmask and veg type'
+            print *,'i,j=',i,j, '  landmask =',NINT(landmask(i,j)),'  ivgtyp=',ivgtyp(i,j)
+            oops = .TRUE.
+            oops_count = oops_count + 1
+landmask(i,j) = 0
+ivgtyp(i,j)=16
+isltyp(i,j)=14
+         END IF
+      END DO
+   END DO
+
+   IF ( oops ) THEN
+      CALL wrf_debug( 0, 'mismatch in check_consistency, turned to water points, be careful' )
+   END IF
+
+END SUBROUTINE check_consistency
+
+SUBROUTINE check_consistency2( ivgtyp , isltyp , landmask , &
+                               tmn , tsk , sst , xland , &
+                               tslb , smois , sh2o , &
+                               num_soil_layers , id , &
+                               ids , ide , jds , jde , kds , kde , &
+                               ims , ime , jms , jme , kms , kme , &
+                               its , ite , jts , jte , kts , kte , &
+                               iswater )
+
+   USE module_configure
+   USE module_optional_si_input
+
+   INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           its , ite , jts , jte , kts , kte 
+   INTEGER , INTENT(IN) :: num_soil_layers , id
+
+   INTEGER , DIMENSION(ims:ime,jms:jme) :: ivgtyp , isltyp
+   REAL    , DIMENSION(ims:ime,jms:jme) :: landmask , tmn , tsk , sst , xland
+   REAL    , DIMENSION(ims:ime,num_soil_layers,jms:jme) :: tslb , smois , sh2o
+
+   INTEGER :: oops1 , oops2
+   INTEGER :: i , j , k
+
+      fix_tsk_tmn : SELECT CASE ( model_config_rec%sf_surface_physics(id) )
+
+         CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
+            DO j = jts, MIN(jde-1,jte)
+               DO i = its, MIN(ide-1,ite)
+                  IF ( ( landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) ) THEN
+                     tmn(i,j) = sst(i,j)
+                     tsk(i,j) = sst(i,j)
+                  ELSE IF ( landmask(i,j) .LT. 0.5 ) THEN
+                     tmn(i,j) = tsk(i,j)
+                  END IF
+               END DO
+            END DO
+      END SELECT fix_tsk_tmn
+
+      !  Is the TSK reasonable?
+
+      DO j = jts, MIN(jde-1,jte)
+         DO i = its, MIN(ide-1,ite)
+            IF ( tsk(i,j) .LT. 170 .or. tsk(i,j) .GT. 400. ) THEN
+               print *,'error in the TSK'
+               print *,'i,j=',i,j
+               print *,'landmask=',landmask(i,j)
+               print *,'tsk, sst, tmn=',tsk(i,j),sst(i,j),tmn(i,j)
+               if(tmn(i,j).gt.170. .and. tmn(i,j).lt.400.)then
+                  tsk(i,j)=tmn(i,j)
+               else if(sst(i,j).gt.170. .and. sst(i,j).lt.400.)then
+                  tsk(i,j)=sst(i,j)
+               else
+                  CALL wrf_error_fatal ( 'TSK unreasonable' )
+               end if
+            END IF
+         END DO
+      END DO
+
+      !  Is the TMN reasonable?
+
+      DO j = jts, MIN(jde-1,jte)
+         DO i = its, MIN(ide-1,ite)
+            IF ( ( ( tmn(i,j) .LT. 170. ) .OR. ( tmn(i,j) .GT. 400. ) ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
+                  print *,'error in the TMN'
+                  print *,'i,j=',i,j
+                  print *,'landmask=',landmask(i,j)
+                  print *,'tsk, sst, tmn=',tsk(i,j),sst(i,j),tmn(i,j)
+               if(tsk(i,j).gt.170. .and. tsk(i,j).lt.400.)then
+                  tmn(i,j)=tsk(i,j)
+               else if(sst(i,j).gt.170. .and. sst(i,j).lt.400.)then
+                  tmn(i,j)=sst(i,j)
+               else
+                  CALL wrf_error_fatal ( 'TMN unreasonable' )
+               endif
+            END IF
+         END DO
+      END DO
+
+      !  Is the TSLB reasonable?
+
+      DO j = jts, MIN(jde-1,jte)
+         DO i = its, MIN(ide-1,ite)
+            IF ( ( ( tslb(i,1,j) .LT. 170. ) .OR. ( tslb(i,1,j) .GT. 400. ) ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
+                  print *,'error in the TSLB'
+                  print *,'i,j=',i,j
+                  print *,'landmask=',landmask(i,j)
+                  print *,'tsk, sst, tmn=',tsk(i,j),sst(i,j),tmn(i,j)
+                  print *,'tslb = ',tslb(i,:,j)
+                  print *,'old smois = ',smois(i,:,j)
+                  DO l = 1 , num_soil_layers
+                     sh2o(i,l,j) = 0.0
+                  END DO
+                  DO l = 1 , num_soil_layers
+                     smois(i,l,j) = 0.3
+                  END DO
+                  if(tsk(i,j).gt.170. .and. tsk(i,j).lt.400.)then
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)=tsk(i,j)
+                     END DO
+                  else if(sst(i,j).gt.170. .and. sst(i,j).lt.400.)then
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)=sst(i,j)
+                     END DO
+                  else if(tmn(i,j).gt.170. .and. tmn(i,j).lt.400.)then
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)=tmn(i,j)
+                     END DO
+                  else
+                     CALL wrf_error_fatal ( 'TSLB unreasonable' )
+                  endif
+            END IF
+         END DO
+      END DO
+
+      !  Let us make sure (again) that the landmask and the veg/soil categories match.
+
+oops1=0
+oops2=0
+      DO j = jts, MIN(jde-1,jte)
+         DO i = its, MIN(ide-1,ite)
+            IF ( ( ( landmask(i,j) .LT. 0.5 ) .AND. ( ivgtyp(i,j) .NE. iswater .OR. isltyp(i,j) .NE. 14 ) ) .OR. &
+                 ( ( landmask(i,j) .GT. 0.5 ) .AND. ( ivgtyp(i,j) .EQ. iswater .OR. isltyp(i,j) .EQ. 14 ) ) ) THEN
+               IF ( tslb(i,1,j) .GT. 1. ) THEN
+oops1=oops1+1
+                  ivgtyp(i,j) = 5
+                  isltyp(i,j) = 8
+                  landmask(i,j) = 1
+                  xland(i,j) = 1
+               ELSE IF ( sst(i,j) .GT. 1. ) THEN
+oops2=oops2+1
+                  ivgtyp(i,j) = iswater
+                  isltyp(i,j) = 14
+                  landmask(i,j) = 0
+                  xland(i,j) = 2
+               ELSE
+                  print *,'the landmask and soil/veg cats do not match'
+                  print *,'i,j=',i,j
+                  print *,'landmask=',landmask(i,j)
+                  print *,'ivgtyp=',ivgtyp(i,j)
+                  print *,'isltyp=',isltyp(i,j)
+                  print *,'iswater=', iswater
+                  print *,'tslb=',tslb(i,:,j)
+                  print *,'sst=',sst(i,j)
+                  CALL wrf_error_fatal ( 'mismatch_landmask_ivgtyp' )
+               END IF
+            END IF
+         END DO
+      END DO
+if (oops1.gt.0) then
+print *,'points artificially set to land : ',oops1
+endif
+if(oops2.gt.0) then
+print *,'points artificially set to water: ',oops2
+endif
+
+END SUBROUTINE check_consistency2
Index: trunk/WRF.COMMON/WRFV2/main/real_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/real_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/real_em.F	(revision 2744)
@@ -0,0 +1,2016 @@
+!  Create an initial data set for the WRF model based on real data.  This
+!  program is specifically set up for the Eulerian, mass-based coordinate.
+PROGRAM real_data
+
+   USE module_machine
+   USE module_domain
+   USE module_initialize
+   USE module_io_domain
+   USE module_driver_constants
+   USE module_configure
+   USE module_timing
+#ifdef WRF_CHEM
+   USE module_input_chem_data
+   USE module_input_chem_bioemiss
+#endif
+   USE module_utility
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+   IMPLICIT NONE
+
+#ifdef WRF_CHEM
+  ! interface
+   INTERFACE
+     ! mediation-supplied 
+     SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
+       USE module_domain
+       TYPE (domain) grid
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_read_wrf_chem_bioemiss
+   END INTERFACE
+#endif
+
+   REAL    :: time , bdyfrq
+
+   INTEGER :: loop , levels_to_process , debug_level
+
+
+   TYPE(domain) , POINTER :: null_domain
+   TYPE(domain) , POINTER :: grid , another_grid
+   TYPE(domain) , POINTER :: grid_ptr , grid_ptr2
+   TYPE (grid_config_rec_type)              :: config_flags
+   INTEGER                :: number_at_same_level
+
+   INTEGER :: max_dom, domain_id , grid_id , parent_id , parent_id1 , id
+   INTEGER :: e_we , e_sn , i_parent_start , j_parent_start
+   INTEGER :: idum1, idum2 
+#ifdef DM_PARALLEL
+   INTEGER                 :: nbytes
+   INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
+   INTEGER                 :: configbuf( configbuflen )
+   LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+#endif
+   LOGICAL found_the_id
+
+   INTEGER :: ids , ide , jds , jde , kds , kde
+   INTEGER :: ims , ime , jms , jme , kms , kme
+   INTEGER :: ips , ipe , jps , jpe , kps , kpe
+   INTEGER :: ijds , ijde , spec_bdy_width
+   INTEGER :: i , j , k , idts, rc
+   INTEGER :: sibling_count , parent_id_hold , dom_loop
+
+   CHARACTER (LEN=80)     :: message
+
+   INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
+   INTEGER ::   end_year ,   end_month ,   end_day ,   end_hour ,   end_minute ,   end_second
+   INTEGER :: interval_seconds , real_data_init_type
+   INTEGER :: time_loop_max , time_loop
+real::t1,t2
+   INTERFACE
+     SUBROUTINE Setup_Timekeeping( grid )
+      USE module_domain
+      TYPE(domain), POINTER :: grid
+     END SUBROUTINE Setup_Timekeeping
+   END INTERFACE
+
+#include "version_decl"
+
+   !  Define the name of this program (program_name defined in module_domain)
+
+   ! NOTE: share/input_wrf.F tests first 7 chars of this name to decide 
+   ! whether to read P_TOP as metadata from the SI (yes, if .eq. REAL_EM)
+
+   program_name = "REAL_EM " // TRIM(release_version) // " PREPROCESSOR"
+
+#ifdef DM_PARALLEL
+   CALL disable_quilting
+#endif
+
+   !  Initialize the modules used by the WRF system.  Many of the CALLs made from the
+   !  init_modules routine are NO-OPs.  Typical initializations are: the size of a
+   !  REAL, setting the file handles to a pre-use value, defining moisture and
+   !  chemistry indices, etc.
+
+   CALL       wrf_debug ( 100 , 'real_em: calling init_modules ' )
+   CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
+   CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
+   CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
+
+   !  The configuration switches mostly come from the NAMELIST input.
+
+#ifdef DM_PARALLEL
+   IF ( wrf_dm_on_monitor() ) THEN
+      CALL initial_config
+   ENDIF
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+   CALL wrf_dm_initialize
+#else
+   CALL initial_config
+#endif
+
+   CALL nl_get_debug_level ( 1, debug_level )
+   CALL set_wrf_debug_level ( debug_level )
+
+   CALL  wrf_message ( program_name )
+
+   !  Allocate the space for the mother of all domains.
+
+   NULLIFY( null_domain )
+   CALL       wrf_debug ( 100 , 'real_em: calling alloc_and_configure_domain ' )
+   CALL alloc_and_configure_domain ( domain_id  = 1           , &
+                                     grid       = head_grid   , &
+                                     parent     = null_domain , &
+                                     kid        = -1            )
+
+   grid => head_grid
+   CALL nl_get_max_dom ( 1 , max_dom )
+
+   IF ( model_config_rec%interval_seconds .LE. 0 ) THEN
+     CALL wrf_error_fatal( 'namelist value for interval_seconds must be > 0')
+   ENDIF
+
+   all_domains : DO domain_id = 1 , max_dom
+
+      IF ( ( model_config_rec%input_from_file(domain_id) ) .OR. &
+           ( domain_id .EQ. 1 ) ) THEN
+
+         IF ( domain_id .GT. 1 ) THEN
+
+            CALL nl_get_grid_id        ( domain_id, grid_id        )
+            CALL nl_get_parent_id      ( domain_id, parent_id      )
+            CALL nl_get_e_we           ( domain_id, e_we           )
+            CALL nl_get_e_sn           ( domain_id, e_sn           )
+            CALL nl_get_i_parent_start ( domain_id, i_parent_start )
+            CALL nl_get_j_parent_start ( domain_id, j_parent_start )
+            WRITE (message,FMT='(A,2I3,2I4,2I3)') &
+            'new allocated  domain: id, par id, dims i/j, start i/j =', &
+            grid_id, parent_id, e_we, e_sn, i_parent_start, j_parent_start
+
+            CALL wrf_debug ( 100 , message )
+            CALL nl_get_grid_id        ( parent_id, grid_id        )
+            CALL nl_get_parent_id      ( parent_id, parent_id1     )
+            CALL nl_get_e_we           ( parent_id, e_we           )
+            CALL nl_get_e_sn           ( parent_id, e_sn           )
+            CALL nl_get_i_parent_start ( parent_id, i_parent_start )
+            CALL nl_get_j_parent_start ( parent_id, j_parent_start )
+            WRITE (message,FMT='(A,2I3,2I4,2I3)') &
+            'parent domain: id, par id, dims i/j, start i/j =', &
+            grid_id, parent_id1, e_we, e_sn, i_parent_start, j_parent_start
+            CALL wrf_debug ( 100 , message )
+
+            CALL nl_get_grid_id        ( domain_id, grid_id        )
+            CALL nl_get_parent_id      ( domain_id, parent_id      )
+            CALL nl_get_e_we           ( domain_id, e_we           )
+            CALL nl_get_e_sn           ( domain_id, e_sn           )
+            CALL nl_get_i_parent_start ( domain_id, i_parent_start )
+            CALL nl_get_j_parent_start ( domain_id, j_parent_start )
+            grid_ptr2 => head_grid
+            found_the_id = .FALSE.
+            CALL find_my_parent ( grid_ptr2 , grid_ptr , domain_id , parent_id , found_the_id )
+            IF ( found_the_id ) THEN
+
+               sibling_count = 0
+               DO dom_loop = 2 , domain_id
+                 CALL nl_get_parent_id ( dom_loop, parent_id_hold )
+                 IF ( parent_id_hold .EQ. parent_id ) THEN
+                    sibling_count = sibling_count + 1
+                 END IF
+               END DO
+               CALL alloc_and_configure_domain ( domain_id  = domain_id    , &
+                                                 grid       = another_grid , &
+                                                 parent     = grid_ptr     , &
+                                                 kid        = sibling_count )
+               grid => another_grid
+            ELSE
+              CALL wrf_error_fatal( 'real_em.F: Could not find the parent domain')
+            END IF
+         END IF
+
+         CALL Setup_Timekeeping ( grid )
+         CALL set_current_grid_ptr( grid )
+         CALL domain_clockprint ( 150, grid, &
+                'DEBUG real:  clock after Setup_Timekeeping,' )
+         CALL domain_clock_set( grid, &
+                                time_step_seconds=model_config_rec%interval_seconds )
+         CALL domain_clockprint ( 150, grid, &
+                'DEBUG real:  clock after timeStep set,' )
+
+
+         CALL       wrf_debug ( 100 , 'real_em: calling set_scalar_indices_from_config ' )
+         CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
+
+         CALL       wrf_debug ( 100 , 'real_em: calling model_to_grid_config_rec ' )
+         CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+         !  Initialize the WRF IO: open files, init file handles, etc.
+
+         CALL       wrf_debug ( 100 , 'real_em: calling init_wrfio' )
+         CALL init_wrfio
+
+
+         !  Some of the configuration values may have been modified from the initial READ
+         !  of the NAMELIST, so we re-broadcast the configuration records.
+
+#ifdef DM_PARALLEL
+         CALL       wrf_debug ( 100 , 'real_em: re-broadcast the configuration records' )
+         CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+         CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+         CALL set_config_as_buffer( configbuf, configbuflen )
+#endif
+
+         !   No looping in this layer.  
+
+         CALL       wrf_debug ( 100 , 'calling med_sidata_input' )
+         CALL med_sidata_input ( grid , config_flags )
+         CALL       wrf_debug ( 100 , 'backfrom med_sidata_input' )
+
+      ELSE 
+         CYCLE all_domains
+      END IF
+
+   END DO all_domains
+
+   CALL set_current_grid_ptr( head_grid )
+
+   !  We are done.
+
+   CALL       wrf_debug (   0 , 'real_em: SUCCESS COMPLETE REAL_EM INIT' )
+
+   CALL wrf_shutdown
+
+   CALL WRFU_Finalize( rc=rc )
+
+END PROGRAM real_data
+
+SUBROUTINE med_sidata_input ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+  ! Model layer
+   USE module_configure
+   USE module_bc_time_utilities
+   USE module_initialize
+   USE module_optional_si_input
+#ifdef WRF_CHEM
+   USE module_input_chem_data
+   USE module_input_chem_bioemiss
+#endif
+
+   USE module_date_time
+   USE module_utility
+
+   IMPLICIT NONE
+
+
+  ! Interface 
+   INTERFACE
+     SUBROUTINE start_domain ( grid , allowed_to_read )  ! comes from module_start in appropriate dyn_ directory
+       USE module_domain
+       TYPE (domain) grid
+       LOGICAL, INTENT(IN) :: allowed_to_read
+     END SUBROUTINE start_domain
+   END INTERFACE
+
+  ! Arguments
+   TYPE(domain)                :: grid
+   TYPE (grid_config_rec_type) :: config_flags
+  ! Local
+   INTEGER                :: time_step_begin_restart
+   INTEGER                :: idsi , ierr , myproc
+   CHARACTER (LEN=80)      :: si_inpname
+   CHARACTER (LEN=80)      :: message
+
+   CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
+
+   INTEGER :: time_loop_max , loop, rc
+   INTEGER :: julyr , julday 
+   REAL :: gmt
+real::t1,t2,t3,t4
+
+   grid%input_from_file = .true.
+   grid%input_from_file = .false.
+
+   CALL compute_si_start_and_end ( model_config_rec%start_year  (grid%id) , &
+                                   model_config_rec%start_month (grid%id) , &
+                                   model_config_rec%start_day   (grid%id) , &
+                                   model_config_rec%start_hour  (grid%id) , &
+                                   model_config_rec%start_minute(grid%id) , &
+                                   model_config_rec%start_second(grid%id) , &
+                                   model_config_rec%  end_year  (grid%id) , & 
+                                   model_config_rec%  end_month (grid%id) , &
+                                   model_config_rec%  end_day   (grid%id) , &
+                                   model_config_rec%  end_hour  (grid%id) , &
+                                   model_config_rec%  end_minute(grid%id) , &
+                                   model_config_rec%  end_second(grid%id) , &
+                                   model_config_rec%interval_seconds      , &
+                                   model_config_rec%real_data_init_type   , &
+                                   start_date_char , end_date_char , time_loop_max )
+
+   !  Override stop time with value computed above.  
+   CALL domain_clock_set( grid, stop_timestr=end_date_char )
+
+   ! TBH:  for now, turn off stop time and let it run data-driven
+   CALL WRFU_ClockStopTimeDisable( grid%domain_clock, rc=rc ) 
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_ClockStopTimeDisable(grid%domain_clock) FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+   CALL domain_clockprint ( 150, grid, &
+          'DEBUG med_sidata_input:  clock after stopTime set,' )
+
+   !  Here we define the initial time to process, for later use by the code.
+   
+   current_date_char = start_date_char
+   start_date = start_date_char // '.0000'
+   current_date = start_date
+
+   CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
+
+   !!!!!!!  Loop over each time period to process.
+
+   CALL cpu_time ( t1 )
+   DO loop = 1 , time_loop_max
+
+      internal_time_loop = loop
+      IF ( ( grid%id .GT. 1 ) .AND. ( loop .GT. 1 ) .AND. (model_config_rec%grid_fdda(grid%id) .EQ. 0) ) EXIT
+
+      print *,' '
+      print *,'-----------------------------------------------------------------------------'
+      print *,' '
+      print '(A,I2,A,A,A,I2,A,I2)' , &
+      ' Domain ',grid%id,': Current date being processed: ',current_date, ', which is loop #',loop,' out of ',time_loop_max
+
+      !  After current_date has been set, fill in the julgmt stuff.
+
+      CALL geth_julgmt ( config_flags%julyr , config_flags%julday , config_flags%gmt )
+
+        print *,'configflags%julyr, %julday, %gmt:',config_flags%julyr, config_flags%julday, config_flags%gmt
+      !  Now that the specific Julian info is available, save these in the model config record.
+
+      CALL nl_set_gmt (grid%id, config_flags%gmt)
+      CALL nl_set_julyr (grid%id, config_flags%julyr)
+      CALL nl_set_julday (grid%id, config_flags%julday)
+
+      !  Open the input file for real.  This is either the "new" one or the "old" one.  The "new" one could have
+      !  a suffix for the type of the data format.  Check to see if either is around.
+
+      CALL cpu_time ( t3 )
+      IF ( grid%dyn_opt .EQ. dyn_em ) THEN
+         WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ', &
+                                                TRIM(config_flags%auxinput1_inname)
+         CALL wrf_debug ( 100 , wrf_err_message )
+         CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , &
+                                    current_date_char , config_flags%io_form_auxinput1 )
+         CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
+         IF ( ierr .NE. 0 ) THEN
+            CALL wrf_debug( 1 , 'error opening ' // TRIM(si_inpname) // &
+                                ' for input; bad date in namelist or file not in directory' )
+            CALL wrf_debug( 1 , 'will try again without the extension' )
+            CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
+            CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
+            IF ( ierr .NE. 0 ) THEN
+               CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // &
+                                     ' for input; bad date in namelist or file not in directory' )
+            ENDIF
+         ENDIF
+      END IF
+
+      !  Input data.
+
+      CALL wrf_debug ( 100 , 'med_sidata_input: calling input_aux_model_input1' )
+      CALL input_aux_model_input1 ( idsi ,   grid , config_flags , ierr )
+      CALL cpu_time ( t4 )
+      WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for input ',NINT(t4-t3) ,' s.'
+      CALL wrf_debug( 0, wrf_err_message )
+
+      !  Possible optional SI input.  This sets flags used by init_domain.
+
+      CALL cpu_time ( t3 )
+      IF ( loop .EQ. 1 ) THEN
+         already_been_here = .FALSE.
+         CALL       wrf_debug ( 100 , 'med_sidata_input: calling init_module_optional_si_input' )
+         CALL init_module_optional_si_input ( grid , config_flags )
+      END IF
+      CALL       wrf_debug ( 100 , 'med_sidata_input: calling optional_si_input' )
+      CALL  optional_si_input ( grid , idsi )
+
+      !  Initialize the mother domain for this time period with input data.
+
+      CALL       wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
+      grid%input_from_file = .true.
+      CALL init_domain ( grid )
+      CALL cpu_time ( t4 )
+      WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for processing ',NINT(t4-t3) ,' s.'
+      CALL wrf_debug( 0, wrf_err_message )
+      CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+      !  Close this file that is output from the SI and input to this pre-proc.
+
+      CALL       wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
+      CALL close_dataset ( idsi , config_flags , "DATASET=INPUT" )
+
+!     CALL start_domain ( grid , .TRUE. )
+
+#ifdef WRF_CHEM
+      IF ( loop == 1 ) THEN
+         IF( grid%chem_opt > 0 ) then
+           ! Read the chemistry data from a previous wrf forecast (wrfout file)
+           IF(grid%chem_in_opt == 1 ) THEN
+              message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
+              CALL  wrf_message ( message )
+
+              CALL input_ext_chem_file( grid )
+
+              IF(grid%bio_emiss_opt == BEIS311 ) THEN
+                 message = 'READING BEIS3.11 EMISSIONS DATA'
+                 CALL  wrf_message ( message )
+                 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
+              END IF
+ 
+           ELSEIF(grid%chem_in_opt == 0)then
+              ! Generate chemistry data from a idealized vertical profile
+              message = 'STARTING WITH BACKGROUND CHEMISTRY '
+              CALL  wrf_message ( message )
+
+              CALL input_chem_profile ( grid )
+
+              IF(grid%bio_emiss_opt == BEIS311 ) THEN
+                 message = 'READING BEIS3.11 EMISSIONS DATA'
+                 CALL  wrf_message ( message )
+                 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
+              END IF
+
+           ELSE
+             message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
+             CALL  wrf_message ( message )
+           ENDIF
+         ENDIF
+      ENDIF
+#endif
+
+      CALL cpu_time ( t3 )
+      CALL assemble_output ( grid , config_flags , loop , time_loop_max )
+      CALL cpu_time ( t4 )
+      WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for output ',NINT(t4-t3) ,' s.'
+      CALL wrf_debug( 0, wrf_err_message )
+      CALL cpu_time ( t2 )
+      WRITE ( wrf_err_message , FMT='(A,I4,A,I10,A)' ) 'Timing for loop # ',loop,' = ',NINT(t2-t1) ,' s.'
+      CALL wrf_debug( 0, wrf_err_message )
+
+      !  If this is not the last time, we define the next time that we are going to process.
+
+      IF ( loop .NE. time_loop_max ) THEN
+         CALL geth_newdate ( current_date_char , start_date_char , loop * model_config_rec%interval_seconds )
+         current_date =  current_date_char // '.0000'
+         CALL domain_clockprint ( 150, grid, &
+                'DEBUG med_sidata_input:  clock before current_date set,' )
+         WRITE (wrf_err_message,*) &
+           'DEBUG med_sidata_input:  before currTime set, current_date = ',TRIM(current_date)
+         CALL wrf_debug ( 150 , wrf_err_message )
+         CALL domain_clock_set( grid, current_date(1:19) )
+         CALL domain_clockprint ( 150, grid, &
+                'DEBUG med_sidata_input:  clock after current_date set,' )
+      END IF
+      CALL cpu_time ( t1 )
+   END DO
+
+END SUBROUTINE med_sidata_input
+
+SUBROUTINE compute_si_start_and_end (  &
+   start_year , start_month , start_day , start_hour , start_minute , start_second , &
+     end_year ,   end_month ,   end_day ,   end_hour ,   end_minute ,   end_second , &
+   interval_seconds , real_data_init_type , &
+   start_date_char , end_date_char , time_loop_max )
+
+   USE module_date_time
+
+   IMPLICIT NONE
+
+   INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
+   INTEGER ::   end_year ,   end_month ,   end_day ,   end_hour ,   end_minute ,   end_second
+   INTEGER :: interval_seconds , real_data_init_type
+   INTEGER :: time_loop_max , time_loop
+
+   CHARACTER(LEN=19) :: current_date_char , start_date_char , end_date_char , next_date_char
+
+   WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
+           start_year,start_month,start_day,start_hour,start_minute,start_second
+   WRITE (   end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
+             end_year,  end_month,  end_day,  end_hour,  end_minute,  end_second
+
+   IF ( end_date_char .LT. start_date_char ) THEN
+      CALL wrf_error_fatal( 'Ending date in namelist ' // end_date_char // ' prior to beginning date ' // start_date_char )
+   END IF
+
+!  start_date = start_date_char // '.0000'
+
+   !  Figure out our loop count for the processing times.
+
+   time_loop = 1
+   PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',start_date_char,'.'
+   current_date_char = start_date_char
+   loop_count : DO
+      CALL geth_newdate ( next_date_char , current_date_char , interval_seconds )
+      IF      ( next_date_char .LT. end_date_char ) THEN
+         time_loop = time_loop + 1
+         PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
+         current_date_char = next_date_char
+      ELSE IF ( next_date_char .EQ. end_date_char ) THEN
+         time_loop = time_loop + 1
+         PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
+         PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
+         time_loop_max = time_loop
+         EXIT loop_count
+      ELSE IF ( next_date_char .GT. end_date_char ) THEN
+         PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
+         time_loop_max = time_loop
+         EXIT loop_count
+      END IF
+   END DO loop_count
+END SUBROUTINE compute_si_start_and_end
+
+SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
+
+   USE module_big_step_utilities_em
+   USE module_domain
+   USE module_io_domain
+   USE module_configure
+   USE module_date_time
+   USE module_bc
+   IMPLICIT NONE
+
+   TYPE(domain)                 :: grid
+   TYPE (grid_config_rec_type)  :: config_flags
+   INTEGER , INTENT(IN)         :: loop , time_loop_max
+
+   INTEGER :: ids , ide , jds , jde , kds , kde
+   INTEGER :: ims , ime , jms , jme , kms , kme
+   INTEGER :: ips , ipe , jps , jpe , kps , kpe
+   INTEGER :: ijds , ijde , spec_bdy_width
+   INTEGER :: i , j , k , idts
+
+   INTEGER :: id1 , interval_seconds , ierr, rc, sst_update, grid_fdda
+   INTEGER , SAVE :: id, id2,  id5 
+   CHARACTER (LEN=80) :: inpname , bdyname
+   CHARACTER(LEN= 4) :: loop_char
+character *19 :: temp19
+character *24 :: temp24 , temp24b
+
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
+!!!!***MARS >>
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q2bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q3bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q4bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q5bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q6bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q7bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q8bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q9bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q10bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q11bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q12bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q13bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q14bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q15bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q16bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q17bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q18bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q19bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q20bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q21bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q22bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q23bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q24bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q25bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q26bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q27bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q28bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q29bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q30bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q31bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q32bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q33bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q34bdy3dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q35bdy3dtemp1
+!!!!***MARS <<
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp1
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
+!!!!***MARS >>
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q2bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q3bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q4bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q5bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q6bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q7bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q8bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q9bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q10bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q11bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q12bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q13bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q14bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q15bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q16bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q17bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q18bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q19bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q20bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q21bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q22bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q23bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q24bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q25bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q26bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q27bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q28bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q29bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q30bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q31bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q32bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q33bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q34bdy3dtemp2
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q35bdy3dtemp2
+!!!!***MARS <<
+   REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp2
+real::t1,t2
+
+   !  Various sizes that we need to be concerned about.
+
+   ids = grid%sd31
+   ide = grid%ed31
+   kds = grid%sd32
+   kde = grid%ed32
+   jds = grid%sd33
+   jde = grid%ed33
+
+   ims = grid%sm31
+   ime = grid%em31
+   kms = grid%sm32
+   kme = grid%em32
+   jms = grid%sm33
+   jme = grid%em33
+
+   ips = grid%sp31
+   ipe = grid%ep31
+   kps = grid%sp32
+   kpe = grid%ep32
+   jps = grid%sp33
+   jpe = grid%ep33
+
+   ijds = MIN ( ids , jds )
+   ijde = MAX ( ide , jde )
+
+   !  Boundary width, scalar value.
+
+   spec_bdy_width = model_config_rec%spec_bdy_width
+   interval_seconds = model_config_rec%interval_seconds
+   sst_update = model_config_rec%sst_update
+   grid_fdda = model_config_rec%grid_fdda(grid%id)
+
+
+   IF ( loop .EQ. 1 ) THEN
+
+      !  This is the space needed to save the current 3d data for use in computing
+      !  the lateral boundary tendencies.
+
+      IF ( ALLOCATED ( ubdy3dtemp1 ) ) DEALLOCATE ( ubdy3dtemp1 )
+      IF ( ALLOCATED ( vbdy3dtemp1 ) ) DEALLOCATE ( vbdy3dtemp1 )
+      IF ( ALLOCATED ( tbdy3dtemp1 ) ) DEALLOCATE ( tbdy3dtemp1 )
+      IF ( ALLOCATED ( pbdy3dtemp1 ) ) DEALLOCATE ( pbdy3dtemp1 )
+      IF ( ALLOCATED ( qbdy3dtemp1 ) ) DEALLOCATE ( qbdy3dtemp1 )
+!!!!***MARS >>
+      IF ( ALLOCATED ( q2bdy3dtemp1 ) ) DEALLOCATE ( q2bdy3dtemp1 )
+      IF ( ALLOCATED ( q3bdy3dtemp1 ) ) DEALLOCATE ( q3bdy3dtemp1 )
+      IF ( ALLOCATED ( q4bdy3dtemp1 ) ) DEALLOCATE ( q4bdy3dtemp1 )
+      IF ( ALLOCATED ( q5bdy3dtemp1 ) ) DEALLOCATE ( q5bdy3dtemp1 )
+      IF ( ALLOCATED ( q6bdy3dtemp1 ) ) DEALLOCATE ( q6bdy3dtemp1 )
+      IF ( ALLOCATED ( q7bdy3dtemp1 ) ) DEALLOCATE ( q7bdy3dtemp1 )
+      IF ( ALLOCATED ( q8bdy3dtemp1 ) ) DEALLOCATE ( q8bdy3dtemp1 )
+      IF ( ALLOCATED ( q9bdy3dtemp1 ) ) DEALLOCATE ( q9bdy3dtemp1 )
+      IF ( ALLOCATED ( q10bdy3dtemp1 ) ) DEALLOCATE ( q10bdy3dtemp1 )
+      IF ( ALLOCATED ( q11bdy3dtemp1 ) ) DEALLOCATE ( q11bdy3dtemp1 )
+      IF ( ALLOCATED ( q12bdy3dtemp1 ) ) DEALLOCATE ( q12bdy3dtemp1 )
+      IF ( ALLOCATED ( q13bdy3dtemp1 ) ) DEALLOCATE ( q13bdy3dtemp1 )
+      IF ( ALLOCATED ( q14bdy3dtemp1 ) ) DEALLOCATE ( q14bdy3dtemp1 )
+      IF ( ALLOCATED ( q15bdy3dtemp1 ) ) DEALLOCATE ( q15bdy3dtemp1 )
+      IF ( ALLOCATED ( q16bdy3dtemp1 ) ) DEALLOCATE ( q16bdy3dtemp1 )
+      IF ( ALLOCATED ( q17bdy3dtemp1 ) ) DEALLOCATE ( q17bdy3dtemp1 )
+      IF ( ALLOCATED ( q18bdy3dtemp1 ) ) DEALLOCATE ( q18bdy3dtemp1 )
+      IF ( ALLOCATED ( q19bdy3dtemp1 ) ) DEALLOCATE ( q19bdy3dtemp1 )
+      IF ( ALLOCATED ( q20bdy3dtemp1 ) ) DEALLOCATE ( q20bdy3dtemp1 )
+      IF ( ALLOCATED ( q21bdy3dtemp1 ) ) DEALLOCATE ( q21bdy3dtemp1 )
+      IF ( ALLOCATED ( q22bdy3dtemp1 ) ) DEALLOCATE ( q22bdy3dtemp1 )
+      IF ( ALLOCATED ( q23bdy3dtemp1 ) ) DEALLOCATE ( q23bdy3dtemp1 )
+      IF ( ALLOCATED ( q24bdy3dtemp1 ) ) DEALLOCATE ( q24bdy3dtemp1 )
+      IF ( ALLOCATED ( q25bdy3dtemp1 ) ) DEALLOCATE ( q25bdy3dtemp1 )
+      IF ( ALLOCATED ( q26bdy3dtemp1 ) ) DEALLOCATE ( q26bdy3dtemp1 )
+      IF ( ALLOCATED ( q27bdy3dtemp1 ) ) DEALLOCATE ( q27bdy3dtemp1 )
+      IF ( ALLOCATED ( q28bdy3dtemp1 ) ) DEALLOCATE ( q28bdy3dtemp1 )
+      IF ( ALLOCATED ( q29bdy3dtemp1 ) ) DEALLOCATE ( q29bdy3dtemp1 )
+      IF ( ALLOCATED ( q30bdy3dtemp1 ) ) DEALLOCATE ( q30bdy3dtemp1 )
+      IF ( ALLOCATED ( q31bdy3dtemp1 ) ) DEALLOCATE ( q31bdy3dtemp1 )
+      IF ( ALLOCATED ( q32bdy3dtemp1 ) ) DEALLOCATE ( q32bdy3dtemp1 )
+      IF ( ALLOCATED ( q33bdy3dtemp1 ) ) DEALLOCATE ( q33bdy3dtemp1 )
+      IF ( ALLOCATED ( q34bdy3dtemp1 ) ) DEALLOCATE ( q34bdy3dtemp1 )
+      IF ( ALLOCATED ( q35bdy3dtemp1 ) ) DEALLOCATE ( q35bdy3dtemp1 )
+!!!!***MARS <<
+      IF ( ALLOCATED ( mbdy2dtemp1 ) ) DEALLOCATE ( mbdy2dtemp1 )
+      IF ( ALLOCATED ( ubdy3dtemp2 ) ) DEALLOCATE ( ubdy3dtemp2 )
+      IF ( ALLOCATED ( vbdy3dtemp2 ) ) DEALLOCATE ( vbdy3dtemp2 )
+      IF ( ALLOCATED ( tbdy3dtemp2 ) ) DEALLOCATE ( tbdy3dtemp2 )
+      IF ( ALLOCATED ( pbdy3dtemp2 ) ) DEALLOCATE ( pbdy3dtemp2 )
+      IF ( ALLOCATED ( qbdy3dtemp2 ) ) DEALLOCATE ( qbdy3dtemp2 )
+!!!!***MARS >>
+      IF ( ALLOCATED ( q2bdy3dtemp2 ) ) DEALLOCATE ( q2bdy3dtemp2 )
+      IF ( ALLOCATED ( q3bdy3dtemp2 ) ) DEALLOCATE ( q3bdy3dtemp2 )
+      IF ( ALLOCATED ( q4bdy3dtemp2 ) ) DEALLOCATE ( q4bdy3dtemp2 )
+      IF ( ALLOCATED ( q5bdy3dtemp2 ) ) DEALLOCATE ( q5bdy3dtemp2 )
+      IF ( ALLOCATED ( q6bdy3dtemp2 ) ) DEALLOCATE ( q6bdy3dtemp2 )
+      IF ( ALLOCATED ( q7bdy3dtemp2 ) ) DEALLOCATE ( q7bdy3dtemp2 )
+      IF ( ALLOCATED ( q8bdy3dtemp2 ) ) DEALLOCATE ( q8bdy3dtemp2 )
+      IF ( ALLOCATED ( q9bdy3dtemp2 ) ) DEALLOCATE ( q9bdy3dtemp2 )
+      IF ( ALLOCATED ( q10bdy3dtemp2 ) ) DEALLOCATE ( q10bdy3dtemp2 )
+      IF ( ALLOCATED ( q11bdy3dtemp2 ) ) DEALLOCATE ( q11bdy3dtemp2 )
+      IF ( ALLOCATED ( q12bdy3dtemp2 ) ) DEALLOCATE ( q12bdy3dtemp2 )
+      IF ( ALLOCATED ( q13bdy3dtemp2 ) ) DEALLOCATE ( q13bdy3dtemp2 )
+      IF ( ALLOCATED ( q14bdy3dtemp2 ) ) DEALLOCATE ( q14bdy3dtemp2 )
+      IF ( ALLOCATED ( q15bdy3dtemp2 ) ) DEALLOCATE ( q15bdy3dtemp2 )
+      IF ( ALLOCATED ( q16bdy3dtemp2 ) ) DEALLOCATE ( q16bdy3dtemp2 )
+      IF ( ALLOCATED ( q17bdy3dtemp2 ) ) DEALLOCATE ( q17bdy3dtemp2 )
+      IF ( ALLOCATED ( q18bdy3dtemp2 ) ) DEALLOCATE ( q18bdy3dtemp2 )
+      IF ( ALLOCATED ( q19bdy3dtemp2 ) ) DEALLOCATE ( q19bdy3dtemp2 )
+      IF ( ALLOCATED ( q20bdy3dtemp2 ) ) DEALLOCATE ( q20bdy3dtemp2 )
+      IF ( ALLOCATED ( q21bdy3dtemp2 ) ) DEALLOCATE ( q21bdy3dtemp2 )
+      IF ( ALLOCATED ( q22bdy3dtemp2 ) ) DEALLOCATE ( q22bdy3dtemp2 )
+      IF ( ALLOCATED ( q23bdy3dtemp2 ) ) DEALLOCATE ( q23bdy3dtemp2 )
+      IF ( ALLOCATED ( q24bdy3dtemp2 ) ) DEALLOCATE ( q24bdy3dtemp2 )
+      IF ( ALLOCATED ( q25bdy3dtemp2 ) ) DEALLOCATE ( q25bdy3dtemp2 )
+      IF ( ALLOCATED ( q26bdy3dtemp2 ) ) DEALLOCATE ( q26bdy3dtemp2 )
+      IF ( ALLOCATED ( q27bdy3dtemp2 ) ) DEALLOCATE ( q27bdy3dtemp2 )
+      IF ( ALLOCATED ( q28bdy3dtemp2 ) ) DEALLOCATE ( q28bdy3dtemp2 )
+      IF ( ALLOCATED ( q29bdy3dtemp2 ) ) DEALLOCATE ( q29bdy3dtemp2 )
+      IF ( ALLOCATED ( q30bdy3dtemp2 ) ) DEALLOCATE ( q30bdy3dtemp2 )
+      IF ( ALLOCATED ( q31bdy3dtemp2 ) ) DEALLOCATE ( q31bdy3dtemp2 )
+      IF ( ALLOCATED ( q32bdy3dtemp2 ) ) DEALLOCATE ( q32bdy3dtemp2 )
+      IF ( ALLOCATED ( q33bdy3dtemp2 ) ) DEALLOCATE ( q33bdy3dtemp2 )
+      IF ( ALLOCATED ( q34bdy3dtemp2 ) ) DEALLOCATE ( q34bdy3dtemp2 )
+      IF ( ALLOCATED ( q35bdy3dtemp2 ) ) DEALLOCATE ( q35bdy3dtemp2 )
+!!!!***MARS <<
+      IF ( ALLOCATED ( mbdy2dtemp2 ) ) DEALLOCATE ( mbdy2dtemp2 )
+
+      ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( pbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+!!!!***MARS >>
+      ALLOCATE ( q2bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q3bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q4bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q5bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q6bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q7bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q8bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q9bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q10bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q11bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q12bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q13bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q14bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q15bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q16bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q17bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q18bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q19bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q20bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q21bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q22bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q23bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q24bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q25bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q26bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q27bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q28bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q29bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q30bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q31bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q32bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q33bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q34bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q35bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+!!!!***MARS <<
+      ALLOCATE ( mbdy2dtemp1(ims:ime,1:1,    jms:jme) )
+      ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( pbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+!!!!***MARS >>
+      ALLOCATE ( q2bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q3bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q4bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q5bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q6bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q7bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q8bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q9bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q10bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q11bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q12bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q13bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q14bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q15bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q16bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q17bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q18bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q19bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q20bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q21bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q22bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q23bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q24bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q25bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q26bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q27bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q28bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q29bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q30bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q31bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q32bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q33bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q34bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q35bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+!!!!***MARS <<
+      ALLOCATE ( mbdy2dtemp2(ims:ime,1:1,    jms:jme) )
+
+      !  Open the wrfinput file.  From this program, this is an *output* file.
+
+      CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
+      CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
+      IF ( ierr .NE. 0 ) THEN
+         CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
+      ENDIF
+      IF(sst_update .EQ. 1)THEN
+        CALL construct_filename1( inpname , 'wrflowinp' , grid%id , 2 )
+        CALL open_w_dataset ( id5, TRIM(inpname) , grid , config_flags , output_aux_model_input5 , "DATASET=AUXINPUT5", ierr )
+        IF ( ierr .NE. 0 ) THEN
+           CALL wrf_error_fatal( 'real: error opening wrflowinp for writing' )
+        ENDIF
+      ENDIF
+!     CALL calc_current_date ( grid%id , 0. )
+      CALL output_model_input ( id1, grid , config_flags , ierr )
+      CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
+      IF(sst_update .EQ. 1)THEN
+        CALL output_aux_model_input5 ( id5, grid , config_flags , ierr )
+      ENDIF
+
+      !  We need to save the 3d data to compute a difference during the next loop.  Couple the
+      !  3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
+
+      CALL couple ( grid%em_mu_2 , grid%em_mub , ubdy3dtemp1 , grid%em_u_2                 , 'u' , grid%msfu , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , vbdy3dtemp1 , grid%em_v_2                 , 'v' , grid%msfv , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , tbdy3dtemp1 , grid%em_t_2                 , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , pbdy3dtemp1 , grid%em_ph_2                , 'h' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+!      CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp1 , grid%moist(:,:,:,P_QV) , 't' , grid%msft , &
+!                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!MARS: si config_flags%mars != 0 il y a au moins un autre traceur (indice 2 a cause du dummy tracer)
+!!!!!MARS: -- il faut donc definir ses conditions aux bornes
+!!!!!MARS: -- cas generique ici, les choix de flux ou non-flux sont dans solve_em
+!!!!!MARS: ensuite faire au cas par cas (ou un jour une boucle sur le nombre de traceurs ???) !!!q2bdy3dtemp1
+!!!!!MARS: NB NB: si on ne veut pas passer un traceur aux bornes, tout ce qui suit n'est pas utile 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+IF (config_flags%mars .gt. 0) THEN
+!! ceci suffit avec les modes 2 et 10 qui ne transportent qu'un seul traceur
+      CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp1 , grid%scalar(:,:,:,2) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+!!!!!MARS: autres possibilites. pour le moment seuls 4 traceurs aux bornes sont supportes.
+!!!!!MARS: ... mais il est facile d'en ajouter... ajouter simplement des tableaux type q2bdy3dtemp1 
+IF ( (config_flags%mars .eq. 1) .OR. &
+     (config_flags%mars .eq. 3) .OR. &
+     (config_flags%mars .eq. 11) .OR. &
+     (config_flags%mars .eq. 12) ) THEN
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q2bdy3dtemp1 , grid%scalar(:,:,:,3) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+IF ((config_flags%mars .eq. 11) .OR. (config_flags%mars .eq. 12)) THEN
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q3bdy3dtemp1 , grid%scalar(:,:,:,4) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q4bdy3dtemp1 , grid%scalar(:,:,:,5) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+IF ((config_flags%mars .eq. 12)) THEN
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q5bdy3dtemp1 , grid%scalar(:,:,:,6) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q6bdy3dtemp1 , grid%scalar(:,:,:,7) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+
+!VENUS
+IF (config_flags%mars .eq. 34) THEN
+      CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp1 ,grid%scalar(:,:,:,2) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q2bdy3dtemp1,grid%scalar(:,:,:,3) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q3bdy3dtemp1,grid%scalar(:,:,:,4) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q4bdy3dtemp1,grid%scalar(:,:,:,5) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q5bdy3dtemp1,grid%scalar(:,:,:,6) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q6bdy3dtemp1,grid%scalar(:,:,:,7) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q7bdy3dtemp1,grid%scalar(:,:,:,8) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q8bdy3dtemp1,grid%scalar(:,:,:,9) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q9bdy3dtemp1,grid%scalar(:,:,:,10) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q10bdy3dtemp1,grid%scalar(:,:,:,11) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q11bdy3dtemp1,grid%scalar(:,:,:,12) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q12bdy3dtemp1,grid%scalar(:,:,:,13) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q13bdy3dtemp1,grid%scalar(:,:,:,14) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q14bdy3dtemp1,grid%scalar(:,:,:,15) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q15bdy3dtemp1,grid%scalar(:,:,:,16) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q16bdy3dtemp1,grid%scalar(:,:,:,17) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q17bdy3dtemp1,grid%scalar(:,:,:,18) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q18bdy3dtemp1,grid%scalar(:,:,:,19) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q19bdy3dtemp1,grid%scalar(:,:,:,20) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q20bdy3dtemp1,grid%scalar(:,:,:,21) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q21bdy3dtemp1,grid%scalar(:,:,:,22) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q22bdy3dtemp1,grid%scalar(:,:,:,23) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q23bdy3dtemp1,grid%scalar(:,:,:,24) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q24bdy3dtemp1,grid%scalar(:,:,:,25) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q25bdy3dtemp1,grid%scalar(:,:,:,26) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q26bdy3dtemp1,grid%scalar(:,:,:,27) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q27bdy3dtemp1,grid%scalar(:,:,:,28) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q28bdy3dtemp1,grid%scalar(:,:,:,29) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q29bdy3dtemp1,grid%scalar(:,:,:,30) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q30bdy3dtemp1,grid%scalar(:,:,:,31) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q31bdy3dtemp1,grid%scalar(:,:,:,32) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q32bdy3dtemp1,grid%scalar(:,:,:,33) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q33bdy3dtemp1,grid%scalar(:,:,:,34) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q34bdy3dtemp1,grid%scalar(:,:,:,35) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+!!!!!MARS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+
+      DO j = jps , MIN(jde-1,jpe)
+         DO i = ips , MIN(ide-1,ipe)
+            mbdy2dtemp1(i,1,j) = grid%em_mu_2(i,j)
+         END DO
+      END DO
+
+      IF(grid_fdda .EQ. 1)THEN
+! for fdda
+         DO j = jps , jpe
+            DO k = kps , kpe
+               DO i = ips , ipe
+                  grid%fdda3d(i,k,j,p_u_ndg_old) = grid%em_u_2(i,k,j)
+                  grid%fdda3d(i,k,j,p_v_ndg_old) = grid%em_v_2(i,k,j)
+                  grid%fdda3d(i,k,j,p_t_ndg_old) = grid%em_t_2(i,k,j)
+                  grid%fdda3d(i,k,j,p_q_ndg_old) = grid%moist(i,k,j,P_QV)
+                  grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%em_ph_2(i,k,j)
+               END DO
+            END DO
+         END DO
+
+         DO j = jps , jpe
+            DO i = ips , ipe
+               grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%em_mu_2(i,j)
+            END DO
+         END DO
+      ENDIF
+
+
+      !  There are 2 components to the lateral boundaries.  First, there is the starting
+      !  point of this time period - just the outer few rows and columns.
+
+      CALL stuff_bdy     ( ubdy3dtemp1 , grid%em_u_b     , 'U' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdy     ( vbdy3dtemp1 , grid%em_v_b     , 'V' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdy     ( tbdy3dtemp1 , grid%em_t_b     , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdy     ( pbdy3dtemp1 , grid%em_ph_b    , 'W' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+!      CALL stuff_bdy     ( qbdy3dtemp1 , grid%moist_b(:,:,:,:,P_QV)   , 'T' , ijds , ijde , spec_bdy_width      , &
+!                                                                 ids , ide , jds , jde , kds , kde , &
+!                                                                 ims , ime , jms , jme , kms , kme , &
+!                                                                 ips , ipe , jps , jpe , kps , kpe )
+!!!!!MARS >>
+IF (config_flags%mars .gt. 0) THEN
+      CALL stuff_bdy     ( qbdy3dtemp1 , grid%scalar_b(:,:,:,:,2)   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+IF ( (config_flags%mars .eq. 1) .OR. &
+     (config_flags%mars .eq. 3) .OR. &
+     (config_flags%mars .eq. 11) .OR. &
+     (config_flags%mars .eq. 12) ) THEN
+      CALL stuff_bdy     ( q2bdy3dtemp1 , grid%scalar_b(:,:,:,:,3)   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+IF ((config_flags%mars .eq. 11) .OR. (config_flags%mars .eq. 12)) THEN
+      CALL stuff_bdy     ( q3bdy3dtemp1 , grid%scalar_b(:,:,:,:,4)   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdy     ( q4bdy3dtemp1 , grid%scalar_b(:,:,:,:,5)   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+IF ((config_flags%mars .eq. 12)) THEN
+      CALL stuff_bdy     ( q5bdy3dtemp1 , grid%scalar_b(:,:,:,:,6)   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdy     ( q6bdy3dtemp1 , grid%scalar_b(:,:,:,:,7)   , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , kds , kde , &
+                                                                 ims , ime , jms , jme , kms , kme , &
+                                                                 ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+
+!VENUS
+IF (config_flags%mars .eq. 34) THEN
+      CALL stuff_bdy     ( qbdy3dtemp1 , grid%scalar_b(:,:,:,:,2)   , 'T' , ijds, ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q2bdy3dtemp1 , grid%scalar_b(:,:,:,:,3)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q3bdy3dtemp1 , grid%scalar_b(:,:,:,:,4)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q4bdy3dtemp1 , grid%scalar_b(:,:,:,:,5)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q5bdy3dtemp1 , grid%scalar_b(:,:,:,:,6)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q6bdy3dtemp1 , grid%scalar_b(:,:,:,:,7)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q7bdy3dtemp1 , grid%scalar_b(:,:,:,:,8)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q8bdy3dtemp1 , grid%scalar_b(:,:,:,:,9)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q9bdy3dtemp1 , grid%scalar_b(:,:,:,:,10)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q10bdy3dtemp1 , grid%scalar_b(:,:,:,:,11)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q11bdy3dtemp1 , grid%scalar_b(:,:,:,:,12)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q12bdy3dtemp1 , grid%scalar_b(:,:,:,:,13)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q13bdy3dtemp1 , grid%scalar_b(:,:,:,:,14)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q14bdy3dtemp1 , grid%scalar_b(:,:,:,:,15)   , 'T' ,ijds , ijde , spec_bdy_width      , &                                                                 
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q15bdy3dtemp1 , grid%scalar_b(:,:,:,:,16)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q16bdy3dtemp1 , grid%scalar_b(:,:,:,:,17)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q17bdy3dtemp1 , grid%scalar_b(:,:,:,:,18)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q18bdy3dtemp1 , grid%scalar_b(:,:,:,:,19)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q19bdy3dtemp1 , grid%scalar_b(:,:,:,:,20)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q20bdy3dtemp1 , grid%scalar_b(:,:,:,:,21)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q21bdy3dtemp1 , grid%scalar_b(:,:,:,:,22)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q22bdy3dtemp1 , grid%scalar_b(:,:,:,:,23)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q23bdy3dtemp1 , grid%scalar_b(:,:,:,:,24)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q24bdy3dtemp1 , grid%scalar_b(:,:,:,:,25)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q25bdy3dtemp1 , grid%scalar_b(:,:,:,:,26)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q26bdy3dtemp1 , grid%scalar_b(:,:,:,:,27)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q27bdy3dtemp1 , grid%scalar_b(:,:,:,:,28)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q28bdy3dtemp1 , grid%scalar_b(:,:,:,:,29)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q29bdy3dtemp1 , grid%scalar_b(:,:,:,:,30)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q30bdy3dtemp1 , grid%scalar_b(:,:,:,:,31)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q31bdy3dtemp1 , grid%scalar_b(:,:,:,:,33)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q32bdy3dtemp1 , grid%scalar_b(:,:,:,:,33)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q33bdy3dtemp1 , grid%scalar_b(:,:,:,:,34)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q34bdy3dtemp1 , grid%scalar_b(:,:,:,:,35)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+ENDIF
+!!!!MARS <<
+
+      CALL stuff_bdy     ( mbdy2dtemp1 , grid%em_mu_b    , 'M' , ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds , jde , 1 , 1 , &
+                                                                 ims , ime , jms , jme , 1 , 1 , &
+                                                                 ips , ipe , jps , jpe , 1 , 1 )
+
+
+   ELSE IF ( loop .GT. 1 ) THEN
+
+      IF(sst_update .EQ. 1)THEN
+        CALL output_aux_model_input5 ( id5, grid , config_flags , ierr )
+      ENDIF
+
+      !  Open the boundary file.
+
+
+      IF ( loop .eq. 2 ) THEN
+       IF(grid%id .eq. 1)THEN
+         CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
+         CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
+         IF ( ierr .NE. 0 ) THEN
+               CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
+         ENDIF
+       ENDIF
+       IF(grid_fdda .EQ. 1)THEN
+! for fdda
+         CALL construct_filename1( inpname , 'wrffdda' , grid%id , 2 )
+         CALL open_w_dataset ( id2, TRIM(inpname) , grid , config_flags , output_aux_model_input10 , "DATASET=AUXINPUT10", ierr )
+         IF ( ierr .NE. 0 ) THEN
+               CALL wrf_error_fatal( 'real: error opening wrffdda for writing' )
+         ENDIF
+       ENDIF
+      ELSE
+         IF ( .NOT. domain_clockisstoptime(grid) ) THEN
+            CALL domain_clockadvance( grid )
+            CALL domain_clockprint ( 150, grid, &
+                   'DEBUG assemble_output:  clock after ClockAdvance,' )
+         ENDIF
+      END IF
+
+
+      !  Couple this time period's data with total mu, and save it in the *bdy3dtemp2 arrays.
+
+      CALL couple ( grid%em_mu_2 , grid%em_mub , ubdy3dtemp2 , grid%em_u_2                 , 'u' , grid%msfu , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , vbdy3dtemp2 , grid%em_v_2                 , 'v' , grid%msfv , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , tbdy3dtemp2 , grid%em_t_2                 , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , pbdy3dtemp2 , grid%em_ph_2                , 'h' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+!      CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp2 , grid%moist(:,:,:,P_QV) , 't' , grid%msft , &
+!                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+!!!!!MARS >>
+IF (config_flags%mars .gt. 0) THEN
+      CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp2 , grid%scalar(:,:,:,2) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+IF ( (config_flags%mars .eq. 1) .OR. &
+     (config_flags%mars .eq. 3) .OR. &
+     (config_flags%mars .eq. 11) .OR. &
+     (config_flags%mars .eq. 12) ) THEN
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q2bdy3dtemp2 , grid%scalar(:,:,:,3) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+IF ((config_flags%mars .eq. 11) .OR. (config_flags%mars .eq. 12)) THEN
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q3bdy3dtemp2 , grid%scalar(:,:,:,4) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q4bdy3dtemp2 , grid%scalar(:,:,:,5) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+IF ((config_flags%mars .eq. 12)) THEN
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q5bdy3dtemp2 , grid%scalar(:,:,:,6) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q6bdy3dtemp2 , grid%scalar(:,:,:,7) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+
+!VENUS
+IF (config_flags%mars .eq. 34) THEN
+      CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp2 ,grid%scalar(:,:,:,2) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q2bdy3dtemp2,grid%scalar(:,:,:,3) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q3bdy3dtemp2,grid%scalar(:,:,:,4) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q4bdy3dtemp2,grid%scalar(:,:,:,5) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q5bdy3dtemp2,grid%scalar(:,:,:,6) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q6bdy3dtemp2,grid%scalar(:,:,:,7) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q7bdy3dtemp2,grid%scalar(:,:,:,8) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q8bdy3dtemp2,grid%scalar(:,:,:,9) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q9bdy3dtemp2,grid%scalar(:,:,:,10) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q10bdy3dtemp2,grid%scalar(:,:,:,11) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q11bdy3dtemp2,grid%scalar(:,:,:,12) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q12bdy3dtemp2,grid%scalar(:,:,:,13) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q13bdy3dtemp2,grid%scalar(:,:,:,14) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q14bdy3dtemp2,grid%scalar(:,:,:,15) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q15bdy3dtemp2,grid%scalar(:,:,:,16) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q16bdy3dtemp2,grid%scalar(:,:,:,17) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q17bdy3dtemp2,grid%scalar(:,:,:,18) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q18bdy3dtemp2,grid%scalar(:,:,:,19) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q19bdy3dtemp2,grid%scalar(:,:,:,20) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q20bdy3dtemp2,grid%scalar(:,:,:,21) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q21bdy3dtemp2,grid%scalar(:,:,:,22) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q22bdy3dtemp2,grid%scalar(:,:,:,23) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q23bdy3dtemp2,grid%scalar(:,:,:,24) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q24bdy3dtemp2,grid%scalar(:,:,:,25) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q25bdy3dtemp2,grid%scalar(:,:,:,26) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q26bdy3dtemp2,grid%scalar(:,:,:,27) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q27bdy3dtemp2,grid%scalar(:,:,:,28) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q28bdy3dtemp2,grid%scalar(:,:,:,29) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q29bdy3dtemp2,grid%scalar(:,:,:,30) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q30bdy3dtemp2,grid%scalar(:,:,:,31) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q31bdy3dtemp2,grid%scalar(:,:,:,32) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q32bdy3dtemp2,grid%scalar(:,:,:,33) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q33bdy3dtemp2,grid%scalar(:,:,:,34) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+      CALL couple ( grid%em_mu_2 , grid%em_mub , q34bdy3dtemp2,grid%scalar(:,:,:,35) , 't' , grid%msft , &
+                    ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,kme,ips, ipe, jps, jpe, kps, kpe )
+ENDIF
+!!!!!MARS <<
+
+      DO j = jps , jpe
+         DO i = ips , ipe
+            mbdy2dtemp2(i,1,j) = grid%em_mu_2(i,j)
+         END DO
+      END DO
+
+      IF(grid_fdda .EQ. 1)THEN
+! for fdda
+         DO j = jps , jpe
+            DO k = kps , kpe
+               DO i = ips , ipe
+                  grid%fdda3d(i,k,j,p_u_ndg_new) = grid%em_u_2(i,k,j)
+                  grid%fdda3d(i,k,j,p_v_ndg_new) = grid%em_v_2(i,k,j)
+                  grid%fdda3d(i,k,j,p_t_ndg_new) = grid%em_t_2(i,k,j)
+                  grid%fdda3d(i,k,j,p_q_ndg_new) = grid%moist(i,k,j,P_QV)
+                  grid%fdda3d(i,k,j,p_ph_ndg_new) = grid%em_ph_2(i,k,j)
+               END DO
+            END DO
+         END DO
+
+         DO j = jps , jpe
+            DO i = ips , ipe
+               grid%fdda2d(i,1,j,p_mu_ndg_new) = grid%em_mu_2(i,j)
+            END DO
+         END DO
+      ENDIF
+
+      !  During all of the loops after the first loop, we first compute the boundary
+      !  tendencies with the current data values (*bdy3dtemp2 arrays) and the previously 
+      !  saved information stored in the *bdy3dtemp1 arrays.
+
+      CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds) , grid%em_u_bt  , 'U' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds) , grid%em_v_bt  , 'V' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds) , grid%em_t_bt  , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , REAL(interval_seconds) , grid%em_ph_bt  , 'W' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+!      CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds) , grid%moist_bt(:,:,:,:,P_QV) , 'T' , &
+!                                                            ijds , ijde , spec_bdy_width      , &
+!                                                            ids , ide , jds , jde , kds , kde , &
+!                                                            ims , ime , jms , jme , kms , kme , &
+!                                                            ips , ipe , jps , jpe , kps , kpe )
+!!!!!MARS >>
+IF (config_flags%mars .gt. 0) THEN
+      CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,2) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+IF ( (config_flags%mars .eq. 1) .OR. &
+     (config_flags%mars .eq. 3) .OR. &
+     (config_flags%mars .eq. 11) .OR. &
+     (config_flags%mars .eq. 12) ) THEN
+      CALL stuff_bdytend ( q2bdy3dtemp2 , q2bdy3dtemp1 , REAL(interval_seconds) ,grid%scalar_bt(:,:,:,:,3) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+IF ((config_flags%mars .eq. 11) .OR. (config_flags%mars .eq. 12)) THEN
+      CALL stuff_bdytend ( q3bdy3dtemp2 , q3bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,4) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q4bdy3dtemp2 , q4bdy3dtemp1 , REAL(interval_seconds) ,grid%scalar_bt(:,:,:,:,5) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+IF ((config_flags%mars .eq. 12)) THEN
+      CALL stuff_bdytend ( q5bdy3dtemp2 , q5bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,6) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q6bdy3dtemp2 , q6bdy3dtemp1 , REAL(interval_seconds) ,grid%scalar_bt(:,:,:,:,7) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+
+!VENUS
+IF (config_flags%mars .eq. 34) THEN
+      CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,2) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q2bdy3dtemp2 , q2bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,3) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q3bdy3dtemp2 , q3bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,4) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q4bdy3dtemp2 , q4bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,5) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q5bdy3dtemp2 , q5bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,6) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q6bdy3dtemp2 , q6bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,7) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q7bdy3dtemp2 , q7bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,8) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q8bdy3dtemp2 , q8bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,9) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q9bdy3dtemp2 , q9bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,10) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q10bdy3dtemp2 , q10bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,11) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q11bdy3dtemp2 , q11bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,12) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q12bdy3dtemp2 , q12bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,13) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q13bdy3dtemp2 , q13bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,14) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q14bdy3dtemp2 , q14bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,15) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q15bdy3dtemp2 , q15bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,16) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q16bdy3dtemp2 , q16bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,17) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q17bdy3dtemp2 , q17bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,18) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q18bdy3dtemp2 , q18bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,19) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q19bdy3dtemp2 , q19bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,20) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q20bdy3dtemp2 , q20bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,21) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q21bdy3dtemp2 , q21bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,22) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q22bdy3dtemp2 , q22bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,23) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q23bdy3dtemp2 , q23bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,24) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q24bdy3dtemp2 , q24bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,25) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q25bdy3dtemp2 , q25bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,26) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q26bdy3dtemp2 , q26bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,27) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q27bdy3dtemp2 , q27bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,28) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q28bdy3dtemp2 , q28bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,29) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q29bdy3dtemp2 , q29bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,30) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q30bdy3dtemp2 , q30bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,31) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q31bdy3dtemp2 , q31bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,32) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q32bdy3dtemp2 , q32bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,33) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q33bdy3dtemp2 , q33bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,34) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+      CALL stuff_bdytend ( q34bdy3dtemp2 , q34bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,35) , 'T' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , kds , kde , &
+                                                            ims , ime , jms , jme , kms , kme , &
+                                                            ips , ipe , jps , jpe , kps , kpe )
+
+ENDIF
+!!!!!MARS <<
+
+      CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , REAL(interval_seconds) , grid%em_mu_bt  , 'M' , &
+                                                            ijds , ijde , spec_bdy_width      , &
+                                                            ids , ide , jds , jde , 1 , 1 , &
+                                                            ims , ime , jms , jme , 1 , 1 , &
+                                                            ips , ipe , jps , jpe , 1 , 1 )
+
+      !  Both pieces of the boundary data are now available to be written (initial time and tendency).
+      !  This looks ugly, these date shifting things.  What's it for?  We want the "Times" variable
+      !  in the lateral BDY file to have the valid times of when the initial fields are written.
+      !  That's what the loop-2 thingy is for with the start date.  We increment the start_date so
+      !  that the starting time in the attributes is the second time period.  Why you may ask.  I
+      !  agree, why indeed.
+
+      CALL domain_clockprint ( 150, grid, &
+             'DEBUG assemble_output:  clock before 1st current_date set,' )
+      WRITE (wrf_err_message,*) &
+        'DEBUG assemble_output:  before 1st currTime set, current_date = ',TRIM(current_date)
+      CALL wrf_debug ( 150 , wrf_err_message )
+      CALL domain_clock_set( grid, current_date(1:19) )
+      CALL domain_clockprint ( 150, grid, &
+             'DEBUG assemble_output:  clock after 1st current_date set,' )
+
+      temp24= current_date
+      temp24b=start_date
+      start_date = current_date
+      CALL geth_newdate ( temp19 , temp24b(1:19) , (loop-2) * model_config_rec%interval_seconds )
+      current_date = temp19 //  '.0000'
+      CALL domain_clockprint ( 150, grid, &
+             'DEBUG assemble_output:  clock before 2nd current_date set,' )
+      WRITE (wrf_err_message,*) &
+        'DEBUG assemble_output:  before 2nd currTime set, current_date = ',TRIM(current_date)
+      CALL wrf_debug ( 150 , wrf_err_message )
+      CALL domain_clock_set( grid, current_date(1:19) )
+      CALL domain_clockprint ( 150, grid, &
+             'DEBUG assemble_output:  clock after 2nd current_date set,' )
+      IF(grid%id .EQ. 1)THEN
+        print *,'LBC valid between these times ',current_date, ' ',start_date
+        CALL output_boundary ( id, grid , config_flags , ierr )
+      ENDIF
+! for fdda
+      IF(grid_fdda .EQ. 1) THEN
+         CALL output_aux_model_input10 ( id2, grid , config_flags , ierr )
+      END IF
+      current_date = temp24
+      start_date = temp24b
+      CALL domain_clockprint ( 150, grid, &
+             'DEBUG assemble_output:  clock before 3rd current_date set,' )
+      WRITE (wrf_err_message,*) &
+        'DEBUG assemble_output:  before 3rd currTime set, current_date = ',TRIM(current_date)
+      CALL wrf_debug ( 150 , wrf_err_message )
+      CALL domain_clock_set( grid, current_date(1:19) )
+      CALL domain_clockprint ( 150, grid, &
+             'DEBUG assemble_output:  clock after 3rd current_date set,' )
+
+      !  OK, for all of the loops, we output the initialzation data, which would allow us to
+      !  start the model at any of the available analysis time periods.
+
+!     WRITE ( loop_char , FMT = '(I4.4)' ) loop
+!     CALL open_w_dataset ( id1, 'wrfinput'//loop_char , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
+!     IF ( ierr .NE. 0 ) THEN
+!       CALL wrf_error_fatal( 'real: error opening wrfinput'//loop_char//' for writing' )
+!     ENDIF
+
+!     CALL calc_current_date ( grid%id , 0. )
+!     CALL output_model_input ( id1, grid , config_flags , ierr )
+!     CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
+      !  Is this or is this not the last time time?  We can remove some unnecessary
+      !  stores if it is not.
+      IF     ( loop .LT. time_loop_max ) THEN
+
+         !  We need to save the 3d data to compute a difference during the next loop.  Couple the
+         !  3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
+         !  We load up the boundary data again for use in the next loop.
+
+         DO j = jps , jpe
+            DO k = kps , kpe
+               DO i = ips , ipe
+                  ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
+                  vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
+                  tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
+                  pbdy3dtemp1(i,k,j) = pbdy3dtemp2(i,k,j)
+                  qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
+!!!!MARS >>
+                  q2bdy3dtemp1(i,k,j) = q2bdy3dtemp2(i,k,j)
+                  q3bdy3dtemp1(i,k,j) = q3bdy3dtemp2(i,k,j)
+                  q4bdy3dtemp1(i,k,j) = q4bdy3dtemp2(i,k,j)
+                  q5bdy3dtemp1(i,k,j) = q5bdy3dtemp2(i,k,j)
+                  q6bdy3dtemp1(i,k,j) = q6bdy3dtemp2(i,k,j)
+                  q7bdy3dtemp1(i,k,j) = q7bdy3dtemp2(i,k,j)
+                  q8bdy3dtemp1(i,k,j) = q8bdy3dtemp2(i,k,j)
+                  q9bdy3dtemp1(i,k,j) = q9bdy3dtemp2(i,k,j)
+                  q10bdy3dtemp1(i,k,j) = q10bdy3dtemp2(i,k,j)
+                  q11bdy3dtemp1(i,k,j) = q11bdy3dtemp2(i,k,j)
+                  q12bdy3dtemp1(i,k,j) = q12bdy3dtemp2(i,k,j)
+                  q13bdy3dtemp1(i,k,j) = q13bdy3dtemp2(i,k,j)
+                  q14bdy3dtemp1(i,k,j) = q14bdy3dtemp2(i,k,j)
+                  q15bdy3dtemp1(i,k,j) = q15bdy3dtemp2(i,k,j)
+                  q16bdy3dtemp1(i,k,j) = q16bdy3dtemp2(i,k,j)
+                  q17bdy3dtemp1(i,k,j) = q17bdy3dtemp2(i,k,j)
+                  q18bdy3dtemp1(i,k,j) = q18bdy3dtemp2(i,k,j)
+                  q19bdy3dtemp1(i,k,j) = q19bdy3dtemp2(i,k,j)
+                  q20bdy3dtemp1(i,k,j) = q20bdy3dtemp2(i,k,j)
+                  q21bdy3dtemp1(i,k,j) = q21bdy3dtemp2(i,k,j)
+                  q22bdy3dtemp1(i,k,j) = q22bdy3dtemp2(i,k,j)
+                  q23bdy3dtemp1(i,k,j) = q23bdy3dtemp2(i,k,j)
+                  q24bdy3dtemp1(i,k,j) = q24bdy3dtemp2(i,k,j)
+                  q25bdy3dtemp1(i,k,j) = q25bdy3dtemp2(i,k,j)
+                  q26bdy3dtemp1(i,k,j) = q26bdy3dtemp2(i,k,j)
+                  q27bdy3dtemp1(i,k,j) = q27bdy3dtemp2(i,k,j)
+                  q28bdy3dtemp1(i,k,j) = q28bdy3dtemp2(i,k,j)
+                  q29bdy3dtemp1(i,k,j) = q29bdy3dtemp2(i,k,j)
+                  q30bdy3dtemp1(i,k,j) = q30bdy3dtemp2(i,k,j)
+                  q31bdy3dtemp1(i,k,j) = q31bdy3dtemp2(i,k,j)
+                  q32bdy3dtemp1(i,k,j) = q32bdy3dtemp2(i,k,j)
+                  q33bdy3dtemp1(i,k,j) = q33bdy3dtemp2(i,k,j)
+                  q34bdy3dtemp1(i,k,j) = q34bdy3dtemp2(i,k,j)                  
+                  q35bdy3dtemp1(i,k,j) = q35bdy3dtemp2(i,k,j)
+!!!!MARS <<
+               END DO
+            END DO
+         END DO
+
+         DO j = jps , jpe
+            DO i = ips , ipe
+               mbdy2dtemp1(i,1,j) = mbdy2dtemp2(i,1,j)
+            END DO
+         END DO
+
+      IF(grid_fdda .EQ. 1)THEN
+! for fdda
+         DO j = jps , jpe
+            DO k = kps , kpe
+               DO i = ips , ipe
+                  grid%fdda3d(i,k,j,p_u_ndg_old) = grid%fdda3d(i,k,j,p_u_ndg_new)
+                  grid%fdda3d(i,k,j,p_v_ndg_old) = grid%fdda3d(i,k,j,p_v_ndg_new)
+                  grid%fdda3d(i,k,j,p_t_ndg_old) = grid%fdda3d(i,k,j,p_t_ndg_new)
+                  grid%fdda3d(i,k,j,p_q_ndg_old) = grid%fdda3d(i,k,j,p_q_ndg_new)
+                  grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%fdda3d(i,k,j,p_ph_ndg_new)
+               END DO
+            END DO
+         END DO
+
+         DO j = jps , jpe
+            DO i = ips , ipe
+               grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%fdda2d(i,1,j,p_mu_ndg_new)
+            END DO
+         END DO
+      ENDIF
+
+         !  There are 2 components to the lateral boundaries.  First, there is the starting
+         !  point of this time period - just the outer few rows and columns.
+
+         CALL stuff_bdy     ( ubdy3dtemp1 , grid%em_u_b     , 'U' , ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( vbdy3dtemp1 , grid%em_v_b     , 'V' , ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( tbdy3dtemp1 , grid%em_t_b     , 'T' , ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+         CALL stuff_bdy     ( pbdy3dtemp1 , grid%em_ph_b    , 'W' , ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+!         CALL stuff_bdy     ( qbdy3dtemp1 , grid%moist_b(:,:,:,:,P_QV)   , 'T' , ijds , ijde , spec_bdy_width      , &
+!                                                                    ids , ide , jds , jde , kds , kde , &
+!                                                                    ims , ime , jms , jme , kms , kme , &
+!                                                                    ips , ipe , jps , jpe , kps , kpe )
+!!!!!MARS >>
+IF (config_flags%mars .gt. 0) THEN
+        CALL stuff_bdy     ( qbdy3dtemp1 , grid%scalar_b(:,:,:,:,2)   , 'T', ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+IF ( (config_flags%mars .eq. 1) .OR. &
+     (config_flags%mars .eq. 3) .OR. &
+     (config_flags%mars .eq. 11) .OR. &
+     (config_flags%mars .eq. 12) ) THEN
+        CALL stuff_bdy     ( q2bdy3dtemp1 , grid%scalar_b(:,:,:,:,3)   , 'T', ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+IF ((config_flags%mars .eq. 11) .OR. (config_flags%mars .eq. 12)) THEN
+        CALL stuff_bdy     ( q3bdy3dtemp1 , grid%scalar_b(:,:,:,:,4)   , 'T', ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+        CALL stuff_bdy     ( q4bdy3dtemp1 , grid%scalar_b(:,:,:,:,5)   , 'T', ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+IF ((config_flags%mars .eq. 12)) THEN
+        CALL stuff_bdy     ( q5bdy3dtemp1 , grid%scalar_b(:,:,:,:,6)   , 'T', ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+        CALL stuff_bdy     ( q6bdy3dtemp1 , grid%scalar_b(:,:,:,:,7)   , 'T', ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , kds , kde , &
+                                                                    ims , ime , jms , jme , kms , kme , &
+                                                                    ips , ipe , jps , jpe , kps , kpe )
+ENDIF
+
+!VENUS
+IF (config_flags%mars .eq. 34) THEN
+      CALL stuff_bdy     ( qbdy3dtemp1 , grid%scalar_b(:,:,:,:,2)   , 'T' , ijds, ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q2bdy3dtemp1 , grid%scalar_b(:,:,:,:,3)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q3bdy3dtemp1 , grid%scalar_b(:,:,:,:,4)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q4bdy3dtemp1 , grid%scalar_b(:,:,:,:,5)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q5bdy3dtemp1 , grid%scalar_b(:,:,:,:,6)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q6bdy3dtemp1 , grid%scalar_b(:,:,:,:,7)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q7bdy3dtemp1 , grid%scalar_b(:,:,:,:,8)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q8bdy3dtemp1 , grid%scalar_b(:,:,:,:,9)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q9bdy3dtemp1 , grid%scalar_b(:,:,:,:,10)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q10bdy3dtemp1 , grid%scalar_b(:,:,:,:,11)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q11bdy3dtemp1 , grid%scalar_b(:,:,:,:,12)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q12bdy3dtemp1 , grid%scalar_b(:,:,:,:,13)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q13bdy3dtemp1 , grid%scalar_b(:,:,:,:,14)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q14bdy3dtemp1 , grid%scalar_b(:,:,:,:,15)   , 'T' ,ijds , ijde , spec_bdy_width      , &                                                                 
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q15bdy3dtemp1 , grid%scalar_b(:,:,:,:,16)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q16bdy3dtemp1 , grid%scalar_b(:,:,:,:,17)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q17bdy3dtemp1 , grid%scalar_b(:,:,:,:,18)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q18bdy3dtemp1 , grid%scalar_b(:,:,:,:,19)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q19bdy3dtemp1 , grid%scalar_b(:,:,:,:,20)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q20bdy3dtemp1 , grid%scalar_b(:,:,:,:,21)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q21bdy3dtemp1 , grid%scalar_b(:,:,:,:,22)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q22bdy3dtemp1 , grid%scalar_b(:,:,:,:,23)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q23bdy3dtemp1 , grid%scalar_b(:,:,:,:,24)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q24bdy3dtemp1 , grid%scalar_b(:,:,:,:,25)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q25bdy3dtemp1 , grid%scalar_b(:,:,:,:,26)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q26bdy3dtemp1 , grid%scalar_b(:,:,:,:,27)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q27bdy3dtemp1 , grid%scalar_b(:,:,:,:,28)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q28bdy3dtemp1 , grid%scalar_b(:,:,:,:,29)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q29bdy3dtemp1 , grid%scalar_b(:,:,:,:,30)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q30bdy3dtemp1 , grid%scalar_b(:,:,:,:,31)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q31bdy3dtemp1 , grid%scalar_b(:,:,:,:,33)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q32bdy3dtemp1 , grid%scalar_b(:,:,:,:,33)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q33bdy3dtemp1 , grid%scalar_b(:,:,:,:,34)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+      CALL stuff_bdy     ( q34bdy3dtemp1 , grid%scalar_b(:,:,:,:,35)   , 'T' ,ijds , ijde , spec_bdy_width      , &
+                                                                 ids , ide , jds, jde , kds , kde , &
+                                                                 ims , ime , jms, jme , kms , kme , &
+                                                                 ips , ipe , jps, jpe , kps , kpe )
+ENDIF
+!!!!MARS <<
+         CALL stuff_bdy     ( mbdy2dtemp1 , grid%em_mu_b    , 'M' , ijds , ijde , spec_bdy_width      , &
+                                                                    ids , ide , jds , jde , 1 , 1 , &
+                                                                    ims , ime , jms , jme , 1 , 1 , &
+                                                                    ips , ipe , jps , jpe , 1 , 1 )
+
+      ELSE IF ( loop .EQ. time_loop_max ) THEN
+
+         !  If this is the last time through here, we need to close the files.
+
+         IF(grid%id .EQ. 1)CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
+         IF(grid_fdda .EQ. 1)CALL close_dataset ( id2 , config_flags , "DATASET=AUXINPUT10" )
+        IF(sst_update .EQ. 1)THEN
+         CALL close_dataset ( id5 , config_flags , "DATASET=AUXINPUT5" )
+        ENDIF
+
+      END IF
+
+   END IF
+
+END SUBROUTINE assemble_output
Index: trunk/WRF.COMMON/WRFV2/main/real_nmm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/real_nmm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/real_nmm.F	(revision 2744)
@@ -0,0 +1,1208 @@
+!  Create an initial data set for the WRF model based on real data.  This
+!  program is specifically set up for the NMM core.
+
+PROGRAM real_data
+
+   USE module_machine
+   USE module_domain
+   USE module_initialize
+   USE module_io_domain
+   USE module_driver_constants
+   USE module_configure
+   USE module_timing
+#ifdef WRF_CHEM
+   USE module_input_chem_data
+   USE module_input_chem_bioemiss
+#endif
+   USE module_utility
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+   IMPLICIT NONE
+
+   REAL    :: time , bdyfrq
+
+   INTEGER :: loop , levels_to_process , debug_level
+
+
+   TYPE(domain) , POINTER :: null_domain
+   TYPE(domain) , POINTER :: grid
+   TYPE (grid_config_rec_type)              :: config_flags
+   INTEGER                :: number_at_same_level
+
+   INTEGER :: max_dom, domain_id
+   INTEGER :: idum1, idum2 
+#ifdef DM_PARALLEL
+   INTEGER                 :: nbytes
+!   INTEGER, PARAMETER      :: configbuflen = 2*1024
+   INTEGER, PARAMETER      :: configbuflen = 4*CONFIG_BUF_LEN
+   INTEGER                 :: configbuf( configbuflen )
+   LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+#endif
+
+   INTEGER :: ids , ide , jds , jde , kds , kde
+   INTEGER :: ims , ime , jms , jme , kms , kme
+   INTEGER :: ips , ipe , jps , jpe , kps , kpe
+   INTEGER :: ijds , ijde , spec_bdy_width
+   INTEGER :: i , j , k , idts
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+   CHARACTER (LEN=80)     :: message
+
+   INTEGER :: start_year , start_month , start_day 
+   INTEGER :: start_hour , start_minute , start_second
+   INTEGER :: end_year ,   end_month ,   end_day ,   &
+              end_hour ,   end_minute ,   end_second
+   INTEGER :: interval_seconds , real_data_init_type
+   INTEGER :: time_loop_max , time_loop, rc
+   REAL    :: t1,t2
+
+#include "version_decl"
+
+   INTERFACE
+     SUBROUTINE Setup_Timekeeping( grid )
+      USE module_domain
+      TYPE(domain), POINTER :: grid
+     END SUBROUTINE Setup_Timekeeping
+   END INTERFACE
+
+   !  Define the name of this program (program_name defined in module_domain)
+
+   program_name = "REAL_NMM " // TRIM(release_version) // " PREPROCESSOR"
+
+#ifdef DM_PARALLEL
+   CALL disable_quilting
+#endif
+
+   !  Initialize the modules used by the WRF system.  
+   !  Many of the CALLs made from the
+   !  init_modules routine are NO-OPs.  Typical initializations 
+   !  are: the size of a
+   !  REAL, setting the file handles to a pre-use value, defining moisture and
+   !  chemistry indices, etc.
+
+   CALL       wrf_debug ( 100 , 'real_nmm: calling init_modules ' )
+
+!!!!   CALL init_modules
+   CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
+   CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
+   CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
+
+   !  The configuration switches mostly come from the NAMELIST input.
+
+#ifdef DM_PARALLEL
+   IF ( wrf_dm_on_monitor() ) THEN
+	write(0,*) 'call initial_config'
+      CALL initial_config
+   ENDIF
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+   CALL wrf_dm_initialize
+#else
+   CALL initial_config
+#endif
+
+
+   CALL nl_get_debug_level ( 1, debug_level )
+   CALL set_wrf_debug_level ( debug_level )
+
+   CALL  wrf_message ( program_name )
+
+   !  Allocate the space for the mother of all domains.
+
+   NULLIFY( null_domain )
+   CALL  wrf_debug ( 100 , 'real_nmm: calling alloc_and_configure_domain ' )
+   CALL alloc_and_configure_domain ( domain_id  = 1           , &
+                                     grid       = head_grid   , &
+                                     parent     = null_domain , &
+                                     kid        = -1            )
+
+   grid => head_grid
+
+#include "deref_kludge.h"
+   CALL Setup_Timekeeping ( grid )
+   CALL domain_clock_set( grid, &
+                          time_step_seconds=model_config_rec%interval_seconds )
+   CALL wrf_debug ( 100 , 'real_nmm: calling set_scalar_indices_from_config ' )
+   CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
+
+   CALL     wrf_debug ( 100 , 'real_nmm: calling model_to_grid_config_rec ' )
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+	write(0,*) 'after model_to_grid_config_rec, e_we, e_sn are: ', &
+                    config_flags%e_we, config_flags%e_sn
+
+   !  Initialize the WRF IO: open files, init file handles, etc.
+
+   CALL       wrf_debug ( 100 , 'real_nmm: calling init_wrfio' )
+   CALL init_wrfio
+
+!  Some of the configuration values may have been modified from the initial READ
+!  of the NAMELIST, so we re-broadcast the configuration records.
+
+#ifdef DM_PARALLEL
+   CALL wrf_debug ( 100 , 'real_nmm: re-broadcast the configuration records' )
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+#endif
+
+   !   No looping in this layer.  
+
+   CALL med_sidata_input ( grid , config_flags )
+
+   !  We are done.
+
+   CALL       wrf_debug (   0 , 'real_nmm: SUCCESS COMPLETE REAL_NMM INIT' )
+
+#ifdef DM_PARALLEL
+    CALL wrf_dm_shutdown
+#endif
+
+   CALL WRFU_Finalize( rc=rc )
+
+END PROGRAM real_data
+
+SUBROUTINE med_sidata_input ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+  ! Model layer
+   USE module_configure
+   USE module_bc_time_utilities
+   USE module_initialize
+   USE module_optional_si_input
+#ifdef WRF_CHEM
+   USE module_input_chem_data
+   USE module_input_chem_bioemiss
+#endif
+
+   USE module_si_io_nmm
+
+   USE module_date_time
+
+   IMPLICIT NONE
+
+
+  ! Interface 
+   INTERFACE
+     SUBROUTINE start_domain ( grid , allowed_to_read )
+       USE module_domain
+       TYPE (domain) grid
+       LOGICAL, INTENT(IN) :: allowed_to_read
+     END SUBROUTINE start_domain
+   END INTERFACE
+
+  ! Arguments
+   TYPE(domain)                :: grid
+   TYPE (grid_config_rec_type) :: config_flags
+  ! Local
+   INTEGER                :: time_step_begin_restart
+   INTEGER                :: idsi , ierr , myproc
+   CHARACTER (LEN=80)      :: si_inpname
+   CHARACTER (LEN=80)      :: message
+
+   CHARACTER(LEN=19) :: start_date_char , end_date_char , &
+                        current_date_char , next_date_char
+
+   INTEGER :: time_loop_max , loop
+   INTEGER :: julyr , julday , LEN
+
+   INTEGER :: io_form_auxinput1
+   INTEGER, EXTERNAL :: use_package
+
+   REAL :: gmt
+   REAL :: t1,t2
+
+   INTEGER :: numx_sm_levels_input,numx_st_levels_input
+   REAL,DIMENSION(100) :: smx_levels_input,stx_levels_input
+
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+#include "deref_kludge.h"
+
+
+   grid%input_from_file = .true.
+   grid%input_from_file = .false.
+
+   CALL compute_si_start_and_end ( model_config_rec%start_year  (grid%id) , &
+                                   model_config_rec%start_month (grid%id) , &
+                                   model_config_rec%start_day   (grid%id) , &
+                                   model_config_rec%start_hour  (grid%id) , &
+                                   model_config_rec%start_minute(grid%id) , &
+                                   model_config_rec%start_second(grid%id) , &
+                                   model_config_rec%  end_year  (grid%id) , & 
+                                   model_config_rec%  end_month (grid%id) , &
+                                   model_config_rec%  end_day   (grid%id) , &
+                                   model_config_rec%  end_hour  (grid%id) , &
+                                   model_config_rec%  end_minute(grid%id) , &
+                                   model_config_rec%  end_second(grid%id) , &
+                                   model_config_rec%interval_seconds      , &
+                                   model_config_rec%real_data_init_type   , &
+                                   start_date_char , end_date_char , time_loop_max )
+
+   !  Here we define the initial time to process, for later use by the code.
+
+   current_date_char = start_date_char
+!   start_date = start_date_char // '.0000'
+   start_date = start_date_char 
+   current_date = start_date
+
+   CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
+
+   !  Loop over each time period to process.
+
+   write(0,*) 'time_loop_max: ', time_loop_max
+   DO loop = 1 , time_loop_max
+
+      write(0,*) 'loop=', loop
+
+      print *,'-----------------------------------------------------------'
+      print *,' '
+      print '(A,A,A,I2,A,I2)' , ' Current date being processed: ', &
+        current_date, ', which is loop #',loop,' out of ',time_loop_max
+
+      !  After current_date has been set, fill in the julgmt stuff.
+
+      CALL geth_julgmt ( config_flags%julyr , config_flags%julday , &
+                                              config_flags%gmt )
+
+      !  Now that the specific Julian info is available, 
+      !  save these in the model config record.
+
+      CALL nl_set_gmt (grid%id, config_flags%gmt)
+      CALL nl_set_julyr (grid%id, config_flags%julyr)
+      CALL nl_set_julday (grid%id, config_flags%julday)
+
+      CALL nl_get_io_form_auxinput1( 1, io_form_auxinput1 )
+      write(0,*)" io_form_auxinput1 = ",io_form_auxinput1
+
+      SELECT CASE ( use_package(io_form_auxinput1) )
+#ifdef NETCDF
+      CASE ( IO_NETCDF   )
+
+      !  Open the wrfinput file.
+
+      IF ( grid%dyn_opt .EQ. dyn_nmm ) THEN
+         CALL  wrf_debug ( 100 , 'med_sidata_input: calling open_r_dataset for wrf_real_input_nm' )
+         current_date_char(11:11)='_'
+         CALL construct_filename2( si_inpname , 'wrf_real_input_nm' , &
+                                         grid%id , 2 , current_date_char )
+         current_date_char(11:11)='T'
+      ELSE
+         CALL wrf_error_fatal('real: error cant handle this grid%dyn_opt' )
+      END IF
+
+      CALL open_r_dataset ( idsi, TRIM(si_inpname), grid, config_flags, "DATASET=AUXINPUT1", ierr )
+
+      IF ( ( ierr .NE. 0 ) .AND. ( grid%dyn_opt .EQ. dyn_nmm ) ) THEN
+        CALL wrf_error_fatal('real: error opening wrf_real_input_nm for read '//TRIM(si_inpname) )
+      ENDIF
+
+      !  Input data.
+
+      CALL wrf_debug (100, 'med_sidata_input: call input_aux_model_input1_wrf')
+
+      CALL input_aux_model_input1 ( idsi, grid, config_flags, ierr )
+
+      !  Possible optional SI input.  This sets flags used by init_domain.
+
+      IF ( loop .EQ. 1 ) THEN
+         CALL  wrf_debug (100, 'med_sidata_input: call init_module_optional_si_input' )
+         CALL init_module_optional_si_input ( grid , config_flags )
+      END IF
+      CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_si_input' )
+!
+      CALL optional_si_input ( grid , idsi )
+	write(0,*) 'maxval st_input(1) within real_nmm: ', maxval(st_input(:,1,:))
+!
+      CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
+
+#endif
+#ifdef INTIO
+      CASE ( IO_INTIO )
+
+      !  Possible optional SI input.  This sets flags used by init_domain.
+
+      IF ( loop .EQ. 1 ) THEN
+         CALL  wrf_debug (100, 'med_sidata_input: call init_module_optional_si_input' )
+         CALL init_module_optional_si_input ( grid , config_flags )
+      END IF
+
+      current_date_char(11:11)='_'
+      CALL read_si ( grid, current_date_char )
+      current_date_char(11:11)='T'
+
+#endif
+      CASE DEFAULT
+        CALL wrf_error_fatal('real: not valid io_form_auxinput1')
+      END SELECT
+
+      grid%nmm_islope=1
+      grid%vegfra=grid%nmm_vegfrc
+      grid%nmm_dfrlg=grid%nmm_dfl/9.81
+
+      grid%isurban=1
+      grid%isoilwater=14
+
+      !  Initialize the mother domain for this time period with input data.
+
+      CALL wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
+      grid%input_from_file = .true.
+
+      CALL init_domain ( grid )
+
+      CALL model_to_grid_config_rec ( grid%id, model_config_rec, config_flags )
+
+      !  Close this file that is output from the SI and input to this pre-proc.
+
+      CALL wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
+
+
+!!! not sure about this, but doesnt seem like needs to be called each time
+      IF ( loop .EQ. 1 ) THEN
+	write(0,*) 'call start_domain'
+        CALL start_domain ( grid , .TRUE.)
+      END IF
+
+#ifdef WRF_CHEM
+      IF ( loop == 1 ) THEN
+         IF ( ( grid%chem_opt .EQ. RADM2     ) .OR. &
+              ( grid%chem_opt .EQ. RADM2SORG ) .OR. &
+              ( grid%chem_opt .EQ. RACM      ) .OR. &
+              ( grid%chem_opt .EQ. RACMSORG  ) ) THEN
+           ! Read the chemistry data from a previous wrf forecast (wrfout file)
+           IF(grid%chem_in_opt == 1 ) THEN
+              message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
+              CALL  wrf_message ( message )
+
+              CALL input_ext_chem_file( grid )
+
+              IF(grid%bio_emiss_opt == BEIS311 ) THEN
+                 message = 'READING BEIS3.11 EMISSIONS DATA'
+                 CALL  wrf_message ( message )
+                 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
+              END IF
+
+           ELSEIF(grid%chem_in_opt == 0)then
+              ! Generate chemistry data from a idealized vertical profile
+              message = 'STARTING WITH BACKGROUND CHEMISTRY '
+              CALL  wrf_message ( message )
+
+              print *,' ETA1 '
+              print *, grid%nmm_eta1
+
+              CALL input_chem_profile ( grid )
+
+              IF(grid%bio_emiss_opt == BEIS311 ) THEN
+                 message = 'READING BEIS3.11 EMISSIONS DATA'
+                 CALL  wrf_message ( message )
+                 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
+              END IF
+
+           ELSE
+             message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
+             CALL  wrf_message ( message )
+           ENDIF
+         ENDIF
+      ENDIF
+#endif
+
+      config_flags%isurban=1
+      config_flags%isoilwater=14
+
+      CALL assemble_output ( grid , config_flags , loop , time_loop_max )
+
+      !  Here we define the next time that we are going to process.
+
+      CALL geth_newdate ( current_date_char , start_date_char , &
+                          loop * model_config_rec%interval_seconds )
+      current_date =  current_date_char // '.0000'
+
+      CALL domain_clock_set( grid, current_date(1:19) )
+
+      write(0,*) 'current_date= ', current_date
+
+   END DO
+END SUBROUTINE med_sidata_input
+
+SUBROUTINE compute_si_start_and_end (  &
+          start_year, start_month, start_day, start_hour, &
+          start_minute, start_second, &
+          end_year ,   end_month ,   end_day ,   end_hour , &
+          end_minute ,   end_second , &
+          interval_seconds , real_data_init_type , &
+          start_date_char , end_date_char , time_loop_max )
+
+   USE module_date_time
+
+   IMPLICIT NONE
+
+   INTEGER :: start_year , start_month , start_day , &
+              start_hour , start_minute , start_second
+   INTEGER ::   end_year ,   end_month ,   end_day , &
+                end_hour ,   end_minute ,   end_second
+   INTEGER :: interval_seconds , real_data_init_type
+   INTEGER :: time_loop_max , time_loop
+
+   CHARACTER(LEN=19) :: current_date_char , start_date_char , &
+                        end_date_char , next_date_char
+
+!   WRITE ( start_date_char , FMT = &
+!         '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
+!         start_year,start_month,start_day,start_hour,start_minute,start_second
+!   WRITE (   end_date_char , FMT = &
+!         '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
+!          end_year,  end_month,  end_day,  end_hour,  end_minute,  end_second
+
+   WRITE ( start_date_char , FMT = &
+         '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
+         start_year,start_month,start_day,start_hour,start_minute,start_second
+   WRITE (   end_date_char , FMT = &
+         '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
+          end_year,  end_month,  end_day,  end_hour,  end_minute,  end_second
+
+!  start_date = start_date_char // '.0000'
+
+   !  Figure out our loop count for the processing times.
+
+   time_loop = 1
+   PRINT '(A,I4,A,A,A)','Time period #',time_loop, &
+                        ' to process = ',start_date_char,'.'
+   current_date_char = start_date_char
+   loop_count : DO
+      CALL geth_newdate (next_date_char, current_date_char, interval_seconds )
+      IF      ( next_date_char .LT. end_date_char ) THEN
+         time_loop = time_loop + 1
+         PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
+                              ' to process = ',next_date_char,'.'
+         current_date_char = next_date_char
+      ELSE IF ( next_date_char .EQ. end_date_char ) THEN
+         time_loop = time_loop + 1
+         PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
+                              ' to process = ',next_date_char,'.'
+         PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
+         time_loop_max = time_loop
+         EXIT loop_count
+      ELSE IF ( next_date_char .GT. end_date_char ) THEN
+         PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
+         time_loop_max = time_loop
+         EXIT loop_count
+      END IF
+   END DO loop_count
+	write(0,*) 'done in si_start_and_end'
+END SUBROUTINE compute_si_start_and_end
+
+SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
+
+!!! replace with something?   USE module_big_step_utilities_em
+
+   USE module_domain
+   USE module_io_domain
+   USE module_configure
+   USE module_date_time
+   USE module_bc
+   IMPLICIT NONE
+
+   TYPE(domain)                 :: grid
+   TYPE (grid_config_rec_type)  :: config_flags
+   INTEGER , INTENT(IN)         :: loop , time_loop_max
+
+   INTEGER :: ids , ide , jds , jde , kds , kde
+   INTEGER :: ims , ime , jms , jme , kms , kme
+   INTEGER :: ips , ipe , jps , jpe , kps , kpe
+   INTEGER :: ijds , ijde , spec_bdy_width
+   INTEGER :: inc_h,inc_v
+   INTEGER :: i , j , k , idts
+
+   INTEGER :: id1 , interval_seconds , ierr, rc
+   INTEGER , SAVE :: id 
+   CHARACTER (LEN=80) :: inpname , bdyname
+   CHARACTER(LEN= 4) :: loop_char
+character *19 :: temp19
+character *24 :: temp24 , temp24b
+
+   REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp1 , vbdy3dtemp1 ,&
+                                                tbdy3dtemp1 , &
+				                cwmbdy3dtemp1 , qbdy3dtemp1,&
+                                                q2bdy3dtemp1 , pdbdy2dtemp1
+   REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , &
+                                                tbdy3dtemp2 , & 
+                                                cwmbdy3dtemp2 , qbdy3dtemp2, &
+                                                q2bdy3dtemp2, pdbdy2dtemp2
+   REAL :: t1,t2
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+#include "deref_kludge.h"
+
+
+   !  Various sizes that we need to be concerned about.
+
+   ids = grid%sd31
+   ide = grid%ed31-1 ! 030730tst
+   kds = grid%sd32
+   kde = grid%ed32-1 ! 030730tst
+   jds = grid%sd33
+   jde = grid%ed33-1 ! 030730tst
+
+   ims = grid%sm31
+   ime = grid%em31
+   kms = grid%sm32
+   kme = grid%em32
+   jms = grid%sm33
+   jme = grid%em33
+
+   ips = grid%sp31
+   ipe = grid%ep31-1 ! 030730tst
+   kps = grid%sp32
+   kpe = grid%ep32-1 ! 030730tst
+   jps = grid%sp33
+   jpe = grid%ep33-1 ! 030730tst
+
+!!!!!!! believe IPE and JPE should be larger if they aren't on the global
+!!!!!!! boundary
+
+        if (IPE .ne. IDE) IPE=IPE+1
+        if (JPE .ne. JDE) JPE=JPE+1
+
+	write(0,*) 'assemble output (ids,ide): ', ids,ide
+	write(0,*) 'assemble output (ims,ime): ', ims,ime
+	write(0,*) 'assemble output (ips,ipe): ', ips,ipe
+
+	write(0,*) 'assemble output (jds,jde): ', jds,jde
+	write(0,*) 'assemble output (jms,jme): ', jms,jme
+	write(0,*) 'assemble output (jps,jpe): ', jps,jpe
+
+	write(0,*) 'assemble output (kds,kde): ', kds,kde
+	write(0,*) 'assemble output (kms,kme): ', kms,kme
+	write(0,*) 'assemble output (kps,kpe): ', kps,kpe
+
+   ijds = MIN ( ids , jds )
+!mptest030805   ijde = MAX ( ide , jde )
+   ijde = MAX ( ide , jde ) + 1   ! to make stuff_bdy dimensions consistent with alloc
+
+   !  Boundary width, scalar value.
+
+   spec_bdy_width = model_config_rec%spec_bdy_width
+   interval_seconds = model_config_rec%interval_seconds
+
+      write(0,*)' in assemble_ouput loop=',loop
+!-----------------------------------------------------------------------
+!
+   main_loop_test: IF ( loop .EQ. 1 ) THEN
+!
+!-----------------------------------------------------------------------
+
+   !  This is the space needed to save the current 3d data for use in computing
+   !  the lateral boundary tendencies.
+
+	write(0,*) 'allocating 3d arrays passed into stuff_bdy with vert lims: ', &
+                  kms, kme
+      ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( cwmbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q2bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( pdbdy2dtemp1(ims:ime,  1:1  ,jms:jme) )
+
+	ubdy3dtemp1=0.
+	vbdy3dtemp1=0.
+	tbdy3dtemp1=0.
+	qbdy3dtemp1=0.
+	cwmbdy3dtemp1=0.
+	q2bdy3dtemp1=0.
+	pdbdy2dtemp1=0.
+
+      ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( cwmbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( q2bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
+      ALLOCATE ( pdbdy2dtemp2(ims:ime,  1:1  ,jms:jme) )
+
+	ubdy3dtemp2=0.
+	vbdy3dtemp2=0.
+	tbdy3dtemp2=0.
+	qbdy3dtemp2=0.
+	cwmbdy3dtemp2=0.
+	q2bdy3dtemp2=0.
+	pdbdy2dtemp2=0.
+
+      !  Open the wrfinput file.  From this program, this is an *output* file.
+
+      CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
+
+      CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , &
+                            output_model_input , "DATASET=INPUT", ierr )
+
+      IF ( ierr .NE. 0 ) THEN
+      CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
+      ENDIF
+
+!     CALL calc_current_date ( grid%id , 0. )
+!      grid%write_metadata = .true.
+
+	write(0,*) 'making call to output_model_input'
+
+        CALL output_model_input ( id1, grid , config_flags , ierr )
+	write(0,*) 'ierr from output_model_input: ', ierr
+
+!***
+!***  CLOSE THE WRFINPUT DATASET
+!***
+      CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
+
+      !  We need to save the 3d data to compute a 
+      !  difference during the next loop. 
+
+   write(0,*) 'I,J,K lims: ', MIN(ide,ipe), MIN(jde,jpe), MIN(kde,kpe)
+!
+!-----------------------------------------------------------------------
+!***  SOUTHERN BOUNDARY
+!-----------------------------------------------------------------------
+!
+
+        IF(JPS==JDS)THEN
+          J=1
+          DO k = kps , MIN(kde,kpe)
+          DO i = ips , MIN(ide,ipe)
+            ubdy3dtemp1(i,k,j) = grid%nmm_u(i,k,j)
+            vbdy3dtemp1(i,k,j) = grid%nmm_v(i,k,j)
+            tbdy3dtemp1(i,k,j) = grid%nmm_t(i,k,j)
+            qbdy3dtemp1(i,k,j) = grid%nmm_q(i,k,j)
+            cwmbdy3dtemp1(i,k,j) = grid%nmm_cwm(i,k,j)
+            q2bdy3dtemp1(i,k,j) = grid%nmm_q2(i,k,j)
+          END DO
+          END DO
+
+          DO i = ips , MIN(ide,ipe)
+            pdbdy2dtemp1(i,1,j) = grid%nmm_pd(i,j)
+          END DO
+        ENDIF
+
+!
+!-----------------------------------------------------------------------
+!***  NORTHERN BOUNDARY
+!-----------------------------------------------------------------------
+!
+        IF(JPE==JDE)THEN
+          J=MIN(JDE,JPE)
+          DO k = kps , MIN(kde,kpe)
+          DO i = ips , MIN(ide,ipe)
+            ubdy3dtemp1(i,k,j) = grid%nmm_u(i,k,j)
+            vbdy3dtemp1(i,k,j) = grid%nmm_v(i,k,j)
+            tbdy3dtemp1(i,k,j) = grid%nmm_t(i,k,j)
+            qbdy3dtemp1(i,k,j) = grid%nmm_q(i,k,j)
+            cwmbdy3dtemp1(i,k,j) = grid%nmm_cwm(i,k,j)
+            q2bdy3dtemp1(i,k,j) = grid%nmm_q2(i,k,j)
+          END DO
+          END DO
+
+          DO i = ips , MIN(ide,ipe)
+            pdbdy2dtemp1(i,1,j) = grid%nmm_pd(i,j)
+          END DO
+        ENDIF
+
+!
+!-----------------------------------------------------------------------
+!***  WESTERN BOUNDARY
+!-----------------------------------------------------------------------
+!
+	write(0,*) 'western boundary, store winds over J: ', jps, min(jpe,jde)
+        IF(IPS==IDS)THEN
+          I=1
+          DO k = kps , MIN(kde,kpe)
+          inc_h=mod(jps+1,2)
+          DO j = jps+inc_h, min(jde,jpe),2
+
+        if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
+            tbdy3dtemp1(i,k,j) = grid%nmm_t(i,k,j)
+            qbdy3dtemp1(i,k,j) = grid%nmm_q(i,k,j)
+            cwmbdy3dtemp1(i,k,j) = grid%nmm_cwm(i,k,j)
+            q2bdy3dtemp1(i,k,j) = grid%nmm_q2(i,k,j)
+      if(k==1)then
+        write(0,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,k,j)=',tbdy3dtemp1(i,k,j)
+      endif
+	endif
+          END DO
+          END DO
+
+          DO k = kps , MIN(kde,kpe)
+          inc_v=mod(jps,2)
+          DO j = jps+inc_v, min(jde,jpe),2
+        if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
+            ubdy3dtemp1(i,k,j) = grid%nmm_u(i,k,j)
+            vbdy3dtemp1(i,k,j) = grid%nmm_v(i,k,j)
+	endif
+          END DO
+          END DO
+!
+          inc_h=mod(jps+1,2)
+        DO j = jps+inc_h, min(jde,jpe),2
+        if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
+            pdbdy2dtemp1(i,1,j) = grid%nmm_pd(i,j)
+      write(0,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,1,j)=',pdbdy2dtemp1(i,1,j)
+	endif
+          END DO
+        ENDIF
+!
+!-----------------------------------------------------------------------
+!***  EASTERN BOUNDARY
+!-----------------------------------------------------------------------
+!
+        IF(IPE==IDE)THEN
+          I=MIN(IDE,IPE)
+!
+          DO k = kps , MIN(kde,kpe)
+!
+!***   Make sure the J loop is on the global boundary
+!
+          inc_h=mod(jps+1,2)
+          DO j = jps+inc_h, min(jde,jpe),2
+        if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
+            tbdy3dtemp1(i,k,j) = grid%nmm_t(i,k,j)
+            qbdy3dtemp1(i,k,j) = grid%nmm_q(i,k,j)
+            cwmbdy3dtemp1(i,k,j) = grid%nmm_cwm(i,k,j)
+            q2bdy3dtemp1(i,k,j) = grid%nmm_q2(i,k,j)
+	endif
+          END DO
+          END DO
+
+          DO k = kps , MIN(kde,kpe)
+          inc_v=mod(jps,2)
+          DO j = jps+inc_v, min(jde,jpe),2
+        if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
+            ubdy3dtemp1(i,k,j) = grid%nmm_u(i,k,j)
+            vbdy3dtemp1(i,k,j) = grid%nmm_v(i,k,j)
+        endif
+          END DO
+          END DO
+!
+          inc_h=mod(jps+1,2)
+          DO j = jps+inc_h, min(jde,jpe),2
+        if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
+            pdbdy2dtemp1(i,1,j) = grid%nmm_pd(i,j)
+	endif
+          END DO
+        ENDIF
+
+
+      !  There are 2 components to the lateral boundaries.  
+      !  First, there is the starting
+      !  point of this time period - just the outer few rows and columns.
+
+
+ CALL stuff_bdy (ubdy3dtemp1, grid%nmm_u_b, 'N', ijds, ijde, spec_bdy_width  , &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+ CALL stuff_bdy ( vbdy3dtemp1, grid%nmm_v_b, 'N', ijds, ijde, spec_bdy_width, &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+	write(0,*) 'size (dim 1) nmm_t_b: ', size(grid%nmm_t_b, dim=1)
+	write(0,*) 'size (dim 2) nmm_t_b: ', size(grid%nmm_t_b, dim=2)
+	write(0,*) 'size (dim 3) nmm_t_b: ', size(grid%nmm_t_b, dim=3)
+	write(0,*) 'size (dim 4) nmm_t_b: ', size(grid%nmm_t_b, dim=4)
+
+ CALL stuff_bdy ( tbdy3dtemp1, grid%nmm_t_b, 'N', ijds, ijde, spec_bdy_width, &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+
+ CALL stuff_bdy ( cwmbdy3dtemp1,grid%nmm_cwm_b,'N',ijds,ijde, spec_bdy_width, &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+
+ CALL stuff_bdy ( qbdy3dtemp1, grid%nmm_q_b, 'N', ijds, ijde, spec_bdy_width, &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+
+ CALL stuff_bdy ( q2bdy3dtemp1,grid%nmm_q2_b,'N', ijds, ijde, spec_bdy_width, &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+
+	write(0,*) 'stuff_bdy lims for pdbdy I: ', ids, ide+1
+	write(0,*) 'stuff_bdy lims for pdbdy J: ', jds, jde+1
+
+ CALL stuff_bdy ( pdbdy2dtemp1,grid%nmm_pd_b,'M', ijds,ijde, spec_bdy_width, &
+                                        ids , ide+1 , jds , jde+1 , 1 , 1 , &
+                                        ims , ime , jms , jme , 1 , 1 , &
+                                        ips , ipe , jps , jpe , 1 , 1 )
+
+!-----------------------------------------------------------------------
+!
+   ELSE IF ( loop .GT. 1 ) THEN
+!
+!-----------------------------------------------------------------------
+
+      write(0,*)' assemble_ouput loop=',loop,' in IF block'
+      !  Open the boundary file.
+
+      IF ( loop .eq. 2 ) THEN
+         CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
+      CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , &
+                          output_boundary , "DATASET=BOUNDARY", ierr )
+         IF ( ierr .NE. 0 ) THEN
+               CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
+         ENDIF
+!         grid%write_metadata = .true.
+      ELSE
+! what's this do?
+!         grid%write_metadata = .true.
+!         grid%write_metadata = .false.
+         CALL domain_clockadvance( grid )
+      END IF
+
+      write(0,*)' assemble_ouput loop=',loop,' point 2'
+
+!
+!-----------------------------------------------------------------------
+!***  SOUTHERN BOUNDARY
+!-----------------------------------------------------------------------
+!
+        IF(JPS==JDS)THEN
+          J=1
+          DO k = kps , MIN(kde,kpe)
+          DO i = ips , MIN(ide,ipe)
+            ubdy3dtemp2(i,k,j) = grid%nmm_u(i,k,j)
+            vbdy3dtemp2(i,k,j) = grid%nmm_v(i,k,j)
+            tbdy3dtemp2(i,k,j) = grid%nmm_t(i,k,j)
+            qbdy3dtemp2(i,k,j) = grid%nmm_q(i,k,j)
+            cwmbdy3dtemp2(i,k,j) = grid%nmm_cwm(i,k,j)
+            q2bdy3dtemp2(i,k,j) = grid%nmm_q2(i,k,j)
+          END DO
+          END DO
+!
+          DO i = ips , MIN(ide,ipe)
+            pdbdy2dtemp2(i,1,j) = grid%nmm_pd(i,j)
+          END DO
+        ENDIF
+
+!
+!-----------------------------------------------------------------------
+!***  NORTHERN BOUNDARY
+!-----------------------------------------------------------------------
+!
+        IF(JPE==JDE)THEN
+          J=MIN(JDE,JPE)
+          DO k = kps , MIN(kde,kpe)
+          DO i = ips , MIN(ide,ipe)
+            ubdy3dtemp2(i,k,j) = grid%nmm_u(i,k,j)
+            vbdy3dtemp2(i,k,j) = grid%nmm_v(i,k,j)
+            tbdy3dtemp2(i,k,j) = grid%nmm_t(i,k,j)
+            qbdy3dtemp2(i,k,j) = grid%nmm_q(i,k,j)
+            cwmbdy3dtemp2(i,k,j) = grid%nmm_cwm(i,k,j)
+            q2bdy3dtemp2(i,k,j) = grid%nmm_q2(i,k,j)
+          END DO
+          END DO
+
+          DO i = ips , MIN(ide,ipe)
+            pdbdy2dtemp2(i,1,j) = grid%nmm_pd(i,j)
+          END DO
+        ENDIF
+!
+!-----------------------------------------------------------------------
+!***  WESTERN BOUNDARY
+!-----------------------------------------------------------------------
+!
+      write(0,*)' assemble_ouput loop=',loop,' point 3 ips=',ips,' ids=',ids
+        IF(IPS==IDS)THEN
+          I=1
+          DO k = kps , MIN(kde,kpe)
+          inc_h=mod(jps+1,2)
+      if(k==1)then
+        write(0,*)' assemble_ouput loop=',loop,' inc_h=',inc_h,' jps=',jps
+      endif
+          DO j = jps+inc_h, MIN(jde,jpe),2
+        if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
+            tbdy3dtemp2(i,k,j) = grid%nmm_t(i,k,j)
+      if(k==1)then
+        write(0,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,k,j)=',tbdy3dtemp1(i,k,j)
+      endif
+            qbdy3dtemp2(i,k,j) = grid%nmm_q(i,k,j)
+            cwmbdy3dtemp2(i,k,j) = grid%nmm_cwm(i,k,j)
+            q2bdy3dtemp2(i,k,j) = grid%nmm_q2(i,k,j)
+	endif
+          END DO
+          END DO
+!
+          DO k = kps , MIN(kde,kpe)
+          inc_v=mod(jps,2)
+          DO j = jps+inc_v, MIN(jde,jpe),2
+        if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
+            ubdy3dtemp2(i,k,j) = grid%nmm_u(i,k,j)
+            vbdy3dtemp2(i,k,j) = grid%nmm_v(i,k,j)
+	endif
+          END DO
+          END DO
+
+	write(0,*) 'western boundary pdbdy J lims: ',  jps, min(jde,jpe)
+          inc_h=mod(jps+1,2)
+        DO j = jps+inc_h, MIN(jde,jpe),2
+        if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
+            pdbdy2dtemp2(i,1,j) = grid%nmm_pd(i,j)
+      write(0,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,1,j)=',pdbdy2dtemp1(i,1,j)
+	endif
+          END DO
+        ENDIF
+!
+!-----------------------------------------------------------------------
+!***  EASTERN BOUNDARY
+!-----------------------------------------------------------------------
+!
+        IF(IPE==IDE)THEN
+          I=MIN(IDE,IPE)
+
+          DO k = kps , MIN(kde,kpe)
+          inc_h=mod(jps+1,2)
+          DO j = jps+inc_h, MIN(jde,jpe),2
+        if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
+            tbdy3dtemp2(i,k,j) = grid%nmm_t(i,k,j)
+            qbdy3dtemp2(i,k,j) = grid%nmm_q(i,k,j)
+            cwmbdy3dtemp2(i,k,j) = grid%nmm_cwm(i,k,j)
+            q2bdy3dtemp2(i,k,j) = grid%nmm_q2(i,k,j)
+	endif
+          END DO
+          END DO
+
+          DO k = kps , MIN(kde,kpe)
+          inc_v=mod(jps,2)
+          DO j = jps+inc_v, MIN(jde,jpe),2
+        if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
+            ubdy3dtemp2(i,k,j) = grid%nmm_u(i,k,j)
+            vbdy3dtemp2(i,k,j) = grid%nmm_v(i,k,j)
+	endif
+          END DO
+          END DO
+
+          inc_h=mod(jps+1,2)
+          DO j = jps+inc_h, MIN(jde,jpe),2
+        if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
+            pdbdy2dtemp2(i,1,j) = grid%nmm_pd(i,j)
+	endif
+          END DO
+        ENDIF
+!-----------------------------------------------------------------------
+      !  During all of the loops after the first loop, 
+      !  we first compute the boundary
+      !  tendencies with the current data values 
+      !  (*bdy3dtemp2 arrays) and the previously 
+      !  saved information stored in the *bdy3dtemp1 arrays.
+
+
+      CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds),&
+                                   grid%nmm_u_bt  , 'N' , &
+                                   ijds , ijde , spec_bdy_width      , &
+                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                   ims , ime , jms , jme , kms , kme , &
+                                   ips , ipe , jps , jpe , kps , kpe+1 )
+      CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds),&
+                                    grid%nmm_v_bt  , 'N' , &
+                                   ijds , ijde , spec_bdy_width      , &
+                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                   ims , ime , jms , jme , kms , kme , &
+                                   ips , ipe , jps , jpe , kps , kpe+1 )
+      CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds),&
+                                   grid%nmm_t_bt  , 'N' , &
+                                   ijds , ijde , spec_bdy_width      , &
+                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                   ims , ime , jms , jme , kms , kme , &
+                                   ips , ipe , jps , jpe , kps , kpe+1 )
+
+      CALL stuff_bdytend ( cwmbdy3dtemp2,cwmbdy3dtemp1,REAL(interval_seconds),&
+                                   grid%nmm_cwm_bt  , 'N' , &
+                                   ijds , ijde , spec_bdy_width      , &
+                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                   ims , ime , jms , jme , kms , kme , &
+                                   ips , ipe , jps , jpe , kps , kpe+1 )
+
+      CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds),&
+                                   grid%nmm_q_bt , 'N' , &
+                                   ijds , ijde , spec_bdy_width      , &
+                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                   ims , ime , jms , jme , kms , kme , &
+                                   ips , ipe , jps , jpe , kps , kpe+1 )
+
+    CALL stuff_bdytend ( q2bdy3dtemp2, q2bdy3dtemp1 , REAL(interval_seconds),&
+                                   grid%nmm_q2_bt , 'N' , &
+                                   ijds , ijde , spec_bdy_width      , &
+                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                   ims , ime , jms , jme , kms , kme , &
+                                   ips , ipe , jps , jpe , kps , kpe+1 )
+
+       if(jps==jds.and.ips==ids) write(0,*) 'pdbdy2dtemp2(1,1,1): ', pdbdy2dtemp2(1,1,1)
+
+	write(0,*) 'stuff_bdytend lims for pdbdy I: ', ids, ide+1
+	write(0,*) 'stuff_bdytend lims for pdbdy J: ', jds, jde+1
+
+    CALL stuff_bdytend( pdbdy2dtemp2 , pdbdy2dtemp1, REAL(interval_seconds),&
+                                   grid%nmm_pd_bt  , 'M' , &
+                                   ijds , ijde , spec_bdy_width      , &
+                                   ids , ide+1 , jds , jde+1 , 1 , 1 , &
+                                   ims , ime , jms , jme , 1 , 1 , &
+                                   ips , ipe , jps , jpe , 1 , 1 )
+
+       write(0,*) 'grid%nmm_pd_bt(1,1): ', grid%nmm_pd_bt(1,1,1,1)
+
+      !  Both pieces of the boundary data are now 
+      !  available to be written (initial time and tendency).
+      !  This looks ugly, these date shifting things.  
+      !  What's it for?  We want the "Times" variable
+      !  in the lateral BDY file to have the valid times 
+      !  of when the initial fields are written.
+      !  That's what the loop-2 thingy is for with the start date.  
+      !  We increment the start_date so
+      !  that the starting time in the attributes is the 
+      !  second time period.  Why you may ask.  I
+      !  agree, why indeed.
+
+      temp24= current_date
+      temp24b=start_date
+      start_date = current_date
+      CALL geth_newdate ( temp19 , temp24b(1:19) , &
+                         (loop-2) * model_config_rec%interval_seconds )
+      current_date = temp19 //  '.0000'
+       CALL domain_clock_set( grid, current_date(1:19) )
+ print *,'LBC valid between these times ',current_date, ' ',start_date
+
+      CALL output_boundary ( id, grid , config_flags , ierr )
+      current_date = temp24
+      start_date = temp24b
+
+      !  OK, for all of the loops, we output the initialzation 
+      !  data, which would allow us to
+      !  start the model at any of the available analysis time periods.
+
+!  WRITE ( loop_char , FMT = '(I4.4)' ) loop
+!  CALL open_w_dataset ( id1, 'wrfinput'//loop_char , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
+!  IF ( ierr .NE. 0 ) THEN
+!    CALL wrf_error_fatal( 'real: error opening wrfinput'//loop_char//' for writing' )
+!  ENDIF
+!  grid%write_metadata = .true.
+
+!  CALL calc_current_date ( grid%id , 0. )
+!  CALL output_model_input ( id1, grid , config_flags , ierr )
+!  CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
+
+  !  Is this or is this not the last time time?  We can remove some unnecessary
+  !  stores if it is not.
+
+      IF     ( loop .LT. time_loop_max ) THEN
+
+         !  We need to save the 3d data to compute a 
+         !  difference during the next loop.  Couple the
+         !  3d fields with total mu (mub + mu_2) and the 
+         !  stagger-specific map scale factor.
+         !  We load up the boundary data again for use in the next loop.
+
+
+!mp	change these limits?????????
+
+	write(0,*) 'limits at end: ipe,jpe,kpe: ', ipe,jpe,kpe
+
+         DO j = jps , jpe
+            DO k = kps , kpe
+               DO i = ips , ipe
+                  ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
+                  vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
+                  tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
+                  cwmbdy3dtemp1(i,k,j) = cwmbdy3dtemp2(i,k,j)
+                  qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
+                  q2bdy3dtemp1(i,k,j) = q2bdy3dtemp2(i,k,j)
+               END DO
+            END DO
+         END DO
+
+!mp	change these limits?????????
+
+         DO j = jps , jpe
+            DO i = ips , ipe
+               pdbdy2dtemp1(i,1,j) = pdbdy2dtemp2(i,1,j)
+            END DO
+         END DO
+
+  !  There are 2 components to the lateral boundaries.  
+  !   First, there is the starting
+  !  point of this time period - just the outer few rows and columns.
+
+
+         CALL stuff_bdy ( ubdy3dtemp1 , grid%nmm_u_b  , 'N' ,& 
+                                        ijds , ijde , spec_bdy_width      , &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+         CALL stuff_bdy ( vbdy3dtemp1 , grid%nmm_v_b  , 'N' , &
+                                        ijds , ijde , spec_bdy_width      , &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+         CALL stuff_bdy ( tbdy3dtemp1 , grid%nmm_t_b  , 'N' , &
+                                        ijds , ijde , spec_bdy_width      , &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+
+         CALL stuff_bdy ( cwmbdy3dtemp1 , grid%nmm_cwm_b , 'N' , &
+                                          ijds , ijde , spec_bdy_width      , &
+                                          ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                          ims , ime , jms , jme , kms , kme , &
+                                          ips , ipe , jps , jpe , kps , kpe+1 )
+
+         CALL stuff_bdy ( qbdy3dtemp1 , grid%nmm_q_b , 'N' ,&
+                                        ijds , ijde , spec_bdy_width      , &
+                                        ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                        ims , ime , jms , jme , kms , kme , &
+                                        ips , ipe , jps , jpe , kps , kpe+1 )
+
+         CALL stuff_bdy ( q2bdy3dtemp1 , grid%nmm_q2_b, 'N' ,&
+                                         ijds , ijde , spec_bdy_width      , &
+                                         ids , ide+1 , jds , jde+1 , kds , kde+1 , &
+                                         ims , ime , jms , jme , kms , kme , &
+                                         ips , ipe , jps , jpe , kps , kpe+1 )
+
+         CALL stuff_bdy ( pdbdy2dtemp1 , grid%nmm_pd_b , 'M' ,&
+                                          ijds , ijde , spec_bdy_width  , &
+                                          ids , ide+1 , jds , jde+1 , 1 , 1 , &
+                                          ims , ime , jms , jme , 1 , 1 , &
+                                          ips , ipe , jps , jpe , 1 , 1 )
+
+            write(0,*) 'grid%nmm_pd_b(1,1): ', grid%nmm_pd_b(1,1,1,1)
+
+      ELSE IF ( loop .EQ. time_loop_max ) THEN
+
+    !  If this is the last time through here, we need to close the files.
+
+         CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
+
+      END IF
+
+   END IF main_loop_test
+
+END SUBROUTINE assemble_output
Index: trunk/WRF.COMMON/WRFV2/main/wrf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/wrf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/wrf.F	(revision 2744)
@@ -0,0 +1,31 @@
+!WRF:DRIVER_LAYER:MAIN
+!
+
+PROGRAM wrf
+
+   USE module_wrf_top
+
+!<DESCRIPTION>
+! Main program of WRF model.  Responsible for starting up the model, reading in (and
+! broadcasting for distributed memory) configuration data, defining and initializing
+! the top-level domain, either from initial or restart data, setting up time-keeping, and
+! then calling the <a href=integrate.html>integrate</a> routine to advance the domain
+! to the ending time of the simulation. After the integration is completed, the model
+! is properly shut down.
+!
+!</DESCRIPTION>
+
+   IMPLICIT NONE
+
+   ! Initialize WRF model.  
+   CALL wrf_init
+
+   ! WRF model time-stepping.  Calls integrate().  
+   CALL wrf_run
+
+   ! WRF model clean-up.  This calls MPI_FINALIZE() for DM parallel runs.  
+   CALL wrf_finalize
+
+END PROGRAM wrf
+
+
Index: trunk/WRF.COMMON/WRFV2/main/wrf_ESMFApp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/wrf_ESMFApp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/wrf_ESMFApp.F	(revision 2744)
@@ -0,0 +1,213 @@
+!WRF:DRIVER_LAYER:MAIN
+!
+
+!<DESCRIPTION>
+! Stand-alone ESMF Application Wrapper for WRF model.  This file contains the 
+! main program and creates a top level ESMF Gridded Component.  
+!
+! This source file is only built when ESMF coupling is used.  
+!
+!</DESCRIPTION>
+
+
+PROGRAM wrf_ESMFApp
+
+!<DESCRIPTION>
+! Stand-alone ESMF Application Wrapper for WRF model.  This is the main 
+! program that creates a top level ESMF Gridded Component.  
+!
+!</DESCRIPTION>
+                                                                                                      
+   ! WRF registration routine
+   USE module_wrf_setservices, ONLY: WRF_register
+   ! ESMF module, defines all ESMF data types and procedures
+   USE ESMF_Mod
+   ! Not-yet-implemented ESMF features
+   USE module_esmf_extensions
+   ! Component-independent utilities
+   USE module_metadatautils, ONLY: GetTimesFromStates
+
+   IMPLICIT NONE
+
+   ! Local variables
+
+   ! Components
+   TYPE(ESMF_GridComp) :: WRFcompGridded   ! WRF
+
+   ! State, Virtual Machine, and DELayout
+   TYPE(ESMF_VM) :: vm
+   TYPE(ESMF_State) :: importState, exportState
+
+   ! A clock, some times, and a time step
+   TYPE(ESMF_Clock) :: driverClock
+   TYPE(ESMF_Time) :: startTime
+   TYPE(ESMF_Time) :: stopTime
+   TYPE(ESMF_TimeInterval) :: couplingInterval
+
+   ! Return codes for error checks
+   INTEGER :: rc
+
+   ! Warn users that this is not yet ready for general use.  
+   PRINT *, '                      W A R N I N G                          '
+   PRINT *, '  ESMF COUPLING CAPABILITY IS EXPERIMENTAL AND UNSUPPORTED   '
+   PRINT *, '                 IN THIS VERSION OF WRF                      '
+   PRINT *, '          U S E   A T   Y O U R   O W N   R I S K            '
+
+   ! This call includes everything that must be done before ESMF_Initialize()
+   ! is called.
+   CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
+
+   ! Initialize ESMF, get the default Global VM, and set
+   ! the default calendar to be Gregorian.
+   CALL ESMF_Initialize( vm=vm, defaultCalendar=ESMF_CAL_GREGORIAN, rc=rc )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_Initialize failed' )
+   ENDIF
+   CALL ESMF_SetInitialized()   ! eliminate this once ESMF does it internally
+!TBH:  these cause hangs on bluesky, PET* files never get written...  
+!TBH:   CALL ESMF_LogSet( maxElements=1, verbose=ESMF_TRUE, flush=ESMF_TRUE, rc=rc )
+!TBH:   CALL ESMF_LogSet( maxElements=1, rc=rc )
+!TBH:   IF ( rc /= ESMF_SUCCESS ) THEN
+!TBH:     CALL wrf_error_fatal( 'ESMF_LogSet failed' )
+!TBH:   ENDIF
+
+   ! Create the top level Gridded Component, passing in the default VM.
+   WRFcompGridded = ESMF_GridCompCreate(vm, "WRF Model", rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_GridCompCreate failed' )
+   ENDIF
+
+   ! Create empty import and export states
+   importState = ESMF_StateCreate("WRF Import State", statetype=ESMF_STATE_IMPORT, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_StateCreate(importState) failed' )
+   ENDIF
+   exportState = ESMF_StateCreate("WRF Export State", statetype=ESMF_STATE_EXPORT, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_StateCreate(exportState) failed' )
+   ENDIF
+
+   ! Create top-level clock.  There is no way to create an "empty" clock, so 
+   ! stuff in bogus values for start time, stop time, and time step and fix 
+   ! them after "WRF Init" returns.  
+   CALL ESMF_TimeSet(startTime, yy=2000, mm=1, dd=1, &
+                     h=0, m=0, s=0, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_TimeSet(startTime) failed' )
+   ENDIF
+   CALL ESMF_TimeSet(stopTime, yy=2000, mm=1, dd=1, &
+                     h=12, m=0, s=0, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_TimeSet(stopTime) failed' )
+   ENDIF
+   CALL ESMF_TimeIntervalSet(couplingInterval, s=2, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_TimeIntervalSet(couplingInterval) failed' )
+   ENDIF
+   driverClock = ESMF_ClockCreate(timeStep=couplingInterval, startTime=startTime, &
+                                  stopTime=stopTime, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_ClockCreate failed' )
+   ENDIF
+
+   ! Register the top level Gridded Component
+   CALL ESMF_GridCompSetServices(WRFcompGridded, WRF_register, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_GridCompSetServices(WRFcompGridded) failed' )
+   ENDIF
+
+   ! Init, Run, and Finalize section
+   ! Phase 1 init returns WRF time and decomposition information as 
+   ! exportState metadata.  
+   CALL ESMF_GridCompInitialize(WRFcompGridded, importState, exportState, &
+                                driverClock, phase=1, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_GridCompInitialize(WRFcompGridded phase 1) failed' )
+   ENDIF
+
+   ! For now, use settings from WRF component intialization to set up 
+   ! top-level clock.  Per suggestion from ESMF Core team, these are passed 
+   ! back from "WRF init" as attributes on exportState.  
+   CALL GetTimesFromStates( exportState, startTime, stopTime, couplingInterval )
+   ! update driver clock
+   CALL ESMF_ClockDestroy(driverClock, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_ClockDestroy failed' )
+   ENDIF
+   driverClock = ESMF_ClockCreate(timeStep=couplingInterval, startTime=startTime, &
+                                  stopTime=stopTime, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_ClockCreate(driverClock) failed' )
+   ENDIF
+   CALL wrf_clockprint ( 150, driverClock, 'driverClock before phase 2 WRF init' )
+
+   ! Phase 2 init sets up WRF importState and exportState.  
+   CALL ESMF_GridCompInitialize(WRFcompGridded, importState, exportState, &
+                                driverClock, phase=2, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_GridCompInitialize(WRFcompGridded phase 2) failed' )
+   ENDIF
+
+   CALL wrf_debug ( 150, 'wrf_ESMFApp:  begin time stepping...' )
+   ! main time-stepping loop
+   DO WHILE ( .NOT. ESMF_ClockIsStopTime(driverClock, rc) )
+
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal( 'ESMF_ClockIsStopTime failed' )
+     ENDIF
+
+     ! Run WRF
+     CALL wrf_debug ( 150, 'wrf_ESMFApp:  calling ESMF_GridCompRun(WRFcompGridded)...' )
+     CALL ESMF_GridCompRun(WRFcompGridded, importState, exportState, &
+                           driverClock, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal( 'ESMF_GridCompRun failed' )
+     ENDIF
+     CALL wrf_debug ( 150, 'wrf_ESMFApp:  back from ESMF_GridCompRun(WRFcompGridded)...' )
+
+     ! advance clock to next coupling time step
+     CALL ESMF_ClockAdvance( driverClock, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal( 'ESMF_ClockAdvance failed' )
+     ENDIF
+     CALL wrf_clockprint ( 150, driverClock, 'driverClock after ESMF_ClockAdvance' )
+
+   ENDDO
+   CALL wrf_debug ( 150, 'wrf_ESMFApp:  done time stepping...' )
+
+   CALL wrf_debug ( 150, 'wrf_ESMFApp:  calling ESMF_GridCompFinalize(WRFcompGridded)...' )
+   ! clean up WRF
+   CALL ESMF_GridCompFinalize(WRFcompGridded, importState, exportState, &
+                              driverClock, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_GridCompFinalize failed' )
+   ENDIF
+   CALL wrf_debug ( 150, 'wrf_ESMFApp:  back from ESMF_GridCompFinalize(WRFcompGridded)...' )
+ 
+   ! Clean up
+
+   CALL wrf_debug ( 150, 'wrf_ESMFApp:  cleaning up ESMF objects...' )
+   CALL ESMF_GridCompDestroy(WRFcompGridded, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_GridCompDestroy failed' )
+   ENDIF
+   CALL ESMF_StateDestroy(importState, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_StateDestroy(importState) failed' )
+   ENDIF
+   CALL ESMF_StateDestroy(exportState, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_StateDestroy(exportState) failed' )
+   ENDIF
+   CALL ESMF_ClockDestroy(driverClock, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal( 'ESMF_Destroy(driverClock) failed' )
+   ENDIF
+
+   CALL wrf_debug ( 150, 'wrf_ESMFApp:  calling ESMF_Finalize()...' )
+   CALL ESMF_Finalize( rc=rc )
+   CALL wrf_debug ( 150, 'wrf_ESMFApp:  back from ESMF_Finalize()...' )
+
+END PROGRAM wrf_ESMFApp
+
+
Index: trunk/WRF.COMMON/WRFV2/main/wrf_ESMFMod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/wrf_ESMFMod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/wrf_ESMFMod.F	(revision 2744)
@@ -0,0 +1,1255 @@
+!WRF:DRIVER_LAYER:MAIN
+!
+
+!<DESCRIPTION>
+! ESMF-specific modules for building WRF as an ESMF component.  
+!
+! This source file is only built when ESMF coupling is used.  
+!
+!</DESCRIPTION>
+
+
+
+MODULE module_metadatautils
+!<DESCRIPTION>
+! This module defines component-independent "model metadata" utilities 
+! used for ESMF coupling.  
+!</DESCRIPTION>
+!$$$ Upgrade this later to support multiple coupling intervals via Alarms 
+!$$$ associated with top-level clock.  Do this by adding TimesAttachedToState() 
+!$$$ inquiry function that will test an ESMF_State to see if the times are 
+!$$$ present via names defined in this module.  Then call this for every 
+!$$$ component and resolve conflicts (somehow) for cases where two components 
+!$$$ define conflicting clocks.  Of course, a component is allowed to not define 
+!$$$ a clock at all too...  
+!
+!$$$ Replace meta-data names with "model metadata" conventions (when they exist)
+!
+!$$$ Refactor to remove duplication of hard-coded names!  
+!
+   USE ESMF_Mod
+
+   IMPLICIT NONE
+
+   ! everything is private by default
+   PRIVATE
+
+   ! Public interfaces
+   PUBLIC AttachTimesToState
+   PUBLIC GetTimesFromStates
+   PUBLIC AttachDecompToState
+   PUBLIC GetDecompFromState
+
+   ! private stuff
+   CHARACTER (ESMF_MAXSTR) :: str
+
+
+CONTAINS
+
+
+   ! Attach time information to state as meta-data.  
+   ! Update later to use some form of meta-data standards/conventions for 
+   ! model "time" meta-data.  
+   SUBROUTINE AttachTimesToState( state, startTime, stopTime, couplingInterval )
+     TYPE(ESMF_State),        INTENT(INOUT) :: state
+     TYPE(ESMF_Time),         INTENT(IN   ) :: startTime
+     TYPE(ESMF_Time),         INTENT(IN   ) :: stopTime
+     TYPE(ESMF_TimeInterval), INTENT(IN   ) :: couplingInterval
+     ! locals
+     INTEGER :: rc
+     INTEGER :: year, month, day, hour, minute, second
+     INTEGER(ESMF_KIND_I4) :: timevals(6)   ! big enough to hold the vars listed above
+     ! start time
+     CALL ESMF_TimeGet(startTime, yy=year, mm=month, dd=day, &
+                       h=hour, m=minute, s=second, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_TimeGet(startTime) failed' )
+     ENDIF
+     timevals(1) = year
+     timevals(2) = month
+     timevals(3) = day
+     timevals(4) = hour
+     timevals(5) = minute
+     timevals(6) = second
+     CALL ESMF_StateSetAttribute(state, 'ComponentStartTime', &
+                                 SIZE(timevals), timevals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(ComponentStartTime) failed' )
+     ENDIF
+     ! stop time
+     CALL ESMF_TimeGet(stopTime, yy=year, mm=month, dd=day, &
+                       h=hour, m=minute, s=second, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_TimeGet(stopTime) failed' )
+     ENDIF
+     timevals(1) = year
+     timevals(2) = month
+     timevals(3) = day
+     timevals(4) = hour
+     timevals(5) = minute
+     timevals(6) = second
+     CALL ESMF_StateSetAttribute(state, 'ComponentStopTime', &
+                                 SIZE(timevals), timevals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(ComponentStopTime) failed' )
+     ENDIF
+     ! coupling time step
+     CALL ESMF_TimeIntervalGet(couplingInterval, yy=year, mm=month, d=day, &
+                               h=hour, m=minute, s=second, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_TimeIntervalGet(couplingInterval) failed' )
+     ENDIF
+     timevals(1) = year
+     timevals(2) = month
+     timevals(3) = day
+     timevals(4) = hour
+     timevals(5) = minute
+     timevals(6) = second
+     CALL ESMF_StateSetAttribute(state, 'ComponentCouplingInterval', &
+                                 SIZE(timevals), timevals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(ComponentCouplingInterval) failed' )
+     ENDIF
+   END SUBROUTINE AttachTimesToState
+
+
+
+   ! Extract time information attached as meta-data from a single 
+   ! ESMF_State.  
+   ! Update later to use some form of meta-data standards/conventions for 
+   ! model "time" meta-data.  
+   SUBROUTINE GetTimesFromState( state, startTime, stopTime, couplingInterval )
+     TYPE(ESMF_State),        INTENT(IN   ) :: state
+     TYPE(ESMF_Time),         INTENT(INOUT) :: startTime
+     TYPE(ESMF_Time),         INTENT(INOUT) :: stopTime
+     TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
+     ! locals
+     INTEGER :: rc
+     INTEGER :: year, month, day, hour, minute, second
+     INTEGER(ESMF_KIND_I4) :: timevals(6)   ! big enough to hold the vars listed above
+     ! start time
+     CALL ESMF_StateGetAttribute(state, 'ComponentStartTime', &
+                                 SIZE(timevals), timevals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(ComponentStartTime) failed' )
+     ENDIF
+     year   = timevals(1)
+     month  = timevals(2)
+     day    = timevals(3)
+     hour   = timevals(4)
+     minute = timevals(5)
+     second = timevals(6)
+     CALL ESMF_TimeSet(startTime, yy=year, mm=month, dd=day, &
+                       h=hour, m=minute, s=second, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_TimeSet(startTime) failed' )
+     ENDIF
+     ! stop time
+     CALL ESMF_StateGetAttribute(state, 'ComponentStopTime', &
+                                 SIZE(timevals), timevals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(ComponentStopTime) failed' )
+     ENDIF
+     year   = timevals(1)
+     month  = timevals(2)
+     day    = timevals(3)
+     hour   = timevals(4)
+     minute = timevals(5)
+     second = timevals(6)
+     CALL ESMF_TimeSet(stopTime, yy=year, mm=month, dd=day, &
+                       h=hour, m=minute, s=second, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_TimeSet(stopTime) failed' )
+     ENDIF
+     ! coupling time step
+     CALL ESMF_StateGetAttribute(state, 'ComponentCouplingInterval', &
+                                 SIZE(timevals), timevals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(ComponentCouplingInterval) failed' )
+     ENDIF
+     year   = timevals(1)
+     month  = timevals(2)
+     day    = timevals(3)
+     hour   = timevals(4)
+     minute = timevals(5)
+     second = timevals(6)
+     CALL ESMF_TimeIntervalSet(couplingInterval, yy=year, mm=month, d=day, &
+                               h=hour, m=minute, s=second, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_TimeIntervalSet(couplingInterval) failed' )
+     ENDIF
+   END SUBROUTINE GetTimesFromState
+
+
+
+   ! Extract time information attached as meta-data from one or more 
+   ! ESMF_States.  To use this with more than one ESMF_State, put the 
+   ! ESMF_States into a single ESMF_State.  If times differ, an attempt 
+   ! is made to reconcile them.  
+   SUBROUTINE GetTimesFromStates( state, startTime, stopTime, couplingInterval )
+     TYPE(ESMF_State),        INTENT(IN   ) :: state
+     TYPE(ESMF_Time),         INTENT(INOUT) :: startTime
+     TYPE(ESMF_Time),         INTENT(INOUT) :: stopTime
+     TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
+     ! locals
+     INTEGER :: rc
+     INTEGER :: numItems, numStates, i, istate
+     TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
+     TYPE(ESMF_State) :: tmpState
+     CHARACTER (len=ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
+     TYPE(ESMF_Time),         ALLOCATABLE :: startTimes(:)
+     TYPE(ESMF_Time),         ALLOCATABLE :: stopTimes(:)
+     TYPE(ESMF_TimeInterval), ALLOCATABLE :: couplingIntervals(:)
+
+!$$$unfortunately, implementing this is an extraordinary pain in the @ss due 
+!$$$to lack of sane iterators for ESMF_State!!!  @#$%!!  
+
+     ! Since there are no convenient iterators for ESMF_State (@#$%), 
+     ! write a lot of code...  
+     ! Figure out how many items are in the ESMF_State
+     CALL ESMF_StateGet(state, itemCount=numItems, rc=rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateGet(numItems) failed' )
+     ENDIF
+     ! allocate an array to hold the types of all items
+     ALLOCATE( itemTypes(numItems) )
+     ! allocate an array to hold the names of all items
+     ALLOCATE( itemNames(numItems) )
+     ! get the item types and names
+     CALL ESMF_StateGet(state, stateitemtypeList=itemTypes, &
+                        itemNameList=itemNames, rc=rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+       WRITE(str,*) 'ESMF_StateGet itemTypes failed with rc = ', rc
+       CALL wrf_error_fatal ( str )
+     ENDIF
+     ! count how many items are ESMF_States
+     numStates = 0
+     DO i=1,numItems
+       IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
+         numStates = numStates + 1
+       ENDIF
+     ENDDO
+     ALLOCATE( startTimes(numStates), stopTimes(numStates), &
+               couplingIntervals(numStates) )
+     IF ( numStates > 0) THEN
+       ! finally, extract nested ESMF_States by name, if there are any
+       ! (should be able to do this by index at least -- @#%$)
+       istate = 0
+       DO i=1,numItems
+         IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
+           CALL ESMF_StateGetState( state, nestedStateName=TRIM(itemNames(i)), &
+                                    nestedState=tmpState, rc=rc )
+           IF ( rc /= ESMF_SUCCESS) THEN
+             WRITE(str,*) 'ESMF_StateGetState(',TRIM(itemNames(i)),') failed'
+             CALL wrf_error_fatal ( str )
+           ENDIF
+           istate = istate + 1
+           CALL GetTimesFromState( tmpState, startTimes(istate),         &
+                                             stopTimes(istate),          &
+                                             couplingIntervals(istate) )
+         ENDIF
+       ENDDO
+       CALL ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
+                            startTime,  stopTime,  couplingInterval )
+     ELSE
+       ! there are no nested ESMF_States so use parent state only
+       CALL GetTimesFromState( state, startTime, stopTime, &
+                               couplingInterval )
+     ENDIF
+
+     ! deallocate locals
+     DEALLOCATE( itemTypes )
+     DEALLOCATE( itemNames )
+     DEALLOCATE( startTimes, stopTimes, couplingIntervals )
+
+   END SUBROUTINE GetTimesFromStates
+
+
+   ! Reconcile all times and intervals in startTimes, stopTimes, and 
+   ! couplingIntervals and return the results in startTime, stopTime, and 
+   ! couplingInterval.  Abort if reconciliation is not possible.  
+   SUBROUTINE ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
+                              startTime,  stopTime,  couplingInterval )
+     TYPE(ESMF_Time),         INTENT(IN   ) :: startTimes(:)
+     TYPE(ESMF_Time),         INTENT(IN   ) :: stopTimes(:)
+     TYPE(ESMF_TimeInterval), INTENT(IN   ) :: couplingIntervals(:)
+     TYPE(ESMF_Time),         INTENT(INOUT) :: startTime
+     TYPE(ESMF_Time),         INTENT(INOUT) :: stopTime
+     TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
+     ! locals
+     INTEGER :: numTimes, numTimesTmp, i
+
+     ! how many sets of time info?
+     numTimes = SIZE(startTimes)
+     IF ( numTimes < 2 ) THEN
+       CALL wrf_error_fatal ( 'SIZE(startTimes) too small' )
+     ENDIF
+     numTimesTmp = SIZE(stopTimes)
+     IF ( numTimes /= numTimesTmp ) THEN
+       CALL wrf_error_fatal ( 'incorrect SIZE(stopTimes)' )
+     ENDIF
+     numTimesTmp = SIZE(couplingIntervals)
+     IF ( numTimes /= numTimesTmp ) THEN
+       CALL wrf_error_fatal ( 'incorrect SIZE(couplingIntervals)' )
+     ENDIF
+
+     ! reconcile
+!For now this is very simple.  Fancy it up later.  
+     DO i = 1, numTimes
+       IF ( i == 1 ) THEN
+         startTime = startTimes(i)
+         stopTime = stopTimes(i)
+         couplingInterval = couplingIntervals(i)
+       ELSE
+         IF ( startTimes(i) /= startTime ) THEN
+           CALL wrf_error_fatal ( 'ReconcileTimes:  inconsistent startTimes' )
+         ENDIF
+         IF ( stopTimes(i) /= stopTime ) THEN
+           CALL wrf_error_fatal ( 'ReconcileTimes:  inconsistent stopTimes' )
+         ENDIF
+         IF ( couplingIntervals(i) /= couplingInterval ) THEN
+           CALL wrf_error_fatal ( 'ReconcileTimes:  inconsistent couplingIntervals' )
+         ENDIF
+       ENDIF
+
+     ENDDO
+
+   END SUBROUTINE ReconcileTimes
+
+
+
+   !$$$ TBH:  Eliminate this once this information can be derived via other 
+   !$$$ TBH:  means.  
+   SUBROUTINE AttachDecompToState( state,                        & 
+                                   ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   ips, ipe, jps, jpe, kps, kpe, &
+                                   domdesc, bdy_mask )
+     TYPE(ESMF_State), INTENT(INOUT) :: state
+     INTEGER,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde
+     INTEGER,          INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
+     INTEGER,          INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
+     INTEGER,          INTENT(IN   ) :: domdesc
+     LOGICAL,          INTENT(IN   ) :: bdy_mask(4)
+     ! locals
+     INTEGER :: i, rc
+     ! big enough to hold the integer values listed above
+     INTEGER(ESMF_KIND_I4) :: intvals(19)
+     ! big enough to hold the logical values listed above
+     TYPE(ESMF_Logical) :: logvals(4)   ! #$%*ing insane
+
+     ! first the logicals
+     ! Usually, when writing an API for a target language, it is considered 
+     ! good practice to use native types of the target language in the 
+     ! interfaces.  
+     logvals = ESMF_FALSE
+     DO i = 1, SIZE(bdy_mask)
+       IF (bdy_mask(i)) THEN
+         logvals(i) = ESMF_TRUE
+       ENDIF
+     ENDDO
+     CALL ESMF_StateSetAttribute(state, 'DecompositionLogicals', &
+                                 SIZE(logvals), logvals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(DecompositionLogicals) failed' )
+     ENDIF
+     ! now the integers
+     intvals(1) = ids
+     intvals(2) = ide
+     intvals(3) = jds
+     intvals(4) = jde
+     intvals(5) = kds
+     intvals(6) = kde
+     intvals(7) = ims
+     intvals(8) = ime
+     intvals(9) = jms
+     intvals(10) = jme
+     intvals(11) = kms
+     intvals(12) = kme
+     intvals(13) = ips
+     intvals(14) = ipe
+     intvals(15) = jps
+     intvals(16) = jpe
+     intvals(17) = kps
+     intvals(18) = kpe
+     intvals(19) = domdesc
+     CALL ESMF_StateSetAttribute(state, 'DecompositionIntegers', &
+                                 SIZE(intvals), intvals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(DecompositionIntegers) failed' )
+     ENDIF
+   END SUBROUTINE AttachDecompToState
+
+
+
+   !$$$ TBH:  Eliminate this once this information can be derived via other 
+   !$$$ TBH:  means.  
+   SUBROUTINE GetDecompFromState( state,                        & 
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  ips, ipe, jps, jpe, kps, kpe, &
+                                  domdesc, bdy_mask )
+     TYPE(ESMF_State), INTENT(IN   ) :: state
+     INTEGER,          INTENT(  OUT) :: ids, ide, jds, jde, kds, kde
+     INTEGER,          INTENT(  OUT) :: ims, ime, jms, jme, kms, kme
+     INTEGER,          INTENT(  OUT) :: ips, ipe, jps, jpe, kps, kpe
+     INTEGER,          INTENT(  OUT) :: domdesc
+     LOGICAL,          INTENT(  OUT) :: bdy_mask(4)
+     ! locals
+     INTEGER :: i, rc
+     ! big enough to hold the integer values listed above
+     INTEGER(ESMF_KIND_I4) :: intvals(19)
+     ! big enough to hold the logical values listed above
+     TYPE(ESMF_Logical) :: logvals(4)   ! #$%*ing insane
+
+     ! first the logicals
+     CALL ESMF_StateGetAttribute(state, 'DecompositionLogicals', &
+                                 SIZE(logvals), logvals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(DecompositionLogicals) failed' )
+     ENDIF
+     ! Usually, when writing an API for a target language, it is considered 
+     ! good practice to use native types of the target language in the 
+     ! interfaces.  
+     bdy_mask = .FALSE.
+     DO i = 1, SIZE(logvals)
+       IF (logvals(i) == ESMF_TRUE) THEN
+         bdy_mask(i) = .TRUE.
+       ENDIF
+     ENDDO
+     ! now the integers
+     CALL ESMF_StateGetAttribute(state, 'DecompositionIntegers', &
+                                 SIZE(intvals), intvals, rc=rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(DecompositionIntegers) failed' )
+     ENDIF
+     ids = intvals(1)
+     ide = intvals(2)
+     jds = intvals(3)
+     jde = intvals(4)
+     kds = intvals(5)
+     kde = intvals(6)
+     ims = intvals(7)
+     ime = intvals(8)
+     jms = intvals(9)
+     jme = intvals(10)
+     kms = intvals(11)
+     kme = intvals(12)
+     ips = intvals(13)
+     ipe = intvals(14)
+     jps = intvals(15)
+     jpe = intvals(16)
+     kps = intvals(17)
+     kpe = intvals(18)
+     domdesc = intvals(19)
+   END SUBROUTINE GetDecompFromState
+
+
+
+END MODULE module_metadatautils
+
+
+
+MODULE module_wrf_component_top
+!<DESCRIPTION>
+! This module defines wrf_component_init1(), wrf_component_init2(), 
+! wrf_component_run(), and wrf_component_finalize() routines that are called 
+! when WRF is run as an ESMF component.  
+!</DESCRIPTION>
+
+   USE module_wrf_top
+   USE ESMF_Mod
+   USE module_esmf_extensions
+   USE module_metadatautils, ONLY: AttachTimesToState, AttachDecompToState
+
+
+
+   IMPLICIT NONE
+
+   ! everything is private by default
+   PRIVATE
+
+   ! Public entry points
+   PUBLIC wrf_component_init1
+   PUBLIC wrf_component_init2
+   PUBLIC wrf_component_run
+   PUBLIC wrf_component_finalize
+
+   ! private stuff
+   CHARACTER (ESMF_MAXSTR) :: str
+
+CONTAINS
+
+
+   SUBROUTINE wrf_component_init1( gcomp, importState, exportState, clock, rc )
+     TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: exportState
+     TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
+     INTEGER,                     INTENT(  OUT) :: rc
+!<DESCRIPTION>
+!     WRF component init routine, phase 1.  Passes relevant coupling 
+!     information back as metadata on exportState.  
+!
+!     The arguments are:
+!       gcomp           Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     ! Local variables
+     TYPE(ESMF_GridComp), POINTER :: p_gcomp
+     TYPE(ESMF_State),    POINTER :: p_importState
+     TYPE(ESMF_State),    POINTER :: p_exportState
+     TYPE(ESMF_Clock),    POINTER :: p_clock
+     ! Time hackery
+     TYPE(ESMF_Time) :: startTime
+     TYPE(ESMF_Time) :: stopTime
+     TYPE(ESMF_TimeInterval) :: couplingInterval
+     ! decomposition hackery
+     INTEGER :: ids, ide, jds, jde, kds, kde
+     INTEGER :: ims, ime, jms, jme, kms, kme
+     INTEGER :: ips, ipe, jps, jpe, kps, kpe
+     INTEGER :: domdesc
+     LOGICAL :: bdy_mask(4)
+     CHARACTER(LEN=256) :: couplingIntervalString
+
+     rc = ESMF_SUCCESS
+
+     p_gcomp => gcomp
+     p_importState => importState
+     p_exportState => exportState
+     p_clock => clock
+     ! NOTE:  It will be possible to remove this call once ESMF supports 
+     !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(), 
+     !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().  
+     CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
+                           exportState=p_exportState, clock=p_clock )
+
+     ! Call WRF "init" routine, suppressing call to init_modules(1) since 
+     ! it was already done by the AppDriver.  
+     CALL wrf_init( no_init1=.TRUE. )
+
+     ! For now, use settings from WRF component intialization to set up 
+     ! top-level clock.  Per suggestion from ESMF Core team, these are passed 
+     ! back as attributes on exportState.  
+     CALL wrf_clockprint( 100, head_grid%domain_clock, &
+            'DEBUG wrf_component_init1():  head_grid%domain_clock,' )
+     CALL ESMF_ClockGet(head_grid%domain_clock, startTime=startTime, &
+                        stopTime=stopTime, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_component_init1:  ESMF_ClockGet failed' )
+     ENDIF
+!     CALL wrf_debug( 100, 'DEBUG wrf_component_init1():  before wrf_findCouplingInterval' )
+     CALL wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
+!     CALL wrf_debug( 100, 'DEBUG wrf_component_init1():  after wrf_findCouplingInterval' )
+     CALL ESMF_TimeIntervalGet( couplingInterval, TimeString=couplingIntervalString, &
+                                rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_component_init1:  ESMF_TimeIntervalGet failed' )
+     ENDIF
+     CALL wrf_debug( 100, 'DEBUG wrf_component_init1():  couplingInterval = '//TRIM(couplingIntervalString) )
+     CALL AttachTimesToState( exportState, startTime, stopTime, couplingInterval )
+     CALL wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
+                             ims, ime, jms, jme, kms, kme, &
+                             ips, ipe, jps, jpe, kps, kpe, &
+                             domdesc, bdy_mask )
+     CALL AttachDecompToState( exportState,                  &
+                               ids, ide, jds, jde, kds, kde, &
+                               ims, ime, jms, jme, kms, kme, &
+                               ips, ipe, jps, jpe, kps, kpe, &
+                               domdesc, bdy_mask )
+
+   END SUBROUTINE wrf_component_init1
+
+
+
+   SUBROUTINE wrf_component_init2( gcomp, importState, exportState, clock, rc )
+     TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: exportState
+     TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
+     INTEGER,                     INTENT(  OUT) :: rc
+!<DESCRIPTION>
+!     WRF component init routine, phase 2.  Initializes importState and 
+!     exportState.  
+!
+!     The arguments are:
+!       gcomp           Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     ! Local variables
+     TYPE(ESMF_GridComp), POINTER :: p_gcomp
+     TYPE(ESMF_State),    POINTER :: p_importState
+     TYPE(ESMF_State),    POINTER :: p_exportState
+     TYPE(ESMF_Clock),    POINTER :: p_clock
+     ! Time hackery
+     TYPE(ESMF_Time) :: startTime
+     TYPE(ESMF_Time) :: stopTime
+     TYPE(ESMF_TimeInterval) :: couplingInterval
+     ! decomposition hackery
+     INTEGER :: ids, ide, jds, jde, kds, kde
+     INTEGER :: ims, ime, jms, jme, kms, kme
+     INTEGER :: ips, ipe, jps, jpe, kps, kpe
+     INTEGER :: domdesc
+     LOGICAL :: bdy_mask(4)
+     TYPE(ESMF_StateType) :: statetype
+     INTEGER :: itemCount, i
+     CHARACTER (ESMF_MAXSTR) :: statename
+     CHARACTER (ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
+     TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
+
+     CALL wrf_debug ( 100, 'wrf_component_init2():  begin' )
+     ! check exportState
+     CALL ESMF_StateGet( exportState, itemCount=itemCount, &
+                         statetype=statetype, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(exportState) failed" )
+     ENDIF
+     WRITE (str,*) 'wrf_component_init2: exportState itemCount = ', itemCount
+     CALL wrf_debug ( 100 , TRIM(str) )
+     IF ( statetype /= ESMF_STATE_EXPORT ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  exportState is not an export state" )
+     ENDIF
+     ! check importState
+     CALL ESMF_StateGet( importState, itemCount=itemCount, &
+                         statetype=statetype, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(importState) failed" )
+     ENDIF
+     WRITE (str,*) 'wrf_component_init2: importState itemCount = ', itemCount
+     CALL wrf_debug ( 100 , TRIM(str) )
+     IF ( statetype /= ESMF_STATE_IMPORT ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  importState is not an import state" )
+     ENDIF
+
+     p_gcomp => gcomp
+     p_importState => importState
+     p_exportState => exportState
+     p_clock => clock
+     ! NOTE:  It will be possible to remove this call once ESMF supports 
+     !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(), 
+     !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().  
+     CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
+                           exportState=p_exportState, clock=p_clock )
+
+
+     ! This bit of hackery causes wrf_component_run to advance the head_grid 
+     ! of WRF up to the point where import and export states have been 
+     ! initialized and then return.  
+     head_grid%return_after_training_io = .TRUE.
+     CALL wrf_component_run( gcomp, importState, exportState, clock, rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_component_init2:  wrf_component_run failed' )
+     ENDIF
+
+     ! examine importState
+     WRITE (str,*) 'wrf_component_init2: EXAMINING importState...'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL ESMF_StateGet( importState, itemCount=itemCount, &
+                         statetype=statetype, name=statename, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(importState) failed B" )
+     ENDIF
+     IF ( statetype /= ESMF_STATE_IMPORT ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  importState is not an import state" )
+     ENDIF
+     WRITE (str,*) 'wrf_component_init2: importState <',TRIM(statename), &
+                   '> itemCount = ', itemCount
+     CALL wrf_debug ( 100 , TRIM(str) )
+     ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
+     CALL ESMF_StateGet( importState, itemNameList=itemNames, &
+                         stateitemtypeList=itemTypes, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(importState) failed C" )
+     ENDIF
+     DO i=1, itemCount
+       IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
+         WRITE(str,*) 'wrf_component_init2: importState contains field <',TRIM(itemNames(i)),'>'
+         CALL wrf_debug ( 100 , TRIM(str) )
+       ENDIF
+     ENDDO
+     DEALLOCATE ( itemNames, itemTypes )
+     WRITE (str,*) 'wrf_component_init2: DONE EXAMINING importState...'
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     ! examine exportState
+     WRITE (str,*) 'wrf_component_init2: EXAMINING exportState...'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL ESMF_StateGet( exportState, itemCount=itemCount, &
+                         statetype=statetype, name=statename, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(exportState) failed B" )
+     ENDIF
+     IF ( statetype /= ESMF_STATE_EXPORT ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  exportState is not an export state" )
+     ENDIF
+     WRITE (str,*) 'wrf_component_init2: exportState <',TRIM(statename), &
+                   '> itemCount = ', itemCount
+     CALL wrf_debug ( 100 , TRIM(str) )
+     ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
+     CALL ESMF_StateGet( exportState, itemNameList=itemNames, &
+                         stateitemtypeList=itemTypes, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(exportState) failed C" )
+     ENDIF
+     DO i=1, itemCount
+       IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
+         WRITE(str,*) 'wrf_component_init2: exportState contains field <',TRIM(itemNames(i)),'>'
+         CALL wrf_debug ( 100 , TRIM(str) )
+       ENDIF
+     ENDDO
+     DEALLOCATE ( itemNames, itemTypes )
+     WRITE (str,*) 'wrf_component_init2: DONE EXAMINING exportState...'
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     CALL wrf_debug ( 100, 'DEBUG wrf_component_init2():  end' )
+
+   END SUBROUTINE wrf_component_init2
+
+
+
+   SUBROUTINE wrf_component_run( gcomp, importState, exportState, clock, rc )
+     TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState, exportState
+     TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
+     INTEGER,                     INTENT(  OUT) :: rc
+!<DESCRIPTION>
+!     WRF component run routine.
+!
+!     The arguments are:
+!       gcomp           Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     ! Local variables
+     TYPE(ESMF_GridComp), POINTER :: p_gcomp
+     TYPE(ESMF_State),    POINTER :: p_importState
+     TYPE(ESMF_State),    POINTER :: p_exportState
+     TYPE(ESMF_Clock),    POINTER :: p_clock
+     ! timing
+     TYPE(ESMF_Time) :: currentTime, nextTime
+     TYPE(ESMF_TimeInterval) :: runLength     ! how long to run in this call
+     CHARACTER(LEN=256) :: timeStr
+
+     CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  begin' )
+
+     p_gcomp => gcomp
+     p_importState => importState
+     p_exportState => exportState
+     p_clock => clock
+     ! NOTE:  It will be possible to remove this call once ESMF supports 
+     !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(), 
+     !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().  
+     CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
+                           exportState=p_exportState, clock=p_clock )
+
+     ! connect ESMF clock with WRF domain clock
+     CALL ESMF_ClockGet( clock, currTime=currentTime, timeStep=runLength, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_component_run:  ESMF_ClockGet failed' )
+     ENDIF
+     CALL wrf_clockprint(100, clock, &
+            'DEBUG wrf_component_run():  clock,')
+     nextTime = currentTime + runLength
+     head_grid%start_subtime = currentTime
+     head_grid%stop_subtime = nextTime
+     CALL wrf_timetoa ( head_grid%start_subtime, timeStr )
+     WRITE (str,*) 'wrf_component_run:  head_grid%start_subtime ',TRIM(timeStr)
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL wrf_timetoa ( head_grid%stop_subtime, timeStr )
+     WRITE (str,*) 'wrf_component_run:  head_grid%stop_subtime ',TRIM(timeStr)
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     ! Call WRF "run" routine
+     CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  calling wrf_run()' )
+     CALL wrf_run( )
+     CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  back from wrf_run()' )
+
+     ! This bit of hackery will cause the next call to wrf_run() to 
+     ! resume advance of the head_grid from the point where import and 
+     ! export states were initialized.  When grid%return_after_training_io 
+     ! is .TRUE., wrf_run() returns right after import and export states 
+     ! are initialized.  This hack is triggered in wrf_component_init2.
+     IF ( head_grid%return_after_training_io ) THEN
+       head_grid%return_after_training_io = .FALSE.
+     ENDIF
+
+     CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  end' )
+
+   END SUBROUTINE wrf_component_run
+
+
+
+   SUBROUTINE wrf_component_finalize( gcomp, importState, exportState, clock, rc )
+     TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState, exportState
+     TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
+     INTEGER,                     INTENT(  OUT) :: rc
+!<DESCRIPTION>
+!     WRF component finalize routine.
+!
+!     The arguments are:
+!       gcomp           Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     ! Local variables
+     TYPE(ESMF_GridComp), POINTER :: p_gcomp
+     TYPE(ESMF_State),    POINTER :: p_importState
+     TYPE(ESMF_State),    POINTER :: p_exportState
+     TYPE(ESMF_Clock),    POINTER :: p_clock
+     INTEGER :: rc
+     p_gcomp => gcomp
+     p_importState => importState
+     p_exportState => exportState
+     p_clock => clock
+     ! NOTE:  It will be possible to remove this call once ESMF supports 
+     !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(), 
+     !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().  
+     CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
+                           exportState=p_exportState, clock=p_clock )
+
+     ! Call WRF "finalize" routine, suppressing call to MPI_FINALIZE so 
+     ! ESMF can do it (if needed) during ESMF_Finalize().  
+     CALL wrf_finalize( no_shutdown=.TRUE. )
+
+     rc = ESMF_SUCCESS
+
+   END SUBROUTINE wrf_component_finalize
+
+
+
+   SUBROUTINE wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
+     TYPE(ESMF_Time),         INTENT(IN   ) :: startTime
+     TYPE(ESMF_Time),         INTENT(IN   ) :: stopTime
+     TYPE(ESMF_TimeInterval), INTENT(  OUT) :: couplingInterval
+!<DESCRIPTION>
+!     WRF convenience routine for deducing coupling interval.  The startTime 
+!     and stopTime arguments are only used for determining a default value 
+!     when coupling is not actually being done.  
+!
+!     The arguments are:
+!       startTime          start time
+!       stopTime           stop time
+!       couplingInterval   coupling interval
+!</DESCRIPTION>
+     ! locals
+     LOGICAL :: foundcoupling
+     INTEGER :: rc
+     INTEGER :: io_form
+     ! external function prototype
+     INTEGER, EXTERNAL :: use_package
+
+     ! deduce coupling time-step
+     foundcoupling = .FALSE.
+!$$$here...  this bit just finds the FIRST case and extracts coupling interval
+!$$$here...  add error-checking for over-specification
+!$$$here...  add support for multiple coupling intervals later...  
+!$$$here...  add support for coupling that does not begin immediately later...  
+!$$$ get rid of this hideous duplication!!  
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput1( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT1_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT1_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput2( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT2_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT2_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput3( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT3_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT3_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput4( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT4_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT4_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput5( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT5_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT5_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput6( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT6_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT6_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput7( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT7_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT7_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput8( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT8_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT8_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput9( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT9_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT9_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_gfdda( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT10_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT10_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxinput11( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT11_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT11_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+
+
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist1( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST1_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST1_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist2( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST2_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST2_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist3( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST3_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST3_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist4( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST4_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST4_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist5( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST5_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST5_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist6( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST6_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST6_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist7( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST7_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST7_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist8( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST8_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST8_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist9( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST9_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST9_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist10( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST10_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST10_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+     IF ( .NOT. foundcoupling ) THEN
+       CALL nl_get_io_form_auxhist11( 1, io_form )
+       IF ( use_package( io_form ) == IO_ESMF ) THEN
+         CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST11_ALARM ), &
+                             RingInterval=couplingInterval, rc=rc )
+         IF ( rc /= ESMF_SUCCESS ) THEN
+           CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST11_ALARM) failed' )
+         ENDIF
+         foundcoupling = .TRUE.
+       ENDIF
+     ENDIF
+
+     ! look for erroneous use of io_form...  
+     CALL nl_get_io_form_restart( 1, io_form )
+     IF ( use_package( io_form ) == IO_ESMF ) THEN
+       CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF restart I/O' )
+     ENDIF
+     CALL nl_get_io_form_input( 1, io_form )
+     IF ( use_package( io_form ) == IO_ESMF ) THEN
+       CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF input' )
+     ENDIF
+     CALL nl_get_io_form_history( 1, io_form )
+     IF ( use_package( io_form ) == IO_ESMF ) THEN
+       CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF history output' )
+     ENDIF
+     CALL nl_get_io_form_boundary( 1, io_form )
+     IF ( use_package( io_form ) == IO_ESMF ) THEN
+       CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF boundary I/O' )
+     ENDIF
+
+     ! If nobody uses IO_ESMF, then default is to run WRF all the way to 
+     ! the end.  
+     IF ( .NOT. foundcoupling ) THEN
+       couplingInterval = stopTime - startTime
+       call wrf_debug ( 1, 'WARNING:  ESMF coupling not used in this WRF run' )
+     ENDIF
+
+   END SUBROUTINE wrf_findCouplingInterval
+
+
+
+   SUBROUTINE wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                                 domdesc, bdy_mask )
+     INTEGER, INTENT(OUT) :: ids, ide, jds, jde, kds, kde
+     INTEGER, INTENT(OUT) :: ims, ime, jms, jme, kms, kme
+     INTEGER, INTENT(OUT) :: ips, ipe, jps, jpe, kps, kpe
+     INTEGER, INTENT(OUT) :: domdesc
+     LOGICAL, INTENT(OUT) :: bdy_mask(4)
+!<DESCRIPTION>
+!     WRF convenience routine for deducing decomposition information.  
+!     Note that domdesc is meaningful only for SPMD serial operation.  
+!     For concurrent operation (SPMD or MPMD), we will need to create a new 
+!     "domdesc" suitable for the task layout of the SST component.  For 
+!     MPMD serial operation, we will need to serialize domdesc and store it 
+!     as metadata within the export state.  Similar arguments apply
+!     to [ij][mp][se] and bdy_mask.
+!
+!     The arguments are:
+!       ids, ide, jds, jde, kds, kde    Domain extent.  
+!       ims, ime, jms, jme, kms, kme    Memory extent.  
+!       ips, ipe, jps, jpe, kps, kpe    Patch extent.  
+!       domdesc                         Domain descriptor for external 
+!                                       distributed-memory communication 
+!                                       package (opaque to WRF).  
+!       bdy_mask                        Boundary mask flags indicating which 
+!                                       domain boundaries are on this task.  
+!</DESCRIPTION>
+     ! extract decomposition information from head_grid
+     CALL get_ijk_from_grid( head_grid ,                   &
+                             ids, ide, jds, jde, kds, kde, &
+                             ims, ime, jms, jme, kms, kme, &
+                             ips, ipe, jps, jpe, kps, kpe  )
+     domdesc = head_grid%domdesc
+     bdy_mask = head_grid%bdy_mask
+   END SUBROUTINE wrf_getDecompInfo
+
+
+END MODULE module_wrf_component_top
+
+
+
+
+MODULE module_wrf_setservices
+!<DESCRIPTION>
+! This module defines WRF "Set Services" method wrf_register() 
+! used for ESMF coupling.  
+!</DESCRIPTION>
+
+   USE module_wrf_component_top, ONLY: wrf_component_init1, &
+                                       wrf_component_init2, &
+                                       wrf_component_run,   &
+                                       wrf_component_finalize
+   USE ESMF_Mod
+
+   IMPLICIT NONE
+
+   ! everything is private by default
+   PRIVATE
+
+   ! Public entry point for ESMF_GridCompSetServices()
+   PUBLIC WRF_register
+
+   ! private stuff
+   CHARACTER (ESMF_MAXSTR) :: str
+
+CONTAINS
+
+
+   SUBROUTINE wrf_register(gcomp, rc)
+     TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp
+     INTEGER, INTENT(OUT) :: rc
+!
+!<DESCRIPTION>
+!     WRF_register - Externally visible registration routine
+!
+!     User-supplied SetServices routine.
+!     The Register routine sets the subroutines to be called
+!     as the init, run, and finalize routines.  Note that these are
+!     private to the module.
+!
+!     The arguments are:
+!       gcomp           Component
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     rc = ESMF_SUCCESS
+     ! Register the callback routines.
+     call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
+                                     wrf_component_init1, 1, rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+        CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_init1) failed' )
+     ENDIF
+     call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
+                                     wrf_component_init2, 2, rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+        CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_init2) failed' )
+     ENDIF
+     call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, &
+                                     wrf_component_run, ESMF_SINGLEPHASE, rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+        CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_run) failed' )
+     ENDIF
+     call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETFINAL, &
+                                     wrf_component_finalize, ESMF_SINGLEPHASE, rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+        CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_finalize) failed' )
+     ENDIF
+     PRINT *,'WRF:  Registered Initialize, Run, and Finalize routines'
+
+   END SUBROUTINE wrf_register
+
+END MODULE module_wrf_setservices
+
Index: trunk/WRF.COMMON/WRFV2/main/wrf_SST_ESMF.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/main/wrf_SST_ESMF.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/main/wrf_SST_ESMF.F	(revision 2744)
@@ -0,0 +1,2049 @@
+!WRF:DRIVER_LAYER:MAIN
+!
+
+!<DESCRIPTION>
+! ESMF Application Wrapper for coupling WRF with a "dummy" component 
+! that simply reads SSTs from a file, sends to WRF, receives SST from 
+! WRF (two-way coupling). and checks that the SSTs match.  
+!
+! This file contains the main program and associated modules for the 
+! SST "dummy" component and a simple coupler.  It creates ESMF Gridded 
+! and Coupler Components.  
+!
+! This source file is only built when ESMF coupling is used.  
+!
+!</DESCRIPTION>
+
+
+
+!<DESCRIPTION>
+! Modules module_sst_component_top and module_sst_setservices define the 
+! "SST" dummy component.  
+!</DESCRIPTION>
+
+MODULE module_sst_component_top
+!<DESCRIPTION>
+! This module defines sst_component_init1(), sst_component_init2(), 
+! sst_component_run1(), sst_component_run2(), and sst_component_finalize() 
+! routines that are called when SST is run as an ESMF component.  
+!</DESCRIPTION>
+
+   USE ESMF_Mod
+   USE module_esmf_extensions
+   USE module_metadatautils, ONLY: AttachTimesToState
+
+
+   IMPLICIT NONE
+
+   ! everything is private by default
+   PRIVATE
+
+   ! Public entry points
+   PUBLIC sst_component_init1
+   PUBLIC sst_component_init2
+   PUBLIC sst_component_run1
+   PUBLIC sst_component_run2
+   PUBLIC sst_component_finalize
+
+   ! private stuff
+   TYPE(ESMF_Grid), SAVE :: esmfgrid  ! grid used in fields
+   CHARACTER (4096) :: str
+   INTEGER, SAVE :: fid               ! file handle
+   ! decomposition information
+   INTEGER, SAVE :: ids, ide, jds, jde, kds, kde
+   INTEGER, SAVE :: ims, ime, jms, jme, kms, kme
+   INTEGER, SAVE :: ips, ipe, jps, jpe, kps, kpe
+!$$$here...  change names to remove tmp_ ...  
+   REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_sst(:,:)
+   REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_landmask(:,:)
+   REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_sst(:,:)
+   REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_landmask(:,:)
+!$$$DEBUG
+   PUBLIC :: ids, ide, jds, jde, kds, kde
+   PUBLIC :: ims, ime, jms, jme, kms, kme
+   PUBLIC :: ips, ipe, jps, jpe, kps, kpe
+!$$$END DEBUG
+   INTEGER, SAVE :: domdesc
+   LOGICAL, SAVE :: bdy_mask(4)
+   ! MPI communicator, if needed
+   INTEGER, SAVE :: mpicom
+   ! field data
+   REAL, POINTER, SAVE :: file_landmask_data(:,:), file_sst_data(:,:)
+   ! input data file name
+   CHARACTER ( ESMF_MAXSTR ), SAVE :: sstinfilename
+   ! field names
+   INTEGER, PARAMETER :: datacount = 2
+   INTEGER, PARAMETER :: SST_INDX = 1
+   INTEGER, PARAMETER :: LANDMASK_INDX = 2
+   CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount)
+   TYPE real2d
+     REAL, POINTER :: r2d(:,:)
+   END TYPE real2d
+   TYPE(real2d) :: this_data(datacount)
+
+
+CONTAINS
+
+
+
+   ! First-phase "init" reads "SST" data file and returns "time" metadata in 
+   ! exportState.  
+   SUBROUTINE sst_component_init1( gcomp, importState, exportState, clock, rc )
+     USE module_io
+     TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: exportState
+     TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
+     INTEGER,                     INTENT(  OUT) :: rc
+!<DESCRIPTION>
+!     SST component init routine, phase 1.
+!
+!     The arguments are:
+!       gcomp           Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+#ifdef DM_PARALLEL
+     INCLUDE 'mpif.h'
+#endif
+
+     ! Local variables
+     CHARACTER (LEN=19) :: date_string
+#ifdef DM_PARALLEL
+     TYPE(ESMF_VM) :: vm
+     INTEGER :: mpicomtmp
+#endif
+     TYPE(ESMF_Time) :: startTime, stopTime, currentTime, dataTime
+     TYPE(ESMF_TimeInterval) :: timeStep
+     INTEGER :: ierr, num_steps, time_loop_max
+     INTEGER :: status_next_var
+
+     !$$$ For now, sstinfilename is hard-coded
+     !$$$ Upgrade to use a variant of construct_filename() via startTime 
+     !$$$ extracted from clock.  
+     sstinfilename = 'sstin_d01_000000'
+
+     ! get MPI communicator out of current VM and duplicate (if needed)
+#ifdef DM_PARALLEL
+     CALL ESMF_VMGetCurrent(vm, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'sst_component_init1:  ESMF_VMGetCurrent failed' )
+     ENDIF
+     CALL ESMF_VMGet(vm, mpiCommunicator=mpicomtmp, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'sst_component_init1:  ESMF_VMGet failed' )
+     ENDIF
+     CALL MPI_Comm_dup( mpicomtmp, mpicom, ierr )
+#else
+     mpicom = 0
+#endif
+     !  Open the "SST" input data file for reading.
+     write(str,'(A,A)') 'Subroutine sst_component_init1: Opening data file ', &
+       TRIM(sstinfilename)
+     CALL wrf_message ( TRIM(str) )
+     CALL wrf_open_for_read ( TRIM(sstinfilename) , &
+                              mpicom ,              &
+                              mpicom ,              &
+                              "DATASET=INPUT" ,     &
+                              fid ,                 &
+                              ierr )
+     IF ( ierr .NE. 0 ) THEN
+        WRITE( str , FMT='(A,A,A,I8)' ) &
+          'subroutine sst_component_init1: error opening ', &
+          TRIM(sstinfilename),' for reading ierr=',ierr
+        CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+     WRITE( str , FMT='(A,A,A,I8)' ) &
+       'subroutine sst_component_init1: opened file ', &
+       TRIM(sstinfilename),' for reading fid=',fid
+     CALL wrf_debug ( 100, TRIM(str) )
+
+     ! How many data time levels are in the SST input file?  
+     num_steps = -1
+     time_loop_max = 0
+     CALL wrf_debug    ( 100, 'subroutine sst_component_init1: find time_loop_max' )
+     ! compute SST start time, time step, and end time here
+     get_the_right_time : DO
+        CALL wrf_get_next_time ( fid, date_string, status_next_var )
+        write(str,'(A,A)') 'Subroutine sst_component_init1: SST data startTime: ', &
+          date_string
+        CALL wrf_debug ( 100 , TRIM(str) )
+        IF ( status_next_var == 0 ) THEN
+           IF ( time_loop_max == 0 ) THEN
+             CALL wrf_atotime( date_string, startTime )
+           ELSEIF ( time_loop_max == 1 ) THEN
+             ! assumes fixed time step!
+             CALL wrf_atotime( date_string, dataTime )
+             timeStep = dataTime - startTime
+           ENDIF
+           time_loop_max = time_loop_max + 1
+           CALL wrf_atotime( date_string, stopTime )
+        ELSE
+           EXIT get_the_right_time
+        ENDIF
+     END DO get_the_right_time
+     CALL wrf_timetoa ( stopTime, date_string )
+     write(str,'(A,A)') 'Subroutine sst_component_init1: SST data stopTime: ', &
+       date_string
+     CALL wrf_debug ( 100 , TRIM(str) )
+     ! attach times to exportState for use by driver
+     CALL AttachTimesToState( exportState, startTime, stopTime, timeStep )
+
+     ! There should be a more elegant way to get to the beginning of the 
+     ! file, but this will do.
+     CALL wrf_ioclose( fid , ierr )
+     IF ( ierr .NE. 0 ) THEN
+        CALL wrf_error_fatal ( 'sst_component_init1:  wrf_ioclose failed' )
+     ENDIF
+     WRITE( str , FMT='(A,I8)' ) &
+       'subroutine sst_component_init1: closed file fid=',fid
+     CALL wrf_debug ( 100, TRIM(str) )
+
+     ! set up field names
+!$$$ use CF conventions for "standard_name" once WRF Registry supports them
+!$$$     datanames(SST_INDX) = "sea_surface_temperature"
+!$$$     datanames(LANDMASK_INDX) = "land_binary_mask"
+     datanames(SST_INDX) = "SST"
+     datanames(LANDMASK_INDX) = "LANDMASK"
+
+     rc = ESMF_SUCCESS
+
+   END SUBROUTINE sst_component_init1
+
+
+
+   SUBROUTINE read_data( exportState, clock )
+     USE module_io
+     TYPE(ESMF_State), INTENT(INOUT) :: exportState
+     TYPE(ESMF_Clock), INTENT(IN   ) :: clock
+!<DESCRIPTION>
+!     Reads data from file and stores.  Then 
+!     stuffs the file data into the SST exportState.  
+!</DESCRIPTION>
+
+     #include <wrf_status_codes.h>
+     #include <wrf_io_flags.h>
+
+     ! Local variables
+     CHARACTER (LEN=19) :: date_string
+     TYPE(ESMF_Time) :: currentTime, dataTime
+     REAL(ESMF_KIND_R4), POINTER :: out_sst_ptr(:,:), out_landmask_ptr(:,:)
+     TYPE(ESMF_Field) :: out_sst_field, out_landmask_field
+     TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
+     INTEGER :: i, j
+     CHARACTER(LEN=ESMF_MAXSTR) :: fieldname, debugmsg, errormsg, timestr
+     INTEGER :: ierr
+     INTEGER :: rc
+
+     ! This call to wrf_get_next_time will position the dataset over the next 
+     ! time-frame in the file and return the date_string, which is used as an 
+     ! argument to the read_field routines in the blocks of code included 
+     ! below.  
+
+     CALL wrf_get_next_time( fid, date_string , ierr )
+     WRITE(str,'(A,A)') 'Subroutine read_data: SST data time: ', &
+       date_string
+     CALL wrf_debug ( 100 , TRIM(str) )
+     IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND.  &
+          ierr .NE. WRF_WARN_DRYRUN_READ ) THEN
+       CALL wrf_error_fatal ( "... May have run out of valid SST data ..." )
+     ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. &
+               ierr .NE. WRF_WARN_DRYRUN_READ) THEN
+       ! check input time against current time (which will be start time at 
+       ! beginning)
+       CALL wrf_atotime( date_string, dataTime )
+       CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
+       IF (rc /= ESMF_SUCCESS) THEN
+         CALL wrf_error_fatal ( 'read_data:  ESMF_ClockGet() failed' )
+       ENDIF
+       CALL wrf_clockprint(150, clock, &
+              'DEBUG read_data():  get currentTime from clock,')
+       IF ( dataTime .NE. currentTime ) THEN
+           CALL wrf_timetoa ( dataTime, timestr )
+           WRITE( errormsg , * )'Time in file: ',trim( timestr )
+           CALL wrf_message ( trim(errormsg) )
+           CALL wrf_timetoa ( currentTime, timestr )
+           WRITE( errormsg , * )'Time on domain: ',trim( timestr )
+           CALL wrf_message ( trim(errormsg) )
+           CALL wrf_error_fatal( &
+             "**ERROR** Time in input file not equal to time on domain **ERROR**" )
+       ENDIF
+     ENDIF
+
+     ! doing this in a loop only works if staggering is the same for all fields
+     this_data(SST_INDX)%r2d => file_sst_data
+     this_data(LANDMASK_INDX)%r2d => file_landmask_data
+     DO i=1, datacount
+       fieldname = TRIM(datanames(i))
+       debugmsg  = 'ext_read_field '//TRIM(fieldname)//' memorder XY'
+       errormsg  = 'could not read '//TRIM(fieldname)//' data from file'
+       CALL wrf_ext_read_field (    &
+              fid                 , &  ! DataHandle
+              date_string         , &  ! DateStr
+              TRIM(fieldname)     , &  ! Data Name
+              this_data(i)%r2d    , &  ! Field
+              WRF_REAL            , &  ! FieldType
+              mpicom              , &  ! Comm
+              mpicom              , &  ! I/O Comm
+              domdesc             , &  ! Domain descriptor
+              bdy_mask            , &  ! bdy_mask
+              'XY'                , &  ! MemoryOrder
+              ''                  , &  ! Stagger
+              TRIM(debugmsg)      , &  ! Debug message
+              ids , (ide-1) , jds , (jde-1) , 1 , 1 , &
+              ims , ime , jms , jme , 1 , 1         , &
+              ips , MIN( (ide-1), ipe ) , jps , MIN( (jde-1), jpe ) , 1 , 1 , &
+              ierr )
+       IF (ierr /= 0) THEN
+         CALL wrf_error_fatal ( TRIM(errormsg) )
+       ENDIF
+     ENDDO
+
+     ! stuff fields into exportState
+!$$$ change this to Bundles, eventually
+     CALL ESMF_StateGetField( exportState, TRIM(datanames(SST_INDX)), &
+                              out_sst_field, rc=rc )
+     IF (rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( &
+         'could not find sea_surface_temperature field in exportState' )
+     ENDIF
+     CALL ESMF_StateGetField( exportState, TRIM(datanames(LANDMASK_INDX)), &
+                              out_landmask_field, rc=rc )
+     IF (rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( &
+         'could not find land_binary_mask field in exportState' )
+     ENDIF
+     CALL ESMF_FieldGetDataPointer( out_sst_field, out_sst_ptr, rc=rc )
+     IF (rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( &
+         'could not find sea_surface_temperature data in sea_surface_temperature field' )
+     ENDIF
+     CALL ESMF_FieldGetDataPointer( out_landmask_field, out_landmask_ptr, rc=rc )
+     IF (rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( &
+         'could not find land_binary_mask data in land_binary_mask field' )
+     ENDIF
+     ! staggered starts/ends
+     DO j= jps , MIN( (jde-1), jpe )
+       DO i= ips , MIN( (ide-1), ipe )
+         out_sst_ptr(i,j) = file_sst_data(i,j)
+         out_landmask_ptr(i,j) = file_landmask_data(i,j)
+       ENDDO
+     ENDDO
+
+   END SUBROUTINE read_data
+
+
+
+
+   SUBROUTINE compare_data( importState, clock )
+     TYPE(ESMF_State), INTENT(INOUT) :: importState
+!$$$ remove clock after debugging is finished
+     TYPE(ESMF_Clock), INTENT(INOUT) :: clock
+!<DESCRIPTION>
+!     Gets data from coupler via importState 
+!     and compares with data read from file and 
+!     error-exits if they differ.  
+!
+!     The arguments are:
+!       importState     Importstate
+!</DESCRIPTION>
+
+     ! Local variables
+     TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
+     REAL(ESMF_KIND_R4), POINTER :: in_sst_ptr(:,:), in_landmask_ptr(:,:)
+     REAL, POINTER :: in_sst_ptr_real(:,:), in_landmask_ptr_real(:,:)
+     INTEGER :: i, j
+     INTEGER :: rc
+     LOGICAL :: landmask_ok, sst_ok
+!$$$DEBUG
+TYPE(ESMF_Time) :: currentTime
+INTEGER, SAVE :: numtimes=0   ! track number of calls
+CHARACTER(LEN=256) :: timestamp
+!$$$END DEBUG
+
+!$$$DEBUG
+! count calls...
+CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
+IF (rc /= ESMF_SUCCESS) THEN
+  CALL wrf_error_fatal ( 'compare_data:  ESMF_ClockGet() failed' )
+ENDIF
+CALL wrf_timetoa ( currentTime, timestamp )
+numtimes = numtimes + 1
+WRITE(str,*) 'SST compare_data:  begin, numtimes = ',numtimes,' time = ',TRIM(timestamp)
+CALL wrf_debug ( 100 , TRIM(str) )
+!$$$END DEBUG
+
+     ! extract data from the importState and compare with data from file
+!$$$ change this to Bundles, eventually
+     CALL ESMF_StateGetField( importState, TRIM(datanames(SST_INDX)), &
+                              in_sst_field, rc=rc )
+     IF (rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( &
+         'could not extract sea_surface_temperature field from importState' )
+     ENDIF
+     CALL ESMF_StateGetField( importState, TRIM(datanames(LANDMASK_INDX)), &
+                              in_landmask_field, rc=rc )
+     IF (rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( &
+         'could not extract land_binary_mask field from importState' )
+     ENDIF
+     CALL ESMF_FieldGetDataPointer( in_sst_field, in_sst_ptr, rc=rc )
+     IF (rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( &
+         'could not extract sea_surface_temperature data from sea_surface_temperature field' )
+     ENDIF
+     ALLOCATE( in_sst_ptr_real(ims:ime,jms:jme) )
+     WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ',           &
+       ips,':',ipe,',',jps,':',jpe,                               &
+       ', in_sst_ptr(BOUNDS) = ',                                 &
+       LBOUND(in_sst_ptr,1),':',UBOUND(in_sst_ptr,1),',',         &
+       LBOUND(in_sst_ptr,2),':',UBOUND(in_sst_ptr,2)
+     CALL wrf_debug ( 100 , TRIM(str) )
+     DO j= jms, jme
+       DO i= ims, ime
+         in_sst_ptr_real(i,j) = -(i*1000.0 + j)/100000.0     ! obvious bad value for debugging
+       ENDDO
+     ENDDO
+     in_sst_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = &
+          in_sst_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe))
+     CALL ESMF_FieldGetDataPointer( in_landmask_field, in_landmask_ptr, rc=rc )
+     IF (rc /= ESMF_SUCCESS) THEN
+       CALL wrf_error_fatal ( &
+         'could not extract land_binary_mask data from land_binary_mask field' )
+     ENDIF
+     ALLOCATE( in_landmask_ptr_real(ims:ime,jms:jme) )
+     WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ',             &
+       ips,':',ipe,',',jps,':',jpe,                                 &
+       ', in_landmask_ptr(BOUNDS) = ',                              &
+       LBOUND(in_landmask_ptr,1),':',UBOUND(in_landmask_ptr,1),',', &
+       LBOUND(in_landmask_ptr,2),':',UBOUND(in_landmask_ptr,2)
+     CALL wrf_debug ( 100 , TRIM(str) )
+     DO j= jms, jme
+       DO i= ims, ime
+         in_landmask_ptr_real(i,j) = -(i*1000.0 + j)/100000.0     ! obvious bad value for debugging
+       ENDDO
+     ENDDO
+     in_landmask_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = &
+          in_landmask_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe))
+
+     ! compare LANDMASK...  
+     landmask_ok = .TRUE.
+     ! staggered starts/ends
+     LANDMASK_COMPARE : DO j= jps , MIN( (jde-1), jpe )
+       DO i= ips , MIN( (ide-1), ipe )
+         IF ( file_landmask_data(i,j) /= in_landmask_ptr_real(i,j) ) THEN
+           landmask_ok = .FALSE.
+           WRITE( str , * ) 'error landmask mismatch at (i,j) = (',i,',',j, &
+                            '), values are',file_landmask_data(i,j),' and ',     &
+                            in_landmask_ptr_real(i,j) 
+           EXIT LANDMASK_COMPARE
+         ENDIF
+       ENDDO
+     ENDDO LANDMASK_COMPARE
+!$$$DEBUG
+!CALL wrf_debug( 100, 'compare_data:  writing DEBUG1_SSTcmp_FILE_LANDMASK_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_SSTcmp_FILE_LANDMASK_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a)') 'LANDMASK'
+!DO j = jps, MIN( (jde-1), jpe )
+!  DO i = ips, MIN( (ide-1), ipe )
+!    WRITE (985,*) '(',i,',',j,'):  ',file_landmask_data(i,j)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!CALL wrf_debug( 100, 'compare_data:  writing DEBUG1_SSTcmp_FROM_WRF_LANDMASK_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_SSTcmp_FROM_WRF_LANDMASK_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a)') 'LANDMASK'
+!DO j = jps, MIN( (jde-1), jpe )
+!  DO i = ips, MIN( (ide-1), ipe )
+!    WRITE (985,*) '(',i,',',j,'):  ',in_landmask_ptr_real(i,j)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!$$$END DEBUG
+     IF ( landmask_ok ) THEN
+       WRITE(str,*) 'compare_data: LANDMASK compares OK'
+       CALL wrf_debug ( 100 , TRIM(str) )
+     ELSE
+       CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+
+     ! compare SST...  
+     sst_ok = .TRUE.
+     ! staggered starts/ends
+     SST_COMPARE : DO j= jps , MIN( (jde-1), jpe )
+       DO i= ips , MIN( (ide-1), ipe )
+         IF ( file_sst_data(i,j) /= in_sst_ptr_real(i,j) ) THEN
+           sst_ok = .FALSE.
+           WRITE( str , * ) 'error sst mismatch at (i,j) = (',i,',',j, &
+                            '), values are',file_sst_data(i,j),' and ',     &
+                            in_sst_ptr_real(i,j) 
+           EXIT SST_COMPARE
+         ENDIF
+       ENDDO
+     ENDDO SST_COMPARE
+!$$$DEBUG
+!CALL wrf_debug( 100, 'compare_data:  writing DEBUG1_SSTcmp_FILE_SST_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_SSTcmp_FILE_SST_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a)') 'SST'
+!DO j = jps, MIN( (jde-1), jpe )
+!  DO i = ips, MIN( (ide-1), ipe )
+!    WRITE (985,*) '(',i,',',j,'):  ',file_sst_data(i,j)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!CALL wrf_debug( 100, 'compare_data:  writing DEBUG1_SSTcmp_FROM_WRF_SST_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_SSTcmp_FROM_WRF_SST_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a)') 'SST'
+!DO j = jps, MIN( (jde-1), jpe )
+!  DO i = ips, MIN( (ide-1), ipe )
+!    WRITE (985,*) '(',i,',',j,'):  ',in_sst_ptr_real(i,j)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!$$$END DEBUG
+     IF ( sst_ok ) THEN
+       WRITE(str,*) 'compare_data: SST compares OK'
+       CALL wrf_debug ( 100 , TRIM(str) )
+     ELSE
+       CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+
+     DEALLOCATE( in_sst_ptr_real, in_landmask_ptr_real )
+
+!$$$DEBUG
+WRITE(str,*) 'compare_data:  end, numtimes = ',numtimes
+CALL wrf_debug ( 100 , TRIM(str) )
+!$$$END DEBUG
+
+   END SUBROUTINE compare_data
+
+
+
+
+   ! Second-phase "init" gets decomposition information from 
+   ! importState.  
+   SUBROUTINE sst_component_init2( gcomp, importState, exportState, clock, rc )
+     USE module_metadatautils, ONLY: GetDecompFromState
+     USE module_io
+     TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: exportState
+     TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
+     INTEGER,                     INTENT(  OUT) :: rc
+!<DESCRIPTION>
+!     SST component init routine, phase 2.
+!
+!     The arguments are:
+!       gcomp           Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     ! Local variables
+     TYPE(ESMF_RelLoc) :: horzRelloc
+     TYPE(ESMF_Field) :: out_sst_field, out_landmask_field
+     TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
+     INTEGER, PARAMETER :: NUMDIMS=2
+     INTEGER :: DomainStart(NUMDIMS)
+     INTEGER :: DomainEnd(NUMDIMS)
+     INTEGER :: MemoryStart(NUMDIMS)
+     INTEGER :: MemoryEnd(NUMDIMS)
+     INTEGER :: PatchStart(NUMDIMS)
+     INTEGER :: PatchEnd(NUMDIMS)
+     INTEGER :: rc, i, j
+     INTEGER :: ierr
+
+    ! Get decomposition information from importState.  Note that index 
+    ! values are for staggered dimensions, following the WRF convention.  
+!$$$ TBH:  Note that this will only work for SPMD serial operation.  For 
+!$$$ TBH:  concurrent operation (SPMD or MPMD), we will need to create a new 
+!$$$ TBH:  "domdesc" suitable for the task layout of the SST component.  For
+!$$$ TBH:  MPMD serial operation, we will need to extract serialized domdesc 
+!$$$ TBH:  from export state metadata and de-serialize it.  Similar arguments 
+!$$$ TBH:  apply to [ij][mp][se] and bdy_mask.  
+     write(str,*) 'sst_component_init2: calling GetDecompFromState'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL GetDecompFromState( importState,                  &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              domdesc, bdy_mask )
+     write(str,*) 'sst_component_init2: back from GetDecompFromState'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     write(str,*) 'sst_component_init2: ids, ide, jds, jde, kds, kde = ', ids, ide, jds, jde, kds, kde
+     CALL wrf_debug ( 100 , TRIM(str) )
+     write(str,*) 'sst_component_init2: ims, ime, jms, jme, kms, kme = ', ims, ime, jms, jme, kms, kme
+     CALL wrf_debug ( 100 , TRIM(str) )
+     write(str,*) 'sst_component_init2: ips, ipe, jps, jpe, kps, kpe = ', ips, ipe, jps, jpe, kps, kpe
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     ! allocate space for data read from disk
+     ALLOCATE( file_sst_data     (ims:ime,jms:jme) )
+     DO j= jms, jme
+       DO i= ims, ime
+         file_sst_data(i,j) = -(i*1000.0 + j)/100000.0     ! obvious bad value for debugging
+       ENDDO
+     ENDDO
+!$$$  Hmmm...  really need to load these pointers here?  Check...  
+     this_data(SST_INDX)%r2d => file_sst_data
+     ALLOCATE( file_landmask_data(ims:ime,jms:jme) )
+     DO j= jms, jme
+       DO i= ims, ime
+         file_landmask_data(i,j) = -(i*1000.0 + j)/100000.0     ! obvious bad value for debugging
+       ENDDO
+     ENDDO
+     this_data(LANDMASK_INDX)%r2d => file_landmask_data
+
+     ! Create ESMF_Fields in importState and exportState
+     ! Create ESMF_Grid.  Use exactly the same method as WRF so WRFIO will 
+     ! work (ugh).  
+     DomainStart(1) = ids; DomainEnd(1) = ide;
+     DomainStart(2) = jds; DomainEnd(2) = jde;
+     MemoryStart(1) = ims; MemoryEnd(1) = ime;
+     MemoryStart(2) = jms; MemoryEnd(2) = jme;
+     PatchStart(1)  = ips; PatchEnd(1)  = ipe;
+     PatchStart(2)  = jps; PatchEnd(2)  = jpe
+     CALL wrf_debug ( 5 , 'DEBUG sst_component_init2:  Calling ioesmf_create_grid_int()' )
+     CALL ioesmf_create_grid_int( esmfgrid, NUMDIMS,      &
+                                  DomainStart, DomainEnd, &
+                                  MemoryStart, MemoryEnd, &
+                                  PatchStart, PatchEnd )
+     CALL wrf_debug ( 5 , 'DEBUG sst_component_init2:  back from ioesmf_create_grid_int()' )
+     ! create ESMF_Fields
+     !$$$ use CF standard_names later
+     !$$$here...  This is a complete HACK!!  Need to communicate horzrelloc 
+     !$$$here...  during init sometime...  
+     horzrelloc=ESMF_CELL_CENTER
+     ! Note use of patch dimension for POINTERs allocated by ESMF.  
+     CALL wrf_debug ( 5 , 'DEBUG sst_component_init2:  Calling ESMF_GridValidate(esmfgrid)' )
+     CALL ESMF_GridValidate( esmfgrid, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       WRITE( str,* ) 'Error in ESMF_GridValidate ',   &
+                      __FILE__ ,                       &
+                      ', line ',                       &
+                      __LINE__ ,                       &
+                      ', error code = ',rc
+! TBH:  debugging error exit here...
+       CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+     CALL wrf_debug ( 5 , 'DEBUG sst_component_init2:  back OK from ESMF_GridValidate(esmfgrid)' )
+!TBH     ! let ESMF allocate tmp_data_out_sst
+!TBH     ! Note that ESMF will deallocate it when the internal ESMF_Array object 
+!TBH     ! is explicitly destroyed.  Assuming that we can figure out how to safely 
+!TBH     ! destroy it!!!  (And we have gone around and around on this one.  @#$%!)  
+!BELAY THAT:  do it ourselves for now...
+     ALLOCATE( tmp_data_out_sst(ips:ipe,jps:jpe) )
+     write(str,*) 'sst_component_init2: tmp_data_out_sst(', &
+       LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',',LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2),')'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_sst_field)' )
+     out_sst_field = ESMF_FieldCreate(                 &
+                       esmfgrid, tmp_data_out_sst,     &
+                       copyflag=ESMF_DATA_REF,         &
+                       horzrelloc=horzrelloc,          &
+                       name=TRIM(datanames(SST_INDX)), &
+!                       lbounds=(/ips,jps/),            &
+!                       ubounds=(/ipe,jpe/),            &
+                       rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) failed ', &
+                      __FILE__ ,                                 &
+                      ', line ',                                 &
+                      __LINE__ ,                                 &
+                      ', error code = ',rc
+       CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+     CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_sst_field)' )
+     write(str,*) 'sst_component_init2: ips:ipe,jps:jpe = ', &
+       ips,':',ipe,',',jps,':',jpe
+     CALL wrf_debug ( 100 , TRIM(str) )
+     ! validate ESMF allocation
+     IF ( ( ips /= LBOUND(tmp_data_out_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_sst,1) ) .OR. &
+          ( jps /= LBOUND(tmp_data_out_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_sst,2) ) ) THEN
+       WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) allocation failed ', &
+                      __FILE__ ,                                            &
+                      ', line ',                                            &
+                      __LINE__ ,                                            &
+                      ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe,   &
+                      ', tmp_data_out_sst(BOUNDS) = ',LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',', &
+                                              LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2)
+       CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+!TBH     ! let ESMF allocate tmp_data_out_landmask
+!TBH     ! Note that ESMF will deallocate it when the internal ESMF_Array object 
+!TBH     ! is explicitly destroyed.  Assuming that we can figure out how to safely 
+!TBH     ! destroy it!!!  (And we have gone around and around on this one.  @#$%!)  
+!BELAY THAT:  do it ourselves for now...
+     ALLOCATE( tmp_data_out_landmask(ips:ipe,jps:jpe) )
+     write(str,*) 'sst_component_init2: tmp_data_out_landmask(', &
+       LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',',LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2),')'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_landmask_field)' )
+     out_landmask_field = ESMF_FieldCreate(                      &
+                            esmfgrid, tmp_data_out_landmask,     &
+                            copyflag=ESMF_DATA_REF,              &
+                            horzrelloc=horzrelloc,               &
+                            name=TRIM(datanames(LANDMASK_INDX)), &
+!                            lbounds=(/ips,jps/),                 &
+!                            ubounds=(/ipe,jpe/),                 &
+                            rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_FieldCreate(out_landmask_field) failed' )
+     ENDIF
+     CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_landmask_field)' )
+     ! validate ESMF allocation
+     IF ( ( ips /= LBOUND(tmp_data_out_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_landmask,1) ) .OR. &
+          ( jps /= LBOUND(tmp_data_out_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_landmask,2) ) ) THEN
+       WRITE( str,* ) 'ESMF_FieldCreate(out_landmask_field) allocation failed ', &
+                      __FILE__ ,                                            &
+                      ', line ',                                            &
+                      __LINE__ ,                                            &
+                      ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe,   &
+                      ', tmp_data_out_landmask(BOUNDS) = ',LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',', &
+                                              LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2)
+       CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+!TBH     ! let ESMF allocate tmp_data_in_sst
+!TBH     ! Note that ESMF will deallocate it when the internal ESMF_Array object 
+!TBH     ! is explicitly destroyed.  Assuming that we can figure out how to safely 
+!TBH     ! destroy it!!!  (And we have gone around and around on this one.  @#$%!)  
+!BELAY THAT:  do it ourselves for now...
+     ALLOCATE( tmp_data_in_sst(ips:ipe,jps:jpe) )
+     write(str,*) 'sst_component_init2: tmp_data_in_sst(', &
+       LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',',LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2),')'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_sst_field)' )
+     in_sst_field = ESMF_FieldCreate(                 &
+                      esmfgrid, tmp_data_in_sst,      &
+                      copyflag=ESMF_DATA_REF,         &
+                      horzrelloc=horzrelloc,          &
+                      name=TRIM(datanames(SST_INDX)), &
+!                      lbounds=(/ips,jps/),            &
+!                      ubounds=(/ipe,jpe/),            &
+                      rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_sst_field) failed' )
+     ENDIF
+     CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_sst_field)' )
+     ! validate ESMF allocation
+     IF ( ( ips /= LBOUND(tmp_data_in_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_sst,1) ) .OR. &
+          ( jps /= LBOUND(tmp_data_in_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_sst,2) ) ) THEN
+       WRITE( str,* ) 'ESMF_FieldCreate(in_sst_field) allocation failed ', &
+                      __FILE__ ,                                            &
+                      ', line ',                                            &
+                      __LINE__ ,                                            &
+                      ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe,   &
+                      ', tmp_data_in_sst(BOUNDS) = ',LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',', &
+                                              LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2)
+       CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+!TBH     ! let ESMF allocate tmp_data_in_landmask
+!TBH     ! Note that ESMF will deallocate it when the internal ESMF_Array object 
+!TBH     ! is explicitly destroyed.  Assuming that we can figure out how to safely 
+!TBH     ! destroy it!!!  (And we have gone around and around on this one.  @#$%!)  
+!BELAY THAT:  do it ourselves for now...
+     ALLOCATE( tmp_data_in_landmask(ips:ipe,jps:jpe) )
+     write(str,*) 'sst_component_init2: tmp_data_in_landmask(', &
+       LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',',LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2),')'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_landmask_field)' )
+     in_landmask_field = ESMF_FieldCreate(                      &
+                           esmfgrid, tmp_data_in_landmask,      &
+                           copyflag=ESMF_DATA_REF,              &
+                           horzrelloc=horzrelloc,               &
+                           name=TRIM(datanames(LANDMASK_INDX)), &
+!                           lbounds=(/ips,jps/),                 &
+!                           ubounds=(/ipe,jpe/),                 &
+                           rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_landmask_field) failed' )
+     ENDIF
+     CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_landmask_field)' )
+     ! validate ESMF allocation
+     IF ( ( ips /= LBOUND(tmp_data_in_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_landmask,1) ) .OR. &
+          ( jps /= LBOUND(tmp_data_in_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_landmask,2) ) ) THEN
+       WRITE( str,* ) 'ESMF_FieldCreate(in_landmask_field) allocation failed ', &
+                      __FILE__ ,                                            &
+                      ', line ',                                            &
+                      __LINE__ ,                                            &
+                      ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe,   &
+                      ', tmp_data_in_landmask(BOUNDS) = ',LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',', &
+                                              LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2)
+       CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+
+     ! attach ESMF_Field to importState
+     CALL ESMF_StateAddField( importState, in_sst_field, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateAddField(in_sst_field) failed' )
+     ENDIF
+     CALL ESMF_StateAddField( importState, in_landmask_field, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateAddField(in_landmask_field) failed' )
+     ENDIF
+     ! attach ESMF_Field to exportState
+     CALL ESMF_StateAddField( exportState, out_sst_field, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateAddField(out_sst_field) failed' )
+     ENDIF
+     CALL ESMF_StateAddField( exportState, out_landmask_field, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'ESMF_StateAddField(out_landmask_field) failed' )
+     ENDIF
+
+     !  Open the "SST" input data file for reading.
+     write(str,'(A,A)') 'sst_component_init2: Opening data file ', &
+       TRIM(sstinfilename)
+     CALL wrf_message ( TRIM(str) )
+     CALL wrf_open_for_read ( TRIM(sstinfilename) , &
+                              mpicom ,              &
+                              mpicom ,              &
+                              "DATASET=INPUT" ,     &
+                              fid ,                 &
+                              ierr )
+     IF ( ierr .NE. 0 ) THEN
+       WRITE( str , FMT='(A,A,A,I8)' )  &
+         'sst_component_init2: error opening ', &
+         TRIM(sstinfilename),' for reading ierr=',ierr
+       CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+     WRITE( str , FMT='(A,A,A,I8)' ) &
+       'subroutine sst_component_init2: opened file ', &
+       TRIM(sstinfilename),' for reading fid=',fid
+     CALL wrf_debug ( 100, TRIM(str) )
+
+     write(str,'(A)') 'sst_component_init2: returning rc=ESMF_SUCCESS'
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     rc = ESMF_SUCCESS
+
+   END SUBROUTINE sst_component_init2
+
+
+
+   SUBROUTINE sst_component_run1( gcomp, importState, exportState, clock, rc )
+     TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState, exportState
+     TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
+     INTEGER,                     INTENT(  OUT) :: rc
+!<DESCRIPTION>
+!     SST component run routine, phase 1.
+!     Read "SST" data from file and stuff into exportState.  
+!
+!     The arguments are:
+!       gcomp           Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     rc = ESMF_SUCCESS
+
+     ! Get "SST" data from file and stuff it into exportState.  
+     CALL read_data( exportState, clock )
+
+   END SUBROUTINE sst_component_run1
+
+
+
+   SUBROUTINE sst_component_run2( gcomp, importState, exportState, clock, rc )
+     TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState, exportState
+     TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
+     INTEGER,                     INTENT(  OUT) :: rc
+!<DESCRIPTION>
+!     SST component run routine, phase 2.
+!     Get from importState, compare with file data, and error-exit 
+!     if they differ...  If they are the same, then 
+!     stuff the file data into the exportState.  
+!
+!     The arguments are:
+!       gcomp           Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     rc = ESMF_SUCCESS
+
+     ! Get from importState, compare with file data, and error_exit 
+     ! if they differ...  
+     ! This works because WRF loads its exportState BEFORE integrating.  
+     CALL wrf_clockprint ( 50, clock, 'sst_component_run2:  clock before call to compare_data()' )
+     CALL compare_data( importState, clock )
+     CALL wrf_clockprint ( 50, clock, 'sst_component_run2:  clock after call to compare_data()' )
+
+   END SUBROUTINE sst_component_run2
+
+
+
+   SUBROUTINE sst_component_finalize( gcomp, importState, exportState, clock, rc )
+     USE module_io
+     TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
+     TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState, exportState
+     TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
+     INTEGER,                     INTENT(  OUT) :: rc
+!<DESCRIPTION>
+!     SST component finalize routine.
+!
+!     The arguments are:
+!       gcomp           Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     ! Local variables
+     TYPE(ESMF_Field) :: tmp_field
+     INTEGER :: i, ierr
+
+     rc = ESMF_SUCCESS
+
+     ! destroy ESMF_Fields and other "deep" objects created by this component
+     ! note that this component relied on ESMF to allocate data pointers during 
+     ! calls to ESMF_FieldCreate() so it also expects ESMF to free these pointers 
+!$$$here...  remove duplication
+     DO i=1, datacount
+       ! destroy field in importState
+       CALL ESMF_StateGetField( importState, TRIM(datanames(i)), tmp_field, &
+                                rc=rc )
+       IF (rc /= ESMF_SUCCESS) THEN
+         WRITE( str , * )                                               &
+           'sst_component_finalize:  ESMF_StateGetField( importState,', &
+           TRIM(datanames(i)),') failed'
+         CALL wrf_error_fatal ( TRIM(str) )
+       ENDIF
+       CALL ESMF_FieldDestroy( tmp_field, rc=rc )
+       IF (rc /= ESMF_SUCCESS) THEN
+         WRITE( str , * )                                              &
+           'sst_component_finalize:  ESMF_FieldDestroy( importState,', &
+           TRIM(datanames(i)),') failed'
+         CALL wrf_error_fatal ( TRIM(str) )
+       ENDIF
+       ! destroy field in exportState
+       CALL ESMF_StateGetField( exportState, TRIM(datanames(i)), tmp_field, &
+                                rc=rc )
+       IF (rc /= ESMF_SUCCESS) THEN
+         WRITE( str , * )                                               &
+           'sst_component_finalize:  ESMF_StateGetField( exportState,', &
+           TRIM(datanames(i)),') failed'
+         CALL wrf_error_fatal ( TRIM(str) )
+       ENDIF
+       CALL ESMF_FieldDestroy( tmp_field, rc=rc )
+       IF (rc /= ESMF_SUCCESS) THEN
+         WRITE( str , * )                                              &
+           'sst_component_finalize:  ESMF_FieldDestroy( exportState,', &
+           TRIM(datanames(i)),') failed'
+         CALL wrf_error_fatal ( TRIM(str) )
+       ENDIF
+     ENDDO
+
+     ! deallocate space for data read from disk
+     DEALLOCATE( file_sst_data, file_landmask_data )
+
+     ! close SST data file
+     WRITE( str , FMT='(A,I8)' ) &
+       'subroutine sst_component_finalize: closing file fid=',fid
+     CALL wrf_debug ( 100, TRIM(str) )
+     CALL wrf_ioclose( fid , ierr )
+     IF ( ierr .NE. 0 ) THEN
+       CALL wrf_error_fatal ( 'sst_component_finalize:  wrf_ioclose failed' )
+     ENDIF
+
+   END SUBROUTINE sst_component_finalize
+
+
+END MODULE module_sst_component_top
+
+
+
+
+MODULE module_sst_setservices
+!<DESCRIPTION>
+! This module defines SST "Set Services" method sst_register() 
+! used for ESMF coupling.  
+!</DESCRIPTION>
+
+   USE module_sst_component_top, ONLY: sst_component_init1,  &
+                                       sst_component_init2,  &
+                                       sst_component_run1,   &
+                                       sst_component_run2,   &
+                                       sst_component_finalize
+   USE ESMF_Mod
+
+   IMPLICIT NONE
+
+   ! everything is private by default
+   PRIVATE
+
+   ! Public entry point for ESMF_GridCompSetServices()
+   PUBLIC SST_register
+
+   ! private stuff
+   CHARACTER (ESMF_MAXSTR) :: str
+
+CONTAINS
+
+
+   SUBROUTINE sst_register(gcomp, rc)
+     TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp
+     INTEGER, INTENT(OUT) :: rc
+     INTEGER :: finalrc
+!
+!<DESCRIPTION>
+!     SST_register - Externally visible registration routine
+!
+!     User-supplied SetServices routine.
+!     The Register routine sets the subroutines to be called
+!     as the init, run, and finalize routines.  Note that these are
+!     private to the module.
+!
+!     The arguments are:
+!       gcomp           Component
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+     finalrc = ESMF_SUCCESS
+     ! Register the callback routines.
+     call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
+                                     sst_component_init1, 1, rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+        WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init1) failed with rc = ', rc
+        CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+     call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
+                                     sst_component_init2, 2, rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+        WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init2) failed with rc = ', rc
+        CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+     call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, &
+                                     sst_component_run1, 1, rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+        WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run1) failed with rc = ', rc
+        CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+     call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, &
+                                     sst_component_run2, 2, rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+        WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run2) failed with rc = ', rc
+        CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+     call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETFINAL, &
+                                     sst_component_finalize, ESMF_SINGLEPHASE, rc)
+     IF ( rc /= ESMF_SUCCESS) THEN
+        WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_finalize) failed with rc = ', rc
+        CALL wrf_error_fatal ( TRIM(str) )
+     ENDIF
+
+     PRINT *,'SST:  Registered Initialize, Run, and Finalize routines'
+
+     rc = finalrc
+
+   END SUBROUTINE sst_register
+
+END MODULE module_sst_setservices
+
+
+
+!<DESCRIPTION>
+! Module module_wrfsst_coupler defines the 
+! "WRF-SST" coupler component.  It provides two-way coupling between 
+! the "SST" and "WRF" components.  
+! In its run routine it transfers data directly from the 
+! SST Component's export state to the WRF Component's import state.  
+! It also transfers data directly from the 
+! WRF Component's export state to the SST Component's import state.  
+!
+! This is derived from src/demo/coupled_flow/src/CouplerMod.F90
+! created by Nancy Collins and others on the ESMF Core Team.  
+!
+!</DESCRIPTION>
+
+MODULE module_wrfsst_coupler
+
+    USE ESMF_Mod
+
+    IMPLICIT NONE
+    
+    ! everything is private by default
+    PRIVATE
+
+    ! Public entry point 
+    PUBLIC WRFSSTCpl_register
+
+    ! private data members
+    ! route handles and flags
+    TYPE(ESMF_RouteHandle), SAVE :: fromWRF_rh, fromSST_rh
+    LOGICAL, SAVE :: fromWRF_rh_ready = .FALSE.
+    LOGICAL, SAVE :: fromSST_rh_ready = .FALSE.
+    ! field names
+    INTEGER, PARAMETER :: datacount = 2
+    INTEGER, PARAMETER :: SST_INDX = 1
+    INTEGER, PARAMETER :: LANDMASK_INDX = 2
+    CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount)
+    CHARACTER(LEN=ESMF_MAXSTR) :: str
+
+
+CONTAINS
+
+
+   SUBROUTINE WRFSSTCpl_register(comp, rc)
+     TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
+     INTEGER, INTENT(OUT) :: rc
+!
+!<DESCRIPTION>
+!     WRFSSTCpl_register - Externally visible registration routine
+!
+!     User-supplied SetServices routine.
+!     The Register routine sets the subroutines to be called
+!     as the init, run, and finalize routines.  Note that these are
+!     private to the module.
+!
+!     The arguments are:
+!       comp            Component
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+      ! guilty until proven innocent
+      rc = ESMF_FAILURE
+
+      ! Register the callback routines.
+
+      call ESMF_CplCompSetEntryPoint(comp, ESMF_SETINIT, WRFSSTCpl_init, &
+                                     ESMF_SINGLEPHASE, rc)
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_init) failed' )
+      ENDIF
+      call ESMF_CplCompSetEntryPoint(comp, ESMF_SETRUN, WRFSSTCpl_run, &
+                                     ESMF_SINGLEPHASE, rc)
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_run) failed' )
+      ENDIF
+      call ESMF_CplCompSetEntryPoint(comp, ESMF_SETFINAL, WRFSSTCpl_final, &
+                                     ESMF_SINGLEPHASE, rc)
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_final) failed' )
+      ENDIF
+
+      print *, "module_wrfsst_coupler: Registered Initialize, Run, and Finalize routines"
+
+    END SUBROUTINE WRFSSTCpl_register
+
+
+    SUBROUTINE WRFSSTCpl_init(comp, importState, exportState, clock, rc)
+      USE module_metadatautils, ONLY: AttachDecompToState, GetDecompFromState
+      TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
+      TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState
+      TYPE(ESMF_Clock), INTENT(INOUT) :: clock
+      INTEGER, INTENT(OUT) :: rc
+!<DESCRIPTION>
+!     WRF-SST coupler component init routine.  This simply passes needed 
+!     metadata from WRF to SST.  Initialization of ESMF_RouteHandle objects 
+!     is handled later via lazy evaluation.  
+!
+!     The arguments are:
+!       comp            Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+      ! Local variables
+      CHARACTER(ESMF_MAXSTR) :: importstatename
+      ! decomposition information
+      INTEGER :: ids, ide, jds, jde, kds, kde
+      INTEGER :: ims, ime, jms, jme, kms, kme
+      INTEGER :: ips, ipe, jps, jpe, kps, kpe
+      INTEGER :: domdesc
+      LOGICAL :: bdy_mask(4)
+
+      PRINT *, "DEBUG:  Coupler Init starting"
+
+      ! guilty until proven innocent
+      rc = ESMF_FAILURE
+
+      CALL ESMF_StateGet(importState, name=importstatename, rc=rc)
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal ( 'WRFSSTCpl_init:  ESMF_StateGet failed' )
+      ENDIF
+
+      IF ( TRIM(importstatename) .EQ. "WRF Export State" ) THEN
+        ! get metadata from WRF export state
+        CALL GetDecompFromState( importState,                  &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 ips, ipe, jps, jpe, kps, kpe, &
+                                 domdesc, bdy_mask )
+        ! put metadata from in SST import state
+        CALL AttachDecompToState( exportState,                  &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  ips, ipe, jps, jpe, kps, kpe, &
+                                  domdesc, bdy_mask )
+
+
+      ELSE
+        CALL wrf_error_fatal ( 'WRFSSTCpl_init:  invalid importState name' )
+      ENDIF
+
+      ! set up field names
+!$$$ use CF conventions for "standard_name" once WRF Registry supports them
+!$$$     datanames(SST_INDX) = "sea_surface_temperature"
+!$$$     datanames(LANDMASK_INDX) = "land_binary_mask"
+      datanames(SST_INDX) = "SST"
+      datanames(LANDMASK_INDX) = "LANDMASK"
+
+      PRINT *, "DEBUG:  Coupler Init returning"
+   
+    END SUBROUTINE WRFSSTCpl_init
+
+
+
+    SUBROUTINE WRFSSTCpl_run(comp, importState, exportState, clock, rc)
+!$$$DEBUG
+! get ips,ipe, ... from this hack for debugging
+      USE module_sst_component_top
+!$$$END DEBUG
+      TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
+      TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState
+      TYPE(ESMF_Clock), INTENT(INOUT) :: clock
+      INTEGER, INTENT(OUT) :: rc
+!<DESCRIPTION>
+!     WRF-SST coupler component run routine.
+!
+!     The arguments are:
+!       comp            Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+      ! Local variables
+      TYPE(ESMF_Field) :: src_field, dst_field
+      TYPE(ESMF_RouteHandle) :: routehandle
+      TYPE(ESMF_VM) :: vm
+      LOGICAL :: build_fromWRF_rh, build_fromSST_rh, fromWRF
+      CHARACTER(LEN=ESMF_MAXSTR) :: importStatename
+      CHARACTER(LEN=ESMF_MAXSTR) :: SST_exportStatename, WRF_exportStatename
+      INTEGER :: i
+!$$$DEBUG
+      TYPE(ESMF_Time) :: currentTime
+      CHARACTER(LEN=256) :: timestamp, directionString
+      INTEGER :: ii, jj
+      REAL(ESMF_KIND_R4), POINTER :: tmp_data_ptr(:,:)
+!$$$END DEBUG
+
+      WRITE(str,*) 'WRFSSTCpl_run: begin'
+      CALL wrf_debug ( 100 , TRIM(str) )
+
+!$$$DEBUG
+CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
+IF (rc /= ESMF_SUCCESS) THEN
+  CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_ClockGet() failed' )
+ENDIF
+CALL wrf_timetoa ( currentTime, timestamp )
+!$$$END DEBUG
+
+      ! guilty until proven innocent
+      rc = ESMF_FAILURE
+
+      ! Which way is this coupling going?  
+      WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateGet(importState,name,...)'
+      CALL wrf_debug ( 100 , TRIM(str) )
+      CALL ESMF_StateGet( importState, name=importStatename, rc=rc )
+      IF ( rc /= ESMF_SUCCESS ) THEN
+        CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_StateGet(importState,name,...) failed' )
+      ENDIF
+      WRITE(str,*) 'WRFSSTCpl_run: back from ESMF_StateGet, importStatename = <',TRIM(importStatename),'>'
+      CALL wrf_debug ( 100 , TRIM(str) )
+
+      ! first time through in each direction:  create route handle and 
+      ! associated objects
+      WRF_exportStatename = "WRF Export State"
+      SST_exportStatename = "SST Export State"
+      IF ( TRIM(importStatename) .EQ. TRIM(WRF_exportStatename) ) THEN
+        fromWRF = .TRUE.
+        directionString = 'WRFtoSST'
+      ELSE IF ( TRIM(importStatename) .EQ. TRIM(SST_exportStatename) ) THEN
+        fromWRF = .FALSE.
+        directionString = 'SSTtoWRF'
+      ELSE
+        CALL wrf_error_fatal ( 'WRFSSTCpl_run:  invalid importState name' )
+      ENDIF
+      WRITE(str,*) 'WRFSSTCpl_run: fromWRF = ',fromWRF
+      CALL wrf_debug ( 100 , TRIM(str) )
+      build_fromWRF_rh =         fromWRF   .AND. ( .NOT. fromWRF_rh_ready )
+      build_fromSST_rh = ( .NOT. fromWRF ) .AND. ( .NOT. fromSST_rh_ready )
+      WRITE(str,*) 'WRFSSTCpl_run: build_fromWRF_rh = ',build_fromWRF_rh
+      CALL wrf_debug ( 100 , TRIM(str) )
+      WRITE(str,*) 'WRFSSTCpl_run: build_fromSST_rh = ',build_fromSST_rh
+      CALL wrf_debug ( 100 , TRIM(str) )
+      IF ( build_fromWRF_rh .OR. build_fromSST_rh ) THEN
+        CALL ESMF_CplCompGet( comp, vm=vm, rc=rc )
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_CplCompGet failed' )
+        ENDIF
+        ! The use of literal index "1" here indicates that we don't care which 
+        ! ESMF_Field we get so we might as well get the first one.  
+!$$$ Right now, staggering of all fields is identical.  Do we need more than one 
+!$$$ routeHandle if there is more than one staggering?  
+        WRITE(str,*) 'WRFSSTCpl_run: grabbing first field <',TRIM(datanames(1)), &
+                     '> from import state'
+        CALL wrf_debug ( 100 , TRIM(str) )
+        CALL ESMF_StateGetField( importState, TRIM(datanames(1)), src_field, &
+                                 rc=rc )
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_StateGetField(importState) failed' )
+        ENDIF
+        WRITE(str,*) 'WRFSSTCpl_run: grabbing first field <',TRIM(datanames(1)), &
+                     '> from export state'
+        CALL wrf_debug ( 100 , TRIM(str) )
+        CALL ESMF_StateGetField( exportState, TRIM(datanames(1)), dst_field, &
+                                 rc=rc )
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_StateGetField(exportState) failed' )
+        ENDIF
+        IF ( build_fromWRF_rh ) THEN
+          WRITE(str,*) 'WRFSSTCpl_run: creating fromWRF_rh'
+          CALL wrf_debug ( 100 , TRIM(str) )
+          fromWRF_rh = ESMF_RouteHandleCreate( rc )
+          IF ( rc /= ESMF_SUCCESS ) THEN
+            CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_RouteHandleCreate(fromWRF_rh) failed' )
+          ENDIF
+          WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_FieldRedistStore(fromWRF_rh)'
+          CALL wrf_debug ( 100 , TRIM(str) )
+          CALL ESMF_FieldRedistStore( src_field, dst_field, vm, &
+                                      routehandle=fromWRF_rh, rc=rc )
+          IF ( rc /= ESMF_SUCCESS ) THEN
+            CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_FieldRedistStore(fromWRF_rh) failed' )
+          ENDIF
+          fromWRF_rh_ready = .TRUE.
+        ENDIF
+        IF ( build_fromSST_rh ) THEN
+          WRITE(str,*) 'WRFSSTCpl_run: creating fromSST_rh'
+          CALL wrf_debug ( 100 , TRIM(str) )
+          fromSST_rh = ESMF_RouteHandleCreate( rc )
+          IF ( rc /= ESMF_SUCCESS ) THEN
+            CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_RouteHandleCreate(fromSST_rh) failed' )
+          ENDIF
+          WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_FieldRedistStore(fromSST_rh)'
+          CALL wrf_debug ( 100 , TRIM(str) )
+          CALL ESMF_FieldRedistStore( src_field, dst_field, vm, &
+                                      routehandle=fromSST_rh, rc=rc )
+          IF ( rc /= ESMF_SUCCESS ) THEN
+            CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_FieldRedistStore(fromSST_rh) failed' )
+          ENDIF
+          fromSST_rh_ready = .TRUE.
+        ENDIF
+        DO i=1, datacount
+          WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateSetNeeded(importState, ',TRIM(datanames(i)),')'
+          CALL wrf_debug ( 100 , TRIM(str) )
+          CALL ESMF_StateSetNeeded( importState, TRIM(datanames(i)), &
+                                    ESMF_NEEDED, rc=rc )
+          IF ( rc /= ESMF_SUCCESS ) THEN
+            WRITE(str,*) 'WRFSSTCpl_run:  ESMF_StateSetNeeded(',TRIM(datanames(i)),') failed'
+            CALL wrf_error_fatal ( str )
+          ENDIF
+        ENDDO
+      ENDIF
+
+      ! In this case, the coupling is symmetric - you call redist going
+      ! both ways - so we only care about the coupling direction in order 
+      ! to get the right routehandle selected.
+      IF ( fromWRF ) THEN
+        WRITE(str,*) 'WRFSSTCpl_run: routehandle = fromWRF_rh'
+        CALL wrf_debug ( 100 , TRIM(str) )
+        routehandle = fromWRF_rh 
+      ELSE
+        WRITE(str,*) 'WRFSSTCpl_run: routehandle = fromSST_rh'
+        CALL wrf_debug ( 100 , TRIM(str) )
+        routehandle = fromSST_rh 
+      ENDIF
+
+      DO i=1, datacount
+        WRITE(str,*) 'WRFSSTCpl_run: grabbing field <',TRIM(datanames(i)),'>'
+        CALL wrf_debug ( 100 , TRIM(str) )
+        ! check isneeded flag here
+        IF ( .NOT. ESMF_StateIsNeeded( importState, TRIM(datanames(i)), rc=rc ) ) THEN 
+          IF ( rc /= ESMF_SUCCESS ) THEN
+            WRITE(str,*) 'WRFSSTCpl_run:  ESMF_StateIsNeeded(',TRIM(datanames(i)),') failed'
+            CALL wrf_error_fatal ( str )
+          ENDIF
+          WRITE(str,*) 'WRFSSTCpl_run: skipping field <',TRIM(datanames(i)),'>'
+          CALL wrf_debug ( 100 , TRIM(str) )
+          CYCLE
+        ENDIF
+
+        WRITE(str,*) 'WRFSSTCpl_run: processing field <',TRIM(datanames(i)),'>'
+        CALL wrf_debug ( 100 , TRIM(str) )
+
+!   The following piece of code provides an example of calling the data
+!   redistribution routine  between two Fields in the Coupler Component.  
+!   Unlike regrid, which translates between
+!   different Grids, redist translates between different DELayouts on
+!   the same Grid.   The first two lines get the Fields from the 
+!   States, each corresponding to a different subcomponent.  One is
+!   an Export State and the other is an Import State.
+!
+        WRITE(str,*) 'WRFSSTCpl_run:  calling ESMF_StateGetField(importState,', &
+                     TRIM(datanames(i)),')...'
+        CALL wrf_debug ( 100 , TRIM(str) )
+        CALL ESMF_StateGetField( importState, TRIM(datanames(i)), src_field, &
+                                 rc=rc )
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          WRITE(str,*) 'WRFSSTCpl_run:  ESMF_StateGetField(importState,', &
+                       TRIM(datanames(i)),') failed'
+          CALL wrf_error_fatal ( str )
+        ENDIF
+
+!$$$$ debugging...
+!$$$     CALL ESMF_CplCompRun(compCplWRFSST, exportStateSST, &
+!$$$                          importStateWRF, driverClock, rc=rc)
+!$$$ Why is LANDMASK not on importStateWRF?  May be moot now due to fix in Registry...  
+
+        WRITE(str,*) 'WRFSSTCpl_run:  calling ESMF_StateGetField(exportState,', &
+                     TRIM(datanames(i)),')...'
+        CALL wrf_debug ( 100 , TRIM(str) )
+        CALL ESMF_StateGetField( exportState, TRIM(datanames(i)), dst_field, &
+                                 rc=rc )
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          WRITE(str,*) 'WRFSSTCpl_run:  ESMF_StateGetField(exportState,', &
+                       TRIM(datanames(i)),') failed'
+          CALL wrf_error_fatal ( str )
+        ENDIF
+
+!   The redist routine uses information contained in the Fields and the
+!   Coupler VM object to call the communication routines to move the data.
+!   Because many Fields may share the same Grid association, the same
+!   routing information may be needed repeatedly.  Route information is 
+!   saved so the precomputed information can be retained.  The following 
+!   is an example of a Field redist call:
+!$$$DEBUG
+!CALL wrf_debug ( 100, 'WRFSSTCpl_run '//TRIM(directionString)//':  calling ESMF_FieldPrint( src_field )' )
+!CALL ESMF_FieldPrint( src_field, rc=rc )
+!CALL wrf_debug ( 100, 'WRFSSTCpl_run '//TRIM(directionString)//':  back from ESMF_FieldPrint( src_field )' )
+!CALL ESMF_FieldGetDataPointer( src_field, tmp_data_ptr, rc=rc )
+!IF (rc /= ESMF_SUCCESS) THEN
+!  WRITE(str,*) 'WRFSSTCpl_run '//TRIM(directionString)//':  ESMF_FieldGetDataPointer( src_field, '//TRIM(datanames(i))//' ) returned rc = ',rc
+!  CALL wrf_debug ( 100 , TRIM(str) )
+!  CALL wrf_error_fatal ( &
+!    'WRFSSTCpl_run '//TRIM(directionString)//':  ESMF_FieldGetDataPointer( src_field, ... ) failed' )
+!ENDIF
+!CALL wrf_debug( 100, 'WRFSSTCpl_run:  writing DEBUG1_CPLcmp_src_'//TRIM(directionString)//'_'//TRIM(datanames(i))//'_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_CPLcmp_src_'//TRIM(directionString)//'_'//TRIM(datanames(i))//'_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a)') TRIM(datanames(i))
+!DO jj = jps, MIN( (jde-1), jpe )
+!  DO ii = ips, MIN( (ide-1), ipe )
+!    WRITE (985,*) '(',ii,',',jj,'):  ',tmp_data_ptr(ii,jj)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!$$$END DEBUG
+        WRITE(str,*) 'WRFSSTCpl_run:  calling ESMF_FieldRedist for <', &
+                     TRIM(datanames(i)),'>...'
+        CALL wrf_debug ( 100 , TRIM(str) )
+        CALL ESMF_FieldRedist( src_field, dst_field, routehandle, rc=rc )
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          CALL wrf_error_fatal ( 'WRFSSTCpl_run:  ESMF_FieldRedist failed' )
+        ENDIF
+        WRITE(str,*) 'WRFSSTCpl_run:  back from ESMF_FieldRedist for <', &
+                     TRIM(datanames(i)),'>...'
+        CALL wrf_debug ( 100 , TRIM(str) )
+!$$$DEBUG
+!CALL wrf_debug ( 100, 'WRFSSTCpl_run '//TRIM(directionString)//':  calling ESMF_FieldPrint( dst_field )' )
+!CALL ESMF_FieldPrint( dst_field, rc=rc )
+!CALL wrf_debug ( 100, 'WRFSSTCpl_run '//TRIM(directionString)//':  back from ESMF_FieldPrint( dst_field )' )
+!CALL ESMF_FieldGetDataPointer( dst_field, tmp_data_ptr, rc=rc )
+!IF (rc /= ESMF_SUCCESS) THEN
+!  WRITE(str,*) 'WRFSSTCpl_run '//TRIM(directionString)//':  ESMF_FieldGetDataPointer( dst_field, '//TRIM(datanames(i))//' ) returned rc = ',rc
+!  CALL wrf_debug ( 100 , TRIM(str) )
+!  CALL wrf_error_fatal ( &
+!    'WRFSSTCpl_run '//TRIM(directionString)//':  ESMF_FieldGetDataPointer( dst_field, ... ) failed' )
+!ENDIF
+!CALL wrf_debug( 100, 'WRFSSTCpl_run:  writing DEBUG1_CPLcmp_dst_'//TRIM(directionString)//'_'//TRIM(datanames(i))//'_'//TRIM(timestamp) )
+!OPEN( UNIT=985, FILE='DEBUG1_CPLcmp_dst_'//TRIM(directionString)//'_'//TRIM(datanames(i))//'_'//TRIM(timestamp), FORM='formatted' )
+!WRITE (985,'(a)') TRIM(datanames(i))
+!DO jj = jps, MIN( (jde-1), jpe )
+!  DO ii = ips, MIN( (ide-1), ipe )
+!    WRITE (985,*) '(',ii,',',jj,'):  ',tmp_data_ptr(ii,jj)
+!  ENDDO
+!ENDDO
+!CLOSE (985)
+!$$$END DEBUG
+
+      ENDDO
+
+      WRITE(str,*) 'WRFSSTCpl_run: end'
+      CALL wrf_debug ( 100 , TRIM(str) )
+
+    END SUBROUTINE WRFSSTCpl_run
+
+
+
+    SUBROUTINE WRFSSTCpl_final(comp, importState, exportState, clock, rc)
+      TYPE(ESMF_CplComp) :: comp
+      TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState
+      TYPE(ESMF_Clock), INTENT(INOUT) :: clock
+      INTEGER, INTENT(OUT) :: rc
+!<DESCRIPTION>
+!     WRF-SST coupler component finalize routine.
+!
+!     The arguments are:
+!       comp            Component
+!       importState     Importstate
+!       exportState     Exportstate
+!       clock           External clock
+!       rc              Return code; equals ESMF_SUCCESS if there are no errors,
+!                       otherwise ESMF_FAILURE.
+!</DESCRIPTION>
+
+      PRINT *, "DEBUG:  Coupler Final starting"
+   
+      ! guilty until proven innocent
+      rc = ESMF_FAILURE
+
+      ! Only thing to do here is release redist and route handles
+      IF ( fromWRF_rh_ready ) THEN
+        CALL ESMF_FieldRedistRelease(fromWRF_rh, rc)
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          CALL wrf_error_fatal ( 'WRFSSTCpl_final:  ESMF_FieldRedistRelease(fromWRF_rh) failed' )
+        ENDIF
+        CALL ESMF_RouteHandleDestroy(fromWRF_rh, rc)
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          CALL wrf_error_fatal ( 'WRFSSTCpl_final:  ESMF_RouteHandleDestroy(fromWRF_rh) failed' )
+        ENDIF
+      ENDIF
+      IF ( fromSST_rh_ready ) THEN
+        CALL ESMF_FieldRedistRelease(fromSST_rh, rc)
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          CALL wrf_error_fatal ( 'WRFSSTCpl_final:  ESMF_FieldRedistRelease(fromSST_rh) failed' )
+        ENDIF
+        CALL ESMF_RouteHandleDestroy(fromSST_rh, rc)
+        IF ( rc /= ESMF_SUCCESS ) THEN
+          CALL wrf_error_fatal ( 'WRFSSTCpl_final:  ESMF_RouteHandleDestroy(fromSST_rh) failed' )
+        ENDIF
+      ENDIF
+
+      PRINT *, "DEBUG:  Coupler Final returning"
+   
+    END SUBROUTINE WRFSSTCpl_final
+
+
+END MODULE module_wrfsst_coupler
+    
+    
+
+
+PROGRAM wrf_SST_ESMF
+
+!$$$AAAA
+
+!$$$TBH:   update this documentation!  
+
+!<DESCRIPTION>
+! ESMF Application Wrapper for coupling WRF with a "dummy" component 
+! that simply reads SSTs from a file and sends them to WRF (one-way 
+! coupling).
+!
+! Note that, like other WRF coupling methods (MCEL, MCT), ESMF coupling is 
+! supported only via auxiliary input and history streams.  
+!
+! This is the main program that creates the ESMF Gridded and Coupler 
+! Component.  
+!
+! "init" looks like this:  
+!   1. Init phase 1 for WRF, sets WRF exportState metadata for "time" 
+!      and "domain" information needed by WRF IOAPI (which is called from 
+!      the SST component).  It also sets up all WRF and WSF modules.  Note 
+!      that this must be called before SST phase-1 init because SST uses 
+!      WRF IOAPI.  
+!   2. Init phase 1 for SST, sets "time" metadata in SST exportState.  
+!   3. Initialize coupler, passing decomposition metadata from WRF exportState 
+!      to SST importState.  
+!   4. Resolve any "time" metadata inconsistencies and create top-level clock.  
+!   5. Init phase 2 for SST, gets "domain" information from importState, 
+!      creates an ESMF_Grid based on "domain" information using the exact same 
+!      method as WRF (so WRF IOAPI calls will work), and sets up SST 
+!      importState and exportState.  
+!   6. Init phase 2 for WRF, runs up to the end of the head_grid I/O "training" 
+!      phase (done in med_before_solve_io()).  This initializes WRF 
+!      importState and exportState prior to the first coupling step during the 
+!      "run" loop.  Note that this only works for head_grid at present because 
+!      recursion in WRF traversal of subdomains is not dealt with yet and 
+!      because the code that populates the WRF importState and exportState is 
+!      not yet sophisticated enough to handle creating and destroying nested 
+!      domains at any time during the model run.  
+!$$$   NOTE:  At the moment, any ESMF auxio that does not begin at the start 
+!$$$          of the model run will FAIL due to the way WRF init phases have 
+!$$$          been split.  A solution would be to split the WRF run into two 
+!$$$          phases instead and run the first part, which will stop after 
+!$$$          "training", at the very start of the "run" loop".  The main 
+!$$$          implication of this change would be that WRF import and export 
+!$$$          states would not be valid until after first-phase run were 
+!$$$          called.  A nasty business either way.    TBH
+!
+!$$$here...  Note that we really need nested states, one for each auxio stream!!
+!$$$here...  For now, only support one input and/or one output stream via 
+!$$$here...  io_esmf.  This condition is asserted in 
+!$$$here...  ext_esmf_open_for_read_begin() and 
+!$$$here...  ext_esmf_open_for_write_begin().  
+!
+! "run" loop looks like this:  
+!   1. Run SST phase 1, reads SST from file and writes it to SST exportState 
+!      for coupling to WRF.  
+!   2. Couple SST exportState -> WRF importState.  First iteration:  set up 
+!      SST->WRF routeHandle via lazy evaluation.  
+!   3. Run WRF.  First iteration:  head_grid resumes after I/O "training" 
+!      phase.  Other iterations and domains:  run normally.  
+!      Read WRF importState and write WRF exportState (via med_before_solve_io()).  
+!      Note that WRF assigns sst -> tsk for sea points in 
+!      share/module_soil_pre.F.  
+!$$$here...  However, WRF does NOT assign tsk -> sst.  Do we need to send TSK 
+!$$$here...  from WRF too for self-test?  
+!$$$here...  eventually couple LANDMASK on first iteration only
+!$$$here...  For concurrent coupling, must break wrf_run into two phases, first 
+!$$$here...  phase returns after the call to med_before_solve_io(), second phase 
+!$$$here...  resumes after the call to med_before_solve_io().  This is 
+!$$$here...  *relatively* easy if we limit ESMF coupling to head_grid, but is 
+!$$$here...  NOT so easy otherwise due to recursion.  Also, we will need 
+!$$$here...  dynamic ESMF_States to couple to WRF nested domains since the 
+!$$$here...  nested domains may be created/destroyed at any time during the 
+!$$$here...  model run!  Not clear that using ESMF to couple directly to WRF 
+!$$$here...  nested domains is a small effort, and not clear that it is needed.  
+!
+!$$$  Note that moving init phase-2 to a first run phase and then splitting 
+!$$$  yet again after med_before_solve_io() would lead to three run phases for 
+!$$$  WRF.  One could argue that since the current "everyone calls everything" 
+!$$$  ESMF model for "concurrent components" is suboptimal for loosely-coupled 
+!$$$  concurrency anyway, we should aviod the split after 
+!$$$  med_before_solve_io(), limit ESMF use in WRF to sequential coupling, and 
+!$$$  use MCEL/MCT for concurrent coupling.  Food for thought...    TBH
+!
+!   4. Couple WRF exportState -> SST importState.  First iteration:  set up
+!      WRF->SST routeHandle via lazy evaluation.
+!   5. Run SST phase 2, compare SST from file with SST from WRF (via 
+!      SST importState) and error-exit if they differ.  
+!   6. Advance clock and goto step 1
+!
+! "finalize" is trivial, except for destruction of ESMF objects which is 
+! quite non-trivial at the moment.  
+!
+!</DESCRIPTION>
+
+!$$$ TBH:  Need to eliminate duplication between wrf_ESMFApp.F 
+!$$$ TBH:  and wrf_SST_ESMF.F.  
+
+   ! WRF registration routine
+   USE module_wrf_setservices, ONLY: WRF_register
+   ! SST registration routine
+   USE module_sst_setservices, ONLY: SST_register
+   ! WRF-SST coupler registration routine
+   USE module_wrfsst_coupler, ONLY: WRFSSTCpl_register
+   ! ESMF module, defines all ESMF data types and procedures
+   USE ESMF_Mod
+   ! Not-yet-implemented ESMF features
+   USE module_esmf_extensions
+   ! Component-independent utilities
+   USE module_metadatautils, ONLY: GetTimesFromStates
+
+   IMPLICIT NONE
+
+   ! Local variables
+
+   ! Components
+   TYPE(ESMF_GridComp) :: compGriddedWRF   ! WRF
+   TYPE(ESMF_GridComp) :: compGriddedSST   ! SST reader
+   TYPE(ESMF_CplComp) :: compCplWRFSST     ! WRF-SST coupler
+
+   ! State, Virtual Machine, and DELayout
+   TYPE(ESMF_VM) :: vm
+   TYPE(ESMF_State) :: importStateWRF, exportStateWRF
+   TYPE(ESMF_State) :: importStateSST, exportStateSST
+
+   ! A clock, some times, and a time step
+   TYPE(ESMF_Clock) :: driverClock
+   TYPE(ESMF_Time) :: startTime
+   TYPE(ESMF_Time) :: stopTime
+   TYPE(ESMF_TimeInterval) :: couplingInterval
+
+   ! other misc stuff
+   TYPE(ESMF_State) :: tmpState
+   INTEGER :: timestepdebug
+
+   ! Return codes for error checks
+   INTEGER :: rc
+   CHARACTER (ESMF_MAXSTR) :: str
+
+   ! debugging
+   CHARACTER(LEN=256) :: couplingIntervalString
+
+        
+   ! Warn users that this is not yet ready for general use.  
+   PRINT *, '                      W A R N I N G                          '
+   PRINT *, '  ESMF COUPLING CAPABILITY IS EXPERIMENTAL AND UNSUPPORTED   '
+   PRINT *, '               IN THIS VERSION OF WRF-SST                    '
+   PRINT *, '          U S E   A T   Y O U R   O W N   R I S K            '
+
+   ! This call includes everything that must be done before ESMF_Initialize()
+   ! is called.
+   CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
+
+   ! Initialize ESMF, get the default Global VM, and set
+   ! the default calendar to be Gregorian.
+   CALL ESMF_Initialize( vm=vm, defaultCalendar=ESMF_CAL_GREGORIAN, rc=rc )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_Initialize failed'
+   ENDIF
+   ! Note:  wrf_debug and wrf_error_fatal are not initialized yet
+   PRINT *, 'DEBUG wrf_SST_ESMF:  returned from ESMF_Initialize'
+   CALL ESMF_SetInitialized()   ! eliminate this once ESMF does it internally
+
+   ! Create the WRF Gridded Component, passing in the default VM.
+   compGriddedWRF = ESMF_GridCompCreate(vm, "WRF Model", rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_GridCompCreate(WRF Model) failed'
+   ENDIF
+
+   ! Create the SST Gridded Component, passing in the default VM.
+   compGriddedSST = ESMF_GridCompCreate(vm, "SST Dummy Model", rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_GridCompCreate(WRF Dummy Model) failed'
+   ENDIF
+
+   ! Create the WRF-SST Coupler Component, passing in the default VM.
+   compCplWRFSST = ESMF_CplCompCreate(vm, "WRF-SST Coupler", rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_CplCompCreate failed'
+   ENDIF
+
+   ! Create empty import and export states for WRF
+   importStateWRF = ESMF_StateCreate("WRF Import State", statetype=ESMF_STATE_IMPORT, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_StateCreate(WRF Import State) failed'
+   ENDIF
+   exportStateWRF = ESMF_StateCreate("WRF Export State", statetype=ESMF_STATE_EXPORT, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_StateCreate(WRF Export State) failed'
+   ENDIF
+
+   ! Create empty import and export states for SST
+   importStateSST = ESMF_StateCreate("SST Import State", statetype=ESMF_STATE_IMPORT, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_StateCreate(SST Import State) failed'
+   ENDIF
+   exportStateSST = ESMF_StateCreate("SST Export State", statetype=ESMF_STATE_EXPORT, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_StateCreate(SST Export State) failed'
+   ENDIF
+
+   ! Register the WRF Gridded Component
+   CALL ESMF_GridCompSetServices(compGriddedWRF, WRF_register, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_GridCompSetServices(compGriddedWRF) failed'
+   ENDIF
+
+   ! Register the SST Gridded Component
+   CALL ESMF_GridCompSetServices(compGriddedSST, SST_register, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_GridCompSetServices(compGriddedSST) failed'
+   ENDIF
+
+   ! Register the WRF-SST Coupler Component
+   CALL ESMF_CplCompSetServices(compCplWRFSST, WRFSSTCpl_register, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_CplCompSetServices failed'
+   ENDIF
+
+   ! Create top-level clock.  There is no way to create an "empty" clock, so 
+   ! stuff in bogus values for start time, stop time, and time step and fix 
+   ! them after gridded component "init" phases return.  
+   CALL ESMF_TimeSet(startTime, yy=2000, mm=1, dd=1, &
+                     h=0, m=0, s=0, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_TimeSet(startTime) failed'
+   ENDIF
+   CALL ESMF_TimeSet(stopTime, yy=2000, mm=1, dd=1, &
+                     h=12, m=0, s=0, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_TimeSet(stopTime) failed'
+   ENDIF
+   CALL ESMF_TimeIntervalSet(couplingInterval, s=2, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_TimeIntervalSet failed'
+   ENDIF
+   driverClock = ESMF_ClockCreate(timeStep=couplingInterval, &
+                                  startTime=startTime,       &
+                                  stopTime=stopTime, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     PRINT *, 'wrf_SST_ESMF:  ESMF_ClockCreate failed'
+   ENDIF
+
+   ! Init, Run, and Finalize section
+
+   ! Init...
+   ! initialize WRF, phase 1
+   ! Phase 1 init returns WRF time and decomposition information as
+   ! exportState metadata.
+   PRINT *, 'DEBUG wrf_SST_ESMF:  calling phase-1 WRF init (wrf_component_init1)'
+   CALL ESMF_GridCompInitialize(compGriddedWRF, importStateWRF, &
+                                exportStateWRF, driverClock, phase=1, rc=rc)
+   ! Note:  wrf_debug and wrf_error_fatal are now initialized
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompInitialize(WRF phase 1) failed' )
+   ENDIF
+
+   ! initialize SST, phase 1
+   ! Phase 1 init returns SST time information as
+   ! exportState metadata.
+   PRINT *, 'DEBUG wrf_SST_ESMF:  calling phase-1 SST init (sst_component_init1)'
+   CALL ESMF_GridCompInitialize(compGriddedSST, importStateSST, &
+                                exportStateSST, driverClock, phase=1, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompInitialize(SST phase 1) failed' )
+   ENDIF
+
+   ! Reconcile clock settings from WRF and SST components to set up 
+   ! top-level clock.  These are passed back from each "init" as attributes 
+   ! on exportState*.  
+   ! Stuff both States into a single State to pass into GetTimesFromStates() 
+   ! which is smart enough to deal with a Composite.  
+   PRINT *, 'DEBUG wrf_SST_ESMF:  reconciling clock from WRF and SST components'
+   tmpState = ESMF_StateCreate( rc=rc )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_StateCreate(tmpState) failed' )
+   ENDIF
+   CALL ESMF_StateAddState( tmpState, exportStateWRF, rc )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_StateAddState(exportStateWRF) failed' )
+   ENDIF
+   CALL ESMF_StateAddState( tmpState, exportStateSST, rc )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_StateAddState(exportStateSST) failed' )
+   ENDIF
+   CALL GetTimesFromStates( tmpState, startTime, stopTime, couplingInterval )
+   CALL ESMF_TimeIntervalGet( couplingInterval, TimeString=couplingIntervalString, &
+                              rc=rc )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_TimeIntervalGet failed' )
+   ENDIF
+   CALL wrf_debug( 100, 'wrf_SST_ESMF:  couplingInterval = '//TRIM(couplingIntervalString) )
+   CALL ESMF_StateDestroy( tmpState, rc )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_StateDestroy(tmpState) failed' )
+   ENDIF
+   ! update driver clock
+   CALL ESMF_ClockDestroy(driverClock, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_ClockDestroy failed' )
+   ENDIF
+   driverClock = ESMF_ClockCreate(timeStep=couplingInterval, &
+                                  startTime=startTime,       &
+                                  stopTime=stopTime, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_ClockCreate(driverClock) failed' )
+   ENDIF
+   PRINT *, 'DEBUG wrf_SST_ESMF:  done reconciling clock from WRF and SST components'
+   CALL wrf_clockprint(50, driverClock, &
+          'DEBUG wrf_SST_ESMF:  driverClock after creation,')
+
+   ! initialize WRF-SST Coupler
+   PRINT *, 'DEBUG wrf_SST_ESMF:  calling phase-1 CPL init (WRFSSTCpl_init)'
+   CALL ESMF_CplCompInitialize(compCplWRFSST, exportStateWRF, &
+                               importStateSST, driverClock, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_CplCompInitialize(WRF -> SST) failed' )
+   ENDIF
+! TBH:  this bit is not needed
+!   CALL ESMF_CplCompInitialize(compCplWRFSST, exportStateSST, &
+!                               importStateWRF, driverClock, rc=rc)
+!   IF ( rc /= ESMF_SUCCESS ) THEN
+!     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_CplCompInitialize(SST -> WRF) failed' )
+!   ENDIF
+
+   ! initialize SST, phase 2
+   WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-2 init for SST (sst_component_init2)'
+   CALL wrf_debug ( 100 , TRIM(str) )
+   CALL ESMF_GridCompInitialize(compGriddedSST, importStateSST, &
+                                exportStateSST, driverClock, phase=2, rc=rc)
+   WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-2 init for SST'
+   CALL wrf_debug ( 100 , TRIM(str) )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompInitialize(SST phase 2) failed' )
+   ENDIF
+
+   ! initialize WRF, phase 2
+   ! Phase 2 init sets up WRF importState and exportState.
+   WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-2 init for WRF (wrf_component_init2)'
+   CALL wrf_debug ( 100 , TRIM(str) )
+   CALL ESMF_GridCompInitialize(compGriddedWRF, importStateWRF, &
+                                exportStateWRF, driverClock, phase=2, rc=rc)
+   WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-2 init for WRF'
+   CALL wrf_debug ( 100 , TRIM(str) )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompInitialize(WRF phase 2) failed' )
+   ENDIF
+
+   CALL wrf_clockprint(50, driverClock, &
+          'DEBUG wrf_SST_ESMF:  driverClock before main time-stepping loop,')
+   ! Run...
+   ! main time-stepping loop
+   timestepdebug = 0
+   DO WHILE ( .NOT. ESMF_ClockIsStopTime(driverClock, rc) )
+
+     timestepdebug = timestepdebug + 1
+     WRITE(str,'(A,I8)') 'PROGRAM wrf_SST_ESMF: Top of time-stepping loop, timestepdebug = ',timestepdebug
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL wrf_clockprint(50, driverClock, &
+            'DEBUG wrf_SST_ESMF:  driverClock at top of time-stepping loop,')
+
+     ! Run SST phase 1
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-1 run for SST (sst_component_run1)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL ESMF_GridCompRun(compGriddedSST, importStateSST, exportStateSST, &
+                           driverClock, phase=1, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompRun(SST phase 1) failed' )
+     ENDIF
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-1 run for SST (sst_component_run1)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     ! couple SST export -> WRF import
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling run for CPL SST->WRF (WRFSSTCpl_run)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL ESMF_CplCompRun(compCplWRFSST, exportStateSST, &
+                          importStateWRF, driverClock, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_CplCompRun(SST -> WRF) failed' )
+     ENDIF
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from run for CPL SST->WRF (WRFSSTCpl_run)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     ! Run WRF
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling run for WRF (wrf_component_run)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL ESMF_GridCompRun(compGriddedWRF, importStateWRF, exportStateWRF, &
+                           driverClock, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompRun(WRF) failed' )
+     ENDIF
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from run for WRF (wrf_component_run)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     ! couple WRF export -> SST import
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling run for CPL WRF->SST (WRFSSTCpl_run)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL ESMF_CplCompRun(compCplWRFSST, exportStateWRF, &
+                          importStateSST, driverClock, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_CplCompRun(WRF -> SST) failed' )
+     ENDIF
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from run for CPL WRF->SST (WRFSSTCpl_run)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     ! Run SST phase 2
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-2 run for SST (sst_component_run2)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL ESMF_GridCompRun(compGriddedSST, importStateSST, exportStateSST, &
+                           driverClock, phase=2, rc=rc)
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompRun(SST phase 2) failed' )
+     ENDIF
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-2 run for SST (sst_component_run2)'
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     ! advance clock to next coupling time step
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: advancing clock'
+     CALL wrf_debug ( 100 , TRIM(str) )
+     CALL ESMF_ClockAdvance( driverClock, rc=rc )
+     IF ( rc /= ESMF_SUCCESS ) THEN
+       CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_ClockAdvance failed' )
+     ENDIF
+     WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: done advancing clock'
+     CALL wrf_debug ( 100 , TRIM(str) )
+
+     CALL wrf_clockprint(50, driverClock, &
+            'DEBUG wrf_SST_ESMF:  driverClock at end of time-stepping loop,')
+
+   ENDDO
+
+   WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: done with time-stepping loop'
+   CALL wrf_debug ( 100 , TRIM(str) )
+
+   ! clean up SST
+   CALL ESMF_GridCompFinalize(compGriddedSST, importStateSST, exportStateSST, &
+                              driverClock, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompFinalize(compGriddedSST) failed' )
+   ENDIF
+ 
+   ! clean up compCplWRFSST
+   CALL ESMF_CplCompFinalize( compCplWRFSST, exportStateWRF, importStateSST, &
+                              driverClock, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_CplCompFinalize(compCplWRFSST) failed' )
+   ENDIF
+ 
+   ! clean up WRF
+   ! must do this AFTER clean up of SST since SST uses WRF IOAPI
+   CALL ESMF_GridCompFinalize(compGriddedWRF, importStateWRF, exportStateWRF, &
+                              driverClock, rc=rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompFinalize(compGriddedWRF) failed' )
+   ENDIF
+ 
+   ! Clean up
+
+   CALL ESMF_GridCompDestroy(compGriddedWRF, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_GridCompDestroy(compGriddedWRF) failed' )
+   ENDIF
+   CALL ESMF_StateDestroy(importStateWRF, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_StateDestroy(importStateWRF) failed' )
+   ENDIF
+   CALL ESMF_StateDestroy(exportStateWRF, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_StateDestroy(exportStateWRF) failed' )
+   ENDIF
+   CALL ESMF_StateDestroy(importStateSST, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_StateDestroy(importStateSST) failed' )
+   ENDIF
+   CALL ESMF_StateDestroy(exportStateSST, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_StateDestroy(exportStateSST) failed' )
+   ENDIF
+   CALL ESMF_ClockDestroy(driverClock, rc)
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_ClockDestroy(driverClock) failed' )
+   ENDIF
+
+   CALL ESMF_Finalize( rc=rc )
+   IF ( rc /= ESMF_SUCCESS ) THEN
+     CALL wrf_error_fatal ( 'wrf_SST_ESMF:  ESMF_Finalize failed' )
+   ENDIF
+
+END PROGRAM wrf_SST_ESMF
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/create_make_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/create_make_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/create_make_gcm	(revision 2744)
@@ -0,0 +1,220 @@
+#!/bin/sh
+#set -xv
+machine=`hostname`
+os=`uname`
+gcm=`pwd`
+libf=$gcm/libf
+libo=$gcm/libo
+CRAY=0
+if [ "$machine" = "atlas" -o "$machine" = "etoile" -o "$machine" = "axis" ] ; then
+  CRAY=1
+fi
+XNEC=0
+if [ "$machine" = "rhodes" ] ; then
+  XNEC=1
+fi
+VPP=0
+if [ "$machine" = "nymphea0" ] ; then
+  VPP=1
+fi
+#
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Definitions de Macros pour Make"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+echo "# Repertoires :"
+echo
+echo "GCM     = "$gcm
+if [ "$CRAY" = '0' ] ; then
+   echo "MACHINE = sun4"
+fi
+echo 'LIBF    = $(GCM)/libf'
+if [ "$CRAY" = '0' ] ; then
+#   echo 'LIBO    = $(GCM)/libo/$(MACHINE)'
+   echo 'LIBO    = $(LIBOGCM)/$(MACHINE)'
+else
+   echo 'LIBO    = $(GCM)/libo'
+fi
+#echo 'LOCAL_DIR=$(GCM)'
+#echo $localdir
+echo "LOCAL_DIR=`echo $localdir`"
+echo 'BIBIO    = $(LIBF)/bibio'
+echo 'AERONOMARS    = $(LIBF)/aeronomars'
+echo "FILTRE   = filtre"
+echo "PHYS  = "
+echo "DYN  = dyn "
+echo 'LIBPHY = $(LIBO)/libphy$(PHYS).a'
+echo 'DIRMAIN=dyn$(DIM)d'
+echo 'RM=rm'
+echo
+echo "OPLINK = "
+echo
+echo '# Les differentes librairies pour l"edition des liens:'
+echo
+if [ "$XNEC" = '1' ] ; then
+  echo 'dyn3d      = $(LIBO)/libsxdyn3d.a $(LIBO)/libsx$(FILTRE).a'
+  echo 'dyn2d      = $(LIBO)/libsxdyn2d.a'
+  echo 'dyn1d      = $(LIBO)/libsxdyn1d.a'
+  echo 'L_DYN      = -lsxdyn$(DIM)d'
+  echo 'L_FILTRE   = -lsx$(FILTRE)'
+  echo 'L_PHY = -lsxphy$(PHYS) '
+  echo 'L_BIBIO    = -lsxbibio'
+  echo 'L_AERONOMARS    = -lsxaeronomars'
+  echo 'L_ADJNT    ='
+else
+  echo 'dyn3d      = $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a'
+  echo 'dyn2d      = $(LIBO)/libdyn2d.a'
+  echo 'dyn1d      = $(LIBO)/libdyn1d.a'
+  echo 'L_DYN      = -ldyn$(DIM)d'
+  echo 'L_FILTRE   = -l$(FILTRE)'
+  echo 'L_PHY = -lphy$(PHYS) '
+  echo 'L_BIBIO    = -lbibio'
+  echo 'L_AERONOMARS    = -laeronomars'
+  echo 'L_ADJNT    ='
+fi
+echo
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Option de compilation FORTRAN"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+   echo 'COMPILE90 = $(F90) $(OPTIM90) $(INCLUDE) -c'
+   echo "LINK    = $LINK"
+   echo "AR      = $AR"
+echo
+echo
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Creation des differents executables"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+echo "# Executables:"
+echo "# ------------"
+echo
+echo "PROG = code"
+echo
+echo 'main : $(DYN) bibio phys aeronomars $(OPTION_DEP) '
+echo '	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
+echo '	cd $(LOCAL_DIR); \'
+echo '	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(PROG).F -o $(PROG).o ; \'
+if [ "$CRAY" = '0' ] ; then
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+else
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+fi
+echo
+echo 'dyn : $(LIBO)/libdyn$(DIM)d.a $(FILTRE)$(DIM)d'
+echo
+echo 'phys : $(LIBPHY)'
+echo
+echo 'bibio : $(LIBO)/libbibio.a'
+echo
+echo 'aeronomars : $(LIBO)/libaeronomars.a'
+echo
+echo 'adjnt : $(LIBO)/libadjnt.a'
+echo
+echo '$(FILTRE)3d : $(LIBO)/lib$(FILTRE).a'
+echo
+echo '$(FILTRE)2d :'
+echo
+echo '$(FILTRE)1d :'
+echo
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Contenu des differentes bibliotheques"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+echo
+cd $libf >/dev/null 2>&1
+for diri in ` ls `
+do
+   if [ -d $diri ] ; then
+   if [ "`ls $diri/*.F`" != "" ] || [ "`ls $diri/*.F90`" != "" ]  ; then 
+      cd $diri >/dev/null 2>&1
+      echo
+      listlib=""
+      for i in `ls *.F`
+      do
+         fili=`basename $i .F`
+         test=` (  head $i | grep '      PROGRAM' ) `
+         if [ "$test" = "" ] ; then 
+            listlib=$listlib" "$fili
+         fi
+      done
+      for i in `ls *.F90`
+      do
+         fili=`basename $i .F90`
+         test=` (  head $i | grep '      PROGRAM' ) `
+         if [ "$test" = "" ] ; then
+            listlib=$listlib" "$fili
+         fi 
+      done
+#
+      echo
+      echo
+      echo "#======================================================================="
+      echo "# Contenu de la bibliotheque correspondant au Directory "$diri
+      echo "#======================================================================="
+      echo
+      for fili in $listlib
+      do
+         echo '$(LIBO)/lib'$diri".a : " '$(LIBO)/lib'$diri".a("$fili".o)"
+         echo
+      done
+      echo '.PRECIOUS	: $(LIBO)/lib'$diri'.a'
+      echo
+      echo
+      echo "# Compilation des membres de la bibliotheque lib"$diri".a"
+      echo
+      for fili in $listlib
+      do
+         if [ -f $fili.F90 ] ; then
+           trufile=$fili.F90
+         else
+           trufile=$fili.F
+         fi
+         F90=0 ; egrep -i '^ *use ' $trufile > /dev/null 2>&1 && F90=1
+                 egrep -i '^ *module ' $trufile > /dev/null 2>&1 && F90=1
+         str1='$(LIBO)/lib'$diri'.a('$fili'.o) : $(LIBF)/'$diri/$trufile
+         [ "$fili" = "chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F
+         for stri in ` ( sed -n "/\#include/s/\#include//p" $trufile | sed 's/\"//g' ; egrep -i '^ *use ' $trufile | awk ' { print $2 } ' ) `
+         do
+            stri=`echo $stri | tr [A-Z] [a-z]`
+            if [ -f $stri ] ; then
+               echo $str1 \\
+               str1='$(LIBF)/'$diri'/'$stri
+            else
+               if [ -f $stri.F ] || [ -f $stri.F90 ] ; then
+                  str1='$(LIBO)/lib'$diri'.a('$stri'.o)'
+               else
+                  for dirinc in dyn3d grid bibio aeronomars phymars
+                  do
+                     if [ -f ../$dirinc/$stri ] ; then
+                        echo $str1 \\
+                        str1='$(LIBF)/'`cd .. ; ls */$stri | head -1`
+                     fi
+                  done
+               fi
+            fi
+         done
+         echo $str1
+         echo '	cd $(LOCAL_DIR); \'
+	     echo '	$(COMPILE90) $(LIBF)/'$diri'/'$trufile' ; \'
+         MODU=0; egrep -i ' *module ' $trufile> /dev/null 2>&1 && MODU=1
+         if [ "$MODU" -eq '1' -a "$CRAY" != '1' ] ; then
+            if [ "$os" = 'UNIX_System_V' ] ; then
+              echo '	cp $(MOD_LOC_DIR)/*.$(MOD_SUFFIX) $(LIBO)/ ; \'
+            else
+              echo '	mv $(MOD_LOC_DIR)/'$fili'.$(MOD_SUFFIX) $(LIBO)/'$fili'.$(MOD_SUFFIX) ; \'
+            fi
+         fi
+         if [ "$XNEC" -eq '1' ] ; then
+           echo '	sxar r $(LIBO)/libsx'$diri'.a '$fili'.o ; \'
+         fi
+         echo '	$(AR) r $(LIBO)/lib'$diri'.a '$fili'.o ; $(RM) '$fili'.o ; \'
+         echo '	cd $(GCM)'
+	 echo
+      done
+#	 
+      echo
+   cd $libf
+   fi
+   fi
+done
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/error_libc
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/error_libc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/error_libc	(revision 2744)
@@ -0,0 +1,50 @@
+L'option static permet de porter l'exécutable, car il contient alors toutes
+les librairies nécessaires !
+
+
+You somehow got incompatible versons of your basic system C libraries on your machine.
+
+The warning messages are just saying that the dynamic libc library must be use for some of the symbols and your application will not be completly static. Since libc must be on every Linux system, I doubt this will cause problems.
+
+For the undefined references, you want to find the library which contains the symbols. In this case, the symbols can be found in "/usr/lib/gcc/i386-redhat-linux/4.0.0/libgcc_eh.a". Using the "nm" utility, followed by a "grep" will show if the symbol is present and an upper case "T" indicates that the symbol is defined. A "U" indicates that the symbol is used but undefined. 
+aymeric@ubuntu:/usr/lib/gcc/i486-linux-gnu/4.1.2$ nm libgcc_eh.a | grep -i "_Unwind_Resume"
+
+adding -lgcc_eh
+
+
+/usr/lib/libc.a(iofclose.o):(.eh_frame+0x11): référence indéfinie vers « __gcc_personality_v0 »
+/usr/lib/libc.a(iofflush.o): In function `fflush':
+(.text+0xdc): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(iofflush.o):(.eh_frame+0x12): référence indéfinie vers « __gcc_personality_v0 »
+/usr/lib/libc.a(iofputs.o): In function `fputs':
+(.text+0x105): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(iofputs.o):(.eh_frame+0x12): référence indéfinie vers « __gcc_personality_v0 »
+/usr/lib/libc.a(iofwrite.o): In function `fwrite':
+(.text+0x126): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(iofwrite.o):(.eh_frame+0x12): référence indéfinie vers « __gcc_personality_v0 »
+/usr/lib/libc.a(wfileops.o): In function `_IO_wfile_underflow':
+(.text+0x125d): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(wfileops.o):(.eh_frame+0x12): référence indéfinie vers « __gcc_personality_v0 »
+/usr/lib/libc.a(fileops.o): In function `_IO_file_fopen':
+(.text+0x1f13): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(fileops.o): In function `_IO_file_underflow':
+(.text+0x2108): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(fileops.o):(.eh_frame+0x12): référence indéfinie vers « __gcc_personality_v0 »
+/usr/lib/libc.a(syslog.o): In function `__vsyslog_chk':
+(.text+0x6dd): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(syslog.o): In function `__vsyslog_chk':
+(.text+0x6f2): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(syslog.o): In function `openlog':
+(.text+0x803): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(syslog.o): In function `closelog':
+(.text+0x874): référence indéfinie vers « _Unwind_Resume »
+/usr/lib/libc.a(syslog.o):(.eh_frame+0x12): référence indéfinie vers « __gcc_personality_v0 »
+/usr/lib/libc.a(backtrace.o): In function `backtrace':
+(.text+0x54): référence indéfinie vers « _Unwind_Backtrace »
+/usr/lib/libc.a(backtrace.o): In function `backtrace_helper':
+(.text+0x10a): référence indéfinie vers « _Unwind_GetIP »
+/usr/lib/libc.a(backtrace.o): In function `backtrace_helper':
+(.text+0x12f): référence indéfinie vers « _Unwind_GetGR »
+/usr/lib/libc.a(backtrace.o): In function `backtrace_helper':
+(.text+0x13a): référence indéfinie vers « _Unwind_GetCFA »
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/LMDZ.MARS.source.txt
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/LMDZ.MARS.source.txt	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/LMDZ.MARS.source.txt	(revision 2744)
@@ -0,0 +1,312 @@
+--------------------------------------------------------------------
+Changes in the LMD MARS GCM reference sources 
+(most recent version available in LMDZ.MARS.source.tar)
+--------------------------------------------------------------------
+
+09/2008 dyn3d/physdem1.F
+Correct possible bugs on some computers + english text & comments
+
+09/2008 dyn3d/defrun_new.F
+Corrected small bug (tapedef argument should not be altered)
+
+09/2008 dyn3d/eofdump.F
+Corrected small bug in the sampling time
+
+09/2008 dyn3d/vanleer.F
+removed inapropriate 'EXTERNAL' statement
+
+O9/2008 aeronomars/euvheat.F
+removed print of 'ngrid','nlayer' (undefined and unused variables)
+
+O9/2008 phymars/mkstat.F90
+Cleaned up (removed unused variables)
+
+09/2008 phymars/uniplot.F bibio/uniplot.F are removed because useless
+
+O9/2008 phymars/comcstfi.h
+09/2008 phymars/writediagfi.F
+08/2007 phymars/tabfi.F
+Cosmetic: english text & comments
+
+09/2008 dyn3d/iniwrite.F => phymars/iniwrite.F 
+- moved it from dyn3d to phymars
+- cleanup & english
+
+09/2008 phymars/physdem1.F
+commented unused (wrong) 'external' qualifiers
+
+09/2008 phymars/orosetup.F
+Replaced logical 'xor' with 'neqv' (for standards compliance)
+
+09/2008 phymars/physiq.F
+- Change to ice albedo to fit new TES observation (Franck L.)
+- cleanup + comments in english (Ehouarn)
+
+09/2008 phymars/watercloud.F
+cleaned version with reduced number of nuclei, and TES like output. 
+
+09/2008 phymars/growthrate.F
+updated to improved version provided by F. Montmessin (Feb 2006...)
+ 
+09/2008 phymars/vdifc.F
+Change to remove an old quick fix to take into account condensation in
+vertical diffusion
+
+09/2008  
+- phymars/mkstat.F90 
+- phymars/def_var.F90
+Slight change to improve compilation (include => #include)
+
+O7/2008 MAJOR CHANGE to solve the "warm polar night" problem
+- dyn3d/addfi.F
+- dyn3d/gcm.F
+Recompute mass after incrementation of ps in addfi.F (masse is added in the argument
+list of addfi). 
+Also : the call of groupeun is now controlled by a flag.  
+
+
+07/2008 phymars/physiq.F
+- Change made (by Aymeric) to improve the models when iradia > 1 (iradia
+  is set is callphys.def). 
+(i.e. when one don't want to compute radiative transfer at every timestep):
+The change has no impact when iradia=1
+=> The net radiative surface flux  "fluxrad" is computed outside the
+test on iradia    
+=> Add intermediate variable "fluxrad_sky" (rad. flux from sky absorbed 
+by surface) to be saved when rad. transfer is not computed.
+- Cleaning of old commented lines about radiative transfer in clouds
+
+
+07/2008 Utility concatnc.F90 (not used by the gcm): improvement in order
+to 1) concatenate 1D variable and 2) increase the number of input files
+up to 1000
+
+12/2007 dyn3d/lect_start_archive.F
+some old stuuf is commented to avoid bugs with some start_archive with
+many tracers
+
+12/2007 dyn3d/dump2d.F
+Changed to improve crazy output to screen with newstart...
+
+12/2007 bibio/mxva.F
+Changed to avoid array bounds problems on some compilers
+
+12/2007 
+aeronomars/conduction.F
+aeronomars/molvis.F
+Changed to ensure variable initialisation on some compilers. 
+
+12/2007 phymars/convadj.F
+Improvement regarding convection in the polar night
+
+12/2007 
+-phymars/callsedim.F  
+-phymars/initracer.F  
+-phymars/tracer.h
+-phymars/callsedim2q.F
+Changed to initialize tracer particle densities in initracer.F, and
+transfer it with common in tracer.h
+
+12/2007 script "makegcm" "create_make_gcm"
+Improved to separate object compiled files in LIBO depending on the type
+of machine you are (32bits or 64bits). Also allow to compute with LMDZ.2
+dynamics.  
+
+10/2007 Utility lslin.F90 (not used by the gcm)
+changed evaluation of 'start_var' from hard-coded values to a computed value
+
+09/2007 phymars/wstats.F90 and phymars/readtesassim.F90
+change " include" to "#include" to force recompilation by makegcm
+
+08/2007 dyn3d/newstart.F90
+Translate french questions asked by program in english...
+Improve options to remove topography... (for intercomparison)
+
+08/2007 phymars/dustopacity.F
+add possibility for scenario iaervar=5 (for paleoclimate...)
+
+08/2007 phymars/tabfi.F
+Translate french questions asked by program in english...
+
+----------------------------------
+----------------------------------
+----------------------------------
+----------------------------------
+
+
+11/2006 phymars/convadj.F
+Correction to remove a bug for compiler which did not "save" variable 
+by default (e.g. pgf on opteron, or g95)
+
+11/2006 aeronomars/thermosphere.F
+Correction to remove a bug if tracer=F and callthermos=T 
+
+10/2006 phymars/readtesassim.F90
+Correction to use dust scenario MY24 at high horizontal resolution
+
+10/2006 dyn3d/dynredem.F and phymars/physdem1.F
+Syntax changes to avoid problem when writing start files when compiling
+on 64bits computers.
+
+05/2006 : phymars/writediagfi.F
+Add a test to be sure not to use writediagfi with 1D version of GCM 
+
+09/2005 : phymars/mucorr.F
+Fix a weird bug that occured when running the model with "Diurnal=F"
+on Linux, pgf90
+
+-----------------------------------
+Update in june 2005
+-----------------------------------
+
+06/2005 : deftank/run0
+Improved so that the "run manager" run0 send you an E-mail when a run crash
+(this can easily be commented)
+
+06/2005 : deftank/run_mcd and deftank/callphys.def
+Cosmetic changes to make thing clearer in english
+
+06/2005 : makegcm
+IMPORTANT FOR 1D GCM VERSION ON LINUX : modified to follow a change in
+the Linux syntax of "sed"
+
+06/2005 : aeronomars/calchim.F
+NEW version provided by S. Lebonnois and F. Lefevre on May, 11, 2005
+("Cosmetic changes")+syntax changes by FF (1 line > 72 characters)
+
+06/2005 : phymars/convadj.F
+Modified if one tracer is CO2, take into account the
+Molecular mass variation (e.g. when CO2 condense) to trigger convection
+
+06/2005 : phymars/newcondens.F
+The CO2 deplation induced convection is now skipped, since it is properly
+done in convadj.F (see above)
+
+06/2005 : phymars/watercloud.F
+IMPORTANT (especially for PALEOCLIMATE) : correction if a lot of subliming 
+CO2 fills the 1st layer. The number of input is modified (see below)
+
+06/2005 : phymars/physiq.F
+- Change in the input argument of watercloud.F : "pdpsrf" is added (see
+above)
+- If "caps", the cold trap at the south pole is only active for
+obliquity lower than 27 deg (only useful for paleoclimate...)
+
+06/2005 : dyn3d/groupe.F
+Just cleaned to remove ambiguity of where "ngroup" is set (in groupeun, and
+not in groupe). 
+
+06/2005 : phymars/inistats.F
+remove declaration of "pseudoalt", already in comvert.h 
+(was a problem only for some compiler)
+
+06/2005 : dyn3d/newstart.F
+Cosmetic changes in some format for compatibility with gnu compiler
+
+06/2005 : dyn3d/readhead_NC.F
+Cosmetic changes in some format for compatibility with gnu compiler
+
+06/2005 : dyn3d/sortvarc.F
+Cosmetic changes in some format for compatibility with gnu compiler
+
+06/2005 : phymars/testphys1d.F
+Cleaning and changes in declaration for compatibility with gnu compiler
+
+06/2005 : phymars/lwflux.F
+Initialisation of "ksidb" for compiler that does not unitialized variable.
+
+06/2005 : phymars/lwxd.F
+Initialisation of "ksi_emis" for compiler that does not unitialized variable.
+
+06/2005 : phymars/nirco2abs.F
+Negligible change of one loop for compiler that does not like loop on real.
+
+06/2005 : aeronomars/paramfoto.F
+Negligible change of one loop for compiler that does not like loop on real.
+
+
+--------------------------------------------------------------
+Change in December 2004 - January 2005 
+--------------------------------------------------------------
+
+01/2005 : aeronomars/euvheat.F
+IMPORTANT FOR THERMOSPHERE : correction to avoid EUV flux time variation 
+and keep it constant throughout the run
+
+01/2005 : LMDZ.MARS/create_make_gcm
+add phymars on line 187 to ensure recompilation of aeronomars subroutines
+when any *.h file is updated in phymars
+
+01/2005 : dyn3d/dynetat0.F
+Add an option to reindex the tracer when using newstart if needed
+
+01/2005 : phymars/phyetat0.F
+Fix a bug when using newstart with more tracers than in old startfi
+Add an option to reindex the surface tracer if needed
+
+12/2004 : phymars/watercloud.F
+IMPORTANT: Several Changes to fix a bug that made watercloud
+to create negative mixing ratio in some conditions (past climate)
+
+12/2004 : dyn3d/interp_horiz.F
+IMPORTANT : add a test to fix a bug when using newstart with 
+a new grid size.
+
+12/2004 : phymars/vdifc.F
+FOR compilation on DEC machine :
+Just change order of declaration of pqsurf(ngrid,nq
+
+12/2004 : phymars/phyetat0.F
+FOR compilation on DEC machine :Just change order of declaration 
+
+12/2004 : dyn3d/addfi.F
+FOR compilation on DEC machine : qtestt = 1.0e-30 (before: qtestt = 1.0e-40)
+
+12/2004 : LMDZ.MARS/makefile
+Add new option to allow compilation on DEC machine
+
+--------------------------------------------------------------
+Change in August-september 2004 : before production of MCD V4.0
+--------------------------------------------------------------
+
+09/2004 : phymars/eofdump.F
+Change to store density in EOF to build Mars Climate Database
+
+09/2004 : phymars/physiq.F
+add rho in the input of eofdump:
+CALL eofdump(ngrid, nlayer, zu, zv, zt, rho, ps)
+
+09/2004 : phymars/ineofdump.F
+Change to store hybrid coordinates in EOF to build Mars Climate Database
+
+
+08/2004 : dyn3d/inidissip.F
+Form change to simplify the choice of dissipation parameters
+and use the same code for the thermosphere of only atmosphere model
+
+08/2004 : dyn3d/newstart.F
+Add an option "q=x" to initialise tracer manually
+
+08/2004 : aeronomars/chimiedata.h
+remove mmol,noms (now in tracer.h common)
+
+08/2004 : In aeronomars: calchim.F, concentrations.F, euvheat.F,
+inichim_newstart.F, moldiff.F, moldiffcoeff.F, perosat.F
+Add : #include "tracer.h"  (where tracer names are now)
+
+08/2004 : phymars/inifis.F
+Change some test on callphys.def options to allow any tracer transport...
+
+08/2004 : phymars/initracer
+Initialization of tracer name "noms(iq)" usable in many place
+
+08/2004 : phymars/tracer.h
+add noms,mmol to the common tracer
+
+08/2004 : phymars/newcondens.F
+IMPORTANT : major changes to allow proper treatment of non volatile 
+gaz enrichment when CO2 condense and depletion when CO2 sublime
+
+08/2004 : phymars/writediagfi.F
+remove the "abort" command so that the run does not stop due to a NETCDF bug
+(NETCDF cannot write in file larger than 2098184 kb
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/calchim.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/calchim.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/calchim.F	(revision 2744)
@@ -0,0 +1,379 @@
+      subroutine calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+     $                   zzlay,zday,pq,pdq,dqchim,dqschim,dqcloud,
+     $                   dqscloud)
+c
+      implicit none
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c  Prepare the call for the photochemical module, and send back the
+c  tendencies from photochemistry in the chemical species mass mixing ratios
+c
+c   Author:   Sebastien Lebonnois (08/11/2002)
+c   -------
+c    update 12/06/2003 for water ice clouds and compatibility with dust
+c    update 07/2003 for coupling with thermosphere (Monica Angelats-i-Coll)
+c    update 03/05/2005 cosmetic changes (Franck Lefevre)
+c
+c   Arguments:
+c   ----------
+c
+c  Input:
+c
+c    ptimestep                  timestep (s)
+c    pplay(ngridmx,nlayermx)    Pressure at the middle of the layers (Pa)
+c    pplev(ngridmx,nlayermx+1)  Intermediate pressure levels (Pa)
+c    pt(ngridmx,nlayermx)       Temperature (K)
+c    pdt(ngridmx,nlayermx)      Temperature tendency (K)
+c    dist_sol                   distance of the sun (AU)
+c    mu0(ngridmx)               cos of solar zenith angle (=1 when sun at zenith)
+c    pq(ngridmx,nlayermx,nqmx)  Advected fields, ie chemical species here
+c    pdq(ngridmx,nlayermx,nqmx) Previous tendencies on pq
+c
+c  Output:
+c
+c    dqchim(ngridmx,nlayermx,nqmx) ! tendencies on pq due to chemistry
+c    dqschim(ngridmx,nqmx)         ! tendencies on qsurf 
+c
+c=======================================================================
+
+c    Declarations :
+c    --------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "fisice.h"
+#include "conc.h"
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+
+      real    ptimestep
+      real    pplay(ngridmx,nlayermx)    ! pressure at the middle of the layers
+      real    zzlay(ngridmx,nlayermx)    ! pressure at the middle of the layers
+      real    pplev(ngridmx,nlayermx+1)  ! intermediate pressure levels
+      real    pt(ngridmx,nlayermx)       ! temperature
+      real    pdt(ngridmx,nlayermx)      ! temperature tendency
+      real    dist_sol                   ! distance of the sun (AU)
+      real    mu0(ngridmx)       ! cos of solar zenith angle (=1 when sun at zenith)
+      real    pq(ngridmx,nlayermx,nqmx)  ! tracers mass mixing ratio
+      real    pdq(ngridmx,nlayermx,nqmx) ! previous tendencies
+      real    zday                       ! date (time since Ls=0, in martian days)
+
+c   outputs:
+c   --------
+
+      real dqchim(ngridmx,nlayermx,nqmx) ! tendencies on pq due to chemistry
+      real dqschim(ngridmx,nqmx)         ! tendencies on qsurf 
+      real dqcloud(ngridmx,nlayermx,nqmx)! tendencies on pq due to condensation
+      real dqscloud(ngridmx,nqmx)        ! tendencies on qsurf 
+
+c Local variables :
+c -----------------
+
+      character*5 str5
+      integer  ig,l,iq, i_co2, i_o
+      integer  foundswitch, lswitch
+      real zq(ngridmx,nlayermx,nqmx) ! pq+pdq*ptimestep before chemistry
+                                     ! new mole fraction after
+      real colden(ngridmx,nqmx)      ! Column densities (cm-2)
+      real zt(ngridmx,nlayermx)      ! temperature
+c
+c  for each column of atmosphere:
+c
+      real zpress(nlayermx)       !  Pressure (mbar)
+      real zdens(nlayermx)        !  Density  (cm-3)
+      real ztemp(nlayermx)        !  Temperature (K)
+      real zlocal(nlayermx)       !  Altitude (km)
+      real zycol(nlayermx,nqmx)   !  Composition (mole fractions)
+      real szacol                 !  Solar zenith angle
+      real jo3(nlayermx)          !  Photodissociation rate O3->O1D (s-1)
+c
+c for output:
+c
+      real zdens3d(ngridmx,nlayermx) !  Density  (cm-3)
+      real jo3_3d(ngridmx,nlayermx)  !  Photodissociation rate O3->O1D (s-1)
+      real surfice(ngridmx,nlayermx) !  Surface of ice particules (um2/cm3)
+      logical output
+
+      logical firstcall
+      data    firstcall/.true./
+      save    firstcall
+c
+c  scheme A: 1 ; scheme B: 2
+c
+      integer scheme
+      data  scheme/2/
+c
+c=======================================================================
+c     initialization of the chemistry (first call only)
+c=======================================================================
+c
+      if (firstcall) then
+c
+         if (photochem) then
+            print*,'INIT CHEMISTRY'
+            if (scheme  .eq.  1) then
+               print*,'Scheme A : A METTRE A JOUR !!'
+               stop
+c              call init_chimie_A
+            else
+               print*,'Scheme B'
+               call init_chimie_B
+            end if
+         end if
+         firstcall = .false.
+      end if
+c
+c=======================================================================
+c     loop over grid
+c=======================================================================
+c
+      do ig = 1,ngridmx
+c
+c     local updates
+c 
+         foundswitch = 0
+         do l = 1,nlayermx
+            do iq = nqchem_min,nqmx
+               zq(ig,l,iq) = pq(ig,l,iq) + pdq(ig,l,iq)*ptimestep
+               zt(ig,l)    = pt(ig,l)    + pdt(ig,l)   *ptimestep
+               zycol(l,iq) = zq(ig,l,iq) * mmean(ig,l)/mmol(iq)
+            enddo
+            zpress(l) = pplay(ig,l)/100.
+            ztemp(l)  = zt(ig,l)
+            zdens(l)  = zpress(l)/(kb*1.e4*ztemp(l))
+            zlocal(l) = zzlay(ig,l)/1000.
+c
+c     search for switch index between regions
+c
+            if (photochem .and. thermochem) then
+               if (foundswitch .eq. 0 .and. pplay(ig,l).lt.1.e-3) then
+                  lswitch = l
+                  foundswitch=1
+               end if
+            end if
+            if ( .not. photochem) then
+               lswitch = 22
+            end if
+            if (.not.  thermochem) then
+               lswitch = min(33,nlayermx+1)
+            end if
+c
+c     ice surface area  in microns^2/cm^3
+c
+c     = 4 pi r^2 * [ zq * mugaz/NA / (rhoice*4/3 pi r^3) ] *zdens
+c     = 3/r * [ zq * mugaz/NA / rhoice ] *zdens
+c     with r in microns, rhoice = 0.92e-12 g microns^-3 and zdens in cm^-3
+c
+            if (iceparty) then
+               zycol(l,nqmx-1) = (3.e-6/rice(ig,l))*zq(ig,l,nqmx-1)
+     $                           *(mugaz/6.022e23)*zdens(l)/0.92e-12
+c              write(*,*) "rice=",rice(ig,l)," m / zdens=",zdens(l),
+c    $        " cm-3 / icesurf=",zycol(l,nqmx-1)," microns^2/cm^3"
+               surfice(ig,l) = zycol(l,nqmx-1)
+            end if
+c
+         end do
+c
+         szacol = acos(mu0(ig))*180./pi
+c
+c=======================================================================
+c     call chemical subroutine
+c=======================================================================
+c
+        if (photochem) then
+           if (scheme .eq. 1) then
+              print*,'Scheme A : A METTRE A JOUR !!'
+c             call photochemist_A(zycol,szacol,ptimestep,
+c    $                            zpress,ztemp,zdens,dist_sol)
+           else
+              call photochemist_B(lswitch,zycol,szacol,ptimestep,
+     $                            zpress,ztemp,zdens,dist_sol,jo3)
+           end if
+        end if
+        if (thermochem) then
+           call chemthermos(ig,lswitch,zycol,ztemp,zdens,zpress,
+     $                      zlocal,szacol,ptimestep,zday)
+        end if
+c
+c=======================================================================
+c     tendencies
+c=======================================================================
+c
+c     must be 0. for water ice:
+c
+         if (iceparty) then
+            do l = 1,nlayermx
+               dqchim(ig,l,nqmx-1) = 0.
+            end do
+         end if
+c
+c     tendency for CO2 = - sum of others for lower atmosphere
+c     tendency for O   = - sum of others for upper atmosphere
+c
+         do l = 1,nlayermx
+            if (l .lt. lswitch) then
+               do iq = nqchem_min,nqmx
+                  if ((noms(iq) .ne. "co2") .and. 
+     $                (noms(iq) .ne. "ice")) then
+                     dqchim(ig,l,iq) = (zycol(l,iq)*mmol(iq)/mmean(ig,l)
+     $                                - zq(ig,l,iq))/ptimestep
+                  else if (noms(iq) .eq. "co2") then
+                     i_co2 = iq
+                     dqchim(ig,l,iq) = 0.
+                  end if
+                  dqschim(ig,iq) = 0.
+               end do
+               do iq = nqchem_min,nqmx
+                  if (noms(iq) .ne. "co2") then
+                     dqchim(ig,l,i_co2) = dqchim(ig,l,i_co2) 
+     $                                  - dqchim(ig,l,iq)
+                  end if
+                end do
+             else if (l .ge. lswitch) then
+                do iq = nqchem_min,nqmx
+                   if ((noms(iq).ne."o") .and.(noms(iq) .ne."ice")) then
+                      dqchim(ig,l,iq) = (zycol(l,iq)*mmol(iq)
+     $                                  /mmean(ig,l)
+     $                                 - zq(ig,l,iq))/ptimestep
+                   else if (noms(iq) .eq. "o") then
+                      i_o = iq
+                      dqchim(ig,l,iq) = 0.
+                   end if
+                enddo
+                do iq = nqchem_min,nqmx
+                   if (noms(iq) .ne. "o") then
+                      dqchim(ig,l,i_o) = dqchim(ig,l,i_o) 
+     $                                 - dqchim(ig,l,iq)
+                   end if
+                end do
+             end if
+          end do
+c
+c     dust
+c
+          if (nqchem_min .gt. 1) then
+             do iq = 1,nqchem_min-1
+                do l = 1,nlayermx
+                   dqchim(ig,l,iq) = 0.
+                end do
+                dqschim(ig,iq) = 0.
+             end do
+          end if
+c
+c     condensation of h2o2
+c
+          call perosat(ig,ptimestep,pplev,pplay,
+     $                 ztemp,zycol,dqcloud,dqscloud)
+c
+c     for outputs
+c
+          do iq = nqchem_min,nqmx
+             colden(ig,iq) = 0.
+             do l = 1,nlayermx
+c
+c     column density converted in cm-2
+c     pplev en pa, mugaz en g.mol-1 et g en m.s-2
+c     not for ice
+c
+                if (noms(iq) .ne. "h2o2") then
+                  colden(ig,iq) = colden(ig,iq) + zycol(l,iq)
+     $                         *6.022e22*(pplev(ig,l)-pplev(ig,l+1))
+     $                         /(mmean(ig,l)*g)
+                else   ! for H2O2, remove condensation from zycol
+                  colden(ig,iq) = colden(ig,iq) + (zycol(l,iq) +
+     $               dqcloud(ig,l,iq)*ptimestep*mmean(ig,l)/mmol(iq))
+     $                         *6.022e22*(pplev(ig,l)-pplev(ig,l+1))
+     $                         /(mmean(ig,l)*g)
+                end if
+c
+c     local densities, for outputs (put in zq)
+c     not for ice
+c
+                zq(ig,l,iq) = zycol(l,iq)*zdens(l)
+c                        for H2O2, remove condensation from zycol
+                if (noms(iq) .eq. "h2o2") then
+                   zq(ig,l,iq) = zdens(l)*(zycol(l,iq) +
+     $               dqcloud(ig,l,iq)*ptimestep*mmean(ig,l)/mmol(iq))
+                end if
+             end do
+          end do
+c
+c     density and j(o3->o1d), for outputs
+c
+          zdens3d(ig,1) = zdens(1)
+          jo3_3d(ig,1) = jo3(1)
+          do l = 2,nlayermx
+             zdens3d(ig,l) = zdens(l)
+             jo3_3d(ig,l) = jo3(l)
+          end do
+c
+c=======================================================================
+c     end of loop over grid
+c=======================================================================
+c
+      end do
+c
+c=======================================================================
+c     write outputs
+c=======================================================================
+c
+      output = .true.
+
+      if (output) then
+         if (ngridmx .gt. 1) then
+c           call writediagfi(ngridmx,'dens','atm dens.','cm-3',3,zdens3d(1,1))
+c           call writediagfi(ngridmx,'jo3','j o3->o1d','s-1',3,jo3_3d(1,1))
+c           call writediagfi(ngridmx,'sice','ice surf.','um2/cm3',3,surfice(1,1))
+            do iq = nqchem_min,nqmx
+               if (noms(iq) .ne. "ice") then
+                  write(str5(1:5),'(a5)') noms(iq)
+c                  call writediagfi(ngridmx,'n_'//str5,'density',
+c     $                             'cm-3',3,zq(1,1,iq))
+cc                 call writediagfi(ngridmx,'dqch_'//str5,'density','cm-3',3,dqchim(1,1,iq))
+cc                 if (noms(iq) .eq. "h2o2" .or. noms(iq) .eq. "h2o") then
+cc                    call writediagfi(ngridmx,'cl_'//str5,'density','cm-3',3,dqcloud(1,1,iq))
+cc                 end if
+c                  call writediagfi(ngridmx,'c_'//str5,'col. dens.',
+c     $                             'cm-2',2,colden(1,iq))
+               end if
+            end do
+c
+            if (callstats) then
+c
+c              convert to mole.cm-2 for the column densities
+c
+               do iq = nqchem_min,nqmx
+                  do ig = 1,ngridmx
+                     colden(ig,iq) = colden(ig,iq)/6.022e23
+                  end do   
+               end do 
+c
+c              call wstats(ngridmx,"jo3","jo3->o1d","s-1",3,jo3_3d)
+c
+c               do iq = nqchem_min,nqmx
+c                  if (noms(iq) .ne. "ice") then
+c                     write(str5(1:5),'(a5)') noms(iq)
+c                     call wstats(ngridmx,"n_"//str5,"density",
+c     &                           "cm-3",3,zq(1,1,iq))
+c                     call wstats(ngridmx,"c_"//str5,"col. dens.",
+c     &                           "mol cm-2",2,colden(1,iq))
+c                  end if
+c               end do
+            end if
+         end if
+c
+      endif
+c
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/ch.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/ch.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/ch.F	(revision 2744)
@@ -0,0 +1,550 @@
+c 	************************************************************
+c
+c		chapman function for grazing incidence
+c
+c 	************************************************************
+
+	function ch(x,z) 
+
+	integer ierr
+	real ch,x
+
+	double precision ch1,sublim,z,error,aerr,rerr
+	double precision dcadre,fch
+	external fch,dcadre 
+
+	common/integ/ax,az
+	double precision ax,az 
+
+c
+
+	ax=x
+	az=z
+
+	aerr= 0.0d0
+	rerr= 0.0001d0 
+	sublim = 1.0d-4
+	ch1 = dcadre( fch, sublim, az, aerr, rerr, error, ierr )
+	ch = ax * sin(az) * ch1
+
+	return
+	end
+
+c 	************************************************************
+c
+c		integrand for the chapman function 
+c
+c 	************************************************************
+
+	double precision function fch(gi)
+
+	double precision gi
+
+	common/integ/x,z
+	double precision x,z 
+
+!	real x,z,a
+
+	fch = (1./sin(gi))**2. * exp( x *(1.- sin(z)/sin(gi)) )
+
+	return 
+	end
+
+
+
+
+******************************************************************************
+
+      double precision function dcadre (f,a,b,aerr,rerr,error,ier)              
+c                                  specifications for arguments                 
+      integer            ier                                                    
+      double precision   f,a,b,aerr,rerr,error                                  
+c                                  specifications for local variables           
+      integer            ibegs(30),maxts,maxtbl,mxstge,ibeg,ii,nnleft           
+      integer            i,n2,iii,istep2,iend,istep,l,lm1,it,istage,n           
+      double precision   t(10,10),r(10),ait(10),dif(10),rn(4),ts(2049)          
+      double precision   begin(30),finis(30),est(30)                            
+      double precision   h2tol,aittol,length,jumptl,zero,p1,half,one            
+      double precision   two,four,fourp5,ten,hun,cadre,aitlow                   
+      double precision   stepmn,stepnm,stage,curest,fnsize,hrerr                
+      double precision   prever,beg,fbeg,edn,fend,step,astep,tabs,hovn          
+      double precision   fn,sum,sumabs,vint,tabtlm,ergl,ergoal                  
+      double precision   erra,errr,fextrp,errer,diff,sing,fextm1                
+      double precision   h2next,singnx,slope,fbeg2,erret,h2tfex,fi              
+      logical            h2conv,aitken,right,reglar,reglsv(30)                  
+      data               aitlow,h2tol,aittol,jumptl,maxts,maxtbl,mxstge         
+     1                   /1.1d0,.15d0,.1d0,.01d0,2049,10,30/                    
+      data               rn(1),rn(2),rn(3),rn(4)/                               
+     1                   .7142005d0,.3466282d0,.843751d0,.1263305d0/            
+      data               zero,p1,half,one,two,four,fourp5,ten,hun               
+     1                   /0.0d0,0.1d0,0.5d0,1.0d0,2.0d0,4.0d0,                  
+     2                   4.5d0,10.0d0,100.0d0/                                  
+c                                  first executable statement                   
+      ier = 0                                                                   
+      cadre = zero                                                              
+      error = zero                                                              
+      curest = zero                                                             
+      vint = zero                                                               
+      length = dabs(b-a)
+
+      if (length .eq. zero) go to 215                                           
+      if (rerr .gt. p1 .or. rerr .lt. zero) go to 210                           
+      hrerr = rerr+hun                                                          
+      if (aerr .eq. zero .and. hrerr .le. hun) go to 210                        
+      errr = rerr                                                               
+      erra = dabs(aerr)                                                         
+      stepmn = length/(two**mxstge)                                             
+      stepnm = dmax1(length,dabs(a),dabs(b))*ten                                
+      stage = half                                                              
+      istage = 1                                                                
+      fnsize = zero                                                             
+      prever = zero                                                             
+      reglar = .false.                                                          
+c                                  the given interval of integration            
+c                                    is the first interval considered.          
+      beg = a                                                                   
+      fbeg = f(beg)*half                                                        
+      ts(1) = fbeg                                                              
+      ibeg = 1                                                                  
+      edn = b                                                                   
+      fend = f(edn)*half                                                        
+      ts(2) = fend                                                              
+      iend = 2                                                                  
+    5 right = .false.                                                           
+c                                  investigation of a particular                
+c                                    subinterval begins at this point.          
+   10 step = edn - beg                                                          
+      astep =  dabs(step)                                                       
+      if (astep .lt. stepmn) go to 205                                          
+      hrerr = stepnm+astep                                                      
+      if (hrerr .eq. stepnm) go to 205                                          
+      t(1,1) = fbeg + fend                                                      
+      tabs = dabs(fbeg) + dabs(fend)                                            
+      l = 1                                                                     
+      n = 1                                                                     
+      h2conv = .false.                                                          
+      aitken = .false.                                                          
+   15 lm1 = l                                                                   
+      l = l + 1                                                                 
+c                                  calculate the next trapezoid sum,            
+c                                    t(l,1), which is based on *n2* + 1         
+c                                    equispaced points. here,                   
+c                                    n2 = n*2 = 2**(l-1).                       
+      n2 = n+n                                                                  
+      fn = n2                                                                   
+      istep = (iend - ibeg)/n                                                   
+      if (istep .gt. 1) go to 25                                                
+      ii = iend                                                                 
+      iend = iend + n                                                           
+      if (iend .gt. maxts) go to 200                                            
+      hovn = step/fn                                                            
+      iii = iend                                                                
+      fi = one                                                                  
+      do 20 i=1,n2,2                                                            
+         ts(iii) = ts(ii)                                                       
+         ts(iii-1) = f(edn - fi * hovn)                                         
+         fi = fi+two                                                            
+         iii = iii-2                                                            
+         ii = ii-1                                                              
+   20 continue                                                                  
+      istep = 2                                                                 
+   25 istep2 = ibeg + istep/2                                                   
+      sum = zero                                                                
+      sumabs = zero                                                             
+      do 30 i=istep2,iend,istep                                                 
+         sum = sum + ts(i)                                                      
+         sumabs = sumabs + dabs(ts(i))                                          
+   30 continue                                                                  
+      t(l,1) = t(l-1,1)*half+sum/fn                                             
+      tabs = tabs*half+sumabs/fn                                                
+      n = n2                                                                    
+c                                  get preliminary value for *vint*             
+c                                    from last trapezoid sum and update         
+c                                    the error requirement *ergoal*             
+c                                    for this subinterval.                      
+      it = 1                                                                    
+      vint = step*t(l,1)                                                        
+      tabtlm = tabs*ten                                                         
+      fnsize = dmax1(fnsize,dabs(t(l,1)))                                       
+      ergl = astep*fnsize*ten                                                   
+      ergoal = stage*dmax1(erra,errr*dabs(curest+vint))                         
+c                                  complete row l and column l of *t*           
+c                                    array.                                     
+      fextrp = one                                                              
+      do 35 i=1,lm1                                                             
+         fextrp = fextrp*four                                                   
+         t(i,l) = t(l,i) - t(l-1,i)                                             
+         t(l,i+1) = t(l,i) + t(i,l)/(fextrp-one)                                
+   35 continue                                                                  
+      errer = astep*dabs(t(1,l))                                                
+c                                  preliminary decision procedure               
+c                                    if l = 2 and t(2,1) = t(1,1),              
+c                                    go to 135 to follow up the                 
+c                                    impression that intergrand is              
+c                                    straight line.                             
+      if (l .gt. 2) go to 40                                                    
+      hrerr = tabs+p1*dabs(t(1,2))                                              
+      if (hrerr .eq. tabs) go to 135                                            
+      go to 15                                                                  
+c                                  caculate next ratios for                     
+c                                    columns 1,...,l-2 of t-table               
+c                                    ratio is set to zero if difference         
+c                                    in last two entries of column is           
+c                                    about zero                                 
+   40 do 45 i=2,lm1                                                             
+         diff = zero                                                            
+         hrerr = tabtlm+dabs(t(i-1,l))                                          
+         if (hrerr .ne. tabtlm) diff = t(i-1,lm1)/t(i-1,l)                      
+         t(i-1,lm1) = diff                                                      
+   45 continue                                                                  
+      if (dabs(four-t(1,lm1)) .le. h2tol) go to 60                              
+      if (t(1,lm1) .eq. zero) go to 55                                          
+      if (dabs(two-dabs(t(1,lm1))) .lt. jumptl) go to 130                       
+      if (l .eq. 3) go to 15                                                    
+      h2conv = .false.                                                          
+      if (dabs((t(1,lm1)-t(1,l-2))/t(1,lm1)) .le. aittol) go to 75              
+   50 if (reglar) go to 55                                                      
+      if (l .eq. 4) go to 15                                                    
+      hrerr = ergl+errer                                                        
+   55 if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 175                    
+      go to 145                                                                 
+c                                  cautious romberg extrapolation               
+   60 if (h2conv) go to 65                                                      
+      aitken = .false.                                                          
+      h2conv = .true.                                                           
+   65 fextrp = four                                                             
+   70 it = it + 1                                                               
+      vint = step*t(l,it)                                                       
+      errer = dabs(step/(fextrp-one)*t(it-1,l))                                 
+      if (errer .le. ergoal) go to 160                                          
+      hrerr = ergl+errer                                                        
+      if (hrerr .eq. ergl) go to 160                                            
+      if (it .eq. lm1) go to 125                                                
+      if (t(it,lm1) .eq. zero) go to 70                                         
+      if (t(it,lm1) .le. fextrp) go to 125                                      
+      if (dabs(t(it,lm1)/four-fextrp)/fextrp .lt. aittol)                       
+     1       fextrp = fextrp*four                                               
+      go to 70                                                                  
+c                                  integrand may have x**alpha type             
+c                                    singularity                                
+c                                    resulting in a ratio of *sing*  =          
+c                                    2**(alpha + 1)                             
+   75 if (t(1,lm1) .lt. aitlow) go to 175                                       
+      if (aitken) go to 80                                                      
+      h2conv = .false.                                                          
+      aitken = .true.                                                           
+   80 fextrp = t(l-2,lm1)                                                       
+      if (fextrp .gt. fourp5) go to 65                                          
+      if (fextrp .lt. aitlow) go to 175                                         
+      if (dabs(fextrp-t(l-3,lm1))/t(1,lm1) .gt. h2tol) go to 175                
+      sing = fextrp                                                             
+      fextm1 = one/(fextrp - one)                                               
+      ait(1) = zero                                                             
+      do 85 i=2,l                                                               
+         ait(i) = t(i,1) + (t(i,1)-t(i-1,1))*fextm1                             
+         r(i) = t(1,i-1)                                                        
+         dif(i) = ait(i) - ait(i-1)                                             
+   85 continue                                                                  
+      it = 2                                                                    
+   90 vint = step*ait(l)                                                        
+      errer = errer*fextm1                                                      
+      hrerr = ergl+errer                                                        
+      if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 95                     
+      ier = max0(ier,65)                                                        
+      go to 160                                                                 
+   95 it = it + 1                                                               
+      if (it .eq. lm1) go to 125                                                
+      if (it .gt. 3) go to 100                                                  
+      h2next = four                                                             
+      singnx = sing+sing                                                        
+  100 if (h2next .lt. singnx) go to 105                                         
+      fextrp = singnx                                                           
+      singnx = singnx+singnx                                                    
+      go to 110                                                                 
+  105 fextrp = h2next                                                           
+      h2next = four*h2next                                                      
+  110 do 115 i=it,lm1                                                           
+         r(i+1) = zero                                                          
+         hrerr = tabtlm+dabs(dif(i+1))                                          
+         if (hrerr .ne. tabtlm) r(i+1) = dif(i)/dif(i+1)                        
+  115 continue                                                                  
+      h2tfex = -h2tol*fextrp                                                    
+      if (r(l) - fextrp .lt. h2tfex) go to 125                                  
+      if (r(l-1)-fextrp .lt. h2tfex) go to 125                                  
+      errer = astep*dabs(dif(l))                                                
+      fextm1 = one/(fextrp - one)                                               
+      do 120 i=it,l                                                             
+         ait(i) = ait(i) + dif(i)*fextm1                                        
+         dif(i) = ait(i) - ait(i-1)                                             
+  120 continue                                                                  
+      go to 90                                                                  
+c                                  current trapezoid sum and resulting          
+c                                    extrapolated values did not give           
+c                                    a small enough *errer*.                    
+c                                    note -- having prever .lt. errer           
+c                                    is an almost certain sign of               
+c                                    beginning trouble with in the func-        
+c                                    tion values. hence, a watch for,           
+c                                    and control of, noise should               
+c                                    begin here.                                
+  125 fextrp = dmax1(prever/errer,aitlow)                                       
+      prever = errer                                                            
+      if (l .lt. 5) go to 15                                                    
+      if (l-it .gt. 2 .and. istage .lt. mxstge) go to 170                       
+      erret = errer/(fextrp**(maxtbl-l))                                        
+      hrerr = ergl+erret                                                        
+      if (erret .gt. ergoal .and. hrerr .ne. ergl) go to 170                    
+      go to 15                                                                  
+c                                  integrand has jump (see notes)               
+  130 hrerr = ergl+errer                                                        
+      if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 170                    
+c                                  note that  2*fn = 2**l                       
+      diff = dabs(t(1,l))*(fn+fn)                                               
+      go to 160                                                                 
+c                                  integrand is straight line                   
+c                                    test this assumption by comparing          
+c                                    the value of the integrand at              
+c                                    four *randomly chosen* points with         
+c                                    the value of the straight line             
+c                                    interpolating the integrand at the         
+c                                    two end points of the sub-interval.        
+c                                    if test is passed, accept *vint*           
+  135 slope = (fend-fbeg)*two                                                   
+      fbeg2 = fbeg+fbeg                                                         
+      do 140 i=1,4                                                              
+         diff = dabs(f(beg+rn(i)*step) - fbeg2-rn(i)*slope)                     
+         hrerr = tabtlm+diff                                                    
+         if(hrerr .ne. tabtlm) go to 155                                        
+  140 continue                                                                  
+      go to 160                                                                 
+c                                  noise may be dominant feature                
+c                                    estimate noise level by comparing          
+c                                    the value of the integrand at              
+c                                    four *randomly chosen* points with         
+c                                    the value of the straight line             
+c                                    interpolating the integrand at the         
+c                                    two endpoints. if small enough,            
+c                                    accept *vint*                              
+  145 slope = (fend-fbeg)*two                                                   
+      fbeg2 = fbeg+fbeg                                                         
+      i = 1                                                                     
+  150 diff = dabs(f(beg+rn(i)*step) - fbeg2-rn(i)*slope)                        
+  155 errer = dmax1(errer,astep*diff)                                           
+      hrerr = ergl+errer                                                        
+      if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 175                    
+      i = i+1                                                                   
+      if (i .le. 4) go to 150                                                   
+      ier = 66                                                                  
+c                                  intergration over current sub-               
+c                                    interval successful                        
+c                                    add *vint* to *dcadre* and *errer*         
+c                                    to *error*, then set up next sub-          
+c                                    interval, if any.                          
+  160 cadre = cadre + vint                                                      
+      error = error + errer                                                     
+      if (right) go to 165                                                      
+      istage = istage - 1                                                       
+      if (istage .eq. 0) go to 220                                              
+      reglar = reglsv(istage)                                                   
+      beg = begin(istage)                                                       
+      edn = finis(istage)                                                       
+      curest = curest - est(istage+1) + vint                                    
+      iend = ibeg - 1                                                           
+      fend = ts(iend)                                                           
+      ibeg = ibegs(istage)                                                      
+      go to 180                                                                 
+  165 curest = curest + vint                                                    
+      stage = stage+stage                                                       
+      iend = ibeg                                                               
+      ibeg = ibegs(istage)                                                      
+      edn = beg                                                                 
+      beg = begin(istage)                                                       
+      fend = fbeg                                                               
+      fbeg = ts(ibeg)                                                           
+      go to 5                                                                   
+c                                  integration over current subinterval         
+c                                    is unsuccessful. mark subinterval          
+c                                    for further subdivision. set up            
+c                                    next subinterval.                          
+  170 reglar = .true.                                                           
+  175 if (istage .eq. mxstge) go to 205                                         
+      if (right) go to 185                                                      
+      reglsv(istage+1) = reglar                                                 
+      begin(istage) = beg                                                       
+      ibegs(istage) = ibeg                                                      
+      stage = stage*half                                                        
+  180 right = .true.                                                            
+      beg = (beg+edn)*half                                                      
+      ibeg = (ibeg+iend)/2                                                      
+      ts(ibeg) = ts(ibeg)*half                                                  
+      fbeg = ts(ibeg)                                                           
+      go to 10                                                                  
+  185 nnleft = ibeg - ibegs(istage)                                             
+      if (iend+nnleft .ge. maxts) go to 200                                     
+      iii = ibegs(istage)                                                       
+      ii = iend                                                                 
+      do 190 i=iii,ibeg                                                         
+         ii = ii + 1                                                            
+         ts(ii) = ts(i)                                                         
+  190 continue                                                                  
+      do 195 i=ibeg,ii                                                          
+         ts(iii) = ts(i)                                                        
+         iii = iii + 1                                                          
+  195 continue                                                                  
+      iend = iend + 1                                                           
+      ibeg = iend - nnleft                                                      
+      fend = fbeg                                                               
+      fbeg = ts(ibeg)                                                           
+      finis(istage) = edn                                                       
+      edn = beg                                                                 
+      beg = begin(istage)                                                       
+      begin(istage) = edn                                                       
+      reglsv(istage) = reglar                                                   
+      istage = istage + 1                                                       
+      reglar = reglsv(istage)                                                   
+      est(istage) = vint                                                        
+      curest = curest + est(istage)                                             
+      go to 5                                                                   
+c                                  failure to handle given integra-             
+c                                    tion problem                               
+  200 ier = 131                                                                 
+      go to 215                                                                 
+  205 ier = 132                                                                 
+      go to 215                                                                 
+  210 ier = 133                                                                 
+  215 cadre = curest + vint                                                     
+  220 dcadre = cadre                                                            
+ 9000 continue                                                                  
+      if (ier .ne. 0) call uertst (ier,6hdcadre)                                
+ 9005 return                                                                    
+      end     
+
+
+******************************************************************************
+
+	subroutine uertst (ier,name)                                              
+c                                  specifications for arguments                 
+      integer            ier                                                    
+      integer            name(2)                                                
+c                                  specifications for local variables           
+      integer            i,ieq,ieqdf,iounit,level,levold,nameq(6),              
+     *                   namset(6),namupk(6),nin,nmtb                           
+      data               namset/1hu,1he,1hr,1hs,1he,1ht/                        
+      data               nameq/6*1h /                                           
+      data               level/4/,ieqdf/0/,ieq/1h=/                             
+c                                  unpack name into namupk                      
+c                                  first executable statement                   
+      call uspkd (name,6,namupk,nmtb)                                           
+c                                  get output unit number                       
+      call ugetio(1,nin,iounit)                                                 
+c                                  check ier                                    
+      if (ier.gt.999) go to 25                                                  
+      if (ier.lt.-32) go to 55                                                  
+      if (ier.le.128) go to 5                                                   
+      if (level.lt.1) go to 30                                                  
+c                                  print terminal message                       
+      if (ieqdf.eq.1) write(iounit,35) ier,nameq,ieq,namupk                     
+      if (ieqdf.eq.0) write(iounit,35) ier,namupk                               
+      go to 30                                                                  
+    5 if (ier.le.64) go to 10                                                   
+      if (level.lt.2) go to 30                                                  
+c                                  print warning with fix message               
+c      if (ieqdf.eq.1) write(iounit,40) ier,nameq,ieq,namupk                     
+c      if (ieqdf.eq.0) write(iounit,40) ier,namupk                               
+      if (ieqdf.eq.1) continue 
+      if (ieqdf.eq.0) continue 
+      go to 30                                                                  
+   10 if (ier.le.32) go to 15                                                   
+c                                  print warning message                        
+      if (level.lt.3) go to 30                                                  
+      if (ieqdf.eq.1) write(iounit,45) ier,nameq,ieq,namupk                     
+      if (ieqdf.eq.0) write(iounit,45) ier,namupk                               
+      go to 30                                                                  
+   15 continue                                                                  
+c                                  check for uerset call                        
+      do 20 i=1,6                                                               
+         if (namupk(i).ne.namset(i)) go to 25                                   
+   20 continue                                                                  
+      levold = level                                                            
+      level = ier                                                               
+      ier = levold                                                              
+      if (level.lt.0) level = 4                                                 
+      if (level.gt.4) level = 4                                                 
+      go to 30                                                                  
+   25 continue                                                                  
+      if (level.lt.4) go to 30                                                  
+c                                  print non-defined message                    
+      if (ieqdf.eq.1) write(iounit,50) ier,nameq,ieq,namupk                     
+      if (ieqdf.eq.0) write(iounit,50) ier,namupk                               
+   30 ieqdf = 0                                                                 
+      return                                                                    
+   35 format(19h *** terminal error,10x,7h(ier = ,i3,                           
+     1       20h) from imsl routine ,6a1,a1,6a1)                                
+   40 format(27h *** warning with fix error,2x,7h(ier = ,i3,                    
+     1       20h) from imsl routine ,6a1,a1,6a1)                                
+   45 format(18h *** warning error,11x,7h(ier = ,i3,                            
+     1       20h) from imsl routine ,6a1,a1,6a1)                                
+   50 format(20h *** undefined error,9x,7h(ier = ,i5,                           
+     1       20h) from imsl routine ,6a1,a1,6a1)                                
+c                                                                               
+c                                  save p for p = r case                        
+c                                    p is the page namupk                       
+c                                    r is the routine namupk                    
+   55 ieqdf = 1                                                                 
+      do 60 i=1,6                                                               
+   60 nameq(i) = namupk(i)                                                      
+   65 return                                                                    
+      end                          
+
+
+************************************************************************
+
+      subroutine uspkd  (packed,nchars,unpakd,nchmtb)                           
+c                                  specifications for arguments                 
+      integer            nc,nchars,nchmtb                                       
+c                                                                               
+c      integer            unpakd(1),iblank                                       
+      integer            unpakd(nchars),iblank                                       
+      character          packed(1)           ! Modificado el 29-Ago-2001 porque
+!      integer            packed(1)            esto deberia ser CHARACTER, no??
+      data               iblank /1h /                                           
+c                                  initialize nchmtb                            
+      nchmtb = 0                                                                
+c                                  return if nchars is le zero                  
+      if(nchars.le.0) return                                                    
+c                                  set nc=number of chars to be decoded         
+      nc = min0 (129,nchars)                                                   
+!      decode (nc,150,packed) (unpakd(i),i=1,nc)                                
+      read (packed,150) (unpakd(i),i=1,nc)                                
+  150 format (129a1)                                                           
+c                                  check unpakd array and set nchmtb            
+c                                  based on trailing blanks found               
+      do 200 n = 1,nc                                                           
+         nn = nc - n + 1                                                        
+         if(unpakd(nn) .ne. 536870912) go to 210                                
+  200 continue                                                                  
+  210 nchmtb = nn                                                               
+      return                                                                    
+      end            
+
+
+****************************************************************************
+
+      subroutine ugetio(iopt,nin,nout)                                          
+c                                  specifications for arguments                 
+      integer            iopt,nin,nout                                          
+c                                  specifications for local variables           
+      integer            nind,noutd                                             
+      data               nind/5/,noutd/6/                                       
+c                                  first executable statement                   
+      if (iopt.eq.3) go to 10                                                   
+      if (iopt.eq.2) go to 5                                                    
+      if (iopt.ne.1) go to 9005                                                 
+      nin = nind                                                                
+      nout = noutd                                                              
+      go to 9005                                                                
+    5 nind = nin                                                                
+      go to 9005                                                                
+   10 noutd = nout                                                              
+ 9005 return                                                                    
+      end       
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/chemthermos.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/chemthermos.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/chemthermos.F	(revision 2744)
@@ -0,0 +1,151 @@
+      SUBROUTINE chemthermos(ig,lswitch,zycol,ztemp,zdens,zpress,
+     $                       zlocal,zenit,ptimestep,zday)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing chemical variations in the thermosphere
+c
+c   author:  MAC July 2003
+c   ------
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "param.h"
+#include "param_v3.h"
+#include "chimiedata.h"
+#include "conc.h"
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER lswitch,ig
+
+      REAL zday,zycol(nlayermx,nqmx)
+      REAL ptimestep
+      real zenit
+      real ztemp(nlayermx)
+      real zdens(nlayermx)
+      real zpress(nlayermx)			! in mbar
+c
+c    Local variables :
+c    -----------------
+      INTEGER nlayer,l,nesptherm
+      parameter (nesptherm = 11)
+      real tmean
+      real aux1(nlayermx),aux2(nlayermx)
+      real zlocal(nlayermx)
+      real rm(nlayermx,nesptherm) 		!number density (cm-3)
+
+      integer i_co2, i_co, i_o2, i_h2, i_h2o, i_h2o2, 
+     $        i_o1d, i_o, i_h, i_oh, i_ho2
+      integer g_co2, g_co, g_o2, g_h2, g_h2o, g_h2o2, 
+     $        g_o1d, g_o, g_h, g_oh, g_ho2, g_o3, g_n2
+
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+
+c      if (firstcall) then
+c        call param_read
+c        firstcall= .false.
+c      endif
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      g_co2      =  nqchem_min
+      g_co       =  nqchem_min + 1
+      g_o        =  nqchem_min + 2
+      g_o1d      =  nqchem_min + 3
+      g_o2       =  nqchem_min + 4
+      g_o3       =  nqchem_min + 5
+      g_h        =  nqchem_min + 6
+      g_h2       =  nqchem_min + 7
+      g_oh       =  nqchem_min + 8
+      g_ho2      =  nqchem_min + 9
+      g_h2o2     =  nqchem_min + 10
+      g_n2       =  nqchem_min + 11
+      g_h2o      =  nqmx
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the thermospheric chemistry
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      i_co2  = 1
+      i_o2   = 2
+      i_o    = 3
+      i_co   = 4
+      i_h    = 5
+      i_oh   = 6
+      i_ho2  = 7
+      i_h2   = 8
+      i_h2o  = 9
+      i_h2o2 = 10
+      i_o1d  = 11
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      nlayer=nlayermx
+c      zlocal(1)=0.00625
+c      do l=2,nlayer
+c        tmean=ztemp(l)
+c        if(ztemp(l).ne.ztemp(l-1))
+c     &    tmean=(ztemp(l)-ztemp(l-1))/log(ztemp(l)/ztemp(l-1))
+c        zlocal(l)= zlocal(l-1)-log(zpress(l)/zpress(l-1))
+c     &                         *Rnew(ig,l-1)*tmean/g/1000.
+c      enddo
+
+      do l=1,nlayer
+        aux1(l)=0.
+        aux2(l)=0.
+        rm(l,i_co2)  = zycol(l,g_co2)  *zdens(l)  
+        rm(l,i_co)   = zycol(l,g_co)   *zdens(l) 
+        rm(l,i_o)    = zycol(l,g_o)    *zdens(l)
+        rm(l,i_o1d)  = zycol(l,g_o1d)  *zdens(l) 
+        rm(l,i_o2)   = zycol(l,g_o2)   *zdens(l)
+        rm(l,i_h)    = zycol(l,g_h)    *zdens(l) 
+        rm(l,i_h2)   = zycol(l,g_h2)   *zdens(l) 
+        rm(l,i_oh)   = zycol(l,g_oh)   *zdens(l) 
+        rm(l,i_ho2)  = zycol(l,g_ho2)  *zdens(l)
+        rm(l,i_h2o2) = zycol(l,g_h2o2) *zdens(l) 
+        rm(l,i_h2o)  = zycol(l,g_h2o)  *zdens(l) 
+      enddo
+         
+      call flujo(solarcondate+zday/365.)
+
+      call jthermcalc
+     $ (rm(1,i_co2),rm(1,i_o2),rm(1,i_o),rm(1,i_h2),rm(1,i_h2o),
+     &  rm(1,i_h2o2),aux1,aux2,ztemp,nlayermx,zlocal,
+     &  solarcondate+zday/365.,zenit)
+
+      call paramfoto(lswitch,zdens,ztemp,ptimestep/3600.,zenit,
+     &             nlayer,rm(1,i_co2),rm(1,i_o2),rm(1,i_o),
+     &             rm(1,i_co),rm(1,i_h),rm(1,i_oh),rm(1,i_ho2),
+     &             rm(1,i_h2),rm(1,i_h2o),rm(1,i_h2o2),rm(1,i_o1d))
+
+      do l=lswitch,nlayer
+        zycol(l,g_co2)  = max(rm(l,i_co2)  / zdens(l) , 1.e-30)
+        zycol(l,g_co)   = max(rm(l,i_co)   / zdens(l) , 1.E-30)
+        zycol(l,g_o2)   = max(rm(l,i_o2)   / zdens(l) , 1.e-30)
+        zycol(l,g_h2)   = max(rm(l,i_h2)   / zdens(l) , 1.e-30)
+        zycol(l,g_h)    = max(rm(l,i_h)    / zdens(l) , 1.e-30)
+        zycol(l,g_oh)   = max(rm(l,i_oh)   / zdens(l) , 1.e-30)
+        zycol(l,g_ho2)  = max(rm(l,i_ho2)  / zdens(l) , 1.e-30)
+        zycol(l,g_h2o)  = max(rm(l,i_h2o)  / zdens(l) , 1.e-30)
+        zycol(l,g_h2o2) = max(rm(l,i_h2o2) / zdens(l) , 1.e-30)
+        zycol(l,g_o1d)  = max(rm(l,i_o1d)  / zdens(l) , 1.e-30)
+        zycol(l,g_o)    = max(rm(l,i_o)    / zdens(l) , 1.e-30)
+       enddo	!nlayer
+
+
+      return
+      end 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/chimiedata.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/chimiedata.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/chimiedata.h	(revision 2744)
@@ -0,0 +1,61 @@
+c ------------------------------------
+c ---  Data for chemical routines  ---
+c ------------------------------------
+c    Author: Sebastien Lebonnois
+c            Franck Lefevre
+c    
+c  Update after water clouds included
+c ------------------------------------
+c
+      integer    nd, nozo, nr, nsza, ntemp
+c
+      parameter (nd    = 11)
+      parameter (nozo  = 7)
+      parameter (nr    = nd + 28)
+      parameter (nsza  = 27)
+      parameter (ntemp = 4)
+c
+      real       kb
+      parameter (kb = 1.38e-23)
+c
+c     factor: molecular gas constant/(boltzmann*gravity)
+c
+      real       factor
+      parameter (factor = 192./(kb*1.e4*3.72))
+c
+      common/chimiedata/reactifs,nprod,nperte,prod,perte,jphot,
+     $                  colairtab,table_ozo
+c
+c     used in obsolete scheme A :
+      integer    reactifs(nr,5),nprod(nqmx),nperte(nqmx)
+      integer    prod(nqmx,100),perte(nqmx,100,2)
+c
+c     VERSION: 28/05/2004  (update: Ar)
+c
+c     photodissociation rates matrix: version dependent
+c     for this version, file jmars.20030707
+c
+      real       jphot(ntemp,nsza,0:200,nozo,nd)
+      real       colairtab(0:200)
+      real       szatab(nsza)
+      real       table_ozo(nozo)
+c
+      data       szatab/0.,  5., 10., 15., 20., 25.,
+     $                 30., 35., 40., 45., 50., 55.,
+     $                 60., 65., 70., 75., 80., 82.,
+     $                 84., 86., 88., 90., 91., 92.,
+     $                 93., 94., 95./
+c
+c     compounds taken into account: version dependent
+c     DOES NOT INCLUDE h2o (always iq=nqmx)
+c            NOR water ice (if iceparty, iq=nqmx-1)
+c
+      integer       ncomp
+      parameter    (ncomp=13)
+      character*10  nomchem(ncomp)
+      data          nomchem/"co2","co","o","o1d","o2","o3","h","h2",
+     $                   "oh","ho2","h2o2", "n2", "ar"/
+c
+      real  mmolchem(ncomp)
+      data  mmolchem/44.,28.,16.,16.,32.,48.,1.,2.,17.,33.,34.,28.,40./
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/column.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/column.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/column.F	(revision 2744)
@@ -0,0 +1,153 @@
+c**********************************************************************
+
+      subroutine column
+     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,tx,nz,iz,zenit,co2colx,o2colx,
+     $ o3pcolx,h2o2colx)
+
+
+c     nov 2002        fgg           first version
+
+c**********************************************************************
+
+      implicit none
+
+
+c     common variables and constants
+
+      include 'param.h'
+      include 'param_v3.h'
+
+
+
+c    local parameters and variables
+
+
+
+c     input and output variables
+
+      integer    nz
+      real       co2colx(nz)                 !column density of CO2 (cm^-2)
+      real       o2colx(nz)                  !column density of O2(cm^-2)
+      real       o3pcolx(nz)                 !column density of O(3P)(cm^-2)
+      real       h2o2colx(nz)                !column density of H2O2(cm^-2)
+      real       co2x(nz)                    !density of CO2(cm^-3)
+      real       o2x(nz)                     !density of O2(cm^-3)
+      real       o3px(nz)                    !density of O(3P)(cm^-3)
+      real       h2x(nz)                     !density of H2(cm^-3)
+      real       h2ox(nz)                    !density of H2O(cm^-3)
+      real       h2o2x(nz)                   !density of H2O2(cm^-3)
+      real       jtot(nz)                    !output: heating rate(erg/s)
+      real       tx(nz)                      !temperature profile
+      real       iz(nz+1)                    !height profile
+      real       zenit
+
+c     local variables
+
+      real       xx
+      real       grav(nzmax)
+      real       ntx(nzmax)
+      real       pmmixx(nzmax)
+      real       Hmix(nzmax)
+      real       nint(nzmax)
+      real       co2vmrx(nzmax)
+      real       o2vmrx(nzmax)
+      real       o3pvmrx(nzmax)
+      real       h2vmrx(nzmax)
+      real       h2ovmrx(nzmax)
+      real       h2o2vmrx(nzmax)
+      real       Hco2
+      real       Ho3p
+      real       Ho2
+      real       Hh2o2
+      real       chapm(nzmax)
+
+
+
+c     local variables
+
+      integer    i,j,k,icol,indexint          !indexes
+      real*8     znt
+
+c External functions
+
+       external    ch
+       real        ch
+
+
+c*************************PROGRAM STARTS*******************************
+
+      do i=1,nz
+         xx = ( radio + iz(i) ) * 1.e5
+         ntx(i)=co2x(i)+o2x(i)+o3px(i)+h2x(i)+h2ox(i)+h2o2x(i)
+         co2vmrx(i)=co2x(i)/ntx(i)
+         o2vmrx(i)=o2x(i)/ntx(i)
+         o3pvmrx(i)=o3px(i)/ntx(i)
+         h2vmrx(i)=h2x(i)/ntx(i)
+         h2ovmrx(i)=h2ox(i)/ntx(i)
+         h2o2vmrx(i)=h2o2x(i)/ntx(i)
+         pmmixx(i) = (pmco2*co2x(i)+pmo2*o2x(i) 
+     $                + pmo3p*o3px(i))/ntx(i)
+         grav(i) = gg * masa /(xx**2)
+         Hmix(i) = kboltzman*tx(i)*n_avog / (pmmixx(i)*grav(i))
+         nint(i) = -Hmix(i)*ntx(i)*
+     $   (exp((iz(i)-iz(i+1))*1e5/Hmix(i))-1)
+      end do
+
+      xx = kboltzman * tx(nz) * n_avog / grav(nz)
+      Ho3p = xx / pmo3p 
+      Hco2 = xx / pmco2
+      Ho2  = xx / pmo2
+      Hh2o2 = xx / pmh2o2
+      o3pcolx(nz) = o3px(nz) * Ho3p
+      co2colx(nz) = co2x(nz) * Hco2
+      h2o2colx(nz) = h2o2x(nz) * Hh2o2
+      o2colx(nz) = o2x(nz) * Ho2
+      do i=1,nz-1
+         co2colx(i) = co2colx(nz)
+         o2colx(i) = o2colx(nz)
+         o3pcolx(i) = o3pcolx(nz)
+         h2o2colx(i) = h2o2colx(nz)
+         do j=i,nz-1
+            co2colx(i) = co2colx(i) + nint(j) 
+     $                   * ((co2vmrx(j+1) + co2vmrx(j)) / 2.)
+            o2colx(i) = o2colx(i) + nint(j)
+     $                  * ((o2vmrx(j+1) + o2vmrx(j)) / 2.)
+            o3pcolx(i) = o3pcolx(i) + nint(j)
+     $                   * ((o3pvmrx(j+1) + o3pvmrx(j)) /2.)
+            h2o2colx(i) = h2o2colx(i) +nint(j)
+     $                     * ((h2o2vmrx(j+1) + h2o2vmrx(j)) / 2.)
+         end do
+      end do
+
+      znt=zenit*3.1416/180.
+      if(zenit.gt.80.0) then
+         do i=1,nz
+            chapm(i) =  
+     $           ch( (iz(i)+radio)/(Hmix(i)*1.e-5),znt)
+         enddo
+      end if
+      znt=zenit*3.1416/180.
+      do i=1,nz
+         if(zenit.le.80.0) then
+            co2colx(i)=co2colx(i)/cos(znt)
+            o2colx(i)=o2colx(i)/cos(znt)
+            o3pcolx(i)=o3pcolx(i)/cos(znt)
+            h2o2colx(i)=h2o2colx(i)/cos(znt)
+         else
+            co2colx(i)=co2colx(i)*chapm(i)
+            o2colx(i)=o2colx(i)*chapm(i)
+            o3pcolx(i)=o3pcolx(i)*chapm(i)
+            h2o2colx(i)=h2o2colx(i)*chapm(i)
+         end if
+      end do
+
+
+      return
+
+
+      end
+
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/conc.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/conc.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/conc.h	(revision 2744)
@@ -0,0 +1,18 @@
+c**********************************************************************
+
+c	conc.h
+	
+c**********************************************************************
+
+      integer ncomptot
+
+      parameter (ncomptot=ncomp+1)
+
+      common/conc/mmean,Akknew,cpnew,rnew
+ 
+      real mmean(ngridmx,nlayermx)
+      real Akknew(ngridmx,nlayermx)
+      real cpnew(ngridmx,nlayermx)
+      real rnew(ngridmx,nlayermx)
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/concentrations.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/concentrations.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/concentrations.F	(revision 2744)
@@ -0,0 +1,177 @@
+      SUBROUTINE concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+                                             
+       IMPLICIT NONE
+c=======================================================================
+
+c CALCULATION OF MEAN MOLECULAR MASS, Cp, Akk and R
+c
+c mmean(ngridmx,nlayermx)			amu
+c cpnew(ngridmx,nlayermx)			J/kg/K
+c rnew(ngridmx,nlayermx)			J/kg/K
+c akknew(ngridmx,nlayermx)			coefficient of thermal concduction
+c
+c=======================================================================
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer
+
+      REAL pplay(ngridmx,nlayermx)
+      REAL pt(ngridmx,nlayermx)
+      REAL pdt(ngridmx,nlayermx)
+      real pq(ngridmx,nlayermx,nqmx)
+      REAL pdq(ngridmx,nlayermx,nqmx)
+      REAL ptimestep
+
+c    Local variables :
+c    -----------------
+      INTEGER iq,l,ig,ll,n,k,nq
+      integer gind(ncomptot)
+      real ni(ncomptot)
+      real nt, ntot
+      real q2(ngridmx,nlayermx,ncomptot)
+      real zt(ngridmx,nlayermx)
+      real q2tot(ngridmx,nlayermx)
+      real aki(ncomptot)
+      real cpi(ncomptot)
+
+      integer i_co2, i_co, i_o2, i_h2, i_h2o, i_h2o2,
+     $        i_o1d, i_o, i_h, i_oh, i_ho2, i_n2, i_o3, i_ar
+
+c      save    aki, cpi
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering for the thermal conduction and
+c     specific heat coefficients
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      i_co2  = 1
+      i_co   = 2
+      i_o    = 3
+      i_o1d  = 4
+      i_o2   = 5
+      i_o3   = 6
+      i_h    = 7
+      i_h2   = 8
+      i_oh   = 9
+      i_ho2  = 10
+      i_h2o2 = 11
+      i_n2   = 12
+      i_ar   = 13
+      i_h2o  = 14
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      gind(i_co2)   =  nqchem_min			! co2
+      gind(i_co)    =  nqchem_min + 1			! co
+      gind(i_o)     =  nqchem_min + 2			! o
+      gind(i_o1d)   =  nqchem_min + 3			! o1d
+      gind(i_o2)    =  nqchem_min + 4			! o2
+      gind(i_o3)    =  nqchem_min + 5			! o3
+      gind(i_h)     =  nqchem_min + 6			! h
+      gind(i_h2)    =  nqchem_min + 7			! h2
+      gind(i_oh)    =  nqchem_min + 8			! oh
+      gind(i_ho2)   =  nqchem_min + 9			! ho2
+      gind(i_h2o2)  =  nqchem_min + 10			! h2o2
+      gind(i_n2)    =  nqchem_min + 11			! n2
+      gind(i_ar)    =  nqchem_min + 12			! ar
+      gind(i_h2o)   =  nqmx				! h2o
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     Thermal conductivity and specific heat coefficients
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      aki(i_co2)  = 3.072e-4
+      aki(i_co)   = 4.87e-4
+      aki(i_o)    = 7.59e-4
+      aki(i_o1d)  = 7.59e-4		!?
+      aki(i_o2)   = 5.68e-4
+      aki(i_o3)   = 3.00e-4		!?
+      aki(i_h)    = 0.0
+      aki(i_h2)   = 36.314e-4
+      aki(i_oh)   = 7.00e-4		!?
+      aki(i_ho2)  = 0.0
+      aki(i_h2o2) = 0.0
+      aki(i_n2)   = 5.6e-4
+      aki(i_ar)   = 0.0                 !?
+      aki(i_h2o)  = 0.0
+
+      cpi(i_co2)   = 0.834e3
+      cpi(i_co)    = 1.034e3
+      cpi(i_o)     = 1.3e3
+      cpi(i_o1d)   = 1.3e3		!?
+      cpi(i_o2)    = 0.9194e3
+      cpi(i_o3)    = 0.800e3	!?
+      cpi(i_h)     = 20.780e3
+      cpi(i_h2)    = 14.266e3
+      cpi(i_oh)    = 1.045e3
+      cpi(i_ho2)   = 1.065e3	!?
+      cpi(i_h2o2)  = 1.000e3	!?
+      cpi(i_n2)    = 1.034e3
+      cpi(i_ar)    = 1.000e3    !?
+      cpi(i_h2o)   = 1.870e3
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      nlayer=nlayermx
+      ngrid=ngridmx
+      nq=nqmx
+
+      DO l=1,nlayer
+        DO ig=1,ngrid
+          DO n=1,ncomptot
+            q2(ig,l,n)=max(1.e-30,
+     .         pq(ig,l,gind(n))+pdq(ig,l,gind(n))*ptimestep)
+          ENDDO
+          zt(ig,l)=pt(ig,l) +pdt(ig,l)*ptimestep
+        ENDDO
+      ENDDO
+  
+      do l=1,nlayermx
+        do ig=1,ngridmx
+          ntot=pplay(ig,l)/(1.381e-23*zt(ig,l))*1.e-6  ! in #/cm3
+          cpnew(ig,l)=0.
+          akknew(ig,l)=0.
+          mmean(ig,l)=0.
+          q2tot(ig,l)=0.
+          nt=0.
+          do n=1,ncomptot
+            ni(n)=0.0 
+            do k=1,ncomptot
+              if(k.ne.n) ni(n)=ni(n)+q2(ig,l,k)/mmol(gind(k))
+            enddo
+            ni(n)=ntot/(1.+mmol(gind(n))/q2(ig,l,n)*ni(n))
+            cpnew(ig,l)=cpnew(ig,l)+ni(n)*cpi(n)
+            akknew(ig,l)=akknew(ig,l)+ni(n)*aki(n)
+            mmean(ig,l)=mmean(ig,l)+q2(ig,l,n)/mmol(gind(n))
+            q2tot(ig,l)=q2tot(ig,l)+q2(ig,l,n)
+c        if(ig.eq.1.and.l.eq.1) write(*,*)'q2tot(ig,l)',n,q2tot(ig,l) 
+            if(cpi(n) .ne. 0.0) nt=nt+ni(n)
+          enddo 
+
+c     print*,"concentrations rep 3",l,ig,nt,mmean(ig,l),zt(ig+1,l)
+
+          cpnew(ig,l)=cpnew(ig,l)/nt
+          akknew(ig,l)=akknew(ig,l)/nt
+          mmean(ig,l)=1/mmean(ig,l)    ! in amu
+          rnew(ig,l)=8.314/mmean(ig,l)*1.e3     ! J/kg/K		
+        enddo
+c        print*,l,mmean(1,l),cpnew(1,l),rnew(1,l)
+c         write(228,*),l,pplay(1,l),ntot
+      enddo
+      return
+      end 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/conduction.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/conduction.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/conduction.F	(revision 2744)
@@ -0,0 +1,178 @@
+       SUBROUTINE conduction(ptimestep,pplay,pplev,pt,pdt,
+     $                   tsurf,zzlev,zzlay,zdtconduc)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Molecular thermal conduction
+c   
+c   N. Descamp, F. Forget 05/1999
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c-----------------------------------------------------------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "surfdat.h"
+#include "chimiedata.h"
+#include "conc.h"
+
+c   arguments:
+c   ----------
+
+      REAL ptimestep
+      REAL pplay(ngridmx,nlayermx)
+      real pplev(ngridmx,nlayermx+1)
+      REAL zzlay(ngridmx,nlayermx)
+      real zzlev(ngridmx,nlayermx+1)
+      REAL pt(ngridmx,nlayermx)
+      real pdt(ngridmx,nlayermx)
+      real tsurf(ngridmx)
+
+      real zdtconduc(ngridmx,nlayermx)
+
+c   local:
+c   ------
+
+      INTEGER i,ig,l, ngrid, nz
+      real Akk,skk,phitop,m,tmean
+      REAL alpha(nlayermx)
+      real zt(nlayermx)
+      REAL lambda(nlayermx)
+      real muvol(nlayermx)
+      REAL C(nlayermx)
+      real D(nlayermx)
+      real den(nlayermx)
+      REAL pdtc(nlayermx)
+      real zlay(nlayermx)
+      real zlev(nlayermx+1)
+
+c   constants used locally
+c    ---------------------
+c     The atmospheric conductivity is a function of temperature T :
+c      conductivity = Akk* T**skk
+      PARAMETER (skk=0.69)
+      
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+c-----------------------------------------------------------------------
+c   calcul des coefficients alpha et lambda
+c-----------------------------------------------------------------------
+
+      IF (firstcall) THEN
+        write (*,*) 'coeff to compute molecular conductivity Akk,skk'
+        write(*,*) Akk,skk
+        firstcall = .false.
+      END IF
+
+! Initialize phitop
+      phitop=0.0
+      
+      ngrid=ngridmx
+      nz=nlayermx
+
+      do ig=1,ngrid
+
+        zt(1)=pt(ig,1)+pdt(ig,1)*ptimestep
+c        zlay(1)=-log(pplay(ig,1)/pplev(ig,1))*Rnew(ig,1)*zt(1)/g
+c        zlev(1)=0.0
+        zlay(1)=zzlay(ig,1)
+        zlev(1)=zzlev(ig,1)
+      
+        do i=2,nz
+
+          zt(i)=pt(ig,i)+pdt(ig,i)*ptimestep 
+c          tmean=zt(i)
+c          if(zt(i).ne.zt(i-1))
+c     &    tmean=(zt(i)-zt(i-1))/log(zt(i)/zt(i-1))
+c          zlay(i)= zlay(i-1)
+c     &          -log(pplay(ig,i)/pplay(ig,i-1))*Rnew(ig,i-1)*tmean/g
+c          zlev(i)= zlev(i-1)
+c     &         -log(pplev(ig,i)/pplev(ig,i-1))*Rnew(ig,i-1)*tmean/g
+        zlay(i)=zzlay(ig,i)
+        zlev(i)=zzlev(ig,i)
+        enddo
+        
+c        zlev(nz+1)= zlev(nz)
+c     &         -log(max(pplev(ig,nz+1),1.e-30)/pplev(ig,nz))
+c     &           *Rnew(ig,nz)*tmean/g
+c        if(pplev(ig,nz+1).eq.0.) 
+c     &     zlev(nz+1)=zlev(nz)+(zlay(nz)-zlay(nz-1))
+      
+        zlev(nz+1)= zlev(nz)+10000.
+
+        Akk=Akknew(ig,1) 
+        lambda(1) = Akk*tsurf(ig)**skk/zlay(1)   
+
+        DO i = 2 , nz
+          Akk=Akknew(ig,i) 
+          lambda(i)=Akk*zt(i)**skk/(zlay(i)-zlay(i-1)) 
+        ENDDO
+        DO i=1,nz-1
+          muvol(i)=pplay(ig,i)/(rnew(ig,i)*zt(i)) 
+          alpha(i)=cpnew(ig,i)*(muvol(i)/ptimestep)
+     $                        *(zlev(i+1)-zlev(i))
+        ENDDO
+
+        muvol(nz)=pplay(ig,nz)/(rnew(ig,nz)*zt(nz)) 
+        alpha(nz)=cpnew(ig,i)*(muvol(nz)/ptimestep)
+     $                       *(zlev(nz+1)-zlev(nz))
+
+c--------------------------------------------------------------------
+c
+c     calcul des coefficients C et D
+c
+c-------------------------------------------------------------------
+
+      den(1)=alpha(1)+lambda(2)+lambda(1)
+      C(1)=lambda(1)*(tsurf(ig)-zt(1))+lambda(2)*(zt(2)-zt(1))
+      C(1)=C(1)/den(1)	     
+      D(1)=lambda(2)/den(1)           
+   
+      DO i = 2,nz-1
+        den(i)=alpha(i)+lambda(i+1)
+        den(i)=den(i)+lambda(i)*(1-D(i-1))
+         
+        C(i) =lambda(i+1)*(zt(i+1)-zt(i)) 
+     $       +lambda(i)*(zt(i-1)-zt(i)+C(i-1))    
+        C(i) =C(i)/den(i)           
+
+        D(i) =lambda(i+1) / den(i)
+      ENDDO 
+
+      den(nz)=alpha(nz) + lambda(nz) * (1-D(nz-1))
+      C(nz)=C(nz-1)+zt(nz-1)-zt(nz) 
+      C(nz)=(C(nz)*lambda(nz)+phitop) / den(nz) 
+       	 	
+c----------------------------------------------------------------------
+c
+c      calcul de la nouvelle temperature ptconduc
+c
+c----------------------------------------------------------------------
+
+      DO i=1,nz
+        pdtc(i)=0.
+      ENDDO
+      pdtc(nz)=C(nz)
+      DO i=nz-1,1,-1
+        pdtc(i)=C(i)+D(i)*pdtc(i+1)
+      ENDDO 
+c-----------------------------------------------------------------------
+c
+c     calcul de la tendance zdtconduc
+c
+c-----------------------------------------------------------------------
+    
+      DO i=1,nz
+        zdtconduc(ig,i)=pdtc(i)/ptimestep
+      ENDDO
+
+      ENDDO             ! boucle sur ngrid
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/dtridgl.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/dtridgl.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/dtridgl.F	(revision 2744)
@@ -0,0 +1,36 @@
+      SUBROUTINE DTRIDGL(L,AF,BF,CF,DF,XK)
+
+C  GCM2.0  Feb 2003
+
+C     DOUBLE PRECISION VERSION OF TRIDGL
+
+      PARAMETER (NMAX=201)
+      IMPLICIT REAL*8  (A-H,O-Z)
+      DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
+      DIMENSION AS(NMAX),DS(NMAX)
+
+C*    THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
+C*    EQUATIONS. THE FORM OF THE EQUATIONS ARE:
+C*    A(I)*X(I-1) + B(I)*X(I) + C(I)*X(I+1) = D(I)
+C*    WHERE I=1,L  LESS THAN 103.
+C* ..............REVIEWED -CP........
+
+C======================================================================C
+
+      AS(L) = AF(L)/BF(L)
+      DS(L) = DF(L)/BF(L)
+
+      DO I=2,L
+        X         = 1./(BF(L+1-I) - CF(L+1-I)*AS(L+2-I))
+        AS(L+1-I) = AF(L+1-I)*X
+        DS(L+1-I) = (DF(L+1-I)-CF(L+1-I)*DS(L+2-I))*X
+      END DO
+ 
+      XK(1)=DS(1)
+      DO I=2,L
+        XKB   = XK(I-1)
+        XK(I) = DS(I)-AS(I)*XKB
+      END DO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/euvheat.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/euvheat.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/euvheat.F	(revision 2744)
@@ -0,0 +1,183 @@
+      SUBROUTINE euvheat(pt,pdt,pplev,pplay,zzlay,dist_sol,
+     $     mu0,ptimestep,ptime,zday,pq,pdq,pdteuv)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing heating rate due to EUV absorption
+c
+c   author:  MAC 2002
+c   ------
+c
+c   input:
+c   ----- 
+c   dist_sol		  sun-Mars distance (AU)
+c   mu0(ngridmx)           
+c   pplay(ngrid,nlayer)   pressure at middle of layers (Pa)
+c
+c   output:
+c   -------
+c
+c   pdteuv(ngrid,nlayer)      Heating rate (K/s)
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "param.h"
+#include "param_v3.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+
+      REAL pplay(ngridmx,nlayermx)
+      REAL zzlay(ngridmx,nlayermx)
+      real pplev(ngridmx,nlayermx+1)
+      REAL pt(ngridmx,nlayermx)
+      REAL pdt(ngridmx,nlayermx)
+      real zday
+      REAL dist_sol
+      real mu0(ngridmx)
+      real pq(ngridmx,nlayermx,nqmx)
+      real pdq(ngridmx,nlayermx,nqmx)
+      real ptimestep,ptime
+
+
+      REAL pdteuv(ngridmx,nlayermx)
+c
+c    Local variables :
+c    -----------------
+      integer nespeuv
+      parameter (nespeuv=6)
+
+      INTEGER l,iq,ig,n,inif, ngrid, nlayer
+      real rm(nlayermx,nespeuv)				! number density (cm-3)
+      real zq(ngridmx,nlayermx,nqmx)
+      real zt(ngridmx,nlayermx)
+      real zlocal(nlayermx)
+      real zenit
+      real aux1(nlayermx)
+      real aux2(nlayermx)
+      real jtot(nlayermx)
+      real dens								! amu/cm-3
+      real tx(nlayermx)
+      real tmean
+      
+      integer i_co2, i_o2, i_h2, i_h2o, i_h2o2, i_o
+      integer g_co2, g_co, g_o2, g_h2, g_h2o, g_h2o2,
+     $        g_o1d, g_o, g_h, g_oh, g_ho2, g_o3, g_n2
+
+
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+
+      if (firstcall) then
+        if ((nqchem_min+nespeuv).gt.nqmx) then
+          print*,'******* Dimension problem in EUVHEAT ********'
+          STOP
+        endif
+
+        firstcall= .false.
+        print*,'EUV',nlayer,nlayermx,ngrid,ngridmx   
+      endif
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      g_co2      =  nqchem_min
+      g_co       =  nqchem_min + 1
+      g_o        =  nqchem_min + 2
+      g_o1d      =  nqchem_min + 3
+      g_o2       =  nqchem_min + 4
+      g_o3       =  nqchem_min + 5
+      g_h        =  nqchem_min + 6
+      g_h2       =  nqchem_min + 7
+      g_oh       =  nqchem_min + 8
+      g_ho2      =  nqchem_min + 9
+      g_h2o2     =  nqchem_min + 10
+      g_n2       =  nqchem_min + 11
+      g_h2o      =  nqmx
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the EUV heating
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      i_co2  = 1
+      i_o2   = 2
+      i_o    = 3
+      i_h2   = 4
+      i_h2o  = 5
+      i_h2o2 = 6
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      do l=1,nlayermx
+        do ig=1,ngridmx
+          do iq=nqchem_min,nqmx
+            zq(ig,l,iq)=pq(ig,l,iq)+pdq(ig,l,iq)*ptimestep
+          enddo
+          zt(ig,l)=pt(ig,l)+pdt(ig,l)*ptimestep
+        enddo
+      enddo
+
+      call flujo(solarcondate)
+c     call flujo(solarcondate+zday/365.) ! version with EUV time evolution
+
+      do ig=1,ngridmx
+
+        zenit=acos(mu0(ig))*180./acos(-1.)
+ 
+        do l=1,nlayermx
+          dens=pplay(ig,l)/(rnew(ig,l)*zt(ig,l)) / 1.66e-21
+          rm(l,i_co2)  = zq(ig,l,g_co2)  * dens / mmol(g_co2)
+          rm(l,i_o2)   = zq(ig,l,g_o2)   * dens / mmol(g_o2)
+          rm(l,i_o)    = zq(ig,l,g_o)    * dens / mmol(g_o)
+          rm(l,i_h2)   = zq(ig,l,g_h2)   * dens / mmol(g_h2)
+          rm(l,i_h2o)  = zq(ig,l,g_h2o)  * dens / mmol(g_h2o)
+          rm(l,i_h2o2) = zq(ig,l,g_h2o2) * dens / mmol(g_h2o2)
+        enddo
+
+c        zlocal(1)=-log(pplay(ig,1)/pplev(ig,1))
+c     &            *Rnew(ig,1)*zt(ig,1)/g
+        zlocal(1)=zzlay(ig,1)
+        zlocal(1)=zlocal(1)/1000.
+        tx(1)=zt(ig,1)
+
+        do l=2,nlayermx
+          tx(l)=zt(ig,l)
+          tmean=tx(l)
+          if(tx(l).ne.tx(l-1))
+     &    tmean=(tx(l)-tx(l-1))/log(tx(l)/tx(l-1))
+c          zlocal(l)= zlocal(l-1)
+c     &   -log(pplay(ig,l)/pplay(ig,l-1))*Rnew(ig,l-1)*tmean/g/1000.
+        zlocal(l)=zzlay(ig,l)/1000.
+        enddo
+
+        call hrtherm (rm(1,i_co2),rm(1,i_o2),rm(1,i_o),
+     &                rm(1,i_h2),rm(1,i_h2o),rm(1,i_h2o2),
+     &                aux1,aux2,tx,nlayermx,zlocal,
+     &                solarcondate+zday/365.,zenit,jtot)
+
+        do l=1,nlayermx
+          pdteuv(ig,l)=0.16*jtot(l)/10.
+     &            /(cpnew(ig,l)*pplay(ig,l)/(rnew(ig,l)*zt(ig,l)))
+     &                  *(1.52/dist_sol)**2 
+
+        enddo	
+
+      enddo  !ngrid
+
+      return
+      end 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/flujo.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/flujo.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/flujo.F	(revision 2744)
@@ -0,0 +1,48 @@
+c***************************************************
+
+      subroutine flujo(date)
+
+
+c     fgg           nov 2002     first version
+c***************************************************
+
+      implicit none
+
+
+c     common variables and constants
+
+      include 'param.h'
+      include 'param_v3.h'
+
+
+c     Arguments
+
+      real date
+
+
+c     Local variable and constants
+
+      integer i
+      integer inter
+      real    nada
+
+c*************************************************
+
+      if(date.lt.1985.) date=1985.
+      if(date.gt.2001.) date=2001.
+      
+      do i=1,ninter
+        if(i.le.24) then
+          fluxtop(i)=(((ct1(i)+p1(i)*date)/2.)
+     $                *sin(2.*3.1416/11.*(date-1985.-3.1416))
+     $                +(ct2(i)+p2(i)*date)+1.)*fluxtophr(i)
+        else
+          fluxtop(i)=fluxtophr(i)
+        end if
+      end do
+     
+      return
+      end
+      
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/getch.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/getch.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/getch.F	(revision 2744)
@@ -0,0 +1,76 @@
+c***************************************************************************
+       subroutine getch (tt)
+
+c	NOV 98	MALV 		First Version. From the work:
+c                               Rodrigo et al, Atmosfera, 3, pp.31-43, 19990
+c       apr 02  FGG             New reactions
+c       jul 03  MAC             Updated to agree with lower atmosphere
+c***************************************************************************
+	
+      implicit none
+
+      include 'param.h'
+      include 'param_v3.h'
+
+c Arguments 	
+      real*8 		tt		! Temperature 
+
+
+c**************************************************************************
+
+ch2: h + o2 + co2 --> ho2 + co2
+      ch2 = 1.3d-31 * exp(tt / 300.) ** (-1.6)
+
+ch3: o + ho2 --> oh + o2
+      ch3 = 3.0d-11 * exp(200.d0 / tt)
+
+ch4: co + oh --> co2 + h
+      ch4 = 1.57d-13 + 3.54d-33
+
+ch5: ho2 + ho2 --> h2o2 + o2
+      ch5 = 1.5d-12 * exp(19.d0 / tt)
+
+ch7: oh + ho2 --> h2o + o2
+      ch7 = 4.8d-11 * exp(250.d0 / tt)
+
+ch9: o(1d) + h2o --> 2oh
+      ch9 = 2.2d-10
+
+ch10: o + o + co2 --> o2 + co2
+      ch10 = 2.5 * 5.2d-35 * exp(900. / tt) 
+
+ch11: o + oh --> o2 + h
+      ch11 = 2.2d-11 * exp(120.d0 / tt)
+
+ch13: h + ho2 --> h2 + o2
+      ch13 = 6.48d-12
+
+ch14: o(1d) + h2 --> h + oh
+      ch14 = 1.1d-10
+
+ch15: oh + h2 --> h + h2o
+      ch15 = 5.5d-12 * exp (-2000.d0 / tt)
+
+ch18: oh + h2o2 --> h2o + ho2
+      ch18 = 2.9d-12 * exp (-160.d0 / tt)
+
+ch19: o(1d) + co2 --> o + co2
+      ch19 = 7.4d-11 * exp(120.d0 / tt)
+
+ch20: o(1d) + o2 --> o + o2
+      ch20 = 3.2d-11 * exp (70.d0 / tt)
+
+ch21: o + o2 + co2 --> o3 + co2
+      ch21 = 2.5 * 6.0d-34 * (tt / 300.) ** (-2.4) 
+
+      return 
+      end
+
+
+
+
+
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/hrtherm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/hrtherm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/hrtherm.F	(revision 2744)
@@ -0,0 +1,100 @@
+c**********************************************************************
+
+      subroutine hrtherm
+     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit,jtot)
+
+
+c     feb 2002        fgg           first version
+c     nov 2002        fgg           second version
+
+c**********************************************************************
+
+      implicit none
+
+c     common variables and constants
+
+      include 'param.h'
+      include 'param_v3.h'
+      include 'callkeys.h'
+
+
+c    local parameters and variables
+
+      real       xabsi(nabs,nzmax) 			!densities
+      real       nada
+      real       jergs(ninter,nabs,nzmax)
+      
+      integer    i,j,k,indexint          !indexes
+      character  dn
+
+
+c     input and output variables
+
+      integer    nz                          !number of layers
+      real       co2x(nz)                    !density of CO2(cm^-3)
+      real       o2x(nz)                     !density of O2(cm^-3)
+      real       o3px(nz)                    !density of O(3P)(cm^-3)
+      real       h2x(nz)                     !density of H2(cm^-3)
+      real       h2ox(nz)                    !density of H2O(cm^-3)
+      real       h2o2x(nz)                   !density of H2O2(cm^-3)
+      real       aux1(nz)	  	             !auxiliar variable
+      real       aux2(nz)                    !auxiliar variable
+      real       jtot(nz)                    !output: heating rate(erg/s)
+      real       tx(nz)                      !temperature
+      real       date
+      real       zenit
+      real       iz(nz)
+
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+
+c*************************PROGRAM STARTS*******************************
+
+c      if (firstcall) then
+c        if(.not. thermochem) call param_read
+c        firstcall= .false.
+c      endif
+
+      if(zenit.gt.100.) then
+         dn='n'
+         else
+         dn='d'
+      end if
+      if(dn.eq.'n') then
+        do i=1,nz                                    
+	      jtot(i)=0.
+        enddo       
+        return
+      endif 
+     
+      do i=1,nz
+         xabsi(1,i) = co2x(i)
+         xabsi(2,i) = o2x(i)
+         xabsi(3,i) = o3px(i)
+         xabsi(4,i) = h2ox(i)
+         xabsi(5,i) = h2x(i)
+         xabsi(6,i) = h2o2x(i)
+         jtot(i) = 0.
+      end do
+
+      if(.not. thermochem) then
+        call jthermcalc
+     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit)
+      endif
+
+      do i=1,nz
+        do j=1,nabs
+          do indexint=1,33
+            jergs(indexint,j,i) = jfotsout(indexint,j,i) 
+     $              * xabsi (j,i) * fluxtop(indexint)  
+     $              / (0.5e9 * freccen(indexint))
+            jtot(i)=jtot(i)+jergs(indexint,j,i)
+          end do
+        end do
+      end do
+
+      return
+
+      end
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inichim.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inichim.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inichim.F	(revision 2744)
@@ -0,0 +1,309 @@
+      subroutine inichim(pq,sig)
+
+      implicit none
+
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c  Initialization of the composition for use in testphys1d.F
+c
+c   Author:   Sebastien Lebonnois (08/11/2002)
+c   -------
+c            update 12/06/2003
+c            update july 2003: Monica Angelats-i-Coll
+c
+c   Arguments:
+c   ----------
+c
+c    pq(ngridmx,nlayermx,nqmx)  Advected fields, ie chemical species here
+c    sig = sigma                vertical coordinate (interface of layers)
+c
+c=======================================================================
+
+c    Declarations :
+c    --------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "datafile.h"
+
+c Arguments :
+c -----------
+
+      real    pq(ngridmx,nlayermx,nqmx)  ! chemical species mass mixing ratio
+      real    sig(llm+1)                 ! vertical coordinate (interface of layers)
+
+c Local variables :
+c -----------------
+
+      integer  ig,l,iq, n,i,j,iqmax
+      real     zy(ngridmx,nlayermx,nqmx) ! Composition in MOLE fractions
+      REAL qtot(ngridmx,nlayermx)
+      INTEGER aa(nqmx)  ! relation GCM<->files
+      real densconc,zgcm,zfile(252),vmrint,nt, mmean
+      real nxf(252),zfilemin(252),sigfile(252)
+      real vmrf(252,14),nf(252,14)
+      real tfile(252),zzfile(252)
+      real ni(14)       ! densities from files (interpolated for GCM)
+
+      real mmolf(14)    ! molecular mass in amu (species in files)
+      data mmolf/44.,40.,28.,32.,28.,16.,2.,   ! majors
+     .           1.,17.,33.,18.,34.,16.,48./   ! minors
+
+      character*3 tmp  ! temporary variable
+      integer ierr,lnblnk
+      external lnblnk
+
+
+c Dimension test:
+c ---------------
+
+       if (iceparty) then
+         if ((nqchem_min+ncomp+1).ne.nqmx) then
+            print*,'********* Dimension problem! ********'
+            print*,"nqchem_min+ncomp+1).ne.nqmx"
+            print*,"ncomp: ",ncomp
+            print*,"nqchem_min: ",nqchem_min
+            print*,"nqmx: ",nqmx
+            print*,'Change ncomp in chimiedata.h'
+            STOP
+         endif
+       else
+         if ((nqchem_min+ncomp).ne.nqmx) then
+            print*,'********* Dimension problem! ********'
+            print*,"nqchem_min+ncomp).ne.nqmx"
+            print*,"ncomp: ",ncomp
+            print*,"nqchem_min: ",nqchem_min
+            print*,"nqmx: ",nqmx
+            print*,'Change ncomp in chimiedata.h'
+            STOP
+         endif
+       endif
+
+c noms and mmol vectors:
+c ----------------------
+
+       if (iceparty) then
+          do iq=nqchem_min,nqmx-2
+            noms(iq) = nomchem(iq-nqchem_min+1)
+            mmol(iq) = mmolchem(iq-nqchem_min+1)
+          enddo
+          noms(nqmx-1) = 'ice'
+          mmol(nqmx-1) = 18.
+          noms(nqmx)   = 'h2o'
+          mmol(nqmx)   = 18.
+       else
+          do iq=nqchem_min,nqmx-1
+            noms(iq) = nomchem(iq-nqchem_min+1)
+            mmol(iq) = mmolchem(iq-nqchem_min+1)
+          enddo
+          noms(nqmx)   = 'h2o'
+          mmol(nqmx)   = 18.
+       endif
+       if (nqchem_min.gt.1) then
+          do iq=1,nqchem_min-1
+            noms(iq) = 'dust'
+            mmol(iq) = 100.
+          enddo
+       endif
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracers numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     co2      =  nqchem_min
+c     co       =  nqchem_min + 1
+c     o        =  nqchem_min + 2
+c     o(1d)    =  nqchem_min + 3
+c     o2       =  nqchem_min + 4
+c     o3       =  nqchem_min + 5
+c     h        =  nqchem_min + 6
+c     h2       =  nqchem_min + 7
+c     oh       =  nqchem_min + 8
+c     ho2      =  nqchem_min + 9
+c     h2o2     =  nqchem_min + 10
+c     n2       =  nqchem_min + 11
+c     ar       =  nqchem_min + 12
+c     h2o      =  nqmx
+c
+c----------------------------------------------------------------------
+c Major species in files:
+c
+c       1=CO2
+c       2=AR
+c       3=N2
+c       4=O2
+c       5=CO
+c       6=O
+c       7=H2
+c
+c Minor species in files:
+c
+c       1=H
+c       2=OH
+c       3=HO2
+c       4=H2O
+c       5=H2O2
+c       6=O1D
+c       7=O3
+c
+c----------------------------------------------------------------------
+c Major species:
+        aa(nqchem_min)      = 1
+        aa(nqchem_min + 12) = 2
+        aa(nqchem_min + 11) = 3
+        aa(nqchem_min + 4)  = 4
+        aa(nqchem_min + 1)  = 5
+        aa(nqchem_min + 2)  = 6
+        aa(nqchem_min + 7)  = 7
+c Minor species:
+        aa(nqchem_min + 6)  = 8
+        aa(nqchem_min + 8)  = 9
+        aa(nqchem_min + 9)  = 10
+        aa(nqmx)            = 11
+        aa(nqchem_min + 10) = 12
+        aa(nqchem_min + 3)  = 13
+        aa(nqchem_min + 5)  = 14
+c----------------------------------------------------------------------
+
+      open(210, iostat=ierr,file=
+     & datafile(1:lnblnk(datafile))//'/atmosfera_LMD_may.dat')
+      if (ierr.ne.0) then
+        write(*,*)'Error : cannot open file atmosfera_LMD_may.dat '
+        write(*,*)'(in aeronomars/inichim.F)'
+        write(*,*)'It should be in :', datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary atmosfera_LMD_may.dat (and others)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+         STOP
+      endif
+      open(220, iostat=ierr,file=
+     & datafile(1:lnblnk(datafile))//'/atmosfera_LMD_min.dat')
+      if (ierr.ne.0) then
+        write(*,*)'Error : cannot open file atmosfera_LMD_min.dat '
+        write(*,*)'(in aeronomars/inichim.F)'
+        write(*,*)'It should be in :', datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary atmosfera_LMD_min.dat (and others)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+         STOP
+      endif
+      read(210,*) tmp
+      read(220,*) tmp
+        do l=1,252
+          read(210,112) tfile(l),zfile(l),nxf(l),(vmrf(l,n),n=1,7)
+          zfile(l)=zfile(l)*100.                    !pressure (Pa)
+          sigfile(l)=zfile(l)/zfile(1)
+        enddo
+        do l=1,252
+          read(220,113)zfilemin(l),(vmrf(l,n),n=8,14)
+          zfilemin(l)=zfilemin(l)*1000.             !height (m)
+          do n=1,14
+            nf(l,n)=vmrf(l,n)*nxf(l)
+          enddo
+        enddo
+        close(210)
+        close(220)
+
+      do i=1,ngridmx
+         do l=1,nlayermx
+
+          zgcm=sig(l)
+
+          do n=1,14
+            call intrplf(zgcm,vmrint,sigfile,nf(1,n),252)
+            ni(n)=vmrint
+          enddo
+
+          densconc=0.
+          nt=0.
+
+          do n=1,14
+            densconc=densconc+ni(n)*mmolf(n)
+            nt=nt+ni(n)
+          enddo
+
+          mmean=densconc/nt                            ! in amu
+
+c TEST
+c           print*,l," mmean=",mmean
+c           print*,l," nt=",nt
+c FIN TEST
+
+          do n=nqchem_min,nqmx-2
+            pq(i,l,n)=ni(aa(n))/nt*mmol(n)/mmean
+          enddo
+          if (iceparty) then
+            pq(i,l,nqmx-1) = 0.
+            pq(i,l,nqmx)   = ni(aa(nqmx))/nt*mmol(nqmx)/mmean
+          else
+           do n=nqmx-1,nqmx
+            pq(i,l,n)=ni(aa(n))/nt*mmol(n)/mmean
+           enddo
+          endif
+
+c TEST
+c        if (noms(n).eq."h2o") then
+c           print*,l," ",noms(n)," ni=",ni(aa(n))," q=",pq(i,l,n)
+c        endif
+c FIN TEST
+
+c          pq(i,l,nqchem_min)=0.995
+c          do n=nqchem_min+1, nqmx
+c            pq(i,l,n)=0.005/12
+c          enddo
+
+          enddo     
+        enddo   
+
+cccccccccccccccccccccccccccccc      
+c  make sure that sum of q = 1      
+c dominent species is = 1 - sum(all other species)      
+cccccccccccccccccccccccccccccc      
+      iqmax=nqchem_min
+      
+      if ((nqmx-nqchem_min).gt.10) then
+       do l=1,nlayermx
+        do j=1,ngridmx
+           do iq=nqchem_min,nqmx
+            if ( (pq(j,l,iq).gt.pq(j,l,iqmax)).and.
+     .           (noms(iq).ne."ice") )  then 
+              iqmax=iq
+            endif
+           enddo
+           pq(j,l,iqmax)=1.
+           qtot(j,l)=0
+           do iq=nqchem_min,nqmx
+            if ( (iq.ne.iqmax).and.
+     .           (noms(iq).ne."ice") ) then        
+              pq(j,l,iqmax)=pq(j,l,iqmax)-pq(j,l,iq)        
+            endif
+           enddo !iq
+           do iq=nqchem_min,nqmx
+            if (noms(iq).ne."ice") then
+             qtot(j,l)=qtot(j,l)+pq(j,l,iq)
+            endif
+c            if (j.eq.1.and.l.eq.1) write(*,*)' qtot(j,l)',
+c     $    qtot(j,l)
+           enddo !iq
+         enddo !j   
+       enddo !l  
+      endif
+ccccccccccccccccccccccccccccccc
+
+66      format(i2,6(1x,e11.5))
+112     format(7x,f7.3,3x,e12.6,3x,e12.6,6(3x,e12.6))
+113     format(1x,f6.2,7(3x,e12.6))
+
+      end
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inichim_newstart.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inichim_newstart.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inichim_newstart.F	(revision 2744)
@@ -0,0 +1,337 @@
+      subroutine inichim_newstart(pq,ps,sig,nq,latfi,lonfi,airefi,
+     $ thermo)
+
+      implicit none
+
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c  Initialization of the composition for use in the building of a new start file
+c  using newstart.F
+c
+c   Author:   Sebastien Lebonnois (08/11/2002)
+c   -------
+c Revised 07/2003 by Monica Angelats-i-Coll to use input files
+c
+c   Arguments:
+c   ----------
+c
+c    pq(iip1,jjp1,llm,nqmx)  Advected fields, ie chemical species here
+c    sig = sigma                vertical coordinate (interface of layers)
+c    nq: permet de ne pas modifier l'eau (et la glace d'eau si iceparty)
+c
+c=======================================================================
+
+c    Declarations :
+c    --------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "comcstfi.h"
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "temps.h"
+#include "datafile.h"
+
+c Arguments :
+c -----------
+
+      real    ps(iip1,jjp1)
+      real    pq(iip1,jjp1,llm,nqmx)     ! Advected fields, ie chemical species
+      real    sig(llm+1)                 ! vertical coordinate (interface of layers)
+      integer nq                         !    =nqmx 
+                                         ! or =nqmx-1 if H2O kept
+                                         ! or =nqmx-2 if H2O and ice kept
+      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
+      integer thermo ! flag for thermosphere initialisation only
+
+c Local variables :
+c -----------------
+
+      integer  iq,i,j,l,n, nspecini,inil,iqmax
+      INTEGER aa(nqmx)
+      REAL qtot(iip1,jjp1,llm)
+      real densconc,zgcm,zfile(252),vmrint,nt, mmean
+      real nxf(252),zfilemin(252),sigfile(252)
+      real vmrf(252,14),nf(252,14)
+      real tfile(252),zzfile(252)
+      real ni(14),niold(14)
+      real mmolf(14)    ! molecular mass in amu (species in files)
+      data mmolf/44.,40.,28.,32.,28.,16.,2.,   ! majors
+     &           1.,17.,33.,18.,34.,16.,48./   ! minors
+      character*3 tmp ! temporary variable
+      integer ierr,lnblnk
+      external lnblnk
+
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+
+       call inichim_readcallphys()
+
+c Dimension test:
+c ---------------
+
+       if (iceparty) then
+         if ((nqchem_min+ncomp+1).ne.nqmx) then
+            print*,'********* Dimension problem! ********'
+            print*,"nqchem_min+ncomp+1).ne.nqmx"
+            print*,"ncomp: ",ncomp
+            print*,"nqchem_min: ",nqchem_min
+            print*,"nqmx: ",nqmx
+            print*,'Change ncomp in chimiedata.h'
+            STOP
+         endif
+       else
+         if ((nqchem_min+ncomp).ne.nqmx) then
+            print*,'********* Dimension problem! ********'
+            print*,"nqchem_min+ncomp).ne.nqmx"
+            print*,"ncomp: ",ncomp
+            print*,"nqchem_min: ",nqchem_min
+            print*,"nqmx: ",nqmx
+            print*,'Change ncomp in chimiedata.h'
+            STOP
+         endif
+       endif
+
+c noms and mmol vectors:
+c ----------------------
+
+       if (iceparty) then
+          do iq=nqchem_min,nqmx-2
+            noms(iq) = nomchem(iq-nqchem_min+1)
+            mmol(iq) = mmolchem(iq-nqchem_min+1)
+          enddo
+          noms(nqmx-1) = 'ice'
+          mmol(nqmx-1) = 18.
+          noms(nqmx)   = 'h2o'
+          mmol(nqmx)   = 18.
+       else
+          do iq=nqchem_min,nqmx-1
+            noms(iq) = nomchem(iq-nqchem_min+1)
+            mmol(iq) = mmolchem(iq-nqchem_min+1)
+          enddo
+          noms(nqmx)   = 'h2o'
+          mmol(nqmx)   = 18.
+       endif
+       if (nqchem_min.gt.1) then
+          do iq=1,nqchem_min-1
+            noms(iq) = 'dust'
+            mmol(iq) = 100.
+          enddo
+       endif
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracers numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     co2      =  nqchem_min
+c     co       =  nqchem_min + 1         
+c     o        =  nqchem_min + 2
+c     o(1d)    =  nqchem_min + 3
+c     o2       =  nqchem_min + 4
+c     o3       =  nqchem_min + 5
+c     h        =  nqchem_min + 6
+c     h2       =  nqchem_min + 7
+c     oh       =  nqchem_min + 8
+c     ho2      =  nqchem_min + 9
+c     h2o2     =  nqchem_min + 10
+c     n2       =  nqchem_min + 11
+c     ar       =  nqchem_min + 12
+c     h2o      =  nqmx
+c
+c----------------------------------------------------------------------
+c Major species in files:
+c
+c    1=CO2 
+c    2=AR
+c    3=N2  
+c    4=O2  
+c    5=CO  
+c    6=O   
+c    7=H2
+c
+c Minor species in files:
+c
+c    1=H  
+c    2=OH 
+c    3=HO2 
+c    4=H2O 
+c    5=H2O2 
+c    6=O1D
+c    7=O3
+c
+c----------------------------------------------------------------------
+c Major species:
+        aa(nqchem_min)      = 1
+        aa(nqchem_min + 12) = 2
+        aa(nqchem_min + 11) = 3
+        aa(nqchem_min + 4)  = 4
+        aa(nqchem_min + 1)  = 5
+        aa(nqchem_min + 2)  = 6
+        aa(nqchem_min + 7)  = 7
+c Minor species:
+        aa(nqchem_min + 6)  = 8
+        aa(nqchem_min + 8)  = 9
+        aa(nqchem_min + 9)  = 10
+        aa(nqmx)            = 11
+        aa(nqchem_min + 10) = 12
+        aa(nqchem_min + 3)  = 13 
+        aa(nqchem_min + 5)  = 14
+c----------------------------------------------------------------------
+      open(210, iostat=ierr,file=
+     & datafile(1:lnblnk(datafile))//'/atmosfera_LMD_may.dat')
+      if (ierr.ne.0) then
+        write(*,*)'Error : cannot open file atmosfera_LMD_may.dat '
+        write(*,*)'(in aeronomars/inichim.F)'
+        write(*,*)'It should be in :', datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary atmosfera_LMD_may.dat (and others)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+         STOP
+      endif
+      open(220, iostat=ierr,file=
+     & datafile(1:lnblnk(datafile))//'/atmosfera_LMD_min.dat')
+      if (ierr.ne.0) then
+        write(*,*)'Error : cannot open file atmosfera_LMD_min.dat '
+        write(*,*)'(in aeronomars/inichim.F)'
+        write(*,*)'It should be in :', datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary atmosfera_LMD_min.dat (and others)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+         STOP
+      endif
+
+      read(210,*) tmp
+      read(220,*) tmp
+        do l=1,252
+          read(210,112) tfile(l),zfile(l),nxf(l),(vmrf(l,n),n=1,7)
+          zfile(l)=zfile(l)*100.              !pressure (Pa)
+          sigfile(l)=zfile(l)/zfile(1)       
+        enddo
+        do l=1,252
+          read(220,113)zfilemin(l),(vmrf(l,n),n=8,14)
+          zfilemin(l)=zfilemin(l)*1000.       !height (m)
+          do n=1,14
+            nf(l,n)=vmrf(l,n)*nxf(l)
+          enddo
+        enddo
+        close(210)
+        close(220)
+c flag thermo set to 1 or 0 in newstart 
+c inil=33 for initialisation of thermosphere only        
+c inil=1 for initialisation of all layers        
+        if (thermo.eq.1) then
+        inil=33
+        else
+        inil=1
+        endif
+
+      do i=1,iip1
+       do j=1,jjp1
+         do l=inil,llm
+
+c          zgcm=sig(l)
+          zgcm=sig(l)*ps(i,j)
+          densconc=0.
+          nt=0.
+
+          do n=1,14
+            call intrplf(zgcm,vmrint,zfile,nf(1,n),252)
+c            call intrplf(zgcm,vmrint,sigfile,nf(1,n),252)
+            ni(n)=vmrint
+
+            densconc=densconc+ni(n)*mmolf(n)
+            nt=nt+ni(n)
+          enddo
+
+          mmean=densconc/nt                     ! in amu
+
+          if (nq.ne.nqmx) then
+            do n=nqchem_min,nq-1
+            pq(i,j,l,n)=ni(aa(n))/nt*mmol(n)/mmean
+            if(i.eq.iip1) pq(i,j,l,n)=pq(1,j,l,n) 
+            enddo
+            if (iceparty .and. nq.gt.nqmx-2) then
+              pq(i,j,l,nq) = 0.
+              if(i.eq.iip1) pq(i,j,l,nq)=pq(1,j,l,nq) 
+            else
+              pq(i,j,l,nq)=ni(aa(nq))/nt*mmol(nq)/mmean
+              if(i.eq.iip1) pq(i,j,l,nq)=pq(1,j,l,nq) 
+            endif
+          endif
+          if (nq.eq.nqmx) then
+            do n=nqchem_min,nq-2
+              pq(i,j,l,n)=ni(aa(n))/nt*mmol(n)/mmean
+              if(i.eq.iip1) pq(i,j,l,n)=pq(1,j,l,n) 
+            enddo
+            if (iceparty) then
+              pq(i,j,l,nq-1) = 0.
+              if(i.eq.iip1) pq(i,j,l,nq-1)=pq(1,j,l,nq-1) 
+              pq(i,j,l,nq)=ni(aa(nq))/nt*mmol(nq)/mmean
+              if(i.eq.iip1) pq(i,j,l,nq)=pq(1,j,l,nq) 
+            else
+              do n=nq-1,nq
+                pq(i,j,l,n)=ni(aa(n))/nt*mmol(n)/mmean
+                if(i.eq.iip1) pq(i,j,l,n)=pq(1,j,l,n) 
+              enddo
+            endif
+          endif
+          enddo     !nlayer
+         enddo      !ngrid_j
+        enddo       !ngrid_i
+
+cccccccccccccccccccccccccccccc      
+c  make sure that sum of q = 1      
+c dominent species is = 1 - sum(all other species)      
+cccccccccccccccccccccccccccccc      
+      iqmax=nqchem_min
+      
+      if ((nqmx-nqchem_min).gt.10) then
+       do l=1,llm
+        do j=1,jjp1
+          do i=1,iip1
+           do iq=nqchem_min,nqmx
+            if ( (pq(i,j,l,iq).gt.pq(i,j,l,iqmax)).and.
+     .           (noms(iq).ne."ice") )  then 
+              iqmax=iq
+            endif
+           enddo
+           pq(i,j,l,iqmax)=1.
+           qtot(i,j,l)=0
+           do iq=nqchem_min,nqmx
+            if ( (iq.ne.iqmax).and.
+     .           (noms(iq).ne."ice") ) then        
+              pq(i,j,l,iqmax)=pq(i,j,l,iqmax)-pq(i,j,l,iq)        
+            endif
+           enddo !iq
+           do iq=nqchem_min,nqmx
+            if (noms(iq).ne."ice") then
+             qtot(i,j,l)=qtot(i,j,l)+pq(i,j,l,iq)
+            endif
+c            if (i.eq.1.and.j.eq.1.and.l.eq.1) write(*,*) 'qtot(i,j,l)',
+c     $    qtot(i,j,l)
+           enddo !iq
+            if (i.eq.1.and.j.eq.1) write(*,*) 'qtot(i,j,l)',
+     $    qtot(i,j,l)
+          enddo !i   
+         enddo !j   
+       enddo !l  
+      endif
+ccccccccccccccccccccccccccccccc
+
+66      format(i2,6(1x,e11.5))
+112     format(7x,f7.3,3x,e12.6,3x,e12.6,7(3x,e12.6))
+113     format(1x,f6.2,7(3x,e12.6))
+
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inichim_readcallphys.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inichim_readcallphys.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inichim_readcallphys.F	(revision 2744)
@@ -0,0 +1,463 @@
+      SUBROUTINE inichim_readcallphys
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Initialisation for the physical parametrisations of the LMD 
+c   martian atmospheric general circulation modele.
+c
+c   author: Frederic Hourdin 15 / 10 /93
+c   -------
+c   modified: Sebastien Lebonnois 11/06/2003 (new callphys.def)
+c
+c
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    pdayref               Day of reference for the simulation
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "planete.h"
+#include "comcstfi.h"
+#include "comsaison.h"
+#include "comdiurn.h"
+#include "comgeomfi.h"
+#include "callkeys.h"
+#include "surfdat.h"
+
+      character*12 ch1
+      integer ierr
+      logical chem, h2o
+
+
+c --------------------------------------------------------------
+c  Reading the "callphys.def" file controlling some key options
+c --------------------------------------------------------------
+
+      OPEN(99,file='callphys.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+      IF(ierr.EQ.0) THEN
+         PRINT*
+         PRINT*
+         PRINT*,'--------------------------------------------'
+         PRINT*,' Parametres pour la physique (callphys.def)'
+         PRINT*,'--------------------------------------------'
+
+         READ(99,*)
+         READ(99,*)
+
+         READ(99,fmt='(a)') ch1 
+         READ(99,*) tracer
+         WRITE(*,8000) ch1,tracer
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') diurnal
+         WRITE(*,8000) ch1,diurnal
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') season
+         WRITE(*,8000) ch1,season
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') lwrite
+         WRITE(*,8000) ch1,lwrite
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callstats
+         WRITE(*,8000) ch1,callstats
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calleofdump
+         WRITE(*,8000) ch1,calleofdump
+
+         READ(99,*)
+         READ(99,*)
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*,iostat=ierr) iaervar
+c****WRF: ligne trop longue         
+         if(ierr.ne.0) stop'no iaervar in callphys.def (old?)'
+         WRITE(*,8001) ch1,iaervar
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) iddist
+         WRITE(*,8001) ch1,iddist
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) topdustref
+         WRITE(*,8002) ch1,topdustref
+
+         READ(99,*)
+         READ(99,*)
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callrad
+         WRITE(*,8000) ch1,callrad
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callnlte
+         WRITE(*,8000) ch1,callnlte
+         
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callnirco2
+         WRITE(*,8000) ch1,callnirco2
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calldifv
+         WRITE(*,8000) ch1,calldifv
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calladj
+         WRITE(*,8000) ch1,calladj
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callcond
+         WRITE(*,8000) ch1,callcond
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callsoil
+         WRITE(*,8000) ch1,callsoil
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calllott
+         WRITE(*,8000) ch1,calllott
+
+         READ(99,*) 
+         READ(99,*)
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) iradia
+         WRITE(*,8001) ch1,iradia
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callg2d
+         WRITE(*,8000) ch1,callg2d
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) rayleigh
+         WRITE(*,8000) ch1,rayleigh
+
+         READ(99,*) 
+         READ(99,*)
+
+c TRACERS:
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) dustbin
+         WRITE(*,8001) ch1,dustbin
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) active
+         WRITE(*,8000) ch1,active
+
+c Test of incompatibility:
+c if active is used, then dustbin should be > 0
+
+         if (active.and.(dustbin.lt.1)) then
+           print*,'if active is used, then dustbin should > 0'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) doubleq
+         WRITE(*,8000) ch1,doubleq
+
+c Test of incompatibility:
+c if doubleq is used, then dustbin should be 1
+
+         if (doubleq.and.(dustbin.ne.1)) then
+           print*,'if doubleq is used, then dustbin should be 1'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) lifting
+         WRITE(*,8000) ch1,lifting
+
+c Test of incompatibility:
+c if lifting is used, then dustbin should be > 0
+
+         if (lifting.and.(dustbin.lt.1)) then
+           print*,'if lifting is used, then dustbin should > 0'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) callddevil
+         WRITE(*,8000) ch1,callddevil
+
+c Test of incompatibility:
+c if dustdevil is used, then dustbin should be > 0
+
+         if (callddevil.and.(dustbin.lt.1)) then
+           print*,'if dustdevil is used, then dustbin should > 0'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) scavenging
+         WRITE(*,8000) ch1,scavenging
+
+c Test of incompatibility:
+c if scavenging is used, then dustbin should be > 0
+
+         if (scavenging.and.(dustbin.lt.1)) then
+           print*,'if scavenging is used, then dustbin should > 0'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) sedimentation
+         WRITE(*,8000) ch1,sedimentation
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) iceparty
+         WRITE(*,8000) ch1,iceparty
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) activice
+         WRITE(*,8000) ch1,activice
+
+c Test of incompatibility:
+c if activice is used, then iceparty should be used too
+
+         if (activice.and..not.iceparty) then
+           print*,'if activice is used, iceparty should be used too'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) water
+         WRITE(*,8000) ch1,water
+
+c Test of incompatibility:
+c if iceparty is used, then water should be used too
+
+         if (iceparty.and..not.water) then
+           print*,'if iceparty is used, then water should be used too'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) caps
+         WRITE(*,8000) ch1,caps
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) photochem
+         WRITE(*,8000) ch1,photochem
+
+         READ(99,*)
+         READ(99,*)
+
+c THERMOSPHERE
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callthermos
+         WRITE(*,8000) ch1,callthermos
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') thermoswater
+         WRITE(*,8000) ch1,thermoswater
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callconduct
+         WRITE(*,8000) ch1,callconduct
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calleuv
+         WRITE(*,8000) ch1,calleuv
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callmolvis
+         WRITE(*,8000) ch1,callmolvis
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callmoldiff
+         WRITE(*,8000) ch1,callmoldiff
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') thermochem
+         WRITE(*,8000) ch1,thermochem
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) solarcondate
+         WRITE(*,*) ch1,solarcondate
+
+c Test of incompatibility:
+c if photochem is used, then water should be used too
+
+         if (photochem.and..not.water) then
+           print*,'if photochem is used, water should be used too'
+           stop
+         endif
+
+c if callthermos is used, then thermoswater should be used too 
+c (if water not used already)
+
+         if (callthermos .and. .not.water) then
+           if (callthermos .and. .not.thermoswater) then
+             print*,'if callthermos is used, water or thermoswater 
+     &               should be used too'
+             stop
+           endif
+         endif
+
+         PRINT*,'--------------------------------------------'
+         PRINT*
+         PRINT*
+      ELSE
+         write(*,*)
+         write(*,*) 'Cannot read file callphys.def. Is it here ?'
+         stop
+      ENDIF
+      CLOSE(99)
+
+      pi=2.*asin(1.)
+
+c     managing the tracers, and tests:
+c     -------------------------------
+
+      if(tracer) then
+
+c          when photochem is used, nqchem_min is the rank
+c          of the first chemical species
+
+       if (photochem .or. callthermos) then
+         chem = .true.
+        if (doubleq) then
+          nqchem_min = 3
+        else
+          nqchem_min = dustbin+1
+        end if
+       end if
+
+       if (water .or. thermoswater) h2o = .true.
+
+c          TESTS
+
+       print*,'TRACERS:'
+
+       if ((doubleq).and.(h2o).and.
+     $     (chem).and.(iceparty)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         print*,' 3 to ',nqmx-2,': chemistry'
+         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+       endif
+
+       if ((doubleq).and.(h2o).and.
+     $     (chem).and..not.(iceparty)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         print*,' 3 to ',nqmx-1,': chemistry'
+         print*,nqmx,': water vapor'
+       endif
+
+       if ((doubleq).and.(h2o).and.
+     $     .not.(chem).and.(iceparty)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+         if (nqmx.ne.4) then
+           print*,'nqmx should be 4 with these options...'
+           stop
+         endif
+       endif
+       if ((doubleq).and.(h2o).and.
+     $     .not.(chem).and..not.(iceparty)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         print*,nqmx,': water vapor'
+         if (nqmx.ne.3) then
+           print*,'nqmx should be 3 with these options...'
+           stop
+         endif
+       endif
+
+       if ((doubleq).and..not.(h2o)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         if (nqmx.ne.2) then
+           print*,'nqmx should be 2 with these options...'
+           stop
+         endif
+       endif
+
+       if (.not.(doubleq).and.(h2o).and.
+     $     (chem).and.(iceparty)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+         endif
+         print*,nqchem_min,' to ',nqmx-2,': chemistry'
+         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+       endif
+       if (.not.(doubleq).and.(h2o).and.
+     $     (chem).and..not.(iceparty)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+         endif
+         print*,nqchem_min,' to ',nqmx-1,': chemistry'
+         print*,nqmx,': water vapor'
+       endif
+       if (.not.(doubleq).and.(h2o).and.
+     $     .not.(chem).and.(iceparty)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+         endif
+         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+         if (nqmx.ne.(dustbin+2)) then
+           print*,'nqmx should be ',(dustbin+2),
+     $            ' with these options...'
+           stop
+         endif
+       endif
+       if (.not.(doubleq).and.(h2o).and.
+     $     .not.(chem).and..not.(iceparty)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+         endif
+         print*,nqmx,': water vapor'
+         if (nqmx.ne.(dustbin+1)) then
+           print*,'nqmx should be ',(dustbin+1),
+     $            ' with these options...'
+           stop
+         endif
+       endif
+       if (.not.(doubleq).and..not.(h2o)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+           if (nqmx.ne.dustbin) then
+             print*,'nqmx should be ',dustbin,
+     $              ' with these options...'
+             stop
+           endif
+         else
+           print*,'dustbin=',dustbin,
+     $            ': tracer should be F with these options...'
+           stop
+         endif
+       endif
+
+      endif
+
+8000  FORMAT(t5,a12,l8)
+8001  FORMAT(t5,a12,i8)
+8002  FORMAT(t5,a12,f8.1)
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/init_chimie_B.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/init_chimie_B.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/init_chimie_B.F	(revision 2744)
@@ -0,0 +1,85 @@
+      subroutine init_chimie_B
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c   Scheme B
+c
+c   subject:
+c   --------
+c
+c   Initialization of the photochemical scheme
+c
+c   VERSION: 30/04/2003
+c
+c   This is dependent of the chemistry version:
+c   for scheme B its only purpose is reading the
+c   photodissociation rates lookup table
+c
+c   Author:   Franck Lefevre for scheme B
+c
+c   Arguments:
+c   ----------
+c
+c   The output variable is jphot and is put in common chimiedata.
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "chimiedata.h"
+#include "datafile.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer fic, ij, iozo, isza, itemp, iz, ierr
+c
+      real xsza
+      integer lnblnk
+      external lnblnk 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      fic = 81
+
+      open(fic, form = 'formatted', status = 'old',
+     $file =datafile(1:lnblnk(datafile))//'/jmars.20030707',iostat=ierr)
+
+      IF (ierr.NE.0) THEN
+        write(*,*)'Error : cannot open file jmars.20030707 '
+        write(*,*)'(in aeronomars/init_chimie_B.F)'
+        write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary jmars.20030707 (and other datafiles)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+        STOP
+      ENDIF
+
+c
+      print*, 'lecture table des J...'
+c
+      do itemp = 1,ntemp
+         do iozo = 1,nozo
+            do isza = 1,nsza
+               do iz = 200,0,-1
+                  read(fic,*) colairtab(iz), xsza, table_ozo(iozo)
+                  read(fic,*) (jphot(itemp,isza,iz,iozo,ij), ij=1,7)
+                  read(fic,*) (jphot(itemp,isza,iz,iozo,ij), ij=8,11)
+                  do ij = 1,nd
+                     if (jphot(itemp,isza,iz,iozo,ij) .eq. 1.e-30) then
+                        jphot(itemp,isza,iz,iozo,ij) = 0.
+                     end if
+                  end do
+               end do
+            end do
+         end do
+      end do
+c
+      print*, 'lecture table des J...ok'
+      close(fic)
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/interpfast.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/interpfast.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/interpfast.F	(revision 2744)
@@ -0,0 +1,32 @@
+      subroutine interpfast(escout,p,nlayer,
+     & escin,pin,nl,limdown,limup)
+c****WRF:ligne trop longue
+
+C
+C subroutine to perform linear interpolation in pressure from 1D profile 
+C escin(nl) sampled on pressure grid pin(nl) to profile
+C escout(nlayer) on pressure grid p(nlayer).
+C
+      real escout(nlayer),p(nlayer)
+      real escin(nl),pin(nl),wm,wp
+      real limup,limdown
+      integer nl,nlayer,n1,n,nm,np
+      nm=1
+      do 5 n1=1,nlayer
+         if(p(n1) .gt. limup .or. p(n1) .lt. limdown) then
+            escout(n1) = 0.0
+         else
+            do n = nm,nl-1
+               if (p(n1).ge.pin(n).and.p(n1).le.pin(n+1)) then
+                  nm=n
+                  np=n+1
+                  wm=abs(pin(nm)-p(n1))/(pin(np)-pin(nm))
+                  wp=1.0 - wm
+                  goto 33
+               endif
+            enddo
+ 33         escout(n1) = escin(np)*wm + escin(nm)*wp
+         endif
+    5 continue
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/intrplf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/intrplf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/intrplf.F	(revision 2744)
@@ -0,0 +1,42 @@
+c******************************************************
+      SUBROUTINE intrplf(x,y,xd,yd,nd)
+c interpolation, give y = f(x) with array xd,yd known, size nd
+ 
+c  Version with CONSTANT values outside limits
+c**********************************************************
+ 
+c Variable declaration
+c --------------------
+c  Arguments :
+      real x,y
+      real xd(nd),yd(nd)
+      integer nd
+c  internal
+      integer i,j
+      real y_undefined
+ 
+c run
+c ---
+      y_undefined=1.e20
+ 
+      y=0.
+      if ((x.le.xd(1)).and.(x.le.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = yd(1) ! yd(1)
+        if (xd(1).ge.xd(nd)) y = yd(nd) ! yd(1)
+      else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = yd(nd) ! yd(1)
+        if (xd(1).ge.xd(nd)) y = yd(1) ! yd(1)
+c        y = yd (nd)
+      else
+        do i=1,nd-1
+         if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) )
+     &     .or. ( (x.le.xd(i)).and.(x.gt.xd(i+1)) ) ) then
+           y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i))
+           goto 99
+         end if
+        end do
+      end if
+ 
+ 99   continue
+      return
+      end                    
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inv.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inv.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/inv.F	(revision 2744)
@@ -0,0 +1,121 @@
+      SUBROUTINE inv(A,N)
+
+      implicit none
+
+c=======================================================================
+c   Scheme A
+c
+c   subject:
+c   --------
+c
+c   Inversion of a matrix:
+c   Combinaison des routines ludcmp.f et lubksb.f du Numerical Recipes
+c=======================================================================
+
+      real       TINY
+      PARAMETER (TINY=1.0E-20)
+      real       AAMAX,DUM,SUM
+      integer    IMAX,I,II,J,K,L,LL,N
+      real       A(N,N),INDX(N),VV(N,N)
+
+      IMAX = 0
+      do I=1,N
+          AAMAX=0.
+          do J=1,N
+            IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J))
+          enddo
+          if (AAMAX.EQ.0.) then
+              write(*,*) 'Singular matrix.'
+              stop
+          endif
+          VV(I,1)=1./AAMAX
+      enddo
+      do J=1,N
+        IF (J.GT.1) THEN
+          do I=1,J-1
+            SUM=A(I,J)
+            IF (I.GT.1)THEN
+              do K=1,I-1
+                SUM=SUM-A(I,K)*A(K,J)
+              enddo
+              A(I,J)=SUM
+            ENDIF
+          enddo
+        ENDIF
+        AAMAX=0.
+        do I=J,N
+          SUM=A(I,J)
+          IF (J.GT.1)THEN
+            do K=1,J-1
+              SUM=SUM-A(I,K)*A(K,J)
+            enddo
+            A(I,J)=SUM
+          ENDIF
+          DUM=VV(I,1)*ABS(SUM)
+          IF (DUM.GE.AAMAX) THEN
+            IMAX=I
+            AAMAX=DUM
+          ENDIF
+        enddo
+        IF (J.NE.IMAX)THEN
+          do K=1,N
+            DUM=A(IMAX,K)
+            A(IMAX,K)=A(J,K)
+            A(J,K)=DUM
+          enddo
+          VV(IMAX,1)=VV(J,1)
+        ENDIF
+        INDX(J)=IMAX
+        if(abs(A(J,J)).LT.TINY) then
+              write(*,*) 'Pivot too small.'
+              stop
+        endif
+        IF(J.NE.N)THEN
+          DUM=1./A(J,J)
+          do I=J+1,N
+            A(I,J)=A(I,J)*DUM
+          enddo
+        ENDIF
+      enddo
+
+      do I=1,N
+         do J=1,N
+            VV(I,J) = 0.
+         enddo
+         VV(I,I) = 1.
+      enddo
+
+      do L=1,N
+        II=0
+        do I=1,N
+          LL=INDX(I)
+          SUM=VV(LL,L)
+          VV(LL,L)=VV(I,L)
+          IF (II.NE.0)THEN
+            do J=II,I-1
+              SUM=SUM-A(I,J)*VV(J,L)
+            enddo
+          ELSE IF (SUM.NE.0.) THEN
+            II=I
+          ENDIF
+          VV(I,L)=SUM
+        enddo
+        do I=N,1,-1
+          SUM=VV(I,L)
+          IF(I.LT.N)THEN
+            do J=I+1,N
+              SUM=SUM-A(I,J)*VV(J,L)
+            enddo
+          ENDIF
+          VV(I,L)=SUM/A(I,I)
+        enddo
+      enddo
+
+      do I=1,N
+        do L=1,N
+          A(I,L)=VV(I,L)
+        enddo
+      enddo
+
+      return
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/jthermcalc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/jthermcalc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/jthermcalc.F	(revision 2744)
@@ -0,0 +1,557 @@
+c**********************************************************************
+
+      subroutine jthermcalc
+     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit)
+
+
+c     feb 2002        fgg           first version
+c     nov 2002        fgg           second version
+c
+c modified from paramhr.F
+c MAC July 2003
+c**********************************************************************
+
+      implicit none
+
+c     common variables and constants
+
+      include 'param.h'
+      include 'param_v3.h'
+
+c    local parameters and variables
+
+      real       xabsi(nabs,nzmax) !densities
+      real       nada
+      real       co2colx2(nzmax,ninter)
+      real       o2colx2(nzmax,ninter)
+      real       o3pcolx2(nzmax,ninter)
+      real       co2colx(nzmax)              !column density of CO2 (cm^-2)
+      real       o2colx(nzmax)               !column density of O2(cm^-2)
+      real       o3pcolx(nzmax)              !column density of O(3P)(cm^-2)
+      real       h2o2colx(nzmax)             !column density of H2O2(cm^-2)
+      real       t2(nzmax)
+      real       coltemp(nzmax)
+      real       dt(nzmax)
+      real       sigma(ninter,nzmax)
+      real       alfa(ninter,nzmax)
+      real       xx
+      real       grav(nzmax)
+      
+      integer    i,j,k,icol,indexint          !indexes
+      character  dn
+
+c     input and output variables
+
+      integer    nz                          !number of layers
+      real       co2x(nz)                    !density of CO2(cm^-3)
+      real       o2x(nz)                     !density of O2(cm^-3)
+      real       o3px(nz)                    !density of O(3P)(cm^-3)
+      real       h2x(nz)                     !density of H2(cm^-3)
+      real       h2ox(nz)                    !density of H2O(cm^-3)
+      real       h2o2x(nz)                   !density of H2O2(cm^-3)
+      real       aux1(nz)	             !auxiliar variable
+      real       aux2(nz)                    !auxiliar variable
+      real       tx(nz)                      !temperature
+      real       date
+      real       zenit
+      real       iz(nz)
+
+
+c     variables used in interpolation
+
+      real aux3(nz2), aux4(nz2)
+                                              !auxiliar variables
+      real       limdown                      !limits for interpolation
+      real       limup                        !        ""
+
+c*************************PROGRAM STARTS*******************************
+
+      if(zenit.gt.100.) then
+         dn='n'
+         else
+         dn='d'
+      end if
+      if(dn.eq.'n') then
+        return
+      endif 
+     
+      do i=1,nz
+         xabsi(1,i) = co2x(i)
+         xabsi(2,i) = o2x(i)
+         xabsi(3,i) = o3px(i)
+         xabsi(4,i) = h2ox(i)
+         xabsi(5,i) = h2x(i)
+         xabsi(6,i) = h2o2x(i)
+      end do
+
+      do i=1,nz
+         t2(i)=tx(i)
+         if(t0(i).lt.195.0) t0(i)=195.0
+         if(t0(i).gt.295.0) t0(i)=295.0
+         if(t2(i).lt.195.0) t2(i)=195.0
+         if(t2(i).gt.295.0) t2(i)=295.0
+      end do
+
+
+c    COLUMN CALCULATION 
+
+      call column(co2x,o2x,o3px,h2x,h2ox,h2o2x,tx,nz,iz,zenit,co2colx
+     $,o2colx,o3pcolx,h2o2colx)
+
+      coltemp(nz)=co2colx(nz)*abs(t2(nz)-t0(nz))
+      dt(nz)=coltemp(nz)/co2colx(nz)
+      do i=nz-1,1,-1
+        coltemp(i)=coltemp(i+1)+ 
+     $         ( co2x(i) + co2x(i+1) ) * 0.5 
+     $         * 1e5 * (iz(i+1)-iz(i)) * abs(t2(i)-t0(i))
+        dt(i)=coltemp(i)/co2colx(i)
+      end do
+
+
+c     Calculo la seccion eficaz de CO2 a la temperatura t0 a cada altura
+c CALCULATION OF CO2 CROSS-SECTION AT TEMPERATURE T0 AT EACH HEIGHT
+
+      do i=1,nz
+         do indexint=24,32
+           sigma(indexint,i)=co2crsc195(indexint-23)*
+     $         (1+((co2crsc295(indexint-23)/co2crsc195(indexint-23))-1.)
+     $         *(t0(i)-195.)/100.)
+           if(t0(i).ne.295.) then
+             alfa(indexint,i)=((co2crsc295(indexint-23)
+     $                        /sigma(indexint,i))-1.)/(295.-t0(i))
+           else 
+             alfa(indexint,i)=0.
+           end if
+         end do
+      end do
+
+
+c     Comienza la interpolacion
+c INTERPOLATION BEGINS
+c************************************************
+c     o2,0.1,5.0
+c************************************************
+      
+      indexint=1
+      limdown=1e-20
+      limup=1e26
+       do i=1,nz
+         aux2(nz-i+1) = o2colx(i) + o3pcolx(i)
+       end do
+       do i=1,nz2
+         aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
+         aux4(i) = c23(nz2-i+1)
+       enddo
+       call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup)
+       do i=1,nz
+         jfotsout(indexint,2,i) = aux1(nz-i+1)
+       enddo
+
+c************************************************
+c     o3p,0.1,5.0
+c************************************************
+
+      indexint=1
+      limdown=1e-20
+      limup=1e26
+         do i=1,nz
+            aux2(nz-i+1) = o2colx(i) + o3pcolx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,3,nz2-i+1)
+            aux4(i) = c23(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup)
+         do i=1,nz
+            jfotsout(indexint,3,i) = aux1(nz-i+1)
+         enddo
+
+
+c************************************************
+c     h2,0.1,5.0
+c************************************************
+
+      indexint=1
+      limdown=1e-20
+      limup=1e26
+         do i=1,nz
+            aux2(nz-i+1) = o2colx(i) + o3pcolx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,5,nz2-i+1)
+            aux4(i) = c23(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,5,i) = aux1(nz-i+1)
+         enddo
+
+
+c************************************************
+c     interpola para el o2 entre 5 y 90.8nm
+c************************************************
+
+      limdown=1e-20
+      limup=1e12
+      do indexint=2,16
+         co2colx2(nz,indexint)= co2colx(nz) 
+     $              * crscabsi2(1,indexint)
+         o2colx2(nz,indexint)= o2colx(nz) 
+     $              * crscabsi2(2,indexint)
+         o3pcolx2(nz,indexint)= o3pcolx(nz) 
+     $              * crscabsi2(3,indexint)
+         do i=nz-1,1,-1
+            co2colx2(i,indexint) = co2colx2(i+1,indexint) + 
+     $         ( xabsi(1,i) + xabsi(1,i+1) ) * 0.5 
+     $           * 1e5 * (iz(i+1)-iz(i)) * crscabsi2(1,indexint)
+            o2colx2(i,indexint) = o2colx2(i+1,indexint) + 
+     $         ( xabsi(2,i) + xabsi(2,i+1) ) * 0.5 
+     $         * 1e5 * (iz(i+1)-iz(i)) * crscabsi2(2,indexint)
+            o3pcolx2(i,indexint) = o3pcolx2(i+1,indexint) + 
+     $         ( xabsi(3,i) + xabsi(3,i+1) ) * 0.5 
+     $         * 1e5 * (iz(i+1)-iz(i)) * crscabsi2(3,indexint)
+         end do
+         do i=1,nz
+            aux2(nz-i+1) = co2colx2(i,indexint)+
+     $      o2colx2(i,indexint)+
+     $      o3pcolx2(i,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
+            aux4(i) = c123(indexint,nz2-i+1)
+         enddo
+          call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+          do i=1,nz
+            jfotsout(indexint,2,i) = aux1(nz-i+1) 
+          enddo
+      end do
+      
+
+c************************************************
+c     idem para o3p entre 5 y 90.8nm
+c************************************************
+
+      do indexint=2,16
+         do i=1,nz
+            aux2(nz-i+1) = co2colx2(i,indexint) +
+     $      o2colx2(i,indexint) +
+     $      o3pcolx2(i,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,3,nz2-i+1)
+            aux4(i) = c123(indexint,nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,3,i) = aux1(nz-i+1)
+         enddo
+      end do
+
+
+c************************************************
+c     idem para co2 entre 5 y 90.8nm
+c************************************************
+
+      do indexint=2,16
+         do i=1,nz
+            aux2(nz-i+1) = co2colx2(i,indexint) +
+     $      o2colx2(i,indexint) +
+     $      o3pcolx2(i,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
+            aux4(i) = c123(indexint,nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,1,i) = aux1(nz-i+1)
+         enddo
+      end do
+
+
+c************************************************
+c     idem para h2 entre 5 y 80.6nm
+c************************************************
+
+      do indexint=2,15
+         do i=1,nz
+            aux2(nz-i+1) = co2colx2(i,indexint) +
+     $      o2colx2(i,indexint) +
+     $      o3pcolx2(i,indexint)
+         end do
+         do i=1,nabs
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,5,nz2-i+1)
+            aux4(i) = c123(indexint,nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,5,i) = aux1(nz-i+1)
+         enddo
+      end do
+
+
+c************************************************
+c      co2,90.9,119.5
+c************************************************
+
+      limdown=1e-20
+      limup=1e26
+      do indexint=17,24
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+c           print*,indexint,i,aux2(i),aux1(i),aux3(i),aux4(i)
+           jfotsout(indexint,1,i) = aux1(nz-i+1)
+           if(indexint.eq.24) then
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+             jfotsout(indexint,1,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))*
+     $           (1+alfa(indexint,i)*(t2(i)-t0(i)))
+           else 
+             jfotsout(indexint,1,i)=0.
+           end if
+           end if
+c           print*,indexint,i,(jfotsout(indexint,j,i),j=1,nabs)
+         enddo
+      end do
+
+
+c************************************************
+c     o2,90.9,119.5
+c************************************************
+      
+      do indexint=17,24
+         do i=1,nz
+            aux2(nz-i+1) = o2colx(i) + co2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,2,i) = aux1(nz-i+1)
+            if(indexint.eq.24) then
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,2,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+               else
+                  jfotsout(indexint,2,i)=0.
+               end if
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c      co2,119.6,202.5
+c************************************************
+
+      do indexint=25,31
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,1,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))*
+     $           (1+alfa(indexint,i)*(t2(i)-t0(i)))
+            else
+               jfotsout(indexint,1,i) = 0.
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c      o2,119.6,202.5
+c************************************************
+
+      do indexint=25,31
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,2,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,2,i)=0.
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c      h2o,119.6,202.5
+c************************************************
+
+      do indexint=25,31
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,4,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,4,i) = aux1(nz-i+1) 
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,4,i) = 0.
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c      h2o2,119.6,202.5
+c************************************************
+
+      do indexint=25,31
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,6,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,6,i) = aux1(nz-i+1) 
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,6,i) = 0.
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c     co2,202.6,210.0
+c************************************************
+
+      indexint=32
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
+            aux4(i) = c1(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,1,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))*
+     $           (1+alfa(indexint,i)*(t2(i)-t0(i)))
+            else
+               jfotsout(indexint,1,i)=0.
+            end if
+         enddo
+
+
+c************************************************
+c     h2o2,202.6,210.0
+c************************************************
+
+      indexint=32
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,6,nz2-i+1)
+            aux4(i) = c1(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,6,i) = aux1(nz-i+1) 
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,6,i)=0.
+            end if
+         enddo
+
+
+c************************************************
+c     h2o2,210.1,337.5
+c************************************************
+
+      indexint=33
+      limdown=1.e-20
+      limup=1e25
+         do i=1,nz
+            aux2(nz-i+1) = h2o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,6,nz2-i+1)
+            aux4(i) = ch2o2(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,6,i) = aux1(nz-i+1)
+         enddo
+
+      return
+
+      end
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/moldiff.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/moldiff.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/moldiff.F	(revision 2744)
@@ -0,0 +1,540 @@
+      subroutine moldiff(pplay,pplev,pt,pdt,pq,pdq,ptimestep,
+     &                   zzlay,pdteuv,pdtconduc,pdqdiff)
+
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+
+
+c
+c Input/Output
+c
+      real ptimestep
+      real pplay(ngridmx,nlayermx)
+      real zzlay(ngridmx,nlayermx)
+      real pplev(ngridmx,nlayermx+1)
+      real pq(ngridmx,nlayermx,nqmx)
+      real pdq(ngridmx,nlayermx,nqmx)
+      real pt(ngridmx,nlayermx)
+      real pdt(ngridmx,nlayermx)
+      real pdteuv(ngridmx,nlayermx)
+      real pdtconduc(ngridmx,nlayermx)
+      real pdqdiff(ngridmx,nlayermx,nqmx)
+c
+c Local
+c
+       real hco2(ncomptot),ho
+
+      integer ig,nz,l,n,nn
+      real del1,del2, tmean ,dalfinvdz, d
+      real hh,dcoef,dcoef1,ptfac, ntot, dens, dens2, dens3
+      real hp(nlayermx)
+      real tt(nlayermx)
+      real qq(nlayermx,ncomptot)
+      real dmmeandz(nlayermx)
+      real qnew(nlayermx,ncomptot)
+      real zlocal(nlayermx)
+      real alf(ncomptot-1,ncomptot-1)
+      real alfinv(nlayermx,ncomptot-1,ncomptot-1)
+      real indx(ncomptot-1)
+      real b(nlayermx,ncomptot-1)
+      real y(ncomptot-1,ncomptot-1)
+      real aa(nlayermx,ncomptot-1,ncomptot-1)
+      real bb(nlayermx,ncomptot-1,ncomptot-1)
+      real cc(nlayermx,ncomptot-1,ncomptot-1)
+      real atri(nlayermx-2)
+      real btri(nlayermx-2)
+      real ctri(nlayermx-2)
+      real rtri(nlayermx-2)
+      real qtri(nlayermx-2)
+      real alfdiag(ncomptot-1)
+      real wi(ncomptot), flux(ncomptot), pote
+
+      integer i_co2, i_co, i_o2, i_h2, i_h2o, i_h2o2,
+     $        i_o1d, i_o, i_h, i_oh, i_ho2, i_n2, i_o3, i_ar
+      integer g_co2, g_co, g_o2, g_h2, g_h2o, g_h2o2,
+     $        g_o1d, g_o, g_h, g_oh, g_ho2, g_o3, g_n2, g_ar
+      integer gcmind(ncomptot)
+      integer ierr
+
+      logical firstcall
+      real abfac(ncomptot)
+      real dij(ncomptot,ncomptot)
+      save firstcall
+      save dij
+      data firstcall /.true./
+
+      if (firstcall) then
+        call moldiffcoeff(dij)
+        print*,'MOLDIFF  EXO'
+        firstcall= .false.
+      endif
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      g_co2      =  nqchem_min
+      g_co       =  nqchem_min + 1
+      g_o        =  nqchem_min + 2
+      g_o1d      =  nqchem_min + 3
+      g_o2       =  nqchem_min + 4
+      g_o3       =  nqchem_min + 5
+      g_h        =  nqchem_min + 6
+      g_h2       =  nqchem_min + 7
+      g_oh       =  nqchem_min + 8
+      g_ho2      =  nqchem_min + 9
+      g_h2o2     =  nqchem_min + 10
+      g_n2       =  nqchem_min + 11
+      g_ar       =  nqchem_min + 12
+      g_h2o      =  nqmx
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the molecular diffusion
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c  Atomic oxygen must always be the LAST species of the list as
+c it is the dominant species at high altitudes. 
+
+      i_co   = 1
+      i_n2   = 2
+      i_o2   = 3
+      i_co2  = 4
+      i_h2   = 5
+      i_h    = 6
+      i_oh   = 7
+      i_ho2  = 8
+      i_h2o  = 9
+      i_h2o2 = 10
+      i_o1d  = 11
+      i_o3   = 12
+      i_ar   = 13
+      i_o    = 14
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     array to relate local indexes to gcm indexes
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      gcmind(i_co)	=	g_co
+      gcmind(i_n2)	=	g_n2
+      gcmind(i_o2)	=	g_o2
+      gcmind(i_co2)	=	g_co2
+      gcmind(i_h2)	=	g_h2
+      gcmind(i_h)	=	g_h
+      gcmind(i_oh)	=	g_oh
+      gcmind(i_ho2)	=	g_ho2
+      gcmind(i_h2o)	=	g_h2o
+      gcmind(i_h2o2)=	g_h2o2
+      gcmind(i_o1d) =	g_o1d
+      gcmind(i_o3)  =	g_o3
+      gcmind(i_o)   =	g_o
+      gcmind(i_ar)   =	g_ar
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      nz=nlayermx
+
+      do ig=1,ngridmx
+
+        do l=2,nz-1
+          tt(l)=pt(ig,l)+pdt(ig,l)*ptimestep
+     &                  +pdteuv(ig,l)*ptimestep
+     &                  +pdtconduc(ig,l)*ptimestep
+
+          do nn=1,ncomptot
+            qq(l,nn)=pq(ig,l,gcmind(nn))+pdq(ig,l,gcmind(nn))*ptimestep
+            qq(l,nn)=max(qq(l,nn),1.e-30)
+          enddo
+          hp(l)=-log(pplay(ig,l+1)/pplay(ig,l-1))
+          dmmeandz(l)=(mmean(ig,l+1)-mmean(ig,l-1))/hp(l)
+        enddo
+
+        tt(1)=pt(ig,1)  +pdt(ig,1)*ptimestep
+     &                  +pdteuv(ig,1)*ptimestep
+     &                  +pdtconduc(ig,1)*ptimestep
+        tt(nz)=pt(ig,nz)+pdt(ig,nz)*ptimestep
+     &                  +pdteuv(ig,nz)*ptimestep
+     &                  +pdtconduc(ig,nz)*ptimestep
+
+        do nn=1,ncomptot
+          qq(1,nn)=pq(ig,1,gcmind(nn))+pdq(ig,1,gcmind(nn))*ptimestep
+          qq(nz,nn)=pq(ig,nz,gcmind(nn))+pdq(ig,nz,gcmind(nn))*ptimestep
+          qq(1,nn)=max(qq(1,nn),1.e-30)
+          qq(nz,nn)=max(qq(nz,nn),1.e-30)
+        enddo
+        hp(1)=-log(pplay(ig,2)/pplay(ig,1))
+        dmmeandz(1)=(-3.*mmean(ig,1)+4.*mmean(ig,2)
+     &               -mmean(ig,3))/(2.*hp(1))
+        hp(nz)=-log(pplay(ig,nz)/pplay(ig,nz-1))
+        dmmeandz(nz)=(3.*mmean(ig,nz)-4.*mmean(ig,nz-1)
+     &                +mmean(ig,nz-2))/(2.*hp(nz))
+c
+c Setting-up matrix of alfa coefficients from Dickinson and Ridley 1972
+c
+      do l=1,nz
+       if(abs(dmmeandz(l)) .lt. 1.e-5) dmmeandz(l)=0.0
+        hh=rnew(ig,l)*tt(l)/g
+        ptfac=(1.e5/pplay(ig,l))*(tt(l)/273)**1.75
+        ntot=pplay(ig,l)/(1.381e-23*tt(l))      		! in #/m3
+
+        do nn=1,ncomptot-1            ! rows
+          alfdiag(nn)=0.
+          dcoef1=dij(nn,i_o)*ptfac
+          do n=1,ncomptot-1           ! columns
+            y(nn,n)=0.
+            dcoef=dij(nn,n)*ptfac
+            alf(nn,n)=qq(l,nn)/ntot/1.66e-27
+     &         *(1./(mmol(gcmind(n))*dcoef)-1./(mmol(g_o)*dcoef1))
+            alfdiag(nn)=alfdiag(nn)
+     &       +(1./(mmol(gcmind(n))*dcoef)-1./(mmol(g_o)*dcoef1))
+     &        *qq(l,n)
+          enddo
+          dcoef=dij(nn,nn)*ptfac
+          alfdiag(nn)=alfdiag(nn)
+     &       -(1./(mmol(gcmind(nn))*dcoef)-1./(mmol(g_o)*dcoef1))
+     &          *qq(l,nn)
+          alf(nn,nn)=-(alfdiag(nn)
+     &                 +1./(mmol(g_o)*dcoef1))/ntot/1.66e-27
+          y(nn,nn)=1.
+          b(l,nn)=-(dmmeandz(l)/mmean(ig,l)
+     &              +mmol(gcmind(nn))/mmean(ig,l)-1.)
+        enddo
+
+c
+c Inverting the alfa matrix
+c
+        call ludcmp(alf,ncomptot-1,ncomptot-1,indx,d,ierr)
+
+c       TEMPORAIRE *****************************
+        if (ierr.ne.0) then
+            write(*,*) 'In moldiff: Problem in LUDCMP with matrix alf'
+            write(*,*) 'Singular matrix ?'
+c           write(*,*) 'Matrix alf = ', alf
+            write(*,*) 'ig, l=',ig, l
+            write(*,*) 'No molecular diffusion this time !'
+            call zerophys(ngridmx*nlayermx*nqmx,pdqdiff)
+            return
+c           stop
+        end if
+c       *******************************************
+        do n=1,ncomptot-1
+          call lubksb(alf,ncomptot-1,ncomptot-1,indx,y(1,n))
+          do nn=1,ncomptot-1
+            alfinv(l,nn,n)=y(nn,n)/hh
+          enddo
+        enddo
+      enddo
+
+c
+c Calculating coefficients of the system
+c
+
+c      zlocal(1)=-log(pplay(ig,1)/pplev(ig,1))* Rnew(ig,1)*tt(1)/g
+      zlocal(1)=zzlay(ig,1)
+
+      do l=2,nz-1
+        del1=hp(l)*pplay(ig,l)/(g*ptimestep)
+        del2=(hp(l)/2)**2*pplay(ig,l)/(g*ptimestep)
+        do nn=1,ncomptot-1
+          do n=1,ncomptot-1
+            dalfinvdz=(alfinv(l+1,nn,n)-alfinv(l-1,nn,n))/hp(l)
+            aa(l,nn,n)=-dalfinvdz/del1+alfinv(l,nn,n)/del2
+     &                +alfinv(l-1,nn,n)*b(l-1,n)/del1    
+            bb(l,nn,n)=-2.*alfinv(l,nn,n)/del2
+            cc(l,nn,n)=dalfinvdz/del1+alfinv(l,nn,n)/del2
+     &                -alfinv(l+1,nn,n)*b(l+1,n)/del1    
+          enddo
+        enddo
+
+c        tmean=tt(l)
+c        if(tt(l).ne.tt(l-1))
+c     &        tmean=(tt(l)-tt(l-1))/log(tt(l)/tt(l-1))
+c        zlocal(l)= zlocal(l-1)
+c     &         -log(pplay(ig,l)/pplay(ig,l-1))*rnew(ig,l)*tmean/g
+      zlocal(l)=zzlay(ig,l)
+      enddo 
+
+c      zlocal(nz)= zlocal(nz-1)
+c     &         -log(pplay(ig,nz)/pplay(ig,nz-1))*rnew(ig,nz)*tmean/g
+      zlocal(nz)=zzlay(ig,nz)
+        
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c Escape velocity from Jeans equation for the flux of H and H2
+c (Hunten 1973, eq. 5)
+      
+      do n=1,ncomptot
+        wi(n)=1.
+        flux(n)=0.
+        abfac(n)=1.
+      enddo
+
+       dens=pplay(ig,nz)/(rnew(ig,nz)*tt(nz))
+c
+c For H:
+c
+       pote=(3398000.+zlocal(nz))/
+     &         (1.381e-23*tt(nz)/(1.6605e-27*mmol(g_h)*g))
+       wi(i_h)=sqrt(2.*1.381e-23*tt(nz)/(1.6605e-27*mmol(g_h)))
+     &             /(2.*sqrt(3.1415))*(1.+pote)*exp(-pote)
+       flux(i_h)=qq(nz,i_h)*dens/(1.6605e-27*mmol(g_h))*wi(i_h)
+       flux(i_h)=flux(i_h)*1.6606e-27
+       abfac(i_h)=0.
+c
+c For H2:
+c
+       pote=(3398000.+zlocal(nz))/
+     &         (1.381e-23*tt(nz)/(1.6605e-27*mmol(g_h2)*g))
+       wi(i_h2)=sqrt(2.*1.381e-23*tt(nz)/(1.6605e-27*mmol(g_h2)))
+     &              /(2.*sqrt(3.1415))*(1.+pote)*exp(-pote)
+       flux(i_h2)=qq(nz,i_h2)*dens/(1.6605e-27*mmol(g_h2))*wi(i_h2)
+       flux(i_h2)=flux(i_h2)*1.6606e-27
+       abfac(i_h2)=0.
+
+c ********* TEMPORAIRE : no escape for h and h2
+c     do n=1,ncomptot
+c       wi(n)=1.
+c       flux(n)=0.
+c       abfac(n)=1.
+c     enddo
+c ********************************************
+
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c
+c Setting coefficients for tridiagonal matrix and solving the system
+c
+
+      do nn=1,ncomptot-1
+        do l=2,nz-1
+          atri(l-1)=aa(l,nn,nn)
+          btri(l-1)=bb(l,nn,nn)+1.
+          ctri(l-1)=cc(l,nn,nn)
+          rtri(l-1)=qq(l,nn)
+          do n=1,ncomptot-1
+            rtri(l-1)=rtri(l-1)-(aa(l,nn,n)*qq(l-1,n)
+     &                           +bb(l,nn,n)*qq(l,n)
+     &                           +cc(l,nn,n)*qq(l+1,n))
+          enddo
+          rtri(l-1)=rtri(l-1)+(aa(l,nn,nn)*qq(l-1,nn)
+     &                         +bb(l,nn,nn)*qq(l,nn)
+     &                         +cc(l,nn,nn)*qq(l+1,nn))
+        enddo
+
+c
+c Boundary conditions:
+c	Escape flux for H and H2 at top
+c	Diffusive equilibrium for the other species at top
+c	Perfect mixing for all at bottom
+c
+
+        rtri(nz-2)=rtri(nz-2)
+     &             -ctri(nz-2)*flux(nn)*mmol(gcmind(nn))/(dens*wi(nn))
+
+        atri(nz-2)=atri(nz-2)
+     &             -abfac(nn)*ctri(nz-2)/(3.-2.*hp(nz)*b(nz,nn))
+        btri(nz-2)=btri(nz-2)
+     &             +abfac(nn)*4.*ctri(nz-2)/(3.-2.*hp(nz)*b(nz,nn))
+
+c        rtri(1)=rtri(1)-atri(1)*qq(1,nn)
+        btri(1)=btri(1)+atri(1)
+
+        call tridag(atri,btri,ctri,rtri,qtri,nz-2)
+
+        do l=2,nz-1
+c          qnew(l,nn)=qtri(l-1)
+          qnew(l,nn)=max(qtri(l-1),1.e-30)
+        enddo
+
+        qnew(nz,nn)=flux(nn)*mmol(gcmind(nn))/(dens*wi(nn))
+     &               +abfac(nn)*(4.*qnew(nz-1,nn)-qnew(nz-2,nn))
+     &                /(3.-2.*hp(nz)*b(nz,nn))
+c        qnew(1,nn)=qq(1,nn)
+        qnew(1,nn)=qnew(2,nn)
+         
+        qnew(nz,nn)=max(qnew(nz,nn),1.e-30)
+        qnew(1,nn)=max(qnew(1,nn),1.e-30)
+
+      enddo 	! loop on species
+
+      DO l=1,nz
+        if(zlocal(l).gt.65000.)then
+        pdqdiff(ig,l,g_o)=0.
+        do n=1,ncomptot-1
+          pdqdiff(ig,l,gcmind(n))=(qnew(l,n)-qq(l,n))
+          pdqdiff(ig,l,g_o)=pdqdiff(ig,l,g_o)-(qnew(l,n)-qq(l,n))
+          pdqdiff(ig,l,gcmind(n))=pdqdiff(ig,l,gcmind(n))/ptimestep
+        enddo
+		pdqdiff(ig,l,g_o)=pdqdiff(ig,l,g_o)/ptimestep
+        endif
+      ENDDO
+
+c      do l=2,nz
+c        do n=1,ncomptot-1
+c          hco2(n)=qnew(l,n)*pplay(ig,l)/(rnew(ig,l)*tt(l)) /
+c     &      (qnew(l-1,n)*pplay(ig,l-1)/(rnew(ig,l-1)*tt(l-1))) 
+c          hco2(n)=-(zlocal(l)-zlocal(l-1))/log(hco2(n))/1000.
+c        enddo
+c        write(225,*),l,pt(1,l),(hco2(n),n=1,6)
+c        write(226,*),l,pt(1,l),(hco2(n),n=7,12)
+c      enddo
+
+      enddo		! ig loop
+
+      return
+      end
+
+c    ********************************************************************
+c    ********************************************************************
+c    ********************************************************************
+ 
+      subroutine tridag(a,b,c,r,u,n)
+      parameter (nmax=100)
+c      dimension gam(nmax),a(n),b(n),c(n),r(n),u(n)
+      real gam(nmax),a(n),b(n),c(n),r(n),u(n)
+      if(b(1).eq.0.)pause
+      bet=b(1)
+      u(1)=r(1)/bet
+      do 11 j=2,n
+        gam(j)=c(j-1)/bet
+        bet=b(j)-a(j)*gam(j)
+        if(bet.eq.0.)pause
+        u(j)=(r(j)-a(j)*u(j-1))/bet
+11    continue
+      do 12 j=n-1,1,-1
+        u(j)=u(j)-gam(j+1)*u(j+1)
+12    continue
+      return
+      end
+
+c    ********************************************************************
+c    ********************************************************************
+c    ********************************************************************
+
+      SUBROUTINE LUBKSB(A,N,NP,INDX,B)
+
+      implicit none
+
+      integer i,j,n,np,ii,ll
+      real sum
+      real a(np,np),indx(np),b(np)
+
+c      DIMENSION A(NP,NP),INDX(N),B(N)
+      II=0
+      DO 12 I=1,N
+        LL=INDX(I)
+        SUM=B(LL)
+        B(LL)=B(I)
+        IF (II.NE.0)THEN
+          DO 11 J=II,I-1
+            SUM=SUM-A(I,J)*B(J)
+11        CONTINUE
+        ELSE IF (SUM.NE.0.) THEN
+          II=I
+        ENDIF
+        B(I)=SUM
+12    CONTINUE
+      DO 14 I=N,1,-1
+        SUM=B(I)
+        IF(I.LT.N)THEN
+          DO 13 J=I+1,N
+            SUM=SUM-A(I,J)*B(J)
+13        CONTINUE
+        ENDIF
+        B(I)=SUM/A(I,I)
+14    CONTINUE
+      RETURN
+      END
+
+c    ********************************************************************
+c    ********************************************************************
+c    ********************************************************************
+
+      SUBROUTINE LUDCMP(A,N,NP,INDX,D,ierr)
+
+      implicit none
+
+      integer n,np,nmax,i,j,k,imax
+      real d,tiny,aamax
+      real a(np,np),indx(np)
+      integer ierr  ! error =0 if OK, =1 if problem
+
+      PARAMETER (NMAX=100,TINY=1.0E-20)
+c      DIMENSION A(NP,NP),INDX(N),VV(NMAX)
+      real sum,vv(nmax),dum
+
+      D=1.
+      DO 12 I=1,N
+        AAMAX=0.
+        DO 11 J=1,N
+          IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J))
+11      CONTINUE
+        IF (AAMAX.EQ.0.) then
+            write(*,*) 'In moldiff: Problem in LUDCMP with matrix A'
+            write(*,*) 'Singular matrix ?'
+c           write(*,*) 'Matrix A = ', A
+c           TO DEBUG :
+            ierr =1
+            return
+c           stop
+        END IF 
+
+        VV(I)=1./AAMAX
+12    CONTINUE
+      DO 19 J=1,N
+        IF (J.GT.1) THEN
+          DO 14 I=1,J-1
+            SUM=A(I,J)
+            IF (I.GT.1)THEN
+              DO 13 K=1,I-1
+                SUM=SUM-A(I,K)*A(K,J)
+13            CONTINUE
+              A(I,J)=SUM
+            ENDIF
+14        CONTINUE
+        ENDIF
+        AAMAX=0.
+        DO 16 I=J,N
+          SUM=A(I,J)
+          IF (J.GT.1)THEN
+            DO 15 K=1,J-1
+              SUM=SUM-A(I,K)*A(K,J)
+15          CONTINUE
+            A(I,J)=SUM
+          ENDIF
+          DUM=VV(I)*ABS(SUM)
+          IF (DUM.GE.AAMAX) THEN
+            IMAX=I
+            AAMAX=DUM
+          ENDIF
+16      CONTINUE
+        IF (J.NE.IMAX)THEN
+          DO 17 K=1,N
+            DUM=A(IMAX,K)
+            A(IMAX,K)=A(J,K)
+            A(J,K)=DUM
+17        CONTINUE
+          D=-D
+          VV(IMAX)=VV(J)
+        ENDIF
+        INDX(J)=IMAX
+        IF(J.NE.N)THEN
+          IF(A(J,J).EQ.0.)A(J,J)=TINY
+          DUM=1./A(J,J)
+          DO 18 I=J+1,N
+            A(I,J)=A(I,J)*DUM
+18        CONTINUE
+        ENDIF
+19    CONTINUE
+      IF(A(N,N).EQ.0.)A(N,N)=TINY
+      ierr =0
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/moldiffcoeff.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/moldiffcoeff.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/moldiffcoeff.F	(revision 2744)
@@ -0,0 +1,143 @@
+      subroutine moldiffcoeff(dij)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing molecular diffusion coefficients
+c   following Nair 94 (pg 131)
+c   author:  MAC 2002
+c   ------
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER nq, n, nn, i
+      integer i_co2, i_co, i_o2, i_h2, i_h2o, i_h2o2, i_n2, i_o3,
+     $        i_o1d, i_o, i_h, i_oh, i_ho2, i_ar
+      integer g_co2, g_co, g_o2, g_h2, g_h2o, g_h2o2,
+     $        g_o1d, g_o, g_h, g_oh, g_ho2, g_o3, g_n2, g_ar
+      integer gcmind(ncomptot)
+
+      real dnh
+      real dij(ncomptot,ncomptot)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      g_co2      =  nqchem_min
+      g_co       =  nqchem_min + 1
+      g_o        =  nqchem_min + 2
+      g_o1d      =  nqchem_min + 3
+      g_o2       =  nqchem_min + 4
+      g_o3       =  nqchem_min + 5
+      g_h        =  nqchem_min + 6
+      g_h2       =  nqchem_min + 7
+      g_oh       =  nqchem_min + 8
+      g_ho2      =  nqchem_min + 9
+      g_h2o2     =  nqchem_min + 10
+      g_n2       =  nqchem_min + 11
+      g_ar       =  nqchem_min + 12
+      g_h2o      =  nqmx
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the molecular diffusion
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c  Atomic oxygen must always be the LAST species of the list as 
+c it is the dominant species at high altitudes.  
+      i_co   = 1
+      i_n2   = 2
+      i_o2   = 3
+      i_co2  = 4
+      i_h2   = 5
+      i_h    = 6
+      i_oh   = 7
+      i_ho2  = 8
+      i_h2o  = 9
+      i_h2o2 = 10
+      i_o1d  = 11
+      i_o3   = 12
+      i_ar   = 13
+      i_o    = 14
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     array to relate local indexes to gcm indexes
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      gcmind(i_co)  =   g_co
+      gcmind(i_n2)  =   g_n2
+      gcmind(i_o2)  =   g_o2
+      gcmind(i_co2) =   g_co2
+      gcmind(i_h2)  =   g_h2
+      gcmind(i_h)   =   g_h
+      gcmind(i_oh)  =   g_oh
+      gcmind(i_ho2) =   g_ho2
+      gcmind(i_h2o) =   g_h2o
+      gcmind(i_h2o2)=   g_h2o2
+      gcmind(i_o1d) =   g_o1d
+      gcmind(i_o3)  =   g_o3
+      gcmind(i_o)   =   g_o
+      gcmind(i_ar)   =  g_ar
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+      dij(i_h2,i_co)   = 0.0000651
+      dij(i_h2,i_n2)   = 0.0000674
+      dij(i_h2,i_o2)   = 0.0000697
+      dij(i_h2,i_co2)  = 0.0000550
+      dij(i_h2,i_h2)   = 0.0
+      dij(i_h2,i_h)    = 0.0
+      dij(i_h2,i_oh)   = 0.0	!0003
+      dij(i_h2,i_ho2)  = 0.0	!0003
+      dij(i_h2,i_h2o)  = 0.0	!0003
+      dij(i_h2,i_h2o2) = 0.0	!0003
+      dij(i_h2,i_o1d)  = 0.0
+      dij(i_h2,i_o3)   = 0.0	!0003
+      dij(i_h2,i_o)    = 0.0
+      dij(i_h2,i_ar)   = 0.0
+
+c      dij(i_h,i_o)     = 0.0000144
+      dij(i_h,i_o)     = 0.000114
+
+       print*,' COEFF CALC'
+       open(56,file='coeffs.dat',status='unknown')
+      do n=1,ncomptot
+        if (dij(i_h2,n).gt.0.0) then
+          do nn=n,ncomptot
+            dij(nn,n)=dij(i_h2,n)
+     &                  *sqrt(mmol(g_h2)/mmol(gcmind(nn)))
+            if(n.eq.nn) dij(nn,n)=1.0
+            dij(n,nn)=dij(nn,n)
+          enddo 
+        endif
+        if (dij(i_h2,n).eq.0.0) then
+          dnh=dij(i_h,i_o)*sqrt(mmol(g_o)/mmol(gcmind(n)))
+          do nn=n,ncomptot
+            dij(nn,n)=dnh*sqrt(mmol(g_h)/mmol(gcmind(nn)))
+            if(n.eq.nn) dij(nn,n)=1.0
+            dij(n,nn)=dij(nn,n)
+          enddo 
+        endif
+      enddo 
+
+      do n=1,ncomptot
+        do nn=n,ncomptot
+          write(56,*) n,nn,dij(n,nn)	!*1.e5/1.381e-23/(273**1.75)
+        enddo
+      enddo
+      close(56)
+
+
+      return   
+      end 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/molvis.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/molvis.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/molvis.F	(revision 2744)
@@ -0,0 +1,197 @@
+       SUBROUTINE molvis(ptimestep,pplay,pplev,
+     $          pt,pdteuv,pdtconduc,pvel,
+     $                   tsurf,zzlev,zzlay,zdvelmolvis)
+      IMPLICIT NONE
+
+
+c******WRF: ligne trop longue
+
+c=======================================================================
+c
+c   Molecular Viscosity Diffusion
+c  
+c   Based on conduction.F  by N. Descamp, F. Forget 05/1999
+c
+c   modified by M. Angelats i Coll
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c-----------------------------------------------------------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "surfdat.h"
+#include "chimiedata.h"
+#include "conc.h"
+
+c   arguments:
+c   ----------
+
+      REAL ptimestep
+      REAL pplay(ngridmx,nlayermx)
+      REAL pplev(ngridmx,nlayermx+1)
+      REAL zzlay(ngridmx,nlayermx)
+      REAL zzlev(ngridmx,nlayermx+1)
+      real pt(ngridmx,nlayermx)
+      real tsurf(ngridmx)
+      REAL pvel(ngridmx,nlayermx)
+      REAL pdvel(ngridmx,nlayermx)
+      real pdteuv(ngridmx,nlayermx)
+      real pdtconduc(ngridmx,nlayermx)
+
+      real zdvelmolvis(ngridmx,nlayermx)
+
+c   local:
+c   ------
+
+      INTEGER l,ig, ngrid,nz
+      real Akk,skk,phitop,velsurf,fac, m, tmean
+      REAL zvel(nlayermx)
+      real zt(nlayermx)
+      REAL alpha(nlayermx)
+      REAL lambda(nlayermx)
+      real muvol(nlayermx)
+      REAL C(nlayermx)
+      real D(nlayermx)
+      real den(nlayermx)
+      REAL pdvelm(nlayermx)
+      REAL zlay(nlayermx)
+      real zlev(nlayermx+1)
+
+c   constants used locally
+c    ---------------------
+c     The atmospheric conductivity is a function of temperature T :
+c      conductivity = Akk* T**skk
+c     Molecular viscosity is related to thermal conductivity by:
+c       conduc = 0.25*(9*gamma - 5)* Cv * molvis
+c     where gamma = Cp/Cv.  For dry air.
+
+
+      PARAMETER (skk=0.69)
+
+      PARAMETER (velsurf =0.0)
+      
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+c-----------------------------------------------------------------------
+c   calcul des coefficients alpha et lambda
+c-----------------------------------------------------------------------
+
+      IF (firstcall) THEN
+        write (*,*) 'coeff of molecular viscosity Akk,skk,factor'
+        write(*,*) Akk,skk,fac
+        firstcall = .false.
+      END IF
+
+! Initialize phitop
+      phitop=0.0
+
+      ngrid=ngridmx
+      nz=nlayermx
+
+      do ig=1,ngrid
+
+        zt(1)=pt(ig,1)+(pdteuv(ig,1)+pdtconduc(ig,1))*ptimestep
+        zvel(1)=pvel(ig,1)
+c        zlay(1)=-log(pplay(ig,1)/pplev(ig,1))*Rnew(ig,1)*zt(1)/g
+c        zlev(1)=0.0
+
+        zlay(1)=zzlay(ig,1)
+        zlev(1)=zzlev(ig,1)
+
+        do l=2,nz
+          zt(l)=pt(ig,l)+(pdteuv(ig,l)+pdtconduc(ig,l))*ptimestep
+          zvel(l)=pvel(ig,l)
+c          tmean=zt(l)
+c          if(zt(l).ne.zt(l-1)) tmean=(zt(l)-zt(l-1))/log(zt(l)/zt(l-1))
+c          zlay(l)= zlay(l-1)
+c     &          -log(pplay(ig,l)/pplay(ig,l-1))*Rnew(ig,l-1)*tmean/g
+c          zlev(l)= zlev(l-1)
+c     &         -log(pplev(ig,l)/pplev(ig,l-1))*Rnew(ig,l-1)*tmean/g
+        zlay(l)=zzlay(ig,l)
+        zlev(l)=zzlev(ig,l)
+        enddo
+
+c          zlev(nz+1)= zlev(nz)
+c     &         -log(max(pplev(ig,nz+1),1.e-30)/pplev(ig,nz))
+c     &          *Rnew(ig,nz)*tmean/g
+c          if(pplev(ig,nz+1).eq.0.)
+c     &       zlev(nz+1)=zlev(nz)+(zlay(nz)-zlay(nz-1))
+
+          zlev(nz+1)= zlev(nz)+10000.
+
+        fac=0.25*(9.*cpnew(ig,1)-5.*(cpnew(ig,1)-rnew(ig,1))) 
+        Akk=Akknew(ig,1)
+        lambda(1)=Akk*tsurf(ig)**skk/zlay(1)/fac   
+c        write(*,*) 'rnew(ig,nz)  ',ig , rnew(ig,nz)
+
+        DO l=2,nz
+          fac=(9.*cpnew(ig,l)-5.*(cpnew(ig,l)-rnew(ig,l)))/4. 
+          Akk=Akknew(ig,l)
+          lambda(l)=Akk/fac*zt(l)**skk/(zlay(l)-zlay(l-1)) 
+        ENDDO
+    
+        DO l=1,nz-1
+          muvol(l)=pplay(ig,l)/(rnew(ig,l)*zt(l)) 
+          alpha(l)=(muvol(l)/ptimestep)*(zlev(l+1)-zlev(l))
+        ENDDO
+        muvol(nz)=pplay(ig,nz)/(rnew(ig,nz)*zt(nz)) 
+        alpha(nz)=(muvol(nz)/ptimestep)*(zlev(nz+1)-zlev(nz))
+
+c--------------------------------------------------------------------
+c
+c     calcul des coefficients C et D
+c
+c-------------------------------------------------------------------
+
+      den(1)=alpha(1)+lambda(2)+lambda(1)
+      C(1)=lambda(1)*(velsurf-zvel(1))+lambda(2)*(zvel(2)-zvel(1))
+      C(1)=C(1)/den(1)	     
+      D(1)=lambda(2)/den(1)           
+   
+      DO l = 2,nz-1
+         den(l)=alpha(l)+lambda(l+1)
+         den(l)=den(l)+lambda(l)*(1-D(l-1))
+         
+         C(l) =lambda(l+1)*(zvel(l+1)-zvel(l)) 
+     $        +lambda(l)*(zvel(l-1)-zvel(l)+C(l-1))    
+         C(l) =C(l)/den(l)           
+
+         D(l) =lambda(l+1) / den(l)
+      ENDDO 
+
+      den(nz)=alpha(nz) + lambda(nz) * (1-D(nz-1))
+      C(nz)=C(nz-1)+zvel(nz-1)-zvel(nz) 
+      C(nz)=(C(nz)*lambda(nz)+phitop) / den(nz) 
+       	 	
+c----------------------------------------------------------------------
+c
+c      calcul de la nouvelle pdvelm 
+c
+c----------------------------------------------------------------------
+
+      DO l=1,nz
+         pdvelm(l)=0.
+      ENDDO
+         pdvelm(nz)=C(nz)
+      DO l=nz-1,1,-1
+         pdvelm(l)=C(l)+D(l)*pdvelm(l+1)
+      ENDDO 
+c-----------------------------------------------------------------------
+c
+c     calcul de la tendance zdvelmolvis
+c
+c-----------------------------------------------------------------------
+    
+      DO l=1,nz
+        zdvelmolvis(ig,l)=pdvelm(l)/ptimestep
+      ENDDO
+
+      ENDDO             ! boucle sur ngrid
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/param.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/param.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/param.h	(revision 2744)
@@ -0,0 +1,62 @@
+c***********************************************
+
+c	param.par
+
+c	Parameters for paramhr.f
+c***********************************************
+
+	integer    ninter
+	parameter  (ninter=33)
+
+	integer    nabs
+	parameter  (nabs=6)
+
+	integer    nz2
+	parameter  (nz2=203)
+
+	integer    ninter2
+        parameter  (ninter2=16)
+
+	real       kboltzman                  !cte Boltzman
+	parameter  (kboltzman = 1.381e-16)
+	
+	real       n_avog                    !# de Avogadro
+	parameter  (n_avog = 6.023e23)
+
+	real       gg                        !cte gravitacion
+	parameter  (gg = 6.67259e-8)
+
+	real       masa                      !masa de Marte(g)
+	parameter  (masa = 6.4163e26)
+
+	real       radio
+	parameter  (radio = 3390.)           !radio de Marte(km)
+
+	real       pmco2
+	parameter  (pmco2 = 44.)
+
+	real       pmo3p
+	parameter  (pmo3p = 16.)
+
+	real       pmo2
+	parameter  (pmo2 = 32.)
+
+	real       pmh2o2
+	parameter  (pmh2o2 = 36.)
+
+	real       cpco2
+	parameter  (cpco2=20.0e6)
+
+	real       cpo2
+	parameter  (cpo2=0.9194e7)
+
+	real       cpo3p
+	parameter  (cpo3p=1.30e7)
+
+	integer	   nreact
+	parameter  (nreact=22)
+
+	integer    nzmax
+	parameter  (nzmax=210)
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/param_read.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/param_read.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/param_read.F	(revision 2744)
@@ -0,0 +1,232 @@
+      subroutine param_read
+
+      implicit none
+
+
+c     common variables and constants
+
+#include "param.h"
+#include "param_v3.h"
+#include "datafile.h"
+
+
+c     local variables
+
+      integer    i,j,k,inter                          !indexes
+      integer ierr,lnblnk 
+      real       nada
+      external lnblnk
+
+     
+c*************************+PROGRAM STARTS**************************
+
+
+c     data
+
+      data anchint/4.9,5.3,6.1,12.8,2.0,6.9,11.8,0.4,1.9,4.9,0.9,4.0,
+     $6.9,4.9,4.9,10.2,5.6,1.9,0.9,0.9,0.9,0.9,3.7
+     $,13.1,3.9,6.0,4.8,23.9,8.4,8.5,26.8,7.5,127.6/
+
+      data (crscabsi2(1,j),j=1,ninter2) /0.0,4.42e-18,7.51e-18
+     $,1.498e-17,2.344e-17,2.388e-17,2.927E-17,3.161e-17,3.161e-17,
+     $3.4e-17,3.4e-17,2.588e-17,2.596e-17,2.248e-17,3.183e-17,
+     $1.284e-17/
+
+      data (crscabsi2(2,j),j=1,ninter2) /2.736e-19,1.055e-18,4.789e-18
+     $,1.063e-17,1.559e-17,1.698e-17,2.164e-17,2.241e-17,2.427e-17,
+     $2.444e-17,2.502e-17,2.516e-17,2.907e-17,3.649e-17,3.066e-17,
+     $2.093e-17/
+
+      data (crscabsi2(3,j),j=1,ninter2) /2.603e-19,6.985e-19,3.97e-18
+     $,6.621e-18,8.433e-18,9.011e-18,9.862e-18,1.033e-17,1.012e-17,
+     $1.033e-17,1.033e-17,1.034e-17,9.0e-18,3.564e-18,3.572e-18
+     $,3.47E-18/
+
+      data freccen /3.4,7.5,14.5,23.0,30.3,34.1,49.6,50.5,52.5,56.0,
+     $59.0,61.5,68.7,73.1,78.4,83.1,92.4,97.5,99.3,100.1,100.7,102.1,
+     $104.5,116.8,121.3,127.0,130.6,153.7,162.8,171.4
+     $,195.6,206.3,273.5/
+
+      data co2crsc195/3.691e-19,4.44216e-20,3.86945e-19,5.94208e-19,
+     $2.93217e-19,7.58769e-20,8.60192e-21,4.20007e-24,2.29996e-26/
+
+      data co2crsc295/3.691e-19,5.21572e-20,4.23488e-19,6.54728e-19,
+     $3.30227e-19,1.03183e-19,1.55722e-20,1.72317e-23,7.0e-25/
+
+
+c     Reads tabulated functions
+
+      open(210, status = 'old',
+     $file=datafile(1:lnblnk(datafile))//'/EUVDAT/coln.dat',iostat=ierr)
+
+      IF (ierr.NE.0) THEN
+       write(*,*)'cant find directory EUVDAT and content coln.dat'
+       write(*,*)'(in aeronomars/param_read.F)'
+       write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+       write(*,*)'1) You can change this directory address in '
+       write(*,*)'   file phymars/datafile.h'
+       write(*,*)'2) If necessary, EUVDAT (and other datafiles)'
+       write(*,*)'   can be obtained online on:'
+       write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+       STOP
+      ENDIF
+
+      open(220,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j2_an.dat')
+      open(230,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j3_an.dat')
+      open(240,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j1_an.dat')
+      open(250,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j2_bn.dat')
+      open(260,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j2_cn.dat')
+      open(270,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j1_bn.dat')
+      open(280,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j1_cn.dat')
+      open(290,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j1_dn.dat')
+      open(150,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j4n.dat')
+      open(160,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j5n.dat')
+      open(170,file=datafile(1:lnblnk(datafile))//'/EUVDAT/j6n.dat')
+
+      do i=210,290,10
+         read(i,*)
+         read(i,*)
+      end do
+
+      do i=150,170,10
+         read(i,*)
+         read(i,*)
+      end do
+
+      do i=nz2,1,-1
+        read(210,*) c23(i),(c123(j,i),j=2,ninter2),c12(i),c1(i),ch2o2(i)
+      end do
+
+      do i=nz2,1,-1
+         read(220,*) (jabsifotsint(j,2,i),j=1,ninter2)
+      end do
+      
+      do i=nz2,1,-1
+         read(230,*) (jabsifotsint(j,3,i),j=1,ninter2)
+      end do
+
+      do i=nz2,1,-1
+         read(240,*) (jabsifotsint(j,1,i),j=2,ninter2)
+      end do
+
+      do i=nz2,1,-1
+         read(250,*) (jabsifotsint(j,2,i),j=17,24)
+      end do
+
+      do i=nz2,1,-1
+         read(260,*) (jabsifotsint(j,2,i),j=25,31)
+      end do
+
+      do i=nz2,1,-1
+         read(270,*) (jabsifotsint(j,1,i),j=17,24)
+      end do
+
+      do i=nz2,1,-1
+         read(280,*) (jabsifotsint(j,1,i),j=25,31)
+      end do
+
+      do i=nz2,1,-1
+         read(290,*) jabsifotsint(32,1,i)
+      end do
+
+      do i=nz2,1,-1
+         read(160,*) (jabsifotsint(j,5,i),j=1,15)
+      end do
+
+      do i=nz2,1,-1
+         read(150,*) (jabsifotsint(j,4,i),j=25,31)
+      end do
+
+      do i=nz2,1,-1
+         read(170,*) (jabsifotsint(j,6,i),j=25,33)
+      end do
+
+      do i=210,290,10
+         close(i)
+      end do
+
+      do i=150,170,10
+         close(i)
+      end do
+
+
+c     reads t0
+
+      open(120,file=datafile(1:lnblnk(datafile))//'/EUVDAT/t0.dat')
+      do i=1,201
+         read(120,*)t0(i)
+      end do
+      close(120)
+
+      open(100,file=datafile(1:lnblnk(datafile))//'/EUVDAT/flujo.dat')
+      do i=1,ninter
+         read(100,*) inter,fluxtophr(i)
+      end do
+      close(100)
+
+
+      open(99,file=datafile(1:lnblnk(datafile))//'/EUVDAT/varflujo.dat')
+      read(99,*)
+      do i=1,24
+         read(99,*) inter,ct1(i),p1(i),ct2(i),p2(i),nada
+      end do
+      close(99)
+
+c     eficiencias de disociacion (de Torr et al, 1979)
+
+      do inter=1,11
+         efdisco2(inter) = 0.
+         efdiso2(inter) = 0.
+      end do
+
+      do inter=1,15
+         efdish2(inter) = 1.
+      end do
+
+      efdisco2(12) = 0.183
+      efdiso2(12) = 0.003
+
+      efdisco2(13) = 0.163
+      efdiso2(13) = 0.170
+
+      efdisco2(14) = 0.243
+      efdiso2(14) =0.180
+
+      efdisco2(15) = 0.323
+      efdiso2(15) =0.653
+
+      efdisco2(16) = 0.235
+      efdiso2(16) =0.616
+
+      do inter=17,32
+         efdisco2(inter) = 1.0
+      end do
+
+      efdiso2(17) = 0.399
+      do inter=18,20
+         efdiso2(inter) = 0.261
+      end do
+
+      do inter=21,23
+         efdiso2(inter) = 0.755
+      end do
+
+
+      do inter=24,31
+         efdiso2(inter) = 1.
+      end do
+
+      do inter=25,31
+         efdish2o(inter) = 1.
+      end do
+
+      do inter=25,33
+         efdish2o2(inter) = 1.
+      end do
+
+
+      return
+
+
+      end
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/param_v3.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/param_v3.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/param_v3.h	(revision 2744)
@@ -0,0 +1,95 @@
+c**********************************************************************
+
+c	param.cmn
+	
+c	fgg     mar 02          first version
+c**********************************************************************
+
+      common/uv/ anchint,crscabsi2,freccen,c123,c1,c2,c12,c23,ch2o2
+     $ ,jabsifotsint,jfotsout,co2crsc195,co2crsc295,fluxtop,t0
+     
+     
+
+
+      real       anchint(ninter)          !widht of each interval
+      real       crscabsi2(nabs,ninter)    !cross section
+      real       freccen(ninter)          !representative wavelenght
+      real       c123(ninter2,nz2)        !column densities (cm^-2)
+                                          !(CO2+O2+O3P)
+      real       c1(nz2)                  !idem (CO2) (cm^-2)
+      real       c2(nz2)                  !idem (O2) (cm^-2)
+      real       c12(nz2)                 !idem (CO2+O2) (cm^-2)
+      real       c23(nz2)                 !idem (O2+O3P) (cm^-2)
+      real       ch2o2(nz2)               !idem (H2O2) (cm^-2)
+      real       jabsifotsint(ninter,nabs,nzmax) !photoabsorption
+                                                 !coefficients (fot/s)
+      real       jfotsout(ninter,nabs,nzmax)
+      real       co2crsc195(9)
+      real       co2crsc295(9)
+      real       fluxtop(ninter)
+      real       t0(nzmax)
+      
+
+
+      common/fotoquimica/  ch2, ch3, ch4, ch5, ch7,ch9,ch10,ch11,
+     $                     ch13,ch14,ch15,ch18,ch19,ch20,ch21
+     $			   ,jdistot,jdistot_b
+
+      real*8 ch2, ch3, ch4, ch5, ch7,ch9,ch10,ch11,ch13,ch14,ch15,ch18
+      real*8 ch19,ch20,ch21
+						  !reaction rates
+      real jdistot(nabs,nzmax)    !photodissociation rates
+      real jdistot_b(2,nzmax)
+
+
+
+      common/prod/ Pco2,Po2,Po3p,Pco,Ph,Poh,Pho2,Ph2,Ph2o,Po1d,Ph2o2,
+     $		   Pco2tot,Po2tot,Po3ptot,Pcotot,Phtot,Pohtot,
+     $             Pho2tot,Ph2tot,Ph2otot,Po1dtot,Ph2o2tot
+	
+      real*8 Pco2(nzmax,nreact),Po2(nzmax,nreact),Po3p(nzmax,nreact)
+      real*8 Pco(nzmax,nreact),Ph(nzmax,nreact),Poh(nzmax,nreact)
+      real*8 Pho2(nzmax,nreact),Ph2(nzmax,nreact),Ph2o(nzmax,nreact)
+      real*8 Po1d(nzmax,nreact),Ph2o2(nzmax,nreact)
+      real*8 Pco2tot(nzmax),Po2tot(nzmax),Po3ptot(nzmax),Pcotot(nzmax)
+      real*8 Phtot(nzmax)
+      real*8 Pohtot(nzmax),Pho2tot(nzmax),Ph2tot(nzmax),Ph2otot(nzmax)
+      real*8 Po1dtot(nzmax),Ph2o2tot(nzmax)
+
+
+      common/loss/ Lco2,Lo2,Lo3p,Lco,Lh,Loh,Lho2,Lh2,Lh2o,Lo1d,Lh2o2,
+     $		   Lco2tot,Lo2tot,Lo3ptot,Lcotot,Lhtot,Lohtot,
+     $             Lho2tot,Lh2tot,Lh2otot,Lo1dtot,Lh2o2tot
+	
+      real*8 Lco2(nzmax,nreact),Lo2(nzmax,nreact),Lo3p(nzmax,nreact)
+      real*8 Lco(nzmax,nreact),Lh(nzmax,nreact),Loh(nzmax,nreact)
+      real*8 Lho2(nzmax,nreact),Lh2(nzmax,nreact),Lh2o(nzmax,nreact)
+      real*8 Lo1d(nzmax,nreact),Lh2o2(nzmax,nreact)
+      real*8 Lco2tot(nzmax),Lo2tot(nzmax),Lo3ptot(nzmax),Lcotot(nzmax)
+      real*8 Lhtot(nzmax),Lohtot(nzmax),Lho2tot(nzmax),Lh2tot(nzmax)
+      real*8 Lh2otot(nzmax),Lo1dtot(nzmax),Lh2o2tot(nzmax)
+
+
+      common/vida/ tminco2,tmino2,tmino3p,tminco,tminh,tminoh,tminho2
+     $               ,tminh2,tminh2o,tmino1d,tminh2o2
+
+    	real*8 tminco2(nzmax),tmino2(nzmax),tmino3p(nzmax),tminco(nzmax)
+    	real*8 tminh(nzmax),tminoh(nzmax),tminho2(nzmax),tminh2(nzmax)
+    	real*8 tminh2o(nzmax),tmino1d(nzmax),tminh2o2(nzmax)
+
+
+      common/flujoctes/ fluxtophr,ct1,p1,ct2,p2   
+ 
+      real fluxtophr(ninter)
+      real ct1(ninter),p1(ninter),ct2(ninter),p2(ninter)       
+
+      common/phdisef/ efdisco2, efdiso2, efdish2, efdish2o, efdish2o2
+
+      real efdisco2(ninter), efdiso2(ninter), efdish2o(ninter)
+      real efdish2o2(ninter), efdish2(ninter)
+
+
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/paramfoto.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/paramfoto.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/paramfoto.F	(revision 2744)
@@ -0,0 +1,599 @@
+c**********************************************************************
+      
+      subroutine paramfoto
+     $(lswitch,zdens,tx,timestep,zenit,nz,co2x,o2x,o3px,cox,hx,ohx,
+     & ho2x,h2x,h2ox,h2o2x,o1dx)
+
+c     oct 2002      fgg
+c**********************************************************************
+
+      implicit none
+
+      include 'param.h'
+      include 'param_v3.h'
+
+c     arguments
+
+      integer nz,lswitch
+      real zdens(nz)
+      real tx(nz)
+      real co2x(nz),o2x(nz),o3px(nz),cox(nz),hx(nz),ohx(nz)
+      real    h2x(nz),h2ox(nz),h2o2x(nz),o1dx(nz),ho2x(nz)
+      real    zenit
+      real    timestep
+
+c     local variables
+
+      real*8    dt,deltat
+      integer nt, ntmax
+      real*8    tauco2(nzmax,nreact)
+      real*8    tauo2(nzmax,nreact)
+      real*8    tauo3p(nzmax,nreact)
+      real*8    tauco(nzmax,nreact)
+      real*8    tauh(nzmax,nreact)
+      real*8    tauoh(nzmax,nreact)
+      real*8    tauho2(nzmax,nreact)
+      real*8    tauh2(nzmax,nreact)
+      real*8    tauh2o(nzmax,nreact)
+      real*8    tauo1d(nzmax,nreact)
+      real*8    tauh2o2(nzmax,nreact)
+      real*8    co2x8,o2x8,o3px8,cox8,hx8,ohx8,ho2x8,h2x8,h2ox8
+      real*8    h2o2x8,o1dx8
+      real*8    o1dx8aux,ohx8aux,ho2x8aux,dif_o1d,dif_oh,dif_ho2
+      real*8    timestep8
+      real*8    jdistot8(nabs,nzmax)
+      real*8    jdistot8_b(2,nzmax)
+      real*8    tx8
+
+      real*8    tmin(nzmax)
+      integer i,j,k,nada,n
+
+      real*8    auxp,auxl
+      
+      character*1 o1d_eq(nzmax)
+      character*1 oh_eq(nzmax)
+      character*1 ho2_eq(nzmax)
+      character*1 dn
+
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+
+      if (firstcall) then
+        firstcall= .false.
+        print*,'FOTO'
+      endif
+
+c 123  format(1x,f10.7,11(tr3,e12.7))
+
+c**********************************************************************
+
+C     Start: altitude loop
+      timestep8=dble(timestep)
+
+      do i=nz,lswitch,-1
+         
+
+c     Concentrations to real*8
+
+         co2x8=dble(co2x(i))
+         o2x8=dble(o2x(i))
+         o3px8=dble(o3px(i))
+         cox8=dble(cox(i))
+         hx8=dble(hx(i))
+         ohx8=dble(ohx(i))
+         ho2x8=dble(ho2x(i))
+         h2x8=dble(h2x(i))
+         h2ox8=dble(h2ox(i))
+         h2o2x8=dble(h2o2x(i))
+         o1dx8=dble(o1dx(i))
+         tx8=dble(tx(i))
+
+
+c     reaction rates         
+
+         call getch(tx8)
+
+c         print*,i,co2x(i),o2x(i),o3px(i),cox(i),hx(i),ohx(i),ho2x(i),
+c     &            h2x(i),h2ox(i),h2o2x(i),o1dx(i),tx(i),zdens(i)
+
+
+c     photodissotiation rates
+
+         jdistot(1,i) = 0.
+         jdistot(2,i) = 0.
+         jdistot(3,i) = 0.
+         jdistot(4,i) = 0.
+         jdistot(5,i) = 0.
+         jdistot(6,i) = 0.
+         jdistot_b(1,i) = 0.
+         jdistot_b(2,i) = 0.
+
+         call phdisrate(zenit,i)
+
+         do j=1,6
+            jdistot8(j,i) = dble(jdistot(j,i))
+         end do
+         jdistot8_b(1,i) = dble(jdistot_b(1,i))
+         jdistot8_b(2,i) = dble(jdistot_b(2,i))
+         
+         
+c     Lifetimes calculation
+
+         do j=1,nreact
+            tauco2(i,j) = 1.d30
+            tauo2(i,j) = 1.d30
+            tauo3p(i,j) = 1.d30
+            tauco(i,j) = 1.d30
+            tauh(i,j) = 1.d30
+            tauoh(i,j) = 1.d30
+            tauho2(i,j) = 1.d30
+            tauh2(i,j) = 1.d30
+            tauh2o(i,j) = 1.d30
+            tauo1d(i,j) = 1.d30
+            tauh2o2(i,j) = 1.d30
+         end do
+
+         if(jdistot8(1,i).gt.1d-30) tauco2(i,1) = 1.d0 / jdistot8(1,i)
+
+         if(ch2*o2x8*co2x8.gt.1d-30) 
+     $      tauh(i,2) = 1.d0 / (ch2 * o2x8 * co2x8)  
+         if(ch2*hx8*co2x8.gt.1d-30)
+     $      tauo2(i,2) = 1.d0 / (ch2 * hx8 * co2x8)
+ 
+         if(ch3*o3px8.gt.1d-30) tauho2(i,3) = 1.d0 / (ch3 * o3px8)
+         if(ch3*ho2x8.gt.1d-30) tauo3p(i,3) = 1.d0 / (ch3 * ho2x8)
+ 
+         if(ch4*cox8.gt.1d-30) tauoh(i,4) = 1.d0 / (ch4 * cox8)
+         if(ch4*ohx8.gt.1d-30) tauco(i,4) = 1.d0 / (ch4 * ohx8)
+ 
+         if(ch5*ho2x8.gt.1d-30)tauho2(i,5) = 1.d0 / (2.d0 * ch5 * ho2x8)
+
+         if(jdistot8(6,i).gt.1d-30) tauh2o2(i,6) = 1.d0 / jdistot8(6,i)
+
+         if(ch7*ohx8.gt.1d-30) tauho2(i,7) = 1.d0 / (ch7 * ohx8)
+         if(ch7*ho2x8.gt.1d-30) tauoh(i,7) = 1.d0 / (ch7 * ho2x8)
+ 
+         if(jdistot8(4,i).gt.1d-30) tauh2o(i,8) = 1.d0 / jdistot8(4,i)
+
+         if(ch9*o1dx8.gt.1d-30) tauh2o(i,9) = 1.d0 / (ch9 * o1dx8)
+         if(ch9*h2ox8.gt.1d-30) tauo1d(i,9) = 1.d0 / (ch9 * h2ox8)
+
+         if(ch10*o3px8*co2x8.gt.1d-30) 
+     $     tauo3p(i,10) = 1.d0 / (2.d0 * ch10 * o3px8 * co2x8)
+
+         if(ch11*o3px8.gt.1d-30) tauoh(i,11) = 1.d0 / (ch11 * o3px8)
+         if(ch11*ohx8.gt.1d-30) tauo3p(i,11) = 1.d0 / (ch11 * ohx8)
+
+         if(jdistot8(2,i).gt.1d-30) tauo2(i,12) = 1.d0 / jdistot8(2,i)
+
+         if(ch13*hx8.gt.1d-30) tauho2(i,13) = 1.d0 / (ch13 * hx8)
+         if(ch13*ho2x8.gt.1d-30) tauh(i,13) = 1.d0 / (ch13 * ho2x8)
+
+         if(ch14*o1dx8.gt.1d-30) tauh2(i,14) = 1.d0 / (ch14 * o1dx8)
+         if(ch14*h2x8.gt.1d-30) tauo1d(i,14) = 1.d0 / (ch14 * h2x8)
+
+         if(ch15*ohx8.gt.1d-30) tauh2(i,15) = 1.d0 / (ch15 * ohx8)
+         if(ch15*h2x8.gt.1d-30) tauoh(i,15) = 1.d0 / (ch15 * h2x8)
+
+         if(jdistot8_b(1,i).gt.1d-30) tauco2(i,16) =1.d0/jdistot8_b(1,i)
+
+         if(jdistot8_b(2,i).gt.1d-30) tauo2(i,17) =1.d0/jdistot8_b(2,i)
+
+         if(ch18*ohx8.gt.1d-30) tauh2o2(i,18) = 1.d0 / (ch18 * ohx8)
+         if(ch18*h2o2x8.gt.1d-30) tauoh(i,18) = 1.d0 / (ch18 * h2o2x8)
+
+         if(ch19*co2x8.gt.1d-30) tauo1d(i,19) = 1.d0 / (ch19 * co2x8)
+
+         if(ch20*o2x8.gt.1d-30) tauo1d(i,20) = 1.d0 / (ch20 * o2x8)
+
+         if(ch21*o2x8*co2x8.gt.1d-30) tauo3p(i,21) = 1.d0 / 
+     $        (ch21 * o2x8 * co2x8)
+         if(ch21*o3px8*co2x8.gt.1d-30) tauo2(i,21) = 1.d0 / 
+     $        (ch21 * o3px8 * co2x8)
+
+         if(jdistot8(5,i).gt.1d-30) tauh2(i,22) = 1.d0 / jdistot8(5,i)
+
+         !minimum lifetime
+         tminco2(i) = 1.d30
+         tmino2(i) = 1.d30
+         tmino3p(i) = 1.d30
+         tminco(i) = 1.d30
+         tminh(i) = 1.d30
+         tminoh(i) = 1.d30
+         tminho2(i) = 1.d30
+         tminh2(i) = 1.d30
+         tminh2o(i) = 1.d30
+         tmino1d(i) = 1.d30
+         tminh2o2(i) = 1.d30
+         
+         do j=1,nreact
+            tminco2(i) = min(tminco2(i),tauco2(i,j))
+            tmino2(i) = min(tmino2(i),tauo2(i,j))
+            tmino3p(i) = min(tmino3p(i),tauo3p(i,j))
+            tminco(i) = min(tminco(i),tauco(i,j))
+            tminh(i) = min(tminh(i),tauh(i,j))
+            tminoh(i) = min(tminoh(i),tauoh(i,j))
+            tminho2(i) = min(tminho2(i),tauho2(i,j))
+            tminh2(i) = min(tminh2(i),tauh2(i,j))
+            tminh2o(i) = min(tminh2o(i),tauh2o(i,j))
+            tmino1d(i) = min(tmino1d(i),tauo1d(i,j))
+            tminh2o2(i) = min(tminh2o2(i),tauh2o2(i,j))
+         end do
+
+         tmin(i) = 1.d30
+         tmin(i) = min(tmin(i),tminco2(i))
+         tmin(i) = min(tmin(i),tmino2(i))
+         tmin(i) = min(tmin(i),tmino3p(i))
+         tmin(i) = min(tmin(i),tminco(i))
+         tmin(i) = min(tmin(i),tminh(i))
+         tmin(i) = min(tmin(i),tminh2(i))
+         tmin(i) = min(tmin(i),tminh2o(i))
+         tmin(i) = min(tmin(i),tminh2o2(i))
+
+
+         !Internal timestep
+         if(tmin(i)/10.d0.gt.timestep8*3600.d0) then
+            deltat = timestep8 * 3600.d0
+         else
+            deltat = tmin(i)/10.d0
+         end if
+         if(deltat.ne.timestep8*3600.d0) then
+            n=int(timestep8*3600.d0/deltat)+1
+            deltat=timestep8*3600.d0/n
+         endif
+
+
+         !Photochemical equilibrium for O1D,OH and HO2?
+         if(tmino1d(i).lt.deltat/5.d0) then
+            o1d_eq(i)='Y'
+         else 
+            o1d_eq(i)='N'
+c            o1d_eq(i)='Y'
+         endif
+         if(tminoh(i).lt.deltat/5.d0) then
+           oh_eq(i)='Y'
+         else
+           oh_eq(i)='N'
+c           oh_eq(i)='Y'
+         end if
+         if(tminho2(i).lt.deltat/5.d0) then
+            ho2_eq(i)='Y'
+         else
+            ho2_eq(i)='N'
+c            ho2_eq(i)='Y'
+         endif
+
+
+C     Start: temporal loop
+c        do dt=deltat,timestep8*3600.d0,deltat
+         do nt=1,int(timestep8*3600.d0/deltat)
+            dt=nt*deltat
+
+            !Productions and losses
+            do j=1,nreact
+               Lco2(i,j) = 0.d0
+               Pco2(i,j) = 0.d0
+               Lo2(i,j) = 0.d0
+               Po2(i,j) = 0.d0
+               Lo3p(i,j) = 0.d0
+               Po3p(i,j) = 0.d0
+               Lco(i,j) = 0.d0
+               Pco(i,j) = 0.d0
+               Ph(i,j) = 0.d0
+               Lh(i,j) = 0.d0
+               Poh(i,j) = 0.d0
+               Loh(i,j) = 0.d0
+               Pho2(i,j) = 0.d0
+               Lho2(i,j) = 0.d0
+               Ph2(i,j) = 0.d0
+               Lh2(i,j) = 0.d0
+               Ph2o(i,j) = 0.d0
+               Lh2o(i,j) = 0.d0
+               Po1d(i,j) = 0.d0
+               Lo1d(i,j) = 0.d0
+               Ph2o2(i,j) = 0.d0
+               Lh2o2(i,j) = 0.d0
+            end do
+            Pco2tot(i) = 0.d0
+            Lco2tot(i) = 0.d0
+            Po2tot(i) = 0.d0
+            Lo2tot(i) = 0.d0
+            Po3ptot(i) = 0.d0
+            Lo3ptot(i) = 0.d0
+            Pcotot(i) = 0.d0
+            Lcotot(i) = 0.d0
+            Phtot(i) = 0.d0
+            Lhtot(i) = 0.d0
+            Pohtot(i) = 0.d0
+            Lohtot(i) = 0.d0
+            Pho2tot(i) = 0.d0
+            Lho2tot(i) = 0.d0
+            Ph2tot(i) = 0.d0
+            Lh2tot(i) = 0.d0
+            Ph2otot(i) = 0.d0
+            Lh2otot(i) = 0.d0
+            Po1dtot(i) = 0.d0
+            Lo1dtot(i) = 0.d0
+            Ph2o2tot(i) = 0.d0
+            Lh2o2tot(i) = 0.d0
+
+
+c           R1: CO2 + hv -> CO + O
+
+            Lco2(i,1) = jdistot8(1,i)
+            Pco(i,1) = co2x8 * jdistot8(1,i)
+            Po3p(i,1) = co2x8 * jdistot8(1,i)
+
+
+c           R16(1b): CO2 + hv -> CO + O1D
+
+            Lco2(i,16) = jdistot8_b(1,i)
+            Pco(i,16) = co2x8 * jdistot8_b(1,i)
+            Po1d(i,16) = co2x8 * jdistot8_b(1,i)
+
+
+c           R2: H + O2 + CO2 -> HO2 + CO2
+
+            Lh(i,2) = ch2 * o2x8 * co2x8
+            Lo2(i,2) = ch2 * hx8 * co2x8
+            Pho2(i,2) = ch2 * hx8 * o2x8 * co2x8
+
+
+c           R3: O + HO2 -> OH + O2
+
+            Lo3p(i,3) = ch3 * ho2x8 
+            Lho2(i,3) = ch3 * o3px8
+            Poh(i,3) = ch3 * o3px8 * ho2x8
+            Po2(i,3) = ch3 * o3px8 * ho2x8
+
+
+c           R4: CO + OH -> CO2 + H
+
+            Lco(i,4) = ch4 * ohx8
+            Loh(i,4) = ch4 * cox8
+            Pco2(i,4) = ch4 * cox8 * ohx8
+            Ph(i,4) = ch4 * cox8 * ohx8
+
+
+c           R5: 2HO2 -> H2O2 + O2
+
+            Lho2(i,5) = 2.d0 * ch5 * ho2x8 
+            Po2(i,5) = ch5 * ho2x8 * ho2x8 
+            Ph2o2(i,5) = ch5 * ho2x8 * ho2x8
+
+
+c           R6: H2O2 + hv -> 2OH
+
+            Lh2o2(i,6) = jdistot8(6,i) 
+            Poh(i,6) = jdistot8(6,i) * h2o2x8
+
+
+c           R7: OH + HO2 -> H2O + O2
+
+            Loh(i,7) = ch7 * ho2x8 
+            Lho2(i,7) = ch7 * ohx8
+            Po2(i,7) = ch7 * ohx8 * ho2x8
+            Ph2o(i,7) = ch7 * ohx8 * ho2x8
+
+
+c           R8: H20 + hv -> H + OH
+
+            Lh2o(i,8) = jdistot8(4,i)
+            Ph(i,8) = jdistot8(4,i) * h2ox8
+            Poh(i,8) = jdistot8(4,i) * h2ox8
+
+
+c           R9: O(1D) + H2O -> 2OH
+
+            Lo1d(i,9) = ch9 * h2ox8
+            Lh2o(i,9) = ch9 * o1dx8
+            Poh(i,9) = 2.d0 * ch9 * o1dx8 * h2ox8 
+         
+
+c           R10: 2O + CO2 -> O2 + CO2
+
+            Lo3p(i,10) = 2.d0 * ch10 * o3px8 * co2x8  
+            Po2(i,10) = ch10 * o3px8 * o3px8 * co2x8
+
+
+c           R11: O + OH -> O2 + H
+
+            Lo3p(i,11) = ch11 * ohx8
+            Loh(i,11) = ch11 * o3px8
+            Po2(i,11) = ch11 * o3px8 * ohx8
+            Ph(i,11) = ch11 * o3px8 * ohx8
+
+
+c           R12: O2 + hv -> 2O
+
+            Lo2(i,12) = jdistot8(2,i)
+            Po3p(i,12) = 2.d0 * jdistot8(2,i) * o2x8
+
+
+c           R17(12b): O2 + hv -> O + O1D
+
+            Lo2(i,17) = jdistot8_b(2,i)
+            Po3p(i,17) = jdistot8_b(2,i) * o2x8
+            Po1d(i,17) = jdistot8_b(2,i) * o2x8
+
+
+c           R13: H + HO2 -> H2 + O2
+
+            Lh(i,13) = ch13 * ho2x8 
+            Lho2(i,13) = ch13 * hx8
+            Ph2(i,13) = ch13 * hx8 * ho2x8
+            Po2(i,13) = ch13 * hx8 * ho2x8
+
+
+c           R14: O(1D) + H2 -> H + OH
+
+            Lo1d(i,14) = ch14 * h2x8
+            Lh2(i,14) = ch14 * o1dx8
+            Ph(i,14) = ch14 * o1dx8 * h2x8
+            Poh(i,14) = ch14 * o1dx8 * h2x8
+
+
+c           R15: OH + H2 -> H + H20
+
+            Loh(i,15) = ch15 * h2x8
+            Lh2(i,15) = ch15 * ohx8
+            Ph(i,15) = ch15 * ohx8 * h2x8
+            Ph2o(i,15) = ch15 * ohx8 * h2x8
+
+
+c           R18: OH + H2O2 -> H2O + HO2
+
+            Loh(i,18) = ch18 * h2o2x8
+            Lh2o2(i,18) = ch18 * ohx8
+            Ph2o(i,18) = ch18 * ohx8 * h2o2x8
+            Pho2(i,18) = ch18 * ohx8 * h2o2x8
+
+
+c           R19: O(1D) + CO2 -> O + CO2
+
+            Lo1d(i,19) = ch19 * co2x8
+            Po3p(i,19) = ch19 * o1dx8 * co2x8
+
+
+c           R20: O(1D) + O2 -> O + O2
+
+            Lo1d(i,20) = ch20 * o2x8
+            Po3p(i,20) = ch20 * o1dx8 * o2x8
+
+
+c           R21: O + O2 + CO2 -> O3 + CO2
+
+            Lo3p(i,21) = ch21 * o2x8 * co2x8
+            Lo2(i,21) = ch21 * o3px8 * co2x8
+
+
+c           R22: H2 + hv -> 2H
+
+            Lh2(i,22) = jdistot8(5,i)
+            Ph(i,22) = 2.d0 * jdistot8(5,i) * h2x8 
+
+
+            do j=1,nreact
+               Pco2tot(i) = Pco2tot(i) + Pco2(i,j)
+               Lco2tot(i) = Lco2tot(i) + Lco2(i,j)
+               Po2tot(i) = Po2tot(i) + Po2(i,j)
+               Lo2tot(i) = Lo2tot(i) + Lo2(i,j)
+               Po3ptot(i) = Po3ptot(i) + Po3p(i,j)
+               Lo3ptot(i) = Lo3ptot(i) + Lo3p(i,j)
+               Pcotot(i) = Pcotot(i) + Pco(i,j)
+               Lcotot(i) = Lcotot(i) + Lco(i,j)
+               Phtot(i) = Phtot(i) + Ph(i,j)
+               Lhtot(i) = Lhtot(i) + Lh(i,j)
+               Pohtot(i) = Pohtot(i) + Poh(i,j)
+               Lohtot(i) = Lohtot(i) + Loh(i,j)
+               Pho2tot(i) = Pho2tot(i) + Pho2(i,j)
+               Lho2tot(i) = Lho2tot(i) + Lho2(i,j)
+               Ph2tot(i) = Ph2tot(i) + Ph2(i,j)
+               Lh2tot(i) = Lh2tot(i) + Lh2(i,j)
+               Ph2otot(i) = Ph2otot(i) + Ph2o(i,j)
+               Lh2otot(i) = Lh2otot(i) + Lh2o(i,j)
+               Po1dtot(i) = Po1dtot(i) + Po1d(i,j)
+               Lo1dtot(i) = Lo1dtot(i) + Lo1d(i,j)
+               Ph2o2tot(i) = Ph2o2tot(i) + Ph2o2(i,j)
+               Lh2o2tot(i) = Lh2o2tot(i) + Lh2o2(i,j)
+            end do
+
+
+            !New concentrations, implicit scheme
+            co2x8 = (co2x8 + Pco2tot(i) * deltat) /
+     $                (1.d0 + Lco2tot(i) * deltat)
+            o2x8 = (o2x8 + Po2tot(i) * deltat) /
+     $               (1.d0 + Lo2tot(i) * deltat)
+            o3px8 = (o3px8 + Po3ptot(i) * deltat) /
+     $                (1.d0 + Lo3ptot(i) * deltat)
+            cox8 = (cox8 + Pcotot(i) * deltat) /
+     $               (1.d0 + Lcotot(i) * deltat)
+            hx8 = (hx8 + Phtot(i) * deltat) /
+     $              (1.d0 + Lhtot(i) * deltat)
+             h2x8 = (h2x8 + Ph2tot(i) * deltat) /
+     $               (1.d0 + Lh2tot(i) * deltat)
+            h2ox8 = (h2ox8 + Ph2otot(i) * deltat) / 
+     $                (1.d0 + Lh2otot(i) * deltat)
+            h2o2x8 = (h2o2x8 + Ph2o2tot(i) * deltat) /
+     $                (1.d0 + Lh2o2tot(i) * deltat)
+
+            if(o1d_eq(i).eq.'Y') then
+               auxp=jdistot8_b(1,i)*co2x8+jdistot8_b(2,i)*o2x8
+               auxl=ch9*h2ox8+ch14*h2x8+ch19*co2x8+ch20*o2x8
+               if(auxl.ne.0.) then
+                  o1dx8=auxp/auxl
+               else
+                  o1dx8=o1dx8+Po1dtot(i)*deltat
+               endif
+            else
+               o1dx8 = (o1dx8 + Po1dtot(i) * deltat) /
+     $                   (1.d0 + Lo1dtot(i) * deltat)
+            end if
+
+            if(oh_eq(i).eq.'Y') then
+               auxp=ch3*o3px8*ho2x8+jdistot(4,i)*h2ox8+
+     $              2.d0*ch9*o1dx8*h2ox8+ch14*o1dx8*h2x8+
+     $              2.d0*jdistot(6,i)*h2o2x8
+               auxl=ch4*cox8+ch7*ho2x8+ch11*o3px8+ch15*h2x8+
+     $              ch18*h2o2x8
+               if(auxl.ne.0.) then
+                  ohx8=auxp/auxl
+               else
+                  ohx8=ohx8+Pohtot(i)*deltat
+               end if
+            else
+               ohx8 = (ohx8 + Pohtot(i) * deltat) /
+     $                  (1.d0 + Lohtot(i) * deltat)
+            end if
+
+            if(ho2_eq(i).eq.'Y') then
+               auxp=ch2*hx8*o2x8*co2x8+ch18*ohx8*h2o2x8
+               auxl=ch3*o3px8+2.d0*ch5*ho2x8+ch7*ohx8+ch13*hx8
+               if(auxl.ne.0.) then
+                  ho2x8=auxp/auxl
+               else
+                  ho2x8=ho2x8+Pho2tot(i)*deltat
+               end if
+            else
+               ho2x8 = (ho2x8 + Pho2tot(i) * deltat) /
+     $                  (1.d0 + Lho2tot(i) * deltat)
+            end if
+
+
+C        End: temporal loop
+         end do
+         
+         
+         co2x(i)  = real(co2x8)
+         o2x(i)   = real(o2x8)
+         o3px(i)  = real(o3px8)
+         cox(i)   = real(cox8)
+         hx(i)    = real(hx8)
+         ohx(i)   = real(ohx8)
+         ho2x(i)  = real(ho2x8)
+         h2x(i)   = real(h2x8)
+         h2ox(i)  = real(h2ox8)
+         h2o2x(i) = real(h2o2x8)
+         o1dx(i)  = real(o1dx8)
+
+c         co2x(i)=(co2x8)
+c         o2x(i)=(o2x8)
+c         o3px(i)=(o3px8)
+c         cox(i)=(cox8)
+c         hx(i)=(hx8)
+c         ohx(i)=(ohx8)
+c         ho2x(i)=(ho2x8)
+c         h2x(i)=(h2x8)
+c         h2ox(i)=(h2ox8)
+c         h2o2x(i)=(h2o2x8)
+c         o1dx(i)=(o1dx8)
+
+C     End: altitude loop
+      end do
+
+      return
+
+      end
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/perosat.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/perosat.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/perosat.F	(revision 2744)
@@ -0,0 +1,140 @@
+      SUBROUTINE perosat(ig, ptimestep,
+     $                   pplev, pplay, zt,
+     &                   zy, pdqcloud, pdqscloud)
+      IMPLICIT NONE
+
+c=======================================================================
+c     Treatment of saturation of hydrogen peroxide (H2O2)
+c
+c     Modif de zq si saturation dans l'atmopshere
+c     si zq(ig,l)> zqsat(ig,l) ->    zq(ig,l)=zqsat(ig,l)
+c     Le test est effectue de bas en haut. H2O2 condense
+c    (si saturation) est remis dans la couche en dessous.
+c     H2O2 condense dans la couche du bas est depose a la surface
+c
+c     WARNING : H2O2 mixing ratio is assumed to be q(i_h2o2)    
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ig
+      REAL ptimestep                ! pas de temps physique (s)
+      REAL pplev(ngridmx,nlayermx+1)! pression aux inter-couches (Pa)
+      REAL pplay(ngridmx,nlayermx)  ! pression au milieu des couches (Pa)
+      REAL zt(nlayermx)             ! temperature au centre des couches (K)
+                                    ! deja mise a jour dans calchim
+
+c   Traceurs :
+      real zy(nlayermx,nqmx)        ! traceur (fraction molaire sortie chimie)
+      real pdqcloud(ngridmx,nlayermx,nqmx) ! tendance condensation (kg/kg.s-1)
+      real pdqscloud(ngridmx,nqmx)         ! flux en surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      INTEGER l,iq
+      INTEGER i_h2o2
+
+      REAL zysat(nlayermx)
+      REAL zynew(nlayermx)             ! mole fraction after condensation
+      REAL psat_hg                     ! pression saturante (mm Hg)
+      REAL psat_hpa                    ! pression saturante (hPa)
+
+c     Pour diagnostique :
+c     ~~~~~~~~~~~~~~~~~
+      REAL taucond(ngridmx,nlayermx)   ! taux de condensation (kg/kg/s-1)
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+c
+      do iq=1,nqmx
+       if (noms(iq).eq."h2o2") then
+          i_h2o2 = iq
+c         print *,'H2O2: ',noms(iq),' iq=',iq
+c      else
+c         print *,noms(iq),' iq=',iq
+       endif
+      enddo
+
+c    ----------------------------------------------
+c    
+c       Rapport de melange a saturation dans la couche l :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+c       d'apres Lindner, Planet. Space Sci., 36, 125, 1988.
+c       domaine d'application: T < 220 K
+c
+        do l = 1,nlayermx
+
+c       print *,'ig=',ig,' l=',l,' i_h2o2=',i_h2o2
+c       print *,'y=',zy(l,i_h2o2),' T=',zt(l)
+
+             zynew(l) = zy(l,i_h2o2)
+
+             if (zt(l) .le. 220.) then
+               psat_hg = 10.**(11.98 - (3422./zt(l)))
+               psat_hpa = psat_hg*760./1013.
+               zysat(l) = (psat_hpa*100./pplay(ig,l))
+             else
+               zysat(l) = 1.e+30
+             end if
+
+c       print *,'ysat=',zysat(l)
+
+        end do
+
+c       taux de condensation (kg/kg/s-1) dans les differentes couches
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c       (Pour diagnostic seulement !)
+c
+        do l=1, nlayermx
+            taucond(ig,l)= max((zy(l,i_h2o2)-zysat(l))*mmol(i_h2o2)
+     $                         /(mmean(ig,l)*ptimestep),0.)
+        end do
+c
+c       Saturation couche nlay a 2 :  
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+        do l=nlayermx,2, -1
+           if (zynew(l).gt.zysat(l)) then
+              zynew(l-1) =  zynew(l-1) + (zynew(l) - zysat(l))
+     &      *(pplev(ig,l)-pplev(ig,l+1))/(pplev(ig,l-1)-pplev(ig,l))
+
+              zynew(l)=zysat(l)
+           endif
+        enddo
+c
+c       Saturation couche l=1 
+c       ~~~~~~~~~~~~~~~~~~~~~
+c
+        if (zynew(1).gt.zysat(1)) then
+           pdqscloud(ig,i_h2o2)= (zynew(1)-zysat(1))*mmol(i_h2o2)
+     $   *(pplev(ig,1)-pplev(ig,2))/(mmean(ig,1)*g*ptimestep)
+c
+           zynew(1)=zysat(1)
+        end if
+c
+c       Tendance finale
+c       ~~~~~~~~~~~~~~~
+c
+        do l=1, nlayermx
+           pdqcloud(ig,l,i_h2o2)=(zynew(l) - zy(l,i_h2o2))*mmol(i_h2o2)
+     &                           /(mmean(ig,l)*ptimestep) 
+c          print *,'pdqcloud=',pdqcloud(ig,l,i_h2o2)
+        end do
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/phdisrate.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/phdisrate.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/phdisrate.F	(revision 2744)
@@ -0,0 +1,109 @@
+c**********************************************************************
+
+      subroutine phdisrate(zenit,i)
+
+c     apr 2002       fgg           first version
+c**********************************************************************
+
+
+      implicit none
+
+      include 'param.h'
+      include 'param_v3.h'
+
+c     arguments
+
+      integer         i                !altitude
+      real            zenit
+
+c     local variables
+
+      integer         inter,iz
+      real            lambda
+      real            jdis(nabs,ninter,nzmax)
+      character*1     dn
+
+
+c**********************************************************************
+
+      if(zenit.gt.100.) then
+         dn='n'
+         else
+         dn='d'
+      end if
+
+      if(dn.eq.'n') then
+         jdistot(1,i) = 0.
+         jdistot(2,i) = 0.
+         jdistot(3,i) = 0.
+         jdistot(4,i) = 0.
+         jdistot(5,i) = 0.
+         jdistot(6,i) = 0.
+         jdistot_b(1,i) = 0.
+         jdistot_b(2,i) = 0.
+      else
+
+c     photodissociation rate
+
+         jdistot(1,i)=0.
+         jdistot(2,i)=0.
+         jdistot(4,i)=0.
+         jdistot(6,i)=0.
+         jdistot_b(1,i)=0.
+         jdistot_b(2,i)=0.
+         do inter=1,32
+            jdis(1,inter,i) = jfotsout(inter,1,i) * fluxtop(inter) 
+     $      * efdisco2(inter)
+            if(inter.gt.29.and.inter.le.32) then
+               jdistot(1,i) = jdistot(1,i) + jdis(1,inter,i)
+            else if(inter.le.29) then
+               jdistot_b(1,i) = jdistot_b(1,i) + jdis(1,inter,i)
+            end if
+         end do
+
+         do inter=1,31
+            jdis(2,inter,i) = jfotsout(inter,2,i) * fluxtop(inter)
+     $      * efdiso2(inter)
+            if(inter.ge.31) then
+               jdistot(2,i) = jdistot(2,i) + jdis(2,inter,i)
+            else if(inter.lt.31) then
+               jdistot_b(2,i) = jdistot_b(2,i) + jdis(2,inter,i)
+            end if
+         end do
+
+         jdistot(3,i) = 0.
+
+         do inter=25,31
+            jdis(4,inter,i) = jfotsout(inter,4,i) * fluxtop(inter)
+     $      * efdish2o(inter)
+            jdistot(4,i) = jdistot(4,i) + jdis(4,inter,i)
+         end do
+
+         do inter=1,15
+            jdis(5,inter,i) = jfotsout(inter,5,i) * fluxtop(inter)
+     $      * efdish2(inter)
+            jdistot(5,i) = jdistot(5,i) + jdis(5,inter,i)
+         end do
+
+         do inter=25,33
+            jdis(6,inter,i) = jfotsout(inter,6,i) * fluxtop(inter)
+     $      * efdish2o2(inter) 
+            jdistot(6,i) = jdistot(6,i) + jdis(6,inter,i)
+         end do 
+      end if
+
+
+      return
+      
+
+      end
+
+
+
+
+
+
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/photochemist_B.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/photochemist_B.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/photochemist_B.F	(revision 2744)
@@ -0,0 +1,1562 @@
+c*****************************************************************
+c
+c     Photochemical routines for Scheme B
+c
+c     Author: Franck Lefevre
+c     ------
+c
+c     update 12/06/2003: compatibility with dust and iceparty
+c        (S. Lebonnois)
+c
+c*****************************************************************
+c
+      subroutine photochemist_B(lswitch,zycol, sza, ptimestep, press,
+c     $                          temp, dens, dist_sol)
+     $                          temp, dens, dist_sol, jo3)
+c
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "chimiedata.h" 
+#include "callkeys.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     input/output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real zycol(nlayermx,nqmx)  ! chemical species volume mixing ratio
+c if iceparty, zycol(l,nqmx-1) is ice surface area (in microns^2/cm^3)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real sza                   ! solar zenith angle (deg)
+      real ptimestep             ! physics timestep (s)
+      real press(nlayermx)       ! pressure (hpa)
+      real temp(nlayermx)        ! temperature (k)
+      real dens(nlayermx)        ! density (cm-3)
+      real dist_sol              ! sun distance (au) 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real jo3(nlayermx)  ! photodissociation rate O3 -> O1D
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer phychemrat         ! ratio physics timestep/chemistry timestep
+      integer istep
+      integer i_o3,lev
+      integer nesp
+      integer lswitch
+c
+      parameter (nesp = 15)      ! number of species in the chemistry
+c
+      real ctimestep             ! chemistry timestep (s) 
+      real rm(nlayermx,nesp)     ! species volume mixing ratio 
+      real j(nlayermx,nd)        ! interpolated photolysis rates (s-1)
+      real icesurf(nlayermx)     ! ice surface area (cm^2/cm^3)
+      real rmo3(nlayermx)        ! ozone mixing ratio
+c
+c     reaction rates
+c
+      real a001(nlayermx), a002(nlayermx), a003(nlayermx)
+      real b001(nlayermx), b002(nlayermx), b003(nlayermx), 
+     $     b004(nlayermx), b005(nlayermx), b006(nlayermx)
+      real c001(nlayermx), c002(nlayermx), c003(nlayermx), 
+     $     c004(nlayermx), c005(nlayermx), c006(nlayermx), 
+     $     c007(nlayermx), c008(nlayermx), c009(nlayermx), 
+     $     c010(nlayermx), c011(nlayermx), c012(nlayermx),
+     $     c013(nlayermx), c014(nlayermx), c015(nlayermx), 
+     $     c016(nlayermx), c017(nlayermx), c018(nlayermx)
+      real d001(nlayermx), d002(nlayermx), d003(nlayermx)
+      real e001(nlayermx), e002(nlayermx)
+      real h001(nlayermx), h002(nlayermx)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     ctimestep : chemistry timestep (s)                         c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      ctimestep = 10.*60.
+c
+      phychemrat = int(ptimestep/ctimestep)
+c     print*,"PHYCHEMRAT = ",phychemrat
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     initialisation of chemical species and families            c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      call gcmtochim(zycol, lswitch, nesp, rm) 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     ice surface area for heterogenous chemistry
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      if (iceparty) then
+       do lev=1,lswitch-1
+        icesurf(lev)= zycol(lev,nqmx-1)*1.e-8 ! microns^2 -> cm^2
+       enddo
+      else
+       do lev=1,lswitch-1
+        icesurf(lev)=0.0e0
+       enddo
+      endif
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     compute reaction rates                                     c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      call chemrates(lswitch, dens, press, temp, icesurf,
+     $               a001, a002, a003,
+     $               b001, b002, b003, b004, b005, b006,
+     $               c001, c002, c003, c004, c005, c006,
+     $               c007, c008, c009, c010, c011, c012,
+     $               c013, c014, c015, c016, c017, c018,
+     $               d001, d002, d003,
+     $               e001, e002,
+     $               h001, h002)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     interpolation of photolysis rates in the lookup table      c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      i_o3 = 5 
+c
+      do lev=1,lswitch-1
+        rmo3(lev)=rm(lev,i_o3)
+      enddo
+
+      call phot(lswitch, press, temp, sza, dist_sol, rmo3, j)
+c
+      do lev=1,lswitch-1
+        jo3(lev) = j(lev,5)
+      enddo
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     loop over time within the physical timestep                c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do istep = 1,phychemrat
+         call chimie_B(lswitch,nesp, rm, j, dens, ctimestep, 
+     $                 press, temp, sza, dist_sol,
+     $                 a001, a002, a003,
+     $                 b001, b002, b003, b004, b005, b006,
+     $                 c001, c002, c003, c004, c005, c006,
+     $                 c007, c008, c009, c010, c011, c012,
+     $                 c013, c014, c015, c016, c017, c018,
+     $                 d001, d002, d003,
+     $                 e001, e002,
+     $                 h001, h002)
+c
+c        print*,'appel chimie ok iteration ', istep
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     save chemical species for the gcm                          c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      call chimtogcm(zycol, lswitch, nesp, rm) 
+c
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine chimie_B(lswitch, nesp, rm, j, dens, dt, 
+     $                    press, t, sza, dist_sol,
+     $                    a001, a002, a003,
+     $                    b001, b002, b003, b004, b005, b006,
+     $                    c001, c002, c003, c004, c005, c006,
+     $                    c007, c008, c009, c010, c011, c012,
+     $                    c013, c014, c015, c016, c017, c018,
+     $                    d001, d002, d003,
+     $                    e001, e002,
+     $                    h001, h002)
+c
+c*****************************************************************
+c
+      implicit none 
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "chimiedata.h" 
+#include "callkeys.h" 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     input/output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      integer lswitch         ! interface level between chemistries
+      integer nesp            ! number of species
+c
+      real rm(nlayermx,nesp)  ! volume mixing ratios 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real dens(nlayermx)     ! density (cm-3)
+      real dt                 ! chemistry timestep (s) 
+      real j(nlayermx,nd)     ! interpolated photolysis rates (s-1) 
+      real press(nlayermx)    ! pressure (hpa)
+      real t(nlayermx)        ! temperature (k)
+      real sza                ! solar zenith angle (deg)
+      real dist_sol           ! sun distance (au) 
+c
+c     reaction rates
+c
+      real a001(nlayermx), a002(nlayermx), a003(nlayermx)
+      real b001(nlayermx), b002(nlayermx), b003(nlayermx), 
+     $     b004(nlayermx), b005(nlayermx), b006(nlayermx)
+      real c001(nlayermx), c002(nlayermx), c003(nlayermx), 
+     $     c004(nlayermx), c005(nlayermx), c006(nlayermx), 
+     $     c007(nlayermx), c008(nlayermx), c009(nlayermx), 
+     $     c010(nlayermx), c011(nlayermx), c012(nlayermx),
+     $     c013(nlayermx), c014(nlayermx), c015(nlayermx), 
+     $     c016(nlayermx), c017(nlayermx), c018(nlayermx)
+      real d001(nlayermx), d002(nlayermx), d003(nlayermx)
+      real e001(nlayermx), e002(nlayermx)
+      real h001(nlayermx), h002(nlayermx)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer HETERO
+      parameter (HETERO=0)
+
+      integer iesp, iter, l, niter
+      integer i_co2, i_co, i_o2, i_h2, i_h2o, i_h2o2, i_hox, i_ox,
+     $        i_o1d, i_o, i_o3, i_h, i_oh, i_ho2, i_n2
+      integer j_o2_o, j_o2_o1d, j_co2_o, j_co2_o1d,
+     $        j_o3_o1d, j_o3_o, j_h2o, j_hdo, j_h2o2,
+     $        j_ho2, j_no2
+c
+      parameter (niter = 5)          ! iterations in the chemical scheme
+c
+      real*8 cc0(nlayermx,nesp)        ! initial number density (cm-3)
+      real*8 cc(nlayermx,nesp)         ! final number density (cm-3)
+      real*8 co2(nlayermx)             ! co2 number density (cm-3)
+      real*8 nox(nlayermx)             ! nox number density (cm-3)
+      real*8 no(nlayermx)              ! no  number density (cm-3)
+      real*8 no2(nlayermx)             ! no2 number density (cm-3)
+      real*8 production(nlayermx,nesp) ! production rate
+      real*8 loss(nlayermx,nesp)       ! loss rate
+c
+      real c007h(nlayermx)           ! c007 rate modified
+c                                    ! by heterogenous reactions h001 and h002
+c
+      real ro_o3, rh_ho2, roh_ho2, rno2_no
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the chemistry
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      i_co2    =  1
+      i_co     =  2
+      i_o      =  3
+      i_o1d    =  4
+      i_o2     =  5
+      i_o3     =  6
+      i_h      =  7
+      i_h2     =  8
+      i_oh     =  9
+      i_ho2    = 10 
+      i_h2o2   = 11
+      i_h2o    = 12
+      i_n2     = 13
+      i_hox    = 14
+      i_ox     = 15
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     numbering of photolysis rates
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      j_o2_o     =  1      ! o2 + hv   -> o + o
+      j_o2_o1d   =  2      ! o2 + hv   -> o + o(1d)
+      j_co2_o    =  3      ! co2 + hv  -> co + o
+      j_co2_o1d  =  4      ! co2 + hv  -> co + o(1d)
+      j_o3_o1d   =  5      ! o3 + hv   -> o2 + o(1d)
+      j_o3_o     =  6      ! o3 + hv   -> o2 + o
+      j_h2o      =  7      ! h2o + hv  -> h + oh
+      j_hdo      =  8      ! hdo + hv  -> d + oh
+      j_h2o2     =  9      ! h2o2 + hv -> oh + oh
+      j_ho2      =  10     ! ho2 + hv  -> oh + o
+      j_no2      =  11     ! no2 + hv  -> no + o
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     volume mixing ratio -> density conversion
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do iesp = 1,nesp
+         do l = 1,lswitch-1
+            cc0(l,iesp) = rm(l,iesp)*dens(l)
+            cc(l,iesp)  = cc0(l,iesp)
+         end do
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     co2 and nox number densities (cm-3)    
+c      
+c     co2 mixing ratio: 0.953
+c     nox mixing ratio: 6.e-10 (yung and demore, 1999)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+         co2(l) = cc(l,i_co2)
+         nox(l) = 6.e-10*dens(l)
+      end do 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     loop over iterations in the chemical scheme
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do iter = 1,niter
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     modification of c007
+c        by heterogenous reactions h001 and h002
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      if (HETERO.eq.1) then
+       do l = 1,lswitch-1
+         c007h(l) = c007(l)
+     $            + h001(l)/max(cc(l,i_oh), 1.e-30*dens(l))
+     $            + h002(l)/max(cc(l,i_ho2),1.e-30*dens(l))
+c         write(*,*) "C007 = ",c007(l)," / C007H = ",c007h(l)
+       end do
+      else
+       do l = 1,lswitch-1
+         c007h(l) = c007(l)
+       end do
+      endif
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        nox species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        no2/no
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+         rno2_no = (d002(l)*cc(l,i_o3) + d003(l)*cc(l,i_ho2))
+     $            /(j(l,j_no2) +
+     $              d001(l)*max(cc(l,i_o),1.e-30*dens(l)))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        no
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         no(l) = nox(l)/(1. + rno2_no)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        no2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         no2(l) = no(l)*rno2_no
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        hox species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        photochemical equilibrium for oh and ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h/ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+         rh_ho2 = (c001(l)*cc(l,i_o)
+     $           + c004(l)*cc(l,i_h)
+     $           + c005(l)*cc(l,i_h)
+     $           + c006(l)*cc(l,i_h)
+     $           + c007h(l)*cc(l,i_oh)
+     $           + 2.*c008(l)*cc(l,i_ho2)
+     $           + c015(l)*cc(l,i_o3)
+     $           + 2.*c016(l)*cc(l,i_ho2)
+     $           + j(l,j_ho2))
+     $          /(c011(l)*cc(l,i_o2))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        oh/ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         roh_ho2 = (c001(l)*cc(l,i_o)
+     $            + c003(l)*cc(l,i_o3)*rh_ho2
+     $            + 2.*c004(l)*cc(l,i_h)
+     $            + 2.*c008(l)*cc(l,i_ho2)
+     $            + c015(l)*cc(l,i_o3)
+     $            + d003(l)*no(l)
+     $            + j(l,j_ho2)
+     $            + j(l,j_h2o)*cc(l,i_h2o)
+     $             /max(cc(l,i_ho2),dens(l)*1.e-30))
+     $            /(c002(l)*cc(l,i_o)
+     $            + c007h(l)*cc(l,i_ho2)
+     $            + e001(l)*cc(l,i_co))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         cc(l,i_h) = cc(l,i_hox)
+     $                 /(1. + (1. + roh_ho2)/rh_ho2)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         cc(l,i_ho2) = cc(l,i_h)/rh_ho2
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        oh
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         cc(l,i_oh) = cc(l,i_ho2)*roh_ho2
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     modification of c007
+c        by heterogenous reactions h001 and h002
+c           after update of cc(l,i_oh) and cc(l,i_ho2)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      if (HETERO.eq.1) then
+       do l = 1,lswitch-1
+         c007h(l) = c007(l)
+     $            + h001(l)/max(cc(l,i_oh), 1.e-30*dens(l))
+     $            + h002(l)/max(cc(l,i_ho2),1.e-30*dens(l))
+c         write(*,*) "C007 = ",c007(l)," / C007H = ",c007h(l)
+       end do
+      endif
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        ox species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        day:
+c        - o1d at photochemical equilibrium 
+c        - o3 at photochemical equilibrium
+c        - continuity equation for ox
+c        night:
+c        - o1d = 0
+c        - continuity equation for o3
+c        - continuity equation for o
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        
+      if (sza .le. 95.) then
+c
+         do l = 1,lswitch-1
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o(1d)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            cc(l,i_o1d) = (j(l,j_co2_o1d)*co2(l)
+     $                   + j(l,j_o2_o1d)*cc(l,i_o2)
+     $                   + j(l,j_o3_o1d)*cc(l,i_o3))
+     $                   /( b001(l)*co2(l)
+     $                   + b002(l)*cc(l,i_h2o)
+     $                   + b003(l)*cc(l,i_h2)
+     $                   + b004(l)*cc(l,i_o2)
+     $                   + b005(l)*cc(l,i_o3)
+     $                   + b006(l)*cc(l,i_o3))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o/o3
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            ro_o3 = (j(l,j_o3_o1d) + j(l,j_o3_o)
+     $              + a003(l)*cc(l,i_o)
+     $              + c003(l)*cc(l,i_h)
+     $              + c014(l)*cc(l,i_oh)
+     $              + c015(l)*cc(l,i_ho2))
+     $              /(a001(l)*cc(l,i_o2))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o3
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            cc(l,i_o3) = cc(l,i_ox)/(1. + ro_o3)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            cc(l,i_o) = cc(l,i_o3)*ro_o3
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        ox = o + o3
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            production(l,i_ox) =
+     $                   + j(l,j_co2_o)*co2(l)
+     $                   + j(l,j_co2_o1d)*co2(l)
+     $                   + j(l,j_ho2)*cc(l,i_ho2)
+     $                   + 2.*j(l,j_o2_o)*cc(l,i_o2)
+     $                   + 2.*j(l,j_o2_o1d)*cc(l,i_o2)
+     $                   + c006(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                   + c013(l)*cc(l,i_oh)*cc(l,i_oh)
+     $                   + d003(l)*cc(l,i_ho2)*no(l)
+c
+            loss(l,i_ox) = 2.*a002(l)*cc(l,i_o)*cc(l,i_o)
+     $                   + 2.*a003(l)*cc(l,i_o)*cc(l,i_o3)
+     $                   + c001(l)*cc(l,i_ho2)*cc(l,i_o)
+     $                   + c002(l)*cc(l,i_oh)*cc(l,i_o)
+     $                   + c003(l)*cc(l,i_h)*cc(l,i_o3)
+     $                   + c012(l)*cc(l,i_o)*cc(l,i_h2o2)
+     $                   + c014(l)*cc(l,i_o3)*cc(l,i_oh)
+     $                   + c015(l)*cc(l,i_o3)*cc(l,i_ho2)
+     $                   + d001(l)*cc(l,i_o)*no2(l)
+     $                   + e002(l)*cc(l,i_o)*cc(l,i_co)
+c
+            loss(l,i_ox) = loss(l,i_ox)/cc(l,i_ox)
+c
+         end do
+c
+      else
+c
+         do l = 1,lswitch-1
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o(1d)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            cc(l,i_o1d) = 0.
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o3
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            production(l,i_o3) = a001(l)*cc(l,i_o2)*cc(l,i_o)
+c
+            loss(l,i_o3) = a003(l)*cc(l,i_o)
+     $                   + c003(l)*cc(l,i_h)
+     $                   + c014(l)*cc(l,i_oh)
+     $                   + c015(l)*cc(l,i_ho2)
+c
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            production(l,i_o) = c006(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                        + c013(l)*cc(l,i_oh)*cc(l,i_oh)
+c
+            loss(l,i_o)  =  a001(l)*cc(l,i_o2)
+     $                   + 2.*a002(l)*cc(l,i_o)
+     $                   + a003(l)*cc(l,i_o3)
+     $                   + c001(l)*cc(l,i_ho2)
+     $                   + c002(l)*cc(l,i_oh)
+     $                   + c012(l)*cc(l,i_h2o2)
+     $                   + e002(l)*cc(l,i_co)
+c
+         end do
+      end if
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     other species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        co
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_co) = j(l,j_co2_o)*co2(l)
+     $                      + j(l,j_co2_o1d)*co2(l)
+c
+         loss(l,i_co) = e001(l)*cc(l,i_oh)
+     $                + e002(l)*cc(l,i_o)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_o2) = 
+     $                  j(l,j_o3_o)*cc(l,i_o3)
+     $                + j(l,j_o3_o1d)*cc(l,i_o3)
+     $                + a002(l)*cc(l,i_o)*cc(l,i_o)
+     $                + 2.*a003(l)*cc(l,i_o)*cc(l,i_o3)
+     $                + 2.*b005(l)*cc(l,i_o1d)*cc(l,i_o3)
+     $                + b006(l)*cc(l,i_o1d)*cc(l,i_o3)
+     $                + c001(l)*cc(l,i_o)*cc(l,i_ho2)
+     $                + c002(l)*cc(l,i_o)*cc(l,i_oh)
+     $                + c003(l)*cc(l,i_h)*cc(l,i_o3)
+     $                + c005(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                + c007h(l)*cc(l,i_oh)*cc(l,i_ho2)
+     $                + c008(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                + c014(l)*cc(l,i_o3)*cc(l,i_oh)
+     $                + 2.*c015(l)*cc(l,i_o3)*cc(l,i_ho2)
+     $                + c016(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                + d001(l)*cc(l,i_o)*no2(l)
+c
+         loss(l,i_o2) = j(l,j_o2_o)
+     $                + j(l,j_o2_o1d)
+     $                + a001(l)*cc(l,i_o)
+     $                + c011(l)*cc(l,i_h)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_h2) = c005(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                      + c018(l)*cc(l,i_h)*cc(l,i_h)
+c
+         loss(l,i_h2) = b003(l)*cc(l,i_o1d)
+     $                + c010(l)*cc(l,i_oh)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h2o
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_h2o) = 
+     $                   c006(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                 + c007h(l)*cc(l,i_oh)*cc(l,i_ho2)
+     $                 + c009(l)*cc(l,i_oh)*cc(l,i_h2o2)
+     $                 + c010(l)*cc(l,i_oh)*cc(l,i_h2)
+     $                 + c013(l)*cc(l,i_oh)*cc(l,i_oh)
+c
+         loss(l,i_h2o) = j(l,j_h2o)
+     $                 + b002(l)*cc(l,i_o1d)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h2o2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_h2o2) =
+     $                    c008(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                  + c016(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                  + c017(l)*cc(l,i_oh)*cc(l,i_oh)
+c
+         loss(l,i_h2o2) = j(l,j_h2o2)
+     $                  + c009(l)*cc(l,i_oh)
+     $                  + c012(l)*cc(l,i_o)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        hox = h + oh + ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_hox) = 
+     $                   2.*j(l,j_h2o)*cc(l,i_h2o)
+     $                 + 2.*j(l,j_h2o2)*cc(l,i_h2o2)
+     $                 + 2.*b002(l)*cc(l,i_o1d)*cc(l,i_h2o)
+     $                 + 2.*b003(l)*cc(l,i_o1d)*cc(l,i_h2)
+     $                 + 2.*c012(l)*cc(l,i_o)*cc(l,i_h2o2)
+c
+         loss(l,i_hox) = 2.*c005(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                 + 2.*c006(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                 + 2.*c007h(l)*cc(l,i_oh)*cc(l,i_ho2)
+     $                 + 2.*c008(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                 + 2.*c013(l)*cc(l,i_oh)*cc(l,i_oh)
+     $                 + 2.*c016(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                 + 2.*c017(l)*cc(l,i_oh)*cc(l,i_oh)
+     $                 + 2.*c018(l)*cc(l,i_h)*cc(l,i_h)
+c
+         loss(l,i_hox) = loss(l,i_hox)/cc(l,i_hox)
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     update number densities
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     long-lived species
+c
+      do l = 1,lswitch-1
+         cc(l,i_co)  = (cc0(l,i_co) + production(l,i_co)*dt)
+     $              /(1. + loss(l,i_co)*dt)
+         cc(l,i_o2)  = (cc0(l,i_o2) + production(l,i_o2)*dt)
+     $              /(1. + loss(l,i_o2)*dt)
+         cc(l,i_h2)  = (cc0(l,i_h2) + production(l,i_h2)*dt)
+     $              /(1. + loss(l,i_h2)*dt)
+         cc(l,i_h2o2)= (cc0(l,i_h2o2) + production(l,i_h2o2)*dt)
+     $              /(1. + loss(l,i_h2o2)*dt)
+         cc(l,i_h2o) = (cc0(l,i_h2o) + production(l,i_h2o)*dt)
+     $              /(1. + loss(l,i_h2o)*dt)
+         cc(l,i_hox) = (cc0(l,i_hox) + production(l,i_hox)*dt)
+     $              /(1. + loss(l,i_hox)*dt)
+      end do
+c
+c     ox species
+c
+      if (sza .le. 95.) then
+         do l = 1,lswitch-1
+            cc(l,i_ox) = (cc0(l,i_ox) + production(l,i_ox)*dt)
+     $                   /(1. + loss(l,i_ox)*dt)
+         end do
+      else
+         do l = 1,lswitch-1
+            cc(l,i_o)  = (cc0(l,i_o) + production(l,i_o)*dt)
+     $                   /(1. + loss(l,i_o)*dt)
+            cc(l,i_o3) = (cc0(l,i_o3) + production(l,i_o3)*dt)
+     $                   /(1. + loss(l,i_o3)*dt)
+            cc(l,i_ox) = cc(l,i_o) + cc(l,i_o3)
+         end do
+      end if 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     end of loop over iterations
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     density -> volume mixing ratio conversion
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do iesp = 1,nesp
+         do l = 1,lswitch-1
+            rm(l,iesp) = max(cc(l,iesp)/dens(l), 1.e-30)
+         end do
+      end do
+c
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine phot(lswitch, press, temp, sza, dist_sol, rmo3, j)
+c
+c*****************************************************************
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "chimiedata.h" 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c       
+      integer lswitch         ! interface level between chemistries
+      real press(nlayermx)             ! pressure (hPa)
+      real temp(nlayermx)              ! temperature (K)
+      real sza                         ! solar zenith angle (deg)
+      real dist_sol                    ! sun distance (AU) 
+      real rmo3(nlayermx)              ! ozone mixing ratio
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real j(nlayermx,nd)              ! interpolated photolysis rates (s-1) 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer icol, ij, indsza, indcol, indozo, indtemp, 
+     $        iozo, isza, it, iztop, l
+c
+      real col(nlayermx)               ! overhead air column   (molecule cm-2)
+      real colo3(nlayermx)             ! overhead ozone column (molecule cm-2)
+      real poids(2,2,2,2)              ! 4D interpolation weights 
+      real tref                        ! temperature  at 1.9 hPa in the gcm (K)
+      real table_temp(ntemp)           ! temperatures at 1.9 hPa in jmars   (K)
+      real cinf, csup, cicol, 
+     $     ciozo, cisza, citemp
+      real colo3min, dp, scaleh
+      real ratio_o3(nlayermx)
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     day/night criterion
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      if (sza .le. 95.) then 
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     temperatures at 1.9 hPa in jmars
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      table_temp(1) = 226.2
+      table_temp(2) = 206.2
+      table_temp(3) = 186.2
+      table_temp(4) = 169.8
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     interpolation in solar zenith angle
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      indsza = nsza - 1
+      do isza = 1,nsza
+         if (szatab(isza) .ge. sza) then
+            indsza = min(indsza,isza - 1)
+            indsza = max(indsza, 1)
+         end if
+      end do
+      cisza = (sza - szatab(indsza))
+     $       /(szatab(indsza + 1) - szatab(indsza))
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     air and ozone columns
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     air column at model top: assign standard value
+c
+      scaleh = 10.
+      iztop = nint(scaleh*log(press(1)/press(lswitch-1)))
+      iztop = min(iztop,200)
+      col(lswitch-1) = colairtab(iztop)
+c
+c     ozone column at model top
+c
+      colo3(lswitch-1) = 0.
+c
+c     air and ozone columns for other levels
+c
+      do l = lswitch-2,1,-1
+         dp = (press(l) - press(l+1))*100.
+         col(l) = col(l+1) + factor*dp
+         col(l) = min(col(l), colairtab(0))
+         colo3(l) = colo3(l+1)
+     $            + factor*(rmo3(l+1) + rmo3(l))*0.5*dp
+      end do
+c
+c     ratio ozone column/minimal theoretical column (ro3 = 7.171e-10)
+c
+      do l = 1,lswitch-1
+         colo3min    = col(l)*7.171e-10
+         ratio_o3(l) = colo3(l)/colo3min
+         ratio_o3(l) = min(ratio_o3(l), table_ozo(nozo)*10.)
+         ratio_o3(l) = max(ratio_o3(l), table_ozo(1)*10.)
+      end do
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     temperature dependence
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     1) search for temperature at 1.9 hPa (tref): vertical interpolation
+c
+c      print*,'****** recherche de T a 1.9 hPa ******'
+      tref = temp(1)
+      do l = (lswitch-1)-1,1,-1
+         if (press(l) .gt. 1.9) then
+            cinf = (press(l) - 1.9)
+     $            /(press(l) - press(l+1))
+            csup = 1. - cinf
+            tref = cinf*temp(l+1) + csup*temp(l)
+c
+c            print*, press(l+1), temp(l+1)
+c            print*, press(l  ), temp(l  )
+c            print*, 'tref = ', tref
+            go to 10
+         end if
+      end do 
+ 10   continue
+c
+c     2) interpolation in temperature
+c
+      tref = min(tref,table_temp(1))
+      tref = max(tref,table_temp(ntemp))
+c
+      do it = 2, ntemp
+         if (table_temp(it) .le. tref) then
+            citemp = (log(tref) - log(table_temp(it)))
+     $              /(log(table_temp(it-1)) - log(table_temp(it)))
+            indtemp = it - 1
+c            print*,'interpolation entre ', table_temp(it), ' et ',
+c     $              table_temp(it-1) 
+c            print*,'indtemp = ', indtemp, ' citemp = ', citemp
+            goto 20
+         end if
+      end do
+  20  continue
+c      print*,'****** fin interpolation en T ********'
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     loop over vertical levels
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+c     interpolation in air column
+c
+         do icol = 0,200
+            if (colairtab(icol) .lt. col(l)) then
+               cicol = (log(col(l)) - log(colairtab(icol)))
+     $                /(log(colairtab(icol-1)) - log(colairtab(icol)))
+               indcol = icol - 1
+               goto 30
+            end if
+         end do
+ 30      continue
+c
+cc    interpolation in ozone column
+c
+         indozo = nozo - 1
+         do iozo = 1,nozo
+            if (table_ozo(iozo)*10. .ge. ratio_o3(l)) then
+               indozo = min(indozo, iozo - 1)
+               indozo = max(indozo, 1)
+            end if
+         end do
+         ciozo = (ratio_o3(l) - table_ozo(indozo)*10.)
+     $          /(table_ozo(indozo + 1)*10. - table_ozo(indozo)*10.)
+c
+c         write(6,'(i2,4e13.4,5f10.4)') 
+c    $         l, press(l), col(l), 
+c    $         colairtab(indcol), colairtab(indcol+1), 
+c    $         colo3(l)/2.687e15, 
+c    $         ratio_o3(l), table_ozo(indozo), table_ozo(indozo+1), 
+c    $         ciozo
+c 
+cc    4-dimensional interpolation weights
+c
+         poids(1,1,1,1) = citemp*(1.-cisza)*cicol*(1.-ciozo)
+         poids(1,1,1,2) = citemp*(1.-cisza)*cicol*ciozo
+         poids(1,1,2,1) = citemp*(1.-cisza)*(1.-cicol)*(1.-ciozo)
+         poids(1,1,2,2) = citemp*(1.-cisza)*(1.-cicol)*ciozo
+         poids(1,2,1,1) = citemp*cisza*cicol*(1.-ciozo)
+         poids(1,2,1,2) = citemp*cisza*cicol*ciozo
+         poids(1,2,2,1) = citemp*cisza*(1.-cicol)*(1.-ciozo)
+         poids(1,2,2,2) = citemp*cisza*(1.-cicol)*ciozo
+         poids(2,1,1,1) = (1.-citemp)*(1.-cisza)*cicol*(1.-ciozo)
+         poids(2,1,1,2) = (1.-citemp)*(1.-cisza)*cicol*ciozo
+         poids(2,1,2,1) = (1.-citemp)*(1.-cisza)*(1.-cicol)*(1.-ciozo)
+         poids(2,1,2,2) = (1.-citemp)*(1.-cisza)*(1.-cicol)*ciozo
+         poids(2,2,1,1) = (1.-citemp)*cisza*cicol*(1.-ciozo)
+         poids(2,2,1,2) = (1.-citemp)*cisza*cicol*ciozo
+         poids(2,2,2,1) = (1.-citemp)*cisza*(1.-cicol)*(1.-ciozo)
+         poids(2,2,2,2) = (1.-citemp)*cisza*(1.-cicol)*ciozo
+c
+cc    4-dimensional interpolation in the lookup table
+c
+         do ij = 1,nd
+           j(l,ij) =
+     $     poids(1,1,1,1)*jphot(indtemp,indsza,indcol,indozo,ij)
+     $   + poids(1,1,1,2)*jphot(indtemp,indsza,indcol,indozo+1,ij)
+     $   + poids(1,1,2,1)*jphot(indtemp,indsza,indcol+1,indozo,ij)
+     $   + poids(1,1,2,2)*jphot(indtemp,indsza,indcol+1,indozo+1,ij)
+     $   + poids(1,2,1,1)*jphot(indtemp,indsza+1,indcol,indozo,ij)
+     $   + poids(1,2,1,2)*jphot(indtemp,indsza+1,indcol,indozo+1,ij)
+     $   + poids(1,2,2,1)*jphot(indtemp,indsza+1,indcol+1,indozo,ij)
+     $   + poids(1,2,2,2)*jphot(indtemp,indsza+1,indcol+1,indozo+1,ij)
+     $   + poids(2,1,1,1)*jphot(indtemp+1,indsza,indcol,indozo,ij)
+     $   + poids(2,1,1,2)*jphot(indtemp+1,indsza,indcol,indozo+1,ij)
+     $   + poids(2,1,2,1)*jphot(indtemp+1,indsza,indcol+1,indozo,ij)
+     $   + poids(2,1,2,2)*jphot(indtemp+1,indsza,indcol+1,indozo+1,ij)
+     $   + poids(2,2,1,1)*jphot(indtemp+1,indsza+1,indcol,indozo,ij)
+     $   + poids(2,2,1,2)*jphot(indtemp+1,indsza+1,indcol,indozo+1,ij)
+     $   + poids(2,2,2,1)*jphot(indtemp+1,indsza+1,indcol+1,indozo,ij)
+     $   + poids(2,2,2,2)*jphot(indtemp+1,indsza+1,indcol+1,indozo+1,ij)
+         end do
+c
+cc    correction for sun distance
+c
+         do ij = 1,nd
+            j(l,ij) = j(l,ij)*(1.52/dist_sol)**2.
+         end do 
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     end of loop over vertical levels
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      end do
+c
+      else
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     night
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do ij = 1,nd
+         do l = 1,lswitch-1
+            j(l,ij) = 0.
+         end do
+      end do
+c
+      end if
+c
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine gcmtochim(zycol, lswitch, nesp, rm)
+c
+c*****************************************************************
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real zycol(nlayermx,nqmx)! species volume mixing ratio in the gcm
+c
+      integer nesp            ! number of species in the chemistry
+      integer lswitch         ! interface level between chemistries
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     outputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real rm(nlayermx,nesp)   ! species volume mixing ratio 
+c      
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer l
+      integer i_co2, i_co, i_o2, i_h2, i_h2o, i_h2o2, i_hox, i_ox,
+     $        i_o1d, i_o, i_o3, i_h, i_oh, i_ho2, i_n2
+c      
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracers numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     co2      =  nqchem_min           
+c     co       =  nqchem_min + 1          
+c     o        =  nqchem_min + 2
+c     o(1d)    =  nqchem_min + 3
+c     o2       =  nqchem_min + 4
+c     o3       =  nqchem_min + 5
+c     h        =  nqchem_min + 6
+c     h2       =  nqchem_min + 7
+c     oh       =  nqchem_min + 8
+c     ho2      =  nqchem_min + 9
+c     h2o2     =  nqchem_min + 10
+c     n2       =  nqchem_min + 11
+c     ar       =  nqchem_min + 12
+c     h2o      =  nqmx
+c      
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracers numbering in the chemistry
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      i_co2    =  1
+      i_co     =  2
+      i_o      =  3
+      i_o1d    =  4
+      i_o2     =  5
+      i_o3     =  6
+      i_h      =  7
+      i_h2     =  8
+      i_oh     =  9
+      i_ho2    = 10
+      i_h2o2   = 11
+      i_h2o    = 12
+      i_n2     = 13
+      i_hox    = 14
+      i_ox     = 15
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     initialise chemical species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+       rm(l,i_co2)  = max(zycol(l, nqchem_min),      1.e-30)
+       rm(l,i_co)   = max(zycol(l, nqchem_min + 1),  1.e-30)
+       rm(l,i_o)    = max(zycol(l, nqchem_min + 2),  1.e-30)
+       rm(l,i_o1d)  = max(zycol(l, nqchem_min + 3),  1.e-30)
+       rm(l,i_o2)   = max(zycol(l, nqchem_min + 4),  1.e-30)
+       rm(l,i_o3)   = max(zycol(l, nqchem_min + 5),  1.e-30)
+       rm(l,i_h)    = max(zycol(l, nqchem_min + 6),  1.e-30)
+       rm(l,i_h2)   = max(zycol(l, nqchem_min + 7),  1.e-30)
+       rm(l,i_oh)   = max(zycol(l, nqchem_min + 8),  1.e-30)
+       rm(l,i_ho2)  = max(zycol(l, nqchem_min + 9),  1.e-30)
+       rm(l,i_h2o2) = max(zycol(l, nqchem_min + 10), 1.e-30)
+       rm(l,i_n2)   = max(zycol(l, nqchem_min + 11), 1.e-30)
+       rm(l,i_h2o)  = max(zycol(l, nqmx),            1.e-30)
+c 
+      end do 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     initialise chemical families                     c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+         rm(l,i_hox) = rm(l,i_h) 
+     $               + rm(l,i_oh)
+     $               + rm(l,i_ho2)
+         rm(l,i_ox)  = rm(l,i_o) 
+     $               + rm(l,i_o3)
+      end do
+c
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine chimtogcm(zycol, lswitch, nesp, rm)
+c
+c*****************************************************************
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer nesp               ! number of species in the chemistry
+      integer lswitch            ! interface level between chemistries
+c      
+      real rm(nlayermx,nesp)     ! species volume mixing ratio 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real zycol(nlayermx,nqmx)  ! species volume mixing ratio in the gcm
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer l
+      integer i_co2, i_co, i_o2, i_h2, i_h2o, i_h2o2, i_hox, i_ox,
+     $        i_o1d, i_o, i_o3, i_h, i_oh, i_ho2, i_n2
+c      
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracers numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     co2      =  nqchem_min
+c     co       =  nqchem_min + 1
+c     o        =  nqchem_min + 2
+c     o(1d)    =  nqchem_min + 3
+c     o2       =  nqchem_min + 4
+c     o3       =  nqchem_min + 5
+c     h        =  nqchem_min + 6
+c     h2       =  nqchem_min + 7
+c     oh       =  nqchem_min + 8
+c     ho2      =  nqchem_min + 9
+c     h2o2     =  nqchem_min + 10
+c     n2       =  nqchem_min + 11
+c     ar       =  nqchem_min + 12
+c     h2o      =  nqmx
+c      
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracers numbering in the chemistry
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      i_co2    =  1
+      i_co     =  2
+      i_o      =  3
+      i_o1d    =  4
+      i_o2     =  5
+      i_o3     =  6
+      i_h      =  7
+      i_h2     =  8
+      i_oh     =  9
+      i_ho2    = 10
+      i_h2o2   = 11
+      i_h2o    = 12
+      i_n2     = 13
+      i_hox    = 14
+      i_ox     = 15
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     save mixing ratios for the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+         zycol(l, nqchem_min)      = rm(l,i_co2) 
+         zycol(l, nqchem_min + 1)  = rm(l,i_co) 
+         zycol(l, nqchem_min + 2)  = rm(l,i_o) 
+         zycol(l, nqchem_min + 3)  = rm(l,i_o1d)
+         zycol(l, nqchem_min + 4)  = rm(l,i_o2) 
+         zycol(l, nqchem_min + 5)  = rm(l,i_o3) 
+         zycol(l, nqchem_min + 6)  = rm(l,i_h)  
+         zycol(l, nqchem_min + 7)  = rm(l,i_h2) 
+         zycol(l, nqchem_min + 8)  = rm(l,i_oh) 
+         zycol(l, nqchem_min + 9)  = rm(l,i_ho2) 
+         zycol(l, nqchem_min + 10) = rm(l,i_h2o2)
+         zycol(l, nqchem_min + 11) = rm(l,i_n2)
+         zycol(l, nqmx)            = rm(l,i_h2o)
+      end do 
+c
+c  water ice: zycol(nqmx-1) has not been changed if iceparty on
+c  
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine chemrates(lswitch, dens, press, t, icesurf,
+     $                     a001, a002, a003,
+     $                     b001, b002, b003, b004, b005, b006,
+     $                     c001, c002, c003, c004, c005, c006,
+     $                     c007, c008, c009, c010, c011, c012,
+     $                     c013, c014, c015, c016, c017, c018,
+     $                     d001, d002, d003,
+     $                     e001, e002,
+     $                     h001, h002)
+c
+c*****************************************************************
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:                                                    c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer lswitch                  ! interface level between chemistries
+
+      real dens(nlayermx)              ! density (cm-3)
+      real press(nlayermx)             ! pressure (hpa)
+      real t(nlayermx)                 ! temperature (k)
+      real icesurf(nlayermx)           ! ice surface area (cm^2/cm^3)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     outputs:                                                   c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real a001(nlayermx), a002(nlayermx), a003(nlayermx)
+      real b001(nlayermx), b002(nlayermx), b003(nlayermx), 
+     $     b004(nlayermx), b005(nlayermx), b006(nlayermx)
+      real c001(nlayermx), c002(nlayermx), c003(nlayermx), 
+     $     c004(nlayermx), c005(nlayermx), c006(nlayermx), 
+     $     c007(nlayermx), c008(nlayermx), c009(nlayermx), 
+     $     c010(nlayermx), c011(nlayermx), c012(nlayermx),
+     $     c013(nlayermx), c014(nlayermx), c015(nlayermx), 
+     $     c016(nlayermx), c017(nlayermx), c018(nlayermx)
+      real d001(nlayermx), d002(nlayermx), d003(nlayermx)
+      real e001(nlayermx), e002(nlayermx)
+      real h001(nlayermx), h002(nlayermx)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:                                                     c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real ak0, ak1, rate, xpo
+c
+      integer l
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     compute reaction rates from JPL 1997, otherwise mentioned
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        oxygen compounds
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      a001: o + o2 + co2 -> o3 + co2
+c
+c        jpl 2003
+c
+         a001(l) = 2.5
+     $             *6.0e-34*(t(l)/300.)**(-2.4)*dens(l)
+c
+c        nair et al., 1994
+c
+c        a001(l) = 1.3e-34*exp(724./t(l))*dens(l)
+c
+ccc      a002: o + o + co2 -> o2 + co2
+c
+c        Tsang and Hampson, J. Chem. Phys. Ref. Data, 15, 1087, 1986
+c
+         a002(l) = 2.5*5.2e-35*exp(900./t(l))*dens(l)
+c
+c        Campbell and Gray, Chem. Phys. Lett., 18, 607, 1973
+c
+c        a002(l) = 1.2e-32*(300./t(l))**(2.0)*dens(l)
+c
+ccc      a003: o + o3 -> o2 + o2
+c
+c        jpl 2003
+c
+         a003(l) = 8.0e-12*exp(-2060./t(l))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        reactions with o(1d)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      b001: o(1d) + co2  -> o + co2
+c
+c        jpl 2003
+c
+         b001(l) = 7.4e-11*exp(120./t(l))
+c
+ccc      b002: o(1d) + h2o  -> oh + oh
+c
+c        jpl 2003
+c
+         b002(l) = 2.2e-10
+c    
+ccc      b003: o(1d) + h2  -> oh + h
+c
+c        jpl 2003
+c
+         b003(l) = 1.1e-10
+c
+c        nair et al., 1994
+c
+c        b003(l) = 1.0e-10
+c    
+ccc      b004: o(1d) + o2  -> o + o2
+c
+c        jpl 2003
+c
+         b004(l) = 3.2e-11*exp(70./t(l))
+c    
+ccc      b005: o(1d) + o3  -> o2 + o2
+c
+c        jpl 2003
+c
+         b005(l) = 1.2e-10
+c    
+ccc      b006: o(1d) + o3  -> o2 + o + o
+c
+c        jpl 2003
+c
+         b006(l) = 1.2e-10
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        hydrogen compounds    
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      c001: o + ho2 -> oh + o2
+c
+c        jpl 2003
+c 
+         c001(l) = 3.0e-11*exp(200./t(l))
+c        c001(l) = 0.75*3.0e-11*exp(200./t(l))
+c
+ccc      c002: o + oh -> o2 + h
+c
+c        jpl 2003
+c 
+         c002(l) = 2.2e-11*exp(120./t(l))
+c
+ccc      c003: h + o3 -> oh + o2
+c
+c        jpl 2003
+c 
+         c003(l) = 1.4e-10*exp(-470./t(l))
+c
+ccc      c004: h + ho2 -> oh + oh
+c
+c        jpl 2003
+c 
+         c004(l) = 8.1e-11*0.90
+c
+ccc      c005: h + ho2 -> h2 + o2
+c
+c        jpl 2003
+c 
+         c005(l) = 8.1e-11*0.08
+c
+ccc      c006: h + ho2 -> h2o + o
+c
+c        jpl 2003
+c 
+         c006(l) = 8.1e-11*0.02
+c
+ccc      c007: oh + ho2 -> h2o + o2
+c
+c        jpl 2003
+c 
+         c007(l) = 4.8e-11*exp(250./t(l))
+c        c007(l) = 0.75*4.8e-11*exp(250./t(l))
+c
+ccc      c008: ho2 + ho2 -> h2o2 + o2
+c
+c        jpl 2003
+c 
+c        c008(l) = 2.3e-13*exp(600./t(l))
+c
+c        christensen et al., grl, 13, 2002
+c
+         c008(l) = 1.5e-12*exp(19./t(l))
+c
+ccc      c009: oh + h2o2 -> h2o + ho2
+c
+c        jpl 2003
+c 
+         c009(l) = 2.9e-12*exp(-160./t(l))
+c
+ccc      c010: oh + h2 -> h2o + h
+c
+c        jpl 2003
+c 
+         c010(l) = 5.5e-12*exp(-2000./t(l))
+c
+ccc      c011: h + o2 + co2 -> ho2 + co2
+c
+c        jpl 2003
+c 
+         ak0 = 2.5*5.7e-32*(t(l)/300.)**(-1.6)
+         ak1 = 7.5e-11*(t(l)/300.)**(0.0)
+c
+         rate = (ak0*dens(l))/(1. + ak0*dens(l)/ak1)
+         xpo = 1./(1. + alog10((ak0*dens(l))/ak1)**2)
+         c011(l) = rate*0.6**xpo
+c
+ccc      c012: o + h2o2 -> oh + ho2
+c
+c        jpl 2003
+c 
+         c012(l) = 1.4e-12*exp(-2000./t(l))
+c
+ccc      c013: oh + oh -> h2o + o
+c
+c        jpl 2003
+c 
+         c013(l) = 4.2e-12*exp(-240./t(l))
+c
+ccc      c014: oh + o3 -> ho2 + o2
+c
+c        jpl 2003
+c
+         c014(l) = 1.7e-12*exp(-940./t(l))
+c
+c        jpl 2000
+c
+c        c014(l) = 1.5e-12*exp(-880./t(l))
+c
+c        nair et al., 1994 (jpl 1997)
+c
+c        c014(l) = 1.6e-12*exp(-940./t(l))
+c
+ccc      c015: ho2 + o3 -> oh + o2 + o2
+c
+c        jpl 2003
+c
+         c015(l) = 1.0e-14*exp(-490./t(l))
+c
+c        jpl 2000
+c
+c        c015(l) = 2.0e-14*exp(-680./t(l))
+c
+c        nair et al., 1994 (jpl 1997)
+c
+c        c015(l) = 1.1e-14*exp(-500./t(l))
+c
+ccc      c016: ho2 + ho2 + co2 -> h2o2 + o2 + co2
+c
+c        jpl 2003
+c
+         c016(l) = 2.5*1.7e-33
+     $              *exp(1000./t(l))*dens(l)
+c
+ccc      c017: oh + oh + co2 -> h2o2 + co2
+c
+c        jpl 2003
+c
+         ak0 = 2.5*6.9e-31*(t(l)/300.)**(-1.0)
+         ak1 = 2.6e-11*(t(l)/300.)**(0.0)
+c
+c        jpl 1997
+c
+c        ak0 = 2.5*6.2e-31*(t(l)/300.)**(-1.0)
+c        ak1 = 2.6e-11*(t(l)/300.)**(0.0)
+c
+c        nair et al., 1994
+c
+c        ak0 = 2.5*7.1e-31*(t(l)/300.)**(-0.8)
+c        ak1 = 1.5e-11*(t(l)/300.)**(0.0)
+c
+         rate = (ak0*dens(l))/(1. + ak0*dens(l)/ak1)
+         xpo = 1./(1. + alog10((ak0*dens(l))/ak1)**2)
+         c017(l) = rate*0.6**xpo
+c
+ccc      c018: h + h + co2 -> h2 + co2
+c
+c        baulch et al., 1992
+c
+         c018(l) = 2.5*8.85e-33*(t(l)/298.)**(-0.6)*dens(l)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        nitrogen compounds
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      d001: no2 + o -> no + o2
+c
+c        jpl 2003
+c
+         d001(l) = 5.6e-12*exp(180./t(l))
+c
+ccc      d002: no + o3 -> no2 + o2
+c
+c        jpl 2003
+c
+         d002(l) = 3.0e-12*exp(-1500./t(l))
+c
+ccc      d003: no + ho2 -> no2 + oh
+c
+c        jpl 2003
+c
+         d003(l) = 3.5e-12*exp(250./t(l))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        carbon compounds
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      e001: oh + co -> co2 + h
+c
+c        jpl 2003
+c
+c        e001(l) = 1.5e-13*(1 + 0.6*press(l)/1013.)
+c
+c        mccabe et al., grl, 28, 3135, 2001
+c
+         e001(l) = 1.57e-13 + 3.54e-33*dens(l)
+c
+ccc      e002: o + co + m -> co2 + m
+c
+c        tsang and hampson, 1986.
+c
+         e002(l) = 2.5*6.5e-33*exp(-2184./t(l))*dens(l)
+c
+c        baulch et al., butterworths, 1976.
+c
+c        e002(l) = 1.6e-32*exp(-2184./t(l))*dens(l)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        heterogenous chemistry
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      h001: ho2 + ice surface -> (ho2)ads
+ccc           (ho2)ads + oh -> h2o + o2
+ccc      total : oh + ho2 -> h2o + o2, first order
+ccc         K = h001*[ho2],
+ccc      h001 = (S*v*gamma1)/4. (s-1), v=100*sqrt(3kT/m_ho2) (cm s-1)
+c
+c        cooper and abbatt, 1996
+c
+         h001(l) = icesurf(l) * 25.*sqrt(3*8.31*t(l)/33.) * 0.025
+c         h001(l) = 0.0e0
+c
+ccc      h002: oh + ice surface -> (oh)ads
+ccc           (oh)ads + ho2 -> h2o + o2
+ccc      total : oh + ho2 -> h2o + o2, first order
+ccc         K = h002*[oh],
+ccc      h002 = (S*v*gamma2)/4. (s-1), v=100*sqrt(3kT/m_oh) (cm s-1)
+c
+c        cooper and abbatt, 1996
+c
+         h002(l) = icesurf(l) * 25.*sqrt(3*8.31*t(l)/17.) * 0.03
+c         h002(l) = 0.0e0
+c
+c        write(*,*) "level ",l," / icesurf=",icesurf(l),
+c     $       " / 0.25vg1=",(25.*sqrt(3*8.31*t(l)/33.) * 0.025),
+c     $       " / 0.25vg2=",(25.*sqrt(3*8.31*t(l)/17.) * 0.03)
+c
+      end do
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/thermosphere.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/thermosphere.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/aeronomars/thermosphere.F	(revision 2744)
@@ -0,0 +1,88 @@
+      subroutine thermosphere(pplev,pplay,dist_sol,
+     $     mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay,
+     &     pt,pq,pu,pv,pdt,pdq,
+     $     zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff)
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "param.h"
+#include "param_v3.h"
+#include "chimiedata.h"
+#include "conc.h"
+
+
+      INTEGER l,ig
+
+      REAL pplay(ngridmx,nlayermx)
+      real pplev(ngridmx,nlayermx+1)
+      REAL zzlay(ngridmx,nlayermx)
+      real zzlev(ngridmx,nlayermx+1)
+      REAL pt(ngridmx,nlayermx)
+      real zday
+      REAL dist_sol
+      real mu0(ngridmx)
+      real pq(ngridmx,nlayermx,nqmx)
+      real ptimestep
+      real ptime
+      real tsurf(ngridmx)
+      REAL pu(ngridmx,nlayermx),pv(ngridmx,nlayermx)
+      REAL pdt(ngridmx,nlayermx),pdq(ngridmx,nlayermx,nqmx)
+
+      REAL zdteuv(ngridmx,nlayermx)
+      REAL zdtconduc(ngridmx,nlayermx)
+      REAL zdumolvis(ngridmx,nlayermx)
+      REAL zdvmolvis(ngridmx,nlayermx)
+      real zdqmoldiff(ngridmx,nlayermx,nqmx)
+
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+
+      if (firstcall) then
+        if (.not. tracer) then
+          do l=1,nlayermx
+            do ig=1,ngridmx
+              rnew(ig,l)=r
+              cpnew(ig,l)=cpp
+            enddo
+          enddo
+        endif
+        firstcall= .false.
+      endif
+
+      if (calleuv) then
+        call zerophys(ngridmx*nlayermx,zdteuv)
+        call euvheat(pt,pdt,pplev,pplay,zzlay,dist_sol,
+     $               mu0,ptimestep,ptime,zday,pq,pdq,zdteuv)
+      endif
+
+      if (callconduct) THEN
+        call zerophys(ngridmx*nlayermx,zdtconduc)
+        call conduction(ptimestep,pplay,pplev,pt,zdteuv,
+     $                   tsurf,zzlev,zzlay,zdtconduc)
+      endif
+
+      if (callmolvis) THEN
+        call zerophys(ngridmx*nlayermx,zdumolvis)
+        call molvis(ptimestep,pplay,pplev,pt,zdteuv,zdtconduc,pu,
+     $                   tsurf,zzlev,zzlay,zdumolvis)
+        call zerophys(ngridmx*nlayermx,zdvmolvis)
+        call molvis(ptimestep,pplay,pplev,pt,zdteuv,zdtconduc,pv,
+     $                   tsurf,zzlev,zzlay,zdvmolvis)
+      endif
+
+      if (callmoldiff) THEN
+        call zerophys(ngridmx*nlayermx*nqmx,zdqmoldiff)
+        call moldiff(pplay,pplev,pt,pdt,pq,pdq,ptimestep,
+     &                   zzlay,zdteuv,zdtconduc,zdqmoldiff)
+      endif
+
+      return
+      end
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/cbrt.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/cbrt.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/cbrt.F	(revision 2744)
@@ -0,0 +1,9 @@
+      FUNCTION cbrt(x)
+      IMPLICIT NONE
+
+      REAL x,cbrt
+
+      cbrt=sign(1.,x)*(abs(x)**(1./3.))
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/cvmgp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/cvmgp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/cvmgp.F	(revision 2744)
@@ -0,0 +1,14 @@
+      FUNCTION cvmgp(x1,x2,x3)
+      IMPLICIT NONE
+
+      REAL x1,x2,x3,cvmgp
+
+      IF(x3.ge.0) then 
+        cvmgp=x1
+      ELSE
+        cvmgp=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/cvmgt.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/cvmgt.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/cvmgt.F	(revision 2744)
@@ -0,0 +1,15 @@
+      FUNCTION cvmgt(x1,x2,l)
+      IMPLICIT NONE
+
+      REAL x1,x2,cvmgt
+      LOGICAL l
+
+      IF(l) then 
+        cvmgt=x1
+      ELSE
+        cvmgt=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/from36.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/from36.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/from36.F	(revision 2744)
@@ -0,0 +1,111 @@
+      SUBROUTINE from36(x,nbre,iunit)
+      IMPLICIT NONE
+c====================================================================
+      INTEGER iunit, nbre
+      REAL x(nbre)
+c====================================================================
+      INTEGER i, l
+      INTEGER nbreok, ibaseok, icase
+      REAL xmax, xmin, errcod
+c====================================================================
+      INTEGER lbord
+      PARAMETER (lbord=255)
+      REAL conv(0:lbord)
+c====================================================================     
+      INTEGER ibase, maxcas, maxnbr, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36, maxcas=3, maxnbr=100000)
+      PARAMETER(ifact1=ibase**1-1)
+      PARAMETER(ifact2=ibase**2-1)
+      PARAMETER(ifact3=ibase**3-1)
+      CHARACTER*1 base(ibase), fac(maxcas,maxnbr)
+      INTEGER inte(maxcas)
+      DATA (base(l),l=1,ibase)
+     .     /'0','1','2','3','4','5','6','7','8','9',
+     .      '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'/
+c====================================================================
+      IF (nbre .GT. maxnbr) THEN
+      PRINT*, 'Verifier maxnbr dans from36 (trop petite)'
+      STOP
+      ENDIF
+      DO 10 i = 0, lbord
+   10 conv(i) = 1.0e+33
+c    34  c  10 conv(i) = 1.0e+49
+      DO 20 i = 1, ibase
+      l = ICHAR(base(i))
+   20 conv(l) = FLOAT(i-1)
+c====================================================================
+      READ (iunit,*) nbreok, ibaseok, icase
+        IF (nbre .NE. nbreok) THEN
+          PRINT*, 'Incoherence (Nombre elements)', nbreok, nbre
+          STOP
+        ENDIF
+        IF (ibase .NE. ibaseok) THEN
+          PRINT*, 'Incoherence (Nombre base)', ibaseok, ibase
+          STOP
+        ENDIF
+        IF (icase.NE.1 .AND. icase.NE.2 .AND. icase.NE.3) THEN
+          PRINT*, 'Verifier icase (1,2,3) dans le fichier a lire', 
+     .             icase
+          STOP
+        ENDIF
+c====================================================================
+      READ (iunit,*) xmin
+      READ (iunit,*) xmax
+        PRINT*,'Xmin et Xmax=', xmin, xmax
+c====================================================================
+      IF (xmin .EQ. xmax) THEN
+        READ(iunit,'(a)')
+        PRINT*, 'Ce champ est constant'
+        DO 30 i = 1, nbre
+   30   x(i) = xmin
+        GO TO 123
+      END IF
+c====================================================================
+      IF (icase .EQ. 1) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact1)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,91)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 190 i = 1, nbre
+        x(i) = 0.0
+        DO 191 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  191   CONTINUE
+        x(i) = xmin + x(i)/FLOAT(ifact1)*(xmax-xmin)
+  190   CONTINUE
+      ELSE IF (icase .EQ. 2) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact2)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,92)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 290 i = 1, nbre
+        x(i) = 0.0
+        DO 291 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  291   CONTINUE
+        x(i) = xmin + x(i)/float(ifact2)*(xmax-xmin)
+  290   CONTINUE
+      ELSE IF (icase .EQ. 3) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact3)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,93)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 390 i = 1, nbre
+        x(i) = 0.0
+        DO 391 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  391   CONTINUE
+        x(i) = xmin + x(i)/FLOAT(ifact3)*(xmax-xmin)
+  390   CONTINUE
+      ELSE
+        PRINT*, 'Verfier icase (1, 2 ou 3)'
+        STOP
+      ENDIF
+   91 FORMAT(120a1)
+   92 FORMAT(64(2a1))
+   93 FORMAT(40(3a1))
+c====================================================================
+  123 RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/gather.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/gather.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/gather.F	(revision 2744)
@@ -0,0 +1,16 @@
+      SUBROUTINE GATHER(n,a,b,index)
+c
+      IMPLICIT NONE
+C
+      INTEGER n,index(n),i
+      REAL a(n),b(n)
+c
+      DO 100 i=1,n
+        a(i)=b(index(i))
+100   CONTINUE
+c
+      RETURN
+      END
+c
+c     voir aussi vec_gather(v,vindices,count,r)...p.11-14
+c  
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ilsum.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ilsum.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ilsum.F	(revision 2744)
@@ -0,0 +1,19 @@
+      FUNCTION ilsum(n, logic, inc)
+c
+      IMPLICIT NONE
+c
+      integer ilsum
+      integer n, inc
+      logical logic((n-1)*inc+1)
+c
+      integer i, in
+c
+      ilsum = 0.
+      in = 1
+      do 10 i = 1, n
+         if (logic(in)) ilsum = ilsum + 1
+         in=in+inc
+10    continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ini36.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ini36.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ini36.F	(revision 2744)
@@ -0,0 +1,46 @@
+      SUBROUTINE ini36
+Ccray IMPLICIT NONE
+      IMPLICIT NONE
+c====================================================================
+c-- cette routine fait l'initialisation pour le codage sur base 36
+c-- de la routine to36. on peut utiliser soit 1 soit 2 soit 3 cases
+      INTEGER i,j,k,l, ijk, jk
+c====================================================================
+      INTEGER ibase, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36)
+      PARAMETER (ifact1 = ibase-1)
+      PARAMETER (ifact2 = ibase*ibase-1)
+      PARAMETER (ifact3 = ibase*ibase*ibase-1)
+c====================================================================
+      CHARACTER*1 word1(0:ifact1)
+      COMMON /elbat1/ word1
+      CHARACTER*2 word2(0:ifact2)
+      COMMON /elbat2/ word2
+      CHARACTER*3 word3(0:ifact3)
+      COMMON /elbat3/ word3
+c====================================================================
+      CHARACTER*1 base(ibase)
+      DATA (base(l),l=1,ibase)
+     .     /'0','1','2','3','4','5','6','7','8','9',
+     .      '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'/
+c===================================================================
+      DO 30 i = 1, ibase
+      DO 30 j = 1, ibase
+      DO 30 k = 1, ibase
+      ijk = ( (i-1)*ibase + j-1 )*ibase + k-1
+      word3(ijk) = base(i)//base(j)//base(k)
+   30 CONTINUE
+      DO 20 j = 1, ibase
+      DO 20 k = 1, ibase
+      jk = (j-1)*ibase + k-1
+      word2(jk) = base(j)//base(k)
+   20 CONTINUE
+      DO 10 k = 1, ibase
+      word1(k-1) = base(k)
+   10 CONTINUE
+c===================================================================
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/isamax.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/isamax.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/isamax.F	(revision 2744)
@@ -0,0 +1,21 @@
+      function isamax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,isamax,ix
+      real sx((n-1)*incx+1),sxmax,abssx
+c
+      ix=1
+      isamax=1
+      sxmax=ABS(sx(1))
+      do 10 i=1,n-1
+         ix=ix+incx
+         abssx=ABS(sx(ix))
+         if(abssx.gt.sxmax) then
+             sxmax=abssx
+             isamax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/isitor.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/isitor.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/isitor.F	(revision 2744)
@@ -0,0 +1,64 @@
+
+      SUBROUTINE isitor(filename,writeornot,filenum, files)
+
+C--------------------------------------------------------------------
+C Subroutine qui determine si un fichier doit etre ecrit ou non
+C--------------------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     filename: CHARACTER*20 
+C               nom du fichier dont on veut savoir si il doit etre ecrit
+C     writeornot: LOGICAL
+C                 Variable de sortie qui est vraie si le champ doit etre ecrit
+C     filenum: INTEGER
+C              nombre de fichier dans la list files
+C     files: CHARACTER*20 files(100)
+C            c'est la liste des fichier qui doivent etre ecrit et dans
+C            lequel on vas voir si filename y est.
+C
+
+
+      IMPLICIT NONE
+      CHARACTER*20 filename, checkname
+      CHARACTER*1 separator
+      LOGICAL writeornot, check
+      INTEGER iletter, ifile
+      INTEGER filenum
+      CHARACTER*20 files(100)
+
+      writeornot = .FALSE.
+      check = .FALSE.
+      separator = '/'
+
+      DO 6565 iletter = 20,1,-1
+
+        IF (filename(iletter:iletter) .EQ. separator) THEN
+
+          checkname = filename(iletter+1:20)
+    
+        ELSE
+        ENDIF
+ 6565 CONTINUE
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: filename=',filename,
+     &             'checkname=',checkname
+      ENDIF
+
+      DO 6767 ifile = 1,filenum
+
+      IF (files(ifile) .EQ. checkname ) THEN
+       
+      writeornot = .TRUE. 
+
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: writeornot=',writeornot
+      ENDIF
+
+ 6767 CONTINUE
+
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ismax.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ismax.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ismax.F	(revision 2744)
@@ -0,0 +1,20 @@
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+      ix=ix+incx
+      if(sx(ix).gt.sxmax) then
+      sxmax=sx(ix)
+      ismax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ismin.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ismin.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ismin.F	(revision 2744)
@@ -0,0 +1,20 @@
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+	 ix=ix+incx
+	 if(sx(ix).lt.sxmin) then
+	     sxmin=sx(ix)
+	     ismin=i+1
+         endif
+      ENDDO
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/lmdstd.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/lmdstd.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/lmdstd.h	(revision 2744)
@@ -0,0 +1,31 @@
+c=======================================================================
+c   INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+
+      INTEGER bandmax
+      PARAMETER(bandmax=24)
+
+      COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+     $                gentete,gdatedep,gdatefin
+        
+      CHARACTER*100 gtitre    !du champ
+      CHARACTER*20  gunites   !unites du champ
+      CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+      CHARACTER*100 gfichier  !nom du fichier contenant le champ
+      CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+      CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+      CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+      CHARACTER*20  glistfich !liste de champs a sortir
+
+      COMMON/lmdstdnu/ gminimum,gmaximum,
+     $                 gdeltajour(bandmax),gdeltapas(bandmax),
+     $                 gnbetats(bandmax),gnbfich
+
+      REAL    gminimum        ! \    min et max
+      REAL    gmaximum        ! /    du champ
+      INTEGER gnbfich         ! nombre de fichier a sortir
+c  pour les evolutions temporelles:
+      INTEGER gnbetats        ! nombre d'etats par bande
+      INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+      REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+
+c=======================================================================
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/lnblnk.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/lnblnk.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/lnblnk.F	(revision 2744)
@@ -0,0 +1,36 @@
+      INTEGER FUNCTION lnblnk (letter)
+
+C--------------------------------------------------------
+C Fonction qui determine la longeur d'un string sans les
+C blancs qui suivent. Le critere pour determiner la fin du
+C string est, trois blancs de suite
+C---------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     letter: CHARACTER*xxx (xxx < imax)
+C             le string dont on determine la longuer
+C     lnblnk: INTEGER
+C             le nombre de characteres
+C
+C     PARAMETER
+C     +++++++++
+C     imax : INTEGER
+C            le nombre maximale de character que peut contenir le string
+C            a traiter
+
+      IMPLICIT NONE
+      INTEGER i,imax
+      PARAMETER (imax = 256)
+      CHARACTER(len=*) letter
+
+      i=0
+
+10    i=i+1
+      IF (letter(i:i+3) . EQ . '   ') GOTO 20
+      GOTO 10
+
+20    lnblnk=i-1
+
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxm.F	(revision 2744)
@@ -0,0 +1,34 @@
+       SUBROUTINE MXM(A,NAR,B,NAC,C,NBC)
+c
+c
+c    Multiplication of matrix A by matrix B ,and result in matrix C
+c
+c
+c      NAR : number of   rows  for matrix  A and  matrix  C
+c      NAC : number of columns for matrix  A and number of rows
+c                              for matrix  B
+c      NBC : number of columns for matrix  B and  matrix  C
+c
+c
+       IMPLICIT NONE
+c
+       INTEGER  NAR,NAC,NBC, I,J,K
+       REAL     A(NAR,NAC), B(NAC,NBC), C(NAR,NBC)
+c
+       DO 10 J = 1,NBC
+       DO 10 I = 1,NAR
+       C(I,J)=0.
+10     CONTINUE
+c
+       DO 50 J = 1,NBC
+       DO 40 I = 1,NAR
+
+       DO 20 K = 1,NAC
+       C(I,J)  = C(I,J) + A(I,K) * B(K,J)
+20     CONTINUE
+
+40     CONTINUE
+50     CONTINUE
+
+       RETURN
+       END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxv.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxv.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxv.F	(revision 2744)
@@ -0,0 +1,20 @@
+      SUBROUTINE MXV(A,NRA,B,NCA,C)
+      IMPLICIT NONE
+
+      INTEGER NRA,NCA
+      REAL A(NRA,NCA), B(NCA), C(NRA)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+         C(I) = 0.
+100   CONTINUE
+c     multiply matrix A and vector B
+      DO 220 J = 1, NCA
+         DO 210 I = 1, NRA
+            C(I) = C(I) + A(I,J)*B(J)
+210     CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxva.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxva.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxva.F	(revision 2744)
@@ -0,0 +1,25 @@
+      SUBROUTINE MXVA (SA,IAC,IAR,SB,IB,SC,IC,NRA,NCA)
+      IMPLICIT NONE
+
+      INTEGER IAC,IAR,IB,IC,NRA,NCA
+      REAL SA(*), SB(*), SC(*)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+       SC( 1 + (I-1)*IC ) = 0.
+c      ( C(i) := 0. )
+100   CONTINUE
+c     multiply matrix from sa and vector from sb
+      DO 220 J = 1, NCA
+        DO 210 I = 1, NRA
+          SC( 1 + (I-1)*IC )
+     &      = SC( 1 + (I-1)*IC )
+     &        + SA( 1 + (I-1)*IAC + (J-1)*IAR )
+     &          * SB( 1 + (J-1)*IB )
+c         ( C(i) := C(i) + A(i,j)*B(j) )
+210      CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxva.F_old
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxva.F_old	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mxva.F_old	(revision 2744)
@@ -0,0 +1,25 @@
+      SUBROUTINE MXVA (SA,IAC,IAR,SB,IB,SC,IC,NRA,NCA)
+      IMPLICIT NONE
+
+      INTEGER IAC,IAR,IB,IC,NRA,NCA
+      REAL SA(1), SB(1), SC(1)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+       SC( 1 + (I-1)*IC ) = 0.
+c      ( C(i) := 0. )
+100   CONTINUE
+c     multiply matrix from sa and vector from sb
+      DO 220 J = 1, NCA
+        DO 210 I = 1, NRA
+          SC( 1 + (I-1)*IC )
+     &      = SC( 1 + (I-1)*IC )
+     &        + SA( 1 + (I-1)*IAC + (J-1)*IAR )
+     &          * SB( 1 + (J-1)*IB )
+c         ( C(i) := C(i) + A(i,j)*B(j) )
+210      CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mywrite.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mywrite.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/mywrite.F	(revision 2744)
@@ -0,0 +1,154 @@
+      SUBROUTINE mywrite(champ,icount,titre,unit,format,nom
+     &                  , entete, date0, date, deltpas, nbeta
+     &                  , deltajour, filenum, files)
+C----------------------------------------------------------
+C Subroutine qui ecrit les fichiers dans le format de transfert
+C vers le LMD.
+C format etabli par Zhao-Xin Li, Frederique Hourdin, Emmanuelle Cohen-Solal,
+C Jan Polcher . Il peut etre utilise pour sortire  des evolutions
+C temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+C le character # place devant le format determine la fin de la 
+C description du champ et permet eventulellement de rajouter
+C des informations (avant le #).
+C le programme de lecture lit , dans la description, les variables
+C qu'il connait et saute apres jusquau #. A partir de la
+C il commence a lire le champ dans le format specifie.
+c------------------------------------------------------------
+C       ARGUMENTS
+C       +++++++++
+C champ: REAL (icount)
+C        champ contenant les valeurs et de longeur icount
+C icount: INTEGER
+C         nombre d'element dans le champ
+C titre: CHARACTER*100
+C        nom d'ecrivant le champ
+C unit: CHARACTER*20
+C       unites du champ
+C format: CHARACTER*20
+C         format dans le quel le champ doit etre ecrit.
+C         au choix:
+C                  - tous les format FORTRAN
+C                  - compactage de L.Li (zxliN) ou N peut valoir 1, 2 ou 3
+C nom: CHARACTER*20
+C      nom du fichier dans le quel le champ sera ecris, eventuellement
+C      avec directory (ex: evol/tsol)
+C entete: CHARACTER*100
+C         une entete du fichier pouvant par exemple decrire le run
+C date0: CHARACTER*8
+C        date de depart de la moyenne ou de l'evolution temporelle que contient
+C        le fichier
+C date : CHARACTER*8
+C        date de fin de la moyenne ou de l'evolution temporelle que contient
+C        le fichier
+C deltpas: INTEGER (bandmax)
+C          decript le nombre de pas de temps entre deux sorties pour chamque
+C          bande (necesaire pour les evolutions temporelles)
+C nbeta: INTEGER (bandmax)
+C        donne le nombre d'etas par bande (necesaire pour les evolutions 
+C        temporelles)
+C deltajour: REAL (bandmax)
+C             l'ecart en jours des iscriptions sur chaque bande (necesaire 
+C             pour les evolutions temporelles)
+C filenum: INTEGER
+C          nombre d'elements dans la liste files des champs desires
+C          si filenum = 0 alors tous les champs sont sortis  
+C files: CHARACTER*20 (100)
+C        list des champ que l'on desire sortire
+C
+C        PARAMETER
+C        +++++++++
+C bandmax: INTEGER
+C          le nombre maximale que peut traiter le programme
+C
+
+
+      IMPLICIT NONE
+
+      INTEGER bandmax
+      PARAMETER (bandmax = 24)
+      INTEGER icount,i,imin,imax
+      REAL champ(icount)
+      CHARACTER*100 titre, entete
+      CHARACTER unit*20,nom*80
+      CHARACTER*20 format
+      CHARACTER*8 date0, date
+      INTEGER deltpas(bandmax), nbeta(bandmax)
+      REAL deltajour(bandmax)
+      LOGICAL check, writeornot
+      INTEGER lnblnk,ismin,ismax
+      INTEGER filenum
+      CHARACTER*20 files(100)
+      EXTERNAL lnblnk,ismin,ismax, isitor, to36
+
+      check = .FALSE.
+
+      IF (filenum .EQ. 0) THEN
+        writeornot = .TRUE.
+      ELSE
+        CALL isitor(nom,writeornot,filenum, files)
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'MYWRITE:: writeornot=',writeornot
+      ENDIF
+
+      IF (writeornot) THEN
+      imin = ismin(icount,champ,1)
+      imax = ismax(icount,champ,1)
+      IF (check) THEN
+        WRITE(*,*) entete(1:lnblnk(entete))
+        WRITE(*,*) titre(1:lnblnk(titre))
+        WRITE(*,*) date0
+        WRITE(*,*) date
+        WRITE(*,*) unit(1:lnblnk(unit))
+        WRITE(*,*) deltpas, nbeta
+        WRITE(*,*) deltajour
+        WRITE(*,*) champ(imin),champ(imax)
+        WRITE(*,*) format(1:lnblnk(format))
+        WRITE(*,*) icount
+      ENDIF
+      WRITE(*,*) titre(1:lnblnk(titre)),'min,max:',
+     &           champ(imin),champ(imax),'  ',unit(1:lnblnk(unit))
+      
+      OPEN (unit=55, file=nom(1:lnblnk(nom)))
+      WRITE(55,'(a)') entete(1:lnblnk(entete))
+      WRITE(55,'(a)') titre(1:lnblnk(titre))
+      WRITE(55,'(a)') date0
+      WRITE(55,'(a)') date
+      WRITE(55,'(a)') unit(1:lnblnk(unit))
+      WRITE(55,*) deltpas, nbeta
+      WRITE(55,*) deltajour
+      WRITE(55,*) champ(imin),champ(imax)
+      WRITE(55,'(a)') '#'//format(1:lnblnk(format))
+      WRITE(55,*) icount
+
+      IF (check) THEN
+        WRITE(*,'('//format(1:lnblnk(format))//')') champ(1)
+      ENDIF
+
+      IF (format(1:lnblnk(format)) .EQ. 'zxli1') THEN
+        CALL to36 (champ,icount,champ(imin),champ(imax),55, 1)
+      ELSE 
+        IF (format(1:lnblnk(format)) .EQ. 'zxli2') THEN
+          CALL to36 (champ, icount,champ(imin), champ(imax),55, 2)
+        ELSE
+          IF (format(1:lnblnk(format)) .EQ. 'zxli3') THEN
+            CALL to36 (champ,icount,champ(imin),champ(imax),55, 3)
+          ELSE
+            DO 2233 i=1,icount
+              WRITE(55,'('//format(1:lnblnk(format))//')') 
+     &             champ(i)
+ 2233       CONTINUE
+          ENDIF
+        ENDIF
+      ENDIF
+
+      CLOSE (unit=55)
+
+      ELSE
+        WRITE(*,*) 'FILE    ',nom,'WAS NOT WRITEN'
+      ENDIF
+      
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/readcoord.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/readcoord.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/readcoord.F	(revision 2744)
@@ -0,0 +1,123 @@
+      SUBROUTINE readcoord(imx,jmx,lmx,imax,jmax,lmax,x,y,z,pathcoor)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs Jan Polcher, Frederic Hourdin
+c   -------
+c
+c   Objet   Lecture du fichier contenant des coordonnees x,y et z.
+c   -----
+c
+c   Inteface
+c   --------
+c
+c   Arguments:
+c   ----------
+c
+c   input
+c   -----
+c      imx   \
+c      jmx          dimensions des coordonnees
+c      lmx   /
+c      pathcoor     path absolu pour le fichier des coordonnees
+c                   CHARACTER*80
+c
+c   ouput
+c   -----
+c      imax         nombre de coordonnees x effectives
+c      jmax         nombre de coordonnees y effectives
+c      lmax         nombre de coordonnees z effectives
+c      x(imx)
+c      y(jmx)
+c      z(lmx)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c   arguments:
+c   ----------
+
+      INTEGER imx,jmx,lmx
+      INTEGER imax,jmax,lmax
+
+      REAL x(imx),y(jmx),z(lmx)
+
+      CHARACTER*80 pathcoor
+
+c   local
+c   -----
+
+      INTEGER i,j,l
+
+      CHARACTER*100 filecoor,messerr
+
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      messerr=' '
+      filecoor='coord.def'
+
+c-----------------------------------------------------------------------
+
+100   IF(pathcoor(1:1).EQ.'/') THEN
+         filecoor= pathcoor(:lnblnk(pathcoor))//filecoor
+      ENDIF
+      OPEN (99,file=filecoor,err=200,status='old',form='formatted')
+      GO TO 300
+
+200   WRITE(*,*) messerr
+      WRITE(*,*) 'entrer le nom du fichier des coordonnees puis RETURN'
+      WRITE(*,*) 'ou seulement RETURN pour arreter le programme'
+      READ(*,'(a)') filecoor
+      IF(filecoor(1:1).EQ.' ') STOP
+      CLOSE (99)
+      GOTO 100
+
+300   CONTINUE
+
+      READ(99,*,err=9999) imax
+      IF(imax.GT.imx) THEN
+        WRITE(6,1000) 'x',imx,imax
+        STOP
+      ENDIF
+      READ(99,*) (x(i),i=1,imax)
+
+      READ(99,*,err=9999) jmax
+      IF(jmax.GT.jmx) THEN
+        WRITE(6,1000) 'y',jmx,jmax
+        STOP
+      ENDIF
+      READ(99,*,err=9999) (y(j),j=1,jmax)
+
+      READ(99,*,err=9999) lmax
+      IF(lmax.GT.lmx) THEN
+        WRITE(6,1000) 'z',lmx,lmax
+        STOP
+      ENDIF
+      READ(99,*) (z(l),l=1,lmax)
+
+      CLOSE(99)
+
+c-----------------------------------------------------------------------
+
+      RETURN
+
+9999  PRINT*,'Le fichier ',filecoor,' que vous lisez est mal structure'
+      PRINT*,'Il doit contenir :'
+      PRINT*,'  le nombre de points en x suivi des valeurs de x'
+      PRINT*,'  puis la meme chose pour y et z'
+      STOP
+
+1000  FORMAT(/,
+     $ 'Probleme avec le fichier de coordonnees',/,
+     $ 'Le tableau contenant ',a3,' est dimenssionne a ',i4,/,
+     $ 'et le fichier de coordonnees contient ',i4,' valeurs.')
+
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/readstd.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/readstd.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/readstd.F	(revision 2744)
@@ -0,0 +1,286 @@
+      SUBROUTINE readstd(imx,champ,imax)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:   Jan Polcher, Frederic Hourdin  20/04/91
+c   --------
+c
+c   Objet:
+c   ------
+c
+c Subroutine qui lit les fichiers dans le format lmdstd
+c format etabli par :
+c  Jan Polcher,Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal,
+c Il peut etre utilise pour sortire  des evolutions
+c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+c le character # place devant le format determine la fin de la 
+c description du champ et permet eventulellement de rajouter
+c des informations (avant le #).
+c le programme de lecture lit , dans la description, les variables
+c qu'il connait et saute apres jusquau #. A partir de la
+c il commence a lire le champ dans le format specifie.
+c
+c-----------------------------------------------------------------------
+c
+c   Interface:
+c   ----------
+c
+c   ARGUMENTS
+c   ---------
+c
+c imx  : INTEGER
+c        taille du tableau contenant le champ
+c champ: REAL (imx)
+c        champ contenant les valeurs et de longeur icount
+c imax : INTEGER
+c        nombre d'element dans le champ
+c
+c   COMMON:
+c   -------
+c
+c=======================================================================
+c  INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+c
+c     INTEGER bandmax
+c     PARAMETER(bandmax=24)
+c
+c     COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+c    $                gentete,gdatedep,gdatefin
+c       
+c     CHARACTER*100 gtitre    !du champ
+c     CHARACTER*20  gunites   !unites du champ
+c     CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+c     CHARACTER*100 gfichier  !nom du fichier contenant le champ
+c     CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+c     CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+c     CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+c     CHARACTER*20  glistfich !liste de champs a sortir
+c
+c     COMMON/lmdstdnu/ gminimum,gmaximum,
+c    $                 gdeltajour(bandmax),gdeltapas(bandmax),
+c    $                 gnbetats(bandmax),gnbfich
+c
+c     REAL    gminimum        ! \    min et max
+c     REAL    gmaximum        ! /    du champ
+c     INTEGER gnbfich         ! nombre de fichier a sortir
+c pour les evolutions temporelles:
+c     INTEGER gnbetats        ! nombre d'etats par bande
+c     INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+c     REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "lmdstd.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER imx,imax
+      REAL champ(imx)
+
+c   Local:
+c   ------
+
+      INTEGER i
+
+      CHARACTER*200 test(20)
+      CHARACTER*200 helptest(20)
+      CHARACTER*200 help
+      INTEGER reccount
+
+      LOGICAL check,continue
+
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      check = .FALSE.
+      DO 9876 i=1,20
+        helptest(i) = '        '
+ 9876 CONTINUE
+
+
+c-----------------------------------------------------------------------
+c   lecture le l'entete:
+c   --------------------
+
+ 2222 OPEN (unit=10,file=gfichier(1:lnblnk(gfichier)), form='formatted',
+     &      ERR = 9999, status='old')
+      GOTO 1111
+
+ 9999 WRITE(*,*) 'Je ne peut pas lire le fichier: ',
+     & gfichier(1:lnblnk(gfichier))
+      CLOSE(10)
+      WRITE(*,*) 'Entrez S.V.P. un autre nom de fichier (path absolu) '
+      WRITE(*,*) 'ou RETURN pour stopper lexecution'
+      READ (*,'(a)') gfichier
+      IF(lnblnk(gfichier).EQ.0) STOP
+      GOTO 2222
+
+ 1111 continue = .TRUE.
+      DO 2345 i=1,20
+        IF (continue) THEN
+          READ (10,'(a200)') test(i)
+          IF ( test(i)(1:1) .EQ. '#' .OR. test(i)(1:1) .EQ. 'f10' ) THEN
+            continue = .FALSE.
+            reccount = i
+          ENDIF
+        ENDIF
+ 2345 CONTINUE
+
+      DO 1223 i=1,reccount-1
+        helptest(i) = test(i)
+ 1223 CONTINUE
+      helptest(20) = test(reccount)
+
+
+      IF (check) THEN
+        WRITE(*,*) 'gentete'
+      ENDIF
+      IF ( helptest(1) .NE. ' ' ) THEN
+        read (helptest(1),'(a100)') gentete
+      ELSE
+c       WRITE(*,*) 'la description du run'
+c       READ (*,'(a100)') gentete
+        gentete = '    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'titre'
+      ENDIF
+      IF ( helptest(2) .NE. ' ' ) THEN
+        read (helptest(2),'(a100)') gtitre
+      ELSE
+c       WRITE(*,*) 'le titre du dessin'
+c       READ (*,'(a100)') gtitre 
+        gtitre = '    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'datefins'
+      ENDIF
+      IF ( helptest(3) .NE. ' ' ) THEN
+        read (helptest(3),'(a8)') gdatedep 
+        read (helptest(4),'(a8)') gdatefin
+      ELSE
+c       WRITE(*,*)
+c    &  'datefin du debut de la moyenne (ou le mois tout simplement)'
+c       READ (*,'(a8)') gdatedep 
+c       WRITE(*,*) 'et celle de la fin (ou rien du tout)'
+c       READ (*,'(a8)') gdatefin 
+        gdatedep = '       '
+        gdatefin = '       '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'unitees'
+      ENDIF
+      IF ( helptest(5) .NE. ' ' ) THEN
+        read (helptest(5),'(a20)') gunites
+      ELSE
+c       WRITE(*,*) 'les unitees du champ'
+c       READ (*,'(a20)') gunites
+        gunites = '                    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'deltapas et nbetats'
+      ENDIF
+      IF ( helptest(6) .NE. ' ' ) THEN
+c       READ (helptest(6),*,ERR=1212) 
+c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
+        GOTO 1213
+
+ 1212   help =helptest(6)(1:lnblnk(helptest(6)))//
+     .        helptest(7)(1:lnblnk(helptest(7)))
+        helptest(6) = help
+        IF (check) THEN
+          WRITE(*,*) 'Problems while reading', help
+        ENDIF
+        DO  1214 i=7,reccount
+          helptest(i) = helptest(i+1)
+ 1214   CONTINUE
+c       READ (helptest(6),*,ERR=1212) 
+c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
+
+ 1213   CONTINUE
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'deltajour'
+      ENDIF
+      IF ( helptest(7) .NE. ' ' ) THEN
+c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
+        GOTO 1313
+
+ 1312   help =helptest(7)(1:lnblnk(helptest(7)))//
+     .        helptest(8)(1:lnblnk(helptest(8)))
+        helptest(7) = help
+        IF (check) THEN
+          WRITE(*,*) 'Problems while reading', help
+        ENDIF
+        DO  1314 i=8,reccount
+          helptest(i) = helptest(i+1)
+ 1314   CONTINUE
+c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
+
+ 1313   CONTINUE
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'min et max'
+      ENDIF
+      IF ( helptest(8) .NE. ' ' ) THEN
+c       READ (helptest(8),*)     gminimum,gmaximum
+      ENDIF
+
+      gformat = helptest(20)(2:20)
+
+      IF (check) THEN
+        WRITE(*,*) gentete
+        WRITE(*,*) gtitre
+        WRITE(*,*) gdatedep
+        WRITE(*,*) gdatefin 
+        WRITE(*,*) gdeltapas,gnbetats
+        WRITE(*,*) gdeltajour
+        WRITE(*,*) gminimum,gmaximum
+        WRITE(*,*) gformat
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   lecture du champ proprement dit:
+c   --------------------------------
+
+      READ (10,*)     imax
+   
+      IF(imax.GT.imx) THEN
+         WRITE(*,*) 'Vous essayez de lire un champ dont la taille est'
+         WRITE(*,*) 'superieure a la taille maximum autorisee'
+         WRITE(*,*) 'c est a dire a la dimension du champ utilise'
+         WRITE(*,*) 'pour lappel a la procedure writestd.'
+         STOP
+      ENDIF
+
+      IF (gformat(1:4) .EQ. 'zxli') THEN
+        CALL from36 (champ,imax,10)
+      ELSE 
+         IF (lnblnk(gformat).LE.1.OR.lnblnk(gformat).GE.20) THEN
+            READ(10,*) (champ (i),i=1,imax)
+         ELSE
+            READ(10,'('//gformat(1:lnblnk(gformat))//')')
+     $      (champ (i),i=1,imax)
+         ENDIF
+      ENDIF
+
+      CLOSE (unit=10)
+
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/scatter.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/scatter.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/scatter.F	(revision 2744)
@@ -0,0 +1,21 @@
+       subroutine scatter(n,a,index,b)
+C
+       implicit none
+       integer N,INDEX(n),I
+       real A(n),B(n)
+c
+c
+       DO 100 I=1,N
+          A(INDEX(I))=B(I)
+100    CONTINUE
+c
+       return
+       end 
+c
+c
+c      peut etre vec_scatter(v,rindices,count,r) en f77hp
+c      equivalent code:
+c      do 99 i=1,count
+c99    r(rindices(i))=v(i)
+c      voir p. 11-13
+c
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/scopy.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/scopy.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/scopy.F	(revision 2744)
@@ -0,0 +1,17 @@
+      subroutine scopy(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      real sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+         sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/scopyi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/scopyi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/scopyi.F	(revision 2744)
@@ -0,0 +1,17 @@
+      subroutine scopyi(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      integer sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+      sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/sdot.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/sdot.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/sdot.F	(revision 2744)
@@ -0,0 +1,21 @@
+      FUNCTION sdot (n, x,incx, y,incy)
+      IMPLICIT NONE
+c
+      integer n, incx, incy
+      real sdot
+      real x((n-1)*incx+1), y((n-1)*incy+1)
+c
+      integer i, ix, iy
+c
+      sdot = 0.0
+      ix = 1
+      iy = 1
+c
+      do 10 i = 1, n
+         sdot = sdot + x(ix) * y(iy)
+         ix = ix + incx
+         iy = iy + incy
+   10 continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ssum.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ssum.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/ssum.F	(revision 2744)
@@ -0,0 +1,16 @@
+      function ssum(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,i,ix
+      real ssum,sx((n-1)*incx+1)
+c
+      ssum=0.
+      ix=1
+      do 10 i=1,n
+      ssum=ssum+sx(ix)
+         ix=ix+incx
+10    continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/to36.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/to36.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/to36.F	(revision 2744)
@@ -0,0 +1,84 @@
+      SUBROUTINE to36(x,nbre,xmin,xmax,iunit,icase)
+Ccray IMPLICIT NONE
+      IMPLICIT NONE
+c=======================================================================
+c-- x    : le champ a compacter
+c-- nbre : la taille du champ x
+c-- iunit: numero logique du fichier sortie
+c-- icase: nombre de cases a utiliser (qui determine la precision)
+      INTEGER iunit, nbre, icase
+      REAL x(nbre) 
+c=======================================================================
+      INTEGER ibase, maxnbr, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36, maxnbr=100000)
+      PARAMETER (ifact1 = ibase**1-1)
+      PARAMETER (ifact2 = ibase**2-1)
+      PARAMETER (ifact3 = ibase**3-1)
+c=======================================================================
+      CHARACTER*1 word1(0:ifact1)
+      COMMON /elbat1/ word1
+      CHARACTER*1 chax1(maxnbr)
+c======================================================================
+      CHARACTER*2 word2(0:ifact2)
+      COMMON /elbat2/ word2
+      CHARACTER*2 chax2(maxnbr)
+c======================================================================
+      CHARACTER*3 word3(0:ifact3)
+      COMMON /elbat3/ word3
+      CHARACTER*3 chax3(maxnbr)
+c=====================================================================
+      INTEGER i, inte
+      REAL xmin, xmax
+      EXTERNAL ini36
+c=====================================================================
+c
+c--- initialisation pour le codage
+c la routine ini36 est appelee une seule fois
+c     IF (word1(36) .NE. 'Z' ) THEN
+        CALL ini36
+c     ENDIF
+
+      IF (nbre .GT. maxnbr) THEN
+        PRINT*, 'Nombre elements trop grand', nbre, maxnbr
+        STOP
+      ENDIF
+c
+      WRITE(iunit,*) nbre, ibase, icase, '  (nbre,ibase,icase)'
+      WRITE(iunit,*) xmin
+      WRITE(iunit,*) xmax
+c
+      IF(xmin .EQ. xmax)THEN
+      WRITE(iunit,'(a)')'Ce champ est constant'
+      GO TO 999
+      ENDIF 
+c
+      IF (icase .EQ. 1) THEN
+        DO 10 i = 1, nbre
+          inte = NINT( FLOAT(ifact1)/(xmax-xmin) * (x(i)-xmin) )
+          chax1(i) = word1(inte)
+   10   CONTINUE
+        WRITE(iunit,91) (chax1(i),i=1,nbre)
+      ELSE IF (icase .EQ. 2) THEN
+        DO 20 i = 1, nbre
+          inte = NINT( FLOAT(ifact2)/(xmax-xmin) * (x(i)-xmin) )
+          chax2(i) = word2(inte)
+   20   CONTINUE
+        WRITE(iunit,92) (chax2(i),i=1,nbre)
+      ELSE IF (icase.eq.3) THEN
+        DO 30 i = 1, nbre
+          inte = NINT( FLOAT(ifact3)/(xmax-xmin) * (x(i)-xmin) )
+          chax3(i) = word3(inte)
+   30   CONTINUE
+        WRITE(iunit,93) (chax3(i),i=1,nbre)
+      ELSE
+        PRINT*, 'Verfier icase (1,2,3) dans les arguments de to36'
+        STOP
+      ENDIF
+c
+   91 FORMAT(120a1)
+   92 FORMAT(64a2)
+   93 FORMAT(40a3)
+c
+  999 RETURN
+      END 
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/uniplot.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/uniplot.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/uniplot.F	(revision 2744)
@@ -0,0 +1,74 @@
+      SUBROUTINE uniplot(im,jm,champ)
+      INTEGER isys,system
+      EXTERNAL system
+      INTEGER imx,jmx
+      PARAMETER (imx=400,jmx=200)
+      INTEGER im,jm,i,j,nreg
+      REAL champ(im,jm)
+      REAL xinf,xsup,yinf,ysup
+      REAL xorig,yorig,xlength,ylength,xfac,yfac
+      REAL xreg(1),yreg(1)
+      REAL x(imx),y(jmx)
+      LOGICAL francais,flreg,flgri,fliso
+      REAL txtheight,linewidth,fdismin,flonmin
+      INTEGER ishade,inter_exter
+      CHARACTER*200 txtstr(5)
+
+      xorig=20.
+      yorig=20.
+      xlength=120.
+      ylength=120.
+      xfac=1.
+      yfac=1.
+      xinf=1.
+      xsup=im
+      yinf=1.
+      ysup=jm
+      nreg=1
+      DO i=1,im
+         x(i)=i
+      ENDDO
+      DO j=1,jm
+         y(j)=j
+      ENDDO
+
+      DO i=1,5
+       txtstr(i)=" "
+      ENDDO
+
+      txtstr(2)='i'
+      txtstr(3)='j'
+
+      OPEN(10,file='/tmp2/planetes/tmp.graph',
+     s  status='unknown',form='formatted')
+
+      WRITE(10,*) im,jm,nreg
+      WRITE(10,*) xorig,yorig,xlength,ylength,xfac,yfac,
+     s     xinf,xsup,yinf,ysup
+      WRITE(10,*) (x(i),i=1,im),(y(j),j=1,jm),
+     s     ((champ(i,j),i=1,im),j=1,jm),
+     s     (xreg(i),i=1,nreg),(yreg(j),j=1,nreg)
+
+      francais=.true.
+      flreg=.false.
+      flgri=.false.
+      fliso=.true.
+      txtheight=3.7
+      linewidth=.2
+      fdismin=0.
+      flonmin=0.
+      ishade=3
+      inter_exter=0
+      WRITE(10,*) francais,flreg,flgri,fliso
+      WRITE(10,*) txtheight,linewidth,fdismin,flonmin
+      WRITE(10,*) ishade,inter_exter
+      DO i=1,5
+      WRITE(10,'(a200)') txtstr(i)
+      ENDDO
+      CLOSE(10)
+
+      isys=system(
+     s  'rsh ella " xterm -display $DISPLAY -n controle_graph
+     s   -e /u2/planetes/graph/lance" ' )
+
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/wheneq.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/wheneq.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/wheneq.F	(revision 2744)
@@ -0,0 +1,23 @@
+      SUBROUTINE wheneq(n,x,incx,target,index,nn)
+      IMPLICIT NONE
+c
+      integer n, incx, nn
+      integer index(n)
+c
+      integer target, x((n-1)*incx+1)
+cccccc      real target, x((n-1)*incx+1)
+c
+      integer i, ix
+c
+      ix = 1
+      nn = 0
+      do 10 i = 1, n
+         if (x(ix).EQ.target) then
+            index(i) = ix
+            nn = nn + 1
+         endif
+         ix = ix + incx
+   10 continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/writestd.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/writestd.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/bibio/writestd.F	(revision 2744)
@@ -0,0 +1,201 @@
+      SUBROUTINE writestd(champ,icount)
+
+c=======================================================================
+c
+c   Auteurs:   Jan Polcher, Frederic Hourdin
+c   --------
+c
+c   Objet:
+c   ------
+c
+c Subroutine qui ecrit les fichiers dans le format de transfert
+c vers le LMD.
+c format etabli par :
+c   Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal,
+c   Jan Polcher .
+c Il peut etre utilise pour sortire  des evolutions
+c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+c le character # place devant le format determine la fin de la 
+c description du champ et permet eventulellement de rajouter
+c des informations (avant le #).
+c le programme de lecture lit , dans la description, les variables
+c qu'il connait et saute apres jusquau #. A partir de la
+c il commence a lire le champ dans le format specifie.
+c
+c-----------------------------------------------------------------------
+c
+c   Interface:
+c   ----------
+c
+c   ARGUMENTS
+c   ---------
+c
+c champ: REAL (icount)
+c        champ contenant les valeurs et de longeur icount
+c icount: INTEGER
+c        nombre d'element dans le champ
+c
+c   COMMON:
+c   -------
+c
+c=======================================================================
+c  INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+c
+c     INTEGER bandmax
+c     PARAMETER(bandmax=24)
+c
+c     COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+c    $                gentete,gdatedep,gdatefin
+c       
+c     CHARACTER*100 gtitre    !du champ
+c     CHARACTER*20  gunites   !unites du champ
+c     CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+c     CHARACTER*100 gfichier  !nom du fichier contenant le champ
+c     CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+c     CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+c     CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+c     CHARACTER*20  glistfich !liste de champs a sortir
+c
+c     COMMON/lmdstdnu/ gminimum,gmaximum,
+c    $                 gdeltajour(bandmax),gdeltapas(bandmax),
+c    $                 gnbetats(bandmax),gnbfich
+c
+c     REAL    gminimum        ! \    min et max
+c     REAL    gmaximum        ! /    du champ
+c     INTEGER gnbfich         ! nombre de fichier a sortir
+c pour les evolutions temporelles:
+c     INTEGER gnbetats        ! nombre d'etats par bande
+c     INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+c     REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+      IMPLICIT NONE
+#include "lmdstd.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER icount
+      REAL champ(icount)
+
+c   Local:
+c   ------
+
+      INTEGER i,imin,imax
+      LOGICAL check, writeornot
+      INTEGER lnblnk,ismin,ismax
+      EXTERNAL lnblnk,ismin,ismax, isitor, to36
+
+      INTEGER indexfil
+      COMMON/indexfil/indexfil
+
+c-----------------------------------------------------------------------
+c   verification que le champ est dans la liste predefinie:
+c   -------------------------------------------------------
+
+      check = .FALSE.
+
+      IF (gnbfich .EQ. 0) THEN
+        writeornot = .TRUE.
+      ELSE
+        CALL isitor(gfichier,writeornot,gnbfich, glistfich)
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'MYWRITE:: writeornot=',writeornot
+      ENDIF
+
+c-----------------------------------------------------------------------
+      IF (writeornot) THEN
+c-----------------------------------------------------------------------
+
+      imin = ismin(icount,champ,1)
+      imax = ismax(icount,champ,1)
+      IF (check) THEN
+        WRITE(*,*) gentete(1:lnblnk(gentete))
+        WRITE(*,*) gtitre(1:lnblnk(gtitre))
+        WRITE(*,*) gdatedep
+        WRITE(*,*) gdatefin
+        WRITE(*,*) gunites(1:lnblnk(gunites))
+        WRITE(*,*) gdeltapas, gnbetats
+        WRITE(*,*) gdeltajour
+        WRITE(*,*) champ(imin),champ(imax)
+        WRITE(*,*) gformat(1:lnblnk(gformat))
+        WRITE(*,*) icount
+      ENDIF
+      WRITE(*,*) gtitre(1:lnblnk(gtitre)),'min,max:',
+     &  champ(imin),champ(imax),'  ',gunites(1:lnblnk(gunites))
+      
+c-----------------------------------------------------------------------
+c   creation eventuelle d'un nom pour le fichier d'ecriture du champ:
+c   -----------------------------------------------------------------
+
+      IF(lnblnk(gfichier).LT.1.OR.lnblnk(gfichier).GE.100) THEN
+         gfichier(1:5)='champ'
+         IF(indexfil.LT.1) indexfil=49
+         gfichier(6:6)=char(indexfil)
+	 indexfil=indexfil+1
+	 PRINT*,'nom du fichier  ',gfichier
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   ecriture sur le fichier de sorties:
+c   -----------------------------------
+
+      OPEN (unit=55, file=gfichier(1:lnblnk(gfichier)))
+      WRITE(55,'(a)') gentete(1:lnblnk(gentete))
+      WRITE(55,'(a)') gtitre(1:lnblnk(gtitre))
+      WRITE(55,'(a)') gdatedep
+      WRITE(55,'(a)') gdatefin
+      WRITE(55,'(a)') gunites(1:lnblnk(gunites))
+      WRITE(55,*) gdeltapas, gnbetats
+      WRITE(55,*) gdeltajour
+      WRITE(55,*) champ(imin),champ(imax)
+      WRITE(55,'(a)') '#'//gformat(1:lnblnk(gformat))
+      WRITE(55,*) icount
+
+      IF (check) THEN
+        WRITE(*,'('//gformat(1:lnblnk(gformat))//')') champ(1)
+      ENDIF
+
+      IF (lnblnk(gformat).LE.1.OR.lnblnk(gformat).GE.20) THEN
+         DO 2230 i=1,icount
+            WRITE(55,*) champ(i)
+2230     CONTINUE
+      ELSE
+         IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli1') THEN
+            CALL to36 (champ,icount,champ(imin),champ(imax),55, 1)
+         ELSE 
+            IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli2') THEN
+               CALL to36(champ,icount,champ(imin),champ(imax),55,2)
+            ELSE
+               IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli3') THEN
+cc****WRF ligne trop longue
+            CALL to36(champ,icount,champ(imin),champ(imax),55,3)
+               ELSE
+                  WRITE(55,'('//gformat(1:lnblnk(gformat))//')') 
+     &            (champ(i),i=1,icount)
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CLOSE (unit=55)
+
+      gfichier=' '
+
+c-----------------------------------------------------------------------
+c   si on ecrit pas le champ (writeornot.EQ..f.):
+c   ---------------------------------------------
+
+      ELSE
+        WRITE(*,*) 'FILE    ',gfichier,'WAS NOT WRITEN'
+      ENDIF
+      
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate1	(revision 2744)
@@ -0,0 +1,19 @@
+#\rm aeronomars/d2_*
+#\rm bibio/d2_*
+#\rm phymars/d2_*
+#\rm grid/d2_*
+#\rm dyn3d/d2_*
+
+#\rm aeronomars/d3_*
+#\rm bibio/d3_*
+#\rm phymars/d3_*
+#\rm grid/d3_*
+#\rm dyn3d/d3_*
+
+\rm aeronomars/d?_*
+\rm bibio/d?_*
+\rm phymars/d?_*
+\rm grid/d?_*
+\rm dyn3d/d?_*
+
+# this may be used for cleaning purpose as well
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate2	(revision 2744)
@@ -0,0 +1,49 @@
+#!/bin/bash
+
+./duplicate1
+
+echo 'duplicate sources for domain 2'
+
+### deja fait dans duplicate1
+#\rm aeronomars/d2_*
+#\rm bibio/d2_*
+#\rm phymars/d2_*
+#\rm grid/d2_*
+#\rm dyn3d/d2_*
+
+
+cd aeronomars
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+cd bibio
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+cd phymars
+cp ../generate2 .
+find *.F -exec generate2 {} \;
+find *.h -exec generate2 {} \;
+find *.F90 -exec generate2 {} \;
+find *.inc -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+cd grid
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+\rm d2_dimension
+cd ..
+
+cd dyn3d
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+  
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate3
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate3	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate3	(revision 2744)
@@ -0,0 +1,61 @@
+#!/bin/bash
+
+./duplicate2
+
+echo 'duplicate sources for domain 3'
+
+### deja fait dans duplicate1
+#\rm aeronomars/d3_*
+#\rm bibio/d3_*
+#\rm phymars/d3_*
+#\rm grid/d3_*
+#\rm dyn3d/d3_*
+
+
+cd aeronomars
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+cd bibio
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+cd phymars
+cp ../generate3 .
+find *.F -exec generate3 {} \;
+find *.h -exec generate3 {} \;
+find *.F90 -exec generate3 {} \;
+find *.inc -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+cd grid
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+\rm d3_dimension
+cd ..
+
+cd dyn3d
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+\rm aeronomars/d3_d2*
+\rm bibio/d3_d2*
+\rm phymars/d3_d2*
+\rm grid/d3_d2*
+\rm dyn3d/d3_d2*
+
+\rm aeronomars/d2_d3*
+\rm bibio/d2_d3*
+\rm phymars/d2_d3*
+\rm grid/d2_d3*
+\rm dyn3d/d2_d3*
+
+  
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate4
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate4	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate4	(revision 2744)
@@ -0,0 +1,73 @@
+#!/bin/bash
+
+./duplicate3  
+
+echo 'duplicate sources for domain 4'
+
+### deja fait dans duplicate1
+#\rm aeronomars/d4_*
+#\rm bibio/d4_*
+#\rm phymars/d4_*
+#\rm grid/d4_*
+#\rm dyn3d/d4_*
+
+
+cd aeronomars
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+cd bibio
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+cd phymars
+cp ../generate4 .
+find *.F -exec generate4 {} \;
+find *.h -exec generate4 {} \;
+find *.F90 -exec generate4 {} \;
+find *.inc -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+cd grid
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+\rm d4_dimension
+cd ..
+
+cd dyn3d
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+\rm aeronomars/d4_d3*
+\rm bibio/d4_d3*
+\rm phymars/d4_d3*
+\rm grid/d4_d3*
+\rm dyn3d/d4_d3*
+
+\rm aeronomars/d3_d4*
+\rm bibio/d3_d4*
+\rm phymars/d3_d4*
+\rm grid/d3_d4*
+\rm dyn3d/d3_d4*
+
+\rm aeronomars/d4_d2*
+\rm bibio/d4_d2*
+\rm phymars/d4_d2*
+\rm grid/d4_d2*
+\rm dyn3d/d4_d2*
+
+\rm aeronomars/d2_d4*
+\rm bibio/d2_d4*
+\rm phymars/d2_d4*
+\rm grid/d2_d4*
+\rm dyn3d/d2_d4*
+
+  
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate5
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate5	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/duplicate5	(revision 2744)
@@ -0,0 +1,76 @@
+#!/bin/bash
+
+./duplicate4  
+
+echo 'duplicate sources for domain 5'
+
+cd aeronomars
+cp ../generate5 .
+find * -exec generate5 {} \;
+\rm *generate5
+cd ..
+
+cd bibio
+cp ../generate5 .
+find * -exec generate5 {} \;
+\rm *generate5
+cd ..
+
+cd phymars
+cp ../generate5 .
+find *.F -exec generate5 {} \;
+find *.h -exec generate5 {} \;
+find *.F90 -exec generate5 {} \;
+find *.inc -exec generate5 {} \;
+\rm *generate5
+cd ..
+
+cd grid
+cp ../generate5 .
+find * -exec generate5 {} \;
+\rm *generate5
+\rm d5_dimension
+cd ..
+
+cd dyn3d
+cp ../generate5 .
+find * -exec generate5 {} \;
+\rm *generate5
+cd ..
+
+\rm aeronomars/d5_d4*
+\rm bibio/d5_d4*
+\rm phymars/d5_d4*
+\rm grid/d5_d4*
+\rm dyn3d/d5_d4*
+
+\rm aeronomars/d4_d5*
+\rm bibio/d4_d5*
+\rm phymars/d4_d5*
+\rm grid/d4_d5*
+\rm dyn3d/d4_d5*
+
+\rm aeronomars/d5_d3*
+\rm bibio/d5_d3*
+\rm phymars/d5_d3*
+\rm grid/d5_d3*
+\rm dyn3d/d5_d3*
+
+\rm aeronomars/d3_d5*
+\rm bibio/d3_d5*
+\rm phymars/d3_d5*
+\rm grid/d3_d5*
+\rm dyn3d/d3_d5*
+
+\rm aeronomars/d5_d2*
+\rm bibio/d5_d2*
+\rm phymars/d5_d2*
+\rm grid/d5_d2*
+\rm dyn3d/d5_d2*
+
+\rm aeronomars/d2_d5*
+\rm bibio/d2_d5*
+\rm phymars/d2_d5*
+\rm grid/d2_d5*
+\rm dyn3d/d2_d5*
+  
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/angtot.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/angtot.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/angtot.h	(revision 2744)
@@ -0,0 +1,8 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'angtot.h
+
+      COMMON/angtot/dangdyn,dangm1,dangdis,dangdif
+
+      REAL dangdyn,dangm1,dangdis,dangdif
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/clesph0.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/clesph0.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/clesph0.h	(revision 2744)
@@ -0,0 +1,8 @@
+c..include clesph0.h
+c
+       COMMON/clesph0/cycle_diurne, soil_model,new_oliq, ok_orodr ,
+     ,                ok_orolf ,ok_limitvrai, nbapp_rad, iflag_con
+c
+       LOGICAL cycle_diurne,soil_model,ok_orodr,ok_orolf,new_oliq
+       LOGICAL ok_limitvrai
+       INTEGER nbapp_rad, iflag_con
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comav.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comav.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comav.h	(revision 2744)
@@ -0,0 +1,3 @@
+      COMMON/comav/period_av,time0_av
+      REAL period_av ! periode de stockage en jour
+      REAL time0_av  ! date initiale de stokage en jour
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comconst.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comconst.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comconst.h	(revision 2744)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+! INCLUDE comconst.h
+
+      COMMON/comconst/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,
+     * dtvr,daysec,
+     * pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg
+
+      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
+      REAL dtvr,daysec
+      REAL pi,dtphys,dtdiss,rad,r,cpp,kappa
+      REAL cotot,unsim,g,omeg
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdiss.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdiss.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdiss.h	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'comdiss.h'
+
+      INTEGER niter
+      REAL tetau(llm),tetah(llm),cdivu,cdivh,crot
+      LOGICAL dissipst
+
+      COMMON/comdissi/niter
+      COMMON/comdissr/tetau,tetah,cdivu,cdivh,crot
+      COMMON/comdissl/dissipst
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdissip.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdissip.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdissip.h	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE dissip.h
+
+      COMMON/comdissip/
+     $    niterdis,coefdis,tetavel,tetatemp,gamdissip
+
+
+      INTEGER niterdis
+
+      REAL tetavel,tetatemp,coefdis,gamdissip
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdissipn.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdissipn.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdissipn.h	(revision 2744)
@@ -0,0 +1,13 @@
+c-----------------------------------------------------------------------
+c INCLUDE comdissipn.h
+
+      REAL  tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
+c
+      COMMON/comdissipn/ tetaudiv(llm),tetaurot(llm),tetah(llm)   ,
+     1                        cdivu,      crot,         cdivh
+
+c
+c    Les parametres de ce common proviennent des calculs effectues dans 
+c             Inidissip  .
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdissnew.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdissnew.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comdissnew.h	(revision 2744)
@@ -0,0 +1,18 @@
+c-----------------------------------------------------------------------
+c INCLUDE comdissnew.h
+
+
+c****WRF: attention ligne trop longue
+
+      COMMON/comdissnew/ lstardis,nitergdiv,nitergrot,niterh,
+     1                   tetagdiv,tetagrot,tetatemp,coefdis 
+
+      LOGICAL lstardis
+      INTEGER nitergdiv, nitergrot, niterh
+      REAL     tetagdiv, tetagrot,  tetatemp, coefdis
+
+c
+c ... Les parametres de ce common comdissnew sont  lues par defrun_new 
+c              sur le fichier  run.def    ....
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comgeom.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comgeom.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comgeom.h	(revision 2744)
@@ -0,0 +1,29 @@
+!CDK comgeom
+      COMMON/comgeom/
+     .cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),
+     .aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),
+     .airev(ip1jm),unsaire(ip1jmp1),apoln,apols,
+     .unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),
+     .aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),
+     .aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),
+     .alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),
+     .alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),
+     .fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),
+     .rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),
+     .cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),
+     .cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),
+     .cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),
+     .unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,
+     .unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),
+     .aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
+
+      REAL :: 
+     .cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,
+     .apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,
+     .alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,
+     .fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,
+     .cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2,
+     .unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,
+     .aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu,
+     .xprimv
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comgeom2.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comgeom2.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comgeom2.h	(revision 2744)
@@ -0,0 +1,31 @@
+*CDK comgeom2
+      COMMON/comgeom/
+     1 cu(iip1,jjp1),cv(iip1,jjm),unscu2(iip1,jjp1),unscv2(iip1,jjm)  ,
+     2 aire(iip1,jjp1),airesurg(iip1,jjp1),aireu(iip1,jjp1)           ,
+     3 airev(iip1,jjm),unsaire(iip1,jjp1),apoln,apols                 ,  
+     4 unsairez(iip1,jjm),airuscv2(iip1,jjm),airvscu2(iip1,jjm)       ,
+     5 aireij1(iip1,jjp1),aireij2(iip1,jjp1),aireij3(iip1,jjp1)       ,
+     6 aireij4(iip1,jjp1),alpha1(iip1,jjp1),alpha2(iip1,jjp1)         ,
+     7 alpha3(iip1,jjp1),alpha4(iip1,jjp1),alpha1p2(iip1,jjp1)        ,
+     8 alpha1p4(iip1,jjp1),alpha2p3(iip1,jjp1),alpha3p4(iip1,jjp1)    ,
+     9 fext(iip1,jjm),constang(iip1,jjp1), rlatu(jjp1),rlatv(jjm),
+     1 rlonu(iip1),rlonv(iip1),cuvsurcv(iip1,jjm),cvsurcuv(iip1,jjm)  ,
+     1 cvusurcu(iip1,jjp1),cusurcvu(iip1,jjp1)                        ,
+     2 cuvscvgam1(iip1,jjm),cuvscvgam2(iip1,jjm),cvuscugam1(iip1,jjp1),
+     3 cvuscugam2(iip1,jjp1),cvscuvgam(iip1,jjm),cuscvugam(iip1,jjp1) ,
+     4 unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2                ,
+     5 unsair_gam1(iip1,jjp1),unsair_gam2(iip1,jjp1)                  ,
+     6 unsairz_gam(iip1,jjm),aivscu2gam(iip1,jjm),aiuscv2gam(iip1,jjm)
+     7 , xprimu(iip1),xprimv(iip1)
+
+c
+      REAL 
+     1 cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,apoln,apols,unsaire
+     2 ,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4     ,
+     3 alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,
+     4 fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,
+     5 cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1           , 
+     6 unsapolnga2,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2     ,
+     7 unsairz_gam,aivscu2gam,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu    ,
+     8 cusurcvu,xprimu,xprimv
+c
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comvert.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comvert.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/comvert.h	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'comvert.h'
+
+      COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm) ,
+     .               pa,preff,nivsigs(llm),nivsig(llm+1),
+     .               sig(llm+1),ds(llm),aps(llm),bps(llm),pseudoalt(llm)
+
+      REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig
+c Mars Ce qui suit vient de gcm
+      REAL sig,ds,aps,bps,pseudoalt
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/control.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/control.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/control.h	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'control.h'
+
+      COMMON/control/nday,day_step,
+     $              iperiod,iconser,idissip,iphysiq ,
+     $              periodav,ecritphy,anneeref
+
+      INTEGER   nday,day_step,iperiod,iconser,
+     $          idissip,iphysiq,anneeref
+      REAL periodav, ecritphy
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/description.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/description.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/description.h	(revision 2744)
@@ -0,0 +1,2 @@
+      character *120 descript
+      common /titre/descript
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/ener.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/ener.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/ener.h	(revision 2744)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'ener.h'
+
+      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,
+     *            ang,etot,ptot,ztot,stot,rmsdpdt ,
+     *            rmsv,gtot(llmm1)
+
+      REAL ang0,etot0,ptot0,ztot0,stot0,
+     s     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/gradsdef.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/gradsdef.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/gradsdef.h	(revision 2744)
@@ -0,0 +1,20 @@
+      integer nfmx,imx,jmx,lmx,nf,nvarmx
+      parameter(nfmx=10,imx=200,jmx=150,lmx=20,nvarmx=1000)
+
+      real xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx)
+
+      integer imd(imx),jmd(jmx),lmd(lmx)
+      integer iid(imx),jid(jmx)
+      integer ifd(imx),jfd(jmx)
+      integer unit(nfmx),irec(nfmx),itime(nfmx),nld(nvarmx,nfmx)
+
+      integer nvar(nfmx),ivar(nfmx)
+      logical firsttime(nfmx)
+
+      character*10 var(nvarmx,nfmx),fichier(nfmx)
+      character*40 title(nfmx),tvar(nvarmx,nfmx)
+
+      common/gradsdef/xd,yd,zd,dtime,
+     s   imd,jmd,lmd,iid,jid,ifd,jfd,
+     s   unit,irec,nvar,ivar,nf,itime,nld,firsttime,
+     s   var,fichier,title,tvar
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/logic.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/logic.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/logic.h	(revision 2744)
@@ -0,0 +1,10 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'logic.h'
+
+      COMMON/logic/ purmats,physic,forward,leapf,apphys,grireg,
+     *  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+
+      LOGICAL purmats,physic,forward,leapf,apphys,grireg,statcl,conser,
+     * apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/para_netcdf.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/para_netcdf.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/para_netcdf.h	(revision 2744)
@@ -0,0 +1,10 @@
+c
+      INTEGER lons ,lats,levs
+      PARAMETER (lons = 320, lats = 161, levs = 17)
+c
+c     *******    a  changer  eventuellement   ********`
+c
+c  *** Ces valeurs de lons et de lats correspondent a une grille 1.125 x1.125
+c                  du fichier d'entree en Netcdf     ******
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/paramet.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/paramet.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/paramet.h	(revision 2744)
@@ -0,0 +1,19 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'paramet.h'
+
+      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
+      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
+      INTEGER  ijmllm,mvar
+      INTEGER jcfil,jcfllm
+
+      PARAMETER( iip1= iim+1-1/iim,iip2=iim+2,iip3=iim+3)
+      PARAMETER( jjp1=jjm+1-1/jjm)
+      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
+      PARAMETER( kftd  = iim/2 -ndm )
+      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
+      PARAMETER( ip1jmi1= ip1jm - iip1 )
+      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
+      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
+      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/serre.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/serre.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/serre.h	(revision 2744)
@@ -0,0 +1,6 @@
+c..include serre.h
+c
+       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
+     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo , 
+     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/sponge.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/sponge.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/sponge.h	(revision 2744)
@@ -0,0 +1,9 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'sponge.h'
+
+      COMMON/com_sponge/callsponge,mode_sponge,hsponge,tetasponge
+
+      LOGICAL   callsponge
+      INTEGER   mode_sponge
+      REAL   hsponge,tetasponge
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/temps.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/temps.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/temps.h	(revision 2744)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'temps.h'
+
+      COMMON/temps/itaufin,dt,
+     s  day_ini,day_end,anne_ini
+
+      INTEGER  itaufin
+      INTEGER*4 day_ini,day_end,anne_ini
+      REAL     dt
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/tracstoke.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/tracstoke.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/dyn3d/tracstoke.h	(revision 2744)
@@ -0,0 +1,2 @@
+      common /tracstoke/istdyn,istphy,unittrac
+      integer istdyn,istphy,unittrac
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate2	(revision 2744)
@@ -0,0 +1,7 @@
+#script
+# execute: find * -exec generate2 {} \;
+# change number sed -e s/d2/d3/g generate2 > generate3
+
+sed -e s/'[cC][aA][lL][lL] '/'call d2_'/g ${1} | sed -e s/'call d2_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d2_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d2_'/'firstcall '/g | sed -e s/'lastcall d2_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d2_'/g | sed -e s/'callphys.def'/'callphysd2_.def '/g | sed -e s/'diagfi.nc'/'diagfid2_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d2_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd2_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d2_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d2_"+g | sed -e s+"d2_netcdf.inc"+"netcdf.inc"+g | sed -e s+"isitice"+"d2_isitice"+g | sed -e s+"nplatcrocus"+"d2_nplatcrocus"+g | sed -e s+"splatcrocus"+"d2_splatcrocus"+g > d2_${1} 
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate3
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate3	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate3	(revision 2744)
@@ -0,0 +1,7 @@
+#script
+# execute: find * -exec generate_d3 {} \;
+# change number sed -e s/d3/d3/g generate_d3 > generated3
+
+sed -e s/'[cC][aA][lL][lL] '/'call d3_'/g ${1} | sed -e s/'call d3_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d3_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d3_'/'firstcall '/g | sed -e s/'lastcall d3_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d3_'/g | sed -e s/'callphys.def'/'callphysd3_.def '/g | sed -e s/'diagfi.nc'/'diagfid3_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d3_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd3_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d3_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d3_"+g | sed -e s+"d3_netcdf.inc"+"netcdf.inc"+g | sed -e s+"isitice"+"d3_isitice"+g | sed -e s+"nplatcrocus"+"d3_nplatcrocus"+g | sed -e s+"splatcrocus"+"d3_splatcrocus"+g > d3_${1} 
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate4
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate4	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate4	(revision 2744)
@@ -0,0 +1,7 @@
+#script
+# execute: find * -exec generate_d4 {} \;
+# change number sed -e s/d4/d4/g generate_d4 > generated4
+
+sed -e s/'[cC][aA][lL][lL] '/'call d4_'/g ${1} | sed -e s/'call d4_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d4_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d4_'/'firstcall '/g | sed -e s/'lastcall d4_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d4_'/g | sed -e s/'callphys.def'/'callphysd4_.def '/g | sed -e s/'diagfi.nc'/'diagfid4_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d4_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd4_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d4_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d4_"+g | sed -e s+"d4_netcdf.inc"+"netcdf.inc"+g | sed -e s+"isitice"+"d4_isitice"+g | sed -e s+"nplatcrocus"+"d4_nplatcrocus"+g | sed -e s+"splatcrocus"+"d4_splatcrocus"+g > d4_${1} 
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate5
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate5	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/generate5	(revision 2744)
@@ -0,0 +1,7 @@
+#script
+# execute: find * -exec generate2 {} \;
+# change number sed -e s/d5/d3/g generate2 > generate3
+
+sed -e s/'[cC][aA][lL][lL] '/'call d5_'/g ${1} | sed -e s/'call d5_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d5_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d5_'/'firstcall '/g | sed -e s/'lastcall d5_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d5_'/g | sed -e s/'callphys.def'/'callphysd5_.def '/g | sed -e s/'diagfi.nc'/'diagfid5_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d5_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd5_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d5_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d5_"+g | sed -e s+"d5_netcdf.inc"+"netcdf.inc"+g | sed -e s+"isitice"+"d5_isitice"+g | sed -e s+"nplatcrocus"+"d5_nplatcrocus"+g | sed -e s+"splatcrocus"+"d5_splatcrocus"+g > d5_${1} 
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.1.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.1.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.1.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=1
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.10.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.10.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.10.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=10
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.100.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.100.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.100.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=100
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.12.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.12.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.12.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=12
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.144.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.144.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.144.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=144
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.149.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.149.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.149.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=149
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.150.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.150.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.150.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=150
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.180.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.180.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.180.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=180
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.190.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.190.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.190.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=190
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.200.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.200.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.200.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=200
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.24.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.24.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.24.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=24
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.24.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.24.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.24.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=24
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.25.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.25.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.25.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.25.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.25.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.25.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.26.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.26.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.26.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=26
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.29.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.29.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.29.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=29
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.3.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.3.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.3.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=3
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.30.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.30.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.30.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=30
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.30.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.30.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.30.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=30
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.34.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.34.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.34.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=34
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.39.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.39.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.39.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=39
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.44.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.44.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.44.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=44
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.49.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.49.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.49.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=49
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.50.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.50.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.50.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.50.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.50.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.50.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.51.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.51.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.51.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=51
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.59.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.59.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.59.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=59
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.60.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.60.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.60.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.60.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.60.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.60.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.61.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.61.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.61.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=61
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.61.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.61.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.61.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=61
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.64.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.64.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.64.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=64
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.69.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.69.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.69.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=69
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.70.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.70.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.70.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=70
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.71.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.71.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.71.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=71
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.73.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.73.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.73.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=73
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.74.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.74.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.74.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=74
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.99.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.99.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/dimensions.99.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=99
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/makdim
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/makdim	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/dimension/makdim	(revision 2744)
@@ -0,0 +1,66 @@
+nqmx=$1
+shift
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions${list}.t${nqmx}
+
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+ if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+   n2=$1
+   ndm=1
+
+#  while [ "$n2" -gt 2 ]; do
+#      n2=`expr $n2 / 2`
+#     ndm=`expr $ndm + 1`
+#   done
+#   if [ "$n2" != 2 ] ; then
+#      echo le nombre de longitude doit etre une puissance de 2
+#      exit
+#   fi
+
+ else if [ $# -ge 2 ] ; then
+      im=1
+       jm=$1
+      lm=$2
+      ndm=1
+ else if [ $# -ge 1 ] ; then
+         im=1
+         jm=1
+         lm=$1
+         ndm=1
+ else
+         echo il faut au moins une dimension
+         exit
+ fi
+fi
+fi
+
+cat << EOF > $fichdim
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= $im
+      INTEGER, parameter :: jjm=$jm
+      INTEGER, parameter :: llm=$lm
+      INTEGER, parameter :: ndm=$ndm
+
+      integer, parameter :: nqmx=$nqmx
+
+!-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxy_new.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxy_new.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxy_new.h	(revision 2744)
@@ -0,0 +1,21 @@
+c--------------------------------------------------------------
+         REAL ripx
+         REAL fx,fxprim,fy,fyprim,ri,rj,bigy
+c
+c....stretching in x...
+c
+        ripx(  ri )= (ri-1.0) *2.*pi/FLOAT(iim) 
+        fx  (  ri )= ripx(ri) + transx  +
+     *         alphax * SIN( ripx(ri)+transx-pxo ) - pi
+        fxprim(ri) = 2.*pi/FLOAT(iim)  *
+     *        ( 1.+ alphax * COS( ripx(ri)+transx-pxo ) )
+
+c....stretching in y...
+c
+        bigy(rj)   = 2.* (FLOAT(jjp1)-rj) *pi/jjm
+        fy(rj)     =  ( bigy(rj) + transy  +
+     *        alphay * SIN( bigy(rj)+transy-pyo ) ) /2.  - pi/2.
+        fyprim(rj) = ( pi/jjm ) * ( 1.+
+     *           alphay * COS( bigy(rj)+transy-pyo ) )
+
+c--------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxy_reg.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxy_reg.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxy_reg.h	(revision 2744)
@@ -0,0 +1,42 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'fxyprim.h'
+c
+c    ................................................................
+c    ................  Fonctions in line  ...........................
+c    ................................................................
+c
+      REAL  fy, fx, fxprim, fyprim
+      REAL  ri, rj
+c
+c
+      fy    ( rj ) =    pi/FLOAT(jjm) * ( 0.5 * FLOAT(jjm) +  1. - rj  )
+      fyprim( rj ) =    pi/FLOAT(jjm)
+
+c     fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+c     fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
+
+      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/FLOAT(iim)
+c
+c
+c    La valeur de pi est passee par le common/const/ou /const2/ .
+c    Sinon, il faut la calculer avant d'appeler ces fonctions .
+c
+c   ----------------------------------------------------------------
+c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
+c   -----------------------------------------------------------------
+c
+c    .....  ici, on a l'application particuliere suivante   ........
+c
+c                **************************************
+c                **     x = 2. * pi/iim *  X         **
+c                **     y =      pi/jjm *  Y         **
+c                **************************************
+c
+c   ..................................................................
+c   ..................................................................
+c
+c
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxy_sin.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxy_sin.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxy_sin.h	(revision 2744)
@@ -0,0 +1,39 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'fxyprim.h'
+c
+c    ................................................................
+c    ................  Fonctions in line  ...........................
+c    ................................................................
+c
+      REAL  fy, fx, fxprim, fyprim
+      REAL  ri, rj
+c
+c
+      fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+      fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
+
+      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/FLOAT(iim)
+c
+c
+c    La valeur de pi est passee par le common/const/ou /const2/ .
+c    Sinon, il faut la calculer avant d'appeler ces fonctions .
+c
+c   ----------------------------------------------------------------
+c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
+c   -----------------------------------------------------------------
+c
+c    .....  ici, on a l'application particuliere suivante   ........
+c
+c                **************************************
+c                **     x = 2. * pi/iim *  X         **
+c                **     y =      pi/jjm *  Y         **
+c                **************************************
+c
+c   ..................................................................
+c   ..................................................................
+c
+c
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxyprim.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxyprim.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/grid/fxyprim.h	(revision 2744)
@@ -0,0 +1,42 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'fxyprim.h'
+c
+c    ................................................................
+c    ................  Fonctions in line  ...........................
+c    ................................................................
+c
+      REAL  fy, fx, fxprim, fyprim
+      REAL  ri, rj
+c
+c
+      fy    ( rj ) =    pi/FLOAT(jjm) * ( 0.5 * FLOAT(jjm) +  1. - rj  )
+      fyprim( rj ) =    pi/FLOAT(jjm)
+
+c     fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+c     fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
+
+      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/FLOAT(iim)
+c
+c
+c    La valeur de pi est passee par le common/const/ou /const2/ .
+c    Sinon, il faut la calculer avant d'appeler ces fonctions .
+c
+c   ----------------------------------------------------------------
+c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
+c   -----------------------------------------------------------------
+c
+c    .....  ici, on a l'application particuliere suivante   ........
+c
+c                **************************************
+c                **     x = 2. * pi/iim *  X         **
+c                **     y =      pi/jjm *  Y         **
+c                **************************************
+c
+c   ..................................................................
+c   ..................................................................
+c
+c
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/must_keep
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/must_keep	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/must_keep	(revision 2744)
@@ -0,0 +1,3 @@
+*.h in dyn3d
+*.h in grid
+makdim in grid/dimension
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerave.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerave.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerave.F	(revision 2744)
@@ -0,0 +1,189 @@
+      SUBROUTINE aerave ( ndata,
+     & longdata,epdata,omegdata,gdata,          
+     &            longref,epref,temp,nir,longir
+     &            ,epir,omegir,gir                      )
+      IMPLICIT NONE
+c.......................................................................
+c
+c R.Fournier 02/1996 
+c (modif F.Forget 02/1996)
+c le spectre est decoupe en "nir" bandes et cette routine calcule
+c les donnees radiatives moyenne sur chaque bande : l'optimisation
+c est faite pour une temperature au sol "temp" et une epaisseur
+c optique de l'atmosphere "epref" a la longueur d'onde "longref"
+c
+c dans la version actuelle, les ponderations sont independantes de
+c l'epaisseur optique : c'est a dire que "omegir", "gir"
+c et "epir/epre" sont independants de "epref".
+c en effet les ponderations sont choisies pour une solution exacte
+c en couche mince et milieu isotherme. 
+c
+c entree
+c
+c    ndata : taille des champs data
+c    longdata,epdata,omegdata,gdata : proprietes radiative de l'aerosol
+c                  (longdata longueur d'onde en METRES)
+c  * longref : longueur d'onde a laquelle l'epaisseur optique
+c              est connue
+c  * epref : epaisseur optique a longref
+c  * temp : temperature choisie pour la ponderation (Planck)
+c  * nir : nombre d'intervals dans la discretisation spectrale
+c           du GCM
+c  * longir : longueurs d'onde definissant ces intervals
+c
+c sortie
+c
+c  * epir : epaisseur optique moyenne pour chaque interval
+c  * omegir : "scattering albedo" moyen pour chaque interval
+c  * gir : "assymetry factor" moyen pour chaque interval
+c
+c.......................................................................
+c
+      REAL longref
+      REAL epref
+      REAL temp
+      INTEGER nir
+      REAL longir(nir+1)
+      REAL epir(nir)
+      REAL omegir(nir)
+      REAL gir(nir)
+c
+c.......................................................................
+c
+      INTEGER iir,nirmx
+      PARAMETER (nirmx=100)
+      INTEGER idata,ndata
+c
+c.......................................................................
+c
+      REAL emit
+      REAL totalemit(nirmx)
+      REAL longdata(ndata),epdata(ndata)
+     &    ,omegdata(ndata),gdata(ndata)
+      INTEGER ibande,nbande
+      PARAMETER (nbande=1000)
+      REAL long,deltalong
+      INTEGER ilong
+      INTEGER i1,i2
+      REAL c1,c2
+      REAL factep,ep,omeg,g
+c
+c.......................................................................
+c
+      DOUBLE PRECISION tmp1
+      REAL tmp2,tmp3
+c
+c
+      long=longref
+c
+c********************************************************
+c interpolation
+      ilong=1
+      DO idata=2,ndata
+        IF (long.gt.longdata(idata)) ilong=idata
+      ENDDO
+      i1=ilong
+      i2=ilong+1
+      IF (i2.gt.ndata) i2=ndata
+      IF (long.lt.longdata(1)) i2=1
+      IF (i1.eq.i2) THEN
+        c1=1.E+0
+        c2=0.E+0
+      ELSE
+        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+      ENDIF
+c********************************************************
+c
+      ep=c1*epdata(i1)+c2*epdata(i2)
+      factep=ep/epref
+      DO idata=1,ndata
+        epdata(idata)=epdata(idata)/factep
+      ENDDO
+c
+c.......................................................................
+c
+      DO iir=1,nir
+c
+c.......................................................................
+c
+        deltalong=(longir(iir+1)-longir(iir)) / nbande
+        totalemit(iir)=0.E+0
+        epir(iir)=0.E+0
+        omegir(iir)=0.E+0
+        gir(iir)=0.E+0
+c
+c.......................................................................
+c
+        DO ibande=1,nbande
+c
+c.......................................................................
+c
+          long=longir(iir) + (ibande-0.5E+0) * deltalong
+          CALL blackl(DBLE(long),DBLE(temp),tmp1)
+          emit=REAL(tmp1)
+c
+c.......................................................................
+c
+c********************************************************
+c interpolation
+      ilong=1
+      DO idata=2,ndata
+        IF (long.gt.longdata(idata)) ilong=idata
+      ENDDO
+      i1=ilong
+      i2=ilong+1
+      IF (i2.gt.ndata) i2=ndata
+      IF (long.lt.longdata(1)) i2=1
+      IF (i1.eq.i2) THEN
+        c1=1.E+0
+        c2=0.E+0
+      ELSE
+        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+      ENDIF
+c********************************************************
+c
+          ep=c1*epdata(i1)+c2*epdata(i2)
+          omeg=c1*omegdata(i1)+c2*omegdata(i2)
+          g=c1*gdata(i1)+c2*gdata(i2)
+c
+c.......................................................................
+c
+          totalemit(iir)=totalemit(iir)+deltalong*emit
+          epir(iir)=epir(iir)+deltalong*emit*ep
+          omegir(iir)=omegir(iir)+deltalong*emit*omeg*ep
+          gir(iir)=gir(iir)+deltalong*emit*omeg*ep*g
+c
+c.......................................................................
+c
+        ENDDO
+c
+c.......................................................................
+c
+        gir(iir)=gir(iir)/omegir(iir)
+        omegir(iir)=omegir(iir)/epir(iir)
+        epir(iir)=epir(iir)/totalemit(iir)
+c
+c.......................................................................
+c
+      ENDDO
+c
+c......................................................................
+c
+c     Diagnostic de controle si on moyenne sur tout le spectre vis ou IR :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     tmp2=0.E+0
+c     DO iir=1,nir
+c       tmp2=tmp2+totalemit(iir)
+c     ENDDO
+c     tmp3=5.67E-8 * temp**4
+c     IF (abs((tmp2-tmp3)/tmp3).gt.0.05E+0) THEN
+c       PRINT *,'!!!! <---> il manque du Planck (voir moyenne.F)'
+c       PRINT *,'somme des bandes :',tmp2,'--- Planck:',tmp3
+c     ENDIF
+c
+c......................................................................
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdata.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdata.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdata.h	(revision 2744)
@@ -0,0 +1,134 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdata.h'
+c Spectral  Radiative properties of the Martian dust
+c SPECIAL "bright dust" (Clancy and Lee, 1991)
+
+c visible (Clancy and Lee, 1991)
+      integer ndatavis
+      parameter(ndatavis=2)
+      REAL longdatavis(ndatavis),epdatavis(ndatavis)
+     &    ,omegdatavis(ndatavis),gdatavis(ndatavis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndatair
+      parameter(ndatair=124)
+      REAL longdatair(ndatair),epdatair(ndatair)
+     &    ,omegdatair(ndatair),gdatair(ndatair)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+
+      data longdatavis/
+     & 0.210000E-06,0.414800E-05/
+      data epdatavis/2.5,2.5/
+      data omegdatavis/0.92,0.92/
+      data gdatavis/0.55,0.55/
+      data longdatair/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdatair/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdatair/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdatair/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdust.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdust.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdust.h	(revision 2744)
@@ -0,0 +1,135 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdust.h'
+c Spectral  Radiative properties of the Martian dust
+c SPECIAL "bright dust" (Clancy and Lee, 1991)
+
+
+c visible (Clancy and Lee, 1991)
+      integer ndustvis
+      parameter(ndustvis=2)
+      REAL longdustvis(ndustvis),epdustvis(ndustvis)
+     &    ,omegdustvis(ndustvis),gdustvis(ndustvis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndustir
+      parameter(ndustir=124)
+      REAL longdustir(ndustir),epdustir(ndustir)
+     &    ,omegdustir(ndustir),gdustir(ndustir)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+
+      data longdustvis/
+     & 0.210000E-06,0.414800E-05/
+      data epdustvis/2.5,2.5/
+      data omegdustvis/0.92,0.92/
+      data gdustvis/0.55,0.55/
+      data longdustir/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdustir/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdustir/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdustir/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdust.h.clan91
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdust.h.clan91	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdust.h.clan91	(revision 2744)
@@ -0,0 +1,135 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdust.h'
+c Spectral  Radiative properties of the Martian dust
+c SPECIAL "bright dust" (Clancy and Lee, 1991)
+
+
+c visible (Clancy and Lee, 1991)
+      integer ndustvis
+      parameter(ndustvis=2)
+      REAL longdustvis(ndustvis),epdustvis(ndustvis)
+     &    ,omegdustvis(ndustvis),gdustvis(ndustvis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndustir
+      parameter(ndustir=124)
+      REAL longdustir(ndustir),epdustir(ndustir)
+     &    ,omegdustir(ndustir),gdustir(ndustir)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+
+      data longdustvis/
+     & 0.210000E-06,0.414800E-05/
+      data epdustvis/2.5,2.5/
+      data omegdustvis/0.92,0.92/
+      data gdustvis/0.55,0.55/
+      data longdustir/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdustir/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdustir/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdustir/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdust.h.ocke97
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdust.h.ocke97	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerdust.h.ocke97	(revision 2744)
@@ -0,0 +1,151 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdata.h'
+c Spectral  Radiative properties of the Martian dust
+
+c visible (composite; Ockert-Bell, 1996)
+      integer ndatavis
+      parameter(ndatavis=22)
+      REAL longdatavis(ndatavis),epdatavis(ndatavis)
+     &    ,omegdatavis(ndatavis),gdatavis(ndatavis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndatair
+      parameter(ndatair=124)
+      REAL longdatair(ndatair),epdatair(ndatair)
+     &    ,omegdatair(ndatair),gdatair(ndatair)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+      data longdatavis/
+     & 0.210000E-06,0.300000E-06,0.350000E-06,0.396000E-06,0.500000E-06
+     &,0.596000E-06,0.670000E-06,0.700000E-06,0.802000E-06,0.101500E-05
+     &,0.121000E-05,0.138800E-05,0.219600E-05,0.249000E-05,0.289800E-05
+     &,0.300000E-05,0.319300E-05,0.339600E-05,0.360400E-05,0.377600E-05
+     &,0.398000E-05,0.414800E-05/
+      data epdatavis/
+     & 2.6279900,2.5766001,2.5974200,2.6333699,2.8306701
+     &,2.9744799,3.0389600,3.0630300,3.1325400,3.2430501
+     &,3.3174801,3.3595500,3.2457900,3.1078401,2.7780800
+     &,2.7713201,2.7360499,2.6556201,2.5405700,2.4204800
+     &,2.2459800,1.9280800/
+      data omegdatavis/
+     & 0.7495430,0.6030650,0.5962170,0.6119930,0.7942140
+     &,0.9040160,0.9288640,0.9370630,0.9486390,0.9521170
+     &,0.9540560,0.9558040,0.9550000,0.9511820,0.8042000
+     &,0.8244980,0.8807870,0.9260230,0.9545540,0.9594400
+     &,0.9581870,0.8693700/
+      data gdatavis/
+     & 0.7858040,0.8816350,0.8781190,0.8550090,0.7232660
+     &,0.6684300,0.6547490,0.6502400,0.6412210,0.6326590
+     &,0.6283010,0.6261290,0.6281390,0.6306530,0.6707820
+     &,0.6652110,0.6506370,0.6400950,0.6341580,0.6334550
+     &,0.6341640,0.6506680/
+      data longdatair/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdatair/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdatair/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdatair/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h	(revision 2744)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=2.5E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=3.e-6,qrefice=2.2)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0594757,2.0556829,2.2896707,2.3257456,2.5099661,
+     &2.9161227,2.8020720,0.9336269,1.5134708,1.6889371,
+     &1.8322314,1.9146321,1.9831489,2.0514481,2.1239402,
+     &2.1971617,2.2737679,2.3492715,2.4073563,2.4458375,
+     &2.4726937,2.4971056,2.5221505,2.5486584,2.5773935,
+     &2.6081295,2.6391418,2.6699214,2.7093878,2.7364888,
+     &2.7674158,2.8051183,2.8506889,2.9136717,2.9810331,
+     &3.0470915,3.0933173,3.1121876,3.1349294,3.1638598,
+     &3.1912117,3.2744172,3.2761116,3.2431061,3.2102768,
+     &3.1776469,3.0866187,2.9577594,2.8526461,2.8176398,
+     &2.7821639,2.7549253,2.7503767,2.7499533,2.7608297,
+     &2.7274404,2.5991304,2.5173609/
+       data epiceir/
+     &2.4190733,2.3199425,2.2540693,2.1095867,1.9555371,
+     &1.8269345,1.8036077,1.7855358,1.7711544,1.7690116,
+     &1.7829260,1.8295234,1.8549844,1.8687238,1.8656639,
+     &1.8619236,1.8579320,1.8448261,1.8235378,1.8017112,
+     &1.7578924,1.7259388,1.7054915,1.6687690,1.6185619,
+     &1.5858195,1.5535859,1.5112923,1.4703351,1.4347173,
+     &1.4047177,1.3697965,1.3251381,1.2680571,1.1960392,
+     &1.1172380,1.0578237,0.9745934,0.8949080,0.8474779,
+     &0.7968613,0.7102672,0.6077121,0.5407101,0.5224510,
+     &0.5266400,0.5439359,0.5927324,0.6681964,0.7765685,
+     &0.8902640,1.0280455,1.1302272,1.3228931,1.4579507,
+     &1.5726897,1.6591437,1.7202030,1.7452124,1.7473249,
+     &1.7453249,1.7290004,1.7075497,1.6815135,1.6501899,
+     &1.6082871,1.5523466,1.4047438,1.2489705,1.1717392,
+     &1.1052268,0.9884429,0.9432285,0.9081387,0.8657278,
+     &0.8152991,0.6394543,0.5499370,0.5321090,0.5103995,
+     &0.4716277,0.4179623,0.3657534,0.2508311,0.2299716,
+     &0.2108125,0.1924924,0.1673682,0.1598235,0.1464571,
+     &0.1420538,0.1533015,0.1798090,0.2135266,0.2636204,
+     &0.3173732,0.3756316,0.4310254,0.4916850,0.5594596,
+     &0.6165060,0.6480070,0.6899570,0.7094871,0.6969641,
+     &0.6295437,0.5589720,0.4951279,0.4591832,0.4279796,
+     &0.3880569,0.3635468,0.3400364,0.2975883,0.2645470,
+     &0.2365445,0.2152134,0.2020684,0.2264057,0.2488454,
+     &0.2725164,0.3044016,0.3105968,0.3001241,0.2917667,
+     &0.2818419,0.2701418,0.2540473,0.2319813,0.2079458,
+     &0.1858774,0.1567208,0.1371507,0.1266034,0.0947660,
+     &0.0791723,0.0730714,0.0680956,0.0596443,0.0523504,
+     &0.0464472,0.0328870,0.0206243,0.0157984/
+       data omegicevis/
+     &0.5478598,0.9999998,0.9999930,0.9999391,0.9852892,
+     &0.9747255,0.9896471,0.3921073,0.3646954,0.3975615,
+     &0.4174147,0.4264744,0.4352827,0.4448440,0.4550543,
+     &0.4644430,0.4733422,0.4809923,0.4836857,0.4835298,
+     &0.4823884,0.4821825,0.4822653,0.4822173,0.4828566,
+     &0.4861327,0.4930841,0.5041330,0.5267492,0.5471958,
+     &0.5780509,0.6176673,0.6584746,0.7053177,0.7443977,
+     &0.7823801,0.8173603,0.8434741,0.8708835,0.8929197,
+     &0.9106523,0.9344197,0.9465593,0.9499664,0.9501572,
+     &0.9384264,0.9281004,0.9095014,0.8796501,0.8642664,
+     &0.8496780,0.8360837,0.8353950,0.8325557,0.8399941,
+     &0.8961539,0.9191431,0.9229702/
+       data omegiceir/
+     &0.9181703,0.9106198,0.9053057,0.8796571,0.8349904,
+     &0.7679166,0.7511637,0.7306502,0.7113808,0.6862068,
+     &0.6691588,0.6380840,0.6405194,0.6548850,0.6619208,
+     &0.6655905,0.6727100,0.6823230,0.6875201,0.6890487,
+     &0.6883412,0.6776634,0.6725497,0.6736822,0.6769779,
+     &0.6740052,0.6752223,0.6791695,0.6745857,0.6706817,
+     &0.6675888,0.6726563,0.6810013,0.6928600,0.7032822,
+     &0.7016219,0.6788723,0.6561857,0.6251051,0.5999153,
+     &0.5784231,0.5407491,0.4858367,0.4156316,0.3081297,
+     &0.2542117,0.2051306,0.1674406,0.1491730,0.1494159,
+     &0.1588227,0.1749455,0.1886469,0.2149218,0.2356885,
+     &0.2543647,0.2729447,0.2907736,0.3091933,0.3188552,
+     &0.3287012,0.3389443,0.3486176,0.3593718,0.3712797,
+     &0.3844498,0.3992367,0.4283787,0.4480617,0.4557256,
+     &0.4565090,0.4582297,0.4537602,0.4503480,0.4573702,
+     &0.4677775,0.5004078,0.4921789,0.4687816,0.4652704,
+     &0.4829984,0.5146720,0.5423340,0.5802344,0.5751773,
+     &0.5603711,0.5358865,0.4843219,0.4606548,0.3958648,
+     &0.2311990,0.1309277,0.0689810,0.0473044,0.0357645,
+     &0.0302096,0.0285216,0.0283661,0.0288575,0.0298694,
+     &0.0319034,0.0337869,0.0364643,0.0395041,0.0429032,
+     &0.0455614,0.0464966,0.0454506,0.0435048,0.0429859,
+     &0.0433492,0.0439662,0.0451907,0.0472841,0.0479729,
+     &0.0480491,0.0468699,0.0440733,0.0341798,0.0291907,
+     &0.0265080,0.0251720,0.0254859,0.0266501,0.0271129,
+     &0.0276442,0.0282702,0.0292041,0.0302890,0.0310830,
+     &0.0316508,0.0322409,0.0326373,0.0328552,0.0364115,
+     &0.0346299,0.0332475,0.0322650,0.0299256,0.0276080,
+     &0.0250169,0.0166050,0.0108650,0.0093190/
+       data gicevis/
+     &0.9487292,0.8501517,0.8084917,0.8064129,0.7796354,
+     &0.8265753,0.9093526,0.9365674,0.9241107,0.9169607,
+     &0.9102123,0.9061169,0.9015271,0.8957432,0.8886193,
+     &0.8810557,0.8728880,0.8651341,0.8625306,0.8636174,
+     &0.8661903,0.8671943,0.8675743,0.8681570,0.8683062,
+     &0.8662376,0.8610609,0.8520109,0.8346523,0.8228595,
+     &0.8053397,0.7876619,0.7732534,0.7589003,0.7500000,
+     &0.7413471,0.7345427,0.7344642,0.7366309,0.7405840,
+     &0.7467821,0.7644036,0.7784136,0.7846442,0.7965618,
+     &0.8083032,0.8136568,0.8199432,0.8255728,0.8271201,
+     &0.8275242,0.8268972,0.8249819,0.8245324,0.8223208,
+     &0.8117355,0.8062472,0.8041336/
+       data giceir/
+     &0.8028125,0.8016422,0.8009415,0.7998557,0.7981417,
+     &0.7963558,0.7960360,0.7959067,0.7956044,0.7956340,
+     &0.7950525,0.7882976,0.7844244,0.7777230,0.7753325,
+     &0.7731695,0.7707492,0.7681598,0.7659332,0.7639940,
+     &0.7603320,0.7571294,0.7533165,0.7466281,0.7393790,
+     &0.7345678,0.7292926,0.7235673,0.7182128,0.7126561,
+     &0.7069229,0.7005080,0.6936766,0.6865230,0.6792384,
+     &0.6722496,0.6657850,0.6547473,0.6428918,0.6345846,
+     &0.6255974,0.6109424,0.5946515,0.5828903,0.5715944,
+     &0.5652506,0.5587830,0.5527261,0.5470884,0.5424237,
+     &0.5377048,0.5334029,0.5303385,0.5231666,0.5153511,
+     &0.5072109,0.4983860,0.4895755,0.4802338,0.4751357,
+     &0.4699576,0.4646551,0.4586791,0.4522615,0.4457387,
+     &0.4389421,0.4309897,0.4133823,0.3940207,0.3839259,
+     &0.3734751,0.3533985,0.3436313,0.3339687,0.3244507,
+     &0.3145035,0.2824177,0.2612788,0.2519038,0.2428105,
+     &0.2333613,0.2230495,0.2126012,0.1826718,0.1755434,
+     &0.1677177,0.1589084,0.1445894,0.1393903,0.1275548,
+     &0.1034226,0.0862908,0.0732680,0.0678129,0.0630464,
+     &0.0581228,0.0541460,0.0502856,0.0463469,0.0425679,
+     &0.0408138,0.0391414,0.0376537,0.0370017,0.0370768,
+     &0.0378109,0.0381619,0.0376564,0.0360912,0.0348694,
+     &0.0337249,0.0332462,0.0328845,0.0325112,0.0317704,
+     &0.0309227,0.0299524,0.0289665,0.0271364,0.0258780,
+     &0.0250178,0.0241542,0.0240672,0.0236685,0.0231454,
+     &0.0228576,0.0225964,0.0223764,0.0221073,0.0215770,
+     &0.0209200,0.0198007,0.0188984,0.0183424,0.0170089,
+     &0.0154822,0.0146694,0.0140185,0.0127366,0.0115393,
+     &0.0104058,0.0071931,0.0046216,0.0037448/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.005
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.005	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.005	(revision 2744)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 0.5 MICRONS (Franck Montmessin) 
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=65.E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=.5e-6,qrefice=2.8)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.1832037,3.0220087,2.4477277,1.7936502,0.7896869,
+     &0.3638896,0.0989704,0.1296485,0.4747359,0.6042269,
+     &0.7391522,0.8270491,0.9101521,1.0053538,1.1204786,
+     &1.2478381,1.3907613,1.5331460,1.5983437,1.5859528,
+     &1.5294470,1.4795980,1.4226713,1.3357474,1.2130061,
+     &1.0765146,0.9549081,0.8522044,0.7333566,0.6579455,
+     &0.5836973,0.5145633,0.4580996,0.4042850,0.3620397,
+     &0.3252469,0.2931417,0.2685316,0.2455204,0.2259372,
+     &0.2092481,0.1779757,0.1460140,0.1362165,0.1238611,
+     &0.1114724,0.1013308,0.0958610,0.0989326,0.1026265,
+     &0.1056360,0.1088488,0.1078976,0.1089309,0.1056082,
+     &0.0775238,0.0604925,0.0548426/
+       data epiceir/
+     &0.0518859,0.0499921,0.0489281,0.0504541,0.0563693,
+     &0.0690525,0.0726885,0.0778081,0.0828819,0.0909149,
+     &0.0975723,0.1109497,0.1108328,0.1043100,0.1007861,
+     &0.0985987,0.0951375,0.0903377,0.0868122,0.0846175,
+     &0.0815860,0.0824196,0.0820647,0.0784795,0.0737793,
+     &0.0722562,0.0696436,0.0659283,0.0645018,0.0631230,
+     &0.0617881,0.0583767,0.0540010,0.0487309,0.0435927,
+     &0.0405531,0.0414796,0.0409568,0.0413717,0.0422409,
+     &0.0421894,0.0416819,0.0412459,0.0438362,0.0547753,
+     &0.0626479,0.0729752,0.0890032,0.1097846,0.1367236,
+     &0.1645632,0.1977923,0.2204414,0.2592581,0.2749909,
+     &0.2818336,0.2731296,0.2562519,0.2294758,0.2146772,
+     &0.2003647,0.1846708,0.1704422,0.1563350,0.1425573,
+     &0.1287259,0.1145926,0.0897004,0.0727098,0.0659172,
+     &0.0615737,0.0541199,0.0521104,0.0503624,0.0466379,
+     &0.0422906,0.0299038,0.0264714,0.0274238,0.0264572,
+     &0.0231405,0.0186739,0.0150726,0.0092988,0.0087124,
+     &0.0084247,0.0083568,0.0085502,0.0087600,0.0096209,
+     &0.0139307,0.0186971,0.0250932,0.0314043,0.0401234,
+     &0.0493907,0.0591965,0.0683152,0.0781187,0.0888679,
+     &0.0974246,0.1010759,0.1059724,0.1067670,0.1021143,
+     &0.0896822,0.0784708,0.0693838,0.0645370,0.0599980,
+     &0.0540903,0.0504870,0.0469609,0.0408812,0.0363856,
+     &0.0326679,0.0299615,0.0284745,0.0328476,0.0366500,
+     &0.0404568,0.0452998,0.0461202,0.0442455,0.0428461,
+     &0.0412572,0.0394165,0.0369267,0.0336194,0.0301124,
+     &0.0269362,0.0227761,0.0199896,0.0184862,0.0138242,
+     &0.0116880,0.0108555,0.0101642,0.0089899,0.0079631,
+     &0.0071303,0.0051857,0.0033162,0.0025556/
+       data omegicevis/
+     &0.5254589,1.0000000,0.9999991,0.9999862,0.9916013,
+     &0.9620332,0.9309642,0.0638710,0.0662553,0.0823147,
+     &0.0963694,0.1048159,0.1133009,0.1232222,0.1352970,
+     &0.1488444,0.1650357,0.1841903,0.2017575,0.2166039,
+     &0.2292029,0.2433622,0.2616843,0.2852339,0.3131889,
+     &0.3412718,0.3660752,0.3928272,0.4309901,0.4492646,
+     &0.4801873,0.5139056,0.5460804,0.5844365,0.6146011,
+     &0.6468718,0.6772872,0.6975922,0.7236167,0.7461668,
+     &0.7655625,0.7888166,0.7862524,0.7823967,0.7588729,
+     &0.6857340,0.6214526,0.5368491,0.4470918,0.4119983,
+     &0.3805366,0.3541514,0.3503601,0.3458159,0.3562116,
+     &0.4411552,0.4703839,0.4680012/
+       data omegiceir/
+     &0.4410178,0.4089485,0.3886294,0.3210695,0.2419387,
+     &0.1693097,0.1560958,0.1421160,0.1303703,0.1174139,
+     &0.1096975,0.0955347,0.0956753,0.0990973,0.1009341,
+     &0.1015035,0.1034342,0.1062110,0.1070629,0.1064178,
+     &0.1036404,0.0972966,0.0935797,0.0912126,0.0893898,
+     &0.0863554,0.0848208,0.0840290,0.0804088,0.0772171,
+     &0.0744647,0.0741630,0.0747523,0.0763844,0.0774963,
+     &0.0745925,0.0657440,0.0572360,0.0481501,0.0421850,
+     &0.0375024,0.0306774,0.0232991,0.0167966,0.0100478,
+     &0.0075047,0.0055527,0.0042542,0.0036752,0.0036866,
+     &0.0039804,0.0045186,0.0049973,0.0059663,0.0067372,
+     &0.0074513,0.0081464,0.0088094,0.0094550,0.0097817,
+     &0.0101162,0.0104466,0.0107313,0.0110585,0.0114425,
+     &0.0118786,0.0123615,0.0132487,0.0135842,0.0136287,
+     &0.0132877,0.0127042,0.0121676,0.0117236,0.0118197,
+     &0.0120773,0.0129020,0.0118840,0.0105257,0.0101722,
+     &0.0107762,0.0121118,0.0133881,0.0149663,0.0144329,
+     &0.0133009,0.0117145,0.0090358,0.0080348,0.0058144,
+     &0.0023043,0.0010388,0.0004725,0.0003068,0.0002241,
+     &0.0001846,0.0001716,0.0001686,0.0001696,0.0001738,
+     &0.0001855,0.0001962,0.0002120,0.0002308,0.0002526,
+     &0.0002702,0.0002761,0.0002683,0.0002543,0.0002499,
+     &0.0002511,0.0002545,0.0002619,0.0002746,0.0002779,
+     &0.0002773,0.0002686,0.0002502,0.0001890,0.0001591,
+     &0.0001434,0.0001354,0.0001372,0.0001437,0.0001462,
+     &0.0001491,0.0001526,0.0001578,0.0001639,0.0001681,
+     &0.0001709,0.0001735,0.0001751,0.0001759,0.0001954,
+     &0.0001839,0.0001755,0.0001695,0.0001556,0.0001422,
+     &0.0001276,0.0000821,0.0000525,0.0000447/
+       data gicevis/
+     &0.9440147,0.7965972,0.8107608,0.7669883,0.6258456,
+     &0.4763368,0.3164644,0.2653029,0.2540545,0.2543145,
+     &0.2552853,0.2555421,0.2551991,0.2546355,0.2543354,
+     &0.2544852,0.2551972,0.2571523,0.2610470,0.2657359,
+     &0.2696103,0.2723087,0.2749877,0.2770225,0.2766140,
+     &0.2729803,0.2674728,0.2618006,0.2547111,0.2485000,
+     &0.2423996,0.2361834,0.2305830,0.2249461,0.2198020,
+     &0.2149920,0.2103154,0.2060570,0.2018775,0.1979253,
+     &0.1941856,0.1853729,0.1727509,0.1681767,0.1610373,
+     &0.1502239,0.1399678,0.1301550,0.1233758,0.1211795,
+     &0.1180928,0.1149843,0.1129097,0.1123236,0.1113603,
+     &0.1042673,0.0958210,0.0918495/
+       data giceir/
+     &0.0879977,0.0844017,0.0822360,0.0778328,0.0732655,
+     &0.0690960,0.0682752,0.0674878,0.0666989,0.0659700,
+     &0.0653013,0.0618198,0.0604822,0.0583973,0.0576873,
+     &0.0569741,0.0562715,0.0555336,0.0547710,0.0540252,
+     &0.0525653,0.0511566,0.0498082,0.0478042,0.0458238,
+     &0.0445190,0.0432495,0.0419659,0.0407013,0.0394739,
+     &0.0382847,0.0371085,0.0359234,0.0347448,0.0335567,
+     &0.0323681,0.0312087,0.0295399,0.0279082,0.0268502,
+     &0.0258095,0.0242507,0.0226832,0.0216094,0.0205569,
+     &0.0199994,0.0194464,0.0189064,0.0183935,0.0179262,
+     &0.0174721,0.0170318,0.0167252,0.0161173,0.0156093,
+     &0.0151735,0.0148010,0.0144899,0.0141909,0.0140236,
+     &0.0138500,0.0136646,0.0134407,0.0131990,0.0129545,
+     &0.0126989,0.0123981,0.0117364,0.0110220,0.0106622,
+     &0.0102900,0.0096114,0.0092885,0.0089773,0.0086913,
+     &0.0084029,0.0075082,0.0069195,0.0066498,0.0064030,
+     &0.0061638,0.0059125,0.0056564,0.0049044,0.0047217,
+     &0.0045194,0.0042905,0.0039171,0.0037807,0.0034683,
+     &0.0028199,0.0023535,0.0019931,0.0018378,0.0017011,
+     &0.0015627,0.0014514,0.0013460,0.0012398,0.0011386,
+     &0.0010917,0.0010505,0.0010140,0.0010014,0.0010106,
+     &0.0010385,0.0010523,0.0010404,0.0009990,0.0009673,
+     &0.0009376,0.0009252,0.0009159,0.0009061,0.0008860,
+     &0.0008628,0.0008361,0.0008086,0.0007567,0.0007210,
+     &0.0006967,0.0006727,0.0006705,0.0006603,0.0006463,
+     &0.0006386,0.0006316,0.0006257,0.0006182,0.0006034,
+     &0.0005850,0.0005536,0.0005284,0.0005128,0.0004754,
+     &0.0004328,0.0004100,0.0003918,0.0003559,0.0003223,
+     &0.0002906,0.0002006,0.0001287,0.0001043/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.01
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.01	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.01	(revision 2744)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 1 MICRONS (Franck M ontmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=23.E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=1.e-6,qrefice=2.75)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.1192634,2.3866904,3.0710473,3.2044775,2.4812233,
+     &1.5408986,0.5308650,0.2823303,0.8151994,0.9982054,
+     &1.1776563,1.2913215,1.3945227,1.5075399,1.6387790,
+     &1.7810757,1.9404513,2.1077142,2.2311430,2.3039091,
+     &2.3424239,2.3839264,2.4322689,2.4745319,2.4916942,
+     &2.4703403,2.4206913,2.3665223,2.2752666,2.1747661,
+     &2.0781898,1.9706942,1.8699772,1.7651500,1.6681471,
+     &1.5780047,1.4902014,1.4125437,1.3384955,1.2692254,
+     &1.2053254,1.0666140,0.9020291,0.8492430,0.7754933,
+     &0.6846126,0.6097632,0.5495253,0.5234407,0.5223706,
+     &0.5196257,0.5199762,0.5163358,0.5186846,0.5133317,
+     &0.4363440,0.3637202,0.3336293/
+       data epiceir/
+     &0.3097547,0.2899992,0.2780589,0.2617716,0.2548404,
+     &0.2650286,0.2694660,0.2773825,0.2855305,0.3007740,
+     &0.3150952,0.3452618,0.3475289,0.3352611,0.3274985,
+     &0.3222899,0.3144871,0.3029351,0.2930705,0.2859025,
+     &0.2744837,0.2721885,0.2687397,0.2570274,0.2420578,
+     &0.2354512,0.2268017,0.2151964,0.2083238,0.2020417,
+     &0.1963370,0.1862280,0.1736113,0.1585643,0.1430934,
+     &0.1316877,0.1294224,0.1228625,0.1185373,0.1171891,
+     &0.1139945,0.1080297,0.1016796,0.1029433,0.1216047,
+     &0.1356978,0.1546041,0.1849135,0.2246722,0.2768484,
+     &0.3310658,0.3965377,0.4426499,0.5253468,0.5668955,
+     &0.5922215,0.5880766,0.5654298,0.5190575,0.4913011,
+     &0.4635427,0.4314885,0.4015174,0.3712321,0.3411348,
+     &0.3102629,0.2780339,0.2194865,0.1779260,0.1610434,
+     &0.1496597,0.1303599,0.1247039,0.1198948,0.1110008,
+     &0.1007371,0.0712706,0.0622413,0.0636172,0.0611146,
+     &0.0536605,0.0437097,0.0355698,0.0220631,0.0205425,
+     &0.0196398,0.0191828,0.0191171,0.0193923,0.0208254,
+     &0.0290338,0.0383325,0.0509648,0.0635566,0.0810146,
+     &0.0995692,0.1192388,0.1375636,0.1572995,0.1789836,
+     &0.1963544,0.2039599,0.2141546,0.2161427,0.2071475,
+     &0.1822319,0.1595332,0.1409966,0.1310656,0.1218277,
+     &0.1098314,0.1025169,0.0953714,0.0830212,0.0738609,
+     &0.0662767,0.0607402,0.0576721,0.0664149,0.0740372,
+     &0.0816919,0.0914682,0.0931417,0.0893927,0.0865822,
+     &0.0833833,0.0796740,0.0746523,0.0679690,0.0608707,
+     &0.0544375,0.0460094,0.0403652,0.0373210,0.0279000,
+     &0.0235664,0.0218776,0.0204772,0.0180988,0.0160214,
+     &0.0143370,0.0104088,0.0066479,0.0051210/
+       data omegicevis/
+     &0.5386420,1.0000000,0.9999983,0.9999850,0.9955066,
+     &0.9844767,0.9774309,0.1614970,0.1627708,0.1939070,
+     &0.2183838,0.2320055,0.2452919,0.2601796,0.2772272,
+     &0.2949594,0.3144796,0.3355922,0.3536791,0.3691771,
+     &0.3833629,0.3993029,0.4197326,0.4469427,0.4815640,
+     &0.5188605,0.5528998,0.5873977,0.6337127,0.6578971,
+     &0.6923810,0.7275212,0.7585961,0.7921193,0.8169167,
+     &0.8410107,0.8620409,0.8756065,0.8913837,0.9042724,
+     &0.9147988,0.9275904,0.9291340,0.9284223,0.9196891,
+     &0.8876197,0.8561562,0.8072060,0.7431433,0.7140535,
+     &0.6865323,0.6620798,0.6595058,0.6550942,0.6665309,
+     &0.7495020,0.7778903,0.7786440/
+       data omegiceir/
+     &0.7604749,0.7366999,0.7205958,0.6580536,0.5668025,
+     &0.4587096,0.4356672,0.4097329,0.3868122,0.3598266,
+     &0.3431242,0.3130278,0.3147338,0.3254214,0.3307036,
+     &0.3329236,0.3383887,0.3458877,0.3488805,0.3483467,
+     &0.3436954,0.3301307,0.3225699,0.3191252,0.3170218,
+     &0.3108034,0.3083988,0.3079879,0.2998554,0.2926259,
+     &0.2863949,0.2870713,0.2903223,0.2965344,0.3012683,
+     &0.2946250,0.2699749,0.2452659,0.2165022,0.1961797,
+     &0.1795562,0.1537112,0.1230571,0.0931165,0.0588126,
+     &0.0449536,0.0339055,0.0263423,0.0229347,0.0230562,
+     &0.0248910,0.0281887,0.0311059,0.0369957,0.0417154,
+     &0.0460758,0.0503238,0.0543560,0.0582899,0.0602842,
+     &0.0623192,0.0643389,0.0661152,0.0681381,0.0704755,
+     &0.0731053,0.0760185,0.0814240,0.0838108,0.0843268,
+     &0.0827206,0.0799519,0.0771474,0.0748236,0.0755603,
+     &0.0772232,0.0825206,0.0770989,0.0693231,0.0673670,
+     &0.0711028,0.0790820,0.0865735,0.0959862,0.0931518,
+     &0.0868936,0.0778482,0.0618916,0.0556907,0.0414274,
+     &0.0172511,0.0079517,0.0036608,0.0023874,0.0017483,
+     &0.0014435,0.0013443,0.0013223,0.0013315,0.0013663,
+     &0.0014583,0.0015426,0.0016673,0.0018146,0.0019850,
+     &0.0021217,0.0021683,0.0021083,0.0019995,0.0019657,
+     &0.0019761,0.0020031,0.0020611,0.0021607,0.0021879,
+     &0.0021838,0.0021172,0.0019728,0.0014927,0.0012580,
+     &0.0011338,0.0010718,0.0010859,0.0011371,0.0011565,
+     &0.0011796,0.0012070,0.0012485,0.0012965,0.0013299,
+     &0.0013524,0.0013734,0.0013868,0.0013938,0.0015480,
+     &0.0014583,0.0013921,0.0013452,0.0012361,0.0011303,
+     &0.0010147,0.0006545,0.0004192,0.0003572/
+       data gicevis/
+     &0.9472355,0.7817819,0.8104869,0.8370932,0.8250610,
+     &0.7729445,0.6907796,0.6560782,0.6408569,0.6389719,
+     &0.6383793,0.6379554,0.6365179,0.6343526,0.6319877,
+     &0.6300194,0.6284310,0.6279051,0.6303032,0.6338103,
+     &0.6368135,0.6378741,0.6381156,0.6375306,0.6352661,
+     &0.6311954,0.6260597,0.6201031,0.6121832,0.6065006,
+     &0.5996023,0.5927197,0.5867192,0.5807193,0.5757619,
+     &0.5710542,0.5665758,0.5626292,0.5584362,0.5544021,
+     &0.5504646,0.5406969,0.5247300,0.5183126,0.5077586,
+     &0.4904415,0.4721469,0.4530136,0.4389606,0.4342998,
+     &0.4274060,0.4202327,0.4151474,0.4137563,0.4111845,
+     &0.3915503,0.3674690,0.3556202/
+       data giceir/
+     &0.3438542,0.3325318,0.3255288,0.3110588,0.2956603,
+     &0.2814386,0.2786329,0.2760077,0.2733599,0.2710718,
+     &0.2689575,0.2567067,0.2516982,0.2434593,0.2405528,
+     &0.2376774,0.2347744,0.2316430,0.2284427,0.2253558,
+     &0.2193370,0.2136727,0.2081797,0.1998119,0.1914108,
+     &0.1859097,0.1804893,0.1749370,0.1695419,0.1642952,
+     &0.1592050,0.1540809,0.1488775,0.1436688,0.1384313,
+     &0.1332790,0.1283971,0.1213205,0.1144493,0.1100211,
+     &0.1056500,0.0991218,0.0926120,0.0882538,0.0841548,
+     &0.0820158,0.0799326,0.0779781,0.0761736,0.0745909,
+     &0.0730158,0.0714981,0.0703739,0.0679849,0.0657191,
+     &0.0636815,0.0617775,0.0601208,0.0585010,0.0576308,
+     &0.0567537,0.0558357,0.0547788,0.0536580,0.0525378,
+     &0.0513812,0.0500444,0.0471741,0.0441685,0.0426759,
+     &0.0411515,0.0383862,0.0370815,0.0358252,0.0346632,
+     &0.0334926,0.0298874,0.0275405,0.0264717,0.0254866,
+     &0.0245280,0.0235218,0.0225007,0.0195162,0.0187928,
+     &0.0179918,0.0170857,0.0156065,0.0150664,0.0138279,
+     &0.0112556,0.0094019,0.0079691,0.0073517,0.0068074,
+     &0.0062553,0.0058107,0.0053889,0.0049634,0.0045574,
+     &0.0043685,0.0042020,0.0040541,0.0040013,0.0040349,
+     &0.0041445,0.0041994,0.0041524,0.0039878,0.0038609,
+     &0.0037426,0.0036932,0.0036563,0.0036177,0.0035376,
+     &0.0034454,0.0033390,0.0032297,0.0030226,0.0028803,
+     &0.0027832,0.0026872,0.0026783,0.0026373,0.0025813,
+     &0.0025507,0.0025227,0.0024990,0.0024694,0.0024103,
+     &0.0023370,0.0022120,0.0021112,0.0020491,0.0019000,
+     &0.0017298,0.0016389,0.0015661,0.0014226,0.0012886,
+     &0.0011617,0.0008021,0.0005148,0.0004169/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.02
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.02	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.02	(revision 2744)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 2 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=5.5E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=2.e-6,qrefice=2.55)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0770404,2.1333470,2.4010422,2.4979005,3.0323684,
+     &3.1023693,1.8456773,0.6115797,1.2549678,1.4533914,
+     &1.6278559,1.7319367,1.8213371,1.9134820,2.0143185,
+     &2.1186094,2.2303414,2.3434513,2.4327984,2.4951937,
+     &2.5413978,2.5864980,2.6369226,2.6951535,2.7622788,
+     &2.8332534,2.8984516,2.9598370,3.0300596,3.0575798,
+     &3.0930560,3.1250999,3.1535439,3.1871719,3.2121134,
+     &3.2310603,3.2315695,3.2093773,3.1794426,3.1392601,
+     &3.0919006,2.9505072,2.7231605,2.6405320,2.5163631,
+     &2.3446450,2.1814499,2.0090101,1.8916085,1.8633907,
+     &1.8338290,1.8152963,1.8086077,1.8112632,1.8131738,
+     &1.7060630,1.5370420,1.4517928/
+       data epiceir/
+     &1.3677877,1.2895485,1.2393701,1.1429415,1.0560902,
+     &1.0034354,0.9967221,0.9962561,0.9977396,1.0125090,
+     &1.0341120,1.0880692,1.1033542,1.0976548,1.0879265,
+     &1.0804520,1.0700891,1.0510827,1.0297735,1.0111766,
+     &0.9773523,0.9594117,0.9459089,0.9159908,0.8764862,
+     &0.8542295,0.8300154,0.7979962,0.7717778,0.7486199,
+     &0.7285973,0.7015588,0.6676357,0.6260576,0.5785204,
+     &0.5338926,0.5080446,0.4684776,0.4333192,0.4139500,
+     &0.3915187,0.3532456,0.3098173,0.2878825,0.3012615,
+     &0.3171561,0.3421502,0.3891775,0.4544489,0.5433146,
+     &0.6361080,0.7489142,0.8315196,0.9866923,1.0865711,
+     &1.1662428,1.2104664,1.2263397,1.2011900,1.1775792,
+     &1.1506165,1.1109692,1.0695655,1.0244781,0.9760489,
+     &0.9209963,0.8573869,0.7222608,0.6077753,0.5570301,
+     &0.5179734,0.4515876,0.4286255,0.4101167,0.3839801,
+     &0.3538276,0.2605970,0.2226936,0.2192847,0.2094082,
+     &0.1883334,0.1602530,0.1354466,0.0878593,0.0806558,
+     &0.0747401,0.0696599,0.0635099,0.0620812,0.0608565,
+     &0.0708767,0.0859044,0.1087823,0.1332179,0.1678403,
+     &0.2047173,0.2441402,0.2811615,0.3213149,0.3657669,
+     &0.4021912,0.4198142,0.4433846,0.4508493,0.4361142,
+     &0.3870594,0.3401732,0.3004933,0.2788217,0.2592098,
+     &0.2339364,0.2185203,0.2035674,0.1773828,0.1576549,
+     &0.1412068,0.1290261,0.1220045,0.1392276,0.1544823,
+     &0.1700448,0.1902850,0.1939131,0.1865104,0.1808444,
+     &0.1743156,0.1667072,0.1563581,0.1424541,0.1275658,
+     &0.1140205,0.0962364,0.0843266,0.0779076,0.0582227,
+     &0.0489812,0.0453767,0.0424055,0.0373608,0.0329743,
+     &0.0294211,0.0211810,0.0134449,0.0103372/
+       data omegicevis/
+     &0.5456115,0.9999998,0.9999956,0.9999590,0.9916146,
+     &0.9859025,0.9887677,0.3030088,0.2913164,0.3281876,
+     &0.3529492,0.3651998,0.3768913,0.3895164,0.4031501,
+     &0.4161578,0.4291025,0.4413079,0.4489263,0.4537341,
+     &0.4575938,0.4624165,0.4686106,0.4772439,0.4906920,
+     &0.5103999,0.5342540,0.5620137,0.6054875,0.6363699,
+     &0.6767519,0.7208792,0.7611457,0.8031358,0.8346425,
+     &0.8628765,0.8866344,0.9024555,0.9187659,0.9315375,
+     &0.9414928,0.9542499,0.9594395,0.9604324,0.9575609,
+     &0.9427309,0.9280359,0.9029658,0.8663382,0.8482844,
+     &0.8309193,0.8149818,0.8138757,0.8108203,0.8191826,
+     &0.8778344,0.8991383,0.9015617/
+       data omegiceir/
+     &0.8934232,0.8818511,0.8737661,0.8382167,0.7786070,
+     &0.6939076,0.6735601,0.6493360,0.6269631,0.5988325,
+     &0.5805314,0.5477262,0.5506567,0.5654900,0.5726005,
+     &0.5761235,0.5833758,0.5930895,0.5978242,0.5985849,
+     &0.5960529,0.5830086,0.5764220,0.5759224,0.5773382,
+     &0.5725862,0.5723791,0.5748378,0.5679526,0.5619652,
+     &0.5570325,0.5608990,0.5682156,0.5793377,0.5887846,
+     &0.5845600,0.5571433,0.5294130,0.4933869,0.4654703,
+     &0.4418373,0.4019260,0.3476712,0.2847430,0.1985389,
+     &0.1588668,0.1246927,0.0997362,0.0880947,0.0885516,
+     &0.0949879,0.1061776,0.1158887,0.1351058,0.1506025,
+     &0.1648239,0.1789169,0.1923770,0.2058806,0.2128322,
+     &0.2198936,0.2270511,0.2336397,0.2410020,0.2492446,
+     &0.2583708,0.2685325,0.2880028,0.2994628,0.3033591,
+     &0.3015518,0.2984661,0.2927081,0.2880204,0.2918781,
+     &0.2983889,0.3187046,0.3071705,0.2860579,0.2815239,
+     &0.2940739,0.3184738,0.3403679,0.3687520,0.3625693,
+     &0.3473680,0.3237919,0.2777646,0.2580903,0.2082118,
+     &0.1032983,0.0523547,0.0255129,0.0169770,0.0125923,
+     &0.0104937,0.0098291,0.0097139,0.0098247,0.0101194,
+     &0.0108076,0.0114394,0.0123597,0.0134295,0.0146494,
+     &0.0156162,0.0159481,0.0155375,0.0147876,0.0145659,
+     &0.0146613,0.0148656,0.0152911,0.0160210,0.0162369,
+     &0.0162299,0.0157726,0.0147472,0.0112574,0.0095320,
+     &0.0086141,0.0081565,0.0082618,0.0086479,0.0087967,
+     &0.0089716,0.0091790,0.0094908,0.0098519,0.0101090,
+     &0.0102865,0.0104608,0.0105742,0.0106353,0.0118091,
+     &0.0111652,0.0106810,0.0103373,0.0095315,0.0087433,
+     &0.0078753,0.0051297,0.0033094,0.0028262/
+       data gicevis/
+     &0.9484491,0.8355189,0.7778400,0.7776268,0.8190585,
+     &0.8606436,0.8731218,0.8806872,0.8701044,0.8643763,
+     &0.8590536,0.8557699,0.8518856,0.8469009,0.8408017,
+     &0.8344239,0.8276296,0.8213363,0.8196754,0.8210629,
+     &0.8234175,0.8239279,0.8233964,0.8221809,0.8193476,
+     &0.8139911,0.8067252,0.7971323,0.7828836,0.7760382,
+     &0.7660869,0.7580626,0.7531731,0.7496098,0.7489922,
+     &0.7482402,0.7481378,0.7496041,0.7509772,0.7528265,
+     &0.7546561,0.7586707,0.7610235,0.7611462,0.7609918,
+     &0.7593807,0.7559055,0.7519168,0.7489015,0.7477896,
+     &0.7452020,0.7419832,0.7389061,0.7381128,0.7358862,
+     &0.7217935,0.7082421,0.7019699/
+       data giceir/
+     &0.6960046,0.6900042,0.6861350,0.6780239,0.6687398,
+     &0.6597540,0.6579545,0.6563612,0.6546398,0.6533316,
+     &0.6517801,0.6404516,0.6350707,0.6258222,0.6224794,
+     &0.6192569,0.6158453,0.6121228,0.6084902,0.6050581,
+     &0.5983168,0.5919929,0.5853947,0.5746408,0.5632364,
+     &0.5555539,0.5475681,0.5390213,0.5306059,0.5220675,
+     &0.5134400,0.5042357,0.4944685,0.4842367,0.4735520,
+     &0.4627753,0.4524445,0.4363809,0.4197907,0.4085655,
+     &0.3969283,0.3785424,0.3589033,0.3451340,0.3322701,
+     &0.3254838,0.3188725,0.3129705,0.3078346,0.3038980,
+     &0.3000817,0.2968043,0.2943990,0.2886447,0.2820266,
+     &0.2753667,0.2682444,0.2614060,0.2542432,0.2503684,
+     &0.2464747,0.2424094,0.2378109,0.2329219,0.2279974,
+     &0.2228620,0.2168691,0.2037218,0.1898008,0.1828437,
+     &0.1758485,0.1631169,0.1571932,0.1515194,0.1461390,
+     &0.1406711,0.1239195,0.1134407,0.1088622,0.1045607,
+     &0.1002667,0.0957376,0.0912288,0.0785050,0.0754995,
+     &0.0722006,0.0684929,0.0624823,0.0602997,0.0553188,
+     &0.0450513,0.0376778,0.0319985,0.0295693,0.0274262,
+     &0.0252342,0.0234632,0.0217670,0.0200484,0.0184050,
+     &0.0176370,0.0169397,0.0163182,0.0160728,0.0161649,
+     &0.0165620,0.0167632,0.0165711,0.0159091,0.0153961,
+     &0.0149173,0.0147177,0.0145685,0.0144148,0.0140963,
+     &0.0137293,0.0133060,0.0128724,0.0120525,0.0114887,
+     &0.0111030,0.0107191,0.0106819,0.0105141,0.0102884,
+     &0.0101648,0.0100523,0.0099577,0.0098403,0.0096062,
+     &0.0093154,0.0088192,0.0084187,0.0081718,0.0075791,
+     &0.0069006,0.0065386,0.0062486,0.0056770,0.0051429,
+     &0.0046372,0.0032037,0.0020571,0.0016664/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.03
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.03	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.03	(revision 2744)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice: PARTICLE RADIUS = 3 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=2.5E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=3.e-6,qrefice=2.2)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0594757,2.0556829,2.2896707,2.3257456,2.5099661,
+     &2.9161227,2.8020720,0.9336269,1.5134708,1.6889371,
+     &1.8322314,1.9146321,1.9831489,2.0514481,2.1239402,
+     &2.1971617,2.2737679,2.3492715,2.4073563,2.4458375,
+     &2.4726937,2.4971056,2.5221505,2.5486584,2.5773935,
+     &2.6081295,2.6391418,2.6699214,2.7093878,2.7364888,
+     &2.7674158,2.8051183,2.8506889,2.9136717,2.9810331,
+     &3.0470915,3.0933173,3.1121876,3.1349294,3.1638598,
+     &3.1912117,3.2744172,3.2761116,3.2431061,3.2102768,
+     &3.1776469,3.0866187,2.9577594,2.8526461,2.8176398,
+     &2.7821639,2.7549253,2.7503767,2.7499533,2.7608297,
+     &2.7274404,2.5991304,2.5173609/
+       data epiceir/
+     &2.4190733,2.3199425,2.2540693,2.1095867,1.9555371,
+     &1.8269345,1.8036077,1.7855358,1.7711544,1.7690116,
+     &1.7829260,1.8295234,1.8549844,1.8687238,1.8656639,
+     &1.8619236,1.8579320,1.8448261,1.8235378,1.8017112,
+     &1.7578924,1.7259388,1.7054915,1.6687690,1.6185619,
+     &1.5858195,1.5535859,1.5112923,1.4703351,1.4347173,
+     &1.4047177,1.3697965,1.3251381,1.2680571,1.1960392,
+     &1.1172380,1.0578237,0.9745934,0.8949080,0.8474779,
+     &0.7968613,0.7102672,0.6077121,0.5407101,0.5224510,
+     &0.5266400,0.5439359,0.5927324,0.6681964,0.7765685,
+     &0.8902640,1.0280455,1.1302272,1.3228931,1.4579507,
+     &1.5726897,1.6591437,1.7202030,1.7452124,1.7473249,
+     &1.7453249,1.7290004,1.7075497,1.6815135,1.6501899,
+     &1.6082871,1.5523466,1.4047438,1.2489705,1.1717392,
+     &1.1052268,0.9884429,0.9432285,0.9081387,0.8657278,
+     &0.8152991,0.6394543,0.5499370,0.5321090,0.5103995,
+     &0.4716277,0.4179623,0.3657534,0.2508311,0.2299716,
+     &0.2108125,0.1924924,0.1673682,0.1598235,0.1464571,
+     &0.1420538,0.1533015,0.1798090,0.2135266,0.2636204,
+     &0.3173732,0.3756316,0.4310254,0.4916850,0.5594596,
+     &0.6165060,0.6480070,0.6899570,0.7094871,0.6969641,
+     &0.6295437,0.5589720,0.4951279,0.4591832,0.4279796,
+     &0.3880569,0.3635468,0.3400364,0.2975883,0.2645470,
+     &0.2365445,0.2152134,0.2020684,0.2264057,0.2488454,
+     &0.2725164,0.3044016,0.3105968,0.3001241,0.2917667,
+     &0.2818419,0.2701418,0.2540473,0.2319813,0.2079458,
+     &0.1858774,0.1567208,0.1371507,0.1266034,0.0947660,
+     &0.0791723,0.0730714,0.0680956,0.0596443,0.0523504,
+     &0.0464472,0.0328870,0.0206243,0.0157984/
+       data omegicevis/
+     &0.5478598,0.9999998,0.9999930,0.9999391,0.9852892,
+     &0.9747255,0.9896471,0.3921073,0.3646954,0.3975615,
+     &0.4174147,0.4264744,0.4352827,0.4448440,0.4550543,
+     &0.4644430,0.4733422,0.4809923,0.4836857,0.4835298,
+     &0.4823884,0.4821825,0.4822653,0.4822173,0.4828566,
+     &0.4861327,0.4930841,0.5041330,0.5267492,0.5471958,
+     &0.5780509,0.6176673,0.6584746,0.7053177,0.7443977,
+     &0.7823801,0.8173603,0.8434741,0.8708835,0.8929197,
+     &0.9106523,0.9344197,0.9465593,0.9499664,0.9501572,
+     &0.9384264,0.9281004,0.9095014,0.8796501,0.8642664,
+     &0.8496780,0.8360837,0.8353950,0.8325557,0.8399941,
+     &0.8961539,0.9191431,0.9229702/
+       data omegiceir/
+     &0.9181703,0.9106198,0.9053057,0.8796571,0.8349904,
+     &0.7679166,0.7511637,0.7306502,0.7113808,0.6862068,
+     &0.6691588,0.6380840,0.6405194,0.6548850,0.6619208,
+     &0.6655905,0.6727100,0.6823230,0.6875201,0.6890487,
+     &0.6883412,0.6776634,0.6725497,0.6736822,0.6769779,
+     &0.6740052,0.6752223,0.6791695,0.6745857,0.6706817,
+     &0.6675888,0.6726563,0.6810013,0.6928600,0.7032822,
+     &0.7016219,0.6788723,0.6561857,0.6251051,0.5999153,
+     &0.5784231,0.5407491,0.4858367,0.4156316,0.3081297,
+     &0.2542117,0.2051306,0.1674406,0.1491730,0.1494159,
+     &0.1588227,0.1749455,0.1886469,0.2149218,0.2356885,
+     &0.2543647,0.2729447,0.2907736,0.3091933,0.3188552,
+     &0.3287012,0.3389443,0.3486176,0.3593718,0.3712797,
+     &0.3844498,0.3992367,0.4283787,0.4480617,0.4557256,
+     &0.4565090,0.4582297,0.4537602,0.4503480,0.4573702,
+     &0.4677775,0.5004078,0.4921789,0.4687816,0.4652704,
+     &0.4829984,0.5146720,0.5423340,0.5802344,0.5751773,
+     &0.5603711,0.5358865,0.4843219,0.4606548,0.3958648,
+     &0.2311990,0.1309277,0.0689810,0.0473044,0.0357645,
+     &0.0302096,0.0285216,0.0283661,0.0288575,0.0298694,
+     &0.0319034,0.0337869,0.0364643,0.0395041,0.0429032,
+     &0.0455614,0.0464966,0.0454506,0.0435048,0.0429859,
+     &0.0433492,0.0439662,0.0451907,0.0472841,0.0479729,
+     &0.0480491,0.0468699,0.0440733,0.0341798,0.0291907,
+     &0.0265080,0.0251720,0.0254859,0.0266501,0.0271129,
+     &0.0276442,0.0282702,0.0292041,0.0302890,0.0310830,
+     &0.0316508,0.0322409,0.0326373,0.0328552,0.0364115,
+     &0.0346299,0.0332475,0.0322650,0.0299256,0.0276080,
+     &0.0250169,0.0166050,0.0108650,0.0093190/
+       data gicevis/
+     &0.9487292,0.8501517,0.8084917,0.8064129,0.7796354,
+     &0.8265753,0.9093526,0.9365674,0.9241107,0.9169607,
+     &0.9102123,0.9061169,0.9015271,0.8957432,0.8886193,
+     &0.8810557,0.8728880,0.8651341,0.8625306,0.8636174,
+     &0.8661903,0.8671943,0.8675743,0.8681570,0.8683062,
+     &0.8662376,0.8610609,0.8520109,0.8346523,0.8228595,
+     &0.8053397,0.7876619,0.7732534,0.7589003,0.7500000,
+     &0.7413471,0.7345427,0.7344642,0.7366309,0.7405840,
+     &0.7467821,0.7644036,0.7784136,0.7846442,0.7965618,
+     &0.8083032,0.8136568,0.8199432,0.8255728,0.8271201,
+     &0.8275242,0.8268972,0.8249819,0.8245324,0.8223208,
+     &0.8117355,0.8062472,0.8041336/
+       data giceir/
+     &0.8028125,0.8016422,0.8009415,0.7998557,0.7981417,
+     &0.7963558,0.7960360,0.7959067,0.7956044,0.7956340,
+     &0.7950525,0.7882976,0.7844244,0.7777230,0.7753325,
+     &0.7731695,0.7707492,0.7681598,0.7659332,0.7639940,
+     &0.7603320,0.7571294,0.7533165,0.7466281,0.7393790,
+     &0.7345678,0.7292926,0.7235673,0.7182128,0.7126561,
+     &0.7069229,0.7005080,0.6936766,0.6865230,0.6792384,
+     &0.6722496,0.6657850,0.6547473,0.6428918,0.6345846,
+     &0.6255974,0.6109424,0.5946515,0.5828903,0.5715944,
+     &0.5652506,0.5587830,0.5527261,0.5470884,0.5424237,
+     &0.5377048,0.5334029,0.5303385,0.5231666,0.5153511,
+     &0.5072109,0.4983860,0.4895755,0.4802338,0.4751357,
+     &0.4699576,0.4646551,0.4586791,0.4522615,0.4457387,
+     &0.4389421,0.4309897,0.4133823,0.3940207,0.3839259,
+     &0.3734751,0.3533985,0.3436313,0.3339687,0.3244507,
+     &0.3145035,0.2824177,0.2612788,0.2519038,0.2428105,
+     &0.2333613,0.2230495,0.2126012,0.1826718,0.1755434,
+     &0.1677177,0.1589084,0.1445894,0.1393903,0.1275548,
+     &0.1034226,0.0862908,0.0732680,0.0678129,0.0630464,
+     &0.0581228,0.0541460,0.0502856,0.0463469,0.0425679,
+     &0.0408138,0.0391414,0.0376537,0.0370017,0.0370768,
+     &0.0378109,0.0381619,0.0376564,0.0360912,0.0348694,
+     &0.0337249,0.0332462,0.0328845,0.0325112,0.0317704,
+     &0.0309227,0.0299524,0.0289665,0.0271364,0.0258780,
+     &0.0250178,0.0241542,0.0240672,0.0236685,0.0231454,
+     &0.0228576,0.0225964,0.0223764,0.0221073,0.0215770,
+     &0.0209200,0.0198007,0.0188984,0.0183424,0.0170089,
+     &0.0154822,0.0146694,0.0140185,0.0127366,0.0115393,
+     &0.0104058,0.0071931,0.0046216,0.0037448/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.04
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.04	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.04	(revision 2744)
@@ -0,0 +1,199 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 4 MICRONS (Franck Montmessin)
+
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=2.1E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=4.e-6,qrefice=2.1)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1802000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8197000E-05,
+     &.8333000E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680000E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0854822,2.0504486,2.2594056,2.2905577,2.4309553,
+     &2.7394925,2.9738858,1.0479889,1.5827071,1.7473683,
+     &1.8791661,1.9542847,2.0162247,2.0774747,2.1420606,
+     &2.2070080,2.2746674,2.3410056,2.3915425,2.4243052,
+     &2.4465380,2.4664531,2.4864873,2.5070593,2.5285199,
+     &2.5506347,2.5724538,2.5936350,2.6196233,2.6374214,
+     &2.6572831,2.6830637,2.7173599,2.7675186,2.8233521,
+     &2.8801521,2.9195511,2.9341195,2.9565225,2.9903221,
+     &3.0211312,3.1489194,3.2117107,3.1927426,3.1992998,
+     &3.2346768,3.1870882,3.0997686,3.0240328,2.9942008,
+     &2.9638598,2.9380857,2.9347956,2.9330930,2.9452588,
+     &2.9445502,2.8607601,2.7946008/
+       data epiceir/
+     &2.7047184,2.6120941,2.5504249,2.4083079,2.2449776,
+     &2.0963051,2.0678715,2.0435539,2.0233198,2.0134084,
+     &2.0220503,2.0596078,2.0865511,2.1071296,2.1073430,
+     &2.1056444,2.1049262,2.0960135,2.0772534,2.0565253,
+     &2.0132797,1.9785371,1.9572351,1.9217145,1.8724474,
+     &1.8385008,1.8061319,1.7637404,1.7201956,1.6824483,
+     &1.6508880,1.6160781,1.5712145,1.5128543,1.4363862,
+     &1.3483616,1.2774042,1.1795400,1.0840162,1.0261202,
+     &0.9651563,0.8602540,0.7339102,0.6469975,0.6119478,
+     &0.6091090,0.6207982,0.6672347,0.7434798,0.8558041,
+     &0.9740046,1.1170480,1.2233814,1.4233819,1.5659507,
+     &1.6880697,1.7848208,1.8579589,1.8989074,1.9101462,
+     &1.9175409,1.9114984,1.8998538,1.8840935,1.8632078,
+     &1.8316492,1.7857095,1.6508096,1.4954219,1.4151742,
+     &1.3432500,1.2148845,1.1631782,1.1234219,1.0776615,
+     &1.0225006,0.8207632,0.7104143,0.6854881,0.6592867,
+     &0.6146109,0.5515194,0.4878044,0.3406532,0.3125988,
+     &0.2862523,0.2605937,0.2247351,0.2136279,0.1929169,
+     &0.1780802,0.1848382,0.2104575,0.2466988,0.3018862,
+     &0.3613543,0.4261933,0.4881637,0.5562663,0.6325883,
+     &0.6974163,0.7349945,0.7849246,0.8107314,0.8016415,
+     &0.7301529,0.6518985,0.5788133,0.5371399,0.5015947,
+     &0.4561899,0.4281780,0.4014403,0.3523277,0.3134494,
+     &0.2802024,0.2545224,0.2382317,0.2645295,0.2893848,
+     &0.3160831,0.3526863,0.3600670,0.3487748,0.3395592,
+     &0.3284123,0.3151843,0.2968681,0.2714744,0.2435622,
+     &0.2178014,0.1836341,0.1606565,0.1482674,0.1111388,
+     &0.0925535,0.0852699,0.0793584,0.0693137,0.0606733,
+     &0.0536815,0.0376899,0.0234903,0.0179599/
+       data omegicevis/
+     &0.9997557,0.9999997,0.9999922,0.9999319,0.9834057,
+     &0.9697400,0.9889413,0.4170863,0.3839164,0.4148017,
+     &0.4329225,0.4410049,0.4489707,0.4576899,0.4670268,
+     &0.4755634,0.4835813,0.4903115,0.4920676,0.4910262,
+     &0.4890484,0.4880903,0.4873634,0.4862187,0.4850952,
+     &0.4856144,0.4890416,0.4960548,0.5125623,0.5285751,
+     &0.5546114,0.5898761,0.6277213,0.6730058,0.7122949,
+     &0.7517495,0.7888858,0.8171780,0.8476295,0.8725174,
+     &0.8933310,0.9217324,0.9365012,0.9409229,0.9421082,
+     &0.9300490,0.9206304,0.9031980,0.8741305,0.8588691,
+     &0.8445156,0.8310569,0.8304268,0.8275097,0.8349118,
+     &0.8934678,0.9187520,0.9234176/
+       data omegiceir/
+     &0.9195789,0.9130654,0.9084498,0.8848193,0.8432430,
+     &0.7802753,0.7644560,0.7449288,0.7265303,0.7022048,
+     &0.6854911,0.6547806,0.6568891,0.6708937,0.6778638,
+     &0.6815536,0.6886025,0.6981948,0.7035849,0.7054032,
+     &0.7053613,0.6954878,0.6908569,0.6925153,0.6964372,
+     &0.6940646,0.6957520,0.7002053,0.6964250,0.6932367,
+     &0.6907555,0.6961634,0.7047681,0.7167735,0.7274370,
+     &0.7265938,0.7055041,0.6847062,0.6557705,0.6320110,
+     &0.6117497,0.5758710,0.5225218,0.4523725,0.3413817,
+     &0.2842636,0.2313632,0.1900614,0.1697527,0.1697629,
+     &0.1798291,0.1970501,0.2115807,0.2391071,0.2606377,
+     &0.2798113,0.2988472,0.3170983,0.3361139,0.3461500,
+     &0.3563966,0.3671677,0.3774159,0.3888194,0.4014468,
+     &0.4154617,0.4312829,0.4628420,0.4848666,0.4936416,
+     &0.4953880,0.4988511,0.4951004,0.4923347,0.5001683,
+     &0.5114973,0.5471412,0.5407871,0.5179877,0.5151565,
+     &0.5338754,0.5665359,0.5949027,0.6346611,0.6304472,
+     &0.6168448,0.5937971,0.5441191,0.5208242,0.4555555,
+     &0.2795748,0.1643928,0.0891554,0.0618627,0.0471263,
+     &0.0400198,0.0378990,0.0377831,0.0385226,0.0399469,
+     &0.0426608,0.0451856,0.0487382,0.0527340,0.0571690,
+     &0.0606253,0.0618599,0.0605589,0.0581096,0.0574950,
+     &0.0580301,0.0588644,0.0604849,0.0632511,0.0642014,
+     &0.0643580,0.0628783,0.0592713,0.0462856,0.0396805,
+     &0.0361116,0.0343350,0.0347561,0.0363269,0.0369600,
+     &0.0376791,0.0385242,0.0397799,0.0412408,0.0423222,
+     &0.0431063,0.0439387,0.0445039,0.0448168,0.0496150,
+     &0.0473067,0.0454896,0.0441976,0.0410999,0.0380139,
+     &0.0345402,0.0231292,0.0152373,0.0130964/
+       data gicevis/
+     &0.8343501,0.8539270,0.8165237,0.8181057,0.7824335,
+     &0.8121903,0.9116917,0.9469896,0.9339413,0.9264918,
+     &0.9194773,0.9152379,0.9105224,0.9045991,0.8973010,
+     &0.8895398,0.8811479,0.8731629,0.8704250,0.8714981,
+     &0.8741569,0.8753158,0.8759663,0.8770830,0.8782619,
+     &0.8777608,0.8743001,0.8669701,0.8513806,0.8396250,
+     &0.8215540,0.8018272,0.7843039,0.7655624,0.7525014,
+     &0.7398580,0.7289740,0.7259218,0.7254756,0.7268577,
+     &0.7324639,0.7521768,0.7661537,0.7739922,0.7902248,
+     &0.8065580,0.8156578,0.8255079,0.8347661,0.8373555,
+     &0.8387650,0.8389051,0.8371919,0.8368247,0.8344242,
+     &0.8242407,0.8213838,0.8203836/
+       data giceir/
+     &0.8202859,0.8204761,0.8207446,0.8218899,0.8224330,
+     &0.8225752,0.8226243,0.8228495,0.8228806,0.8232125,
+     &0.8228349,0.8170514,0.8134916,0.8073353,0.8051527,
+     &0.8032251,0.8010219,0.7986862,0.7967891,0.7952084,
+     &0.7923052,0.7898931,0.7867939,0.7811755,0.7750518,
+     &0.7710254,0.7664988,0.7615658,0.7570799,0.7523895,
+     &0.7475237,0.7419846,0.7361146,0.7300106,0.7239206,
+     &0.7182872,0.7132332,0.7041776,0.6943774,0.6874813,
+     &0.6799427,0.6676864,0.6541361,0.6444608,0.6352317,
+     &0.6299193,0.6244130,0.6191449,0.6140400,0.6095717,
+     &0.6048778,0.6003752,0.5971281,0.5896495,0.5818252,
+     &0.5736867,0.5649501,0.5561939,0.5469384,0.5418788,
+     &0.5367152,0.5314598,0.5255540,0.5191799,0.5126669,
+     &0.5058801,0.4979611,0.4805868,0.4616396,0.4517272,
+     &0.4414385,0.4213243,0.4114112,0.4014477,0.3914565,
+     &0.3809337,0.3465430,0.3234292,0.3130346,0.3027512,
+     &0.2918884,0.2798819,0.2676042,0.2318030,0.2231267,
+     &0.2135321,0.2026399,0.1847338,0.1781789,0.1631734,
+     &0.1323553,0.1103728,0.0936858,0.0867514,0.0807283,
+     &0.0744888,0.0694563,0.0645469,0.0595233,0.0546962,
+     &0.0524681,0.0503008,0.0483757,0.0475037,0.0475338,
+     &0.0483772,0.0487606,0.0480684,0.0460275,0.0444297,
+     &0.0429296,0.0423003,0.0418224,0.0413265,0.0403650,
+     &0.0392690,0.0380197,0.0367560,0.0344374,0.0328447,
+     &0.0317576,0.0306637,0.0305520,0.0300328,0.0293586,
+     &0.0289865,0.0286487,0.0283637,0.0280170,0.0273389,
+     &0.0265009,0.0250756,0.0239277,0.0232211,0.0215270,
+     &0.0195894,0.0185593,0.0177348,0.0161119,0.0145967,
+     &0.0131628,0.0091000,0.0058481,0.0047391/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.05
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.05	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.05	(revision 2744)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 5 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=1.2E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=5.e-6,qrefice=2.1)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0428143,2.0440466,2.1968415,2.2153285,2.2960923,
+     &2.3659375,2.8867066,1.4714612,1.7771624,1.8997087,
+     &1.9929919,2.0451753,2.0872736,2.1281450,2.1707144,
+     &2.2132783,2.2573934,2.3003073,2.3321264,2.3514304,
+     &2.3634045,2.3739398,2.3842189,2.3941483,2.4037600,
+     &2.4129043,2.4213498,2.4291728,2.4373298,2.4419029,
+     &2.4471161,2.4538815,2.4630349,2.4742622,2.4854822,
+     &2.5033839,2.5176528,2.5136092,2.5134516,2.5263309,
+     &2.5060482,2.6094491,2.6798794,2.6632533,2.7183650,
+     &2.8463554,2.9012349,2.9348140,2.9701750,2.9754398,
+     &2.9789634,2.9716895,2.9712498,2.9672985,2.9738250,
+     &3.0348940,3.1332080,3.1466768/
+       data epiceir/
+     &3.1348512,3.1135170,3.0980451,3.0516498,2.9460745,
+     &2.7977514,2.7647121,2.7296543,2.6980081,2.6652355,
+     &2.6520360,2.6446781,2.6661332,2.7014117,2.7124405,
+     &2.7181728,2.7285180,2.7372139,2.7347012,2.7262812,
+     &2.7032161,2.6736920,2.6591630,2.6453030,2.6226292,
+     &2.5987844,2.5791478,2.5533869,2.5169418,2.4857807,
+     &2.4605293,2.4401815,2.4123871,2.3720129,2.3076501,
+     &2.2154198,2.1208081,1.9929006,1.8554076,1.7655714,
+     &1.6732348,1.5088136,1.2957467,1.1248519,1.0043060,
+     &0.9623911,0.9399940,0.9638529,1.0305194,1.1452191,
+     &1.2687433,1.4178077,1.5291764,1.7348669,1.8864686,
+     &2.0165479,2.1304126,2.2267041,2.3057120,2.3408694,
+     &2.3737895,2.3992765,2.4196458,2.4389904,2.4559703,
+     &2.4664493,2.4680557,2.4285460,2.3429909,2.2869768,
+     &2.2235444,2.0965919,2.0351093,1.9889221,1.9465162,
+     &1.8934352,1.6640973,1.4980435,1.4440260,1.4054043,
+     &1.3498148,1.2628263,1.1601040,0.8777069,0.8140609,
+     &0.7497768,0.6831331,0.5837339,0.5504547,0.4820068,
+     &0.3904156,0.3576854,0.3641066,0.4038780,0.4747776,
+     &0.5532535,0.6412786,0.7272216,0.8227299,0.9304959,
+     &1.0245264,1.0890912,1.1736258,1.2312673,1.2493920,
+     &1.1830822,1.0889487,0.9851518,0.9227560,0.8740039,
+     &0.8118621,0.7720758,0.7351863,0.6589684,0.5922329,
+     &0.5316939,0.4811391,0.4445072,0.4707272,0.5020384,
+     &0.5401840,0.5982011,0.6122363,0.6017624,0.5915391,
+     &0.5768967,0.5586212,0.5319895,0.4920566,0.4455049,
+     &0.4009319,0.3399382,0.2980777,0.2753274,0.2093637,
+     &0.1716706,0.1567566,0.1449283,0.1247388,0.1076142,
+     &0.0937344,0.0625980,0.0375503,0.0283737/
+       data omegicevis/
+     &0.5494931,0.9999998,0.9999893,0.9999013,0.9758908,
+     &0.9520350,0.9813806,0.4902175,0.4373621,0.4608643,
+     &0.4736899,0.4790656,0.4847680,0.4913164,0.4985126,
+     &0.5050762,0.5111622,0.5159741,0.5158814,0.5132105,
+     &0.5098287,0.5077458,0.5059724,0.5035798,0.5004508,
+     &0.4974112,0.4955608,0.4956980,0.4999822,0.5055479,
+     &0.5182787,0.5389499,0.5644807,0.6003360,0.6358722,
+     &0.6744935,0.7115463,0.7406379,0.7754455,0.8046825,
+     &0.8330303,0.8720050,0.8909805,0.8971584,0.8986517,
+     &0.8775966,0.8676537,0.8459433,0.8139567,0.7968134,
+     &0.7813268,0.7666911,0.7660663,0.7625950,0.7705110,
+     &0.8471078,0.8871527,0.8974949/
+       data omegiceir/
+     &0.8977836,0.8945748,0.8924134,0.8738061,0.8388449,
+     &0.7859417,0.7726671,0.7557423,0.7397608,0.7176195,
+     &0.7014517,0.6706539,0.6709267,0.6829631,0.6896477,
+     &0.6933964,0.7002523,0.7101147,0.7166997,0.7200235,
+     &0.7232453,0.7166191,0.7139632,0.7179898,0.7246478,
+     &0.7245268,0.7280882,0.7347864,0.7340991,0.7336202,
+     &0.7333983,0.7403341,0.7504411,0.7639143,0.7766036,
+     &0.7794099,0.7640404,0.7500795,0.7291497,0.7110402,
+     &0.6959369,0.6683127,0.6242461,0.5602421,0.4472759,
+     &0.3841803,0.3222430,0.2709396,0.2443090,0.2429399,
+     &0.2540719,0.2731242,0.2887707,0.3170114,0.3380532,
+     &0.3559635,0.3733418,0.3897057,0.4070157,0.4162955,
+     &0.4258323,0.4362862,0.4465349,0.4581154,0.4711562,
+     &0.4861186,0.5037051,0.5414228,0.5708696,0.5832593,
+     &0.5885317,0.5983726,0.5977412,0.5976148,0.6077798,
+     &0.6216503,0.6655161,0.6657503,0.6467597,0.6461229,
+     &0.6660358,0.6987826,0.7269489,0.7691699,0.7678677,
+     &0.7591690,0.7429094,0.7052954,0.6864988,0.6300915,
+     &0.4480666,0.2989470,0.1806929,0.1314649,0.1033070,
+     &0.0896708,0.0859415,0.0864679,0.0888946,0.0928023,
+     &0.0989119,0.1047399,0.1125751,0.1210458,0.1301845,
+     &0.1373109,0.1401302,0.1382077,0.1341803,0.1336529,
+     &0.1354927,0.1375671,0.1411836,0.1473035,0.1498776,
+     &0.1508872,0.1485618,0.1416996,0.1143930,0.0999223,
+     &0.0919109,0.0879268,0.0889088,0.0927174,0.0943725,
+     &0.0961518,0.0982119,0.1012073,0.1047162,0.1074747,
+     &0.1096113,0.1120945,0.1138527,0.1148487,0.1264241,
+     &0.1220450,0.1182757,0.1155932,0.1089078,0.1020501,
+     &0.0940495,0.0660757,0.0452682,0.0393932/
+       data gicevis/
+     &0.9488561,0.8622694,0.8421568,0.8444307,0.8198477,
+     &0.8025251,0.8924177,0.9702666,0.9557836,0.9476732,
+     &0.9401344,0.9356233,0.9306720,0.9244909,0.9168691,
+     &0.9087364,0.8999177,0.8914922,0.8885176,0.8896047,
+     &0.8924723,0.8939612,0.8951342,0.8972442,0.9004632,
+     &0.9036172,0.9051868,0.9042581,0.8988889,0.8931115,
+     &0.8817939,0.8662245,0.8491337,0.8268852,0.8078062,
+     &0.7890281,0.7693759,0.7548954,0.7426000,0.7296526,
+     &0.7270693,0.7355062,0.7289565,0.7364469,0.7544447,
+     &0.7692665,0.7925164,0.8065700,0.8307455,0.8377706,
+     &0.8427537,0.8454301,0.8436610,0.8436959,0.8396172,
+     &0.8239458,0.8273445,0.8320904/
+       data giceir/
+     &0.8373514,0.8419112,0.8460672,0.8574966,0.8670993,
+     &0.8753594,0.8769836,0.8787410,0.8801410,0.8817471,
+     &0.8821138,0.8790489,0.8760744,0.8707907,0.8689077,
+     &0.8674014,0.8654746,0.8634583,0.8622014,0.8614331,
+     &0.8604119,0.8602243,0.8590601,0.8563642,0.8534315,
+     &0.8516557,0.8491830,0.8464145,0.8443506,0.8419912,
+     &0.8393673,0.8359801,0.8324290,0.8288801,0.8258969,
+     &0.8241146,0.8232231,0.8199658,0.8160087,0.8130227,
+     &0.8095026,0.8040639,0.7986902,0.7954774,0.7927923,
+     &0.7908941,0.7887109,0.7863154,0.7833571,0.7799240,
+     &0.7757225,0.7708758,0.7671629,0.7589634,0.7514880,
+     &0.7439123,0.7363079,0.7288431,0.7213242,0.7172369,
+     &0.7129840,0.7087308,0.7039406,0.6985872,0.6929027,
+     &0.6868637,0.6798444,0.6653367,0.6513552,0.6442967,
+     &0.6372020,0.6223192,0.6148563,0.6068394,0.5979654,
+     &0.5884917,0.5583712,0.5388037,0.5299017,0.5197192,
+     &0.5079988,0.4946542,0.4810905,0.4402598,0.4297767,
+     &0.4177190,0.4033195,0.3778822,0.3680294,0.3443614,
+     &0.2904477,0.2472555,0.2122748,0.1975763,0.1849724,
+     &0.1717572,0.1611385,0.1505969,0.1396510,0.1290195,
+     &0.1242519,0.1192575,0.1148210,0.1125826,0.1120808,
+     &0.1130957,0.1133712,0.1114241,0.1063793,0.1023448,
+     &0.0985022,0.0968736,0.0956093,0.0943082,0.0919330,
+     &0.0892278,0.0861601,0.0830894,0.0777779,0.0741764,
+     &0.0717541,0.0693096,0.0690498,0.0677189,0.0660590,
+     &0.0651242,0.0642725,0.0635431,0.0626790,0.0610575,
+     &0.0590792,0.0557436,0.0530752,0.0514414,0.0475330,
+     &0.0431135,0.0407930,0.0389434,0.0353244,0.0319652,
+     &0.0288019,0.0198931,0.0127889,0.0103672/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.10
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.10	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/aerice.h.10	(revision 2744)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 10 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=0.8E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=1.e-5,qrefice=2.1)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0273049,2.0553651,2.1324184,2.1634929,2.1279089,
+     &2.2649884,2.2698500,2.0945108,1.9718964,2.0290234,
+     &2.0724838,2.0969706,2.1164510,2.1352997,2.1550443,
+     &2.1750197,2.1959615,2.2164886,2.2313924,2.2397768,
+     &2.2443697,2.2484777,2.2524328,2.2560196,2.2593305,
+     &2.2624981,2.2655437,2.2686977,2.2731700,2.2766244,
+     &2.2794294,2.2792618,2.2795415,2.2846086,2.2950807,
+     &2.3121541,2.3191226,2.3011398,2.2936110,2.2905064,
+     &2.2727025,2.3178666,2.3242922,2.3330655,2.3261759,
+     &2.3501878,2.3524554,2.3359809,2.3611195,2.3675768,
+     &2.3733923,2.3748493,2.3755083,2.3754752,2.3756132,
+     &2.3760719,2.4271755,2.3955469/
+       data epiceir/
+     &2.4612815,2.4641292,2.4568148,2.5147929,2.5530331,
+     &2.5705762,2.5728459,2.5721469,2.5704122,2.5617049,
+     &2.5519185,2.5355358,2.5353646,2.5456607,2.5519402,
+     &2.5570130,2.5640745,2.5747874,2.5854921,2.5940452,
+     &2.6071377,2.6118498,2.6188061,2.6403730,2.6669781,
+     &2.6775784,2.6885033,2.7046711,2.7192614,2.7353652,
+     &2.7494493,2.7692459,2.7941475,2.8259096,2.8570986,
+     &2.8766527,2.8766177,2.8746240,2.8368504,2.7997968,
+     &2.7614427,2.6663651,2.4818733,2.2510304,1.9602349,
+     &1.8146522,1.6854036,1.6102730,1.6048870,1.6705624,
+     &1.7576077,1.8667697,1.9497169,2.0947831,2.2019422,
+     &2.2885010,2.3667836,2.4332867,2.4948113,2.5246017,
+     &2.5532246,2.5817444,2.6085849,2.6368368,2.6661391,
+     &2.6972022,2.7322018,2.8090558,2.8837960,2.9189849,
+     &2.9399867,2.9627054,2.9581554,2.9556482,2.9702957,
+     &2.9914343,3.0622592,3.0227430,2.9683504,2.9483757,
+     &2.9425662,2.9222951,2.8775811,2.6872020,2.5973134,
+     &2.4775703,2.3277271,2.0808144,1.9930708,1.7932411,
+     &1.3749977,1.1105362,0.9519616,0.9414314,1.0029964,
+     &1.0884044,1.1978686,1.3110209,1.4375935,1.5781999,
+     &1.7028408,1.8087940,1.9384904,2.0478878,2.1342847,
+     &2.1552835,2.1219630,2.0431452,1.9908499,1.9683007,
+     &1.9452211,1.9265127,1.9173379,1.8556699,1.7696880,
+     &1.6679885,1.5544487,1.4389187,1.3726599,1.3709559,
+     &1.4067492,1.4992472,1.5341307,1.5684799,1.5883886,
+     &1.5933384,1.5931257,1.5828085,1.5444956,1.4816657,
+     &1.4080117,1.2855885,1.1866654,1.1282085,0.9652229,
+     &0.7942671,0.7229686,0.6674553,0.5672902,0.4800995,
+     &0.4058672,0.2359050,0.1220444,0.0873671/
+       data omegicevis/
+     &0.5504259,0.9999992,0.9999804,0.9997928,0.9548051,
+     &0.9126351,0.9571041,0.5516225,0.4932337,0.5069626,
+     &0.5145947,0.5177403,0.5216092,0.5264726,0.5321194,
+     &0.5374104,0.5423936,0.5462285,0.5453517,0.5420842,
+     &0.5383082,0.5359790,0.5340598,0.5316239,0.5284724,
+     &0.5251024,0.5221875,0.5200486,0.5182305,0.5173715,
+     &0.5181928,0.5213331,0.5280793,0.5438614,0.5659477,
+     &0.5936272,0.6220001,0.6461561,0.6788177,0.7087492,
+     &0.7393658,0.7893919,0.8146747,0.8209112,0.8149179,
+     &0.7802355,0.7582701,0.7185146,0.6685008,0.6464375,
+     &0.6278486,0.6119440,0.6113081,0.6078985,0.6163179,
+     &0.7056757,0.7598560,0.7761379/
+       data omegiceir/
+     &0.7759839,0.7669778,0.7639439,0.7364159,0.6928631,
+     &0.6428539,0.6326926,0.6199911,0.6088360,0.5931817,
+     &0.5812727,0.5587846,0.5566773,0.5620723,0.5661795,
+     &0.5687336,0.5732306,0.5805613,0.5866805,0.5907671,
+     &0.5969589,0.5957459,0.5962836,0.6028957,0.6124275,
+     &0.6156567,0.6218417,0.6321118,0.6370467,0.6411974,
+     &0.6447079,0.6546141,0.6691408,0.6888857,0.7109522,
+     &0.7267580,0.7246028,0.7274987,0.7256792,0.7211279,
+     &0.7193315,0.7149989,0.7013977,0.6651995,0.5782154,
+     &0.5228451,0.4628350,0.4070674,0.3747672,0.3693838,
+     &0.3776684,0.3927504,0.4044872,0.4236842,0.4359979,
+     &0.4452721,0.4529338,0.4591291,0.4647588,0.4675789,
+     &0.4704044,0.4736306,0.4769657,0.4809483,0.4857694,
+     &0.4920136,0.5005317,0.5248833,0.5530189,0.5680709,
+     &0.5790995,0.6006733,0.6076213,0.6135495,0.6271621,
+     &0.6453611,0.7096416,0.7277915,0.7180390,0.7214272,
+     &0.7430624,0.7781302,0.8105813,0.8638036,0.8667906,
+     &0.8650255,0.8590664,0.8432143,0.8341830,0.8032821,
+     &0.6736456,0.5327421,0.3821245,0.3023261,0.2506925,
+     &0.2248830,0.2181999,0.2206931,0.2274191,0.2371715,
+     &0.2492834,0.2612511,0.2759819,0.2907880,0.3061035,
+     &0.3189336,0.3259392,0.3269015,0.3248960,0.3278614,
+     &0.3352942,0.3411323,0.3492400,0.3630564,0.3716860,
+     &0.3780700,0.3789840,0.3714330,0.3232819,0.2950966,
+     &0.2783259,0.2697008,0.2717506,0.2816038,0.2868812,
+     &0.2919132,0.2975354,0.3052135,0.3144514,0.3230745,
+     &0.3308428,0.3415695,0.3497911,0.3546669,0.3859474,
+     &0.3858507,0.3821296,0.3797063,0.3712473,0.3611613,
+     &0.3470088,0.2835475,0.2232076,0.2036654/
+       data gicevis/
+     &0.9488313,0.8737755,0.8699134,0.8632549,0.8664746,
+     &0.8654723,0.8639066,0.9867598,0.9718844,0.9635127,
+     &0.9558461,0.9512742,0.9462659,0.9400148,0.9322755,
+     &0.9239700,0.9149156,0.9062143,0.9031032,0.9042205,
+     &0.9072103,0.9088409,0.9101745,0.9125225,0.9162391,
+     &0.9205437,0.9242871,0.9270018,0.9297845,0.9314710,
+     &0.9314710,0.9295564,0.9256747,0.9176448,0.9091137,
+     &0.8993065,0.8857244,0.8742417,0.8625565,0.8491372,
+     &0.8415641,0.8312504,0.8189208,0.8167353,0.8238611,
+     &0.8239230,0.8371644,0.8417686,0.8616024,0.8695507,
+     &0.8752736,0.8796579,0.8782625,0.8792304,0.8746206,
+     &0.8405395,0.8161123,0.8190467/
+       data giceir/
+     &0.8215228,0.8188539,0.8235543,0.8430634,0.8634555,
+     &0.8889333,0.8943647,0.9004826,0.9057037,0.9118157,
+     &0.9151983,0.9186423,0.9165455,0.9109817,0.9085578,
+     &0.9069400,0.9043546,0.9010347,0.8988791,0.8976911,
+     &0.8963661,0.8980653,0.8983047,0.8966079,0.8940747,
+     &0.8933308,0.8913805,0.8891829,0.8896720,0.8898105,
+     &0.8894080,0.8870043,0.8841559,0.8807722,0.8783676,
+     &0.8806533,0.8874398,0.8930346,0.8980618,0.9013399,
+     &0.9038298,0.9075544,0.9122803,0.9171227,0.9216645,
+     &0.9230088,0.9236676,0.9233609,0.9217389,0.9185820,
+     &0.9143328,0.9086544,0.9041949,0.8948452,0.8875402,
+     &0.8805291,0.8743904,0.8689287,0.8643938,0.8621209,
+     &0.8597336,0.8575692,0.8550812,0.8520836,0.8486272,
+     &0.8446994,0.8398250,0.8288277,0.8186790,0.8140771,
+     &0.8110483,0.8041257,0.8015433,0.7980613,0.7919027,
+     &0.7852415,0.7688640,0.7656652,0.7660689,0.7611709,
+     &0.7521669,0.7417981,0.7344227,0.7222472,0.7201254,
+     &0.7173442,0.7131014,0.7038283,0.6999976,0.6905708,
+     &0.6637480,0.6310949,0.5964675,0.5787684,0.5612767,
+     &0.5405343,0.5222011,0.5027949,0.4812989,0.4589987,
+     &0.4483198,0.4369166,0.4259420,0.4192472,0.4154068,
+     &0.4142449,0.4130682,0.4088767,0.3968293,0.3857591,
+     &0.3742922,0.3692816,0.3648685,0.3617240,0.3566430,
+     &0.3508260,0.3437443,0.3361050,0.3206013,0.3090643,
+     &0.3008432,0.2916748,0.2902482,0.2839455,0.2766951,
+     &0.2723766,0.2683532,0.2648085,0.2613389,0.2555560,
+     &0.2486358,0.2367881,0.2269753,0.2207384,0.2052476,
+     &0.1863302,0.1759822,0.1676274,0.1511226,0.1356524,
+     &0.1210628,0.0811427,0.0511400,0.0412876/
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/blackl.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/blackl.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/blackl.F	(revision 2744)
@@ -0,0 +1,20 @@
+      subroutine blackl(blalong,blat,blae)
+c.......................................................................
+      implicit double precision (a-h,o-z)
+c.......................................................................
+c.....donnees de fond
+      sigma=5.6693d-08
+      pi=datan(1.d0)*4.d0
+      c0=2.9979d+08
+      h=6.6262d-34
+      cbol=1.3806d-23
+      rind=1.d0
+      c=c0/rind
+      c1=h*(c**2)
+      c2=h*c/cbol
+c.....fin de donnees de fond
+c.......................................................................
+      blae=2.d0*pi*c1/blalong**5/(dexp(c2/blalong/blat)-1.d0)
+c.......................................................................
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/blendrad.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/blendrad.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/blendrad.F	(revision 2744)
@@ -0,0 +1,60 @@
+      subroutine blendrad(ngrid, nlayer, pplay,
+     &                    zdtsw, zdtlw, zdtnirco2, zdtnlte, dtrad)
+c
+c  Combine radiative tendencies.  LTE contributions (zdtsw and zdtlw)
+c  have been calculated for the first NLAYLTE layers, zdtnirco2 and
+c  zdtnlte have been calculated for all nlayer layers (but zdtnlte may
+c  be zero low down).  zdtlw is phased out in favour of zdtnlte with
+c  height; zdtsw is also phased out to remove possible spurious heating
+c  at low pressures.  The pressure at which the transition occurs and
+c  the scale over which this happens are set in the nlteparams.h file.
+c  Above layer NLAYLTE the tendency is purely the sum of NLTE contributions.
+c  (Note : nlaylte is calculated by "nlthermeq" and stored in common "yomlw.h")
+c  Stephen Lewis 6/2000 FF 
+c
+      implicit none
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "nlteparams.h"
+#include "yomlw.h"
+
+c     Input:
+      integer ngrid, nlayer
+      real pplay(ngrid, nlayer)
+      real zdtlw(ngrid, nlayer)
+      real zdtsw(ngrid, nlayer)
+      real zdtnirco2(ngrid, nlayer)
+      real zdtnlte(ngrid, nlayer)
+c
+c     Output:
+      real dtrad(ngrid, nlayer)
+c
+c     Local:
+      integer l, ig
+      real alpha
+c
+c     This is split into two loops to minimize number of calculations,
+c     but for vector machines it may be faster to perform one big
+c     loop from 1 to nlayer and remove the second loop.
+c
+c     Loop over layers for which zdtsw/lw have been calculated.
+      do l = 1,nlaylte 
+         do ig = 1, ngrid
+c           alpha is actually 0.5*(1+tanh((z-ztrans)/zw))
+c           written here in a simpler form, with z=-ln(p) and zwi=2/zw
+            alpha = 1./(1.+(pplay(ig,l)/ptrans)**zwi)
+            dtrad(ig,l) = (1.-alpha)*(zdtsw(ig,l)+zdtlw(ig,l))
+     &                  + zdtnirco2(ig,l) + alpha*zdtnlte(ig,l)
+         enddo
+      enddo
+c
+c     Faster loop over any remaining layers.
+      do l = nlaylte+1, nlayer
+         do ig = 1, ngrid
+            dtrad(ig,l) = zdtnirco2(ig,l) + zdtnlte(ig,l)
+         enddo
+      enddo
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/calldrag_noro.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/calldrag_noro.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/calldrag_noro.F	(revision 2744)
@@ -0,0 +1,203 @@
+      SUBROUTINE calldrag_noro(ngrid,nlayer,ptimestep,
+     &                 pplay,pplev,pt,pu,pv,pdtgw,pdugw,pdvgw) 
+
+
+
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call SUBROUTINE drag_noro 
+c   Interface for sub-grid scale orographic scheme
+c   The purpose of this subroutine is
+c      1) Make some initial calculation at first call
+c      2) Split the calculation in several sub-grid
+c        ("sub-domain") to save memory and
+c        be able run on a workstation at high resolution
+c        The sub-grid size is defined in dimradmars.h
+c
+c   author:   
+c   ------
+c           Christophe Hourdin/ Francois Forget
+c
+c   input:
+c   ----- 
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   ptimestep             Physical timestep (s)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature  (K)
+c   pu(ngrid,nlayer)       zonal wind (m s-1)
+c   pv(ngrid,nlayer)       meridional wind (m s-1)
+c
+c   output:
+c   -------
+c   pdtgw(ngrid,nlayer)    Temperature trend (K.s-1)
+c   pdugw(ngrid,nlayer)    zonal wind trend  (m.s-2)
+c   pdvgw(ngrid,nlayer)    meridional wind trend  (m.s-2)
+c
+c
+c
+c
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "surfdat.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer  
+
+      real ptimestep
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer), pu(ngrid,nlayer),pv(ngrid,nlayer)
+      REAL pdtgw(ngrid,nlayer), pdugw(ngrid,nlayer),pdvgw(ngrid,nlayer)
+
+
+c
+c    Local variables :
+c    -----------------
+
+      REAL sigtest(nlayermx+1)
+      INTEGER igwd,igwdim,itest(ngridmx)
+
+      INTEGER ndomain
+      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+
+      INTEGER l,ig
+      INTEGER jd,ig0,nd
+
+      REAL zulow(ngridmx),zvlow(ngridmx)
+      REAL zustr(ngridmx),zvstr(ngridmx)
+
+
+      REAL zplev(ndomainsz,nlayermx+1)
+      REAL zplay(ndomainsz,nlayermx)
+      REAL zt(ndomainsz,nlayermx)
+      REAL zu(ndomainsz,nlayermx)
+      REAL zv(ndomainsz,nlayermx)
+      INTEGER zidx(ndomainsz)
+      REAL zzdtgw(ndomainsz,nlayermx)
+      REAL zzdugw(ndomainsz,nlayermx)
+      REAL zzdvgw(ndomainsz,nlayermx)
+
+      logical ll
+
+
+c   local saved variables
+c   ---------------------
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+         do l=1,nlayermx+1
+           sigtest(l)=pplev(1,l)/pplev(1,1)
+         enddo
+         call sugwd(nlayermx,sigtest)
+
+         if (ngridmx .EQ. 1) then
+           if (ndomainsz .NE. 1) then
+             print*
+             print*,'ATTENTION !!!'
+             print*,'pour tourner en 1D, meme pour drag_noro '
+             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+             print*
+             call exit(1)
+           endif
+         endif
+
+         firstcall=.false.
+      END IF
+
+
+c     Starting loop on sub-domain
+c     ----------------------------
+
+      DO jd=1,ndomain
+        ig0=(jd-1)*ndomainsz
+        if (jd.eq.ndomain) then
+          nd=ngridmx-ig0
+        else
+          nd=ndomainsz
+        endif
+
+c    selection des points pour lesquels le shema est actif:
+
+        igwd=0
+        DO ig=ig0+1,ig0+nd
+          itest(ig)=0
+          ll=zstd(ig).gt.50.0
+          IF(ll) then
+            itest(ig)=1
+            igwd=igwd+1
+            zidx(igwd)=ig - ig0
+          ENDIF
+        ENDDO
+        IGWDIM=MAX(1,IGWD)
+
+c       Spliting input variable in sub-domain input variables
+c       ---------------------------------------------------
+
+        do l=1,nlayer+1
+          do ig = 1,nd
+           zplev(ig,l) = pplev(ig0+ig,l)
+          enddo
+        enddo
+
+        do l=1,nlayer
+          do ig = 1,nd
+            zplay(ig,l) = pplay(ig0+ig,l)
+            zt(ig,l) = pt(ig0+ig,l)
+            zu(ig,l) = pu(ig0+ig,l)
+            zv(ig,l) = pv(ig0+ig,l)
+          enddo
+        enddo
+
+
+c       Calling gravity wave and subgrid scale topo parameterization
+c       -------------------------------------------------------------
+
+        call drag_noro (nd,nlayer,ptimestep,zplay,zplev,
+     e            zstd(ig0+1),zsig(ig0+1),zgam(ig0+1),zthe(ig0+1),
+     e            igwd,igwdim,zidx,itest(ig0+1),
+     e            zt, zu, zv,
+     s            zulow(ig0+1),zvlow(ig0+1),zustr(ig0+1),zvstr(ig0+1),
+     s            zzdtgw,zzdugw,zzdvgw)
+
+
+c       Un-spliting output variable from sub-domain input variables
+c       ------------------------------------------------------------
+c       (and devide by ptimestep -> true tendancies)
+
+        do l=1,nlayer
+         do ig = 1,nd
+          pdtgw(ig0+ig,l) = zzdtgw(ig,l)/ptimestep
+          pdugw(ig0+ig,l) = zzdugw(ig,l)/ptimestep
+          pdvgw(ig0+ig,l) = zzdvgw(ig,l)/ptimestep
+         enddo
+        enddo
+
+      ENDDO         !   (boucle jd=1, ndomain)
+
+
+      return
+      end 
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callkeys.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callkeys.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callkeys.h	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../meso_callkeys.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callradite.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callradite.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callradite.F	(revision 2744)
@@ -0,0 +1,365 @@
+      SUBROUTINE callradite(icount,ngrid,nlayer,
+     $     aerosol,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call the main canonic
+c   radiative transfer subroutine "lwmain" et "swmain"
+c   to compute radiative heating and cooling rate and
+c   radiative fluxes to the surface.
+c
+c   These calculations are only valid on the part of the atmosphere
+c   where Local Thermal Equilibrium (NLTE) is verified. In practice
+c   The calculations are only performed for the first "nlaylte"
+c   parameters (nlaylte is calculated by subroutine "nlthermeq"
+c   and stored in common "yomlw.h"
+c      
+c
+c
+c   The purpose of this subroutine is
+c      1) Make some initial calculation at first call
+c      2) Split the calculation in several sub-grid
+c        ("sub-domain") to save memory and
+c        be able run on a workstation at high resolution
+c        The sub-grid size is defined in dimradmars.h
+c       3) call "lwmain" and "swmain"
+c
+c
+c   author:   
+c   ------
+c           Francois Forget / Christophe Hourdin
+c
+c   This version modified to only calculate radiative tendencies over
+c   layers 1..NFLEV (set in dimradmars.h).  Returns zero for higher
+c   layers, if any.
+c   In other routines, nlayermx -> nflev.
+c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
+c   SRL 7/2000
+c
+c   definition:
+c   ----------
+c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
+c   set in dimradmars.h 
+c   Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
+c   set in dimradmars.h 
+c
+c   input:
+c   ----- 
+c   icount                counter of call to subroutine physic by gcm
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c
+c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.  
+c 
+c   albedo (ngrid,2)      hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1 
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c   mu0(ngridmx)           cos of solar zenith angle (=1 when sun at zenith)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature in each layer (K)
+c   tsurf(ngrid)           surface temperature (K)
+c   fract(ngridmx)         day fraction of the time interval 
+c                          =1 during the full day ; =0 during the night
+c   declin                 latitude of subsolar point
+c   dist_sol               sun-Mars distance (AU)
+c   igout                  coordinate of analysed point for debugging
+c
+c  output:
+c  -------
+c dtlw (ngrid,nlayer)       longwave (IR) heating rate (K/s)
+c dtsw(ngrid,nlayer)        shortwave (Solar) heating rate (K/s)
+c fluxsurf_lw(ngrid)        surface downward flux tota LW (thermal IR) (W.m-2)
+c fluxsurf_sw(ngrid,1)      surface downward flux SW for solar band#1 (W.m-2)
+c fluxsurf_sw(ngrid,2)      surface downward flux SW for solar band#2 (W.m-2)
+c
+c fluxtop_lw(ngrid)         outgoing upward flux tota LW (thermal IR) (W.m-2)
+c fluxtop_sw(ngrid,1)       outgoing upward flux SW for solar band#1 (W.m-2)
+c fluxtop_sw(ngrid,2)       outgoing upward flux SW for solar band#2 (W.m-2)
+
+c=======================================================================
+c
+c    Declarations :
+c    -------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "yomlw.h"
+
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER Icount        
+      INTEGER ngrid,nlayer  
+      INTEGER igout
+
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL albedo(ngrid,2),emis(ngrid)
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer)
+      REAL tsurf(ngrid)
+      REAL dist_sol,mu0(ngrid),fract(ngrid)
+      REAL dtlw(ngridmx,nlayermx),dtsw(ngridmx,nlayermx)
+      REAL fluxsurf_lw(ngridmx), fluxtop_lw(ngridmx)
+      REAL fluxsurf_sw(ngridmx,2), fluxtop_sw(ngridmx,2)
+      REAL flux(ngridmx,6)
+
+
+c
+c    Local variables :
+c    -----------------
+
+      INTEGER l,ig, n
+      INTEGER jd,j,ig0,nd
+
+      real  cste_mars ! solar constant on Mars (Wm-2)
+      REAL ptlev(ngridmx,nlayermx+1)
+
+
+      INTEGER ndomain
+      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+
+c     Thermal IR net radiative budget (W m-2)
+      real znetrad(ndomainsz,nflev) 
+
+      real zfluxd_sw(ndomainsz,nflev+1,2)
+      real zfluxu_sw(ndomainsz,nflev+1,2)
+
+
+      REAL zplev(ndomainsz,nflev+1)
+      REAL zztlev(ndomainsz,nflev+1)
+      REAL zplay(ndomainsz,nflev)
+      REAL zt(ndomainsz,nflev)
+      REAL zaerosol(ndomainsz,nflev,naerkind)
+      REAL zalbedo(ndomainsz,2)
+      REAL zdp(ndomainsz,nflev)
+      REAL zdt0(ndomainsz)
+
+      REAL zzdtlw(ndomainsz,nflev)
+      REAL zzdtsw(ndomainsz,nflev)
+      REAL zzflux(ndomainsz,6)
+      real zrmuz
+
+
+c   local saved variables
+c   ---------------------
+
+      real pview(ngridmx)
+      save pview
+      
+      real zco2   ! volume fraction of CO2 in Mars atmosphere
+      DATA zco2/0.95/
+      SAVE zco2
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+         DO ig=1,ngrid
+            pview(ig)=1.66     ! cosecant of viewing angle
+         ENDDO
+         gcp = g/cpp
+         CALL SUAER
+         CALL SULW
+
+         write(*,*) 'Splitting radiative calculations: ',
+     $              ' ngridmx,ngrid,ndomainsz,ndomain',
+     $                ngridmx,ngrid,ndomainsz,ndomain
+         if (ngridmx .EQ. 1) then
+           if (ndomainsz .NE. 1) then
+             print*
+             print*,'ATTENTION !!!'
+             print*,'pour tourner en 1D, '
+             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+             print*
+             call exit(1)
+           endif
+         endif
+         firstcall=.false.
+      END IF
+
+c     Starting loop on sub-domain
+c     ----------------------------
+
+      DO jd=1,ndomain
+        ig0=(jd-1)*ndomainsz
+        if (jd.eq.ndomain) then
+         nd=ngridmx-ig0
+        else
+         nd=ndomainsz
+        endif
+        
+
+c       Spliting input variable in sub-domain input variables
+c       ---------------------------------------------------
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          zplev(ig,l) = pplev(ig0+ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          zplay(ig,l) = pplay(ig0+ig,l)
+          zt(ig,l) = pt(ig0+ig,l)
+
+c         Thickness of each layer (Pa) :
+          zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
+         enddo
+        enddo
+
+        do n=1,naerkind
+          do l=1,nlaylte
+            do ig=1,nd
+              zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
+            enddo
+          enddo
+        enddo
+
+        do j=1,2
+          do ig = 1,nd
+           zalbedo(ig,j) = albedo(ig0+ig,j)
+          enddo
+        enddo
+
+c       Intermediate  levels: (computing tlev)
+c       ---------------------------------------
+c       Extrapolation for the air temperature above the surface
+        DO ig=1,nd
+              zztlev(ig,1)=zt(ig,1)+
+     s        (zplev(ig,1)-zplay(ig,1))*
+     s        (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
+
+              zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
+        ENDDO
+
+        DO l=2,nlaylte
+         DO ig=1,nd
+               zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l))
+         ENDDO
+        ENDDO
+
+        DO ig=1,nd
+           zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
+        ENDDO
+
+
+c       Longwave ("lw") radiative transfer (= thermal infrared)
+c       -------------------------------------------------------
+
+        !PRINT*,'ig0',ig0
+        !PRINT*,'icount',icount
+        !PRINT*,'nd',nd
+        !PRINT*,'nflev',nflev
+        !PRINT*,'zdp',zdp
+        !PRINT*,'zdt0',zdt0
+        !PRINT*,'emis',emis(ig0+1)
+        !PRINT*,'zplev',zplev
+        !PRINT*,'zztlev',zztlev
+        !PRINT*,'zt',zt
+        !PRINT*,'zaerosol',zaerosol
+        !PRINT*,'zzdtlw',zzdtlw
+        !PRINT*,'fluxsurf_lw',fluxsurf_lw(ig0+1)
+        !PRINT*,'fluxtop_lw',fluxtop_lw(ig0+1)
+        !PRINT*,'znetrad',znetrad
+
+        call lwmain (ig0,icount,nd,nflev
+     .        ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
+     .        ,zaerosol,zzdtlw
+     .        ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
+     .        ,znetrad)
+
+c       Shortwave ("sw") radiative transfer (= solar radiation)
+c       -------------------------------------------------------
+c          Mars solar constant (W m-2)
+c          1370 W.m-2 is the solar constant at 1 AU.
+           cste_mars=1370./(dist_sol*dist_sol)
+
+           call swmain ( nd, nflev, 
+     S     cste_mars, zalbedo, 
+     S     mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
+     S     zzdtsw, zfluxd_sw, zfluxu_sw)
+
+c       Un-spliting output variable from sub-domain input variables
+c       ------------------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          dtlw(ig0+ig,l) = zzdtlw(ig,l)
+          dtsw(ig0+ig,l) = zzdtsw(ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          ptlev(ig0+ig,l) = zztlev(ig,l)
+         enddo
+        enddo
+
+        do ig = 1,nd
+          fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
+          fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
+          fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
+          fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
+        enddo
+
+
+      ENDDO         !   (boucle jd=1, ndomain)
+
+
+c     Zero tendencies for any remaining layers between nlaylte and nlayer
+      if (nlayer.gt.nlaylte) then
+         do l = nlaylte+1, nlayer
+            do ig = 1, ngrid
+               dtlw(ig, l) = 0.
+               dtsw(ig, l) = 0.
+            enddo
+         enddo
+      endif
+        
+
+c     Output for debugging if lwrite=T
+c     --------------------------------
+c     Write all nlayer layers, even though only nlaylte layers may have
+c     non-zero tendencies.
+
+         IF(lwrite) THEN
+            PRINT*,'Diagnotique for the radiation'
+            PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
+            PRINT*,albedo(igout,1),emis(igout),mu0(igout),
+     s           fract(igout), fluxsurf_lw(igout),
+     $     fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
+            PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
+            PRINT*,'daysec',daysec
+            DO l=1,nlayer
+               PRINT*,pt(igout,l),ptlev(igout,l),
+     s         pplay(igout,l),pplev(igout,l),
+     s         dtsw(igout,l),dtlw(igout,l)
+            ENDDO
+         ENDIF
+
+
+      return
+      end 
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callsedim.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callsedim.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callsedim.F	(revision 2744)
@@ -0,0 +1,144 @@
+      SUBROUTINE callsedim(ngrid,nlay, ptimestep,
+     $                pplev,zlev, pt,
+     &                pq, pdqfi, pdqsed,pdqs_sed,nq)
+      IMPLICIT NONE
+
+c=======================================================================
+c      Sedimentation of the  Martian aerosols
+c      depending on their density and radius
+c
+c      F.Forget 1999
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "tracer.h"
+#include "callkeys.h"
+
+#include "fisice.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep            ! pas de temps physique (s)
+      REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+      REAL pt(ngrid,nlay)    ! temperature au centre des couches (K)
+      REAL zlev(ngrid,nlay+1) ! altitude at layer boundaries
+
+
+c    Traceurs :
+      integer nq             ! nombre de traceurs
+      real pq(ngrid,nlay,nq)  ! traceur (kg/kg)
+      real pdqfi(ngrid,nlay,nq)  ! tendance avant sedimentation (kg/kg.s-1)
+      real pdqsed(ngrid,nlay,nq) ! tendande due a la sedimentation (kg/kg.s-1)
+      real pdqs_sed(ngrid,nq)    ! flux en surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig, iq
+
+      real zqi(ngridmx,nlayermx)
+      real masse (ngridmx,nlayermx)
+      real epaisseur (ngridmx,nlayermx)
+      real wq(ngridmx,nlayermx+1) 
+c      real dens(ngridmx,nlayermx) ! Mean density of the ice part. accounting for dust core
+      real rfall(ngridmx,nlayermx)
+
+
+      LOGICAL firstcall
+      SAVE firstcall
+      DATA firstcall/.true./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans coefdifv'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+         firstcall=.false.
+      ENDIF
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+c
+c     Calcul preliminaires  de caracteristiques des couches
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c    Masse (kg.m-2), epaisseur(m), temps de traversee (s)  etc...
+
+
+      do  l=1,nlay
+        do ig=1, ngrid
+          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g 
+          epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
+        end do
+      end do
+
+      do iq=1, nq
+
+        if(radius(iq).gt.1.e-9) then   ! no sedim for gaz (defined by radius=0)
+
+c         On "update" la valeur de q apres les autres parametrisations
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+          do l=1,nlay
+            do ig=1,ngrid
+              zqi(ig,l)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+              if (iceparty.and.iq.eq.nq-1) then
+c               On affecte un rayon moyen aux poussieres a chaque altitude du type :
+c               r(z)=r0*exp(-z/H) avec r0=0.8 micron et H=18 km.
+c               ''''''''''''''''''''''''''''''''''''''''''''''''
+                rfall(ig,l)=max( rice(ig,l)*1.5,rdust(ig,l) )
+c modif FranckMM pour ameliorer cycle H2O: rfall= 20 microns
+                rfall(ig,l)=min(rfall(ig,l),1.e-4)
+!mars commente pour l'instant               rfall(ig,l)=20.e-6
+                
+              endif
+            enddo
+          enddo
+
+c         Calcul du transport par sedimentation pour chaque traceur
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(iceparty.and.iq.eq.nq-1) then
+            call newsedim(ngrid,nlay,ngrid*nlay,ptimestep,
+     &      pplev,masse,epaisseur,pt,rfall,rho_ice,zqi,wq)
+          else
+            call newsedim(ngrid,nlay,1,ptimestep,
+     &      pplev,masse,epaisseur,pt,radius(iq),rho_dust,zqi,wq)
+          endif
+
+c         Calcul des tendances
+c         ~~~~~~~~~~~~~~~~~~~~
+          do ig=1,ngrid 
+            if(iceparty.and.iq.eq.nq-1) then
+                pdqs_sed(ig,nq) = wq(ig,1)/ptimestep 
+            else
+                pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+            endif
+          end do
+          DO l = 1, nlay
+            DO ig=1,ngrid
+c	      zqi(ig,l)=max(zqi(ig,l), 1.e-10)
+              pdqsed(ig,l,iq)=(zqi(ig,l)-
+     $        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
+            ENDDO
+          ENDDO
+        endif
+      enddo
+ 
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callsedim2q.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callsedim2q.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/callsedim2q.F	(revision 2744)
@@ -0,0 +1,294 @@
+      SUBROUTINE callsedim2q(ngrid,nlay, ptimestep,
+     $                pplev,zlev, pt,
+     &                pq, pdqfi, pdqsed,pdqs_sed,nq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c      Sedimentation of the  Martian dust 
+c      using method with mass (iq=1) and number(iq=2) mixing ratio
+c
+c      F.Forget 1999
+c
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "tracer.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep             ! pas de temps physique (s)
+      REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+      REAL pt(ngrid,nlay)        ! temperature au centre des couches (K)
+      REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
+
+
+c    Traceurs :
+      integer nq                 ! nombre de traceurs
+      real pq(ngrid,nlay,nq)     ! traceur (kg/kg)
+      real pdqfi(ngrid,nlay,nq)  ! tendance avant sedimentation (kg/kg.s-1)
+      real pdqsed(ngrid,nlay,nq) ! tendande due a la sedimentation (kg/kg.s-1)
+      real pdqs_sed(ngrid,nq)    ! flux en surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+c    Traceurs :
+c    ~~~~~~~~ 
+      INTEGER iq
+      real zq(ngridmx,nlayermx,2)
+      real masse(ngridmx,nlayermx)      ! Layer mass (kg.m-2)
+      real epaisseur(ngridmx,nlayermx)  ! Layer thickness (m)
+      real wq(ngridmx,nlayermx+1)       ! moved tracer mass (kg.m-2)
+      real r0(ngridmx,nlayermx)         ! geometric mean radius (m)
+
+
+c     Discretisation en taille:
+c     ~~~~~~~~~~~~~~
+c       1) Discretisation pour representer la variation de Vitesse de chute
+      integer nr,ir
+      parameter (nr=7)   ! nombre de rayon pour le calcul du transport
+      real rd(nr),qr(ngridmx,nlayermx,nr)
+      real rdi(nr+1)    ! extreme and intermediate radii
+      real Sq(ngridmx,nlayermx)
+      real rdmin,rdmax,rdimin,rdimax
+      data rdmin/1.e-7/
+      data rdmax/30.e-6/
+      data rdimin/1.e-10/
+      data rdimax/1e-4/
+      save rd, rdi
+
+c       2) Sous discretisation pour bien integrer la loi lognormale
+c          (calcul de q pour chaque gamme de rayon rd)
+
+      integer nint, iint   
+      parameter (nint=4)  ! nombre de point entre chaque rayon rdi
+      real rr(nint,nr)
+      save rr
+      
+      real reff(ngridmx,nlayermx,2)  ! for diagnostic only
+      
+
+
+
+      DATA firstcall/.true./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            Print*,'STOP dans coefdifv'
+            Print*,'probleme de dimensions :'
+            Print*,'ngrid  =',ngrid
+            Print*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+         firstcall=.false.
+ 
+         do ir=1,nr
+             rd(ir)= rdmin*(rdmax/rdmin)**(float(ir-1)/float(nr-1))
+c            rd(ir) = rdmin + (float(ir-1)/float(nr-1))*(rdmax-rdmin)
+         end do
+         rdi(1)=rdimin
+         do ir=2,nr
+           rdi(ir)= sqrt(rd(ir-1)*rd(ir))
+         end do
+         rdi(nr+1)=rdimax
+
+         do ir=1,nr
+           do iint=1,nint
+             rr(iint,ir)=
+     &       rdi(ir)*(rdi(ir+1)/rdi(ir))**(float(iint-1)/float(nint-1))
+c             write(*,*) rr(iint,ir)
+           end do
+         end do
+      ENDIF
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c    On "update" la valeur de q apres les autres parametrisations
+c    ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do iq=1,2
+        do l=1,nlay
+          do ig=1,ngrid
+            zq(ig,l,iq)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+          enddo
+        enddo
+      enddo
+
+
+c    Calcul preliminaires  de caracteristiques des couches
+c    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c    Masse (kg.m-2), epaisseur(m), temps de traversee (s)  etc...
+
+      do  l=1,nlay
+        do ig=1, ngrid
+          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
+          epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
+        end do
+      end do
+
+
+c     Calcul de la distribution de taille
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      do  l=1,nlay
+         do ig=1, ngrid
+              r0(ig,l)=
+     &        (r3n_q*zq(ig,l,1)/max(zq(ig,l,min(2,nq)),0.01))**(1./3.)
+              r0(ig,l)=min(max(r0(ig,l),1.e-10),500.e-6)
+         end do
+      end do
+
+      DO iq=1,2  ! LOOP on Mass (iq=1) then Number(iq=2) mixing ratio
+
+c        Calcul du rapport de melange pour les nir tailles considerees
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          call zerophys(ngridmx*nlayermx, Sq)
+          do ir=1,nr
+            do l=1,nlay
+              do ig=1,ngrid
+c                **************** nouvelle methode :
+c                Calcul de q pour chaque gamme de rayon rd
+c                Sous discretisation pour bien integrer la loi lognormale
+c                (Methode des trapezes)
+                 qr(ig,l,ir)=0.5*(rr(2,ir)-rr(1,ir))*
+     &             (rr(1,ir)**(5-3*iq))*
+     &             exp(-(log(rr(1,ir)/r0(ig,l)))**2/(2*varian**2))
+                 do iint=2,nint-1
+                   qr(ig,l,ir)=qr(ig,l,ir) +
+     &             0.5*(rr(iint+1,ir)-rr(iint-1,ir))*
+     &             (rr(iint,ir)**(5-3*iq))*
+     &             exp(-(log(rr(iint,ir)/r0(ig,l)))**2/(2*varian**2))
+                 end do
+                   qr(ig,l,ir)=qr(ig,l,ir) +
+     &             0.5*(rr(nint,ir)-rr(nint-1,ir))*
+     &             (rr(nint,ir)**(5-3*iq))*
+     &             exp(-(log(rr(nint,ir)/r0(ig,l)))**2/(2*varian**2))
+
+c                **************** Methode simple BUGGEE
+c                qr(ig,l,ir)=(rd(ir)**(5-3*iq))*
+c    &           exp( -(log(rd(ir)/r0(ig,l)))**2 / (2*varian**2) )
+c                ******************************
+                 Sq(ig,l)=Sq(ig,l)+qr(ig,l,ir) 
+              enddo
+            enddo
+          enddo
+          do ir=1,nr
+            do l=1,nlay
+              do ig=1,ngrid
+                 qr(ig,l,ir)= zq(ig,l,iq)* qr(ig,l,ir)/Sq(ig,l)
+              enddo
+            enddo
+c          write(123,*) rd(ir)*1.e6, qr(1,10,ir)
+          enddo
+
+c         Calcul du transport par sedimentation pour chaque traceur
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+          call zerophys(ngridmx*nlayermx,zq(1,1,iq))
+          call zerophys(ngridmx*nlayermx,pdqs_sed(1,iq))
+
+c         write(*,*)
+c         if(iq.eq.1) write(*,*) '5 fois  wq(6), wq(7), q(6)'
+          
+          do ir=1,nr
+             call newsedim(ngrid,nlay,1,ptimestep,
+     &       pplev,masse,epaisseur,pt,rd(ir),rho_dust,qr(1,1,ir),wq)
+
+c            Calcul des tendances
+c            ~~~~~~~~~~~~~~~~~~~~
+             do ig=1,ngrid
+               pdqs_sed(ig,iq) = pdqs_sed(ig,iq) + wq(ig,1)/ptimestep
+             end do
+             DO l = 1, nlay
+               DO ig=1,ngrid
+                 zq(ig,l,iq)=zq(ig,l,iq)+qr(ig,l,ir)
+               ENDDO
+             ENDDO
+c         if(iq.eq.1) write(*,*) 'callsed: wq(6), wq(7), q(6)',
+c    &               wq(1,6),wq(1,7),qr(1,6,ir)
+
+c               if(iq.eq.1)write(*,*)'R=', rd(ir)*1.e6
+c               write(*,*)
+          enddo
+
+          do l = 1, nlay
+            do ig=1,ngrid
+              pdqsed(ig,l,iq)=(zq(ig,l,iq)-
+     $        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
+            enddo
+          enddo
+
+c     ***** Diagnostique *****************
+c         call zerophys(ngridmx*nlayermx,reff(1,1,iq))
+c         do ir=1,nr
+c           do l = 1, nlay
+c             do ig=1,ngrid
+c              if(iq.eq.1) then 
+c               reff(ig,l,iq)=reff(ig,l,iq) + qr(ig,l,ir)/rd(ir)
+c              else
+c               reff(ig,l,iq)=reff(ig,l,iq) + qr(ig,l,ir)*log(rd(ir))
+c              endif
+c             enddo
+c           enddo
+c         enddo
+c         do l = 1, nlay
+c           do ig=1,ngrid
+c            if(iq.eq.1) then 
+c             reff(ig,l,iq)=zq(ig,l,iq)/reff(ig,l,iq)
+c            else
+c             reff(ig,l,iq)=exp(reff(ig,l,iq)/zq(ig,l,iq))
+c            endif
+c           enddo
+c         enddo
+c     **** FIN Diagnostique *****************
+
+      enddo  ! end loop on iq=1,2
+
+
+
+c ********************************************
+c     Diagnostique
+c     if(ngrid.eq.1) then
+c      do  l=1,nlay
+c       do ig=1, ngrid
+c         r0(ig,l)=
+c    &    (r3n_q*zq(ig,l,1)/max(zq(ig,l,min(2,nq)),0.01))**(1./3.)
+c         r0(ig,l)=min(max(r0(ig,l),1.e-10),500.e-6)
+c
+c         write(*,*)'l,r0, r02 ', l, r0(ig,l),reff(ig,l,1)*0.3626
+c    &    ,reff(ig,l,2)
+c    &    ,r0(ig,l)/(reff(ig,l,1)*0.3626) 
+c
+c       end do
+c      end do
+c      CALL writeg1d(ngrid,nlay,r0,'r0','m')
+c     end if
+c ********************************************
+
+
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/co2snow.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/co2snow.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/co2snow.F	(revision 2744)
@@ -0,0 +1,144 @@
+      SUBROUTINE co2snow (ngrid,nlayer,ptimestep,
+     &          emisref,condsub,pplev,
+     &        pcondicea,pcondices,pfallice,pemisurf)
+
+       IMPLICIT NONE
+
+
+c*****WRF: ligne trop longue
+
+c=======================================================================
+c     Program for simulate the impact of the CO2 snow fall on
+c     the surface infrared emission (emissivity)  and on 
+c     the airborne dust
+c     F.Forget 1996
+c=======================================================================
+
+c Declarations
+c ------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "surfdat.h"
+#include "callkeys.h"
+
+c     input
+c     -----
+
+      INTEGER ngrid,nlayer
+      REAL ptimestep , emisref(ngrid) ! grd or ice  emissivity without snow
+      logical condsub(ngrid)
+
+      REAL pplev(ngrid,nlayer+1)
+      REAL pcondicea(ngrid,nlayer), pcondices(ngrid)
+      REAL pfallice(ngrid,nlayer+1)
+
+c     output
+c     ------
+
+      REAL pemisurf(ngrid)
+
+c     local
+c     -----
+      integer ig , l , icap
+
+      REAL zdemisurf ,dtemis
+      REAL sumdaer
+
+c     saved
+c     -----
+      REAL Kscat(2), scaveng
+      LOGICAL firstcall
+      SAVE firstcall
+      save Kscat , scaveng
+      DATA firstcall/.true./
+
+c --------------
+c Initialisation
+c --------------
+
+      if (firstcall) then
+
+c   Kscat : coefficient for decreasing the surface emissivity
+c           =(0.001/3.)*alpha/iceradius ,
+c           with 0.3< alpha < 0.6, set to 0.45 (coeff from emis = f (tau))
+c           and iceradius the mean radius of the
+c           scaterring particles  (200.e-6<iceradius<10.e-6)
+
+            Kscat(1)=(0.001/3.)*0.45/iceradius(1)
+            Kscat(2)=(0.001/3.)*0.45/iceradius(2)
+
+c          Scavenging Ratio (dust concentration in the air / in the snow)
+           scaveng = 100.0
+           
+c          Collision Scavenging coefficient  (m2.kg-1)
+c          Csca  = 2.3  ! not used yet !!!!!!!!!!!
+           firstcall = .false.
+
+      end if
+
+
+c     LOOP on grid points
+c     -------------------
+      do ig=1,ngrid 
+         if (condsub(ig)) then
+
+c         IF (scavenging) then
+c          Airborne Dust 
+c          -------------
+c          sumdaer=0.
+c          do l=nlayer, 1, -1
+c             pdaerosol(ig,l)= -paerosol(ig,l,1)*
+c    &              (1-exp(-scaveng*pcondicea(ig,l)*ptimestep*g/
+c    &               (pplev(ig,l)-pplev(ig,l+1))))/ptimestep  
+
+c    &           - Csca*paerosol(ig,l,1) ! Scavenging by collision
+c    &           * 0.5*(pfallice(ig,l)) ! not included
+
+c             test to avoid releasing to much dust when subliming:
+c             if(pdaerosol(ig,l).gt.-sumdaer)pdaerosol(ig,l)=-sumdaer 
+c             sumdaer=sumdaer + pdaerosol(ig,l)
+
+c            if (-pdaerosol(ig,l)*ptimestep.gt.paerosol(ig,l,1)) then
+c                write(*,*) 'ds co2snow: aerosol < 0.0 !!!'
+c                write(*,*) 'ig =' , ig
+c            end if
+c          end do
+c         END IF
+
+c          Surface emissivity
+c          ------------------
+c   dtemis: Time scale for increasing the ice emissivity
+
+           IF(ig.GT.ngrid/2+1) THEN
+              icap=2
+           ELSE
+              icap=1
+           ENDIF
+
+           zdemisurf = 
+     &    (emisref(ig)-pemisurf(ig))/(dtemisice(icap)*daysec) 
+c Using directly the diferential equation:
+c    &       -Kscat(icap)*emisref(ig)*
+c    &      (pemisurf(ig)/emisref(ig))**4 *pfallice(ig,1) 
+c Using an integrated form for numerical safety instead
+     & +(emisref(ig)* ((pemisurf(ig)/emisref(ig))**(-3)+3.*Kscat(icap)*
+     & pfallice(ig,1)*ptimestep)**(-1/3.) -pemisurf(ig))/ptimestep   
+
+
+           pemisurf(ig) = pemisurf(ig) + zdemisurf*ptimestep 
+
+           if (pemisurf(ig).lt.0.1) then
+                 write(*,*) 'ds co2snow: emis < 0.1 !!!'
+                 write(*,*) 'ig =' , ig
+                 write(*,*)'pemisurf(ig)',pemisurf(ig)
+                 write(*,*) 'zdemisurf*ptimestep',zdemisurf*ptimestep
+           end if
+         else
+           pemisurf(ig) = emisref(ig)
+         end if
+      end do
+
+      return
+      end 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comcstfi.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comcstfi.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comcstfi.h	(revision 2744)
@@ -0,0 +1,8 @@
+c-----------------------------------------------------------------------
+c INCLUDE comcstfi.h
+
+      COMMON/comcstfi/
+     * pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+
+      REAL pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comdiurn.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comdiurn.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comdiurn.h	(revision 2744)
@@ -0,0 +1,5 @@
+      COMMON/comdiurn/ldiurn,
+     s     sinlon(ngridmx),coslon(ngridmx),
+     s     sinlat(ngridmx),coslat(ngridmx)
+      REAL sinlon,coslon,sinlat,coslat
+      LOGICAL ldiurn
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comg1d.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comg1d.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comg1d.h	(revision 2744)
@@ -0,0 +1,59 @@
+c.......................................................................
+c  le COMMON pour GRADS-1D
+c  (Utilise pour les sorties format Grads dans la version 1D du modele)
+c
+c  on peut se dire : "on ne sauvera pas plus de 1000 variables ... hein ?"
+c
+      INTEGER g1d_nvarmx
+      PARAMETER(g1d_nvarmx=1000)
+c
+c         * g1d_nlayer     ---> nombre de couches verticales
+c         * g1d_nomfich    ---> nom du fichier grads
+c         * g1d_unitfich   ---> code du fichier grads
+c         * g1d_nomctl     ---> nom du fichier ctl
+c         * g1d_unitctl    ---> code du fichier ctl
+c         * g1d_premier    ---> variable logique pour dire si le fichier
+c                               est deja ouvert
+c         * g1d_irec       ---> indice de derniere ecriture
+c         * g1d_nvar       ---> nombre de variables deja definies a la
+c                               derniere ecriture
+c         * g1d_nomvar     ---> noms des vecteurs existants
+c         * g1d_dimvar     ---> taille des vecteurs
+c         * g1d_titrevar   ---> titres des vecteurs
+c         * g1d_tmp1       ---> caractere 
+c         * g1d_tmp2       ---> caractere 
+c
+      INTEGER g1d_nlayer
+      CHARACTER*100 g1d_nomfich
+      INTEGER g1d_unitfich
+      CHARACTER*100 g1d_nomctl
+      INTEGER g1d_unitctl
+      LOGICAL g1d_premier
+      LOGICAL g2d_premier
+      INTEGER g1d_irec
+      INTEGER g2d_irec
+      INTEGER g2d_appel
+      INTEGER g1d_nvar
+      CHARACTER*100 g1d_nomvar
+      INTEGER g1d_dimvar
+      CHARACTER*100 g1d_titrevar
+      CHARACTER*100 g1d_tmp1,g1d_tmp2
+c
+      COMMON/COMG1DI/g1d_nlayer
+     &             ,g1d_unitfich
+     &             ,g1d_unitctl
+     &             ,g1d_irec
+     &             ,g2d_irec
+     &             ,g2d_appel
+     &             ,g1d_nvar
+      COMMON/COMG1DC/g1d_dimvar(0:g1d_nvarmx)
+     &             ,g1d_nomfich
+     &             ,g1d_nomctl
+     &             ,g1d_nomvar(0:g1d_nvarmx)
+     &             ,g1d_titrevar(0:g1d_nvarmx)
+     &             ,g1d_tmp1
+     &             ,g1d_tmp2
+      COMMON/COMG1DL/g1d_premier
+     &             ,g2d_premier
+c
+c.......................................................................
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comgeomfi.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comgeomfi.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comgeomfi.h	(revision 2744)
@@ -0,0 +1,4 @@
+      COMMON/comgeomfi1/long(ngridmx),lati(ngridmx),area(ngridmx)
+      COMMON/comgeomfi2/ totarea
+
+      REAL long,lati,area,totarea
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comorbit.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comorbit.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comorbit.h	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'comorbit.h'
+
+      COMMON/comorbit/aphelie,periheli,year_day,
+     $       peri_day,timeperi,obliquit,
+     $       e_elips,p_elips,unitastr,pi
+
+      REAL aphelie,periheli,year_day,
+     $  peri_day,timeperi,obliquit,
+     $  e_elips,p_elips,unitastr,pi
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comsaison.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comsaison.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/comsaison.h	(revision 2744)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c   INCLUDE saison.h
+
+      COMMON/saison/callsais,isaison,dist_sol,declin,
+     $             mu0(ngridmx),fract(ngridmx)
+
+      INTEGER isaison
+      LOGICAL callsais
+      REAL dist_sol,declin,mu0,fract
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/convadj.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/convadj.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/convadj.F	(revision 2744)
@@ -0,0 +1,346 @@
+      SUBROUTINE convadj(ngrid,nlay,nq,ptimestep,
+     S                   pplay,pplev,ppopsk,
+     $                   pu,pv,ph,pq,
+     $                   pdufi,pdvfi,pdhfi,pdqfi,
+     $                   pduadj,pdvadj,pdhadj,
+     $                   pdqadj)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   ajustement convectif sec
+c   on ajoute les tendances pdhfi au profil pdh avant l'ajustement
+c   SPECIAL VERSION : if one tracer is CO2, take into account the
+c   Molecular mass variation (e.g. when CO2 condense) to trigger
+c   convection  F. Forget 01/2005
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+
+
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL ph(ngrid,nlay),pdhfi(ngrid,nlay),pdhadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1),ppopsk(ngrid,nlay)
+      REAL pu(ngrid,nlay),pdufi(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvfi(ngrid,nlay),pdvadj(ngrid,nlay)
+
+c    Traceurs :
+      integer nq
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq)
+      real pdqadj(ngrid,nlay,nq)
+
+
+c   local:
+c   ------
+
+      INTEGER ig,i,l,l1,l2,jj
+      INTEGER jcnt, jadrs(ngridmx)
+
+      REAL sig(nlayermx+1),sdsig(nlayermx),dsig(nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zh(ngridmx,nlayermx)
+      REAL zu2(ngridmx,nlayermx),zv2(ngridmx,nlayermx)
+      REAL zh2(ngridmx,nlayermx), zhc(ngridmx,nlayermx)
+      REAL zhm,zsm,zum,zvm,zalpha,zhmc
+      
+
+c    Traceurs :
+      INTEGER iq,ico2
+      save ico2
+      REAL zq(ngridmx,nlayermx,nqmx), zq2(ngridmx,nlayermx,nqmx)
+      REAL zqm(nqmx),zqco2m
+      real m_co2, m_noco2, A , B
+      save A, B
+c    Temporaire (for diagnostic)
+c      REAL diag_alpha(ngridmx)
+
+
+      LOGICAL vtest(ngridmx),down,firstcall
+      save firstcall
+      data firstcall/.true./
+
+      EXTERNAL SCOPY
+c
+c-----------------------------------------------------------------------
+c   initialisation:
+c   ---------------
+c
+      IF (firstcall) THEN 
+        IF(ngrid.NE.ngridmx) THEN
+           PRINT*
+           PRINT*,'STOP dans convadj'
+           PRINT*,'ngrid    =',ngrid
+           PRINT*,'ngridmx  =',ngridmx
+        ENDIF
+        ico2=0
+        if (tracer) then
+c          Prepare Special treatment if one of the tracer is CO2 gas
+c           write(*,*) "convadj: nqmx=",nqmx
+           do iq=1,nqmx
+c           write(*,*) "convadj: iq=",iq," noms(iq)=",noms(iq)
+             if (noms(iq).eq."co2") then
+                ico2=iq
+                m_co2 = 44.01E-3  ! CO2 molecular mass (kg/m-3)   
+                m_noco2 = 33.37E-3  ! Non condensible mol mass (kg/m-3)   
+c               Compute A and B coefficient use to compute
+c               mean molecular mass Mair defined by
+c               1/Mair = q(ico2)/m_co2 + (1-q(ico2))/m_noco2
+c               1/Mair = A*q(ico2) + B
+                A =(1/m_co2 - 1/m_noco2)
+                B=1/m_noco2
+             end if
+           enddo
+           firstcall=.false.
+        endif
+      ENDIF
+
+c
+c-----------------------------------------------------------------------
+c   detection des profils a modifier:
+c   ---------------------------------
+c   si le profil est a modifier
+c   (i.e. ph(niv_sup) < ph(niv_inf) )
+c   alors le tableau "vtest" est mis a .TRUE. ;
+c   sinon, il reste a sa valeur initiale (.FALSE.)
+c   cette operation est vectorisable
+c   On en profite pour copier la valeur initiale de "ph"
+c   dans le champ de travail "zh"
+
+
+      DO l=1,nlay
+         DO ig=1,ngrid
+            zh(ig,l)=ph(ig,l)+pdhfi(ig,l)*ptimestep
+            zu(ig,l)=pu(ig,l)+pdufi(ig,l)*ptimestep
+            zv(ig,l)=pv(ig,l)+pdvfi(ig,l)*ptimestep
+         ENDDO
+      ENDDO
+
+      if(tracer) then      
+        DO iq =1, nq
+         DO l=1,nlay
+           DO ig=1,ngrid
+              zq(ig,l,iq)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+           ENDDO
+         ENDDO
+        ENDDO
+      end if
+
+
+      CALL scopy(ngrid*nlay,zh,1,zh2,1)
+      CALL scopy(ngrid*nlay,zu,1,zu2,1)
+      CALL scopy(ngrid*nlay,zv,1,zv2,1)
+      CALL scopy(ngrid*nlay*nq,zq,1,zq2,1)
+
+      DO ig=1,ngrid
+        vtest(ig)=.FALSE.
+      ENDDO
+c
+      if (ico2.ne.0) then
+c        Special case if one of the tracer is CO2 gas
+c         write(*,*) "convadj: ico2=",ico2," nqmx=",nqmx
+         DO l=1,nlay
+           DO ig=1,ngrid
+             zhc(ig,l) = zh2(ig,l)*(A*zq2(ig,l,ico2)+B)
+           ENDDO
+         ENDDO
+       else
+          CALL scopy(ngrid*nlay,zh2,1,zhc,1)
+       end if
+
+       
+
+      DO l=2,nlay
+        DO ig=1,ngrid
+          IF(zhc(ig,l).LT.zhc(ig,l-1)) vtest(ig)=.TRUE.
+        ENDDO
+      ENDDO
+c
+CRAY  CALL WHENNE(ngrid, vtest, 1, 0, jadrs, jcnt)
+      jcnt=0
+      DO ig=1,ngrid
+         IF(vtest(ig)) THEN
+            jcnt=jcnt+1
+            jadrs(jcnt)=ig
+         ENDIF
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c  Ajustement des "jcnt" profils instables indices par "jadrs":
+c  ------------------------------------------------------------
+c
+      DO jj = 1, jcnt
+c
+          i = jadrs(jj)
+c
+c   Calcul des niveaux sigma sur cette colonne
+          DO l=1,nlay+1
+            sig(l)=pplev(i,l)/pplev(i,1)
+          ENDDO
+         DO l=1,nlay
+            dsig(l)=sig(l)-sig(l+1)
+            sdsig(l)=ppopsk(i,l)*dsig(l)
+         ENDDO
+          l2 = 1
+c
+c      -- boucle de sondage vers le haut
+c
+cins$     Loop
+          DO
+c
+            l2 = l2 + 1
+c
+cins$       Exit
+            IF (l2 .GT. nlay) EXIT
+c
+            IF (zhc(i, l2) .LT. zhc(i, l2-1)) THEN
+c
+c          -- l2 est le niveau le plus haut de la colonne instable
+c
+              l1 = l2 - 1
+              l  = l1
+              zsm = sdsig(l2)
+              zhm = zh2(i, l2)
+              if(ico2.ne.0) zqco2m = zq2(i,l2,ico2)
+c
+c          -- boucle de sondage vers le bas
+c
+cins$         Loop
+              DO
+c
+                zsm = zsm + sdsig(l)
+                zhm = zhm + sdsig(l) * (zh2(i, l) - zhm) / zsm
+                if(ico2.ne.0) then
+                  zqco2m = 
+     &            zqco2m + sdsig(l) * (zq2(i,l,ico2) - zqco2m) / zsm
+                  zhmc = zhm*(A*zqco2m+B)
+                else 
+                  zhmc = zhm
+                end if
+c
+c            -- doit on etendre la colonne vers le bas ?
+c
+c_EC (M1875) 20/6/87 : AND -> AND THEN
+c
+                down = .FALSE.
+                IF (l1 .NE. 1) THEN    !--  and then
+                  IF (zhmc .LT. zhc(i, l1-1)) THEN
+                    down = .TRUE.
+                  END IF
+                END IF
+c
+                IF (down) THEN
+c
+                  l1 = l1 - 1
+                  l  = l1
+c
+                ELSE
+c
+c              -- peut on etendre la colonne vers le haut ?
+c
+cins$             Exit
+                  IF (l2 .EQ. nlay) EXIT
+c
+cins$             Exit
+                  IF (zhc(i, l2+1) .GE. zhmc) EXIT
+c
+                  l2 = l2 + 1
+                  l  = l2
+c
+                END IF
+c
+cins$         End Loop
+              ENDDO
+c
+c          -- nouveau profil : constant (valeur moyenne)
+c
+              zalpha=0.
+              zum=0.
+              zvm=0.
+              do iq=1,nq
+                zqm(iq) = 0.
+              end do
+              DO l = l1, l2
+                if(ico2.ne.0) then
+                  zalpha=zalpha+
+     &            ABS(zhc(i,l)/(A+B*zqco2m) -zhm)*dsig(l)
+                else
+                  zalpha=zalpha+ABS(zh2(i,l)-zhm)*dsig(l)
+                endif
+                zh2(i, l) = zhm
+                zum=zum+dsig(l)*zu(i,l)
+                zvm=zvm+dsig(l)*zv(i,l)
+                do iq=1,nq
+                   zqm(iq) = zqm(iq)+dsig(l)*zq(i,l,iq)
+                end do
+              ENDDO
+              zalpha=zalpha/(zhm*(sig(l1)-sig(l2+1)))
+              zum=zum/(sig(l1)-sig(l2+1))
+              zvm=zvm/(sig(l1)-sig(l2+1))
+              do iq=1,nq
+                 zqm(iq) = zqm(iq)/(sig(l1)-sig(l2+1))
+              end do
+
+              IF(zalpha.GT.1.) THEN
+c                PRINT*,'WARNING dans convadj zalpha=',zalpha
+c         STOP
+                 zalpha=1.
+              ELSE
+c                IF(zalpha.LT.0.) STOP
+                 IF(zalpha.LT.1.e-4) zalpha=1.e-4
+              ENDIF
+
+              DO l=l1,l2
+                 zu2(i,l)=zu2(i,l)+zalpha*(zum-zu2(i,l))
+                 zv2(i,l)=zv2(i,l)+zalpha*(zvm-zv2(i,l))
+                 do iq=1,nq
+                   zq2(i,l,iq)=zq2(i,l,iq)+zalpha*(zqm(iq)-zq2(i,l,iq)) 
+c                  zq2(i,l,iq)=zqm(iq)
+                 end do
+              ENDDO
+c              diag_alpha(i)=zalpha  !temporaire
+ 
+              l2 = l2 + 1
+c
+            END IF
+c
+cins$     End Loop
+          ENDDO
+c
+      ENDDO
+c
+      DO l=1,nlay
+        DO ig=1,ngrid
+          pdhadj(ig,l)=(zh2(ig,l)-zh(ig,l))/ptimestep
+          pduadj(ig,l)=(zu2(ig,l)-zu(ig,l))/ptimestep
+          pdvadj(ig,l)=(zv2(ig,l)-zv(ig,l))/ptimestep
+c         pdhadj(ig,l)=0.
+c         pduadj(ig,l)=0.
+c         pdvadj(ig,l)=0.
+        ENDDO
+      ENDDO
+
+      if(tracer) then 
+        do iq=1, nq
+          do  l=1,nlay
+            do ig=1, ngrid
+              pdqadj(ig,l,iq)=(zq2(ig,l,iq)-zq(ig,l,iq))/ptimestep 
+            end do 
+          end do 
+        end do 
+      end if
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/cvmgp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/cvmgp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/cvmgp.F	(revision 2744)
@@ -0,0 +1,14 @@
+      FUNCTION cvmgp(x1,x2,x3)
+      IMPLICIT NONE
+
+      REAL x1,x2,x3,cvmgp
+
+      IF(x3.ge.0) then 
+        cvmgp=x1
+      ELSE
+        cvmgp=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/cvmgt.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/cvmgt.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/cvmgt.F	(revision 2744)
@@ -0,0 +1,15 @@
+      FUNCTION cvmgt(x1,x2,l)
+      IMPLICIT NONE
+
+      REAL x1,x2,cvmgt
+      LOGICAL l
+
+      IF(l) then 
+        cvmgt=x1
+      ELSE
+        cvmgt=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/datafile.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/datafile.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/datafile.h	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../meso_datafile.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/datareadnc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/datareadnc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/datareadnc.F	(revision 2744)
@@ -0,0 +1,291 @@
+c=======================================================================
+      SUBROUTINE datareadnc(relief,phisinit,alb,ith,
+     .                    zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c
+c
+c   Author: F. Hourdin      01/1997
+c   -------
+c
+c   Object: To read data from Martian surface to use in a GCM
+c   ------                from NetCDF file "surface.nc"
+c
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c     Outputs:
+c     --------
+c
+c=======================================================================
+c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
+c
+c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
+c
+c   360 valeurs en longitude (de -179.5 a 179.5)
+c   180 valeurs en latitudes (de 89.5 a -89.5)
+c
+c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
+c
+c   Il faut donc que ces donnees soient au format grille scalaire
+c               (imold+1 jmold+1)
+c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
+c
+c   On prend imd (d pour donnees!) 
+c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
+c                   (rlonud de -179 a -181)
+c           jmd = 179 
+c                   (rlatvd de 89 a -89)
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comconst.h"
+#include "netcdf.inc"
+#include "datafile.h"
+
+c=======================================================================
+c   Declarations:
+C=======================================================================
+
+      INTEGER    imd,jmd,imdp1,jmdp1
+      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
+
+      INTEGER    iimp1
+      parameter    (iimp1=iim+1-1/iim)
+
+      CHARACTER relief*3
+
+      REAL        zdata(imd*jmdp1)
+      REAL        zdataS(imdp1*jmdp1)
+      REAL        pfield(iimp1*jjp1)
+
+      REAL        alb(iimp1*jjp1)
+      REAL        ith(iimp1*jjp1)
+      REAL        phisinit(iimp1*jjp1)
+
+      REAL        zmea(imdp1*jmdp1)
+      REAL        zstd(imdp1*jmdp1)
+      REAL        zsig(imdp1*jmdp1)
+      REAL        zgam(imdp1*jmdp1)
+      REAL        zthe(imdp1*jmdp1)
+
+      INTEGER   lnblnk, ierr
+      EXTERNAL    lnblnk
+
+      INTEGER   unit,nvarid
+
+      INTEGER    i,j,k
+
+      INTEGER klatdat,ngridmxgdat
+      PARAMETER (klatdat=180,ngridmxgdat=360)
+
+c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
+
+      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
+      REAL rlonud(imdp1),rlatvd(jmd)
+
+      CHARACTER*20 string
+      DIMENSION string(4)
+
+      CHARACTER*80    file
+
+#include "lmdstd.h"
+#include "fxyprim.h"
+
+      pi=2.*ASIN(1.)
+
+c=======================================================================
+c    rlonud, rlatvd
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF des donnees latitude et longitude
+c-----------------------------------------------------------------------
+      write(*,*) 'ouverture du fichier surface.nc'
+
+      ierr = NF_OPEN (datafile(1:lnblnk(datafile))//'/surface.nc',
+     &  NF_NOWRITE,unit)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(*,*)'Error : cannot open file surface.nc '
+        write(*,*)'(in phymars/datareadnc.F)'
+        write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary surface.nc (and other datafiles)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+        CALL ABORT
+      ENDIF
+
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
+#endif
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
+#endif
+
+c-----------------------------------------------------------------------
+c    Passage au format boites scalaires
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c       longitude(imd)        -->      rlonud(imdp1) 
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do i=1,imd 
+          rlonud(i)=(longitude(i)+.5)*pi/180.
+      enddo
+
+c Repetition de la valeur im+1
+      rlonud(imdp1)=rlonud(1) + 2*pi
+
+c-----------------------------------------------------------------------
+c        latitude(jmdp1)         -->        rlonvd(jmd)
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do j=1,jmd 
+          rlatvd(j)=(latitude(j)-.5)*pi/180.
+      enddo
+
+c=======================================================================
+c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
+c=======================================================================
+
+      string(1) = 'albedo'
+      string(2) = 'thermal'
+      if (relief.ne.'pla') then
+        write(*,*) ' La topographie est celle de MOLA'
+        relief = 'MOL'
+          string(3) = 'z'//relief
+      else
+          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
+                            ! remise a 0 derriere
+      endif
+      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
+ 
+
+      DO k=1,4
+          write(*,*) 'string',k,string(k)
+          
+c-----------------------------------------------------------------------
+c    initialisation
+c-----------------------------------------------------------------------
+      call initial0(iimp1*jjp1,pfield)
+      call initial0(imd*jmdp1,zdata)
+      call initial0(imdp1*jmdp1,zdataS)
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF  
+c-----------------------------------------------------------------------
+
+      ierr = NF_INQ_VARID (unit, string(k), nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
+#endif
+
+c-----------------------------------------------------------------------
+c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
+c-----------------------------------------------------------------------
+      if (k.eq.4) then
+
+          call multscal(imd*jmdp1,zdata,1000.,zdata)
+          call multscal(imd,longitude,pi/180.,longitude)
+          call multscal(jmdp1,latitude,pi/180.,latitude)
+
+          call grid_noro1(360, 180, longitude, latitude, zdata,
+     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
+
+          CALL dump2d(iip1,jjp1,zmea,'zmea')
+          CALL dump2d(iip1,jjp1,zstd,'zstd')
+          CALL dump2d(iip1,jjp1,zsig,'zsig')
+          CALL dump2d(iip1,jjp1,zgam,'zgam')
+          CALL dump2d(iip1,jjp1,zthe,'zthe')
+
+      endif
+
+c-----------------------------------------------------------------------
+c   Passage de zdata en grille (imdp1 jmdp1)
+c-----------------------------------------------------------------------
+      do j=1,jmdp1
+          do i=1,imd
+              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmxgdat*(j-1))
+          enddo
+          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmxgdat*(j-1))
+      enddo
+
+c-----------------------------------------------------------------------
+c    Interpolation
+c-----------------------------------------------------------------------
+      call interp_horiz(zdataS,pfield,imd,jmd,
+     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
+
+c-----------------------------------------------------------------------
+c    Periodicite    
+c-----------------------------------------------------------------------
+
+      do j=1,jjp1
+         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
+      enddo 
+ 
+c-----------------------------------------------------------------------
+c    Sauvegarde des champs    
+c-----------------------------------------------------------------------
+
+      if (k.eq.1) then                    ! albedo
+         do i=1,iimp1*jjp1
+              alb(i) = pfield(i)
+          enddo
+      elseif (k.eq.2) then                ! thermal
+         do i=1,iimp1*jjp1
+              ith(i) = pfield(i)
+          enddo
+      elseif (k.eq.3) then                ! relief
+        if (relief.eq.'pla') then
+              call initial0(iimp1*jjp1,phisinit)
+        else
+             do i=1,iimp1*jjp1
+                  phisinit(i) = pfield(i)
+              enddo
+        endif
+      endif
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    Traitement Phisinit
+c-----------------------------------------------------------------------
+
+      DO i=1,iimp1*jjp1
+            phisinit(i)=1000.*phisinit(i)
+      ENDDO
+      CALL dump2d(iimp1,jjp1,phisinit,'Altitude en m')
+      CALL multscal(iimp1*jjp1,phisinit,g,phisinit)
+
+c-----------------------------------------------------------------------
+c    FIN
+c-----------------------------------------------------------------------
+
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dedd.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dedd.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dedd.F	(revision 2744)
@@ -0,0 +1,156 @@
+      SUBROUTINE DEDD (KDLON,PGG,PREF,PRMUZ,PTO1,PW
+     S                ,      PRE1,PRE2,PTR1,PTR2         )
+      implicit none
+C
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+C
+C**** *DEDD* - DELTA-EDDINGTON IN A CLOUDY LAYER
+C
+C     PURPOSE.
+C     --------
+C           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
+C     LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
+C
+C**   INTERFACE.
+C     ----------
+C          *DEDD* IS CALLED BY *SW*.
+C
+C     SUBROUTINE DEDD (KDLON,PGG,PREF,PRMUZ,PTO1,PW
+C    S                ,      PRE1,PRE2,PTR1,PTR2         )
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C PGG    : (NDLON)             ; ASSYMETRY FACTOR
+C PREF   : (NDLON)             ; REFLECTIVITY OF THE UNDERLYING LAYER
+C PRMUZ  : (NDLON)             ; COSINE OF SOLAR ZENITH ANGLE
+C PTO1   : (NDLON)             ; OPTICAL THICKNESS
+C PW     : (NDLON)             ; SINGLE SCATTERING ALBEDO
+C     ==== OUTPUTS ===
+C PRE1   : (NDLON)             ; LAYER REFLECTIVITY ASSUMING NO
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C PTR1   : (NDLON)             ; LAYER TRANSMISSIVITY ASSUMING NO
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C PRE2   : (NDLON)             ; LAYER REFLECTIVITY ASSUMING
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C PTR2   : (NDLON)             ; LAYER TRANSMISSIVITY ASSUMING
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C          STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
+C
+C     EXTERNALS.
+C     ----------
+C
+C          NONE
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
+C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "IN CORE MODEL"
+C
+C     AUTHOR.
+C     -------
+C        JEAN-JACQUES MORCRETTE  *ECMWF*
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 88-12-15
+C     ------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+      INTEGER KDLON
+C
+      REAL PGG(NDLO2),PREF(NDLO2),PRMUZ(NDLO2),PTO1(NDLO2),PW(NDLO2)
+      REAL PRE1(NDLO2),PRE2(NDLO2),PTR1(NDLO2),PTR2(NDLO2)
+
+c   local
+      integer jl
+      real*8 ZFF,ZGP,ZTOP,ZWCP,ZDT,ZX1,ZWM,ZRM2,ZRK,ZX2,ZRP,ZALPHA
+      real*8 ZBETA,ZEXMU0,ZEXKP,ZEXKM,ZXP2P,ZXM2P,ZAP2B,ZAM2B
+      real*8 ZA11,ZA12,ZA13,ZA22,ZA21,ZA23,ZDENA,ZC1A,ZC2A
+      real*8 ZRI0A,ZRI1A,ZRI0B,ZRI1B
+      real*8 ZB21,ZB22,ZB23,ZDENB,ZC1B,ZC2B
+      real*8 ZRI0C,ZRI1C,ZRI0D,ZRI1D
+C
+C     ------------------------------------------------------------------
+C
+C*         1.      DELTA-EDDINGTON CALCULATIONS
+C
+ 100  CONTINUE
+C
+      DO 131 JL   =   1 , KDLON
+C
+C*         1.1     SET UP THE DELTA-MODIFIED PARAMETERS
+C
+ 110  CONTINUE
+C
+      ZFF = PGG(JL)*PGG(JL)
+      ZGP = PGG(JL)/(1.+PGG(JL))
+      ZTOP = (1.- PW(JL) * ZFF) * PTO1(JL)
+      ZWCP = (1-ZFF)* PW(JL) /(1.- PW(JL) * ZFF)
+      ZDT = 2./3.
+      ZX1 = 1.-ZWCP*ZGP
+      ZWM = 1.-ZWCP
+      ZRM2 =  PRMUZ(JL) * PRMUZ(JL)
+      ZRK = SQRT(3.*ZWM*ZX1)
+      ZX2 = 4.*(1.-ZRK*ZRK*ZRM2)
+      ZRP = SQRT(3.*ZWM/ZX1)
+      ZALPHA = 3.*ZWCP*ZRM2*(1.+ZGP*ZWM)/ZX2
+      ZBETA = 3.*ZWCP* PRMUZ(JL) *(1.+3.*ZGP*ZRM2*ZWM)/ZX2
+      ZEXMU0 = EXP(-ZTOP/ PRMUZ(JL) )
+      ZEXKP = EXP(ZRK*ZTOP)
+      ZEXKM = 1./ZEXKP
+      ZXP2P = 1.+ZDT*ZRP
+      ZXM2P = 1.-ZDT*ZRP
+      ZAP2B = ZALPHA+ZDT*ZBETA
+      ZAM2B = ZALPHA-ZDT*ZBETA
+C
+C*         1.2     WITHOUT REFLECTION FROM THE UNDERLYING LAYER
+C
+ 120  CONTINUE
+C
+      ZA11 = ZXP2P
+      ZA12 = ZXM2P
+      ZA13 = ZAP2B
+      ZA22 = ZXP2P*ZEXKP
+      ZA21 = ZXM2P*ZEXKM
+      ZA23 = ZAM2B*ZEXMU0
+      ZDENA = ZA11 * ZA22 - ZA21 * ZA12
+      ZC1A = (ZA22*ZA13-ZA12*ZA23)/ZDENA
+      ZC2A = (ZA11*ZA23-ZA21*ZA13)/ZDENA
+      ZRI0A = ZC1A+ZC2A-ZALPHA
+      ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA
+      PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL)
+      ZRI0B = ZC1A*ZEXKM+ZC2A*ZEXKP-ZALPHA*ZEXMU0
+      ZRI1B = ZRP*(ZC1A*ZEXKM-ZC2A*ZEXKP)-ZBETA*ZEXMU0
+      PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL)
+C
+C*         1.3     WITH REFLECTION FROM THE UNDERLYING LAYER
+C
+ 130  CONTINUE
+C
+      ZB21 = ZA21- PREF(JL) *ZXP2P*ZEXKM
+      ZB22 = ZA22- PREF(JL) *ZXM2P*ZEXKP
+      ZB23 = ZA23- PREF(JL) *ZEXMU0*(ZAP2B - PRMUZ(JL) )
+      ZDENB = ZA11 * ZB22 - ZB21 * ZA12
+      ZC1B = (ZB22*ZA13-ZA12*ZB23)/ZDENB
+      ZC2B = (ZA11*ZB23-ZB21*ZA13)/ZDENB
+      ZRI0C = ZC1B+ZC2B-ZALPHA
+      ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA
+      PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL)
+      ZRI0D = ZC1B*ZEXKM + ZC2B*ZEXKP - ZALPHA*ZEXMU0
+      ZRI1D = ZRP * (ZC1B*ZEXKM - ZC2B*ZEXKP) - ZBETA*ZEXMU0
+      PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL)
+C
+ 131  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/def_var.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/def_var.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/def_var.F90	(revision 2744)
@@ -0,0 +1,33 @@
+subroutine def_var(nid,name,title,units,nbdim,dim,nvarid,ierr)
+
+implicit none
+
+include "netcdf.inc"
+
+character (len=*) :: title,units,name
+integer :: nid,nbdim,nvarid,ierr
+integer, dimension(nbdim) :: dim
+
+ierr=NF_REDEF(nid)
+#ifdef NC_DOUBLE
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dim,nvarid)
+#else
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dim,nvarid)
+#endif
+if(ierr/=NF_NOERR) then
+   write(*,*) NF_STRERROR(ierr)
+   stop "in def_var"
+endif
+ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", len_trim(adjustl(title)),adjustl(title))
+if(ierr/=NF_NOERR) then
+   write(*,*) NF_STRERROR(ierr)
+   stop "in def_var"
+endif
+ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", len_trim(adjustl(units)),adjustl(units))
+if(ierr/=NF_NOERR) then
+   write(*,*) NF_STRERROR(ierr)
+   stop "in def_var"
+endif
+ierr = NF_ENDDEF(nid)
+
+end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dimphys.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dimphys.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dimphys.h	(revision 2744)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimphys.h'
+
+
+         INTEGER, parameter :: wiim=44
+         INTEGER, parameter :: wjjm=44
+         INTEGER, PARAMETER :: ngridmx=1936
+         INTEGER, parameter :: nlayermx=70
+         INTEGER, PARAMETER :: nsoilmx=10
+	
+!-----------------------------------------------------------------------
+
+	 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dimradmars.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dimradmars.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dimradmars.h	(revision 2744)
@@ -0,0 +1,78 @@
+c-----------------------------------------------------------------------
+c------------------------------------------------------------------------
+c   INCLUDE 'dimradmars.h'
+
+c   Declaration and initialisation or radiative transfer calculations
+c------------------------------------------------------------------------
+c------------------------------------------------------------------------
+
+c Splitting of horizontal grid (to reduce program size on workstation)
+c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c nflev: number of vertical layer
+c ndlon: nombre de points de la grille horizontale
+c NDLO2 et ndomainsz pour le decoupage de l'appel a la physique
+c ATTENTION:  Il faut  1 < ndomainsz =< ngridmx
+
+      INTEGER  NFLEV,NDLON, ndomainsz, NDLO2
+
+c        parameter (ndomainsz=ngridmx)
+cc       parameter (ndomainsz=(ngridmx-1)/20 + 1)
+cc      parameter (ndomainsz=(ngridmx-1)/5 + 1)
+        parameter (ndomainsz=(ngridmx-1)/100 + 1)
+
+	
+      parameter (NFLEV=nlayermx,NDLON=ndomainsz)	! avec decoupage 
+      parameter (NDLO2=NDLON)
+
+
+c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      REAL longrefir,longrefvis
+      REAL long1vis,long2vis,long3vis, long1ir,long2ir
+      REAL long1co2,long2co2
+      REAL sunfr(2)
+      integer nir, nuco2
+      INTEGER npademx,nabsmx,nt_pademx, NSUN
+
+
+c Definition of spectral intervals at thermal infrared wavelengths (LW)
+c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      parameter (nir=4) ! Total number of thermal IR bands
+      parameter (nuco2=2) ! number of bands in CO2 bands
+      PARAMETER (long1ir=5.E-6 , long2ir=200.E-6)
+      PARAMETER (long1co2=1.E+0 / 865.E+2 , long2co2=1.E+0 / 500.E+2)
+
+c  Warning : the "nir" thermal IR bands are not ordered by wavelength:
+c      iir=1 : central 15um CO2 bands \    
+c      iir=2 : CO2 band wings    [long1co2-long2co2] MINUS central band
+c      iir=3 : 9 um band [long1ir - long1co2]
+c      iir=4 : Far IR    [long2co2 - long2ir]
+    
+c  Definition of spectral interval at solar wavelengths (SW)
+c  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      PARAMETER (NSUN=2)   ! do not change that !
+c  Boundaries of spectral intervals (m) : 
+      PARAMETER (long1vis=0.1E-6 , long2vis=0.5E-6 , long3vis=5.E-6)
+c  Fraction of solar energy in solar band #1 [long1vis-long2vis]
+      DATA sunfr(1) / 0.274490 /  
+c  Fraction of solar energy in solar band #2 [long2vis-long3vis]
+      DATA sunfr(2) / 0.725509 /
+
+c Reference wavelengths used to compute reference dust optical depth (m)
+c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      PARAMETER (longrefir=9.E-6,longrefvis=0.67E-6)
+
+c Number of kind of tracer radiative properties 
+c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c (ex: naerkind=1 if you use one dust mode without ice ...)
+c (ex: naerkind=2 if you use one dust mode and active ice ...)
+      integer naerkind        
+      parameter (naerkind=1)
+
+c Various initialisation for LW radiative code
+c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c npademx : nombre de coef de pade 
+c nabsmx : ?
+c nt_pademx : nombre d'intervalles de temperature pour pade
+
+      PARAMETER (npademx=4,nabsmx=2,nt_pademx=19)
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/drag_noro.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/drag_noro.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/drag_noro.F	(revision 2744)
@@ -0,0 +1,170 @@
+      SUBROUTINE drag_noro (klon,klev,dtime,pplay,pplev,
+     e                   pvar, psig, pgam, pthe,
+     e                   kgwd,kgwdim,kdx,ktest,
+     e                   t, u, v,
+     s                   pulow, pvlow, pustr, pvstr,
+     s                   d_t, d_u, d_v)
+C**** *DRAG_NORO* INTERFACE FOR SUB-GRID SCALE OROGRAPHIC SCHEME
+C
+C     PURPOSE.
+C     --------
+C           ZEROS TENDENCIES, COMPUTES GEOPOTENTIAL HEIGHT AND UPDATES THE
+C           TENDENCIES AFTER THE SCHEME HAS BEEN CALLED.
+C
+C     EXPLICIT ARGUMENTS :
+C     --------------------
+C
+C     INPUT :
+C
+C     NLON               : NUMBER OF HORIZONTAL GRID POINTS
+C     NLEV               : NUMBER OF LEVELS
+C     DTIME              : LENGTH OF TIME STEP
+C     PPLAY(NLON,NLEV+1) : PRESSURE AT MIDDLE LEVELS
+C     PPLEV(NLON,NLEV)   : PRESSURE ON MODEL LEVELS
+C     PVAR(NLON)         : SUB-GRID SCALE STANDARD DEVIATION
+C     PSIG(NLON)         : SUB-GRID SCALE SLOPE
+C     PGAM(NLON)         : SUB-GRID SCALE ANISOTROPY
+C     PTHE(NLON)         : SUB-GRID SCALE PRINCIPAL AXES ANGLE
+C     KGWD               : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KGWDIM             : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KDX(NLON)          : POINTS AT WHICH TO CALL THE SCHEME
+C     KTEST(NLON)        : MAP OF CALLING POINTS
+C     T(NLON,NLEV)       : TEMPERATURE
+C     U(NLON,NLEV)       : ZONAL WIND
+C     V(NLON,NLEV)       : MERIDIONAL WIND
+C
+C     OUTPUT :
+C
+C     PULOW(NLON)        : LOW LEVEL ZONAL WIND
+C     PVLOW(NLON)        : LOW LEVEL MERIDIONAL WIND
+C     PUSTR(NLON)        : LOW LEVEL ZONAL STRESS
+C     PVSTR(NLON)        : LOW LEVEL MERIDIONAL STRESS
+C     D_T(NLON,NLEV)     : TEMPERATURE TENDENCY
+C     D_U(NLON,NLEV)     : ZONAL WIND TENDENCY
+C     D_V(NLON,NLEV)     : MERIDIONAL WIND TENDENCY
+C
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C
+C     comcstfi.h
+C     dimphys.h
+C
+c
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li F.Lott (LMD/CNRS) date: 19950201
+c Objet: Frottement de la montagne Interface
+c======================================================================
+c Arguments:
+c dtime---input-R- pas d'integration (s)
+c s-------input-R-la valeur "s" pour chaque couche
+c pplay--input-R- pression au milieu des couches en Pa
+c pplev--input-R-pression au bords des couches en Pa
+c t-------input-R-temperature (K)
+c u-------input-R-vitesse horizontale (m/s)
+c v-------input-R-vitesse horizontale (m/s)
+c
+c d_t-----output-R-increment de la temperature t
+c d_u-----output-R-increment de la vitesse u
+c d_v-----output-R-increment de la vitesse v
+c======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+c
+c ARGUMENTS
+c
+      REAL dtime
+      INTEGER klon,klev
+      real pplay(NDLO2,klev),pplev(NDLO2,klev+1)
+      REAL pvar(NDLO2),psig(NDLO2),pgam(NDLO2),pthe(NDLO2)
+      REAL pulow(NDLO2),pvlow(NDLO2),pustr(NDLO2),pvstr(NDLO2)
+      REAL u(NDLO2,klev), v(NDLO2,klev),t(NDLO2,klev)
+      REAL d_t(NDLO2,klev), d_u(NDLO2,klev), d_v(NDLO2,klev)
+c
+      INTEGER i, k, kgwd, kgwdim, kdx(NDLO2), ktest(NDLO2)
+c
+c Variables locales:
+c
+      REAL paprs(NDLO2,nlayermx+1)
+      REAL paprsf(NDLO2,nlayermx)
+      REAL zgeom(NDLO2,nlayermx)
+      REAL pdtdt(NDLO2,nlayermx)
+      REAL pdudt(NDLO2,nlayermx), pdvdt(NDLO2,nlayermx)
+      REAL pt(NDLO2,nlayermx), pu(NDLO2,nlayermx)
+      REAL pv(NDLO2,nlayermx)
+c
+c initialiser les variables de sortie (pour securite)
+c
+      DO i = 1,klon
+         pulow(i) = 0.0
+         pvlow(i) = 0.0
+         pustr(i) = 0.0
+         pvstr(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         pdudt(i,k)=0.0
+         pdvdt(i,k)=0.0
+         pdtdt(i,k)=0.0
+      ENDDO
+      ENDDO
+c
+c preparer les variables d'entree (attention: l'ordre des niveaux 
+c verticaux augmente du haut vers le bas)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         pt(i,k) = t(i,klev-k+1)
+         pu(i,k) = u(i,klev-k+1)
+         pv(i,k) = v(i,klev-k+1)
+         paprsf(i,k) = pplay(i,klev-k+1)
+         paprs(i,k) = pplev(i,klev+1-k+1)
+      ENDDO
+      ENDDO
+      DO i = 1, klon
+         paprs(i,klev+1) = pplev(i,1)
+      ENDDO
+      DO i = 1, klon
+         zgeom(i,klev) = r * pt(i,klev)
+     .                  * LOG(paprs(i,klev+1)/paprsf(i,klev))
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, klon
+         zgeom(i,k) = zgeom(i,k+1) + r * (pt(i,k)+pt(i,k+1))/2.0
+     .               * LOG(paprsf(i,k+1)/paprsf(i,k))
+      ENDDO
+      ENDDO
+c
+c appeler la routine principale
+c
+
+c----------------sursis g95
+      CALL ORODRAG(klon,klev,kgwd,kgwdim,kdx,ktest,
+     .            dtime,
+     .            paprs, paprsf, zgeom,
+     .            pt, pu, pv, pvar, psig, pgam, pthe,
+     .            pulow,pvlow,
+     .            pdudt,pdvdt,pdtdt)
+c----------------problem g95
+
+
+C
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,klev+1-k) = dtime*pdudt(i,k)
+         d_v(i,klev+1-k) = dtime*pdvdt(i,k)
+         d_t(i,klev+1-k) = dtime*pdtdt(i,k)
+         pustr(i)        = pustr(i)
+     .                    +g*pdudt(i,k)*(paprs(i,k+1)-paprs(i,k))
+         pvstr(i)        = pvstr(i)
+     .                    +g*pdvdt(i,k)*(paprs(i,k+1)-paprs(i,k))
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dustdevil.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dustdevil.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dustdevil.F	(revision 2744)
@@ -0,0 +1,250 @@
+      SUBROUTINE dustdevil(ngrid,nlay,nq, pplev,pu,pv,pt, ptsurf,pq2,
+     &                pdqdev,pdqs_dev)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c
+c  VERSION SPECIAL TRACEURS :
+c  Parameterization of dust devil activities
+c  to estimate dust lifting
+c  The dust devil activity is estimated based on 
+c  Renno et al. 1998 (JAS 55, 3244-3252)  
+c
+c  It is proportional to (1-b)*Fs
+c
+c  With b= [ps**(rcp+1) - ptop**(rcp+1)] / [(ps-ptop)*(rcp+1)* ps**rcp]
+c  with ptop pressure of the top of the boundary layer
+c       rcp = R/cp
+c
+c  and Fs the surface sensible heat flux = Cd*|U|*(T(1) -Tsurf)
+c       
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"      
+c#include "comconst.h"        ! TEMPORAIRE AVEC ANLDEVIL !!!!
+#include "planete.h"
+#include "comgeomfi.h"
+#include "tracer.h"
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL pplev(ngrid,nlay+1)
+      REAL pt(ngrid,nlay)
+      REAL pu(ngrid,nlay)
+      REAL pv(ngrid,nlay)
+      REAL pq2(ngrid,nlay+1)
+      REAL ptsurf(ngrid)
+
+c    Traceurs :
+      integer nq 
+      real pdqdev(ngrid,nlay,nq) 
+      real pdqs_dev(ngrid,nq) 
+      
+c   local:
+c   ------
+
+      INTEGER ig,l,iq
+      real Cd, z1
+      save Cd
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+
+      REAL devila(ngridmx)
+      integer ltop(ngridmx)
+      real b,rho,Fs,wind
+
+
+
+      REAL  q2top , seuil
+      SAVE  q2top , seuil
+      DATA q2top/.5/ ! value of q2 at the top of PBL
+      DATA seuil/.3/ ! value of minimum dust devil activity for dust lifting
+
+
+      DATA firstcall/.true./
+
+c   TEMPORAIRE AVEC ANLDEVIL : *************
+c        real b_diag(ngridmx)
+c       real localtime(ngridmx)
+c       common/temporaire/localtime
+c      real ztop(ngridmx),magwind(ngridmx),t1(ngridmx)
+c      real rcp ,cpp
+c      rcp = kappa
+c      cpp = r/rcp
+c   **********************************
+       
+
+c-----------------------------------------------------------------------
+c    initialisation
+c    --------------
+
+      IF (firstcall) THEN
+
+        write(*,*) 'In dustdevil :'
+        write(*,*) '    q2top= ',q2top,'     seuil= ', seuil 
+c       un petit test de coherence:
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans coefdifv'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+
+c A rough estimation of the horizontal drag coefficient Cd
+c (the scale heigh is taken to be 13 km since we are typically
+c dealing with daytime temperature around 250K.
+c 
+         z1= -0.5*13.e3*log(pplev(1,2)/pplev(1,1))
+         Cd = (0.4/log(z1/z0))**2
+
+         firstcall=.false.
+
+c        Temporaire
+c        open(77,file='devil')
+      
+      ENDIF
+
+c-----------------------------------------------------------------------
+c Initialisation
+      do iq=1,nq
+       do l=1,nlay
+           do ig=1,ngrid
+             pdqdev(ig,l,iq)= 0
+           end do
+       end do
+      end do
+
+
+c-----------------------------------------------------------------------
+c      Determining the top of the boundary layer
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do ig=1,ngrid
+         do  l=2,nlay-1
+            if (pq2(ig,l).lt.q2top)then
+              ltop(ig)=l
+              goto 99
+            end if
+         enddo
+ 99      continue
+
+c        ***************************************
+cc        if (ptsurf(ig).gt.255)then
+c         write(*,*) 'tsurf, ztop (km): ', ig,
+c     &   ptsurf(ig), -12.*log(pplev(ig,ltop(ig))/pplev(ig,1))
+c         if ((ptsurf(ig).gt.50.).and.(
+c     &      (-12.*log(pplev(ig,ltop(ig))/pplev(ig,1))).gt.60.))then
+c            do l=1,nlay
+c             write(*,*) l,
+c     &       -12.*log(pplev(ig,l)/pplev(ig,1)),pq2(ig,l)
+c            end do
+c         end if
+cc        end if
+c        ***************************************
+     
+      enddo
+
+c        ***************************************
+c        do ig=100,148
+c           write(*,*)'time,tsurf,ztop', localtime(ig),ptsurf(ig),
+c    &      -12.*log(pplev(ig,ltop(ig))/pplev(ig,1))
+c        end do
+c        ***************************************
+
+
+c   Calculation : dust devil intensity
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do ig=1,ngrid
+
+c --------------------------------------------------
+c 1) Version 1 : sensible heat flux using actual wind :
+c        Wind magnitude:
+c        wind = sqrt(pu(ig,1)**2+pv(ig,1)**2)
+c
+c --------------------------------------------------
+c 2) Version 2 : sensible heat flux using  wind = 15 m/s
+         wind = 15.
+c ----------------------------------------------------
+c        Density :
+         rho=pplev(ig,1)/(R*pt(ig,1))
+
+c        Sensible heat flux (W.m-2) (>0 if up)
+         Fs= rho*cpp*Cd * wind
+     &       * (ptsurf(ig) -pt(ig,1))
+         b= (pplev(ig,1)**(rcp+1) - pplev(ig,ltop(ig))**(rcp+1)) /
+     &    ( (pplev(ig,1)-pplev(ig,ltop(ig)))*(rcp+1)*pplev(ig,1)**rcp)
+
+c        b_diag(ig) = b     ! TEMPORAIRE (pour diagnostique)
+
+c   Energy flux available to drive dust devil (W.m-2) : (1-b)*Fs
+c   Dust devil activity : 
+         devila(ig)= max( 0. , (1-b)*Fs - seuil ) 
+      enddo
+c   
+c     lifted dust (kg m-2 s-1)  (<0 when lifting)
+c     ~~~~~~~~~~  
+      do iq=1,nq
+         do ig=1,ngrid
+           pdqs_dev(ig,iq)= - alpha_devil(iq) * devila(ig)
+         end do
+      end do 
+
+c     Injection of dust in the atmosphere (up to the top of pbl)
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do iq=1,nq
+       do ig=1,ngrid
+         if (devila(ig).ne.0.) then
+           do l=1,ltop(ig)
+             pdqdev(ig,l,iq)=-pdqs_dev(ig,iq)*g/
+     &        (pplev(ig,1)-pplev(ig,ltop(ig)))
+           end do
+         end if
+       end do
+      end do
+
+c *********************************************************     
+c     TEMPORAIRE AVEC ANLDEVIL:
+c     IF (ngrid.gt.1) THEN
+c      do ig=2,ngridmx-1
+c       write(77,88) lati(ig)*180./pi,localtime(ig),
+c    &        -12.*log(pplev(ig,ltop(ig))/pplev(ig,1)),
+c    &   devil(ig),min(sqrt(pu(ig,1)**2+pv(ig,1)**2),40.),
+c    &   ptsurf(ig)-pt(ig,1),ptsurf(ig),pplev(ig,1)
+c      end do    
+c88    format (f7.3,1x,f7.3,1x,f6.3,1x,f6.4,1x,f7.4,1x,
+c    &        f7.3,1x,f7.3,1x,f9.3)
+c      do ig=1,ngridmx
+c       ztop(ig) = -12.*log(pplev(ig,ltop(ig))/pplev(ig,1))
+c       magwind(ig) = sqrt(pu(ig,1)**2+pv(ig,1)**2)
+c       t1(ig) =max(ptsurf(ig)- pt(ig,1),0.)
+c      end do
+
+c       call WRITEDIAGFI(ngridmx,'dqs_dev','dqs devil',
+c    &               'kg.m-2.s-1',2,pdqs_dev)
+c       call WRITEDIAGFI(ngridmx,'wind','wind',
+c    &               'm.s-1',2,magwind)
+c       call WRITEDIAGFI(ngridmx,'ztop','top pbl',
+c    &               'km',2,ztop)
+c       call WRITEDIAGFI(ngridmx,'tsurf','tsurf',
+c    &               'K',2,ptsurf)
+c       call WRITEDIAGFI(ngridmx,'T1','T(1)',
+c    &               'K',2,t1)
+c       call WRITEDIAGFI(ngridmx,'b','b',
+c    &               ' ',2,b_diag)
+c     END If
+c *********************************************************     
+         
+      RETURN
+      END
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dustlift.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dustlift.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/dustlift.F	(revision 2744)
@@ -0,0 +1,143 @@
+      SUBROUTINE dustlift(ngrid,nlay,nq,rho,pcdh_true,pcdh,co2ice,
+     $                  dqslift)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Dust lifting by surface winds
+c  Computing flux to the middle of the first layer
+c  (Called by vdifc)
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "tracer.h"
+
+c
+c   arguments:
+c   ----------
+
+c   INPUT
+      integer ngrid, nlay, nq  
+      real rho(ngrid)  ! density (kg.m-3) at surface
+      real pcdh_true(ngrid) ! Cd 
+      real pcdh(ngrid) ! Cd * |V| 
+      real co2ice(ngrid)
+
+c   OUTPUT
+      real dqslift(ngrid,nq) !surface dust flux to mid-layer (<0 when lifing)
+c     real pb(ngrid,nlay) ! diffusion to surface coeff.
+
+c   local:
+c   ------
+      INTEGER ig,iq
+      REAL fhoriz(ngridmx)  ! Horizontal dust flux 
+      REAL ust,us
+      REAL stress_seuil
+      SAVE stress_seuil
+c      DATA stress_seuil/0.0225/   ! stress seuil soulevement (N.m2)
+!****WRF
+!****WRF: additional ASCII file to define dust opacity
+          REAL alpha  
+          INTEGER ierr
+          OPEN(99,file='stress.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+          IF(ierr.NE.0) THEN
+             stress_seuil = 0.0225
+             alpha = 1.   
+             write(*,*) 'No file stress.def - set ', stress_seuil, alpha
+             !stop
+          ELSE
+             READ(99,*) stress_seuil
+             READ(99,*) alpha
+             write(*,*) 'definir seuil stress : ', stress_seuil, alpha
+             CLOSE(99)
+          ENDIF
+          alpha_lift(1) = alpha          
+!****WRF
+!****WRF
+
+
+
+
+
+c     ---------------------------------
+c     Computing horizontal flux: fhoriz
+c     ---------------------------------
+
+      do ig=1,ngrid
+          fhoriz(ig) = 0.      ! initialisation
+
+c         Selection of points where surface dust is available
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         if (latid(ig).ge.80.) goto 99  ! N permanent  polar caps
+c         if (latid(ig).le.-80.) goto 99 ! S polar deposits
+c         if  ((longd(ig).ge.-141. .and. longd(ig).le.-127.)
+c    &   .and.(latid(ig).ge.12.   .and. latid(ig).le.23.))goto 99 ! olympus
+c         if  ((longd(ig).ge.-125. .and. longd(ig).le.-118.)
+c    &   .and.(latid(ig).ge.-12.   .and. latid(ig).le.-6.))goto 99 ! Arsia
+c         if  ((longd(ig).ge.-116. .and. longd(ig).le.-109.)
+c    &   .and.(latid(ig).ge.-5.   .and. latid(ig).le. 5.))goto 99 ! pavonis
+c         if  ((longd(ig).ge.-109. .and. longd(ig).le.-100.)
+c    &   .and.(latid(ig).ge. 7.   .and. latid(ig).le. 16.))goto 99 ! ascraeus
+c         if  ((longd(ig).ge.  61. .and. longd(ig).le.  63.)
+c    &   .and.(latid(ig).ge. 63. .and. latid(ig).le. 64.))goto 99 !weird point
+          if (co2ice(ig).gt.0.) goto 99
+
+
+c         Is the wind strong enough ?
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          ust = sqrt(stress_seuil/rho(ig))
+          us = pcdh(ig) /  sqrt(pcdh_true(ig)) ! ustar=cd*v /sqrt(cd)
+
+          if (us.gt.ust) then
+c            If lifting ? 
+c            Calcul du flux suivant Marticorena ( en fait white (1979))
+
+             fhoriz(ig) = 2.61*(rho(ig)/g) *
+     &      (us -ust) * (us + ust)**2
+          end if
+ 99      continue
+      end do
+
+
+cc       write(*,*) 'caca', us, ust
+cc       do iq=1,nq
+cc       do ig=1,ngrid
+cc          write(*,*) 'cacao', -alpha_lift(iq) * fhoriz(ig)
+cc       enddo
+cc       enddo
+
+
+
+c     -------------------------------------
+c     Computing vertical flux and diffusion
+c     -------------------------------------
+ 
+       do iq=1,nq
+         do ig=1,ngrid
+             dqslift(ig,iq)= -alpha_lift(iq)* fhoriz(ig)
+
+cc  le  flux vertical remplace le terme de diffusion turb. qui est mis a zero
+c            zb(ig,1) = 0.
+cc           If surface deposition by turbulence diffusion (impaction...)
+cc           if(fhoriz(ig).ne.0) then
+cc           zb(ig,1) = zcdh(ig)*zb0(ig,1)
+cc           AMount of Surface deposition !
+cc           pdqs_dif(ig,iq)=pdqs_dif(ig,iq) +
+cc    &      zb(ig,1)*zq(ig,1,iq)/ptimestep
+cc          write(*,*) 'zb(1)  = ' ,  zb(ig,1),zcdh(ig),zb0(ig,1)
+cc
+
+         enddo
+       enddo
+
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/eofdump.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/eofdump.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/eofdump.F	(revision 2744)
@@ -0,0 +1,60 @@
+      subroutine eofdump(ngrid,nlayer,u,v,t,rho,ps)
+
+cccc  subroutine eofdump(cols,rows,nlayer,u,v,t,p)
+
+      implicit none
+c
+c     Dumps profiles for calculation of variability EOFs 
+c     Modified to include rho, FF 09/2004
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "eofdump.h"
+c
+c._.  integer cols
+c._.  integer rows
+
+      integer ngrid
+      integer nlayer
+      real*4 u(ngrid,nlayer)
+      real*4 v(ngrid,nlayer)
+      real*4 t(ngrid,nlayer)
+      real*4 rho(ngrid,nlayer)
+      real*4 ps(ngrid)
+      integer count
+      data count /0/
+      save count
+      integer i,j,l, ig
+
+      LOGICAL firstcall
+      SAVE firstcall
+      DATA firstcall/.true./
+
+c-------------------------------------------------------
+c     Initialization at first call:
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (firstcall) THEN
+        write(*,*) 'CALL ineofdump'
+        CALL ineofdump
+        firstcall=.false.
+      END IF
+
+c-------------------------------------------------------
+c     Dumps every ieofs physics timesteps
+c
+      if ((ieofs.gt.0).and.(mod(count,ieofs).eq.0)) then
+
+        do i=1,iim,eofskip
+          do j=1+eofskip/2,jjm+1,eofskip
+            ig = 1+ (j-2)*iim +i
+            write(uedata) (u(ig,l),l=1,nlayer)
+            write(uedata) (v(ig,l),l=1,nlayer)
+            write(uedata) (t(ig,l),l=1,nlayer)
+            write(uedata) (rho(ig,l),l=1,nlayer)
+            write(uedata) ps(ig)
+          enddo
+        enddo
+      endif
+      count=count+1
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/eofdump.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/eofdump.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/eofdump.h	(revision 2744)
@@ -0,0 +1,22 @@
+c
+c  eofdump:
+c	This include file controls the production of data for EOFs.
+c
+c	Dump profiles for EOFs every ieofs physics timesteps,
+c       starting at first call.
+	integer ieofs
+c
+c	Only dump profiles every eofskip points in each direction
+c       on the model grid.
+	integer eofskip
+	parameter (eofskip = 4)
+c
+c	Units for writing EOF header and data
+	integer uehead, uedata
+	parameter (uehead = 82, uedata = 83)
+c
+	common /eofcom/ ieofs
+c
+      INTEGER npgrid
+      PARAMETER(npgrid=ngridmx+2*(iim-1))
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/fill_save.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/fill_save.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/fill_save.inc	(revision 2744)
@@ -0,0 +1,8 @@
+      CALL fill_save_2d(
+     . tsurf,
+     . fluxsurf_sw_tot,
+     . fluxsurf_lw,
+     . ust,
+     . hfx,
+     . ngrid,
+     . output_tab2d)
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/fill_save_2d.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/fill_save_2d.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/fill_save_2d.F90	(revision 2744)
@@ -0,0 +1,28 @@
+SUBROUTINE fill_save_2d( &
+tsurf,&
+fluxsurf_sw_tot,&
+fluxsurf_lw,&
+ust,&
+hfx,&
+ngrid,&
+output_tab2d)
+   
+IMPLICIT NONE
+   
+include "wrf_output_2d.h"
+   
+INTEGER :: ngrid
+REAL, DIMENSION(ngrid) :: tsurf
+REAL, DIMENSION(ngrid) :: fluxsurf_sw_tot
+REAL, DIMENSION(ngrid) :: fluxsurf_lw
+REAL, DIMENSION(ngrid) :: ust
+REAL, DIMENSION(ngrid) :: hfx
+REAL, DIMENSION(ngrid,n2d) :: output_tab2d
+   
+output_tab2d(:,ind_TSURF)=tsurf(:)
+output_tab2d(:,ind_SWDOWN)=fluxsurf_sw_tot(:)
+output_tab2d(:,ind_LWDOWN)=fluxsurf_lw(:)
+output_tab2d(:,ind_UST)=ust(:)
+output_tab2d(:,ind_HFX)=hfx(:)
+   
+END SUBROUTINE fill_save_2d
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/fisice.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/fisice.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/fisice.h	(revision 2744)
@@ -0,0 +1,20 @@
+c-----------------------------------------------------------------------
+c INCLUDE fisice.h
+
+      COMMON/fisice/dqsf,rice,rdust,zcondicea,pclc,icetot,mtot,rave
+
+      REAL dqsf(nqmx)       ! tendance of tracer on surface (e.g. kg.m-2)
+      REAL rice(ngridmx,nlayermx) ! Estimated ice crystal radius (m)
+      REAL rdust(ngridmx,nlayermx) ! Prescribed dust radius in each layer (m) 
+c Variables used to define water ice scavenging by atmos. CO2 condensing
+      REAL zcondicea(ngridmx,nlayermx)
+c Some diagnostic variables 
+
+      REAL pclc(ngridmx)  ! cloud cover ratio (used by radiative transfer, may depend of nlay in the future)
+
+cccccWRF
+c for WRF outputs
+cccccWRF
+      REAL icetot(ngridmx),mtot(ngridmx),rave(ngridmx)
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/flusv.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/flusv.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/flusv.F	(revision 2744)
@@ -0,0 +1,333 @@
+      SUBROUTINE flusv(KDLON,nsf,n,omega,g,tau,emis,bh,bsol,fah,fdh)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  calcul des flux ascendant et descendant aux interfaces entre n couches
+c  * dans l'infrarouge 
+c  * B est une fonction lineaire de $\tau$ a l'interieur de chaque couche
+c  * le B du sol peut etre different de celui qui correspond au profil
+c    de la n-ieme couche
+c  * l'hypothese est une hypothese a deux flux isotropes sur chaque 
+c    hemisphere ("hemispheric constant") + "source function technique"
+c    (voir Toon et al. 1988)
+c  * le flux descendant en haut de l'atmosphere est nul
+c  * les couches sont numerotees du haut de l'atmosphere vers le sol
+c
+c  in :   * KDLON      ---> dimension de vectorisation
+c         * nsf        ---> nsf=0 ==> "hemispheric constant"
+c                           nsf>0 ==> "hemispheric constant" + "source function"
+c         * n          ---> nombre de couches
+c         * omega(i)   ---> single scattering albedo pour la i-eme couche
+c         * g(i)       ---> asymmetry parameter pour la i-eme couche
+c         * tau(i)     ---> epaisseur optique de la i-eme couche
+c         * emis       ---> emissivite du sol
+c         * bh(i)      ---> luminance du corps noir en haut de la i-eme
+c                           couche, bh(n+1) pour la valeur au sol qui
+c                           correspond au profil de la n-ieme couche
+c         * bsol       ---> luminance du corps noir au sol
+c
+c  out :  * fah(i)     ---> flux ascendant en haut de la i-eme couche,
+c                           fah(n+1) pour le sol 
+c         * fdh(i)     ---> flux descendant en haut de la i-eme couche,
+c                           fdh(n+1) pour le sol 
+c
+c.......................................................................
+c  include des dimensions locales
+c 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER KDLON,nsf,n
+      REAL omega(NDLO2,n),g(NDLO2,n),tau(NDLO2,n),emis(NDLO2)
+     &,bh(NDLO2,n+1),bsol(NDLO2),fah(NDLO2,n+1),fdh(NDLO2,n+1)
+c.......................................................................
+c  declaration des variables locales
+c 
+      REAL pi
+      PARAMETER (pi=3.141592653589793E+0)
+      INTEGER iv,i,j
+      REAL beta,gama1,gama2,amu1,grgama,b0,b1
+      REAL a(NDLON,4*nlayermx),b(NDLON,4*nlayermx)
+     &    ,d(NDLON,4*nlayermx),e(NDLON,4*nlayermx)
+     &    ,y(NDLON,4*nlayermx)
+     &    ,alambda(NDLON,2*nlayermx)
+     &    ,e1(NDLON,2*nlayermx),e2(NDLON,2*nlayermx)
+     &    ,e3(NDLON,2*nlayermx),e4(NDLON,2*nlayermx)
+     &    ,cah(NDLON,2*nlayermx),cab(NDLON,2*nlayermx)
+     &    ,cdh(NDLON,2*nlayermx),cdb(NDLON,2*nlayermx)
+      REAL grg(NDLON,2*nlayermx),grh(NDLON,2*nlayermx)
+     &    ,grj(NDLON,2*nlayermx),grk(NDLON,2*nlayermx)
+     &    ,alpha1(NDLON,2*nlayermx),alpha2(NDLON,2*nlayermx)
+     &    ,sigma1(NDLON,2*nlayermx),sigma2(NDLON,2*nlayermx)
+      INTEGER nq
+      PARAMETER (nq=8)
+      REAL x(nq),w(nq),gri(NDLON,nq)
+      DATA x/1.9855071751231860E-2 , 0.1016667612931866E+0
+     &     , 0.2372337950418355E+0 , 0.4082826787521751E+0
+     &     , 0.5917173212478250E+0 , 0.7627662049581645E+0
+     &     , 0.8983332387068134E+0 , 0.9801449282487682E+0/
+      DATA w/5.0614268145185310E-2 , 0.1111905172266872E+0
+     &     , 0.1568533229389437E+0 , 0.1813418916891810E+0
+     &     , 0.1813418916891810E+0 , 0.1568533229389437E+0
+     &     , 0.1111905172266872E+0 , 5.0614268145185310E-2/
+c....................................................................... 
+c
+c....................................................................... 
+      do 10001 i=1,n
+                                                   do 99999 iv=1,KDLON
+      beta=(1.E+0-g(iv,i))/2.E+0
+      gama1=2.E+0*(1.E+0-omega(iv,i)*(1.E+0-beta))
+      gama2=2.E+0*omega(iv,i)*beta
+      amu1=5.E-1
+      alambda(iv,i)=sqrt(gama1**2-gama2**2)
+      grgama=(gama1-alambda(iv,i))/gama2
+c
+c ici une petite bidouille : si l'epaisseur optique d'une couche
+c est trop faible, $dB \over d\tau$ devient tres grand et le schema
+c s'ecroule. dans ces cas, on fait l'hypothese de couche isotherme.
+c
+      if (tau(iv,i).gt.1.E-3) then
+      b0=bh(iv,i)
+      b1=(bh(iv,i+1)-b0)/tau(iv,i)
+      else
+      b0=(bh(iv,i)+bh(iv,i+1))/2.E+0
+      b1=0.E+0
+      endif
+c
+      e1(iv,i)=1.E+0+grgama*exp(-alambda(iv,i)*tau(iv,i))
+      e2(iv,i)=1.E+0-grgama*exp(-alambda(iv,i)*tau(iv,i))
+      e3(iv,i)=grgama+exp(-alambda(iv,i)*tau(iv,i))
+      e4(iv,i)=grgama-exp(-alambda(iv,i)*tau(iv,i))
+      cah(iv,i)=2.E+0*pi*amu1*(b0+b1/(gama1+gama2))
+      cab(iv,i)=2.E+0*pi*amu1*(b0+b1*(tau(iv,i)+1.E+0/(gama1+gama2)))
+      cdh(iv,i)=2.E+0*pi*amu1*(b0-b1/(gama1+gama2))
+      cdb(iv,i)=2.E+0*pi*amu1*(b0+b1*(tau(iv,i)-1.E+0/(gama1+gama2)))  
+c
+      grg(iv,i)=(1.E+0/amu1-alambda(iv,i))
+      grh(iv,i)=grgama*(alambda(iv,i)+1.E+0/amu1)
+      grj(iv,i)=grh(iv,i)
+      grk(iv,i)=grg(iv,i)
+      alpha1(iv,i)=2.E+0*pi*(b0+b1*(1.E+0/(gama1+gama2)-amu1))
+      alpha2(iv,i)=2.E+0*pi*b1
+      sigma1(iv,i)=2.E+0*pi*(b0-b1*(1.E+0/(gama1+gama2)-amu1))
+      sigma2(iv,i)=alpha2(iv,i)
+c
+99999                                              continue
+10001 continue
+c.......................................................................
+                                                   do 99998 iv=1,KDLON
+      a(iv,1)=0.E+0
+      b(iv,1)=e1(iv,1)
+      d(iv,1)=-e2(iv,1)
+      e(iv,1)=-cdh(iv,1)
+99998                                              continue
+c
+      do 10002 i=1,n-1 
+      j=2*i+1
+                                                   do 99997 iv=1,KDLON
+      a(iv,j)=e2(iv,i)*e3(iv,i)-e4(iv,i)*e1(iv,i)
+      b(iv,j)=e1(iv,i)*e1(iv,i+1)-e3(iv,i)*e3(iv,i+1)
+      d(iv,j)=e3(iv,i)*e4(iv,i+1)-e1(iv,i)*e2(iv,i+1)
+      e(iv,j)=e3(iv,i)*(cah(iv,i+1)-cab(iv,i))
+     &       +e1(iv,i)*(cdb(iv,i)-cdh(iv,i+1))
+99997                                              continue
+10002 continue
+c
+      do 10003 i=1,n-1
+      j=2*i
+                                                   do 99996 iv=1,KDLON
+      a(iv,j)=e2(iv,i+1)*e1(iv,i)-e3(iv,i)*e4(iv,i+1)
+      b(iv,j)=e2(iv,i)*e2(iv,i+1)-e4(iv,i)*e4(iv,i+1)
+      d(iv,j)=e1(iv,i+1)*e4(iv,i+1)-e2(iv,i+1)*e3(iv,i+1)
+      e(iv,j)=e2(iv,i+1)*(cah(iv,i+1)-cab(iv,i))
+     &       +e4(iv,i+1)*(cdb(iv,i)-cdh(iv,i+1))
+99996                                              continue
+10003 continue
+c     
+      j=2*n
+                                                   do 99995 iv=1,KDLON
+      a(iv,j)=e1(iv,n)-(1.E+0-emis(iv))*e3(iv,n)
+      b(iv,j)=e2(iv,n)-(1.E+0-emis(iv))*e4(iv,n)
+      d(iv,j)=0.E+0
+      e(iv,j)=emis(iv)*pi*bsol(iv)-cab(iv,n)+(1.E+0-emis(iv))*cdb(iv,n)
+99995                                              continue
+c.......................................................................
+      call sys3v(KDLON,2*n,a,b,d,e,y)
+c....................................................................... 
+      do 10004 i=1,n
+                                                   do 99994 iv=1,KDLON
+      grg(iv,i)=grg(iv,i)*(y(iv,2*i-1)+y(iv,2*i))
+      grh(iv,i)=grh(iv,i)*(y(iv,2*i-1)-y(iv,2*i))
+      grj(iv,i)=grj(iv,i)*(y(iv,2*i-1)+y(iv,2*i))
+      grk(iv,i)=grk(iv,i)*(y(iv,2*i-1)-y(iv,2*i))
+99994                                              continue
+10004 continue
+c.......................................................................
+c les valeurs de flux "hemispheric constant"
+c 
+      IF (nsf.eq.0) THEN
+      do 10005 i=1,n
+                                                   do 99993 iv=1,KDLON
+      fah(iv,i)=e3(iv,i)*y(iv,2*i-1)-e4(iv,i)*y(iv,2*i)+cah(iv,i)
+      fdh(iv,i)=e1(iv,i)*y(iv,2*i-1)-e2(iv,i)*y(iv,2*i)+cdh(iv,i)
+99993                                              continue
+10005 continue
+                                                   do 99992 iv=1,KDLON
+      fah(iv,n+1)=e1(iv,n)*y(iv,2*n-1)+e2(iv,n)*y(iv,2*n)+cab(iv,n)
+      fdh(iv,n+1)=e3(iv,n)*y(iv,2*n-1)+e4(iv,n)*y(iv,2*n)+cdb(iv,n)
+99992                                              continue
+      GOTO 10100
+      ENDIF 
+c....................................................................... 
+c passage a "source function" 
+c 
+c on applique une quadrature de dimension nq
+c x est le vecteur des \mu de la quadrature
+c w est le vecteur des poids correspondants
+c nq est fixe en parameter
+c x et w sont fixes en data
+c 
+c....................................................................... 
+c on part d'en haut et on descent selon les nq angles pour calculer
+c tous les flux descendants 
+c
+      do 10006 j=1,nq 
+                                                   do 99991 iv=1,KDLON
+      gri(iv,j)=0.E+0
+99991                                              continue
+10006 continue
+                                                   do 99990 iv=1,KDLON
+      fdh(iv,1)=0.E+0
+99990                                              continue
+      do 10007 i=1,n
+      do 10008 j=1,nq
+                                                   do 99989 iv=1,KDLON
+      gri(iv,j)=gri(iv,j)*exp(-tau(iv,i)/x(j))
+     &+grj(iv,i)/(alambda(iv,i)*x(j)+1.E+0)
+     &*(1.E+0-exp(-tau(iv,i)*(alambda(iv,i)+1.E+0/x(j))))
+     &+grk(iv,i)/(alambda(iv,i)*x(j)-1.E+0)
+     &*(exp(-tau(iv,i)/x(j))-exp(-tau(iv,i)*alambda(iv,i)))
+     &+sigma1(iv,i)*(1.E+0-exp(-tau(iv,i)/x(j)))
+     &+sigma2(iv,i)*(x(j)*exp(-tau(iv,i)/x(j))+tau(iv,i)-x(j))
+99989                                              continue
+10008 continue
+                                                   do 99988 iv=1,KDLON
+      fdh(iv,i+1)=0.E+0
+99988                                              continue
+      do 10009 j=1,nq 
+                                                   do 99987 iv=1,KDLON
+      fdh(iv,i+1)=fdh(iv,i+1)+w(j)*x(j)*gri(iv,j)
+99987                                              continue
+10009 continue
+10007 continue
+c.......................................................................
+c on applique la condition de reflexion a sol 
+c
+                                                   do 99986 iv=1,KDLON
+      fah(iv,n+1)=(1.E+0-emis(iv))*fdh(iv,n+1)+pi*emis(iv)*bsol(iv)
+99986                                              continue
+      do 10010 j=1,nq
+                                                   do 99985 iv=1,KDLON
+      gri(iv,j)=2.E+0*fah(iv,n+1)
+99985                                              continue
+10010 continue 
+c.......................................................................
+c on remonte pour calculer tous les flux ascendants 
+c  
+      do 10011 i=n,1,-1 
+      do 10012 j=1,nq 
+                                                   do 99984 iv=1,KDLON
+      gri(iv,j)=gri(iv,j)*exp(-tau(iv,i)/x(j))
+     &+grg(iv,i)/(alambda(iv,i)*x(j)-1.E+0)
+     &*(exp(-tau(iv,i)/x(j))-exp(-tau(iv,i)*alambda(iv,i)))
+     &+grh(iv,i)/(alambda(iv,i)*x(j)+1.E+0)
+     &*(1.E+0-exp(-tau(iv,i)*(alambda(iv,i)+1.E+0/x(j))))
+     &+alpha1(iv,i)*(1.E+0-exp(-tau(iv,i)/x(j)))
+     &+alpha2(iv,i)*(x(j)-(tau(iv,i)+x(j))*exp(-tau(iv,i)/x(j)))
+99984                                              continue
+10012 continue
+                                                   do 99983 iv=1,KDLON
+      fah(iv,i)=0.E+0
+99983                                              continue
+      do 10013 j=1,nq 
+                                                   do 99982 iv=1,KDLON
+      fah(iv,i)=fah(iv,i)+w(j)*x(j)*gri(iv,j)
+99982                                              continue
+10013 continue
+10011 continue
+c.......................................................................
+10100 continue      
+c.......................................................................
+c
+c.......................................................................
+      RETURN
+      END
+
+c ***************************************************************
+
+
+      SUBROUTINE sys3v(KDLON,n,a,b,d,e,y)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  inversion d'un systeme lineaire tridiagonal
+c
+c  |  b1  d1               |   | y1 |   | e1 |
+c  |  a2  b2  d2           |   | y2 |   | e2 |
+c  |      a3  b3  d3       | * | y3 | = | e3 |
+c  |             ....      |   |    |   |    |
+c  |              an  bn   |   | yn |   | en |
+c
+c  in :   * KDLON        --> dimension de vectorisation
+c         * n            --> dimension du systeme
+c         * a,b,d,e      --> voir dessin
+c
+c  out :  * y            --> voir dessin
+c
+c.......................................................................
+c  include des dimensions locales
+c 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER KDLON,n
+      REAL a(NDLO2,n),b(NDLO2,n),d(NDLO2,n),e(NDLO2,n),y(NDLO2,n)
+c.......................................................................
+c  declaration des variables locales
+c 
+      INTEGER iv,i
+      REAL as(NDLON,4*nlayermx),ds(NDLON,4*nlayermx)
+     &    ,x(NDLON,4*nlayermx)
+c.......................................................................
+c
+c.......................................................................
+                                                   do 99999 iv=1,KDLON
+      as(iv,n)=a(iv,n)/b(iv,n)
+      ds(iv,n)=e(iv,n)/b(iv,n)
+99999                                              continue
+      do 10001 i=n-1,1,-1
+                                                   do 99998 iv=1,KDLON
+      x(iv,i)=1.E+0/(b(iv,i)-d(iv,i)*as(iv,i+1))
+      as(iv,i)=a(iv,i)*x(iv,i)
+      ds(iv,i)=(e(iv,i)-d(iv,i)*ds(iv,i+1))*x(iv,i)
+99998                                              continue
+10001 continue 
+                                                   do 99997 iv=1,KDLON
+      y(iv,1)=ds(iv,1)
+99997                                              continue
+      do 10002 i=2,n 
+                                                   do 99996 iv=1,KDLON
+      y(iv,i)=ds(iv,i)-as(iv,i)*y(iv,i-1)
+99996                                              continue
+10002 continue
+c.......................................................................
+c
+c.......................................................................
+      RETURN
+      END 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/geticecover.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/geticecover.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/geticecover.F90	(revision 2744)
@@ -0,0 +1,1 @@
+link geticecover.F90.local
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/geticecover.F90.local
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/geticecover.F90.local	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/geticecover.F90.local	(revision 2744)
@@ -0,0 +1,341 @@
+SUBROUTINE geticecover( ngrid, ls, lontab, lattab, icecover )
+  !!**********************************************!!
+  ! A. Spiga (aymeric.spiga@upmc.fr) October 2011  !
+  !!**********************************************!!
+  IMPLICIT NONE
+  !! INPUTS
+  REAL, DIMENSION(ngrid), INTENT(IN)  :: lontab,lattab
+  REAL,                   INTENT(IN)  :: ls
+  INTEGER,                INTENT(IN)  :: ngrid
+  !! OUTPUTS
+  REAL, DIMENSION(ngrid), INTENT(OUT) :: icecover
+  !! LOCAL
+  REAL :: isitice
+  INTEGER :: ig
+  icecover(:) = 0.
+  DO ig=1,ngrid
+    icecover(ig) = isitice( ls, lontab(ig), lattab(ig) )
+  ENDDO
+END SUBROUTINE geticecover
+
+REAL FUNCTION isitice( ls, lon, lat )
+  !!**********************************************!!
+  ! A. Spiga (aymeric.spiga@upmc.fr) October 2011  !
+  !!**********************************************!!
+  IMPLICIT NONE
+  REAL, INTENT(IN) :: ls,lon,lat
+  REAL :: nplatcrocus, splatcrocus
+  isitice = 0.
+  !! for speedup purposes: 
+  !! useless to call functions for lats between -40. and 40.
+  IF (lat .le. -40.) THEN
+    IF ( lat .le. splatcrocus(ls,lon) ) isitice = 1.
+  ENDIF
+  IF (lat .ge. 40.) THEN
+    IF ( lat .ge. nplatcrocus(ls,lon) ) isitice = 1.
+  ENDIF
+END FUNCTION isitice
+
+REAL FUNCTION nplatcrocus( ls, lon )
+  !;Purpose: To return the areocentric latitude of the IR cap edge for TES year "1".
+  !;
+  !;Inputs:
+  !;  ls: Season in degrees of L_s.
+  !;  lo: East Longitude of interest.
+  !;
+  !;Dates of TES data used:  1999 FEB 28 to  2001 JAN 15
+  !;Dates of TES data used:  2001 JAN 15 to  2002 DEC 2
+  !;Dates of TES data used:  2002 DEC 2 to  1980 JAN 1
+  !;
+  !;Written by T.N. Titus Thu Dec 15 11:54:26 2005
+  !;U.S. Geological Survey Astrogeology Team.
+  !;2255 North Gemini Drive
+  !;Flagstaff, AZ 86001 USA
+  !;http://www.mars-ice.org
+  !;
+  !;If using this function for research or publication, please cite:
+  !; T. N. Titus (2005), Mars Polar Cap Edges Tracked over 3 Full Mars Years,
+  !;   36th Annual Lunar and Planetary Science Conference, March 14-18, 2005,
+  !;   in League City, Texas, abstract no.1993
+  !!**********************************************************!!
+  ! ADAPTATION: A. Spiga (aymeric.spiga@upmc.fr) October 2011  !
+  !!**********************************************************!!
+  IMPLICIT NONE
+  !! INPUT
+  REAL, INTENT(IN) :: ls,lon 
+  !! LOCAL
+  REAL, DIMENSION(40) :: gen1, gen2, quan, c, s
+  REAL, DIMENSION(40,2,3) :: tes
+  INTEGER :: year
+  REAL, DIMENSION(3) :: const, line
+  !!*****************************************************************************************
+  !! CONSTANT
+  const(:) = (/ 71.4648,70.4607,71.5339 /)
+  !! GENERIC TABS
+  gen1(:) = (/ & 
+  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
+  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
+  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
+  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
+  & 1.00000,2.00000,3.00000,4.00000, &
+  & 1.00000,2.00000,3.00000,4.00000, &
+  & 1.00000,2.00000,3.00000,4.00000, &
+  & 1.00000,2.00000,3.00000,4.00000, &
+  & 1.00000,2.00000,3.00000,4.00000 & 
+  /)
+  gen2(:) = (/ &
+  & 1.00000,1.00000,1.00000,1.00000,1.00000, &
+  & 2.00000,2.00000,2.00000,2.00000,2.00000, &
+  & 3.00000,3.00000,3.00000,3.00000,3.00000, &
+  & 4.00000,4.00000,4.00000,4.00000,4.00000, &
+  &  0.00000, 0.00000, 0.00000, 0.00000, &
+  & -1.00000,-1.00000,-1.00000,-1.00000, &
+  & -2.00000,-2.00000,-2.00000,-2.00000, &
+  & -3.00000,-3.00000,-3.00000,-3.00000, &
+  & -4.00000,-4.00000,-4.00000,-4.00000 &
+  /)
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! NORTHERN CAP
+  !!! FIRST YEAR TES
+  tes(:,1,1) = (/ &
+  & -1.04928,  -0.217329,  0.101174, -0.0374879, 0.00576928, &
+  & -0.467708,  0.213426, -0.322449,  0.248625, -0.0879115, &
+  & -0.0852889,-0.0280091,-0.185435,  0.0160633, 0.0485029, &
+  & -0.0402631, 0.163700, -0.115792, -0.0468377,-0.00756858, &
+  & -11.1382,   0.918513,  0.754372, -0.288945,  0.0435517, &
+  & 0.143201,  -0.195657,  0.0378341,-0.640119,  0.429567, &
+  & -0.114784, -0.0829540,-0.179708,  0.0328001, 0.0342086, &
+  & -0.0193232, 0.0279848, 0.180155, -0.154807,  0.0971645 &
+  /)
+  tes(:,2,1) = (/ &
+  &  0.673412,   0.194463,  0.0213440, -0.219141,   0.124593, &
+  &  0.0526366, -0.604908,  0.113683,   0.0372814, -0.0714123, &
+  & -0.00710610,-0.0933308, 0.0241633,  0.0559299, -0.0924497, &
+  &  0.0747056,  0.0400294,-0.127268,  -0.0222301,  0.0272872, &
+  & -19.2296,    4.86860,  -0.454119,  -0.375147,  -0.119044, &
+  &  0.209839,  -0.271209,  0.367698,   0.171835,   0.350654, &
+  & -0.288149,  -0.0152939, 0.0195934,  0.184573,  -0.0272326, &
+  & -0.0466995,  0.299228,- 0.0593913, -0.0660705,  0.0282595 &
+  /)
+  !!! SECOND YEAR TES
+  tes(:,1,2) = (/ &
+  & -0.728762,-0.671618,0.154561,0.112470,-0.152911,-0.633290, &
+  &  0.372959,-0.241842,0.100173,0.0558815,-0.0258014,0.0138332, &
+  & -0.113160,0.0965581,-0.0478080,0.0199076,0.0360519,-0.119565, &
+  & -0.0564988,0.00166589,-10.8664,1.34367,0.334286,-0.0889369, &
+  & 0.170191,-0.241918,0.0406942,-0.0312268,-0.542561,0.440734,&
+  & -0.181151,-0.178009,-0.216867,-0.00154585,0.0381691,0.0333462,&
+  & 0.0558955,0.0512524,-0.0389391,0.0705681 &
+  /)
+  tes(:,2,2) = (/ &
+  & 0.133511,0.301999,0.354979,-0.471594,0.151863,0.0575986, &
+  & -0.478402,-0.0168485,0.148232,-0.128787,-0.0914331,-0.0603194, &
+  & 0.0611823,0.0668322,-0.0833629,0.0176089,0.0570124,-0.0641502, &
+  & 0.0196993,-0.0272954,-18.8258,4.08857,-0.252963,-0.0642321, &
+  & -0.463212,0.380846,-0.00712758,0.0374067,0.230256,0.154810, &
+  & -0.235321,0.0838983,0.0737168,0.115381,-0.00787243,-0.0289239, &
+  & 0.169424,-0.00376776,-0.0134735,0.00663328 &
+  /)
+  !!! THIRD YEAR TES
+  tes(:,1,3) = (/ &
+  & -0.170075,-0.706807,-0.0725778,0.266425,-0.166670,-0.408371, &
+  & 0.106833,-0.318539,0.319422,-0.0361432,-0.0366784,-0.0231430, &
+  & -0.129665,0.0478013,0.0283050,0.399130,-0.177498,-0.113099, &
+  & 0.0885522,-0.0503254,-12.2470,1.40947,0.401761,-0.149156, &
+  & -0.256222,-0.0307999,0.173418,-0.112992,-0.628345,0.286791, &
+  & -0.0395388,-0.0634619,-0.263644,0.0727097,0.0679133,0.0350731, &
+  & -0.140744,0.0673651,0.0457041,-0.0454068 &
+  /)
+  tes(:,2,3) = (/ &
+  & 0.447200,-0.251112,0.597279,-0.374734,-0.0290520,-0.0208475, &
+  & -0.682811,0.146231,0.0122089,-0.0917365,0.00708168,-0.143992, &
+  & 0.0724996,0.102962,-0.0703368,-0.0429708,-0.173888,0.189929, &
+  & -0.107449,-0.0505178,-19.3010,4.83420,-1.09834,0.430944, &
+  & -0.643534,0.710448,-0.299251,0.135935,0.134539,0.320505, &
+  & -0.200302,-0.0106718,0.0166824,0.260126,-0.0992902,-0.0182585, &
+  & -0.0627401,0.232410,-0.126134,-0.0100335 &
+  /)
+  !!! MAIN CALCULATIONS
+  quan = (acos(-1.)/180.)*ls*gen1 + (acos(-1.)/180.)*lon*gen2
+  c = cos(quan)
+  s = sin(quan)
+  line(:) = 0.
+  DO year=1,3
+    line(year) = DOT_PRODUCT(c,tes(:,1,year)) - DOT_PRODUCT(s,tes(:,2,year)) + const(year)
+    !!! this is taken into account in isitice
+    !if (line(year) < -90.) line(year) = -90.
+    !if (line(year) >  90.) line(year) =  90. 
+  ENDDO
+  !!! THIS IS TEMPORARY, BUT WHY NOT FOR MODELING
+  nplatcrocus = (line(1)+line(2)+line(3))/3.
+END FUNCTION nplatcrocus
+
+REAL FUNCTION splatcrocus( ls, lon )
+  !;Purpose: To return the areocentric latitude of the IR cap edge for TES year "1".
+  !;
+  !;Inputs:
+  !;  ls: Season in degrees of L_s.
+  !;  lo: East Longitude of interest.
+  !;
+  !;Dates of TES data used:  1999 FEB 28 to  2001 JAN 15
+  !;Dates of TES data used:  2001 JAN 15 to  2002 DEC 2
+  !;Dates of TES data used:  2002 DEC 2 to  1980 JAN 1
+  !;
+  !;Written by T.N. Titus Thu Dec 15 11:54:26 2005
+  !;U.S. Geological Survey Astrogeology Team.
+  !;2255 North Gemini Drive
+  !;Flagstaff, AZ 86001 USA
+  !;http://www.mars-ice.org
+  !;
+  !;If using this function for research or publication, please cite:
+  !; T. N. Titus (2005), Mars Polar Cap Edges Tracked over 3 Full Mars Years,
+  !;   36th Annual Lunar and Planetary Science Conference, March 14-18, 2005,
+  !;   in League City, Texas, abstract no.1993
+  !!**********************************************************!!
+  ! ADAPTATION: A. Spiga (aymeric.spiga@upmc.fr) October 2011  !
+  !!**********************************************************!!
+  IMPLICIT NONE
+  !! INPUT
+  REAL, INTENT(IN) :: ls,lon
+  !! LOCAL
+  REAL, DIMENSION(60) :: gen1, gen2, quan, c, s
+  REAL, DIMENSION(60,2,2) :: tes
+  INTEGER :: year
+  REAL, DIMENSION(2) :: const, line
+  !!*****************************************************************************************
+  !! CONSTANT
+  const(:) = (/ -69.6039, -68.8420 /)
+  !! GENERIC TABS
+  gen1(:) = (/ & 
+  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
+  & 5.00000,0.00000,1.00000,2.00000,3.00000, &
+  & 4.00000,5.00000,0.00000,1.00000,2.00000, &
+  & 3.00000,4.00000,5.00000,0.00000,1.00000, &
+  & 2.00000,3.00000,4.00000,5.00000,0.00000, &
+  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
+  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
+  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
+  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
+  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
+  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
+  & 1.00000,2.00000,3.00000,4.00000,5.00000 &
+  /)
+  gen2(:) = (/ &
+  &  1.00000, 1.00000, 1.00000, 1.00000, 1.00000, &
+  &  1.00000, 2.00000, 2.00000, 2.00000, 2.00000, &
+  &  2.00000, 2.00000, 3.00000, 3.00000, 3.00000, &
+  &  3.00000, 3.00000, 3.00000, 4.00000, 4.00000, &
+  &  4.00000, 4.00000, 4.00000, 4.00000, 5.00000, &
+  &  5.00000, 5.00000, 5.00000, 5.00000, 5.00000, &
+  &  0.00000, 0.00000, 0.00000, 0.00000, 0.00000, &
+  & -1.00000,-1.00000,-1.00000,-1.00000,-1.00000, &
+  & -2.00000,-2.00000,-2.00000,-2.00000,-2.00000, &
+  & -3.00000,-3.00000,-3.00000,-3.00000,-3.00000, &
+  & -4.00000,-4.00000,-4.00000,-4.00000,-4.00000, &
+  & -5.00000,-5.00000,-5.00000,-5.00000,-5.00000 &
+  /)
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SOUTHERN CAP
+  !!! FIRST YEAR TES
+  tes(:,1,1) = (/ &
+  &  3.53762,  -1.57584,  -2.97332,  -1.07670,    0.272623,  &
+  &  0.311819,  0.842387,  1.11375,   0.388617,  -0.575892,  &
+  & -0.502105, -0.0357803,-0.689386,  0.743998,   0.796186,  &
+  &  0.304092, -0.172464, -0.290923, -0.542742,  -0.577187,  & 
+  & -0.439117,  0.266552,  0.393525,  0.0654230,  0.296123,  &
+  &  0.0949434,-0.162267, -0.175361,  0.000162221,0.105111,  &
+  & -12.4148,   0.177898,  1.45822,   0.309320,  -0.148393, 3.51232, &
+  &  0.355009, -0.782760, -0.427043, -0.178686,  -0.429962,  &
+  & -0.649747, -0.487551,  0.259459,  0.139186,  -0.964653,  &
+  & -0.409536,  0.137911,  0.293971,  0.0248885,  0.238855,  &
+  &  0.612519,  0.172469, -0.0462983,-0.0129877,  0.00532444,&
+  & -0.189464, -0.139035, -0.0231797, 0.0903127 &
+  /)
+  tes(:,2,1) = (/ &
+  &  3.21178,   3.81330,    0.357977,  -1.85466,   -1.01477,  &
+  & -0.209586, -0.797844,   0.334659,   0.828534,   0.519493, &
+  & -0.0512511,-0.204263,  -0.924137,  -0.694012, -0.0666508, &
+  &  0.632104,  0.397041,  -0.00521332, 0.933057,  0.0136105, &
+  & -0.646719, -0.480330,  -0.0122939,  0.214389,  0.0880269, &
+  &  0.0896852, 0.158164,  -0.00717643,-0.130884, -0.0425004, &
+  & -21.5000,  -5.88472,   -0.767056,   0.261383,  0.232822,  &
+  &  1.18087,   2.13123,    1.00744,   -0.0527458,-0.0417051, &
+  &  1.05940,   0.00149598,-0.501423,  -0.290405, -0.0562713, &
+  &  0.335254, -0.480024,  -0.604500,   0.0411040, 0.0403603, &
+  & -0.489831,  0.109007,   0.217500,   0.109769, -0.000845153, &
+  &  0.152139,  0.206418,  -0.0980599, -0.180992, -0.00685824 &
+  /)
+  !!! SECOND YEAR TES
+  tes(:,1,2) = (/ &
+  &  3.10733,  -0.0926926, -1.38769,   -0.638410,  0.0598460, &
+  &  0.0212056,-0.574512,  -0.687073,  -0.193427,  0.161192,  &
+  &  0.242137,  0.0178444, -0.427617,   0.892971,  0.650940,  &
+  & -0.0372970,-0.311147,  -0.123042,  -0.221688, -0.467191,  &
+  & -0.659134,  0.0246518,  0.257168,   0.124850,  0.174360,  &
+  &  0.320583,  0.136864,  -0.0606024, -0.0941828, 0.00372431,&
+  & -11.1678,  -0.376356,   0.316746,  -0.100600,  -0.119510, &
+  &  1.35807,  -1.53000,   -0.867922,   0.301309,   0.258290, &
+  &  0.0813258, 0.601762,   0.268272,   0.0989900, -0.0737015,&
+  & -0.968944, -0.599203,   0.217550,   0.466813,   0.0202996,&
+  &  0.693900,  0.653567,  -0.0888332, -0.219429,  -0.0298150,&
+  & -0.186738, -0.329258,  -0.155475,   0.0241376,  0.0613455 &
+  /)
+  tes(:,2,2) = (/ &
+  &  0.745574,  2.34362,    0.617967,  -0.847462,  -0.440483, &
+  & -0.135479,  0.546528,  -0.0659467, -0.627697,  -0.358895, &
+  &  0.0292012, 0.0797757, -0.953241,  -0.386098,   0.325419, &
+  &  0.543846,  0.108148,  -0.0596165,  1.15557,    0.436356, &
+  & -0.392191, -0.500867,  -0.205739,   0.194082,  -0.239364, &
+  & -0.136630,  0.135228,   0.213587,   0.0299697, -0.0101247,&
+  & -19.9097,  -5.34634,    0.103437,  -0.343399,  -0.348643, &
+  &  2.20957,   1.02330,   -0.722428,  -0.574345,   0.149871, &
+  & -0.635328, -0.317596,   0.154507,   0.110691,   0.0265673,&
+  &  0.593630, -0.516898  ,-0.689954,   0.00465230, 0.120493, &
+  & -0.323229,  0.491035,   0.508041,   0.0373988, -0.106504, &
+  &  0.241758,  0.0470212, -0.236231,  -0.186565,   0.0105776 &
+  /)
+  !!! MAIN CALCULATIONS
+  quan = (acos(-1.)/180.)*ls*gen1 + (acos(-1.)/180.)*lon*gen2
+  c = cos(quan)
+  s = sin(quan)
+  line(:) = 0.
+  DO year=1,2
+    line(year) = DOT_PRODUCT(c,tes(:,1,year)) - DOT_PRODUCT(s,tes(:,2,year)) + const(year)
+    !!! this is taken into account in isitice
+    !if (line(year) < -90.) line(year) = -90.
+    !if (line(year) >  90.) line(year) =  90. 
+  ENDDO
+  !!! THIS IS TEMPORARY, BUT WHY NOT FOR MODELING
+  splatcrocus = (line(1)+line(2))/2.
+END FUNCTION splatcrocus
+
+!PROGRAM main
+!
+!implicit none
+!INTEGER, PARAMETER :: ngrid = 12
+!REAL,DIMENSION(ngrid) :: lontab,lattab,icecover
+!REAL :: ls,lo,outputs,isitice
+!REAL :: nplatcrocus,splatcrocus
+!INTEGER :: i,j,zels
+!
+!DO i=0,360,30
+!print *, 'ls,np,sp ', float(i), nplatcrocus(float(i),0.), splatcrocus(float(i),0.)
+!ENDDO
+!
+!print *, 'isitice(90.,0.,50.)',isitice(90.,0.,50.)
+!print *, 'isitice(90.,0.,87.)',isitice(90.,0.,87.)
+!print *, 'isitice(90.,0.,-50.)',isitice(90.,0.,-50.)
+!print *, 'isitice(90.,0.,-87.)',isitice(90.,0.,-87.)
+!print *, 'isitice(290.,0.,50.)',isitice(290.,0.,50.)
+!print *, 'isitice(290.,0.,87.)',isitice(290.,0.,87.)
+!print *, 'isitice(290.,0.,-50.)',isitice(290.,0.,-50.)
+!print *, 'isitice(290.,0.,-87.)',isitice(290.,0.,-87.)
+!print *, 'isitice(120.,0.,90.)',isitice(120.,0.,90.)
+!
+!lontab(:) = 0.
+!lattab = (/ -90., -75., -60., -45., -30., -15.,  15.,  30.,  45.,  60.,  75.,  90. /)
+!print *,'ls. lat:', lattab
+!DO zels=0,360,30
+!  CALL geticecover( ngrid, float(zels), lontab, lattab, icecover )
+!  print *, zels, icecover
+!ENDDO
+!
+!END PROGRAM main
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/geticecover.F90.new
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/geticecover.F90.new	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/geticecover.F90.new	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../../../LMDZ.MARS/libf/phymars/geticecover.F90
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/growthrate.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/growthrate.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/growthrate.F	(revision 2744)
@@ -0,0 +1,107 @@
+      subroutine growthrate(timestep,t,p,ph2o,psat,seq,r,Cste)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c     Determination of the water ice crystal growth rate
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c
+c   arguments:
+c   ----------
+
+      REAL timestep
+      REAL t    ! temperature in the middle of the layer (K)
+      REAL p    ! pressure in the middle of the layer (K)
+      REAL*8 ph2o ! water vapor partial pressure (Pa)
+      REAL*8 psat ! water vapor saturation pressure (Pa) 
+      REAL r    ! crystal radius before condensation (m)
+      REAL seq  ! Equilibrium saturation ratio
+      REAL dr   ! crystal radius variation (m)
+
+c   local:
+c   ------
+
+      REAL molco2,molh2o
+      REAL Mco2,Mh2o,rho_i,sigh2o
+      REAL nav,rgp,kbz,pi,To
+
+c     Effective gas molecular radius (m)
+      data molco2/2.2e-10/   ! CO2
+c     Effective gas molecular radius (m)
+      data molh2o/1.2e-10/   ! H2O
+c     Molecular weight of CO2
+      data Mco2/44.e-3/            ! kg.mol-1
+c     Molecular weight of H2O
+      data Mh2o/18.e-3/            ! kg.mol-1
+c     surface tension of ice/vapor
+      data sigh2o/0.12/	     ! N.m
+c     Ice density
+      data rho_i/917./        ! kg.m-3 also defined in initcld.f
+c     Avogadro number
+      data nav/6.023e23/
+c     Perfect gas constant
+      data rgp/8.3143/
+c     Boltzman constant
+      data kbz/1.381e-23/
+c     pi number
+      data pi/3.141592654/
+c     Reference temperature, T=273,15 K 
+      data To/273.15/
+
+      REAL k,Lv                 
+      REAL knudsen           ! Knudsen number (gas mean free path/particle radius)
+      REAL a,Dv,lambda       ! Intermediate computations for growth rate
+      REAL*8 Rk,Rd
+      REAL Cste, rf
+
+c-----------------------------------------------------------------------
+c      Ice particle growth rate by diffusion/impegement of water molecules
+c                r.dr/dt = (S-Seq) / (Seq*Rk+Rd)
+c        with r the crystal radius, Rk and Rd the resistances due to 
+c        latent heat release and to vapor diffusion respectively 
+c----------------------------------------------------------------------- 
+
+c     - Equilibrium saturation accounting for KeLvin Effect
+       seq=exp(2*sigh2o*Mh2o/(rho_i*rgp*t*r))
+
+c     - Thermal conductibility of CO2
+      k  = (0.17913 * t - 13.9789) * 4.184e-4
+c     - Latent heat of h2o (J.kg-1)
+      Lv = (2834.3 - 0.28 * (t-To) - 0.004 * (t-To)**2 ) * 1.e+3
+
+c     - Constant to compute gas mean free path
+c     l= (T/P)*a, with a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+      a = 0.707*rgp/(4 * pi* molco2**2  * nav)
+
+c     - Compute Dv, water vapor diffusion coefficient
+c       accounting for both kinetic and continuum regime of diffusion,
+c       the nature of which depending on the Knudsen number.
+
+      Dv = 1./3. * sqrt( 8*kbz*t/(pi*Mh2o/nav) )* kbz * t / 
+     &   ( pi * p * (molco2+molh2o)**2 * sqrt(1.+Mh2o/Mco2) )
+
+      knudsen = t / p * a / r
+      lambda  = (1.333+0.71/knudsen) / (1.+1./knudsen)
+      Dv      = Dv / (1. + lambda * knudsen)
+
+c     - Compute Rk
+      Rk = Lv**2 * rho_i * Mh2o / (k*rgp*t**2.)
+c     - Compute Rd
+      Rd = rgp * t *rho_i / (Dv*psat*Mh2o)
+
+c     - Compute Cste=rdr/dt, then r(t+1)= sqrt(r(t)**2.+2.*Cste*dt)
+       Cste = 1. / (seq*Rk+Rd)
+c      Cste = (ph2o/psat-seq) / (seq*Rk+Rd)
+c      rf   = sqrt( max( r**2.+2.*Cste*timestep , 0. ) )
+c      dr   = rf-r
+
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/gwprofil.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/gwprofil.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/gwprofil.F	(revision 2744)
@@ -0,0 +1,216 @@
+      SUBROUTINE GWPROFIL
+     *         ( klon, klev
+     *         , kgwd ,kdx  , ktest
+     *         , KKCRIT, KKCRITH, KCRIT ,  kkenvh, kknu,kknu2
+     *         , PAPHM1, PRHO   , PSTAB , PTFR , PVPH , PRI , PTAU
+     *         , ptauf ,pdmod   , pnu   , psig ,pgamma, pvar      )
+
+C**** *GWPROFIL*
+C
+C     PURPOSE.
+C     --------
+C
+C**   INTERFACE.
+C     ----------
+C          FROM *GWDRAG*
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS ===
+C     ==== OUTPUTS ===
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD:
+C     -------
+C     THE STRESS PROFILE FOR GRAVITY WAVES IS COMPUTED AS FOLLOWS:
+C     IT IS CONSTANT (NO GWD) AT THE LEVELS BETWEEN THE GROUND
+C     AND THE TOP OF THE BLOCKED LAYER (KKENVH).
+C     IT DECREASES LINEARLY WITH HEIGHTS FROM THE TOP OF THE 
+C     BLOCKED LAYER TO 3*VAROR (kKNU), TO SIMULATES LEE WAVES OR 
+C     NONLINEAR GRAVITY WAVE BREAKING.
+C     ABOVE IT IS CONSTANT, EXCEPT WHEN THE WAVE ENCOUNTERS A CRITICAL
+C     LEVEL (KCRIT) OR WHEN IT BREAKS.
+C     
+C
+C
+C     EXTERNALS.
+C     ----------
+C
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
+C
+C     AUTHOR.
+C     -------
+C
+C     MODIFICATIONS.
+C     --------------
+C     PASSAGE OF THE NEW GWDRAG TO I.F.S. (F. LOTT, 22/11/93)
+C-----------------------------------------------------------------------
+      implicit none
+C
+
+C
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+#include "yoegwd.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      integer kgwd
+      INTEGER KKCRIT(NDLO2),KKCRITH(NDLO2),KCRIT(NDLO2)
+     *       ,kdx(NDLO2),ktest(NDLO2)
+     *       ,kkenvh(NDLO2),kknu(NDLO2),kknu2(NDLO2)
+C
+      REAL PAPHM1(NDLO2,klev+1), PSTAB(NDLO2,klev+1),
+     *     PRHO  (NDLO2,klev+1), PVPH (NDLO2,klev+1),
+     *     PRI   (NDLO2,klev+1), PTFR (NDLO2), PTAU(NDLO2,klev+1),
+     *     ptauf (NDLO2,klev+1)
+     
+      REAL pdmod (NDLO2) , pnu (NDLO2) , psig(NDLO2),
+     *     pgamma(NDLO2) , pvar(NDLO2)
+     
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+C
+c   declarations pour 'implicit none"
+      real zsqr,zalfa,zriw,zalpha,zb,zdel,zdz2n,zdelp,zdelpt
+
+      integer ji,jk,jl,ilevh
+      REAL ZDZ2 (NDLO2,nlayermx) , ZNORM(NDLO2) , zoro(NDLO2)
+      REAL ZTAU (NDLO2,nlayermx+1)
+C
+C-----------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+
+
+      kidia=1
+      kfdia=klon
+
+ 100  CONTINUE
+C
+C
+C*    COMPUTATIONAL CONSTANTS.
+C     ------------- ----------
+C
+      ilevh=KLEV/3
+C
+      DO 400 ji=1,kgwd
+      jl=kdx(ji)
+      Zoro(JL)=Psig(JL)*Pdmod(JL)/4./max(pvar(jl),1.0)
+      ZTAU(JL,KKNU(JL)+1)=PTAU(JL,KKNU(JL)+1)
+      ZTAU(JL,KLEV+1)=PTAU(JL,KLEV+1)
+  400 CONTINUE
+C
+      DO 430 JK=KLEV,2,-1
+C
+C
+C*         4.1    CONSTANT WAVE STRESS UNTIL TOP OF THE
+C                 BLOCKING LAYER.
+  410 CONTINUE
+C
+      DO 411 ji=1,kgwd
+      jl=kdx(ji)
+           IF(JK.GE.KKNU2(JL)) THEN
+           PTAU(JL,JK)=ZTAU(JL,KLEV+1)
+           ENDIF
+ 411  CONTINUE             
+C
+C*         4.15   CONSTANT SHEAR STRESS UNTIL THE TOP OF THE
+C                 LOW LEVEL FLOW LAYER.
+ 415  CONTINUE
+C        
+C
+C*         4.2    WAVE DISPLACEMENT AT NEXT LEVEL.
+C
+  420 CONTINUE
+C
+      DO 421 ji=1,kgwd
+      jl=kdx(ji)
+      IF(JK.LT.KKNU2(JL)) THEN
+      ZNORM(JL)=gkdrag*PRHO(JL,JK)*SQRT(PSTAB(JL,JK))*PVPH(JL,JK)
+     *                                                    *zoro(jl)
+      ZDZ2(JL,JK)=PTAU(JL,JK+1)/max(ZNORM(JL),gssec)
+      ENDIF
+  421 CONTINUE
+C
+C*         4.3    WAVE RICHARDSON NUMBER, NEW WAVE DISPLACEMENT
+C*                AND STRESS:  BREAKING EVALUATION AND CRITICAL 
+C                 LEVEL
+C
+      DO 431 ji=1,kgwd
+      jl=kdx(ji)
+          IF(JK.LT.KKNU2(JL)) THEN
+          IF((PTAU(JL,JK+1).LT.GTSEC).OR.(JK.LE.KCRIT(JL))) THEN
+            PTAU(JL,JK)=0.0
+          ELSE
+               ZSQR=SQRT(PRI(JL,JK))
+               ZALFA=SQRT(PSTAB(JL,JK)*ZDZ2(JL,JK))/PVPH(JL,JK)
+               ZRIW=PRI(JL,JK)*(1.-ZALFA)/(1+ZALFA*ZSQR)**2
+               IF(ZRIW.LT.GRCRIT) THEN
+                 ZDEL=4./ZSQR/GRCRIT+1./GRCRIT**2+4./GRCRIT
+                 ZB=1./GRCRIT+2./ZSQR
+                 ZALPHA=0.5*(-ZB+SQRT(ZDEL))
+                 ZDZ2N=(PVPH(JL,JK)*ZALPHA)**2/PSTAB(JL,JK)
+                 PTAU(JL,JK)=ZNORM(JL)*ZDZ2N
+               ELSE
+                 PTAU(JL,JK)=ZNORM(JL)*ZDZ2(JL,JK)
+               ENDIF
+            PTAU(JL,JK)=MIN(PTAU(JL,JK),PTAU(JL,JK+1))
+          ENDIF
+          ENDIF
+  431 CONTINUE
+  
+  430 CONTINUE
+  440 CONTINUE
+  
+c     write(*,*) 'ptau'
+c     write(*,99) ((ji,ilevh,ptau(ji,ilevh),ji=1,NDLO2),
+c    .                  ilevh=1,nlayermx+1)
+ 99   FORMAT(i3,i3,f15.5)
+
+
+C  REORGANISATION OF THE STRESS PROFILE
+C  IF BREAKING OCCURS AT LOW LEVEL:
+
+      DO 530 ji=1,kgwd
+      jl=kdx(ji)
+      ZTAU(JL,KKENVH(JL))=PTAU(JL,KKENVH(JL))
+      ZTAU(JL,KKCRITH(JL))=PTAU(JL,KKCRITH(JL))
+ 530  CONTINUE      
+
+      DO 531 JK=1,KLEV
+      
+      DO 532 ji=1,kgwd
+      jl=kdx(ji)
+                
+         IF(JK.GT.KKCRITH(JL).AND.JK.LT.KKENVH(JL))THEN
+
+          ZDELP=PAPHM1(JL,JK)-PAPHM1(JL,KKENVH(JL))
+          ZDELPT=PAPHM1(JL,KKCRITH(JL))-PAPHM1(JL,KKENVH(JL))
+          PTAU(JL,JK)=ZTAU(JL,KKENVH(JL)) +
+     .                (ZTAU(JL,KKCRITH(JL))-ZTAU(JL,KKENVH(JL)) )*
+     .                ZDELP/ZDELPT
+     
+        ENDIF
+            
+ 532  CONTINUE    
+ 
+ 531  CONTINUE        
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/gwstress.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/gwstress.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/gwstress.F	(revision 2744)
@@ -0,0 +1,134 @@
+      SUBROUTINE GWSTRESS
+     *         (  klon  , klev
+     *         , KKCRIT, KSECT, KKHLIM, KTEST, KKCRITH, KCRIT, kkenvh
+     *         , kknu
+     *         , PRHO  , PSTAB, PVPH  , PVAR ,PVARor, psig  
+     *         , PTFR  , PTAU  
+     *         ,pgeom1 , pgamma, pd1  , pd2   ,pdmod ,pnu )
+C
+C**** *GWSTRESS*
+C
+C     PURPOSE.
+C     --------
+C
+C**   INTERFACE.
+C     ----------
+C     CALL *GWSTRESS*  FROM *GWDRAG*
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS ===
+C     ==== OUTPUTS ===
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C
+C     EXTERNALS.
+C     ----------
+C
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
+C
+C     AUTHOR.
+C     -------
+C
+C     MODIFICATIONS.
+C     --------------
+C     F. LOTT PUT THE NEW GWD ON IFS      22/11/93
+C
+C-----------------------------------------------------------------------
+      implicit none
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+
+#include "yoegwd.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      INTEGER KKCRIT(NDLO2),KKCRITH(NDLO2),KCRIT(NDLO2),KSECT(NDLO2),
+     *        KKHLIM(NDLO2),KTEST(NDLO2),KKENVH(NDLO2),KKNU(NDLO2)
+C
+      REAL PRHO(NDLO2,klev+1),PSTAB(NDLO2,klev+1),PTAU(NDLO2,klev+1),
+     *     PVPH(NDLO2,klev+1),PVAR(NDLO2,4),PTFR(NDLO2),
+     *     pgeom1(NDLO2,klev),PVARor(NDLO2)
+C
+      real pd1(NDLO2),pd2(NDLO2),pnu(NDLO2),psig(NDLO2),pgamma(NDLO2)
+      real pdmod(NDLO2)
+C
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+      integer jl
+      real zblock,zvar,zeff
+      logical lo
+
+C
+C-----------------------------------------------------------------------
+C
+C*       0.3   FUNCTIONS
+C              ---------
+C     ------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+
+
+      kidia=1
+      kfdia=klon
+
+
+C
+ 100  CONTINUE
+C
+C*         3.1     GRAVITY WAVE STRESS.
+C
+  300 CONTINUE
+C
+C
+      DO 301 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+      
+C  EFFECTIVE MOUNTAIN HEIGHT ABOVE THE BLOCKED FLOW
+  
+c        IF(KKENVH(JL).EQ.KLEV)THEN
+         ZBLOCK=0.0 
+c        ELSE
+c         ZBLOCK=(PGEOM1(JL,KKENVH(JL))+PGEOM1(JL,KKENVH(JL)+1))/2./RG          
+c        ENDIF
+      
+        ZVAR=PVAROR(JL)
+        ZEFF=AMAX1(0.,2.*ZVAR-ZBLOCK)
+
+        PTAU(JL,KLEV+1)=PRHO(JL,KLEV+1)*GKDRAG*psig(jl)*ZEFF**2
+     *    /4./ZVAR*PVPH(JL,KLEV+1)*pdmod(jl)*sqrt(pstab(jl,klev+1))
+
+C  TOO SMALL VALUE OF STRESS OR  LOW LEVEL FLOW INCLUDE CRITICAL LEVEL
+C  OR LOW LEVEL FLOW:  GRAVITY WAVE STRESS NUL.
+                
+        LO=(PTAU(JL,KLEV+1).LT.GTSEC).OR.(KCRIT(JL).GE.KKNU(JL))
+     *      .OR.(PVPH(JL,KLEV+1).LT.GVCRIT)
+c       IF(LO) PTAU(JL,KLEV+1)=0.0
+      
+      ELSE
+      
+          PTAU(JL,KLEV+1)=0.0
+          
+      ENDIF
+      
+  301 CONTINUE
+C
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/ineofdump.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/ineofdump.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/ineofdump.F	(revision 2744)
@@ -0,0 +1,71 @@
+      subroutine ineofdump
+
+c._.  subroutine ineofdump(long, lati)
+
+      implicit none
+c
+c     Initialise dumping of profiles for EOF calculations
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comvert.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+c
+c._.#include "param2"
+c._.#include "bats"
+c._.#include "outcon"
+c._.#include "phycmn"
+c
+#include "eofdump.h"
+c
+c._.      real*4 long(cols,rows)
+c._.      real*4 lati(cols,rows)
+      integer ig,i,j,l    
+      logical firstcall
+      save firstcall
+
+      data firstcall/.true./
+
+      if (firstcall) then
+         firstcall=.false.
+      endif
+
+c
+c     Set frequency for dumping at once per day
+c
+      ieofs=nint(daysec/dtphys)
+      if (abs(float(ieofs)-daysec/dtphys).gt.1.e-8*daysec)
+     :   stop'In ineofdump:  1 day .ne. n physics timesteps'
+c
+c     Header
+c
+      open(uehead,file='profiles.hdr',form='formatted')
+c._.  write(uehead,*) rntape, kstart, ktotal, itspd, kphysic, refday
+      write(uehead,*) 0.E+0,0,0,ieofs,1,0
+c._.  write(uehead,*) cols, rows, npgrid, nl
+      write(uehead,*) iim,npgrid/iim,npgrid,nlayermx
+
+c._.  do i=1,cols,eofskip
+c._.    do j=1+eofskip/2,rows,eofskip
+c._.      write(uehead,*) long(i,j)*180./pi, lati(i,j)*180./pi
+c._.    enddo
+c._.  enddo
+      do i=1,iim,eofskip
+        do j=1+eofskip/2,jjm+1,eofskip    
+          ig = 1+ (j-2)*iim +i
+          if(j.eq.1) stop 'Problem in ineofdump.F'
+          if(j.eq.jjm+1) stop 'Problem in ineofdump.F'
+          write(uehead,*) long(ig)*180./pi, lati(ig)*180./pi
+c         write(*,*) 'eof grid j=',j,' lat= ', lati(ig)*180./pi
+        enddo
+      enddo
+
+      write(uehead,*) aps
+      write(uehead,*) bps
+      close(uehead)
+c
+c     Main profile file
+c
+      open(uedata,file='profiles.dat',form='unformatted')
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/inifis.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/inifis.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/inifis.F	(revision 2744)
@@ -0,0 +1,777 @@
+      SUBROUTINE inifis(ngrid,nlayer,
+     $           wday_ini,wdaysec,
+     $           wappel_phys,
+     $           plat,plon,parea,
+     $           prad,pg,pr,pcpp,
+     $           nq, wdt,
+     $           womeg,wmugaz,
+     $           wyear_day,wperiheli,waphelie,wperi_day,wobliquit, 
+     $           wz0,wemin_turb,wlmixmin,
+     $           wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS, 
+     $           wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,
+     $           walbedodat,winertiedat,wphisfi, 
+     $           wzmea,wzstd,wzsig,wzgam,wzthe,
+     $           wtheta,wpsi)
+
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c	CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+c
+c	... CHECK THE ****WRF lines
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Initialisation for the physical parametrisations of the LMD 
+c   martian atmospheric general circulation modele.
+c
+c   author: Frederic Hourdin 15 / 10 /93
+c   -------
+c   modified: Sebastien Lebonnois 11/06/2003 (new callphys.def)
+c   adapted to the WRF use - Aymeric Spiga - Jan 2007
+c
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    pdayref               Day of reference for the simulation
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "planete.h"
+#include "comcstfi.h"
+#include "comsaison.h"
+#include "comdiurn.h"
+#include "comgeomfi.h"
+#include "callkeys.h"
+#include "surfdat.h"
+#include "slope.h"
+
+
+      INTEGER ngrid,nlayer,nq
+
+      REAL prad,pg,pr,pcpp,pdaysec
+      REAL womeg,wmugaz,wdaysec  
+      REAL wyear_day,wperiheli,waphelie,wperi_day,wobliquit
+      REAL wz0,wemin_turb,wlmixmin
+      REAL wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS
+
+      REAL wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS     
+      REAL walbedodat(ngrid),winertiedat(ngrid),wphisfi(ngrid) 
+      REAL wzmea(ngrid),wzstd(ngrid),wzsig(ngrid)
+      REAL wzgam(ngrid),wzthe(ngrid)
+      REAL wtheta(ngrid),wpsi(ngrid)
+
+      REAL plat(ngrid),plon(ngrid),parea(ngridmx)
+      integer wday_ini
+      REAL wdt
+      INTEGER ig,ierr
+
+      INTEGER wecri_phys
+      REAL wappel_phys
+ 
+      EXTERNAL iniorbit,orbite
+      EXTERNAL SSUM
+      REAL SSUM
+ 
+      CHARACTER ch1*12
+      CHARACTER ch80*80
+
+      logical chem, h2o
+
+c ****WRF
+c
+c------------------------------------------------------
+c  Fill some parameters in the 'include' files
+c  >> Do part of the job previously done by phyetat0.F
+c  >> Complete list of parameters is found in tabfi.F
+c------------------------------------------------------
+c
+c Values are defined in the module_model_constants.F WRF routine
+c      
+      ! in 'comcstfi.h'
+      rad=prad                  
+      cpp=pcpp
+      g=pg
+      r=pr                    
+      rcp=r/cpp
+      daysec=wdaysec  
+      omeg=womeg                
+      mugaz=wmugaz  
+      print*,"check: rad,cpp,g,r,rcp,daysec,omeg,mugaz"
+      print*,rad,cpp,g,r,rcp,daysec,omeg,mugaz
+    
+      ! in 'planet.h' 
+      year_day=wyear_day
+      periheli=wperiheli
+      aphelie=waphelie
+      peri_day=wperi_day
+      obliquit=wobliquit
+      z0=wz0
+      emin_turb=wemin_turb
+      lmixmin=wlmixmin
+      print*,"check: year_day,periheli,aphelie,peri_day,obliquit"
+      print*,year_day,periheli,aphelie,peri_day,obliquit
+      print*,"check: z0,emin_turb,lmixmin"
+      print*,z0,emin_turb,lmixmin
+
+      ! in 'surfdat.h'
+      emissiv=wemissiv
+      emisice(1)=wemissiceN
+      emisice(2)=wemissiceS
+      albedice(1)=walbediceN
+      albedice(2)=walbediceS
+      iceradius(1)=wiceradiusN
+      iceradius(2)=wiceradiusS
+      dtemisice(1)=wdtemisiceN
+      dtemisice(2)=wdtemisiceS
+      print*,"check: emissiv,emisice,albedice,iceradius,dtemisice"
+      print*,emissiv,emisice,albedice,iceradius,dtemisice
+
+c
+c Values are defined in the WPS processing
+c  
+        albedodat(:)=walbedodat(:)
+        inertiedat(:)=winertiedat(:)
+        phisfi(:)=wphisfi(:)
+        print*,"check: albedodat(1),inertiedat(1),phisfi(1)"
+        print*,albedodat(1),inertiedat(1),phisfi(1)
+        print*,"check: albedodat(end),inertiedat(end),phisfi(end)"
+        print*,albedodat(ngrid),inertiedat(ngrid),phisfi(ngrid)
+
+        ! NB: usually, gravity wave scheme is useless in mesoscale modeling
+        ! NB: we however keep the option for coarse grid case ... 	
+        zmea(:)=wzmea(:)
+        zstd(:)=wzstd(:)
+        zsig(:)=wzsig(:)
+        zgam(:)=wzgam(:)
+        zthe(:)=wzthe(:)
+        print*,"check: gw param"
+        print*,zmea(1),zmea(ngrid)
+        print*,zstd(1),zstd(ngrid)
+        print*,zsig(1),zsig(ngrid)
+        print*,zgam(1),zgam(ngrid)
+        print*,zthe(1),zthe(ngrid)
+
+        !
+        ! in slope.h
+        !
+        theta_sl(:)=wtheta(:)
+        psi_sl(:)=wpsi(:)
+        print*,"check: theta_sl(1),psi_sl(1)"
+        print*,theta_sl(1),psi_sl(1)
+        print*,"check: theta_sl(end),psi_sl(end)"
+        print*,theta_sl(ngrid),psi_sl(ngrid)
+
+
+c ****WRF
+
+ 
+
+c --------------------------------------------------------
+c     The usual Tests
+c     --------------
+
+c ****WRF
+c useless here, because it was already done in the WRF driver
+
+      IF (nlayer.NE.nlayermx) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'nlayer     = ',nlayer
+         PRINT*,'nlayermx   = ',nlayermx
+         STOP
+      ENDIF
+
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+
+c --------------------------------------------------------------
+c  Reading the "callphys.def" file controlling some key options
+c --------------------------------------------------------------
+
+      callrad=.true.
+      calldifv=.true.
+      calladj=.true.
+      callcond=.true.
+      callsoil=.true.
+      season=.true.
+      diurnal=.false.
+      lwrite=.false.
+      calllott=.true.
+      iaervar=2
+      iddist=3
+      topdustref=55.
+      OPEN(99,file='callphys.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+      IF(ierr.EQ.0) THEN
+         !PRINT*
+         !PRINT*
+         PRINT*,'--------------------------------------------'
+         PRINT*,' Parametres pour la physique (callphys.def)'
+         PRINT*,'--------------------------------------------'
+
+         READ(99,*)
+         READ(99,*)
+
+         READ(99,fmt='(a)') ch1 
+         READ(99,*) tracer
+         WRITE(*,8000) ch1,tracer
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') diurnal
+         WRITE(*,8000) ch1,diurnal
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') season
+         WRITE(*,8000) ch1,season
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') lwrite
+         WRITE(*,8000) ch1,lwrite
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callstats
+         WRITE(*,8000) ch1,callstats
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calleofdump
+         WRITE(*,8000) ch1,calleofdump
+
+         READ(99,*)
+         READ(99,*)
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*,iostat=ierr) iaervar
+         if(ierr.ne.0) stop'no iaervar in callphys.def (old?)'
+c****WRF: ligne trop longue ....
+         WRITE(*,8001) ch1,iaervar
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) iddist
+         WRITE(*,8001) ch1,iddist
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) topdustref
+         WRITE(*,8002) ch1,topdustref
+
+         READ(99,*)
+         READ(99,*)
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callrad
+         WRITE(*,8000) ch1,callrad
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callnlte
+         WRITE(*,8000) ch1,callnlte
+         
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callnirco2
+         WRITE(*,8000) ch1,callnirco2
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calldifv
+         WRITE(*,8000) ch1,calldifv
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calladj
+         WRITE(*,8000) ch1,calladj
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callcond
+         WRITE(*,8000) ch1,callcond
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callsoil
+         WRITE(*,8000) ch1,callsoil
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calllott
+         WRITE(*,8000) ch1,calllott
+
+         READ(99,*) 
+         READ(99,*)
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) iradia
+         WRITE(*,8001) ch1,iradia
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callg2d
+         WRITE(*,8000) ch1,callg2d
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) rayleigh
+         WRITE(*,8000) ch1,rayleigh
+
+         READ(99,*) 
+         READ(99,*)
+
+c TRACERS:
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) dustbin
+         WRITE(*,8001) ch1,dustbin
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) active
+         WRITE(*,8000) ch1,active
+
+c Test of incompatibility:
+c if active is used, then dustbin should be > 0
+
+         if (active.and.(dustbin.lt.1)) then
+           print*,'if active is used, then dustbin should > 0'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) doubleq
+         WRITE(*,8000) ch1,doubleq
+
+c Test of incompatibility:
+c if doubleq is used, then dustbin should be 1
+
+         if (doubleq.and.(dustbin.ne.1)) then
+           print*,'if doubleq is used, then dustbin should be 1'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) lifting
+         WRITE(*,8000) ch1,lifting
+
+c Test of incompatibility:
+c if lifting is used, then dustbin should be > 0
+
+         if (lifting.and.(dustbin.lt.1)) then
+           print*,'if lifting is used, then dustbin should > 0'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) callddevil
+         WRITE(*,8000) ch1,callddevil
+
+c Test of incompatibility:
+c if dustdevil is used, then dustbin should be > 0
+
+         if (callddevil.and.(dustbin.lt.1)) then
+           print*,'if dustdevil is used, then dustbin should > 0'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) scavenging
+         WRITE(*,8000) ch1,scavenging
+
+c Test of incompatibility:
+c if scavenging is used, then dustbin should be > 0
+
+         if (scavenging.and.(dustbin.lt.1)) then
+           print*,'if scavenging is used, then dustbin should > 0'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) sedimentation
+         WRITE(*,8000) ch1,sedimentation
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) iceparty
+         WRITE(*,8000) ch1,iceparty
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) activice
+         WRITE(*,8000) ch1,activice
+
+c Test of incompatibility:
+c if activice is used, then iceparty should be used too
+
+         if (activice.and..not.iceparty) then
+           print*,'if activice is used, iceparty should be used too'
+           stop
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) water
+         WRITE(*,8000) ch1,water
+
+c Test of incompatibility:
+c if iceparty is used, then water should be used too
+
+         if (.not.water) then
+            iceparty = .false. 
+         endif
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) caps
+         WRITE(*,8000) ch1,caps
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) photochem
+         WRITE(*,8000) ch1,photochem
+
+         READ(99,*)
+         READ(99,*)
+
+c THERMOSPHERE
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callthermos
+         WRITE(*,8000) ch1,callthermos
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') thermoswater
+         WRITE(*,8000) ch1,thermoswater
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callconduct
+         WRITE(*,8000) ch1,callconduct
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') calleuv
+         WRITE(*,8000) ch1,calleuv
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callmolvis
+         WRITE(*,8000) ch1,callmolvis
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callmoldiff
+         WRITE(*,8000) ch1,callmoldiff
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') thermochem
+         WRITE(*,8000) ch1,thermochem
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) solarcondate
+         WRITE(*,*) ch1,solarcondate
+
+         if (.not.callthermos) then
+                 thermoswater=.false.          
+                 callconduct=.false.          
+                 calleuv=.false.          
+                 callmolvis=.false.          
+                 callmoldiff=.false.          
+                 thermochem=.false.          
+        end if
+
+c Test of incompatibility:
+c if photochem is used, then water should be used too
+
+         if (photochem.and..not.water) then
+           print*,'if photochem is used, water should be used too'
+           stop
+         endif
+
+c if callthermos is used, then thermoswater should be used too 
+c (if water not used already)
+
+         if (callthermos .and. .not.water) then
+           if (callthermos .and. .not.thermoswater) then
+             print*,'if callthermos is used, water or thermoswater 
+     &               should be used too'
+             stop
+           endif
+         endif
+
+         PRINT*,'--------------------------------------------'
+         PRINT*
+         PRINT*
+      ELSE
+         write(*,*)
+         write(*,*) 'Cannot read file callphys.def. Is it here ?'
+         stop
+      ENDIF
+      CLOSE(99)
+
+      !!-----------------------------------------
+      !! titus cap
+      OPEN(99,file='titus.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+      IF(ierr.EQ.0) THEN
+         READ(99,*,iostat=ierr) tituscap
+      ELSE
+         write(*,*) 'no titus.def files. assuming no Titus cap.'
+         tituscap = .false.
+      ENDIF
+      write(*,*) 'Titus cap is: ',tituscap
+      CLOSE(99)
+      !!-----------------------------------------
+
+
+8000  FORMAT(t5,a12,l8)
+8001  FORMAT(t5,a12,i8)
+8002  FORMAT(t5,a12,f8.1)
+
+
+c ****WRF
+c*****************************************************
+c Since it comes from WRF settings, we have to
+c fill dtphys in the include file 
+c It must be set now, because it is used afterwards
+c
+c Opportunity is taken to fill ecri_phys as well
+c*****************************************************
+        dtphys=wdt*wappel_phys
+        print*,'Physical timestep (s) ',dtphys
+        ecri_phys=10 !8.e18  !! a dummy low frequency
+        print*,'Physical frequency for writing ',ecri_phys
+c
+c ****WRF
+
+
+      PRINT*
+      PRINT*,'daysec',daysec
+      PRINT*
+      PRINT*,'The radiative transfer is computed:'
+      PRINT*,'           each ',iradia,' physical time-step'
+      PRINT*,'        or each ',iradia*dtphys,' seconds'
+      PRINT*
+
+
+
+c --------------------------------------------------------------
+c  Managing the Longwave radiative transfer
+c --------------------------------------------------------------
+
+c     In most cases, the run just use the following values :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      callemis=.true.     
+c     ilwd=10*int(daysec/dtphys) ! bug before 22/10/01       
+      ilwd=10*int(daysec/dtphys) 
+      ilwn=2               
+      linear=.true.        
+      ncouche=3
+      alphan=0.4
+      ilwb=2
+      semi=0
+
+c     BUT people working hard on the LW may want to read them in 'radia.def' 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      OPEN(99,file='radia.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+      IF(ierr.EQ.0) THEN
+         write(*,*) 'Reading radia.def !!!'
+         READ(99,fmt='(a)') ch1
+         READ(99,*) callemis
+         WRITE(*,8000) ch1,callemis
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) iradia
+         WRITE(*,8001) ch1,iradia
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) ilwd
+         WRITE(*,8001) ch1,ilwd
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) ilwn
+         WRITE(*,8001) ch1,ilwn
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) linear
+         WRITE(*,8000) ch1,linear
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) ncouche
+         WRITE(*,8001) ch1,ncouche
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) alphan
+         WRITE(*,*) ch1,alphan
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) ilwb
+         WRITE(*,8001) ch1,ilwb
+
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callg2d
+         WRITE(*,8000) ch1,callg2d
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) semi
+         WRITE(*,*) ch1,semi
+      end if
+
+c-----------------------------------------------------------------------
+c     Some more initialization:
+c     ------------------------
+
+      ! in 'comgeomfi.h'	
+      CALL SCOPY(ngrid,plon,1,long,1)
+      CALL SCOPY(ngrid,plat,1,lati,1)
+      CALL SCOPY(ngrid,parea,1,area,1)
+      totarea=SSUM(ngridmx,area,1)
+
+      ! in 'comdiurn.h'
+      DO ig=1,ngrid
+         sinlat(ig)=sin(plat(ig))
+         coslat(ig)=cos(plat(ig))
+         sinlon(ig)=sin(plon(ig))
+         coslon(ig)=cos(plon(ig))
+      ENDDO
+
+      pi=2.*asin(1.)
+
+c     managing the tracers, and tests:
+c     -------------------------------
+
+      if(tracer) then
+
+c          when photochem is used, nqchem_min is the rank
+c          of the first chemical species
+
+       nqchem_min = 1
+       if (photochem .or. callthermos) then
+         chem = .true.
+        if (doubleq) then
+          nqchem_min = 3
+        else
+          nqchem_min = dustbin+1
+        end if
+       end if
+
+       if (water .or. thermoswater) h2o = .true.
+
+c          TESTS
+
+       print*,'TRACERS:'
+
+       if ((doubleq).and.(h2o).and.
+     $     (chem).and.(iceparty)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         print*,' 3 to ',nqmx-2,': chemistry'
+         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+       endif
+
+       if ((doubleq).and.(h2o).and.
+     $     (chem).and..not.(iceparty)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         print*,' 3 to ',nqmx-1,': chemistry'
+         print*,nqmx,': water vapor'
+       endif
+
+       if ((doubleq).and.(h2o).and.
+     $     .not.(chem).and.(iceparty)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+         if (nqmx.ne.4) then
+           print*,'nqmx should be 4 with these options.'
+           print*,'(or check callphys.def)'
+           stop
+         endif
+       endif
+
+       if ((doubleq).and.(h2o).and.
+     $     .not.(chem).and..not.(iceparty)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         print*,nqmx,': water vapor'
+         if (nqmx.ne.3) then
+           print*,'nqmx should be 3 with these options...'
+           print*,'(or check callphys.def)'
+           stop
+         endif
+       endif
+
+       if ((doubleq).and..not.(h2o)) then
+         print*,' 1: dust ; 2: dust (doubleq)'
+         if (nqmx.ne.2) then
+           print*,'nqmx should be 2 with these options...'
+           print*,'(or check callphys.def)'
+           stop
+         endif
+       endif
+
+       if (.not.(doubleq).and.(h2o).and.
+     $     (chem).and.(iceparty)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+         endif
+         print*,nqchem_min,' to ',nqmx-2,': chemistry'
+         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+       endif
+       if (.not.(doubleq).and.(h2o).and.
+     $     (chem).and..not.(iceparty)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+         endif
+         print*,nqchem_min,' to ',nqmx-1,': chemistry'
+         print*,nqmx,': water vapor'
+       endif
+       if (.not.(doubleq).and.(h2o).and.
+     $     .not.(chem).and.(iceparty)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+         endif
+         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+         if (nqmx.ne.(dustbin+2)) then
+           print*,'nqmx should be ',(dustbin+2),
+     $            ' with these options...'
+           print*,'(or check callphys.def)'
+           stop
+         endif
+       endif
+       if (.not.(doubleq).and.(h2o).and.
+     $     .not.(chem).and..not.(iceparty)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+         endif
+         print*,nqmx,': water vapor'
+         if (nqmx.ne.(dustbin+1)) then
+           print*,'nqmx should be ',(dustbin+1),
+     $            ' with these options...'
+           print*,'(or check callphys.def)'
+           stop
+         endif
+       endif
+       if (.not.(doubleq).and..not.(h2o)) then
+         if (dustbin.gt.0) then
+           print*,' 1 to ',dustbin,': dust bins'
+           if (nqmx.ne.dustbin) then
+             print*,'nqmx should be ',dustbin,
+     $              ' with these options...'
+             print*,'(or check callphys.def)'
+             stop
+           endif
+         else
+           print*,'dustbin=',dustbin,
+     $            ': tracer should be F with these options...'
+     $           ,'UNLESS you just want to move tracers around '
+         endif
+       endif
+
+      endif
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/iniorbit.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/iniorbit.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/iniorbit.F	(revision 2744)
@@ -0,0 +1,102 @@
+      SUBROUTINE iniorbit
+     $     (paphelie,pperiheli,pyear_day,pperi_day,pobliq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:
+c   -------
+c     Frederic Hourdin      22 Fevrier 1991
+c
+c   Objet:
+c   ------
+c    Initialisation du sous programme orbite qui calcule
+c    a une date donnee de l'annee de duree year_day commencant
+c    a l'equinoxe de printemps et dont le perihelie se situe
+c    a la date peri_day, la distance au soleil et la declinaison.
+c
+c   Interface:
+c   ----------
+c   - Doit etre appele avant d'utiliser orbite.
+c   - initialise une partie du common planete.h
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   aphelie       \   aphelie et perihelie de l'orbite
+c   periheli      /   en millions de kilometres.
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c   Arguments:
+c   ----------
+
+      REAL paphelie,pperiheli,pyear_day,pperi_day,pobliq
+
+c   Local:
+c   ------
+
+      REAL zxref,zanom,zz,zx0,zdx
+      INTEGER iter
+
+c-----------------------------------------------------------------------
+
+      pi=2.*asin(1.)
+
+      aphelie =paphelie
+      periheli=pperiheli
+      year_day=pyear_day
+      obliquit=pobliq
+      peri_day=pperi_day
+
+      PRINT*,'Perihelie en Mkm  ',periheli
+      PRINT*,'Aphelise  en Mkm  ',aphelie 
+      PRINT*,'obliquite en degres  :',obliquit
+      unitastr=149.597927
+      e_elips=(aphelie-periheli)/(periheli+aphelie)
+      p_elips=0.5*(periheli+aphelie)*(1-e_elips*e_elips)/unitastr
+
+      print*,'e_elips',e_elips
+      print*,'p_elips',p_elips
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(year_day-pperi_day)/year_day
+      zanom=2.*pi*(zz-nint(zz))
+      zxref=abs(zanom)
+      PRINT*,'zanom  ',zanom
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = zxref
+c  methode de Newton
+
+      zx0=zxref+e_elips*sin(zxref)
+      DO 110 iter=1,100
+         zdx=-(zx0-e_elips*sin(zx0)-zxref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-12)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+      PRINT*,'zx0   ',zx0
+
+c zteta est la longitude solaire
+
+      timeperi=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+      PRINT*,'longitude solaire du perihelie timeperi = ',timeperi
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/inistats.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/inistats.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/inistats.F	(revision 2744)
@@ -0,0 +1,112 @@
+      subroutine inistats(ierr)
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+      integer,intent(out) :: ierr
+      integer :: nid
+      integer :: l,nsteppd
+      real, dimension(llm) ::  sig_s
+      integer :: idim_lat,idim_lon,idim_llm,idim_llmp1,idim_time
+      real, dimension(istime) :: lt
+      integer :: nvarid
+
+      write (*,*) 
+      write (*,*) '                        || STATS ||'
+      write (*,*) 
+      write (*,*) 'daysec',daysec
+      write (*,*) 'dtphys',dtphys
+      nsteppd=nint(daysec/dtphys)
+      write (*,*) 'nsteppd=',nsteppd
+      if (abs(float(nsteppd)-daysec/dtphys).gt.1.e-8*daysec)
+     ,   stop'Dans Instat:  1jour .ne. n pas physiques'
+
+      if(mod(nsteppd,istime).ne.0)
+     ,   stop'Dans Instat:  1jour .ne. n*istime pas physiques'
+
+      istats=nsteppd/istime
+      write (*,*) 'istats=',istats
+      write (*,*) 'Storing ',istime,'times per day'
+      write (*,*) 'thus every ',istats,'physical timestep '
+      write (*,*) 
+
+      do l= 1, llm
+         sig_s(l)=((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
+         pseudoalt(l)=-10.*log(presnivs(l)/preff)   
+      enddo
+
+      ierr = NF_CREATE("stats.nc",NF_CLOBBER,nid)
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_lat)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_lon)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid, "llmp1", llm+1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_time)
+
+      ierr = NF_ENDDEF(nid)
+      call def_var(nid,"Time","Time",
+     .            "days since 0000-00-0 00:00:00",1,
+     .            idim_time,nvarid,ierr)
+! Time is initialised later by mkstats subroutine
+
+      call def_var(nid,"latitude","latitude","degrees_north",1,
+     .            idim_lat,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+      call def_var(nid,"longitude","East longitude","degrees_east",1,
+     .            idim_lon,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+
+! Niveaux verticaux, aps et bps
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"altitude", NF_DOUBLE, 1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"altitude", NF_FLOAT, 1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",8,"altitude")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif 
+      call def_var(nid,"aps","hybrid pressure at midlayers"," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+
+      call def_var(nid,"bps","hybrid sigma at midlayers"," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else 
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+
+      ierr=NF_CLOSE(nid)
+
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/initracer.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/initracer.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/initracer.F	(revision 2744)
@@ -0,0 +1,300 @@
+      SUBROUTINE initracer(qsurf,co2ice)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Initialisation related to tracer 
+c (transported dust, water, chemical species, ice...)
+c
+c   Name of the tracer
+c
+c   Test of dimension :
+c   Initialise COMMON tracer in tracer.h
+c
+c   If water=T : q(iq=nqmx) is the water mass mixing ratio
+c   If water=T and iceparty=T : q(iq=nqmx-1) is the ice mass mixing ratio
+
+c   If there is transported dust, it uses iq=1 to iq=dustbin
+c   If there is no transported dust : dustbin=0
+c   If doubleq=T : q(iq=1) is the dust mass mixing ratio
+c                  q(iq=2) is the dust number mixing ratio 
+
+c   If (photochem.or.thermochem) there is "ncomp" chemical species (ncomp
+c   is set in aeronomars/chimiedata.h) using the ncomp iq values starting at
+c      iq=nqchem_min = dustbin+1   (nqchem_min is defined in inifis.F)
+c   
+c
+c   author: F.Forget
+c   ------
+c    Modifs: Franck Montmessin, Sebastien Lebonnois (june 2003)
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+
+#include "comgeomfi.h"
+#include "watercap.h"
+#include "aerice.h"
+#include "fisice.h"
+#include "chimiedata.h"
+
+
+      real qsurf(ngridmx,nqmx)       ! tracer on surface (e.g.  kg.m-2)
+      real co2ice(ngridmx)           ! co2 ice mass on surface (e.g.  kg.m-2)
+      integer iq,ig
+      real r0_lift , reff_lift
+
+c-----------------------------------------------------------------------
+c  radius(nqmx)      ! aerosol particle radius (m)
+c  qext(nqmx)        ! Single Scat. Extinction coeff at 0.67 um
+c  alpha_lift(nqmx)  ! saltation vertical flux/horiz flux ratio (m-1)
+c  alpha_devil(nqmx) ! lifting coeeficient by dust devil
+c  rho_dust          ! Mars dust density
+c  rho_ice           ! Water ice density
+c  doubleq           ! if method with mass (iq=1) and number(iq=2) mixing ratio
+c  varian            ! Characteristic variance of log-normal distribution
+c-----------------------------------------------------------------------
+
+
+c------------------------------------------------------------
+c     Test Dimensions tracers
+c------------------------------------------------------------
+
+      if(photochem.or.thermochem) then
+          if (iceparty) then
+              if ((nqchem_min+ncomp+1).ne.nqmx) then
+                 print*,'********* Dimension problem! ********'
+                 print*,"nqchem_min+ncomp+1).ne.nqmx"
+                 print*,"ncomp: ",ncomp
+                 print*,"nqchem_min: ",nqchem_min
+                 print*,"nqmx: ",nqmx
+                 print*,'Change ncomp in chimiedata.h'
+               endif
+          else
+               if ((nqchem_min+ncomp).ne.nqmx) then
+                 print*,'********* Dimension problem! ********'
+                 print*,"nqchem_min+ncomp).ne.nqmx"
+                 print*,"ncomp: ",ncomp
+                 print*,"nqchem_min: ",nqchem_min
+                 print*,"nqmx: ",nqmx
+                 print*,'Change ncomp in chimiedata.h'
+                 STOP
+               endif
+            endif
+          endif
+
+c------------------------------------------------------------
+c         NAME and molar mass of the tracer 
+c------------------------------------------------------------
+
+c noms and mmol vectors:
+      if (water) then 
+         mmol(nqmx) = 18.
+         noms(nqmx)   = 'h2o'
+      end if
+      if (iceparty) then
+         noms(nqmx-1) = 'ice'
+         mmol(nqmx-1) = 18.
+      end if
+      if(photochem.or.thermochem) then
+         do iq=nqchem_min, nqchem_min+ncomp-1
+             noms(iq) = nomchem(iq-nqchem_min+1)
+             mmol(iq) = mmolchem(iq-nqchem_min+1)
+         enddo
+      end if
+      if (dustbin.ge.1) then
+          do iq=1,dustbin
+            noms(iq) = 'dust'
+            mmol(iq) = 100.
+          enddo
+          if (doubleq) then
+           noms(1) = 'dust mass mix. ratio'
+           noms(dustbin) = 'dust number mix. ratio'
+          end if
+      end if
+
+c     Simulation of CO2 + neutral gaz
+      if ((dustbin.eq.0).and.(.not.water)) then
+         noms(1) = 'co2'
+         mmol(1) = 44
+         if (nqmx.eq.2)then
+            noms(nqmx) = 'Ar_N2'
+            mmol(nqmx) = 30
+         end if 
+      end if 
+   
+
+c------------------------------------------------------------
+c     Initialisation tracers ....
+c------------------------------------------------------------
+
+      rho_dust=2500.  ! Mars dust density (kg.m-3)
+      rho_ice=920.    ! Water ice density (kg.m-3)
+
+      if (doubleq) then
+c       "doubleq" technique 
+c       -------------------
+c      (transport of mass and number mixing ratio)
+c       iq=1: Q mass mixing ratio, iq=2: N number mixing ratio
+
+        if( (nqmx.lt.2).or.(water.and.(nqmx.lt.3)) ) then
+            write(*,*) 'nqmx is too low : nqmx=', nqmx
+            write(*,*) 'water= ',water,' doubleq= ',doubleq   
+        end if
+
+        varian=0.637    ! Characteristic variance    
+        qext(1)=3.04    ! reference extinction at 0.67 um for ref dust
+        qext(2)=3.04    ! reference extinction at 0.67 um for ref dust
+
+c       Intermediate calcul for computing geometric mean radius r0
+c       as a function of mass and number mixing ratio Q and N
+c       (r0 = (r3n_q * Q/ N)
+        r3n_q = exp(-4.5*varian**2)*(3./4.)/(pi*rho_dust)
+
+c       Intermediate calcul for computing effective radius reff
+c       from geometric mean radius r0
+c       (reff = ref_r0 * r0)
+        ref_r0 = exp(2.5*varian**2)
+        
+c       lifted dust :
+c       '''''''''''
+        reff_lift = 3.e-6      !  Effective radius of lifted dust (m)
+        alpha_devil(1)=9.e-9   !  dust devil lift mass coeff
+        alpha_lift(1)=3.0e-15  !  Lifted mass coeff
+
+        r0_lift = reff_lift/ref_r0
+        alpha_devil(2)= r3n_q * alpha_devil(1)/r0_lift**3
+        alpha_lift(2)= r3n_q * alpha_lift(1)/r0_lift**3
+
+c       Not used:
+        radius(1) = 0.
+	radius(2) = 0.
+
+      else
+
+       if (dustbin.gt.1) then
+        print*,'ATTENTION:',
+     $   ' properties of dust need input in initracer !!!'
+	stop
+
+       else if (dustbin.eq.1) then
+
+c       This will be used for 1 dust particle size:
+c       ------------------------------------------
+cc        radius(1)=3.e-6
+cc        Qext(1)=3.04
+cc        alpha_lift(1)=0.0e-6
+cc        alpha_devil(1)=7.65e-9
+        radius(1)=1.e-6
+        Qext(1)=3.04        
+        alpha_lift(1)=1.
+        alpha_devil(1)=0.0e-9        
+	qextrhor(1)= (3./4.)*Qext(1) / (rho_dust*radius(1))
+
+       endif
+      end if    ! (doubleq)
+
+c     Initialization for photochemistry:
+c     ---------------------------------
+      if (photochem) then
+        do iq=nqchem_min,nqmx
+	 radius(iq)=0.
+         Qext(iq)=0.
+         alpha_lift(iq) =0.
+         alpha_devil(iq)=0.
+	 qextrhor(iq)= 0.
+        enddo
+      endif
+
+c     Initialization for water vapor
+c     ------------------------------
+      if(water) then
+         radius(nqmx)=0.
+         Qext(nqmx)=0.
+         alpha_lift(nqmx) =0.
+         alpha_devil(nqmx)=0.
+	 qextrhor(nqmx)= 0.
+
+c       "Dryness coefficient" controlling the evaporation and
+c        sublimation from the ground water ice (close to 1)
+c        HERE, the goal is to correct for the fact
+c        that the simulated permanent water ice polar caps
+c        is larger than the actual cap and the atmospheric
+c        opacity not always realistic.
+
+         do ig=1,ngridmx
+           if (ngridmx.ne.1) watercaptag(ig)=.false.
+           dryness(ig) = 1.
+           if (activice) pclc(ig)=1.
+         enddo
+
+         IF (caps) THEN
+c Perennial H20 north cap defined by watercaptag=true (allows surface to be
+c hollowed by sublimation in vdifc).
+c Cloud area fraction (pclc) is defined here.
+         do ig=1,ngridmx
+           if (lati(ig)*180./pi.gt.84) then
+             if (ngridmx.ne.1) watercaptag(ig)=.true.
+             dryness(ig) = 1.
+             if (activice)then
+               pclc(ig)=1.
+               print*,'Cloud area ratio : ',pclc(ig),' at lat '
+     $        ,lati(ig)*180./pi
+             endif
+c Use the following cap definition for high spatial resolution (latitudinal bin <= 5 deg)
+c	      if (lati(ig)*180./pi.lt.85.and.long(ig).ge.0) then
+c	        if (ngridmx.ne.1) watercaptag(ig)=.true.
+c	        pclc(ig)=.3
+c               dryness(ig) = 1.
+c               print*,'Cloud area ratio : ',pclc(ig),' at lat '
+c	      endif
+c             if (lati(ig)*180./pi.ge.85) then
+c               if (ngridmx.ne.1) watercaptag(ig)=.true.
+c               dryness(ig) = 1.
+c	        pclc(ig)=.3
+c               print*,'Cloud area ratio : ',pclc(ig),' at lat '
+c	      endif
+           endif  ! (lati>80 deg)
+         end do ! (ngridmx)
+        ENDIF ! (caps)
+
+         if(iceparty.and.nqmx.ge.2) then
+           radius(nqmx-1)=3.e-6
+           Qext(nqmx-1)=0.
+           alpha_lift(nqmx-1) =0.
+           alpha_devil(nqmx-1)=0.
+           if (activice) then
+             radius(nqmx-1)=rcrystal
+             Qext(nqmx-1)=qrefice
+           endif
+           qextrhor(nqmx-1)= (3./4.)*Qext(nqmx-1) 
+     $       / (rho_ice*radius(nqmx-1))
+         elseif(iceparty.and.nqmx.lt.2) then
+            write(*,*) 'nqmx is too low : nqmx=', nqmx
+            write(*,*) 'water= ',water,' iceparty= ',iceparty
+         endif
+
+      end if  ! (water)
+
+c     Output for records:
+c     ~~~~~~~~~~~~~~~~~~
+      write(*,*)
+      Write(*,*) '******** initracer : dust transport parameters :'
+      write(*,*) 'alpha_lift = ', alpha_lift
+      write(*,*) 'alpha_devil = ', alpha_devil
+      write(*,*) 'radius  = ', radius
+      if(doubleq) then
+        write(*,*) 'reff_lift (um) =  ', reff_lift
+        write(*,*) 'size distribution variance  = ', varian
+        write(*,*) 'r3n_q , ref_r0 : ', r3n_q , ref_r0
+      end if
+      write(*,*) 'Qext  = ', qext 
+      write(*,*)
+
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/ismax.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/ismax.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/ismax.F	(revision 2744)
@@ -0,0 +1,20 @@
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+      ix=ix+incx
+      if(sx(ix).gt.sxmax) then
+      sxmax=sx(ix)
+      ismax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/ismin.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/ismin.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/ismin.F	(revision 2744)
@@ -0,0 +1,20 @@
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+      ix=ix+incx
+      if(sx(ix).lt.sxmin) then
+        sxmin=sx(ix)
+        ismin=i+1
+      endif
+      ENDDO
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwb.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwb.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwb.F	(revision 2744)
@@ -0,0 +1,140 @@
+      subroutine lwb (kdlon,kflev,tlev,tlay,dt0
+     .               ,bsurf,btop,blay,blev,dblay,dbsublay)
+ 
+c----------------------------------------------------------------------
+c     LWB  computes the planck function and gradient
+c          from a polynomial development of planck function
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon            ! part of ngrid
+      integer kflev            ! part of nalyer
+
+      real dt0 (ndlo2)                 ! surface temperature discontinuity
+      real tlay (ndlo2,kflev)          ! layer temperature
+      real tlev (ndlo2,kflev+1)        ! level temperature
+
+c                                                            outputs:
+c                                                            --------
+      real bsurf (ndlo2,nir)        ! surface spectral planck function
+      real btop (ndlo2,nir)         ! top spectral planck function
+      real blev (ndlo2,nir,kflev+1) ! level   spectral planck function
+      real blay (ndlo2,nir,kflev)   ! layer   spectral planck function
+      real dblay (ndlo2,nir,kflev)  ! layer gradient spectral planck function
+      real dbsublay (ndlo2,nir,2*kflev)  ! layer gradient spectral planck
+                                         ! function in sub layers
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer jk, jl, jnu, jk1, jk2
+
+      real ztlay (ndlon)
+      real ztlev (ndlon)
+
+c----------------------------------------------------------------------
+      do jnu=1,nir
+c----------------------------------------------------------------------
+c         1.1   levels and layers from surface to nlaylte
+c               ---------------------------------------
+
+      do jk = 1 , nlaylte
+        do jl = 1 , kdlon
+
+c                                                  level planck function 
+c                                                  ---------------------
+      ztlev(jl)=(tlev(jl,jk)-tstand)/tstand    ! tstand = 200k
+
+      blev(jl,jnu,jk)   = xp(1,jnu)
+     .                    +ztlev(jl)*(xp(2,jnu) 
+     .                    +ztlev(jl)*(xp(3,jnu) 
+     .                    +ztlev(jl)*(xp(4,jnu) 
+     .                    +ztlev(jl)*(xp(5,jnu)
+     .                    +ztlev(jl)*(xp(6,jnu)    )))))
+
+c                                                  layer planck function 
+c                                                  ---------------------
+      ztlay(jl)=(tlay(jl,jk)-tstand)/tstand
+
+      blay(jl,jnu,jk) = xp(1,jnu)
+     .                  +ztlay(jl)*(xp(2,jnu)
+     .                  +ztlay(jl)*(xp(3,jnu)
+     .                  +ztlay(jl)*(xp(4,jnu)
+     .                  +ztlay(jl)*(xp(5,jnu)
+     .                  +ztlay(jl)*(xp(6,jnu)    )))))
+
+c                                               planck function gradient
+c                                               ------------------------
+      dblay(jl,jnu,jk) = xp(2,jnu)
+     .                   +ztlay(jl)*(2*xp(3,jnu)
+     .                   +ztlay(jl)*(3*xp(4,jnu)
+     .                   +ztlay(jl)*(4*xp(5,jnu)
+     .                   +ztlay(jl)*(5*xp(6,jnu)  ))))
+      dblay(jl,jnu,jk) = dblay(jl,jnu,jk)/tstand
+
+        enddo
+      enddo
+     
+c----------------------------------------------------------------------
+c         1.2   top of the atmosphere and surface
+c               --------------------------------
+
+      do jl = 1 , kdlon
+c                                                  top of the atmosphere
+c                                                  ---------------------
+      ztlev(jl) = (tlev(jl,nlaylte+1)-tstand)/tstand
+
+      blev(jl,jnu,nlaylte+1) = xp(1,jnu)
+     .                       +ztlev(jl)*(xp(2,jnu)
+     .                       +ztlev(jl)*(xp(3,jnu)
+     .                       +ztlev(jl)*(xp(4,jnu)
+     .                       +ztlev(jl)*(xp(5,jnu)
+     .                       +ztlev(jl)*(xp(6,jnu)    )))))
+      btop(jl,jnu) = blev(jl,jnu,nlaylte+1)
+
+c                                                                surface
+c                                                                -------
+      ztlay(jl) = (tlev(jl,1)+dt0(jl)-tstand)/tstand
+
+      bsurf(jl,jnu) = xp(1,jnu)
+     .               +ztlay(jl)*(xp(2,jnu)
+     .               +ztlay(jl)*(xp(3,jnu)
+     .               +ztlay(jl)*(xp(4,jnu)
+     .               +ztlay(jl)*(xp(5,jnu)
+     .               +ztlay(jl)*(xp(6,jnu)     )))))
+
+      enddo
+
+c----------------------------------------------------------------------
+c         1.3   Gradients in sub-layers
+c               -----------------------
+
+      do jk=1,nlaylte
+        jk2 = 2 * jk
+        jk1 = jk2 - 1 
+          do jl=1,kdlon
+            dbsublay(jl,jnu,jk1)=blay(jl,jnu,jk)-blev(jl,jnu,jk)
+            dbsublay(jl,jnu,jk2)=blev(jl,jnu,jk+1)-blay(jl,jnu,jk)
+          enddo
+      enddo
+
+c----------------------------------------------------------------------
+      enddo           ! (do jnu=1,nir)
+c----------------------------------------------------------------------
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwdiff.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwdiff.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwdiff.F	(revision 2744)
@@ -0,0 +1,219 @@
+      subroutine lwdiff (kdlon,kflev
+     .         ,pbsur,pbtop,pdbsl
+     .         ,tautotal,omegtotal,gtotal
+     .         ,pemis,pfluc)
+
+      IMPLICIT NONE
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+C-----------------------------------------------------------------------
+C
+c  ABSORPTION ET DIFUSION HORS DE LA BANDE A 15 MICRONS :
+c! 1) Dans la bande a 15 micron (CO2), les poussieres 
+c! n'interviennent que comme un milieu gris non diffusif avec 
+c!                      Q=Qext*(1-Omega)
+c! cette bande est decoupee en deux sous bandes (indices 1 et 2)
+c! pour lesquelles les parametres optiques des poussieres sont
+c! identiques
+c! 2)  le reste est decoupe en "nir-2" bandes : une bande qui recouvre toutes
+c! les longueurs d'onde inferieures a celles de la bande a 15 microns
+c! (indice 3) et nir-3 bandes pour les grandes longueurs d'onde
+c! (indices 4...nir) sur chacune de ces  bandes, les poussieres
+c! sont supposees diffusantes grises.
+c!
+C
+C-----------------------------------------------------------------------
+C
+C
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      integer kdlon,kflev
+      REAL PBSUR(NDLO2,nir), PBTOP(NDLO2,nir)
+     S  ,  PDBSL(NDLO2,nir,KFLEV*2), PEMIS(NDLO2)
+
+      real PFLUC(NDLO2,2,KFLEV+1)
+      real tautotal(ndlon,nflev,nir)
+      real omegtotal(ndlon,nflev,nir), gtotal(ndlon,nflev,nir)
+
+C
+C
+C-------------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+C
+C
+      integer jl, jk, ndd, indd, iir, j1
+      integer  j2, j2dd2, j2dd1,j2bot,j2top, j2dd
+      REAL ZADJD(NDLON,NFLEV+1), ZADJU(NDLON,NFLEV+1)
+     S  ,  ZDBDT(NDLON,nir,NFLEV)
+     S  ,  ZDISD(NDLON,NFLEV+1), ZDISU(NDLON,NFLEV+1)
+     S  ,  ZFD(NDLON), ZFDN(NDLON,NFLEV+1), ZFU(NDLON)
+     S  ,  ZFUP(NDLON,NFLEV+1),ZGLAYD(NDLON),ZGLAYU(NDLON)
+     S  ,  ZOMEGADD(NDLON,NFLEV*2),ZGDD(NDLON,NFLEV*2)
+     S  ,  ZTAUDD(NDLON,NFLEV*2)
+     S  ,  ZBHDD(NDLON,NFLEV*2+1),ZBSDD(NDLON)
+     S  ,  ZZBHDD(NDLON,NFLEV*2+1),ZZBSDD(NDLON)
+     S  ,  ZFAHDD(NDLON,NFLEV*2+1),ZFDHDD(NDLON,NFLEV*2+1)
+     S  ,  ZZFAHDD(NDLON,NFLEV*2+1),ZZFDHDD(NDLON,NFLEV*2+1)
+C
+C-----------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+ 100  CONTINUE
+C
+C*         1.1     INITIALIZE LAYER CONTRIBUTIONS
+C                  ------------------------------
+C
+ 110  CONTINUE
+C
+
+      do jl = 1 , kdlon
+        do jk = 1 , nlaylte
+          PFLUC(jl,1,jk) = 0.
+          PFLUC(jl,2,jk) = 0.
+        enddo
+      enddo
+
+      DO 112 JK = 1 , nlaylte+1
+        DO 111 JL = 1 , KDLON
+          ZADJD(JL,JK) = 0.
+          ZADJU(JL,JK) = 0.
+          ZDISD(JL,JK) = 0.
+          ZDISU(JL,JK) = 0.
+ 111    CONTINUE
+ 112  CONTINUE
+C
+C
+C     ------------------------------------------------------------------
+C
+C*         2.      VERTICAL INTEGRATION
+C                  --------------------
+C
+C     ------------------------------------------------------------------
+C
+C
+C  ==================================================================
+C*         2.0     contribution des bandes "hors co2"
+C  ==================================================================
+C
+ 200  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         2.0.1   preparation des Planck a chaque hauteur
+C                  ----------------------------------
+C
+c!
+c! le nombre de couche pour la diffusion sera le nombre de layer * 2
+c! soit NDD=nlaylte*2, donc la taille du vecteur des Planck sera
+c! nlaylte*2 + 1. la taille des vecteurs omega / g / tau sera
+c! par contre nlaylte*2 (voir dans FLUSV.F).
+c!
+      NDD=nlaylte*2
+      DO indd=1,ndd+1
+                                            do jl=1,kdlon
+         ZFAHDD(jl,indd)=0.
+         ZFDHDD(jl,indd)=0.
+         ZBHDD(jl,indd)=0.
+                                            enddo
+      ENDDO
+                                            do jl=1,kdlon
+      ZBSDD(jl)=0.
+                                            enddo
+c!
+c! boucle sur les  bandes hors CO2
+c!
+      DO 10001 iir=3,nir
+c!
+                                            do jl=1,kdlon
+        ZZBHDD(JL,1)=PBTOP(JL,iir)/pi
+                                            enddo
+        DO J1=2,NDD+1
+                                            do jl=1,kdlon
+           ZZBHDD(JL,J1)=
+     &     ZZBHDD(JL,J1-1)-PDBSL(JL,iir,NDD-J1+2)/pi
+                                            enddo
+        ENDDO
+                                            do jl=1,kdlon
+        ZZBSDD(JL)=PBSUR(JL,iir)/pi
+                                            enddo
+
+C
+C     ------------------------------------------------------------------
+C
+C*         2.0.2   preparation des coefficients de diffusion
+C                  -----------------------------------------
+C
+c! les omega, g, tau ... boucle de bas en haut
+        DO J2=1,nlaylte-1
+          J2DD2=(nlaylte-J2+1)*2
+          J2DD1=J2DD2-1
+          J2BOT=3*J2-2
+          J2TOP=3*J2+1
+          do jl=1,kdlon
+            ZTAUDD(JL,J2DD1)=tautotal(jl,J2,iir)*0.5
+            ZTAUDD(JL,J2DD2)=ZTAUDD(JL,J2DD1)
+            ZOMEGADD(JL,J2DD1)=omegtotal(jl,J2,iir)
+            ZOMEGADD(JL,J2DD2)=omegtotal(jl,J2,iir)
+            ZGDD(JL,J2DD1)=gtotal(jl,J2,iir)
+            ZGDD(JL,J2DD2)=gtotal(jl,J2,iir)
+          enddo
+        ENDDO
+        J2=nlaylte
+        J2DD2=2
+        J2DD1=1
+        J2BOT=3*J2-2
+                                            do jl=1,kdlon
+        ZTAUDD(JL,J2DD1)= tautotal(jl,J2,iir)*0.5
+        ZTAUDD(JL,J2DD2)= tautotal(jl,J2,iir)*0.5
+        ZOMEGADD(JL,J2DD1)= omegtotal(jl,J2,iir)
+        ZOMEGADD(JL,J2DD2)= omegtotal(jl,J2,iir)
+        ZGDD(JL,J2DD1)= gtotal(jl,J2,iir)
+        ZGDD(JL,J2DD2)= gtotal(jl,J2,iir)
+                                            enddo
+C
+C     ------------------------------------------------------------------
+C
+C*         2.0.3   calcul de la diffusion
+C                  ----------------------
+C
+
+c-----------------------------------------------------------------------
+        CALL flusv(KDLON,0
+     &  ,NDD,ZOMEGADD,ZGDD,ZTAUDD,PEMIS
+     &  ,ZZBHDD,ZZBSDD
+     &  ,ZZFAHDD,ZZFDHDD)
+c!
+c!  Cumul des flux sur le spectre hors bande du CO2
+c!
+        DO indd=1,ndd+1
+           do jl=1,kdlon
+             ZFAHDD(jl,indd)=ZFAHDD(jl,indd)+ZZFAHDD(jl,indd)
+             ZFDHDD(jl,indd)=ZFDHDD(jl,indd)+ZZFDHDD(jl,indd)
+           enddo
+        ENDDO
+10001 CONTINUE
+
+      DO J2=1,nlaylte+1
+        J2DD=(nlaylte-J2+1)*2+1
+        do jl=1,kdlon
+          PFLUC(JL,1,J2)=PFLUC(JL,1,J2)+ZFAHDD(JL,J2DD)
+          PFLUC(JL,2,J2)=PFLUC(JL,2,J2)-ZFDHDD(JL,J2DD)
+        enddo
+      ENDDO
+
+
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwflux.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwflux.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwflux.F	(revision 2744)
@@ -0,0 +1,514 @@
+       subroutine lwflux (ig0,kdlon,kflev,dp
+     .                   ,bsurf,btop,blev,blay,dbsublay
+     .                   ,tlay, tlev, dt0      ! pour sortie dans g2d uniquement
+     .                   ,emis
+     .                   , tautotal,omegtotal,gtotal
+     .                   ,coolrate,fluxground,fluxtop
+     .                   ,netrad)
+
+c----------------------------------------------------------------------
+c     LWFLUX     computes the fluxes
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comg1d.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0                   ! 
+      integer kdlon                 ! part of ngrid
+      integer kflev                 ! part of nlayer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+
+      real bsurf (ndlo2,nir)             ! surface spectral planck function
+      real blev (ndlo2,nir,kflev+1)      ! level   spectral planck function
+      real blay (ndlo2,nir,kflev)        ! layer   spectral planck function
+      real btop (ndlo2,nir)              ! top spectral planck function
+      real dbsublay (ndlo2,nir,2*kflev)  ! layer gradient spectral planck
+                                         ! function in sub layers
+
+      real dt0 (ndlo2)                 ! surface temperature discontinuity
+      real tlay (ndlo2,kflev)          ! layer temperature
+      real tlev (ndlo2,kflev+1)        ! level temperature
+
+      real emis (ndlo2)                  ! surface emissivity
+
+      real tautotal(ndlo2,kflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlo2,kflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlo2,kflev,nir)    ! /   NAERKIND aerosols prop.)
+
+
+c                                                            outputs:
+c                                                            --------
+      real coolrate(ndlo2,kflev)    ! radiative cooling rate (K/s) 
+      real netrad (ndlo2,kflev)     ! radiative budget (W/m2) 
+      real fluxground(ndlo2)        ! downward flux on the ground
+                                    ! for surface radiative budget
+      real fluxtop(ndlo2)           ! upward flux on the top of atm ("OLR")
+
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,j,i,ig1d,ig,l,ndim
+      parameter(ndim = ndlon*(nuco2+1)*(nflev+2)*(nflev+2))
+      real  ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2)
+
+      real dpsgcp (0:nflev+1,0:nflev+1)    !  dp/(g.cp)
+      real temp (0:nflev+1,0:nflev+1)       
+
+      real fluxdiff(ndlon,2,nflev+1)  ! diffusion flux: upward(1) downward(2) 
+
+      real*4 reel4
+
+c     To compute IR flux in the atmosphere  (For diagnostic only !!)
+      logical computeflux
+      real coefd(ngridmx,nuco2,nflev+1,nflev+1) 
+      real coefu(ngridmx,nuco2,0:nflev,nflev+1)
+      real flw_up(ngridmx,nflev+1), flw_dn(ngridmx,nflev+1) ! fluxes (W/m2)
+
+
+      call zerophys(ndim, ksidb)
+
+c----------------------------------------------------------------------
+c         1.1   exchanges (layer i <--> all layers up to i) 
+c               -------------------------------------------
+
+      do i = 1,nlaylte
+        do j = i+1,nlaylte
+          do ja = 1,nuco2
+            do jl = 1,kdlon
+
+      ksidb(jl,ja,i,j) = xi(ig0+jl,ja,i,j) 
+     .                 * (blay(jl,ja,j)-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,j,i) = -ksidb(jl,ja,i,j)
+      
+            enddo
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   exchanges (ground <--> all layers) 
+c               ----------------------------------
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,i,0) = xi(ig0+jl,ja,0,i) 
+     .                 * (bsurf(jl,ja)-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,0,i) = -ksidb(jl,ja,i,0)
+
+          enddo
+        enddo
+      enddo
+
+c--------------------------------------------------------
+c  Here we add the neighbour contribution 
+c           for exchanges between ground and first layer
+c--------------------------------------------------------
+
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0) 
+     .                 - xi_ground(ig0+jl,ja) 
+     .                 * (blev(jl,ja,1)-blay(jl,ja,1))
+
+cc                                                       ksidb reciprocity
+cc                                                       -----------------
+      ksidb(jl,ja,0,1) = - ksidb(jl,ja,1,0)
+
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         1.3   exchanges (layer i <--> space) 
+c               ------------------------------
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,i,nlaylte+1) = xi(ig0+jl,ja,i,nlaylte+1) 
+     .                       * (-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,nlaylte+1,i) = - ksidb(jl,ja,i,nlaylte+1)
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.4   exchanges (ground <--> space) 
+c               -----------------------------
+
+      do ja = 1,nuco2
+        do jl = 1,kdlon
+
+      ksidb(jl,ja,0,nlaylte+1) = xi(ig0+jl,ja,0,nlaylte+1) 
+     .                       * (-bsurf(jl,ja))
+
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,nlaylte+1,0) = - ksidb(jl,ja,0,nlaylte+1)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.0   sum of band 1 and 2 of co2 contribution 
+c               ---------------------------------------
+
+      do i = 0,nlaylte+1
+        do j = 0,nlaylte+1
+          do jl = 1,kdlon
+
+            ksidb(jl,3,i,j)= ksidb(jl,1,i,j) + ksidb(jl,2,i,j)
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         3.0   Diffusion
+c               ---------
+
+      i = nlaylte+1
+      do jl = 1,kdlon
+        fluxdiff(jl,1,i)   = 0.
+        fluxdiff(jl,2,i)   = 0.
+      enddo
+
+      call lwdiff (kdlon,kflev
+     .         ,bsurf,btop,dbsublay
+     .         ,tautotal,omegtotal,gtotal
+     .         ,emis,fluxdiff)
+
+c----------------------------------------------------------------------
+c         4.0   Radiative Budget for each layer i
+c               ---------------------------------
+
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+            netrad(jl,i) = 0.
+        enddo
+      enddo
+
+      do i = 1,nlaylte
+        do j = 0,nlaylte+1
+          do jl = 1,kdlon
+
+            netrad(jl,i) = netrad(jl,i) + ksidb(jl,3,i,j)
+
+          enddo
+        enddo
+      enddo
+c                                                 diffusion contribution
+c                                                 ----------------------
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+
+          netrad(jl,i) = netrad(jl,i) 
+     .                 - fluxdiff(jl,1,i+1) - fluxdiff(jl,2,i+1)   
+     .                 + fluxdiff(jl,1,i)   + fluxdiff(jl,2,i)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         4.0   cooling rate for each layer i
+c               -----------------------------
+
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+
+          coolrate(jl,i) = gcp * netrad(jl,i) / dp(jl,i)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         5.0   downward flux (all layers --> ground): "fluxground" 
+c               ---------------------------------------------------
+
+      do jl = 1,kdlon
+          fluxground(jl) = 0.
+      enddo
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      fluxground(jl) = fluxground(jl)
+     .               + xi(ig0+jl,ja,0,i) * (blay(jl,ja,i))
+
+          enddo
+        enddo
+      enddo
+   
+      do jl = 1,kdlon
+        fluxground(jl) = fluxground(jl) - fluxdiff(jl,2,1)  
+      enddo
+
+c----------------------------------------------------------------------
+c         6.0   outgoing flux (all layers --> space): "fluxtop" 
+c               ---------------------------------------------------
+
+      do jl = 1,kdlon
+          fluxtop(jl) = 0.
+      enddo
+
+      do i = 0,nlaylte
+        do jl = 1,kdlon
+           fluxtop(jl) = fluxtop(jl)- ksidb(jl,3,i,nlaylte+1)
+        enddo
+      enddo
+   
+      do jl = 1,kdlon
+        fluxtop(jl) = fluxtop(jl) + fluxdiff(jl,1,nlaylte+1)  
+      enddo
+
+c----------------------------------------------------------------------
+c         6.5 ONLY FOR DIAGNOSTIC : Compute IR flux in the atmosphere 
+c             -------------------
+c     The broadband fluxes (W.m-2) at every level  from surface level (l=1) 
+c     up the top of the  upper layer (here: l=nlaylte+1) are:
+c     upward : flw_up(ig,l)   ;   downward : flw_dn(ig,j) 
+c
+      computeflux = .false.
+
+      IF (computeflux) THEN  ! not used by the GCM only for diagnostic !
+c      upward flux 
+c      ~~~~~~~~~~~
+       do i = 0,nlaylte
+        do j = 1,nlaylte+1
+         do ja = 1,nuco2
+          do jl = 1,kdlon
+            coefu(jl,ja,i,j) =0.
+            do l=j,nlaylte+1 
+              coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
+            end do
+
+          enddo
+         enddo
+        enddo
+       enddo
+       do j = 1,nlaylte+1
+        do jl = 1,kdlon
+           flw_up(jl,j) = 0.
+           do ja = 1,nuco2
+             flw_up(jl,j)=flw_up(jl,j)+bsurf(jl,ja)*coefu(jl,ja,0,j)
+             do i=1,j-1
+              flw_up(jl,j)=flw_up(jl,j)+blay(jl,ja,i)*coefu(jl,ja,i,j) 
+             end do 
+           end do
+           flw_up(jl,j)=flw_up(jl,j) + fluxdiff(jl,1,j)
+        end do
+       end do
+
+c      downward flux
+c      ~~~~~~~~~~~~~
+       do i = 1,nlaylte+1
+        do j = 1,nlaylte+1
+         do ja = 1,nuco2
+          do jl = 1,kdlon
+            coefd(jl,ja,i,j) =0.
+            do l=0,j-1
+              coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
+            end do
+          enddo
+         enddo
+        enddo
+       enddo
+       do j = 1,nlaylte+1
+        do jl = 1,kdlon
+           flw_dn(jl,j) = 0.
+           do ja = 1,nuco2
+             do i=j,nlaylte
+              flw_dn(jl,j)=flw_dn(jl,j)+blay(jl,ja,i)*coefd(jl,ja,i,j) 
+             end do 
+           end do
+           flw_dn(jl,j)=flw_dn(jl,j) - fluxdiff(jl,2,j)
+        end do
+       end do
+      END IF
+
+c----------------------------------------------------------------------
+c         7.0   outputs Grads 2D
+c               ----------------
+
+c ig1d: point de la grille physique ou on veut faire la sortie
+c ig0+1:  point du decoupage de la grille physique
+c ig:   point pour les variables decoupees
+
+c#ifdef undim
+      if (callg2d) then
+
+      ig1d = ngridmx/2 + 1
+c     ig1d = ngridmx
+
+      if ((ig0+1).LE.ig1d .and. ig1d.LE.(ig0+kdlon)
+     .    .OR.  ngridmx.EQ.1   ) then
+
+          ig = ig1d-ig0
+        print*, 'Sortie g2d: ig1d, ig, ig0', ig1d, ig, ig0
+
+c--------------------------------------------
+c   Ouverture de g2d.dat
+c--------------------------------------------
+      if (g2d_premier) then
+        open (47,file='g2d.dat'
+clmd     &       ,form='unformatted',access='direct',recl=4)
+     &        ,form='unformatted',access='direct',recl=1
+     &        ,status='unknown')
+        g2d_irec=0
+        g2d_appel=0
+        g2d_premier=.false.
+      endif
+        g2d_appel = g2d_appel+1
+
+c--------------------------------------------
+c   Sortie g2d des xi proches + distants 
+c--------------------------------------------
+cl                               if (nflev .NE. 500) then
+      do ja = 1,nuco2
+        do j = 0,nlaylte+1
+          do i = 0,nlaylte+1
+            g2d_irec=g2d_irec+1
+            reel4 = xi(ig1d,ja,i,j)
+            write(47,rec=g2d_irec) reel4
+          enddo
+        enddo
+      enddo
+cl                               endif
+
+c------------------------------------------------------
+c   Writeg2d des ksidb 
+c------------------------------------------------------
+      do ja = 1,nuco2
+c       ja=1
+        do j = 0,nlaylte+1
+          do i = 0,nlaylte+1
+            g2d_irec=g2d_irec+1
+            reel4 = ksidb(ig,ja,i,j)
+            write(47,rec=g2d_irec) reel4
+          enddo
+        enddo
+      enddo
+
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = ksidb(ig,3,i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+c------------------------------------------------------
+c  Writeg2d dpsgcp
+c------------------------------------------------------
+
+        do j = 1 , nlaylte
+          do i = 0 , nlaylte+1
+            dpsgcp(i,j) = dp(ig,j) / gcp
+          enddo
+        enddo
+
+        do i = 0 , nlaylte+1
+c         dpsgcp(i,0) = 0.0002  ! (rapport ~ entre 1000 et 10000 pour le sol)
+          dpsgcp(i,0) = 1.      ! (pour regler l'echelle des sorties)
+          dpsgcp(i,nlaylte+1) = 0.
+        enddo
+
+c     print*
+c     print*,'gcp: ',gcp
+c     print*
+c       do i = 0 , nlaylte+1
+c     print*,i,'dp: ',dp(ig,i)
+c       enddo
+c     print*
+c       do i = 0 , nlaylte+1
+c     print*,i,'dpsgcp: ',dpsgcp(i,1)
+c       enddo
+  
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = dpsgcp(i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+c------------------------------------------------------
+c  Writeg2d temperature
+c------------------------------------------------------
+
+        do j = 1 , nlaylte
+          do i = 0 , nlaylte+1
+            temp(i,j) = tlay(ig,j)
+          enddo
+        enddo
+
+        do i = 0 , nlaylte+1
+          temp(i,0) = tlev(ig,1)+dt0(ig)     ! temperature surface
+          temp(i,nlaylte+1) = 0.               ! temperature espace  (=0)
+        enddo
+
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = temp(i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+        write(76,*) 'ig1d, ig, ig0', ig1d, ig, ig0
+        write(76,*) 'nlaylte', nlaylte
+        write(76,*) 'nflev', nflev
+        write(76,*) 'kdlon', kdlon
+        write(76,*) 'ndlo2', ndlo2
+        write(76,*) 'ndlon', ndlon
+      do ja=1,4
+        write(76,*) 'bsurf', ja, bsurf(ig,ja)
+        write(76,*) 'btop', ja, btop(ig,ja)
+
+        do j=1,nlaylte+1
+          write(76,*) 'blev', ja, j, blev(ig,ja,j)
+        enddo
+
+        do j=1,nlaylte
+          write(76,*) 'blay', ja, j, blay(ig,ja,j)
+        enddo
+
+        do j=1,2*nlaylte
+          write(76,*) 'dbsublay', ja, j, dbsublay(ig,ja,j)
+        enddo
+      enddo
+
+      endif
+c************************************************************************
+c#endif 
+      endif  !   callg2d
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwi.F	(revision 2744)
@@ -0,0 +1,223 @@
+      subroutine lwi (ig0,kdlon,kflev
+     .                ,psi,zdblay,pdp
+     .                ,newpcolc )
+
+
+      implicit none
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "yomlw.h"
+ 
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C                             -   lwi    -    
+C
+C     PURPOSE:       Shema semi - implicite 
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+
+c************************************************************************
+c
+c        0.    Declarations
+c              ------------
+c
+c-------------------------------------------------------------------------
+c        0.1   Arguments
+c              ---------
+c
+ 
+      integer ig0, kdlon,kflev
+
+      real    psi(ndlo2,kflev)
+     .     ,  zdblay(ndlo2,nir,kflev)
+     .     ,  pdp(ndlo2,kflev)
+
+
+      real    newpcolc(ndlo2,kflev)
+
+c-------------------------------------------------------------------------
+c        0.2   local arrays
+c              ------------
+c
+      real    di(ndlon,nflev) 
+     .      , hi(ndlon,nflev) 
+     .      , bi(ndlon,nflev) 
+
+      real    ci(ndlon,nflev) 
+     .      , ai(ndlon,nflev) 
+      real    deltat
+
+      real   semit, denom
+
+      integer i, jl
+
+c************************************************************************
+c
+c        1.    Initialisations
+c              ---------------
+c
+c-----------------------------------------------------------------------
+ 
+        deltat = dtphys * iradia
+c       print*,'SEMI = ',semi, '(expl:0  semi-implicite:0.5  impl:1)'
+        semit = semi * deltat
+c       semi = 0.
+
+c       print*,'dtphys,iradia,deltat,semit:',dtphys,iradia,deltat,semit
+c       print*,'g,cpp',g,cpp
+
+
+c************************************************************************
+c
+c        2.    
+c              ---------------
+c
+c-------------------------------------------------------------------------
+c        2.1   Calcul des di
+c              -------------
+c
+
+
+      do i = 1 , nlaylte-1
+        do jl = 1 , kdlon
+c     -------------------
+      di(jl,i) =  1 + semit * (g / pdp(jl,i) / cpp) * (
+     .    ( xi(ig0+jl,1,i,nlaylte+1) 
+     .    + xi(ig0+jl,1,i,i+1) 
+     .    + xi(ig0+jl,1,i,i-1) )
+     .    *    zdblay(jl,1,i) 
+     .  + ( xi(ig0+jl,2,i,nlaylte+1) 
+     .    + xi(ig0+jl,2,i,i+1) 
+     .    + xi(ig0+jl,2,i,i-1) )
+     .    *    zdblay(jl,2,i) 
+     .     )
+c     -------------------
+        enddo
+      enddo
+
+
+
+c couche nlaylte
+c ------------
+c      , on enleve i,i+1 sinon on a 2 fois le cooling2space
+
+      do jl = 1 , kdlon
+c     -------------------
+      di(jl,nlaylte) =  1 + semit * (g / pdp(jl,nlaylte) / cpp) * (
+     .    ( xi(ig0+jl,1,nlaylte,nlaylte+1) 
+     .    + xi(ig0+jl,1,nlaylte,nlaylte-1) )
+     .    *    zdblay(jl,1,nlaylte) 
+     .  + ( xi(ig0+jl,2,nlaylte,nlaylte+1) 
+     .    + xi(ig0+jl,2,nlaylte,nlaylte-1) )
+     .    *    zdblay(jl,2,nlaylte) 
+     .     )
+c     -------------------
+      enddo
+
+
+c-------------------------------------------------------------------------
+c        2.2   Calcul des hi
+c              -------------
+c
+
+      do i = 1 , nlaylte-1
+        do jl = 1 , kdlon
+c     -------------------
+      hi(jl,i) =    - semit * (g / pdp(jl,i) / cpp) *
+     .            (    xi(ig0+jl,1,i,i+1) * zdblay(jl,1,i+1)
+     .               + xi(ig0+jl,2,i,i+1) * zdblay(jl,2,i+1)   )
+c     -------------------
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.3   Calcul des bi
+c              -------------
+c
+
+
+      do i = 2 , nlaylte
+        do jl = 1 , kdlon
+c     -------------------
+      bi(jl,i) =   - semit * (g / pdp(jl,i) / cpp) * 
+     .           (     xi(ig0+jl,1,i,i-1) * zdblay(jl,1,i-1)
+     .               + xi(ig0+jl,2,i,i-1) * zdblay(jl,2,i-1)   )
+c     -------------------
+        enddo
+      enddo
+
+
+c couche 1
+c --------
+c  tant qu'on a pas un calcul propre de zdblay(0) qui tienne compte de 
+c    la discontinuite de temperature au sol , on met  b1 = 0
+
+
+      do jl = 1 , kdlon
+        bi(jl,1) = 0 
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.4   
+c              -------------
+c
+
+c couche nlaylte
+c ------------
+
+      do jl = 1 , kdlon
+c     -------------------
+      ci(jl,nlaylte) = (gcp * psi(jl,nlaylte) / pdp(jl,nlaylte))
+     .                   / di(jl,nlaylte)
+
+      ai(jl,nlaylte) = - bi(jl,nlaylte) / di(jl,nlaylte)
+c     -------------------
+      enddo
+
+
+
+      do i = nlaylte-1 , 1 , -1
+        do jl = 1 , kdlon
+c     -------------------
+      denom = di(jl,i) + hi(jl,i) * ai(jl,i+1)
+
+      ci(jl,i) = (  gcp * psi(jl,i) / pdp(jl,i)
+     .             - hi(jl,i) * ci(jl,i+1)  )  / denom
+ 
+      ai(jl,i) = -bi(jl,i) / denom
+c     -------------------
+        enddo
+      enddo
+
+
+c-------------------------------------------------------------------------
+c        2.5   
+c              -------------
+c
+
+c couche 1
+c -------
+      do jl = 1 , kdlon
+        newpcolc(jl,1) = ci(jl,1)
+      enddo
+
+
+      do i = 2 , nlaylte
+        do jl = 1 , kdlon
+           newpcolc(jl,i) = ci(jl,i) + ai(jl,i) * newpcolc(jl,i-1)
+        enddo
+      enddo
+
+
+
+c-------------------------------------------------------------------------
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwmain.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwmain.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwmain.F	(revision 2744)
@@ -0,0 +1,200 @@
+       subroutine lwmain (ig0,icount,kdlon,kflev
+     .                   ,dp,dt0,emis
+     .                   ,plev,tlev,tlay,aerosol,coolrate
+     .                   ,fluxground,fluxtop
+     .                   ,netrad)
+
+c----------------------------------------------------------------------
+c     LWMAIN     organizes the LTE longwave calculations
+c     for layer 1 to layer "nlaylte" (stored in  "yomlw.h")
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comg1d.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer icount
+      integer kdlon            ! part of ngrid
+      integer kflev            ! part of nlayer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+      real dt0 (ndlo2)              ! surface temperature discontinuity (K)
+      real emis (ndlo2)             ! surface emissivity
+      real plev (ndlo2,kflev+1)     ! level pressure (Pa)
+      real tlev (ndlo2,kflev+1)     ! level temperature (K)
+      real tlay (ndlo2,kflev)       ! layer temperature (K)
+      real aerosol(ndlo2,kflev,naerkind)      !  aerosol extinction optical
+c                         depth at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+
+
+c                                                            outputs:
+c                                                            --------
+      real coolrate(ndlo2,kflev)      ! cooling rate (K/s)
+      real fluxground(ndlo2)          ! downward ground flux (W/m2)
+      real fluxtop(ndlo2)             ! outgoing upward flux (W/m2) ("OLR")
+      real netrad (ndlo2,kflev)       ! radiative budget (W/m2) 
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      real aer_t (ndlon,nuco2,nflev+1)  ! transmission (aer)
+      real co2_u (ndlon,nuco2,nflev+1)  ! absorber amounts (co2)
+      real co2_up (ndlon,nuco2,nflev+1) ! idem scaled by the pressure (co2)
+
+      real bsurf (ndlon,nir)            ! surface spectral planck function
+      real btop (ndlon,nir)             ! top spectral planck function
+      real blev (ndlon,nir,nflev+1)     ! level   spectral planck function
+      real blay (ndlon,nir,nflev)       ! layer   spectral planck function
+      real dblay (ndlon,nir,nflev)      ! layer gradient spectral planck function
+      real dbsublay (ndlon,nir,2*nflev) ! layer gradient spectral planck function
+                                        ! in sub layers
+
+      real tautotal(ndlon,nflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlon,nflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlon,nflev,nir)    ! /   NAERKIND aerosols prop.)
+
+      real newcoolrate(ndlon,nflev) ! cooling rate (K/s) / with implicite scheme
+
+      integer jk,jkk,ja,jl
+
+      logical firstcall
+      save firstcall
+      data firstcall/.true./
+
+
+c----------------------------------------------------------------------
+c         0.3   Initialisation
+c               --------------
+
+      if (firstcall) then
+
+        firstcall = .false.
+
+        do jkk = 0 , nlaylte+1
+          do jk = 0 , nlaylte+1
+            do ja = 1 , nuco2
+              do jl = 1 , ngridmx
+                  xi (jl,ja,jk,jkk)=0.
+              enddo
+            enddo
+          enddo
+        enddo
+
+      endif
+
+c----------------------------------------------------------------------
+c         1.0   planck function
+c               ---------------
+
+      call lwb ( kdlon, kflev, tlev, tlay, dt0
+     .         , bsurf, btop, blay, blev, dblay, dbsublay)
+
+c----------------------------------------------------------------------
+c         2.0   absorber amounts
+c               ----------------
+
+      call lwu ( kdlon, kflev
+     .         , dp, plev, tlay, aerosol  
+     .         , aer_t, co2_u, co2_up
+     .         ,tautotal,omegtotal,gtotal)   
+
+c----------------------------------------------------------------------
+c         3.0   transmission functions / exchange coefficiants
+c               ----------------------------------------------
+
+c                                                                distants
+c                                                                --------
+                    if( mod(icount-1,ilwd).eq.0) then
+
+c     print*, 'CALL of DISTANTS'
+      call lwxd ( ig0, kdlon, kflev, emis
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+c                                                              neighbours
+c                                                              ----------
+                    if( mod(icount-1,ilwn).eq.0) then
+
+c     print*, 'CALL of NEIGHBOURS'
+      call lwxn ( ig0, kdlon, kflev
+     .          , dp
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+c                                                              boundaries
+c                                                              ----------
+                    if( mod(icount-1,ilwb).eq.0) then
+
+c     print*, 'CALL of BOUNDARIES'
+      call lwxb ( ig0, kdlon, kflev, emis
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+
+c----------------------------------------------------------------------
+c         4.0   cooling rate
+c               ------------
+
+      call lwflux ( ig0, kdlon, kflev, dp
+     .            , bsurf, btop, blev, blay, dbsublay
+     .            , tlay, tlev, dt0      ! pour sortie dans g2d uniquement
+     .            , emis
+     .            , tautotal,omegtotal,gtotal
+     .            , coolrate, fluxground, fluxtop
+     .            , netrad)
+
+c     do jk = 1, nlaylte
+c       print*,coolrate(1,jk)
+c     enddo
+      
+c       do jkk = 0 , nlaylte+1
+c         do jk = 0 , nlaylte+1
+c           do ja = 1 , nuco2
+c             do jl = 1 , ngridmx
+c      if (xi (jl,ja,jk,jkk) .LT. 0
+c    .       .OR. xi (jl,ja,jk,jkk) .GT. 1 ) then
+c                 print*,'xi bande',ja,jk,jkk,xi (jl,ja,jk,jkk)
+c      endif
+c             enddo
+c           enddo
+c         enddo
+c       enddo
+
+c----------------------------------------------------------------------
+c
+c          5.    shema semi-implicite  (lwi) 
+c                ---------------------------
+c
+c
+      call lwi (ig0,kdlon,kflev,netrad,dblay,dp
+     .          , newcoolrate)
+c
+c  Verif que   (X sol,space) + somme(X i,sol) = 1
+c
+      do jkk = 1 , nlaylte
+        do jl = 1 , kdlon
+c     print*,'NEW et OLD coolrate :',jkk,newcoolrate(jl,jkk) 
+c    .  ,coolrate(jl,jkk)
+      coolrate(jl,jkk) = newcoolrate(jl,jkk)
+        enddo
+      enddo
+c
+c----------------------------------------------------------------------
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwtt.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwtt.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwtt.F	(revision 2744)
@@ -0,0 +1,65 @@
+      subroutine lwtt (kdlon,u,up,nu,tr)
+
+c----------------------------------------------------------------------
+c     LWTT   computes the longwave transmission functions
+c            for all the absorbers in all spectral intervals
+c            using pade approximants and horner's algorithm
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon            ! part of ngrid
+      integer nu               ! 
+
+      real    u (ndlo2,nu)     ! absorber amounts 
+      real    up (ndlo2,nu)    ! idem scaled by the pressure
+
+c                                                            outputs:
+c                                                            --------
+      real    tr (ndlo2,nu)    ! transmission functions
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl
+
+      real xn (ndlon)
+      real xd (ndlon)
+      real ueq (ndlon)
+
+c----------------------------------------------------------------------
+c   Transmission by the CO2 15 microns band:
+c   ----------------------------------------
+
+      do  ja=1,nu
+	    do jl=1,kdlon
+c                              equivalent absorber amount (Doppler effect)
+c                             --------------------------------------------
+	      ueq(jl) = sqrt(up(jl,ja))
+     .              +cst_voigt(1,ja)*u(jl,ja)**cst_voigt(2,ja)
+
+c                                                      Horner's algorithm
+c                                                      ------------------
+            xn(jl) = ga(1,ja) + 
+     .      ueq(jl)*(ga(2,ja) + ueq(jl) * ga(3,ja) )
+            xd(jl) = gb(1,ja) + ueq(jl)*(gb(2,ja) + 
+     .      ueq(jl) * ( gb(3,ja) + ueq(jl)  ))
+            tr(jl,ja) = xn(jl) / xd(jl)
+
+	    enddo
+      enddo
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwu.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwu.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwu.F	(revision 2744)
@@ -0,0 +1,241 @@
+      subroutine lwu (kdlon,kflev
+     &                ,dp,plev,tlay,aerosol 
+     &                ,aer_t,co2_u,co2_up
+     &                ,tautotal,omegtotal,gtotal)
+
+c----------------------------------------------------------------------
+c     LWU   computes  - co2: longwave effective absorber amounts including 
+c                      pressure and temperature effects 
+c                     - aerosols: amounts for every band
+c                                transmission for bandes 1 and 2 of co2
+c----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c ATTENTION AUX UNITES:
+c le facteur 10*g fait passer des kg m-2 aux g cm-2
+c-----------------------------------------------------------------------
+c! modif diffusion
+c! on ne change rien a la bande CO2 : les quantites d'absorbant CO2
+c! sont multipliees par 1.66
+c! pview= 1/cos(teta0)=1.66
+c-----------------------------------------------------------------------
+ 
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+
+#include "fisice.h"
+#include "callkeys.h"
+
+#include "aerice.h"
+ 
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------                                    
+c                                                            inputs:
+c                                                            -------
+      integer kdlon        ! part of ngrid
+      integer kflev        ! part of nalyer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+      real plev (ndlo2,kflev+1)     ! level pressure (Pa)
+      real tlay (ndlo2,kflev)       ! layer temperature (K)
+      real aerosol (ndlo2,kflev,naerkind) ! aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+
+
+c                                                            outputs:
+c                                                            --------
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer) 
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+      real tautotal(ndlo2,kflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlo2,kflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlo2,kflev,nir)    ! /   NAERKIND aerosols properties)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer jl,jk,jkl,ja,n
+ 
+      real aer_u (ndlon,nir,nflev+1)     ! absorber amounts (aer) extinction
+      real co2c           ! co2 concentration (pa/pa)
+      real pview          ! cosecant of viewing angle
+      real pref           ! reference pressure (1013 mb = 101325 Pa)
+      real tx,tx2
+      real phi (ndlon,nuco2)
+      real psi (ndlon,nuco2)
+      real plev2 (ndlon,nflev+1)
+      real zzz
+
+      real ray,coefsize,coefsizew,coefsizeg 
+
+c************************************************************************
+c----------------------------------------------------------------------
+c         0.3  Initialisation  
+c               -------------
+
+      pview = 1.66
+      co2c = 0.95           
+      pref = 101325.
+
+      do jk=1,nlaylte+1
+        do jl=1,kdlon
+          plev2(jl,jk)=plev(jl,jk)*plev(jl,jk)
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c  Computing TOTAL single scattering parameters by adding properties of
+c  all the NAERKIND kind of aerosols in each IR band
+
+      call zerophys(ndlon*kflev*nir,tautotal)
+      call zerophys(ndlon*kflev*nir,omegtotal)
+      call zerophys(ndlon*kflev*nir,gtotal)
+
+      do n=1,naerkind
+        do ja=1,nir
+          do jk=1,nlaylte
+            do jl = 1,kdlon
+c TEST : to account for the varying sol/ir optical depth of ice with varying crystal size     
+c      : and for varying w,g with varying crystal size     
+              if (activice.and.n.eq.naerkind) then 
+        ray=min( max(rice(jl,jk)*1.e+6, 1.),10.) 
+            if (ja.eq.1.or.ja.eq.2) then 
+          coefsize=(-0.00382*ray**3.+0.0503*ray**2.+0.03531)
+     &             /QIRsQREF(ja,n)
+          coefsizew=(-0.011*ray**2.+0.1824*ray-0.1283)
+     &           /omegaIR(ja,n)
+          coefsizeg=(-0.00122*ray**3.+0.009161*ray**2.+  
+     &          0.1182*ray-0.096877)/gIR(ja,n)
+                elseif (ja.eq.3) then
+          coefsize=(-0.00324*ray**3.+0.0419*ray**2.+0.0459)
+     &             /QIRsQREF(ja,n)
+          coefsizew=(-0.01292*ray**2.+0.1963*ray-0.06566)
+     &           /omegaIR(ja,n)
+          coefsizeg=(0.00271*ray**3.-0.05959*ray**2.+
+     &          0.4411*ray-0.2724)/gIR(ja,n)
+                elseif (ja.eq.4) then
+          coefsize=(-0.0003823*ray**3.+0.0104*ray**2.+0.005966)
+     &             /QIRsQREF(ja,n)
+              coefsizew=(-0.002*ray**3.+0.02623*ray**2.-0.014465)
+     &           /omegaIR(ja,n)
+          coefsizeg=(-0.0017192*ray**3.+0.0259*ray**2.-
+     &          0.027692*ray+0.016099)/gIR(ja,n)
+            endif
+        if (coefsize.le.0.or.coefsizew.le.0.or.coefsizeg.le.0) 
+     &        stop'pb dans lwu avec prp opt glace'
+
+            tautotal(jl,jk,ja)=tautotal(jl,jk,ja) +
+     &          QIRsQREF(ja,n)*aerosol(jl,jk,n)
+     &          *coefsize
+                omegtotal(jl,jk,ja) =  omegtotal(jl,jk,ja) + 
+     &           QIRsQREF(ja,n)*aerosol(jl,jk,n)*omegaIR(ja,n)
+     &          *coefsize*coefsizew
+                gtotal(jl,jk,ja) =  gtotal(jl,jk,ja) + 
+     &           QIRsQREF(ja,n)*aerosol(jl,jk,n)*omegaIR(ja,n)*gIR(ja,n)
+     &          *coefsize*coefsizew*coefsizeg     
+              else
+              tautotal(jl,jk,ja)=tautotal(jl,jk,ja) +
+     &           QIRsQREF(ja,n)*aerosol(jl,jk,n)
+              omegtotal(jl,jk,ja) =  omegtotal(jl,jk,ja) + 
+     &           QIRsQREF(ja,n)*aerosol(jl,jk,n)*omegaIR(ja,n)
+              gtotal(jl,jk,ja) =  gtotal(jl,jk,ja) + 
+     &           QIRsQREF(ja,n)*aerosol(jl,jk,n)*omegaIR(ja,n)*gIR(ja,n)
+              endif
+            enddo
+          enddo
+        enddo
+      enddo
+      do ja=1,nir
+        do jk=1,nlaylte
+          do jl = 1,kdlon
+             gtotal(jl,jk,ja)=gtotal(jl,jk,ja)/omegtotal(jl,jk,ja)
+             omegtotal(jl,jk,ja)=omegtotal(jl,jk,ja)/tautotal(jl,jk,ja)
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.0   cumulative (aerosol) amounts (for every band)
+c               ----------------------------
+
+      jk=nlaylte+1
+      do ja=1,nir
+        do jl = 1 , kdlon
+          aer_u(jl,ja,jk)=0.
+        enddo
+      enddo
+
+      do jk=1,nlaylte
+        jkl=nlaylte+1-jk
+        do ja=1,nir
+          do jl=1,kdlon
+             aer_u(jl,ja,jkl)=aer_u(jl,ja,jkl+1)+ tautotal(jl,jkl,ja)
+          enddo
+        enddo
+      enddo                 
+
+c----------------------------------------------------------------------
+c         1.0   bands 1 and 2 of co2
+c               --------------------
+
+      jk=nlaylte+1
+      do ja=1,nuco2
+        do jl = 1 , kdlon
+          co2_u(jl,ja,jk)=0.
+          co2_up(jl,ja,jk)=0.
+          aer_t(jl,ja,jk)=1.
+        enddo
+      enddo
+
+      do jk=1,nlaylte
+                       jkl=nlaylte+1-jk
+        do ja=1,nuco2
+          do jl=1,kdlon
+
+c                 introduces temperature effects on absorber(co2) amounts
+c                 -------------------------------------------------------
+            tx = sign(min(abs(tlay(jl,jkl)-tref),70.)
+     .         ,tlay(jl,jkl)-tref)
+            tx2=tx*tx
+            phi(jl,ja)=at(1,ja)*tx+bt(1,ja)*tx2
+            psi(jl,ja)=at(2,ja)*tx+bt(2,ja)*tx2
+            phi(jl,ja)=exp(phi(jl,ja)/cst_voigt(2,ja))
+            psi(jl,ja)=exp(2.*psi(jl,ja))
+
+c                                        cumulative absorber(co2) amounts
+c                                        --------------------------------
+            co2_u(jl,ja,jkl)=co2_u(jl,ja,jkl+1)
+     .     +         pview/(10*g)*phi(jl,ja)*dp(jl,jkl)*co2c
+
+            co2_up(jl,ja,jkl)=co2_up(jl,ja,jkl+1)
+     .     +         pview/(10*g*2*pref)*psi(jl,ja)
+     .     *        (plev2(jl,jkl)-plev2(jl,jkl+1))*co2c
+
+c                                                  (aerosol) transmission
+c                                                  ----------------------
+c   on calcule directement les transmissions pour les aerosols.
+c   on multiplie le Qext  par 1-omega dans la bande du CO2.
+c   et pourquoi pas d'abord?  hourdin@lmd.ens.fr
+
+           zzz=pview*(1.-omegtotal(jl,jkl,ja))
+           aer_t(jl,ja,jkl)=exp(-zzz*aer_u(jl,ja,jkl))
+          
+          enddo
+        enddo
+      enddo                 
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwxb.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwxb.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwxb.F	(revision 2744)
@@ -0,0 +1,220 @@
+      subroutine lwxb (ig0,kdlon,kflev
+     .                ,emis
+     .                ,aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXB   computes transmission function and exchange coefficients
+c                          for boundaries 
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c 
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |***|***|***|***|***|***|***| 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |***|   |   |   |   |   | 0 |***|
+c              |---|---|---|---|---|---|---|---|
+c     ...      |***|   |   |   |   | 0 |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      4       |***|   |   |   | 0 |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      3       |***|   |   | 0 |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      2       |***|   | 0 |   |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      1       |***| 0 |   |   |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |***|***|***|***|***|***|***|  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1
+c             (ground)                    (space)
+c
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon          ! part of ngrid
+      integer kflev          ! part of nalyer
+
+      real emis (ndlo2)                  ! surface emissivity
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,ig0
+
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+c                                          2 for ground(1) and space(2)
+      real trans (ndlon,nuco2,2,0:nflev+1)
+      real ksi (ndlon,nuco2,2,0:nflev+1)
+c                                                       only for space
+      real trans_emis (ndlon,nuco2,0:nflev+1)
+      real ksi_emis (ndlon,nuco2,0:nflev+1)
+
+c*************************************************************************
+c         1.0   Transmissions 
+c               -------------
+c----------------------------------------------------------------------
+c         1.1   Direct Transmission 
+c               -------------------
+
+c                                                                 space
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            zu(jl,ja)  = co2_u(jl,ja,jk)
+            zup(jl,ja) = co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,jk)
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,2,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+c                                                                 ground
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            zu(jl,ja) =  co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+            zup(jl,ja) = co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,1) /aer_t(jl,ja,jk)
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,1,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   Transmission with reflexion
+c               ---------------------------
+
+c                                                                 space
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+            zu(jl,ja) =   2 * co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+            zup(jl,ja) =  2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,1) 
+     .                    * aer_t(jl,ja,1)
+     .                    / aer_t(jl,ja,jk)
+
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans_emis(jl,ja,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+
+c*************************************************************************
+c         2.0   Exchange Coefficiants
+c               ---------------------
+
+      do jk = 1 , nlaylte
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c-------------------------------------------------------------------------
+c        2.1    colling to space  (from layer 1,nlaylte toward "layer" nlaylte+1)
+c               ----------------
+
+
+      ksi(jl,ja,2,jk) = trans(jl,ja,2,jk+1)
+     .                - trans(jl,ja,2,jk)
+
+      ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
+     .                   - trans_emis(jl,ja,jk+1) 
+
+      xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) 
+     .                        + ksi_emis(jl,ja,jk)* (1 - emis(jl))
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(ig0+jl,ja,nlaylte+1,jk)      = xi(ig0+jl,ja,jk,nlaylte+1)
+
+c-------------------------------------------------------------------------
+c        2.2    echange with ground  (from "layer" 0 toward layers 1,nlaylte)
+c               -------------------
+
+
+      ksi(jl,ja,1,jk) = trans(jl,ja,1,jk) 
+     .                - trans(jl,ja,1,jk+1)
+
+      xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk)
+
+c-------------------------------------------------------------------------
+          enddo
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+c       2.3     echange ground-space  (from "layer" 0 toward "layer" nlaylte+1)
+c               ----------------------
+
+c Is not used because we use sigma T4 for the ground budget in physiq.F
+
+      do ja = 1 , nuco2
+        do jl = 1 , kdlon
+
+      ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1) 
+      xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1)
+
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwxd.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwxd.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwxd.F	(revision 2744)
@@ -0,0 +1,257 @@
+      subroutine lwxd (ig0,kdlon,kflev,emis
+     .                ,aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXD   computes transmission function and exchange coefficiants
+c                        for distant layers
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c  
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |   |   |   |   |   |   |   | 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |   |***|***|***|***|   | 0 |   |
+c              |---|---|---|---|---|---|---|---|
+c     ...      |   |***|***|***|   | 0 |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      4       |   |***|***|   | 0 |   |***|   | 
+c              |---|---|---|---|---|---|---|---|
+c      3       |   |***|   | 0 |   |***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      2       |   |   | 0 |   |   |***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      1       |   | 0 |   |   |***|***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |   |   |***|***|***|***|   |  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1 
+c             (ground)                    (space)
+c  
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+ 
+#include "yomlw.h"
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer kdlon      ! part of ngrid
+      integer kflev      ! part of nalyer
+ 
+      real emis (ndlo2)                  ! surface emissivity
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,jkk,ndim
+      parameter(ndim = ndlon*nuco2*(nflev+2)*(nflev+2))
+
+
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+
+      real ksi (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real ksi_emis (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real trans (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real trans_emis (ndlon,nuco2,0:nflev+1,0:nflev+1)
+
+c----------------------------------------------------------------------
+      call zerophys(ndim,ksi_emis)
+c----------------------------------------------------------------------
+c         1.0   Transmission functions
+c               ----------------------
+
+c----------------------------------------------------------------------
+c        1.1   Direct transmission 
+c              -------------------
+
+      do jk = 1 , nlaylte+1
+        do jkk = jk , nlaylte+1
+
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+c                                                                   co2
+c                                                                   ---
+              zu(jl,ja) =  co2_u(jl,ja,jk)  - co2_u(jl,ja,jkk)
+              zup(jl,ja) = co2_up(jl,ja,jk) - co2_up(jl,ja,jkk)
+c                                                                   aer
+c                                                                   ---
+              zt_aer(jl,ja)= aer_t(jl,ja,jk)
+     .                      /aer_t(jl,ja,jkk)
+
+            enddo
+          enddo
+
+          call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+c                                                            co2 and aer
+c                                                            -----------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans(jl,ja,jk,jkk) = zt_co2(jl,ja) * zt_aer(jl,ja)
+            enddo
+          enddo
+c                                                       trans reciprocity
+c                                                       -----------------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans(jl,ja,jkk,jk) = trans(jl,ja,jk,jkk) 
+c           if (trans(jl,ja,jk,jkk) .LT. 0 ) then
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           endif
+c           if (trans(jl,ja,jk,jkk) .GT. 1) then
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           trans(jl,ja,jk,jkk)=1
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           endif
+
+            enddo
+          enddo
+     
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   Transmission with reflexion
+c               ---------------------------
+
+      do jk = 1 , nlaylte+1
+        do jkk = jk , nlaylte+1
+
+      if (callemis) then
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+c                                                                   co2
+c                                                                   ---
+              zu(jl,ja)  = 2 * co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+     .                                         - co2_u(jl,ja,jkk)
+              zup(jl,ja) = 2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+     .                                         - co2_up(jl,ja,jkk)
+c                                                                   aer
+c                                                                   ---
+                zt_aer(jl,ja)  = aer_t(jl,ja,1)
+     .                         * aer_t(jl,ja,1)
+     .                         / aer_t(jl,ja,jk)
+     .                         / aer_t(jl,ja,jkk)
+            enddo
+          enddo
+
+          call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+c                                                            co2 and aer
+c                                                            -----------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jk,jkk) = zt_co2(jl,ja)
+     .                                 * zt_aer(jl,ja)
+            enddo
+          enddo
+
+      else
+
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jk,jkk) = 1.
+            enddo
+          enddo
+
+      endif
+c                                                       trans reciprocity
+c                                                       -----------------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jkk,jk) = trans_emis(jl,ja,jk,jkk)
+c         if (trans_emis(jl,ja,jk,jkk) .LT. 0 
+c    .                .OR.  trans_emis(jl,ja,jk,jkk) .GT. 1) then
+c     print*,'trans_emis bande',ja,jk,jkk,trans_emis(jl,ja,jk,jkk)
+c         endif
+            enddo
+          enddo
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.0   Exchange Coefficiants
+c               ---------------------
+
+      do jk = 1 , nlaylte-2
+        do jkk = jk+2 , nlaylte
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk,jkk) = 
+     .            trans(jl,ja,jk+1,jkk)   - trans(jl,ja,jk,jkk)
+     .          - trans(jl,ja,jk+1,jkk+1) + trans(jl,ja,jk,jkk+1)
+
+      ksi_emis(jl,ja,jk,jkk) = 
+     .   trans_emis(jl,ja,jk,jkk)   - trans_emis(jl,ja,jk+1,jkk)
+     . - trans_emis(jl,ja,jk,jkk+1) + trans_emis(jl,ja,jk+1,jkk+1)
+
+c       if (ksi(jl,ja,jk,jkk) .LT. 0 ) then
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c           ksi(jl,ja,jk,jkk)=0
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c       endif
+c       if (ksi(jl,ja,jk,jkk) .GT. 1) then
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c           ksi(jl,ja,jk,jkk)=1
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c       endif
+
+c       if (ksi_emis(jl,ja,jk,jkk) .LT. 0 
+c    .                .OR.  ksi_emis(jl,ja,jk,jkk) .GT. 1) then
+c     print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk)
+c       endif
+
+      xi(ig0+jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
+     .      + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl))
+
+c                                                        ksi reciprocity
+c                                                        ---------------
+      ksi(jl,ja,jkk,jk)      = ksi(jl,ja,jk,jkk)
+      ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk)
+      xi(ig0+jl,ja,jkk,jk)   = xi(ig0+jl,ja,jk,jkk)
+
+            enddo
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.1   Save xi_emis for neighbours (lwxn.F)
+c               -----------------------------------
+
+      do jk = 1 , nlaylte-1
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c     ksi_emis(jl,ja,jk,jk+1) = 
+c    .   trans_emis(jl,ja,jk,jk+1)   - trans_emis(jl,ja,jk+1,jk+1)
+c    . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2)
+
+      xi_emis(ig0+jl,ja,jk) =
+     .                 ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl))
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwxn.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwxn.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/lwxn.F	(revision 2744)
@@ -0,0 +1,389 @@
+      subroutine lwxn ( ig0,kdlon,kflev
+     .                , dp
+     .                , aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXN   computes transmission function and exchange coefficiants
+c                        for neighbours layers
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c  
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |   |   |   |   |   |   |   | 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |   |   |   |   |   |***| 0 |   |
+c              |---|---|---|---|---|---|---|---|
+c     ...      |   |   |   |   |***| 0 |***|   |
+c              |---|---|---|---|---|---|---|---|
+c      4       |   |   |   |***| 0 |***|   |   | 
+c              |---|---|---|---|---|---|---|---|
+c      3       |   |   |***| 0 |***|   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      2       |   |***| 0 |***|   |   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      1       |   | 0 |***|   |   |   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |   |   |   |   |   |   |   |  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1 
+c             (ground)                    (space)
+c  
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+c                                                                       
+c  *********************************************************** nj=1
+c
+c
+c                                       sublayer    1                  
+c
+c
+c                                ----------------------------- nj=2
+c
+c                                       sublayer    2                  
+c
+c    - - - -  LAYER j - - - - -  ----------------------------- nj=3
+c
+c                                       sublayer    3                  
+c                                ----------------------------- nj=4
+c                                       sublayer  ncouche                  
+c  *********************************************************** ni=nj=ncouche+1
+c                                       sublayer  ncouche                  
+c                                ----------------------------- ni=4
+c                                       sublayer    3                  
+c
+c    - - - -  LAYER i - - - - -  ----------------------------- ni=3
+c
+c                                       sublayer    2                  
+c                     
+c                                ----------------------------- ni=2
+c
+c
+c                                       sublayer    1                  
+c
+c
+c  *********************************************************** ni=1
+c                                                                       
+c-----------------------------------------------------------------------
+c ATTENTION AUX UNITES:
+c le facteur 10*g fait passer des kg m-2 aux g cm-2
+c-----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+ 
+#include "yomlw.h"
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer kdlon     ! part of ngrid
+      integer kflev     ! part of nalyer
+
+      real dp (ndlo2,kflev)              ! layer pressure thickness (Pa)
+
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,nlmd,ni,nj
+
+      integer nmax
+      parameter (nmax=50)               ! max: 50 sublayers
+
+      real cn (nmax), cb (nmax)
+
+      real zu_layer_i (ndlon,nuco2)
+      real zup_layer_i (ndlon,nuco2)
+      real zt_aer_layer_i (ndlon,nuco2)
+
+      real zu_layer_j (ndlon,nuco2)
+      real zup_layer_j (ndlon,nuco2)
+      real zt_aer_layer_j (ndlon,nuco2)
+
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+
+      real zu_i (ndlon,nuco2,nmax+1)
+      real zup_i (ndlon,nuco2,nmax+1)
+      real zu_j (ndlon,nuco2,nmax+1)
+      real zup_j (ndlon,nuco2,nmax+1)
+      real zt_aer_i (ndlon,nuco2,nmax+1)
+      real zt_aer_j (ndlon,nuco2,nmax+1)
+
+      real trans (ndlon,nuco2,nmax+1,nmax+1)
+      real ksi (ndlon,nuco2,nflev-1)
+
+c----------------------------------------------------------------------
+c         0.3   Initialisation
+c               --------------
+
+      jk=ncouche+1
+      do ja = 1 ,nuco2
+        do jl = 1 , kdlon
+          zu_i (jl,ja,jk) = 0.
+          zup_i (jl,ja,jk) = 0.
+          zu_j (jl,ja,jk) = 0.
+          zup_j (jl,ja,jk) = 0.
+          zt_aer_i (jl,ja,jk) = 1.
+          zt_aer_j (jl,ja,jk) = 1.
+        enddo
+      enddo
+
+      if (linear) then
+
+      do nlmd = 1 ,ncouche
+        cn(nlmd)=(1.0/ncouche)
+        cb(nlmd)=(ncouche-nlmd+0.5)/ncouche
+c       print*,nlmd,cb(nlmd),cn(nlmd)
+      enddo
+
+      else
+
+      do nlmd = 1 ,ncouche-1
+        cn(nlmd)=(1-alphan)*alphan**(nlmd-1)
+        cb(nlmd)=0.5*(1+alphan)*alphan**(nlmd-1)
+      enddo
+      cn(ncouche)=alphan**(ncouche-1)
+      cb(ncouche)=0.5*alphan**(ncouche-1)
+
+      endif
+
+c test
+      if (nmax .LT. ncouche) then
+        print*,'!!!!! ATTENTION !!!!! '
+        print*,'probleme dans lwxn.F'
+        print*,' nmax=',nmax,'  < ncouche=',ncouche
+        call exit(1)
+      endif
+
+c----------------------------------------------------------------------
+      do jk = 1 , nlaylte-1
+c----------------------------------------------------------------------
+c         1.0   (co2) amount and (aer) transmission for all sublayers  
+c               ----------------------------------------------------
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c                                                        layer i (down)
+c                                                        -------------
+      zu_layer_i(jl,ja) =  co2_u(jl,ja,jk)  - co2_u(jl,ja,jk+1)
+      zup_layer_i(jl,ja) = co2_up(jl,ja,jk) - co2_up(jl,ja,jk+1)
+      zt_aer_layer_i(jl,ja) = aer_t(jl,ja,jk)
+     .                       / aer_t(jl,ja,jk+1)
+                                  
+      do nlmd=1,ncouche
+        zu_i(jl,ja,nlmd)=cn(nlmd)*zu_layer_i(jl,ja)
+        zup_i(jl,ja,nlmd)=cn(nlmd)*zup_layer_i(jl,ja)
+        zt_aer_i(jl,ja,nlmd)=zt_aer_layer_i(jl,ja)**cn(nlmd)
+      enddo
+
+c                                                          layer j (up)
+c                                                          ------------
+      zu_layer_j(jl,ja) =  co2_u(jl,ja,jk+1)  - co2_u(jl,ja,jk+2)
+      zup_layer_j(jl,ja) = co2_up(jl,ja,jk+1) - co2_up(jl,ja,jk+2)
+      zt_aer_layer_j(jl,ja) = aer_t(jl,ja,jk+1)
+     .                       / aer_t(jl,ja,jk+2)
+        
+      do nlmd=1,ncouche
+        zu_j(jl,ja,nlmd)=cn(nlmd)*zu_layer_j(jl,ja)
+        zup_j(jl,ja,nlmd)=cn(nlmd)*zup_layer_j(jl,ja)
+        zt_aer_j(jl,ja,nlmd)=zt_aer_layer_j(jl,ja)**cn(nlmd)
+      enddo
+
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         2.0   transmissions between all sublayers
+c               ------------------------------------
+
+        do ni = 1 ,ncouche+1
+
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=0.    
+      zup(jl,ja)=0.    
+      zt_aer(jl,ja)=1.    
+                        
+      do nlmd=ni,ncouche+1
+        zu(jl,ja)=zu(jl,ja)+zu_i(jl,ja,nlmd)    
+        zup(jl,ja)=zup(jl,ja)+zup_i(jl,ja,nlmd)    
+        zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_i(jl,ja,nlmd)    
+      enddo
+              enddo
+            enddo
+
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ni,ncouche+1)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+c on ajoute la couche J
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=zu(jl,ja)+zu_layer_j(jl,ja) 
+      zup(jl,ja)=zup(jl,ja)+zup_layer_j(jl,ja) 
+      zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_layer_j(jl,ja) 
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ni,1)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+        enddo
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+        
+        do nj = 1 ,ncouche+1
+
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=0.    
+      zup(jl,ja)=0.    
+      zt_aer(jl,ja)=1.    
+                        
+      do nlmd=nj,ncouche+1
+        zu(jl,ja)=zu(jl,ja)+zu_j(jl,ja,nlmd)    
+        zup(jl,ja)=zup(jl,ja)+zup_j(jl,ja,nlmd)    
+        zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_j(jl,ja,nlmd)    
+      enddo
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ncouche+1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+c on ajoute la couche I
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=zu(jl,ja)+zu_layer_i(jl,ja) 
+      zup(jl,ja)=zup(jl,ja)+zup_layer_i(jl,ja) 
+      zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_layer_i(jl,ja) 
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+        enddo
+        
+c----------------------------------------------------------------------
+c         3.0   global exchange coefficiant between neigthbours
+c               -----------------------------------------------
+        
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            ksi(jl,ja,jk) = 0.
+          enddo
+        enddo
+
+        do ni = 1 ,ncouche
+          do ja = 1 ,nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk)=ksi(jl,ja,jk) +
+     .             ( trans(jl,ja,ni+1,ncouche+1)
+     .             - trans(jl,ja,ni,ncouche+1)
+     .             - trans(jl,ja,ni+1,1)
+     .             + trans(jl,ja,ni,1) )
+     .             * (cb(ni)*dp(jl,jk)) * 2    
+     .             /  (dp(jl,jk) + dp(jl,jk+1))       !!!!!!!!!!!!!!!!!!!
+
+            enddo
+          enddo
+        enddo
+
+        do nj = 1 ,ncouche
+          do ja = 1 ,nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk)=ksi(jl,ja,jk) +
+     .             ( trans(jl,ja,ncouche+1,nj+1)
+     .             - trans(jl,ja,1,nj+1)
+     .             - trans(jl,ja,ncouche+1,nj)
+     .             + trans(jl,ja,1,nj) )
+     .             * (cb(nj)*dp(jl,jk+1)) * 2 
+     .             /  (dp(jl,jk) + dp(jl,jk+1))       !!!!!!!!!!!!!!!!!!!
+
+            enddo
+          enddo
+        enddo
+
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            xi(ig0+jl,ja,jk,jk+1) = ksi(jl,ja,jk)
+     .                            + xi_emis(ig0+jl,ja,jk)
+
+c                                                        ksi reciprocity
+c                                                        ---------------
+            xi(ig0+jl,ja,jk+1,jk) = xi(ig0+jl,ja,jk,jk+1)
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         4.0   Special treatment for ground
+c               ----------------------------
+
+
+      if (jk .EQ. 1) then
+
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            xi_ground(ig0+jl,ja)=0.
+          enddo
+        enddo
+
+        do ni = 1 ,ncouche
+          do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+
+      xi_ground(ig0+jl,ja) = xi_ground(ig0+jl,ja)
+     .                     + ( trans(jl,ja,ni+1,ncouche+1)
+     .                        -trans(jl,ja,ni,ncouche+1))
+     .                     * 2 * cb(ni)
+            enddo
+          enddo
+        enddo
+
+      endif
+
+c----------------------------------------------------------------------
+      enddo    !  boucle sur jk
+c----------------------------------------------------------------------
+      return
+      end
+
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_dimphys.h_ref
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_dimphys.h_ref	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_dimphys.h_ref	(revision 2744)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimphys.h'
+
+
+         INTEGER, parameter :: wiim=--xsize--
+         INTEGER, parameter :: wjjm=--ysize--
+         INTEGER, PARAMETER :: ngridmx=--physize--
+         INTEGER, parameter :: nlayermx=--zsize--
+         INTEGER, PARAMETER :: nsoilmx=--soilsize--
+	
+!-----------------------------------------------------------------------
+
+	 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_dustopacity.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_dustopacity.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_dustopacity.F	(revision 2744)
@@ -0,0 +1,318 @@
+      SUBROUTINE meso_dustopacity(ngrid,nlayer,nq,
+     $    zday,pplay,pplev,ls,pq,
+     $    tauref,tau,aerosol)
+                                                   
+       IMPLICIT NONE
+
+c=======================================================================
+c
+c       CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+c
+c       ... CHECK THE ****WRF lines
+c
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth (dust opacity) 
+c   In each layers
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq
+!****WRF
+      INTEGER ierr 
+!****WRF
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+      real r0,reff,coefsize
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+
+c        altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c        in the Viking year scenario
+         DO ig=1,ngrid
+             topdust0(ig)=60. -22.*SIN(lati(ig))**2
+         END DO
+         firstcall=.false.
+      END IF
+
+	
+
+c  -------------------------------------------------------------
+c     1) Prescribed dust  (if tracer=F or active=F)
+c  -------------------------------------------------------------
+      IF ((.not.tracer) .or. (.not.active)) THEN 
+
+c       Vertical column optical depth at 700.Pa 
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        IF(iaervar.eq.1) THEN
+!****WRF
+!****WRF: additional ASCII file to define dust opacity
+          OPEN(99,file='dustopacity.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+          IF(ierr.NE.0) THEN
+                write(*,*) 'No file dustopacity.def'
+                stop
+          ELSE
+             READ(99,*) tauvis
+             write(*,*) 'constant tau', tauvis   
+!****WRF
+!****WRF
+             do ig=1, ngridmx
+                tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste as read in file
+             end do
+             CLOSE(99)
+          ENDIF
+        ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+          tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+          do ig=2,ngrid
+            tauref(ig) = tauref(1)
+          end do
+
+        ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+           taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+           tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+           tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+	     
+           do ig=1,ngrid/2  ! Northern hemisphere
+             tauref(ig)= tauN +
+     &       (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+           end do
+           do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+             tauref(ig)= tauS +
+     &       (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+           end do
+
+        ELSE IF (iaervar.eq.4) THEN  ! << "TES" scenario >>
+c*************WRF
+c
+c 1. MY24 TES 
+c
+           call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+        ELSE IF (iaervar.gt.99) THEN  ! << input netcdf file >>
+c*************WRF
+c
+c 2. customized dust opacity field
+c   ex: from assimilation
+       call meso_readtesassim(ngrid,nlayer,zday,pplev,tauref,
+     . iaervar)
+c
+c*************WRF
+
+
+        ELSE
+          stop 'problem with iaervar in dustopacity.F'
+        ENDIF
+
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          end do
+        endif
+
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+         expfactor=0.
+          DO l=1,nlayer
+             DO ig=1,ngrid
+             if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+               expfactor=1.e-3
+              endif       
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     &           *expfactor
+c     s           *max( exp(.007*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+c     changement dans le calcul de la distribution verticale          
+c     dans le cas des scenarios de poussieres assimiles
+c        if (iaervar.eq.4) THEN  ! TES
+c        call zerophys(ngrid*naerkind,tau)
+c
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c                tau(ig,1)=tau(ig,1)+ aerosol(ig,l,1)
+c           end do
+c        end do
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c               aerosol(ig,l,1)=aerosol(ig,l,1)*tauref(ig)/tau(ig,1)
+c     $     *(pplev(ig,1)/700)
+c           end do
+c        end do
+c        endif
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c  ---------------------------------------------------------------------
+c     2) Transported radiatively active dust  (if tracer=T and active=T)
+c ----------------------------------------------------------------------
+      ELSE  IF ((tracer) .and. (active)) THEN 
+c     The dust opacity is computed from q
+
+c     a) "doubleq" technique (transport of mass and number mixing ratio)
+c        ~~~~~~~~~~~~~~~~~~~
+       if(doubleq) then 
+
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+
+c        Computing effective radius :
+         do  l=1,nlayer
+           do ig=1, ngrid
+              r0=
+     &        (r3n_q*pq(ig,l,1)/max(pq(ig,l,2),0.01))**(1./3.)
+              r0=min(max(r0,1.e-10),500.e-6)
+              reff= ref_r0 * r0
+cc           If  reff is small, the transported dust mean Qext
+c            is reduced from the reference dust Qext by a factor "coefsize"
+
+             coefsize=min(max(2.52e6*reff-0.043 ,0.)   ,1.)
+
+cc              It is added 1.e-8 to pq to avoid low
+
+                aerosol(ig,l,1)=aerosol(ig,l,1)+ 1.E-8 +
+     &         ( 0.75*Qext(1)*coefsize/(rho_dust*reff))
+     &          * (pq(ig,l,1))*
+     &          (pplev(ig,l)-pplev(ig,l+1))/g
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+
+c     b) Size bin technique (each aerosol can contribute to opacity))
+c        ~~~~~~~~~~~~~~~~~~
+       else
+c        The dust opacity is computed from q
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         do iq=1,dustbin
+           do l=1,nlayer
+              do ig=1,ngrid
+cc               qextrhor(iq) is  (3/4)*Qext/(rho*reff)
+cc               It is added 1.e-8 to pq to avoid low
+                 aerosol(ig,l,1)=aerosol(ig,l,1)+
+     &           qextrhor(iq)* (pq(ig,l,iq) + 1.e-8)*
+     &           (pplev(ig,l)-pplev(ig,l+1))/g
+              end do
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+       end if  ! (doubleq)
+      END IF   ! (dust scenario)
+
+c --------------------------------------------------------------------------
+c Column integrated visible optical depth in each point (used for diagnostic)
+c --------------------------------------------------------------------------
+      call zerophys(ngrid*naerkind,tau)
+      do l=1,nlayer
+         do ig=1,ngrid
+               tau(ig,1)=tau(ig,1)+ aerosol(ig,l,1)
+         end do
+      end do
+
+      return
+      end 
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_physiq.F_old
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_physiq.F_old	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_physiq.F_old	(revision 2744)
@@ -0,0 +1,1689 @@
+      SUBROUTINE meso_physiq(ngrid,nlayer,nq,
+     $            firstcall,lastcall,
+     $		  wday_ini,
+     $            pday,ptime,ptimestep,
+     $            pplev,pplay,pphi,
+     $            pu,pv,pt,pq,
+     $            pw,
+     $            pdu,pdv,pdt,pdq,pdpsrf,tracerdyn,
+     $		  wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,
+     $		  wecritphys,
+     $            output_tab2d, output_tab3d)
+
+
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c	CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+c
+c	... CHECK THE ****WRF lines
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Organisation of the physical parametrisations of the LMD 
+c   martian atmospheric general circulation model.
+c
+c   The GCM can be run without or with tracer transport
+c   depending on the value of Logical "tracer" in file  "callphys.def"
+c   Tracers may be water vapor, ice OR chemical species OR dust particles
+c
+c   SEE comments in initracer.F about numbering of tracer species...
+c
+c   It includes:
+c
+c      1. Initialisation:
+c      1.5 Calculation of mean mass and cp, R and thermal conduction coeff.
+c      2. Calcul of the radiative tendencies : radiative transfer
+c         (longwave and shortwave) for CO2 and dust.
+c      3. Gravity wave and subgrid scale topography drag :
+c      4. Vertical diffusion (turbulent mixing):
+c      5. convective adjustment
+c      6.  TRACERS :
+c       6a. water and water ice
+c       6b. call for photochemistry when tracers are chemical species
+c       6c. other scheme for tracer (dust) transport (lifting, sedimentation)
+c       6d. updates (CO2 pressure variations, surface budget)
+c      7.  condensation and sublimation of carbon dioxide.
+c      8. Surface and sub-surface temperature calculations
+c      9. Writing output files :
+c           - "startfi", "histfi" (if it's time)
+c           - Saving statistics (if "callstats = .true.")
+c           - Dumping eof (if "calleofdump = .true.")
+c           - Output any needed variables in "diagfi" 
+c      10. Diagnostic: mass conservation of tracers
+c 
+c   author: 
+c   ------- 
+c           Frederic Hourdin	15/10/93
+c           Francois Forget		1994
+c           Christophe Hourdin	02/1997 
+c           Subroutine completly rewritten by F.Forget (01/2000)
+c           Introduction of the photochemical module: S. Lebonnois (11/2002)
+c           Introduction of the thermosphere module: M. Angelats i Coll (2002)
+c           Water ice clouds: Franck Montmessin (update 06/2003)
+c	    WRF version: Aymeric Spiga (01-03/2007)
+c           
+c
+c
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c    ecri                  period (in dynamical timestep) to write output
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    nq                    Number of advected fields
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c    ptime                 Universal time (0<ptime<1): ptime=0.5 at 12:00 UT
+c    ptimestep             timestep (s)
+c    pplay(ngrid,nlayer)   Pressure at the middle of the layers (Pa)
+c    pplev(ngrid,nlayer+1) intermediate pressure levels (pa)
+c    pphi(ngrid,nlayer)    Geopotential at the middle of the layers (m2s-2)
+c    pu(ngrid,nlayer)      u component of the wind (ms-1)
+c    pv(ngrid,nlayer)      v component of the wind (ms-1)
+c    pt(ngrid,nlayer)      Temperature (K)
+c    pq(ngrid,nlayer,nq)   Advected fields
+c    pudyn(ngrid,nlayer)    \ 
+c    pvdyn(ngrid,nlayer)     \ Dynamical temporal derivative for the
+c    ptdyn(ngrid,nlayer)     / corresponding variables
+c    pqdyn(ngrid,nlayer,nq) /
+c    pw(ngrid,?)           vertical velocity
+c 
+c
+c    ****WRF 
+c	day_ini,tsurf,tsoil,emis,q2,qsurf,co2ice are inputs 
+c		and locally saved variables
+c    			(no need to call phyetat0)
+c
+c
+c   output:
+c   -------
+c
+c    pdu(ngrid,nlayermx)        \
+c    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding
+c    pdt(ngrid,nlayermx)         /  variables due to physical processes.
+c    pdq(ngrid,nlayermx)        /
+c    pdpsrf(ngrid)             /
+c    tracerdyn                 call tracer in dynamical part of GCM ?
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "comsaison.h"
+#include "control.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "tracer.h"
+#include "nlteparams.h"
+
+#include "chimiedata.h"
+#include "watercap.h"
+#include "fisice.h"
+#include "param.h"
+#include "param_v3.h"
+#include "conc.h"
+
+#include "netcdf.inc"
+
+#include "slope.h"
+!!#include "wrf_output.h"
+
+
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+      INTEGER ngrid,nlayer,nq
+      REAL ptimestep
+      REAL pplev(ngridmx,nlayer+1),pplay(ngridmx,nlayer)
+      REAL pphi(ngridmx,nlayer)
+      REAL pu(ngridmx,nlayer),pv(ngridmx,nlayer)
+      REAL pt(ngridmx,nlayer),pq(ngridmx,nlayer,nq)
+      REAL pw(ngridmx,nlayer) !Mars pvervel transmit par dyn3d
+      REAL zh(ngridmx,nlayermx)      ! potential temperature (K)
+      LOGICAL firstcall,lastcall
+c ****WRF
+      INTEGER wday_ini  
+      REAL wtsurf(ngridmx)	! input only ay firstcall - output            
+      REAL wtsoil(ngridmx,nsoilmx)    
+      REAL wco2ice(ngridmx)             
+      REAL wemis(ngridmx)             
+      REAL wqsurf(ngridmx,nqmx)       
+      REAL wq2(ngridmx,nlayermx+1) 
+      REAL wecritphys	
+c      REAL output_tau(ngridmx)
+c      REAL output_swsurf(ngridmx),output_lwsurf(ngridmx)
+c      REAL output_rice(ngridmx,nlayer)
+c
+c LE NOMBRE DE SORTIES EST CODE EN DUR
+c
+      REAL output_tab2d(ngridmx,10)
+      REAL output_tab3d(ngridmx,nlayer,1)
+      
+      REAL sl_ls, sl_lct, sl_lat, sl_tau, sl_alb, sl_the, sl_psi
+      REAL sl_fl0, sl_flu
+c ****WRF
+      REAL pday
+      REAL ptime 
+      logical tracerdyn
+
+c   outputs:
+c   --------
+c     physical tendencies
+      REAL pdu(ngridmx,nlayer),pdv(ngridmx,nlayer)
+      REAL pdt(ngridmx,nlayer),pdq(ngridmx,nlayer,nq)
+      REAL pdpsrf(ngridmx)
+
+
+c Local saved variables:
+c ----------------------
+c     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+c     "longrefvis" set in dimradmars.h , for one of the "naerkind"  kind of
+c      aerosol optical properties  :
+      REAL aerosol(ngridmx,nlayermx,naerkind) 
+
+      INTEGER day_ini  ! Initial date of the run (sol since Ls=0) 
+      INTEGER icount     ! counter of calls to physiq during the run.
+      REAL tsurf(ngridmx)            ! Surface temperature (K)
+      REAL tsoil(ngridmx,nsoilmx)    ! sub-surface temperatures (K)
+      REAL co2ice(ngridmx)           ! co2 ice surface layer (kg.m-2)  
+      REAL albedo(ngridmx,2)         ! Surface albedo in each solar band
+      REAL emis(ngridmx)             ! Thermal IR surface emissivity
+      REAL dtrad(ngridmx,nlayermx)   ! Net atm. radiative heating rate (K.s-1)
+      REAL fluxrad(ngridmx)          ! Net radiative surface flux (W.m-2)
+      REAL capcal(ngridmx)           ! surface heat capacity (J m-2 K-1)
+      REAL fluxgrd(ngridmx)          ! surface conduction flux (W.m-2)
+      REAL qsurf(ngridmx,nqmx)       ! tracer on surface (e.g. kg.m-2)
+      REAL q2(ngridmx,nlayermx+1)    ! Turbulent Kinetic Energy 
+      INTEGER ig_vl1                 ! Grid Point near VL1   (for diagnostic) 
+
+      SAVE day_ini, icount
+      SAVE aerosol, tsurf,tsoil
+      SAVE co2ice,albedo,emis, q2
+      SAVE capcal,fluxgrd,dtrad,fluxrad, qsurf
+      SAVE ig_vl1
+
+      REAL stephan   
+      DATA stephan/5.67e-08/  ! Stephan Boltzman constant
+      SAVE stephan
+
+c Local variables :
+c -----------------
+      CHARACTER*80 fichier 
+      INTEGER l,ig,ierr,igout,iq, tapphys
+      INTEGER iqmin                     ! Used if iceparty engaged
+
+      REAL fluxsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2)
+      REAL fluxsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL fluxtop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL fluxtop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+c     for clear area (uncovered by clouds) :
+      REAL clsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2) 
+      REAL clsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL cltop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL cltop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+      REAL tauref(ngridmx)           ! Reference column optical depth at 700 Pa
+                                     ! (used if active=F) 
+      REAL tau(ngridmx,naerkind)     ! Column dust optical depth at each point
+      REAL zls                       !  solar longitude (rad)
+      REAL zday                      ! date (time since Ls=0, in martian days)
+      REAL zzlay(ngridmx,nlayermx)   ! altitude at the middle of the layers
+      REAL zzlev(ngridmx,nlayermx+1) ! altitude at layer boundaries
+      REAL latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
+
+
+c     Tendancies due to various processes:
+      REAL dqsurf(ngridmx,nqmx)
+      REAL zdtlw(ngridmx,nlayermx)     ! (K/s)
+      REAL zdtsw(ngridmx,nlayermx)     ! (K/s)
+      REAL cldtlw(ngridmx,nlayermx)     ! (K/s) LW heating rate for clear area
+      REAL cldtsw(ngridmx,nlayermx)     ! (K/s) SW heating rate for clear area
+      REAL zdtnirco2(ngridmx,nlayermx) ! (K/s)
+      REAL zdtnlte(ngridmx,nlayermx)   ! (K/s)
+      REAL zdtsurf(ngridmx)            ! (K/s)
+      REAL zdtcloud(ngridmx,nlayermx)
+      REAL zdvdif(ngridmx,nlayermx),zdudif(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhdif(ngridmx,nlayermx), zdtsdif(ngridmx)         ! (K/s)
+      REAL zdvadj(ngridmx,nlayermx),zduadj(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhadj(ngridmx,nlayermx)                           ! (K/s)
+      REAL zdtgw(ngridmx,nlayermx)                            ! (K/s)
+      REAL zdugw(ngridmx,nlayermx),zdvgw(ngridmx,nlayermx)    ! (m.s-2)
+      REAL zdtc(ngridmx,nlayermx),zdtsurfc(ngridmx)
+      REAL zdvc(ngridmx,nlayermx),zduc(ngridmx,nlayermx)
+
+      REAL zdqdif(ngridmx,nlayermx,nqmx), zdqsdif(ngridmx,nqmx)
+      REAL zdqsed(ngridmx,nlayermx,nqmx), zdqssed(ngridmx,nqmx)
+      REAL zdqdev(ngridmx,nlayermx,nqmx), zdqsdev(ngridmx,nqmx)
+      REAL zdqadj(ngridmx,nlayermx,nqmx)
+      REAL zdqc(ngridmx,nlayermx,nqmx)
+      REAL zdqcloud(ngridmx,nlayermx,nqmx)
+      REAL zdqscloud(ngridmx,nqmx)
+      REAL zdqchim(ngridmx,nlayermx,nqmx)
+      REAL zdqschim(ngridmx,nqmx)
+
+      REAL zdteuv(ngridmx,nlayermx)    ! (K/s)
+      REAL zdtconduc(ngridmx,nlayermx) ! (K/s)
+      REAL zdumolvis(ngridmx,nlayermx)
+      REAL zdvmolvis(ngridmx,nlayermx)
+      real zdqmoldiff(ngridmx,nlayermx,nqmx)
+
+c     Local variable for local intermediate calcul:
+      REAL zflubid(ngridmx)
+      REAL zplanck(ngridmx),zpopsk(ngridmx,nlayermx)
+      REAL zdum1(ngridmx,nlayermx)
+      REAL zdum2(ngridmx,nlayermx)
+      REAL ztim1,ztim2,ztim3, z1,z2
+      REAL ztime_fin
+      REAL zdh(ngridmx,nlayermx)
+      REAL pclc_min ! minimum of the cloud fraction over the whole domain
+      INTEGER length
+      PARAMETER (length=100)
+
+c local variables only used for diagnostic (output in file "diagfi" or "stats")
+c -----------------------------------------------------------------------------
+      REAL ps(ngridmx), zt(ngridmx,nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL fluxtop_sw_tot(ngridmx), fluxsurf_sw_tot(ngridmx)
+      character*2 str2
+      character*5 str5
+      real zdtdif(ngridmx,nlayermx), zdtadj(ngridmx,nlayermx)
+      real reff(ngridmx,nlayermx) ! effective dust radius (used if doubleq=T)
+      real qtot1,qtot2 ! total aerosol mass
+      integer igmin, lmin
+      logical tdiag
+
+
+      REAL zplev(ngrid,nlayermx+1),zplay(ngrid,nlayermx)
+      real hco2(nqmx),tmean, zlocal(nlayermx)
+      real rho(ngridmx,nlayermx) ! density
+      real vmr(ngridmx,nlayermx) ! volume mixing ratio
+
+      REAL time_phys
+     
+c=======================================================================
+
+c 1. Initialisation:
+c -----------------
+ 
+
+c     Initialisation only at first call
+c     ---------------------------------
+      IF(firstcall) THEN
+
+c        variables set to 0
+c        ~~~~~~~~~~~~~~~~~~
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         call zerophys(ngrid*nlayer,dtrad)
+         call zerophys(ngrid,fluxrad)
+
+c ****WRF
+c
+c	No need to use startfi.nc
+c		> part of the job of phyetat0 is done in inifis
+c		> remaining initializations are passed here from the WRF variables
+c		> beware, some operations were done by phyetat0 (ex: tracers)
+c			> if any problems, look in phyetat0
+c
+	tsurf(:)=wtsurf(:)
+        	PRINT*,'check: tsurf ',tsurf(1),tsurf(ngridmx)
+	tsoil(:,:)=wtsoil(:,:)
+        	PRINT*,'check: tsoil ',tsoil(1,1),tsoil(ngridmx,nsoilmx)
+	emis(:)=wemis(:)
+        	PRINT*,'check: emis ',emis(1),emis(ngridmx)
+	q2(:,:)=wq2(:,:)
+        	PRINT*,'check: q2 ',q2(1,1),q2(ngridmx,nlayermx+1)
+	qsurf(:,:)=wqsurf(:,:)
+        	PRINT*,'check: qsurf ',qsurf(1,1),qsurf(ngridmx,nqmx)
+	co2ice(:)=wco2ice(:)
+        	PRINT*,'check: co2 ',co2ice(1),co2ice(ngridmx)
+	day_ini=wday_ini
+
+c	artificially filling dyn3d/control.h is also required
+c	> iphysiq is put in WRF to be set easily (cf ptimestep)
+c	> day_step is simply deduced:
+c
+	day_step=daysec/ptimestep
+	PRINT*,'Call to LMD physics:',day_step,' per Martian day'
+c
+        ecritphy=wecritphys
+                !!PRINT*,ecri_phys  
+                !!PRINT*,float(ecri_phys) ...
+                !!renvoient tous deux des nombres absurdes 
+                !!pourtant callkeys.h est inclus ...
+                !!
+                !!donc ecritphys est passe en argument ... 
+        PRINT*,'Write LMD physics each:',ecritphy,' seconds'
+
+        iphysiq=ptimestep
+
+c
+c ****WRF
+
+
+         if (pday.ne.day_ini) then
+           write(*,*) "***ERROR Pb de synchronisation entre phys et dyn"
+           write(*,*) "jour dynamique: ",pday
+           write(*,*) "jour physique: ",day_ini
+           stop
+         endif
+
+         write (*,*) 'In physic day_ini =', day_ini
+
+	
+
+c        Initialize albedo and orbital calculation
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         CALL surfini(ngrid,co2ice,qsurf,albedo)
+         CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)
+
+c        initialisation soil 
+c        ~~~~~~~~~~~~~~~~~~~
+         IF (callsoil) THEN
+            CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+         ELSE
+            PRINT*,'WARNING! Thermal conduction in the soil turned off'
+            DO ig=1,ngrid
+               capcal(ig)=1.e5
+               fluxgrd(ig)=0.
+            ENDDO
+         ENDIF
+         icount=1
+
+
+c        initialisation pour les traceurs
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (tracer) THEN
+            CALL initracer(qsurf,co2ice)
+         ENDIF  ! end tracer
+
+c ****WRF
+c
+c nosense in mesoscale modeling
+c
+cc        Determining gridpoint near Viking Lander 1 (used for diagnostic only)
+cc        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         if(ngrid.ne.1) then
+c           latvl1= 22.27 
+c           lonvl1= -47.94 
+c           ig_vl1= 1+ int( (1.5-(latvl1-90.)*jjm/180.)  -2 )*iim +
+c     &              int(1.5+(lonvl1+180)*iim/360.)
+c           write(*,*) 'Viking Lander 1 GCM point: lat,lon',
+c     &              lati(ig_vl1)*180/pi, long(ig_vl1)*180/pi
+c         end if 
+c
+c ****WRF
+
+
+c        Initializing thermospheric parameters
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         if (callthermos) call param_read
+
+c        Initializing R and Cp as constant
+
+         if (.not.callthermos .and. .not.photochem) then
+                 do l=1,nlayermx
+                  do ig=1,ngridmx
+                   rnew(ig,l)=r
+                   cpnew(ig,l)=cpp
+                   mmean(ig,l)=mugaz
+                   enddo
+                  enddo  
+         endif         
+                   
+      ENDIF        !  (end of "if firstcall")
+
+c    ------------------------------------------
+c    Initialisations at every physical timestep:
+c    ------------------------------------------
+c
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in PHYSIQ'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+      zday=pday+ptime
+
+	
+
+c     Computing Solar Longitude (Ls) :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (season) then 
+	 PRINT*,'day',zday
+         CALL solarlong(zday,zls)
+      else
+         PRINT*,'day_ini',day_ini
+         call solarlong(float(day_ini),zls) 
+      end if
+
+
+c     Initializing various variable
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      call zerophys(ngrid*nlayer, pdv)
+      call zerophys(ngrid*nlayer, pdu)
+      call zerophys(ngrid*nlayer, pdt)
+      call zerophys(ngrid*nlayer*nq, pdq)
+      call zerophys(ngrid, pdpsrf)
+      call zerophys(ngrid, zflubid)
+      call zerophys(ngrid, zdtsurf)
+      call zerophys(ngrid*nq, dqsurf)
+      igout=ngrid/2+1 
+
+c     computing geopotentiel at interlayer levels
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     ponderation des altitudes au niveau des couches en dp/p
+
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            zzlay(ig,l)=pphi(ig,l)/g    
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+         zzlev(ig,1)=0.
+         zzlev(ig,nlayer+1)=1.e7    ! dummy top of last layer above 10000 km...
+      ENDDO
+      DO l=2,nlayer
+         DO ig=1,ngrid
+            z1=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
+            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         ENDDO
+      ENDDO
+
+
+!     Potential temperature calculation not the same in physiq and dynamic
+
+c     Computing potential temperature
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      DO l=1,nlayer
+         DO ig=1,ngrid 
+            zpopsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**rcp
+            zh(ig,l)=pt(ig,l)/zpopsk(ig,l)
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    1.5 Calculation of mean mass, cp, and R
+c    ---------------------------------------
+
+      if(photochem.or.callthermos) then
+         call concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+      endif
+c-----------------------------------------------------------------------
+c    2. Calcul of the radiative tendencies :
+c    ---------------------------------------
+
+
+      IF(callrad) THEN
+         IF( MOD(icount-1,iradia).EQ.0) THEN
+
+c          Local Solar zenith angle
+c          ~~~~~~~~~~~~~~~~~~~~~~~~
+        
+           CALL orbite(zls,dist_sol,declin)
+
+           IF(diurnal) THEN
+               ztim1=SIN(declin)
+               ztim2=COS(declin)*COS(2.*pi*(zday-.5))
+               ztim3=-COS(declin)*SIN(2.*pi*(zday-.5))
+
+               CALL solang(ngrid,sinlon,coslon,sinlat,coslat,
+     s         ztim1,ztim2,ztim3, mu0,fract)
+
+           ELSE
+               CALL mucorr(ngrid,declin, lati, mu0, fract,10000.,rad)
+           ENDIF
+
+
+	
+c          NLTE cooling from CO2 emission
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           IF(callnlte) CALL nltecool(ngrid,nlayer,pplay,pt,zdtnlte)
+
+
+c          Find number of layers for LTE radiation calculations
+           IF(MOD(iphysiq*(icount-1),day_step).EQ.0) THEN          
+		CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+	   ENDIF	
+
+		
+c          Atmospheric dust opacity and aerosol distribution:
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+cc*****WRF
+         CALL meso_dustopacity(ngrid,nlayer,nq,
+     $          zday,pplay,pplev,zls,pq,
+     $      tauref,tau,aerosol)
+
+cc*****WRF
+
+        
+c          Calling main radiative transfer scheme
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c          Transfer through dust and CO2, except NIR CO2 absorption
+
+c ----------
+c partie rajoutee par Franck, commentee pour l'instant
+c ----------
+c
+c           if (ngridmx.eq.1) pclc(1)=1. !TEST for 1D simulation
+c
+c           pclc_min=1.
+c           if (activice.and.naerkind.gt.1) then
+c             do ig=1,ngrid
+c               pclc_min=min(pclc_min,pclc(ig))
+c             enddo
+c           endif
+c
+c           IF(activice.and.naerkind.gt.1.and.pclc_min.lt.1) THEN
+c          Computing radiative tendencies accounting for a cloudy area (0< pclc(ngrid) <1)
+c          pclc is set in initracer (prescribed for the moment).
+c          two steps : 1/rad. tend. without clouds (aerosol(*,*,2)=0.)
+c          ~~~~~~~~~   2/rad. tend. with clouds
+c                      3/final tendencies=average of 1/ and 2/ weighted by the
+cloud area (pclc)
+c
+c
+c 1/
+c           call zerophys(nlayer*ngrid,aerosol(1,1,2))  !remettre
+c           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+c     $     cldtlw,cldtsw,clsurf_lw,clsurf_sw,cltop_lw,cltop_sw)
+c
+c 2/
+c           CALL h2oiceopacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,
+c     $     tau,aerosol,zls,co2ice)
+c
+c           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+c     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+c
+c 3/
+c           do l=1,nlayer
+c             do ig=1,ngrid
+c             zdtlw(ig,l)=(1.-pclc(ig))*cldtlw(ig,l)+pclc(ig)*zdtlw(ig,l)
+c             zdtsw(ig,l)=(1.-pclc(ig))*cldtsw(ig,l)+pclc(ig)*zdtsw(ig,l)
+c             enddo
+c           enddo
+c           do ig=1,ngrid
+c             fluxsurf_lw(ig)=(1.-pclc(ig))*clsurf_lw(ig)+
+c     $        pclc(ig)*fluxsurf_lw(ig)
+c             fluxtop_lw(ig)=(1.-pclc(ig))*cltop_lw(ig)+
+c     $        pclc(ig)*fluxtop_lw(ig)
+c
+c             fluxsurf_sw(ig,1)=(1.-pclc(ig))*clsurf_sw(ig,1)+
+c     $        pclc(ig)*fluxsurf_sw(ig,1)
+c             fluxsurf_sw(ig,2)=(1.-pclc(ig))*clsurf_sw(ig,2)+
+c     $        pclc(ig)*fluxsurf_sw(ig,2)
+c
+c             fluxtop_sw(ig,1)=(1.-pclc(ig))*cltop_sw(ig,1)+
+c     $        pclc(ig)*fluxtop_sw(ig,1)
+c             fluxtop_sw(ig,2)=(1.-pclc(ig))*cltop_sw(ig,2)+
+c     $        pclc(ig)*fluxtop_sw(ig,2)
+c           enddo
+c
+c           ELSE
+c
+c          Atmospheric water ice opacity and particle distribution:
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+c           if (activice.and.naerkind.gt.1)
+c     &      CALL h2oiceopacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,
+c     &      tau,aerosol,zls,co2ice)
+c
+c
+c ----------
+c  fin partie rajoutee par Franck (plus ENDIF ci-dessous)
+c ----------
+
+           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+
+c ----------
+c           ENDIF ! end of condition on the cloudy fraction
+c ----------
+
+
+ccccc
+ccccc PARAM SLOPE
+ccccc
+
+c          Insolation (direct + scaterred) on a slope
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           DO ig=1,ngrid  
+
+                DO l=1,2
+           
+		sl_ls = 180.*zls/pi
+		sl_lct = ptime*24. + 180.*long(ig)/pi/15.
+		sl_lat = 180.*lati(ig)/pi
+		sl_tau = tau(ig,1)
+		sl_alb = albedo(ig,l)
+		sl_the = theta_sl(ig)
+		sl_psi = psi_sl(ig)
+		sl_fl0 = fluxsurf_sw(ig,l)
+
+           if (ig .eq. 1) then
+                write(*,*) 'ls ', 'lct ' , 'lat ', 'tau ',
+     &                   'alb ', 'the ', 'psi ', 'fl0 '
+		write(*,*) sl_ls, sl_lct, sl_lat, sl_tau, 
+     &                   sl_alb, sl_the, sl_psi, sl_fl0
+           endif
+                   
+		CALL param_slope(sl_ls, sl_lct, sl_lat, 
+     &                   sl_tau, sl_alb, 
+     &                   sl_the, sl_psi, sl_fl0, sl_flu)
+
+                fluxsurf_sw(ig,l) = sl_flu
+             ENDDO
+           ENDDO
+
+ccccc
+ccccc PARAM SLOPE
+ccccc
+
+
+c          CO2 near infrared absorption
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           call zerophys(ngrid*nlayer,zdtnirco2)
+           if (callnirco2) then
+              call nirco2abs (ngrid,nlayer,pplay,dist_sol,
+     .                       mu0,fract,declin, zdtnirco2)
+           endif
+
+c          Net radiative surface flux (W.m-2)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~
+           DO ig=1,ngrid
+               fluxrad(ig)=emis(ig)*fluxsurf_lw(ig)
+     $         +fluxsurf_sw(ig,1)*(1.-albedo(ig,1))
+     $         +fluxsurf_sw(ig,2)*(1.-albedo(ig,2))
+               zplanck(ig)=tsurf(ig)*tsurf(ig)
+               zplanck(ig)=emis(ig)*
+     $         stephan*zplanck(ig)*zplanck(ig)
+               fluxrad(ig)=fluxrad(ig)-zplanck(ig)
+           ENDDO
+
+c          Net atmospheric radiative heating rate (K.s-1)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           IF(callnlte) THEN
+              CALL blendrad(ngrid, nlayer, pplay,
+     &             zdtsw, zdtlw, zdtnirco2, zdtnlte, dtrad)
+           ELSE
+              DO l=1,nlayer
+                 DO ig=1,ngrid
+                    dtrad(ig,l)=zdtsw(ig,l)+zdtlw(ig,l)
+     &                          +zdtnirco2(ig,l)
+                  ENDDO
+              ENDDO
+           ENDIF
+
+
+
+        ENDIF ! mod(icount-1,iradia).eq.0
+
+
+c    Transformation of the radiative tendencies:
+c    -----------------------------------------------
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+dtrad(ig,l)
+            ENDDO
+         ENDDO
+
+      ENDIF
+
+
+
+c-----------------------------------------------------------------------
+c    3. Gravity wave and subgrid scale topography drag :
+c    -------------------------------------------------
+
+
+      IF(calllott)THEN
+
+        CALL calldrag_noro(ngrid,nlayer,ptimestep,
+     &                 pplay,pplev,pt,pu,pv,zdtgw,zdugw,zdvgw)
+ 
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            pdv(ig,l)=pdv(ig,l)+zdvgw(ig,l)
+            pdu(ig,l)=pdu(ig,l)+zdugw(ig,l)
+            pdt(ig,l)=pdt(ig,l)+zdtgw(ig,l)
+          ENDDO
+        ENDDO
+      ENDIF
+
+c-----------------------------------------------------------------------
+c    4. Vertical diffusion (turbulent mixing):
+c    -----------------------------------------
+c
+      IF(calldifv) THEN
+
+
+         DO ig=1,ngrid
+            zflubid(ig)=fluxrad(ig)+fluxgrd(ig)
+         ENDDO
+
+         CALL zerophys(ngrid*nlayer,zdum1)
+         CALL zerophys(ngrid*nlayer,zdum2)
+         do l=1,nlayer
+            do ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            enddo
+         enddo
+
+
+c        Calling vdif (Martian version WITH CO2 condensation)
+         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
+     $        ptimestep,capcal,lwrite,
+     $        pplay,pplev,zzlay,zzlev,z0,
+     $        pu,pv,zh,pq,tsurf,emis,qsurf,
+     $        zdum1,zdum2,zdh,pdq,zflubid,
+     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
+     &        zdqdif,zdqsdif)
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+
+               pdv(ig,l)=pdv(ig,l)+zdvdif(ig,l)
+               pdu(ig,l)=pdu(ig,l)+zdudif(ig,l)
+               pdt(ig,l)=pdt(ig,l)+zdhdif(ig,l)*zpopsk(ig,l)
+
+               zdtdif(ig,l)=zdhdif(ig,l)*zpopsk(ig,l) ! for diagnostic only
+
+            ENDDO
+         ENDDO
+
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+zdtsdif(ig)
+         ENDDO
+
+         if(tracer) then 
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdif(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+           DO iq=1, nq
+              DO ig=1,ngrid
+                 dqsurf(ig,iq)=dqsurf(ig,iq) + zdqsdif(ig,iq)
+              ENDDO
+           ENDDO
+         end if
+
+      ELSE    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     s      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+         ENDDO
+      ENDIF
+
+
+c-----------------------------------------------------------------------
+c   5. Dry convective adjustment:
+c   -----------------------------
+
+      IF(calladj) THEN
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            ENDDO
+         ENDDO
+         CALL zerophys(ngrid*nlayer,zduadj)
+         CALL zerophys(ngrid*nlayer,zdvadj)
+         CALL zerophys(ngrid*nlayer,zdhadj)
+
+         CALL convadj(ngrid,nlayer,nq,ptimestep,
+     $                pplay,pplev,zpopsk,
+     $                pu,pv,zh,pq,
+     $                pdu,pdv,zdh,pdq,
+     $                zduadj,zdvadj,zdhadj,
+     $                zdqadj)
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdu(ig,l)=pdu(ig,l)+zduadj(ig,l)
+               pdv(ig,l)=pdv(ig,l)+zdvadj(ig,l)
+               pdt(ig,l)=pdt(ig,l)+zdhadj(ig,l)*zpopsk(ig,l)
+
+               zdtadj(ig,l)=zdhadj(ig,l)*zpopsk(ig,l) ! for diagnostic only
+            ENDDO
+         ENDDO
+
+         if(tracer) then 
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqadj(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         end if
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   6. Carbon dioxide condensation-sublimation:
+c   -------------------------------------------
+
+      IF(callcond) THEN
+         CALL newcondens(ngrid,nlayer,nq,ptimestep,
+     $              capcal,pplay,pplev,tsurf,pt,
+     $              pphi,pdt,pdu,pdv,zdtsurf,pu,pv,pq,pdq,
+     $              co2ice,albedo,emis,
+     $              zdtc,zdtsurfc,pdpsrf,zduc,zdvc,zdqc,
+     $	            fluxsurf_sw) 
+
+         DO l=1,nlayer
+           DO ig=1,ngrid
+             pdt(ig,l)=pdt(ig,l)+zdtc(ig,l)
+             pdv(ig,l)=pdv(ig,l)+zdvc(ig,l)
+             pdu(ig,l)=pdu(ig,l)+zduc(ig,l)
+           ENDDO
+         ENDDO
+         DO ig=1,ngrid
+            zdtsurf(ig) = zdtsurf(ig) + zdtsurfc(ig)
+            ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+         ENDDO
+
+         IF(tracer) THEN
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqc(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         END IF !(tracer)
+
+      ENDIF  !(callcond) 
+
+c        print*,'condens ok'
+c-----------------------------------------------------------------------
+c   7. Specific parameterizations for tracers 
+c:   -----------------------------------------
+
+      if(tracer) then 
+
+c   7a. Water and ice
+c     ---------------
+
+c        ---------------------------------------
+c        Water ice condensation in the atmosphere
+c        ----------------------------------------
+         IF (water) THEN
+
+
+c--------------------sursis with g95
+           call watercloud(ngrid,nlayer, ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,qsurf,zdqscloud,zdtcloud,
+     &                nq,naerkind,tau,icount,zls)
+c--------------------problem with g95
+
+           if (activice) then
+c Temperature variation due to latent heat release
+           DO l=1,nlayer
+             DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+             ENDDO
+           ENDDO
+           endif
+
+           IF (iceparty) then
+             iqmin=nq-1
+           ELSE
+             iqmin=nq
+           ENDIF
+
+           DO iq=iqmin,nq
+             DO l=1,nlayer
+                DO ig=1,ngrid
+                   pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqcloud(ig,l,iq)
+                ENDDO
+             ENDDO
+             DO ig=1,ngrid
+                dqsurf(ig,iq)= dqsurf(ig,iq) + zdqscloud(ig,iq)
+             ENDDO
+           ENDDO
+
+         END IF  ! (water)
+
+c   7b. Chemical species
+c     ------------------
+
+c        --------------
+c        photochemistry :
+c        --------------
+         IF(photochem .or. thermochem) then
+          call calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+     .      zzlay,zday,pq,pdq,zdqchim,zdqschim,zdqcloud,zdqscloud)
+           
+c Photochemistry includes condensation of H2O2
+
+           do iq=nqchem_min,nq
+            if (noms(iq).eq."h2o2") then
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqchim(ig,l,iq)
+                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqcloud(ig,l,iq)
+               ENDDO
+             ENDDO
+            else
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqchim(ig,l,iq)
+               ENDDO
+             ENDDO
+            endif
+           ENDDO
+           do iq=nqchem_min,nq
+            if (noms(iq).eq."h2o2") then
+               DO ig=1,ngrid
+                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqschim(ig,iq)
+                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqscloud(ig,iq)
+               ENDDO
+            else
+               DO ig=1,ngrid
+                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqschim(ig,iq)
+               ENDDO
+            endif
+           ENDDO
+
+         END IF  ! (photochem.or.thermochem)
+c        print*,'photochem ok'
+
+c   7c. Aerosol particles
+c     -------------------
+
+c        ----------
+c        Dust devil :
+c        ----------
+         IF(callddevil) then 
+           call dustdevil(ngrid,nlayer,nq, pplev,pu,pv,pt, tsurf,q2,
+     &                zdqdev,zdqsdev)
+ 
+           if (dustbin.ge.1) then
+              do iq=1,nq
+                 DO l=1,nlayer
+                    DO ig=1,ngrid
+                       pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdev(ig,l,iq)
+                    ENDDO
+                 ENDDO
+              enddo
+              do iq=1,nq
+                 DO ig=1,ngrid
+                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqsdev(ig,iq)
+                 ENDDO
+              enddo
+           endif  ! (test sur dustbin)
+
+         END IF
+
+c        ------------- 
+c        Sedimentation :   acts also on water ice
+c        ------------- 
+         IF (sedimentation) THEN 
+           call zerophys(ngrid*nlayer*nq, zdqsed)
+           call zerophys(ngrid*nq, zdqssed)
+
+           if(doubleq) then
+            call callsedim2q(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           else
+            call callsedim(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           end if
+
+
+           DO iq=1, nq
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqsed(ig,l,iq)
+               ENDDO
+             ENDDO
+           ENDDO
+           DO iq=1, nq
+             DO ig=1,ngrid
+                dqsurf(ig,iq)= dqsurf(ig,iq) + zdqssed(ig,iq)
+             ENDDO
+           ENDDO
+         END IF   ! (sedimentation)
+
+c        print*,'sedim ok'
+
+c   7d. Updates
+c     ---------
+
+        DO iq=1, nq
+          DO ig=1,ngrid
+
+c       ---------------------------------
+c       Updating tracer budget on surface
+c       ---------------------------------
+            qsurf(ig,iq)=qsurf(ig,iq)+ptimestep*dqsurf(ig,iq)
+
+          ENDDO  ! (ig)
+        ENDDO    ! (iq)
+
+      END IF    ! (tracer) 
+
+c        print*,'tracers ok'
+
+
+c-----------------------------------------------------------------------
+c   8.5 THERMOSPHERE CALCULATION
+c-----------------------------------------------------------------------
+
+      if (callthermos) then
+        call thermosphere(pplev,pplay,dist_sol,
+     $     mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay,
+     &     pt,pq,pu,pv,pdt,pdq,
+     $     zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff)
+c           do iq=nqchem_min,nq
+c           write(*,*) 'thermo iq,pq',iq,pq(690,1,iq)
+c           enddo
+
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            dtrad(ig,l)=dtrad(ig,l)+zdteuv(ig,l)
+            pdt(ig,l)=pdt(ig,l)+zdtconduc(ig,l)
+     &                         +zdteuv(ig,l)
+            pdv(ig,l)=pdv(ig,l)+zdvmolvis(ig,l)
+            pdu(ig,l)=pdu(ig,l)+zdumolvis(ig,l)
+            DO iq=1, nq
+              pdq(ig,l,iq)=pdq(ig,l,iq)+zdqmoldiff(ig,l,iq)
+            ENDDO
+          ENDDO
+        ENDDO
+
+
+      endif
+c-----------------------------------------------------------------------
+c   8. Surface  and sub-surface soil temperature
+c-----------------------------------------------------------------------
+c
+c
+c   Surface temperature incrementation :
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      DO ig=1,ngrid
+         tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig) 
+      ENDDO
+
+
+c  Prescription piege froid au pole sud (Except at high obliquity !!)
+c  temperature en surface = temperature equilibre de phases du CO2
+       
+      IF (tracer.AND.water.AND.ngridmx.NE.1) THEN
+         if (caps.and.(obliquit.lt.27.)) then
+           tsurf(ngrid)=1/(1/136.27-r/5.9e+5*alog(0.0095*ps(ngrid)))
+         endif
+c       -------------------------------------------------------------
+c       Change of surface albedo (set to 0.4) in case of ground frost
+c       everywhere except on the north permanent cap and in regions
+c       covered by dry ice. 
+c              ALWAYS PLACE these lines after newcondens !!!
+c       -------------------------------------------------------------
+         do ig=1,ngrid
+
+c       -------------- Version originale Franck ------------
+          if (co2ice(ig).eq.0.and.qsurf(ig,nqmx).gt.0.005) then
+            if (.not.watercaptag(ig)) then
+              albedo(ig,1)=0.4
+              albedo(ig,2)=0.4
+            endif
+          endif
+c       -------------- version Francois ---------------
+c          if (co2ice(ig).eq.0.and.
+c    &        ((qsurf(ig,nqmx).gt.0.005).or.(watercaptag(ig)))) then
+c              albedo(ig,1)=max(0.4,albedodat(ig))
+c              albedo(ig,2)=albedo(ig,1)
+c          endif
+c       ---------------------------------------------
+         enddo  ! (ig)
+      ENDIF  ! (tracer, water and 3D)
+
+c        print*,'tracer, water and 3D ok'
+
+c
+c   soil temperatures and subsurface heat flux:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (callsoil) THEN
+         CALL soil(ngrid,nsoilmx,.false.,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+      ENDIF
+
+c        print*,'soil ok'
+
+
+
+
+
+c-----------------------------------------------------------------------
+c  9. Writing output files
+c  ------------------------
+
+c    -------------------------------
+c    Dynamical fields incrementation
+c    -------------------------------
+c (FOR OUTPUT ONLY : the actual model integration is performed in the dynamics)
+
+      DO l=1,nlayer
+        DO ig=1,ngrid
+          zt(ig,l)=pt(ig,l)  + pdt(ig,l)*ptimestep
+          zu(ig,l)=pu(ig,l)  + pdu(ig,l)*ptimestep
+          zv(ig,l)=pv(ig,l)  + pdv(ig,l)*ptimestep
+        ENDDO
+      ENDDO
+      DO iq=1, nq
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            zq(ig,l,iq)=pq(ig,l,iq) +pdq(ig,l,iq)*ptimestep
+          ENDDO
+        ENDDO
+      ENDDO
+      DO ig=1,ngrid
+          ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep !already in 7
+      ENDDO
+      DO l=1,nlayer
+        DO ig=1,ngrid
+             zplev(ig,l)=pplev(ig,l)/pplev(ig,1)*ps(ig)
+             zplay(ig,l)=pplay(ig,l)/pplev(ig,1)*ps(ig)
+        ENDDO
+      ENDDO
+      ! Density calculation
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            rho(ig,l) = zplay(ig,l)/(rnew(ig,l)*zt(ig,l))
+         ENDDO
+      ENDDO
+
+c     Sum of fluxes in solar spectral bands (for output only)
+      DO ig=1,ngrid
+	     fluxtop_sw_tot(ig)=fluxtop_sw(ig,1) + fluxtop_sw(ig,2)
+	     fluxsurf_sw_tot(ig)=fluxsurf_sw(ig,1) + fluxsurf_sw(ig,2)
+      ENDDO
+c ******* TEMPORAIRE ************************************************
+      ztim1 = 999
+      DO l=1,nlayer
+        DO ig=1,ngrid
+           if (pt(ig,l).lt.ztim1) then
+               ztim1 = pt(ig,l)
+               igmin = ig
+               lmin = l 
+           end if
+        ENDDO
+      ENDDO
+      if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then	
+        write(*,*) 'stability WARNING :' 
+        write(*,*) 'pt, zt Tmin = ', pt(igmin,lmin), zt(igmin,lmin),
+     &              'ig l =', igmin, lmin
+      end if
+c *******************************************************************
+
+c     --------------------
+c     Output on the screen 
+c     --------------------
+
+
+      IF (lwrite) THEN
+         PRINT*,'Global diagnostics for the physics'
+         PRINT*,'Variables and their increments x and dx/dt * dt'
+         WRITE(*,'(a6,a10,2a15)') 'Ts','dTs','ps','dps'
+         WRITE(*,'(2f10.5,2f15.5)')
+     s   tsurf(igout),zdtsurf(igout)*ptimestep,
+     s   pplev(igout,1),pdpsrf(igout)*ptimestep
+         WRITE(*,'(a4,a6,5a10)') 'l','u','du','v','dv','T','dT'
+         WRITE(*,'(i4,6f10.5)') (l,
+     s   pu(igout,l),pdu(igout,l)*ptimestep,
+     s   pv(igout,l),pdv(igout,l)*ptimestep,
+     s   pt(igout,l),pdt(igout,l)*ptimestep,
+     s   l=1,nlayer)
+      ENDIF
+
+cc****WRF
+cc      IF (ngrid.NE.1) THEN
+c	PRINT*,'check - values after update at ngrid/2+1'
+c         WRITE(*,'(a4,a6,2a10)') 'l','u','v','T'
+c         WRITE(*,'(i4,3f10.5)') (l,
+c     s   zu(igout,l),
+c     s   zv(igout,l),
+c     s   zt(igout,l),
+c     s   l=1,nlayer)
+c
+cc****WRF
+
+
+         print*,'Ls =',zls*180./pi,
+     &   ' tauref(700 Pa,lat=0) =',tauref(ngrid/2)
+c     &   ' tau(Viking1) =',tau(ig_vl1,1)
+
+
+
+ccc
+ccc
+ccc**************** WRF OUTPUT *********************
+ccc
+ccc
+	
+	do ig=1,ngrid       
+
+           ! output surface temperature 
+           ! ... it was updated above, and not below
+           ! ... we directly output tsurf to WRF (and not tsurf+zdtsurf*ptimestep !)
+           wtsurf(ig) = tsurf(ig)           
+
+	   ! output co2ice
+           wco2ice(ig) = co2ice(ig)         
+!
+! TAB2D
+!           
+           ! output dust opacity      
+           output_tab2d(ig,1) = tauref(ig)   !! tau(ig,1)  !! when dust is transp.
+	   ! output visible ground flux
+	   output_tab2d(ig,2) = fluxsurf_sw_tot(ig)
+	   ! output IR ground flux
+	   output_tab2d(ig,3) = fluxsurf_lw(ig)
+	   ! output visible top flux
+	   output_tab2d(ig,4) = fluxtop_sw_tot(ig)
+	   ! output IR top flux
+	   output_tab2d(ig,5) = fluxtop_lw(ig)
+!	   ! output total mass of water vapor (kg/m2)
+!	   output_tab2d(ig,6) = mtot(ig)
+!	   ! output total mass of water ice (kg/m2)
+!	   output_tab2d(ig,7) = icetot(ig)
+!	   ! output mean ice radius (meter)
+!	   output_tab2d(ig,8) = rave(ig)
+ 	   !
+	   output_tab2d(ig,9) = 0.
+	   output_tab2d(ig,10) = 0.	 
+!
+! TAB3D
+!
+!          if (tracer) then
+            if (iceparty) then         
+              ! output ice radius  
+              DO l=1,nlayer 
+                output_tab3d(ig,l,1) = rice(ig,l)  
+              ENDDO
+            else
+             DO l=1,nlayer 
+                output_tab3d(ig,l,1) = 0.  
+              ENDDO           
+            endif
+!           endif
+
+        enddo
+
+ccc
+ccc
+ccc**************** WRF OUTPUT *********************
+ccc
+ccc
+
+
+
+
+c        -------------------------------------------------------------------
+c        Writing NetCDF file  "RESTARTFI" at the end of the run
+c        -------------------------------------------------------------------
+c        Remarque : On  stocke restarfi 
+c        juste avant que la dynamique ne le soit dans restart.
+c        entre maintenant et l'ecriture de restart,
+c        on aura itau = itau +1 et remise a jour de time.
+c        (lastcall = .true. lorsque itau+1 = itaufin)
+c        Donc on stocke  avec time = time + dtvr
+
+         IF(lastcall) THEN
+            ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec) 
+            write(*,*)'pour physdem ztime_fin =',ztime_fin
+            call physdem1("restartfi.nc",long,lati,nsoilmx,nq,
+     .              ptimestep,pday,
+     .              ztime_fin,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              area,albedodat,inertiedat,zmea,zstd,zsig,
+     .              zgam,zthe)
+         ENDIF
+
+
+
+c        -----------------------------------------------------------------
+c        Saving statistics :
+c        -----------------------------------------------------------------
+c        ("stats" stores and accumulates 8 key variables in file "stats.nc"
+c        which can later be used to make the statistic files of the run:
+c        "stats")          only possible in 3D runs !
+
+         
+         IF (callstats) THEN
+
+
+            call wstats(ngrid,"ps",
+     .          "Surface pressure","K",2,ps)
+            call wstats(ngrid,"tsurf",
+     .          "Surface temperature","K",2,tsurf)
+            call wstats(ngrid,"co2ice",
+     .          "CO2 ice cover",
+     .                  "kg.m-2",2,co2ice)
+c            call wstats(ngrid,
+c     .          "emis","Surface emissivity","w.m-1",2,
+c     .                  emis)
+             call wstats(ngrid,"fluxsurf_lw",
+     .                 "Thermal IR radiative flux to surface","W.m-2",2,
+     .                 fluxsurf_lw)
+             call wstats(ngrid,"fluxsurf_sw",
+     .                  "Solar radiative flux to surface","W.m-2",2,
+     .                   fluxsurf_sw_tot)
+             call wstats(ngrid,"fluxtop_lw",
+     .                  "Thermal IR radiative flux to space","W.m-2",2,
+     .                  fluxtop_lw)
+             call wstats(ngrid,"fluxtop_sw",
+     .                  "Solar radiative flux to space","W.m-2",2,
+     .                  fluxtop_sw_tot)
+            call wstats(ngrid,"dod",
+     .          "Dust optical depth"," ",2,tauref)
+
+            call wstats(ngrid,"temp",
+     .          "Atmospheric temperature","K",3,zt)
+            call wstats(ngrid,"u",
+     .          "Zonal (East-West) wind","m.s-1",3,zu)
+            call wstats(ngrid,"v",
+     .          "Meridional (North-South) wind",
+     .                  "m.s-1",3,zv)
+            call wstats(ngrid,"w",
+     .          "Vertical (down-up) wind",
+     .                  "m.s-1",3,pw)
+            call wstats(ngrid,"rho",
+     .          "Atmospheric density","none",3,rho)
+             call wstats(ngrid,"q2",
+     .          "Boundary layer eddy kinetic energy","m2.s-2",3,q2)
+
+           if (tracer) then
+            if (water) then
+               vmr=zq(1:ngridmx,1:nlayermx,nqmx)*mugaz/mmol(nqmx)
+               call wstats(ngrid,"vmr_h2ovapor",
+     .                    "H2O vapor volume mixing ratio","mol/mol",
+     .                    3,vmr)
+               if (iceparty) then
+                  vmr=zq(1:ngridmx,1:nlayermx,nqmx-1)*mugaz/mmol(nqmx-1)
+                  call wstats(ngrid,"vmr_h2oice",
+     .                       "H2O ice volume mixing ratio","mol/mol",
+     .                       3,vmr)
+               endif
+            endif
+
+             if (thermochem.or.photochem) then
+                do iq=1,nq
+                   if ((noms(iq).eq."o").or.(noms(iq).eq."co2").or.
+     .               (noms(iq).eq."co").or.(noms(iq).eq."n2").or.
+     .               (noms(iq).eq."h2").or.
+     .               (noms(iq).eq."o3")) then
+                        do l=1,nlayer
+                          do ig=1,ngrid
+                            vmr(ig,l)=zq(ig,l,iq)*mmean(ig,l)/mmol(iq)
+                          end do
+                        end do
+                        call wstats(ngrid,"vmr_"//trim(noms(iq)),
+     .                     "Volume mixing ratio","mol/mol",3,vmr)
+                   endif
+                enddo
+             endif
+           endif !tracer 
+
+            IF(lastcall) THEN
+              write (*,*) "Writing stats..."
+              call mkstats(ierr)
+            ENDIF
+          ENDIF !if callstats
+
+cc ****WRF: desactivated
+ccc        (Store EOF for Mars Climate database software)
+cc         IF (calleofdump) THEN
+cc            CALL eofdump(ngrid, nlayer, zu, zv, zt, rho, ps)
+cc         ENDIF
+cc ****WRF
+
+cc        ----------------------------------------------------------------------
+cc        output in netcdf file "DIAGFI", containing any variable for diagnostic
+cc        (output with  period "ecritphy", set in "run.def")
+cc        ----------------------------------------------------------------------
+cc        meso_WRITEDIAGFI can ALSO be called from any other subroutines
+cc        for any variables !!
+cc       call meso_WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2,
+cc    .                  emis)
+
+cc        call meso_WRITEDIAGFI(ngrid,"xlon","2D projected longitude","rad",2,
+cc     .                  long)
+cc        call meso_WRITEDIAGFI(ngrid,"xlat","2D projected latitude","rad",2,
+cc     .                  lati)
+cc        call meso_WRITEDIAGFI(ngrid,"zplay","Layer altitudes","m",3,
+cc     .                  zplay)
+cc        call meso_WRITEDIAGFI(ngrid,"zplev","Level altitudes","m",3,
+cc     .                  zplev)
+c      call meso_WRITEDIAGFI(ngrid,"tsurf",
+c     .  "Surface temperature","K",2,
+c     .                  tsurf)
+c      call meso_WRITEDIAGFI(ngrid,"ps",
+c     .  "surface pressure","Pa",2,ps)
+c      call meso_WRITEDIAGFI(ngrid,"co2ice","co2 ice thickness",
+c     .  "kg.m-2",2,
+c     .                  co2ice)
+cc       call meso_WRITEDIAGFI(ngrid,"rho","density","none",3,rho)
+c      call meso_WRITEDIAGFI(ngrid,"fluxsurf_lw",
+c     .  "fluxsurf_lw","W.m-2",2,
+c     .       fluxsurf_lw)
+c      call meso_WRITEDIAGFI(ngrid,"fluxsurf_sw",
+c     .  "fluxsurf_sw","W.m-2",2,
+c     .       fluxsurf_sw_tot)
+      call meso_WRITEDIAGFI(ngrid,"fluxtop_lw",
+     .  "fluxtop_lw","W.m-2",2,
+     .       fluxtop_lw)
+      call meso_WRITEDIAGFI(ngrid,"fluxtop_sw",
+     .  "fluxtop_sw","W.m-2",2,
+     .       fluxtop_sw_tot)
+c      call meso_WRITEDIAGFI(ngrid,"tauref",
+c     .  "tauref"," ",2,tauref)
+
+cc        call meso_WRITEDIAGFI(ngrid,"temp","temperature","K",3,zt)
+
+      call meso_WRITEDIAGFI(ngrid,"zu",
+     .  "Zonal wind","m.s-1",3,zu)
+      call meso_WRITEDIAGFI(ngrid,"zv",
+     .  "Meri. wind","m.s-1",3,zv)
+      call meso_WRITEDIAGFI(ngrid,"zt",
+     .  "Temperature","m.s-1",3,zt)
+
+c      call meso_WRITEDIAGFI(ngrid,"du","Td. Zonal wind","m.s-1",3,zu-pu)
+c      call meso_WRITEDIAGFI(ngrid,"dv","Td. Meri. wind","m.s-1",3,zv-pv)
+c      call meso_WRITEDIAGFI(ngrid,"dt","Td. Temperat.", "m.s-1",3,zt-pt)
+
+cc      TEMPORAIRE **************
+c         do l=1, nlayer
+c            write(*,*) 'lev', l, pplev(ngrid/2,l)
+c            write(*,*) 'lay', l, pplay(ngrid/2,l)
+c         end do
+c            write(*,*) 'lev', nlayer+1, pplev(ngrid/2,nlayer+1)
+c            stop
+
+
+
+cc        call meso_WRITEDIAGFI(ngrid,"u","Zonal wind","m.s-1",3,zu)
+cc        call meso_WRITEDIAGFI(ngrid,"v","Meridional wind","m.s-1",3,zv)
+cc       call meso_WRITEDIAGFI(ngrid,"w","Vertical wind","m.s-1",3,pw)
+cc       call meso_WRITEDIAGFI(ngrid,"q2","q2","kg.m-3",3,q2)
+cc       call meso_WRITEDIAGFI(ngridm,'Teta','T potentielle','K',3,zh)
+cc       call meso_WRITEDIAGFI(ngridm,'Pression','Pression','Pa',3,pplay)
+
+cc       OUTPUT of tracer mass mixing ratio and surface value :    
+cc       if (tracer) then
+cc         (for photochemistry, outputs are done in calchim)
+cc          do iq=1,nqmx
+cc            write(str2(1:2),'(i2.2)') iq
+cc            call meso_WRITEDIAGFI(ngridmx,'q'//str2,noms(iq),
+cc    &                         'kg/kg',3,zq(1,1,iq))
+cc            call meso_WRITEDIAGFI(ngridmx,'qsurf'//str2,noms(iq),
+cc    &                     'kg.m-2',2,qsurf(1,iq))
+cc          end do
+cc        end if
+cc ***************************************************
+c
+cc  Outputs for H2O
+c       if (tracer) then
+c        if (activice) then
+cc         call meso_WRITEDIAGFI(ngridmx,'tauice','tau','SI',2,tau(1,2))
+cc         call meso_WRITEDIAGFI(ngridmx,'sw_htrt','sw heat. rate',
+cc     &                   'w.m-2',3,zdtsw)
+cc         call meso_WRITEDIAGFI(ngridmx,'lw_htrt','lw heat. rate',
+cc     &                   'w.m-2',3,zdtlw)
+c        endif  !(activice)
+c
+c        if (water.and..not.photochem) then
+c           iq=nq
+cc          write(str2(1:2),'(i2.2)') iq
+cc          call meso_WRITEDIAGFI(ngridmx,'dqs'//str2,'dqscloud',
+cc     &                    'kg.m-2',2,zdqscloud(1,iq))
+cc          call meso_WRITEDIAGFI(ngridmx,'dqch'//str2,'var chim',
+cc     &                    'kg/kg',3,zdqchim(1,1,iq))
+cc          call meso_WRITEDIAGFI(ngridmx,'dqd'//str2,'var dif',
+cc     &                    'kg/kg',3,zdqdif(1,1,iq))
+cc          call meso_WRITEDIAGFI(ngridmx,'dqa'//str2,'var adj',
+cc     &                    'kg/kg',3,zdqadj(1,1,iq))
+cc          call meso_WRITEDIAGFI(ngridmx,'dqc'//str2,'var c',
+cc     &                    'kg/kg',3,zdqc(1,1,iq))
+c        endif  !(water.and..not.photochem)
+c
+cc       if (iceparty) then
+cc          iq=nq-1
+cc          write(str2(1:2),'(i2.2)') iq
+cc          call meso_WRITEDIAGFI(ngridmx,'q'//str2,'mix. ratio',
+cc    &                     'kg/kg',3,zq(1,1,iq))
+cc       endif  !(iceparty)
+c       endif
+c
+cc  Outputs for dust tracers
+c
+cc ****WRF: careful, have to correct floating exception
+c
+c         if (tracer.and.(dustbin.ne.0)) then
+c            call meso_WRITEDIAGFI(ngridmx,'tau','taudust','SI',2,tau(1,1))
+c            if (doubleq) then
+c               call meso_WRITEDIAGFI(ngridmx,'qsurf','qsurf',
+c     &                         'kg.m-2',2,qsurf(1,1))
+c               call meso_WRITEDIAGFI(ngridmx,'Nsurf','N particles',
+c     &                         'N.m-2',2,qsurf(1,2))
+c               call meso_WRITEDIAGFI(ngridmx,'dqsdev','ddevil lift',
+c     &                         'kg.m-2.s-1',2,zdqsdev(1,1))
+c               call meso_WRITEDIAGFI(ngridmx,'dqssed','sedimentation',
+c     &                         'kg.m-2.s-1',2,zdqssed(1,1))
+c               do  l=1,nlayer
+c                  do ig=1, ngrid
+c                     reff(ig,l)= ref_r0 *
+c     &               (r3n_q*pq(ig,l,1)/max(pq(ig,l,2),0.01))**(1./3.)
+c                     reff(ig,l)=min(max(reff(ig,l),1.e-10),500.e-6)
+c                  end do
+c               end do
+c               call meso_WRITEDIAGFI(ngridmx,'reff','reff','m',3,reff)
+c            else
+c               do iq=1,dustbin
+c                  write(str2(1:2),'(i2.2)') iq
+c                  call meso_WRITEDIAGFI(ngridmx,'q'//str2,'mix. ratio',
+c     &                            'kg/kg',3,zq(1,1,iq))
+c                  call meso_WRITEDIAGFI(ngridmx,'qsurf'//str2,'qsurf',
+c     &                            'kg.m-2',2,qsurf(1,iq))
+c               end do
+c            endif ! (doubleq)
+c         end if  ! (tracer.and.(dustbin.ne.0))
+c
+c
+c      ELSE     ! if(ngrid.eq.1)
+c
+c         print*,'Ls =',zls*180./pi,
+c     &  '  tauref(700 Pa) =',tauref,' local tau =',tau(1,1)
+cc      ----------------------------------------------------------------------
+cc      Output in grads file "g1d" (ONLY when using testphys1d)
+cc      (output at every X physical timestep)
+cc      ----------------------------------------------------------------------
+cc
+cc        CALL writeg1d(ngrid,1,fluxsurf_lw,'Fs_ir','W.m-2')
+cc        CALL writeg1d(ngrid,1,tsurf,'tsurf','K')
+c         CALL writeg1d(ngrid,1,ps,'ps','Pa')
+c         
+c         CALL writeg1d(ngrid,nlayer,zt,'T','K')
+cc        CALL writeg1d(ngrid,nlayer,pu,'u','m.s-1')
+cc        CALL writeg1d(ngrid,nlayer,pv,'v','m.s-1')
+cc        CALL writeg1d(ngrid,nlayer,pw,'w','m.s-1')
+c
+c         if(tracer) then
+cc           CALL writeg1d(ngrid,1,tau,'tau','SI')
+c            do iq=1,nq
+c              CALL writeg1d(ngrid,nlayer,zq(1,1,iq),noms(iq),'kg/kg') 
+c            end do
+c         end if
+c
+c         zlocal(1)=-log(pplay(1,1)/pplev(1,1))* Rnew(1,1)*zt(1,1)/g
+c
+c         do l=2,nlayer-1
+c            tmean=zt(1,l)
+c            if(zt(1,l).ne.zt(1,l-1))
+c     &        tmean=(zt(1,l)-zt(1,l-1))/log(zt(1,l)/zt(1,l-1))
+c              zlocal(l)= zlocal(l-1)
+c     &        -log(pplay(1,l)/pplay(1,l-1))*rnew(1,l)*tmean/g
+c         enddo
+c         zlocal(nlayer)= zlocal(nlayer-1)-
+c     &                   log(pplay(1,nlayer)/pplay(1,nlayer-1))*
+c     &                   rnew(1,nlayer)*tmean/g
+c
+cc         if(tracer) then
+cc         do l=2,nlayer
+cc            do iq=1,nq
+cc               hco2(iq)=zq(1,l,iq)/zq(1,l-1,iq)
+cc               hco2(iq)=-(zlocal(l)-zlocal(l-1))/log(hco2(iq))/1000.
+cc            enddo
+cc            write(225,*) l,pt(1,l),(hco2(iq),iq=1,6)
+cc            write(226,*) l,(hco2(iq),iq=7,13)
+cc         enddo
+cc         endif
+c
+c      END IF       ! if(ngrid.ne.1)
+
+
+
+      icount=icount+1
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_readtesassim.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_readtesassim.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_readtesassim.F90	(revision 2744)
@@ -0,0 +1,306 @@
+subroutine meso_readtesassim(ngrid,nlayer,zday,pplev,tauref,day_translate)
+
+! Reading of the dust assimilation file
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "comgeomfi.h"
+include "netcdf.inc"
+include "datafile.h"
+
+integer, intent(in) :: ngrid,nlayer
+real, intent(in) :: zday ! date in martian days
+real, dimension(ngrid,nlayer+1), intent(in) :: pplev
+real, dimension(ngrid), intent(out) :: tauref
+
+! Local variables
+
+real :: realday
+integer nid,nvarid,ierr
+integer ltloop,lsloop,iloop,jloop,varloop,ig
+real, dimension(2) :: taubuf
+real tau1(4),tau
+real alt(4)
+integer latp(4),lonp(4)
+integer yinf,ysup,xinf,xsup,tinf,tsup
+real latinf,latsup,loninf,lonsup
+real latintmp,lonintmp,latdeg,londeg
+real colat,dlat,dlon,colattmp
+logical, save :: firstcall=.true.
+logical :: timeflag
+real radeg,pi
+integer :: timedim,londim,latdim
+real, dimension(:), allocatable, save :: lat,lon,time
+real, dimension(:,:,:), allocatable, save :: tautes
+integer, save :: timelen,lonlen,latlen
+INTEGER, external:: lnblnk
+
+!!WRF added
+INTEGER :: day_translate 
+
+pi=acos(-1.)
+radeg=180/pi
+realday=mod(zday,669.)
+
+if (firstcall) then
+   firstcall=.false.
+
+   !! Note: datafile() is defined in "datafile.h"
+   !print *,datafile(1:lnblnk(datafile))
+   !ierr=NF_OPEN (datafile(1:lnblnk(datafile))//"/input_totoptdep.nc",NF_NOWRITE,nid)
+
+!!-------------------------------------
+!! iaervar is used here to communicate the day starting the diagfi
+!! -- in addition, inpu_totoptdep.nc must be prepared
+day_translate=day_translate-1000
+ierr=NF_OPEN ("./input_totoptdep.nc",NF_NOWRITE,nid)
+!!-------------------------------------
+
+
+   IF (ierr.NE.NF_NOERR) THEN
+     !write(*,*)'Problem opening dust.nc (in phymars/readtesassim.F90)'
+     !write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+     !write(*,*)'1) You can change this directory address in '
+     !write(*,*)'   file phymars/datafile.h'
+     !write(*,*)'2) If necessary, dust.nc (and other datafiles)'
+     !write(*,*)'   can be obtained online on:'
+     !write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+     write(*,*)'Problem opening input_totoptdep.nc ...'
+     CALL ABORT
+   ENDIF
+
+   ierr=NF_INQ_DIMID(nid,"time",timedim)
+   ierr=NF_INQ_DIMLEN(nid,timedim,timelen)
+   ierr=NF_INQ_DIMID(nid,"lat",latdim)
+   ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+   ierr=NF_INQ_DIMID(nid,"lon",londim)
+   ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
+
+   allocate(tautes(lonlen,latlen,timelen))
+   allocate(lat(latlen), lon(lonlen), time(timelen))
+
+   ierr = NF_INQ_VARID (nid, "totoptdep",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tautes)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, tautes)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <totoptdep> not found"
+      stop
+   ENDIF
+
+!!****WRF
+!! diagfi files feature the dust opacity divided by 700 Pa
+        tautes=tautes*700.
+!!****WRF
+
+
+   ierr = NF_INQ_VARID (nid, "time",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, time)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <Time> not found"
+      stop
+   ENDIF
+
+!!****WRF
+PRINT *, "**** read assimilation dust"
+PRINT *, "prescribed starting day ...", day_translate
+time=time+day_translate
+!!****WRF
+
+   ierr = NF_INQ_VARID (nid, "lat",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lat)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lat)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <latitude> not found"
+      stop
+   ENDIF
+
+   ierr = NF_INQ_VARID (nid, "lon",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lon)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lon)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <longitude> not found"
+      stop
+   ENDIF
+
+endif ! of if (firstcall)
+
+do ig=1,ngrid
+
+! Find the four nearest points, arranged as follows:
+!                               1 2
+!                               3 4
+
+   latdeg=lati(ig)*radeg  ! latitude, in degrees
+   londeg=long(ig)*radeg  ! longitude, in degrees east
+   colat=90-latdeg        ! colatitude, in degrees
+
+ ! Find encompassing latitudes
+   if (colat<(90-lat(1))) then ! between north pole and lat(1)
+      ysup=1
+      yinf=1
+   else if (colat>=90-(lat(latlen))) then ! between south pole and lat(laten)
+      ysup=latlen
+      yinf=latlen
+   else ! general case
+      do iloop=2,latlen
+         if(colat<(90-lat(iloop))) then
+           ysup=iloop-1
+           yinf=iloop
+           exit
+         endif
+      enddo
+   endif
+
+   latinf=lat(yinf)
+   latsup=lat(ysup)
+
+
+ ! Find encompassing longitudes
+   ! Note: in input file, lon(1)=-180.
+   if (londeg>lon(lonlen)) then
+      xsup=1
+      xinf=lonlen
+      loninf=lon(xsup)
+      lonsup=180.0 ! since lon(1)=-180.0
+   else
+      do iloop=2,lonlen
+         if(londeg<lon(iloop)) then
+              xsup=iloop
+              xinf=iloop-1
+              exit
+         endif
+      enddo
+      loninf=lon(xinf)
+      lonsup=lon(xsup)
+   endif
+
+   if ((xsup.gt.lonlen).OR.(yinf.gt.latlen).OR.(xinf.lt.1)&
+     .OR.(ysup.lt.1)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on x or y in ts_gcm"
+      write (*,*) "xinf: ",xinf
+      write (*,*) "xsup: ",xsup
+      write (*,*) "yinf: ",yinf
+      write (*,*) "ysup: ",ysup
+      stop
+   endif
+
+!   loninf=lon(xinf)
+!   lonsup=lon(xsup)
+!   latinf=lat(yinf)
+!   latsup=lat(ysup)
+
+! The four neighbouring points are arranged as follows:
+!                               1 2
+!                               3 4
+
+   latp(1)=ysup
+   latp(2)=ysup
+   latp(3)=yinf
+   latp(4)=yinf
+
+   lonp(1)=xinf
+   lonp(2)=xsup
+   lonp(3)=xinf
+   lonp(4)=xsup
+
+! Linear interpolation on time, for all four neighbouring points
+
+   if ((realday<time(1)).or.(realday>time(timelen))) then
+      tinf=timelen
+      tsup=1
+      timeflag=.true.
+   else 
+      do iloop=2,timelen
+         if (realday<time(iloop)) then
+            tinf=iloop-1
+            tsup=iloop
+            exit
+         endif
+      enddo
+   endif
+
+! Bilinear interpolation on the four nearest points
+
+   if ((colat<(90-lat(1))).OR.(colat>(90-lat(latlen))).OR.(latsup==latinf)) then
+      dlat=0
+   else
+      dlat=((90-latinf)-colat)/((90-latinf)-(90-latsup))
+   endif
+
+   if (lonsup==loninf) then
+      dlon=0
+   else
+      dlon=(londeg-loninf)/(lonsup-loninf)
+   endif
+
+   do iloop=1,4
+      taubuf(1)=tautes(lonp(iloop),latp(iloop),tinf)
+      taubuf(2)=tautes(lonp(iloop),latp(iloop),tsup)
+      if (timeflag) then
+         if (realday>time(timelen)) then
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)+(669-time(tinf))) 
+         else
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*realday/(time(tsup)+(669-time(tinf)))
+         endif
+      else
+         tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)-time(tinf))
+      endif
+      if (tau1(iloop)<0) then
+          write (*,*) "Readtesassim: SYSTEM ERROR on tau"
+          write (*,*) "utime ",realday
+          write (*,*) "time(tinf) ",time(tinf)
+          write (*,*) "time(tsup) ",time(tsup)
+          write (*,*) "tau1 ",taubuf(1)
+          write (*,*) "tau2 ",taubuf(2)
+          write (*,*) "tau ",tau1(iloop)
+          stop
+      endif
+   enddo
+   timeflag=.false.
+
+   if ((dlat>1).OR.(dlon>1) .OR. (dlat<0) .OR. (dlon<0)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on dlat or dlon in ts_gcm"
+      write (*,*) "dlat: ",dlat
+      write (*,*) "lat: ",latdeg
+      write (*,*) "dlon: ",dlon
+      write (*,*) "lon: ",londeg
+      stop
+   endif
+
+   tau= dlat*(dlon*(tau1(2)+tau1(3)-tau1(1)-tau1(4))+tau1(1)-tau1(3)) +dlon*(tau1(4)-tau1(3))+tau1(3)
+
+!!   tauref(ig)=tau*700/pplev(ig,1)*0.8
+    tauref(ig)=tau*0.825
+
+!-------------
+! from Oxford
+!-------------
+! + tuning ... TES is little bit too hot compared to radio-occultations 
+! 0.825 is the MY24 value
+!tauref(ig)=tau*700.*0.825
+!tauref(ig)=tau*700.
+!tauref(ig)=tau*700.*1.2
+!tauref(ig)=tau*700.*0.6
+!-------------------------------------------------
+! NB: multiply by 700. is now done elsewhere
+!-------------------------------------------------
+
+
+enddo
+
+end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_writediagfi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_writediagfi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_writediagfi.F	(revision 2744)
@@ -0,0 +1,467 @@
+      subroutine meso_writediagfi(ngrid,nom,titre,unite,dim,px)
+
+c=======================================================================
+c
+c	CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+c
+c	... CHECK THE ****WRF lines
+c
+c=======================================================================
+!  Ecriture de variables diagnostiques au choix dans la physique 
+!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
+!  3d (ex : temperature), 2d (ex : temperature de surface), ou
+!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
+!  solaire)
+!  Dans la version 2000, la periode d'ecriture est celle de 
+!  "ecritphy " regle dans le fichier de controle de run :  run.def
+!
+!    writediagfi peut etre appele de n'importe quelle subroutine
+!    de la physique, plusieurs fois. L'initialisation et la creation du
+!    fichier se fait au tout premier appel.
+!
+! WARNING : les variables dynamique (u,v,t,q,ps)
+!  sauvees par writediagfi avec une
+! date donnee sont legerement differentes que dans le fichier histoire car 
+! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
+! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
+! avant l'ecriture dans diagfi (cf. physiq.F)
+!  
+!
+!  parametres (input) :
+!  ----------
+!      ngrid : nombres de point ou est calcule la physique
+!                (ngrid = 2+(jjm-1)*iim - 1/jjm)
+!                 (= nlon ou klon dans la physique terrestre)
+!      
+!      unit : unite logique du fichier de sortie (toujours la meme)
+!      nom  : nom de la variable a sortir (chaine de caracteres)
+!      titre: titre de la variable (chaine de caracteres)
+!      unite : unite de la variable (chaine de caracteres)
+!      px : variable a sortir (real 0, 2, ou 3d)
+!      dim : dimension de px : 0, 2, ou 3 dimensions
+!
+!=================================================================
+ 
+      implicit none
+
+! Arguments variable
+
+! Local variables
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "control.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "description.h"
+#include "netcdf.inc"
+#include "temps.h"
+#include "surfdat.h"
+
+      integer ngrid
+	
+!****WRF
+        INTEGER idim_alt,idim_lon,idim_lat
+        REAL px(ngrid,nlayermx)
+        REAL dx3(wiim,wjjm,nlayermx),dx2(wiim,wjjm)
+!****WRF
+!!      REAL px(ngrid,llm)
+!!      REAL dx3(iip1,jjp1,llm),dx2(iip1,jjp1)
+
+      REAL dx0
+
+      real date
+      character (len=*) :: nom,titre,unite
+
+      REAL phis(ip1jmp1)
+
+      integer dim
+      integer irythme
+      integer ierr
+      integer iq
+      integer i,j,l,zmax , ig0
+
+      integer zitau
+      character firstnom*10
+      SAVE firstnom
+      SAVE zitau
+      SAVE date
+      data firstnom /'1234567890'/
+      data zitau /0/
+
+! Ajouts
+      integer, save :: ntime=0
+      integer :: idim,varid
+      integer :: nid
+      character (len =50):: fichnom
+      integer, dimension(4) :: id
+      integer, dimension(4) :: edges,corner
+      
+
+!***************************************************************
+!Sortie des variables au rythme voulu
+
+      irythme = int(ecritphy) ! sortie au rythme de ecritphy
+        !print*,irythme 
+!     irythme = iconser  ! sortie au rythme des variables de controle
+!     irythme = iphysiq  ! sortie a tous les pas physique
+!     irythme = iecri*day_step ! sortie au rythme des fichiers histoires
+!     irythme = periodav*day_step ! sortie au rythme des fichiers histmoy
+
+!***************************************************************
+ 
+c     nom=trim((nom))
+c     unite=trim((unite))
+c     titre=trim((titre))
+
+c
+c lat / lon / alt dimensions from WRF (in dimphys.h)
+c
+        idim_lat=wjjm
+c        write (*,*) "lat",idim_lat
+        idim_lon=wiim
+c        write (*,*) "lon",idim_lon
+        idim_alt=nlayermx
+c        write (*,*) "alt",idim_alt     
+
+
+
+! initialisation de 'firstnom' / ouverture du fichier NetCDF
+! ----------------------------------------------------------
+! (Au tout premier appel de la subroutine durant le run.)
+
+      if(ngrid.eq.1) return ! don't use writediagfi with 1D version
+
+      fichnom="diagfi.nc"
+      if (firstnom.eq.'1234567890') then
+         firstnom = nom
+
+!****WRF
+!         call gr_fi_dyn(1,ngrid,iip1,jjp1,phisfi,phis)
+!****WRF
+
+! assign Logical Unit: ouverture du fichier NetCDF
+         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+! Creation de la dimension (temps)
+         ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
+        ierr = NF_DEF_DIM (nid, "latitude", wjjm, idim_lat)
+        ierr = NF_DEF_DIM (nid, "longitude", wiim, idim_lon)
+        ierr = NF_DEF_DIM (nid, "altitude", nlayermx,idim_alt)
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
+#else
+         ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
+#endif
+         ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
+     .          4,"Time")
+         ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
+     .          "days since 0000-00-0 00:00:00")
+         ierr = NF_ENDDEF(nid)
+! ecriture de l'entete du fichier (longitudes, latitudes ... relief)
+
+!!****caca caca
+!                phis(:)=0.   
+!         call iniwrite(nid,day_ini , phis)
+!!
+!        ierr = NF_DEF_DIM (nid, "latitude", wjjm, idim_lat)
+!        ierr = NF_DEF_DIM (nid, "longitude", wiim, idim_lon)
+!        ierr = NF_DEF_DIM (nid, "altitude", nlayermx, idim_alt)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid, "latitude", NF_DOUBLE, 1, idim_lat,varid)
+#else
+      ierr =NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim_lat,varid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,varid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,varid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+!#ifdef NC_DOUBLE
+!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+!#else
+!      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+!#endif
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_lon,varid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1,idim_lon,varid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,varid,"long_name",14,
+     .      "East longitude")
+      ierr =NF_PUT_ATT_TEXT(nid,varid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+!#ifdef NC_DOUBLE
+!      ierr = NF_PUT_VAR_DOUBLE(nid,nvarid,rlonv/pi*180)
+!#else
+!      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+!#endif
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
+     .       idim_alt,varid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
+     .       idim_alt,varid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,varid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,varid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,varid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+!#ifdef NC_DOUBLE
+!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+!#else
+!      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+!#endif
+
+
+
+         zitau = -1
+      else
+         ierr = NF_OPEN(fichnom,NF_WRITE,nid)
+      endif
+
+!incrementation de temps a chaque premier appel de WRITEDIAGFI ds la physique
+!------------------------------------------------------------------------
+      if (nom.eq.firstnom) then
+          !! -- elapsed seconds --   
+          zitau = zitau + iphysiq
+          !! iphysiq is ptimestep          
+      end if
+
+!--------------------------------------------------------
+!Sortie des variables au rythme voulu
+!--------------------------------------------------------
+
+      if ( MOD(zitau+1,irythme) .eq.0.) then
+
+!Calcul/ecriture/extension de la coordonnee temps (date en jours)
+!--------------------------------------------------------
+!(effectuee a chaque premier appel de writediagfi ds la physique)
+!On date les sorties comme histoire, c.a.d un pas de temps plus loin !
+
+!Detection du changement de temps
+        if (nom.eq.firstnom) then
+           ntime=ntime+1
+!           date= float (zitau +1)/float (day_step)
+           date=float(zitau+1)/3700.
+!
+           ierr= NF_INQ_VARID(nid,"Time",varid)
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
+              write(*,*) "***** with time"
+              write(*,*) 'ierr=', ierr   
+c             call abort
+           endif
+
+           write(6,*)'WRITEDIAGFI: date= ', date
+        end if
+
+!Cas Variable 3D
+!---------------
+        if (dim.eq.3) then
+
+!         Passage variable physique -->  variable dynamique
+
+!****WRF
+
+           DO l=1,nlayermx
+             DO j=1,wjjm
+                ig0=(j-1)*wiim 
+                DO i=1,wiim
+                   dx3(i,j,l)=px(ig0+i,l)
+                ENDDO
+             ENDDO
+           ENDDO
+
+
+!!           DO l=1,llm
+!!             DO i=1,iip1
+!!                dx3(i,1,l)=px(1,l)
+!!                dx3(i,jjp1,l)=px(ngrid,l)
+!!             ENDDO
+!!             DO j=2,jjm
+!!                ig0= 1+(j-2)*iim
+!!                DO i=1,iim
+!!                   dx3(i,j,l)=px(ig0+i,l)
+!!                ENDDO
+!!                dx3(iip1,j,l)=dx3(1,j,l)
+!!             ENDDO
+!!           ENDDO
+
+!****WRF
+
+!         Ecriture du champs
+
+!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
+!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
+! nom de la variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "DIAGFI: creation de ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif 
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+!****WRF
+!!           edges(1)=iip1
+!!           edges(2)=jjp1
+           edges(1)=wiim
+           edges(2)=wjjm
+           edges(3)=nlayermx
+!****WRF
+
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+!Cas Variable 2D
+!---------------
+
+        else if (dim.eq.2) then
+
+!         Passage variable physique -->  physique dynamique
+
+!****WRF
+
+!           DO l=1,nlayermx
+             DO j=1,wjjm
+                ig0=(j-1)*wiim 
+                DO i=1,wiim
+                   dx2(i,j)=px(ig0+i,1)
+                ENDDO
+             ENDDO
+!           ENDDO
+
+!!             DO i=1,iip1
+!!                dx2(i,1)=px(1,1)
+!!                dx2(i,jjp1)=px(ngrid,1)
+!!             ENDDO
+!!             DO j=2,jjm
+!!                ig0= 1+(j-2)*iim
+!!                DO i=1,iim
+!!                   dx2(i,j)=px(ig0+i,1)
+!!                ENDDO
+!!                dx2(iip1,j)=dx2(1,j)
+!!             ENDDO
+
+!****WRF
+
+!         Ecriture du champs
+
+!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
+!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"Time",id(3))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "DIAGFI: creation de ",nom
+
+              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=ntime
+!****WRF
+!!           edges(1)=iip1
+!!           edges(2)=jjp1
+           edges(1)=wiim
+           edges(2)=wjjm
+!****WRF
+           edges(3)=1
+
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2) 
+#else         
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
+#endif     
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+!Cas Variable 0D (scalaire dependant du temps)
+!---------------------------------------------
+
+        else if (dim.eq.0) then
+           dx0 = px (1,1)
+
+!         Ecriture du champs
+
+!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"Time",id(1))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "DIAGFI: creation de ",nom
+
+              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
+
+           endif
+
+           corner(1)=ntime
+           edges(1)=1
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0)  
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx0)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+        endif
+
+      endif
+
+      ierr= NF_CLOSE(nid)
+
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/mkstat.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/mkstat.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/mkstat.F90	(revision 2744)
@@ -0,0 +1,164 @@
+subroutine mkstats(ierr)
+
+ 
+!
+!  This program writes a stats.nc file from sums and sums of squares
+!  to means and standard deviations and also writes netcdf style
+!  file so that the data can be viewed easily.  The data file is
+!  overwritten in place.  
+!  SRL  21 May 1996
+!  Yann W. july 2003
+
+
+implicit none
+
+include "dimensions.h"
+include "statto.h"
+include "netcdf.inc"
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+integer :: ierr,nid,nbvar,i,ndims,lt,nvarid
+integer, dimension(4) :: id,varid,start,size
+integer, dimension(5) :: dimids
+character (len=50) :: name,nameout,units,title
+real, dimension(iip1,jjp1,llm) :: sum3d,square3d,mean3d,sd3d
+real, dimension(iip1,jjp1) :: sum2d,square2d,mean2d,sd2d
+real, dimension(istime) :: time
+real, dimension(jjp1) :: lat
+real, dimension(iip1) :: lon
+real, dimension(llm) :: alt
+logical :: lcopy=.true.
+integer :: latid,lonid,altid,timeid
+integer :: meanid,sdid
+integer, dimension(4) :: dimout
+
+! Incrementation of count for the last step, which is not done in wstats
+count(istime)=count(istime)+1
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+! We catch the id of dimensions of the stats file
+
+ierr= NF_INQ_DIMID(nid,"latitude",id(1))
+ierr= NF_INQ_DIMID(nid,"longitude",id(2))
+ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+ierr= NF_INQ_VARID(nid,"latitude",varid(1))
+ierr= NF_INQ_VARID(nid,"longitude",varid(2))
+ierr= NF_INQ_VARID(nid,"altitude",varid(3))
+ierr= NF_INQ_VARID(nid,"Time",varid(4))
+
+! Time initialisation
+
+do i=1,istime
+   time(i)=i*24./istime
+#ifdef NC_DOUBLE
+   ierr= NF_PUT_VARA_DOUBLE(nid,varid(4),i,1,time(i))
+#else
+   ierr= NF_PUT_VARA_REAL(nid,varid(4),i,1,time(i))
+#endif
+enddo
+
+! We catche the values of the variables
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(1),lat)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(2),lon)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,varid(1),lat)
+         ierr = NF_GET_VAR_REAL(nid,varid(2),lon)
+         ierr = NF_GET_VAR_REAL(nid,varid(3),alt)
+#endif
+
+! We catch the number of variables in the stats file
+ierr = NF_INQ_NVARS(nid,nbvar)
+
+! to catche the "real" number of variables (without the "additionnal variables")
+nbvar=(nbvar-4)/2 
+
+do i=1,nbvar
+   varid=(i-1)*2+5
+
+   ! What's the variable's name?
+   ierr=NF_INQ_VARNAME(nid,varid,name)
+   write(*,*) "OK variable ",name
+   ! Its units?
+   units=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"units",units)
+   ! Its title?
+   title=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"title",title)
+   ! Its number of dimensions?   
+   ierr=NF_INQ_VARNDIMS(nid,varid,ndims)
+   ! Its values?
+
+   if(ndims==4) then ! lat, lon, alt & time
+
+      dimout(1)=lonid
+      dimout(2)=latid
+      dimout(3)=altid
+      dimout(4)=timeid
+
+      size=(/iip1,jjp1,llm,1/)
+      do lt=1,istime
+         start=(/1,1,1,lt/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square3d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square3d)
+#endif
+         ! Calculation of these variables
+         mean3d=sum3d/count(lt)
+         sd3d=sqrt(max(0.,square3d/count(lt)-mean3d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd3d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd3d)
+#endif
+      enddo
+
+    else if (ndims.eq.3) then
+
+      dimout(1)=lonid
+      dimout(2)=latid
+      dimout(3)=timeid
+
+      size=(/iip1,jjp1,1,0/)
+      do lt=1,istime
+         start=(/1,1,lt,0/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square2d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square2d)
+#endif
+         ! Calculation of these variables
+         mean2d=sum2d/count(lt)
+         sd2d=sqrt(max(0.,square2d/count(lt)-mean2d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd2d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd2d)
+#endif
+      enddo
+
+    endif 
+enddo
+
+ierr= NF_CLOSE(nid)
+
+end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/mucorr.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/mucorr.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/mucorr.F	(revision 2744)
@@ -0,0 +1,102 @@
+      SUBROUTINE mucorr(npts,pdeclin, plat, pmu, pfract,phaut,prad)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day whithout 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         npts             number of points
+c         pdeclin          solar declinaison
+c         plat(npts)        latitude
+c         phaut            hauteur typique de l'atmosphere
+c         prad             rayon planetaire
+c
+c      Output :
+c      --------
+c         pmu(npts)          equivalent cosinus of the solar angle
+c         pfract(npts)       fractionnal day
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+
+c     Arguments :
+c     -----------
+      INTEGER npts
+      REAL plat(npts),pmu(npts), pfract(npts)
+      REAL phaut,prad,pdeclin
+c
+c     Local variables :
+c     -----------------
+      INTEGER j
+      REAL pi
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b, tp
+      REAL alph
+
+c-----------------------------------------------------------------------
+
+      pi = 4. * atan(1.0)
+      z = pdeclin
+      cz = cos (z)
+      sz = sin (z)
+
+      DO 20 j = 1, npts
+
+         phi = plat(j)
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+   
+         IF(t.eq.0.) then
+            tp=0.5*pi
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) then
+               tp = -atan (-t) + pi
+            ELSE
+               tp = atan(t)
+            ENDIF
+         ENDIF
+         t = tp
+   
+         pmu(j) = (sphi*sz*t) / pi + b*sin(t)/pi
+         pfract(j) = t / pi
+         IF (ap .lt.0.) then
+            pmu(j) = sphi * sz
+            pfract(j) = 1.0
+         ENDIF
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+
+   20 CONTINUE
+
+c-----------------------------------------------------------------------
+c   correction de rotondite:
+c   ------------------------
+
+      alph=phaut/prad
+      DO 30 j=1,npts
+c !!!!!!
+         pmu(j)=sqrt(1224.*pmu(j)*pmu(j)+1.)/35.
+c    $          (sqrt(alph*alph*pmu(j)*pmu(j)+2.*alph+1.)-alph*pmu(j))
+30    CONTINUE
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/mufract.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/mufract.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/mufract.F	(revision 2744)
@@ -0,0 +1,92 @@
+      SUBROUTINE mufract(jjm,pdecli, plat, pmu, pfract)
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day whithout 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         jjm              number of points
+c         pdecli           solar declinaison
+c         plat(jjm)        latitude
+c
+c      Output :
+c      --------
+c         pmu(jjm)          equivalent cosinus of the solar angle
+c         pfract(jjm)       fractionnal day
+c
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+c
+c     Arguments :
+c     -----------
+
+      INTEGER jjm
+      REAL plat(jjm),pmu(jjm), pfract(jjm)
+      REAL pdecli
+c
+c     Local variables :
+c     -----------------
+
+      INTEGER j
+      REAL pi
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b
+c
+c=======================================================================
+c
+      pi = 4. * atan(1.0)
+      z = pdecli
+      cz = cos (z*pi/180.)
+      sz = sin (z*pi/180.)
+c
+      DO 20 j = 1, jjm
+c
+         phi = plat(j)
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+         IF(t.eq.0.) THEN
+            t=0.5*pi
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) THEN
+               t = -atan (-t) + pi
+            ELSE
+               t = atan(t)
+            ENDIF
+         ENDIF
+         pmu(j) = (sphi*sz*t) / pi + b*sin(t)/pi
+         pfract(j) = t / pi
+         IF (ap .lt.0.) THEN
+            pmu(j) = sphi * sz
+            pfract(j) = 1.0
+         ENDIF
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+c
+   20 CONTINUE
+c
+      RETURN
+      END
+c
+c* end of mufract
+c=======================================================================
+c
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/multipl.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/multipl.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/multipl.F	(revision 2744)
@@ -0,0 +1,17 @@
+      SUBROUTINE multipl(n,x1,x2,y)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   multiplication de deux vecteurs
+c
+c=======================================================================
+c
+      INTEGER n,i
+      REAL x1(n),x2(n),y(n)
+c
+      DO 10 i=1,n
+         y(i)=x1(i)*x2(i)
+10    CONTINUE
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/newcondens.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/newcondens.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/newcondens.F	(revision 2744)
@@ -0,0 +1,799 @@
+      SUBROUTINE newcondens(ngrid,nlayer,nq,ptimestep,
+     $                  pcapcal,pplay,pplev,ptsrf,pt,
+     $                  pphi,pdt,pdu,pdv,pdtsrf,pu,pv,pq,pdq,
+     $                  piceco2,psolaralb,pemisurf,
+     $                  pdtc,pdtsrfc,pdpsrf,pduc,pdvc,pdqc,
+     $                  fluxsurf_sw)
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Condensation/sublimation of CO2 ice on the ground and in the
+c   atmosphere 
+c   (Scheme described in Forget et al., Icarus, 1998)
+c
+c   author:   Francois Forget     1994-1996
+c   ------
+c
+c   input:
+c   ----- 
+c    ngrid                 nombre de points de verticales
+c                          (toutes les boucles de la physique sont au
+c                          moins vectorisees sur ngrid)
+c    nlayer                nombre de couches
+c    pplay(ngrid,nlayer)   Pressure levels 
+c    pplev(ngrid,nlayer+1) Pressure levels 
+c    pt(ngrid,nlayer)      temperature (en K)
+c    ptsrf(ngrid)          temperature de surface
+c 
+c                    \
+c    pdt(ngrid,nlayermx)   \  derivee temporelle physique avant condensation
+c                     /  ou sublimation pour  pt,ptsrf
+c    pdtsrf(ngrid)   /
+c
+c   output:
+c   -------
+c
+c    pdpsrf(ngrid)   \  derivee temporelle physique (contribution de
+c    pdtc(ngrid,nlayermx) /  la condensation ou sublimation) pour Ps,pt,ptsrf
+c    pdtsrfc(ngrid) /
+c
+c   Entree/sortie
+c   -------------
+c    
+c    piceco2(ngrid) :      quantite de glace co2 au sol (kg/m2)
+c    psolaralb(ngrid,2) :  albedo au sol
+c    pemisurf(ngrid)     :  emissivite du sol             
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "surfdat.h"
+#include "comgeomfi.h"
+#include "comvert.h"
+#include "paramet.h"
+#include "callkeys.h"
+#include "tracer.h"
+
+#include "fisice.h"
+
+c-----------------------------------------------------------------------
+c    Arguments :
+c    ---------
+      INTEGER ngrid, nlayer, nq
+
+      REAL ptimestep 
+      REAL pplay(ngrid,nlayer),pplev(ngrid,nlayer+1)
+      REAL pcapcal(ngrid)
+      REAL pt(ngrid,nlayer)
+      REAL ptsrf(ngrid)
+      REAL pphi(ngrid,nlayer)
+      REAL pdt(ngrid,nlayer),pdtsrf(ngrid),pdtc(ngrid,nlayer)
+      REAL pdtsrfc(ngrid),pdpsrf(ngrid)
+      REAL piceco2(ngrid),psolaralb(ngrid,2),pemisurf(ngrid)
+
+      REAL pu(ngrid,nlayer) ,  pv(ngrid,nlayer)
+      REAL pdu(ngrid,nlayer) , pdv(ngrid,nlayer)
+      REAL pduc(ngrid,nlayer) , pdvc(ngrid,nlayer)
+      REAL pq(ngridmx,nlayer,nq),pdq(ngrid,nlayer,nq)
+      REAL pdqc(ngrid,nlayer,nq)
+      REAL fluxsurf_sw(ngrid,2) ! added to calculate flux dependent albedo 
+c
+c    Local variables :
+c    -----------------
+
+c   variables used for albedo parametrization       
+c --------------------------------------------      
+      INTEGER i,j
+      REAL Fluxmean(jjp1)
+      INTEGER l,ig,iq,icap,nmix
+      LOGICAL transparency, fluxdependent
+c   flag transparency if you want to make the co2ice semi-transparent       
+      PARAMETER(transparency=.true.)
+c   flag fluxdependent if you want the co2ice albedo to be dependent on
+c   the incident solar flux      
+      PARAMETER(fluxdependent=.false.)
+      REAL slopy,alpha,constA,constB,constT,albediceF_new(ngridmx)
+      REAL zt(ngridmx,nlayermx)
+      REAL zcpi
+      REAL ztcond (ngridmx,nlayermx)
+      REAL ztcondsol(ngridmx) 
+      REAL zdiceco2(ngridmx)
+c      REAL zcondicea(ngridmx,nlayermx) ! Already defined in fisice.h 
+      REAL zcondices(ngridmx)
+      REAL zfallice(ngridmx,nlayermx+1) , zfallheat
+      REAL zmflux(nlayermx+1)
+      REAL zu(nlayermx),zv(nlayermx)
+      REAL zq(nlayermx,nqmx),zq1(nlayermx)
+      REAL ztsrf(ngridmx)
+      REAL ztc(nlayermx), ztm(nlayermx+1) 
+      REAL zum(nlayermx+1) , zvm(nlayermx+1)
+      REAL zqm(nlayermx+1,nqmx),zqm1(nlayermx+1)
+      REAL masse(nlayermx),w(nlayermx+1)
+      REAL Sm(nlayermx),Smq(nlayermx,nqmx),mixmas,qmix
+      LOGICAL condsub(ngridmx)
+
+c variable speciale diagnostique
+      real tconda1(ngridmx,nlayermx)
+      real tconda2(ngridmx,nlayermx)
+c     REAL zdiceco2a(ngridmx) ! for diagnostic only
+      real zdtsig (ngridmx,nlayermx)
+      real zdt (ngridmx,nlayermx)
+
+
+c   local saved variables
+      integer ico2
+      real qco2min
+      save ico2,qco2min
+      REAL emisref(ngridmx)
+      REAL latcond,tcond1mb
+      REAL acond,bcond,ccond,cpice
+      REAL albediceF(ngridmx)
+      SAVE emisref
+      SAVE latcond,acond,bcond,ccond,cpice
+      SAVE albediceF
+ 
+
+      LOGICAL firstcall,firstcall2
+      SAVE firstcall,firstcall2
+      REAL SSUM
+      EXTERNAL SSUM
+
+c      common/scratch/zt,ztcond,zcondicea,zfallice,tconda1
+c     ,    ,tconda2,zdtsig,zdt,zu,zv
+
+
+      DATA latcond,tcond1mb/5.9e5,136.27/
+      DATA cpice /1000./
+      DATA firstcall/.true./
+      DATA firstcall2/.true./
+
+      integer flag
+
+c----------------------------------------------------------------------
+
+
+c   Initialisation
+c   --------------
+c
+      IF (firstcall) THEN
+         bcond=1./tcond1mb
+         ccond=cpp/(g*latcond)
+         acond=r/latcond
+
+         firstcall=.false.
+         PRINT*,'In newcondens:Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
+         PRINT*,'acond,bcond,ccond',acond,bcond,acond
+
+         ico2=0
+         if (tracer) then  
+c          Prepare Special treatment if one of the tracer is CO2 gas
+           do iq=1,nqmx
+             if (noms(iq).eq."co2") ico2=iq
+           enddo
+c          minimum CO2 mix. ratio below which mixing occur with layer above: 
+           qco2min =0.75  
+         end if
+      ENDIF
+      zcpi=1./cpp
+
+c
+c======================================================================
+c    Calcul of CO2 condensation sublimation 
+c    ============================================================
+c  
+c    Used variable :
+c       piceco2(ngrid)   :  amount of co2 ice on the ground (kg/m2)
+c       zcondicea(ngrid,l):  condensation rate in layer  l  (kg/m2/s)
+c       zcondices(ngrid):  condensation rate on the ground (kg/m2/s)
+c       zfallice(ngrid,l):amount of ice falling from layer l (kg/m2/s)
+c                           
+c       pdtc(ngrid,nlayermx)  : dT/dt due to cond/sub
+c
+c
+c     Tendencies set to 0 (except pdtc)
+c     -------------------------------------
+      DO l=1,nlayer
+         DO ig=1,ngrid
+           zcondicea(ig,l) = 0.
+           zfallice(ig,l) = 0.
+           pduc(ig,l)  = 0
+           pdvc(ig,l)  = 0
+         END DO
+      END DO
+         
+      DO iq=1,nqmx         
+      DO l=1,nlayer
+         DO ig=1,ngrid
+           pdqc(ig,l,iq)  = 0
+         END DO
+      END DO
+      END DO
+
+      DO ig=1,ngrid
+         zfallice(ig,nlayer+1) = 0.
+         zcondices(ig) = 0.
+         pdtsrfc(ig) = 0.
+         pdpsrf(ig) = 0.
+         condsub(ig) = .false.
+         zdiceco2(ig) = 0.
+      ENDDO
+      zfallheat=0
+
+c     *************************
+c     ATMOSPHERIC CONDENSATION
+c     *************************
+
+c     forecast of atmospheric temperature zt and frost temperature ztcond
+c     --------------------------------------------------------------------
+
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
+            ztcond(ig,l)=1./(bcond-acond*log(.0095*pplay(ig,l)))
+            if (pplay(ig,l).lt.1e-4) ztcond(ig,l)=0.0 !mars Monica
+         ENDDO
+      ENDDO
+ 
+c      Condensation/sublimation in the atmosphere
+c      ------------------------------------------
+c      (calcul of zcondicea , zfallice and pdtc)
+c
+      DO l=nlayer , 1, -1
+         DO ig=1,ngrid
+           pdtc(ig,l)=0.
+           IF((zt(ig,l).LT.ztcond(ig,l)).or.(zfallice(ig,l+1).gt.0))THEN
+               condsub(ig)=.true.
+               IF (zfallice(ig,l+1).gt.0) then  
+                 zfallheat=zfallice(ig,l+1)*
+     &           (pphi(ig,l+1)-pphi(ig,l) +
+     &          cpice*(ztcond(ig,l+1)-ztcond(ig,l)))/latcond
+               ELSE
+                   zfallheat=0.
+               ENDIF
+               pdtc(ig,l)=(ztcond(ig,l) - zt(ig,l))/ptimestep
+               zcondicea(ig,l)=(pplev(ig,l)-pplev(ig,l+1))
+     &                        *ccond*pdtc(ig,l)- zfallheat
+c              Case when the ice from above sublimes entirely
+c              """""""""""""""""""""""""""""""""""""""""""""""
+               IF (zfallice(ig,l+1).lt.- zcondicea(ig,l)) then
+                  pdtc(ig,l)=(-zfallice(ig,l+1)+zfallheat)/
+     &              (ccond*(pplev(ig,l)-pplev(ig,l+1)))
+                  zcondicea(ig,l)= -zfallice(ig,l+1)
+               END IF
+
+               zfallice(ig,l) = zcondicea(ig,l)+zfallice(ig,l+1)
+            END IF
+         ENDDO
+      ENDDO
+
+c     *************************
+c       SURFACE  CONDENSATION
+c     *************************
+
+c     forecast of ground temperature ztsrf and frost temperature ztcondsol
+c     --------------------------------------------------------------------
+      DO ig=1,ngrid
+         ztcondsol(ig)=1./(bcond-acond*log(.0095*pplev(ig,1)))
+         ztsrf(ig) = ptsrf(ig) + pdtsrf(ig)*ptimestep
+      ENDDO
+
+c
+c      Condensation/sublimation on the ground 
+c      --------------------------------------
+c      (calcul of zcondices , pdtsrfc)
+c
+      DO ig=1,ngrid
+         IF(ig.GT.ngrid/2+1) THEN
+            icap=2
+         ELSE
+            icap=1
+         ENDIF
+       
+c
+c        Loop on where we have  condensation/ sublimation 
+         IF ((ztsrf(ig) .LT. ztcondsol(ig)) .OR.   ! ground cond 
+     $       (zfallice(ig,1).NE.0.) .OR.           ! falling snow
+     $      ((ztsrf(ig) .GT. ztcondsol(ig)) .AND.  ! ground sublim.
+     $      ((piceco2(ig)+zfallice(ig,1)*ptimestep) .NE. 0.))) THEN
+            condsub(ig) = .true. 
+
+            IF (zfallice(ig,1).gt.0) then  
+                 zfallheat=zfallice(ig,1)*
+     &           (pphi(ig,1)- phisfi(ig) +
+     &           cpice*(ztcond(ig,1)-ztcondsol(ig)))/(latcond*ptimestep)
+            ELSE
+                 zfallheat=0.
+            ENDIF
+
+c           condensation or partial sublimation of CO2 ice
+c           """""""""""""""""""""""""""""""""""""""""""""""
+            zcondices(ig)=pcapcal(ig)*(ztcondsol(ig)-ztsrf(ig)) 
+     &      /(latcond*ptimestep)         - zfallheat
+            pdtsrfc(ig) = (ztcondsol(ig) - ztsrf(ig))/ptimestep
+       
+c           If the entire CO_2 ice layer sublimes
+c           """"""""""""""""""""""""""""""""""""""""""""""""""""
+c           (including what has just condensed in the atmosphere)
+
+            IF((piceco2(ig)/ptimestep+zfallice(ig,1)).LE.
+     &          -zcondices(ig))THEN
+               zcondices(ig) = -piceco2(ig)/ptimestep - zfallice(ig,1) 
+               pdtsrfc(ig)=(latcond/pcapcal(ig))*
+     &         (zcondices(ig)+zfallheat)
+            END IF
+
+c           Changing CO2 ice amount and pressure :
+c           """"""""""""""""""""""""""""""""""""
+
+            zdiceco2(ig) = zcondices(ig) + zfallice(ig,1)
+            piceco2(ig) = piceco2(ig) + zdiceco2(ig)*ptimestep
+            pdpsrf(ig) = -zdiceco2(ig)*g
+
+            IF(ABS(pdpsrf(ig)*ptimestep).GT.pplev(ig,1)) THEN
+               PRINT*,'STOP in condens'
+               PRINT*,'condensing more than total mass'
+               PRINT*,'Grid point ',ig
+               PRINT*,'Ps = ',pplev(ig,1)
+               PRINT*,'d Ps = ',pdpsrf(ig)
+               STOP
+            ENDIF
+         END IF
+      ENDDO
+
+c  ********************************************************************
+c  Surface albedo and emissivity of the surface below the snow (emisref)
+c  ********************************************************************
+c     Prepare the case where albedo varies with insolation:
+c     ----------------------------------------------------
+      if (fluxdependent) then
+
+c       Calcul du flux moyen (zonal mean)
+        do j=1,jjp1
+           Fluxmean(j)=0      
+           do i=1,iim
+               ig=1+(j-2)*iim +i
+               if(j.eq.1) ig=1
+               if(j.eq.jjp1) ig=ngrid
+               Fluxmean(j)=Fluxmean(j)+fluxsurf_sw(ig,1)
+     $            +fluxsurf_sw(ig,2)
+           enddo
+           Fluxmean(j)=Fluxmean(j)/float(iim)
+        enddo
+
+c       const A and B used to calculate the albedo which depends on solar flux 
+c       albedice=constA+constB*Flux
+c       constT = time step to calculate the solar flux when flux decreases         
+         constA=0.26
+c        constA=0.33
+c        constA=0.186
+         constB=0.00187
+         constT=10
+      endif
+
+c     Calcul de l'albedo
+c     ------------------
+         do ig =1,ngrid
+           IF(ig.GT.ngrid/2+1) THEN
+              icap=2
+           ELSE
+              icap=1
+           ENDIF
+           IF(firstcall2) THEN
+           albediceF(ig)=albedice(icap)
+           ENDIF
+c       test on the existence of co2ice ccccccccccccccccccccccc
+           if(.not.piceco2(ig).ge.0.) THEN
+              if(piceco2(ig).le.-5.e-8) print*,
+     $         'WARNING newcondens piceco2(',ig,')=', piceco2(ig)
+               piceco2(ig)=0.
+           endif
+c       if there is still co2ice        ccccccccccccccccccccccc
+           if (piceco2(ig).gt.0) then
+              emisref(ig) = emisice(icap)
+
+c     if flux dependent albedo is used 
+c     --------------------------------
+             if (fluxdependent) then
+                j=INT((ig-2)/iim)+2
+                if(ig.eq.1) j=1
+                if(ig.eq.ngrid) j=jjp1
+c                albediceF_new(ig)=MIN(constA+constB*Fluxmean(j),
+c     $          constA+constB*250)
+                  albediceF_new(ig)=constA+constB*Fluxmean(j)
+                if (albediceF(ig).gt.albediceF_new(ig)) then
+                   albediceF(ig)=albediceF(ig)+ ptimestep/(daysec*
+     $             constT)*(albediceF_new(ig)-albediceF(ig))
+                else
+                   albediceF(ig)=albediceF_new(ig)
+                endif
+c               if part of the ice is transparent
+c               slopy = pente de la droite:  alpha = y*co2ice/1620
+c               pour une valeur superieur a une epaisseur de glace donnee
+c               ici, epaisseur limite = 10cm
+                if (transparency) then
+                slopy=1/(1620*0.10)
+                alpha=MIN(slopy*piceco2(ig),1.)
+                psolaralb(ig,1) = alpha*albediceF(ig)
+     $                           +(1-alpha)*albedodat(ig) 
+                psolaralb(ig,2) = psolaralb(ig,1) 
+                else
+                psolaralb(ig,1) = albediceF(ig) 
+                psolaralb(ig,2) = psolaralb(ig,1) 
+                endif
+             else
+c           transparency set to true and fluxdependent set to false            
+                if (transparency) then
+                slopy=1/(1620*0.10)
+                alpha=MIN(slopy*piceco2(ig),1.)
+                psolaralb(ig,1) = alpha*albedice(icap)
+     $                           +(1-alpha)*albedodat(ig) 
+                psolaralb(ig,2) = psolaralb(ig,1) 
+                else
+c           simplest case: transparency and flux dependent set to false
+                psolaralb(ig,1) = albedice(icap)
+                psolaralb(ig,2) = albedice(icap)
+                endif
+             endif    
+c         no more co2ice, albedo = ground albedo
+           else
+              psolaralb(ig,1) = albedodat(ig)
+              psolaralb(ig,2) = albedodat(ig)
+              emisref(ig) = emissiv
+              pemisurf(ig) = emissiv
+           endif
+         end do ! end of the ig loop
+
+         firstcall2=.false.
+c ***************************************************************
+c  Correction to account for redistribution between sigma or hybrid 
+c  layers when changing surface pressure (and warming/cooling
+c  of the CO2 currently changing phase).
+c *************************************************************
+
+      DO ig=1,ngrid
+        if (condsub(ig)) then
+           do l=1,nlayer
+             ztc(l)  =zt(ig,l)   +pdtc(ig,l)  *ptimestep
+             zu(l)   =pu(ig,l)   +pdu( ig,l)  *ptimestep
+             zv(l)   =pv(ig,l)   +pdv( ig,l)  *ptimestep
+            do iq=1,nqmx
+             zq(l,iq)=pq(ig,l,iq)+pdq(ig,l,iq)*ptimestep
+            enddo
+           end do
+
+c  Mass fluxes through the sigma levels (kg.m-2.s-1)  (>0 when up)
+c  """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
+
+            zmflux(1) = -zcondices(ig)
+            DO l=1,nlayer
+             zmflux(l+1) = zmflux(l) -zcondicea(ig,l)
+     &        + (bp(l)-bp(l+1))*(zfallice(ig,1)-zmflux(1))
+c zmflux set to 0 if very low to avoid: top layer is disappearing in v1ld  
+          if (abs(zmflux(l+1)).lt.1E-13.OR.bp(l+1).eq.0.) zmflux(l+1)=0.
+            END DO
+
+c Mass of each layer
+c ------------------ 
+            DO l=1,nlayer
+              masse(l)=(pplev(ig,l) - pplev(ig,l+1))/g
+            END DO
+
+
+c  Corresponding fluxes for T,U,V,Q
+c  """"""""""""""""""""""""""""""""
+
+c           averaging operator for TRANSPORT  
+c           """"""""""""""""""""""""""""""""
+c           Value transfert at the surface interface when condensation
+c           sublimation:
+            ztm(1) = ztsrf(ig) + pdtsrfc(ig)*ptimestep
+            zum(1) = 0  
+            zvm(1) = 0  
+            do iq=1,nqmx
+              zqm(1,iq)=0. ! most tracer do not condense !
+            enddo
+c           Special case if one of the tracer is CO2 gas
+            if (ico2.ne.0) zqm(1,ico2)=1. ! flux is 100% CO2
+
+c           Van Leer scheme:
+            DO l=1,nlayer+1
+                w(l)=-zmflux(l)*ptimestep
+            END DO
+            call vl1d(ztc,2.,masse,w,ztm) 
+            call vl1d(zu ,2.,masse,w,zum) 
+            call vl1d(zv ,2.,masse,w,zvm) 
+            do iq=1,nqmx
+             do l=1,nlayer
+              zq1(l)=zq(l,iq)
+             enddo
+             zqm1(1)=zqm(1,iq)
+             call vl1d(zq1,2.,masse,w,zqm1)
+             do l=2,nlayer
+              zq( l,iq)=zq1(l)
+              zqm(l,iq)=zqm1(l)
+             enddo
+            enddo
+
+c           Surface condensation affects low winds
+            if (zmflux(1).lt.0) then 
+                zum(1)= zu(1) *  (w(1)/masse(1))
+                zvm(1)= zv(1) *  (w(1)/masse(1))
+                if (w(1).gt.masse(1)) then ! ensure numerical stability
+                  zum(1)= (zu(1)-zum(2))*masse(1)/w(1) + zum(2)
+                  zvm(1)= (zv(1)-zvm(2))*masse(1)/w(1) + zvm(2)
+                end if
+            end if
+                    
+            ztm(nlayer+1)= ztc(nlayer) ! should not be used, but... 
+            zum(nlayer+1)= zu(nlayer)  ! should not be used, but...
+            zvm(nlayer+1)= zv(nlayer)  ! should not be used, but...
+            do iq=1,nqmx
+             zqm(nlayer+1,iq)= zq(nlayer,iq)
+            enddo
+  
+cc           Tendencies on T, U, V, Q 
+cc           """"""""""""""""""""""""
+c            DO l=1,nlayer
+c 
+cc             Tendencies on T
+c               zdtsig(ig,l) = (1/masse(l)) *
+c     &        ( zmflux(l)*(ztm(l) - ztc(l)) 
+c     &        - zmflux(l+1)*(ztm(l+1) - ztc(l))
+c     &        + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l))  )
+c               pdtc(ig,l) =  pdtc(ig,l) + zdtsig(ig,l)
+c
+cc             Tendencies on U
+c               pduc(ig,l)   = (1/masse(l)) *
+c     &        ( zmflux(l)*(zum(l) - zu(l))
+c     &        - zmflux(l+1)*(zum(l+1) - zu(l)) )
+c
+c
+cc             Tendencies on V
+c               pdvc(ig,l)   = (1/masse(l)) *
+c     &        ( zmflux(l)*(zvm(l) - zv(l))
+c     &        - zmflux(l+1)*(zvm(l+1) - zv(l)) )
+c
+c            END DO
+
+c           Tendencies on Q
+            do iq=1,nqmx
+              if (noms(iq).eq.'co2') then 
+c               SPECIAL Case when the tracer IS CO2 :
+                DO l=1,nlayer
+                  pdqc(ig,l,iq)= (1/masse(l)) *
+     &           ( zmflux(l)*(zqm(l,iq) - zq(l,iq))
+     &           - zmflux(l+1)*(zqm(l+1,iq) - zq(l,iq)) 
+     &           + zcondicea(ig,l)*(zq(l,iq)-1.) )
+                END DO
+              else
+                DO l=1,nlayer
+                  pdqc(ig,l,iq)= (1/masse(l)) *
+     &           ( zmflux(l)*(zqm(l,iq) - zq(l,iq))
+     &           - zmflux(l+1)*(zqm(l+1,iq) - zq(l,iq)) 
+     &           + zcondicea(ig,l)*zq(l,iq) )
+                END DO
+              end if
+            enddo
+
+c           --------------------------------------------------------
+c           Roughly Simulate Molecular mixing when CO2 is too depleted by
+c           Surface condensation (mixing starts if qco2 < qco2min )  
+c           FF 06/2004
+c           WARNING : this is now done in convadj, better (FF 02/2005)
+c           --------------------------------------------------------
+            flag=0  ! now done in convadj : must be =0
+            if (flag.eq.1) then 
+            if(ico2.gt.0) then   ! relevant only if one tracer is CO2
+             if(pq(ig,1,ico2)+(pdq(ig,1,ico2)+pdqc(ig,1,ico2))*ptimestep
+     &       .lt.qco2min) then 
+                do iq=1,nqmx
+                  zq(1,iq)=pq(ig,1,iq)
+     &                     +(pdq(ig,1,iq)+pdqc(ig,1,iq))*ptimestep
+                  Smq(1,iq) = masse(1)*zq(1,iq)
+                end do
+                Sm(1)  = masse(1)
+                do l =2,nlayermx
+                  do iq=1,nqmx
+                     zq(l,iq)=pq(ig,l,iq)
+     &                        +(pdq(ig,l,iq)+pdqc(ig,l,iq))*ptimestep
+                     smq(l,iq) = smq(l-1,iq) + masse(l)*zq(l,iq)
+                  end do 
+                  sm(l) = sm(l-1) + masse(l)
+                  if(zq(l,ico2).gt.qco2min) then 
+c                   mixmas: mass of atmosphere that must be mixed to reach qco2min
+                    mixmas = (sm(l-1)*zq(l,ico2)-Smq(l-1,ico2))
+     &                      /(zq(l,ico2)-qco2min)
+                    if((mixmas.le.sm(l)))then
+c                      OK if mixed mass less than mass of layers affected
+                       nmix=l   ! number of layer affected by mixing
+                       goto 99 
+                    end if
+                  end if
+                 end do
+ 99              continue 
+                 do iq=1,nqmx
+                   qmix=zq(nmix,iq) 
+     &             +(Smq(nmix-1,iq)-zq(nmix,iq)*Sm(nmix-1))/mixmas
+                   do l=1,nmix-1
+                      pdqc(ig,l,iq)=
+     &                  (qmix-pq(ig,l,iq))/ptimestep - pdq(ig,l,iq)
+                   end do 
+c                  layer only partly mixed :
+                   pdqc(ig,nmix,iq)=(
+     &             qmix+(Sm(nmix)-mixmas)*(zq(nmix,iq)-qmix)/masse(nmix)
+     &             -pq(ig,nmix,iq))/ptimestep -pdq(ig,nmix,iq)
+
+                 end do 
+             end if
+            end if
+
+        endif   ! (flag.eq.1)
+       end if ! if (condsub)
+      END DO  ! loop on ig 
+
+c ***************************************************************
+c   CO2 snow / clouds scheme
+c ***************************************************************
+
+      call co2snow(ngrid,nlayer,ptimestep,emisref,condsub,pplev,
+     &        zcondicea,zcondices,zfallice,pemisurf)
+
+c ***************************************************************
+c Ecriture des diagnostiques
+c ***************************************************************
+
+c     DO l=1,nlayer
+c        DO ig=1,ngrid
+c         Taux de cond en kg.m-2.pa-1.s-1
+c          tconda1(ig,l)=zcondicea(ig,l)/(pplev(ig,l)-pplev(ig,l+1))
+c          Taux de cond en kg.m-3.s-1
+c          tconda2(ig,l)=tconda1(ig,l)*pplay(ig,l)*g/(r*pt(ig,l))
+c        END DO
+c     END DO
+c     call WRITEDIAGFI(ngridmx,'tconda1',
+c    &'Taux de condensation CO2 atmospherique /Pa',
+c    & 'kg.m-2.Pa-1.s-1',3,tconda1)
+c     call WRITEDIAGFI(ngridmx,'tconda2',
+c    &'Taux de condensation CO2 atmospherique /m',
+c    & 'kg.m-3.s-1',3,tconda2)
+
+
+        !print*,'fin newcondens piceco2',piceco2(ig)
+        !print*,'ptsrf ztsrf', ptsrf(ig),ztsrf(ig)
+        !print*,'ztcondsol(ig)', ztcondsol(ig)
+        !print*,'ztcondsol(ig)', ztcondsol(ig)
+        !print*,'tend. press', pdpsrf(ig)*ptimestep
+
+
+      return
+      end
+
+
+
+c *****************************************************************
+      SUBROUTINE vl1d(q,pente_max,masse,w,qm)
+c
+c    
+c     Operateur de moyenne inter-couche pour calcul de transport type
+c     Van-Leer " pseudo amont " dans la verticale
+c    q,w sont des arguments d'entree  pour le s-pg ....
+c    masse : masse de la couche Dp/g
+c    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
+c    pente_max = 2 conseillee
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+
+#include "dimensions.h"
+
+c
+c
+c
+c   Arguments:
+c   ----------
+      real masse(llm),pente_max
+      REAL q(llm),qm(llm+1)
+      REAL w(llm+1)
+c
+c      Local 
+c   ---------
+c
+      INTEGER l
+c
+      real dzq(llm),dzqw(llm),adzqw(llm),dzqmax
+      real sigw, Mtot, MQtot
+      integer m 
+c     integer ismax,ismin 
+
+
+c    On oriente tout dans le sens de la pression 
+c     W > 0 WHEN DOWN !!!!!!!!!!!!!
+
+      do l=2,llm
+            dzqw(l)=q(l-1)-q(l)
+            adzqw(l)=abs(dzqw(l))
+      enddo
+
+      do l=2,llm-1
+            if(dzqw(l)*dzqw(l+1).gt.0.) then
+                dzq(l)=0.5*(dzqw(l)+dzqw(l+1))
+            else
+                dzq(l)=0.
+            endif
+            dzqmax=pente_max*min(adzqw(l),adzqw(l+1))
+            dzq(l)=sign(min(abs(dzq(l)),dzqmax),dzq(l))
+      enddo
+
+         dzq(1)=0.
+         dzq(llm)=0.
+
+       do l = 1,llm-1
+
+c         Regular scheme (transfered mass < layer mass)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(w(l+1).gt.0. .and. w(l+1).le.masse(l+1)) then
+             sigw=w(l+1)/masse(l+1)
+             qm(l+1)=(q(l+1)+0.5*(1.-sigw)*dzq(l+1))
+          else if(w(l+1).le.0. .and. -w(l+1).le.masse(l)) then
+             sigw=w(l+1)/masse(l)
+             qm(l+1)=(q(l)-0.5*(1.+sigw)*dzq(l))
+
+c         Extended scheme (transfered mass > layer mass)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else if(w(l+1).gt.0.) then
+             m=l+1
+             Mtot = masse(m)
+             MQtot = masse(m)*q(m)
+             do while ((m.lt.llm).and.(w(l+1).gt.(Mtot+masse(m+1))))
+                m=m+1
+                Mtot = Mtot + masse(m)
+                MQtot = MQtot + masse(m)*q(m)
+             end do
+             if (m.lt.llm) then
+                sigw=(w(l+1)-Mtot)/masse(m+1)
+                qm(l+1)= (1/w(l+1))*(MQtot + (w(l+1)-Mtot)*
+     &          (q(m+1)+0.5*(1.-sigw)*dzq(m+1)) )
+             else
+                w(l+1) = Mtot
+                qm(l+1) = Mqtot / Mtot
+                write(*,*) 'top layer is disapearing !'
+                stop
+             end if
+          else      ! if(w(l+1).lt.0) 
+             m = l-1 
+             Mtot = masse(m+1)
+             MQtot = masse(m+1)*q(m+1)
+             do while ((m.gt.0).and.(-w(l+1).gt.(Mtot+masse(m))))
+                m=m-1
+                Mtot = Mtot + masse(m+1)
+                MQtot = MQtot + masse(m+1)*q(m+1)
+             end do
+             if (m.gt.0) then
+                sigw=(w(l+1)+Mtot)/masse(m)
+                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)* 
+     &          (q(m)-0.5*(1.+sigw)*dzq(m))  )
+             else
+                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)*qm(1))
+             end if   
+          end if
+       enddo
+
+c     boundary conditions (not used in newcondens !!)
+c         qm(llm+1)=0.
+c         if(w(1).gt.0.) then
+c            qm(1)=q(1)
+c         else 
+c           qm(1)=0.
+c         end if
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/newsedim.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/newsedim.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/newsedim.F	(revision 2744)
@@ -0,0 +1,185 @@
+      SUBROUTINE newsedim(ngrid,nlay,nsize,ptimestep,
+     &  pplev,masse,epaisseur,pt,rd,rho,pqi,wq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c      Compute sedimentation of 1 tracer 
+c      of radius rd (m) and density rho (kg.m-3) 
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,nsize
+      REAL ptimestep            ! pas de temps physique (s)
+      REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+      REAL pt(ngrid,nlay)    ! temperature au centre des couches (K)
+      real masse (ngrid,nlay) ! masse d'une couche (kg)
+      real epaisseur (ngrid,nlay)  ! epaisseur d'une couche (m)
+      real rd(nsize)             ! particle radius (m)
+      real rho             ! particle density (kg.m-3)
+
+
+c    Traceurs :
+      real pqi(ngrid,nlay)  ! traceur   (e.g. ?/kg)
+      real wq(ngridmx,nlay+1)  ! flux de traceur durant timestep (?/m-2)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig, k, i
+      REAL rfall
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+c    Traceurs :
+c    ~~~~~~~~ 
+      real traversee (ngridmx,nlayermx)
+      real vstokes(ngridmx,nlayermx)
+      real w(ngridmx,nlayermx)
+      real ptop, dztop, Ep, Stra
+
+      DATA firstcall/.true./
+
+c    Physical constant
+c    ~~~~~~~~~~~~~~~~~
+      REAL visc, molrad
+c     Gas molecular viscosity (N.s.m-2)
+      data visc/1.e-5/       ! CO2
+c     Effective gas molecular radius (m)
+      data molrad/2.2e-10/   ! CO2
+
+c     local and saved variable
+      real a,b
+      save a,b
+
+
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans newsedim'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+         firstcall=.false.
+
+
+c       Preliminary calculations for sedimenation velocity :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c       - Constant to compute stokes speed simple formulae
+c        (Vstokes =  b * rho* r**2   avec   b= (2/9) * rho * g / visc
+         b = 2./9. * g / visc
+
+c       - Constant  to compute gas mean free path
+c        l= (T/P)*a, avec a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+         a = 0.707*8.31/(4*3.1416* molrad**2  * 6.023e23)
+
+c       - Correction to account for non-spherical shape (Murphy et al.  1990)
+c   (correction = 0.85 for irregular particles, 0.5 for disk shaped particles)
+c        a = a    * 0.85
+      ENDIF
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c     Sedimentation velocity (m/s)
+c     ~~~~~~~~~~~~~~~~~~~~~~
+c     (stokes law corrected for low pressure by the Cunningham
+c     slip-flow correction  according to Rossow (Icarus 36, 1-50, 1978)
+
+        do  l=1,nlay
+          do ig=1, ngrid
+            if (nsize.eq.1) then 
+              rfall=rd(1)
+            else
+              i=ngrid*(l-1)+ig
+              rfall=rd(i)
+            endif  
+            vstokes(ig,l) = b * rho * rfall**2 *
+     &      (1 + 1.333* ( a*pt(ig,l)/pplev(ig,l) )/rfall)
+
+c           Layer crossing time (s) :
+            traversee(ig,l)= epaisseur(ig,l)/vstokes(ig,l)
+          end do
+        end do
+
+
+c     Calcul de la masse d'atmosphere correspondant a q transferee
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     (e.g. on recherche le niveau  en dessous de laquelle le traceur
+c      va traverser le niveau intercouche l : "dztop" est sa hauteur
+c      au dessus de l (m), "ptop" est sa pression (Pa))
+
+      do  l=1,nlay
+        do ig=1, ngrid
+             
+             dztop = vstokes(ig,l)*  ptimestep 
+             Ep=0
+             k=0
+
+c **************************************************************
+c            Simple Method
+             w(ig,l) =
+     &       (1- exp(-dztop*g/(r*pt(ig,l))))*pplev(ig,l) / g
+cc           write(*,*) 'OK simple method l,w =', l, w(ig,l)
+cc           write(*,*) 'OK simple method dztop =', dztop
+c **************************************************************
+cccc         Complex method :
+            if (dztop.gt.epaisseur(ig,l)) then
+cccc            Cas ou on "epuise" la couche l : On calcule le flux
+cccc            Venant de dessus en tenant compte de la variation de Vstokes
+
+               Ep= epaisseur(ig,l)
+               Stra= traversee(ig,l)
+               do while(dztop.gt.Ep.and.l+k+1.le.nlay)
+                 k=k+1
+                 dztop= Ep + vstokes(ig,l+k)*(ptimestep -Stra)
+                 Ep = Ep + epaisseur(ig,l+k)
+                 Stra = Stra + traversee(ig,l+k)
+               enddo 
+               Ep = Ep - epaisseur(ig,l+k)
+             end if
+             ptop=pplev(ig,l+k)*exp(-(dztop-Ep)*g/(r*pt(ig,l+k)))
+             w(ig,l) = (pplev(ig,l) -Ptop)/g
+c
+cc           write(*,*) 'OK new    method l,w =', l, w(ig,l)
+cc           write(*,*) 'OK new    method dztop =', dztop
+cc       if(l.eq.7)write(*,*)'l=7,k,pplev,Ptop',pplev(ig,l),Ptop
+cc       if(l.eq.7)write(*,*)'l=7,dztop,Ep',dztop,Ep
+cc            if(l.eq.6)write(*,*)'l=6,k, w',k, w(1,l)
+cc            if(l.eq.7)write(*,*)'l=7,k, w',k, w(1,l)
+cc            if(l.eq.8)write(*,*)'l=8,k, w',k, w(1,l)
+c **************************************************************
+        end do
+      end do
+
+      call vlz_fi(ngrid,pqi,2.,masse,w,wq)
+c         write(*,*) ' newsed: wq(6), wq(7), q(6)',
+c    &                wq(1,6),wq(1,7),pqi(1,6)
+
+
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nirco2abs.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nirco2abs.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nirco2abs.F	(revision 2744)
@@ -0,0 +1,144 @@
+      SUBROUTINE nirco2abs(ngrid,nlayer,pplay,dist_sol,
+     $     mu0,fract,declin,pdtnirco2)
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing heating rate due to
+c   absorption by CO2 in the near-infrared
+c   This version includes NLTE effects
+c
+c   (Scheme to be described in Forget et al., JGR, 2003)
+c   (old Scheme described in Forget et al., JGR, 1999)
+c
+c   This version updated with a new functional fit,
+c   see NLTE correction-factor of Lopez-Valverde et al (1998)
+c   Stephen Lewis 2000
+c  
+c   08/2002 : correction for bug when running with diurnal=F
+c
+c   author:  Frederic Hourdin 1996 
+c   ------
+c            Francois Forget 1999 
+c
+c   input:
+c   ----- 
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   dist_sol              sun-Mars distance (AU)
+c   mu0(ngridmx)          
+c   fract(ngridmx)        day fraction of the time interval
+c   declin                latitude of subslar point
+c
+c   output:
+c   -------
+c
+c   pdtnirco2(ngrid,nlayer)      Heating rate (K/s)
+c
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer
+
+      REAL pplay(ngrid,nlayer)
+      REAL dist_sol,mu0(ngridmx),fract(ngridmx),declin
+
+      REAL pdtnirco2(ngrid,nlayer)
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig, n, nstep
+      REAL co2heat0, zmu(ngridmx)
+
+c     special diurnal=F 
+      real mu0_int(ngridmx),fract_int(ngridmx),zday_int
+      real ztim1,ztim2,ztim3,step
+
+c
+c   local saved variables
+c   ---------------------
+
+c     p0noonlte is a pressure below which non LTE effects are significant.
+c     REAL p0nonlte
+c     DATA p0nonlte/7.5e-3/
+c     SAVE p0nonlte
+
+c     parameters for CO2 heating fit
+      real n_a, n_p0, n_b
+      parameter (n_a=1.1956475)
+      parameter (n_b=1.9628251)
+      parameter (n_p0=0.0015888279)
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+c     co2heat is the heating by CO2 at 700Pa for a zero zenithal angle.
+      co2heat0=n_a*(1.52/dist_sol)**2/daysec
+
+c     Simple calcul for a given sun incident angle (if diurnal=T)
+c     --------------------------------------------
+
+      IF (diurnal) THEN  
+         do ig=1,ngrid
+            zmu(ig)=sqrt(1224.*mu0(ig)*mu0(ig)+1.)/35.
+         enddo
+         do l=1,nlayer
+           do ig=1,ngrid
+             if(fract(ig).gt.0.) pdtnirco2(ig,l)=
+     &             co2heat0*sqrt((700.*zmu(ig))/pplay(ig,l))
+     &             /(1.+n_p0/pplay(ig,l))**n_b
+
+c           OLD SCHEME (forget et al. 1999)
+c    s           co2heat0*sqrt((700.*zmu(ig))/pplay(ig,l))
+c    s          / (1+p0nonlte/pplay(ig,l))
+           enddo
+         enddo
+
+c     Averaging over diurnal cycle (if diurnal=F)
+c     -------------------------------------------
+c     NIR CO2 abs is slightly non linear. To remove the diurnal
+c     cycle, it is better to average the heating rate over 1 day rather
+c     than using the mean mu0 computed by mucorr in physiq.F (FF, 1998)
+
+      ELSE      ! if (.not.diurnal) then
+
+         nstep = 20   ! number of integration step /sol
+         do n=1,nstep
+            zday_int = (n-1)/float(nstep)
+            ztim2=COS(declin)*COS(2.*pi*(zday_int-.5))
+            ztim3=-COS(declin)*SIN(2.*pi*(zday_int-.5))
+            CALL solang(ngrid,sinlon,coslon,sinlat,coslat,
+     s             ztim1,ztim2,ztim3,
+     s             mu0_int,fract_int)
+            do ig=1,ngrid
+               zmu(ig)=sqrt(1224.*mu0_int(ig)*mu0_int(ig)+1.)/35.
+            enddo
+            do l=1,nlayer
+               do ig=1,ngrid
+                  if(fract_int(ig).gt.0.) pdtnirco2(ig,l)=
+     &                 pdtnirco2(ig,l) + (1/float(nstep))*
+     &                 co2heat0*sqrt((700.*zmu(ig))/pplay(ig,l))
+     &                 /(1.+n_p0/pplay(ig,l))**n_b
+               enddo
+            enddo
+         end do
+      END IF
+
+      return
+      end 
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nltecool.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nltecool.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nltecool.F	(revision 2744)
@@ -0,0 +1,306 @@
+c**************************************************************************
+c
+      subroutine nltecool(ngrid,nlayer,pplay,pt,dtnlte)
+c
+c This code was designed as a delivery for the "Martian Environment Models" 
+c project ( ESA contract 11369/95/nl/jg CCN2 )
+c Computes non-LTE heating rates from CO2 emission at 15 um
+c in the Martian upper atmosphere.
+c Uses a simplified model consisting of two excited levels with two
+c emission bands, one of them stronger than the other, which correspond
+c to the behaviours of the 626 fundamental band and the isotopic fund.bands.
+c It uses a cool-to-space approximation with tabulated escape functions.
+c These escape functions have been precomputed for the strong and weak bands,
+c and are given as a function of pressure in separate files.
+c The output values are the heating rates (actually, cooling, since they
+c are always negative) for the two bands, i.e., the total cooling is the
+c sum of them.
+c Miguel A. Lopez Valverde
+c Instituto de Astrofisica de Andalucia (CSIC), Granada, Spain
+c
+c Version 1b.  See description above.  22-March-2000.
+c Adapted as a subroutine for use in GCM -- PLR/SRL 6/2000
+c Version 1c.  Inclusion of VMR in the tabulation of escape functions. 
+c              Table contains now only 1 input file -- Miguel 11/Jul/2000
+c Version 1d  data contained in original input file "nlte_escape.dat"
+c now stored in include file "nltedata.h" Y.Wanherdrick 09/2000
+c     
+c***************************************************************************
+
+      implicit none
+
+#include "nltedata.h" ! (Equivalent to the reading of the "nlte_escape.dat" file)
+ 
+c Input and output variables
+c
+      integer     ngrid                           ! no. of horiz. gridpoints
+      integer     nlayer                          ! no. of atmospheric layers
+      real        pplay(ngrid,nlayer)             ! input pressure grid
+      real        pt(ngrid,nlayer)                ! input temperatures
+      real        dtnlte(ngrid,nlayer)            ! output temp. tendencies
+
+c
+c Standard atmosphere variables
+c
+      real        nt                              ! number density [cm-3]
+      real        co2(nlayer)                     !  "   of CO2
+      real        o3p(nlayer)                     !  "   of atomic oxygen
+      real        n2co(nlayer)                    !  "  of N2 + CO
+      real        pyy(nlayer)                     ! auxiliary pressure grid
+
+c
+c Vectors and indexes for the tabulation of escape functions and VMR
+c
+c                 np                              ! # data points in tabulation
+c                 pnb(np)                         ! Pressure in tabulation
+c                 ef1(np)                         ! Esc.funct.#1, tabulated
+c                 ef2(np)                         ! Esc.funct.#2, tabulated
+c                 co2vmr(np)                      ! CO2 VMR tabulated
+c                 o3pvmr(np)                      ! CO2 VMR tabulated
+c                 n2covmr(np)                     ! N2+CO VMR tabulated
+      real        escf1(nlayer)                   ! Esc.funct.#1, interpolated
+      real        escf2(nlayer)                   ! Esc.funct.#2, interpolated
+
+
+c
+c Local Constants
+c
+      real       nu1, nu2                         ! freq. of energy levels
+      real       imr1, imr2                       ! isotopic abundances
+      real       hplanck, gamma, vlight           ! physical constants
+      real       ee
+      real       rfvt                             ! collisional rate
+      real       rfvto3p                          !     "
+      real       rfvv                             !     "
+
+c
+c Local variables for the main loop
+c
+      real       n1, n2, co2t                     ! ground populations
+      real       l1, p1, p12                      ! prod & losses
+      real       l2, p2, p21
+      real       tt                               ! dummy variable
+      real       c1, c2                           ! molecular constants
+      real       ae1, ae2                         ! einstein spontaneous emission
+      real       a1, a2, a12, a21
+      real       pl1, pl2
+      real       el1, el2
+      real       hr1, hr2                         ! heating rate due to each band
+      real       hr(nlayer)                       ! total heating rate
+
+c
+c Indexes
+c
+      integer    i
+      integer    j,ii
+
+c
+c Rate coefficients
+c
+      real       k19xca, k19xcb
+      real       k19cap1, k19cap2
+      real       k19cbp1, k19cbp2
+      real       d19c, d19cp1, d19cp2
+      real       k20xc, k20cp1, k20cp2
+      real       k21xc, k21cp2
+
+      logical    firstcall
+      data       firstcall/.true./
+      save       firstcall,ef1,ef2,co2vmr,n2covmr,o3pvmr,pnb
+
+c
+c Data
+c
+      data       nu1, nu2, hplanck, gamma, vlight, ee/
+     1     667.38, 662.3734, 6.6261e-27, 1.191e-5, 3.e10, 1.438769/
+
+c*************************************************************************
+c       PROGRAM  STARTS
+c*************************************************************************
+
+      imr1 = 0.987
+      imr2 = 0.00408 + 0.0112
+      rfvt = 0.1
+      rfvto3p = 1.0
+      rfvv = 0.1
+
+      if(firstcall) then
+
+         do i=1,np
+            pnb(i)=1.0e-4*exp(pnb(i)) ! p into Pa
+         end do
+
+         firstcall = .false.
+
+      endif
+
+c
+c MAIN LOOP, for each gridpoint and altitude:
+c
+      do j=1,ngrid  ! loop over grid points
+c
+c set up local pressure grid
+c
+         do ii=1,nlayer
+            pyy(ii)=pplay(j,ii)
+         enddo
+!
+! Interpolate escape functions and VMR to the desired grid
+!
+         call interp1(escf2,pyy,nlayer,ef2,pnb,np)
+         call interp1(escf1,pyy,nlayer,ef1,pnb,np)
+         call interp3(co2,o3p,n2co,pyy,nlayer,
+     &        co2vmr,o3pvmr,n2covmr,pnb,np)
+        
+         do i=1,nlayer  ! loop over layers
+C
+C test if p lies outside range (p > 3.5 Pa)
+C changed to 1 Pa since transition will always be higher than this
+C
+            if(pyy(i) .gt. 1.0 .or. pyy(i) .lt. 4.0e-6) then 
+               hr(i)=0.0
+               dtnlte(j,i)=0.0
+            else
+c
+c           if(pt(j,i).lt.1.0)print*,pt(j,i)
+               nt = pyy(i)/(1.381e-17*pt(j,i)) ! nt in cm-3
+               co2(i)=co2(i)*nt                ! CO2 density in cm-3
+               o3p(i)=o3p(i)*nt                ! O3p density in cm-3
+               n2co(i)=n2co(i)*nt              ! N2+CO in cm-3
+c molecular populations
+               n1 = co2(i) * imr1
+               n2 = co2(i) * imr2
+               co2t = n1 + n2
+
+c intermediate collisional rates
+               tt = pt(j,i)*pt(j,i)
+
+               if (pt(j,i).le.175.0) then
+                  k19xca = 3.3e-15
+                  k19xcb = 7.6e-16
+               else
+                  k19xca = 4.2e-12 * exp( -2988.0/pt(j,i) + 303930.0/tt)
+                  k19xcb = 2.1e-12 * exp( -2659.0/pt(j,i) + 223052.0/tt)
+               endif
+               k19xca = k19xca * rfvt
+               k19xcb = k19xcb * rfvt
+               k19cap1 = k19xca * 2.0 * exp( -ee*nu1/pt(j,i) )
+               k19cap2 = k19xca * 2.0 * exp( -ee*nu2/pt(j,i) )
+               k19cbp1 = k19xcb * 2.0 * exp( -ee*nu1/pt(j,i) )
+               k19cbp2 = k19xcb * 2.0 * exp( -ee*nu2/pt(j,i) )
+               d19c = k19xca*co2t + k19xcb*n2co(i)
+               d19cp1 = k19cap1*co2t + k19cbp1*n2co(i)
+               d19cp2 = k19cap2*co2t + k19cbp2*n2co(i)
+                                !
+               k20xc = 3.e-12 * rfvto3p
+               k20cp1 = k20xc * 2.0 * exp( -ee/pt(j,i) * nu1 )
+               k20cp2 = k20xc * 2.0 * exp( -ee/pt(j,i) * nu2 )
+                                !
+               k21xc = 2.49e-11 * 0.5 * rfvv
+               k21cp2 = k21xc * exp( - ee/pt(j,i) * (nu2-nu1) )
+                                !
+               l1 = d19c + k20xc*o3p(i) + k21cp2*n2
+               p1 = ( d19cp1 + k20cp1*o3p(i) ) * n1
+               p12 = k21xc*n1
+                                !
+               l2 = d19c + k20xc*o3p(i) + k21xc*n1
+               p2 = ( d19cp2 + k20cp2*o3p(i) ) * n2
+               p21 = k21cp2*n2
+
+c radiative rates
+               ae1 = 1.3546 * 1.66 / 4.0 * escf1(i)
+               ae2 = ( 1.3452 + 1.1878 ) * 1.66 / 4.0 * escf2(i)
+               l1 = l1 + ae1
+               l2 = l2 + ae2
+
+c solving the system
+               c1 = gamma*nu1**3. * 0.5
+               c2 = gamma*nu2**3. * 0.5
+               a1 = c1 * p1 / (n1*l1)
+               a2 = c2 * p2 / (n2*l2)
+               a12 = (nu1/nu2)**3. * n2/n1 * p12/l1
+               a21 = (nu2/nu1)**3. * n1/n2 * p21/l2
+               el2 = (a2 + a21 * a1 ) / ( 1.0 - a21 * a12 )
+               el1 = a1 + a12 * el2
+               pl1 = el1 * n1 / c1
+               pl2 = el2 * n2 / c2
+
+c  heating rate
+               hr1 = - hplanck*vlight * nu1 * ae1 * pl1
+               hr2 = - hplanck*vlight * nu2 * ae2 * pl2
+               hr(i) = hr1 + hr2
+               dtnlte(j,i)=0.1*hr(i)*pt(j,i)/(4.4*pyy(i)) ! dtnlte in K s-1
+c              write(7,25)pxx(i),hr1,hr2,hr(i),qt
+c  25         format(' ',1p5e12.4)
+
+            endif
+
+         enddo  ! end loop over layers
+      enddo     ! end loop over grid points
+c     close(7)
+c
+        return
+        end
+
+c***********************************************************************
+
+      subroutine interp1(escout,p,nlayer,escin,pin,nl)
+C
+C subroutine to perform linear interpolation in pressure from 1D profile 
+C escin(nl) sampled on pressure grid pin(nl) to profile
+C escout(nlayer) on pressure grid p(nlayer).
+C
+      real escout(nlayer),p(nlayer)
+      real escin(nl),pin(nl),wm,wp
+      integer nl,nlayer,n1,n,nm,np
+      do n1=1,nlayer
+         if(p(n1) .gt. 3.5 .or. p(n1) .lt. 4.0e-6) then
+            escout(n1) = 0.0
+         else
+            do n = 1,nl-1
+               if (p(n1).le.pin(n).and.p(n1).ge.pin(n+1)) then
+                  nm=n
+                  np=n+1
+                  wm=abs(pin(np)-p(n1))/(pin(nm)-pin(np))
+                  wp=1.0 - wm
+               endif
+            enddo
+            escout(n1) = escin(nm)*wm + escin(np)*wp
+         endif
+      enddo
+      return
+      end
+
+c***********************************************************************
+
+      subroutine interp3(esco1,esco2,esco3,p,nlayer,
+     1     esci1,esci2,esci3,pin,nl)
+C
+C subroutine to perform 3 simultaneous linear interpolations in pressure from 
+C 1D profiles esci1-3(nl) sampled on pressure grid pin(nl) to 1D profiles 
+C esco1-3(nlayer) on pressure grid p(ngrid,nlayer).
+C
+      real esco1(nlayer),esco2(nlayer),esco3(nlayer),p(nlayer)
+      real esci1(nl),    esci2(nl),    esci3(nl),    pin(nl),wm,wp
+      integer nl,nlayer,n1,n,nm,np
+      do n1=1,nlayer
+         if (p(n1).gt. 3.5 .or. p(n1) .lt. 4.0e-6) then
+            esco1(n1)=0.0
+            esco2(n1)=0.0
+            esco3(n1)=0.0
+         else 
+            do n = 1,nl-1
+               if (p(n1).le.pin(n).and.p(n1).ge.pin(n+1)) then
+                  nm=n
+                  np=n+1
+                  wm=abs(pin(np)-p(n1))/(pin(nm)-pin(np))
+                  wp=1.0 - wm
+               endif
+            enddo
+            esco1(n1) = esci1(nm)*wm + esci1(np)*wp
+            esco2(n1) = esci2(nm)*wm + esci2(np)*wp
+            esco3(n1) = esci3(nm)*wm + esci3(np)*wp
+         endif
+      enddo
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nltedata.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nltedata.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nltedata.h	(revision 2744)
@@ -0,0 +1,166 @@
+c INCLUDE nlte_escape.h
+       !
+       ! Escape functions and VMRs from tabulated values.
+       ! Origin: nlte_escape.dat file form Miguel L.
+       ! (Y. Wanherdrick, 09/2000)
+
+       integer     np
+       parameter ( np = 68 )                ! # data points in tabulation
+       real        pnb(np)                  ! Pressure in tabulation
+       real        ef1(np)                  ! Esc.funct.#1, tabulated
+       real        ef2(np)                  ! Esc.funct.#2, tabulated
+       real        co2vmr(np)               ! CO2 VMR tabulated
+       real        o3pvmr(np)               ! CO2 VMR tabulated
+       real        n2covmr(np)              ! N2+CO VMR tabulated
+ 
+ 
+      DATA pnb/
+     &    12.0000,    11.0000,    10.8000,
+     &    10.6000,   10.40000,   10.20000,
+     &   10.00000,    9.80000,    9.60000,
+     &    9.40000,    9.20000,    9.00000,
+     &    8.80000,    8.60000,    8.40000,
+     &    8.20000,    8.00000,    7.80000,
+     &    7.60000,    7.40000,    7.20000,
+     &    7.00000,    6.80000,    6.60000,
+     &    6.40000,    6.20000,    6.00000,
+     &    5.80000,    5.60000,    5.40000,
+     &    5.20000,    5.00000,    4.80000,
+     &    4.60000,    4.40000,    4.20000,
+     &    4.00000,    3.80000,    3.60000,
+     &    3.40000,    3.20000,    3.00000,
+     &    2.80000,    2.60000,    2.40000,
+     &    2.20000,    2.00000,    1.80000,
+     &    1.60000,    1.40000,    1.20000,
+     &    1.00000,   0.800000,   0.599999,
+     &   0.400000,   0.200000,  0.,
+     &  -0.200000,  -0.400001,  -0.600000,
+     &  -0.800000,   -1.00000,   -1.20000,
+     &   -1.40000,   -1.60000,   -1.80000,
+     &   -2.00000,   -3.00000/
+ 
+      DATA ef1/
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.61707E-04,    4.76886E-04,
+     &    4.95638E-04,    5.20935E-04,    5.55511E-04,
+     &    6.01219E-04,    6.63734E-04,    7.50691E-04,
+     &    8.63474E-04,    1.00900E-03,    1.19642E-03,
+     &    1.42690E-03,    1.71398E-03,    2.06663E-03,
+     &    2.48974E-03,    3.01578E-03,    3.64350E-03,
+     &    4.40323E-03,    5.32066E-03,    6.40456E-03,
+     &    7.72069E-03,    9.25684E-03,    1.10905E-02,
+     &    1.32374E-02,    1.57643E-02,    1.87388E-02,
+     &    2.22072E-02,    2.63099E-02,    3.10614E-02,
+     &    3.66948E-02,    4.32373E-02,    5.15022E-02,
+     &    6.21455E-02,    7.77212E-02,    9.92027E-02,
+     &   0.131155,   0.179470,   0.258913,
+     &   0.380549,   0.530450,   0.643180,
+     &   0.741061,   0.826336,   0.922787,
+     &   0.997203,    1.00000/
+ 
+      DATA ef2/
+     &    1.98992E-03,    1.98992E-03,    1.98992E-03,
+     &    1.98992E-03,    1.98992E-03,    1.98992E-03,
+     &    1.98992E-03,    1.98992E-03,    1.98992E-03,
+     &    1.98992E-03,    1.98992E-03,    2.01376E-03,
+     &    2.09450E-03,    2.22993E-03,    2.42056E-03,
+     &    2.68018E-03,    3.04398E-03,    3.43896E-03,
+     &    3.80282E-03,    4.20622E-03,    4.76121E-03,
+     &    8.01698E-03,    1.19947E-02,    1.69149E-02,
+     &    2.24497E-02,    2.85244E-02,    3.54813E-02,
+     &    4.39264E-02,    5.46248E-02,    6.75367E-02,
+     &    8.29931E-02,    1.01717E-01,   0.123422,
+     &   0.148468,   0.177096,   0.208816,
+     &   0.244003,   0.282013,   0.322559,
+     &   0.365542,   0.410518,   0.457384,
+     &   0.505358,   0.553627,   0.600472,
+     &   0.644807,   0.687185,   0.727429,
+     &   0.764734,   0.798562,   0.828699,
+     &   0.854797,   0.877717,   0.897874,
+     &   0.915258,   0.929904,   0.942381,
+     &   0.952906,   0.962173,   0.970191,
+     &   0.976437,   0.981501,   0.985406,
+     &   0.988560,   0.991111,   0.993653,
+     &   0.995561,    1.00000/
+ 
+      DATA co2vmr/
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.949619,   0.947694,   0.945830,
+     &   0.944016,   0.940557,   0.937068,
+     &   0.932366,   0.893661/
+ 
+      DATA o3pvmr/
+     &    5.06756E-08,    9.16539E-07,    1.68217E-06,
+     &    3.00843E-06,    5.03151E-06,    8.07489E-06,
+     &    1.23137E-05,    1.79029E-05,    2.45308E-05,
+     &    3.27431E-05,    4.26692E-05,    5.44396E-05,
+     &    6.78865E-05,    8.33147E-05,    1.00148E-04,
+     &    1.18846E-04,    1.39681E-04,    1.64909E-04,
+     &    1.93617E-04,    2.25161E-04,    2.60834E-04,
+     &    3.01501E-04,    3.44953E-04,    3.91011E-04,
+     &    4.40377E-04,    4.90820E-04,    5.43200E-04,
+     &    5.95335E-04,    6.45420E-04,    6.93166E-04,
+     &    7.43729E-04,    7.93710E-04,    8.44394E-04,
+     &    8.94318E-04,    9.44732E-04,    9.94964E-04,
+     &    1.04901E-03,    1.10008E-03,    1.16302E-03,
+     &    1.22989E-03,    1.30026E-03,    1.37131E-03,
+     &    1.45556E-03,    1.55186E-03,    1.66328E-03,
+     &    1.77802E-03,    1.91546E-03,    2.07503E-03,
+     &    2.24903E-03,    2.47117E-03,    2.71728E-03,
+     &    2.99739E-03,    3.33582E-03,    3.73507E-03,
+     &    4.20819E-03,    4.76887E-03,    5.42558E-03,
+     &    6.20815E-03,    7.14473E-03,    8.28545E-03,
+     &    9.51779E-03,    1.08140E-02,    1.22359E-02,
+     &    1.36870E-02,    1.51495E-02,    1.67196E-02,
+     &    1.85485E-02,    3.36252E-02/
+ 
+      DATA n2covmr/
+     &    2.71412E-02,    2.71464E-02,    2.71490E-02,
+     &    2.71523E-02,    2.71558E-02,    2.71617E-02,
+     &    2.71672E-02,    2.71749E-02,    2.71837E-02,
+     &    2.71943E-02,    2.72058E-02,    2.72189E-02,
+     &    2.72326E-02,    2.72483E-02,    2.72661E-02,
+     &    2.72848E-02,    2.73054E-02,    2.73279E-02,
+     &    2.73514E-02,    2.73775E-02,    2.74048E-02,
+     &    2.74345E-02,    2.74672E-02,    2.75021E-02,
+     &    2.75404E-02,    2.75826E-02,    2.76340E-02,
+     &    2.77013E-02,    2.78220E-02,    2.79707E-02,
+     &    2.81759E-02,    2.84339E-02,    2.87587E-02,
+     &    2.91600E-02,    2.96561E-02,    3.02558E-02,
+     &    3.09922E-02,    3.18062E-02,    3.27010E-02,
+     &    3.35635E-02,    3.44388E-02,    3.53327E-02,
+     &    3.62143E-02,    3.70941E-02,    3.79315E-02,
+     &    3.87626E-02,    3.95524E-02,    4.03071E-02,
+     &    4.10071E-02,    4.16229E-02,    4.21231E-02,
+     &    4.25167E-02,    4.27964E-02,    4.29773E-02,
+     &    4.30488E-02,    4.29638E-02,    4.28049E-02,
+     &    4.26788E-02,    4.26822E-02,    4.29426E-02,
+     &    4.34634E-02,    4.42559E-02,    4.53038E-02,
+     &    4.65879E-02,    4.80262E-02,    4.96303E-02,
+     &    5.14885E-02,    6.91651E-02/
+ 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nlteparams.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nlteparams.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nlteparams.h	(revision 2744)
@@ -0,0 +1,18 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'nlteparams.h'
+c
+c   Parameters which govern the transition from LTE to NLTE radiation
+c   tendencies.
+c-----------------------------------------------------------------------
+
+      real ptrans           ! central pressure for transition (Pa)
+      parameter (ptrans = 0.1)
+      real zw               ! half-width for transition (scale heights)
+      parameter (zw = 0.5)
+      real pminte           ! pressure up to which LTE is calculated (Pa)
+      parameter (pminte = 0.4*ptrans)
+c     almost one scale height above transition in worst case is very safe
+      real zwi
+      parameter (zwi = 2./zw)
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nlthermeq.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nlthermeq.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/nlthermeq.F	(revision 2744)
@@ -0,0 +1,58 @@
+      subroutine nlthermeq(ngrid, nlayer, pplev, pplay)
+c
+c  Compute the number of layers nlaylte (stored in common yomlw.h)
+c  over which local thermodynamic equilibrium
+c  radiation scheme should be run to be sure of covering at least to a
+c  height greater than (pressure lower than) p=pminte, set in nlteparams.h.
+c  The maximum layer needed is found for the worst possible case.
+c  Stephen Lewis 6/2000
+c  Modified Y. Wanherdrick/ F. Forget 09/2000
+
+      implicit none
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "nlteparams.h"
+#include "yomlw.h"
+#include "callkeys.h"
+
+c
+c     Input:
+      integer ngrid, nlayer
+      real pplev(ngrid, nlayer+1)
+      real pplay(ngrid, nlayer)
+c
+c     Local:
+      integer igpmax, ismax
+      logical firstcall
+      data firstcall /.true./
+      save firstcall, igpmax
+c
+      if(firstcall) then
+c     Find the location of maximum surface pressure.
+c     Location won't vary much so only do it at the start;
+c     with no topography location would vary, but this is only
+c     needed for an estimate so any point would do in that case.
+         igpmax = ismax(ngrid, pplev, 1)
+         write(*, 10) ptrans
+         write(*, 20) zw
+         write(*, 30) pminte
+         firstcall = .false.
+      endif
+c
+      IF(callnlte) then
+c       Find first layer above pminte at this location
+        do nlaylte = nlayer, 1, -1
+           if (pplay(igpmax, nlaylte).gt.pminte)  go to 100
+        enddo
+      ELSE
+        nlaylte=nlayer
+      END IF
+  100 write(*,*) 'LTE rad. calculations up to layer ',  nlaylte
+c
+      return
+c
+   10 format(' nlthermeq: transition to NLTE centred at ',f6.2,'Pa')
+   20 format('               half-width (scale heights) ',f6.2)
+   30 format('          suggested LTE coverage at least ',f6.2,'Pa')
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/orbite.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/orbite.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/orbite.F	(revision 2744)
@@ -0,0 +1,63 @@
+      SUBROUTINE orbite(pls,pdist_sol,pdecli)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Objet:
+c   ------
+c
+c   Distance from sun and declimation as a function of the solar
+c   longitude Ls
+c
+c   Interface:
+c   ----------
+c
+c
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   pls          Ls
+c
+c   Output:
+c   -------
+c   pdist_sol     Distance Sun-Planet in UA
+c   pdecli        declinaison ( en radians )
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c arguments:
+c ----------
+
+      REAL pday,pdist_sol,pdecli,pls,i
+
+c-----------------------------------------------------------------------
+
+c Distance Sun-Planet
+
+      pdist_sol=p_elips/(1.+e_elips*cos(pls+timeperi))
+
+c Solar declination
+
+c ********************* version before 01/01/2000 *******
+
+      pdecli= asin (sin(pls)*sin(obliquit*pi/180.))
+
+c ********************* version after 01/01/2000 *******
+c     i=obliquit*pi/180.
+c     pdecli=asin(sin(pls)*sin(i)/sqrt(sin(pls)**2+
+c    & cos(pls)**2*cos(i)**2))
+c ******************************************************
+
+
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/orodrag.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/orodrag.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/orodrag.F	(revision 2744)
@@ -0,0 +1,286 @@
+      SUBROUTINE ORODRAG( klon,klev 
+     I                 , KGWD, KGWDIM, KDX, KTEST
+     R                 , PTSPHY
+     R                 , PAPHM1,PAPM1,PGEOM1,PTM1,PUM1
+     R                 , PVM1, PVAROR, PSIG, PGAMMA, PTHETA
+C OUTPUTS
+     R                 , PULOW,PVLOW
+     R                 , PVOM,PVOL,PTE )
+C
+C
+C**** *ORODRAG* - DOES THE GRAVITY WAVE PARAMETRIZATION.
+C
+C     PURPOSE.
+C     --------
+C
+C          THIS ROUTINE COMPUTES THE PHYSICAL TENDENCIES OF THE
+C          PROGNOSTIC VARIABLES U,V  AND T DUE TO  VERTICAL TRANSPORTS BY
+C          SUBGRIDSCALE OROGRAPHICALLY EXCITED GRAVITY WAVES
+C
+C     EXPLICIT ARGUMENTS :
+C     --------------------
+C
+C     INPUT :
+C
+C     NLON               : NUMBER OF HORIZONTAL GRID POINTS
+C     NLEV               : NUMBER OF LEVELS
+C     KGWD               : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KGWDIM             : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KDX(NLON)          : POINTS AT WHICH TO CALL THE SCHEME
+C     KTEST(NLON)        : MAP OF CALLING POINTS
+C     PTSPHY             : LENGTH OF TIME STEP
+C     PAPHM1(NLON,NLEV+1): PRESSURE AT MIDDLE LEVELS
+C     PAPM1(NLON,NLEV)   : PRESSURE ON MODEL LEVELS
+C     PGEOM1(NLON,NLEV)  : GEOPOTENTIAL HIEGHT OF MODEL LEVELS
+C     PTM1(NLON,NLEV)    : TEMPERATURE
+C     PUM1(NLON,NLEV)    : ZONAL WIND
+C     PVM1(NLON,NLEV)    : MERIDIONAL WIND
+C     PVAROR(NLON)       : SUB-GRID SCALE STANDARD DEVIATION
+C     PSIG(NLON)         : SUB-GRID SCALE SLOPE
+C     PGAMMA(NLON)       : SUB-GRID SCALE ANISOTROPY
+C     PTHETA(NLON)       : SUB-GRID SCALE PRINCIPAL AXES ANGLE
+C
+C     OUTPUT :
+C
+C     PULOW(NLON)        : LOW LEVEL ZONAL WIND
+C     PVLOW(NLON)        : LOW LEVEL MERIDIONAL WIND
+C     PVOM(NLON,NLEV)    : ZONAL WIND TENDENCY
+C     PVOL(NLON,NLEV)    : MERIDIONAL WIND TENDENCY
+C     PTE(NLON,NLEV)     : TEMPERATURE TENDENCY
+C
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C
+C     comcstfi.h
+C     dimphys.h
+C     yoegwd.h
+C
+C     METHOD.
+C     -------
+C
+C     EXTERNALS.
+C     ----------
+C
+C     REFERENCE.
+C     ----------
+C
+C     AUTHOR.
+C     -------
+C     M.MILLER + B.RITTER   E.C.M.W.F.     15/06/86.
+C
+C     F.LOTT + M. MILLER    E.C.M.W.F.     22/11/94
+C-----------------------------------------------------------------------
+      implicit none
+C
+C
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+      parameter(kidia=1,kfdia=NDLO2)
+
+#include "comcstfi.h"
+#include "yoegwd.h"
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+C
+      REAL  PTE(NDLO2,klev),
+     *      PVOL(NDLO2,klev),
+     *      PVOM(NDLO2,klev),
+     *      PULOW(NDLO2),
+     *      PVLOW(NDLO2)
+      REAL  PUM1(NDLO2,klev),
+     *      PVM1(NDLO2,klev),
+     *      PTM1(NDLO2,klev),
+     *      PVAROR(NDLO2),PSIG(NDLO2),PGAMMA(NDLO2),PTHETA(NDLO2),
+     *      PGEOM1(NDLO2,klev),
+     *      PAPM1(NDLO2,klev),
+     *      PAPHM1(NDLO2,klev+1)
+C
+      integer kgwd,kgwdim
+      real ptsphy
+      INTEGER  KDX(NDLO2),KTEST(NDLO2)
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+      INTEGER  ISECT(NDLO2),
+     *         ICRIT(NDLO2),
+     *         IKCRITH(NDLO2),
+     *         IKenvh(NDLO2),
+     *         IKNU(NDLO2),
+     *         IKNU2(NDLO2),
+     *         IKCRIT(NDLO2),
+     *         IKHLIM(NDLO2)
+      integer ji,jk,jl,klevm1,ilevp1
+C      real gkwake
+      real ztmst,pvar,ztauf,zrtmst,zdelp,zb,zc,zbet
+      real zconb,zabsv,zzd1,ratio,zust,zvst,zdis,ztemp
+C
+      REAL   ZTAU(NDLO2,nlayermx+1),
+     *       ZSTAB(NDLO2,nlayermx+1),
+     *       ZVPH(NDLO2,nlayermx+1),
+     *       ZRHO(NDLO2,nlayermx+1),
+     *       ZRI(NDLO2,nlayermx+1),
+     *       ZpsI(NDLO2,nlayermx+1),
+     *       Zzdep(NDLO2,nlayermx)
+      REAL   ZDUDT(NDLO2),
+     *       ZDVDT(NDLO2),
+     *       ZDTDT(NDLO2),
+     *       ZDEDT(NDLO2),
+     *       ZVIDIS(NDLO2),
+     *       ZTFR(NDLO2),
+     *       Znu(NDLO2),
+     *       Zd1(NDLO2),
+     *       Zd2(NDLO2),
+     *       Zdmod(NDLO2)
+C
+C------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+ 100  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         1.1   COMPUTATIONAL CONSTANTS
+C                -----------------------
+C
+ 110  CONTINUE
+C
+c     ZTMST=TWODT
+c     IF(NSTEP.EQ.NSTART) ZTMST=0.5*TWODT
+      KLEVM1=KLEV-1
+      ZTMST=PTSPHY
+      ZRTMST=1./ZTMST
+C     ------------------------------------------------------------------
+C
+ 120  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         1.3   CHECK WHETHER ROW CONTAINS POINT FOR PRINTING
+C                ---------------------------------------------
+C
+ 130  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         2.     PRECOMPUTE BASIC STATE VARIABLES.
+C*                ---------- ----- ----- ----------
+C*                DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
+C*                LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
+C*                THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
+C
+  200 CONTINUE
+C
+C
+C
+      CALL OROSETUP
+     *     ( klon, klev , KTEST 
+     *     , IKCRIT, IKCRITH, ICRIT, ISECT, IKHLIM, ikenvh,IKNU,iknu2
+     *     , PAPHM1, PAPM1 , PUM1   , PVM1 , PTM1 , PGEOM1, pvaror
+     *     , ZRHO  , ZRI   , ZSTAB  , ZTAU , ZVPH , zpsi, zzdep
+     *     , PULOW, PVLOW 
+     *     , ptheta,pgamma,znu  ,zd1,  zd2,  zdmod                )
+C
+C
+C
+C***********************************************************
+C
+C
+C*         3.      COMPUTE LOW LEVEL STRESSES USING SUBCRITICAL AND
+C*                 SUPERCRITICAL FORMS.COMPUTES ANISOTROPY COEFFICIENT
+C*                 AS MEASURE OF OROGRAPHIC TWODIMENSIONALITY.
+C
+  300 CONTINUE
+C
+      CALL GWSTRESS
+     *    ( klon  , klev
+     *    , IKCRIT, ISECT, IKHLIM, KTEST, IKCRITH, ICRIT, ikenvh, IKNU
+     *    , ZRHO  , ZSTAB, ZVPH  , PVAR , pvaror,  psig
+     *    , ZTFR   , ZTAU 
+     *    , pgeom1,pgamma,zd1,zd2,zdmod,znu)
+C
+C*         4.      COMPUTE STRESS PROFILE.
+C*                 ------- ------ --------
+C
+  400 CONTINUE
+C
+C
+      CALL GWPROFIL
+     *       (  klon , klev
+     *       , kgwd   , kdx  , KTEST
+     *       , IKCRIT, IKCRITH, ICRIT  , ikenvh, IKNU
+     *       ,iknu2 , pAPHM1, ZRHO   , ZSTAB , ZTFR   , ZVPH
+     *       , ZRI   , ZTAU   , ztauf
+     *       , zdmod , znu    , psig  , pgamma , pvaror   )
+C
+C
+C*         5.      COMPUTE TENDENCIES.
+C*                 -------------------
+C
+  500 CONTINUE
+C
+C  EXPLICIT SOLUTION AT ALL LEVELS FOR THE GRAVITY WAVE
+C  IMPLICIT SOLUTION FOR THE BLOCKED LEVELS
+
+      DO 510 JL=KIDIA,KFDIA
+      ZVIDIS(JL)=0.0
+      ZDUDT(JL)=0.0
+      ZDVDT(JL)=0.0
+      ZDTDT(JL)=0.0
+  510 CONTINUE
+C
+      ILEVP1=KLEV+1
+C
+C
+      DO 524 JK=1,klev
+C
+CDIR$ IVDEP
+C
+C      GKWAKE=0.5
+C
+C     NOW SET IN SUGWD.F
+C
+      DO 523 JL=1,KGWD
+      JI=KDX(JL)
+      ZDELP=pAPHM1(Ji,JK+1)-pAPHM1(Ji,JK)
+      ZTEMP=-g*(ZTAU(Ji,JK+1)-ZTAU(Ji,JK))/(ZVPH(Ji,ILEVP1)*ZDELP)
+      ZDUDT(JI)=(PULOW(JI)*Zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji)
+      ZDVDT(JI)=(pvLOW(JI)*Zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji)
+      if(jk.ge.ikenvh(ji)) then
+         zb=1.0-0.18*pgamma(ji)-0.04*pgamma(ji)**2
+         zc=0.48*pgamma(ji)+0.3*pgamma(ji)**2
+         zconb=2.*ztmst*GKWAKE*psig(ji)/(4.*pvaror(ji))
+         zabsv=sqrt(PUM1(JI,JK)**2+PVM1(JI,JK)**2)/2.
+         zzd1=zb*cos(zpsi(ji,jk))**2+zc*sin(zpsi(ji,jk))**2
+         ratio=(cos(zpsi(ji,jk))**2+pgamma(ji)*sin(zpsi(ji,jk))**2)/
+     *   (pgamma(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2)
+         zbet=max(0.,2.-1./ratio)*zconb*zzdep(ji,jk)*zzd1*zabsv
+         zdudt(ji)=-pum1(ji,jk)/ztmst
+         zdvdt(ji)=-pvm1(ji,jk)/ztmst
+         zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet))
+         zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet))
+      end if
+      PVOM(JI,JK)=ZDUDT(JI)
+      PVOL(JI,JK)=ZDVDT(JI)
+      ZUST=PUM1(JI,JK)+ZTMST*ZDUDT(JI)
+      ZVST=PVM1(JI,JK)+ZTMST*ZDVDT(JI)
+      ZDIS=0.5*(PUM1(JI,JK)**2+PVM1(JI,JK)**2-ZUST**2-ZVST**2)
+      ZDEDT(JI)=ZDIS/ZTMST
+      ZVIDIS(JI)=ZVIDIS(JI)+ZDIS*ZDELP
+      ZDTDT(JI)=ZDEDT(JI)/cpp
+      PTE(JI,JK)=ZDTDT(JI)
+
+  523 CONTINUE
+
+  524 CONTINUE
+C
+C
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/orosetup.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/orosetup.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/orosetup.F	(revision 2744)
@@ -0,0 +1,498 @@
+      SUBROUTINE OROSETUP
+     *         ( klon   , klev  , KTEST
+     *         , KKCRIT, KKCRITH, KCRIT, KSECT , KKHLIM
+     *         , kkenvh, kknu  , kknu2
+     *         , PAPHM1, PAPM1 , PUM1   , PVM1 , PTM1  , PGEOM1, pvaror
+     *         , PRHO  , PRI   , PSTAB  , PTAU , PVPH  ,ppsi, pzdep
+     *         , PULOW , PVLOW  
+     *         , Ptheta, pgamma,  pnu  ,  pd1  ,  pd2  ,pdmod  )
+C
+C**** *GWSETUP*
+C
+C     PURPOSE.
+C     --------
+C
+C**   INTERFACE.
+C     ----------
+C          FROM *ORODRAG*
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS ===
+C     ==== OUTPUTS ===
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C
+C     EXTERNALS.
+C     ----------
+C
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
+C
+C     AUTHOR.
+C     -------
+C
+C     MODIFICATIONS.
+C     --------------
+C     F.LOTT  FOR THE NEW-GWDRAG SCHEME NOVEMBER 1993
+C
+C-----------------------------------------------------------------------
+      implicit none
+C
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+
+#include "comcstfi.h"
+#include "yoegwd.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      INTEGER KKCRIT(NDLO2),KKCRITH(NDLO2),KCRIT(NDLO2),KSECT(NDLO2),
+     *        KKHLIM(NDLO2),KTEST(NDLO2),kkenvh(NDLO2)
+
+C
+      REAL PAPHM1(NDLO2,KLEV+1),PAPM1(NDLO2,KLEV),PUM1(NDLO2,KLEV),
+     *     PVM1(NDLO2,KLEV),PTM1(NDLO2,KLEV),PGEOM1(NDLO2,KLEV),
+     *     PRHO(NDLO2,KLEV+1),PRI(NDLO2,KLEV+1),PSTAB(NDLO2,KLEV+1),
+     *     PTAU(NDLO2,KLEV+1),PVPH(NDLO2,KLEV+1),ppsi(NDLO2,klev+1),
+     *     pzdep(NDLO2,klev)
+       REAL PULOW(NDLO2),PVLOW(NDLO2),ptheta(NDLO2),pgamma(NDLO2),
+     *     pnu(NDLO2),
+     *     pd1(NDLO2),pd2(NDLO2),pdmod(NDLO2)
+      real pvaror(NDLO2)
+C
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+C
+C
+      LOGICAL LL1(NDLO2,nlayermx+1)
+      integer kknu(NDLO2),kknu2(NDLO2),kknub(NDLO2),kknul(NDLO2),
+     *        kentp(NDLO2),ncount(NDLO2)  
+C
+      REAL ZHCRIT(NDLO2,nlayermx),ZNCRIT(NDLO2,nlayermx),
+     *     ZVPF(NDLO2,nlayermx), ZDP(NDLO2,nlayermx)
+      REAL ZNORM(NDLO2),zpsi(NDLO2),zb(NDLO2),zc(NDLO2),
+     *      zulow(NDLO2),zvlow(NDLO2),znup(NDLO2),znum(NDLO2)
+C
+c   declarations pour "implicit none"
+      integer jk,jl,ilevm1,ilevm2,ilevh
+      real zu,zphi,zcons1,zcons2,zcons3,zwind,zdwind,zhgeo
+      real zvt1,zvt2,zst,zvar,zdelp,zstabm,zstabp,zrhom,zrhop
+      real alpha,zggeenv,zggeom1,zgvar
+      logical lo
+
+C     ------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+c     print *,' entree gwsetup'
+ 100  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         1.1   COMPUTATIONAL CONSTANTS
+C                -----------------------
+C
+
+      kidia=1
+	  kfdia=klon
+
+ 110  CONTINUE
+C
+      ILEVM1=KLEV-1
+      ILEVM2=KLEV-2
+      ILEVH =KLEV/3
+C
+      ZCONS1=1./r
+cold  ZCONS2=G**2/CPD
+      ZCONS2=g**2/cpp
+cold  ZCONS3=1.5*API
+      ZCONS3=1.5*PI
+C
+C
+C     ------------------------------------------------------------------
+C
+C*         2.
+C                --------------
+C
+ 200  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         2.1     DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
+C*                 LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
+C*                 THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
+C
+C
+C
+      DO 2001 JL=kidia,kfdia
+      kknu(JL)    =klev
+      kknu2(JL)   =klev
+      kknub(JL)   =klev
+      kknul(JL)   =klev
+      pgamma(JL) =max(pgamma(jl),gtsec)
+      ll1(jl,klev+1)=.false.
+ 2001 CONTINUE
+C
+C*      DEFINE TOP OF LOW LEVEL FLOW
+C       ----------------------------
+      DO 2002 JK=KLEV,ilevh,-1
+      DO 2003 JL=kidia,kfdia
+      LO=(PAPHM1(JL,JK)/PAPHM1(JL,KLEV+1)).GE.GSIGCR
+      IF(LO) THEN
+        KKCRIT(JL)=JK
+      ENDIF
+      ZHCRIT(JL,JK)=4.*pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+cccccc g95: XOR does not exist in Fortran  
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknu(JL)=JK
+      ENDIF
+ 2003 CONTINUE
+ 2002 CONTINUE
+      DO 2004 JK=KLEV,ilevh,-1
+      DO 2005 JL=kidia,kfdia
+      ZHCRIT(JL,JK)=3.*pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+cccccc g95: XOR does not exist in Fortran
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknu2(JL)=JK
+      ENDIF
+ 2005 CONTINUE
+ 2004 CONTINUE
+      DO 2006 JK=KLEV,ilevh,-1
+      DO 2007 JL=kidia,kfdia
+      ZHCRIT(JL,JK)=2.*pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+cccccc g95: XOR does not exist in Fortran
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknub(JL)=JK
+      ENDIF
+ 2007 CONTINUE
+ 2006 CONTINUE
+      DO 2008 JK=KLEV,ilevh,-1
+      DO 2009 JL=kidia,kfdia
+      ZHCRIT(JL,JK)=pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+cccccc g95: XOR does not exist in Fortran
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknul(JL)=JK
+      ENDIF
+ 2009 CONTINUE
+ 2008 CONTINUE
+C
+      do 2010 jl=kidia,kfdia  
+      kknu(jl)=min(kknu(jl),nktopg)
+      kknub(jl)=min(kknub(jl),nktopg)
+      if(kknub(jl).eq.nktopg) kknul(jl)=klev
+C
+C     CHANGE IN HERE TO STOP KKNUL=KKNUB
+C
+      if(kknul(jl).le.kknub(jl)) kknul(jl)=nktopg
+ 2010 continue      
+C
+
+ 210  CONTINUE
+C
+C
+CC*     INITIALIZE VARIOUS ARRAYS
+C
+      DO 2107 JL=kidia,kfdia
+      PRHO(JL,KLEV+1)  =0.0
+      PSTAB(JL,KLEV+1) =0.0
+      PSTAB(JL,1)      =0.0
+      PRI(JL,KLEV+1)   =9999.0
+      ppsi(JL,KLEV+1)  =0.0
+      PRI(JL,1)        =0.0
+      PVPH(JL,1)       =0.0
+      PULOW(JL)        =0.0
+      PVLOW(JL)        =0.0
+      zulow(JL)        =0.0
+      zvlow(JL)        =0.0
+      KKCRITH(JL)      =KLEV
+      KKenvH(JL)       =KLEV
+      Kentp(JL)        =KLEV
+      KCRIT(JL)        =1
+      ncount(JL)       =0
+      ll1(JL,klev+1)   =.false.
+ 2107 CONTINUE
+C
+C*     DEFINE LOW-LEVEL FLOW
+C      ---------------------
+C
+      DO 223 JK=KLEV,2,-1
+      DO 222 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+        ZDP(JL,JK)=PAPM1(JL,JK)-PAPM1(JL,JK-1)
+        PRHO(JL,JK)=2.*PAPHM1(JL,JK)*ZCONS1/(PTM1(JL,JK)+PTM1(JL,JK-1))
+        PSTAB(JL,JK)=2.*ZCONS2/(PTM1(JL,JK)+PTM1(JL,JK-1))*
+     *  (1.-cpp*PRHO(JL,JK)*(PTM1(JL,JK)-PTM1(JL,JK-1))/ZDP(JL,JK))
+        PSTAB(JL,JK)=MAX(PSTAB(JL,JK),GSSEC)
+      ENDIF
+  222 CONTINUE
+  223 CONTINUE
+C
+C********************************************************************
+C
+C*     DEFINE blocked FLOW
+C      -------------------
+      DO 2115 JK=klev,ilevh,-1
+      DO 2116 JL=kidia,kfdia
+      if(jk.ge.kknub(jl).and.jk.le.kknul(jl)) then
+        pulow(JL)=pulow(JL)+PUM1(JL,JK)*(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
+        pvlow(JL)=pvlow(JL)+PVM1(JL,JK)*(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
+      end if
+ 2116 CONTINUE
+ 2115 CONTINUE
+      DO 2110 JL=kidia,kfdia
+      pulow(JL)=pulow(JL)/(PAPHM1(JL,Kknul(jl)+1)-PAPHM1(JL,kknub(jl)))
+      pvlow(JL)=pvlow(JL)/(PAPHM1(JL,Kknul(jl)+1)-PAPHM1(JL,kknub(jl)))
+      ZNORM(JL)=MAX(SQRT(PULOW(JL)**2+PVLOW(JL)**2),GVSEC)
+      PVPH(JL,KLEV+1)=ZNORM(JL)
+ 2110 CONTINUE
+C
+C*******  SETUP OROGRAPHY AXES AND DEFINE PLANE OF PROFILES  *******
+C
+      DO 2112 JL=kidia,kfdia
+      LO=(PULOW(JL).LT.GVSEC).AND.(PULOW(JL).GE.-GVSEC)
+      IF(LO) THEN
+        ZU=PULOW(JL)+2.*GVSEC
+      ELSE
+        ZU=PULOW(JL)
+      ENDIF
+      Zphi=ATAN(PVLOW(JL)/ZU)
+      ppsi(jl,klev+1)=ptheta(jl)*pi/180.-zphi
+      zb(jl)=1.-0.18*pgamma(jl)-0.04*pgamma(jl)**2
+      zc(jl)=0.48*pgamma(jl)+0.3*pgamma(jl)**2
+      pd1(jl)=zb(jl)-(zb(jl)-zc(jl))*(sin(ppsi(jl,klev+1))**2)
+      pd2(jl)=(zb(jl)-zc(jl))*sin(ppsi(jl,klev+1))*cos(ppsi(jl,klev+1))
+      pdmod(jl)=sqrt(pd1(jl)**2+pd2(jl)**2)
+ 2112 CONTINUE
+C
+C  ************ DEFINE FLOW IN PLANE OF LOWLEVEL STRESS *************
+C
+      DO 213 JK=1,KLEV
+      DO 212 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1)  THEN
+        ZVt1       =PULOW(JL)*PUM1(JL,JK)+PVLOW(JL)*PVM1(JL,JK)
+        ZVt2       =-PvLOW(JL)*PUM1(JL,JK)+PuLOW(JL)*PVM1(JL,JK)
+        ZVPF(JL,JK)=(zvt1*pd1(jl)+zvt2*pd2(JL))/(znorm(jl)*pdmod(jl))
+      ENDIF
+      PTAU(JL,JK)  =0.0
+      Pzdep(JL,JK) =0.0
+      Ppsi(JL,JK)  =0.0
+      ll1(JL,JK)   =.FALSE.
+  212 CONTINUE
+  213 CONTINUE
+      DO 215 JK=2,KLEV
+      DO 214 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+        ZDP(JL,JK)=PAPM1(JL,JK)-PAPM1(JL,JK-1)
+        PVPH(JL,JK)=((PAPHM1(JL,JK)-PAPM1(JL,JK-1))*ZVPF(JL,JK)+
+     *            (PAPM1(JL,JK)-PAPHM1(JL,JK))*ZVPF(JL,JK-1))
+     *            /ZDP(JL,JK)
+        IF(PVPH(JL,JK).LT.GVSEC) THEN
+          PVPH(JL,JK)=GVSEC
+          KCRIT(JL)=JK
+        ENDIF
+      ENDIF
+  214 CONTINUE
+  215 CONTINUE
+C
+C
+C*         2.2     BRUNT-VAISALA FREQUENCY AND DENSITY AT HALF LEVELS.
+C
+  220 CONTINUE
+C
+      DO 2211 JK=ilevh,KLEV
+      DO 221 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+      IF(jk.ge.(kknub(jl)+1).and.jk.le.kknul(jl)) THEN
+           ZST=ZCONS2/PTM1(JL,JK)*(1.-cpp*PRHO(JL,JK)*
+     *                   (PTM1(JL,JK)-PTM1(JL,JK-1))/ZDP(JL,JK))
+           PSTAB(JL,KLEV+1)=PSTAB(JL,KLEV+1)+ZST*ZDP(JL,JK)
+           PSTAB(JL,KLEV+1)=MAX(PSTAB(JL,KLEV+1),GSSEC)
+           PRHO(JL,KLEV+1)=PRHO(JL,KLEV+1)+PAPHM1(JL,JK)*2.*ZDP(JL,JK)
+     *                   *ZCONS1/(PTM1(JL,JK)+PTM1(JL,JK-1))
+      ENDIF
+      ENDIF
+  221 CONTINUE
+ 2211 CONTINUE
+C
+      DO 2212 JL=kidia,kfdia
+C*****************************************************************************
+C
+C     O.K. THERE IS A POSSIBLE PROBLEM HERE. IF KKNUL=KKNUB THEN
+C     DIVISION BY ZERO OCCURS. I HAVE PUT A FIX IN HERE BUT WILL ASK FRANCOIS 
+C     LOTT ABOUT IT IN PARIS.
+C
+C     MAT COLLINS 30.1.96
+C
+C     ALSO IF THIS IS THE CASE PSTAB AND PRHO ARE NOT DEFINED AT KLEV+1
+C     SO I HAVE ADDED THE ELSE
+C
+C*****************************************************************************
+      IF (KKNUL(JL).NE.KKNUB(JL)) THEN
+        PSTAB(JL,KLEV+1)=PSTAB(JL,KLEV+1)/(PAPM1(JL,Kknul(jl))
+     *                                          -PAPM1(JL,kknub(jl)))
+        PRHO(JL,KLEV+1)=PRHO(JL,KLEV+1)/(PAPM1(JL,Kknul(jl))
+     *                                          -PAPM1(JL,kknub(jl)))
+      ELSE
+      WRITE(*,*) 'KKNUB=KKNUL= ',KKNUB(JL),' AT JL= ',JL
+        PSTAB(JL,KLEV+1)=PSTAB(JL,KLEV)
+        PRHO(JL,KLEV+1)=PRHO(JL,KLEV)
+      ENDIF
+        ZVAR=PVARor(JL)
+ 2212 CONTINUE
+C
+C*         2.3     MEAN FLOW RICHARDSON NUMBER.
+C*                 AND CRITICAL HEIGHT FOR FROUDE LAYER
+C
+  230 CONTINUE
+C
+      DO 232 JK=2,KLEV
+      DO 231 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+        ZDWIND=MAX(ABS(ZVPF(JL,JK)-ZVPF(JL,JK-1)),GVSEC)
+        PRI(JL,JK)=PSTAB(JL,JK)*(ZDP(JL,JK)
+     *          /(g*PRHO(JL,JK)*ZDWIND))**2
+        PRI(JL,JK)=MAX(PRI(JL,JK),GRCRIT)
+      ENDIF
+  231 CONTINUE
+  232 CONTINUE
+C
+C
+C*      DEFINE TOP OF 'envelope' layer
+C       ----------------------------
+
+      DO 233 JL=kidia,kfdia
+      pnu (jl)=0.0
+      znum(jl)=0.0
+ 233  CONTINUE
+      
+      DO 234 JK=2,KLEV-1
+      DO 234 JL=kidia,kfdia
+      
+      IF(KTEST(JL).EQ.1) THEN
+       
+      IF (JK.GE.KKNU2(JL)) THEN
+          
+            ZNUM(JL)=PNU(JL)
+            ZWIND=(pulow(JL)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            ZWIND=max(sqrt(zwind**2),gvsec)
+            ZDELP=PAPHM1(JL,JK+1)-PAPHM1(JL,JK)
+            ZSTABM=SQRT(MAX(PSTAB(JL,JK  ),GSSEC))
+            ZSTABP=SQRT(MAX(PSTAB(JL,JK+1),GSSEC))
+            ZRHOM=PRHO(JL,JK  )
+            ZRHOP=PRHO(JL,JK+1)
+            PNU(JL) = PNU(JL) + (ZDELP/g)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/ZWIND     
+            IF((ZNUM(JL).LE.GFRCRIT).AND.(PNU(JL).GT.GFRCRIT)
+     *                          .AND.(KKENVH(JL).EQ.KLEV))
+     *      KKENVH(JL)=JK
+     
+      ENDIF    
+
+      ENDIF
+      
+ 234  CONTINUE
+
+C  CALCULATION OF A DYNAMICAL MIXING HEIGHT FOR THE BREAKING
+C  OF GRAVITY WAVES:
+
+              
+      DO 235 JL=kidia,kfdia
+      znup(jl)=0.0
+      znum(jl)=0.0
+ 235  CONTINUE
+
+      DO 236 JK=KLEV-1,2,-1
+      DO 236 JL=kidia,kfdia
+      
+      IF(KTEST(JL).EQ.1) THEN
+        
+      IF (JK.LT.KKENVH(JL)) THEN
+
+            ZNUM(JL)=ZNUP(JL)
+            ZWIND=(pulow(JL)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            ZWIND=max(sqrt(zwind**2),gvsec)
+            ZDELP=PAPHM1(JL,JK+1)-PAPHM1(JL,JK)
+            ZSTABM=SQRT(MAX(PSTAB(JL,JK  ),GSSEC))
+            ZSTABP=SQRT(MAX(PSTAB(JL,JK+1),GSSEC))
+            ZRHOM=PRHO(JL,JK  )
+            ZRHOP=PRHO(JL,JK+1)
+            ZNUP(JL) = ZNUP(JL) + (ZDELP/g)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/ZWIND     
+            IF((ZNUM(JL).LE.1.5).AND.(ZNUP(JL).GT.1.5)
+     *                          .AND.(KKCRITH(JL).EQ.KLEV))
+     *      KKCRITH(JL)=JK
+     
+      ENDIF
+      
+      ENDIF
+      
+ 236  CONTINUE
+ 
+      DO 237 JL=KIDIA,KFDIA
+      KKCRITH(JL)=MIN0(KKCRITH(JL),KKNU(JL))
+ 237  CONTINUE
+c
+c     directional info for flow blocking ************************* 
+c
+      do 251 jk=ilevh,klev    
+      DO 252 JL=kidia,kfdia
+      IF(jk.ge.kkenvh(jl)) THEN
+      LO=(PUm1(JL,jk).LT.GVSEC).AND.(PUm1(JL,jk).GE.-GVSEC)
+      IF(LO) THEN
+        ZU=PUm1(JL,jk)+2.*GVSEC
+      ELSE
+        ZU=PUm1(JL,jk)
+      ENDIF
+       Zphi=ATAN(PVm1(JL,jk)/ZU)
+       ppsi(jl,jk)=ptheta(jl)*pi/180.-zphi
+      end if
+ 252  continue
+ 251  CONTINUE
+c      forms the vertical 'leakiness' **************************
+
+      alpha=3.
+      
+      DO 254  JK=ilevh,klev
+      DO 253  JL=kidia,kfdia
+      IF(jk.ge.kkenvh(jl)) THEN
+        zggeenv=AMAX1(1.,
+     *          (pgeom1(jl,kkenvh(jl))+pgeom1(jl,kkenvh(jl)-1))/2.)      
+        zggeom1=AMAX1(pgeom1(jl,jk),1.)
+        zgvar=amax1(pvaror(jl)*g,1.)     
+        pzdep(jl,jk)=SQRT((zggeenv-zggeom1)/(zggeom1+zgvar))      
+      end if
+ 253  CONTINUE
+ 254  CONTINUE
+
+ 260  CONTINUE
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/param_slope.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/param_slope.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/param_slope.F90	(revision 2744)
@@ -0,0 +1,220 @@
+SUBROUTINE param_slope( &
+  !
+  ! INPUTS
+  !
+               &  csza, declin, rho, latitude &
+               &  ,taudust, albedo  &
+               &  ,theta_s, psi_s &
+               &  ,fdir_0, ftot_0  &
+  !
+  ! OUTPUTS
+  !
+               &  ,ftot &
+ )
+
+
+!!*****************************************************************************************
+!
+! SUBROUTINE:
+! param_slope
+! 
+!
+! PURPOSE: 
+! computes total solar irradiance on a given Martian slope 
+!
+!
+! INPUTS:
+! csza		cosine solar zenith angle
+! declin	sun declination (rad)
+! rho		sun right ascension (rad)
+! latitude	latitude (deg)
+! taudust	dust optical depth at reference wavelength 0.67 mic. 
+! albedo	spectrally integrated surface Lambertian reflection albedo 
+! theta_s	slope inclination angle (deg)
+!			0 is horizontal, 90 is vertical
+! phi_s		slope azimuth (deg) 
+!       		0 >> Northward
+!       		90 >> Eastward
+!       		180 >> Southward
+!       		270 >> Westward
+! ftot_0	spectrally integrated total irradiance on an horizontal surface (W/m2)
+! fdir_0	spectrally integrated direct irradiance on an horizontal surface (W/m2)
+!
+!
+! OUTPUTS:
+! ftot		spectrally integrated total irradiance on the slope (W/m2)
+!
+! REFERENCE: 
+! "Fast and accurate estimation of irradiance on Martian slopes"
+! A. Spiga & F. Forget
+! .....
+!
+! AUTHOR: 
+! A. Spiga (spiga@lmd.jussieu.fr)
+! March 2008
+!
+!!*****************************************************************************************
+
+IMPLICIT NONE
+
+!!
+!! INPUT
+!!
+REAL, INTENT(IN) :: csza, declin, rho, latitude, taudust, theta_s, psi_s, albedo, ftot_0 , fdir_0 
+
+!!
+!! LOCAL
+!!
+REAL :: pi, deg2rad
+REAL :: a
+REAL :: mu_s, sigma_s
+REAL :: fdir, fscat, fscat_0, fref
+REAL, DIMENSION(4,2) :: mat_M, mat_N, mat_T
+REAL, DIMENSION(2) :: g_vector
+REAL, DIMENSION(4) :: s_vector
+REAL :: ratio
+
+!!
+!! OUTPUT
+!!
+REAL, INTENT(OUT) :: ftot
+
+!!*****************************************************************************************
+
+!
+! Prerequisite
+!
+  pi = 2.*asin(1.)
+  deg2rad = pi/180.
+  if ((theta_s > 90.) .or. (theta_s < 0.)) then
+	print *, 'please set theta_s between 0 and 90', theta_s
+	stop 
+  endif
+
+!
+! Solar Zenith angle (radian) 
+!
+  if (csza .lt. 0.01) then
+      !print *, 'sun below horizon' 
+      !fdir_0=0.
+      fdir=0.
+      fscat_0=0.
+      fscat=0.   
+      fref=0.
+  else
+
+!!
+!! Low incidence fix
+!! 
+!  if (csza .lt. 0.15) csza = 0.15
+
+!
+! 'Slope vs Sun' azimuth (radian)
+!
+  if ( ( (cos(declin)*sin(rho)) .eq. 0.0 ) &
+               .and. &
+     ( ( sin(deg2rad*latitude)*cos(declin)*cos(rho) &
+              -cos(deg2rad*latitude)*sin(declin) ) .eq. 0.0 ) ) then
+    a = deg2rad*psi_s ! some compilator need specfying value for atan2(0,0)  
+  else
+    a = deg2rad*psi_s + atan2(cos(declin)*sin(rho), &
+               sin(deg2rad*latitude)*cos(declin)*cos(rho)-cos(deg2rad*latitude)*sin(declin))
+  end if
+  
+!
+! Cosine of slope-sun phase angle 
+!
+  mu_s = csza*cos(deg2rad*theta_s) - cos(a)*sin(deg2rad*theta_s)*sqrt(1-csza**2)
+  if (mu_s .le. 0.) mu_s=0.
+
+!
+! Sky-view factor
+!
+  sigma_s=0.5*(1.+cos(deg2rad*theta_s))
+
+!
+! Direct flux on the slope
+!
+  fdir = fdir_0 * mu_s/csza
+
+!
+! Reflected flux on the slope
+!
+  fref = albedo * (1-sigma_s) * ftot_0
+
+!
+! Scattered flux on a flat surface
+!
+  fscat_0 = ftot_0 - fdir_0
+
+!
+! Scattering vector (slope vs sky)
+!
+  s_vector=(/ 1., exp(-taudust) , sin(deg2rad*theta_s), sin(deg2rad*theta_s)*exp(-taudust) /)
+
+!
+! Geometry vector (slope vs sun)
+!
+  g_vector=(/ mu_s/csza, 1. /)
+
+!
+! Coupling matrix
+!
+  if (csza .ge. 0.5) then
+	mat_M(:,1) = (/ -0.264,  1.309,  0.208, -0.828 /)
+	mat_M(:,2) = (/  1.291*sigma_s, -1.371*sigma_s, -0.581,  1.641 /)
+	mat_N(:,1) = (/  0.911, -0.777, -0.223,  0.623 /)
+	mat_N(:,2) = (/ -0.933*sigma_s,  0.822*sigma_s,  0.514, -1.195 /)
+
+  else
+	mat_M(:,1) = (/ -0.373,  0.792, -0.095,  0.398 /)
+	mat_M(:,2) = (/  1.389*sigma_s, -0.794*sigma_s, -0.325,  0.183 /)
+	mat_N(:,1) = (/  1.079,  0.275,  0.419, -1.855 /)
+	mat_N(:,2) = (/ -1.076*sigma_s, -0.357*sigma_s, -0.075,  1.844 /)
+  endif
+  !
+  mat_T = mat_M + csza*mat_N
+
+
+!
+! Scattered flux slope ratio
+!
+  if (deg2rad*theta_s <= 0.0872664626) then
+  !
+  ! low angles
+  !
+	s_vector = (/ 1., exp(-taudust) , sin(0.0872664626), sin(0.0872664626)*exp(-taudust) /)
+	ratio = DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )
+        ratio = 1. + (ratio - 1.)*deg2rad*theta_s/0.0872664626
+  else
+  !
+  ! general case
+  !
+	ratio= DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )  
+                  !
+                  ! NB: ratio= DOT_PRODUCT ( s_vector, MATMUL( mat_T, g_vector ) ) is equivalent
+  endif
+
+!
+! Scattered flux on the slope
+!
+  fscat = ratio * fscat_0
+
+
+endif !! if (csza < 0.01)
+
+!
+! Total flux on the slope
+!
+  ftot = fdir + fref + fscat
+
+!!
+!! Display results
+!!
+!  print *, 'sca component 0 ', ftot_0-fdir_0
+!  print *, 'dir component 0 ', fdir_0
+!  print *, 'scattered component ', fscat
+!  print *, 'direct component ', fdir
+!  print *, 'reflected component ', fref
+
+END SUBROUTINE param_slope
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/param_slope_full.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/param_slope_full.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/param_slope_full.F90	(revision 2744)
@@ -0,0 +1,248 @@
+SUBROUTINE param_slope_full( &
+  !
+  ! INPUTS
+  !
+               &  ls, localtime, latitude, taudust, albedo  &
+               &  ,theta_s, psi_s &
+               &  ,ftot_0  &
+  !
+  ! OUTPUTS
+  !
+               &  ,ftot &
+ )
+
+
+!!*****************************************************************************************
+!
+! SUBROUTINE:
+! param_slope
+! 
+!
+! PURPOSE: 
+! computes total solar irradiance on a given Martian slope 
+!
+!
+! INPUTS:
+! ls	 	aerocentric longitude (deg)
+! localtime	local true solar time (Martian hours)
+! latitude  	latitude (deg)
+! taudust	dust optical depth at reference wavelength 0.67 mic. 
+! albedo	spectrally integrated surface Lambertian reflection albedo 
+! theta_s	slope inclination angle (deg)
+!			0 is horizontal, 90 is vertical
+! phi_s		slope azimuth (deg) 
+!       		0 >> Northward
+!       		90 >> Eastward
+!       		180 >> Southward
+!       		270 >> Westward
+! ftot_0	spectrally integrated total irradiance on an horizontal surface (W/m2)
+!
+!
+! OUTPUTS:
+! ftot		spectrally integrated total irradiance on the slope (W/m2)
+!
+! REFERENCE: 
+! "Fast and accurate estimation of irradiance on Martian slopes"
+! A. Spiga & F. Forget
+! .....
+!
+! AUTHOR: 
+! A. Spiga (spiga@lmd.jussieu.fr)
+! March 2008
+!
+!!*****************************************************************************************
+
+IMPLICIT NONE
+
+!!
+!! INPUT
+!!
+REAL, INTENT(IN) :: ls, localtime, latitude, taudust, theta_s, psi_s, albedo, ftot_0  
+
+!!
+!! LOCAL
+!!
+REAL :: pi, deg2rad, dist_sol, cste_mars
+REAL, PARAMETER :: p = 1.510404          ! Semi-latus rectum of Martian elliptic orbit (AU)
+REAL, PARAMETER :: e = 9.3357898E-02     ! Eccentricity of Martian elliptic orbit
+REAL, PARAMETER :: t = 1.908231          ! Angle from Ls=0 to the perihelion (radian)
+REAL, PARAMETER :: so = 0.4256214        ! sin(Obliquity of Martian axis) 
+REAL :: rho, sdec, dec, cdec, csza, sza, ssza, psi0 
+REAL :: px, py
+REAL :: a
+REAL :: mu_s, sigma_s
+REAL :: fdir, fdir_0, fscat, fscat_0, fref
+REAL, DIMENSION(4,2) :: mat_M, mat_N, mat_T
+REAL, DIMENSION(2) :: g_vector
+REAL, DIMENSION(4) :: s_vector
+REAL :: ratio
+
+!!
+!! OUTPUT
+!!
+REAL, INTENT(OUT) :: ftot
+
+!!*****************************************************************************************
+
+!
+! Prerequisite
+!
+  pi = 2.*asin(1.)
+  deg2rad = pi/180.
+  if ((theta_s > 90.) .or. (theta_s < 0.)) then
+	print *, 'please set theta_s between 0 and 90', theta_s
+	stop 
+  endif
+
+!
+! Sun right ascension (radian)
+!
+  rho = pi*(1.0-localtime/12.0)
+
+!
+! Distance to sun (AU)
+!
+  dist_sol = p/(1.0+e*cos(deg2rad*Ls+t))   !! ellipse polar equation 
+ 
+!
+! Incident flux @ top of the atmosphere (Mars solar constant, W m-2)
+!
+  cste_mars=1370./(dist_sol*dist_sol)      !! 1370 W.m-2 is the solar constant at 1 AU.
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! pour comparer avec spectres ESA
+!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!cste_mars=cste_mars*0.92
+
+
+!
+! Sun declination (radian) [= subsolar point latitude]
+!
+  sdec = sin(deg2rad*Ls)*so
+  dec = asin(sdec)  
+  cdec = cos(dec)
+
+!
+! Solar Zenith angle (radian) 
+!
+  csza = sin(deg2rad*latitude)*sdec + cos(deg2rad*latitude)*cdec*cos(rho)
+  sza = acos(csza)
+  ssza = sin(sza)
+  if (csza < 0.01) then
+      !print *, 'sun below horizon' 
+      fdir_0=0.
+      fdir=0.
+      fscat_0=0.
+      fscat=0.   
+      fref=0.
+  else      
+
+!
+! 'Slope vs Sun' azimuth (radian)
+!
+  if ( ( (cdec*sin(rho)) .eq. 0.0 ) .and. ( ( sin(deg2rad*latitude)*cdec*cos(rho)-cos(deg2rad*latitude)*sdec ) .eq. 0.0 ) ) then
+    a = deg2rad*psi_s ! some compilator need specfying value for atan2(0,0)  
+  else
+    a = deg2rad*psi_s + atan2(cdec*sin(rho),sin(deg2rad*latitude)*cdec*cos(rho)-cos(deg2rad*latitude)*sdec)
+  end if
+  
+!
+! Cosine of slope-sun phase angle 
+!
+  mu_s = csza*cos(deg2rad*theta_s) - cos(a)*sin(deg2rad*theta_s)*sqrt(1-csza**2)
+  if (mu_s .le. 0.) mu_s=0.
+
+!
+! Sky-view factor
+!
+  sigma_s=0.5*(1.+cos(deg2rad*theta_s))
+
+!
+! Direct flux on a flat surface
+!
+  fdir_0 = cste_mars*csza*exp(-taudust/csza)
+
+!
+! Direct flux on the slope
+!
+  fdir = fdir_0 * mu_s/csza
+
+!
+! Reflected flux on the slope
+!
+  fref = albedo * (1-sigma_s) * ftot_0
+
+!
+! Scattered flux on a flat surface
+!
+  fscat_0 = ftot_0 - fdir_0
+
+!
+! Scattering vector (slope vs sky)
+!
+  s_vector=(/ 1., exp(-taudust) , sin(deg2rad*theta_s), sin(deg2rad*theta_s)*exp(-taudust) /)
+
+!
+! Geometry vector (slope vs sun)
+!
+  g_vector=(/ mu_s/csza, 1. /)
+
+!
+! Coupling matrix
+!
+  if (csza .ge. 0.5) then
+	mat_M(:,1) = (/ -0.264,  1.309,  0.208, -0.828 /)
+	mat_M(:,2) = (/  1.291*sigma_s, -1.371*sigma_s, -0.581,  1.641 /)
+	mat_N(:,1) = (/  0.911, -0.777, -0.223,  0.623 /)
+	mat_N(:,2) = (/ -0.933*sigma_s,  0.822*sigma_s,  0.514, -1.195 /)
+
+  else
+	mat_M(:,1) = (/ -0.373,  0.792, -0.095,  0.398 /)
+	mat_M(:,2) = (/  1.389*sigma_s, -0.794*sigma_s, -0.325,  0.183 /)
+	mat_N(:,1) = (/  1.079,  0.275,  0.419, -1.855 /)
+	mat_N(:,2) = (/ -1.076*sigma_s, -0.357*sigma_s, -0.075,  1.844 /)
+  endif
+  !
+  mat_T = mat_M + csza*mat_N
+
+
+!
+! Scattered flux slope ratio
+!
+  if (deg2rad*theta_s <= 0.0872664626) then
+  !
+  ! low angles
+  !
+	s_vector = (/ 1., exp(-taudust) , sin(0.0872664626), sin(0.0872664626)*exp(-taudust) /)
+	ratio = DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )
+        ratio = 1. + (ratio - 1.)*deg2rad*theta_s/0.0872664626
+  else
+  !
+  ! general case
+  !
+	ratio= DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )  
+                  !
+                  ! NB: ratio= DOT_PRODUCT ( s_vector, MATMUL( mat_T, g_vector ) ) is equivalent
+  endif
+
+!
+! Scattered flux on the slope
+!
+  fscat = ratio * fscat_0
+
+endif !! if (csza < 0.01)
+
+!
+! Total flux on the slope
+!
+  ftot = fdir + fref + fscat
+
+!!
+!! Display results
+!!
+!  print *, 'scattered component ', fscat
+!  print *, 'direct component ', fdir
+!  print *, 'reflected component ', fref
+
+END SUBROUTINE param_slope_full
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/phyetat0.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/phyetat0.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/phyetat0.F	(revision 2744)
@@ -0,0 +1,527 @@
+      SUBROUTINE phyetat0 (fichnom,tab0,Lmodif,nsoil,nq,
+     .           day_ini,time,
+     .           tsurf,tsoil,emis,q2,qsurf,co2ice)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c  Adaptation à Mars : Yann Wanherdrick 
+c Objet: Lecture de l etat initial pour la physique
+c======================================================================
+#include "dimensions.h"
+#include "netcdf.inc"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "planete.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "comcstfi.h"
+c======================================================================
+      CHARACTER*(*) fichnom
+      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
+      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
+
+      INTEGER radpas
+      REAL co2_ppm
+      REAL solaire,time
+      REAL tsoil(ngridmx,nsoil,nbsrf)
+
+      REAL xmin, xmax
+c
+      INTEGER nsoil,nq
+      INTEGER ig,iq,lmax
+      INTEGER nid, nvarid
+      INTEGER ierr, i, nsrf, isoil 
+      INTEGER length
+      PARAMETER (length=100)
+      CHARACTER*7 str7
+      CHARACTER*2 str2
+      CHARACTER*1 yes
+c
+      integer   Lmodif,tab0
+      REAL      p_rad,p_omeg,p_g,p_mugaz,p_daysec
+      REAL tsurf(ngridmx,nbsrf),co2ice(ngridmx),emis(ngridmx)
+      REAL q2(ngridmx, llm+1)
+      REAL qsurf(ngridmx,nq) 
+      INTEGER day_ini,nqold
+c
+c Ouvrir le fichier contenant l etat initial:
+c
+ 
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        CALL ABORT
+      ENDIF
+
+
+c modifications possibles des variables de tab_cntrl
+      PRINT*
+      write(*,*) 'TABFI de phyeta0',Lmodif,tab0
+      call tabfi (nid,Lmodif,tab0,day_ini,lmax,p_rad,
+     .              p_omeg,p_g,p_mugaz,p_daysec,time)
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <latitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lati)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, lati)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <longitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, long)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, long)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <longitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des aires des mailles:
+c
+      ierr = NF_INQ_VARID (nid, "area", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <area> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, area)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, area)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <area>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(area)
+      xmax = MAXVAL(area)
+      PRINT*,'Aires des mailles <area>:', xmin, xmax
+c
+c Lecture du geopotentiel au sol:
+c
+      ierr = NF_INQ_VARID (nid, "phisfi", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <phisfi> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisfi)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phisfi)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <phisfi>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(phisfi)
+      xmax = MAXVAL(phisfi)
+      PRINT*,'Geopotentiel au sol <phisfi>:', xmin, xmax
+c
+c Lecture de l''albedo du sol nu:
+c
+      ierr = NF_INQ_VARID (nid, "albedodat", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <albedodat> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albedodat)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, albedodat)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <albedodat>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(albedodat)
+      xmax = MAXVAL(albedodat)
+      PRINT*,'Albedo du sol nu <albedodat>:', xmin, xmax
+c
+c Lecture de l''inertie thermique du sol:
+c
+      ierr = NF_INQ_VARID (nid, "inertiedat", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <inertiedat> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, inertiedat)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, inertiedat)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <inertiedat>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(inertiedat)
+      xmax = MAXVAL(inertiedat)
+      PRINT*,'Inertie thermique du sol <inertiedat>:', xmin, xmax
+c
+c ZMEA
+c
+      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zmea(i),xmin)
+         xmax = MAX(zmea(i),xmax)
+      ENDDO
+      PRINT*,'<zmea>:', xmin, xmax
+c
+c ZSTD
+c
+      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zstd(i),xmin)
+         xmax = MAX(zstd(i),xmax)
+      ENDDO
+      PRINT*,'<zstd>:', xmin, xmax
+c
+c ZSIG
+c
+      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zsig(i),xmin)
+         xmax = MAX(zsig(i),xmax)
+      ENDDO
+      PRINT*,'<zsig>:', xmin, xmax
+c
+c ZGAM
+c
+      ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zgam(i),xmin)
+         xmax = MAX(zgam(i),xmax)
+      ENDDO
+      PRINT*,'<zgam>:', xmin, xmax
+c
+c ZTHE
+c
+      ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zthe(i),xmin)
+         xmax = MAX(zthe(i),xmax)
+      ENDDO
+      PRINT*,'<zthe>:', xmin, xmax
+c
+c CO2 ice cover
+c
+      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <co2ice> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, co2ice)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, co2ice)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <co2ice>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(co2ice)
+      xmax = MAXVAL(co2ice)
+      PRINT*,'CO2 ice cover <co2ice>:', xmin, xmax
+c
+c Lecture des temperatures du sol:
+c
+      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <tsurf> est absent'
+         PRINT*, '          Mais je vais essayer de lire TS**'
+         IF (nbsrf.GT.99) THEN
+            PRINT*, "Trop de sous-mailles"
+            CALL abort
+         ENDIF
+         DO nsrf = 1, nbsrf
+           WRITE(str2,'(i2.2)') nsrf
+           ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
+           IF (ierr.NE.NF_NOERR) THEN
+              PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
+              CALL abort
+           ENDIF
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsurf(1,nsrf))
+#else
+           ierr = NF_GET_VAR_REAL(nid, nvarid, tsurf(1,nsrf))
+#endif
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
+             CALL abort
+           ENDIF
+           xmin = 1.0E+20
+           xmax = -1.0E+20
+           xmin = MINVAL(tsurf)
+           xmax = MAXVAL(tsurf)
+           PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
+         ENDDO
+      ELSE
+         PRINT*, 'phyetat0: Le champ <tsurf> est present'
+         PRINT*, '          J ignore donc les autres temperatures TS**'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsurf(1,1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsurf(1,1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TSURF>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         xmin = MINVAL(tsurf)
+         xmax = MAXVAL(tsurf)
+         PRINT*,'Temperature du sol <tsurf>', xmin, xmax
+         IF (nbsrf >= 2) THEN
+            DO nsrf = 2, nbsrf
+               DO i = 1, ngridmx
+                  tsurf(i,nsrf) = tsurf(i,1)
+               ENDDO
+            ENDDO
+         ENDIF
+      ENDIF
+c
+c Lecture des temperatures du sol profond:
+c
+      IF (nsoil.GT.99 .OR. nbsrf.GT.99) THEN
+         PRINT*, "Trop de couches ou sous-mailles"
+         CALL abort
+      ENDIF
+      DO nsrf = 1, nbsrf
+         DO isoil=1, nsoil
+            WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
+            ierr = NF_INQ_VARID (nid, 'tsoil', nvarid)
+            IF (ierr.NE.NF_NOERR) THEN
+               PRINT*, "phyetat0: Le champ <tsoil> est absent"
+               PRINT*, "          Il prend donc la valeur de surface"
+               DO i=1, ngridmx
+                  tsoil(i,isoil,nsrf)=tsurf(i,nsrf)
+               ENDDO
+            ELSE
+#ifdef NC_DOUBLE
+              ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,1,nsrf))
+#else
+              ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,1,nsrf))
+#endif
+               IF (ierr.NE.NF_NOERR) THEN
+                  PRINT*, "Lecture echouee pour <tsoil>"
+                  CALL abort
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(tsoil)
+      xmax = MAXVAL(tsoil)
+      PRINT*,'Temperatures du sol profond <tsoil>', xmin, xmax
+c
+c Surface emissivity
+c
+      ierr = NF_INQ_VARID (nid, "emis", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <emis> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, emis)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, emis)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <emis>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(emis)
+      xmax = MAXVAL(emis)
+      PRINT*,'Surface emissivity <emis>:', xmin, xmax
+c
+c pbl wind variance
+c
+      ierr = NF_INQ_VARID (nid, "q2", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <q2> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q2)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, q2)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <q2>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(q2)
+      xmax = MAXVAL(q2)
+      PRINT*,'pbl wind variance <q2>:', xmin, xmax
+c
+c tracer on surface
+c
+
+      IF(nq.GE.1) THEN
+         nqold=nq
+         DO iq=1,nq
+            str7(1:5)='qsurf'
+            WRITE(str7(6:7),'(i2.2)') iq
+            ierr = NF_INQ_VARID (nid,str7,nvarid)
+            IF (ierr.NE.NF_NOERR) THEN
+                write (*,*) ' WARNING : ',str7,' not in the file'
+                write (*,*) str7, ' set to 0'
+                do ig=1,ngridmx
+                    qsurf(ig,iq)=0.
+                end do
+                nqold=min(iq-1,nqold)
+            ELSE
+#ifdef NC_DOUBLE
+              ierr = NF_GET_VAR_DOUBLE(nid, nvarid,qsurf(1,iq))
+#else
+              ierr = NF_GET_VAR_REAL(nid, nvarid,qsurf(1,iq))
+#endif
+              IF (ierr.NE.NF_NOERR) THEN
+                PRINT*, 'phyetat0: Lecture echouee pour <',str7,'>'
+                CALL abort
+              ENDIF
+           ENDIF
+           xmin = 1.0E+20
+           xmax = -1.0E+20
+           xmin = MINVAL(qsurf(1:ngridmx,iq))
+           xmax = MAXVAL(qsurf(1:ngridmx,iq))
+      PRINT*,'tracer on surface <',str7,'>:', xmin, xmax
+         ENDDO
+         if(nqold.lt.nq) then
+c        case when new tracer are added in addition to old ones
+             write(*,*)'qsurf 1 to ', nqold,'were already present'
+             write(*,*)'qsurf ', nqold+1,' to ', nqmx,'are new'
+            yes=' '
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+             write(*,*) 'Would you like to reindex qsurf # 1 ->',nqold
+             write(*,*) 'to #',nqmx-nqold+1,'->', nqmx,'   (y or n) ?'
+             read(*,fmt='(a)') yes
+            end do
+            if (yes.eq.'y') then
+              write(*,*) 'OK, let s reindex qsurf'
+                 do ig=1,ngridmx
+                    do iq=nqmx,nqmx-nqold+1,-1
+                       qsurf(ig,iq)=qsurf(ig,iq-nqmx+nqold)
+                    end do
+                    do iq=nqmx-nqold,1,-1
+                       qsurf(ig,iq)= 0.
+                    end do
+                 end do
+            end if
+         end if
+      ENDIF
+c
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/physdem1.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/physdem1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/physdem1.F	(revision 2744)
@@ -0,0 +1,461 @@
+      subroutine physdem1(filename,lonfi,latfi,nsoil,nq,
+     .                   phystep,day_ini,
+     .                   time,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .                   airefi,alb,ith,pzmea,pzstd,pzsig,pzgam,pzthe)
+
+      IMPLICIT none
+c-------------------------------------------------------------
+C Author : L. Fairhead
+C Date   : 01/10/1999
+C Objet  : Ecriture des etats initiaux physiques
+c-------------------------------------------------------------
+c
+c
+c
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+c-----------------------------------------------------------------------
+#include "comvert.h"
+#include "comgeom2.h"
+#include "control.h"
+#include "comdissnew.h"
+#include "logic.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "dimphys.h"
+c
+      INTEGER nid,iq
+      INTEGER, parameter :: ivap=1
+      REAL, parameter :: qsolmax= 150.0
+      character (len=*) :: filename
+      character (len=7) :: str7
+
+      REAL day_ini
+      INTEGER nsoil,nq
+      integer ierr,idim1,idim2,idim3,idim4,idim5,nvarid
+
+c
+      REAL phystep,time
+      REAL latfi(ngridmx), lonfi(ngridmx)
+      REAL champhys(ngridmx)
+      REAL tsurf(ngridmx)
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length)
+
+c
+
+ccccccccccccccccccccc g95 errors
+ccc probably looking for functions, 
+ccc but disappointed when finding subroutines 
+ccc
+ccc obsolete
+ccc
+ccc      
+c      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
+c      EXTERNAL exner_hyb , SSUM
+c
+ccccccccccccccccccccc g95 errors
+
+#include "serre.h"
+#include "clesph0.h"
+#include "fxyprim.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "planete.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "comcstfi.h"
+
+      real co2ice(ngridmx),tsoil(ngridmx,nsoil),emis(ngridmx)
+      real q2(ngridmx, llm+1),qsurf(ngridmx,nq)
+      real airefi(ngridmx)
+      real alb(ngridmx),ith(ngridmx)
+      real pzmea(ngridmx),pzstd(ngridmx)
+      real pzsig(ngridmx),pzgam(ngridmx),pzthe(ngridmx)
+      integer ig
+      INTEGER lnblnk
+      EXTERNAL lnblnk
+
+c-----------------------------------------------------------------------
+
+      CALL SCOPY(ngridmx,airefi,1,area,1)
+      DO ig=1,ngridmx
+         albedodat(ig)=alb(ig)
+         inertiedat(ig)=ith(ig)
+         zmea(ig)=pzmea(ig)
+         zstd(ig)=pzstd(ig)
+         zsig(ig)=pzsig(ig)
+         zgam(ig)=pzgam(ig)
+         zthe(ig)=pzthe(ig)
+      ENDDO
+c
+c  stockage sur le fichier Physique:
+c
+      ierr = NF_CREATE(trim((filename)),NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        WRITE(6,*)' Problem creating restartfi.nc'
+        WRITE(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 26,
+     .                       "Fichier demarrage physique")
+c
+      ierr = NF_DEF_DIM (nid,"index",length,idim1)
+      ierr = NF_DEF_DIM (nid,"physical_points",ngridmx,idim2)
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoil,idim3)
+      ierr = NF_DEF_DIM (nid,"nlayer+1",llm+1,idim4)
+      ierr = NF_DEF_DIM (nid,"number_of_advected_fields",nq,idim5)
+c
+      ierr = NF_ENDDEF(nid)
+c
+      DO ierr = 1, length
+         tab_cntrl(ierr) = 0.0
+      ENDDO
+
+      write(*,*) "ngridmx: ",ngridmx
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c pour la DOCUMENTATION    (fichier io/maj/fi_cntl)
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c Info sur la grille physique
+      tab_cntrl(1) = float(ngridmx)  ! nombre de points de la grille physique
+      tab_cntrl(2) = float(nlayermx) ! nombre de couches
+      tab_cntrl(3) = day_ini + int(time)         ! jour initial
+      tab_cntrl(4) = time -int(time)            ! heure initiale 0
+
+c Info sur la Planete Mars pour la dynamique et la physique
+      tab_cntrl(5) = rad      ! rayon de mars(m) ~3397200
+      tab_cntrl(6) = omeg     ! vitesse de rotation (rad.s-1)
+      tab_cntrl(7) = g        ! gravite (m.s-2) ~3.72
+      tab_cntrl(8) = mugaz    ! Masse molaire de l''atm (g.mol-1) ~43.49
+      tab_cntrl(9) = rcp      !  = r/cp  ~0.256793 (=kappa dans dynamique)
+      tab_cntrl(10) = daysec  ! duree du sol (s)  ~88775
+
+      tab_cntrl(11) = phystep  ! pas de temps de la physique 
+      tab_cntrl(12) = 0.
+      tab_cntrl(13) = 0.
+
+c Info sur la Planete Mars pour la physique uniquement
+      tab_cntrl(14) = year_day  ! duree de l''annee (sols) ~668.6
+      tab_cntrl(15) = periheli  ! dist.min. soleil-mars (Mkm) ~206.66
+      tab_cntrl(16) = aphelie   ! dist.max. soleil-mars (Mkm) ~249.22
+      tab_cntrl(17) = peri_day  ! date du perihelie (sols depuis printemps)
+      tab_cntrl(18) = obliquit  ! Obliquite de la planete (deg) ~23.98
+
+c Couche limite et Turbulence
+      tab_cntrl(19) = z0        ! surface roughness (m) ~0.01
+      tab_cntrl(20) = lmixmin   ! longueur de melange ~100
+      tab_cntrl(21) = emin_turb ! energie minimale ~1.e-8
+
+c propriete optiques des calottes et emissivite du sol
+      tab_cntrl(22) = albedice(1)  ! Albedo calotte nord ~0.5
+      tab_cntrl(23) = albedice(2)  ! Albedo calotte sud ~0.5
+      tab_cntrl(24) = emisice(1)   ! Emissivite calotte nord ~0.95
+      tab_cntrl(25) = emisice(2)   ! Emissivite calotte sud ~0.95
+      tab_cntrl(26) = emissiv      ! Emissivite du sol martien ~.95
+      tab_cntrl(31) = iceradius(1) ! mean scat radius of CO2 snow (north)
+      tab_cntrl(32) = iceradius(2) ! mean scat radius of CO2 snow (south)
+      tab_cntrl(33) = dtemisice(1) ! time scale for snow metamorphism (north)
+      tab_cntrl(34) = dtemisice(2) ! time scale for snow metamorphism (south)
+
+c Proprietes des poussiere aerosol
+      tab_cntrl(27) = tauvis      ! profondeur optique visible moyenne
+
+      tab_cntrl(28) = 0. 
+      tab_cntrl(29) = 0.
+      tab_cntrl(30) = 0.
+
+cc   ***    new_oliq   (  commentaires de L. LI dans routine physique ) 
+cc   ***  ok_orodr  et ok_orolf   si on appelle l'orographie      ****
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+     .                        "Longitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lonfi)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,lonfi)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
+     .                        "Latitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,latfi)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,latfi)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "area", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "area", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
+     .                        "Aire des mailles")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,area)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,area)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "phisfi", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "phisfi", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                        "Geopotentiel au sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phisfi)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phisfi)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "albedodat", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "albedodat", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
+     .                        "Albedo du sol nu")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedodat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedodat)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "inertiedat", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "inertiedat", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 24,
+     .                        "Inertie thermique du sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,inertiedat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,inertiedat)
+#endif
+c
+c   fichier pour les programmes de Francois Lott
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
+     .                        "Relief moyen")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 18,
+     .                        "Ecartype du relief")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                        "Relief: parametre sigma")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                        "Relief: parametre gamma")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                        "Relief: parametre theta")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
+#endif
+
+c Ecriture des champs physiques
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "co2ice", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "co2ice", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 13,
+     .                        "CO2 ice cover")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,co2ice)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,co2ice)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "tsurf", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "tsurf", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                        "Surface temperature")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsurf)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tsurf)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"tsoil",NF_DOUBLE,2,(/idim2,idim3/),nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"tsoil",NF_FLOAT,2,(/idim2,idim3/),nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
+     .                        "Soil temperature")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "emis", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "emis", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 18,
+     .                        "Surface emissivity")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,emis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,emis)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "q2", NF_DOUBLE, 2, 
+     .  (/idim2,idim4/),nvarid)
+c****WRF: ligne trop longue ....
+#else
+      ierr = NF_DEF_VAR (nid, "q2", NF_FLOAT, 2,(/idim2,idim4/),nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+     .                        "pbl wind variance")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q2)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,q2)
+#endif
+c
+      IF(nq.GE.1) THEN
+         DO iq=1,nq
+            str7(1:5)='qsurf'
+            WRITE(str7(6:7),'(i2.2)') iq
+            ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+            ierr = NF_DEF_VAR (nid,str7,NF_DOUBLE,1,idim2,nvarid)
+#else
+            ierr = NF_DEF_VAR (nid,str7,NF_FLOAT,1,idim2,nvarid)
+#endif
+            ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+     .                        "tracer on surface")
+            ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,iq))
+#else
+            ierr = NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,iq))
+#endif
+         ENDDO
+      ENDIF
+c
+      ierr = NF_CLOSE(nid)
+
+      RETURN
+
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/physiq.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/physiq.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/physiq.F	(revision 2744)
@@ -0,0 +1,1582 @@
+      SUBROUTINE physiq(ngrid,nlayer,nq,
+     $            firstcall,lastcall,
+     $            pday,ptime,ptimestep,
+     $            pplev,pplay,pphi,
+     $            pu,pv,pt,pq,
+     $            pw,
+     $            pdu,pdv,pdt,pdq,pdpsrf,tracerdyn,
+     $            wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,
+     $            wday_ini,
+     $            output_tab2d, output_tab3d,
+     $            flag_LES)
+
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c	CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+c
+c	... CHECK THE ****WRF lines
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Organisation of the physical parametrisations of the LMD 
+c   martian atmospheric general circulation model.
+c
+c   The GCM can be run without or with tracer transport
+c   depending on the value of Logical "tracer" in file  "callphys.def"
+c   Tracers may be water vapor, ice OR chemical species OR dust particles
+c
+c   SEE comments in initracer.F about numbering of tracer species...
+c
+c   It includes:
+c
+c      1. Initialisation:
+c      1.5 Calculation of mean mass and cp, R and thermal conduction coeff.
+c      2. Calcul of the radiative tendencies : radiative transfer
+c         (longwave and shortwave) for CO2 and dust.
+c      3. Gravity wave and subgrid scale topography drag :
+c      4. Vertical diffusion (turbulent mixing):
+c      5. convective adjustment
+c      6.  TRACERS :
+c       6a. water and water ice
+c       6b. call for photochemistry when tracers are chemical species
+c       6c. other scheme for tracer (dust) transport (lifting, sedimentation)
+c       6d. updates (CO2 pressure variations, surface budget)
+c      7.  condensation and sublimation of carbon dioxide.
+c      8. Surface and sub-surface temperature calculations
+c      9. Writing output files :
+c           - "startfi", "histfi" (if it's time)
+c           - Saving statistics (if "callstats = .true.")
+c           - Dumping eof (if "calleofdump = .true.")
+c           - Output any needed variables in "diagfi" 
+c      10. Diagnostic: mass conservation of tracers
+c 
+c   author: 
+c   ------- 
+c           Frederic Hourdin	15/10/93
+c           Francois Forget		1994
+c           Christophe Hourdin	02/1997 
+c           Subroutine completly rewritten by F.Forget (01/2000)
+c           Introduction of the photochemical module: S. Lebonnois (11/2002)
+c           Introduction of the thermosphere module: M. Angelats i Coll (2002)
+c           Water ice clouds: Franck Montmessin (update 06/2003)
+c	    WRF version: Aymeric Spiga (01-03/2007)
+c           
+c
+c
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c    ecri                  period (in dynamical timestep) to write output
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    nq                    Number of advected fields
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c    ptime                 Universal time (0<ptime<1): ptime=0.5 at 12:00 UT
+c    ptimestep             timestep (s)
+c    pplay(ngrid,nlayer)   Pressure at the middle of the layers (Pa)
+c    pplev(ngrid,nlayer+1) intermediate pressure levels (pa)
+c    pphi(ngrid,nlayer)    Geopotential at the middle of the layers (m2s-2)
+c    pu(ngrid,nlayer)      u component of the wind (ms-1)
+c    pv(ngrid,nlayer)      v component of the wind (ms-1)
+c    pt(ngrid,nlayer)      Temperature (K)
+c    pq(ngrid,nlayer,nq)   Advected fields
+c    pudyn(ngrid,nlayer)    \ 
+c    pvdyn(ngrid,nlayer)     \ Dynamical temporal derivative for the
+c    ptdyn(ngrid,nlayer)     / corresponding variables
+c    pqdyn(ngrid,nlayer,nq) /
+c    pw(ngrid,?)           vertical velocity
+c 
+c
+c    ****WRF 
+c	day_ini,tsurf,tsoil,emis,q2,qsurf,co2ice are inputs 
+c		and locally saved variables
+c    			(no need to call phyetat0)
+c
+c
+c   output:
+c   -------
+c
+c    pdu(ngrid,nlayermx)        \
+c    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding
+c    pdt(ngrid,nlayermx)         /  variables due to physical processes.
+c    pdq(ngrid,nlayermx)        /
+c    pdpsrf(ngrid)             /
+c    tracerdyn                 call tracer in dynamical part of GCM ?
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "comsaison.h"
+#include "control.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "tracer.h"
+#include "nlteparams.h"
+
+#include "chimiedata.h"
+#include "watercap.h"
+#include "fisice.h"
+#include "param.h"
+#include "param_v3.h"
+#include "conc.h"
+
+#include "netcdf.inc"
+
+#include "slope.h"
+#include "wrf_output_2d.h"
+#include "wrf_output_3d.h"
+
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+      INTEGER ngrid,nlayer,nq
+      REAL ptimestep
+      REAL pplev(ngridmx,nlayer+1),pplay(ngridmx,nlayer)
+      REAL pphi(ngridmx,nlayer)
+      REAL pu(ngridmx,nlayer),pv(ngridmx,nlayer)
+      REAL pt(ngridmx,nlayer),pq(ngridmx,nlayer,nq)
+      REAL pw(ngridmx,nlayer) !Mars pvervel transmit par dyn3d
+      REAL zh(ngridmx,nlayermx)      ! potential temperature (K)
+      LOGICAL firstcall,lastcall
+c ****WRF
+      INTEGER wday_ini  
+      REAL wtsurf(ngridmx)  ! input only ay firstcall - output            
+      REAL wtsoil(ngridmx,nsoilmx)    
+      REAL wco2ice(ngridmx)             
+      REAL wemis(ngridmx)             
+      REAL wqsurf(ngridmx,nqmx)       
+      REAL wq2(ngridmx,nlayermx+1) 
+      REAL output_tab2d(ngridmx,n2d)
+      REAL output_tab3d(ngridmx,nlayer,n3d)
+      REAL sl_ls, sl_lct, sl_lat, sl_tau, sl_alb, sl_the, sl_psi
+      REAL sl_fl0, sl_flu
+      REAL sl_ra, sl_di0
+      REAL sky
+      REAL sensheat(ngridmx)    !! pour LES avec isfflx!=0
+      REAL ustar(ngridmx)    !! pour LES avec isfflx!=0
+      LOGICAL flag_LES     !! pour LES avec isfflx!=0
+      REAL qsurflast(ngridmx) !! pour diagnostics
+c ****WRF
+      REAL pday
+      REAL ptime 
+      logical tracerdyn
+   
+
+c   outputs:
+c   --------
+c     physical tendencies
+      REAL pdu(ngridmx,nlayer),pdv(ngridmx,nlayer)
+      REAL pdt(ngridmx,nlayer),pdq(ngridmx,nlayer,nq)
+      REAL pdpsrf(ngridmx)
+
+!!!!!!!TEST TEST
+!      REAL spdu(ngridmx,nlayermx)
+!      REAL spdv(ngridmx,nlayermx)
+!      REAL spdt(ngridmx,nlayermx)
+!      REAL spdq(ngridmx,nlayermx,nqmx)
+!      REAL spdpsrf(ngridmx)
+!      SAVE spdu
+!      SAVE spdv
+!      SAVE spdt
+!      SAVE spdq
+!      SAVE spdpsrf
+!      LOGICAL nocalculphy
+!!!!!!!TEST TEST      
+
+
+c Local saved variables:
+c ----------------------
+c     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+c     "longrefvis" set in dimradmars.h , for one of the "naerkind"  kind of
+c      aerosol optical properties  :
+      REAL aerosol(ngridmx,nlayermx,naerkind) 
+
+      INTEGER day_ini  ! Initial date of the run (sol since Ls=0) 
+      INTEGER icount     ! counter of calls to physiq during the run.
+      REAL tsurf(ngridmx)            ! Surface temperature (K)
+      REAL tsoil(ngridmx,nsoilmx)    ! sub-surface temperatures (K)
+      REAL co2ice(ngridmx)           ! co2 ice surface layer (kg.m-2)  
+      REAL albedo(ngridmx,2)         ! Surface albedo in each solar band
+      REAL emis(ngridmx)             ! Thermal IR surface emissivity
+      REAL dtrad(ngridmx,nlayermx)   ! Net atm. radiative heating rate (K.s-1)
+      REAL fluxrad_save(ngridmx)     ! Net radiative surface flux (W.m-2)
+      REAL capcal(ngridmx)           ! surface heat capacity (J m-2 K-1)
+      REAL fluxgrd(ngridmx)          ! surface conduction flux (W.m-2)
+      REAL qsurf(ngridmx,nqmx)       ! tracer on surface (e.g. kg.m-2)
+      REAL q2(ngridmx,nlayermx+1)    ! Turbulent Kinetic Energy 
+      INTEGER ig_vl1                 ! Grid Point near VL1   (for diagnostic) 
+
+      SAVE day_ini, icount
+      SAVE aerosol, tsurf,tsoil
+      SAVE co2ice,albedo,emis, q2
+      SAVE capcal,fluxgrd,dtrad,fluxrad_save, qsurf
+      SAVE ig_vl1
+
+      REAL stephan   
+      DATA stephan/5.67e-08/  ! Stephan Boltzman constant
+      SAVE stephan
+
+c Local variables :
+c -----------------
+
+      REAL fluxrad(ngridmx)     ! Net radiative surface flux (W.m-2)
+
+      CHARACTER*80 fichier 
+      INTEGER l,ig,ierr,igout,iq, tapphys
+      INTEGER iqmin                     ! Used if iceparty engaged
+
+      REAL fluxsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2)
+      REAL fluxsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL fluxtop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL fluxtop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+c     for clear area (uncovered by clouds) :
+      REAL clsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2) 
+      REAL clsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL cltop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL cltop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+      REAL tauref(ngridmx)           ! Reference column optical depth at 700 Pa
+                                     ! (used if active=F) 
+      REAL tau(ngridmx,naerkind)     ! Column dust optical depth at each point
+      REAL zls                       !  solar longitude (rad)
+      REAL zday                      ! date (time since Ls=0, in martian days)
+      REAL zzlay(ngridmx,nlayermx)   ! altitude at the middle of the layers
+      REAL zzlev(ngridmx,nlayermx+1) ! altitude at layer boundaries
+      REAL latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
+
+
+c     Tendancies due to various processes:
+      REAL dqsurf(ngridmx,nqmx)
+      REAL zdtlw(ngridmx,nlayermx)     ! (K/s)
+      REAL zdtsw(ngridmx,nlayermx)     ! (K/s)
+      REAL cldtlw(ngridmx,nlayermx)     ! (K/s) LW heating rate for clear area
+      REAL cldtsw(ngridmx,nlayermx)     ! (K/s) SW heating rate for clear area
+      REAL zdtnirco2(ngridmx,nlayermx) ! (K/s)
+      REAL zdtnlte(ngridmx,nlayermx)   ! (K/s)
+      REAL zdtsurf(ngridmx)            ! (K/s)
+      REAL zdtcloud(ngridmx,nlayermx)
+      REAL zdvdif(ngridmx,nlayermx),zdudif(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhdif(ngridmx,nlayermx), zdtsdif(ngridmx)         ! (K/s)
+      REAL zdvadj(ngridmx,nlayermx),zduadj(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhadj(ngridmx,nlayermx)                           ! (K/s)
+      REAL zdtgw(ngridmx,nlayermx)                            ! (K/s)
+      REAL zdugw(ngridmx,nlayermx),zdvgw(ngridmx,nlayermx)    ! (m.s-2)
+      REAL zdtc(ngridmx,nlayermx),zdtsurfc(ngridmx)
+      REAL zdvc(ngridmx,nlayermx),zduc(ngridmx,nlayermx)
+
+      REAL zdqdif(ngridmx,nlayermx,nqmx), zdqsdif(ngridmx,nqmx)
+      REAL zdqsed(ngridmx,nlayermx,nqmx), zdqssed(ngridmx,nqmx)
+      REAL zdqdev(ngridmx,nlayermx,nqmx), zdqsdev(ngridmx,nqmx)
+      REAL zdqadj(ngridmx,nlayermx,nqmx)
+      REAL zdqc(ngridmx,nlayermx,nqmx)
+      REAL zdqcloud(ngridmx,nlayermx,nqmx)
+      REAL zdqscloud(ngridmx,nqmx)
+      REAL zdqchim(ngridmx,nlayermx,nqmx)
+      REAL zdqschim(ngridmx,nqmx)
+
+      REAL zdteuv(ngridmx,nlayermx)    ! (K/s)
+      REAL zdtconduc(ngridmx,nlayermx) ! (K/s)
+      REAL zdumolvis(ngridmx,nlayermx)
+      REAL zdvmolvis(ngridmx,nlayermx)
+      real zdqmoldiff(ngridmx,nlayermx,nqmx)
+
+c     Local variable for local intermediate calcul:
+      REAL zflubid(ngridmx)
+      REAL zplanck(ngridmx),zpopsk(ngridmx,nlayermx)
+      REAL zdum1(ngridmx,nlayermx)
+      REAL zdum2(ngridmx,nlayermx)
+      REAL ztim1,ztim2,ztim3, z1,z2
+      REAL ztime_fin
+      REAL zdh(ngridmx,nlayermx)
+      REAL pclc_min ! minimum of the cloud fraction over the whole domain
+      INTEGER length
+      PARAMETER (length=100)
+
+c local variables only used for diagnostic (output in file "diagfi" or "stats")
+c -----------------------------------------------------------------------------
+      REAL ps(ngridmx), zt(ngridmx,nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL fluxtop_sw_tot(ngridmx), fluxsurf_sw_tot(ngridmx)
+      character*2 str2
+      character*5 str5
+      real zdtdif(ngridmx,nlayermx), zdtadj(ngridmx,nlayermx)
+      real reff(ngridmx,nlayermx) ! effective dust radius (used if doubleq=T)
+      real qtot1,qtot2 ! total aerosol mass
+      integer igmin, lmin
+      logical tdiag
+
+      REAL zplev(ngrid,nlayermx+1),zplay(ngrid,nlayermx)
+      real hco2(nqmx),tmean, zlocal(nlayermx)
+      real rho(ngridmx,nlayermx) ! density
+      real vmr(ngridmx,nlayermx) ! volume mixing ratio
+
+      REAL time_phys
+
+!!! WRF for retrocompatibility with newphys
+      REAL tauTES(ngridmx)      ! column optical depth at 825 cm-1
+      REAL qsurfice(ngridmx)    ! pour diagnostics
+!!! WRF for retrocompatibility with newphys
+     
+c=======================================================================
+
+
+
+
+c 1. Initialisation:
+c -----------------
+ 
+
+c     Initialisation only at first call
+c     ---------------------------------
+      IF(firstcall) THEN
+
+c        variables set to 0
+c        ~~~~~~~~~~~~~~~~~~
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         call zerophys(ngrid*nlayer,dtrad)
+         call zerophys(ngrid,fluxrad)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c ****WRF
+c
+c	No need to use startfi.nc
+c		> part of the job of phyetat0 is done in inifis
+c		> remaining initializations are passed here from the WRF variables
+c		> beware, some operations were done by phyetat0 (ex: tracers)
+c			> if any problems, look in phyetat0
+c
+      tsurf(:)=wtsurf(:)
+      PRINT*,'check: tsurf ',tsurf(1),tsurf(ngridmx)
+      tsoil(:,:)=wtsoil(:,:)
+      PRINT*,'check: tsoil ',tsoil(1,1),tsoil(ngridmx,nsoilmx)
+      emis(:)=wemis(:)
+      PRINT*,'check: emis ',emis(1),emis(ngridmx)
+      q2(:,:)=wq2(:,:)
+      PRINT*,'check: q2 ',q2(1,1),q2(ngridmx,nlayermx+1)
+      qsurf(:,:)=wqsurf(:,:)
+      PRINT*,'check: qsurf ',qsurf(1,1),qsurf(ngridmx,nqmx)
+      co2ice(:)=wco2ice(:)
+      PRINT*,'check: co2 ',co2ice(1),co2ice(ngridmx)
+      day_ini=wday_ini
+
+c	artificially filling dyn3d/control.h is also required
+c	> iphysiq is put in WRF to be set easily (cf ptimestep)
+c	> day_step is simply deduced:
+c
+      day_step=daysec/ptimestep
+      PRINT*,'Call to LMD physics:',day_step,' per Martian day'
+c
+      iphysiq=ptimestep
+c
+      ecritphy=8.e18  !! a dummy low frequency
+      PRINT*,'Write LMD physics each:',ecritphy,' seconds'
+              !!PRINT*,ecri_phys  
+              !!PRINT*,float(ecri_phys) ...
+              !!renvoient tous deux des nombres absurdes 
+              !!pourtant callkeys.h est inclus ...
+              !!
+              !!donc ecritphys est passe en argument ... 
+      PRINT*,'Write LMD physics each:',ecritphy,' seconds'
+c
+c ****WRF
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+         if (pday.ne.day_ini) then
+           write(*,*) "***ERROR Pb de synchronisation entre phys et dyn"
+           write(*,*) "jour dynamique: ",pday
+           write(*,*) "jour physique: ",day_ini
+           stop
+         endif
+
+         write (*,*) 'In physic day_ini =', day_ini
+
+
+
+c        Initialize albedo and orbital calculation
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         CALL surfini(ngrid,co2ice,qsurf,albedo)
+         CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)
+
+c        initialisation soil 
+c        ~~~~~~~~~~~~~~~~~~~
+         IF (callsoil) THEN
+            CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+         ELSE
+            PRINT*,'WARNING! Thermal conduction in the soil turned off'
+            DO ig=1,ngrid
+               capcal(ig)=1.e5
+               fluxgrd(ig)=0.
+            ENDDO
+         ENDIF
+         icount=1
+
+
+c        initialisation pour les traceurs
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (tracer) THEN
+            CALL initracer(qsurf,co2ice)
+         ENDIF  ! end tracer
+
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c ****WRF
+c
+c nosense in mesoscale modeling
+c
+cc        Determining gridpoint near Viking Lander 1 (used for diagnostic only)
+cc        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         if(ngrid.ne.1) then
+c           latvl1= 22.27 
+c           lonvl1= -47.94 
+c           ig_vl1= 1+ int( (1.5-(latvl1-90.)*jjm/180.)  -2 )*iim +
+c     &              int(1.5+(lonvl1+180)*iim/360.)
+c           write(*,*) 'Viking Lander 1 GCM point: lat,lon',
+c     &              lati(ig_vl1)*180/pi, long(ig_vl1)*180/pi
+c         end if 
+c
+c ****WRF
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+c        Initializing thermospheric parameters
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         if (callthermos) call param_read
+
+c        Initializing R and Cp as constant
+
+         if (.not.callthermos .and. .not.photochem) then
+                 do l=1,nlayermx
+                  do ig=1,ngridmx
+                   rnew(ig,l)=r
+                   cpnew(ig,l)=cpp
+                   mmean(ig,l)=mugaz
+                   enddo
+                  enddo  
+         endif         
+                   
+      ENDIF        !  (end of "if firstcall")
+
+!!!!!!!!!!!!!!!!TEST TEST
+!      IF (nocalculphy) THEN
+!
+!            write(*,*) 'tendencies are not recalculated !'  
+!            pdu(:,:)=spdu(:,:) 
+!            pdv(:,:)=spdv(:,:)
+!            pdt(:,:)=spdt(:,:)
+!            pdq(:,:,:)=spdq(:,:,:)
+!            pdpsrf(:)=spdpsrf(:)
+!            write(*,*) pdu(100,10), pdv(100,10), pdt(100,10)  
+!      ELSE      
+!!!!!!!!!!!!!!!!TEST TEST
+
+
+c    ------------------------------------------
+c    Initialisations at every physical timestep:
+c    ------------------------------------------
+c
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in PHYSIQ'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+      zday=pday+ptime
+
+
+
+c     Computing Solar Longitude (Ls) :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (season) then 
+         PRINT*,'day',zday
+         CALL solarlong(zday,zls)
+      else
+         PRINT*,'day_ini',day_ini
+         call solarlong(float(day_ini),zls) 
+      end if
+
+
+c     Initializing various variable
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      call zerophys(ngrid*nlayer, pdv)
+      call zerophys(ngrid*nlayer, pdu)
+      call zerophys(ngrid*nlayer, pdt)
+      call zerophys(ngrid*nlayer*nq, pdq)
+      call zerophys(ngrid, pdpsrf)
+      call zerophys(ngrid, zflubid)
+      call zerophys(ngrid, zdtsurf)
+      call zerophys(ngrid*nq, dqsurf)
+      igout=ngrid/2+1 
+
+c     computing geopotentiel at interlayer levels
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     ponderation des altitudes au niveau des couches en dp/p
+
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            zzlay(ig,l)=pphi(ig,l)/g    
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+         zzlev(ig,1)=0.
+         zzlev(ig,nlayer+1)=1.e7    ! dummy top of last layer above 10000 km...
+      ENDDO
+      DO l=2,nlayer
+         DO ig=1,ngrid
+            z1=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
+            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         ENDDO
+      ENDDO
+
+
+!     Potential temperature calculation not the same in physiq and dynamic
+
+c     Computing potential temperature
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      DO l=1,nlayer
+         DO ig=1,ngrid 
+            zpopsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**rcp
+            zh(ig,l)=pt(ig,l)/zpopsk(ig,l)
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    1.5 Calculation of mean mass, cp, and R
+c    ---------------------------------------
+
+      if(photochem.or.callthermos) then
+         call concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+      endif
+c-----------------------------------------------------------------------
+c    2. Calcul of the radiative tendencies :
+c    ---------------------------------------
+
+
+      IF(callrad) THEN
+         IF( MOD(icount-1,iradia).EQ.0) THEN
+
+           write (*,*) 'call radiative transfer'
+
+c          Local Solar zenith angle
+c          ~~~~~~~~~~~~~~~~~~~~~~~~
+        
+           CALL orbite(zls,dist_sol,declin)
+
+           IF(diurnal) THEN
+               ztim1=SIN(declin)
+               ztim2=COS(declin)*COS(2.*pi*(zday-.5))
+               ztim3=-COS(declin)*SIN(2.*pi*(zday-.5))
+
+               CALL solang(ngrid,sinlon,coslon,sinlat,coslat,
+     s         ztim1,ztim2,ztim3, mu0,fract)
+
+           ELSE
+               CALL mucorr(ngrid,declin, lati, mu0, fract,10000.,rad)
+           ENDIF
+
+
+
+c          NLTE cooling from CO2 emission
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           IF(callnlte) CALL nltecool(ngrid,nlayer,pplay,pt,zdtnlte)
+
+
+c          Find number of layers for LTE radiation calculations
+           IF(MOD(iphysiq*(icount-1),day_step).EQ.0) THEN          
+                CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+           ENDIF
+
+
+c          Atmospheric dust opacity and aerosol distribution:
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+cc*****WRF
+         CALL meso_dustopacity(ngrid,nlayer,nq,
+     $          zday,pplay,pplev,zls,pq,
+     $      tauref,tau,aerosol)
+
+cc*****WRF
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+        
+c          Calling main radiative transfer scheme
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c          Transfer through dust and CO2, except NIR CO2 absorption
+
+c ----------
+c partie rajoutee par Franck, commentee pour l'instant
+c ----------
+c
+c           if (ngridmx.eq.1) pclc(1)=1. !TEST for 1D simulation
+c
+c           pclc_min=1.
+c           if (activice.and.naerkind.gt.1) then
+c             do ig=1,ngrid
+c               pclc_min=min(pclc_min,pclc(ig))
+c             enddo
+c           endif
+c
+c           IF(activice.and.naerkind.gt.1.and.pclc_min.lt.1) THEN
+c          Computing radiative tendencies accounting for a cloudy area (0< pclc(ngrid) <1)
+c          pclc is set in initracer (prescribed for the moment).
+c          two steps : 1/rad. tend. without clouds (aerosol(*,*,2)=0.)
+c          ~~~~~~~~~   2/rad. tend. with clouds
+c                      3/final tendencies=average of 1/ and 2/ weighted by the
+cloud area (pclc)
+c
+c
+c 1/
+c           call zerophys(nlayer*ngrid,aerosol(1,1,2))  !remettre
+c           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+c     $     cldtlw,cldtsw,clsurf_lw,clsurf_sw,cltop_lw,cltop_sw)
+c
+c 2/
+c           CALL h2oiceopacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,
+c     $     tau,aerosol,zls,co2ice)
+c
+c           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+c     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+c
+c 3/
+c           do l=1,nlayer
+c             do ig=1,ngrid
+c             zdtlw(ig,l)=(1.-pclc(ig))*cldtlw(ig,l)+pclc(ig)*zdtlw(ig,l)
+c             zdtsw(ig,l)=(1.-pclc(ig))*cldtsw(ig,l)+pclc(ig)*zdtsw(ig,l)
+c             enddo
+c           enddo
+c           do ig=1,ngrid
+c             fluxsurf_lw(ig)=(1.-pclc(ig))*clsurf_lw(ig)+
+c     $        pclc(ig)*fluxsurf_lw(ig)
+c             fluxtop_lw(ig)=(1.-pclc(ig))*cltop_lw(ig)+
+c     $        pclc(ig)*fluxtop_lw(ig)
+c
+c             fluxsurf_sw(ig,1)=(1.-pclc(ig))*clsurf_sw(ig,1)+
+c     $        pclc(ig)*fluxsurf_sw(ig,1)
+c             fluxsurf_sw(ig,2)=(1.-pclc(ig))*clsurf_sw(ig,2)+
+c     $        pclc(ig)*fluxsurf_sw(ig,2)
+c
+c             fluxtop_sw(ig,1)=(1.-pclc(ig))*cltop_sw(ig,1)+
+c     $        pclc(ig)*fluxtop_sw(ig,1)
+c             fluxtop_sw(ig,2)=(1.-pclc(ig))*cltop_sw(ig,2)+
+c     $        pclc(ig)*fluxtop_sw(ig,2)
+c           enddo
+c
+c           ELSE
+c
+c          Atmospheric water ice opacity and particle distribution:
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+c           if (activice.and.naerkind.gt.1)
+c     &      CALL h2oiceopacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,
+c     &      tau,aerosol,zls,co2ice)
+c
+c
+c ----------
+c  fin partie rajoutee par Franck (plus ENDIF ci-dessous)
+c ----------
+
+
+!          DO ig=1,ngrid
+!            DO l=1,nlayer
+!                   IF ( (pplev(ig,l+1) - pplev(ig,l) ) .gt. 0. )
+!     .                PRINT*,'pb1 ',
+!     .                        pplev(ig,l),
+!     .                        pplev(ig,l+1),
+!     .                        pplev(ig,l+1)-pplev(ig,l),
+!     .                        l,
+!     .                        ig
+!            ENDDO
+!         ENDDO
+
+           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+
+!           DO ig=1,ngrid
+!            zdtlw(ig)=zdtlw(1)
+!            zdtsw(ig)=zdtsw(1)
+!            fluxsurf_lw(ig)=fluxsurf_lw(1)
+!            fluxsurf_sw(ig,1)=fluxsurf_sw(1,1)
+!            fluxsurf_sw(ig,2)=fluxsurf_sw(1,2)
+!            fluxtop_lw(ig)=fluxtop_lw(1)
+!            fluxtop_sw(ig,1)=fluxtop_sw(1,1) 
+!            fluxtop_sw(ig,2)=fluxtop_sw(1,2)
+!           ENDDO
+
+c ----------
+c           ENDIF ! end of condition on the cloudy fraction
+c ----------
+
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccc
+ccccc PARAM SLOPE : Insolation (direct + scattered)
+ccccc
+      DO ig=1,ngrid  
+        sl_the = theta_sl(ig)
+        IF (sl_the .ne. 0.) THEN
+         ztim1=fluxsurf_sw(ig,1)+fluxsurf_sw(ig,2)
+          DO l=1,2
+           sl_lct = ptime*24. + 180.*long(ig)/pi/15.
+           sl_ra  = pi*(1.0-sl_lct/12.)
+           sl_lat = 180.*lati(ig)/pi
+           sl_tau = tau(ig,1)
+           sl_alb = albedo(ig,l)
+           sl_psi = psi_sl(ig)
+           sl_fl0 = fluxsurf_sw(ig,l)
+           sl_di0 = 0.
+           if (mu0(ig) .gt. 0.) then
+            sl_di0 = mu0(ig)*(exp(-sl_tau/mu0(ig)))
+            sl_di0 = sl_di0*1370./dist_sol/dist_sol
+            sl_di0 = sl_di0/ztim1
+            sl_di0 = fluxsurf_sw(ig,l)*sl_di0
+           endif
+           ! sait-on jamais (a cause des arrondis)
+           if (sl_fl0 .lt. sl_di0) sl_di0=sl_fl0
+     !!!!!!!!!!!!!!!!!!!!!!!!!!
+        CALL param_slope( mu0(ig), declin, sl_ra, sl_lat, 
+     &            sl_tau, sl_alb, 
+     &            sl_the, sl_psi, sl_di0, sl_fl0, sl_flu)
+     !!!!!!!!!!!!!!!!!!!!!!!!!!
+           fluxsurf_sw(ig,l) = sl_flu
+                !!      sl_ls = 180.*zls/pi
+                !!      sl_lct = ptime*24. + 180.*long(ig)/pi/15.
+                !!      sl_lat = 180.*lati(ig)/pi
+                !!      sl_tau = tau(ig,1)
+                !!      sl_alb = albedo(ig,l)
+                !!      sl_the = theta_sl(ig)
+                !!      sl_psi = psi_sl(ig)
+                !!      sl_fl0 = fluxsurf_sw(ig,l)
+                !!      CALL param_slope_full(sl_ls, sl_lct, sl_lat, 
+                !!     &                   sl_tau, sl_alb, 
+                !!     &                   sl_the, sl_psi, sl_fl0, sl_flu)
+          ENDDO
+          !!! compute correction on IR flux as well
+          sky= (1.+cos(pi*theta_sl(ig)/180.))/2.
+          fluxsurf_lw(ig)= fluxsurf_lw(ig)*sky
+        ENDIF    
+      ENDDO
+ccccc
+ccccc PARAM SLOPE
+ccccc
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+c          CO2 near infrared absorption
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           call zerophys(ngrid*nlayer,zdtnirco2)
+           if (callnirco2) then
+              call nirco2abs (ngrid,nlayer,pplay,dist_sol,
+     .                       mu0,fract,declin, zdtnirco2)
+           endif
+
+
+c          Radiative flux from the sky absorbed by the surface (W.m-2)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           DO ig=1,ngrid
+               fluxrad_save(ig)=emis(ig)*fluxsurf_lw(ig)
+     $         +fluxsurf_sw(ig,1)*(1.-albedo(ig,1))
+     $         +fluxsurf_sw(ig,2)*(1.-albedo(ig,2))
+
+            !print*,'RAD ', fluxrad_save(ig)
+            !print*,'LW ', emis(ig)*fluxsurf_lw(ig)
+            !print*,'SW ', fluxsurf_sw(ig,2)*(1.-albedo(ig,2))
+
+           ENDDO
+
+
+
+c          Net atmospheric radiative heating rate (K.s-1)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           IF(callnlte) THEN
+              CALL blendrad(ngrid, nlayer, pplay,
+     &             zdtsw, zdtlw, zdtnirco2, zdtnlte, dtrad)
+           ELSE
+              DO l=1,nlayer
+                 DO ig=1,ngrid
+                    dtrad(ig,l)=zdtsw(ig,l)+zdtlw(ig,l)
+     &                          +zdtnirco2(ig,l)
+                  ENDDO
+              ENDDO
+           ENDIF
+
+           !PRINT*,'zdtsw',zdtsw
+           !PRINT*,'zdtlw',zdtlw
+           !PRINT*,'zdtnirco2',zdtnirco2
+           !PRINT*,'dtrad',dtrad
+
+
+        ENDIF ! mod(icount-1,iradia).eq.0
+
+c    Transformation of the radiative tendencies:
+c    -----------------------------------------------
+
+c          Net radiative surface flux (W.m-2)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~
+           DO ig=1,ngrid
+               zplanck(ig)=tsurf(ig)*tsurf(ig)
+               zplanck(ig)=emis(ig)*
+     $         stephan*zplanck(ig)*zplanck(ig)
+               fluxrad(ig)=fluxrad_save(ig)-zplanck(ig)
+cccc
+cccc param slope
+cccc
+               sky= (1.+cos(pi*theta_sl(ig)/180.))/2.
+               fluxrad(ig)=fluxrad(ig)+(1.-sky)*zplanck(ig)
+cccc
+cccc
+cccc
+           ENDDO
+
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+dtrad(ig,l)
+            ENDDO
+         ENDDO
+
+      ENDIF
+
+
+
+!c-----------------------------------------------------------------------
+!c    3. Gravity wave and subgrid scale topography drag :
+!c    -------------------------------------------------
+!
+!
+!      IF(calllott)THEN
+!
+!        CALL calldrag_noro(ngrid,nlayer,ptimestep,
+!     &                 pplay,pplev,pt,pu,pv,zdtgw,zdugw,zdvgw)
+! 
+!        DO l=1,nlayer
+!          DO ig=1,ngrid
+!            pdv(ig,l)=pdv(ig,l)+zdvgw(ig,l)
+!            pdu(ig,l)=pdu(ig,l)+zdugw(ig,l)
+!            pdt(ig,l)=pdt(ig,l)+zdtgw(ig,l)
+!          ENDDO
+!        ENDDO
+!      ENDIF
+
+c-----------------------------------------------------------------------
+c    4. Vertical diffusion (turbulent mixing):
+c    -----------------------------------------
+c
+
+      IF(calldifv) THEN
+
+         DO ig=1,ngrid
+            zflubid(ig)=fluxrad(ig)+fluxgrd(ig)
+         ENDDO
+
+         CALL zerophys(ngrid*nlayer,zdum1)
+         CALL zerophys(ngrid*nlayer,zdum2)
+         do l=1,nlayer
+            do ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            enddo
+         enddo
+
+
+c        Calling vdif (Martian version WITH CO2 condensation)
+         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
+     $        ptimestep,capcal,lwrite,
+     $        pplay,pplev,zzlay,zzlev,z0,
+     $        pu,pv,zh,pq,tsurf,emis,qsurf,
+     $        zdum1,zdum2,zdh,pdq,zflubid,
+     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
+     &        zdqdif,zdqsdif)
+
+         DO ig=1,ngrid
+          !! sensible heat flux in W/m2
+          sensheat(ig) = zflubid(ig)-capcal(ig)*zdtsdif(ig)
+          !! u star in similarity theory in m/s
+          ustar(ig) = 0.4
+     .               * sqrt( pu(ig,1)*pu(ig,1) + pv(ig,1)*pv(ig,1) )
+     .               / log( 1.E+0 + zzlay(ig,1)/z0 )
+         ENDDO   
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! LES LES 
+       IF (flag_LES) THEN        
+
+         write (*,*) '************************************************' 
+         write (*,*) '** LES mode: the difv part is only used to'
+         write (*,*) '**  provide HFX and UST to the dynamics'
+         write (*,*) '** NB: - dudif, dvdif, dhdif, dqdif are set to 0'
+         write (*,*) '**     - tsurf is updated'     
+         write (*,*) '************************************************'
+
+!
+          DO l=1,nlayer
+            zdvdif(ig,l) = 0.
+            zdudif(ig,l) = 0.
+            zdhdif(ig,l) = 0.
+            DO iq=1, nq
+              zdqdif(ig,l,iq) = 0.
+              zdqsdif(ig,iq) = 0. !! sortir de la boucle
+            ENDDO 
+          ENDDO
+!
+!         ENDDO
+         !write (*,*) 'RAD ',fluxrad(igout)
+         !write (*,*) 'GRD ',fluxgrd(igout)
+         !write (*,*) 'dTs/dt ',capcal(igout)*zdtsurf(igout)
+      ENDIF
+!!! LES LES        
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+
+               pdv(ig,l)=pdv(ig,l)+zdvdif(ig,l)
+               pdu(ig,l)=pdu(ig,l)+zdudif(ig,l)
+               pdt(ig,l)=pdt(ig,l)+zdhdif(ig,l)*zpopsk(ig,l)
+
+               zdtdif(ig,l)=zdhdif(ig,l)*zpopsk(ig,l) ! for diagnostic only
+
+            ENDDO
+         ENDDO
+
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+zdtsdif(ig)
+         ENDDO
+!!!!gros caca : sans chaleur sensible
+!         DO ig=1,ngrid
+!            zdtsurf(ig)=zdtsurf(ig)+
+!     s      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+!         ENDDO
+
+
+         if(tracer) then 
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdif(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+           DO iq=1, nq
+              DO ig=1,ngrid
+                 dqsurf(ig,iq)=dqsurf(ig,iq) + zdqsdif(ig,iq)
+              ENDDO
+           ENDDO
+         end if
+
+      ELSE    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     s      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+         ENDDO
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         IF (flag_LES) THEN
+            write(*,*) 'LES mode !' 
+            write(*,*) 'Please set calldifv to T in callphys.def'
+            STOP
+         ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ENDIF
+
+
+c-----------------------------------------------------------------------
+c   5. Dry convective adjustment:
+c   -----------------------------
+
+      IF(calladj) THEN
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            ENDDO
+         ENDDO
+         CALL zerophys(ngrid*nlayer,zduadj)
+         CALL zerophys(ngrid*nlayer,zdvadj)
+         CALL zerophys(ngrid*nlayer,zdhadj)
+
+         CALL convadj(ngrid,nlayer,nq,ptimestep,
+     $                pplay,pplev,zpopsk,
+     $                pu,pv,zh,pq,
+     $                pdu,pdv,zdh,pdq,
+     $                zduadj,zdvadj,zdhadj,
+     $                zdqadj)
+
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdu(ig,l)=pdu(ig,l)+zduadj(ig,l)
+               pdv(ig,l)=pdv(ig,l)+zdvadj(ig,l)
+               pdt(ig,l)=pdt(ig,l)+zdhadj(ig,l)*zpopsk(ig,l)
+
+               zdtadj(ig,l)=zdhadj(ig,l)*zpopsk(ig,l) ! for diagnostic only
+            ENDDO
+         ENDDO
+
+         if(tracer) then 
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqadj(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         end if
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   6. Carbon dioxide condensation-sublimation:
+c   -------------------------------------------
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !!! get the actual co2 seasonal cap from Titus observations
+      !!! (inherited from GCM only at first step, but not a big deal)
+      IF (tituscap) THEN
+         CALL geticecover( ngrid, 180.*zls/pi,
+     .                  180.*long/pi, 180.*lati/pi, co2ice )
+         co2ice(:) = co2ice(:)*10000.
+         emis(:) = 0.95 ! so that points outside the cap are indeed at 0.95
+                        ! avoid unwanted patchiness from GCM initial state
+      ENDIF
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      IF(callcond) THEN
+         CALL newcondens(ngrid,nlayer,nq,ptimestep,
+     $              capcal,pplay,pplev,tsurf,pt,
+     $              pphi,pdt,pdu,pdv,zdtsurf,pu,pv,pq,pdq,
+     $              co2ice,albedo,emis,
+     $              zdtc,zdtsurfc,pdpsrf,zduc,zdvc,zdqc,
+     $	            fluxsurf_sw) 
+
+         !! Titus cap security. 
+         !! -- neglect pressure changes caused by sublimation/condensation
+         IF (tituscap) THEN 
+           DO ig=1,ngrid
+             pdpsrf(ig) = 0.
+           ENDDO
+         ENDIF
+
+         DO l=1,nlayer
+           DO ig=1,ngrid
+             pdt(ig,l)=pdt(ig,l)+zdtc(ig,l)
+             pdv(ig,l)=pdv(ig,l)+zdvc(ig,l)
+             pdu(ig,l)=pdu(ig,l)+zduc(ig,l)
+           ENDDO
+         ENDDO
+         DO ig=1,ngrid
+            zdtsurf(ig) = zdtsurf(ig) + zdtsurfc(ig)
+            ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+         ENDDO
+
+         IF(tracer) THEN
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqc(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         END IF !(tracer)
+
+      ENDIF  !(callcond) 
+
+c        print*,'condens ok'
+c-----------------------------------------------------------------------
+c   7. Specific parameterizations for tracers 
+c:   -----------------------------------------
+
+      if(tracer) then 
+
+c   7a. Water and ice
+c     ---------------
+
+c        ---------------------------------------
+c        Water ice condensation in the atmosphere
+c        ----------------------------------------
+         IF (water) THEN
+
+           call watercloud(ngrid,nlayer, ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,qsurf,zdqscloud,zdtcloud,
+     &                nq,naerkind,tau,icount,zls)
+
+           if (activice) then
+c Temperature variation due to latent heat release
+           DO l=1,nlayer
+             DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+             ENDDO
+           ENDDO
+           endif
+
+           IF (iceparty) then
+             iqmin=nq-1
+           ELSE
+             iqmin=nq
+           ENDIF
+
+           DO iq=iqmin,nq
+             DO l=1,nlayer
+                DO ig=1,ngrid
+                   pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqcloud(ig,l,iq)
+                ENDDO
+             ENDDO
+             DO ig=1,ngrid
+                dqsurf(ig,iq)= dqsurf(ig,iq) + zdqscloud(ig,iq)
+             ENDDO
+           ENDDO
+
+         END IF  ! (water)
+
+c   7b. Chemical species
+c     ------------------
+
+!c        --------------
+!c        photochemistry :
+!c        --------------
+!         IF(photochem .or. thermochem) then
+!          call calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+!     .      zzlay,zday,pq,pdq,zdqchim,zdqschim,zdqcloud,zdqscloud)
+!           
+!c Photochemistry includes condensation of H2O2
+!
+!           do iq=nqchem_min,nq
+!            if (noms(iq).eq."h2o2") then
+!             DO l=1,nlayer
+!               DO ig=1,ngrid
+!                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqchim(ig,l,iq)
+!                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqcloud(ig,l,iq)
+!               ENDDO
+!             ENDDO
+!            else
+!             DO l=1,nlayer
+!               DO ig=1,ngrid
+!                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqchim(ig,l,iq)
+!               ENDDO
+!             ENDDO
+!            endif
+!           ENDDO
+!           do iq=nqchem_min,nq
+!            if (noms(iq).eq."h2o2") then
+!               DO ig=1,ngrid
+!                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqschim(ig,iq)
+!                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqscloud(ig,iq)
+!               ENDDO
+!            else
+!               DO ig=1,ngrid
+!                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqschim(ig,iq)
+!               ENDDO
+!            endif
+!           ENDDO
+!
+!         END IF  ! (photochem.or.thermochem)
+!c        print*,'photochem ok'
+
+c   7c. Aerosol particles
+c     -------------------
+
+c        ----------
+c        Dust devil :
+c        ----------
+         IF(callddevil) then 
+           call dustdevil(ngrid,nlayer,nq, pplev,pu,pv,pt, tsurf,q2,
+     &                zdqdev,zdqsdev)
+ 
+           if (dustbin.ge.1) then
+              do iq=1,nq
+                 DO l=1,nlayer
+                    DO ig=1,ngrid
+                       pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdev(ig,l,iq)
+                    ENDDO
+                 ENDDO
+              enddo
+              do iq=1,nq
+                 DO ig=1,ngrid
+                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqsdev(ig,iq)
+                 ENDDO
+              enddo
+           endif  ! (test sur dustbin)
+
+         END IF
+
+c        ------------- 
+c        Sedimentation :   acts also on water ice
+c        ------------- 
+         IF (sedimentation) THEN 
+           call zerophys(ngrid*nlayer*nq, zdqsed)
+           call zerophys(ngrid*nq, zdqssed)
+
+           if(doubleq) then
+            call callsedim2q(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           else
+            call callsedim(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           end if
+
+
+           DO iq=1, nq
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqsed(ig,l,iq)
+               ENDDO
+             ENDDO
+           ENDDO
+           DO iq=1, nq
+             DO ig=1,ngrid
+                dqsurf(ig,iq)= dqsurf(ig,iq) + zdqssed(ig,iq)
+             ENDDO
+           ENDDO
+         END IF   ! (sedimentation)
+
+c        print*,'sedim ok'
+
+c   7d. Updates
+c     ---------
+
+        DO iq=1, nq
+          DO ig=1,ngrid
+
+c       ---------------------------------
+c       Updating tracer budget on surface
+c       ---------------------------------
+            qsurf(ig,iq)=qsurf(ig,iq)+ptimestep*dqsurf(ig,iq)
+
+          ENDDO  ! (ig)
+        ENDDO    ! (iq)
+
+      END IF    ! (tracer) 
+
+c        print*,'tracers ok'
+
+
+!c-----------------------------------------------------------------------
+!c   8.5 THERMOSPHERE CALCULATION
+!c-----------------------------------------------------------------------
+!
+!      if (callthermos) then
+!        call thermosphere(pplev,pplay,dist_sol,
+!     $     mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay,
+!     &     pt,pq,pu,pv,pdt,pdq,
+!     $     zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff)
+!c           do iq=nqchem_min,nq
+!c           write(*,*) 'thermo iq,pq',iq,pq(690,1,iq)
+!c           enddo
+!
+!        DO l=1,nlayer
+!          DO ig=1,ngrid
+!            dtrad(ig,l)=dtrad(ig,l)+zdteuv(ig,l)
+!            pdt(ig,l)=pdt(ig,l)+zdtconduc(ig,l)
+!     &                         +zdteuv(ig,l)
+!            pdv(ig,l)=pdv(ig,l)+zdvmolvis(ig,l)
+!            pdu(ig,l)=pdu(ig,l)+zdumolvis(ig,l)
+!            DO iq=1, nq
+!              pdq(ig,l,iq)=pdq(ig,l,iq)+zdqmoldiff(ig,l,iq)
+!            ENDDO
+!          ENDDO
+!        ENDDO
+!
+!
+!      endif
+
+c-----------------------------------------------------------------------
+c   8. Surface  and sub-surface soil temperature
+c-----------------------------------------------------------------------
+c
+c
+c   Surface temperature incrementation :
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      DO ig=1,ngrid
+         tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig) 
+      ENDDO
+
+
+c  Prescription piege froid au pole sud (Except at high obliquity !!)
+c  temperature en surface = temperature equilibre de phases du CO2
+       
+      IF (tracer.AND.water.AND.ngridmx.NE.1) THEN
+         !if (caps.and.(obliquit.lt.27.)) then
+         !  tsurf(ngrid)=1/(1/136.27-r/5.9e+5*alog(0.0095*ps(ngrid)))
+         !endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!! note WRF MESOSCALE AYMERIC -- mot cle "caps"
+!!!!! watercaptag n'est plus utilise que dans vdifc
+!!!!! ... pour que la sublimation ne soit pas stoppee 
+!!!!! ... dans la calotte permanente nord si qsurf=0
+!!!!! on desire garder cet effet regle par caps=T
+!!!!! on a donc commente "if (caps.and.(obliquit.lt.27.))" ci-dessus
+!!!!! --- remplacer ces lignes par qqch de plus approprie
+!!!!!      si on s attaque a la calotte polaire sud
+!!!!! pas d'autre occurrence majeure du mot-cle "caps"
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+c       -------------------------------------------------------------
+c       Change of surface albedo (set to 0.4) in case of ground frost
+c       everywhere except on the north permanent cap and in regions
+c       covered by dry ice. 
+c              ALWAYS PLACE these lines after newcondens !!!
+c       -------------------------------------------------------------
+         do ig=1,ngrid
+
+c       -------------- Version temporaire fit TES 2008 ------------
+         if (co2ice(ig).eq.0.and.qsurf(ig,nqmx).gt.0.005) then
+              albedo(ig,1)=0.45
+              albedo(ig,2)=0.45                                     
+          endif
+
+c         if (co2ice(ig).eq.0.and.qsurf(ig,nqmx).gt.0.005) then
+c           if (.not.watercaptag(ig)) then
+c             albedo(ig,1)=0.4
+c             albedo(ig,2)=0.4
+c           endif
+c         endif
+c       -------------- version Francois ---------------
+c          if (co2ice(ig).eq.0.and.
+c    &        ((qsurf(ig,nqmx).gt.0.005).or.(watercaptag(ig)))) then
+c              albedo(ig,1)=max(0.4,albedodat(ig))
+c              albedo(ig,2)=albedo(ig,1)
+c          endif
+c       ---------------------------------------------
+         enddo  ! of do ig=1,ngrid
+      ENDIF  ! of IF (tracer.AND.water.AND.ngridmx.NE.1)
+
+
+c        print*,'tracer, water and 3D ok'
+
+c
+c   soil temperatures and subsurface heat flux:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (callsoil) THEN
+         CALL soil(ngrid,nsoilmx,.false.,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+      ENDIF
+
+c        print*,'soil ok'
+
+
+
+
+
+c-----------------------------------------------------------------------
+c  9. Writing output files
+c  ------------------------
+
+c    -------------------------------
+c    Dynamical fields incrementation
+c    -------------------------------
+c (FOR OUTPUT ONLY : the actual model integration is performed in the dynamics)
+
+      DO l=1,nlayer
+        DO ig=1,ngrid
+          zt(ig,l)=pt(ig,l)  + pdt(ig,l)*ptimestep
+          zu(ig,l)=pu(ig,l)  + pdu(ig,l)*ptimestep
+          zv(ig,l)=pv(ig,l)  + pdv(ig,l)*ptimestep
+        ENDDO
+      ENDDO
+      DO iq=1, nq
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            zq(ig,l,iq)=pq(ig,l,iq) +pdq(ig,l,iq)*ptimestep
+          ENDDO
+        ENDDO
+      ENDDO
+      DO ig=1,ngrid
+          ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep !already in 7
+      ENDDO
+      DO l=1,nlayer
+        DO ig=1,ngrid
+             zplev(ig,l)=pplev(ig,l)/pplev(ig,1)*ps(ig)
+             zplay(ig,l)=pplay(ig,l)/pplev(ig,1)*ps(ig)
+        ENDDO
+      ENDDO
+      ! Density calculation
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            rho(ig,l) = zplay(ig,l)/(rnew(ig,l)*zt(ig,l))
+         ENDDO
+      ENDDO
+
+c     Sum of fluxes in solar spectral bands (for output only)
+      DO ig=1,ngrid
+            fluxtop_sw_tot(ig)=fluxtop_sw(ig,1) + fluxtop_sw(ig,2)
+            fluxsurf_sw_tot(ig)=fluxsurf_sw(ig,1) + fluxsurf_sw(ig,2)
+      ENDDO
+c ******* TEMPORAIRE ************************************************
+      ztim1 = 999
+      DO l=1,nlayer
+        DO ig=1,ngrid
+           if (pt(ig,l).lt.ztim1) then
+               ztim1 = pt(ig,l)
+               igmin = ig
+               lmin = l 
+           end if
+        ENDDO
+      ENDDO
+      if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then
+        write(*,*) 'stability WARNING :' 
+        write(*,*) 'pt, zt Tmin = ', pt(igmin,lmin), zt(igmin,lmin),
+     &              'ig l =', igmin, lmin
+      end if
+c *******************************************************************
+
+c     --------------------
+c     Output on the screen 
+c     --------------------
+
+
+      IF (lwrite) THEN
+         PRINT*,'Global diagnostics for the physics'
+         PRINT*,'Variables and their increments x and dx/dt * dt'
+         WRITE(*,'(a6,a10,2a15)') 'Ts','dTs','ps','dps'
+         WRITE(*,'(2f10.5,2f15.5)')
+     s   tsurf(igout),zdtsurf(igout)*ptimestep,
+     s   pplev(igout,1),pdpsrf(igout)*ptimestep
+         WRITE(*,'(a4,a6,5a10)') 'l','u','du','v','dv','T','dT'
+         WRITE(*,'(i4,6f10.5)') (l,
+     s   pu(igout,l),pdu(igout,l)*ptimestep,
+     s   pv(igout,l),pdv(igout,l)*ptimestep,
+     s   pt(igout,l),pdt(igout,l)*ptimestep,
+     s   l=1,nlayer)
+      ENDIF
+
+cc****WRF
+cc      IF (ngrid.NE.1) THEN
+c	PRINT*,'check - values after update at ngrid/2+1'
+c         WRITE(*,'(a4,a6,2a10)') 'l','u','v','T'
+c         WRITE(*,'(i4,3f10.5)') (l,
+c     s   zu(igout,l),
+c     s   zv(igout,l),
+c     s   zt(igout,l),
+c     s   l=1,nlayer)
+c
+cc****WRF
+
+         print*,'Ls =',zls*180./pi,
+     &   ' tauref(700 Pa,lat=0) =',tauref(ngrid/2)
+c     &   ' tau(Viking1) =',tau(ig_vl1,1)
+
+
+c        -------------------------------------------------------------------
+c        Writing NetCDF file  "RESTARTFI" at the end of the run
+c        -------------------------------------------------------------------
+c        Remarque : On  stocke restarfi 
+c        juste avant que la dynamique ne le soit dans restart.
+c        entre maintenant et l'ecriture de restart,
+c        on aura itau = itau +1 et remise a jour de time.
+c        (lastcall = .true. lorsque itau+1 = itaufin)
+c        Donc on stocke  avec time = time + dtvr
+
+         IF(lastcall) THEN
+            ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec) 
+            write(*,*)'pour physdem ztime_fin =',ztime_fin
+            call physdem1("restartfi.nc",long,lati,nsoilmx,nq,
+     .              ptimestep,pday,
+     .              ztime_fin,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              area,albedodat,inertiedat,zmea,zstd,zsig,
+     .              zgam,zthe)
+         ENDIF
+
+
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+      do ig=1,ngrid
+         wtsurf(ig) = tsurf(ig)    !! surface temperature
+         wco2ice(ig) = co2ice(ig)  !! co2 ice 
+
+         !!! TEMP TEMP TEMP TEMP TEMP TEMP TEMP
+         !!! specific to WRF WRF WRF
+         !!! just to output water ice on surface
+         !!! [it might not be water ice on surface but OK]
+         !!! uncomment the Registry entry
+         qsurflast(ig) = qsurf(ig,nqmx)
+
+      enddo
+c
+c THIS INCLUDE IS AUTOMATICALLY GENERATED FROM REGISTRY
+c
+#include "fill_save.inc"
+c
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+
+
+cc-----------------------------------
+cc you can still use meso_WRITEDIAGFI (e.g. for debugging purpose), 
+cc though this is not the default strategy now
+cc-----------------------------------
+cc please use cudt in namelist.input to set frequency of outputs
+cc----------------------------------- 
+cc BEWARE: if at least one call to meso_WRITEDIAGFI is performed,
+cc cudt cannot be 0 - otherwise you'll get a "Floating exception"
+cc-----------------------------------         
+!      call meso_WRITEDIAGFI(ngrid,"tauref",
+!     .  "tauref","W.m-2",2,
+!     .       tauref)
+!      call meso_WRITEDIAGFI(ngrid,"dtrad",
+!     .  "dtrad","W.m-2",2,
+!     .       dtrad)
+c      call meso_WRITEDIAGFI(ngrid,"tsurf",
+c     .  "tsurf","K",2,
+c     .       tsurf)
+c
+!      call meso_WRITEDIAGFI(ngrid,"zt",
+!     .  "zt","W.m-2",3,
+!     .       zt)
+!      call meso_WRITEDIAGFI(ngrid,"zdtlw",
+!     .  "zdtlw","W.m-2",2,
+!     .       zdtlw)
+!      call meso_WRITEDIAGFI(ngrid,"zdtsw",
+!     .  "zdtsw","W.m-2",2,
+!     .       zdtsw)
+
+
+      icount=icount+1
+
+!!!!!!!!!!!!!TEST TEST
+!        ENDIF
+!!!!!!!!!!!!!TEST TEST      
+
+      write(*,*) 'now, back to the dynamical core...'
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/planete.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/planete.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/planete.h	(revision 2744)
@@ -0,0 +1,14 @@
+c-----------------------------------------------------------------------
+c INCLUDE planet.h
+
+      COMMON/planet/aphelie,periheli,year_day,peri_day,
+     $       obliquit,
+     $       z0,lmixmin,emin_turb,coefvis,coefir,
+     $       timeperi,e_elips,p_elips,unitastr
+
+      REAL aphelie,periheli,year_day,peri_day,
+     $     obliquit,
+     $     z0,lmixmin,emin_turb,coefvis,coefir,
+     $       timeperi,e_elips,p_elips,unitastr
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/profile.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/profile.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/profile.F	(revision 2744)
@@ -0,0 +1,223 @@
+      SUBROUTINE profile(unit,nlev,zkm,temp)
+      IMPLICIT NONE
+c=======================================================================
+c     Subroutine utilisee dans le modele 1-D  "testphys1d"
+c     pour l'initialisation du profil atmospherique
+c=======================================================================
+c
+c   differents profils d'atmospheres. T=f(z)
+c   entree:
+c     unit    unite de lecture de "testphys1d.def"
+c     nlev    nombre de niveaux
+c     zkm     alititudes en km
+c     ichoice choix de l'atmosphere:
+c             1 Temperature constante
+c             2 profil Savidjari
+c             3 Lindner (profil polaire)
+c             4 Inversion pour Francois
+c             5 Seiff (moyen)
+c             6 T constante + perturbation gauss (level) (christophe 10/98)
+c             7 T constante + perturbation gauss   (km)  (christophe 10/98)
+c             8 Lecture du profile dans un fichier ASCII (profile)
+c     tref    temperature de reference
+c     isin    ajout d'une perturbation (isin=1)
+c     pic     pic perturbation gauss pour ichoice = 6 ou 7
+c     largeur largeur de la perturbation gauss pour ichoice = 6 ou 7
+c     hauteur hauteur de la perturbation gauss pour ichoice = 6 ou 7
+c
+c   sortie:
+c     temp    temperatures en K
+c     
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c   arguments:
+c   ----------
+
+       INTEGER nlev, unit
+       REAL zkm(nlev),temp(nlev)
+
+c   local:
+c   ------
+
+      INTEGER il,ichoice,nseiff,iseiff,isin,iter
+      REAL pi
+      PARAMETER(nseiff=37)
+      REAL tref,t1,t2,t3,ww
+      REAL tseiff(nseiff)
+      DATA tseiff/214.,213.8,213.4,212.4,209.3,205.,201.4,197.8,
+     $           194.6,191.4,188.2,185.2,182.5,180.,177.5,175,
+     $           172.5,170.,167.5,164.8,162.4,160.,158.,156.,
+     $           154.1,152.2,150.3,148.7,147.2,145.7,144.2,143.,
+     $           142.,141.,140,139.5,139./
+      REAL pic,largeur
+      REAL hauteur,tmp
+
+c-----------------------------------------------------------------------
+c   choix du profile:
+c   -----------------
+
+      READ(unit,*) 
+      READ(unit,*) 
+      READ(unit,*) 
+      READ(unit,*) ichoice
+      READ(unit,*) tref
+      READ(unit,*,ERR=200) isin
+      READ(unit,*) pic
+      READ(unit,*) largeur
+      READ(unit,*) hauteur
+      GOTO 200
+100   STOP'fichier profile.def inexistant'
+200   CONTINUE
+      CLOSE(unit)
+c-----------------------------------------------------------------------
+c   ichoice=1 temperature constante:
+c   --------------------------------
+
+      IF(ichoice.EQ.1) THEN
+         DO il=1,nlev
+            temp(il)=tref
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=2 savidjari:
+c   --------------------
+
+      ELSE IF(ichoice.EQ.2) THEN
+         DO il=1,nlev
+            temp(il)=AMAX1(219.-2.5*zkm(il),140.)
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=3 Lindner:
+c   ------------------
+
+      ELSE IF(ichoice.EQ.3) THEN
+         DO il=1,nlev
+            IF(zkm(il).LT.2.5) THEN
+               temp(il)=150.+30.*zkm(il)/2.5
+            ELSE IF(zkm(il).LT.5.) THEN
+               temp(il)=180.
+            ELSE
+               temp(il)=AMAX1(180.-2.*(zkm(il)-5.),130.)
+            ENDIF
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=4 Inversion pour Francois:
+c   ------------------
+
+      ELSE IF(ichoice.EQ.4) THEN
+         DO il=1,nlev
+            IF(zkm(il).LT.20.) THEN
+               temp(il)=135.
+            ELSE
+               temp(il)=AMIN1(135.+5.*(zkm(il)-20.),200.)
+            ENDIF
+         ENDDO
+
+
+c-----------------------------------------------------------------------
+c   ichoice=5 Seiff:
+c   ----------------
+
+      ELSE IF(ichoice.EQ.5) THEN
+	 DO il=1,nlev
+	    iseiff=INT(zkm(il)/2.)+1
+	    IF(iseiff.LT.nseiff-1) THEN
+	       temp(il)=tseiff(iseiff)+(zkm(il)-2.*(iseiff-1))*
+     $         (tseiff(iseiff+1)-tseiff(iseiff))/2.
+	    ELSE
+	       temp(il)=tseiff(nseiff)
+	    ENDIF
+	 ENDDO
+c IF(ichoice.EQ.6) THEN
+c	    DO iter=1,6
+c	    t2=temp(1)
+c	    t3=temp(2)
+c	    DO il=2,nlev-1
+c	       t1=t2
+c	       t2=t3
+c	       t3=temp(il+1)
+c	       ww=tanh(zkm(il)/20.)
+c	       ww=ww*ww*ww
+c	       temp(il)=t2+ww*.5*(t1-2.*t2+t3)
+c	    ENDDO
+c	    ENDDO
+c	 ENDIF
+
+c-----------------------------------------------------------------------
+c   ichoice=6 
+c   ---------
+
+      ELSE IF(ichoice.EQ.6) THEN
+      DO il=1,nlev
+        tmp=il-pic
+        temp(il)=tref + hauteur*exp(-tmp*tmp/largeur/largeur)
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   ichoice=7
+c   ---------
+
+      ELSE IF(ichoice.EQ.7) THEN
+      DO il=1,nlev
+        tmp=zkm(il)-pic
+        temp(il)=tref + hauteur*exp(-tmp*tmp*4/largeur/largeur)
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=8
+c   ---------
+
+      ELSE IF(ichoice.GE.8) THEN
+      OPEN(11,file='profile',status='old',form='formatted',err=101)
+      DO il=1,nlev
+        READ (11,*) temp(il)
+      ENDDO
+
+      GOTO 201
+101   STOP'fichier profile inexistant'
+201   CONTINUE
+      CLOSE(10)
+
+c-----------------------------------------------------------------------
+
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   rajout eventuel d'une perturbation:
+c   -----------------------------------
+
+      IF(isin.EQ.1) THEN
+	 pi=2.*ASIN(1.)
+	 DO il=1,nlev
+c       if (nlev.EQ.501) then
+c         if (zkm(il).LE.70.5) then
+c       temp(il)=temp(il)+(1.-1000./(1000+zkm(il)*zkm(il)))*(
+c    s      6.*SIN(zkm(il)*pi/6.)+9.*SIN(zkm(il)*pi/10.3) )
+c         endif
+c       else
+        temp(il)=temp(il)+(1.-1000./(1000+zkm(il)*zkm(il)))*(
+     s      6.*SIN(zkm(il)*pi/6.)+9.*SIN(zkm(il)*pi/10.3) )
+c       endif
+	 ENDDO
+      ENDIF
+
+
+c-----------------------------------------------------------------------
+c   Ecriture du profil de temperature dans un fichier profile.out
+c   -------------------------------------------------------------
+
+
+      OPEN(12,file='profile.out',form='formatted')
+	  DO il=1,nlev
+	    write(12,*) temp(il)
+	  ENDDO
+      CLOSE(12)
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/readtesassim.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/readtesassim.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/readtesassim.F90	(revision 2744)
@@ -0,0 +1,264 @@
+subroutine readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+! Reading of the dust assimilation file
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "comgeomfi.h"
+include "netcdf.inc"
+include "datafile.h"
+
+integer, intent(in) :: ngrid,nlayer
+real, intent(in) :: zday ! date in martian days
+real, dimension(ngrid,nlayer+1), intent(in) :: pplev
+real, dimension(ngrid), intent(out) :: tauref
+
+! Local variables
+
+real :: realday
+integer nid,nvarid,ierr
+integer ltloop,lsloop,iloop,jloop,varloop,ig
+real, dimension(2) :: taubuf
+real tau1(4),tau
+real alt(4)
+integer latp(4),lonp(4)
+integer yinf,ysup,xinf,xsup,tinf,tsup
+real latinf,latsup,loninf,lonsup
+real latintmp,lonintmp,latdeg,londeg
+real colat,dlat,dlon,colattmp
+logical, save :: firstcall=.true.
+logical :: timeflag
+real radeg,pi
+integer :: timedim,londim,latdim
+real, dimension(:), allocatable, save :: lat,lon,time
+real, dimension(:,:,:), allocatable, save :: tautes
+integer, save :: timelen,lonlen,latlen
+INTEGER, external:: lnblnk
+
+pi=acos(-1.)
+radeg=180/pi
+realday=mod(zday,669.)
+
+if (firstcall) then
+   firstcall=.false.
+
+   ! Note: datafile() is defined in "datafile.h"
+   ierr=NF_OPEN (datafile(1:lnblnk(datafile))//"/dust_tes.nc",NF_NOWRITE,nid)
+   IF (ierr.NE.NF_NOERR) THEN
+     write(*,*)'Problem opening dust.nc (in phymars/readtesassim.F90)'
+     write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+     write(*,*)'1) You can change this directory address in '
+     write(*,*)'   file phymars/datafile.h'
+     write(*,*)'2) If necessary, dust.nc (and other datafiles)'
+     write(*,*)'   can be obtained online on:'
+     write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+     CALL ABORT
+   ENDIF
+
+   ierr=NF_INQ_DIMID(nid,"Time",timedim)
+   ierr=NF_INQ_DIMLEN(nid,timedim,timelen)
+   ierr=NF_INQ_DIMID(nid,"latitude",latdim)
+   ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+   ierr=NF_INQ_DIMID(nid,"longitude",londim)
+   ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
+
+   allocate(tautes(lonlen,latlen,timelen))
+   allocate(lat(latlen), lon(lonlen), time(timelen))
+
+   ierr = NF_INQ_VARID (nid, "dustop",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tautes)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, tautes)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <dustop> not found"
+      stop
+   ENDIF
+   ierr = NF_INQ_VARID (nid, "Time",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, time)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <Time> not found"
+      stop
+   ENDIF
+
+   ierr = NF_INQ_VARID (nid, "latitude",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lat)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lat)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <latitude> not found"
+      stop
+   ENDIF
+
+   ierr = NF_INQ_VARID (nid, "longitude",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lon)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lon)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <longitude> not found"
+      stop
+   ENDIF
+
+endif ! of if (firstcall)
+
+do ig=1,ngrid
+
+! Find the four nearest points, arranged as follows:
+!                               1 2
+!                               3 4
+
+   latdeg=lati(ig)*radeg  ! latitude, in degrees
+   londeg=long(ig)*radeg  ! longitude, in degrees east
+   colat=90-latdeg        ! colatitude, in degrees
+
+ ! Find encompassing latitudes
+   if (colat<(90-lat(1))) then ! between north pole and lat(1)
+      ysup=1
+      yinf=1
+   else if (colat>=90-(lat(latlen))) then ! between south pole and lat(laten)
+      ysup=latlen
+      yinf=latlen
+   else ! general case
+      do iloop=2,latlen
+         if(colat<(90-lat(iloop))) then
+           ysup=iloop-1
+           yinf=iloop
+           exit
+         endif
+      enddo
+   endif
+
+   latinf=lat(yinf)
+   latsup=lat(ysup)
+
+
+ ! Find encompassing longitudes
+   ! Note: in input file, lon(1)=-180.
+   if (londeg>lon(lonlen)) then
+      xsup=1
+      xinf=lonlen
+      loninf=lon(xsup)
+      lonsup=180.0 ! since lon(1)=-180.0
+   else
+      do iloop=2,lonlen
+         if(londeg<lon(iloop)) then
+              xsup=iloop
+              xinf=iloop-1
+              exit
+         endif
+      enddo
+      loninf=lon(xinf)
+      lonsup=lon(xsup)
+   endif
+
+   if ((xsup.gt.lonlen).OR.(yinf.gt.latlen).OR.(xinf.lt.1)&
+     .OR.(ysup.lt.1)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on x or y in ts_gcm"
+      write (*,*) "xinf: ",xinf
+      write (*,*) "xsup: ",xsup
+      write (*,*) "yinf: ",yinf
+      write (*,*) "ysup: ",ysup
+      stop
+   endif
+
+!   loninf=lon(xinf)
+!   lonsup=lon(xsup)
+!   latinf=lat(yinf)
+!   latsup=lat(ysup)
+
+! The four neighbouring points are arranged as follows:
+!                               1 2
+!                               3 4
+
+   latp(1)=ysup
+   latp(2)=ysup
+   latp(3)=yinf
+   latp(4)=yinf
+
+   lonp(1)=xinf
+   lonp(2)=xsup
+   lonp(3)=xinf
+   lonp(4)=xsup
+
+! Linear interpolation on time, for all four neighbouring points
+
+   if ((realday<time(1)).or.(realday>time(timelen))) then
+      tinf=timelen
+      tsup=1
+      timeflag=.true.
+   else 
+      do iloop=2,timelen
+         if (realday<time(iloop)) then
+            tinf=iloop-1
+            tsup=iloop
+            exit
+         endif
+      enddo
+   endif
+
+! Bilinear interpolation on the four nearest points
+
+   if ((colat<(90-lat(1))).OR.(colat>(90-lat(latlen))).OR.(latsup==latinf)) then
+      dlat=0
+   else
+      dlat=((90-latinf)-colat)/((90-latinf)-(90-latsup))
+   endif
+
+   if (lonsup==loninf) then
+      dlon=0
+   else
+      dlon=(londeg-loninf)/(lonsup-loninf)
+   endif
+
+   do iloop=1,4
+      taubuf(1)=tautes(lonp(iloop),latp(iloop),tinf)
+      taubuf(2)=tautes(lonp(iloop),latp(iloop),tsup)
+      if (timeflag) then
+         if (realday>time(timelen)) then
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)+(669-time(tinf))) 
+         else
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*realday/(time(tsup)+(669-time(tinf)))
+         endif
+      else
+         tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)-time(tinf))
+      endif
+      if (tau1(iloop)<0) then
+          write (*,*) "Readtesassim: SYSTEM ERROR on tau"
+          write (*,*) "utime ",realday
+          write (*,*) "time(tinf) ",time(tinf)
+          write (*,*) "time(tsup) ",time(tsup)
+          write (*,*) "tau1 ",taubuf(1)
+          write (*,*) "tau2 ",taubuf(2)
+          write (*,*) "tau ",tau1(iloop)
+          stop
+      endif
+   enddo
+   timeflag=.false.
+
+   if ((dlat>1).OR.(dlon>1) .OR. (dlat<0) .OR. (dlon<0)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on dlat or dlon in ts_gcm"
+      write (*,*) "dlat: ",dlat
+      write (*,*) "lat: ",latdeg
+      write (*,*) "dlon: ",dlon
+      write (*,*) "lon: ",londeg
+      stop
+   endif
+
+   tau= dlat*(dlon*(tau1(2)+tau1(3)-tau1(1)-tau1(4))+tau1(1)-tau1(3)) +dlon*(tau1(4)-tau1(3))+tau1(3)
+
+!   tauref(ig)=tau*700/pplev(ig,1)*0.8
+    tauref(ig)=tau*0.825
+enddo
+
+end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/readtesassim.F90.modif
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/readtesassim.F90.modif	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/readtesassim.F90.modif	(revision 2744)
@@ -0,0 +1,288 @@
+subroutine readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+! Reading of the dust assimilation file
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "comgeomfi.h"
+include "netcdf.inc"
+include "datafile.h"
+
+integer, intent(in) :: ngrid,nlayer
+real, intent(in) :: zday ! date in martian days
+real, dimension(ngrid,nlayer+1), intent(in) :: pplev
+real, dimension(ngrid), intent(out) :: tauref
+
+! Local variables
+
+real :: realday
+integer nid,nvarid,ierr
+integer ltloop,lsloop,iloop,jloop,varloop,ig
+real, dimension(2) :: taubuf
+real tau1(4),tau
+real alt(4)
+integer latp(4),lonp(4)
+integer yinf,ysup,xinf,xsup,tinf,tsup
+real latinf,latsup,loninf,lonsup
+real latintmp,lonintmp,latdeg,londeg
+real colat,dlat,dlon,colattmp
+logical, save :: firstcall=.true.
+logical :: timeflag
+real radeg,pi
+integer :: timedim,londim,latdim
+!real, dimension(:), allocatable, save :: lat,lon,time
+!real, dimension(:,:,:), allocatable, save :: tautes
+!integer, save :: timelen,lonlen,latlen
+real, dimension(:), allocatable :: lat,lon,time
+real, dimension(:,:,:), allocatable :: tautes
+integer :: timelen,lonlen,latlen
+INTEGER, external:: lnblnk
+
+pi=acos(-1.)
+radeg=180/pi
+realday=mod(zday,669.)
+
+if (firstcall) then
+   !firstcall=.false.
+
+   ! Note: datafile() is defined in "datafile.h"
+   ierr=NF_OPEN (datafile(1:lnblnk(datafile))//"/dust_tes.nc",NF_NOWRITE,nid)
+   IF (ierr.NE.NF_NOERR) THEN
+     write(*,*)'Problem opening dust.nc (in phymars/readtesassim.F90)'
+     write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+     write(*,*)'1) You can change this directory address in '
+     write(*,*)'   file phymars/datafile.h'
+     write(*,*)'2) If necessary, dust.nc (and other datafiles)'
+     write(*,*)'   can be obtained online on:'
+     write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+     CALL ABORT
+   ENDIF
+
+   ierr=NF_INQ_DIMID(nid,"Time",timedim)
+   ierr=NF_INQ_DIMLEN(nid,timedim,timelen)
+   ierr=NF_INQ_DIMID(nid,"latitude",latdim)
+   ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+   ierr=NF_INQ_DIMID(nid,"longitude",londim)
+   ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
+
+
+   allocate(tautes(lonlen,latlen,timelen))
+   allocate(lat(latlen), lon(lonlen), time(timelen))
+
+   ierr = NF_INQ_VARID (nid, "dustop",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tautes)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, tautes)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <dustop> not found"
+      stop
+   ENDIF
+   ierr = NF_INQ_VARID (nid, "Time",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, time)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <Time> not found"
+      stop
+   ENDIF
+
+   ierr = NF_INQ_VARID (nid, "latitude",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lat)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lat)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <latitude> not found"
+      stop
+   ENDIF
+
+   ierr = NF_INQ_VARID (nid, "longitude",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lon)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lon)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <longitude> not found"
+      stop
+   ENDIF
+
+   ierr=NF_CLOSE(nid)
+
+endif ! of if (firstcall)
+
+do ig=1,ngrid
+
+! Find the four nearest points, arranged as follows:
+!                               1 2
+!                               3 4
+
+   latdeg=lati(ig)*radeg  ! latitude, in degrees
+   londeg=long(ig)*radeg  ! longitude, in degrees east
+   colat=90-latdeg        ! colatitude, in degrees
+
+! Ehouarn: rounding effects and/or specific compiler issues
+!          sometime cause londeg to be sligthly below -180 ...
+  if (londeg.lt.-180) then
+    ! check if it is by a large amount
+    if ((londeg+180).lt.-1.e-3) then
+      write(*,*) 'reattesassim: error!!'
+      write(*,*) ' ig=',ig,' londeg=',londeg
+      stop
+    else
+      londeg=-180
+    endif
+  endif
+
+ ! Find encompassing latitudes
+   if (colat<(90-lat(1))) then ! between north pole and lat(1)
+      ysup=1
+      yinf=1
+   else if (colat>=90-(lat(latlen))) then ! between south pole and lat(laten)
+      ysup=latlen
+      yinf=latlen
+   else ! general case
+      do iloop=2,latlen
+         if(colat<(90-lat(iloop))) then
+           ysup=iloop-1
+           yinf=iloop
+           exit
+         endif
+      enddo
+   endif
+
+   latinf=lat(yinf)
+   latsup=lat(ysup)
+
+
+ ! Find encompassing longitudes
+   ! Note: in input file, lon(1)=-180.
+   if (londeg>lon(lonlen)) then
+      xsup=1
+      xinf=lonlen
+      loninf=lon(xsup)
+      lonsup=180.0 ! since lon(1)=-180.0
+   else
+      do iloop=2,lonlen
+         if(londeg<lon(iloop)) then
+              xsup=iloop
+              xinf=iloop-1
+              exit
+         endif
+      enddo
+      loninf=lon(xinf)
+      lonsup=lon(xsup)
+   endif
+
+   if ((xsup.gt.lonlen).OR.(yinf.gt.latlen).OR.(xinf.lt.1)&
+     .OR.(ysup.lt.1)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on x or y in ts_gcm"
+      write (*,*) "xinf: ",xinf
+      write (*,*) "xsup: ",xsup
+      write (*,*) "yinf: ",yinf
+      write (*,*) "ysup: ",ysup
+      stop
+   endif
+
+!   loninf=lon(xinf)
+!   lonsup=lon(xsup)
+!   latinf=lat(yinf)
+!   latsup=lat(ysup)
+
+! The four neighbouring points are arranged as follows:
+!                               1 2
+!                               3 4
+
+   latp(1)=ysup
+   latp(2)=ysup
+   latp(3)=yinf
+   latp(4)=yinf
+
+   lonp(1)=xinf
+   lonp(2)=xsup
+   lonp(3)=xinf
+   lonp(4)=xsup
+
+! Linear interpolation on time, for all four neighbouring points
+
+   if ((realday<time(1)).or.(realday>time(timelen))) then
+      tinf=timelen
+      tsup=1
+      timeflag=.true.
+   else 
+      timeflag=.false.
+      do iloop=2,timelen
+         if (realday<time(iloop)) then
+            tinf=iloop-1
+            tsup=iloop
+            exit
+         endif
+      enddo
+   endif
+
+! Bilinear interpolation on the four nearest points
+
+   if ((colat<(90-lat(1))).OR.(colat>(90-lat(latlen))).OR.(latsup==latinf)) then
+      dlat=0
+   else
+      dlat=((90-latinf)-colat)/((90-latinf)-(90-latsup))
+   endif
+
+   if (lonsup==loninf) then
+      dlon=0
+   else
+      dlon=(londeg-loninf)/(lonsup-loninf)
+   endif
+
+   do iloop=1,4
+      taubuf(1)=tautes(lonp(iloop),latp(iloop),tinf)
+      taubuf(2)=tautes(lonp(iloop),latp(iloop),tsup)
+      if (timeflag) then
+         if (realday>time(timelen)) then
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)+(669-time(tinf))) 
+         else
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*realday/(time(tsup)+(669-time(tinf)))
+         endif
+      else
+         tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)-time(tinf))
+      endif
+      if (tau1(iloop)<0) then
+          write (*,*) "Readtesassim: SYSTEM ERROR on tau"
+          write (*,*) "utime ",realday
+          write (*,*) "time(tinf) ",time(tinf)
+          write (*,*) "time(tsup) ",time(tsup)
+          write (*,*) "tau1 ",taubuf(1)
+          write (*,*) "tau2 ",taubuf(2)
+          write (*,*) "tau ",tau1(iloop)
+          stop
+      endif
+   enddo
+
+   if ((dlat>1).OR.(dlon>1) .OR. (dlat<0) .OR. (dlon<0)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on dlat or dlon in ts_gcm"
+      write (*,*) "dlat: ",dlat
+      write (*,*) "lat: ",latdeg
+      write (*,*) "dlon: ",dlon
+      write (*,*) "lon: ",londeg
+      stop
+   endif
+
+   tau= dlat*(dlon*(tau1(2)+tau1(3)-tau1(1)-tau1(4))+tau1(1)-tau1(3)) +dlon*(tau1(4)-tau1(3))+tau1(3)
+
+!   tauref(ig)=tau*700/pplev(ig,1)*0.8
+    tauref(ig)=tau*0.825
+enddo
+
+   deallocate(tautes)
+   deallocate(lat)
+   deallocate(lon)
+   deallocate(time)
+
+end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/scatter.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/scatter.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/scatter.F	(revision 2744)
@@ -0,0 +1,21 @@
+       subroutine scatter(n,a,index,b)
+C
+       implicit none
+       integer N,INDEX(n),I
+       real A(n),B(n)
+c
+c
+       DO 100 I=1,N
+          A(INDEX(I))=B(I)
+100    CONTINUE
+c
+       return
+       end 
+c
+c
+c      peut etre vec_scatter(v,rindices,count,r) en f77hp
+c      equivalent code:
+c      do 99 i=1,count
+c99    r(rindices(i))=v(i)
+c      voir p. 11-13
+c
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/scopyi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/scopyi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/scopyi.F	(revision 2744)
@@ -0,0 +1,17 @@
+      subroutine scopyi(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      integer sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+      sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/slope.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/slope.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/slope.h	(revision 2744)
@@ -0,0 +1,5 @@
+      COMMON/comslope/theta_sl(ngridmx),psi_sl(ngridmx)
+
+      REAL theta_sl   ! slope angle versus horizontale (deg)
+      REAL psi_sl     ! orientation of the slope (deg)
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/soil.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/soil.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/soil.F	(revision 2744)
@@ -0,0 +1,192 @@
+      SUBROUTINE soil(ngrid,nsoil,firstcall,ptherm_i,
+     s          ptimestep,ptsrf,ptsoil,
+     s          pcapcal,pfluxgrd)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  Frederic Hourdin     30/01/92
+c   -------
+c
+c   objet:  computation of : the soil temperature evolution
+c   ------                   the surfacic heat capacity "Capcal"
+c                            the surface conduction flux pcapcal
+c
+c
+c   Method: implicit time integration
+c   -------
+c   Consecutive ground temperatures are related by:
+c           T(k+1) = C(k) + D(k)*T(k)  (1)
+c   the coefficients C and D are computed at the t-dt time-step.
+c   Routine structure:
+c   1)new temperatures are computed  using (1)
+c   2)C and D coefficients are computed from the new temperature
+c     profile for the t+dt time-step
+c   3)the coefficients A and B are computed where the diffusive
+c     fluxes at the t+dt time-step is given by
+c            Fdiff = A + B Ts(t+dt)
+c     or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
+c            with F0 = A + B (Ts(t))
+c                 Capcal = B*dt
+c           
+c   Interface:
+c   ----------
+c
+c   Arguments:
+c   ----------
+c   ngird               number of grid-points
+c   ptimestep              physical timestep (s)
+c   pto(ngrid,nsoil)     temperature at time-step t (K)
+c   ptn(ngrid,nsoil)     temperature at time step t+dt (K)
+c   pcapcal(ngrid)      specific heat (W*m-2*s*K-1)
+c   pfluxgrd(ngrid)      surface diffusive flux from ground (Wm-2)
+c   
+c=======================================================================
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+
+c-----------------------------------------------------------------------
+c  arguments
+c  ---------
+
+      INTEGER ngrid,nsoil
+      REAL ptimestep
+      REAL ptsrf(ngridmx),ptsoil(ngrid,nsoilmx),ptherm_i(ngridmx)
+      REAL pcapcal(ngrid),pfluxgrd(ngrid)
+      LOGICAL firstcall
+
+c-----------------------------------------------------------------------
+c  local arrays
+c  ------------
+
+      INTEGER ig,jk
+      REAL za(ngridmx),zb(ngridmx)
+      REAL zdz2(nsoilmx),z1(ngridmx)
+      REAL min_period,dalph_soil
+
+c   local saved variables:
+c   ----------------------
+      REAL dz1(nsoilmx),dz2(nsoilmx)
+      REAL zc(ngridmx,nsoilmx),zd(ngridmx,nsoilmx)
+      REAL lambda
+      SAVE dz1,dz2,zc,zd,lambda
+
+c-----------------------------------------------------------------------
+c   Depthts:
+c   --------
+
+      REAL fz,rk,fz1,rk1,rk2
+      fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
+
+      IF (firstcall) THEN
+
+c-----------------------------------------------------------------------
+c   ground levels 
+c   grnd=z/l where l is the skin depth of the diurnal cycle:
+c   --------------------------------------------------------
+
+         min_period=887.75
+c        min_period=1800.
+c        min_period=20000.
+         dalph_soil=2.
+
+         OPEN(99,file='soil.def',status='old',form='formatted',err=9999)
+         READ(99,*) min_period
+         READ(99,*) dalph_soil
+         PRINT*,'Discretization for the soil model'
+         PRINT*,'First level e-folding depth',min_period,
+     s   '   dalph',dalph_soil
+         CLOSE(99)
+9999     CONTINUE
+
+c   la premiere couche represente un dixieme de cycle diurne
+         fz1=sqrt(min_period/3.14)
+
+         DO jk=1,nsoil
+            rk1=jk
+            rk2=jk-1
+            dz2(jk)=fz(rk1)-fz(rk2)
+         ENDDO
+         DO jk=1,nsoil-1
+            rk1=jk+.5
+            rk2=jk-.5
+            dz1(jk)=1./(fz(rk1)-fz(rk2))
+         ENDDO
+         lambda=fz(.5)*dz1(1)
+         PRINT*,'full layers, intermediate layers (secoonds)'
+         DO jk=1,nsoil
+            rk=jk
+            rk1=jk+.5
+            rk2=jk-.5
+            PRINT*,fz(rk1)*fz(rk2)*3.14,
+     s      fz(rk)*fz(rk)*3.14
+         ENDDO
+
+c   Initialisations:
+c   ----------------
+
+      ELSE
+c-----------------------------------------------------------------------
+c   Computation of the soil temperatures using the Cgrd and Dgrd
+c  coefficient computed at the previous time-step:
+c  -----------------------------------------------
+
+c    surface temperature
+         DO ig=1,ngrid
+            ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/
+     s      (lambda*(1.-zd(ig,1))+1.)
+         ENDDO
+
+c   other temperatures
+         DO jk=1,nsoil-1
+            DO ig=1,ngrid
+               ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk)
+            ENDDO
+         ENDDO
+
+      ENDIF
+c-----------------------------------------------------------------------
+c   Computation of the Cgrd and Dgrd coefficient for the next step:
+c   ---------------------------------------------------------------
+
+      DO jk=1,nsoil
+         zdz2(jk)=dz2(jk)/ptimestep
+      ENDDO
+
+      DO ig=1,ngrid
+         z1(ig)=zdz2(nsoil)+dz1(nsoil-1)
+         zc(ig,nsoil-1)=zdz2(nsoil)*ptsoil(ig,nsoil)/z1(ig)
+         zd(ig,nsoil-1)=dz1(nsoil-1)/z1(ig)
+      ENDDO
+
+      DO jk=nsoil-1,2,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)*(1.-zd(ig,jk)))
+            zc(ig,jk-1)=
+     s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))*z1(ig)
+            zd(ig,jk-1)=dz1(jk-1)*z1(ig)
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   computation of the surface diffusive flux from ground and
+c   calorific capacity of the ground:
+c   ---------------------------------
+
+      DO ig=1,ngrid
+         pfluxgrd(ig)=ptherm_i(ig)*dz1(1)*
+     s   (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1))
+         pcapcal(ig)=ptherm_i(ig)*
+     s   (dz2(1)+ptimestep*(1.-zd(ig,1))*dz1(1))
+         z1(ig)=lambda*(1.-zd(ig,1))+1.
+         pcapcal(ig)=pcapcal(ig)/z1(ig)
+         pfluxgrd(ig)=pfluxgrd(ig)
+     s   +pcapcal(ig)*(ptsoil(ig,1)*z1(ig)-lambda*zc(ig,1)-ptsrf(ig))
+     s   /ptimestep
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/solang.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/solang.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/solang.F	(revision 2744)
@@ -0,0 +1,114 @@
+      subroutine solang ( kgrid,psilon,pcolon,psilat,pcolat,
+     &                    ptim1,ptim2,ptim3,pmu0,pfract )
+      IMPLICIT NONE
+
+C
+C**** *LW*   - ORGANIZES THE LONGWAVE CALCULATIONS
+C
+C     PURPOSE.
+C     --------
+C          CALCULATES THE SOLAR ANGLE FOR ALL THE POINTS OF THE GRID
+C
+C**   INTERFACE.
+C     ----------
+C      SUBROUTINE SOLANG ( KGRID )
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS  ===
+C
+C PSILON(KGRID)   : SINUS OF THE LONGITUDE
+C PCOLON(KGRID)   : COSINUS OF THE LONGITUDE
+C PSILAT(KGRID)   : SINUS OF THE LATITUDE
+C PCOLAT(KGRID)   : COSINUS OF THE LATITUDE
+C PTIM1           : SIN(DECLI)
+C PTIM2           : COS(DECLI)*COS(TIME)
+C PTIM3           : SIN(DECLI)*SIN(TIME)
+C
+C     ==== OUTPUTS ===
+C
+C PMU0 (KGRID)    : SOLAR ANGLE
+C PFRACT(KGRID)   : DAY FRACTION OF THE TIME INTERVAL
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C     EXTERNALS.
+C     ----------
+C
+C         NONE
+C
+C     REFERENCE.
+C     ----------
+C
+C         RADIATIVE PROCESSES IN METEOROLOGIE AND CLIMATOLOGIE
+C         PALTRIDGE AND PLATT
+C
+C     AUTHOR.
+C     -------
+C        FREDERIC HOURDIN
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL :90-01-14
+C                  92-02-14 CALCULATIONS DONE THE ENTIER GRID (J.Polcher)
+C-----------------------------------------------------------------------
+C
+C     ------------------------------------------------------------------
+
+C-----------------------------------------------------------------------
+C
+C*      0.1   ARGUMENTS
+C             ---------
+C
+      INTEGER kgrid
+      REAL ptim1,ptim2,ptim3
+      REAL psilon(kgrid),pcolon(kgrid),pmu0(kgrid),pfract(kgrid)
+      REAL psilat(kgrid), pcolat(kgrid)
+C
+      INTEGER jl
+      REAL ztim1,ztim2,ztim3
+C------------------------------------------------------------------------
+C------------------------------------------------------------------------
+C------------------------------------------------------------------------
+C
+C------------------------------------------------------------------------
+C
+C*     1.     INITIALISATION
+C             --------------
+C
+ 100  CONTINUE
+C
+      DO jl=1,kgrid
+        pmu0(jl)=0.
+        pfract(jl)=0.
+      ENDDO
+C
+C*     1.1     COMPUTATION OF THE SOLAR ANGLE
+C              ------------------------------
+C
+      DO jl=1,kgrid
+        ztim1=psilat(jl)*ptim1
+        ztim2=pcolat(jl)*ptim2
+        ztim3=pcolat(jl)*ptim3
+        pmu0(jl)=ztim1+ztim2*pcolon(jl)+ztim3*psilon(jl)
+      ENDDO
+C
+C*     1.2      DISTINCTION BETWEEN DAY AND NIGHT
+C               ---------------------------------
+C
+      DO jl=1,kgrid
+        IF (pmu0(jl).gt.0.) THEN
+          pfract(jl)=1.
+c       pmu0(jl)=sqrt(1224.*pmu0(jl)*pmu0(jl)+1.)/35.
+      ELSE
+c       pmu0(jl)=0.
+        pfract(jl)=0.
+        ENDIF
+      ENDDO
+C
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/solarlong.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/solarlong.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/solarlong.F	(revision 2744)
@@ -0,0 +1,110 @@
+      SUBROUTINE solarlong(pday,psollong)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Objet:
+c   ------
+c
+c      Calcul de la distance soleil-planete et de la declinaison
+c   en fonction du jour de l'annee.
+c
+c
+c   Methode:
+c   --------
+c
+c      Calcul complet de l'elipse
+c
+c   Interface:
+c   ----------
+c
+c      Uncommon comprenant les parametres orbitaux.
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   pday          jour de l'annee (le jour 0 correspondant a l'equinoxe)
+c   lwrite        clef logique pour sorties de controle
+c
+c   Output:
+c   -------
+c   pdist_sol     distance entre le soleil et la planete
+c                 ( en unite astronomique pour utiliser la constante 
+c                  solaire terrestre 1370 Wm-2 )
+c   pdecli        declinaison ( en radians )
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c arguments:
+c ----------
+
+      REAL pday,pdist_sol,pdecli,psollong
+      LOGICAL lwrite
+
+c Local:
+c ------
+
+      REAL zanom,xref,zx0,zdx,zteta,zz
+      INTEGER iter
+
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c   Initialisation eventuelle:
+      if(.not.unitastr.gt.1.e-4) then
+         call iniorbit(249.22,206.66,669.,485.,25.2)
+	 print*,'call>iniorbit'
+      endif
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(pday-peri_day)/year_day
+      pi=2.*asin(1.)
+      zanom=2.*pi*(zz-nint(zz))
+      xref=abs(zanom)
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = xref
+c  methode de Newton
+
+      zx0=xref+e_elips*sin(xref)
+      DO 110 iter=1,10
+         zdx=-(zx0-e_elips*sin(zx0)-xref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-7)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+
+c zteta est la longitude solaire
+
+      zteta=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+
+      psollong=zteta-timeperi
+
+      IF(psollong.LT.0.) psollong=psollong+2.*pi
+      IF(psollong.GT.2.*pi) psollong=psollong-2.*pi
+
+	PRINT*,'aerocentric longitude (deg) :',psollong*180./pi
+c-----------------------------------------------------------------------
+c   sorties eventuelles:
+c   ---------------------
+c
+c     IF (lwrite) THEN
+c        PRINT*,'jour de l"annee   :',pday
+c        PRINT*,'distance au soleil (en unite astronomique) :',pdist_sol
+c        PRINT*,'declinaison (en degres) :',pdecli*180./pi
+c     ENDIF
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/statto.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/statto.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/statto.h	(revision 2744)
@@ -0,0 +1,34 @@
+
+!  statto:
+!     This include file controls the production of statistics.
+!     Some variables could be set in a namelist, but it is easier to
+!     do it here since arrays can then be dimensioned using parameters
+!     and values shouldn't have to change too often.   SRL
+
+!     Calculate stats every istats physics timesteps, starting at first
+!     call.  If istats=0 then don't do statistics at all.  Check value
+!     if number of physics timesteps changes.
+	integer istats
+
+!     Calculate itime independent sums and sums of squares,
+!     example, istat=1,istime=1 gives a single time mean
+	integer, parameter :: istime=12
+
+!     Number of 2D and 3D variables on which to do statistics.
+	integer n2dvar, n3dvar
+	parameter (n2dvar = 8, n3dvar = 5)
+
+!     Units for writing stats header and data
+	integer usdata
+
+!     count tab to know the variable record
+        integer count(istime)
+
+!     Record of the number of stores made for each time.
+	integer nstore(istime)
+
+! Size of the "controle" array
+        integer, parameter :: cntrlsize=15
+
+!       common /sttcom/ dummy,nstore,istats,usdata
+        common /sttcom/ nstore,istats,usdata,count
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/suaer.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/suaer.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/suaer.F	(revision 2744)
@@ -0,0 +1,269 @@
+      SUBROUTINE SUAER
+      implicit none
+C     
+C     Purpose.
+C     --------
+C     initialize yomaer, the common that contains the
+C     radiative characteristics of the aerosols
+c     
+C     AUTHOR.
+C     -------
+c     Richard Fournier (1996) Francois Forget (1996)
+c     Frederic Hourdin
+C     Jean-jacques morcrette *ECMWF*
+c     MODIF Francois Forget (2000)
+c     MODIF Franck Montmessin (add water ice)
+C     ------------------------------------------------------------------
+C     
+C-----------------------------------------------------------------------
+C     
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+     
+c     Aerosol Spectral properties :
+#include "aerdust.h"
+
+#ifdef ICE
+#include "aerice.h"
+#endif
+C-----------------------------------------------------------------------
+c     
+      INTEGER iaer,isun,iir,n
+
+c I/O  of "aerave" (subroutine averaging spectrally sing.scat.parameters) 
+      REAL tsun             ! Sun brightness temperature (for SW)
+      REAL tsol             ! Surface reference brightness temp (for LW)
+      REAL longref          ! reference wavelengths
+      REAL longsun(nsun+1)  ! solar band boundaries
+      REAL longir(nir+1)    ! IR band boundaries
+      REAL epref            ! reference extinction ep at wavelength "longref"
+      REAL epav(nir)        ! average ep  (= <Qext>/Qext(longref) if epref=1)
+      REAL omegav(nir)      ! Average sing.scat.albedo
+      REAL gav(nir)         ! Average assymetry parameter
+      REAL QIRTM9sQrefIR    ![Qext averaged over IRTM 9um band]/Qext(longrefir)
+                            ! with longrefir defined in dimradmars.h 
+
+
+C-----------------------------------------------------------------------
+c     quelques initialisations a 0
+      call zerophys(naerkind*nsun,gvis)
+      call zerophys(naerkind*nsun,omegavis)
+      call zerophys(naerkind*nsun,QVISsQREF)
+
+      call zerophys(naerkind*nir,gIR)
+      call zerophys(naerkind*nir,omegaIR)
+      call zerophys(naerkind*nir,QIRsQREF)
+c     
+C-----------------------------------------------------------------------
+C     
+C     ----------------------------------------------------------------
+C     *       1.    SHORTWAVE COEFFICIENTS
+C     ----------------------------------------------------------------
+C     
+c     Computing average optical properties on both solar bands
+c     For pure dust (naerkind=1)
+c     
+      do iaer=1,naerkind
+
+      tsun=6000.E+0
+      longsun(1)=long1vis
+      longsun(2)=long2vis
+      longsun(3)=long3vis
+      longref=longrefvis
+      epref=1.E+0         
+
+
+c     Here, epav is <Qext>/Qext(longrefvis) since epref=1 :
+
+      if (iaer.eq.1) then
+      CALL aerave ( ndustvis,
+     &     longdustvis,epdustvis,omegdustvis,gdustvis,
+     &     longref,epref,tsun
+     &     ,nsun,longsun, epav,omegav,gav )
+      elseif (iaer.eq.2) then
+#ifdef ICE
+      CALL aerave ( nicevis,
+     &     longicevis,epicevis,omegicevis,gicevis,
+     &     longref,epref,tsun
+     &     ,nsun,longsun, epav,omegav,gav )
+#endif
+      endif
+
+       do isun=1,nsun
+            QVISsQREF(isun,iaer)=epav(isun)
+            gvis(isun,iaer)=gav(isun)
+            omegavis(isun,iaer)=omegav(isun)
+c TEST
+c	    if (iaer.eq.2)  omegavis(isun,iaer)=.86   
+c	    if (iaer.eq.2)  gvis(isun,iaer)=-1.  
+c	    if (iaer.eq.2) then   !TEST
+c              QVISsQREF(isun,iaer)=QVISsQREF(isun,1)
+c              gvis(isun,iaer)=gvis(isun,1)
+c              omegavis(isun,iaer)=omegavis(isun,1)
+c            endif
+c END TEST
+
+       enddo
+
+c     
+
+C     ----------------------------------------------------------------
+C     *       2.    LONGWAVE COEFFICIENTS
+C     ----------------------------------------------------------------
+
+      if (iaer.eq.1) then
+
+c     Computing average optical properties on both solar bands
+c     For dust (iaer=1)
+c
+c     Calcul preliminaire
+c     ~~~~~~~~~~~~~~~~~~~
+c     Ratio betwen Qext averaged over IRTM 9um band
+c     and Qext(longrefir) (longrefir is defined in dimradmars.h)
+c     -> useful because the ratio of extinction "solsir"
+c      is defined between 0.67um and the IRTM 9um band 
+c      (for which it has been estimated)
+
+      tsol=215.D+0
+c     IRTM band (T9):
+      longir(1)=8.3E-6
+      longir(2)=9.7E-6
+      longref=longrefir
+      epref=1.E+0
+
+c     Here, epav is QavIRTM9/Qext(longrefir) since epref=1 :
+
+       write(*,*) 'Call test 9 micron'
+      CALL aerave ( ndustir,
+     &     longdustir,epdustir,omegdustir,gdustir,
+     &     longref,epref,tsol
+     &     ,1,longir,epav,omegav,gav )
+       write(*,*) 'OK test 9 micron'
+      QIRTM9sQrefIR=epav(1)
+      
+c     Average scaterring properties of 3 IR bands defined as :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     [long1ir - long1co2] , [long1co2-long2co2], [long2co2 - long2ir]
+c
+
+      tsol=215.D+0
+      longir(1)=long1ir
+      longir(2)=long1co2
+      longir(3)=long2co2
+      longir(4)=long2ir
+      longref=longrefir
+      epref=1.E+0
+
+c     Here, epav is <QIR>/Qext(longrefir) since epref=1
+      CALL aerave ( ndustir,
+     &     longdustir,epdustir,omegdustir,gdustir,
+     &     longref,epref,tsol
+     &     ,nir-1,longir,epav,omegav,gav )
+
+c     Computing  <QIR>/Qext(longrefvis)
+      DO iir=1,4
+         epav(iir)=  epav(iir) / (QIRTM9sQrefIR * solsir)
+      ENDDO
+
+      elseif (iaer.eq.2) then
+
+c     Average scaterring properties of 3 IR bands defined as :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     [long1ir - long1co2] , [long1co2-long2co2], [long2co2 - long2ir]
+c
+
+      tsol=215.D+0
+      longir(1)=long1ir
+      longir(2)=long1co2
+      longir(3)=long2co2
+      longir(4)=long2ir
+      longref=longrefir
+      epref=1.E+0
+
+c     Here, epav is <QIR>/Qext(longrefir) since epref=1
+#ifdef ICE
+      CALL aerave ( niceir,
+     &     longiceir,epiceir,omegiceir,giceir,
+     &     longref,epref,tsol
+     &     ,nir-1,longir,epav,omegav,gav )
+
+c     Computing  <QIR>/Qext(longrefvis)
+      DO iir=1,4
+         epav(iir)=  epav(iir) / solsirice
+      ENDDO
+#endif
+
+      endif
+c  Single scattering properties in each of the "nir" bands (cf. dimramars.h)
+c  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c  iir=1 : central 15um CO2 bands   
+      QIRsQREF(1,iaer)=epav(2)
+      omegaIR(1,iaer)=omegav(2)
+      gIR(1,iaer)=gav(2)
+
+c  iir=2 : CO2 band wings (same properties than for central part)
+      QIRsQREF(2,iaer)=epav(2)
+      omegaIR(2,iaer)=omegav(2)
+      gIR(2,iaer)=gav(2)
+
+c  iir=3 : 9 um band [long1ir - long1co2]
+      QIRsQREF(3,iaer)=epav(1)
+      omegaIR(3,iaer)=omegav(1)
+      gIR(3,iaer)=gav(1)
+
+c  iir=4 : Far IR    [long2co2 - long2ir]
+      QIRsQREF(4,iaer)=epav(3)
+      omegaIR(4,iaer)=omegav(3)
+      gIR(4,iaer)=gav(3)
+
+c      if (iaer.eq.2) then  !TEST
+c	do iir=1,4
+c	  QIRsQREF(iir,iaer)=QIRsQREF(iir,1)
+c          omegaIR(iir,iaer)= omegaIR(iir,1)
+c          gIR(iir,iaer)=gIR(iir,1)
+c        enddo
+c      endif
+
+C     ----------------------------------------------------------------
+C     Output on screen 
+C     ----------------------------------------------------------------
+      if (iaer.eq.1) then
+        PRINT*,'PURE DUST PROPERTIES :'
+        PRINT*
+        PRINT*,'Rapport Solaire/IR :',solsir
+        PRINT*
+      elseif (iaer.eq.2) then
+#ifdef ICE
+        PRINT*,'ICE PROPERTIES :'
+        PRINT*
+        PRINT*,'Rapport Solaire/IR :',solsirice
+        PRINT*
+#endif
+      endif
+
+      PRINT *,'Les donnees spectrales :'
+      PRINT *,'Solaire (SW) ---->'
+      PRINT *,'<Qext>/Qext(0.67um) ; omega ; g'
+      DO isun=1,nsun
+         PRINT *,QVISsQREF(isun,iaer),omegavis(isun,iaer)
+     &    ,gvis(isun,iaer)
+      ENDDO
+      PRINT *,'Thermal IR (LW) ---->'
+      PRINT *,'<Qext>/Qext(0.67um) ; omega ; g'
+      DO iir=1,nir
+         PRINT *,QIRsQREF(iir,iaer),omegaIR(iir,iaer),gIR(iir,iaer)
+      ENDDO
+c     
+
+      print *,'Dans le co2 on prend <Qabs>/Qext(0.67um) =',
+     &  QIRsQREF(1,iaer)*(1-omegaIR(1,iaer))  
+      write(*,*)
+
+      enddo  ! Loop on iaer
+      
+
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/sugwd.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/sugwd.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/sugwd.F	(revision 2744)
@@ -0,0 +1,109 @@
+      SUBROUTINE SUGWD(NLEV,PSIG)
+C     
+C**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
+C     
+C     PURPOSE.
+C     --------
+C     INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
+C     GRAVITY WAVE DRAG PARAMETRIZATION.
+C     
+C     EXPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     INPUT :
+C     
+C     PSIG        : VERTICAL COORDINATE TABLE
+C     NLEV        : NUMBER OF MODEL LEVELS
+C     
+C     OUTPUT :
+C     
+C     NONE
+C     
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     COMMON YOEGWD
+C     
+C     METHOD.
+C     -------
+C     SEE DOCUMENTATION
+C     
+C     EXTERNALS.
+C     ----------
+C     NONE
+C     
+C     REFERENCE.
+C     ----------
+C     ECMWF Research Department documentation of the IFS
+C     
+C     AUTHOR.
+C     -------
+C     MARTIN MILLER             *ECMWF*
+C     
+C     MODIFICATIONS.
+C     --------------
+C     ORIGINAL : 90-01-01
+C     ------------------------------------------------------------------
+      implicit none
+C     
+C     -----------------------------------------------------------------
+c     !-*-      include 'yoegwd.h'
+#include "yoegwd.h"
+c     !-*-
+C     ----------------------------------------------------------------
+C     
+      integer nlev
+      REAL PSIG(NLEV+1)
+
+      real zsigt,zpr,zpm1r
+      integer jk
+C     
+C     *       1.    SET THE VALUES OF THE PARAMETERS
+C     --------------------------------
+C     
+ 100  CONTINUE
+C     
+c     PRINT *,' Dans sugwd nlev=',NLEV,' SIG=',PSIG
+      GHMAX=10000.
+C     
+c     old  ZSIGT=0.94
+c     old  ZPR=80000.
+      ZSIGT=0.85
+      ZPR=100000.
+C     
+      DO 110 JK=1,NLEV-1
+         ZPM1R=0.5*ZPR*(PSIG(JK)+PSIG(JK+1))
+         IF((ZPM1R/ZPR).GE.ZSIGT)THEN
+            NKTOPG=JK
+         ENDIF
+ 110  CONTINUE
+      WRITE(*,*) 'In sugwd NKTOPG=',NKTOPG
+C     
+      GSIGCR=0.80
+C     
+      GKDRAG= 0.1  ! used to be 0.1 for mcd Version 1 and 2 (before 10/2000)
+      GRCRIT=0.25
+      GFRCRIT=1.0
+      GKWAKE=1.0
+
+C     
+      GKDRAGL=4.*GKDRAG
+      GRAHILO=1.
+      GVCRIT =0.0
+C     
+C     
+C     ----------------------------------------------------------------
+C     
+C     *       2.    SET VALUES OF SECURITY PARAMETERS
+C     ---------------------------------
+C     
+ 200  CONTINUE
+C     
+      GVSEC=0.10
+      GSSEC=1.E-12
+C     
+      GTSEC=1.E-07
+C     
+C     ----------------------------------------------------------------
+C     
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/sulw.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/sulw.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/sulw.F	(revision 2744)
@@ -0,0 +1,81 @@
+      SUBROUTINE SULW
+C     
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "yomlw.h"
+C     
+C     PURPOSE.
+C     --------
+C     INITIALIZE YOMLW, THE COMMON THAT CONTAINS COEFFICIENTS
+C     NEEDED TO RUN THE LONGWAVE RADIATION ROUTINES
+C     
+C     AUTHOR.
+C     -------
+C     JEAN-JACQUES MORCRETTE  *ECMWF*
+c     Simplified F. Forget 01/2000
+C     
+C     ------------------------------------------------------------------
+C     ----------------------------------------------------------------
+C     
+C     *       1.    SET VALUES.
+C     -----------
+C     
+C     
+C--   REFERENCE TEMPERATURES FOR THE PLANCK FUNCTIONS ----- TSTAND
+C     TEMPERATURE DEPENDENCE OF THE ABSORPTION ----- TREF
+      DATA TSTAND,TREF / 200.0, 200.0 /
+C     
+C--   ROOTS AND WEIGHTS FOR THE 2-POINT GAUSSIAN QUADRATURE
+c     DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 /
+c     DATA (WG1(IG1),IG1=1,2) /  1.0        ,  1.0         /
+
+c-----------------------------------------------------------------------
+C--   COEFFICIENTS OF THE POLYNOMIALS GIVING THE PLANCK FUNCTIONS
+C     
+      DATA xp/
+
+     s     0.63849788E+01, 0.30969419E+02, 0.44790835E+02,
+     s     0.52651048E+01,-0.18799237E+02, 0.92836181E+01,
+
+     s     0.26166790E+02, 0.12348011E+03, 0.17868306E+03,
+     s     0.33657659E+02,-0.66869343E+02, 0.21017507E+02,
+c     
+c     s  0.47045285E+02, 0.12234377E+03, 0.61873275E+02,
+c     s -0.31971883E+02, 0.59168472E+01, 0.91927407E+01,
+c     
+c     s  0.11101254E+02, 0.86037325E+02, 0.25892695E+03,
+c     s  0.35582991E+03, 0.16958020E+03,-0.41311413E+02/
+c     
+     s     0.11101254E+02, 0.86037325E+02, 0.25892695E+03,
+     s     0.35582991E+03, 0.16958020E+03,-0.41311413E+02,
+
+     s     0.47045285E+02, 0.12234377E+03, 0.61873275E+02,
+     s     -0.31971883E+02, 0.59168472E+01, 0.91927407E+01/
+
+c     
+c-----------------------------------------------------------------------
+c     temperature dependency of absorber amounts:
+c     -------------------------------------------
+
+      DATA at
+     s     / 0.694E-03, 0.272E-02, 0.275E-02, 0.178E-01/
+      DATA bt
+     s     / 0.328E-05, 0.298E-05,-0.705E-04,-0.163E-04/
+
+c-----------------------------------------------------------------------
+      DATA (ga(ie, 1),ie=1,4)
+     s     / 0.288231E-04, 0.170794E-01,-0.339714E-01, 0.000000E+00/
+      DATA (gb(ie, 1),ie=1,4)
+     s     / 0.288231E-04, 0.145426E-01, 0.543812E+00, 0.100000E+01/
+
+      DATA (ga(ie, 2),ie=1,4)
+     s     / 0.289299E-01, 0.190634E+01, 0.384061E+01, 0.000000E+00/
+      DATA (gb(ie, 2),ie=1,4)
+     s     / 0.289299E-01, 0.189485E+01, 0.600363E+01, 0.100000E+01/
+
+      DATA cst_voigt / 0.500E-02, 0.100E-01, 0.150E-01, 0.100E+00/
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/surfdat.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/surfdat.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/surfdat.h	(revision 2744)
@@ -0,0 +1,9 @@
+      COMMON/surfdat/albedodat(ngridmx),inertiedat(ngridmx),
+     s   phisfi(ngridmx),albedice(2),emisice(2),emissiv,
+     s   iceradius(2) , dtemisice(2),
+     s   zmea(ngridmx),zstd(ngridmx),
+     s   zsig(ngridmx),zgam(ngridmx),zthe(ngridmx)
+
+      REAL albedodat,inertiedat,phisfi,albedice,emisice,emissiv,
+     s   iceradius , dtemisice
+      real zmea,zstd,zsig,zgam,zthe
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/surfini.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/surfini.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/surfini.F	(revision 2744)
@@ -0,0 +1,111 @@
+      SUBROUTINE surfini(ngrid,piceco2,qsurf,psolaralb)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   creation des calottes pour l'etat initial
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "dimphys.h"
+#include "surfdat.h"
+#include "callkeys.h"
+#include "tracer.h"
+#include "comgeomfi.h"
+#include "comcstfi.h"
+#include "watercap.h"
+
+c
+      INTEGER ngrid,ig,icap,iq
+      REAL  piceco2(ngrid),psolaralb(ngrid,2)
+      REAL qsurf(ngrid,nqmx) !tracer on surface (kg/m2)
+
+      EXTERNAL ISMIN,ISMAX
+      INTEGER ISMIN,ISMAX
+c
+c=======================================================================
+
+      do ig=1,ngridmx
+
+         !write(*,*) "all qsurf to zero. dirty."
+         do iq=1,nqmx
+         qsurf(ig,iq)=0.  !! on jette les inputs GCM
+                          !! on regle juste watercaptag
+                          !! il faudrait garder les inputs GCM 
+                          !! si elles sont consequentes
+         enddo
+
+!! AS: my previous stuff
+!         if ( ( lati(ig)*180./pi .gt. 70. ) .and.
+!     .        ( albedodat(ig) .ge. 0.26   ) )  then
+!                 write(*,*)"outlier ",ig,albedodat(ig),inertiedat(ig)
+!                 watercaptag(ig)  = .true.
+!                 dryness(ig)      = 1.
+!                 albedodat(ig)    = 0.45 !albedo_h2o_ice  !! pour output 
+!                 inertiedat(ig)   = 800.
+!                 write(*,*)"new values ",ig,albedodat(ig),inertiedat(ig)
+!         else
+!                 watercaptag(ig)  = .false.
+!                 dryness(ig)      = 1.
+!         endif 
+!         if ( inertiedat(ig) .ge. 800. ) then
+!            write(*,*)"change inertie from ",inertiedat(ig)," to 800."
+!            inertiedat(ig)   = 800.
+!         endif
+
+!! using Tyler and Barnes maps.
+         dryness(ig)      = 1.
+         if ( inertiedat(ig) .ge. 600. ) then
+                 write(*,*)"ice ",ig,albedodat(ig),inertiedat(ig)
+                 watercaptag(ig)  = .true.
+         else
+                 watercaptag(ig)  = .false.
+         endif
+         
+      enddo
+
+
+c
+c     calcul de piceco2 (kg/m2) a l'etat initial
+c     ------------------------------------------
+
+      DO 100 ig=1,ngrid
+         psolaralb(ig,1)=albedodat(ig)
+         psolaralb(ig,2)=albedodat(ig)
+100   CONTINUE
+
+      PRINT*,'minimum des donnees albedo',
+     s     albedodat(ISMIN(ngrid,albedodat,1))
+      PRINT*,'maximum des donnees albedo',
+     s     albedodat(ISMAX(ngrid,albedodat,1))
+c      calcul de psolaralb 
+c      -------------------
+      DO 115 ig=1,ngrid
+
+c	 IF (water) THEN 
+c	   if (qsurf(ig,nqmx).gt.0.005) then
+c             psolaralb(ig,1) = 0.4
+c             psolaralb(ig,2) = 0.4 
+c           endif 
+c         ENDIF
+c IF there is more than 5 pr. um of h2o ice but no C02 ice, surface albedo is set to 0.4. 
+         IF (piceco2(ig) .GT. 0.) THEN
+             IF(ig.GT.ngrid/2+1) THEN
+                icap=2
+             ELSE
+                icap=1
+             ENDIF
+             psolaralb(ig,1) = albedice(icap)
+             psolaralb(ig,2) =  albedice(icap)
+         END IF
+115   CONTINUE      
+
+      PRINT*,'minimum des donnees albedo',
+     s     psolaralb(ISMIN(ngrid,psolaralb,1),1)
+      PRINT*,'maximum des donnees albedo',
+     s     psolaralb(ISMAX(ngrid,psolaralb,1),1)
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/swmain.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/swmain.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/swmain.F	(revision 2744)
@@ -0,0 +1,173 @@
+      SUBROUTINE SWMAIN ( KDLON, KFLEV,
+     $                PCST, albedo,
+     $                PRMU0, PDP, PPLEV, aerosol,PFRACT,
+     $                PHEAT, PFLUXD,PFLUXU)
+
+      IMPLICIT NONE
+      
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+#include "callkeys.h"
+c     
+c     PURPOSE.
+c     --------
+c     
+c     This routine computes the shortwave (solar wavelength)
+c     radiation fluxes in two spectral intervals 
+c     and heating rate on the first "nlaylte" layers.
+C     
+c     Francois Forget (2000), adapted from 
+C     Fouquart and Bonnel's ECMWF program
+c 
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     ==== INPUTS ===
+c
+c    KDLON :  number of horizontal grid points
+c    PCST  :  Solar constant on Mars (W.m-2)
+c    albedo   hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c    PRMU0 :         cos of solar zenith angle (=1 when sun at zenith)
+c    PDP :           Layer thickness (Pa)
+c    PPLEV           pressure (Pa) at boundaries of each layer 
+c   aerosol               aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+c    Pfract :        day fraction of the time interval
+c                          =1 during the full day ; =0 during the night
+C     ==== OUTPUTS ===
+c    PHEAT :         Heating rate (K/s)
+c    PFLUXD :        SW downward flux at boundaries of each layer (W.m-2)
+c    PFLUXU :        SW upward flux at boundaries of each layer (W.m-2)
+C     
+C     ----------
+C     
+C-----------------------------------------------------------------------
+C     
+C     
+C-----------------------------------------------------------------------
+C     
+C     ARGUMENTS
+C     ---------
+      
+      INTEGER KDLON, KFLEV
+      REAL ZPSOL(NDLO2), aerosol(NDLO2,KFLEV,naerkind),PRMU0(NDLO2)
+      real PCST
+      REAL albedo(NDLO2,2)
+      REAL PDP(NDLO2,KFLEV)
+      REAL PPLEV(NDLO2,KFLEV+1)
+      REAL PHEAT(NDLO2,KFLEV)
+      REAL PFRACT(NDLO2)
+      real PFLUXD(NDLON,NFLEV+1,2)
+      real PFLUXU(NDLON,NFLEV+1,2)
+      
+C     LOCAL ARRAYS
+C     ------------
+      
+      REAL ZDSIG(NDLON,NFLEV), ZFACT(NDLON)
+     S     ,  ZFD(NDLON,NFLEV+1)
+     S     ,  ZFU(NDLON,NFLEV+1)
+     S     ,  ZRMU(NDLON), ZSEC(NDLON)
+     S     ,  ZUD(NDLON,3,NFLEV+1), ZUM(NDLON,NFLEV+1)
+      REAL ZSIGN(NDLON),  ZSIGO(NDLON)
+
+c following line has been changed, kflev--->nflev (to avoid error message 
+c when compiling on NASA Ames Sun)
+      REAL ZFDOWN(NDLO2,NFLEV+1),ZFUP(NDLO2,NFLEV+1)
+
+      integer jl, jk, jkp1, jkl
+      integer INU 
+      real  zdfnet
+
+C     ------------------------------------------------------------------
+C     Initializations :
+C     ------------------------------------------------------------------
+
+c     Incident Solar flux and corrected angle in the atmosphere 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      DO JL = 1 , KDLON
+c        Incident Flux at the top of the atmosphere
+         ZFACT(JL)= PRMU0(JL) * PCST * PFRACT(JL)
+
+c        Cos of solar zenith angle CORRECTED for high zenith angle
+       if (PRMU0(JL).GT.0) then
+         ZRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35.
+       else
+         ZRMU(JL)= 1. / 35.
+       endif
+         ZSEC(JL)=1./ZRMU(JL)
+      END DO
+
+c     Calcul of ZDSIG  (thickness of layers in sigma coordinates)
+c     ~~~~~~~~~~~~~~~
+      DO JL = 1 , KDLON
+         ZSIGO(JL) = 1.0
+         ZPSOL(JL) = PPLEV(JL,1)
+      END DO
+      DO JK = 1 , nlaylte
+         JKP1 = JK + 1
+         JKL = nlaylte+1 - JK
+         DO  JL = 1 , KDLON
+            ZSIGN(JL) = PPLEV(JL,JKP1) / PPLEV(JL,1)
+            ZDSIG(JL,JK) = ZSIGO(JL) - ZSIGN(JL)
+            ZSIGO(JL) = ZSIGN(JL)
+         END DO
+      END DO
+
+C------------------------------------------------------------------
+C          LOOP ON SPECTRAL INTERVAL in solar spectrum
+C------------------------------------------------------------------
+c  2 spectral interval in solar spectrum :
+c  - INU=1: between wavelength "long1vis" and "long2vis" set in dimradmars.h
+c  - INU=2: between wavelength "long2vis" and "long3vis" set in dimradmars.h
+
+      DO INU = 1,2
+         CALL SWR ( KDLON, kflev, INU
+     S     ,  aerosol,albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+     S     ,  ZFD,ZFU )
+
+         DO JK = 1 , nlaylte+1
+            DO  JL = 1 , KDLON
+              PFLUXD(JL,JK,INU)=ZFD(JL,JK)*ZFACT(JL)
+              PFLUXU(JL,JK,INU)=ZFU(JL,JK)*ZFACT(JL)
+            END DO
+         END DO
+      END DO
+
+C     ------------------------------------------------------
+C     HEATING RATES
+C     ------------------------------------------------------
+
+      DO JK = 1 , nlaylte+1
+         DO  JL = 1 , KDLON
+c           wavelength integrated flux at every level:
+            ZFUP(JL,JK)= (PFLUXU(JL,JK,1)+ PFLUXU(JL,JK,2))
+            ZFDOWN(JL,JK)= (PFLUXD(JL,JK,1)+ PFLUXD(JL,JK,2))
+         END DO
+      END DO
+     
+      DO JK = 1 , nlaylte
+         DO  JL = 1 , KDLON
+            ZDFNET = ZFUP (JL,JK  ) - ZFDOWN(JL,JK  )
+     S              -ZFUP (JL,JK+1) + ZFDOWN(JL,JK+1)
+c           Heating rate
+            PHEAT(JL,JK) = gcp * ZDFNET / PDP(JL,JK)
+c TEST pour diminuer erreur eddington pour diffuseurs simples	    
+c           if (activice) then   
+c	    if(aerosol(JL,JK,2)/aerosol(JL,JK,1).gt.1) 
+c     s 	    PHEAT(JL,JK) =PHEAT(JL,JK)/10.
+c           endif 
+         END DO
+      END DO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/swr.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/swr.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/swr.F	(revision 2744)
@@ -0,0 +1,380 @@
+      SUBROUTINE SWR ( KDLON, KFLEV, KNU
+     S     ,  aerosol,albedo,PDSIG,PPSOL,PRMU,PSEC
+     S     ,  PFD,PFU )
+
+      IMPLICIT NONE
+C     
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+
+#include "fisice.h"
+
+#include "aerice.h"
+C     
+C   SWR - Continuum scattering computations
+C     
+C     PURPOSE.
+C     --------
+C     Computes the reflectivity and transmissivity in case oF
+C     Continuum scattering
+c     F. Forget (1999)
+c
+c      BASED ON MORCRETTE EARTH MODEL
+C     (See radiation's part of the ecmwf research department
+C     documentation, and Fouquart and BonneL (1980)
+C     
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     ==== INPUTS ===
+c
+c    KDLON :  number of horizontal grid points
+c    KFLEV :  number of vertical layers
+c    KNU   :   Solar band # (1 or 2)
+c   aerosol               aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+c    albedo   hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c    PDSIG      layer thickness in sigma coordinates
+c    PPSOL       Surface pressure (Pa)
+c    PRMU:  cos of solar zenith angle (=1 when sun at zenith)
+c           (CORRECTED for high zenith angle (atmosphere), unlike mu0)
+c    PSEC   =1./PRMU
+
+C     ==== OUTPUTS ===
+c
+c    PFD : downward flux in spectral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+c    PFU : upward flux in specatral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+C
+C     
+C     METHOD.
+C     -------
+C     
+C     Computes continuum fluxes corresponding to aerosoL
+C     Or/and rayleigh scattering (no molecular gas absorption)
+C     
+C-----------------------------------------------------------------------
+C     
+C     
+C-----------------------------------------------------------------------
+C     
+     
+C     ARGUMENTS
+C     ---------
+      INTEGER KDLON, KFLEV, KNU
+      REAL aerosol(NDLO2,KFLEV,naerkind), albedo(NDLO2,2), 
+     S     PDSIG(NDLO2,KFLEV),PSEC(NDLO2)
+      REAL PPSOL(NDLO2)
+      REAL PFD(NDLO2,KFLEV+1),PFU(NDLO2,KFLEV+1)
+      REAL PRMU(NDLO2)
+
+C     LOCAL ARRAYS
+C     ------------
+ 
+      INTEGER jk,ja,jl,jae, jkl,jklp1,jkm1,jaj
+      REAL ZTRAY, ZRATIO,ZGAR, ZFF
+      real zfacoa,zcorae
+      real ZMUE, zgap,zbmu0, zww,zto,zden,zmu1,zbmu1,zden1,zre11
+
+      REAL ZC1I(NDLON,NFLEV+1), ZGG(NDLON), ZREF(NDLON)
+     S ,  ZRE1(NDLON), ZRE2(NDLON)
+     S ,  ZRMUZ(NDLON), ZRNEB(NDLON), ZR21(NDLON)
+     S ,  ZR23(NDLON),  ZSS1(NDLON), ZTO1(NDLON), ZTR(NDLON,2,NFLEV+1)
+     S ,  ZTR1(NDLON), ZTR2(NDLON), ZW(NDLON)
+
+      REAL ZRAY1(NDLO2,NFLEV+1), ZRAY2(NDLO2,NFLEV+1)
+     s   ,  ZREFZ(NDLO2,2,NFLEV+1)
+     S   ,  ZRMUE(NDLO2,NFLEV+1)
+     S   ,  ZCGAZ(NDLO2,NFLEV),ZPIZAZ(NDLO2,NFLEV),ZTAUAZ(NDLO2,NFLEV)
+
+      REAL  ZRAYL(NDLON)
+     S     ,   ZRJ(NDLON,6,NFLEV+1)
+     S     ,  ZRK(NDLON,6,NFLEV+1)
+     S     ,  ZTRA1(NDLON,NFLEV+1), ZTRA2(NDLON,NFLEV+1)
+
+
+      real ray,coefsizew
+
+c     Function
+c     --------
+      real CVMGT
+
+C    --------------------------------
+C     OPTICAL PARAMETERS FOR AEROSOLS 
+C     -------------------------------
+C     
+      DO  JK = 1 , nlaylte+1
+         DO  JA = 1 , 6
+            DO JL = 1 , KDLON
+               ZRJ(JL,JA,JK) = 0.
+               ZRK(JL,JA,JK) = 0.
+            END DO
+         END DO
+      END DO
+
+c Computing TOTAL single scattering parameters by adding
+c  properties of all the NAERKIND kind of aerosols
+
+      DO JK = 1 , nlaylte
+         DO  JL = 1 , KDLON
+            ZCGAZ(JL,JK) = 0.
+            ZPIZAZ(JL,JK) =  0.
+            ZTAUAZ(JL,JK) = 0.
+         END DO
+         DO 106 JAE=1,naerkind
+            DO 105 JL = 1 , KDLON
+c              Mean Extinction optical depth in the spectral band
+c              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+               ZTAUAZ(JL,JK)=ZTAUAZ(JL,JK)
+     S              +aerosol(JL,JK,JAE)*QVISsQREF(KNU,JAE)
+c              Single scattering albedo
+c              ~~~~~~~~~~~~~~~~~~~~~~~~ 
+c TEST : to account for the varying w with varying crystal size
+               if (activice.and.JAE.eq.naerkind.and.KNU.eq.2) then
+                 ray=min( max(rice(JL,JK)*1.e+6, 1.),10.) 
+	         coefsizew=(0.0001417*ray**2.-0.00328*ray+0.99667)
+     &             /omegavis(KNU,JAE)
+	       else
+		 coefsizew=1.
+               endif
+               ZPIZAZ(JL,JK)=ZPIZAZ(JL,JK)+aerosol(JL,JK,JAE)
+     S           * QVISsQREF(KNU,JAE)*omegavis(KNU,JAE)*coefsizew
+c              Assymetry factor 
+c              ~~~~~~~~~~~~~~~~
+               ZCGAZ(JL,JK) =  ZCGAZ(JL,JK) +aerosol(JL,JK,JAE)
+     S            * QVISsQREF(KNU,JAE)*omegavis(KNU,JAE)*gvis(KNU,JAE)
+ 105        CONTINUE
+ 106     CONTINUE
+      END DO
+C     
+      DO JK = 1 , nlaylte
+         DO JL = 1 , KDLON
+            ZCGAZ(JL,JK) = CVMGT( 0., ZCGAZ(JL,JK) / ZPIZAZ(JL,JK),
+     S            (ZPIZAZ(JL,JK).EQ.0) )
+            ZPIZAZ(JL,JK) = CVMGT( 1., ZPIZAZ(JL,JK) / ZTAUAZ(JL,JK),
+     S           (ZTAUAZ(JL,JK).EQ.0) )
+         END DO
+      END DO
+
+C     --------------------------------
+C     INCLUDING RAYLEIGH SCATERRING 
+C     -------------------------------
+      if (rayleigh) then 
+
+        call swrayleigh(kdlon,knu,ppsol,prmu,ZRAYL)
+
+c       Modifying mean aerosol parameters to account rayleigh scat by gas:
+
+        DO JK = 1 , nlaylte
+           DO JL = 1 , KDLON
+c             Rayleigh opacity in each layer :
+              ZTRAY = ZRAYL(JL) * PDSIG(JL,JK)
+c             ratio Tau(rayleigh) / Tau (total)
+              ZRATIO = ZTRAY / (ZTRAY + ZTAUAZ(JL,JK))
+              ZGAR = ZCGAZ(JL,JK)
+              ZFF = ZGAR * ZGAR
+                ZTAUAZ(JL,JK)=ZTRAY+ZTAUAZ(JL,JK)*(1.-ZPIZAZ(JL,JK)*ZFF)
+              ZCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR)
+              ZPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*ZPIZAZ(JL,JK)*(1.-ZFF)
+     S           / (1. -ZPIZAZ(JL,JK) * ZFF)
+           END DO
+        END DO
+      end if
+
+     
+C     ----------------------------------------------
+C     TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
+C     ----------------------------------------------
+C     
+ 200  CONTINUE
+      
+      DO JL = 1 , KDLON
+         ZR23(JL) = 0.
+         ZC1I(JL,nlaylte+1) = 0.
+      END DO
+      
+      DO JK = 1 , nlaylte
+         JKL = nlaylte+1 - JK
+         JKLP1 = JKL + 1
+         DO JL = 1 , KDLON
+            ZFACOA = 1.-ZPIZAZ(JL,JKL)*ZCGAZ(JL,JKL)*ZCGAZ(JL,JKL)
+            ZCORAE = ZFACOA * ZTAUAZ(JL,JKL) * PSEC(JL)
+            ZR21(JL) = EXP(-ZCORAE   )
+            ZSS1(JL) =  1.0-ZR21(JL)
+            ZC1I(JL,JKL) = 1.0-(1.0-ZSS1(JL))*(1.0-ZC1I(JL,JKLP1))
+         END DO
+      END DO
+
+C     -----------------------------------------------
+C     REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
+C     -----------------------------------------------
+C     
+      DO JL = 1 , KDLON
+         ZRAY1(JL,nlaylte+1) = 0.
+         ZRAY2(JL,nlaylte+1) = 0.
+         ZREFZ(JL,2,1) = albedo(JL,KNU)
+         ZREFZ(JL,1,1) = albedo(JL,KNU)
+         ZTRA1(JL,nlaylte+1) = 1.
+         ZTRA2(JL,nlaylte+1) = 1.
+      END DO
+
+      DO JK = 2 , nlaylte+1
+         JKM1 = JK-1
+         DO 342 JL = 1 , KDLON
+            ZRNEB(JL)= 1.e-5   ! used to be "cloudiness" (PCLDSW in Morcrette)
+
+            ZRE1(JL)=0.
+            ZTR1(JL)=0.
+            ZRE2(JL)=0.
+            ZTR2(JL)=0.
+      
+C           EQUIVALENT ZENITH ANGLE
+c           ~~~~~~~~~~~~~~~~~~~~~~~
+            ZMUE = (1.-ZC1I(JL,JK)) * PSEC(JL)
+     S           + ZC1I(JL,JK) * 1.66
+            ZRMUE(JL,JK) = 1./ZMUE
+
+C     ------------------------------------------------------------------
+C          REFLECT./TRANSMISSIVITY DUE TO AEROSOLS (and rayleigh ?)
+C     ------------------------------------------------------------------
+
+            ZGAP = ZCGAZ(JL,JKM1)
+            ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE
+            ZWW =ZPIZAZ(JL,JKM1)
+            ZTO = ZTAUAZ(JL,JKM1)
+            ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE
+     S           + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE
+            ZRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN
+            ZTRA1(JL,JKM1) = 1. / ZDEN
+C     
+            ZMU1 = 0.5
+            ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1
+            ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1
+     S         + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1
+            ZRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1
+            ZTRA2(JL,JKM1) = 1. / ZDEN1
+
+            ZGG(JL) =  ZCGAZ(JL,JKM1)
+            ZW(JL) =ZPIZAZ(JL,JKM1)
+            ZREF(JL) = ZREFZ(JL,1,JKM1)
+            ZRMUZ(JL) = ZRMUE(JL,JK)
+            ZTO1(JL) =  ZTAUAZ(JL,JKM1)/ZPIZAZ(JL,JKM1)
+
+ 342     CONTINUE
+
+C     
+         CALL DEDD ( KDLON
+     S        , ZGG,ZREF,ZRMUZ,ZTO1,ZW
+     S        , ZRE1,ZRE2,ZTR1,ZTR2     )
+C     
+         DO JL = 1 , KDLON
+C     
+            ZREFZ(JL,1,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1)
+     S           + ZREFZ(JL,1,JKM1) * ZTRA1(JL,JKM1)
+     S           * ZTRA2(JL,JKM1)
+     S           / (1.-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))
+     S           + ZRNEB(JL) * ZRE2(JL)
+C     
+            ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (ZTRA1(JL,JKM1)
+     S           / (1.-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))
+     S           * (1.-ZRNEB(JL))
+C     
+            ZREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1)
+     S           + ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1)
+     S           * ZTRA2(JL,JKM1) )
+     S           + ZRNEB(JL) * ZRE1(JL)
+C     
+            ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL)
+     S           + ZTRA1(JL,JKM1) * (1.-ZRNEB(JL))
+C     
+         END DO
+      END DO 
+C     
+C     
+C     ------------------------------------------------------------------
+C     
+C     *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
+C     -------------------------------------------------
+C     
+ 350  CONTINUE
+C     
+      IF (KNU.EQ.1) THEN
+         JAJ = 2
+         DO 351 JL = 1 , KDLON
+            ZRJ(JL,JAJ,nlaylte+1) = 1.
+            ZRK(JL,JAJ,nlaylte+1) = ZREFZ(JL, 1,nlaylte+1)
+ 351     CONTINUE
+C     
+         DO 353 JK = 1 , nlaylte
+            JKL = nlaylte+1 - JK
+            JKLP1 = JKL + 1
+            DO 352 JL = 1 , KDLON
+               ZRE11= ZRJ(JL,JAJ,JKLP1) * ZTR(JL,  1,JKL)
+               ZRJ(JL,JAJ,JKL) = ZRE11
+               ZRK(JL,JAJ,JKL) = ZRE11 * ZREFZ(JL,  1,JKL)
+ 352        CONTINUE
+ 353     CONTINUE
+ 354     CONTINUE
+C     
+      ELSE
+C     
+         DO 358 JAJ = 1 , 2
+            DO 355 JL = 1 , KDLON
+               ZRJ(JL,JAJ,nlaylte+1) = 1.
+               ZRK(JL,JAJ,nlaylte+1) = ZREFZ(JL,JAJ,nlaylte+1)
+ 355        CONTINUE
+C     
+            DO 357 JK = 1 , nlaylte
+               JKL = nlaylte+1 - JK
+               JKLP1 = JKL + 1
+               DO 356 JL = 1 , KDLON
+                  ZRE11= ZRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
+                  ZRJ(JL,JAJ,JKL) = ZRE11
+                  ZRK(JL,JAJ,JKL) = ZRE11 * ZREFZ(JL,JAJ,JKL)
+ 356           CONTINUE
+ 357        CONTINUE
+ 358     CONTINUE
+      END IF
+
+C     
+C     
+C     
+C     ------------------------------------------------------------------
+C     ---------------
+C     DOWNWARD FLUXES
+C     ---------------
+C    
+      JAJ = 2
+
+      do JK = 1 , nlaylte+1
+        JKL = nlaylte+1 - JK + 1
+        DO  JL = 1 , KDLON
+            PFD(JL,JKL) =   ZRJ(JL,JAJ,JKL) * sunfr(KNU)
+        end do
+      end do
+C    
+C  -------------
+C  UPWARD FLUXES
+C  -------------
+      DO JK = 1 , nlaylte+1
+         DO  JL = 1 , KDLON
+c           ZRK = upward flux / incident top flux
+            PFU(JL,JK) =    ZRK(JL,JAJ,JK) * sunfr(KNU)
+         END DO
+      END DO
+
+C     
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/swrayleigh.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/swrayleigh.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/swrayleigh.F	(revision 2744)
@@ -0,0 +1,86 @@
+      SUBROUTINE swrayleigh(kdlon,knu,ppsol,prmu,prayl)
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing total rayleigh scat atmospheric optical depth  
+c
+c   author: F.Forget 
+c   ------
+c
+c   input:
+c   ----- 
+c   kdlon             Number of gridpoint of horizontal grid
+c    knu   :   Solar band # (1 or 2)
+c   ppsol             surface pressure (Pa) 
+c   prmu         cos of solar zenith angle (=1 when sun at zenith)
+c           (CORRECTED for high zenith angle (atmosphere), unlike mu0)
+c
+c   output:
+c   -------
+c   prayl       column optical depth in each model column
+c
+c=======================================================================
+#include "comcstfi.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER kdlon, knu
+
+      real ppsol(kdlon),prmu(kdlon),prayl(kdlon)
+c
+c    Local variables :
+c    -----------------
+      integer JL, K
+c
+c   local saved variables
+c   ---------------------
+c     rayleigh scattering coefficients (from Morcrete et al.EARTH model !)
+      real cray(2,6)
+
+      DATA (CRAY(1,K),K=1,6) /
+     S     .428937E-01, .890743E+00,-.288555E+01,
+     S     .522744E+01,-.469173E+01, .161645E+01/
+
+      DATA (CRAY(2,K),K=1,6) /
+     S     .697200E-02, .173297E-01,-.850903E-01,
+     S     .248261E+00,-.302031E+00, .129662E+00/
+      save cray
+c----------------------------------------------------------------------
+
+      DO JL = 1 , KDLON
+
+c        Total Rayleigh Optical thickness on Earth at 101325 Pa level
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c        WARNING : the CRAY coefficients are only valid for
+c        Spectral interval used in Earth model !!!
+c        (i.e. 0.25-0.68 micron and 0.68-4.00 micron
+c         ---> should be modified for Mars model !!!
+
+         PRAYL(JL) = CRAY(KNU,1) + PRMU(JL) * (CRAY(KNU,2) + PRMU(JL)
+     S        * (CRAY(KNU,3) + PRMU(JL) * (CRAY(KNU,4) + PRMU(JL)
+     S        * (CRAY(KNU,5) + PRMU(JL) *   CRAY(KNU,6)       ))))
+
+c        Total local Rayleigh Optical thickness on Mars
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c           - PRAYL above is the total Rayleigh Optical thickness
+c             at  101325Pa for Earth atmosphere
+c           -> Total Rayleigh Optical thickness on Mars
+c              = PRAYL*(Psurf/101325)*9.81/g *2.5
+c              (Extinction coeff of CO2 = 2.5 * N2)
+
+c     (Comment the following line to get back bugged version before 01/2000)
+c        PRAYL(JL) = PRAYL(JL) * PPSOL(JL) * 2.42e-4/g
+
+      END DO
+
+
+      return
+      end 
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/tabfi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/tabfi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/tabfi.F	(revision 2744)
@@ -0,0 +1,514 @@
+c=======================================================================
+      SUBROUTINE tabfi(nid,Lmodif,tab0,day_ini,lmax,p_rad,
+     .                 p_omeg,p_g,p_mugaz,p_daysec,time)
+c=======================================================================
+c
+c   C. Hourdin 15/11/96
+c
+c   Object:        Lecture du tab_cntrl physique dans un fichier 
+c   ------            et initialisation des constantes physiques
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c      - nid:    unitne logique du fichier ou on va lire le tab_cntrl    
+c                      (ouvert dans le programme appellant) 
+c
+c                 si nid=0:
+c                       pas de lecture du tab_cntrl mais
+c                       Valeurs par default des constantes physiques
+c        
+c      - tab0:    Offset de tab_cntrl a partir duquel sont ranges 
+c                  les parametres physiques (50 pour start_archive)
+c
+c      - Lmodif:  si on souhaite modifier les constantes  Lmodif = 1 = TRUE
+c
+c
+c     Outputs:
+c     --------
+c
+c      - day_ini: tab_cntrl(tab0+3) (Dans les cas ou l'on souhaite
+c                              comparer avec le day_ini dynamique)
+c
+c      - lmax:    tab_cntrl(tab0+2) (pour test avec nlayermx)
+c
+c      - p_rad
+c      - p_omeg   !
+c      - p_g      ! Constantes physiques ayant des 
+c      - p_mugaz  ! homonymes dynamiques
+c      - p_daysec !
+c
+c=======================================================================
+ 
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "planete.h"
+#include "surfdat.h"
+#include "netcdf.inc"
+#include "dimradmars.h"
+#include "yomaer.h"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c Arguments
+c ---------
+      INTEGER nid,nvarid,tab0
+      INTEGER*4 day_ini
+      INTEGER Lmodif
+      INTEGER lmax
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec,time
+
+c Variables
+c ---------
+      INTEGER length
+      parameter (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER  ierr
+      INTEGER size
+      CHARACTER modif*20
+
+c Fonctions DRS et autres
+c -----------------------
+      INTEGER setname, cluvdb, getdat
+
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c  Initialisation des constantes physiques par defaut (cas nid = 0)
+c-----------------------------------------------------------------------
+      IF (nid.eq.0) then
+ 
+c Pression de reference sur la planete
+c-------------------------------------
+c     pressrf = 670.            ! Pression de reference (Pa) ~650
+
+c Info sur la Planete Mars pour la dynamique et la physique
+c----------------------------------------------------------
+      rad=3397200.          ! rayon de mars (m)  ~3397200 m
+      daysec=88775.         ! duree du sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec)       ! vitesse de rotation (rad.s-1)
+      g=3.72                ! gravite (m.s-2) ~3.72
+      mugaz=43.49           ! Masse molaire de l''atm (g.mol-1) ~43.49
+      rcp=.256793         ! = r/cp  ~0.256793
+
+c Info sur la Planete Mars pour la physique uniquement
+c-----------------------------------------------------
+      year_day = 669.       !modif FH  duree de l''annee (sols) ~668.6
+      periheli = 206.66         ! dist.min. soleil-mars (Mkm) ~206.66
+      aphelie = 249.22          ! dist.max. soleil-mars (Mkm) ~249.22
+      peri_day =  485.    ! date du perihelie (sols depuis printemps)
+      obliquit = 25.19         ! Obliquite de la planete (deg) ~25.19
+
+c Couche limite et Turbulence
+c----------------------------
+      z0 =  1.e-2               ! surface roughness (m) ~0.01
+      emin_turb = 1.e-6         ! energie minimale ~1.e-8
+      lmixmin = 30              ! longueur de melange ~100
+
+c propriete optiques des calottes et emissivite du sol
+c-----------------------------------------------------
+      emissiv=.95               ! Emissivite du sol martien ~.95
+      emisice(1)=0.95           ! Emissivite calotte nord
+      emisice(2)=0.95           ! Emissivite calotte sud
+      albedice(1)=0.65          ! Albedo calotte nord
+      albedice(2)=0.65          ! Albedo calotte sud
+      iceradius(1) = 100.e-6    ! mean scat radius of CO2 snow (north)
+      iceradius(2) = 100.e-6    ! mean scat radius of CO2 snow (south)
+      dtemisice(1) = 0.4   ! time scale for snow metamorphism (north)
+      dtemisice(2) = 0.4   ! time scale for snow metamorphism (south)
+
+c Proprietes des poussiere aerosol
+c---------------------------------
+      tauvis= 0.2          ! profondeur optique visible moyenne
+
+c  Ancien code radiatif (non utilise avec le code d'apres 03/96)
+c---------------------------------------------------------------
+c     tauir= 0.  ! .2  ratio (mean IR opt.depth)/Visible
+c     scatalb=0. ! .86 scaterring albedo visible (~.86)
+c     asfact=0.  ! .79 assymetrie factor visible   (~.79)
+c     day0 = 0   ! = 0 en general !!!
+ 
+c-----------------------------------------------------------------------
+c  Initialisation des constantes physiques par lecture du tableau 
+c		des parametres du run (tab_cntrl) 	(cas nid != 0)
+c-----------------------------------------------------------------------
+      ELSE
+
+c Lecture du tableau
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Tabfi: Le champ <controle> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Tabfi: Lecture echoue pour <controle>"
+         CALL abort
+      ENDIF
+
+       print*,'tab_cntrl',tab_cntrl
+c
+c  Initialisation des constantes physiques
+c infor sur la grille physique
+      if(ngridmx.ne.tab_cntrl(tab0+1)) then
+         print*,'WARNING !!! tab_cntrl(tab0+1).ne.ngridmx'
+         print*,tab_cntrl(tab0+1),ngridmx
+      endif
+      lmax = nint(tab_cntrl(tab0+2))
+      day_ini = tab_cntrl(tab0+3)
+      time = tab_cntrl(tab0+4)
+      write (*,*) 'IN tabfi day_ini=',day_ini
+c Info sur la Planete Mars pour la dynamique et la physique
+      rad = tab_cntrl(tab0+5)
+      omeg = tab_cntrl(tab0+6)
+      g = tab_cntrl(tab0+7)
+      mugaz = tab_cntrl(tab0+8)
+      rcp = tab_cntrl(tab0+9)
+      daysec = tab_cntrl(tab0+10)
+      dtphys = tab_cntrl(tab0+11)
+c Info sur la Planete Mars pour la physique uniquement
+      year_day = tab_cntrl(tab0+14)
+      periheli = tab_cntrl(tab0+15)
+      aphelie = tab_cntrl(tab0+16)
+      peri_day = tab_cntrl(tab0+17)
+      obliquit = tab_cntrl(tab0+18)
+c couche limite et turbeulence
+      z0 = tab_cntrl(tab0+19)
+      lmixmin = tab_cntrl(tab0+20)
+      emin_turb = tab_cntrl(tab0+21)
+c proprietes optiques des calottes et emissivite du sol
+      albedice(1)= tab_cntrl(tab0+22)
+      albedice(2)= tab_cntrl(tab0+23)
+      emisice(1) = tab_cntrl(tab0+24)
+      emisice(2) = tab_cntrl(tab0+25)
+      emissiv    = tab_cntrl(tab0+26)
+      tauvis     = tab_cntrl(tab0+27)  ! dust opt. depth vis.
+      iceradius(1)= tab_cntrl(tab0+31) ! mean scat radius of CO2 snow (north)
+      iceradius(2)= tab_cntrl(tab0+32) ! mean scat radius of CO2 snow (south)
+      dtemisice(1)= tab_cntrl(tab0+33) !time scale for snow metamorphism (north)
+      dtemisice(2)= tab_cntrl(tab0+34) !time scale for snow metamorphism (south)
+c-----------------------------------------------------------------------
+c	Sauvegarde des constantes pour passages en arguments
+c-----------------------------------------------------------------------
+      p_omeg = omeg
+      p_g = g
+      p_mugaz = mugaz
+      p_daysec = daysec
+      p_rad=rad
+
+      ENDIF    ! (du if nid = 0) 
+
+c-----------------------------------------------------------------------
+c	Impression des constantes physiques avant modif
+c-----------------------------------------------------------------------
+ 
+   6  FORMAT(a20,e15.6,e15.6)
+   5  FORMAT(a20,f12.2,f12.2)
+ 
+      write(*,*) '*****************************************************'
+      write(*,*) 'lecture du tab_cntrl a l appel de tabfi avant modif'
+      write(*,*) '*****************************************************'
+      write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),float(ngridmx)
+      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
+      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
+      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
+      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
+
+      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
+      write(*,5) '(15)       periheli',tab_cntrl(tab0+15),periheli
+      write(*,5) '(16)        aphelie',tab_cntrl(tab0+16),aphelie
+      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
+      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
+
+      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
+      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
+      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
+
+      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
+      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
+      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
+      write(*,5) '(22)    albedice(1)',tab_cntrl(tab0+22),albedice(1)
+      write(*,5) '(23)    albedice(2)',tab_cntrl(tab0+23),albedice(2)
+      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
+      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
+      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
+      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
+
+      write(*,5) '(27)         tauvis',tab_cntrl(tab0+27),tauvis
+
+      write(*,*)
+      write(*,*) 'Lmodif dans tabfi!!!!!!!',Lmodif
+
+c-----------------------------------------------------------------------
+c	 Modifications...
+c-----------------------------------------------------------------------
+
+      IF(Lmodif.eq.1) then
+
+      write(*,*)
+      write(*,*) 'Modifications des valeurs du tab_cntrl:'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*) '(valeurs actuelles indiquees ci-dessus)'
+      write(*,*)
+      write(*,*) '(3)          day_ini : Jour initial (=0 a Ls=0)'
+      write(*,*) '(19)              z0 :  surface roughness (m)'
+      write(*,*) '(21)       emin_turb :  energie minimale'
+      write(*,*) '(20)         lmixmin : longueur de melange'
+      write(*,*) '(26)         emissiv : Emissivite du sol martien'
+      write(*,*) '(24 et 25)   emisice : Emissivite des calottes '
+      write(*,*) '(22 et 23)  albedice : Albedo des calotte'
+      write(*,*) '(31 et 32) iceradius : mean scat radius of CO2 snow'
+      write(*,*) '(33 et 34) dtemisice : time scale for snow',
+     . ' metamorphism'
+      write(*,*) '(27)          tauvis : profondeur optique visible',
+     . ' moyenne'
+      write(*,*) '(18)        obliquit : planet obliquity (deg)'
+      write(*,*) '(17)      peri_day : perihelion date (sol since Ls=0)'
+      write(*,*) '(15)      periheli : min. sun-mars dist (Mkm)'
+      write(*,*) '(16)      aphelie  : max. sun-mars dist (Mkm)'
+      write(*,*)
+ 
+ 
+      do while(modif(1:1).ne.'hello')
+        write(*,*)
+        write(*,*)
+        write(*,*) 'modification a faire ?'
+        write(*,*) '   (entrer le mot cle ou return pour finir)'
+        write(*,*)
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ') goto 999
+ 
+        write(*,*)
+        write(*,*) modif(1:lnblnk(modif)) , ' : '
+
+        if (modif(1:lnblnk(modif)) .eq. 'day_ini') then
+          write(*,*) 'valeur actuelle:',day_ini
+          write(*,*) 'entrer la nouvelle valeur:'
+ 101      read(*,*,iostat=ierr) day_ini
+          if(ierr.ne.0) goto 101
+          write(*,*) ' '
+          write(*,*) 'day_ini (nouvelle valeur):',day_ini
+
+        else if (modif(1:lnblnk(modif)) .eq. 'z0') then
+          write(*,*) 'valeur actuelle:',z0
+          write(*,*) 'entrer la nouvelle valeur:'
+ 102      read(*,*,iostat=ierr) z0
+          if(ierr.ne.0) goto 102
+          write(*,*) ' '
+          write(*,*) ' z0 (nouvelle valeur):',z0
+
+        else if (modif(1:lnblnk(modif)) .eq. 'emin_turb') then
+          write(*,*) 'valeur actuelle:',emin_turb
+          write(*,*) 'entrer la nouvelle valeur:'
+ 103      read(*,*,iostat=ierr) emin_turb
+          if(ierr.ne.0) goto 103
+          write(*,*) ' '
+          write(*,*) ' emin_turb (nouvelle valeur):',emin_turb
+
+        else if (modif(1:lnblnk(modif)) .eq. 'lmixmin') then
+          write(*,*) 'valeur actuelle:',lmixmin
+          write(*,*) 'entrer la nouvelle valeur:'
+ 104      read(*,*,iostat=ierr) lmixmin
+          if(ierr.ne.0) goto 104
+          write(*,*) ' '
+          write(*,*) ' lmixmin (nouvelle valeur):',lmixmin
+
+        else if (modif(1:lnblnk(modif)) .eq. 'emissiv') then
+          write(*,*) 'valeur actuelle:',emissiv
+          write(*,*) 'entrer la nouvelle valeur:'
+ 105      read(*,*,iostat=ierr) emissiv
+          if(ierr.ne.0) goto 105
+          write(*,*) ' '
+          write(*,*) ' emissiv (nouvelle valeur):',emissiv
+
+        else if (modif(1:lnblnk(modif)) .eq. 'emisice') then
+          write(*,*) 'valeur actuelle emisice(1) Nord:',emisice(1)
+          write(*,*) 'entrer la nouvelle valeur:'
+ 106      read(*,*,iostat=ierr) emisice(1)
+          if(ierr.ne.0) goto 106
+          write(*,*) 
+          write(*,*) ' emisice(1) (nouvelle valeur):',emisice(1)
+          write(*,*)
+
+          write(*,*) 'valeur actuelle emisice(2) Sud:',emisice(2)
+          write(*,*) 'entrer la nouvelle valeur:'
+ 107      read(*,*,iostat=ierr) emisice(2)
+          if(ierr.ne.0) goto 107
+          write(*,*) 
+          write(*,*) ' emisice(2) (nouvelle valeur):',emisice(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'albedice') then
+          write(*,*) 'valeur actuelle albedice(1) Nord:',albedice(1)
+          write(*,*) 'entrer la nouvelle valeur:'
+ 108      read(*,*,iostat=ierr) albedice(1)
+          if(ierr.ne.0) goto 108
+          write(*,*) 
+          write(*,*) ' albedice(1) (nouvelle valeur):',albedice(1)
+          write(*,*)
+
+          write(*,*) 'valeur actuelle albedice(2) Sud:',albedice(2)
+          write(*,*) 'entrer la nouvelle valeur:'
+ 109      read(*,*,iostat=ierr) albedice(2)
+          if(ierr.ne.0) goto 109
+          write(*,*) 
+          write(*,*) ' albedice(2) (nouvelle valeur):',albedice(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'iceradius') then
+          write(*,*) 'valeur actuelle iceradius(1) Nord:',iceradius(1)
+          write(*,*) 'entrer la nouvelle valeur:'
+ 110      read(*,*,iostat=ierr) iceradius(1)
+          if(ierr.ne.0) goto 110
+          write(*,*) 
+          write(*,*) ' iceradius(1) (nouvelle valeur):',iceradius(1)
+          write(*,*)
+
+          write(*,*) 'valeur actuelle iceradius(2) Sud:',iceradius(2)
+          write(*,*) 'entrer la nouvelle valeur:'
+ 111      read(*,*,iostat=ierr) iceradius(2)
+          if(ierr.ne.0) goto 111
+          write(*,*) 
+          write(*,*) ' iceradius(2) (nouvelle valeur):',iceradius(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'dtemisice') then
+          write(*,*) 'valeur actuelle dtemisice(1) Nord:',dtemisice(1)
+          write(*,*) 'entrer la nouvelle valeur:'
+ 112      read(*,*,iostat=ierr) dtemisice(1)
+          if(ierr.ne.0) goto 112
+          write(*,*) 
+          write(*,*) ' dtemisice(1) (nouvelle valeur):',dtemisice(1)
+          write(*,*)
+
+          write(*,*) 'valeur actuelle dtemisice(2) Sud:',dtemisice(2)
+          write(*,*) 'entrer la nouvelle valeur:'
+ 113      read(*,*,iostat=ierr) dtemisice(2)
+          if(ierr.ne.0) goto 113
+          write(*,*) 
+          write(*,*) ' dtemisice(2) (nouvelle valeur):',dtemisice(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'tauvis') then
+          write(*,*) 'valeur actuelle:',tauvis
+          write(*,*) 'entrer la nouvelle valeur:'
+ 114      read(*,*,iostat=ierr) tauvis
+          if(ierr.ne.0) goto 114
+          write(*,*) 
+          write(*,*) ' tauvis (nouvelle valeur):',tauvis
+        else if (modif(1:lnblnk(modif)) .eq. 'obliquit') then
+          write(*,*) 'valeur actuelle:',obliquit
+          write(*,*) 'obliquit should be 25.19 on current Mars'
+          write(*,*) 'entrer la nouvelle valeur:'
+ 115      read(*,*,iostat=ierr) obliquit
+          if(ierr.ne.0) goto 115
+          write(*,*) 
+          write(*,*) ' obliquit (nouvelle valeur):',obliquit
+
+        else if (modif(1:lnblnk(modif)) .eq. 'peri_day') then
+          write(*,*) 'valeur actuelle:',peri_day
+          write(*,*) 'peri_day should be 485 on current Mars'
+          write(*,*) 'entrer la nouvelle valeur:'
+ 116      read(*,*,iostat=ierr) peri_day
+          if(ierr.ne.0) goto 116
+          write(*,*) 
+          write(*,*) ' peri_day (nouvelle valeur):',peri_day
+
+        else if (modif(1:lnblnk(modif)) .eq. 'periheli') then
+          write(*,*) 'valeur actuelle:',periheli
+          write(*,*) 'periheli should be 206.66 on current Mars'
+          write(*,*) 'entrer la nouvelle valeur:'
+ 117      read(*,*,iostat=ierr) periheli
+          if(ierr.ne.0) goto 117
+          write(*,*) 
+          write(*,*) ' periheli (nouvelle valeur):',periheli
+ 
+        else if (modif(1:lnblnk(modif)) .eq. 'aphelie') then
+          write(*,*) 'valeur actuelle:',aphelie
+          write(*,*) 'aphelie should be 249.22 on current Mars'
+          write(*,*) 'entrer la nouvelle valeur:'
+ 118      read(*,*,iostat=ierr) aphelie
+          if(ierr.ne.0) goto 118
+          write(*,*) 
+          write(*,*) ' aphelie (nouvelle valeur):',aphelie
+ 
+        endif
+      enddo
+
+ 999  continue
+
+c-----------------------------------------------------------------------
+c	Impression des constantes physiques apres modif si modif
+c-----------------------------------------------------------------------
+ 
+      write(*,*) '*****************************************************'
+      write(*,*) 'lecture du tab_cntrl a l appel de tabfi apres modif'
+      write(*,*) '*****************************************************'
+      write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),float(ngridmx)
+      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
+      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
+      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
+      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
+ 
+      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
+      write(*,5) '(15)       periheli',tab_cntrl(tab0+15),periheli
+      write(*,5) '(16)        aphelie',tab_cntrl(tab0+16),aphelie
+      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
+      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
+ 
+      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
+      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
+      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
+ 
+      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
+      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
+      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
+      write(*,5) '(22)    albedice(1)',tab_cntrl(tab0+22),albedice(1)
+      write(*,5) '(23)    albedice(2)',tab_cntrl(tab0+23),albedice(2)
+      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
+      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
+      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
+      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
+ 
+      write(*,5) '(27)         tauvis',tab_cntrl(tab0+27),tauvis
+
+      write(*,*)  
+      write(*,*) 
+
+      ENDIF 			!	(du if Lmodif = 1)
+
+c-----------------------------------------------------------------------
+c	Case when using a start file from before March 1996 (without iceradius...
+c-----------------------------------------------------------------------
+      if (iceradius(1).eq.0) then 
+         iceradius(1) = 100.e-6
+         iceradius(2) = 100.e-6
+         dtemisice(1) = 0.4
+         dtemisice(2) = 0.4
+         write (*,*) ' WARNING : old initialisation file'
+         write (*,*) 'iceradius set to',iceradius(1),iceradius(2)  
+         write (*,*) 'dtemisice set to',dtemisice(1),dtemisice(2)  
+       end if
+
+c-----------------------------------------------------------------------
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/testphys1d.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/testphys1d.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/testphys1d.F	(revision 2744)
@@ -0,0 +1,508 @@
+
+      PROGRAM testphys1d
+      IMPLICIT NONE
+
+c=======================================================================
+c   subject:
+c   --------
+c   PROGRAM useful to run physical part of the martian GCM in a 1D column
+c       
+c Can be compiled with a command like (e.g. for 25 layers)
+c  "makegcm -p mars -d 25 testphys1d"
+c It requires the files "testphys1d.def" "callphys.def"
+c      and a file describing the sigma layers (e.g. "z2sig.def")
+c
+c   author: Frederic Hourdin, R.Fournier,F.Forget
+c   -------
+c   
+c   update: 12/06/2003 including chemistry (S. Lebonnois) 
+c                            and water ice (F. Montmessin)
+c 
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "comsaison.h"
+#include "yomaer.h"
+#include "aerdust.h"
+#include "control.h"
+#include "comvert.h"
+#include "netcdf.inc"
+#include "comg1d.h"
+#include "watercap.h"
+#include "fisice.h"
+#include "logic.h"
+
+c --------------------------------------------------------------
+c  Declarations
+c --------------------------------------------------------------
+c
+      INTEGER unit           ! unite de lecture de "testphys1d.def"
+      INTEGER unitstart      ! unite d'ecriture de "startfi"
+      INTEGER nlayer,nlevel,nsoil,ndt
+      INTEGER ilayer,ilevel,isoil,idt,iq
+      LOGICAl firstcall,lastcall
+c
+      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
+      REAL day           ! date durant le run
+      REAL time             ! time (0<time<1 ; time=0.5 a midi)
+      REAL play(nlayermx)   ! Pressure at the middle of the layers (Pa)
+      REAL plev(nlayermx+1) ! intermediate pressure levels (pa)
+      REAL psurf,tsurf      
+      REAL u(nlayermx),v(nlayermx)  ! zonal, meridional wind
+      REAL gru,grv   ! prescribed "geostrophic" background wind
+      REAL temp(nlayermx)   ! temperature at the middle of the layers
+      REAL q(nlayermx,nqmx) ! tracer mixing ratio (e.g. kg/kg)
+      REAL qsurf(nqmx)      ! tracer surface budget (e.g. kg.m-2)
+      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
+      REAL co2ice           ! co2ice layer (kg.m-2)
+      REAL emis             ! surface layer
+      REAL q2(nlayermx+1)   ! Turbulent Kinetic Energy
+      REAL zlay(nlayermx)   ! altitude estimee dans les couches (km)
+
+c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
+      REAL du(nlayermx),dv(nlayermx),dtemp(nlayermx)
+      REAL dudyn(nlayermx),dvdyn(nlayermx),dtempdyn(nlayermx)
+      REAL dpsurf    
+      REAL dq(nlayermx,nqmx)
+      REAL dqdyn(nlayermx,nqmx)
+
+c   Various intermediate variables
+      INTEGER thermo
+      REAL zls
+      REAL phi(nlayermx),h(nlayermx),s(nlayermx)
+      REAL pks, ptif, w(nlayermx)
+      REAL qtotinit, mqtot(nqmx),qtot
+      INTEGER ierr, aslun
+      REAL tmp1(0:nlayermx),tmp2(0:nlayermx)
+      Logical  tracerdyn
+
+      character*2 str2
+
+c=======================================================================
+
+c=======================================================================
+c INITIALISATION
+c=======================================================================
+
+c ------------------------------------------------------
+c  Constantes prescrites ICI
+c ------------------------------------------------------
+
+      pi=2.E+0*asin(1.E+0)
+
+c     Constante de la Planete Mars
+c     ----------------------------
+      rad=3397200.               ! rayon de mars (m)  ~3397200 m
+      daysec=88775.              ! duree du sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec)  ! vitesse de rotation (rad.s-1)
+      g=3.72                     ! gravite (m.s-2) ~3.72  
+      mugaz=43.49                ! Masse molaire de l'atm (g.mol-1) ~43.49
+      rcp=.256793                ! = r/cp  ~0.256793
+      r= 8.314511E+0 *1000.E+0/mugaz
+      cpp= r/rcp
+      year_day = 669           ! duree de l'annee (sols) ~668.6
+      periheli = 206.66          ! dist.min. soleil-mars (Mkm) ~206.66
+      aphelie = 249.22           ! dist.max. soleil-mars (Mkm) ~249.22
+      peri_day =  485.           ! date du perihelie (sols depuis printemps)
+      obliquit = 25.2           ! Obliquite de la planete (deg) ~25.2         
+ 
+c     Parametres Couche limite et Turbulence 
+c     --------------------------------------
+      z0 =  1.e-2                ! surface roughness (m) ~0.01 
+      emin_turb = 1.e-6          ! energie minimale ~1.e-8
+      lmixmin = 30               ! longueur de melange ~100
+ 
+c     propriete optiques des calottes et emissivite du sol
+c     ----------------------------------------------------
+      emissiv= 0.95              ! Emissivite du sol martien ~.95
+      emisice(1)=0.95            ! Emissivite calotte nord
+      emisice(2)=0.95            ! Emissivite calotte sud  
+      albedice(1)=0.5           ! Albedo calotte nord
+      albedice(2)=0.5            ! Albedo calotte sud
+      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
+      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
+      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
+      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
+      hybrid=.false.
+
+c ------------------------------------------------------
+c  Lecture des parametres dans "testphys1d.def" 
+c ------------------------------------------------------
+
+c   Opening parameters file "testphys1d.def"
+c   ---------------------------------------
+      unit =97
+      OPEN(unit,file='testphys1d.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+
+      IF(ierr.ne.0) THEN
+        write(*,*) 'Problem to open "testphys1d.def'
+        write(*,*) 'Is it there ?'
+        stop
+      END IF
+
+c  Date et heure locale du debut du run
+c  ------------------------------------
+c    Date (en sols depuis le solstice de printemps) du debut du run
+      day0 = 0
+      PRINT *,'date de depart ?'
+      READ(unit,*) day0
+      day=float(day0)
+      PRINT *,day0
+c  Heure de demarrage
+      PRINT *,'heure de debut de simulation (entre 0 et 24) ?'
+      READ(unit,*) time
+      time=time/24.E+0
+
+c  Discretisation (Definition de la grille et des pas de temps)
+c  --------------
+c
+      nlayer=nlayermx
+      nlevel=nlayer+1
+      nsoil=nsoilmx
+      PRINT *,'nombre de pas de temps par jour ?'
+      READ(unit,*) day_step
+      print*,day_step
+
+      PRINT *,'nombre de jours simules ?'
+      READ(unit,*) ndt
+      print*,ndt
+
+      ndt=ndt*day_step     
+      dtphys=daysec/day_step  
+c Pression de surface sur la planete
+c ------------------------------------
+c
+      PRINT *,'pression au sol'
+      READ(unit,*) psurf
+      PRINT *,psurf
+c Pression de reference
+      pa=20.
+      preff=610.      
+ 
+c Proprietes des poussiere aerosol
+c --------------------------------
+      print *,'epaisseur optique dans le visible ?'
+      READ(unit,*) tauvis
+      print *,tauvis
+ 
+c  latitude/longitude
+c  ------------------
+      PRINT *,'latitude en degres ?'
+      READ(unit,*) lati(1)
+      PRINT *,lati(1)
+      lati(1)=lati(1)*pi/180.E+0
+      long(1)=0.E+0
+      long(1)=long(1)*pi/180.E+0
+
+c  Initialisation albedo / inertie du sol
+c  --------------------------------------
+c
+      PRINT *,'Albedo du sol nu ?'
+      READ(unit,*) albedodat(1)
+      PRINT *,albedodat(1)
+
+      PRINT *,'Inertie thermique du sol ?'
+      READ(unit,*) inertiedat(1)
+      PRINT *,inertiedat(1)
+c
+c  pour le schema d'ondes de gravite
+c  ---------------------------------
+c
+      zmea(1)=0.E+0
+      zstd(1)=0.E+0
+      zsig(1)=0.E+0
+      zgam(1)=0.E+0
+      zthe(1)=0.E+0
+
+
+
+c   Initialisation speciales "physiq"
+c   ---------------------------------
+c   la surface de chaque maille est inutile en 1D --->
+      area(1)=1.E+0
+
+c   le geopotentiel au sol est inutile en 1D car tout est controle
+c   par la pression de surface --->
+      phisfi(1)=0.E+0
+
+c  "inifis" reproduit un certain nombre d'initialisations deja faites
+c  + lecture des clefs de callphys.def
+c  + calcul de la frequence d'appel au rayonnement
+c  + calcul des sinus et cosinus des longitude latitude
+
+!Mars possible matter with dtphys in input and include!!!
+      CALL inifis(1,llm,day0,daysec,dtphys,
+     .            lati,long,area,rad,g,r,cpp)
+c   Initialisation pour prendre en compte les vents en 1-D
+c   ------------------------------------------------------
+      ptif=2.E+0*omeg*sinlat(1)
+ 
+c    vent geostrophique
+      PRINT *,'composante vers l est du vent geostrophique (U) ?'
+      READ(unit,*) gru
+      PRINT *,'composante vers le nord du vent geostrophique (V) ?'
+      READ(unit,*) grv
+
+c     Initialisation des vents  au premier pas de temps
+      DO ilayer=1,nlayer
+         u(ilayer)=gru
+         v(ilayer)=grv
+      ENDDO
+
+c     energie cinetique turbulente
+      DO ilevel=1,nlevel
+         q2(ilevel)=0.E+0
+      ENDDO
+
+c  glace de CO2 au sol
+c  -------------------
+      co2ice=0.E+0
+      PRINT *,'co2ice (kg.m-2)'
+      READ(unit,*) co2ice
+
+c
+c  emissivite
+c  ----------
+      emis=emissiv
+      IF (co2ice.eq.1.E+0) THEN
+         emis=emisice(1)
+         IF(lati(1).LT.0) emis=emisice(2)
+      ENDIF
+
+ 
+
+c  calcul des pressions et altitudes en utilisant les niveaux sigma
+c  ----------------------------------------------------------------
+
+c    Vertical Coordinates
+c    """"""""""""""""""""
+      PRINT *,'Hybrid coordinates ?'
+      READ(unit,*) hybrid
+      PRINT *,'Hybrid =', hybrid
+
+      CALL  disvert
+
+      DO ilevel=1,nlevel
+        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        zlay(ilayer)=-200.E+0 *r*log(play(ilayer)/plev(1))
+     &   /g
+      ENDDO
+
+
+c  profil de temperature au premier appel
+c  --------------------------------------
+      pks=psurf**rcp
+
+c altitude en km dans profile: on divise zlay par 1000
+      tmp1(0)=0.E+0
+      DO ilayer=1,nlayer
+        tmp1(ilayer)=zlay(ilayer)/1000.E+0
+      ENDDO
+      call profile(unit,nlayer+1,tmp1,tmp2)
+
+      tsurf=tmp2(0)
+      DO ilayer=1,nlayer
+        temp(ilayer)=tmp2(ilayer)
+      ENDDO
+      
+
+
+c     temperature du sous-sol
+c     ~~~~~~~~~~~~~~~~~~~~~~~
+      DO isoil=1,nsoil
+         tsoil(isoil)=tsurf
+      ENDDO
+
+c    Initialisation des traceurs
+c    ---------------------------
+
+      DO iq=1,nqmx
+        DO ilayer=1,nlayer
+           q(ilayer,iq) = 0.
+        ENDDO
+      ENDDO
+
+      if (photochem.or.callthermos) then
+         write(*,*) 'Especes chimiques initialisees'
+         ! thermo=0: initialisation pour toutes les couches 
+         thermo=0
+         call inichim_newstart(q,psurf,sig,nqmx,lati,long,area,
+     $   thermo)
+      endif
+      watercaptag(ngridmx)=.false.
+      
+      DO iq=1,nqmx-1
+        qsurf(iq) = 0.
+      ENDDO
+
+
+c    Initialisation pour les sorties GRADS dans "g1d.dat" et "g1d.ctl"
+c    ----------------------------------------------------------------
+c    (effectuee avec "writeg1d" a partir de "physiq.F"
+c    ou tout autre subroutine physique, y compris celle ci).
+
+        g1d_nlayer=nlayer
+        g1d_nomfich='g1d.dat'
+        g1d_unitfich=40
+        g1d_nomctl='g1d.ctl'
+        g1d_unitctl=41
+        g1d_premier=.true.
+        g2d_premier=.true.
+
+c  Ecriture de "startfi"
+c  --------------------
+c  (Ce fichier sera aussitot relu au premier
+c   appel de "physiq", mais il est necessaire pour passer
+c   les variables purement physiques a "physiq"...
+
+      call physdem1("startfi.nc",long,lati,nsoilmx,nqmx,
+     .              dtphys,float(day0),
+     .              time,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c  BOUCLE TEMPORELLE DU MODELE 1D 
+c=======================================================================
+c
+      firstcall=.true.
+      lastcall=.false.
+
+      DO idt=1,ndt
+c        IF (idt.eq.ndt) lastcall=.true.
+        IF (idt.eq.ndt-day_step-1) then       !test
+         lastcall=.true.
+         call solarlong(day*1.0,zls)
+         write(103,*) 'Ls=',zls*180./pi
+         write(103,*) 'Lat=', lati(1)*180./pi
+         write(103,*) 'Tau=', tauvis/700*psurf
+         write(103,*) 'RunEnd - Atmos. Temp. File'
+         write(103,*) 'RunEnd - Atmos. Temp. File'
+         write(104,*) 'Ls=',zls*180./pi
+         write(104,*) 'Lat=', lati(1)
+         write(104,*) 'Tau=', tauvis/700*psurf
+         write(104,*) 'RunEnd - Atmos. Temp. File'
+        ENDIF
+
+c    calcul du geopotentiel 
+c     ~~~~~~~~~~~~~~~~~~~~~
+      DO ilayer=1,nlayer
+        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
+      ENDDO
+      phi(1)=pks*h(1)*(1.E+0-s(1))
+      DO ilayer=2,nlayer
+         phi(ilayer)=phi(ilayer-1)+
+     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
+     &                  *(s(ilayer-1)-s(ilayer))
+
+      ENDDO
+
+c       appel de la physique
+c       --------------------
+
+      CALL physiq (1,llm,nqmx,
+     ,     firstcall,lastcall,
+     ,     day,time,dtphys,
+     ,     plev,play,phi,
+     ,     u, v,temp, q,  
+     ,     w,
+C - sorties
+     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
+
+c       evolution du vent : modele 1D
+c       -----------------------------
+ 
+c       la physique calcule les derivees temporelles de u et v.
+c       on y rajoute betement un effet Coriolis.
+c
+c       DO ilayer=1,nlayer
+c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
+c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
+c       ENDDO
+
+c       Pour certain test : pas de coriolis a l'equateur
+c       if(lati(1).eq.0.) then
+          DO ilayer=1,nlayer
+             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
+             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
+          ENDDO
+c       end if
+c      
+c
+c       Calcul du temps au pas de temps suivant
+c       ---------------------------------------
+        firstcall=.false.
+        time=time+dtphys/daysec
+        IF (time.gt.1.E+0) then
+            time=time-1.E+0
+            day=day+1
+        ENDIF
+
+c       calcul des vitesses et temperature au pas de temps suivant
+c       ----------------------------------------------------------
+
+        DO ilayer=1,nlayer
+           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
+           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
+           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
+        ENDDO
+
+c       calcul des pressions au pas de temps suivant
+c       ----------------------------------------------------------
+
+           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           DO ilevel=1,nlevel
+             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+           ENDDO
+           DO ilayer=1,nlayer
+             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+           ENDDO
+
+      ENDDO   ! fin de la boucle temporelle
+
+c    ========================================================
+c    GESTION DES SORTIE
+c    ========================================================
+
+c    fermeture pour conclure les sorties format grads dans "g1d.dat"
+c    et "g1d.ctl" (effectuee avec "writeg1d" a partir de "physiq.F"
+c    ou tout autre subroutine physique, y compris celle ci).
+
+c        CALL endg1d(1,nlayer,zphi/(g*1000.),ndt)
+        CALL endg1d(1,nlayer,zlay/1000.,ndt)
+
+c    ========================================================
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+c     Subroutines Bidons utilise seulement en 3D, mais
+c     necessaire a la compilation de testphys1d en 1-D
+
+      subroutine gr_fi_dyn
+      RETURN
+      END
+ 
+      subroutine iniwrite
+      RETURN
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+
+#include "../dyn3d/disvert.F"
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/tracer.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/tracer.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/tracer.h	(revision 2744)
@@ -0,0 +1,22 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'tracer.h'
+
+      character*10  noms(nqmx)  ! name of the tracer
+      real mmol(nqmx)           ! mole mass of tracer (g/mol-1) 
+      real radius(nqmx)   ! dust and ice particle radius (m)
+      real qext(nqmx)     ! Single Scat. Extinction coeff at 0.67 um
+      real alpha_lift(nqmx) ! saltation vertical flux/horiz flux ratio (m-1)
+      real alpha_devil(nqmx) ! lifting coeeficient by dust devil
+
+      real varian      ! Characteristic variance of log-normal distribution
+      real r3n_q     ! used to compute r0 from number and mass mixing ratio
+      real qextrhor(nqmx) ! Intermediate for computing opt. depth from q
+      real rho_dust     ! Mars dust density (kg.m-3)
+      real rho_ice     ! Water ice density (kg.m-3)
+      real ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
+
+      real dryness(ngridmx)!"Dryness coefficient" for grnd water ice sublimation
+      
+      COMMON/tracer/radius,qext,alpha_lift,alpha_devil,noms,mmol,
+     & varian,r3n_q,qextrhor,rho_dust,rho_ice,ref_r0,dryness
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/uniplot.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/uniplot.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/uniplot.F	(revision 2744)
@@ -0,0 +1,74 @@
+      SUBROUTINE uniplot(im,jm,champ)
+      INTEGER isys,system
+      EXTERNAL system
+      INTEGER imx,jmx
+      PARAMETER (imx=400,jmx=200)
+      INTEGER im,jm,i,j,nreg
+      REAL champ(im,jm)
+      REAL xinf,xsup,yinf,ysup
+      REAL xorig,yorig,xlength,ylength,xfac,yfac
+      REAL xreg(1),yreg(1)
+      REAL x(imx),y(jmx)
+      LOGICAL francais,flreg,flgri,fliso
+      REAL txtheight,linewidth,fdismin,flonmin
+      INTEGER ishade,inter_exter
+      CHARACTER*200 txtstr(5)
+
+      xorig=20.
+      yorig=20.
+      xlength=120.
+      ylength=120.
+      xfac=1.
+      yfac=1.
+      xinf=1.
+      xsup=im
+      yinf=1.
+      ysup=jm
+      nreg=1
+      DO i=1,im
+         x(i)=i
+      ENDDO
+      DO j=1,jm
+         y(j)=j
+      ENDDO
+
+      DO i=1,5
+       txtstr(i)=" "
+      ENDDO
+
+      txtstr(2)='i'
+      txtstr(3)='j'
+
+      OPEN(10,file='/tmp2/planetes/tmp.graph',
+     s  status='unknown',form='formatted')
+
+      WRITE(10,*) im,jm,nreg
+      WRITE(10,*) xorig,yorig,xlength,ylength,xfac,yfac,
+     s     xinf,xsup,yinf,ysup
+      WRITE(10,*) (x(i),i=1,im),(y(j),j=1,jm),
+     s     ((champ(i,j),i=1,im),j=1,jm),
+     s     (xreg(i),i=1,nreg),(yreg(j),j=1,nreg)
+
+      francais=.true.
+      flreg=.false.
+      flgri=.false.
+      fliso=.true.
+      txtheight=3.7
+      linewidth=.2
+      fdismin=0.
+      flonmin=0.
+      ishade=3
+      inter_exter=0
+      WRITE(10,*) francais,flreg,flgri,fliso
+      WRITE(10,*) txtheight,linewidth,fdismin,flonmin
+      WRITE(10,*) ishade,inter_exter
+      DO i=1,5
+      WRITE(10,'(a200)') txtstr(i)
+      ENDDO
+      CLOSE(10)
+
+      isys=system(
+     s  'rsh ella " xterm -display $DISPLAY -n controle_graph
+     s   -e /u2/planetes/graph/lance" ' )
+
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vdif_cd.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vdif_cd.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vdif_cd.F	(revision 2744)
@@ -0,0 +1,118 @@
+      SUBROUTINE vdif_cd( ngrid,nlay,pz0, 
+     &    pg,pz,pu,pv,pts,ph,pcdv,pcdh)
+c****WRF:ligne trop longue
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Subject: computation of the surface drag coefficient using the
+c   -------  approch developed by Loui for ECMWF.
+c
+c   Author: Frederic Hourdin  15 /10 /93
+c   -------
+c
+c   Arguments:
+c   ----------
+c
+c   inputs:
+c   ------
+c     ngrid            size of the horizontal grid
+c     pg               gravity (m s -2)
+c     pz(ngrid)        height of the first atmospheric layer
+c     pu(ngrid)        u component of the wind in that layer
+c     pv(ngrid)        v component of the wind in that layer
+c     pts(ngrid)       surfacte temperature
+c     ph(ngrid)        potential temperature T*(p/ps)^kappa
+c
+c   outputs:
+c   --------
+c     pcdv(ngrid)      Cd for the wind
+c     pcdh(ngrid)      Cd for potential temperature
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+c   Arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL pz0
+      REAL pg,pz(ngrid,nlay)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay)
+      REAL pts(ngrid,nlay),ph(ngrid,nlay)
+      REAL pcdv(ngrid),pcdh(ngrid)
+
+c   Local:
+c   ------
+
+      INTEGER ig
+
+      REAL zu2,z1,zri,zcd0,zz
+
+      REAL karman,b,c,d,c2b,c3bc,c3b,umin2
+      LOGICAL firstcal
+      DATA karman,b,c,d,umin2/.4,5.,5.,5.,1.e-12/
+      DATA firstcal/.true./
+      SAVE b,c,d,karman,c2b,c3bc,c3b,firstcal,umin2
+
+c-----------------------------------------------------------------------
+c   couche de surface:
+c   ------------------
+
+c     DO ig=1,ngrid
+c        zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
+c        pcdv(ig)=pz0*(1.+sqrt(zu2))
+c        pcdh(ig)=pcdv(ig)
+c     ENDDO
+c     RETURN
+c
+c      IF (firstcal) THEN
+c         c2b=2.*b
+c         c3bc=3.*b*c
+c         c3b=3.*b
+c         firstcal=.false.
+c      ENDIF
+c
+c!!!! WARNING, verifier la formule originale de Louis!
+c      DO ig=1,ngrid
+c         zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
+c         zri=pg*pz(ig)*(ph(ig)-pts(ig))/(ph(ig)*zu2)
+c._.
+c            zri=0.E+0
+c._.
+c         z1=1.+pz(ig)/pz0
+c         zcd0=karman/log(z1)
+c._.         zcd0=zcd0*zcd0*sqrt(zu2)
+c         zcd0=zcd0*zcd0
+c         IF(zri.LT.0.) THEN
+c._.            z1=b*zri/(1.+c3bc*zcd0*sqrt(-z1*zri))
+c            z1=b*zri/(1.+c3bc*zcd0*sqrt(-z1*zri*zu2))
+c            pcdv(ig)=zcd0*(1.-2.*z1)
+c            pcdh(ig)=zcd0*(1.-3.*z1)
+c         ELSE
+c            zz=sqrt(1.+d*zri)
+c            pcdv(ig)=zcd0/(1.+c2b*zri/zz)
+c            pcdh(ig)=zcd0/(1.+c3b*zri*zz)
+c         ENDIF
+c      ENDDO
+
+
+c On calcule un VRAI cdrag tout bete
+
+      DO ig=1,ngrid
+         z1=1.E+0 + pz(ig,1)/pz0
+         zcd0=karman/log(z1)
+         zcd0=zcd0*zcd0
+         pcdv(ig)=zcd0
+         pcdh(ig)=zcd0
+      ENDDO
+
+       
+
+
+c-----------------------------------------------------------------------
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vdif_kc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vdif_kc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vdif_kc.F	(revision 2744)
@@ -0,0 +1,554 @@
+      SUBROUTINE vdif_kc(dt,g,zlev,zlay,u,v,teta,cd,q2,km,kn)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphys.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c 
+c.......................................................................
+      REAL dt,g
+      REAL zlev(ngridmx,nlayermx+1)
+      REAL zlay(ngridmx,nlayermx)
+      REAL u(ngridmx,nlayermx)
+      REAL v(ngridmx,nlayermx)
+      REAL teta(ngridmx,nlayermx)
+      REAL cd(ngridmx)
+      REAL q2(ngridmx,nlayermx+1)
+      REAL km(ngridmx,nlayermx+1)
+      REAL kn(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c nlay : nombre de couches        
+c nlev : nombre de niveaux
+c ngrid : nombre de points de grille       
+c unsdz : 1 sur l'epaisseur de couche
+c unsdzdec : 1 sur la distance entre le centre de la couche et le
+c            centre de la couche inferieure
+c q : echelle de vitesse au bas de chaque couche
+c     (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      INTEGER nlay,nlev,ngrid
+      REAL unsdz(ngridmx,nlayermx)
+      REAL unsdzdec(ngridmx,nlayermx+1)
+      REAL q(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c kmpre : km au debut du pas de temps
+c qcstat : q : solution stationnaire du probleme couple
+c          (valeur a la fin du pas de temps)
+c q2cstat : q2 : solution stationnaire du probleme couple
+c           (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL kmpre(ngridmx,nlayermx+1)
+      REAL qcstat
+      REAL q2cstat
+c.......................................................................
+c
+c long : longueur de melange calculee selon Blackadar
+c
+c.......................................................................
+      REAL long(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c kmq3 : terme en q^3 dans le developpement de km
+c        (valeur au debut du pas de temps)
+c kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c knq3 : terme en q^3 dans le developpement de kn
+c mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
+c          (valeur a la fin du pas de temps)
+c m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c m : valeur a la fin du pas de temps
+c mpre : valeur au debut du pas de temps
+c m2 : valeur a la fin du pas de temps
+c n2 : valeur a la fin du pas de temps
+c 
+c.......................................................................
+      REAL kmq3
+      REAL kmcstat
+      REAL knq3
+      REAL mcstat
+      REAL m2cstat
+      REAL m(ngridmx,nlayermx+1)
+      REAL mpre(ngridmx,nlayermx+1)
+      REAL m2(ngridmx,nlayermx+1)
+      REAL n2(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c gn : intermediaire pour les coefficients de stabilite
+c gnmin : borne inferieure de gn (-0.23 ou -0.28)
+c gnmax : borne superieure de gn (0.0233)
+c gninf : vrai si gn est en dessous de sa borne inferieure
+c gnsup : vrai si gn est en dessus de sa borne superieure
+c gm : drole d'objet bien utile
+c ri : nombre de Richardson
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c sm : coefficient de stabilite pour m
+c smq2 : premier terme du developement limite de sm en q2
+c
+c.......................................................................
+      REAL gn
+      REAL gnmin
+      REAL gnmax
+      LOGICAL gninf
+      LOGICAL gnsup
+      REAL gm
+c      REAL ri(ngridmx,nlayermx+1)
+      REAL sn(ngridmx,nlayermx+1)
+      REAL snq2(ngridmx,nlayermx+1)
+      REAL sm(ngridmx,nlayermx+1)
+      REAL smq2(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c kappa : consatnte de Von Karman (0.4)
+c long0 : longueur de reference pour le calcul de long (160)
+c a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
+c                  de stabilite (0.92/0.74/16.6/10.1/0.08)
+c cn1,cn2 : constantes pour sn
+c cm1,cm2,cm3,cm4 : constantes pour sm
+c
+c.......................................................................
+      REAL kappa
+      REAL long0
+      REAL a1,a2,b1,b2,c1
+      REAL cn1,cn2
+      REAL cm1,cm2,cm3,cm4
+c.......................................................................
+c
+c termq : termes en $q$ dans l'equation de q2
+c termq3 : termes en $q^3$ dans l'equation de q2
+c termqm2 : termes en $q*m^2$ dans l'equation de q2
+c termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
+c
+c.......................................................................
+      REAL termq
+      REAL termq3
+      REAL termqm2
+      REAL termq3m2
+c.......................................................................
+c
+c q2min : borne inferieure de q2
+c q2max : borne superieure de q2
+c
+c.......................................................................
+      REAL q2min
+      REAL q2max
+c.......................................................................
+c knmin : borne inferieure de kn
+c kmmin : borne inferieure de km
+c.......................................................................
+      REAL knmin
+      REAL kmmin
+c.......................................................................
+      INTEGER ilay,ilev,igrid
+      REAL tmp1,tmp2
+c.......................................................................
+      PARAMETER (kappa=0.4E+0)
+      PARAMETER (long0=160.E+0)
+      PARAMETER (gnmin=-10.E+0)
+      PARAMETER (gnmax=0.0233E+0)
+      PARAMETER (a1=0.92E+0)
+      PARAMETER (a2=0.74E+0)
+      PARAMETER (b1=16.6E+0)
+      PARAMETER (b2=10.1E+0)
+      PARAMETER (c1=0.08E+0)
+      PARAMETER (knmin=1.E-5)
+      PARAMETER (kmmin=1.E-5)
+      PARAMETER (q2min=1.E-3)
+      PARAMETER (q2max=1.E+2)
+      PARAMETER (nlay=nlayermx)
+      PARAMETER (nlev=nlayermx+1)
+      PARAMETER (ngrid=ngridmx)
+c
+      PARAMETER (
+     &  cn1=a2*(1.E+0 -6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cn2=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm1=a1*(1.E+0 -3.E+0 *c1-6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cm2=a1*(-3.E+0 *a2*((b2-3.E+0 *a2)*(1.E+0 -6.E+0 *a1/b1)
+     &          -3.E+0 *c1*(b2+6.E+0 *a1)))
+     &          )
+      PARAMETER (
+     &  cm3=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm4=-9.E+0 *a1*a2
+     &          )
+c.......................................................................
+c  traitment des valeur de q2 en entree
+c.......................................................................
+c
+      DO ilev=1,nlev
+                                                      DO igrid=1,ngrid 
+        q2(igrid,ilev)=amax1(q2(igrid,ilev),q2min)
+        q(igrid,ilev)=sqrt(q2(igrid,ilev))
+                                                      ENDDO
+      ENDDO
+c
+                                                      DO igrid=1,ngrid 
+      tmp1=cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
+      q2(igrid,1)=b1**(2.E+0/3.E+0)*tmp1
+      q2(igrid,1)=amax1(q2(igrid,1),q2min)
+      q(igrid,1)=sqrt(q2(igrid,1))
+                                                      ENDDO
+c
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+c                                                     DO igrid=1,ngrid 
+c           zlev(igrid,nlev)=zlay(igrid,nlay)
+c    &             +( zlay(igrid,nlay) - zlev(igrid,nlev-1) )
+c                                                     ENDDO            
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO ilay=1,nlay
+                                                      DO igrid=1,ngrid 
+        unsdz(igrid,ilay)=1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,1)=1.E+0/(zlay(igrid,1)-zlev(igrid,1))
+                                                      ENDDO
+      DO ilay=2,nlay
+                                                      DO igrid=1,ngrid 
+        unsdzdec(igrid,ilay)=1.E+0/(zlay(igrid,ilay)-zlay(igrid,ilay-1))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,nlay+1)=1.E+0/(zlev(igrid,nlay+1)-zlay(igrid,nlay))
+                                                      ENDDO
+c
+c.......................................................................
+c  le cisaillement et le gradient de temperature
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,1)=(unsdzdec(igrid,1)
+     &                   *u(igrid,1))**2
+     &                 +(unsdzdec(igrid,1)
+     &                   *v(igrid,1))**2
+      m(igrid,1)=sqrt(m2(igrid,1))
+      mpre(igrid,1)=m(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        n2(igrid,ilev)=g*unsdzdec(igrid,ilev)
+     &                   *(teta(igrid,ilev)-teta(igrid,ilev-1))
+     &                   /(teta(igrid,ilev)+teta(igrid,ilev-1)) *2.E+0
+c
+c --->
+c       on ne sais traiter que les cas stratifies. et l'ajustement
+c       convectif est cense faire en sorte que seul des configurations
+c       stratifiees soient rencontrees en entree de cette routine.
+c       mais, bon ... on sait jamais (meme on sait que n2 prends
+c       quelques valeurs negatives ... parfois) alors : 
+c<---
+c
+        IF (n2(igrid,ilev).lt.0.E+0) THEN
+          n2(igrid,ilev)=0.E+0
+        ENDIF
+c
+        m2(igrid,ilev)=(unsdzdec(igrid,ilev)
+     &                     *(u(igrid,ilev)-u(igrid,ilev-1)))**2
+     &                   +(unsdzdec(igrid,ilev)
+     &                     *(v(igrid,ilev)-v(igrid,ilev-1)))**2
+        m(igrid,ilev)=sqrt(m2(igrid,ilev))
+        mpre(igrid,ilev)=m(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,nlev)=m2(igrid,nlev-1)
+      m(igrid,nlev)=m(igrid,nlev-1)
+      mpre(igrid,nlev)=m(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  calcul des fonctions de stabilite
+c.......................................................................
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        tmp1=kappa*(zlev(igrid,ilev)-zlev(igrid,1))
+        long(igrid,ilev)=tmp1/(1.E+0 + tmp1/long0)
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        gm=long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * m2(igrid,ilev)
+c
+        gninf=.false.
+        gnsup=.false.
+        long(igrid,ilev)=long(igrid,ilev)
+        long(igrid,ilev)=long(igrid,ilev)
+c
+        IF (gn.lt.gnmin) THEN
+          gninf=.true.
+          gn=gnmin
+        ENDIF
+c
+        IF (gn.gt.gnmax) THEN
+          gnsup=.true.
+          gn=gnmax
+        ENDIF
+c
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)
+     &     *(1.E+0 +cm4*gn) )
+c
+        IF ((gninf).or.(gnsup)) THEN
+          snq2(igrid,ilev)=0.E+0
+          smq2(igrid,ilev)=0.E+0
+        ELSE
+          snq2(igrid,ilev)=
+     &     -gn
+     &     *(-cn1*cn2/(1.E+0 +cn2*gn)**2 )
+          smq2(igrid,ilev)=
+     &     -gn
+     &     *( cm2*(1.E+0 +cm3*gn)
+     &           *(1.E+0 +cm4*gn)
+     &       -( cm3*(1.E+0 +cm4*gn)
+     &         +cm4*(1.E+0 +cm3*gn) )
+     &       *(cm1+cm2*gn)            )
+     &     /( (1.E+0 +cm3*gn)
+     &       *(1.E+0 +cm4*gn) )**2
+        ENDIF
+c
+c --->
+c       la decomposition de Taylor en q2 n'a de sens que
+c       dans les cas stratifies ou sn et sm sont quasi
+c       proportionnels a q2. ailleurs on laisse le meme
+c       algorithme car l'ajustement convectif fait le travail.
+c       mais c'est delirant quand sn et snq2 n'ont pas le meme
+c       signe : dans ces cas, on ne fait pas la decomposition.
+c<---
+c
+        IF (snq2(igrid,ilev)*sn(igrid,ilev).le.0.E+0)
+     &      snq2(igrid,ilev)=0.E+0
+        IF (smq2(igrid,ilev)*sm(igrid,ilev).le.0.E+0)
+     &      smq2(igrid,ilev)=0.E+0
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+c.......................................................................
+c  calcul de km et kn au debut du pas de temps
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+      kmpre(igrid,1)=km(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sm(igrid,ilev)
+        kmpre(igrid,ilev)=km(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+      kmpre(igrid,nlev)=km(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  boucle sur les niveaux 2 a nlev-1
+c.......................................................................
+c
+c---->
+      DO 10001 ilev=2,nlev-1
+c---->
+      DO 10002 igrid=1,ngrid 
+c
+c.......................................................................
+c
+c  calcul des termes sources et puits de l'equation de q2
+c  ------------------------------------------------------
+c
+        knq3=kn(igrid,ilev)*snq2(igrid,ilev)
+     &                                    /sn(igrid,ilev)
+        kmq3=km(igrid,ilev)*smq2(igrid,ilev)
+     &                                    /sm(igrid,ilev)
+c
+        termq=0.E+0
+        termq3=0.E+0
+        termqm2=0.E+0
+        termq3m2=0.E+0
+c
+        tmp1=dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+        tmp2=dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termqm2=termqm2
+     &    +dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+     &    -dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termq3m2=termq3m2
+     &    +dt*2.E+0 *kmq3*m2(igrid,ilev)
+c 
+        termq=termq
+     &    -dt*2.E+0 *kn(igrid,ilev)*n2(igrid,ilev)
+     &    +dt*2.E+0 *knq3*n2(igrid,ilev)
+        termq3=termq3
+     &    -dt*2.E+0 *knq3*n2(igrid,ilev)
+c
+        termq3=termq3
+     &    -dt*2.E+0 *q(igrid,ilev)**3 / (b1*long(igrid,ilev))
+c
+c.......................................................................
+c
+c  resolution stationnaire couplee avec le gradient de vitesse local
+c  -----------------------------------------------------------------
+c
+c  -----{on cherche le cisaillement qui annule l'equation de q^2
+c        supposee en q3}
+c
+        tmp1=termq+termq3
+        tmp2=termqm2+termq3m2
+        m2cstat=m2(igrid,ilev)
+     &      -(tmp1+tmp2)/(dt*2.E+0*km(igrid,ilev))
+        mcstat=sqrt(m2cstat)
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (ilev.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)
+     &              *cd(igrid)
+     &              *( sqrt(u(igrid,3)**2+v(igrid,3)**2)
+     &                -mcstat/unsdzdec(igrid,ilev)
+     &                -mpre(igrid,ilev+1)/unsdzdec(igrid,ilev+1) )**2)
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)
+     &                          *mpre(igrid,ilev-1) )
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ENDIF
+        tmp2=kmcstat
+     &      /( sm(igrid,ilev)/q2(igrid,ilev) )
+     &      /long(igrid,ilev)
+        qcstat=tmp2**(1.E+0/3.E+0)
+        q2cstat=qcstat**2
+c
+c.......................................................................
+c
+c  choix de la solution finale
+c  ---------------------------
+c
+          q(igrid,ilev)=qcstat
+          q2(igrid,ilev)=q2cstat
+          m(igrid,ilev)=mcstat
+          m2(igrid,ilev)=m2cstat
+c
+c --->
+c       pour des raisons simples q2 est minore 
+c<---
+c
+        IF (q2(igrid,ilev).lt.q2min) THEN
+          q2(igrid,ilev)=q2min
+          q(igrid,ilev)=sqrt(q2min)
+        ENDIF
+c
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sm(igrid,ilev)
+c
+c.......................................................................
+c
+10002 CONTINUE
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+      q2(igrid,nlev)=q2(igrid,nlev-1)
+      q(igrid,nlev)=q(igrid,nlev-1)
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+                                                      ENDDO
+
+c
+c.......................................................................
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vdifc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vdifc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vdifc.F	(revision 2744)
@@ -0,0 +1,597 @@
+      SUBROUTINE vdifc(ngrid,nlay,nq,co2ice,ppopsk,
+     $                ptimestep,pcapcal,lecrit,
+     $                pplay,pplev,pzlay,pzlev,pz0,
+     $                pu,pv,ph,pq,ptsrf,pemis,pqsurf,
+     $                pdufi,pdvfi,pdhfi,pdqfi,pfluxsrf,
+     $                pdudif,pdvdif,pdhdif,pdtsrf,pq2,
+     $                pdqdif,pdqsdif)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   subject:
+c   --------
+c   Turbulent diffusion (mixing) for potential T, U, V and tracer
+c
+c   Shema implicite
+c   On commence par rajouter au variables x la tendance physique
+c   et on resoult en fait:
+c      x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
+c
+c   author:
+c   ------
+c      Hourdin/Forget/Fournier
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "surfdat.h"
+#include "comgeomfi.h"
+#include "tracer.h"
+
+#include "watercap.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
+      REAL ptsrf(ngrid),pemis(ngrid)
+      REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
+      REAL pfluxsrf(ngrid)
+      REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
+      REAL pdtsrf(ngrid),pcapcal(ngrid)
+      REAL pq2(ngrid,nlay+1)
+
+c    Argument added for condensation:
+      REAL co2ice (ngrid), ppopsk(ngrid,nlay)
+      logical lecrit
+      REAL pz0
+
+c    Traceurs :
+      integer nq 
+      REAL pqsurf(ngrid,nq)
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 
+      real pdqdif(ngrid,nlay,nq) 
+      real pdqsdif(ngrid,nq) 
+      
+c   local:
+c   ------
+
+      INTEGER ilev,ig,ilay,nlev,ierr
+
+      REAL z4st,zdplanck(ngridmx)
+      REAL zkv(ngridmx,nlayermx+1),zkh(ngridmx,nlayermx+1)
+	  REAL zcdv(ngridmx),zcdh(ngridmx)
+	  REAL zcdv_true(ngridmx),zcdh_true(ngridmx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zh(ngridmx,nlayermx)
+      REAL ztsrf2(ngridmx)
+      REAL z1(ngridmx),z2(ngridmx)
+      REAL za(ngridmx,nlayermx),zb(ngridmx,nlayermx)
+      REAL zb0(ngridmx,nlayermx)
+      REAL zc(ngridmx,nlayermx),zd(ngridmx,nlayermx)
+      REAL zcst1
+      REAL zu2
+
+      EXTERNAL SSUM,SCOPY
+      REAL SSUM
+      LOGICAL firstcall
+      SAVE firstcall
+
+c     variable added for CO2 condensation:
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+      REAL hh , zhcond(ngridmx,nlayermx), tconds
+       REAL latcond,tcond1mb
+      REAL acond,bcond
+      SAVE acond,bcond
+      DATA latcond,tcond1mb/5.9e5,136.27/
+
+c    Tracers :
+c    ~~~~~~~ 
+      INTEGER iq
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL zq1temp(ngridmx)
+      REAL rho(ngridmx) ! near surface air density
+      REAL qsat(ngridmx)
+      DATA firstcall/.true./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans coefdifv'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+c        To compute: Tcond= 1./(bcond-acond*log(.0095*p)) (p in pascal)
+         bcond=1./tcond1mb
+         acond=r/latcond
+         PRINT*,'In vdifc: Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
+         PRINT*,'acond,bcond,ccond',acond,bcond,acond
+
+         firstcall=.false.
+      ENDIF
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+      nlev=nlay+1
+
+c    ** calcul de rho*dz et dt*rho/dz=dt*rho**2 g/dp
+c       avec rho=p/RT=p/ (R Theta) (p/ps)**kappa
+c       ----------------------------------------
+
+      DO ilay=1,nlay
+         DO ig=1,ngrid
+            za(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/g
+         ENDDO
+      ENDDO
+
+      zcst1=4.*g*ptimestep/(r*r)
+      DO ilev=2,nlev-1
+         DO ig=1,ngrid
+            zb0(ig,ilev)=pplev(ig,ilev)*
+     s      (pplev(ig,1)/pplev(ig,ilev))**rcp /
+     s      (ph(ig,ilev-1)+ph(ig,ilev))
+            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/
+     s      (pplay(ig,ilev-1)-pplay(ig,ilev))
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+		 zb0(ig,1)=ptimestep*pplev(ig,1)/(r*ptsrf(ig))
+      ENDDO
+
+
+
+c    ** diagnostique pour l'initialisation
+c       ----------------------------------
+
+      IF(lecrit) THEN
+         ig=ngrid/2+1
+         PRINT*,'Pression (mbar) ,altitude (km),u,v,theta, rho dz'
+         DO ilay=1,nlay
+            WRITE(*,'(6f11.5)')
+     s      .01*pplay(ig,ilay),.001*pzlay(ig,ilay),
+     s      pu(ig,ilay),pv(ig,ilay),ph(ig,ilay),za(ig,ilay)
+         ENDDO
+         PRINT*,'Pression (mbar) ,altitude (km),zb'
+         DO ilev=1,nlay
+            WRITE(*,'(3f15.7)')
+     s      .01*pplev(ig,ilev),.001*pzlev(ig,ilev),
+     s      zb0(ig,ilev)
+         ENDDO
+      ENDIF
+
+c     Potential Condensation temperature:
+c     -----------------------------------
+
+c     if (callcond) then 
+c       DO ilev=1,nlay
+c         DO ig=1,ngrid
+c           zhcond(ig,ilev) =
+c    &  (1./(bcond-acond*log(.0095*pplay(ig,ilev))))/ppopsk(ig,ilev)
+c         END DO
+c       END DO
+c     else
+c       DO ilev=1,nlay
+c         DO ig=1,ngrid
+c           zhcond(ig,ilev) = 0.  
+c         END DO
+c       END DO
+c     end if
+
+
+c-----------------------------------------------------------------------
+c   2. ajout des tendances physiques
+c      -----------------------------
+
+      DO ilev=1,nlay
+         DO ig=1,ngrid
+            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
+            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=max(zh(ig,ilev),zhcond(ig,ilev))
+         ENDDO
+      ENDDO
+      if(tracer) then
+        DO iq =1, nq
+         DO ilev=1,nlay
+           DO ig=1,ngrid
+              zq(ig,ilev,iq)=pq(ig,ilev,iq)+pdqfi(ig,ilev,iq)*ptimestep
+           ENDDO
+         ENDDO
+        ENDDO
+      end if
+
+c-----------------------------------------------------------------------
+c   3. schema de turbulence
+c      --------------------
+
+c    ** source d'energie cinetique turbulente a la surface
+c       (condition aux limites du schema de diffusion turbulente
+c       dans la couche limite
+c       ---------------------
+
+      CALL vdif_cd( ngrid,nlay,pz0,g,pzlay,pu,pv,ptsrf,ph
+     &             ,zcdv_true,zcdh_true)
+      DO ig=1,ngrid
+        zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
+        zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+        zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+      ENDDO
+
+
+
+
+c    ** schema de diffusion turbulente dans la couche limite
+c       ---------------------------------------------------- 
+
+        CALL vdif_kc(ptimestep,g,pzlev,pzlay
+     &              ,pu,pv,ph,zcdv_true
+     &              ,pq2,zkv,zkh)
+
+
+
+c    ** diagnostique pour le schema de turbulence
+c       -----------------------------------------
+
+      IF(lecrit) THEN
+         PRINT*
+         PRINT*,'Diagnostic for the vertical turbulent mixing'
+         PRINT*,'Cd for momentum and potential temperature'
+
+         PRINT*,zcdv(ngrid/2+1),zcdh(ngrid/2+1)
+         PRINT*,'Mixing coefficient for momentum and pot.temp.'
+         DO ilev=1,nlay
+            PRINT*,zkv(ngrid/2+1,ilev),zkh(ngrid/2+1,ilev)
+         ENDDO
+      ENDIF
+
+
+
+
+c-----------------------------------------------------------------------
+c   4. inversion pour l'implicite sur u
+c      --------------------------------
+
+c    ** l'equation est 
+c       u(t+1) =  u(t) + dt * {(du/dt)phys}(t)  +  dt * {(du/dt)difv}(t+1)
+c       avec
+c       /zu/ = u(t) + dt * {(du/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Ku
+ 
+      CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdv,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zu(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   5. inversion pour l'implicite sur v
+c      --------------------------------
+
+c    ** l'equation est 
+c       v(t+1) =  v(t) + dt * {(dv/dt)phys}(t)  +  dt * {(dv/dt)difv}(t+1)
+c       avec
+c       /zv/ = v(t) + dt * {(dv/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Kv
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zv(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   6. inversion pour l'implicite sur h sans oublier le couplage
+c      avec le sol (conduction)
+c      ------------------------
+
+c    ** l'equation est 
+c       h(t+1) =  h(t) + dt * {(dh/dt)phys}(t)  +  dt * {(dh/dt)difv}(t+1)
+c       avec
+c       /zh/ = h(t) + dt * {(dh/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1)
+c       donc les entrees sont /zcdh/ pour la condition de raccord au sol
+c       et /zkh/ = Kh
+c       -------------
+
+      CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdh,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+c    ** calcul de (d Planck / dT) a la temperature d'interface
+c       ------------------------------------------------------
+
+      z4st=4.*5.67e-8*ptimestep
+      DO ig=1,ngrid
+         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
+      ENDDO
+
+c    ** calcul de la temperature_d'interface et de sa tendance.
+c       on ecrit que la somme des flux est nulle a l'interface
+c       a t + \delta t,
+c       c'est a dire le flux radiatif a {t + \delta t}
+c       + le flux turbulent a {t + \delta t} 
+c            qui s'ecrit K (T1-Tsurf) avec T1 = d1 Tsurf + c1
+c            (notation K dt = /cpp*b/)        
+c       + le flux dans le sol a t
+c       + l'evolution du flux dans le sol lorsque la temperature d'interface
+c       passe de sa valeur a t a sa valeur a {t + \delta t}.
+c       ----------------------------------------------------
+
+      DO ig=1,ngrid
+         z1(ig)=pcapcal(ig)*ptsrf(ig)+cpp*zb(ig,1)*zc(ig,1)
+     s     +zdplanck(ig)*ptsrf(ig)+ pfluxsrf(ig)*ptimestep
+         z2(ig)= pcapcal(ig)+cpp*zb(ig,1)*(1.-zd(ig,1))+zdplanck(ig)
+         ztsrf2(ig)=z1(ig)/z2(ig)
+         pdtsrf(ig)=(ztsrf2(ig)-ptsrf(ig))/ptimestep
+
+c        Modif speciale CO2 condensation:
+c        tconds = 1./(bcond-acond*log(.0095*pplev(ig,1)))
+c        if ((callcond).and.
+c    &      ((co2ice(ig).ne.0).or.(ztsrf2(ig).lt.tconds)))then
+c           zh(ig,1)=zc(ig,1)+zd(ig,1)*tconds
+c        else
+            zh(ig,1)=zc(ig,1)+zd(ig,1)*ztsrf2(ig)
+c        end if
+      ENDDO
+
+c    ** et a partir de la temperature au sol on remonte 
+c       -----------------------------------------------
+
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            hh = max( zh(ig,ilay-1) , zhcond(ig,ilay-1) ) ! modif co2cond
+            zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*hh
+         ENDDO
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   TRACERS
+c   -------
+
+      if(tracer) then
+
+c     Using the wind modified by friction for lifting and  sublimation
+c     ----------------------------------------------------------------
+        DO ig=1,ngrid
+          zu2=zu(ig,1)*zu(ig,1)+zv(ig,1)*zv(ig,1)
+          zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+          zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+        ENDDO
+
+c       Calcul du flux vertical au bas de la premiere couche (dust) :
+c       -----------------------------------------------------------
+        do ig=1,ngridmx  
+          rho(ig) = zb0(ig,1) /ptimestep
+          zb(ig,1) = 0.
+        end do
+c       Dust lifting:
+        if (lifting) then 
+           call dustlift(ngrid,nlay,nq,rho,zcdh_true,zcdh,co2ice,
+     $                  pdqsdif)
+       
+           else
+           call zerophys(ngrid*nq,pdqsdif)
+        end if
+
+c       OU calcul de la valeur de q a la surface (water)  :
+c       ----------------------------------------
+        if (water) then 
+            call watersat(ngridmx,ptsrf,pplev(1,1),qsat)
+        end if
+
+c      Inversion pour l'implicite sur q 
+c       --------------------------------
+        do iq=1,nq
+          CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+
+          if ((water).and.(iq.eq.nqmx)) then 
+c            This line is required to account for turbulent transport 
+c            from surface (e.g. ice) to mid-layer of atmosphere:
+             CALL multipl(ngrid,zcdv,zb0,zb(1,1))
+             CALL multipl(ngrid,dryness,zb(1,1),zb(1,1)) 
+          end if
+
+          DO ig=1,ngrid
+               z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+               zc(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
+               zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+          ENDDO
+  
+          DO ilay=nlay-1,2,-1
+               DO ig=1,ngrid
+                z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+                zc(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+
+     $           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+                zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+               ENDDO
+          ENDDO
+          DO ig=1,ngrid
+                z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     $           zb(ig,2)*(1.-zd(ig,2)))
+                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $         zb(ig,2)*zc(ig,2) +
+     $        (-pdqsdif(ig,iq)) *ptimestep) *z1(ig)  !tracer flux from surface
+          ENDDO
+  
+          IF ((water).and.(iq.eq.nqmx)) then 
+c           Calculation for turbulent exchange with the surface (for ice)
+            DO ig=1,ngrid
+              zd(ig,1)=zb(ig,1)*z1(ig)
+              zq1temp(ig)=zc(ig,1)+ zd(ig,1)*qsat(ig)
+
+              pdqsdif(ig,nq)=rho(ig)*dryness(ig)*zcdv(ig)
+     &                       *(zq1temp(ig)-qsat(ig))
+c             write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+            END DO
+            DO ig=1,ngrid
+              if(.not.watercaptag(ig)) then
+              if ((-pdqsdif(ig,nq)*ptimestep).gt.pqsurf(ig,nq)) then
+c                 write(*,*)'on sublime plus que qsurf!'
+                  pdqsdif(ig,nq) = -pqsurf(ig,nq)/ptimestep
+c                 write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+                  z1(ig)=1./(za(ig,1)+ zb(ig,2)*(1.-zd(ig,2)))
+                  zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $            zb(ig,2)*zc(ig,2) +
+     $            (-pdqsdif(ig,iq)) *ptimestep) *z1(ig)
+                  zq1temp(ig)=zc(ig,1)
+              endif   
+              endif   
+c             Starting upward calculations for water :
+               zq(ig,1,iq)=zq1temp(ig)
+            ENDDO
+          ELSE
+c           Starting upward calculations for simple mixing of tracer (dust)
+            DO ig=1,ngrid
+               zq(ig,1,iq)=zc(ig,1)
+            ENDDO
+          END IF
+
+          DO ilay=2,nlay
+             DO ig=1,ngrid
+                zq(ig,ilay,iq)=zc(ig,ilay)+zd(ig,ilay)*zq(ig,ilay-1,iq)
+             ENDDO
+          ENDDO
+        enddo
+      end if
+
+c-----------------------------------------------------------------------
+c   8. calcul final des tendances de la diffusion verticale
+c      ----------------------------------------------------
+
+      DO ilev = 1, nlay
+         DO ig=1,ngrid
+            pdudif(ig,ilev)=(    zu(ig,ilev)-
+     $      (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep)    )/ptimestep
+            pdvdif(ig,ilev)=(    zv(ig,ilev)-
+     $      (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep)    )/ptimestep
+            hh = max(ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep ,
+     $           zhcond(ig,ilev))        ! modif co2cond
+            pdhdif(ig,ilev)=( zh(ig,ilev)- hh )/ptimestep
+         ENDDO
+      ENDDO
+
+
+      if (tracer) then 
+        DO iq = 1, nq
+          DO ilev = 1, nlay
+            DO ig=1,ngrid
+              pdqdif(ig,ilev,iq)=(zq(ig,ilev,iq)-
+     $      (pq(ig,ilev,iq) + pdqfi(ig,ilev,iq)*ptimestep))/ptimestep
+            ENDDO
+          ENDDO
+        ENDDO
+      end if
+
+c    ** diagnostique final 
+c       ------------------
+
+      IF(lecrit) THEN
+         PRINT*,'In vdif'
+         PRINT*,'Ts (t) and Ts (t+st)'
+         WRITE(*,'(a10,3a15)')
+     s   'theta(t)','theta(t+dt)','u(t)','u(t+dt)'
+         PRINT*,ptsrf(ngrid/2+1),ztsrf2(ngrid/2+1)
+         DO ilev=1,nlay
+            WRITE(*,'(4f15.7)')
+     s      ph(ngrid/2+1,ilev),zh(ngrid/2+1,ilev),
+     s      pu(ngrid/2+1,ilev),zu(ngrid/2+1,ilev)
+
+         ENDDO
+      ENDIF
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vlz_fi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vlz_fi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/vlz_fi.F	(revision 2744)
@@ -0,0 +1,195 @@
+      SUBROUTINE vlz_fi(ngrid,q,pente_max,masse,w,wq)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " dans la verticale
+c    pour appel dans la physique (sedimentation)
+c    ********************************************************************
+c    q rapport de melange (kg/kg)...
+c    masse : masse de la couche Dp/g
+c    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
+c    pente_max = 2 conseillee
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "dimphys.h"
+
+c
+c
+c   Arguments:
+c   ----------
+      integer ngrid
+      real masse(ngrid,llm),pente_max
+      REAL q(ngrid,llm)
+      REAL w(ngrid,llm)
+      REAL wq(ngrid,llm+1)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+
+      real dzq(ngridmx,llm),dzqw(ngridmx,llm),adzqw(ngridmx,llm),dzqmax
+      real newmasse
+      real sigw, Mtot, MQtot
+      integer m
+
+      REAL      SSUM,CVMGP,CVMGT
+      integer ismax,ismin
+
+
+c    On oriente tout dans le sens de la pression c'est a dire dans le
+c    sens de W
+
+      do l=2,llm
+         do ij=1,ngrid
+            dzqw(ij,l)=q(ij,l-1)-q(ij,l)
+            adzqw(ij,l)=abs(dzqw(ij,l))
+         enddo
+      enddo
+
+      do l=2,llm-1
+         do ij=1,ngrid
+#ifdef CRAY
+            dzq(ij,l)=0.5*
+     ,      cvmgp(dzqw(ij,l)+dzqw(ij,l+1),0.,dzqw(ij,l)*dzqw(ij,l+1))
+#else
+            if(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) then
+                dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1))
+            else
+                dzq(ij,l)=0.
+            endif
+#endif
+            dzqmax=pente_max*min(adzqw(ij,l),adzqw(ij,l+1))
+            dzq(ij,l)=sign(min(abs(dzq(ij,l)),dzqmax),dzq(ij,l))
+         enddo
+      enddo
+
+      do ij=1,ngrid
+         dzq(ij,1)=0.
+         dzq(ij,llm)=0.
+      enddo
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection verticale  .......
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
+c
+c      No flux at the model top:
+       do ij=1,ngrid
+          wq(ij,llm+1)=0.
+       enddo
+
+c      1) Compute wq where w > 0 (down) (ALWAYS FOR SEDIMENTATION)     
+c      ===============================
+
+       do l = 1,llm          ! loop different than when w<0
+        do  ij = 1,ngrid
+
+         if(w(ij,l).gt.0.)then
+
+c         Regular scheme (transfered mass < 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(w(ij,l).le.masse(ij,l))then
+            sigw=w(ij,l)/masse(ij,l)
+            wq(ij,l)=w(ij,l)*(q(ij,l)+0.5*(1.-sigw)*dzq(ij,l))
+            
+
+c         Extended scheme (transfered mass > 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else 
+            m=l
+            Mtot = masse(ij,m)
+            MQtot = masse(ij,m)*q(ij,m)
+            if(m.ge.llm)goto 88
+            do while(w(ij,l).gt.(Mtot+masse(ij,m+1)))
+                m=m+1
+                Mtot = Mtot + masse(ij,m)
+                MQtot = MQtot + masse(ij,m)*q(ij,m)
+                if(m.ge.llm)goto 88
+            end do
+ 88         continue
+            if (m.lt.llm) then
+                sigw=(w(ij,l)-Mtot)/masse(ij,m+1)
+                wq(ij,l)=(MQtot + (w(ij,l)-Mtot)*
+     &          (q(ij,m+1)+0.5*(1.-sigw)*dzq(ij,m+1)) )
+            else
+                w(ij,l) = Mtot
+                wq(ij,l) = Mqtot 
+            end if
+          end if
+         end if
+        enddo
+       enddo
+
+c      2) Compute wq where w < 0 (up) (NOT USEFUL FOR SEDIMENTATION)     
+c      ===============================
+       goto 99 ! SKIPPING THIS PART FOR SEDIMENTATION 
+
+c      Surface flux up:
+       do  ij = 1,ngrid
+         if(w(ij,1).lt.0.) wq(ij,1)=0. ! warning : not always valid
+       end do
+
+       do l = 1,llm-1  ! loop different than when w>0
+        do  ij = 1,ngrid
+         if(w(ij,l+1).le.0)then
+
+c         Regular scheme (transfered mass < 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(-w(ij,l+1).le.masse(ij,l))then
+            sigw=w(ij,l+1)/masse(ij,l)
+            wq(ij,l+1)=w(ij,l+1)*(q(ij,l)-0.5*(1.+sigw)*dzq(ij,l))
+c         Extended scheme (transfered mass > 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else 
+             m = l-1
+             Mtot = masse(ij,m+1)
+             MQtot = masse(ij,m+1)*q(ij,m+1)
+             if (m.le.0)goto 77
+             do while(-w(ij,l+1).gt.(Mtot+masse(ij,m)))
+                m=m-1
+                Mtot = Mtot + masse(ij,m+1)
+                MQtot = MQtot + masse(ij,m+1)*q(ij,m+1)
+                if (m.le.0)goto 77
+             end do
+ 77          continue
+
+             if (m.gt.0) then
+                sigw=(w(ij,l+1)+Mtot)/masse(ij,m)
+                wq(ij,l+1)= (MQtot + (-w(ij,l+1)-Mtot)*
+     &          (q(ij,m)-0.5*(1.+sigw)*dzq(ij,m))  )
+             else
+c               wq(ij,l+1)= (MQtot + (-w(ij,l+1)-Mtot)*qm(ij,1))
+                write(*,*) 'a rather weird situation in vlz_fi !'
+                stop
+             end if
+          endif
+         endif
+        enddo
+       enddo
+ 99    continue
+
+      do l=1,llm
+         do ij=1,ngrid
+
+cccccccc lines below not used for sedimentation (No real flux)
+ccccc       newmasse=masse(ij,l)+w(ij,l+1)-w(ij,l) 
+ccccc       q(ij,l)=(q(ij,l)*masse(ij,l)+wq(ij,l+1)-wq(ij,l))
+ccccc&         /newmasse
+ccccc       masse(ij,l)=newmasse
+
+            q(ij,l)=q(ij,l) +  (wq(ij,l+1)-wq(ij,l))/masse(ij,l)
+
+         enddo
+      enddo
+
+
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/watercap.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/watercap.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/watercap.h	(revision 2744)
@@ -0,0 +1,6 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'watercap.h'
+
+      logical watercaptag(ngridmx)
+
+      common/permcap/watercaptag
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/watercloud.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/watercloud.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/watercloud.F	(revision 2744)
@@ -0,0 +1,489 @@
+      SUBROUTINE watercloud(ngrid,nlay, ptimestep,
+     &                pplev,pplay,pdpsrf,pzlev,pzlay,pt,pdt,
+     &                pq,pdq,pdqcloud,qsurf,pdqscloud,pdtcloud,
+     &                nq,nsize,tau,icount,zls)
+      IMPLICIT NONE
+
+c=======================================================================
+c     Treatment of saturation of water vapor
+c
+c
+c     Modif de zq si saturation dans l'atmopshere
+c     si zq(ig,l)> zqsat(ig,l) ->    zq(ig,l)=zqsat(ig,l)
+c     Le test est effectue de bas en haut. L'eau condensee
+c    (si saturation) est remise dans la couche en dessous.
+c     L'eau condensee dans la couche du bas est deposee a la surface
+c
+c     WARNING : water vapor mixing ratio is assumed to be 
+c     q(nqmx)
+c
+c    Modification: Franck Montmessin water ice scheme
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+
+#include "fisice.h"
+#include "comgeomfi.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,nsize
+      INTEGER icount
+      REAL ptimestep             ! pas de temps physique (s)
+      REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+      REAL pplay(ngrid,nlay)     ! pression au milieu des couches (Pa)
+      REAL pzlev(ngrid,nlay+1)   ! altitude at layer boundaries
+      REAL pzlay(ngrid,nlay)     ! altitude at the middle of the layers
+      REAL pdpsrf(ngrid)         ! tendance surf pressure
+      REAL pt(ngrid,nlay)        ! temperature au centre des couches (K)
+      REAL pdt(ngrid,nlay)       ! tendance temperature des autres param.
+      REAL pdtcloud(ngrid,nlay)  ! tendance temperature due a la chaleur latente
+      REAL tau(ngridmx,nsize)
+      REAL zls
+
+c    Traceurs :
+      integer nq                   ! nombre de traceurs 
+      real pq(ngrid,nlay,nq)       ! traceur (kg/kg)
+      real pdq(ngrid,nlay,nq)      ! tendance avant condensation  (kg/kg.s-1)
+      real pdqcloud(ngrid,nlay,nq) ! tendance de la condesation H2O(kg/kg.s-1)
+      real qsurf(ngrid,nq)
+      real pdqscloud(ngrid,nq)     ! flux en surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      REAL CBRT
+      EXTERNAL CBRT
+      INTEGER ig,l
+
+      LOGICAL firstcall,improved
+      SAVE firstcall
+
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL zq0(ngridmx,nlayermx,nqmx)
+      REAL zqsat(ngridmx,nlayermx)
+      REAL zt(ngridmx,nlayermx)
+
+
+      REAL masse (ngridmx,nlayermx)
+      REAL epaisseur (ngridmx,nlayermx)
+      REAL dustcores(ngridmx,nlayermx)  !Dust number density (#/kg) 
+      REAL rfinal        ! Ice crystal radius after condensation(m)
+      REAL seq           ! Equilibrium saturation ration (accounting for curvature effect)
+      REAL dzq           ! masse de glace echangee (kg/kg)
+      REAL lw       !Latent heat of sublimation (J.kg-1) 
+      REAL To
+
+      REAL Ctot
+      REAL*8 ph2o,satu
+      REAL gr,Cste,up,dwn,newvap
+
+      DATA firstcall/.true./
+cc      DATA improved/.false./      ! Actionne une microphysique plus raffinee
+      DATA improved/.true./
+
+c     Reference temperature, T=273,15 K
+      data To/273.15/
+
+      SAVE improved
+
+c     POur diagnostique :
+c     ~~~~~~~~~~~~~~~~~
+      REAL taucond(ngridmx,nlayermx)   ! taux de condensation (kg/kg/s-1)
+ccc****WRF
+c      REAL mtot(ngridmx)               ! Total mass of water vapor (kg/m2)
+c      REAL icetot(ngridmx)             ! Total mass of water ice (kg/m2)
+c      REAL rave(ngridmx)               ! Mean crystal radius in a column (m)
+ccc****WRF
+      REAL cloudmass(ngridmx,nlayermx) ! Integrated mass of water ice in each layer (kg/m2)
+      REAL waterhem(2,3)
+
+      REAL icetot2pm(ngridmx)
+      REAL mtot2pm(ngridmx)
+      REAL rave2pm(ngridmx)
+      REAL qsurf2pm(ngridmx)
+      INTEGER i,nit
+      REAL ecart,loctime
+      integer univtime,lon2pm(ngridmx)
+
+      integer ig_vl2
+      real latvl2,lonvl2
+
+      logical tesfield  ! output of TES like data
+      data tesfield /.false./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans watercloud'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+         firstcall=.false.
+         if (tesfield) then
+           latvl2= 47.57
+           lonvl2= 134.26
+           ig_vl2= 1+ int( (1.5-(latvl2-90.)*jjm/180.)  -2 )*iim +
+     &              int(1.5+(lonvl2+180)*iim/360.)
+           open(201,file='VL2_data')
+           open(199,file='water_budgets')
+           print*,'File water_budgets created'
+c          Find the universal time corresponding to 2PM (TES obs)
+           print*,'Universal time corresponding to 2PM (TES obs)'
+           print*,'of each longitude - Used when iceparty is on.'
+           print*,'2PM outputs are written in a specific file.'
+           print*,'|   Longitude   |   U.T = 2PM LT   |'
+           nit= 48
+           do ig=1,ngridmx
+             ecart=24.
+             do i=1,nit-1
+               loctime = i/float(nit)*24. + long(ig)*12./pi
+               if (loctime.gt.24.) loctime = loctime - 24.
+               if (loctime.lt.0)   loctime = loctime + 24.
+               if (abs(14.-loctime).lt.ecart) then
+                 ecart      = abs(14.-loctime)
+                 lon2pm(ig) = i
+               endif
+             enddo
+             if(int(lati(ig)*180./pi).eq.0) 
+     *             print*,long(ig)/pi*180.,'|',lon2pm(ig)/2.
+           enddo
+           open(200,file='2pm_outputs',form='unformatted')
+           print*,'File 2pm_outputs created'
+           write(200) long,lati
+         endif ! (tesfield)
+      ENDIF
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c    On "update" la valeur de q(nqmx) (water vapor) et temperature.
+c    On effectue qqes calculs preliminaires sur les couches : 
+c    masse (kg.m-2), epaisseur(m).
+
+      do l=1,nlay
+          do ig=1,ngrid
+            zq(ig,l,nq)=pq(ig,l,nq)+pdq(ig,l,nq)*ptimestep
+            zq(ig,l,nq)=max(zq(ig,l,nq),1.E-30) ! FF 12/2004 
+            zq0(ig,l,nq)=zq(ig,l,nq)
+            zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
+            masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
+            epaisseur(ig,l)= pzlev(ig,l+1) - pzlev(ig,l)
+            if(iceparty) then
+              zq(ig,l,nq-1)=pq(ig,l,nq-1)+pdq(ig,l,nq-1)*ptimestep
+              zq(ig,l,nq-1)=max(zq(ig,l,nq-1),0.) ! FF 12/2004 
+              zq0(ig,l,nq-1)=zq(ig,l,nq-1)
+              rdust(ig,l)= max(.8e-6*exp(-pzlay(ig,l)/18000.),1.e-9)
+c         Calcul du rayon moyen des particules de glace.
+c         Hypothese : Dans une couche, la glace presente se
+c         repartit uniformement autour du nbre de poussieres
+c         dont le rayon moyen est prescrit par rdust.
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+              if ((dustbin.eq.1).and..not.(doubleq)) then
+                zq(ig,l,1)=pq(ig,l,1)+pdq(ig,l,1)*ptimestep
+                dustcores(ig,l)=max(zq(ig,l,1)/
+     &           (rho_dust*4./3.*pi*radius(1)**3.),1.e-9)
+              else
+                dustcores(ig,l)=( epaisseur(ig,l)/masse(ig,l) ) *
+     &       2.e+6/0.1*max(tau(ig,1),0.001)*exp(-pzlay(ig,l)/10000.)
+
+!!!PATCH WATER
+c            TEMPORAIRE : réduction du nombre de nuclei FF 04/2008 :
+                dustcores(ig,l) = dustcores(ig,l) / 8.
+                ! reduction facteur 2
+
+              endif
+              rice(ig,l)=CBRT( ( zq(ig,l,nq-1)/rho_ice+
+     &         dustcores(ig,l)*(4./3.)*pi*rdust(ig,l)**3. )
+     &         / (dustcores(ig,l)*4./3.*pi) )
+              rice(ig,l)=max(rice(ig,l),rdust(ig,l))
+            endif
+          enddo
+      enddo
+
+      call zerophys(ngrid*nq,pdqscloud)
+      call zerophys(ngrid*nlay*nq,pdqcloud)
+      call zerophys(ngrid*nlay,pdtcloud)
+      call zerophys(ngrid,mtot)
+
+      call zerophys(ngrid,icetot)
+      call zerophys(ngrid,rave)
+      call zerophys(ngrid,cloudmass)
+
+c    ----------------------------------------------
+c
+c
+c       Rapport de melange a saturation dans la couche l : -------
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+        call watersat(ngridmx*nlayermx,zt,pplay,zqsat)
+
+c       taux de condensation (kg/kg/s-1) dans les differentes couches
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c       (Pour diagnostic seulement !)
+        if(.not.iceparty)then
+        do l=1, nlay
+          do ig=1,ngridmx
+            taucond(ig,l)= max((zq(ig,l,nq)-zqsat(ig,l))/ptimestep,0.)
+          end do
+        end do
+        endif
+
+
+        if(iceparty) then
+          do l=1,nlay
+            do ig=1,ngrid
+
+            If (improved) then
+c           Improved microphysics scheme
+c           ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+             Ctot = zq(ig,l,nq) + zq(ig,l,nq-1)
+             ph2o = zq(ig,l,nq) * 44. / 18. * pplay(ig,l)
+             satu = zq(ig,l,nq) / zqsat(ig,l)
+
+             call growthrate(ptimestep,zt(ig,l),pplay(ig,l),
+     &        ph2o,ph2o/satu,seq,rice(ig,l),gr)
+             Cste = ptimestep * 4. * pi * rice(ig,l)
+     *              * rho_ice * dustcores(ig,l)
+             up   = zq(ig,l,nq) + Cste * gr * seq
+             dwn  =    1.       + Cste * gr / zqsat(ig,l)
+             newvap = min(up/dwn,Ctot)
+
+             gr  = gr * ( newvap/zqsat(ig,l) - seq )
+             dzq = min( max( Cste * gr,-zq(ig,l,nq-1) ) 
+     *             , zq(ig,l,nq) )
+
+c            Nucleation (sat ratio must be larger than a critical value)
+c            ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+             if (satu.gt.1.) then
+               if (satu.le.1.4.and.zq(ig,l,nq-1).lt.1.e-8) 
+     *            dzq = 0.
+             endif
+
+            Else
+c           Old version
+c           ~~~~~~~~~~~
+             if (zq(ig,l,nq).ge.zqsat(ig,l))then  !  Condensation
+               dzq=zq(ig,l,nq)-zqsat(ig,l)                
+             elseif(zq(ig,l,nq).lt.zqsat(ig,l))then  ! Sublimation
+               dzq=-min(zqsat(ig,l)-zq(ig,l,nq),zq(ig,l,nq-1))
+             endif
+
+            Endif
+
+c           Water Mass change
+c           ~~~~~~~~~~~~~~~~~
+            zq(ig,l,nq-1)=zq(ig,l,nq-1)+dzq
+            zq(ig,l,nq)=zq(ig,l,nq)-dzq
+
+            rice(ig,l)=max( CBRT ( (zq(ig,l,nq-1)/rho_ice
+     &       +dustcores(ig,l)*(4./3.)*pi*rdust(ig,l)**3.)
+     &       /(dustcores(ig,l)*4./3.*pi) ), rdust(ig,l)) 
+
+            if(activice.and.pclc(ig).gt.0)
+     &        rice(ig,l)=rice(ig,l)/CBRT(pclc(ig))
+              
+            enddo
+          enddo
+
+        else   ! if not iceparty
+
+c         Saturation couche nlay a 2 :
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~
+          do l=nlay,2, -1
+             do ig=1,ngrid
+             if (zq(ig,l,nq).gt.zqsat(ig,l))then 
+               zq(ig,l-1,nq) =  zq(ig,l-1,nq)+(zq(ig,l,nq)-zqsat(ig,l))
+     &          *(pplev(ig,l)-pplev(ig,l+1))/(pplev(ig,l-1)-pplev(ig,l))
+               zq(ig,l,nq)=zqsat(ig,l)
+             endif
+             enddo
+          enddo
+
+c       Saturation couche l=1 si pas iceparty 
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          do ig=1,ngridmx
+              if (zq(ig,1,nq).gt.zqsat(ig,1))then
+                 pdqscloud(ig,nq)= (zq(ig,1,nq)-zqsat(ig,1))
+     &         *(pplev(ig,1)-pplev(ig,2))/(g*ptimestep)
+                 zq(ig,1,nq)=zqsat(ig,1)
+              endif
+          end do
+
+        endif   ! (iceparty)
+
+c       Tendance finale
+c       ~~~~~~~~~~~~~~~
+        do l=1, nlay
+          do ig=1,ngridmx
+            pdqcloud(ig,l,nq) = (zq(ig,l,nq) - zq0(ig,l,nq))/ptimestep
+            if(iceparty) then
+              pdqcloud(ig,l,nq-1) =
+     &        (zq(ig,l,nq-1) - zq0(ig,l,nq-1))/ptimestep
+            endif
+            lw=(2834.3-0.28*(zt(ig,l)-To)-0.004*(zt(ig,l)-To)**2)*1.e+3
+            pdtcloud(ig,l)=-pdqcloud(ig,l,nq)*lw/cpp
+          end do 
+        end do
+
+c       A correction if a lot of subliming CO2 fills the 1st layer FF04/2005
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c       Then that should not affect the ice particle radius
+        do ig=1,ngridmx
+          if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,2)))then
+            if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,3)))
+     &      rice(ig,2)=rice(ig,3) 
+            rice(ig,1)=rice(ig,2)
+          end if
+        end do
+        
+c**************************************************
+c       Output  
+c**************************************************
+        univtime = icount - int(float(icount)/48.) * 48
+
+c       if "tesfield"
+c       ~~~~~~~~~~~~~
+        if (tesfield.and.mod(icount,12).eq.0) 
+     .          call zerophys(6,waterhem)
+c****WRF: ligne trop longue        
+         do ig=1,ngridmx
+          do l=1 ,nlay
+c           masse de vapeur d'eau dans la couche l
+            mtot(ig)=mtot(ig)+pq(ig,l,nq)*masse(ig,l)
+            if(iceparty) then
+c           masse de glace d'eau dans la couche l
+              icetot(ig)=icetot(ig)+masse(ig,l)*pq(ig,l,nq-1)
+c           rayon moyen des cristaux dans la colonne ig
+              rave(ig)=rave(ig)+masse(ig,l)*pq(ig,l,nq-1)*rice(ig,l)
+              cloudmass(ig,l)=masse(ig,l)*pq(ig,l,nq-1)
+            endif
+          enddo
+          if(iceparty) then
+            rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+            if (icetot(ig)*1000.lt.0.01) rave(ig)=0.
+          endif
+          if (tesfield) then
+            if (univtime.eq.lon2pm(ig)) mtot2pm(ig)   = mtot(ig)
+            if (univtime.eq.lon2pm(ig).and.iceparty) 
+     *        icetot2pm(ig) = icetot(ig)
+            if (univtime.eq.lon2pm(ig).and.iceparty) 
+     *        rave2pm(ig)   = rave(ig)
+            if (univtime.eq.lon2pm(ig)) qsurf2pm(ig)  = qsurf(ig,nqmx)
+        endif
+
+c       Outputs total mass of water and clouds    *
+c       ******************************************
+          IF (tesfield.and.mod(icount,12).EQ.0) THEN
+           if (int(lati(ig)*180/pi).gt.0) then
+             waterhem(1,1)=waterhem(1,1)+area(ig)*mtot(ig)
+             waterhem(1,2)=waterhem(1,2)+area(ig)*qsurf(ig,nqmx)
+            if (iceparty)waterhem(1,3)=waterhem(1,3)+area(ig)*icetot(ig)
+           endif
+           if (int(lati(ig)*180/pi).lt.0) then
+             waterhem(2,1)=waterhem(2,1)+area(ig)*mtot(ig)
+             waterhem(2,2)=waterhem(2,2)+area(ig)*qsurf(ig,nqmx)
+            if (iceparty)waterhem(2,3)=waterhem(2,3)+area(ig)*icetot(ig)
+           endif
+           if (int(lati(ig)*180/pi).eq.0) then
+             waterhem(1,1)=waterhem(1,1)+area(ig)*mtot(ig)/2.
+             waterhem(2,1)=waterhem(2,1)+area(ig)*mtot(ig)/2.
+             waterhem(1,2)=waterhem(1,2)+area(ig)*qsurf(ig,nqmx)/2.
+             waterhem(2,2)=waterhem(2,2)+area(ig)*qsurf(ig,nqmx)/2.
+             if (iceparty) then
+               waterhem(1,3)=waterhem(1,3)+area(ig)*icetot(ig)/2.
+               waterhem(2,3)=waterhem(2,3)+area(ig)*icetot(ig)/2.
+             endif
+           endif
+          ENDIF ! (total mass)
+        enddo   ! (ngridmx)
+
+        if (tesfield.and.mod(icount,12).eq.0) then
+          write(199,6000)zls*180./pi,waterhem(1,1),waterhem(1,2),
+     &    waterhem(1,3),waterhem(2,1),waterhem(2,2),waterhem(2,3)
+!6000      format(f8.3,x,6(e12.5,x))
+!!!!!!!!!!!!!!!!g95
+6000      format(f8.3,1x,6(e12.5,1x))
+          write(201,6001) zls*180./pi,pplev(ig_vl2,1),icetot(ig_vl2)
+     &    ,zt(ig_vl2,1)
+!6001      format(f8.3,x,3(e12.5,x))
+!!!!!!!!!!!!!!!!g95
+6001      format(f8.3,1x,3(e12.5,1x))
+        endif
+
+***************************************************
+*       Write outputs at 2PM LT in a dedicated file
+***************************************************
+        if (tesfield) then
+          if (mod(icount,48).eq.0.and.icount.ne.1.and.iceparty) then
+            print*,'ecriture dans 2pm_outputs'
+            write(200) zls
+            write(200) mtot2pm
+            if (iceparty) write(200) icetot2pm
+            write(200) qsurf2pm
+            if (iceparty) write(200) rave2pm
+          endif
+        endif
+
+c ******************************************    
+c      Output in diagfi
+c ******************************************    
+
+      if (ngrid.gt.1) then
+
+c          CALL WRITEDIAGFI(ngridmx,'mtot',
+c     &  'total mass of water vapor','kg/m2',2,mtot)
+c
+c         if (callstats) then
+c            call wstats(ngrid,"mtot",
+c     .   "total mass of water vapor","kg/m2",2,mtot)
+c         endif
+c
+cc        if(.not.iceparty)
+cc     &  call WRITEDIAGFI(ngridmx,'taucond',
+cc     &  'taux cond H2O ice','kg/kg/s',3,taucond)
+cc
+c         if(iceparty) then
+c            CALL WRITEDIAGFI(ngridmx,'icetot',
+c     &    'total mass of water ice','kg/m2',2,icetot)
+c           if (callstats) then
+c              call wstats(ngrid,"icetot",
+c     .        "total mass of water ice","kg/m2",2,icetot)
+c           endif
+cc          CALL WRITEDIAGFI(ngridmx,'cloudmass',
+cc     &    'mass of water ice/layer','kg/m2',3,cloudmass)
+cc          CALL WRITEDIAGFI(ngridmx,'rice','ice radius',
+cc     &    'meter',3,rice)
+cc          CALL WRITEDIAGFI(ngridmx,'rave','Mean ice radius',
+cc     &    'meter',2,rave)
+c         endif
+
+      else
+
+c          CALL WRITEG1D(ngridmx,1,mtot,'gas','kg/m2')
+c          CALL WRITEG1D(ngridmx,1,icetot,'ice','kg/m2')
+c          call WRITEG1D(ngridmx,nlay,rice,'rice','um')
+c          call WRITEG1D(ngridmx,nlay,dustcores,'pouss','#/layer')
+
+      endif
+ 99   continue
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/watersat.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/watersat.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/watersat.F	(revision 2744)
@@ -0,0 +1,47 @@
+      SUBROUTINE watersat(nsize,t,p,qsat)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Water mass mixing ratio at saturation (kg/kg) for a given pressure (Pa)
+c   and Temperature (K) array
+c
+c=======================================================================
+
+c   declarations:
+c   -------------
+c   arguments:
+c   ----------
+
+c   INPUT
+      integer nsize 
+      real t(nsize) , p(nsize)
+c   OUTPUT
+      real qsat(nsize)
+
+c   local:
+c   ------
+      INTEGER i
+      REAL r2,r3,r4 , To, es
+      SAVE r2,r3,r4
+      DATA r2,r3,r4/611.14,21.875,7.66/
+      SAVE To
+      DATA To/273.16/
+          
+      do i=1,nsize
+c        pression de vapeur saturante :
+c         es =r2*exp(r3*(t(i)-To)/(t(i)-r4))
+c         qsat(i)=es/p(i)*0.41  !rapport de melange
+        es=2.07023-0.00320991*t(i)-2484.896/t(i)+3.56654*alog10(t(i))
+        es=10.**es 
+        qsat(i)=(es*100.)/p(i)*0.41 
+
+c        qss = specific humidity
+c        qss=622*10**(2.07023-0.0032991*Tsurf(ig)-2484.896/Tsurf(ig)
+c    $                  +3.56654*log10(Tsurf(ig)))
+
+      enddo
+
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/wrf_output_2d.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/wrf_output_2d.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/wrf_output_2d.h	(revision 2744)
@@ -0,0 +1,9 @@
+!-------------------
+! INCLUDE wrf_output_2d.h
+!-------------------
+      INTEGER, PARAMETER :: ind_TSURF = 1
+      INTEGER, PARAMETER :: ind_SWDOWN = 2
+      INTEGER, PARAMETER :: ind_LWDOWN = 3
+      INTEGER, PARAMETER :: ind_UST = 4
+      INTEGER, PARAMETER :: ind_HFX = 5
+      INTEGER, PARAMETER :: n2d = 5
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/wrf_output_3d.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/wrf_output_3d.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/wrf_output_3d.h	(revision 2744)
@@ -0,0 +1,4 @@
+!-------------------
+! INCLUDE wrf_output_3d.h
+!-------------------
+           INTEGER, PARAMETER :: n3d = 1
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/writeg1d.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/writeg1d.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/writeg1d.F	(revision 2744)
@@ -0,0 +1,204 @@
+      SUBROUTINE writeg1d(ngrid,nx,x,nom,titre)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture de x pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nx         ---> taille du vecteur a stocker
+c                             "1" pour une variable de surface
+c                             "nlayer" pour une variable de centre de couche
+c                             "nlayer+1" pour une variable d'interface
+c         * x          ---> variable a stocker
+c         * nom        ---> nom "pour grads"
+c         * titre      ---> titre "pour grads"
+c
+c.......................................................................
+c
+#include "comg1d.h"
+
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nx,i
+      REAL*4 xr4(1000)
+      REAL x(nx)
+      CHARACTER*(*) nom,titre
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ilayer,ivar
+      LOGICAL test 
+c
+c  declaration des variables locales
+c.......................................................................
+c  controle 1D
+c
+c     print*,'ngrid=',ngrid
+      IF (ngrid.NE.1) return
+c
+c  controle 1D
+c.......................................................................
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+
+      do i=1,nx
+        xr4(i) = x(i)
+      enddo
+
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+c.......................................................................
+c  ouverture du fichier au premier appel
+c
+      IF (g1d_premier) THEN
+        OPEN (g1d_unitfich,FILE=g1d_nomfich
+     &       ,FORM='unformatted',ACCESS='direct',RECL=4)
+        g1d_irec=0
+        g1d_nvar=0
+        g1d_premier=.false.
+      ENDIF
+c
+c  ouverture du fichier au premier appel
+c.......................................................................
+c  pour l'ecriture du fichier ctl
+c
+      test=.true.
+      DO ivar=1,g1d_nvar
+        IF (nom.EQ.g1d_nomvar(ivar)) test=.false.
+        IF (nx .GT. 1000) then
+          print*,'ERROR:  nx > 1000 dans writeg1d.F' 
+          print*,'Changer la dimension de xr4'
+          call exit(1)
+        ENDIF
+      ENDDO
+      IF (test) THEN
+        g1d_nvar=g1d_nvar+1
+        g1d_nomvar(g1d_nvar)=nom
+        g1d_titrevar(g1d_nvar)=titre
+        IF (nx.EQ.1) THEN
+           g1d_dimvar(g1d_nvar)=0
+        ELSEIF (nx.EQ.g1d_nlayer) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer
+        ELSEIF (nx.EQ.g1d_nlayer+1) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer+1
+        ELSE
+           PRINT *,'._. probleme de dimension dans GRADS-1D ._.'
+           print*,'NX = ',nx
+           print*,'g1d_nlayer = ',g1d_nlayer
+        ENDIF
+      ENDIF
+c
+c  pour l'ecriture du fichier ctl
+c.......................................................................
+c  ecriture
+c
+      IF (nx.EQ.1) THEN
+        g1d_irec=g1d_irec+1
+        WRITE(g1d_unitfich,REC=g1d_irec) xr4(1)
+      ELSE
+        DO ilayer=1,g1d_nlayer
+          g1d_irec=g1d_irec+1
+          WRITE(g1d_unitfich,REC=g1d_irec) xr4(ilayer)
+        ENDDO
+      ENDIF
+c
+c  ecriture
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
+
+
+
+
+
+c *********************************************************************
+c *********************************************************************
+
+      SUBROUTINE endg1d(ngrid,nlayer,zlayer,ndt)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture du fichier de controle pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nlayer     ---> nombre de couches
+c         * zlayer     ---> altitude au centre de chaque couche (km)
+c         * ndt        ---> nombre de pas de temps
+c
+c.......................................................................
+c
+#include "comg1d.h"
+#include "comcstfi.h"
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nlayer
+      REAL zlayer(nlayer)
+      INTEGER ndt
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ivar,ilayer
+c
+c  declaration des variables locales
+c.......................................................................
+c  contole 1D
+c
+      IF (ngrid.NE.1) GOTO 10001
+c
+c  contole 1D
+c.......................................................................
+c
+      IF (nlayer.ne.g1d_nlayer) 
+     &PRINT *,'._. probleme de dimension dans GRADS-1D (endg1d.F) '
+c
+c.......................................................................
+c
+      CLOSE (g1d_unitfich)
+c
+c.......................................................................
+c
+      OPEN (g1d_unitctl,FILE=g1d_nomctl,FORM='formatted',RECL=4*100)
+      WRITE (g1d_unitctl,'(a4,2x,a1,a20)') 'DSET','^',g1d_nomfich
+      WRITE (g1d_unitctl,'(a5,2x,a20)') 'UNDEF ','1.E+30'
+      WRITE (g1d_unitctl,'(a11)') 'FORMAT YREV'
+      WRITE (g1d_unitctl,'(a5,2x,a30)') 'TITLE ','champs 1D'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'XDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'YDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'ZDEF ',g1d_nlayer,' LEVELS'
+      WRITE (g1d_unitctl,'(5(1x,f13.5))')
+     &      (zlayer(ilayer),ilayer=1,g1d_nlayer)
+
+c     Writing true timestep in g1d.ctl (in planet "minutes"= sol/(60*24)
+      ivar =min( max(int(1440.*dtphys/daysec +0.5),1) , 99)   
+      WRITE (g1d_unitctl,'(a4,2x,i10,a19,i2,a2)')
+     &      'TDEF ',ndt,' LINEAR 01JAN2000 ', ivar,'MN '
+
+      WRITE (g1d_unitctl,'(a5,i5)') 'VARS ',g1d_nvar
+      DO ivar=1,g1d_nvar
+      WRITE (g1d_unitctl,'(a9,3x,i4,i3,1x,a39)') 
+     &       g1d_nomvar(ivar),g1d_dimvar(ivar),99,g1d_titrevar(ivar)
+      ENDDO
+      WRITE (g1d_unitctl,'(a7)') 'ENDVARS'
+      CLOSE (g1d_unitctl)
+c
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/wstats.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/wstats.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/wstats.F90	(revision 2744)
@@ -0,0 +1,279 @@
+subroutine wstats(ngrid,nom,titre,unite,dim,px)
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "statto.h"
+include "netcdf.inc"
+
+integer,intent(in) :: ngrid
+character (len=*) :: nom,titre,unite
+integer,intent(in) :: dim
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+real, dimension(ngrid,llm) :: px
+real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
+real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
+character (len=50) :: namebis
+character (len=50), save :: firstvar
+integer :: ierr,varid,nbdim,nid
+integer :: meanid,sdid
+integer, dimension(4)  :: id,start,size
+logical, save :: firstcall=.TRUE.
+integer :: l,i,j,ig0
+integer,save :: index
+
+integer, save :: step=0
+
+
+if (firstcall) then
+   firstcall=.false.
+   firstvar=trim((nom))
+   call inistats(ierr)
+endif
+
+if (firstvar==nom) then ! If we're back to the first variable
+      step = step + 1
+endif
+
+if (mod(step,istats).ne.0) then
+   RETURN
+endif
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+namebis=trim(nom)
+ierr= NF_INQ_VARID(nid,namebis,meanid)
+
+if (ierr.ne.NF_NOERR) then
+
+   if (firstvar==nom) then 
+      index=1
+      count=0
+   endif
+
+
+!declaration de la variable
+
+! choix du nom des coordonnees
+   ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+   ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+   if (dim.eq.3) then
+      ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+      ierr= NF_INQ_DIMID(nid,"Time",id(4))
+      nbdim=4
+   else if (dim==2) then
+      ierr= NF_INQ_DIMID(nid,"Time",id(3))
+      nbdim=3
+   endif
+
+   write (*,*) "====================="
+   write (*,*) "STATS: creation de ",nom
+   namebis=trim(nom)
+   call def_var(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
+   call inivar(nid,meanid,ngrid,dim,index,px,ierr)
+   namebis=trim(nom)//"_sd"
+   call def_var(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
+   call inivar(nid,sdid,ngrid,dim,index,px,ierr)
+
+   ierr= NF_CLOSE(nid)
+   return
+
+else
+   namebis=trim(nom)//"_sd"
+   ierr= NF_INQ_VARID(nid,namebis,sdid)
+
+endif
+
+if (firstvar==nom) then 
+   count(index)=count(int(index))+1
+   index=index+1
+   if (index>istime) then
+      index=1
+   endif
+endif
+
+if (count(index)==0) then
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+      mean3d=0
+      sd3d=0
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+      mean2d=0
+      sd2d=0
+   endif
+else
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+   endif
+endif
+
+if (dim.eq.3) then
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+   mean3d= mean3d+dx3
+   sd3d= sd3d+dx3**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+
+else if (dim.eq.2) then
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+   mean2d= mean2d+dx2
+   sd2d= sd2d+dx2**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+
+endif
+
+ierr= NF_CLOSE(nid)
+
+end
+
+!======================================================
+subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "netcdf.inc"
+
+integer, intent(in) :: nid,varid,dim,index,ngrid
+real, dimension(ngrid,llm), intent(in) :: px
+integer, intent(out) :: ierr
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+
+integer :: l,i,j,ig0
+integer, dimension(4) :: start,size
+real, dimension(iip1,jjp1,llm) :: dx3
+real, dimension(iip1,jjp1) :: dx2
+
+if (dim.eq.3) then
+
+   start=(/1,1,1,index/)
+   size=(/iip1,jjp1,llm,1/)
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx3)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx3)
+#endif
+
+else if (dim.eq.2) then
+
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx2)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx2)
+#endif
+
+endif
+
+end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/yoegwd.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/yoegwd.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/yoegwd.h	(revision 2744)
@@ -0,0 +1,16 @@
+C     -----------------------------------------------------------------
+C*    *COMMON* *YOEGWD* - PARAMETERS FOR GRAVITY WAVE DRAG CALCULATIONS
+C     -----------------------------------------------------------------
+C
+      real GFRCRIT,GRCRIT,GVCRIT,GKDRAG,GKDRAGL,GHMAX
+     *             , GRAHILO,GSIGCR,GSSEC, GTSEC,  GVSEC
+     *             ,GKWAKE
+
+      integer NKTOPG
+
+      COMMON/YOEGWD/ GFRCRIT,GRCRIT,GVCRIT,GKDRAG,GKDRAGL,GHMAX
+     *             , GRAHILO,GSIGCR,NKTOPG,GSSEC, GTSEC,  GVSEC
+     *             ,GKWAKE
+C
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/yomaer.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/yomaer.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/yomaer.h	(revision 2744)
@@ -0,0 +1,29 @@
+C*    Radiative characteristics of the aerosols
+C
+C   Shortwave
+c   ~~~~~~~~~
+c
+c tauvis: dust optical depth at reference wavelength  ("longrefvis" set
+c in dimradmars.h : typically longrefvis = 0.67E-6 m, as measured by Viking )
+
+c For the "naerkind" kind of aerosol radiative properties : 
+C QVISsQREF  :  Qext / Qext("longrefvis")   <--- For both solar bands
+C omegavis   :  sinle scattering albedo     <--- For both solar bands
+C gvis       :  assymetry factor            <--- For both solar bands
+c
+C   Longwave
+c   ~~~~~~~~
+c
+c For the "naerkind" kind of aerosol radiative properties : 
+c QIRsQREF :  Qext / Qext("longrefvis")     <--- For the nir bandes IR
+c omegaIR  :  mean single scattering albedo <--- For the nir bandes IR
+c gIR      :  mean assymetry factor         <--- For the nir bandes IR
+c
+      real tauvis
+      real QVISsQREF(nsun,naerkind)
+      real omegavis(nsun,naerkind),gvis(nsun,naerkind)
+      real QIRsQREF(nir,naerkind)
+      real omegaIR(nir,naerkind),gIR(nir,naerkind)
+
+      COMMON/YOMAER/tauvis,QVISsQREF,omegavis,gvis,
+     &              QIRsQREF,omegaIR,gIR
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/yomlw.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/yomlw.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/yomlw.h	(revision 2744)
@@ -0,0 +1,21 @@
+C*    Coefficients for the longwave radiation subroutines
+c-----------------------------------------------------------------------
+
+      COMMON/yomlw/at(2,2),bt(2,2)
+     S ,tref,xp(6,nir),tstand
+     S ,ga(npademx,nabsmx),gb(npademx,nabsmx)
+     S ,cst_voigt(2,nabsmx), gcp , nlaylte
+
+      REAL at,bt, tref,xp,tstand,ga,gb, cst_voigt
+      REAL gcp    ! = g/cpp
+
+c     Number of layers on which LTE calculations (in lw and sw) are performed 
+c     (Computed in nlthermeq) :
+      INTEGER nlaylte       
+
+
+      COMMON/ksicom/
+     S xi(ngridmx,nuco2,0:nflev+1,0:nflev+1)
+     S ,xi_ground(ngridmx,nuco2),xi_emis(ngridmx,nuco2,nflev-1)
+
+      real xi, xi_ground, xi_emis
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/zerophys.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/zerophys.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/zerophys.F	(revision 2744)
@@ -0,0 +1,11 @@
+      SUBROUTINE zerophys(n,x)
+      IMPLICIT NONE
+      INTEGER n
+      REAL x(n)
+      INTEGER i
+
+      DO i=1,n
+         x(i)=0.
+      ENDDO
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/LISEZMOI
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/LISEZMOI	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/LISEZMOI	(revision 2744)
@@ -0,0 +1,136 @@
+
+Version abbrégé spécial Mars
+
+ ..  Version  du 28/12/1998  , avec  nouveau fxyhyper appele par inigeom ...
+ **************************************************************************
+
+ 1) Le gcm LMDZ.3.2  a des coordonnees  hybrides  verticalement ,c.a.d  des
+          ********
+   coordonnees equivalentes a sigma pres de la surface et a  P plus haut .     
+
+   Les pressions  p(ij,l) aux differents interfaces des  llm  couches verti- 
+   cales sont donnees  par   :
+
+    p( ij,l ) = ap(l) + bp(l) * ps(ij)    ,    1 << l << llm + 1    . 
+
+            
+   La fonction d'Exner  est calculee aux milieux des llm couches vertic.
+
+     pk(ij,l) = cp * ( p(ij,l)/preff ) ** kappa   ,  1 << l <<  llm
+
+   Les pressions  PLS(ij,l)  definies aux milieux des couches sont egales a :
+
+     pls(ij,l) = preff * ( pk(ij,l) /cp ) ** 1./kappa
+
+   
+
+ 2) Une des variables prognostiques de LMDZ.3  est   teta  , temperature 
+     potentielle  :    
+
+                 teta (ij,l) = temperature(ij,l) * cp/ pk(ij,l)
+ 
+    
+ 3) Dans  le programme principal gcm.F , il faut definir , au debut ,les para-
+    metres  IADV ,pour choisir le shema d'advection pour l'eau et les traceurs
+                    IADV = 3    , Van-Leer
+
+ 4) Il y a 2 shemas de dissipation   ( diffusion laterale )  :
+
+ a) La dissipation star ( qui ne fait pas intervenir la geometrie de la     
+    grille et qui est utilisee quand il y a un zoom ) 
+
+    Par expl . la diffusion d'un scalaire  comme  teta est formulee ( en 
+     appelant l'operateur  DIVGRAD2 )   comme :
+
+    d( ro * teta ) = (-1)**(it-1) *cdiv * Lap * ro**1/2 * Lap_gam** (it-2 ) *
+                           ro**1/2 * Lap * teta
+ avec  :
+ Lap     = 1/aire * Filt[ dx ( coefx*dx ) + dy( coefy*dy ) ] Filt
+       
+ Lap_gam = (1./aire)** -gam { dx[ coefx**(-gam) dx] + dy[ coefy**(-gam) dy ] } 
+
+
+  Filt est l'operateur  filtre 
+  ro   est la densite dp  de chaque couche
+  it   = nombre d'iterations de l'operateur de dissipation ( ici divgrad2 )
+  gam  = coefdis /( it -2 ) , coefdis = 0. si it = 2 , sinon = 1. habituellem.
+  dx   = operateur difference finie :
+    dx(A) = A( X +1/2 , Y, z ) - A( X -1/2, Y, z ) , dans le systeme de 
+  travail  (X,Y) , avec l'increment DX = 1.
+
+  Idem pour dy .
+
+  coefx = beta(ij) / alpha(ij)  , coefy = alpha(ij)/beta(ij)
+     avec    u_covariant(ij) = alpha(ij)* u_nat(ij) 
+             v_covariant(ij) = beta(ij) * v_nat(ij) 
+
+ Cette dissipation star est choisie en mettant le parametre lstardis a .TRUE.
+  dans le fichier run.def  lu  par le gcm en entree .
+
+ b) La dissipation ' non star '  fait intervenir les operateurs elementaires
+   diverg,grad,rotat .   Elle est choisie  avec lstardis = .FALSE.
+
+N.B : Dans les 2 shemas de dissipation , le gcm est plus stable  quand on
+     n'itere pas l'operateur ' GRADIV ' ou ' GRADIV2 " .            
+     
+ 5) Les constantes thermodynamiques Cp et kappa = R/Cp   utilisees dans la
+   partie dynamique ont ete mises , ce qui est normal, aux memes valeurs
+   qu'elles ont dans la partie ' physique ' , en changeant INICONST et en 
+   les mettant dans l'entete de controle de start et startphy ,en changeant
+   etat0_lmd , par rapport  a LMDZ.2.2 
+       
+ 6) Pour finir , quelques commentaires sur les parametres qui figurent sur
+    le fichier  run.def qui commandent le gcm .
+
+
+ c) coefdis , coefficient qui intervient dans le calcul de gam  , utilise 
+   dans les routines de dissipation star , vus plus haut .
+
+ d) iphysiq correspond ici a un appel de la physique toutes les 30 minutes.
+
+ e) alphax et alphay correspondent au grossissement pour le zoom dans la
+   direction X et Y .
+   En fait , les facteurs de grossissement sont egaux a  1./ ( 1.- alphax )
+     et 1./( 1.- alphay )  .
+
+ f) fxyhypb  est egal a .TRUE. si on choisit  pour la fonction f(x,y) qui 
+   definit la grille du modele  une fonction a tangente hyperbolique , un peu
+   adaptee pour le zoom , que la fonction sinusoidale , definie par fxy_new.h 
+   dans /..../gcm/libf/grid  et lu par  makegcm  lors de la compilation du 
+   code .
+
+
+N.B: Pour l'instant , cette fonction hyperbolique n'est activee eventuellement
+****            que pour  un zoom  latitudinal . 
+   Pour un zoom longitudinal , la fonction sinusoidale precisee dans fxy_new.h
+       est  choisie automatiquement .
+
+ g) psi0 et delta sont des parametres  pour cette fonction hyberbolique .
+   Ces valeurs de 0.3 et 0.5  ont ete adaptees pour 96x72  .
+  
+
+
+
+ ****************************************************************************
+
+ 
+ AA) Choisir les options du run  , avec   le fichier  run.def   .
+
+     Il y a entre autres choses , le nombre de jours qu'on veut integrer lors 
+       d'un run .
+     Il y a le nombre de pas a faire pour 1 jour , ce qui calcule donc le dt
+       temporel ( en secondes ) pour un pas dynamique .
+     Iperiod  est conseille  d'etre a 5 pas ( mais non obligatoiremnet = 5 ) . 
+     Idissip  peut etre mis a n'importe quelle valeur . Il est maintenant
+
+     Les parametres( la plupart des cles ) pour la physique commencent avec
+      la var. logique         **  physic  **
+
+           entiere( en pas )  ** iphysiq  ** qui est calculee de telle facon a
+                              appeler la physique tous les  30 minutes .
+
+           ( en jours )       ** ecritphy ** qui indique la frequence en jours
+                                du stockage   sur  diagfi
+
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/abort_gcm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/abort_gcm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/abort_gcm.F	(revision 2744)
@@ -0,0 +1,24 @@
+      SUBROUTINE abort_gcm(modname, message, ierr)
+     
+C
+C Stops the simulation cleanly, closing files and printing various
+C comments
+C
+C  Input: modname = name of calling program
+C         message = stuff to print
+C         ierr    = severity of situation ( = 0 normal )
+
+      character*20 modname
+      integer ierr
+      character*80 message
+
+      write(*,*) 'in abort_gcm'
+      write(*,*) 'Stopping in ', modname
+      write(*,*) 'Reason = ',message
+      if (ierr .eq. 0) then
+        write(*,*) 'Everything is cool'
+      else
+        write(*,*) 'Houston, we have a problem ', ierr
+      endif
+      STOP
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/addfi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/addfi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/addfi.F	(revision 2744)
@@ -0,0 +1,166 @@
+      SUBROUTINE addfi(nq, pdt, leapf, forward,
+     S          pucov, pvcov, pteta, pq   , pps ,
+     S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c    Addition of the physical tendencies
+c    Modif special Mars (no special treatment of iq = 1, 2, FF 2003)
+c
+c    Interface :
+c    -----------
+c
+c      Input :
+c      -------
+c      pdt                    time step of integration
+c      leapf                  logical
+c      forward                logical
+c      pucov(ip1jmp1,llm)     first component of the covariant velocity
+c      pvcov(ip1ip1jm,llm)    second component of the covariant velocity
+c      pteta(ip1jmp1,llm)     potential temperature
+c      pts(ip1jmp1,llm)       surface temperature
+c      pdufi(ip1jmp1,llm)     |
+c      pdvfi(ip1jm,llm)       |   respective
+c      pdhfi(ip1jmp1)         |      tendencies
+c      pdtsfi(ip1jmp1)        |
+c
+c      Output :
+c      --------
+c      pucov
+c      pvcov
+c      ph
+c      pts
+c
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "serre.h"
+c
+c    Arguments :
+c    -----------
+c
+      INTEGER nq
+
+      REAL pdt
+c
+      REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
+      REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nq),pps(ip1jmp1)
+c
+      REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
+      REAL pdqfi(ip1jmp1,llm,nq),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
+c
+      LOGICAL leapf,forward
+c
+c
+c    Local variables :
+c    -----------------
+c
+      REAL xpn(iim),xps(iim),tpn,tps
+      INTEGER j,k,iq,ij
+      REAL qtestw, qtestt
+      PARAMETER ( qtestw = 1.0e-15 )
+      PARAMETER ( qtestt = 1.0e-30 )
+
+      REAL SSUM
+      EXTERNAL SSUM
+c
+c-----------------------------------------------------------------------
+
+      DO k = 1,llm
+         DO j = 1,ip1jmp1
+            pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
+         ENDDO
+      ENDDO
+
+      DO  k    = 1, llm
+       DO  ij   = 1, iim
+         xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
+         xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
+       ENDDO
+       tpn      = SSUM(iim,xpn,1)/ apoln
+       tps      = SSUM(iim,xps,1)/ apols
+
+       DO ij   = 1, iip1
+         pteta(   ij   ,k)  = tpn
+         pteta(ij+ip1jm,k)  = tps
+       ENDDO
+      ENDDO
+c
+
+      DO k = 1,llm
+         DO j = iip2,ip1jm
+            pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
+         ENDDO
+      ENDDO
+
+      DO k = 1,llm
+         DO j = 1,ip1jm
+            pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
+         ENDDO
+      ENDDO
+
+c
+      DO j = 1,ip1jmp1
+         pps(j) = pps(j) + pdpfi(j) * pdt
+      ENDDO
+ 
+c     DO iq = 1, 2 ! special Mars: no special treatment for water
+c        DO k = 1,llm
+c           DO j = 1,ip1jmp1
+c              pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
+c              pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
+c           ENDDO
+c        ENDDO
+c     ENDDO
+
+      DO iq = 1, nq
+         DO k = 1,llm
+            DO j = 1,ip1jmp1
+               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
+               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
+            ENDDO
+         ENDDO
+      ENDDO
+                                       
+
+       DO  ij   = 1, iim
+         xpn(ij) = aire(   ij   ) * pps(  ij     )
+         xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
+       ENDDO
+       tpn      = SSUM(iim,xpn,1)/apoln
+       tps      = SSUM(iim,xps,1)/apols
+
+       DO ij   = 1, iip1
+         pps (   ij     )  = tpn
+         pps ( ij+ip1jm )  = tps
+       ENDDO
+
+
+       DO iq = 1, nq
+         DO  k    = 1, llm
+           DO  ij   = 1, iim
+             xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
+             xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
+           ENDDO
+           tpn      = SSUM(iim,xpn,1)/apoln
+           tps      = SSUM(iim,xps,1)/apols
+
+           DO ij   = 1, iip1
+             pq (   ij   ,k,iq)  = tpn
+             pq (ij+ip1jm,k,iq)  = tps
+           ENDDO
+         ENDDO
+       ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/addit.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/addit.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/addit.F	(revision 2744)
@@ -0,0 +1,14 @@
+      SUBROUTINE addit(np,px,py,pz)
+      IMPLICIT NONE
+
+      INTEGER np
+      REAL px(np),py(np),pz(np)
+
+      INTEGER i
+
+      DO i=1,np
+	 pz(i)=px(i)+py(i)
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/adv_h2o.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/adv_h2o.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/adv_h2o.F	(revision 2744)
@@ -0,0 +1,131 @@
+      SUBROUTINE adv_h2o (nq,iq,q,w, pbaru, pbarv,dq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van / F.Forget
+c   -------
+c
+c   ********************************************************************
+c   Transport d'un traceur q par shema amont (horiz), moy arithmetique (vert)
+c   (Shema classique pour l'humidite specifique LMD)
+c   ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+
+c   Arguments:
+c   ----------
+      INTEGER nq,iq
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq), dq( ip1jmp1,llm,nq )
+      REAL w(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER   l,ij
+
+      REAL qbyv( ip1jm,llm ), qbxu( ip1jmp1,llm )
+      REAL wsur2(ip1jmp1),ww
+      REAL dqh( ip1jmp1,llm)
+
+      EXTERNAL     convflu
+
+c     ----------------------------------------------------------------
+c     --        calcul transport horiz. pour  dq                    --
+c     -                                                              -
+c     -         shema ' amont '  pour l'humidite specifique  q       -
+c     ----------------------------------------------------------------
+c
+      IF( iq.GT.2 )   THEN
+        DO   l = 1, llm
+         DO ij = 1, ip1jmp1
+          dq(ij,l,iq) = 0.
+         ENDDO
+        ENDDO
+            RETURN
+      ENDIF
+
+ 
+      IF( forward.OR.leapf )   THEN
+ 
+        DO 10 l = 1, llm
+ 
+        DO 6  ij     = iip2, ip1jm - 1
+ 
+          IF( pbaru(ij,l).GT.0.  )   THEN
+            qbxu( ij,l ) =  pbaru( ij,l )  * q(  ij  ,l,iq)
+          ELSE
+            qbxu( ij,l ) =  pbaru( ij,l )  * q(ij +1 ,l,iq)
+          ENDIF
+
+   6    CONTINUE
+ 
+c     ..... correction  pour  qbxu(iip1,j,l)   .....
+c     ...   qbxu(iip1,j,l)= qbxu(1,j,l)  ...
+ 
+CDIR$ IVDEP
+        DO  7   ij   = iip1 +iip1, ip1jm, iip1
+        qbxu( ij,l ) = qbxu( ij - iim, l )
+   7    CONTINUE
+ 
+        DO  8  ij     = 1, ip1jm
+         IF( pbarv(ij,l).GT.0.  )   THEN
+           qbyv( ij,l ) =  pbarv( ij,l )  * q(ij+iip1, l,iq)
+         ELSE
+           qbyv( ij,l ) =  pbarv( ij,l )  * q(   ij  , l,iq)
+         ENDIF
+   8    CONTINUE
+c
+  10    CONTINUE
+c
+ 
+c     stockage dans  dqh de la convergence horiz.du flux d'humidite  .
+c     ------------------------------------------------------------- 
+c
+                  CALL convflu(qbxu, qbyv, llm, dqh )
+
+c
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection vertic.pour q ....
+c              (moyenne arithmetique)
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dqh pour calculer dq
+c
+
+      DO 20 l = 1,llmm1
+
+c       preliminaires:
+c
+        DO 11 ij = 1,ip1jmp1
+         wsur2( ij ) = - 0.5 * w( ij,l+1 )
+  11    CONTINUE
+
+
+        DO 12 ij = 1,ip1jmp1
+          ww             = wsur2(ij)   * ( q(ij,l,iq) + q(ij,l+1,iq) )
+          dq (ij, l ,iq) = dqh(ij, l ) -  ww
+          dqh(ij,l+1   ) = dqh(ij,l+1) +  ww
+  12    CONTINUE
+c
+  20  CONTINUE 
+c
+c       special dq (ij,llm) (qui n'a pas ete rempli ! ) 
+c
+        DO  ij = 1,ip1jmp1
+          dq( ij,llm,iq ) = dqh( ij,llm ) 
+        END DO
+           
+      END IF
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/advect.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/advect.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/advect.F	(revision 2744)
@@ -0,0 +1,164 @@
+      SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta)
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Auteurs:  P. Le Van , Fr. Hourdin  .
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   *************************************************************
+c   .... calcul des termes d'advection vertic.pour u,v,teta,q ...
+c   *************************************************************
+c        ces termes sont ajoutes a du,dv,dteta et dq .
+c  Modif F.Forget 03/94 : on retire q de advect
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "ener.h"
+
+c   Arguments:
+c   ----------
+
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1)
+      REAL unsaire2(ip1jmp1), ge(ip1jmp1)
+      REAL deuxjour, ww, gt, uu, vv
+
+      INTEGER  ij,l
+
+      EXTERNAL  SSUM
+      REAL      SSUM
+
+c-----------------------------------------------------------------------
+c   2. Calculs preliminaires:
+c   -------------------------
+
+      IF (conser)  THEN
+         deuxjour = 2. * daysec
+
+         DO   1  ij   = 1, ip1jmp1
+         unsaire2(ij) = unsaire(ij) * unsaire(ij)
+   1     CONTINUE
+      END IF
+
+
+c------------------  -yy ----------------------------------------------
+c   .  Calcul de     u
+
+      DO  l=1,llm
+         DO    ij     = iip2, ip1jmp1
+            uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) )
+         ENDDO
+         DO    ij     = iip2, ip1jm
+            uav(ij,l) = uav(ij,l) + uav(ij+iip1,l)
+         ENDDO
+         DO      ij         = 1, iip1
+            uav(ij      ,l) = 0.
+            uav(ip1jm+ij,l) = 0.
+         ENDDO
+      ENDDO
+
+c------------------  -xx ----------------------------------------------
+c   .  Calcul de     v
+
+      DO  l=1,llm
+         DO    ij   = 2, ip1jm
+          vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) )
+         ENDDO
+         DO    ij   = 1,ip1jm,iip1
+          vav(ij,l) = vav(ij+iim,l)
+         ENDDO
+         DO    ij   = 1, ip1jm-1
+          vav(ij,l) = vav(ij,l) + vav(ij+1,l)
+         ENDDO
+         DO    ij       = 1, ip1jm, iip1
+          vav(ij+iim,l) = vav(ij,l)
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+
+c
+      DO 20 l = 1, llmm1
+
+
+c       ......   calcul de  - w/2.    au niveau  l+1   .......
+
+      DO 5   ij   = 1, ip1jmp1
+      wsur2( ij ) = - 0.5 * w( ij,l+1 )
+   5  CONTINUE
+
+
+c     .....................     calcul pour  du     ..................
+
+      DO 6 ij = iip2 ,ip1jm-1
+      ww        = wsur2 (  ij  )     + wsur2( ij+1 ) 
+      uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
+      du(ij,l)  = du(ij,l)   - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
+      du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
+   6  CONTINUE
+
+c     .....  correction pour  du(iip1,j,l)  ........
+c     .....     du(iip1,j,l)= du(1,j,l)   .....
+
+CDIR$ IVDEP
+      DO   7  ij   = iip1 +iip1, ip1jm, iip1
+      du( ij, l  ) = du( ij -iim, l  )
+      du( ij,l+1 ) = du( ij -iim,l+1 )
+   7  CONTINUE
+
+c     .................    calcul pour   dv      .....................
+
+      DO 8 ij = 1, ip1jm
+      ww        = wsur2( ij+iip1 )   + wsur2( ij )
+      vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
+      dv(ij,l)  = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
+      dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
+   8  CONTINUE
+
+c
+
+c     ............................................................
+c     ...............    calcul pour   dh      ...................
+c     ............................................................
+
+c                       ---z
+c       calcul de  - d( teta  * w )      qu'on ajoute a   dh
+c                   ...............
+
+        DO 15 ij = 1, ip1jmp1
+         ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
+         dteta(ij, l ) = dteta(ij, l )  -  ww
+         dteta(ij,l+1) = dteta(ij,l+1)  +  ww
+  15    CONTINUE
+
+      IF( conser)  THEN
+        DO 17 ij = 1,ip1jmp1
+        ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)
+  17    CONTINUE
+        gt       = SSUM( ip1jmp1,ge,1 )
+        gtot(l)  = deuxjour * SQRT( gt/ip1jmp1 )
+      END IF
+
+  20  CONTINUE
+ 
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/amont.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/amont.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/amont.F	(revision 2744)
@@ -0,0 +1,125 @@
+      SUBROUTINE amont (nq,iq,q,w, pbaru, pbarv,dq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van / F.Forget
+c   -------
+c
+c   ********************************************************************
+c   Transport d'un traceur q par shema amont 3D
+c   ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+
+c   Arguments:
+c   ----------
+      INTEGER nq,iq  
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq), dq( ip1jmp1,llm,nq )
+      REAL w(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER   l,ij
+
+      REAL qbyv( ip1jm,llm ), qbxu( ip1jmp1,llm )
+      REAL ww
+      REAL dqh( ip1jmp1,llm)
+
+      EXTERNAL     convflu
+
+c     ----------------------------------------------------------------
+c     --        calcul transport horiz. pour  dq                    --
+c     -                                                              -
+c     -         shema ' amont '                                      -
+c     ----------------------------------------------------------------
+c
+      IF( iq.GT.2 )   THEN
+       DO   l = 1, llm
+        DO ij = 1, ip1jmp1
+          dq(ij,l,iq) = 0.
+        ENDDO
+       ENDDO
+            RETURN
+      ENDIF
+ 
+c
+      IF( forward.OR.leapf )   THEN
+ 
+        DO 10 l = 1, llm
+ 
+        DO 6  ij     = iip2, ip1jm - 1
+           IF( pbaru(ij,l).GT.0.  )   THEN
+            qbxu( ij,l ) =  pbaru( ij,l )  * q(  ij  ,l,iq)
+           ELSE
+            qbxu( ij,l ) =  pbaru( ij,l )  * q(ij +1 ,l,iq)
+           ENDIF
+   6    CONTINUE
+ 
+c     ..... correction  pour  qbxu(iip1,j,l)   .....
+c     ...   qbxu(iip1,j,l)= qbxu(1,j,l)  ...
+ 
+CDIR$ IVDEP
+        DO  7   ij   = iip1 +iip1, ip1jm, iip1
+        qbxu( ij,l ) = qbxu( ij - iim, l )
+   7    CONTINUE
+ 
+        DO  8  ij     = 1, ip1jm
+           IF( pbarv(ij,l).GT.0.  )   THEN
+            qbyv( ij,l ) =  pbarv( ij,l )  * q(ij+iip1, l,iq)
+           ELSE
+            qbyv( ij,l ) =  pbarv( ij,l )  * q(   ij  , l,iq)
+           ENDIF
+   8    CONTINUE
+c
+  10    CONTINUE
+ 
+c     stockage dans  dqh de la convergence horiz.du flux d'humidite  .
+c     ------------------------------------------------------------- 
+c
+                  CALL convflu(qbxu, qbyv, llm, dqh )
+
+
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection vertic.pour q. Shema amont
+c ---------------------------------------------------------------
+
+c     calcul de  - d( q   * w )    qu'on ajoute a  dqh pour calculer dq
+c
+
+       DO 20 l = 1,llmm1
+c
+         DO 11 ij = 1,ip1jmp1
+           IF( w(ij,l+1).LT.0.  )   THEN
+            ww  =   - w( ij,l+1 ) * q( ij,  l  ,iq)
+           ELSE
+            ww  =   - w( ij,l+1 ) * q( ij, l +1,iq)
+           ENDIF
+
+          dq (ij, l ,iq ) = dqh(ij, l )   -  ww
+          dqh(ij,l+1    ) = dqh(ij,l+1)   +  ww
+  11     CONTINUE
+c
+  20   CONTINUE 
+
+c
+c       special dq (ij,llm) (qui n'a pas ete rempli ! ) 
+c
+        DO  ij = 1,ip1jmp1
+          dq( ij,llm,iq ) = dqh( ij,llm )
+        END DO
+           
+      END IF
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/amont_qsat.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/amont_qsat.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/amont_qsat.F	(revision 2744)
@@ -0,0 +1,151 @@
+      SUBROUTINE amont_qsat (nq,iq,q,teta,pk,w, pbaru, pbarv,dq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van / F.Forget
+c   -------
+c
+c   ********************************************************************
+c   Transport d'un traceur q par shema amont 3D  avec contrainte thermi-
+c           -que
+c   ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "serre.h"
+
+c   Arguments:
+c   ----------
+      INTEGER nq,iq  
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq), dq( ip1jmp1,llm,nq )
+      REAL teta(ip1jmp1,llm),pk(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER   l,ij
+
+      REAL qbyv( ip1jm,llm ), qbxu( ip1jmp1,llm )
+      REAL ww
+      REAL dqh( ip1jmp1,llm)
+
+      REAL ptarg,pdelarg,foeew,zdelta
+      REAL rtt,retv,r3les,r3ies,r4les,r4ies,unskappa,play
+      REAL tempe(ip1jmp1),qsat(ip1jmp1,llm),r2es
+
+      EXTERNAL     convflu
+
+       FOEEW ( PTARG,PDELARG ) = EXP (
+     *          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)
+     * / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
+C
+
+
+c     ----------------------------------------------------------------
+c     --        calcul transport horiz. pour  dq                    --
+c     -                                                              -
+c     -         shema ' amont '                                      -
+c     ----------------------------------------------------------------
+ 
+        r2es  = 380.11733 
+        r3les = 17.269
+        r3ies = 21.875
+        r4les = 35.86
+        r4ies = 7.66
+        retv = 0.6077667
+        rtt  = 273.16
+ 
+        unskappa =  1./ kappa
+
+        DO l = 1, llm
+         DO ij = 1, ip1jmp1
+          tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
+         ENDDO
+         DO ij = 1, ip1jmp1
+          zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          play   =  preff * (pk(ij,l)/cpp) ** unskappa
+          qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
+          qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
+         ENDDO
+        ENDDO
+
+        DO 10 l = 1, llm
+
+        DO 6  ij     = iip2, ip1jm - 1
+         IF( pbaru(ij,l).GT.0  )  THEN
+          qbxu( ij,l ) = pbaru( ij,l ) * MIN( q(ij,l,iq),qsat(ij +1,l))
+         ELSE
+          qbxu( ij,l ) = pbaru( ij,l ) * MIN( q(ij+1,l,iq),qsat(ij,l) )
+         ENDIF
+       
+   6    CONTINUE
+ 
+c     ..... correction  pour  qbxu(iip1,j,l)   .....
+c     ...   qbxu(iip1,j,l)= qbxu(1,j,l)  ...
+ 
+CDIR$ IVDEP
+        DO  7   ij   = iip1 +iip1, ip1jm, iip1
+        qbxu( ij,l ) = qbxu( ij - iim, l )
+   7    CONTINUE
+ 
+        DO  8  ij     = 1, ip1jm
+         IF( pbarv(ij,l).GT.0  )  THEN
+          qbyv(ij,l) = pbarv( ij,l ) * MIN( q(ij+iip1,l,iq),qsat(ij,l) )
+         ELSE
+          qbyv(ij,l) = pbarv( ij,l ) * MIN( q(ij,l,iq),qsat(ij+iip1,l) )
+         ENDIF
+   8    CONTINUE
+c
+  10    CONTINUE
+ 
+c     stockage dans  dqh de la convergence horiz.du flux d'humidite  .
+c     ------------------------------------------------------------- 
+c
+                  CALL convflu(qbxu, qbyv, llm, dqh )
+
+
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection vertic.pour q. Shema amont
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dqh pour calculer dq
+c
+
+       DO 20 l = 1,llmm1
+c
+         DO 11 ij = 1,ip1jmp1
+           IF( w(ij,l+1).LT.0. )   THEN
+             ww =  -w(ij,l+1) * MIN( q(ij, l ,iq),qsat(ij ,l+1) )
+           ELSE
+             ww =  -w(ij,l+1) * MIN( q(ij,l+1,iq),qsat(ij , l ) )
+           ENDIF
+
+cc     .... Modif . P. Le Van  (26/09/95) ....
+
+          dq (ij, l ,iq ) = dqh(ij, l )   -  ww
+          dqh(ij,l+1    ) = dqh(ij,l+1)   +  ww
+  11     CONTINUE
+c
+  20   CONTINUE 
+
+c
+c       special dq (ij,llm) (qui n'a pas ete rempli ! ) 
+c
+        DO  ij = 1,ip1jmp1
+          dq( ij,llm,iq ) = dqh( ij,llm )
+        END DO
+           
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/angtot.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/angtot.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/angtot.h	(revision 2744)
@@ -0,0 +1,8 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'angtot.h
+
+      COMMON/angtot/dangdyn,dangm1,dangdis,dangdif
+
+      REAL dangdyn,dangm1,dangdis,dangdif
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/anl_mcdstats.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/anl_mcdstats.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/anl_mcdstats.F	(revision 2744)
@@ -0,0 +1,1375 @@
+      PROGRAM anldiag_nc
+      IMPLICIT NONE
+c======================================================================
+c
+c
+c Program designed to read output files from the MARS gcm
+c or the Mars Climate database.
+c
+c    Francois Forget 1999
+c    Version used by monica to interpolate in zaeroid and p coordinate
+
+c
+c=======================================================================
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "description.h"
+#include "netcdf.inc"
+
+      INTEGER itau,nbpas,nbpasmx, coor,sor,varoutsize
+      integer varspecsize
+      integer varout(6),varspec(nqmx)
+      integer itau0
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx),y
+      INTEGER unitlec
+      INTEGER i,j,l,irec,itautot,ierr,iq,n,ff,k
+      real, dimension(:),allocatable :: lat,lon,alt
+      integer:: nout,latdimout,londimout,altdimout,timedimout,timevarout
+      integer:: latdim,londim,altdim,dimid
+      integer:: latvar,lonvar,altvar,timevar
+      integer:: latlen,lonlen,altlen,timelen
+      integer, dimension(4) :: edges,corner,id
+      integer, dimension(3) :: edges2,corner2
+
+      INTEGER   unit,nvarid,nid,varid
+      REAL mugaz
+
+      REAL missing
+      PARAMETER(missing=1E+20)
+      REAL valid_range(2)
+      DATA valid_range /0., 300.0/
+c   variables meteo dans la grille verticale GCM
+c   --------------------------------------------
+      REAL v(iip1,jjp1,llm),u(iip1,jjp1,llm),w(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm),rho(iip1,jjp1,llm),phi(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1) , tsurf(iip1,jjp1)
+      REAL Rnew(iip1,jjp1,llm)
+      real euv(iip1,jjp1,llm),con(iip1,jjp1,llm),nir(iip1,jjp1,llm)
+      real nspec(iip1,jjp1,llm,nqmx),spec(iip1,jjp1,llm)
+
+      REAL v_sd(iip1,jjp1,llm),u_sd(iip1,jjp1,llm)
+      real w_sd(iip1,jjp1,llm),t_sd(iip1,jjp1,llm)
+      real rho_sd(iip1,jjp1,llm)
+      real euv_sd(iip1,jjp1,llm),con_sd(iip1,jjp1,llm)
+      real nir_sd(iip1,jjp1,llm)
+      real nspec_sd(iip1,jjp1,llm,nqmx)
+
+c   ALtitude of the GCM levels
+c   -------------------------
+      REAL zlocal(iip1,jjp1,llm) ! altitude above the local surface (m)
+      REAL zareoid(iip1,jjp1,llm) ! altitude above the mola areoid (m)
+      real tmean   ! use to integrate hydrostatic equation
+      real Rmean   ! use to integrate hydrostatic equation
+
+c    Also used to integrate hydrostatic equation:
+      real g0 ! exact mean gravity at radius=3396.km (LEMOINE ET AL 2001) 
+      data    g0 /3.7257964/
+      data    a0 /3396.0/  ! radius=3396.km
+      real gz  ! used to estimate gravity in altitude...
+
+
+c   variables meteo en coordonnee de pression
+c   --------------------------------------------
+      REAL vp(iip1,jjp1,llm),up(iip1,jjp1,llm),wp(iip1,jjp1,llm)
+      REAL tp(iip1,jjp1,llm),rhop(iip1,jjp1,llm)
+      REAL nspecp(iip1,jjp1,llm,nqmx)
+      REAL phip(iip1,jjp1,llm)
+      
+      REAL vp_sd(iip1,jjp1,llm),up_sd(iip1,jjp1,llm)
+      real wp_sd(iip1,jjp1,llm),tp_sd(iip1,jjp1,llm)
+      real rhop_sd(iip1,jjp1,llm),nspecp_sd(iip1,jjp1,llm,nqmx)
+ 
+c     Niveaux de pression (Pa)
+      real pref(llm)
+
+c    Version 32 layers : ************
+c     data pref/
+c     &1000.,884., 783. , 610., 475, 370, 288, 224, 174, 140.,
+c     &115 , 80.6481, 48.0445, 26.6881, 14.1462, 7.29102, 3.70004,
+c     &1.86241, 0.933516, 0.466924, 0.233296, 0.116503, 5.81631E-02,
+c     & 2.90335E-02,1.44919E-02, 7.23328E-03, 3.61027E-03, 1.80193E-03,
+c     & 8.99364E-04,4.48881E-04, 2.15769E-04, 1.3E-04/
+
+c    Version 50 layers : ************
+      data pref/
+     &1400., 1100., 800., 565., 400., 280., 200., 140., 100.,
+     &70., 50., 35., 25., 18., 13., 9., 6.,
+     &3.63227,1.803712,0.8956969,0.4447900,0.2208762,0.1096839,
+     &5.4467395E-02,2.7047679E-02,1.3431421E-02,
+     &6.6698161E-03,3.3121328E-03,
+     &1.6447564E-03,8.1676187E-04,4.0559194E-04,2.0141099E-04,
+     &1.0001774E-04,4.9667346E-05,2.4664072E-05,1.2247816E-05,
+     &6.0820857E-06,3.0202741E-06,1.4998238E-06,7.4479044E-07,
+     &3.6985199E-07,1.8366305E-07,9.1204370E-08,4.5290751E-08,
+     &2.2490720E-08,1.1168562E-08,5.5461431E-09,2.7541311E-09,
+     &1.3676602E-09,6.7915956E-10/
+
+c   variables meteo en coordonnee de zareoid
+c   --------------------------------------------
+      REAL va(iip1,jjp1,llm),ua(iip1,jjp1,llm),wa(iip1,jjp1,llm)
+      REAL ta(iip1,jjp1,llm),rhoa(iip1,jjp1,llm),ra(iip1,jjp1,llm)
+      real euva(iip1,jjp1,llm),cona(iip1,jjp1,llm),nira(iip1,jjp1,llm)
+      real nspeca(iip1,jjp1,llm,nqmx)
+
+      REAL va_sd(iip1,jjp1,llm),ua_sd(iip1,jjp1,llm)
+      real wa_sd(iip1,jjp1,llm),ta_sd(iip1,jjp1,llm)
+      real rhoa_sd(iip1,jjp1,llm)
+      real euva_sd(iip1,jjp1,llm),cona_sd(iip1,jjp1,llm)
+      real nira_sd(iip1,jjp1,llm)
+      real nspeca_sd(iip1,jjp1,llm,nqmx)
+
+      REAL vij(llm),uij(llm),zaij(llm),wij(llm),rij(llm)
+      REAL tij(llm),rhoij(llm+1),sigij(llm)
+      real euvij(llm),conij(llm),nirij(llm)
+      real nspecij(llm+1,nqmx)
+
+      REAL vij_sd(llm),uij_sd(llm)
+      real wij_sd(llm),tij_sd(llm),rhoij_sd(llm+1)
+      real euvij_sd(llm),conij_sd(llm),nirij_sd(llm)
+      real nspecij_sd(llm+1,nqmx)
+
+c     Niveaux de zareoid (m)
+      real zaref(llm)
+      real p_zaref,p_zaij(llm+1) ! used to interpolate rho
+
+       data zaref/    
+      & -6.E+3,-4.E+3,-2.E+3,0.E+3,2.E+3,4.E+3,6.E+3,8.E+3,10.E+3,12.E+3
+      & ,14.E+3,16.E+3,18.E+3,22.E+3,26.E+3,30.E+3,34.E+3
+      & ,38.E+3,44.E+3,50.E+3,56.E+3,62.E+3,68.E+3,74.E+3
+      & ,80.E+3,86.E+3,92.E+3,98.E+3,104.E+3,110.E+3,116.E+3
+      & ,122.E+3,128.E+3,134.E+3,140.E+3,146.E+3,152.E+3,158.E+3
+      & ,164.E+3,170.E+3,176.E+3,182.E+3,188.E+3,194.E+3,200.E+3
+      & ,206.E+3,212.E+3,218.E+3,224.E+3,230.E+3/
+
+
+c   Surface data (sometime needed for some analysis):
+c   ------------------------------------------------
+      character relief*3
+      real phis(iip1,jjp1)
+      real alb(iip1,jjp1),ith(iip1,jjp1)
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+
+
+      real utime
+      real localtime(iip1)
+      common/temporaire/localtime
+
+      INTEGER*4 day0
+      integer nmoy(jjp1,llm),tp1,tp2,pass
+
+      CHARACTER*1 yes,yescomp
+
+      integer iformat
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER nomfich*60
+      CHARACTER nomfile(2)*60,nomfileout(2)*60
+      integer fichsize,fstats
+      CHARACTER fdiag*60
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL inifilr,exner
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c   Dust
+c   ----
+
+#include "fxyprim.h"
+
+      character*10  noms(nqmx),varnoms(6)
+c      data          noms/"co2","co","o","o1d","o2","o3","h","h2",
+c     $                   "oh","ho2","h2o2", "n2", "h2o"/
+c      data          varnoms/"T","U","V","W","RHO","Species"/
+
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      unitlec=11
+      itautot=0
+
+
+c     Lecture du fichier a lire
+c     -------------------------
+
+      print*,' ' 
+      PRINT*,'File to process: 1)DIAGFI 2)STATS 3)BOTH'
+      READ(5,'(i)') fichsize
+      if(fichsize.ne.2)then
+        i=1
+        PRINT*,'   enter name of diagfi file (w/o .nc)'
+        READ(5,'(a)') nomfile(i)
+        fdiag=nomfile(i)
+        PRINT*,'   do you want to rename the output file?  
+     &  1) Yes  2) No'
+        READ(5,'(i)') sor
+        if (sor.eq.1) then
+          PRINT*,'   enter label for output file'
+          READ(5,'(a)') nomfileout(i)
+        elseif(sor.eq.2) then
+          nomfileout(i)=nomfile(i)
+        endif
+      endif
+      if(fichsize.ne.1)then
+        i=i+1
+        PRINT*,'   enter name of stats file (w/o .nc)'
+        READ(5,'(a)') nomfile(i)
+        PRINT*,'   do you want to rename the output file?  
+     &  1) Yes  2) No'
+        READ(5,'(i)') sor
+        if (sor.eq.1) then
+          PRINT*,'   enter label for output file'
+          READ(5,'(a)') nomfileout(i)
+        elseif(sor.eq.2) then
+          nomfileout(i)=nomfile(i)
+        endif
+        if(fichsize.eq.2) then
+          PRINT*,'   enter name of diagfi file for controle (w/o .nc)'
+          read(5,'(a)') fdiag
+        endif
+        fstats=1
+      endif
+      if (fichsize.ge.2) fichsize=fichsize-1
+      print*,' '
+      print*,'Output in: 1) netcdf 2) IDL 3) both ?'
+      READ(5,'(i)') sor
+      print*,' '
+      print*,'Coordinates in: 1) pressure 2) Zareoid 3) both  ?'
+      READ(5,'(i)') coor
+
+c ************* Partie a moderniser !!! FF 2004 ************
+      print*,' '
+      print*,'Fields:  T  U  V  W  Rho  Species  All   ?'
+      print*,'Type total number of desired outputs or 6 for All   '
+      READ(5,'(i)') varoutsize
+      if(varoutsize.lt.6) then
+        print*,' '
+        print*,'Fields:  T  U  V  W  Rho  Species '
+        print*,'  #   :  1  2  3  4   5      6'
+        print*,' '
+        do i=1,varoutsize
+          print*,'Type number of variable ',i
+          READ(5,'(i)') varout(i)
+        enddo
+      endif
+      if(varoutsize.eq.6) then
+        do i=1,6
+          varout(i)=i
+        enddo
+      endif
+      do i=1,varoutsize
+        if (varout(i).eq.6) then
+           print*,'Type total number of desired species or 13 for All'
+           READ(5,'(i2)') varspecsize
+           if(varspecsize.ne.13) then
+             print*,' '
+             print*,'Select Species: CO2 CO O O(1D) O2 O3' 
+             print*,'                 1  2  3   4   5  6'
+             print*,'                 H H2 OH HO2 H2O2 N2 H2O'
+             print*,'                 7 8  9  10   11  12 13'
+             do n=1,varspecsize
+               print*,'Type number of species ',i
+               read(5,'(i)') varspec(n)
+             enddo
+           else
+             do n=1,varspecsize
+               varspec(n)=n
+             enddo
+           endif
+         endif
+       enddo
+      if(varoutsize.gt.6) print*,'Value must be <= 6'
+     
+c ***************** Fin partie a moderniser ***************
+
+! LOOP ON FILES
+! =================================================================
+      do ff=1,fichsize
+ 
+      file=nomfile(ff)  
+      nomfich=nomfile(ff)  
+      file=file(1:lnblnk(file))
+      PRINT*,'file',file
+
+c     Ouverture fichiers :
+c     ------------------
+      write(*,*) "opening "//trim(nomfich)//"..."
+      ierr = NF_OPEN(trim(adjustl(nomfich))//".nc",NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening file '//nomfich
+         stop ""
+      endif
+
+! Control & lecture on dimensions
+! =================================================================
+      ierr=NF_INQ_DIMID(nid,"latitude",latdim)
+      ierr=NF_INQ_VARID(nid,"latitude",latvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <latitude> is missing'
+      stop ""
+      endif
+      ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+!  write(*,*) "latlen: ",latlen
+
+      ierr=NF_INQ_DIMID(nid,"longitude",londim)
+      ierr=NF_INQ_VARID(nid,"longitude",lonvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <longitude> is lacking'
+      stop ""
+      endif
+      ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
+!  write(*,*) "lonlen: ",lonlen
+
+      ierr=NF_INQ_DIMID(nid,"altitude",altdim)
+      ierr=NF_INQ_VARID(nid,"altitude",altvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <altitude> is lacking'
+      stop ""
+      endif
+
+      ierr=NF_INQ_DIMLEN(nid,altdim,altlen)
+!  write(*,*) "altlen: ",altlen
+
+      if (ff.eq.1) then
+        allocate(lat(latlen))
+        allocate(lon(lonlen))
+        allocate(alt(altlen))
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid,latvar,lat)
+      ierr = NF_GET_VAR_DOUBLE(nid,lonvar,lon)
+      ierr = NF_GET_VAR_DOUBLE(nid,altvar,alt)
+#else
+      ierr = NF_GET_VAR_REAL(nid,latvar,lat)
+      ierr = NF_GET_VAR_REAL(nid,lonvar,lon)
+      ierr = NF_GET_VAR_REAL(nid,altvar,alt)
+#endif
+
+c   Lecture Time :
+
+      ierr= NF_INQ_DIMID (nid,"Time",dimid)
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'anl_NC: Le champ <Time> est absent'
+          CALL abort
+        ENDIF
+
+      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'anl_NC: Lecture echouee pour <Time>'
+          CALL abort
+        ENDIF
+        PRINT*,'temps',(temps(itau),itau=1,10)
+! =================================================================
+
+! SETTING OUTPUT FILES
+
+      file=nomfileout(ff)  
+      nomfich=nomfileout(ff)  
+      file=file(1:lnblnk(file))
+
+c    layers in zareoid : ************
+          do l=1,llm
+            alt(l)=zaref(l)/1000.
+          enddo
+
+! =================================================================
+! Output in netcdf
+! =================================================================
+      if (sor.ne.2) then
+
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+ 
+          ierr = NF_CREATE(trim(adjustl(nomfich))//"_P.nc",
+     &                     NF_CLOBBER, nout)
+          if (ierr.NE.NF_NOERR) THEN
+            write(*,*)' Pb d''ouverture du fichier '
+            write(*,*)' ierr = ', ierr
+            STOP
+          ENDIF
+          ierr = NF_PUT_ATT_TEXT(nout, NF_GLOBAL, "title", 24,
+     &                          "Pressure coordinates ")
+          ierr = NF_DEF_DIM(nout,"latitude", size(lat), latdimout)
+          ierr = NF_DEF_DIM(nout,"longitude", size(lon), londimout)
+          ierr = NF_DEF_DIM(nout,"altitude", size(pref), altdimout)
+          ierr = NF_DEF_DIM(nout,"Time", NF_UNLIMITED, timedimout)
+          ierr = NF_ENDDEF(nout)
+
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES 
+
+          ierr = NF_CREATE(trim(adjustl(nomfich))//"_Z.nc",
+     &                     NF_CLOBBER, nout)
+          IF(ierr.NE.NF_NOERR) THEN
+            write(*,*)' Pb d''ouverture du fichier '
+            write(*,*)' ierr = ', ierr
+            STOP
+          ENDIF
+          ierr = NF_PUT_ATT_TEXT(nout, NF_GLOBAL, "title", 24,
+     &                           "zaeroid coordinates")
+          ierr = NF_DEF_DIM(nout,"latitude", size(lat), latdimout)
+          ierr = NF_DEF_DIM(nout,"longitude", size(lon), londimout)
+          ierr = NF_DEF_DIM(nout,"altitude ", size(pref), altdimout)
+          ierr = NF_DEF_DIM(nout,"Time", NF_UNLIMITED, timedimout)
+          ierr = NF_ENDDEF(nout)
+
+        endif
+
+        call def_var(nout,"Time","Time","days since 0000-00-0
+     &  00:00:00",1,(/timedimout/),timevarout,ierr)
+
+        ierr = NF_REDEF (nout)       
+        call def_var(nout,"latitude","latitude","degrees_north",1,
+     &               (/latdimout/),nvarid,ierr)
+
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,lat)
+#else
+        ierr = NF_PUT_VAR_REAL (nout,nvarid,lat)
+#endif
+        ierr = NF_REDEF (nout) 
+        call def_var(nout,"longitude","East longitude","degrees_east",1,
+     &               (/londimout/),nvarid,ierr)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,lon)
+#else
+        ierr = NF_PUT_VAR_REAL (nout,nvarid,lon)
+#endif
+        ierr = NF_REDEF (nout)
+
+        if(coor.ne.2) then 					! PRESSURE CCOORDINATES
+#ifdef NC_DOUBLE
+          ierr = NF_DEF_VAR (nout,"altitude",NF_DOUBLE,1,
+     &                       (/altdimout/), nvarid)
+#else
+          ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,
+     &                       (/altdimout/),nvarid)
+#endif
+
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",22,"altitude
+     &                            pression")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"Pa")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',4,"down")
+          ierr = NF_ENDDEF(nout)
+#ifdef NC_DOUBLE
+          ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,pref)
+#else
+          ierr = NF_PUT_VAR_REAL (nout,nvarid,pref)
+#endif
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES 
+
+#ifdef NC_DOUBLE
+          ierr = NF_DEF_VAR (nout,"altitude",NF_DOUBLE,1,
+     &                       (/altdimout/), nvarid)
+#else
+          ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,
+     &                       (/altdimout/),nvarid)
+#endif
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",20,"altitude
+     &                           zaeroid")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"km")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',2,"up")
+          ierr = NF_ENDDEF(nout)
+#ifdef NC_DOUBLE
+          ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,alt)
+#else
+          ierr = NF_PUT_VAR_REAL (nout,nvarid,alt)
+#endif
+        endif
+
+      endif !end if netcdf  
+
+! Output in idl
+! =================================================================
+      if (sor.ne.1) then
+
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+          do i=1,varoutsize
+            j=121+i
+            if(varout(i).eq.6) then
+              do iq=1,varspecsize
+                file=trim(nomfileout(ff))//'_P_'
+     &               //trim(noms(iq))//'.dat'  
+                j=121+i+(iq-1)
+                open(j,file=trim(file), status='unknown')
+                write(j,117) noms(iq) 
+                write(j,120) iim,jjp1,llm
+                write(j,119) lon
+                write(j,119) lat
+                write(j,119) pref
+              enddo
+            else
+              file=trim(nomfileout(ff))//'_P_'
+     &            //trim(varnoms(varout(i)))//'.dat'  
+              open(j,file=trim(file), status='unknown')
+              write(j,117) varnoms(varout(i)) 
+              write(j,120) iim,jjp1,llm
+              write(j,119) lon
+              write(j,119) lat
+              write(j,119) pref
+            endif
+          enddo 
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES
+          do i=1,varoutsize
+            j=1221+i
+            if(varout(i).eq.6) then
+              do iq=1,varspecsize
+                file=trim(nomfileout(ff))//'_Z_'
+     &               //trim(noms(iq))//'.dat'  
+                j=1221+i+(iq-1)
+                open(j,file=trim(file), status='unknown')
+                write(j,117) noms(iq)
+                write(j,120) iim,jjp1,llm
+                write(j,119) lon
+                write(j,119) lat
+                write(j,119) alt
+              enddo
+            else
+              file=trim(nomfileout(ff))//'_Z_'
+     &            //trim(varnoms(varout(i)))//'.dat'  
+              open(j,file=trim(file), status='unknown')
+              write(j,117) varnoms(varout(i))
+              write(j,120) iim,jjp1,llm
+              write(j,119) lon
+              write(j,119) lat
+              write(j,119) alt
+            endif
+          enddo
+              
+c              file=trim(nomfileout(ff))
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_EUV.dat',
+c     &               status='unknown')
+c              write(j,117) 'EUV'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_CON.dat',
+c     &               status='unknown')
+c              write(j,117) 'CONDUCTION'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_NIR.dat',
+c     &               status='unknown')
+c              write(j,117) 'NIR'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+        endif
+
+      endif
+120    format(3i3)
+119    format(12(e10.4,1x))
+118    format(2i3)
+117    format(6(a7))
+116    format(13(a6))
+! =================================================================
+ 
+
+800   continue ! LOOP SUR LES FICHIERS
+
+
+! =================================================================
+! INITIALIZATION OF PARAMETERS
+! =================================================================
+
+      rad=3397200.              ! rayon de mars (m)  ~3397200 m
+      daysec=88775.             ! duree du sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec) ! vitesse de rotation (rad.s-1)
+      g=3.72                    ! gravite (m.s-2) ~3.72
+      mugaz=43.49               ! Masse molaire de l'atm (g.mol-1) ~43.49
+      kappa=.256793             ! = r/cp  ~0.256793
+      r = 191.18213
+      pi=2.*asin(1.)
+      ecritphy =1
+      iphysiq=1
+      day_ini=0.
+      day_step=1
+
+      CALL readhead_NC(trim(adjustl(fdiag))//".nc",day0,phis,R)
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+c     If needed : getting topography, albedo, thermal inertia...
+c     -------------------------------------------------------
+c     "phis" is the surface geopotential = topography (m) * g 
+       relief='mola'    ! Topography MOLA par defaut
+
+        CALL datareadnc(relief,phis,alb,ith,zmeaS,zstdS,zsigS,zgamS,
+      .          ztheS)
+
+
+! =================================================================
+! LOOP IN TIME
+! =================================================================
+
+      DO itau=1,nbpas
+
+! FILE READING : 
+! =================================================================
+        print*,'Timestep = ',itau,'/',nbpas
+
+c Cas special stats pour la base de donnee : FF 2004
+c        call lect_var(nid,'tsurf',3,ierr,itau,	tsurf)
+        call lect_var(nid,'ps',3,ierr,itau,ps)
+
+        call lect_var(nid,'temp',4,ierr,itau,t)
+        call lect_var(nid,'u',4,ierr,itau,u)
+        call lect_var(nid,'v',4,ierr,itau,v)
+        call lect_var(nid,'w',4,ierr,itau,		w)
+        call lect_var(nid,'rho',4,ierr,itau,	rho)
+        
+
+
+        do n=1,varspecsize
+          i=varspec(n)
+        call lect_var(nid,'n_'//trim(noms(i)),4,ierr,itau,spec)
+        do l=1,llm
+          do j=1,jjp1
+            do i=1,iip1
+              nspec(i,j,l,n)=spec(i,j,l)
+            enddo
+          enddo
+        enddo
+        enddo
+
+        if(fstats*ff-fichsize .eq. 0) then
+          call lect_var(nid,'temp_sd',4,ierr,itau,	t_sd)
+          call lect_var(nid,'u_sd',4,ierr,itau,		u_sd)
+          call lect_var(nid,'v_sd',4,ierr,itau,		v_sd)
+c          call lect_var(nid,'w_sd',4,ierr,itau,		w_sd)
+c          call lect_var(nid,'rho_sd',4,ierr,itau,	rho_sd)
+          do n=1,varspecsize
+            i=varspec(n)
+            call lect_var(nid,'n_'//trim(noms(i))//'_sd',4,ierr,
+     &                    itau,	spec)
+            do l=1,llm
+              do j=1,jjp1
+                do i=1,iip1
+                  nspec_sd(i,j,l,n)=spec(i,j,l)
+                enddo
+              enddo
+            enddo
+          enddo
+        endif
+
+! =================================================================
+! COMPUTING ALTITUDE OF GCM LEVELS IN GCM GRID
+! =================================================================
+
+c  ---------------------------------------------------------------
+c   Computing Molecular Gas Constant at every grid point (J kg-1 K-1)
+c   later used to integrate the hydrostatic equation
+c  ---------------------------------------------------------------
+        do l=1,llm
+          do j=1,jjp1
+            do i=1,iip1
+c              Rnew = P/(rho*T)
+              Rnew(i,j,l) =  (aps(l) + bps(l)*ps(i,j))
+     &                      / ( rho(i,j,l) * T(i,j,l) )
+            enddo
+          enddo
+        enddo
+
+
+c      ALTITUDE OF GCM LEVELS 
+c      ----------------------
+c      zlocal 	! altitude above the local surface (m)
+c      zareoid 	! altitude above the mola areoid (m)
+c      phis(i,j)/g ! altitude of the local surface above the mola areoid (m)
+
+        do j=1,jjp1
+          do i=1,iip1
+            sigij(1)=aps(1)/ps(i,j)+bps(1)
+            zlocal(i,j,1)=-log(sigij(1))* Rnew(i,j,1)*t(i,j,1)/g
+            zareoid(i,j,1) = zlocal(i,j,1) + phis(i,j)/g0
+
+            do l=2,llm
+              sigij(l)=aps(l)/ps(i,j)+bps(l)
+              tmean=t(i,j,l)
+              if(t(i,j,l).ne.t(i,j,l-1))
+     &          tmean=(t(i,j,l)-t(i,j,l-1))/log(t(i,j,l)/t(i,j,l-1))
+                Rmean = 0.5*(Rnew(i,j,l) + Rnew(i,j,l-1))
+                gz= g0*a0**2/(a0+zareoid(i,j,l-1))**2
+
+              zlocal(i,j,l)=zlocal(i,j,l-1) 
+     &                -log(sigij(l)/sigij(l-1))*Rmean*tmean/gz
+              zareoid(i,j,l) = zlocal(i,j,l) + phis(i,j)/g
+            enddo
+  
+          enddo
+        enddo
+
+
+c Local time
+c ----------
+c universal time (in stats oe MCD files)
+        utime = (itau-1)*2.
+
+c local time (in stats file)
+        DO i = 1,iim
+          localtime(i)=utime + 12.*rlonv(i)/pi
+          if(localtime(i).gt.24) localtime(i)=localtime(i)-24.
+          if(localtime(i).lt.0) localtime(i)=localtime(i)+24.
+        ENDDO
+
+c c Passage en niveaux de pression
+c ------------------------------
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+          call xsig2p (ps,T,pref,llm,Tp)
+          call xsig2p (ps,u,pref,llm,up)
+          call xsig2p (ps,v,pref,llm,vp)
+          call xsig2p (ps,w,pref,llm,wp)
+          call xsig2p (ps,rho,pref,llm,rhop)
+          do iq=1,varspecsize
+            call xsig2p (ps,nspec(1,1,1,iq),pref,llm,nspecp(1,1,1,iq))
+          enddo
+           if(fstats*ff-fichsize .eq. 0) then
+             call xsig2p (ps,u_sd,pref,llm,up_sd)
+             call xsig2p (ps,v_sd,pref,llm,vp_sd)
+             call xsig2p(ps,t_sd,pref,llm,Tp_sd)
+             call xsig2p (ps,w_sd,pref,llm,wp_sd)
+             call xsig2p (ps,rho_sd,pref,llm,rhop_sd)
+             do iq=1,varspecsize
+               call xsig2p (ps,nspec_sd(1,1,1,iq),pref,llm,
+     $                      nspecp_sd(1,1,1,iq))
+             enddo
+           endif
+         endif
+
+c c Passage en niveaux de zareoid
+c ------------------------------
+        if(coor.ne.1) then 					! ZAEROID COORDINATES
+        do j=1,jjp1
+          do i=1,iip1
+            do l=1,llm
+              Tij(l)=T(i,j,l)
+              uij(l)=u(i,j,l)
+              vij(l)=v(i,j,l)
+              wij(l)=w(i,j,l)
+              rhoij(l)=rho(i,j,l)
+              do iq=1,varspecsize
+                nspecij(l,iq)=nspec(i,j,l,iq)
+                if(l.eq.llm) nspecij(l+1,iq)=nspecij(l,iq)*1.e-3
+              enddo
+c              euvij(l)=euv(i,j,l)
+c              conij(l)=con(i,j,l)
+c              nirij(l)=nir(i,j,l)
+              zaij(l)=zareoid(i,j,l)
+              p_zaij(l)=exp(-zareoid(i,j,l)/1.e4) ! used to interpolate rho
+              if(fstats*ff-fichsize .eq. 0) then
+                Tij_sd(l)=T_sd(i,j,l)
+                uij_sd(l)=u_sd(i,j,l)
+                vij_sd(l)=v_sd(i,j,l)
+                wij_sd(l)=w_sd(i,j,l)
+                rhoij_sd(l)=rho_sd(i,j,l)
+                do iq=1,varspecsize
+                  nspecij_sd(l,iq)=nspec_sd(i,j,l,iq)
+                  if(l.eq.llm) nspecij_sd(l+1,iq)=nspecij_sd(l,iq)*1.e-3
+                enddo
+              endif
+            enddo
+
+            do l=1,llm
+              call interpolf(zaref(l),y,zaij,Tij,llm)
+              Ta(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,uij,llm)
+              ua(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,vij,llm)
+              va(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,wij,llm)
+              wa(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,euvij,llm)
+c              euva(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,conij,llm)
+c              cona(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,nirij,llm)
+c              nira(i,j,l)=y
+
+              p_zaref=exp(-zaref(l)/1.e4)
+              call interpolf(p_zaref,y,p_zaij,rhoij,llm+1)
+              rhoa(i,j,l)=y
+               
+              do iq=1,varspecsize
+                call interpolf(p_zaref,y,p_zaij,nspecij(1,iq),llm+1)
+c                call interpolf(zaref(l),y,zaij,nspecij(1,iq),llm)
+                nspeca(i,j,l,iq)=y
+              enddo
+
+              if(fstats*ff-fichsize .eq. 0) then
+                call interpolf(zaref(l),y,zaij,Tij_sd,llm)
+                Ta_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,uij_sd,llm)
+                ua_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,vij_sd,llm)
+                va_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,wij_sd,llm)
+                wa_sd(i,j,l)=y
+                call interpolf(p_zaref,y,p_zaij,rhoij_sd,llm+1)
+                rhoa_sd(i,j,l)=y
+                do iq=1,varspecsize
+                  call interpolf(p_zaref,y,p_zaij,nspecij_sd(1,iq),
+     &                           llm+1)
+c                  call interpolf(zaref(l),y,zaij,nspecij_sd(1,iq),llm)
+                  nspeca_sd(i,j,l,iq)=y
+                enddo
+              endif
+
+            enddo
+          enddo
+        enddo
+
+c            do l=1,llm
+c        print*,T(32,24,l),Ta(32,24,l)
+c        print*,nspec(32,24,l,1),nspeca(32,24,l,1)
+c            enddo
+
+        endif
+ 
+c Output at each time-step, in netcdf format
+! =================================================================
+        if (sor .ne. 2) then
+
+          ierr= NF_INQ_VARID(nout,"Time",nvarid)
+#ifdef NC_DOUBLE
+          ierr= NF_PUT_VARA_DOUBLE(nout,nvarid,itau,1,temps(itau))
+#else
+          ierr= NF_PUT_VARA_REAL(nout,nvarid,itau,1,temps(itau))
+#endif
+          if (ierr.ne.NF_NOERR) then
+            write(*,*) "time problem ",NF_STRERROR(ierr)
+            stop
+          endif
+
+          if (varoutsize.eq.6) n=1
+          if (varoutsize.ne.6) n=varoutsize
+          do i=1,n
+            if(varout(i).eq.1 .or. varoutsize.eq.6) then
+             if(coor.ne.1) 
+     &          call put_var(nout,'temp','temp','K',4,ierr,itau,Ta)
+             if(coor.ne.2) 
+     &          call put_var(nout,'temp','temp','K',4,ierr,itau,Tp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'temp_sd','temp_sd','K',
+     &                                      4,ierr,itau,Ta_sd)
+                if(coor.ne.2) call put_var(nout,'temp_sd','temp_sd','K',
+     &                                      4,ierr,itau,Tp_sd)
+              endif
+            endif
+            if(varout(i).eq.2 .or. varoutsize.eq.6)  then
+              if(coor.ne.1) 
+     &          call put_var(nout,'u','u','m s-1',4,ierr,itau,ua)
+              if(coor.ne.2) 
+     &          call put_var(nout,'u','u','m s-1',4,ierr,itau,up)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'u_sd','u_sd','m s-1',
+     &                                      4,ierr,itau,ua_sd)
+                if(coor.ne.2) call put_var(nout,'u_sd','u_sd','m s-1',
+     &                                      4,ierr,itau,up_sd)
+              endif
+            endif
+            if(varout(i).eq.3 .or. varoutsize.eq.6) then
+              if(coor.ne.1) 
+     &          call put_var(nout,'v','v','m s-1',4,ierr,itau,va)
+              if(coor.ne.2) 
+     &          call put_var(nout,'v','v','m s-1',4,ierr,itau,vp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'v_sd','v_sd','m s-1',
+     &                                      4,ierr,itau,va_sd)
+                if(coor.ne.2) call put_var(nout,'v_sd','v_sd','m s-1',
+     &                                      4,ierr,itau,vp_sd)
+              endif
+            endif
+            if(varout(i).eq.4 .or. varoutsize.eq.6) then
+              if(coor.ne.1) 
+     &          call put_var(nout,'w','w','m s-1',4,ierr,itau,wa)
+              if(coor.ne.2) 
+     &          call put_var(nout,'w','w','m s-1',4,ierr,itau,wp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'w_sd','w_sd','m s-1',
+     &                                      4,ierr,itau,wa_sd)
+                if(coor.ne.2) call put_var(nout,'w_sd','w_sd','m s-1',
+     &                                      4,ierr,itau,wp_sd)
+              endif
+            endif
+            if(varout(i).eq.5 .or. varoutsize.eq.6)  then
+              if(coor.ne.1) call put_var(nout,'rho','rho','',4,ierr,
+     &                                    itau,rhoa)
+              if(coor.ne.2) call put_var(nout,'rho','rho','',4,ierr,
+     &                                    itau,rhop)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'rho_sd','rho_sd','',
+     &                                      4,ierr,itau,rhoa_sd)
+                if(coor.ne.2) call put_var(nout,'rho_sd','rho_sd','',
+     &                                      4,ierr,itau,rhop_sd)
+              endif
+            endif
+            if(varout(i).eq.6 .or. varoutsize.eq.6) then
+              do iq=1,varspecsize
+                j=varspec(iq)
+                if(coor.ne.1) call put_var(nout,'n_'//trim(noms(j)),
+     &       'n_'//trim(noms(j)),'cm-3',4,ierr,itau,nspeca(1,1,1,iq))
+                if(coor.ne.2) call put_var(nout,'n_'//trim(noms(j)),
+     &         'n_'//trim(noms(j)),'cm-3',4,ierr,itau,nspecp(1,1,1,iq))
+                if(fstats*ff-fichsize.eq.0) then
+                  if(coor.ne.1) call put_var(nout,
+     &                        'n_'//trim(noms(j))//'_sd',
+     &                        'n_'//trim(noms(j))//'_sd','cm-3',4,ierr,
+     &                           itau,nspeca_sd(1,1,1,iq))
+                  if(coor.ne.2) call put_var(nout,
+     &                        'n_'//trim(noms(j))//'_sd',
+     &                        'n_'//trim(noms(j))//'_sd','cm-3',4,ierr,
+     &                           itau,nspecp_sd(1,1,1,iq))
+                endif
+              enddo
+            endif     
+          enddo
+        endif !endif writing data on Netcdf file 
+
+c Output at each time-step, ASCII file for IDL
+! =================================================================
+c In pressure and zareoid coordinates:
+
+      if (sor .ne. 1) then
+       do n=1,varoutsize
+         if(varout(n).eq.1) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((Tp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((Ta(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.2) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((up(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1)then
+               k=1221+n
+               write(k,124) ((ua(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif 
+         if(varout(n).eq.3) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((vp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((va(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.4) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(122,124) ((wp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((wa(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.5) then
+           do l=1,llm
+            if(coor.ne.2) then
+              k=121+n
+              write(k,124) ((rhop(i,j,l),i=1,iim),j=1,jjp1)
+            elseif(coor.ne.1) then
+               k=1221+n
+              write(k,124) ((rhoa(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.6) then
+           do iq=1,varspecsize
+             do l=1,llm
+               if(coor.ne.1) then
+                 k=1221+n+(iq-1)
+                 write(k,124) ((nspeca(i,j,l,iq),i=1,iim),j=1,jjp1)
+               endif
+             enddo
+           enddo
+         endif     
+       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((euva(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((cona(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((nira(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+      endif
+124   format(12(e10.4,1x))
+
+
+       ENDDO		!LOOP in TIME
+! =================================================================
+
+ 900   continue
+
+
+c  ECRITURE FINALE si besoin
+c  *************************
+      ierr= NF_CLOSE(nid)
+      ierr=NF_CLOSE(nout)
+      close (33)
+      close (122)
+      close (1222)
+       
+      ENDDO		!LOOP in FILES
+! =================================================================
+
+9999  PRINT*,'Fin '
+1000  format(a5,3x,i4,i3,x,a39)
+7777  FORMAT ('latitude/longitude',4f7.1)
+
+      END
+
+c*******************************************************
+
+      subroutine  xsig2p (ps,qsig,pref,npref,qp)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Francois Forget    Avril 1996
+c
+c Cette subroutine calcule les champs interpole en niveaux de pression
+c different niveaux de pression pref
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c  ARGUMENTS
+c  ---------
+
+c Inputs:
+      
+      REAL qsig(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1)
+      integer npref
+      real pref(npref)
+
+c outputs
+      REAL qp(iip1,jjp1,npref)
+
+
+c Variables du modele
+c -------------------
+
+      REAL lnp(llm)  , q(llm)
+      REAL x,y
+      INTEGER i,j,l ,n
+
+
+      logical firstcall
+      save firstcall
+      data firstcall/.true./
+ 
+#include "fxyprim.h"
+c**********************************************************************
+         if (firstcall) then
+           write(*,*) 'kappa = ', kappa
+           write(*,*) 'cpp = ', cpp
+           firstcall = .false.
+         end if
+
+        DO j=1,jjp1
+          DO i=1,iip1
+            do l=1,llm
+              lnp(l) = -log(aps(l)+bps(l)*ps(i,j))
+              q(l) = qsig(i,j,l)
+            end do
+            do n =1,npref
+              if ( (pref(n).le.ps(i,j)) .and.
+     &          (pref(n).ge.(ps(i,j)*bps(llm)+aps(llm))) ) then
+                    x = -log(pref(n))
+                    call interpolf(x,y,lnp,q,llm)
+                    qp(i,j,n) = y
+              else
+                    qp(i,j,n) = 1E+20 
+              end if
+            end do
+          ENDDO
+        ENDDO
+
+      return
+      end 
+
+      subroutine  missing_value(nout,nvarid,valid_range,missing)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+      include "netcdf.inc"
+
+      INTEGER nout,nvarid,ierr
+      REAL missing
+      REAL valid_range(2)
+c
+c  ARGUMENTS
+c  ---------
+
+c Inputs:
+      
+             ierr= NF_PUT_ATT_REAL(nout,nvarid,'valid_range',
+     $  NF_FLOAT,2,valid_range)
+        IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'anl_NC: valid_range attribution failed'
+            WRITE(*,*) 'NF_NOERR', NF_NOERR
+            CALL abort
+        ENDIF
+
+#ifdef NC_DOUBLE
+             ierr= NF_PUT_ATT_DOUBLE(nout,nvarid,'missing_value',
+     $  NF_DOUBLE,1,missing)
+#else
+              ierr= NF_PUT_ATT_REAL(nout,nvarid,'missing_value',
+     $  NF_FLOAT,1,missing)
+
+#endif
+
+        IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'anl_NC: missing value attribution failed'
+            WRITE(*,*) 'NF_NOERR', NF_NOERR
+            CALL abort
+        ENDIF
+      return
+      end
+**********************************************************
+      subroutine lect_var(nid,name,nbdim,ierr,itau,
+     $ var)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c inputs
+      character (len=*) :: name
+      INTEGER nid,nbdim,nvarid,ierr,itau
+      integer, dimension(nbdim) :: edges,corner
+c output var
+      integer, dimension(nbdim) :: var
+c  ---------
+        if (nbdim.eq.4) then
+         corner=(/1,1,1,itau/)
+         edges=(/iip1,jjp1,llm,1/)
+        endif
+
+        if (nbdim.eq.3) then
+            corner=(/1,1,itau/)
+            edges=(/iip1,jjp1,1/)
+        endif
+
+
+          ierr = NF_INQ_VARID (nid,adjustl(name), nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,corner,edges, var)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,corner,edges, var)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            write(*,*) 'anl_NC: reading failed for ', name
+            CALL abort
+          ENDIF
+
+      return
+      end
+
+
+      subroutine put_var(nout,name,title,units,nbdim,ierr,itau,
+     $ var)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+      character (len=*) :: title,units,name
+      INTEGER nout,nbdim,nvarid,ierr,itau
+      integer, dimension(nbdim) :: edges,corner,id,var
+      REAL valid_range(2)
+      DATA valid_range /0., 300.0/
+c  ---------
+        if (nbdim.eq.4) then
+         ierr= NF_INQ_DIMID(nout,"longitude",id(1))
+         ierr= NF_INQ_DIMID(nout,"latitude",id(2))
+         ierr= NF_INQ_DIMID(nout,"altitude",id(3))
+         ierr= NF_INQ_DIMID(nout,"Time",id(4))
+         corner=(/1,1,1,itau/)
+         edges=(/iip1,jjp1,llm,1/)
+        endif
+
+        if (nbdim.eq.3) then
+             ierr= NF_INQ_DIMID(nout,"longitude",id(1))
+             ierr= NF_INQ_DIMID(nout,"latitude",id(2))
+             ierr= NF_INQ_DIMID(nout,"Time",id(3))
+            corner=(/1,1,itau/)
+            edges=(/iip1,jjp1,1/)
+        endif
+
+
+        ierr = NF_INQ_VARID (nout,adjustl(name), nvarid)
+          if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+! Creation de la variable si elle n'existait pas
+             write (*,*) "====================="
+             write (*,*) "creation de  ",name
+         call def_var(nout,adjustl(title),adjustl(name),adjustl(units),
+     $   nbdim,id,nvarid,ierr)
+          if (name.eq.'temp') then
+             ierr = NF_REDEF (nout)
+             call missing_value(nout,nvarid,valid_range,1E+20)
+             ierr = NF_ENDDEF(nout)
+          endif
+          endif
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VARA_DOUBLE(nout,nvarid,corner,edges,var)
+#else
+        ierr = NF_PUT_VARA_REAL(nout,nvarid,corner,edges,var)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+            write(*,*) 'anl_NC: writing failed for ',name
+            CALL abort
+        ENDIF
+
+                
+      return
+      end
+
+
+      Subroutine interpolf(x,y,xd,yd,nd)
+
+c******************************************************
+c   SUBROUTINE   (interpol)
+c interpolation, give y = f(x) with array xd,yd known, size nd
+
+c  Version with CONSTANT values oustide limits
+c**********************************************************
+
+
+c Variable declaration
+c --------------------
+c  Arguments :
+      real x,y
+      real xd(*),yd(*)
+      integer nd
+c  internal
+      integer i,j
+      real y_undefined
+
+c run
+c ---
+c      y_undefined=-999.999
+      y_undefined=1.e20
+
+      y=0.
+      if ((x.le.xd(1)).and.(x.le.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = y_undefined ! yd(1)
+        if (xd(1).ge.xd(nd)) y = y_undefined ! yd(nd)
+      else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = y_undefined ! yd(nd)
+        if (xd(1).ge.xd(nd)) y = y_undefined ! yd(1)
+c       y = yd(nd)
+      else
+        do i=1,nd-1
+         if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) )
+     &     .or. ( (x.le.xd(i)).and.(x.gt.xd(i+1)) ) ) then
+           y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i))
+           goto 99
+         end if
+        end do
+      end if
+
+c     write (*,*)' x , y' , x,y
+c     do i=1,nd
+c       write (*,*)' i, xd , yd' , xd(i),yd(i)
+c     end do
+c     stop
+
+ 99   continue
+
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/anl_stats-diag.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/anl_stats-diag.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/anl_stats-diag.F	(revision 2744)
@@ -0,0 +1,1377 @@
+      PROGRAM anldiag_nc
+      IMPLICIT NONE
+c======================================================================
+c
+c
+c Program designed to read output files from the MARS gcm
+c or the Mars Climate database.
+c
+c    Francois Forget 1999
+c    Version used by monica to interpolate in zaeroid and p coordinate
+
+c
+c=======================================================================
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "description.h"
+#include "netcdf.inc"
+
+      INTEGER itau,nbpas,nbpasmx, coor,sor,varoutsize
+      integer varspecsize
+      integer varout(6),varspec(nqmx)
+      integer itau0
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx),y
+      INTEGER unitlec
+      INTEGER i,j,l,irec,itautot,ierr,iq,n,ff,k
+      real, dimension(:),allocatable :: lat,lon,alt
+      integer:: nout,latdimout,londimout,altdimout,timedimout,timevarout
+      integer:: latdim,londim,altdim,dimid
+      integer:: latvar,lonvar,altvar,timevar
+      integer:: latlen,lonlen,altlen,timelen
+      integer, dimension(4) :: edges,corner,id
+      integer, dimension(3) :: edges2,corner2
+
+      INTEGER   unit,nvarid,nid,varid
+      REAL mugaz
+
+      REAL missing
+      PARAMETER(missing=1E+20)
+      REAL valid_range(2)
+      DATA valid_range /0., 300.0/
+c   variables meteo dans la grille verticale GCM
+c   --------------------------------------------
+      REAL v(iip1,jjp1,llm),u(iip1,jjp1,llm),w(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm),rho(iip1,jjp1,llm),phi(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1) , tsurf(iip1,jjp1)
+      REAL Rnew(iip1,jjp1,llm)
+      real euv(iip1,jjp1,llm),con(iip1,jjp1,llm),nir(iip1,jjp1,llm)
+      real nspec(iip1,jjp1,llm,nqmx),spec(iip1,jjp1,llm)
+
+      REAL v_sd(iip1,jjp1,llm),u_sd(iip1,jjp1,llm)
+      real w_sd(iip1,jjp1,llm),t_sd(iip1,jjp1,llm)
+      real rho_sd(iip1,jjp1,llm)
+      real euv_sd(iip1,jjp1,llm),con_sd(iip1,jjp1,llm)
+      real nir_sd(iip1,jjp1,llm)
+      real nspec_sd(iip1,jjp1,llm,nqmx)
+
+c   ALtitude of the GCM levels (+1 dummy "thermosphere level")
+c   -------------------------
+      REAL zlocal(iip1,jjp1,llm+1) ! altitude above the local surface (m)
+      REAL zareoid(iip1,jjp1,llm+1) ! altitude above the mola areoid (m)
+      real tmean   ! use to integrate hydrostatic equation
+      real sig_therm ! dummy "thermosphere level" as in atmemcd.F
+      real T_therm
+
+c   variables meteo en coordonnee de pression
+c   --------------------------------------------
+      REAL vp(iip1,jjp1,llm),up(iip1,jjp1,llm),wp(iip1,jjp1,llm)
+      REAL tp(iip1,jjp1,llm),rhop(iip1,jjp1,llm)
+      REAL nspecp(iip1,jjp1,llm,nqmx)
+      REAL phip(iip1,jjp1,llm)
+      
+      REAL vp_sd(iip1,jjp1,llm),up_sd(iip1,jjp1,llm)
+      real wp_sd(iip1,jjp1,llm),tp_sd(iip1,jjp1,llm)
+      real rhop_sd(iip1,jjp1,llm),nspecp_sd(iip1,jjp1,llm,nqmx)
+ 
+c     Niveaux de pression (Pa)
+      real pref(llm)
+
+c    Version 32 layers : ************
+      data pref/
+     &1000.,884., 783. , 610., 475, 370, 288, 224, 174, 140.,
+     &115 , 80.6481, 48.0445, 26.6881, 14.1462, 7.29102, 3.70004,
+     &1.86241, 0.933516, 0.466924, 0.233296, 0.116503, 5.81631E-02,
+     & 2.90335E-02,1.44919E-02, 7.23328E-03, 3.61027E-03, 1.80193E-03,
+     & 8.99364E-04,4.48881E-04, 2.15769E-04, 1.3E-04/
+
+c    Version 50 layers : ************
+c      data pref/
+c     &1000.,884., 783. , 610., 475, 370, 288, 224, 174, 140.,
+c     &115 , 80.6481, 48.0445, 26.6881, 14.1462, 7.29102, 3.70004,
+c     &1.86241, 0.933516, 0.466924, 0.233296, 0.116503, 5.81631E-02,
+c     & 2.90335E-02,1.44919E-02, 7.23328E-03, 3.61027E-03, 1.80193E-03,
+c     & 8.99364E-04,4.48881E-04, 2.15769E-04, 1.3E-04,
+c     & 7.23328e-05, 3.61027e-05, 1.80193e-05, 8.99364e-06,
+c     & 4.48881e-06, 2.15769e-06, 1.3e-06,
+c     & 7.23328e-07, 3.61027e-07, 1.80193e-07, 8.99364e-08,
+c     & 4.48881e-08, 2.15769e-08, 1.3e-08,
+c     & 7.23328e-09, 3.61027e-09, 1.80193e-09, 8.99364e-10/
+
+c      data pref/
+c     &1000.,884., 783. , 610., 475, 370, 288, 224, 174, 140.,
+c     &115 , 80.6481, 48.0445, 26.6881, 14.1462, 7.29102, 3.70004,
+c     &1.86241, 0.933516, 0.466924, 0.233296, 0.116503, 5.81631E-02,
+c     & 2.90335E-02,1.44919E-02 / 
+c       data pref/
+c     & 101.4369,94.4369,87.4369,80.4369,73.4369,66.4369,59.4369,52.4369,
+c     & 45.4369,38.4369,31.5527,25.0626,18.9666,13.5138,8.97780,
+c     & 5.54010,3.19040,1.73630,0.907000,0.460400,0.228200,0.109700,
+c     & 0.0500,0.0200,0.0050/
+c   variables meteo en coordonnee de zareoid
+c   --------------------------------------------
+      REAL va(iip1,jjp1,llm),ua(iip1,jjp1,llm),wa(iip1,jjp1,llm)
+      REAL ta(iip1,jjp1,llm),rhoa(iip1,jjp1,llm),ra(iip1,jjp1,llm)
+      real euva(iip1,jjp1,llm),cona(iip1,jjp1,llm),nira(iip1,jjp1,llm)
+      real nspeca(iip1,jjp1,llm,nqmx)
+
+      REAL va_sd(iip1,jjp1,llm),ua_sd(iip1,jjp1,llm)
+      real wa_sd(iip1,jjp1,llm),ta_sd(iip1,jjp1,llm)
+      real rhoa_sd(iip1,jjp1,llm)
+      real euva_sd(iip1,jjp1,llm),cona_sd(iip1,jjp1,llm)
+      real nira_sd(iip1,jjp1,llm)
+      real nspeca_sd(iip1,jjp1,llm,nqmx)
+
+      REAL vij(llm),uij(llm),zaij(llm),wij(llm),rij(llm)
+      REAL tij(llm),rhoij(llm+1),sigij(llm)
+      real euvij(llm),conij(llm),nirij(llm)
+      real nspecij(llm+1,nqmx)
+
+      REAL vij_sd(llm),uij_sd(llm)
+      real wij_sd(llm),tij_sd(llm),rhoij_sd(llm+1)
+      real euvij_sd(llm),conij_sd(llm),nirij_sd(llm)
+      real nspecij_sd(llm+1,nqmx)
+
+c     Niveaux de zareoide (m)
+      real zaref(llm)
+      real p_zaref,p_zaij(llm+1) ! used to interpolate rho
+
+c   Surface data (sometime needed for some analysis):
+c   ------------------------------------------------
+      character relief*3
+      real phis(iip1,jjp1)
+      real alb(iip1,jjp1),ith(iip1,jjp1)
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+
+
+      real utime
+      real localtime(iip1)
+      common/temporaire/localtime
+
+      INTEGER*4 day0
+      integer nmoy(jjp1,llm),tp1,tp2,pass
+
+      CHARACTER*1 yes,yescomp
+
+      integer iformat
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER nomfich*60
+      CHARACTER nomfile(2)*60,nomfileout(2)*60
+      integer fichsize,fstats
+      CHARACTER fdiag*60
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL inifilr,exner
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c   Dust
+c   ----
+
+#include "fxyprim.h"
+
+      character*10  noms(nqmx),varnoms(6)
+      data          noms/"co2","co","o","o1d","o2","o3","h","h2",
+     $                   "oh","ho2","h2o2", "n2", "h2o"/
+      data          varnoms/"T","U","V","W","RHO","Species"/
+
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      unitlec=11
+      itautot=0
+
+
+c     Lecture du fichier a lire
+c     -------------------------
+
+      print*,' ' 
+      PRINT*,'File to process: 1)DIAGFI 2)STATS 3)BOTH'
+      READ(5,'(i)') fichsize
+      if(fichsize.ne.2)then
+        i=1
+        PRINT*,'   enter name of diagfi file (w/o .nc)'
+        READ(5,'(a)') nomfile(i)
+        fdiag=nomfile(i)
+        PRINT*,'   do you want to rename the output file?  
+     &  1) Yes  2) No'
+        READ(5,'(i)') sor
+        if (sor.eq.1) then
+          PRINT*,'   enter label for output file'
+          READ(5,'(a)') nomfileout(i)
+        elseif(sor.eq.2) then
+          nomfileout(i)=nomfile(i)
+        endif
+      endif
+      if(fichsize.ne.1)then
+        i=i+1
+        PRINT*,'   enter name of stats file (w/o .nc)'
+        READ(5,'(a)') nomfile(i)
+        PRINT*,'   do you want to rename the output file?  
+     &  1) Yes  2) No'
+        READ(5,'(i)') sor
+        if (sor.eq.1) then
+          PRINT*,'   enter label for output file'
+          READ(5,'(a)') nomfileout(i)
+        elseif(sor.eq.2) then
+          nomfileout(i)=nomfile(i)
+        endif
+        if(fichsize.eq.2) then
+          PRINT*,'   enter name of diagfi file for controle (w/o .nc)'
+          read(5,'(a)') fdiag
+        endif
+        fstats=1
+      endif
+      if (fichsize.ge.2) fichsize=fichsize-1
+      print*,' '
+      print*,'Output in: 1) netcdf 2) IDL 3) both ?'
+      READ(5,'(i)') sor
+      print*,' '
+      print*,'Coordinates in: 1) pressure 2) Zareoid 3) both  ?'
+      READ(5,'(i)') coor
+      print*,' '
+      print*,'Fields:  T  U  V  W  Rho  Species  All   ?'
+      print*,'Type total number of desired outputs or 6 for All   '
+      READ(5,'(i)') varoutsize
+      if(varoutsize.lt.6) then
+        print*,' '
+        print*,'Fields:  T  U  V  W  Rho  Species '
+        print*,'  #   :  1  2  3  4   5      6'
+        print*,' '
+        do i=1,varoutsize
+          print*,'Type number of variable ',i
+          READ(5,'(i)') varout(i)
+        enddo
+      endif
+      if(varoutsize.eq.6) then
+        do i=1,6
+          varout(i)=i
+        enddo
+      endif
+      do i=1,varoutsize
+        if (varout(i).eq.6) then
+           print*,'Type total number of desired species or 13 for All'
+           READ(5,'(i2)') varspecsize
+           if(varspecsize.ne.13) then
+             print*,' '
+             print*,'Select Species: CO2 CO O O(1D) O2 O3' 
+             print*,'                 1  2  3   4   5  6'
+             print*,'                 H H2 OH HO2 H2O2 N2 H2O'
+             print*,'                 7 8  9  10   11  12 13'
+             do n=1,varspecsize
+               print*,'Type number of species ',i
+               read(5,'(i)') varspec(n)
+             enddo
+           else
+             do n=1,varspecsize
+               varspec(n)=n
+             enddo
+           endif
+         endif
+       enddo
+      if(varoutsize.gt.6) print*,'Value must be <= 6'
+     
+
+! LOOP ON FILES
+! =================================================================
+      do ff=1,fichsize
+ 
+      file=nomfile(ff)  
+      nomfich=nomfile(ff)  
+      file=file(1:lnblnk(file))
+      PRINT*,'file',file
+
+c     Ouverture fichiers :
+c     ------------------
+      write(*,*) "opening "//trim(nomfich)//"..."
+      ierr = NF_OPEN(trim(adjustl(nomfich))//".nc",NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening file '//nomfich
+         stop ""
+      endif
+
+! Control & lecture on dimensions
+! =================================================================
+      ierr=NF_INQ_DIMID(nid,"latitude",latdim)
+      ierr=NF_INQ_VARID(nid,"latitude",latvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <latitude> is missing'
+      stop ""
+      endif
+      ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+!  write(*,*) "latlen: ",latlen
+
+      ierr=NF_INQ_DIMID(nid,"longitude",londim)
+      ierr=NF_INQ_VARID(nid,"longitude",lonvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <longitude> is lacking'
+      stop ""
+      endif
+      ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
+!  write(*,*) "lonlen: ",lonlen
+
+      ierr=NF_INQ_DIMID(nid,"altitude",altdim)
+      ierr=NF_INQ_VARID(nid,"altitude",altvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <altitude> is lacking'
+      stop ""
+      endif
+
+      ierr=NF_INQ_DIMLEN(nid,altdim,altlen)
+!  write(*,*) "altlen: ",altlen
+
+      if (ff.eq.1) then
+        allocate(lat(latlen))
+        allocate(lon(lonlen))
+        allocate(alt(altlen))
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid,latvar,lat)
+      ierr = NF_GET_VAR_DOUBLE(nid,lonvar,lon)
+      ierr = NF_GET_VAR_DOUBLE(nid,altvar,alt)
+#else
+      ierr = NF_GET_VAR_REAL(nid,latvar,lat)
+      ierr = NF_GET_VAR_REAL(nid,lonvar,lon)
+      ierr = NF_GET_VAR_REAL(nid,altvar,alt)
+#endif
+
+c   Lecture Time :
+
+      ierr= NF_INQ_DIMID (nid,"Time",dimid)
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'anl_NC: Le champ <Time> est absent'
+          CALL abort
+        ENDIF
+
+      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'anl_NC: Lecture echouee pour <Time>'
+          CALL abort
+        ENDIF
+        PRINT*,'temps',(temps(itau),itau=1,10)
+! =================================================================
+
+! SETTING OUTPUT FILES
+
+      file=nomfileout(ff)  
+      nomfich=nomfileout(ff)  
+      file=file(1:lnblnk(file))
+
+c    layers in zareoid : ************
+          do l=0,llm-1
+            zaref(l+1)=4500.*l
+            alt(l+1)=zaref(l+1)/1000.
+          enddo 
+
+! =================================================================
+! Output in netcdf
+! =================================================================
+      if (sor.ne.2) then
+
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+ 
+          ierr = NF_CREATE(trim(adjustl(nomfich))//"_P.nc",
+     &                     NF_CLOBBER, nout)
+          if (ierr.NE.NF_NOERR) THEN
+            write(*,*)' Pb d''ouverture du fichier '
+            write(*,*)' ierr = ', ierr
+            STOP
+          ENDIF
+          ierr = NF_PUT_ATT_TEXT(nout, NF_GLOBAL, "title", 24,
+     &                          "Pressure coordinates ")
+          ierr = NF_DEF_DIM(nout,"latitude", size(lat), latdimout)
+          ierr = NF_DEF_DIM(nout,"longitude", size(lon), londimout)
+          ierr = NF_DEF_DIM(nout,"altitude", size(pref), altdimout)
+          ierr = NF_DEF_DIM(nout,"Time", NF_UNLIMITED, timedimout)
+          ierr = NF_ENDDEF(nout)
+
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES 
+
+          ierr = NF_CREATE(trim(adjustl(nomfich))//"_Z.nc",
+     &                     NF_CLOBBER, nout)
+          IF(ierr.NE.NF_NOERR) THEN
+            write(*,*)' Pb d''ouverture du fichier '
+            write(*,*)' ierr = ', ierr
+            STOP
+          ENDIF
+          ierr = NF_PUT_ATT_TEXT(nout, NF_GLOBAL, "title", 24,
+     &                           "zaeroid coordinates")
+          ierr = NF_DEF_DIM(nout,"latitude", size(lat), latdimout)
+          ierr = NF_DEF_DIM(nout,"longitude", size(lon), londimout)
+          ierr = NF_DEF_DIM(nout,"altitude ", size(pref), altdimout)
+          ierr = NF_DEF_DIM(nout,"Time", NF_UNLIMITED, timedimout)
+          ierr = NF_ENDDEF(nout)
+
+        endif
+
+        call def_var(nout,"Time","Time","days since 0000-00-0
+     &  00:00:00",1,(/timedimout/),timevarout,ierr)
+
+        ierr = NF_REDEF (nout)       
+        call def_var(nout,"latitude","latitude","degrees_north",1,
+     &               (/latdimout/),nvarid,ierr)
+
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,lat)
+#else
+        ierr = NF_PUT_VAR_REAL (nout,nvarid,lat)
+#endif
+        ierr = NF_REDEF (nout) 
+        call def_var(nout,"longitude","East longitude","degrees_east",1,
+     &               (/londimout/),nvarid,ierr)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,lon)
+#else
+        ierr = NF_PUT_VAR_REAL (nout,nvarid,lon)
+#endif
+        ierr = NF_REDEF (nout)
+
+        if(coor.ne.2) then 					! PRESSURE CCOORDINATES
+#ifdef NC_DOUBLE
+          ierr = NF_DEF_VAR (nout,"altitude",NF_DOUBLE,1,
+     &                       (/altdimout/), nvarid)
+#else
+          ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,
+     &                       (/altdimout/),nvarid)
+#endif
+
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",22,"altitude
+     &                            pression")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"Pa")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',4,"down")
+          ierr = NF_ENDDEF(nout)
+#ifdef NC_DOUBLE
+          ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,pref)
+#else
+          ierr = NF_PUT_VAR_REAL (nout,nvarid,pref)
+#endif
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES 
+
+#ifdef NC_DOUBLE
+          ierr = NF_DEF_VAR (nout,"altitude",NF_DOUBLE,1,
+     &                       (/altdimout/), nvarid)
+#else
+          ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,
+     &                       (/altdimout/),nvarid)
+#endif
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",20,"altitude
+     &                           zaeroid")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"km")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',2,"up")
+          ierr = NF_ENDDEF(nout)
+#ifdef NC_DOUBLE
+          ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,alt)
+#else
+          ierr = NF_PUT_VAR_REAL (nout,nvarid,alt)
+#endif
+        endif
+
+      endif !end if netcdf  
+
+! Output in idl
+! =================================================================
+      if (sor.ne.1) then
+
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+          do i=1,varoutsize
+            j=121+i
+            if(varout(i).eq.6) then
+              do iq=1,varspecsize
+                file=trim(nomfileout(ff))//'_P_'
+     &               //trim(noms(iq))//'.dat'  
+                j=121+i+(iq-1)
+                open(j,file=trim(file), status='unknown')
+                write(j,117) noms(iq) 
+                write(j,120) iim,jjp1,llm
+                write(j,119) lon
+                write(j,119) lat
+                write(j,119) pref
+              enddo
+            else
+              file=trim(nomfileout(ff))//'_P_'
+     &            //trim(varnoms(varout(i)))//'.dat'  
+              open(j,file=trim(file), status='unknown')
+              write(j,117) varnoms(varout(i)) 
+              write(j,120) iim,jjp1,llm
+              write(j,119) lon
+              write(j,119) lat
+              write(j,119) pref
+            endif
+          enddo 
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES
+          do i=1,varoutsize
+            j=1221+i
+            if(varout(i).eq.6) then
+              do iq=1,varspecsize
+                file=trim(nomfileout(ff))//'_Z_'
+     &               //trim(noms(iq))//'.dat'  
+                j=1221+i+(iq-1)
+                open(j,file=trim(file), status='unknown')
+                write(j,117) noms(iq)
+                write(j,120) iim,jjp1,llm
+                write(j,119) lon
+                write(j,119) lat
+                write(j,119) alt
+              enddo
+            else
+              file=trim(nomfileout(ff))//'_Z_'
+     &            //trim(varnoms(varout(i)))//'.dat'  
+              open(j,file=trim(file), status='unknown')
+              write(j,117) varnoms(varout(i))
+              write(j,120) iim,jjp1,llm
+              write(j,119) lon
+              write(j,119) lat
+              write(j,119) alt
+            endif
+          enddo
+              
+c              file=trim(nomfileout(ff))
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_EUV.dat',
+c     &               status='unknown')
+c              write(j,117) 'EUV'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_CON.dat',
+c     &               status='unknown')
+c              write(j,117) 'CONDUCTION'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_NIR.dat',
+c     &               status='unknown')
+c              write(j,117) 'NIR'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+        endif
+
+      endif
+120    format(3i3)
+119    format(12(e10.4,1x))
+118    format(2i3)
+117    format(6(a7))
+116    format(13(a6))
+! =================================================================
+ 
+
+800   continue ! LOOP SUR LES FICHIERS
+
+
+! =================================================================
+! INITIALIZATION OF PARAMETERS
+! =================================================================
+
+      rad=3397200.              ! rayon de mars (m)  ~3397200 m
+      daysec=88775.             ! duree du sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec) ! vitesse de rotation (rad.s-1)
+      g=3.72                    ! gravite (m.s-2) ~3.72
+      mugaz=43.49               ! Masse molaire de l'atm (g.mol-1) ~43.49
+      kappa=.256793             ! = r/cp  ~0.256793
+      r = 191.18213
+      pi=2.*asin(1.)
+      ecritphy =1
+      iphysiq=1
+      day_ini=0.
+      day_step=1
+
+      CALL readhead_NC(trim(adjustl(fdiag))//".nc",day0,phis,R)
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+c  Dummy "thermosphere level" as in atmemcd (extrapol above top GCM level)
+      sig_therm=bps(llm)*exp(-20./7.)
+      T_therm = 200.  ! temperature (K) of the "thermosphere level"
+
+   
+c     If needed : getting topography, albedo, thermal inertia...
+c     -------------------------------------------------------
+c     "phis" is the surface geopotential = topography (m) * g 
+       relief='mola'    ! Topography MOLA par defaut
+
+c       CALL datareadnc(relief,phis,alb,ith,zmeaS,zstdS,zsigS,zgamS,
+c     .          ztheS)
+
+
+! =================================================================
+! LOOP IN TIME
+! =================================================================
+
+      DO itau=1,nbpas
+
+! FILE READING
+! =================================================================
+        print*,'Timestep = ',itau,'/',nbpas
+
+c        call lect_var(nid,'tsurf',3,ierr,itau,	tsurf)
+        call lect_var(nid,'ps',3,ierr,itau,		ps)
+
+        call lect_var(nid,'temp',4,ierr,itau,	t)
+        call lect_var(nid,'u',4,ierr,itau,		u)
+        call lect_var(nid,'v',4,ierr,itau,		v)
+c        call lect_var(nid,'w',4,ierr,itau,		w)
+c        call lect_var(nid,'rho',4,ierr,itau,	rho)
+        do l=1,llm
+          do j=1,jjp1
+            do i=1,iip1
+              Rnew(i,j,l)=8.314/mugaz*1.e3 
+! A enregistrer lors du run pour pouvoir le lire avec la ligne dessous
+            enddo
+          enddo
+        enddo
+c        call lect_var(nid,'r',4,ierr,itau,		Rnew)
+c        call lect_var(nid,'euv',4,ierr,itau,	euv)
+c        call lect_var(nid,'cond',4,ierr,itau,	con)
+c        call lect_var(nid,'nir',4,ierr,itau,	nir)
+        do n=1,varspecsize
+          i=varspec(n)
+        call lect_var(nid,'n_'//trim(noms(i)),4,ierr,itau,	spec)
+        do l=1,llm
+          do j=1,jjp1
+            do i=1,iip1
+              nspec(i,j,l,n)=spec(i,j,l)
+            enddo
+          enddo
+        enddo
+        enddo
+
+        if(fstats*ff-fichsize .eq. 0) then
+          call lect_var(nid,'temp_sd',4,ierr,itau,	t_sd)
+          call lect_var(nid,'u_sd',4,ierr,itau,		u_sd)
+          call lect_var(nid,'v_sd',4,ierr,itau,		v_sd)
+c          call lect_var(nid,'w_sd',4,ierr,itau,		w_sd)
+c          call lect_var(nid,'rho_sd',4,ierr,itau,	rho_sd)
+          do n=1,varspecsize
+            i=varspec(n)
+            call lect_var(nid,'n_'//trim(noms(i))//'_sd',4,ierr,
+     &                    itau,	spec)
+            do l=1,llm
+              do j=1,jjp1
+                do i=1,iip1
+                  nspec_sd(i,j,l,n)=spec(i,j,l)
+                enddo
+              enddo
+            enddo
+          enddo
+        endif
+! =================================================================
+
+! COMPUTING ALTITUDE OF GCM LEVELS IN GCM GRID
+! =================================================================
+c      zlocal 	! altitude above the local surface (m)
+c      zareoid 	! altitude above the mola areoid (m)
+
+        do j=1,jjp1
+          do i=1,iip1
+            sigij(1)=aps(1)/ps(i,j)+bps(1)
+            zlocal(i,j,1)=-log(sigij(1))* Rnew(i,j,1)*t(i,j,1)/g
+c            phis(i,j)=0.0
+c            phi(i,j,1)=phis(i,j)
+c            rho(i,j,1)=sigij(1)*ps(i,j)/(Rnew(i,j,1)*t(i,j,1))
+            zareoid(i,j,1) = zlocal(i,j,1) + phis(i,j)/g
+            do l=2,llm
+              sigij(l)=aps(l)/ps(i,j)+bps(l)
+              tmean=t(i,j,l)
+              if(t(i,j,l).ne.t(i,j,l-1))
+     &          tmean=(t(i,j,l)-t(i,j,l-1))/log(t(i,j,l)/t(i,j,l-1))
+              zlocal(i,j,l)=zlocal(i,j,l-1) 
+     &                -log(sigij(l)/sigij(l-1))*Rnew(i,j,l-1)*tmean/g
+              zareoid(i,j,l) = zlocal(i,j,l) + phis(i,j)/g
+c              rho(i,j,l)=sigij(l)*ps(i,j)/(Rnew(i,j,l)*t(i,j,l))
+              phi(i,j,l)=zareoid(i,j,l)*g
+            enddo
+  
+c           Altitude of the dummy thermosphere level (as in atmemcd)   
+c           ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+            tmean=(T_therm-t(i,j,llm))/log(T_therm/t(i,j,llm))
+            zlocal(i,j,llm+1)=zlocal(i,j,llm) 
+     &                  -log(sig_therm/sigij(llm))*Rnew(i,j,llm)*tmean/g
+            zareoid(i,j,llm+1) = zlocal(i,j,llm+1) + phis(i,j)/g
+
+          enddo
+        enddo
+
+c            do l=1,llm
+c        print*,zareoid(32,24,l),zlocal(32,24,l),zaref(l)
+c        print*,zareoid(32,24,l),zaref(l)
+c            enddo
+
+c Local time
+c ----------
+c universal time (in stats oe MCD files)
+        utime = (itau-1)*2.
+
+c local time (in stats file)
+        DO i = 1,iim
+          localtime(i)=utime + 12.*rlonv(i)/pi
+          if(localtime(i).gt.24) localtime(i)=localtime(i)-24.
+          if(localtime(i).lt.0) localtime(i)=localtime(i)+24.
+        ENDDO
+
+c c Passage en niveaux de pression
+c ------------------------------
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+          call xsig2p (ps,T,pref,llm,Tp)
+          call xsig2p (ps,u,pref,llm,up)
+          call xsig2p (ps,v,pref,llm,vp)
+          call xsig2p (ps,w,pref,llm,wp)
+          call xsig2p (ps,rho,pref,llm,rhop)
+          do iq=1,varspecsize
+            call xsig2p (ps,nspec(1,1,1,iq),pref,llm,nspecp(1,1,1,iq))
+          enddo
+           if(fstats*ff-fichsize .eq. 0) then
+             call xsig2p (ps,u_sd,pref,llm,up_sd)
+             call xsig2p (ps,v_sd,pref,llm,vp_sd)
+             call xsig2p(ps,t_sd,pref,llm,Tp_sd)
+             call xsig2p (ps,w_sd,pref,llm,wp_sd)
+             call xsig2p (ps,rho_sd,pref,llm,rhop_sd)
+             do iq=1,varspecsize
+               call xsig2p (ps,nspec_sd(1,1,1,iq),pref,llm,
+     $                      nspecp_sd(1,1,1,iq))
+             enddo
+           endif
+         endif
+
+c c Passage en niveaux de zareoid
+c ------------------------------
+        if(coor.ne.1) then 					! ZAEROID COORDINATES
+        do j=1,jjp1
+          do i=1,iip1
+            do l=1,llm
+              Tij(l)=T(i,j,l)
+              uij(l)=u(i,j,l)
+              vij(l)=v(i,j,l)
+              wij(l)=w(i,j,l)
+              rhoij(l)=rho(i,j,l)
+              do iq=1,varspecsize
+                nspecij(l,iq)=nspec(i,j,l,iq)
+                if(l.eq.llm) nspecij(l+1,iq)=nspecij(l,iq)*1.e-3
+              enddo
+c              euvij(l)=euv(i,j,l)
+c              conij(l)=con(i,j,l)
+c              nirij(l)=nir(i,j,l)
+              zaij(l)=zareoid(i,j,l)
+              p_zaij(l)=exp(-zareoid(i,j,l)/1.e4) ! used to interpolate rho
+              if(fstats*ff-fichsize .eq. 0) then
+                Tij_sd(l)=T_sd(i,j,l)
+                uij_sd(l)=u_sd(i,j,l)
+                vij_sd(l)=v_sd(i,j,l)
+                wij_sd(l)=w_sd(i,j,l)
+                rhoij_sd(l)=rho_sd(i,j,l)
+                do iq=1,varspecsize
+                  nspecij_sd(l,iq)=nspec_sd(i,j,l,iq)
+                  if(l.eq.llm) nspecij_sd(l+1,iq)=nspecij_sd(l,iq)*1.e-3
+                enddo
+              endif
+            enddo
+            p_zaij(l+1)=exp(-zareoid(i,j,l+1)/1.e4) 
+c            rhoij(l+1)=sig_therm*ps(i,j)/(R*T_therm)!in dummy thermosphere
+            rhoij(l+1)=rhoij(llm)*1.e-3
+            rhoij_sd(l+1)=rhoij_sd(llm)*1.e-3
+
+            do l=1,llm
+              call interpolf(zaref(l),y,zaij,Tij,llm)
+              Ta(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,uij,llm)
+              ua(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,vij,llm)
+              va(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,wij,llm)
+              wa(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,euvij,llm)
+c              euva(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,conij,llm)
+c              cona(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,nirij,llm)
+c              nira(i,j,l)=y
+
+              p_zaref=exp(-zaref(l)/1.e4)
+              call interpolf(p_zaref,y,p_zaij,rhoij,llm+1)
+              rhoa(i,j,l)=y
+               
+              do iq=1,varspecsize
+                call interpolf(p_zaref,y,p_zaij,nspecij(1,iq),llm+1)
+c                call interpolf(zaref(l),y,zaij,nspecij(1,iq),llm)
+                nspeca(i,j,l,iq)=y
+              enddo
+
+              if(fstats*ff-fichsize .eq. 0) then
+                call interpolf(zaref(l),y,zaij,Tij_sd,llm)
+                Ta_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,uij_sd,llm)
+                ua_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,vij_sd,llm)
+                va_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,wij_sd,llm)
+                wa_sd(i,j,l)=y
+                call interpolf(p_zaref,y,p_zaij,rhoij_sd,llm+1)
+                rhoa_sd(i,j,l)=y
+                do iq=1,varspecsize
+                  call interpolf(p_zaref,y,p_zaij,nspecij_sd(1,iq),
+     &                           llm+1)
+c                  call interpolf(zaref(l),y,zaij,nspecij_sd(1,iq),llm)
+                  nspeca_sd(i,j,l,iq)=y
+                enddo
+              endif
+
+            enddo
+          enddo
+        enddo
+
+c            do l=1,llm
+c        print*,T(32,24,l),Ta(32,24,l)
+c        print*,nspec(32,24,l,1),nspeca(32,24,l,1)
+c            enddo
+
+        endif
+ 
+c Output at each time-step, in netcdf format
+! =================================================================
+        if (sor .ne. 2) then
+
+          ierr= NF_INQ_VARID(nout,"Time",nvarid)
+#ifdef NC_DOUBLE
+          ierr= NF_PUT_VARA_DOUBLE(nout,nvarid,itau,1,temps(itau))
+#else
+          ierr= NF_PUT_VARA_REAL(nout,nvarid,itau,1,temps(itau))
+#endif
+          if (ierr.ne.NF_NOERR) then
+            write(*,*) "time problem ",NF_STRERROR(ierr)
+            stop
+          endif
+
+          if (varoutsize.eq.6) n=1
+          if (varoutsize.ne.6) n=varoutsize
+          do i=1,n
+            if(varout(i).eq.1 .or. varoutsize.eq.6) then
+             if(coor.ne.1) 
+     &          call put_var(nout,'temp','temp','K',4,ierr,itau,Ta)
+             if(coor.ne.2) 
+     &          call put_var(nout,'temp','temp','K',4,ierr,itau,Tp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'temp_sd','temp_sd','K',
+     &                                      4,ierr,itau,Ta_sd)
+                if(coor.ne.2) call put_var(nout,'temp_sd','temp_sd','K',
+     &                                      4,ierr,itau,Tp_sd)
+              endif
+            endif
+            if(varout(i).eq.2 .or. varoutsize.eq.6)  then
+              if(coor.ne.1) 
+     &          call put_var(nout,'u','u','m s-1',4,ierr,itau,ua)
+              if(coor.ne.2) 
+     &          call put_var(nout,'u','u','m s-1',4,ierr,itau,up)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'u_sd','u_sd','m s-1',
+     &                                      4,ierr,itau,ua_sd)
+                if(coor.ne.2) call put_var(nout,'u_sd','u_sd','m s-1',
+     &                                      4,ierr,itau,up_sd)
+              endif
+            endif
+            if(varout(i).eq.3 .or. varoutsize.eq.6) then
+              if(coor.ne.1) 
+     &          call put_var(nout,'v','v','m s-1',4,ierr,itau,va)
+              if(coor.ne.2) 
+     &          call put_var(nout,'v','v','m s-1',4,ierr,itau,vp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'v_sd','v_sd','m s-1',
+     &                                      4,ierr,itau,va_sd)
+                if(coor.ne.2) call put_var(nout,'v_sd','v_sd','m s-1',
+     &                                      4,ierr,itau,vp_sd)
+              endif
+            endif
+            if(varout(i).eq.4 .or. varoutsize.eq.6) then
+              if(coor.ne.1) 
+     &          call put_var(nout,'w','w','m s-1',4,ierr,itau,wa)
+              if(coor.ne.2) 
+     &          call put_var(nout,'w','w','m s-1',4,ierr,itau,wp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'w_sd','w_sd','m s-1',
+     &                                      4,ierr,itau,wa_sd)
+                if(coor.ne.2) call put_var(nout,'w_sd','w_sd','m s-1',
+     &                                      4,ierr,itau,wp_sd)
+              endif
+            endif
+            if(varout(i).eq.5 .or. varoutsize.eq.6)  then
+              if(coor.ne.1) call put_var(nout,'rho','rho','',4,ierr,
+     &                                    itau,rhoa)
+              if(coor.ne.2) call put_var(nout,'rho','rho','',4,ierr,
+     &                                    itau,rhop)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'rho_sd','rho_sd','',
+     &                                      4,ierr,itau,rhoa_sd)
+                if(coor.ne.2) call put_var(nout,'rho_sd','rho_sd','',
+     &                                      4,ierr,itau,rhop_sd)
+              endif
+            endif
+            if(varout(i).eq.6 .or. varoutsize.eq.6) then
+              do iq=1,varspecsize
+                j=varspec(iq)
+                if(coor.ne.1) call put_var(nout,'n_'//trim(noms(j)),
+     &       'n_'//trim(noms(j)),'cm-3',4,ierr,itau,nspeca(1,1,1,iq))
+                if(coor.ne.2) call put_var(nout,'n_'//trim(noms(j)),
+     &         'n_'//trim(noms(j)),'cm-3',4,ierr,itau,nspecp(1,1,1,iq))
+                if(fstats*ff-fichsize.eq.0) then
+                  if(coor.ne.1) call put_var(nout,
+     &                        'n_'//trim(noms(j))//'_sd',
+     &                        'n_'//trim(noms(j))//'_sd','cm-3',4,ierr,
+     &                           itau,nspeca_sd(1,1,1,iq))
+                  if(coor.ne.2) call put_var(nout,
+     &                        'n_'//trim(noms(j))//'_sd',
+     &                        'n_'//trim(noms(j))//'_sd','cm-3',4,ierr,
+     &                           itau,nspecp_sd(1,1,1,iq))
+                endif
+              enddo
+            endif     
+          enddo
+        endif !endif writing data on Netcdf file 
+
+c Output at each time-step, ASCII file for IDL
+! =================================================================
+c In pressure and zareoid coordinates:
+
+      if (sor .ne. 1) then
+       do n=1,varoutsize
+         if(varout(n).eq.1) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((Tp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((Ta(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.2) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((up(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1)then
+               k=1221+n
+               write(k,124) ((ua(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif 
+         if(varout(n).eq.3) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((vp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((va(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.4) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(122,124) ((wp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((wa(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.5) then
+           do l=1,llm
+            if(coor.ne.2) then
+              k=121+n
+              write(k,124) ((rhop(i,j,l),i=1,iim),j=1,jjp1)
+            elseif(coor.ne.1) then
+               k=1221+n
+              write(k,124) ((rhoa(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.6) then
+           do iq=1,varspecsize
+             do l=1,llm
+               if(coor.ne.1) then
+                 k=1221+n+(iq-1)
+                 write(k,124) ((nspeca(i,j,l,iq),i=1,iim),j=1,jjp1)
+               endif
+             enddo
+           enddo
+         endif     
+       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((euva(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((cona(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((nira(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+      endif
+124   format(12(e10.4,1x))
+
+
+       ENDDO		!LOOP in TIME
+! =================================================================
+
+ 900   continue
+
+
+c  ECRITURE FINALE si besoin
+c  *************************
+      ierr= NF_CLOSE(nid)
+      ierr=NF_CLOSE(nout)
+      close (33)
+      close (122)
+      close (1222)
+       
+      ENDDO		!LOOP in FILES
+! =================================================================
+
+9999  PRINT*,'Fin '
+1000  format(a5,3x,i4,i3,x,a39)
+7777  FORMAT ('latitude/longitude',4f7.1)
+
+      END
+
+c*******************************************************
+
+      subroutine  xsig2p (ps,qsig,pref,npref,qp)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Francois Forget    Avril 1996
+c
+c Cette subroutine calcule les champs interpole en niveaux de pression
+c different niveaux de pression pref
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c  ARGUMENTS
+c  ---------
+
+c Inputs:
+      
+      REAL qsig(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1)
+      integer npref
+      real pref(npref)
+
+c outputs
+      REAL qp(iip1,jjp1,npref)
+
+
+c Variables du modele
+c -------------------
+
+      REAL lnp(llm)  , q(llm)
+      REAL x,y
+      INTEGER i,j,l ,n
+
+
+      logical firstcall
+      save firstcall
+      data firstcall/.true./
+ 
+#include "fxyprim.h"
+c**********************************************************************
+         if (firstcall) then
+           write(*,*) 'kappa = ', kappa
+           write(*,*) 'cpp = ', cpp
+           firstcall = .false.
+         end if
+
+        DO j=1,jjp1
+          DO i=1,iip1
+            do l=1,llm
+              lnp(l) = -log(aps(l)+bps(l)*ps(i,j))
+              q(l) = qsig(i,j,l)
+            end do
+            do n =1,npref
+              if ( (pref(n).le.ps(i,j)) .and.
+     &          (pref(n).ge.(ps(i,j)*bps(llm)+aps(llm))) ) then
+                    x = -log(pref(n))
+                    call interpolf(x,y,lnp,q,llm)
+                    qp(i,j,n) = y
+              else
+                    qp(i,j,n) = 1E+20 
+              end if
+            end do
+          ENDDO
+        ENDDO
+
+      return
+      end 
+
+      subroutine  missing_value(nout,nvarid,valid_range,missing)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+      include "netcdf.inc"
+
+      INTEGER nout,nvarid,ierr
+      REAL missing
+      REAL valid_range(2)
+c
+c  ARGUMENTS
+c  ---------
+
+c Inputs:
+      
+             ierr= NF_PUT_ATT_REAL(nout,nvarid,'valid_range',
+     $  NF_FLOAT,2,valid_range)
+        IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'anl_NC: valid_range attribution failed'
+            WRITE(*,*) 'NF_NOERR', NF_NOERR
+            CALL abort
+        ENDIF
+
+#ifdef NC_DOUBLE
+             ierr= NF_PUT_ATT_DOUBLE(nout,nvarid,'missing_value',
+     $  NF_DOUBLE,1,missing)
+#else
+              ierr= NF_PUT_ATT_REAL(nout,nvarid,'missing_value',
+     $  NF_FLOAT,1,missing)
+
+#endif
+
+        IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'anl_NC: missing value attribution failed'
+            WRITE(*,*) 'NF_NOERR', NF_NOERR
+            CALL abort
+        ENDIF
+      return
+      end
+**********************************************************
+      subroutine lect_var(nid,name,nbdim,ierr,itau,
+     $ var)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c inputs
+      character (len=*) :: name
+      INTEGER nid,nbdim,nvarid,ierr,itau
+      integer, dimension(nbdim) :: edges,corner
+c output var
+      integer, dimension(nbdim) :: var
+c  ---------
+        if (nbdim.eq.4) then
+         corner=(/1,1,1,itau/)
+         edges=(/iip1,jjp1,llm,1/)
+        endif
+
+        if (nbdim.eq.3) then
+            corner=(/1,1,itau/)
+            edges=(/iip1,jjp1,1/)
+        endif
+
+
+          ierr = NF_INQ_VARID (nid,adjustl(name), nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,corner,edges, var)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,corner,edges, var)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            write(*,*) 'anl_NC: reading failed for ', name
+            CALL abort
+          ENDIF
+
+      return
+      end
+
+
+      subroutine put_var(nout,name,title,units,nbdim,ierr,itau,
+     $ var)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+      character (len=*) :: title,units,name
+      INTEGER nout,nbdim,nvarid,ierr,itau
+      integer, dimension(nbdim) :: edges,corner,id,var
+      REAL valid_range(2)
+      DATA valid_range /0., 300.0/
+c  ---------
+        if (nbdim.eq.4) then
+         ierr= NF_INQ_DIMID(nout,"longitude",id(1))
+         ierr= NF_INQ_DIMID(nout,"latitude",id(2))
+         ierr= NF_INQ_DIMID(nout,"altitude",id(3))
+         ierr= NF_INQ_DIMID(nout,"Time",id(4))
+         corner=(/1,1,1,itau/)
+         edges=(/iip1,jjp1,llm,1/)
+        endif
+
+        if (nbdim.eq.3) then
+             ierr= NF_INQ_DIMID(nout,"longitude",id(1))
+             ierr= NF_INQ_DIMID(nout,"latitude",id(2))
+             ierr= NF_INQ_DIMID(nout,"Time",id(3))
+            corner=(/1,1,itau/)
+            edges=(/iip1,jjp1,1/)
+        endif
+
+
+        ierr = NF_INQ_VARID (nout,adjustl(name), nvarid)
+          if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+! Creation de la variable si elle n'existait pas
+             write (*,*) "====================="
+             write (*,*) "creation de  ",name
+         call def_var(nout,adjustl(title),adjustl(name),adjustl(units),
+     $   nbdim,id,nvarid,ierr)
+          if (name.eq.'temp') then
+             ierr = NF_REDEF (nout)
+             call missing_value(nout,nvarid,valid_range,1E+20)
+             ierr = NF_ENDDEF(nout)
+          endif
+          endif
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VARA_DOUBLE(nout,nvarid,corner,edges,var)
+#else
+        ierr = NF_PUT_VARA_REAL(nout,nvarid,corner,edges,var)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+            write(*,*) 'anl_NC: writing failed for ',name
+            CALL abort
+        ENDIF
+
+                
+      return
+      end
+
+
+      Subroutine interpolf(x,y,xd,yd,nd)
+
+c******************************************************
+c   SUBROUTINE   (interpol)
+c interpolation, give y = f(x) with array xd,yd known, size nd
+
+c  Version with CONSTANT values oustide limits
+c**********************************************************
+
+
+c Variable declaration
+c --------------------
+c  Arguments :
+      real x,y
+      real xd(*),yd(*)
+      integer nd
+c  internal
+      integer i,j
+      real y_undefined
+
+c run
+c ---
+c      y_undefined=-999.999
+      y_undefined=1.e20
+
+      y=0.
+      if ((x.le.xd(1)).and.(x.le.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = y_undefined ! yd(1)
+        if (xd(1).ge.xd(nd)) y = y_undefined ! yd(nd)
+      else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = y_undefined ! yd(nd)
+        if (xd(1).ge.xd(nd)) y = y_undefined ! yd(1)
+c       y = yd(nd)
+      else
+        do i=1,nd-1
+         if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) )
+     &     .or. ( (x.le.xd(i)).and.(x.gt.xd(i+1)) ) ) then
+           y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i))
+           goto 99
+         end if
+        end do
+      end if
+
+c     write (*,*)' x , y' , x,y
+c     do i=1,nd
+c       write (*,*)' i, xd , yd' , xd(i),yd(i)
+c     end do
+c     stop
+
+ 99   continue
+
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/anldoppler2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/anldoppler2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/anldoppler2.F	(revision 2744)
@@ -0,0 +1,380 @@
+      PROGRAM anldoppler2
+      IMPLICIT NONE
+c======================================================================
+c
+c
+c Programme pour analyser vent a heure locale fixee
+c a partir d'un fichier Netcdf de la MCD
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "description.h"
+
+
+      INTEGER point
+      PARAMETER(point=11)     		! nbre de points d''observation
+      real olon(point),olat(point)	! Coordonnees des points observes
+      INTEGER iraie                	! pour le choix de la raie du CO
+
+c--------------------------------------------------------
+c coordonees lon/lat des points observes
+c--------------------------------------------------------
+
+c     ANNEE 2001
+
+      DATA olon/0,-30,30,0,-90,90,-75,75,0,-70,70/
+      DATA olat/-1,0,0,40,0,0,40,40,90,-40,40/
+
+c     ANNEE 1999
+
+c      DATA olon/0,0,-30,30,-85,85,0,-90,90,0,-65,65,0/
+c      DATA olat/18,-10,0,0,0,0,55,40,40,90,-40,-40,-70/
+
+c     ANNEE 1997
+
+c      DATA olon/0,-85,85,0,0/
+c      DATA olat/24,0,0,90,-70/
+
+c     ANNEE 1992
+
+c      DATA olon/0,-85,85,0,0,-75,75,-90,90,0,0/
+c      DATA olat/8,0,0,-40,40,-40,-40,40,40,90,-90/
+
+c     ANNEE 1990
+
+c      DATA olon/0,-90,90,0,0/
+c      DATA olat/-1,0,0,70,-90/
+
+c     ANNEE 1988
+
+c      DATA olon/0,-90,90,0,0,0,-35,35,0,0,-45,45,-60,60/
+c      DATA olat/-21,0,0,-90,60,0,0,0,-35,25,-35,-35,25,25/
+
+c----------------------------------------------------------
+
+      INTEGER mcdreadnc
+      external mcdreadnc
+      INTEGER itau,nbpas,nbpasmx
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx)
+      INTEGER unitlec
+      INTEGER i,j,l,itautot
+
+c   Declarations DRS:
+c   -----------------
+      INTEGER ierr, dimtype
+      CHARACTER*120 dimsou, dimnam*16, dimtit*80
+      CHARACTER*40 dimunit
+      CHARACTER*100  varname
+
+c   variables meteo dans la grille verticale GCM
+c   --------------------------------------------
+      REAL v(iip1,jjp1,llm),u(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1) , tsurf(iip1,jjp1)
+
+c   variables meteo en coordonnee de pression
+c   --------------------------------------------
+      REAL vp(iip1,jjp1,llm),up(iip1,jjp1,llm)
+      REAL tp(iip1,jjp1,llm)
+
+c     Niveaux de pression (Pa)
+      real pref(llm)
+
+c     version 25 couches
+
+c      data pref/1291.37,1005.720,783.255,600.,475.069,350.,
+c     &          288.144,174.768,106.002,64.2935,38.9960,
+c     &          23.6523,14.3458,8.70000,5.28000,3.20000,
+c     &          1.94000,1.18000,0.714000,0.433000,0.263000,
+c     &          0.118000,0.0614000,0.0333000,0.0163000/
+
+c     version 32 couches
+
+      data pref/1291.37,1005.720,783.255,600.,475.069,350.,
+     &          288.144,174.768,106.002,64.2935,38.9960,
+     &          23.6523,14.3458,8.70000,5.28000,3.20000,
+     &          1.94000,1.18000,0.714000,0.433000,0.263000,
+     &          0.118000,0.0614000,0.0333000,0.0163000, 
+     &          8.e-3,4.e-3,2.e-3,1.e-3,5.e-4,2.e-4,1.e-4/
+
+c   Local:
+c   ------
+      REAL phis(iip1,jjp1)
+      real utime,latst,lonst,tamp,hlst
+      real localtime(iip1),heure(iip1)
+      common/temporaire/localtime
+
+      INTEGER*4 day0
+c      integer nmoy(jjp1,llm),tp1,tp2,pass
+	
+
+      CHARACTER*1 yes
+
+      LOGICAL ldrs
+      integer iformat,nid
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER nomfich*60
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL inifilr,exner
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+      logical icdf,idrs
+
+c   Dust
+c   ----
+
+#include "fxyprim.h"
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      ldrs=.true.
+      unitlec=11
+      itautot=0
+      idrs=.false.
+      icdf=.false.
+
+c     Lecture du fichier a lire
+c     -------------------------
+
+      PRINT*,'entrer le nom du fichier NetCDF de la MCD'
+      READ(5,'(a)') nomfich
+      file=nomfich(1:lnblnk(nomfich))
+      PRINT*,'file',file
+
+
+c     Lecture des autres parametres du programme
+c     ------------------------------------------
+
+      write(*,*) 'Raie a simuler ? '
+      write(*,*)'[1]12CO(2-1) [2]:13CO(2-1) ',
+     &     ' [3]:12CO(1-0) [4]13CO(1-0) [5]H2O(183)'  
+      read(*,*) iraie
+
+      write(*,*) 'heure local du point subterrestre ? '
+      read(*,*) hlst
+
+      write(*,*) 'latitude du point subterrestre ? '
+      read(*,*) latst
+
+c---------------------------------------------------------
+c   Lecture des fichiers stats , diagfi ou histmoy
+c---------------------------------------------------------
+
+800   continue ! LOOP SUR LES FICHIERS
+
+c     Ouverture fichiers :
+c     ------------------
+
+c        Ouverture fichier NetCDF
+            ierr = NF_OPEN (file(1:lnblnk(file))//'.nc', NF_NOWRITE,nid)
+            IF (ierr.NE.NF_NOERR) THEN
+              write(6,*)' Pb d''ouverture du fichier ',file
+              write(6,*)' ierr = ', ierr
+              CALL abort
+            ENDIF
+     
+c----------------------------------------------------------------------
+c   initialisation de la physique:
+c   ------------------------------
+
+c initialisations aux valeurs martiennes
+
+      rad=3397200.              ! rayon de mars (m)  ~3397200 m
+      daysec=88775.             ! duree du sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec) ! vitesse de rotation (rad.s-1)
+      g=3.72                    ! gravite (m.s-2) ~3.72
+      mugaz=43.49               ! Masse molaire de l''atm (g.mol-1) ~43.49
+      kappa=.256793             ! = r/cp  ~0.256793
+      r = 191.18213
+      pi=2.*asin(1.)
+      ecritphy =1
+      iphysiq=1
+      day_ini=0.
+      day_step=1
+   
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+c   sigma aux niveaux s:
+
+      DO l=1,llm
+         print*,'sig_s(',l,')  =  ',sig_s(l)
+      ENDDO
+
+c      Format Grads (Stats) : On suppose que l'on a 12 pas de temps :
+c      --------------------
+
+      nbpas=12
+      print*,'nbpas=',nbpas
+
+c======================================================================
+c   debut de la boucle sur les etats dans un fichier histoire:
+c======================================================================
+
+       itau= 1
+
+801    continue ! LOOP SUR LES PAS DE TEMPS START HERE
+
+       varname='u'
+       ierr =mcdreadnc(nid,varname,llm,u,itau)
+       varname='v'
+       ierr =mcdreadnc(nid,varname,llm,v,itau)
+       varname='temp'
+       ierr =mcdreadnc(nid,varname,llm,t,itau)
+       varname='ps'
+       ierr =mcdreadnc(nid,varname,1,ps,itau)
+c      PRINT*,'ps',ps(iip1/2,jjp1/2)
+       varname='tsurf'
+       ierr =mcdreadnc(nid,varname,1,tsurf,itau)
+c      PRINT*,'tsurf',tsurf(iip1/2,jjp1/2)
+
+c**********************************************************
+c  Traitement des donnees : (we are in LOOP on timestep)
+c**********************************************************
+
+
+c universal time (in stats file)
+c-------------------------------
+      utime = (itau-1)*2.
+
+c Longitude du point subterrestre
+c -------------------------------
+
+      tamp=(hlst-utime)*(iip1/24.)
+      if(tamp.GT.iip1) then
+      tamp=tamp-iip1
+      endif
+      if(tamp.LT.0)  then
+      tamp=iip1+tamp
+      endif
+      lonst=rlonv(nint(tamp))*180./pi
+      write(*,*) hlst,latst,lonst
+
+       lonst=(hlst-utime)*15
+       if(lonst.gt.180) lonst=lonst-180.
+       if(lonst.lt.-180) lonst=lonst+180.
+       write(*,*) hlst,latst,lonst
+
+c Local time
+c ----------
+
+c local time (in stats file)
+            DO i = 1,iim
+              localtime(i)=utime + 12.*rlonv(i)/pi
+              if(localtime(i).gt.24) localtime(i)=localtime(i)-24.
+              if(localtime(i).lt.0) localtime(i)=localtime(i)+24.
+	      heure(i)=localtime(i)
+c	      if(itau.EQ.1) heure(i)=0.375*(i-1)
+c	      if(itau.EQ.1) print*,heure(i)
+            ENDDO
+
+c              if(itau.EQ.1) heure(iip1)=24.
+	       heure(iip1)=localtime(1)
+
+c ******************************************
+
+
+c c Passage en niveaux de pression
+c --------------------------------
+
+          call xsig2p (ps,T,pref,llm,Tp)
+          call xsig2p (ps,u,pref,llm,up)
+          call xsig2p (ps,v,pref,llm,vp)
+
+c         Test temporaire
+c          do l=1, llm
+c             write(77,*) pref(l),up(1,1,l)
+c          end do
+
+c Traitement des donnees -> creation de spectres synthetiques
+c -----------------------------------------------------------
+
+c calcul des vitesses projetees
+
+      do l=1,llm
+         do j=1,jjp1
+            do i=1,iip1
+
+
+               up(i,j,l)=(242.*cos(rlatu(j))+up(i,j,l))*
+     .              sin(rlonv(i)-lonst*pi/180)*cos(latst*pi/180)
+
+
+           vp(i,j,l)=vp(i,j,l)*(cos(rlonv(i)-lonst*pi/180)*sin(rlatu(j))
+     .    *cos(latst*pi/180)-sin(latst*pi/180)*cos(rlatu(j)))
+
+
+            enddo
+         enddo
+      enddo
+
+c synthese des spectres
+
+c	print*,'itau=',itau,nbpas
+
+      call spectre2(itau,iraie,latst,lonst,olon,olat,
+     .vp,up,tp,ps,tsurf)
+
+
+	
+c  Fin de la boucle sur les pas de temps ? : (we are in LOOP on timestep)
+c  ****************************************
+
+      itau=itau+1
+
+      if(itau.gt.nbpas) then
+         ierr = NF_CLOSE(nid)
+         write(*,*) 'Si vous voulez entrer un nouveau fichier'
+         print*,'entrez son nom. Sinon, RETURN'
+            READ(5,'(a)') nomfich
+         if (nomfich(1:lnblnk(nomfich)).eq."") then
+            print*,'OK, on termine la'
+         else
+            file=nomfich(1:lnblnk(nomfich))
+            PRINT*,'file',file
+            goto 800
+         endif
+      else
+         goto 801
+      endif
+
+ 900   continue
+
+
+9999  PRINT*,'Fin '
+1000  format(a5,3x,i4,i3,x,a39)
+7777  FORMAT ('latitude/longitude',4f7.1)
+
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/bernoui.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/bernoui.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/bernoui.F	(revision 2744)
@@ -0,0 +1,56 @@
+      SUBROUTINE bernoui (ngrid,nlay,pphi,pecin,pbern)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:   P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c     calcul de la fonction de Bernouilli aux niveaux s  .....
+c     phi  et  ecin  sont des arguments d'entree pour le s-pg .......
+c          bern       est un  argument de sortie pour le s-pg  ......
+c
+c    fonction de Bernouilli = bern = filtre de( geopotentiel + 
+c                              energ.cinet.)
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   Decalrations:
+c   -------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+c
+c   Arguments:
+c   ----------
+c
+      INTEGER nlay,ngrid
+      REAL pphi(ngrid*nlay),pecin(ngrid*nlay),pbern(ngrid*nlay)
+c
+c   Local:
+c   ------
+c
+      INTEGER   ijl
+      EXTERNAL  filtreg
+c
+c-----------------------------------------------------------------------
+c   calcul de Bernouilli:
+c   ---------------------
+c
+      DO 4 ijl = 1,ngrid*nlay
+         pbern( ijl ) =  pphi( ijl ) + pecin( ijl )
+   4  CONTINUE
+c
+c-----------------------------------------------------------------------
+c   filtre:
+c   -------
+c
+      CALL filtreg( pbern, jjp1, llm, 2,1, .true., 1 )
+c
+c-----------------------------------------------------------------------
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/caldyn.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/caldyn.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/caldyn.F	(revision 2744)
@@ -0,0 +1,125 @@
+      SUBROUTINE caldyn
+     $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
+     $  phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Auteur :  P. Le Van
+c
+c   Objet:
+c   ------
+c
+c   Calcul des tendances dynamiques.
+c
+c Modif 04/93 F.Forget
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   0. Declarations:
+c   ----------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      LOGICAL conser
+
+      INTEGER itau
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm)
+      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
+      REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+      REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL time
+
+c   Local:
+c   ------
+
+      REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
+      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
+      REAL vorpot(ip1jm,llm)
+      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
+      REAL bern(ip1jmp1,llm)
+      REAL massebxy(ip1jm,llm)
+    
+
+      INTEGER   ij,l
+      EXTERNAL  advect,bernoui,convmas,covcont,dteta1,dudv1,dudv2,
+     *          enercin,flumass,tourpot,vitvert,sortvarc,
+     *          pression,psextbar,massdair
+
+c-----------------------------------------------------------------------
+c   Calcul des tendances dynamiques:
+c   --------------------------------
+
+      CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )
+      CALL pression ( ip1jmp1, ap      , bp   ,  ps  , p            )
+      CALL psextbar (   ps   , psexbarxy                            )
+      CALL massdair (    p   , masse                                )
+      CALL massbar  (   masse, massebx , masseby                    )
+      call massbarxy(   masse, massebxy                             )
+      CALL flumass  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
+      CALL dteta1   (   teta , pbaru   , pbarv, dteta               )
+      CALL convmas  (   pbaru, pbarv   , convm                      )
+
+      DO ij =1, ip1jmp1
+         dp( ij ) = convm( ij,1 ) / airesurg( ij )
+      ENDDO
+c     write (38,*) "convm: ",convm
+c     write (38,*) "airesurg: ",airesurg
+c     write (38,*) "iip1: ",iip1
+c     close (38)
+
+
+      CALL vitvert ( convm  , w                                  )
+      CALL tourpot ( vcov   , ucov  , massebxy  , vorpot         )
+      CALL dudv1   ( vorpot , pbaru , pbarv     , du     , dv    )
+      CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin  )
+      CALL bernoui ( ip1jmp1, llm   , phi       , ecin   , bern  )
+      CALL dudv2   ( teta   , pkf   , bern      , du     , dv    )
+
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            ang(ij,l) = ucov(ij,l) + constang(ij)
+      ENDDO
+      ENDDO
+
+
+      CALL advect( ang, vcov, teta, w, massebx, masseby, du, dv,dteta ) 
+
+C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi 
+C          probablement. Observe sur le code compile avec pgf90 3.0-1 
+
+      DO l = 1, llm
+         DO ij = 1, ip1jm, iip1
+           IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN
+c         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',  
+c    ,   ' dans caldyn'
+c         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
+          dv(ij+iim,l) = dv(ij,l)
+          endif
+         enddo
+      enddo
+c-----------------------------------------------------------------------
+c   Sorties eventuelles des variables de controle:
+c   ----------------------------------------------
+
+      IF( conser )  THEN
+        CALL sortvarc
+     $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
+
+      ENDIF
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/caldyn0.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/caldyn0.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/caldyn0.F	(revision 2744)
@@ -0,0 +1,88 @@
+      SUBROUTINE caldyn0
+     $ (itau,ucov,vcov,teta,ps,masse,pk,phis ,
+     $  phi,w,pbaru,pbarv,time )
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Auteur :  P. Le Van
+c
+c   Objet:
+c   ------
+c
+c   Calcul des tendances dynamiques.
+c
+c Modif 04/93 F.Forget
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   0. Declarations:
+c   ----------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER itau
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL pk(iip1,jjp1,llm)
+      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
+      REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL time
+
+c   Local:
+c   ------
+
+      REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
+      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
+      REAL vorpot(ip1jm,llm)
+      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
+      REAL bern(ip1jmp1,llm)
+      REAL massebxy(ip1jm,llm), dp(ip1jmp1)
+    
+
+      INTEGER   ij,l
+      EXTERNAL  advect,bernoui,convmas,covcont ,
+     *          enercin,flumass,tourpot,vitvert,sortvarc,traceur,
+     *          pression,psextbar,massdair
+
+c-----------------------------------------------------------------------
+c   Calcul des tendances dynamiques:
+c   --------------------------------
+      CALL covcont  (llm,ucov,vcov,ucont,vcont)
+      CALL pression (ip1jmp1,ap,bp,ps,p)
+      CALL psextbar (ps,psexbarxy)
+      CALL massdair (p,masse)
+      CALL massbar  (masse,massebx,masseby)
+      CALL massbarxy(masse,massebxy)
+      CALL flumass  (massebx,masseby,vcont,ucont,pbaru,pbarv)
+      CALL convmas  (pbaru,pbarv,convm)
+
+      DO ij =1, ip1jmp1
+         dp( ij ) = convm( ij,1 ) / airesurg( ij )
+      ENDDO
+
+      CALL vitvert (convm,w)
+      CALL tourpot (vcov,ucov,massebxy,vorpot)
+      CALL enercin (vcov,ucov,vcont,ucont,ecin)
+      CALL bernoui (ip1jmp1,llm,phi,ecin,bern)
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            ang(ij,l) = ucov(ij,l) + constang(ij)
+         ENDDO
+      ENDDO
+
+        CALL sortvarc0
+     $ (itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov)
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/calfis.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/calfis.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/calfis.F	(revision 2744)
@@ -0,0 +1,547 @@
+      SUBROUTINE calfis(nq, lafin, rdayvrai,rday_ecri, heure,
+     $            pucov,pvcov,pteta,pq,pmasse,pps,pp,ppk,pphis,pphi,
+     $            pducov,pdvcov,pdteta,pdq,pw,
+     $            pdufi,pdvfi,pdhfi,pdqfi,pdpsfi,tracer )
+c
+c    Auteur :  P. Le Van, F. Hourdin 
+c   .........
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   1. rearrangement des tableaux et transformation
+c      variables dynamiques  >  variables physiques
+c   2. calcul des termes physiques
+c   3. retransformation des tendances physiques en tendances dynamiques
+c
+c   remarques:
+c   ----------
+c
+c    - les vents sont donnes dans la physique par leurs composantes 
+c      naturelles.
+c    - la variable thermodynamique de la physique est une variable
+c      intensive :   T 
+c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
+c    - les deux seules variables dependant de la geometrie necessaires
+c      pour la physique sont la latitude pour le rayonnement et 
+c      l'aire de la maille quand on veut integrer une grandeur 
+c      horizontalement.
+c    - les points de la physique sont les points scalaires de la 
+c      la dynamique; numerotation:
+c          1 pour le pole nord
+c          (jjm-1)*iim pour l'interieur du domaine
+c          ngridmx pour le pole sud
+c      ---> ngridmx=2+(jjm-1)*iim
+c
+c     Input :
+c     -------
+c       ecritphy        frequence d'ecriture (en jours)de histphy
+c       pucov           covariant zonal velocity
+c       pvcov           covariant meridional velocity 
+c       pteta           potential temperature
+c       pps             surface pressure
+c       pmasse          masse d'air dans chaque maille
+c       pts             surface temperature  (K)
+c       pw              flux vertical (kg m-2)
+c
+c    Output :
+c    --------
+c        pdufi          tendency for the natural zonal velocity (ms-1)
+c        pdvfi          tendency for the natural meridional velocity 
+c        pdhfi          tendency for the potential temperature
+c        pdtsfi         tendency for the surface temperature
+c
+c        tracer         Call tracer in  gcm.F ? (decided in callphys.def)
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+
+      INTEGER ngridmx,nq
+      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
+
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "control.h"
+
+c    Arguments :
+c    -----------
+      LOGICAL  lafin
+      REAL heure
+
+      REAL pvcov(iip1,jjm,llm)
+      REAL pucov(iip1,jjp1,llm)
+      REAL pteta(iip1,jjp1,llm)
+      REAL pmasse(iip1,jjp1,llm)
+      REAL pq(iip1,jjp1,llm,nqmx)
+      REAL pphis(iip1,jjp1)
+      REAL pphi(iip1,jjp1,llm)
+c
+      REAL pdvcov(iip1,jjm,llm)
+      REAL pducov(iip1,jjp1,llm)
+      REAL pdteta(iip1,jjp1,llm)
+      REAL pdq(iip1,jjp1,llm,nqmx)
+c
+      REAL pw(iip1,jjp1,llm)
+c
+      REAL pps(iip1,jjp1)
+      REAL pp(iip1,jjp1,llmp1)
+      REAL ppk(iip1,jjp1,llm)
+c
+      REAL pdvfi(iip1,jjm,llm)
+      REAL pdufi(iip1,jjp1,llm)
+      REAL pdhfi(iip1,jjp1,llm)
+      REAL pdqfi(iip1,jjp1,llm,nqmx)
+      REAL pdpsfi(iip1,jjp1)
+      logical tracer
+
+c    Local variables :
+c    -----------------
+
+      INTEGER i,j,l,ig0,ig,iq
+      REAL zpsrf(ngridmx)
+      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
+      REAL zphi(ngridmx,llm),zphis(ngridmx)
+c
+      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
+      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqmx)
+c
+      REAL zvervel(ngridmx,llm)
+c
+      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
+      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqmx)
+      REAL zdpsrf(ngridmx)
+c
+      REAL zsin(iim),zcos(iim),z1(iim)
+      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
+      REAL unskap, pksurcp
+c
+      
+      EXTERNAL gr_dyn_fi,gr_fi_dyn
+      EXTERNAL physiq,multipl
+      REAL SSUM
+      EXTERNAL SSUM
+
+      REAL latfi(ngridmx),lonfi(ngridmx)
+      REAL airefi(ngridmx)
+      SAVE latfi, lonfi, airefi
+
+      LOGICAL firstcal, debut
+      DATA firstcal/.true./
+      SAVE firstcal,debut
+      REAL rdayvrai,rday_ecri
+c
+c-----------------------------------------------------------------------
+c
+c    1. Initialisations :
+c    --------------------
+c
+
+
+      IF (ngridmx.NE.2+(jjm-1)*iim) THEN
+         PRINT*,'STOP dans calfis'
+         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
+         PRINT*,'  ngridmx  jjm   iim   '
+         PRINT*,ngridmx,jjm,iim
+         STOP
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   latitude, longitude et aires des mailles pour la physique:
+c   ----------------------------------------------------------
+
+c
+      IF ( firstcal )  THEN
+          debut = .TRUE.
+      ELSE
+          debut = .FALSE.
+      ENDIF
+
+c
+      IF (firstcal) THEN
+         latfi(1)=rlatu(1)
+         lonfi(1)=0.
+         DO j=2,jjm
+            DO i=1,iim
+               latfi((j-2)*iim+1+i)= rlatu(j)
+               lonfi((j-2)*iim+1+i)= rlonv(i)
+            ENDDO
+         ENDDO
+         latfi(ngridmx)= rlatu(jjp1)
+         lonfi(ngridmx)= 0.
+         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+
+         CALL inifis(ngridmx,llm,day_ini,daysec,dtphys,
+     .                latfi,lonfi,airefi,rad,g,r,cpp)
+      ENDIF
+
+c
+c-----------------------------------------------------------------------
+c   40. transformation des variables dynamiques en variables physiques:
+c   ---------------------------------------------------------------
+
+c   41. pressions au sol (en Pascals)
+c   ----------------------------------
+
+       
+      zpsrf(1) = pps(1,1)
+
+      ig0  = 2
+      DO j = 2,jjm
+         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
+         ig0 = ig0+iim
+      ENDDO
+
+      zpsrf(ngridmx) = pps(1,jjp1)
+
+
+c   42. pression intercouches :
+c
+c   -----------------------------------------------------------------
+c     .... zplev  definis aux (llm +1) interfaces des couches  ....
+c     .... zplay  definis aux (  llm )    milieux des couches  .... 
+c   -----------------------------------------------------------------
+
+c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
+c
+       unskap   = 1./ kappa
+c
+      DO l = 1, llmp1
+        zplev( 1,l ) = pp(1,1,l)
+        ig0 = 2
+          DO j = 2, jjm
+             DO i =1, iim
+              zplev( ig0,l ) = pp(i,j,l)
+              ig0 = ig0 +1
+             ENDDO
+          ENDDO
+        zplev( ngridmx,l ) = pp(1,jjp1,l)
+      ENDDO
+c
+c
+
+c   43. temperature naturelle (en K) et pressions milieux couches .
+c   ---------------------------------------------------------------
+
+      DO l=1,llm
+
+         pksurcp     =  ppk(1,1,l) / cpp
+         zplay(1,l)  =  preff * pksurcp ** unskap
+         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp
+         ig0         =  2
+
+         DO j = 2, jjm
+            DO i = 1, iim
+              pksurcp        = ppk(i,j,l) / cpp
+              zplay(ig0,l)   = preff * pksurcp ** unskap
+              ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
+              ig0            = ig0 + 1
+            ENDDO
+         ENDDO
+
+         pksurcp       = ppk(1,jjp1,l) / cpp
+         zplay(ig0,l)  = preff * pksurcp ** unskap
+         ztfi (ig0,l)  = pteta(1,jjp1,l)  * pksurcp
+
+      ENDDO
+
+      DO l=1, llm
+        DO ig=1,ngridmx
+             if (ztfi(ig,l).lt.15) then
+                  write(*,*) 'New Temperature below 15 K !!! '
+	              write(*,*) 'Stop in calfis.F '
+	              write(*,*) 'ig=', ig, 'l= ', l
+                  stop
+             end if
+        ENDDO
+      ENDDO
+
+
+
+c   43.bis Taceurs (en kg/kg)
+c   --------------------------
+      DO iq=1,nqmx
+         DO l=1,llm
+            zqfi(1,l,iq) = pq(1,1,l,iq)
+            ig0          = 2
+            DO j=2,jjm
+               DO i = 1, iim
+                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
+                  ig0             = ig0 + 1
+               ENDDO
+            ENDDO
+            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
+         ENDDO
+      ENDDO
+
+c   Geopotentiel calcule par rapport a la surface locale:
+c   -----------------------------------------------------
+
+      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
+      DO l=1,llm
+         DO ig=1,ngridmx
+            zphi(ig,l)=zphi(ig,l)-zphis(ig)
+         ENDDO
+      ENDDO
+
+c   Calcul de la vitesse  verticale (m/s) pour diagnostique 
+c   -------------------------------
+c     pw est en kg/s
+c On interpole "lineairement" la temperature entre les couches(FF,10/95)
+
+      DO ig=1,ngridmx
+         zvervel(ig,1)=0.
+      END DO
+      DO l=2,llm
+        zvervel(1,l)=(pw(1,1,l)/apoln)
+     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)              
+        ig0=2
+       DO j=2,jjm
+           DO i = 1, iim
+              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
+     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+              ig0 = ig0 + 1
+           ENDDO
+       ENDDO
+        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
+     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+      ENDDO
+
+c    .........  Reindexation : calcul de zvervel au MILIEU des couches
+       DO l=1,llm-1
+	      DO ig=1,ngridmx
+		     zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
+          END DO 
+       END DO 
+c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
+
+c   45. champ u:
+c   ------------
+
+      DO 50 l=1,llm
+
+         DO 25 j=2,jjm
+            ig0 = 1+(j-2)*iim
+            zufi(ig0+1,l)= 0.5 * 
+     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
+            DO 10 i=2,iim
+               zufi(ig0+i,l)= 0.5 *
+     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
+10         CONTINUE
+25      CONTINUE
+
+50    CONTINUE
+
+
+c   46.champ v:
+c   -----------
+
+      DO l=1,llm
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               zvfi(ig0+i,l)= 0.5 *
+     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
+            ENDDO
+         ENDDO
+      ENDDO
+
+
+c   47. champs de vents aux pole nord   
+c   ------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
+         ENDDO
+
+         DO i=1,iim
+            zcos(i)   = COS(rlonv(i))*z1(i)
+            zcosbis(i)= COS(rlonv(i))*z1bis(i)
+            zsin(i)   = SIN(rlonv(i))*z1(i)
+            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
+         ENDDO
+
+         zufi(1,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+
+c   48. champs de vents aux pole sud:
+c   ---------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
+      ENDDO
+
+         DO i=1,iim
+            zcos(i)    = COS(rlonv(i))*z1(i)
+            zcosbis(i) = COS(rlonv(i))*z1bis(i)
+            zsin(i)    = SIN(rlonv(i))*z1(i)
+            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
+      ENDDO
+
+         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   Appel de la physique:
+c   ---------------------
+
+
+      CALL physiq (ngridmx,llm,nq,
+     ,     debut,lafin,
+     ,     rday_ecri,heure,dtphys,
+     ,     zplev,zplay,zphi,
+     ,     zufi, zvfi,ztfi, zqfi,  
+     ,     zvervel,
+C - sorties
+     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
+
+
+c-----------------------------------------------------------------------
+c   transformation des tendances physiques en tendances dynamiques:
+c   ---------------------------------------------------------------
+
+c  tendance sur la pression :
+c  -----------------------------------
+
+      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
+c
+ccc     CALL multipl(ip1jmp1,aire,pdpsfi,pdpsfi)
+
+c   62. enthalpie potentielle
+c   ---------------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+          pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
+          pdhfi(i,jjp1,l) = cpp *  zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
+            ENDDO
+               pdhfi(iip1,j,l) =  pdhfi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   62. humidite specifique
+c   ---------------------
+
+      DO iq=1,nqmx
+         DO l=1,llm
+            DO i=1,iip1
+               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
+               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
+            ENDDO
+            DO j=2,jjm
+               ig0=1+(j-2)*iim
+               DO i=1,iim
+                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
+               ENDDO
+               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
+            ENDDO
+         ENDDO
+      ENDDO
+
+c   65. champ u:
+c   ------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+            pdufi(i,1,l)    = 0.
+            pdufi(i,jjp1,l) = 0.
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim-1
+               pdufi(i,j,l)=
+     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
+            ENDDO
+            pdufi(iim,j,l)=
+     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
+            pdufi(iip1,j,l)=pdufi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   67. champ v:
+c   ------------
+
+      DO l=1,llm
+
+         DO j=2,jjm-1
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdvfi(i,j,l)=
+     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
+            ENDDO
+            pdvfi(iip1,j,l) = pdvfi(1,j,l)
+         ENDDO
+      ENDDO
+
+
+c   68. champ v pres des poles:
+c   ---------------------------
+c      v = U * cos(long) + V * SIN(long)
+
+      DO l=1,llm
+
+         DO i=1,iim
+            pdvfi(i,1,l)=
+     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
+            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
+     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
+            pdvfi(i,1,l)=
+     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
+            pdvfi(i,jjm,l)=
+     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
+          ENDDO
+
+         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
+         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+
+700   CONTINUE
+
+      firstcal = .FALSE.
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/clesph0.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/clesph0.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/clesph0.h	(revision 2744)
@@ -0,0 +1,8 @@
+c..include clesph0.h
+c
+       COMMON/clesph0/cycle_diurne, soil_model,new_oliq, ok_orodr ,
+     ,                ok_orolf ,ok_limitvrai, nbapp_rad, iflag_con
+c
+       LOGICAL cycle_diurne,soil_model,ok_orodr,ok_orolf,new_oliq
+       LOGICAL ok_limitvrai
+       INTEGER nbapp_rad, iflag_con
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/coefpoly.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/coefpoly.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/coefpoly.F	(revision 2744)
@@ -0,0 +1,38 @@
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/coefpoly.F,v 1.1 2001/04/23 08:43:28 lmdz Exp $
+      SUBROUTINE coefpoly ( Xf1, Xf2, Xprim1, Xprim2, xtild1,xtild2 ,
+     ,                                          a0,a1,a2,a3         )
+      IMPLICIT NONE
+c
+c   ...  Auteur :   P. Le Van  ...
+c
+c
+c    Calcul des coefficients a0, a1, a2, a3 du polynome de degre 3 qui
+c      satisfait aux 4 equations  suivantes :
+
+c    a0 + a1*xtild1 + a2*xtild1*xtild1 + a3*xtild1*xtild1*xtild1 = Xf1
+c    a0 + a1*xtild2 + a2*xtild2*xtild2 + a3*xtild2*xtild2*xtild2 = Xf2
+c               a1  +     2.*a2*xtild1 +     3.*a3*xtild1*xtild1 = Xprim1
+c               a1  +     2.*a2*xtild2 +     3.*a3*xtild2*xtild2 = Xprim2
+
+c  On en revient a resoudre un systeme de 4 equat.a 4 inconnues a0,a1,a2,a3
+
+      REAL*8 Xf1, Xf2,Xprim1,Xprim2, xtild1,xtild2, xi 
+      REAL*8 Xfout, Xprim
+      REAL*8 a1,a2,a3,a0, xtil1car, xtil2car,derr,x1x2car
+
+      xtil1car = xtild1 * xtild1
+      xtil2car = xtild2 * xtild2 
+
+      derr= 2. *(Xf2-Xf1)/( xtild1-xtild2)
+
+      x1x2car = ( xtild1-xtild2)*(xtild1-xtild2)
+
+      a3 = (derr + Xprim1+Xprim2 )/x1x2car
+      a2     = ( Xprim1 - Xprim2 + 3.* a3 * ( xtil2car-xtil1car ) )    /
+     /           (  2.* ( xtild1 - xtild2 )  )
+
+      a1     = Xprim1 -3.* a3 * xtil1car     -2.* a2 * xtild1
+      a0     =  Xf1 - a3 * xtild1* xtil1car -a2 * xtil1car - a1 *xtild1
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comav.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comav.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comav.h	(revision 2744)
@@ -0,0 +1,3 @@
+      COMMON/comav/period_av,time0_av
+      REAL period_av ! periode de stockage en jour
+      REAL time0_av  ! date initiale de stokage en jour
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comconst.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comconst.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comconst.h	(revision 2744)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+! INCLUDE comconst.h
+
+      COMMON/comconst/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,
+     * dtvr,daysec,
+     * pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg
+
+      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
+      REAL dtvr,daysec
+      REAL pi,dtphys,dtdiss,rad,r,cpp,kappa
+      REAL cotot,unsim,g,omeg
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdiss.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdiss.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdiss.h	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'comdiss.h'
+
+      INTEGER niter
+      REAL tetau(llm),tetah(llm),cdivu,cdivh,crot
+      LOGICAL dissipst
+
+      COMMON/comdissi/niter
+      COMMON/comdissr/tetau,tetah,cdivu,cdivh,crot
+      COMMON/comdissl/dissipst
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdissip.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdissip.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdissip.h	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE dissip.h
+
+      COMMON/comdissip/
+     $    niterdis,coefdis,tetavel,tetatemp,gamdissip
+
+
+      INTEGER niterdis
+
+      REAL tetavel,tetatemp,coefdis,gamdissip
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdissipn.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdissipn.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdissipn.h	(revision 2744)
@@ -0,0 +1,13 @@
+c-----------------------------------------------------------------------
+c INCLUDE comdissipn.h
+
+      REAL  tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
+c
+      COMMON/comdissipn/ tetaudiv(llm),tetaurot(llm),tetah(llm)   ,
+     1                        cdivu,      crot,         cdivh
+
+c
+c    Les parametres de ce common proviennent des calculs effectues dans 
+c             Inidissip  .
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdissnew.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdissnew.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comdissnew.h	(revision 2744)
@@ -0,0 +1,15 @@
+c-----------------------------------------------------------------------
+c INCLUDE comdissnew.h
+
+      COMMON/comdissnew/ lstardis,nitergdiv,nitergrot,niterh,tetagdiv,
+     1                   tetagrot,tetatemp,coefdis 
+
+      LOGICAL lstardis
+      INTEGER nitergdiv, nitergrot, niterh
+      REAL     tetagdiv, tetagrot,  tetatemp, coefdis
+
+c
+c ... Les parametres de ce common comdissnew sont  lues par defrun_new 
+c              sur le fichier  run.def    ....
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comgeom.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comgeom.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comgeom.h	(revision 2744)
@@ -0,0 +1,29 @@
+!CDK comgeom
+      COMMON/comgeom/
+     .cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),
+     .aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),
+     .airev(ip1jm),unsaire(ip1jmp1),apoln,apols,
+     .unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),
+     .aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),
+     .aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),
+     .alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),
+     .alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),
+     .fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),
+     .rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),
+     .cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),
+     .cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),
+     .cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),
+     .unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,
+     .unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),
+     .aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
+
+      REAL :: 
+     .cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,
+     .apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,
+     .alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,
+     .fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,
+     .cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2,
+     .unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,
+     .aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu,
+     .xprimv
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comgeom2.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comgeom2.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comgeom2.h	(revision 2744)
@@ -0,0 +1,31 @@
+*CDK comgeom2
+      COMMON/comgeom/
+     1 cu(iip1,jjp1),cv(iip1,jjm),unscu2(iip1,jjp1),unscv2(iip1,jjm)  ,
+     2 aire(iip1,jjp1),airesurg(iip1,jjp1),aireu(iip1,jjp1)           ,
+     3 airev(iip1,jjm),unsaire(iip1,jjp1),apoln,apols                 ,  
+     4 unsairez(iip1,jjm),airuscv2(iip1,jjm),airvscu2(iip1,jjm)       ,
+     5 aireij1(iip1,jjp1),aireij2(iip1,jjp1),aireij3(iip1,jjp1)       ,
+     6 aireij4(iip1,jjp1),alpha1(iip1,jjp1),alpha2(iip1,jjp1)         ,
+     7 alpha3(iip1,jjp1),alpha4(iip1,jjp1),alpha1p2(iip1,jjp1)        ,
+     8 alpha1p4(iip1,jjp1),alpha2p3(iip1,jjp1),alpha3p4(iip1,jjp1)    ,
+     9 fext(iip1,jjm),constang(iip1,jjp1), rlatu(jjp1),rlatv(jjm),
+     1 rlonu(iip1),rlonv(iip1),cuvsurcv(iip1,jjm),cvsurcuv(iip1,jjm)  ,
+     1 cvusurcu(iip1,jjp1),cusurcvu(iip1,jjp1)                        ,
+     2 cuvscvgam1(iip1,jjm),cuvscvgam2(iip1,jjm),cvuscugam1(iip1,jjp1),
+     3 cvuscugam2(iip1,jjp1),cvscuvgam(iip1,jjm),cuscvugam(iip1,jjp1) ,
+     4 unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2                ,
+     5 unsair_gam1(iip1,jjp1),unsair_gam2(iip1,jjp1)                  ,
+     6 unsairz_gam(iip1,jjm),aivscu2gam(iip1,jjm),aiuscv2gam(iip1,jjm)
+     7 , xprimu(iip1),xprimv(iip1)
+
+c
+      REAL 
+     1 cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,apoln,apols,unsaire
+     2 ,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4     ,
+     3 alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,
+     4 fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,
+     5 cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1           , 
+     6 unsapolnga2,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2     ,
+     7 unsairz_gam,aivscu2gam,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu    ,
+     8 cusurcvu,xprimu,xprimv
+c
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comvert.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comvert.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/comvert.h	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'comvert.h'
+
+      COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm) ,
+     .               pa,preff,nivsigs(llm),nivsig(llm+1),
+     .               sig(llm+1),ds(llm),aps(llm),bps(llm),pseudoalt(llm)
+
+      REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig
+c Mars Ce qui suit vient de gcm
+      REAL sig,ds,aps,bps,pseudoalt
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/control.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/control.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/control.h	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'control.h'
+
+      COMMON/control/nday,day_step,
+     $              iperiod,iconser,idissip,iphysiq ,
+     $              periodav,ecritphy,anneeref
+
+      INTEGER   nday,day_step,iperiod,iconser,
+     $          idissip,iphysiq,anneeref
+      REAL periodav, ecritphy
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/convflu.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/convflu.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/convflu.F	(revision 2744)
@@ -0,0 +1,60 @@
+      SUBROUTINE convflu( xflu,yflu,nbniv,convfl )
+c
+c  P. Le Van
+c
+c
+c    *******************************************************************
+c  ... calcule la (convergence horiz. * aire locale)du flux ayant pour
+c      composantes xflu et yflu ,variables extensives .  ......
+c    *******************************************************************
+c      xflu , yflu et nbniv sont des arguments d'entree pour le s-pg ..
+c      convfl                est  un argument de sortie pour le s-pg .
+c
+c     njxflu  est le nombre de lignes de latitude de xflu, 
+c     ( = jjm ou jjp1 )
+c     nbniv   est le nombre de niveaux vert. de  xflu et de yflu .
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+      REAL       xflu,yflu,convfl,convpn,convps
+      INTEGER    l,ij,nbniv
+      DIMENSION  xflu( ip1jmp1,nbniv ),yflu( ip1jm,nbniv ) ,
+     *         convfl( ip1jmp1,nbniv )
+c
+      EXTERNAL   SSUM
+      REAL       SSUM
+c
+c
+#include "comgeom.h"
+c
+      DO 5 l = 1,nbniv
+c
+      DO 2  ij = iip2, ip1jm - 1
+      convfl( ij + 1,l ) =  xflu(   ij,l ) - xflu( ij +  1,l )   +
+     *                      yflu(ij +1,l ) - yflu( ij -iim,l )
+   2  CONTINUE
+c
+c
+
+c     ....  correction pour  convfl( 1,j,l)  ......
+c     ....   convfl(1,j,l)= convfl(iip1,j,l) ...
+c
+CDIR$ IVDEP
+      DO 3 ij = iip2,ip1jm,iip1
+      convfl( ij,l ) = convfl( ij + iim,l )
+   3  CONTINUE
+c
+c     ......  calcul aux poles  .......
+c
+      convpn =   SSUM( iim, yflu(     1    ,l ),  1 )
+      convps = - SSUM( iim, yflu( ip1jm-iim,l ),  1 )
+      DO 4 ij = 1,iip1
+      convfl(     ij   ,l ) = convpn * aire(   ij     ) / apoln
+      convfl( ij+ ip1jm,l ) = convps * aire( ij+ ip1jm) / apols
+   4  CONTINUE
+c
+   5  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/convmas.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/convmas.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/convmas.F	(revision 2744)
@@ -0,0 +1,62 @@
+      SUBROUTINE convmas (pbaru, pbarv, convm )
+c
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:  P. Le Van , F. Hourdin  .
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   ********************************************************************
+c   .... calcul de la convergence du flux de masse aux niveaux p ...
+c   ********************************************************************
+c
+c
+c     pbaru  et  pbarv  sont des arguments d'entree pour le s-pg  ....
+c      .....  convm      est  un argument de sortie pour le s-pg  ....
+c
+c    le calcul se fait de haut en bas, 
+c    la convergence de masse au niveau p(llm+1) est egale a 0. et
+c    n'est pas stockee dans le tableau convm .
+c
+c
+c=======================================================================
+c
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "logic.h"
+
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm ),convm(  ip1jmp1,llm )
+      INTEGER   l,ij
+
+      EXTERNAL   filtreg
+      EXTERNAL   convflu
+
+c-----------------------------------------------------------------------
+c    ....  calcul de - (d(pbaru)/dx + d(pbarv)/dy ) ......
+
+      CALL convflu( pbaru, pbarv, llm, convm )
+
+c-----------------------------------------------------------------------
+c   filtrage:
+c   ---------
+
+       CALL filtreg( convm, jjp1, llm, 2, 2, .true., 1 )
+
+c    integration de la convergence de masse de haut  en bas ......
+
+      DO      l      = llmm1, 1, -1
+        DO    ij     = 1, ip1jmp1
+         convm(ij,l) = convm(ij,l) + convm(ij,l+1)
+        ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/coordij.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/coordij.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/coordij.F	(revision 2744)
@@ -0,0 +1,48 @@
+      SUBROUTINE coordij(lon,lat,ilon,jlat)
+
+c=======================================================================
+c
+c   calcul des coordonnees i et j de la maille scalaire dans
+c   laquelle se trouve le point (lon,lat) en radian
+c
+c=======================================================================
+
+      IMPLICIT NONE
+      REAL lon,lat
+      INTEGER ilon,jlat
+      INTEGER i,j
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "serre.h"
+
+      real zlon,zlat
+
+      zlon=lon
+      zlat=lat
+
+      DO i=1,iim+1
+        print*,i,' ',rlonu(i),' ',zlon 
+         IF (rlonu(i).GT.zlon) THEN
+            ilon=i
+            GOTO 10
+         ENDIF
+      ENDDO
+10    CONTINUE
+
+      j=0
+      DO j=1,jjm
+        print*,j,' ',rlatv(j),' ' ,zlat 
+         IF(rlatv(j).LT.zlat) THEN
+           
+            jlat=j
+            GOTO 20
+         ENDIF
+      ENDDO
+20    CONTINUE
+      IF(j.EQ.0) j=jjm+1
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/covcont.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/covcont.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/covcont.F	(revision 2744)
@@ -0,0 +1,41 @@
+      SUBROUTINE covcont (klevel,ucov, vcov, ucont, vcont )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c  *********************************************************************
+c    calcul des compos. contravariantes a partir des comp.covariantes
+c  ********************************************************************
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      INTEGER klevel
+      REAL ucov ( ip1jmp1,klevel ),  vcov( ip1jm,klevel )
+      REAL ucont( ip1jmp1,klevel ), vcont( ip1jm,klevel )
+      INTEGER   l,ij
+
+
+      DO 10 l = 1,klevel
+
+      DO 2  ij = iip2, ip1jm
+      ucont( ij,l ) = ucov( ij,l ) * unscu2( ij )
+   2  CONTINUE
+
+      DO 4 ij = 1,ip1jm
+      vcont( ij,l ) = vcov( ij,l ) * unscv2( ij )
+   4  CONTINUE
+
+  10  CONTINUE
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/covnat.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/covnat.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/covnat.F	(revision 2744)
@@ -0,0 +1,46 @@
+      SUBROUTINE covnat (klevel,ucov, vcov, unat, vnat )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  F Hourdin Phu LeVan
+c   -------
+c
+c   Objet:
+c   ------
+c
+c  *********************************************************************
+c    calcul des compos. naturelles a partir des comp.covariantes
+c  ********************************************************************
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      INTEGER klevel
+      REAL ucov( ip1jmp1,klevel ),  vcov( ip1jm,klevel )
+      REAL unat( ip1jmp1,klevel ), vnat( ip1jm,klevel )
+      INTEGER   l,ij
+
+
+      DO l = 1,klevel
+         DO ij = 1, iip1
+            unat (ij,l) =0.
+         END DO
+
+         DO ij = iip2, ip1jm
+            unat( ij,l ) = ucov( ij,l ) / cu(ij)
+         ENDDO
+         DO ij = ip1jm+1, ip1jmp1  
+            unat (ij,l) =0.
+         END DO
+
+         DO ij = 1,ip1jm
+            vnat( ij,l ) = vcov( ij,l ) / cv(ij)
+         ENDDO
+
+      ENDDO
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/defrun_new.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/defrun_new.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/defrun_new.F	(revision 2744)
@@ -0,0 +1,492 @@
+      SUBROUTINE defrun_new( tapedef, etatinit )
+c
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c     Auteurs :   L. Fairhead , P. Le Van  .
+c      Modif C. Hourdin F. Forget VERSION MARTIENNE
+c
+c
+c   Declarations :
+c   --------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "control.h"
+#include "logic.h"
+#include "serre.h"
+#include "comdissnew.h"
+#include "sponge.h"
+c
+      LOGICAL  etatinit
+c
+c   local:
+c   ------
+
+      CHARACTER ch1*72,ch2*72,ch3*72,ch4*8
+      INTEGER tapeout,tapedef
+
+c     REAL clonn,clatt,alphaxx,alphayy
+c     LOGICAL  fxyhypbb
+      INTEGER ierr
+      REAL clonn,clatt,grossismxx,grossismyy
+      REAL dzoomxx,dzoomyy,tauxx,tauyy,temp
+      LOGICAL  fxyhypbb, ysinuss
+
+
+c
+c  -------------------------------------------------------------------
+c
+c                    MODIF JUIN 2000 (zoom)
+c       .........     Version  du 29/04/97       ..........
+c
+c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
+c   tetatemp   ajoutes  pour la dissipation   .
+c
+c   Autre parametre ajoute en fin de liste : ** fxyhypb ** 
+c
+c   Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
+c   Sinon , choix de fxynew  , a derivee sinusoidale  ..
+c
+c   ......  etatinit = . TRUE. si defrun_new  est appele dans NEWSTART
+c   ETAT0_LMD  ou  LIMIT_LMD  pour l'initialisation de start.dat (dic) et
+c   de limit.dat (dic)  ...........
+c   Sinon  etatinit = . FALSE .
+c
+c   Donc etatinit = .F.  si on veut comparer les valeurs de  alphax ,
+c   alphay,clon,clat, fxyhypb  lues sur  le fichier  start  avec
+c   celles passees  par run.def ,  au debut du gcm, apres l'appel a 
+c   lectba .  
+c   Ces parametres definissant entre autres la grille et doivent etre
+c   pareils et coherents , sinon il y aura  divergence du gcm .
+c
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+ 
+      tapeout=6
+
+c-----------------------------------------------------------------------
+c  Parametres de controle du run:
+c-----------------------------------------------------------------------
+
+
+!Initialisation des parametres "terrestres", qui ne concernent pas
+!le modele martien et ne sont donc plus lues dans "run.def"
+
+        anneeref=0
+
+      OPEN(tapedef,file='run.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+      IF(ierr.EQ.0) THEN
+
+        PRINT*
+        READ (tapedef,9000) ch1,ch2,ch3
+        WRITE(tapeout,9000) ch1,ch2,ch3
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    nday
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'nday       ',nday
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    day_step
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'day_step   ',day_step
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    iperiod
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'iperiod    ',iperiod
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    iconser
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'iconser    ',iconser
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    temp
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9006) 'iecri not used'
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    periodav
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9003) 'periodav   ',periodav
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    idissip
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'idissip    ',idissip
+
+ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
+ccc
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    lstardis
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9004) 'lstardis   ',lstardis
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    hybrid
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9004) 'hybrid ',hybrid
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    nitergdiv
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'nitergdiv  ',nitergdiv
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    nitergrot
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'nitergrot  ',nitergrot
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    niterh
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'niterh     ',niterh
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    tetagdiv
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9003) 'tetagdiv   ',tetagdiv
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    tetagrot
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9003) 'tetagrot   ',tetagrot
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    tetatemp
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9003) 'tetatemp   ',tetatemp
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    coefdis
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9003) 'coefdis    ',coefdis
+c
+c    ...............................................................
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    purmats
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9004) 'purmats    ',purmats
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    physic
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9004) 'physic     ',physic
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    iphysiq
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'iphysiq    ',iphysiq
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    grireg
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9004) 'grireg     ',grireg
+
+ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
+c
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    ecritphy
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9003) 'ecritphy   ',ecritphy
+
+
+ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
+c     .........   (  modif  le 17/04/96 )   .........
+c
+        if (.not.etatinit ) then 
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    clonn
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'clon       ',clonn
+           IF( ABS(clon - clonn).GE. 0.001 )  THEN
+             PRINT *,' La valeur de clon passee par run.def est '
+     *       ,'differente de celle lue sur le fichier start '
+             STOP
+           ENDIF
+c
+c
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    clatt
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'clat       ',clatt
+  
+           IF( ABS(clat - clatt).GE. 0.001 )  THEN
+             PRINT *,' La valeur de clat passee par run.def est '
+     *       ,'differente de celle lue sur le fichier start '
+             STOP
+           ENDIF
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    grossismxx
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'grossismx  ',grossismxx
+
+           if(grossismxx.eq.0) then  
+             write(*,*)
+             write(*,*)'ERREUR : dans run.def, grossismx =0'
+             write(*,*)'Attention a ne pas utiliser une version de'
+             write(*,*)'run.def avant le nouveau zoom LMDZ2.3 (06/2000)'
+             write(*,*)'(Il faut ajouter grossismx,dzoomx,etc... a la'
+             write(*,*)'place de alphax, alphay. cf. dyn3d). '
+             write(*,*)
+             stop
+           end if
+
+           IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
+             PRINT *,' La valeur de grossismx passee par run.def est '
+     *       ,'differente de celle lue sur le fichier  start =',
+     *        grossismx
+             if (grossismx.eq.0) then
+                  write(*,*) 'OK,Normal : c est un vieux start'
+     *             , 'd avant le nouveau zoom LMDZ2.3 (06/2000)'
+                 grossismx=grossismxx
+             else
+                   STOP
+             endif
+           ENDIF
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    grossismyy
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'grossismy  ',grossismyy
+
+           IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
+             PRINT *,' La valeur de grossismy passee par run.def est '
+     *       ,'differente de celle lue sur le fichier  start =',
+     *        grossismy
+             if (grossismy.eq.0) then
+                  write(*,*) 'OK,Normal : c est un vieux start'
+     *             , 'd avant le nouveau zoom LMDZ2.3 (06/2000)'
+                 grossismy=grossismyy
+             else
+                   STOP
+             endif
+           ENDIF
+
+
+           IF( grossismx.LT.1. )  THEN
+             PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
+             STOP
+           ELSE
+             alphax = 1. - 1./ grossismx
+           ENDIF
+
+           IF( grossismy.LT.1. )  THEN
+             PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
+             STOP
+           ELSE
+             alphay = 1. - 1./ grossismy
+           ENDIF
+
+           PRINT *,' '
+           PRINT *,' --> In defrun: alphax alphay  ',alphax,alphay
+           PRINT *,' '
+c
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    fxyhypbb
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9004) 'fxyhypbb   ',fxyhypbb
+  
+           IF( .NOT.fxyhypb )  THEN
+             IF( fxyhypbb )     THEN
+                PRINT *,' ********  PBS DANS  DEFRUN  ******** '
+                PRINT *,' *** fxyhypb lu sur le fichier start est F ',
+     *          'alors  qu il est  T  sur  run.def  ***'
+                STOP
+             ENDIF
+           ELSE
+             IF( .NOT.fxyhypbb )   THEN
+                PRINT *,' ********  PBS DANS  DEFRUN  ******** '
+                PRINT *,' ***  fxyhypb lu sur le fichier start est T ',
+     *         'alors  qu il est  F  sur  run.def  ****  '
+                STOP
+             ENDIF
+           ENDIF
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    dzoomxx
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'dzoomx  ',dzoomxx
+
+           IF( fxyhypb )  THEN
+              IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
+                PRINT *,' La valeur de dzoomx passee par run.def est '
+     *          ,'differente de celle lue sur le fichier  start '
+                STOP
+              ENDIF
+           ENDIF
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    dzoomyy
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'dzoomy  ',dzoomyy
+
+           IF( fxyhypb )  THEN
+              IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
+                PRINT *,' La valeur de dzoomy passee par run.def est '
+     *          ,'differente de celle lue sur le fichier  start '
+                STOP
+              ENDIF
+           ENDIF
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    tauxx
+           WRITE(tapeout,9001) ch1,'taux'
+           WRITE(tapeout,*)    tauxx
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    tauyy
+           WRITE(tapeout,9001) ch1,'tauy'
+           WRITE(tapeout,*)    tauyy
+
+           IF( fxyhypb )  THEN
+              IF( ABS(taux - tauxx).GE. 0.001 )  THEN
+                WRITE(6,*)' La valeur de taux passee par run.def est', 
+     *             'differente de celle lue sur le fichier  start '
+                CALL ABORT
+              ENDIF
+
+              IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
+                WRITE(6,*)' La valeur de tauy passee par run.def est',
+     *          'differente de celle lue sur le fichier  start '
+                CALL ABORT
+              ENDIF
+           ENDIF
+  
+        ELSE    ! Below, case when etainit=.true.
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    clon
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'clon       ',clon
+c
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    clat
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'clat       ',clat
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    grossismx
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'grossismx  ',grossismx
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    grossismy
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'grossismy  ',grossismy
+
+           IF( grossismx.LT.1. )  THEN
+            PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
+            STOP
+           ELSE
+             alphax = 1. - 1./ grossismx
+           ENDIF
+
+           IF( grossismy.LT.1. )  THEN
+             PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
+             STOP
+           ELSE
+             alphay = 1. - 1./ grossismy
+           ENDIF
+
+           PRINT *,' Defrun  alphax alphay  ',alphax,alphay
+c
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    fxyhypb
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9004) 'fxyhypb  ',fxyhypb
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    dzoomx
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'dzoomx   ',dzoomx
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    dzoomy
+           WRITE(tapeout,9002) ch1
+           WRITE(tapeout,9003) 'dzoomy   ',dzoomy
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    taux
+           WRITE(tapeout,9001) ch1,'taux'
+           WRITE(tapeout,*)    taux
+
+           READ (tapedef,9001) ch1,ch4
+           READ (tapedef,*)    tauy
+           WRITE(tapeout,9001) ch1,'tauy'
+           WRITE(tapeout,*)    tauy
+
+        END IF
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    ysinus
+        WRITE(tapeout,9001) ch1,'ysinus'
+        WRITE(tapeout,*)    ysinus
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    callsponge
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9004) 'callsponge ',callsponge
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    mode_sponge
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9005) 'mode_sponge',mode_sponge
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    hsponge
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9003) 'hsponge    ',hsponge
+
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    tetasponge
+        WRITE(tapeout,9002) ch1
+        WRITE(tapeout,9003) 'tetasponge ',tetasponge
+
+
+      WRITE(tapeout,*) '-----------------------------------------------'
+      WRITE(tapeout,*) ' '
+      WRITE(tapeout,*) ' '
+c
+
+c       Unlike on Earth (cf LMDZ2.2) , always a regular grid on Mars :
+        ysinus = .false. !Mars Mettre a jour
+
+
+      WRITE(tapeout,*) '-----------------------------------------------'
+      WRITE(tapeout,*) ' '
+      WRITE(tapeout,*) ' '
+cc
+      ELSE
+         write(0,*) ' WHERE IS run.def ? WE NEED IT !!!!!!!!!!!!!!!!!'
+         stop
+      ENDIF
+
+c     Test sur le zoom
+
+      if((grossismx.eq.1).and.(grossismy.eq.1)) then  
+c        Pas de zoom :
+         write(*,*) 'No zoom ? -> fxyhypb set to False'
+     &   ,'           (It runs better that way)'
+         fxyhypb = .false.
+      else     
+c        Avec Zoom
+         if (.not.fxyhypb) stop 'With zoom, fxyhypb should be set to T 
+     &in run.def for this version... -> STOP ! '     
+      end if
+
+      RETURN
+c
+9000  FORMAT(3(/,a72))
+9001  FORMAT(/,a72,/,a9)
+9002  FORMAT(/,a72)
+9003  FORMAT(t3,a11,t14,f9.3)
+9004  FORMAT(t3,a11,t14,l9)
+9005  FORMAT(t3,a11,t14,i9)
+9006  FORMAT(t3,a14)
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/description.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/description.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/description.h	(revision 2744)
@@ -0,0 +1,2 @@
+      character *120 descript
+      common /titre/descript
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/diagadv.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/diagadv.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/diagadv.F	(revision 2744)
@@ -0,0 +1,77 @@
+      subroutine diagadv(q,masse,descript)
+      implicit none
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+      real q(iip1,jjp1,llm),masse(iip1,jjp1,llm)
+      integer i,j,l
+      character*10 descript
+      real sss,smas,smin,smax
+ 
+      external ismin,ismax
+      integer ismin,ismax
+ 
+      sss=0.
+      smas=0.
+      smin=1.e33
+      smax=-1.e33
+      do l=1,llm
+        do j=1,jjp1
+           do i=1,iim
+              sss=sss+masse(i,j,l)*q(i,j,l)
+              smas=smas+masse(i,j,l)
+              smin=min(smin,q(i,j,l))
+              smax=max(smax,q(i,j,l))
+           enddo
+        enddo
+      enddo
+
+      write(*,1000) descript,smin,smax,sss/smas,sss
+ 
+      return
+1000  format(a10,'   MIN:',e15.4,'   MAX:',e15.4,'   MOY:',e15.4
+     s   ,'   TOT:',e15.4)
+      end
+
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+         ix=ix+incx
+         if(sx(ix).lt.sxmin) then
+             sxmin=sx(ix)
+             ismin=i+1
+         endif
+      ENDDO
+c
+      return
+      end
+C
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+       ix=ix+incx
+       if(sx(ix).gt.sxmax) then
+         sxmax=sx(ix)
+         ismax=i+1
+       endif
+10    continue
+c
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dissip.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dissip.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dissip.F	(revision 2744)
@@ -0,0 +1,142 @@
+      SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
+c
+      IMPLICIT NONE
+
+
+c ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
+c                                 (  10/01/98  )
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   Dissipation horizontale
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "comdissnew.h"
+#include "comdissipn.h"
+
+c   Arguments:
+c   ----------
+
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL  p( ip1jmp1,llmp1 )
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dh(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL gdx(ip1jmp1,llm),gdy(ip1jm,llm)
+      REAL grx(ip1jmp1,llm),gry(ip1jm,llm)
+      REAL te1dt(llm),te2dt(llm),te3dt(llm)
+      REAL deltapres(ip1jmp1,llm)
+
+      INTEGER l,ij
+
+      REAL  SSUM
+      EXTERNAL  gradiv ,nXgrarot,divgrad,initial0
+      EXTERNAL  gradiv2,nXgraro2,divgrad2,SSUM
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      DO l=1,llm
+         te1dt(l) = tetaudiv(l) * dtdiss
+         te2dt(l) = tetaurot(l) * dtdiss
+         te3dt(l) = tetah(l)    * dtdiss
+      ENDDO
+      CALL initial0( ijp1llm, du )
+      CALL initial0( ijmllm , dv )
+      CALL initial0( ijp1llm, dh )
+
+c-----------------------------------------------------------------------
+c   Calcul de la dissipation:
+c   -------------------------
+
+c   Calcul de la partie   grad  ( div ) :
+c   -------------------------------------
+
+
+      IF(lstardis) THEN
+         CALL gradiv2( llm,ucov,vcov,nitergdiv,gdx,gdy )
+      ELSE
+         CALL gradiv ( llm,ucov,vcov,nitergdiv,gdx,gdy )
+      ENDIF
+
+      DO l=1,llm
+
+         DO ij = 1, iip1
+            gdx(     ij ,l) = 0.
+            gdx(ij+ip1jm,l) = 0.
+         ENDDO
+
+         DO ij = iip2,ip1jm
+            du(ij,l) = du(ij,l) - te1dt(l) *gdx(ij,l)
+         ENDDO
+         DO ij = 1,ip1jm
+            dv(ij,l) = dv(ij,l) - te1dt(l) *gdy(ij,l)
+         ENDDO
+
+       ENDDO
+
+c   calcul de la partie   n X grad ( rot ):
+c   ---------------------------------------
+
+      IF(lstardis) THEN
+         CALL nxgraro2( llm,ucov, vcov, nitergrot,grx,gry )
+      ELSE
+         CALL nxgrarot( llm,ucov, vcov, nitergrot,grx,gry )
+      ENDIF
+
+
+      DO l=1,llm
+         DO ij = 1, iip1
+            grx(ij,l) = 0.
+         ENDDO
+
+         DO ij = iip2,ip1jm
+            du(ij,l) = du(ij,l) - te2dt(l) * grx(ij,l)
+         ENDDO
+         DO ij =  1, ip1jm
+            dv(ij,l) = dv(ij,l) - te2dt(l) * gry(ij,l)
+         ENDDO
+      ENDDO
+
+c   calcul de la partie   div ( grad ):
+c   -----------------------------------
+
+        
+      IF(lstardis) THEN
+
+       DO l = 1, llm
+          DO ij = 1, ip1jmp1
+            deltapres(ij,l) = AMAX1( 0.,  p(ij,l) - p(ij,l+1) )
+          ENDDO
+       ENDDO
+
+         CALL divgrad2( llm,teta, deltapres  ,niterh, gdx )
+      ELSE
+         CALL divgrad ( llm,teta, niterh, gdx        )
+      ENDIF
+
+      DO l = 1,llm
+         DO ij = 1,ip1jmp1
+            dh( ij,l ) = dh( ij,l ) - te3dt(l) * gdx( ij,l )
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/disvert.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/disvert.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/disvert.F	(revision 2744)
@@ -0,0 +1,300 @@
+      SUBROUTINE disvert 
+
+c    Auteur :  F. Forget Y. Wanherdrick, P. Levan
+c    Nouvelle version 100% Mars !!
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "logic.h"
+c
+c=======================================================================
+c    Discretisation verticale en coordonnée hybride OU sigma
+c
+c=======================================================================
+c
+c   declarations:
+c   -------------
+c
+c
+      INTEGER l,ll
+      REAL snorm
+      REAL alpha,beta,gama,delta,deltaz,h,quoi,quand
+      REAL zsig(llm)
+      INTEGER np,ierr
+      integer :: ierr1,ierr2,ierr3,ierr4
+      REAL x
+
+      REAL SSUM
+      EXTERNAL SSUM
+      real newsig 
+      REAL dz0,dz1,nhaut,sig1,esig,csig,zz
+      real tt,rr,gg, prevz
+      real s(llm),dsig(llm) 
+
+      integer iz 
+      real z, ps,p
+
+c
+c-----------------------------------------------------------------------
+c
+      pi=2.*ASIN(1.)
+
+! Ouverture possible de fichiers typiquement E.T.
+
+         open(99,file="esasig.def",status='old',form='formatted',
+     s   iostat=ierr2)
+         if(ierr2.ne.0) then
+              close(99)
+              open(99,file="z2sig.def",status='old',form='formatted',
+     s        iostat=ierr4)
+         endif
+
+c-----------------------------------------------------------------------
+c   cas 1 on lit les options dans esasig.def:
+c   ----------------------------------------
+
+      IF(ierr2.eq.0) then
+
+c        Lecture de esasig.def :
+c        Systeme peu souple, mais qui respecte en theorie
+c        La conservation de l'energie (conversion Energie potentielle
+c        <-> energie cinetique, d'apres la note de Frederic Hourdin...
+
+         PRINT*,'*****************************'
+         PRINT*,'WARNING Lecture de esasig.def'
+         PRINT*,'*****************************'
+         READ(99,*) h
+         READ(99,*) dz0
+         READ(99,*) dz1
+         READ(99,*) nhaut
+         CLOSE(99)
+
+         dz0=dz0/h
+         dz1=dz1/h
+
+         sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut)
+
+         esig=1.
+
+         do l=1,20
+            esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.)
+         enddo
+         csig=(1./sig1-1.)/(exp(esig)-1.)
+
+         DO L = 2, llm
+            zz=csig*(exp(esig*(l-1.))-1.)
+            sig(l) =1./(1.+zz)
+     &      * tanh(.5*(llm+1-l)/nhaut)
+         ENDDO
+         sig(1)=1.
+         sig(llm+1)=0.
+         quoi      = 1. + 2.* kappa
+         s( llm )  = 1.
+         s(llm-1) = quoi
+         IF( llm.gt.2 )  THEN
+            DO  ll = 2, llm-1
+               l         = llm+1 - ll
+               quand     = sig(l+1)/ sig(l)
+               s(l-1)    = quoi * (1.-quand) * s(l)  + quand * s(l+1)
+            ENDDO
+         END IF
+c
+         snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2)
+         DO l = 1, llm
+            s(l)    = s(l)/ snorm
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   cas 2 on lit les options dans z2sig.def:
+c   ----------------------------------------
+
+      ELSE IF(ierr4.eq.0) then
+         PRINT*,'****************************'
+         PRINT*,'Lecture de z2sig.def'
+         PRINT*,'****************************'
+
+         READ(99,*) h
+         do l=1,llm
+            read(99,*) zsig(l)
+         end do
+         CLOSE(99)
+
+         sig(1) =1
+         do l=2,llm
+           sig(l) = 0.5 * ( exp(-zsig(l)/h) + exp(-zsig(l-1)/h) )
+         end do
+         sig(llm+1) =0
+
+c-----------------------------------------------------------------------
+      ELSE
+         write(*,*) 'didn t you forget something ??? '
+         write(*,*) 'We need the file  z2sig.def ! (OR esasig.def) '
+         stop
+      ENDIF
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+        nivsigs(l) = FLOAT(l)
+      ENDDO
+
+      DO l=1,llmp1
+        nivsig(l)= FLOAT(l)
+      ENDDO
+
+ 
+c-----------------------------------------------------------------------
+c    ....  Calculs  de ap(l) et de bp(l)  ....
+c    .........................................
+c
+c   .....  pa et preff sont lus  sur les fichiers start par dynetat0 .....
+c-----------------------------------------------------------------------
+c
+
+      if (hybrid) then
+         write(*,*) "*******************************"
+         write(*,*) "Systeme en coordonnees hybrides"
+         write(*,*) 
+c        Coordonnees hybrides avec mod
+         DO l = 1, llm
+
+         call sig_hybrid(sig(l),pa,preff,newsig)
+            bp(l) = EXP( 1. - 1./(newsig**2)  )
+            ap(l) = pa * (newsig - bp(l) )
+         enddo
+         bp(llmp1) = 0.
+         ap(llmp1) = 0.
+      else
+         write(*,*) "****************************"
+         write(*,*) "Systeme en coordonnees sigma"
+         write(*,*) 
+c        Pour ne pas passer en coordonnees hybrides
+         DO l = 1, llm
+            ap(l) = 0.
+            bp(l) = sig(l)
+         ENDDO
+         ap(llmp1) = 0.
+      endif
+
+      bp(llmp1) =   0.
+
+      PRINT *,' BP '
+      PRINT *,  bp
+      PRINT *,' AP '
+      PRINT *,  ap
+
+c     Calcul au milieu des couches :
+c     WARNING : le choix de placer le milieu des couches au niveau de
+c     pression intermédiaire est arbitraire et pourrait etre modifié.
+c     Le calcul du niveau pour la derniere couche 
+c     (on met la meme distance (en log pression)  entre P(llm)
+c     et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est
+c     Specifique.  Ce choix est spécifié ici ET dans exner_hyb.F
+
+      DO l = 1, llm-1
+       aps(l) =  0.5 *( ap(l) +ap(l+1)) 
+       bps(l) =  0.5 *( bp(l) +bp(l+1)) 
+      ENDDO
+     
+      if (hybrid) then
+         aps(llm) = aps(llm-1)**2 / aps(llm-2) 
+         bps(llm) = 0.5*(bp(llm) + bp(llm+1))
+      else
+         bps(llm) = bps(llm-1)**2 / bps(llm-2) 
+         aps(llm) = 0.
+      end if
+
+      PRINT *,' BPs '
+      PRINT *,  bps
+      PRINT *,' APs'
+      PRINT *,  aps
+
+      DO l = 1, llm
+       presnivs(l) = aps(l)+bps(l)*preff
+       pseudoalt(l) = -10.*log(presnivs(l)/preff)
+      ENDDO
+
+      PRINT *,' PRESNIVS' 
+      PRINT *,presnivs 
+      PRINT *,'Pseudo altitude des Presnivs : ' 
+      PRINT *,pseudoalt
+
+c     --------------------------------------------------
+c     This can be used to plot the vertical discretization
+c     (> xmgrace -nxy testhybrid.tab       (z = H*log(p(l)/pref))
+c     --------------------------------------------------
+c     open (53,file='testhybrid.tab')
+c     do iz=0,60
+c       z = -10 + min(iz,60-iz)
+c       ps = preff*exp(-z/10)
+c       do l=1,llm
+c          zsig(l)= -10.*log((aps(l) + bps(l)*ps)/preff)
+c       end do
+c       write(53,*)iz, (zsig(l),l=1,llm,1)
+c      end do
+c      close(53)
+c     --------------------------------------------------
+
+
+      RETURN
+      END
+
+c ************************************************************
+      subroutine sig_hybrid(sig,pa,preff,newsig)
+c     ----------------------------------------------
+c     Subroutine utilisee pour calculer des valeurs de sigma modifie
+c     pour conserver les coordonnees verticales decrites dans
+c     esasig.def/z2sig.def lors du passage en coordonnees hybrides
+c     F. Forget 2002
+c     Connaissant sig (niveaux "sigma" ou on veut mettre les couches)
+c     L'objectif est de calculer newsig telle que
+c       (1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig = sig
+c     Cela ne se résoud pas analytiquement: 
+c     => on résoud par iterration bourrine 
+c     ----------------------------------------------
+c     Information  : where exp(1-1./x**2) become << x
+c           x      exp(1-1./x**2) /x
+c           1           1
+c           0.68       0.5
+c           0.5        1.E-1
+c           0.391      1.E-2
+c           0.333      1.E-3
+c           0.295      1.E-4
+c           0.269      1.E-5
+c           0.248      1.E-6
+c        => on peut utiliser newsig = sig*preff/pa si sig*preff/pa < 0.25
+
+
+      implicit none
+      real x1, x2, sig,pa,preff, newsig, F
+      integer j
+
+      newsig = sig
+      x1=0
+      x2=1
+	  if (sig.ge.1) then
+	       newsig= sig
+      else if (sig*preff/pa.ge.0.25) then
+        DO J=1,9999  ! nombre d''iteration max
+          F=((1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig)/sig
+c         write(0,*) J, ' newsig =', newsig, ' F= ', F
+          if (F.gt.1) then
+              X2 = newsig
+              newsig=(X1+newsig)*0.5
+          else
+              X1 = newsig
+              newsig=(X2+newsig)*0.5
+          end if
+c         Test : on arete lorsque on approxime sig à moins de 0.01 m près 
+c         (en pseudo altiude) :
+          IF(abs(10.*log(F)).LT.1.E-5) goto 999
+        END DO
+       else   !    if (sig*preff/pa.le.0.25) then
+	        newsig= sig*preff/pa
+       end if
+ 999   continue
+       Return
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/disvert.orig
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/disvert.orig	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/disvert.orig	(revision 2744)
@@ -0,0 +1,341 @@
+      SUBROUTINE disvert 
+
+c    Auteur :  P. Le Van . F. Forget Y. Wanherdrick
+c    Many modif special mars !!
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "hybrid.h"
+c
+c=======================================================================
+c    Discretisation verticale en coordonnée hybride
+c
+c=======================================================================
+c
+c   declarations:
+c   -------------
+c
+c
+      INTEGER l,ll
+      REAL snorm
+      REAL alpha,beta,gama,delta,deltaz,h,zsig,quoi,quand
+      INTEGER np,ierr
+      integer :: ierr1,ierr2,ierr3,ierr4
+      REAL x
+
+      REAL SSUM
+      EXTERNAL SSUM
+      real newsig 
+      REAL dz0,dz1,nhaut,sig1,esig,csig,zz
+      real tt,rr,gg, prevz
+      real s(llm),dsig(llm) 
+
+c
+c-----------------------------------------------------------------------
+c
+      pi=2.*ASIN(1.)
+
+      open(99,file="sigma.def",status='old',form='formatted',
+     s   iostat=ierr1)
+! Ouverture possible de fichiers typiquement E.T.
+
+      if(ierr1.ne.0) then
+         close(99)
+         open(99,file="esasig.def",status='old',form='formatted',
+     s   iostat=ierr2)
+         if(ierr2.ne.0) then
+            close(99)
+            open(99,file="tritonsig.def",status='old',form='formatted',
+     s      iostat=ierr3)
+            if(ierr3.ne.0) then
+              close(99)
+              open(99,file="z2sig.def",status='old',form='formatted',
+     s        iostat=ierr4)
+            endif
+         endif
+      endif
+
+c-----------------------------------------------------------------------
+c   cas 1 on lit les options dans sigma.def:
+c   ----------------------------------------
+
+      IF (ierr1.eq.0) THEN
+
+         PRINT*,'*****************************'
+         PRINT*,'WARNING Lecture de sigma.def'
+         PRINT*,'*****************************'
+      READ(99,*) deltaz
+      READ(99,*) h
+      READ(99,*) beta
+      READ(99,*) gama
+      READ(99,*) delta
+      READ(99,*) np
+      CLOSE(99)
+      alpha=deltaz/(llm*h)
+c
+
+       DO l = 1, llm
+          dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))*
+     $          ( (tanh(gama*l)/tanh(gama*llm))**np +
+     $            (1.-l/FLOAT(llm))*delta )
+       ENDDO
+
+       sig(1)=1.
+       DO l=1,llm-1
+          sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l))
+       ENDDO
+       sig(llm+1)=0.
+
+c
+
+! Debut de la partie martienne pour lecture de esasig.def
+c=========================================================
+
+      ELSE IF(ierr2.eq.0) then
+
+         PRINT*,'*****************************'
+         PRINT*,'WARNING Lecture de esasig.def'
+         PRINT*,'*****************************'
+         READ(99,*) h
+         READ(99,*) dz0
+         READ(99,*) dz1
+         READ(99,*) nhaut
+         CLOSE(99)
+
+         dz0=dz0/h
+         dz1=dz1/h
+
+         sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut)
+
+         esig=1.
+
+         PRINT*
+         do l=1,20
+            esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.)
+         enddo
+         print*,'esig=',esig
+         PRINT*
+         csig=(1./sig1-1.)/(exp(esig)-1.)
+
+         DO L = 2, llm
+            zz=csig*(exp(esig*(l-1.))-1.)
+            sig(l) =1./(1.+zz)
+     &      * tanh(.5*(llm+1-l)/nhaut)
+         ENDDO
+         sig(1)=1.
+         sig(llm+1)=0.
+
+c Fin de la partie martienne
+c ==========================
+
+      ELSE IF(ierr3.eq.0) then
+
+         PRINT*,'********************************'
+         PRINT*,'WARNING Lecture de tritonsig.def'
+         PRINT*,'********************************'
+         PRINT*,'kappa=', kappa
+         READ(99,*) gg
+         READ(99,*) rr
+         sig(1)=1.
+         prevz=0.
+         do l=1,llm-1
+           read(99,*) zz, tt
+           sig(l+1) = sig(l)* exp(-(zz-prevz)*gg/(rr*tt))
+           prevz=zz
+           if(l.eq.llm/2)h =1.e-3* rr*tt/gg
+         end do
+         sig(llm+1)=0.
+         CLOSE(99)
+
+      ELSE IF(ierr4.eq.0) then
+         PRINT*,'****************************'
+         PRINT*,'WARNING Lecture de z2sig.def'
+         PRINT*,'****************************'
+
+
+         READ(99,*) h
+         do l=1,llm
+            read(99,*) zsig
+            s(l) = exp(-kappa*zsig/h)
+         end do
+         CLOSE(99)
+
+         sig(1) =1
+         do l=2,llm
+           sig(l) = 0.5 * (s(l)**(1/kappa)+s(l-1)**(1/kappa))
+         end do
+         sig(llm+1) =0
+
+      ELSE
+c-----------------------------------------------------------------------
+c   cas 2 ancienne discretisation (LMD5...):
+c   ----------------------------------------
+
+      PRINT*,'********************************************'
+      PRINT*,'WARNING!!! Ancienne discretisation verticale'
+      PRINT*,'********************************************'
+      stop ! interdit sur MARS
+      h=7.
+      snorm  = 0.
+      DO l = 1, llm
+         x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1)
+         dsig(l) = 1.0 + 7.0 * SIN(x)**2
+         snorm = snorm + dsig(l)
+      ENDDO
+      snorm = 1./snorm
+      DO l = 1, llm
+         dsig(l) = dsig(l)*snorm
+      ENDDO
+      sig(llm+1) = 0.
+      DO l = llm, 1, -1
+         sig(l) = sig(l+1) + dsig(l)
+      ENDDO
+
+      ENDIF
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+        nivsigs(l) = FLOAT(l)
+      ENDDO
+
+      DO l=1,llmp1
+        nivsig(l)= FLOAT(l)
+      ENDDO
+
+c    On ne recalcule s que dans les cas "classique"
+c    (esasig.def, sigma.def, ou ancienne discretisation sans fichier)
+      IF( (ierr1.eq.0) .or. (ierr2.eq.0)
+     &   .or. ((ierr3.ne.0).and.(ierr4.ne.0)) ) then
+         quoi      = 1. + 2.* kappa
+         s( llm )  = 1.
+         s(llm-1) = quoi
+         IF( llm.gt.2 )  THEN
+            DO  ll = 2, llm-1
+               l         = llm+1 - ll
+               quand     = sig(l+1)/ sig(l)
+               s(l-1)    = quoi * (1.-quand) * s(l)  + quand * s(l+1)
+            ENDDO
+         END IF
+c
+         snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2)
+         DO l = 1, llm
+            s(l)    = s(l)/ snorm
+         ENDDO
+      END IF
+
+c
+c    ....  Calculs  de ap(l) et de bp(l)  ....
+c    .........................................
+c
+c
+c   .....  pa et preff sont lus  sur les fichiers start par dynetat0 .....
+c
+
+
+      if (hybrid) then
+         write(*,*) "*******************************"
+         write(*,*) "Systeme en coordonnees hybrides"
+         write(*,*) 
+c        Coordonnees hybrides avec mod
+         write(*,*) "sig disvert",sig
+         DO l = 1, llm
+            call sig_hybrid(sig(l),pa,preff,1.e-6,newsig)
+            bp(l) = EXP( 1. -1./( newsig*newsig) )
+            ap(l) = pa * (newsig - bp(l) )
+         enddo
+         call sig_hybrid(sig(llmp1),pa,preff,1.e-6,newsig)
+         ap(llmp1) = pa * ( newsig - bp(llmp1) )
+      else
+         write(*,*) "****************************"
+         write(*,*) "Systeme en coordonnees sigma"
+         write(*,*) 
+c        Pour ne pas passer en coordonnees hybrides
+         DO l = 1, llm
+            ap(l) = 0.
+            bp(l) = sig(l)
+         ENDDO
+         ap(llmp1) = 0.
+      endif
+
+      bp(llmp1) =   0.
+
+      PRINT *,' BP '
+      PRINT *,  bp
+      PRINT *,' AP '
+      PRINT *,  ap
+
+c     Calcul au milieu des couches :
+c     WARNING : le choix de placer le milieu des couches au niveau de
+c     pression intermédiaire est arbitraire et pourrait etre modifié.
+c     Le calcul du niveau pour la derniere couche 
+c     (on met la meme distance (en log pression)  entre P(llm)
+c     et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est
+c     Specifique.  Ce choix est spécifié ici ET dans exner_hyb.F
+
+      DO l = 1, llm-1
+       aps(l) =  0.5 *( ap(l) +ap(l+1)) 
+       bps(l) =  0.5 *( bp(l) +bp(l+1)) 
+      ENDDO
+     
+      if (hybrid) then
+         aps(llm) = ap(llm-1)**2 / ap(llm-2) 
+         bps(llm) = 0.5*(bp(llm) + bp(llm+1))
+      else
+         bps(llm) = bp(llm-1)**2 / bp(llm-2) 
+         aps(llm) = 0.
+      end if
+
+      PRINT *,' BPs '
+      PRINT *,  bps
+      PRINT *,' APs'
+      PRINT *,  aps
+
+      DO l = 1, llm
+       presnivs(l) = aps(l)+bps(l)*preff
+       pseudoalt(l) = -10.*log(presnivs(l)/preff)
+      ENDDO
+
+      PRINT *,' PRESNIVS' 
+      PRINT *,presnivs 
+      PRINT *,'Pseudo altitude des Presnivs : ' 
+      PRINT *,pseudoalt
+
+      RETURN
+      END
+
+c ************************************************************
+      subroutine sig_hybrid(sig,pa,preff,xacc,newsig)
+c     ----------------------------------------------
+c     Subroutine utilisee pour calculer des valeurs de sigma modifie
+c     pour conserver les coordonnees verticales decrites dans
+c     esasig.def/z2sig.def lors du passage en coordonnees hybrides
+c     F. Forget 2002
+c     ----------------------------------------------
+      implicit none
+      real x1, x2, xacc, sig,pa,preff, newsig, F
+      integer j
+
+      newsig = sig
+      x1=0
+      x2=1
+      if ((sig.ne.0).and.(sig.ne.1)) then
+        DO J=1,9999  ! nombre d''iteration max
+          F=(1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig -sig
+          if (F.gt.0) then
+              X2 = newsig
+              newsig=(X1+newsig)*0.5
+          else
+              X1 = newsig
+              newsig=(X2+newsig)*0.5
+          end if
+c       write(0,*) J, ' newsig =', newsig, ' F= ', F
+
+        IF(X2-X1.LT.XACC) RETURN
+        END DO
+       end if
+       Return
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/diverg.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/diverg.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/diverg.F	(revision 2744)
@@ -0,0 +1,83 @@
+      SUBROUTINE diverg(klevel,x,y,div)
+c
+c     P. Le Van
+c
+c  *********************************************************************
+c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 
+c     x et y...
+c              x et y  etant des composantes covariantes   ...
+c  *********************************************************************
+      IMPLICIT NONE
+c
+c      x  et  y  sont des arguments  d'entree pour le s-prog
+c        div      est  un argument  de sortie pour le s-prog
+c
+c
+c   ---------------------------------------------------------------------
+c
+c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
+c
+c   ---------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c    ..........          variables en arguments    ...................
+c
+      INTEGER klevel
+      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
+      INTEGER   l,ij
+c
+c    ...............     variables  locales   .........................
+
+      REAL aiy1( iip1 ) , aiy2( iip1 )
+      REAL sumypn,sumyps
+c    ...................................................................
+c
+      EXTERNAL  SSUM
+      REAL      SSUM
+c
+c
+      DO 10 l = 1,klevel
+c
+        DO  ij = iip2, ip1jm - 1
+         div( ij + 1, l )     =  
+     *   cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +
+     *   cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l) 
+        ENDDO
+c
+c     ....  correction pour  div( 1,j,l)  ......
+c     ....   div(1,j,l)= div(iip1,j,l) ....
+c
+CDIR$ IVDEP
+        DO  ij = iip2,ip1jm,iip1
+         div( ij,l ) = div( ij + iim,l )
+        ENDDO
+c
+c     ....  calcul  aux poles  .....
+c
+        DO  ij  = 1,iim
+         aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
+         aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
+        ENDDO
+        sumypn = SSUM ( iim,aiy1,1 ) / apoln
+        sumyps = SSUM ( iim,aiy2,1 ) / apols
+c
+        DO  ij = 1,iip1
+         div(     ij    , l ) = - sumypn
+         div( ij + ip1jm, l ) =   sumyps
+        ENDDO
+  10  CONTINUE
+c
+
+ccc        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
+      
+c
+        DO l = 1, klevel
+           DO ij = iip2,ip1jm
+            div(ij,l) = div(ij,l) * unsaire(ij) 
+          ENDDO
+        ENDDO
+c
+       RETURN
+       END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/diverg_gam.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/diverg_gam.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/diverg_gam.F	(revision 2744)
@@ -0,0 +1,78 @@
+      SUBROUTINE diverg_gam(klevel,cuvscvgam,cvuscugam,unsairegam ,
+     *                       unsapolnga,unsapolsga,  x, y,  div )
+c
+c     P. Le Van
+c
+c  *********************************************************************
+c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 
+c     x et y...
+c              x et y  etant des composantes covariantes   ...
+c  *********************************************************************
+      IMPLICIT NONE
+c
+c      x  et  y  sont des arguments  d'entree pour le s-prog
+c        div      est  un argument  de sortie pour le s-prog
+c
+c
+c   ---------------------------------------------------------------------
+c
+c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
+c
+c   ---------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c    ..........          variables en arguments    ...................
+c
+      INTEGER klevel
+      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
+      REAL cuvscvgam(ip1jm),cvuscugam(ip1jmp1),unsairegam(ip1jmp1)
+      REAL unsapolnga,unsapolsga
+c
+c    ...............     variables  locales   .........................
+
+      REAL aiy1( iip1 ) , aiy2( iip1 )
+      REAL sumypn,sumyps
+      INTEGER   l,ij
+c    ...................................................................
+c
+      EXTERNAL  SSUM
+      REAL      SSUM
+c
+c
+      DO 10 l = 1,klevel
+c
+        DO  ij = iip2, ip1jm - 1
+         div( ij + 1, l )     = (  
+     *  cvuscugam( ij+1 ) * x( ij+1,l ) - cvuscugam( ij ) * x( ij , l) +
+     *  cuvscvgam(ij-iim) * y(ij-iim,l) - cuvscvgam(ij+1) * y(ij+1,l) )* 
+     *         unsairegam( ij+1 )
+        ENDDO
+c
+c     ....  correction pour  div( 1,j,l)  ......
+c     ....   div(1,j,l)= div(iip1,j,l) ....
+c
+CDIR$ IVDEP
+        DO  ij = iip2,ip1jm,iip1
+         div( ij,l ) = div( ij + iim,l )
+        ENDDO
+c
+c     ....  calcul  aux poles  .....
+c
+        DO  ij  = 1,iim
+         aiy1(ij) =    cuvscvgam(    ij       ) * y(     ij     , l )
+         aiy2(ij) =    cuvscvgam( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
+        ENDDO
+        sumypn = SSUM ( iim,aiy1,1 ) * unsapolnga
+        sumyps = SSUM ( iim,aiy2,1 ) * unsapolsga
+c
+        DO  ij = 1,iip1
+         div(     ij    , l ) = - sumypn 
+         div( ij + ip1jm, l ) =   sumyps 
+        ENDDO
+  10  CONTINUE
+c
+
+       RETURN
+       END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divergf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divergf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divergf.F	(revision 2744)
@@ -0,0 +1,83 @@
+      SUBROUTINE divergf(klevel,x,y,div)
+c
+c     P. Le Van
+c
+c  *********************************************************************
+c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 
+c     x et y...
+c              x et y  etant des composantes covariantes   ...
+c  *********************************************************************
+      IMPLICIT NONE
+c
+c      x  et  y  sont des arguments  d'entree pour le s-prog
+c        div      est  un argument  de sortie pour le s-prog
+c
+c
+c   ---------------------------------------------------------------------
+c
+c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
+c
+c   ---------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c    ..........          variables en arguments    ...................
+c
+      INTEGER klevel
+      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
+      INTEGER   l,ij
+c
+c    ...............     variables  locales   .........................
+
+      REAL aiy1( iip1 ) , aiy2( iip1 )
+      REAL sumypn,sumyps
+c    ...................................................................
+c
+      EXTERNAL  SSUM
+      REAL      SSUM
+c
+c
+      DO 10 l = 1,klevel
+c
+        DO  ij = iip2, ip1jm - 1
+         div( ij + 1, l )     =  
+     *   cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +
+     *   cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l) 
+        ENDDO
+c
+c     ....  correction pour  div( 1,j,l)  ......
+c     ....   div(1,j,l)= div(iip1,j,l) ....
+c
+CDIR$ IVDEP
+        DO  ij = iip2,ip1jm,iip1
+         div( ij,l ) = div( ij + iim,l )
+        ENDDO
+c
+c     ....  calcul  aux poles  .....
+c
+        DO  ij  = 1,iim
+         aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
+         aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
+        ENDDO
+        sumypn = SSUM ( iim,aiy1,1 ) / apoln
+        sumyps = SSUM ( iim,aiy2,1 ) / apols
+c
+        DO  ij = 1,iip1
+         div(     ij    , l ) = - sumypn
+         div( ij + ip1jm, l ) =   sumyps
+        ENDDO
+  10  CONTINUE
+c
+
+        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
+      
+c
+        DO l = 1, klevel
+           DO ij = iip2,ip1jm
+            div(ij,l) = div(ij,l) * unsaire(ij) 
+          ENDDO
+        ENDDO
+c
+       RETURN
+       END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divergst.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divergst.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divergst.F	(revision 2744)
@@ -0,0 +1,60 @@
+      SUBROUTINE divergst(klevel,x,y,div)
+      IMPLICIT NONE
+c
+c     P. Le Van
+c
+c  ******************************************************************
+c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. x et y...
+c           x et y  etant des composantes contravariantes   ...
+c  ****************************************************************
+c      x  et  y  sont des arguments  d'entree pour le s-prog
+c        div      est  un argument  de sortie pour le s-prog
+c
+c
+c   -------------------------------------------------------------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      INTEGER klevel
+      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
+      INTEGER ij,l,i
+      REAL aiy1( iip1 ) , aiy2( iip1 )
+      REAL sumypn,sumyps
+
+      REAL SSUM
+      EXTERNAL SSUM
+c
+c
+      DO 10 l = 1,klevel
+c
+      DO 1 ij = iip2, ip1jm - 1
+      div( ij + 1, l ) = x(ij+1,l) - x(ij,l)+ y(ij-iim,l)-y(ij+1,l)
+   1  CONTINUE
+c
+c     ....  correction pour  div( 1,j,l)  ......
+c     ....   div(1,j,l)= div(iip1,j,l) ....
+c
+CDIR$ IVDEP
+      DO 3 ij = iip2,ip1jm,iip1
+      div( ij,l ) = div( ij + iim,l )
+   3  CONTINUE
+c
+c     ....  calcul  aux poles  .....
+c
+c
+      DO 5 i  = 1,iim
+      aiy1(i)= y(i,l)
+      aiy2(i)= y(i+ip1jmi1,l)
+   5  CONTINUE
+      sumypn = SSUM ( iim,aiy1,1 )
+      sumyps = SSUM ( iim,aiy2,1 )
+      DO 7 i = 1,iip1
+      div(     i    , l ) = - sumypn/iim
+      div( i + ip1jm, l ) =   sumyps/iim
+   7  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divgrad.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divgrad.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divgrad.F	(revision 2744)
@@ -0,0 +1,55 @@
+      SUBROUTINE divgrad (klevel,h, lh, divgra )
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c  Auteur :   P. Le Van
+c  ----------
+c
+c                              lh
+c      calcul de  (div( grad ))   de h  .....
+c      h  et lh  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+c=======================================================================
+c
+c   declarations:
+c   -------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comdissipn.h"
+#include "logic.h"
+c
+      INTEGER klevel
+      REAL h( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
+c
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+
+      INTEGER  l,ij,iter,lh
+c
+      EXTERNAL  filtreg
+      EXTERNAL  SCOPY, grad, covcont, diverg
+c
+c
+      CALL SCOPY ( ip1jmp1*klevel,h,1,divgra,1 )
+c
+      DO 10 iter = 1,lh
+
+      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1  )
+
+      CALL grad (klevel,divgra, ghx  , ghy          )
+      CALL diverg (klevel,  ghx , ghy  , divgra       )
+
+      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1)
+
+      DO 5 l = 1,klevel
+      DO 4  ij = 1, ip1jmp1
+      divgra( ij,l ) = - cdivh * divgra( ij,l )
+   4  CONTINUE
+   5  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divgrad2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divgrad2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divgrad2.F	(revision 2744)
@@ -0,0 +1,78 @@
+      SUBROUTINE divgrad2 ( klevel, h, deltapres, lh, divgra )
+c
+c     P. Le Van
+c
+c   ***************************************************************
+c
+c     .....   calcul de  (div( grad ))   de (  pext * h ) .....
+c   ****************************************************************
+c   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
+c         divgra     est  un argument  de sortie pour le s-prg
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom2.h"
+#include "comdissipn.h"
+
+c    .......    variables en arguments   .......
+c
+      INTEGER klevel
+      REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
+      REAL divgra( ip1jmp1,klevel)
+c
+c    .......    variables  locales    ..........
+c
+      REAL     signe, nudivgrs, sqrtps( ip1jmp1,llm )
+      INTEGER  l,ij,iter,lh
+c    ...................................................................
+
+      EXTERNAL  filtreg
+      EXTERNAL  SCOPY,  laplacien_gam
+c
+      signe    = (-1.)**lh
+      nudivgrs = signe * cdivh
+
+      CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
+
+c
+      CALL laplacien( klevel, divgra, divgra )
+     
+      DO l = 1, klevel
+       DO ij = 1, ip1jmp1
+        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
+       ENDDO
+      ENDDO
+c
+      DO l = 1, klevel
+        DO ij = 1, ip1jmp1
+         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
+        ENDDO
+      ENDDO
+   
+c    ........    Iteration de l'operateur  laplacien_gam    ........
+c
+      DO  iter = 1, lh - 2
+       CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
+     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
+      ENDDO
+c
+c    ...............................................................
+ 
+      DO l = 1, klevel
+        DO ij = 1, ip1jmp1
+          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
+        ENDDO
+      ENDDO
+c
+      CALL laplacien ( klevel, divgra, divgra )
+c
+      DO l  = 1,klevel
+      DO ij = 1,ip1jmp1
+      divgra(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divgrad22.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divgrad22.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/divgrad22.F	(revision 2744)
@@ -0,0 +1,55 @@
+      SUBROUTINE divgrad2_mars (klevel,h, lh, divgra )
+c
+c  P. Le Van
+c
+c   ************************************************************
+c
+c                                lh
+c        calcul de  (div( grad ))   de h  .....
+c   ************************************************************
+c      h  et lh  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+
+      INTEGER klevel
+      REAL h( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
+c
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+      REAL signe, nudivgrs
+
+      INTEGER  l,ij,iter,lh
+
+      EXTERNAL  filtreg
+      EXTERNAL  SCOPY, grad, covcont, diverg, divergst
+
+
+      signe    = (-1.)**lh
+      nudivgrs = signe * cdivh
+
+      CALL SCOPY ( ip1jmp1*klevel,h,1,divgra,1 )
+
+      DO 2 iter = 1, lh -1
+      CALL grad (klevel,divgra, ghx  , ghy          )
+      CALL divergst (klevel,  ghx , ghy  , divgra       )
+   2  CONTINUE
+
+      CALL filtreg (divgra,jjp1,klevel,2,1,.true.,1)
+      CALL grad  (klevel,divgra, ghx, ghy      )
+      CALL covcont (klevel,ghx   , ghy, ghx ,ghy )
+      CALL diverg  (klevel,ghx   , ghy,divgra    )
+
+      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1)
+
+      DO 5 l = 1,klevel
+      DO 4  ij = 1, ip1jmp1
+      divgra( ij,l ) = nudivgrs * divgra( ij,l )
+   4  CONTINUE
+   5  CONTINUE
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dteta1.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dteta1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dteta1.F	(revision 2744)
@@ -0,0 +1,67 @@
+      SUBROUTINE dteta1 ( teta, pbaru, pbarv, dteta)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
+c
+c   ********************************************************************
+c   ... calcul du terme de convergence horizontale du flux d'enthalpie
+c        potentielle   ......
+c   ********************************************************************
+c  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
+c     dteta 	          sont des arguments de sortie pour le s-pg ....
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+
+      REAL teta( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL dteta( ip1jmp1,llm )
+      INTEGER   l,ij
+
+      REAL hbyv( ip1jm,llm ), hbxu( ip1jmp1,llm )
+
+      EXTERNAL     convflu
+      EXTERNAL     filtreg
+c
+
+      DO 5 l = 1,llm
+
+      DO 1  ij = iip2, ip1jm - 1
+      hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) )
+   1  CONTINUE
+
+c    .... correction pour  hbxu(iip1,j,l)  .....
+c    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
+
+CDIR$ IVDEP
+      DO 2 ij = iip1+ iip1, ip1jm, iip1
+      hbxu( ij, l ) = hbxu( ij - iim, l )
+   2  CONTINUE
+
+
+      DO 3 ij = 1,ip1jm
+      hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) )
+   3  CONTINUE
+
+   5  CONTINUE
+
+
+        CALL convflu ( hbxu, hbyv, llm, dteta )
+
+
+c    stockage dans  dh de la convergence horizont. filtree' du  flux
+c                  ....                           ...........
+c           d'enthalpie potentielle .
+
+      CALL filtreg( dteta, jjp1, llm, 2, 2, .true., 1)
+
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dudv1.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dudv1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dudv1.F	(revision 2744)
@@ -0,0 +1,50 @@
+      SUBROUTINE dudv1 ( vorpot, pbaru, pbarv, du, dv )
+      IMPLICIT NONE
+c
+c-----------------------------------------------------------------------
+c
+c   Auteur:   P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c   calcul du terme de  rotation
+c   ce terme est ajoute a  d(ucov)/dt et a d(vcov)/dt  ..
+c   vorpot, pbaru et pbarv sont des arguments d'entree  pour le s-pg ..
+c   du  et dv              sont des arguments de sortie pour le s-pg ..
+c
+c-----------------------------------------------------------------------
+
+#include "dimensions.h"
+#include "paramet.h"
+
+      REAL vorpot( ip1jm,llm ) ,pbaru( ip1jmp1,llm ) ,
+     *     pbarv( ip1jm,llm ) ,du( ip1jmp1,llm ) ,dv( ip1jm,llm )
+      INTEGER  l,ij
+c
+c
+      DO 10 l = 1,llm
+c
+      DO 2  ij = iip2, ip1jm - 1
+      du( ij,l ) = 0.125 *(  vorpot(ij-iip1, l) + vorpot( ij, l)  ) *
+     *                    (   pbarv(ij-iip1, l) + pbarv(ij-iim,  l) +
+     *                        pbarv(   ij  , l) + pbarv(ij+ 1 ,  l)   )
+   2  CONTINUE
+c
+      DO 3 ij = 1, ip1jm - 1
+      dv( ij+1,l ) = - 0.125 *(  vorpot(ij, l)  + vorpot(ij+1, l)  ) *
+     *                        (   pbaru(ij, l)  +  pbaru(ij+1   , l) +
+     *                       pbaru(ij+iip1, l)  +  pbaru(ij+iip2, l)  )
+   3  CONTINUE
+c
+c    .... correction  pour  dv( 1,j,l )  .....
+c    ....   dv(1,j,l)= dv(iip1,j,l) ....
+c
+CDIR$ IVDEP
+      DO 4 ij = 1, ip1jm, iip1
+      dv( ij,l ) = dv( ij + iim, l )
+   4  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dudv2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dudv2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dudv2.F	(revision 2744)
@@ -0,0 +1,60 @@
+      SUBROUTINE dudv2 ( teta, pkf, bern, du, dv  )
+
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   *****************************************************************
+c   ..... calcul du terme de pression (gradient de p/densite )   et
+c          du terme de ( -gradient de la fonction de Bernouilli ) ...
+c   *****************************************************************
+c          Ces termes sont ajoutes a  d(ucov)/dt et a d(vcov)/dt  ..
+c
+c
+c    teta , pkf, bern  sont des arguments d'entree  pour le s-pg  ....
+c    du et dv          sont des arguments de sortie pour le s-pg  ....
+c
+c=======================================================================
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+
+      REAL teta( ip1jmp1,llm ),pkf( ip1jmp1,llm ) ,bern( ip1jmp1,llm ),
+     *         du( ip1jmp1,llm ),  dv( ip1jm,llm )
+      INTEGER  l,ij
+c
+c
+      DO 5 l = 1,llm
+c
+      DO 2  ij  = iip2, ip1jm - 1
+       du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) *
+     * ( pkf( ij,l ) - pkf(ij+1,l) )  + bern(ij,l) - bern(ij+1,l)
+   2  CONTINUE
+c
+c
+c    .....  correction  pour du(iip1,j,l),  j=2,jjm   ......
+c    ...          du(iip1,j,l) = du(1,j,l)                 ...
+c
+CDIR$ IVDEP
+      DO 3 ij = iip1+ iip1, ip1jm, iip1
+      du( ij,l ) = du( ij - iim,l )
+   3  CONTINUE
+c
+c
+      DO 4 ij  = 1,ip1jm
+      dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) *
+     *                             ( pkf(ij+iip1,l) - pkf(  ij,l  ) )
+     *                           +   bern( ij+iip1,l ) - bern( ij  ,l )
+   4  CONTINUE
+c
+   5  CONTINUE
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dump2d.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dump2d.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dump2d.F	(revision 2744)
@@ -0,0 +1,43 @@
+      SUBROUTINE dump2d(im,jm,z,nom_z)
+      IMPLICIT NONE
+      INTEGER im,jm
+      REAL z(im,jm)
+      CHARACTER*80 nom_z
+
+      INTEGER i,j,imin,illm,jmin,jllm
+      REAL zmin,zllm
+
+      PRINT*,nom_z
+
+      zmin=z(1,1)
+      zllm=z(1,1)
+      imin=1
+      illm=1
+      jmin=1
+      jllm=1
+
+      DO j=1,jm
+         DO i=1,im
+            IF(z(i,j).GT.zllm) THEN
+               illm=i
+               jllm=j
+               zllm=z(i,j)
+            ENDIF
+            IF(z(i,j).LT.zmin) THEN
+               imin=i
+               jmin=j
+               zmin=z(i,j)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      PRINT*,'MIN: ',zmin
+      PRINT*,'MAX: ',zllm
+
+      IF(zllm.GT.zmin) THEN
+      DO j=1,jm
+      WRITE(*,'(72i1)') (NINT(10.*(z(i,j)-zmin)/(zllm-zmin)),i=1,im)
+      ENDDO
+      ENDIF
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dynetat0.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dynetat0.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dynetat0.F	(revision 2744)
@@ -0,0 +1,413 @@
+      SUBROUTINE dynetat0(fichnom,nq,vcov,ucov,
+     .                    teta,q,masse,ps,phis,time)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van / L.Fairhead
+c   -------
+c
+c   objet:
+c   ------
+c
+c   Lecture de l'etat initial
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+#include "logic.h"
+
+c   Arguments:
+c   ----------
+
+      CHARACTER*(*) fichnom
+      INTEGER nq
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL q(iip1,jjp1,llm,nq),masse(ip1jmp1,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+
+      REAL time
+
+c   Variables 
+c
+      INTEGER length,iq,i,j,l
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER ierr, nid, nvarid, nqold
+      CHARACTER  str3*3,yes*1
+
+c-----------------------------------------------------------------------
+
+c  Ouverture NetCDF du fichier etat initial
+
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier ',fichnom
+        CALL ABORT
+      ENDIF
+
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <controle> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echoue pour <controle>"
+         CALL abort
+      ENDIF
+
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ini    = tab_cntrl(4)
+      rad        = tab_cntrl(5)
+      omeg       = tab_cntrl(6)
+      g          = tab_cntrl(7)
+      cpp        = tab_cntrl(8)
+      kappa      = tab_cntrl(9)
+      daysec     = tab_cntrl(10)
+      dtvr       = tab_cntrl(11)
+      etot0      = tab_cntrl(12)
+      ptot0      = tab_cntrl(13)
+      ztot0      = tab_cntrl(14)
+      stot0      = tab_cntrl(15)
+      ang0       = tab_cntrl(16)
+      pa         = tab_cntrl(17)
+      preff      = tab_cntrl(18)
+c
+      clon       = tab_cntrl(19)
+      clat       = tab_cntrl(20)
+      grossismx  = tab_cntrl(21)
+      grossismy  = tab_cntrl(22)
+c
+      IF ( tab_cntrl(23).EQ.1. )  THEN
+        fxyhypb  = . TRUE .
+        dzoomx   = tab_cntrl(24)
+        dzoomy   = tab_cntrl(25)
+        taux     = tab_cntrl(27)
+        tauy     = tab_cntrl(28)
+      ELSE
+        fxyhypb = . FALSE .
+        ysinus  = . FALSE .
+        IF( tab_cntrl(26).EQ.1. ) ysinus = . TRUE. 
+      ENDIF
+c   .................................................................
+c
+c
+      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+ 
+      IF(   im.ne.iim           )  THEN
+          PRINT 1,im,iim
+          STOP
+      ELSE  IF( jm.ne.jjm       )  THEN
+          PRINT 2,jm,jjm
+          STOP
+      ELSE  IF( lllm.ne.llm     )  THEN
+          PRINT 3,lllm,llm
+          STOP
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <rlonu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <rlatu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <rlonv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <rlatv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour rlatv"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "cu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <cu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <cu>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "cv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <cv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <cv>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "aire", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <aire> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <aire>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <phisinit> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+	     ierr = NF_INQ_VARID (nid, "temps", nvarid)
+		 IF (ierr .NE. NF_NOERR) THEN
+           PRINT*, "dynetat0: <Time> or <temps> absent"
+           CALL abort
+         ENDIF
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee <Time>/<temps>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <ucov> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <ucov>"
+         CALL abort
+      ENDIF
+ 
+      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <vcov> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <vcov>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "teta", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <teta> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <teta>"
+         CALL abort
+      ENDIF
+
+
+      IF(nq.GE.1) THEN
+
+         IF(nq.GT.99) THEN
+            PRINT*, "Trop de traceurs"
+            CALL abort
+         ENDIF
+         nqold=nq
+         DO iq=1,nq
+           str3(1:1)='q'
+           WRITE(str3(2:3),'(i2.2)') iq
+           ierr =  NF_INQ_VARID (nid, str3, nvarid)
+           IF (ierr .NE. NF_NOERR) THEN
+              PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
+              PRINT*, "          Il est donc initialise a zero"
+              CALL initial0(ijp1llm,q(1,1,1,iq))
+              nqold=min(iq-1,nqold)
+           ELSE
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,1,iq))
+#else
+           ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,1,iq))
+#endif
+              IF (ierr .NE. NF_NOERR) THEN
+                 PRINT*, "dynetat0: Lecture echouee pour "//str3
+                 CALL abort
+              ENDIF
+           ENDIF
+         ENDDO
+         if(nqold.lt.nq) then   
+c        case when new tracer are added in addition to old ones
+             write(*,*)'tracers 1 to ', nqold,'were already present'
+             write(*,*)'tracers ', nqold+1,' to ', nqmx,'are new'
+             yes=' '
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+             write(*,*) 'Would you like to reindex tracer # 1 ->',nqold
+             write(*,*) 'to #',nqmx-nqold+1,'->', nqmx,'   (y or n) ?'
+             read(*,fmt='(a)') yes
+            end do
+            if (yes.eq.'y') then
+              write(*,*) 'OK, let s reindex the tracers'
+              do l=1,llm
+                do j=1,jjp1
+                  do i=1,iip1
+                    do iq=nqmx,nqmx-nqold+1,-1
+                       q(i,j,l,iq)=q(i,j,l,iq-nqmx+nqold)   
+                    end do
+                    do iq=nqmx-nqold,1,-1
+                       q(i,j,l,iq)= 0.
+                    end do
+                  end do
+                end do
+              end do
+            end if 
+         end if
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "masse", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <masse> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <masse>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <ps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <ps>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_CLOSE(nid)
+
+       day_ini=day_ini+INT(time)
+       time=time-INT(time)
+
+  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
+     *arrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
+     *arrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
+     *rrage est differente de la valeur parametree llm =',i4//)
+   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
+     *rrage est differente de la valeur  dtinteg =',i4//)
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dynredem.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dynredem.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/dynredem.F	(revision 2744)
@@ -0,0 +1,694 @@
+      SUBROUTINE dynredem0(fichnom,idayref,anneeref,phis,nq)
+      IMPLICIT NONE
+c=======================================================================
+c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
+c=======================================================================
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+
+c   Arguments:
+c   ----------
+      INTEGER*4 idayref,anneeref
+      REAL phis(ip1jmp1)
+      CHARACTER*(*) fichnom
+      INTEGER nq
+
+c   Local:
+c   ------
+      INTEGER iq,l
+      CHARACTER str3*3
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER ierr
+      character*20 modname
+      character*80 abort_message
+
+c   Variables locales pour NetCDF:
+c
+      INTEGER dims2(2), dims3(3), dims4(4)
+      INTEGER idim_index
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_llm, idim_llmp1
+      INTEGER idim_tim
+      INTEGER nid,nvarid
+
+      REAL zan0,zjulian,hours
+      REAL sigs(llm)
+      INTEGER yyears0,jjour0, mmois0
+      character*30 unites
+
+
+c-----------------------------------------------------------------------
+      modname='dynredem'
+      do l=1,llm
+         sigs(l)=float(l)
+      enddo
+
+      DO l=1,length
+       tab_cntrl(l) = 0.
+      ENDDO
+       tab_cntrl(1)  = FLOAT(iim)
+       tab_cntrl(2)  = FLOAT(jjm)
+       tab_cntrl(3)  = FLOAT(llm)
+       tab_cntrl(4)  = FLOAT(idayref)
+       tab_cntrl(5)  = rad
+       tab_cntrl(6)  = omeg
+       tab_cntrl(7)  = g
+       tab_cntrl(8)  = cpp
+       tab_cntrl(9) = kappa
+       tab_cntrl(10) = daysec
+       tab_cntrl(11) = dtvr
+       tab_cntrl(12) = etot0
+       tab_cntrl(13) = ptot0
+       tab_cntrl(14) = ztot0
+       tab_cntrl(15) = stot0
+       tab_cntrl(16) = ang0
+       tab_cntrl(17) = pa
+       tab_cntrl(18) = preff
+c
+c    .....    parametres  pour le zoom      ......   
+
+       tab_cntrl(19)  = clon
+       tab_cntrl(20)  = clat
+       tab_cntrl(21)  = grossismx
+       tab_cntrl(22)  = grossismy
+c
+      IF ( fxyhypb )   THEN
+       tab_cntrl(23) = 1.
+       tab_cntrl(24) = dzoomx
+       tab_cntrl(25) = dzoomy
+       tab_cntrl(26) = 0.
+       tab_cntrl(27) = taux
+       tab_cntrl(28) = tauy
+      ELSE
+       tab_cntrl(23) = 0.
+       tab_cntrl(24) = dzoomx
+       tab_cntrl(25) = dzoomy
+       tab_cntrl(26) = 0.
+       tab_cntrl(27) = 0.
+       tab_cntrl(28) = 0.
+       IF( ysinus )  tab_cntrl(26) = 1. 
+      ENDIF
+c
+c    .........................................................
+c
+c Creation du fichier:
+c
+      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
+         WRITE(6,*)' ierr = ', ierr
+         CALL ABORT
+      ENDIF
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid,NF_GLOBAL,"title",18,
+     .                       "Dynamic start file")
+c
+c Definir les dimensions du fichiers:
+c
+      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
+      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim)
+
+c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
+c     ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+c     ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+c     ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+c
+c Definir et enregistrer certains champs invariants:
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
+     .          "Coef A: hybrid pressure levels"  )
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
+     .      "Coef B: hybrid sigma levels")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37,
+     .      "Coef AS: hybrid pressure in midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 31,
+     .      "Coef BS: hybrid sigma midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+c ------------------------------------------------------------------
+c ------------------------------------------------------------------
+c  Variable uniquement pour visualisation avec Grads ou Ferret
+c ------------------------------------------------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+  
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+  
+  
+c ----------------------
+c ----------------------
+c
+c Coefficients de passage cov. <-> contra. <--> naturel
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonu
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatv
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+c ----------------------
+c Aire de chaque maille:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Aires de chaque maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+c
+c ----------------------
+c Geopentiel au sol:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Geopotentiel au sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+c ----------------------
+c Definir les variables pour pouvoir les enregistrer plus tard:
+c
+      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
+c
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Temps de simulation")
+      write(unites,200)yyears0,mmois0,jjour0
+200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
+     .                         unites)
+
+c
+      dims4(1) = idim_rlonu
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Vitesse U")
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatv
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Vitesse V")
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
+     .                       "Temperature")
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+      IF(nq.GE.1) THEN
+         DO iq=1,nq
+            IF (iq.GT.99) THEN
+               PRINT*, "Trop de traceurs"
+               CALL abort
+            ELSE
+               str3(1:1)='q'
+               WRITE(str3(2:3),'(i2.2)') iq
+#ifdef NC_DOUBLE
+               ierr = NF_DEF_VAR (nid,str3,NF_DOUBLE,4,dims4,nvarid)
+#else
+               ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
+#endif
+               ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
+     .                          "Traceurs "//str3)
+            ENDIF
+         ENDDO
+      ENDIF
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
+     .                       "C est quoi ?")
+c
+      dims3(1) = idim_rlonv
+      dims3(2) = idim_rlatu
+      dims3(3) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
+     .                       "Pression au sol")
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+      ierr = NF_CLOSE(nid) ! fermer le fichier
+
+      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      PRINT*,'rad,omeg,g,cpp,kappa',
+     ,        rad,omeg,g,cpp,kappa
+
+      RETURN
+      END
+
+c ================================================================
+      SUBROUTINE dynredem1(fichnom,time,
+     .                     vcov,ucov,teta,q,nq,masse,ps)
+      IMPLICIT NONE
+c=================================================================
+c  Ecriture du fichier de redemarrage sous format NetCDF
+c=================================================================
+#include "dimensions.h"
+#include "paramet.h"
+#include "description.h"
+#include "netcdf.inc"
+#include "comvert.h"
+#include "comgeom.h"
+
+      INTEGER nq, l
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
+      REAL teta(ip1jmp1,llm)                   
+      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
+      REAL q(iip1,jjp1,llm,nqmx)
+      REAL q3d(iip1,jjp1,llm) !temporary variable
+      CHARACTER*(*) fichnom
+     
+      REAL time
+      INTEGER nid, nvarid
+      INTEGER ierr
+      INTEGER iq
+      CHARACTER str3*3
+      character*20 modname
+      character*80 abort_message
+c
+      INTEGER nb,i,j
+      SAVE nb
+      DATA nb / 0 /
+
+      modname = 'dynredem1'
+      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Pb. d ouverture "//fichnom
+         CALL abort
+      ENDIF
+
+c  Ecriture/extension de la coordonnee temps
+
+      nb = nb + 1
+      ierr = NF_INQ_VARID(nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         print *, NF_STRERROR(ierr)
+         abort_message='Variable Time n est pas definie'
+         CALL abort_gcm(modname,abort_message,ierr)
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
+#else
+      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
+#endif
+      PRINT*, "Enregistrement pour ", nb, time
+
+c  Ecriture des champs
+c
+      ierr = NF_INQ_VARID(nid, "ucov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable ucov n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
+#endif
+
+      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable vcov n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
+#endif
+
+      ierr = NF_INQ_VARID(nid, "teta", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable teta n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
+#endif
+
+      IF (nq.GT.99) THEN
+         PRINT*, "Trop de traceurs"
+         CALL abort
+      ENDIF
+      IF(nq.GE.1) THEN
+         DO iq=1,nq
+            str3(1:1)='q'
+            WRITE(str3(2:3),'(i2.2)') iq
+            ierr = NF_INQ_VARID(nid, str3, nvarid)
+            IF (ierr .NE. NF_NOERR) THEN
+               PRINT*, "Variable "//str3//" n est pas definie"
+               CALL abort
+            ENDIF
+            do l=1,llm
+               do j=1,jjp1
+                  do i=1,iip1
+                     q3d(i,j,l)=q(i,j,l,iq)
+                  enddo
+               enddo
+            enddo
+#ifdef NC_DOUBLE
+            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q3d)
+#else
+            ierr = NF_PUT_VAR_REAL (nid,nvarid,q3d)
+#endif
+            IF (ierr .NE. NF_NOERR) THEN
+               PRINT*, "Error: ", NF_STRERROR(ierr)
+               CALL abort
+            ENDIF
+         ENDDO
+      ENDIF
+c
+      ierr = NF_INQ_VARID(nid, "masse", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable masse n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
+#endif
+c
+      ierr = NF_INQ_VARID(nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable ps n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
+#endif
+
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ener.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ener.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ener.h	(revision 2744)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'ener.h'
+
+      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,
+     *            ang,etot,ptot,ztot,stot,rmsdpdt ,
+     *            rmsv,gtot(llmm1)
+
+      REAL ang0,etot0,ptot0,ztot0,stot0,
+     s     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/enercin.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/enercin.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/enercin.F	(revision 2744)
@@ -0,0 +1,96 @@
+      SUBROUTINE enercin ( vcov, ucov, vcont, ucont, ecin )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur: P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c *********************************************************************
+c .. calcul de l'energie cinetique aux niveaux s  ......
+c *********************************************************************
+c  vcov, vcont, ucov et ucont sont des arguments d'entree pour le s-pg .
+c  ecin         est  un  argument de sortie pour le s-pg
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      REAL vcov( ip1jm,llm ),vcont( ip1jm,llm ),
+     * ucov( ip1jmp1,llm ),ucont( ip1jmp1,llm ),ecin( ip1jmp1,llm )
+
+      REAL ecinni( iip1 ),ecinsi( iip1 )
+
+      REAL ecinpn, ecinps
+      INTEGER     l,ij,i
+
+      EXTERNAL    SSUM
+      REAL        SSUM
+
+
+
+c                 . V
+c                i,j-1
+
+c      alpha4 .       . alpha1
+
+
+c        U .      . P     . U
+c       i-1,j    i,j      i,j
+
+c      alpha3 .       . alpha2
+
+
+c                 . V
+c                i,j
+
+c    
+c  L'energie cinetique au point scalaire P(i,j) ,autre que les poles, est :
+c       Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +
+c              0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +
+c              0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +
+c              0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
+
+
+      DO 5 l = 1,llm
+
+      DO 1  ij = iip2, ip1jm -1
+      ecin( ij+1, l )  =    0.5  *
+     * (   ucov( ij   ,l ) * ucont( ij   ,l ) * alpha3p4( ij +1 )   +
+     *     ucov( ij+1 ,l ) * ucont( ij+1 ,l ) * alpha1p2( ij +1 )   +
+     *     vcov(ij-iim,l ) * vcont(ij-iim,l ) * alpha1p4( ij +1 )   +
+     *     vcov( ij+ 1,l ) * vcont( ij+ 1,l ) * alpha2p3( ij +1 )   )
+   1  CONTINUE
+
+c    ... correction pour  ecin(1,j,l)  ....
+c    ...   ecin(1,j,l)= ecin(iip1,j,l) ...
+
+CDIR$ IVDEP
+      DO 2 ij = iip2, ip1jm, iip1
+      ecin( ij,l ) = ecin( ij + iim, l )
+   2  CONTINUE
+
+c     calcul aux poles  .......
+
+
+      DO 3 i = 1, iim
+      ecinni(i) = vcov(    i  ,  l) * vcont(    i    ,l) * aire(   i   )
+      ecinsi(i) = vcov(i+ip1jmi1,l) * vcont(i+ip1jmi1,l) * aire(i+ip1jm)
+   3  CONTINUE
+
+      ecinpn = 0.5 * SSUM( iim,ecinni,1 ) / apoln
+      ecinps = 0.5 * SSUM( iim,ecinsi,1 ) / apols
+
+      DO 4 ij = 1,iip1
+      ecin(   ij     , l ) = ecinpn
+      ecin( ij+ ip1jm, l ) = ecinps
+   4  CONTINUE
+
+   5  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/exner.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/exner.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/exner.F	(revision 2744)
@@ -0,0 +1,29 @@
+      SUBROUTINE exner(ngrid,pext,aire,pks,pksf)
+      IMPLICIT NONE
+
+c      .........    Version du 16/04/96     .........
+c
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "comconst.h"
+
+      INTEGER ngrid
+      REAL pext(ngrid),aire(ngrid),pks(ngrid),pksf(ngrid)
+
+      INTEGER ig,iii
+
+      EXTERNAL filtreg
+
+c-----------------------------------------------------------------------
+
+      DO 3 ig = 1,ngrid
+         pks( ig )     = ( pext( ig )/ aire( ig ) ) ** kappa
+         pksf( ig )    = pks( ig )
+   3  CONTINUE
+
+      CALL filtreg (pksf,jmp1,1,2,1,.true.,1)
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/exnerF
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/exnerF	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/exnerF	(revision 2744)
@@ -0,0 +1,88 @@
+      SUBROUTINE  exner ( ngrid, ps, p, pks, pk, pkf )
+c
+c     Auteurs :  P.Le Van  , Fr. Hourdin  .
+c    ..........
+c
+c    .... ngrid, ps,p  sont des argum.d'entree  au sous-prog.   ....
+c    .... pks,pk,pkf   sont des argum.de sortie au sous-prog.   ....
+c
+c   ************************************************************************
+c    Calcule la fonction d'Exner pk = Cp * p ** kappa , aux milieux des 
+c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
+c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
+c   ************************************************************************
+c  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
+c    la pression et la fonction d'Exner  au  sol  .
+c
+c                                 -------- z                                   
+c    A partir des relations  ( 1 ) p*dz(pk) = kappa *pk*dz(p)      et
+c                            ( 2 ) pk(l) = alpha(l)+ beta(l)*pk(l-1)
+c    ( voir note de Fr.Hourdin )  ,
+c
+c    on determine successivement , du haut vers le bas des couches, les 
+c    coef. alpha(llm),beta(llm) .,.,alpha(l),beta(l),,,alpha(2),beta(2), 
+c    puis pk(ij,1). Ensuite ,on calcule,du bas vers le haut des couches,  
+c     pk(ij,l)  donne  par la relation (2),  pour l = 2 a l = llm .
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+
+      INTEGER  ngrid
+      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
+      REAL ps(ngrid),pks(ngrid)
+      INTEGER l, ij
+      REAL alpha(ngrid,llm),beta(ngrid,llm),unpl2k,delta
+      EXTERNAL filtreg
+c
+      unpl2k    = 1.+ 2.* kappa
+c
+      DO   ij  = 1, ngrid
+       pks(ij) = cpp * (ps(ij)/preff) ** kappa
+      ENDDO
+c
+c    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
+c
+      DO     ij      = 1, ngrid
+       alpha(ij,llm) = 0.
+       beta (ij,llm) = 1./ unpl2k
+      ENDDO
+c
+c     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
+c
+      DO l = llm -1 , 2 , -1
+c
+        DO ij = 1, ngrid
+        delta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
+        alpha(ij,l)  = - p(ij,l+1) / delta * alpha(ij,l+1)
+        beta (ij,l)  =   p(ij,l  ) / delta   
+        ENDDO
+c
+      ENDDO
+c
+c  ***********************************************************************
+c     .....  Calcul de pk pour la couche 1 , pres du sol  ....
+c
+      DO   ij   = 1, ngrid
+       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  /
+     *    (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
+      ENDDO
+c
+c    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
+c
+      DO l = 2, llm
+        DO   ij   = 1, ngrid
+         pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
+        ENDDO
+      ENDDO
+c
+c
+      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
+      CALL filtreg ( pkf, jmp1, llm, 2, 1, .true., 1)
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/exner_hyb.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/exner_hyb.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/exner_hyb.F	(revision 2744)
@@ -0,0 +1,102 @@
+      SUBROUTINE  exner_hyb ( ngrid, ps, p,beta, pks, pk, pkf )
+c
+c     Auteurs :  F. Forget , Y. Wanherdrick
+c P.Le Van  , Fr. Hourdin  .
+c    ..........
+c
+c    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
+c    .... beta, pks,pk,pkf   sont des argum.de sortie au sous-prog ...
+c
+c   ************************************************************************
+c    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des 
+c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
+c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
+c   ************************************************************************
+c    .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
+c    la pression et la fonction d'Exner  au  sol  .
+c
+c     WARNING : CECI est une version speciale de exner_hyb originale
+c               Utilis dans la version martienne pour pouvoir 
+c               tourner avec des coordonnes verticales complexe
+c              => Il ne verifie PAS la condition la proportionalit en 
+c              nergie totale/ interne / potentielle (F.Forget 2001)
+c    ( voir note de Fr.Hourdin )  ,
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "serre.h"
+
+      INTEGER  ngrid
+      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
+      REAL ps(ngrid),pks(ngrid), beta(ngrid,llm)
+
+c    .... variables locales   ...
+
+      INTEGER l, ij
+      REAL dum1
+
+      REAL ppn(iim),pps(iim)
+      REAL xpn, xps
+      REAL SSUM
+      EXTERNAL filtreg, SSUM
+      
+c     -------------
+c     Calcul de pks
+c     -------------
+   
+      DO   ij  = 1, ngrid
+        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
+      ENDDO
+
+      DO  ij   = 1, iim
+        ppn(ij) = aire(   ij   ) * pks(  ij     )
+        pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
+      ENDDO
+      xpn      = SSUM(iim,ppn,1) /apoln
+      xps      = SSUM(iim,pps,1) /apols
+
+      DO ij   = 1, iip1
+        pks(   ij     )  =  xpn
+        pks( ij+ip1jm )  =  xps
+      ENDDO
+c
+c
+c    .... Calcul de pk  pour la couche l 
+c    --------------------------------------------
+c
+      dum1 = cpp * (2*preff)**(-kappa) 
+      DO l = 1, llm-1
+        DO   ij   = 1, ngrid
+         pk(ij,l) = dum1 * (p(ij,l) + p(ij,l+1))**kappa
+        ENDDO
+      ENDDO
+
+c    .... Calcul de pk  pour la couche l = llm ..
+c    (on met la meme distance (en log pression)  entre Pk(llm)
+c    et Pk(llm -1) qu'entre Pk(llm-1) et Pk(llm-2)
+
+      DO   ij   = 1, ngrid
+         pk(ij,llm) = pk(ij,llm-1)**2 / pk(ij,llm-2)
+      ENDDO
+
+
+c    calcul de pkf
+c    -------------
+      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
+      CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
+      
+c    EST-CE UTILE ?? : calcul de beta
+c    --------------------------------
+      DO l = 2, llm
+        DO   ij   = 1, ngrid
+          beta(ij,l) = pk(ij,l) / pk(ij,l-1)   
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/flumass.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/flumass.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/flumass.F	(revision 2744)
@@ -0,0 +1,107 @@
+      SUBROUTINE flumass (massebx,masseby, vcont, ucont, pbaru, pbarv )
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:  P. Le Van, F. Hourdin  .
+c   -------
+c
+c   Objet:
+c   ------
+c
+c *********************************************************************
+c     .... calcul du flux de masse  aux niveaux s ......
+c *********************************************************************
+c   massebx,masseby,vcont et ucont sont des argum. d'entree pour le s-pg .
+c       pbaru  et pbarv            sont des argum.de sortie pour le s-pg .
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      REAL massebx( ip1jmp1,llm ),masseby( ip1jm,llm ) ,
+     * vcont( ip1jm,llm ),ucont( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),
+     * pbarv( ip1jm,llm )
+
+      REAL apbarun( iip1 ),apbarus( iip1 )
+
+      REAL sairen,saireun,saires,saireus,ctn,cts,ctn0,cts0
+      INTEGER  l,ij,i
+
+      EXTERNAL   SSUM
+      REAL       SSUM
+
+
+      DO  5 l = 1,llm
+
+      DO  1 ij = iip2,ip1jm
+      pbaru( ij,l ) = massebx( ij,l ) * ucont( ij,l )
+   1  CONTINUE
+
+      DO 3 ij = 1,ip1jm
+      pbarv( ij,l ) = masseby( ij,l ) * vcont( ij,l )
+   3  CONTINUE
+
+   5  CONTINUE
+
+c    ................................................................
+c     calcul de la composante du flux de masse en x aux poles .......
+c    ................................................................
+c     par la resolution d'1 systeme de 2 equations .
+
+c     la premiere equat.decrivant le calcul de la divergence en 1 point i
+c     du pole,ce calcul etant itere de i=1 a i=im .
+c                 c.a.d   ,
+c     ( ( 0.5*pbaru(i)-0.5*pbaru(i-1) - pbarv(i))/aire(i)   =
+c                                           - somme de ( pbarv(n) )/aire pole
+
+c     l'autre equat.specifiant que la moyenne du flux de masse au pole est =0.
+c     c.a.d    somme de pbaru(n)*aire locale(n) = 0.
+
+c     on en revient ainsi a determiner la constante additive commune aux pbaru
+c     qui representait pbaru(0,j,l) dans l'equat.du calcul de la diverg.au pt
+c     i=1 .
+c     i variant de 1 a im
+c     n variant de 1 a im
+
+      sairen = SSUM( iim,  aire(   1     ), 1 )
+      saireun= SSUM( iim, aireu(   1     ), 1 )
+      saires = SSUM( iim,  aire( ip1jm+1 ), 1 )
+      saireus= SSUM( iim, aireu( ip1jm+1 ), 1 )
+
+      DO 20 l = 1,llm
+
+      ctn =  SSUM( iim, pbarv(    1     ,l),  1 )/ sairen
+      cts =  SSUM( iim, pbarv(ip1jmi1+ 1,l),  1 )/ saires
+
+      pbaru(    1   ,l )=   pbarv(    1     ,l ) - ctn * aire(    1    )
+      pbaru( ip1jm+1,l )= - pbarv( ip1jmi1+1,l ) + cts * aire( ip1jm+1 )
+
+      DO 11 i = 2,iim
+      pbaru(    i    ,l ) = pbaru(   i - 1   ,l )    +
+     *                      pbarv(    i      ,l ) - ctn * aire(   i    )
+
+      pbaru( i+ ip1jm,l ) = pbaru( i+ ip1jm-1,l )    -
+     *                      pbarv( i+ ip1jmi1,l ) + cts * aire(i+ ip1jm)
+  11  CONTINUE
+      DO 12 i = 1,iim
+      apbarun(i) = aireu(    i   ) * pbaru(   i    , l)
+      apbarus(i) = aireu(i +ip1jm) * pbaru(i +ip1jm, l)
+  12  CONTINUE
+      ctn0 = -SSUM( iim,apbarun,1 )/saireun
+      cts0 = -SSUM( iim,apbarus,1 )/saireus
+      DO 14 i = 1,iim
+      pbaru(   i    , l) = 2. * ( pbaru(   i    , l) + ctn0 )
+      pbaru(i+ ip1jm, l) = 2. * ( pbaru(i +ip1jm, l) + cts0 )
+  14  CONTINUE
+
+      pbaru(   iip1 ,l ) = pbaru(    1    ,l )
+      pbaru( ip1jmp1,l ) = pbaru( ip1jm +1,l )
+  20  CONTINUE
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fluxstoke.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fluxstoke.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fluxstoke.F	(revision 2744)
@@ -0,0 +1,149 @@
+      SUBROUTINE fluxstoke(pbaru,pbarv,masse,teta,phi,phis)
+c
+c     Auteur :  F. Hourdin
+c
+c
+ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "tracstoke.h"
+
+
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL masse(ip1jmp1,llm),teta(ip1jmp1,llm),phi(ip1jmp1,llm)
+      REAL phis(ip1jmp1)
+
+      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
+      REAL massem(ip1jmp1,llm),tetac(ip1jmp1,llm),phic(ip1jmp1,llm)
+
+      REAL pbarug(ip1jmp1,llm),pbarvg(iip1,jjm,llm),wg(ip1jmp1,llm)
+
+      REAL pbarvst(iip1,jjp1,llm)
+
+
+      INTEGER iadvtr 
+      INTEGER ij,l,irec,i,j
+ 
+      SAVE iadvtr, massem,pbaruc,pbarvc,irec
+      SAVE phic,tetac
+      logical first
+      save first
+      data first/.true./
+      DATA iadvtr/0/
+
+      if(first) then
+#ifdef CRAY
+         CALL ASSIGN("assign -N ieee -F null f:fluxmass")
+#endif
+         open(47,file='fluxmass',form='unformatted',
+     s        access='direct',recl=4*(6*ijp1llm))
+         irec=1
+         first=.false.
+
+         open(77,file='fluxmass.ctl',status='unknown',form='formatted')
+
+      endif
+
+
+      IF(iadvtr.EQ.0) THEN
+         CALL initial0(ijp1llm,phic)
+         CALL initial0(ijp1llm,tetac)
+         CALL initial0(ijp1llm,pbaruc)
+         CALL initial0(ijmllm,pbarvc)
+      ENDIF
+
+c   accumulation des flux de masse horizontaux
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
+            tetac(ij,l) = tetac(ij,l) + teta(ij,l)
+            phic(ij,l) = phic(ij,l) + phi(ij,l)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
+         ENDDO
+      ENDDO
+
+c   selection de la masse instantannee des mailles avant le transport.
+      IF(iadvtr.EQ.0) THEN
+         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
+      ENDIF
+
+      iadvtr   = iadvtr+1
+
+
+c   Test pour savoir si on advecte a ce pas de temps
+      IF ( iadvtr.EQ.istdyn ) THEN
+
+c    normalisation
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
+            tetac(ij,l) = tetac(ij,l)/float(istdyn)
+            phic(ij,l) = phic(ij,l)/float(istdyn)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
+         ENDDO
+      ENDDO
+
+c   traitement des flux de masse avant advection.
+c     1. calcul de w
+c     2. groupement des mailles pres du pole.
+
+        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
+
+        do l=1,llm
+           do j=1,jjm
+              do i=1,iip1
+                 pbarvst(i,j,l)=pbarvg(i,j,l)
+              enddo
+           enddo
+           do i=1,iip1
+              pbarvst(i,jjp1,l)=0.
+           enddo
+        enddo
+
+         iadvtr=0
+
+         irec=irec+1
+         write(47,rec=1) float(irec),dtvr,float(istdyn),
+     s    float(iim),float(jjm),float(llm),rlonu,rlonv,rlatu,rlatv
+     s    ,aire,phis
+         write(47,rec=irec) massem,pbarug,pbarvst,wg,tetac,phic
+
+c   on reinitialise a zero les flux de masse cumules.
+
+      write(77,'(a4,2x,a40)')
+     &       'DSET ','^fluxmass'
+
+      write(77,'(a12)') 'UNDEF 1.0E30'
+      write(77,'(a5,1x,a40)') 'TITLE ','Titre a voir'
+      call formcoord(77,iip1,rlonv,180./pi,.false.,'XDEF')
+      call formcoord(77,jjp1,rlatu,180./pi,.true.,'YDEF')
+      call formcoord(77,llm,presnivs,1.,.false.,'ZDEF')
+      write(77,'(a4,i10,a30)')
+     &       'TDEF ',irec,' LINEAR 02JAN1987 1DY '
+      write(77,'(a4,2x,i5)') 'VARS',6
+      write(77,1000) 'masse',llm,99,'masse    '
+      write(77,1000) 'pbaru',llm,99,'pbaru    '
+      write(77,1000) 'pbarv',llm,99,'pbarv    '
+      write(77,1000) 'w    ',llm,99,'w        '
+      write(77,1000) 'teta ',llm,99,'teta     '
+      write(77,1000) 'phi  ',llm,99,'phi      '
+      write(77,'(a7)') 'ENDVARS'
+
+1000  format(a5,3x,i4,i3,1x,a39)
+
+
+
+      ENDIF ! if iadvtr.EQ.istdyn
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxhyp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxhyp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxhyp.F	(revision 2744)
@@ -0,0 +1,448 @@
+       SUBROUTINE fxhyp ( xzoomdeg,grossism,dzoom,tau ,
+     , rlonm025,xprimm025,rlonv,xprimv,rlonu,xprimu,rlonp025,xprimp025,
+     , champmin,champmax                                               )
+
+c      Auteur :  P. Le Van 
+
+       IMPLICIT NONE
+
+c    Calcule les longitudes et derivees dans la grille du GCM pour une
+c     fonction f(x) a tangente  hyperbolique  .
+c
+c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois,etc.)
+c     dzoom  etant  la distance totale de la zone du zoom
+c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom
+c
+c    On doit avoir grossism x dzoom <  pi ( radians )   , en longitude.
+c   ********************************************************************
+
+
+       INTEGER nmax, nmax2
+       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
+c
+       LOGICAL scal180
+       PARAMETER ( scal180 = .TRUE. )
+
+c      scal180 = .TRUE.  si on veut avoir le premier point scalaire pour   
+c      une grille reguliere ( grossism = 1.,tau=0.,clon=0. ) a -180. degres.
+c      sinon scal180 = .FALSE.
+
+#include "dimensions.h"
+#include "paramet.h"
+       
+c     ......  arguments  d'entree   .......
+c
+       REAL xzoomdeg,dzoom,tau,grossism
+
+c    ......   arguments  de  sortie  ......
+
+       REAL rlonm025(iip1),xprimm025(iip1),rlonv(iip1),xprimv(iip1),
+     ,  rlonu(iip1),xprimu(iip1),rlonp025(iip1),xprimp025(iip1)
+
+c     .... variables locales  ....
+c
+       REAL*8 xlon(iip1),xprimm(iip1),xuv
+       REAL*8 xtild(0:nmax2)
+       REAL*8 fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)
+       REAL*8 Xf(0:nmax2),xxpr(0:nmax2)
+       REAL*8 xvrai(iip1),xxprim(iip1) 
+       REAL*8 pi,depi,epsilon,xzoom,fa,fb
+       REAL*8 Xf1, Xfi , a0,a1,a2,a3,xi2
+       INTEGER i,it,ik,iter,ii,idif,ii1,ii2
+       REAL*8 xi,xo1,xmoy,xlon2,fxm,Xprimin
+       REAL*8 champmin,champmax,decalx
+       INTEGER is2
+       SAVE is2
+
+       REAL*8 heavyside
+       EXTERNAL coefpoly,heavyside
+
+       pi       = 2. * ASIN(1.)
+       depi     = 2. * pi
+       epsilon  = 1.e-3
+       xzoom    = xzoomdeg * pi/180. 
+c
+           decalx   = .75
+       IF( grossism.EQ.1..AND.scal180 )  THEN
+           decalx   = 1.
+       ENDIF
+
+       WRITE(6,*) 'FXHYP scal180,decalx', scal180,decalx
+c
+       IF( dzoom.LT.1.)  THEN
+         dzoom = dzoom * depi
+       ELSEIF( dzoom.LT. 25. ) THEN
+         WRITE(6,*) ' Le param. dzoomy pour fxhyp est trop petit ! L aug
+     ,menter et relancer ! '
+         STOP 1
+       ELSE
+         dzoom = dzoom * pi/180.
+       ENDIF
+
+       WRITE(6,*) ' xzoom( rad.),grossism,tau,dzoom (radians)'
+       WRITE(6,24) xzoom,grossism,tau,dzoom
+
+       DO i = 0, nmax2 
+        xtild(i) = - pi + FLOAT(i) * depi /nmax2
+       ENDDO
+
+       DO i = nmax, nmax2
+
+       fa  = tau*  ( dzoom/2.  - xtild(i) )
+       fb  = xtild(i) *  ( pi - xtild(i) )
+
+         IF( 200.* fb .LT. - fa )   THEN
+           fhyp ( i) = - 1.
+         ELSEIF( 200. * fb .LT. fa ) THEN
+           fhyp ( i) =   1.
+         ELSE
+            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
+                IF(   200.*fb + fa.LT.1.e-10 )  THEN
+                    fhyp ( i ) = - 1.
+                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
+                    fhyp ( i )  =   1.
+                ENDIF
+            ELSE
+                    fhyp ( i )  =  TANH ( fa/fb )
+            ENDIF
+         ENDIF
+
+        IF ( xtild(i).EQ. 0. )  fhyp(i) =  1.
+        IF ( xtild(i).EQ. pi )  fhyp(i) = -1.
+
+       ENDDO
+
+cc  ....  Calcul  de  beta  ....
+c   ............................
+
+       ffdx = 0.
+
+       DO i = nmax +1,nmax2
+
+       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
+       fa  = tau*  ( dzoom/2.  - xmoy )
+       fb  = xmoy *  ( pi - xmoy )
+
+       IF( 200.* fb .LT. - fa )   THEN
+         fxm = - 1.
+       ELSEIF( 200. * fb .LT. fa ) THEN
+         fxm =   1.
+       ELSE
+            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
+                IF(   200.*fb + fa.LT.1.e-10 )  THEN
+                    fxm   = - 1.
+                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
+                    fxm   =   1.
+                ENDIF
+            ELSE
+                    fxm   =  TANH ( fa/fb )
+            ENDIF
+       ENDIF
+
+       IF ( xmoy.EQ. 0. )  fxm  =  1.
+       IF ( xmoy.EQ. pi )  fxm  = -1.
+
+       ffdx = ffdx + fxm * ( xtild(i) - xtild(i-1) )
+
+       ENDDO
+
+        beta  = ( grossism * ffdx - pi ) / ( ffdx - pi )
+
+       IF( 2.*beta - grossism.LE. 0.)  THEN
+        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
+     ,tine fxhyp est mauvaise ! '
+        WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',
+     , ' et relancer ! ***  '
+        CALL ABORT
+       ENDIF
+c
+c   .....  calcul  de  Xprimt   .....
+c
+       
+       DO i = nmax, nmax2
+        Xprimt(i) = beta  + ( grossism - beta ) * fhyp(i)
+       ENDDO
+c   
+       DO i =  nmax+1, nmax2
+        Xprimt( nmax2 - i ) = Xprimt( i )
+       ENDDO
+c
+
+c   .....  Calcul  de  Xf     ........
+
+       Xf(0) = - pi
+
+       DO i =  nmax +1, nmax2
+
+       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
+       fa  = tau*  ( dzoom/2.  - xmoy )
+       fb  = xmoy *  ( pi - xmoy )
+
+       IF( 200.* fb .LT. - fa )   THEN
+         fxm = - 1.
+       ELSEIF( 200. * fb .LT. fa ) THEN
+         fxm =   1.
+       ELSE
+         fxm =  TANH ( fa/fb )
+       ENDIF
+
+       IF ( xmoy.EQ. 0. )  fxm =  1.
+       IF ( xmoy.EQ. pi )  fxm = -1.
+       xxpr(i)    = beta + ( grossism - beta ) * fxm
+
+       ENDDO
+
+       DO i = nmax+1, nmax2
+        xxpr(nmax2-i+1) = xxpr(i)
+       ENDDO
+
+        DO i=1,nmax2
+         Xf(i)   = Xf(i-1) + xxpr(i) * ( xtild(i) - xtild(i-1) )
+        ENDDO
+
+
+c    *****************************************************************
+c
+
+c     .....  xuv = 0.   si  calcul  aux pts   scalaires   ........
+c     .....  xuv = 0.5  si  calcul  aux pts      U        ........
+c
+      WRITE(6,18)
+c
+      DO 5000  ik = 1, 4
+
+       IF( ik.EQ.1 )        THEN
+         xuv =  -0.25
+       ELSE IF ( ik.EQ.2 )  THEN
+         xuv =   0.
+       ELSE IF ( ik.EQ.3 )  THEN
+         xuv =   0.50
+       ELSE IF ( ik.EQ.4 )  THEN
+         xuv =   0.25
+       ENDIF
+
+      xo1   = 0.
+
+      ii1=1
+      ii2=iim
+      IF(ik.EQ.1.and.grossism.EQ.1.) THEN
+        ii1 = 2 
+        ii2 = iim+1
+      ENDIF
+
+      DO 1500 i = ii1, ii2
+
+      xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim) 
+
+      Xfi    = xlon2
+c
+      DO 250 it =  nmax2,0,-1
+      IF( Xfi.GE.Xf(it))  GO TO 350
+250   CONTINUE
+
+      it = 0
+
+350   CONTINUE
+
+c    ......  Calcul de   Xf(xi)    ...... 
+c
+      xi  = xtild(it)
+
+      IF(it.EQ.nmax2)  THEN
+       it       = nmax2 -1
+       Xf(it+1) = pi
+      ENDIF
+c  .....................................................................
+c
+c   Appel de la routine qui calcule les coefficients a0,a1,a2,a3 d'un
+c   polynome de degre 3  qui passe  par les points (Xf(it),xtild(it) )
+c          et (Xf(it+1),xtild(it+1) )
+
+       CALL coefpoly ( Xf(it),Xf(it+1),Xprimt(it),Xprimt(it+1),
+     ,                xtild(it),xtild(it+1),  a0, a1, a2, a3  )
+
+       Xf1     = Xf(it)
+       Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi
+
+       DO 500 iter = 1,300
+        xi = xi - ( Xf1 - Xfi )/ Xprimin
+
+        IF( ABS(xi-xo1).LE.epsilon)  GO TO 550
+         xo1      = xi
+         xi2      = xi * xi
+         Xf1      = a0 +  a1 * xi +     a2 * xi2  +     a3 * xi2 * xi
+         Xprimin  =       a1      + 2.* a2 *  xi  + 3.* a3 * xi2
+500   CONTINUE
+        WRITE(6,*) ' Pas de solution ***** ',i,xlon2,iter
+          STOP 6
+550   CONTINUE
+
+       xxprim(i) = depi/ ( FLOAT(iim) * Xprimin )
+       xvrai(i)  =  xi + xzoom
+
+1500   CONTINUE
+
+
+       IF(ik.EQ.1.and.grossism.EQ.1.)  THEN
+         xvrai(1)    = xvrai(iip1)-depi
+         xxprim(1)   = xxprim(iip1)
+       ENDIF
+       DO i = 1 , iim
+        xlon(i)     = xvrai(i)
+        xprimm(i)   = xxprim(i)
+       ENDDO
+  
+       DO i = 1, iim -1
+        IF( xvrai(i+1). LT. xvrai(i) )  THEN
+         WRITE(6,*) ' PBS. avec rlonu(',i+1,') plus petit que rlonu(',i,
+     ,  ')'
+        STOP 7
+        ENDIF
+       ENDDO
+c
+c   ... Reorganisation  des  longitudes  pour les avoir  entre - pi et pi ..
+c   ........................................................................
+
+       champmin =  1.e12
+       champmax = -1.e12
+       DO i = 1, iim
+        champmin = MIN( champmin,xvrai(i) )
+        champmax = MAX( champmax,xvrai(i) )
+       ENDDO
+
+      IF(champmin .GE.-pi-0.10.and.champmax.LE.pi+0.10 )  THEN
+                GO TO 1600
+      ELSE
+       WRITE(6,*) 'Reorganisation des longitudes pour avoir entre - pi',
+     ,  ' et pi '
+c
+        IF( xzoom.LE.0.)  THEN
+          IF( ik.EQ. 1 )  THEN
+          DO i = 1, iim
+           IF( xvrai(i).GE. - pi )  GO TO 80
+          ENDDO
+            WRITE(6,*)  ' PBS. 1 !  Xvrai plus petit que  - pi ! '
+            STOP 8
+ 80       CONTINUE
+          is2 = i
+          ENDIF
+
+          IF( is2.NE. 1 )  THEN
+            DO ii = is2 , iim
+             xlon  (ii-is2+1) = xvrai(ii)
+             xprimm(ii-is2+1) = xxprim(ii)
+            ENDDO
+            DO ii = 1 , is2 -1
+             xlon  (ii+iim-is2+1) = xvrai(ii) + depi
+             xprimm(ii+iim-is2+1) = xxprim(ii) 
+            ENDDO
+          ENDIF
+        ELSE 
+          IF( ik.EQ.1 )  THEN
+           DO i = iim,1,-1
+             IF( xvrai(i).LE. pi ) GO TO 90
+           ENDDO
+             WRITE(6,*) ' PBS.  2 ! Xvrai plus grand  que   pi ! '
+              STOP 9
+ 90        CONTINUE
+            is2 = i
+          ENDIF
+           idif = iim -is2
+           DO ii = 1, is2
+            xlon  (ii+idif) = xvrai(ii)
+            xprimm(ii+idif) = xxprim(ii)
+           ENDDO
+           DO ii = 1, idif
+            xlon (ii)  = xvrai (ii+is2) - depi
+            xprimm(ii) = xxprim(ii+is2) 
+           ENDDO
+         ENDIF
+      ENDIF
+c
+c     .........   Fin  de la reorganisation   ............................
+
+ 1600    CONTINUE
+
+
+         xlon  ( iip1)  = xlon(1) + depi
+         xprimm( iip1 ) = xprimm (1 )
+       
+         DO i = 1, iim+1
+         xvrai(i) = xlon(i)*180./pi
+         ENDDO
+
+         IF( ik.EQ.1 )  THEN
+c          WRITE(6,*)  ' XLON aux pts. V-0.25   apres ( en  deg. ) '
+c          WRITE(6,18) 
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM k ',ik
+c          WRITE(6,566)  xprimm
+
+           DO i = 1,iim +1
+             rlonm025(i) = xlon( i )
+            xprimm025(i) = xprimm(i)
+           ENDDO
+           
+         ELSE IF( ik.EQ.2 )  THEN
+c          WRITE(6,18) 
+c          WRITE(6,*)  ' XLON aux pts. V   apres ( en  deg. ) '
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM k ',ik
+c          WRITE(6,566)  xprimm
+
+           DO i = 1,iim + 1
+             rlonv(i) = xlon( i )
+            xprimv(i) = xprimm(i)
+           ENDDO
+
+         ELSE IF( ik.EQ.3)   THEN
+c          WRITE(6,18) 
+c          WRITE(6,*)  ' XLON aux pts. U   apres ( en  deg. ) '
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM ik ',ik
+c          WRITE(6,566)  xprimm
+
+           DO i = 1,iim + 1
+             rlonu(i) = xlon( i )
+            xprimu(i) = xprimm(i)
+           ENDDO
+
+         ELSE IF( ik.EQ.4 )  THEN
+c          WRITE(6,18) 
+c          WRITE(6,*)  ' XLON aux pts. V+0.25   apres ( en  deg. ) '
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM ik ',ik
+c          WRITE(6,566)  xprimm
+
+           DO i = 1,iim + 1
+             rlonp025(i) = xlon( i )
+            xprimp025(i) = xprimm(i)
+           ENDDO
+
+         ENDIF
+
+5000    CONTINUE
+c
+       WRITE(6,18)
+c
+c    ...........  fin  de la boucle  do 5000      ............
+
+        DO i = 1, iim
+         xlon(i) = rlonv(i+1) - rlonv(i)
+        ENDDO
+        champmin =  1.e12
+        champmax = -1.e12
+        DO i = 1, iim
+         champmin = MIN( champmin, xlon(i) )
+         champmax = MAX( champmax, xlon(i) )
+        ENDDO
+         champmin = champmin * 180./pi
+         champmax = champmax * 180./pi
+
+18     FORMAT(/)
+24     FORMAT(2x,'Parametres xzoom,gross,tau ,dzoom pour fxhyp ',4f8.3)
+68     FORMAT(1x,7f9.2)
+566    FORMAT(1x,7f9.4)
+
+       RETURN
+       END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxy.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxy.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxy.F	(revision 2744)
@@ -0,0 +1,66 @@
+      SUBROUTINE fxy (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
+     ,                    rlatu2,yprimu2,
+     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+      IMPLICIT NONE
+
+c     Auteur  :  P. Le Van
+c
+c     Calcul  des longitudes et des latitudes  pour une fonction f(x,y)
+c           a tangente sinusoidale et eventuellement avec zoom  .
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "serre.h"
+#include "comconst.h"
+
+       INTEGER i,j
+
+       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
+     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
+       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
+     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
+
+#include "fxy_new.h"
+
+
+c    ......  calcul  des  latitudes  et de y'   .....
+c
+       DO j = 1, jjm + 1 
+          rlatu(j) = fy    ( FLOAT( j )        )
+         yprimu(j) = fyprim( FLOAT( j )        )
+       ENDDO
+
+
+       DO j = 1, jjm
+
+         rlatv(j)  = fy    ( FLOAT( j ) + 0.5  )
+         rlatu1(j) = fy    ( FLOAT( j ) + 0.25 ) 
+         rlatu2(j) = fy    ( FLOAT( j ) + 0.75 ) 
+
+        yprimv(j)  = fyprim( FLOAT( j ) + 0.5  ) 
+        yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )
+        yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )
+
+       ENDDO
+
+c
+c     .....  calcul   des  longitudes et de  x'   .....
+c
+       DO i = 1, iim + 1
+           rlonv(i)     = fx    (   FLOAT( i )          )
+           rlonu(i)     = fx    (   FLOAT( i ) + 0.5    )
+        rlonm025(i)     = fx    (   FLOAT( i ) - 0.25  )
+        rlonp025(i)     = fx    (   FLOAT( i ) + 0.25  )
+
+         xprimv  (i)    = fxprim (  FLOAT( i )          )
+         xprimu  (i)    = fxprim (  FLOAT( i ) + 0.5    )
+        xprimm025(i)    = fxprim (  FLOAT( i ) - 0.25   )
+        xprimp025(i)    = fxprim (  FLOAT( i ) + 0.25   )
+       ENDDO
+
+c
+       RETURN
+       END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxyhyper.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxyhyper.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxyhyper.F	(revision 2744)
@@ -0,0 +1,137 @@
+c
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/fxyhyper.F,v 1.4 2001/04/24 13:12:44 lmdz Exp $
+c
+       SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy  ,   
+     ,                       xzoom, grossx, dzoomx,taux  ,
+     , rlatu,yprimu,rlatv,yprimv,rlatu1,  yprimu1,  rlatu2,  yprimu2  , 
+     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+       IMPLICIT NONE
+c
+c      Auteur :  P. Le Van .
+c
+c      d'apres  formulations de R. Sadourny .
+c
+c
+c     Ce spg calcule les latitudes( routine fyhyp ) et longitudes( fxhyp )
+c            par des  fonctions  a tangente hyperbolique .
+c
+c     Il y a 3 parametres ,en plus des coordonnees du centre du zoom (xzoom
+c                      et  yzoom )   :  
+c
+c     a) le grossissement du zoom  :  grossy  ( en y ) et grossx ( en x )
+c     b) l' extension     du zoom  :  dzoomy  ( en y ) et dzoomx ( en x )
+c     c) la raideur de la transition du zoom  :   taux et tauy   
+c
+c  N.B : Il vaut mieux avoir   :   grossx * dzoomx <  pi    ( radians )
+c ******
+c                  et              grossy * dzoomy <  pi/2  ( radians )
+c
+#include "dimensions.h"
+#include "paramet.h"
+
+
+c   .....  Arguments  ...
+c
+       REAL xzoom,yzoom,grossx,grossy,dzoomx,dzoomy,taux,tauy
+       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
+     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
+       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
+     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
+       REAL*8  dxmin, dxmax , dymin, dymax
+
+c   ....   var. locales   .....
+c
+       INTEGER i,j
+c
+
+       CALL fyhyp ( yzoom, grossy, dzoomy,tauy  , 
+     ,  rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
+     ,  dymin,dymax                                               )
+
+       CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv,
+     , xprimv,rlonu,xprimu,rlonp025,xprimp025 , dxmin,dxmax         )
+
+
+        DO i = 1, iip1
+          IF(rlonp025(i).LT.rlonv(i))  THEN
+           WRITE(6,*) ' Attention !  rlonp025 < rlonv',i
+            STOP
+          ENDIF
+
+          IF(rlonv(i).LT.rlonm025(i))  THEN 
+           WRITE(6,*) ' Attention !  rlonm025 > rlonv',i
+            STOP
+          ENDIF
+
+          IF(rlonp025(i).GT.rlonu(i))  THEN
+           WRITE(6,*) ' Attention !  rlonp025 > rlonu',i
+            STOP
+          ENDIF
+        ENDDO
+
+        WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FX **** '
+
+c
+       DO j = 1, jjm
+c
+       IF(rlatu1(j).LE.rlatu2(j))   THEN
+         WRITE(6,*)'Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j
+         STOP 13
+       ENDIF
+c
+       IF(rlatu2(j).LE.rlatu(j+1))  THEN
+        WRITE(6,*)'Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j
+        STOP 14
+       ENDIF
+c
+       IF(rlatu(j).LE.rlatu1(j))    THEN
+        WRITE(6,*)' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j
+        STOP 15
+       ENDIF
+c
+       IF(rlatv(j).LE.rlatu2(j))    THEN
+        WRITE(6,*)' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j
+        STOP 16
+       ENDIF
+c
+       IF(rlatv(j).ge.rlatu1(j))    THEN
+        WRITE(6,*)' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j
+        STOP 17
+       ENDIF
+c
+       IF(rlatv(j).ge.rlatu(j))     THEN
+        WRITE(6,*) ' Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j
+        STOP 18
+       ENDIF
+c
+       ENDDO
+c
+       WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FY **** '
+c
+        WRITE(6,18)
+        WRITE(6,*) '  Latitudes  '
+        WRITE(6,*) ' *********** '
+        WRITE(6,18)
+        WRITE(6,3)  dymin, dymax
+        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
+     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
+c
+        WRITE(6,18)
+        WRITE(6,*) '  Longitudes  '
+        WRITE(6,*) ' ************ '
+        WRITE(6,18)
+        WRITE(6,3)  dxmin, dxmax
+        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
+     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
+        WRITE(6,18)
+c
+3      Format(1x, ' Au centre du zoom , la longueur de la maille est',
+     ,  ' d environ ',f8.2 ,' degres  ',
+     , ' alors que la maille en dehors de la zone du zoom est d environ
+     , ', f8.2,' degres ' )
+18      FORMAT(/)
+
+       RETURN
+       END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxysinus.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxysinus.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fxysinus.F	(revision 2744)
@@ -0,0 +1,66 @@
+      SUBROUTINE fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
+     ,                    rlatu2,yprimu2,
+     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+
+      IMPLICIT NONE
+c
+c     Calcul  des longitudes et des latitudes  pour une fonction f(x,y)
+c            avec y = Asin( j )  .
+c
+c     Auteur  :  P. Le Van
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+
+       INTEGER i,j
+
+       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
+     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
+       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
+     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
+
+#include "fxy_sin.h"
+
+
+c    ......  calcul  des  latitudes  et de y'   .....
+c
+       DO j = 1, jjm + 1 
+          rlatu(j) = fy    ( FLOAT( j )        )
+         yprimu(j) = fyprim( FLOAT( j )        )
+       ENDDO
+
+
+       DO j = 1, jjm
+
+         rlatv(j)  = fy    ( FLOAT( j ) + 0.5  )
+         rlatu1(j) = fy    ( FLOAT( j ) + 0.25 ) 
+         rlatu2(j) = fy    ( FLOAT( j ) + 0.75 ) 
+
+        yprimv(j)  = fyprim( FLOAT( j ) + 0.5  ) 
+        yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )
+        yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )
+
+       ENDDO
+
+c
+c     .....  calcul   des  longitudes et de  x'   .....
+c
+       DO i = 1, iim + 1
+           rlonv(i)     = fx    (   FLOAT( i )          )
+           rlonu(i)     = fx    (   FLOAT( i ) + 0.5    )
+        rlonm025(i)     = fx    (   FLOAT( i ) - 0.25  )
+        rlonp025(i)     = fx    (   FLOAT( i ) + 0.25  )
+
+         xprimv  (i)    = fxprim (  FLOAT( i )          )
+         xprimu  (i)    = fxprim (  FLOAT( i ) + 0.5    )
+        xprimm025(i)    = fxprim (  FLOAT( i ) - 0.25   )
+        xprimp025(i)    = fxprim (  FLOAT( i ) + 0.25   )
+       ENDDO
+
+c
+       RETURN
+       END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fyhyp.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fyhyp.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/fyhyp.F	(revision 2744)
@@ -0,0 +1,376 @@
+C
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/fyhyp.F,v 1.5 2001/07/04 10:46:06 lmdz Exp $
+c
+       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzoom,tau  ,  
+     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
+     ,  champmin,champmax                                            ) 
+
+cc    ...  Version du 01/04/2001 ....
+
+       IMPLICIT NONE
+c
+c    ...   Auteur :  P. Le Van  ... 
+c
+c    .......    d'apres  formulations  de R. Sadourny  .......
+c
+c     Calcule les latitudes et derivees dans la grille du GCM pour une
+c     fonction f(y) a tangente  hyperbolique  .
+c
+c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)
+c     dzoom  etant  la distance totale de la zone du zoom ( en radians )
+c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom   
+c
+c
+c N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en lati.
+c      ********************************************************************
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+
+       INTEGER      nmax , nmax2
+       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
+c
+c
+c     .......  arguments  d'entree    .......
+c
+       REAL yzoomdeg, grossism,dzoom,tau 
+c         ( rentres  par  run.def )
+
+c     .......  arguments  de sortie   .......
+c
+       REAL rrlatu(jjp1), yyprimu(jjp1),rrlatv(jjm), yyprimv(jjm),
+     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
+
+c
+c     .....     champs  locaux    .....
+c
+     
+       REAL*8 ylat(jjp1), yprim(jjp1)
+       REAL*8 yuv
+       REAL*8 yt(0:nmax2)
+       REAL*8 fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
+       SAVE Ytprim, yt,Yf
+       REAL*8 Yf(0:nmax2),yypr(0:nmax2)
+       REAL*8 yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
+       REAL*8 pi,depi,pis2,epsilon,y0,pisjm
+       REAL*8 yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
+       REAL*8 yfi,Yf1,ffdy
+       REAL*8 ypn,deply,y00
+       SAVE y00, deply
+
+       INTEGER i,j,it,ik,iter,jlat
+       INTEGER jpn,jjpn
+       SAVE jpn
+       REAL*8 a0,a1,a2,a3,yi2,heavyy0,heavyy0m
+       REAL*8 fa(0:nmax2),fb(0:nmax2)
+       REAL y0min,y0max
+
+       REAL*8     heavyside
+       EXTERNAL   heavyside
+
+       pi       = 2. * ASIN(1.)
+       depi     = 2. * pi
+       pis2     = pi/2.
+       pisjm    = pi/ FLOAT(jjm)
+       epsilon  = 1.e-3
+       y0       =  yzoomdeg * pi/180. 
+
+       IF( dzoom.LT.1.)  THEN
+         dzoom = dzoom * pi
+       ELSEIF( dzoom.LT. 12. ) THEN
+         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
+     ,menter et relancer ! '
+         STOP 1
+       ELSE
+         dzoom = dzoom * pi/180.
+       ENDIF
+
+       WRITE(6,18)
+       WRITE(6,*) ' yzoom( rad.),grossism,tau,dzoom (radians)'
+       WRITE(6,24) y0,grossism,tau,dzoom
+
+       DO i = 0, nmax2 
+        yt(i) = - pis2  + FLOAT(i)* pi /nmax2
+       ENDDO
+
+       heavyy0m = heavyside( -y0 )
+       heavyy0  = heavyside(  y0 )
+       y0min    = 2.*y0*heavyy0m - pis2
+       y0max    = 2.*y0*heavyy0  + pis2
+
+       fa = 999.999
+       fb = 999.999
+
+       DO i = 0, nmax2 
+        IF( yt(i).LT.y0 )  THEN
+         fa (i) = tau*  (yt(i)-y0+dzoom/2. )
+         fb(i) =   (yt(i)-2.*y0*heavyy0m +pis2) * ( y0 - yt(i) )
+        ELSEIF ( yt(i).GT.y0 )  THEN
+         fa(i) =   tau *(y0-yt(i)+dzoom/2. )
+         fb(i) = (2.*y0*heavyy0 -yt(i)+pis2) * ( yt(i) - y0 ) 
+       ENDIF
+        
+       IF( 200.* fb(i) .LT. - fa(i) )   THEN
+         fhyp ( i) = - 1.
+       ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
+         fhyp ( i) =   1.
+       ELSE  
+         fhyp(i) =  TANH ( fa(i)/fb(i) )
+       ENDIF
+
+       IF( yt(i).EQ.y0 )  fhyp(i) = 1.
+       IF(yt(i).EQ. y0min. OR.yt(i).EQ. y0max ) fhyp(i) = -1.
+
+       ENDDO
+
+cc  ....  Calcul  de  beta  ....
+c
+       ffdy   = 0.
+
+       DO i = 1, nmax2
+        ymoy    = 0.5 * ( yt(i-1) + yt( i ) )
+        IF( ymoy.LT.y0 )  THEN
+         fa(i)= tau * ( ymoy-y0+dzoom/2.) 
+         fb(i) = (ymoy-2.*y0*heavyy0m +pis2) * ( y0 - ymoy )
+        ELSEIF ( ymoy.GT.y0 )  THEN
+         fa(i)= tau * ( y0-ymoy+dzoom/2. ) 
+         fb(i) = (2.*y0*heavyy0 -ymoy+pis2) * ( ymoy - y0 )
+        ENDIF
+
+        IF( 200.* fb(i) .LT. - fa(i) )    THEN
+         fxm ( i) = - 1.
+        ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
+         fxm ( i) =   1.
+        ELSE
+         fxm(i) =  TANH ( fa(i)/fb(i) )
+        ENDIF
+         IF( ymoy.EQ.y0 )  fxm(i) = 1.
+         IF (ymoy.EQ. y0min. OR.yt(i).EQ. y0max ) fxm(i) = -1.
+         ffdy = ffdy + fxm(i) * ( yt(i) - yt(i-1) )
+
+        ENDDO
+
+        beta  = ( grossism * ffdy - pi ) / ( ffdy - pi )
+
+       IF( 2.*beta - grossism.LE. 0.)  THEN
+
+        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
+     ,tine fyhyp est mauvaise ! '
+        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
+     , ' et relancer ! ***  '
+        CALL ABORT
+
+       ENDIF
+c
+c   .....  calcul  de  Ytprim   .....
+c
+       
+       DO i = 0, nmax2
+        Ytprim(i) = beta  + ( grossism - beta ) * fhyp(i)
+       ENDDO
+
+c   .....  Calcul  de  Yf     ........
+
+       Yf(0) = - pis2
+       DO i = 1, nmax2
+        yypr(i)    = beta + ( grossism - beta ) * fxm(i)
+       ENDDO
+
+       DO i=1,nmax2
+        Yf(i)   = Yf(i-1) + yypr(i) * ( yt(i) - yt(i-1) )
+       ENDDO
+
+c    ****************************************************************
+c
+c   .....   yuv  = 0.   si calcul des latitudes  aux pts.  U  .....
+c   .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....
+c
+      WRITE(6,18)
+c
+      DO 5000  ik = 1,4
+
+       IF( ik.EQ.1 )  THEN
+         yuv  = 0.
+         jlat = jjm + 1
+       ELSE IF ( ik.EQ.2 )  THEN
+         yuv  = 0.5
+         jlat = jjm 
+       ELSE IF ( ik.EQ.3 )  THEN
+         yuv  = 0.25
+         jlat = jjm 
+       ELSE IF ( ik.EQ.4 )  THEN
+         yuv  = 0.75
+         jlat = jjm 
+       ENDIF
+c
+       yo1   = 0.
+       DO 1500 j =  1,jlat
+        yo1   = 0.
+        ylon2 =  - pis2 + pisjm * ( FLOAT(j)  + yuv  -1.)  
+        yfi    = ylon2
+c
+       DO 250 it =  nmax2,0,-1
+        IF( yfi.GE.Yf(it))  GO TO 350
+250    CONTINUE
+       it = 0
+350    CONTINUE
+
+       yi = yt(it)
+       IF(it.EQ.nmax2)  THEN
+        it       = nmax2 -1
+        Yf(it+1) = pis2
+       ENDIF
+c  .................................................................
+c  ....  Interpolation entre  yi(it) et yi(it+1)   pour avoir Y(yi)  
+c      .....           et   Y'(yi)                             .....
+c  .................................................................
+
+       CALL coefpoly ( Yf(it),Yf(it+1),Ytprim(it), Ytprim(it+1),   
+     ,                  yt(it),yt(it+1) ,   a0,a1,a2,a3   )      
+
+       Yf1     = Yf(it)
+       Yprimin = a1 + 2.* a2 * yi + 3.*a3 * yi *yi
+
+       DO 500 iter = 1,300
+         yi = yi - ( Yf1 - yfi )/ Yprimin
+
+        IF( ABS(yi-yo1).LE.epsilon)  GO TO 550
+         yo1      = yi
+         yi2      = yi * yi
+         Yf1      = a0 +  a1 * yi +     a2 * yi2  +     a3 * yi2 * yi
+         Yprimin  =       a1      + 2.* a2 *  yi  + 3.* a3 * yi2
+500   CONTINUE
+        WRITE(6,*) ' Pas de solution ***** ',j,ylon2,iter
+         STOP 2
+550   CONTINUE
+c
+       Yprimin   = a1  + 2.* a2 *  yi   + 3.* a3 * yi* yi
+       yprim(j)  = pi / ( jjm * Yprimin )
+       yvrai(j)  = yi 
+
+1500    CONTINUE
+
+       DO j = 1, jlat -1
+        IF( yvrai(j+1). LT. yvrai(j) )  THEN
+         WRITE(6,*) ' PBS. avec  rlat(',j+1,') plus petit que rlat(',j,
+     ,  ')'
+         STOP 3
+        ENDIF
+       ENDDO
+
+       WRITE(6,*) 'Reorganisation des latitudes pour avoir entre - pi/2'
+     , ,' et  pi/2 '
+c
+        IF( ik.EQ.1 )   THEN
+           ypn = pis2 
+          DO j = jlat,1,-1
+           IF( yvrai(j).LE. ypn ) GO TO 1502
+          ENDDO
+1502     CONTINUE
+
+         jpn   = j
+         y00   = yvrai(jpn)
+         deply = pis2 -  y00
+        ENDIF
+
+         DO  j = 1, jjm +1 - jpn
+           ylatt (j)  = -pis2 - y00  + yvrai(jpn+j-1)
+           yprimm(j)  = yprim(jpn+j-1)
+         ENDDO
+
+         jjpn  = jpn
+         IF( jlat.EQ. jjm ) jjpn = jpn -1
+
+         DO j = 1,jjpn 
+          ylatt (j + jjm+1 -jpn) = yvrai(j) + deply
+          yprimm(j + jjm+1 -jpn) = yprim(j)
+         ENDDO
+
+c      ***********   Fin de la reorganisation     *************
+c
+ 1600   CONTINUE
+
+       DO j = 1, jlat
+          ylat(j) =  ylatt( jlat +1 -j )
+         yprim(j) = yprimm( jlat +1 -j )
+       ENDDO
+  
+        DO j = 1, jlat
+         yvrai(j) = ylat(j)*180./pi
+        ENDDO
+
+        IF( ik.EQ.1 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rrlatu(j) =  ylat( j )
+           yyprimu(j) = yprim( j )
+          ENDDO
+
+        ELSE IF ( ik.EQ. 2 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*)' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rrlatv(j) =  ylat( j )
+           yyprimv(j) = yprim( j )
+          ENDDO
+
+        ELSE IF ( ik.EQ. 3 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rlatu2(j) =  ylat( j )
+           yprimu2(j) = yprim( j )
+          ENDDO
+
+        ELSE IF ( ik.EQ. 4 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '
+c         WRITE(6,68)(yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,68) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rlatu1(j) =  ylat( j )
+           yprimu1(j) = yprim( j )
+          ENDDO
+
+        ENDIF
+
+5000   CONTINUE
+c
+        WRITE(6,18)
+c
+c  .....     fin de la boucle  do 5000 .....
+
+        DO j = 1, jjm
+         ylat(j) = rrlatu(j) - rrlatu(j+1)
+        ENDDO
+        champmin =  1.e12
+        champmax = -1.e12
+        DO j = 1, jjm
+         champmin = MIN( champmin, ylat(j) )
+         champmax = MAX( champmax, ylat(j) )
+        ENDDO
+         champmin = champmin * 180./pi
+         champmax = champmax * 180./pi
+
+24     FORMAT(2x,'Parametres yzoom,gross,tau ,dzoom pour fyhyp ',4f8.3)
+18      FORMAT(/)
+68      FORMAT(1x,7f9.2)
+
+        RETURN
+        END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gcm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gcm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gcm.F	(revision 2744)
@@ -0,0 +1,672 @@
+      PROGRAM gcm
+
+      IMPLICIT NONE
+
+c      ......   Version  du 10/01/98    ..........
+
+c             avec  coordonnees  verticales hybrides 
+c   avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   GCM LMD nouvelle grille
+c
+c=======================================================================
+c
+c  ... Dans inigeom , nouveaux calculs pour les elongations  cu , cv
+c      et possibilite d'appeler une fonction f(y)  a derivee tangente
+c      hyperbolique a la  place de la fonction a derivee sinusoidale.
+
+c  ... Possibilite de choisir le shema de Van-leer pour l'advection de
+c        q  , en faisant iadv = 3  dans   traceur  (29/04/97) .
+c
+c      Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
+c
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissnew.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+#include "tracstoke.h"
+#include "sponge.h"
+
+
+      INTEGER*4  iday ! jour julien
+      REAL       time ! Heure de la journee en fraction d''1 jour
+      REAL zdtvr
+
+c   variables dynamiques
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      real, dimension(ip1jmp1,llm) :: teta   ! temperature potentielle 
+      REAL q(ip1jmp1,llm,nqmx)               ! champs advectes
+      REAL ps(ip1jmp1)                       ! pression  au sol
+      REAL pext(ip1jmp1)                     ! pression  extensive
+      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
+      REAL pks(ip1jmp1)                      ! exner au  sol
+      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
+      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
+      REAL masse(ip1jmp1,llm)                ! masse d''air
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+      REAL phi(ip1jmp1,llm)                  ! geopotentiel
+      REAL w(ip1jmp1,llm)                    ! vitesse verticale
+
+c variables dynamiques intermediaire pour le transport
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm) !flux de masse
+
+c   variables dynamiques au pas -1
+      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
+
+      REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1)
+      REAL massem1(ip1jmp1,llm)
+
+c   tendances dynamiques
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+      REAL dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)
+
+c   tendances de la dissipation
+      REAL dvdis(ip1jm,llm),dudis(ip1jmp1,llm)
+      REAL dhdis(ip1jmp1,llm)
+
+c   tendances physiques
+      REAL dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
+      REAL dhfi(ip1jmp1,llm),dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)
+
+c   variables pour le fichier histoire
+      REAL dtav      ! intervalle de temps elementaire
+
+      REAL tppn(iim),tpps(iim),tpn,tps
+c
+      INTEGER iadv(nqmx) ! indice schema de transport pour le traceur iq
+
+      INTEGER itau,itaufinp1,iav
+
+
+      EXTERNAL caldyn, traceur
+      EXTERNAL dissip,geopot,iniconst,inifilr
+      EXTERNAL integrd,SCOPY
+      EXTERNAL inigeom
+      EXTERNAL exner_hyb,addit
+      EXTERNAL defrun_new, test_period
+      REAL  SSUM
+      REAL time_0 , finvmaold(ip1jmp1,llm)
+
+      LOGICAL lafin
+      INTEGER ij,iq,l,ierr,numvanle,iapp_tracvl
+
+      REAL rdayvrai,rdaym_ini,rday_ecri
+      LOGICAL first
+      REAL beta(ip1jmp1,llm)
+
+      LOGICAL offline  ! Controle du stockage ds "fluxmass"
+      PARAMETER (offline=.false.)
+
+      character*20 modname
+      character*80 abort_message
+
+      LOGICAL tracer
+	  data tracer/.true./
+
+C Calendrier
+      LOGICAL true_calendar
+      PARAMETER (true_calendar = .false.)
+
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      modname = 'gcm'
+      descript = 'Run GCM LMDZ'
+      lafin    = .FALSE.
+
+c-----------------------------------------------------------------------
+c
+
+c  ....  Choix  des shemas d'advection pour l'eau et les traceurs  ...
+c  ...................................................................
+c
+c     iadv = 1    shema  transport type "humidite specifique LMD"  
+c     iadv = 2    shema   amont
+c     iadv = 3    shema  Van-leer
+c     iadv = 4    schema  Van-leer + humidite specifique
+c                        Modif F.Codron
+c 
+c     dans le tableau q(ij,l,iq) , iq = 1  pour l'eau vapeur
+c                                , iq = 2  pour l'eau liquide
+c         et eventuellement      , iq = 3, nqmx pour les autres traceurs
+c
+c     iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.
+c
+c  !!!!!Mars: vapeur d'eau = traceur nqmx !!!!!
+c
+      DO iq = 1, nqmx
+       iadv( iq ) = 3    ! Van-Leer + humidite pas au point? (Yann)
+      ENDDO
+c
+      DO  iq = 1, nqmx-1
+       IF( iadv(iq).EQ.1 ) PRINT *,' Choix du shema humidite specifique'
+     * ,' pour le traceur no ', iq
+       IF( iadv(iq).EQ.2 ) PRINT *,' Choix du shema  amont',' pour le'
+
+     * ,' traceur no ', iq
+       IF( iadv(iq).EQ.3 ) PRINT *,' Choix du shema  Van-Leer ',' pour'
+     * ,'le traceur no ', iq
+
+       IF( iadv(iq).EQ.4 )  THEN
+         PRINT *,' Le shema  Van-Leer + humidite specifique ',
+     * ' est  uniquement pour la vapeur d eau .'
+         PRINT *,' Corriger iadv( ',iq, ')  et repasser ! '
+         CALL ABORT
+       ENDIF
+
+       IF( iadv(iq).LE.0.OR.iadv(iq).GT.4 )   THEN
+        PRINT *,' Erreur dans le choix de iadv (nqmx).Corriger et '
+     * ,' repasser car  iadv(iq) = ', iadv(iq)
+         CALL ABORT
+       ENDIF
+      ENDDO
+
+       IF( iadv(nqmx).EQ.1 ) PRINT *,' Choix du shema humidite '
+     * ,'specifique pour la vapeur d''eau'
+       IF( iadv(nqmx).EQ.2 ) PRINT *,' Choix du shema  amont',' pour la'
+     * ,' vapeur d''eau '
+       IF( iadv(nqmx).EQ.3 ) PRINT *,' Choix du shema  Van-Leer '
+     * ,' pour la vapeur d''eau'
+       IF( iadv(nqmx).EQ.4 ) PRINT *,' Choix du shema  Van-Leer + '
+     * ,' humidite specifique pour la vapeur d''eau'
+c
+       IF( iadv(nqmx).LE.0.OR.iadv(nqmx).GT.4 )   THEN
+        PRINT *,' Erreur dans le choix de iadv (nqmx).Corriger et '
+     * ,' repasser car  iadv(nqmx) = ', iadv(nqmx)
+         CALL ABORT
+       ENDIF
+
+      first = .TRUE.
+      numvanle = nqmx + 1
+      DO  iq = 1, nqmx
+        IF((iadv(iq).EQ.3.OR.iadv(iq).EQ.4).AND.first ) THEN
+          numvanle = iq
+          first    = .FALSE. 
+        ENDIF
+      ENDDO
+c
+      DO  iq = 1, nqmx
+
+      IF( (iadv(iq).NE.3.AND.iadv(iq).NE.4).AND.iq.GT.numvanle )  THEN
+          PRINT *,' Il y a discontinuite dans le choix du shema de ',
+     *    'Van-leer pour les traceurs . Corriger et repasser . '
+           CALL ABORT
+      ENDIF
+
+      ENDDO
+c
+
+      CALL dynetat0("start.nc",nqmx,vcov,ucov,
+     .              teta,q,masse,ps,phis, time_0)
+
+      CALL defrun_new( 99, .TRUE. )
+
+
+c  on recalcule eventuellement le pas de temps
+
+      IF(MOD(day_step,iperiod).NE.0)
+     * STOP'Il faut choisir un nb de pas par jour multiple de iperiod'
+
+      IF(MOD(day_step,iphysiq).NE.0)
+     * STOP'Il faut choisir un nb de pas par jour multiple de iphysiq'
+
+      zdtvr    = daysec/FLOAT(day_step)
+        IF(dtvr.NE.zdtvr) THEN
+         PRINT*,'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
+        ENDIF
+
+c  nombre d'etats dans les fichiers demarrage et histoire
+
+      dtvr = zdtvr
+      CALL iniconst
+      CALL inigeom
+
+      CALL inifilr
+
+c
+c   ......    P.Le Van    ( modif  le 29/04/97 )   .........  
+c
+
+      CALL inidissip ( lstardis, nitergdiv, nitergrot, niterh   ,
+     *                tetagdiv, tetagrot , tetatemp              )
+c
+
+      CALL pression ( ip1jmp1, ap, bp, ps, p       )
+
+      call dump2d(iip1,jjp1,ps,'PRESSION SURFACE')
+      CALL exner_hyb( ip1jmp1, ps, p,beta, pks, pk, pkf )
+
+c
+c  numero de stockage pour les fichiers de redemarrage:
+
+c-----------------------------------------------------------------------
+c   temps de depart et de fin:
+c   --------------------------
+
+      itau = 0
+      iday = day_ini+itau/day_step
+      time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
+         IF(time.GT.1.) THEN
+          time = time-1.
+          iday = iday+1
+         ENDIF
+      itaufin   = nday*day_step
+c ********************************
+c      itaufin = 120   ! temporaire !!
+c ********************************
+      itaufinp1 = itaufin +1
+
+      day_end = day_ini + nday
+      PRINT 300, itau,itaufin,day_ini,day_end
+
+      CALL dynredem0("restart.nc",day_end,anne_ini,phis,nqmx)
+
+      ecripar = .TRUE.
+
+      dtav = iperiod*dtvr/daysec
+
+
+c   Quelques initialisations pour les traceurs
+      call initial0(ijp1llm*nqmx,dq)
+c     istdyn=day_step/4     ! stockage toutes les 6h=1jour/4
+c     istphy=istdyn/iphysiq
+
+c-----------------------------------------------------------------------
+c   Debut de l'integration temporelle:
+c   ----------------------------------
+
+   1  CONTINUE
+c
+      IF( MOD( itau, 10* day_step ).EQ.0 )  THEN
+        CALL test_period ( ucov,vcov,teta,q,p,phis )
+        PRINT *,' ----   Test_period apres continue   OK ! -----', itau
+      ENDIF 
+
+      call groupeun(jjp1,llm,ucov,.true.)
+      call groupeun(jjm,llm,vcov,.true.)
+      call groupeun(jjp1,llm,teta,.true.)
+      call groupeun(jjp1,llm,masse,.true.)
+      call groupeun(jjp1,1,ps,.false.)
+
+      CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 )
+      CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 )
+      CALL SCOPY( ijp1llm,teta , 1, tetam1 , 1 )
+      CALL SCOPY( ijp1llm,masse, 1, massem1, 1 )
+      CALL SCOPY( ip1jmp1, ps  , 1,   psm1 , 1 )
+
+      forward = .TRUE.
+      leapf   = .FALSE.
+      dt      =  dtvr
+
+c   ...    P.Le Van .26/04/94  ....
+
+      CALL SCOPY   ( ijp1llm,   masse, 1, finvmaold,     1 )
+      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
+
+
+   2  CONTINUE
+
+c-----------------------------------------------------------------------
+
+c   date:
+c   -----
+
+
+
+c   gestion des appels de la physique et des dissipations:
+c   ------------------------------------------------------
+c
+c   ...    P.Le Van  ( 6/02/95 )  ....
+
+      apphys = .FALSE.
+      statcl = .FALSE.
+      conser = .FALSE.
+      apdiss = .FALSE.
+
+      IF( purmats ) THEN
+         IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
+         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
+         IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward 
+     $                              .AND.   physic    ) apphys = .TRUE.
+      ELSE
+         IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
+         IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
+         IF( MOD(itau+1,iphysiq).EQ.0. AND. physic    ) apphys = .TRUE.
+      END IF
+
+c-----------------------------------------------------------------------
+c   calcul des tendances dynamiques:
+c   --------------------------------
+
+      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
+c
+c
+      CALL caldyn 
+     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
+     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
+
+
+c-----------------------------------------------------------------------
+c   calcul des tendances advection des traceurs (dont l'humidite)
+c   -------------------------------------------------------------
+
+      if (tracer) then
+       IF( forward. OR . leapf )  THEN
+
+        DO iq = 1, nqmx
+c
+         IF ( iadv(iq).EQ.1.OR.iadv(iq).EQ.2 )  THEN
+            CALL traceur( iq,iadv,q,teta,pk,w, pbaru, pbarv, dq )
+
+         ELSE IF( iq.EQ. nqmx )   THEN
+c
+            iapp_tracvl = 5
+c
+cccc     iapp_tracvl est la frequence en pas du groupement des flux
+cccc      de masse pour  Van-Leer dans la routine  tracvl  .
+c
+
+            CALL vanleer(numvanle,iapp_tracvl,nqmx,q,pbaru,pbarv,
+     *                      p, masse, dq,  iadv(1), teta, pk     )
+
+c
+c                   ...  Modif  F.Codron  ....
+c
+         ENDIF
+c
+        ENDDO
+C
+c        IF (offline) THEN
+C maf stokage du flux de masse pour traceurs OFF-LINE
+
+c           CALL fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
+c    .   time_step, itau)
+
+c        ENDIF
+c
+      ENDIF
+	  END IF   ! tracer
+
+
+c-----------------------------------------------------------------------
+c   integrations dynamique et traceurs:
+c   ----------------------------------
+
+       CALL integrd ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 , 
+     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
+     $              finvmaold )
+
+c .P.Le Van (26/04/94  ajout de  finvpold dans l'appel d'integrd)
+c
+c-----------------------------------------------------------------------
+c   calcul des tendances physiques:
+c   -------------------------------
+c    ########   P.Le Van ( Modif le  6/02/95 )   ###########
+c
+       IF( purmats )  THEN
+          IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .TRUE.
+       ELSE
+          IF( itau+1. EQ. itaufin )              lafin = .TRUE.
+       ENDIF
+c
+c
+       IF( apphys )  THEN
+c
+c     .......   Ajout   P.Le Van ( 17/04/96 )   ...........
+c
+
+         CALL pression (  ip1jmp1, ap, bp, ps,  p      )
+         CALL exner_hyb(  ip1jmp1, ps, p,beta,pks, pk, pkf )
+
+           rdaym_ini  = itau * dtvr / daysec
+           rdayvrai   = rdaym_ini  + day_ini
+
+           IF ( ecritphy.LT.1. )  THEN
+             rday_ecri = rdaym_ini
+           ELSE
+             rday_ecri = INT( rdayvrai )
+           ENDIF
+c
+        CALL calfis( nqmx, lafin ,rdayvrai,rday_ecri,time  ,
+     $                 ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
+     $     du,dv,dteta,dq,w, dufi,dvfi,dhfi,dqfi,dpfi,tracer)
+
+
+c      ajout des tendances physiques:
+c      ------------------------------
+          CALL addfi( nqmx, dtphys, leapf, forward   ,
+     $                  ucov, vcov, teta , q   ,ps ,
+     $                 dufi, dvfi, dhfi , dqfi ,dpfi  )
+c
+       ENDIF
+
+       CALL pression ( ip1jmp1, ap, bp, ps, p                  )
+
+       CALL exner_hyb( ip1jmp1, ps, p,beta, pks, pk, pkf )
+c   ----------------------------------------------------------
+
+c
+c
+c   dissipation horizontale et verticale  des petites echelles:
+c   ----------------------------------------------------------
+
+
+      IF(apdiss) THEN
+
+c        Sponge layer
+c        ~~~~~~~~~~~~
+         DO ij=1, ip1jmp1
+            pext(ij)=ps(ij)*aire(ij)
+         ENDDO
+         IF (callsponge) THEN
+            CALL sponge(ucov,vcov,teta,pext,dtdiss,mode_sponge)
+         ENDIF
+
+c        Dissipation horizontale
+c        ~~~~~~~~~~~~~~~~~~~~~~~
+         CALL dissip(vcov,ucov,teta,p,dvdis,dudis,dhdis)
+
+         CALL addit( ijp1llm,ucov ,dudis,ucov )
+         CALL addit( ijmllm ,vcov ,dvdis,vcov )
+         CALL addit( ijp1llm,teta ,dhdis,teta )
+
+
+c    .......        P. Le Van (  ajout  le 17/04/96  )   ...........
+c   ...      Calcul de la valeur moyenne, unique de h aux poles  .....
+c
+
+        DO l  =  1, llm
+          DO ij =  1,iim
+           tppn(ij)  = aire(  ij    ) * teta(  ij    ,l)
+           tpps(ij)  = aire(ij+ip1jm) * teta(ij+ip1jm,l)
+          ENDDO
+
+           tpn  = SSUM(iim,tppn,1)/apoln
+           tps  = SSUM(iim,tpps,1)/apols
+
+          DO ij = 1, iip1
+           teta(  ij    ,l) = tpn
+           teta(ij+ip1jm,l) = tps
+          ENDDO
+        ENDDO
+
+        DO ij =  1,iim
+          tppn(ij)  = aire(  ij    ) * ps (  ij    )
+          tpps(ij)  = aire(ij+ip1jm) * ps (ij+ip1jm)
+        ENDDO
+          tpn  = SSUM(iim,tppn,1)/apoln
+
+          tps  = SSUM(iim,tpps,1)/apols
+
+        DO ij = 1, iip1
+          ps(  ij    ) = tpn
+          ps(ij+ip1jm) = tps
+        ENDDO
+
+
+      END IF
+        
+c   ********************************************************************
+c   ********************************************************************
+c   .... fin de l'integration dynamique  et physique pour le pas itau ..
+c   ********************************************************************
+c   ********************************************************************
+
+c   preparation du pas d'integration suivant  ......
+
+      IF ( .NOT.purmats ) THEN
+c       ........................................................
+c       ..............  schema matsuno + leapfrog  ..............
+c       ........................................................
+
+            IF(forward. OR. leapf) THEN
+              itau= itau + 1
+              iday= day_ini+itau/day_step
+              time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
+                IF(time.GT.1.) THEN
+                  time = time-1.
+                  iday = iday+1
+                ENDIF
+            ENDIF
+
+
+            IF( itau. EQ. itaufinp1 ) then  
+              abort_message = 'Simulation finished'
+              call abort_gcm(modname,abort_message,0)
+            ENDIF
+c-----------------------------------------------------------------------
+c   ecriture du fichier histoire moyenne:
+c   -------------------------------------
+
+c           IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
+c              IF(itau.EQ.itaufin) THEN
+c                 iav=1
+c              ELSE
+c                 iav=0
+c              ENDIF
+c              CALL writedynav(histaveid, nqmx, itau,vcov ,
+c    ,                          ucov,teta,pk,phi,q,masse,ps,phis)
+c           ENDIF
+
+c-----------------------------------------------------------------------
+
+
+            IF(itau.EQ.itaufin) THEN
+
+
+       PRINT *,' Appel test_period avant redem ', itau
+       CALL test_period ( ucov,vcov,teta,q,p,phis )
+       CALL dynredem1("restart.nc",0.0,
+     .                     vcov,ucov,teta,q,nqmx,masse,ps)
+
+              CLOSE(99)
+            ENDIF
+
+c-----------------------------------------------------------------------
+c   gestion de l'integration temporelle:
+c   ------------------------------------
+
+            IF( MOD(itau,iperiod).EQ.0 )    THEN
+                    GO TO 1
+            ELSE IF ( MOD(itau-1,iperiod). EQ. 0 ) THEN
+
+                   IF( forward )  THEN
+c      fin du pas forward et debut du pas backward
+
+                      forward = .FALSE.
+                        leapf = .FALSE.
+                           GO TO 2
+
+                   ELSE
+c      fin du pas backward et debut du premier pas leapfrog
+
+                        leapf =  .TRUE.
+                        dt  =  2.*dtvr
+                        GO TO 2
+                   END IF
+            ELSE
+
+c      ......   pas leapfrog  .....
+
+                 leapf = .TRUE.
+                 dt  = 2.*dtvr
+                 GO TO 2
+            END IF
+
+      ELSE
+
+c       ........................................................
+c       ..............       schema  matsuno        ...............
+c       ........................................................
+            IF( forward )  THEN
+
+             itau =  itau + 1
+             iday = day_ini+itau/day_step
+             time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
+
+                  IF(time.GT.1.) THEN
+                   time = time-1.
+                   iday = iday+1
+                  ENDIF
+
+               forward =  .FALSE.
+               IF( itau. EQ. itaufinp1 ) then  
+                 abort_message = 'Simulation finished'
+                 call abort_gcm(modname,abort_message,0)
+               ENDIF
+               GO TO 2
+
+            ELSE
+
+            IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
+               IF(itau.EQ.itaufin) THEN
+                  iav=1
+               ELSE
+                  iav=0
+               ENDIF
+c              CALL writedynav(histaveid, nqmx, itau,vcov ,
+c    ,                          ucov,teta,pk,phi,q,masse,ps,phis)
+
+            ENDIF
+
+
+                 IF(itau.EQ.itaufin)
+     . CALL dynredem1("restart.nc",0.0,
+     .                     vcov,ucov,teta,q,nqmx,masse,ps)
+
+                 forward = .TRUE.
+                 GO TO  1
+
+
+            ENDIF
+
+      END IF
+
+
+ 300  FORMAT('1'/,15x,'run du pas',i7,2x,'au pas',i7,2x,  
+     . 'c''est a dire du jour',i7,3x,'au jour',i7//)
+
+      STOP
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/geopot.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/geopot.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/geopot.F	(revision 2744)
@@ -0,0 +1,69 @@
+      SUBROUTINE geopot (ngrid, teta, pk, pks, phis, phi )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c    *******************************************************************
+c    ....   calcul du geopotentiel aux milieux des couches    .....
+c    *******************************************************************
+c
+c     ....   l'integration se fait de bas en haut  ....
+c
+c     .. ngrid,teta,pk,pks,phis sont des argum. d'entree pour le s-pg ..
+c              phi               est un  argum. de sortie pour le s-pg .
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER ngrid
+      REAL teta(ngrid,llm),pks(ngrid),phis(ngrid),pk(ngrid,llm) ,
+     *       phi(ngrid,llm)
+      real zz(ngrid)
+
+
+c   Local:
+c   ------
+
+      INTEGER  l, ij, count
+      logical flag 
+
+
+c-----------------------------------------------------------------------
+c     calcul de phi au niveau 1 pres du sol  .....
+
+      flag=.false.
+      count=0
+c     call dump2d(iip1,jjp1,teta(:,1),'TETA COUCHE 1')
+c     zz(:)=pks(:)-pk(:,1)
+c     call dump2d(iip1,jjp1,zz(:),'DPK SURF-1')
+
+      DO   ij  = 1, ngrid
+          phi( ij,1 ) = phis( ij ) + teta(ij,1) * ( pks(ij) - pk(ij,1) )
+      ENDDO
+
+c     calcul de phi aux niveaux superieurs  .......
+
+      DO  l = 2,llm
+        DO  ij    = 1,ngrid
+        phi(ij,l) = phi(ij,l-1) + 0.5 * ( teta(ij,l)  + teta(ij,l-1) ) 
+     *                              *   (  pk(ij,l-1) -  pk(ij,l)    )
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_dyn_fi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_dyn_fi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_dyn_fi.F	(revision 2744)
@@ -0,0 +1,37 @@
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
+c   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+
+c   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+            ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_fi_dyn.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_fi_dyn.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_fi_dyn.F	(revision 2744)
@@ -0,0 +1,39 @@
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER i,j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      DO ifield=1,nfield
+
+c  traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+
+c   traitement des point normaux
+         DO j=2,jm-1
+            ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+            pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_int_dyn.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_int_dyn.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_int_dyn.F	(revision 2744)
@@ -0,0 +1,46 @@
+      subroutine gr_int_dyn(champin,champdyn,iim,jp1)
+      implicit none
+c=======================================================================
+c   passage d'un champ interpole a un champ sur grille scalaire
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER iim
+      integer ip1, jp1
+      REAL champin(iim, jp1)
+      REAL champdyn(iim+1, jp1)
+
+      INTEGER i, j
+      real polenord, polesud
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      ip1 = iim + 1
+      polenord = 0.
+      polesud = 0.
+      do i = 1, iim
+        polenord = polenord + champin (i, 1)
+        polesud = polesud + champin (i, jp1)
+      enddo
+      polenord = polenord / iim
+      polesud = polesud / iim
+      do j = 1, jp1
+        do i = 1, iim
+          if (j .eq. 1) then
+            champdyn(i, j) = polenord
+          else if (j .eq. jp1) then
+            champdyn(i, j) = polesud
+          else
+            champdyn(i, j) = champin (i, j)
+          endif
+        enddo
+        champdyn(ip1, j) = champdyn(1, j)
+      enddo
+
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_u_scal.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_u_scal.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_u_scal.F	(revision 2744)
@@ -0,0 +1,57 @@
+      SUBROUTINE gr_u_scal(nx,x_u,x_scal)
+c%W%    %G%
+c=======================================================================
+c
+c   Author:    Frederic Hourdin      original: 11/11/92
+c   -------
+c
+c   Subject:
+c   ------
+c
+c   Method:
+c   --------
+c
+c   Interface:
+c   ----------
+c
+c      Input:
+c      ------
+c
+c      Output:
+c      -------
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER nx
+      REAL x_u(ip1jmp1,nx),x_scal(ip1jmp1,nx)
+
+c   Local:
+c   ------
+
+      INTEGER l,ij
+
+c-----------------------------------------------------------------------
+
+      DO l=1,nx
+         DO ij=ip1jmp1,2,-1
+            x_scal(ij,l)=
+     s      (aireu(ij)*x_u(ij,l)+aireu(ij-1)*x_u(ij-1,l))
+     s      /(aireu(ij)+aireu(ij-1))
+         ENDDO
+      ENDDO
+
+      CALL SCOPY(nx*jjp1,x_scal(iip1,1),iip1,x_scal(1,1),iip1)
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_v_scal.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_v_scal.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gr_v_scal.F	(revision 2744)
@@ -0,0 +1,61 @@
+      SUBROUTINE gr_v_scal(nx,x_v,x_scal)
+c%W%    %G%
+c=======================================================================
+c
+c   Author:    Frederic Hourdin      original: 11/11/92
+c   -------
+c
+c   Subject:
+c   ------
+c
+c   Method:
+c   --------
+c
+c   Interface:
+c   ----------
+c
+c      Input:
+c      ------
+c
+c      Output:
+c      -------
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER nx
+      REAL x_v(ip1jm,nx),x_scal(ip1jmp1,nx)
+
+c   Local:
+c   ------
+
+      INTEGER l,ij
+
+c-----------------------------------------------------------------------
+
+      DO l=1,nx
+         DO ij=iip2,ip1jm
+            x_scal(ij,l)=
+     s      (airev(ij-iip1)*x_v(ij-iip1,l)+airev(ij)*x_v(ij,l))
+     s      /(airev(ij-iip1)+airev(ij))
+         ENDDO
+         DO ij=1,iip1
+            x_scal(ij,l)=0.
+         ENDDO
+         DO ij=ip1jm+1,ip1jmp1
+            x_scal(ij,l)=0.
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grad.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grad.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grad.F	(revision 2744)
@@ -0,0 +1,41 @@
+      SUBROUTINE  grad(klevel, pg,pgx,pgy )
+c
+c      P. Le Van
+c
+c    ******************************************************************
+c     .. calcul des composantes covariantes en x et y du gradient de g
+c
+c    ******************************************************************
+c             pg        est un   argument  d'entree pour le s-prog
+c       pgx  et  pgy    sont des arguments de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+      INTEGER klevel
+      REAL  pg( ip1jmp1,klevel )
+      REAL pgx( ip1jmp1,klevel ) , pgy( ip1jm,klevel )
+      INTEGER  l,ij
+c
+c
+      DO 6 l = 1,klevel
+c
+      DO 2  ij = 1, ip1jmp1 - 1
+      pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
+   2  CONTINUE
+c
+c    .... correction pour  pgx(ip1,j,l)  ....
+c    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....
+CDIR$ IVDEP
+      DO 3  ij = iip1, ip1jmp1, iip1
+      pgx( ij,l ) = pgx( ij -iim,l )
+   3  CONTINUE
+c
+      DO 4 ij = 1,ip1jm
+      pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
+   4  CONTINUE
+c
+   6  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gradiv.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gradiv.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gradiv.F	(revision 2744)
@@ -0,0 +1,56 @@
+      SUBROUTINE gradiv(klevel, xcov, ycov, ld, gdx, gdy )
+c
+c    Auteur :   P. Le Van
+c
+c   ***************************************************************
+c
+c                                ld
+c       calcul  de  (grad (div) )   du vect. v ....
+c
+c     xcov et ycov etant les composant.covariantes de v
+c   ****************************************************************
+c    xcov , ycov et ld  sont des arguments  d'entree pour le s-prog
+c     gdx   et  gdy     sont des arguments de sortie pour le s-prog
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+#include "logic.h"
+
+      INTEGER klevel
+c
+      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
+      REAL gdx( ip1jmp1,klevel ),   gdy( ip1jm,klevel )
+
+      REAL div(ip1jmp1,llm)
+
+      INTEGER l,ij,iter,ld
+c
+      EXTERNAL   SCOPY, diverg,  grad
+      EXTERNAL   filtreg
+c
+c
+      CALL SCOPY( ip1jmp1*klevel,xcov,1,gdx,1 )
+      CALL SCOPY( ip1jm*klevel,  ycov,1,gdy,1 )
+c
+      DO 10 iter = 1,ld
+c
+      CALL diverg( klevel,  gdx , gdy, div          )
+      CALL filtreg( div, jjp1, klevel, 2,1, .true.,2 )
+      CALL grad( klevel,  div, gdx, gdy           )
+c
+      DO 5  l = 1, klevel
+      DO 3 ij = 1, ip1jmp1
+      gdx( ij,l ) = - gdx( ij,l ) * cdivu
+   3  CONTINUE
+      DO 4 ij = 1, ip1jm
+      gdy( ij,l ) = - gdy( ij,l ) * cdivu
+   4  CONTINUE
+   5  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gradiv2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gradiv2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gradiv2.F	(revision 2744)
@@ -0,0 +1,77 @@
+      SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy )
+c
+c     P. Le Van
+c
+c   **********************************************************
+c                                ld
+c       calcul  de  (grad (div) )   du vect. v ....
+c
+c     xcov et ycov etant les composant.covariantes de v
+c   **********************************************************
+c     xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
+c      gdx   et  gdy       sont des arguments de sortie pour le s-prog
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comdissipn.h"
+c
+c     ........    variables en arguments      ........
+
+      INTEGER klevel
+      REAL  xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
+      REAL   gdx( ip1jmp1,klevel ),  gdy( ip1jm,klevel )
+c
+c     ........       variables locales       .........
+c
+      REAL div(ip1jmp1,llm)
+      REAL signe, nugrads
+      INTEGER l,ij,iter,ld
+      
+c    ........................................................
+c
+      EXTERNAL   SCOPY, divergf, grad, laplacien_gam, filtreg
+c
+      CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
+      CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
+c
+c
+      signe   = (-1.)**ld
+      nugrads = signe * cdivu
+c
+
+
+      CALL divergf( klevel, gdx,   gdy , div )
+
+      IF( ld.GT.1 )   THEN
+
+        CALL laplacien ( klevel, div,  div     )
+
+c    ......  Iteration de l'operateur laplacien_gam   .......
+
+        DO iter = 1, ld -2
+         CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1,
+     *                       unsapolnga1, unsapolsga1,  div, div       )
+        ENDDO
+
+      ENDIF
+
+
+       CALL filtreg( div   , jjp1, klevel, 2, 1, .TRUE., 1 )
+       CALL grad  ( klevel,  div,   gdx,  gdy             )
+
+c
+       DO   l = 1, klevel
+         DO  ij = 1, ip1jmp1
+          gdx( ij,l ) = gdx( ij,l ) * nugrads
+         ENDDO
+         DO  ij = 1, ip1jm
+          gdy( ij,l ) = gdy( ij,l ) * nugrads
+         ENDDO
+       ENDDO
+c
+       RETURN
+       END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gradsdef.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gradsdef.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/gradsdef.h	(revision 2744)
@@ -0,0 +1,20 @@
+      integer nfmx,imx,jmx,lmx,nf,nvarmx
+      parameter(nfmx=10,imx=200,jmx=150,lmx=20,nvarmx=1000)
+
+      real xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx)
+
+      integer imd(imx),jmd(jmx),lmd(lmx)
+      integer iid(imx),jid(jmx)
+      integer ifd(imx),jfd(jmx)
+      integer unit(nfmx),irec(nfmx),itime(nfmx),nld(nvarmx,nfmx)
+
+      integer nvar(nfmx),ivar(nfmx)
+      logical firsttime(nfmx)
+
+      character*10 var(nvarmx,nfmx),fichier(nfmx)
+      character*40 title(nfmx),tvar(nvarmx,nfmx)
+
+      common/gradsdef/xd,yd,zd,dtime,
+     s   imd,jmd,lmd,iid,jid,ifd,jfd,
+     s   unit,irec,nvar,ivar,nf,itime,nld,firsttime,
+     s   var,fichier,title,tvar
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grid_atob.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grid_atob.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grid_atob.F	(revision 2744)
@@ -0,0 +1,968 @@
+      SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
+     .                    imar, jmar, x, y, sortie)
+c=======================================================================
+c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
+c
+c Methode naive pour transformer un champ d'une grille fine a une
+c grille grossiere. Je considere que les nouveaux points occupent
+c une zone adjacente qui comprend un ou plusieurs anciens points
+c
+c Aucune ponderation est consideree (voir grille_p)
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        sortie: champ de sortie deja transforme
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL sortie(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(2200),b(2200),c(1100),d(1100)
+      REAL number(2200,1100)
+      REAL distans(2200*1100)
+      INTEGER i_proche, j_proche, ij_proche
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+c Calculer les limites des zones des nouveaux points
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         number(i,j) = 0.0
+         sortie(i,j) = 0.0
+      ENDDO
+      ENDDO
+c
+c Determiner la zone sur laquelle chaque ancien point se trouve
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+               number(ii,jj) = number(ii,jj) + 1.0
+               sortie(ii,jj) = sortie(ii,jj) + entree(i,j)
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c Si aucun ancien point tombe sur une zone, c'est un probleme
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (number(i,j) .GT. 0.001) THEN
+         sortie(i,j) = sortie(i,j) / number(i,j)
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+ccc         CALL ABORT
+         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imdep*jmdep,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imdep*jmdep
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imdep + 1
+         i_proche = ij_proche - (j_proche-1)*imdep
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         sortie(i,j) = entree(i_proche,j_proche)
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+      SUBROUTINE grille_p(imdep, jmdep, xdata, ydata, entree,
+     .                    imar, jmar, x, y, sortie)
+c=======================================================================
+c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
+c
+c Methode naive pour transformer un champ d'une grille fine a une
+c grille grossiere. Je considere que les nouveaux points occupent
+c une zone adjacente qui comprend un ou plusieurs anciens points
+c
+c Consideration de la distance des points (voir grille_m)
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        sortie: champ de sortie deja transforme
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL sortie(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(400),b(400),c(200),d(200)
+      REAL number(400,200)
+      INTEGER indx(400,200), indy(400,200)
+      REAL dist(400,200), distsom(400,200)
+c
+      IF (imar.GT.400 .OR. jmar.GT.200) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+      IF (imdep.GT.400 .OR. jmdep.GT.200) THEN
+         PRINT*, 'imdep ou jmdep trop grand', imdep, jmdep
+         CALL ABORT
+      ENDIF
+c
+c calculer les bords a et b de la nouvelle grille
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+c
+c calculer les bords c et d de la nouvelle grille
+c
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+c
+c trouver les indices (indx,indy) de la nouvelle grille sur laquelle
+c un point de l'ancienne grille est tombe.
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+               indx(i,j) = ii
+               indy(i,j) = jj
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c faire une verification
+c
+
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         IF (indx(i,j).GT.imar .OR. indy(i,j).GT.jmar) THEN
+            PRINT*, 'Probleme grave,i,j,indx,indy=',
+     .              i,j,indx(i,j),indy(i,j)
+            CALL abort
+         ENDIF
+      ENDDO
+      ENDDO
+
+c
+c calculer la distance des anciens points avec le nouveau point,
+c on prend ensuite une sorte d'inverse pour ponderation.
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         number(i,j) = 0.0
+         distsom(i,j) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         dist(i,j) = SQRT ( (xdata(i)-x(indx(i,j)))**2
+     .                     +(ydata(j)-y(indy(i,j)))**2 )
+         distsom(indx(i,j),indy(i,j)) = distsom(indx(i,j),indy(i,j))
+     .                                  + dist(i,j)
+         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j)) +1.
+      ENDDO
+      ENDDO
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         dist(i,j) = 1.0 - dist(i,j)/distsom(indx(i,j),indy(i,j))
+      ENDDO
+      ENDDO
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         number(i,j) = 0.0
+         sortie(i,j) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         sortie(indx(i,j),indy(i,j)) = sortie(indx(i,j),indy(i,j))
+     .                                 + entree(i,j) * dist(i,j)
+         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j))
+     .                                 + dist(i,j)
+      ENDDO
+      ENDDO
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (number(i,j) .GT. 0.001) THEN
+         sortie(i,j) = sortie(i,j) / number(i,j)
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+         CALL ABORT
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
+
+      SUBROUTINE mask_c_o(imdep, jmdep, xdata, ydata, relief,
+     .                    imar, jmar, x, y, mask)
+c=======================================================================
+c z.x.li (le 1 avril 1994): A partir du champ de relief, on fabrique
+c                           un champ indicateur (masque) terre/ocean
+c                           terre:1; ocean:0
+c
+c Methode naive (voir grille_m)
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL relief(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL mask(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(2200),b(2200),c(1100),d(1100)
+      REAL num_tot(2200,1100), num_oce(2200,1100)
+c
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         num_oce(i,j) = 0.0
+         num_tot(i,j) = 0.0
+      ENDDO
+      ENDDO
+
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+               num_tot(ii,jj) = num_tot(ii,jj) + 1.0
+               IF (.NOT. ( relief(i,j) - 0.9. GE. 1.e-5 ) )
+     .             num_oce(ii,jj) = num_oce(ii,jj) + 1.0
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+c
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (num_tot(i,j) .GT. 0.001) THEN
+           IF ( num_oce(i,j)/num_tot(i,j) - 0.5 .GE. 1.e-5 ) THEN
+              mask(i,j) = 0.
+           ELSE
+              mask(i,j) = 1.
+           ENDIF
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+         CALL ABORT
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+c
+c
+
+
+      SUBROUTINE rugosite(imdep, jmdep, xdata, ydata, entree,
+     .                    imar, jmar, x, y, sortie, mask)
+c=======================================================================
+c z.x.li (le 1 avril 1994): Transformer la longueur de rugosite d'une
+c grille fine a une grille grossiere. Sur l'ocean, on impose une valeur
+c fixe (0.001m).
+c
+c Methode naive (voir grille_m)
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL sortie(imar,jmar), mask(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(400),b(400),c(400),d(400)
+      REAL num_tot(400,400)
+      REAL distans(400*400)
+      INTEGER i_proche, j_proche, ij_proche
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      IF (imar.GT.400 .OR. jmar.GT.400) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         num_tot(i,j) = 0.0
+         sortie(i,j) = 0.0
+      ENDDO
+      ENDDO
+
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+              sortie(ii,jj)  = sortie(ii,jj) + LOG(entree(i,j))
+              num_tot(ii,jj) = num_tot(ii,jj) + 1.0
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+       IF (NINT(mask(i,j)).EQ.1) THEN
+         IF (num_tot(i,j) .GT. 0.0) THEN
+            sortie(i,j) = sortie(i,j) / num_tot(i,j)
+            sortie(i,j) = EXP(sortie(i,j))
+         ELSE
+            PRINT*, 'probleme,i,j=', i,j
+ccc            CALL ABORT
+         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imdep*jmdep,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imdep*jmdep
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imdep + 1
+         i_proche = ij_proche - (j_proche-1)*imdep
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         sortie(i,j) = entree(i_proche,j_proche)
+         ENDIF
+       ELSE
+         sortie(i,j) = 0.001
+       ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
+
+
+      SUBROUTINE sea_ice(imdep, jmdep, xdata, ydata, glace01,
+     .                    imar, jmar, x, y, frac_ice)
+c=======================================================================
+c z.x.li (le 1 avril 1994): Transformer un champ d'indicateur de la
+c glace (1, sinon 0) d'une grille fine a un champ de fraction de glace
+c (entre 0 et 1) dans une grille plus grossiere.
+c
+c Methode naive (voir grille_m)
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL glace01(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL frac_ice(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(400),b(400),c(400),d(400)
+      REAL num_tot(400,400), num_ice(400,400)
+      REAL distans(400*400)
+      INTEGER i_proche, j_proche, ij_proche
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      IF (imar.GT.400 .OR. jmar.GT.400) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         num_ice(i,j) = 0.0
+         num_tot(i,j) = 0.0
+      ENDDO
+      ENDDO
+
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+             num_tot(ii,jj) = num_tot(ii,jj) + 1.0
+              IF (NINT(glace01(i,j)).EQ.1 ) 
+     .       num_ice(ii,jj) = num_ice(ii,jj) + 1.0
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (num_tot(i,j) .GT. 0.001) THEN
+           IF (num_ice(i,j).GT.0.001) THEN
+            frac_ice(i,j) = num_ice(i,j) / num_tot(i,j)
+           ELSE
+              frac_ice(i,j) = 0.0
+           ENDIF
+         ELSE
+           PRINT*, 'probleme,i,j=', i,j
+ccc           CALL ABORT
+         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imdep*jmdep,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imdep*jmdep
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imdep + 1
+         i_proche = ij_proche - (j_proche-1)*imdep
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN
+            frac_ice(i,j) = 1.0
+         ELSE
+            frac_ice(i,j) = 0.0
+         ENDIF
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
+      SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief,
+     .                    immod, jmmod, xmod, ymod, rugs)
+c=======================================================================
+c Calculer la longueur de rugosite liee au relief en utilisant
+c l'ecart-type dans une maille de 1x1
+C=======================================================================
+      IMPLICIT none
+c
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      REAL amin, AMAX
+c
+      INTEGER imrel, jmrel
+      REAL xrel(imrel),yrel(jmrel)
+      REAL relief(imrel,jmrel)
+c
+      INTEGER immod, jmmod
+      REAL xmod(immod),ymod(jmmod)
+      REAL rugs(immod,jmmod)
+c
+      INTEGER imtmp, jmtmp
+      PARAMETER (imtmp=360,jmtmp=180)
+      REAL xtmp(imtmp), ytmp(jmtmp)
+      REAL*8 cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
+      REAL zzzz
+c
+      INTEGER i, j, ii, jj
+      REAL a(2200),b(2200),c(1100),d(1100)
+      REAL number(2200,1100)
+c
+      REAL distans(400*400)
+      INTEGER i_proche, j_proche, ij_proche
+c
+      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
+         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
+         CALL ABORT
+      ENDIF
+c
+c Calculs intermediares:
+c
+      xtmp(1) = -180.0 + 360.0/FLOAT(imtmp) / 2.0
+      DO i = 2, imtmp
+         xtmp(i) = xtmp(i-1) + 360.0/FLOAT(imtmp)
+      ENDDO
+      DO i = 1, imtmp
+         xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
+      ENDDO
+      ytmp(1) = -90.0 + 180.0/FLOAT(jmtmp) / 2.0
+      DO j = 2, jmtmp
+         ytmp(j) = ytmp(j-1) + 180.0/FLOAT(jmtmp)
+      ENDDO
+      DO j = 1, jmtmp
+         ytmp(j) = ytmp(j) /180.0 * 4.0*ATAN(1.0)
+      ENDDO
+c
+      a(1) = xtmp(1) - (xtmp(2)-xtmp(1))/2.0
+      b(1) = (xtmp(1)+xtmp(2))/2.0
+      DO i = 2, imtmp-1
+         a(i) = b(i-1)
+         b(i) = (xtmp(i)+xtmp(i+1))/2.0
+      ENDDO
+      a(imtmp) = b(imtmp-1)
+      b(imtmp) = xtmp(imtmp) + (xtmp(imtmp)-xtmp(imtmp-1))/2.0
+
+      c(1) = ytmp(1) - (ytmp(2)-ytmp(1))/2.0
+      d(1) = (ytmp(1)+ytmp(2))/2.0
+      DO j = 2, jmtmp-1
+         c(j) = d(j-1)
+         d(j) = (ytmp(j)+ytmp(j+1))/2.0
+      ENDDO
+      c(jmtmp) = d(jmtmp-1)
+      d(jmtmp) = ytmp(jmtmp) + (ytmp(jmtmp)-ytmp(jmtmp-1))/2.0
+
+      DO i = 1, imtmp
+      DO j = 1, jmtmp
+         number(i,j) = 0.0
+         cham1tmp(i,j) = 0.0
+         cham2tmp(i,j) = 0.0
+      ENDDO
+      ENDDO
+c
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imtmp
+      DO jj = 1, jmtmp
+        DO i = 1, imrel
+         IF( ( xrel(i)-a(ii).GE.1.e-5.AND.xrel(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xrel(i)-a(ii).LE.1.e-5.AND.xrel(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmrel
+          IF( (yrel(j)-c(jj).GE.1.e-5.AND.yrel(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  yrel(j)-c(jj).LE.1.e-5.AND.yrel(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+              number(ii,jj) = number(ii,jj) + 1.0
+              cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j)
+              cham2tmp(ii,jj) = cham2tmp(ii,jj) 
+     .                              + relief(i,j)*relief(i,j)
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+      DO i = 1, imtmp
+      DO j = 1, jmtmp
+         IF (number(i,j) .GT. 0.001) THEN
+         cham1tmp(i,j) = cham1tmp(i,j) / number(i,j)
+         cham2tmp(i,j) = cham2tmp(i,j) / number(i,j)
+         zzzz=cham2tmp(i,j)-cham1tmp(i,j)**2
+         if (zzzz .lt. 0.0) then
+           if (zzzz .gt. -7.5) then
+             zzzz = 0.0
+             print*,'Pb rugsoro, -7.5 < zzzz < 0, => zzz = 0.0'
+           else
+              stop 'Pb rugsoro, zzzz <-7.5'
+           endif
+         endif
+         cham2tmp(i,j) = SQRT(zzzz)
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+         CALL ABORT
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      amin = cham2tmp(1,1)
+      AMAX = cham2tmp(1,1)
+      DO j = 1, jmtmp
+      DO i = 1, imtmp
+         IF (cham2tmp(i,j).GT.AMAX) AMAX = cham2tmp(i,j)
+         IF (cham2tmp(i,j).LT.amin) amin = cham2tmp(i,j)
+      ENDDO
+      ENDDO
+      PRINT*, 'Ecart-type 1x1:', amin, AMAX
+c
+c
+c
+      a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0
+      b(1) = (xmod(1)+xmod(2))/2.0
+      DO i = 2, immod-1
+         a(i) = b(i-1)
+         b(i) = (xmod(i)+xmod(i+1))/2.0
+      ENDDO
+      a(immod) = b(immod-1)
+      b(immod) = xmod(immod) + (xmod(immod)-xmod(immod-1))/2.0
+
+      c(1) = ymod(1) - (ymod(2)-ymod(1))/2.0
+      d(1) = (ymod(1)+ymod(2))/2.0
+      DO j = 2, jmmod-1
+         c(j) = d(j-1)
+         d(j) = (ymod(j)+ymod(j+1))/2.0
+      ENDDO
+      c(jmmod) = d(jmmod-1)
+      d(jmmod) = ymod(jmmod) + (ymod(jmmod)-ymod(jmmod-1))/2.0
+c
+      DO i = 1, immod
+      DO j = 1, jmmod
+         number(i,j) = 0.0
+         rugs(i,j) = 0.0
+      ENDDO
+      ENDDO
+c
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, immod
+      DO jj = 1, jmmod
+        DO i = 1, imtmp
+         IF( ( xtmp(i)-a(ii).GE.1.e-5.AND.xtmp(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xtmp(i)-a(ii).LE.1.e-5.AND.xtmp(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmtmp
+          IF( (ytmp(j)-c(jj).GE.1.e-5.AND.ytmp(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ytmp(j)-c(jj).LE.1.e-5.AND.ytmp(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+              number(ii,jj) = number(ii,jj) + 1.0
+              rugs(ii,jj) = rugs(ii,jj)
+     .                       + LOG(MAX(0.001,real(cham2tmp(i,j))))
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+      DO i = 1, immod
+      DO j = 1, jmmod
+         IF (number(i,j) .GT. 0.001) THEN
+         rugs(i,j) = rugs(i,j) / number(i,j)
+         rugs(i,j) = EXP(rugs(i,j))
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+ccc         CALL ABORT
+         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imtmp*jmtmp,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imtmp*jmtmp
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imtmp + 1
+         i_proche = ij_proche - (j_proche-1)*imtmp
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         rugs(i,j) = LOG(MAX(0.001,real(cham2tmp(i_proche,j_proche))))
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      amin = rugs(1,1)
+      AMAX = rugs(1,1)
+      DO j = 1, jmmod
+      DO i = 1, immod
+         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
+         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
+      ENDDO
+      ENDDO
+      PRINT*, 'Ecart-type du modele:', amin, AMAX
+c
+      DO j = 1, jmmod
+      DO i = 1, immod
+         rugs(i,j) = rugs(i,j) / AMAX * 20.0
+      ENDDO
+      ENDDO
+c
+      amin = rugs(1,1)
+      AMAX = rugs(1,1)
+      DO j = 1, jmmod
+      DO i = 1, immod
+         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
+         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
+      ENDDO
+      ENDDO
+      PRINT*, 'Longueur de rugosite du modele:', amin, AMAX
+c
+      RETURN
+      END
+c
+      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
+c
+c Auteur: Laurent Li (le 30 decembre 1996)
+c
+c Ce programme calcule la distance minimale (selon le grand cercle)
+c entre deux points sur la terre
+c
+c Input:
+      INTEGER im, jm ! dimensions
+      REAL rf_lon ! longitude du point de reference (degres)
+      REAL rf_lat ! latitude du point de reference (degres)
+      REAL rlon(im), rlat(jm) ! longitude et latitude des points
+c
+c Output:
+      REAL distance(im,jm) ! distances en metre
+c
+      REAL rlon1, rlat1
+      REAL rlon2, rlat2
+      REAL dist
+      REAL pa, pb, p, pi
+c
+      REAL radius
+      PARAMETER (radius=6371229.)
+c
+      pi = 4.0 * ATAN(1.0)
+c
+      DO 9999 j = 1, jm
+      DO 9999 i = 1, im
+c
+      rlon1=rf_lon
+      rlat1=rf_lat
+      rlon2=rlon(i)
+      rlat2=rlat(j)
+      pa = pi/2.0 - rlat1*pi/180.0 ! dist. entre pole n et point a
+      pb = pi/2.0 - rlat2*pi/180.0 ! dist. entre pole n et point b
+      p = (rlon1-rlon2)*pi/180.0 ! angle entre a et b (leurs meridiens)
+c
+      dist = ACOS( COS(pa)*COS(pb) + SIN(pa)*SIN(pb)*COS(p))
+      dist = radius * dist
+      distance(i,j) = dist
+c
+ 9999 CONTINUE
+c
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grid_noro.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grid_noro.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grid_noro.F	(revision 2744)
@@ -0,0 +1,487 @@
+
+      SUBROUTINE grid_noro(imdep, jmdep, xdata, ydata, zdata,
+     .             imar, jmar, x, y,
+     .             zphi,zmea,zstd,zsig,zgam,zthe,
+     .             zpic,zval,mask)
+c=======================================================================
+c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
+c
+c      Compute the Parameters of the SSO scheme as described in
+c      LOTT & MILLER (1997) and LOTT(1999).
+c      Target points are on a rectangular grid:
+c      iim+1 latitudes including North and South Poles;
+c      jjm+1 longitudes, with periodicity jjm+1=1.
+c      aux poles.  At the poles the fields value is repeated
+c      jjm+1 time.
+c      The parameters a,b,c,d represent the limite of the target
+c      gridpoint region. The means over this region are calculated
+c      from USN data, ponderated by a weight proportional to the 
+c      surface occupated by the data inside the model gridpoint area.
+c      In most circumstances, this weight is the ratio between the
+c      surface of the USN gridpoint area and the surface of the
+c      model gridpoint area. 
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X and Y input field
+c        xdata, ydata: coordinates X and Y input field
+c        zdata: Input field
+c        In this version it is assumed that the entry data come from
+c        the USNavy dataset: imdep=iusn=2160, jmdep=jusn=1080.
+c OUTPUT:
+c        imar, jmar: dimensions X and Y Output field
+c        x, y: ccordinates  X and Y Output field.
+c             zmea:  Mean orographie   
+c             zstd:  Standard deviation
+c             zsig:  Slope
+c             zgam:  Anisotropy
+c             zthe:  Orientation of the small axis
+c             zpic:  Maximum altitude
+c             zval:  Minimum altitude
+C=======================================================================
+      IMPLICIT INTEGER (I,J)
+      IMPLICIT REAL(X,Z) 
+      
+      parameter(iusn=2160,jusn=1080,iext=216)
+#include "dimensions.h"
+      REAL xusn(iusn+2*iext),yusn(jusn+2)	
+      REAL zusn(iusn+2*iext,jusn+2)
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL zdata(imdep,jmdep)
+c
+      INTEGER imar, jmar
+  
+C INTERMEDIATE FIELDS  (CORRELATIONS OF OROGRAPHY GRADIENT)
+
+      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
+      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
+      REAL weight(iim+1,jjm+1)
+
+C CORRELATIONS OF USN OROGRAPHY GRADIENTS
+
+      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
+      REAL zxtzyusn(iusn+2*iext,jusn+2)
+      REAL x(imar+1),y(jmar),zphi(imar+1,jmar)
+      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
+      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
+      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
+      integer mask(imar+1,jmar)
+      real num_tot(2200,1100),num_lan(2200,1100)
+c
+      REAL a(2200),b(2200),c(1100),d(1100)
+c
+      print *,' parametres de l orographie a l echelle sous maille' 
+      xpi=acos(-1.)
+      rad    = 6 371 229.
+      zdeltay=2.*xpi/float(jusn)*rad
+
+c
+c  quelques tests de dimensions:
+c    
+c
+      if(iim.ne.imar) STOP 'Problem dim. x'
+      if(jjm.ne.jmar-1) STOP 'Problem dim. y'
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar or jmar too big', imar, jmar
+         CALL ABORT
+      ENDIF
+
+      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
+         print *,' imdep or jmdep bad dimensions:',imdep,jmdep
+         call abort
+      ENDIF
+
+      IF(imar+1.ne.iim+1.or.jmar.ne.jjm+1)THEN
+        print *,' imar or jmar bad dimensions:',imar,jmar
+        call abort
+      ENDIF
+
+
+c      print *,'xdata:',xdata
+c      print *,'ydata:',ydata
+c      print *,'x:',x
+c      print *,'y:',y
+c
+C  EXTENSION OF THE USN DATABASE TO POCEED COMPUTATIONS AT
+C  BOUNDARIES:
+c
+      DO j=1,jusn
+        yusn(j+1)=ydata(j)
+      DO i=1,iusn
+        zusn(i+iext,j+1)=zdata(i,j)
+        xusn(i+iext)=xdata(i)
+      ENDDO
+      DO i=1,iext
+        zusn(i,j+1)=zdata(iusn-iext+i,j)
+        xusn(i)=xdata(iusn-iext+i)-2.*xpi
+        zusn(iusn+iext+i,j+1)=zdata(i,j)
+        xusn(iusn+iext+i)=xdata(i)+2.*xpi
+      ENDDO
+      ENDDO
+
+        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
+        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
+       DO i=1,iusn/2+iext
+        zusn(i,1)=zusn(i+iusn/2,2)
+        zusn(i+iusn/2+iext,1)=zusn(i,2)
+        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
+        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
+       ENDDO
+c  
+c COMPUTE LIMITS OF MODEL GRIDPOINT AREA
+C     ( REGULAR GRID)
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar+1) = b(imar)
+      b(imar+1) = x(imar+1) + (x(imar+1)-x(imar))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+c
+c  initialisations:
+c
+
+c     write (*,*) "zpic: ",zpic
+
+      DO i = 1, imar+1
+         DO j = 1, jmar
+            weight(i,j) = 0.0
+            zxtzx(i,j)  = 0.0
+            zytzy(i,j)  = 0.0
+            zxtzy(i,j)  = 0.0
+            ztz(i,j)    = 0.0
+            zmea(i,j)   = 0.0
+            zpic(i,j)  = -1.E+10
+            zval(i,j)  = 1.E+10
+         ENDDO
+      ENDDO
+c
+c  COMPUTE SLOPES CORRELATIONS ON USN GRID
+c
+         DO j = 1,jusn+2 
+         DO i = 1, iusn+2*iext
+            zytzyusn(i,j)=0.0
+            zxtzxusn(i,j)=0.0
+            zxtzyusn(i,j)=0.0
+         ENDDO
+         ENDDO
+
+
+         DO j = 2,jusn+1 
+            zdeltax=zdeltay*cos(yusn(j))
+         DO i = 2, iusn+2*iext-1
+            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
+            zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2
+            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
+     *                   *(zusn(i+1,j)-zusn(i-1,j))/zdeltax
+         ENDDO
+         ENDDO
+c
+c  SUMMATION OVER GRIDPOINT AREA
+c 
+      zleny=xpi/float(jusn)*rad
+      xincr=xpi/2./float(jusn)
+       DO ii = 1, imar+1
+       DO jj = 1, jmar
+       num_tot(ii,jj)=0.
+       num_lan(ii,jj)=0.
+c        PRINT *,' iteration ii jj:',ii,jj
+         DO j = 2,jusn+1 
+c         DO j = 3,jusn 
+            zlenx=zleny*cos(yusn(j))
+            zdeltax=zdeltay*cos(yusn(j))
+            zbordnor=(c(jj)-yusn(j)+xincr)*rad
+            zbordsud=(yusn(j)-d(jj)+xincr)*rad
+            weighy=AMAX1(0.,
+     *             amin1(zbordnor,zbordsud,zleny))
+         IF(weighy.ne.0)THEN
+         DO i = 2, iusn+2*iext-1
+            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
+            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
+            weighx=AMAX1(0.,
+     *             amin1(zbordest,zbordoue,zlenx))
+            IF(weighx.ne.0)THEN
+            num_tot(ii,jj)=num_tot(ii,jj)+1.0
+            if(zusn(i,j).ge.1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
+            weight(ii,jj)=weight(ii,jj)+weighx*weighy
+            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
+            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
+            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
+            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
+c mean
+            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
+c peacks
+            zpic(ii,jj)=amax1(zpic(ii,jj),zusn(i,j))
+c valleys
+            zval(ii,jj)=amin1(zval(ii,jj),zusn(i,j))
+            ENDIF
+         ENDDO
+         ENDIF
+         ENDDO
+       ENDDO
+       ENDDO
+c
+c  COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
+C  LOTT (1999) SSO SCHEME.
+c
+      zllmmea=0.
+      zllmstd=0.
+      zllmsig=0.
+      zllmgam=0.
+      zllmpic=0.
+      zllmval=0.
+      zllmthe=0.
+      zminthe=0.
+c     print 100,' '
+c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
+       DO ii = 1, imar+1
+       DO jj = 1, jmar
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Mask
+           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
+             mask(ii,jj)=1
+           else
+             mask(ii,jj)=0
+           endif
+c  Mean Orography:
+           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
+           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
+           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
+           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
+           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
+c  Standard deviation:
+           zstd(ii,jj)=sqrt(AMAX1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
+         ELSE
+            PRINT*, 'probleme,ii,jj=', ii,jj
+         ENDIF
+       ENDDO
+       ENDDO
+
+C CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
+
+       DO ii = 1, imar+1
+         zxtzx(ii,1)=zxtzx(ii,2)
+         zxtzx(ii,jmar)=zxtzx(ii,jmar-1)
+         zxtzy(ii,1)=zxtzy(ii,2)
+         zxtzy(ii,jmar)=zxtzy(ii,jmar-1)
+         zytzy(ii,1)=zytzy(ii,2)
+         zytzy(ii,jmar)=zytzy(ii,jmar-1)
+       ENDDO
+
+C  FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
+
+C  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
+
+       CALL MVA9(zmea,iim+1,jjm+1)
+       CALL MVA9(zstd,iim+1,jjm+1)
+       CALL MVA9(zpic,iim+1,jjm+1)
+       CALL MVA9(zval,iim+1,jjm+1)
+       CALL MVA9(zxtzx,iim+1,jjm+1)
+       CALL MVA9(zxtzy,iim+1,jjm+1)
+       CALL MVA9(zytzy,iim+1,jjm+1)
+
+       DO ii = 1, imar
+       DO jj = 1, jmar
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Coefficients K, L et M:
+           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
+           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
+           xm=zxtzy(ii,jj)
+           xp=xk-sqrt(xl**2+xm**2)
+           xq=xk+sqrt(xl**2+xm**2)
+           xw=1.e-8
+           if(xp.le.xw) xp=0.
+           if(xq.le.xw) xq=xw
+           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
+c slope: 
+           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
+c isotropy:
+           zgam(ii,jj)=xp/xq*mask(ii,jj)
+c angle theta:
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
+           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
+           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
+           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
+           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
+           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
+
+c          print 101,ii,jj,
+c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
+c    *           zthe(ii,jj)
+c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
+         ELSE
+c           PRINT*, 'probleme,ii,jj=', ii,jj
+         ENDIF
+      zllmmea=AMAX1(zmea(ii,jj),zllmmea)
+      zllmstd=AMAX1(zstd(ii,jj),zllmstd)
+      zllmsig=AMAX1(zsig(ii,jj),zllmsig)
+      zllmgam=AMAX1(zgam(ii,jj),zllmgam)
+      zllmthe=AMAX1(zthe(ii,jj),zllmthe)
+      zminthe=amin1(zthe(ii,jj),zminthe)
+      zllmpic=AMAX1(zpic(ii,jj),zllmpic)
+      zllmval=AMAX1(zval(ii,jj),zllmval)
+       ENDDO
+       ENDDO
+
+      print *,'  MEAN ORO:',zllmmea
+      print *,'  ST. DEV.:',zllmstd
+      print *,'  PENTE:',zllmsig
+      print *,' ANISOTROP:',zllmgam
+      print *,'  ANGLE:',zminthe,zllmthe	
+      print *,'  pic:',zllmpic
+      print *,'  val:',zllmval
+      
+C
+c gamma and theta a 1. and 0. at poles
+c
+      DO jj=1,jmar
+      zmea(imar+1,jj)=zmea(1,jj)
+      zphi(imar+1,jj)=zphi(1,jj)
+      zpic(imar+1,jj)=zpic(1,jj)
+      zval(imar+1,jj)=zval(1,jj)
+      zstd(imar+1,jj)=zstd(1,jj)
+      zsig(imar+1,jj)=zsig(1,jj)
+      zgam(imar+1,jj)=zgam(1,jj)
+      zthe(imar+1,jj)=zthe(1,jj)
+      ENDDO
+
+
+      zmeanor=0.0
+      zmeasud=0.0
+      zstdnor=0.0
+      zstdsud=0.0
+      zsignor=0.0
+      zsigsud=0.0
+      zweinor=0.0
+      zweisud=0.0
+      zpicnor=0.0
+      zpicsud=0.0                                   
+      zvalnor=0.0
+      zvalsud=0.0 
+
+      DO ii=1,imar
+      zweinor=zweinor+              weight(ii,   1)
+      zweisud=zweisud+              weight(ii,jmar)
+      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
+      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
+      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
+      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
+      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
+      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
+      zpicnor=zpicnor+zpic(ii,   1)*weight(ii,   1)
+      zpicsud=zpicsud+zpic(ii,jmar)*weight(ii,jmar)
+      zvalnor=zvalnor+zval(ii,   1)*weight(ii,   1)
+      zvalsud=zvalsud+zval(ii,jmar)*weight(ii,jmar)
+      ENDDO
+
+      DO ii=1,imar+1
+      zmea(ii,   1)=zmeanor/zweinor
+      zmea(ii,jmar)=zmeasud/zweisud
+      zphi(ii,   1)=zmeanor/zweinor
+      zphi(ii,jmar)=zmeasud/zweisud
+      zpic(ii,   1)=zpicnor/zweinor
+      zpic(ii,jmar)=zpicsud/zweisud
+      zval(ii,   1)=zvalnor/zweinor
+      zval(ii,jmar)=zvalsud/zweisud
+      zstd(ii,   1)=zstdnor/zweinor
+      zstd(ii,jmar)=zstdsud/zweisud
+      zsig(ii,   1)=zsignor/zweinor
+      zsig(ii,jmar)=zsigsud/zweisud
+      zgam(ii,   1)=1.
+      zgam(ii,jmar)=1.
+      zthe(ii,   1)=0.
+      zthe(ii,jmar)=0.
+      ENDDO
+
+      RETURN
+      END
+
+      SUBROUTINE MVA9(X,IMAR,JMAR)
+
+C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
+
+      PARAMETER (ISMo=300,JSMo=200)
+      REAL X(IMAR,JMAR),XF(ISMo,JSMo)
+      real weight(-1:1,-1:1)
+
+      if(imar.gt.ismo) stop'surdimensionner ismo dans mva9 (grid_noro)'
+      if(jmar.gt.jsmo) stop'surdimensionner jsmo dans mva9 (grid_noro)'
+      
+      SUM=0.
+      DO IS=-1,1
+      DO JS=-1,1
+      WEIGHT(IS,JS)=1./FLOAT((1+IS**2)*(1+JS**2))
+      SUM=SUM+WEIGHT(IS,JS)
+      ENDDO
+      ENDDO
+
+      DO IS=-1,1
+      DO JS=-1,1
+      WEIGHT(IS,JS)=WEIGHT(IS,JS)/SUM
+      ENDDO
+      ENDDO
+
+      DO J=2,JMAR-1
+      DO I=2,IMAR-1
+      XF(I,J)=0.
+      DO IS=-1,1
+      DO JS=-1,1
+         XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHT(IS,JS)
+      ENDDO
+      ENDDO
+      ENDDO
+      ENDDO
+
+      DO J=2,JMAR-1
+         XF(1,J)=0.
+      IS=IMAR-1
+      DO JS=-1,1 
+         XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHT(-1,JS)
+      ENDDO
+      DO IS=0,1 
+      DO JS=-1,1 
+         XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHT(IS,JS)
+      ENDDO
+      ENDDO
+         XF(IMAR,J)=XF(1,J)
+      ENDDO
+
+      DO I=1,IMAR
+      XF(I,1)=XF(I,2)
+      XF(I,JMAR)=XF(I,JMAR-1)
+      ENDDO
+
+      DO I=1,IMAR
+      DO J=1,JMAR
+         X(I,J)=XF(I,J)
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grid_noro1.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grid_noro1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/grid_noro1.F	(revision 2744)
@@ -0,0 +1,423 @@
+      SUBROUTINE grid_noro1(imdep, jmdep, xdata, ydata, entree,
+     .                 imar, jmar, x, y, zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
+c
+c      Calcul des parametres de l'orographie sous-maille necessaires
+c      au nouveau shema de representation des montagnes meso-echelles
+c      dans le modele.  Les points sont mis sur une grille rectangulaire
+c      pseudo-physique.  Typiquement, il y a iim+1 latitudes incluant
+c      le pole nord et le pole sud.  Il y a jjm+1 longitudes, y compris
+c      aux poles.  Aux poles les champs peuvent ont une valeurs repetee
+c      jjm+1 fois.....  La valeur du champs en jjm+1 (jmar) est celle
+c      en j=1.  
+c      Les parametres a,b,c,d representent les limites de la region
+c      de point de grille correspondant a un point decrit precedemment.
+c      Les moyennes sur ces regions des valeurs calculees a partir de
+c      l'USN, sont ponderees par un poids, fonction de la surface
+c      occuppe par ces donnees a l'interieure de la grille du modele.
+c      Dans la plupart des cas ce poid est le rapport entre la surface
+c      de la region de point de grille USN et la surface de la region
+c      de point de grille du modele.
+c       
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c        dans ce programme, on assume que les donnees sont les altitudes
+c        de l'USNavy: imdep=iusn=2160, jmdep=jusn=1080.
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        les champs de sorties sont sur une grille physique:
+c             zmea:  orographie moyenne
+c             zstd:  deviation standard de l'orographie sous-maille
+c             zsig:  pente de l'orographie sous-maille 
+c             zgam:  anisotropy de l'orographie sous maille
+c             zthe:  orientation de l'axe oriente dans la direction
+c                    de plus grande pente de l'orographie sous maille
+C=======================================================================
+c     IMPLICIT INTEGER (I,J)
+c     IMPLICIT REAL(X,Z) 
+       implicit none
+       integer iusn,jusn,iext
+       parameter(iusn=360,jusn=180,iext=40)
+c!-*-      include 'param1'
+c!-*-      include 'comcstfi.h'
+#include "dimensions.h"
+#include "comconst.h"
+c!-*-
+c!-*-      parameter(iim=cols,jjm=rows)
+      REAL xusn(iusn+2*iext),yusn(jusn+2)	
+      REAL zusn(iusn+2*iext,jusn+2),zusnfi(iusn+2*iext,jusn+2)
+
+c   modif declarations pour implicit none
+      real zmeanor,zmeasud,zstdnor,zstdsud,zsignor
+      real zsigsud,zweinor,zweisud
+      real xk,xl,xm,xw,xp,xq
+      real zmaxmea,zmaxstd,zmaxsig,zmaxgam,zmaxthe,zminthe
+      real zbordnor,zbordsud,zbordest,zbordoue,xpi
+      real zdeltax,zdeltay,zlenx,zleny,weighx,weighy,xincr
+      integer i,j,ii,jj,ideltax,ihalph
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+  
+      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
+      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
+      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
+      REAL zxtzyusn(iusn+2*iext,jusn+2)
+      REAL weight(iim+1,jjm+1)
+      REAL x(imar+1),y(jmar)
+      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
+      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
+c
+      REAL a(2200),b(2200),c(1100),d(1100)
+c
+c  quelques constantes:
+c
+      print *,' parametres de l orographie a l echelle sous maille' 
+      print*,'rad =',rad
+      print*,'Long et lat entree'
+      print*,(x(i),i=1,imar+1)
+      print*,(y(j),j=1,jmar)
+       print*,'Long et lat donnees'
+      print*,(xdata(i),i=1,imdep)
+      print*,(ydata(j),j=1,jmdep)
+
+      xpi=acos(-1.)
+      zdeltay=2.*xpi/float(jusn)*rad
+c
+c  quelques tests de dimensions:
+c    
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+
+      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
+         print *,' imdep ou jmdep mal dimensionnes:',imdep,jmdep
+         call abort
+      ENDIF
+
+      IF(imar+1.gt.iim+1.or.jmar.gt.jjm+1)THEN
+        print *,' imar ou jmar mal dimensionnes:',imar,jmar
+        call abort
+      ENDIF
+c
+C  Extension de la base de donnee de l'USN pour faciliter
+C  les calculs ulterieurs:
+c
+      DO j=1,jusn
+        yusn(j+1)=ydata(j)
+      DO i=1,iusn
+        zusn(i+iext,j+1)=entree(i,j)
+        xusn(i+iext)=xdata(i)
+      ENDDO
+      DO i=1,iext
+        zusn(i,j+1)=entree(iusn-iext+i,j)
+        xusn(i)=xdata(iusn-iext+i)-2.*xpi
+        zusn(iusn+iext+i,j+1)=entree(i,j)
+        xusn(iusn+iext+i)=xdata(i)+2.*xpi
+      ENDDO
+      ENDDO
+
+        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
+        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
+       DO i=1,iusn/2+iext
+        zusn(i,1)=zusn(i+iusn/2,2)
+        zusn(i+iusn/2+iext,1)=zusn(i,2)
+        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
+        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
+       ENDDO
+c
+c  Calcul d'une orographie filtree aux hautes latitudes
+c  pour permettre des calculs plus isotropiques sur la pente
+c  des montagnes
+c
+       DO i=1,IUSN+2*iext
+       DO J=1,JUSN+2
+          zusnfi(i,j)=0.0
+       ENDDO
+       ENDDO
+
+      DO j=1,jusn
+            ideltax=1./cos(yusn(j+1))
+            ideltax=min(iusn/2-1,ideltax)
+            IF(MOD(IDELTAX,2).EQ.0)THEN
+              IDELTAX=IDELTAX+1
+            ENDIF
+            IHALPH=(IDELTAX-1)/2 
+c           print *,' ideltax=',ideltax
+         IF(ideltax.eq.1)THEN
+            DO i=1,iusn
+               zusnfi(i+iext,j+1)=entree(i,j)
+            ENDDO   
+         ELSE
+            DO i=1,ihalph
+               DO ii=1,i+ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               DO ii=ihalph-i,0,-1
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(iusn-ii,j)
+               ENDDO  
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
+            ENDDO   
+            DO i=iusn-ihalph+1,iusn
+               DO ii = i-ihalph,iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO 
+               DO ii = 1,ihalph+i-iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
+            ENDDO
+            DO i=ihalph+1,iusn-ihalph
+               DO ii=-ihalph,ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(i+ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
+            ENDDO
+         ENDIF
+            DO i=1,iext
+               zusnfi(i,j+1)=zusnfi(iusn-iext+i,j+1)
+               zusnfi(i+iusn+iext,j+1)=zusnfi(i,j+1)
+            ENDDO
+      ENDDO
+c  
+c Calculer les limites des zones des nouveaux points
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+c
+c      quelques initialisations:
+      print*,'OKM1'
+c
+      DO i = 1, imar
+      DO j = 1, jmar
+         weight(i,j) = 0.0
+         zxtzx(i,j) = 0.0
+         zytzy(i,j) = 0.0
+         zxtzy(i,j) = 0.0
+         ztz(i,j) = 0.0
+         zmea(i,j) = 0.0
+         zstd(i,j)=0.0
+      ENDDO
+      ENDDO
+c
+c  calculs des correlations de pentes sur la grille de l'USN.
+c
+         DO j = 2,jusn+1 
+         DO i = 1, iusn+2*iext
+            zytzyusn(i,j)=0.0
+            zxtzxusn(i,j)=0.0
+            zxtzyusn(i,j)=0.0
+         ENDDO
+         ENDDO
+
+
+         DO j = 2,jusn+1 
+            zdeltax=zdeltay*cos(yusn(j))
+         DO i = 2, iusn+2*iext-1
+            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
+            zxtzxusn(i,j)=(zusnfi(i+1,j)-zusnfi(i-1,j))**2/zdeltax**2
+            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
+     *                   *(zusnfi(i+1,j)-zusnfi(i-1,j))/zdeltax
+         ENDDO
+
+         ENDDO
+
+ 
+
+      print*,'OK0'
+c
+c  sommations des differentes quantites definies precedemment
+c  sur une grille du modele.
+c 
+      zleny=xpi/float(jusn)*rad
+      xincr=xpi/2./float(jusn)
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c        PRINT *,' iteration ii jj:',ii,jj
+         DO j = 2,jusn+1 
+c         DO j = 3,jusn 
+            zlenx=zleny*cos(yusn(j))
+            zdeltax=zdeltay*cos(yusn(j))
+            zbordnor=(c(jj)-yusn(j)+xincr)*rad
+            zbordsud=(yusn(j)-d(jj)+xincr)*rad
+            weighy=amax1(0.,
+     *             amin1(zbordnor,zbordsud,zleny))
+         IF(weighy.ne.0)THEN
+         DO i = 2, iusn+2*iext-1
+            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
+            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
+            weighx=amax1(0.,
+     *             amin1(zbordest,zbordoue,zlenx))
+            IF(weighx.ne.0)THEN
+            weight(ii,jj)=weight(ii,jj)+weighx*weighy
+            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
+            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
+            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
+            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
+            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
+            ENDIF
+         ENDDO
+         ENDIF
+         ENDDO
+       ENDDO
+       ENDDO
+c
+c  calculs des differents parametres necessaires au programme
+c  de parametrisation de l'orographie a l'echelle moyenne:
+c
+      zmaxmea=0.
+      zmaxstd=0.
+      zmaxsig=0.
+      zmaxgam=0.
+      zmaxthe=0.
+      zminthe=0.
+c     print 100,' '
+c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
+       print*,'OK1'
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c       print*,'ok0'
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Orography moyenne:
+c         print*,'ok1'
+           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
+           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
+           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
+           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
+           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
+c         print*,'ok2'
+c  Deviation standard:
+           zstd(ii,jj)=sqrt(amax1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
+c  Coefficients K, L et M:
+           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
+           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
+           xm=zxtzy(ii,jj)
+           xp=xk-sqrt(xl**2+xm**2)
+           xq=xk+sqrt(xl**2+xm**2)
+           xw=1.e-8
+           if(xp.le.xw) xp=0.
+           if(xq.le.xw) xq=xw
+           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
+c          print*,'ok3'
+c pente: 
+           zsig(ii,jj)=sqrt(xq)
+c           zsig(ii,jj)=sqrt(2.*xk)
+c isotropy:
+           zgam(ii,jj)=xp/xq
+c angle theta:
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
+
+c          print 101,ii,jj,
+c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
+c    *           zthe(ii,jj)
+c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
+c          print*,'ok4'
+         ELSE
+c           PRINT*, 'probleme,ii,jj=', ii,jj
+c          print*,'ok1b'
+         ENDIF
+      zmaxmea=amax1(zmea(ii,jj),zmaxmea)
+c         print*,'oka'
+      zmaxstd=amax1(zstd(ii,jj),zmaxstd)
+c         print*,'okb'
+      zmaxsig=amax1(zsig(ii,jj),zmaxsig)
+c         print*,'okc'
+      zmaxgam=amax1(zgam(ii,jj),zmaxgam)
+c         print*,'okd'
+      zmaxthe=amax1(zthe(ii,jj),zmaxthe)
+c         print*,'oke'
+      zminthe=amin1(zthe(ii,jj),zminthe)
+c      print*,'ok5'
+       ENDDO
+       ENDDO
+
+      print *,'  MEAN ORO:',zmaxmea
+	  print *,'  ST. DEV.:',zmaxstd
+      print *,'  PENTE:',zmaxsig
+      print *,' ANISOTROP:',zmaxgam
+      print *,'  ANGLE:',zminthe,zmaxthe	
+      
+C
+c  On passe ce donnees sur la grille dite physique....(?)
+c  On met gamma et theta a 1. et 0. aux poles ou ces quantites
+c  n'ont pas vraiment de sens
+c
+      DO jj=1,jmar
+      zmea(imar+1,jj)=zmea(1,jj)
+      zstd(imar+1,jj)=zstd(1,jj)
+      zsig(imar+1,jj)=zsig(1,jj)
+      zgam(imar+1,jj)=zgam(1,jj)
+      zthe(imar+1,jj)=zthe(1,jj)
+      ENDDO
+
+
+      zmeanor=0.0
+      zmeasud=0.0
+      zstdnor=0.0
+      zstdsud=0.0
+      zsignor=0.0
+      zsigsud=0.0
+      zweinor=0.0
+      zweisud=0.0
+
+      DO ii=1,imar
+      zweinor=zweinor+              weight(ii,   1)
+      zweisud=zweisud+              weight(ii,jmar)
+      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
+      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
+      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
+      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
+      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
+      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
+      ENDDO
+
+      DO ii=1,imar+1
+      zmea(ii,   1)=zmeanor/zweinor
+      zmea(ii,jmar)=zmeasud/zweisud
+      zstd(ii,   1)=zstdnor/zweinor
+      zstd(ii,jmar)=zstdsud/zweisud
+      zsig(ii,   1)=zsignor/zweinor
+      zsig(ii,jmar)=zsigsud/zweisud
+      zgam(ii,   1)=1.
+      zgam(ii,jmar)=1.
+      zthe(ii,   1)=0.
+      zthe(ii,jmar)=0.
+      ENDDO
+
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/groupe.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/groupe.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/groupe.F	(revision 2744)
@@ -0,0 +1,83 @@
+      subroutine groupe(pext,pbaru,pbarv,pbarum,pbarvm,wm)
+      implicit none
+
+c   SEE COMMENTS IN groupeun.F
+c
+c   sous-programme servant a fitlrer les champs de flux de masse aux
+c   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
+c   et a mesure qu'on se rapproche du pole.
+c
+c   en entree: pext, pbaru et pbarv
+c
+c   en sortie:  pbarum,pbarvm et wm.
+c
+c   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
+c   pas besoin de w en entree.
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom2.h"
+#include "comvert.h"
+
+
+      real pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
+      real pext(iip1,jjp1,llm)
+
+      real pbarum(iip1,jjp1,llm),pbarvm(iip1,jjm,llm)
+      real wm(iip1,jjp1,llm)
+
+      real zconvm(iip1,jjp1,llm),zconvmm(iip1,jjp1,llm)
+
+      real uu
+
+      integer i,j,l
+
+c   Champs 1D
+
+      call convflu(pbaru,pbarv,llm,zconvm)
+
+c
+      call scopy(ijp1llm,zconvm,1,zconvmm,1)
+      call scopy(ijmllm,pbarv,1,pbarvm,1)
+
+c
+      call groupeun(jjp1,llm,zconvmm)
+      call groupeun(jjm,llm,pbarvm)
+
+c   Champs 3D
+
+      do l=1,llm
+         do j=2,jjm
+            uu=pbaru(iim,j,l)
+            do i=1,iim
+               uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
+               pbarum(i,j,l)=uu
+c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
+c    *                      yflu(i,j,l)-yflu(i,j-1,l)
+            enddo
+            pbarum(iip1,j,l)=pbarum(1,j,l)
+         enddo
+      enddo
+
+c    integration de la convergence de masse de haut  en bas ......
+      do l=1,llm
+         do j=1,jjp1
+            do i=1,iip1
+               zconvmm(i,j,l)=zconvmm(i,j,l)
+            enddo
+         enddo
+      enddo
+      do  l = llm-1,1,-1
+          do j=1,jjp1
+             do i=1,iip1
+                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
+             enddo
+          enddo
+      enddo
+
+      CALL vitvert(zconvmm,wm)
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/groupeun.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/groupeun.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/groupeun.F	(revision 2744)
@@ -0,0 +1,145 @@
+!Mars importe directement de la version martienne 
+      subroutine groupeun(jjmax,llmax,q)
+      implicit none
+
+c *********************************************************
+c     lissage fort des champs aux poles pour permettre 
+c     de tourner avec plafond haut.
+c     F. Hourdin, 1997.
+c     (commentaire et test sur ngroup par Francois Forget, 05/2000)
+c
+c     Technique :
+c
+c     1) Les points sont regroupes par paquet de 2**ngroup 
+c     aux poles (e.g. ngroup=3 -> paquet de 8), puis 2**(ngroup-1)
+c     2**(ngroup-2), etc... aux latitude plus basse en s'eloignant du pole
+c
+c     2) Plus ngroup est eleve, plus le lissage est efficace
+c
+c     3) MAIS, il faut iim divisible par 2**ngroup !!!
+c
+c
+c *********************************************************
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom2.h"
+
+      integer jjmax,llmax
+      real q(iip1,jjmax,llmax)
+
+      integer ngroup
+      parameter (ngroup=3) 
+
+      logical intensive
+
+      real airen,airecn,qn
+      real aires,airecs,qs
+
+      integer i,j,l,ig,j1,j2,i0,jd
+      logical firstcall
+      DATA firstcall/.true./
+
+c -------------------------------------------------------
+c   test sur ngroup :
+
+      if (firstcall) then
+        IF(MOD(iim,2**ngroup).NE.0) then
+           write(*,*) 'Problem in groupeun.F'
+           write(*,*) 'iim= ', iim, ' ngroup=', ngroup
+           write(*,*) 'iim must be divisible by par 2**ngroup= ',
+     &                 2**ngroup
+           write(*,*) ' YOU must change ngroup in groupeun.F'
+           write(*,*) ' Have fun... '
+           stop
+        END IF
+        write(*,*) 'in groupeun.F, ngroup=', ngroup
+        firstcall = .false.
+      end if
+      
+
+c Champs 3D
+      intensive=.true.
+      if (intensive) then
+      jd=jjp1-jjmax
+      do l=1,llmax
+       j1=1+jd
+       j2=2
+       do ig=1,ngroup
+         do j=j1-jd,j2-jd
+c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
+            do i0=1,iim,2**(ngroup-ig+1)
+               airen=0.
+               airecn=0.
+               qn=0.
+               aires=0.
+               airecs=0.
+               qs=0.
+               do i=i0,i0+2**(ngroup-ig+1)-1
+                  airen=airen+aire(i,j)
+                  aires=aires+aire(i,jjp1-j+1)
+                  qn=qn+q(i,j,l)*aire(i,j)
+                  qs=qs+q(i,jjp1-j+1-jd,l)*aire(i,jjp1-j+1)
+               enddo
+               airecn=0.
+               airecs=0.
+               do i=i0,i0+2**(ngroup-ig+1)-1
+                  q(i,j,l)=qn/airen
+                  q(i,jjp1-j+1-jd,l)=qs/aires
+               enddo
+            enddo
+            q(iip1,j,l)=q(1,j,l)
+            q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
+         enddo
+         j1=j2+1
+         j2=j2+2**ig
+       enddo
+      enddo
+
+c  ---------------
+      else
+c   Cas sans multiplication par les aires.
+c  ---------------
+
+      jd=jjp1-jjmax
+      do l=1,llmax
+      j1=1+jd
+      j2=2
+      do ig=1,ngroup
+         do j=j1-jd,j2-jd
+c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
+            do i0=1,iim,2**(ngroup-ig+1)
+               airen=0.
+               airecn=0.
+               qn=0.
+               aires=0.
+               airecs=0.
+               qs=0.
+               do i=i0,i0+2**(ngroup-ig+1)-1
+                  airen=airen+aire(i,j)
+                  aires=aires+aire(i,jjp1-j+1)
+                  qn=qn+q(i,j,l)
+                  qs=qs+q(i,jjp1-j+1-jd,l)
+               enddo
+               airecn=0.
+               airecs=0.
+               do i=i0,i0+2**(ngroup-ig+1)-1
+                  q(i,j,l)=qn*aire(i,j)/airen
+                  q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
+               enddo
+            enddo
+            q(iip1,j,l)=q(1,j,l)
+            q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
+         enddo
+         j1=j2+1
+         j2=j2+2**ig
+      enddo
+      enddo
+
+      endif
+
+c     print*,'On groupe jusque j=',j1-1,rlatu(j1-1)*180./pi
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/heavyside.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/heavyside.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/heavyside.F	(revision 2744)
@@ -0,0 +1,21 @@
+c
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/heavyside.F,v 1.2 2001/04/13 15:49:10 lmdz Exp $
+c
+       FUNCTION heavyside(a)
+
+c      ...   P. Le Van  ....
+c
+       IMPLICIT NONE
+
+       REAL*8 heavyside , a
+
+       IF ( a.LE.0. )  THEN
+         heavyside = 0.
+       ELSE
+         heavyside = 1.
+       ENDIF
+
+       RETURN
+       END
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ini_archive.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ini_archive.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ini_archive.F	(revision 2744)
@@ -0,0 +1,473 @@
+c=======================================================================
+      subroutine ini_archive(nid,idayref,phis,tab_cntrl_fi)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:  ecriture de l'entete du fichier "start_archive"
+c   -----
+c
+c	 Proche de iniwrite.F
+c
+c	 On ajoute dans le tableau "tab_cntrl" (dynamique), a partir de 51, 
+c	 les valeurs de tab_cntrl_fi (les 38 parametres de controle physiques
+c	 du RUN + ptotal et cotoicetotal)
+c
+c			tab_cntrl(50+l)=tab_cntrl_fi(l)
+c
+c   Arguments:
+c   ---------
+c
+c	Inputs:
+c   ------
+c
+c       nid            unite logique du fichier "start_archive"
+c       idayref        Valeur du jour initial a mettre dans
+c                      l'entete du fichier "start_archive"
+c       phis           geopotentiel au sol
+c       tab_cntrl_fi   tableau des param physiques
+c
+
+c=======================================================================
+ 
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "description.h"
+#include "serre.h"
+#include "netcdf.inc"
+#include "control.h"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c   Local:
+c   ------
+      INTEGER	length,l
+      parameter (length = 100)
+      REAL		tab_cntrl(length) ! tableau des parametres du run
+      INTEGER	loop
+      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
+      INTEGER	setdim
+      INTEGER	ind1,indlast
+
+c   Arguments:
+c   ----------
+      INTEGER*4	idayref
+      REAL		phis(ip1jmp1)
+      REAL		tab_cntrl_fi(length)
+
+!Mars --------Ajouts-----------
+c   Variables locales pour NetCDF:
+c
+      INTEGER dims2(2), dims3(3), dims4(4)
+      INTEGER idim_index
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_llmp1,idim_llm
+      INTEGER idim_tim
+      INTEGER nid,nvarid
+      real sig_s(llm),s(llm)
+
+      pi  = 2. * ASIN(1.)
+
+
+c-----------------------------------------------------------------------
+c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      tab_cntrl(1)  = FLOAT(iim) ! nombre de points en longitude
+      tab_cntrl(2)  = FLOAT(jjm) ! nombre de points en latitude
+      tab_cntrl(3)  = FLOAT(llm) ! nombre de couches
+      tab_cntrl(4)  = FLOAT(idayref) ! jour 0
+      tab_cntrl(5)  = rad ! rayon de mars(m) ~3397200
+      tab_cntrl(6)  = omeg ! vitesse de rotation (rad.s-1)
+      tab_cntrl(7)  = g   ! gravite (m.s-2) ~3.72
+      tab_cntrl(8)  = cpp 
+      tab_cntrl(8)  = 43.49 !mars temporaire Masse molaire de l''atm (g.mol-1) ~43.49
+      tab_cntrl(9)  = kappa ! = r/cp  ~0.256793 (=rcp dans physique)
+      tab_cntrl(10) = daysec ! duree du sol (s)  ~88775
+      tab_cntrl(11) = dtvr ! pas de temps de la dynamique (s)
+      tab_cntrl(12) = etot0 ! energie totale    !
+      tab_cntrl(13) = ptot0 ! pression totalei   !    variables
+      tab_cntrl(14) = ztot0 ! enstrophie totale   !  de controle
+      tab_cntrl(15) = stot0 ! enthalpie totale   !    globales
+      tab_cntrl(16) = ang0 ! moment cinetique  !
+      tab_cntrl(17) = pa
+      tab_cntrl(18) = preff
+
+c    .....    parametres  pour le zoom      ......   
+
+      tab_cntrl(19)  = clon ! longitude en degres du centre du zoom
+      tab_cntrl(20)  = clat ! latitude en degres du centre du zoom
+      tab_cntrl(21)  = grossismx ! facteur de grossissement du zoom,selon longitude
+      tab_cntrl(22)  = grossismy ! facteur de grossissement du zoom ,selon latitude
+
+      IF ( fxyhypb )   THEN
+       tab_cntrl(23) = 1.
+       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+      ELSE
+       tab_cntrl(23) = 0.
+       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+       tab_cntrl(26) = 0.
+       IF ( ysinus)  tab_cntrl(26) = 1.
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   Copie du tableau des parametres de controle du RUN  (physique)
+c		dans le tableau dynamique
+c-----------------------------------------------------------------------
+
+      DO l=1,50
+         tab_cntrl(50+l)=tab_cntrl_fi(l)
+      ENDDO
+
+c=======================================================================
+c	Ecriture NetCDF de l''entete du fichier "start_archive"
+c=======================================================================
+
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
+     .                       "Fichier start_archive")
+c
+c Definir les dimensions du fichiers:
+c
+c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+
+
+      ierr = NF_DEF_DIM (nid,"index", length, idim_index)
+      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid,"interlayer", llmp1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid,"Time", NF_UNLIMITED, idim_tim)
+
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+
+c-----------------------------------------------------------------------
+c  Ecriture du tableau des parametres du run
+c-----------------------------------------------------------------------
+
+      call def_var(nid,"Time","Time","days since 00:00:00",1,
+     .            idim_tim,nvarid,ierr)
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des longitudes et latitudes
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des niveaux verticaux
+c-----------------------------------------------------------------------
+
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
+     .                       "Coef A: niveaux pression hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 35,
+     .                       "Coefficient B niveaux sigma hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 36,
+     .      "Coef AS: hybrid pressure in midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
+     .      "Coef BS: hybrid sigma midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+c
+c ----------------------
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+c ------------------------------------------------------------------
+c  Variable uniquement pour visualisation avec Grads ou Ferret
+c ------------------------------------------------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c----------------------
+       ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c--------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonu
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatv
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+c Aire de chaque maille:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Aires de chaque maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture du geopentiel au sol
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Geopotentiel au sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+
+      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      PRINT*,'rad,omeg,g,mugaz,kappa',
+     s rad,omeg,g,43.49,kappa !mars temporaire (ecrire mugaz ensuite)
+      PRINT*,'daysec,dtvr',daysec,dtvr
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniav.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniav.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniav.F	(revision 2744)
@@ -0,0 +1,235 @@
+      SUBROUTINE iniav(fichnom,pday0,pyear0,pfrac0,pperiod,phis,nq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   pday0    jour de reference pour le stockage
+c   pfrac0   decalage du debut du stockage par rapport a pday0 (en jour)
+c   pperiod  period de stockage en secondes
+c   phis     geopotentiel au sol
+c   
+c   initialisation de l'ecriture des moyennes temporelles.
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comav.h"
+#include "netcdf.inc"
+#include "comvert.h"
+#include "comgeom.h"
+
+      REAL pperiod
+
+      INTEGER*4 pday0,pyear0
+      REAL pfrac0
+      CHARACTER*(*) fichnom
+      REAL phis(ip1jmp1)
+c
+      CHARACTER str3*3
+c
+      INTEGER nq
+      INTEGER ierr, nid, nvarid, iq
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_s, idim_sig
+      INTEGER idim_tim
+      INTEGER dims2(2), dims3(3), dims4(4)
+
+      period_av=pperiod
+      time0_av=pfrac0
+c
+      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
+         WRITE(6,*)' ierr = ', ierr
+         CALL ABORT
+      ENDIF
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 32,
+     .                       "Fichier moyen histoire dynamique")
+c
+c Definir les dimensions du fichiers:
+c
+      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
+      ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
+      ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+c
+c Definir et enregistrer certains champs invariants:
+c
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
+      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
+      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+c
+c Geopentiel au sol:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+ccc      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+c Definir les variables pour pouvoir les enregistrer plus tard:
+c
+      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
+c
+ccc      ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
+      ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "iniav: Erreur pour definir <temps>"
+         CALL abort
+      ENDIF
+c
+      dims4(1) = idim_rlonu
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+ccc      ierr = NF_DEF_VAR (nid,"vitu",NF_DOUBLE,4,dims4,nvarid)
+      ierr = NF_DEF_VAR (nid,"vitu",NF_FLOAT,4,dims4,nvarid)
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatv
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+ccc      ierr = NF_DEF_VAR (nid,"vitv",NF_DOUBLE,4,dims4,nvarid)
+      ierr = NF_DEF_VAR (nid,"vitv",NF_FLOAT,4,dims4,nvarid)
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+ccc      ierr = NF_DEF_VAR (nid,"temp",NF_DOUBLE,4,dims4,nvarid)
+      ierr = NF_DEF_VAR (nid,"temp",NF_FLOAT,4,dims4,nvarid)
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+      IF(nq.GE.1) THEN
+      DO iq=1,nq
+      IF (iq.GT.99) THEN
+         PRINT*, "Trop de traceurs"
+         CALL abort
+      ELSE
+         str3(1:1)='q'
+         WRITE(str3(2:3),'(i2.2)') iq
+ccc         ierr = NF_DEF_VAR (nid,str3,NF_DOUBLE,4,dims4,nvarid)
+         ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
+      ENDIF
+      ENDDO
+      ENDIF
+c
+      dims3(1) = idim_rlonv
+      dims3(2) = idim_rlatu
+      dims3(3) = idim_tim
+ccc      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
+      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+      ierr = NF_CLOSE(nid) ! fermer le fichier
+
+      PRINT*,'le fichier hist.moy stoke les variables toutes'
+      PRINT*,'les ',period_av,'s'
+      PRINT*,'A partir du jour de reference day0'
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniconst.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniconst.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniconst.F	(revision 2744)
@@ -0,0 +1,55 @@
+      SUBROUTINE iniconst
+
+      IMPLICIT NONE
+c
+c      P. Le Van
+c
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "temps.h"
+#include "control.h"
+#include "comvert.h"
+
+
+      INTEGER :: l
+c
+c
+      EXTERNAL disvert
+c
+c-----------------------------------------------------------------------
+c   dimension des boucles:
+c   ----------------------
+
+      im      = iim
+      jm      = jjm
+      lllm    = llm
+      imp1    = iim 
+      jmp1    = jjm + 1
+      lllmm1  = llm - 1
+      lllmp1  = llm + 1
+
+c-----------------------------------------------------------------------
+
+      dtdiss  = idissip * dtvr
+      dtphys  = iphysiq * dtvr
+      unsim   = 1./iim
+      pi      = 2.*ASIN( 1. )
+
+c-----------------------------------------------------------------------
+c
+
+      r       = cpp * kappa
+
+      PRINT*,' R  CPP  Kappa ',  r , cpp,  kappa
+c
+c-----------------------------------------------------------------------
+      CALL disvert
+c
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/inidissip.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/inidissip.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/inidissip.F	(revision 2744)
@@ -0,0 +1,287 @@
+      SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh  ,
+     *                       tetagdiv,tetagrot,tetatemp             )
+c=======================================================================
+c   initialisation de la dissipation horizontale
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      IMPLICIT NONE
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "control.h"
+
+      LOGICAL lstardis
+      INTEGER nitergdiv,nitergrot,niterh
+      REAL    tetagdiv,tetagrot,tetatemp
+      REAL zvert(llm),zz
+      REAL zh(ip1jmp1),zu(ip1jmp1),zv(ip1jm),deltap(ip1jmp1,llm)
+      REAL ullm,vllm,umin,vmin,zhmin,zhmax
+      REAL zllm,z1llm
+
+      INTEGER l,ij,idum,ii
+      REAL tetamin
+
+      EXTERNAL ran1
+      REAL ran1
+      real sig_s(llm)
+      save sig_s
+      logical firstcall
+      data firstcall/.true./
+      save firstcall 
+
+      REAL fac_mid
+      REAL fac_up
+      REAL delta
+      REAL middle,startalt
+      SAVE fac_mid, fac_up, delta, startalt, middle
+
+c ------------------------------------------------------
+      if (firstcall) then
+         firstcall=.false.
+         do l=1,llm
+            sig_s(l)=aps(l)/preff + bps(l)
+         enddo
+
+c        COMPUTING THE VARIATION OF DISSIPATION AS A FUNCTION OF MODEL TOP :
+c         FF 2004       
+         if (pseudoalt(llm).lt.160.) then 
+             fac_mid=2  ! coeff  pour dissipation aux basses/moyennes altitudes
+             fac_up=10 ! coeff multiplicateur pour dissipation hautes altitudes
+             startalt=90. ! altitude en Km de la transition mid / up
+             delta=20.! Intervalle (km) pour le changement mid / up
+         else ! thermosphere model
+             fac_mid=2 ! coeff pour dissipation aux basses/moyennes altitudes
+             fac_up=25 ! coeff multiplicateur pour dissipation hautes altitudes
+c            startalt: 95 OK for MY24
+             startalt=95. ! altitude en Km de la transition mid / up
+             delta=30.! Intervalle (km) pour le changement mid /up
+         end if
+         middle=startalt+delta/2
+         write(*,*) 'Dissipation : '
+         write(*,*) 'Multiplication de la dissipation en altitude :',
+     &          ' fac_mid, fac_up =', fac_mid, fac_up 
+         write(*,*) 'Transition mid /up : startalt, delta =',
+     &             startalt, delta , '(km)'
+      endif
+
+c-----------------------------------------------------------------------
+c
+c   calcul des valeurs propres des operateurs par methode iterrative:
+c   -----------------------------------------------------------------
+
+      crot     = -1.
+      cdivu    = -1.
+      cdivh    = -1.
+
+c   calcul de la valeur propre de divgrad:
+c   --------------------------------------
+      idum = 0
+      DO l = 1, llm
+       DO ij = 1, ip1jmp1
+        deltap(ij,l) = 1.
+       ENDDO
+      ENDDO
+
+      idum  = -1
+      zh(1) = RAN1(idum)-.5
+      idum  = 0
+      DO ij = 2, ip1jmp1
+        zh(ij) = RAN1(idum) -.5
+      ENDDO
+
+      CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1)
+
+      CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
+
+      IF ( zhmin .GE. zhmax  )     THEN
+         PRINT*,'  Inidissip  zh min max  ',zhmin,zhmax
+         STOP'probleme generateur alleatoire dans inidissip'
+      ENDIF
+
+      zllm = ABS( zhmax )
+      DO l = 1,50
+         IF(lstardis) THEN
+            CALL divgrad2(1,zh,deltap,niterh,zh)
+         ELSE
+            CALL divgrad (1,zh,niterh,zh)
+         ENDIF
+
+        CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
+
+         zllm  = ABS( zhmax )
+         z1llm = 1./zllm
+         DO ij = 1,ip1jmp1
+            zh(ij) = zh(ij)* z1llm
+         ENDDO
+      ENDDO
+
+      IF(lstardis) THEN
+         cdivh = 1./ zllm
+      ELSE
+         cdivh = zllm ** ( -1./niterh )
+      ENDIF
+
+c   calcul des valeurs propres de gradiv (ii =1) et  nxgrarot(ii=2)
+c   -----------------------------------------------------------------
+      print*,'calcul des valeurs propres'
+
+      DO  20  ii = 1, 2
+c
+         DO ij = 1, ip1jmp1
+           zu(ij)  = RAN1(idum) -.5
+         ENDDO
+         CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1)
+         DO ij = 1, ip1jm
+            zv(ij) = RAN1(idum) -.5
+         ENDDO
+         CALL filtreg (zv,jjm,1,2,1,.FALSE.,1)
+
+         CALL minmax(iip1*jjp1,zu,umin,ullm )
+         CALL minmax(iip1*jjm, zv,vmin,vllm )
+
+         ullm = ABS ( ullm )
+         vllm = ABS ( vllm )
+
+         DO  5  l = 1, 50
+            IF(ii.EQ.1) THEN
+               IF(lstardis) THEN
+                  CALL gradiv2( 1,zu,zv,nitergdiv,zu,zv )
+               ELSE
+                  CALL gradiv ( 1,zu,zv,nitergdiv,zu,zv )
+               ENDIF
+            ELSE
+               IF(lstardis) THEN
+                  CALL nxgraro2( 1,zu,zv,nitergrot,zu,zv )
+               ELSE
+                  CALL nxgrarot( 1,zu,zv,nitergrot,zu,zv )
+               ENDIF
+            ENDIF
+
+            CALL minmax(iip1*jjp1,zu,umin,ullm )
+            CALL minmax(iip1*jjm, zv,vmin,vllm )
+
+            ullm = ABS  ( ullm )
+            vllm = ABS  ( vllm )
+
+            zllm  = MAX( ullm,vllm )
+            z1llm = 1./ zllm
+            DO ij = 1, ip1jmp1
+              zu(ij) = zu(ij)* z1llm
+            ENDDO
+            DO ij = 1, ip1jm
+               zv(ij) = zv(ij)* z1llm
+            ENDDO
+ 5       CONTINUE
+
+         IF ( ii.EQ.1 ) THEN
+            IF(lstardis) THEN
+               cdivu  = 1./zllm
+            ELSE
+               cdivu  = zllm **( -1./nitergdiv )
+            ENDIF
+         ELSE
+            IF(lstardis) THEN
+               crot   = 1./ zllm
+            ELSE
+               crot   = zllm **( -1./nitergrot )
+            ENDIF
+         ENDIF
+
+ 20   CONTINUE
+
+c   petit test pour les operateurs non star:
+c   ----------------------------------------
+
+c     IF(.NOT.lstardis) THEN
+c        fac_mid    = rad*24./float(jjm)
+c        fac_mid    = fac_mid*fac_mid
+c        PRINT*,'coef u ', fac_mid/cdivu, 1./cdivu
+c        PRINT*,'coef r ', fac_mid/crot , 1./crot
+c        PRINT*,'coef h ', fac_mid/cdivh, 1./cdivh
+c     ENDIF
+
+c-----------------------------------------------------------------------
+c   variation verticale du coefficient de dissipation:
+c   --------------------------------------------------
+
+      DO l=1,llm
+         zvert(l)=1.
+      ENDDO
+
+c
+      DO l = 1, llm
+         zz   = 1. -1./sig_s(l)
+         zvert(l)= fac_mid -( fac_mid-1.)/( 1.+zz*zz )
+
+c ---------------------------------------------------------------
+c Utilisation de la fonction tangente hyperbolique pour augmenter
+c arbitrairement la dissipation et donc la stabilite du modele a 
+c partir d'une certaine altitude.
+
+c   Le facteur multiplicatif de basse atmosphere etant deja pris 
+c   en compte, il faut diviser le facteur multiplicatif de haute 
+c   atmosphere par celui-ci.
+c   ============================================================
+
+         zvert(l)= zvert(l)*(1.0+((fac_up/fac_mid-1)
+     &   *(1-(0.5*(1+tanh(-6./delta*    
+     &   (10.*(-log(sig_s(l)))-middle)))))
+     &   ))
+      ENDDO
+ 
+c -----------------------------------------------------------------------------
+
+c
+
+      PRINT*,'Constantes de temps de la diffusion horizontale'
+
+      tetamin =  1.e+6
+
+
+      DO l=1,llm
+        tetaudiv(l)   = zvert(l)/tetagdiv
+        tetaurot(l)   = zvert(l)/tetagrot
+        tetah(l)      = zvert(l)/tetatemp
+
+        IF( tetamin.GT. (1./tetaudiv(l)) ) tetamin = 1./ tetaudiv(l)
+        IF( tetamin.GT. (1./tetaurot(l)) ) tetamin = 1./ tetaurot(l)
+        IF( tetamin.GT. (1./   tetah(l)) ) tetamin = 1./    tetah(l)
+      ENDDO
+
+c     Calcul automatique de idissip
+c     -----------------------------
+c    :::::::::::::::::::::
+c     A Commenter pour garder la valeur de run.def :
+c     idissip = INT( tetamin/( 2.*dtvr*iperiod) ) * iperiod
+c     idissip = MAX(iperiod,idissip)
+c    :::::::::::::::::::::
+      dtdiss  = idissip * dtvr
+ 
+      PRINT *,' INIDI tetamin dtvr ',tetamin,dtvr,iperiod
+      PRINT *,' INIDI tetamin idissip ',tetamin,idissip
+      PRINT *,' INIDI idissip dtdiss ',idissip,dtdiss
+
+      PRINT*,'pseudoZ(km)  zvert  dt(tetagdiv) dt(tetagrot) dt(divgrad)'
+      DO l = 1,llm
+         PRINT*,pseudoalt(l),zvert(l),dtdiss*tetaudiv(l),
+     *        dtdiss*tetaurot(l),dtdiss*tetah(l)
+         if ( (dtdiss*tetaudiv(l).gt.1.9).or.
+     &        (dtdiss*tetaurot(l).gt.1.9).or.
+     &        (dtdiss*tetah(l).gt.1.9)) then
+          PRINT *,'STOP : your dissipation is too intense for the '      
+          PRINT *,'dissipation timestep : unstable model !'
+          PRINT *,'in run.def, you must increase tetagdiv,' 
+          PRINT *,'(or tetagrot and tetatemp if they are smaller than'
+          PRINT *,'tetagdiv) OR decrease idissip OR increase day_step)' 
+          stop
+         end if
+  
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/inigeom.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/inigeom.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/inigeom.F	(revision 2744)
@@ -0,0 +1,699 @@
+c
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/inigeom.F,v 1.3 2001/04/13 15:49:10 lmdz Exp $
+c
+      SUBROUTINE inigeom
+c
+c     Auteur :  P. Le Van
+c
+c   ............      Version  du 01/04/2001     ........................
+c
+c  Calcul des elongations cuij1,.cuij4 , cvij1,..cvij4  aux memes en-
+c     endroits que les aires aireij1,..aireij4 .
+
+c  Choix entre f(y) a derivee sinusoid. ou a derivee tangente hyperbol.
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom2.h"
+#include "serre.h"
+#include "logic.h"
+#include "comdissnew.h"
+
+c-----------------------------------------------------------------------
+c   ....  Variables  locales   ....
+c
+      INTEGER  i,j,itmax,itmay,iter
+      REAL cvu(iip1,jjp1),cuv(iip1,jjm)
+      REAL ai14,ai23,airez,rlatp,rlatm,xprm,xprp,un4rad2,yprp,yprm
+      REAL eps,x1,xo1,f,df,xdm,y1,yo1,ydm
+      REAL coslatm,coslatp,radclatm,radclatp
+      REAL cuij1(iip1,jjp1),cuij2(iip1,jjp1),cuij3(iip1,jjp1),
+     *     cuij4(iip1,jjp1)
+      REAL cvij1(iip1,jjp1),cvij2(iip1,jjp1),cvij3(iip1,jjp1),
+     *     cvij4(iip1,jjp1)
+      REAL rlonvv(iip1),rlatuu(jjp1)
+      REAL rlatu1(jjm),yprimu1(jjm),rlatu2(jjm),yprimu2(jjm) ,
+     *     yprimv(jjm),yprimu(jjp1)
+      REAL gamdi_gdiv, gamdi_grot, gamdi_h
+ 
+      REAL rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),
+     ,  xprimp025(iip1)
+      SAVE rlatu1,yprimu1,rlatu2,yprimu2,yprimv,yprimu
+      SAVE rlonm025,xprimm025,rlonp025,xprimp025
+
+      REAL      SSUM
+      EXTERNAL  SSUM
+c
+c
+c   ------------------------------------------------------------------
+c   -                                                                -
+c   -    calcul des coeff. ( cu, cv , 1./cu**2,  1./cv**2  )         -
+c   -                                                                -
+c   ------------------------------------------------------------------
+c
+c      les coef. ( cu, cv ) permettent de passer des vitesses naturelles
+c      aux vitesses covariantes et contravariantes , ou vice-versa ...
+c
+c
+c     on a :  u (covariant) = cu * u (naturel)   , u(contrav)= u(nat)/cu
+c             v (covariant) = cv * v (naturel)   , v(contrav)= v(nat)/cv
+c
+c       on en tire :  u(covariant) = cu * cu * u(contravariant)
+c                     v(covariant) = cv * cv * v(contravariant)
+c
+c
+c     on a l'application (  x(X) , y(Y) )   avec - im/2 +1 <  X  < im/2
+c                                                          =     =
+c                                           et   - jm/2    <  Y  < jm/2
+c                                                          =     =
+c
+c      ...................................................
+c      ...................................................
+c      .  x  est la longitude du point  en radians       .
+c      .  y  est la  latitude du point  en radians       .
+c      .                                                 .
+c      .  on a :  cu(i,j) = rad * COS(y) * dx/dX         .
+c      .          cv( j ) = rad          * dy/dY         .
+c      .        aire(i,j) =  cu(i,j) * cv(j)             .
+c      .                                                 .
+c      . y, dx/dX, dy/dY calcules aux points concernes   .
+c      .                                                 .
+c      ...................................................
+c      ...................................................
+c
+c
+c
+c                                                           ,
+c    cv , bien que dependant de j uniquement,sera ici indice aussi en i
+c          pour un adressage plus facile en  ij  .
+c
+c
+c
+c  **************  aux points  u  et  v ,           *****************
+c      xprimu et xprimv sont respectivement les valeurs de  dx/dX
+c      yprimu et yprimv    .  .  .  .  .  .  .  .  .  .  .  dy/dY
+c      rlatu  et  rlatv    .  .  .  .  .  .  .  .  .  .  .la latitude
+c      cvu    et   cv      .  .  .  .  .  .  .  .  .  .  .    cv
+c
+c  **************  aux points u, v, scalaires, et z  ****************
+c      cu, cuv, cuscal, cuz sont respectiv. les valeurs de    cu
+c
+c
+c
+c         Exemple de distribution de variables sur la grille dans le
+c             domaine de travail ( X,Y ) .
+c     ................................................................
+c                  DX=DY= 1
+c
+c   
+c        +     represente  un  point scalaire ( p.exp  la pression )
+c        >     represente  la composante zonale du  vent
+c        V     represente  la composante meridienne du vent
+c        o     represente  la  vorticite
+c
+c       ----  , car aux poles , les comp.zonales covariantes sont nulles
+c
+c
+c
+c         i ->
+c
+c         1      2      3      4      5      6      7      8
+c  j
+c  v  1   + ---- + ---- + ---- + ---- + ---- + ---- + ---- + --
+c
+c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
+c
+c     2   +   >  +   >  +   >  +   >  +   >  +   >  +   >  +  >
+c
+c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
+c
+c     3   +   >  +   >  +   >  +   >  +   >  +   >  +   >  +  >
+c
+c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
+c
+c     4   +   >  +   >  +   >  +   >  +   >  +   >  +   >  +  >
+c
+c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
+c
+c     5   + ---- + ---- + ---- + ---- + ---- + ---- + ---- + --
+c
+c
+c      Ci-dessus,  on voit que le nombre de pts.en longitude est egal
+c                 a   IM = 8
+c      De meme ,   le nombre d'intervalles entre les 2 poles est egal
+c                 a   JM = 4
+c
+c      Les points scalaires ( + ) correspondent donc a des valeurs
+c       entieres  de  i ( 1 a IM )   et  de  j ( 1 a  JM +1 )   .
+c
+c      Les vents    U       ( > ) correspondent a des valeurs  semi-
+c       entieres  de i ( 1+ 0.5 a IM+ 0.5) et entieres de j ( 1 a JM+1)
+c
+c      Les vents    V       ( V ) correspondent a des valeurs entieres
+c       de     i ( 1 a  IM ) et semi-entieres de  j ( 1 +0.5  a JM +0.5)
+c
+c
+c
+      WRITE(6,3) 
+ 3    FORMAT( // 10x,' ....  INIGEOM  date du 01/06/98   ..... ',
+     * //5x,'   Calcul des elongations cu et cv  comme sommes des 4 ' /
+     *  5x,' elong. cuij1, .. 4  , cvij1,.. 4  qui les entourent , aux 
+     * '/ 5x,' memes endroits que les aires aireij1,...j4   . ' / )
+c
+c
+      IF( nitergdiv.NE.2 ) THEN
+        gamdi_gdiv = coefdis/ ( float(nitergdiv) -2. )
+      ELSE
+        gamdi_gdiv = 0.
+      ENDIF
+      IF( nitergrot.NE.2 ) THEN
+        gamdi_grot = coefdis/ ( float(nitergrot) -2. )
+      ELSE
+        gamdi_grot = 0.
+      ENDIF
+      IF( niterh.NE.2 ) THEN
+        gamdi_h = coefdis/ ( float(niterh) -2. )
+      ELSE
+        gamdi_h = 0.
+      ENDIF
+
+      WRITE(6,*) ' gamdi_gd ',gamdi_gdiv,gamdi_grot,gamdi_h,coefdis,
+     *  nitergdiv,nitergrot,niterh
+c
+      pi    = 2.* ASIN(1.)
+c
+      WRITE(6,990) 
+
+c     ----------------------------------------------------------------
+c
+      IF( .NOT.fxyhypb )   THEN
+c
+c
+       IF( ysinus )  THEN
+c
+        WRITE(6,*) ' ***  Inigeom ,  Y = Sinus ( Latitude ) *** '
+c
+c   .... utilisation de f(x,y )  avec  y  =  sinus de la latitude  .....
+
+        CALL  fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
+     ,                    rlatu2,yprimu2,
+     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+       ELSE
+c
+        WRITE(6,*) '*** Inigeom ,  Y = Latitude  , der. sinusoid . ***'
+
+c  .... utilisation  de f(x,y) a tangente sinusoidale , y etant la latit. ...
+c
+ 
+        pxo   = clon *pi /180.
+        pyo   = 2.* clat* pi /180.
+c
+c  ....  determination de  transx ( pour le zoom ) par Newton-Raphson ...
+c
+        itmax = 10
+        eps   = .1e-7
+c
+        xo1 = 0.
+        DO 10 iter = 1, itmax
+        x1  = xo1
+        f   = x1+ alphax *SIN(x1-pxo)
+        df  = 1.+ alphax *COS(x1-pxo)
+        x1  = x1 - f/df
+        xdm = ABS( x1- xo1 )
+        IF( xdm.LE.eps )GO TO 11
+        xo1 = x1
+ 10     CONTINUE
+ 11     CONTINUE
+c
+        transx = xo1
+
+        itmay = 10
+        eps   = .1e-7
+C
+        yo1  = 0.
+        DO 15 iter = 1,itmay
+        y1   = yo1
+        f    = y1 + alphay* SIN(y1-pyo)
+        df   = 1. + alphay* COS(y1-pyo)
+        y1   = y1 -f/df
+        ydm  = ABS(y1-yo1)
+        IF(ydm.LE.eps) GO TO 17
+        yo1  = y1
+ 15     CONTINUE
+c
+ 17     CONTINUE
+        transy = yo1
+
+        CALL fxy ( rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
+     ,              rlatu2,yprimu2,
+     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+       ENDIF
+c
+      ELSE
+c
+c   ....  Utilisation  de fxyhyper , f(x,y) a derivee tangente hyperbol.
+c   .....................................................................
+
+      WRITE(6,*)'*** Inigeom , Y = Latitude  , der.tg. hyperbolique ***'
+ 
+       CALL fxyhyper( clat, grossismy, dzoomy, tauy    , 
+     ,                clon, grossismx, dzoomx, taux    ,
+     , rlatu,yprimu,rlatv, yprimv,rlatu1, yprimu1,rlatu2,yprimu2  ,
+     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025 )
+
+  
+      ENDIF
+c
+c  -------------------------------------------------------------------
+
+c
+      rlatu(1)    =     ASIN(1.)
+      rlatu(jjp1) =  - rlatu(1)
+c
+c
+c   ....  calcul  aux  poles  ....
+c
+      yprimu(1)      = 0.
+      yprimu(jjp1)   = 0.
+c
+c
+      un4rad2 = 0.25 * rad * rad
+c
+c   --------------------------------------------------------------------
+c   --------------------------------------------------------------------
+c   -                                                                  -
+c   -  calcul  des aires ( aire,aireu,airev, 1./aire, 1./airez  )      -
+c   -      et de   fext ,  force de coriolis  extensive  .             -
+c   -                                                                  -
+c   --------------------------------------------------------------------
+c   --------------------------------------------------------------------
+c
+c
+c
+c   A 1 point scalaire P (i,j) de la grille, reguliere en (X,Y) , sont
+c   affectees 4 aires entourant P , calculees respectivement aux points
+c            ( i + 1/4, j - 1/4 )    :    aireij1 (i,j)
+c            ( i + 1/4, j + 1/4 )    :    aireij2 (i,j)
+c            ( i - 1/4, j + 1/4 )    :    aireij3 (i,j)
+c            ( i - 1/4, j - 1/4 )    :    aireij4 (i,j)
+c
+c           ,
+c   Les cotes de chacun de ces 4 carres etant egaux a 1/2 suivant (X,Y).
+c   Chaque aire centree en 1 point scalaire P(i,j) est egale a la somme
+c   des 4 aires  aireij1,aireij2,aireij3,aireij4 qui sont affectees au
+c   point (i,j) .
+c   On definit en outre les coefficients  alpha comme etant egaux a
+c    (aireij / aire), c.a.d par exp.  alpha1(i,j)=aireij1(i,j)/aire(i,j)
+c
+c   De meme, toute aire centree en 1 point U est egale a la somme des
+c   4 aires aireij1,aireij2,aireij3,aireij4 entourant le point U .
+c    Idem pour  airev, airez .
+c
+c       On a ,pour chaque maille :    dX = dY = 1
+c
+c
+c                             . V
+c
+c                 aireij4 .        . aireij1
+c
+c                   U .       . P      . U
+c
+c                 aireij3 .        . aireij2
+c
+c                             . V
+c
+c
+c
+c
+c
+c   ....................................................................
+c
+c    Calcul des 4 aires elementaires aireij1,aireij2,aireij3,aireij4
+c   qui entourent chaque aire(i,j) , ainsi que les 4 elongations elemen
+c   taires cuij et les 4 elongat. cvij qui sont calculees aux memes 
+c     endroits  que les aireij   .    
+c
+c   ....................................................................
+c
+c     .......  do 35  :   boucle sur les  jjm + 1  latitudes   .....
+c
+c
+      DO 35 j = 1, jjp1
+c
+      IF ( j. eq. 1 )  THEN
+c
+      yprm           = yprimu1(j)
+      rlatm          = rlatu1(j)
+c
+      coslatm        = COS( rlatm )
+      radclatm       = 0.5* rad * coslatm
+c
+      DO 30 i = 1, iim
+      xprp           = xprimp025( i )
+      xprm           = xprimm025( i )
+
+      aireij2( i,1 ) = un4rad2 * coslatm  * xprp * yprm
+      aireij3( i,1 ) = un4rad2 * coslatm  * xprm * yprm
+      cuij2  ( i,1 ) = radclatm * xprp
+      cuij3  ( i,1 ) = radclatm * xprm
+      cvij2  ( i,1 ) = 0.5* rad * yprm
+      cvij3  ( i,1 ) = cvij2(i,1)
+  30  CONTINUE
+c
+      DO  i = 1, iim
+      aireij1( i,1 ) = 0.
+      aireij4( i,1 ) = 0.
+      cuij1  ( i,1 ) = 0.
+      cuij4  ( i,1 ) = 0.
+      cvij1  ( i,1 ) = 0.
+      cvij4  ( i,1 ) = 0.
+      ENDDO
+c
+      END IF
+c
+      IF ( j. eq. jjp1 )  THEN
+       yprp               = yprimu2(j-1)
+       rlatp              = rlatu2 (j-1)
+ccc       yprp             = fyprim( FLOAT(j) - 0.25 )
+ccc       rlatp            = fy    ( FLOAT(j) - 0.25 )
+c
+      coslatp             = COS( rlatp )
+      radclatp            = 0.5* rad * coslatp
+c
+      DO 31 i = 1,iim
+        xprp              = xprimp025( i )
+        xprm              = xprimm025( i )
+        aireij1( i,jjp1 ) = un4rad2 * coslatp  * xprp * yprp
+        aireij4( i,jjp1 ) = un4rad2 * coslatp  * xprm * yprp
+        cuij1(i,jjp1)     = radclatp * xprp
+        cuij4(i,jjp1)     = radclatp * xprm
+        cvij1(i,jjp1)     = 0.5 * rad* yprp
+        cvij4(i,jjp1)     = cvij1(i,jjp1)
+ 31   CONTINUE
+c
+       DO   i    = 1, iim
+        aireij2( i,jjp1 ) = 0.
+        aireij3( i,jjp1 ) = 0.
+        cvij2  ( i,jjp1 ) = 0.
+        cvij3  ( i,jjp1 ) = 0.
+        cuij2  ( i,jjp1 ) = 0.
+        cuij3  ( i,jjp1 ) = 0.
+       ENDDO
+c
+      END IF
+c
+
+      IF ( j .gt. 1 .AND. j .lt. jjp1 )  THEN
+c
+        rlatp    = rlatu2 ( j-1 )
+        yprp     = yprimu2( j-1 )
+        rlatm    = rlatu1 (  j  )
+        yprm     = yprimu1(  j  )
+cc         rlatp    = fy    ( FLOAT(j) - 0.25 )
+cc         yprp     = fyprim( FLOAT(j) - 0.25 )
+cc         rlatm    = fy    ( FLOAT(j) + 0.25 )
+cc         yprm     = fyprim( FLOAT(j) + 0.25 )
+
+         coslatm  = COS( rlatm )
+         coslatp  = COS( rlatp )
+         radclatp = 0.5* rad * coslatp
+         radclatm = 0.5* rad * coslatm
+c
+         DO 32 i = 1,iim
+         xprp            = xprimp025( i )
+         xprm            = xprimm025( i )
+      
+         ai14            = un4rad2 * coslatp * yprp
+         ai23            = un4rad2 * coslatm * yprm
+         aireij1 ( i,j ) = ai14 * xprp
+         aireij2 ( i,j ) = ai23 * xprp
+         aireij3 ( i,j ) = ai23 * xprm
+         aireij4 ( i,j ) = ai14 * xprm
+         cuij1   ( i,j ) = radclatp * xprp
+         cuij2   ( i,j ) = radclatm * xprp
+         cuij3   ( i,j ) = radclatm * xprm
+         cuij4   ( i,j ) = radclatp * xprm
+         cvij1   ( i,j ) = 0.5* rad * yprp
+         cvij2   ( i,j ) = 0.5* rad * yprm
+         cvij3   ( i,j ) = cvij2(i,j)
+         cvij4   ( i,j ) = cvij1(i,j)
+  32     CONTINUE
+c
+      END IF
+c
+c    ........       periodicite   ............
+c
+         cvij1   (iip1,j) = cvij1   (1,j)
+         cvij2   (iip1,j) = cvij2   (1,j)
+         cvij3   (iip1,j) = cvij3   (1,j)
+         cvij4   (iip1,j) = cvij4   (1,j)
+         cuij1   (iip1,j) = cuij1   (1,j)
+         cuij2   (iip1,j) = cuij2   (1,j)
+         cuij3   (iip1,j) = cuij3   (1,j)
+         cuij4   (iip1,j) = cuij4   (1,j)
+         aireij1 (iip1,j) = aireij1 (1,j )
+         aireij2 (iip1,j) = aireij2 (1,j )
+         aireij3 (iip1,j) = aireij3 (1,j )
+         aireij4 (iip1,j) = aireij4 (1,j )
+        
+  35  CONTINUE
+c
+c    ..............................................................
+c
+      DO 37 j = 1, jjp1
+      DO 36 i = 1, iim
+      aire    ( i,j )  = aireij1(i,j) + aireij2(i,j) + aireij3(i,j) +
+     *                          aireij4(i,j)
+      alpha1  ( i,j )  = aireij1(i,j) / aire(i,j)
+      alpha2  ( i,j )  = aireij2(i,j) / aire(i,j)
+      alpha3  ( i,j )  = aireij3(i,j) / aire(i,j)
+      alpha4  ( i,j )  = aireij4(i,j) / aire(i,j)
+      alpha1p2( i,j )  = alpha1 (i,j) + alpha2 (i,j)
+      alpha1p4( i,j )  = alpha1 (i,j) + alpha4 (i,j)
+      alpha2p3( i,j )  = alpha2 (i,j) + alpha3 (i,j)
+      alpha3p4( i,j )  = alpha3 (i,j) + alpha4 (i,j)
+  36  CONTINUE
+c
+c
+      aire    (iip1,j) = aire    (1,j)
+      alpha1  (iip1,j) = alpha1  (1,j)
+      alpha2  (iip1,j) = alpha2  (1,j)
+      alpha3  (iip1,j) = alpha3  (1,j)
+      alpha4  (iip1,j) = alpha4  (1,j)
+      alpha1p2(iip1,j) = alpha1p2(1,j)
+      alpha1p4(iip1,j) = alpha1p4(1,j)
+      alpha2p3(iip1,j) = alpha2p3(1,j)
+      alpha3p4(iip1,j) = alpha3p4(1,j)
+  37  CONTINUE
+c
+
+      DO 42 j = 1,jjp1
+      DO 41 i = 1,iim
+      aireu       (i,j)= aireij1(i,j) + aireij2(i,j) + aireij4(i+1,j) +
+     *                                aireij3(i+1,j)
+      unsaire    ( i,j)= 1./ aire(i,j)
+      unsair_gam1( i,j)= unsaire(i,j)** ( - gamdi_gdiv )
+      unsair_gam2( i,j)= unsaire(i,j)** ( - gamdi_h    )
+      airesurg   ( i,j)= aire(i,j)/ g
+  41  CONTINUE
+      aireu     (iip1,j)  = aireu  (1,j)
+      unsaire   (iip1,j)  = unsaire(1,j)
+      unsair_gam1(iip1,j) = unsair_gam1(1,j)
+      unsair_gam2(iip1,j) = unsair_gam2(1,j)
+      airesurg   (iip1,j) = airesurg(1,j)
+  42  CONTINUE
+c
+c
+      DO 48 j = 1,jjm
+c
+        DO i=1,iim
+         airev     (i,j) = aireij2(i,j)+ aireij3(i,j)+ aireij1(i,j+1) +
+     *                           aireij4(i,j+1)
+        ENDDO
+         DO i=1,iim
+          airez         = aireij2(i,j)+aireij1(i,j+1)+aireij3(i+1,j) +
+     *                           aireij4(i+1,j+1)
+          unsairez(i,j) = 1./ airez
+          unsairz_gam(i,j)= unsairez(i,j)** ( - gamdi_grot )
+          fext    (i,j)   = airez * SIN(rlatv(j))* 2.* omeg
+         ENDDO
+        airev     (iip1,j)  = airev(1,j)
+        unsairez  (iip1,j)  = unsairez(1,j)
+        fext      (iip1,j)  = fext(1,j)
+        unsairz_gam(iip1,j) = unsairz_gam(1,j)
+c
+  48  CONTINUE
+c
+c
+c    .....      Calcul  des elongations cu,cv, cvu     .........
+c
+      DO    j   = 1, jjm
+       DO   i  = 1, iim
+       cv(i,j) = 0.5 *( cvij2(i,j)+cvij3(i,j)+cvij1(i,j+1)+cvij4(i,j+1))
+       cvu(i,j)= 0.5 *( cvij1(i,j)+cvij4(i,j)+cvij2(i,j)  +cvij3(i,j) )
+       cuv(i,j)= 0.5 *( cuij2(i,j)+cuij3(i,j)+cuij1(i,j+1)+cuij4(i,j+1))
+       unscv2(i,j) = 1./ ( cv(i,j)*cv(i,j) )
+       ENDDO
+       DO   i  = 1, iim
+       cuvsurcv (i,j)    = airev(i,j)  * unscv2(i,j)
+       cvsurcuv (i,j)    = 1./cuvsurcv(i,j)
+       cuvscvgam1(i,j)   = cuvsurcv (i,j) ** ( - gamdi_gdiv )
+       cuvscvgam2(i,j)   = cuvsurcv (i,j) ** ( - gamdi_h )
+       cvscuvgam(i,j)    = cvsurcuv (i,j) ** ( - gamdi_grot )
+       ENDDO
+       cv       (iip1,j)  = cv       (1,j)
+       cvu      (iip1,j)  = cvu      (1,j)
+       unscv2   (iip1,j)  = unscv2   (1,j)
+       cuv      (iip1,j)  = cuv      (1,j)
+       cuvsurcv (iip1,j)  = cuvsurcv (1,j)
+       cvsurcuv (iip1,j)  = cvsurcuv (1,j)
+       cuvscvgam1(iip1,j) = cuvscvgam1(1,j)
+       cuvscvgam2(iip1,j) = cuvscvgam2(1,j)
+       cvscuvgam(iip1,j)  = cvscuvgam(1,j)
+      ENDDO
+
+      DO  j     = 2, jjm
+        DO   i  = 1, iim
+        cu(i,j) = 0.5*(cuij1(i,j)+cuij4(i+1,j)+cuij2(i,j)+cuij3(i+1,j))
+        unscu2    (i,j)  = 1./ ( cu(i,j) * cu(i,j) )
+        cvusurcu  (i,j)  =  aireu(i,j) * unscu2(i,j)
+        cusurcvu  (i,j)  = 1./ cvusurcu(i,j)
+        cvuscugam1 (i,j) = cvusurcu(i,j) ** ( - gamdi_gdiv ) 
+        cvuscugam2 (i,j) = cvusurcu(i,j) ** ( - gamdi_h    ) 
+        cuscvugam (i,j)  = cusurcvu(i,j) ** ( - gamdi_grot )
+        ENDDO
+        cu       (iip1,j)  = cu(1,j)
+        unscu2   (iip1,j)  = unscu2(1,j)
+        cvusurcu (iip1,j)  = cvusurcu(1,j)
+        cusurcvu (iip1,j)  = cusurcvu(1,j)
+        cvuscugam1(iip1,j) = cvuscugam1(1,j)
+        cvuscugam2(iip1,j) = cvuscugam2(1,j)
+        cuscvugam (iip1,j) = cuscvugam(1,j)
+      ENDDO
+
+c
+c   ....  calcul aux  poles  ....
+c
+      DO    i      =  1, iip1
+        cu    ( i, 1 )  =   0.
+        unscu2( i, 1 )  =   0.
+        cvu   ( i, 1 )  =   0.
+c
+        cu    (i, jjp1) =   0.
+        unscu2(i, jjp1) =   0.
+        cvu   (i, jjp1) =   0.
+      ENDDO
+c
+c    ..............................................................
+c
+      DO j = 1, jjm
+        DO i= 1, iim
+         airvscu2  (i,j) = airev(i,j)/ ( cuv(i,j) * cuv(i,j) )
+         aivscu2gam(i,j) = airvscu2(i,j)** ( - gamdi_grot )
+        ENDDO
+         airvscu2  (iip1,j)  = airvscu2(1,j)
+         aivscu2gam(iip1,j)  = aivscu2gam(1,j)
+      ENDDO
+
+      DO j=2,jjm
+        DO i=1,iim
+         airuscv2   (i,j)    = aireu(i,j)/ ( cvu(i,j) * cvu(i,j) )
+         aiuscv2gam (i,j)    = airuscv2(i,j)** ( - gamdi_grot ) 
+        ENDDO
+         airuscv2  (iip1,j)  = airuscv2  (1,j)
+         aiuscv2gam(iip1,j)  = aiuscv2gam(1,j)
+      ENDDO
+
+c
+c   calcul des aires aux  poles :
+c   -----------------------------
+c
+      apoln       = SSUM(iim,aire(1,1),1)
+      apols       = SSUM(iim,aire(1,jjp1),1)
+      unsapolnga1 = 1./ ( apoln ** ( - gamdi_gdiv ) )
+      unsapolsga1 = 1./ ( apols ** ( - gamdi_gdiv ) )
+      unsapolnga2 = 1./ ( apoln ** ( - gamdi_h    ) )
+      unsapolsga2 = 1./ ( apols ** ( - gamdi_h    ) )
+c
+c-----------------------------------------------------------------------
+c     gtitre='Coriolis version ancienne'
+c     gfichier='fext1'
+c     CALL writestd(fext,iip1*jjm)
+c
+c   changement F. Hourdin calcul conservatif pour fext
+c   constang contient le produit a * cos ( latitude ) * omega
+c
+      DO i=1,iim
+         constang(i,1) = 0.
+      ENDDO
+      DO j=1,jjm-1
+        DO i=1,iim
+         constang(i,j+1) = rad*omeg*cu(i,j+1)*COS(rlatu(j+1))
+        ENDDO
+      ENDDO
+      DO i=1,iim
+         constang(i,jjp1) = 0.
+      ENDDO
+c
+c   periodicite en longitude
+c
+      DO j=1,jjm
+        fext(iip1,j)     = fext(1,j)
+      ENDDO
+      DO j=1,jjp1
+        constang(iip1,j) = constang(1,j)
+      ENDDO
+
+c fin du changement
+
+c
+c-----------------------------------------------------------------------
+c
+       WRITE(6,*) '   ***  Coordonnees de la grille  *** '
+       WRITE(6,995)
+c
+       WRITE(6,*) '   LONGITUDES  aux pts.   V  ( degres )  '
+       WRITE(6,995)
+        DO i=1,iip1
+         rlonvv(i) = rlonv(i)*180./pi
+        ENDDO
+       WRITE(6,400) rlonvv
+c
+       WRITE(6,995)
+       WRITE(6,*) '   LATITUDES   aux pts.   V  ( degres )  '
+       WRITE(6,995)
+        DO i=1,jjm
+         rlatuu(i)=rlatv(i)*180./pi
+        ENDDO
+       WRITE(6,400) (rlatuu(i),i=1,jjm)
+c
+        DO i=1,iip1
+          rlonvv(i)=rlonu(i)*180./pi
+        ENDDO
+       WRITE(6,995)
+       WRITE(6,*) '   LONGITUDES  aux pts.   U  ( degres )  '
+       WRITE(6,995)
+       WRITE(6,400) rlonvv
+       WRITE(6,995)
+
+       WRITE(6,*) '   LATITUDES   aux pts.   U  ( degres )  '
+       WRITE(6,995)
+        DO i=1,jjp1
+         rlatuu(i)=rlatu(i)*180./pi
+        ENDDO
+       WRITE(6,400) (rlatuu(i),i=1,jjp1)
+       WRITE(6,995)
+c
+444    format(f10.3,f6.0)
+400    FORMAT(1x,8f8.2)
+990    FORMAT(//)
+995    FORMAT(/)
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/inigrads.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/inigrads.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/inigrads.F	(revision 2744)
@@ -0,0 +1,77 @@
+      subroutine inigrads(if,im
+     s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
+     s  ,dt,file,titlel)
+
+
+      implicit none
+
+      integer if,im,jm,lm,i,j,l,lnblnk
+      real x(im),y(jm),z(lm),fx,fy,fz,dt
+      real xmin,xmax,ymin,ymax
+
+      character file*10,titlel*40
+
+#include "gradsdef.h"
+
+      data unit/66,32,34,36,38,40,42,44,46,48/
+      data nf/0/
+
+      if (if.le.nf) stop'verifier les appels a inigrads'
+
+      print*,'Entree dans inigrads'
+
+      nf=if
+      title(if)=titlel
+      ivar(if)=0
+
+      fichier(if)=file(1:lnblnk(file))
+
+      firsttime(if)=.true.
+      dtime(if)=dt
+
+      iid(if)=1
+      ifd(if)=im
+      imd(if)=im
+      do i=1,im
+         xd(i,if)=x(i)*fx
+         if(xd(i,if).lt.xmin) iid(if)=i+1
+         if(xd(i,if).le.xmax) ifd(if)=i
+      enddo
+      print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'
+
+      jid(if)=1
+      jfd(if)=jm
+      jmd(if)=jm
+      do j=1,jm
+         yd(j,if)=y(j)*fy
+         if(yd(j,if).gt.ymax) jid(if)=j+1
+         if(yd(j,if).ge.ymin) jfd(if)=j
+      enddo
+      print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'
+
+      print*,'Open de dat'
+      print*,'file=',file
+      print*,'fichier(if)=',fichier(if)
+
+      print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
+      print*,file(1:lnblnk(file))//'.dat'
+
+      OPEN (unit(if)+1,FILE=file(1:lnblnk(file))//'.dat',
+     s   FORM='UNFORMATTED',
+     s   ACCESS='DIRECT'
+     s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))
+
+      print*,'Open de dat ok'
+
+      lmd(if)=lm
+      do l=1,lm
+         zd(l,if)=z(l)*fz
+      enddo
+
+      irec(if)=0
+
+      print*,if,imd(if),jmd(if),lmd(if)
+      print*,'if,imd(if),jmd(if),lmd(if)'
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniinterp_h.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniinterp_h.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniinterp_h.F	(revision 2744)
@@ -0,0 +1,238 @@
+      subroutine iniinterp_h (imo,jmo,imn,jmn ,kmax,
+     &       rlonuo,rlatvo,rlonun,rlatvn,
+     &       ktotal,iik,jjk,jk,ik,intersec,airen)
+   
+      implicit none
+
+
+
+c ---------------------------------------------------------
+c Prepare l' interpolation des variables d'une grille LMDZ
+c  dans une autre grille LMDZ en conservant la quantite
+c  totale pour les variables intensives (/m2) : ex : Pression au sol
+c
+c   (Pour chaque case autour d'un point scalaire de la nouvelle
+c    grille, on calcule la surface (en m2)en intersection avec chaque
+c    case de l'ancienne grille , pour la future interpolation)
+c
+c on calcule aussi l' aire dans la nouvelle grille 
+c
+c
+c   Auteur:  F.Forget 01/1995
+c   -------
+c
+c ---------------------------------------------------------
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+c INPUT
+       integer imo, jmo ! dimensions ancienne grille
+       integer imn,jmn  ! dimensions nouvelle grille
+       integer kmax ! taille du tableau des intersections
+       real rlonuo(imo+1)     !  Latitude et
+       real rlatvo(jmo)       !  longitude des
+       real rlonun(imn+1)     !  bord des
+       real rlatvn(jmn)     !  cases "scalaires" (input)
+
+c OUTPUT
+       integer ktotal ! nombre totale d''intersections reperees
+       integer iik(kmax), jjk(kmax),jk(kmax),ik(kmax)
+       real intersec(kmax)  ! surface des intersections (m2)
+       real airen (imn+1,jmn+1) ! aire dans la nouvelle grille
+
+
+       
+ 
+c Autres variables
+c """"""""""""""""
+       integer i,j,ii,jj
+       integer imomx,jmomx,imnmx1,jmnmx1
+       parameter (imomx=361,jmomx=180,imnmx1=190,jmnmx1=100)
+       real a(imomx+1),b(imomx+1),c(jmomx+1),d(jmomx+1)
+       real an(imnmx1+1),bn(imnmx1+1)
+       real cn(jmnmx1+1),dn(jmnmx1+1)
+       real aa, bb,cc,dd
+       real pi
+
+       pi      = 2.*ASIN( 1. )
+
+c Test dimensions imnmx1 jmnmx1
+c""""""""""""""""""""""""""""""
+c test dimensionnement tableau airetest
+      if (imn.GT.imnmx1.OR.jmn.GT.jmnmx1) then
+        write(*,*) 'STOP pb dimensionnement'
+        write(*,*) 'il faut imn < imnmx1 et jmn < jmnmx1'
+        write(*,*) 'imn imnmx1', imn,imnmx1
+        write(*,*) 'jmn jmnmx1', jmn,jmnmx1
+        call exit(1)
+      endif
+
+      if (imo.GT.imomx.OR.jmo.GT.jmomx) then
+        write(*,*) 'STOP pb dimensionnement'
+        write(*,*) 'il faut imo < imomx et jmo < jmomx'
+        write(*,*) 'imo imomx', imo,imomx
+        write(*,*) 'jmo jmomx', jmo,jmomx
+        call exit(1)
+      endif
+
+c On repere les frontieres des cases :
+c =================================== 
+c
+c Attention, on ruse avec des latitudes = 90 deg au pole.
+
+
+c  Ancienne grile
+c  """"""""""""""
+      a(1) =   - rlonuo(imo+1)
+      b(1) = rlonuo(1)
+      do i=2,imo+1
+         a(i) = rlonuo(i-1)
+         b(i) =  rlonuo(i)
+      end do
+
+      d(1) = pi/2 
+      do j=1,jmo
+         c(j) = rlatvo(j) 
+         d(j+1) = rlatvo(j)
+      end do
+      c(jmo+1) = -pi/2 
+      
+
+c  Nouvelle grille
+c  """""""""""""""
+      an(1) =  - rlonun(imn+1)
+      bn(1) = rlonun(1)
+      do i=2,imn+1
+         an(i) = rlonun(i-1)
+         bn(i) =  rlonun(i)
+      end do
+
+      dn(1) = pi/2 
+      do j=1,jmn
+         cn(j) = rlatvn(j)
+         dn(j+1) = rlatvn(j)
+      end do
+      cn(jmn+1) = -pi/2 
+
+c Calcul de la surface des cases scalaires de la nouvelle grille
+c ==============================================================
+      do ii=1,imn + 1
+        do jj = 1,jmn+1
+           airen(ii,jj) = (bn(ii)-an(ii))*(sin(dn(jj))-sin(cn(jj)))
+        end do
+      end do
+
+c Calcul de la surface des intersections
+c ======================================
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c test dimenssion kmax (calcul de ktotal)
+c"""""""""""""""""""""""""""""""""""""""
+c Calcul de ktotal, mais ralonge beaucoup en temps => pour debug
+      write(*,*) 
+      write(*,*) 'DEBUT DU TEST KMAX'
+      ktotal = 0
+      do jj = 1,jmn+1
+       do j=1, jmo+1
+          if((cn(jj).lt.d(j)).and.(dn(jj).gt.c(j)))then
+              do ii=1,imn + 1
+                do i=1, imo +1
+                    if (  ((an(ii).lt.b(i)).and.(bn(ii).gt.a(i)))
+     &        .or. ((an(ii).lt.b(i)-2*pi).and.(bn(ii).gt.a(i)-2*pi)
+     &             .and.(b(i)-2*pi.lt.-pi) )
+     &        .or. ((an(ii).lt.b(i)+2*pi).and.(bn(ii).gt.a(i)+2*pi)
+     &             .and.(a(i)+2*pi.gt.pi) )
+     &                     )then
+                      ktotal = ktotal +1
+                     end if
+                enddo
+              enddo
+           end if
+        enddo
+      enddo
+
+      if (kmax.LT.ktotal) then
+         write(*,*)
+         write(*,*) '******** ATTENTION ********' 
+         write(*,*) 'kmax =',kmax 
+         write(*,*) 'ktotal =',ktotal 
+         write(*,*) 'Changer la valeur de kmax dans interp_horiz.F ' 
+         write(*,*) 'avec kmax >= ktotal' 
+         write(*,*) 'EXIT dans iniinterp_h'
+         call exit(1)
+      else
+         write(*,*) 'kmax =',kmax 
+         write(*,*) 'ktotal =',ktotal
+      end if
+      write(*,*) 'FIN DU TEST KMAX'
+      write(*,*) 
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c     boucle sur la nouvelle grille
+c     """"""""""""""""""""""""""""
+      ktotal = 0
+      do jj = 1,jmn+1
+       do j=1, jmo+1
+          if((cn(jj).lt.d(j)).and.(dn(jj).gt.c(j)))then
+              do ii=1,imn + 1
+                do i=1, imo +1
+                    if (  ((an(ii).lt.b(i)).and.(bn(ii).gt.a(i)))
+     &        .or. ((an(ii).lt.b(i)-2*pi).and.(bn(ii).gt.a(i)-2*pi)
+     &             .and.(b(i)-2*pi.lt.-pi) )
+     &        .or. ((an(ii).lt.b(i)+2*pi).and.(bn(ii).gt.a(i)+2*pi)
+     &             .and.(a(i)+2*pi.gt.pi) )
+     &                     )then
+                      ktotal = ktotal +1
+                      iik(ktotal) =ii
+                      jjk(ktotal) =jj
+                      ik(ktotal) =i
+                      jk(ktotal) =j
+
+                      dd = min(d(j), dn(jj))
+                      cc = cn(jj)
+                      if (cc.lt. c(j))cc=c(j)
+                      if((an(ii).lt.b(i)-2*pi).and.
+     &                  (bn(ii).gt.a(i)-2*pi)) then 
+                          bb = min(b(i)-2*pi,bn(ii))
+                          aa = an(ii)
+                          if (aa.lt.a(i)-2*pi) aa=a(i)-2*pi
+                      else if((an(ii).lt.b(i)+2*pi).and.
+     &                       (bn(ii).gt.a(i)+2*pi)) then
+                          bb = min(b(i)+2*pi,bn(ii))
+                          aa = an(ii)
+                          if (aa.lt.a(i)+2*pi) aa=a(i)+2*pi
+                      else 
+                          bb = min(b(i),bn(ii))
+                          aa = an(ii)
+                          if (aa.lt.a(i)) aa=a(i)
+                      end if
+                      intersec(ktotal)=(bb-aa)*(sin(dd)-sin(cc))
+                     end if
+                end do
+               end do
+             end if
+         end do
+       end do       
+
+
+c     TEST  INFO
+c     DO k=1,ktotal 
+c      ii = iik(k) 
+c      jj = jjk(k)
+c      i = ik(k)
+c      j = jk(k)
+c      if ((ii.eq.10).and.(jj.eq.10).and.(i.eq.10).and.(j.eq.10))then
+c      if (jj.eq.2.and.(ii.eq.1))then
+c          write(*,*) '**************** jj=',jj,'ii=',ii
+c          write(*,*) 'i,j =',i,j
+c          write(*,*) 'an,bn,cn,dn', an(ii), bn(ii), cn(jj),dn(jj)
+c          write(*,*) 'a,b,c,d', a(i), b(i), c(j),d(j)
+c          write(*,*) 'intersec(k)',intersec(k)
+c          write(*,*) 'airen(ii,jj)=',airen(ii,jj)
+c      end if
+c     END DO 
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/initial0.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/initial0.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/initial0.F	(revision 2744)
@@ -0,0 +1,9 @@
+      SUBROUTINE initial0(n,x)
+      IMPLICIT NONE
+      INTEGER n,i
+      REAL x(n)
+      DO 10 i=1,n
+         x(i)=0.
+10    CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniwrite.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniwrite.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/iniwrite.F	(revision 2744)
@@ -0,0 +1,407 @@
+      SUBROUTINE iniwrite(nid,idayref,phis)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   ecriture du fichier histoire
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+!#include "comconst.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER*4 idayref
+      REAL phis(ip1jmp1)
+
+c   Local:
+c   ------
+      INTEGER length,l
+      parameter (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER loop
+      INTEGER ierr
+      INTEGER ind1,indlast
+
+      integer :: nid,nvarid,idim_index,idim_rlonu,idim_rlonv
+      integer :: idim_rlatu,idim_rlatv,idim_llmp1,idim_llm
+      integer, dimension(2) :: id  
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+      tab_cntrl(1)  = FLOAT(iim)
+      tab_cntrl(2)  = FLOAT(jjm)
+      tab_cntrl(3)  = FLOAT(llm)
+      tab_cntrl(4)  = FLOAT(idayref)
+      tab_cntrl(5)  = rad
+      tab_cntrl(6)  = omeg
+      tab_cntrl(7)  = g
+      tab_cntrl(8)  = mugaz
+      tab_cntrl(9)  = rcp
+      tab_cntrl(10) = daysec
+      tab_cntrl(11) = dtphys
+      tab_cntrl(12) = etot0
+      tab_cntrl(13) = ptot0
+      tab_cntrl(14) = ztot0
+      tab_cntrl(15) = stot0
+      tab_cntrl(16) = ang0
+c
+c    ..........    P.Le Van  ( ajout le 8/04/96 )    .........
+c         .....        parametres  pour le zoom          ......   
+      tab_cntrl(17)  = clon
+      tab_cntrl(18)  = clat
+      tab_cntrl(19)  = grossismx
+      tab_cntrl(20)  = grossismy
+c
+c     .....   ajout  le 6/05/97 et le 15/10/97  .......
+c
+      IF ( fxyhypb )   THEN
+        tab_cntrl(21) = 1.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+      ELSE
+        tab_cntrl(21) = 0.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+        tab_cntrl(24) = 0.
+        IF( ysinus )  tab_cntrl(24) = 1.
+      ENDIF
+
+c    .........................................................
+
+! Definition des dimensions
+    
+      ierr = NF_REDEF (nid)
+
+      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
+      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid, "interlayer", (llm+1), idim_llmp1)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+c
+      ierr = NF_ENDDEF(nid)
+
+c  Ecriture DRS du tableau des parametres du run
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, 
+     .       idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, 
+     .       idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c --------------------------
+c  Ecriture des longitudes et latitudes
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "rlonu", NF_DOUBLE, 1, idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "rlonu", NF_FLOAT, 1, idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
+     .                        "Longitudes aux points u")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid, "latitude", NF_DOUBLE, 1, idim_rlatu,nvarid)
+#else
+      ierr =NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1, 
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1, 
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "rlatv", NF_DOUBLE, 1, idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "rlatv", NF_FLOAT, 1, idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Latitudes aux points v")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv/pi*180)
+#endif
+c
+c --------------------------
+c  Ecriture des niveaux verticaux
+      call def_var(nid,"aps","hybrid pressure at midlayers "," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+
+      call def_var(nid,"bps","hybrid sigma at midlayers"," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+
+      call def_var(nid,"ap","hybrid pressure at interlayers"," ",
+     .            1,idim_llmp1,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+
+      call def_var(nid,"bp","hybrid sigma at interlayers"," ",
+     .            1,idim_llmp1,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+
+c
+c --------------------------
+c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
+
+      id(1)=idim_rlonu
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cu", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cu", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 39,
+     .                      "Coefficients de passage cov <--> naturel")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatv
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cv", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cv", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 39,
+     .                      "Coefficients de passage cov <--> naturel")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "aire", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "aire", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+     .                        "Aires des mailles")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+c
+c  Ecriture du geopentiel au sol
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 24,
+     .                        "Geopotentiel au sol init")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
+
+      id(1)=idim_rlonu
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cu", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cu", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 39,
+     .                      "Coefficients de passage cov <--> naturel")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatv
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cv", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cv", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 39,
+     .                      "Coefficients de passage cov <--> naturel")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "aire", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "aire", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+     .                        "Aires des mailles")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+c
+c  Ecriture du geopentiel au sol
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 24,
+     .                        "Geopotentiel au sol init")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      PRINT*,'rad,omeg,g,mugaz,rcp',
+     s rad,omeg,g,mugaz,rcp
+      PRINT*,'daysec,dtphys',daysec,dtphys
+
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/integrd.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/integrd.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/integrd.F	(revision 2744)
@@ -0,0 +1,185 @@
+      SUBROUTINE integrd
+     $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
+     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold )
+
+      IMPLICIT NONE
+
+
+c=======================================================================
+cccccccccccccccccccccccccccccccccccccccccccc
+c
+!Mars       VERSION MARTIENNE de integrd.F
+c
+c   ..   modification de l'integration de  q   . 26/04/94 ..
+c   ....   Si shema Van-leer pour advection de q , on n'integre pas  q
+c      car q  a ete deja integre   dans "tracvl.F" appele par vanleer   ...
+cccccccccccccccccccccccccccccccccccccccccccc
+
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   objet:
+c   ------
+c
+c   Incrementation des tendances dynamiques
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "logic.h"
+#include "temps.h"
+#include "serre.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER nq
+
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL q(ip1jmp1,llm,nq)
+      REAL ps(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
+
+      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
+      REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1),massem1(ip1jmp1,llm)
+
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+      REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
+      REAL dq(ip1jmp1,llm,nq), finvmaold(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
+      REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm)
+      REAL p(ip1jmp1,llmp1)
+      REAL tpn,tps,tppn(iim),tpps(iim)
+      REAL qpn,qps,qppn(iim),qpps(iim)
+      REAL deltap( ip1jmp1,llm )
+
+      INTEGER  l,ij,iq
+
+      EXTERNAL  filtreg,massdair,pression
+      EXTERNAL  SCOPY 
+      REAL SSUM
+      EXTERNAL SSUM
+
+c-----------------------------------------------------------------------
+
+      DO  l = 1,llm
+        DO  ij = 1,iip1
+         ucov(    ij    , l) = 0.
+         ucov( ij +ip1jm, l) = 0.
+         uscr(     ij      ) = 0.
+         uscr( ij +ip1jm   ) = 0.
+        ENDDO
+      ENDDO
+
+
+c    ............    integration  de       ps         ..............
+
+      CALL SCOPY(ip1jmp1*llm, masse, 1, massescr, 1)
+
+      DO 2 ij = 1,ip1jmp1
+       pscr (ij)    = ps(ij)
+       ps (ij)      = psm1(ij) + dt * dp(ij)
+
+   2  CONTINUE
+c
+      DO ij = 1,ip1jmp1
+        IF( ps(ij).LT.0. ) THEN
+         PRINT*,' Au point ij = ',ij, ' , pression sol neg. ', ps(ij)
+         STOP' dans integrd'
+        ENDIF
+      ENDDO
+c
+      IF( alphax.NE.0. )   THEN
+         DO  ij    = 1, iim
+          tppn(ij) = aire(   ij   ) * ps(  ij    )
+          tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
+         ENDDO
+          tpn      = SSUM(iim,tppn,1)/apoln
+          tps      = SSUM(iim,tpps,1)/apols
+         DO ij   = 1, iip1
+          ps(   ij   )  = tpn
+          ps(ij+ip1jm)  = tps
+         ENDDO
+      ENDIF
+c
+c  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...
+c
+      CALL pression ( ip1jmp1, ap, bp, ps, p )
+      CALL massdair (     p  , masse         )
+
+      CALL SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
+      CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1  )
+c
+
+c    ............   integration  de  ucov, vcov,  h     ..............
+
+      DO 10 l = 1,llm
+
+      DO 4 ij = iip2,ip1jm
+      uscr( ij )   =  ucov( ij,l )
+      ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
+   4  CONTINUE
+
+      DO 5 ij = 1,ip1jm
+      vscr( ij )   =  vcov( ij,l )
+      vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
+   5  CONTINUE
+
+      DO 6 ij = 1,ip1jmp1
+      hscr( ij )    =  teta(ij,l)
+      teta ( ij,l ) = tetam1(ij,l) *  massem1(ij,l) / masse(ij,l) 
+     $                + dt * dteta(ij,l) / masse(ij,l)
+   6  CONTINUE
+
+c   ....  Calcul de la valeur moyenne, unique  aux poles pour  teta    ......
+c
+c
+      DO  ij   = 1, iim
+        tppn(ij) = aire(   ij   ) * teta(  ij    ,l)
+        tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
+      ENDDO
+        tpn      = SSUM(iim,tppn,1)/apoln
+        tps      = SSUM(iim,tpps,1)/apols
+
+      DO ij   = 1, iip1
+        teta(   ij   ,l)  = tpn
+        teta(ij+ip1jm,l)  = tps
+      ENDDO
+c
+
+      IF(leapf)  THEN
+         CALL SCOPY ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 )
+         CALL SCOPY (   ip1jm, vscr(1), 1, vcovm1(1, l), 1 )
+         CALL SCOPY ( ip1jmp1, hscr(1), 1, tetam1(1, l), 1 )
+      END IF
+
+  10  CONTINUE
+
+
+c
+c   .......  integration de   q   ......
+c
+c
+c     .....   FIN  de l'integration  de   q    .......
+
+c    .................................................................
+
+
+      IF( leapf )  THEN
+         CALL SCOPY (    ip1jmp1 ,  pscr   , 1,   psm1  , 1 )
+         CALL SCOPY ( ip1jmp1*llm, massescr, 1,  massem1, 1 )
+      END IF
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/interp_horiz.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/interp_horiz.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/interp_horiz.F	(revision 2744)
@@ -0,0 +1,199 @@
+      subroutine interp_horiz (varo,varn,imo,jmo,imn,jmn,lm,
+     &  rlonuo,rlatvo,rlonun,rlatvn)  
+
+c===========================================================
+c  Interpolation Horizontales des variables d'une grille LMDZ
+c (des points SCALAIRES au point SCALAIRES)
+c  dans une autre grille LMDZ en conservant la quantite
+c  totale pour les variables intensives (/m2) : ex : Pression au sol
+c
+c Francois Forget (01/1995)
+c===========================================================
+
+      IMPLICIT NONE 
+
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+        
+       INTEGER imo, jmo ! dimensions ancienne grille (input)
+       INTEGER imn,jmn  ! dimensions nouvelle grille (input)
+
+       REAL rlonuo(imo+1)     !  Latitude et
+       REAL rlatvo(jmo)       !  longitude des
+       REAL rlonun(imn+1)     !  bord des 
+       REAL rlatvn(jmn)     !  cases "scalaires" (input)
+
+       INTEGER lm ! dimension verticale (input)
+       REAL varo (imo+1, jmo+1,lm) ! var dans l'ancienne grille (input)
+       REAL varn (imn+1,jmn+1,lm) ! var dans la nouvelle grille (output)
+
+c Autres variables
+c """"""""""""""""
+       INTEGER imnmx2,jmnmx2
+       parameter (imnmx2=190,jmnmx2=100)
+       REAL airetest(imnmx2+1,jmnmx2+1)
+       INTEGER ii,jj,l
+
+       REAL airen ((imnmx2+1)*(jmnmx2+1)) ! aire dans la nouvelle grille
+       REAL airentotn	! aire totale pole nord dans la nouvelle grille
+       REAL airentots	! aire totale pole sud dans la nouvelle grille
+c    Info sur les ktotal intersection entre les cases new/old grille
+
+c kmax: le nombre  max  d'intersections entre les 2 grilles horizontales
+c On fixe kmax a la taille de la grille des donnees martiennes (360x179) 
+c + des pouiemes (cas ou une maille est a cheval sur 2 ou 4 mailles)
+c  Il y a un test dans iniinterp_h pour s'assurer que ktotal < kmax
+       INTEGER kmax, k, ktotal
+       parameter (kmax = 360*179 + 200000)
+c      parameter (kmax = 360*179 + 40000)
+
+       INTEGER iik(kmax), jjk(kmax),jk(kmax),ik(kmax)
+       REAL intersec(kmax)
+       REAL R
+       REAL totn, tots
+       REAL prev_sumdim
+       save prev_sumdim
+       
+
+       logical firsttest, aire_ok
+       save firsttest
+       data firsttest /.true./
+       data aire_ok /.true./
+
+       integer imoS,jmoS,imnS,jmnS
+       save imoS,jmoS,imnS,jmnS
+       save ktotal,iik,jjk,jk,ik,intersec,airen
+       REAL pi
+
+c Test dimensions imnmx2 jmnmx2
+c""""""""""""""""""""""""""""""
+c test dimensionnement tableau airetest
+      if (imn.GT.imnmx2.OR.jmn.GT.jmnmx2) then
+         write(*,*) 'STOP pb dimensionnement tableau airetest'
+         write(*,*) 'il faut imn < imnmx2 et jmn < jmnmx2'
+         write(*,*) 'imn imnmx2', imn,imnmx2
+         write(*,*) 'jmn jmnmx2', jmn,jmnmx2
+         call exit(1)
+      endif
+
+c initialisation
+c --------------
+c Si c'est le premier appel,  on prepare l'interpolation
+c en calculant pour chaque case autour d'un point scalaire de la
+c nouvelle grille, la surface  de intersection avec chaque
+c    case de l'ancienne grille.
+
+c  This must also be done if we change the dimension
+      if (imo+jmo+imn+jmn.ne.prev_sumdim) then
+          firsttest=.true.
+          prev_sumdim=imo+jmo+imn+jmn
+      end if       
+
+      if (firsttest) then 
+        call iniinterp_h(imo,jmo,imn,jmn ,kmax,
+     &       rlonuo,rlatvo,rlonun,rlatvn,
+     &          ktotal,iik,jjk,jk,ik,intersec,airen)
+       imoS=imo
+       jmoS=jmo
+       imnS=imn
+       jmnS=jmn
+      else
+       if(imo.NE.imoS.OR.jmo.NE.jmoS.OR.imn.NE.imnS.OR.jmn.NE.jmnS) then
+        call iniinterp_h(imo,jmo,imn,jmn ,kmax,
+     &       rlonuo,rlatvo,rlonun,rlatvn,
+     &          ktotal,iik,jjk,jk,ik,intersec,airen)
+       imoS=imo
+       jmoS=jmo
+       imnS=imn
+       jmnS=jmn
+       end if
+      end if
+
+      do l=1,lm
+       do jj =1 , jmn+1
+        do ii=1, imn+1
+          varn(ii,jj,l) =0.
+        end do
+       end do
+      end do 
+       
+c Interpolation horizontale
+c -------------------------
+c boucle sur toute les ktotal intersections entre les cases
+c de l'ancienne et la  nouvelle grille
+c
+     
+      do k=1,ktotal
+        do l=1,lm
+         varn(iik(k),jjk(k),l) = varn(iik(k),jjk(k),l) 
+     &   + varo(ik(k), jk(k),l)*intersec(k)/airen(iik(k)
+     &   +(jjk(k)-1)*(imn+1))
+        end do
+      end do
+
+c Une seule valeur au pole pour les variables ! :
+c -----------------------------------------------
+      DO l=1, lm
+         totn =0.
+         tots =0.
+
+
+c moyenne du champ au poles (ponderee par les aires)
+c"""""""""""""""""""""""""""""""
+         airentotn=0.
+         airentots=0.
+
+         do ii =1, imn+1
+            totn = totn + varn(ii,1,l)*airen(ii)
+            tots = tots + varn (ii,jmn+1,l)*airen(jmn*(imn+1)+ii)
+            airentotn=airentotn + airen(ii)
+            airentots=airentots + airen(jmn*(imn+1)+ii)
+         end do 
+
+         do ii =1, imn+1
+            varn(ii,1,l) = totn/airentotn
+            varn(ii,jmn+1,l) = tots/airentots
+         end do 
+
+      ENDDO
+           
+
+c---------------------------------------------------------------
+c  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST 
+      if (firsttest) then
+      pi=2.*asin(1.)
+      firsttest = .false.
+      write (*,*) 'INTERP. HORIZ. : TEST SUR LES AIRES:'
+
+      do jj =1 , jmn+1
+        do ii=1, imn+1
+          airetest(ii,jj) =0.
+        end do
+      end do 
+      do k=1,ktotal
+         airetest(iik(k),jjk(k))= airetest(iik(k),jjk(k)) +intersec(k) 
+      end do
+      do jj =1 , jmn+1
+       do ii=1, imn+1
+         r = airen(ii+(jj-1)*(imn+1))/airetest(ii,jj)
+         if ((r.gt.1.001).or.(r.lt.0.999)) then
+             write (*,*) '********** PROBLEME D'' AIRES !!!',
+     &                   ' DANS L''INTERPOLATION HORIZONTALE'
+             write(*,*)'ii,jj,airen,airetest',
+     &          ii,jj,airen(ii+(jj-1)*(imn+1)),airetest(ii,jj)
+             aire_ok = .false.
+         end if
+       end do
+      end do
+      if (aire_ok) write(*,*) 'INTERP. HORIZ. : AIRES OK'
+      endif
+
+c FIN TEST  FIN TEST  FIN TEST  FIN TEST  FIN TEST  FIN TEST  FIN TEST
+c --------------------------------------------------------------------
+
+
+        return
+        end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/interp_vert.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/interp_vert.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/interp_vert.F	(revision 2744)
@@ -0,0 +1,70 @@
+c******************************************************
+      SUBROUTINE   interp_vert(varo,varn,lmo,lmn,apso,bpso,
+     &             aps,bps,ps,Nhoriz)
+c
+c interpolation lineaire pour passer
+c a une nouvelle discretisation verticale pour
+c les variables de GCM
+c Francois Forget (01/1995)
+c Modif pour coordonnees hybrides FF (03/2003)
+c**********************************************************
+
+      IMPLICIT NONE
+
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+
+       integer lmo ! dimensions ancienne couches (input)
+       integer lmn ! dimensions nouvelle couches (input)
+
+       real apso(lmo),bpso(lmo)! anciennes coord hybrides midlayer (input)
+       real aps(lmn), bps(lmn)! nouvelles coord hybrides (midlayer) (input)
+
+       integer Nhoriz ! nombre de point horizontale (input)
+       real ps(nhoriz) !pression de surface (input)
+
+       real varo(Nhoriz,lmo) ! var dans l''ancienne grille (input)
+       real varn(Nhoriz,lmn) ! var dans la nouvelle grille (output)
+
+c Autres variables
+c """"""""""""""""
+       integer n, ln ,lo 
+       real coef
+       REAL sigmo(lmo) ! niveau sigma des variables dans les anciennes coord
+       REAL sigmn(lmn) ! niveau sigma des variables dans les nouvelles coord
+
+c run
+c ====
+
+      do n=1,Nhoriz
+        do ln=1,lmn
+            sigmn(ln)=aps(ln)/ps(n)+bps(ln)
+        end do
+        do lo=1,lmo
+            sigmo(lo)=apso(lo)/ps(n)+bpso(lo)
+        end do
+
+        do ln=1,lmn
+           if (sigmn(ln).ge.sigmo(1))then
+             varn(n,ln) =  varo(n,1)  
+           else if (sigmn(ln).le.sigmo(lmo)) then
+             varn(n,ln) =  varo(n,lmo)
+           else
+              do lo =1,lmo-1 
+                if ( (sigmn(ln).le.sigmo(lo)).and.
+     &             (sigmn(ln).gt.sigmo(lo+1)) )then
+                  coef = (sigmn(ln)-sigmo(lo))/(sigmo(lo+1)-sigmo(lo))
+                   varn(n,ln)=varo(n,lo) +coef*(varo(n,lo+1)-varo(n,lo))
+                end if
+              end do           
+           end if
+         end do
+
+      end do
+
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien.F	(revision 2744)
@@ -0,0 +1,38 @@
+      SUBROUTINE laplacien ( klevel, teta, divgra )
+c
+c     P. Le Van
+c
+c   ************************************************************
+c    ....     calcul de  (div( grad ))   de   teta  .....
+c   ************************************************************
+c     klevel et teta  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c
+c    .........      variables  en arguments   ..............
+c
+      INTEGER klevel
+      REAL teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
+c
+c    ............     variables  locales      ..............
+c
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+c    .......................................................
+
+      EXTERNAL  SCOPY, grad, divergf, filtreg
+
+c
+      CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
+
+      CALL filtreg( divgra,  jjp1, klevel,  2, 1, .TRUE., 1 )
+      CALL grad ( klevel,divgra,   ghx , ghy              )
+      CALL divergf ( klevel, ghx , ghy  , divgra           )
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien_gam.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien_gam.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien_gam.F	(revision 2744)
@@ -0,0 +1,52 @@
+      SUBROUTINE laplacien_gam ( klevel, cuvsga, cvusga, unsaigam ,
+     *                        unsapolnga, unsapolsga, teta, divgra )
+
+c  P. Le Van
+c
+c   ************************************************************
+c
+c      ....   calcul de  (div( grad ))   de   teta  .....
+c   ************************************************************
+c    klevel et teta  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c
+c    ............     variables  en arguments    ..........
+c
+      INTEGER klevel
+      REAL teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
+      REAL cuvsga(ip1jm) , cvusga( ip1jmp1 ),unsaigam(ip1jmp1),
+     *     unsapolnga, unsapolsga
+c
+c    ...........    variables  locales    .................
+c
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+c    ......................................................
+
+      EXTERNAL  filtreg
+      EXTERNAL  SCOPY, grad, divergst
+c
+c
+c   ...  cvuscugam  = ( cvu/ cu ) ** (- gamdissip )
+c   ...  cuvscvgam  = ( cuv/ cv ) ** (- gamdissip )  calcules dans inigeom  ..
+c   ...  unsairegam =  1. /  aire ** (- gamdissip )
+c
+
+      CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
+c
+      CALL grad ( klevel, divgra, ghx, ghy )
+c
+      CALL diverg_gam ( klevel, cuvsga, cvusga,  unsaigam  ,
+     *                 unsapolnga, unsapolsga, ghx , ghy , divgra )
+
+c
+
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien_rot.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien_rot.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien_rot.F	(revision 2744)
@@ -0,0 +1,37 @@
+      SUBROUTINE laplacien_rot ( klevel, rotin, rotout,ghx,ghy )
+c
+c    P. Le Van
+c
+c   ************************************************************
+c    ...  calcul de  ( rotat x nxgrad )  du rotationnel rotin  .
+c   ************************************************************
+c
+c     klevel et rotin  sont des arguments  d'entree pour le s-prog
+c      rotout           est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c 
+c   ..........    variables  en  arguments     .............
+c
+      INTEGER klevel
+      REAL rotin( ip1jm,klevel ), rotout( ip1jm,klevel )
+c
+c   ..........    variables   locales       ................
+c
+      REAL ghy(ip1jm,klevel), ghx(ip1jmp1,klevel)
+c   ........................................................
+c
+      EXTERNAL  filtreg, nxgrad, rotatf
+c
+      CALL filtreg ( rotin ,   jjm, klevel,   2, 1, .FALSE., 1 )
+
+      CALL nxgrad ( klevel, rotin,   ghx ,  ghy               )
+      CALL rotatf  ( klevel, ghx  ,   ghy , rotout             )
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien_rotgam.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien_rotgam.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/laplacien_rotgam.F	(revision 2744)
@@ -0,0 +1,42 @@
+      SUBROUTINE laplacien_rotgam ( klevel, rotin, rotout )
+c
+c     P. Le Van
+c
+c   ************************************************************
+c   ... calcul de  (rotat x nxgrad)_gam  du rotationnel rotin ..
+c   ************************************************************
+c     klevel et teta  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c
+c    .............   variables  en  arguments    ...........
+c
+      INTEGER klevel
+      REAL rotin( ip1jm,klevel ), rotout( ip1jm,klevel )
+c
+c   ............     variables   locales     ...............
+c
+      INTEGER l, ij
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+c   ........................................................
+c
+      EXTERNAL   nxgrad_gam, rotat_nfil
+c
+
+      CALL nxgrad_gam ( klevel, rotin,   ghx ,   ghy  )
+      CALL rotat_nfil ( klevel, ghx  ,   ghy , rotout )
+c
+      DO l = 1, klevel
+        DO ij = 1, ip1jm
+         rotout(ij,l) = rotout(ij,l) * unsairz_gam(ij)
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/lect_start_archive.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/lect_start_archive.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/lect_start_archive.F	(revision 2744)
@@ -0,0 +1,1067 @@
+
+      SUBROUTINE lect_start_archive(date,tsurf,tsoil,emis,q2,
+     .     t,ucov,vcov,ps,co2ice,h,phisold_newgrid,q,qsurf,nid)
+c=======================================================================
+c
+c
+c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
+c   ------
+c
+c
+c   Objet:     Lecture des variables d'un fichier "start_archive"
+c              Plus besoin de régler ancienne valeurs grace
+c              a l'allocation dynamique de memoire (Yann Wanherdrick)
+c
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "surfdat.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "planete.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "control.h"
+#include "logic.h"
+#include "description.h"
+#include "ener.h"
+#include "temps.h"
+#include "lmdstd.h"
+#include "netcdf.inc"
+
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+c Variables dimension du fichier "ini"
+c------------------------------------
+      INTEGER   imold,jmold,lmold,nqold
+
+c et autres:
+c----------
+      INTEGER lnblnk
+      EXTERNAL lnblnk
+
+c Variables pour les lectures des fichiers "ini" 
+c--------------------------------------------------
+      INTEGER sizei,timelen,dimid
+      INTEGER length
+      parameter (length = 100)
+      INTEGER tab0
+      INTEGER isoil,iq,iqmax
+      CHARACTER*2   str2
+
+      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
+
+      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
+
+      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
+      CHARACTER*120 dimsource
+      CHARACTER*16 dimname
+      CHARACTER*80 dimtitle
+      CHARACTER*40 dimunits
+      INTEGER   dimtype
+
+      INTEGER dimord(4)  ! tableau contenant l''ordre
+      data dimord /1,2,3,4/ ! de sortie des dimensions
+
+      INTEGER vardim(4)
+      REAL date
+      INTEGER   memo
+      character (len=50) :: tmpname
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL h(iip1,jjp1,llm),ps(iip1,jjp1)
+      REAL q(iip1,jjp1,llm,nqmx),qtot(iip1,jjp1,llm)
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+
+c!-*-
+      integer klatdat,klongdat
+      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+
+c variable physique
+c------------------
+      REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx),co2ice(ngridmx)
+      REAL emis(ngridmx)
+      REAL q2(ngridmx,nlayermx+1),qsurf(ngridmx,nqmx)
+c     REAL phisfi(ngridmx)
+
+      INTEGER i,j,l
+      INTEGER nid,nvarid
+c     REAL year_day,periheli,aphelie,peri_day
+c     REAL obliquit,z0,emin_turb,lmixmin
+c     REAL emissiv,emisice(2),albedice(2),tauvis
+c     REAL iceradius(2) , dtemisice(2)
+
+      EXTERNAL RAN1
+      REAL RAN1
+      EXTERNAL geopot,inigeom
+      integer ierr
+      integer ismin
+      external ismin
+      CHARACTER*80 datapath
+      integer, dimension(4) :: start,count
+
+c Variable nouvelle grille naturelle au point scalaire
+c------------------------------------------------------
+      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
+      REAL phisold_newgrid(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
+      real co2iceS(iip1,jjp1),emisS(iip1,jjp1)
+      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqmx)
+
+      real ptotal, co2icetotal
+
+c Var intermediaires : vent naturel, mais pas coord scalaire
+c-----------------------------------------------------------
+      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+
+
+c Variable de l'ancienne grille 
+c---------------------------------------------------------
+
+      real, dimension(:), allocatable :: timelist
+      real, dimension(:), allocatable :: rlonuold, rlatvold
+      real, dimension(:), allocatable :: rlonvold, rlatuold
+      real, dimension(:), allocatable :: apsold,bpsold
+      real, dimension(:,:,:), allocatable :: uold,vold,told,q2old
+      real, dimension(:,:,:), allocatable :: tsoilold,qsurfold
+      real, dimension(:,:), allocatable :: psold,phisold
+      real, dimension(:,:), allocatable :: co2iceold,tsurfold
+      real, dimension(:,:), allocatable :: emisold
+      real, dimension(:,:,:,:), allocatable :: qold
+
+      real tab_cntrl(100)
+
+      real ptotalold, co2icetotalold
+
+c Variable intermediaires iutilise pour l'extrapolation verticale 
+c----------------------------------------------------------------
+      real, dimension(:,:,:), allocatable :: var,varp1 
+
+c=======================================================================
+
+c Catching the axis lenghts for dynamic memory allocation 
+
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"temps",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+
+      ierr= NF_INQ_DIMID(nid,"latitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlatu",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,jmold)
+      jmold=jmold-1
+
+      ierr= NF_INQ_DIMID(nid,"longitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlonv",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,imold)
+      imold=imold-1
+
+      ierr= NF_INQ_DIMID(nid,"altitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"sig_s",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,lmold)
+
+      nqold=0
+      do
+         write(str2,'(i2.2)') nqold+1
+         ierr= NF_INQ_VARID(nid,'q'//str2,dimid)
+!        write(*,*) 'q'//str2
+         if (ierr.eq.NF_NOERR) then
+            nqold=nqold+1
+         else
+            exit
+         endif
+      enddo
+
+      write(*,*) "Start_archive dimensions:"
+      write(*,*) "longitude: ",imold
+      write(*,*) "latitude: ",jmold
+      write(*,*) "altitude: ",lmold
+      write(*,*) "tracers: ",nqold
+      write(*,*) "time lenght: ",timelen
+      write(*,*) 
+
+      allocate(timelist(timelen))
+      allocate(rlonuold(imold+1), rlatvold(jmold))
+      allocate(rlonvold(imold+1), rlatuold(jmold+1))
+      allocate (apsold(lmold),bpsold(lmold))
+      allocate(uold(imold+1,jmold+1,lmold))
+      allocate(vold(imold+1,jmold+1,lmold))
+      allocate(told(imold+1,jmold+1,lmold))
+      allocate(psold(imold+1,jmold+1))
+      allocate(phisold(imold+1,jmold+1))
+      allocate(qold(imold+1,jmold+1,lmold,nqmx))
+      allocate(co2iceold(imold+1,jmold+1))
+      allocate(tsurfold(imold+1,jmold+1))
+      allocate(emisold(imold+1,jmold+1))
+      allocate(q2old(imold+1,jmold+1,lmold+1))
+      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
+      allocate(qsurfold(imold+1,jmold+1,nqmx))
+
+      allocate(var (imold+1,jmold+1,llm))
+      allocate(varp1 (imold+1,jmold+1,llm+1))
+
+      write(*,*) 'q2',ngridmx,nlayermx+1
+      write(*,*) 'q2S',iip1,jjp1,llm+1
+      write(*,*) 'q2old',imold+1,jmold+1,lmold+1
+ 
+C-----------------------------------------------------------------------
+c Lecture du tableau des parametres du run 
+c     (pour  la lecture ulterieure de "ptotalold" et "co2icetotalold")
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Lect_start_archive: champ <controle> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echoue pour <controle>"
+         CALL abort
+      ENDIF
+c
+      tab0 = 50
+
+c-----------------------------------------------------------------------
+c Lecture des longitudes et latitudes
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlonv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlonv>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlatu> est absent"
+         CALL abort
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlatu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlonu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlatv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlatv>"
+         CALL abort
+      ENDIF
+c
+
+c-----------------------------------------------------------------------
+c Lecture des niveaux verticaux
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <aps> est absent"
+         apsold=0
+         PRINT*, "<aps> set to 0"
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apsold)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, apsold)
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Lecture echouee pour <aps>"
+         ENDIF
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <bps> est absent"
+         PRINT*, "It must be an old start_archive, lets look for sig_s"
+         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "Nothing to do..."
+            CALL abort
+         ENDIF
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpsold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bpsold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <bps>"
+         CALL abort
+      END IF
+
+
+c-----------------------------------------------------------------------
+c Lecture geopotentiel au sol
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <phisinit> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <phisinit>"
+         CALL abort
+      ENDIF
+
+C-----------------------------------------------------------------------
+c   lecture de "ptotalold" et "co2icetotalold"
+c-----------------------------------------------------------------------
+      ptotalold = tab_cntrl(tab0+49)
+      co2icetotalold = tab_cntrl(tab0+50)
+ 
+c-----------------------------------------------------------------------
+c   Lecture du temps et choix
+c-----------------------------------------------------------------------
+ 
+c  lecture du temps
+c
+      ierr = NF_INQ_DIMID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Le champ <Time> est absent"
+            CALL abort
+         endif
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_VARID (nid, "temps", nvarid)
+      endif 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, timelist)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, timelist)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <Time>"
+         CALL abort
+      ENDIF
+c
+      write(*,*)
+      write(*,*)
+      write(*,*) 'Differentes dates des etats initiaux stockes:'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      pi=2.*ASIN(1.)
+      do i=1,timelen
+c       call solarlong(timelist(i),sollong(i))
+c       sollong(i) = sollong(i)*180./pi
+        write(*,*) 'etat initial au jour martien' ,int(timelist(i))
+c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
+c    .    sollong(i)
+      end do
+
+   6  FORMAT(i7,i7,f9.3)
+ 
+      write(*,*)
+      write(*,*) 'Choix de la date'
+ 123  read(*,*,iostat=ierr) date
+      if(ierr.ne.0) goto 123
+      memo = 0
+      do i=1,timelen
+        if (date.eq.int(timelist(i))) then
+            memo = i
+        endif
+      end do
+ 
+      if (memo.eq.0) then
+        write(*,*)
+        write(*,*)
+        write(*,*) 'He alors... Y sait pas lire !?!'
+        write(*,*)
+        write(*,*) 'Differentes dates des etats initiaux stockes:'
+        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+        do i=1,timelen
+          write(*,*) 'etat initial au jour martien' ,nint(timelist(i))
+c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
+        end do
+        goto 123
+      endif
+ 
+c-----------------------------------------------------------------------
+c Lecture des champs 2D (co2ice, emis,ps,tsurf,Tg[10], q2surf)
+c-----------------------------------------------------------------------
+ 
+      start=(/1,1,memo,0/)
+      count=(/imold+1,jmold+1,1,0/)
+       
+      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <co2ice> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <co2ice>"
+         PRINT*, NF_STRERROR(ierr)
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "emis", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <emis> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,emisold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,emisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <emis>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <ps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,psold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,psold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <ps>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <tsurf> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsurfold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsurfold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <tsurf>"
+         CALL abort
+      ENDIF
+c
+      do isoil=1,nsoilmx
+         write(str2,'(i2.2)') isoil
+c
+         ierr = NF_INQ_VARID (nid, "Tg"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .              Le champ <","Tg"//str2,"> est absent"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     .          tsoilold(1,1,isoil))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     .          tsoilold(1,1,isoil))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .            Lecture echouee pour <","Tg"//str2,">"
+            CALL abort
+         ENDIF
+c
+      end do
+
+c
+      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <q2surf> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <q2surf>"
+         CALL abort
+      ENDIF
+c
+      write (*,*) "rlonuold,rlatvold"
+      write (*,*) rlonuold
+      write (*,*) rlatvold
+      write (*,*)
+c
+
+c tracers: the 2 last ones are kept the 2 last one. 
+c the others keep their rank.
+c -------------------------------------------
+      
+      do iq=1,nqmx
+        call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
+      enddo
+
+      iq=nqold
+        write(str2,'(i2.2)') iq
+         ierr = NF_INQ_VARID (nid, "qsurf"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .               Le champ <","qsurf"//str2,"> est absent"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     .          qsurfold(1,1,nqmx))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     .          qsurfold(1,1,nqmx))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .               Lecture echouee pour <","qsurf"//str2,">"
+            write (*,*) 'qsurf'//str2,' set to 0'
+            call initial0((jmold+1)*(imold+1), qsurfold(1,1,nqmx))
+         ENDIF
+
+      if ((nqold.gt.1).and.(nqmx.gt.1)) then
+        iq=nqold-1
+        write(str2,'(i2.2)') iq
+         ierr = NF_INQ_VARID (nid, "qsurf"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .               Le champ <","qsurf"//str2,"> est absent"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     .          qsurfold(1,1,nqmx-1))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     .          qsurfold(1,1,nqmx-1))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .               Lecture echouee pour <","qsurf"//str2,">"
+            write (*,*) 'qsurf'//str2,' set to 0'
+            call initial0((jmold+1)*(imold+1), qsurfold(1,1,nqmx-1))
+         ENDIF
+      endif
+
+      if (nqold.gt.2) then
+       do  iq = 1, nqold-2
+       if (iq.lt.nqmx-1) then
+         write(str2,'(i2.2)') iq
+         ierr = NF_INQ_VARID (nid, "qsurf"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .               Le champ <","qsurf"//str2,"> est absent"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     .          qsurfold(1,1,iq))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     .          qsurfold(1,1,iq))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .               Lecture echouee pour <","qsurf"//str2,">"
+            write (*,*) 'qsurf'//str2,' set to 0'
+            call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
+         ENDIF
+       end if
+       end do
+      end if
+
+c-----------------------------------------------------------------------
+c	Lecture des champs 3D (t,u,v, q2atm,q)
+c-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,lmold,1/)
+
+c
+      ierr = NF_INQ_VARID (nid,"temp", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <temp> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid, start, count, told)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid, start, count, told)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <temp>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"u", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <u> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,uold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,uold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <u>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"v", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <v> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,vold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,vold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <v>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <q2atm> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old(1,1,2))
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old(1,1,2))
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <q2atm>"
+         CALL abort
+      ENDIF
+c
+
+c tracers: the 2 last ones are kept the 2 last one. 
+c the others keep their rank.
+c -------------------------------------------
+      
+      do iq=1,nqmx
+         call initial0((jmold+1)*(imold+1)*lmold,qold(1,1,1,iq) )
+      enddo
+
+      iq=nqold
+        write(str2,'(i2.2)') iq
+         ierr = NF_INQ_VARID (nid, "q"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive:
+     .               Le champ <","q"//str2,"> est absent"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr= NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,nqmx))
+#else
+         ierr= NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,nqmx))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .               Lecture echouee pour <","q"//str2,">"
+            write (*,*) 'q'//str2,' set to 1.E-30'
+            do l=1,lmold
+              do j=1,jmold+1
+                do i=1,imold+1
+                   qold(1,1,1,nqmx)=1.e-30
+                end do
+              end do
+            end do
+
+         ENDIF
+
+      if ((nqold.gt.1).and.(nqmx.gt.1)) then
+        iq=nqold-1
+        write(str2,'(i2.2)') iq
+         ierr = NF_INQ_VARID (nid, "q"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive:
+     .               Le champ <","q"//str2,"> est absent"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr= NF_GET_VARA_DOUBLE(nid,nvarid,start,count,
+     .                            qold(1,1,1,nqmx-1))
+#else
+         ierr= NF_GET_VARA_REAL(nid,nvarid,start,count,
+     .                            qold(1,1,1,nqmx-1))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .               Lecture echouee pour <","q"//str2,">"
+            write (*,*) 'q'//str2,' set to 1.E-30'
+            do l=1,lmold
+              do j=1,jmold+1
+                do i=1,imold+1
+                   qold(1,1,1,nqmx-1)=1.e-30
+                end do
+              end do
+            end do
+
+         ENDIF
+      endif
+
+      if (nqold.gt.2) then
+       do  iq = 1, nqold-2
+       if (iq.lt.nqmx-1) then
+         write(str2,'(i2.2)') iq
+         ierr = NF_INQ_VARID (nid, "q"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive:
+     .               Le champ <","q"//str2,"> est absent"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr= NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
+#else
+         ierr= NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .               Lecture echouee pour <","q"//str2,">"
+            write (*,*) 'q'//str2,' set to 1.E-30 '
+            do l=1,lmold
+              do j=1,jmold+1
+                do i=1,imold+1
+                   qold(1,1,1,iq)=1.e-30
+                end do
+              end do
+            end do
+
+         ENDIF
+       end if
+       end do
+      end if
+
+c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...)
+c -------------------------------------------------------------------------
+
+      datapath = '/users/forget/gcm/data_mars_gcm'
+
+
+c=======================================================================
+c   INTERPOLATION DANS LA NOUVELLE GRILLE et initialisation des variables
+c=======================================================================
+c  Interpolation horizontale puis passage dans la grille physique pour 
+c  les variables physique 
+c  Interpolation verticale puis horizontale pour chaque variable 3D
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c	Variable 2d :
+c-----------------------------------------------------------------------
+c Relief 
+      call interp_horiz (phisold,phisold_newgrid,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Glace CO2
+      call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Temperature de surface
+      call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,tsurfs,tsurf)
+c     write(44,*) 'tsurf', tsurf
+
+c Temperature du sous-sol
+      call interp_horiz(tsoilold,tsoils,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngridmx,tsoils,tsoil)
+c     write(45,*) 'tsoil',tsoil
+
+c Emissivite de la surface
+      call interp_horiz (emisold,emiss,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,emiss,emis)
+c     write(46,*) 'emis',emis
+c-----------------------------------------------------------------------
+c	Traitement special de la pression au sol :
+c-----------------------------------------------------------------------
+
+c  Extrapolation la pression dans la nouvelle grille
+      call interp_horiz(psold,ps,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c-----------------------------------------------------------------------
+c	On assure la conservation de la masse de l'atmosphere + calottes
+c-----------------------------------------------------------------------
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+            ptotal=ptotal+ps(i,j)*aire(i,j)/g
+            co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j)
+         END DO
+      END DO
+
+      write(*,*)
+      write(*,*)'Ancienne grille: masse de l atm :',ptotalold
+      write(*,*)'Nouvelle grille: masse de l atm :',ptotal
+      write (*,*) 'Ratio new atm./ old atm =', ptotal/ptotalold 
+      write(*,*)
+      write(*,*)'Ancienne grille: masse de la glace CO2:',co2icetotalold
+      write(*,*)'Nouvelle grille: masse de la glace CO2:',co2icetotal
+      write(*,*)'Ratio new ice./old ice =',co2icetotal/co2icetotalold
+      write(*,*)
+
+
+      DO j=1,jjp1
+         DO i=1,iip1
+            ps(i,j)=ps(i,j) * ptotalold/ptotal
+         END DO
+      END DO
+
+      if ( co2icetotalold.gt.0.) then 
+         DO j=1,jjp1
+            DO i=1,iip1
+               co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal
+            END DO
+         END DO
+      end if
+
+c-----------------------------------------------------------------------
+c	Variable 3d :
+c-----------------------------------------------------------------------
+      
+c temperatures atmospheriques
+      write (*,*) 'told ', told (1,jmold+1,1)  ! INFO
+      call interp_vert
+     &    (told,var,lmold,llm,apsold,bpsold,aps,bps,
+     &     psold,(imold+1)*(jmold+1))
+      write (*,*) 'var ', var (1,jmold+1,1)  ! INFO
+      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 't ', t(1,jjp1,1)  ! INFO
+
+c q2 : pbl wind variance
+      write (*,*) 'q2old ', q2old (1,2,1)  ! INFO
+      call interp_vert (q2old,varp1,lmold+1,llm+1,
+     &     apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      write (*,*) 'varp1 ', varp1 (1,2,1)  ! INFO
+      call interp_horiz(varp1,q2s,imold,jmold,iim,jjm,llm+1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'q2s ', q2s (1,2,1)  ! INFO
+      call gr_dyn_fi (llm+1,iim+1,jjm+1,ngridmx,q2s,q2)
+      write (*,*) 'q2 ', q2 (1,2)  ! INFO
+c     write(47,*) 'q2',q2
+
+c calcul des champ de vent; passage en vent covariant
+      write (*,*) 'uold ', uold (1,2,1)  ! INFO
+      call interp_vert
+     & (uold,var,lmold,llm,apsold,bpsold,aps,bps,
+     &  psold,(imold+1)*(jmold+1))
+      write (*,*) 'var ', var (1,2,1)  ! INFO
+      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'us ', us (1,2,1)   ! INFO
+
+      call interp_vert
+     & (vold,var,lmold,llm,
+     &  apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      call interp_horiz(var,vs,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call scal_wind(us,vs,unat,vnat)
+      write (*,*) 'unat ', unat (1,2,1)    ! INFO
+      do l=1,llm
+        do j = 1, jjp1
+          do i=1,iip1
+            ucov( i,j,l ) = unat( i,j,l ) * cu(i,j)
+c           ucov( i,j,l ) = 0
+          end do
+        end do
+      end do 
+      write (*,*) 'ucov ', ucov (1,2,1)  ! INFO
+c     write(48,*) 'ucov',ucov
+      do l=1,llm
+        do j = 1, jjm
+          do i=1,iim
+            vcov( i,j,l ) = vnat( i,j,l ) * cv(i,j)
+c           vcov( i,j,l ) = 0
+          end do
+          vcov( iip1,j,l ) = vcov( 1,j,l )
+        end do
+      end do
+c     write(49,*) 'ucov',vcov
+
+c traceurs surface
+      do iq = 1, nqmx
+            call interp_horiz(qsurfold(1,1,iq) ,qsurfs(1,1,iq),
+     &                  imold,jmold,iim,jjm,1,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+
+      call gr_dyn_fi (nqmx,iim+1,jjm+1,ngridmx,qsurfs,qsurf)
+
+c traceurs 3D
+      do  iq = 1, nqmx
+            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
+     &        apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+cccccccccccccccccccccccccccccc      
+c  make sure that sum of q = 1      
+c dominent species is = 1 - sum(all other species)      
+cccccccccccccccccccccccccccccc      
+      iqmax=1
+      
+      if (nqold.gt.10) then
+       do l=1,llm
+        do j=1,jjp1
+          do i=1,iip1
+           do iq=1,nqold
+            if (q(i,j,l,iq).gt.q(i,j,l,iqmax)) then
+              iqmax=iq
+            endif
+           enddo
+           q(i,j,l,iqmax)=1.
+           qtot(i,j,l)=0
+           do iq=1,nqold
+            if (iq.ne.iqmax) then        
+              q(i,j,l,iqmax)=q(i,j,l,iqmax)-q(i,j,l,iq)        
+            endif
+           enddo !iq
+           do iq=1,nqold
+            qtot(i,j,l)=qtot(i,j,l)+q(i,j,l,iq)
+c            if (i.eq.1.and.j.eq.1.and.l.Eq.1) write(*,*)' qtot(i,j,l)',
+c     $    qtot(i,j,l)
+           enddo !iq
+          enddo !i   
+         enddo !j   
+       enddo !l  
+      endif
+ccccccccccccccccccccccccccccccc
+
+c     Periodicite :
+      do  iq = 1, nqmx
+         do l=1, llm
+            do j = 1, jjp1
+               q(iip1,j,l,iq) = q(1,j,l,iq)
+            end do
+         end do
+      enddo
+      
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,co2ices,co2ice)
+
+c-----------------------------------------------------------------------
+c   Initialisation  h:	(passage de t -> h)
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO j=1,jjp1
+            DO i=1,iim
+               h(i,j,l) = t(i,j,l)*((ps(i,j)/preff)**kappa)
+            END DO
+            h(iip1,j,l) =  h(1,j,l)
+         END DO
+      END DO
+
+
+c***********************************************************************
+c***********************************************************************
+c     Fin subroutine lecture ini
+c***********************************************************************
+c***********************************************************************
+
+      deallocate(timelist)
+      deallocate(rlonuold, rlatvold)
+      deallocate(rlonvold, rlatuold)
+      deallocate(apsold,bpsold)
+      deallocate(uold)
+      deallocate(vold)
+      deallocate(told)
+      deallocate(psold)
+      deallocate(phisold)
+      deallocate(qold)
+      deallocate(co2iceold)
+      deallocate(tsurfold)
+      deallocate(emisold)
+      deallocate(q2old)
+      deallocate(tsoilold)
+      deallocate(qsurfold)
+      deallocate(var,varp1)
+
+      return
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/lectflux.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/lectflux.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/lectflux.F	(revision 2744)
@@ -0,0 +1,233 @@
+      SUBROUTINE lectflux(irec,massem,pbarun,pbarvn,wn,tetan,phin,
+     s     nrec,avant,airefi,
+     s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
+     s     yu1,yv1,ftsol,pctsrf,
+     s     frac_impa,frac_nucl,phis)
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom2.h"
+
+#include "tracstoke.h"
+
+      integer irec,nrec,i,j
+
+      integer ngridmx,ig,l
+      parameter (ngridmx=iim*(jjm-1)+2)
+      INTEGER nbsrf
+      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
+
+      real zmfd(ngridmx,llm),zde_d(ngridmx,llm),zen_d(ngridmx,llm)
+      real zmfu(ngridmx,llm),zde_u(ngridmx,llm),zen_u(ngridmx,llm)
+      real coefkz(ngridmx,llm)
+      real frac_impa(ngridmx,llm),frac_nucl(ngridmx,llm)
+      real yu1(ngridmx), yv1(ngridmx)
+      real ftsol(ngridmx,nbsrf),pctsrf(ngridmx,nbsrf)
+      integer imfu,imfd,ien_u,ide_u,
+     s      ien_d,ide_d,
+     s      icoefkz,izu1,izv1,
+     s      itsol,ipsf,
+     s      ilei, ilec
+      parameter(imfu=1,imfd=llm+1,ien_u=2*llm+1,ide_u=3*llm+1,
+     s      ien_d=4*llm+1,ide_d=5*llm+1,
+     s      icoefkz=6*llm+1,
+     s      ilei=7*llm+1,ilec=8*llm+1,
+     s      izu1=9*llm+1,izv1=9*llm+2,
+     s      itsol=9*llm+3,ipsf=9*llm+3+nbsrf)
+      logical avant
+
+      real massefi(ngridmx,llm)
+
+      real massem(ip1jmp1,llm),tetan(ip1jmp1,llm)
+      real pbarun(iip1,jjp1,llm),pbarvn(iip1,jjm,llm)
+      real pbarvst(iip1,jjp1,llm)
+      real wn(iip1,jjp1,llm),phin(iip1,jjp1,llm)
+      real phis(iip1,jjp1)
+
+      real airefi(ngridmx)
+
+      real xlecn(ngridmx,9*llm+2+2*nbsrf)
+
+      real zcontrole(ngridmx),zmass,tmpdyn(iip1,jjp1),zflux
+
+      real ziadvtrac,zrec,ziadvtrac2,zrec2
+      real zim,zjm,zlm,zklon,zklev
+
+      real zpi
+
+      zpi=2.*asin(1.)
+
+
+c==================================================================
+c   Si le numero du record est 0 alors: INITIALISATION
+c==================================================================
+c
+      print*,'ENTREE DANS LECTFLUX'
+        print*,'IREC=',IREC
+      if(irec.eq.0) then
+
+        print*,'IREC==',0
+
+C test         call inigeom
+
+c==================================================================
+c   ouverture des fichiers
+c==================================================================
+
+c   Fichier fluxmass
+#ifdef CRAY
+         CALL ASSIGN("assign -N ieee -F null f:fluxmass")
+#endif
+      open(47,file='fluxmass',form='unformatted',
+     s     access='direct'
+     s     ,recl=4*(6*ijp1llm))
+      read(47,rec=1) zrec,dtvr,ziadvtrac,zim,zjm,zlm,
+     s   rlonu,rlonv,rlatu,rlatv,aire
+     s    ,phis
+      print*,'zrec,dtvr,ziadvtrac,zim,zjm,zlm'
+      print*,zrec,dtvr,ziadvtrac,zim,zjm,zlm
+      print*,rlonv
+
+
+
+c  Fichier physique
+c  Fichier lessivage (supprime les donnees utiles sont dans "physique")
+#ifdef CRAY
+         CALL ASSIGN("assign -N ieee -F null f:physique")
+#endif
+      open(49,file='physique',form='unformatted',
+     s     access='direct'
+     s     ,recl=4*ngridmx*(9*llm+2+2*nbsrf))
+      read(49,rec=1) zrec2,ziadvtrac2,zklon,zklev
+      print*,'Entete du fichier physique'
+      print*,zrec2,ziadvtrac2,zklon,zklev
+
+      nrec=zrec
+      print*,'nrec=',nrec
+
+      istdyn=ziadvtrac
+      istphy=ziadvtrac2
+
+c==================================================================
+c   Fin des initialisations
+      else ! irec=0
+c==================================================================
+
+
+c-----------------------------------------------------------------------
+c   Lecture des fichiers fluxmass et  physique:
+c   -----------------------------------------------------
+
+c  Variables dynamiques
+         read(47,rec=irec) massem,pbarun,pbarvst,wn,tetan,phin
+        do l=1,llm
+           do j=1,jjm
+              do i=1,iip1
+                 pbarvn(i,j,l)=pbarvst(i,j,l)
+              enddo
+           enddo
+        enddo
+
+c  Variables physiques
+         read(49,rec=irec) ((xlecn(ig,l),ig=1,ngridmx),
+     s                                    l=1,9*llm+2+2*nbsrf)
+
+       do l=1,llm
+          do ig=1,ngridmx
+             coefkz(ig,l)=xlecn(ig,icoefkz+l-1)
+             frac_impa(ig,l)=xlecn(ig,ilei+l-1)
+             frac_nucl(ig,l)=xlecn(ig,ilec+l-1)
+          enddo
+       enddo
+       do l=1,nbsrf
+          do ig=1,ngridmx
+             ftsol(ig,l)=xlecn(ig,itsol+l-1)
+             pctsrf(ig,l)=xlecn(ig,ipsf+l-1)
+          enddo
+       enddo
+       do ig=1,ngridmx
+          yv1(ig)=xlecn(ig,izv1)
+          yu1(ig)=xlecn(ig,izu1)
+       enddo
+C
+      if(avant) then
+c   Simu directe
+       do l=1,llm
+          do ig=1,ngridmx
+             zmfu(ig,l)=xlecn(ig,imfu+l-1)
+             zmfd(ig,l)=xlecn(ig,imfd+l-1)
+             zde_u(ig,l)=xlecn(ig,ide_u+l-1)
+             zen_u(ig,l)=xlecn(ig,ien_u+l-1)
+             zde_d(ig,l)=xlecn(ig,ide_d+l-1)
+             zen_d(ig,l)=xlecn(ig,ien_d+l-1)
+          enddo
+       enddo
+      else
+c   Simu retro
+       do l=1,llm
+          do ig=1,ngridmx
+             zmfd(ig,l)=-xlecn(ig,imfu+l-1)
+             zmfu(ig,l)=-xlecn(ig,imfd+l-1)
+             zen_d(ig,l)=xlecn(ig,ide_u+l-1)
+             zde_d(ig,l)=xlecn(ig,ien_u+l-1)
+             zen_u(ig,l)=xlecn(ig,ide_d+l-1)
+             zde_u(ig,l)=xlecn(ig,ien_d+l-1)
+          enddo
+       enddo
+      endif
+
+c-----------------------------------------------------------------------
+c   PETIT CONTROLE SUR LES FLUX CONVECTIFS...
+c-----------------------------------------------------------------------
+
+      print*,'Ap redec irec'
+
+         call gr_dyn_fi(llm,iip1,jjp1,ngridmx,massem,massefi)
+
+         do ig=1,ngridmx
+            zcontrole(ig)=1.
+         enddo
+c   zmass=(max(massem(ig,l),massem(ig,l-1))/airefi(ig)
+         do l=2,llm
+            do ig=1,ngridmx
+               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefi(ig)
+               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
+               if(zflux.gt.0.9*zmass) then
+                 zcontrole(ig)=min(zcontrole(ig),0.9*zmass/zflux)
+               endif
+            enddo
+         enddo
+
+         do ig=1,ngridmx
+            if(zcontrole(ig).lt.0.99999) then
+               print*,'ATTENTION !!! on reduit les flux de masse '
+               print*,'convectifs au point ig=',ig
+            endif
+         enddo
+
+         call gr_fi_dyn(1,ngridmx,iip1,jjp1,zcontrole,tmpdyn)
+
+         do l=1,llm
+            do ig=1,ngridmx
+               zmfu(ig,l)=zmfu(ig,l)*zcontrole(ig)
+               zmfd(ig,l)=zmfd(ig,l)*zcontrole(ig)
+               zen_u(ig,l)=zen_u(ig,l)*zcontrole(ig)
+               zde_u(ig,l)=zde_u(ig,l)*zcontrole(ig)
+               zen_d(ig,l)=zen_d(ig,l)*zcontrole(ig)
+               zde_d(ig,l)=zde_d(ig,l)*zcontrole(ig)
+            enddo
+         enddo
+
+
+      endif ! irec=0
+
+
+      RETURN
+      END
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/logic.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/logic.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/logic.h	(revision 2744)
@@ -0,0 +1,10 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'logic.h'
+
+      COMMON/logic/ purmats,physic,forward,leapf,apphys,grireg,
+     *  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+
+      LOGICAL purmats,physic,forward,leapf,apphys,grireg,statcl,conser,
+     * apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/massbar.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/massbar.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/massbar.F	(revision 2744)
@@ -0,0 +1,97 @@
+      SUBROUTINE massbar(  masse, massebx, masseby )
+c
+c **********************************************************************
+c
+c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
+c **********************************************************************
+c    Auteurs : P. Le Van , Fr. Hourdin  .
+c   ..........
+c
+c  ..  masse                 est  un argum. d'entree  pour le s-pg ...
+c  ..  massebx,masseby      sont des argum. de sortie pour le s-pg ...
+c     
+c
+c     IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+      REAL    masse( ip1jmp1,llm ), massebx( ip1jmp1,llm )  ,
+     *      masseby(   ip1jm,llm )
+c
+c
+c   Methode pour calculer massebx et masseby .
+c   ----------------------------------------
+c
+c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
+c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
+c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
+c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
+c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
+c
+c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
+c
+c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
+c
+c
+c
+c   alpha4 .         . alpha1    . alpha4
+c    (i,j)             (i,j)       (i+1,j)
+c
+c             P .        U .          . P
+c           (i,j)       (i,j)         (i+1,j)
+c
+c   alpha3 .         . alpha2    .alpha3 
+c    (i,j)              (i,j)     (i+1,j)
+c
+c             V .        Z .          . V
+c           (i,j)
+c
+c   alpha4 .         . alpha1    .alpha4
+c   (i,j+1)            (i,j+1)   (i+1,j+1) 
+c
+c             P .        U .          . P
+c          (i,j+1)                    (i+1,j+1)
+c
+c
+c
+c                       On  a :
+c
+c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
+c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
+c     localise  au point  ... U (i,j) ...
+c
+c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
+c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
+c     localise  au point  ... V (i,j) ...
+c
+c
+c=======================================================================
+
+      DO   100    l = 1 , llm
+c
+        DO  ij = 1, ip1jmp1 - 1
+         massebx(ij,l) =  masse( ij, l) * alpha1p2( ij  )     + 
+     *                   masse(ij+1, l) * alpha3p4(ij+1 )
+        ENDDO
+
+c    .... correction pour massebx( iip1,j) .....
+c    ...    massebx(iip1,j)= massebx(1,j) ...
+c
+CDIR$ IVDEP
+        DO  ij = iip1, ip1jmp1, iip1
+         massebx( ij,l ) = massebx( ij - iim,l )
+        ENDDO
+
+
+         DO  ij = 1,ip1jm
+         masseby( ij,l ) = masse(  ij   , l ) * alpha2p3(   ij    )  +
+     *                     masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
+         ENDDO
+
+100   CONTINUE
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/massbarxy.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/massbarxy.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/massbarxy.F	(revision 2744)
@@ -0,0 +1,44 @@
+      SUBROUTINE massbarxy(  masse, massebxy )
+c
+c **********************************************************************
+c
+c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
+c **********************************************************************
+c    Auteurs : P. Le Van , Fr. Hourdin  .
+c   ..........
+c
+c  ..  masse          est  un  argum. d'entree  pour le s-pg ...
+c  ..  massebxy       est  un  argum. de sortie pour le s-pg ...
+c     
+c
+c     IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+       REAL  masse( ip1jmp1,llm ), massebxy( ip1jm,llm )
+c
+
+      DO l = 1 , llm
+c
+         DO ij = 1, ip1jm - 1
+            massebxy( ij,l ) = masse(    ij  ,l ) * alpha2(   ij    ) +
+     +                      masse(   ij+1 ,l ) * alpha3(  ij+1   ) +
+     +                      masse( ij+iip1,l ) * alpha1( ij+iip1 ) +
+     +                      masse( ij+iip2,l ) * alpha4( ij+iip2 )
+         ENDDO
+
+c    ....  correction pour     massebxy( iip1,j )  ........
+
+CDIR$ IVDEP
+
+         DO ij = iip1, ip1jm, iip1
+            massebxy( ij,l ) = massebxy( ij - iim,l )
+         ENDDO
+
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/massdair.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/massdair.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/massdair.F	(revision 2744)
@@ -0,0 +1,107 @@
+      SUBROUTINE massdair( p, masse )
+c
+c *********************************************************************
+c       ....  Calcule la masse d'air  dans chaque maille   ....
+c *********************************************************************
+c
+c    Auteurs : P. Le Van , Fr. Hourdin  .
+c   ..........
+c
+c  ..    p                      est  un argum. d'entree pour le s-pg ...
+c  ..  masse                    est un  argum.de sortie pour le s-pg ...
+c     
+c  ....  p est defini aux interfaces des llm couches   .....
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+c  .....   arguments  ....
+c
+      REAL p(ip1jmp1,llmp1), masse(ip1jmp1,llm)
+
+c   ....  Variables locales  .....
+
+      INTEGER l,ij
+      REAL massemoyn, massemoys
+
+      REAL SSUM
+      EXTERNAL SSUM
+c
+c
+c   Methode pour calculer massebx et masseby .
+c   ----------------------------------------
+c
+c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
+c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
+c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
+c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
+c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
+c
+c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
+c
+c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
+c
+c
+c
+c   alpha4 .         . alpha1    . alpha4
+c    (i,j)             (i,j)       (i+1,j)
+c
+c             P .        U .          . P
+c           (i,j)       (i,j)         (i+1,j)
+c
+c   alpha3 .         . alpha2    .alpha3 
+c    (i,j)              (i,j)     (i+1,j)
+c
+c             V .        Z .          . V
+c           (i,j)
+c
+c   alpha4 .         . alpha1    .alpha4
+c   (i,j+1)            (i,j+1)   (i+1,j+1) 
+c
+c             P .        U .          . P
+c          (i,j+1)                    (i+1,j+1)
+c
+c
+c
+c                       On  a :
+c
+c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
+c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
+c     localise  au point  ... U (i,j) ...
+c
+c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
+c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
+c     localise  au point  ... V (i,j) ...
+c
+c
+c=======================================================================
+
+      DO   100    l = 1 , llm
+c
+        DO    ij     = 1, ip1jmp1
+         masse(ij,l) = airesurg(ij) * ( p(ij,l) - p(ij,l+1) )
+        ENDDO
+c
+        DO   ij = 1, ip1jmp1,iip1
+         masse(ij+ iim,l) = masse(ij,l)
+        ENDDO
+c
+c       DO    ij     = 1,  iim
+c        masse(   ij   ,l) = masse(   ij   ,l) * aire(  ij    )
+c        masse(ij+ip1jm,l) = masse(ij+ip1jm,l) * aire(ij+ip1jm) 
+c       ENDDO
+c        massemoyn         = SSUM(iim,masse(   1   ,l),1)/ apoln
+c        massemoys         = SSUM(iim,masse(ip1jm+1,l),1)/ apols
+c       DO    ij     = 1, iip1
+c        masse(   ij   ,l )    = massemoyn
+c        masse(ij+ip1jm,l )    = massemoys
+c       ENDDO
+       
+100   CONTINUE
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/minmax.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/minmax.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/minmax.F	(revision 2744)
@@ -0,0 +1,20 @@
+       SUBROUTINE minmax(imax, xi, zmin, zmax )
+c
+c      P. Le Van
+
+       INTEGER imax
+       REAL    xi(imax)
+       REAL    zmin,zmax
+       INTEGER i
+
+       zmin = xi(1)
+       zmax = xi(1)
+
+       DO i = 2, imax
+         zmin = MIN( zmin,xi(i) )
+         zmax = MAX( zmax,xi(i) )
+       ENDDO
+
+       RETURN
+       END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/multipl.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/multipl.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/multipl.F	(revision 2744)
@@ -0,0 +1,17 @@
+      SUBROUTINE multipl(n,x1,x2,y)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   multiplication de deux vecteurs
+c
+c=======================================================================
+c
+      INTEGER n,i
+      REAL x1(n),x2(n),y(n)
+c
+      DO 10 i=1,n
+         y(i)=x1(i)*x2(i)
+10    CONTINUE
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/multscal.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/multscal.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/multscal.F	(revision 2744)
@@ -0,0 +1,9 @@
+      SUBROUTINE multscal(n,x,lambda,y)
+      IMPLICIT NONE
+      INTEGER i,n
+      REAL lambda,x(n),y(n)
+      DO 10 i=1,n
+         y(i)=x(i)*lambda
+10    CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/netcdf.inc
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/netcdf.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/netcdf.inc	(revision 2744)
@@ -0,0 +1,1312 @@
+!
+! netcdf version 3 fortran interface:
+!
+
+!
+! external netcdf data types:
+!
+      integer nf_byte
+      integer nf_int1
+      integer nf_char
+      integer nf_short
+      integer nf_int2
+      integer nf_int
+      integer nf_float
+      integer nf_real
+      integer nf_double
+
+      parameter (nf_byte = 1)
+      parameter (nf_int1 = nf_byte)
+      parameter (nf_char = 2)
+      parameter (nf_short = 3)
+      parameter (nf_int2 = nf_short)
+      parameter (nf_int = 4)
+      parameter (nf_float = 5)
+      parameter (nf_real = nf_float)
+      parameter (nf_double = 6)
+
+!
+! default fill values:
+!
+      integer           nf_fill_byte
+      integer           nf_fill_int1
+      integer           nf_fill_char
+      integer           nf_fill_short
+      integer           nf_fill_int2
+      integer           nf_fill_int
+      real              nf_fill_float
+      real              nf_fill_real
+      doubleprecision   nf_fill_double
+
+      parameter (nf_fill_byte = -127)
+      parameter (nf_fill_int1 = nf_fill_byte)
+      parameter (nf_fill_char = 0)
+      parameter (nf_fill_short = -32767)
+      parameter (nf_fill_int2 = nf_fill_short)
+      parameter (nf_fill_int = -2147483647)
+      parameter (nf_fill_float = 9.9692099683868690e+36)
+      parameter (nf_fill_real = nf_fill_float)
+      parameter (nf_fill_double = 9.9692099683868690e+36)
+
+!
+! mode flags for opening and creating a netcdf dataset:
+!
+      integer nf_nowrite
+      integer nf_write
+      integer nf_clobber
+      integer nf_noclobber
+      integer nf_fill
+      integer nf_nofill
+      integer nf_lock
+      integer nf_share
+      integer nf_sizehint_default
+      integer nf_align_chunk
+
+      parameter (nf_nowrite = 0)
+      parameter (nf_write = 1)
+      parameter (nf_clobber = 0)
+      parameter (nf_noclobber = 4)
+      parameter (nf_fill = 0)
+      parameter (nf_nofill = 256)
+      parameter (nf_lock = 1024)
+      parameter (nf_share = 2048)
+      parameter (nf_sizehint_default = 0)
+      parameter (nf_align_chunk = -1)
+
+!
+! size argument for defining an unlimited dimension:
+!
+      integer nf_unlimited
+      parameter (nf_unlimited = 0)
+
+!
+! global attribute id:
+!
+      integer nf_global
+      parameter (nf_global = 0)
+
+!
+! implementation limits:
+!
+      integer nf_max_dims
+      integer nf_max_attrs
+      integer nf_max_vars
+      integer nf_max_name
+      integer nf_max_var_dims
+
+      parameter (nf_max_dims = 100)
+      parameter (nf_max_attrs = 2000)
+      parameter (nf_max_vars = 2000)
+      parameter (nf_max_name = 128)
+      parameter (nf_max_var_dims = nf_max_dims)
+
+!
+! error codes:
+!
+      integer nf_noerr
+      integer nf_ebadid
+      integer nf_eexist
+      integer nf_einval
+      integer nf_eperm
+      integer nf_enotindefine
+      integer nf_eindefine
+      integer nf_einvalcoords
+      integer nf_emaxdims
+      integer nf_enameinuse
+      integer nf_enotatt
+      integer nf_emaxatts
+      integer nf_ebadtype
+      integer nf_ebaddim
+      integer nf_eunlimpos
+      integer nf_emaxvars
+      integer nf_enotvar
+      integer nf_eglobal
+      integer nf_enotnc
+      integer nf_ests
+      integer nf_emaxname
+      integer nf_eunlimit
+      integer nf_enorecvars
+      integer nf_echar
+      integer nf_eedge
+      integer nf_estride
+      integer nf_ebadname
+      integer nf_erange
+      integer nf_enomem
+
+      parameter (nf_noerr = 0)
+      parameter (nf_ebadid = -33)
+      parameter (nf_eexist = -35)
+      parameter (nf_einval = -36)
+      parameter (nf_eperm = -37)
+      parameter (nf_enotindefine = -38)
+      parameter (nf_eindefine = -39)
+      parameter (nf_einvalcoords = -40)
+      parameter (nf_emaxdims = -41)
+      parameter (nf_enameinuse = -42)
+      parameter (nf_enotatt = -43)
+      parameter (nf_emaxatts = -44)
+      parameter (nf_ebadtype = -45)
+      parameter (nf_ebaddim = -46)
+      parameter (nf_eunlimpos = -47)
+      parameter (nf_emaxvars = -48)
+      parameter (nf_enotvar = -49)
+      parameter (nf_eglobal = -50)
+      parameter (nf_enotnc = -51)
+      parameter (nf_ests = -52)
+      parameter (nf_emaxname = -53)
+      parameter (nf_eunlimit = -54)
+      parameter (nf_enorecvars = -55)
+      parameter (nf_echar = -56)
+      parameter (nf_eedge = -57)
+      parameter (nf_estride = -58)
+      parameter (nf_ebadname = -59)
+      parameter (nf_erange = -60)
+      parameter (nf_enomem = -61)
+
+!
+! error handling modes:
+!
+      integer  nf_fatal
+      integer nf_verbose
+
+      parameter (nf_fatal = 1)
+      parameter (nf_verbose = 2)
+
+!
+! miscellaneous routines:
+!
+      character*80   nf_inq_libvers
+      external       nf_inq_libvers
+
+      character*80   nf_strerror
+!                         (integer             ncerr)
+      external       nf_strerror
+
+      logical        nf_issyserr
+!                         (integer             ncerr)
+      external       nf_issyserr
+
+!
+! control routines:
+!
+      integer         nf_inq_base_pe
+!                         (integer             ncid,
+!                          integer             pe)
+      external        nf_inq_base_pe
+
+      integer         nf_set_base_pe
+!                         (integer             ncid,
+!                          integer             pe)
+      external        nf_set_base_pe
+
+      integer         nf_create
+!                         (character*(*)       path,
+!                          integer             cmode,
+!                          integer             ncid)
+      external        nf_create
+
+      integer         nf__create
+!                         (character*(*)       path,
+!                          integer             cmode,
+!                          integer             initialsz,
+!                          integer             chunksizehint,
+!                          integer             ncid)
+      external        nf__create
+
+      integer         nf__create_mp
+!                         (character*(*)       path,
+!                          integer             cmode,
+!                          integer             initialsz,
+!                          integer             basepe,
+!                          integer             chunksizehint,
+!                          integer             ncid)
+      external        nf__create_mp
+
+      integer         nf_open
+!                         (character*(*)       path,
+!                          integer             mode,
+!                          integer             ncid)
+      external        nf_open
+
+      integer         nf__open
+!                         (character*(*)       path,
+!                          integer             mode,
+!                          integer             chunksizehint,
+!                          integer             ncid)
+      external        nf__open
+
+      integer         nf__open_mp
+!                         (character*(*)       path,
+!                          integer             mode,
+!                          integer             basepe,
+!                          integer             chunksizehint,
+!                          integer             ncid)
+      external        nf__open_mp
+
+      integer         nf_set_fill
+!                         (integer             ncid,
+!                          integer             fillmode,
+!                          integer             old_mode)
+      external        nf_set_fill
+
+      integer         nf_redef
+!                         (integer             ncid)
+      external        nf_redef
+
+      integer         nf_enddef
+!                         (integer             ncid)
+      external        nf_enddef
+
+      integer         nf__enddef
+!                         (integer             ncid,
+!                          integer             h_minfree,
+!                          integer             v_align,
+!                          integer             v_minfree,
+!                          integer             r_align)
+      external        nf__enddef
+
+      integer         nf_sync
+!                         (integer             ncid)
+      external        nf_sync
+
+      integer         nf_abort
+!                         (integer             ncid)
+      external        nf_abort
+
+      integer         nf_close
+!                         (integer             ncid)
+      external        nf_close
+
+      integer         nf_delete
+!                         (character*(*)       ncid)
+      external        nf_delete
+
+!
+! general inquiry routines:
+!
+
+      integer         nf_inq
+!                         (integer             ncid,
+!                          integer             ndims,
+!                          integer             nvars,
+!                          integer             ngatts,
+!                          integer             unlimdimid)
+      external        nf_inq
+
+      integer         nf_inq_ndims
+!                         (integer             ncid,
+!                          integer             ndims)
+      external        nf_inq_ndims
+
+      integer         nf_inq_nvars
+!                         (integer             ncid,
+!                          integer             nvars)
+      external        nf_inq_nvars
+
+      integer         nf_inq_natts
+!                         (integer             ncid,
+!                          integer             ngatts)
+      external        nf_inq_natts
+
+      integer         nf_inq_unlimdim
+!                         (integer             ncid,
+!                          integer             unlimdimid)
+      external        nf_inq_unlimdim
+
+!
+! dimension routines:
+!
+
+      integer         nf_def_dim
+!                         (integer             ncid,
+!                          character(*)        name,
+!                          integer             len,
+!                          integer             dimid)
+      external        nf_def_dim
+
+      integer         nf_inq_dimid
+!                         (integer             ncid,
+!                          character(*)        name,
+!                          integer             dimid)
+      external        nf_inq_dimid
+
+      integer         nf_inq_dim
+!                         (integer             ncid,
+!                          integer             dimid,
+!                          character(*)        name,
+!                          integer             len)
+      external        nf_inq_dim
+
+      integer         nf_inq_dimname
+!                         (integer             ncid,
+!                          integer             dimid,
+!                          character(*)        name)
+      external        nf_inq_dimname
+
+      integer         nf_inq_dimlen
+!                         (integer             ncid,
+!                          integer             dimid,
+!                          integer             len)
+      external        nf_inq_dimlen
+
+      integer         nf_rename_dim
+!                         (integer             ncid,
+!                          integer             dimid,
+!                          character(*)        name)
+      external        nf_rename_dim
+
+!
+! general attribute routines:
+!
+
+      integer         nf_inq_att
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             xtype,
+!                          integer             len)
+      external        nf_inq_att
+
+      integer         nf_inq_attid
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             attnum)
+      external        nf_inq_attid
+
+      integer         nf_inq_atttype
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             xtype)
+      external        nf_inq_atttype
+
+      integer         nf_inq_attlen
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             len)
+      external        nf_inq_attlen
+
+      integer         nf_inq_attname
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             attnum,
+!                          character(*)        name)
+      external        nf_inq_attname
+
+      integer         nf_copy_att
+!                         (integer             ncid_in,
+!                          integer             varid_in,
+!                          character(*)        name,
+!                          integer             ncid_out,
+!                          integer             varid_out)
+      external        nf_copy_att
+
+      integer         nf_rename_att
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        curname,
+!                          character(*)        newname)
+      external        nf_rename_att
+
+      integer         nf_del_att
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name)
+      external        nf_del_att
+
+!
+! attribute put/get routines:
+!
+
+      integer         nf_put_att_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             len,
+!                          character(*)        text)
+      external        nf_put_att_text
+
+      integer         nf_get_att_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          character(*)        text)
+      external        nf_get_att_text
+
+      integer         nf_put_att_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             xtype,
+!                          integer             len,
+!                          nf_int1_t           i1vals(1))
+      external        nf_put_att_int1
+
+      integer         nf_get_att_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          nf_int1_t           i1vals(1))
+      external        nf_get_att_int1
+
+      integer         nf_put_att_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             xtype,
+!                          integer             len,
+!                          nf_int2_t           i2vals(1))
+      external        nf_put_att_int2
+
+      integer         nf_get_att_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          nf_int2_t           i2vals(1))
+      external        nf_get_att_int2
+
+      integer         nf_put_att_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             xtype,
+!                          integer             len,
+!                          integer             ivals(1))
+      external        nf_put_att_int
+
+      integer         nf_get_att_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             ivals(1))
+      external        nf_get_att_int
+
+      integer         nf_put_att_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             xtype,
+!                          integer             len,
+!                          real                rvals(1))
+      external        nf_put_att_real
+
+      integer         nf_get_att_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          real                rvals(1))
+      external        nf_get_att_real
+
+      integer         nf_put_att_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             xtype,
+!                          integer             len,
+!                          double              dvals(1))
+      external        nf_put_att_double
+
+      integer         nf_get_att_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          double              dvals(1))
+      external        nf_get_att_double
+
+!
+! general variable routines:
+!
+
+      integer         nf_def_var
+!                         (integer             ncid,
+!                          character(*)        name,
+!                          integer             datatype,
+!                          integer             ndims,
+!                          integer             dimids(1),
+!                          integer             varid)
+      external        nf_def_var
+
+      integer         nf_inq_var
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name,
+!                          integer             datatype,
+!                          integer             ndims,
+!                          integer             dimids(1),
+!                          integer             natts)
+      external        nf_inq_var
+
+      integer         nf_inq_varid
+!                         (integer             ncid,
+!                          character(*)        name,
+!                          integer             varid)
+      external        nf_inq_varid
+
+      integer         nf_inq_varname
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name)
+      external        nf_inq_varname
+
+      integer         nf_inq_vartype
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             xtype)
+      external        nf_inq_vartype
+
+      integer         nf_inq_varndims
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             ndims)
+      external        nf_inq_varndims
+
+      integer         nf_inq_vardimid
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             dimids(1))
+      external        nf_inq_vardimid
+
+      integer         nf_inq_varnatts
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             natts)
+      external        nf_inq_varnatts
+
+      integer         nf_rename_var
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        name)
+      external        nf_rename_var
+
+      integer         nf_copy_var
+!                         (integer             ncid_in,
+!                          integer             varid,
+!                          integer             ncid_out)
+      external        nf_copy_var
+
+!
+! entire variable put/get routines:
+!
+
+      integer         nf_put_var_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        text)
+      external        nf_put_var_text
+
+      integer         nf_get_var_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          character(*)        text)
+      external        nf_get_var_text
+
+      integer         nf_put_var_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          nf_int1_t           i1vals(1))
+      external        nf_put_var_int1
+
+      integer         nf_get_var_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          nf_int1_t           i1vals(1))
+      external        nf_get_var_int1
+
+      integer         nf_put_var_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          nf_int2_t           i2vals(1))
+      external        nf_put_var_int2
+
+      integer         nf_get_var_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          nf_int2_t           i2vals(1))
+      external        nf_get_var_int2
+
+      integer         nf_put_var_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             ivals(1))
+      external        nf_put_var_int
+
+      integer         nf_get_var_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             ivals(1))
+      external        nf_get_var_int
+
+      integer         nf_put_var_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          real                rvals(1))
+      external        nf_put_var_real
+
+      integer         nf_get_var_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          real                rvals(1))
+      external        nf_get_var_real
+
+      integer         nf_put_var_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          doubleprecision     dvals(1))
+      external        nf_put_var_double
+
+      integer         nf_get_var_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          doubleprecision     dvals(1))
+      external        nf_get_var_double
+
+!
+! single variable put/get routines:
+!
+
+      integer         nf_put_var1_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          character*1         text)
+      external        nf_put_var1_text
+
+      integer         nf_get_var1_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          character*1         text)
+      external        nf_get_var1_text
+
+      integer         nf_put_var1_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          nf_int1_t           i1val)
+      external        nf_put_var1_int1
+
+      integer         nf_get_var1_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          nf_int1_t           i1val)
+      external        nf_get_var1_int1
+
+      integer         nf_put_var1_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          nf_int2_t           i2val)
+      external        nf_put_var1_int2
+
+      integer         nf_get_var1_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          nf_int2_t           i2val)
+      external        nf_get_var1_int2
+
+      integer         nf_put_var1_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          integer             ival)
+      external        nf_put_var1_int
+
+      integer         nf_get_var1_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          integer             ival)
+      external        nf_get_var1_int
+
+      integer         nf_put_var1_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          real                rval)
+      external        nf_put_var1_real
+
+      integer         nf_get_var1_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          real                rval)
+      external        nf_get_var1_real
+
+      integer         nf_put_var1_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          doubleprecision     dval)
+      external        nf_put_var1_double
+
+      integer         nf_get_var1_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             index(1),
+!                          doubleprecision     dval)
+      external        nf_get_var1_double
+
+!
+! variable array put/get routines:
+!
+
+      integer         nf_put_vara_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          character(*)        text)
+      external        nf_put_vara_text
+
+      integer         nf_get_vara_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          character(*)        text)
+      external        nf_get_vara_text
+
+      integer         nf_put_vara_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          nf_int1_t           i1vals(1))
+      external        nf_put_vara_int1
+
+      integer         nf_get_vara_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          nf_int1_t           i1vals(1))
+      external        nf_get_vara_int1
+
+      integer         nf_put_vara_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          nf_int2_t           i2vals(1))
+      external        nf_put_vara_int2
+
+      integer         nf_get_vara_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          nf_int2_t           i2vals(1))
+      external        nf_get_vara_int2
+
+      integer         nf_put_vara_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             ivals(1))
+      external        nf_put_vara_int
+
+      integer         nf_get_vara_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             ivals(1))
+      external        nf_get_vara_int
+
+      integer         nf_put_vara_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          real                rvals(1))
+      external        nf_put_vara_real
+
+      integer         nf_get_vara_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          real                rvals(1))
+      external        nf_get_vara_real
+
+      integer         nf_put_vara_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          doubleprecision     dvals(1))
+      external        nf_put_vara_double
+
+      integer         nf_get_vara_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          doubleprecision     dvals(1))
+      external        nf_get_vara_double
+
+!
+! strided variable put/get routines:
+!
+
+      integer         nf_put_vars_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          character(*)        text)
+      external        nf_put_vars_text
+
+      integer         nf_get_vars_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          character(*)        text)
+      external        nf_get_vars_text
+
+      integer         nf_put_vars_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          nf_int1_t           i1vals(1))
+      external        nf_put_vars_int1
+
+      integer         nf_get_vars_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          nf_int1_t           i1vals(1))
+      external        nf_get_vars_int1
+
+      integer         nf_put_vars_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          nf_int2_t           i2vals(1))
+      external        nf_put_vars_int2
+
+      integer         nf_get_vars_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          nf_int2_t           i2vals(1))
+      external        nf_get_vars_int2
+
+      integer         nf_put_vars_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             ivals(1))
+      external        nf_put_vars_int
+
+      integer         nf_get_vars_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             ivals(1))
+      external        nf_get_vars_int
+
+      integer         nf_put_vars_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          real                rvals(1))
+      external        nf_put_vars_real
+
+      integer         nf_get_vars_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          real                rvals(1))
+      external        nf_get_vars_real
+
+      integer         nf_put_vars_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          doubleprecision     dvals(1))
+      external        nf_put_vars_double
+
+      integer         nf_get_vars_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          doubleprecision     dvals(1))
+      external        nf_get_vars_double
+
+!
+! mapped variable put/get routines:
+!
+
+      integer         nf_put_varm_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          character(*)        text)
+      external        nf_put_varm_text
+
+      integer         nf_get_varm_text
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          character(*)        text)
+      external        nf_get_varm_text
+
+      integer         nf_put_varm_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          nf_int1_t           i1vals(1))
+      external        nf_put_varm_int1
+
+      integer         nf_get_varm_int1
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          nf_int1_t           i1vals(1))
+      external        nf_get_varm_int1
+
+      integer         nf_put_varm_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          nf_int2_t           i2vals(1))
+      external        nf_put_varm_int2
+
+      integer         nf_get_varm_int2
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          nf_int2_t           i2vals(1))
+      external        nf_get_varm_int2
+
+      integer         nf_put_varm_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          integer             ivals(1))
+      external        nf_put_varm_int
+
+      integer         nf_get_varm_int
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          integer             ivals(1))
+      external        nf_get_varm_int
+
+      integer         nf_put_varm_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          real                rvals(1))
+      external        nf_put_varm_real
+
+      integer         nf_get_varm_real
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          real                rvals(1))
+      external        nf_get_varm_real
+
+      integer         nf_put_varm_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          doubleprecision     dvals(1))
+      external        nf_put_varm_double
+
+      integer         nf_get_varm_double
+!                         (integer             ncid,
+!                          integer             varid,
+!                          integer             start(1),
+!                          integer             count(1),
+!                          integer             stride(1),
+!                          integer             imap(1),
+!                          doubleprecision     dvals(1))
+      external        nf_get_varm_double
+
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! begin netcdf 2.4 backward compatibility:
+!
+
+!      
+! functions in the fortran interface
+!
+      integer nccre
+      integer ncopn
+      integer ncddef
+      integer ncdid
+      integer ncvdef
+      integer ncvid
+      integer nctlen
+      integer ncsfil
+
+      external nccre
+      external ncopn
+      external ncddef
+      external ncdid
+      external ncvdef
+      external ncvid
+      external nctlen
+      external ncsfil
+
+
+      integer ncrdwr
+      integer nccreat
+      integer ncexcl
+      integer ncindef
+      integer ncnsync
+      integer nchsync
+      integer ncndirty
+      integer nchdirty
+      integer nclink
+      integer ncnowrit
+      integer ncwrite
+      integer ncclob
+      integer ncnoclob
+      integer ncglobal
+      integer ncfill
+      integer ncnofill
+      integer maxncop
+      integer maxncdim
+      integer maxncatt
+      integer maxncvar
+      integer maxncnam
+      integer maxvdims
+      integer ncnoerr
+      integer ncebadid
+      integer ncenfile
+      integer nceexist
+      integer nceinval
+      integer nceperm
+      integer ncenotin
+      integer nceindef
+      integer ncecoord
+      integer ncemaxds
+      integer ncename
+      integer ncenoatt
+      integer ncemaxat
+      integer ncebadty
+      integer ncebadd
+      integer ncests
+      integer nceunlim
+      integer ncemaxvs
+      integer ncenotvr
+      integer nceglob
+      integer ncenotnc
+      integer ncfoobar
+      integer ncsyserr
+      integer ncfatal
+      integer ncverbos
+      integer ncentool
+
+
+!
+! netcdf data types:
+!
+      integer ncbyte
+      integer ncchar
+      integer ncshort
+      integer nclong
+      integer ncfloat
+      integer ncdouble
+
+      parameter(ncbyte = 1)
+      parameter(ncchar = 2)
+      parameter(ncshort = 3)
+      parameter(nclong = 4)
+      parameter(ncfloat = 5)
+      parameter(ncdouble = 6)
+
+!     
+!     masks for the struct nc flag field; passed in as 'mode' arg to
+!     nccreate and ncopen.
+!     
+
+!     read/write, 0 => readonly 
+      parameter(ncrdwr = 1)
+!     in create phase, cleared by ncendef 
+      parameter(nccreat = 2)
+!     on create destroy existing file 
+      parameter(ncexcl = 4)
+!     in define mode, cleared by ncendef 
+      parameter(ncindef = 8)
+!     synchronise numrecs on change (x'10')
+      parameter(ncnsync = 16)
+!     synchronise whole header on change (x'20')
+      parameter(nchsync = 32)
+!     numrecs has changed (x'40')
+      parameter(ncndirty = 64)  
+!     header info has changed (x'80')
+      parameter(nchdirty = 128)
+!     prefill vars on endef and increase of record, the default behavior
+      parameter(ncfill = 0)
+!     do not fill vars on endef and increase of record (x'100')
+      parameter(ncnofill = 256)
+!     isa link (x'8000')
+      parameter(nclink = 32768)
+
+!     
+!     'mode' arguments for nccreate and ncopen
+!     
+      parameter(ncnowrit = 0)
+      parameter(ncwrite = ncrdwr)
+      parameter(ncclob = nf_clobber)
+      parameter(ncnoclob = nf_noclobber)
+
+!     
+!     'size' argument to ncdimdef for an unlimited dimension
+!     
+      integer ncunlim
+      parameter(ncunlim = 0)
+
+!     
+!     attribute id to put/get a global attribute
+!     
+      parameter(ncglobal  = 0)
+
+!     
+!     advisory maximums:
+!     
+      parameter(maxncop = 32)
+      parameter(maxncdim = 100)
+      parameter(maxncatt = 2000)
+      parameter(maxncvar = 2000)
+!     not enforced 
+      parameter(maxncnam = 128)
+      parameter(maxvdims = maxncdim)
+
+!     
+!     global netcdf error status variable
+!     initialized in error.c
+!     
+
+!     no error 
+      parameter(ncnoerr = nf_noerr)
+!     not a netcdf id 
+      parameter(ncebadid = nf_ebadid)
+!     too many netcdfs open 
+      parameter(ncenfile = -31)   ! nc_syserr
+!     netcdf file exists && ncnoclob
+      parameter(nceexist = nf_eexist)
+!     invalid argument 
+      parameter(nceinval = nf_einval)
+!     write to read only 
+      parameter(nceperm = nf_eperm)
+!     operation not allowed in data mode 
+      parameter(ncenotin = nf_enotindefine )   
+!     operation not allowed in define mode 
+      parameter(nceindef = nf_eindefine)   
+!     coordinates out of domain 
+      parameter(ncecoord = nf_einvalcoords)
+!     maxncdims exceeded 
+      parameter(ncemaxds = nf_emaxdims)
+!     string match to name in use 
+      parameter(ncename = nf_enameinuse)   
+!     attribute not found 
+      parameter(ncenoatt = nf_enotatt)
+!     maxncattrs exceeded 
+      parameter(ncemaxat = nf_emaxatts)
+!     not a netcdf data type 
+      parameter(ncebadty = nf_ebadtype)
+!     invalid dimension id 
+      parameter(ncebadd = nf_ebaddim)
+!     ncunlimited in the wrong index 
+      parameter(nceunlim = nf_eunlimpos)
+!     maxncvars exceeded 
+      parameter(ncemaxvs = nf_emaxvars)
+!     variable not found 
+      parameter(ncenotvr = nf_enotvar)
+!     action prohibited on ncglobal varid 
+      parameter(nceglob = nf_eglobal)
+!     not a netcdf file 
+      parameter(ncenotnc = nf_enotnc)
+      parameter(ncests = nf_ests)
+      parameter (ncentool = nf_emaxname) 
+      parameter(ncfoobar = 32)
+      parameter(ncsyserr = -31)
+
+!     
+!     global options variable. used to determine behavior of error handler.
+!     initialized in lerror.c
+!     
+      parameter(ncfatal = 1)
+      parameter(ncverbos = 2)
+
+!
+!     default fill values.  these must be the same as in the c interface.
+!
+      integer filbyte
+      integer filchar
+      integer filshort
+      integer fillong
+      real filfloat
+      doubleprecision fildoub
+
+      parameter (filbyte = -127)
+      parameter (filchar = 0)
+      parameter (filshort = -32767)
+      parameter (fillong = -2147483647)
+      parameter (filfloat = 9.9692099683868690e+36)
+      parameter (fildoub = 9.9692099683868690e+36)
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/newstart.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/newstart.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/newstart.F	(revision 2744)
@@ -0,0 +1,919 @@
+C======================================================================
+      PROGRAM newstart
+c=======================================================================
+c
+c
+c   Auteur:   Christophe Hourdin/Francois Forget/Yann Wanherdrick
+c   ------
+c             Derniere modif : 12/03
+c
+c
+c   Objet:  Create or modify the initial state for the LMD Mars GCM
+c   -----           (fichiers NetCDF start et startfi)
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "surfdat.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "planete.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "control.h"
+#include "logic.h"
+#include "description.h"
+#include "ener.h"
+#include "temps.h"
+#include "lmdstd.h"
+#include "comdissnew.h"
+#include "clesph0.h"
+#include "serre.h"
+#include "netcdf.inc"
+
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+c Variables dimension du fichier "start_archive"
+c------------------------------------
+      CHARACTER	relief*3
+
+c et autres:
+c----------
+      INTEGER lnblnk
+      EXTERNAL lnblnk
+
+c Variables pour les lectures NetCDF des fichiers "start_archive" 
+c--------------------------------------------------
+      INTEGER nid_dyn, nid_fi,nid,nvarid
+      INTEGER size
+      INTEGER length
+      parameter (length = 100)
+      INTEGER tab0
+      INTEGER   NB_ETATMAX
+      parameter (NB_ETATMAX = 100)
+
+      REAL  date
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL phis(iip1,jjp1)
+      REAL q(iip1,jjp1,llm,nqmx)               ! champs advectes
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+      REAL pks(iip1,jjp1)
+      REAL w(iip1,jjp1,llm+1)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
+      REAL phi(iip1,jjp1,llm)
+
+      integer klatdat,klongdat
+      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+
+c variable physique
+c------------------
+      REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx),co2ice(ngridmx)
+      REAL emis(ngridmx),qsurf(ngridmx,nqmx)
+      REAL q2(ngridmx,nlayermx+1)
+      REAL rnaturfi(ngridmx)
+      real alb(iip1,jjp1),albfi(ngridmx)
+      real ith(iip1,jjp1),ithfi(ngridmx)
+      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
+
+      INTEGER i,j,l,idum,ig
+      real mugaz ! masse molaire de l''atmosphere
+
+      EXTERNAL iniconst,geopot,inigeom
+      integer ierr, nbetat
+      integer ismin
+      external ismin
+
+c Variable nouvelle grille naturelle au point scalaire
+c------------------------------------------------------
+      REAL p(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      real phisold_newgrid(iip1,jjp1)
+      REAL :: teta(iip1, jjp1, llm)
+      REAL :: pk(iip1,jjp1,llm)
+      REAL :: pkf(iip1,jjp1,llm)
+      REAL :: ps(iip1, jjp1)
+      REAL :: masse(iip1,jjp1,llm)
+      REAL :: xpn,xps,xppn(iim),xpps(iim)
+      REAL :: p3d(iip1, jjp1, llm+1)
+      REAL :: beta(iip1,jjp1,llm)
+      REAL dteta(ip1jmp1,llm)
+
+c Variable de l'ancienne grille 
+c------------------------------
+      real time
+      real tab_cntrl(100)
+      real tab_cntrl_bis(100)
+
+c variables diverses
+c-------------------
+      real choix_1
+      character*80      fichnom
+      integer Lmodif,iq,thermo
+      character modif*20
+      real z_reel(iip1,jjp1)
+      real tsud,albsud,alb_bb,ith_bb,Tiso
+      real ptoto,pcap,patm,airetot,ptotn,patmn
+      real ssum
+      character*1 yes
+      logical :: flagiso=.false.
+      real val
+
+      INTEGER :: itau
+
+c sortie visu pour les champs dynamiques
+c---------------------------------------
+      INTEGER :: visuid
+      real :: time_step,t_ops,t_wrt
+      CHARACTER*80 :: visu_file
+
+      cpp    = 744.499 ! au lieu de 1004.70885 (Terre)
+      preff  = 610.    ! au lieu de 101325. (Terre)
+      pa= 20           ! au lieu de 500 (Terre)
+
+c=======================================================================
+c   Choix du fichier de demarrage a modifier
+c=======================================================================
+
+      write(*,*) 'A partir de quoi souhaitez vous creer vos etats',
+     .                  ' initiaux ?'
+      write(*,*) '    0 - d un fichier start_archive'
+      write(*,*) '    1 - d un fichier start'
+ 
+c-----------------------------------------------------------------------
+c   Ouverture des fichiers a modifier (start ou start_archive)
+c-----------------------------------------------------------------------
+
+      DO
+         read(*,*,iostat=ierr) choix_1
+         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
+      ENDDO
+
+c     Ouverture de start_archive
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Creation d un etat initial a partir de'
+        write(*,*) './start_archive.dat et ./start_archive.dic'
+        write(*,*)
+        fichnom = 'start_archive.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Pb d''ouverture du fichier ',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+        tab0 = 50 
+        Lmodif = 1
+
+c     OU Ouverture de start
+c     ~~~~~~~~~~~~~~~~~~~~~
+      else
+        write(*,*) 'Creation d un etat initial a partir de'
+        write(*,*) './start.nc et ./startfi.nc'
+        write(*,*)
+        fichnom = 'start.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Pb d''ouverture du fichier ',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+ 
+        fichnom = 'startfi.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Pb d''ouverture du fichier ',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+
+        tab0 = 0 
+        Lmodif = 0
+
+      endif
+
+c-----------------------------------------------------------------------
+c Lecture du tableau des parametres du run (pour la dynamique)
+c-----------------------------------------------------------------------
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'lecture tab_cntrl START_ARCHIVE'
+c
+        ierr = NF_INQ_VARID (nid, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+c
+      else if (choix_1.eq.1) then
+
+        write(*,*) 'lecture tab_cntrl START'
+c
+        ierr = NF_INQ_VARID (nid_dyn, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_dyn, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid_dyn, nvarid, tab_cntrl)
+#endif
+c
+        write(*,*) 'lecture tab_cntrl STARTFI'
+c
+        ierr = NF_INQ_VARID (nid_fi, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_fi, nvarid, tab_cntrl_bis)
+#else
+        ierr = NF_GET_VAR_REAL(nid_fi, nvarid, tab_cntrl_bis)
+#endif
+c
+        do i=1,50
+          tab_cntrl(i+50)=tab_cntrl_bis(i)
+        enddo
+      write(*,*) 'Impression de tab_cntrl', tab_cntrl
+      do i=1,100
+        write(*,*) i,tab_cntrl(i)
+      enddo
+      
+      endif
+c-----------------------------------------------------------------------
+c		Initialisation des constantes dynamique
+c-----------------------------------------------------------------------
+
+      kappa = tab_cntrl(9) 
+      etot0 = tab_cntrl(12)
+      ptot0 = tab_cntrl(13)
+      ztot0 = tab_cntrl(14)
+      stot0 = tab_cntrl(15)
+      ang0 = tab_cntrl(16)
+      write(*,*) "kappa,etot0,ptot0,ztot0,stot0,ang0"
+      write(*,*) kappa,etot0,ptot0,ztot0,stot0,ang0
+
+c-----------------------------------------------------------------------
+c   Lecture du tab_cntrl et initialisation des constantes physiques
+c  - pour start:  Lmodif = 0 => pas de modifications possibles
+c                  (modif dans le tabfi de readfi + loin)
+c  - pour start_archive:  Lmodif = 1 => modifications possibles
+c-----------------------------------------------------------------------
+      if (choix_1.eq.0) then
+         call tabfi (nid,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_mugaz,p_daysec,time)
+      else if (choix_1.eq.1) then
+         call tabfi (nid_fi,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_mugaz,p_daysec,time)
+      endif
+
+      rad = p_rad
+      omeg = p_omeg
+      g = p_g
+      mugaz = p_mugaz
+      daysec = p_daysec
+      write(*,*) 'aire',aire
+
+
+c=======================================================================
+c  INITIALISATIONS DIVERSES
+c=======================================================================
+
+      day_step=180
+      CALL defrun_new( 99, .TRUE. )
+      CALL iniconst 
+      CALL inigeom
+      idum=-1
+      idum=0
+
+c Initialisation coordonnees /aires
+c -------------------------------
+
+      latfi(1)=rlatu(1)
+      lonfi(1)=0.
+      DO j=2,jjm
+         DO i=1,iim
+            latfi((j-2)*iim+1+i)=rlatu(j)
+            lonfi((j-2)*iim+1+i)=rlonv(i)
+         ENDDO
+      ENDDO
+      latfi(ngridmx)=rlatu(jjp1)
+      lonfi(ngridmx)=0.
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+
+
+c=======================================================================
+c  Lecture des fichiers (start ou start_archive)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'lecture Fichier START_ARCHIVE'
+        CALL lect_start_archive(date,tsurf,tsoil,emis,q2,
+     .   t,ucov,vcov,ps,co2ice,teta,phisold_newgrid,q,qsurf,nid)
+        
+        ierr= NF_CLOSE(nid)
+
+      else if (choix_1.eq.1) then !  c'est l'appel a tabfi de phyeta0 qui
+                                  !  permet de changer les valeurs du 
+                                  !  tab_cntrl Lmodif=1
+        tab0=0
+        Lmodif=1 ! Lmodif set to 1 to allow modifications in phyeta0                           
+        write(*,*) 'lecture Fichier START'
+        fichnom = 'start.nc'
+        CALL dynetat0(fichnom,nqmx,vcov,ucov,teta,q,masse,
+     .       ps,phis,time)
+
+        write(*,*) 'lecture Fichier STARTFI'
+        fichnom = 'startfi.nc'
+        CALL phyetat0 (fichnom,tab0,Lmodif,nsoilmx,nqmx,
+     .        day_ini,time,
+     .        tsurf,tsoil,emis,q2,qsurf,co2ice)
+        
+        do i=1,ngridmx
+          albfi(i) = albedodat(i)
+          ithfi(i) = inertiedat(i)
+        enddo
+
+      else 
+        CALL exit(1)
+      endif
+
+      dtvr   = daysec/FLOAT(day_step)
+      dtphys   = dtvr * FLOAT(iphysiq)
+
+c=======================================================================
+c   lecture topographie, albedo, inertie thermique, relief sous-maille
+c=======================================================================
+
+      if (choix_1.ne.1) then  ! pour ne pas avoir besoin du fichier 
+                              ! surface.dat dans le cas des start
+
+c do while((relief(1:3).ne.'mol').AND.(relief(1:3).ne.'pla'))
+c       write(*,*)
+c       write(*,*) 'choix du relief (mola,pla)'
+c       write(*,*) '(Topographie MGS MOLA, plat)'
+c       read(*,fmt='(a3)') relief
+        relief="mola"
+c     enddo
+
+      CALL datareadnc(relief,phis,alb,ith,zmeaS,zstdS,zsigS,zgamS,
+     .          ztheS)
+
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zmeaS,zmea)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zstdS,zstd)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zsigS,zsig)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zgamS,zgam)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ztheS,zthe)
+
+      endif
+
+c=======================================================================
+c 
+c=======================================================================
+ 
+ 888  continue
+
+      write(*,*)
+      write(*,*)
+      write(*,*) 'Autres Modifications possibles :'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*)
+      write(*,*) 'flat : no topography ("aquaplanet")'
+      write(*,*) 'bilball : albedo, inertie thermique uniforme'
+      write(*,*) 'coldspole : sous sol froid et haut albedo au pole sud'
+      write(*,*) 'q=0 : ALL tracer =zero'
+      write(*,*) 'q=x : give a specific uniform value to one tracer'
+      write(*,*) 'ini_q : tracers initialisation for chemistry, water an
+     $d ice   '
+      write(*,*) 'ini_q-H2O : tracers initialisation for chemistry and 
+     $ice '
+      write(*,*) 'ini_q-iceH2O : tracers initialisation for chemistry on
+     $ly '
+      write(*,*) 'watercapn : H20 ice sur la calotte permanente nord '
+      write(*,*) 'watercaps : H20 ice sur la calotte permanente sud '
+      write(*,*) 'wetstart  : start with a wet atmosphere'
+      write(*,*) 'isotherm : Temperatures isothermes et vents nuls '
+      write(*,*) 'co2ice=0 : elimination des calottes polaires de CO2'
+      write(*,*) 'ptot : pression totale'
+
+
+      do while(modif(1:1).ne.'hello')
+        write(*,*)
+        write(*,*) 'modification a faire ?'
+        write(*,*) '   (entrer le mot cle ou return pour finir)'
+        write(*,*)
+
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ') goto 999
+        write(*,*)
+        write(*,*) modif(1:lnblnk(modif)) , ' : '
+
+c       'flat : no topography ("aquaplanet")'
+c       -------------------------------------
+        if (modif(1:lnblnk(modif)) .eq. 'flat') then
+          CALL initial0(ip1jmp1,z_reel)
+          CALL multscal(ip1jmp1,z_reel,g,phis)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+          write(*,*) 'topography set to zero.'
+          write(*,*) 'WARNING : the subgrid topography parameters',
+     &    ' were not set to zero ! => set calllott to F'                    
+          if (choix_1.ne.0) then
+              write(*,*)'WARNING : reading start, the pressure is not'
+     &                  ,' corrected for topography change'
+              write(*,*) '=> you should start with start_archive !'
+          end if
+
+c       bilball : albedo, inertie thermique uniforme
+c       --------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'bilball') then
+          write(*,*) 'Valeur constante pour albedo et iner.therm:'
+          write(*,*) 'Nouvelle valeur pour albedo (ex: 0.25) ?'
+ 101      read(*,*,iostat=ierr) alb_bb
+          if(ierr.ne.0) goto 101
+          write(*,*)
+          write(*,*) ' albedo uniforme (nouvelle valeur):',alb_bb
+          write(*,*)
+
+          write(*,*) 'Nouvelle valeur pour iner.therm (ex: 247) ?'
+ 102      read(*,*,iostat=ierr) ith_bb
+          if(ierr.ne.0) goto 102
+          write(*,*) 'iner.therm uniforme (nouvelle valeur):',ith_bb
+          DO j=1,jjp1
+             DO i=1,iip1
+                alb(i,j) = alb_bb
+                ith(i,j) = ith_bb
+             END DO
+          END DO
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+c       coldspole : sous-sol de la calotte sud toujours froid
+c       -----------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'coldspole') then
+          write(*,*)'nouvelle valeur de la temperature du',
+     &   'sous sol de la calotte permanente sud ? (ex: 141 K)'
+ 103      read(*,*,iostat=ierr) tsud
+          if(ierr.ne.0) goto 103
+          write(*,*)
+          write(*,*) ' nouvelle valeur de la temperature:',tsud
+c         nouvelle temperature sous la calotte permanente
+          do l=2,nsoilmx
+               tsoil(ngridmx,l) =  tsud
+          end do
+
+
+          write(*,*)'nouvelle valeur de l albedo',
+     &   'de la calotte permanente sud ? (ex: 0.75 K)'
+ 104      read(*,*,iostat=ierr) albsud
+          if(ierr.ne.0) goto 104
+          write(*,*)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         Option 1:  Seul l'albedo du pole est modifié :    
+          albfi(ngridmx)=albsud
+          write(*,*) 'ig=',ngridmx,'   albedo perennial cap ',
+     &    albfi(ngridmx)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~é 
+c          Option 2 A haute resolution : coordonnée de la vrai calotte ~    
+c           DO j=1,jjp1
+c             DO i=1,iip1
+c                ig=1+(j-2)*iim +i
+c                if(j.eq.1) ig=1
+c                if(j.eq.jjp1) ig=ngridmx
+c                if ((rlatu(j)*180./pi.lt.-84.).and.
+c     &            (rlatu(j)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.lt.0.))         then
+cc    albedo de la calotte permanente fixe a albsud
+c                   alb(i,j)=albsud
+c                   write(*,*) 'lat=',rlatu(j)*180./pi,
+c     &                      ' lon=',rlonv(i)*180./pi
+cc     fin de la condition sur les limites de la calotte permanente
+c                end if
+c             ENDDO
+c          ENDDO
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+
+c       ptot : Modification de la pression totale glace + atm actuelle
+c       --------------------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'ptot') then
+
+c         calcul de la pression totale glace + atm actuelle
+          patm=0.
+          airetot=0.
+          pcap=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+                patm = patm + ps(i,j)*aire(i,j)
+                airetot= airetot + aire(i,j)
+                pcap = pcap + aire(i,j)*co2ice(ig)*g
+             ENDDO
+          ENDDO
+          ptoto = pcap + patm
+
+          print*,'Pression totale au sol actuelle (co2 ice + atm) ',
+     &       ptoto/airetot
+
+          print*,'nouvelle valeur?'
+          read(*,*) ptotn
+          ptotn=ptotn*airetot
+          patmn=ptotn-pcap
+          print*,'ptoto,patm,ptotn,patmn'
+          print*,ptoto,patm,ptotn,patmn
+          print*,'Facteur mult de la pression (atm only)', patmn/patm
+          do j=1,jjp1
+             do i=1,iip1
+                ps(i,j)=ps(i,j)*patmn/patm
+             enddo
+          enddo
+
+c        Correction pour la conservation des traceurs
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to conserve tracer total mass (y)',
+     &              ' or tracer mixing ratio (n) ?'
+             read(*,fmt='(a)') yes
+         end do
+
+         if (yes.eq.'y') then
+           write(*,*) 'OK : conservation of tracer total mass'
+           DO iq =1, nqmx
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=q(i,j,l,iq)*patm/patmn
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+          else
+            write(*,*) 'OK : conservation of tracer mixing ratio'
+          end if
+
+c       q=0 : traceurs a zero
+c       ---------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'q=0') then
+c          mise a 0 des q (traceurs)
+          write(*,*) 'Traceurs mis a 0 (1.E-30 en fait)'
+           DO iq =1, nqmx
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=1.e-30
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+
+c          mise a 0 des qsurf (traceurs a la surface)
+           DO iq =1, nqmx
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+           ENDDO
+
+c       q=x : initialise tracer manually 
+c       --------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'q=x') then
+             write(*,*) 'Which tracer do you want to modify ?'
+             write(*,*) '(choose between 1 and ',nqmx,')'
+             read(*,*) iq 
+             write(*,*)'mixing ratio of tracer #',iq, ' ? (kg/kg)'
+             read(*,*) val
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=val
+                  ENDDO
+               ENDDO
+             ENDDO
+             write(*,*) 'SURFACE value of tracer #', iq , ' ? (kg/m2)'
+             read(*,*) val
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=val
+             ENDDO
+
+c       ini_q : traceurs initialises pour la chimie
+c       -----------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'ini_q') then
+c         For more than 32 layers, possible to initiate thermosphere only     
+          thermo=0
+          yes=' '
+          if (llm.gt.32) then 
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &     'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then
+            thermo=1 
+            else
+            thermo=0
+            endif
+            enddo  
+          endif
+          
+              call inichim_newstart(q,ps,sig,nqmx,latfi,lonfi,airefi,
+     $   thermo)
+          write(*,*) 'Especes chimiques initialisees'
+
+        if (thermo.eq.0) then 
+c          mise a 0 des qsurf (traceurs a la surface)
+           DO iq =1, nqmx
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+           ENDDO
+        endif   
+
+c       ini_q-H2O : idem sauf le dernier traceur (H2O)
+c       -----------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'ini_q-H2O') then
+          ! for more than 32 layers, possible to initiate thermosphere only     
+          thermo=0
+          yes=' '
+          if(llm.gt.32) then
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &      'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then 
+            thermo=1 
+            else
+            thermo=0
+            endif
+            enddo
+          endif
+              call inichim_newstart(q,ps,sig,nqmx-1,latfi,lonfi,airefi,
+     $   thermo)
+          write(*,*) 'Esp. chim. initialisees sauf derniere (H2O)'
+
+        if (thermo.eq.0) then 
+c          mise a 0 des qsurf (traceurs a la surface)
+           DO iq =1, nqmx-1
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+           ENDDO
+        endif
+
+c       ini_q-iceH2O : idem sauf ice et H2O
+c       -----------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'ini_q-iceH2O') then
+c         For more than 32 layers, possible to initiate thermosphere only     
+          thermo=0
+          yes=' '
+          if(llm.gt.32) then
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &      'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then 
+            thermo=1 
+            else
+            thermo=0
+            endif
+            enddo
+          endif
+     
+         call inichim_newstart(q,ps,sig,nqmx-2,latfi,lonfi,airefi,
+     $   thermo)
+          write(*,*) 'Esp. chim. initialisees sauf ice et H2O'
+
+        if (thermo.eq.0) then 
+c          mise a 0 des qsurf (traceurs a la surface)
+           DO iq =1, nqmx-2
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO 
+           ENDDO
+        endif
+c      wetstart : wet atmosphere with a north to south gradient
+c      --------------------------------------------------------
+       else if (modif(1:lnblnk(modif)) .eq. 'wetstart') then
+          DO l=1,llm
+            DO j=1,jjp1
+              DO i=1,iip1
+                q(i,j,l,nqmx)=150.e-6 * (rlatu(j)+pi/2.) / pi
+              ENDDO
+            ENDDO
+          ENDDO
+
+         write(*,*) 'Water mass mixing ratio at north pole='
+     *               ,q(1,1,1,nqmx)
+         write(*,*) '---------------------------south pole='
+     *               ,q(1,jjp1,1,nqmx)
+
+c      watercapn : H20 ice sur la calotte permanente nord
+c      --------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'watercapn') then
+           do ig=1,ngridmx
+             j=(ig-2)/iim +2
+              if(ig.eq.1) j=1
+              if (rlatu(j)*180./pi.gt.80.) then
+                   qsurf(ig,nqmx)=1.e5
+                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
+     &              qsurf(ig,nqmx)
+                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
+     &              rlatv(j)*180./pi
+                end if
+           enddo
+
+c      watercaps : H20 ice sur la calotte permanente sud
+c      -------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'watercaps') then
+           do ig=1,ngridmx
+               j=(ig-2)/iim +2
+               if(ig.eq.1) j=1
+               if (rlatu(j)*180./pi.lt.-80.) then
+                   qsurf(ig,nqmx)=1.e5
+                   write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
+     &              qsurf(ig,nqmx)
+                   write(*,*)'     ==> Ice mesh North boundary (deg)= ',
+     &              rlatv(j-1)*180./pi
+               end if
+           enddo
+
+c       isotherm : Temperatures isothermes et vents nuls
+c       ------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'isotherm') then
+
+          write(*,*)'Isothermal temperature of the atmosphere, 
+     &           surface and subsurface'
+          write(*,*) 'Value of THIS temperature ? :'
+ 203      read(*,*,iostat=ierr) Tiso
+          if(ierr.ne.0) goto 203
+
+          do ig=1, ngridmx
+            tsurf(ig) = Tiso
+          end do
+          do l=2,nsoilmx
+            do ig=1, ngridmx
+              tsoil(ig,l) = Tiso
+            end do
+          end do
+          flagiso=.true.
+          call initial0(llm*ip1jmp1,ucov)
+          call initial0(llm*ip1jm,vcov)
+          call initial0(ngridmx*(llm+1),q2)
+
+c       co2ice=0 : ellimination des calottes polaires de CO2'
+c       ------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'co2ice=0') then
+           do ig=1,ngridmx
+              co2ice(ig)=0
+              emis(ig)=emis(ngridmx/2)
+           end do
+        else
+          goto 888
+        end if
+      end do
+
+ 999  continue
+
+ 
+c=======================================================================
+c   Correction de la pression pour nouvelle grille (menu 0)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+        r = 1000.*8.31/mugaz
+
+        do j=1,jjp1
+          do i=1,iip1
+             ps(i,j) = ps(i,j) * 
+     .            exp((phisold_newgrid(i,j)-phis(i,j)) /
+     .                                  (t(i,j,1) * r))
+          end do
+        end do
+  
+c periodicite de ps en longitude
+        do j=1,jjp1
+          ps(1,j) = ps(iip1,j)
+        end do
+      end if
+
+c=======================================================================
+c=======================================================================
+
+c=======================================================================
+c    Initialisation de la physique / ecriture de newstartfi :
+c=======================================================================
+
+
+      CALL inifilr 
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+
+c-----------------------------------------------------------------------
+c   Initialisation  pks:
+c-----------------------------------------------------------------------
+
+      CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+! Calcul de la temperature potentielle teta
+
+      if (flagiso) then
+          DO l=1,llm
+             DO j=1,jjp1
+                DO i=1,iim
+                   teta(i,j,l) = Tiso * cpp/pk(i,j,l)
+                ENDDO
+                teta (iip1,j,l)= teta (1,j,l)
+             ENDDO
+          ENDDO
+      else if (choix_1.eq.0) then
+         DO l=1,llm
+            DO j=1,jjp1
+               DO i=1,iim
+                  teta(i,j,l) = t(i,j,l) * cpp/pk(i,j,l)
+               ENDDO
+               teta (iip1,j,l)= teta (1,j,l)
+            ENDDO
+         ENDDO
+      endif
+
+C Calcul intermediaire
+c
+      if (choix_1.eq.0) then
+         CALL massdair( p3d, masse  )
+c
+         print *,' ALPHAX ',alphax
+
+         DO  l = 1, llm
+           DO  i    = 1, iim
+             xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
+             xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
+           ENDDO
+             xpn      = SUM(xppn)/apoln
+             xps      = SUM(xpps)/apols
+           DO i   = 1, iip1
+             masse(   i   ,   1     ,  l )   = xpn
+             masse(   i   ,   jjp1  ,  l )   = xps
+           ENDDO
+         ENDDO
+      endif
+      phis(iip1,:) = phis(1,:)
+
+      CALL inidissip ( lstardis, nitergdiv, nitergrot, niterh,
+     *                tetagdiv, tetagrot , tetatemp  )
+      itau=0
+      if (choix_1.eq.0) then
+         day_ini=int(date)
+      endif
+c
+      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
+
+      CALL caldyn0( itau,ucov,vcov,teta,ps,masse,pk,phis ,
+     *                phi,w, pbaru,pbarv,day_ini+time )
+c     CALL caldyn
+c    $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
+c    $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, day_ini )
+
+      CALL dynredem0("restart.nc",day_ini,anneeref,phis,nqmx)
+      CALL dynredem1("restart.nc",0.0,vcov,ucov,teta,q,nqmx,masse,ps) 
+C
+C Ecriture etat initial physique
+C
+      call physdem1("restartfi.nc",lonfi,latfi,nsoilmx,nqmx,
+     .              dtphys,float(day_ini),
+     .              time,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              airefi,albfi,ithfi,zmea,zstd,zsig,zgam,zthe)
+
+c=======================================================================
+c	Formats 
+c=======================================================================
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lllm =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgrad.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgrad.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgrad.F	(revision 2744)
@@ -0,0 +1,45 @@
+      SUBROUTINE nxgrad (klevel, rot, x, y )
+c
+c     P. Le Van
+c
+c   ********************************************************************
+c      calcul du gradient tourne de pi/2 du rotationnel du vect.v
+c   ********************************************************************
+c       rot          est un argument  d'entree pour le s-prog
+c       x  et y    sont des arguments de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+      INTEGER klevel
+      REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
+      INTEGER   l,ij
+c
+c
+      DO 10 l = 1,klevel
+c
+      DO 1  ij = 2, ip1jm
+      y( ij,l ) = (  rot( ij,l ) - rot( ij-1,l )  ) * cvsurcuv( ij )
+   1  CONTINUE
+c
+c    ..... correction pour  y ( 1,j,l )  ......
+c
+c    ....    y(1,j,l)= y(iip1,j,l) ....
+CDIR$ IVDEP
+      DO 2  ij = 1, ip1jm, iip1
+      y( ij,l ) = y( ij +iim,l )
+   2  CONTINUE
+c
+      DO 4  ij = iip2,ip1jm
+      x( ij,l ) = (  rot( ij,l ) - rot( ij -iip1,l )  ) * cusurcvu( ij )
+   4  CONTINUE
+      DO 6 ij = 1,iip1
+      x(    ij    ,l ) = 0.
+      x( ij +ip1jm,l ) = 0.
+   6  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgrad_gam.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgrad_gam.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgrad_gam.F	(revision 2744)
@@ -0,0 +1,46 @@
+      SUBROUTINE nxgrad_gam( klevel, rot, x, y )
+c
+c  P. Le Van
+c
+c   ********************************************************************
+c      calcul du gradient tourne de pi/2 du rotationnel du vect.v
+c   ********************************************************************
+c       rot          est un argument  d'entree pour le s-prog
+c       x  et y    sont des arguments de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+      INTEGER klevel
+      REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
+      INTEGER   l,ij
+      integer ismin,ismax
+      external ismin,ismax
+c
+      DO 10 l = 1,klevel
+c
+      DO 1  ij = 2, ip1jm
+      y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
+   1  CONTINUE
+c
+c    ..... correction pour  y ( 1,j,l )  ......
+c
+c    ....    y(1,j,l)= y(iip1,j,l) ....
+CDIR$ IVDEP
+      DO 2  ij = 1, ip1jm, iip1
+      y( ij,l ) = y( ij +iim,l )
+   2  CONTINUE
+c
+      DO 4  ij = iip2,ip1jm
+      x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
+   4  CONTINUE
+      DO 6 ij = 1,iip1
+      x(    ij    ,l ) = 0.
+      x( ij +ip1jm,l ) = 0.
+   6  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgradst.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgradst.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgradst.F	(revision 2744)
@@ -0,0 +1,44 @@
+      SUBROUTINE nxgradst (klevel,rot, x, y )
+c
+      IMPLICIT NONE
+c     Auteur :  P. Le Van
+c
+c   ********************************************************************
+c      calcul du gradient tourne de pi/2 du rotationnel du vect.v
+c   ********************************************************************
+c       rot          est un argument  d'entree pour le s-prog
+c       x  et y    sont des arguments de sortie pour le s-prog
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      INTEGER klevel
+      REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
+      INTEGER l,ij
+c
+      DO 10 l = 1,klevel
+c
+      DO 1  ij = 2, ip1jm
+      y(ij,l)=( rot(ij,l) - rot(ij-1,l))
+   1  CONTINUE
+c
+c    ..... correction pour  y ( 1,j,l )  ......
+c
+c    ....    y(1,j,l)= y(iip1,j,l) ....
+
+      DO 2  ij = 1, ip1jm, iip1
+      y( ij,l ) = y( ij +iim,l )
+   2  CONTINUE
+c
+      DO 4  ij = iip2,ip1jm
+      x(ij,l)= rot(ij,l)-rot(ij-iip1,l)
+   4  CONTINUE
+      DO 6 ij = 1,iip1
+      x(    ij    ,l ) = 0.
+      x( ij +ip1jm,l ) = 0.
+   6  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgraro2.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgraro2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgraro2.F	(revision 2744)
@@ -0,0 +1,67 @@
+       SUBROUTINE nxgraro2 (klevel,xcov, ycov, lr, grx, gry )
+c
+c      P.Le Van .
+c   ***********************************************************
+c                                 lr
+c      calcul de  ( nxgrad (rot) )   du vect. v  ....
+c
+c       xcov et ycov  etant les compos. covariantes de  v
+c   ***********************************************************
+c     xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
+c      grx   et  gry     sont des arguments de sortie pour le s-prog
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+c
+c    ......  variables en arguments  .......
+c
+      INTEGER klevel
+      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
+      REAL  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
+c
+c    ......   variables locales     ........
+c
+      REAL rot(ip1jm,llm) , signe, nugradrs
+      INTEGER l,ij,iter,lr
+c    ........................................................
+c
+      EXTERNAL    filtreg
+      EXTERNAL  SCOPY, rotatf, nxgrad, laplacien_rotgam
+c
+c
+      signe    = (-1.)**lr
+      nugradrs = signe * crot
+c
+      CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
+      CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
+c
+      CALL rotatf     ( klevel, grx, gry, rot )
+c
+      CALL laplacien_rot ( klevel, rot, rot,grx,gry      )
+
+c
+c    .....   Iteration de l'operateur laplacien_rotgam  .....
+c
+      DO  iter = 1, lr -2
+        CALL laplacien_rotgam ( klevel, rot, rot )
+      ENDDO
+c
+c
+      CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.,1)
+      CALL nxgrad ( klevel, rot, grx, gry )
+c
+      DO    l = 1, klevel
+         DO  ij = 1, ip1jm
+          gry( ij,l ) = gry( ij,l ) * nugradrs
+         ENDDO
+         DO  ij = 1, ip1jmp1
+          grx( ij,l ) = grx( ij,l ) * nugradrs
+         ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgrarot.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgrarot.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/nxgrarot.F	(revision 2744)
@@ -0,0 +1,54 @@
+      SUBROUTINE nxgrarot (klevel,xcov, ycov, lr, grx, gry )
+c   ***********************************************************
+c
+c    Auteur :  P.Le Van  
+c
+c                                 lr
+c      calcul de  ( nXgrad (rot) )   du vect. v  ....
+c
+c       xcov et ycov  etant les compos. covariantes de  v
+c   ***********************************************************
+c     xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
+c      grx   et  gry     sont des arguments de sortie pour le s-prog
+c
+c
+      IMPLICIT NONE
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+#include "logic.h"
+c
+      INTEGER klevel
+      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
+      REAL  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
+c
+      REAL rot(ip1jm,llm)
+
+      INTEGER l,ij,iter,lr
+c
+      EXTERNAL    filtreg
+      EXTERNAL       SCOPY, rotat, nXgrad
+c
+c
+      CALL SCOPY ( ip1jmp1*klevel, xcov, 1, grx, 1 )
+      CALL SCOPY (  ip1jm*klevel, ycov, 1, gry, 1 )
+c
+      DO 10 iter = 1,lr
+      CALL rotat (klevel,grx, gry, rot )
+      CALL filtreg( rot, jjm, klevel, 2,1, .false.,2)
+      CALL nxgrad (klevel,rot, grx, gry )
+c
+      DO 5  l = 1, klevel
+      DO 2 ij = 1, ip1jm
+      gry( ij,l ) = - gry( ij,l ) * crot
+   2  CONTINUE
+      DO 3 ij = 1, ip1jmp1
+      grx( ij,l ) = - grx( ij,l ) * crot
+   3  CONTINUE
+   5  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/para_netcdf.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/para_netcdf.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/para_netcdf.h	(revision 2744)
@@ -0,0 +1,10 @@
+c
+      INTEGER lons ,lats,levs
+      PARAMETER (lons = 320, lats = 161, levs = 17)
+c
+c     *******    a  changer  eventuellement   ********`
+c
+c  *** Ces valeurs de lons et de lats correspondent a une grille 1.125 x1.125
+c                  du fichier d'entree en Netcdf     ******
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/paramet.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/paramet.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/paramet.h	(revision 2744)
@@ -0,0 +1,19 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'paramet.h'
+
+      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
+      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
+      INTEGER  ijmllm,mvar
+      INTEGER jcfil,jcfllm
+
+      PARAMETER( iip1= iim+1-1/iim,iip2=iim+2,iip3=iim+3)
+      PARAMETER( jjp1=jjm+1-1/jjm)
+      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
+      PARAMETER( kftd  = iim/2 -ndm )
+      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
+      PARAMETER( ip1jmi1= ip1jm - iip1 )
+      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
+      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
+      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/pression.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/pression.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/pression.F	(revision 2744)
@@ -0,0 +1,29 @@
+      SUBROUTINE pression( ngrid, ap, bp, ps, p )
+c
+
+c      Auteurs : P. Le Van , Fr.Hourdin  .
+
+c  ************************************************************************
+c     Calcule la pression p(l) aux differents niveaux l = 1 ( niveau du
+c     sol) a l = llm +1, ces niveaux correspondant aux interfaces des (llm) 
+c     couches , avec  p(ij,llm +1) = 0.  et p(ij,1) = ps(ij)  .      
+c  ************************************************************************
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+c
+      INTEGER ngrid
+      INTEGER l,ij
+ 
+      REAL ap(llmp1), bp(llmp1), ps(ngrid), p(ngrid,llmp1) 
+      
+      DO    l    = 1, llmp1
+        DO  ij   = 1, ngrid
+         p(ij,l) = ap(l) + bp(l) * ps(ij)
+        ENDDO
+      ENDDO
+   
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ps_amontF
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ps_amontF	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ps_amontF	(revision 2744)
@@ -0,0 +1,454 @@
+      SUBROUTINE ps_amont(nq,iq,q,w,pbaru,pbarv,dq)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comgeom.h"
+c
+c
+c   Arguments:
+c   ----------
+      INTEGER nq,iq
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq), dq( ip1jmp1,llm,nq )
+      REAL w(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l
+c
+      REAL airej2,airejjm,airescb(iim),airesch(iim)
+      REAL pente(ip1jmp1),xg(ip1jmp1),xd(ip1jmp1),xs(ip1jmp1) ,
+     *     xn(ip1jmp1),xb(ip1jmp1),xh(ip1jmp1)
+      REAL qg(ip1jmp1),qd(ip1jmp1),qs(ip1jmp1) ,
+     *     qn(ip1jmp1),qb(ip1jmp1,llm),qh(ip1jmp1,llm)
+      REAL qbyv(ip1jm,llm), qbxu(ip1jmp1,llm), ww,dqh(ip1jmp1,llm)
+      REAL qpns,qpsn
+      logical first,extrpn,extrps
+      save first
+c
+c
+      REAL      SSUM,CVMGP,CVMGT
+      EXTERNAL  SSUM, convflu
+
+      data first/.true./
+
+      if(first) then
+         print*,'SCHEMA AMONT NOUVEAU'
+         first=.false.
+      endif
+
+
+c
+c
+      IF( forward.OR.leapf )   THEN
+c
+c
+      DO  100  l = 1, llm
+c
+c   ...  Boucle sur les  llm niveaux verticaux ...
+c
+c
+c  --------------------------------------------------------------
+c  --------------------------------------------------------------
+c  .............      Traitement en longitude     ...............
+c  --------------------------------------------------------------
+c  --------------------------------------------------------------
+c
+c     
+c        |          |            |           |
+c        |   q(i-1) |     q(i)   |   q(i+1)  |
+c        |          |qg(i)  qd(i)|qg(i+1)    |
+c
+c
+c      En  longitude ,
+c      Pour chaque maille ( i ) avec q(i,j,l,iq), on cherche a determiner
+c      avec une methode de ' pente' les valeurs qg(i) et qd(i) qui se trouvent
+c      au bord gauche et droite de cette maille .
+c
+c      Si ( q(i+1)-q(i) ) * ( q(i)-q(i-1)) < 0. ,on a qg(i)=qd(i)=q(i)
+c              Sinon
+c      qg(i)= q(i) - 1/4 * ( q(i+1) - q(i-1))
+c      qd(i)= q(i) + 1/4 * ( q(i+1) - q(i-1) )
+c
+c      On utilisera la meme methode pour determiner les valeurs qs(i) et qn(i)
+c      en latitude , ainsi que les valeurs qb(i) et qh(i) en  altitude .
+c
+c
+c
+       DO      ij    = 1,iip1
+       qg(ij)        = 0.
+       qd(ij)        = 0.
+       qg(ij+ ip1jm) = 0.
+       qd(ij+ ip1jm) = 0.
+       ENDDO
+c
+c     ....  calculs pour les lignes j= 2 a j = jjm  ....
+c
+       DO   ij    = iip2, ip1jm -1
+       pente(ij)  =( q(ij+1,l,iq)-q(ij,l,iq)) *(q(ij,l,iq)-q(ij-1,l,iq)) 
+       xg(ij)     = q(ij,l,iq) - 0.25 * ( q(ij+1,l,iq) - q(ij-1,l,iq) )
+       xd(ij)     = q(ij,l,iq) + 0.25 * ( q(ij+1,l,iq) - q(ij-1,l,iq) )
+       qg(ij)     = CVMGP( xg(ij), q(ij,l,iq) ,pente(ij) )
+       qd(ij)     = CVMGP( xd(ij), q(ij,l,iq), pente(ij) )
+       ENDDO
+
+c    ... Correction aux points  ( i= 1,  j )  .....
+c
+       DO   ij   = iip2, ip1jm, iip1
+       pente(ij) = ( q(ij+1,l,iq) - q(ij,l,iq) )     * 
+     *                                ( q(ij,l,iq)  - q(ij+iim-1,l,iq) )
+       xg(ij)    = q(ij,l,iq) - 0.25* ( q(ij+1,l,iq)- q(ij+iim-1,l,iq) )
+       xd(ij)    = q(ij,l,iq) + 0.25* ( q(ij+1,l,iq)- q(ij+iim-1,l,iq) )
+       qg(ij)    = CVMGP( xg(ij), q(ij,l,iq) ,pente(ij) )
+       qd(ij)    = CVMGP( xd(ij), q(ij,l,iq), pente(ij) )
+       ENDDO
+c
+c    ... Correction aux points ( i= iip1,  j ) .....
+c
+       DO     ij      = iip2, ip1jm, iip1
+       qg( ij+ iim  ) = qg( ij )
+       qd( ij+ iim )  = qd( ij )
+       ENDDO
+c
+c   .............................................................
+c   .........    Limitation des pentes a gauche des boites  .....
+c
+c    Si (q(i)-qg(i))*(qg(i)-q(i-1)) < 0.  , on a  qg(i)=q(i-1)  
+c                                         et qd(i)=2*q(i)-qg(i)
+c   .............................................................
+c
+       DO   ij  = iip2,ip1jm -1
+       pente(ij)= ( qg(ij) -q(ij-1,l,iq))*(q(ij,l,iq)-qg(ij) )
+       qg(ij)   = CVMGP( qg(ij), q(ij-1,l,iq) ,pente(ij) )
+       qd(ij)   = CVMGP( qd(ij), 
+     *                q(ij,l,iq)+ q(ij,l,iq) -qg(ij) , pente(ij) ) 
+       ENDDO
+c
+c      .....   Correction aux points ( i= 1,  j )  ......
+c
+       DO    ij  = iip2 ,ip1jm, iip1
+       qg(ij)    =  qg(ij+ iim)
+       qd(ij)    =  qd(ij+ iim)
+       ENDDO
+c    
+c      ...............................................................
+c      ...... Limitation des pentes a droite des boites      .........
+c      Si (q(i+1)-qd(i))*(qd(i)-q(i)) < 0. , on a qd(i)=q(i+1)
+c                                              et qg(i)=2*q(i)-qd(i) .
+c      ...............................................................
+c
+       DO ij = iip2, ip1jm -1
+       pente(ij) = ( qd(ij)-q(ij,l,iq) )*(q(ij+1,l,iq)-qd(ij) ) 
+       qd(ij)    =  CVMGP( qd(ij), q(ij+1,l,iq), pente(ij) )
+       qg(ij)    =  CVMGP( qg(ij), 
+     *                q(ij,l,iq)+ q(ij,l,iq) -qd(ij) , pente(ij) ) 
+       ENDDO
+c
+c      ....  Correction aux points ( i = iip1, j )  .....
+c
+       DO     ij     = iip2, ip1jm, iip1
+       qg( ij+ iim ) = qg( ij )
+       qd( ij+ iim ) = qd( ij )
+       ENDDO
+c
+
+c     -------------------------------------------------------------
+c     -------------------------------------------------------------
+c     .............    Traitement en  latitude    .................
+c     -------------------------------------------------------------
+c     -------------------------------------------------------------
+c
+c
+c      q(j=1)   PN
+c   --------------
+c     ---------  
+c   --------------
+c
+c      q(j-1)
+c
+c   --------------
+c            qn(j)
+c      q(j)
+c            qs(j)
+c   --------------
+c        
+c      q(j+1)
+c
+c   --------------
+c
+c      q(jjp1)  PS
+c
+c   --------------
+c
+c
+c     ......   operations pour les lignes j= 2 a j= jjm  .......
+c
+       DO    ij    = iip2, ip1jm
+       pente(ij)   = ( q(ij-iip1,l,iq)- q(ij,l,iq)  )  *
+     *               ( q(ij,l,iq) - q(ij+iip1,l,iq) )
+       xs(ij) = q(ij,l,iq) - 0.25 * ( q(ij-iip1,l,iq) -q(ij+iip1,l,iq) )
+       xn(ij) = q(ij,l,iq) + 0.25 * ( q(ij-iip1,l,iq) -q(ij+iip1,l,iq) )
+       qs(ij) = CVMGP( xs(ij), q(ij,l,iq), pente(ij) )
+       qn(ij) = CVMGP( xn(ij), q(ij,l,iq), pente(ij) )
+       ENDDO
+c
+c
+c     ......    Calculs aux  poles   .............................
+c     ............................................................
+c
+c     On n'a pas besoin des valeurs de  qn au pole Nord ( j=    1) ,
+c      ainsi que de celles de           qs au pole Sud  ( j= jjp1)
+c
+c
+      airej2 = SSUM( iim, aire(iip2), 1 )
+      airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
+      DO i = 1, iim
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l,iq)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l,iq)
+      ENDDO
+      qpns   = SSUM( iim,  airescb ,1 ) / airej2
+      qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
+c
+c     qpns , val.moyenne de q sur la ligne j= 2
+c     qpsn , val.moyenne de q sur la ligne j= jjm
+c
+c
+c
+c  on cherche si on a un extremum au pole
+c
+      extrpn=.true.
+      extrps=.true.
+      DO ij=2,iim
+         if((q(iip1+i,l,iq)-q(1,l,iq))*(q(iip2,l,iq)-q(1,l,iq)).lt.0.)
+     .   extrpn=.false.
+         if((q(ip1jm-iip1+i,l,iq)-q(1,l,iq))*
+     .     (q(ip1jm-iim,l,iq)-q(1,l,iq)).lt.0.)
+     .      extrps=.false.
+      ENDDO
+
+c   calcul des pentes au pole
+
+      if(extrpn) then
+         DO    ij     = 1, iip1
+            qs(ij)= q(ij,l,iq)
+         ENDDO
+      else
+         DO    ij     = 1, iip1
+            qs(ij)= q(ij,l,iq) + 0.5 * ( q(ij+ iip1,l,iq) - qpns )
+         ENDDO
+      endif
+
+      if(extrps) then
+         DO    ij     = 1, iip1
+            qn(ij+ip1jm) = q(ij+ip1jm,l,iq)
+         ENDDO
+      else
+         DO    ij     = 1, iip1
+            qn(ij+ip1jm) = q(ij+ip1jm,l,iq) +   0.5 *
+     *                    ( q(ij+ip1jm-iip1,l,iq) - qpsn )
+         ENDDO
+      endif
+
+c
+c
+c    .........................................................
+c    ......    Limitation des pentes au sud des boites   .....
+c    .........................................................    
+c
+      DO   ij     = 1, ip1jm
+      pente(ij)   = ( qs(ij) - q (ij+iip1,l,iq) )   *
+     *              ( q( ij,l,iq) - qs( ij ) )
+      qs(ij) = CVMGP( qs(ij) , q(ij+iip1,l,iq), pente(ij) )
+      qn(ij) = CVMGP( qn(ij) , 
+     *                q(ij,l,iq)+ q(ij,l,iq) -qs(ij), pente(ij) )
+      ENDDO
+c
+c
+c     .......................................................
+c     .... Limitation des pentes au nord des boites .........
+c     .......................................................
+c
+      DO   ij     = iip2, ip1jmp1
+      pente(ij)   = ( qn( ij  ) -  q(ij,l,iq) )  *
+     *              (  q(ij-iip1,l,iq) - qn(ij) )
+      qn(ij)      = CVMGP( qn(ij), q(ij-iip1,l,iq), pente(ij) )
+      qs(ij)      = CVMGP( qs(ij), 
+     *                q(ij,l,iq)+ q(ij,l,iq) -qn(ij) , pente(ij) )
+      ENDDO
+c
+c
+c    .............................................................
+c    .....   Calculs des flux de  q  sur le plan horizontal ......
+c    .............................................................
+c
+c
+c
+c      
+c      ....  Selon   X  .... 
+c
+         DO  ij     = iip2, ip1jm - 1
+c
+         qbxu( ij,l ) =  pbaru( ij,l )   *
+     *            CVMGT( qd(ij), qg(ij +1), pbaru(ij,l).GT.0. )
+         ENDDO
+c
+c     ..... correction  pour  qbxu(iip1,j,l)   .....
+c     ...   qbxu(iip1,j,l)= qbxu(1,j,l)  ...
+c
+c           &&&CDIR$ IVDEP
+         DO    ij     = iip1 +iip1, ip1jm, iip1
+         qbxu( ij,l ) = qbxu( ij - iim, l )
+         ENDDO
+c
+c      .... Selon Y  .....
+c
+         DO    ij     = 1, ip1jm
+         qbyv( ij,l ) =  pbarv( ij,l )    *
+     *             CVMGT( qn(ij+iip1), qs(ij), pbarv(ij,l).GT.0. )
+         ENDDO
+c
+c
+c
+  100  CONTINUE
+c
+c     ..........................................................
+c     ( ... fin des traitements en longitude et latitude  ... )
+c
+c
+c   stockage dans  dqh  de la convergence horiz.du flux d'humidite  .
+c                   ....
+c
+c
+                 CALL convflu( qbxu, qbyv, llm, dqh )
+c
+c
+c
+c    ----------------------------------------------------------------
+c    ----------------------------------------------------------------
+c    .............      Traitement  en  altitude        .............
+c    ----------------------------------------------------------------
+c    ----------------------------------------------------------------
+c
+c
+c     -------------
+c        q (llm)
+c
+c     -------------
+c     -------------
+c
+c        q(l+1)
+c
+c     -------------
+c             qh(l)
+c        q(l)
+c             qb(l)
+c     -------------
+c
+c        q(l-1)
+c
+c     -------------
+c     -------------
+c        q(1)
+c     -------------
+c
+c
+c    ... Calculs pour les niveaux 2 a llm -1  ...
+c
+c
+      DO  200   l = 2, llm -1
+
+       DO   ij     = 1, ip1jmp1
+       pente(ij)   = ( q(ij, l+1 ,iq)  - q(ij , l  ,   iq) )  * 
+     *               ( q(ij,   l ,iq)  - q(ij ,l-1 ,   iq) )
+       xb(ij)      = q(ij,l,iq) - 0.25* ( q(ij,l+1,iq) - q(ij,l-1,iq) )
+       xh(ij)      = q(ij,l,iq) + 0.25* ( q(ij,l+1,iq) - q(ij,l-1,iq) )
+       qb(ij,l)    = CVMGP( xb(ij), q(ij,l,iq), pente(ij) )
+       qh(ij,l)    = CVMGP( xh(ij), q(ij,l,iq), pente(ij) )
+       ENDDO
+c
+c     ........................................................
+c     ......  Limitation des pentes en bas des boites   ......
+c     ........................................................
+c
+       DO   ij     = 1, ip1jmp1
+       pente(ij)   = ( qb(ij,l) - q ( ij,l-1,iq) )   *
+     *                ( q (ij,l,iq) - qb( ij,l ) )
+       qb(ij,l)    = CVMGP( qb(ij,l), q(ij,l-1,iq), pente(ij) )
+       qh(ij,l)    = CVMGP( qh(ij,l), 
+     *               q(ij,l,iq) + q(ij,l,iq) -qb(ij,l), pente(ij) )
+       ENDDO
+c
+c
+c     ........................................................
+c     ......  Limitation des pentes en haut des boites   ......
+c     ........................................................
+c
+       DO   ij     = 1, ip1jmp1
+       pente(ij)   = ( qh(ij,l) - q ( ij,l+1,iq) )   *
+     *                ( q (ij,l,iq) - qh( ij,l ) )
+       qh(ij,l)    = CVMGP( qh(ij,l), q(ij,l+1,iq), pente(ij) )
+       qb(ij,l)    = CVMGP( qb(ij,l), 
+     *               q(ij,l,iq) + q(ij,l,iq) -qh(ij,l), pente(ij) )
+       ENDDO
+c
+c
+  200  CONTINUE
+c
+c
+c    ............................................................
+c    .....     Calculs pour les niveaux l= 1 et l= llm  .........
+c    ............................................................
+c
+      DO   ij    = 1, ip1jmp1
+      qb(ij,1)   = q(ij, 1 , iq)
+      qb(ij,llm) = q(ij,llm, iq)
+      qh(ij,1)   = q(ij, 1 , iq)
+      qh(ij,llm) = q(ij,llm, iq)
+      ENDDO
+c
+
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection verticale  .......
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dqh pour calculer dq
+c
+
+       DO 300 l = 1,llmm1
+c
+         DO  ij = 1,ip1jmp1
+          ww= - w( ij,l+1 ) * 
+     *        CVMGT ( qh(ij,l), qb(ij,l+1), w(ij,l+1).LT.0.)
+
+          dq (ij, l ,iq ) = dqh(ij, l )   - dsig1( l ) * ww
+          dqh(ij,l+1    ) = dqh(ij,l+1)   + dsig1(l+1) * ww
+         ENDDO
+c
+  300   CONTINUE 
+c
+c
+c
+        DO  ij = 1,ip1jmp1
+          dq( ij,llm,iq ) = dqh( ij,llm )
+        END DO
+c
+c
+      END IF
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/psextbar.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/psextbar.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/psextbar.F	(revision 2744)
@@ -0,0 +1,105 @@
+      SUBROUTINE psextbar ( ps, psexbarxy )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c **********************************************************************
+c calcul des moyennes en x et en y de (pression au sol*aire variable) ..
+c **********************************************************************
+c
+c         ps          est un  argum. d'entree  pour le s-pg ..
+c         psexbarxy   est un  argum. de sortie pour le s-pg ..
+c
+c   Methode:
+c   --------
+c
+c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
+c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
+c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
+c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
+c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
+c
+c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
+c
+c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
+c
+c
+c
+c   alpha4 .         . alpha1    . alpha4
+c    (i,j)             (i,j)       (i+1,j)
+c
+c             P .        U .          . P
+c           (i,j)       (i,j)         (i+1,j)
+c
+c   alpha3 .         . alpha2    .alpha3 
+c    (i,j)              (i,j)     (i+1,j)
+c
+c             V .        Z .          . V
+c           (i,j)
+c
+c   alpha4 .         . alpha1    .alpha4
+c   (i,j+1)            (i,j+1)   (i+1,j+1) 
+c
+c             P .        U .          . P
+c          (i,j+1)                    (i+1,j+1)
+c
+c
+c
+c
+c                       On  a :
+c
+c    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
+c                 Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
+c     localise  au point  ... U (i,j) ...
+c
+c    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
+c                 Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
+c     localise  au point  ... V (i,j) ...
+c
+c  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
+c               Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
+c     localise  au point  ... Z (i,j) ...
+c
+c
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      REAL ps( ip1jmp1 ), psexbarxy ( ip1jm ), pext( ip1jmp1 )
+
+      INTEGER  l, ij
+      EXTERNAL SCOPY
+c
+
+      DO ij = 1, ip1jmp1
+       pext(ij) = ps(ij) * aire(ij)
+      ENDDO
+
+
+      DO     5     ij = 1, ip1jm - 1
+      psexbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) +
+     *   pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
+   5  CONTINUE
+
+
+c    ....  correction pour     psexbarxy( iip1,j )  ........
+
+CDIR$ IVDEP
+
+      DO 7 ij = iip1, ip1jm, iip1
+      psexbarxy( ij ) = psexbarxy( ij - iim )
+   7  CONTINUE
+
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ran1.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ran1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/ran1.F	(revision 2744)
@@ -0,0 +1,31 @@
+      FUNCTION RAN1(IDUM)
+      DIMENSION R(97)
+      save r
+      save iff,ix1,ix2,ix3
+      PARAMETER (M1=259200,IA1=7141,IC1=54773,RM1=3.8580247E-6)
+      PARAMETER (M2=134456,IA2=8121,IC2=28411,RM2=7.4373773E-6)
+      PARAMETER (M3=243000,IA3=4561,IC3=51349)
+      DATA IFF /0/
+      IF (IDUM.LT.0.OR.IFF.EQ.0) THEN
+        IFF=1
+        IX1=MOD(IC1-IDUM,M1)
+        IX1=MOD(IA1*IX1+IC1,M1)
+        IX2=MOD(IX1,M2)
+        IX1=MOD(IA1*IX1+IC1,M1)
+        IX3=MOD(IX1,M3)
+        DO 11 J=1,97
+          IX1=MOD(IA1*IX1+IC1,M1)
+          IX2=MOD(IA2*IX2+IC2,M2)
+          R(J)=(FLOAT(IX1)+FLOAT(IX2)*RM2)*RM1
+11      CONTINUE
+        IDUM=1
+      ENDIF
+      IX1=MOD(IA1*IX1+IC1,M1)
+      IX2=MOD(IA2*IX2+IC2,M2)
+      IX3=MOD(IA3*IX3+IC3,M3)
+      J=1+(97*IX3)/M3
+      IF(J.GT.97.OR.J.LT.1)PAUSE
+      RAN1=R(J)
+      R(J)=(FLOAT(IX1)+FLOAT(IX2)*RM2)*RM1
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/readhead_NC.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/readhead_NC.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/readhead_NC.F	(revision 2744)
@@ -0,0 +1,231 @@
+      SUBROUTINE readhead_NC (fichnom,
+     .           day0,
+     .           phis,constR)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c  Adaptation à Mars : Yann Wanherdrick 
+c Objet: Lecture de l etat initial pour la physique
+c======================================================================
+#include "netcdf.inc"
+c====== includes de l ancien readhead ===
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "description.h"
+
+c======================================================================
+
+      CHARACTER*(*) fichnom
+      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
+      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
+
+      INTEGER radpas
+
+      REAL xmin, xmax
+c
+      INTEGER  i
+
+c   Variables
+c
+      INTEGER length,iq
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER ierr, nid, nvarid
+      CHARACTER  str3*3
+
+c
+      INTEGER day0
+      REAL phis(ip1jmp1),constR
+c
+c Ouvrir le fichier contenant l etat initial:
+c
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        CALL ABORT
+      ENDIF
+c
+c Lecture des parametres de controle:
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Le champ <controle> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Lecture echouee pour <controle>'
+         CALL abort
+      ENDIF
+
+
+c Info sur la Planete Mars pour la dynamique 
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ini    = tab_cntrl(4)
+      rad        = tab_cntrl(5)
+      omeg       = tab_cntrl(6)
+      g          = tab_cntrl(7)
+c      mugaz      = tab_cntrl(8)
+      cpp        =  744.499
+      kappa      = tab_cntrl(9)
+      daysec     = tab_cntrl(10)
+      dtvr       = tab_cntrl(11)
+      etot0      = tab_cntrl(12)
+      ptot0      = tab_cntrl(13)
+      ztot0      = tab_cntrl(14)
+      stot0      = tab_cntrl(15)
+      ang0       = tab_cntrl(16)
+c pas vrai pour diagfi, seulement pour start      preff      = tab_cntrl(18)
+      preff=610.
+      WRITE (*,*) 'readhead -     preff ' , preff 
+c
+
+      day0=day_ini
+
+      constR=kappa*cpp
+      WRITE (*,*) 'constR = ' , constR
+      r=constR
+      IF(   im.ne.iim           )  THEN
+          PRINT 1,im,iim
+          STOP
+      ELSE  IF( jm.ne.jjm       )  THEN
+          PRINT 2,jm,jjm
+          STOP
+      ELSE  IF( lllm.ne.llm     )  THEN
+          PRINT 3,lllm,llm
+          STOP
+      ENDIF
+                                                                       
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <rlonu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+                                                                       
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <rlatv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour rlatv"
+         CALL abort
+      ENDIF
+
+      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <cv>"
+         CALL abort
+      ENDIF
+c
+c Lecture des aires des mailles:
+c
+      ierr = NF_INQ_VARID (nid, "aire", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Le champ <aire> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Lecture echouee pour <aire>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(aire)
+      xmax = MAXVAL(aire)
+      PRINT*,'Aires des mailles <aire>:', xmin, xmax
+c
+c Lecture du geopotentiel au sol:
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Le champ <phisinit> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Lecture echouee pour <phis>'
+         CALL abort
+      ENDIF
+c      PRINT*,'READHEAD_NC  Phis:',phis
+
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <aps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, aps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <aps>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <bps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <bps>"
+         CALL abort
+      ENDIF
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur  dtinteg =',i4//)
+
+      
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotat.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotat.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotat.F	(revision 2744)
@@ -0,0 +1,55 @@
+      SUBROUTINE rotat (klevel, x, y, rot )
+c
+c     Auteur : P.Le Van 
+c**************************************************************
+c.  calcule le rotationnel
+c     a tous les niveaux d'1 vecteur de comp. x et y ..
+c       x  et  y etant des composantes  covariantes  ...
+c********************************************************************
+c   klevel, x  et y   sont des arguments d'entree pour le s-prog
+c        rot          est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c   .....  variables en arguments  ......
+c
+      INTEGER klevel
+      REAL rot( ip1jm,klevel )
+      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
+c
+c  ...   variables  locales  ...
+c
+      INTEGER  l, ij
+c
+c
+      DO  10 l = 1,klevel
+c
+        DO   ij = 1, ip1jm - 1
+         rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +
+     *                   x(ij +iip1, l )  -  x( ij,l )  
+        ENDDO
+c
+c    .... correction pour rot( iip1,j,l)  ....
+c    ....   rot(iip1,j,l)= rot(1,j,l) ...
+CDIR$ IVDEP
+        DO  ij = iip1, ip1jm, iip1
+         rot( ij,l ) = rot( ij -iim,l )
+        ENDDO
+c
+  10  CONTINUE
+
+ccc        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
+      
+        DO l = 1, klevel
+          DO ij = 1, ip1jm
+           rot(ij,l) = rot(ij,l) * unsairez(ij)
+          ENDDO
+        ENDDO
+c
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotat_nfil.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotat_nfil.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotat_nfil.F	(revision 2744)
@@ -0,0 +1,46 @@
+      SUBROUTINE rotat_nfil (klevel, x, y, rot )
+c
+c    Auteur :   P.Le Van 
+c**************************************************************
+c.          Calcule le rotationnel  non filtre   ,
+c      a tous les niveaux d'1 vecteur de comp. x et y ..
+c       x  et  y etant des composantes  covariantes  ...
+c********************************************************************
+c   klevel, x  et y   sont des arguments d'entree pour le s-prog
+c        rot          est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c   .....  variables en arguments  ......
+c
+      INTEGER klevel
+      REAL rot( ip1jm,klevel )
+      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
+c
+c  ...   variables  locales  ...
+c
+      INTEGER  l, ij
+c
+c
+      DO  10 l = 1,klevel
+c
+        DO   ij = 1, ip1jm - 1
+         rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +
+     *                   x(ij +iip1, l )  -  x( ij,l )  
+        ENDDO
+c
+c    .... correction pour rot( iip1,j,l)  ....
+c    ....   rot(iip1,j,l)= rot(1,j,l) ...
+CDIR$ IVDEP
+        DO  ij = iip1, ip1jm, iip1
+         rot( ij,l ) = rot( ij -iim,l )
+        ENDDO
+c
+  10  CONTINUE
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotatf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotatf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotatf.F	(revision 2744)
@@ -0,0 +1,55 @@
+      SUBROUTINE rotatf (klevel, x, y, rot )
+c
+c     Auteur : P.Le Van 
+c**************************************************************
+c.  calcule le rotationnel
+c     a tous les niveaux d'1 vecteur de comp. x et y ..
+c       x  et  y etant des composantes  covariantes  ...
+c********************************************************************
+c   klevel, x  et y   sont des arguments d'entree pour le s-prog
+c        rot          est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c   .....  variables en arguments  ......
+c
+      INTEGER klevel
+      REAL rot( ip1jm,klevel )
+      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
+c
+c  ...   variables  locales  ...
+c
+      INTEGER  l, ij
+c
+c
+      DO  10 l = 1,klevel
+c
+        DO   ij = 1, ip1jm - 1
+         rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +
+     *                   x(ij +iip1, l )  -  x( ij,l )  
+        ENDDO
+c
+c    .... correction pour rot( iip1,j,l)  ....
+c    ....   rot(iip1,j,l)= rot(1,j,l) ...
+CDIR$ IVDEP
+        DO  ij = iip1, ip1jm, iip1
+         rot( ij,l ) = rot( ij -iim,l )
+        ENDDO
+c
+  10  CONTINUE
+
+        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
+      
+        DO l = 1, klevel
+          DO ij = 1, ip1jm
+           rot(ij,l) = rot(ij,l) * unsairez(ij)
+          ENDDO
+        ENDDO
+c
+c
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotatst.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotatst.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/rotatst.F	(revision 2744)
@@ -0,0 +1,40 @@
+      SUBROUTINE rotatst (klevel,x, y, rot )
+c
+c  P. Le Van
+c
+c    *****************************************************************
+c     .. calcule le rotationnel a tous les niveaux d'1 vecteur de comp. x et y ..
+c         x  et  y etant des composantes  covariantes  .....
+c    *****************************************************************
+c        x  et y     sont des arguments d'entree pour le s-prog
+c        rot          est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+      INTEGER klevel
+#include "dimensions.h"
+#include "paramet.h"
+
+      REAL rot( ip1jm,klevel )
+      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
+      INTEGER  l, ij
+c
+c
+      DO 5 l = 1,klevel
+c
+      DO 1 ij = 1, ip1jm - 1
+      rot( ij,l )  =  (  y( ij+1 , l )  -  y( ij,l )   +
+     *                 x(ij +iip1, l )  -  x( ij,l )  )
+   1  CONTINUE
+c
+c    .... correction pour rot( iip1,j,l)  ....
+c
+c    ....   rot(iip1,j,l)= rot(1,j,l) ...
+CDIR$ IVDEP
+      DO 2 ij = iip1, ip1jm, iip1
+      rot( ij,l ) = rot( ij -iim,l )
+   2  CONTINUE
+c
+   5  CONTINUE
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/scal_wind.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/scal_wind.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/scal_wind.F	(revision 2744)
@@ -0,0 +1,55 @@
+      SUBROUTINE scal_wind(xus,xvs,xu,xv)
+c=======================================================================
+c
+c
+c   Subject:
+c   ------
+c On passe  les variable xus, xvs  aux points de vent u et v (xu et xv)
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      REAL xu(iip1,jjp1,llm),xv(iip1,jjm,llm)
+      REAL xus(iip1,jjp1,llm), xvs (iip1,jjp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER i,j,l
+
+c-----------------------------------------------------------------------
+
+c   transport zonal:
+c   ----------------
+      DO l=1,llm
+        Do j=1,jjp1
+	      DO i=1,iim
+            xu(i,j,l)=0.5*(xus(i,j,l)+xus(i+1,j,l))
+	      ENDDO
+          xu(iip1,j,l)=xu(1,j,l)
+	    ENDDO
+      ENDDO
+
+
+c   Transport meridien:
+c   -------------------
+      DO l=1,llm
+         DO j=1,jjm
+           do i=1 ,iip1
+	         xv(i,j,l)=.5*(xvs(i,j,l)+xvs(i,j+1,l))
+           end do
+	     ENDDO
+	  ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/serre.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/serre.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/serre.h	(revision 2744)
@@ -0,0 +1,6 @@
+c..include serre.h
+c
+       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
+     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo , 
+     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sortvarc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sortvarc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sortvarc.F	(revision 2744)
@@ -0,0 +1,164 @@
+      SUBROUTINE sortvarc
+     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
+     $ vcov )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:    P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   sortie des variables de controle
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "logic.h"
+#include "temps.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER itau
+      REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL vcov(ip1jm,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL vorpot(ip1jm,llm)
+      REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
+      REAL dp(ip1jmp1)
+      REAL time
+      REAL pk(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
+      REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
+      REAL cosphi(ip1jm),omegcosp(ip1jm)
+      REAL dtvrs1j,rjour,heure,radsg,radomeg
+      REAL rday, massebxy(ip1jm,llm)
+      INTEGER  l, ij, imjmp1
+
+      EXTERNAL  filtreg, massbarxy
+c     EXTERNAL FLUSH
+      EXTERNAL   SSUM, SCOPY 
+      REAL       SSUM
+
+c-----------------------------------------------------------------------
+
+       dtvrs1j   = dtvr/daysec
+       rjour     = FLOAT( INT( itau * dtvrs1j ))
+       heure     = ( itau*dtvrs1j-rjour ) * 24.
+       imjmp1    = iim * jjp1
+       IF(ABS(heure - 24.).LE.0.0001 ) heure = 0.
+c
+       CALL massbarxy ( masse, massebxy )
+
+c   .....  Calcul  de  rmsdpdt  .....
+
+       CALL multipl(ip1jmp1,dp,dp,ge)
+
+       rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+c
+       rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1) 
+
+       CALL SCOPY( ijp1llm,bern,1,bernf,1 )
+       CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1)
+
+c   .....  Calcul du moment  angulaire   .....
+
+       radsg    = rad /g
+       radomeg  = rad * omeg
+c
+       DO ij=iip2,ip1jm
+          cosphi( ij ) = COS(rlatu((ij-1)/iip1+1))
+          omegcosp(ij) = radomeg   * cosphi(ij)
+       ENDDO
+
+c  ...  Calcul  de l'energie,de l'enstrophie,de l'entropie et de rmsv  .
+
+       DO l=1,llm
+          DO ij = 1,ip1jm
+             vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
+          ENDDO
+          ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1))
+
+          DO ij = 1,ip1jmp1
+             ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l)  +
+     s        bernf(ij,l)-phi(ij,l))
+          ENDDO
+          etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO   ij   = 1, ip1jmp1
+             ge(ij) = masse(ij,l)*teta(ij,l)
+          ENDDO
+          stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO ij=1,ip1jmp1
+             ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.)
+          ENDDO
+          rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1))
+
+          DO ij =iip2,ip1jm
+             ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
+     *               cosphi(ij)
+          ENDDO
+          angl(l) = radsg *
+     s    (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
+      ENDDO
+
+          DO ij=1,ip1jmp1
+            ge(ij)= ps(ij)*aire(ij)
+          ENDDO
+      ptot  = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
+      etot  = SSUM(     llm, etotl, 1 )
+      ztot  = SSUM(     llm, ztotl, 1 )
+      stot  = SSUM(     llm, stotl, 1 )
+      rmsv  = SSUM(     llm, rmsvl, 1 )
+      ang   = SSUM(     llm,  angl, 1 )
+
+      rday = FLOAT(INT ( day_ini + time ))
+c
+      IF(ptot0.eq.0.)  THEN
+         PRINT 3500, itau, rday, heure,time
+         PRINT*,'WARNING!!! On recalcule les valeurs initiales de :'
+         PRINT*,'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
+         PRINT *, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
+         etot0 = etot
+         ptot0 = ptot
+         ztot0 = ztot
+         stot0 = stot
+         ang0  = ang
+      END IF
+
+      etot= etot/etot0
+      rmsv= SQRT(rmsv/ptot)
+      ptot= ptot/ptot0
+      ztot= ztot/ztot0
+      stot= stot/stot0
+      ang = ang /ang0
+
+
+      PRINT 3500, itau, rday, heure, time
+      PRINT 4000, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
+
+      RETURN
+
+3500   FORMAT('0',10(1h*),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x 
+     *   ,'date',f10.5,4x,10(1h*))
+4000   FORMAT(10x,'masse',4x,'rmsdpdt',7x,'energie',2x,'enstrophie'
+     * ,2x,'entropie',3x,'rmsv',4x,'mt.ang'/6x,f10.6,e13.6,5f10.3/
+     * )
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sortvarc0.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sortvarc0.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sortvarc0.F	(revision 2744)
@@ -0,0 +1,141 @@
+      SUBROUTINE sortvarc0
+     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
+     $ vcov)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:    P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   sortie des variables de controle
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "logic.h"
+#include "temps.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER itau
+      REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL vcov(ip1jm,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL vorpot(ip1jm,llm)
+      REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
+      REAL dp(ip1jmp1)
+      REAL time
+      REAL pk(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
+      REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
+      REAL cosphi(ip1jm),omegcosp(ip1jm)
+      REAL dtvrs1j,rjour,heure,radsg,radomeg
+      REAL rday, massebxy(ip1jm,llm)
+      INTEGER  l, ij, imjmp1
+
+      EXTERNAL  filtreg, massbarxy
+c     EXTERNAL FLUSH
+      EXTERNAL   SSUM, SCOPY ,ismin,ismax
+      REAL       SSUM
+      integer  ismin,ismax
+
+c-----------------------------------------------------------------------
+
+       dtvrs1j   = dtvr/daysec
+       rjour     = FLOAT( INT( itau * dtvrs1j ))
+       heure     = ( itau*dtvrs1j-rjour ) * 24.
+       imjmp1    = iim * jjp1
+       IF(ABS(heure - 24.).LE.0.0001 ) heure = 0.
+c
+       CALL massbarxy ( masse, massebxy )
+
+c   .....  Calcul  de  rmsdpdt  .....
+
+       CALL multipl(ip1jmp1,dp,dp,ge)
+
+       rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+c
+       rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1) 
+
+       CALL SCOPY( ijp1llm,bern,1,bernf,1 )
+       CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1)
+
+c   .....  Calcul du moment  angulaire   .....
+
+       radsg    = rad /g
+       radomeg  = rad * omeg
+c
+       DO ij=iip2,ip1jm
+          cosphi( ij ) = COS(rlatu((ij-1)/iip1+1))
+          omegcosp(ij) = radomeg   * cosphi(ij)
+       ENDDO
+
+c  ...  Calcul  de l'energie,de l'enstrophie,de l'entropie et de rmsv  .
+
+       DO l=1,llm
+          DO ij = 1,ip1jm
+             vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
+          ENDDO
+          ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1))
+
+          DO ij = 1,ip1jmp1
+             ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l)  +
+     s        bernf(ij,l)-phi(ij,l))
+          ENDDO
+          etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO   ij   = 1, ip1jmp1
+             ge(ij) = masse(ij,l)*teta(ij,l)
+          ENDDO
+          stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO ij=1,ip1jmp1
+             ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.)
+          ENDDO
+          rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1))
+
+          DO ij =iip2,ip1jm
+             ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
+     *               cosphi(ij)
+          ENDDO
+          angl(l) = radsg *
+     s    (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
+      ENDDO
+
+          DO ij=1,ip1jmp1
+            ge(ij)= ps(ij)*aire(ij)
+          ENDDO
+      ptot0  = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
+      etot0  = SSUM(     llm, etotl, 1 )
+      ztot0  = SSUM(     llm, ztotl, 1 )
+      stot0  = SSUM(     llm, stotl, 1 )
+      rmsv   = SSUM(     llm, rmsvl, 1 )
+      ang0   = SSUM(     llm,  angl, 1 )
+
+      rday = day_ini
+c
+      PRINT 3500, itau, rday, heure, time
+      PRINT *, ptot0,etot0,ztot0,stot0,ang0
+
+3500   FORMAT('0',10(1h*),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x 
+     *   ,'date',f10.5,4x,10(1h*))
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/spline.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/spline.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/spline.F	(revision 2744)
@@ -0,0 +1,76 @@
+      subroutine spline(x,y,n,yp1,ypn,y2)
+     
+c
+     
+c     Routine to set up the interpolating function for a cubic spline
+     
+c     interpolation (see "Numerical Recipes" for details).
+     
+c
+      implicit real (a-h,o-z)
+      implicit integer (i-n)
+     
+      parameter(nllm=4096)
+     
+      dimension x(n),y(n),y2(n),u(nllm)
+     
+c
+c	write(6,*)(x(i),i=1,n)
+c	write(6,*)(y(i),i=1,n)
+     
+      if(yp1.gt.0.99E30) then
+c the lower boundary condition is set
+       y2(1)=0.
+c either to be "natural"
+       u(1)=0.
+     
+      else
+c or else to have a specified first
+       y2(1)=-0.5
+c derivative
+       u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
+     
+      end if
+     
+      do 11 i=2,n-1
+c decomposition loop of the tridiagonal
+       sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
+c algorithm. Y2 and U are used
+       p=sig*y2(i-1)+2.
+c for temporary storage of the decompo-
+       y2(i)=(sig-1.)/p
+c sed factors
+       u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1))
+     
+     . /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p
+     
+ 11   continue
+     
+      if(ypn.gt.0.99E30) then
+c the upper boundary condition is set
+       qn=0.
+c either to be "natural"
+       un=0.
+     
+      else
+c or else to have a specified first
+       qn=0.5
+c derivative
+       un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
+     
+      end if
+     
+      y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.)
+     
+      do 12 k=n-1,1,-1
+c this is the backsubstitution loop of
+       y2(k)=y2(k)*y2(k+1)+u(k)
+c the tridiagonal algorithm
+ 12   continue
+     
+c
+     
+      return
+     
+      end
+     
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/splint.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/splint.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/splint.F	(revision 2744)
@@ -0,0 +1,53 @@
+     
+      SUBROUTINE splint(xa,ya,y2a,n,x,y)
+     
+c
+c     Routine to compute a cubic-spline interpolated value Y given the
+c     value of X, the arrays XA, YA and the 2nd derivative array Y2A
+c     computed by SUBROUTINE SPLINE. See "Numerical Recipes" for details
+c
+     
+      IMPLICIT REAL (a-h,o-z)
+      IMPLICIT INTEGER (i-n)
+      DIMENSION xa(n),ya(n),y2a(n)
+     
+      kl0=1
+     
+      khi=n
+c means of bisection
+ 1    IF(khi-kl0.gt.1) THEN
+     
+       k=(khi+kl0)/2
+     
+       IF(xa(k).gt.x) THEN
+     
+        khi=k
+     
+       ELSE
+     
+        kl0=k
+     
+       END IF
+     
+       GO TO 1
+     
+      END IF
+c KL0 and KHI now bracket the X
+      h=xa(khi)-xa(kl0)
+     
+      IF(h.eq.0.0) STOP
+      a=(xa(khi)-x)/h
+c evaluation of cubic spline polynomial
+      b=(x-xa(kl0))/h
+     
+      y=a*ya(kl0)+b*ya(khi)+((a**3-a)*y2a(kl0)+(b**3-b)*y2a(khi))*(h**2)
+     
+     ./6.
+     
+c
+     
+      RETURN
+     
+      END
+     
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sponge.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sponge.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sponge.F	(revision 2744)
@@ -0,0 +1,137 @@
+      subroutine sponge(ucov,vcov,h,pext,dt,mode)
+      implicit none
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "sponge.h"
+      real ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm)
+      real h(iip1,jjp1,llm),pext(iip1,jjp1)
+      real dt
+      real sig_s(llm) !sigma au milieu des couches
+      save sig_s
+
+c   Local:
+c   ------
+
+      REAL vm,um,hm,ptot(jjp1)
+      real cst(llm)
+      integer mode
+
+      INTEGER l,i,j,l0
+
+      real ssum
+
+      real echelle,zkm
+      logical firstcall
+      save firstcall,cst,l0
+      data firstcall/.true./
+
+      if (firstcall) then
+       do l=1,llm
+          sig_s(l)=((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
+       enddo
+
+       IF (mode.eq.3) then
+         l0=llm-2
+         echelle=10.
+ 
+         PRINT*
+         print*,'sponge mode',mode
+         print*,'hsponge',hsponge
+         print*,'tetasponge n intervient pas'
+         print*,'Constantes de dissipations fixees comme les anglais'
+         print*,'Coeffs pour la couche en eponge'
+         print*,'Z (km)  tau'
+         cst(llm)=dt/(0.5*88775)
+         cst(llm-1)=dt/(88775)
+         cst(l0)=dt/(2*88775)
+         do l=l0,llm
+            zkm=-echelle*log(sig_s(l))
+            print*,zkm,dt/cst(l),cst(l)
+         enddo
+         firstcall=.false.
+         PRINT*
+       ELSE
+         l0=1
+         echelle=10.
+ 
+         PRINT*
+         print*,'sponge mode',mode
+         print*,'hsponge tetasponge ',hsponge,tetasponge
+         print*,'Coeffs pour la couche en eponge'
+         print*,'Z (km)  tau'
+         do l=1,llm
+            zkm=-echelle*log(sig_s(l))
+            cst(l)=.5*(1.+tanh((zkm-hsponge)/echelle))
+            cst(l)= max(tetasponge*1.e-15,cst(l))
+            print*,zkm,1./cst(l)*tetasponge,cst(l)*dt/tetasponge
+            cst(l)=cst(l)*dt/tetasponge
+         enddo
+         firstcall=.false.
+         PRINT*
+       ENDIF
+      endif
+
+c-----------------------------------------------------------------------
+c   calcul de la dissipation:
+c   -------------------------
+
+      do j=1,jjp1
+         ptot(j)=ssum(iim,pext(1,j),1)
+      enddo
+ 
+c   temperature potentielle
+      do l=l0,llm
+         do j=1,jjp1
+            hm=0.
+            do i=1,iim
+               hm=hm+h(i,j,l)*pext(i,j)
+            enddo
+            hm=hm/ptot(j)
+            do i=1,iim
+               h(i,j,l)=h(i,j,l)-cst(l)*(h(i,j,l)-hm)
+            enddo
+            h(iip1,j,l)=h(1,j,l)
+         enddo
+      enddo
+
+c   vent zonal
+      do l=l0,llm
+         do j=2,jjm
+            um=0.
+            if(mode.ge.1) then
+               do i=1,iim
+                  um=um+0.5*ucov(i,j,l)*(pext(i,j)+pext(i+1,j))
+     s               /cu(i,j)
+               enddo
+               um=um/ptot(j)
+            endif
+            do i=1,iim
+               ucov(i,j,l)=ucov(i,j,l)-cst(l)*(ucov(i,j,l)-um*cu(i,j))
+            enddo
+            ucov(iip1,j,l)=ucov(1,j,l)
+         enddo
+      enddo
+
+c  vent meridien
+      do l=l0,llm
+         do j=1,jjm
+            vm=0.
+            if(mode.ge.2) then
+               do i=1,iim
+                  vm=vm+vcov(i,j,l)*(pext(i,j)+pext(i,j+1))
+     s               /cv(i,j)
+               enddo
+               vm=vm/(ptot(j)+ptot(j+1))
+            endif
+            do i=1,iim
+               vcov(i,j,l)=vcov(i,j,l)-cst(l)*(vcov(i,j,l)-vm*cv(i,j))
+            enddo
+            vcov(iip1,j,l)=vcov(1,j,l)
+         enddo
+      enddo
+
+      RETURN
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sponge.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sponge.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/sponge.h	(revision 2744)
@@ -0,0 +1,9 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'sponge.h'
+
+      COMMON/com_sponge/callsponge,mode_sponge,hsponge,tetasponge
+
+      LOGICAL   callsponge
+      INTEGER   mode_sponge
+      REAL   hsponge,tetasponge
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/start2archive.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/start2archive.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/start2archive.F	(revision 2744)
@@ -0,0 +1,354 @@
+c=======================================================================
+      PROGRAM start2archive
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c
+c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
+c   -----    "startfi" a un fichier netcdf unique "start_archive" 
+c
+c  "start_archive" est une banque d'etats initiaux:
+c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
+c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
+c 
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "description.h"
+
+#include "dimphys.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c variables dynamiques du GCM
+c -----------------------------
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL teta(ip1jmp1,llm)                    ! temperature potentielle 
+      REAL q(ip1jmp1,llm,nqmx)               ! champs advectes
+      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
+      REAL pk(ip1jmp1,llm)
+      REAL pkf(ip1jmp1,llm)
+      REAL beta(iip1,jjp1,llm)
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
+      REAL ps(ip1jmp1)                       ! pression au sol
+      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
+      
+c Variable Physiques (grille physique)
+c ------------------------------------
+      REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx),co2ice(ngridmx)
+      REAL q2(ngridmx,nlayermx+1),qsurf(ngridmx,nqmx)
+      REAL emis(ngridmx)
+      INTEGER start,length
+      PARAMETER (length = 100)
+      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
+      INTEGER*4 day_ini_fi
+
+c Variable naturelle / grille scalaire
+c ------------------------------------
+      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
+      REAL tsurfS(ip1jmp1),tsoilS(ip1jmp1,nsoilmx),co2iceS(ip1jmp1)
+      REAL q2S(ip1jmp1,llm+1),qsurfS(ip1jmp1,nqmx)
+      REAL emisS(ip1jmp1)
+
+c Variables intermediaires : vent naturel, mais pas coord scalaire
+c----------------------------------------------------------------
+      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
+
+c Autres  variables
+c -----------------
+      LOGICAL startdrs
+      INTEGER Lmodif
+
+      REAL ptotal, co2icetotal
+      REAL timedyn,timefi !fraction du jour dans start, startfi
+      REAL date
+
+      CHARACTER*2 str2
+      CHARACTER*80 fichier 
+      data  fichier /'startfi'/
+
+      INTEGER ij, l,i,j,isoil,iq
+      character*80      fichnom
+      integer :: ierr,ntime
+
+c Netcdf
+c-------
+      integer varid,dimid,timelen 
+      INTEGER nid,nid1
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      grireg   = .TRUE.
+
+c=======================================================================
+c Lecture des donnees
+c=======================================================================
+
+      fichnom = 'start.nc'
+      CALL dynetat0(fichnom,nqmx,vcov,ucov,teta,q,masse,
+     .       ps,phis,timedyn)
+
+      fichnom = 'startfi.nc'
+      Lmodif=0
+
+      CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,nqmx,day_ini_fi,timefi,
+     .      tsurf,tsoil,emis,q2,qsurf,co2ice)
+
+       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
+       IF (ierr.NE.NF_NOERR) THEN
+         write(6,*)' Pb d''ouverture du fichier'//fichnom
+        CALL ABORT
+       ENDIF
+                                                
+      ierr = NF_INQ_VARID (nid1, "controle", varid)
+      IF (ierr .NE. NF_NOERR) THEN
+       PRINT*, "start2archive: Le champ <controle> est absent"
+       CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
+#else
+      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
+#endif
+       IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "start2archive: Lecture echoue pour <controle>"
+          CALL abort
+       ENDIF
+                                
+      ierr = NF_CLOSE(nid1)
+
+c-----------------------------------------------------------------------
+c Controle de la synchro
+c-----------------------------------------------------------------------
+!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) 
+      if ((day_ini_fi.ne.day_ini)) 
+     &  stop ' Probleme de Synchro entre start et startfi !!!'
+
+
+c *****************************************************************
+c    Option : Reinitialisation des dates dans la premieres annees :
+       do while (day_ini.ge.669)
+          day_ini=day_ini-669
+       enddo
+c *****************************************************************
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .FALSE. )
+      call iniconst
+      call inigeom
+      call inifilr
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+
+c=======================================================================
+c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
+c=======================================================================
+c  Les variables modeles dependent de la resolution. Il faut donc
+c  eliminer les facteurs responsables de cette dependance
+c  (pour utiliser newstart)
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Vent   (depend de la resolution horizontale) 
+c-----------------------------------------------------------------------
+c
+c ucov --> un  et  vcov --> vn
+c un --> us  et   vn --> vs
+c
+c-----------------------------------------------------------------------
+
+      call covnat(llm,ucov, vcov, un, vn) 
+      call wind_scal(un,vn,us,vs) 
+
+c-----------------------------------------------------------------------
+c Temperature  (depend de la resolution verticale => de "sigma.def")
+c-----------------------------------------------------------------------
+c
+c h --> T
+c
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c Variable physique 
+c-----------------------------------------------------------------------
+c
+c tsurf --> tsurfS
+c co2ice --> co2iceS
+c tsoil --> tsoilS
+c emis --> emisS
+c q2 --> q2S
+c qsurf --> qsurfS
+c
+c-----------------------------------------------------------------------
+
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS)
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
+      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
+      call gr_fi_dyn(nqmx,ngridmx,iip1,jjp1,qsurf,qsurfS)
+
+c=======================================================================
+c Info pour controler
+c=======================================================================
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
+           co2icetotal = co2icetotal + 
+     &            co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1))
+         ENDDO
+      ENDDO
+      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
+      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
+
+c-----------------------------------------------------------------------
+c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
+c-----------------------------------------------------------------------
+
+      tab_cntrl_fi(49) = ptotal
+      tab_cntrl_fi(50) = co2icetotal
+
+c=======================================================================
+c Ecriture dans le fichier  "start_archive"
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Ouverture de "start_archive" 
+c-----------------------------------------------------------------------
+
+      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
+ 
+c-----------------------------------------------------------------------
+c  si "start_archive" n'existe pas:
+c    1_ ouverture
+c    2_ creation de l'entete dynamique ("ini_archive")
+c-----------------------------------------------------------------------
+c ini_archive:
+c On met dans l'entete le tab_cntrl dynamique (1 a 16) 
+c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
+c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
+c-----------------------------------------------------------------------
+
+      if (ierr.ne.NF_NOERR) then
+         write(*,*)'OK, Could not open file "start_archive.nc"'
+         write(*,*)'So let s create a new "start_archive"'
+         ierr = NF_CREATE('start_archive.nc', NF_CLOBBER, nid)
+         call ini_archive(nid,day_ini,phis,tab_cntrl_fi)
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture de la coordonnee temps (date en jours)
+c-----------------------------------------------------------------------
+
+      date = day_ini
+      ierr= NF_INQ_VARID(nid,"Time",varid)
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+      ntime=timelen+1
+
+      write(*,*) "******************"
+      write(*,*) "ntime",ntime
+      write(*,*) "******************"
+#ifdef NC_DOUBLE
+      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write(*,*) "time matter ",NF_STRERROR(ierr)
+         stop
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture des champs  (co2ice,emis,ps,Tsurf,T,u,v,q2,q,qsurf)
+c-----------------------------------------------------------------------
+c ATTENTION: q2 a une couche de plus!!!!
+c    Pour creer un fichier netcdf lisible par grads,
+c    On passe donc une des couches de q2 a part
+c    comme une variable 2D (la couche au sol: "q2surf")
+c    Les lmm autres couches sont nommees "q2atm" (3D) 
+c-----------------------------------------------------------------------
+
+      call write_archive(nid,ntime,'co2ice','couche de glace co2',
+     &  'kg/m2',2,co2iceS)
+      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
+      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
+      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
+      call write_archive(nid,ntime,'temp','temperature','K',3,t)
+      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
+      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
+      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
+     .              q2S)
+      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
+     .              q2S(1,2))
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  tsoil  ( Tg[1,10] )
+c-----------------------------------------------------------------------
+c "tsoil" Temperature au sol definie dans 10 couches dans le sol
+c   Les 10 couches sont lues comme 10 champs 
+c  nommees Tg[1,10]
+
+      do isoil=1,nsoilmx
+       write(str2,'(i2.2)') isoil
+       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
+     .   'K',2,tsoilS(1,isoil))
+      enddo
+c-----------------------------------------------------------------------
+c Ecriture du champs  q  ( q[1,nqmx] )
+c-----------------------------------------------------------------------
+      do iq=1,nqmx
+       write(str2,'(i2.2)') iq
+        call write_archive(nid,ntime,'q'//str2,'tracer','kg/kg',
+     .         3,q(1,1,iq))
+      end do
+c-----------------------------------------------------------------------
+c Ecriture du champs  qsurf  ( qsurf[1,nqmx] )
+c-----------------------------------------------------------------------
+      do iq=1,nqmx
+       write(str2,'(i2.2)') iq
+       call write_archive(nid,ntime,'qsurf'//str2,'Tracer on surface',
+     $  'kg.m-2',2,qsurfS(1,iq))
+      enddo
+
+      ierr=NF_CLOSE(nid)
+
+c-----------------------------------------------------------------------
+c Fin 
+c-----------------------------------------------------------------------
+
+      end 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/temps.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/temps.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/temps.h	(revision 2744)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'temps.h'
+
+      COMMON/temps/itaufin,dt,
+     s  day_ini,day_end,anne_ini
+
+      INTEGER  itaufin
+      INTEGER*4 day_ini,day_end,anne_ini
+      REAL     dt
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/test_period.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/test_period.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/test_period.F	(revision 2744)
@@ -0,0 +1,86 @@
+      SUBROUTINE test_period ( ucov, vcov, teta, q, p, phis )
+c
+c     Auteur : P. Le Van  
+c    ---------
+c  ....  Cette routine teste la periodicite en longitude des champs   ucov,
+c                           teta, q , p et phis                 .......... 
+c
+c     IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+c
+c    ......  Arguments   ......
+c
+      REAL ucov(ip1jmp1,llm), vcov(ip1jm,llm), teta(ip1jmp1,llm) ,
+     ,      q(ip1jmp1,llm,nqmx), p(ip1jmp1,llmp1), phis(ip1jmp1)
+c
+c   .....  Variables  locales  .....
+c
+      INTEGER ij,l,nq
+c
+      DO l = 1, llm
+         DO ij = 1, ip1jmp1, iip1
+          IF( ucov(ij,l).NE.ucov(ij+iim,l) )  THEN
+          PRINT *,'STOP dans test_period car ---  UCOV  ---  n est pas',  
+     ,  ' periodique en longitude ! '
+          PRINT *,' l,  ij = ', l, ij, ij+iim
+          STOP
+          ENDIF
+          IF( teta(ij,l).NE.teta(ij+iim,l) )  THEN
+          PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas',  
+     ,   ' periodique en longitude ! '
+          PRINT *,' l,  ij = ', l, ij, ij+iim
+          STOP
+          ENDIF
+         ENDDO
+      ENDDO
+
+c
+      DO l = 1, llm
+         DO ij = 1, ip1jm, iip1
+          IF( vcov(ij,l).NE.vcov(ij+iim,l) )  THEN
+          PRINT *,'STOP dans test_period car ---  VCOV  ---  n est pas',  
+     ,   ' periodique en longitude !'
+          PRINT *,' l,  ij = ', l, ij, ij+iim,vcov(ij+iim,l),vcov(ij,l)
+          vcov(ij+iim,l)=vcov(ij,l)
+          STOP
+          ENDIF
+         ENDDO
+      ENDDO
+      
+c
+      DO nq =1, nqmx
+        DO l =1, llm
+          DO ij = 1, ip1jmp1, iip1
+          IF( q(ij,l,nq).NE.q(ij+iim,l,nq) )  THEN
+          PRINT *,'STOP dans test_period car ---  Q  ---  n est pas ',  
+     ,   'periodique en longitude !'
+          PRINT *,' nq , l,  ij, ij+iim = ', nq, l, ij, ij+iim
+        PRINT *,'q(ij,l,nq) q(ij+iim,l,nq) ',q(ij,l,nq),q(ij+iim,l,nq)
+          STOP
+          ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+c
+       DO l = 1, llm
+         DO ij = 1, ip1jmp1, iip1
+          IF( p(ij,l).NE.p(ij+iim,l) )  THEN
+          PRINT *,'STOP dans test_period car ---  P  ---  n est pas',  
+     ,    ' periodique en longitude !'
+          PRINT *,' l ij = ',l, ij, ij+iim
+          STOP
+          ENDIF
+          IF( phis(ij).NE.phis(ij+iim) )  THEN
+          PRINT *,'STOP dans test_period car ---  PHIS  ---  n est pas',  
+     ,   ' periodique en longitude !  l, IJ = ', l, ij,ij+iim
+          PRINT *,' ij = ', ij, ij+iim
+          STOP
+          ENDIF
+         ENDDO
+       ENDDO
+c
+c
+         RETURN
+         END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/testharm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/testharm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/testharm.F	(revision 2744)
@@ -0,0 +1,44 @@
+      PROGRAM testharm
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+
+      integer i,j,ii,jj
+      real pi
+      real psi(jjp1,jjp1,iim) , fphi(iim,iim)
+      character file*20, str2*2, str2b*2
+
+#include "serre.h"
+#include "fxyprim.h"
+
+      pi=2.*asin(1.)
+
+      call harmspher( fphi,psi )
+      print*,'FIN de harmspher'
+
+      do i=1,iim
+         write(str2,'(i2.2)') i
+         file='Phi'//str2
+         open(10,file=file,form='formatted')
+         print*,'i,file',i,file
+         do ii=1,iim
+            write(10,*) fx(float(ii))*180./pi,fphi(ii,i)
+         enddo
+         close(10)
+      enddo
+
+      do i=1,iim
+         do j=1,jjp1
+            write(str2,'(i2.2)') i
+            write(str2b,'(i2.2)') j
+            file='Psi.'//str2//'.'//str2b
+            open(10,file=file,form='formatted')
+            do jj=1,jjp1
+               write(10,*) fy(float(jj))*180./pi,psi(jj,j,i)
+            enddo
+            close(10)
+         enddo
+      enddo
+
+      end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/tourpot.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/tourpot.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/tourpot.F	(revision 2744)
@@ -0,0 +1,79 @@
+      SUBROUTINE tourpot ( vcov, ucov, massebxy, vorpot )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c    *******************************************************************
+c    .........      calcul du tourbillon potentiel             .........
+c    *******************************************************************
+c
+c     vcov,ucov,fext et pbarxyfl sont des argum. d'entree pour le s-pg .
+c             vorpot            est  un argum.de sortie pour le s-pg .
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "logic.h"
+
+      REAL  rot( ip1jm,llm )
+      REAL vcov( ip1jm,llm ),ucov( ip1jmp1,llm )
+      REAL massebxy( ip1jm,llm ),vorpot( ip1jm,llm )
+
+      INTEGER l, ij
+
+      EXTERNAL filtreg
+
+
+
+c  ... vorpot = ( Filtre( d(vcov)/dx - d(ucov)/dy ) + fext ) /psbarxy ..
+
+
+
+c    ........  Calcul du rotationnel du vent V  puis filtrage  ........
+
+      DO 5 l = 1,llm
+
+      DO 2 ij = 1, ip1jm - 1
+      rot( ij,l ) = vcov(ij+1,l)-vcov(ij,l)+ucov(ij+iip1,l)-ucov(ij,l)
+   2  CONTINUE
+
+c    ....  correction pour  rot( iip1,j,l )  .....
+c    ....     rot(iip1,j,l) = rot(1,j,l)    .....
+
+CDIR$ IVDEP
+
+      DO 3 ij = iip1, ip1jm, iip1
+      rot( ij,l ) = rot( ij -iim, l )
+   3  CONTINUE
+
+   5  CONTINUE
+
+
+      CALL filtreg( rot, jjm, llm, 2, 1, .FALSE., 1 )
+
+
+      DO 10 l = 1, llm
+
+      DO 6 ij = 1, ip1jm - 1
+      vorpot( ij,l ) = ( rot(ij,l) + fext(ij) ) / massebxy(ij,l)
+   6  CONTINUE
+
+c    ..... correction pour  vorpot( iip1,j,l)  .....
+c    ....   vorpot(iip1,j,l)= vorpot(1,j,l) ....
+CDIR$ IVDEP
+      DO 8 ij = iip1, ip1jm, iip1
+      vorpot( ij,l ) = vorpot( ij -iim,l )
+   8  CONTINUE
+
+  10  CONTINUE
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/traceur.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/traceur.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/traceur.F	(revision 2744)
@@ -0,0 +1,81 @@
+      SUBROUTINE traceur (iq,iadv,q,teta,pk,w, pbaru, pbarv,dq )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  F.Forget / A.Armengaud
+c   -------
+c
+c   ....  Modif  P.Le Van  ,  29/04/97  et 01/06/98    ....
+c
+c   ********************************************************************
+c   Transport des traceurs (dont l'humidite q(1)) par differents shemas
+c   ********************************************************************
+c     iq,q,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c     iadv = 1 :  Schema de transport type "humidite specifique  LMD"
+c                 (shema amont (horiz),moy arithmetique (vertic))
+c
+c     iadv = 2  :  Shema amont
+c
+c
+c     iadv = 0  : Indice montrant que q n'est pas vraiment un 
+c                traceur, mais une variable pronostique attachee
+c                (par exemple : une pente du shemas de pente)
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+
+c   Arguments:
+c   ----------
+      INTEGER iq,iadv(iq) 
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q( ip1jmp1,llm,iq), dq( ip1jmp1,llm,iq)
+      REAL w(ip1jmp1,llm),teta(ip1jmp1,llm),pk(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      LOGICAL     qsat
+      PARAMETER ( qsat = .TRUE. )
+
+c
+cc ******     Si  iadv(iq) =  2   et   qsat = .TRUE.  ,   
+cc        ,  on choisit  le shema  amont avec le q sature   ********
+c
+
+      EXTERNAL adv_h2o, amont, amont_qsat
+
+
+       IF( iadv(iq).GT.2 )  THEN
+         PRINT *,' Erreur dans le choix de iadv  pour la routine 
+     *  traceur .  Corrigez . '
+         STOP
+       ENDIF
+
+c   ----------------------------------------------------------------
+c   Schema de transport type "humidite specifique  LMD" 
+c   (shema amont (horiz),moy arithmetique (vertic))
+c   ----------------------------------------------------------------
+         IF (iadv(iq).EQ.1) THEN
+              CALL adv_h2o (iq,iq,q,w, pbaru, pbarv,dq)       
+c   ----------------------------------------------------------------
+c   Shema amont (dans les 3 dimensions)
+c   ----------------------------------------------------------------
+         ELSE IF (iadv(iq).EQ.2) THEN
+           IF( qsat )   THEN
+              CALL amont_qsat ( iq,iq,q,teta,pk,w, pbaru, pbarv,dq )
+           ELSE
+              CALL amont      ( iq,iq,q,        w, pbaru, pbarv,dq )
+           ENDIF
+c   ----------------------------------------------------------------
+
+         ENDIF
+
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/tracstoke.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/tracstoke.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/tracstoke.h	(revision 2744)
@@ -0,0 +1,2 @@
+      common /tracstoke/istdyn,istphy,unittrac
+      integer istdyn,istphy,unittrac
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/tracvl.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/tracvl.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/tracvl.F	(revision 2744)
@@ -0,0 +1,127 @@
+      SUBROUTINE tracvl(numvanle,iapp_tracvl,nq,pbaru,pbarv ,
+     *                    p, masse , q, iapptrac, iadv1, teta, pk  )
+c
+c     Auteur :  F. Hourdin
+c
+c
+ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
+c                 F. Codron     (10/99)
+
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+
+c     .... Arguments  ....
+c
+      INTEGER numvanle, nq, iapp_tracvl, iapptrac, iadv1
+
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
+      REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
+      REAL pk(ip1jmp1,llm)
+
+c     ....  var. locales  .....
+c
+      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
+      REAL massem(ip1jmp1,llm),zdp(ip1jmp1)
+
+      REAL pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
+
+
+      INTEGER iadvtr, numvan
+      INTEGER ij,l,iq
+      REAL zdpmin, zdpmax
+      EXTERNAL  minmax
+      SAVE iadvtr, massem, pbaruc, pbarvc, numvan
+      DATA iadvtr/0/
+
+      numvan = numvanle
+
+      IF(iadvtr.EQ.0) THEN
+         CALL initial0(ijp1llm,pbaruc)
+         CALL initial0(ijmllm,pbarvc)
+      ENDIF
+
+c   accumulation des flux de masse horizontaux
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
+         ENDDO
+      ENDDO
+
+c   selection de la masse instantannee des mailles avant le transport.
+      IF(iadvtr.EQ.0) THEN
+
+         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
+ccc         CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 )
+c
+      ENDIF
+
+      iadvtr   = iadvtr+1
+      iapptrac = iadvtr
+
+
+c   Test pour savoir si on advecte a ce pas de temps
+      IF ( iadvtr.EQ.iapp_tracvl ) THEN
+
+cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
+cc
+
+c   traitement des flux de masse avant advection.
+c     1. calcul de w
+c     2. groupement des mailles pres du pole.
+
+        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
+
+
+c  test sur l'eventuelle creation de valeurs negatives de la masse
+         DO l=1,llm-1
+            DO ij = iip2+1,ip1jm
+              zdp(ij) = pbarug(ij-1,l) - pbarug(ij,l)
+     s                  - pbarvg(ij-iip1,l) + pbarvg(ij,l)
+     s                  + wg(ij,l+1) - wg(ij,l)
+            ENDDO
+            CALL SCOPY( jjm -1 ,zdp(iip1+iip1),iip1,zdp(iip2),iip1 )
+            DO ij = iip2,ip1jm
+               zdp(ij)= zdp(ij)*dtvr/ massem(ij,l) 
+            ENDDO 
+
+
+            CALL minmax ( ip1jm-iip1, zdp(iip2), zdpmin,zdpmax )
+
+            IF(MAX(ABS(zdpmin),ABS(zdpmax)).GT.0.5) THEN
+            PRINT*,'WARNING DP/P l=',l,'  MIN:',zdpmin,
+     s        '   MAX:', zdpmax
+            ENDIF
+
+         ENDDO
+
+c   Advection proprement dite.
+c
+c   test sur iadv1 pour le schema de vapeur d'eau
+c
+         IF (numvanle.EQ.1.AND.iadv1.EQ.4) THEN
+           CALL vlspltqs( q(1,1,1), 2., massem, wg ,
+     *                 pbarug,pbarvg,dtvr,p,pk,teta )
+           numvan = 2
+         ENDIF
+
+         DO iq = numvan, nq
+          CALL vlsplt( q(1,1,iq), 2. ,massem,wg,pbarug,pbarvg,dtvr )
+         ENDDO
+         iadvtr=0
+
+c   on reinitialise a zero les flux de masse cumules.
+
+      ENDIF ! if iadvtr.EQ.iapp_tracvl
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vanleer.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vanleer.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vanleer.F	(revision 2744)
@@ -0,0 +1,71 @@
+      SUBROUTINE vanleer(numvanle,iapp_tracvl,nq,q,pbaru,pbarv ,
+     *                     p ,masse, dq ,  iadv1, teta, pk      )
+c
+      IMPLICIT NONE
+c
+c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron  
+c
+c=======================================================================
+c
+c       Shema de  Van Leer
+c       Version simplifiée pour Mars
+c       (L'original bugue a cause des histoires d'eau terrestre !!)
+c       FF 2003
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+
+c   Arguments:
+c   ----------
+      INTEGER nq, numvanle, iapp_tracvl, iadv1 
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
+      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nq),dq( ip1jmp1,llm,nq )
+      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
+c  ..................................................................
+c
+c   Local:
+c   ------
+
+      EXTERNAL  tracvl,minmaxq, qminimum
+      INTEGER ij,l, iq, iapptrac
+      REAL finmasse(ip1jmp1,llm), dtvrtrac
+cc
+
+        CALL SCOPY( nq * ijp1llm, q, 1, dq, 1 )
+
+c   advection
+
+      CALL tracvl( numvanle,iapp_tracvl,nq,pbaru,pbarv,p , masse,q  ,
+     *                      iapptrac, iadv1, teta ,pk              )
+
+cc     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
+c
+          DO l = 1, llm
+           DO ij = 1, ip1jmp1
+             finmasse(ij,l) =  p(ij,l) - p(ij,l+1) 
+           ENDDO
+          ENDDO
+
+          CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
+          CALL filtreg ( finmasse ,  jjp1,  llm, -2, 2, .TRUE., 1 )
+c
+c   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
+
+          dtvrtrac = iapp_tracvl * dtvr
+c
+           DO iq = 1 , nq ! modif special mars : 2 devient nq
+            DO l = 1 , llm
+             DO ij = 1,ip1jmp1
+             dq(ij,l,iq) = ( q(ij,l,iq) - dq(ij,l,iq) ) * finmasse(ij,l)
+     *                               /  dtvrtrac
+             ENDDO
+            ENDDO
+           ENDDO
+
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vitvert.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vitvert.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vitvert.F	(revision 2744)
@@ -0,0 +1,49 @@
+      SUBROUTINE vitvert ( convm , w )
+c
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:  P. Le Van , F. Hourdin .
+c   -------
+c
+c   Objet:
+c   ------
+c
+c    *******************************************************************
+c  .... calcul de la vitesse verticale aux niveaux sigma  ....
+c    *******************************************************************
+c     convm   est un argument  d'entree pour le s-pg  ......
+c       w     est un argument de sortie pour le s-pg  ......
+c
+c    la vitesse verticale est orientee de  haut en bas .
+c    au sol, au niveau sigma(1),   w(i,j,1) = 0.
+c    au sommet, au niveau sigma(llm+1) , la vit.verticale est aussi
+c    egale a 0. et n'est pas stockee dans le tableau w  .
+c
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+
+      REAL w(ip1jmp1,llm),convm(ip1jmp1,llm)
+      INTEGER   l, ij
+
+
+
+      DO 2  l = 1,llmm1
+
+      DO 1 ij = 1,ip1jmp1
+      w( ij, l+1 ) = convm( ij, l+1 ) - bp(l+1) * convm( ij, 1 )
+   1  CONTINUE
+
+   2  CONTINUE
+
+      DO 5 ij  = 1,ip1jmp1
+      w(ij,1)  = 0.
+5     CONTINUE
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vlsplt.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vlsplt.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vlsplt.F	(revision 2744)
@@ -0,0 +1,887 @@
+      SUBROUTINE vlsplt(q,pente_max,masse,w,pbaru,pbarv,pdt)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c
+c   pente_max facteur de limitation des pentes: 2 en general
+c                                               0 pour un schema amont
+c   pbaru,pbarv,w flux de masse en u ,v ,w
+c   pdt pas de temps
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm),pdt
+c
+c      Local 
+c   ---------
+c
+      INTEGER ij,l
+c
+      REAL zm(ip1jmp1,llm)
+      REAL mu(ip1jmp1,llm)
+      REAL mv(ip1jm,llm)
+      REAL mw(ip1jmp1,llm+1)
+      REAL zq(ip1jmp1,llm)
+      REAL temps1,temps2,temps3
+      REAL zzpbar, zzw
+      LOGICAL testcpu
+      SAVE testcpu
+      SAVE temps1,temps2,temps3
+
+      REAL qmin,qmax
+      DATA qmin,qmax/0.,1.e33/
+      DATA testcpu/.false./
+      DATA temps1,temps2,temps3/0.,0.,0./
+
+c      PRINT*,'Debut vlsplt version debug sans vly'
+
+        zzpbar = 0.5 * pdt
+        zzw    = pdt
+      DO l=1,llm
+        DO ij = iip2,ip1jm
+            mu(ij,l)=pbaru(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jm
+            mv(ij,l)=pbarv(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jmp1
+            mw(ij,l)=w(ij,l) * zzw
+         ENDDO
+      ENDDO
+
+      DO ij=1,ip1jmp1
+         mw(ij,llm+1)=0.
+      ENDDO
+
+      CALL SCOPY(ijp1llm,q,1,zq,1)
+      CALL SCOPY(ijp1llm,masse,1,zm,1)
+
+c      call minmaxq(zq,qmin,qmax,'avant vlx     ')
+      call vlx(zq,pente_max,zm,mu)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vly     ')
+
+      call vly(zq,pente_max,zm,mv)
+
+
+c      call minmaxq(zq,qmin,qmax,'avant vlz     ')
+
+      call vlz(zq,pente_max,zm,mw)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vly     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vly     ')
+
+      call vly(zq,pente_max,zm,mv)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlx     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlx     ')
+
+      call vlx(zq,pente_max,zm,mu)
+
+c     call minmaxq(zq,qmin,qmax,'apres vlx     ')
+c     call minmaxq(zm,qmin,qmax,'M apres vlx     ')
+
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+           q(ij,l)=zq(ij,l)
+         ENDDO
+         DO ij=1,ip1jm+1,iip1
+            q(ij+iim,l)=q(ij,l)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
+      SUBROUTINE vlx(q,pente_max,masse,u_m)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL u_m( ip1jmp1,llm )
+      REAL q(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
+      INTEGER n0,iadvplus(ip1jmp1,llm),nl(llm)
+c
+      REAL new_m,zu_m,zdum(ip1jmp1,llm)
+      REAL dxq(ip1jmp1,llm),dxqu(ip1jmp1)
+      REAL zz(ip1jmp1)
+      REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
+      REAL u_mq(ip1jmp1,llm)
+
+      Logical first,testcpu
+      SAVE first,testcpu
+
+      REAL      SSUM
+      EXTERNAL  SSUM
+      REAL temps1,temps2,temps3,temps4,temps5
+      SAVE temps1,temps2,temps3,temps4,temps5
+
+
+      DATA first,testcpu/.true.,.false./
+
+      IF(first) THEN
+         temps1=0.
+         temps2=0.
+         temps3=0.
+         temps4=0.
+         temps5=0.
+         first=.false.
+      ENDIF
+
+c   calcul de la pente a droite et a gauche de la maille
+
+
+      IF (pente_max.gt.-1.e-5) THEN
+c     IF (pente_max.gt.10) THEN
+
+c   calcul des pentes avec limitation, Van Leer scheme I:
+c   -----------------------------------------------------
+
+c   calcul de la pente aux points u
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+c              IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'
+c              sigu(ij)=u_m(ij,l)/masse(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+c              sigu(ij)=sigu(ij-iim)
+            ENDDO
+
+            DO ij=iip2,ip1jm
+               adxqu(ij)=abs(dxqu(ij))
+            ENDDO
+
+c   calcul de la pente maximum dans la maille en valeur absolue
+
+            DO ij=iip2+1,ip1jm
+               dxqmax(ij,l)=pente_max*
+     ,      min(adxqu(ij-1),adxqu(ij))
+c limitation subtile
+c    ,      min(adxqu(ij-1)/sigu(ij-1),adxqu(ij)/(1.-sigu(ij)))
+          
+
+            ENDDO
+
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqmax(ij-iim,l)=dxqmax(ij,l)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+#ifdef CRAY
+               dxq(ij,l)=
+     ,         cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij))
+#else
+               IF(dxqu(ij-1)*dxqu(ij).gt.0) THEN
+                  dxq(ij,l)=dxqu(ij-1)+dxqu(ij)
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+#endif
+               dxq(ij,l)=0.5*dxq(ij,l)
+               dxq(ij,l)=
+     ,         sign(min(abs(dxq(ij,l)),dxqmax(ij,l)),dxq(ij,l))
+            ENDDO
+
+         ENDDO ! l=1,llm
+
+      ELSE ! (pente_max.lt.-1.e-5)
+
+c   Pentes produits:
+c   ----------------
+
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+               zz(ij)=dxqu(ij-1)*dxqu(ij)
+               zz(ij)=zz(ij)+zz(ij)
+               IF(zz(ij).gt.0) THEN
+                  dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij))
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+            ENDDO
+
+         ENDDO
+
+      ENDIF ! (pente_max.lt.-1.e-5)
+
+c   bouclage de la pente en iip1:
+c   -----------------------------
+
+      DO l=1,llm
+         DO ij=iip1+iip1,ip1jm,iip1
+            dxq(ij-iim,l)=dxq(ij,l)
+         ENDDO
+
+         DO ij=1,ip1jmp1
+            iadvplus(ij,l)=0
+         ENDDO
+
+      ENDDO
+
+
+c   calcul des flux a gauche et a droite
+
+#ifdef CRAY
+
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l),
+     ,                     1.+u_m(ij,l)/masse(ij+1,l),
+     ,                     u_m(ij,l))
+          zdum(ij,l)=0.5*zdum(ij,l)
+          u_mq(ij,l)=cvmgp(
+     ,                q(ij,l)+zdum(ij,l)*dxq(ij,l),
+     ,                q(ij+1,l)-zdum(ij,l)*dxq(ij+1,l),
+     ,                u_m(ij,l))
+          u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
+       ENDDO
+      ENDDO
+#else
+c   on cumule le flux correspondant a toutes les mailles dont la masse
+c   au travers de la paroi pENDant le pas de temps.
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          IF (u_m(ij,l).gt.0.) THEN
+             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l)
+             u_mq(ij,l)=u_m(ij,l)*(q(ij,l)+0.5*zdum(ij,l)*dxq(ij,l))
+          ELSE
+             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l)
+             u_mq(ij,l)=u_m(ij,l)*(q(ij+1,l)-0.5*zdum(ij,l)*dxq(ij+1,l))
+          ENDIF
+       ENDDO
+      ENDDO
+#endif
+
+
+c   detection des points ou on advecte plus que la masse de la
+c   maille
+      DO l=1,llm
+         DO ij=iip2,ip1jm-1
+            IF(zdum(ij,l).lt.0) THEN
+               iadvplus(ij,l)=1
+               u_mq(ij,l)=0.
+            ENDIF
+         ENDDO
+      ENDDO
+      DO l=1,llm
+       DO ij=iip1+iip1,ip1jm,iip1
+          iadvplus(ij,l)=iadvplus(ij-iim,l)
+       ENDDO
+      ENDDO
+
+
+
+c   traitement special pour le cas ou on advecte en longitude plus que le
+c   contenu de la maille.
+c   cette partie est mal vectorisee.
+
+c  calcul du nombre de maille sur lequel on advecte plus que la maille.
+
+      n0=0
+      DO l=1,llm
+         nl(l)=0
+         DO ij=iip2,ip1jm
+            nl(l)=nl(l)+iadvplus(ij,l)
+         ENDDO
+         n0=n0+nl(l)
+      ENDDO
+
+      IF(n0.gt.1) THEN
+ccc      PRINT*,'Nombre de points pour lesquels on advect plus que le'
+ccc     &       ,'contenu de la maille : ',n0
+
+         DO l=1,llm
+            IF(nl(l).gt.0) THEN
+               iju=0
+c   indicage des mailles concernees par le traitement special
+               DO ij=iip2,ip1jm
+                  IF(iadvplus(ij,l).eq.1.and.mod(ij,iip1).ne.0) THEN
+                     iju=iju+1
+                     indu(iju)=ij
+                  ENDIF
+               ENDDO
+               niju=iju
+c              PRINT*,'niju,nl',niju,nl(l)
+
+c  traitement des mailles
+               DO iju=1,niju
+                  ij=indu(iju)
+                  j=(ij-1)/iip1+1
+                  zu_m=u_m(ij,l)
+                  u_mq(ij,l)=0.
+                  IF(zu_m.gt.0.) THEN
+                     ijq=ij
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m-masse(ijq,l)
+                        i=mod(i-2+iim,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*
+     &               (q(ijq,l)+0.5*(1.-zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ELSE
+                     ijq=ij+1
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(-zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m+masse(ijq,l)
+                        i=mod(i,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l)-
+     &               0.5*(1.+zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDIF  ! n0.gt.0 
+
+
+
+c   bouclage en latitude
+
+      DO l=1,llm
+        DO ij=iip1+iip1,ip1jm,iip1
+           u_mq(ij,l)=u_mq(ij-iim,l)
+        ENDDO
+      ENDDO
+
+
+c   calcul des tENDances
+
+      DO l=1,llm
+         DO ij=iip2+1,ip1jm
+            new_m=masse(ij,l)+u_m(ij-1,l)-u_m(ij,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+
+     &      u_mq(ij-1,l)-u_mq(ij,l))
+     &      /new_m
+            masse(ij,l)=new_m
+         ENDDO
+c   ModIF Fred 22 03 96 correction d'un bug (les scopy ci-dessous)
+         DO ij=iip1+iip1,ip1jm,iip1
+            q(ij-iim,l)=q(ij,l)
+            masse(ij-iim,l)=masse(ij,l)
+         ENDDO
+      ENDDO
+
+c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
+c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
+
+
+      RETURN
+      END
+      SUBROUTINE vly(q,pente_max,masse,masse_adv_v)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     q,masse_adv_v,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c     SPECIAL MARS :  on ajoute un test ("max") pour eviter les division
+c     par des "dyq" trop faible (special compilateur SUN) 27/11/2003 F. Forget
+
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse_adv_v( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l
+c
+      REAL airej2,airejjm,airescb(iim),airesch(iim)
+      REAL dyq(ip1jmp1,llm),dyqv(ip1jm)
+      REAL adyqv(ip1jm),dyqmax(ip1jmp1)
+      REAL qbyv(ip1jm,llm)
+
+      REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
+c     REAL newq,oldmasse
+      Logical first,testcpu
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE first,testcpu
+
+      REAL convpn,convps,convmpn,convmps
+      REAL sinlon(iip1),sinlondlon(iip1)
+      REAL coslon(iip1),coslondlon(iip1)
+      SAVE sinlon,coslon,sinlondlon,coslondlon
+      SAVE airej2,airejjm
+c
+c
+      REAL      SSUM
+      EXTERNAL  SSUM
+
+      DATA first,testcpu/.true.,.false./
+      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
+
+      IF(first) THEN
+         PRINT*,'Shema  Amont nouveau  appele dans  Vanleer   '
+         first=.false.
+         do i=2,iip1
+            coslon(i)=cos(rlonv(i))
+            sinlon(i)=sin(rlonv(i))
+            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
+            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
+         ENDDO
+         coslon(1)=coslon(iip1)
+         coslondlon(1)=coslondlon(iip1)
+         sinlon(1)=sinlon(iip1)
+         sinlondlon(1)=sinlondlon(iip1)
+         airej2 = SSUM( iim, aire(iip2), 1 )
+         airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
+      ENDIF
+
+c
+
+
+      DO l = 1, llm
+c
+c   --------------------------------
+c      CALCUL EN LATITUDE
+c   --------------------------------
+
+c   On commence par calculer la valeur du traceur moyenne sur le premier cercle
+c   de latitude autour du pole (qpns pour le pole nord et qpsn pour
+c    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
+
+      DO i = 1, iim
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
+      ENDDO
+      qpns   = SSUM( iim,  airescb ,1 ) / airej2
+      qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
+
+c   calcul des pentes aux points v
+
+      DO ij=1,ip1jm
+         dyqv(ij)=q(ij,l)-q(ij+iip1,l)
+         adyqv(ij)=abs(dyqv(ij))
+      ENDDO
+
+c   calcul des pentes aux points scalaires
+
+      DO ij=iip2,ip1jm
+         dyq(ij,l)=.5*(dyqv(ij-iip1)+dyqv(ij))
+         dyqmax(ij)=min(adyqv(ij-iip1),adyqv(ij))
+         dyqmax(ij)=pente_max*dyqmax(ij)
+      ENDDO
+
+c   calcul des pentes aux poles
+
+      DO ij=1,iip1
+         dyq(ij,l)=qpns-q(ij+iip1,l)
+         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l)-qpsn
+      ENDDO
+
+c   filtrage de la derivee
+      dyn1=0.
+      dys1=0.
+      dyn2=0.
+      dys2=0.
+      DO ij=1,iim
+         dyn1=dyn1+sinlondlon(ij)*dyq(ij,l)
+         dys1=dys1+sinlondlon(ij)*dyq(ip1jm+ij,l)
+         dyn2=dyn2+coslondlon(ij)*dyq(ij,l)
+         dys2=dys2+coslondlon(ij)*dyq(ip1jm+ij,l)
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=dyn1*sinlon(ij)+dyn2*coslon(ij)
+         dyq(ip1jm+ij,l)=dys1*sinlon(ij)+dys2*coslon(ij)
+      ENDDO
+
+c   calcul des pentes limites aux poles
+
+      fn=1.
+      fs=1.
+      DO ij=1,iim
+         IF(pente_max*adyqv(ij).lt.abs(dyq(ij,l))) THEN
+            fn=min(pente_max*adyqv(ij)/ max(abs(dyq(ij,l)),1.E-30),fn)
+         ENDIF
+      IF(pente_max*adyqv(ij+ip1jm-iip1).lt.abs(dyq(ij+ip1jm,l))) THEN
+         fs= min(pente_max*adyqv(ij+ip1jm-iip1) 
+     &              / max(abs(dyq(ij+ip1jm,l)),1.E-30) ,fs)
+         ENDIF
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=fn*dyq(ij,l)
+         dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)
+      ENDDO
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C  En memoire de dIFferents tests sur la 
+C  limitation des pentes aux poles.
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     PRINT*,dyq(1)
+C     PRINT*,dyqv(iip1+1)
+C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     PRINT*,dyq(ip1jm+1)
+C     PRINT*,dyqv(ip1jm-iip1+1)
+C     aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
+C     DO ij=2,iim
+C        apn=amax1(abs(dyq(ij)/dyqv(ij)),apn)
+C        aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps)
+C     ENDDO
+C     apn=min(pente_max/apn,1.)
+C     aps=min(pente_max/aps,1.)
+C
+C
+C   cas ou on a un extremum au pole
+C
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   apn=0.
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &   aps=0.
+C
+C   limitation des pentes aux poles
+C     DO ij=1,iip1
+C        dyq(ij)=apn*dyq(ij)
+C        dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
+C     ENDDO
+C
+C   test
+C      DO ij=1,iip1
+C         dyq(iip1+ij)=0.
+C         dyq(ip1jm+ij-iip1)=0.
+C      ENDDO
+C      DO ij=1,ip1jmp1
+C         dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
+C      ENDDO
+C
+C changement 10 07 96
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   THEN
+C        DO ij=1,iip1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=1,iip1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij))
+C        ENDDO
+C     ENDIF
+C
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &THEN
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij-iip1))
+C        ENDDO
+C     ENDIF
+C   fin changement 10 07 96
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+c   calcul des pentes limitees
+
+      DO ij=iip2,ip1jm
+         IF(dyqv(ij)*dyqv(ij-iip1).gt.0.) THEN
+            dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l))
+         ELSE
+            dyq(ij,l)=0.
+         ENDIF
+      ENDDO
+
+      ENDDO
+
+      DO l=1,llm
+       DO ij=1,ip1jm
+          IF(masse_adv_v(ij,l).gt.0) THEN
+              qbyv(ij,l)=q(ij+iip1,l)+dyq(ij+iip1,l)*
+     ,                   0.5*(1.-masse_adv_v(ij,l)/masse(ij+iip1,l))
+          ELSE
+              qbyv(ij,l)=q(ij,l)-dyq(ij,l)*
+     ,                   0.5*(1.+masse_adv_v(ij,l)/masse(ij,l))
+          ENDIF
+          qbyv(ij,l)=masse_adv_v(ij,l)*qbyv(ij,l)
+       ENDDO
+      ENDDO
+
+
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+            newmasse=masse(ij,l)
+     &      +masse_adv_v(ij,l)-masse_adv_v(ij-iip1,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+qbyv(ij,l)-qbyv(ij-iip1,l))
+     &         /newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. ancienne version
+         convpn=SSUM(iim,qbyv(1,l),1)/apoln
+         convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
+         DO ij = 1,iip1
+            newmasse=masse(ij,l)+convmpn*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convpn*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+         convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
+         convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)/apols
+         DO ij = ip1jm+1,ip1jmp1
+            newmasse=masse(ij,l)+convmps*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convps*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. fin ancienne version
+
+c._. nouvelle version
+c        convpn=SSUM(iim,qbyv(1,l),1)
+c        convmpn=ssum(iim,masse_adv_v(1,l),1)
+c        oldmasse=ssum(iim,masse(1,l),1)
+c        newmasse=oldmasse+convmpn
+c        newq=(q(1,l)*oldmasse+convpn)/newmasse
+c        newmasse=newmasse/apoln
+c        DO ij = 1,iip1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
+c        convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
+c        oldmasse=ssum(iim,masse(ip1jm-iim,l),1)
+c        newmasse=oldmasse+convmps
+c        newq=(q(ip1jmp1,l)*oldmasse+convps)/newmasse
+c        newmasse=newmasse/apols
+c        DO ij = ip1jm+1,ip1jmp1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c._. fin nouvelle version
+      ENDDO
+
+      RETURN
+      END
+      SUBROUTINE vlz(q,pente_max,masse,w)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c    q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL q(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm+1)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+      REAL wq(ip1jmp1,llm+1),newmasse
+
+      REAL dzq(ip1jmp1,llm),dzqw(ip1jmp1,llm),adzqw(ip1jmp1,llm),dzqmax
+      REAL sigw
+
+      LOGICAL testcpu
+      SAVE testcpu
+
+      REAL temps0,temps1,temps2,temps3,temps4,temps5,second
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+      REAL      SSUM
+      EXTERNAL  SSUM, convflu
+      EXTERNAL filtreg
+
+      DATA testcpu/.false./
+      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
+
+c    On oriente tout dans le sens de la pression c'est a dire dans le
+c    sens de W
+
+#ifdef BIDON
+      IF(testcpu) THEN
+         temps0=second(0.)
+      ENDIF
+#endif
+      DO l=2,llm
+         DO ij=1,ip1jmp1
+            dzqw(ij,l)=q(ij,l-1)-q(ij,l)
+            adzqw(ij,l)=abs(dzqw(ij,l))
+         ENDDO
+      ENDDO
+
+      DO l=2,llm-1
+         DO ij=1,ip1jmp1
+#ifdef CRAY
+            dzq(ij,l)=0.5*
+     ,      cvmgp(dzqw(ij,l)+dzqw(ij,l+1),0.,dzqw(ij,l)*dzqw(ij,l+1))
+#else
+            IF(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) THEN
+                dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1))
+            ELSE
+                dzq(ij,l)=0.
+            ENDIF
+#endif
+            dzqmax=pente_max*min(adzqw(ij,l),adzqw(ij,l+1))
+            dzq(ij,l)=sign(min(abs(dzq(ij,l)),dzqmax),dzq(ij,l))
+         ENDDO
+      ENDDO
+
+      DO ij=1,ip1jmp1
+         dzq(ij,1)=0.
+         dzq(ij,llm)=0.
+      ENDDO
+
+#ifdef BIDON
+      IF(testcpu) THEN
+         temps1=temps1+second(0.)-temps0
+      ENDIF
+#endif
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection verticale  .......
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
+
+       DO l = 1,llm-1
+         do  ij = 1,ip1jmp1
+          IF(w(ij,l+1).gt.0.) THEN
+             sigw=w(ij,l+1)/masse(ij,l+1)
+             wq(ij,l+1)=w(ij,l+1)*(q(ij,l+1)+0.5*(1.-sigw)*dzq(ij,l+1))
+          ELSE
+             sigw=w(ij,l+1)/masse(ij,l)
+             wq(ij,l+1)=w(ij,l+1)*(q(ij,l)-0.5*(1.+sigw)*dzq(ij,l))
+          ENDIF
+         ENDDO
+       ENDDO
+
+       DO ij=1,ip1jmp1
+          wq(ij,llm+1)=0.
+          wq(ij,1)=0.
+       ENDDO
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            newmasse=masse(ij,l)+w(ij,l+1)-w(ij,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+wq(ij,l+1)-wq(ij,l))
+     &         /newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+      ENDDO
+
+
+      RETURN
+      END
+      SUBROUTINE minmaxq(zq,qmin,qmax,comment)
+
+#include "dimensions.h"
+#include "paramet.h"
+
+      CHARACTER*(*) comment
+      real qmin,qmax
+      real zq(ip1jmp1,llm)
+
+      INTEGER jadrs(ip1jmp1), jbad, k, i
+
+      DO k = 1, llm
+         jbad = 0
+         DO i = 1, ip1jmp1
+         IF (zq(i,k).GT.qmax .OR. zq(i,k).LT.qmin) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+         IF (jbad.GT.0) THEN
+         PRINT*, comment
+         DO i = 1, jbad
+cc            PRINT*, "i,k,zq=", jadrs(i),k,zq(jadrs(i),k)
+         ENDDO
+         ENDIF
+      ENDDO
+
+      return
+      end
+
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vlspltqs.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vlspltqs.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/vlspltqs.F	(revision 2744)
@@ -0,0 +1,775 @@
+       SUBROUTINE vlspltqs ( q,pente_max,masse,w,pbaru,pbarv,pdt,
+     ,                                  p,pk,teta                 )
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron 
+c
+c    ********************************************************************
+c          Shema  d'advection " pseudo amont " .
+c      + test sur humidite specifique: Q advecte< Qsat aval
+c                   (F. Codron, 10/99)
+c    ********************************************************************
+c     q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c
+c     pente_max facteur de limitation des pentes: 2 en general
+c                                                0 pour un schema amont
+c     pbaru,pbarv,w flux de masse en u ,v ,w
+c     pdt pas de temps
+c
+c     teta temperature potentielle, p pression aux interfaces,
+c     pk exner au milieu des couches necessaire pour calculer Qsat
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm),pdt
+      REAL p(ip1jmp1,llmp1),teta(ip1jmp1,llm),pk(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+      REAL qsat(ip1jmp1,llm)
+      REAL zm(ip1jmp1,llm)
+      REAL mu(ip1jmp1,llm)
+      REAL mv(ip1jm,llm)
+      REAL mw(ip1jmp1,llm+1)
+      REAL zq(ip1jmp1,llm)
+      REAL temps1,temps2,temps3
+      REAL zzpbar, zzw
+      LOGICAL testcpu
+      SAVE testcpu
+      SAVE temps1,temps2,temps3
+
+      REAL qmin,qmax
+      DATA qmin,qmax/0.,1.e33/
+      DATA testcpu/.false./
+      DATA temps1,temps2,temps3/0.,0.,0./
+
+c--pour rapport de melange saturant--
+
+      REAL rtt,retv,r2es,r3les,r3ies,r4les,r4ies,play
+      REAL ptarg,pdelarg,foeew,zdelta
+      REAL tempe(ip1jmp1)
+
+c    fonction psat(T)
+
+       FOEEW ( PTARG,PDELARG ) = EXP (
+     *          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)
+     * / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
+
+        r2es  = 380.11733 
+        r3les = 17.269
+        r3ies = 21.875
+        r4les = 35.86
+        r4ies = 7.66
+        retv = 0.6077667
+        rtt  = 273.16
+
+c-- Calcul de Qsat en chaque point
+c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
+c   pour eviter une exponentielle.
+        DO l = 1, llm
+         DO ij = 1, ip1jmp1
+          tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
+         ENDDO
+         DO ij = 1, ip1jmp1
+          zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          play   = 0.5*(p(ij,l)+p(ij,l+1))
+          qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
+          qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
+         ENDDO
+        ENDDO
+
+
+c      PRINT*,'Debut vlsplt version debug sans vlyqs'
+
+        zzpbar = 0.5 * pdt
+        zzw    = pdt
+      DO l=1,llm
+        DO ij = iip2,ip1jm
+            mu(ij,l)=pbaru(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jm
+            mv(ij,l)=pbarv(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jmp1
+            mw(ij,l)=w(ij,l) * zzw
+         ENDDO
+      ENDDO
+
+      DO ij=1,ip1jmp1
+         mw(ij,llm+1)=0.
+      ENDDO
+
+      CALL SCOPY(ijp1llm,q,1,zq,1)
+      CALL SCOPY(ijp1llm,masse,1,zm,1)
+
+c      call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
+      call vlxqs(zq,pente_max,zm,mu,qsat)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
+
+      call vlyqs(zq,pente_max,zm,mv,qsat)
+
+
+c      call minmaxq(zq,qmin,qmax,'avant vlz     ')
+
+      call vlz(zq,pente_max,zm,mw)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlyqs     ')
+
+      call vlyqs(zq,pente_max,zm,mv,qsat)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlxqs     ')
+
+      call vlxqs(zq,pente_max,zm,mu,qsat)
+
+c     call minmaxq(zq,qmin,qmax,'apres vlxqs     ')
+c     call minmaxq(zm,qmin,qmax,'M apres vlxqs     ')
+
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+           q(ij,l)=zq(ij,l)
+         ENDDO
+         DO ij=1,ip1jm+1,iip1
+            q(ij+iim,l)=q(ij,l)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
+      SUBROUTINE vlxqs(q,pente_max,masse,u_m,qsat)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL u_m( ip1jmp1,llm )
+      REAL q(ip1jmp1,llm)
+      REAL qsat(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
+      INTEGER n0,iadvplus(ip1jmp1,llm),nl(llm)
+c
+      REAL new_m,zu_m,zdum(ip1jmp1,llm)
+      REAL dxq(ip1jmp1,llm),dxqu(ip1jmp1)
+      REAL zz(ip1jmp1)
+      REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
+      REAL u_mq(ip1jmp1,llm)
+
+      Logical first,testcpu
+      SAVE first,testcpu
+
+      REAL      SSUM
+      EXTERNAL  SSUM
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+
+
+      DATA first,testcpu/.true.,.false./
+
+      IF(first) THEN
+         temps1=0.
+         temps2=0.
+         temps3=0.
+         temps4=0.
+         temps5=0.
+         first=.false.
+      ENDIF
+
+c   calcul de la pente a droite et a gauche de la maille
+
+
+      IF (pente_max.gt.-1.e-5) THEN
+c     IF (pente_max.gt.10) THEN
+
+c   calcul des pentes avec limitation, Van Leer scheme I:
+c   -----------------------------------------------------
+
+c   calcul de la pente aux points u
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+c              IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'
+c              sigu(ij)=u_m(ij,l)/masse(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+c              sigu(ij)=sigu(ij-iim)
+            ENDDO
+
+            DO ij=iip2,ip1jm
+               adxqu(ij)=abs(dxqu(ij))
+            ENDDO
+
+c   calcul de la pente maximum dans la maille en valeur absolue
+
+            DO ij=iip2+1,ip1jm
+               dxqmax(ij,l)=pente_max*
+     ,      min(adxqu(ij-1),adxqu(ij))
+c limitation subtile
+c    ,      min(adxqu(ij-1)/sigu(ij-1),adxqu(ij)/(1.-sigu(ij)))
+          
+
+            ENDDO
+
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqmax(ij-iim,l)=dxqmax(ij,l)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+#ifdef CRAY
+               dxq(ij,l)=
+     ,         cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij))
+#else
+               IF(dxqu(ij-1)*dxqu(ij).gt.0) THEN
+                  dxq(ij,l)=dxqu(ij-1)+dxqu(ij)
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+#endif
+               dxq(ij,l)=0.5*dxq(ij,l)
+               dxq(ij,l)=
+     ,         sign(min(abs(dxq(ij,l)),dxqmax(ij,l)),dxq(ij,l))
+            ENDDO
+
+         ENDDO ! l=1,llm
+
+      ELSE ! (pente_max.lt.-1.e-5)
+
+c   Pentes produits:
+c   ----------------
+
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+               zz(ij)=dxqu(ij-1)*dxqu(ij)
+               zz(ij)=zz(ij)+zz(ij)
+               IF(zz(ij).gt.0) THEN
+                  dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij))
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+            ENDDO
+
+         ENDDO
+
+      ENDIF ! (pente_max.lt.-1.e-5)
+
+c   bouclage de la pente en iip1:
+c   -----------------------------
+
+      DO l=1,llm
+         DO ij=iip1+iip1,ip1jm,iip1
+            dxq(ij-iim,l)=dxq(ij,l)
+         ENDDO
+
+         DO ij=1,ip1jmp1
+            iadvplus(ij,l)=0
+         ENDDO
+
+      ENDDO
+
+
+c   calcul des flux a gauche et a droite
+
+#ifdef CRAY
+c--pas encore modification sur Qsat
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l),
+     ,                     1.+u_m(ij,l)/masse(ij+1,l),
+     ,                     u_m(ij,l))
+          zdum(ij,l)=0.5*zdum(ij,l)
+          u_mq(ij,l)=cvmgp(
+     ,                q(ij,l)+zdum(ij,l)*dxq(ij,l),
+     ,                q(ij+1,l)-zdum(ij,l)*dxq(ij+1,l),
+     ,                u_m(ij,l))
+          u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
+       ENDDO
+      ENDDO
+#else
+c   on cumule le flux correspondant a toutes les mailles dont la masse
+c   au travers de la paroi pENDant le pas de temps.
+c   le rapport de melange de l'air advecte est min(q_vanleer, Qsat_downwind)
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          IF (u_m(ij,l).gt.0.) THEN
+             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l)
+             u_mq(ij,l)=u_m(ij,l)*
+     $         min(q(ij,l)+0.5*zdum(ij,l)*dxq(ij,l),qsat(ij+1,l))
+          ELSE
+             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l)
+             u_mq(ij,l)=u_m(ij,l)*
+     $         min(q(ij+1,l)-0.5*zdum(ij,l)*dxq(ij+1,l),qsat(ij,l))
+          ENDIF
+       ENDDO
+      ENDDO
+#endif
+
+
+c   detection des points ou on advecte plus que la masse de la
+c   maille
+      DO l=1,llm
+         DO ij=iip2,ip1jm-1
+            IF(zdum(ij,l).lt.0) THEN
+               iadvplus(ij,l)=1
+               u_mq(ij,l)=0.
+            ENDIF
+         ENDDO
+      ENDDO
+      DO l=1,llm
+       DO ij=iip1+iip1,ip1jm,iip1
+          iadvplus(ij,l)=iadvplus(ij-iim,l)
+       ENDDO
+      ENDDO
+
+
+
+c   traitement special pour le cas ou on advecte en longitude plus que le
+c   contenu de la maille.
+c   cette partie est mal vectorisee.
+
+c   pas d'influence de la pression saturante (pour l'instant)
+
+c  calcul du nombre de maille sur lequel on advecte plus que la maille.
+
+      n0=0
+      DO l=1,llm
+         nl(l)=0
+         DO ij=iip2,ip1jm
+            nl(l)=nl(l)+iadvplus(ij,l)
+         ENDDO
+         n0=n0+nl(l)
+      ENDDO
+
+      IF(n0.gt.1) THEN
+ccc      PRINT*,'Nombre de points pour lesquels on advect plus que le'
+ccc     &       ,'contenu de la maille : ',n0
+
+         DO l=1,llm
+            IF(nl(l).gt.0) THEN
+               iju=0
+c   indicage des mailles concernees par le traitement special
+               DO ij=iip2,ip1jm
+                  IF(iadvplus(ij,l).eq.1.and.mod(ij,iip1).ne.0) THEN
+                     iju=iju+1
+                     indu(iju)=ij
+                  ENDIF
+               ENDDO
+               niju=iju
+c              PRINT*,'niju,nl',niju,nl(l)
+
+c  traitement des mailles
+               DO iju=1,niju
+                  ij=indu(iju)
+                  j=(ij-1)/iip1+1
+                  zu_m=u_m(ij,l)
+                  u_mq(ij,l)=0.
+                  IF(zu_m.gt.0.) THEN
+                     ijq=ij
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m-masse(ijq,l)
+                        i=mod(i-2+iim,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*
+     &               (q(ijq,l)+0.5*(1.-zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ELSE
+                     ijq=ij+1
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(-zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m+masse(ijq,l)
+                        i=mod(i,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l)-
+     &               0.5*(1.+zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDIF  ! n0.gt.0 
+
+
+
+c   bouclage en latitude
+
+      DO l=1,llm
+        DO ij=iip1+iip1,ip1jm,iip1
+           u_mq(ij,l)=u_mq(ij-iim,l)
+        ENDDO
+      ENDDO
+
+
+c   calcul des tendances
+
+      DO l=1,llm
+         DO ij=iip2+1,ip1jm
+            new_m=masse(ij,l)+u_m(ij-1,l)-u_m(ij,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+
+     &      u_mq(ij-1,l)-u_mq(ij,l))
+     &      /new_m
+            masse(ij,l)=new_m
+         ENDDO
+c   Modif Fred 22 03 96 correction d'un bug (les scopy ci-dessous)
+         DO ij=iip1+iip1,ip1jm,iip1
+            q(ij-iim,l)=q(ij,l)
+            masse(ij-iim,l)=masse(ij,l)
+         ENDDO
+      ENDDO
+
+c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
+c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
+
+
+      RETURN
+      END
+      SUBROUTINE vlyqs(q,pente_max,masse,masse_adv_v,qsat)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     q,masse_adv_v,w sont des arguments d'entree  pour le s-pg ....
+c     qsat 	       est   un argument de sortie pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse_adv_v( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL qsat(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l
+c
+      REAL airej2,airejjm,airescb(iim),airesch(iim)
+      REAL dyq(ip1jmp1,llm),dyqv(ip1jm)
+      REAL adyqv(ip1jm),dyqmax(ip1jmp1)
+      REAL qbyv(ip1jm,llm)
+
+      REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
+c     REAL newq,oldmasse
+      Logical first,testcpu
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE first,testcpu
+
+      REAL convpn,convps,convmpn,convmps
+      REAL sinlon(iip1),sinlondlon(iip1)
+      REAL coslon(iip1),coslondlon(iip1)
+      SAVE sinlon,coslon,sinlondlon,coslondlon
+      SAVE airej2,airejjm
+c
+c
+      REAL      SSUM
+      EXTERNAL  SSUM
+
+      DATA first,testcpu/.true.,.false./
+      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
+
+      IF(first) THEN
+         PRINT*,'Shema  Amont nouveau  appele dans  Vanleer   '
+         first=.false.
+         do i=2,iip1
+            coslon(i)=cos(rlonv(i))
+            sinlon(i)=sin(rlonv(i))
+            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
+            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
+         ENDDO
+         coslon(1)=coslon(iip1)
+         coslondlon(1)=coslondlon(iip1)
+         sinlon(1)=sinlon(iip1)
+         sinlondlon(1)=sinlondlon(iip1)
+         airej2 = SSUM( iim, aire(iip2), 1 )
+         airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
+      ENDIF
+
+c
+
+
+      DO l = 1, llm
+c
+c   --------------------------------
+c      CALCUL EN LATITUDE
+c   --------------------------------
+
+c   On commence par calculer la valeur du traceur moyenne sur le premier cercle
+c   de latitude autour du pole (qpns pour le pole nord et qpsn pour
+c    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
+
+      DO i = 1, iim
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
+      ENDDO
+      qpns   = SSUM( iim,  airescb ,1 ) / airej2
+      qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
+
+c   calcul des pentes aux points v
+
+      DO ij=1,ip1jm
+         dyqv(ij)=q(ij,l)-q(ij+iip1,l)
+         adyqv(ij)=abs(dyqv(ij))
+      ENDDO
+
+c   calcul des pentes aux points scalaires
+
+      DO ij=iip2,ip1jm
+         dyq(ij,l)=.5*(dyqv(ij-iip1)+dyqv(ij))
+         dyqmax(ij)=min(adyqv(ij-iip1),adyqv(ij))
+         dyqmax(ij)=pente_max*dyqmax(ij)
+      ENDDO
+
+c   calcul des pentes aux poles
+
+      DO ij=1,iip1
+         dyq(ij,l)=qpns-q(ij+iip1,l)
+         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l)-qpsn
+      ENDDO
+
+c   filtrage de la derivee
+      dyn1=0.
+      dys1=0.
+      dyn2=0.
+      dys2=0.
+      DO ij=1,iim
+         dyn1=dyn1+sinlondlon(ij)*dyq(ij,l)
+         dys1=dys1+sinlondlon(ij)*dyq(ip1jm+ij,l)
+         dyn2=dyn2+coslondlon(ij)*dyq(ij,l)
+         dys2=dys2+coslondlon(ij)*dyq(ip1jm+ij,l)
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=dyn1*sinlon(ij)+dyn2*coslon(ij)
+         dyq(ip1jm+ij,l)=dys1*sinlon(ij)+dys2*coslon(ij)
+      ENDDO
+
+c   calcul des pentes limites aux poles
+
+      fn=1.
+      fs=1.
+      DO ij=1,iim
+         IF(pente_max*adyqv(ij).lt.abs(dyq(ij,l))) THEN
+            fn=min(pente_max*adyqv(ij)/abs(dyq(ij,l)),fn)
+         ENDIF
+      IF(pente_max*adyqv(ij+ip1jm-iip1).lt.abs(dyq(ij+ip1jm,l))) THEN
+         fs=min(pente_max*adyqv(ij+ip1jm-iip1)/abs(dyq(ij+ip1jm,l)),fs)
+         ENDIF
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=fn*dyq(ij,l)
+         dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)
+      ENDDO
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C  En memoire de dIFferents tests sur la 
+C  limitation des pentes aux poles.
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     PRINT*,dyq(1)
+C     PRINT*,dyqv(iip1+1)
+C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     PRINT*,dyq(ip1jm+1)
+C     PRINT*,dyqv(ip1jm-iip1+1)
+C     aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
+C     DO ij=2,iim
+C        apn=amax1(abs(dyq(ij)/dyqv(ij)),apn)
+C        aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps)
+C     ENDDO
+C     apn=min(pente_max/apn,1.)
+C     aps=min(pente_max/aps,1.)
+C
+C
+C   cas ou on a un extremum au pole
+C
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   apn=0.
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &   aps=0.
+C
+C   limitation des pentes aux poles
+C     DO ij=1,iip1
+C        dyq(ij)=apn*dyq(ij)
+C        dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
+C     ENDDO
+C
+C   test
+C      DO ij=1,iip1
+C         dyq(iip1+ij)=0.
+C         dyq(ip1jm+ij-iip1)=0.
+C      ENDDO
+C      DO ij=1,ip1jmp1
+C         dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
+C      ENDDO
+C
+C changement 10 07 96
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   THEN
+C        DO ij=1,iip1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=1,iip1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij))
+C        ENDDO
+C     ENDIF
+C
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &THEN
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij-iip1))
+C        ENDDO
+C     ENDIF
+C   fin changement 10 07 96
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+c   calcul des pentes limitees
+
+      DO ij=iip2,ip1jm
+         IF(dyqv(ij)*dyqv(ij-iip1).gt.0.) THEN
+            dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l))
+         ELSE
+            dyq(ij,l)=0.
+         ENDIF
+      ENDDO
+
+      ENDDO
+
+      DO l=1,llm
+       DO ij=1,ip1jm
+         IF( masse_adv_v(ij,l).GT.0. ) THEN
+           qbyv(ij,l)= MIN( qsat(ij+iip1,l), q(ij+iip1,l )  +
+     ,      dyq(ij+iip1,l)*0.5*(1.-masse_adv_v(ij,l)/masse(ij+iip1,l)))
+         ELSE
+              qbyv(ij,l)= MIN( qsat(ij,l), q(ij,l) - dyq(ij,l) *
+     ,                   0.5*(1.+masse_adv_v(ij,l)/masse(ij,l)) )
+         ENDIF
+          qbyv(ij,l) = masse_adv_v(ij,l)*qbyv(ij,l)
+       ENDDO
+      ENDDO
+
+
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+            newmasse=masse(ij,l)
+     &      +masse_adv_v(ij,l)-masse_adv_v(ij-iip1,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+qbyv(ij,l)-qbyv(ij-iip1,l))
+     &         /newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. ancienne version
+         convpn=SSUM(iim,qbyv(1,l),1)/apoln
+         convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
+         DO ij = 1,iip1
+            newmasse=masse(ij,l)+convmpn*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convpn*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+         convps  = -SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
+         convmps = -SSUM(iim,masse_adv_v(ip1jm-iim,l),1)/apols
+         DO ij = ip1jm+1,ip1jmp1
+            newmasse=masse(ij,l)+convmps*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convps*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. fin ancienne version
+
+c._. nouvelle version
+c        convpn=SSUM(iim,qbyv(1,l),1)
+c        convmpn=ssum(iim,masse_adv_v(1,l),1)
+c        oldmasse=ssum(iim,masse(1,l),1)
+c        newmasse=oldmasse+convmpn
+c        newq=(q(1,l)*oldmasse+convpn)/newmasse
+c        newmasse=newmasse/apoln
+c        DO ij = 1,iip1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
+c        convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
+c        oldmasse=ssum(iim,masse(ip1jm-iim,l),1)
+c        newmasse=oldmasse+convmps
+c        newq=(q(ip1jmp1,l)*oldmasse+convps)/newmasse
+c        newmasse=newmasse/apols
+c        DO ij = ip1jm+1,ip1jmp1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c._. fin nouvelle version
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/wind_scal.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/wind_scal.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/wind_scal.F	(revision 2744)
@@ -0,0 +1,55 @@
+      SUBROUTINE wind_scal(pbaru,pbarv,us,vs)
+c=======================================================================
+c
+c
+c   Subject:
+c   ------
+c   On ramene les flux de masse /vents  aux points scalaires.
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL us(ip1jmp1,llm), vs (ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER ij,l
+
+c-----------------------------------------------------------------------
+
+c   transport zonal:
+c   ----------------
+      DO l=1,llm
+	 DO ij=2,ip1jmp1
+            us(ij,l)=.5*(pbaru(ij,l)+pbaru(ij-1,l))
+	 ENDDO
+      ENDDO
+      CALL SCOPY(jjp1*llm,us(iip1,1),iip1,us(1,1),iip1)
+
+
+c   Transport meridien:
+c   -------------------
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+	    vs(ij,l)=.5*(pbarv(ij,l)+pbarv(ij-iip1,l))
+	 ENDDO
+	 DO ij=1,iip1
+	    vs(ij,l)=0.
+	    vs(ip1jm+ij,l)=0.
+	 ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/wrgrads.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/wrgrads.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/wrgrads.F	(revision 2744)
@@ -0,0 +1,125 @@
+      subroutine wrgrads(if,nl,field,name,titlevar)
+      implicit none
+
+c   Declarations
+c    if indice du fichier
+c    nl nombre de couches
+c    field   champ
+c    name    petit nom
+c    titlevar   Titre
+
+#include "gradsdef.h"
+
+c   arguments
+      integer if,nl
+      real field(imx*jmx*lmx)
+      character*10 name,file
+      character*10 titlevar
+
+c   local
+
+      integer im,jm,lm,i,j,l,lnblnk,iv,iii,iji,iif,ijf
+
+      logical writectl
+
+
+      writectl=.false.
+
+c     print*,if,iid(if),jid(if),ifd(if),jfd(if)
+      iii=iid(if)
+      iji=jid(if)
+      iif=ifd(if)
+      ijf=jfd(if)
+      im=iif-iii+1
+      jm=ijf-iji+1
+      lm=lmd(if)
+
+c      print*,'im,jm,lm,name,firsttime(if)'
+c      print*,im,jm,lm,name,firsttime(if)
+
+      if(firsttime(if)) then
+         if(name.eq.var(1,if)) then
+            firsttime(if)=.false.
+            ivar(if)=1
+         print*,'fin de l initialiation de l ecriture du fichier'
+         print*,file
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+         else
+            ivar(if)=ivar(if)+1
+            nvar(if)=ivar(if)
+            var(ivar(if),if)=name
+            tvar(ivar(if),if)=titlevar(1:lnblnk(titlevar))
+            nld(ivar(if),if)=nl
+            print*,'initialisation ecriture de ',var(ivar(if),if)
+            print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if)
+         endif
+         writectl=.true.
+         itime(if)=1
+      else
+         ivar(if)=mod(ivar(if),nvar(if))+1
+         if (ivar(if).eq.nvar(if)) then
+            writectl=.true.
+            itime(if)=itime(if)+1
+         endif
+
+         if(var(ivar(if),if).ne.name) then
+           print*,'Il faut stoker la meme succession de champs a chaque'
+           print*,'pas de temps'
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+
+           stop
+         endif
+      endif
+
+c     print*,'ivar(if),nvar(if),var(ivar(if),if),writectl'
+c     print*,ivar(if),nvar(if),var(ivar(if),if),writectl
+      do l=1,nl
+         irec(if)=irec(if)+1
+c        print*,'Ecrit rec=',irec(if),iii,iif,iji,ijf,
+c    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
+c    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
+         write(unit(if)+1,rec=irec(if))
+     s   ((field((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i)
+     s   ,i=iii,iif),j=iji,ijf)
+      enddo
+      if (writectl) then
+
+      file=fichier(if)
+c   WARNING! on reecrase le fichier .ctl a chaque ecriture
+      open(unit(if),file=file(1:lnblnk(file))//'.ctl',
+     &         form='formatted',status='unknown')
+      write(unit(if),'(a5,1x,a40)')
+     &       'DSET ','^'//file(1:lnblnk(file))//'.dat'
+
+      write(unit(if),'(a12)') 'UNDEF 1.0E30'
+      write(unit(if),'(a5,1x,a40)') 'TITLE ',title(if)
+      call formcoord(unit(if),im,xd(iii,if),1.,.false.,'XDEF')
+      call formcoord(unit(if),jm,yd(iji,if),1.,.true.,'YDEF')
+      call formcoord(unit(if),lm,zd(1,if),1.,.false.,'ZDEF')
+      write(unit(if),'(a4,i10,a30)')
+     &       'TDEF ',itime(if),' LINEAR 02JAN1987 1MO '
+      write(unit(if),'(a4,2x,i5)') 'VARS',nvar(if)
+      do iv=1,nvar(if)
+c        print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
+c        print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
+         write(unit(if),1000) var(iv,if),nld(iv,if)-1/nld(iv,if)
+     &     ,99,tvar(iv,if)
+      enddo
+      write(unit(if),'(a7)') 'ENDVARS'
+c
+1000  format(a5,3x,i4,i3,1x,a39)
+
+      close(unit(if))
+
+      endif ! writectl
+
+      return
+
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/write_archive.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/write_archive.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/write_archive.F	(revision 2744)
@@ -0,0 +1,202 @@
+c=======================================================================
+      subroutine write_archive(nid,ntime,nom,titre,unite,dim,px)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:   Ecriture de champs sur grille scalaire (iip1*jjp1)
+c   -----    dans un fichier DRS nomme "start_archive"
+c
+c    Il faut au prealable avoir cree un entete avec un "call ini_archive".
+c    Ces variables peuvent etre 3d (ex: temperature), 2d (ex: temperature
+c    de surface), ou 0d (pour un scalaire qui ne depend que du temps)
+c    (ex: la longitude solaire)
+c
+c
+c   Arguments: 
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c		  nid      Unite logique du fichier "start_archive"
+c         nom      nom du champ a ecrire dans le fichier "start_archive"
+c         titre    titre de la variable dans le fichier DRS "start_archive"
+c         unite    unite de la variable ....
+c         dim      dimension de la variable a ecrire
+c         px       tableau contenant la variable a ecrire
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "control.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "description.h"
+#include "temps.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c	Declarations   
+c-----------------------------------------------------------------------
+
+c Arguments:
+
+      INTEGER nid,ntime,dim 
+      REAL px(iip1,jjp1,llm) 
+
+      CHARACTER*(*) nom, titre, unite
+
+      integer ierr
+
+
+c local
+      integer, dimension(4) :: edges,corner,id
+      integer :: varid,i,j,l
+c-----------------------------------------------------------------------
+c      Ecriture du champs dans le fichier            (3 cas)      
+c-----------------------------------------------------------------------
+
+!Cas Variable 3D
+!---------------
+        if (dim.eq.3) then
+
+!         Ecriture du champs
+
+! nom de la variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif
+
+! mars s'arranger pour qu'il n'y ai plus besoin de ca
+
+c          do l=1,llm
+c             do j=1,jjp1
+c                do i=1,iip1
+c                   pxbis(i,j,l)=px(i,j,llm-l+1)
+c                enddo
+c             enddo
+c          enddo
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=llm
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
+              call abort
+           endif
+
+!Cas Variable 2D
+!---------------
+
+        else if (dim.eq.2) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"Time",id(3))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=ntime
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=1
+
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else         
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif     
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+
+!Cas Variable 0D (scalaire dependant du temps)
+!---------------------------------------------
+
+        else if (dim.eq.0) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"temps",id(1))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
+
+           endif
+
+           corner(1)=ntime
+           edges(1)=1
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+        endif
+
+      return
+      end
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/xvik.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/xvik.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/dyn3d/xvik.F	(revision 2744)
@@ -0,0 +1,514 @@
+      PROGRAM xvik
+      IMPLICIT NONE
+c=======================================================================
+c
+c  Pression au site Viking
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "description.h"
+#include "netcdf.inc"      
+
+
+      INTEGER itau,nbpas,nbpasmx
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx)
+      INTEGER unitlec
+      INTEGER i,j,l,jj
+      REAL constR
+
+c   Declarations NCDF:
+c   -----------------
+      CHARACTER*100  varname
+      INTEGER ierr,nid,nvarid,dimid
+      LOGICAL nc
+      INTEGER start_ps(3),start_temp(4),start_co2ice(3)
+      INTEGER count_ps(3),count_temp(4),count_co2ice(3)
+
+c   declarations pour les points viking:
+c   ------------------------------------
+      INTEGER ivik(2),jvik(2),ifile(2),iv
+      REAL lonvik(2),latvik(2),phivik(2),phisim(2)
+      REAL unanj
+
+c   variables meteo:
+c   ----------------
+      REAL vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm),ps(iip1,jjp1),pstot, phis(iip1,jjp1)
+      REAL co2ice(iip1,jjp1), captotN,captotS
+
+      REAL zp1,zp2,zp2_sm,zu,zv,zw(0:1,0:1,2),zalpha,zbeta
+
+      LOGICAL firstcal,lcal,latcal,lvent,day_ls
+      INTEGER*4 day0
+
+      REAL ziceco2(iip1,jjp1)
+      REAL day,zt,sollong,sol,dayw
+      REAL airtot1,gh
+
+      INTEGER ii,iyear,kyear
+
+      CHARACTER*1 chr2
+
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER pathchmp*80,pathsor*80,nomfich*80
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL inifilr,exner,pbar
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      unanj=667.9
+      print*,'WARNING!!!',unanj,'Jours/an'
+      nc=.true.
+      lcal=.true.
+      latcal=.true.
+      lvent=.false.
+      day_ls=.true.
+
+c lecture du fichier xvik.def
+
+      phivik(1)=-3627
+      phivik(2)=-4505
+
+
+
+      OPEN(99,file='xvik.def',form='formatted')
+
+      READ(99,*) 
+      READ(99,*,iostat=ierr) phivik
+      IF(ierr.NE.0) GOTO 105
+
+      READ(99,*,END=105)
+      READ(99,'(a)',END=105) pathchmp
+      READ(99,*,END=105)
+      READ(99,'(a)',END=105) pathsor
+      READ(99,*,END=105)
+c     READ(99,'(l1)',END=105) day_ls
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) lcal
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) lvent
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) latcal
+ 
+ 105  CONTINUE
+      CLOSE(99)
+      write (*,*)'>>>>>>>>>>>>>>>>', phivik,g
+      DO iv=1,2
+         phivik(iv)=phivik(iv)*3.73
+      END DO
+
+
+c-----------------------------------------------------------------------
+c-----------------------------------------------------------------------
+c   ouverture des fichiers xgraph:
+c   ------------------------------
+
+      ifile(1)=12
+      ifile(2)=13
+      kyear=-1
+c      OPEN(77,file='xlongday',form='formatted')
+
+      unitlec=11
+c
+      PRINT*,'entrer le nom du fichier NC'
+      READ(5,'(a)') nomfich
+
+      PRINT *,'nomfich : ',nomfich
+
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+c   grande boucle sur les fichiers histoire:
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      firstcal=.true.
+      DO WHILE(lnblnk(nomfich).GT.0.AND.lnblnk(nomfich).LT.50)
+      PRINT *,'nomfich : ',nomfich
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      file=pathchmp(1:lnblnk(pathchmp))//'/'//
+     s     nomfich(1:lnblnk(nomfich))
+      PRINT*,'file.nc: ', file(1:lnblnk(file))//'.nc'
+      PRINT*,'timestep ',dtvr
+
+      IF(nc) THEN
+      ierr= NF_OPEN(file(1:lnblnk(file))//'.nc',NF_NOWRITE,nid)        
+      ELSE
+         PRINT*,'Ouverture binaire ',file
+         OPEN(unitlec,file=file,status='old',form='unformatted',
+     .   iostat=ierr)
+      ENDIF
+
+c----------------------------------------------------------------------
+c   initialisation de la physique:
+c   ------------------------------
+
+      CALL readhead_NC(file(1:lnblnk(file))//'.nc',day0,phis,constR)
+
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+
+c   Lecture temps :
+
+      ierr= NF_INQ_DIMID (nid,"Time",dimid)
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'xvik: Le champ <Time> est absent'
+          CALL abort
+        ENDIF
+
+      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'xvik: Lecture echouee pour <Time>'
+          CALL abort
+        ENDIF
+
+        PRINT*,'temps',(temps(itau),itau=1,10)
+              
+c-----------------------------------------------------------------------
+c   coordonnees des point Viking:
+c   -----------------------------
+
+      latvik(1)=22.27*pi/180.
+      lonvik(1)=-47.9*pi/180.
+      latvik(2)=47.67*pi/180.
+      lonvik(2)=(360.-225.71)*pi/180.
+
+c   ponderations pour les 4 points autour de Viking
+      DO iv=1,2
+         CALL coordij(lonvik(iv),latvik(iv),ivik(iv),jvik(iv))
+         IF(lonvik(iv).lt.rlonv(ivik(iv))) THEN
+            ivik(iv)=ivik(iv)-1
+         ENDIF
+         IF(latvik(iv).gt.rlatu(jvik(iv))) THEN
+            jvik(iv)=jvik(iv)-1
+         ENDIF
+         zalpha=(lonvik(iv)-rlonv(ivik(iv)))/
+     s          (rlonv(ivik(iv)+1)-rlonv(ivik(iv)))
+         zbeta=(latvik(iv)-rlatu(jvik(iv)))/
+     s          (rlatu(jvik(iv)+1)-rlatu(jvik(iv)))
+         zw(0,0,iv)=(1.-zalpha)*(1.-zbeta)
+         zw(1,0,iv)=zalpha*(1.-zbeta)
+         zw(0,1,iv)=(1.-zalpha)*zbeta
+         zw(1,1,iv)=zalpha*zbeta
+      ENDDO
+
+c   altitude reelle et modele aux points Viking
+      DO iv=1,2
+         phisim(iv)=0.
+         DO jj=0,1
+            j=jvik(iv)+jj
+            DO ii=0,1
+               i=ivik(iv)+ii
+               phisim(iv)=phisim(iv)+zw(ii,jj,iv)*phis(i,j)
+            ENDDO
+         ENDDO
+      ENDDO
+      PRINT*,'relief aux points Viking pour les sorties:',phivik
+
+c----------------------------------------------------------------------
+c   lectures des etats:
+c   -------------------
+
+       airtot1=1./(SSUM(ip1jmp1,aire,1)-SSUM(jjp1,aire,iip1))
+
+c======================================================================
+c   debut de la boucle sur les etats dans un fichier histoire:
+c======================================================================
+       count_ps=(/iip1,jjp1,1/)
+       count_co2ice=(/iip1,jjp1,1/)
+       count_temp=(/iip1,jjp1,llm,1/)
+       
+       DO itau=1,nbpas
+
+       start_ps=(/1,1,itau/)
+       start_co2ice=(/1,1,itau/)
+       start_temp=(/1,1,1,itau/)
+c   lecture drs des champs:
+c   -----------------------
+c         varname='u'
+c         ierr=drsread (unitlec,varname,unat,itau)
+c         PRINT*,'unat',unat(iip1/2,jjp1/2,llm/2)
+c         varname='v'
+c         ierr=drsread (unitlec,varname,vnat,itau)
+c         PRINT*,'vnat',vnat(iip1/2,jjp1/2,llm/2)
+
+ccccccccc  LECTURE Ps ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "ps", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start_ps,count_ps, ps)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start_ps,count_ps, ps)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <ps>'
+            CALL abort
+          ENDIF
+          
+          PRINT*,'ps',ps(iip1/2,jjp1/2)
+
+ccccccccc  LECTURE Temperature ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "temp", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_temp,count_temp, t)
+#else
+          ierr = NF_GET_VARA_REAL(nid,nvarid,start_temp,count_temp, t)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <temp>'
+            CALL abort
+          ENDIF
+
+c          PRINT*,'t',t(iip1/2,jjp1/2,llm/2)
+
+ccccccccc  LECTURE co2ice ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_co2ice,
+     &    count_co2ice,  co2ice)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start_co2ice,
+     &    count_co2ice, co2ice)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <co2ice>'
+            CALL abort
+          ENDIF
+
+
+c Gestion du temps
+c ----------------
+          day=temps(itau)
+          PRINT*,'day ',day
+          CALL solarlong(day+day0,sollong)
+          sol=day+day0+461.
+          iyear=sol/unanj
+          WRITE (*,*) 'iyear',iyear
+          sol=sol-iyear*unanj
+c
+c Ouverture / fermeture des fichiers
+c ----------------------------------
+          IF (iyear.NE.kyear) THEN
+             WRITE(chr2(1:1),'(i1)') iyear+1
+             WRITE (*,*) 'iyear bis',iyear
+             WRITE (*,*) 'chr2'
+             WRITE (*,*)  chr2
+             IF(iyear.GE.9) WRITE(chr2,'(i2)') iyear+1
+             kyear=iyear
+             DO ii=1,2
+                CLOSE(10+ifile(ii))
+                CLOSE(2+ifile(ii))
+                CLOSE(4+ifile(ii))
+                CLOSE(6+ifile(ii))
+                CLOSE(8+ifile(ii))
+                CLOSE(16+ifile(ii))
+                CLOSE(12+ifile(ii))
+                CLOSE(14+ifile(ii))
+                CLOSE(97)
+                CLOSE(98)
+             ENDDO
+             CLOSE(5+ifile(1))
+             OPEN(ifile(1)+10,file='xpsol1'//chr2,form='formatted')
+             OPEN(ifile(2)+10,file='xpsol2'//chr2,form='formatted')
+c            OPEN(ifile(1)+8,file='xbpsol1'//chr2,form='formatted')
+c            OPEN(ifile(2)+8,file='xbpsol2'//chr2,form='formatted')
+c            OPEN(ifile(1)+2,file='xlps1'//chr2,form='formatted')
+c            OPEN(ifile(2)+2,file='xlps2'//chr2,form='formatted')
+             IF(lcal) THEN
+c               OPEN(ifile(2)+4,file='xpressud'//chr2,form='formatted')
+c               OPEN(ifile(1)+4,file='xpresnord'//chr2,form='formatted')
+c               OPEN(ifile(1)+6,file='xpm2'//chr2,form='formatted')
+             ENDIF
+                         IF(latcal) THEN
+c               OPEN(ifile(2)+14,file='xlats'//chr2,form='formatted')
+c               OPEN(ifile(1)+14,file='xlatn'//chr2,form='formatted')
+                         ENDIF
+             IF(lvent) THEN
+c               OPEN(ifile(1)+16,file='xu1'//chr2,form='formatted')
+c               OPEN(ifile(2)+16,file='xu2'//chr2,form='formatted')
+c               OPEN(ifile(1)+12,file='xv1'//chr2,form='formatted')
+c               OPEN(ifile(2)+12,file='xv2'//chr2,form='formatted')
+             ENDIF
+             OPEN(97,file='xprestot'//chr2,form='formatted')
+c            OPEN(98,file='xlat37_'//chr2,form='formatted')
+           WRITE(98,'(f5.1,16f7.1)') 0.,(rlonv(i)*180./pi,i=1,iim,4)
+          ENDIF
+ 
+
+          sollong=sollong*180./pi
+          IF(day_ls) THEN
+             dayw=sol
+             write(*,*) 'dayw', dayw
+          ELSE
+             dayw=sollong
+          ENDIF
+
+c Calcul de la moyenne planetaire
+c -------------------------------
+          pstot=0.
+          captotS=0.
+          captotN=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                pstot=pstot+aire(i,j)*ps(i,j)
+             ENDDO
+          ENDDO
+ 
+              DO j=1,jjp1/2
+                 DO i=1,iim
+                    captotN = captotN  +aire(i,j)*co2ice(i,j)
+                 ENDDO
+              ENDDO
+              DO j=jjp1/2+1, jjp1
+                 DO i=1,iim
+                    captotS = captotS  +aire(i,j)*co2ice(i,j)
+                 ENDDO
+              ENDDO
+              WRITE(97,'(4e16.6)') dayw,pstot*airtot1
+     &       , captotN*g*airtot1, captotS*g*airtot1          
+
+          IF(.NOT.firstcal) THEN
+         WRITE(98,'(f5.1,16f7.3)')
+     s    dayw,(ps(i,37),i=1,iim,4)
+
+c boucle sur les sites vikings:
+c ----------------------------
+
+          DO iv=1,2
+
+c interpolation de la temperature dans la 7eme couche, de la pression
+c de surface et des vents aux points viking.
+
+             zp1=0.
+             zp2=0.
+             zp2_sm=0.
+             zt=0.
+             zu=0.
+             zv=0.
+             DO jj=0,1
+                j=jvik(iv)+jj
+                DO ii=0,1
+                   i=ivik(iv)+ii
+                   zt=zt+zw(ii,jj,iv)*t(i,j,7)
+                   zp1=zp1+zw(ii,jj,iv)*ps(i,j)
+                    WRITE (*,*) 'ps autour iv',ps(i,j),iv
+                   zu=zu+zw(ii,jj,iv)*unat(i,j,1)/cu(i,j)
+                   zv=zv+zw(ii,jj,iv)*vnat(i,j,1)/cv(i,j)
+                ENDDO
+             ENDDO
+ 
+ 
+c               pression au sol extrapolee a partir de la temp. 7eme couche
+           WRITE (*,*) 'constR ',constR 
+           WRITE (*,*) 'zt ',zt 
+                gh=constR*zt
+                zp2=zp1*exp(-(phivik(iv)-phisim(iv))/gh)
+
+           WRITE (*,*) 'iv,pstot,zp2, zp1, phivik(iv),phisim(iv),gh'
+           WRITE (*,*) iv,pstot*airtot1,zp2,zp1,phivik(iv),phisim(iv),gh
+           WRITE(ifile(iv)+10,'(2e15.5)') dayw,zp1
+
+           
+c   sorties eventuelles de vent
+             IF(lvent) THEN
+                WRITE(ifile(iv)+16,'(2e15.5)')
+     s          dayw,zu
+                WRITE(ifile(iv)+12,'(2e15.5)')
+     s          dayw,zv
+             ENDIF
+          ENDDO
+c         IF (lcal) THEN
+c            WRITE(ifile(1)+4,'(2e15.6)') dayw,airtot1*g*.01*
+c    s       (SSUM(ip1jmp1/2,ziceco2,1)-SSUM(jjp1/2,ziceco2,iip1))
+c            WRITE(ifile(2)+4,'(2e15.6)') dayw,airtot1*g*.01*
+c    s       (SSUM(iip1*jjm/2,ziceco2(1,jjm/2+2),1)-
+c    s       SSUM(jjm/2,ziceco2(1,jjm/2+2),iip1))
+c         ENDIF
+c            IF(latcal) THEN
+c               CALL icelat(iim,jjm,ziceco2,rlatv,zicelat)
+c               WRITE(ifile(1)+14,'(2e15.6)') dayw,zicelat(1)*180./pi
+c               WRITE(ifile(2)+14,'(2e15.6)') dayw,zicelat(2)*180./pi
+c            ENDIF
+         ENDIF
+         firstcal=.false.
+
+c======================================================================
+c   Fin de la boucle sur les etats du fichier histoire:
+c======================================================================
+      ENDDO
+
+      ierr= NF_CLOSE(nid)
+
+      PRINT*,'Fin du fichier',nomfich
+      print*,'Entrer un nouveau fichier ou return pour finir'
+      READ(5,'(a)',err=9999) nomfich
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+c   Fin de la boucle sur les fichiers histoire:
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      ENDDO
+
+      PRINT*,'relief du point V1',.001*phis(ivik(1),jvik(1))/g
+      PRINT*,'relief du point V2',.001*phis(ivik(2),jvik(2))/g
+      DO iv=1,2
+         PRINT*,'Viking',iv,'   i=',ivik(iv),'j  =',jvik(iv)
+         WRITE(6,7777)
+     s   (rlonv(i)*180./pi,i=ivik(iv)-1,ivik(iv)+2)
+         print*
+         DO j=jvik(iv)-1,jvik(iv)+2
+            WRITE(6,'(f8.1,10x,5f7.1)')
+     s   rlatu(j)*180./pi,(phis(i,j)/(g*1000.),i=ivik(iv)-1,ivik(iv)+2)
+         ENDDO
+         print*
+         print*,'zw'
+         write(6,'(2(2f10.4/))') ((zw(ii,jj,iv),ii=0,1),jj=0,1)
+         print*,'altitude interpolee (km) ',phisim(iv)/1000./g
+      ENDDO
+      PRINT*,'R=',r
+ 9999  PRINT*,'Fin '
+
+7777  FORMAT ('latitude/longitude',4f7.1)
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Entries
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Entries	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Entries	(revision 2744)
@@ -0,0 +1,10 @@
+/acc.F/1.1.1.1/Mon Nov 22 15:02:04 1999//Trel-1-0-patch
+/coefils.h/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/eigen.F/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/eigen_sort.F/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/filtreg.F/1.2/Thu Mar 29 14:58:49 2001//Trel-1-0-patch
+/inifgn.F/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/inifilr.F/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/jacobi.F/1.2/Thu Mar 29 14:58:49 2001//Trel-1-0-patch
+/parafilt.h/1.2/Thu Mar 29 14:58:49 2001//Trel-1-0-patch
+D
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Repository
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Repository	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Repository	(revision 2744)
@@ -0,0 +1,1 @@
+LMDZ.3.3/libf/filtrez
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Root
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Root	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Root	(revision 2744)
@@ -0,0 +1,1 @@
+:pserver:lmdzbrowse@piaf.lmd.jussieu.fr:/users/lmdz/cvsroot
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Tag
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Tag	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/CVS/Tag	(revision 2744)
@@ -0,0 +1,1 @@
+Trel-1-0-patch
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/acc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/acc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/acc.F	(revision 2744)
@@ -0,0 +1,11 @@
+        subroutine acc(vec,d,im)
+        dimension vec(im,im),d(im)
+        do 10 j=1,im
+        do 9 i=1,im
+ 9	d(i)=vec(i,j)*vec(i,j)
+        sum=ssum(im,d,1)
+        sum=sqrt(sum)
+        do 10 i=1,im
+ 10	vec(i,j)=vec(i,j)/sum
+        return
+        end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/coefils.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/coefils.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/coefils.h	(revision 2744)
@@ -0,0 +1,8 @@
+      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)
+     * ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),
+     * modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)
+     * ,coefilu2(iim,jjm),coefilv2(iim,jjm)
+c
+      INTEGER jfiltnu,jfiltsu,jfiltnv,jfiltsv,modfrstu,modfrstv
+      REAL    sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv
+      REAL    coefilu2,coefilv2
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/eigen.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/eigen.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/eigen.F	(revision 2744)
@@ -0,0 +1,28 @@
+      SUBROUTINE eigen( e,d)
+#include "dimensions.h"
+      dimension e( iim,iim ), d( iim )
+      dimension asm( iim )
+      im=iim
+c
+      DO 48 i = 1,im
+	 asm( i ) = d( im-i+1 )
+ 48   CONTINUE
+      DO 49 i = 1,iim
+	 d( i ) = asm( i )
+ 49   CONTINUE
+c
+c     PRINT 70,d
+ 70   FORMAT(5x,'Valeurs propres',/,8(1x,8f10.4,/),/)
+		print *
+c
+      DO 51 i = 1,im
+	 DO 52 j = 1,im
+            asm( j ) = e( i , im-j+1 )
+ 52      CONTINUE
+	 DO 50 j = 1,im
+	    e( i,j ) = asm( j )
+ 50      CONTINUE
+ 51   CONTINUE
+
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/eigen_sort.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/eigen_sort.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/eigen_sort.F	(revision 2744)
@@ -0,0 +1,29 @@
+          SUBROUTINE eigen_sort(d,v,n,np)
+          INTEGER n,np
+          REAL d(np),v(np,np)
+          INTEGER i,j,k
+          REAL p
+
+       DO i=1,n-1
+          k=i
+          p=d(i)
+        DO j=i+1,n
+           IF(d(j).ge.p) THEN
+            k=j
+            p=d(j)
+           ENDIF
+        ENDDO
+          
+        IF(k.ne.i) THEN
+          d(k)=d(i)
+          d(i)=p
+         DO j=1,n
+          p=v(j,i)
+          v(j,i)=v(j,k)
+          v(j,k)=p
+         ENDDO
+        ENDIF
+       ENDDO
+
+        RETURN
+        END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/filtreg.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/filtreg.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/filtreg.F	(revision 2744)
@@ -0,0 +1,297 @@
+      SUBROUTINE filtreg ( champ, nlat, nbniv, ifiltre,iaire,
+     .   griscal ,iter)
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Auteur: P. Le Van        07/10/97
+c   ------
+c
+c   Objet: filtre matriciel longitudinal ,avec les matrices precalculees
+c                     pour l'operateur  Filtre    .
+c   ------
+c
+c   Arguments:
+c   ----------
+c
+c      nblat                 nombre de latitudes a filtrer
+c      nbniv                 nombre de niveaux verticaux a filtrer
+c      champ(iip1,nblat,nbniv)  en entree : champ a filtrer
+c                            en sortie : champ filtre
+c      ifiltre               +1  Transformee directe
+c                            -1  Transformee inverse
+c                            +2  Filtre directe
+c                            -2  Filtre inverse
+c
+c      iaire                 1   si champ intensif
+c                            2   si champ extensif (pondere par les aires)
+c
+c      iter                  1   filtre simple
+c
+c=======================================================================
+c
+c
+c                      Variable Intensive
+c                ifiltre = 1     filtre directe
+c                ifiltre =-1     filtre inverse
+c
+c                      Variable Extensive
+c                ifiltre = 2     filtre directe
+c                ifiltre =-2     filtre inverse
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "parafilt.h"
+#include "coefils.h"
+c
+      INTEGER nlat,nbniv,ifiltre,iter
+      INTEGER i,j,l,k
+      INTEGER iim2,immjm
+      INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
+
+      REAL  champ( iip1,nlat,nbniv)
+      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
+      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
+     ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
+     ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
+      REAL  eignq(iim), sdd1(iim),sdd2(iim)
+      LOGICAL    griscal
+      INTEGER    hemisph, iaire
+c
+
+      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1) 
+     *    STOP'Pas de transformee simple dans cette version'
+
+      IF( iter.EQ. 2 )  THEN
+       PRINT *,' Pas d iteration du filtre dans cette version !'
+     * , ' Utiliser old_filtreg et repasser !'
+           STOP
+      ENDIF
+
+      IF( ifiltre.EQ. -2 .AND..NOT.griscal )     THEN
+       PRINT *,' Cette routine ne calcule le filtre inverse que ',
+     * ' sur la grille des scalaires !'
+           STOP
+      ENDIF
+
+      IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 )  THEN
+       PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
+     *,' corriger et repasser !'
+           STOP
+      ENDIF
+c
+
+      iim2   = iim * iim
+      immjm  = iim * jjm
+c
+c
+      IF( griscal )   THEN
+         IF( nlat. NE. jjp1 )  THEN
+             PRINT  1111
+             STOP
+         ELSE
+c
+             IF( iaire.EQ.1 )  THEN
+                CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 ) 
+                CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
+             ELSE
+                CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
+                CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
+             END IF
+c
+             jdfil1 = 2
+             jffil1 = jfiltnu
+             jdfil2 = jfiltsu
+             jffil2 = jjm
+          END IF
+      ELSE
+          IF( nlat.NE.jjm )  THEN
+             PRINT  2222
+             STOP
+          ELSE
+c
+             IF( iaire.EQ.1 )  THEN
+                CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 ) 
+                CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
+             ELSE
+                CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
+                CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
+             END IF
+c
+             jdfil1 = 1
+             jffil1 = jfiltnv
+             jdfil2 = jfiltsv
+             jffil2 = jjm
+          END IF
+      END IF
+c
+c
+      DO 100  hemisph = 1, 2
+c
+      IF ( hemisph.EQ.1 )  THEN
+          jdfil = jdfil1
+          jffil = jffil1
+      ELSE
+          jdfil = jdfil2
+          jffil = jffil2
+      END IF
+
+ 
+      DO 50  l = 1, nbniv
+      DO 30  j = jdfil,jffil
+ 
+ 
+      DO  5  i = 1, iim
+      champ(i,j,l) = champ(i,j,l) * sdd1(i)
+   5  CONTINUE
+c
+
+      IF( hemisph. EQ. 1 )      THEN
+
+        IF( ifiltre. EQ. -2 )   THEN
+#ifdef CRAY
+         CALL MXVA( matrinvn(1,1,j), 1, iim, champ(1,j,l), 1, eignq  , 
+     *                             1, iim, iim                         )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO k = 1, iim
+      DO i = 1, iim
+         eignq(k) = eignq(k) + matrinvn(k,i,j)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ELSE IF ( griscal )     THEN
+#ifdef CRAY
+         CALL MXVA( matriceun(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
+     *                             1, iim, iim                         )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matriceun(k,i,j)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ELSE 
+#ifdef CRAY
+         CALL MXVA( matricevn(1,1,j), 1, iim, champ(1,j,l), 1, eignq , 
+     *                             1, iim, iim                         )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matricevn(k,i,j)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ENDIF
+
+      ELSE
+
+        IF( ifiltre. EQ. -2 )   THEN
+#ifdef CRAY
+         CALL MXVA( matrinvs(1,1,j-jfiltsu+1),  1, iim, champ(1,j,l),1 ,  
+     *                          eignq,  1, iim, iim                    )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matrinvs(1,1,j-jfiltsu+1),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matrinvs(k,i,j-jfiltsu+1)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ELSE IF ( griscal )     THEN
+#ifdef CRAY
+         CALL MXVA( matriceus(1,1,j-jfiltsu+1), 1, iim, champ(1,j,l),1 , 
+     *                          eignq,  1, iim, iim                    )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matriceus(1,1,j-jfiltsu+1),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matriceus(k,i,j-jfiltsu+1)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ELSE 
+#ifdef CRAY
+         CALL MXVA( matricevs(1,1,j-jfiltsv+1), 1, iim, champ(1,j,l),1 , 
+     *                          eignq,  1, iim, iim                    )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matricevs(1,1,j-jfiltsv+1),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matricevs(k,i,j-jfiltsv+1)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ENDIF
+
+      ENDIF
+c
+      IF( ifiltre.EQ. 2 )  THEN
+        DO 15 i = 1, iim
+        champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
+  15    CONTINUE
+      ELSE
+        DO 16 i=1,iim
+        champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
+16      CONTINUE
+      ENDIF
+c
+      champ( iip1,j,l ) = champ( 1,j,l )
+c
+  30  CONTINUE
+c
+  50  CONTINUE
+c    
+ 100  CONTINUE
+c
+1111  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a 
+     *filtrer, sur la grille des scalaires'/)
+2222  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
+     *ltrer, sur la grille de V ou de Z'/)
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/inifgn.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/inifgn.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/inifgn.F	(revision 2744)
@@ -0,0 +1,103 @@
+      SUBROUTINE inifgn(dv)
+c  
+c    ...  H.Upadyaya , O.Sharma  ... 
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "serre.h"
+
+c
+      REAL vec(iim,iim),vec1(iim,iim)
+      REAL dlonu(iim),dlonv(iim)
+      REAL du(iim),dv(iim),d(iim)
+      REAL pi
+      INTEGER i,j,k,imm1,nrot
+C
+#include "coefils.h"
+c
+      EXTERNAL SSUM, acc,eigen,jacobi
+      REAL SSUM
+c
+
+      imm1  = iim -1
+      pi = 2.* ASIN(1.)
+C
+      DO 5 i=1,iim
+       dlonu(i)=  xprimu( i )
+       dlonv(i)=  xprimv( i )
+   5  CONTINUE
+
+      DO 12 i=1,iim
+      sddv(i)   = SQRT(dlonv(i))
+      sddu(i)   = SQRT(dlonu(i))
+      unsddu(i) = 1./sddu(i)
+      unsddv(i) = 1./sddv(i)
+  12  CONTINUE
+C
+      DO 17 j=1,iim
+      DO 17 i=1,iim
+      vec(i,j)     = 0.
+      vec1(i,j)    = 0.
+      eignfnv(i,j) = 0.
+      eignfnu(i,j) = 0.
+  17  CONTINUE
+c
+c
+      eignfnv(1,1)    = -1.
+      eignfnv(iim,1)  =  1.
+      DO 20 i=1,imm1
+      eignfnv(i+1,i+1)= -1.
+      eignfnv(i,i+1)  =  1.
+  20  CONTINUE
+      DO 25 j=1,iim
+      DO 25 i=1,iim
+      eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
+  25  CONTINUE
+      DO 30 j=1,iim
+      DO 30 i=1,iim
+      eignfnu(i,j) = -eignfnv(j,i)
+  30  CONTINUE
+c
+#ifdef CRAY
+      CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
+      CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
+#else
+      DO j = 1, iim
+      DO i = 1, iim
+        vec (i,j) = 0.0
+        vec1(i,j) = 0.0
+       DO k = 1, iim
+        vec (i,j) = vec(i,j)  + eignfnu(i,k) * eignfnv(k,j)
+        vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
+       ENDDO
+      ENDDO
+      ENDDO
+#endif
+
+c
+      CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
+      CALL acc(eignfnv,d,iim)
+      CALL eigen_sort(dv,eignfnv,iim,iim)
+c
+      CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
+      CALL acc(eignfnu,d,iim)
+      CALL eigen_sort(du,eignfnu,iim,iim)
+
+cc   ancienne version avec appels IMSL
+c
+c     CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
+c     CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
+c     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
+c     CALL acc(eignfnv,d,iim)
+c     CALL eigen(eignfnv,dv)
+c
+c     CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
+c     CALL acc(eignfnu,d,iim)
+c     CALL eigen(eignfnu,du)
+
+      RETURN
+      END
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/inifilr.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/inifilr.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/inifilr.F	(revision 2744)
@@ -0,0 +1,584 @@
+      SUBROUTINE inifilr
+c
+c    ... H. Upadhyaya, O.Sharma   ...
+c
+      IMPLICIT NONE
+c
+c     version 3 .....
+
+c     Correction  le 28/10/97    P. Le Van .
+c  -------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "parafilt.h"
+c  -------------------------------------------------------------------
+#include "comgeom.h"
+#include "coefils.h"
+#include "logic.h"
+#include "serre.h"
+
+      REAL  dlonu(iim),dlatu(jjm)
+      REAL  rlamda( iim ),  eignvl( iim )
+c
+
+      REAL    lamdamax,pi,cof
+      INTEGER i,j,modemax,imx,k,kf,ii
+      REAL dymin,dxmin,colat0
+      REAL eignft(iim,iim), coff
+      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
+      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
+     ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
+     ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
+#ifdef CRAY
+      INTEGER   ISMIN
+      EXTERNAL  ISMIN
+      INTEGER iymin 
+      INTEGER ixmineq
+#endif
+      EXTERNAL  inifgn
+c
+c ------------------------------------------------------------
+c   This routine computes the eigenfunctions of the laplacien
+c   on the stretched grid, and the filtering coefficients
+c      
+c  We designate:
+c   eignfn   eigenfunctions of the discrete laplacien
+c   eigenvl  eigenvalues
+c   jfiltn   indexof the last scalar line filtered in NH
+c   jfilts   index of the first line filtered in SH
+c   modfrst  index of the mode from where modes are filtered
+c   modemax  maximum number of modes ( im )
+c   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
+c   sdd      SQRT( dx )
+c      
+c     the modes are filtered from modfrst to modemax
+c      
+c-----------------------------------------------------------
+c
+
+       pi       = 2. * ASIN( 1. )
+
+       DO i = 1,iim
+        dlonu(i) = xprimu( i )
+       ENDDO
+c
+       CALL inifgn(eignvl)
+c
+        print *,' EIGNVL '
+        PRINT 250,eignvl
+250     FORMAT( 1x,5e13.6)
+c
+c compute eigenvalues and eigenfunctions
+c
+c
+c.................................................................
+c
+c  compute the filtering coefficients for scalar lines and 
+c  meridional wind v-lines
+c
+c  we filter all those latitude lines where coefil < 1
+c  NO FILTERING AT POLES
+c
+c  colat0 is to be used  when alpha (stretching coefficient)
+c  is set equal to zero for the regular grid case 
+c
+c    .......   Calcul  de  colat0   .........
+c     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
+c
+c
+      DO 45 j = 1,jjm
+         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
+ 45   CONTINUE
+c
+#ifdef CRAY
+      iymin   = ISMIN( jjm, dlatu, 1 )
+      ixmineq = ISMIN( iim, dlonu, 1 )
+      dymin   = dlatu( iymin )
+      dxmin   = dlonu( ixmineq )
+#else
+      dxmin   =  dlonu(1)
+       DO  i  = 2, iim
+        dxmin = MIN( dxmin,dlonu(i) )
+       ENDDO
+      dymin  = dlatu(1)
+       DO j  = 2, jjm
+        dymin = MIN( dymin,dlatu(j) )
+       ENDDO
+#endif
+c
+c
+      colat0  =  MIN( 0.5, dymin/dxmin )
+c
+      IF( .NOT.fxyhypb.AND.ysinus )  THEN
+           colat0 = 0.6
+c         ...... a revoir  pour  ysinus !   .......
+           alphax = 0.
+      ENDIF
+c
+      PRINT 50, colat0,alphax
+  50  FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7)
+c
+      IF(alphax.EQ.1. )  THEN
+        PRINT *,' Inifilr  alphax doit etre  <  a 1.  Corriger '
+         STOP
+      ENDIF
+c
+      lamdamax = iim / ( pi * colat0 * ( 1. - alphax ) )
+
+cc                        ... Correction  le 28/10/97  ( P.Le Van ) ..
+c
+      DO 71 i = 2,iim
+       rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
+ 71   CONTINUE
+c
+
+      DO 72 j = 1,jjm
+	    DO 73 i = 1,iim
+	    coefilu( i,j )  = 0.0
+	    coefilv( i,j )  = 0.0
+	    coefilu2( i,j ) = 0.0
+	    coefilv2( i,j ) = 0.0
+ 73     CONTINUE
+ 72   CONTINUE
+
+c
+c    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
+c    .........................................................
+c
+       modemax = iim
+
+cccc    imx = modemax - 4 * (modemax/iim)
+
+       imx  = iim
+c
+       PRINT *,' TRUNCATION AT ',imx
+c
+      DO 75 j = 2, jjm/2+1
+       cof = COS( rlatu(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
+        ENDIF
+
+       cof = COS( rlatu(jjp1-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. )
+     $      jfiltsu= jjp1-j+1
+        ENDIF
+ 75   CONTINUE
+c
+      DO 76 j = 1, jjm/2
+       cof = COS( rlatv(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
+        ENDIF
+
+       cof = COS( rlatv(jjm-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. )
+     $       jfiltsv= jjm-j+1
+        ENDIF
+ 76   CONTINUE
+c                                 
+
+      IF( jfiltnu.LE.0 .OR. jfiltnu.GT. jjm/2 +1 )  THEN
+        PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu
+        STOP
+      ENDIF
+
+      IF( jfiltsu.LE.0 .OR. jfiltsu.GT.  jjm  +1 )  THEN
+        PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu
+        STOP
+      ENDIF
+
+      IF( jfiltnv.LE.0 .OR. jfiltnv.GT. jjm/2    )  THEN
+        PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv
+        STOP
+      ENDIF
+
+      IF( jfiltsv.LE.0 .OR. jfiltsv.GT.     jjm  )  THEN
+        PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv
+        STOP
+      ENDIF
+
+       PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' ,
+     *           jfiltnv,jfiltsv,jfiltnu,jfiltsu
+
+c                                 
+c   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
+c................................................................
+c
+c
+      DO 77 j = 1,jjm
+	  modfrstu( j ) = iim
+	  modfrstv( j ) = iim
+ 77   CONTINUE
+c
+      DO 84 j = 2,jfiltnu
+       DO 81 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 82
+ 81    CONTINUE
+      GOTO 84
+ 82   modfrstu( j ) = k
+c
+	  kf = modfrstu( j )
+	   DO 83 k = kf , modemax
+        cof = rlamda(k) * COS( rlatu(j) )
+	    coefilu(k,j) = cof - 1.
+	    coefilu2(k,j) = cof*cof - 1.
+ 83    CONTINUE
+ 84   CONTINUE
+c                                 
+c
+      DO 89 j = 1,jfiltnv
+c
+       DO 86 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 87
+ 86    CONTINUE
+      GOTO 89
+ 87   modfrstv( j ) = k
+c
+	   kf = modfrstv( j )
+	   DO 88 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 88    CONTINUE
+c
+ 89    CONTINUE
+c
+      DO 94 j = jfiltsu,jjm
+       DO 91 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 92
+ 91    CONTINUE
+      GOTO 94
+ 92   modfrstu( j ) = k
+c
+        kf = modfrstu( j )
+	 DO 93 k = kf , modemax
+          cof = rlamda(k) * COS( rlatu(j) )
+	  coefilu(k,j) = cof - 1.
+	  coefilu2(k,j) = cof*cof - 1.
+ 93      CONTINUE
+ 94    CONTINUE
+c                                 
+      DO 99 j = jfiltsv,jjm
+       DO 96 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 97
+ 96    CONTINUE
+      GOTO 99
+ 97   modfrstv( j ) = k
+c
+       kf = modfrstv( j )
+	   DO 98 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 98    CONTINUE
+ 99   CONTINUE
+c
+
+       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
+
+         IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
+         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
+
+          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' ,
+     *        jfiltnv,jfiltsv,jfiltnu,jfiltsu
+       ENDIF
+
+       PRINT *,'   Modes premiers  v  '
+       PRINT 334,modfrstv
+       PRINT *,'   Modes premiers  u  '
+       PRINT 334,modfrstu
+
+     
+      IF( nfilun.LT. jfiltnu )  THEN
+       PRINT *,' le parametre nfilun utilise pour la matrice ',
+     *   ' matriceun  est trop petit ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilun.GT. jfiltnu+ 2 )  THEN
+           PRINT *,' le parametre nfilun utilise pour la matrice ',
+     *' matriceun est trop grand ! Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+c              STOP
+      ENDIF
+      IF( nfilus.LT. jjm - jfiltsu +1 )  THEN
+            PRINT *,' le parametre nfilus utilise pour la matrice ',
+     *   ' matriceus  est trop petit !  '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ',
+     * jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilus.GT. jjm - jfiltsu + 3 )  THEN
+           PRINT *,' le parametre nfilus utilise pour la matrice ',
+     * ' matriceus  est trop grand ! ' 
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' ,
+     * jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+c              STOP
+      ENDIF
+      IF( nfilvn.LT. jfiltnv )  THEN
+            PRINT *,' le parametre nfilvn utilise pour la matrice ',
+     *   ' matricevn  est trop petit ! '  
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvn.GT. jfiltnv+ 2 )  THEN
+           PRINT *,' le parametre nfilvn utilise pour la matrice ',
+     *' matricevn est trop grand !  Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+c              STOP
+      ENDIF
+      IF( nfilvs.LT. jjm - jfiltsv +1 )  THEN
+            PRINT *,' le parametre nfilvs utilise pour la matrice ',
+     *   ' matricevs  est trop petit !  Le changer dans parafilt.h '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  '
+     * , jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvs.GT. jjm - jfiltsv + 3 )  THEN
+           PRINT *,' le parametre nfilvs utilise pour la matrice ',
+     * ' matricevs  est trop grand ! Gachis de memoire ! '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  '
+     *   ,  jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+c              STOP
+      ENDIF
+
+c  
+c   ...................................................................
+c
+c   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
+c                       sur la grille scalaire                 ........
+c   ...................................................................
+c
+        DO j = 2, jfiltnu
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM( eignfnv,iim,eignft,iim,matriceun(1,1,j),iim )
+#else
+#ifdef BLAS
+         CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $   eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceun(i,k,j) = 0.0
+            DO ii = 1, iim
+               matriceun(i,k,j) = matriceun(i,k,j)
+     .                          + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matriceus(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $           eignfnv, iim, eignft, iim, 0.0, 
+     $           matriceus(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceus(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1)
+     .                                    + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+c   ...................................................................
+c
+c   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
+c                       sur la grille   de V ou de Z           ........
+c   ...................................................................
+c
+        DO j = 1, jfiltnv
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+           DO k = 1, iim
+            eignft(i,k) = eignfnu(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnu,iim,eignft,iim,matricevn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $     eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matricevn(i,k,j) = matricevn(i,k,j)
+     .                          + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsv, jjm
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+            DO k = 1, iim
+             eignft(i,k) = eignfnu(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnu,iim,eignft,iim,matricevs(1,1,j-jfiltsv+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $           eignfnu, iim, eignft, iim, 0.0, 
+     $           matricevs(1,1,j-jfiltsv+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevs(i,k,j-jfiltsv+1) = 0.0
+            DO ii = 1, iim
+               matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1)
+     .                          + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+c   ...................................................................
+c
+c   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
+c              sur la grille scalaire , pour le filtre inverse ........
+c   ...................................................................
+c
+        DO j = 2, jfiltnu
+
+         DO i = 1,iim
+          coff = coefilu(i,j)/ ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnv,iim,eignft,iim,matrinvn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $     eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matrinvn(i,k,j) = matrinvn(i,k,j)
+     .                          + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i = 1,iim
+          coff = coefilu(i,j) / ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matrinvs(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $ eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvs(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1)
+     .                          + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+c   ...................................................................
+
+c
+334    FORMAT(1x,24i3)
+755    FORMAT(1x,6f10.3,i3)
+
+       RETURN
+       END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/jacobi.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/jacobi.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/jacobi.F	(revision 2744)
@@ -0,0 +1,94 @@
+      SUBROUTINE JACOBI(A,N,NP,D,V,NROT)
+      PARAMETER (NMAX=400)
+      DIMENSION A(NP,NP),D(NP),V(NP,NP),B(NMAX),Z(NMAX)
+      IF (n.gt.nmax) THEN
+         print*, 'n, nmax=', n, nmax
+         print*, 'Surdimensionnement insuffisant dans jacobi'
+         CALL abort
+      ENDIF
+      DO 12 IP=1,N
+        DO 11 IQ=1,N
+          V(IP,IQ)=0.
+11      CONTINUE
+        V(IP,IP)=1.
+12    CONTINUE
+      DO 13 IP=1,N
+        B(IP)=A(IP,IP)
+        D(IP)=B(IP)
+        Z(IP)=0.
+13    CONTINUE
+      NROT=0
+      DO 24 I=1,50
+        SM=0.
+        DO 15 IP=1,N-1
+          DO 14 IQ=IP+1,N
+            SM=SM+ABS(A(IP,IQ))
+14        CONTINUE
+15      CONTINUE
+        IF(SM.EQ.0.)RETURN
+        IF(I.LT.4)THEN
+          TRESH=0.2*SM/N**2
+        ELSE
+          TRESH=0.
+        ENDIF
+        DO 22 IP=1,N-1
+          DO 21 IQ=IP+1,N
+            G=100.*ABS(A(IP,IQ))
+            IF((I.GT.4).AND.(ABS(D(IP))+G.EQ.ABS(D(IP)))
+     *         .AND.(ABS(D(IQ))+G.EQ.ABS(D(IQ))))THEN
+              A(IP,IQ)=0.
+            ELSE IF(ABS(A(IP,IQ)).GT.TRESH)THEN
+              H=D(IQ)-D(IP)
+              IF(ABS(H)+G.EQ.ABS(H))THEN
+                T=A(IP,IQ)/H
+              ELSE
+                THETA=0.5*H/A(IP,IQ)
+                T=1./(ABS(THETA)+SQRT(1.+THETA**2))
+                IF(THETA.LT.0.)T=-T
+              ENDIF
+              C=1./SQRT(1+T**2)
+              S=T*C
+              TAU=S/(1.+C)
+              H=T*A(IP,IQ)
+              Z(IP)=Z(IP)-H
+              Z(IQ)=Z(IQ)+H
+              D(IP)=D(IP)-H
+              D(IQ)=D(IQ)+H
+              A(IP,IQ)=0.
+              DO 16 J=1,IP-1
+                G=A(J,IP)
+                H=A(J,IQ)
+                A(J,IP)=G-S*(H+G*TAU)
+                A(J,IQ)=H+S*(G-H*TAU)
+16            CONTINUE
+              DO 17 J=IP+1,IQ-1
+                G=A(IP,J)
+                H=A(J,IQ)
+                A(IP,J)=G-S*(H+G*TAU)
+                A(J,IQ)=H+S*(G-H*TAU)
+17            CONTINUE
+              DO 18 J=IQ+1,N
+                G=A(IP,J)
+                H=A(IQ,J)
+                A(IP,J)=G-S*(H+G*TAU)
+                A(IQ,J)=H+S*(G-H*TAU)
+18            CONTINUE
+              DO 19 J=1,N
+                G=V(J,IP)
+                H=V(J,IQ)
+                V(J,IP)=G-S*(H+G*TAU)
+                V(J,IQ)=H+S*(G-H*TAU)
+19            CONTINUE
+              NROT=NROT+1
+            ENDIF
+21        CONTINUE
+22      CONTINUE
+        DO 23 IP=1,N
+          B(IP)=B(IP)+Z(IP)
+          D(IP)=B(IP)
+          Z(IP)=0.
+23      CONTINUE
+24    CONTINUE
+      STOP '50 iterations should never happen'
+      RETURN
+      END
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/parafilt.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/parafilt.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/filtrez/parafilt.h	(revision 2744)
@@ -0,0 +1,40 @@
+        INTEGER nfilun, nfilus, nfilvn, nfilvs
+c
+c 48 32 19 non-zoom:
+c       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
+c        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
+c         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
+c        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
+cmaf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
+c
+c
+c 96 49 11 non-zoom:
+ccc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
+c
+c
+c 144 73 11 non-zoom:
+ccc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
+c
+c 192 143 19 non-zoom:
+c             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
+c      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
+       PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
+c       PARAMETER (nfilun=9,nfilus=8,nfilvn=8,nfilvs=8)
+
+c 96 72 19 non-zoom:
+ccc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
+c
+c        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
+c        PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
+c
+c
+c      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
+c
+c      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
+c
+c      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et 
+c
+c      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
+c
+c      Parameter  ci-dessus  et de relancer  le  run .  
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.1.1.32.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.1.1.32.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.1.1.32.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.1.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.1.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.1.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=1
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.10.48.55.t6
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.10.48.55.t6	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.10.48.55.t6	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 10
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=55
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=6
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t15
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t15	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t15	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=32
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=32
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.176.90.18.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.176.90.18.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.176.90.18.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 176
+      INTEGER, parameter :: jjm=90
+      INTEGER, parameter :: llm=18
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.2.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.2.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.2.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=2
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.20.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.20.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.20.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=20
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.201.2.40.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.201.2.40.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.201.2.40.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 201
+      INTEGER, parameter :: jjm=2
+      INTEGER, parameter :: llm=40
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t15
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t15	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t15	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t32
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t32	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.25.t32	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=32
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.30.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.30.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.30.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=30
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t13
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t13	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t13	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=13
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t12
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t12	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t12	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=12
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t60
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t60	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t60	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=60
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.34.60.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.34.60.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.34.60.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=34
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t15
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t15	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t15	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.32.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.40.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.40.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.40.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=40
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.45.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.45.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.45.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=45
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.50.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.50.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.50.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.50.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.50.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.50.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.50.t15
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.50.t15	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.50.t15	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.60.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.60.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.60.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.24.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.24.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.24.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=24
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t-p
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t-p	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t-p	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=-p
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t12
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t12	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t12	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=12
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t13
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t13	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t13	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=13
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t15
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t15	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t15	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.325.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.325.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.325.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=325
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t1	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t15
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t15	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t15	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t14
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t14	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t14	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=54
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=54
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.72.36.32.t2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.72.36.32.t2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/dimensions.72.36.32.t2	(revision 2744)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 72
+      INTEGER, parameter :: jjm=36
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim	(revision 2744)
@@ -0,0 +1,66 @@
+nqmx=$1
+shift
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions${list}.t${nqmx}
+
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+ if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+   n2=$1
+   ndm=1
+
+#  while [ "$n2" -gt 2 ]; do
+#      n2=`expr $n2 / 2`
+#     ndm=`expr $ndm + 1`
+#   done
+#   if [ "$n2" != 2 ] ; then
+#      echo le nombre de longitude doit etre une puissance de 2
+#      exit
+#   fi
+
+ else if [ $# -ge 2 ] ; then
+      im=1
+       jm=$1
+      lm=$2
+      ndm=1
+ else if [ $# -ge 1 ] ; then
+         im=1
+         jm=1
+         lm=$1
+         ndm=1
+ else
+         echo il faut au moins une dimension
+         exit
+ fi
+fi
+fi
+
+cat << EOF > $fichdim
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= $im
+      INTEGER, parameter :: jjm=$jm
+      INTEGER, parameter :: llm=$lm
+      INTEGER, parameter :: ndm=$ndm
+
+      integer, parameter :: nqmx=$nqmx
+
+!-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.bak
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.bak	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.bak	(revision 2744)
@@ -0,0 +1,63 @@
+nqmx=$1
+shift
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions${list}.t${nqmx}
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+ if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+   n2=$1
+   ndm=1
+   while [ "$n2" -gt 2 ]; do
+      n2=`expr $n2 / 2`
+      ndm=`expr $ndm + 1`
+   done
+   if [ "$n2" != 2 ] ; then
+      echo le nombre de longitude doit etre une puissance de 2
+      exit
+   fi
+ else if [ $# -ge 2 ] ; then
+      im=1
+      jm=$1
+      lm=$2
+      ndm=1
+ else if [ $# -ge 1 ] ; then
+         im=1
+         jm=1
+         lm=$1
+         ndm=1
+ else
+         echo il faut au moins une dimension
+         exit
+ fi
+fi
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+c   INCLUDE 'dimensions.h'
+c
+c   dimensions.h continet les dimensions du modele
+c   ndm est tel que iim=2**ndm
+c   nqmx est la dimension de la variable traceur q
+c-----------------------------------------------------------------------
+
+      INTEGER iim,jjm,llm,ndm
+
+      PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm)
+
+      integer nqmx
+      parameter (nqmx=$nqmx)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.moi
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.moi	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.moi	(revision 2744)
@@ -0,0 +1,68 @@
+nqmx=$1
+shift
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions${list}.t${nqmx}
+
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+echo $#
+if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+   n2=$1
+   ndm=1
+
+#  while [ "$n2" -gt 2 ]; do
+#      n2=`expr $n2 / 2`
+#     ndm=`expr $ndm + 1`
+#   done
+#   if [ "$n2" != 2 ] ; then
+#      echo le nombre de longitude doit etre une puissance de 2
+#      exit
+#   fi
+
+echo $#
+    if [ $# -ge 2 ] ; then
+      im=1
+       jm=$1
+      lm=$2
+      ndm=1
+      else if [ $# -ge 1 ] ; then
+         im=1
+         jm=1
+         lm=$1
+         ndm=1
+      else
+         echo il faut au moins une dimension
+         exit
+      fi
+    fi
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+c   INCLUDE 'dimensions.h'
+c
+c   dimensions.h continet les dimensions du modele
+c   ndm est tel que iim=2**ndm
+c   nqmx est la dimension de la variable traceur q
+c-----------------------------------------------------------------------
+
+      INTEGER iim,jjm,llm,ndm
+
+      PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm)
+
+      integer nqmx
+      parameter (nqmx=$nqmx)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.n
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.n	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.n	(revision 2744)
@@ -0,0 +1,65 @@
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions$list
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+if [ $# -ge 4 ] ; then
+   nqmx=$1
+   im=$2
+   jm=$3
+   lm=$4
+   n2=$2
+   ndm=1
+   while [ "$n2" -gt 2 ]; do
+      n2=`expr $n2 / 2`
+      ndm=`expr $ndm + 1`
+   done
+   if [ "$n2" != 2 ] ; then
+      echo le nombre de longitude doit etre une puissance de 2
+      exit
+   fi
+else if [ $# -ge 3 ] ; then
+   nqmx=$1
+   im=1
+   jm=$2
+   lm=$3
+   ndm=1
+   else if [ $# -ge 2 ] ; then
+      nqmx=$1
+      im=1
+      jm=1
+      lm=$2
+      ndm=1
+   else
+      echo il faut au moins une dimension
+      exit
+   fi
+fi
+
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+c   INCLUDE 'dimensions.h'
+c
+c   dimensions.h continet les dimensions du modele
+c   ndm est tel que iim=2**ndm
+c   nqmx est la dimension de la variable traceur q
+c-----------------------------------------------------------------------
+
+      INTEGER iim,jjm,llm,ndm
+
+      PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm)
+
+      integer nqmx
+      parameter (nqmx=$nqmx)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.old
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.old	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdim.old	(revision 2744)
@@ -0,0 +1,57 @@
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions$list
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+   n2=$1
+   ndm=1
+   while [ "$n2" -gt 2 ]; do
+      n2=`expr $n2 / 2`
+      ndm=`expr $ndm + 1`
+   done
+   if [ "$n2" != 2 ] ; then
+      echo le nombre de longitude doit etre une puissance de 2
+      exit
+   fi
+   else if [ $# -ge 2 ] ; then
+      im=1
+      jm=$1
+      lm=$2
+      ndm=1
+      else if [ $# -ge 1 ] ; then
+         im=1
+         jm=1
+         lm=$1
+         ndm=1
+      else
+         echo il faut au moins une dimension
+         exit
+      fi
+   fi
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+c   INCLUDE 'dimensions.h'
+c
+c   dimensions.h continet les trois dimensions du modele
+c   ndm est tel que iim=2**ndm
+c-----------------------------------------------------------------------
+
+      INTEGER iim,jjm,llm,ndm
+
+      PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdimphy
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdimphy	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makdimphy	(revision 2744)
@@ -0,0 +1,28 @@
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimphy$list
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+else
+   echo il faut preciser les dimensions
+   exit
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+      INTEGER KIDIA, KFDIA, KLON, KLEV
+      PARAMETER (KIDIA=1,KFDIA=$im*($jm-1)+2,
+     .           KLON=KFDIA-KIDIA+1,KLEV=$lm)
+c-----------------------------------------------------------------------
+EOF
+fi
+
+/bin/rm ../dimphy.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimphy.h )
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makntrac
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makntrac	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/makntrac	(revision 2744)
@@ -0,0 +1,23 @@
+fichntrac=ntraceur.$1
+
+if [ ! -f $fichntrac ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+cat << EOF > $fichntrac
+c-----------------------------------------------------------------------
+c   INCLUDE 'ntraceur.h'
+c
+c   ntraceur.h contient la dimension de la variable traceur q
+c   Generalement egale au nombre de traceur.
+c-----------------------------------------------------------------------
+
+      INTEGER nqmx
+
+      PARAMETER (nqmx=$1)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../ntraceur.h
+tar cf - $fichntrac | ( cd .. ; tar xf - ; mv $fichntrac ntraceur.h )
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/ntraceur.1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/ntraceur.1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/ntraceur.1	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'ntraceur.h'
+c
+c   ntraceur.h contient la dimension de la variable traceur q
+c   Generalement egale au nombre de traceur.
+c-----------------------------------------------------------------------
+
+      INTEGER nqmx
+
+      PARAMETER (nqmx=1)
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/ntraceur.5
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/ntraceur.5	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/dimension/ntraceur.5	(revision 2744)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'ntraceur.h'
+c
+c   ntraceur.h contient la dimension de la variable traceur q
+c   Generalement egale au nombre de traceur.
+c-----------------------------------------------------------------------
+
+      INTEGER nqmx
+
+      PARAMETER (nqmx=5)
+
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxy_new.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxy_new.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxy_new.h	(revision 2744)
@@ -0,0 +1,21 @@
+c--------------------------------------------------------------
+         REAL ripx
+         REAL fx,fxprim,fy,fyprim,ri,rj,bigy
+c
+c....stretching in x...
+c
+        ripx(  ri )= (ri-1.0) *2.*pi/FLOAT(iim) 
+        fx  (  ri )= ripx(ri) + transx  +
+     *         alphax * SIN( ripx(ri)+transx-pxo ) - pi
+        fxprim(ri) = 2.*pi/FLOAT(iim)  *
+     *        ( 1.+ alphax * COS( ripx(ri)+transx-pxo ) )
+
+c....stretching in y...
+c
+        bigy(rj)   = 2.* (FLOAT(jjp1)-rj) *pi/jjm
+        fy(rj)     =  ( bigy(rj) + transy  +
+     *        alphay * SIN( bigy(rj)+transy-pyo ) ) /2.  - pi/2.
+        fyprim(rj) = ( pi/jjm ) * ( 1.+
+     *           alphay * COS( bigy(rj)+transy-pyo ) )
+
+c--------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxy_reg.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxy_reg.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxy_reg.h	(revision 2744)
@@ -0,0 +1,42 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'fxyprim.h'
+c
+c    ................................................................
+c    ................  Fonctions in line  ...........................
+c    ................................................................
+c
+      REAL  fy, fx, fxprim, fyprim
+      REAL  ri, rj
+c
+c
+      fy    ( rj ) =    pi/FLOAT(jjm) * ( 0.5 * FLOAT(jjm) +  1. - rj  )
+      fyprim( rj ) =    pi/FLOAT(jjm)
+
+c     fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+c     fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
+
+      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/FLOAT(iim)
+c
+c
+c    La valeur de pi est passee par le common/const/ou /const2/ .
+c    Sinon, il faut la calculer avant d'appeler ces fonctions .
+c
+c   ----------------------------------------------------------------
+c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
+c   -----------------------------------------------------------------
+c
+c    .....  ici, on a l'application particuliere suivante   ........
+c
+c                **************************************
+c                **     x = 2. * pi/iim *  X         **
+c                **     y =      pi/jjm *  Y         **
+c                **************************************
+c
+c   ..................................................................
+c   ..................................................................
+c
+c
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxy_sin.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxy_sin.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxy_sin.h	(revision 2744)
@@ -0,0 +1,39 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'fxyprim.h'
+c
+c    ................................................................
+c    ................  Fonctions in line  ...........................
+c    ................................................................
+c
+      REAL  fy, fx, fxprim, fyprim
+      REAL  ri, rj
+c
+c
+      fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+      fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
+
+      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/FLOAT(iim)
+c
+c
+c    La valeur de pi est passee par le common/const/ou /const2/ .
+c    Sinon, il faut la calculer avant d'appeler ces fonctions .
+c
+c   ----------------------------------------------------------------
+c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
+c   -----------------------------------------------------------------
+c
+c    .....  ici, on a l'application particuliere suivante   ........
+c
+c                **************************************
+c                **     x = 2. * pi/iim *  X         **
+c                **     y =      pi/jjm *  Y         **
+c                **************************************
+c
+c   ..................................................................
+c   ..................................................................
+c
+c
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxyprim.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxyprim.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libf/zz_not_used/grid/fxyprim.h	(revision 2744)
@@ -0,0 +1,42 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'fxyprim.h'
+c
+c    ................................................................
+c    ................  Fonctions in line  ...........................
+c    ................................................................
+c
+      REAL  fy, fx, fxprim, fyprim
+      REAL  ri, rj
+c
+c
+      fy    ( rj ) =    pi/FLOAT(jjm) * ( 0.5 * FLOAT(jjm) +  1. - rj  )
+      fyprim( rj ) =    pi/FLOAT(jjm)
+
+c     fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+c     fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
+
+      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/FLOAT(iim)
+c
+c
+c    La valeur de pi est passee par le common/const/ou /const2/ .
+c    Sinon, il faut la calculer avant d'appeler ces fonctions .
+c
+c   ----------------------------------------------------------------
+c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
+c   -----------------------------------------------------------------
+c
+c    .....  ici, on a l'application particuliere suivante   ........
+c
+c                **************************************
+c                **     x = 2. * pi/iim *  X         **
+c                **     y =      pi/jjm *  Y         **
+c                **************************************
+c
+c   ..................................................................
+c   ..................................................................
+c
+c
+c
+c-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/libo/log_compile_phys
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/libo/log_compile_phys	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/libo/log_compile_phys	(revision 2744)
@@ -0,0 +1,54 @@
+coucou
+Linux
+Optimisations par defaut suivant les machines
+/donnees/aslmd/MODELES/WRFV3/mars_lmd
+apres les opts dim 70
+dimension avant sed 70
+calcul de la dimension
+1
+-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars -I$(LIBF)/dyn3d -I/donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1/include
+/donnees/aslmd/MODELES/WRFV3/mars_lmd/libf/grid
+/donnees/aslmd/MODELES/WRFV3/mars_lmd/libf/grid/dimension
+rm: ne peut enlever `../dimensions.h': Aucun fichier ou répertoire de ce type
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=70
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
+/donnees/aslmd/MODELES/WRFV3/mars_lmd
+/donnees/aslmd/MODELES/WRFV3/mars_lmd
+dimension 1 dim 70
+pas de dynamique
+/donnees/aslmd/MODELES/WRFV3/mars_lmd
+MACRO FILTRE FILTRE= L_FILTRE=
+1
+/donnees/aslmd/MODELES/WRFV3/mars_lmd
+les fichiers suivants ont ete crees ou detruits
+ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+32a33
+> libf/grid/d2_dimensions.h
+60d60
+< libf/phymars/dimphys.h
+136a137,140
+> libf/phymars/slope.h
+> libf/phymars/wrf_output_2d.h
+> libf/phymars/wrf_output_3d.h
+> libf/phymars/dimphys.h
+2a3
+> libf/phymars/param_slope_full.F90
+5a7,8
+> libf/phymars/param_slope.F90
+> libf/phymars/fill_save_2d.F90
+On recree le makefile
+ls: *.F90: Aucun fichier ou répertoire de ce type
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/liste_des_sources_f77
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/liste_des_sources_f77	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/liste_des_sources_f77	(revision 2744)
@@ -0,0 +1,350 @@
+libf/bibio/from36.F
+libf/bibio/ini36.F
+libf/bibio/cvmgp.F
+libf/bibio/cvmgt.F
+libf/bibio/isitor.F
+libf/bibio/lmdstd.h
+libf/bibio/lnblnk.F
+libf/bibio/mywrite.F
+libf/bibio/readcoord.F
+libf/bibio/readstd.F
+libf/bibio/to36.F
+libf/bibio/gather.F
+libf/bibio/writestd.F
+libf/bibio/ilsum.F
+libf/bibio/isamax.F
+libf/bibio/ismax.F
+libf/bibio/ismin.F
+libf/bibio/mxm.F
+libf/bibio/mxva.F
+libf/bibio/mxv.F
+libf/bibio/scatter.F
+libf/bibio/scopy.F
+libf/bibio/scopyi.F
+libf/bibio/sdot.F
+libf/bibio/ssum.F
+libf/bibio/uniplot.F
+libf/bibio/wheneq.F
+libf/bibio/cbrt.F
+libf/grid/fxy_new.h
+libf/grid/fxyprim.h
+libf/grid/fxy_reg.h
+libf/grid/fxy_sin.h
+libf/grid/d2_dimensions.h
+libf/grid/dimensions.h
+libf/phymars/aerave.F
+libf/phymars/aerdata.h
+libf/phymars/blendrad.F
+libf/phymars/calldrag_noro.F
+libf/phymars/callradite.F
+libf/phymars/callsedim.F
+libf/phymars/callsedim2q.F
+libf/phymars/aerdust.h
+libf/phymars/co2snow.F
+libf/phymars/comcstfi.h
+libf/phymars/comdiurn.h
+libf/phymars/comg1d.h
+libf/phymars/comgeomfi.h
+libf/phymars/watercloud.F
+libf/phymars/sugwd.F
+libf/phymars/comorbit.h
+libf/phymars/lwu.F
+libf/phymars/growthrate.F
+libf/phymars/tabfi.F
+libf/phymars/comsaison.h
+libf/phymars/phyetat0.F
+libf/phymars/convadj.F
+libf/phymars/cvmgp.F
+libf/phymars/cvmgt.F
+libf/phymars/datareadnc.F
+libf/phymars/dedd.F
+libf/phymars/dimradmars.h
+libf/phymars/drag_noro.F
+libf/phymars/dustdevil.F
+libf/phymars/dustlift.F
+libf/phymars/eofdump.F
+libf/phymars/eofdump.h
+libf/phymars/ineofdump.F
+libf/phymars/flusv.F
+libf/phymars/yomlw.h
+libf/phymars/gwprofil.F
+libf/phymars/gwstress.F
+libf/phymars/lwflux.F
+libf/phymars/lwmain.F
+libf/phymars/ismax.F
+libf/phymars/meso_testphys1d.F
+libf/phymars/iniorbit.F
+libf/phymars/vdifc.F
+libf/phymars/lwi.F
+libf/phymars/ismin.F
+libf/phymars/lwxb.F
+libf/phymars/lwb.F
+libf/phymars/lwdiff.F
+libf/phymars/lwxd.F
+libf/phymars/lwxn.F
+libf/phymars/lwtt.F
+libf/phymars/mucorr.F
+libf/phymars/mufract.F
+libf/phymars/newcondens.F
+libf/phymars/tracer.h
+libf/phymars/initracer.F
+libf/phymars/watercap.h
+libf/phymars/aerice.h
+libf/phymars/newsedim.F
+libf/phymars/nirco2abs.F
+libf/phymars/nltecool.F
+libf/phymars/nltedata.h
+libf/phymars/nlteparams.h
+libf/phymars/nlthermeq.F
+libf/phymars/orbite.F
+libf/phymars/orodrag.F
+libf/phymars/orosetup.F
+libf/phymars/fisice.h
+libf/phymars/physdem1.F
+libf/phymars/planete.h
+libf/phymars/profile.F
+libf/phymars/scatter.F
+libf/phymars/scopyi.F
+libf/phymars/soil.F
+libf/phymars/solang.F
+libf/phymars/solarlong.F
+libf/phymars/statto.h
+libf/phymars/suaer.F
+libf/phymars/sulw.F
+libf/phymars/blackl.F
+libf/phymars/vdif_cd.F
+libf/phymars/surfdat.h
+libf/phymars/surfini.F
+libf/phymars/swmain.F
+libf/phymars/swr.F
+libf/phymars/swrayleigh.F
+libf/phymars/uniplot.F
+libf/phymars/vdif_kc.F
+libf/phymars/vlz_fi.F
+libf/phymars/watersat.F
+libf/phymars/callkeys.h
+libf/phymars/writeg1d.F
+libf/phymars/yoegwd.h
+libf/phymars/yomaer.h
+libf/phymars/zerophys.F
+libf/phymars/inistats.F
+libf/phymars/multipl.F
+libf/phymars/datafile.h
+libf/phymars/meso_physiq.F
+libf/phymars/meso_writediagfi.F
+libf/phymars/meso_inifis.F
+libf/phymars/meso_dustopacity.F
+libf/phymars/slope.h
+libf/phymars/wrf_output_2d.h
+libf/phymars/wrf_output_3d.h
+libf/phymars/dimphys.h
+libf/aeronomars/calchim.F
+libf/aeronomars/chemthermos.F
+libf/aeronomars/ch.F
+libf/aeronomars/chimiedata.h
+libf/aeronomars/column.F
+libf/aeronomars/concentrations.F
+libf/aeronomars/conc.h
+libf/aeronomars/conduction.F
+libf/aeronomars/dtridgl.F
+libf/aeronomars/euvheat.F
+libf/aeronomars/flujo.F
+libf/aeronomars/getch.F
+libf/aeronomars/hrtherm.F
+libf/aeronomars/inichim.F
+libf/aeronomars/inichim_newstart.F
+libf/aeronomars/inichim_readcallphys.F
+libf/aeronomars/init_chimie_B.F
+libf/aeronomars/interpfast.F
+libf/aeronomars/intrplf.F
+libf/aeronomars/inv.F
+libf/aeronomars/jthermcalc.F
+libf/aeronomars/moldiffcoeff.F
+libf/aeronomars/moldiff.F
+libf/aeronomars/molvis.F
+libf/aeronomars/paramfoto.F
+libf/aeronomars/param.h
+libf/aeronomars/param_read.F
+libf/aeronomars/param_v3.h
+libf/aeronomars/perosat.F
+libf/aeronomars/phdisrate.F
+libf/aeronomars/photochemist_B.F
+libf/aeronomars/thermosphere.F
+libf/dyn3d/angtot.h
+libf/dyn3d/clesph0.h
+libf/dyn3d/comav.h
+libf/dyn3d/comconst.h
+libf/dyn3d/comdiss.h
+libf/dyn3d/comdissip.h
+libf/dyn3d/comdissipn.h
+libf/dyn3d/comdissnew.h
+libf/dyn3d/comgeom2.h
+libf/dyn3d/comgeom.h
+libf/dyn3d/comvert.h
+libf/dyn3d/control.h
+libf/dyn3d/description.h
+libf/dyn3d/ener.h
+libf/dyn3d/gradsdef.h
+libf/dyn3d/logic.h
+libf/dyn3d/paramet.h
+libf/dyn3d/para_netcdf.h
+libf/dyn3d/serre.h
+libf/dyn3d/sponge.h
+libf/dyn3d/temps.h
+libf/dyn3d/tracstoke.h
+libf/zz_not_used/filtrez/coefils.h
+libf/zz_not_used/filtrez/acc.F
+libf/zz_not_used/filtrez/eigen.F
+libf/zz_not_used/filtrez/eigen_sort.F
+libf/zz_not_used/filtrez/filtreg.F
+libf/zz_not_used/filtrez/inifgn.F
+libf/zz_not_used/filtrez/inifilr.F
+libf/zz_not_used/filtrez/jacobi.F
+libf/zz_not_used/filtrez/parafilt.h
+libf/zz_not_used/dyn3d/abort_gcm.F
+libf/zz_not_used/dyn3d/addfi.F
+libf/zz_not_used/dyn3d/addit.F
+libf/zz_not_used/dyn3d/adv_h2o.F
+libf/zz_not_used/dyn3d/advect.F
+libf/zz_not_used/dyn3d/amont.F
+libf/zz_not_used/dyn3d/amont_qsat.F
+libf/zz_not_used/dyn3d/angtot.h
+libf/zz_not_used/dyn3d/anldoppler2.F
+libf/zz_not_used/dyn3d/bernoui.F
+libf/zz_not_used/dyn3d/caldyn.F
+libf/zz_not_used/dyn3d/caldyn0.F
+libf/zz_not_used/dyn3d/calfis.F
+libf/zz_not_used/dyn3d/lect_start_archive.F
+libf/zz_not_used/dyn3d/clesph0.h
+libf/zz_not_used/dyn3d/coefpoly.F
+libf/zz_not_used/dyn3d/comav.h
+libf/zz_not_used/dyn3d/comconst.h
+libf/zz_not_used/dyn3d/comdiss.h
+libf/zz_not_used/dyn3d/comdissip.h
+libf/zz_not_used/dyn3d/divgrad22.F
+libf/zz_not_used/dyn3d/comdissipn.h
+libf/zz_not_used/dyn3d/comgeom.h
+libf/zz_not_used/dyn3d/comdissnew.h
+libf/zz_not_used/dyn3d/comgeom2.h
+libf/zz_not_used/dyn3d/comvert.h
+libf/zz_not_used/dyn3d/control.h
+libf/zz_not_used/dyn3d/convflu.F
+libf/zz_not_used/dyn3d/convmas.F
+libf/zz_not_used/dyn3d/coordij.F
+libf/zz_not_used/dyn3d/covcont.F
+libf/zz_not_used/dyn3d/covnat.F
+libf/zz_not_used/dyn3d/defrun_new.F
+libf/zz_not_used/dyn3d/description.h
+libf/zz_not_used/dyn3d/diagadv.F
+libf/zz_not_used/dyn3d/dissip.F
+libf/zz_not_used/dyn3d/disvert.F
+libf/zz_not_used/dyn3d/diverg.F
+libf/zz_not_used/dyn3d/diverg_gam.F
+libf/zz_not_used/dyn3d/divergf.F
+libf/zz_not_used/dyn3d/divergst.F
+libf/zz_not_used/dyn3d/divgrad.F
+libf/zz_not_used/dyn3d/divgrad2.F
+libf/zz_not_used/dyn3d/newstart.F
+libf/zz_not_used/dyn3d/dteta1.F
+libf/zz_not_used/dyn3d/dudv1.F
+libf/zz_not_used/dyn3d/dudv2.F
+libf/zz_not_used/dyn3d/dump2d.F
+libf/zz_not_used/dyn3d/dynetat0.F
+libf/zz_not_used/dyn3d/dynredem.F
+libf/zz_not_used/dyn3d/logic.h
+libf/zz_not_used/dyn3d/ener.h
+libf/zz_not_used/dyn3d/enercin.F
+libf/zz_not_used/dyn3d/exner.F
+libf/zz_not_used/dyn3d/exner_hyb.F
+libf/zz_not_used/dyn3d/flumass.F
+libf/zz_not_used/dyn3d/fluxstoke.F
+libf/zz_not_used/dyn3d/fxhyp.F
+libf/zz_not_used/dyn3d/fxy.F
+libf/zz_not_used/dyn3d/fxyhyper.F
+libf/zz_not_used/dyn3d/fxysinus.F
+libf/zz_not_used/dyn3d/fyhyp.F
+libf/zz_not_used/dyn3d/gcm.F
+libf/zz_not_used/dyn3d/geopot.F
+libf/zz_not_used/dyn3d/gr_dyn_fi.F
+libf/zz_not_used/dyn3d/gr_fi_dyn.F
+libf/zz_not_used/dyn3d/grad.F
+libf/zz_not_used/dyn3d/grid_noro1.F
+libf/zz_not_used/dyn3d/gr_int_dyn.F
+libf/zz_not_used/dyn3d/gr_u_scal.F
+libf/zz_not_used/dyn3d/gr_v_scal.F
+libf/zz_not_used/dyn3d/gradiv.F
+libf/zz_not_used/dyn3d/gradiv2.F
+libf/zz_not_used/dyn3d/gradsdef.h
+libf/zz_not_used/dyn3d/grid_atob.F
+libf/zz_not_used/dyn3d/grid_noro.F
+libf/zz_not_used/dyn3d/ini_archive.F
+libf/zz_not_used/dyn3d/groupe.F
+libf/zz_not_used/dyn3d/groupeun.F
+libf/zz_not_used/dyn3d/heavyside.F
+libf/zz_not_used/dyn3d/iniav.F
+libf/zz_not_used/dyn3d/iniconst.F
+libf/zz_not_used/dyn3d/inidissip.F
+libf/zz_not_used/dyn3d/inigeom.F
+libf/zz_not_used/dyn3d/inigrads.F
+libf/zz_not_used/dyn3d/iniinterp_h.F
+libf/zz_not_used/dyn3d/initial0.F
+libf/zz_not_used/dyn3d/write_archive.F
+libf/zz_not_used/dyn3d/iniwrite.F
+libf/zz_not_used/dyn3d/integrd.F
+libf/zz_not_used/dyn3d/interp_horiz.F
+libf/zz_not_used/dyn3d/interp_vert.F
+libf/zz_not_used/dyn3d/laplacien.F
+libf/zz_not_used/dyn3d/laplacien_gam.F
+libf/zz_not_used/dyn3d/laplacien_rot.F
+libf/zz_not_used/dyn3d/laplacien_rotgam.F
+libf/zz_not_used/dyn3d/lectflux.F
+libf/zz_not_used/dyn3d/massbar.F
+libf/zz_not_used/dyn3d/massbarxy.F
+libf/zz_not_used/dyn3d/massdair.F
+libf/zz_not_used/dyn3d/minmax.F
+libf/zz_not_used/dyn3d/multipl.F
+libf/zz_not_used/dyn3d/multscal.F
+libf/zz_not_used/dyn3d/start2archive.F
+libf/zz_not_used/dyn3d/paramet.h
+libf/zz_not_used/dyn3d/nxgrad.F
+libf/zz_not_used/dyn3d/vanleer.F
+libf/zz_not_used/dyn3d/nxgrad_gam.F
+libf/zz_not_used/dyn3d/nxgradst.F
+libf/zz_not_used/dyn3d/nxgraro2.F
+libf/zz_not_used/dyn3d/nxgrarot.F
+libf/zz_not_used/dyn3d/para_netcdf.h
+libf/zz_not_used/dyn3d/pression.F
+libf/zz_not_used/dyn3d/psextbar.F
+libf/zz_not_used/dyn3d/ran1.F
+libf/zz_not_used/dyn3d/rotat_nfil.F
+libf/zz_not_used/dyn3d/rotat.F
+libf/zz_not_used/dyn3d/rotatf.F
+libf/zz_not_used/dyn3d/rotatst.F
+libf/zz_not_used/dyn3d/scal_wind.F
+libf/zz_not_used/dyn3d/serre.h
+libf/zz_not_used/dyn3d/sortvarc.F
+libf/zz_not_used/dyn3d/sortvarc0.F
+libf/zz_not_used/dyn3d/spline.F
+libf/zz_not_used/dyn3d/splint.F
+libf/zz_not_used/dyn3d/sponge.F
+libf/zz_not_used/dyn3d/sponge.h
+libf/zz_not_used/dyn3d/temps.h
+libf/zz_not_used/dyn3d/test_period.F
+libf/zz_not_used/dyn3d/testharm.F
+libf/zz_not_used/dyn3d/tourpot.F
+libf/zz_not_used/dyn3d/traceur.F
+libf/zz_not_used/dyn3d/tracstoke.h
+libf/zz_not_used/dyn3d/tracvl.F
+libf/zz_not_used/dyn3d/vitvert.F
+libf/zz_not_used/dyn3d/vlsplt.F
+libf/zz_not_used/dyn3d/vlspltqs.F
+libf/zz_not_used/dyn3d/wind_scal.F
+libf/zz_not_used/dyn3d/wrgrads.F
+libf/zz_not_used/dyn3d/xvik.F
+libf/zz_not_used/dyn3d/readhead_NC.F
+libf/zz_not_used/dyn3d/anl_stats-diag.F
+libf/zz_not_used/dyn3d/anl_mcdstats.F
+libf/zz_not_used/grid/fxy_new.h
+libf/zz_not_used/grid/fxy_reg.h
+libf/zz_not_used/grid/fxy_sin.h
+libf/zz_not_used/grid/fxyprim.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/liste_des_sources_f90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/liste_des_sources_f90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/liste_des_sources_f90	(revision 2744)
@@ -0,0 +1,8 @@
+libf/phymars/meso_readtesassim.F90
+libf/phymars/wstats.F90
+libf/phymars/param_slope_full.F90
+libf/phymars/def_var.F90
+libf/phymars/mkstat.F90
+libf/phymars/readtesassim.F90
+libf/phymars/param_slope.F90
+libf/phymars/fill_save_2d.F90
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/makefile	(revision 2744)
@@ -0,0 +1,1681 @@
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Definitions de Macros pour Make
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+# Repertoires :
+
+GCM     = /donnees/aslmd/WRF/MARS_WRF/64bits_pgf90/WRFV2/mars_lmd
+MACHINE = sun4
+LIBF    = $(GCM)/libf
+LIBO    = $(LIBOGCM)/$(MACHINE)
+LOCAL_DIR=/donnees/aslmd/WRF/MARS_WRF/64bits_pgf90/WRFV2/mars_lmd
+BIBIO    = $(LIBF)/bibio
+AERONOMARS    = $(LIBF)/aeronomars
+FILTRE   = filtre
+PHYS  = 
+DYN  = dyn 
+LIBPHY = $(LIBO)/libphy$(PHYS).a
+DIRMAIN=dyn$(DIM)d
+RM=rm
+
+OPLINK = 
+
+# Les differentes librairies pour l"edition des liens:
+
+dyn3d      = $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a
+dyn2d      = $(LIBO)/libdyn2d.a
+dyn1d      = $(LIBO)/libdyn1d.a
+L_DYN      = -ldyn$(DIM)d
+L_FILTRE   = -l$(FILTRE)
+L_PHY = -lphy$(PHYS) 
+L_BIBIO    = -lbibio
+L_AERONOMARS    = -laeronomars
+L_ADJNT    =
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Option de compilation FORTRAN
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+COMPILE90 = $(F90) $(OPTIM90) $(INCLUDE) -c
+LINK    = 
+AR      = 
+
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Creation des differents executables
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+# Executables:
+# ------------
+
+PROG = code
+
+main : $(DYN) bibio phys aeronomars $(OPTION_DEP) 
+	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(PROG).F -o $(PROG).o ; \
+	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o 
+
+dyn : $(LIBO)/libdyn$(DIM)d.a $(FILTRE)$(DIM)d
+
+phys : $(LIBPHY)
+
+bibio : $(LIBO)/libbibio.a
+
+aeronomars : $(LIBO)/libaeronomars.a
+
+adjnt : $(LIBO)/libadjnt.a
+
+$(FILTRE)3d : $(LIBO)/lib$(FILTRE).a
+
+$(FILTRE)2d :
+
+$(FILTRE)1d :
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Contenu des differentes bibliotheques
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+
+
+#=======================================================================
+# Contenu de la bibliotheque correspondant au Directory aeronomars
+#=======================================================================
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(calchim.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(chemthermos.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(ch.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(column.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(concentrations.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(conduction.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(dtridgl.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(euvheat.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(flujo.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(getch.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(hrtherm.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inichim.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inichim_newstart.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inichim_readcallphys.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(init_chimie_B.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(interpfast.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(intrplf.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inv.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(jthermcalc.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(moldiffcoeff.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(moldiff.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(molvis.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(paramfoto.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(param_read.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(perosat.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(phdisrate.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(photochemist_B.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(thermosphere.o)
+
+.PRECIOUS	: $(LIBO)/libaeronomars.a
+
+
+# Compilation des membres de la bibliotheque libaeronomars.a
+
+$(LIBO)/libaeronomars.a(calchim.o) : $(LIBF)/aeronomars/calchim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/calchim.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a calchim.o ; $(RM) calchim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(chemthermos.o) : $(LIBF)/aeronomars/chemthermos.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/chemthermos.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a chemthermos.o ; $(RM) chemthermos.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(ch.o) : $(LIBF)/aeronomars/ch.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/ch.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a ch.o ; $(RM) ch.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(column.o) : $(LIBF)/aeronomars/column.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/column.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a column.o ; $(RM) column.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(concentrations.o) : $(LIBF)/aeronomars/concentrations.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/concentrations.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a concentrations.o ; $(RM) concentrations.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(conduction.o) : $(LIBF)/aeronomars/conduction.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/conduction.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a conduction.o ; $(RM) conduction.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(dtridgl.o) : $(LIBF)/aeronomars/dtridgl.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/dtridgl.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a dtridgl.o ; $(RM) dtridgl.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(euvheat.o) : $(LIBF)/aeronomars/euvheat.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/euvheat.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a euvheat.o ; $(RM) euvheat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(flujo.o) : $(LIBF)/aeronomars/flujo.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/flujo.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a flujo.o ; $(RM) flujo.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(getch.o) : $(LIBF)/aeronomars/getch.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/getch.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a getch.o ; $(RM) getch.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(hrtherm.o) : $(LIBF)/aeronomars/hrtherm.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/hrtherm.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a hrtherm.o ; $(RM) hrtherm.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(inichim.o) : $(LIBF)/aeronomars/inichim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/datafile.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/inichim.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a inichim.o ; $(RM) inichim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(inichim_newstart.o) : $(LIBF)/aeronomars/inichim_newstart.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/phymars/datafile.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/inichim_newstart.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a inichim_newstart.o ; $(RM) inichim_newstart.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(inichim_readcallphys.o) : $(LIBF)/aeronomars/inichim_readcallphys.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comsaison.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/surfdat.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/inichim_readcallphys.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a inichim_readcallphys.o ; $(RM) inichim_readcallphys.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(init_chimie_B.o) : $(LIBF)/aeronomars/init_chimie_B.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/datafile.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/init_chimie_B.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a init_chimie_B.o ; $(RM) init_chimie_B.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(interpfast.o) : $(LIBF)/aeronomars/interpfast.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/interpfast.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a interpfast.o ; $(RM) interpfast.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(intrplf.o) : $(LIBF)/aeronomars/intrplf.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/intrplf.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a intrplf.o ; $(RM) intrplf.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(inv.o) : $(LIBF)/aeronomars/inv.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/inv.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a inv.o ; $(RM) inv.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(jthermcalc.o) : $(LIBF)/aeronomars/jthermcalc.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/jthermcalc.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a jthermcalc.o ; $(RM) jthermcalc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(moldiffcoeff.o) : $(LIBF)/aeronomars/moldiffcoeff.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/moldiffcoeff.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a moldiffcoeff.o ; $(RM) moldiffcoeff.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(moldiff.o) : $(LIBF)/aeronomars/moldiff.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/moldiff.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a moldiff.o ; $(RM) moldiff.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(molvis.o) : $(LIBF)/aeronomars/molvis.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/molvis.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a molvis.o ; $(RM) molvis.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(paramfoto.o) : $(LIBF)/aeronomars/paramfoto.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/paramfoto.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a paramfoto.o ; $(RM) paramfoto.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(param_read.o) : $(LIBF)/aeronomars/param_read.F \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/phymars/datafile.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/param_read.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a param_read.o ; $(RM) param_read.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(perosat.o) : $(LIBF)/aeronomars/perosat.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/perosat.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a perosat.o ; $(RM) perosat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(phdisrate.o) : $(LIBF)/aeronomars/phdisrate.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/phdisrate.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a phdisrate.o ; $(RM) phdisrate.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(photochemist_B.o) : $(LIBF)/aeronomars/photochemist_B.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/photochemist_B.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a photochemist_B.o ; $(RM) photochemist_B.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(thermosphere.o) : $(LIBF)/aeronomars/thermosphere.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/thermosphere.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a thermosphere.o ; $(RM) thermosphere.o ; \
+	cd $(GCM)
+
+
+
+
+
+#=======================================================================
+# Contenu de la bibliotheque correspondant au Directory bibio
+#=======================================================================
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(cbrt.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(cvmgp.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(cvmgt.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(from36.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(gather.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ilsum.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ini36.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(isamax.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(isitor.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ismax.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ismin.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(lnblnk.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(mxm.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(mxva.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(mxv.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(mywrite.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(readcoord.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(readstd.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(scatter.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(scopy.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(scopyi.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(sdot.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ssum.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(to36.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(uniplot.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(wheneq.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(writestd.o)
+
+.PRECIOUS	: $(LIBO)/libbibio.a
+
+
+# Compilation des membres de la bibliotheque libbibio.a
+
+$(LIBO)/libbibio.a(cbrt.o) : $(LIBF)/bibio/cbrt.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/cbrt.F ; \
+	$(AR) r $(LIBO)/libbibio.a cbrt.o ; $(RM) cbrt.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(cvmgp.o) : $(LIBF)/bibio/cvmgp.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/cvmgp.F ; \
+	$(AR) r $(LIBO)/libbibio.a cvmgp.o ; $(RM) cvmgp.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(cvmgt.o) : $(LIBF)/bibio/cvmgt.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/cvmgt.F ; \
+	$(AR) r $(LIBO)/libbibio.a cvmgt.o ; $(RM) cvmgt.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(from36.o) : $(LIBF)/bibio/from36.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/from36.F ; \
+	$(AR) r $(LIBO)/libbibio.a from36.o ; $(RM) from36.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(gather.o) : $(LIBF)/bibio/gather.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/gather.F ; \
+	$(AR) r $(LIBO)/libbibio.a gather.o ; $(RM) gather.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ilsum.o) : $(LIBF)/bibio/ilsum.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ilsum.F ; \
+	$(AR) r $(LIBO)/libbibio.a ilsum.o ; $(RM) ilsum.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ini36.o) : $(LIBF)/bibio/ini36.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ini36.F ; \
+	$(AR) r $(LIBO)/libbibio.a ini36.o ; $(RM) ini36.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(isamax.o) : $(LIBF)/bibio/isamax.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/isamax.F ; \
+	$(AR) r $(LIBO)/libbibio.a isamax.o ; $(RM) isamax.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(isitor.o) : $(LIBF)/bibio/isitor.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/isitor.F ; \
+	$(AR) r $(LIBO)/libbibio.a isitor.o ; $(RM) isitor.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ismax.o) : $(LIBF)/bibio/ismax.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ismax.F ; \
+	$(AR) r $(LIBO)/libbibio.a ismax.o ; $(RM) ismax.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ismin.o) : $(LIBF)/bibio/ismin.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ismin.F ; \
+	$(AR) r $(LIBO)/libbibio.a ismin.o ; $(RM) ismin.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(lnblnk.o) : $(LIBF)/bibio/lnblnk.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/lnblnk.F ; \
+	$(AR) r $(LIBO)/libbibio.a lnblnk.o ; $(RM) lnblnk.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(mxm.o) : $(LIBF)/bibio/mxm.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/mxm.F ; \
+	$(AR) r $(LIBO)/libbibio.a mxm.o ; $(RM) mxm.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(mxva.o) : $(LIBF)/bibio/mxva.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/mxva.F ; \
+	$(AR) r $(LIBO)/libbibio.a mxva.o ; $(RM) mxva.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(mxv.o) : $(LIBF)/bibio/mxv.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/mxv.F ; \
+	$(AR) r $(LIBO)/libbibio.a mxv.o ; $(RM) mxv.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(mywrite.o) : $(LIBF)/bibio/mywrite.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/mywrite.F ; \
+	$(AR) r $(LIBO)/libbibio.a mywrite.o ; $(RM) mywrite.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(readcoord.o) : $(LIBF)/bibio/readcoord.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/readcoord.F ; \
+	$(AR) r $(LIBO)/libbibio.a readcoord.o ; $(RM) readcoord.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(readstd.o) : $(LIBF)/bibio/readstd.F \
+$(LIBF)/bibio/lmdstd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/readstd.F ; \
+	$(AR) r $(LIBO)/libbibio.a readstd.o ; $(RM) readstd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(scatter.o) : $(LIBF)/bibio/scatter.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/scatter.F ; \
+	$(AR) r $(LIBO)/libbibio.a scatter.o ; $(RM) scatter.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(scopy.o) : $(LIBF)/bibio/scopy.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/scopy.F ; \
+	$(AR) r $(LIBO)/libbibio.a scopy.o ; $(RM) scopy.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(scopyi.o) : $(LIBF)/bibio/scopyi.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/scopyi.F ; \
+	$(AR) r $(LIBO)/libbibio.a scopyi.o ; $(RM) scopyi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(sdot.o) : $(LIBF)/bibio/sdot.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/sdot.F ; \
+	$(AR) r $(LIBO)/libbibio.a sdot.o ; $(RM) sdot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ssum.o) : $(LIBF)/bibio/ssum.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ssum.F ; \
+	$(AR) r $(LIBO)/libbibio.a ssum.o ; $(RM) ssum.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(to36.o) : $(LIBF)/bibio/to36.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/to36.F ; \
+	$(AR) r $(LIBO)/libbibio.a to36.o ; $(RM) to36.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(uniplot.o) : $(LIBF)/bibio/uniplot.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/uniplot.F ; \
+	$(AR) r $(LIBO)/libbibio.a uniplot.o ; $(RM) uniplot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(wheneq.o) : $(LIBF)/bibio/wheneq.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/wheneq.F ; \
+	$(AR) r $(LIBO)/libbibio.a wheneq.o ; $(RM) wheneq.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(writestd.o) : $(LIBF)/bibio/writestd.F \
+$(LIBF)/bibio/lmdstd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/writestd.F ; \
+	$(AR) r $(LIBO)/libbibio.a writestd.o ; $(RM) writestd.o ; \
+	cd $(GCM)
+
+
+
+
+
+#=======================================================================
+# Contenu de la bibliotheque correspondant au Directory phymars
+#=======================================================================
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(aerave.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(blackl.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(blendrad.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(calldrag_noro.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(callradite.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(callsedim2q.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(callsedim.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(co2snow.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(convadj.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(cvmgp.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(cvmgt.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(datareadnc.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(dedd.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(drag_noro.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(dustdevil.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(dustlift.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(eofdump.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(flusv.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(growthrate.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(gwprofil.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(gwstress.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(ineofdump.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(iniorbit.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(inistats.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(initracer.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(ismax.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(ismin.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwb.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwdiff.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwflux.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwmain.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwtt.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwu.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwxb.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwxd.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwxn.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(meso_dustopacity.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(meso_inifis.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(meso_physiq.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(meso_writediagfi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(mucorr.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(mufract.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(multipl.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(newcondens.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(newsedim.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(nirco2abs.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(nltecool.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(nlthermeq.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(orbite.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(orodrag.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(orosetup.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(phyetat0.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(physdem1.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(profile.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(scatter.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(scopyi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(soil.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(solang.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(solarlong.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(suaer.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(sugwd.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(sulw.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(surfini.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(swmain.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(swrayleigh.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(swr.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(tabfi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(uniplot.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(vdif_cd.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(vdifc.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(vdif_kc.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(vlz_fi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(watercloud.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(watersat.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(writeg1d.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(zerophys.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(def_var.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(meso_readtesassim.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(mkstat.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(readtesassim.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(wstats.o)
+
+.PRECIOUS	: $(LIBO)/libphymars.a
+
+
+# Compilation des membres de la bibliotheque libphymars.a
+
+$(LIBO)/libphymars.a(aerave.o) : $(LIBF)/phymars/aerave.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/aerave.F ; \
+	$(AR) r $(LIBO)/libphymars.a aerave.o ; $(RM) aerave.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(blackl.o) : $(LIBF)/phymars/blackl.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/blackl.F ; \
+	$(AR) r $(LIBO)/libphymars.a blackl.o ; $(RM) blackl.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(blendrad.o) : $(LIBF)/phymars/blendrad.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/nlteparams.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/blendrad.F ; \
+	$(AR) r $(LIBO)/libphymars.a blendrad.o ; $(RM) blendrad.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(calldrag_noro.o) : $(LIBF)/phymars/calldrag_noro.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/surfdat.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/calldrag_noro.F ; \
+	$(AR) r $(LIBO)/libphymars.a calldrag_noro.o ; $(RM) calldrag_noro.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(callradite.o) : $(LIBF)/phymars/callradite.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/callradite.F ; \
+	$(AR) r $(LIBO)/libphymars.a callradite.o ; $(RM) callradite.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(callsedim2q.o) : $(LIBF)/phymars/callsedim2q.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/callsedim2q.F ; \
+	$(AR) r $(LIBO)/libphymars.a callsedim2q.o ; $(RM) callsedim2q.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(callsedim.o) : $(LIBF)/phymars/callsedim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/fisice.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/callsedim.F ; \
+	$(AR) r $(LIBO)/libphymars.a callsedim.o ; $(RM) callsedim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(co2snow.o) : $(LIBF)/phymars/co2snow.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/co2snow.F ; \
+	$(AR) r $(LIBO)/libphymars.a co2snow.o ; $(RM) co2snow.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(convadj.o) : $(LIBF)/phymars/convadj.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/convadj.F ; \
+	$(AR) r $(LIBO)/libphymars.a convadj.o ; $(RM) convadj.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(cvmgp.o) : $(LIBF)/phymars/cvmgp.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/cvmgp.F ; \
+	$(AR) r $(LIBO)/libphymars.a cvmgp.o ; $(RM) cvmgp.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(cvmgt.o) : $(LIBF)/phymars/cvmgt.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/cvmgt.F ; \
+	$(AR) r $(LIBO)/libphymars.a cvmgt.o ; $(RM) cvmgt.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(datareadnc.o) : $(LIBF)/phymars/datareadnc.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/phymars/datafile.h \
+$(LIBF)/bibio/lmdstd.h \
+$(LIBF)/grid/fxyprim.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/datareadnc.F ; \
+	$(AR) r $(LIBO)/libphymars.a datareadnc.o ; $(RM) datareadnc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(dedd.o) : $(LIBF)/phymars/dedd.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/dedd.F ; \
+	$(AR) r $(LIBO)/libphymars.a dedd.o ; $(RM) dedd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(drag_noro.o) : $(LIBF)/phymars/drag_noro.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/drag_noro.F ; \
+	$(AR) r $(LIBO)/libphymars.a drag_noro.o ; $(RM) drag_noro.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(dustdevil.o) : $(LIBF)/phymars/dustdevil.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/dustdevil.F ; \
+	$(AR) r $(LIBO)/libphymars.a dustdevil.o ; $(RM) dustdevil.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(dustlift.o) : $(LIBF)/phymars/dustlift.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/dustlift.F ; \
+	$(AR) r $(LIBO)/libphymars.a dustlift.o ; $(RM) dustlift.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(eofdump.o) : $(LIBF)/phymars/eofdump.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/eofdump.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/eofdump.F ; \
+	$(AR) r $(LIBO)/libphymars.a eofdump.o ; $(RM) eofdump.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(flusv.o) : $(LIBF)/phymars/flusv.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/flusv.F ; \
+	$(AR) r $(LIBO)/libphymars.a flusv.o ; $(RM) flusv.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(growthrate.o) : $(LIBF)/phymars/growthrate.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/growthrate.F ; \
+	$(AR) r $(LIBO)/libphymars.a growthrate.o ; $(RM) growthrate.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(gwprofil.o) : $(LIBF)/phymars/gwprofil.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/gwprofil.F ; \
+	$(AR) r $(LIBO)/libphymars.a gwprofil.o ; $(RM) gwprofil.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(gwstress.o) : $(LIBF)/phymars/gwstress.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/gwstress.F ; \
+	$(AR) r $(LIBO)/libphymars.a gwstress.o ; $(RM) gwstress.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(ineofdump.o) : $(LIBF)/phymars/ineofdump.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/eofdump.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/ineofdump.F ; \
+	$(AR) r $(LIBO)/libphymars.a ineofdump.o ; $(RM) ineofdump.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(iniorbit.o) : $(LIBF)/phymars/iniorbit.F \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/iniorbit.F ; \
+	$(AR) r $(LIBO)/libphymars.a iniorbit.o ; $(RM) iniorbit.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(inistats.o) : $(LIBF)/phymars/inistats.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/phymars/statto.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/inistats.F ; \
+	$(AR) r $(LIBO)/libphymars.a inistats.o ; $(RM) inistats.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(initracer.o) : $(LIBF)/phymars/initracer.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/watercap.h \
+$(LIBF)/phymars/aerice.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/aeronomars/chimiedata.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/initracer.F ; \
+	$(AR) r $(LIBO)/libphymars.a initracer.o ; $(RM) initracer.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(ismax.o) : $(LIBF)/phymars/ismax.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/ismax.F ; \
+	$(AR) r $(LIBO)/libphymars.a ismax.o ; $(RM) ismax.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(ismin.o) : $(LIBF)/phymars/ismin.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/ismin.F ; \
+	$(AR) r $(LIBO)/libphymars.a ismin.o ; $(RM) ismin.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwb.o) : $(LIBF)/phymars/lwb.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwb.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwb.o ; $(RM) lwb.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwdiff.o) : $(LIBF)/phymars/lwdiff.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwdiff.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwdiff.o ; $(RM) lwdiff.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwflux.o) : $(LIBF)/phymars/lwflux.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwflux.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwflux.o ; $(RM) lwflux.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwi.o) : $(LIBF)/phymars/lwi.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwi.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwi.o ; $(RM) lwi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwmain.o) : $(LIBF)/phymars/lwmain.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwmain.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwmain.o ; $(RM) lwmain.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwtt.o) : $(LIBF)/phymars/lwtt.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwtt.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwtt.o ; $(RM) lwtt.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwu.o) : $(LIBF)/phymars/lwu.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/aerice.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwu.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwu.o ; $(RM) lwu.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwxb.o) : $(LIBF)/phymars/lwxb.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwxb.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwxb.o ; $(RM) lwxb.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwxd.o) : $(LIBF)/phymars/lwxd.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwxd.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwxd.o ; $(RM) lwxd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwxn.o) : $(LIBF)/phymars/lwxn.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwxn.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwxn.o ; $(RM) lwxn.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(meso_dustopacity.o) : $(LIBF)/phymars/meso_dustopacity.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/planete.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/meso_dustopacity.F ; \
+	$(AR) r $(LIBO)/libphymars.a meso_dustopacity.o ; $(RM) meso_dustopacity.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(meso_inifis.o) : $(LIBF)/phymars/meso_inifis.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comsaison.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/surfdat.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/meso_inifis.F ; \
+	$(AR) r $(LIBO)/libphymars.a meso_inifis.o ; $(RM) meso_inifis.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(meso_physiq.o) : $(LIBF)/phymars/meso_physiq.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comsaison.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/nlteparams.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/watercap.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/meso_physiq.F ; \
+	$(AR) r $(LIBO)/libphymars.a meso_physiq.o ; $(RM) meso_physiq.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(meso_writediagfi.o) : $(LIBF)/phymars/meso_writediagfi.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/description.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/phymars/surfdat.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/meso_writediagfi.F ; \
+	$(AR) r $(LIBO)/libphymars.a meso_writediagfi.o ; $(RM) meso_writediagfi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(mucorr.o) : $(LIBF)/phymars/mucorr.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/mucorr.F ; \
+	$(AR) r $(LIBO)/libphymars.a mucorr.o ; $(RM) mucorr.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(mufract.o) : $(LIBF)/phymars/mufract.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/mufract.F ; \
+	$(AR) r $(LIBO)/libphymars.a mufract.o ; $(RM) mufract.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(multipl.o) : $(LIBF)/phymars/multipl.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/multipl.F ; \
+	$(AR) r $(LIBO)/libphymars.a multipl.o ; $(RM) multipl.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(newcondens.o) : $(LIBF)/phymars/newcondens.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/grid/dimensions.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/newcondens.F ; \
+	$(AR) r $(LIBO)/libphymars.a newcondens.o ; $(RM) newcondens.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(newsedim.o) : $(LIBF)/phymars/newsedim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/newsedim.F ; \
+	$(AR) r $(LIBO)/libphymars.a newsedim.o ; $(RM) newsedim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(nirco2abs.o) : $(LIBF)/phymars/nirco2abs.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/nirco2abs.F ; \
+	$(AR) r $(LIBO)/libphymars.a nirco2abs.o ; $(RM) nirco2abs.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(nltecool.o) : $(LIBF)/phymars/nltecool.F \
+$(LIBF)/phymars/nltedata.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/nltecool.F ; \
+	$(AR) r $(LIBO)/libphymars.a nltecool.o ; $(RM) nltecool.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(nlthermeq.o) : $(LIBF)/phymars/nlthermeq.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/nlteparams.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/nlthermeq.F ; \
+	$(AR) r $(LIBO)/libphymars.a nlthermeq.o ; $(RM) nlthermeq.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(orbite.o) : $(LIBF)/phymars/orbite.F \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/orbite.F ; \
+	$(AR) r $(LIBO)/libphymars.a orbite.o ; $(RM) orbite.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(orodrag.o) : $(LIBF)/phymars/orodrag.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/orodrag.F ; \
+	$(AR) r $(LIBO)/libphymars.a orodrag.o ; $(RM) orodrag.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(orosetup.o) : $(LIBF)/phymars/orosetup.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/orosetup.F ; \
+	$(AR) r $(LIBO)/libphymars.a orosetup.o ; $(RM) orosetup.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(phyetat0.o) : $(LIBF)/phymars/phyetat0.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/phyetat0.F ; \
+	$(AR) r $(LIBO)/libphymars.a phyetat0.o ; $(RM) phyetat0.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(physdem1.o) : $(LIBF)/phymars/physdem1.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom2.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/dyn3d/comdissnew.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/dyn3d/serre.h \
+$(LIBF)/dyn3d/clesph0.h \
+$(LIBF)/grid/fxyprim.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/physdem1.F ; \
+	$(AR) r $(LIBO)/libphymars.a physdem1.o ; $(RM) physdem1.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(profile.o) : $(LIBF)/phymars/profile.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/profile.F ; \
+	$(AR) r $(LIBO)/libphymars.a profile.o ; $(RM) profile.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(scatter.o) : $(LIBF)/phymars/scatter.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/scatter.F ; \
+	$(AR) r $(LIBO)/libphymars.a scatter.o ; $(RM) scatter.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(scopyi.o) : $(LIBF)/phymars/scopyi.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/scopyi.F ; \
+	$(AR) r $(LIBO)/libphymars.a scopyi.o ; $(RM) scopyi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(soil.o) : $(LIBF)/phymars/soil.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/soil.F ; \
+	$(AR) r $(LIBO)/libphymars.a soil.o ; $(RM) soil.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(solang.o) : $(LIBF)/phymars/solang.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/solang.F ; \
+	$(AR) r $(LIBO)/libphymars.a solang.o ; $(RM) solang.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(solarlong.o) : $(LIBF)/phymars/solarlong.F \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/solarlong.F ; \
+	$(AR) r $(LIBO)/libphymars.a solarlong.o ; $(RM) solarlong.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(suaer.o) : $(LIBF)/phymars/suaer.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/aerdust.h \
+$(LIBF)/phymars/aerice.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/suaer.F ; \
+	$(AR) r $(LIBO)/libphymars.a suaer.o ; $(RM) suaer.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(sugwd.o) : $(LIBF)/phymars/sugwd.F \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/sugwd.F ; \
+	$(AR) r $(LIBO)/libphymars.a sugwd.o ; $(RM) sugwd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(sulw.o) : $(LIBF)/phymars/sulw.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/sulw.F ; \
+	$(AR) r $(LIBO)/libphymars.a sulw.o ; $(RM) sulw.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(surfini.o) : $(LIBF)/phymars/surfini.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/surfini.F ; \
+	$(AR) r $(LIBO)/libphymars.a surfini.o ; $(RM) surfini.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(swmain.o) : $(LIBF)/phymars/swmain.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/swmain.F ; \
+	$(AR) r $(LIBO)/libphymars.a swmain.o ; $(RM) swmain.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(swrayleigh.o) : $(LIBF)/phymars/swrayleigh.F \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/swrayleigh.F ; \
+	$(AR) r $(LIBO)/libphymars.a swrayleigh.o ; $(RM) swrayleigh.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(swr.o) : $(LIBF)/phymars/swr.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/phymars/aerice.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/swr.F ; \
+	$(AR) r $(LIBO)/libphymars.a swr.o ; $(RM) swr.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(tabfi.o) : $(LIBF)/phymars/tabfi.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/tabfi.F ; \
+	$(AR) r $(LIBO)/libphymars.a tabfi.o ; $(RM) tabfi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(uniplot.o) : $(LIBF)/phymars/uniplot.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/uniplot.F ; \
+	$(AR) r $(LIBO)/libphymars.a uniplot.o ; $(RM) uniplot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(vdif_cd.o) : $(LIBF)/phymars/vdif_cd.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/vdif_cd.F ; \
+	$(AR) r $(LIBO)/libphymars.a vdif_cd.o ; $(RM) vdif_cd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(vdifc.o) : $(LIBF)/phymars/vdifc.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/watercap.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/vdifc.F ; \
+	$(AR) r $(LIBO)/libphymars.a vdifc.o ; $(RM) vdifc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(vdif_kc.o) : $(LIBF)/phymars/vdif_kc.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/vdif_kc.F ; \
+	$(AR) r $(LIBO)/libphymars.a vdif_kc.o ; $(RM) vdif_kc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(vlz_fi.o) : $(LIBF)/phymars/vlz_fi.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/vlz_fi.F ; \
+	$(AR) r $(LIBO)/libphymars.a vlz_fi.o ; $(RM) vlz_fi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(watercloud.o) : $(LIBF)/phymars/watercloud.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/phymars/comgeomfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/watercloud.F ; \
+	$(AR) r $(LIBO)/libphymars.a watercloud.o ; $(RM) watercloud.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(watersat.o) : $(LIBF)/phymars/watersat.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/watersat.F ; \
+	$(AR) r $(LIBO)/libphymars.a watersat.o ; $(RM) watersat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(writeg1d.o) : $(LIBF)/phymars/writeg1d.F \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/writeg1d.F ; \
+	$(AR) r $(LIBO)/libphymars.a writeg1d.o ; $(RM) writeg1d.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(zerophys.o) : $(LIBF)/phymars/zerophys.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/zerophys.F ; \
+	$(AR) r $(LIBO)/libphymars.a zerophys.o ; $(RM) zerophys.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(def_var.o) : $(LIBF)/phymars/def_var.F90
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/def_var.F90 ; \
+	$(AR) r $(LIBO)/libphymars.a def_var.o ; $(RM) def_var.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(meso_readtesassim.o) : $(LIBF)/phymars/meso_readtesassim.F90
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/meso_readtesassim.F90 ; \
+	$(AR) r $(LIBO)/libphymars.a meso_readtesassim.o ; $(RM) meso_readtesassim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(mkstat.o) : $(LIBF)/phymars/mkstat.F90
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/mkstat.F90 ; \
+	$(AR) r $(LIBO)/libphymars.a mkstat.o ; $(RM) mkstat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(readtesassim.o) : $(LIBF)/phymars/readtesassim.F90
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/readtesassim.F90 ; \
+	$(AR) r $(LIBO)/libphymars.a readtesassim.o ; $(RM) readtesassim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(wstats.o) : $(LIBF)/phymars/wstats.F90
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/wstats.F90 ; \
+	$(AR) r $(LIBO)/libphymars.a wstats.o ; $(RM) wstats.o ; \
+	cd $(GCM)
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/makefile_init
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/makefile_init	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/makefile_init	(revision 2744)
@@ -0,0 +1,3136 @@
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Definitions de Macros pour Make
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+# Repertoires :
+
+GCM     = /u/forget/d2/LMDZ.MARS
+MACHINE = sun4
+LIBF    = $(GCM)/libf
+LIBO    = $(LIBOGCM)/$(MACHINE)
+LOCAL_DIR=/donnees/forget/run_baratoux
+BIBIO    = $(LIBF)/bibio
+AERONOMARS    = $(LIBF)/aeronomars
+FILTRE   = filtre
+PHYS  = 
+DYN  = dyn 
+LIBPHY = $(LIBO)/libphy$(PHYS).a
+DIRMAIN=dyn$(DIM)d
+RM=rm
+
+OPLINK = 
+
+# Les differentes librairies pour l"edition des liens:
+
+dyn3d      = $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a
+dyn2d      = $(LIBO)/libdyn2d.a
+dyn1d      = $(LIBO)/libdyn1d.a
+L_DYN      = -ldyn$(DIM)d
+L_FILTRE   = -l$(FILTRE)
+L_PHY = -lphy$(PHYS) 
+L_BIBIO    = -lbibio
+L_AERONOMARS    = -laeronomars
+L_ADJNT    =
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Option de compilation FORTRAN
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+COMPILE90 = $(F90) $(OPTIM90) $(INCLUDE) -c
+LINK    = 
+AR      = 
+
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Creation des differents executables
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+# Executables:
+# ------------
+
+PROG = code
+
+main : $(DYN) bibio phys aeronomars $(OPTION_DEP) 
+	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(PROG).F -o $(PROG).o ; \
+	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o 
+
+dyn : $(LIBO)/libdyn$(DIM)d.a $(FILTRE)$(DIM)d
+
+phys : $(LIBPHY)
+
+bibio : $(LIBO)/libbibio.a
+
+aeronomars : $(LIBO)/libaeronomars.a
+
+adjnt : $(LIBO)/libadjnt.a
+
+$(FILTRE)3d : $(LIBO)/lib$(FILTRE).a
+
+$(FILTRE)2d :
+
+$(FILTRE)1d :
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Contenu des differentes bibliotheques
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+
+
+#=======================================================================
+# Contenu de la bibliotheque correspondant au Directory aeronomars
+#=======================================================================
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(calchim.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(ch.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(chemthermos.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(column.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(concentrations.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(conduction.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(dtridgl.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(euvheat.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(flujo.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(getch.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(hrtherm.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inichim.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inichim_newstart.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inichim_readcallphys.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(init_chimie_B.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(interpfast.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(intrplf.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inv.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(jthermcalc.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(moldiff.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(moldiffcoeff.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(molvis.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(param_read.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(paramfoto.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(perosat.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(phdisrate.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(photochemist_B.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(thermosphere.o)
+
+.PRECIOUS	: $(LIBO)/libaeronomars.a
+
+
+# Compilation des membres de la bibliotheque libaeronomars.a
+
+$(LIBO)/libaeronomars.a(calchim.o) : $(LIBF)/aeronomars/calchim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/calchim.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a calchim.o ; $(RM) calchim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(ch.o) : $(LIBF)/aeronomars/ch.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/ch.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a ch.o ; $(RM) ch.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(chemthermos.o) : $(LIBF)/aeronomars/chemthermos.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/chemthermos.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a chemthermos.o ; $(RM) chemthermos.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(column.o) : $(LIBF)/aeronomars/column.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/column.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a column.o ; $(RM) column.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(concentrations.o) : $(LIBF)/aeronomars/concentrations.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/concentrations.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a concentrations.o ; $(RM) concentrations.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(conduction.o) : $(LIBF)/aeronomars/conduction.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/conduction.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a conduction.o ; $(RM) conduction.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(dtridgl.o) : $(LIBF)/aeronomars/dtridgl.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/dtridgl.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a dtridgl.o ; $(RM) dtridgl.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(euvheat.o) : $(LIBF)/aeronomars/euvheat.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/euvheat.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a euvheat.o ; $(RM) euvheat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(flujo.o) : $(LIBF)/aeronomars/flujo.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/flujo.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a flujo.o ; $(RM) flujo.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(getch.o) : $(LIBF)/aeronomars/getch.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/getch.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a getch.o ; $(RM) getch.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(hrtherm.o) : $(LIBF)/aeronomars/hrtherm.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/hrtherm.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a hrtherm.o ; $(RM) hrtherm.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(inichim.o) : $(LIBF)/aeronomars/inichim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/datafile.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/inichim.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a inichim.o ; $(RM) inichim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(inichim_newstart.o) : $(LIBF)/aeronomars/inichim_newstart.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/phymars/datafile.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/inichim_newstart.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a inichim_newstart.o ; $(RM) inichim_newstart.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(inichim_readcallphys.o) : $(LIBF)/aeronomars/inichim_readcallphys.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comsaison.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/surfdat.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/inichim_readcallphys.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a inichim_readcallphys.o ; $(RM) inichim_readcallphys.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(init_chimie_B.o) : $(LIBF)/aeronomars/init_chimie_B.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/datafile.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/init_chimie_B.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a init_chimie_B.o ; $(RM) init_chimie_B.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(interpfast.o) : $(LIBF)/aeronomars/interpfast.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/interpfast.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a interpfast.o ; $(RM) interpfast.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(intrplf.o) : $(LIBF)/aeronomars/intrplf.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/intrplf.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a intrplf.o ; $(RM) intrplf.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(inv.o) : $(LIBF)/aeronomars/inv.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/inv.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a inv.o ; $(RM) inv.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(jthermcalc.o) : $(LIBF)/aeronomars/jthermcalc.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/jthermcalc.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a jthermcalc.o ; $(RM) jthermcalc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(moldiff.o) : $(LIBF)/aeronomars/moldiff.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/moldiff.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a moldiff.o ; $(RM) moldiff.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(moldiffcoeff.o) : $(LIBF)/aeronomars/moldiffcoeff.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/moldiffcoeff.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a moldiffcoeff.o ; $(RM) moldiffcoeff.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(molvis.o) : $(LIBF)/aeronomars/molvis.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/molvis.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a molvis.o ; $(RM) molvis.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(param_read.o) : $(LIBF)/aeronomars/param_read.F \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/phymars/datafile.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/param_read.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a param_read.o ; $(RM) param_read.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(paramfoto.o) : $(LIBF)/aeronomars/paramfoto.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/paramfoto.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a paramfoto.o ; $(RM) paramfoto.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(perosat.o) : $(LIBF)/aeronomars/perosat.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/perosat.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a perosat.o ; $(RM) perosat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(phdisrate.o) : $(LIBF)/aeronomars/phdisrate.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/phdisrate.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a phdisrate.o ; $(RM) phdisrate.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(photochemist_B.o) : $(LIBF)/aeronomars/photochemist_B.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/photochemist_B.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a photochemist_B.o ; $(RM) photochemist_B.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(thermosphere.o) : $(LIBF)/aeronomars/thermosphere.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/thermosphere.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a thermosphere.o ; $(RM) thermosphere.o ; \
+	cd $(GCM)
+
+
+
+
+
+#=======================================================================
+# Contenu de la bibliotheque correspondant au Directory bibio
+#=======================================================================
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(cbrt.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(cvmgp.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(cvmgt.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(from36.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(gather.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ilsum.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ini36.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(isamax.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(isitor.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ismax.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ismin.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(lnblnk.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(mxm.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(mxv.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(mxva.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(mywrite.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(readcoord.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(readstd.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(scatter.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(scopy.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(scopyi.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(sdot.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(ssum.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(to36.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(uniplot.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(wheneq.o)
+
+$(LIBO)/libbibio.a :  $(LIBO)/libbibio.a(writestd.o)
+
+.PRECIOUS	: $(LIBO)/libbibio.a
+
+
+# Compilation des membres de la bibliotheque libbibio.a
+
+$(LIBO)/libbibio.a(cbrt.o) : $(LIBF)/bibio/cbrt.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/cbrt.F ; \
+	$(AR) r $(LIBO)/libbibio.a cbrt.o ; $(RM) cbrt.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(cvmgp.o) : $(LIBF)/bibio/cvmgp.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/cvmgp.F ; \
+	$(AR) r $(LIBO)/libbibio.a cvmgp.o ; $(RM) cvmgp.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(cvmgt.o) : $(LIBF)/bibio/cvmgt.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/cvmgt.F ; \
+	$(AR) r $(LIBO)/libbibio.a cvmgt.o ; $(RM) cvmgt.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(from36.o) : $(LIBF)/bibio/from36.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/from36.F ; \
+	$(AR) r $(LIBO)/libbibio.a from36.o ; $(RM) from36.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(gather.o) : $(LIBF)/bibio/gather.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/gather.F ; \
+	$(AR) r $(LIBO)/libbibio.a gather.o ; $(RM) gather.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ilsum.o) : $(LIBF)/bibio/ilsum.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ilsum.F ; \
+	$(AR) r $(LIBO)/libbibio.a ilsum.o ; $(RM) ilsum.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ini36.o) : $(LIBF)/bibio/ini36.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ini36.F ; \
+	$(AR) r $(LIBO)/libbibio.a ini36.o ; $(RM) ini36.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(isamax.o) : $(LIBF)/bibio/isamax.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/isamax.F ; \
+	$(AR) r $(LIBO)/libbibio.a isamax.o ; $(RM) isamax.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(isitor.o) : $(LIBF)/bibio/isitor.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/isitor.F ; \
+	$(AR) r $(LIBO)/libbibio.a isitor.o ; $(RM) isitor.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ismax.o) : $(LIBF)/bibio/ismax.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ismax.F ; \
+	$(AR) r $(LIBO)/libbibio.a ismax.o ; $(RM) ismax.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ismin.o) : $(LIBF)/bibio/ismin.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ismin.F ; \
+	$(AR) r $(LIBO)/libbibio.a ismin.o ; $(RM) ismin.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(lnblnk.o) : $(LIBF)/bibio/lnblnk.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/lnblnk.F ; \
+	$(AR) r $(LIBO)/libbibio.a lnblnk.o ; $(RM) lnblnk.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(mxm.o) : $(LIBF)/bibio/mxm.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/mxm.F ; \
+	$(AR) r $(LIBO)/libbibio.a mxm.o ; $(RM) mxm.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(mxv.o) : $(LIBF)/bibio/mxv.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/mxv.F ; \
+	$(AR) r $(LIBO)/libbibio.a mxv.o ; $(RM) mxv.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(mxva.o) : $(LIBF)/bibio/mxva.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/mxva.F ; \
+	$(AR) r $(LIBO)/libbibio.a mxva.o ; $(RM) mxva.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(mywrite.o) : $(LIBF)/bibio/mywrite.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/mywrite.F ; \
+	$(AR) r $(LIBO)/libbibio.a mywrite.o ; $(RM) mywrite.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(readcoord.o) : $(LIBF)/bibio/readcoord.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/readcoord.F ; \
+	$(AR) r $(LIBO)/libbibio.a readcoord.o ; $(RM) readcoord.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(readstd.o) : $(LIBF)/bibio/readstd.F \
+$(LIBF)/bibio/lmdstd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/readstd.F ; \
+	$(AR) r $(LIBO)/libbibio.a readstd.o ; $(RM) readstd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(scatter.o) : $(LIBF)/bibio/scatter.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/scatter.F ; \
+	$(AR) r $(LIBO)/libbibio.a scatter.o ; $(RM) scatter.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(scopy.o) : $(LIBF)/bibio/scopy.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/scopy.F ; \
+	$(AR) r $(LIBO)/libbibio.a scopy.o ; $(RM) scopy.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(scopyi.o) : $(LIBF)/bibio/scopyi.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/scopyi.F ; \
+	$(AR) r $(LIBO)/libbibio.a scopyi.o ; $(RM) scopyi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(sdot.o) : $(LIBF)/bibio/sdot.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/sdot.F ; \
+	$(AR) r $(LIBO)/libbibio.a sdot.o ; $(RM) sdot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(ssum.o) : $(LIBF)/bibio/ssum.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/ssum.F ; \
+	$(AR) r $(LIBO)/libbibio.a ssum.o ; $(RM) ssum.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(to36.o) : $(LIBF)/bibio/to36.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/to36.F ; \
+	$(AR) r $(LIBO)/libbibio.a to36.o ; $(RM) to36.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(uniplot.o) : $(LIBF)/bibio/uniplot.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/uniplot.F ; \
+	$(AR) r $(LIBO)/libbibio.a uniplot.o ; $(RM) uniplot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(wheneq.o) : $(LIBF)/bibio/wheneq.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/wheneq.F ; \
+	$(AR) r $(LIBO)/libbibio.a wheneq.o ; $(RM) wheneq.o ; \
+	cd $(GCM)
+
+$(LIBO)/libbibio.a(writestd.o) : $(LIBF)/bibio/writestd.F \
+$(LIBF)/bibio/lmdstd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/bibio/writestd.F ; \
+	$(AR) r $(LIBO)/libbibio.a writestd.o ; $(RM) writestd.o ; \
+	cd $(GCM)
+
+
+
+
+
+#=======================================================================
+# Contenu de la bibliotheque correspondant au Directory dyn3d
+#=======================================================================
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(abort_gcm.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(addfi.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(addit.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(adv_h2o.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(advect.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(amont.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(amont_qsat.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(bernoui.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(caldyn.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(caldyn0.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(calfis.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(coefpoly.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(convflu.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(convmas.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(coordij.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(covcont.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(covnat.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(defrun_new.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(diagadv.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(dissip.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(disvert.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(diverg.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(diverg_gam.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(divergf.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(divergst.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(divgrad.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(divgrad2.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(divgrad22.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(dteta1.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(dudv1.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(dudv2.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(dump2d.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(dynetat0.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(dynredem.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(enercin.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(exner.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(exner_hyb.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(flumass.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(fluxstoke.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(fxhyp.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(fxy.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(fxyhyper.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(fxysinus.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(fyhyp.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(geopot.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(gr_dyn_fi.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(gr_fi_dyn.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(gr_int_dyn.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(gr_u_scal.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(gr_v_scal.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(grad.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(gradiv.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(gradiv2.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(grid_atob.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(grid_noro.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(grid_noro1.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(groupe.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(groupeun.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(heavyside.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(ini_archive.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(iniav.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(iniconst.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(inidissip.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(inigeom.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(inigrads.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(iniinterp_h.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(initial0.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(iniwrite.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(integrd.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(interp_horiz.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(interp_vert.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(laplacien.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(laplacien_gam.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(laplacien_rot.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(laplacien_rotgam.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(lect_start_archive.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(lectflux.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(massbar.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(massbarxy.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(massdair.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(minmax.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(multipl.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(multscal.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(nxgrad.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(nxgrad_gam.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(nxgradst.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(nxgraro2.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(nxgrarot.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(pression.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(psextbar.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(ran1.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(readhead_NC.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(rotat.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(rotat_nfil.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(rotatf.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(rotatst.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(scal_wind.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(sortvarc.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(sortvarc0.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(spline.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(splint.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(sponge.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(test_period.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(tourpot.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(traceur.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(tracvl.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(vanleer.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(vitvert.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(vlsplt.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(vlspltqs.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(wind_scal.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(wrgrads.o)
+
+$(LIBO)/libdyn3d.a :  $(LIBO)/libdyn3d.a(write_archive.o)
+
+.PRECIOUS	: $(LIBO)/libdyn3d.a
+
+
+# Compilation des membres de la bibliotheque libdyn3d.a
+
+$(LIBO)/libdyn3d.a(abort_gcm.o) : $(LIBF)/dyn3d/abort_gcm.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/abort_gcm.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a abort_gcm.o ; $(RM) abort_gcm.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(addfi.o) : $(LIBF)/dyn3d/addfi.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/serre.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/addfi.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a addfi.o ; $(RM) addfi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(addit.o) : $(LIBF)/dyn3d/addit.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/addit.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a addit.o ; $(RM) addit.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(adv_h2o.o) : $(LIBF)/dyn3d/adv_h2o.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/adv_h2o.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a adv_h2o.o ; $(RM) adv_h2o.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(advect.o) : $(LIBF)/dyn3d/advect.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/ener.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/advect.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a advect.o ; $(RM) advect.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(amont.o) : $(LIBF)/dyn3d/amont.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/amont.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a amont.o ; $(RM) amont.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(amont_qsat.o) : $(LIBF)/dyn3d/amont_qsat.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/serre.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/amont_qsat.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a amont_qsat.o ; $(RM) amont_qsat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(bernoui.o) : $(LIBF)/dyn3d/bernoui.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/bernoui.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a bernoui.o ; $(RM) bernoui.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(caldyn.o) : $(LIBF)/dyn3d/caldyn.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/caldyn.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a caldyn.o ; $(RM) caldyn.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(caldyn0.o) : $(LIBF)/dyn3d/caldyn0.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/caldyn0.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a caldyn0.o ; $(RM) caldyn0.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(calfis.o) : $(LIBF)/dyn3d/calfis.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom2.h \
+$(LIBF)/dyn3d/control.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/calfis.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a calfis.o ; $(RM) calfis.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(coefpoly.o) : $(LIBF)/dyn3d/coefpoly.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/coefpoly.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a coefpoly.o ; $(RM) coefpoly.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(convflu.o) : $(LIBF)/dyn3d/convflu.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/convflu.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a convflu.o ; $(RM) convflu.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(convmas.o) : $(LIBF)/dyn3d/convmas.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/logic.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/convmas.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a convmas.o ; $(RM) convmas.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(coordij.o) : $(LIBF)/dyn3d/coordij.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/serre.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/coordij.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a coordij.o ; $(RM) coordij.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(covcont.o) : $(LIBF)/dyn3d/covcont.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/covcont.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a covcont.o ; $(RM) covcont.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(covnat.o) : $(LIBF)/dyn3d/covnat.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/covnat.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a covnat.o ; $(RM) covnat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(defrun_new.o) : $(LIBF)/dyn3d/defrun_new.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/serre.h \
+$(LIBF)/dyn3d/comdissnew.h \
+$(LIBF)/dyn3d/sponge.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/defrun_new.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a defrun_new.o ; $(RM) defrun_new.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(diagadv.o) : $(LIBF)/dyn3d/diagadv.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/diagadv.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a diagadv.o ; $(RM) diagadv.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(dissip.o) : $(LIBF)/dyn3d/dissip.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/comdissnew.h \
+$(LIBF)/dyn3d/comdissipn.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/dissip.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a dissip.o ; $(RM) dissip.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(disvert.o) : $(LIBF)/dyn3d/disvert.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/logic.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/disvert.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a disvert.o ; $(RM) disvert.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(diverg.o) : $(LIBF)/dyn3d/diverg.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/diverg.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a diverg.o ; $(RM) diverg.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(diverg_gam.o) : $(LIBF)/dyn3d/diverg_gam.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/diverg_gam.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a diverg_gam.o ; $(RM) diverg_gam.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(divergf.o) : $(LIBF)/dyn3d/divergf.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/divergf.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a divergf.o ; $(RM) divergf.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(divergst.o) : $(LIBF)/dyn3d/divergst.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/divergst.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a divergst.o ; $(RM) divergst.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(divgrad.o) : $(LIBF)/dyn3d/divgrad.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/comdissipn.h \
+$(LIBF)/dyn3d/logic.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/divgrad.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a divgrad.o ; $(RM) divgrad.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(divgrad2.o) : $(LIBF)/dyn3d/divgrad2.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom2.h \
+$(LIBF)/dyn3d/comdissipn.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/divgrad2.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a divgrad2.o ; $(RM) divgrad2.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(divgrad22.o) : $(LIBF)/dyn3d/divgrad22.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comdissipn.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/divgrad22.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a divgrad22.o ; $(RM) divgrad22.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(dteta1.o) : $(LIBF)/dyn3d/dteta1.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/dteta1.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a dteta1.o ; $(RM) dteta1.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(dudv1.o) : $(LIBF)/dyn3d/dudv1.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/dudv1.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a dudv1.o ; $(RM) dudv1.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(dudv2.o) : $(LIBF)/dyn3d/dudv2.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comvert.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/dudv2.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a dudv2.o ; $(RM) dudv2.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(dump2d.o) : $(LIBF)/dyn3d/dump2d.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/dump2d.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a dump2d.o ; $(RM) dump2d.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(dynetat0.o) : $(LIBF)/dyn3d/dynetat0.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/dyn3d/description.h \
+$(LIBF)/dyn3d/serre.h \
+$(LIBF)/dyn3d/logic.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/dynetat0.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a dynetat0.o ; $(RM) dynetat0.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(dynredem.o) : $(LIBF)/dyn3d/dynredem.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/dyn3d/description.h \
+$(LIBF)/dyn3d/serre.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/description.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/dynredem.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a dynredem.o ; $(RM) dynredem.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(enercin.o) : $(LIBF)/dyn3d/enercin.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/enercin.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a enercin.o ; $(RM) enercin.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(exner.o) : $(LIBF)/dyn3d/exner.F \
+$(LIBF)/dyn3d/comconst.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/exner.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a exner.o ; $(RM) exner.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(exner_hyb.o) : $(LIBF)/dyn3d/exner_hyb.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/serre.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/exner_hyb.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a exner_hyb.o ; $(RM) exner_hyb.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(flumass.o) : $(LIBF)/dyn3d/flumass.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/flumass.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a flumass.o ; $(RM) flumass.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(fluxstoke.o) : $(LIBF)/dyn3d/fluxstoke.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/tracstoke.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/fluxstoke.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a fluxstoke.o ; $(RM) fluxstoke.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(fxhyp.o) : $(LIBF)/dyn3d/fxhyp.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/fxhyp.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a fxhyp.o ; $(RM) fxhyp.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(fxy.o) : $(LIBF)/dyn3d/fxy.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/serre.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/grid/fxy_new.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/fxy.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a fxy.o ; $(RM) fxy.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(fxyhyper.o) : $(LIBF)/dyn3d/fxyhyper.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/fxyhyper.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a fxyhyper.o ; $(RM) fxyhyper.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(fxysinus.o) : $(LIBF)/dyn3d/fxysinus.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/grid/fxy_sin.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/fxysinus.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a fxysinus.o ; $(RM) fxysinus.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(fyhyp.o) : $(LIBF)/dyn3d/fyhyp.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/fyhyp.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a fyhyp.o ; $(RM) fyhyp.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(geopot.o) : $(LIBF)/dyn3d/geopot.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comvert.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/geopot.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a geopot.o ; $(RM) geopot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(gr_dyn_fi.o) : $(LIBF)/dyn3d/gr_dyn_fi.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/gr_dyn_fi.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a gr_dyn_fi.o ; $(RM) gr_dyn_fi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(gr_fi_dyn.o) : $(LIBF)/dyn3d/gr_fi_dyn.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/gr_fi_dyn.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a gr_fi_dyn.o ; $(RM) gr_fi_dyn.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(gr_int_dyn.o) : $(LIBF)/dyn3d/gr_int_dyn.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/gr_int_dyn.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a gr_int_dyn.o ; $(RM) gr_int_dyn.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(gr_u_scal.o) : $(LIBF)/dyn3d/gr_u_scal.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/gr_u_scal.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a gr_u_scal.o ; $(RM) gr_u_scal.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(gr_v_scal.o) : $(LIBF)/dyn3d/gr_v_scal.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/gr_v_scal.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a gr_v_scal.o ; $(RM) gr_v_scal.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(grad.o) : $(LIBF)/dyn3d/grad.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/grad.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a grad.o ; $(RM) grad.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(gradiv.o) : $(LIBF)/dyn3d/gradiv.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comdissipn.h \
+$(LIBF)/dyn3d/logic.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/gradiv.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a gradiv.o ; $(RM) gradiv.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(gradiv2.o) : $(LIBF)/dyn3d/gradiv2.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/comdissipn.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/gradiv2.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a gradiv2.o ; $(RM) gradiv2.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(grid_atob.o) : $(LIBF)/dyn3d/grid_atob.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/grid_atob.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a grid_atob.o ; $(RM) grid_atob.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(grid_noro.o) : $(LIBF)/dyn3d/grid_noro.F \
+$(LIBF)/grid/dimensions.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/grid_noro.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a grid_noro.o ; $(RM) grid_noro.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(grid_noro1.o) : $(LIBF)/dyn3d/grid_noro1.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/comconst.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/grid_noro1.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a grid_noro1.o ; $(RM) grid_noro1.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(groupe.o) : $(LIBF)/dyn3d/groupe.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom2.h \
+$(LIBF)/dyn3d/comvert.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/groupe.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a groupe.o ; $(RM) groupe.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(groupeun.o) : $(LIBF)/dyn3d/groupeun.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom2.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/groupeun.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a groupeun.o ; $(RM) groupeun.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(heavyside.o) : $(LIBF)/dyn3d/heavyside.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/heavyside.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a heavyside.o ; $(RM) heavyside.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(ini_archive.o) : $(LIBF)/dyn3d/ini_archive.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/description.h \
+$(LIBF)/dyn3d/serre.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/dyn3d/control.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/ini_archive.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a ini_archive.o ; $(RM) ini_archive.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(iniav.o) : $(LIBF)/dyn3d/iniav.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comav.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/iniav.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a iniav.o ; $(RM) iniav.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(iniconst.o) : $(LIBF)/dyn3d/iniconst.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/dyn3d/comvert.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/iniconst.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a iniconst.o ; $(RM) iniconst.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(inidissip.o) : $(LIBF)/dyn3d/inidissip.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comdissipn.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/control.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/inidissip.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a inidissip.o ; $(RM) inidissip.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(inigeom.o) : $(LIBF)/dyn3d/inigeom.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom2.h \
+$(LIBF)/dyn3d/serre.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comdissnew.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/inigeom.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a inigeom.o ; $(RM) inigeom.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(inigrads.o) : $(LIBF)/dyn3d/inigrads.F \
+$(LIBF)/dyn3d/gradsdef.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/inigrads.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a inigrads.o ; $(RM) inigrads.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(iniinterp_h.o) : $(LIBF)/dyn3d/iniinterp_h.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/iniinterp_h.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a iniinterp_h.o ; $(RM) iniinterp_h.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(initial0.o) : $(LIBF)/dyn3d/initial0.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/initial0.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a initial0.o ; $(RM) initial0.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(iniwrite.o) : $(LIBF)/dyn3d/iniwrite.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/dyn3d/description.h \
+$(LIBF)/dyn3d/serre.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/iniwrite.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a iniwrite.o ; $(RM) iniwrite.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(integrd.o) : $(LIBF)/dyn3d/integrd.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/dyn3d/serre.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/integrd.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a integrd.o ; $(RM) integrd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(interp_horiz.o) : $(LIBF)/dyn3d/interp_horiz.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/interp_horiz.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a interp_horiz.o ; $(RM) interp_horiz.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(interp_vert.o) : $(LIBF)/dyn3d/interp_vert.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/interp_vert.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a interp_vert.o ; $(RM) interp_vert.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(laplacien.o) : $(LIBF)/dyn3d/laplacien.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/laplacien.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a laplacien.o ; $(RM) laplacien.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(laplacien_gam.o) : $(LIBF)/dyn3d/laplacien_gam.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/laplacien_gam.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a laplacien_gam.o ; $(RM) laplacien_gam.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(laplacien_rot.o) : $(LIBF)/dyn3d/laplacien_rot.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/laplacien_rot.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a laplacien_rot.o ; $(RM) laplacien_rot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(laplacien_rotgam.o) : $(LIBF)/dyn3d/laplacien_rotgam.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/laplacien_rotgam.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a laplacien_rotgam.o ; $(RM) laplacien_rotgam.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(lect_start_archive.o) : $(LIBF)/dyn3d/lect_start_archive.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom2.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/description.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/bibio/lmdstd.h \
+$(LIBF)/dyn3d/netcdf.inc
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/lect_start_archive.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a lect_start_archive.o ; $(RM) lect_start_archive.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(lectflux.o) : $(LIBF)/dyn3d/lectflux.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom2.h \
+$(LIBF)/dyn3d/tracstoke.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/lectflux.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a lectflux.o ; $(RM) lectflux.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(massbar.o) : $(LIBF)/dyn3d/massbar.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/massbar.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a massbar.o ; $(RM) massbar.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(massbarxy.o) : $(LIBF)/dyn3d/massbarxy.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/massbarxy.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a massbarxy.o ; $(RM) massbarxy.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(massdair.o) : $(LIBF)/dyn3d/massdair.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/massdair.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a massdair.o ; $(RM) massdair.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(minmax.o) : $(LIBF)/dyn3d/minmax.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/minmax.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a minmax.o ; $(RM) minmax.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(multipl.o) : $(LIBF)/dyn3d/multipl.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/multipl.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a multipl.o ; $(RM) multipl.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(multscal.o) : $(LIBF)/dyn3d/multscal.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/multscal.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a multscal.o ; $(RM) multscal.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(nxgrad.o) : $(LIBF)/dyn3d/nxgrad.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/nxgrad.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a nxgrad.o ; $(RM) nxgrad.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(nxgrad_gam.o) : $(LIBF)/dyn3d/nxgrad_gam.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/nxgrad_gam.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a nxgrad_gam.o ; $(RM) nxgrad_gam.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(nxgradst.o) : $(LIBF)/dyn3d/nxgradst.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/nxgradst.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a nxgradst.o ; $(RM) nxgradst.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(nxgraro2.o) : $(LIBF)/dyn3d/nxgraro2.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comdissipn.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/nxgraro2.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a nxgraro2.o ; $(RM) nxgraro2.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(nxgrarot.o) : $(LIBF)/dyn3d/nxgrarot.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comdissipn.h \
+$(LIBF)/dyn3d/logic.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/nxgrarot.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a nxgrarot.o ; $(RM) nxgrarot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(pression.o) : $(LIBF)/dyn3d/pression.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/pression.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a pression.o ; $(RM) pression.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(psextbar.o) : $(LIBF)/dyn3d/psextbar.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/psextbar.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a psextbar.o ; $(RM) psextbar.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(ran1.o) : $(LIBF)/dyn3d/ran1.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/ran1.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a ran1.o ; $(RM) ran1.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(readhead_NC.o) : $(LIBF)/dyn3d/readhead_NC.F \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/dyn3d/description.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/readhead_NC.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a readhead_NC.o ; $(RM) readhead_NC.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(rotat.o) : $(LIBF)/dyn3d/rotat.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/rotat.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a rotat.o ; $(RM) rotat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(rotat_nfil.o) : $(LIBF)/dyn3d/rotat_nfil.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/rotat_nfil.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a rotat_nfil.o ; $(RM) rotat_nfil.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(rotatf.o) : $(LIBF)/dyn3d/rotatf.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/rotatf.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a rotatf.o ; $(RM) rotatf.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(rotatst.o) : $(LIBF)/dyn3d/rotatst.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/rotatst.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a rotatst.o ; $(RM) rotatst.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(scal_wind.o) : $(LIBF)/dyn3d/scal_wind.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/scal_wind.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a scal_wind.o ; $(RM) scal_wind.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(sortvarc.o) : $(LIBF)/dyn3d/sortvarc.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/temps.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/sortvarc.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a sortvarc.o ; $(RM) sortvarc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(sortvarc0.o) : $(LIBF)/dyn3d/sortvarc0.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/temps.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/sortvarc0.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a sortvarc0.o ; $(RM) sortvarc0.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(spline.o) : $(LIBF)/dyn3d/spline.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/spline.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a spline.o ; $(RM) spline.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(splint.o) : $(LIBF)/dyn3d/splint.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/splint.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a splint.o ; $(RM) splint.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(sponge.o) : $(LIBF)/dyn3d/sponge.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comdissip.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom2.h \
+$(LIBF)/dyn3d/sponge.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/sponge.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a sponge.o ; $(RM) sponge.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(test_period.o) : $(LIBF)/dyn3d/test_period.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/test_period.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a test_period.o ; $(RM) test_period.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(tourpot.o) : $(LIBF)/dyn3d/tourpot.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/logic.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/tourpot.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a tourpot.o ; $(RM) tourpot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(traceur.o) : $(LIBF)/dyn3d/traceur.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/traceur.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a traceur.o ; $(RM) traceur.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(tracvl.o) : $(LIBF)/dyn3d/tracvl.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/tracvl.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a tracvl.o ; $(RM) tracvl.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(vanleer.o) : $(LIBF)/dyn3d/vanleer.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comconst.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/vanleer.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a vanleer.o ; $(RM) vanleer.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(vitvert.o) : $(LIBF)/dyn3d/vitvert.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comvert.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/vitvert.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a vitvert.o ; $(RM) vitvert.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(vlsplt.o) : $(LIBF)/dyn3d/vlsplt.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/vlsplt.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a vlsplt.o ; $(RM) vlsplt.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(vlspltqs.o) : $(LIBF)/dyn3d/vlspltqs.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/vlspltqs.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a vlspltqs.o ; $(RM) vlspltqs.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(wind_scal.o) : $(LIBF)/dyn3d/wind_scal.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/wind_scal.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a wind_scal.o ; $(RM) wind_scal.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(wrgrads.o) : $(LIBF)/dyn3d/wrgrads.F \
+$(LIBF)/dyn3d/gradsdef.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/wrgrads.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a wrgrads.o ; $(RM) wrgrads.o ; \
+	cd $(GCM)
+
+$(LIBO)/libdyn3d.a(write_archive.o) : $(LIBF)/dyn3d/write_archive.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/description.h \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/dyn3d/netcdf.inc
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/dyn3d/write_archive.F ; \
+	$(AR) r $(LIBO)/libdyn3d.a write_archive.o ; $(RM) write_archive.o ; \
+	cd $(GCM)
+
+
+
+
+
+#=======================================================================
+# Contenu de la bibliotheque correspondant au Directory filtrez
+#=======================================================================
+
+$(LIBO)/libfiltrez.a :  $(LIBO)/libfiltrez.a(acc.o)
+
+$(LIBO)/libfiltrez.a :  $(LIBO)/libfiltrez.a(eigen.o)
+
+$(LIBO)/libfiltrez.a :  $(LIBO)/libfiltrez.a(eigen_sort.o)
+
+$(LIBO)/libfiltrez.a :  $(LIBO)/libfiltrez.a(filtreg.o)
+
+$(LIBO)/libfiltrez.a :  $(LIBO)/libfiltrez.a(inifgn.o)
+
+$(LIBO)/libfiltrez.a :  $(LIBO)/libfiltrez.a(inifilr.o)
+
+$(LIBO)/libfiltrez.a :  $(LIBO)/libfiltrez.a(jacobi.o)
+
+.PRECIOUS	: $(LIBO)/libfiltrez.a
+
+
+# Compilation des membres de la bibliotheque libfiltrez.a
+
+$(LIBO)/libfiltrez.a(acc.o) : $(LIBF)/filtrez/acc.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/filtrez/acc.F ; \
+	$(AR) r $(LIBO)/libfiltrez.a acc.o ; $(RM) acc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libfiltrez.a(eigen.o) : $(LIBF)/filtrez/eigen.F \
+$(LIBF)/grid/dimensions.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/filtrez/eigen.F ; \
+	$(AR) r $(LIBO)/libfiltrez.a eigen.o ; $(RM) eigen.o ; \
+	cd $(GCM)
+
+$(LIBO)/libfiltrez.a(eigen_sort.o) : $(LIBF)/filtrez/eigen_sort.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/filtrez/eigen_sort.F ; \
+	$(AR) r $(LIBO)/libfiltrez.a eigen_sort.o ; $(RM) eigen_sort.o ; \
+	cd $(GCM)
+
+$(LIBO)/libfiltrez.a(filtreg.o) : $(LIBF)/filtrez/filtreg.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/filtrez/parafilt.h \
+$(LIBF)/filtrez/coefils.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/filtrez/filtreg.F ; \
+	$(AR) r $(LIBO)/libfiltrez.a filtreg.o ; $(RM) filtreg.o ; \
+	cd $(GCM)
+
+$(LIBO)/libfiltrez.a(inifgn.o) : $(LIBF)/filtrez/inifgn.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/serre.h \
+$(LIBF)/filtrez/coefils.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/filtrez/inifgn.F ; \
+	$(AR) r $(LIBO)/libfiltrez.a inifgn.o ; $(RM) inifgn.o ; \
+	cd $(GCM)
+
+$(LIBO)/libfiltrez.a(inifilr.o) : $(LIBF)/filtrez/inifilr.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/filtrez/parafilt.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/filtrez/coefils.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/serre.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/filtrez/inifilr.F ; \
+	$(AR) r $(LIBO)/libfiltrez.a inifilr.o ; $(RM) inifilr.o ; \
+	cd $(GCM)
+
+$(LIBO)/libfiltrez.a(jacobi.o) : $(LIBF)/filtrez/jacobi.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/filtrez/jacobi.F ; \
+	$(AR) r $(LIBO)/libfiltrez.a jacobi.o ; $(RM) jacobi.o ; \
+	cd $(GCM)
+
+
+
+
+
+#=======================================================================
+# Contenu de la bibliotheque correspondant au Directory phymars
+#=======================================================================
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(aerave.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(blackl.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(blendrad.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(calldrag_noro.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(callradite.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(callsedim.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(callsedim2q.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(co2snow.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(convadj.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(cvmgp.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(cvmgt.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(datareadnc.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(dedd.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(drag_noro.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(dustdevil.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(dustlift.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(dustopacity.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(eofdump.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(flusv.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(growthrate.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(gwprofil.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(gwstress.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(ineofdump.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(inifis.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(iniorbit.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(inistats.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(initracer.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(ismax.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(ismin.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwb.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwdiff.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwflux.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwmain.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwtt.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwu.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwxb.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwxd.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(lwxn.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(mucorr.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(mufract.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(multipl.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(newcondens.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(newsedim.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(nirco2abs.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(nltecool.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(nlthermeq.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(orbite.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(orodrag.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(orosetup.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(phyetat0.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(physdem1.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(physiq.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(profile.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(scatter.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(scopyi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(soil.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(solang.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(solarlong.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(suaer.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(sugwd.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(sulw.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(surfini.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(swmain.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(swr.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(swrayleigh.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(tabfi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(uniplot.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(vdif_cd.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(vdif_kc.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(vdifc.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(vlz_fi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(watercloud.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(watersat.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(writediagfi.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(writeg1d.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(zerophys.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(def_var.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(mkstat.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(readtesassim.o)
+
+$(LIBO)/libphymars.a :  $(LIBO)/libphymars.a(wstats.o)
+
+.PRECIOUS	: $(LIBO)/libphymars.a
+
+
+# Compilation des membres de la bibliotheque libphymars.a
+
+$(LIBO)/libphymars.a(aerave.o) : $(LIBF)/phymars/aerave.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/aerave.F ; \
+	$(AR) r $(LIBO)/libphymars.a aerave.o ; $(RM) aerave.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(blackl.o) : $(LIBF)/phymars/blackl.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/blackl.F ; \
+	$(AR) r $(LIBO)/libphymars.a blackl.o ; $(RM) blackl.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(blendrad.o) : $(LIBF)/phymars/blendrad.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/nlteparams.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/blendrad.F ; \
+	$(AR) r $(LIBO)/libphymars.a blendrad.o ; $(RM) blendrad.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(calldrag_noro.o) : $(LIBF)/phymars/calldrag_noro.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/surfdat.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/calldrag_noro.F ; \
+	$(AR) r $(LIBO)/libphymars.a calldrag_noro.o ; $(RM) calldrag_noro.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(callradite.o) : $(LIBF)/phymars/callradite.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/callradite.F ; \
+	$(AR) r $(LIBO)/libphymars.a callradite.o ; $(RM) callradite.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(callsedim.o) : $(LIBF)/phymars/callsedim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/fisice.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/callsedim.F ; \
+	$(AR) r $(LIBO)/libphymars.a callsedim.o ; $(RM) callsedim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(callsedim2q.o) : $(LIBF)/phymars/callsedim2q.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/callsedim2q.F ; \
+	$(AR) r $(LIBO)/libphymars.a callsedim2q.o ; $(RM) callsedim2q.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(co2snow.o) : $(LIBF)/phymars/co2snow.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/co2snow.F ; \
+	$(AR) r $(LIBO)/libphymars.a co2snow.o ; $(RM) co2snow.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(convadj.o) : $(LIBF)/phymars/convadj.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/convadj.F ; \
+	$(AR) r $(LIBO)/libphymars.a convadj.o ; $(RM) convadj.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(cvmgp.o) : $(LIBF)/phymars/cvmgp.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/cvmgp.F ; \
+	$(AR) r $(LIBO)/libphymars.a cvmgp.o ; $(RM) cvmgp.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(cvmgt.o) : $(LIBF)/phymars/cvmgt.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/cvmgt.F ; \
+	$(AR) r $(LIBO)/libphymars.a cvmgt.o ; $(RM) cvmgt.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(datareadnc.o) : $(LIBF)/phymars/datareadnc.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/phymars/datafile.h \
+$(LIBF)/bibio/lmdstd.h \
+$(LIBF)/grid/fxyprim.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/datareadnc.F ; \
+	$(AR) r $(LIBO)/libphymars.a datareadnc.o ; $(RM) datareadnc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(dedd.o) : $(LIBF)/phymars/dedd.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/dedd.F ; \
+	$(AR) r $(LIBO)/libphymars.a dedd.o ; $(RM) dedd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(drag_noro.o) : $(LIBF)/phymars/drag_noro.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/drag_noro.F ; \
+	$(AR) r $(LIBO)/libphymars.a drag_noro.o ; $(RM) drag_noro.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(dustdevil.o) : $(LIBF)/phymars/dustdevil.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/dustdevil.F ; \
+	$(AR) r $(LIBO)/libphymars.a dustdevil.o ; $(RM) dustdevil.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(dustlift.o) : $(LIBF)/phymars/dustlift.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/dustlift.F ; \
+	$(AR) r $(LIBO)/libphymars.a dustlift.o ; $(RM) dustlift.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(dustopacity.o) : $(LIBF)/phymars/dustopacity.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/planete.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/dustopacity.F ; \
+	$(AR) r $(LIBO)/libphymars.a dustopacity.o ; $(RM) dustopacity.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(eofdump.o) : $(LIBF)/phymars/eofdump.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/eofdump.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/eofdump.F ; \
+	$(AR) r $(LIBO)/libphymars.a eofdump.o ; $(RM) eofdump.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(flusv.o) : $(LIBF)/phymars/flusv.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/flusv.F ; \
+	$(AR) r $(LIBO)/libphymars.a flusv.o ; $(RM) flusv.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(growthrate.o) : $(LIBF)/phymars/growthrate.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/growthrate.F ; \
+	$(AR) r $(LIBO)/libphymars.a growthrate.o ; $(RM) growthrate.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(gwprofil.o) : $(LIBF)/phymars/gwprofil.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/gwprofil.F ; \
+	$(AR) r $(LIBO)/libphymars.a gwprofil.o ; $(RM) gwprofil.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(gwstress.o) : $(LIBF)/phymars/gwstress.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/gwstress.F ; \
+	$(AR) r $(LIBO)/libphymars.a gwstress.o ; $(RM) gwstress.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(ineofdump.o) : $(LIBF)/phymars/ineofdump.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/eofdump.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/ineofdump.F ; \
+	$(AR) r $(LIBO)/libphymars.a ineofdump.o ; $(RM) ineofdump.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(inifis.o) : $(LIBF)/phymars/inifis.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comsaison.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/surfdat.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/inifis.F ; \
+	$(AR) r $(LIBO)/libphymars.a inifis.o ; $(RM) inifis.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(iniorbit.o) : $(LIBF)/phymars/iniorbit.F \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/iniorbit.F ; \
+	$(AR) r $(LIBO)/libphymars.a iniorbit.o ; $(RM) iniorbit.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(inistats.o) : $(LIBF)/phymars/inistats.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comconst.h \
+$(LIBF)/phymars/statto.h \
+$(LIBF)/dyn3d/netcdf.inc
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/inistats.F ; \
+	$(AR) r $(LIBO)/libphymars.a inistats.o ; $(RM) inistats.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(initracer.o) : $(LIBF)/phymars/initracer.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/watercap.h \
+$(LIBF)/phymars/aerice.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/aeronomars/chimiedata.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/initracer.F ; \
+	$(AR) r $(LIBO)/libphymars.a initracer.o ; $(RM) initracer.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(ismax.o) : $(LIBF)/phymars/ismax.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/ismax.F ; \
+	$(AR) r $(LIBO)/libphymars.a ismax.o ; $(RM) ismax.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(ismin.o) : $(LIBF)/phymars/ismin.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/ismin.F ; \
+	$(AR) r $(LIBO)/libphymars.a ismin.o ; $(RM) ismin.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwb.o) : $(LIBF)/phymars/lwb.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwb.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwb.o ; $(RM) lwb.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwdiff.o) : $(LIBF)/phymars/lwdiff.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwdiff.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwdiff.o ; $(RM) lwdiff.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwflux.o) : $(LIBF)/phymars/lwflux.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwflux.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwflux.o ; $(RM) lwflux.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwi.o) : $(LIBF)/phymars/lwi.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwi.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwi.o ; $(RM) lwi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwmain.o) : $(LIBF)/phymars/lwmain.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwmain.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwmain.o ; $(RM) lwmain.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwtt.o) : $(LIBF)/phymars/lwtt.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwtt.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwtt.o ; $(RM) lwtt.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwu.o) : $(LIBF)/phymars/lwu.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/aerice.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwu.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwu.o ; $(RM) lwu.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwxb.o) : $(LIBF)/phymars/lwxb.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwxb.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwxb.o ; $(RM) lwxb.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwxd.o) : $(LIBF)/phymars/lwxd.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwxd.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwxd.o ; $(RM) lwxd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(lwxn.o) : $(LIBF)/phymars/lwxn.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/lwxn.F ; \
+	$(AR) r $(LIBO)/libphymars.a lwxn.o ; $(RM) lwxn.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(mucorr.o) : $(LIBF)/phymars/mucorr.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/mucorr.F ; \
+	$(AR) r $(LIBO)/libphymars.a mucorr.o ; $(RM) mucorr.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(mufract.o) : $(LIBF)/phymars/mufract.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/mufract.F ; \
+	$(AR) r $(LIBO)/libphymars.a mufract.o ; $(RM) mufract.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(multipl.o) : $(LIBF)/phymars/multipl.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/multipl.F ; \
+	$(AR) r $(LIBO)/libphymars.a multipl.o ; $(RM) multipl.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(newcondens.o) : $(LIBF)/phymars/newcondens.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/grid/dimensions.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/newcondens.F ; \
+	$(AR) r $(LIBO)/libphymars.a newcondens.o ; $(RM) newcondens.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(newsedim.o) : $(LIBF)/phymars/newsedim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/newsedim.F ; \
+	$(AR) r $(LIBO)/libphymars.a newsedim.o ; $(RM) newsedim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(nirco2abs.o) : $(LIBF)/phymars/nirco2abs.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/nirco2abs.F ; \
+	$(AR) r $(LIBO)/libphymars.a nirco2abs.o ; $(RM) nirco2abs.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(nltecool.o) : $(LIBF)/phymars/nltecool.F \
+$(LIBF)/phymars/nltedata.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/nltecool.F ; \
+	$(AR) r $(LIBO)/libphymars.a nltecool.o ; $(RM) nltecool.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(nlthermeq.o) : $(LIBF)/phymars/nlthermeq.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/nlteparams.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/nlthermeq.F ; \
+	$(AR) r $(LIBO)/libphymars.a nlthermeq.o ; $(RM) nlthermeq.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(orbite.o) : $(LIBF)/phymars/orbite.F \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/orbite.F ; \
+	$(AR) r $(LIBO)/libphymars.a orbite.o ; $(RM) orbite.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(orodrag.o) : $(LIBF)/phymars/orodrag.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/orodrag.F ; \
+	$(AR) r $(LIBO)/libphymars.a orodrag.o ; $(RM) orodrag.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(orosetup.o) : $(LIBF)/phymars/orosetup.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/orosetup.F ; \
+	$(AR) r $(LIBO)/libphymars.a orosetup.o ; $(RM) orosetup.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(phyetat0.o) : $(LIBF)/phymars/phyetat0.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/phyetat0.F ; \
+	$(AR) r $(LIBO)/libphymars.a phyetat0.o ; $(RM) phyetat0.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(physdem1.o) : $(LIBF)/phymars/physdem1.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom2.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/dyn3d/comdissnew.h \
+$(LIBF)/dyn3d/logic.h \
+$(LIBF)/dyn3d/ener.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/dyn3d/serre.h \
+$(LIBF)/dyn3d/clesph0.h \
+$(LIBF)/grid/fxyprim.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/physdem1.F ; \
+	$(AR) r $(LIBO)/libphymars.a physdem1.o ; $(RM) physdem1.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(physiq.o) : $(LIBF)/phymars/physiq.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comsaison.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/nlteparams.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/watercap.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/conc.h \
+$(LIBF)/dyn3d/netcdf.inc
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/physiq.F ; \
+	$(AR) r $(LIBO)/libphymars.a physiq.o ; $(RM) physiq.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(profile.o) : $(LIBF)/phymars/profile.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/profile.F ; \
+	$(AR) r $(LIBO)/libphymars.a profile.o ; $(RM) profile.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(scatter.o) : $(LIBF)/phymars/scatter.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/scatter.F ; \
+	$(AR) r $(LIBO)/libphymars.a scatter.o ; $(RM) scatter.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(scopyi.o) : $(LIBF)/phymars/scopyi.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/scopyi.F ; \
+	$(AR) r $(LIBO)/libphymars.a scopyi.o ; $(RM) scopyi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(soil.o) : $(LIBF)/phymars/soil.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/soil.F ; \
+	$(AR) r $(LIBO)/libphymars.a soil.o ; $(RM) soil.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(solang.o) : $(LIBF)/phymars/solang.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/solang.F ; \
+	$(AR) r $(LIBO)/libphymars.a solang.o ; $(RM) solang.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(solarlong.o) : $(LIBF)/phymars/solarlong.F \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/solarlong.F ; \
+	$(AR) r $(LIBO)/libphymars.a solarlong.o ; $(RM) solarlong.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(suaer.o) : $(LIBF)/phymars/suaer.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/aerdust.h \
+$(LIBF)/phymars/aerice.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/suaer.F ; \
+	$(AR) r $(LIBO)/libphymars.a suaer.o ; $(RM) suaer.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(sugwd.o) : $(LIBF)/phymars/sugwd.F \
+$(LIBF)/phymars/yoegwd.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/sugwd.F ; \
+	$(AR) r $(LIBO)/libphymars.a sugwd.o ; $(RM) sugwd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(sulw.o) : $(LIBF)/phymars/sulw.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomlw.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/sulw.F ; \
+	$(AR) r $(LIBO)/libphymars.a sulw.o ; $(RM) sulw.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(surfini.o) : $(LIBF)/phymars/surfini.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/surfini.F ; \
+	$(AR) r $(LIBO)/libphymars.a surfini.o ; $(RM) surfini.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(swmain.o) : $(LIBF)/phymars/swmain.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/callkeys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/swmain.F ; \
+	$(AR) r $(LIBO)/libphymars.a swmain.o ; $(RM) swmain.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(swr.o) : $(LIBF)/phymars/swr.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/yomaer.h \
+$(LIBF)/phymars/yomlw.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/phymars/aerice.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/swr.F ; \
+	$(AR) r $(LIBO)/libphymars.a swr.o ; $(RM) swr.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(swrayleigh.o) : $(LIBF)/phymars/swrayleigh.F \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/swrayleigh.F ; \
+	$(AR) r $(LIBO)/libphymars.a swrayleigh.o ; $(RM) swrayleigh.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(tabfi.o) : $(LIBF)/phymars/tabfi.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/planete.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/phymars/dimradmars.h \
+$(LIBF)/phymars/yomaer.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/tabfi.F ; \
+	$(AR) r $(LIBO)/libphymars.a tabfi.o ; $(RM) tabfi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(uniplot.o) : $(LIBF)/phymars/uniplot.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/uniplot.F ; \
+	$(AR) r $(LIBO)/libphymars.a uniplot.o ; $(RM) uniplot.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(vdif_cd.o) : $(LIBF)/phymars/vdif_cd.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/vdif_cd.F ; \
+	$(AR) r $(LIBO)/libphymars.a vdif_cd.o ; $(RM) vdif_cd.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(vdif_kc.o) : $(LIBF)/phymars/vdif_kc.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/vdif_kc.F ; \
+	$(AR) r $(LIBO)/libphymars.a vdif_kc.o ; $(RM) vdif_kc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(vdifc.o) : $(LIBF)/phymars/vdifc.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/phymars/comgeomfi.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/watercap.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/vdifc.F ; \
+	$(AR) r $(LIBO)/libphymars.a vdifc.o ; $(RM) vdifc.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(vlz_fi.o) : $(LIBF)/phymars/vlz_fi.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/vlz_fi.F ; \
+	$(AR) r $(LIBO)/libphymars.a vlz_fi.o ; $(RM) vlz_fi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(watercloud.o) : $(LIBF)/phymars/watercloud.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/phymars/comgeomfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/watercloud.F ; \
+	$(AR) r $(LIBO)/libphymars.a watercloud.o ; $(RM) watercloud.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(watersat.o) : $(LIBF)/phymars/watersat.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/watersat.F ; \
+	$(AR) r $(LIBO)/libphymars.a watersat.o ; $(RM) watersat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(writediagfi.o) : $(LIBF)/phymars/writediagfi.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/dyn3d/paramet.h \
+$(LIBF)/dyn3d/control.h \
+$(LIBF)/dyn3d/comvert.h \
+$(LIBF)/dyn3d/comgeom.h \
+$(LIBF)/dyn3d/description.h \
+$(LIBF)/dyn3d/netcdf.inc \
+$(LIBF)/dyn3d/temps.h \
+$(LIBF)/phymars/surfdat.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/writediagfi.F ; \
+	$(AR) r $(LIBO)/libphymars.a writediagfi.o ; $(RM) writediagfi.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(writeg1d.o) : $(LIBF)/phymars/writeg1d.F \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/comg1d.h \
+$(LIBF)/phymars/comcstfi.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/writeg1d.F ; \
+	$(AR) r $(LIBO)/libphymars.a writeg1d.o ; $(RM) writeg1d.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(zerophys.o) : $(LIBF)/phymars/zerophys.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/zerophys.F ; \
+	$(AR) r $(LIBO)/libphymars.a zerophys.o ; $(RM) zerophys.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(def_var.o) : $(LIBF)/phymars/def_var.F90
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/def_var.F90 ; \
+	$(AR) r $(LIBO)/libphymars.a def_var.o ; $(RM) def_var.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(mkstat.o) : $(LIBF)/phymars/mkstat.F90
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/mkstat.F90 ; \
+	$(AR) r $(LIBO)/libphymars.a mkstat.o ; $(RM) mkstat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(readtesassim.o) : $(LIBF)/phymars/readtesassim.F90
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/readtesassim.F90 ; \
+	$(AR) r $(LIBO)/libphymars.a readtesassim.o ; $(RM) readtesassim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libphymars.a(wstats.o) : $(LIBF)/phymars/wstats.F90
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/phymars/wstats.F90 ; \
+	$(AR) r $(LIBO)/libphymars.a wstats.o ; $(RM) wstats.o ; \
+	cd $(GCM)
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_g95
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_g95	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_g95	(revision 2744)
@@ -0,0 +1,771 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+
+#--------------------------------------------------------
+#   set optim90=" -fast -I."
+#   set optimtru90=" -fast -c -Mfree "
+##   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+#   set mod_loc_dir=""
+#   set mod_suffix=mod
+#
+#-ffixed-form
+#   
+set optim=" -O2 -fno-second-underscore -fstatic -fzero" 
+#-ffree-line-length-huge"
+set optim90=" -O2 -fno-second-underscore -fstatic -fzero" 
+#-ffree-line-length-huge"
+set optimtru90=" -O2 -fno-second-underscore -fstatic -fzero" 
+#-ffree-line-length-huge"
+set opt_link=" -L$NCDFLIB -lnetcdf"
+set mod_loc_dir=""
+set mod_suffix=mod
+#--------------------------------------------------------
+   
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+#           set optim90="-g -Mbounds "
+##           set optim90="-mcmodel=medium"
+#-------------------------------------------------------------------
+          set optim="$optim"" -g -fbounds-check "
+          set optim90="$optim90"" -g -fbounds-check "
+          set optimtru90="$optimtru90"" -g -fbounds-check "
+#-------------------------------------------------------------------
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+echo  vous pouvez continuer en repondant oui.
+echo "Voulez-vous vraiment continuer?"
+if ( $< == "oui" ) then
+\rm $libf/grid/dimensions.h
+else
+exit
+endif
+endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=g95
+   set f90=g95
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+#----------------------------------------------
+# set optim90="$optim90 -module $libo"
+# set mod_loc_dir=$libo
+
+ set optimtru90=" $optimtru90 -fmod=$libo  "
+ set optim90=" $optim90 -fmod=$libo  "
+ set mod_loc_dir=$libo
+#----------------------------------------------
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_gnu
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_gnu	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_gnu	(revision 2744)
@@ -0,0 +1,774 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+
+#--------------------------------------------------------
+#   set optim90=" -fast -I."
+#   set optimtru90=" -fast -c -Mfree "
+##   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+#   set mod_loc_dir=""
+#   set mod_suffix=mod
+#
+#-ffixed-form
+#   
+##   set optim="-O3 -funroll-loops -fno-second-underscore"
+##   set optim90="-O3 -funroll-loops -fno-second-underscore"
+##   set optimtru90="-O3 -funroll-loops -fno-second-underscore"
+   set optim="-O2 -fno-second-underscore -pedantic -fbounds-check -g"
+   set optim90="-O2 -fno-second-underscore -pedantic -fbounds-check -g"
+   set optimtru90="-O2 -fno-second-underscore -pedantic -fbounds-check -g"
+
+#set optim=" -O2 -fno-second-underscore -fstatic -fzero" 
+
+set opt_link=" -L$NCDFLIB -lnetcdf"
+set mod_loc_dir=""
+set mod_suffix=mod
+#--------------------------------------------------------
+   
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+#           set optim90="-g -Mbounds "
+##           set optim90="-mcmodel=medium"
+#-------------------------------------------------------------------
+           ## for gfortran
+           set optim="-g -Wall -fcheck=all -fwhole-file"
+           set optim90="-g -Wall -fcheck=all -fwhole-file"
+           set optimtru90="-g -Wall -fcheck=all -fwhole-file"
+#-------------------------------------------------------------------
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+echo  vous pouvez continuer en repondant oui.
+echo "Voulez-vous vraiment continuer?"
+if ( $< == "oui" ) then
+\rm $libf/grid/dimensions.h
+else
+exit
+endif
+endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=gfortran
+   set f90=gfortran
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+#----------------------------------------------
+# Ehouarn : adapt to gfortran
+ set optim="$optim -I${libo}"
+ set optim90="$optim90 -I${libo}"
+ set optimtru90="$optimtru90 -ffree-form -I${libo}"
+ set mod_loc_dir=$libo
+#----------------------------------------------
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_ifort
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_ifort	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_ifort	(revision 2744)
@@ -0,0 +1,770 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+
+#--------------------------------------------------------
+#   set optim90=" -fast -I."
+#   set optimtru90=" -fast -c -Mfree "
+##   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+#   set mod_loc_dir=""
+#   set mod_suffix=mod
+#
+#-ffixed-form
+#   
+set optim=" -O2 -static -zero -align commons"
+#-ffree-line-length-huge"
+set optim90=" -O2 -static -zero -align commons"
+#-ffree-line-length-huge"
+set optimtru90=" -O2 -static -zero -align commons"
+#-ffree-line-length-huge"
+set opt_link=" -L$NCDFLIB -lnetcdf"
+set mod_loc_dir=""
+set mod_suffix=mod
+#--------------------------------------------------------
+   
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+#           set optim90="-g -Mbounds "
+##           set optim90="-mcmodel=medium"
+#-------------------------------------------------------------------
+          set optim="$optim"" -g -fbounds-check "
+          set optim90="$optim90"" -g -fbounds-check "
+          set optimtru90="$optimtru90"" -g -fbounds-check "
+#-------------------------------------------------------------------
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+echo  vous pouvez continuer en repondant oui.
+echo "Voulez-vous vraiment continuer?"
+if ( $< == "oui" ) then
+\rm $libf/grid/dimensions.h
+else
+exit
+endif
+endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=ifort
+   set f90=ifort
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+#----------------------------------------------
+ set optim90="$optim90 -module $libo"
+ set mod_loc_dir=$libo
+ #set optimtru90=" $optimtru90 -fmod=$libo  "
+ #set optim90=" $optim90 -fmod=$libo  "
+ #set mod_loc_dir=$libo
+#----------------------------------------------
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_mpi
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_mpi	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_mpi	(revision 2744)
@@ -0,0 +1,764 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?WHERE_MPI ) then
+    echo You must initialize the variable WHERE_MPI in your environnement
+    echo for instance: "setenv WHERE_MPI /home/install_mpi/bin" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+#   set optim90=" -fast -I. -Mlarge_arrays -mcmodel=medium" 
+### newmodif 01042009
+#   set optimtru90=" -fast -c -Mlarge_arrays -mcmodel=medium" 
+##   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+#   set opt_link=" -Mlarge_arrays -mcmodel=medium -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+   set optim90="-O2 -I. -Munroll -Mcache_align" # -Mbounds" 
+   set optimtru90="-O2 -I. -Munroll -Mcache_align" # -Mbounds" 
+   #set optim90=""#-Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed" #-fast -I."
+   #set optimtru90=""#-Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed"#-fast -I."
+   #set optim90="-O3 -I. -tp=nehalem-64 -fastsse -Mscalarsse -Mvect=sse -Mipa=fast"
+   #set optimtru90="-O3 -I. -tp=nehalem-64 -fastsse -Mscalarsse -Mvect=sse -Mipa=fast"
+   set opt_link=" -L$NCDFLIB -lnetcdf" # -Bstatic"
+   set mod_loc_dir=""
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds -Ktrap=fp"
+#           set optim90="-mcmodel=medium"
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#*********WRF
+#if ( -f dimensions.h ) then
+#echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+#echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#echo  vous pouvez continuer en repondant oui.
+#echo "Voulez-vous vraiment continuer?"
+#if ( $< == "oui" ) then
+#\rm $libf/grid/dimensions.h
+#else
+#exit
+#endif
+#endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+#*********WRF nest
+#a completer par la suite
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d5_dimensions.h
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=$WHERE_MPI/mpif90 #pgf90
+   set f90=$WHERE_MPI/mpif90 #pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_mpifort
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_mpifort	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_mpifort	(revision 2744)
@@ -0,0 +1,785 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?WHERE_MPI ) then
+    echo You must initialize the variable WHERE_MPI in your environnement
+    echo for instance: "setenv WHERE_MPI /home/install_mpi/bin" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+
+#--------------------------------------------------------
+#   set optim90=" -fast -I."
+#   set optimtru90=" -fast -c -Mfree "
+##   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+#   set mod_loc_dir=""
+#   set mod_suffix=mod
+#
+#-ffixed-form
+#   
+set optim=" -O2 -static -zero -align commons -mcmodel=large -shared-intel"
+#-ffree-line-length-huge"
+set optim90=" -O2 -static -zero -align commons -mcmodel=large -shared-intel"
+#-ffree-line-length-huge"
+set optimtru90=" -O2 -static -zero -align commons -mcmodel=large -shared-intel"
+#-ffree-line-length-huge"
+set opt_link=" -L$NCDFLIB -lnetcdf"
+set mod_loc_dir=""
+set mod_suffix=mod
+#--------------------------------------------------------
+   
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+#           set optim90="-g -Mbounds "
+##           set optim90="-mcmodel=medium"
+#-------------------------------------------------------------------
+          set optim="$optim"" -g -fbounds-check "
+          set optim90="$optim90"" -g -fbounds-check "
+          set optimtru90="$optimtru90"" -g -fbounds-check "
+#-------------------------------------------------------------------
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#*********WRF
+#if ( -f dimensions.h ) then
+#echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+#echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#echo  vous pouvez continuer en repondant oui.
+#echo "Voulez-vous vraiment continuer?"
+#if ( $< == "oui" ) then
+#\rm $libf/grid/dimensions.h
+#else
+#exit
+#endif
+#endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+#*********WRF nest
+#a completer par la suite
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d5_dimensions.h
+
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+#   set f77=mpif90
+#   set f90=mpif90
+   set f77=$WHERE_MPI/mpif90
+   set f90=$WHERE_MPI/mpif90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+#----------------------------------------------
+ set optim90="$optim90 -module $libo"
+ set mod_loc_dir=$libo
+ #set optimtru90=" $optimtru90 -fmod=$libo  "
+ #set optim90=" $optim90 -fmod=$libo  "
+ #set mod_loc_dir=$libo
+#----------------------------------------------
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_pgf
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_pgf	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/makegcm_pgf	(revision 2744)
@@ -0,0 +1,759 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+###-Ktrap=fp
+#   set optim90=" -fast -I. -Mlarge_arrays -mcmodel=medium" 
+### newmodif 01042009
+#   set optimtru90=" -fast -c -Mfree -Mlarge_arrays -mcmodel=medium" 
+##   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+#   set opt_link=" -Mlarge_arrays -mcmodel=medium -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+   set optim90=" -O2 -I. -Munroll -Mcache_align" 
+   set optimtru90=" -O2 -I. -Munroll -Mcache_align" 
+   #set optim90="-O3 -I. -tp=nehalem-64 -fastsse -Mscalarsse -Mvect=sse -Mipa=fast"
+   #set optimtru90="-O3 -I. -tp=nehalem-64 -fastsse -Mscalarsse -Mvect=sse -Mipa=fast"
+   set opt_link=" -L$NCDFLIB -lnetcdf -Bstatic"
+   set mod_loc_dir=""
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+#           set optim90="-mcmodel=medium"
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#*********WRF
+#if ( -f dimensions.h ) then
+#echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+#echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#echo  vous pouvez continuer en repondant oui.
+#echo "Voulez-vous vraiment continuer?"
+#if ( $< == "oui" ) then
+#\rm $libf/grid/dimensions.h
+#else
+#exit
+#endif
+#endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+#*********WRF nest
+#a completer par la suite
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=pgf90
+   set f90=pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/tmp
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/tmp	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/tmp	(revision 2744)
@@ -0,0 +1,264 @@
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Definitions de Macros pour Make
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+# Repertoires :
+
+GCM     = /donnees/aslmd/MODELES/WRFV3/mars_lmd
+MACHINE = sun4
+LIBF    = $(GCM)/libf
+LIBO    = $(LIBOGCM)/$(MACHINE)
+LOCAL_DIR=/donnees/aslmd/MODELES/WRFV3/mars_lmd
+BIBIO    = $(LIBF)/bibio
+AERONOMARS    = $(LIBF)/aeronomars
+FILTRE   = filtre
+PHYS  = 
+DYN  = dyn 
+LIBPHY = $(LIBO)/libphy$(PHYS).a
+DIRMAIN=dyn$(DIM)d
+RM=rm
+
+OPLINK = 
+
+# Les differentes librairies pour l"edition des liens:
+
+dyn3d      = $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a
+dyn2d      = $(LIBO)/libdyn2d.a
+dyn1d      = $(LIBO)/libdyn1d.a
+L_DYN      = -ldyn$(DIM)d
+L_FILTRE   = -l$(FILTRE)
+L_PHY = -lphy$(PHYS) 
+L_BIBIO    = -lbibio
+L_AERONOMARS    = -laeronomars
+L_ADJNT    =
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Option de compilation FORTRAN
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+COMPILE90 = $(F90) $(OPTIM90) $(INCLUDE) -c
+LINK    = 
+AR      = 
+
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Creation des differents executables
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+# Executables:
+# ------------
+
+PROG = code
+
+main : $(DYN) bibio phys aeronomars $(OPTION_DEP) 
+	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(PROG).F -o $(PROG).o ; \
+	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o 
+
+dyn : $(LIBO)/libdyn$(DIM)d.a $(FILTRE)$(DIM)d
+
+phys : $(LIBPHY)
+
+bibio : $(LIBO)/libbibio.a
+
+aeronomars : $(LIBO)/libaeronomars.a
+
+adjnt : $(LIBO)/libadjnt.a
+
+$(FILTRE)3d : $(LIBO)/lib$(FILTRE).a
+
+$(FILTRE)2d :
+
+$(FILTRE)1d :
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Contenu des differentes bibliotheques
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+
+
+#=======================================================================
+# Contenu de la bibliotheque correspondant au Directory aeronomars
+#=======================================================================
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(calchim.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(chemthermos.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(ch.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(column.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(concentrations.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(conduction.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(dtridgl.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(euvheat.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(flujo.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(getch.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(hrtherm.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inichim.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inichim_newstart.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inichim_readcallphys.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(init_chimie_B.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(interpfast.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(intrplf.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(inv.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(jthermcalc.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(moldiffcoeff.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(moldiff.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(molvis.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(paramfoto.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(param_read.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(perosat.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(phdisrate.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(photochemist_B.o)
+
+$(LIBO)/libaeronomars.a :  $(LIBO)/libaeronomars.a(thermosphere.o)
+
+.PRECIOUS	: $(LIBO)/libaeronomars.a
+
+
+# Compilation des membres de la bibliotheque libaeronomars.a
+
+$(LIBO)/libaeronomars.a(calchim.o) : $(LIBF)/aeronomars/calchim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/fisice.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/calchim.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a calchim.o ; $(RM) calchim.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(chemthermos.o) : $(LIBF)/aeronomars/chemthermos.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/chemthermos.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a chemthermos.o ; $(RM) chemthermos.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(ch.o) : $(LIBF)/aeronomars/ch.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/ch.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a ch.o ; $(RM) ch.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(column.o) : $(LIBF)/aeronomars/column.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/column.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a column.o ; $(RM) column.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(concentrations.o) : $(LIBF)/aeronomars/concentrations.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/concentrations.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a concentrations.o ; $(RM) concentrations.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(conduction.o) : $(LIBF)/aeronomars/conduction.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/surfdat.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/conduction.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a conduction.o ; $(RM) conduction.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(dtridgl.o) : $(LIBF)/aeronomars/dtridgl.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/dtridgl.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a dtridgl.o ; $(RM) dtridgl.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(euvheat.o) : $(LIBF)/aeronomars/euvheat.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/comdiurn.h \
+$(LIBF)/aeronomars/param.h \
+$(LIBF)/aeronomars/param_v3.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/aeronomars/conc.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/euvheat.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a euvheat.o ; $(RM) euvheat.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(flujo.o) : $(LIBF)/aeronomars/flujo.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/flujo.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a flujo.o ; $(RM) flujo.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(getch.o) : $(LIBF)/aeronomars/getch.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/getch.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a getch.o ; $(RM) getch.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(hrtherm.o) : $(LIBF)/aeronomars/hrtherm.F
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/hrtherm.F ; \
+	$(AR) r $(LIBO)/libaeronomars.a hrtherm.o ; $(RM) hrtherm.o ; \
+	cd $(GCM)
+
+$(LIBO)/libaeronomars.a(inichim.o) : $(LIBF)/aeronomars/inichim.F \
+$(LIBF)/grid/dimensions.h \
+$(LIBF)/phymars/dimphys.h \
+$(LIBF)/aeronomars/chimiedata.h \
+$(LIBF)/phymars/tracer.h \
+$(LIBF)/phymars/comcstfi.h \
+$(LIBF)/phymars/callkeys.h \
+$(LIBF)/phymars/datafile.h
+	cd $(LOCAL_DIR); \
+	$(COMPILE90) $(LIBF)/aeronomars/inichim.F ; \
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/tmp77
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/tmp77	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/tmp77	(revision 2744)
@@ -0,0 +1,350 @@
+libf/bibio/from36.F
+libf/bibio/ini36.F
+libf/bibio/cvmgp.F
+libf/bibio/cvmgt.F
+libf/bibio/isitor.F
+libf/bibio/lmdstd.h
+libf/bibio/lnblnk.F
+libf/bibio/mywrite.F
+libf/bibio/readcoord.F
+libf/bibio/readstd.F
+libf/bibio/to36.F
+libf/bibio/gather.F
+libf/bibio/writestd.F
+libf/bibio/ilsum.F
+libf/bibio/isamax.F
+libf/bibio/ismax.F
+libf/bibio/ismin.F
+libf/bibio/mxm.F
+libf/bibio/mxva.F
+libf/bibio/mxv.F
+libf/bibio/scatter.F
+libf/bibio/scopy.F
+libf/bibio/scopyi.F
+libf/bibio/sdot.F
+libf/bibio/ssum.F
+libf/bibio/uniplot.F
+libf/bibio/wheneq.F
+libf/bibio/cbrt.F
+libf/grid/fxy_new.h
+libf/grid/fxyprim.h
+libf/grid/fxy_reg.h
+libf/grid/fxy_sin.h
+libf/grid/d2_dimensions.h
+libf/grid/dimensions.h
+libf/phymars/aerave.F
+libf/phymars/aerdata.h
+libf/phymars/blendrad.F
+libf/phymars/calldrag_noro.F
+libf/phymars/callradite.F
+libf/phymars/callsedim.F
+libf/phymars/callsedim2q.F
+libf/phymars/aerdust.h
+libf/phymars/co2snow.F
+libf/phymars/comcstfi.h
+libf/phymars/comdiurn.h
+libf/phymars/comg1d.h
+libf/phymars/comgeomfi.h
+libf/phymars/watercloud.F
+libf/phymars/sugwd.F
+libf/phymars/comorbit.h
+libf/phymars/lwu.F
+libf/phymars/growthrate.F
+libf/phymars/tabfi.F
+libf/phymars/comsaison.h
+libf/phymars/phyetat0.F
+libf/phymars/convadj.F
+libf/phymars/cvmgp.F
+libf/phymars/cvmgt.F
+libf/phymars/datareadnc.F
+libf/phymars/dedd.F
+libf/phymars/dimradmars.h
+libf/phymars/drag_noro.F
+libf/phymars/dustdevil.F
+libf/phymars/dustlift.F
+libf/phymars/eofdump.F
+libf/phymars/eofdump.h
+libf/phymars/ineofdump.F
+libf/phymars/flusv.F
+libf/phymars/yomlw.h
+libf/phymars/gwprofil.F
+libf/phymars/gwstress.F
+libf/phymars/lwflux.F
+libf/phymars/lwmain.F
+libf/phymars/ismax.F
+libf/phymars/meso_testphys1d.F
+libf/phymars/iniorbit.F
+libf/phymars/vdifc.F
+libf/phymars/lwi.F
+libf/phymars/ismin.F
+libf/phymars/lwxb.F
+libf/phymars/lwb.F
+libf/phymars/lwdiff.F
+libf/phymars/lwxd.F
+libf/phymars/lwxn.F
+libf/phymars/lwtt.F
+libf/phymars/mucorr.F
+libf/phymars/mufract.F
+libf/phymars/newcondens.F
+libf/phymars/tracer.h
+libf/phymars/initracer.F
+libf/phymars/watercap.h
+libf/phymars/aerice.h
+libf/phymars/newsedim.F
+libf/phymars/nirco2abs.F
+libf/phymars/nltecool.F
+libf/phymars/nltedata.h
+libf/phymars/nlteparams.h
+libf/phymars/nlthermeq.F
+libf/phymars/orbite.F
+libf/phymars/orodrag.F
+libf/phymars/orosetup.F
+libf/phymars/fisice.h
+libf/phymars/physdem1.F
+libf/phymars/planete.h
+libf/phymars/profile.F
+libf/phymars/scatter.F
+libf/phymars/scopyi.F
+libf/phymars/soil.F
+libf/phymars/solang.F
+libf/phymars/solarlong.F
+libf/phymars/statto.h
+libf/phymars/suaer.F
+libf/phymars/sulw.F
+libf/phymars/blackl.F
+libf/phymars/vdif_cd.F
+libf/phymars/surfdat.h
+libf/phymars/surfini.F
+libf/phymars/swmain.F
+libf/phymars/swr.F
+libf/phymars/swrayleigh.F
+libf/phymars/uniplot.F
+libf/phymars/vdif_kc.F
+libf/phymars/vlz_fi.F
+libf/phymars/watersat.F
+libf/phymars/callkeys.h
+libf/phymars/writeg1d.F
+libf/phymars/yoegwd.h
+libf/phymars/yomaer.h
+libf/phymars/zerophys.F
+libf/phymars/inistats.F
+libf/phymars/multipl.F
+libf/phymars/datafile.h
+libf/phymars/meso_physiq.F
+libf/phymars/meso_writediagfi.F
+libf/phymars/meso_inifis.F
+libf/phymars/meso_dustopacity.F
+libf/phymars/slope.h
+libf/phymars/wrf_output_2d.h
+libf/phymars/wrf_output_3d.h
+libf/phymars/dimphys.h
+libf/aeronomars/calchim.F
+libf/aeronomars/chemthermos.F
+libf/aeronomars/ch.F
+libf/aeronomars/chimiedata.h
+libf/aeronomars/column.F
+libf/aeronomars/concentrations.F
+libf/aeronomars/conc.h
+libf/aeronomars/conduction.F
+libf/aeronomars/dtridgl.F
+libf/aeronomars/euvheat.F
+libf/aeronomars/flujo.F
+libf/aeronomars/getch.F
+libf/aeronomars/hrtherm.F
+libf/aeronomars/inichim.F
+libf/aeronomars/inichim_newstart.F
+libf/aeronomars/inichim_readcallphys.F
+libf/aeronomars/init_chimie_B.F
+libf/aeronomars/interpfast.F
+libf/aeronomars/intrplf.F
+libf/aeronomars/inv.F
+libf/aeronomars/jthermcalc.F
+libf/aeronomars/moldiffcoeff.F
+libf/aeronomars/moldiff.F
+libf/aeronomars/molvis.F
+libf/aeronomars/paramfoto.F
+libf/aeronomars/param.h
+libf/aeronomars/param_read.F
+libf/aeronomars/param_v3.h
+libf/aeronomars/perosat.F
+libf/aeronomars/phdisrate.F
+libf/aeronomars/photochemist_B.F
+libf/aeronomars/thermosphere.F
+libf/dyn3d/angtot.h
+libf/dyn3d/clesph0.h
+libf/dyn3d/comav.h
+libf/dyn3d/comconst.h
+libf/dyn3d/comdiss.h
+libf/dyn3d/comdissip.h
+libf/dyn3d/comdissipn.h
+libf/dyn3d/comdissnew.h
+libf/dyn3d/comgeom2.h
+libf/dyn3d/comgeom.h
+libf/dyn3d/comvert.h
+libf/dyn3d/control.h
+libf/dyn3d/description.h
+libf/dyn3d/ener.h
+libf/dyn3d/gradsdef.h
+libf/dyn3d/logic.h
+libf/dyn3d/paramet.h
+libf/dyn3d/para_netcdf.h
+libf/dyn3d/serre.h
+libf/dyn3d/sponge.h
+libf/dyn3d/temps.h
+libf/dyn3d/tracstoke.h
+libf/zz_not_used/filtrez/coefils.h
+libf/zz_not_used/filtrez/acc.F
+libf/zz_not_used/filtrez/eigen.F
+libf/zz_not_used/filtrez/eigen_sort.F
+libf/zz_not_used/filtrez/filtreg.F
+libf/zz_not_used/filtrez/inifgn.F
+libf/zz_not_used/filtrez/inifilr.F
+libf/zz_not_used/filtrez/jacobi.F
+libf/zz_not_used/filtrez/parafilt.h
+libf/zz_not_used/dyn3d/abort_gcm.F
+libf/zz_not_used/dyn3d/addfi.F
+libf/zz_not_used/dyn3d/addit.F
+libf/zz_not_used/dyn3d/adv_h2o.F
+libf/zz_not_used/dyn3d/advect.F
+libf/zz_not_used/dyn3d/amont.F
+libf/zz_not_used/dyn3d/amont_qsat.F
+libf/zz_not_used/dyn3d/angtot.h
+libf/zz_not_used/dyn3d/anldoppler2.F
+libf/zz_not_used/dyn3d/bernoui.F
+libf/zz_not_used/dyn3d/caldyn.F
+libf/zz_not_used/dyn3d/caldyn0.F
+libf/zz_not_used/dyn3d/calfis.F
+libf/zz_not_used/dyn3d/lect_start_archive.F
+libf/zz_not_used/dyn3d/clesph0.h
+libf/zz_not_used/dyn3d/coefpoly.F
+libf/zz_not_used/dyn3d/comav.h
+libf/zz_not_used/dyn3d/comconst.h
+libf/zz_not_used/dyn3d/comdiss.h
+libf/zz_not_used/dyn3d/comdissip.h
+libf/zz_not_used/dyn3d/divgrad22.F
+libf/zz_not_used/dyn3d/comdissipn.h
+libf/zz_not_used/dyn3d/comgeom.h
+libf/zz_not_used/dyn3d/comdissnew.h
+libf/zz_not_used/dyn3d/comgeom2.h
+libf/zz_not_used/dyn3d/comvert.h
+libf/zz_not_used/dyn3d/control.h
+libf/zz_not_used/dyn3d/convflu.F
+libf/zz_not_used/dyn3d/convmas.F
+libf/zz_not_used/dyn3d/coordij.F
+libf/zz_not_used/dyn3d/covcont.F
+libf/zz_not_used/dyn3d/covnat.F
+libf/zz_not_used/dyn3d/defrun_new.F
+libf/zz_not_used/dyn3d/description.h
+libf/zz_not_used/dyn3d/diagadv.F
+libf/zz_not_used/dyn3d/dissip.F
+libf/zz_not_used/dyn3d/disvert.F
+libf/zz_not_used/dyn3d/diverg.F
+libf/zz_not_used/dyn3d/diverg_gam.F
+libf/zz_not_used/dyn3d/divergf.F
+libf/zz_not_used/dyn3d/divergst.F
+libf/zz_not_used/dyn3d/divgrad.F
+libf/zz_not_used/dyn3d/divgrad2.F
+libf/zz_not_used/dyn3d/newstart.F
+libf/zz_not_used/dyn3d/dteta1.F
+libf/zz_not_used/dyn3d/dudv1.F
+libf/zz_not_used/dyn3d/dudv2.F
+libf/zz_not_used/dyn3d/dump2d.F
+libf/zz_not_used/dyn3d/dynetat0.F
+libf/zz_not_used/dyn3d/dynredem.F
+libf/zz_not_used/dyn3d/logic.h
+libf/zz_not_used/dyn3d/ener.h
+libf/zz_not_used/dyn3d/enercin.F
+libf/zz_not_used/dyn3d/exner.F
+libf/zz_not_used/dyn3d/exner_hyb.F
+libf/zz_not_used/dyn3d/flumass.F
+libf/zz_not_used/dyn3d/fluxstoke.F
+libf/zz_not_used/dyn3d/fxhyp.F
+libf/zz_not_used/dyn3d/fxy.F
+libf/zz_not_used/dyn3d/fxyhyper.F
+libf/zz_not_used/dyn3d/fxysinus.F
+libf/zz_not_used/dyn3d/fyhyp.F
+libf/zz_not_used/dyn3d/gcm.F
+libf/zz_not_used/dyn3d/geopot.F
+libf/zz_not_used/dyn3d/gr_dyn_fi.F
+libf/zz_not_used/dyn3d/gr_fi_dyn.F
+libf/zz_not_used/dyn3d/grad.F
+libf/zz_not_used/dyn3d/grid_noro1.F
+libf/zz_not_used/dyn3d/gr_int_dyn.F
+libf/zz_not_used/dyn3d/gr_u_scal.F
+libf/zz_not_used/dyn3d/gr_v_scal.F
+libf/zz_not_used/dyn3d/gradiv.F
+libf/zz_not_used/dyn3d/gradiv2.F
+libf/zz_not_used/dyn3d/gradsdef.h
+libf/zz_not_used/dyn3d/grid_atob.F
+libf/zz_not_used/dyn3d/grid_noro.F
+libf/zz_not_used/dyn3d/ini_archive.F
+libf/zz_not_used/dyn3d/groupe.F
+libf/zz_not_used/dyn3d/groupeun.F
+libf/zz_not_used/dyn3d/heavyside.F
+libf/zz_not_used/dyn3d/iniav.F
+libf/zz_not_used/dyn3d/iniconst.F
+libf/zz_not_used/dyn3d/inidissip.F
+libf/zz_not_used/dyn3d/inigeom.F
+libf/zz_not_used/dyn3d/inigrads.F
+libf/zz_not_used/dyn3d/iniinterp_h.F
+libf/zz_not_used/dyn3d/initial0.F
+libf/zz_not_used/dyn3d/write_archive.F
+libf/zz_not_used/dyn3d/iniwrite.F
+libf/zz_not_used/dyn3d/integrd.F
+libf/zz_not_used/dyn3d/interp_horiz.F
+libf/zz_not_used/dyn3d/interp_vert.F
+libf/zz_not_used/dyn3d/laplacien.F
+libf/zz_not_used/dyn3d/laplacien_gam.F
+libf/zz_not_used/dyn3d/laplacien_rot.F
+libf/zz_not_used/dyn3d/laplacien_rotgam.F
+libf/zz_not_used/dyn3d/lectflux.F
+libf/zz_not_used/dyn3d/massbar.F
+libf/zz_not_used/dyn3d/massbarxy.F
+libf/zz_not_used/dyn3d/massdair.F
+libf/zz_not_used/dyn3d/minmax.F
+libf/zz_not_used/dyn3d/multipl.F
+libf/zz_not_used/dyn3d/multscal.F
+libf/zz_not_used/dyn3d/start2archive.F
+libf/zz_not_used/dyn3d/paramet.h
+libf/zz_not_used/dyn3d/nxgrad.F
+libf/zz_not_used/dyn3d/vanleer.F
+libf/zz_not_used/dyn3d/nxgrad_gam.F
+libf/zz_not_used/dyn3d/nxgradst.F
+libf/zz_not_used/dyn3d/nxgraro2.F
+libf/zz_not_used/dyn3d/nxgrarot.F
+libf/zz_not_used/dyn3d/para_netcdf.h
+libf/zz_not_used/dyn3d/pression.F
+libf/zz_not_used/dyn3d/psextbar.F
+libf/zz_not_used/dyn3d/ran1.F
+libf/zz_not_used/dyn3d/rotat_nfil.F
+libf/zz_not_used/dyn3d/rotat.F
+libf/zz_not_used/dyn3d/rotatf.F
+libf/zz_not_used/dyn3d/rotatst.F
+libf/zz_not_used/dyn3d/scal_wind.F
+libf/zz_not_used/dyn3d/serre.h
+libf/zz_not_used/dyn3d/sortvarc.F
+libf/zz_not_used/dyn3d/sortvarc0.F
+libf/zz_not_used/dyn3d/spline.F
+libf/zz_not_used/dyn3d/splint.F
+libf/zz_not_used/dyn3d/sponge.F
+libf/zz_not_used/dyn3d/sponge.h
+libf/zz_not_used/dyn3d/temps.h
+libf/zz_not_used/dyn3d/test_period.F
+libf/zz_not_used/dyn3d/testharm.F
+libf/zz_not_used/dyn3d/tourpot.F
+libf/zz_not_used/dyn3d/traceur.F
+libf/zz_not_used/dyn3d/tracstoke.h
+libf/zz_not_used/dyn3d/tracvl.F
+libf/zz_not_used/dyn3d/vitvert.F
+libf/zz_not_used/dyn3d/vlsplt.F
+libf/zz_not_used/dyn3d/vlspltqs.F
+libf/zz_not_used/dyn3d/wind_scal.F
+libf/zz_not_used/dyn3d/wrgrads.F
+libf/zz_not_used/dyn3d/xvik.F
+libf/zz_not_used/dyn3d/readhead_NC.F
+libf/zz_not_used/dyn3d/anl_stats-diag.F
+libf/zz_not_used/dyn3d/anl_mcdstats.F
+libf/zz_not_used/grid/fxy_new.h
+libf/zz_not_used/grid/fxy_reg.h
+libf/zz_not_used/grid/fxy_sin.h
+libf/zz_not_used/grid/fxyprim.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd/tmp90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd/tmp90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd/tmp90	(revision 2744)
@@ -0,0 +1,8 @@
+libf/phymars/meso_readtesassim.F90
+libf/phymars/wstats.F90
+libf/phymars/param_slope_full.F90
+libf/phymars/def_var.F90
+libf/phymars/mkstat.F90
+libf/phymars/readtesassim.F90
+libf/phymars/param_slope.F90
+libf/phymars/fill_save_2d.F90
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/create_make_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/create_make_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/create_make_gcm	(revision 2744)
@@ -0,0 +1,253 @@
+#!/bin/sh
+#set -xv
+#
+# Ehouarn: added the following feature:
+#          create_make_gcm must be called with list of directories
+#          which contain header (or modules) which should be scanned
+#          by create_make_gcm when checking dependencies.
+#          Example:
+#          create_make_gcm dyn3d grid
+#          means that header/modules will be looked for in directories
+#          ., dyn3d and grid
+#
+machine=`hostname`
+os=`uname`
+gcm=`pwd`
+libf=$gcm/libf
+libo=$gcm/libo
+CRAY=0
+if [ "$machine" = "atlas" -o "$machine" = "etoile" -o "$machine" = "axis" ] ; then
+  CRAY=1
+fi
+XNEC=0
+if [ "$machine" = "rhodes" ] ; then
+  XNEC=1
+fi
+VPP=0
+if [ "$machine" = "nymphea0" ] ; then
+  VPP=1
+fi
+#
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Definitions de Macros pour Make"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo 
+echo "# create_make_gcm arguments: $*"
+echo
+echo "# Repertoires :"
+echo
+echo "GCM     = "$gcm
+if [ "$CRAY" = '0' ] ; then
+   echo "MACHINE = sun4"
+fi
+echo 'LIBF    = $(GCM)/libf'
+if [ "$CRAY" = '0' ] ; then
+#   echo 'LIBO    = $(GCM)/libo/$(MACHINE)'
+   echo 'LIBO    = $(LIBOGCM)/$(MACHINE)'
+else
+   echo 'LIBO    = $(GCM)/libo'
+fi
+#echo 'LOCAL_DIR=$(GCM)'
+#echo $localdir
+echo "LOCAL_DIR=`echo $localdir`"
+echo 'BIBIO    = $(LIBF)/bibio'
+echo 'AERONOMARS    = $(LIBF)/aeronomars'
+echo "FILTRE   = filtre"
+echo "PHYS  = "
+echo 'DYN  = $(DYNTYPE)'
+echo 'LIBPHY = $(LIBO)/libphy$(PHYS).a'
+echo 'DIRMAIN= $(DYN)$(DIM)d'
+echo 'RM=rm'
+echo
+echo "OPLINK = "
+echo
+echo '# Les differentes librairies pour l"edition des liens:'
+echo
+if [ "$XNEC" = '1' ] ; then
+  echo 'dyn3d      = $(LIBO)/libsxdyn3d.a $(LIBO)/libsx$(FILTRE).a'
+  echo 'dyn2d      = $(LIBO)/libsxdyn2d.a'
+  echo 'dyn1d      = $(LIBO)/libsxdyn1d.a'
+  echo 'L_DYN      = -lsxdyn$(DIM)d'
+  echo 'L_FILTRE   = -lsx$(FILTRE)'
+  echo 'L_PHY = -lsxphy$(PHYS) '
+  echo 'L_BIBIO    = -lsxbibio'
+  echo 'L_AERONOMARS    = -lsxaeronomars'
+  echo 'L_ADJNT    ='
+else
+  echo 'dyn3d      = $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a'
+  echo 'dyn2d      = $(LIBO)/libdyn2d.a'
+  echo 'dyn1d      = $(LIBO)/libdyn1d.a'
+  echo 'L_DYN      = -l$(DYN)$(DIM)d'
+  echo 'L_FILTRE   = -l$(FILTRE)'
+  echo 'L_PHY = -lphy$(PHYS) '
+  echo 'L_BIBIO    = -lbibio'
+  echo 'L_AERONOMARS    = -laeronomars'
+  echo 'L_ADJNT    ='
+fi
+echo
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Option de compilation FORTRAN"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+   echo 'COMPILE = $(F77) $(OPTIM) $(INCLUDE) -c'
+   echo 'COMPILE90 = $(F90) $(OPTIM90) $(INCLUDE) -c'
+   echo 'COMPTRU90 = $(F90) $(OPTIMTRU90) $(INCLUDE) -c'
+   echo "LINK    = $LINK"
+   echo "AR      = $AR"
+echo
+echo
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Creation des differents executables"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+echo "# Executables:"
+echo "# ------------"
+echo
+echo "PROG = code"
+echo
+echo 'main : $(DYN) bibio phys aeronomars $(OPTION_DEP) '
+echo '	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
+echo '	cd $(LOCAL_DIR); \'
+echo '	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(PROG).F -o $(PROG).o ; \'
+if [ "$CRAY" = '0' ] ; then
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+else
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+fi
+echo
+echo 'dyn : $(LIBO)/libdyn$(DIM)d.a $(FILTRE)$(DIM)d'
+echo
+echo 'olddyn : $(LIBO)/libolddyn$(DIM)d.a $(FILTRE)$(DIM)d'
+echo
+echo 'phys : $(LIBPHY)'
+echo
+echo 'bibio : $(LIBO)/libbibio.a'
+echo
+echo 'aeronomars : $(LIBO)/libaeronomars.a'
+echo
+echo 'adjnt : $(LIBO)/libadjnt.a'
+echo
+echo '$(FILTRE)3d : $(LIBO)/lib$(FILTRE).a'
+echo
+echo '$(FILTRE)2d :'
+echo
+echo '$(FILTRE)1d :'
+echo
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Contenu des differentes bibliotheques"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+echo
+cd $libf >/dev/null 2>&1
+for diri in ` ls `
+do
+   if [ -d $diri ] ; then
+   if [ "`ls $diri/*.F`" != "" ] || [ "`ls $diri/*.F90`" != "" ]  ; then 
+      cd $diri >/dev/null 2>&1
+      echo
+      listlib=""
+      for i in `ls *.F`
+      do
+         fili=`basename $i .F`
+         test=` (  head $i | grep '      PROGRAM' ) `
+         if [ "$test" = "" ] ; then 
+            listlib=$listlib" "$fili
+         fi
+      done
+      for i in `ls *.F90`
+      do
+         fili=`basename $i .F90`
+         test=` (  head $i | grep '      PROGRAM' ) `
+         if [ "$test" = "" ] ; then
+            listlib=$listlib" "$fili
+         fi 
+      done
+#
+      echo
+      echo
+      echo "#======================================================================="
+      echo "# Contenu de la bibliotheque correspondant au Directory "$diri
+      echo "#======================================================================="
+      echo
+      for fili in $listlib
+      do
+         echo '$(LIBO)/lib'$diri".a : " '$(LIBO)/lib'$diri".a("$fili".o)"
+         echo
+      done
+      echo '.PRECIOUS	: $(LIBO)/lib'$diri'.a'
+      echo
+      echo
+      echo "# Compilation des membres de la bibliotheque lib"$diri".a"
+      echo
+      for fili in $listlib
+      do
+         if [ -f $fili.F90 ] ; then
+           trufile=$fili.F90
+         else
+           trufile=$fili.F
+         fi
+         F90=0 ; egrep -i '^ *use ' $trufile > /dev/null 2>&1 && F90=1
+                 egrep -i '^ *module ' $trufile > /dev/null 2>&1 && F90=1
+                 egrep -i '#include*.inc ' $trufile > /dev/null 2>&1 && F90=1
+         str1='$(LIBO)/lib'$diri'.a('$fili'.o) : $(LIBF)/'$diri/$trufile
+         [ "$fili" = "chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F
+         for stri in ` ( sed -n "/\#include/s/\#include//p" $trufile | sed 's/\"//g' ; egrep -i '^ *use ' $trufile | sed -e 's/,/ /' | awk ' { print $2 } ' ) `
+         do
+            stri=`echo $stri | tr [A-Z] [a-z]`
+            if [ -f $stri ] ; then
+               echo $str1 \\
+               str1='$(LIBF)/'$diri'/'$stri
+            else
+               if [ -f $stri.F ] || [ -f $stri.F90 ] ; then
+                  echo $str1 \\
+                  str1='$(LIBO)/lib'$diri'.a('$stri'.o)'
+               else
+#                  for dirinc in dyn3d grid bibio aeronomars phymars
+                  for dirinc in $*
+                  do
+                     if [ -f ../$dirinc/$stri ] ; then
+                        echo $str1 \\
+                        str1='$(LIBF)/'`cd .. ; ls */$stri | head -1`
+                     fi
+                     if [ -f ../$dirinc/$stri.F90 ] ; then
+                        echo $str1 \\
+                        str1='$(LIBO)/lib'$dirinc'.a('$stri'.o)'
+                     fi
+                  done
+               fi
+            fi
+         done
+         echo $str1
+	 if [ "$F90" -eq '0' ] ; then
+           echo '	cd $(LOCAL_DIR); \'
+	   echo '	$(COMPILE) $(LIBF)/'$diri'/'$trufile' ; \'
+	 else
+           echo '	cd $(LOCAL_DIR); \'
+           if [ -f $fili.F90 ] ; then
+	      echo '	$(COMPTRU90) $(LIBF)/'$diri'/'$trufile' ; \'
+           else
+	      echo '	$(COMPILE90) $(LIBF)/'$diri'/'$trufile' ; \'
+           fi
+           MODU=0; egrep -i '^ *module ' $trufile> /dev/null 2>&1 && MODU=1
+            if [ "$MODU" -eq '1' -a "$CRAY" != '1' ] ; then
+              if [ "$os" = 'UNIX_System_V' ] ; then
+                echo '	cp $(MOD_LOC_DIR)/*.$(MOD_SUFFIX) $(LIBO)/ ; \'
+              else
+                echo '	mv $(MOD_LOC_DIR)/'$fili'.$(MOD_SUFFIX) $(LIBO)/'$fili'.$(MOD_SUFFIX) ; \'
+#                echo '	if [ "$(MOD_LOC_DIR)" ne "$(LIBO)" ] ; then mv $(MOD_LOC_DIR)/'*'.$(MOD_SUFFIX) $(LIBO) ; fi ; \'
+              fi
+            fi
+	 fi
+	 if ( [ "$XNEC" -eq '1' ] || [ "$X6NEC" = '1' ] || [ "$X8BRODIE" = '1' ] ) ; then
+           echo '	sxar r $(LIBO)/libsx'$diri'.a '$fili'.o ; \'
+         fi
+         echo '	$(AR) r $(LIBO)/lib'$diri'.a '$fili'.o ; $(RM) '$fili'.o ; \'
+         echo '	cd $(GCM)'
+	 echo
+      done
+#	 
+      echo
+   cd $libf
+   fi
+   fi
+done
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/callphys.def
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/callphys.def	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/callphys.def	(revision 2744)
@@ -0,0 +1,115 @@
+##General options
+##~~~~~~~~~~~~~~~
+#Run with or without tracer transport ?
+tracer=.false.
+
+#Diurnal cycle ?  if diurnal=False, diurnal averaged solar heating
+diurnal=.true.
+
+#Seasonal cycle ? if season=False, Ls stays constant, to value set in "start"
+season = .true.   
+
+#write some more output on the screen ?
+lwrite = .false.    
+
+#Save statistics in file "stats.nc" ?
+stats =.true.
+
+#Save EOF profiles in file "profiles" for Climate Database?
+calleofdump = .false.
+
+## Dust scenario. Used if the dust is prescribed (i.e. if tracer=F or active=F)
+## ~~~~~~~~~~~~~
+#  =1 Dust opt.deph read in startfi; =2 Viking scenario; =3 MGS scenario,
+#  =4 Mars Year 24 from TES assimilation (same as =24 for now)
+#  =24 Mars Year 24 from TES assimilation (ie: MCD reference case)
+#  =25 Mars Year 25 from TES assimilation (ie: a year with a global dust storm)
+#  =26 Mars Year 26 from TES assimilation
+iaervar = 24 
+# Dust opacity at 700 Pa (when constant, i.e. for the iaervar=1 case)
+tauvis=0.2
+# Dust vertical distribution: 
+# (=0: old distrib. (Pollack90), =1: top set by "topdustref",
+#  =2: Viking scenario; =3 MGS scenario)
+iddist  = 3
+# Dust top altitude (km). (Matters only if iddist=1)
+topdustref = 55.
+
+## Physical Parameterizations :
+## ~~~~~~~~~~~~~~~~~~~~~~~~~~
+# call radiative transfer ?
+callrad   = .true.
+# call NLTE radiative schemes ?   matters only if callrad=T
+callnlte = .true.
+# call CO2 NIR absorption ?   matters only if callrad=T
+callnirco2 = .true.
+# call turbulent vertical diffusion ?
+calldifv  = .true.
+# call convective adjustment ?
+calladj  = .true.
+# call CO2 condensation ?
+callcond =.true.
+# call thermal conduction in the soil ?
+callsoil = .true.
+# call Lott's gravity wave/subgrid topography scheme ?
+calllott  = .true.
+
+## Radiative transfer options :
+## ~~~~~~~~~~~~~~~~~~~~~~~~~~
+# the rad.transfer is computed every "iradia" physical timestep
+iradia    = 1
+# Output of the exchange coefficient mattrix ? for diagnostic only
+callg2d  = .false.
+# Rayleigh scattering : (should be .false. for now)
+rayleigh  = .false.
+
+## Tracer (dust water, ice and/or chemical species) options (used if tracer=T):
+## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# DUST: Transported dust ? (if >0, use 'dustbin' dust bins)
+dustbin    = 0
+# DUST: Radiatively active dust ? (matters if dustbin>0)
+active  = .false.
+# DUST: use mass and number mixing ratios to predict dust size ?
+# (must also have dustbin=1)
+doubleq   = .false.
+# DUST: lifted by GCM surface winds ?
+lifting = .false.
+# DUST: lifted by dust devils ?
+callddevil = .false.
+# DUST: Scavenging by CO2 snowfall ?
+scavenging = .false.
+# DUST/WATERICE: Gravitationnal sedimentation ?
+sedimentation = .false.
+# WATERICE: Radiatively active transported atmospheric water ice ?
+activice   = .false.
+# WATER: Compute water cycle
+water = .false.
+# WATER: current permanent caps at both poles. True IS RECOMMENDED
+#        (with .true., North cap is a source of water and South pole
+#         is a cold trap)
+caps  = .true.
+# PHOTOCHEMISTRY: include chemical species 
+photochem  = .false.
+
+## Thermospheric options (relevant if tracer=T) :
+##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# call thermosphere ?
+callthermos = .false.
+# WATER: included without cycle (only if water=.false.)
+thermoswater = .false.
+# call thermal conduction ? (only if callthermos=.true.)
+callconduct = .false.
+# call EUV heating ? (only if callthermos=.true.)
+calleuv=.false.
+# call molecular viscosity ? (only if callthermos=.true.)
+callmolvis = .false.
+# call molecular diffusion ? (only if callthermos=.true.)
+callmoldiff = .false.
+# call thermospheric photochemistry ? (only if callthermos=.true.)
+thermochem = .false.
+# date for solar flux calculation: (1985 < date < 2002)
+## (Solar min=1996.4 ave=1993.4 max=1990.6)
+solarcondate = 1993.4
+       
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.1d
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.1d	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.1d	(revision 2744)
@@ -0,0 +1,64 @@
+#
+#----------------------------------------------------------------------- 
+# Run parameters for the 1D 'testphys1d.e' model                                          
+#-----------------------------------------------------------------------                                         
+
+#### Time integration parameters
+#
+# Initial date (in martian sols ; =0 at Ls=0)
+day0=0
+# Initial local time (in hours, between 0 and 24)
+time=0
+# Number of time steps per sol
+day_step=48
+# Number of sols to run 
+ndt = 100
+
+#### Physical parameters
+#
+# Surface pressure (Pa)
+psurf= 610
+# Reference dust opacity at 700 Pa, in the visible (true tau~tauref*psurf/700)
+tauvis=0.2
+# latitude (in degrees)
+latitude= 0.
+# Albedo of bare ground
+albedo=0.2
+# Soil thermal inertia (SI)
+inertia=400
+# zonal eastward component of the geostrophic wind (m/s)
+u=10.
+# meridional northward component of the geostrophic wind (m/s)
+v=0.
+# Initial CO2 ice on the surface (kg.m-2)
+co2ice=0
+# hybrid vertical coordinate ? (.true. for hybrid and .false. for sigma levels)
+hybrid=.true.
+
+
+###### Initial atmospheric temperature profile
+#
+# Type of initial temperature profile
+#         ichoice=1   Constant Temperature:  T=tref
+#         ichoice=2   Savidjari profile (as Seiff but with dT/dz=cte)
+#         ichoice=3   Lindner (polar profile)
+#         ichoice=4   inversion
+#         ichoice=5   Seiff  (standard profile, based on Viking entry)
+#         ichoice=6   constant T  +  gaussian perturbation (levels)
+#         ichoice=7   constant T  + gaussian perturbation (km)
+#         ichoice=8   Read in an ascii file "profile" 
+ichoice=5
+# Reference temperature tref (K)
+tref=200
+# Add a perturbation to profile if isin=1
+isin=0
+# peak of gaussian perturbation (for ichoice=6 or 7)
+pic=26.522
+# width of the gaussian perturbation (for ichoice=6 or 7)
+largeur=10
+# height of the gaussian perturbation (for ichoice=6 or 7)
+hauteur=30.
+
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.32x24x25
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.32x24x25	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.32x24x25	(revision 2744)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 480
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=1
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 3000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=9000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=9000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=10
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=120
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 90
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 50000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.32x24x32
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.32x24x32	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.32x24x32	(revision 2744)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 480
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=1
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 3000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=9000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=9000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=10
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=120
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 130
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 50000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.64x48x25
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.64x48x25	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.64x48x25	(revision 2744)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 960
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=5
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 4000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=5000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=5000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=20
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=240
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 90
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 50000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.64x48x32
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.64x48x32	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.64x48x32	(revision 2744)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 960
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=5
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 4000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=5000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=5000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=20
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=240
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 130
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 50000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.64x48x50
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.64x48x50	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run.def.64x48x50	(revision 2744)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 960
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=1
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 3000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=20000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=20000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=20
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=240
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 230
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 30000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run0
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run0	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run0	(revision 2744)
@@ -0,0 +1,101 @@
+#!/bin/csh
+###########################################################################
+# Script to perform several chained LMD Mars GCM simulations
+# SET HERE the maximum total number of simulations
+
+set nummax=1
+
+###########################################################################
+
+
+echo "---------------------------------------------------------"
+echo "starting run0"
+
+set dir=`pwd`
+set machine=`hostname`
+set address=`whoami`
+
+# Look for file "num_run" which should contain 
+# the value of the previously computed season
+# (defaults to 0 if file "num_run" does not exist)
+if ( -f num_run ) then
+ echo "found file num_run"
+  set numold=`cat num_run`
+else
+  set numold=0
+endif
+echo "numold is set to" ${numold}
+
+
+# Set value of current season 
+set numnew=${numold}
+@ numnew = ${numnew} + 1
+echo "numnew is set to" ${numnew}
+
+# Look for initialization data files (exit if none found)
+if ( ( -f start${numold}.nc ) && ( -f startfi${numold}.nc ) ) then
+   \cp -f start${numold}.nc start.nc
+   \cp -f startfi${numold}.nc startfi.nc
+else if ( ${numold} == 99999 ) then
+    echo "No run because previous run crashed ! (99999 in num_run)"
+    exit
+else
+   echo "Where is file start"${numold}".nc??"
+   exit
+endif
+
+
+# Run GCM
+nice gcm.e >! lrun${numnew} 
+
+
+# Check if run ended normaly and copy datafiles
+if ( ( -f restartfi.nc ) && ( -f restart.nc ) ) then
+  echo "Run seems to have ended normaly"
+  \mv -f restartfi.nc startfi${numnew}.nc
+  \mv -f restart.nc start${numnew}.nc
+else
+  if ( -f num_run ) then
+    \mv -f num_run num_run.crash
+  else
+    echo "No file num_run to build num_run.crash from !!"
+    # Impose a default value of 0 for num_run
+    echo 0 >! num_run.crash
+  endif
+ echo 99999 >! num_run
+############## To receive an Email message if the run crashes ########
+mail -s "crash run GCM" $address <<ENDMAIL
+The run on $machine in $dir has just crashed.
+ENDMAIL
+############################################"" 
+ exit
+endif
+
+# Copy other datafiles that may have been generated
+if ( -f diagfi.nc ) then
+  \mv -f diagfi.nc diagfi${numnew}.nc
+endif
+if ( -f diagsoil.nc ) then
+  \mv -f diagsoil.nc diagsoil${numnew}.nc
+endif
+if ( -f stats.nc ) then
+  \mv -f stats.nc stats${numnew}.nc
+endif
+if ( -f profiles.dat ) then
+  \mv -f profiles.dat profiles${numnew}.dat
+  \mv -f profiles.hdr profiles${numnew}.hdr
+endif
+
+# Prepare things for upcoming runs by writing
+# value of computed season in file num_run
+echo ${numnew} >! num_run
+
+# If we are over nummax : stop
+if ( `expr $numnew + 1 \> $nummax ` == 1) then
+   exit
+else
+   \cp -f run0 exe_mars
+   exe_mars
+endif 
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run_farm
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run_farm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run_farm	(revision 2744)
@@ -0,0 +1,28 @@
+# Script to submit simulations with the LMD MARS GCM on 
+# a farm of computers using the run manager named "Torque".
+# To run it, just type 
+# > qsub run_farm
+
+# Shell
+#PBS -S /bin/bash
+# Job Name
+#PBS -N run_mars
+# Merge output and error logs
+#PBS -j oe
+
+####################################
+# SELECT HERE THE RUN DURATION CLASS :
+# Queue std(6h) / day / week /infini
+
+#PBS -q std
+
+# Go to present working directory
+cd  $PBS_O_WORKDIR
+
+# SELECT HERE THE TYPE OF SCRIPT TO USE : "run0" OR "run_mcd"
+
+run0
+
+####################################
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run_mcd
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run_mcd	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/run_mcd	(revision 2744)
@@ -0,0 +1,78 @@
+#!/bin/csh
+##############################################################################
+# Script to run successive monthly (a month spans 30 deg. in Ls)
+# simulations of the LMD Mars GCM.
+# This script uses the following files:
+# - "run0": script to compute a given month
+# - "num_run": single line file containing a value, which is the value of
+#   the 'initializing' month
+# - "run.def.ref": a "run.def" file, exept that variable "nday" is set to 9999
+# - all files usually neaded to run the GCM. Note that initialization
+#   datafiles "start.nc" and "startfi.nc" must be
+#   "start${num_run}.nc" and "startfi${num_run}.nc"
+##############################################################################
+# DON'T FORGET TO:
+# 1) Set the "number of simulation" to 1 in "run0"
+# 2) Copy "run.def" to "run.def.ref" and SET nday to 9999 in run.def.ref
+# 3) uncomment the various lines below (those which begin with "sed ...")
+# 4) If restarting in the middle of a year: 
+#       -Below, Comment all the month already computed
+#       -Write  "N" in file "num_run" if starting from startN.nc !
+##############################################################################
+
+
+# Remove old "error" file (if any) and create a brand new (blank) one
+\rm -f  error; touch error
+
+# 12 martian months (=30°deg Ls) of unequal length (excentric orbit)
+  sed s/9999/61/ run.def.ref >! run.def ; run0 >>& error     #1
+  sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #2
+  sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #3
+  sed s/9999/65/ run.def.ref >! run.def ; run0 >>& error     #4
+  sed s/9999/60/ run.def.ref >! run.def ; run0 >>& error     #5
+  sed s/9999/54/ run.def.ref >! run.def ; run0 >>& error     #6
+  sed s/9999/50/ run.def.ref >! run.def ; run0 >>& error     #7
+  sed s/9999/46/ run.def.ref >! run.def ; run0 >>& error     #8
+  sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #9
+  sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #10
+  sed s/9999/51/ run.def.ref >! run.def ; run0 >>& error     #11 
+  sed s/9999/56/ run.def.ref >! run.def ; run0 >>& error     #12
+#
+# 12 martian months (=30°deg Ls) of unequal length (excentric orbit)
+# sed s/9999/61/ run.def.ref >! run.def ; run0 >>& error     #13
+# sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #14
+# sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #15
+# sed s/9999/65/ run.def.ref >! run.def ; run0 >>& error     #16
+# sed s/9999/60/ run.def.ref >! run.def ; run0 >>& error     #17
+# sed s/9999/54/ run.def.ref >! run.def ; run0 >>& error     #18
+# sed s/9999/50/ run.def.ref >! run.def ; run0 >>& error     #19
+# sed s/9999/46/ run.def.ref >! run.def ; run0 >>& error     #20
+# sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #21
+# sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #22
+# sed s/9999/51/ run.def.ref >! run.def ; run0 >>& error     #23
+# sed s/9999/56/ run.def.ref >! run.def ; run0 >>& error     #24
+#
+# 12 martian months (=30°deg Ls) of unequal length (excentric orbit)
+# sed s/9999/61/ run.def.ref >! run.def ; run0 >>& error     #25
+# sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #26
+# sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #27
+# sed s/9999/65/ run.def.ref >! run.def ; run0 >>& error     #28
+# sed s/9999/60/ run.def.ref >! run.def ; run0 >>& error     #29
+# sed s/9999/54/ run.def.ref >! run.def ; run0 >>& error     #30
+# sed s/9999/50/ run.def.ref >! run.def ; run0 >>& error     #31
+# sed s/9999/46/ run.def.ref >! run.def ; run0 >>& error     #32
+# sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #33
+# sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #34
+# sed s/9999/51/ run.def.ref >! run.def ; run0 >>& error     #35
+# sed s/9999/56/ run.def.ref >! run.def ; run0 >>& error     #36
+
+# These last lines allow to reconstruct the last num_run after a model crash 
+# (because after crash, num_run was set to 9999 so that no further simulation
+# Could be performed
+   set number=`cat num_run`
+   if ( $number == 99999) then
+      set numold=`cat num_run.crash`
+      echo '-----' >>& error
+      echo 'Seasonal simulation aborted after starting from start'$numold >>& error
+      \mv -f num_run.crash num_run  
+   endif
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/traceur.def.chemistry
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/traceur.def.chemistry	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/traceur.def.chemistry	(revision 2744)
@@ -0,0 +1,16 @@
+15
+co2
+co
+o
+o1d
+o2
+o3
+h
+h2
+oh
+ho2
+h2o2
+n2
+ar
+h2o_ice
+h2o_vap
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/traceur.def.co2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/traceur.def.co2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/traceur.def.co2	(revision 2744)
@@ -0,0 +1,2 @@
+1
+co2
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/traceur.def.watercycle
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/traceur.def.watercycle	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/traceur.def.watercycle	(revision 2744)
@@ -0,0 +1,3 @@
+2
+h2o_ice
+h2o_vap
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/z2sig.def
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/z2sig.def	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/deftank/z2sig.def	(revision 2744)
@@ -0,0 +1,68 @@
+10.00000     H: atmospheric scale height (km) (used as a reference only)
+0.0040       Typical pseudo-altitude (m) for 1st layer (z=H*log(sigma))
+0.018       ,, ,,  ,, ,, ,, ,,  ,, ,, ,,  2nd layer, etc...
+0.0400
+0.1000
+0.228200
+0.460400
+0.907000
+1.73630
+3.19040
+5.54010
+8.97780
+13.5138
+18.9666
+25.0626
+31.5527
+38.4369
+45.4369
+52.4369
+59.4369
+66.4369
+73.4369
+80.4369
+87.4369
+94.4369
+101.4369
+108.437
+115.437
+122.437
+129.437
+136.437
+143.437
+150.437
+157.437
+164.437
+171.437
+178.437
+185.437
+192.437
+199.437
+206.437
+213.437
+220.437
+227.437
+234.437
+241.437
+248.437
+255.437
+262.437
+269.437
+276.437
+283.437
+290.437
+297.437
+304.437
+311.437
+318.437
+325.437
+332.437
+339.437
+346.437
+353.437
+360.437
+367.437
+374.437
+381.437
+388.437
+395.437
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/aeronomars
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/aeronomars	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/aeronomars	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/aeronomars
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/bibio
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/bibio	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/bibio	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/misc
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate1
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate1	(revision 2744)
@@ -0,0 +1,14 @@
+\rm aeronomars/d2_*
+\rm bibio/d2_*
+\rm phymars/d2_*
+\rm grid/d2_*
+\rm dyn3d/d2_*
+
+\rm aeronomars/d3_*
+\rm bibio/d3_*
+\rm phymars/d3_*
+\rm grid/d3_*
+\rm dyn3d/d3_*
+
+
+# this may be used for cleaning purpose as well
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate2	(revision 2744)
@@ -0,0 +1,50 @@
+#!/bin/bash
+
+echo 'duplicate sources for domain 2'
+
+\rm aeronomars/d2_*
+\rm bibio/d2_*
+\rm phymars/d2_*
+\rm phymars/meso_inc/d2_*
+\rm grid/d2_*
+\rm dyn3d/d2_*
+
+cd aeronomars
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+cd bibio
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+cd phymars
+cp ../generate2 .
+find *.F -exec generate2 {} \;
+find *.h -exec generate2 {} \;
+find *.F90 -exec generate2 {} \;
+find *.inc -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+cd phymars/meso_inc/
+cp ../../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ../../.
+
+cd grid
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+\rm d2_dimension
+cd ..
+
+cd dyn3d
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate3
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate3	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate3	(revision 2744)
@@ -0,0 +1,69 @@
+#!/bin/bash
+
+./duplicate2
+
+echo 'duplicate sources for domain 3'
+
+\rm aeronomars/d3_*
+\rm bibio/d3_*
+\rm phymars/d3_*
+\rm phymars/meso_inc/d3_*
+\rm grid/d3_*
+\rm dyn3d/d3_*
+
+
+cd aeronomars
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+cd bibio
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+cd phymars
+cp ../generate3 .
+find *.F -exec generate3 {} \;
+find *.h -exec generate3 {} \;
+find *.F90 -exec generate3 {} \;
+find *.inc -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+cd phymars/meso_inc/
+cp ../../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ../../.
+
+cd grid
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+\rm d3_dimension
+cd ..
+
+cd dyn3d
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+\rm aeronomars/d3_d2*
+\rm bibio/d3_d2*
+\rm phymars/d3_d2*
+\rm phymars/meso_inc/d3_d2*
+\rm grid/d3_d2*
+\rm dyn3d/d3_d2*
+
+\rm aeronomars/d2_d3*
+\rm bibio/d2_d3*
+\rm phymars/d2_d3*
+\rm phymars/meso_inc/d2_d3*
+\rm grid/d2_d3*
+\rm dyn3d/d2_d3*
+
+  
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate4
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate4	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/duplicate4	(revision 2744)
@@ -0,0 +1,83 @@
+#!/bin/bash
+
+./duplicate3  ## est-ce le bon ordre ??? 
+
+echo 'duplicate sources for domain 4'
+
+\rm aeronomars/d4_*
+\rm bibio/d4_*
+\rm phymars/d4_*
+\rm phymars/meso_inc/d4_*
+\rm grid/d4_*
+\rm dyn3d/d4_*
+
+
+cd aeronomars
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+cd bibio
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+cd phymars
+cp ../generate4 .
+find *.F -exec generate4 {} \;
+find *.h -exec generate4 {} \;
+find *.F90 -exec generate4 {} \;
+find *.inc -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+cd phymars/meso_inc/
+cp ../../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ../../.
+
+cd grid
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+\rm d3_dimension
+cd ..
+
+cd dyn3d
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+\rm aeronomars/d4_d3*
+\rm bibio/d4_d3*
+\rm phymars/d4_d3*
+\rm phymars/meso_inc/d4_d3*
+\rm grid/d4_d3*
+\rm dyn3d/d4_d3*
+
+\rm aeronomars/d3_d4*
+\rm bibio/d3_d4*
+\rm phymars/d3_d4*
+\rm phymars/meso_inc/d3_d4*
+\rm grid/d3_d4*
+\rm dyn3d/d3_d4*
+
+\rm aeronomars/d4_d2*
+\rm bibio/d4_d2*
+\rm phymars/d4_d2*
+\rm phymars/meso_inc/d4_d2*
+\rm grid/d4_d2*
+\rm dyn3d/d4_d2*
+
+\rm aeronomars/d2_d4*
+\rm bibio/d2_d4*
+\rm phymars/d2_d4*
+\rm phymars/meso_inc/d2_d4*
+\rm grid/d2_d4*
+\rm dyn3d/d2_d4*
+
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/dyn3d
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/dyn3d	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/dyn3d	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/dyn3d_common
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/filtrez
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/filtrez	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/filtrez	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/filtrez
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/generate2
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/generate2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/generate2	(revision 2744)
@@ -0,0 +1,40 @@
+# script
+# execute: find * -exec generate2 {} \;
+# change number sed -e s/d2/d2/g generate2 > generate3
+
+sed -e s/'[cC][aA][lL][lL] '/'call d2_'/g ${1} | sed -e s/'call d2_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d2_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d2_'/'firstcall '/g | sed -e s/'lastcall d2_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d2_'/g | sed -e s/'callphys.def'/'callphysd2_.def '/g | sed -e s/'diagfi.nc'/'diagfid2_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d2_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd2_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d2_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d2_"+g | sed -e s+"d2_netcdf.inc"+"netcdf.inc"+g > d2_${1}_temp
+
+# Specifcic cases for newphys compilation:
+
+sed -e s/'[mM][oO][dD][uU][lL][eE] '/'MODULE d2_'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'d2_[pP][rR][oO][cC][eE][dD][uU][rR][eE] '/'PROCEDURE '/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'[iI][nN][tT][eE][rR][fF][aA][cC][eE] '/'INTERFACE d2_'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'[eE][nN][dD] INTERFACE d2_'/'END INTERFACE '/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'calltherm_INTERFACE d2_'/'calltherm_interface '/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'meso_inc_'/'d2_meso_inc_'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s+'d2_meso_inc/'+'meso_inc/'+g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'[uU][sS][eE] ioipsl_getincom'/'USE d2_ioipsl_getincom'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'[uU][sS][eE] updaterad'/'USE d2_updaterad'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'PUBLIC :: getin, getin_dump'/'PUBLIC :: d2_getin, d2_getin_dump'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/' getinrs, getinr1d, getinr2d,'/' d2_getinrs, d2_getinr1d, d2_getinr2d,'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/' getinis, getini1d, getini2d,'/' d2_getinis, d2_getini1d, d2_getini2d,'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/' getincs, getinc1d, getinc2d,'/' d2_getincs, d2_getinc1d, d2_getinc2d,'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/' getinls, getinl1d, getinl2d'/' d2_getinls, d2_getinl1d, d2_getinl2d'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg'/'PUBLIC :: d2_ipslnlf, d2_ipslerr, d2_ipslerr_act, d2_ipslerr_inq, d2_histerr, d2_ipsldbg'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'USE ioipsl_errioipsl, ONLY : ipslerr'/'USE d2_ioipsl_errioipsl, ONLY : d2_ipslerr'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'USE ioipsl_stringop'/'USE d2_ioipsl_stringop'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+sed -e s/'ONLY : nocomma,cmpblank,strlowercase'/'ONLY : d2_nocomma,d2_cmpblank,d2_strlowercase'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp
+
+# Functions
+
+case ${1} in 
+   'nlte_aux.F') sed -e s/'iaa_we'/'d2_iaa_we'/g d2_${1}_temp | sed -e s/'simrul'/'d2_simrul'/g | sed -e s/'iaa_f'/'d2_iaa_f'/g | sed -e s/'iaa_fi'/'d2_iaa_fi'/g | sed -e s/'voigtf'/'d2_voigtf'/g | sed -e s/'planckdp'/'d2_planckdp'/g | sed -e s/'we_clean'/'d2_we_clean'/g | sed -e s/'bandid'/'d2_bandid'/g > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp ;;
+   'nlte_tcool.F') sed -e s/'planckdp'/'d2_planckdp'/g d2_${1}_temp | sed -e s/'hrkday_convert'/'d2_hrkday_convert'/g > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp ;;
+   'nlte_calc.F') sed -e s/'bandid'/'d2_bandid'/g d2_${1}_temp > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp ;;
+   'geticecover.F90') sed -e s/'isitice'/'d2_isitice'/g d2_${1}_temp | sed -e s/'splatcrocus'/'d2_splatcrocus'/g | sed -e s/'nplatcrocus'/'d2_nplatcrocus'/g > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp ;;
+   'nuclea.F')  sed -e s/'fshape'/'d2_fshape'/g d2_${1}_temp | sed -e s/'d2_fshapesimple'/'fshapesimple'/g | sed -e s/'zed2_fshape'/'zefshape'/g > d2_${1}_temp2 ; \mv d2_${1}_temp2 d2_${1}_temp ;;
+esac
+
+# Cleanup
+
+\mv d2_${1}_temp d2_${1}
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/generate3
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/generate3	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/generate3	(revision 2744)
@@ -0,0 +1,39 @@
+# script
+# execute: find * -exec generate2 {} \;
+# change number sed -e s/d2/d3/g generate2 > generate3
+
+sed -e s/'[cC][aA][lL][lL] '/'call d3_'/g ${1} | sed -e s/'call d3_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d3_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d3_'/'firstcall '/g | sed -e s/'lastcall d3_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d3_'/g | sed -e s/'callphys.def'/'callphysd3_.def '/g | sed -e s/'diagfi.nc'/'diagfid3_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d3_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd3_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d3_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d3_"+g | sed -e s+"d3_netcdf.inc"+"netcdf.inc"+g > d3_${1}_temp
+
+# Specifcic cases for newphys compilation:
+
+sed -e s/'[mM][oO][dD][uU][lL][eE] '/'MODULE d3_'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'d3_[pP][rR][oO][cC][eE][dD][uU][rR][eE] '/'PROCEDURE '/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'[iI][nN][tT][eE][rR][fF][aA][cC][eE] '/'INTERFACE d3_'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'[eE][nN][dD] INTERFACE d3_'/'END INTERFACE '/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'calltherm_INTERFACE d3_'/'calltherm_interface '/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'meso_inc_'/'d3_meso_inc_'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s+'d3_meso_inc/'+'meso_inc/'+g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'[uU][sS][eE] ioipsl_getincom'/'USE d3_ioipsl_getincom'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'[uU][sS][eE] updaterad'/'USE d3_updaterad'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'PUBLIC :: getin, getin_dump'/'PUBLIC :: d3_getin, d3_getin_dump'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/' getinrs, getinr1d, getinr2d,'/' d3_getinrs, d3_getinr1d, d3_getinr2d,'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/' getinis, getini1d, getini2d,'/' d3_getinis, d3_getini1d, d3_getini2d,'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/' getincs, getinc1d, getinc2d,'/' d3_getincs, d3_getinc1d, d3_getinc2d,'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/' getinls, getinl1d, getinl2d'/' d3_getinls, d3_getinl1d, d3_getinl2d'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg'/'PUBLIC :: d3_ipslnlf, d3_ipslerr, d3_ipslerr_act, d3_ipslerr_inq, d3_histerr, d3_ipsldbg'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'USE ioipsl_errioipsl, ONLY : ipslerr'/'USE d3_ioipsl_errioipsl, ONLY : d3_ipslerr'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'USE ioipsl_stringop'/'USE d3_ioipsl_stringop'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+sed -e s/'ONLY : nocomma,cmpblank,strlowercase'/'ONLY : d3_nocomma,d3_cmpblank,d3_strlowercase'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp
+
+# Functions
+
+case ${1} in 
+   'nlte_aux.F') sed -e s/'iaa_we'/'d3_iaa_we'/g d3_${1}_temp | sed -e s/'simrul'/'d3_simrul'/g | sed -e s/'iaa_f'/'d3_iaa_f'/g | sed -e s/'iaa_fi'/'d3_iaa_fi'/g | sed -e s/'voigtf'/'d3_voigtf'/g | sed -e s/'planckdp'/'d3_planckdp'/g | sed -e s/'we_clean'/'d3_we_clean'/g | sed -e s/'bandid'/'d3_bandid'/g > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp ;;
+   'nlte_tcool.F') sed -e s/'planckdp'/'d3_planckdp'/g d3_${1}_temp | sed -e s/'hrkday_convert'/'d3_hrkday_convert'/g > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp ;;
+   'nlte_calc.F') sed -e s/'bandid'/'d3_bandid'/g d3_${1}_temp > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp ;;
+   'geticecover.F90') sed -e s/'isitice'/'d3_isitice'/g d3_${1}_temp | sed -e s/'splatcrocus'/'d3_splatcrocus'/g | sed -e s/'nplatcrocus'/'d3_nplatcrocus'/g > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp ;;
+   'nuclea.F')  sed -e s/'fshape'/'d3_fshape'/g d3_${1}_temp | sed -e s/'d3_fshapesimple'/'fshapesimple'/g | sed -e s/'zed3_fshape'/'zefshape'/g > d3_${1}_temp2 ; \mv d3_${1}_temp2 d3_${1}_temp ;;
+esac
+# Cleanup
+
+\mv d3_${1}_temp d3_${1}
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/generate4
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/generate4	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/generate4	(revision 2744)
@@ -0,0 +1,40 @@
+# script
+# execute: find * -exec generate2 {} \;
+# change number sed -e s/d2/d3/g generate2 > generate3
+
+sed -e s/'[cC][aA][lL][lL] '/'call d4_'/g ${1} | sed -e s/'call d4_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d4_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d4_'/'firstcall '/g | sed -e s/'lastcall d4_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d4_'/g | sed -e s/'callphys.def'/'callphysd4_.def '/g | sed -e s/'diagfi.nc'/'diagfid4_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d4_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd4_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d4_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d4_"+g | sed -e s+"d4_netcdf.inc"+"netcdf.inc"+g > d4_${1}_temp
+
+# Specifcic cases for newphys compilation:
+
+sed -e s/'[mM][oO][dD][uU][lL][eE] '/'MODULE d4_'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'d4_[pP][rR][oO][cC][eE][dD][uU][rR][eE] '/'PROCEDURE '/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'[iI][nN][tT][eE][rR][fF][aA][cC][eE] '/'INTERFACE d4_'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'[eE][nN][dD] INTERFACE d4_'/'END INTERFACE '/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'calltherm_INTERFACE d4_'/'calltherm_interface '/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'meso_inc_'/'d4_meso_inc_'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s+'d4_meso_inc/'+'meso_inc/'+g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'[uU][sS][eE] ioipsl_getincom'/'USE d4_ioipsl_getincom'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'[uU][sS][eE] updaterad'/'USE d4_updaterad'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'PUBLIC :: getin, getin_dump'/'PUBLIC :: d4_getin, d4_getin_dump'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/' getinrs, getinr1d, getinr2d,'/' d4_getinrs, d4_getinr1d, d4_getinr2d,'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/' getinis, getini1d, getini2d,'/' d4_getinis, d4_getini1d, d4_getini2d,'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/' getincs, getinc1d, getinc2d,'/' d4_getincs, d4_getinc1d, d4_getinc2d,'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/' getinls, getinl1d, getinl2d'/' d4_getinls, d4_getinl1d, d4_getinl2d'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg'/'PUBLIC :: d4_ipslnlf, d4_ipslerr, d4_ipslerr_act, d4_ipslerr_inq, d4_histerr, d4_ipsldbg'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'USE ioipsl_errioipsl, ONLY : ipslerr'/'USE d4_ioipsl_errioipsl, ONLY : d4_ipslerr'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'USE ioipsl_stringop'/'USE d4_ioipsl_stringop'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+sed -e s/'ONLY : nocomma,cmpblank,strlowercase'/'ONLY : d4_nocomma,d4_cmpblank,d4_strlowercase'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp
+
+# Functions
+
+case ${1} in
+   'nlte_aux.F') sed -e s/'iaa_we'/'d4_iaa_we'/g d4_${1}_temp | sed -e s/'simrul'/'d4_simrul'/g | sed -e s/'iaa_f'/'d4_iaa_f'/g | sed -e s/'iaa_fi'/'d4_iaa_fi'/g | sed -e s/'voigtf'/'d4_voigtf'/g | sed -e s/'planckdp'/'d4_planckdp'/g | sed -e s/'we_clean'/'d4_we_clean'/g | sed -e s/'bandid'/'d4_bandid'/g > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp ;;
+   'nlte_tcool.F') sed -e s/'planckdp'/'d4_planckdp'/g d4_${1}_temp | sed -e s/'hrkday_convert'/'d4_hrkday_convert'/g > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp ;;
+   'nlte_calc.F') sed -e s/'bandid'/'d4_bandid'/g d4_${1}_temp > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp ;;
+   'geticecover.F90') sed -e s/'isitice'/'d4_isitice'/g d4_${1}_temp | sed -e s/'splatcrocus'/'d4_splatcrocus'/g | sed -e s/'nplatcrocus'/'d4_nplatcrocus'/g > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp ;;
+   'nuclea.F')  sed -e s/'fshape'/'d4_fshape'/g d4_${1}_temp | sed -e s/'d4_fshapesimple'/'fshapesimple'/g | sed -e s/'zed4_fshape'/'zefshape'/g > d4_${1}_temp2 ; \mv d4_${1}_temp2 d4_${1}_temp ;;
+esac
+
+# Cleanup
+
+\mv d4_${1}_temp d4_${1}
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/grid
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/grid	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/grid	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/grid
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/phy_common
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/phy_common	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/phy_common	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/phy_common
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/phymars
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/phymars	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf/phymars	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/phymars
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/libf_gcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/libf
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm	(revision 2744)
@@ -0,0 +1,803 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+   set optim90=" -fast"
+   set optimtru90=" -fast -c -Mfree "
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+   set opt_link=" -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+  echo "vous pouvez continuer en repondant oui."
+  echo "Voulez-vous vraiment continuer?"
+  if ( $< == "oui" ) then
+    #remove old dimensions.h file
+    \rm $libf/grid/dimensions.h
+  else
+    exit
+  endif
+endif
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=pgf90
+   set f90=pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm.last
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm.last	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm.last	(revision 2744)
@@ -0,0 +1,810 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS.BETA.work
+#setenv LIBOGCM /tmp15/emlmd/test_LMDZ.BETA/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_pgi/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_pgi/include
+#else
+#  setenv NCDFLIB /donnees/emlmd/netcdf-4.0.1_pgi/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf-4.0.1_pgi/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+#   set optim90=" -fast"
+#   set optimtru90=" -fast -c -Mfree "
+   set optim=" -O2 -Munroll -Mcache_align"
+   set optim90=" -O2 -Munroll -Mcache_align"
+   set optimtru90=" -O2 -Munroll -Mcache_align"
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+##   set opt_link=" -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+   set opt_link=" -L$NCDFLIB -lnetcdf -Bstatic"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim="$2" ; set optim90="$2" ; set optimtru90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+  echo "vous pouvez continuer en repondant oui."
+  echo "Voulez-vous vraiment continuer?"
+  if ( $< == "oui" ) then
+    #remove old dimensions.h file
+    \rm -f $libf/grid/dimensions.h
+  else
+    exit
+  endif
+endif
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=pgf90
+   set f90=pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+#if ($code == 'create_etat0' && $VPP) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h                                             
+#     exit                       
+#   endif
+#   set optim90="$optim90"" -X9 -w"
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim="$optim -module $libo"
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_g95
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_g95	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_g95	(revision 2744)
@@ -0,0 +1,831 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+# 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64_g95/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64_g95/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/g95_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/g95_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+d $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+# Ehouarn 'g95' compiler
+   set optim="-O3 -fstatic -funroll-loops -fno-second-underscore -DMESOSCALE"
+   set optim90=" -O3 -fstatic -funroll-loops -fno-second-underscore -DMESOSCALE"
+   set optimtru90=" -O3 -fstatic -funroll-loops -fno-second-underscore -DMESOSCALE"
+## Aymeric : added option for NETCDF libraries
+#   set optim90=" -DMESOSCALE -O2 -fno-second-underscore -fstatic -fzero -Wall
+#   set optimtru90=" -DMESOSCALE -O2 -fno-second-underscore -fstatic -fzero -Wall
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+   set opt_link=" -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+# Ehouarn: add 'g95' string to pathname
+set nomlib=${machine}_g95
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64_g95
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+#        set optim90="$2" ; shift ; shift ; goto top
+        set optim="$2" ; set optim90="$2" ; set optimtru90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+##           set optim90="-g -Mbounds "
+##           set optim90="-mcmodel=medium"
+##         Aymeric : thought I'd complete the g95 debugging 
+#          set optim="$optim"" -g -fbounds-check -DMESOSCALE "
+#          set optim90="$optim90"" -g -fbounds-check -DMESOSCALE "
+#          set optimtru90="$optimtru90"" -g -fbounds-check -DMESOSCALE "
+           ## for g95
+           set optim="-g -Wall -ftrace=full -fbounds-check -DMESOSCALE"
+           set optim90="-g -Wall -ftrace=full -fbounds-check -DMESOSCALE"
+           set optimtru90="-g -Wall -ftrace=full -fbounds-check -DMESOSCALE"
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+./makdim $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+#   set f77=pgf90
+#   set f90=pgf90
+   set f77=g95
+   set f90=g95
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+# Ehouarn : adapt to g95
+ set optim="$optim -fmod=$libo"
+ set optim90="$optim90 -fmod=$libo"
+ set optimtru90="$optimtru90 -fmod=$libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+# cleanup, remove dimensions.h
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_g95.last
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_g95.last	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_g95.last	(revision 2744)
@@ -0,0 +1,812 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS.BETA.work
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+# 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_g95/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_g95/include
+#else
+#  setenv NCDFLIB /donnees/emlmd/netcdf-4.0.1_g95/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf-4.0.1_g95/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+# Ehouarn 'g95' compiler
+   set optim="-O3 -fstatic -funroll-loops "
+   set optim90=" -O3 -fstatic -funroll-loops "
+   set optimtru90=" -O3 -fstatic -funroll-loops "
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+   set opt_link=" -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+# Ehouarn: add 'g95' string to pathname
+set nomlib=${machine}_g95
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64_g95
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim="$2" ; set optim90="$2" ; set optimtru90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+  echo "vous pouvez continuer en repondant oui."
+  echo "Voulez-vous vraiment continuer?"
+  if ( $< == "oui" ) then
+    #remove old dimensions.h file
+    \rm -f $libf/grid/dimensions.h
+  else
+    exit
+  endif
+endif
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+#   set f77=pgf90
+#   set f90=pgf90
+   set f77=g95
+   set f90=g95
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+#if ($code == 'create_etat0' && $VPP) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h                                             
+#     exit                       
+#   endif
+#   set optim90="$optim90"" -X9 -w"
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+# Ehouarn : adapt to g95
+ set optim="$optim -fmod=$libo"
+ set optim90="$optim90 -fmod=$libo"
+ set optimtru90="$optimtru90 -fmod=$libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_ifort
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_ifort	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_ifort	(revision 2744)
@@ -0,0 +1,817 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+# Ehouarn 'ifort' compiler
+   #NB: on gnome -O3 ==> NaNs ...
+   set optim=" -DMESOSCALE -O2 -ip -mkl=sequential -align common "
+   set optim90=" -DMESOSCALE -O2 -ip -mkl=sequential -align common "
+   set optimtru90=" -DMESOSCALE -O2 -ip -mkl=sequential -align common "
+#   set opt_link=" -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+   set mod_loc_dir=$LIBOGCM
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+# Ehouarn: add 'g9fortran' string to pathname
+set nomlib=${machine}
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim="$2" ; set optim90="$2" ; set optimtru90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           ## for ifort
+             set optim=" -DMESOSCALE -g -no-ftz -traceback -ftrapuv -fp-stack-check "
+             set optim90=" -DMESOSCALE -g -no-ftz -traceback -ftrapuv -fp-stack-check "
+             set optimtru90=" -DMESOSCALE -g -no-ftz -traceback -ftrapuv -fp-stack-check "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm -f $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+./makdim $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=ifort
+   set f90=ifort
+   set opt_link=" -L$LIBOGCM -L$NCDFLIB -lnetcdf "
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+#if ($code == 'create_etat0' && $VPP) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h                                             
+#     exit                       
+#   endif
+#   set optim90="$optim90"" -X9 -w"
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+# Ehouarn : adapt to gfortran
+ set optim="$optim -I${libo}"
+ set optim90="$optim90 -I${libo}"
+ set optimtru90="$optimtru90 -ffree-form -I${libo}"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_mpi
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_mpi	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_mpi	(revision 2744)
@@ -0,0 +1,827 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+   ### Aymeric: that could be useless, but user might 
+   ### want to test various mpi at various locations on the disk
+   if ( ! $?WHERE_MPI ) then
+     echo You must initialize the variable WHERE_MPI in your environnement
+     echo for instance: "setenv WHERE_MPI /home/install_mpi/bin" in .cshrc
+     exit
+   endif
+
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+##-Ktrap=fp
+#   set optim90=" -fast -I. -Mlarge_arrays -mcmodel=medium" 
+   set optim=" -DMESOSCALE -O2 -I. -Munroll -Mcache_align" #-C #-fpic" #-Mlarge_arrays -mcmodel=medium
+   set optim90=" -DMESOSCALE -O2 -I. -Munroll -Mcache_align" #-C #-fpic" #-Mlarge_arrays -mcmodel=medium
+## Aymeric: added handling of large arrays and large memory
+## Aymeric: get rid of -Mfree for mpi
+#   set optimtru90=" -fast -c -Mlarge_arrays -mcmodel=medium" 
+  set optimtru90=" -DMESOSCALE -O2 -I. -Munroll -Mcache_align" #-C #-fpic" #-Mlarge_arrays -mcmodel=medium
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+# Aymeric : -Bstatic might need to be removed for mesoscale applications     
+#   set opt_link=" -Mlarge_arrays -mcmodel=medium -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf" # -Bstatic "
+   set opt_link=" -L$NCDFLIB -lnetcdf -Bstatic" #-r" #-fpic" #-Bstatic" #-Mlarge_arrays -mcmodel=medium
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-DMESOSCALE -g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=$WHERE_MPI/mpif90 #pgf90
+   set f90=$WHERE_MPI/mpif90 #pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim="$optim -module $libo"
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_mpifort
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_mpifort	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_mpifort	(revision 2744)
@@ -0,0 +1,818 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+# Ehouarn 'ifort' compiler
+   #NB: on gnome -O3 ==> NaNs ...
+   set optim=" -DMESOSCALE -O2 -ip -mkl=sequential -align common -mcmodel=large -shared-intel"
+   set optim90=" -DMESOSCALE -O2 -ip -mkl=sequential -align common -mcmodel=large -shared-intel"
+   set optimtru90=" -DMESOSCALE -O2 -ip -mkl=sequential -align common -mcmodel=large -shared-intel"
+#   set opt_link=" -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+   set mod_loc_dir=$LIBOGCM
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+# Ehouarn: add 'g9fortran' string to pathname
+set nomlib=${machine}
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim="$2" ; set optim90="$2" ; set optimtru90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           ## for ifort
+             set optim=" -DMESOSCALE -g -no-ftz -traceback -ftrapuv -fp-stack-check -mcmodel=large -shared-intel"
+             set optim90=" -DMESOSCALE -g -no-ftz -traceback -ftrapuv -fp-stack-check -mcmodel=large -shared-intel"
+             set optimtru90=" -DMESOSCALE -g -no-ftz -traceback -ftrapuv -fp-stack-check -mcmodel=large -shared-intel"
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm -f $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+./makdim $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=$WHERE_MPI/mpif90  #ifort
+   set f90=$WHERE_MPI/mpif90  #ifort
+   set opt_link=" -L$LIBOGCM -L$NCDFLIB -lnetcdf "
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+#if ($code == 'create_etat0' && $VPP) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h                                             
+#     exit                       
+#   endif
+#   set optim90="$optim90"" -X9 -w"
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+# Ehouarn : adapt to gfortran
+ set optim="$optim -I${libo}"
+ set optim90="$optim90 -I${libo}"
+# set optimtru90="$optimtru90 -ffree-form -I${libo}"
+  set optimtru90="$optimtru90 -free -I${libo}"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_pgf
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_pgf	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/makegcm_pgf	(revision 2744)
@@ -0,0 +1,816 @@
+#!/bin/csh -f
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+##-Ktrap=fp
+   set optim90=" -DMESOSCALE -fast -I." 
+   set optimtru90=" -DMESOSCALE -fast -c -Mfree" 
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+# Aymeric : -Bstatic might need to be removed for mesoscale applications     
+   set opt_link=" -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+   set mod_loc_dir="" #$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+   ## Aymeric: added handling of large arrays and large memory
+   ## MAIS ATTENTION IL N Y A PAS MESOSCALE !!!!
+   set optim90=" -fast -I. -Mlarge_arrays -mcmodel=medium"
+   set optimtru90=" -fast -c -Mfree -Mlarge_arrays -mcmodel=medium"
+   ## Aymeric : -Bstatic might need to be removed for mesoscale applications     
+   set opt_link=" -Mlarge_arrays -mcmodel=medium -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds -DMESOSCALE "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=pgf90
+   set f90=pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+ set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/assim_aeropacity.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/assim_aeropacity.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/assim_aeropacity.F	(revision 2744)
@@ -0,0 +1,464 @@
+      SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+     &    tauref,tau,aerosol,reffrad,
+     &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+                                                   
+! to use  'getin'
+      USE ioipsl_getincom 
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth in each gridbox.
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   update J.-B. Madeleine 2008-2009:
+c       - added 3D scattering by aerosols;
+c       - dustopacity transferred from physiq.F to callradite.F,
+c           and renamed into aeropacity.F;
+c   
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   zday                  Date (time since Ls=0, in martian days)
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
+c   QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c   omegaREFvis3d(ngridmx,nlayermx,naerkind) \ 3d single scat. albedo
+c   omegaREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL reffrad(ngrid,nlayer,naerkind)
+      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL QREFir3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFir3d(ngridmx,nlayermx,naerkind)
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq,i,j
+      INTEGER iaer           ! Aerosol index
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+      real r0,reff,coefsize
+c     Mean Qext(vis)/Qext(ir) profile
+      real msolsir(nlayermx,naerkind)
+c     Mean Qext(ir)/Qabs(ir) profile
+      real mqextsqabs(nlayermx,naerkind)
+c     Variables used when multiple particle sizes are used
+c       for dust or water ice particles in the radiative transfer
+c       (see callradite.F for more information).
+      REAL taudusttmp(ngridmx)! Temporary dust opacity
+                               !   used before scaling
+      REAL taudustvis(ngridmx) ! Dust opacity after scaling
+      REAL taudusttes(ngridmx) ! Dust opacity at IR ref. wav. as
+                               !   "seen" by the GCM.
+      REAL taucloudvis(ngridmx)! Cloud opacity at visible
+                               !   reference wavelength
+      REAL taucloudtes(ngridmx)! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+! indexes of water ice and dust tracers:
+      INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: tracername ! to temporarly store text
+
+      call zerophys(ngrid*naerkind,tau)
+
+! identify tracers
+
+      IF (firstcall) THEN
+        ! identify tracers which are dust
+        i=0
+        DO iq=1,nq
+          tracername=noms(iq)
+          IF (tracername(1:4).eq."dust") THEN
+          i=i+1
+          nqdust(i)=iq
+          ENDIF
+        ENDDO
+
+        IF (water.AND.activice) THEN
+          i_ice=igcm_h2o_ice
+          write(*,*) "aeropacity: i_ice=",i_ice
+        ENDIF
+
+c       altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c       in the Viking year scenario
+        DO ig=1,ngrid
+            topdust0(ig)=60. -22.*SIN(lati(ig))**2
+        END DO
+
+c       typical profile of solsir and (1-w)^(-1):
+        call zerophys(nlayer*naerkind,msolsir)
+        call zerophys(nlayer*naerkind,mqextsqabs)
+        WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+        DO iaer = 1, naerkind ! Loop on aerosol kind
+          WRITE(*,*) "Aerosol # ",iaer
+          DO l=1,nlayer
+            DO ig=1,ngridmx
+              msolsir(l,iaer)=msolsir(l,iaer)+
+     &              QREFvis3d(ig,l,iaer)/
+     &              QREFir3d(ig,l,iaer)
+              mqextsqabs(l,iaer)=mqextsqabs(l,iaer)+
+     &              (1.E0-omegaREFir3d(ig,l,iaer))**(-1)
+            ENDDO
+            msolsir(l,iaer)=msolsir(l,iaer)/REAL(ngridmx)
+            mqextsqabs(l,iaer)=mqextsqabs(l,iaer)/REAL(ngridmx)
+          ENDDO
+          WRITE(*,*) "solsir: ",msolsir(:,iaer)
+          WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
+        ENDDO
+
+!       load value of tauvis from callphys.def (if given there,
+!       otherwise default value read from starfi.nc file will be used)
+        call getin("tauvis",tauvis)
+
+        firstcall=.false.
+
+      END IF
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind: SELECT CASE (iaer)
+c==================================================================
+        CASE(1) aerkind                             ! Dust (iaer=1)
+c==================================================================
+
+c  -------------------------------------------------------------
+c     1) Prescribed dust  (if tracer=F or active=F)
+c  -------------------------------------------------------------
+      IF ((.not.tracer) .or. (.not.active)) THEN 
+
+c       Vertical column optical depth at 700.Pa 
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        IF(iaervar.eq.1) THEN 
+           do ig=1, ngridmx
+            tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
+                                         ! or read in starfi
+          end do
+        ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+          tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+          do ig=2,ngrid
+            tauref(ig) = tauref(1)
+          end do
+
+        ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+           taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+           tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+           tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+           do ig=1,ngrid/2  ! Northern hemisphere
+             tauref(ig)= tauN +
+     &       (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+           end do
+           do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+             tauref(ig)= tauS +
+     &       (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+           end do
+
+        ELSE IF ((iaervar.eq.4).or.
+     &           ((iaervar.ge.24).and.(iaervar.le.26)))
+     &       THEN  ! << "TES assimilated dust scenarios >>
+           call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+        ELSE IF (iaervar.eq.5) THEN   ! << Escalier Scenario>>
+c         tauref(1) = 0.2
+c         if ((ls.ge.210.*pi/180.).and.(ls.le.330.*pi/180.))
+c    &                              tauref(1) = 2.5
+          tauref(1) = 2.5
+          if ((ls.ge.30.*pi/180.).and.(ls.le.150.*pi/180.))
+     &                              tauref(1) = .2
+          do ig=2,ngrid
+            tauref(ig) = tauref(1)
+          end do
+
+        ELSE IF (iaervar.gt.99) THEN  ! << input netcdf file >>
+c*************WRF
+c
+c 2. customized dust opacity field
+c   ex: from assimilation
+       call meso_readtesassim(ngrid,nlayer,zday,pplev,tauref,
+     . iaervar)
+c
+c*************WRF
+
+        ELSE
+          stop 'problem with iaervar in aeropacity.F'
+        ENDIF
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          end do
+        endif
+
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+          expfactor=0.
+          CALL zerophys(ngrid,taudusttmp)
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c             Typical mixing ratio profile 
+              if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+                expfactor=1.e-3
+              endif
+c             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+     &          expfactor *
+     &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+c             Scaling factor
+              taudusttmp(ig)=taudusttmp(ig)+aerosol(ig,l,iaer)
+            ENDDO
+          ENDDO
+
+c         Rescaling each layer to reproduce the choosen (or
+c           assimilated) dust extinction opacity at visible
+c           reference wavelength, which is originally scaled
+c           to an equivalent 700Pa pressure surface.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              aerosol(ig,l,iaer) = tauref(ig) *
+     &                     pplev(ig,1) / 700.E0 *
+     &                     aerosol(ig,l,iaer) / taudusttmp(ig)
+            ENDDO
+          ENDDO
+
+          CALL zerophys(ngrid,taudustvis)
+          CALL zerophys(ngrid,taudusttes)
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              taudustvis(ig) = taudustvis(ig) + aerosol(ig,l,iaer)
+              taudusttes(ig) = taudusttes(ig) + aerosol(ig,l,iaer)*
+     &          QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer)*
+     &          ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+            ENDDO
+          ENDDO
+
+c         Outputs
+          IF (ngrid.NE.1) THEN
+            CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR',
+     &        ' ',2,taudusttes)
+            CALL wstats(ngridmx,'taudustTES','dust abs IR',
+     &        ' ',2,taudusttes)
+          ELSE
+            CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU')
+          ENDIF
+
+c     changement dans le calcul de la distribution verticale          
+c     dans le cas des scenarios de poussieres assimiles
+c        if (iaervar.eq.4) THEN  ! TES
+c        call zerophys(ngrid*naerkind,tau)
+c
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c                tau(ig,1)=tau(ig,1)+ aerosol(ig,l,1)
+c           end do
+c        end do
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c               aerosol(ig,l,1)=aerosol(ig,l,1)*tauref(ig)/tau(ig,1)
+c     $     *(pplev(ig,1)/700)
+c           end do
+c        end do
+c        endif
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c  ---------------------------------------------------------------------
+c     2) Transported radiatively active dust  (if tracer=T and active=T)
+c ----------------------------------------------------------------------
+      ELSE  IF ((tracer) .and. (active)) THEN 
+c     The dust opacity is computed from q
+
+c     a) "doubleq" technique (transport of mass and number mixing ratio)
+c        ~~~~~~~~~~~~~~~~~~~
+       if(doubleq) then 
+
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+
+c        Computing effective radius :
+         do  l=1,nlayer
+           do ig=1, ngrid
+              r0=
+     &        (r3n_q*pq(ig,l,1)/max(pq(ig,l,2),0.01))**(1./3.)
+              r0=min(max(r0,1.e-10),500.e-6)
+              reff= ref_r0 * r0
+cc           If  reff is small, the transported dust mean Qext
+c            is reduced from the reference dust Qext by a factor "coefsize"
+
+             coefsize=min(max(2.52e6*reff-0.043 ,0.)   ,1.)
+
+cc              It is added 1.e-8 to pq to avoid low
+
+                aerosol(ig,l,1)=aerosol(ig,l,1)+ 1.E-8 +
+     &         ( 0.75*Qext(1)*coefsize/(rho_dust*reff))
+     &          * (pq(ig,l,nqdust(1)))*
+c               only one dust bin to use with doubleq
+     &          (pplev(ig,l)-pplev(ig,l+1))/g
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+
+c     b) Size bin technique (each aerosol can contribute to opacity))
+c        ~~~~~~~~~~~~~~~~~~
+       else
+c        The dust opacity is computed from q
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         do iq=1,dustbin
+           do l=1,nlayer
+              do ig=1,ngrid
+cc               qextrhor(iq) is  (3/4)*Qext/(rho*reff)
+cc               It is added 1.e-8 to pq to avoid low
+                 aerosol(ig,l,1)=aerosol(ig,l,1)+
+     &           qextrhor(nqdust(iq))*(pq(ig,l,nqdust(iq))+1.e-8)*
+     &           (pplev(ig,l)-pplev(ig,l+1))/g
+              end do
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+       end if  ! (doubleq)
+      END IF   ! (dust scenario)
+
+
+c==================================================================
+        CASE(2) aerkind               ! Water ice crystals (iaer=2)
+c==================================================================
+
+      IF (water.AND.activice) THEN
+c       1. Initialization
+        CALL zerophys(ngrid*nlayer,aerosol(1,1,iaer))
+        CALL zerophys(ngrid,taucloudvis)
+        CALL zerophys(ngrid,taucloudtes)
+c       2. Opacity calculation
+        DO ig=1, ngrid
+          DO l=1,nlayer
+            aerosol(ig,l,iaer) =
+     &        (  0.75 * QREFvis3d(ig,l,iaer) /
+     &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+     &        ( pq(ig,l,i_ice) + 1.E-8 ) *
+     &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+            taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+            taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+     &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+     &        ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+          ENDDO
+        ENDDO
+c       3. Outputs
+        IF (ngrid.NE.1) THEN
+          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+          CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+        ELSE
+          CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+        ENDIF
+      ENDIF
+
+c==================================================================
+        END SELECT aerkind
+
+c -----------------------------------------------------------------
+c Column integrated visible optical depth in each point
+c -----------------------------------------------------------------
+
+      do l=1,nlayer
+         do ig=1,ngrid
+               tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+         end do
+      end do
+
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+      return
+      end 
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/assim_readtesassim.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/assim_readtesassim.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/assim_readtesassim.F90	(revision 2744)
@@ -0,0 +1,306 @@
+subroutine meso_readtesassim(ngrid,nlayer,zday,pplev,tauref,day_translate)
+
+! Reading of the dust assimilation file
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "comgeomfi.h"
+include "netcdf.inc"
+include "datafile.h"
+
+integer, intent(in) :: ngrid,nlayer
+real, intent(in) :: zday ! date in martian days
+real, dimension(ngrid,nlayer+1), intent(in) :: pplev
+real, dimension(ngrid), intent(out) :: tauref
+
+! Local variables
+
+real :: realday
+integer nid,nvarid,ierr
+integer ltloop,lsloop,iloop,jloop,varloop,ig
+real, dimension(2) :: taubuf
+real tau1(4),tau
+real alt(4)
+integer latp(4),lonp(4)
+integer yinf,ysup,xinf,xsup,tinf,tsup
+real latinf,latsup,loninf,lonsup
+real latintmp,lonintmp,latdeg,londeg
+real colat,dlat,dlon,colattmp
+logical, save :: firstcall=.true.
+logical :: timeflag
+real radeg,pi
+integer :: timedim,londim,latdim
+real, dimension(:), allocatable, save :: lat,lon,time
+real, dimension(:,:,:), allocatable, save :: tautes
+integer, save :: timelen,lonlen,latlen
+INTEGER, external:: lnblnk
+
+!!WRF added
+INTEGER :: day_translate 
+
+pi=acos(-1.)
+radeg=180/pi
+realday=mod(zday,669.)
+
+if (firstcall) then
+   firstcall=.false.
+
+   !! Note: datafile() is defined in "datafile.h"
+   !print *,datafile(1:lnblnk(datafile))
+   !ierr=NF_OPEN (datafile(1:lnblnk(datafile))//"/input_totoptdep.nc",NF_NOWRITE,nid)
+
+!!-------------------------------------
+!! iaervar is used here to communicate the day starting the diagfi
+!! -- in addition, inpu_totoptdep.nc must be prepared
+day_translate=day_translate-1000
+ierr=NF_OPEN ("./input_totoptdep.nc",NF_NOWRITE,nid)
+!!-------------------------------------
+
+
+   IF (ierr.NE.NF_NOERR) THEN
+     !write(*,*)'Problem opening dust.nc (in phymars/readtesassim.F90)'
+     !write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+     !write(*,*)'1) You can change this directory address in '
+     !write(*,*)'   file phymars/datafile.h'
+     !write(*,*)'2) If necessary, dust.nc (and other datafiles)'
+     !write(*,*)'   can be obtained online on:'
+     !write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+     write(*,*)'Problem opening input_totoptdep.nc ...'
+     CALL ABORT
+   ENDIF
+
+   ierr=NF_INQ_DIMID(nid,"time",timedim)
+   ierr=NF_INQ_DIMLEN(nid,timedim,timelen)
+   ierr=NF_INQ_DIMID(nid,"lat",latdim)
+   ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+   ierr=NF_INQ_DIMID(nid,"lon",londim)
+   ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
+
+   allocate(tautes(lonlen,latlen,timelen))
+   allocate(lat(latlen), lon(lonlen), time(timelen))
+
+   ierr = NF_INQ_VARID (nid, "totoptdep",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tautes)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, tautes)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <totoptdep> not found"
+      stop
+   ENDIF
+
+!!****WRF
+!! diagfi files feature the dust opacity divided by 700 Pa
+        tautes=tautes*700.
+!!****WRF
+
+
+   ierr = NF_INQ_VARID (nid, "time",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, time)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <Time> not found"
+      stop
+   ENDIF
+
+!!****WRF
+PRINT *, "**** read assimilation dust"
+PRINT *, "prescribed starting day ...", day_translate
+time=time+day_translate
+!!****WRF
+
+   ierr = NF_INQ_VARID (nid, "lat",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lat)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lat)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <latitude> not found"
+      stop
+   ENDIF
+
+   ierr = NF_INQ_VARID (nid, "lon",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lon)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lon)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <longitude> not found"
+      stop
+   ENDIF
+
+endif ! of if (firstcall)
+
+do ig=1,ngrid
+
+! Find the four nearest points, arranged as follows:
+!                               1 2
+!                               3 4
+
+   latdeg=lati(ig)*radeg  ! latitude, in degrees
+   londeg=long(ig)*radeg  ! longitude, in degrees east
+   colat=90-latdeg        ! colatitude, in degrees
+
+ ! Find encompassing latitudes
+   if (colat<(90-lat(1))) then ! between north pole and lat(1)
+      ysup=1
+      yinf=1
+   else if (colat>=90-(lat(latlen))) then ! between south pole and lat(laten)
+      ysup=latlen
+      yinf=latlen
+   else ! general case
+      do iloop=2,latlen
+         if(colat<(90-lat(iloop))) then
+           ysup=iloop-1
+           yinf=iloop
+           exit
+         endif
+      enddo
+   endif
+
+   latinf=lat(yinf)
+   latsup=lat(ysup)
+
+
+ ! Find encompassing longitudes
+   ! Note: in input file, lon(1)=-180.
+   if (londeg>lon(lonlen)) then
+      xsup=1
+      xinf=lonlen
+      loninf=lon(xsup)
+      lonsup=180.0 ! since lon(1)=-180.0
+   else
+      do iloop=2,lonlen
+         if(londeg<lon(iloop)) then
+              xsup=iloop
+              xinf=iloop-1
+              exit
+         endif
+      enddo
+      loninf=lon(xinf)
+      lonsup=lon(xsup)
+   endif
+
+   if ((xsup.gt.lonlen).OR.(yinf.gt.latlen).OR.(xinf.lt.1)&
+     .OR.(ysup.lt.1)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on x or y in ts_gcm"
+      write (*,*) "xinf: ",xinf
+      write (*,*) "xsup: ",xsup
+      write (*,*) "yinf: ",yinf
+      write (*,*) "ysup: ",ysup
+      stop
+   endif
+
+!   loninf=lon(xinf)
+!   lonsup=lon(xsup)
+!   latinf=lat(yinf)
+!   latsup=lat(ysup)
+
+! The four neighbouring points are arranged as follows:
+!                               1 2
+!                               3 4
+
+   latp(1)=ysup
+   latp(2)=ysup
+   latp(3)=yinf
+   latp(4)=yinf
+
+   lonp(1)=xinf
+   lonp(2)=xsup
+   lonp(3)=xinf
+   lonp(4)=xsup
+
+! Linear interpolation on time, for all four neighbouring points
+
+   if ((realday<time(1)).or.(realday>time(timelen))) then
+      tinf=timelen
+      tsup=1
+      timeflag=.true.
+   else 
+      do iloop=2,timelen
+         if (realday<time(iloop)) then
+            tinf=iloop-1
+            tsup=iloop
+            exit
+         endif
+      enddo
+   endif
+
+! Bilinear interpolation on the four nearest points
+
+   if ((colat<(90-lat(1))).OR.(colat>(90-lat(latlen))).OR.(latsup==latinf)) then
+      dlat=0
+   else
+      dlat=((90-latinf)-colat)/((90-latinf)-(90-latsup))
+   endif
+
+   if (lonsup==loninf) then
+      dlon=0
+   else
+      dlon=(londeg-loninf)/(lonsup-loninf)
+   endif
+
+   do iloop=1,4
+      taubuf(1)=tautes(lonp(iloop),latp(iloop),tinf)
+      taubuf(2)=tautes(lonp(iloop),latp(iloop),tsup)
+      if (timeflag) then
+         if (realday>time(timelen)) then
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)+(669-time(tinf))) 
+         else
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*realday/(time(tsup)+(669-time(tinf)))
+         endif
+      else
+         tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)-time(tinf))
+      endif
+      if (tau1(iloop)<0) then
+          write (*,*) "Readtesassim: SYSTEM ERROR on tau"
+          write (*,*) "utime ",realday
+          write (*,*) "time(tinf) ",time(tinf)
+          write (*,*) "time(tsup) ",time(tsup)
+          write (*,*) "tau1 ",taubuf(1)
+          write (*,*) "tau2 ",taubuf(2)
+          write (*,*) "tau ",tau1(iloop)
+          stop
+      endif
+   enddo
+   timeflag=.false.
+
+   if ((dlat>1).OR.(dlon>1) .OR. (dlat<0) .OR. (dlon<0)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on dlat or dlon in ts_gcm"
+      write (*,*) "dlat: ",dlat
+      write (*,*) "lat: ",latdeg
+      write (*,*) "dlon: ",dlon
+      write (*,*) "lon: ",londeg
+      stop
+   endif
+
+   tau= dlat*(dlon*(tau1(2)+tau1(3)-tau1(1)-tau1(4))+tau1(1)-tau1(3)) +dlon*(tau1(4)-tau1(3))+tau1(3)
+
+!!   tauref(ig)=tau*700/pplev(ig,1)*0.8
+    tauref(ig)=tau*0.825
+
+!-------------
+! from Oxford
+!-------------
+! + tuning ... TES is little bit too hot compared to radio-occultations 
+! 0.825 is the MY24 value
+!tauref(ig)=tau*700.*0.825
+!tauref(ig)=tau*700.
+!tauref(ig)=tau*700.*1.2
+!tauref(ig)=tau*700.*0.6
+!-------------------------------------------------
+! NB: multiply by 700. is now done elsewhere
+!-------------------------------------------------
+
+
+enddo
+
+end
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/diff_w_phys.sh
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/diff_w_phys.sh	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/diff_w_phys.sh	(revision 2744)
@@ -0,0 +1,21 @@
+#! /bin/bash
+
+
+logfile="diff_meso_gcm.log"
+wheregcm=$1
+
+\rm $logfile
+touch $logfile
+#echo '***** meso_inifis.F' >> $logfile
+diff ./meso_inifis.F      $1/inifis.F          >> $logfile
+#echo '***** meso_callkeys.h' >> $logfile 
+diff ./meso_callkeys.h    $1/callkeys.h        >> $logfile
+#echo '***** meso_dustlift.F' >> $logfile
+#diff ./meso_dustlift.F    $1/dustlift.F   >> $logfile
+#echo '***** meso_inifis.F' >> $logfile
+diff ./meso_inifis.F      $1/inifis.F          >> $logfile
+#echo '***** meso_newcondens.F' >> $logfile
+diff ./meso_newcondens.F  $1/newcondens.F      >> $logfile
+#echo '***** meso_physiq.F' >> $logfile
+diff ./meso_physiq.F      $1/physiq.F          >> $logfile
+diff ./meso_testphys1d.F  $1/testphys1d.F      >> $logfile
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/newgcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/newgcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/newgcm	(revision 2744)
@@ -0,0 +1,1 @@
+link /u/emlmd/LMDZ.MARS.BETA/libf/phymars
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/oldgcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/oldgcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/oldgcm	(revision 2744)
@@ -0,0 +1,1 @@
+link /donnees/aslmd/MODELES/WORKMODELS/LMDZ.MARS/libf/phymars
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/oldmeso
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/oldmeso	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/oldmeso	(revision 2744)
@@ -0,0 +1,1 @@
+link /donnees/aslmd/SVN/trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new/libf/phymars
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/param_slope_full.F90
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/param_slope_full.F90	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/param_slope_full.F90	(revision 2744)
@@ -0,0 +1,248 @@
+SUBROUTINE param_slope_full( &
+  !
+  ! INPUTS
+  !
+               &  ls, localtime, latitude, taudust, albedo  &
+               &  ,theta_s, psi_s &
+               &  ,ftot_0  &
+  !
+  ! OUTPUTS
+  !
+               &  ,ftot &
+ )
+
+
+!!*****************************************************************************************
+!
+! SUBROUTINE:
+! param_slope
+! 
+!
+! PURPOSE: 
+! computes total solar irradiance on a given Martian slope 
+!
+!
+! INPUTS:
+! ls	 	aerocentric longitude (deg)
+! localtime	local true solar time (Martian hours)
+! latitude  	latitude (deg)
+! taudust	dust optical depth at reference wavelength 0.67 mic. 
+! albedo	spectrally integrated surface Lambertian reflection albedo 
+! theta_s	slope inclination angle (deg)
+!			0 is horizontal, 90 is vertical
+! phi_s		slope azimuth (deg) 
+!       		0 >> Northward
+!       		90 >> Eastward
+!       		180 >> Southward
+!       		270 >> Westward
+! ftot_0	spectrally integrated total irradiance on an horizontal surface (W/m2)
+!
+!
+! OUTPUTS:
+! ftot		spectrally integrated total irradiance on the slope (W/m2)
+!
+! REFERENCE: 
+! "Fast and accurate estimation of irradiance on Martian slopes"
+! A. Spiga & F. Forget
+! .....
+!
+! AUTHOR: 
+! A. Spiga (spiga@lmd.jussieu.fr)
+! March 2008
+!
+!!*****************************************************************************************
+
+IMPLICIT NONE
+
+!!
+!! INPUT
+!!
+REAL, INTENT(IN) :: ls, localtime, latitude, taudust, theta_s, psi_s, albedo, ftot_0  
+
+!!
+!! LOCAL
+!!
+REAL :: pi, deg2rad, dist_sol, cste_mars
+REAL, PARAMETER :: p = 1.510404          ! Semi-latus rectum of Martian elliptic orbit (AU)
+REAL, PARAMETER :: e = 9.3357898E-02     ! Eccentricity of Martian elliptic orbit
+REAL, PARAMETER :: t = 1.908231          ! Angle from Ls=0 to the perihelion (radian)
+REAL, PARAMETER :: so = 0.4256214        ! sin(Obliquity of Martian axis) 
+REAL :: rho, sdec, dec, cdec, csza, sza, ssza, psi0 
+REAL :: px, py
+REAL :: a
+REAL :: mu_s, sigma_s
+REAL :: fdir, fdir_0, fscat, fscat_0, fref
+REAL, DIMENSION(4,2) :: mat_M, mat_N, mat_T
+REAL, DIMENSION(2) :: g_vector
+REAL, DIMENSION(4) :: s_vector
+REAL :: ratio
+
+!!
+!! OUTPUT
+!!
+REAL, INTENT(OUT) :: ftot
+
+!!*****************************************************************************************
+
+!
+! Prerequisite
+!
+  pi = 2.*asin(1.)
+  deg2rad = pi/180.
+  if ((theta_s > 90.) .or. (theta_s < 0.)) then
+	print *, 'please set theta_s between 0 and 90', theta_s
+	stop 
+  endif
+
+!
+! Sun right ascension (radian)
+!
+  rho = pi*(1.0-localtime/12.0)
+
+!
+! Distance to sun (AU)
+!
+  dist_sol = p/(1.0+e*cos(deg2rad*Ls+t))   !! ellipse polar equation 
+ 
+!
+! Incident flux @ top of the atmosphere (Mars solar constant, W m-2)
+!
+  cste_mars=1370./(dist_sol*dist_sol)      !! 1370 W.m-2 is the solar constant at 1 AU.
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! pour comparer avec spectres ESA
+!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!cste_mars=cste_mars*0.92
+
+
+!
+! Sun declination (radian) [= subsolar point latitude]
+!
+  sdec = sin(deg2rad*Ls)*so
+  dec = asin(sdec)  
+  cdec = cos(dec)
+
+!
+! Solar Zenith angle (radian) 
+!
+  csza = sin(deg2rad*latitude)*sdec + cos(deg2rad*latitude)*cdec*cos(rho)
+  sza = acos(csza)
+  ssza = sin(sza)
+  if (csza < 0.01) then
+      !print *, 'sun below horizon' 
+      fdir_0=0.
+      fdir=0.
+      fscat_0=0.
+      fscat=0.   
+      fref=0.
+  else      
+
+!
+! 'Slope vs Sun' azimuth (radian)
+!
+  if ( ( (cdec*sin(rho)) .eq. 0.0 ) .and. ( ( sin(deg2rad*latitude)*cdec*cos(rho)-cos(deg2rad*latitude)*sdec ) .eq. 0.0 ) ) then
+    a = deg2rad*psi_s ! some compilator need specfying value for atan2(0,0)  
+  else
+    a = deg2rad*psi_s + atan2(cdec*sin(rho),sin(deg2rad*latitude)*cdec*cos(rho)-cos(deg2rad*latitude)*sdec)
+  end if
+  
+!
+! Cosine of slope-sun phase angle 
+!
+  mu_s = csza*cos(deg2rad*theta_s) - cos(a)*sin(deg2rad*theta_s)*sqrt(1-csza**2)
+  if (mu_s .le. 0.) mu_s=0.
+
+!
+! Sky-view factor
+!
+  sigma_s=0.5*(1.+cos(deg2rad*theta_s))
+
+!
+! Direct flux on a flat surface
+!
+  fdir_0 = cste_mars*csza*exp(-taudust/csza)
+
+!
+! Direct flux on the slope
+!
+  fdir = fdir_0 * mu_s/csza
+
+!
+! Reflected flux on the slope
+!
+  fref = albedo * (1-sigma_s) * ftot_0
+
+!
+! Scattered flux on a flat surface
+!
+  fscat_0 = ftot_0 - fdir_0
+
+!
+! Scattering vector (slope vs sky)
+!
+  s_vector=(/ 1., exp(-taudust) , sin(deg2rad*theta_s), sin(deg2rad*theta_s)*exp(-taudust) /)
+
+!
+! Geometry vector (slope vs sun)
+!
+  g_vector=(/ mu_s/csza, 1. /)
+
+!
+! Coupling matrix
+!
+  if (csza .ge. 0.5) then
+	mat_M(:,1) = (/ -0.264,  1.309,  0.208, -0.828 /)
+	mat_M(:,2) = (/  1.291*sigma_s, -1.371*sigma_s, -0.581,  1.641 /)
+	mat_N(:,1) = (/  0.911, -0.777, -0.223,  0.623 /)
+	mat_N(:,2) = (/ -0.933*sigma_s,  0.822*sigma_s,  0.514, -1.195 /)
+
+  else
+	mat_M(:,1) = (/ -0.373,  0.792, -0.095,  0.398 /)
+	mat_M(:,2) = (/  1.389*sigma_s, -0.794*sigma_s, -0.325,  0.183 /)
+	mat_N(:,1) = (/  1.079,  0.275,  0.419, -1.855 /)
+	mat_N(:,2) = (/ -1.076*sigma_s, -0.357*sigma_s, -0.075,  1.844 /)
+  endif
+  !
+  mat_T = mat_M + csza*mat_N
+
+
+!
+! Scattered flux slope ratio
+!
+  if (deg2rad*theta_s <= 0.0872664626) then
+  !
+  ! low angles
+  !
+	s_vector = (/ 1., exp(-taudust) , sin(0.0872664626), sin(0.0872664626)*exp(-taudust) /)
+	ratio = DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )
+        ratio = 1. + (ratio - 1.)*deg2rad*theta_s/0.0872664626
+  else
+  !
+  ! general case
+  !
+	ratio= DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )  
+                  !
+                  ! NB: ratio= DOT_PRODUCT ( s_vector, MATMUL( mat_T, g_vector ) ) is equivalent
+  endif
+
+!
+! Scattered flux on the slope
+!
+  fscat = ratio * fscat_0
+
+endif !! if (csza < 0.01)
+
+!
+! Total flux on the slope
+!
+  ftot = fdir + fref + fscat
+
+!!
+!! Display results
+!!
+!  print *, 'scattered component ', fscat
+!  print *, 'direct component ', fdir
+!  print *, 'reflected component ', fref
+
+END SUBROUTINE param_slope_full
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/pour_patcher.txt
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/pour_patcher.txt	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_new/tools_compgcm/pour_patcher.txt	(revision 2744)
@@ -0,0 +1,73 @@
+
+****************************************************
+****************************************************
+****************************************************
+****************************************************
+
+
+1. easy part
+diff3 --easy-only --merge oldmeso/meso_physiq.F oldgcm/physiq.F newgcm/physiq.F > meso_physiq.F
+
+2. check quand mm
+vimdiff meso_physiq.F oldmeso/meso_physiq.F
+
+3. reperer conflits
+diff3 --overlap-only meso_physiq.F oldgcm/physiq.F newgcm/physiq.F | more
+--> les lignes sont celles de meso_physiq.F [nouveau fichier]
+[ou] diff3 --show-overlap meso_physiq.F oldgcm/physiq.F newgcm/physiq.F
+
+3bis. reperer conflits
+diff3 --overlap-only --merge meso_physiq.F oldgcm/physiq.F newgcm/physiq.F > dummy
+vimdiff meso_physiq.F dummy
+-- si dummy est OK, alors mv dummy meso_physiq.F
+-- si dummy pas bon, alors n'incorporer que les changements pertinents dans meso_physiq.F
+[ou alors si vous soupconnez l'inverse]
+vimdiff dummy meso_inifis.F
+
+
+4. verifier que les changements sont que mesoscale
+vimdiff meso_physiq.F newgcm/physiq.F
+
+
+
+****************************************************
+****************************************************
+****************************************************
+****************************************************
+****************************************************
+
+
+diff3 --easy-only --merge oldmeso_inifis.F oldgcm_inifis.F newgcm_inifis.F > yeyeye
+diff3 --overlap-only yeyeye oldgcm_inifis.F newgcm_inifis.F
+diff3 --overlap-only --merge yeyeye oldgcm_inifis.F newgcm_inifis.F > yeyeye2
+mv yeyeye2 newmeso_inifis.F
+vimdiff newmeso_inifis.F newgcm_inifis.F [verifier que les changements sont que mesoechelle]
+
+
+
+
+
+
+
+
+
+
+ON VEUT METTRE A JOUR LA PHYSIQUE DU MESO-ECHELLE
+
+1. ancienne version meso
+cp /donnees/aslmd/SVN/trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new/libf/phymars/meso_inifis.F .
+
+2. nouvelle version GCM
+cp /u/emlmd/LMDZ.MARS.BETA/libf/phymars/inifis.F .
+
+3. evaluer differences
+\diff -u meso_inifis.F inifis.F > inifis.patch
+
+4. nettoyer inifis.patch en enlevant les changements meso-echelle
+
+5. mettre a jour meso_inifis.F
+patch meso_inifis.F inifis.patch
+
+6. menage 
+\rm inifis.patch inifis.F
+
Index: trunk/WRF.COMMON/WRFV2/mars_lmd_save
===================================================================
--- trunk/WRF.COMMON/WRFV2/mars_lmd_save	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/mars_lmd_save	(revision 2744)
@@ -0,0 +1,1 @@
+cp -rf mars_lmd* save/
Index: trunk/WRF.COMMON/WRFV2/meso_callkeys.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/meso_callkeys.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/meso_callkeys.h	(revision 2744)
@@ -0,0 +1,54 @@
+      COMMON/callkeys/callrad,calldifv,calladj,callcond,callsoil,
+     s   season,diurnal,iradia,lwrite,calllott
+     s   ,iaervar,iddist,topdustref,callstats,calleofdump
+     s   ,callnirco2,callnlte,callthermos,callconduct,
+     s        calleuv,callmolvis,callmoldiff,thermochem
+     .   , solarcondate, thermoswater
+     .   , semi
+     .   , callemis
+     .   , callg2d
+     .   , linear
+     .   , ilwd
+     .   , ilwb
+     .   , ilwn
+     .   , ncouche
+     .   , alphan
+     .   , rayleigh
+     .   , tracer
+     .   , dustbin,active,doubleq,lifting,callddevil,scavenging
+     .   , sedimentation,iceparty,activice,water,caps
+     .   , photochem,nqchem_min
+     .   , tituscap
+
+      LOGICAL callrad,calldifv,calladj,callcond,callsoil,
+     s   season,diurnal,lwrite,calllott
+     s   ,callstats,calleofdump
+     s   ,callnirco2,callnlte,callthermos,callconduct,
+     s    calleuv,callmolvis,callmoldiff,thermochem,thermoswater
+     s   ,tituscap
+
+      logical callemis
+      logical callg2d
+      logical linear
+
+      real topdustref
+      real semi
+      real alphan
+      real solarcondate
+
+      integer ecri_phys 	
+      integer iddist
+      integer iaervar
+      integer iradia
+      integer ilwd
+      integer ilwb
+      integer ilwn
+      integer ncouche
+
+      logical rayleigh
+      logical tracer
+      integer dustbin
+      logical active,doubleq,lifting,callddevil,scavenging
+      logical sedimentation,iceparty,activice,water,caps
+      logical photochem
+      integer nqchem_min
Index: trunk/WRF.COMMON/WRFV2/meso_callkeys_newphys.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/meso_callkeys_newphys.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/meso_callkeys_newphys.h	(revision 2744)
@@ -0,0 +1,63 @@
+!
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+!
+      COMMON/callkeys/callrad,calldifv,calladj,callcond,callsoil,       &
+     &   season,diurnal,iradia,lwrite,calllott                          &
+     &   ,iaervar,iddist,topdustref,callstats,calleofdump               &
+     &   ,callnirco2,callnlte,callthermos,callconduct,                  &
+     &        calleuv,callmolvis,callmoldiff,thermochem                 &
+     &   , solarcondate, thermoswater                                   &
+     &   , semi                                                         &
+     &   , callemis                                                     &
+     &   , callg2d                                                      &
+     &   , linear                                                       &
+     &   , ilwd                                                         &
+     &   , ilwb                                                         &
+     &   , ilwn                                                         &
+     &   , ncouche                                                      &
+     &   , alphan                                                       &
+     &   , rayleigh                                                     &
+     &   , tracer                                                       &
+     &   , dustbin,active,doubleq,lifting,callddevil,scavenging         &
+     &   , sedimentation,activice,water,caps                            &
+     &   , photochem,nqchem_min                                         
+
+      LOGICAL callrad,calldifv,calladj,callcond,callsoil,               &
+     &   season,diurnal,lwrite,calllott                                 &
+     &   ,callstats,calleofdump                                         &
+     &   ,callnirco2,callnlte,callthermos,callconduct,                  &
+     &    calleuv,callmolvis,callmoldiff,thermochem,thermoswater
+
+
+      logical callemis
+      logical callg2d
+      logical linear
+
+      real topdustref
+      real semi
+      real alphan
+      real solarcondate
+
+      integer ecri_phys 
+      integer iddist
+      integer iaervar
+      integer iradia
+      integer ilwd
+      integer ilwb
+      integer ilwn
+      integer ncouche
+
+      logical rayleigh
+      logical tracer
+      integer dustbin
+      logical active,doubleq,lifting,callddevil,scavenging
+      logical sedimentation,activice,water,caps
+      !!! plus besoin de iceparty ??
+      logical photochem
+      integer nqchem_min
+
+      integer swrtype ! type of short wave (solar wavelength) radiative
+      ! transfer to use 1: Fouquart 2: Toon.
+      parameter (swrtype=2)
+!      parameter (swrtype=2)
Index: trunk/WRF.COMMON/WRFV2/meso_datafile.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/meso_datafile.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/meso_datafile.h	(revision 2744)
@@ -0,0 +1,11 @@
+!-----------------------------------------------------------------------
+! INCLUDE datafile.h
+
+!  Address of the directory containing tables of data needed by the GCM    
+
+      character (len=100) :: datafile
+!! path to WRF data
+!       data datafile /'/u/forget/WWW/datagcm/datafile'/
+!       data datafile /'/d5/aslmd/LMD_MM_MARS_DATA/dust'/
+       data datafile /'../data_physics/'/
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/phys/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/Makefile	(revision 2744)
@@ -0,0 +1,66 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+
+MODULES = \
+	module_physics_addtendc.o \
+	module_physics_init.o \
+	variables_mod.o \
+	update_inputs_physiq_mod.o \
+	update_outputs_physiq_mod.o \
+	iniphysiq_mod.o \
+	callphysiq_mod.o \
+	module_lmd_driver.o 
+ 
+OBJS    =
+
+NMM_MODULES =  
+
+LIBTARGET    =  physics
+TARGETDIR    =  ./
+
+$(LIBTARGET) :
+		if [ $(WRF_NMM_CORE) -eq 1 ] ; then \
+                  $(MAKE) nmm_contrib                                      ; \
+                  $(AR) ../main/libwrflib.a $(MODULES) $(OBJS) $(NMM_OBJS) $(NMM_MODULES) ; \
+                else                                                         \
+                  $(MAKE) non_nmm                                          ; \
+                  $(AR) ../main/libwrflib.a $(MODULES) $(OBJS)             ; \
+                fi
+
+include ../configure.wrf
+
+nmm_contrib : $(NMM_OBJS) $(NMM_MODULES) $(MODULES) $(OBJS)
+
+non_nmm : $(MODULES) $(OBJS)
+
+clean:
+	@ echo 'use the clean script'
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+# si ce qui est à droite a changé, on recompile à gauche
+
+module_physics_addtendc.o: \
+		../frame/module_state_description.o \
+		../frame/module_configure.o
+
+module_physics_init.o : \
+		../frame/module_state_description.o \
+		../frame/module_configure.o \
+		../frame/module_wrf_error.o \
+		../frame/module_dm.o \
+		../share/module_model_constants.o 
+
+module_lmd_driver.o: \
+                ../frame/module_state_description.o \
+                ../frame/module_wrf_error.o \
+                ../frame/module_configure.o \
+                ../share/module_model_constants.o \
+
+#               ../frame/module_wrf_error.o \
+#               ../share/module_model_constants.o
+
+# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV2/phys/diff_Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/diff_Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/diff_Makefile	(revision 2744)
@@ -0,0 +1,19 @@
+57,58c57,59
+< 	module_fddaobs_driver.o
+<   
+---
+> 	module_fddaobs_driver.o \
+> 	module_lmd_driver.o 
+>  
+84a86
+> # si ce qui est à droite a changé, on recompile à gauche
+242a245,253
+> module_lmd_driver.o: \
+>                 ../frame/module_state_description.o \
+>                 ../frame/module_wrf_error.o \
+>                 ../frame/module_configure.o \
+>                 ../share/module_model_constants.o \
+> 
+> #               ../frame/module_wrf_error.o \
+> #               ../share/module_model_constants.o
+> 
Index: trunk/WRF.COMMON/WRFV2/phys/diff_module_physics_addtendc
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/diff_module_physics_addtendc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/diff_module_physics_addtendc	(revision 2744)
@@ -0,0 +1,293 @@
+83a84,88
+> 
+> !****MARS
+> ! please set ra_lw_physics and ra_sw_physics to 0
+> ! (here only the temperature tendency is modified)
+> !****MARS
+91c96,105
+<    if (config_flags%bl_pbl_physics .gt. 0)                     &
+---
+> 
+> !****MARS
+> ! - All the LMD physics packages provide one tendency in the WRF sense
+> ! - PBL is replaced and was chosen for practical reasons 
+> !   (may be subject to change)
+> ! - The tendences are supposed to be A-gridded
+> ! - Set bl_pbl_physics = 0 ('if' routines are commented !)
+> !
+> !   if (config_flags%bl_pbl_physics .gt. 0)                     &
+> !****MARS
+99a114,116
+> !****MARS
+> ! please set cu_physics and fdda to 0
+> !****MARS
+107d123
+< 
+190,268c206,214
+<    SELECT CASE(config_flags%bl_pbl_physics)
+< 
+<       CASE (YSUSCHEME)
+< 
+<            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+<      
+<         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<       CASE (MRFSCHEME)
+< 
+<            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+<      
+<         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<       CASE (MYJPBLSCHEME)
+---
+> !****MARS
+> !! here all is modified to achieve a very simple update w/ LMD physics
+> !! all the PBL schemes are de-activated
+> print*,'starting updating tendencies with LMD outputs ...'
+> !
+> !
+> !   SELECT CASE(config_flags%bl_pbl_physics)
+> !
+> !      CASE (YSUSCHEME)
+285,331c231,355
+<         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+< 
+<       CASE (GFSSCHEME)
+<                                                                                                                                         
+<            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+<                                                                                                                                         
+<            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+<                                                                                                                                         
+<            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+<                                                                                                                                         
+<         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+<                                                                                                                                         
+<         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+<                                                                                                                                         
+<         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+<            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+<                 config_flags,                                    &
+<                 ids,ide, jds, jde, kds, kde,                     &
+<                 ims, ime, jms, jme, kms, kme,                    &
+<                 its, ite, jts, jte, kts, kte                     )
+<       CASE DEFAULT
+< 
+<        print*,'phy_bl_ten: The pbl scheme does not exist'
+---
+> !        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !     
+> !        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !      CASE (MRFSCHEME)
+> !
+> !           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !     
+> !        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !      CASE (MYJPBLSCHEME)
+> !
+> !           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !
+> !      CASE (GFSSCHEME)
+> !                                                                                                                                        
+> !           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !                                                                                                                                        
+> !           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !                                                                                                                                        
+> !           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !                                                                                                                                        
+> !        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !                                                                                                                                        
+> !        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !                                                                                                                                        
+> !        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+> !           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+> !                config_flags,                                    &
+> !                ids,ide, jds, jde, kds, kde,                     &
+> !                ims, ime, jms, jme, kms, kme,                    &
+> !                its, ite, jts, jte, kts, kte                     )
+> !      CASE DEFAULT
+> !
+> !       print*,'phy_bl_ten: The pbl scheme does not exist'
+> !
+> !   END SELECT
+333c357
+<    END SELECT
+---
+> !****MARS
Index: trunk/WRF.COMMON/WRFV2/phys/diff_module_physics_init
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/diff_module_physics_init	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/diff_module_physics_init	(revision 2744)
@@ -0,0 +1,18 @@
+26a27
+> 			 MARS_ALB,MARS_TI,			 & !MARS Stuff
+75c76
+<                          itimestep                               & !Optional obs fdda
+---
+>                          itimestep                              & !Optional obs fdda
+151a153,158
+> !****MARS
+>    REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) ::         &
+>              MARS_ALB,MARS_TI
+> !****MARS
+> 
+> 
+315a323,326
+> !!****MARS
+>       MARS_ALB(i,j)=0.
+>       MARS_TI(i,j)=0. 	  	
+> !!****MARS
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/callphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/callphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/callphysiq_mod.F	(revision 2744)
@@ -0,0 +1,70 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+CONTAINS
+
+SUBROUTINE call_physiq(planet_type,klon,llm,nqtot,                  &
+                       debut_split,lafin_split)
+ 
+  USE variables_mod
+  USE physiq_mod, ONLY: physiq
+  use phys_state_var_mod , only : qsurf
+  use comm_wrf, only : allocate_comm_wrf
+  use tracer_h, only: noms
+ 
+  IMPLICIT NONE
+  character(len=10),INTENT(IN) :: planet_type ! planet type ('earth','mars',...)
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+
+  ! Local variables
+!  CHARACTER(len=11) :: modname="call_physiq"
+
+! Sanity check on physics package type
+  IF (debut_split) THEN
+    IF (planet_type.ne."generic") THEN
+     PRINT*,"wrong planet_type for this physics package"
+     STOP
+    ENDIF
+  ENDIF
+
+  qsurf(:,:)=zqfi_omp(:,1,:)
+  print*,'zdt_split',zdt_split
+
+  call allocate_comm_wrf(klon,llm)
+
+! Call physics package with required inputs/outputs
+  CALL physiq(klon,           & ! ngrid
+              llm,            & ! nlayer
+              nqtot,          & ! nq
+              noms,          & ! nametrac
+              debut_split,    & ! firstcall
+              lafin_split,    & ! lastcall
+              jD_cur,         & ! pday
+              jH_cur_split,   & ! ptime
+              zdt_split,      & ! ptimestep
+              zplev_omp,      & ! pplev
+              zplay_omp,      & ! pplay
+              zphi_omp,       & ! pphi
+              zufi_omp,       & ! pu
+              zvfi_omp,       & ! pv
+              ztfi_omp,       & ! pt
+              zqfi_omp,       & ! pq
+              flxwfi_omp,     & ! flxw
+              zdufi_omp,      & ! pdu
+              zdvfi_omp,      & ! pdv
+              zdtfi_omp,      & ! pdt
+              zdqfi_omp,      & ! pdq
+              zdpsrf_omp)       ! pdpsrf
+
+
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/iniphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/iniphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/iniphysiq_mod.F	(revision 2744)
@@ -0,0 +1,169 @@
+MODULE iniphysiq_mod
+
+CONTAINS
+
+subroutine iniphysiq(ngrid,nlayer,nq,piphysiq,&
+                     punjours, pdayref, &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+!use control_mod, only: nday
+!use surf_heat_transp_mod, only: ini_surf_heat_transp
+!use infotrac, only : nqtot ! number of advected tracers
+!USE comvert_mod, ONLY: ap,bp,preff
+use inifis_mod, only: inifis
+use ioipsl_getin_p_mod, only: getin_p
+
+!use inigeomphy_mod, only: inigeomphy
+!use geometry_mod, only: cell_area, & ! physics grid area (m2)
+!                        longitude, & ! longitudes (rad)
+!                        latitude ! latitudes (rad)
+! necessary to get klon_omp
+!USE mod_phys_lmdz_para, ONLY: klon_omp ! number of columns (on local omp grid)
+USE mod_phys_lmdz_para, ONLY: Init_phys_lmdz_para
+USE dimphy, ONLY: init_dimphy
+USE phys_state_var_mod
+!use planete_mod, only: year_day, periastr, apoastr, peri_day,&
+!                       obliquit, z0, lmixmin, emin_turb
+!                       init_planete_mod
+use planete_mod
+use time_phylmdz_mod, only: dtphys, daysec,day_ini
+use planete_mod, only: year_day, periastr, apoastr, peri_day,&
+                   obliquit, z0, lmixmin, emin_turb
+use surfdat_h,  only: emissiv,iceradius, &
+                    emisice,dtemisice
+use comcstfi_mod, only: omeg,mugaz
+use tracer_h, only: nqtot
+!use comm_wrf, only : allocate_comm_wrf
+
+implicit none
+
+INCLUDE 'mpif.h'
+
+REAL,intent(in) :: prad
+REAL,intent(in) :: pg
+REAL,intent(in) :: pr
+REAL,intent(in) :: pcpp
+REAL,intent(in) :: punjours
+!DOUBLE PRECISION,intent(in) :: ptimestep
+
+!real,intent(in) :: prad ! radius of the planet (m)
+!real,intent(in) :: pg ! gravitational acceleration (m/s2)
+!real,intent(in) :: pr ! ! reduced gas constant R/mu
+!real,intent(in) :: pcpp ! specific heat Cp
+!real,intent(in) :: punjours ! length (in s) of a standard day [daysec]
+integer,intent(in) :: pdayref ! reference day of for the simulation [day_ini]
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer :: nday=0 ! this is dummy for mesoscale (in dyn3d/control_mod)
+
+integer,intent(in) :: ngrid ! number of physics columns for this MPI process
+integer,intent(in) :: nlayer ! number of atmospheric layers
+integer,intent(in) :: nq ! number of tracers
+!real,intent(in) :: phour_ini   ! start time (fraction of day) of the run
+!0=<phour_ini<1
+real,intent(in) :: piphysiq   ! call physics every piphysiq dynamical timesteps
+!real :: latitude(ngrid),longitude(ngrid),cell_area(ngrid)
+!  real,intent(in) :: prefff ! reference surface pressure (Pa)
+!  real,intent(in) :: apf(nlayer+1) ! hybrid coordinate at interfaces
+!  real,intent(in) :: bpf(nlayer+1) 
+logical :: ok_slab_ocean
+real*8 :: lat(ngrid),long(ngrid),cellarea(ngrid)
+REAL*8 :: pprad,ppg,ppr,ppcpp,ppunjours
+REAL*8 :: dummy 
+  ! the common part for all planetary physics
+  !------------------------------------------
+  ! --> initialize physics distribution, global fields and geometry
+  ! (i.e. things in phy_common or dynphy_lonlat)
+
+  ! the distinct part for all planetary physics (ie. things in phystd)
+  !------------------------------------------
+
+CALL Init_phys_lmdz_para(1,1,1,MPI_COMM_WORLD)
+
+!call phys_state_var_init
+print*,'ngrid',ngrid,'nlayer',nlayer
+call init_dimphy(ngrid,nlayer)
+call phys_state_var_init(nqtot)
+! copy over preff , ap() and bp()
+!call ini_planete_mod(nlayer,prefff,apf,bpf)
+
+! for slab ocean, copy over some arrays
+ok_slab_ocean=.false. ! default value
+!call getin_p("ok_slab_ocean",ok_slab_ocean)
+!if (ok_slab_ocean) then
+!  call ini_surf_heat_transp(ip1jm,ip1jmp1,unsairez,fext,unsaire, &
+!                            cu,cuvsurcv,cv,cvusurcu,aire,apoln,apols, &
+!                            aireu,airev)
+!endif
+
+dummy=1.
+lat(:)=0.
+long(:)=0.
+cellarea(:)=1.
+print*,'pg',pg
+!ppunjours=punjours
+ppunjours=1.
+pprad=prad
+ppg=pg
+ppr=pr
+ppcpp=pcpp
+call inifis(ngrid,nlayer,nq,pdayref,ppunjours,nday,dummy, &
+            lat,long,cellarea,pprad,ppg,ppr,ppcpp)
+
+     open(17,file='controle.txt',form='formatted',status='old')
+     rewind(17)
+     read(17,*)
+     read(17,*)
+     read(17,*) day_ini !(tab0+3)
+     read(17,*)
+     read(17,*) !tab0+5)
+     read(17,*) omeg !(tab0+6)
+     read(17,*) !(tab0+7)
+     read(17,*) mugaz
+     read(17,*)  !(tab0+9)
+     read(17,*) daysec
+     read(17,*) dtphys !tab0+11)
+     read(17,*)
+     read(17,*)
+     read(17,*) year_day !(tab0+14)
+     read(17,*) periastr !tab0+15)
+     read(17,*) apoastr !tab0+16)
+     read(17,*) peri_day !tab0+17)
+     read(17,*) obliquit !tab0+18)
+     read(17,*) z0
+     read(17,*)
+     read(17,*)
+     read(17,*)
+     read(17,*)
+     read(17,*) emisice(1)
+     read(17,*) emisice(2)
+     read(17,*) emissiv
+     read(17,*)
+     read(17,*)
+     read(17,*)
+     read(17,*)
+     read(17,*) iceradius(1)
+     read(17,*) iceradius(2)
+     read(17,*) dtemisice(1)
+     read(17,*) dtemisice(2)
+     close(17)
+     !print*,'g',g
+
+     !emissiv(:)=EMIS
+     cloudfrac(:,:)=0.5
+     totcloudfrac(:)=0.5
+     hice(:)=0.
+     rnat(:)=0.
+     pctsrf_sic(:)=0.
+     tsea_ice(:)=0.
+     !qsurf(:,:) = 0. 
+     print*,'check'
+     print*,'iceradius',iceradius,'dtemisice',dtemisice
+     print*,'apoastr,periastr,year_day,peri_day,obliq',apoastr,periastr,year_day,peri_day,obliquit
+     print*,'emissiv',emissiv
+     print*,'mugaz',mugaz
+     
+end subroutine iniphysiq
+
+
+END MODULE iniphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/update_inputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,679 @@
+MODULE update_inputs_physiq_mod
+
+CONTAINS
+
+!SUBROUTINE update_inputs_physiq_time
+!SUBROUTINE update_inputs_physiq_tracers
+!SUBROUTINE update_inputs_physiq_constants
+!SUBROUTINE update_inputs_physiq_geom
+!SUBROUTINE update_inputs_physiq_surf
+!SUBROUTINE update_inputs_physiq_soil
+!SUBROUTINE update_inputs_physiq_turb
+!SUBROUTINE update_inputs_physiq_rad
+!SUBROUTINE update_inputs_physiq_slope
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_time(&
+            JULYR,JULDAY,GMT,&
+            elaps,&
+            lct_input,lon_input,ls_input,&
+            MY)
+  USE variables_mod, only: JD_cur,JH_cur_split,phour_ini
+  use callkeys_mod, only : tlocked
+  INTEGER, INTENT(IN) :: JULDAY, JULYR
+  REAL, INTENT(IN) :: GMT,elaps,lon_input,ls_input,lct_input
+  REAL,INTENT(OUT) :: MY
+  REAL :: sec,nsec
+  
+  IF (JULYR .ne. 9999) THEN
+    if (tlocked .eqv. .false.) THEN
+      JH_cur_split = (GMT + elaps/3600.) !! universal time (0<JH_cur_split<1): JH_cur_split=0.5 at 12:00 UT 
+      JH_cur_split = MODULO(JH_cur_split,24.)   !! the two arguments of MODULO must be of the same type 
+      JH_cur_split = JH_cur_split / 24.
+      JD_cur = (JULDAY - 1 + INT((3600.0*GMT+elaps)/86400))
+      JD_cur = MODULO(int(JD_cur),2)
+      MY = (JULYR-2000) + (86400*(JULDAY - 1)+3600.0*GMT+elaps)/31968000
+      MY = INT(MY)
+    ELSE
+      JH_cur_split = (GMT)! + elaps/420000.) !! universal time (0<JH_cur_split<1): JH_cur_split=0.5 at 12:00 UT 
+      JH_cur_split = MODULO(JH_cur_split,24.)   !! the two arguments of MODULO must be of the same type 
+      JH_cur_split = JH_cur_split / 24.
+      JD_cur = (JULDAY - 1 + INT((3600*GMT)/86400))!+elaps)/1.008e7))
+      JD_cur = MODULO(int(JD_cur),2)
+      MY = (JULYR-2000) + (86400*(JULDAY - 1)+3600*GMT+elaps)/31968000
+      MY = INT(MY)
+    ENDIF
+  ELSE
+    if (tlocked .eqv. .false.) THEN
+      JH_cur_split = lct_input - lon_input / 15. + elaps/1500.0
+      JD_cur =  INT((sec*(lct_input - lon_input / 15.) + elaps)/36000)
+      !ptime = lct_input - lon_input / 15. + elaps/3600.
+      !pday =  INT((3600*(lct_input - lon_input / 15.) + elaps)/86400)
+    ELSE
+      JH_cur_split = lct_input - lon_input / 15. !+ elaps/1500.0
+      !pday =  INT((sec*(lct_input - lon_input / 15.)+ elaps)/36000)
+      JD_cur =  INT((sec*(lct_input - lon_input / 15.))/3600)
+      !print*,'ptime',ptime
+      !print*,'pday',pday 
+    !pday =  INT((3600*(lct_input - lon_input / 15.) + elaps)/86400)
+      JH_cur_split = MODULO(ptime,24.)
+      JH_cur_split = JH_cur_split / 24.
+      JD_cur = MODULO(int(pday),365)
+      MY = 2024
+    ENDIF
+  ENDIF
+
+END SUBROUTINE update_inputs_physiq_time
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_tracers(nq,MARS_MODE)
+
+  use tracer_h, only: noms,nqtot
+  !use phys_state_var_mod , only : qsurf
+  !USE dimphy, only : klon,klev 
+  INTEGER, INTENT(IN) :: nq,MARS_MODE
+  INTEGER :: i,k
+!  CHARACTER(len=20), INTENT(INOUT) :: tname(nq) ! tracer names
+  logical :: end_of_file
+
+  !! TRACERS
+  IF (.not.ALLOCATED(noms)) ALLOCATE(noms(nq)) !! est fait dans initracer normalement
+      
+                 !! tableau dans tracer_mod.F90
+  print*,'nq',nq
+  print*,'MARS_MODE',MARS_MODE
+  nqtot=nq
+  if (MARS_MODE .eq. 1) THEN
+    noms(1)="h2o_vap"
+    noms(2)="h2o_ice"
+  else if (MARS_MODE .eq. 22)  then 
+    noms(1)="co2_vap"
+    noms(2)="co2_ice"
+  else
+    noms(:)="zolbxs"
+  endif
+  !noms(:)=tname(:)
+  print*,'noms',noms
+  !!---------------------!!
+  !! OUTPUT FOR CHECKING !!
+  !!---------------------!!
+
+END SUBROUTINE update_inputs_physiq_tracers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_constants
+
+   !USE module_model_constants
+   !use comcstfi_h, only: omeg,mugaz
+   !use planete_h,  only: year_day,periheli,aphelie, &
+   !                       peri_day,obliquit,emin_turb, &
+   !                       lmixmin
+   use planete_mod, only: year_day, periastr, apoastr, peri_day,&
+                       obliquit, z0, lmixmin, emin_turb
+   use surfdat_h,  only: emissiv,iceradius, &
+                         emisice,dtemisice
+   !                       z0_default
+   !use comsoil_h, only: volcapa
+   use comcstfi_mod, only: rad, omeg, g, mugaz, rcp, cpp, r
+   !! comcstfi_h
+   use phys_state_var_mod, only :cloudfrac,totcloudfrac,hice,rnat,pctsrf_sic,tsea_ice
+   !use iniorbit
+   !use time_phylmdz_mod, only: dtphys, daysec,day_ini
+  
+  
+     !open(17,file='controle.txt',form='formatted',status='old')
+     !rewind(17)
+     !read(17,*)
+     !read(17,*) 
+     !read(17,*) day_ini !(tab0+3)
+     !read(17,*) 
+     !read(17,*) !tab0+5)
+     !read(17,*) omeg !(tab0+6)
+     !read(17,*) !(tab0+7)
+     !read(17,*)  !(tab0+8)
+     !read(17,*)  !(tab0+9)
+     !read(17,*) daysec
+     !read(17,*) dtphys !tab0+11)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*) year_day !(tab0+14)
+     !read(17,*) periastr !tab0+15)
+     !read(17,*) apoastr !tab0+16)
+     !read(17,*) peri_day !tab0+17)
+     !read(17,*) obliquit !tab0+18)
+     !read(17,*) z0
+     !read(17,*)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*) emisice(1)
+     !read(17,*) emisice(2)
+     !read(17,*) emissiv
+     !read(17,*)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*) iceradius(1)
+     !read(17,*) iceradius(2)
+     !read(17,*) dtemisice(1)
+     !read(17,*) dtemisice(2)
+     !close(17) 
+     !cpp=(8.314511/(mugaz/1000.0))/rcp
+     !print*,'cpp',cpp
+     !print*,'g',g
+
+     !emissiv(:)=EMIS
+     !cloudfrac(:,:)=0.5
+     !totcloudfrac(:)=0.5
+     !hice(:)=0.
+     !rnat(:)=0.
+     !pctsrf_sic(:)=0.
+     !tsea_ice(:)=0.
+     !qsurf(:,:) = 0. 
+     !print*,'iceradius',iceradius,'dtemisice',dtemisice
+     !print*,'apoastr,periastr,year_day,peri_day,obliq',apoastr,periastr,year_day,peri_day,obliquit
+     !print*,'emissiv',emissiv
+ 
+     ! SUBROUTINE iniorbit(apoastr,periastr,year_day,peri_day,obliq)
+
+END SUBROUTINE update_inputs_physiq_constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_geom( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,ngrid,nlayer,&
+            DX,DY,MSFT,&
+            lat_input, lon_input,&
+            XLAT,XLONG)
+
+   ! in WRF (share)
+   USE module_model_constants, only: DEGRAD,p0
+   ! in LMD (phymars)
+   !use comgeomfi_h, only: ini_fillgeom
+   ! in LMD (phy_common)
+   USE mod_grid_phy_lmdz, ONLY: init_grid_phy_lmdz
+   USE geometry_mod, ONLY: latitude,latitude_deg,&
+                           longitude,longitude_deg,&
+                           cell_area
+   use comdiurn_h, only: sinlat, coslat, sinlon, coslon
+   !use planetwide_mod, only: planetwide_sumval
+   use comgeomfi_h, only: totarea, totarea_planet
+   use planete_mod, only: ini_planete_mod
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,ngrid,nlayer
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     MSFT,XLAT,XLONG
+   REAL, INTENT(IN) :: dx,dy
+   REAL, INTENT(IN) :: lat_input, lon_input
+   INTEGER :: i,j,subs,ig,k
+   REAL,DIMENSION(ngrid) :: plon, plat, parea
+   REAL, DIMENSION(nlayer+1) :: znw
+   REAL*8, DIMENSION(nlayer+1) :: apdyn,bpdyn
+   REAL :: ptop
+   REAL*8 :: PP0
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+    !-----------------------------------!
+    ! 1D subscript for physics "cursor" !
+    !-----------------------------------!
+    subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+    !----------------------------------------!
+    ! Surface of each part of the grid (m^2) !  
+    !----------------------------------------!
+    !parea(subs) = dx*dy                           !! 1. idealized cases - computational grid
+    parea(subs) = (dx/msft(i,j))*(dy/msft(i,j))    !! 2. WRF map scale factors - assume that msfx=msfy (msf=covariance)
+    !parea(subs)=dx*dy/msfu(i,j)                   !! 3. special for Mercator GCM-like simulations
+
+    !---------------------------------------------!
+    ! Mass-point latitude and longitude (radians) !
+    !---------------------------------------------!
+    IF (JULYR .ne. 9999) THEN
+     plat(subs) = XLAT(i,j)*DEGRAD
+     plon(subs) = XLONG(i,j)*DEGRAD
+    ELSE
+     !!! IDEALIZED CASE
+     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lat: ',lat_input
+     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lon: ',lon_input
+     plat(subs) = lat_input*DEGRAD
+     plon(subs) = lon_input*DEGRAD
+    ENDIF 
+
+   ENDDO
+   ENDDO
+
+   !! FILL GEOMETRICAL ARRAYS !!
+   !call ini_fillgeom(ngrid,plat,plon,parea)
+
+   !!! ----------------------------------------------------------
+   !!! --- initializing geometry in phy_common
+   !!! --- (this is quite planet-independent)
+   !!! ----------------------------------------------------------
+   ! initialize mod_grid_phy_lmdz
+   CALL init_grid_phy_lmdz(1,1,ipe-ips+1,jpe-jps+1,nlayer)
+   ! fill in geometry_mod variables
+   ! ... copy over local grid longitudes and latitudes
+   ! ... partly what is done in init_geometry
+   IF(.not.ALLOCATED(longitude)) ALLOCATE(longitude(ngrid))
+   IF(.not.ALLOCATED(longitude_deg)) ALLOCATE(longitude_deg(ngrid))
+   IF(.not.ALLOCATED(latitude)) ALLOCATE(latitude(ngrid))
+   IF(.not.ALLOCATED(latitude_deg)) ALLOCATE(latitude_deg(ngrid))
+   IF(.not.ALLOCATED(cell_area)) ALLOCATE(cell_area(ngrid))
+   longitude(:) = plon(:)
+   latitude(:) = plat(:)
+   longitude_deg(:) = plon(:)/DEGRAD
+   latitude_deg(:) = plat(:)/DEGRAD
+   cell_area(:) = parea(:)
+   !call planetwide_sumval(parea,totarea_planet)
+   !print*,'parea',parea(1)
+   !totarea=SSUM(ngrid,parea,1)
+   totarea=ngrid*parea(1)
+   !totarea_planet=SSUM(ngrid,parea,1)
+   totarea_planet=ngrid*parea(1)
+
+   IF (.not.ALLOCATED(sinlat)) ALLOCATE(sinlat(ngrid))
+   IF (.not.ALLOCATED(coslat)) ALLOCATE(coslat(ngrid))
+   IF (.not.ALLOCATED(sinlon)) ALLOCATE(sinlon(ngrid))
+   IF (.not.ALLOCATED(coslon)) ALLOCATE(coslon(ngrid))
+   DO ig=1,ngrid
+     sinlat(ig)=sin(plat(ig))
+     coslat(ig)=cos(plat(ig))
+     sinlon(ig)=sin(plon(ig))
+     coslon(ig)=cos(plon(ig))
+   ENDDO
+   
+   open(unit=12,file='levels',form='formatted',status='old')
+   rewind(12)
+   DO k=1, nlayer
+   read(12,*) znw(k)
+   !write(6,*) 'read level ', k,grid%znw(k)
+   ENDDO
+   close(12)
+   
+   ptop=0.5
+   apdyn=ptop*(1-znw)
+   bpdyn=znw
+   PP0=p0
+   CALL ini_planete_mod(nlayer,PP0,apdyn,bpdyn)
+   !!! ----------------------------------------------------------
+
+END SUBROUTINE update_inputs_physiq_geom
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,MARS_MODE,&
+            M_ALBEDO,CST_AL,&
+            M_TSURF,M_EMISS,M_CO2ICE,&
+            M_GW,M_Z0,CST_Z0,&
+            M_H2OICE,&
+            phisfi_val)
+
+   use surfdat_h, only: phisfi, albedodat,  &
+                       zmea, zstd, zsig, zgam, zthe
+   use slab_ice_h, only: noceanmx
+   use planete_mod, only: z0
+   use phys_state_var_mod, only : tsurf, emis, qsurf,tslab
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,MARS_MODE
+   INTEGER :: i,j,subs,nlast,iq
+   REAL, INTENT(IN  ) :: CST_AL, phisfi_val, CST_Z0
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_ALBEDO,M_TSURF,M_EMISS,M_CO2ICE,M_H2OICE,M_Z0
+   REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: M_GW  
+
+   !print*,'ALLOCATED(phisfi)',ALLOCATED(phisfi)
+   !print*,'size phisfi',size(phisfi)
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !---------------------!
+     ! Ground geopotential !
+     !---------------------!
+     phisfi(subs) = phisfi_val
+!     print*,'size phisfi',size(phisfi)
+     !print*,'phisfi',phisfi(subs)
+     !---------------!
+     ! Ground albedo !
+     !---------------!
+     IF (JULYR .ne. 9999) THEN 
+      IF (CST_AL == 0) THEN
+       albedodat(subs)=M_ALBEDO(i,j)
+      ELSE 
+       albedodat(subs)=CST_AL
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT ALBEDO ', albedodat
+      ENDIF
+     ELSE
+      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION albedo: ', CST_AL
+      albedodat(subs)=CST_AL
+     ENDIF
+
+     !-----------------------------------------!
+     ! Gravity wave parametrization            !
+     ! NB: usually 0 in mesoscale applications !
+     !-----------------------------------------!
+     zmea(subs)=0.
+     zstd(subs)=0.
+     zsig(subs)=0.
+     zgam(subs)=0.
+     zthe(subs)=0.
+
+     !----------------------------!
+     ! Variable surface roughness !
+     !----------------------------!
+     z0 = CST_Z0
+     !IF (JULYR .ne. 9999) THEN
+     ! IF (CST_Z0 == 0) THEN
+     !  z0(subs) = M_Z0(i,j)
+     ! ELSE
+     !  z0(subs) = CST_Z0
+     !  IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT SURF ROUGHNESS (m) ',CST_Z0
+     ! ENDIF
+     !ELSE
+     ! IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION z0 (m) ', CST_Z0
+     ! z0(subs)=CST_Z0
+     !ENDIF
+     !!!!! ADDITIONAL SECURITY. THIS MIGHT HAPPEN WITH OLD INIT FILES.
+     !IF (z0(subs) == 0.) THEN
+     !  IF ( (i == ips) .AND. (j == jps) ) PRINT *, 'WELL, z0 is 0, this is no good. Setting to old defaults value 0.01 m'
+     !  z0(subs) = 0.01
+     !ENDIF
+     !!!!! ADDITIONAL SECURITY. INTERP+SMOOTH IN GEOGRID MIGHT YIELD NEGATIVE Z0 !!!
+     !IF (z0(subs) < 0.) THEN
+     !  PRINT *, 'WELL, z0 is NEGATIVE, this is impossible. better stop here.'
+     !  PRINT *, 'advice --> correct interpolation / smoothing of z0 in WPS'
+     !  PRINT *, '           -- or check the constant value set in namelist.input'
+     !  STOP
+     !ENDIF
+
+     !-----------------------------------------------!
+     ! Ground temperature, emissivity, CO2 ice cover !
+     !-----------------------------------------------!
+     tsurf(subs) = M_TSURF(i,j)
+     emis(subs) = M_EMISS(i,j)     
+     !do i=1,noceanmx
+     tslab(subs,:)=tsurf(subs)
+     !enddo
+     !-------------------!
+     ! Tracer at surface !
+     !-------------------!
+     qsurf(subs,:)=0. ! default case
+     SELECT CASE (MARS_MODE)
+       CASE(1)
+       qsurf(subs,2)=M_H2OICE(i,j)    !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
+                                      !! ----- retrocompatible ancienne physique
+                                      !! ----- [H2O ice is last tracer in qsurf in LMD physics]
+       CASE(2)   
+       qsurf(subs,1)=0.                !! not coupled with lifting for the moment [non remobilise]
+       !CASE(3)
+       !qsurf(subs,1)=q_prof(1,1)                !!! temporaire, a definir       
+       !qsurf(subs,2)=q_prof(1,2)     
+       CASE(11)
+       qsurf(subs,2)=M_H2OICE(i,j)    !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
+       qsurf(subs,3)=0.                !! not coupled with lifting for the moment [non remobilise]
+       CASE(12)
+       qsurf(subs,2)=M_H2OICE(i,j)    !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
+       qsurf(subs,3)=0.                !! not coupled with lifting for the moment [non remobilise]
+     END SELECT
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: phisfi",phisfi(1),phisfi(nlast)
+   print*,"check: albedodat",albedodat(1),albedodat(nlast)
+   print*,"check: zmea",zmea(1),zmea(nlast)
+   print*,"check: zstd",zstd(1),zstd(nlast)
+   print*,"check: zsig",zsig(1),zsig(nlast)
+   print*,"check: zgam",zgam(1),zgam(nlast)
+   print*,"check: zthe",zthe(1),zthe(nlast)
+   print*,"check: z0",z0
+   print*,"check: tsurf",tsurf(1),tsurf(nlast)
+   print*,"check: emis",emis(1),emis(nlast)
+   print*,"check: qsurf",qsurf(1,:),qsurf(nlast,:)
+
+END SUBROUTINE update_inputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,nsoil,&
+            M_TI,CST_TI,&
+            M_ISOIL,M_DSOIL,&
+            M_TSOIL,M_TSURF)
+
+   use comsoil_h, only: inertiedat,mlayer,layer,volcapa
+   use phys_state_var_mod, only: tsoil
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,nsoil
+   INTEGER :: i,j,subs,nlast
+   REAL, INTENT(IN  ) :: CST_TI 
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_TI, M_TSURF
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(IN)  :: &
+     M_TSOIL, M_ISOIL, M_DSOIL
+   REAL :: inertiedat_val
+   REAL :: lay1,alpha
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-----------------!
+     ! Thermal Inertia !
+     !-----------------!
+     IF (JULYR .ne. 9999) THEN
+      IF (CST_TI == 0) THEN
+       inertiedat_val=M_TI(i,j)
+      ELSE
+       inertiedat_val=CST_TI
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT THERMAL INERTIA ', inertiedat_val
+      ENDIF
+     ELSE
+      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION inertia: ',CST_TI
+      inertiedat_val=CST_TI
+     ENDIF
+     !inertiedat(subs) = inertiedat_val
+     !--pb de dimensions???!!???
+     IF (JULYR .ne. 9999) THEN
+       inertiedat(subs,:)=M_ISOIL(i,:,j) !! verifier que cest bien hires TI en surface
+       mlayer(0:nsoil-1)=M_DSOIL(i,:,j)
+     ELSE
+        IF ( nsoil .lt. 18 ) THEN
+            PRINT *,'** Mars ** WRONG NUMBER OF SOIL LAYERS. SHOULD BE 18 AND IT IS ',nsoil
+            STOP
+        ENDIF
+        IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION isoil and dsoil standard'
+        do k=1,nsoil
+         inertiedat(subs,k) = inertiedat_val
+         !mlayer(k-1) = sqrt(887.75/3.14)*((2.**(k-0.5))-1.) * inertiedat_val / wvolcapa    ! old setting
+         mlayer(k-1) = 2.E-4 * (2.**(k-0.5-1.))                                            ! new gcm settings
+        enddo
+     ENDIF
+     IF ( (i == ips) .AND. (j == jps) ) &
+         PRINT *,'** Mars ** TI and depth profiles are',inertiedat(subs,:)!,mlayer(0:nsoil-1)
+
+     !!!!!!!!!!!!!!!!! DONE in soil_setting.F 
+     ! 1.5 Build layer(); following the same law as mlayer()
+     ! Assuming layer distribution follows mid-layer law:
+     ! layer(k)=lay1*alpha**(k-1)
+     lay1=sqrt(mlayer(0)*mlayer(1))
+     alpha=mlayer(1)/mlayer(0)
+     do k=1,nsoil
+       layer(k)=lay1*(alpha**(k-1))
+     enddo
+
+     !------------------------!
+     ! Deep soil temperatures ! 
+     !------------------------!
+     IF (M_TSOIL(i,1,j) .gt. 0. .and. JULYR .ne. 9999) THEN
+       tsoil(subs,:)=M_TSOIL(i,:,j)
+     ELSE
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** no tsoil. set it to tsurf.'
+       do k=1,nsoil
+        !print*,'M_TSURF(i,j)',M_TSURF(1,:)
+        !print*,'size M_TSURF',size(M_TSURF)
+        !print*,'size tsoil',size(tsoil)
+        tsoil(subs,k) = M_TSURF(i,j)
+        !print*,'tsoil(subs,k)',tsoil(subs,k)
+       enddo
+     ENDIF
+
+   ENDDO
+   ENDDO
+
+   volcapa=1.e6   
+
+   print*,'zolbxs'
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: inertiedat",inertiedat(1,:),inertiedat(nlast,:)
+   print*,"check: mlayer",mlayer(:)
+   print*,"check: layer",layer(:)
+   print*,"check: tsoil",tsoil(1,:),tsoil(nlast,:)
+
+END SUBROUTINE update_inputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,&
+            RESTART,isles,&
+            M_Q2,M_WSTAR)
+
+   use turb_mod, only: q2,wstar,turb_resolved
+   !use phys_state_var_mod, only : q2,
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs,nlast      
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_WSTAR
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(IN) :: M_Q2
+   LOGICAL, INTENT(IN ) :: RESTART,isles
+
+   !! to know if this is turbulence-resolving run or not
+
+   turb_resolved = isles
+   print*,'isles',isles
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !PBL wind variance
+     IF (.not. restart) THEN
+      q2(subs,:) = 1.E-6      
+      wstar(subs)=0.
+     ELSE
+      q2(subs,:)=M_Q2(i,:,j)!
+      !q2(subs,:) = 1.e-3
+      wstar(subs)=M_WSTAR(i,j)
+     ENDIF
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: q2",q2(1,1)!,q2(nlast,:)
+   print*,"check: wstar",wstar(1),wstar(nlast)
+
+END SUBROUTINE update_inputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            RESTART,&
+            M_FLUXRAD)
+
+   !use dimradmars_mod, only: fluxrad
+   use phys_state_var_mod, only : fluxrad
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs,nlast      
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_FLUXRAD
+   LOGICAL, INTENT(IN ) :: RESTART
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     ! fluxrad_save
+     IF (.not. restart) THEN
+      fluxrad(subs)=0.
+     ELSE
+      fluxrad(subs)=M_FLUXRAD(i,j)
+     ENDIF
+     !! et fluxrad_sky ???!???
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: fluxrad",fluxrad(1),fluxrad(nlast)
+
+END SUBROUTINE update_inputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_slope( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,&
+            SLPX,SLPY)
+
+   !USE module_model_constants, only: DEGRAD
+   !USE slope_mod, ONLY: theta_sl, psi_sl
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: SLPX,SLPY
+   INTEGER :: i,j,subs,nlast
+
+END SUBROUTINE update_inputs_physiq_slope
+
+END MODULE update_inputs_physiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/update_outputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,218 @@
+MODULE update_outputs_physiq_mod
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            MARS_MODE,&
+            M_TSURF,M_CO2ICE,&
+            M_H2OICE)
+
+   !use surfdat_h, only: tsurf, co2ice, qsurf
+   use phys_state_var_mod, only : tsurf,qsurf
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER, INTENT(IN) :: MARS_MODE
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_TSURF,M_CO2ICE,M_H2OICE
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_TSURF(i,j) = tsurf(subs)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            nsoil,&
+            M_TSOIL)
+
+   !use comsoil_h, only: tsoil
+    use phys_state_var_mod, only : tsoil
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,nsoil
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(INOUT)  :: &
+     M_TSOIL
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_TSOIL(i,:,j) = tsoil(subs,:)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            M_FLUXRAD)
+
+   !use dimradmars_mod, only: fluxrad
+   use phys_state_var_mod, only : fluxrad
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: M_FLUXRAD
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_FLUXRAD(i,j) = fluxrad(subs)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            M_Q2,M_WSTAR,&
+            HFMAX,ZMAX,USTM,HFX)
+
+   use turb_mod, only: q2,wstar,ustar,sensibFlux!,&
+                        !hfmax_th,zmax_th
+   !use phys_state_var_mod, only : q2,sensibFlux
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs    
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_WSTAR,HFMAX,ZMAX,USTM,HFX
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT) :: M_Q2
+  
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_Q2(i,kps:kpe+1,j) = q2(subs,:)
+     M_WSTAR(i,j) = wstar(subs)
+     !! output only (arrays already in phys modules)
+     !HFMAX(i,j) = HFMAX_TH(subs)
+     !ZMAX(i,j) = ZMAX_TH(subs)
+     USTM(i,j) = ustar(subs)
+     HFX(i,j) = sensibFlux(subs) ! *-1 ?????
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_diag( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            SWDOWNZ,TAU_DUST,QSURFDUST,&
+            MTOT,ICETOT,TAU_ICE,&
+            HR_SW,HR_LW,HR_DYN,DT,DTRAD,&
+            RDUST,VMR_ICE,RICE,&
+            CLOUDFRAC,TOTCLOUDFRAC,&
+            RAIN,SNOW,REEVAP,SURFRAIN,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+            FLUXSURF_LW,FLXGRD,LSCEZ,H2OICE_REFF,LATENT_HF)
+
+   USE comm_wrf !! to get fields to be written from physiq
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
+     SWDOWNZ,TAU_DUST,QSURFDUST,&
+     MTOT,ICETOT,TAU_ICE,&
+     TOTCLOUDFRAC,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+     FLUXSURF_LW,FLXGRD,LATENT_HF,REEVAP,SURFRAIN
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: &
+     HR_SW,HR_LW,RDUST,VMR_ICE,RICE,CLOUDFRAC,HR_DYN,DT,DTRAD,RAIN,SNOW,&
+     LSCEZ,H2OICE_REFF
+   INTEGER :: i,j,subs
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !! get diagnostics from physics
+     HR_SW(i,kps:kpe,j) = comm_HR_SW(subs,kps:kpe)
+     HR_LW(i,kps:kpe,j) = comm_HR_LW(subs,kps:kpe)
+     CLOUDFRAC(i,kps:kpe,j)= comm_CLOUDFRAC(subs,kps:kpe)
+     TOTCLOUDFRAC(i,j)= comm_TOTCLOUDFRAC(subs)
+     RAIN(i,kps:kpe,j) = comm_RAIN(subs,kps:kpe)
+     SNOW(i,kps:kpe,j) = comm_SNOW(subs,kps:kpe)
+     ALBEQ(i,j)=comm_ALBEQ(subs)
+     FLUXTOP_DN(i,j)=comm_FLUXTOP_DN(subs)
+     FLUXABS_SW(i,j)=comm_FLUXABS_SW(subs)
+     FLUXTOP_LW(i,j)=comm_FLUXTOP_LW(subs)
+     FLUXSURF_SW(i,j)=comm_FLUXSURF_SW(subs)
+     FLUXSURF_LW(i,j)=comm_FLUXSURF_LW(subs)
+     FLXGRD(i,j)=comm_FLXGRD(subs)
+     LSCEZ(i,kps:kpe,j)=comm_LSCEZ(subs,kps:kpe)
+     H2OICE_REFF(i,kps:kpe,j)=comm_H2OICE_REFF(subs,kps:kpe)
+     LATENT_HF(i,j)=comm_LATENT_HF(subs)
+     REEVAP(i,j)=comm_REEVAP(subs)
+     SURFRAIN(i,j)=comm_SURFRAIN(subs)
+
+   ENDDO
+   ENDDO
+
+   CALL deallocate_comm_wrf
+
+END SUBROUTINE update_outputs_physiq_diag
+
+END MODULE update_outputs_physiq_mod
+
+
+
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/variables_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/variables_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_generic_lmd_new/variables_mod.F	(revision 2744)
@@ -0,0 +1,77 @@
+MODULE variables_mod
+
+IMPLICIT NONE
+
+REAL*8 :: JD_cur !pday !JD_cur ! Julian day
+REAL*8 :: JH_cur_split !ptime !JH_cur_split ! Julian hour (fraction of day)
+REAL*8 :: zdt_split !ptimestep !zdt_split ! time step over which the physics are evaluated
+REAL*8 :: phour_ini ! start time (fraction of day) of the run 0=<phour_ini<1
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplev_omp !pplev !zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplay_omp !pplay !zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zpk_omp!(klon,llm)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zphi_omp !pphi !zphi_omp(klon,llm) ! geopotential at midlayer
+REAL*8,DIMENSION(:),ALLOCATABLE :: zphis_omp!(klon) ! surface geopotential
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zufi_omp !pu !zufi_omp(klon,llm) ! zonal wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zvfi_omp !pv !zvfi_omp(klon,llm) ! meridional wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zrfi_omp!(klon,llm) ! relative wind vorticity, in s-1
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: ztfi_omp !pt !ztfi_omp(klon,llm) ! temperature (K)
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zqfi_omp !pq !zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: flxwfi_omp !flxw !flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) 
+! tendencies (in */s) from the physics:
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdufi_omp !pdu !zdufi_omp(klon,llm) ! tendency on zonal winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdvfi_omp !pdv !zdvfi_omp(klon,llm) ! tendency on meridional winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdtfi_omp !pdt !zdtfi_omp(klon,llm) ! tendency on temperature
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zdqfi_omp !pdq !zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+REAL*8,DIMENSION(:),ALLOCATABLE :: zdpsrf_omp !pdpsrf !zdpsrf_omp(klon) ! tendency on surface pressure
+
+CONTAINS
+
+SUBROUTINE allocate_interface(klon,llm,nqtot)
+
+  IMPLICIT NONE
+ 
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+ 
+  IF (.NOT.ALLOCATED(zplev_omp)) ALLOCATE(zplev_omp(klon,llm+1))
+  IF (.NOT.ALLOCATED(zplay_omp)) ALLOCATE(zplay_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zpk_omp)) ALLOCATE(zpk_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphi_omp)) ALLOCATE(zphi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphis_omp)) ALLOCATE(zphis_omp(klon))
+  IF (.NOT.ALLOCATED(zufi_omp)) ALLOCATE(zufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zvfi_omp)) ALLOCATE(zvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zrfi_omp)) ALLOCATE(zrfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(ztfi_omp)) ALLOCATE(ztfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zqfi_omp)) ALLOCATE(zqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(flxwfi_omp)) ALLOCATE(flxwfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdufi_omp)) ALLOCATE(zdufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdvfi_omp)) ALLOCATE(zdvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdtfi_omp)) ALLOCATE(zdtfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdqfi_omp)) ALLOCATE(zdqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(zdpsrf_omp)) ALLOCATE(zdpsrf_omp(klon))
+
+END SUBROUTINE allocate_interface
+
+SUBROUTINE deallocate_interface
+
+  DEALLOCATE(zplev_omp)
+  DEALLOCATE(zplay_omp)
+  DEALLOCATE(zpk_omp)
+  DEALLOCATE(zphi_omp)
+  DEALLOCATE(zphis_omp)
+  DEALLOCATE(zufi_omp)
+  DEALLOCATE(zvfi_omp)
+  DEALLOCATE(zrfi_omp)
+  DEALLOCATE(ztfi_omp)
+  DEALLOCATE(zqfi_omp)
+  DEALLOCATE(flxwfi_omp)
+  DEALLOCATE(zdufi_omp)
+  DEALLOCATE(zdvfi_omp)
+  DEALLOCATE(zdtfi_omp)
+  DEALLOCATE(zdqfi_omp)
+  DEALLOCATE(zdpsrf_omp)
+
+END SUBROUTINE deallocate_interface
+
+END MODULE variables_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd	(revision 2744)
@@ -0,0 +1,1 @@
+link dynphy_wrf_void_lmd_new
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/callphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/callphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/callphysiq_mod.F	(revision 2744)
@@ -0,0 +1,82 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+ !! ----------------------------------------------------------
+ !! ---- CALL TO MARS PHYSICS
+ !! ----------------------------------------------------------
+
+CONTAINS
+
+SUBROUTINE call_physiq(planet_type, klon,llm,nqtot,                       &
+                       debut_split,lafin_split)
+
+  USE variables_mod
+  USE physiq_mod, ONLY: physiq
+  IMPLICIT NONE
+
+  character(len=10),INTENT(IN) :: planet_type ! planet type ('earth','mars',...)
+
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+
+!  ! Local variables
+!  CHARACTER(len=11) :: modname="call_physiq"
+!  LOGICAL,SAVE :: firstcall=.true.
+!!$OMP THREADPRIVATE(firstcall)
+!
+!! Sanity check on physics package type
+!  IF (firstcall) THEN
+!    IF (planet_type.ne."mars") THEN
+!      CALL abort_gcm(modname,"wrong planet_type for this physics package",1)
+!    ENDIF
+!    firstcall=.false.
+!  ENDIF
+
+! Sanity check on physics package type
+ IF (debut_split) THEN
+   IF (planet_type.ne."mars") THEN
+     PRINT*,"wrong planet_type for this physics package"
+     STOP
+   ENDIF
+ ENDIF
+
+! Set dummy variables for Mars to zero (additional and prob useless security)
+  zpk_omp(:,:)=0.
+  zphis_omp(:)=0.
+  presnivs_omp(:)=0.
+  zrfi_omp(:,:)=0.
+ 
+! Call physics package with required inputs/outputs
+  CALL physiq(klon,           & ! ngrid
+              llm,            & ! nlayer
+              nqtot,          & ! nq
+              debut_split,    & ! firstcall
+              lafin_split,    & ! lastcall
+              jD_cur,         & ! pday
+              jH_cur_split,   & ! ptime
+              zdt_split,      & ! ptimestep
+              zplev_omp,      & ! pplev
+              zplay_omp,      & ! pplay
+              zphi_omp,       & ! pphi
+              zufi_omp,       & ! pu
+              zvfi_omp,       & ! pv
+              ztfi_omp,       & ! pt
+              zqfi_omp,       & ! pq
+              flxwfi_omp,     & ! flxw
+              zdufi_omp,      & ! pdu
+              zdvfi_omp,      & ! pdv
+              zdtfi_omp,      & ! pdt
+              zdqfi_omp,      & ! pdq
+              zdpsrf_omp)       ! pdpsrf
+
+
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/iniphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/iniphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/iniphysiq_mod.F	(revision 2744)
@@ -0,0 +1,92 @@
+MODULE iniphysiq_mod
+
+CONTAINS
+
+subroutine iniphysiq(ngrid,nlayer,nq,piphysiq,&
+                     punjours, pdayref, &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+use phys_state_var_init_mod, only: phys_state_var_init
+use time_phylmdz_mod, only: iphysiq, day_step, ecritstart,ecritphy,&
+                            dtphys,daysec,day_ini,hour_ini
+use update_inputs_physiq_mod, only: traceurs
+USE variables_mod, only: phour_ini,zdt_split !! zdt_split <> pttimestep
+   !real*8,intent(in) :: ptimestep !physics time step (s) [dtphys]
+
+! this is necessary to initialize getin_p
+USE mod_phys_lmdz_para, ONLY: Init_phys_lmdz_para
+
+implicit none
+
+INCLUDE 'mpif.h'
+
+real,intent(in) :: prad ! radius of the planet (m)
+real,intent(in) :: pg ! gravitational acceleration (m/s2)
+real,intent(in) :: pr ! ! reduced gas constant R/mu
+real,intent(in) :: pcpp ! specific heat Cp
+real,intent(in) :: punjours ! length (in s) of a standard day [daysec]
+integer,intent(in) :: pdayref ! reference day of for the simulation [day_ini]
+!real*8,intent(in) :: ptimestep !physics time step (s) [dtphys]
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer,intent(in) :: ngrid ! number of physics columns for this MPI process
+integer,intent(in) :: nlayer ! number of atmospheric layers
+integer,intent(in) :: nq ! number of tracers
+!real,intent(in) :: phour_ini   ! start time (fraction of day) of the run 0=<phour_ini<1
+real,intent(in) :: piphysiq   ! call physics every piphysiq dynamical timesteps
+
+! used in GCM but not in mesoscale. dummy initialization.
+integer :: pdayend=0 ! end day of for the simulation [day_end]
+
+! isotopes
+INTEGER :: nqperes
+INTEGER, ALLOCATABLE, DIMENSION(:) :: nqfils
+
+! isotopes variables initialisation
+! -- for the moment, interface with dynamics is inactive
+! -- all tracers are parents with no children
+nqperes=nq
+allocate(nqfils(nq))
+nqfils(:)=0
+
+! copy some fundamental parameters to physics 
+! and do some initializations 
+
+!! Initialize dimphy module
+!call init_dimphy(klon_omp,nlayer)
+!...useless in mesoscale
+
+!! initialize physical constants and arrays
+call phys_state_var_init(ngrid,nlayer,nq, traceurs, &
+                         pdayref,pdayend,phour_ini,punjours,zdt_split, &
+                         prad,pg,pr,pcpp, &
+                         nqperes,nqfils)
+
+!! read callphys.def
+CALL Init_phys_lmdz_para(1,1,1,MPI_COMM_WORLD) ! initializes MPI communicator
+                                               ! ... necessary for getin_p in conf_phys
+call conf_phys(ngrid,nlayer,nq)
+
+!! a few time constants initialization 
+!! not done by init_time in phys_state_var_init
+!! and supposed to be done in conf_phys (but not done in mesoscale)
+day_step=punjours/zdt_split
+iphysiq=piphysiq
+ecritstart=0 !! not used in MESOSCALE
+ecritphy=0 !! not used in MESOSCALE
+
+!! check
+PRINT*,'Call to LMD physics:',day_step,' per Martian day'
+PRINT*,'Call to LMD physics: every',iphysiq,' dynamical timesteps'
+PRINT*,'Call to LMD physics: every',dtphys,' seconds'
+PRINT*,'Call to LMD physics: length of day is',daysec,' seconds'
+PRINT*,'Call to LMD physics: initial day is',day_ini
+PRINT*,'Call to LMD physics: initial fractional time is',hour_ini
+
+! Initialize some "temporal and calendar" related variables
+!CALL init_time(day_ini,hour_ini,punjours,ptimestep)
+!...done in phys_state_var_init
+
+end subroutine iniphysiq
+
+END MODULE iniphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/update_inputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,729 @@
+MODULE update_inputs_physiq_mod
+
+IMPLICIT NONE
+
+CHARACTER(len=20),save,allocatable,dimension(:) :: traceurs ! tracer names
+
+CONTAINS
+
+!SUBROUTINE update_inputs_physiq_time
+!SUBROUTINE update_inputs_physiq_tracers
+!SUBROUTINE update_inputs_physiq_constants
+!SUBROUTINE update_inputs_physiq_geom
+!SUBROUTINE update_inputs_physiq_surf
+!SUBROUTINE update_inputs_physiq_soil
+!SUBROUTINE update_inputs_physiq_turb
+!SUBROUTINE update_inputs_physiq_rad
+!SUBROUTINE update_inputs_physiq_slope
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      real function ls2sol(ls)
+
+!c  Returns solar longitude, Ls (in deg.), from day number (in sol),
+!c  where sol=0=Ls=0 at the northern hemisphere spring equinox
+
+      implicit none
+
+!c  Arguments:
+      real ls
+
+!c  Local:
+      double precision xref,zx0,zteta,zz
+!c	xref: mean anomaly, zteta: true anomaly, zx0: eccentric anomaly
+      double precision year_day 
+      double precision peri_day,timeperi,e_elips
+      double precision pi,degrad 
+      parameter (year_day=668.6d0) ! number of sols in a amartian year
+!c      data peri_day /485.0/
+      parameter (peri_day=485.35d0) ! date (in sols) of perihelion
+!c  timeperi: 2*pi*( 1 - Ls(perihelion)/ 360 ); Ls(perihelion)=250.99
+      parameter (timeperi=1.90258341759902d0)
+      parameter (e_elips=0.0934d0)  ! eccentricity of orbit
+      parameter (pi=3.14159265358979d0)
+      parameter (degrad=57.2957795130823d0)
+
+      if (abs(ls).lt.1.0e-5) then
+         if (ls.ge.0.0) then
+            ls2sol = 0.0
+         else
+            ls2sol = year_day
+         end if
+         return
+      end if
+
+      zteta = ls/degrad + timeperi
+      zx0 = 2.0*datan(dtan(0.5*zteta)/dsqrt((1.+e_elips)/(1.-e_elips)))
+      xref = zx0-e_elips*dsin(zx0)
+      zz = xref/(2.*pi)
+      ls2sol = zz*year_day + peri_day
+      if (ls2sol.lt.0.0) ls2sol = ls2sol + year_day
+      if (ls2sol.ge.year_day) ls2sol = ls2sol - year_day
+
+      return
+      end function ls2sol
+!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_time(&
+            JULYR,JULDAY,GMT,&
+            elaps,&
+            lct_input,lon_input,ls_input,&
+            MY)
+
+  USE variables_mod, only: JD_cur,JH_cur_split,phour_ini
+  !! JD_cur <> pday ! Julian day
+  !! JH_cur_split <> ptime ! Julian hour (fraction of day)
+
+  implicit none
+
+  INTEGER, INTENT(IN) :: JULDAY, JULYR
+  REAL, INTENT(IN) :: GMT,elaps,lon_input,ls_input,lct_input
+  REAL,INTENT(OUT) :: MY
+
+  IF (JULYR .ne. 9999) THEN
+    !
+    ! specified
+    !
+    JH_cur_split = (GMT + elaps/3700.) !! universal time (0<JH_cur_split<1): JH_cur_split=0.5 at 12:00 UT 
+    JH_cur_split = MODULO(JH_cur_split,24.)   !! the two arguments of MODULO must be of the same type 
+    JH_cur_split = JH_cur_split / 24.
+    JD_cur = (JULDAY - 1 + INT((3700*GMT+elaps)/88800))
+    JD_cur = MODULO(int(JD_cur),669)
+    MY = (JULYR-2000) + (88800.*(JULDAY - 1)+3700.*GMT+elaps)/59496000.
+    MY = INT(MY)
+  ELSE
+    !
+    ! idealized
+    !
+    JH_cur_split = lct_input - lon_input / 15. + elaps/3700.
+    JH_cur_split = MODULO(JH_cur_split,24.)
+    JH_cur_split = JH_cur_split / 24.
+    JD_cur = floor(ls2sol(ls_input)) + INT((3700*(lct_input - lon_input / 15.) + elaps)/88800)
+    JD_cur = MODULO(int(JD_cur),669)
+    MY = 2024
+    !day_ini = floor(ls2sol(ls_input)) !! JD_cur at firstcall is day_ini
+  ENDIF
+  print *,'** Mars ** TIME IS', JD_cur, JH_cur_split*24.
+
+END SUBROUTINE update_inputs_physiq_time
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_tracers(nq,MARS_MODE)
+
+  INTEGER, INTENT(IN) :: nq,MARS_MODE
+
+  ALLOCATE(traceurs(nq))
+
+  !!! name of tracers to mimic entries in tracer.def 
+  !!! ----> IT IS IMPORTANT TO KEEP SAME ORDERING AS IN THE REGISTRY !!!!
+  !!!                               SAME NAMING   AS IN THE LMD PHYSICS !!!!
+  SELECT CASE (MARS_MODE)
+    CASE(0,10)  
+      traceurs(nq) = 'co2'
+    CASE(1)    ! scalar:qh2o,qh2o_ice
+      traceurs(1)  = 'h2o_vap'
+      traceurs(2)  = 'h2o_ice'
+    CASE(2)    ! scalar:qdust
+      traceurs(1)  = 'dust01'
+    CASE(3)    ! scalar:qdust,qdustn
+      traceurs(1)  = 'dust_mass'
+      traceurs(2)  = 'dust_number'
+    CASE(11)   ! scalar:qh2o,qh2o_ice,qdust,qdustn
+      traceurs(1)  = 'h2o_vap'
+      traceurs(2)  = 'h2o_ice'
+      traceurs(3)  = 'dust_mass'
+      traceurs(4)  = 'dust_number'
+    CASE(12)
+      traceurs(1)  = 'h2o_vap'
+      traceurs(2)  = 'h2o_ice'
+      traceurs(3)  = 'dust_mass'
+      traceurs(4)  = 'dust_number'
+      traceurs(5)  = 'ccn_mass'
+      traceurs(6)  = 'ccn_number'
+    CASE(20) 
+      traceurs(1) = 'qtrac1'
+    CASE(32) ! scalar:qh2o,qh2o_ice,qdust,qdustn,qccn,qccnn,qco2,qco2_ice,qccn_co2,qccnn_co2
+      traceurs(1)   = 'h2o_vap'
+      traceurs(2)   = 'h2o_ice'
+      traceurs(3)   = 'dust_mass'
+      traceurs(4)   = 'dust_number'
+      traceurs(5)   = 'ccn_mass'
+      traceurs(6)   = 'ccn_number'
+      traceurs(7)   = 'co2'
+      traceurs(8)   = 'co2_ice'
+      traceurs(9)   = 'ccnco2_mass'
+      traceurs(10)  = 'ccnco2_number'
+    CASE(42)
+      traceurs(1)  = 'co2'
+      traceurs(2)  = 'co'
+      traceurs(3)  = 'o'
+      traceurs(4)  = 'o1d'
+      traceurs(5)  = 'o2'
+      traceurs(6)  = 'o3'
+      traceurs(7)  = 'h'
+      traceurs(8)  = 'h2'
+      traceurs(9)  = 'oh'
+      traceurs(10)  = 'ho2'
+      traceurs(11)  = 'h2o2'
+      traceurs(12)  = 'ch4'
+      traceurs(13)  = 'n2'
+      traceurs(14)  = 'ar'
+      traceurs(15)  = 'h2o_ice'
+      traceurs(16)  = 'h2o_vap'
+      traceurs(17)  = 'dust_mass'
+      traceurs(18)  = 'dust_number'
+  END SELECT
+
+  !!---------------------!!
+  !! OUTPUT FOR CHECKING !!
+  !!---------------------!!
+  print*,"check: traceurs",traceurs
+
+END SUBROUTINE update_inputs_physiq_tracers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_constants
+
+   USE module_model_constants
+   use comcstfi_h, only: omeg,mugaz
+   use planete_h,  only: year_day,periheli,aphelie, &
+                          peri_day,obliquit,emin_turb, &
+                          lmixmin
+   use surfdat_h,  only: emissiv,albedice,iceradius, &
+                          emisice,dtemisice, &
+                          z0_default
+   use comsoil_h, only: volcapa
+
+   !! comcstfi_h
+   omeg = womeg                
+   mugaz = wmugaz  
+   print*,"check: omeg,mugaz"
+   print*,omeg,mugaz
+   !! planet_h
+   year_day = wyear_day
+   periheli = wperiheli
+   aphelie = waphelie
+   peri_day = wperi_day
+   obliquit = wobliquit
+   emin_turb = wemin_turb
+   lmixmin = wlmixmin
+   print*,"check: year_day,periheli,aphelie,peri_day,obliquit"
+   print*,year_day,periheli,aphelie,peri_day,obliquit
+   print*,"check: emin_turb,lmixmin"
+   print*,emin_turb,lmixmin
+   !! surfdat_h
+   emissiv = wemissiv
+   emisice(1) = wemissiceN
+   emisice(2) = wemissiceS
+   albedice(1) = walbediceN
+   albedice(2) = walbediceS
+   iceradius(1) = wiceradiusN
+   iceradius(2) = wiceradiusS
+   dtemisice(1) = wdtemisiceN
+   dtemisice(2) = wdtemisiceS
+   z0_default = wz0
+   print*,"check: z0def,emissiv,emisice,albedice,iceradius,dtemisice"
+   print*,z0_default,emissiv,emisice,albedice,iceradius,dtemisice
+   !! comsoil_h
+   volcapa = wvolcapa
+   print*,"check: volcapa",volcapa
+
+END SUBROUTINE update_inputs_physiq_constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_geom( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,ngrid,nlayer,&
+            DX,DY,MSFT,&
+            lat_input, lon_input,&
+            XLAT,XLONG)
+
+   ! in WRF (share)
+   USE module_model_constants, only: DEGRAD
+   ! in LMD (phymars)
+   use comgeomfi_h, only: ini_fillgeom
+   ! in LMD (phy_common)
+   USE mod_grid_phy_lmdz, ONLY: init_grid_phy_lmdz
+   USE geometry_mod, ONLY: latitude,latitude_deg,&
+                           longitude,longitude_deg,&
+                           cell_area
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,ngrid,nlayer
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     MSFT,XLAT,XLONG
+   REAL, INTENT(IN) :: dx,dy
+   REAL, INTENT(IN) :: lat_input, lon_input
+   INTEGER :: i,j,subs
+   REAL,DIMENSION(ngrid) :: plon, plat, parea
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+    !-----------------------------------!
+    ! 1D subscript for physics "cursor" !
+    !-----------------------------------!
+    subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+    !----------------------------------------!
+    ! Surface of each part of the grid (m^2) !  
+    !----------------------------------------!
+    !parea(subs) = dx*dy                           !! 1. idealized cases - computational grid
+    parea(subs) = (dx/msft(i,j))*(dy/msft(i,j))    !! 2. WRF map scale factors - assume that msfx=msfy (msf=covariance)
+    !parea(subs)=dx*dy/msfu(i,j)                   !! 3. special for Mercator GCM-like simulations
+
+    !---------------------------------------------!
+    ! Mass-point latitude and longitude (radians) !
+    !---------------------------------------------!
+    IF (JULYR .ne. 9999) THEN
+     plat(subs) = XLAT(i,j)*DEGRAD
+     plon(subs) = XLONG(i,j)*DEGRAD
+    ELSE
+     !!! IDEALIZED CASE
+     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lat: ',lat_input
+     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lon: ',lon_input
+     plat(subs) = lat_input*DEGRAD
+     plon(subs) = lon_input*DEGRAD
+    ENDIF 
+
+   ENDDO
+   ENDDO
+
+   !! FILL GEOMETRICAL ARRAYS !!
+   call ini_fillgeom(ngrid,plat,plon,parea)
+
+   !!! ----------------------------------------------------------
+   !!! --- initializing geometry in phy_common
+   !!! --- (this is quite planet-independent)
+   !!! ----------------------------------------------------------
+   ! initialize mod_grid_phy_lmdz
+   CALL init_grid_phy_lmdz(1,1,ipe-ips+1,jpe-jps+1,nlayer)
+   ! fill in geometry_mod variables
+   ! ... copy over local grid longitudes and latitudes
+   ! ... partly what is done in init_geometry
+   IF(.not.ALLOCATED(longitude)) ALLOCATE(longitude(ngrid))
+   IF(.not.ALLOCATED(longitude_deg)) ALLOCATE(longitude_deg(ngrid))
+   IF(.not.ALLOCATED(latitude)) ALLOCATE(latitude(ngrid))
+   IF(.not.ALLOCATED(latitude_deg)) ALLOCATE(latitude_deg(ngrid))
+   IF(.not.ALLOCATED(cell_area)) ALLOCATE(cell_area(ngrid))
+   longitude(:) = plon(:)
+   latitude(:) = plat(:)
+   longitude_deg(:) = plon(:)/DEGRAD
+   latitude_deg(:) = plat(:)/DEGRAD
+   cell_area(:) = parea(:)
+   !!! ----------------------------------------------------------
+
+END SUBROUTINE update_inputs_physiq_geom
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,MARS_MODE,&
+            M_ALBEDO,CST_AL,&
+            M_TSURF,M_EMISS,M_CO2ICE,&
+            M_GW,M_Z0,CST_Z0,&
+            M_H2OICE,&
+            phisfi_val)
+
+   use surfdat_h, only: phisfi, albedodat,  &
+                        zmea, zstd, zsig, zgam, zthe, z0, &
+                        tsurf, co2ice, emis, qsurf
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,MARS_MODE
+   INTEGER :: i,j,subs,nlast
+   REAL, INTENT(IN  ) :: CST_AL, phisfi_val, CST_Z0
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_ALBEDO,M_TSURF,M_EMISS,M_CO2ICE,M_H2OICE,M_Z0
+   REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: M_GW  
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !---------------------!
+     ! Ground geopotential !
+     !---------------------!
+     phisfi(subs) = phisfi_val
+
+     !---------------!
+     ! Ground albedo !
+     !---------------!
+     IF (JULYR .ne. 9999) THEN 
+      IF (CST_AL == 0) THEN
+       albedodat(subs)=M_ALBEDO(i,j)
+      ELSE 
+       albedodat(subs)=CST_AL
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT ALBEDO ', albedodat
+      ENDIF
+     ELSE
+      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION albedo: ', CST_AL
+      albedodat(subs)=CST_AL
+     ENDIF
+
+     !-----------------------------------------!
+     ! Gravity wave parametrization            !
+     ! NB: usually 0 in mesoscale applications !
+     !-----------------------------------------!
+     IF (JULYR .ne. 9999) THEN
+      zmea(subs)=M_GW(i,1,j)
+      zstd(subs)=M_GW(i,2,j)
+      zsig(subs)=M_GW(i,3,j)
+      zgam(subs)=M_GW(i,4,j)
+      zthe(subs)=M_GW(i,5,j)
+     ELSE
+      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION GWdrag OFF'
+      zmea(subs)=0.
+      zstd(subs)=0.
+      zsig(subs)=0.
+      zgam(subs)=0.
+      zthe(subs)=0.
+     ENDIF
+
+     !----------------------------!
+     ! Variable surface roughness !
+     !----------------------------!
+     IF (JULYR .ne. 9999) THEN
+      IF (CST_Z0 == 0) THEN
+       z0(subs) = M_Z0(i,j)
+      ELSE
+       z0(subs) = CST_Z0
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT SURF ROUGHNESS (m) ',CST_Z0
+      ENDIF
+     ELSE
+      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION z0 (m) ', CST_Z0
+      z0(subs)=CST_Z0
+     ENDIF
+     !!!! ADDITIONAL SECURITY. THIS MIGHT HAPPEN WITH OLD INIT FILES.
+     IF (z0(subs) == 0.) THEN
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *, 'WELL, z0 is 0, this is no good. Setting to old defaults value 0.01 m'
+       z0(subs) = 0.01
+     ENDIF
+     !!!! ADDITIONAL SECURITY. INTERP+SMOOTH IN GEOGRID MIGHT YIELD NEGATIVE Z0 !!!
+     IF (z0(subs) < 0.) THEN
+       PRINT *, 'WELL, z0 is NEGATIVE, this is impossible. better stop here.'
+       PRINT *, 'advice --> correct interpolation / smoothing of z0 in WPS'
+       PRINT *, '           -- or check the constant value set in namelist.input'
+       STOP
+     ENDIF
+
+     !-----------------------------------------------!
+     ! Ground temperature, emissivity, CO2 ice cover !
+     !-----------------------------------------------!
+     tsurf(subs) = M_TSURF(i,j)
+     emis(subs) = M_EMISS(i,j)
+     co2ice(subs) = M_CO2ICE(i,j)
+
+     !-------------------!
+     ! Tracer at surface !
+     !-------------------!
+     qsurf(subs,:)=0. ! default case
+     SELECT CASE (MARS_MODE)
+       CASE(1)
+       qsurf(subs,2)=M_H2OICE(i,j)    !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
+                                      !! ----- retrocompatible ancienne physique
+                                      !! ----- [H2O ice is last tracer in qsurf in LMD physics]
+       CASE(2)   
+       qsurf(subs,1)=0.                !! not coupled with lifting for the moment [non remobilise]
+       !CASE(3)
+       !qsurf(subs,1)=q_prof(1,1)                !!! temporaire, a definir       
+       !qsurf(subs,2)=q_prof(1,2)     
+       CASE(11)
+       qsurf(subs,2)=M_H2OICE(i,j)    !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
+       qsurf(subs,3)=0.                !! not coupled with lifting for the moment [non remobilise]
+       CASE(12)
+       qsurf(subs,2)=M_H2OICE(i,j)    !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
+       qsurf(subs,3)=0.                !! not coupled with lifting for the moment [non remobilise]
+     END SELECT
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: phisfi",phisfi(1),phisfi(nlast)
+   print*,"check: albedodat",albedodat(1),albedodat(nlast)
+   print*,"check: zmea",zmea(1),zmea(nlast)
+   print*,"check: zstd",zstd(1),zstd(nlast)
+   print*,"check: zsig",zsig(1),zsig(nlast)
+   print*,"check: zgam",zgam(1),zgam(nlast)
+   print*,"check: zthe",zthe(1),zthe(nlast)
+   print*,"check: z0",z0(1),z0(nlast)
+   print*,"check: tsurf",tsurf(1),tsurf(nlast)
+   print*,"check: emis",emis(1),emis(nlast)
+   print*,"check: co2ice",co2ice(1),co2ice(nlast)
+   print*,"check: qsurf",qsurf(1,:),qsurf(nlast,:)
+
+END SUBROUTINE update_inputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,nsoil,&
+            M_TI,CST_TI,&
+            M_ISOIL,M_DSOIL,&
+            M_TSOIL,M_TSURF)
+
+   use comsoil_h, only: inertiedat,mlayer,layer,tsoil
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,nsoil
+   INTEGER :: i,j,subs,nlast,k
+   REAL, INTENT(IN  ) :: CST_TI 
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_TI, M_TSURF
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(IN)  :: &
+     M_TSOIL, M_ISOIL, M_DSOIL
+   REAL :: inertiedat_val
+   REAL :: lay1,alpha
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-----------------!
+     ! Thermal Inertia !
+     !-----------------!
+     IF (JULYR .ne. 9999) THEN
+      IF (CST_TI == 0) THEN
+       inertiedat_val=M_TI(i,j)
+      ELSE
+       inertiedat_val=CST_TI
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT THERMAL INERTIA ', inertiedat_val
+      ENDIF
+     ELSE
+      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION inertia: ',CST_TI
+      inertiedat_val=CST_TI
+     ENDIF
+     !inertiedat(subs) = inertiedat_val
+     !--pb de dimensions???!!???
+     IF (JULYR .ne. 9999) THEN
+       inertiedat(subs,:)=M_ISOIL(i,:,j) !! verifier que cest bien hires TI en surface
+       mlayer(0:nsoil-1)=M_DSOIL(i,:,j)
+     ELSE
+        IF ( nsoil .lt. 18 ) THEN
+            PRINT *,'** Mars ** WRONG NUMBER OF SOIL LAYERS. SHOULD BE 18 AND IT IS ',nsoil
+            STOP
+        ENDIF
+        IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION isoil and dsoil standard'
+        do k=1,nsoil
+         inertiedat(subs,k) = inertiedat_val
+         !mlayer(k-1) = sqrt(887.75/3.14)*((2.**(k-0.5))-1.) * inertiedat_val / wvolcapa    ! old setting
+         mlayer(k-1) = 2.E-4 * (2.**(k-0.5-1.))                                            ! new gcm settings
+        enddo
+     ENDIF
+     IF ( (i == ips) .AND. (j == jps) ) &
+         PRINT *,'** Mars ** TI and depth profiles are',inertiedat(subs,:),mlayer(0:nsoil-1)
+
+     !!!!!!!!!!!!!!!!! DONE in soil_setting.F 
+     ! 1.5 Build layer(); following the same law as mlayer()
+     ! Assuming layer distribution follows mid-layer law:
+     ! layer(k)=lay1*alpha**(k-1)
+     lay1=sqrt(mlayer(0)*mlayer(1))
+     alpha=mlayer(1)/mlayer(0)
+     do k=1,nsoil
+       layer(k)=lay1*(alpha**(k-1))
+     enddo
+
+     !------------------------!
+     ! Deep soil temperatures ! 
+     !------------------------!
+     IF (M_TSOIL(i,1,j) .gt. 0. .and. JULYR .ne. 9999) THEN
+       tsoil(subs,:)=M_TSOIL(i,:,j)
+     ELSE
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** no tsoil. set it to tsurf.'
+       do k=1,nsoil
+        tsoil(subs,k) = M_TSURF(i,j)
+       enddo
+     ENDIF
+
+   ENDDO
+   ENDDO
+
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: inertiedat",inertiedat(1,:),inertiedat(nlast,:)
+   print*,"check: mlayer",mlayer(:)
+   print*,"check: layer",layer(:)
+   print*,"check: tsoil",tsoil(1,:),tsoil(nlast,:)
+
+END SUBROUTINE update_inputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,&
+            RESTART,isles,&
+            M_Q2,M_WSTAR)
+
+   use turb_mod, only: q2,wstar,turb_resolved
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs,nlast      
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_WSTAR
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(IN) :: M_Q2
+   LOGICAL, INTENT(IN ) :: RESTART,isles
+
+   !! to know if this is turbulence-resolving run or not
+   turb_resolved = isles
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !PBL wind variance
+     IF (.not. restart) THEN
+      q2(subs,:) = 1.E-6      
+      wstar(subs)=0.
+     ELSE
+      q2(subs,:)=M_Q2(i,:,j)
+      wstar(subs)=M_WSTAR(i,j)
+     ENDIF
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: q2",q2(1,:),q2(nlast,:)
+   print*,"check: wstar",wstar(1),wstar(nlast)
+
+END SUBROUTINE update_inputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            RESTART,&
+            M_FLUXRAD)
+
+   use dimradmars_mod, only: fluxrad
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs,nlast      
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_FLUXRAD
+   LOGICAL, INTENT(IN ) :: RESTART
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     ! fluxrad_save
+     IF (.not. restart) THEN
+      fluxrad(subs)=0.
+     ELSE
+      fluxrad(subs)=M_FLUXRAD(i,j)
+     ENDIF
+     !! et fluxrad_sky ???!???
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: fluxrad",fluxrad(1),fluxrad(nlast)
+
+END SUBROUTINE update_inputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_slope( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,&
+            SLPX,SLPY)
+
+   USE module_model_constants, only: DEGRAD
+   USE slope_mod, ONLY: theta_sl, psi_sl
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: SLPX,SLPY
+   INTEGER :: i,j,subs,nlast
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------!
+     ! Slope inclination !
+     !-------------------!
+     IF (JULYR .ne. 9999) THEN
+       theta_sl(subs)=atan(sqrt( (1000.*SLPX(i,j))**2 + (1000.*SLPY(i,j))**2 ))
+       theta_sl(subs)=theta_sl(subs)/DEGRAD
+     ELSE
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'IDEALIZED SIMULATION: theta_sl = 0'
+       theta_sl(subs)=0.
+     ENDIF
+
+     !-------------------------------------------!
+     ! Slope orientation; 0 is north, 90 is east !
+     !-------------------------------------------!
+     IF (JULYR .ne. 9999) THEN
+       psi_sl(subs)=-90.*DEGRAD-atan(SLPY(i,j)/SLPX(i,j))
+       if (SLPX(i,j) .ge. 0.) then
+         psi_sl(subs)=psi_sl(subs)-180.*DEGRAD
+       endif
+       psi_sl(subs)=360.*DEGRAD+psi_sl(subs)
+       psi_sl(subs)=psi_sl(subs)/DEGRAD
+       psi_sl(subs) = MODULO(psi_sl(subs)+180.,360.)
+     ELSE
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'IDEALIZED SIMULATION: psi_sl = 0'
+       psi_sl(subs) = 0.
+     ENDIF
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: theta_sl",theta_sl(1),theta_sl(nlast)
+   print*,"check: psi_sl",psi_sl(1),psi_sl(nlast)
+
+END SUBROUTINE update_inputs_physiq_slope
+
+END MODULE update_inputs_physiq_mod
+
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/update_outputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,221 @@
+MODULE update_outputs_physiq_mod
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            MARS_MODE,&
+            M_TSURF,M_CO2ICE,&
+            M_H2OICE)
+
+   use surfdat_h, only: tsurf, co2ice, qsurf
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER, INTENT(IN) :: MARS_MODE
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_TSURF,M_CO2ICE,M_H2OICE
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_CO2ICE(i,j) = co2ice(subs)
+     M_TSURF(i,j) = tsurf(subs)
+     SELECT CASE (MARS_MODE)
+      CASE (1,11,12)
+        M_H2OICE(i,j) = qsurf(subs,2)  !! see above Tracer at surface
+     END SELECT
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            nsoil,&
+            M_TSOIL)
+
+   use comsoil_h, only: tsoil
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,nsoil
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(INOUT)  :: &
+     M_TSOIL
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_TSOIL(i,:,j) = tsoil(subs,:)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            M_FLUXRAD)
+
+   use dimradmars_mod, only: fluxrad
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: M_FLUXRAD
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_FLUXRAD(i,j) = fluxrad(subs)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            M_Q2,M_WSTAR,&
+            HFMAX,ZMAX,USTM,HFX)
+
+   use turb_mod, only: q2,wstar,ustar,sensibFlux,&
+                        hfmax_th,zmax_th
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_WSTAR,HFMAX,ZMAX,USTM,HFX
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT) :: M_Q2
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_Q2(i,kps:kpe+1,j) = q2(subs,:)
+     M_WSTAR(i,j) = wstar(subs)
+
+     !! output only (arrays already in phys modules)
+     HFMAX(i,j) = HFMAX_TH(subs)
+     ZMAX(i,j) = ZMAX_TH(subs)
+     USTM(i,j) = ustar(subs)
+     HFX(i,j) = sensibFlux(subs)
+
+  ENDDO
+  ENDDO
+
+END SUBROUTINE update_outputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_diag( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            SWDOWNZ,TAU_DUST,QSURFDUST,&
+            MTOT,ICETOT,TAU_ICE,&
+            HR_SW,HR_LW,HR_DYN,DT,DTRAD,&
+            RDUST,VMR_ICE,RICE,&
+            CLOUDFRAC,TOTCLOUDFRAC,&
+            RAIN,SNOW,REEVAP,SURFRAIN,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+            FLUXSURF_LW,FLXGRD,LSCEZ,H2OICE_REFF,LATENT_HF)
+   
+   USE comm_wrf !! to get fields to be written from physiq
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
+     SWDOWNZ,TAU_DUST,QSURFDUST,&
+     MTOT,ICETOT,TAU_ICE,&
+     TOTCLOUDFRAC,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+     FLUXSURF_LW,FLXGRD,LATENT_HF,REEVAP,SURFRAIN
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: &
+     HR_SW,HR_LW,RDUST,VMR_ICE,RICE,CLOUDFRAC,HR_DYN,DT,DTRAD,RAIN,SNOW,&
+     LSCEZ,H2OICE_REFF
+   INTEGER :: i,j,subs
+
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !! get diagnostics from physics
+     SWDOWNZ(i,j) = comm_SWDOWNZ(subs)
+     TAU_DUST(i,j) = comm_TAU_DUST(subs)
+     QSURFDUST(i,j) = comm_QSURFDUST(subs)
+     MTOT(i,j) = comm_MTOT(subs)
+     ICETOT(i,j) = comm_ICETOT(subs)
+     TAU_ICE(i,j) = comm_TAU_ICE(subs)
+     HR_SW(i,kps:kpe,j) = comm_HR_SW(subs,kps:kpe)
+     HR_LW(i,kps:kpe,j) = comm_HR_LW(subs,kps:kpe)
+     RDUST(i,kps:kpe,j) = comm_RDUST(subs,kps:kpe)
+     VMR_ICE(i,kps:kpe,j) = comm_VMR_ICE(subs,kps:kpe)
+     RICE(i,kps:kpe,j) = comm_RICE(subs,kps:kpe)
+
+   ENDDO
+   ENDDO
+
+   CALL deallocate_comm_wrf
+
+END SUBROUTINE update_outputs_physiq_diag
+
+END MODULE update_outputs_physiq_mod
+
+
+
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/variables_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/variables_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_mars_lmd_new/variables_mod.F	(revision 2744)
@@ -0,0 +1,80 @@
+MODULE variables_mod
+
+IMPLICIT NONE
+
+REAL :: JD_cur !pday !JD_cur ! Julian day
+REAL :: JH_cur_split !ptime !JH_cur_split ! Julian hour (fraction of day)
+REAL :: zdt_split !ptimestep !zdt_split ! time step over which the physics are evaluated
+REAL :: phour_ini ! start time (fraction of day) of the run 0=<phour_ini<1
+REAL,DIMENSION(:,:),ALLOCATABLE :: zplev_omp !pplev !zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+REAL,DIMENSION(:,:),ALLOCATABLE :: zplay_omp !pplay !zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+REAL,DIMENSION(:,:),ALLOCATABLE :: zpk_omp!(klon,llm)
+REAL,DIMENSION(:,:),ALLOCATABLE :: zphi_omp !pphi !zphi_omp(klon,llm) ! geopotential at midlayer
+REAL,DIMENSION(:),ALLOCATABLE :: zphis_omp!(klon) ! surface geopotential
+REAL,DIMENSION(:),ALLOCATABLE :: presnivs_omp!(llm) ! approximate pressure of atm. layers
+REAL,DIMENSION(:,:),ALLOCATABLE :: zufi_omp !pu !zufi_omp(klon,llm) ! zonal wind (m/s)
+REAL,DIMENSION(:,:),ALLOCATABLE :: zvfi_omp !pv !zvfi_omp(klon,llm) ! meridional wind (m/s)
+REAL,DIMENSION(:,:),ALLOCATABLE :: zrfi_omp!(klon,llm) ! relative wind vorticity, in s-1
+REAL,DIMENSION(:,:),ALLOCATABLE :: ztfi_omp !pt !ztfi_omp(klon,llm) ! temperature (K)
+REAL,DIMENSION(:,:,:),ALLOCATABLE :: zqfi_omp !pq !zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+REAL,DIMENSION(:,:),ALLOCATABLE :: flxwfi_omp !flxw !flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) 
+! tendencies (in */s) from the physics:
+REAL,DIMENSION(:,:),ALLOCATABLE :: zdufi_omp !pdu !zdufi_omp(klon,llm) ! tendency on zonal winds
+REAL,DIMENSION(:,:),ALLOCATABLE :: zdvfi_omp !pdv !zdvfi_omp(klon,llm) ! tendency on meridional winds
+REAL,DIMENSION(:,:),ALLOCATABLE :: zdtfi_omp !pdt !zdtfi_omp(klon,llm) ! tendency on temperature
+REAL,DIMENSION(:,:,:),ALLOCATABLE :: zdqfi_omp !pdq !zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+REAL,DIMENSION(:),ALLOCATABLE :: zdpsrf_omp !pdpsrf !zdpsrf_omp(klon) ! tendency on surface pressure
+
+CONTAINS
+
+SUBROUTINE allocate_interface(klon,llm,nqtot)
+
+  IMPLICIT NONE
+ 
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+ 
+  IF (.NOT.ALLOCATED(zplev_omp)) ALLOCATE(zplev_omp(klon,llm+1))
+  IF (.NOT.ALLOCATED(zplay_omp)) ALLOCATE(zplay_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zpk_omp)) ALLOCATE(zpk_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphi_omp)) ALLOCATE(zphi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphis_omp)) ALLOCATE(zphis_omp(klon))
+  IF (.NOT.ALLOCATED(presnivs_omp)) ALLOCATE(presnivs_omp(llm))
+  IF (.NOT.ALLOCATED(zufi_omp)) ALLOCATE(zufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zvfi_omp)) ALLOCATE(zvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zrfi_omp)) ALLOCATE(zrfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(ztfi_omp)) ALLOCATE(ztfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zqfi_omp)) ALLOCATE(zqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(flxwfi_omp)) ALLOCATE(flxwfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdufi_omp)) ALLOCATE(zdufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdvfi_omp)) ALLOCATE(zdvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdtfi_omp)) ALLOCATE(zdtfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdqfi_omp)) ALLOCATE(zdqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(zdpsrf_omp)) ALLOCATE(zdpsrf_omp(klon))
+
+END SUBROUTINE allocate_interface
+
+SUBROUTINE deallocate_interface
+
+  DEALLOCATE(zplev_omp)
+  DEALLOCATE(zplay_omp)
+  DEALLOCATE(zpk_omp)
+  DEALLOCATE(zphi_omp)
+  DEALLOCATE(zphis_omp)
+  DEALLOCATE(presnivs_omp)
+  DEALLOCATE(zufi_omp)
+  DEALLOCATE(zvfi_omp)
+  DEALLOCATE(zrfi_omp)
+  DEALLOCATE(ztfi_omp)
+  DEALLOCATE(zqfi_omp)
+  DEALLOCATE(flxwfi_omp)
+  DEALLOCATE(zdufi_omp)
+  DEALLOCATE(zdvfi_omp)
+  DEALLOCATE(zdtfi_omp)
+  DEALLOCATE(zdqfi_omp)
+  DEALLOCATE(zdpsrf_omp)
+
+END SUBROUTINE deallocate_interface
+
+END MODULE variables_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/callphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/callphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/callphysiq_mod.F	(revision 2744)
@@ -0,0 +1,55 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+ !! ----------------------------------------------------------
+ !! ---- CALL TO NO PHYSICS
+ !! ----------------------------------------------------------
+
+CONTAINS
+
+SUBROUTINE call_physiq(planet_type, klon,llm,nqtot,                       &
+                       debut_split,lafin_split)
+
+  USE variables_mod
+
+  IMPLICIT NONE
+
+  character(len=10),INTENT(IN) :: planet_type ! planet type ('earth','mars',...)
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+  ! data file
+  INTEGER :: i,k
+  REAL :: hr_sw(llm)
+  REAL :: hr_lw(llm)
+  REAL :: hr_dyn(llm)
+
+  open(17,file='prescribed_sw.txt',form='formatted',status='old')
+  open(18,file='prescribed_lw.txt',form='formatted',status='old')
+  open(19,file='prescribed_dyn.txt',form='formatted',status='old')
+  rewind(17)
+  rewind(18)
+  rewind(19)
+  DO k=1,llm
+    read(17,*) hr_sw(k)
+    read(18,*) hr_lw(k)
+    read(19,*) hr_dyn(k)
+  ENDDO
+  close(17)
+  close(18)
+  close(19)
+
+  DO i=1,klon
+    zdtfi_omp(i,:)=hr_sw(:)+hr_lw(:)+hr_dyn(:)
+  ENDDO
+
+
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/iniphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/iniphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/iniphysiq_mod.F	(revision 2744)
@@ -0,0 +1,26 @@
+MODULE iniphysiq_mod
+
+CONTAINS
+
+subroutine iniphysiq(ngrid,nlayer,nq,piphysiq,&
+                     punjours, pdayref, &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+implicit none
+
+real,intent(in) :: prad ! radius of the planet (m)
+real,intent(in) :: pg ! gravitational acceleration (m/s2)
+real,intent(in) :: pr ! ! reduced gas constant R/mu
+real,intent(in) :: pcpp ! specific heat Cp
+real,intent(in) :: punjours ! length (in s) of a standard day [daysec]
+integer,intent(in) :: pdayref ! reference day of for the simulation [day_ini]
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer,intent(in) :: ngrid ! number of physics columns for this MPI process
+integer,intent(in) :: nlayer ! number of atmospheric layers
+integer,intent(in) :: nq ! number of tracers
+real,intent(in) :: piphysiq   ! call physics every piphysiq dynamical timesteps
+
+end subroutine iniphysiq
+
+END MODULE iniphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/update_inputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,149 @@
+MODULE update_inputs_physiq_mod
+
+CONTAINS
+
+!SUBROUTINE update_inputs_physiq_time
+!SUBROUTINE update_inputs_physiq_tracers
+!SUBROUTINE update_inputs_physiq_constants
+!SUBROUTINE update_inputs_physiq_geom
+!SUBROUTINE update_inputs_physiq_surf
+!SUBROUTINE update_inputs_physiq_soil
+!SUBROUTINE update_inputs_physiq_turb
+!SUBROUTINE update_inputs_physiq_rad
+!SUBROUTINE update_inputs_physiq_slope
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_time(&
+            JULYR,JULDAY,GMT,&
+            elaps,&
+            lct_input,lon_input,ls_input,&
+            MY)
+
+  INTEGER, INTENT(IN) :: JULDAY, JULYR
+  REAL, INTENT(IN) :: GMT,elaps,lon_input,ls_input,lct_input
+  REAL,INTENT(OUT) :: MY
+
+END SUBROUTINE update_inputs_physiq_time
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_tracers(nq,MARS_MODE)
+
+  INTEGER, INTENT(IN) :: nq,MARS_MODE
+
+END SUBROUTINE update_inputs_physiq_tracers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_constants
+
+END SUBROUTINE update_inputs_physiq_constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_geom( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,ngrid,nlayer,&
+            DX,DY,MSFT,&
+            lat_input, lon_input,&
+            XLAT,XLONG)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,ngrid,nlayer
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     MSFT,XLAT,XLONG
+   REAL, INTENT(IN) :: dx,dy
+   REAL, INTENT(IN) :: lat_input, lon_input
+
+END SUBROUTINE update_inputs_physiq_geom
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,MARS_MODE,&
+            M_ALBEDO,CST_AL,&
+            M_TSURF,M_EMISS,M_CO2ICE,&
+            M_GW,M_Z0,CST_Z0,&
+            M_H2OICE,&
+            phisfi_val)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,MARS_MODE
+   INTEGER :: i,j,subs,nlast
+   REAL, INTENT(IN  ) :: CST_AL, phisfi_val, CST_Z0
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_ALBEDO,M_TSURF,M_EMISS,M_CO2ICE,M_H2OICE,M_Z0
+   REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: M_GW  
+
+END SUBROUTINE update_inputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,nsoil,&
+            M_TI,CST_TI,&
+            M_ISOIL,M_DSOIL,&
+            M_TSOIL,M_TSURF)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,nsoil
+   INTEGER :: i,j,subs,nlast,k
+   REAL, INTENT(IN  ) :: CST_TI 
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_TI, M_TSURF
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(IN)  :: &
+     M_TSOIL, M_ISOIL, M_DSOIL
+
+END SUBROUTINE update_inputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,&
+            RESTART,isles,&
+            M_Q2,M_WSTAR)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_WSTAR
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(IN) :: M_Q2
+   LOGICAL, INTENT(IN ) :: RESTART,isles
+
+END SUBROUTINE update_inputs_physiq_turb
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            RESTART,&
+            M_FLUXRAD)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_FLUXRAD
+   LOGICAL, INTENT(IN ) :: RESTART
+
+END SUBROUTINE update_inputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_slope( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,&
+            SLPX,SLPY)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: SLPX,SLPY
+
+END SUBROUTINE update_inputs_physiq_slope
+
+END MODULE update_inputs_physiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/update_outputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,120 @@
+MODULE update_outputs_physiq_mod
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            MARS_MODE,&
+            M_TSURF,M_CO2ICE,&
+            M_H2OICE)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER, INTENT(IN) :: MARS_MODE
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_TSURF,M_CO2ICE,M_H2OICE
+
+END SUBROUTINE update_outputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            nsoil,&
+            M_TSOIL)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,nsoil
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(INOUT)  :: &
+     M_TSOIL
+
+END SUBROUTINE update_outputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            M_FLUXRAD)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: M_FLUXRAD
+
+END SUBROUTINE update_outputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            M_Q2,M_WSTAR,&
+            HFMAX,ZMAX,USTM,HFX)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_WSTAR,HFMAX,ZMAX,USTM,HFX
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT) :: M_Q2
+
+END SUBROUTINE update_outputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_diag( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            SWDOWNZ,TAU_DUST,QSURFDUST,&
+            MTOT,ICETOT,TAU_ICE,&
+            HR_SW,HR_LW,HR_DYN,DT,DTRAD,&
+            RDUST,VMR_ICE,RICE,&
+            CLOUDFRAC,TOTCLOUDFRAC,&
+            RAIN,SNOW,REEVAP,SURFRAIN,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+            FLUXSURF_LW,FLXGRD,LSCEZ,H2OICE_REFF,LATENT_HF)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
+     SWDOWNZ,TAU_DUST,QSURFDUST,&
+     MTOT,ICETOT,TAU_ICE,&
+     TOTCLOUDFRAC,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+     FLUXSURF_LW,FLXGRD,LATENT_HF,REEVAP,SURFRAIN
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: &
+     HR_SW,HR_LW,RDUST,VMR_ICE,RICE,CLOUDFRAC,HR_DYN,DT,DTRAD,RAIN,SNOW,&
+     LSCEZ,H2OICE_REFF
+   REAL, DIMENSION(kms:kme) :: phr_sw,phr_lw,phr_dyn
+   INTEGER :: i,j,subs
+
+  open(17,file='prescribed_sw.txt',form='formatted',status='old')
+  open(18,file='prescribed_lw.txt',form='formatted',status='old')
+  open(19,file='prescribed_dyn.txt',form='formatted',status='old')
+  rewind(17)
+  rewind(18)
+  rewind(19)
+  DO k=1,kpe-kps+1
+    read(17,*) phr_sw(k)
+    read(18,*) phr_lw(k)
+    read(19,*) phr_dyn(k)
+  ENDDO
+  close(19)
+  close(18)
+  close(17)
+ !print*,'phr_lw',phr_lw 
+  DO j=jps,jpe 
+  DO i=ips,ipe
+    HR_SW(i,:,j)=phr_sw(:)
+    HR_LW(i,:,j)=phr_lw(:)
+    HR_DYN(i,:,j)=phr_dyn(:)
+  ENDDO
+  ENDDO
+
+END SUBROUTINE update_outputs_physiq_diag
+
+END MODULE update_outputs_physiq_mod
+
+
+
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/variables_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/variables_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/variables_mod.F	(revision 2744)
@@ -0,0 +1,85 @@
+MODULE variables_mod
+
+IMPLICIT NONE
+
+REAL*8 :: JD_cur !pday !JD_cur ! Julian day
+REAL*8 :: JH_cur_split !ptime !JH_cur_split ! Julian hour (fraction of day)
+REAL*8 :: zdt_split !ptimestep !zdt_split ! time step over which the physics are evaluated
+REAL*8 :: phour_ini ! start time (fraction of day) of the run 0=<phour_ini<1
+REAL*8 :: counter
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplev_omp !pplev !zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplay_omp !pplay !zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zpk_omp!(klon,llm)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zphi_omp !pphi !zphi_omp(klon,llm) ! geopotential at midlayer
+REAL*8,DIMENSION(:),ALLOCATABLE :: zphis_omp!(klon) ! surface geopotential
+REAL*8,DIMENSION(:),ALLOCATABLE :: presnivs_omp!(llm) ! approximate pressure of atm. layers
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zufi_omp !pu !zufi_omp(klon,llm) ! zonal wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zvfi_omp !pv !zvfi_omp(klon,llm) ! meridional wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zrfi_omp!(klon,llm) ! relative wind vorticity, in s-1
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: ztfi_omp !pt !ztfi_omp(klon,llm) ! temperature (K)
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zqfi_omp !pq !zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: flxwfi_omp !flxw !flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s)  ! tendencies (in */s) from the physics:
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdufi_omp !pdu !zdufi_omp(klon,llm) ! tendency on zonal winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdvfi_omp !pdv !zdvfi_omp(klon,llm) ! tendency on meridional winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdtfi_omp !pdt !zdtfi_omp(klon,llm) ! tendency on temperature
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zdqfi_omp !pdq !zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+REAL*8,DIMENSION(:),ALLOCATABLE :: zdpsrf_omp !pdpsrf !zdpsrf_omp(klon) !tendency on surface pressure
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: hrlw,hrsw
+
+CONTAINS
+
+SUBROUTINE allocate_interface(klon,llm,nqtot)
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+
+  IF (.NOT.ALLOCATED(zplev_omp)) ALLOCATE(zplev_omp(klon,llm+1))
+  IF (.NOT.ALLOCATED(zplay_omp)) ALLOCATE(zplay_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zpk_omp)) ALLOCATE(zpk_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphi_omp)) ALLOCATE(zphi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphis_omp)) ALLOCATE(zphis_omp(klon))
+  IF (.NOT.ALLOCATED(presnivs_omp)) ALLOCATE(presnivs_omp(llm))
+  IF (.NOT.ALLOCATED(zufi_omp)) ALLOCATE(zufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zvfi_omp)) ALLOCATE(zvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zrfi_omp)) ALLOCATE(zrfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(ztfi_omp)) ALLOCATE(ztfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zqfi_omp)) ALLOCATE(zqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(flxwfi_omp)) ALLOCATE(flxwfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdufi_omp)) ALLOCATE(zdufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdvfi_omp)) ALLOCATE(zdvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdtfi_omp)) ALLOCATE(zdtfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdqfi_omp)) ALLOCATE(zdqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(zdpsrf_omp)) ALLOCATE(zdpsrf_omp(klon))
+  IF (.NOT.ALLOCATED(hrlw)) ALLOCATE(hrlw(klon,llm))
+  IF (.NOT.ALLOCATED(hrsw)) ALLOCATE(hrsw(klon,llm))
+
+END SUBROUTINE allocate_interface
+
+SUBROUTINE deallocate_interface
+
+  DEALLOCATE(zplev_omp)
+  DEALLOCATE(zplay_omp)
+  DEALLOCATE(zpk_omp)
+  DEALLOCATE(zphi_omp)
+  DEALLOCATE(zphis_omp)
+  DEALLOCATE(presnivs_omp)
+  DEALLOCATE(zufi_omp)
+  DEALLOCATE(zvfi_omp)
+  DEALLOCATE(zrfi_omp)
+  DEALLOCATE(ztfi_omp)
+  DEALLOCATE(zqfi_omp)
+  DEALLOCATE(flxwfi_omp)
+  DEALLOCATE(zdufi_omp)
+  DEALLOCATE(zdvfi_omp)
+  DEALLOCATE(zdtfi_omp)
+  DEALLOCATE(zdqfi_omp)
+  DEALLOCATE(zdpsrf_omp)
+  DEALLOCATE(hrlw)
+  DEALLOCATE(hrsw)
+
+END SUBROUTINE deallocate_interface
+
+END MODULE variables_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/callphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/callphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/callphysiq_mod.F	(revision 2744)
@@ -0,0 +1,70 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+CONTAINS
+
+SUBROUTINE call_physiq(planet_type,klon,llm,nqtot,                  &
+                       debut_split,lafin_split)
+ 
+  USE variables_mod
+  USE physiq_mod, ONLY: physiq
+  use phys_state_var_mod , only : qsurf
+  use comm_wrf, only : allocate_comm_wrf
+  use tracer_h, only: noms
+ 
+  IMPLICIT NONE
+  character(len=10),INTENT(IN) :: planet_type ! planet type ('earth','mars',...)
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+
+  ! Local variables
+!  CHARACTER(len=11) :: modname="call_physiq"
+
+! Sanity check on physics package type
+  IF (debut_split) THEN
+    IF (planet_type.ne."titan") THEN
+     PRINT*,"wrong planet_type for this physics package"
+     STOP
+    ENDIF
+  ENDIF
+
+  qsurf(:,:)=zqfi_omp(:,1,:)
+  print*,'zdt_split',zdt_split
+
+  call allocate_comm_wrf(klon,llm)
+
+! Call physics package with required inputs/outputs
+  CALL physiq(klon,           & ! ngrid
+              llm,            & ! nlayer
+              nqtot,          & ! nq
+              noms,          & ! nametrac
+              debut_split,    & ! firstcall
+              lafin_split,    & ! lastcall
+              jD_cur,         & ! pday
+              jH_cur_split,   & ! ptime
+              zdt_split,      & ! ptimestep
+              zplev_omp,      & ! pplev
+              zplay_omp,      & ! pplay
+              zphi_omp,       & ! pphi
+              zufi_omp,       & ! pu
+              zvfi_omp,       & ! pv
+              ztfi_omp,       & ! pt
+              zqfi_omp,       & ! pq
+              flxwfi_omp,     & ! flxw
+              zdufi_omp,      & ! pdu
+              zdvfi_omp,      & ! pdv
+              zdtfi_omp,      & ! pdt
+              zdqfi_omp,      & ! pdq
+              zdpsrf_omp)       ! pdpsrf
+
+
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/iniphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/iniphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/iniphysiq_mod.F	(revision 2744)
@@ -0,0 +1,163 @@
+MODULE iniphysiq_mod
+
+CONTAINS
+
+subroutine iniphysiq(ngrid,nlayer,nq,piphysiq,&
+                     punjours, pdayref, &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+!use control_mod, only: nday
+!use surf_heat_transp_mod, only: ini_surf_heat_transp
+!use infotrac, only : nqtot ! number of advected tracers
+!USE comvert_mod, ONLY: ap,bp,preff
+use inifis_mod, only: inifis
+use ioipsl_getin_p_mod, only: getin_p
+
+!use inigeomphy_mod, only: inigeomphy
+!use geometry_mod, only: cell_area, & ! physics grid area (m2)
+!                        longitude, & ! longitudes (rad)
+!                        latitude ! latitudes (rad)
+! necessary to get klon_omp
+!USE mod_phys_lmdz_para, ONLY: klon_omp ! number of columns (on local omp grid)
+USE mod_phys_lmdz_para, ONLY: Init_phys_lmdz_para
+USE dimphy, ONLY: init_dimphy
+USE phys_state_var_mod
+!use planete_mod, only: year_day, periastr, apoastr, peri_day,&
+!                       obliquit, z0, lmixmin, emin_turb
+!                       init_planete_mod
+use planete_mod
+use time_phylmdz_mod, only: dtphys, daysec,day_ini
+use planete_mod, only: year_day, periastr, apoastr, peri_day,&
+                   obliquit, z0, lmixmin, emin_turb
+use surfdat_h,  only: emissiv,iceradius, &
+                    emisice,dtemisice
+use comcstfi_mod, only: omeg,mugaz
+use tracer_h, only: nqtot_p
+!use comm_wrf, only : allocate_comm_wrf
+
+implicit none
+
+INCLUDE 'mpif.h'
+
+REAL,intent(in) :: prad
+REAL,intent(in) :: pg
+REAL,intent(in) :: pr
+REAL,intent(in) :: pcpp
+REAL,intent(in) :: punjours
+!DOUBLE PRECISION,intent(in) :: ptimestep
+
+!real,intent(in) :: prad ! radius of the planet (m)
+!real,intent(in) :: pg ! gravitational acceleration (m/s2)
+!real,intent(in) :: pr ! ! reduced gas constant R/mu
+!real,intent(in) :: pcpp ! specific heat Cp
+!real,intent(in) :: punjours ! length (in s) of a standard day [daysec]
+integer,intent(in) :: pdayref ! reference day of for the simulation [day_ini]
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer :: nday=0 ! this is dummy for mesoscale (in dyn3d/control_mod)
+
+integer,intent(in) :: ngrid ! number of physics columns for this MPI process
+integer,intent(in) :: nlayer ! number of atmospheric layers
+integer,intent(in) :: nq ! number of tracers
+!real,intent(in) :: phour_ini   ! start time (fraction of day) of the run
+!0=<phour_ini<1
+real,intent(in) :: piphysiq   ! call physics every piphysiq dynamical timesteps
+!real :: latitude(ngrid),longitude(ngrid),cell_area(ngrid)
+!  real,intent(in) :: prefff ! reference surface pressure (Pa)
+!  real,intent(in) :: apf(nlayer+1) ! hybrid coordinate at interfaces
+!  real,intent(in) :: bpf(nlayer+1) 
+logical :: ok_slab_ocean
+real*8 :: lat(ngrid),long(ngrid),cellarea(ngrid)
+REAL*8 :: pprad,ppg,ppr,ppcpp,ppunjours
+REAL*8 :: dummy 
+  ! the common part for all planetary physics
+  !------------------------------------------
+  ! --> initialize physics distribution, global fields and geometry
+  ! (i.e. things in phy_common or dynphy_lonlat)
+
+  ! the distinct part for all planetary physics (ie. things in phystd)
+  !------------------------------------------
+
+CALL Init_phys_lmdz_para(1,1,1,MPI_COMM_WORLD)
+
+!call phys_state_var_init
+print*,'ngrid',ngrid,'nlayer',nlayer
+call init_dimphy(ngrid,nlayer)
+call phys_state_var_init(nqtot_p)
+! copy over preff , ap() and bp()
+!call ini_planete_mod(nlayer,prefff,apf,bpf)
+
+! for slab ocean, copy over some arrays
+ok_slab_ocean=.false. ! default value
+!call getin_p("ok_slab_ocean",ok_slab_ocean)
+!if (ok_slab_ocean) then
+!  call ini_surf_heat_transp(ip1jm,ip1jmp1,unsairez,fext,unsaire, &
+!                            cu,cuvsurcv,cv,cvusurcu,aire,apoln,apols, &
+!                            aireu,airev)
+!endif
+
+dummy=1.
+lat(:)=0.
+long(:)=0.
+cellarea(:)=1.
+print*,'pg',pg
+!ppunjours=punjours
+ppunjours=1.
+pprad=prad
+ppg=pg
+ppr=pr
+ppcpp=pcpp
+call inifis(ngrid,nlayer,nq,pdayref,ppunjours,nday,dummy, &
+            lat,long,cellarea,pprad,ppg,ppr,ppcpp)
+
+     open(17,file='controle.txt',form='formatted',status='old')
+     rewind(17)
+     read(17,*)
+     read(17,*)
+     read(17,*) day_ini !(tab0+3)
+     read(17,*)
+     read(17,*) !tab0+5)
+     read(17,*) omeg !(tab0+6)
+     read(17,*) !(tab0+7)
+     read(17,*) mugaz
+     read(17,*)  !(tab0+9)
+     read(17,*) daysec
+     read(17,*) dtphys !tab0+11)
+     read(17,*)
+     read(17,*)
+     read(17,*) year_day !(tab0+14)
+     read(17,*) periastr !tab0+15)
+     read(17,*) apoastr !tab0+16)
+     read(17,*) peri_day !tab0+17)
+     read(17,*) obliquit !tab0+18)
+     read(17,*) z0
+     read(17,*)
+     read(17,*)
+     read(17,*)
+     read(17,*)
+     read(17,*) emisice(1)
+     read(17,*) emisice(2)
+     read(17,*) emissiv
+     read(17,*)
+     read(17,*)
+     read(17,*)
+     read(17,*)
+     read(17,*) iceradius(1)
+     read(17,*) iceradius(2)
+     read(17,*) dtemisice(1)
+     read(17,*) dtemisice(2)
+     close(17)
+     !print*,'g',g
+
+     !emissiv(:)=EMIS
+     !qsurf(:,:) = 0. 
+     print*,'check'
+     print*,'iceradius',iceradius,'dtemisice',dtemisice
+     print*,'apoastr,periastr,year_day,peri_day,obliq',apoastr,periastr,year_day,peri_day,obliquit
+     print*,'emissiv',emissiv
+     print*,'mugaz',mugaz
+     
+end subroutine iniphysiq
+
+
+END MODULE iniphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/update_inputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,665 @@
+MODULE update_inputs_physiq_mod
+
+CONTAINS
+
+!SUBROUTINE update_inputs_physiq_time
+!SUBROUTINE update_inputs_physiq_tracers
+!SUBROUTINE update_inputs_physiq_constants
+!SUBROUTINE update_inputs_physiq_geom
+!SUBROUTINE update_inputs_physiq_surf
+!SUBROUTINE update_inputs_physiq_soil
+!SUBROUTINE update_inputs_physiq_turb
+!SUBROUTINE update_inputs_physiq_rad
+!SUBROUTINE update_inputs_physiq_slope
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_time(&
+            JULYR,JULDAY,GMT,&
+            elaps,&
+            lct_input,lon_input,ls_input,&
+            MY)
+
+  USE variables_mod, only: JD_cur,JH_cur_split,phour_ini
+  !use callkeys_mod, only : tlocked
+  !! JD_cur <> pday ! Julian day
+  !! JH_cur_split <> ptime ! Julian hour (fraction of day)
+
+  INTEGER, INTENT(IN) :: JULDAY, JULYR
+  REAL, INTENT(IN) :: GMT,elaps,lon_input,ls_input,lct_input
+  REAL,INTENT(OUT) :: MY
+
+  IF (JULYR .ne. 9999) THEN
+    !
+    ! specified
+    !
+    JH_cur_split = (GMT + elaps/57420.) !! universal time (0<JH_cur_split<1): JH_cur_split=0.5 at 12:00 UT 
+    JH_cur_split = MODULO(JH_cur_split,24.)   !! the two arguments of MODULO must be of the same type 
+    JH_cur_split = JH_cur_split / 24.
+    JD_cur = (JULDAY - 1 + INT((57420.*GMT+elaps)/1378080.))
+    JD_cur = MODULO(int(JD_cur),2)
+    MY = (JULYR-2000) + (1378080*(JULDAY - 1)+57420.*GMT+elaps)/2756160.
+    MY = INT(MY)
+  ELSE
+    !
+    ! idealized
+    !
+    JH_cur_split = lct_input - lon_input / 15. + elaps/57420.0
+    JH_cur_split = MODULO(JH_cur_split,24.)
+    JH_cur_split = JH_cur_split / 24.
+    JD_cur = INT((57420.0*(lct_input - lon_input / 15.) + elaps)/1378080) !! ls2sol???
+    JD_cur = MODULO(int(pday),365) !! 365 to be changed
+    MY = 2024
+    !day_ini = floor(ls2sol(ls_input)) !! JD_cur at firstcall is day_ini
+  ENDIF
+  print *,'** Titan ** TIME IS', JD_cur, JH_cur_split*24.
+
+END SUBROUTINE update_inputs_physiq_time
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_tracers(nq,MARS_MODE)
+
+  use tracer_h, only: noms,nqtot_p
+  !use phys_state_var_mod , only : qsurf
+  !USE dimphy, only : klon,klev 
+  INTEGER, INTENT(IN) :: nq,MARS_MODE
+  INTEGER :: i,k
+!  CHARACTER(len=20), INTENT(INOUT) :: tname(nq) ! tracer names
+  logical :: end_of_file
+
+  !! TRACERS
+  IF (.not.ALLOCATED(noms)) ALLOCATE(noms(nq)) !! est fait dans initracer normalement
+      
+                 !! tableau dans tracer_mod.F90
+  print*,'nq',nq
+  print*,'MARS_MODE',MARS_MODE
+  nqtot=nq
+  noms(:)="zolbxs"
+  !noms(:)=tname(:)
+  print*,'noms',noms
+  !!---------------------!!
+  !! OUTPUT FOR CHECKING !!
+  !!---------------------!!
+
+END SUBROUTINE update_inputs_physiq_tracers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_constants
+
+   !USE module_model_constants
+   !use comcstfi_h, only: omeg,mugaz
+   !use planete_h,  only: year_day,periheli,aphelie, &
+   !                       peri_day,obliquit,emin_turb, &
+   !                       lmixmin
+   !use planete_mod, only: year_day, periastr, apoastr, peri_day,&
+   !                    obliquit, z0, lmixmin, emin_turb
+   !use surfdat_h,  only: emissiv,iceradius, &
+   !                      emisice,dtemisice
+   !                       z0_default
+   !use comsoil_h, only: volcapa
+   !use comcstfi_mod, only: rad, omeg, g, mugaz, rcp, cpp, r
+   !! comcstfi_h
+   !use phys_state_var_mod, only :cloudfrac,totcloudfrac,hice,rnat,pctsrf_sic,tsea_ice
+   !use iniorbit
+   !use time_phylmdz_mod, only: dtphys, daysec,day_ini
+  
+  
+     !open(17,file='controle.txt',form='formatted',status='old')
+     !rewind(17)
+     !read(17,*)
+     !read(17,*) 
+     !read(17,*) day_ini !(tab0+3)
+     !read(17,*) 
+     !read(17,*) !tab0+5)
+     !read(17,*) omeg !(tab0+6)
+     !read(17,*) !(tab0+7)
+     !read(17,*)  !(tab0+8)
+     !read(17,*)  !(tab0+9)
+     !read(17,*) daysec
+     !read(17,*) dtphys !tab0+11)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*) year_day !(tab0+14)
+     !read(17,*) periastr !tab0+15)
+     !read(17,*) apoastr !tab0+16)
+     !read(17,*) peri_day !tab0+17)
+     !read(17,*) obliquit !tab0+18)
+     !read(17,*) z0
+     !read(17,*)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*) emisice(1)
+     !read(17,*) emisice(2)
+     !read(17,*) emissiv
+     !read(17,*)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*)
+     !read(17,*) iceradius(1)
+     !read(17,*) iceradius(2)
+     !read(17,*) dtemisice(1)
+     !read(17,*) dtemisice(2)
+     !close(17) 
+     !cpp=(8.314511/(mugaz/1000.0))/rcp
+     !print*,'cpp',cpp
+     !print*,'g',g
+
+     !emissiv(:)=EMIS
+     !cloudfrac(:,:)=0.5
+     !totcloudfrac(:)=0.5
+     !hice(:)=0.
+     !rnat(:)=0.
+     !pctsrf_sic(:)=0.
+     !tsea_ice(:)=0.
+     !qsurf(:,:) = 0. 
+     !print*,'iceradius',iceradius,'dtemisice',dtemisice
+     !print*,'apoastr,periastr,year_day,peri_day,obliq',apoastr,periastr,year_day,peri_day,obliquit
+     !print*,'emissiv',emissiv
+ 
+     ! SUBROUTINE iniorbit(apoastr,periastr,year_day,peri_day,obliq)
+
+END SUBROUTINE update_inputs_physiq_constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_geom( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,ngrid,nlayer,&
+            DX,DY,MSFT,&
+            lat_input, lon_input,&
+            XLAT,XLONG)
+
+   ! in WRF (share)
+   USE module_model_constants, only: DEGRAD,p0
+   ! in LMD (phymars)
+   !use comgeomfi_h, only: ini_fillgeom
+   ! in LMD (phy_common)
+   USE mod_grid_phy_lmdz, ONLY: init_grid_phy_lmdz
+   USE geometry_mod, ONLY: latitude,latitude_deg,&
+                           longitude,longitude_deg,&
+                           cell_area
+   use comdiurn_h, only: sinlat, coslat, sinlon, coslon
+   !use planetwide_mod, only: planetwide_sumval
+   use comgeomfi_h, only: totarea, totarea_planet
+   use planete_mod, only: ini_planete_mod
+   ! in LMD-WRF interface
+   USE variables_mod, only: ptopwrf
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,ngrid,nlayer
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     MSFT,XLAT,XLONG
+   REAL, INTENT(IN) :: dx,dy
+   REAL, INTENT(IN) :: lat_input, lon_input
+   INTEGER :: i,j,subs,ig,k
+   REAL,DIMENSION(ngrid) :: plon, plat, parea
+   REAL, DIMENSION(nlayer+1) :: znw
+   REAL*8, DIMENSION(nlayer+1) :: apdyn,bpdyn
+   REAL*8 :: PP0
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+    !-----------------------------------!
+    ! 1D subscript for physics "cursor" !
+    !-----------------------------------!
+    subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+    !----------------------------------------!
+    ! Surface of each part of the grid (m^2) !  
+    !----------------------------------------!
+    !parea(subs) = dx*dy                           !! 1. idealized cases - computational grid
+    parea(subs) = (dx/msft(i,j))*(dy/msft(i,j))    !! 2. WRF map scale factors - assume that msfx=msfy (msf=covariance)
+    !parea(subs)=dx*dy/msfu(i,j)                   !! 3. special for Mercator GCM-like simulations
+
+    !---------------------------------------------!
+    ! Mass-point latitude and longitude (radians) !
+    !---------------------------------------------!
+    IF (JULYR .ne. 9999) THEN
+     plat(subs) = XLAT(i,j)*DEGRAD
+     plon(subs) = XLONG(i,j)*DEGRAD
+    ELSE
+     !!! IDEALIZED CASE
+     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lat: ',lat_input
+     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lon: ',lon_input
+     plat(subs) = lat_input*DEGRAD
+     plon(subs) = lon_input*DEGRAD
+    ENDIF 
+
+   ENDDO
+   ENDDO
+
+   !! FILL GEOMETRICAL ARRAYS !!
+   !call ini_fillgeom(ngrid,plat,plon,parea)
+
+   !!! ----------------------------------------------------------
+   !!! --- initializing geometry in phy_common
+   !!! --- (this is quite planet-independent)
+   !!! ----------------------------------------------------------
+   ! initialize mod_grid_phy_lmdz
+   CALL init_grid_phy_lmdz(1,1,ipe-ips+1,jpe-jps+1,nlayer)
+   ! fill in geometry_mod variables
+   ! ... copy over local grid longitudes and latitudes
+   ! ... partly what is done in init_geometry
+   IF(.not.ALLOCATED(longitude)) ALLOCATE(longitude(ngrid))
+   IF(.not.ALLOCATED(longitude_deg)) ALLOCATE(longitude_deg(ngrid))
+   IF(.not.ALLOCATED(latitude)) ALLOCATE(latitude(ngrid))
+   IF(.not.ALLOCATED(latitude_deg)) ALLOCATE(latitude_deg(ngrid))
+   IF(.not.ALLOCATED(cell_area)) ALLOCATE(cell_area(ngrid))
+   longitude(:) = plon(:)
+   latitude(:) = plat(:)
+   longitude_deg(:) = plon(:)/DEGRAD
+   latitude_deg(:) = plat(:)/DEGRAD
+   cell_area(:) = parea(:)
+   !call planetwide_sumval(parea,totarea_planet)
+   !print*,'parea',parea(1)
+   !totarea=SSUM(ngrid,parea,1)
+   totarea=ngrid*parea(1)
+   !totarea_planet=SSUM(ngrid,parea,1)
+   totarea_planet=ngrid*parea(1)
+
+   IF (.not.ALLOCATED(sinlat)) ALLOCATE(sinlat(ngrid))
+   IF (.not.ALLOCATED(coslat)) ALLOCATE(coslat(ngrid))
+   IF (.not.ALLOCATED(sinlon)) ALLOCATE(sinlon(ngrid))
+   IF (.not.ALLOCATED(coslon)) ALLOCATE(coslon(ngrid))
+   DO ig=1,ngrid
+     sinlat(ig)=sin(plat(ig))
+     coslat(ig)=cos(plat(ig))
+     sinlon(ig)=sin(plon(ig))
+     coslon(ig)=cos(plon(ig))
+   ENDDO
+   
+   open(unit=12,file='levels',form='formatted',status='old')
+   rewind(12)
+   DO k=1, nlayer
+   read(12,*) znw(k)
+   !write(6,*) 'read level ', k,grid%znw(k)
+   ENDDO
+   close(12)
+   
+   apdyn=ptopwrf*(1-znw)
+   bpdyn=znw
+   PP0=p0
+   CALL ini_planete_mod(nlayer,PP0,apdyn,bpdyn)
+   !!! ----------------------------------------------------------
+
+END SUBROUTINE update_inputs_physiq_geom
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,MARS_MODE,&
+            M_ALBEDO,CST_AL,&
+            M_TSURF,M_EMISS,M_CO2ICE,&
+            M_GW,M_Z0,CST_Z0,&
+            M_H2OICE,&
+            phisfi_val)
+
+   use surfdat_h, only: phisfi, albedodat,  &
+                       zmea, zstd, zsig, zgam, zthe
+   use planete_mod, only: z0
+   use phys_state_var_mod, only : tsurf, emis, qsurf
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,MARS_MODE
+   INTEGER :: i,j,subs,nlast,iq
+   REAL, INTENT(IN  ) :: CST_AL, phisfi_val, CST_Z0
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_ALBEDO,M_TSURF,M_EMISS,M_CO2ICE,M_H2OICE,M_Z0
+   REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: M_GW  
+
+   !! TITAN: constant surface roughness
+   !! see below commented part if varying is needed
+   z0 = CST_Z0
+   IF (z0 == 0.) THEN
+       PRINT *, 'WELL, z0 is 0, this is no good. Setting to default value from Tokano 2006'
+       z0 = 0.005 ! (m) value for Huygens landing site from Tokano 2006
+   ENDIF
+
+   !print*,'ALLOCATED(phisfi)',ALLOCATED(phisfi)
+   !print*,'size phisfi',size(phisfi)
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !---------------------!
+     ! Ground geopotential !
+     !---------------------!
+     phisfi(subs) = phisfi_val
+!     print*,'size phisfi',size(phisfi)
+     !print*,'phisfi',phisfi(subs)
+     !---------------!
+     ! Ground albedo !
+     !---------------!
+     IF (JULYR .ne. 9999) THEN 
+      IF (CST_AL == 0) THEN
+       albedodat(subs)=M_ALBEDO(i,j)
+      ELSE 
+       albedodat(subs)=CST_AL
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT ALBEDO ', albedodat
+      ENDIF
+     ELSE
+      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION albedo: ', CST_AL
+      albedodat(subs)=CST_AL
+     ENDIF
+
+     !-----------------------------------------!
+     ! Gravity wave parametrization            !
+     ! NB: usually 0 in mesoscale applications !
+     !-----------------------------------------!
+     zmea(subs)=0.
+     zstd(subs)=0.
+     zsig(subs)=0.
+     zgam(subs)=0.
+     zthe(subs)=0.
+
+     !----------------------------!
+     ! Variable surface roughness !
+     !----------------------------!
+     !IF (JULYR .ne. 9999) THEN
+     ! IF (CST_Z0 == 0) THEN
+     !  z0(subs) = M_Z0(i,j)
+     ! ELSE
+     !  z0(subs) = CST_Z0
+     !  IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT SURF ROUGHNESS (m) ',CST_Z0
+     ! ENDIF
+     !ELSE
+     ! IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION z0 (m) ', CST_Z0
+     ! z0(subs)=CST_Z0
+     !ENDIF
+     !!!!! ADDITIONAL SECURITY. THIS MIGHT HAPPEN WITH OLD INIT FILES.
+     !IF (z0(subs) == 0.) THEN
+     !  IF ( (i == ips) .AND. (j == jps) ) PRINT *, 'WELL, z0 is 0, this is no good. Setting to old defaults value 0.01 m'
+     !  z0(subs) = 0.01
+     !ENDIF
+     !!!!! ADDITIONAL SECURITY. INTERP+SMOOTH IN GEOGRID MIGHT YIELD NEGATIVE Z0 !!!
+     !IF (z0(subs) < 0.) THEN
+     !  PRINT *, 'WELL, z0 is NEGATIVE, this is impossible. better stop here.'
+     !  PRINT *, 'advice --> correct interpolation / smoothing of z0 in WPS'
+     !  PRINT *, '           -- or check the constant value set in namelist.input'
+     !  STOP
+     !ENDIF
+
+     !-----------------------------------------------!
+     ! Ground temperature, emissivity, CO2 ice cover !
+     !-----------------------------------------------!
+     tsurf(subs) = M_TSURF(i,j)
+     emis(subs) = M_EMISS(i,j)     
+     !enddo
+     !-------------------!
+     ! Tracer at surface !
+     !-------------------!
+     qsurf(subs,:)=0. ! default case
+     SELECT CASE (MARS_MODE)
+       CASE(1)
+       qsurf(subs,2)=M_H2OICE(i,j)    !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
+                                      !! ----- retrocompatible ancienne physique
+                                      !! ----- [H2O ice is last tracer in qsurf in LMD physics]
+       CASE(2)   
+       qsurf(subs,1)=0.                !! not coupled with lifting for the moment [non remobilise]
+       !CASE(3)
+       !qsurf(subs,1)=q_prof(1,1)                !!! temporaire, a definir       
+       !qsurf(subs,2)=q_prof(1,2)     
+       CASE(11)
+       qsurf(subs,2)=M_H2OICE(i,j)    !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
+       qsurf(subs,3)=0.                !! not coupled with lifting for the moment [non remobilise]
+       CASE(12)
+       qsurf(subs,2)=M_H2OICE(i,j)    !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
+       qsurf(subs,3)=0.                !! not coupled with lifting for the moment [non remobilise]
+     END SELECT
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: phisfi",phisfi(1),phisfi(nlast)
+   print*,"check: albedodat",albedodat(1),albedodat(nlast)
+   print*,"check: zmea",zmea(1),zmea(nlast)
+   print*,"check: zstd",zstd(1),zstd(nlast)
+   print*,"check: zsig",zsig(1),zsig(nlast)
+   print*,"check: zgam",zgam(1),zgam(nlast)
+   print*,"check: zthe",zthe(1),zthe(nlast)
+   print*,"check: z0",z0
+   print*,"check: tsurf",tsurf(1),tsurf(nlast)
+   print*,"check: emis",emis(1),emis(nlast)
+   print*,"check: qsurf",qsurf(1,:),qsurf(nlast,:)
+
+END SUBROUTINE update_inputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,nsoil,&
+            M_TI,CST_TI,&
+            M_ISOIL,M_DSOIL,&
+            M_TSOIL,M_TSURF)
+
+   use comsoil_h, only: inertiedat,mlayer,layer,volcapa
+   use phys_state_var_mod, only: tsoil
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,nsoil
+   INTEGER :: i,j,subs,nlast
+   REAL, INTENT(IN  ) :: CST_TI 
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_TI, M_TSURF
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(IN)  :: &
+     M_TSOIL, M_ISOIL, M_DSOIL
+   REAL :: inertiedat_val
+   REAL :: lay1,alpha
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-----------------!
+     ! Thermal Inertia !
+     !-----------------!
+     IF (JULYR .ne. 9999) THEN
+      IF (CST_TI == 0) THEN
+       inertiedat_val=M_TI(i,j)
+      ELSE
+       inertiedat_val=CST_TI
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT THERMAL INERTIA ', inertiedat_val
+      ENDIF
+     ELSE
+      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION inertia: ',CST_TI
+      inertiedat_val=CST_TI
+     ENDIF
+     !inertiedat(subs) = inertiedat_val
+     !--pb de dimensions???!!???
+     IF (JULYR .ne. 9999) THEN
+       inertiedat(subs,:)=M_ISOIL(i,:,j) !! verifier que cest bien hires TI en surface
+       mlayer(0:nsoil-1)=M_DSOIL(i,:,j)
+     ELSE
+        IF ( nsoil .lt. 18 ) THEN
+            PRINT *,'** Mars ** WRONG NUMBER OF SOIL LAYERS. SHOULD BE 18 AND IT IS ',nsoil
+            STOP
+        ENDIF
+        IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION isoil and dsoil standard'
+        do k=1,nsoil
+         inertiedat(subs,k) = inertiedat_val
+         !mlayer(k-1) = sqrt(887.75/3.14)*((2.**(k-0.5))-1.) * inertiedat_val / wvolcapa    ! old setting
+         mlayer(k-1) = 2.E-4 * (2.**(k-0.5-1.))                                            ! new gcm settings
+        enddo
+     ENDIF
+     IF ( (i == ips) .AND. (j == jps) ) &
+         PRINT *,'** Mars ** TI and depth profiles are',inertiedat(subs,:)!,mlayer(0:nsoil-1)
+
+     !!!!!!!!!!!!!!!!! DONE in soil_setting.F 
+     ! 1.5 Build layer(); following the same law as mlayer()
+     ! Assuming layer distribution follows mid-layer law:
+     ! layer(k)=lay1*alpha**(k-1)
+     lay1=sqrt(mlayer(0)*mlayer(1))
+     alpha=mlayer(1)/mlayer(0)
+     do k=1,nsoil
+       layer(k)=lay1*(alpha**(k-1))
+     enddo
+
+     !------------------------!
+     ! Deep soil temperatures ! 
+     !------------------------!
+     IF (M_TSOIL(i,1,j) .gt. 0. .and. JULYR .ne. 9999) THEN
+       tsoil(subs,:)=M_TSOIL(i,:,j)
+     ELSE
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** no tsoil. set it to tsurf.'
+       do k=1,nsoil
+        !print*,'M_TSURF(i,j)',M_TSURF(1,:)
+        !print*,'size M_TSURF',size(M_TSURF)
+        !print*,'size tsoil',size(tsoil)
+        tsoil(subs,k) = M_TSURF(i,j)
+        !print*,'tsoil(subs,k)',tsoil(subs,k)
+       enddo
+     ENDIF
+
+   ENDDO
+   ENDDO
+
+   volcapa=1.e6   
+
+   print*,'zolbxs'
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: inertiedat",inertiedat(1,:),inertiedat(nlast,:)
+   print*,"check: mlayer",mlayer(:)
+   print*,"check: layer",layer(:)
+   print*,"check: tsoil",tsoil(1,:),tsoil(nlast,:)
+
+END SUBROUTINE update_inputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,&
+            RESTART,isles,&
+            M_Q2,M_WSTAR)
+
+   use turb_mod, only: q2,wstar,turb_resolved
+   !use phys_state_var_mod, only : q2,
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs,nlast      
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_WSTAR
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(IN) :: M_Q2
+   LOGICAL, INTENT(IN ) :: RESTART,isles
+
+   !! to know if this is turbulence-resolving run or not
+
+   turb_resolved = isles
+   print*,'isles',isles
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !PBL wind variance
+     IF (.not. restart) THEN
+      q2(subs,:) = 1.E-6      
+      wstar(subs)=0.
+     ELSE
+      q2(subs,:)=M_Q2(i,:,j)!
+      !q2(subs,:) = 1.e-3
+      wstar(subs)=M_WSTAR(i,j)
+     ENDIF
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: q2",q2(1,1)!,q2(nlast,:)
+   print*,"check: wstar",wstar(1),wstar(nlast)
+
+END SUBROUTINE update_inputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            RESTART,&
+            M_FLUXRAD)
+
+   !use dimradmars_mod, only: fluxrad
+   use phys_state_var_mod, only : fluxrad
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs,nlast      
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_FLUXRAD
+   LOGICAL, INTENT(IN ) :: RESTART
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     ! fluxrad_save
+     IF (.not. restart) THEN
+      fluxrad(subs)=0.
+     ELSE
+      fluxrad(subs)=M_FLUXRAD(i,j)
+     ENDIF
+     !! et fluxrad_sky ???!???
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: fluxrad",fluxrad(1),fluxrad(nlast)
+
+END SUBROUTINE update_inputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_slope( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,&
+            SLPX,SLPY)
+
+   !USE module_model_constants, only: DEGRAD
+   !USE slope_mod, ONLY: theta_sl, psi_sl
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: SLPX,SLPY
+   INTEGER :: i,j,subs,nlast
+
+END SUBROUTINE update_inputs_physiq_slope
+
+END MODULE update_inputs_physiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/update_outputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,218 @@
+MODULE update_outputs_physiq_mod
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            MARS_MODE,&
+            M_TSURF,M_CO2ICE,&
+            M_H2OICE)
+
+   !use surfdat_h, only: tsurf, co2ice, qsurf
+   use phys_state_var_mod, only : tsurf,qsurf
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER, INTENT(IN) :: MARS_MODE
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_TSURF,M_CO2ICE,M_H2OICE
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_TSURF(i,j) = tsurf(subs)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            nsoil,&
+            M_TSOIL)
+
+   !use comsoil_h, only: tsoil
+    use phys_state_var_mod, only : tsoil
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,nsoil
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(INOUT)  :: &
+     M_TSOIL
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_TSOIL(i,:,j) = tsoil(subs,:)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            M_FLUXRAD)
+
+   !use dimradmars_mod, only: fluxrad
+   use phys_state_var_mod, only : fluxrad
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: M_FLUXRAD
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_FLUXRAD(i,j) = fluxrad(subs)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            M_Q2,M_WSTAR,&
+            HFMAX,ZMAX,USTM,HFX)
+
+   use turb_mod, only: q2,wstar,ustar,sensibFlux!,&
+                        !hfmax_th,zmax_th
+   !use phys_state_var_mod, only : q2,sensibFlux
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_WSTAR,HFMAX,ZMAX,USTM,HFX
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT) :: M_Q2
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_Q2(i,kps:kpe+1,j) = q2(subs,:)
+     M_WSTAR(i,j) = wstar(subs)
+
+     !! output only (arrays already in phys modules)
+     !HFMAX(i,j) = HFMAX_TH(subs)
+     !ZMAX(i,j) = ZMAX_TH(subs)
+     USTM(i,j) = ustar(subs)
+     HFX(i,j) = sensibFlux(subs) !! test like Mars
+     !!! sensible heat flux
+     !!! ... minus sign important because 
+     !!! ... in physics sensibFlux is AtmToSurf_TurbFlux
+     !HFX(i,j) = -sensibFlux(subs) 
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_diag( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            SWDOWNZ,TAU_DUST,QSURFDUST,&
+            MTOT,ICETOT,TAU_ICE,&
+            HR_SW,HR_LW,HR_DYN,DT,DTRAD,&
+            RDUST,VMR_ICE,RICE,&
+            CLOUDFRAC,TOTCLOUDFRAC,&
+            RAIN,SNOW,REEVAP,SURFRAIN,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+            FLUXSURF_LW,FLXGRD,LSCEZ,H2OICE_REFF,LATENT_HF)
+   
+   USE comm_wrf !! to get fields to be written from physiq
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
+     SWDOWNZ,TAU_DUST,QSURFDUST,&
+     MTOT,ICETOT,TAU_ICE,&
+     TOTCLOUDFRAC,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+     FLUXSURF_LW,FLXGRD,LATENT_HF,REEVAP,SURFRAIN
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: &
+     HR_SW,HR_LW,RDUST,VMR_ICE,RICE,CLOUDFRAC,HR_DYN,DT,DTRAD,RAIN,SNOW,&
+     LSCEZ,H2OICE_REFF
+   INTEGER :: i,j,subs
+
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !! get diagnostics from physics
+     HR_SW(i,kps:kpe,j) = comm_HR_SW(subs,kps:kpe)
+     HR_LW(i,kps:kpe,j) = comm_HR_LW(subs,kps:kpe)
+     FLUXTOP_DN(i,j)=comm_FLUXTOP_DN(subs)
+     FLUXABS_SW(i,j)=comm_FLUXABS_SW(subs)
+     FLUXTOP_LW(i,j)=comm_FLUXTOP_LW(subs)
+     FLUXSURF_SW(i,j)=comm_FLUXSURF_SW(subs)
+     FLUXSURF_LW(i,j)=comm_FLUXSURF_LW(subs)
+     FLXGRD(i,j)=comm_FLXGRD(subs)
+
+   ENDDO
+   ENDDO
+
+   CALL deallocate_comm_wrf
+
+END SUBROUTINE update_outputs_physiq_diag
+
+END MODULE update_outputs_physiq_mod
+
+
+
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/variables_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/variables_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_titan_lmd_new/variables_mod.F	(revision 2744)
@@ -0,0 +1,78 @@
+MODULE variables_mod
+
+IMPLICIT NONE
+
+REAL*8 :: JD_cur !pday !JD_cur ! Julian day
+REAL*8 :: JH_cur_split !ptime !JH_cur_split ! Julian hour (fraction of day)
+REAL*8 :: zdt_split !ptimestep !zdt_split ! time step over which the physics are evaluated
+REAL*8 :: phour_ini ! start time (fraction of day) of the run 0=<phour_ini<1
+REAL*8 :: ptopwrf ! pressure at top of model in WRF [should be equal to grid%p_top]
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplev_omp !pplev !zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplay_omp !pplay !zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zpk_omp!(klon,llm)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zphi_omp !pphi !zphi_omp(klon,llm) ! geopotential at midlayer
+REAL*8,DIMENSION(:),ALLOCATABLE :: zphis_omp!(klon) ! surface geopotential
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zufi_omp !pu !zufi_omp(klon,llm) ! zonal wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zvfi_omp !pv !zvfi_omp(klon,llm) ! meridional wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zrfi_omp!(klon,llm) ! relative wind vorticity, in s-1
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: ztfi_omp !pt !ztfi_omp(klon,llm) ! temperature (K)
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zqfi_omp !pq !zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: flxwfi_omp !flxw !flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) 
+! tendencies (in */s) from the physics:
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdufi_omp !pdu !zdufi_omp(klon,llm) ! tendency on zonal winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdvfi_omp !pdv !zdvfi_omp(klon,llm) ! tendency on meridional winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdtfi_omp !pdt !zdtfi_omp(klon,llm) ! tendency on temperature
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zdqfi_omp !pdq !zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+REAL*8,DIMENSION(:),ALLOCATABLE :: zdpsrf_omp !pdpsrf !zdpsrf_omp(klon) ! tendency on surface pressure
+
+CONTAINS
+
+SUBROUTINE allocate_interface(klon,llm,nqtot)
+
+  IMPLICIT NONE
+ 
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+ 
+  IF (.NOT.ALLOCATED(zplev_omp)) ALLOCATE(zplev_omp(klon,llm+1))
+  IF (.NOT.ALLOCATED(zplay_omp)) ALLOCATE(zplay_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zpk_omp)) ALLOCATE(zpk_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphi_omp)) ALLOCATE(zphi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphis_omp)) ALLOCATE(zphis_omp(klon))
+  IF (.NOT.ALLOCATED(zufi_omp)) ALLOCATE(zufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zvfi_omp)) ALLOCATE(zvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zrfi_omp)) ALLOCATE(zrfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(ztfi_omp)) ALLOCATE(ztfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zqfi_omp)) ALLOCATE(zqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(flxwfi_omp)) ALLOCATE(flxwfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdufi_omp)) ALLOCATE(zdufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdvfi_omp)) ALLOCATE(zdvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdtfi_omp)) ALLOCATE(zdtfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdqfi_omp)) ALLOCATE(zdqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(zdpsrf_omp)) ALLOCATE(zdpsrf_omp(klon))
+
+END SUBROUTINE allocate_interface
+
+SUBROUTINE deallocate_interface
+
+  DEALLOCATE(zplev_omp)
+  DEALLOCATE(zplay_omp)
+  DEALLOCATE(zpk_omp)
+  DEALLOCATE(zphi_omp)
+  DEALLOCATE(zphis_omp)
+  DEALLOCATE(zufi_omp)
+  DEALLOCATE(zvfi_omp)
+  DEALLOCATE(zrfi_omp)
+  DEALLOCATE(ztfi_omp)
+  DEALLOCATE(zqfi_omp)
+  DEALLOCATE(flxwfi_omp)
+  DEALLOCATE(zdufi_omp)
+  DEALLOCATE(zdvfi_omp)
+  DEALLOCATE(zdtfi_omp)
+  DEALLOCATE(zdqfi_omp)
+  DEALLOCATE(zdpsrf_omp)
+
+END SUBROUTINE deallocate_interface
+
+END MODULE variables_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/callphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/callphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/callphysiq_mod.F	(revision 2744)
@@ -0,0 +1,89 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+ !! ----------------------------------------------------------
+ !! ---- CALL TO VENUS PHYSICS
+ !! ----------------------------------------------------------
+
+CONTAINS
+
+SUBROUTINE call_physiq(planet_type, klon,llm,nqtot,                       &
+                       debut_split,lafin_split)
+
+  USE variables_mod
+  USE physiq_mod, ONLY: physiq
+  USE module_model_constants, only : p0,rcp,cp
+  IMPLICIT NONE
+
+  character(len=10),INTENT(IN) :: planet_type ! planet type ('earth','mars',...)
+
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+  REAL*8 :: zplevmoy(llm+1) ! planet-averaged mean pressure (Pa) at interfaces
+  REAL*8 :: ztmoy(llm)
+
+!  ! Local variables
+!  CHARACTER(len=11) :: modname="call_physiq"
+!  LOGICAL,SAVE :: firstcall=.true.
+!!$OMP THREADPRIVATE(firstcall)
+!
+!! Sanity check on physics package type
+!  IF (firstcall) THEN
+!    IF (planet_type.ne."mars") THEN
+!      CALL abort_gcm(modname,"wrong planet_type for this physics package",1)
+!    ENDIF
+!    firstcall=.false.
+!  ENDIF
+
+! Sanity check on physics package type
+ IF (debut_split) THEN
+   IF (planet_type.ne."venus") THEN
+     PRINT*,"wrong planet_type for this physics package"
+     STOP
+   ENDIF
+ ENDIF
+
+! Set dummy variables for Mars to zero (additional and prob useless security)
+! NB: tname already filled with tracers' names (though not used here)
+  zpk_omp(1:klon,1:llm)=cp*((zplay_omp(1:klon,1:llm)/p0)**rcp)
+  !print*,'zpk_omp',zpk_omp(1,:)
+  zphis_omp(1:klon)=zphi_omp(1:klon,1)
+  presnivs_omp(:)=0.
+  zrfi_omp(:,:)=0.
+  ztmoy(:)=ztfi_omp(1,:)
+  zplevmoy(:)=zplev_omp(1,:)
+! Call physics package with required inputs/outputs
+  CALL physiq(klon,           &
+              llm,            &
+              nqtot,          &
+              debut_split,    &
+              lafin_split,    &
+              jD_cur,         &
+              jH_cur_split,   &
+              zdt_split,      &
+              zplev_omp,      &
+              zplay_omp,      &
+              zpk_omp,        &
+              zphi_omp,       &
+              zphis_omp,      &
+              presnivs_omp,   &
+              zufi_omp,       &
+              zvfi_omp,       &
+              ztfi_omp,       &
+              zqfi_omp,       &
+              flxwfi_omp,     &
+              zdufi_omp,      &
+              zdvfi_omp,      &
+              zdtfi_omp,      &
+              zdqfi_omp,      &
+              zdpsrf_omp)
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/iniphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/iniphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/iniphysiq_mod.F	(revision 2744)
@@ -0,0 +1,112 @@
+MODULE iniphysiq_mod
+
+CONTAINS
+
+subroutine iniphysiq(ngrid,nlayer,nq,piphysiq,&
+                     punjours, pdayref, &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+!use time_phylmdz_mod, only: iphysiq, day_step, ecritstart,ecritphy,&
+!                            dtphys,daysec,day_ini,hour_ini
+use comconst_mod, only : cpp
+use cpdet_phy_mod, only: init_cpdet_phy
+USE control_mod, ONLY: planet_type
+!use surfdat_h, only: ini_surfdat_h
+!use comsoil_h, only: ini_comsoil_h
+!use dimradmars_mod, only: ini_dimradmars_mod
+!use time_phylmdz_mod, only : init_time
+use dimphy, only: init_dimphy
+USE phys_state_var_mod
+use module_model_constants, only : nu, TT00
+USE variables_mod, only: phour_ini,zdt_split !! zdt_split <> ptimestep
+   !real*8,intent(in) :: ptimestep !physics time step (s) [dtphys]
+
+implicit none
+
+REAL,intent(in) :: prad
+REAL,intent(in) :: pg
+REAL,intent(in) :: pr
+REAL,intent(in) :: pcpp
+REAL,intent(in) :: punjours
+!DOUBLE PRECISION,intent(in) :: ptimestep
+
+!real,intent(in) :: prad ! radius of the planet (m)
+!real,intent(in) :: pg ! gravitational acceleration (m/s2)
+!real,intent(in) :: pr ! ! reduced gas constant R/mu
+!real,intent(in) :: pcpp ! specific heat Cp
+!real,intent(in) :: punjours ! length (in s) of a standard day [daysec]
+integer,intent(in) :: pdayref ! reference day of for the simulation [day_ini]
+!real*8,intent(in) :: ptimestep !physics time step (s) [dtphys]
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer,intent(in) :: ngrid ! number of physics columns for this MPI process
+integer,intent(in) :: nlayer ! number of atmospheric layers
+integer,intent(in) :: nq ! number of tracers
+!real,intent(in) :: phour_ini   ! start time (fraction of day) of the run 0=<phour_ini<1
+real,intent(in) :: piphysiq   ! call physics every piphysiq dynamical timesteps
+real*8 :: CPPP,nuvenus,T0venus
+
+! copy some fundamental parameters to physics 
+! and do some initializations 
+
+!! Initialize dimphy module
+!call init_dimphy(klon_omp,nlayer)
+!...useless in mesoscale
+
+!! initialize physical constants and arrays
+
+      ! Initialize some "temporal and calendar" related variables
+      !call init_time(day_ini,hour_ini,pdaysec,ptimestep)
+      !call init_time(1,1,1,1,ptimestep)
+      !=ptimestep 
+      call init_dimphy(ngrid,nlayer)
+
+      Call phys_state_var_init(nq)
+      ! allocate "surfdat_h" arrays
+      !call ini_surfdat_h(ngrid,nq)
+
+     ! allocate "comgeomfi_h" arrays
+      !call ini_comgeomfi_h(ngrid)
+
+      ! allocate "comsoil_h" arrays
+      !call ini_comsoil_h(ngrid)
+
+      ! set some variables in "dimradmars_mod"
+      !call ini_dimradmars_mod(ngrid,nlayer)
+ 
+      ! set klon and klev for venus physiq
+      !call init_dimphy(ngrid,nlayer)
+
+      ! Initialize some physical constants
+      call suphec(pcpp)
+
+      cpp=pcpp
+      planet_type="venus"
+      CPPP=pcpp
+      nuvenus=nu
+      T0venus=TT00
+      call init_cpdet_phy(CPPP,nuvenus,T0venus)
+
+!! a few time constants initialization 
+!! not done by init_time in phys_state_var_init
+!! and supposed to be done in conf_phys (but not done in mesoscale)
+!day_step=punjours/ptimestep
+!iphysiq=piphysiq
+!ecritstart=0 !! not used in MESOSCALE
+!ecritphy=0 !! not used in MESOSCALE
+
+!! check
+!PRINT*,'Call to LMD physics:',day_step,' per Martian day'
+!PRINT*,'Call to LMD physics: every',iphysiq,' dynamical timesteps'
+!PRINT*,'Call to LMD physics: every',dtphys,' seconds'
+!PRINT*,'Call to LMD physics: length of day is',daysec,' seconds'
+!PRINT*,'Call to LMD physics: initial day is',day_ini
+!PRINT*,'Call to LMD physics: initial fractional time is',hour_ini
+
+! Initialize some "temporal and calendar" related variables
+!CALL init_time(day_ini,hour_ini,punjours,ptimestep)
+!...done in phys_state_var_init
+
+end subroutine iniphysiq
+
+END MODULE iniphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/update_inputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,509 @@
+MODULE update_inputs_physiq_mod
+
+IMPLICIT NONE
+
+CHARACTER(len=20),save,allocatable,dimension(:) :: traceurs ! tracer names
+
+CONTAINS
+
+!SUBROUTINE update_inputs_physiq_time
+!SUBROUTINE update_inputs_physiq_tracers
+!SUBROUTINE update_inputs_physiq_constants
+!SUBROUTINE update_inputs_physiq_geom
+!SUBROUTINE update_inputs_physiq_surf
+!SUBROUTINE update_inputs_physiq_soil
+!SUBROUTINE update_inputs_physiq_turb
+!SUBROUTINE update_inputs_physiq_rad
+!SUBROUTINE update_inputs_physiq_slope
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+!c  Returns solar longitude, Ls (in deg.), from day number (in sol),
+!c  where sol=0=Ls=0 at the northern hemisphere spring equinox
+
+
+!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_time(&
+            JULYR,JULDAY,GMT,&
+            elaps,&
+            lct_input,lon_input,ls_input,&
+            MY)
+
+  USE variables_mod, only: JD_cur,JH_cur_split,phour_ini
+  !! JD_cur <> pday ! Julian day
+  !! JH_cur_split <> ptime ! Julian hour (fraction of day)
+
+  implicit none
+
+  INTEGER, INTENT(IN) :: JULDAY, JULYR
+  REAL, INTENT(IN) :: GMT,elaps,lon_input,ls_input,lct_input
+  REAL,INTENT(OUT) :: MY
+
+    !
+    ! specified
+    !
+  IF (JULYR .ne. 9999) THEN
+    JH_cur_split = (GMT + elaps/421200.) !! universal time (0<JH_cur_split<1): JH_cur_split=0.5 at 12:00 UT 
+    JH_cur_split = MODULO(JH_cur_split,24.)   !! the two arguments of MODULO must be of the same type 
+    JH_cur_split = JH_cur_split / 24.
+    JD_cur = (JULDAY - 1 + INT((421200.*GMT+elaps)/10108800.))
+    JD_cur = MODULO(int(JD_cur),2)
+    MY = (JULYR-2000) + (10108800.*(JULDAY - 1)+421200.*GMT+elaps)/20217600.
+    MY = INT(MY)
+  ELSE
+    JH_cur_split = lct_input - lon_input / 15. + elaps/(421200.)
+    JH_cur_split = MODULO(JH_cur_split,24.)
+    JH_cur_split = JH_cur_split / 24.
+    print*,'JH_cur_split',JH_cur_split
+    JD_cur = INT((3700*(lct_input - lon_input / 15.) +elaps)/88800)
+    JD_cur = MODULO(int(JD_cur),669)
+    MY = 2024
+ ENDIF
+
+END SUBROUTINE update_inputs_physiq_time
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_tracers(nq,MARS_MODE)
+
+  use infotrac_phy, only: nqtot,tname
+  use logic_mod, only: iflag_trac
+  implicit none
+  INTEGER, INTENT(IN) :: nq,MARS_MODE
+
+  IF (.not.ALLOCATED(tname)) ALLOCATE(tname(nq))
+  nqtot=nq
+
+  IF (MARS_MODE .EQ. 34) THEN
+    tname(1)="co2"
+    tname(2)="co"
+    tname(3)="h2"
+    tname(4)="h2o"
+    tname(5)="o1d"
+    tname(6)="o"
+    tname(7)="o2"
+    tname(8)="o2dg"
+    tname(9)="o3"
+    tname(10)="h"
+    tname(11)="oh"
+    tname(12)="ho2"
+    tname(13)="h2o2"
+    tname(14)="cl"
+    tname(15)="clo"
+    tname(16)="cl2"
+    tname(17)="hcl"
+    tname(18)="hocl"
+    tname(19)="clco"
+    tname(20)="clco3"
+    tname(21)="cocl2"
+    tname(22)="s"
+    tname(23)="so"
+    tname(24)="so2"
+    tname(25)="so3"
+    tname(26)="s2o2"
+    tname(27)="ocs"
+    tname(28)="hso3"
+    tname(29)="h2so4"
+    tname(30)="s2"
+    tname(31)="clso2"
+    tname(32)="oscl"
+    tname(33)="h2oliq"
+    tname(34)="h2so4liq"
+    iflag_trac=1
+  ELSE
+    tname(:)='zolbxs'
+  ENDIF
+
+END SUBROUTINE update_inputs_physiq_tracers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_constants
+
+   !USE module_model_constants
+   !use comcstfi_h, only: omeg,mugaz
+   !use planete_h,  only: year_day,periheli,aphelie, &
+   !                       peri_day,obliquit,emin_turb, &
+   !                       lmixmin
+   !use surfdat_h,  only: emissiv,albedice,iceradius, &
+   !                      emisice,dtemisice, &
+   !                       z0_default
+   !use comsoil_h, only: volcapa
+
+   implicit none
+
+   !! comcstfi_h
+   !omeg = womeg                
+   !mugaz = wmugaz  
+   !print*,"check: omeg,mugaz"
+   !print*,omeg,mugaz
+   !! planet_h
+
+END SUBROUTINE update_inputs_physiq_constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_geom( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,ngrid,nlayer,&
+            DDX,DDY,MSFT,&
+            lat_input, lon_input,&
+            XLAT,XLONG)
+
+   ! in WRF (share)
+   USE module_model_constants, only: DEGRAD
+   ! in LMD (phymars)
+   !use comgeomfi_h, only: ini_fillgeom
+   ! in LMD (phy_common)
+   USE mod_grid_phy_lmdz, ONLY: init_grid_phy_lmdz
+   USE geometry_mod, ONLY: latitude,latitude_deg,&
+                           longitude,longitude_deg,&
+                           cell_area,dx,dy
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,ngrid,nlayer
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     MSFT,XLAT,XLONG
+   REAL, INTENT(IN) :: ddx,ddy
+   REAL, INTENT(IN) :: lat_input, lon_input
+   INTEGER :: i,j,subs
+   REAL,DIMENSION(ngrid) :: plon, plat, parea
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+    !-----------------------------------!
+    ! 1D subscript for physics "cursor" !
+    !-----------------------------------!
+    subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+    !----------------------------------------!
+    ! Surface of each part of the grid (m^2) !  
+    !----------------------------------------!
+    !parea(subs) = dx*dy                           !! 1. idealized cases - computational grid
+    parea(subs) = (ddx/msft(i,j))*(ddy/msft(i,j))    !! 2. WRF map scale factors - assume that msfx=msfy (msf=covariance)
+    !parea(subs)=dx*dy/msfu(i,j)                   !! 3. special for Mercator GCM-like simulations
+
+    !---------------------------------------------!
+    ! Mass-point latitude and longitude (radians) !
+    !---------------------------------------------!
+    IF (JULYR .ne. 9999) THEN
+     plat(subs) = XLAT(i,j)*DEGRAD
+     plon(subs) = XLONG(i,j)*DEGRAD
+    ELSE
+     !!! IDEALIZED CASE
+     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lat: ',lat_input
+     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lon: ',lon_input
+     plat(subs) = lat_input*DEGRAD
+     plon(subs) = lon_input*DEGRAD
+    ENDIF 
+
+   ENDDO
+   ENDDO
+
+   !! FILL GEOMETRICAL ARRAYS !!
+   !call ini_fillgeom(ngrid,plat,plon,parea)
+
+   !!! ----------------------------------------------------------
+   !!! --- initializing geometry in phy_common
+   !!! --- (this is quite planet-independent)
+   !!! ----------------------------------------------------------
+   ! initialize mod_grid_phy_lmdz
+   CALL init_grid_phy_lmdz(1,1,ipe-ips+1,jpe-jps+1,nlayer)
+   ! fill in geometry_mod variables
+   ! ... copy over local grid longitudes and latitudes
+   ! ... partly what is done in init_geometry
+   IF(.not.ALLOCATED(longitude)) ALLOCATE(longitude(ngrid))
+   IF(.not.ALLOCATED(longitude_deg)) ALLOCATE(longitude_deg(ngrid))
+   IF(.not.ALLOCATED(latitude)) ALLOCATE(latitude(ngrid))
+   IF(.not.ALLOCATED(latitude_deg)) ALLOCATE(latitude_deg(ngrid))
+   IF(.not.ALLOCATED(cell_area)) ALLOCATE(cell_area(ngrid))
+   IF (.not.ALLOCATED(dx)) ALLOCATE(dx(ngrid))
+   IF (.not.ALLOCATED(dy)) ALLOCATE(dy(ngrid))
+   longitude(:) = plon(:)
+   latitude(:) = plat(:)
+   longitude_deg(:) = plon(:)/DEGRAD
+   latitude_deg(:) = plat(:)/DEGRAD
+   cell_area(:) = parea(:)
+   !!! ----------------------------------------------------------
+
+END SUBROUTINE update_inputs_physiq_geom
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,MARS_MODE,&
+            M_ALBEDO,CST_AL,&
+            M_TSURF,M_EMISS,M_CO2ICE,&
+            M_GW,M_Z0,CST_Z0,&
+            M_H2OICE,&
+            phisfi_val)
+
+   use phys_state_var_mod, only : falbe,ftsol 
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,MARS_MODE
+   INTEGER :: i,j,subs,nlast
+   REAL, INTENT(IN  ) :: CST_AL, phisfi_val, CST_Z0
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_ALBEDO,M_TSURF,M_EMISS,M_CO2ICE,M_H2OICE,M_Z0
+   REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: M_GW  
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !---------------------!
+     ! Ground geopotential !
+     !---------------------!
+     !phisfi(subs) = phisfi_val
+
+     !---------------!
+     ! Ground albedo !
+     !---------------!
+     IF (JULYR .ne. 9999) THEN 
+      IF (CST_AL == 0) THEN
+       falbe(subs)=M_ALBEDO(i,j)
+      ELSE 
+       falbe(subs)=CST_AL
+       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT ALBEDO ', falbe
+      ENDIF
+     ELSE
+      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION albedo: ', CST_AL
+      falbe(subs)=CST_AL
+     ENDIF
+
+     !-----------------------------------------!
+     ! Gravity wave parametrization            !
+     ! NB: usually 0 in mesoscale applications !
+     !-----------------------------------------!
+      !zmea(subs)=0.
+      !zstd(subs)=0.
+      !zsig(subs)=0.
+      !zgam(subs)=0.
+      !zthe(subs)=0.
+
+
+     !-----------------------------------------------!
+     ! Ground temperature, emissivity, CO2 ice cover !
+     !-----------------------------------------------!
+     ftsol(subs) = M_TSURF(i,j)
+     !emis(subs) = M_EMISS(i,j)
+
+     !-------------------!
+     ! Tracer at surface !
+     !-------------------!
+     !qsurf(subs,:)=0. ! default case
+
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   !print*,"check: phisfi",phisfi(1),phisfi(nlast)
+   print*,"check: albedodat",falbe(1),falbe(nlast)
+   print*,"check: tsurf",ftsol(1),ftsol(nlast)
+   !print*,"check: emis",emis(1),emis(nlast)
+
+
+END SUBROUTINE update_inputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,nsoil,&
+            M_TI,CST_TI,&
+            M_ISOIL,M_DSOIL,&
+            M_TSOIL,M_TSURF)
+
+   !use comsoil_h, only: tsoil
+   use phys_state_var_mod, only : ftsoil
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,nsoil
+   INTEGER :: i,j,k,subs,nlast
+   REAL, INTENT(IN  ) :: CST_TI 
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_TI, M_TSURF
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(IN)  :: &
+     M_TSOIL, M_ISOIL, M_DSOIL
+   REAL :: inertiedat_val
+   REAL :: lay1,alpha
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !------------------------!
+     ! Deep soil temperatures ! 
+     !------------------------!
+     IF (M_TSOIL(i,1,j) .gt. 0. .and. JULYR .ne. 9999) THEN
+       ftsoil(subs,:)=M_TSOIL(i,:,j)
+     ELSE
+       IF ((i == ips) .AND. (j == jps)) PRINT *,'no tsoil.set it tsurf.'
+       do k=1,nsoil
+        ftsoil(subs,k) = M_TSURF(i,j)
+       enddo
+     ENDIF
+
+   ENDDO
+   ENDDO
+   !print*,'M_TSURF',M_TSURF(i,j)
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   !print*,"check: inertiedat",inertiedat(1,:),inertiedat(nlast,:)
+   !print*,"check: mlayer",mlayer(:)
+   !print*,"check: layer",layer(:)
+   print*,"check: tsoil",ftsoil(1,:),ftsoil(nlast,:)
+
+END SUBROUTINE update_inputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,&
+            RESTART,isles,&
+            M_Q2,M_WSTAR)
+
+   use turb_mod, only: q2,wstar,turb_resolved
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs,nlast      
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_WSTAR
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(IN) :: M_Q2
+   LOGICAL, INTENT(IN ) :: RESTART,isles
+
+   !! to know if this is turbulence-resolving run or not
+   turb_resolved = isles
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !PBL wind variance
+     IF (.not. restart) THEN
+      q2(subs,:) = 1.E-6      
+      wstar(subs)=0.
+     ELSE
+      q2(subs,:)=M_Q2(i,:,j)
+      wstar(subs)=M_WSTAR(i,j)
+     ENDIF
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: q2",q2(1,1),q2(nlast,kme+1)
+   print*,"check: wstar",wstar(1),wstar(nlast)
+
+END SUBROUTINE update_inputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            RESTART,&
+            M_FLUXRAD)
+
+   !use dimradmars_mod, only: fluxrad
+   use phys_state_var_mod, only : radsol
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs,nlast      
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_FLUXRAD
+   LOGICAL, INTENT(IN ) :: RESTART
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     ! fluxrad_save
+     IF (.not. restart) THEN
+      radsol(subs)=0.
+     ELSE
+      radsol(subs)=M_FLUXRAD(i,j)
+     ENDIF
+     !! et fluxrad_sky ???!???
+
+   ENDDO
+   ENDDO
+  
+   !!---------------------!!
+   !! OUTPUT FOR CHECKING !!
+   !!---------------------!!
+   nlast = (ipe-ips+1)*(jpe-jps+1)
+   print*,"check: fluxrad",radsol(1),radsol(nlast)
+
+END SUBROUTINE update_inputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_slope( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,&
+            SLPX,SLPY)
+
+   !USE module_model_constants, only: DEGRAD
+   !USE slope_mod, ONLY: theta_sl, psi_sl
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: SLPX,SLPY
+   INTEGER :: i,j,subs,nlast
+
+   !! Nothing is done: no slope package (yet) in Venus' physics
+
+END SUBROUTINE update_inputs_physiq_slope
+
+END MODULE update_inputs_physiq_mod
+
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/update_outputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,212 @@
+MODULE update_outputs_physiq_mod
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            MARS_MODE,&
+            M_TSURF,M_CO2ICE,&
+            M_H2OICE)
+
+   use phys_state_var_mod, only : ftsol
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER, INTENT(IN) :: MARS_MODE
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_TSURF,M_CO2ICE,M_H2OICE
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_TSURF(i,j) = ftsol(subs)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            nsoil,&
+            M_TSOIL)
+
+   use phys_state_var_mod, only : ftsoil
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,nsoil
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(INOUT)  :: &
+     M_TSOIL
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_TSOIL(i,:,j) = ftsoil(subs,:)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            M_FLUXRAD)
+
+   use phys_state_var_mod, only : radsol
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: M_FLUXRAD
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_FLUXRAD(i,j) = radsol(subs)
+
+   ENDDO
+   ENDDO
+
+END SUBROUTINE update_outputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            M_Q2,M_WSTAR,&
+            HFMAX,ZMAX,USTM,HFX)
+
+   use turb_mod, only: q2,wstar,yustar,sens
+
+   implicit none
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   INTEGER :: i,j,subs
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_WSTAR,HFMAX,ZMAX,USTM,HFX
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT) :: M_Q2
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !-------------------------------------------------------!
+     ! Save key variables for restart and output and nesting !  
+     !-------------------------------------------------------!
+     M_Q2(i,kps:kpe+1,j) = q2(subs,:)
+     M_WSTAR(i,j) = wstar(subs)
+
+     !! output only (arrays already in phys modules)
+     USTM(i,j) = yustar(subs)
+     HFX(i,j) = sens(subs)
+
+  ENDDO
+  ENDDO
+
+END SUBROUTINE update_outputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_diag( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            SWDOWNZ,TAU_DUST,QSURFDUST,&
+            MTOT,ICETOT,TAU_ICE,&
+            HR_SW,HR_LW,HR_DYN,DT,DTRAD,&
+            RDUST,VMR_ICE,RICE,&
+            CLOUDFRAC,TOTCLOUDFRAC,&
+            RAIN,SNOW,REEVAP,SURFRAIN,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+            FLUXSURF_LW,FLXGRD,LSCEZ,H2OICE_REFF,LATENT_HF)
+   
+   USE comm_wrf !! to get fields to be written from physiq
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
+     SWDOWNZ,TAU_DUST,QSURFDUST,&
+     MTOT,ICETOT,TAU_ICE,&
+     TOTCLOUDFRAC,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+     FLUXSURF_LW,FLXGRD,LATENT_HF,REEVAP,SURFRAIN
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: &
+     HR_SW,HR_LW,RDUST,VMR_ICE,RICE,CLOUDFRAC,HR_DYN,DT,DTRAD,RAIN,SNOW,&
+     LSCEZ,H2OICE_REFF
+   INTEGER :: i,j,subs
+
+
+   DO j = jps,jpe
+   DO i = ips,ipe
+
+     !-----------------------------------!
+     ! 1D subscript for physics "cursor" !
+     !-----------------------------------!
+     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+     !! get diagnostics from physics
+     SWDOWNZ(i,j) = comm_SWDOWNZ(subs)
+     MTOT(i,j) = comm_MTOT(subs) 
+     HR_SW(i,kps:kpe,j) = comm_HR_SW(subs,kps:kpe)
+     HR_LW(i,kps:kpe,j) = comm_HR_LW(subs,kps:kpe)
+     HR_DYN(i,kps:kpe,j) = comm_HR_DYN(subs,kps:kpe)
+     DT(i,kps:kpe,j) = comm_DT(subs,kps:kpe)
+     DTRAD(i,kps:kpe,j) = comm_DT_RAD(subs,kps:kpe)
+     DTVDF(i,kps:kpe,j) = comm_DT_VDF(subs,kps:kpe)
+     DTAJS(i,kps:kpe,j) = comm_DT_AJS(subs,kps:kpe)
+
+   ENDDO
+   ENDDO
+
+   CALL deallocate_comm_wrf
+
+END SUBROUTINE update_outputs_physiq_diag
+
+END MODULE update_outputs_physiq_mod
+
+
+
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/variables_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/variables_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_venus_lmd_new/variables_mod.F	(revision 2744)
@@ -0,0 +1,80 @@
+MODULE variables_mod
+
+IMPLICIT NONE
+
+REAL*8 :: JD_cur !pday !JD_cur ! Julian day
+REAL*8 :: JH_cur_split !ptime !JH_cur_split ! Julian hour (fraction of day)
+REAL*8 :: zdt_split !ptimestep !zdt_split ! time step over which the physics are evaluated
+REAL*8 :: phour_ini ! start time (fraction of day) of the run 0=<phour_ini<1
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplev_omp !pplev !zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplay_omp !pplay !zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zpk_omp!(klon,llm)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zphi_omp !pphi !zphi_omp(klon,llm) ! geopotential at midlayer
+REAL*8,DIMENSION(:),ALLOCATABLE :: zphis_omp!(klon) ! surface geopotential
+REAL*8,DIMENSION(:),ALLOCATABLE :: presnivs_omp!(llm) ! approximate pressure of atm. layers
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zufi_omp !pu !zufi_omp(klon,llm) ! zonal wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zvfi_omp !pv !zvfi_omp(klon,llm) ! meridional wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zrfi_omp!(klon,llm) ! relative wind vorticity, in s-1
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: ztfi_omp !pt !ztfi_omp(klon,llm) ! temperature (K)
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zqfi_omp !pq !zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: flxwfi_omp !flxw !flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) 
+! tendencies (in */s) from the physics:
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdufi_omp !pdu !zdufi_omp(klon,llm) ! tendency on zonal winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdvfi_omp !pdv !zdvfi_omp(klon,llm) ! tendency on meridional winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdtfi_omp !pdt !zdtfi_omp(klon,llm) ! tendency on temperature
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zdqfi_omp !pdq !zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+REAL*8,DIMENSION(:),ALLOCATABLE :: zdpsrf_omp !pdpsrf !zdpsrf_omp(klon) ! tendency on surface pressure
+
+CONTAINS
+
+SUBROUTINE allocate_interface(klon,llm,nqtot)
+
+  IMPLICIT NONE
+ 
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+ 
+  IF (.NOT.ALLOCATED(zplev_omp)) ALLOCATE(zplev_omp(klon,llm+1))
+  IF (.NOT.ALLOCATED(zplay_omp)) ALLOCATE(zplay_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zpk_omp)) ALLOCATE(zpk_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphi_omp)) ALLOCATE(zphi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphis_omp)) ALLOCATE(zphis_omp(klon))
+  IF (.NOT.ALLOCATED(presnivs_omp)) ALLOCATE(presnivs_omp(llm))
+  IF (.NOT.ALLOCATED(zufi_omp)) ALLOCATE(zufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zvfi_omp)) ALLOCATE(zvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zrfi_omp)) ALLOCATE(zrfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(ztfi_omp)) ALLOCATE(ztfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zqfi_omp)) ALLOCATE(zqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(flxwfi_omp)) ALLOCATE(flxwfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdufi_omp)) ALLOCATE(zdufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdvfi_omp)) ALLOCATE(zdvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdtfi_omp)) ALLOCATE(zdtfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdqfi_omp)) ALLOCATE(zdqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(zdpsrf_omp)) ALLOCATE(zdpsrf_omp(klon))
+
+END SUBROUTINE allocate_interface
+
+SUBROUTINE deallocate_interface
+
+  DEALLOCATE(zplev_omp)
+  DEALLOCATE(zplay_omp)
+  DEALLOCATE(zpk_omp)
+  DEALLOCATE(zphi_omp)
+  DEALLOCATE(zphis_omp)
+  DEALLOCATE(presnivs_omp)
+  DEALLOCATE(zufi_omp)
+  DEALLOCATE(zvfi_omp)
+  DEALLOCATE(zrfi_omp)
+  DEALLOCATE(ztfi_omp)
+  DEALLOCATE(zqfi_omp)
+  DEALLOCATE(flxwfi_omp)
+  DEALLOCATE(zdufi_omp)
+  DEALLOCATE(zdvfi_omp)
+  DEALLOCATE(zdtfi_omp)
+  DEALLOCATE(zdqfi_omp)
+  DEALLOCATE(zdpsrf_omp)
+
+END SUBROUTINE deallocate_interface
+
+END MODULE variables_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/callphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/callphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/callphysiq_mod.F	(revision 2744)
@@ -0,0 +1,30 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+ !! ----------------------------------------------------------
+ !! ---- CALL TO NO PHYSICS
+ !! ----------------------------------------------------------
+
+CONTAINS
+
+SUBROUTINE call_physiq(planet_type, klon,llm,nqtot,                       &
+                       debut_split,lafin_split)
+
+  USE variables_mod
+
+  IMPLICIT NONE
+
+  character(len=10),INTENT(IN) :: planet_type ! planet type ('earth','mars',...)
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/iniphysiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/iniphysiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/iniphysiq_mod.F	(revision 2744)
@@ -0,0 +1,26 @@
+MODULE iniphysiq_mod
+
+CONTAINS
+
+subroutine iniphysiq(ngrid,nlayer,nq,piphysiq,&
+                     punjours, pdayref, &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+implicit none
+
+real,intent(in) :: prad ! radius of the planet (m)
+real,intent(in) :: pg ! gravitational acceleration (m/s2)
+real,intent(in) :: pr ! ! reduced gas constant R/mu
+real,intent(in) :: pcpp ! specific heat Cp
+real,intent(in) :: punjours ! length (in s) of a standard day [daysec]
+integer,intent(in) :: pdayref ! reference day of for the simulation [day_ini]
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer,intent(in) :: ngrid ! number of physics columns for this MPI process
+integer,intent(in) :: nlayer ! number of atmospheric layers
+integer,intent(in) :: nq ! number of tracers
+real,intent(in) :: piphysiq   ! call physics every piphysiq dynamical timesteps
+
+end subroutine iniphysiq
+
+END MODULE iniphysiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/update_inputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/update_inputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,149 @@
+MODULE update_inputs_physiq_mod
+
+CONTAINS
+
+!SUBROUTINE update_inputs_physiq_time
+!SUBROUTINE update_inputs_physiq_tracers
+!SUBROUTINE update_inputs_physiq_constants
+!SUBROUTINE update_inputs_physiq_geom
+!SUBROUTINE update_inputs_physiq_surf
+!SUBROUTINE update_inputs_physiq_soil
+!SUBROUTINE update_inputs_physiq_turb
+!SUBROUTINE update_inputs_physiq_rad
+!SUBROUTINE update_inputs_physiq_slope
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_time(&
+            JULYR,JULDAY,GMT,&
+            elaps,&
+            lct_input,lon_input,ls_input,&
+            MY)
+
+  INTEGER, INTENT(IN) :: JULDAY, JULYR
+  REAL, INTENT(IN) :: GMT,elaps,lon_input,ls_input,lct_input
+  REAL,INTENT(OUT) :: MY
+
+END SUBROUTINE update_inputs_physiq_time
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_tracers(nq,MARS_MODE)
+
+  INTEGER, INTENT(IN) :: nq,MARS_MODE
+
+END SUBROUTINE update_inputs_physiq_tracers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_constants
+
+END SUBROUTINE update_inputs_physiq_constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_geom( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,ngrid,nlayer,&
+            DX,DY,MSFT,&
+            lat_input, lon_input,&
+            XLAT,XLONG)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,ngrid,nlayer
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     MSFT,XLAT,XLONG
+   REAL, INTENT(IN) :: dx,dy
+   REAL, INTENT(IN) :: lat_input, lon_input
+
+END SUBROUTINE update_inputs_physiq_geom
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,MARS_MODE,&
+            M_ALBEDO,CST_AL,&
+            M_TSURF,M_EMISS,M_CO2ICE,&
+            M_GW,M_Z0,CST_Z0,&
+            M_H2OICE,&
+            phisfi_val)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,MARS_MODE
+   INTEGER :: i,j,subs,nlast
+   REAL, INTENT(IN  ) :: CST_AL, phisfi_val, CST_Z0
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_ALBEDO,M_TSURF,M_EMISS,M_CO2ICE,M_H2OICE,M_Z0
+   REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: M_GW  
+
+END SUBROUTINE update_inputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,nsoil,&
+            M_TI,CST_TI,&
+            M_ISOIL,M_DSOIL,&
+            M_TSOIL,M_TSURF)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,nsoil
+   INTEGER :: i,j,subs,nlast,k
+   REAL, INTENT(IN  ) :: CST_TI 
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
+     M_TI, M_TSURF
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(IN)  :: &
+     M_TSOIL, M_ISOIL, M_DSOIL
+
+END SUBROUTINE update_inputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,&
+            RESTART,isles,&
+            M_Q2,M_WSTAR)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_WSTAR
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(IN) :: M_Q2
+   LOGICAL, INTENT(IN ) :: RESTART,isles
+
+END SUBROUTINE update_inputs_physiq_turb
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            RESTART,&
+            M_FLUXRAD)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: M_FLUXRAD
+   LOGICAL, INTENT(IN ) :: RESTART
+
+END SUBROUTINE update_inputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_inputs_physiq_slope( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,&
+            SLPX,SLPY)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: SLPX,SLPY
+
+END SUBROUTINE update_inputs_physiq_slope
+
+END MODULE update_inputs_physiq_mod
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/update_outputs_physiq_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/update_outputs_physiq_mod.F	(revision 2744)
@@ -0,0 +1,96 @@
+MODULE update_outputs_physiq_mod
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            MARS_MODE,&
+            M_TSURF,M_CO2ICE,&
+            M_H2OICE)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   INTEGER, INTENT(IN) :: MARS_MODE
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_TSURF,M_CO2ICE,M_H2OICE
+
+END SUBROUTINE update_outputs_physiq_surf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            nsoil,&
+            M_TSOIL)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,nsoil
+   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(INOUT)  :: &
+     M_TSOIL
+
+END SUBROUTINE update_outputs_physiq_soil
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            M_FLUXRAD)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: M_FLUXRAD
+
+END SUBROUTINE update_outputs_physiq_rad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            M_Q2,M_WSTAR,&
+            HFMAX,ZMAX,USTM,HFX)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     M_WSTAR,HFMAX,ZMAX,USTM,HFX
+   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT) :: M_Q2
+
+END SUBROUTINE update_outputs_physiq_turb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE update_outputs_physiq_diag( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            SWDOWNZ,TAU_DUST,QSURFDUST,&
+            MTOT,ICETOT,TAU_ICE,&
+            HR_SW,HR_LW,HR_DYN,DT,DTRAD,&
+            RDUST,VMR_ICE,RICE,&
+            CLOUDFRAC,TOTCLOUDFRAC,&
+            RAIN,SNOW,REEVAP,SURFRAIN,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+            FLUXSURF_LW,FLXGRD,LSCEZ,H2OICE_REFF,LATENT_HF)
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
+   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
+     SWDOWNZ,TAU_DUST,QSURFDUST,&
+     MTOT,ICETOT,TAU_ICE,&
+     TOTCLOUDFRAC,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+     FLUXSURF_LW,FLXGRD,LATENT_HF,REEVAP,SURFRAIN
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: &
+     HR_SW,HR_LW,RDUST,VMR_ICE,RICE,CLOUDFRAC,HR_DYN,DT,DTRAD,RAIN,SNOW,&
+     LSCEZ,H2OICE_REFF
+   INTEGER :: i,j,subs
+
+END SUBROUTINE update_outputs_physiq_diag
+
+END MODULE update_outputs_physiq_mod
+
+
+
Index: trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/variables_mod.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/variables_mod.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/dynphy_wrf_void_lmd_new/variables_mod.F	(revision 2744)
@@ -0,0 +1,85 @@
+MODULE variables_mod
+
+IMPLICIT NONE
+
+REAL*8 :: JD_cur !pday !JD_cur ! Julian day
+REAL*8 :: JH_cur_split !ptime !JH_cur_split ! Julian hour (fraction of day)
+REAL*8 :: zdt_split !ptimestep !zdt_split ! time step over which the physics are evaluated
+REAL*8 :: phour_ini ! start time (fraction of day) of the run 0=<phour_ini<1
+REAL*8 :: counter
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplev_omp !pplev !zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zplay_omp !pplay !zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zpk_omp!(klon,llm)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zphi_omp !pphi !zphi_omp(klon,llm) ! geopotential at midlayer
+REAL*8,DIMENSION(:),ALLOCATABLE :: zphis_omp!(klon) ! surface geopotential
+REAL*8,DIMENSION(:),ALLOCATABLE :: presnivs_omp!(llm) ! approximate pressure of atm. layers
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zufi_omp !pu !zufi_omp(klon,llm) ! zonal wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zvfi_omp !pv !zvfi_omp(klon,llm) ! meridional wind (m/s)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zrfi_omp!(klon,llm) ! relative wind vorticity, in s-1
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: ztfi_omp !pt !ztfi_omp(klon,llm) ! temperature (K)
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zqfi_omp !pq !zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: flxwfi_omp !flxw !flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s)  ! tendencies (in */s) from the physics:
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdufi_omp !pdu !zdufi_omp(klon,llm) ! tendency on zonal winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdvfi_omp !pdv !zdvfi_omp(klon,llm) ! tendency on meridional winds
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: zdtfi_omp !pdt !zdtfi_omp(klon,llm) ! tendency on temperature
+REAL*8,DIMENSION(:,:,:),ALLOCATABLE :: zdqfi_omp !pdq !zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+REAL*8,DIMENSION(:),ALLOCATABLE :: zdpsrf_omp !pdpsrf !zdpsrf_omp(klon) !tendency on surface pressure
+REAL*8,DIMENSION(:,:),ALLOCATABLE :: hrlw,hrsw
+
+CONTAINS
+
+SUBROUTINE allocate_interface(klon,llm,nqtot)
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+
+  IF (.NOT.ALLOCATED(zplev_omp)) ALLOCATE(zplev_omp(klon,llm+1))
+  IF (.NOT.ALLOCATED(zplay_omp)) ALLOCATE(zplay_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zpk_omp)) ALLOCATE(zpk_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphi_omp)) ALLOCATE(zphi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zphis_omp)) ALLOCATE(zphis_omp(klon))
+  IF (.NOT.ALLOCATED(presnivs_omp)) ALLOCATE(presnivs_omp(llm))
+  IF (.NOT.ALLOCATED(zufi_omp)) ALLOCATE(zufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zvfi_omp)) ALLOCATE(zvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zrfi_omp)) ALLOCATE(zrfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(ztfi_omp)) ALLOCATE(ztfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zqfi_omp)) ALLOCATE(zqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(flxwfi_omp)) ALLOCATE(flxwfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdufi_omp)) ALLOCATE(zdufi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdvfi_omp)) ALLOCATE(zdvfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdtfi_omp)) ALLOCATE(zdtfi_omp(klon,llm))
+  IF (.NOT.ALLOCATED(zdqfi_omp)) ALLOCATE(zdqfi_omp(klon,llm,nqtot))
+  IF (.NOT.ALLOCATED(zdpsrf_omp)) ALLOCATE(zdpsrf_omp(klon))
+  IF (.NOT.ALLOCATED(hrlw)) ALLOCATE(hrlw(klon,llm))
+  IF (.NOT.ALLOCATED(hrsw)) ALLOCATE(hrsw(klon,llm))
+
+END SUBROUTINE allocate_interface
+
+SUBROUTINE deallocate_interface
+
+  DEALLOCATE(zplev_omp)
+  DEALLOCATE(zplay_omp)
+  DEALLOCATE(zpk_omp)
+  DEALLOCATE(zphi_omp)
+  DEALLOCATE(zphis_omp)
+  DEALLOCATE(presnivs_omp)
+  DEALLOCATE(zufi_omp)
+  DEALLOCATE(zvfi_omp)
+  DEALLOCATE(zrfi_omp)
+  DEALLOCATE(ztfi_omp)
+  DEALLOCATE(zqfi_omp)
+  DEALLOCATE(flxwfi_omp)
+  DEALLOCATE(zdufi_omp)
+  DEALLOCATE(zdvfi_omp)
+  DEALLOCATE(zdtfi_omp)
+  DEALLOCATE(zdqfi_omp)
+  DEALLOCATE(zdpsrf_omp)
+  DEALLOCATE(hrlw)
+  DEALLOCATE(hrsw)
+
+END SUBROUTINE deallocate_interface
+
+END MODULE variables_mod
Index: trunk/WRF.COMMON/WRFV2/phys/module_bl_gfs.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_bl_gfs.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_bl_gfs.F	(revision 2744)
@@ -0,0 +1,1122 @@
+!LWRF:MODEL_LAYER:PHYSICS
+!
+MODULE module_bl_gfs
+
+CONTAINS
+
+!-------------------------------------------------------------------          
+   SUBROUTINE BL_GFS(U3D,V3D,TH3D,T3D,QV3D,QC3D,     P3D,PI3D,     &
+                  RUBLTEN,RVBLTEN,RTHBLTEN,                        &
+                  RQVBLTEN,RQCBLTEN,                   	           &
+                  CP,G,ROVCP,R,ROVG,FLAG_QI,                       &
+                  dz8w,z,PSFC,                                     &
+                  UST,PBL,PSIM,PSIH,                               &
+                  HFX,QFX,TSK,GZ1OZ0,WSPD,BR,                      &
+                  DT,KPBL2D,EP1,KARMAN,                            &
+                  ids,ide, jds,jde, kds,kde,                       &
+                  ims,ime, jms,jme, kms,kme,                       &
+                  its,ite, jts,jte, kts,kte,                       &
+               ! optional
+                  qi3d,rqiblten                                    )
+!--------------------------------------------------------------------
+      USE MODULE_GFS_MACHINE,    ONLY : kind_phys
+!-------------------------------------------------------------------
+      IMPLICIT NONE
+!-------------------------------------------------------------------
+!-- U3D         3D u-velocity interpolated to theta points (m/s)
+!-- V3D         3D v-velocity interpolated to theta points (m/s)
+!-- TH3D	3D potential temperature (K)
+!-- T3D         temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!-- QC3D        3D cloud mixing ratio (Kg/Kg)
+!-- QI3D        3D ice mixing ratio (Kg/Kg)
+!-- P3D         3D pressure (Pa)
+!-- PI3D	3D exner function (dimensionless)
+!-- rr3D	3D dry air density (kg/m^3)
+!-- RUBLTEN     U tendency due to
+!               PBL parameterization (m/s^2)
+!-- RVBLTEN     V tendency due to
+!               PBL parameterization (m/s^2)
+!-- RTHBLTEN    Theta tendency due to
+!               PBL parameterization (K/s)
+!-- RQVBLTEN    Qv tendency due to
+!               PBL parameterization (kg/kg/s)
+!-- RQCBLTEN    Qc tendency due to
+!               PBL parameterization (kg/kg/s)
+!-- RQIBLTEN    Qi tendency due to
+!               PBL parameterization (kg/kg/s)
+!-- CP          heat capacity at constant pressure for dry air (J/kg/K)
+!-- G           acceleration due to gravity (m/s^2)
+!-- ROVCP       R/CP
+!-- R           gas constant for dry air (J/kg/K)
+!-- ROVG 	R/G
+!-- P_QI	species index for cloud ice
+!-- dz8w	dz between full levels (m)
+!-- z		height above sea level (m)
+!-- PSFC        pressure at the surface (Pa)
+!-- UST		u* in similarity theory (m/s)
+!-- PBL		PBL height (m)
+!-- PSIM        similarity stability function for momentum
+!-- PSIH        similarity stability function for heat
+!-- HFX		upward heat flux at the surface (W/m^2)
+!-- QFX		upward moisture flux at the surface (kg/m^2/s)
+!-- TSK		surface temperature (K)
+!-- GZ1OZ0      log(z/z0) where z0 is roughness length
+!-- WSPD        wind speed at lowest model level (m/s)
+!-- BR          bulk Richardson number in surface layer
+!-- DT		time step (s)
+!-- rvovrd      R_v divided by R_d (dimensionless)
+!-- EP1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
+!-- KARMAN      Von Karman constant
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!-------------------------------------------------------------------
+
+      INTEGER, INTENT(IN) ::            ids,ide, jds,jde, kds,kde,      &
+                                        ims,ime, jms,jme, kms,kme,      &
+                                        its,ite, jts,jte, kts,kte
+
+      LOGICAL, INTENT(IN) ::            flag_qi 
+
+      REAL,    INTENT(IN) ::                                            &
+                                        CP,                             &
+                                        DT,                             &
+                                        EP1,                            &
+                                        G,                              &
+                                        KARMAN,                         &
+                                        R,                              & 
+                                        ROVCP,                          &
+                                        ROVG 
+
+      REAL,    DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) ::      & 
+                                        DZ8W,                           &
+                                        P3D,                            &
+                                        PI3D,                           &
+                                        QC3D,                           &
+                                        QV3D,                           &
+                                        T3D,                            &
+                                        TH3D,                           &
+                                        U3D,                            &
+                                        V3D,                            &
+                                        Z   
+
+
+      REAL,    DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::   &
+                                        RTHBLTEN,                       &
+                                        RQCBLTEN,                       &
+                                        RQVBLTEN,                       &
+                                        RUBLTEN,                        &
+                                        RVBLTEN                        
+
+      REAL,    DIMENSION(ims:ime, jms:jme), INTENT(IN) ::               &
+                                        BR,                             &
+                                        GZ1OZ0,                         &
+                                        HFX,                            &
+                                        PSFC,                           &
+                                        PSIM,                           &
+                                        PSIH,                           &
+                                        QFX,                            &
+                                        TSK
+ 
+      REAL,    DIMENSION(ims:ime, jms:jme), INTENT(INOUT) ::            & 
+                                        PBL,                            &
+                                        UST,                            &
+                                        WSPD
+
+      INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(OUT) ::              &
+                                        KPBL2D 
+
+!--------------------------- OPTIONAL VARS ------------------------------
+      REAL, DIMENSION(ims:ime, kms:kme, jms:jme),                       &
+            OPTIONAL, INTENT(IN) ::                                     & 
+                                        QI3D
+
+      REAL, DIMENSION(ims:ime, kms:kme, jms:jme),                       &
+            OPTIONAL, INTENT(INOUT) ::                                  & 
+                                        RQIBLTEN
+
+!--------------------------- LOCAL VARS ------------------------------
+
+
+      REAL     (kind=kind_phys), DIMENSION(its:ite, kts:kte) ::         &
+                                        DEL,                            &
+                                        DU,                             &
+                                        DV,                             &
+                                        PHIL,                           &
+                                        PRSL,                           &
+                                        PRSLK,                          &
+                                        T1,                             &
+                                        TAU,                            &
+                                        U1,                             &
+                                        V1
+
+      REAL     (kind=kind_phys), DIMENSION(its:ite, kts:kte+1) ::       &
+                                        PHII,                           & 
+                                        PRSI
+
+      REAL     (kind=kind_phys), DIMENSION(its:ite, kts:kte, 3) ::      &
+                                        Q1,                             &
+                                        RTG
+
+      REAL     (kind=kind_phys), DIMENSION(its:ite) ::                  &
+                                        DQSFC,                          &
+                                        DTSFC,                          &
+                                        DUSFC,                          &
+                                        DVSFC,                          &
+                                        EVAP,                           &
+                                        FH,                             &
+                                        FM,                             &
+                                        HEAT,                           &
+                                        HGAMQ,                          &
+                                        HGAMT,                          &
+                                        HPBL,                           &
+                                        PSK,                            &
+                                        QSS,                            &
+                                        RBSOIL,                         &
+                                        RCL,                            &
+                                        SPD1,                           &
+                                        STRESS,                         &
+                                        TSEA
+
+      REAL     (kind=kind_phys) ::                                      &
+                                        CPM,                            &
+                                        DELTIM,                         &
+                                        FMTMP,                          &
+                                        RRHOX
+
+      INTEGER, DIMENSION( its:ite ) ::                                  &
+                                        KPBL 
+
+      INTEGER ::                                                        &
+                                        I,                              &
+                                        IM,                             &
+                                        J,                              &
+                                        K,                              &
+                                        KM,                             &
+                                        KTEM,                           &
+                                        KTEP,                           &
+                                        KX,                             &
+                                        L,                              & 
+                                        NTRAC
+ 
+   IM=ITE-ITS+1
+   KX=KTE-KTS+1
+   KTEM=KTE-1
+   KTEP=KTE+1
+   NTRAC=2
+   DELTIM=DT
+   IF (flag_qi) NTRAC=3
+
+
+   DO J=jts,jte
+
+      DO i=its,ite
+        RRHOX=(R*T3D(I,KTS,J)*(1.+EP1*QV3D(I,KTS,J)))/PSFC(I,J)
+        CPM=CP*(1.+0.8*QV3D(i,kts,j))
+        FMTMP=GZ1OZ0(i,j)-PSIM(i,j)
+        PSK(i)=(PSFC(i,j)*.00001)**ROVCP
+        FM(i)=FMTMP
+        FH(i)=GZ1OZ0(i,j)-PSIH(i,j)
+        TSEA(i)=TSK(i,j)
+        QSS(i)=QV3D(i,kts,j)               ! not used in moninp so set to qv3d for now
+        HEAT(i)=HFX(i,j)/CPM*RRHOX
+        EVAP(i)=QFX(i,j)*RRHOX
+        STRESS(i)=KARMAN*KARMAN*WSPD(i,j)*WSPD(i,j)/(FMTMP*FMTMP)
+        SPD1(i)=WSPD(i,j)
+        PRSI(i,kts)=PSFC(i,j)*.001
+        PHII(I,kts)=0.
+        RCL(i)=1.
+        RBSOIL(I)=BR(i,j)
+      ENDDO
+
+      DO k=kts,kte
+        DO i=its,ite 
+          DV(I,K) = 0.
+          DU(I,K) = 0.
+          TAU(I,K) = 0.
+          U1(I,K) = U3D(i,k,j)
+          V1(I,K) = V3D(i,k,j)
+          T1(I,K) = T3D(i,k,j)
+          Q1(I,K,1) = QV3D(i,k,j)/(1.+QV3D(i,k,j))
+          Q1(I,K,2) = QC3D(i,k,j)/(1.+QC3D(i,k,j))
+          PRSL(I,K)=P3D(i,k,j)*.001
+        ENDDO
+      ENDDO
+
+      DO k=kts,kte
+        DO i=its,ite 
+          PRSLK(I,K)=(PRSL(i,k)*.01)**ROVCP
+        ENDDO
+      ENDDO
+
+      DO k=kts+1,kte
+        km=k-1
+        DO i=its,ite 
+          DEL(i,km)=PRSL(i,km)/ROVG*dz8w(i,km,j)/T3D(i,km,j)
+          PRSI(i,k)=PRSI(i,km)-DEL(i,km)
+          PHII(I,K)=(Z(i,k,j)-Z(i,kts,j))*G
+          PHIL(I,KM)=0.5*(Z(i,k,j)+Z(i,km,j)-2.*Z(i,kts,j))*G
+        ENDDO
+      ENDDO
+
+      DO i=its,ite 
+        DEL(i,kte)=DEL(i,ktem)
+        PRSI(i,ktep)=PRSI(i,kte)-DEL(i,ktem)
+        PHII(I,KTEP)=PHII(I,KTE)+dz8w(i,kte,j)*G
+        PHIL(I,KTE)=PHII(I,KTE)-PHIL(I,KTEM)+PHII(I,KTE)
+      ENDDO
+
+      IF (flag_QI .AND. PRESENT( QI3D ) ) THEN
+        DO k=kts,kte
+          DO i=its,ite 
+            Q1(I,K,3) = QI3D(i,k,j)/(1.+QI3D(i,k,j))
+          ENDDO
+        ENDDO
+      ENDIF
+
+      DO l=1,ntrac
+        DO k=kts,kte
+          DO i=its,ite
+            RTG(I,K,L) = 0.
+          ENDDO
+        ENDDO
+      ENDDO
+
+      CALL MONINP(IM,IM,KX,NTRAC,DV,DU,TAU,RTG,U1,V1,T1,Q1,             &
+                  PSK,RBSOIL,FM,FH,TSEA,QSS,HEAT,EVAP,STRESS,           &
+                  SPD1,KPBL,PRSI,DEL,PRSL,PRSLK,PHII,PHIL,RCL,          &
+                  DELTIM,DUSFC,DVSFC,DTSFC,DQSFC,HPBL,HGAMT,HGAMQ)
+
+
+      DO k=kts,kte
+        DO i=its,ite
+          RVBLTEN(I,K,J)=DV(I,K)
+          RUBLTEN(I,K,J)=DU(I,K)
+          RTHBLTEN(I,K,J)=TAU(I,K)/PI3D(I,K,J)
+          RQVBLTEN(I,K,J)=RTG(I,K,1)/(1.-Q1(I,K,1))**2
+          RQCBLTEN(I,K,J)=RTG(I,K,2)/(1.-Q1(I,K,2))**2
+        ENDDO
+      ENDDO
+
+      IF (flag_QI .AND. PRESENT( RQIBLTEN ))  THEN
+        DO k=kts,kte
+          DO i=its,ite
+            RQIBLTEN(I,K,J)=RTG(I,K,3)/(1.-Q1(I,K,3))**2
+          ENDDO
+        ENDDO
+      ENDIF
+
+      DO i=its,ite
+        UST(i,j)=SQRT(STRESS(i))
+        WSPD(i,j)=SQRT(U3D(I,KTS,J)*U3D(I,KTS,J)+                       &
+                       V3D(I,KTS,J)*V3D(I,KTS,J))+1.E-9
+        PBL(i,j)=HPBL(i)
+        KPBL2D(i,j)=kpbl(i)
+      ENDDO
+
+    ENDDO
+
+
+   END SUBROUTINE BL_GFS
+
+!===================================================================
+   SUBROUTINE gfsinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,           &
+                      RQCBLTEN,RQIBLTEN,P_QI,P_FIRST_SCALAR,   &
+                      restart,                                     &
+                      allowed_to_read,                             &
+                      ids, ide, jds, jde, kds, kde,                &
+                      ims, ime, jms, jme, kms, kme,                &
+                      its, ite, jts, jte, kts, kte                 )
+!-------------------------------------------------------------------          
+   IMPLICIT NONE
+!-------------------------------------------------------------------          
+   LOGICAL , INTENT(IN)          ::  allowed_to_read,restart
+   INTEGER , INTENT(IN)          ::  ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte
+   INTEGER , INTENT(IN)          ::  P_QI, P_FIRST_SCALAR
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::         &
+                                                         RUBLTEN, &
+                                                         RVBLTEN, &
+                                                         RTHBLTEN, &
+                                                         RQVBLTEN, &
+                                                         RQCBLTEN, & 
+                                                         RQIBLTEN
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+
+   IF(.not.restart)THEN
+     DO j=jts,jtf
+     DO k=kts,ktf
+     DO i=its,itf
+        RUBLTEN(i,k,j)=0.
+        RVBLTEN(i,k,j)=0.
+        RTHBLTEN(i,k,j)=0.
+        RQVBLTEN(i,k,j)=0.
+        RQCBLTEN(i,k,j)=0.
+     ENDDO
+     ENDDO
+     ENDDO
+   ENDIF
+
+   IF (P_QI .ge. P_FIRST_SCALAR .and. .not.restart) THEN
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         RQIBLTEN(i,k,j)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+   END SUBROUTINE gfsinit
+
+! --------------------------------------------------------------
+!FPP$ NOCONCUR R
+      SUBROUTINE MONINP(IX,IM,KM,ntrac,DV,DU,TAU,RTG,                   &
+     &     U1,V1,T1,Q1,                                                 &
+     &     PSK,RBSOIL,FM,FH,TSEA,QSS,HEAT,EVAP,STRESS,SPD1,KPBL,        &
+!    &     PSK,RBSOIL,CD,CH,FM,FH,TSEA,QSS,DPHI,SPD1,KPBL,              &
+     &     PRSI,DEL,PRSL,PRSLK,PHII,PHIL,RCL,DELTIM,                    &
+     &     DUSFC,DVSFC,DTSFC,DQSFC,HPBL,HGAMT,HGAMQ)
+!
+      USE MODULE_GFS_MACHINE, ONLY : kind_phys
+      USE MODULE_GFS_PHYSCONS, grav => con_g, RD => con_RD, CP => con_CP &
+     &,             HVAP => con_HVAP, ROG => con_ROG, FV => con_FVirt
+
+      implicit none
+!
+!     include 'constant.h'
+!
+!
+!     Arguments
+!
+      integer IX, IM, KM, ntrac, KPBL(IM)
+!
+      real(kind=kind_phys) DELTIM
+      real(kind=kind_phys) DV(IM,KM),     DU(IM,KM),                    &
+     &                     TAU(IM,KM),    RTG(IM,KM,ntrac),             &
+     &                     U1(IX,KM),     V1(IX,KM),                    &
+     &                     T1(IX,KM),     Q1(IX,KM,ntrac),              &
+     &                     PSK(IM),       RBSOIL(IM),                   &
+!    &                     CD(IM),        CH(IM),                       &
+     &                     FM(IM),        FH(IM),                       &
+     &                     TSEA(IM),      QSS(IM),                      &
+     &                                    SPD1(IM),                     &
+!    &                     DPHI(IM),      SPD1(IM),                     &
+     &                     PRSI(IX,KM+1), DEL(IX,KM),                   &
+     &                     PRSL(IX,KM),   PRSLK(IX,KM),                 &
+     &                     PHII(IX,KM+1), PHIL(IX,KM),                  & 
+     &                     RCL(IM),       DUSFC(IM),                    &
+     &                     dvsfc(IM),     dtsfc(IM),                    & 
+     &                     DQSFC(IM),     HPBL(IM),                     &
+     &                     HGAMT(IM),     hgamq(IM)
+!
+!    Locals
+!
+      integer i,iprt,is,iun,k,kk,kmpbl,lond
+!     real(kind=kind_phys) betaq(IM), betat(IM),   betaw(IM),           &
+      real(kind=kind_phys) evap(IM),  heat(IM),    phih(IM),            &
+     &                     phim(IM),  rbdn(IM),    rbup(IM),            &
+     &                     the1(IM),  stress(im),  beta(im),            &
+     &                     the1v(IM), thekv(IM),   thermal(IM),         &
+     &                     thesv(IM), ustar(IM),   wscale(IM)            
+!    &                     thesv(IM), ustar(IM),   wscale(IM),  zl1(IM)
+!
+      real(kind=kind_phys) RDZT(IM,KM-1),                               &
+     &                     ZI(IM,KM+1),     ZL(IM,KM),                  &
+     &                     DKU(IM,KM-1),    DKT(IM,KM-1), DKO(IM,KM-1), &
+     &                     AL(IM,KM-1),     AD(IM,KM),                  &
+     &                     AU(IM,KM-1),     A1(IM,KM),                  &
+     &                     A2(IM,KM),       THETA(IM,KM),               &
+     &                     AT(IM,KM*(ntrac-1))
+      logical              pblflg(IM),   sfcflg(IM), stable(IM)
+!
+      real(kind=kind_phys) aphi16,  aphi5,  bet1,   bvf2,               &
+     &                     cfac,    conq,   cont,   conw,               &
+     &                     conwrc,  dk,     dkmax,  dkmin,              &
+     &                     dq1,     dsdz2,  dsdzq,  dsdzt,              &
+     &                     dsig,    dt,     dthe1,  dtodsd,             &
+     &                     dtodsu,  dw2,    dw2min, g,                  &
+     &                     gamcrq,  gamcrt, gocp,   gor, gravi,         &
+     &                     hol,     pfac,   prmax,  prmin, prinv,       &
+     &                     prnum,   qmin,   qtend,  rbcr,               & 
+     &                     rbint,   rdt,    rdz,    rdzt1,              &
+     &                     ri,      rimin,  rl2,    rlam,               &
+     &                     rone,   rzero,  sfcfrac,                     &
+     &                     sflux,   shr2,   spdk2,  sri,                &
+     &                     tem,     ti,     ttend,  tvd,                &
+     &                     tvu,     utend,  vk,     vk2,                &
+     &                     vpert,   vtend,  xkzo,   zfac,               &
+     &                     zfmin,   zk,     tem1
+!
+      PARAMETER(g=grav)
+      PARAMETER(GOR=G/RD,GOCP=G/CP)
+      PARAMETER(CONT=1000.*CP/G,CONQ=1000.*HVAP/G,CONW=1000./G)
+      PARAMETER(RLAM=150.,VK=0.4,VK2=VK*VK,PRMIN=1.0,PRMAX=4.)
+      PARAMETER(DW2MIN=0.0001,DKMIN=1.0,DKMAX=1000.,RIMIN=-100.)
+      PARAMETER(RBCR=0.5,CFAC=7.8,PFAC=2.0,SFCFRAC=0.1)
+      PARAMETER(QMIN=1.E-8,XKZO=1.0,ZFMIN=1.E-8,APHI5=5.,APHI16=16.)
+!     PARAMETER(GAMCRT=3.,GAMCRQ=2.E-3)
+      PARAMETER(GAMCRT=3.,GAMCRQ=0.)
+      PARAMETER(RZERO=0.,RONE=1.)
+      PARAMETER(IUN=84)
+!
+!
+!-----------------------------------------------------------------------
+!
+ 601  FORMAT(1X,' MONINP LAT LON STEP HOUR ',3I6,F6.1)
+ 602      FORMAT(1X,'    K','        Z','        T','       TH',        &
+     &     '      TVH','        Q','        U','        V',             &
+     &     '       SP')
+ 603      FORMAT(1X,I5,8F9.1)
+ 604      FORMAT(1X,'  SFC',9X,F9.1,18X,F9.1)
+ 605      FORMAT(1X,'    K      ZL    SPD2   THEKV   THE1V'             &
+     &         ,' THERMAL    RBUP')
+ 606      FORMAT(1X,I5,6F8.2)
+ 607      FORMAT(1X,' KPBL    HPBL      FM      FH   HGAMT',            &
+     &         '   HGAMQ      WS   USTAR      CD      CH')
+ 608      FORMAT(1X,I5,9F8.2)
+ 609      FORMAT(1X,' K PR DKT DKU ',I5,3F8.2)
+ 610      FORMAT(1X,' K PR DKT DKU ',I5,3F8.2,' L2 RI T2',              & 
+     &         ' SR2  ',2F8.2,2E10.2)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!     COMPUTE PRELIMINARY VARIABLES
+!
+
+      if (IX .lt. im) stop
+!
+      IPRT = 0
+      IF(IPRT.EQ.1) THEN
+!!!   LATD = 0
+      LOND = 0
+      ELSE
+!!!   LATD = 0
+      LOND = 0
+      ENDIF
+!
+      gravi = 1.0 / grav
+      DT    = 2. * DELTIM
+      RDT   = 1. / DT
+      KMPBL = KM / 2
+!
+      do k=1,km
+        do i=1,im
+          zi(i,k) = phii(i,k) * gravi
+          zl(i,k) = phil(i,k) * gravi
+        enddo
+      enddo
+!
+      do k=1,kmpbl
+        do i=1,im
+          theta(i,k) = t1(i,k) * psk(i) / prslk(i,k)
+        enddo
+      enddo
+!
+      DO K = 1,KM-1
+        DO I=1,IM
+          RDZT(I,K) = GOR * PRSI(I,K+1) / (PRSL(I,K) - PRSL(I,K+1))
+        ENDDO
+      ENDDO
+!
+      DO I = 1,IM
+         DUSFC(I) = 0.
+         DVSFC(I) = 0.
+         DTSFC(I) = 0.
+         DQSFC(I) = 0.
+         HGAMT(I) = 0.
+         HGAMQ(I) = 0.
+         WSCALE(I) = 0.
+         KPBL(I) = 1
+         HPBL(I) = ZI(I,2)
+         PBLFLG(I) = .TRUE.
+         SFCFLG(I) = .TRUE.
+         IF(RBSOIL(I).GT.0.0) SFCFLG(I) = .FALSE.
+      ENDDO
+!!
+      DO I=1,IM
+         RDZT1    = GOR * prSL(i,1) / DEL(i,1)
+!        BET1     = DT*RDZT1*SPD1(I)/T1(I,1)
+         BETA(I)  = DT*RDZT1/T1(I,1)
+!        BETAW(I) = BET1*CD(I)
+!        BETAT(I) = BET1*CH(I)
+!        BETAQ(I) = DPHI(I)*BETAT(I)
+      ENDDO
+!
+      DO I=1,IM
+!        ZL1(i) = 0.-(T1(I,1)+TSEA(I))/2.*LOG(PRSL(I,1)/PRSI(I,1))*ROG
+!        USTAR(I) = SQRT(CD(I)*SPD1(I)**2)
+         USTAR(I) = SQRT(STRESS(I))
+      ENDDO
+!
+      DO I=1,IM
+         THESV(I)   = TSEA(I)*(1.+FV*MAX(QSS(I),QMIN))
+         THE1(I)    = THETA(I,1)
+         THE1V(I)   = THE1(I)*(1.+FV*MAX(Q1(I,1,1),QMIN))
+         THERMAL(I) = THE1V(I)
+!        DTHE1      = (THE1(I)-TSEA(I))
+!        DQ1        = (MAX(Q1(I,1,1),QMIN) - MAX(QSS(I),QMIN))
+!        HEAT(I)    = -CH(I)*SPD1(I)*DTHE1
+!        EVAP(I)    = -CH(I)*SPD1(I)*DQ1
+      ENDDO
+!
+!
+!     COMPUTE THE FIRST GUESS OF PBL HEIGHT
+!
+      DO I=1,IM
+         STABLE(I) = .FALSE.
+!        ZL(i,1) = ZL1(i)
+         RBUP(I) = RBSOIL(I)
+      ENDDO
+      DO K = 2, KMPBL
+        DO I = 1, IM
+          IF(.NOT.STABLE(I)) THEN
+             RBDN(I)   = RBUP(I)
+!            ZL(I,k)   = ZL(I,K-1) - (T1(i,k)+T1(i,K-1))/2 *
+!    &                   LOG(PRSL(I,K)/PRSL(I,K-1)) * ROG
+             THEKV(I)  = THETA(i,k)*(1.+FV*MAX(Q1(i,k,1),QMIN))
+             SPDK2 = MAX(RCL(i)*(U1(i,k)*U1(i,k)+V1(i,k)*V1(i,k)),RONE)
+             RBUP(I)   = (THEKV(I)-THE1V(I))*(G*ZL(I,k)/THE1V(I))/SPDK2
+             KPBL(I)   = K
+             STABLE(I) = RBUP(I).GT.RBCR
+          ENDIF
+        ENDDO
+      ENDDO
+!
+      DO I = 1,IM
+         K = KPBL(I)
+         IF(RBDN(I).GE.RBCR) THEN
+            RBINT = 0.
+         ELSEIF(RBUP(I).LE.RBCR) THEN
+            RBINT = 1.
+         ELSE
+            RBINT = (RBCR-RBDN(I))/(RBUP(I)-RBDN(I))
+         ENDIF
+         HPBL(I) = ZL(I,K-1) + RBINT*(ZL(I,K)-ZL(I,K-1))
+         IF(HPBL(I).LT.ZI(I,KPBL(I))) KPBL(I) = KPBL(I) - 1
+      ENDDO
+!!
+      DO I=1,IM
+           HOL = MAX(RBSOIL(I)*FM(I)*FM(I)/FH(I),RIMIN)
+           IF(SFCFLG(I)) THEN
+              HOL = MIN(HOL,-ZFMIN)
+           ELSE
+              HOL = MAX(HOL,ZFMIN)
+           ENDIF
+!
+!          HOL = HOL*HPBL(I)/ZL1(I)*SFCFRAC
+           HOL = HOL*HPBL(I)/ZL(I,1)*SFCFRAC
+           IF(SFCFLG(I)) THEN
+!             PHIM = (1.-APHI16*HOL)**(-1./4.)
+!             PHIH = (1.-APHI16*HOL)**(-1./2.)
+              TEM  = 1.0 / (1. - APHI16*HOL)
+              PHIH(I) = SQRT(TEM)
+              PHIM(I) = SQRT(PHIH(I))
+           ELSE
+              PHIM(I) = (1.+APHI5*HOL)
+              PHIH(I) = PHIM(I)
+           ENDIF
+           WSCALE(I) = USTAR(I)/PHIM(I)
+           WSCALE(I) = MIN(WSCALE(I),USTAR(I)*APHI16)
+           WSCALE(I) = MAX(WSCALE(I),USTAR(I)/APHI5)
+      ENDDO
+!
+!     COMPUTE THE SURFACE VARIABLES FOR PBL HEIGHT ESTIMATION
+!     UNDER UNSTABLE CONDITIONS
+!
+      DO I = 1,IM
+         SFLUX  = HEAT(I) + EVAP(I)*FV*THE1(I)
+         IF(SFCFLG(I).AND.SFLUX.GT.0.0) THEN
+           HGAMT(I)   = MIN(CFAC*HEAT(I)/WSCALE(I),GAMCRT)
+           HGAMQ(I)   = MIN(CFAC*EVAP(I)/WSCALE(I),GAMCRQ)
+           VPERT      = HGAMT(I) + FV*THE1(I)*HGAMQ(I)
+           VPERT      = MIN(VPERT,GAMCRT)
+           THERMAL(I) = THERMAL(I) + MAX(VPERT,RZERO)
+           HGAMT(I)   = MAX(HGAMT(I),RZERO)
+           HGAMQ(I)   = MAX(HGAMQ(I),RZERO)
+         ELSE
+           PBLFLG(I) = .FALSE.
+         ENDIF
+      ENDDO
+!
+      DO I = 1,IM
+         IF(PBLFLG(I)) THEN
+            KPBL(I) = 1
+            HPBL(I) = ZI(I,2)
+         ENDIF
+      ENDDO
+!
+!     ENHANCE THE PBL HEIGHT BY CONSIDERING THE THERMAL
+!
+      DO I = 1, IM
+         IF(PBLFLG(I)) THEN
+            STABLE(I) = .FALSE.
+            RBUP(I) = RBSOIL(I)
+         ENDIF
+      ENDDO
+      DO K = 2, KMPBL
+        DO I = 1, IM
+          IF(.NOT.STABLE(I).AND.PBLFLG(I)) THEN
+            RBDN(I)   = RBUP(I)
+!           ZL(I,k)   = ZL(I,K-1) - (T1(i,k)+T1(i,K-1))/2 *
+!    &                  LOG(PRSL(I,K)/PRSL(I,K-1)) * ROG
+            THEKV(I)  = THETA(i,k)*(1.+FV*MAX(Q1(i,k,1),QMIN))
+            SPDK2   = MAX(RCL(i)*(U1(i,k)*U1(i,k)+V1(i,k)*V1(i,k)),RONE)
+            RBUP(I)   = (THEKV(I)-THERMAL(I))*(G*ZL(I,k)/THE1V(I))/SPDK2
+            KPBL(I)   = K
+            STABLE(I) = RBUP(I).GT.RBCR
+          ENDIF
+        ENDDO
+      ENDDO
+!
+      DO I = 1,IM
+         IF(PBLFLG(I)) THEN
+            K = KPBL(I)
+            IF(RBDN(I).GE.RBCR) THEN
+               RBINT = 0.
+            ELSEIF(RBUP(I).LE.RBCR) THEN
+               RBINT = 1.
+            ELSE
+               RBINT = (RBCR-RBDN(I))/(RBUP(I)-RBDN(I))
+            ENDIF
+            HPBL(I) = ZL(I,K-1) + RBINT*(ZL(I,k)-ZL(I,K-1))
+            IF(HPBL(I).LT.ZI(I,KPBL(I))) KPBL(I) = KPBL(I) - 1
+            IF(KPBL(I).LE.1) PBLFLG(I) = .FALSE.
+         ENDIF
+      ENDDO
+!!
+!
+!     COMPUTE DIFFUSION COEFFICIENTS BELOW PBL
+!
+      DO K = 1, KMPBL
+         DO I=1,IM
+            IF(KPBL(I).GT.K) THEN
+               PRINV = 1.0 / (PHIH(I)/PHIM(I)+CFAC*VK*.1)
+               PRINV = MIN(PRINV,PRMAX)
+               PRINV = MAX(PRINV,PRMIN)
+!              ZFAC = MAX((1.-(ZI(I,K+1)-ZL1(I))/                       &
+!    &                (HPBL(I)-ZL1(I))), ZFMIN)
+               ZFAC = MAX((1.-(ZI(I,K+1)-ZL(I,1))/                      &
+     &                (HPBL(I)-ZL(I,1))), ZFMIN)
+               DKU(i,k) = XKZO + WSCALE(I)*VK*ZI(I,K+1)                 &
+     &                         * ZFAC**PFAC
+               DKT(i,k) = DKU(i,k)*PRINV
+               DKO(i,k) = (DKU(i,k)-XKZO)*PRINV
+               DKU(i,k) = MIN(DKU(i,k),DKMAX)
+               DKU(i,k) = MAX(DKU(i,k),DKMIN)
+               DKT(i,k) = MIN(DKT(i,k),DKMAX)
+               DKT(i,k) = MAX(DKT(i,k),DKMIN)
+               DKO(i,k) = MAX(RZERO, MIN(DKMAX, DKO(i,k)))
+            ENDIF
+         ENDDO
+      ENDDO
+!
+!     COMPUTE DIFFUSION COEFFICIENTS OVER PBL (FREE ATMOSPHERE)
+!
+      DO K = 1, KM-1
+         DO I=1,IM
+            IF(K.GE.KPBL(I)) THEN
+!              TI   = 0.5*(T1(i,k)+T1(i,K+1))
+               TI   = 2.0 / (T1(i,k)+T1(i,K+1))
+!              RDZ  = RDZT(I,K)/TI
+               RDZ  = RDZT(I,K) * TI
+!              RDZ  = RDZT(I,K)
+               DW2  = RCL(i)*((U1(i,k)-U1(i,K+1))**2                    &
+     &                      + (V1(i,k)-V1(i,K+1))**2)
+               SHR2 = MAX(DW2,DW2MIN)*RDZ**2
+               TVD  = T1(i,k)*(1.+FV*MAX(Q1(i,k,1),QMIN))
+               TVU  = T1(i,K+1)*(1.+FV*MAX(Q1(i,K+1,1),QMIN))
+!              BVF2 = G*(GOCP+RDZ*(TVU-TVD))/TI
+               BVF2 = G*(GOCP+RDZ*(TVU-TVD)) * TI
+               RI   = MAX(BVF2/SHR2,RIMIN)
+               ZK   = VK*ZI(I,K+1)
+!              RL2  = (ZK*RLAM/(RLAM+ZK))**2
+!              DK   = RL2*SQRT(SHR2)
+               RL2  = ZK*RLAM/(RLAM+ZK)
+               DK   = RL2*RL2*SQRT(SHR2)
+               IF(RI.LT.0.) THEN ! UNSTABLE REGIME
+                  SRI = SQRT(-RI)
+                  DKU(i,k) = XKZO + DK*(1+8.*(-RI)/(1+1.746*SRI))
+!                 DKT(i,k) = XKZO + DK*(1+8.*(-RI)/(1+1.286*SRI))
+                  tem      =        DK*(1+8.*(-RI)/(1+1.286*SRI))
+                  DKT(i,k) = XKZO + tem
+                  DKO(i,k) =        tem
+               ELSE             ! STABLE REGIME
+!                 DKT(i,k)  = XKZO + DK/(1+5.*RI)**2
+                  tem       =        DK/(1+5.*RI)**2
+                  DKT(i,k)  = XKZO + tem
+                  DKO(i,k)  =        tem
+                  PRNUM     = 1.0 + 2.1*RI
+                  PRNUM     = MIN(PRNUM,PRMAX)
+                  DKU(i,k)  = (DKT(i,k)-XKZO)*PRNUM + XKZO
+               ENDIF
+!
+               DKU(i,k) = MIN(DKU(i,k),DKMAX)
+               DKU(i,k) = MAX(DKU(i,k),DKMIN)
+               DKT(i,k) = MIN(DKT(i,k),DKMAX)
+               DKT(i,k) = MAX(DKT(i,k),DKMIN)
+               DKO(i,k) = MAX(RZERO, MIN(DKMAX, DKO(i,k)))
+!
+!!!   IF(I.EQ.LOND.AND.LAT.EQ.LATD) THEN
+!!!   PRNUM = DKU(k)/DKT(k)
+!!!   WRITE(IUN,610) K,PRNUM,DKT(k),DKU(k),RL2,RI,
+!!!   1              BVF2,SHR2
+!!!   ENDIF
+!
+            ENDIF
+         ENDDO
+      ENDDO
+!
+!     COMPUTE TRIDIAGONAL MATRIX ELEMENTS FOR HEAT AND MOISTURE
+!
+      DO I=1,IM
+         AD(I,1) = 1.
+         A1(I,1) = T1(i,1)   + BETA(i) * HEAT(I)
+         A2(I,1) = Q1(i,1,1) + BETA(i) * EVAP(I)
+!        A1(I,1) = T1(i,1)-BETAT(I)*(THETA(i,1)-TSEA(I))
+!        A2(I,1) = Q1(i,1,1)-BETAQ(I)*
+!    &           (MAX(Q1(i,1,1),QMIN)-MAX(QSS(I),QMIN))
+      ENDDO
+!
+      DO K = 1,KM-1
+        DO I = 1,IM
+          DTODSD = DT/DEL(I,K)
+          DTODSU = DT/DEL(I,K+1)
+          DSIG   = PRSL(I,K)-PRSL(I,K+1)
+          RDZ    = RDZT(I,K)*2./(T1(i,k)+T1(i,K+1))
+!         RDZ    = RDZT(I,K)
+          tem1   = DSIG * DKT(i,k) * RDZ
+          IF(PBLFLG(I).AND.K.LT.KPBL(I)) THEN
+!            DSDZT = DSIG*DKT(i,k)*RDZ*(GOCP-HGAMT(I)/HPBL(I))
+!            DSDZQ = DSIG*DKT(i,k)*RDZ*(-HGAMQ(I)/HPBL(I))
+             tem   = 1.0 / HPBL(I)
+             DSDZT = tem1 * (GOCP-HGAMT(I)*tem)
+             DSDZQ = tem1 * (-HGAMQ(I)*tem)
+             A2(I,k)   = A2(I,k)+DTODSD*DSDZQ
+             A2(I,k+1) = Q1(i,k+1,1)-DTODSU*DSDZQ
+          ELSE
+!            DSDZT = DSIG*DKT(i,k)*RDZ*(GOCP)
+             DSDZT = tem1 * GOCP
+             A2(I,k+1) = Q1(i,k+1,1)
+          ENDIF
+!         DSDZ2 = DSIG*DKT(i,k)*RDZ*RDZ
+          DSDZ2     = tem1 * RDZ
+          AU(I,k)   = -DTODSD*DSDZ2
+          AL(I,k)   = -DTODSU*DSDZ2
+          AD(I,k)   = AD(I,k)-AU(I,k)
+          AD(I,k+1) = 1.-AL(I,k)
+          A1(I,k)   = A1(I,k)+DTODSD*DSDZT
+          A1(I,k+1) = T1(i,k+1)-DTODSU*DSDZT
+        ENDDO
+      ENDDO
+!
+!     SOLVE TRIDIAGONAL PROBLEM FOR HEAT AND MOISTURE
+!
+      CALL TRIDIN(IM,KM,1,AL,AD,AU,A1,A2,AU,A1,A2)
+!
+!     RECOVER TENDENCIES OF HEAT AND MOISTURE
+!
+      DO  K = 1,KM
+         DO I = 1,IM
+            TTEND      = (A1(I,k)-T1(i,k))*RDT
+            QTEND      = (A2(I,k)-Q1(i,k,1))*RDT
+            TAU(i,k)   = TAU(i,k)+TTEND
+            RTG(I,k,1) = RTG(i,k,1)+QTEND
+            DTSFC(I)   = DTSFC(I)+CONT*DEL(I,K)*TTEND
+            DQSFC(I)   = DQSFC(I)+CONQ*DEL(I,K)*QTEND
+         ENDDO
+      ENDDO
+!
+!     COMPUTE TRIDIAGONAL MATRIX ELEMENTS FOR MOMENTUM
+!
+      DO I=1,IM
+!        AD(I,1) = 1.+BETAW(I)
+         AD(I,1) = 1.0 + BETA(i) * STRESS(I) / SPD1(I)
+         A1(I,1) = U1(i,1)
+         A2(I,1) = V1(i,1)
+!        AD(I,1) = 1.0
+!        tem     = 1.0 + BETA(I) * STRESS(I) / SPD1(I)
+!        A1(I,1) = U1(i,1) * tem
+!        A2(I,1) = V1(i,1) * tem
+      ENDDO
+!
+      DO K = 1,KM-1
+        DO I=1,IM
+          DTODSD    = DT/DEL(I,K)
+          DTODSU    = DT/DEL(I,K+1)
+          DSIG      = PRSL(I,K)-PRSL(I,K+1)
+          RDZ       = RDZT(I,K)*2./(T1(i,k)+T1(i,k+1))
+!         RDZ       = RDZT(I,K)
+          DSDZ2     = DSIG*DKU(i,k)*RDZ*RDZ
+          AU(I,k)   = -DTODSD*DSDZ2
+          AL(I,k)   = -DTODSU*DSDZ2
+          AD(I,k)   = AD(I,k)-AU(I,k)
+          AD(I,k+1) = 1.-AL(I,k)
+          A1(I,k+1) = U1(i,k+1)
+          A2(I,k+1) = V1(i,k+1)
+        ENDDO
+      ENDDO
+!
+!     SOLVE TRIDIAGONAL PROBLEM FOR MOMENTUM
+!
+      CALL TRIDI2(IM,KM,AL,AD,AU,A1,A2,AU,A1,A2)
+!
+!     RECOVER TENDENCIES OF MOMENTUM
+!
+      DO K = 1,KM
+         DO I = 1,IM
+            CONWRC = CONW*SQRT(RCL(i))
+            UTEND = (A1(I,k)-U1(i,k))*RDT
+            VTEND = (A2(I,k)-V1(i,k))*RDT
+            DU(i,k)  = DU(i,k)+UTEND
+            DV(i,k)  = DV(i,k)+VTEND
+            DUSFC(I) = DUSFC(I)+CONWRC*DEL(I,K)*UTEND
+            DVSFC(I) = DVSFC(I)+CONWRC*DEL(I,K)*VTEND
+         ENDDO
+      ENDDO
+!!
+!
+!     COMPUTE TRIDIAGONAL MATRIX ELEMENTS FOR TRACERS
+!
+      if (ntrac .ge. 2) then
+        DO I=1,IM
+         AD(I,1) = 1.
+        ENDDO
+        do k = 2, ntrac
+          is = (k-2) * km
+          do i = 1, im
+            AT(I,1+is) = Q1(i,1,k)
+          enddo
+        enddo
+!
+        DO K = 1,KM-1
+          DO I = 1,IM
+            DTODSD = DT/DEL(I,K)
+            DTODSU = DT/DEL(I,K+1)
+            DSIG   = PRSL(I,K)-PRSL(I,K+1)
+            RDZ    = RDZT(I,K)*2./(T1(i,k)+T1(i,K+1))
+            tem1   = DSIG * DKT(i,k) * RDZ
+            DSDZ2     = tem1 * RDZ
+            AU(I,k)   = -DTODSD*DSDZ2
+            AL(I,k)   = -DTODSU*DSDZ2
+            AD(I,k)   = AD(I,k)-AU(I,k)
+            AD(I,k+1) = 1.-AL(I,k)
+          ENDDO
+        ENDDO
+        do kk = 2, ntrac
+          is = (kk-2) * km
+          do k = 1, km - 1
+            do i = 1, im
+              AT(I,k+1+is) = Q1(i,k+1,kk)
+            enddo
+          enddo
+        enddo
+!
+!     SOLVE TRIDIAGONAL PROBLEM FOR TRACERS
+!
+        CALL TRIDIT(IM,KM,ntrac-1,AL,AD,AU,AT,AU,AT)
+!
+!     RECOVER TENDENCIES OF TRACERS
+!
+        do kk = 2, ntrac
+          is = (kk-2) * km
+          do k = 1, km 
+            do i = 1, im
+              QTEND = (AT(I,K+is)-Q1(i,K,kk))*RDT
+              RTG(i,K,kk) = RTG(i,K,kk) + QTEND
+            enddo
+          enddo
+        enddo
+      endif
+!!
+      RETURN
+      END SUBROUTINE MONINP
+!FPP$ NOCONCUR R
+!-----------------------------------------------------------------------
+      SUBROUTINE TRIDI2(L,N,CL,CM,CU,R1,R2,AU,A1,A2)
+!sela %INCLUDE DBTRIDI2;
+!
+      USE MODULE_GFS_MACHINE     , ONLY : kind_phys
+      implicit none
+      integer             k,n,l,i
+      real(kind=kind_phys) fk
+!
+      real(kind=kind_phys) CL(L,2:N),CM(L,N),CU(L,N-1),R1(L,N),R2(L,N), &
+     &          AU(L,N-1),A1(L,N),A2(L,N)
+!-----------------------------------------------------------------------
+      DO I=1,L
+        FK      = 1./CM(I,1)
+        AU(I,1) = FK*CU(I,1)
+        A1(I,1) = FK*R1(I,1)
+        A2(I,1) = FK*R2(I,1)
+      ENDDO
+      DO K=2,N-1
+        DO I=1,L
+          FK      = 1./(CM(I,K)-CL(I,K)*AU(I,K-1))
+          AU(I,K) = FK*CU(I,K)
+          A1(I,K) = FK*(R1(I,K)-CL(I,K)*A1(I,K-1))
+          A2(I,K) = FK*(R2(I,K)-CL(I,K)*A2(I,K-1))
+        ENDDO
+      ENDDO
+      DO I=1,L
+        FK      = 1./(CM(I,N)-CL(I,N)*AU(I,N-1))
+        A1(I,N) = FK*(R1(I,N)-CL(I,N)*A1(I,N-1))
+        A2(I,N) = FK*(R2(I,N)-CL(I,N)*A2(I,N-1))
+      ENDDO
+      DO K=N-1,1,-1
+        DO I=1,L
+          A1(I,K) = A1(I,K)-AU(I,K)*A1(I,K+1)
+          A2(I,K) = A2(I,K)-AU(I,K)*A2(I,K+1)
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      RETURN
+      END SUBROUTINE TRIDI2
+!FPP$ NOCONCUR R
+!-----------------------------------------------------------------------
+      SUBROUTINE TRIDIN(L,N,nt,CL,CM,CU,R1,R2,AU,A1,A2)
+!sela %INCLUDE DBTRIDI2;
+!
+      USE MODULE_GFS_MACHINE     , ONLY : kind_phys
+      implicit none
+      integer             is,k,kk,n,nt,l,i
+      real(kind=kind_phys) fk(L)
+!
+      real(kind=kind_phys) CL(L,2:N), CM(L,N), CU(L,N-1),               &
+     &                     R1(L,N),   R2(L,N*nt),                       &
+     &                     AU(L,N-1), A1(L,N), A2(L,N*nt),              &
+     &                     FKK(L,2:N-1)
+!-----------------------------------------------------------------------
+      DO I=1,L
+        FK(I)   = 1./CM(I,1)
+        AU(I,1) = FK(I)*CU(I,1)
+        A1(I,1) = FK(I)*R1(I,1)
+      ENDDO
+      do k = 1, nt
+        is = (k-1) * n
+        do i = 1, l
+          a2(i,1+is) = fk(I) * r2(i,1+is)
+        enddo
+      enddo
+      DO K=2,N-1
+        DO I=1,L
+          FKK(I,K) = 1./(CM(I,K)-CL(I,K)*AU(I,K-1))
+          AU(I,K)  = FKK(I,K)*CU(I,K)
+          A1(I,K)  = FKK(I,K)*(R1(I,K)-CL(I,K)*A1(I,K-1))
+        ENDDO
+      ENDDO
+      do kk = 1, nt
+        is = (kk-1) * n
+        DO K=2,N-1
+          DO I=1,L
+            A2(I,K+is) = FKK(I,K)*(R2(I,K+is)-CL(I,K)*A2(I,K+is-1))
+          ENDDO
+        ENDDO
+      ENDDO
+      DO I=1,L
+        FK(I)   = 1./(CM(I,N)-CL(I,N)*AU(I,N-1))
+        A1(I,N) = FK(I)*(R1(I,N)-CL(I,N)*A1(I,N-1))
+      ENDDO
+      do k = 1, nt
+        is = (k-1) * n
+        do i = 1, l
+          A2(I,N+is) = FK(I)*(R2(I,N+is)-CL(I,N)*A2(I,N+is-1))
+        enddo
+      enddo
+      DO K=N-1,1,-1
+        DO I=1,L
+          A1(I,K) = A1(I,K) - AU(I,K)*A1(I,K+1)
+        ENDDO
+      ENDDO
+      do kk = 1, nt
+        is = (kk-1) * n
+        DO K=n-1,1,-1
+          DO I=1,L
+            A2(I,K+is) = A2(I,K+is) - AU(I,K)*A2(I,K+is+1)
+          ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      RETURN
+      END SUBROUTINE TRIDIN
+      SUBROUTINE TRIDIT(L,N,nt,CL,CM,CU,RT,AU,AT)
+!sela %INCLUDE DBTRIDI2;
+!
+      USE MODULE_GFS_MACHINE     , ONLY : kind_phys
+      implicit none
+      integer             is,k,kk,n,nt,l,i
+      real(kind=kind_phys) fk(L)
+!
+      real(kind=kind_phys) CL(L,2:N), CM(L,N), CU(L,N-1),               &
+     &                     RT(L,N*nt),                                  &
+     &                     AU(L,N-1), AT(L,N*nt),                       &
+     &                     FKK(L,2:N-1)                  
+!-----------------------------------------------------------------------
+      DO I=1,L
+        FK(I)   = 1./CM(I,1)
+        AU(I,1) = FK(I)*CU(I,1)
+      ENDDO
+      do k = 1, nt
+        is = (k-1) * n
+        do i = 1, l
+          at(i,1+is) = fk(I) * rt(i,1+is)
+        enddo
+      enddo
+      DO K=2,N-1
+        DO I=1,L
+          FKK(I,K) = 1./(CM(I,K)-CL(I,K)*AU(I,K-1))
+          AU(I,K)  = FKK(I,K)*CU(I,K)
+        ENDDO
+      ENDDO
+      do kk = 1, nt
+        is = (kk-1) * n
+        DO K=2,N-1
+          DO I=1,L
+            AT(I,K+is) = FKK(I,K)*(RT(I,K+is)-CL(I,K)*AT(I,K+is-1))
+          ENDDO
+        ENDDO
+      ENDDO
+      DO I=1,L
+        FK(I)   = 1./(CM(I,N)-CL(I,N)*AU(I,N-1))
+      ENDDO
+      do k = 1, nt
+        is = (k-1) * n
+        do i = 1, l
+          AT(I,N+is) = FK(I)*(RT(I,N+is)-CL(I,N)*AT(I,N+is-1))
+        enddo
+      enddo
+      do kk = 1, nt
+        is = (kk-1) * n
+        DO K=n-1,1,-1
+          DO I=1,L
+            AT(I,K+is) = AT(I,K+is) - AU(I,K)*AT(I,K+is+1)
+          ENDDO
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      RETURN
+      END SUBROUTINE TRIDIT
+                                                                                 
+!-----------------------------------------------------------------------
+
+      END MODULE module_bl_gfs
Index: trunk/WRF.COMMON/WRFV2/phys/module_bl_mrf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_bl_mrf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_bl_mrf.F	(revision 2744)
@@ -0,0 +1,1400 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+MODULE module_bl_mrf
+
+CONTAINS
+
+!-------------------------------------------------------------------          
+   SUBROUTINE MRF(U3D,V3D,TH3D,T3D,QV3D,QC3D,P3D,PI3D,             &
+                  RUBLTEN,RVBLTEN,RTHBLTEN,                        &
+                  RQVBLTEN,RQCBLTEN,                               &
+                  CP,G,ROVCP,R,ROVG,                               &
+                  dz8w,z,XLV,RV,PSFC,                              &
+                  ZNT,UST,ZOL,HOL,PBL,PSIM,PSIH,                   &
+                  XLAND,HFX,QFX,TSK,GZ1OZ0,WSPD,BR,                &
+                  DT,DTMIN,KPBL2D,                                 &
+                  SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT,&
+                  flag_qi,                                         &
+                  ids,ide, jds,jde, kds,kde,                       &
+                  ims,ime, jms,jme, kms,kme,                       &
+                  its,ite, jts,jte, kts,kte,                       &
+               ! Optional
+                  QI3D,RQIBLTEN,                                   & 
+                  regime                                           )
+!-------------------------------------------------------------------
+      IMPLICIT NONE
+!-------------------------------------------------------------------
+!-- U3D         3D u-velocity interpolated to theta points (m/s)
+!-- V3D         3D v-velocity interpolated to theta points (m/s)
+!-- TH3D        3D potential temperature (K)
+!-- T3D         temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!-- QC3D        3D cloud mixing ratio (Kg/Kg)
+!-- QI3D        3D ice mixing ratio (Kg/Kg)
+!-- P3D         3D pressure (Pa)
+!-- PI3D        3D exner function (dimensionless)
+!-- rr3D        3D dry air density (kg/m^3)
+!-- RUBLTEN     U tendency due to
+!               PBL parameterization (m/s^2)
+!-- RVBLTEN     V tendency due to
+!               PBL parameterization (m/s^2)
+!-- RTHBLTEN    Theta tendency due to
+!               PBL parameterization (K/s)
+!-- RQVBLTEN    Qv tendency due to
+!               PBL parameterization (kg/kg/s)
+!-- RQCBLTEN    Qc tendency due to
+!               PBL parameterization (kg/kg/s)
+!-- RQIBLTEN    Qi tendency due to
+!               PBL parameterization (kg/kg/s)
+!-- CP          heat capacity at constant pressure for dry air (J/kg/K)
+!-- G           acceleration due to gravity (m/s^2)
+!-- ROVCP       R/CP
+!-- R           gas constant for dry air (J/kg/K)
+!-- ROVG        R/G
+!-- dz8w        dz between full levels (m)
+!-- z           height above sea level (m)
+!-- XLV         latent heat of vaporization (J/kg)
+!-- RV          gas constant for water vapor (J/kg/K)
+!-- PSFC        pressure at the surface (Pa)
+!-- ZNT         roughness length (m)
+!-- UST         u* in similarity theory (m/s)
+!-- ZOL         z/L height over Monin-Obukhov length
+!-- HOL         PBL height over Monin-Obukhov length
+!-- PBL         PBL height (m)
+!-- REGIME      flag indicating PBL regime (stable, unstable, etc.)
+!-- PSIM        similarity stability function for momentum
+!-- PSIH        similarity stability function for heat
+!-- XLAND       land mask (1 for land, 2 for water)
+!-- HFX         upward heat flux at the surface (W/m^2)
+!-- QFX         upward moisture flux at the surface (kg/m^2/s)
+!-- TSK         surface temperature (K)
+!-- GZ1OZ0      log(z/z0) where z0 is roughness length
+!-- WSPD        wind speed at lowest model level (m/s)
+!-- BR          bulk Richardson number in surface layer
+!-- DT          time step (s)
+!-- DTMIN       time step (minute)
+!-- rvovrd      R_v divided by R_d (dimensionless)
+!-- SVP1        constant for saturation vapor pressure (kPa)
+!-- SVP2        constant for saturation vapor pressure (dimensionless)
+!-- SVP3        constant for saturation vapor pressure (K)
+!-- SVPT0       constant for saturation vapor pressure (K)
+!-- EP1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
+!-- EP2         constant for specific humidity calculation
+!-- KARMAN      Von Karman constant
+!-- EOMEG       angular velocity of earth's rotation (rad/s)
+!-- STBOLT      Stefan-Boltzmann constant (W/m^2/K^4)
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!-------------------------------------------------------------------
+
+      INTEGER,  INTENT(IN   )   ::      ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+
+!
+      REAL,     INTENT(IN   )   ::      DT,DTMIN,CP,G,ROVCP,       &
+                                        ROVG,R,XLV,RV             
+
+      REAL,     INTENT(IN )     ::     SVP1,SVP2,SVP3,SVPT0 
+      REAL,     INTENT(IN )     ::     EP1,EP2,KARMAN,EOMEG,STBOLT
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
+                INTENT(IN   )   ::                           QV3D, &
+                                                             QC3D, &
+                                                              P3D, &
+                                                             PI3D, &
+                                                             TH3D, &
+                                                              T3D, &
+                                                             dz8w, &
+                                                                z   
+!
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
+                INTENT(INOUT)   ::                        RUBLTEN, &
+                                                          RVBLTEN, &
+                                                         RTHBLTEN, &
+                                                         RQVBLTEN, &
+                                                         RQCBLTEN
+
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(IN   )   ::                          XLAND, &
+                                                              HFX, &
+                                                              QFX
+ 
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(INOUT)   ::                            HOL, &
+                                                              UST, &
+                                                              PBL, &
+                                                              ZNT
+
+      LOGICAL,  INTENT(IN)      ::                        FLAG_QI
+!
+!m The following 5 variables are changed to memory size from tile size--
+!
+     REAL,     DIMENSION( ims:ime, jms:jme ), INTENT(IN   )  ::    &
+                                                             PSIM, &
+                                                             PSIH
+
+     REAL,     DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)   ::   &
+                                                             WSPD
+
+     REAL,     DIMENSION( ims:ime, jms:jme ), INTENT(IN   )   ::   &
+                                                           GZ1OZ0, &
+                                                               BR
+
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(IN   )               ::               PSFC
+
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(IN   )   ::                            TSK
+
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(INOUT)   ::                            ZOL
+                                                                      
+      INTEGER,  DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(OUT  )   ::                         KPBL2D 
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
+                INTENT(IN   )   ::                            U3D, &
+                                                              V3D
+!
+! Optional
+!
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                OPTIONAL                                         , &
+                INTENT(INOUT)   ::                         REGIME
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
+                INTENT(INOUT)   ::                       RQIBLTEN
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
+                OPTIONAL                                         , &
+                INTENT(IN   )   ::                           QI3D
+
+! LOCAL VARS
+   REAL,       DIMENSION( its:ite, kts:kte )          ::   dz8w2d, & 
+                                                              z2d
+                                                           
+
+   INTEGER ::  I,J,K,NK
+
+!
+   DO J=jts,jte
+      DO k=kts,kte
+      NK=kme-k
+      DO i=its,ite
+         dz8w2d(I,K) = dz8w(i,NK,j)
+         z2d(I,K) = z(i,NK,j)
+      ENDDO
+      ENDDO
+
+
+      CALL MRF2D(J,U3D(ims,kms,j),V3D(ims,kms,j),T3D(ims,kms,j),    &
+               QV3D(ims,kms,j),QC3D(ims,kms,j),                     &
+               P3D(ims,kms,j),RUBLTEN(ims,kms,j),RVBLTEN(ims,kms,j),&
+               RTHBLTEN(ims,kms,j),RQVBLTEN(ims,kms,j),             &
+               RQCBLTEN(ims,kms,j),                                 &
+               CP,G,ROVCP,R,ROVG,                                   &
+               dz8w2d,z2d,XLV,Rv,                                   &
+               PSFC(ims,j),ZNT(ims,j),                              &
+               UST(ims,j),ZOL(ims,j),                               &
+               HOL(ims,j),PBL(ims,j),PSIM(ims,j),                   &
+               PSIH(ims,j),XLAND(ims,j),HFX(ims,j),QFX(ims,j),      &
+               TSK(ims,j),GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),      &
+               DT,DTMIN,KPBL2D(ims,j),                              &
+               SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT,    &
+               flag_qi,                                             &
+               ids,ide, jds,jde, kds,kde,                           &
+               ims,ime, jms,jme, kms,kme,                           &
+               its,ite, jts,jte, kts,kte,                           &
+            !optional
+               QI2DTEN=RQIBLTEN(ims,kms,j),                         &
+               REGIME=REGIME(ims,j),QI2D=QI3D(ims,kms,j)            )
+
+
+      DO k=kts,kte
+      DO i=its,ite
+         RTHBLTEN(I,K,J)=RTHBLTEN(I,K,J)/PI3D(I,K,J)
+      ENDDO
+      ENDDO
+
+    ENDDO
+
+   END SUBROUTINE MRF
+
+!-------------------------------------------------------------------          
+   SUBROUTINE MRF2D(J,U2D,V2D,T2D,QV2D,QC2D,     P2D,              &
+                  U2DTEN,V2DTEN,T2DTEN,                            &
+                  QV2DTEN,QC2DTEN,                                 & 
+                  CP,G,ROVCP,R,ROVG,                               &
+                  dz8w2d,z2d,XLV,RV,PSFCPA,                        &
+                  ZNT,UST,ZOL,HOL,PBL,PSIM,PSIH,                   &
+                  XLAND,HFX,QFX,TSK,GZ1OZ0,WSPD,BR,                &
+                  DT,DTMIN,KPBL1D,                                 &
+                  SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT,&
+                  flag_qi,                                         &
+                  ids,ide, jds,jde, kds,kde,                       &
+                  ims,ime, jms,jme, kms,kme,                       &
+                  its,ite, jts,jte, kts,kte,                       &
+               ! optional
+                  regime, qi2d, QI2DTEN                            )
+!-------------------------------------------------------------------
+      IMPLICIT NONE
+!-------------------------------------------------------------------
+!     BASED ON THE "COUNTERGRADIENT" TRANSPORT TERM OF TROEN                     
+!     AND MAHRT (1986) FOR THE UNSTABLE PBL.                                     
+!     THIS ROUTINE USES AN IMPLICIT APPROACH FOR VERTICAL FLUX                   
+!     DIVERGENCE AND DOES NOT REQUIRE "MITER" TIMESTEPS.                         
+!     IT INCLUDES VERTICAL DIFFUSION IN THE STABLE ATMOSPHERE                    
+!     AND MOIST VERTICAL DIFFUSION IN CLOUDS.                                    
+!     SURFACE FLUXES CALCULATED AS IN HIRPBL.                                    
+!     5-LAYER SOIL MODEL OPTION REQUIRED IN SLAB DUE TO LONG TIMESTEP            
+!                                                                                
+!     CODED BY SONG-YOU HONG (NCEP), IMPLEMENTED BY JIMY DUDHIA (NCAR)           
+!     FALL 1996                                                                  
+!                                                                                
+!     REFERENCES:                                                                
+!                                                                                
+!        HONG AND PAN (1996), MON. WEA. REV.                                     
+!        TROEN AND MAHRT (1986), BOUNDARY LAYER MET.                             
+!                                                                                
+!     CHANGES:                                                                   
+!        INCREASE RLAM FROM 30 TO 150, AND CHANGE FREE ATMOSPHERE                
+!        STABILITY FUNCTION TO INCREASE VERTICAL DIFFUSION                       
+!        (HONG, JUNE 1997)                                                       
+!                                                                                
+!        PUT LOWER LIMIT ON PSI FOR STABLE CONDITIONS. THIS WILL                 
+!        PREVENT FLUXES FROM BECOMING TOO SMALL (DUDHIA, OCTOBER 1997)           
+!                                                                                
+!        CORRECTION TO REGIME CALCULATION. THIS WILL ALLOW POINTS IN             
+!        REGIME 4 MUCH MORE FREQUENTLY GIVING LARGER SURFACE FLUXES              
+!        REGIME 3 NO LONGER USES HOL < 1.5 OR THVX LAPSE-RATE CHECK              
+!        IN MRF SCHEME. THIS WILL MAKE REGIME 3 MUCH LESS FREQUENT.              
+!                                                                                
+!        ADD SURFACE PRESSURE, PS(I), ARRAY FOR EFFICIENCY                       
+!                                                                                
+!        FIX FOR PROBLEM WITH THIN LAYERS AND HIGH ROUGHNESS                     
+!                                                                                
+!        CHARNOCK CONSTANT NOW COMES FROM NAMELIST (DEFAULT SAME)                
+!                                                                                
+!-------------------------------------------------------------------          
+
+      REAL      RLAM,PRMIN,PRMAX,XKZMIN,XKZMAX,RIMIN,BRCR,         &
+                CFAC,PFAC,SFCFRAC,CKZ,ZFMIN,APHI5,APHI16,GAMCRT,   &
+                GAMCRQ,XKA,PRT
+
+      PARAMETER (RLAM=150.,PRMIN=0.5,PRMAX=4.)                       
+      PARAMETER (XKZMIN=0.01,XKZMAX=1000.,RIMIN=-100.)                           
+      PARAMETER (BRCR=0.5,CFAC=7.8,PFAC=2.0,SFCFRAC=0.1)                         
+      PARAMETER (CKZ=0.001,ZFMIN=1.E-8,APHI5=5.,APHI16=16.)                      
+      PARAMETER (GAMCRT=3.,GAMCRQ=2.E-3)                                         
+      PARAMETER (XKA=2.4E-5)                                                     
+      PARAMETER (PRT=1.)                                                         
+!
+      INTEGER,  INTENT(IN   )   ::      ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte, &
+                                        J
+!
+      LOGICAL,  INTENT(IN)      ::                        FLAG_QI
+!
+      REAL,     INTENT(IN   )   ::      DT,DTMIN,CP,G,ROVCP,       &
+                                        ROVG,R,XLV,RV
+
+      REAL,     INTENT(IN )     ::     SVP1,SVP2,SVP3,SVPT0 
+      REAL,     INTENT(IN )     ::     EP1,EP2,KARMAN,EOMEG,STBOLT
+
+      REAL,     DIMENSION( ims:ime, kms:kme )                    , &
+                INTENT(IN   )   ::                           QV2D, &
+                                                             QC2D, &
+                                                              P2D, &
+                                                              T2D
+!
+      REAL,     DIMENSION( ims:ime, kms:kme )                    , &
+                INTENT(INOUT)   ::                         U2DTEN, &
+                                                           V2DTEN, &
+                                                           T2DTEN, &
+                                                          QV2DTEN, &
+                                                          QC2DTEN
+                                                                  
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(INOUT)   ::                            HOL, &
+                                                              UST, &
+                                                              PBL, &
+                                                              ZNT
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(IN   )   ::                          XLAND, &
+                                                              HFX, &
+                                                              QFX
+!
+!m The following 5 are changed to memory size---
+!
+     REAL,     DIMENSION( ims:ime ), INTENT(IN   )   ::      PSIM, &
+                                                             PSIH
+
+     REAL,     DIMENSION( ims:ime ), INTENT(INOUT)   ::      WSPD
+
+     REAL,     DIMENSION( ims:ime ), INTENT(IN   )   ::    GZ1OZ0, &
+                                                               BR
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(IN   )               ::             PSFCPA
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(IN   )   ::                            TSK
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(INOUT)   ::                            ZOL
+
+      INTEGER,  DIMENSION( ims:ime )                             , &
+                INTENT(OUT  )   ::                         KPBL1D
+
+      REAL,     DIMENSION( ims:ime, kms:kme )                    , &
+                INTENT(IN   )   ::                            U2D, &
+                                                              V2D
+                                                                      
+! MODULE-LOCAL VARIABLES (DEFINED IN SUBROUTINE MRF)
+!
+      REAL,     DIMENSION( its:ite, kts:kte ) ,                    &
+                INTENT(IN)      ::                         dz8w2d, &
+                                                              z2d
+!                                                                                
+! 
+! Optional
+!
+      REAL,     DIMENSION( ims:ime )                             , &
+                OPTIONAL                                         , &
+                INTENT(INOUT)   ::                         REGIME
+
+      REAL,     DIMENSION( ims:ime, kms:kme )                    , &
+                OPTIONAL                                         , &
+                INTENT(IN   )   ::                           QI2D
+
+      REAL,     DIMENSION( ims:ime, kms:kme )                    , &
+                OPTIONAL                                         , &
+                INTENT(INOUT)   ::                        QI2DTEN
+    
+! LOCAL VARS
+
+      REAL,     DIMENSION( its:ite, kts:kte+1 ) ::             ZQ
+
+      REAL,     DIMENSION( its:ite, kts:kte )   ::                 &
+                                                         UX,VX,QX, &
+                                                     QCX,THX,THVX, & 
+                                                          DZQ,DZA, & 
+                                                        TTNP,QTNP, &
+                                                         QCTNP,ZA, &
+                                                          UXS,VXS, &
+                                                         THXS,QXS, &
+                                                         QCXS,QIX, &
+                                                       QITNP,QIXS, &
+                                                        UTNP,VTNP
+!
+      REAL,    DIMENSION( its:ite )             ::     QIXSV,RHOX, &
+                                                     WSPD1,GOVRTH, & 
+                                                       PBL0,THXSV, &
+                                                        UXSV,VXSV, &             
+                                                       QXSV,QCXSV, & 
+                                                     QGH,TGDSA,PS
+
+      INTEGER                                   ::   ILXM,JLXM,KL, &
+                                                   KLM,KLP1,KLPBL
+!
+      INTEGER, DIMENSION( its:ite )             ::     KPBL,KPBL0
+!
+      REAL,    DIMENSION( its:ite, kts:kte )    ::      SCR3,SCR4
+!
+      REAL,    DIMENSION( its:ite )             ::           DUM1, &
+                                                           XKZMKL
+!
+      REAL,    DIMENSION( its:ite )             ::    ZL1,THERMAL, &
+                                                     WSCALE,HGAMT, &
+                                                       HGAMQ,BRDN, &
+                                                        BRUP,PHIM, &
+                                                         PHIH,CPM, &
+                                                      DUSFC,DVSFC, &
+                                                      DTSFC,DQSFC
+                
+!
+      REAL,    DIMENSION( its:ite, kts:kte )    ::      XKZM,XKZH, &
+                                                            A1,A2, &  
+                                                            AD,AU, &
+                                                               TX
+!
+      REAL,    DIMENSION( its:ite, kts:kte )  ::               AL
+!
+      LOGICAL, DIMENSION( its:ite )             ::         PBLFLG, &
+                                                           SFCFLG, &
+                                                           STABLE
+!                                                         
+      REAL, DIMENSION( its:ite )                ::           THGB
+
+      INTEGER ::  N,I,K,KK,L,NZOL,IMVDIF
+
+      INTEGER ::  JBGN,JEND,IBGN,IEND,NK
+
+      REAL    ::  ZOLN,X,Y,CONT,CONQ,CONW,PL,THCON,TVCON,E1,DTSTEP
+      REAL    ::  ZL,TSKV,DTHVDZ,DTHVM,VCONV,RZOL
+      REAL    ::  DTTHX,PSIX,DTG,PSIQ,USTM
+      REAL    ::  DT4,RDT,SPDK2,FM,FH,HOL1,GAMFAC,VPERT,PRNUM
+      REAL    ::  ZFAC,XKZO,SS,RI,QMEAN,TMEAN,ALPH,CHI,ZK,RL2,DK,SRI
+      REAL    ::  BRINT,DTODSD,DSIG,RDZ,DSDZT,DSDZQ,DSDZ2,TTEND,QTEND
+      REAL    ::  UTEND,VTEND,QCTEND,QITEND,TGC,DTODSU
+
+!----------------------------------------------------------------------
+
+      KLPBL=1
+      KL=kte
+      ILXM=ite-1
+      JLXM=jte-1
+      KLM=kte-1
+      KLP1=kte+1
+!                                                                                
+      CONT=1000.*CP/G                                                            
+      CONQ=1000.*XLV/G                                                           
+      CONW=1000./G                                                               
+
+!-- IMVDIF      imvdif=1 for moist adiabat vertical diffusion
+
+      IMVDIF=1
+
+!     DO i=its,ite
+!!PS PSFC cmb
+!        PSFC(I)=PSFCPA(I)/1000.
+!     ENDDO
+
+
+!                                                                                
+!----CONVERT GROUND TEMPERATURE TO POTENTIAL TEMPERATURE:                        
+!                                                                                
+      DO 5 I=its,ite                                                       
+        TGDSA(I)=TSK(I)                                                        
+! PS PSFC cmb
+        PS(I)=PSFCPA(I)/1000.
+        THGB(I)=TSK(I)*(100./PS(I))**ROVCP   
+    5 CONTINUE                                                                   
+!                                                                                
+!-----DECOUPLE FLUX-FORM VARIABLES TO GIVE U,V,T,THETA,THETA-VIR.,               
+!     T-VIR., QV, AND QC AT CROSS POINTS AND AT KTAU-1.                          
+!                                                                                
+!     *** NOTE ***                                                               
+!         THE BOUNDARY WINDS MAY NOT BE ADEQUATELY AFFECTED BY FRICTION,         
+!         SO USE ONLY INTERIOR VALUES OF UX AND VX TO CALCULATE                  
+!         TENDENCIES.                                                            
+!                                                                                
+      DO 24 K=kts,kte                                                      
+        NK=kme-K
+        DO 24 I=its,ite
+          UX(I,K)=U2D(I,NK)
+          VX(I,K)=V2D(I,NK)
+   24 CONTINUE                                                                 
+!                                                                                
+!.....SCR3(I,K) STORE TEMPERATURE,                                               
+!     SCR4(I,K) STORE VIRTUAL TEMPERATURE.                                       
+!                                                                                
+      DO 30 K=kts,kte
+        NK=kme-K
+        DO 30 I=its,ite
+! PL cmb
+          PL=P2D(I,NK)/1000.
+          SCR3(I,K)=T2D(I,NK)
+          THCON=(100./PL)**ROVCP                                                 
+          THX(I,K)=SCR3(I,K)*THCON                                               
+          TX(I,K)=SCR3(I,K)                                                      
+          SCR4(I,K)=SCR3(I,K)                                                    
+          THVX(I,K)=THX(I,K)                                                     
+          QX(I,K)=0.                                                             
+   30 CONTINUE                                                                 
+!                                                                                
+      DO I=its,ite
+         QGH(i)=0.                                                                
+         CPM(i)=CP                                                                
+      ENDDO
+!                                                                                
+!     IF(IDRY.EQ.1)GOTO 80                                                   
+      DO 50 K=kts,kte
+        NK=kme-K
+        DO 50 I=its,ite
+          QX(I,K)=QV2D(I,NK)
+          TVCON=(1.+EP1*QX(I,K))                                      
+          THVX(I,K)=THX(I,K)*TVCON                                               
+          SCR4(I,K)=SCR3(I,K)*TVCON                                              
+   50 CONTINUE                                                                 
+!                                                                                
+      DO 60 I=its,ite
+        E1=SVP1*EXP(SVP2*(TGDSA(I)-SVPT0)/(TGDSA(I)-SVP3))                       
+        QGH(I)=EP2*E1/(PS(I)-E1)                                                 
+        CPM(I)=CP*(1.+0.8*QX(I,KL))                                   
+   60 CONTINUE                                                                   
+!                                                                                
+!     IF(IMOIST.EQ.1)GOTO 80
+      DO 70 K=kts,kte
+        NK=kme-K
+        DO 70 I=its,ite
+          QCX(I,K)=QC2D(I,NK)
+   70 CONTINUE
+
+      IF (flag_QI .AND. PRESENT( QI2D ) ) THEN
+         DO K=kts,kte
+            NK=kme-K
+            DO I=its,ite
+               QIX(I,K)=QI2D(I,NK)
+            ENDDO
+         ENDDO
+      ELSE
+         DO K=kts,kte
+            NK=kme-K
+            DO I=its,ite
+               QIX(I,K)=0.
+            ENDDO
+         ENDDO
+      ENDIF
+
+   80 CONTINUE
+
+!                                                                                
+!-----COMPUTE THE HEIGHT OF FULL- AND HALF-SIGMA LEVELS ABOVE GROUND             
+!     LEVEL, AND THE LAYER THICKNESSES.                                          
+!                                                                                
+      DO 90 I=its,ite
+        ZQ(I,KLP1)=0.                                                            
+        RHOX(I)=PS(I)*1000./(R*SCR4(I,KL))                                       
+   90 CONTINUE                                                                   
+!                                                                                
+      DO 110 KK=kts,kte
+        K=kme-KK
+        DO 100 I=its,ite                                                   
+          DUM1(I)=ZQ(I,K+1)                                                      
+  100   CONTINUE                                                                 
+!                                                                                
+        DO 110 I=its,ite                                                   
+           ZQ(I,K)=dz8w2d(I,K)+DUM1(I)
+  110   CONTINUE                                                                 
+!                                                                                
+      DO 120 K=kts,kte
+        DO 120 I=its,ite
+          ZA(I,K)=0.5*(ZQ(I,K)+ZQ(I,K+1))                                        
+          DZQ(I,K)=ZQ(I,K)-ZQ(I,K+1)                                             
+  120 CONTINUE                                                                 
+!                                                                                
+      DO 130 K=kts,kte-1
+        DO 130 I=its,ite
+          DZA(I,K)=ZA(I,K)-ZA(I,K+1)                                             
+  130 CONTINUE                                                                 
+               
+      DTSTEP=DT                                                                  
+!                                                                                
+      DO 160 I=its,ite
+        GOVRTH(I)=G/THX(I,KL)                                                    
+  160 CONTINUE                                                                   
+!                                                                                
+!-----INITIALIZE VERTICAL TENDENCIES AND                                         
+!                                                                                
+      DO I=its,ite
+      DO K=kts,kte
+         UTNP(i,k)=0.                                                           
+         VTNP(i,k)=0.                                                           
+         TTNP(i,k)=0.                                                           
+      ENDDO
+      ENDDO
+!                                                                                
+!     IF(IDRY.EQ.1)GOTO 250                                                  
+      DO 230 K=kts,kte
+        DO 230 I=its,ite
+          QTNP(I,K)=0.                                                           
+  230 CONTINUE                                                                 
+!                                                                                
+!     IF(IMOIST.EQ.1)GOTO 250                                                
+      DO 240 K=kts,kte
+        DO 240 I=its,ite
+          QCTNP(I,K)=0.                                                          
+          QITNP(I,K)=0.                                                          
+  240 CONTINUE                                                                 
+                                                                                 
+  250 CONTINUE                                                                   
+!                                                                                
+!-----CALCULATE BULK RICHARDSON NO. OF SURFACE LAYER, ACCORDING TO               
+!     AKB(1976), EQ(12).                                                         
+                                                                                 
+!     DO 260 I=its,ite
+!       GZ1OZ0(I)=ALOG(ZA(I,KL)/ZNT(I))                                        
+!       IF((XLAND(I)-1.5).GE.0)THEN                                            
+!         ZL=ZNT(I)                                                            
+!       ELSE                                                                     
+!         ZL=0.01                                                                
+!       ENDIF                                                                    
+!       WSPD(I)=SQRT(UX(I,KL)*UX(I,KL)+VX(I,KL)*VX(I,KL))                        
+!       TSKV=THGB(I)*(1.+EP1*QGH(I)*MAVAIL(I))                     
+!       DTHVDZ=(THVX(I,KL)-TSKV)                                                 
+!       IF(-DTHVDZ.GE.0)THEN                                                     
+!         DTHVM=-DTHVDZ                                                          
+!       ELSE                                                                     
+!         DTHVM=0.                                                               
+!       ENDIF                                                                    
+!       VCONV=VCONVC*SQRT(DTHVM)                                                 
+!       WSPD(I)=SQRT(WSPD(I)*WSPD(I)+VCONV*VCONV)                                
+!       WSPD(I)=AMAX1(WSPD(I),1.)                                                
+!       BR(I)=GOVRTH(I)*ZA(I,KL)*DTHVDZ/(WSPD(I)*WSPD(I))                        
+! 260 CONTINUE                                                                   
+                                                                                 
+!!-----DIAGNOSE BASIC PARAMETERS FOR THE APPROPRIATED STABILITY CLASS:            
+!!                                                                                
+!!     THE STABILITY CLASSES ARE DETERMINED BY BR (BULK RICHARDSON NO.)           
+!!     AND HOL (HEIGHT OF PBL/MONIN-OBUKHOV LENGTH).                              
+!!                                                                                
+!!     CRITERIA FOR THE CLASSES ARE AS FOLLOWS:                                   
+!!                                                                                
+!!        1. BR .GE. 0.2;                                                         
+!!               REPRESENTS NIGHTTIME STABLE CONDITIONS (REGIME=1),               
+!!                                                                                
+!!        2. BR .LT. 0.2 .AND. BR .GT. 0.0;                                       
+!!               REPRESENTS DAMPED MECHANICAL TURBULENT CONDITIONS                
+!!               (REGIME=2),                                                      
+!!                                                                                
+!!        3. BR .EQ. 0.0                                                          
+!!               REPRESENTS FORCED CONVECTION CONDITIONS (REGIME=3),              
+!!                                                                                
+!!        4. BR .LT. 0.0                                                          
+!!               REPRESENTS FREE CONVECTION CONDITIONS (REGIME=4).                
+!!                                                                                
+!!-----                                                                           
+!
+!      DO 320 I=its,ite
+!!----                                                                            
+!!--     REMOVE REGIME 3 DEPENDENCE ON PBL HEIGHT                                 
+!!--          IF(BR(I).LT.0..AND.HOL(I).GT.1.5)GOTO 310                         
+!
+!        IF(BR(I).LT.0.)GOTO 310                                                  
+!!                                                                                
+!!-----CLASS 1; STABLE (NIGHTTIME) CONDITIONS:                                    
+!!                                                                                
+!        IF(BR(I).LT.0.2)GOTO 270                                                 
+!        REGIME(I)=1.                                                           
+!        PSIM(I)=-10.*GZ1OZ0(I)                                                   
+!!    LOWER LIMIT ON PSI IN STABLE CONDITIONS                                     
+!        PSIM(I)=AMAX1(PSIM(I),-10.)                                              
+!        PSIH(I)=PSIM(I)                                                          
+!        HOL(I)=0.0
+!        PBL(I)=0.0                                                             
+!        GOTO 320                                                                 
+!!                                                                                
+!!-----CLASS 2; DAMPED MECHANICAL TURBULENCE:                                     
+!!                                                                                
+!  270   IF(BR(I).EQ.0.0)GOTO 280                                                 
+!        REGIME(I)=2.                                                           
+!        PSIM(I)=-5.0*BR(I)*GZ1OZ0(I)/(1.1-5.0*BR(I))                             
+!!    LOWER LIMIT ON PSI IN STABLE CONDITIONS                                     
+!        PSIM(I)=AMAX1(PSIM(I),-10.)                                              
+!!.....AKB(1976), EQ(16).                                                         
+!        PSIH(I)=PSIM(I)                                                          
+!        HOL(I)=0.0
+!        PBL(I)=0.0                                                             
+!        GOTO 320                                                                 
+!!                                                                                
+!!-----CLASS 3; FORCED CONVECTION:                                                
+!!                                                                                
+!  280   REGIME(I)=3.                                                           
+!        PSIM(I)=0.0                                                              
+!        PSIH(I)=PSIM(I)                                                          
+!                                                                                 
+!! special use kte instead of kme
+!
+!        DO 290 KK=kts,kte-1
+!          K=kte-KK
+!          IF(THVX(I,K).GT.THVX(I,KL))GOTO 300                                    
+!  290   CONTINUE                                                                 
+!        STOP 290                                                                 
+!  300   PBL(I)=ZQ(I,K+1)                                                       
+!        IF(UST(I).LT.0.01)THEN                                                 
+!          ZOL(I)=BR(I)*GZ1OZ0(I)                                               
+!        ELSE                                                                     
+!          ZOL(I)=KARMAN*GOVRTH(I)*ZA(I,KL)*MOL(I,J)/(UST(I)*UST(I)) 
+!        ENDIF                                                                    
+!        HOL(I)=-ZOL(I)*PBL(I)/ZA(I,KL)
+!        GOTO 320                                                                 
+!                                                                                 
+!!-----CLASS 4; FREE CONVECTION:                                                  
+!                                                                                 
+!! 310     IF(THVX(I,KLM).GT.THVX(I,KL))GOTO 280                                  
+!
+!  310   CONTINUE                                                                 
+!        REGIME(I)=4.                                                           
+!        IF(UST(I).LT.0.01)THEN                                                 
+!          ZOL(I)=BR(I)*GZ1OZ0(I)                                               
+!        ELSE                                                                     
+!          ZOL(I)=KARMAN*GOVRTH(I)*ZA(I,KL)*MOL(I,J)/(UST(I)*UST(I))
+!        ENDIF                                                                    
+!        ZOL(I)=AMIN1(ZOL(I),0.)                                              
+!        ZOL(I)=AMAX1(ZOL(I),-9.9999)                                         
+!        NZOL=INT(-ZOL(I)*100.)                                                 
+!        RZOL=-ZOL(I)*100.-NZOL                                                 
+!        PSIM(I)=PSIMTB(NZOL)+RZOL*(PSIMTB(NZOL+1)-PSIMTB(NZOL))                  
+!        PSIH(I)=PSIHTB(NZOL)+RZOL*(PSIHTB(NZOL+1)-PSIHTB(NZOL))                  
+!!---LIMIT PSIH AND PSIM IN THE CASE OF THIN LAYERS AND HIGH ROUGHNESS            
+!!---  THIS PREVENTS DENOMINATOR IN FLUXES FROM GETTING TOO SMALL                 
+!        PSIH(I)=AMIN1(PSIH(I),0.9*GZ1OZ0(I))                                     
+!        PSIM(I)=AMIN1(PSIM(I),0.9*GZ1OZ0(I))                                     
+!  320 CONTINUE                                                                   
+
+!-----COMPUTE THE FRICTIONAL VELOCITY:        
+!     ZA(1982) EQS(2.60),(2.61).     
+
+      DO 330 I=its,ite
+        DTG=THX(I,KL)-THGB(I)        
+        PSIX=GZ1OZ0(I)-PSIM(I)        
+        IF((XLAND(I)-1.5).GE.0)THEN        
+          ZL=ZNT(I)        
+        ELSE        
+          ZL=0.01        
+        ENDIF        
+        PSIQ=ALOG(KARMAN*UST(I)*ZA(I,KL)/XKA+ZA(I,KL)/ZL)-PSIH(I)        
+        UST(I)=KARMAN*WSPD(I)/PSIX        
+!        
+        USTM=AMAX1(UST(I),0.1)        
+        IF((XLAND(I)-1.5).GE.0)THEN        
+          UST(I)=UST(I)        
+        ELSE                     
+          UST(I)=USTM          
+        ENDIF                    
+!       MOL(I,J)=KARMAN*DTG/(GZ1OZ0(I)-PSIH(I))/PRT
+  330 CONTINUE                   
+!                                                                                
+      DO 420 I=its,ite
+        WSPD1(I)=SQRT(UX(I,KL)*UX(I,KL)+VX(I,KL)*VX(I,KL))+1.E-9                  
+  420 CONTINUE                                                                   
+!                                                                                
+!---- COMPUTE VERTICAL DIFFUSION                                                 
+!                                                                                
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -          
+!     COMPUTE PRELIMINARY VARIABLES                                              
+!                                                                                
+!                                                                                
+      DT4=2.*DTSTEP                                                              
+      RDT=1./DT4                                                                 
+!                                                                                
+      DO I=its,ite
+        HGAMT(I)=0.                                                              
+        HGAMQ(I)=0.                                                              
+        WSCALE(I)=0.                                                             
+        KPBL(I)=KL                                                               
+        PBL(I)=ZQ(I,KL)                                                        
+        KPBL0(I)=KL                                                    
+        PBL0(I)=ZQ(I,KL)                                              
+        PBLFLG(I)=.TRUE.                                                         
+        SFCFLG(I)=.TRUE.                                                         
+        IF(BR(I).GT.0.0)SFCFLG(I)=.FALSE.                                        
+        ZL1(I)=ZA(I,KL)                                                          
+        THERMAL(I)=THVX(I,KL)                                                    
+      ENDDO                                                                      
+                                                                                 
+!     COMPUTE THE FIRST GUESS OF PBL HEIGHT                                      
+                                                                                 
+      DO I=its,ite
+        STABLE(I)=.FALSE.                                                        
+        BRUP(I)=BR(I)                                                            
+      ENDDO                                                                      
+      DO K=KLM,KLPBL,-1                                                          
+        DO I=its,ite
+          IF(.NOT.STABLE(I))THEN                                                 
+            BRDN(I)=BRUP(I)                                                      
+            SPDK2=MAX(UX(I,K)**2+VX(I,K)**2,1.)                                  
+            BRUP(I)=(THVX(I,K)-THERMAL(I))*(G*ZA(I,K)/THVX(I,KL))/SPDK2          
+            KPBL(I)=K                                                            
+            STABLE(I)=BRUP(I).GT.BRCR                                            
+          ENDIF                                                                  
+        ENDDO                                                                    
+      ENDDO                                                                      
+!                                                                                
+      DO I=its,ite
+        K=KPBL(I)                                                                
+        IF(BRDN(I).GE.BRCR)THEN                                                  
+          BRINT=0.                                                               
+        ELSEIF(BRUP(I).LE.BRCR)THEN                                              
+          BRINT=1.                                                               
+        ELSE                                                                     
+          BRINT=(BRCR-BRDN(I))/(BRUP(I)-BRDN(I))                                 
+        ENDIF                                                                    
+        PBL(I)=ZA(I,K+1)+BRINT*(ZA(I,K)-ZA(I,K+1))                             
+        IF(PBL(I).LT.ZQ(I,KPBL(I)+1))KPBL(I)=KPBL(I)+1                         
+      ENDDO                                                                      
+!                                                                                
+      DO I=its,ite
+        FM=GZ1OZ0(I)-PSIM(I)                                                     
+        FH=GZ1OZ0(I)-PSIH(I)                                                     
+        HOL(I)=MAX(BR(I)*FM*FM/FH,RIMIN)                                       
+        IF(SFCFLG(I))THEN                                                        
+          HOL(I)=MIN(HOL(I),-ZFMIN)                                          
+        ELSE                                                                     
+          HOL(I)=MAX(HOL(I),ZFMIN)                                           
+        ENDIF                                                                    
+!                                                                                
+        HOL1=HOL(I)*PBL(I)/ZL1(I)*SFCFRAC                                    
+        HOL(I)=-HOL(I)*PBL(I)/ZL1(I)                                       
+        IF(SFCFLG(I))THEN                                                        
+          PHIM(I)=(1.-APHI16*HOL1)**(-1./4.)                                     
+          PHIH(I)=(1.-APHI16*HOL1)**(-1./2.)                                     
+        ELSE                                                                     
+          PHIM(I)=(1.+APHI5*HOL1)                                                
+          PHIH(I)=PHIM(I)                                                        
+        ENDIF                                                                    
+        WSCALE(I)=UST(I)/PHIM(I)                                               
+        WSCALE(I)=MIN(WSCALE(I),UST(I)*APHI16)                                 
+        WSCALE(I)=MAX(WSCALE(I),UST(I)/APHI5)                                  
+      ENDDO                                                                      
+                                                                                 
+!     COMPUTE THE SURFACE VARIABLES FOR PBL HEIGHT ESTIMATION                    
+!     UNDER UNSTABLE CONDITIONS                                                  
+                                                                                 
+      DO I=its,ite
+        IF(SFCFLG(I))THEN                                                        
+          GAMFAC=CFAC/RHOX(I)/WSCALE(I)                                          
+          HGAMT(I)=MIN(GAMFAC*HFX(I)/CPM(I),GAMCRT)                            
+          HGAMQ(I)=MIN(GAMFAC*QFX(I),GAMCRQ)                                   
+          IF((XLAND(I)-1.5).GE.0)HGAMQ(I)=0.                                   
+          VPERT=HGAMT(I)+EP1*THX(I,KL)*HGAMQ(I)                                  
+          VPERT=MIN(VPERT,GAMCRT)                                                
+          THERMAL(I)=THERMAL(I)+MAX(VPERT,0.)                                    
+          HGAMT(I)=MAX(HGAMT(I),0.0)                                             
+          HGAMQ(I)=MAX(HGAMQ(I),0.0)                                             
+        ELSE                                                                     
+          PBLFLG(I)=.FALSE.                                                      
+        ENDIF                                                                    
+      ENDDO                                                                      
+!                                                                                
+      DO I=its,ite
+        IF(PBLFLG(I))THEN                                                        
+          KPBL(I)=KL                                                             
+          PBL(I)=ZQ(I,KL)                                                      
+        ENDIF                                                                    
+      ENDDO                                                                      
+!                                                                                
+!     ENHANCE THE PBL HEIGHT BY CONSIDERING THE THERMAL                          
+!                                                                                
+      DO I=its,ite
+        IF(PBLFLG(I))THEN                                                        
+          STABLE(I)=.FALSE.                                                      
+          BRUP(I)=BR(I)                                                          
+        ENDIF                                                                    
+      ENDDO                                                                      
+      DO K=KLM,KLPBL,-1                                                          
+        DO I=its,ite
+          IF(.NOT.STABLE(I).AND.PBLFLG(I))THEN                                   
+            BRDN(I)=BRUP(I)                                                      
+            SPDK2=MAX((UX(I,K)**2+VX(I,K)**2),1.)                                
+            BRUP(I)=(THVX(I,K)-THERMAL(I))*(G*ZA(I,K)/THVX(I,KL))/SPDK2          
+            KPBL(I)=K                                                            
+            STABLE(I)=BRUP(I).GT.BRCR                                            
+          ENDIF                                                                  
+        ENDDO                                                                    
+      ENDDO                                                                      
+!                                                                                
+      DO I=its,ite
+        IF(PBLFLG(I))THEN                                                        
+          K=KPBL(I)                                                              
+          IF(BRDN(I).GE.BRCR)THEN                                                
+            BRINT=0.                                                             
+          ELSEIF(BRUP(I).LE.BRCR)THEN                                            
+            BRINT=1.                                                             
+          ELSE                                                                   
+            BRINT=(BRCR-BRDN(I))/(BRUP(I)-BRDN(I))                               
+          ENDIF                                                                  
+          PBL(I)=ZA(I,K+1)+BRINT*(ZA(I,K)-ZA(I,K+1))                           
+          IF(PBL(I).LT.ZQ(I,KPBL(I)+1))KPBL(I)=KPBL(I)+1                       
+          IF(KPBL(I).LE.1)PBLFLG(I)=.FALSE.                                      
+        ENDIF                                                                    
+      ENDDO                                                                      
+!                                                                                
+!     DIAGNOSTIC PBL HEIGHT WITH BRCR EFFECTIVELY ZERO (PBL0)                    
+!                                                                                
+      DO I=its,ite
+        IF(PBLFLG(I))THEN                                                        
+          STABLE(I)=.FALSE.                                                      
+          BRUP(I)=BR(I)                                                          
+        ENDIF                                                                    
+      ENDDO                                                                      
+      DO K=KLM,KLPBL,-1                                                          
+        DO I=its,ite
+          IF(.NOT.STABLE(I).AND.PBLFLG(I))THEN                                   
+            BRDN(I)=BRUP(I)                                                      
+            SPDK2=MAX((UX(I,K)**2+VX(I,K)**2),1.)                                
+            BRUP(I)=(THVX(I,K)-THERMAL(I))*(G*ZA(I,K)/THVX(I,KL))/SPDK2          
+            KPBL0(I)=K                                                           
+            STABLE(I)=BRUP(I).GT.0.0                                             
+          ENDIF                                                                  
+                                                                                 
+        ENDDO                                                                    
+      ENDDO                                                                      
+!                                                                                
+      DO I=its,ite
+        IF(PBLFLG(I))THEN                                                        
+          K=KPBL0(I)                                                             
+          IF(BRDN(I).GE.0.0)THEN                                                 
+            BRINT=0.                                                             
+          ELSEIF(BRUP(I).LE.0.0)THEN                                             
+            BRINT=1.                                                             
+          ELSE                                                                   
+            BRINT=(0.0-BRDN(I))/(BRUP(I)-BRDN(I))                                
+          ENDIF                                                                  
+          PBL0(I)=ZA(I,K+1)+BRINT*(ZA(I,K)-ZA(I,K+1))                            
+          IF(PBL0(I).LT.ZQ(I,KPBL0(I)+1))KPBL0(I)=KPBL0(I)+1                     
+          IF(KPBL0(I).LE.1)PBLFLG(I)=.FALSE.                                     
+        ENDIF                                                                    
+      ENDDO                                                                      
+
+!                                                                                
+!     COMPUTE DIFFUSION COEFFICIENTS BELOW PBL                                   
+!                                                                                
+      DO K=kte,KLPBL,-1 
+        DO I=its,ite
+          IF(KPBL(I).LT.K)THEN                                                   
+            PRNUM=(PHIH(I)/PHIM(I)+CFAC*KARMAN*SFCFRAC)                          
+            PRNUM=MIN(PRNUM,PRMAX)                                               
+            PRNUM=MAX(PRNUM,PRMIN)                                               
+            ZFAC=MAX((1.-(ZQ(I,K)-ZL1(I))/(PBL(I)-ZL1(I))),ZFMIN)              
+            XKZO=CKZ*DZA(I,K-1)                                                    
+            XKZM(I,K)=XKZO+WSCALE(I)*KARMAN*ZQ(I,K)*ZFAC**PFAC                   
+            XKZH(I,K)=XKZM(I,K)/PRNUM                                            
+            XKZM(I,K)=MIN(XKZM(I,K),XKZMAX)                                      
+            XKZM(I,K)=MAX(XKZM(I,K),XKZMIN)                                      
+            XKZH(I,K)=MIN(XKZH(I,K),XKZMAX)                                      
+            XKZH(I,K)=MAX(XKZH(I,K),XKZMIN)                                      
+          ENDIF                                                                  
+        ENDDO                                                                    
+      ENDDO                                                                      
+!                                                                                
+!     COMPUTE DIFFUSION COEFFICIENTS OVER PBL (FREE ATMOSPHERE)                  
+!                                                                                
+      DO K=kts+1,kte
+        DO I=its,ite
+          XKZO=CKZ*DZA(I,K-1)                                                      
+          IF(K.LE.KPBL(I))THEN                                                   
+            SS=((UX(I,K-1)-UX(I,K))*(UX(I,K-1)-UX(I,K))+(VX(I,K-1)-   & 
+               VX(I,K))*(VX(I,K-1)-VX(I,K)))/(DZA(I,K-1)*DZA(I,K-1))+ &          
+               1.E-9                                                             
+            RI=GOVRTH(I)*(THVX(I,K-1)-THVX(I,K))/(SS*DZA(I,K-1))                 
+            IF(IMVDIF.EQ.1)THEN                              
+              IF((QCX(I,K)+QIX(I,K)).GT.0.01E-3.AND.(QCX(I,K-1)+      & 
+                QIX(I,K-1)).GT.0.01E-3)THEN                                      
+!      IN CLOUD                                                                  
+                QMEAN=0.5*(QX(I,K)+QX(I,K-1))                                    
+                TMEAN=0.5*(SCR3(I,K)+SCR3(I,K-1))                                
+                ALPH=XLV*QMEAN/R/TMEAN                                           
+                CHI=XLV*XLV*QMEAN/CP/RV/TMEAN/TMEAN                              
+                RI=(1.+ALPH)*(RI-G*G/SS/TMEAN/CP*((CHI-ALPH)/(1.+CHI)))          
+              ENDIF                                                              
+            ENDIF                                                                
+            ZK=KARMAN*ZQ(I,K)                                                    
+            RL2=(ZK*RLAM/(RLAM+ZK))**2                                           
+            DK=RL2*SQRT(SS)                                                      
+            IF(RI.LT.0.)THEN                                                     
+! UNSTABLE REGIME                                                                
+              SRI=SQRT(-RI)                                                      
+              XKZM(I,K)=XKZO+DK*(1+8.*(-RI)/(1+1.746*SRI))                       
+              XKZH(I,K)=XKZO+DK*(1+8.*(-RI)/(1+1.286*SRI))                       
+            ELSE                                                                 
+! STABLE REGIME                                                                  
+              XKZH(I,K)=XKZO+DK/(1+5.*RI)**2                                     
+              PRNUM=1.0+2.1*RI                                                   
+              PRNUM=MIN(PRNUM,PRMAX)                                             
+              XKZM(I,K)=(XKZH(I,K)-XKZO)*PRNUM+XKZO                              
+            ENDIF                                                                
+!                                                                                
+            XKZM(I,K)=MIN(XKZM(I,K),XKZMAX)                                      
+            XKZM(I,K)=MAX(XKZM(I,K),XKZMIN)                                      
+            XKZH(I,K)=MIN(XKZH(I,K),XKZMAX)                                      
+            XKZH(I,K)=MAX(XKZH(I,K),XKZMIN)                                      
+          ENDIF                                                                  
+!                                                                                
+        ENDDO                                                                    
+      ENDDO                                                                      
+                                                                                 
+!     COMPUTE TRIDIAGONAL MATRIX ELEMENTS FOR HEAT AND MOISTURE                  
+                                                                                 
+      DO I=its,ite
+      DO K=kts,kte
+         AU(i,k)=0.
+         AL(i,k)=0.
+         AD(i,k)=0.
+         A1(i,k)=0.
+         A2(i,k)=0.
+      ENDDO
+      ENDDO
+ 
+      DO I=its,ite
+        AD(I,1)=1.                                                               
+        A1(I,1)=SCR3(I,KL)+HFX(I)/(RHOX(I)*CPM(I))/ZQ(I,KL)*DT4                
+        A2(I,1)=QX(I,KL)+QFX(I)/(RHOX(I))/ZQ(I,KL)*DT4                         
+      ENDDO                                                                      
+!                                                                                
+      DO K=kte,kts+1,-1
+        KK=kme-K                                                                
+        DO I=its,ite
+          DTODSD=DT4/dz8w2d(I,K)                                                   
+          DTODSU=DT4/dz8w2d(I,K-1)                                                 
+          DSIG=z2d(I,K)-z2d(I,K-1)                                                 
+          DSIG=-DSIG
+          RDZ=1./DZA(I,K-1)                                                      
+          IF(PBLFLG(I).AND.KPBL(I).LT.K)THEN                                     
+            DSDZT=DSIG*XKZH(I,K)*RDZ*(G/CP-HGAMT(I)/PBL(I))                    
+            DSDZQ=DSIG*XKZH(I,K)*RDZ*(-HGAMQ(I)/PBL(I))                        
+            A2(I,KK)=A2(I,KK)+DTODSD*DSDZQ                                       
+            A2(I,KK+1)=QX(I,K-1)-DTODSU*DSDZQ                                    
+          ELSE                                                                   
+            DSDZT=DSIG*XKZH(I,K)*RDZ*(G/CP)                                      
+            A2(I,KK+1)=QX(I,K-1)                                                 
+          ENDIF                                                                  
+          DSDZ2=DSIG*XKZH(I,K)*RDZ*RDZ                                           
+          AU(I,KK)=-DTODSD*DSDZ2                                                 
+          AL(I,KK)=-DTODSU*DSDZ2                                                 
+          AD(I,KK)=AD(I,KK)-AU(I,KK)                                             
+          AD(I,KK+1)=1.-AL(I,KK)                                                 
+          A1(I,KK)=A1(I,KK)+DTODSD*DSDZT                                         
+          A1(I,KK+1)=SCR3(I,K-1)-DTODSU*DSDZT                                    
+        ENDDO                                                                    
+      ENDDO                                                                      
+                                                                                 
+!     SOLVE TRIDIAGONAL PROBLEM FOR HEAT AND MOISTURE                            
+      
+      CALL TRIDI2(AL,AD,AU,A1,A2,AU,A1,A2,                 &
+                  its,ite,kts,kte                          )
+
+!     RECOVER TENDENCIES OF HEAT AND MOISTURE                                    
+                                                                                 
+      DO K=kte,kts,-1
+        KK=kme-K
+        DO I=its,ite
+          TTEND=(A1(I,KK)-SCR3(I,K))*RDT                                         
+          QTEND=(A2(I,KK)-QX(I,K))*RDT                                           
+          TTNP(I,K)=TTNP(I,K)+TTEND                                              
+          QTNP(I,K)=QTNP(I,K)+QTEND                                              
+        ENDDO                                                                    
+      ENDDO                                                                      
+                                                                                 
+!     COMPUTE TRIDIAGONAL MATRIX ELEMENTS FOR MOMENTUM                           
+                                                                                 
+      DO I=its,ite
+      DO K=kts,kte
+         AU(i,k)=0.
+         AL(i,k)=0.
+         AD(i,k)=0.
+         A1(i,k)=0.
+         A2(i,k)=0.
+      ENDDO
+      ENDDO
+ 
+      DO I=its,ite
+        AD(I,1)=1.                                                               
+        A1(I,1)=UX(I,KL)-UX(I,KL)/WSPD1(I)*UST(I)*UST(I)/ZQ(I,KL)  &
+                *DT4*(WSPD1(I)/WSPD(I))**2                            
+        A2(I,1)=VX(I,KL)-VX(I,KL)/WSPD1(I)*UST(I)*UST(I)/ZQ(I,KL)  &
+                *DT4*(WSPD1(I)/WSPD(I))**2                          
+      ENDDO                                                                      
+!                                                                                
+      DO K=kte,kts+1,-1
+        KK=kme-K
+        DO I=its,ite
+          DTODSD=DT4/dz8w2d(I,K)                                                   
+          DTODSU=DT4/dz8w2d(I,K-1)                                                 
+          DSIG=z2d(I,K)-z2d(I,K-1)                                                 
+          DSIG=-DSIG
+          RDZ=1./DZA(I,K-1)                                                      
+          DSDZ2=DSIG*XKZM(I,K)*RDZ*RDZ                                           
+          AU(I,KK)=-DTODSD*DSDZ2                                                 
+          AL(I,KK)=-DTODSU*DSDZ2                                                 
+          AD(I,KK)=AD(I,KK)-AU(I,KK)                                             
+          AD(I,KK+1)=1.-AL(I,KK)                                                 
+          A1(I,KK+1)=UX(I,K-1)                                                   
+          A2(I,KK+1)=VX(I,K-1)                                                   
+        ENDDO                                                                    
+      ENDDO                                                                      
+                                                                                 
+!     SOLVE TRIDIAGONAL PROBLEM FOR MOMENTUM                                     
+                                                                                 
+      CALL TRIDI2(AL,AD,AU,A1,A2,AU,A1,A2,                 &
+                  its,ite,kts,kte                          )
+                                                                                 
+!     RECOVER TENDENCIES OF MOMENTUM                                             
+                                                                                 
+      DO K=kte,kts,-1 
+        KK=kme-K
+        DO I=its,ite
+          UTEND=(A1(I,KK)-UX(I,K))*RDT                                           
+          VTEND=(A2(I,KK)-VX(I,K))*RDT                                           
+          UTNP(I,K)=UTNP(I,K)+UTEND                                              
+          VTNP(I,K)=VTNP(I,K)+VTEND                                              
+        ENDDO                                                                    
+      ENDDO                                                                      
+                                                                                 
+!     COMPUTE TRIDIAGONAL MATRIX ELEMENTS FOR CLOUD                              
+                                                                                 
+      DO I=its,ite
+      DO K=kts,kte
+         AU(i,k)=0.
+         AL(i,k)=0.
+         AD(i,k)=0.
+         A1(i,k)=0.
+         A2(i,k)=0.
+      ENDDO
+      ENDDO
+ 
+!     IF(IMOIST.EQ.1)GOTO 690                                                
+      DO I=its,ite
+        AD(I,1)=1.                                                               
+        A1(I,1)=QCX(I,KL)                                                        
+        A2(I,1)=QIX(I,KL)                                                        
+      ENDDO                                                                      
+!                                                                                
+      DO K=kte,kts+1,-1
+        KK=kme-K
+        DO I=its,ite
+          DTODSD=DT4/dz8w2d(I,K)                                                   
+          DTODSU=DT4/dz8w2d(I,K-1)                                                 
+          DSIG=z2d(I,K)-z2d(I,K-1)                                                 
+          DSIG=-DSIG
+          RDZ=1./DZA(I,K-1)                                                      
+          A1(I,KK+1)=QCX(I,K-1)                                                  
+          A2(I,KK+1)=QIX(I,K-1)                                                  
+          DSDZ2=DSIG*XKZH(I,K)*RDZ*RDZ                                           
+          AU(I,KK)=-DTODSD*DSDZ2                                                 
+          AL(I,KK)=-DTODSU*DSDZ2                                                 
+          AD(I,KK)=AD(I,KK)-AU(I,KK)                                             
+          AD(I,KK+1)=1.-AL(I,KK)                                                 
+        ENDDO                                                                    
+      ENDDO                                                                      
+                                                                                 
+!     SOLVE TRIDIAGONAL PROBLEM FOR CLOUD                                        
+                                                                                 
+      CALL TRIDI2(AL,AD,AU,A1,A2,AU,A1,A2,                 &
+                  its,ite,kts,kte                          )
+!
+      DO K=kte,kts,-1
+        KK=kme-K                                                                
+        DO I=its,ite
+          QCTEND=(A1(I,KK)-QCX(I,K))*RDT                                         
+          QITEND=(A2(I,KK)-QIX(I,K))*RDT                                         
+          QCTNP(I,K)=QCTNP(I,K)+QCTEND                                           
+          QITNP(I,K)=QITNP(I,K)+QITEND                                           
+        ENDDO                                                                    
+      ENDDO                                                                      
+!                                                                                
+!---- END OF VERTICAL DIFFUSION                                                  
+!                                                                                
+  690 CONTINUE                                                                   
+!                                                                                
+!-----CALCULATION OF NEW VALUES DUE TO VERTICAL EXCHANGE PROCESSES IS            
+!     COMPLETED. THE FINAL STEP IS TO ADD THE TENDENCIES CALCULATED              
+!     IN HIRPBL TO THOSE OF MM4.                                                 
+                                                                                 
+      DO 820 K=kts,kte
+        NK=kme-K
+        DO 820 I=its,ite
+          U2DTEN(I,NK)=UTNP(I,K)
+          V2DTEN(I,NK)=VTNP(I,K)
+  820   CONTINUE                                                                 
+!                                                                                
+!     IF(J.EQ.1.AND.IN.GT.1)GOTO 860                                             
+!SUE  JBGN=3                                                                     
+!SUE  JEND=JLXM-1                                                                
+
+! change when nest
+!SUE  JBGN=2                                                                   
+!SUE  JEND=JLXM                                                                
+
+      JBGN=jts
+      JEND=jte
+      IBGN=its                                                                   
+      IEND=ite
+
+!     IF(J.LT.JBGN.OR.J.GT.JEND)GOTO 860                                         
+!SUE  IBGN=3                                                                     
+!SUE  IEND=ILXM-1                                                                
+
+! change when nest
+!SUE  IBGN=2                                                                   
+!SUE  IEND=ILXM                                                                
+
+      DO 830 K=kts,kte
+        NK=kme-K
+        DO 830 I=IBGN,IEND                                                       
+          T2DTEN(I,NK)=TTNP(I,K)
+  830   CONTINUE                                                                 
+!                                                                                
+!     IF(IDRY.EQ.1)GOTO 860                                                  
+      DO 840 K=kts,kte
+        NK=kme-K
+        DO 840 I=IBGN,IEND                                                       
+          QV2DTEN(I,NK)=QTNP(I,K) 
+  840   CONTINUE                                                                 
+                                                                                 
+!     IF(IMOIST.EQ.1)GOTO 860
+      DO 850 K=kts,kte
+        NK=kme-K
+        DO 850 I=IBGN,IEND
+           QC2DTEN(I,NK)=QCTNP(I,K)
+  850   CONTINUE
+
+      IF(flag_QI .AND. PRESENT( QI2DTEN ) ) THEN
+        DO K=kts,kte
+        NK=kme-K
+          DO I=IBGN,IEND
+             QI2DTEN(I,NK)=QITNP(I,K)
+          ENDDO
+        ENDDO
+      ENDIF
+
+  860 CONTINUE                                                                   
+!                                                                                
+!-----APPLY ASSELIN FILTER TO TGD FOR LARGE TIME STEP:                           
+!                                                                                
+!     DO 885 I=its,ite
+!       TSK(I)=TSK(I)*(PS(I)/100.)**ROVCP                                    
+! 885 CONTINUE                                                                   
+!                                                                                
+  940 CONTINUE                                                                   
+!                                                                                
+! KPBL IS NEEDED FOR THE FDDA, AND SINCE THERE IS NO LONGER JUST ONE             
+! LARGE "J LOOP" IT MUST BE STORED AS (I,J)...                                   
+!                                                                                
+! USE NEW DIAGNOSED PBL DEPTH (CALCULATED WITH brcr=0.0)
+! PBL IS USED FOR OUTPUT AND NEXT-TIME-STEP BELJAARS CALC IN SFCLAY
+      DO 950 I=its,ite
+        KPBL1D(I)=KPBL0(I)                                                      
+        PBL(I)=PBL0(I)
+  950 CONTINUE                                                                   
+
+   END SUBROUTINE MRF2D
+
+!================================================================          
+   SUBROUTINE TRIDI2(CL,CM,CU,R1,R2,AU,A1,A2,                   &
+                     its,ite,kts,kte                            )
+!----------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------
+
+   INTEGER, INTENT(IN )      ::     its,ite, kts,kte
+                                   
+   REAL, DIMENSION( its:ite, kts+1:kte+1 )                    , &
+         INTENT(IN   )  ::                                  CL
+
+   REAL, DIMENSION( its:ite, kts:kte )                        , &
+         INTENT(IN   )  ::                                  CM, &
+                                                            R1, &
+                                                            R2
+   REAL, DIMENSION( its:ite, kts:kte )                        , &
+         INTENT(INOUT)  ::                                  AU, &
+                                                            CU, &
+                                                            A1, &
+                                                            A2
+
+   REAL    :: FK
+   INTEGER :: I,K,L,N
+
+!----------------------------------------------------------------         
+
+   L=ite 
+   N=kte
+
+   DO I=its,L
+     FK=1./CM(I,1)                                                            
+     AU(I,1)=FK*CU(I,1)                                                       
+     A1(I,1)=FK*R1(I,1)                                                       
+     A2(I,1)=FK*R2(I,1)                                                       
+   ENDDO                                                                      
+   DO K=2,N-1
+     DO I=its,L
+       FK=1./(CM(I,K)-CL(I,K)*AU(I,K-1))                                      
+       AU(I,K)=FK*CU(I,K)                                                     
+       A1(I,K)=FK*(R1(I,K)-CL(I,K)*A1(I,K-1))                                 
+       A2(I,K)=FK*(R2(I,K)-CL(I,K)*A2(I,K-1))                                 
+     ENDDO                                                                    
+   ENDDO                                                                      
+   DO I=its,L
+     FK=1./(CM(I,N)-CL(I,N)*AU(I,N-1))                                        
+     A1(I,N)=FK*(R1(I,N)-CL(I,N)*A1(I,N-1))                                   
+     A2(I,N)=FK*(R2(I,N)-CL(I,N)*A2(I,N-1))                                   
+
+   ENDDO                                                                      
+   DO K=N-1,kts,-1                                                              
+     DO I=its,L
+       A1(I,K)=A1(I,K)-AU(I,K)*A1(I,K+1)                                      
+       A2(I,K)=A2(I,K)-AU(I,K)*A2(I,K+1)                                      
+     ENDDO                                                                    
+   ENDDO                                                                      
+
+   END SUBROUTINE TRIDI2
+      
+!===================================================================
+   SUBROUTINE mrfinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,           &
+                      RQCBLTEN,RQIBLTEN,P_QI,P_FIRST_SCALAR,       &
+                      restart, allowed_to_read ,                   &
+                      ids, ide, jds, jde, kds, kde,                &
+                      ims, ime, jms, jme, kms, kme,                &
+                      its, ite, jts, jte, kts, kte                 )
+!-------------------------------------------------------------------          
+   IMPLICIT NONE
+!-------------------------------------------------------------------          
+   LOGICAL , INTENT(IN)          :: restart , allowed_to_read
+   INTEGER , INTENT(IN)          ::  ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte
+   INTEGER , INTENT(IN)          ::  P_QI,P_FIRST_SCALAR
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::         &
+                                                         RUBLTEN, &
+                                                         RVBLTEN, &
+                                                         RTHBLTEN, &
+                                                         RQVBLTEN, &
+                                                         RQCBLTEN, & 
+                                                         RQIBLTEN
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+
+   IF(.not.restart)THEN
+     DO j=jts,jtf
+     DO k=kts,ktf
+     DO i=its,itf
+        RUBLTEN(i,k,j)=0.
+        RVBLTEN(i,k,j)=0.
+        RTHBLTEN(i,k,j)=0.
+        RQVBLTEN(i,k,j)=0.
+        RQCBLTEN(i,k,j)=0.
+     ENDDO
+     ENDDO
+     ENDDO
+   ENDIF
+
+   IF (P_QI .ge. P_FIRST_SCALAR .and. .not.restart) THEN
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         RQIBLTEN(i,k,j)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+   END SUBROUTINE mrfinit
+
+!-------------------------------------------------------------------          
+
+END MODULE module_bl_mrf
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_bl_myjpbl.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_bl_myjpbl.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_bl_myjpbl.F	(revision 2744)
@@ -0,0 +1,1492 @@
+!-----------------------------------------------------------------------
+!
+      MODULE MODULE_BL_MYJPBL
+!
+!-----------------------------------------------------------------------
+!
+      USE MODULE_MODEL_CONSTANTS
+!
+!-----------------------------------------------------------------------
+!
+! REFERENCES:  Janjic (2002), NCEP Office Note 437
+!              Mellor and Yamada (1982), Rev. Geophys. Space Phys.
+!
+! ABSTRACT:
+!     MYJ UPDATES THE TURBULENT KINETIC ENERGY WITH THE PRODUCTION/
+!     DISSIPATION TERM AND THE VERTICAL DIFFUSION TERM
+!     (USING AN IMPLICIT FORMULATION) FROM MELLOR-YAMADA
+!     LEVEL 2.5 AS EXTENDED BY JANJIC.  EXCHANGE COEFFICIENTS FOR
+!     THE SURFACE AND FOR ALL LAYER INTERFACES ARE COMPUTED FROM
+!     MONIN-OBUKHOV THEORY.
+!     THE TURBULENT VERTICAL EXCHANGE IS THEN EXECUTED.
+!
+!-----------------------------------------------------------------------
+!
+      INTEGER :: ITRMX=5 ! Iteration count for mixing length computation
+!
+!     REAL,PARAMETER :: G=9.81,PI=3.1415926,R_D=287.04,R_V=461.6        &
+!    &                 ,VKARMAN=0.4
+      REAL,PARAMETER :: PI=3.1415926,VKARMAN=0.4
+!     REAL,PARAMETER :: CP=7.*R_D/2.
+      REAL,PARAMETER :: CAPA=R_D/CP
+      REAL,PARAMETER :: RLIVWV=XLS/XLV,ELOCP=2.72E6/CP
+      REAL,PARAMETER :: EPS1=1.E-12,EPS2=0.
+      REAL,PARAMETER :: EPSL=0.32,EPSRU=1.E-7,EPSRS=1.E-7               &
+     &                 ,EPSTRB=1.E-24
+      REAL,PARAMETER :: EPSA=1.E-8,EPSIT=1.E-4,EPSU2=1.E-4,EPSUST=0.07  &
+     &                 ,FH=1.01 
+      REAL,PARAMETER :: ALPH=0.30,BETA=1./273.,EL0MAX=1000.,EL0MIN=1.   &
+     &                 ,ELFC=0.23*0.5,GAM1=0.2222222222222222222        &
+     &                 ,PRT=1.
+      REAL,PARAMETER :: A1=0.659888514560862645                         &
+     &                 ,A2x=0.6574209922667784586                       &
+     &                 ,B1=11.87799326209552761                         &
+     &                 ,B2=7.226971804046074028                         &
+     &                 ,C1=0.000830955950095854396
+      REAL,PARAMETER :: A2S=17.2693882,A3S=273.16,A4S=35.86
+      REAL,PARAMETER :: ELZ0=0.,ESQ=5.0,EXCM=0.001                      &
+     &                 ,FHNEU=0.8,GLKBR=10.,GLKBS=30.                   &
+     &                 ,QVISC=2.1E-5,RFC=0.191,RIC=0.505,SMALL=0.35     &
+     &                 ,SQPR=0.84,SQSC=0.84,SQVISC=258.2,TVISC=2.1E-5   &
+     &                 ,USTC=0.7,USTR=0.225,VISC=1.5E-5                 &
+     &                 ,WOLD=0.15,WWST=1.2,ZTMAX=1.,ZTFC=1.,ZTMIN=-5.
+!
+      REAL,PARAMETER :: SEAFC=0.98,PQ0SEA=PQ0*SEAFC
+!
+      REAL,PARAMETER :: BTG=BETA*G,CZIV=SMALL*GLKBS                     &
+!    &                 ,EP_1=R_V/R_D-1.,ESQHF=0.5*5.0,GRRS=GLKBR/GLKBS  &
+     &                 ,ESQHF=0.5*5.0,GRRS=GLKBR/GLKBS                  &
+     &                 ,RB1=1./B1,RTVISC=1./TVISC,RVISC=1./VISC         &
+     &                 ,ZQRZT=SQSC/SQPR
+!
+      REAL,PARAMETER :: ADNH= 9.*A1*A2x*A2x*(12.*A1+3.*B2)*BTG*BTG      &                  
+     &                 ,ADNM=18.*A1*A1*A2x*(B2-3.*A2x)*BTG              & 
+     &                 ,ANMH=-9.*A1*A2x*A2x*BTG*BTG                     &
+     &                 ,ANMM=-3.*A1*A2x*(3.*A2x+3.*B2*C1+18.*A1*C1-B2)  &
+     &                                *BTG                              &   
+     &                 ,BDNH= 3.*A2x*(7.*A1+B2)*BTG                     &
+     &                 ,BDNM= 6.*A1*A1                                  &
+     &                 ,BEQH= A2x*B1*BTG+3.*A2x*(7.*A1+B2)*BTG          &
+     &                 ,BEQM=-A1*B1*(1.-3.*C1)+6.*A1*A1                 &
+     &                 ,BNMH=-A2x*BTG                                   &     
+     &                 ,BNMM=A1*(1.-3.*C1)                              &
+     &                 ,BSHH=9.*A1*A2x*A2x*BTG                          &
+     &                 ,BSHM=18.*A1*A1*A2x*C1                           &
+     &                 ,BSMH=-3.*A1*A2x*(3.*A2x+3.*B2*C1+12.*A1*C1-B2)  &
+     &                                *BTG                              &
+     &                 ,CESH=A2x                                        &
+     &                 ,CESM=A1*(1.-3.*C1)                              &
+     &                 ,CNV=EP_1*G/BTG                                  &
+     &                 ,ELFCS=VKARMAN*BTG                               &
+     &                 ,FZQ1=RTVISC*QVISC*ZQRZT                         &
+     &                 ,FZQ2=RTVISC*QVISC*ZQRZT                         &
+     &                 ,FZT1=RVISC *TVISC*SQPR                          &
+     &                 ,FZT2=CZIV*GRRS*TVISC*SQPR                       &
+     &                 ,FZU1=CZIV*VISC                                  &
+     &                 ,PIHF=0.5*PI                                     &
+     &                 ,RFAC=RIC/(FHNEU*RFC*RFC)                        &
+     &                 ,RQVISC=1./QVISC                                 &
+     &                 ,RRIC=1./RIC                                     &
+     &                 ,USTFC=0.018/G                                   &
+     &                 ,WNEW=1.-WOLD                                    &
+     &                 ,WWST2=WWST*WWST
+!
+!-----------------------------------------------------------------------
+!***  FREE TERM IN THE EQUILIBRIUM EQUATION FOR (L/Q)**2
+!-----------------------------------------------------------------------
+!
+      REAL,PARAMETER :: AEQH=9.*A1*A2x*A2x*B1*BTG*BTG                   &
+     &                      +9.*A1*A2x*A2x*(12.*A1+3.*B2)*BTG*BTG       &
+     &                 ,AEQM=3.*A1*A2x*B1*(3.*A2x+3.*B2*C1+18.*A1*C1-B2)&
+     &                      *BTG+18.*A1*A1*A2x*(B2-3.*A2x)*BTG
+!
+!-----------------------------------------------------------------------
+!***  FORBIDDEN TURBULENCE AREA
+!-----------------------------------------------------------------------
+!
+      REAL,PARAMETER :: REQU=-AEQH/AEQM                                 &
+     &                 ,EPSGH=1.E-9,EPSGM=REQU*EPSGH
+!
+!-----------------------------------------------------------------------
+!***  NEAR ISOTROPY FOR SHEAR TURBULENCE, WW/Q2 LOWER LIMIT
+!-----------------------------------------------------------------------
+! 
+      REAL,PARAMETER :: UBRYL=(18.*REQU*A1*A1*A2x*B2*C1*BTG             &
+     &                         +9.*A1*A2x*A2x*B2*BTG*BTG)               &
+     &                        /(REQU*ADNM+ADNH)                         &
+     &                 ,UBRY=(1.+EPSRS)*UBRYL,UBRY3=3.*UBRY
+!
+      REAL,PARAMETER :: AUBH=27.*A1*A2x*A2x*B2*BTG*BTG-ADNH*UBRY3       &
+     &                 ,AUBM=54.*A1*A1*A2x*B2*C1*BTG -ADNM*UBRY3        &
+     &                 ,BUBH=(9.*A1*A2x+3.*A2x*B2)*BTG-BDNH*UBRY3       &
+     &                 ,BUBM=18.*A1*A1*C1           -BDNM*UBRY3         &
+     &                 ,CUBR=1.                     -     UBRY3         &
+     &                 ,RCUBR=1./CUBR
+!
+!-----------------------------------------------------------------------
+!
+      CONTAINS
+!
+!----------------------------------------------------------------------
+      SUBROUTINE MYJPBL(DT,STEPBL,HT,DZ                                &
+     &                 ,PMID,PINT,TH,T,EXNER,QV,CWM,U,V,RHO            &
+     &                 ,TSK,QSFC,CHKLOWQ,THZ0,QZ0,UZ0,VZ0              &
+     &                 ,LOWLYR,XLAND,SICE,SNOW                         &
+     &                 ,TKE_MYJ,EXCH_H,USTAR,ZNT,EL_MYJ,PBLH,KPBL,CT   &
+     &                 ,AKHS,AKMS,ELFLX                                &
+     &                 ,RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN     &
+     &                 ,IDS,IDE,JDS,JDE,KDS,KDE                        &
+     &                 ,IMS,IME,JMS,JME,KMS,KME                        &
+     &                 ,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: STEPBL
+
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LOWLYR
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: KPBL
+!
+      REAL,INTENT(IN) :: DT
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HT,SICE,SNOW       &
+     &                                             ,TSK,XLAND
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: CWM,DZ     &
+     &                                                     ,EXNER      &
+     &                                                     ,PMID,PINT  &
+     &                                                     ,QV,RHO     &
+     &                                                     ,T,TH,U,V   
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: PBLH
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: AKHS,AKMS
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME)                          &
+     &    ,INTENT(OUT) ::                      EL_MYJ                  &
+     &                                        ,RQCBLTEN,RQVBLTEN       &
+     &                                        ,RTHBLTEN                &
+     &                                        ,RUBLTEN,RVBLTEN        
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CT,QSFC,QZ0     &
+     &                                                ,THZ0,USTAR      &
+     &                                                ,UZ0,VZ0,ZNT
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME)                          &
+     &    ,INTENT(INOUT) ::                    EXCH_H,TKE_MYJ
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CHKLOWQ,ELFLX
+!
+!----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      INTEGER :: I,J,K,KFLIP,LLOW,LMH,LMXL
+!
+      INTEGER,DIMENSION(ITS:ITE,JTS:JTE) :: LPBL
+!
+      REAL :: AKHS_DENS,AKMS_DENS,APEX,DCDT,DELTAZ,DQDT,DTDIF,DTDT     &
+     &       ,DTTURBL,DUDT,DVDT,EXNSFC,PSFC,PTOP,QFC1,QLOW,QOLD        &
+     &       ,RATIOMX,RDTTURBL,RG,RWMSK,SEAMASK,THNEW,THOLD,TX         &
+     &       ,ULOW,VLOW,WMSK
+!
+      REAL,DIMENSION(KTS:KTE) :: CWMK,PK,Q2K,QK,THEK,TK,UK,VK
+!
+      REAL,DIMENSION(KTS:KTE-1) :: AKHK,AKMK,EL,GH,GM
+!
+      REAL,DIMENSION(KTS:KTE+1) :: ZHK
+!
+      REAL,DIMENSION(ITS:ITE,JTS:JTE) :: THSK
+!
+      REAL,DIMENSION(KTS:KTE,ITS:ITE) :: RHOK
+!
+      REAL,DIMENSION(ITS:ITE,KTS:KTE,JTS:JTE) :: APE,THE
+!
+      REAL,DIMENSION(ITS:ITE,KTS:KTE-1,JTS:JTE) :: AKH,AKM
+!
+      REAL,DIMENSION(ITS:ITE,KTS:KTE+1,JTS:JTE) :: ZINT
+!
+!***  Begin debugging
+      REAL :: ZSL_DIAG
+      INTEGER :: IMD,JMD,PRINT_DIAG
+!***  End debugging
+!
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+!***  Begin debugging
+      IMD=(IMS+IME)/2
+      JMD=(JMS+JME)/2
+!***  End debugging
+!
+!***  MAKE PREPARATIONS
+!
+!----------------------------------------------------------------------
+      DTTURBL=DT*STEPBL
+      RDTTURBL=1./DTTURBL
+      DTDIF=DTTURBL
+      RG=1./G
+!
+      DO J=JTS,JTE
+      DO K=KTS,KTE-1
+      DO I=ITS,ITE
+        AKM(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=JTS,JTE
+      DO K=KTS,KTE+1
+      DO I=ITS,ITE
+        ZINT(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        ZINT(I,KTE+1,J)=HT(I,J)     ! Z at bottom of lowest sigma layer
+!
+!!!!!!!!!
+!!!!!! UNCOMMENT THESE LINES IF USING ETA COORDINATES
+!!!!!!!!!
+!!!!!!  ZINT(I,KTE+1,J)=1.E-4       ! Z of bottom of lowest eta layer
+!!!!!!  ZHK(KTE+1)=1.E-4            ! Z of bottom of lowest eta layer
+!
+      ENDDO
+      ENDDO
+!
+      DO J=JTS,JTE
+      DO K=KTE,KTS,-1
+        KFLIP=KTE+1-K
+        DO I=ITS,ITE
+          ZINT(I,K,J)=ZINT(I,K+1,J)+DZ(I,KFLIP,J)
+          APEX=1./EXNER(I,K,J)
+          APE(I,K,J)=APEX
+          TX=T(I,K,J)
+          THE(I,K,J)=(CWM(I,K,J)*(-ELOCP/TX)+1.)*TH(I,K,J)
+        ENDDO
+      ENDDO
+      ENDDO
+!
+      EL_MYJ = 0.
+!
+!----------------------------------------------------------------------
+      setup_integration:  DO J=JTS,JTE
+!----------------------------------------------------------------------
+!
+        DO I=ITS,ITE
+!
+!***  LOWEST LAYER ABOVE GROUND MUST BE FLIPPED
+!
+          LMH=KTE-LOWLYR(I,J)+1
+!
+          PTOP=PINT(I,KTE+1,J)      ! KTE+1=KME
+          PSFC=PINT(I,LOWLYR(I,J),J)
+!
+!***  CONVERT LAND MASK (1 FOR SEA; 0 FOR LAND)
+!
+          SEAMASK=XLAND(I,J)-1.
+!
+!***  FILL 1-D VERTICAL ARRAYS
+!***  AND FLIP DIRECTION SINCE MYJ SCHEME
+!***  COUNTS DOWNWARD FROM THE DOMAIN'S TOP
+!
+          DO K=KTE,KTS,-1
+            KFLIP=KTE+1-K
+            TK(K)=T(I,KFLIP,J)
+            THEK(K)=THE(I,KFLIP,J)
+            RATIOMX=QV(I,KFLIP,J)
+            QK(K)=RATIOMX/(1.+RATIOMX)
+            CWMK(K)=CWM(I,KFLIP,J)
+            PK(K)=PMID(I,KFLIP,J)
+            UK(K)=U(I,KFLIP,J)
+            VK(K)=V(I,KFLIP,J)
+!
+!***  TKE=0.5*(q**2) ==> q**2=2.*TKE
+!
+            Q2K(K)=2.*TKE_MYJ(I,KFLIP,J)
+!
+!***  COMPUTE THE HEIGHTS OF THE LAYER INTERFACES
+!
+            ZHK(K)=ZINT(I,K,J)
+!
+          ENDDO
+          ZHK(KTE+1)=HT(I,J)          ! Z at bottom of lowest sigma layer
+!
+!***  Begin debugging
+!         IF(I==IMD.AND.J==JMD)THEN
+!           PRINT_DIAG=1
+!         ELSE
+!           PRINT_DIAG=0
+!         ENDIF
+!         IF(I==227.AND.J==363)PRINT_DIAG=2
+!***  End debugging
+!
+!----------------------------------------------------------------------
+!***
+!***  FIND THE MIXING LENGTH
+!***
+          CALL MIXLEN(LMH,UK,VK,TK,THEK,QK,CWMK                        &
+     &               ,Q2K,ZHK,GM,GH,EL                                 &
+     &               ,PBLH(I,J),LPBL(I,J),LMXL,CT(I,J)                 &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &               ,IMS,IME,JMS,JME,KMS,KME                          &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+!----------------------------------------------------------------------
+!***
+!***  SOLVE FOR THE PRODUCTION/DISSIPATION OF
+!***  THE TURBULENT KINETIC ENERGY
+!***
+!
+          CALL PRODQ2(LMH,DTTURBL,USTAR(I,J),GM,GH,EL,Q2K              &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &               ,IMS,IME,JMS,JME,KMS,KME                          &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+!----------------------------------------------------------------------
+!*** THE MODEL LAYER (COUNTING UPWARD) CONTAINING THE TOP OF THE PBL
+!----------------------------------------------------------------------
+!
+          KPBL(I,J)=KTE-LPBL(I,J)+1
+!
+!----------------------------------------------------------------------
+!***
+!***  FIND THE EXCHANGE COEFFICIENTS IN THE FREE ATMOSPHERE
+!***
+          CALL DIFCOF(LMH,LMXL,GM,GH,EL,TK,Q2K,ZHK,AKMK,AKHK      &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &               ,IMS,IME,JMS,JME,KMS,KME                          &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE,PRINT_DIAG)   ! debug
+!
+!***  COUNTING DOWNWARD FROM THE TOP, THE EXCHANGE COEFFICIENTS AKH 
+!***  ARE DEFINED ON THE BOTTOMS OF THE LAYERS KTS TO KTE-1.  COUNTING 
+!***  COUNTING UPWARD FROM THE BOTTOM, THOSE SAME COEFFICIENTS EXCH_H
+!***  ARE DEFINED ON THE TOPS OF THE LAYERS KTS TO KTE-1.
+!
+          DO K=KTS,KTE-1
+            KFLIP=KTE-K
+            AKH(I,K,J)=AKHK(K)
+            AKM(I,K,J)=AKMK(K)
+            DELTAZ=0.5*(ZHK(KFLIP)-ZHK(KFLIP+2))
+            EXCH_H(I,K,J)=AKHK(KFLIP)*DELTAZ
+          ENDDO
+!
+!----------------------------------------------------------------------
+!***
+!***  CARRY OUT THE VERTICAL DIFFUSION OF
+!***  TURBULENT KINETIC ENERGY
+!***
+!
+          CALL VDIFQ(LMH,DTDIF,Q2K,EL,ZHK                              &
+     &              ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &              ,IMS,IME,JMS,JME,KMS,KME                           &
+     &              ,ITS,ITE,JTS,JTE,KTS,KTE)
+!
+!***  SAVE THE NEW TKE AND MIXING LENGTH.
+!
+          DO K=KTS,KTE
+            KFLIP=KTE+1-K
+            Q2K(KFLIP)=AMAX1(Q2K(KFLIP),EPSQ2)
+            TKE_MYJ(I,K,J)=0.5*Q2K(KFLIP)
+            IF(K<KTE)EL_MYJ(I,K,J)=EL(K)   ! EL IS NOT DEFINED AT KTE
+          ENDDO
+!
+        ENDDO
+!
+!----------------------------------------------------------------------
+      ENDDO setup_integration
+!----------------------------------------------------------------------
+!
+!***  CONVERT SURFACE SENSIBLE TEMPERATURE TO POTENTIAL TEMPERATURE.
+!
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        PSFC=PINT(I,LOWLYR(I,J),J)
+        THSK(I,J)=TSK(I,J)*(1.E5/PSFC)**CAPA
+      ENDDO
+      ENDDO
+!
+!----------------------------------------------------------------------
+!
+!----------------------------------------------------------------------
+      main_integration:  DO J=JTS,JTE
+!----------------------------------------------------------------------
+!
+        DO I=ITS,ITE
+!
+!***  FILL 1-D VERTICAL ARRAYS
+!***  AND FLIP DIRECTION SINCE MYJ SCHEME
+!***  COUNTS DOWNWARD FROM THE DOMAIN'S TOP
+!
+          DO K=KTE,KTS,-1
+            KFLIP=KTE+1-K
+            THEK(K)=THE(I,KFLIP,J)
+            RATIOMX=QV(I,KFLIP,J)
+            QK(K)=RATIOMX/(1.+RATIOMX)
+            CWMK(K)=CWM(I,KFLIP,J)
+            ZHK(K)=ZINT(I,K,J)
+            RHOK(K,I)=PMID(I,KFLIP,J)/(R_D*T(I,KFLIP,J)*               &
+     &                                (1.+P608*QK(K)-CWMK(K)))
+          ENDDO
+!
+!***  COUNTING DOWNWARD FROM THE TOP, THE EXCHANGE COEFFICIENTS AKH
+!***  ARE DEFINED ON THE BOTTOMS OF THE LAYERS KTS TO KTE-1.  THESE COEFFICIENTS
+!***  ARE ALSO MULTIPLIED BY THE DENSITY AT THE BOTTOM INTERFACE LEVEL.
+!
+          DO K=KTS,KTE-1
+            AKHK(K)=AKH(I,K,J)*0.5*(RHOK(K,I)+RHOK(K+1,I))
+          ENDDO
+!
+          ZHK(KTE+1)=ZINT(I,KTE+1,J)
+!
+          SEAMASK=XLAND(I,J)-1.
+          THZ0(I,J)=(1.-SEAMASK)*THSK(I,J)+SEAMASK*THZ0(I,J)
+!
+          LLOW=LOWLYR(I,J)
+          AKHS_DENS=AKHS(I,J)*RHOK(KTE+1-LLOW,I)
+!
+          IF(SEAMASK<0.5)THEN
+            QFC1=XLV*CHKLOWQ(I,J)*AKHS_DENS
+!
+            IF(SNOW(I,J)>0..OR.SICE(I,J)>0.5)THEN
+              QFC1=QFC1*RLIVWV
+            ENDIF
+!
+            IF(QFC1>0.)THEN
+              QLOW=QK(KTE+1-LLOW)
+              QSFC(I,J)=QLOW+ELFLX(I,J)/QFC1
+            ENDIF
+!
+          ELSE
+            PSFC=PINT(I,LOWLYR(I,J),J)
+            EXNSFC=(1.E5/PSFC)**CAPA
+            QSFC(I,J)=PQ0SEA/PSFC                                      &
+     &         *EXP(A2*(THSK(I,J)-A3*EXNSFC)/(THSK(I,J)-A4*EXNSFC))
+          ENDIF
+!
+          QZ0 (I,J)=(1.-SEAMASK)*QSFC(I,J)+SEAMASK*QZ0 (I,J)
+!
+!***  LOWEST LAYER ABOVE GROUND MUST BE FLIPPED
+!
+          LMH=KTE-LOWLYR(I,J)+1
+!
+!----------------------------------------------------------------------
+!***  CARRY OUT THE VERTICAL DIFFUSION OF
+!***  TEMPERATURE AND WATER VAPOR
+!----------------------------------------------------------------------
+!
+          CALL VDIFH(DTDIF,LMH,THZ0(I,J),QZ0(I,J)                      &
+     &              ,AKHS_DENS,CHKLOWQ(I,J),CT(I,J)                    &
+     &              ,THEK,QK,CWMK,AKHK,ZHK,RHOK(KTS,I)                 &
+     &              ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &              ,IMS,IME,JMS,JME,KMS,KME                           &
+     &              ,ITS,ITE,JTS,JTE,KTS,KTE,I,J)
+!----------------------------------------------------------------------
+!***
+!***  COMPUTE PRIMARY VARIABLE TENDENCIES
+!***
+          DO K=KTS,KTE
+            KFLIP=KTE+1-K
+            THOLD=TH(I,K,J)
+            THNEW=THEK(KFLIP)+CWMK(KFLIP)*ELOCP*APE(I,K,J)
+            DTDT=(THNEW-THOLD)*RDTTURBL
+            QOLD=QV(I,K,J)/(1.+QV(I,K,J))
+            DQDT=(QK(KFLIP)-QOLD)*RDTTURBL
+            DCDT=(CWMK(KFLIP)-CWM(I,K,J))*RDTTURBL
+!
+            RTHBLTEN(I,K,J)=DTDT
+            RQVBLTEN(I,K,J)=DQDT/(1.-QK(KFLIP))**2
+            RQCBLTEN(I,K,J)=DCDT
+          ENDDO
+!
+!*** Begin debugging
+!         IF(I==IMD.AND.J==JMD)THEN
+!           PRINT_DIAG=0
+!         ELSE
+!           PRINT_DIAG=0
+!         ENDIF
+!         IF(I==227.AND.J==363)PRINT_DIAG=0
+!*** End debugging
+!
+        PSFC=.01*PINT(I,LOWLYR(I,J),J)
+        ZSL_DIAG=0.5*DZ(I,1,J)
+!
+!*** Begin debugging
+!         IF(PRINT_DIAG==1)THEN
+!
+!           write(6,"(a, 2i5, 2i3, 2f8.2, f6.2, 2f8.2)") &
+!           '{turb4 i,j, Kpbl, Kmxl, Psfc, Zsfc, Zsl, Zpbl, Zmxl = ' &
+!           , i, j, KPBL(i,j), KTE-LMXL+1, PSFC, ZHK(LMH+1), ZSL_diag  &
+!           , PBLH(i,j), ZHK(LMXL)-ZHK(LMH+1)
+!           write(6,"(a, 2f7.2, f7.3, 3e11.4)") &
+!           '{turb4 tsk, thsk, qz0, q**2_0, akhs, exch_0 = ' &
+!           , tsk(i,j)-273.15, thsk(i,j), 1000.*qz0(i,j) &
+!           , 2.*tke_myj(i,1,j), akhs(i,j), akhs(i,j)*ZSL_diag
+!           write(6,"(a)") &
+!           '{turb5 k, Pmid, Pint_1, Tc, TH, DTH, GH, GM, EL, Q**2, Akh, EXCH_h, Dz, Dp'
+!           do k=kts,kte/2
+!             KFLIP=KTE-K   !-- Includes the KFLIP-1 in earlier versions
+!             write(6,"(a,i3, 2f8.2, 2f8.3, 3e12.4, 4e11.4, f7.2, f6.2)") &
+!            '{turb5 ', k, .01*pmid(i,k,j),.01*pint(i,k,j), T(i,k,j)-273.15 &
+!            , th(i,k,j), DTTURBL*rthblten(i,k,j), GH(KFLIP), GM(KFLIP) &
+!            , el_myj(i,KFLIP,j), 2.*tke_myj(i,k+1,j), akh(i,KFLIP,j) &
+!            , exch_h(i,k,j), dz(i,k,j), .01*(pint(i,k,j)-pint(i,k+1,j))
+!           enddo
+!
+!         ELSEIF(PRINT_DIAG==2)THEN
+!
+!           write(6,"(a, 2i5, 2i3, 2f8.2, f6.2, 2f8.2)") &
+!           '}turb4 i,j, Kpbl, Kmxl, Psfc, Zsfc, Zsl, Zpbl, Zmxl = ' &
+!           , i, j, KPBL(i,j), KTE-LMXL+1, PSFC, ZHK(LMH+1), ZSL_diag  &
+!           , PBLH(i,j), ZHK(LMXL)-ZHK(LMH+1)
+!           write(6,"(a, 2f7.2, f7.3, 3e11.4)") &
+!           '}turb4 tsk, thsk, qz0, q**2_0, akhs, exch_0 = ' &
+!           , tsk(i,j)-273.15, thsk(i,j), 1000.*qz0(i,j) &
+!           , 2.*tke_myj(i,1,j), akhs(i,j), akhs(i,j)*ZSL_diag
+!           write(6,"(a)") &
+!           '}turb5 k, Pmid, Pint_1, Tc, TH, DTH, GH, GM, EL, Q**2, Akh, EXCH_h, Dz, Dp'
+!           do k=kts,kte/2
+!             KFLIP=KTE-K   !-- Includes the KFLIP-1 in earlier versions
+!             write(6,"(a,i3, 2f8.2, 2f8.3, 3e12.4, 4e11.4, f7.2, f6.2)") &
+!            '}turb5 ', k, .01*pmid(i,k,j),.01*pint(i,k,j), T(i,k,j)-273.15 &
+!            , th(i,k,j), DTTURBL*rthblten(i,k,j), GH(KFLIP), GM(KFLIP) &
+!            , el_myj(i,KFLIP,j), 2.*tke_myj(i,k+1,j), akh(i,KFLIP,j) &
+!            , exch_h(i,k,j), dz(i,k,j), .01*(pint(i,k,j)-pint(i,k+1,j))
+!           enddo
+!         ENDIF
+!*** End debugging
+!
+!----------------------------------------------------------------------
+        ENDDO
+!----------------------------------------------------------------------
+        DO I=ITS,ITE
+!
+!***  FILL 1-D VERTICAL ARRAYS
+!***  AND FLIP DIRECTION SINCE MYJ SCHEME
+!***  COUNTS DOWNWARD FROM THE DOMAIN'S TOP
+!
+          DO K=KTS,KTE-1
+            AKMK(K)=AKM(I,K,J)
+            AKMK(K)=AKMK(K)*(RHOK(K,I)+RHOK(K+1,I))*0.5
+          ENDDO
+!
+          LLOW=LOWLYR(I,J)
+          AKMS_DENS=AKMS(I,J)*RHOK(KTE+1-LLOW,I)
+!
+          DO K=KTE,KTS,-1
+            KFLIP=KTE+1-K
+            UK(K)=U(I,KFLIP,J)
+            VK(K)=V(I,KFLIP,J)
+            ZHK(K)=ZINT(I,K,J)
+          ENDDO
+          ZHK(KTE+1)=ZINT(I,KTE+1,J)
+!
+!----------------------------------------------------------------------
+!***  CARRY OUT THE VERTICAL DIFFUSION OF
+!***  VELOCITY COMPONENTS
+!----------------------------------------------------------------------
+!
+          CALL VDIFV(LMH,DTDIF,UZ0(I,J),VZ0(I,J)                       &
+     &              ,AKMS_DENS,UK,VK,AKMK,ZHK,RHOK(KTS,I)              &
+     &              ,IDS,IDE,JDS,JDE,KDS,KDE                           &
+     &              ,IMS,IME,JMS,JME,KMS,KME                           &
+     &              ,ITS,ITE,JTS,JTE,KTS,KTE,I,J)
+!
+!----------------------------------------------------------------------
+!***
+!***  COMPUTE PRIMARY VARIABLE TENDENCIES
+!***
+          DO K=KTS,KTE
+            KFLIP=KTE+1-K
+            DUDT=(UK(KFLIP)-U(I,K,J))*RDTTURBL
+            DVDT=(VK(KFLIP)-V(I,K,J))*RDTTURBL
+            RUBLTEN(I,K,J)=DUDT
+            RVBLTEN(I,K,J)=DVDT
+          ENDDO
+!
+        ENDDO
+!----------------------------------------------------------------------
+!
+      ENDDO main_integration
+!
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE MYJPBL
+!
+!----------------------------------------------------------------------
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!----------------------------------------------------------------------
+                          SUBROUTINE MIXLEN                            &
+!----------------------------------------------------------------------
+!   ******************************************************************
+!   *                                                                *
+!   *                   LEVEL 2.5 MIXING LENGTH                      *
+!   *                                                                *
+!   ******************************************************************
+!
+     &(LMH,U,V,T,THE,Q,CWM,Q2,Z,GM,GH,EL,PBLH,LPBL,LMXL,CT             &
+     &,IDS,IDE,JDS,JDE,KDS,KDE                                         &
+     &,IMS,IME,JMS,JME,KMS,KME                                         &
+     &,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: LMH
+!
+      INTEGER,INTENT(OUT) :: LMXL,LPBL
+!
+      REAL,DIMENSION(KTS:KTE),INTENT(IN) :: CWM,Q,Q2,T,THE,U,V
+!
+      REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z
+!
+      REAL,INTENT(OUT) :: PBLH
+!
+      REAL,DIMENSION(KTS:KTE-1),INTENT(OUT) :: EL,GH,GM
+!
+      REAL,INTENT(INOUT) :: CT
+!----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      INTEGER :: K,LPBLM
+!
+      REAL :: A,ADEN,B,BDEN,AUBR,BUBR,BLMX,EL0,ELOQ2X,GHL,GML           &
+     &       ,QOL2ST,QOL2UN,QDZL,RDZ,SQ,SREL,SZQ,TEM,THM,VKRMZ
+!
+      REAL,DIMENSION(KTS:KTE) :: Q1
+!
+      REAL,DIMENSION(KTS:KTE-1) :: DTH,ELM,REL
+!
+!----------------------------------------------------------------------
+!**********************************************************************
+!--------------FIND THE HEIGHT OF THE PBL-------------------------------
+      LPBL=LMH
+!
+      DO K=LMH-1,1,-1
+        IF(Q2(K)<=EPSQ2*FH)THEN
+          LPBL=K
+          GO TO 110
+        ENDIF
+      ENDDO
+!
+      LPBL=1
+!
+!--------------THE HEIGHT OF THE PBL------------------------------------
+!
+ 110  PBLH=Z(LPBL)-Z(LMH+1)
+!
+!-----------------------------------------------------------------------
+      DO K=KTS,LMH
+        Q1(K)=0.
+      ENDDO
+!
+      DO K=1,LMH-1
+        DTH(K)=THE(K)-THE(K+1)
+      ENDDO
+!
+      DO K=LMH-2,1,-1
+        IF(DTH(K)>0..AND.DTH(K+1)<=0.)THEN
+          DTH(K)=DTH(K)+CT
+          EXIT
+        ENDIF
+      ENDDO
+!
+      CT=0.
+!----------------------------------------------------------------------
+      DO K=KTS,LMH-1
+        RDZ=2./(Z(K)-Z(K+2))
+        GML=((U(K)-U(K+1))**2+(V(K)-V(K+1))**2)*RDZ*RDZ
+        GM(K)=MAX(GML,EPSGM)
+!
+        TEM=(T(K)+T(K+1))*0.5
+        THM=(THE(K)+THE(K+1))*0.5
+!
+        A=THM*P608
+        B=(ELOCP/TEM-1.-P608)*THM
+!
+        GHL=(DTH(K)*((Q(K)+Q(K+1)+CWM(K)+CWM(K+1))*(0.5*P608)+1.)      &
+     &     +(Q(K)-Q(K+1)+CWM(K)-CWM(K+1))*A                            &
+     &     +(CWM(K)-CWM(K+1))*B)*RDZ
+!
+        IF(ABS(GHL)<=EPSGH)GHL=EPSGH
+        GH(K)=GHL
+      ENDDO
+!
+!----------------------------------------------------------------------
+!***  FIND MAXIMUM MIXING LENGTHS AND THE LEVEL OF THE PBL TOP
+!----------------------------------------------------------------------
+!
+      LMXL=LMH
+!
+      DO K=KTS,LMH-1
+        GML=GM(K)
+        GHL=GH(K)
+!
+        IF(GHL>=EPSGH)THEN
+          IF(GML/GHL<=REQU)THEN
+            ELM(K)=EPSL
+            LMXL=K
+          ELSE
+            AUBR=(AUBM*GML+AUBH*GHL)*GHL
+            BUBR= BUBM*GML+BUBH*GHL
+            QOL2ST=(-0.5*BUBR+SQRT(BUBR*BUBR*0.25-AUBR*CUBR))*RCUBR
+            ELOQ2X=1./QOL2ST
+            ELM(K)=MAX(SQRT(ELOQ2X*Q2(K)),EPSL)
+          ENDIF
+        ELSE
+          ADEN=(ADNM*GML+ADNH*GHL)*GHL
+          BDEN= BDNM*GML+BDNH*GHL
+          QOL2UN=-0.5*BDEN+SQRT(BDEN*BDEN*0.25-ADEN)
+          ELOQ2X=1./(QOL2UN+EPSRU)       ! repsr1/qol2un
+          ELM(K)=MAX(SQRT(ELOQ2X*Q2(K)),EPSL)
+        ENDIF
+      ENDDO
+!
+      IF(ELM(LMH-1)==EPSL)LMXL=LMH
+!
+!----------------------------------------------------------------------
+!***  THE HEIGHT OF THE MIXED LAYER
+!----------------------------------------------------------------------
+!
+      BLMX=Z(LMXL)-Z(LMH+1)
+!
+!----------------------------------------------------------------------
+      DO K=LPBL,LMH
+        Q1(K)=SQRT(Q2(K))
+      ENDDO
+!----------------------------------------------------------------------
+      SZQ=0.
+      SQ =0.
+!
+      DO K=KTS,LMH-1
+        QDZL=(Q1(K)+Q1(K+1))*(Z(K+1)-Z(K+2))
+        SZQ=(Z(K+1)+Z(K+2)-Z(LMH+1)-Z(LMH+1))*QDZL+SZQ
+        SQ=QDZL+SQ
+      ENDDO
+!
+!----------------------------------------------------------------------
+!***  COMPUTATION OF ASYMPTOTIC L IN BLACKADAR FORMULA
+!----------------------------------------------------------------------
+!
+      EL0=MIN(ALPH*SZQ*0.5/SQ,EL0MAX)
+      EL0=MAX(EL0            ,EL0MIN)
+!
+!----------------------------------------------------------------------
+!***  ABOVE THE PBL TOP
+!----------------------------------------------------------------------
+!
+      LPBLM=MAX(LPBL-1,1)
+!
+      DO K=KTS,LPBLM
+        EL(K)=MIN((Z(K)-Z(K+2))*ELFC,ELM(K))
+        REL(K)=EL(K)/ELM(K)
+      ENDDO
+!
+!----------------------------------------------------------------------
+!***  INSIDE THE PBL
+!----------------------------------------------------------------------
+!
+      IF(LPBL<LMH)THEN
+        DO K=LPBL,LMH-1
+          VKRMZ=(Z(K+1)-Z(LMH+1))*VKARMAN
+          EL(K)=MIN(VKRMZ/(VKRMZ/EL0+1.),ELM(K))
+          REL(K)=EL(K)/ELM(K)
+        ENDDO
+      ENDIF
+!
+      DO K=LPBL+1,LMH-2
+        SREL=MIN(((REL(K-1)+REL(K+1))*0.5+REL(K))*0.5,REL(K))
+        EL(K)=MAX(SREL*ELM(K),EPSL)
+      ENDDO
+!
+!----------------------------------------------------------------------
+      END SUBROUTINE MIXLEN
+!----------------------------------------------------------------------
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!----------------------------------------------------------------------
+                          SUBROUTINE PRODQ2                            &
+!----------------------------------------------------------------------
+!   ******************************************************************
+!   *                                                                *
+!   *            LEVEL 2.5 Q2 PRODUCTION/DISSIPATION                 *
+!   *                                                                *
+!   ******************************************************************
+!
+     &(LMH,DTTURBL,USTAR,GM,GH,EL,Q2                                   &
+     &,IDS,IDE,JDS,JDE,KDS,KDE                                         &
+     &,IMS,IME,JMS,JME,KMS,KME                                         &
+     &,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: DTTURBL,USTAR
+!
+      REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: GH,GM
+      REAL,DIMENSION(KTS:KTE-1),INTENT(INOUT) :: EL
+!
+      REAL,DIMENSION(KTS:KTE),INTENT(INOUT) :: Q2
+!----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      INTEGER :: K
+!
+      REAL :: ADEN,AEQU,ANUM,ARHS,BDEN,BEQU,BNUM,BRHS,CDEN,CRHS        &
+     &       ,DLOQ1,ELOQ11,ELOQ12,ELOQ13,ELOQ21,ELOQ22,ELOQ31,ELOQ32   &
+     &       ,ELOQ41,ELOQ42,ELOQ51,ELOQ52,ELOQN,EQOL2,GHL,GML          &
+     &       ,RDEN1,RDEN2,RHS2,RHSP1,RHSP2,RHST2
+!
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+      main_integration: DO K=1,LMH-1
+        GML=GM(K)
+        GHL=GH(K)
+!
+!----------------------------------------------------------------------
+!***  COEFFICIENTS OF THE EQUILIBRIUM EQUATION
+!----------------------------------------------------------------------
+!
+        AEQU=(AEQM*GML+AEQH*GHL)*GHL
+        BEQU= BEQM*GML+BEQH*GHL
+!
+!----------------------------------------------------------------------
+!***  EQUILIBRIUM SOLUTION FOR L/Q
+!----------------------------------------------------------------------
+!
+        EQOL2=-0.5*BEQU+SQRT(BEQU*BEQU*0.25-AEQU)
+!
+!----------------------------------------------------------------------
+!***  IS THERE PRODUCTION/DISSIPATION ?
+!----------------------------------------------------------------------
+!
+        IF((GML+GHL*GHL<=EPSTRB)                                       &
+     &   .OR.(GHL>=EPSGH.AND.GML/GHL<=REQU)                            &
+     &   .OR.(EQOL2<=EPS2))THEN
+!
+!----------------------------------------------------------------------
+!***  NO TURBULENCE
+!----------------------------------------------------------------------
+!
+          Q2(K)=EPSQ2
+          EL(K)=EPSL
+!----------------------------------------------------------------------
+!
+        ELSE
+!
+!----------------------------------------------------------------------
+!***  TURBULENCE
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!***  COEFFICIENTS OF THE TERMS IN THE NUMERATOR
+!----------------------------------------------------------------------
+!
+          ANUM=(ANMM*GML+ANMH*GHL)*GHL
+          BNUM= BNMM*GML+BNMH*GHL
+!
+!----------------------------------------------------------------------
+!***  COEFFICIENTS OF THE TERMS IN THE DENOMINATOR
+!----------------------------------------------------------------------
+!
+          ADEN=(ADNM*GML+ADNH*GHL)*GHL
+          BDEN= BDNM*GML+BDNH*GHL
+          CDEN= 1.
+!
+!----------------------------------------------------------------------
+!***  COEFFICIENTS OF THE NUMERATOR OF THE LINEARIZED EQ.
+!----------------------------------------------------------------------
+!
+          ARHS=-(ANUM*BDEN-BNUM*ADEN)*2.
+          BRHS=- ANUM*4.
+          CRHS=- BNUM*2.
+!
+!----------------------------------------------------------------------
+!***  INITIAL VALUE OF L/Q
+!----------------------------------------------------------------------
+!
+          DLOQ1=EL(K)/SQRT(Q2(K))
+!
+!----------------------------------------------------------------------
+!***  FIRST ITERATION FOR L/Q, RHS=0
+!----------------------------------------------------------------------
+!
+          ELOQ21=1./EQOL2
+          ELOQ11=SQRT(ELOQ21)
+          ELOQ31=ELOQ21*ELOQ11
+          ELOQ41=ELOQ21*ELOQ21
+          ELOQ51=ELOQ21*ELOQ31
+!
+!----------------------------------------------------------------------
+!***  1./DENOMINATOR
+!----------------------------------------------------------------------
+!
+          RDEN1=1./(ADEN*ELOQ41+BDEN*ELOQ21+CDEN)
+!
+!----------------------------------------------------------------------
+!***  D(RHS)/D(L/Q)
+!----------------------------------------------------------------------
+!
+          RHSP1=(ARHS*ELOQ51+BRHS*ELOQ31+CRHS*ELOQ11)*RDEN1*RDEN1
+!
+!----------------------------------------------------------------------
+!***  FIRST-GUESS SOLUTION
+!----------------------------------------------------------------------
+!
+          ELOQ12=ELOQ11+(DLOQ1-ELOQ11)*EXP(RHSP1*DTTURBL)
+          ELOQ12=MAX(ELOQ12,EPS1)
+!
+!----------------------------------------------------------------------
+!***  SECOND ITERATION FOR L/Q
+!----------------------------------------------------------------------
+!
+          ELOQ22=ELOQ12*ELOQ12
+          ELOQ32=ELOQ22*ELOQ12
+          ELOQ42=ELOQ22*ELOQ22
+          ELOQ52=ELOQ22*ELOQ32
+!
+!----------------------------------------------------------------------
+!***  1./DENOMINATOR
+!----------------------------------------------------------------------
+!
+          RDEN2=1./(ADEN*ELOQ42+BDEN*ELOQ22+CDEN)
+          RHS2 =-(ANUM*ELOQ42+BNUM*ELOQ22)*RDEN2+RB1
+          RHSP2= (ARHS*ELOQ52+BRHS*ELOQ32+CRHS*ELOQ12)*RDEN2*RDEN2
+          RHST2=RHS2/RHSP2
+!
+!----------------------------------------------------------------------
+!***  CORRECTED SOLUTION
+!----------------------------------------------------------------------
+!
+          ELOQ13=ELOQ12-RHST2+(RHST2+DLOQ1-ELOQ12)*EXP(RHSP2*DTTURBL)
+          ELOQ13=AMAX1(ELOQ13,EPS1)
+!
+!----------------------------------------------------------------------
+!***  TWO ITERATIONS IS ENOUGH IN MOST CASES ...
+!----------------------------------------------------------------------
+!
+          ELOQN=ELOQ13
+!
+          IF(ELOQN>EPS1)THEN
+            Q2(K)=EL(K)*EL(K)/(ELOQN*ELOQN)
+            Q2(K)=AMAX1(Q2(K),EPSQ2)
+            IF(Q2(K)==EPSQ2)THEN
+              EL(K)=EPSL
+            ENDIF
+          ELSE
+            Q2(K)=EPSQ2
+            EL(K)=EPSL
+          ENDIF
+!
+!----------------------------------------------------------------------
+!***  END OF TURBULENT BRANCH
+!----------------------------------------------------------------------
+!
+        ENDIF
+!----------------------------------------------------------------------
+!***  END OF PRODUCTION/DISSIPATION LOOP
+!----------------------------------------------------------------------
+!
+      ENDDO main_integration
+!
+!----------------------------------------------------------------------
+!***  LOWER BOUNDARY CONDITION FOR Q2
+!----------------------------------------------------------------------
+!
+      Q2(LMH)=AMAX1(B1**(2./3.)*USTAR*USTAR,EPSQ2)
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE PRODQ2
+!
+!----------------------------------------------------------------------
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!----------------------------------------------------------------------
+                           SUBROUTINE DIFCOF                           &
+!   ******************************************************************
+!   *                                                                *
+!   *                LEVEL 2.5 DIFFUSION COEFFICIENTS                *
+!   *                                                                *
+!   ******************************************************************
+     &(LMH,LMXL,GM,GH,EL,T,Q2,Z,AKM,AKH                                &
+     &,IDS,IDE,JDS,JDE,KDS,KDE                                         &
+     &,IMS,IME,JMS,JME,KMS,KME                                         &
+     &,ITS,ITE,JTS,JTE,KTS,KTE,PRINT_DIAG)   ! debug
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: LMH,LMXL
+!
+      REAL,DIMENSION(KTS:KTE),INTENT(IN) :: Q2,T
+      REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: EL,GH,GM
+      REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z
+!
+      REAL,DIMENSION(KTS:KTE-1),INTENT(OUT) :: AKH,AKM
+!----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      INTEGER :: K,KINV
+!
+      REAL :: ADEN,AKMIN,BDEN,BESH,BESM,CDEN,D2T,ELL,ELOQ2,ELOQ4,ELQDZ &
+     &       ,ESH,ESM,GHL,GML,Q1L,RDEN,RDZ
+!
+!*** Begin debugging
+      INTEGER,INTENT(IN) :: PRINT_DIAG
+!     REAL :: D2Tmin
+!*** End debugging
+!
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+      DO K=1,LMH-1
+        ELL=EL(K)
+!
+        ELOQ2=ELL*ELL/Q2(K)
+        ELOQ4=ELOQ2*ELOQ2
+!
+        GML=GM(K)
+        GHL=GH(K)
+!
+!----------------------------------------------------------------------
+!***  COEFFICIENTS OF THE TERMS IN THE DENOMINATOR
+!----------------------------------------------------------------------
+!
+        ADEN=(ADNM*GML+ADNH*GHL)*GHL
+        BDEN= BDNM*GML+BDNH*GHL
+        CDEN= 1.
+!
+!----------------------------------------------------------------------
+!***  COEFFICIENTS FOR THE SM DETERMINANT
+!----------------------------------------------------------------------
+!
+        BESM=BSMH*GHL
+!
+!----------------------------------------------------------------------
+!***  COEFFICIENTS FOR THE SH DETERMINANT
+!----------------------------------------------------------------------
+!
+        BESH=BSHM*GML+BSHH*GHL
+!
+!----------------------------------------------------------------------
+!***  1./DENOMINATOR
+!----------------------------------------------------------------------
+!
+        RDEN=1./(ADEN*ELOQ4+BDEN*ELOQ2+CDEN)
+!
+!----------------------------------------------------------------------
+!***  SM AND SH
+!----------------------------------------------------------------------
+!
+        ESM=(BESM*ELOQ2+CESM)*RDEN
+        ESH=(BESH*ELOQ2+CESH)*RDEN
+!
+!----------------------------------------------------------------------
+!***  DIFFUSION COEFFICIENTS
+!----------------------------------------------------------------------
+!
+        RDZ=2./(Z(K)-Z(K+2))
+        Q1L=SQRT(Q2(K))
+        ELQDZ=ELL*Q1L*RDZ
+        AKM(K)=ELQDZ*ESM
+        AKH(K)=ELQDZ*ESH
+!----------------------------------------------------------------------
+      ENDDO
+!----------------------------------------------------------------------
+!
+!----------------------------------------------------------------------
+!***  INVERSIONS
+!----------------------------------------------------------------------
+!
+!     IF(LMXL==LMH)THEN
+!       KINV=LMH
+!       D2Tmin=0.
+!
+!       DO K=LMH/2,LMH-1
+!         D2T=T(K-1)-2.*T(K)+T(K+1)
+!         IF(D2T<D2Tmin)THEN
+!           D2Tmin=D2T
+!           IF(D2T<0)KINV=K
+!         ENDIF
+!       ENDDO
+!
+!       IF(KINV<LMH)THEN
+!         DO K=KINV-1,LMH-1
+!           RDZ=2./(Z(K)-Z(K+2))
+!           AKMIN=0.5*RDZ
+!           AKM(K)=MAX(AKM(K),AKMIN)
+!           AKH(K)=MAX(AKH(K),AKMIN)
+!         ENDDO
+!
+!*** Begin debugging
+!         IF(PRINT_DIAG>0)THEN
+!           write(6,"(a,3i3)") '{turb1 lmxl,lmh,kinv=',lmxl,lmh,kinv
+!           write(6,"(a,3i3)") '}turb1 lmxl,lmh,kinv=',lmxl,lmh,kinv
+!           IF(PRINT_DIAG==1)THEN
+!             write(6,"(a)") &
+!               '{turb3 k, t, d2t, rdz, z(k), z(k+2), akmin, akh '
+!           ELSE
+!             write(6,"(a)") &
+!               '}turb3 k, t, d2t, rdz, z(k), z(k+2), akmin, akh '
+!           ENDIF
+!           DO K=LMH-1,KINV-1,-1
+!             D2T=T(K-1)-2.*T(K)+T(K+1)
+!             RDZ=2./(Z(K)-Z(K+2))
+!             AKMIN=0.5*RDZ
+!             IF(PRINT_DIAG==1)THEN
+!               write(6,"(a,i3,f8.3,2e12.5,2f9.2,2e12.5)") '{turb3 ' &
+!               ,k,t(k)-273.15,d2t,rdz,z(k),z(k+2),akmin,akh(k)
+!             ELSE
+!               write(6,"(a,i3,f8.3,2e12.5,2f9.2,2e12.5)") '}turb3 ' &
+!               ,k,t(k)-273.15,d2t,rdz,z(k),z(k+2),akmin,akh(k)
+!             ENDIF
+!           ENDDO
+!         ENDIF     !- IF (print_diag > 0) THEN
+!       ENDIF       !- IF(KINV<LMH)THEN
+!*** End debugging
+!
+!     ENDIF
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE DIFCOF
+!
+!----------------------------------------------------------------------
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!----------------------------------------------------------------------
+                           SUBROUTINE VDIFQ                            &
+!   ******************************************************************
+!   *                                                                *
+!   *               VERTICAL DIFFUSION OF Q2 (TKE)                   *
+!   *                                                                *
+!   ******************************************************************
+     &(LMH,DTDIF,Q2,EL,Z                                               &
+     &,IDS,IDE,JDS,JDE,KDS,KDE                                         &
+     &,IMS,IME,JMS,JME,KMS,KME                                         &
+     &,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: DTDIF
+!
+      REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: EL
+      REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z
+!
+      REAL,DIMENSION(KTS:KTE),INTENT(INOUT) :: Q2
+!----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      INTEGER :: K
+!
+      REAL :: ADEN,AKQS,BDEN,BESH,BESM,CDEN,CF,DTOZS,ELL,ELOQ2,ELOQ4   &
+     &       ,ELQDZ,ESH,ESM,ESQHF,GHL,GML,Q1L,RDEN,RDZ
+!
+      REAL,DIMENSION(KTS:KTE-2) :: AKQ,CM,CR,DTOZ,RSQ2
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+!***
+!***  VERTICAL TURBULENT DIFFUSION
+!***
+!----------------------------------------------------------------------
+      ESQHF=0.5*ESQ
+!
+      DO K=KTS,LMH-2
+        DTOZ(K)=(DTDIF+DTDIF)/(Z(K)-Z(K+2))
+        AKQ(K)=SQRT((Q2(K)+Q2(K+1))*0.5)*(EL(K)+EL(K+1))*ESQHF         &
+     &        /(Z(K+1)-Z(K+2))
+        CR(K)=-DTOZ(K)*AKQ(K)
+      ENDDO
+!
+      CM(1)=DTOZ(1)*AKQ(1)+1.
+      RSQ2(1)=Q2(1)
+!
+      DO K=KTS+1,LMH-2
+        CF=-DTOZ(K)*AKQ(K-1)/CM(K-1)
+        CM(K)=-CR(K-1)*CF+(AKQ(K-1)+AKQ(K))*DTOZ(K)+1.
+        RSQ2(K)=-RSQ2(K-1)*CF+Q2(K)
+      ENDDO
+!
+      DTOZS=(DTDIF+DTDIF)/(Z(LMH-1)-Z(LMH+1))
+      AKQS=SQRT((Q2(LMH-1)+Q2(LMH))*0.5)*(EL(LMH-1)+ELZ0)*ESQHF        &
+     &    /(Z(LMH)-Z(LMH+1))
+!
+      CF=-DTOZS*AKQ(LMH-2)/CM(LMH-2)
+!
+      Q2(LMH-1)=(DTOZS*AKQS*Q2(LMH)-RSQ2(LMH-2)*CF+Q2(LMH-1))          &
+     &        /((AKQ(LMH-2)+AKQS)*DTOZS-CR(LMH-2)*CF+1.)
+!
+      DO K=LMH-2,KTS,-1
+        Q2(K)=(-CR(K)*Q2(K+1)+RSQ2(K))/CM(K)
+      ENDDO
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE VDIFQ
+!
+!----------------------------------------------------------------------
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!---------------------------------------------------------------------
+      SUBROUTINE VDIFH(DTDIF,LMH,THZ0,QZ0,RKHS,CHKLOWQ,CT             &
+     &                ,THE,Q,CWM,RKH,Z,RHO                            &
+     &                ,IDS,IDE,JDS,JDE,KDS,KDE                        &
+     &                ,IMS,IME,JMS,JME,KMS,KME                        &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE,I,J)
+!     ***************************************************************
+!     *                                                             *
+!     *         VERTICAL DIFFUSION OF MASS VARIABLES                *
+!     *                                                             *
+!     ***************************************************************
+!---------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!---------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE,I,J
+!
+      INTEGER,INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: CHKLOWQ,CT,DTDIF,QZ0,RKHS,THZ0
+!
+      REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: RKH
+      REAL,DIMENSION(KTS:KTE),INTENT(IN) :: RHO
+      REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z
+      REAL,DIMENSION(KTS:KTE),INTENT(INOUT) :: CWM,Q,THE
+!
+!----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      INTEGER :: K
+!
+      REAL :: CF,CMB,CMCB,CMQB,CMTB,CTHF,DTOZL,DTOZS                   &
+     &       ,RCML,RKHH,RKQS,RSCB,RSQB,RSTB
+!
+      REAL,DIMENSION(KTS:KTE-1) :: CM,CR,DTOZ,RKCT,RSC,RSQ,RST
+!
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+      CTHF=0.5*CT
+!
+      DO K=KTS,LMH-1
+        DTOZ(K)=DTDIF/(Z(K)-Z(K+1))
+        CR(K)=-DTOZ(K)*RKH(K)
+        RKCT(K)=RKH(K)*(Z(K)-Z(K+2))*CTHF
+      ENDDO
+!
+      CM(KTS)=DTOZ(KTS)*RKH(KTS)+RHO(KTS)
+!----------------------------------------------------------------------
+      RST(KTS)=-RKCT(KTS)*DTOZ(KTS)                                    &
+     &         +THE(KTS)*RHO(KTS)
+      RSQ(KTS)=Q(KTS)  *RHO(KTS)
+      RSC(KTS)=CWM(KTS)*RHO(KTS)
+!----------------------------------------------------------------------
+      DO K=KTS+1,LMH-1
+        DTOZL=DTOZ(K)
+        CF=-DTOZL*RKH(K-1)/CM(K-1)
+        CM(K)=-CR(K-1)*CF+(RKH(K-1)+RKH(K))*DTOZL+RHO(K)
+        RST(K)=-RST(K-1)*CF+(RKCT(K-1)-RKCT(K))*DTOZL+THE(K)*RHO(K)
+        RSQ(K)=-RSQ(K-1)*CF+Q(K)  *RHO(K)
+        RSC(K)=-RSC(K-1)*CF+CWM(K)*RHO(K)
+      ENDDO
+!
+      DTOZS=DTDIF/(Z(LMH)-Z(LMH+1))
+      RKHH=RKH(LMH-1)
+!
+      CF=-DTOZS*RKHH/CM(LMH-1)
+      RKQS=RKHS*CHKLOWQ
+!
+      CMB=CR(LMH-1)*CF
+      CMTB=-CMB+(RKHH+RKHS)*DTOZS+RHO(LMH)
+      CMQB=-CMB+(RKHH+RKQS)*DTOZS+RHO(LMH)
+      CMCB=-CMB+(RKHH     )*DTOZS+RHO(LMH)
+!
+      RSTB=-RST(LMH-1)*CF+RKCT(LMH-1)*DTOZS+THE(LMH)*RHO(LMH)
+      RSQB=-RSQ(LMH-1)*CF+Q(LMH)  *RHO(LMH)
+      RSCB=-RSC(LMH-1)*CF+CWM(LMH)*RHO(LMH)
+!----------------------------------------------------------------------
+      THE(LMH)=(DTOZS*RKHS*THZ0+RSTB)/CMTB
+      Q(LMH)  =(DTOZS*RKQS*QZ0 +RSQB)/CMQB
+      CWM(LMH)=(                RSCB)/CMCB
+!----------------------------------------------------------------------
+      DO K=LMH-1,KTS,-1
+        RCML=1./CM(K)
+        THE(K)=(-CR(K)*THE(K+1)+RST(K))*RCML
+        Q(K)  =(-CR(K)*  Q(K+1)+RSQ(K))*RCML
+        CWM(K)=(-CR(K)*CWM(K+1)+RSC(K))*RCML
+      ENDDO
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE VDIFH
+!
+!---------------------------------------------------------------------
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!---------------------------------------------------------------------
+      SUBROUTINE VDIFV(LMH,DTDIF,UZ0,VZ0,RKMS,U,V,RKM,Z,RHO           &
+     &                ,IDS,IDE,JDS,JDE,KDS,KDE                        &
+     &                ,IMS,IME,JMS,JME,KMS,KME                        &
+                      ,ITS,ITE,JTS,JTE,KTS,KTE,I,J)
+!     ***************************************************************
+!     *                                                             *
+!     *        VERTICAL DIFFUSION OF VELOCITY COMPONENTS            *
+!     *                                                             *
+!     ***************************************************************
+!---------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!---------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                   &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                   &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE,I,J
+!
+      INTEGER,INTENT(IN) :: LMH
+!
+      REAL,INTENT(IN) :: RKMS,DTDIF,UZ0,VZ0
+!
+      REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: RKM
+      REAL,DIMENSION(KTS:KTE),INTENT(IN) :: RHO
+      REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z
+!
+      REAL,DIMENSION(KTS:KTE),INTENT(INOUT) :: U,V
+!----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      INTEGER :: K
+!
+      REAL :: CF,DTOZAK,DTOZL,DTOZS,RCML,RCMVB,RHOK,RKMH
+!
+      REAL,DIMENSION(KTS:KTE-1) :: CM,CR,DTOZ,RSU,RSV
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+      DO K=1,LMH-1
+        DTOZ(K)=DTDIF/(Z(K)-Z(K+1))
+        CR(K)=-DTOZ(K)*RKM(K)
+      ENDDO
+!
+      RHOK=RHO(1)
+      CM(1)=DTOZ(1)*RKM(1)+RHOK
+      RSU(1)=U(1)*RHOK
+      RSV(1)=V(1)*RHOK
+!----------------------------------------------------------------------
+      DO K=2,LMH-1
+        DTOZL=DTOZ(K)
+        CF=-DTOZL*RKM(K-1)/CM(K-1)
+        RHOK=RHO(K)
+        CM(K)=-CR(K-1)*CF+(RKM(K-1)+RKM(K))*DTOZL+RHOK
+        RSU(K)=-RSU(K-1)*CF+U(K)*RHOK
+        RSV(K)=-RSV(K-1)*CF+V(K)*RHOK
+      ENDDO
+!----------------------------------------------------------------------
+      DTOZS=DTDIF/(Z(LMH)-Z(LMH+1))
+      RKMH=RKM(LMH-1)
+!
+      CF=-DTOZS*RKMH/CM(LMH-1)
+      RHOK=RHO(LMH)
+      RCMVB=1./((RKMH+RKMS)*DTOZS-CR(LMH-1)*CF+RHOK)
+      DTOZAK=DTOZS*RKMS
+!----------------------------------------------------------------------
+      U(LMH)=(DTOZAK*UZ0-RSU(LMH-1)*CF+U(LMH)*RHOK)*RCMVB
+      V(LMH)=(DTOZAK*VZ0-RSV(LMH-1)*CF+V(LMH)*RHOK)*RCMVB
+!----------------------------------------------------------------------
+      DO K=LMH-1,1,-1
+        RCML=1./CM(K)
+        U(K)=(-CR(K)*U(K+1)+RSU(K))*RCML
+        V(K)=(-CR(K)*V(K+1)+RSV(K))*RCML
+      ENDDO
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE VDIFV
+!
+!-----------------------------------------------------------------------
+!
+!=======================================================================
+      SUBROUTINE MYJPBLINIT(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,          &
+     &                      TKE_MYJ,EXCH_H,RESTART,ALLOWED_TO_READ,     &
+     &                      IDS,IDE,JDS,JDE,KDS,KDE,                    &
+     &                      IMS,IME,JMS,JME,KMS,KME,                    &
+     &                      ITS,ITE,JTS,JTE,KTS,KTE                 )
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      LOGICAL,INTENT(IN) :: ALLOWED_TO_READ,RESTART
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE,                    &
+     &                      IMS,IME,JMS,JME,KMS,KME,                    &
+     &                      ITS,ITE,JTS,JTE,KTS,KTE
+
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) ::    EXCH_H, &
+     &                                                         RUBLTEN, &
+     &                                                         RVBLTEN, &
+     &                                                        RTHBLTEN, &
+     &                                                        RQVBLTEN, &
+     &                                                         TKE_MYJ
+      INTEGER :: I,J,K,ITF,JTF,KTF
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+
+      JTF=MIN0(JTE,JDE-1)
+      KTF=MIN0(KTE,KDE-1)
+      ITF=MIN0(ITE,IDE-1)
+
+      IF(.NOT.RESTART)THEN
+        DO J=JTS,JTF
+        DO K=KTS,KTF
+        DO I=ITS,ITF
+          TKE_MYJ(I,K,J)=EPSQ2
+          RUBLTEN(I,K,J)=0.
+          RVBLTEN(I,K,J)=0.
+          RTHBLTEN(I,K,J)=0.
+          RQVBLTEN(I,K,J)=0.
+          EXCH_H(I,K,J)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+      ENDIF
+
+      END SUBROUTINE MYJPBLINIT
+!-----------------------------------------------------------------------
+!
+      END MODULE MODULE_BL_MYJPBL
+!
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/phys/module_bl_ysu.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_bl_ysu.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_bl_ysu.F	(revision 2744)
@@ -0,0 +1,1243 @@
+!wrf:model_layer:physics
+!
+!
+!
+module module_bl_ysu
+contains
+!
+!-------------------------------------------------------------------
+!
+   subroutine ysu(u3d,v3d,th3d,t3d,qv3d,qc3d,qi3d,p3d,pi3d,        &
+                  rublten,rvblten,rthblten,                        &
+                  rqvblten,rqcblten,rqiblten,                      &
+                  cp,g,rovcp,rd,rovg,                              &
+                  dz8w,z,xlv,rv,psfc,                              &
+                  znt,ust,zol,hol,hpbl,psim,psih,                  &
+                  xland,hfx,qfx,tsk,gz1oz0,wspd,br,                &
+                  dt,dtmin,kpbl2d,                                 &
+                  svp1,svp2,svp3,svpt0,ep1,ep2,karman,eomeg,stbolt,&
+                  exch_h,                                          &
+                  ids,ide, jds,jde, kds,kde,                       &
+                  ims,ime, jms,jme, kms,kme,                       &
+                  its,ite, jts,jte, kts,kte,                       &
+                !optional
+                  regime                                           )
+!-------------------------------------------------------------------
+      implicit none
+!-------------------------------------------------------------------
+!-- u3d         3d u-velocity interpolated to theta points (m/s)
+!-- v3d         3d v-velocity interpolated to theta points (m/s)
+!-- th3d	3d potential temperature (k)
+!-- t3d         temperature (k)
+!-- qv3d        3d water vapor mixing ratio (kg/kg)
+!-- qc3d        3d cloud mixing ratio (kg/kg)
+!-- qi3d        3d ice mixing ratio (kg/kg)
+!               (note: if P_QI<PARAM_FIRST_SCALAR this should be zero filled)
+!-- p3d         3d pressure (pa)
+!-- pi3d	3d exner function (dimensionless)
+!-- rr3d	3d dry air density (kg/m^3)
+!-- rublten     u tendency due to
+!               pbl parameterization (m/s/s)
+!-- rvblten     v tendency due to
+!               pbl parameterization (m/s/s)
+!-- rthblten    theta tendency due to
+!               pbl parameterization (K/s)
+!-- rqvblten    qv tendency due to
+!               pbl parameterization (kg/kg/s)
+!-- rqcblten    qc tendency due to
+!               pbl parameterization (kg/kg/s)
+!-- rqiblten    qi tendency due to
+!               pbl parameterization (kg/kg/s)
+!-- cp          heat capacity at constant pressure for dry air (j/kg/k)
+!-- g           acceleration due to gravity (m/s^2)
+!-- rovcp       r/cp
+!-- rd          gas constant for dry air (j/kg/k)
+!-- rovg 	r/g
+!-- dz8w	dz between full levels (m)
+!-- z		height above sea level (m)
+!-- xlv         latent heat of vaporization (j/kg)
+!-- rv 		gas constant for water vapor (j/kg/k)
+!-- psfc        pressure at the surface (pa)
+!-- znt		roughness length (m)
+!-- ust		u* in similarity theory (m/s)
+!-- zol		z/l height over monin-obukhov length
+!-- hol		pbl height over monin-obukhov length
+!-- hpbl	pbl height (m)
+!-- regime	flag indicating pbl regime (stable, unstable, etc.)
+!-- psim        similarity stability function for momentum
+!-- psih        similarity stability function for heat
+!-- xland	land mask (1 for land, 2 for water)
+!-- hfx		upward heat flux at the surface (w/m^2)
+!-- qfx		upward moisture flux at the surface (kg/m^2/s)
+!-- tsk		surface temperature (k)
+!-- gz1oz0      log(z/z0) where z0 is roughness length
+!-- wspd        wind speed at lowest model level (m/s)
+!-- br          bulk richardson number in surface layer
+!-- dt		time step (s)
+!-- dtmin	time step (minute)
+!-- rvovrd      r_v divided by r_d (dimensionless)
+!-- svp1        constant for saturation vapor pressure (kpa)
+!-- svp2        constant for saturation vapor pressure (dimensionless)
+!-- svp3        constant for saturation vapor pressure (k)
+!-- svpt0       constant for saturation vapor pressure (k)
+!-- ep1         constant for virtual temperature (r_v/r_d - 1) (dimensionless)
+!-- ep2         constant for specific humidity calculation
+!-- karman      von karman constant
+!-- eomeg       angular velocity of earths rotation (rad/s)
+!-- stbolt      stefan-boltzmann constant (w/m^2/k^4)
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!-------------------------------------------------------------------
+!
+      integer,  intent(in   )   ::      ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+!
+      real,     intent(in   )   ::      dt,dtmin,cp,g,rovcp,       &
+				        rovg,rd,xlv,rv
+!
+      real,     intent(in )     ::     svp1,svp2,svp3,svpt0
+      real,     intent(in )     ::     ep1,ep2,karman,eomeg,stbolt
+!
+      real,     dimension( ims:ime, kms:kme, jms:jme )           , &
+                intent(in   )   ::                           qv3d, &
+							     qc3d, &
+ 		 				             qi3d, &
+							      p3d, &
+							     pi3d, &
+							     th3d, &
+							      t3d, &
+							     dz8w, &
+							        z
+!
+      real,     dimension( ims:ime, kms:kme, jms:jme )           , &
+                intent(inout)   ::                        rublten, &
+							  rvblten, &
+							 rthblten, &
+							 rqvblten, &
+                                                         rqcblten
+      real,     dimension( ims:ime, kms:kme, jms:jme )           , &
+                intent(inout)   ::                         exch_h
+!
+      real,     dimension( ims:ime, jms:jme )                    , &
+                intent(in   )   ::                          xland, &
+           			                              hfx, &
+                                                              qfx, &
+                                                             psim, &
+                                                             psih, &
+                                                           gz1oz0, &
+                                                               br, &
+                                                             psfc, &
+                                                              tsk
+!
+      real,     dimension( ims:ime, jms:jme )                    , &
+                intent(inout)   ::                            hol, &
+                                                              ust, &
+                                                             hpbl, &
+                                                              znt, &
+                                                             wspd, &
+                                                              zol
+!
+     real,     dimension( ims:ime, kms:kme, jms:jme )            , &
+                intent(in   )   ::                            u3d, &
+                                                              v3d
+!
+     integer,  dimension( ims:ime, jms:jme )                     , &
+                intent(out  )   ::                         kpbl2d
+!optional
+      real,     dimension( ims:ime, jms:jme )                    , &
+                optional                                         , &
+                intent(inout)   ::                         regime
+!
+      real,     dimension( ims:ime, kms:kme, jms:jme )           , &
+                optional                                         , &
+                intent(inout)   ::                        rqiblten
+!
+!local
+   integer ::  i,j,k
+!
+   do j = jts,jte
+      call ysu2d(J=j,ux=u3d(ims,kms,j),vx=v3d(ims,kms,j)           &
+              ,tx=t3d(ims,kms,j)                                   &
+              ,qx=qv3d(ims,kms,j),qcx=qc3d(ims,kms,j)              &
+              ,qix=qi3d(ims,kms,j)                                 &
+              ,p2d=p3d(ims,kms,j),utnp=rublten(ims,kms,j)          &
+              ,vtnp=rvblten(ims,kms,j)                             &
+              ,ttnp=rthblten(ims,kms,j),qtnp=rqvblten(ims,kms,j)   &
+              ,qctnp=rqcblten(ims,kms,j),qitnp=rqiblten(ims,kms,j) &
+              ,cp=cp,g=g,rovcp=rovcp,rd=rd,rovg=rovg               &
+              ,dz8w2d=dz8w(ims,kms,j),z2d=z(ims,kms,j)             &
+              ,xlv=xlv,rv=rv                                       &
+              ,psfcpa=psfc(ims,j),znt=znt(ims,j),ust=ust(ims,j)    &
+              ,zol=zol(ims,j),hol=hol(ims,j),hpbl=hpbl(ims,j)      &
+              ,regime=regime(ims,j),psim=psim(ims,j)               &
+              ,psih=psih(ims,j),xland=xland(ims,j)                 &
+              ,hfx=hfx(ims,j),qfx=qfx(ims,j)                       &
+              ,tsk=tsk(ims,j),gz1oz0=gz1oz0(ims,j)                 &
+              ,wspd=wspd(ims,j),br=br(ims,j)                       &
+              ,dt=dt,dtmin=dtmin,kpbl1d=kpbl2d(ims,j)              &
+              ,svp1=svp1,svp2=svp2,svp3=svp3,svpt0=svpt0           &
+              ,ep1=ep1,ep2=ep2,karman=karman,eomeg=eomeg           &
+              ,stbolt=stbolt                                       &
+              ,exch_hx=exch_h(ims,kms,j)                           &
+              ,ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde   &
+              ,ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme   &
+              ,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte   )
+      do k = kts,kte
+      do i = its,ite
+         rthblten(i,k,j) = rthblten(i,k,j)/pi3d(i,k,j)
+      enddo
+      enddo
+    enddo
+!
+   end subroutine ysu
+!
+!-------------------------------------------------------------------
+!
+   subroutine ysu2d(j,ux,vx,tx,qx,qcx,qix,p2d,                     &
+                  utnp,vtnp,ttnp,                                  &
+                  qtnp,qctnp,qitnp,                                &
+                  cp,g,rovcp,rd,rovg,                              &
+                  dz8w2d,z2d,xlv,rv,psfcpa,                        &
+                  znt,ust,zol,hol,hpbl,psim,psih,                  &
+                  xland,hfx,qfx,tsk,gz1oz0,wspd,br,                &
+                  dt,dtmin,kpbl1d,                                 &
+                  svp1,svp2,svp3,svpt0,ep1,ep2,karman,eomeg,stbolt,&
+                  exch_hx,                                         &
+                  ids,ide, jds,jde, kds,kde,                       &
+                  ims,ime, jms,jme, kms,kme,                       &
+                  its,ite, jts,jte, kts,kte,                       &
+              !optional
+                  regime                                           )
+!-------------------------------------------------------------------
+      implicit none
+!-------------------------------------------------------------------
+!
+!     this code is a revised vertical diffusion package ("ysupbl")
+!     with a nonlocal turbulent mixing in the pbl after "mrfpbl".
+!     the ysupbl is based on the study of noh et al(2003) and
+!     accumulated realism of the behavior of the troen and mahrt
+!     (1986) concept implemented by hong and pan(1996). the major
+!     ingredient of the ysupbl is the inclusion of an explicit
+!     treatment of the entrainment processes at the entrainment layer.
+!     this routine uses an implicit approach for vertical flux
+!     divergence and does not require "miter" timesteps.
+!     it includes vertical diffusion in the stable atmosphere
+!     and moist vertical diffusion in clouds.
+!     surface fluxes calculated as in hirpbl.
+!     5-layer soil model option required in slab due to long timestep
+!
+!     mrfpbl:
+!     coded by song-you hong (ncep), implemented by jimy dudhia (ncar)
+!     fall 1996
+!
+!     ysupbl:
+!     coded by song-you hong (yonsei university) and implemented by
+!         song-you hong (yonsei university) and jimy dudhia (ncar)
+!     summer 2002
+!
+!     references:
+!
+!        hong and pan (1996), mon. wea. rev.
+!        hong, noh, and dudhia (2004), mon. wea. rev, to be submitted
+!        dudhia and hong (2004), mon. wea. rev, to be submitted
+!        noh, chun, hong, and raasch (2003), boundary layer met.
+!        troen and mahrt (1986), boundary layer met.
+!
+!-------------------------------------------------------------------
+!
+      real      rlam,prmin,prmax,xkzmin,xkzmax,rimin,brcr,         &
+                bfac,pfac,sfcfrac,ckz,zfmin,aphi5,aphi16,gamcrt,   &
+                gamcrq,xka
+!
+      parameter (xkzmin = 0.01,xkzmax = 1000.,rimin = -100.)
+      integer ncloud
+      parameter (ncloud = 3)
+      real afac, phifac, qmin
+      real d1,d2,d3
+      real h1,h2
+      parameter (rlam = 30.,prmin = 0.25,prmax = 4.)
+      parameter (brcr = 0.0,bfac = 6.8,pfac = 2.0,sfcfrac = 0.1)
+      parameter (afac = 6.8,phifac = 8.,qmin=1.e-2)
+      parameter (d1 = 0.02, d2 = 0.05, d3 = 0.001)
+      parameter (h1 = 0.33333335, h2 = 0.6666667)
+      parameter (ckz = 0.001,zfmin = 1.e-8,aphi5 = 5.,aphi16 = 16.)
+      parameter (gamcrt = 3.,gamcrq = 2.e-3)
+      parameter (xka = 2.4e-5)
+!wig 16-sep-2005: Parameter added to set a minimum pbl height. To disable
+!                 this option, set hpblmin=0.
+      real, parameter :: hpblmin=0.
+!
+      integer,  intent(in   )   ::      ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte, j
+!
+      real,     intent(in   )   ::      dt,dtmin,cp,g,rovcp,       &
+				        rovg,rd,xlv,rv
+!
+      real,     intent(in )     ::     svp1,svp2,svp3,svpt0
+      real,     intent(in )     ::     ep1,ep2,karman,eomeg,stbolt
+!
+      real,     dimension( ims:ime, kms:kme ),                     &
+                intent(in)      ::                         dz8w2d, &
+                                                              z2d
+!
+      real,     dimension( ims:ime, kms:kme )                    , &
+                intent(in   )   ::                             tx, &
+                                                               qx, &
+						  	      qcx, &
+ 		 				              qix, &
+							      p2d
+!
+      real,     dimension( ims:ime, kms:kme )                    , &
+                intent(inout)   ::                           utnp, &
+							     vtnp, &
+							     ttnp, &
+							     qtnp, &
+							    qctnp, &
+							    qitnp
+!
+      real,     dimension( ims:ime )                             , &
+                intent(inout)   ::                            hol, &
+                                                              ust, &
+                                                             hpbl, &
+                                                              znt
+      real,     dimension( ims:ime )                             , &
+                intent(in   )   ::                          xland, &
+                                                              hfx, &
+                                                              qfx
+!
+      real,     dimension( ims:ime ), intent(inout)   ::     wspd
+      real,     dimension( ims:ime ), intent(in  )    ::       br
+!
+      real,     dimension( ims:ime ), intent(in   )   ::     psim, &
+                                                             psih
+      real,     dimension( ims:ime ), intent(in   )   ::   gz1oz0
+!
+      real,     dimension( ims:ime ), intent(in   )   ::   psfcpa
+      real,     dimension( ims:ime ), intent(in   )   ::      tsk
+      real,     dimension( ims:ime ), intent(inout)   ::      zol
+      integer,  dimension( ims:ime ), intent(out  )   ::   kpbl1d
+!
+!
+      real,     dimension( ims:ime, kms:kme )                    , &
+                intent(in   )   ::                             ux, &
+                                                               vx
+!optional
+      real,     dimension( ims:ime )                             , &
+                optional                                         , &
+                intent(inout)   ::                         regime
+!
+! local vars
+!
+      real,     dimension( its:ite, kts:kte+1 ) ::             zq
+!
+      real,     dimension( its:ite, kts:kte )   ::     		   &
+                  				         thx,thvx, &
+                  				          dzq,dza, &
+						               za, &
+						          uxs,vxs, &
+							 thxs,qxs, &
+                   				        qcxs,qixs
+!
+      real,    dimension( its:ite )             ::     qixsv,rhox, &
+       				                           govrth, &
+   						            thxsv, &
+							uxsv,vxsv, &
+                  			               qxsv,qcxsv, &
+                  			             qgh,tgdsa,ps
+!
+      real,    dimension( its:ite )             ::                 &
+                                                      zl1,thermal, &
+						     wscale,hgamt, &
+                                                       hgamq,brdn, &
+                 				        brup,phim, &
+						         phih,cpm, &
+					              dusfc,dvsfc, &
+						      dtsfc,dqsfc, &
+                                                       thgb,prpbl, &
+                                                            wspd1
+!
+      real,    dimension( its:ite, kts:kte )    ::      xkzm,xkzh, &
+							    f1,f2, &
+							    r1,r2, &
+                                                            ad,au, &
+                                                               cu, &
+                                                               al, &
+                                                             zfac, &
+                                                             scr4
+!jdf added exch_hx
+      real,    dimension( ims:ime, kms:kme )                     , &
+               intent(inout)   ::                         exch_hx
+      real,    dimension( its:ite, kts:kte, ncloud)  ::     r3,f3
+!
+      logical, dimension( its:ite )             ::         pblflg, &
+					                   sfcflg, &
+							   stable
+!
+      integer ::  n,i,k,l,nzol,imvdif,ic
+      integer ::  klpbl
+!
+!wig 16-sep-2005: Added kmin for setting minimum pbl height
+      integer, dimension( its:ite )             ::           kpbl, &
+                                                             kmin
+!
+      real    ::  zoln,x,y,thcon,tvcon,e1,dtstep
+      real    ::  zl,tskv,dthvdz,dthvm,vconv,rzol
+      real    ::  dtthx,psix,dtg,psiq,ustm
+      real    ::  dt2,rdt,spdk2,fm,fh,hol1,gamfac,vpert,prnum
+      real    ::  xkzo,ss,ri,qmean,tmean,alph,chi,zk,rl2,dk,sri
+      real    ::  brint,dtodsd,rdz,dsdzt,dsdzq,dsdz2,ttend,qtend
+      real    ::  utend,vtend,qctend,qitend,tgc,dtodsu,govrthv
+!
+      real, dimension( its:ite, kts:kte )     ::         wscalek, &
+                                                     xkzml,xkzhl, &
+                                                  zfacent,entfac
+      real, dimension( its:ite )              ::            ust3, &
+                                                    wstar3,wstar, &
+                                                     hgamu,hgamv, &
+                                                         wm2, we, &
+                                                          bfxpbl, &
+                                                   hfxpbl,qfxpbl, &
+                                                   ufxpbl,vfxpbl, &
+                                                     delta,dthvx
+      real    ::  prnumfac,bfx0,hfx0,qfx0,delb,dux,dvx,           &
+                  dsdzu,dsdzv,wm3,dthx,dqx
+!
+!----------------------------------------------------------------------
+!
+      klpbl = kte
+!
+!-- imvdif      imvdif = 1 for moist adiabat vertical diffusion
+      imvdif = 1
+!
+!----convert ground temperature to potential temperature:
+!
+      do i = its,ite
+        tgdsa(i) = tsk(i)
+        ps(i) = psfcpa(i)/1000.          ! ps psfc cmb
+        thgb(i) = tsk(i)*(100./ps(i))**rovcp
+      enddo
+!
+!     scr4(i,k) store virtual temperature.
+!
+      do k = kts,kte
+        do i = its,ite
+          thcon = (100000./p2d(i,k))**rovcp
+          thx(i,k) = tx(i,k)*thcon
+          scr4(i,k) = tx(i,k)
+          thvx(i,k) = thx(i,k)
+        enddo
+      enddo
+!
+      do i = its,ite
+        qgh(i) = 0.
+        cpm(i) = cp
+      enddo
+!
+      do k = kts,kte
+        do i = its,ite
+          tvcon = (1.+ep1*qx(i,k))
+          thvx(i,k) = thx(i,k)*tvcon
+          scr4(i,k) = tx(i,k)*tvcon
+        enddo
+      enddo
+!
+      do i = its,ite
+        e1 = svp1*exp(svp2*(tgdsa(i)-svpt0)/(tgdsa(i)-svp3))
+        qgh(i) = ep2*e1/(ps(i)-e1)
+        cpm(i) = cp*(1.+0.8*qx(i,1))
+      enddo
+!
+!-----compute the height of full- and half-sigma levels above ground
+!     level, and the layer thicknesses.
+!
+      do i = its,ite
+        zq(i,1) = 0.
+        rhox(i) = ps(i)*1000./(rd*scr4(i,1))
+      enddo
+!
+      do k = kts,kte
+        do i = its,ite
+          zq(i,k+1) = dz8w2d(i,k)+zq(i,k)
+        enddo
+      enddo
+!
+      do k = kts,kte
+        do i = its,ite
+          za(i,k) = 0.5*(zq(i,k)+zq(i,k+1))
+          dzq(i,k) = zq(i,k+1)-zq(i,k)
+        enddo
+      enddo
+!
+      do i = its,ite
+        dza(i,1) = za(i,1)
+      enddo
+!
+      do k = kts+1,kte
+        do i = its,ite
+          dza(i,k) = za(i,k)-za(i,k-1)
+        enddo
+      enddo
+!
+      do i = its,ite
+        govrth(i) = g/thx(i,1)
+      enddo
+!
+!wig 16-sep-2005: Determine the k level associated with hpblmin.
+      if( hpblmin >= 1. ) then
+         do i = its,ite
+            kmin(i) = 1
+            do k = kte-1,kts,-1
+               if( zq(i,k) <= hpblmin ) then
+                  kmin(i) = k
+                  exit
+               end if
+            end do
+         end do
+      end if
+!
+!-----initialize vertical tendencies and
+!
+      do i = its,ite
+        do k = kts,kte
+          utnp(i,k) = 0.
+          vtnp(i,k) = 0.
+          ttnp(i,k) = 0.
+        enddo
+      enddo
+!
+      do k = kts,kte
+        do i = its,ite
+          qtnp(i,k) = 0.
+        enddo
+      enddo
+!
+      do k = kts,kte
+        do i = its,ite
+          qctnp(i,k) = 0.
+          qitnp(i,k) = 0.
+        enddo
+      enddo
+!
+      do i = its,ite
+        wspd1(i) = sqrt(ux(i,1)*ux(i,1)+vx(i,1)*vx(i,1))+1.e-9
+      enddo
+!
+!---- compute vertical diffusion
+!
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!     compute preliminary variables
+!
+      dtstep = dt
+      dt2 = 2.*dtstep
+      rdt = 1./dt2
+!
+      do i = its,ite
+        bfxpbl(i) = 0.0
+        hfxpbl(i) = 0.0
+        qfxpbl(i) = 0.0
+        ufxpbl(i) = 0.0
+        vfxpbl(i) = 0.0
+        hgamu(i)  = 0.0
+        hgamv(i)  = 0.0
+        delta(i)  = 0.0
+      enddo
+!
+      do k = kts,klpbl
+        do i = its,ite
+          wscalek(i,k) = 0.0
+        enddo
+      enddo
+!
+      do k = kts,klpbl
+        do i = its,ite
+          zfac(i,k) = 0.0
+        enddo
+      enddo
+!
+      do i = its,ite
+        hgamt(i)  = 0.
+        hgamq(i)  = 0.
+        wscale(i) = 0.
+        kpbl(i)   = 1
+        hpbl(i)   = zq(i,1)
+        zl1(i)    = za(i,1)
+        thermal(i)= thvx(i,1)
+        pblflg(i) = .true.
+        sfcflg(i) = .true.
+!wig 12-aug-2004: Turn off check for sfc stability if using a minimum
+!                 pbl height > 0.
+        if(br(i).gt.0.0 .and. hpblmin<=1.) sfcflg(i) = .false.
+      enddo
+!
+!     compute the first guess of pbl height
+!
+      do i = its,ite
+        stable(i) = .false.
+        brup(i) = br(i)
+      enddo
+!
+      do k = 2,klpbl
+        do i = its,ite
+          if(.not.stable(i))then
+            brdn(i) = brup(i)
+            spdk2   = max(ux(i,k)**2+vx(i,k)**2,1.)
+            brup(i) = (thvx(i,k)-thermal(i))*(g*za(i,k)/thvx(i,1))/spdk2
+            kpbl(i) = k
+            stable(i) = brup(i).gt.brcr
+          endif
+        enddo
+      enddo
+!
+      do i = its,ite
+        k = kpbl(i)
+        if(brdn(i).ge.brcr)then
+          brint = 0.
+        elseif(brup(i).le.brcr)then
+          brint = 1.
+        else
+          brint = (brcr-brdn(i))/(brup(i)-brdn(i))
+        endif
+        hpbl(i) = za(i,k-1)+brint*(za(i,k)-za(i,k-1))
+
+!wig 16-sep-2005: rig a minimum PBL heigt
+        if( hpblmin >= 1. .and. hpbl(i).lt.hpblmin) then
+           kpbl(i) = kmin(i)
+           hpbl(i) = hpblmin
+        else
+           if(hpbl(i).lt.zq(i,2)) kpbl(i) = 1
+        end if
+
+        if(kpbl(i).le.1) pblflg(i) = .false.
+      enddo
+!
+      do i = its,ite
+        fm = gz1oz0(i)-psim(i)
+        fh = gz1oz0(i)-psih(i)
+        hol(i) = max(br(i)*fm*fm/fh,rimin)
+        if(sfcflg(i))then
+          hol(i) = min(hol(i),-zfmin)
+        else
+          hol(i) = max(hol(i),zfmin)
+        endif
+!
+        hol1 = hol(i)*hpbl(i)/zl1(i)*sfcfrac
+        hol(i) = -hol(i)*hpbl(i)/zl1(i)
+        if(sfcflg(i))then
+          phim(i) = (1.-aphi16*hol1)**(-1./4.)
+          phih(i) = (1.-aphi16*hol1)**(-1./2.)
+          bfx0 = max(hfx(i)/rhox(i)/cpm(i)             &
+                   +ep1*thx(i,1)*qfx(i)/rhox(i),0.)
+          hfx0 = max(hfx(i)/rhox(i)/cpm(i),0.)
+          qfx0 = max(ep1*thx(i,1)*qfx(i)/rhox(i),0.)
+          wstar3(i) = (govrth(i)*bfx0*hpbl(i))
+          wstar(i) = (wstar3(i))**h1
+        else
+          phim(i) = (1.+aphi5*hol1)
+          phih(i) = phim(i)
+          wstar(i)  = 0.
+          wstar3(i) = 0.
+        endif
+        ust3(i)   = ust(i)**3.
+        wscale(i) = (ust3(i)+phifac*karman*wstar3(i)*0.5)**h1
+        wscale(i) = min(wscale(i),ust(i)*aphi16)
+        wscale(i) = max(wscale(i),ust(i)/aphi5)
+      enddo
+!
+!     compute the surface variables for pbl height estimation
+!     under unstable conditions
+!
+      do i = its,ite
+        if(sfcflg(i))then
+          gamfac   = bfac/rhox(i)/wscale(i)
+          hgamt(i) = min(gamfac*hfx(i)/cpm(i),gamcrt)
+          hgamq(i) = min(gamfac*qfx(i),gamcrq)
+          vpert = (hgamt(i)+ep1*thx(i,1)*hgamq(i))/bfac*afac
+          thermal(i) = thermal(i)+max(vpert,0.)
+          hgamt(i) = max(hgamt(i),0.0)
+          hgamq(i) = 0.0
+          brint    = -15.9*ust(i)*ust(i)/wspd(i)*wstar3(i) &
+                     /(wscale(i)**4.)
+          hgamu(i) = brint*ux(i,1)
+          hgamv(i) = brint*vx(i,1)
+        else
+          pblflg(i) = .false.
+        endif
+      enddo
+!
+!     enhance the pbl height by considering the thermal
+!
+      do i = its,ite
+        if(pblflg(i))then
+          kpbl(i) = 1
+          hpbl(i) = zq(i,1)
+        endif
+      enddo
+!
+      do i = its,ite
+        if(pblflg(i))then
+          stable(i) = .false.
+          brup(i) = br(i)
+        endif
+      enddo
+!
+      do k = 2,klpbl
+        do i = its,ite
+          if(.not.stable(i).and.pblflg(i))then
+            brdn(i) = brup(i)
+            spdk2 = max((ux(i,k)**2+vx(i,k)**2),1.)
+            brup(i) = (thvx(i,k)-thermal(i))*(g*za(i,k)/thvx(i,1))/spdk2
+            kpbl(i) = k
+            stable(i) = brup(i).gt.brcr
+          endif
+        enddo
+      enddo
+!
+      do i = its,ite
+        if(pblflg(i))then
+          k = kpbl(i)
+          if(brdn(i).ge.brcr)then
+            brint = 0.
+          elseif(brup(i).le.brcr)then
+            brint = 1.
+          else
+            brint = (brcr-brdn(i))/(brup(i)-brdn(i))
+          endif
+          hpbl(i) = za(i,k-1)+brint*(za(i,k)-za(i,k-1))
+
+!wig 16-sep-2005: rig a minimum PBL heigt
+          if(hpblmin >= 1. .and. hpbl(i).lt.hpblmin) then
+             kpbl(i) = kmin(i)
+             hpbl(i) = hpblmin
+          else
+             if(hpbl(i).lt.zq(i,2)) kpbl(i) = 1
+          end if
+
+          if(kpbl(i).le.1) pblflg(i) = .false.
+        endif
+      enddo
+!
+!     estimate the entrainment parameters
+!
+      do i = its,ite
+        if(pblflg(i)) then
+          k = kpbl(i) - 1
+          ss = ((ux(i,k+1)-ux(i,k))*(ux(i,k+1)-ux(i,k))+(vx(i,k+1)- &
+             vx(i,k))*(vx(i,k+1)-vx(i,k)))/(dza(i,k+1)*dza(i,k+1))+ &
+             1.e-9
+          govrthv = g/(0.5*(thvx(i,k+1)+thvx(i,k)))
+          ri = govrthv*(thvx(i,k+1)-thvx(i,k))/(ss*dza(i,k+1))
+          if(imvdif.eq.1)then
+            if((qcx(i,k)+qix(i,k)).gt.0.01e-3.and.(qcx(i,k+1)+      &
+              qix(i,k+1)).gt.0.01e-3)then
+!      in cloud
+              qmean = 0.5*(qx(i,k)+qx(i,k+1))
+              tmean = 0.5*(tx(i,k)+tx(i,k+1))
+              alph  = xlv*qmean/rd/tmean
+              chi   = xlv*xlv*qmean/cp/rv/tmean/tmean
+              ri    = (1.+alph)*(ri-g*g/ss/tmean/cp*((chi-alph)/(1.+chi)))
+            endif
+          endif
+          prpbl(i) = 1.0
+          wm3       = wstar3(i) + 5. * ust3(i)
+          wm2(i)    = wm3**h2
+          bfxpbl(i) = -0.15*thvx(i,1)/g*wm3/hpbl(i)
+          dthvx(i)  = max(thvx(i,k+1)-thvx(i,k),qmin)
+          dthx  = max(thx(i,k+1)-thx(i,k),qmin)
+          dqx   = min(qx(i,k+1)-qx(i,k),0.0)
+          we(i) = max(bfxpbl(i)/dthvx(i),-sqrt(wm2(i)))
+          hfxpbl(i) = we(i)*dthx
+          qfxpbl(i) = we(i)*dqx
+!
+          dux = ux(i,k+1)-ux(i,k)
+          dvx = vx(i,k+1)-vx(i,k)
+          if(dux.gt.qmin) then
+            ufxpbl(i) = max(prpbl(i)*we(i)*dux,-ust(i)*ust(i))
+          elseif(dux.lt.-qmin) then
+            ufxpbl(i) = min(prpbl(i)*we(i)*dux,ust(i)*ust(i))
+          else
+            ufxpbl(i) = 0.0
+          endif
+          if(dvx.gt.qmin) then
+            vfxpbl(i) = max(prpbl(i)*we(i)*dvx,-ust(i)*ust(i))
+          elseif(dvx.lt.-qmin) then
+            vfxpbl(i) = min(prpbl(i)*we(i)*dvx,ust(i)*ust(i))
+          else
+            vfxpbl(i) = 0.0
+          endif
+          delb  = govrth(i)*d3*hpbl(i)
+          delta(i) = min(d1*hpbl(i) + d2*wm2(i)/delb,100.)
+        endif
+      enddo
+!
+      do k = kts,klpbl
+        do i = its,ite
+          if(pblflg(i).and.k.ge.kpbl(i))then
+            entfac(i,k) = ((zq(i,k+1)-hpbl(i))/delta(i))**2.
+          else
+            entfac(i,k) = 1.e30
+          endif
+        enddo
+      enddo
+!
+!     compute diffusion coefficients below pbl
+!
+      do k = kts,klpbl
+        do i = its,ite
+          if(k.lt.kpbl(i)) then
+            zfac(i,k) = min(max((1.-(zq(i,k+1)-zl1(i)) &
+                        /(hpbl(i)-zl1(i))),zfmin),1.)
+            xkzo = ckz*dza(i,k+1)
+            zfacent(i,k) = (1.-zfac(i,k))**3.
+            prnumfac = -3.*(max(zq(i,k+1)-sfcfrac*hpbl(i),0.))**2. &
+                       /hpbl(i)**2.
+            prnum = (phih(i)/phim(i)+bfac*karman*sfcfrac)
+            prnum =  1. + (prnum-1.)*exp(prnumfac)
+            prnum = min(prnum,prmax)
+            prnum = max(prnum,prmin)
+            wscalek(i,k) = (ust3(i)+phifac*karman*wstar3(i) &
+                          *(1.-zfac(i,k)))**h1
+            xkzm(i,k) = xkzo+wscalek(i,k)*karman*zq(i,k+1) &
+                        *zfac(i,k)**pfac
+            xkzh(i,k) = xkzm(i,k)/prnum
+            xkzm(i,k) = min(xkzm(i,k),xkzmax)
+            xkzm(i,k) = max(xkzm(i,k),xkzmin)
+            xkzh(i,k) = min(xkzh(i,k),xkzmax)
+            xkzh(i,k) = max(xkzh(i,k),xkzmin)
+!wig 16-sep-2005: This code is unnecessary. exch_hx will get overwritten
+!                 with the same values further down in this routine
+!            exch_hx(i,k) = xkzh(i,k)
+          endif
+        enddo
+      enddo
+!
+!     compute diffusion coefficients over pbl (free atmosphere)
+!
+      do k = kts,kte-1
+        do i = its,ite
+          xkzo = ckz*dza(i,k+1)
+          if(k.ge.kpbl(i)) then
+            ss = ((ux(i,k+1)-ux(i,k))*(ux(i,k+1)-ux(i,k))+(vx(i,k+1)- &
+               vx(i,k))*(vx(i,k+1)-vx(i,k)))/(dza(i,k+1)*dza(i,k+1))+ &
+               1.e-9
+            govrthv = g/(0.5*(thvx(i,k+1)+thvx(i,k)))
+            ri = govrthv*(thvx(i,k+1)-thvx(i,k))/(ss*dza(i,k+1))
+            if(imvdif.eq.1)then
+              if((qcx(i,k)+qix(i,k)).gt.0.01e-3.and.(qcx(i,k+1)+      &
+                qix(i,k+1)).gt.0.01e-3)then
+!      in cloud
+                qmean = 0.5*(qx(i,k)+qx(i,k+1))
+                tmean = 0.5*(tx(i,k)+tx(i,k+1))
+                alph  = xlv*qmean/rd/tmean
+                chi   = xlv*xlv*qmean/cp/rv/tmean/tmean
+                ri    = (1.+alph)*(ri-g*g/ss/tmean/cp*((chi-alph)/(1.+chi)))
+              endif
+            endif
+            zk = karman*zq(i,k+1)
+            rl2 = (zk*rlam/(rlam+zk))**2
+            dk = rl2*sqrt(ss)
+            if(ri.lt.0.)then
+! unstable regime
+              sri = sqrt(-ri)
+              xkzm(i,k) = xkzo+dk*(1+8.*(-ri)/(1+1.746*sri))
+              xkzh(i,k) = xkzo+dk*(1+8.*(-ri)/(1+1.286*sri))
+            else
+! stable regime
+              xkzh(i,k) = xkzo+dk/(1+5.*ri)**2
+              prnum = 1.0+2.1*ri
+              prnum = min(prnum,prmax)
+              xkzm(i,k) = (xkzh(i,k)-xkzo)*prnum+xkzo
+            endif
+!
+            xkzm(i,k) = min(xkzm(i,k),xkzmax)
+            xkzm(i,k) = max(xkzm(i,k),xkzmin)
+            xkzh(i,k) = min(xkzh(i,k),xkzmax)
+            xkzh(i,k) = max(xkzh(i,k),xkzmin)
+            xkzml(i,k) = xkzm(i,k)
+            xkzhl(i,k) = xkzh(i,k)
+!wig 16-sep-2005: This code is unnecessary. exch_hx will get overwritten
+!                 further down in this routine after adjustments are made
+!                 for entrainment.
+!            exch_hx(i,k) = xkzh(i,k)
+          endif
+        enddo
+      enddo
+!
+!     compute tridiagonal matrix elements for heat and moisture, and clouds
+!
+      do i = its,ite
+        do k = kts,kte
+          au(i,k) = 0.
+          al(i,k) = 0.
+          ad(i,k) = 0.
+          f1(i,k) = 0.
+        enddo
+      enddo
+!
+      do ic = 1,ncloud
+        do i = its,ite
+          do k = kts,kte
+            f3(i,k,ic) = 0.
+          enddo
+        enddo
+      enddo
+!
+      do i = its,ite
+        ad(i,1) = 1.
+        f1(i,1) = thx(i,1)+hfx(i)/(rhox(i)*cpm(i))/zq(i,2)*dt2
+        f3(i,1,1) = qx(i,1)+qfx(i)/(rhox(i))/zq(i,2)*dt2
+      enddo
+!
+      if(ncloud.ge.2) then
+        do ic = 2,ncloud
+          do i = its,ite
+            if(ic.eq.2) then
+              f3(i,1,ic) = qcx(i,1)
+            elseif(ic.eq.3) then
+              f3(i,1,ic) = qix(i,1)
+            endif
+          enddo
+        enddo
+      endif
+!
+      do k = kts,kte-1
+        do i = its,ite
+          dtodsd = dt2/dz8w2d(i,k)
+          dtodsu = dt2/dz8w2d(i,k+1)
+          rdz = 1./dza(i,k+1)
+          if(pblflg(i).and.k.lt.kpbl(i)) then
+            dsdzt = xkzh(i,k)*(-hgamt(i)/hpbl(i) &
+                   -hfxpbl(i)*zfacent(i,k)/xkzh(i,k))
+            dsdzq = xkzh(i,k)*(-hgamq(i)/hpbl(i) &
+                   -qfxpbl(i)*zfacent(i,k)/xkzh(i,k))
+            f1(i,k)   = f1(i,k)+dtodsd*dsdzt
+            f1(i,k+1) = thx(i,k+1)-dtodsu*dsdzt
+            f3(i,k,1) = f3(i,k,1)+dtodsd*dsdzq
+            f3(i,k+1,1) = qx(i,k+1)-dtodsu*dsdzq
+          elseif(pblflg(i).and.k.ge.kpbl(i).and.entfac(i,k).lt.4.6) then
+            xkzh(i,k) = -we(i)*dza(i,kpbl(i))*exp(-entfac(i,k))
+            xkzh(i,k) = sqrt(xkzh(i,k)*xkzhl(i,k))
+            xkzh(i,k) = min(xkzh(i,k),xkzmax)
+            xkzh(i,k) = max(xkzh(i,k),xkzmin)
+            f1(i,k+1) = thx(i,k+1)
+            f3(i,k+1,1) = qx(i,k+1)
+          else
+            f1(i,k+1) = thx(i,k+1)
+            f3(i,k+1,1) = qx(i,k+1)
+          endif
+          dsdz2 = xkzh(i,k)*rdz
+          au(i,k)   = -dtodsd*dsdz2
+          al(i,k)   = -dtodsu*dsdz2
+          ad(i,k)   = ad(i,k)-au(i,k)
+          ad(i,k+1) = 1.-al(i,k)
+          exch_hx(i,k) = xkzh(i,k)
+        enddo
+      enddo
+!
+      if(ncloud.ge.2) then
+        do ic = 2,ncloud
+          do k = kts,kte-1
+            do i = its,ite
+              if(ic.eq.2) then
+                f3(i,k+1,ic) = qcx(i,k+1)
+              elseif(ic.eq.3) then
+                f3(i,k+1,ic) = qix(i,k+1)
+              endif
+            enddo
+          enddo
+        enddo
+      endif
+
+! copies here to avoid duplicate input args for tridin
+
+      do k = kts,kte
+        do i = its,ite
+          cu(i,k) = au(i,k)
+          r1(i,k) = f1(i,k)
+        enddo
+      enddo
+!
+      do ic = 1,ncloud
+        do k = kts,kte
+          do i = its,ite
+            r3(i,k,ic) = f3(i,k,ic)
+          enddo
+        enddo
+      enddo
+!
+!
+!     solve tridiagonal problem for heat and moisture, and clouds
+!
+      call tridin(al,ad,cu,r1,r3,au,f1,f3,                 &
+		  its,ite,kts,kte,ncloud                   )
+!
+!     recover tendencies of heat and moisture
+!
+      do k = kte,kts,-1
+        do i = its,ite
+          ttend = (f1(i,k)-thx(i,k))*rdt*(tx(i,k)/thx(i,k))
+          qtend = (f3(i,k,1)-qx(i,k))*rdt
+          ttnp(i,k) = ttnp(i,k)+ttend
+          qtnp(i,k) = qtnp(i,k)+qtend
+        enddo
+      enddo
+!
+      if(ncloud.ge.2) then
+        do ic = 2,ncloud
+          do k = kte,kts,-1
+            do i = its,ite
+              if(ic.eq.2) then
+                qctend = (f3(i,k,ic)-qcx(i,k))*rdt
+                qctnp(i,k) = qctnp(i,k)+qctend
+              elseif(ic.eq.3) then
+                qitend = (f3(i,k,ic)-qix(i,k))*rdt
+                qitnp(i,k) = qitnp(i,k)+qitend
+              endif
+            enddo
+          enddo
+        enddo
+      endif
+!
+!     compute tridiagonal matrix elements for momentum
+!
+      do i = its,ite
+      do k = kts,kte
+         au(i,k) = 0.
+         al(i,k) = 0.
+         ad(i,k) = 0.
+         f1(i,k) = 0.
+         f2(i,k) = 0.
+      enddo
+      enddo
+!
+      do i = its,ite
+        ad(i,1) = 1.
+        f1(i,1) = ux(i,1)-ux(i,1)/wspd1(i)*ust(i)*ust(i)/zq(i,2)*dt2 &
+                          *(wspd1(i)/wspd(i))**2
+        f2(i,1) = vx(i,1)-vx(i,1)/wspd1(i)*ust(i)*ust(i)/zq(i,2)*dt2 &
+                          *(wspd1(i)/wspd(i))**2
+      enddo
+!
+      do k = kts,kte-1
+        do i = its,ite
+          dtodsd = dt2/dz8w2d(i,k)
+          dtodsu = dt2/dz8w2d(i,k+1)
+          rdz = 1./dza(i,k+1)
+        if(pblflg(i).and.k.lt.kpbl(i))then
+          dsdzu=xkzm(i,k)*(-hgamu(i)/hpbl(i) &
+                 -ufxpbl(i)*zfacent(i,k)/xkzm(i,k))
+          dsdzv=xkzm(i,k)*(-hgamv(i)/hpbl(i) &
+                 -vfxpbl(i)*zfacent(i,k)/xkzm(i,k))
+          f1(i,k)   = f1(i,k)+dtodsd*dsdzu
+          f1(i,k+1) = ux(i,k+1)-dtodsu*dsdzu
+          f2(i,k)   = f2(i,k)+dtodsd*dsdzv
+          f2(i,k+1) = vx(i,k+1)-dtodsu*dsdzv
+        elseif(pblflg(i).and.k.ge.kpbl(i).and.entfac(i,k).lt.4.6) then
+          xkzm(i,k) = prpbl(i)*xkzh(i,k)
+          xkzm(i,k) = sqrt(xkzm(i,k)*xkzml(i,k))
+          xkzm(i,k)=min(xkzm(i,k),xkzmax)
+          xkzm(i,k)=max(xkzm(i,k),xkzmin)
+          f1(i,k+1)=ux(i,k+1)
+          f2(i,k+1)=vx(i,k+1)
+        else
+          f1(i,k+1) = ux(i,k+1)
+          f2(i,k+1) = vx(i,k+1)
+        endif
+          dsdz2 = xkzm(i,k)*rdz
+          au(i,k)   = -dtodsd*dsdz2
+          al(i,k)   = -dtodsu*dsdz2
+          ad(i,k)   = ad(i,k)-au(i,k)
+          ad(i,k+1) = 1.-al(i,k)
+        enddo
+      enddo
+
+! copies here to avoid duplicate input args for tridin
+
+      do k = kts,kte
+        do i = its,ite
+          cu(i,k) = au(i,k)
+          r1(i,k) = f1(i,k)
+          r2(i,k) = f2(i,k)
+        enddo
+      enddo
+!
+!
+!     solve tridiagonal problem for momentum
+!
+      call tridin(al,ad,cu,r1,r2,au,f1,f2,                 &
+		  its,ite,kts,kte,1                         )
+!
+!     recover tendencies of momentum
+!
+      do k = kte,kts,-1
+        do i = its,ite
+          utend = (f1(i,k)-ux(i,k))*rdt
+          vtend = (f2(i,k)-vx(i,k))*rdt
+          utnp(i,k) = utnp(i,k)+utend
+          vtnp(i,k) = vtnp(i,k)+vtend
+        enddo
+      enddo
+!
+!---- end of vertical diffusion
+!
+      do i = its,ite
+        kpbl1d(i) = kpbl(i)
+      enddo
+!
+   end subroutine ysu2d
+!
+   subroutine tridin(cl,cm,cu,r1,r2,au,f1,f2,                   &
+                     its,ite,kts,kte,nt			        )
+!----------------------------------------------------------------
+   implicit none
+!----------------------------------------------------------------
+!
+   integer, intent(in )      ::     its,ite, kts,kte, nt
+!
+   real, dimension( its:ite, kts+1:kte+1 )                    , &
+         intent(in   )  ::                                  cl
+!
+   real, dimension( its:ite, kts:kte )                        , &
+         intent(in   )  ::                                  cm, &
+							    r1
+   real, dimension( its:ite, kts:kte,nt )                     , &
+         intent(in   )  ::                                  r2
+!
+   real, dimension( its:ite, kts:kte )                        , &
+         intent(inout)  ::                                  au, &
+							    cu, &
+							    f1
+   real, dimension( its:ite, kts:kte,nt )                     , &
+         intent(inout)  ::                                  f2
+!
+   real    :: fk
+   integer :: i,k,l,n,it
+!
+!----------------------------------------------------------------
+!
+   l = ite
+   n = kte
+!
+   do i = its,l
+     fk = 1./cm(i,1)
+     au(i,1) = fk*cu(i,1)
+     f1(i,1) = fk*r1(i,1)
+   enddo
+   do it = 1,nt
+     do i = its,l
+       fk = 1./cm(i,1)
+       f2(i,1,it) = fk*r2(i,1,it)
+     enddo
+   enddo
+   do k = kts+1,n-1
+     do i = its,l
+       fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1))
+       au(i,k) = fk*cu(i,k)
+       f1(i,k) = fk*(r1(i,k)-cl(i,k)*f1(i,k-1))
+     enddo
+   enddo
+   do it = 1,nt
+   do k = kts+1,n-1
+     do i = its,l
+       fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1))
+       f2(i,k,it) = fk*(r2(i,k,it)-cl(i,k)*f2(i,k-1,it))
+     enddo
+   enddo
+   enddo
+   do i = its,l
+     fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1))
+     f1(i,n) = fk*(r1(i,n)-cl(i,n)*f1(i,n-1))
+   enddo
+   do it = 1,nt
+   do i = its,l
+     fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1))
+     f2(i,n,it) = fk*(r2(i,n,it)-cl(i,n)*f2(i,n-1,it))
+   enddo
+   enddo
+   do k = n-1,kts,-1
+     do i = its,l
+       f1(i,k) = f1(i,k)-au(i,k)*f1(i,k+1)
+     enddo
+   enddo
+   do it = 1,nt
+   do k = n-1,kts,-1
+     do i = its,l
+       f2(i,k,it) = f2(i,k,it)-au(i,k)*f2(i,k+1,it)
+     enddo
+   enddo
+   enddo
+!
+   end subroutine tridin
+!
+   subroutine ysuinit(rublten,rvblten,rthblten,rqvblten,           &
+                      rqcblten,rqiblten,p_qi,p_first_scalar,       &
+                      restart, allowed_to_read,                    &
+                      ids, ide, jds, jde, kds, kde,                &
+                      ims, ime, jms, jme, kms, kme,                &
+                      its, ite, jts, jte, kts, kte                 )
+!-------------------------------------------------------------------
+   implicit none
+!-------------------------------------------------------------------
+!
+   logical , intent(in)          :: restart, allowed_to_read
+   integer , intent(in)          ::  ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte
+   integer , intent(in)          ::  p_qi,p_first_scalar
+   real , dimension( ims:ime , kms:kme , jms:jme ), intent(out) :: &
+                                                          rublten, &
+                                                          rvblten, &
+                                                         rthblten, &
+                                                         rqvblten, &
+                                                         rqcblten, &
+                                                         rqiblten
+   integer :: i, j, k, itf, jtf, ktf
+!
+   jtf = min0(jte,jde-1)
+   ktf = min0(kte,kde-1)
+   itf = min0(ite,ide-1)
+!
+   if(.not.restart)then
+     do j = jts,jtf
+     do k = kts,ktf
+     do i = its,itf
+        rublten(i,k,j) = 0.
+        rvblten(i,k,j) = 0.
+        rthblten(i,k,j) = 0.
+        rqvblten(i,k,j) = 0.
+        rqcblten(i,k,j) = 0.
+     enddo
+     enddo
+     enddo
+   endif
+!
+   if (p_qi .ge. p_first_scalar .and. .not.restart) then
+      do j = jts,jtf
+      do k = kts,ktf
+      do i = its,itf
+         rqiblten(i,k,j) = 0.
+      enddo
+      enddo
+      enddo
+   endif
+!
+   end subroutine ysuinit
+!-------------------------------------------------------------------
+end module module_bl_ysu
Index: trunk/WRF.COMMON/WRFV2/phys/module_cu_bmj.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_cu_bmj.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_cu_bmj.F	(revision 2744)
@@ -0,0 +1,1840 @@
+!-----------------------------------------------------------------------
+!
+!WRF:MODEL_LAYER:PHYSICS
+!
+!-----------------------------------------------------------------------
+!
+      MODULE MODULE_CU_BMJ
+!
+!-----------------------------------------------------------------------
+      USE MODULE_MODEL_CONSTANTS
+!-----------------------------------------------------------------------
+!
+      REAL,PARAMETER ::                                                 &
+     &                  DSPC=-3000.                                     &
+     &                 ,DTTOP=0.,EFIFC=5.0,EFIMN=0.20,EFMNT=0.70        & 
+     &                 ,ELIVW=2.72E6,ENPLO=20000.,ENPUP=15000.          &
+     &                 ,EPSDN=1.05,EPSDT=0.                             &
+     &                 ,EPSNTP=.0001,EPSNTT=.0001,EPSPR=1.E-7           &
+     &                 ,EPSUP=1.00                                      &
+     &                 ,FR=1.00,FSL=0.85,FSS=0.85                       &
+     &                 ,FUP=0.                                          &
+     &                 ,PBM=13000.,PFRZ=15000.,PNO=1000.                &
+     &                 ,PONE=2500.,PQM=20000.                           &
+     &                 ,PSH=20000.,PSHU=45000.                          &
+     &                 ,RENDP=1./(ENPLO-ENPUP)                          &
+     &                 ,RHLSC=0.00,RHHSC=1.10                           &
+     &                 ,ROW=1.E3                                        &
+     &                 ,STABDF=0.90,STABDS=0.90                         &
+     &                 ,STABS=1.0,STRESH=1.10                           &
+     &                 ,TREL=2400.
+      REAL,PARAMETER :: DSPBFL=-3875.*FR                                &
+     &                 ,DSP0FL=-5875.*FR                                &
+     &                 ,DSPTFL=-1875.*FR                                &
+     &                 ,DSPBFS=-3875.                                   &
+     &                 ,DSP0FS=-5875.                                   &
+     &                 ,DSPTFS=-1875.
+!
+      REAL,PARAMETER :: PL=2500.,PLQ=70000.,PH=105000.                  &
+     &                 ,THL=210.,THH=365.,THHQ=325.
+!
+      INTEGER,PARAMETER :: ITB=76,JTB=134,ITBQ=152,JTBQ=440
+!
+      INTEGER,PARAMETER :: ITREFI_MAX=3
+!
+!***  ARRAYS FOR LOOKUP TABLES
+!
+      REAL,DIMENSION(ITB),PRIVATE,SAVE :: STHE,THE0
+      REAL,DIMENSION(JTB),PRIVATE,SAVE :: QS0,SQS
+      REAL,DIMENSION(ITBQ),PRIVATE,SAVE :: STHEQ,THE0Q
+      REAL,DIMENSION(ITB,JTB),PRIVATE,SAVE :: PTBL
+      REAL,DIMENSION(JTB,ITB),PRIVATE,SAVE :: TTBL
+      REAL,DIMENSION(JTBQ,ITBQ),PRIVATE,SAVE :: TTBLQ
+
+!***  SHARE COPIES FOR MODULE_BL_MYJPBL
+!
+      REAL,DIMENSION(JTB) :: QS0_EXP,SQS_EXP
+      REAL,DIMENSION(ITB,JTB) :: PTBL_EXP
+!
+      REAL,PARAMETER :: RDP=(ITB-1.)/(PH-PL),RDPQ=(ITBQ-1.)/(PH-PLQ)  &
+     &                 ,RDQ=ITB-1,RDTH=(JTB-1.)/(THH-THL)             &
+     &                 ,RDTHE=JTB-1.,RDTHEQ=JTBQ-1.                   &
+     &                 ,RSFCP=1./101300.
+!
+      REAL,PARAMETER :: AVGEFI=(EFIMN+1.)*0.5
+!-----------------------------------------------------------------------
+!
+CONTAINS
+!
+!-----------------------------------------------------------------------
+      SUBROUTINE BMJDRV(                                                &
+     &                  IDS,IDE,JDS,JDE,KDS,KDE                         &
+     &                 ,IMS,IME,JMS,JME,KMS,KME                         &
+     &                 ,ITS,ITE,JTS,JTE,KTS,KTE                         &
+     &                 ,DT,ITIMESTEP,STEPCU                             &
+     &                 ,RAINCV,CUTOP,CUBOT,KPBL                         &
+     &                 ,TH,T,QV                                         &
+     &                 ,PINT,PMID,PI,RHO,DZ8W                           &
+     &                 ,CP,R,ELWV,ELIV,G,TFRZ,D608                      &
+     &                 ,CLDEFI,LOWLYR,XLAND,CU_ACT_FLAG                 &
+                      ! optional
+     &                 ,RTHCUTEN, RQVCUTEN                              &
+     &                                                                  )
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     & 
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: ITIMESTEP,STEPCU
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: KPBL,LOWLYR
+!
+      REAL,INTENT(IN) :: CP,DT,ELIV,ELWV,G,R,TFRZ,D608
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: XLAND
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DZ8W        &
+     &                                                     ,PI,PINT     &
+     &                                                     ,PMID,QV     &
+     &                                                     ,RHO,T,TH
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME)                           &
+     &    ,OPTIONAL                                                     &
+     &    ,INTENT(INOUT) ::                        RQVCUTEN,RTHCUTEN 
+! 
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CLDEFI,RAINCV
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CUBOT,CUTOP
+!
+      LOGICAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CU_ACT_FLAG
+!
+!-----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+!-----------------------------------------------------------------------
+      INTEGER :: LBOT,LPBL,LTOP
+!
+      REAL :: DTCNVC,LANDMASK,PCPCOL,PSFC,PTOP
+! 
+      REAL,DIMENSION(KTS:KTE) :: DPCOL,DQDT,DTDT,PCOL,QCOL,TCOL
+!
+      INTEGER :: I,J,K,KFLIP,ICLDCK,LMH
+!
+!***  Begin debugging convection
+      REAL :: DELQ,DELT,PLYR
+      INTEGER :: IMD,JMD
+      LOGICAL :: PRINT_DIAG
+!***  End debugging convection
+!
+!-----------------------------------------------------------------------
+!*********************************************************************** 
+!-----------------------------------------------------------------------
+!
+!***  PREPARE TO CALL BMJ CONVECTION SCHEME
+!
+!-----------------------------------------------------------------------
+!
+!***  CHECK TO SEE IF THIS IS A CONVECTION TIMESTEP
+!                                                                        
+      ICLDCK=MOD(ITIMESTEP,STEPCU)                                              
+!-----------------------------------------------------------------------
+!                                                                      
+!***  COMPUTE CONVECTION EVERY STEPCU*DT/60.0 MINUTES
+!                                                                     
+!***  Begin debugging convection
+      IMD=(IMS+IME)/2
+      JMD=(JMS+JME)/2
+      PRINT_DIAG=.FALSE.
+!***  End debugging convection
+
+      IF(ICLDCK==0.OR.ITIMESTEP==0)THEN
+!
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          CU_ACT_FLAG(I,J)=.TRUE.
+        ENDDO
+        ENDDO
+
+!
+        DTCNVC=DT*STEPCU
+!
+        DO J=JTS,JTE  
+        DO I=ITS,ITE
+!
+          DO K=KTS,KTE
+            DQDT(K)=0.
+            DTDT(K)=0.
+          ENDDO
+!
+          RAINCV(I,J)=0.
+          PCPCOL=0.
+          PSFC=PINT(I,LOWLYR(I,J),J)
+          PTOP=PINT(I,KTE+1,J)      ! KTE+1=KME
+!
+!***  CONVERT TO BMJ LAND MASK (1.0 FOR SEA; 0.0 FOR LAND)
+!
+          LANDMASK=XLAND(I,J)-1.
+!
+!***  FILL 1-D VERTICAL ARRAYS 
+!***  AND FLIP DIRECTION SINCE BMJ SCHEME 
+!***  COUNTS DOWNWARD FROM THE DOMAIN'S TOP
+!
+          DO K=KTS,KTE
+            KFLIP=KTE+1-K
+!
+!***  CONVERT FROM MIXING RATIO TO SPECIFIC HUMIDITY
+!
+            QCOL(K)=MAX(EPSQ,QV(I,KFLIP,J)/(1.+QV(I,KFLIP,J)))
+            TCOL(K)=T(I,KFLIP,J)
+            PCOL(K)=PMID(I,KFLIP,J)
+!           DPCOL(K)=PINT(I,KFLIP,J)-PINT(I,KFLIP+1,J)
+            DPCOL(K)=RHO(I,KFLIP,J)*G*DZ8W(I,KFLIP,J)
+          ENDDO
+!
+!***  LOWEST LAYER ABOVE GROUND MUST ALSO BE FLIPPED
+!
+          LMH=KTE+1-LOWLYR(I,J)
+          LPBL=KTE+1-KPBL(I,J)
+!-----------------------------------------------------------------------
+!***
+!***  CALL CONVECTION
+!***
+!-----------------------------------------------------------------------
+!***  Begin debugging convection
+!         PRINT_DIAG=.FALSE.
+!         IF(I==IMD.AND.J==JMD)PRINT_DIAG=.TRUE.
+!***  End debugging convection
+!-----------------------------------------------------------------------
+          CALL BMJ(ITIMESTEP,I,J,DTCNVC,LMH,LANDMASK,CLDEFI(I,J)        &
+     &            ,DPCOL,PCOL,QCOL,TCOL,PSFC,PTOP                       &
+     &            ,DQDT,DTDT,PCPCOL,LBOT,LTOP,LPBL                      &
+     &            ,CP,R,ELWV,ELIV,G,TFRZ,D608                           &   
+     &            ,PRINT_DIAG                                           &   
+     &            ,IDS,IDE,JDS,JDE,KDS,KDE                              &     
+     &            ,IMS,IME,JMS,JME,KMS,KME                              &
+     &            ,ITS,ITE,JTS,JTE,KTS,KTE)
+!-----------------------------------------------------------------------
+! 
+!***  COMPUTE HEATING AND MOISTENING TENDENCIES
+!
+          IF ( PRESENT( RTHCUTEN ) .AND. PRESENT( RQVCUTEN )) THEN
+            DO K=KTS,KTE
+              KFLIP=KTE+1-K
+              RTHCUTEN(I,K,J)=DTDT(KFLIP)/PI(I,K,J)
+!
+!***  CONVERT FROM SPECIFIC HUMIDTY BACK TO MIXING RATIO
+!
+              RQVCUTEN(I,K,J)=DQDT(KFLIP)/(1.-QCOL(KFLIP))**2
+            ENDDO
+          ENDIF
+!
+!***  ALL UNITS IN BMJ SCHEME ARE MKS, THUS CONVERT PRECIP FROM METERS
+!***  TO MILLIMETERS PER STEP FOR OUTPUT.
+!
+          RAINCV(I,J)=PCPCOL*1.E3/STEPCU
+!
+!***  CONVECTIVE CLOUD TOP AND BOTTOM FROM THIS CALL
+!
+          CUTOP(I,J)=REAL(KTE+1-LTOP)
+          CUBOT(I,J)=REAL(KTE+1-LBOT)
+!
+!-----------------------------------------------------------------------
+!***  Begin debugging convection
+          IF(PRINT_DIAG)THEN
+            DELT=0.
+            DELQ=0.
+            PLYR=0.
+            IF(LBOT>0.AND.LTOP<LBOT)THEN
+              DO K=LTOP,LBOT
+                PLYR=PLYR+DPCOL(K)
+                DELQ=DELQ+DPCOL(K)*DTCNVC*ABS(DQDT(K))
+                DELT=DELT+DPCOL(K)*DTCNVC*ABS(DTDT(K))
+              ENDDO
+              DELQ=DELQ/PLYR
+              DELT=DELT/PLYR
+            ENDIF
+!
+            WRITE(6,"(2a,2i4,3e12.4,f7.2,4i3)") &
+                 '{cu3 i,j,PCPCOL,DTavg,DQavg,PLYR,'  &
+                 ,'LBOT,LTOP,CUBOT,CUTOP = '  &
+                 ,i,j, PCPCOL,DELT,1000.*DELQ,.01*PLYR  &
+                 ,LBOT,LTOP,NINT(CUBOT(I,J)),NINT(CUTOP(I,J))
+!
+            IF(PLYR> 0.)THEN
+              DO K=LBOT,LTOP,-1
+                KFLIP=KTE+1-K
+                WRITE(6,"(a,i3,2e12.4,f7.2)") '{cu3a KFLIP,DT,DQ,DP = ' &
+                     ,KFLIP,DTCNVC*DTDT(K),1000.*DTCNVC*DQDT(K),.01*DPCOL(K)
+              ENDDO
+            ENDIF
+          ENDIF
+!***  End debugging convection
+!-----------------------------------------------------------------------
+!
+        ENDDO
+        ENDDO
+!
+      ENDIF
+!
+      END SUBROUTINE BMJDRV
+!-----------------------------------------------------------------------
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!-----------------------------------------------------------------------
+                          SUBROUTINE BMJ                                &
+!-----------------------------------------------------------------------
+     & (ITIMESTEP,I,J,DTCNVC,LMH,SM,CLDEFI                              &
+     & ,DPRS,PRSMID,Q,T,PSFC,PT                                         &
+     & ,DQDT,DTDT,PCPCOL,LBOT,LTOP,LPBL                                 &
+     & ,CP,R,ELWV,ELIV,G,TFRZ,D608                                      &
+     & ,PRINT_DIAG                                                      &   
+     & ,IDS,IDE,JDS,JDE,KDS,KDE                                         &
+     & ,IMS,IME,JMS,JME,KMS,KME                                         &
+     & ,ITS,ITE,JTS,JTE,KTS,KTE)
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+                           ,IMS,IME,JMS,JME,KMS,KME                     &
+                           ,ITS,ITE,JTS,JTE,KTS,KTE                     &
+                           ,I,J,ITIMESTEP
+! 
+      INTEGER,INTENT(IN) :: LMH,LPBL
+!
+      INTEGER,INTENT(OUT) :: LBOT,LTOP
+!
+      REAL,INTENT(IN) :: CP,D608,DTCNVC,ELIV,ELWV,G,PSFC,PT,R,SM,TFRZ
+!
+      REAL,DIMENSION(KTS:KTE),INTENT(IN) :: DPRS,PRSMID,Q,T
+!
+      REAL,INTENT(INOUT) :: CLDEFI,PCPCOL
+!
+      REAL,DIMENSION(KTS:KTE),INTENT(INOUT) :: DQDT,DTDT
+!
+!-----------------------------------------------------------------------
+!***  DEFINE LOCAL VARIABLES
+!-----------------------------------------------------------------------
+!                                                            
+      REAL,DIMENSION(KTS:KTE) :: APEK,APESK,EL,FPK                      &
+                                ,PK,PSK,QK,QREFK,QSATK                  &
+                                ,THERK,THEVRF,THSK                      &
+                                ,THVMOD,THVREF,TK,TREFK
+!
+      REAL,DIMENSION(KTS:KTE) :: APE,DIFQ,DIFT,THEE,THES,TREF
+!
+      LOGICAL :: DEEP,SHALLOW
+!
+!***  Begin debugging convection
+      LOGICAL :: PRINT_DIAG
+!***  End debugging convection
+!
+!-----------------------------------------------------------------------
+!***
+!***  LOCAL SCALARS
+!***
+!-----------------------------------------------------------------------
+      REAL :: APEKL,APEKXX,APEKXY,APES,APESP,APESTS                     &
+     &            ,AVRGT,AVRGTL,BQ,BQK,BQS00K,BQS10K                    &
+     &            ,CAPA,CUP,DEN,DENTPY,DEPMIN,DEPTH                     &
+     &            ,DEPWL,DHDT,DIFQL,DIFTL,DP,DPKL,DPLO,DPMIX,DPOT       &
+     &            ,DPUP,DQREF,DRHDP,DRHEAT,DSP                          &
+     &            ,DSP0,DSP0K,DSPB,DSPBK,DSPT,DSPTK                     &
+     &            ,DSQ,DST,DSTQ,DTHEM,DTDP,EFI                          &
+     &            ,FEFI,FFUP,FPRS,FPTK,HCORR                            &
+     &            ,OTSUM,P,P00K,P01K,P10K,P11K                          &
+     &            ,PART1,PART2,PART3,PBOT,PBOTFC,PBTK                   &
+     &            ,PK0,PKB,PKL,PKT,PKXXXX,PKXXXY                        &
+     &            ,PLMH,plo,POTSUM,PP1,PPK,PRECK                        &
+     &            ,PRESK,PSP,PSUM,PTHRS,PTOP,PTPK,PUP                   &
+     &            ,QBT,QKL,QNEW,QOTSUM,QQ1,QQBT,QQK,QRFKL               &
+     &            ,QRFTP,QSP,QSUM,QUP,RDP0T                             &
+     &            ,RDPSUM,RDTCNVC,RHH,RHL,RHMAX,ROTSUM,RTBAR            &
+     &            ,SM1,SMIX,SQ,SQK,SQS00K,SQS10K,STABDL,SUMDE,SUMDP     &
+     &            ,SUMDT,TAUK,TAUKSC,TCORR,THBT,THERKX,THERKY           &
+     &            ,THESP,THSKL,THTPK,THVMKL,TKL,TNEW                    &
+     &            ,TPSP,TQ,TQK,TREFKX,TRFKL,trmlo,trmup,TSKL,tsp,TTH    &
+     &            ,TTHBT,TTHES,TTHK,TUP 
+!
+      INTEGER :: IQ,IQTB,IT,ITER,ITREFI,ITTB,ITTBK,KB,KBMAX,KNUMH,KNUML &
+     &          ,L,L0,L0M1,LB,LBM1,LCOR,LPT1                            &
+     &          ,LQM,LSHU,LTP1,LTP2,LTSH
+!-----------------------------------------------------------------------
+!
+      REAL,PARAMETER :: DSPBSL=DSPBFL*FSL,DSP0SL=DSP0FL*FSL             &
+     &                 ,DSPTSL=DSPTFL*FSL                               &
+     &                 ,DSPBSS=DSPBFS*FSS,DSP0SS=DSP0FS*FSS             &
+     &                 ,DSPTSS=DSPTFS*FSS
+!
+      REAL,PARAMETER :: ELEVFC=0.8,STEFI=1.
+!
+      REAL,PARAMETER :: SLOPBL=(DSPBFL-DSPBSL)/(1.-EFIMN)               &
+     &                 ,SLOP0L=(DSP0FL-DSP0SL)/(1.-EFIMN)               &
+     &                 ,SLOPTL=(DSPTFL-DSPTSL)/(1.-EFIMN)               &
+     &                 ,SLOPBS=(DSPBFS-DSPBSS)/(1.-EFIMN)               &
+     &                 ,SLOP0S=(DSP0FS-DSP0SS)/(1.-EFIMN)               &
+     &                 ,SLOPTS=(DSPTFS-DSPTSS)/(1.-EFIMN)               &
+     &                 ,SLOPST=(STABDF-STABDS)/(1.-EFIMN)               &
+     &                 ,SLOPE=(1.-EFMNT)/(1.-EFIMN)
+!
+      REAL :: A23M4L,CPRLG,ELOCP,RCP
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+      CAPA=R/CP
+      CPRLG=CP/(ROW*G*ELWV)
+      ELOCP=ELIVW/CP
+      RCP=1./CP
+      A23M4L=A2*(A3-A4)*ELWV
+      RDTCNVC=1./DTCNVC
+!
+      DEEP=.FALSE.
+      SHALLOW=.FALSE.
+!
+      DSP0=0.
+      DSPB=0.
+      DSPT=0.
+      PSP=0.
+!-----------------------------------------------------------------------
+      TAUK=DTCNVC/TREL
+      TAUKSC=DTCNVC/(1.0*TREL) 
+!-----------------------------------------------------------------------
+!-----------------------------PREPARATIONS------------------------------
+!-----------------------------------------------------------------------
+      LBOT=LMH
+      THESP=0.
+      PCPCOL=0.
+      TREF(KTS)=T(KTS)
+!
+      KBMAX=LMH
+!
+      DO L=KTS,LMH
+        APESTS=PRSMID(L)
+        APE(L)=(1.E5/APESTS)**CAPA
+      ENDDO
+!-----------------------------------------------------------------------
+!----------------SEARCH FOR MAXIMUM BUOYANCY LEVEL----------------------
+!-----------------------------------------------------------------------
+                             DO 170 KB=1,LMH
+!-----------------------------------------------------------------------
+!----------------TRIAL MAXIMUM BUOYANCY LEVEL VARIABLES-----------------
+!-----------------------------------------------------------------------
+!
+      PKL=PRSMID(KB)
+      PLMH=PRSMID(LMH)
+!
+!-----------------------------------------------------------------------
+!***  SEARCH OVER A SCALED DEPTH IN FINDING THE PARCEL
+!***  WITH THE MAX THETA-E 
+!-----------------------------------------------------------------------
+      IF(KB<=LMH)THEN
+!-----------------------------------------------------------------------
+        QBT=Q(KB)
+        TTHBT=T(KB)*APE(KB)
+        TTH=(TTHBT-THL)*RDTH
+        QQ1=TTH-AINT(TTH)
+        ITTB=INT(TTH)+1
+!----------------KEEPING INDICES WITHIN THE TABLE-----------------------
+        IF(ITTB<1)THEN
+          ITTB=1
+          QQ1=0.
+        ENDIF
+!
+        IF(ITTB>=JTB)THEN
+          ITTB=JTB-1
+          QQ1=0.
+        ENDIF
+!--------------BASE AND SCALING FACTOR FOR SPEC. HUMIDITY---------------
+        ITTBK=ITTB
+        BQS00K=QS0(ITTBK)
+        SQS00K=SQS(ITTBK)
+        BQS10K=QS0(ITTBK+1)
+        SQS10K=SQS(ITTBK+1)
+!--------------SCALING SPEC. HUMIDITY & TABLE INDEX---------------------
+        BQ=(BQS10K-BQS00K)*QQ1+BQS00K
+        SQ=(SQS10K-SQS00K)*QQ1+SQS00K
+        TQ=(QBT-BQ)/SQ*RDQ
+        PP1=TQ-AINT(TQ)
+        IQTB=INT(TQ)+1
+!----------------KEEPING INDICES WITHIN THE TABLE-----------------------
+        IF(IQTB<1)THEN
+          IQTB=1
+          PP1=0.
+        ENDIF
+!
+        IF(IQTB>=ITB)THEN
+          IQTB=ITB-1
+          PP1=0.
+        ENDIF
+!--------------SATURATION PRESSURE AT FOUR SURROUNDING TABLE PTS.-------
+        IQ=IQTB
+        IT=ITTB
+        P00K=PTBL(IQ  ,IT  )
+        P10K=PTBL(IQ+1,IT  )
+        P01K=PTBL(IQ  ,IT+1)
+        P11K=PTBL(IQ+1,IT+1)
+!
+!--------------SATURATION POINT VARIABLES AT THE BOTTOM-----------------
+!
+        TPSP=P00K+(P10K-P00K)*PP1+(P01K-P00K)*QQ1                       &
+     &           +(P00K-P10K-P01K+P11K)*PP1*QQ1
+        APESP=(1.E5/TPSP)**CAPA
+        TTHES=TTHBT*EXP(ELOCP*QBT*APESP/TTHBT)
+        THES(KB)=TTHES
+!
+!--------------CHECK FOR MAXIMUM BUOYANCY-------------------------------
+!
+          IF(PKL>=ELEVFC*PLMH.AND.TTHES>THESP)THEN
+            PSP  =TPSP
+            APES =APESP
+            THBT =TTHBT
+            THESP=TTHES
+            QQBT=QBT 
+            KBMAX=KB
+          ENDIF ! End of search for maximum buoyancy level
+!-----------------------------------------------------------------------
+      ENDIF
+!-----------------------------------------------------------------------
+  170 CONTINUE
+!-----------------------------------------------------------------------
+!-----------CHOOSE CLOUD BASE AS MODEL LEVEL JUST BELOW PSP-------------
+!-----------------------------------------------------------------------
+      DO L=KTS,LMH-1
+        P=PRSMID(L)
+        IF(P<PSP.AND.P>=PQM)LBOT=L+1
+      ENDDO
+!***
+!*** WARNING: LBOT MUST NOT BE GT LMH-1 IN SHALLOW CONVECTION
+!*** MAKE SURE CLOUD BASE IS AT LEAST PONE ABOVE THE SURFACE
+!***
+      PBOT=PRSMID(LBOT)
+      PLMH=PRSMID(LMH)
+      IF(PBOT>=PLMH-PONE.OR.LBOT>=LMH)THEN
+!
+        DO L=KTS,LMH-1
+          P=PRSMID(L)
+          IF(P<PLMH-PONE)LBOT=L
+        ENDDO
+!
+        PBOT=PRSMID(LBOT)
+      ENDIF 
+!-----------------------------------------------------------------------
+!----------------CLOUD TOP COMPUTATION----------------------------------
+!-----------------------------------------------------------------------
+      LTOP=LBOT
+      PTOP=PBOT
+!----------------ENTRAINMENT DURING PARTICLE ASCENT---------------------
+!
+      DO L=LMH,KBMAX,-1
+        THES(L)=THESP
+      ENDDO
+!
+      DO L=KTS,LMH
+        THEE(L)=THES(L)
+      ENDDO
+!
+      FEFI=(CLDEFI-EFIMN)*SLOPE+EFMNT
+      FFUP=FUP/(FEFI*FEFI)
+!
+      IF(PBOT>ENPLO)THEN
+        FPRS=1.
+      ELSEIF(PBOT>ENPUP)THEN
+        FPRS=(PBOT-ENPUP)*RENDP
+      ELSE
+        FPRS=0.
+      ENDIF
+!
+      FFUP=FFUP*FPRS*FPRS*0.5
+      DPUP=DPRS(KBMAX)
+!
+      DO L=KBMAX-1,KTS,-1
+        DPLO=DPUP
+        DPUP=DPRS(L)
+!
+        THES(L)=((-FFUP*DPLO+1.)*THES(L+1)                              &
+     &          +(THEE(L)*DPUP+THEE(L+1)*DPLO)*FFUP)                    &
+     &         /(FFUP*DPUP+1.)
+      ENDDO
+!-----------------------------------------------------------------------
+!***
+!***  COMPUTE PARCEL TEMPERATURE ALONG THE ASCENT TRAJECTORY
+!***  SCALING PRESSURE & TT TABLE INDEX.
+!***
+!
+      DO L=LMH,KTS,-1
+!
+        PRESK=PRSMID(L)
+!
+        IF(PRESK<PLQ)THEN
+          CALL TTBLEX(ITB,JTB,PL,PRESK,RDP,RDTHE                        &
+     &               ,STHE,THE0,THES(L),TTBL,TREF(L))
+        ELSE
+          CALL TTBLEX(ITBQ,JTBQ,PLQ,PRESK,RDPQ,RDTHEQ                   &
+     &               ,STHEQ,THE0Q,THES(L),TTBLQ,TREF(L))
+        ENDIF
+!
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!----------------BUOYANCY CHECK-----------------------------------------
+!-----------------------------------------------------------------------
+!
+      DO L=LMH,KTS,-1
+        IF(TREF(L)>T(L)-DTTOP)LTOP=L
+      ENDDO
+!
+!***  CLOUD TOP PRESSURE
+!
+      PTOP=PRSMID(LTOP)
+!
+!------------------FIRST ENTROPY CHECK----------------------------------
+!
+!      IF(KBMAX>LBOT.AND.LBOT>LTOP)THEN
+!!-----------------------------------------------------------------------
+!        DENTPY=0.
+!        SUMDP=0.
+!        L=KBMAX
+!        PLO=PRSMID(L)
+!        TRMLO=0.
+!!
+!        DO L=KBMAX-1,LBOT+1,-1
+!          PUP=PRSMID(L)
+!          TUP=THBT/APE(L)
+!          DP=PLO-PUP
+!          TRMUP=(TUP*(QQBT*0.608+1.)                                    &
+!     &          -T(L)*(Q(L)*0.608+1.))*0.5                              &
+!     &           /(T(L)*(Q(L)*0.608+1.))
+!          DENTPY=(TRMLO+TRMUP)*DP+DENTPY
+!          SUMDP=SUMDP+DP
+!          PLO=PUP
+!          TRMLO=TRMUP
+!        ENDDO
+!!
+!        L=LBOT
+!        PUP=PSP
+!        TUP=THBT/APES
+!        TSP=(T(L+1)-T(L))/(PLO-PBOT)                                    &
+!     &     *(PUP-PBOT)+T(L)
+!        QSP=(Q(L+1)-Q(L))/(PLO-PBOT)                                    &
+!     &     *(PUP-PBOT)+Q(L)
+!        DP=PLO-PUP
+!        TRMUP=(TUP*(QQBT*0.608+1.)                                      &
+!     &        -TSP*(QSP*0.608+1.))*0.5                                  &
+!     &       /(TSP*(QSP*0.608+1.))
+!        DENTPY=(TRMLO+TRMUP)*DP+DENTPY
+!        SUMDP=SUMDP+DP
+!        PLO=PUP
+!        TRMLO=TRMUP
+!        PUP=PRSMID(L)
+!        TUP=TREF(L)
+!        QUP=PQ0/PUP*EXP(A2*(TUP-A3)/(TUP-A4))
+!        DP=PLO-PUP
+!        TRMUP=(TUP*(QUP*0.608+1.)                                       &
+!     &        -T(L)*(Q(L)*0.608+1.))*0.5                                &
+!     &       /(T(L)*(Q(L)*0.608+1.))
+!        DENTPY=(TRMLO+TRMUP)*DP+DENTPY
+!        SUMDP=SUMDP+DP
+!        PLO=PUP
+!        TRMLO=TRMUP
+!!
+!        DO L=LBOT-1,LTOP
+!          PUP=PRSMID(L)
+!          TUP=TREF(L)
+!          QUP=PQ0/PUP*EXP(A2*(TUP-A3)/(TUP-A4))
+!          DP=PLO-PUP
+!          TRMUP=(TUP*(QUP*0.608+1.)                                     &
+!     &          -T(L)*(Q(L)*0.608+1.))*0.5                              &
+!     &         /(T(L)*(Q(L)*0.608+1.))
+!          DENTPY=(TRMLO+TRMUP)*DP+DENTPY
+!          SUMDP=SUMDP+DP
+!          PLO=PUP
+!          TRMLO=TRMUP
+!        ENDDO
+!!
+!        DENTPY=DENTPY*CP/SUMDP
+!        IF(DENTPY<=EPSNTT)THEN
+!          LTOP=LBOT
+!          PTOP=PBOT
+!        ENDIF
+!!-----------------------------------------------------------------------
+!      ENDIF
+!-----------------------------------------------------------------------
+!***
+!***  CLEAN UP AND GATHER DEEP CONVECTION POINTS
+!***
+      IF(LTOP>=LBOT)THEN
+        LBOT=0
+!!        LTOP=LBOT
+        LTOP=KTE
+        PTOP=PBOT
+      ENDIF
+
+!
+      IF(PTOP>PBOT-PNO.OR.LTOP>LBOT-2)THEN
+        CLDEFI=AVGEFI*SM+STEFI*(1.-SM)
+      ENDIF
+!
+!***  DEPTH OF CLOUD REQUIRED TO MAKE THE POINT A DEEP CONVECTION POINT
+!***  IS A SCALED VALUE OF PSFC.
+!
+      DEPMIN=PSH*PSFC*RSFCP
+      DEPTH=PBOT-PTOP
+!
+      IF(DEPTH>=DEPMIN)THEN
+        DEEP=.TRUE.
+      ENDIF
+!***********************************************************************
+!************************ DEEP CONVECTION ******************************
+!***********************************************************************
+      IF(.NOT.DEEP)GO TO 600
+!***********************************************************************
+!DCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD
+!DCDCDCDCDCDCDC  DEEP CONVECTION   DCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD
+!DCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD
+!
+  300 CONTINUE
+!
+      LB =LBOT
+      EFI=CLDEFI
+!--------------INITIALIZE VARIABLES IN THE CONVECTIVE COLUMN------------
+!***
+!***  ONE SHOULD NOTE THAT THE VALUES ASSIGNED TO THE ARRAY TREFK
+!***  IN THE FOLLOWING LOOP ARE REALLY ONLY RELEVANT IN ANCHORING THE
+!***  REFERENCE TEMPERATURE PROFILE AT LEVEL LB.  WHEN BUILDING THE
+!***  REFERENCE PROFILE FROM CLOUD BASE, THEN ASSIGNING THE
+!***  AMBIENT TEMPERATURE TO TREFK IS ACCEPTABLE.  HOWEVER, WHEN
+!***  BUILDING THE REFERENCE PROFILE FROM SOME OTHER LEVEL (SUCH AS
+!***  ONE LEVEL ABOVE THE GROUND), THEN TREFK SHOULD BE FILLED WITH
+!***  THE TEMPERATURES IN TREF(L) WHICH ARE THE TEMPERATURES OF
+!***  THE MOIST ADIABAT THROUGH CLOUD BASE.  BY THE TIME THE LINE 
+!***  NUMBERED 450 HAS BEEN REACHED, TREFK ACTUALLY DOES HOLD THE
+!***  REFERENCE TEMPERATURE PROFILE.
+!***
+      DO L=KTS,LMH
+        DIFT  (L)=0.
+        DIFQ  (L)=0.
+        TKL      =T(L)
+        TK    (L)=TKL
+        TREFK (L)=TKL
+        QKL      =Q(L)
+        QK    (L)=QKL
+        QREFK (L)=QKL
+        PKL      =PRSMID(L)
+        PK    (L)=PKL
+        PSK   (L)=PKL
+        APEKL    =APE(L)
+        APEK  (L)=APEKL
+        THERK (L)=TREF(L)*APEKL
+      ENDDO
+!------------DEEP CONVECTION REFERENCE TEMPERATURE PROFILE------------
+      LTP1=LTOP+1
+      LBM1=LB-1
+      PKB=PK(LB)
+      PKT=PK(LTOP)
+      STABDL=(EFI-EFIMN)*SLOPST+STABDS
+!------------TEMPERATURE REFERENCE PROFILE BELOW FREEZING LEVEL-------
+      EL(LB) = ELWV    
+      L0=LB
+      PK0=PK(LB)
+      TREFKX=TREFK(LB)
+      THERKX=THERK(LB)
+      APEKXX=APEK(LB)
+      THERKY=THERK(LBM1)
+      APEKXY=APEK(LBM1)
+!
+      DO L=LBM1,LTOP,-1
+        IF(T(L+1)<TFRZ)GO TO 430
+        TREFKX=((THERKY-THERKX)*STABDL                                  &
+     &          +TREFKX*APEKXX)/APEKXY
+        TREFK(L)=TREFKX
+        EL(L)=ELWV
+        APEKXX=APEKXY
+        THERKX=THERKY
+        APEKXY=APEK(L-1)
+        THERKY=THERK(L-1)
+        L0=L
+        PK0=PK(L0)
+      ENDDO
+!--------------FREEZING LEVEL AT OR ABOVE THE CLOUD TOP-----------------
+      GO TO 450
+!--------------TEMPERATURE REFERENCE PROFILE ABOVE FREEZING LEVEL-------
+  430 L0M1=L0-1
+      RDP0T=1./(PK0-PKT)
+      DTHEM=THERK(L0)-TREFK(L0)*APEK(L0)
+!
+      DO L=LTOP,L0M1
+        TREFK(L)=(THERK(L)-(PK(L)-PKT)*DTHEM*RDP0T)/APEK(L)
+        EL(L)=ELWV !ELIV
+      ENDDO
+!-----------------------------------------------------------------------
+!--------------DEEP CONVECTION REFERENCE HUMIDITY PROFILE---------------
+!-----------------------------------------------------------------------
+!
+!***  DEPWL IS THE PRESSURE DIFFERENCE BETWEEN CLOUD BASE AND
+!***  THE FREEZING LEVEL
+!
+  450 CONTINUE
+      DEPWL=PKB-PK0
+      DEPTH=PFRZ*PSFC*RSFCP
+      SM1=1.-SM
+      PBOTFC=1.
+!
+!-------------FIRST ADJUSTMENT OF TEMPERATURE PROFILE-------------------
+!!
+!      SUMDT=0.
+!      SUMDP=0.
+!!
+!      DO L=LTOP,LB
+!        SUMDT=(TK(L)-TREFK(L))*DPRS(L)+SUMDT
+!        SUMDP=SUMDP+DPRS(L)
+!      ENDDO
+!!
+!      TCORR=SUMDT/SUMDP
+!!
+!      DO L=LTOP,LB
+!        TREFK(L)=TREFK(L)+TCORR
+!      ENDDO
+!!
+!-----------------------------------------------------------------------
+!--------------- ITERATION LOOP FOR CLOUD EFFICIENCY -------------------
+!-----------------------------------------------------------------------
+!
+      cloud_efficiency : DO ITREFI=1,ITREFI_MAX  
+!
+!-----------------------------------------------------------------------
+      DSPBK=((EFI-EFIMN)*SLOPBS+DSPBSS*PBOTFC)*SM                       &
+     &     +((EFI-EFIMN)*SLOPBL+DSPBSL*PBOTFC)*SM1
+      DSP0K=((EFI-EFIMN)*SLOP0S+DSP0SS*PBOTFC)*SM                       &
+     &     +((EFI-EFIMN)*SLOP0L+DSP0SL*PBOTFC)*SM1
+      DSPTK=((EFI-EFIMN)*SLOPTS+DSPTSS*PBOTFC)*SM                       &
+     &     +((EFI-EFIMN)*SLOPTL+DSPTSL*PBOTFC)*SM1
+!
+!-----------------------------------------------------------------------
+!
+      DO L=LTOP,LB
+!
+!***
+!***  SATURATION PRESSURE DIFFERENCE
+!***
+        IF(DEPWL>=DEPTH)THEN
+          IF(L<L0)THEN
+            DSP=((PK0-PK(L))*DSPTK+(PK(L)-PKT)*DSP0K)/(PK0-PKT)
+          ELSE
+            DSP=((PKB-PK(L))*DSP0K+(PK(L)-PK0)*DSPBK)/(PKB-PK0)
+          ENDIF
+        ELSE
+          DSP=DSP0K
+          IF(L<L0)THEN
+            DSP=((PK0-PK(L))*DSPTK+(PK(L)-PKT)*DSP0K)/(PK0-PKT)
+          ENDIF
+        ENDIF
+!***
+!***  HUMIDITY PROFILE
+!***
+        IF(PK(L)>PQM)THEN
+          PSK(L)=PK(L)+DSP
+          APESK(L)=(1.E5/PSK(L))**CAPA
+          THSK(L)=TREFK(L)*APEK(L)
+          QREFK(L)=PQ0/PSK(L)*EXP(A2*(THSK(L)-A3*APESK(L))              &
+     &                              /(THSK(L)-A4*APESK(L)))
+        ELSE
+          QREFK(L)=QK(L)
+        ENDIF
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!***
+!***  ENTHALPY CONSERVATION INTEGRAL
+!***
+!-----------------------------------------------------------------------
+      enthalpy_conservation : DO ITER=1,2
+!
+        SUMDE=0.
+        SUMDP=0.
+!
+        DO L=LTOP,LB
+          SUMDE=((TK(L)-TREFK(L))*CP+(QK(L)-QREFK(L))*EL(L))*DPRS(L)    &
+     &          +SUMDE
+          SUMDP=SUMDP+DPRS(L)
+        ENDDO
+!
+        HCORR=SUMDE/(SUMDP-DPRS(LTOP))
+        LCOR=LTOP+1
+!***
+!***  FIND LQM
+!***
+        LQM=1
+        DO L=KTS,LB
+          IF(PK(L)<=PQM)LQM=L
+        ENDDO
+!***
+!***  ABOVE LQM CORRECT TEMPERATURE ONLY
+!***
+        IF(LCOR<=LQM)THEN
+          DO L=LCOR,LQM
+            TREFK(L)=TREFK(L)+HCORR*RCP
+          ENDDO
+          LCOR=LQM+1
+        ENDIF
+!***
+!***  BELOW LQM CORRECT BOTH TEMPERATURE AND MOISTURE
+!***
+        DO L=LCOR,LB
+          TSKL=TREFK(L)*APEK(L)/APESK(L)
+          DHDT=QREFK(L)*A23M4L/(TSKL-A4)**2+CP
+          TREFK(L)=HCORR/DHDT+TREFK(L)
+          THSKL=TREFK(L)*APEK(L)
+          QREFK(L)=PQ0/PSK(L)*EXP(A2*(THSKL-A3*APESK(L))                &
+     &                              /(THSKL-A4*APESK(L)))
+        ENDDO
+!
+      ENDDO  enthalpy_conservation
+!-----------------------------------------------------------------------
+!
+!***  HEATING, MOISTENING, PRECIPITATION
+!
+!-----------------------------------------------------------------------
+      AVRGT=0.
+      PRECK=0.
+      DSQ=0.
+      DST=0.
+!
+      DO L=LTOP,LB
+        TKL=TK(L)
+        DIFTL=(TREFK(L)-TKL  )*TAUK
+        DIFQL=(QREFK(L)-QK(L))*TAUK
+        AVRGTL=(TKL+TKL+DIFTL)
+        DPOT=DPRS(L)/AVRGTL
+        DST=DIFTL*DPOT+DST
+        DSQ=DIFQL*EL(L)*DPOT+DSQ
+        AVRGT=AVRGTL*DPRS(L)+AVRGT
+        PRECK=DIFTL*DPRS(L)+PRECK
+        DIFT(L)=DIFTL
+        DIFQ(L)=DIFQL
+      ENDDO
+!
+      DST=(DST+DST)*CP
+      DSQ=DSQ+DSQ
+      DENTPY=DST+DSQ
+      AVRGT=AVRGT/(SUMDP+SUMDP)
+!
+!      DRHEAT=PRECK*CP/AVRGT
+      DRHEAT=(PRECK*SM+MAX(1.E-7,PRECK)*(1.-SM))*CP/AVRGT !As in Eta!
+      DRHEAT=MAX(DRHEAT,1.E-20)
+      EFI=EFIFC*DENTPY/DRHEAT
+!-----------------------------------------------------------------------
+      EFI=MIN(EFI,1.)
+      EFI=MAX(EFI,EFIMN)
+!-----------------------------------------------------------------------
+      ENDDO  cloud_efficiency
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!---------------------- DEEP CONVECTION --------------------------------
+!-----------------------------------------------------------------------
+      IF(DENTPY>=EPSNTP.AND.PRECK>EPSPR)THEN
+!
+        CLDEFI=EFI
+        FEFI=EFMNT+SLOPE*(EFI-EFIMN)
+        FEFI=(DENTPY-EPSNTP)*FEFI/DENTPY
+        PRECK=PRECK*FEFI
+!
+!***  UPDATE PRECIPITATION AND TENDENCIES OF TEMPERATURE AND MOISTURE
+!
+        CUP=PRECK*CPRLG
+        PCPCOL=CUP
+!
+        DO L=LTOP,LB
+          DTDT(L)=DIFT(L)*FEFI*RDTCNVC
+          DQDT(L)=DIFQ(L)*FEFI*RDTCNVC
+        ENDDO
+!
+      ELSE
+!
+!-----------------------------------------------------------------------
+!***  REDUCE THE CLOUD TOP
+!-----------------------------------------------------------------------
+!
+!        LTOP=LTOP+3
+!        PTOP=PRSMID(LTOP)
+!        DEPMIN=PSH*PSFC*RSFCP
+!        DEPTH=PBOT-PTOP
+!***
+!***  ITERATE DEEP CONVECTION PROCEDURE IF NEEDED
+!***
+!        IF(DEPTH>=DEPMIN)THEN
+!          GO TO 300
+!        ENDIF
+!
+!        CLDEFI=AVGEFI
+         CLDEFI=EFIMN*SM+STEFI*(1.-SM)
+!***
+!***  SEARCH FOR SHALLOW CLOUD TOP
+!***
+        LTSH=LBOT
+        LBM1=LBOT-1
+        PBTK=PK(LBOT)
+        DEPMIN=PSH*PSFC*RSFCP
+        PTPK=PBTK-DEPMIN
+!***
+!***  CLOUD TOP IS THE LEVEL JUST BELOW PBTK-PSH
+!***
+        DO L=KTS,LMH
+          IF(PK(L)<=PTPK)LTOP=L+1
+        ENDDO
+!
+        PTPK=PK(LTOP)
+!***
+!***  HIGHEST LEVEL ALLOWED IS LEVEL JUST BELOW PSHU
+!***
+        IF(PTPK<=PSHU)THEN
+!
+          DO L=KTS,LMH
+            IF(PK(L)<=PSHU)LSHU=L+1
+          ENDDO
+!
+          LTOP=LSHU
+          PTPK=PK(LTOP)
+        ENDIF
+!
+!        if(ltop>=lbot)then
+!!!!!!     lbot=0
+!          ltop=lmh
+!!!!!!     pbot=pk(lbot)
+!          ptop=pk(ltop)
+!          pbot=ptop
+!          go to 600
+!        endif
+!
+        LTP1=LTOP+1
+        LTP2=LTOP+2
+!
+        DO L=LTOP,LBOT
+          QSATK(L)=PQ0/PK(L)*EXP(A2*(TK(L)-A3)/(TK(L)-A4))
+        ENDDO
+!
+        RHH=QK(LTOP)/QSATK(LTOP)
+        RHMAX=0.
+!
+        DO L=LTP1,LBM1
+          RHL=QK(L)/QSATK(L)
+          DRHDP=(RHH-RHL)/(PK(L-1)-PK(L))
+!
+          IF(DRHDP>RHMAX)THEN
+            LTSH=L-1
+            RHMAX=DRHDP
+          ENDIF
+!
+          RHH=RHL
+        ENDDO
+!
+        LTOP=LTSH
+!***
+!***  CLOUD MUST BE AT LEAST TWO LAYERS THICK
+!***
+        IF(LBOT-LTOP<2)LTOP=LBOT-2
+!
+        PTOP=PK(LTOP)
+!
+      ENDIF
+!DCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD
+!DCDCDCDCDCDCDC          END OF DEEP CONVECTION            DCDCDCDCDCDCD
+!DCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+  600 CONTINUE
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!----------------GATHER SHALLOW CONVECTION POINTS-----------------------
+!
+      IF(PTOP<=PBOT-PNO.AND.LTOP<=LBOT-2)THEN
+         DEPMIN=PSH*PSFC*RSFCP
+!
+!        if(lpbl<lbot)lbot=lpbl
+!        if(lbot>lmh-1)lbot=lmh-1
+!        pbot=prsmid(lbot)
+!
+         IF(PTOP+1.>=PBOT-DEPMIN)SHALLOW=.TRUE.
+      ELSE
+         LBOT=0
+         LTOP=KTE
+      ENDIF
+!
+!***********************************************************************
+!-----------------------------------------------------------------------
+!***  Begin debugging convection
+      IF(PRINT_DIAG)THEN
+        WRITE(6,"(a,2i3,L2,3e12.4)")  &
+             '{cu2a lbot,ltop,shallow,pbot,ptop,depmin = ' &
+             ,lbot,ltop,shallow,pbot,ptop,depmin
+      ENDIF
+!***  End debugging convection
+!-----------------------------------------------------------------------
+!
+      IF(.NOT.SHALLOW)GO TO 800
+!
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!SCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCS
+!SCSCSCSCSCSCSC         SHALLOW CONVECTION          CSCSCSCSCSCSCSCSCSCS
+!SCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCS
+!-----------------------------------------------------------------------
+      DO L=KTS,LMH
+        TKL      =T(L)
+        TK   (L) =TKL
+        TREFK(L) =TKL
+        QKL      =Q(L)
+        QK   (L) =QKL
+        QREFK(L) =QKL
+        PKL      =PRSMID(L)
+        PK   (L) =PKL
+        QSATK(L) =PQ0/PK(L)*EXP(A2*(TK(L)-A3)/(TK(L)-A4))
+        APEKL    =APE(L)
+        APEK (L) =APEKL
+        THVMKL   =TKL*APEKL*(QKL*D608+1.)
+        THVREF(L)=THVMKL
+!
+!        if(tkl>=tfrz)then
+          EL(L)=ELWV
+!        else
+!          el(l)=eliv
+!        endif
+      ENDDO
+!---------------------------SHALLOW CLOUD TOP---------------------------
+      LBM1=LBOT-1
+      PTPK=PTOP
+      LTP1=LTOP-1
+      DEPTH=PBOT-PTOP
+!-----------------------------------------------------------------------
+!***  Begin debugging convection
+      IF(PRINT_DIAG)THEN
+        WRITE(6,"(a,4e12.4)") '{cu2b PBOT,PTOP,DEPTH,DEPMIN= ' &
+             ,PBOT,PTOP,DEPTH,DEPMIN
+      ENDIF
+!***  End debugging convection
+!-----------------------------------------------------------------------
+!
+!BSF      IF(DEPTH<DEPMIN)THEN
+!BSF        GO TO 800
+!BSF      ENDIF
+!-----------------------------------------------------------------------
+      IF(PTOP>PBOT-PNO.OR.LTOP>LBOT-2)THEN
+        LBOT=0
+!!!     LTOP=LBOT
+        LTOP=KTE
+        PTOP=PBOT
+        GO TO 800
+      ENDIF
+!--------------SCALING POTENTIAL TEMPERATURE & TABLE INDEX AT TOP-------
+!
+      THTPK=T(LTP1)*APE(LTP1)
+!
+      TTHK=(THTPK-THL)*RDTH
+      QQK =TTHK-AINT(TTHK)
+      IT  =INT(TTHK)+1
+!
+      IF(IT<1)THEN
+        IT=1
+        QQK=0.
+      ENDIF
+!
+      IF(IT>=JTB)THEN
+        IT=JTB-1
+        QQK=0.
+      ENDIF
+!--------------BASE AND SCALING FACTOR FOR SPEC. HUMIDITY AT TOP--------
+      BQS00K=QS0(IT)
+      SQS00K=SQS(IT)
+      BQS10K=QS0(IT+1)
+      SQS10K=SQS(IT+1)
+!--------------SCALING SPEC. HUMIDITY & TABLE INDEX AT TOP--------------
+      BQK=(BQS10K-BQS00K)*QQK+BQS00K
+      SQK=(SQS10K-SQS00K)*QQK+SQS00K
+!
+!     TQK=(Q(LTOP)-BQK)/SQK*RDQ
+      TQK=(Q(LTP1)-BQK)/SQK*RDQ
+!
+      PPK=TQK-AINT(TQK)
+      IQ =INT(TQK)+1
+!
+      IF(IQ<1)THEN
+        IQ=1
+        PPK=0.
+      ENDIF
+!
+      IF(IQ>=ITB)THEN
+        IQ=ITB-1
+        PPK=0.
+      ENDIF
+!----------------CLOUD TOP SATURATION POINT PRESSURE--------------------
+      PART1=(PTBL(IQ+1,IT)-PTBL(IQ,IT))*PPK
+      PART2=(PTBL(IQ,IT+1)-PTBL(IQ,IT))*QQK
+      PART3=(PTBL(IQ  ,IT  )-PTBL(IQ+1,IT  )                            &
+     &      -PTBL(IQ  ,IT+1)+PTBL(IQ+1,IT+1))*PPK*QQK
+      PTPK=PTBL(IQ,IT)+PART1+PART2+PART3
+!-----------------------------------------------------------------------
+      DPMIX=PTPK-PSP
+      IF(ABS(DPMIX).LT.3000.)DPMIX=-3000.
+!----------------TEMPERATURE PROFILE SLOPE------------------------------
+      SMIX=(THTPK-THBT)/DPMIX*STABS
+!
+      TREFKX=TREFK(LBOT+1)
+      PKXXXX=PK(LBOT+1)
+      PKXXXY=PK(LBOT)
+      APEKXX=APEK(LBOT+1)
+      APEKXY=APEK(LBOT)
+!
+      DO L=LBOT,LTOP,-1
+        TREFKX=((PKXXXY-PKXXXX)*SMIX                                    &
+     &          +TREFKX*APEKXX)/APEKXY
+        TREFK(L)=TREFKX
+        APEKXX=APEKXY
+        PKXXXX=PKXXXY
+        APEKXY=APEK(L-1)
+        PKXXXY=PK(L-1)
+      ENDDO
+!----------------TEMPERATURE REFERENCE PROFILE CORRECTION---------------
+      SUMDT=0.
+      SUMDP=0.
+!
+      DO L=LTOP,LBOT
+        SUMDT=(TK(L)-TREFK(L))*DPRS(L)+SUMDT
+        SUMDP=SUMDP+DPRS(L)
+      ENDDO
+!
+      RDPSUM=1./SUMDP
+      FPK(LBOT)=TREFK(LBOT)
+!
+      TCORR=SUMDT*RDPSUM
+!
+      DO L=LTOP,LBOT
+        TRFKL   =TREFK(L)+TCORR
+        TREFK(L)=TRFKL
+        FPK  (L)=TRFKL
+      ENDDO
+!----------------HUMIDITY PROFILE EQUATIONS-----------------------------
+      PSUM  =0.
+      QSUM  =0.
+      POTSUM=0.
+      QOTSUM=0.
+      OTSUM =0.
+      DST   =0.
+      FPTK  =FPK(LTOP)
+!
+      DO L=LTOP,LBOT
+        DPKL  =FPK(L)-FPTK
+        PSUM  =DPKL *DPRS(L)+PSUM
+        QSUM  =QK(L)*DPRS(L)+QSUM
+        RTBAR =2./(TREFK(L)+TK(L))
+        OTSUM =DPRS(L)*RTBAR+OTSUM
+        POTSUM=DPKL    *RTBAR*DPRS(L)+POTSUM
+        QOTSUM=QK(L)   *RTBAR*DPRS(L)+QOTSUM
+        DST   =(TREFK(L)-TK(L))*RTBAR*DPRS(L)/EL(L)+DST
+      ENDDO
+!
+      PSUM  =PSUM*RDPSUM
+      QSUM  =QSUM*RDPSUM
+      ROTSUM=1./OTSUM
+      POTSUM=POTSUM*ROTSUM
+      QOTSUM=QOTSUM*ROTSUM
+      DST   =DST*ROTSUM*CP
+!
+!-----------------------------------------------------------------------
+!***  Begin debugging convection
+      IF(PRINT_DIAG)THEN
+        WRITE(6,"(a,5e12.4)") '{cu2c DST,PSUM,QSUM,POTSUM,QOTSUM = ' &
+             ,DST,PSUM,QSUM,POTSUM,QOTSUM
+      ENDIF
+!***  End debugging convection
+!-----------------------------------------------------------------------
+!
+!----------------ENSURE POSITIVE ENTROPY CHANGE-------------------------
+      IF(DST>0.)THEN
+!        dstq=dst*epsup
+        LBOT=0
+!!!!    LTOP=LBOT
+        LTOP=KTE
+        PTOP=PBOT
+        GO TO 800
+      ELSE
+        DSTQ=DST*EPSDN
+      ENDIF
+!----------------CHECK FOR ISOTHERMAL ATMOSPHERE------------------------
+      DEN=POTSUM-PSUM
+!
+      IF(-DEN/PSUM<5.E-5)THEN
+        LBOT=0
+!!!!    LTOP=LBOT
+        LTOP=KTE
+        PTOP=PBOT
+        GO TO 800
+!
+!----------------SLOPE OF THE REFERENCE HUMIDITY PROFILE----------------
+      ELSE
+        DQREF=(QOTSUM-DSTQ-QSUM)/DEN
+      ENDIF
+!-------------- HUMIDITY DOES NOT INCREASE WITH HEIGHT------------------
+      IF(DQREF<0.)THEN
+        LBOT=0
+!!!!    LTOP=LBOT
+        LTOP=KTE
+        PTOP=PBOT
+        GO TO 800
+      ENDIF
+!----------------HUMIDITY AT THE CLOUD TOP------------------------------
+      QRFTP=QSUM-DQREF*PSUM
+!----------------HUMIDITY PROFILE---------------------------------------
+!
+      DO L=LTOP,LBOT
+        QRFKL=(FPK(L)-FPTK)*DQREF+QRFTP
+!
+!***  TOO DRY CLOUDS NOT ALLOWED
+!
+        TNEW=(TREFK(L)-TK(L))*TAUKSC+TK(L)
+        QSATK(L)=PQ0/PK(L)*EXP(A2*(TNEW-A3)/(TNEW-A4))
+        QNEW=(QRFKL-QK(L))*TAUKSC+QK(L)
+!
+        IF(QNEW<QSATK(L)*RHLSC)THEN
+          LBOT=0
+!!!!      LTOP=LBOT
+          LTOP=KTE
+          PTOP=PBOT
+          GO TO 800
+        ENDIF
+!
+!-------------TOO MOIST CLOUDS NOT ALLOWED------------------------------
+!
+        IF(QNEW>QSATK(L)*RHHSC)THEN
+          LBOT=0
+!!!!      LTOP=LBOT
+          LTOP=KTE
+          PTOP=PBOT
+          GO TO 800
+        ENDIF
+
+!
+        THVREF(L)=TREFK(L)*APEK(L)*(QRFKL*D608+1.)
+        QREFK(L)=QRFKL
+      ENDDO
+!
+!------------------ ELIMINATE CLOUDS WITH BOTTOMS TOO DRY --------------
+!!
+!      qnew=(qrefk(lbot)-qk(lbot))*tauksc+qk(lbot)
+!!
+!      if(qnew<qk(lbot+1)*stresh)then  !!?? stresh too large!!
+!        lbot=0
+!!!!!!   ltop=lbot
+!        ltop=kte
+!        ptop=pbot
+!        go to 800
+!      endif
+!!
+!-------------- ELIMINATE IMPOSSIBLE SLOPES (BETTS,DTHETA/DQ)------------
+!
+      DO L=LTOP,LBOT
+        DTDP=(THVREF(L-1)-THVREF(L))/(PRSMID(L)-PRSMID(L-1))
+!
+        IF(DTDP<EPSDT)THEN
+          LBOT=0
+!!!!!     LTOP=LBOT
+          LTOP=KTE
+          PTOP=PBOT
+          GO TO 800
+        ENDIF
+!
+      ENDDO
+!-----------------------------------------------------------------------
+!--------------RELAXATION TOWARD REFERENCE PROFILES---------------------
+!-----------------------------------------------------------------------
+!
+      DO L=LTOP,LBOT
+        DTDT(L)=(TREFK(L)-TK(L))*TAUKSC*RDTCNVC
+        DQDT(L)=(QREFK(L)-QK(L))*TAUKSC*RDTCNVC
+      ENDDO
+!
+!-----------------------------------------------------------------------
+!***  Begin debugging convection
+      IF(PRINT_DIAG)THEN
+        DO L=LBOT,LTOP,-1
+          WRITE(6,"(a,i3,4e12.4)") '{cu2 KFLIP,DT,DTDT,DQ,DQDT = ' &
+               ,KTE+1-L,TREFK(L)-TK(L),DTDT(L),QREFK(L)-QK(L),DQDT(L)
+        ENDDO
+      ENDIF
+!***  End debugging convection
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!SCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCS
+!SCSCSCSCSCSCSC         END OF SHALLOW CONVECTION        SCSCSCSCSCSCSCS
+!SCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCSCS
+!-----------------------------------------------------------------------
+  800 CONTINUE
+!-----------------------------------------------------------------------
+      END SUBROUTINE BMJ
+!-----------------------------------------------------------------------
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!-----------------------------------------------------------------------
+                           SUBROUTINE TTBLEX                            &
+     & (ITBX,JTBX,PLX,PRSMID,RDPX,RDTHEX,STHE                           &
+     & ,THE0,THESP,TTBL,TREF)
+!-----------------------------------------------------------------------
+!     ******************************************************************
+!     *                                                                *
+!     *           EXTRACT TEMPERATURE OF THE MOIST ADIABAT FROM        *
+!     *                      THE APPROPRIATE TTBL                      *
+!     *                                                                *
+!     ******************************************************************
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: ITBX,JTBX
+!
+      REAL,INTENT(IN) :: PLX,PRSMID,RDPX,RDTHEX,THESP
+!
+      REAL,DIMENSION(ITBX),INTENT(IN) :: STHE,THE0
+!
+      REAL,DIMENSION(JTBX,ITBX),INTENT(IN) :: TTBL
+!
+      REAL,INTENT(OUT) :: TREF
+!-----------------------------------------------------------------------
+      REAL :: BTHE00K,BTHE10K,BTHK,PK,PP,QQ,STHE00K,STHE10K,STHK        &
+     &       ,T00K,T01K,T10K,T11K,TPK,TTHK
+!
+      INTEGER :: IPTB,ITHTB
+!-----------------------------------------------------------------------
+!----------------SCALING PRESSURE & TT TABLE INDEX----------------------
+!-----------------------------------------------------------------------
+      PK=PRSMID
+      TPK=(PK-PLX)*RDPX
+      QQ=TPK-AINT(TPK)
+      IPTB=INT(TPK)+1
+!----------------KEEPING INDICES WITHIN THE TABLE-----------------------
+      IF(IPTB<1)THEN
+        IPTB=1
+        QQ=0.
+      ENDIF
+!
+      IF(IPTB>=ITBX)THEN
+        IPTB=ITBX-1
+        QQ=0.
+      ENDIF
+!----------------BASE AND SCALING FACTOR FOR THETAE---------------------
+      BTHE00K=THE0(IPTB)
+      STHE00K=STHE(IPTB)
+      BTHE10K=THE0(IPTB+1)
+      STHE10K=STHE(IPTB+1)
+!----------------SCALING THE & TT TABLE INDEX---------------------------
+      BTHK=(BTHE10K-BTHE00K)*QQ+BTHE00K
+      STHK=(STHE10K-STHE00K)*QQ+STHE00K
+      TTHK=(THESP-BTHK)/STHK*RDTHEX
+      PP=TTHK-AINT(TTHK)
+      ITHTB=INT(TTHK)+1
+!----------------KEEPING INDICES WITHIN THE TABLE-----------------------
+      IF(ITHTB<1)THEN
+        ITHTB=1
+        PP=0.
+      ENDIF
+!
+      IF(ITHTB>=JTBX)THEN
+        ITHTB=JTBX-1
+        PP=0.
+      ENDIF
+!----------------TEMPERATURE AT FOUR SURROUNDING TT TABLE PTS.----------
+      T00K=TTBL(ITHTB,IPTB)
+      T10K=TTBL(ITHTB+1,IPTB)
+      T01K=TTBL(ITHTB,IPTB+1)
+      T11K=TTBL(ITHTB+1,IPTB+1)
+!-----------------------------------------------------------------------
+!----------------PARCEL TEMPERATURE-------------------------------------
+!-----------------------------------------------------------------------
+      TREF=(T00K+(T10K-T00K)*PP+(T01K-T00K)*QQ                          &
+     &    +(T00K-T10K-T01K+T11K)*PP*QQ)
+!-----------------------------------------------------------------------
+      END SUBROUTINE TTBLEX
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      SUBROUTINE BMJINIT(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN            &
+     &                  ,CLDEFI,LOWLYR,CP,RD,RESTART                    &
+     &                  ,ALLOWED_TO_READ                                &
+     &                  ,IDS,IDE,JDS,JDE,KDS,KDE                        &
+     &                  ,IMS,IME,JMS,JME,KMS,KME                        &
+     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      LOGICAL,INTENT(IN) :: RESTART,ALLOWED_TO_READ
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      REAL,INTENT(IN) :: CP,RD
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) ::            &
+     &                                              RTHCUTEN            &
+     &                                             ,RQVCUTEN            &
+     &                                             ,RQCCUTEN            &
+     &                                             ,RQRCUTEN
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CLDEFI
+
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: LOWLYR
+!
+      REAL,PARAMETER :: ELIWV=2.683E6,EPS=1.E-9
+!
+      REAL, DIMENSION(JTB) :: APP,APT,AQP,AQT,PNEW,POLD,QSNEW,QSOLD     &
+     &                       ,THENEW,THEOLD,TNEW,TOLD,Y2P,Y2T
+!
+      REAL,DIMENSION(JTBQ) :: APTQ,AQTQ,THENEWQ,THEOLDQ                 &
+     &                       ,TNEWQ,TOLDQ,Y2TQ
+!
+      INTEGER :: I,J,K,ITF,JTF,KTF
+      INTEGER :: KTH,KTHM,KTHM1,KP,KPM,KPM1
+!
+      REAL :: APE,DP,DQS,DTH,DTHE,P,QS,QS0K,SQSK,STHEK                  &
+     &       ,TH,THE0K,DENOM
+!-----------------------------------------------------------------------
+
+      JTF=MIN0(JTE,JDE-1)
+      KTF=MIN0(KTE,KDE-1)
+      ITF=MIN0(ITE,IDE-1)
+! 
+      IF(.NOT.RESTART)THEN
+        DO J=JTS,JTF
+        DO K=KTS,KTF
+        DO I=ITS,ITF
+          RTHCUTEN(I,K,J)=0.
+          RQVCUTEN(I,K,J)=0.
+          RQCCUTEN(I,K,J)=0.
+          RQRCUTEN(I,K,J)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+!
+        DO J=JTS,JTF
+        DO I=ITS,ITF
+          CLDEFI(I,J)=AVGEFI
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!***  FOR NOW, ASSUME SIGMA MODE FOR LOWEST MODEL LAYER
+!
+      DO J=JTS,JTF
+      DO I=ITS,ITF
+        LOWLYR(I,J)=1
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!----------------COARSE LOOK-UP TABLE FOR SATURATION POINT--------------
+!-----------------------------------------------------------------------
+!
+      KTHM=JTB
+      KPM=ITB
+      KTHM1=KTHM-1
+      KPM1=KPM-1
+!
+      DTH=(THH-THL)/REAL(KTHM-1)
+      DP =(PH -PL )/REAL(KPM -1)
+!
+      TH=THL-DTH
+!-----------------------------------------------------------------------
+      DO 100 KTH=1,KTHM
+!
+      TH=TH+DTH
+      P=PL-DP
+!
+      DO KP=1,KPM
+        P=P+DP
+        APE=(100000./P)**(RD/CP)
+        DENOM=TH-A4*APE
+        IF (DENOM>EPS) THEN
+           QSOLD(KP)=PQ0/P*EXP(A2*(TH-A3*APE)/DENOM)
+        ELSE
+           QSOLD(KP)=0.
+        ENDIF
+        POLD(KP)=P
+      ENDDO
+!
+      QS0K=QSOLD(1)
+      SQSK=QSOLD(KPM)-QSOLD(1)
+      QSOLD(1  )=0.
+      QSOLD(KPM)=1.
+!
+      DO KP=2,KPM1
+        QSOLD(KP)=(QSOLD(KP)-QS0K)/SQSK
+        IF((QSOLD(KP)-QSOLD(KP-1)).LT.EPS)QSOLD(KP)=QSOLD(KP-1)+EPS
+      ENDDO
+!
+      QS0(KTH)=QS0K
+      QS0_EXP(KTH)=QS0K
+      SQS(KTH)=SQSK
+      SQS_EXP(KTH)=SQSK
+!-----------------------------------------------------------------------
+      QSNEW(1  )=0.
+      QSNEW(KPM)=1.
+      DQS=1./REAL(KPM-1)
+!
+      DO KP=2,KPM1
+        QSNEW(KP)=QSNEW(KP-1)+DQS
+      ENDDO
+!
+      Y2P(1   )=0.
+      Y2P(KPM )=0.
+!
+      CALL SPLINE(JTB,KPM,QSOLD,POLD,Y2P,KPM,QSNEW,PNEW,APP,AQP)
+!
+      DO KP=1,KPM
+        PTBL(KP,KTH)=PNEW(KP)
+        PTBL_EXP(KP,KTH)=PNEW(KP)
+      ENDDO
+!-----------------------------------------------------------------------
+  100 CONTINUE
+!-----------------------------------------------------------------------
+!------------COARSE LOOK-UP TABLE FOR T(P) FROM CONSTANT THE------------
+!-----------------------------------------------------------------------
+      P=PL-DP
+!
+      DO 200 KP=1,KPM
+!
+      P=P+DP
+      TH=THL-DTH
+!
+      DO KTH=1,KTHM
+        TH=TH+DTH
+        APE=(1.E5/P)**(RD/CP)
+        DENOM=TH-A4*APE
+        IF (DENOM>EPS) THEN
+           QS=PQ0/P*EXP(A2*(TH-A3*APE)/DENOM)
+        ELSE
+           QS=0.
+        ENDIF
+!        QS=PQ0/P*EXP(A2*(TH-A3*APE)/(TH-A4*APE))
+        TOLD(KTH)=TH/APE
+        THEOLD(KTH)=TH*EXP(ELIWV*QS/(CP*TOLD(KTH)))
+      ENDDO
+!
+      THE0K=THEOLD(1)
+      STHEK=THEOLD(KTHM)-THEOLD(1)
+      THEOLD(1   )=0.
+      THEOLD(KTHM)=1.
+!
+      DO KTH=2,KTHM1
+        THEOLD(KTH)=(THEOLD(KTH)-THE0K)/STHEK
+        IF((THEOLD(KTH)-THEOLD(KTH-1)).LT.EPS)                          &
+     &      THEOLD(KTH)=THEOLD(KTH-1)  +  EPS
+      ENDDO
+!
+      THE0(KP)=THE0K
+      STHE(KP)=STHEK
+!-----------------------------------------------------------------------
+      THENEW(1  )=0.
+      THENEW(KTHM)=1.
+      DTHE=1./REAL(KTHM-1)
+!
+      DO KTH=2,KTHM1
+        THENEW(KTH)=THENEW(KTH-1)+DTHE
+      ENDDO
+!
+      Y2T(1   )=0.
+      Y2T(KTHM)=0.
+!
+      CALL SPLINE(JTB,KTHM,THEOLD,TOLD,Y2T,KTHM,THENEW,TNEW,APT,AQT)
+!
+      DO KTH=1,KTHM
+        TTBL(KTH,KP)=TNEW(KTH)
+      ENDDO
+!-----------------------------------------------------------------------
+  200 CONTINUE
+!-----------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+!---------------FINE LOOK-UP TABLE FOR SATURATION POINT-----------------
+!-----------------------------------------------------------------------
+      KTHM=JTBQ
+      KPM=ITBQ
+      KTHM1=KTHM-1
+      KPM1=KPM-1
+!
+      DTH=(THHQ-THL)/REAL(KTHM-1)
+      DP=(PH-PLQ)/REAL(KPM-1)
+!
+      TH=THL-DTH
+      P=PLQ-DP
+!-----------------------------------------------------------------------
+!---------------FINE LOOK-UP TABLE FOR T(P) FROM CONSTANT THE-----------
+!-----------------------------------------------------------------------
+      DO 300 KP=1,KPM
+!
+      P=P+DP
+      TH=THL-DTH
+!
+      DO KTH=1,KTHM
+        TH=TH+DTH
+        APE=(1.E5/P)**(RD/CP)
+        DENOM=TH-A4*APE
+        IF (DENOM>EPS) THEN
+           QS=PQ0/P*EXP(A2*(TH-A3*APE)/DENOM)
+        ELSE
+           QS=0.
+        ENDIF
+!        QS=PQ0/P*EXP(A2*(TH-A3*APE)/(TH-A4*APE))
+        TOLDQ(KTH)=TH/APE
+        THEOLDQ(KTH)=TH*EXP(ELIWV*QS/(CP*TOLDQ(KTH)))
+      ENDDO
+!
+      THE0K=THEOLDQ(1)
+      STHEK=THEOLDQ(KTHM)-THEOLDQ(1)
+      THEOLDQ(1   )=0.
+      THEOLDQ(KTHM)=1.
+!
+      DO KTH=2,KTHM1
+        THEOLDQ(KTH)=(THEOLDQ(KTH)-THE0K)/STHEK
+        IF((THEOLDQ(KTH)-THEOLDQ(KTH-1))<EPS)                           &
+     &      THEOLDQ(KTH)=THEOLDQ(KTH-1)+EPS
+      ENDDO
+!
+      THE0Q(KP)=THE0K
+      STHEQ(KP)=STHEK
+!-----------------------------------------------------------------------
+      THENEWQ(1  )=0.
+      THENEWQ(KTHM)=1.
+      DTHE=1./REAL(KTHM-1)
+!
+      DO KTH=2,KTHM1
+        THENEWQ(KTH)=THENEWQ(KTH-1)+DTHE
+      ENDDO
+!
+      Y2TQ(1   )=0.
+      Y2TQ(KTHM)=0.
+!
+      CALL SPLINE(JTBQ,KTHM,THEOLDQ,TOLDQ,Y2TQ,KTHM                     &
+     &           ,THENEWQ,TNEWQ,APTQ,AQTQ)
+!
+      DO KTH=1,KTHM
+        TTBLQ(KTH,KP)=TNEWQ(KTH)
+      ENDDO
+!-----------------------------------------------------------------------
+  300 CONTINUE
+!-----------------------------------------------------------------------
+      END SUBROUTINE BMJINIT
+!-----------------------------------------------------------------------
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!-----------------------------------------------------------------------
+      SUBROUTINE SPLINE(JTBX,NOLD,XOLD,YOLD,Y2,NNEW,XNEW,YNEW,P,Q)
+!   ********************************************************************
+!   *                                                                  *
+!   *  THIS IS A ONE-DIMENSIONAL CUBIC SPLINE FITTING ROUTINE          *
+!   *  PROGRAMED FOR A SMALL SCALAR MACHINE.                           *
+!   *                                                                  *
+!   *  PROGRAMER Z. JANJIC                                             *
+!   *                                                                  *
+!   *  NOLD - NUMBER OF GIVEN VALUES OF THE FUNCTION.  MUST BE GE 3.   *
+!   *  XOLD - LOCATIONS OF THE POINTS AT WHICH THE VALUES OF THE       *
+!   *         FUNCTION ARE GIVEN.  MUST BE IN ASCENDING ORDER.         *
+!   *  YOLD - THE GIVEN VALUES OF THE FUNCTION AT THE POINTS XOLD.     *
+!   *  Y2   - THE SECOND DERIVATIVES AT THE POINTS XOLD.  IF NATURAL   *
+!   *         SPLINE IS FITTED Y2(1)=0. AND Y2(NOLD)=0. MUST BE        *
+!   *         SPECIFIED.                                               *
+!   *  NNEW - NUMBER OF VALUES OF THE FUNCTION TO BE CALCULATED.       *
+!   *  XNEW - LOCATIONS OF THE POINTS AT WHICH THE VALUES OF THE       *
+!   *         FUNCTION ARE CALCULATED.  XNEW(K) MUST BE GE XOLD(1)     *
+!   *         AND LE XOLD(NOLD).                                       *
+!   *  YNEW - THE VALUES OF THE FUNCTION TO BE CALCULATED.             *
+!   *  P, Q - AUXILIARY VECTORS OF THE LENGTH NOLD-2.                  *
+!   *                                                                  *
+!   ********************************************************************
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: JTBX,NNEW,NOLD
+      REAL,DIMENSION(JTBX),INTENT(IN) :: XNEW,XOLD,YOLD
+      REAL,DIMENSION(JTBX),INTENT(INOUT) :: P,Q,Y2
+      REAL,DIMENSION(JTBX),INTENT(OUT) :: YNEW
+!
+      INTEGER :: K,K1,K2,KOLD,NOLDM1
+      REAL :: AK,BK,CK,DEN,DX,DXC,DXL,DXR,DYDXL,DYDXR                   &
+     &       ,RDX,RTDXC,X,XK,XSQ,Y2K,Y2KP1
+!-----------------------------------------------------------------------
+      NOLDM1=NOLD-1
+!
+      DXL=XOLD(2)-XOLD(1)
+      DXR=XOLD(3)-XOLD(2)
+      DYDXL=(YOLD(2)-YOLD(1))/DXL
+      DYDXR=(YOLD(3)-YOLD(2))/DXR
+      RTDXC=0.5/(DXL+DXR)
+!
+      P(1)= RTDXC*(6.*(DYDXR-DYDXL)-DXL*Y2(1))
+      Q(1)=-RTDXC*DXR
+!
+      IF(NOLD==3)GO TO 150
+!-----------------------------------------------------------------------
+      K=3
+!
+  100 DXL=DXR
+      DYDXL=DYDXR
+      DXR=XOLD(K+1)-XOLD(K)
+      DYDXR=(YOLD(K+1)-YOLD(K))/DXR
+      DXC=DXL+DXR
+      DEN=1./(DXL*Q(K-2)+DXC+DXC)
+!
+      P(K-1)= DEN*(6.*(DYDXR-DYDXL)-DXL*P(K-2))
+      Q(K-1)=-DEN*DXR
+!
+      K=K+1
+      IF(K<NOLD)GO TO 100
+!-----------------------------------------------------------------------
+  150 K=NOLDM1
+!
+  200 Y2(K)=P(K-1)+Q(K-1)*Y2(K+1)
+!
+      K=K-1
+      IF(K>1)GO TO 200
+!-----------------------------------------------------------------------
+      K1=1
+!
+  300 XK=XNEW(K1)
+!
+      DO 400 K2=2,NOLD
+!
+      IF(XOLD(K2)>XK)THEN
+        KOLD=K2-1
+        GO TO 450
+      ENDIF
+!
+  400 CONTINUE
+!
+      YNEW(K1)=YOLD(NOLD)
+      GO TO 600
+!
+  450 IF(K1==1)GO TO 500
+      IF(K==KOLD)GO TO 550
+!
+  500 K=KOLD
+!
+      Y2K=Y2(K)
+      Y2KP1=Y2(K+1)
+      DX=XOLD(K+1)-XOLD(K)
+      RDX=1./DX
+!
+      AK=.1666667*RDX*(Y2KP1-Y2K)
+      BK=0.5*Y2K
+      CK=RDX*(YOLD(K+1)-YOLD(K))-.1666667*DX*(Y2KP1+Y2K+Y2K)
+!
+  550 X=XK-XOLD(K)
+      XSQ=X*X
+!
+      YNEW(K1)=AK*XSQ*X+BK*XSQ+CK*X+YOLD(K)
+!
+  600 K1=K1+1
+      IF(K1<=NNEW)GO TO 300
+!-----------------------------------------------------------------------
+      END SUBROUTINE SPLINE
+!-----------------------------------------------------------------------
+!
+      END MODULE MODULE_CU_BMJ
+!
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/phys/module_cu_gd.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_cu_gd.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_cu_gd.F	(revision 2744)
@@ -0,0 +1,4383 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+
+MODULE module_cu_gd
+
+CONTAINS
+
+!-------------------------------------------------------------
+   SUBROUTINE GRELLDRV(                                         &
+               DT,itimestep,DX                                  &
+              ,rho,RAINCV                                       &
+              ,U,V,t,W,q,p,pi                                   &
+              ,dz8w,p8w,XLV,CP,G,r_v                            &
+              ,STEPCU,htop,hbot                                 &
+              ,CU_ACT_FLAG,warm_rain                            &
+              ,APR_GR,APR_W,APR_MC,APR_ST,APR_AS                &
+              ,APR_CAPMA,APR_CAPME,APR_CAPMI                    &
+              ,MASS_FLUX,XF_ENS,PR_ENS,HT,XLAND,gsw             &
+              ,GDC,GDC2                                         &
+              ,ensdim,maxiens,maxens,maxens2,maxens3            &
+              ,ids,ide, jds,jde, kds,kde                        &
+              ,ims,ime, jms,jme, kms,kme                        &
+              ,its,ite, jts,jte, kts,kte                        &
+              ,RQVCUTEN,RQCCUTEN,RQICUTEN                       &
+              ,RQVFTEN,RQVBLTEN                                 &
+              ,RTHFTEN,RTHCUTEN,RTHRATEN,RTHBLTEN               &
+              ,F_QV    ,F_QC    ,F_QR    ,F_QI    ,F_QS         &
+                                                                )
+!-------------------------------------------------------------
+   IMPLICIT NONE
+!-------------------------------------------------------------
+   INTEGER,      INTENT(IN   ) ::                               &
+                                  ids,ide, jds,jde, kds,kde,    & 
+                                  ims,ime, jms,jme, kms,kme,    & 
+                                  its,ite, jts,jte, kts,kte
+
+   integer, intent (in   )              ::                      &
+                       ensdim,maxiens,maxens,maxens2,maxens3
+  
+   INTEGER,      INTENT(IN   ) :: STEPCU, ITIMESTEP
+   LOGICAL,      INTENT(IN   ) :: warm_rain
+
+   REAL,         INTENT(IN   ) :: XLV, R_v
+   REAL,         INTENT(IN   ) :: CP,G
+
+   REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,    &
+          INTENT(IN   ) ::                                      &
+                                                          U,    &
+                                                          V,    &
+                                                          W,    &
+                                                         pi,    &
+                                                          t,    &
+                                                          q,    &
+                                                          p,    &
+                                                       dz8w,    &
+                                                       p8w,    &
+                                                        rho
+   REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,    &
+          OPTIONAL                                         ,    &
+          INTENT(INOUT   ) ::                                   &
+               GDC,GDC2
+
+
+   REAL, DIMENSION( ims:ime , jms:jme ),INTENT(IN) :: GSW,HT,XLAND
+!
+   REAL, INTENT(IN   ) :: DT, DX
+!
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                        &
+         INTENT(INOUT) ::                 RAINCV, MASS_FLUX,    &
+                          APR_GR,APR_W,APR_MC,APR_ST,APR_AS,    &
+                              APR_CAPMA,APR_CAPME,APR_CAPMI,htop,hbot
+!+lxz
+!  REAL, DIMENSION( ims:ime , jms:jme ) :: & !, INTENT(INOUT) ::       &
+!        HTOP,     &! highest model layer penetrated by cumulus since last reset in radiation_driver
+!        HBOT       ! lowest  model layer penetrated by cumulus since last reset in radiation_driver
+!                   ! HBOT>HTOP follow physics leveling convention
+
+   LOGICAL, DIMENSION( ims:ime , jms:jme ),                     &
+         INTENT(INOUT) ::                       CU_ACT_FLAG
+
+!
+! Optionals
+!
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),              &
+         OPTIONAL,                                              &
+         INTENT(INOUT) ::                           RTHFTEN,    &
+                                                    RQVFTEN
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),              &
+         OPTIONAL,                                              &
+         INTENT(IN   ) ::                                       &
+                                                   RTHRATEN,    &
+                                                   RTHBLTEN,    &
+                                                   RQVBLTEN
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),              &
+         OPTIONAL,                                              &
+         INTENT(INOUT) ::                                       &
+                                                   RTHCUTEN,    &
+                                                   RQVCUTEN,    &
+                                                   RQCCUTEN,    &
+                                                   RQICUTEN
+!
+! Flags relating to the optional tendency arrays declared above
+! Models that carry the optional tendencies will provdide the
+! optional arguments at compile time; these flags all the model
+! to determine at run-time whether a particular tracer is in
+! use or not.
+!
+   LOGICAL, OPTIONAL ::                                      &
+                                                   F_QV      &
+                                                  ,F_QC      &
+                                                  ,F_QR      &
+                                                  ,F_QI      &
+                                                  ,F_QS
+
+
+
+! LOCAL VARS
+     real,    dimension ( ims:ime , jms:jme , 1:ensdim) ::      &
+        massfln,xf_ens,pr_ens
+     real,    dimension (its:ite,kts:kte+1) ::                    &
+        OUTT,OUTQ,OUTQC,phh,cupclw
+     real,    dimension (its:ite,kts:kte+1) ::  phf
+     real,    dimension (its:ite)         ::                    &
+        pret, ter11, aa0, fp
+!+lxz
+     integer, dimension (its:ite) ::                            &
+        kbcon, ktop
+!.lxz
+     integer, dimension (its:ite,jts:jte) ::                    &
+        iact_old_gr
+     integer :: ichoice,iens,ibeg,iend,jbeg,jend
+
+!
+! basic environmental input includes moisture convergence (mconv)
+! omega (omeg), windspeed (us,vs), and a flag (aaeq) to turn off
+! convection for this call only and at that particular gridpoint
+!
+     real,    dimension (its:ite,kts:kte+1) ::                    &
+        T2d,TN,q2d,qo,PO,P2d,US,VS,omeg
+     real, dimension (its:ite)            ::                    &
+        Z1,PSUR,AAEQ,direction,mconv,cuten,umean,vmean,pmean
+
+   INTEGER :: i,j,k,ICLDCK,ipr,jpr
+   REAL    :: tcrit,dp,dq
+   INTEGER :: itf,jtf,ktf
+   REAL    :: rkbcon,rktop        !-lxz
+
+   ichoice=0
+   iens=1
+     ipr=0
+     jpr=0
+   jbeg=max(jts,jds+4)
+   jend=min(jte,jde-5)
+   ibeg=max(its,ids+4)
+   iend=min(ite,ide-5)
+   tcrit=258.
+
+   itf=MIN(ite,ide-1)
+   ktf=MIN(kte,kde-1)
+   jtf=MIN(jte,jde-1)
+!                                                                      
+     DO 100 J = jts,jtf  
+     DO I= its,itf
+        cuten(i)=0.
+        iact_old_gr(i,j)=0
+        mass_flux(i,j)=0.
+        raincv(i,j)=0.
+        CU_ACT_FLAG(i,j) = .true.
+     ENDDO
+     DO k=1,ensdim
+     DO I= its,itf
+        massfln(i,j,k)=0.
+     ENDDO
+     ENDDO
+#if ( EM_CORE == 1 )
+     DO k= kts,ktf
+     DO I= its,itf
+        RTHFTEN(i,k,j)=(RTHFTEN(i,k,j)+RTHRATEN(i,k,j)+RTHBLTEN(i,k,j))*pi(i,k,j)
+        RQVFTEN(i,k,j)=RQVFTEN(i,k,j)+RQVBLTEN(i,k,j)
+     ENDDO
+     ENDDO
+     !  hydrostatic pressure, first on full levels
+     DO I=ITS,ITF
+         phf(i,1) = p8w(i,1,j)
+     ENDDO
+     !  integrate up, dp = -rho * g * dz
+     DO K=kts+1,ktf+1
+     DO I=ITS,ITF
+         phf(i,k) = phf(i,k-1) - rho(i,k-1,j) * g * dz8w(i,k-1,j)
+     ENDDO
+     ENDDO
+     !  scale factor so that pressure is not zero after integration
+     DO I=ITS,ITF
+         fp(i) = (p8w(i,kts,j)-p8w(i,kte,j))/(phf(i,kts)-phf(i,kte))
+     ENDDO
+     !  re-integrate up, dp = -rho * g * dz * scale_factor
+     DO K=kts+1,ktf+1
+     DO I=ITS,ITF
+         phf(i,k) = phf(i,k-1) - rho(i,k-1,j) * g * dz8w(i,k-1,j) * fp(i)
+     ENDDO
+     ENDDO
+     !  put hydrostatic pressure on half levels
+     DO K=kts,ktf
+     DO I=ITS,ITF
+         phh(i,k) = (phf(i,k) + phf(i,k+1))*0.5
+     ENDDO
+     ENDDO
+#endif
+     DO I=ITS,ITF
+#if ( EM_CORE == 1 )
+         PSUR(I)=p8w(I,1,J)*.01
+#endif
+#if ( NMM_CORE == 1 )
+         PSUR(I)=p(I,1,J)*.01
+#endif
+         TER11(I)=HT(i,j)
+         mconv(i)=0.
+         aaeq(i)=0.
+         direction(i)=0.
+         pret(i)=0.
+         umean(i)=0.
+         vmean(i)=0.
+         pmean(i)=0.
+     ENDDO
+     DO K=kts,ktf
+     DO I=ITS,ITF
+         omeg(i,k)=0.
+!        cupclw(i,k)=0.
+#if ( EM_CORE == 1 )
+         po(i,k)=phh(i,k)*.01
+#endif
+
+#if ( NMM_CORE == 1 )
+         po(i,k)=p(i,k,j)*.01
+#endif
+         P2d(I,K)=PO(i,k)
+         US(I,K) =u(i,k,j)
+         VS(I,K) =v(i,k,j)
+         T2d(I,K)=t(i,k,j)
+         q2d(I,K)=q(i,k,j)
+         omeg(I,K)= -g*rho(i,k,j)*w(i,k,j)
+         TN(I,K)=t2d(i,k)+RTHFTEN(i,k,j)*dt
+         IF(TN(I,K).LT.200.)TN(I,K)=T2d(I,K)
+         QO(I,K)=q2d(i,k)+RQVFTEN(i,k,j)*dt
+         IF(Q2d(I,K).LT.1.E-08)Q2d(I,K)=1.E-08
+         IF(QO(I,K).LT.1.E-08)QO(I,K)=1.E-08
+         OUTT(I,K)=0.
+         OUTQ(I,K)=0.
+         OUTQC(I,K)=0.
+!        RTHFTEN(i,k,j)=0.
+!        RQVFTEN(i,k,j)=0.
+     ENDDO
+     ENDDO
+      do k=  kts+1,ktf-1
+      DO I = its,itf
+         if((p2d(i,1)-p2d(i,k)).gt.150.and.p2d(i,k).gt.300)then
+            dp=-.5*(p2d(i,k+1)-p2d(i,k-1))
+            umean(i)=umean(i)+us(i,k)*dp
+            vmean(i)=vmean(i)+vs(i,k)*dp
+            pmean(i)=pmean(i)+dp
+         endif
+      enddo
+      enddo
+      DO I = its,itf
+         umean(i)=umean(i)/pmean(i)
+         vmean(i)=vmean(i)/pmean(i)
+         direction(i)=(atan2(umean(i),vmean(i))+3.1415926)*57.29578
+         if(direction(i).gt.360.)direction(i)=direction(i)-360.
+      ENDDO
+      DO K=kts,ktf-1
+      DO I = its,itf
+        dq=(q2d(i,k+1)-q2d(i,k))
+        mconv(i)=mconv(i)+omeg(i,k)*dq/g
+      ENDDO
+      ENDDO
+      DO I = its,itf
+        if(mconv(i).lt.0.)mconv(i)=0.
+      ENDDO
+!
+!---- CALL CUMULUS PARAMETERIZATION
+!
+      CALL CUP_enss(outqc,j,AAEQ,T2d,Q2d,TER11,TN,QO,PO,PRET,     &
+           P2d,OUTT,OUTQ,DT,PSUR,US,VS,tcrit,iens,                &
+           mconv,massfln,iact_old_gr,omeg,direction,MASS_FLUX,    &
+           maxiens,maxens,maxens2,maxens3,ensdim,                 &
+           APR_GR,APR_W,APR_MC,APR_ST,APR_AS,                     &
+           APR_CAPMA,APR_CAPME,APR_CAPMI,kbcon,ktop,              &
+           xf_ens,pr_ens,XLAND,gsw,cupclw,                        &
+           xlv,r_v,cp,g,ichoice,ipr,jpr,                          &
+           ids,ide, jds,jde, kds,kde,                             &
+           ims,ime, jms,jme, kms,kme,                             &
+           its,ite, jts,jte, kts,kte                             )
+
+      CALL neg_check(dt,q2d,outq,outt,outqc,pret,its,ite,kts,kte,itf,ktf)
+      if(j.ge.jbeg.and.j.le.jend)then
+
+            DO I=its,itf
+!             cuten(i)=0.
+              if(i.ge.ibeg.and.i.le.iend)then
+              if(pret(i).gt.0.)then
+                 raincv(i,j)=pret(i)*dt
+                 cuten(i)=1.
+                 rkbcon = kte+kts - kbcon(i)
+                 rktop  = kte+kts -  ktop(i)
+                 if (ktop(i)  > HTOP(i,j)) HTOP(i,j) = ktop(i)+.001
+                 if (kbcon(i) < HBOT(i,j)) HBOT(i,j) = kbcon(i)+.001
+              endif
+              else
+               pret(i)=0.
+              endif
+            ENDDO
+            DO K=kts,ktf
+            DO I=its,itf
+               RTHCUTEN(I,K,J)=outt(i,k)*cuten(i)/pi(i,k,j)
+               RQVCUTEN(I,K,J)=outq(i,k)*cuten(i)
+            ENDDO
+            ENDDO
+
+            IF(PRESENT(RQCCUTEN)) THEN
+              IF ( F_QC ) THEN
+                DO K=kts,ktf
+                DO I=its,itf
+                   RQCCUTEN(I,K,J)=outqc(I,K)*cuten(i)
+                   IF ( PRESENT( GDC ) ) GDC(I,K,J)=CUPCLW(I,K)*cuten(i)
+                   IF ( PRESENT( GDC2 ) ) GDC2(I,K,J)=0.
+                ENDDO
+                ENDDO
+              ENDIF
+            ENDIF
+
+!......     QSTEN STORES GRAUPEL TENDENCY IF IT EXISTS, OTHERISE SNOW (V2)     
+
+            IF(PRESENT(RQICUTEN).AND.PRESENT(RQCCUTEN))THEN
+              IF (F_QI) THEN
+                DO K=kts,ktf
+                DO I=its,itf
+                   if(t2d(i,k).lt.258.)then
+                      RQICUTEN(I,K,J)=outqc(I,K)*cuten(i)
+                      RQCCUTEN(I,K,J)=0.
+                      IF ( PRESENT( GDC2 ) ) GDC2(I,K,J)=CUPCLW(I,K)*cuten(i)
+                   else
+                      RQICUTEN(I,K,J)=0.
+                      RQCCUTEN(I,K,J)=outqc(I,K)*cuten(i)
+                      IF ( PRESENT( GDC ) ) GDC(I,K,J)=CUPCLW(I,K)*cuten(i)
+                   endif
+                ENDDO
+                ENDDO
+              ENDIF
+            ENDIF
+        endif !jbeg,jend
+
+ 100    continue
+
+   END SUBROUTINE GRELLDRV
+
+
+   SUBROUTINE CUP_enss(OUTQC,J,AAEQ,T,Q,Z1,                            &
+              TN,QO,PO,PRE,P,OUTT,OUTQ,DTIME,PSUR,US,VS,               &
+              TCRIT,iens,mconv,massfln,iact,                           &
+              omeg,direction,massflx,maxiens,                          &
+              maxens,maxens2,maxens3,ensdim,                           &
+              APR_GR,APR_W,APR_MC,APR_ST,APR_AS,                       &
+              APR_CAPMA,APR_CAPME,APR_CAPMI,kbcon,ktop,                &   !-lxz
+              xf_ens,pr_ens,xland,gsw,cupclw,                          &
+              xl,rv,cp,g,ichoice,ipr,jpr,                              &
+              ids,ide, jds,jde, kds,kde,                               &
+              ims,ime, jms,jme, kms,kme,                               &
+              its,ite, jts,jte, kts,kte                               )
+
+   IMPLICIT NONE
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,                                     &
+        ims,ime, jms,jme, kms,kme,                                     &
+        its,ite, jts,jte, kts,kte,ipr,jpr
+     integer, intent (in   )              ::                           &
+        j,ensdim,maxiens,maxens,maxens2,maxens3,ichoice,iens
+  !
+  ! 
+  !
+     real,    dimension (ims:ime,jms:jme,1:ensdim)                     &
+        ,intent (inout)                   ::                           &
+        massfln,xf_ens,pr_ens
+     real,    dimension (ims:ime,jms:jme)                              &
+        ,intent (inout )                  ::                           &
+               APR_GR,APR_W,APR_MC,APR_ST,APR_AS,APR_CAPMA,     &
+               APR_CAPME,APR_CAPMI,massflx
+     real,    dimension (ims:ime,jms:jme)                              &
+        ,intent (in   )                   ::                           &
+               xland,gsw
+     integer, dimension (ims:ime,jms:jme)                              &
+        ,intent (in   )                   ::                           &
+        iact
+  ! outtem = output temp tendency (per s)
+  ! outq   = output q tendency (per s)
+  ! outqc  = output qc tendency (per s)
+  ! pre    = output precip
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        OUTT,OUTQ,OUTQC,CUPCLW
+     real,    dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+        pre
+!+lxz
+     integer,    dimension (its:ite)                                   &
+        ,intent (out  )                   ::                           &
+        kbcon,ktop
+!.lxz
+  !
+  ! basic environmental input includes moisture convergence (mconv)
+  ! omega (omeg), windspeed (us,vs), and a flag (aaeq) to turn off
+  ! convection for this call only and at that particular gridpoint
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        T,TN,PO,P,US,VS,omeg
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (inout)                   ::                           &
+         Q,QO
+     real, dimension (its:ite)                                         &
+        ,intent (in   )                   ::                           &
+        Z1,PSUR,AAEQ,direction,mconv
+
+       
+       real                                                            &
+        ,intent (in   )                   ::                           &
+        dtime,tcrit,xl,cp,rv,g
+
+
+!
+!  local ensemble dependent variables in this routine
+!
+     real,    dimension (its:ite,1:maxens)  ::                         &
+        xaa0_ens
+     real,    dimension (1:maxens)  ::                                 &
+        mbdt_ens
+     real,    dimension (1:maxens2) ::                                 &
+        edt_ens
+     real,    dimension (its:ite,1:maxens2) ::                         &
+        edtc
+     real,    dimension (its:ite,kts:kte,1:maxens2) ::                 &
+        dellat_ens,dellaqc_ens,dellaq_ens,pwo_ens
+!
+!
+!
+!***************** the following are your basic environmental
+!                  variables. They carry a "_cup" if they are
+!                  on model cloud levels (staggered). They carry
+!                  an "o"-ending (z becomes zo), if they are the forced
+!                  variables. They are preceded by x (z becomes xz)
+!                  to indicate modification by some typ of cloud
+!
+  ! z           = heights of model levels
+  ! q           = environmental mixing ratio
+  ! qes         = environmental saturation mixing ratio
+  ! t           = environmental temp
+  ! p           = environmental pressure
+  ! he          = environmental moist static energy
+  ! hes         = environmental saturation moist static energy
+  ! z_cup       = heights of model cloud levels
+  ! q_cup       = environmental q on model cloud levels
+  ! qes_cup     = saturation q on model cloud levels
+  ! t_cup       = temperature (Kelvin) on model cloud levels
+  ! p_cup       = environmental pressure
+  ! he_cup = moist static energy on model cloud levels
+  ! hes_cup = saturation moist static energy on model cloud levels
+  ! gamma_cup = gamma on model cloud levels
+!
+!
+  ! hcd = moist static energy in downdraft
+  ! zd normalized downdraft mass flux
+  ! dby = buoancy term
+  ! entr = entrainment rate
+  ! zd   = downdraft normalized mass flux
+  ! entr= entrainment rate
+  ! hcd = h in model cloud
+  ! bu = buoancy term
+  ! zd = normalized downdraft mass flux
+  ! gamma_cup = gamma on model cloud levels
+  ! mentr_rate = entrainment rate
+  ! qcd = cloud q (including liquid water) after entrainment
+  ! qrch = saturation q in cloud
+  ! pwd = evaporate at that level
+  ! pwev = total normalized integrated evaoprate (I2)
+  ! entr= entrainment rate
+  ! z1 = terrain elevation
+  ! entr = downdraft entrainment rate
+  ! jmin = downdraft originating level
+  ! kdet = level above ground where downdraft start detraining
+  ! psur        = surface pressure
+  ! z1          = terrain elevation
+  ! pr_ens = precipitation ensemble
+  ! xf_ens = mass flux ensembles
+  ! massfln = downdraft mass flux ensembles used in next timestep
+  ! omeg = omega from large scale model
+  ! mconv = moisture convergence from large scale model
+  ! zd      = downdraft normalized mass flux
+  ! zu      = updraft normalized mass flux
+  ! dir     = "storm motion"
+  ! mbdt    = arbitrary numerical parameter
+  ! dtime   = dt over which forcing is applied
+  ! iact_gr_old = flag to tell where convection was active
+  ! kbcon       = LFC of parcel from k22
+  ! k22         = updraft originating level
+  ! icoic       = flag if only want one closure (usually set to zero!)
+  ! dby = buoancy term
+  ! ktop = cloud top (output)
+  ! xmb    = total base mass flux
+  ! hc = cloud moist static energy
+  ! hkb = moist static energy at originating level
+  ! mentr_rate = entrainment rate
+
+     real,    dimension (its:ite,kts:kte) ::                           &
+        he,hes,qes,z,                                                  &
+        heo,heso,qeso,zo,                                              &
+        xhe,xhes,xqes,xz,xt,xq,                                        &
+
+        qes_cup,q_cup,he_cup,hes_cup,z_cup,p_cup,gamma_cup,t_cup,      &
+        qeso_cup,qo_cup,heo_cup,heso_cup,zo_cup,po_cup,gammao_cup,     &
+        tn_cup,                                                        &
+        xqes_cup,xq_cup,xhe_cup,xhes_cup,xz_cup,xp_cup,xgamma_cup,     &
+        xt_cup,                                                        &
+
+        dby,qc,qrcd,pwd,pw,hcd,qcd,dbyd,hc,qrc,zu,zd,clw_all,          &
+        dbyo,qco,qrcdo,pwdo,pwo,hcdo,qcdo,dbydo,hco,qrco,zuo,zdo,      &
+        xdby,xqc,xqrcd,xpwd,xpw,xhcd,xqcd,xhc,xqrc,xzu,xzd,            &
+
+  ! cd  = detrainment function for updraft
+  ! cdd = detrainment function for downdraft
+  ! dellat = change of temperature per unit mass flux of cloud ensemble
+  ! dellaq = change of q per unit mass flux of cloud ensemble
+  ! dellaqc = change of qc per unit mass flux of cloud ensemble
+
+        cd,cdd,scr1,DELLAH,DELLAQ,DELLAT,DELLAQC
+
+  ! aa0 cloud work function for downdraft
+  ! edt = epsilon
+  ! aa0     = cloud work function without forcing effects
+  ! aa1     = cloud work function with forcing effects
+  ! xaa0    = cloud work function with cloud effects (ensemble dependent)
+  ! edt     = epsilon
+     real,    dimension (its:ite) ::                                   &
+       edt,edto,edtx,AA1,AA0,XAA0,HKB,HKBO,aad,XHKB,QKB,QKBO,          &
+       XMB,XPWAV,XPWEV,PWAV,PWEV,PWAVO,PWEVO,BU,BUO,cap_max,xland1,     &
+       cap_max_increment,closure_n
+     integer,    dimension (its:ite) ::                                &
+       kzdown,KDET,K22,KB,JMIN,kstabi,kstabm,K22x,                     &   !-lxz
+       KBCONx,KBx,KTOPx,ierr,ierr2,ierr3,KBMAX 
+
+     integer                              ::                           &
+       nall,iedt,nens,nens3,ki,I,K,KK,iresult
+     real                                 ::                           &
+      day,dz,mbdt,entr_rate,radius,entrd_rate,mentr_rate,mentrd_rate,  &
+      zcutdown,edtmax,edtmin,depth_min,zkbmax,z_detr,zktop,            &
+      massfld,dh,cap_maxs
+
+     integer :: itf,jtf,ktf
+     integer :: jmini
+     logical :: keep_going
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+     jtf=MIN(jte,jde-1)
+
+!sms$distribute end
+      day=86400.
+      do i=its,itf
+        closure_n(i)=16.
+        xland1(i)=1.
+        if(xland(i,j).gt.1.5)xland1(i)=0.
+        cap_max_increment(i)=25.
+      enddo
+!
+!--- specify entrainmentrate and detrainmentrate
+!
+      if(iens.le.4)then
+      radius=14000.-float(iens)*2000.
+      else
+      radius=12000.
+      endif
+!
+!--- gross entrainment rate (these may be changed later on in the
+!--- program, depending what your detrainment is!!)
+!
+      entr_rate=.2/radius
+!
+!--- entrainment of mass
+!
+      mentrd_rate=0.
+      mentr_rate=entr_rate
+!
+!--- initial detrainmentrates
+!
+      do k=kts,ktf
+      do i=its,itf
+        cupclw(i,k)=0.
+        cd(i,k)=0.1*entr_rate
+        cdd(i,k)=0.
+      enddo
+      enddo
+!
+!--- max/min allowed value for epsilon (ratio downdraft base mass flux/updraft
+!    base mass flux
+!
+      edtmax=.8
+      edtmin=.2
+!
+!--- minimum depth (m), clouds must have
+!
+      depth_min=500.
+!
+!--- maximum depth (mb) of capping 
+!--- inversion (larger cap = no convection)
+!
+      cap_maxs=75.
+!sms$to_local(grid_dh: <1, mix :size>, <2, mjx :size>) begin
+      DO 7 i=its,itf
+        kbmax(i)=1
+        aa0(i)=0.
+        aa1(i)=0.
+        aad(i)=0.
+        edt(i)=0.
+        kstabm(i)=ktf-1
+        IERR(i)=0
+        IERR2(i)=0
+        IERR3(i)=0
+        if(aaeq(i).lt.-1.)then
+           ierr(i)=20
+        endif
+ 7    CONTINUE
+!
+!--- first check for upstream convection
+!
+      do i=its,itf
+          cap_max(i)=cap_maxs
+!         if(tkmax(i,j).lt.2.)cap_max(i)=25.
+          if(gsw(i,j).lt.1.)cap_max(i)=25.
+
+        iresult=0
+!       massfld=0.
+!     call cup_direction2(i,j,direction,iact, &
+!          cu_mfx,iresult,0,massfld,  &
+!          ids,ide, jds,jde, kds,kde, &
+!          ims,ime, jms,jme, kms,kme, &
+!          its,ite, jts,jte, kts,kte)
+!         cap_max(i)=cap_maxs
+       if(iresult.eq.1)then
+          cap_max(i)=cap_maxs+20.
+       endif
+!      endif
+      enddo
+!
+!--- max height(m) above ground where updraft air can originate
+!
+      zkbmax=4000.
+!
+!--- height(m) above which no downdrafts are allowed to originate
+!
+      zcutdown=3000.
+!
+!--- depth(m) over which downdraft detrains all its mass
+!
+      z_detr=1250.
+!
+      do nens=1,maxens
+         mbdt_ens(nens)=(float(nens)-3.)*dtime*1.e-3+dtime*5.E-03
+      enddo
+      do nens=1,maxens2
+         edt_ens(nens)=.95-float(nens)*.01
+      enddo
+!     if(j.eq.jpr)then
+!       print *,'radius ensemble ',iens,radius
+!       print *,mbdt_ens
+!       print *,edt_ens
+!     endif
+!
+!--- environmental conditions, FIRST HEIGHTS
+!
+      do i=its,itf
+         if(ierr(i).ne.20)then
+            do k=1,maxens*maxens2*maxens3
+               xf_ens(i,j,(iens-1)*maxens*maxens2*maxens3+k)=0.
+               pr_ens(i,j,(iens-1)*maxens*maxens2*maxens3+k)=0.
+            enddo
+         endif
+      enddo
+!
+!--- calculate moist static energy, heights, qes
+!
+      call cup_env(z,qes,he,hes,t,q,p,z1, &
+           psur,ierr,tcrit,0,xl,cp,   &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_env(zo,qeso,heo,heso,tn,qo,po,z1, &
+           psur,ierr,tcrit,0,xl,cp,   &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- environmental values on cloud levels
+!
+      call cup_env_clev(t,qes,q,he,hes,z,p,qes_cup,q_cup,he_cup, &
+           hes_cup,z_cup,p_cup,gamma_cup,t_cup,psur, &
+           ierr,z1,xl,rv,cp,          &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_env_clev(tn,qeso,qo,heo,heso,zo,po,qeso_cup,qo_cup, &
+           heo_cup,heso_cup,zo_cup,po_cup,gammao_cup,tn_cup,psur,  &
+           ierr,z1,xl,rv,cp,          &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      do i=its,itf
+      if(ierr(i).eq.0)then
+!
+      do k=kts,ktf-2
+        if(zo_cup(i,k).gt.zkbmax+z1(i))then
+          kbmax(i)=k
+          go to 25
+        endif
+      enddo
+ 25   continue
+!
+!
+!--- level where detrainment for downdraft starts
+!
+      do k=kts,ktf
+        if(zo_cup(i,k).gt.z_detr+z1(i))then
+          kdet(i)=k
+          go to 26
+        endif
+      enddo
+ 26   continue
+!
+      endif
+      enddo
+!
+!
+!
+!------- DETERMINE LEVEL WITH HIGHEST MOIST STATIC ENERGY CONTENT - K22
+!
+      CALL cup_MAXIMI(HEO_CUP,3,KBMAX,K22,ierr, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+       DO 36 i=its,itf
+         IF(ierr(I).eq.0.)THEN
+         IF(K22(I).GE.KBMAX(i))ierr(i)=2
+         endif
+ 36   CONTINUE
+!
+!--- DETERMINE THE LEVEL OF CONVECTIVE CLOUD BASE  - KBCON
+!
+      call cup_kbcon(cap_max_increment,1,k22,kbcon,heo_cup,heso_cup, &
+           ierr,kbmax,po_cup,cap_max, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!     call cup_kbcon_cin(1,k22,kbcon,heo_cup,heso_cup,z,tn_cup, &
+!          qeso_cup,ierr,kbmax,po_cup,cap_max,xl,cp,&
+!          ids,ide, jds,jde, kds,kde, &
+!          ims,ime, jms,jme, kms,kme, &
+!          its,ite, jts,jte, kts,kte)
+!
+!--- increase detrainment in stable layers
+!
+      CALL cup_minimi(HEso_cup,Kbcon,kstabm,kstabi,ierr,  &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      do i=its,itf
+      IF(ierr(I).eq.0.)THEN
+        if(kstabm(i)-1.gt.kstabi(i))then
+           do k=kstabi(i),kstabm(i)-1
+             cd(i,k)=cd(i,k-1)+1.5*entr_rate
+             if(cd(i,k).gt.10.0*entr_rate)cd(i,k)=10.0*entr_rate
+           enddo
+        ENDIF
+      ENDIF
+      ENDDO
+!
+!--- calculate incloud moist static energy
+!
+      call cup_up_he(k22,hkb,z_cup,cd,mentr_rate,he_cup,hc, &
+           kbcon,ierr,dby,he,hes_cup, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_up_he(k22,hkbo,zo_cup,cd,mentr_rate,heo_cup,hco, &
+           kbcon,ierr,dbyo,heo,heso_cup, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+
+!--- DETERMINE CLOUD TOP - KTOP
+!
+      call cup_ktop(1,dbyo,kbcon,ktop,ierr, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      DO 37 i=its,itf
+         kzdown(i)=0
+         if(ierr(i).eq.0)then
+            zktop=(zo_cup(i,ktop(i))-z1(i))*.6
+            zktop=min(zktop+z1(i),zcutdown+z1(i))
+            do k=kts,kte
+              if(zo_cup(i,k).gt.zktop)then
+                 kzdown(i)=k
+                 go to 37
+              endif
+              enddo
+         endif
+ 37   CONTINUE
+!
+!--- DOWNDRAFT ORIGINATING LEVEL - JMIN
+!
+      call cup_minimi(HEso_cup,K22,kzdown,JMIN,ierr, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      DO 100 i=its,ite
+        IF(ierr(I).eq.0.)THEN
+!
+!--- check whether it would have buoyancy, if there where
+!--- no entrainment/detrainment
+!
+!jm begin 20061212:  the following code replaces code that
+!   was too complex and causing problem for optimization.
+!   Done in consultation with G. Grell.
+        jmini = jmin(i)
+        keep_going = .TRUE.
+        DO WHILE ( keep_going )
+          keep_going = .FALSE.
+          if ( jmini - 1 .lt. kdet(i)   ) kdet(i) = jmini-1
+          if ( jmini     .ge. ktop(i)-1 ) jmini = ktop(i) - 2
+          ki = jmini
+          hcdo(i,ki)=heso_cup(i,ki)
+          DZ=Zo_cup(i,Ki+1)-Zo_cup(i,Ki)
+          dh=0.
+          DO k=ki-1,1,-1
+            hcdo(i,k)=heso_cup(i,jmini)
+            DZ=Zo_cup(i,K+1)-Zo_cup(i,K)
+            dh=dh+dz*(HCDo(i,K)-heso_cup(i,k))
+            IF(dh.gt.0.)THEN
+              jmini=jmini-1
+              IF ( jmini .gt. 3 ) THEN
+                keep_going = .TRUE.
+              ELSE
+                ierr(i) = 9
+                EXIT
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDDO
+        jmin(i) = jmini
+        IF ( jmini .le. 3 ) THEN
+          ierr(i)=4
+        ENDIF
+!jm end 20061212
+      ENDIF
+100   CONTINUE
+!
+! - Must have at least depth_min m between cloud convective base
+!     and cloud top.
+!
+      do i=its,itf
+      IF(ierr(I).eq.0.)THEN
+      IF(-zo_cup(I,KBCON(I))+zo_cup(I,KTOP(I)).LT.depth_min)then
+            ierr(i)=6
+      endif
+      endif
+      enddo
+
+!
+!c--- normalized updraft mass flux profile
+!
+      call cup_up_nms(zu,z_cup,mentr_rate,cd,kbcon,ktop,ierr,k22, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_up_nms(zuo,zo_cup,mentr_rate,cd,kbcon,ktop,ierr,k22, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!c--- normalized downdraft mass flux profile,also work on bottom detrainment
+!--- in this routine
+!
+      call cup_dd_nms(zd,z_cup,cdd,mentrd_rate,jmin,ierr, &
+           0,kdet,z1,                 &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_dd_nms(zdo,zo_cup,cdd,mentrd_rate,jmin,ierr, &
+           1,kdet,z1,                 &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- downdraft moist static energy
+!
+      call cup_dd_he(hes_cup,zd,hcd,z_cup,cdd,mentrd_rate, &
+           jmin,ierr,he,dbyd,he_cup,  &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_dd_he(heso_cup,zdo,hcdo,zo_cup,cdd,mentrd_rate, &
+           jmin,ierr,heo,dbydo,he_cup,&
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- calculate moisture properties of downdraft
+!
+      call cup_dd_moisture(zd,hcd,hes_cup,qcd,qes_cup, &
+           pwd,q_cup,z_cup,cdd,mentrd_rate,jmin,ierr,gamma_cup, &
+           pwev,bu,qrcd,q,he,t_cup,2,xl, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_dd_moisture(zdo,hcdo,heso_cup,qcdo,qeso_cup, &
+           pwdo,qo_cup,zo_cup,cdd,mentrd_rate,jmin,ierr,gammao_cup, &
+           pwevo,bu,qrcdo,qo,heo,tn_cup,1,xl, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- calculate moisture properties of updraft
+!
+      call cup_up_moisture(ierr,z_cup,qc,qrc,pw,pwav, &
+           kbcon,ktop,cd,dby,mentr_rate,clw_all,      &
+           q,GAMMA_cup,zu,qes_cup,k22,q_cup,xl, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      do k=kts,ktf
+      do i=its,itf
+         cupclw(i,k)=qrc(i,k)
+      enddo
+      enddo
+      call cup_up_moisture(ierr,zo_cup,qco,qrco,pwo,pwavo, &
+           kbcon,ktop,cd,dbyo,mentr_rate,clw_all, &
+           qo,GAMMAo_cup,zuo,qeso_cup,k22,qo_cup,xl,&
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- calculate workfunctions for updrafts
+!
+      call cup_up_aa0(aa0,z,zu,dby,GAMMA_CUP,t_cup, &
+           kbcon,ktop,ierr,           &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_up_aa0(aa1,zo,zuo,dbyo,GAMMAo_CUP,tn_cup, &
+           kbcon,ktop,ierr,           &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      do i=its,itf
+         if(ierr(i).eq.0)then
+           if(aa1(i).eq.0.)then
+               ierr(i)=17
+           endif
+         endif
+      enddo
+!
+!--- DETERMINE DOWNDRAFT STRENGTH IN TERMS OF WINDSHEAR
+!
+      call cup_dd_edt(ierr,us,vs,zo,ktop,kbcon,edt,po,pwavo, &
+           pwevo,edtmax,edtmin,maxens2,edtc, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      do 250 iedt=1,maxens2
+        do i=its,itf
+         if(ierr(i).eq.0)then
+         edt(i)=edtc(i,iedt)
+         edto(i)=edtc(i,iedt)
+         edtx(i)=edtc(i,iedt)
+         endif
+        enddo
+        do k=kts,ktf
+        do i=its,itf
+           dellat_ens(i,k,iedt)=0.
+           dellaq_ens(i,k,iedt)=0.
+           dellaqc_ens(i,k,iedt)=0.
+           pwo_ens(i,k,iedt)=0.
+        enddo
+        enddo
+!
+      do i=its,itf
+        aad(i)=0.
+      enddo
+!     do i=its,itf
+!       if(ierr(i).eq.0)then
+!        eddt(i,j)=edt(i)
+!        EDTX(I)=EDT(I)
+!        BU(I)=0.
+!        BUO(I)=0.
+!       endif
+!     enddo
+!
+!---downdraft workfunctions
+!
+!     call cup_dd_aa0(edt,ierr,aa0,jmin,gamma_cup,t_cup, &
+!          hcd,hes_cup,z,zd,          &
+!          ids,ide, jds,jde, kds,kde, &
+!          ims,ime, jms,jme, kms,kme, &
+!          its,ite, jts,jte, kts,kte)
+!     call cup_dd_aa0(edto,ierr,aad,jmin,gammao_cup,tn_cup, &
+!          hcdo,heso_cup,zo,zdo,      &
+!          ids,ide, jds,jde, kds,kde, &
+!          ims,ime, jms,jme, kms,kme, &
+!          its,ite, jts,jte, kts,kte)
+!
+!--- change per unit mass that a model cloud would modify the environment
+!
+!--- 1. in bottom layer
+!
+      call cup_dellabot(ipr,jpr,heo_cup,ierr,zo_cup,po,hcdo,edto, &
+           zdo,cdd,heo,dellah,j,mentrd_rate,zo,g, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_dellabot(ipr,jpr,qo_cup,ierr,zo_cup,po,qrcdo,edto, &
+           zdo,cdd,qo,dellaq,j,mentrd_rate,zo,g,&
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- 2. everywhere else
+!
+      call cup_dellas(ierr,zo_cup,po_cup,hcdo,edto,zdo,cdd,    &
+           heo,dellah,j,mentrd_rate,zuo,g,                     &
+           cd,hco,ktop,k22,kbcon,mentr_rate,jmin,heo_cup,kdet, &
+           k22,ipr,jpr,'deep',                                 &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!-- take out cloud liquid water for detrainment
+!
+!??   do k=kts,ktf
+      do k=kts,ktf-1
+      do i=its,itf
+       scr1(i,k)=0.
+       dellaqc(i,k)=0.
+       if(ierr(i).eq.0)then
+!       print *,'in vupnewg, after della ',ierr(i),aa0(i),i,j
+         scr1(i,k)=qco(i,k)-qrco(i,k)
+         if(k.eq.ktop(i)-0)dellaqc(i,k)= &
+                      .01*zuo(i,ktop(i))*qrco(i,ktop(i))* &
+                      9.81/(po_cup(i,k)-po_cup(i,k+1))
+         if(k.lt.ktop(i).and.k.gt.kbcon(i))then
+           dz=zo_cup(i,k+1)-zo_cup(i,k)
+           dellaqc(i,k)=.01*9.81*cd(i,k)*dz*zuo(i,k) &
+                        *.5*(qrco(i,k)+qrco(i,k+1))/ &
+                        (po_cup(i,k)-po_cup(i,k+1))
+         endif
+       endif
+      enddo
+      enddo
+      call cup_dellas(ierr,zo_cup,po_cup,qrcdo,edto,zdo,cdd, &
+           qo,dellaq,j,mentrd_rate,zuo,g, &
+           cd,scr1,ktop,k22,kbcon,mentr_rate,jmin,qo_cup,kdet, &
+           k22,ipr,jpr,'deep',               &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte    )
+!
+!--- using dellas, calculate changed environmental profiles
+!
+!     do 200 nens=1,maxens
+      mbdt=mbdt_ens(2)
+      do i=its,itf
+      xaa0_ens(i,1)=0.
+      xaa0_ens(i,2)=0.
+      xaa0_ens(i,3)=0.
+      enddo
+
+!     mbdt=mbdt_ens(nens)
+!     do i=its,itf 
+!     xaa0_ens(i,nens)=0.
+!     enddo
+      do k=kts,ktf
+      do i=its,itf
+         dellat(i,k)=0.
+         if(ierr(i).eq.0)then
+            XHE(I,K)=DELLAH(I,K)*MBDT+HEO(I,K)
+            XQ(I,K)=DELLAQ(I,K)*MBDT+QO(I,K)
+            DELLAT(I,K)=(1./cp)*(DELLAH(I,K)-xl*DELLAQ(I,K))
+            XT(I,K)= DELLAT(I,K)*MBDT+TN(I,K)
+            IF(XQ(I,K).LE.0.)XQ(I,K)=1.E-08
+!            if(i.eq.ipr.and.j.eq.jpr)then
+!              print *,k,DELLAH(I,K),DELLAQ(I,K),DELLAT(I,K)
+!            endif
+         ENDIF
+      enddo
+      enddo
+      do i=its,itf
+      if(ierr(i).eq.0)then
+      XHE(I,ktf)=HEO(I,ktf)
+      XQ(I,ktf)=QO(I,ktf)
+      XT(I,ktf)=TN(I,ktf)
+      IF(XQ(I,ktf).LE.0.)XQ(I,ktf)=1.E-08
+      endif
+      enddo
+!
+!--- calculate moist static energy, heights, qes
+!
+      call cup_env(xz,xqes,xhe,xhes,xt,xq,po,z1, &
+           psur,ierr,tcrit,2,xl,cp,   &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- environmental values on cloud levels
+!
+      call cup_env_clev(xt,xqes,xq,xhe,xhes,xz,po,xqes_cup,xq_cup, &
+           xhe_cup,xhes_cup,xz_cup,po_cup,gamma_cup,xt_cup,psur,   &
+           ierr,z1,xl,rv,cp,          &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!
+!**************************** static control
+!
+!--- moist static energy inside cloud
+!
+      do i=its,itf
+        if(ierr(i).eq.0)then
+          xhkb(i)=xhe(i,k22(i))
+        endif
+      enddo
+      call cup_up_he(k22,xhkb,xz_cup,cd,mentr_rate,xhe_cup,xhc, &
+           kbcon,ierr,xdby,xhe,xhes_cup, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!c--- normalized mass flux profile
+!
+      call cup_up_nms(xzu,xz_cup,mentr_rate,cd,kbcon,ktop,ierr,k22, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- moisture downdraft
+!
+      call cup_dd_nms(xzd,xz_cup,cdd,mentrd_rate,jmin,ierr, &
+           1,kdet,z1,                 &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_dd_he(xhes_cup,xzd,xhcd,xz_cup,cdd,mentrd_rate, &
+           jmin,ierr,xhe,dbyd,xhe_cup,&
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_dd_moisture(xzd,xhcd,xhes_cup,xqcd,xqes_cup, &
+           xpwd,xq_cup,xz_cup,cdd,mentrd_rate,jmin,ierr,gamma_cup, &
+           xpwev,bu,xqrcd,xq,xhe,xt_cup,3,xl, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+
+!
+!------- MOISTURE updraft
+!
+      call cup_up_moisture(ierr,xz_cup,xqc,xqrc,xpw,xpwav, &
+           kbcon,ktop,cd,xdby,mentr_rate,clw_all, &
+           xq,GAMMA_cup,xzu,xqes_cup,k22,xq_cup,xl, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- workfunctions for updraft
+!
+      call cup_up_aa0(xaa0,xz,xzu,xdby,GAMMA_CUP,xt_cup, &
+           kbcon,ktop,ierr,           &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- workfunctions for downdraft
+!
+!
+!     call cup_dd_aa0(edtx,ierr,xaa0,jmin,gamma_cup,xt_cup, &
+!          xhcd,xhes_cup,xz,xzd,      &
+!          ids,ide, jds,jde, kds,kde, &
+!          ims,ime, jms,jme, kms,kme, &
+!          its,ite, jts,jte, kts,kte)
+      do 200 nens=1,maxens
+      do i=its,itf 
+         if(ierr(i).eq.0)then
+           xaa0_ens(i,nens)=xaa0(i)
+           nall=(iens-1)*maxens3*maxens*maxens2 &
+                +(iedt-1)*maxens*maxens3 &
+                +(nens-1)*maxens3
+           do k=kts,ktf
+              if(k.le.ktop(i))then
+                 do nens3=1,maxens3
+                 if(nens3.eq.7)then
+!--- b=0
+                 pr_ens(i,j,nall+nens3)=pr_ens(i,j,nall+nens3)+ &
+                                    pwo(i,k) 
+!                                  +edto(i)*pwdo(i,k)
+!--- b=beta
+                 else if(nens3.eq.8)then
+                 pr_ens(i,j,nall+nens3)=pr_ens(i,j,nall+nens3)+ &
+                                    pwo(i,k)
+!--- b=beta/2
+                 else if(nens3.eq.9)then
+                 pr_ens(i,j,nall+nens3)=pr_ens(i,j,nall+nens3)+ &
+                                    pwo(i,k)
+!                                  +.5*edto(i)*pwdo(i,k)
+                 else
+                 pr_ens(i,j,nall+nens3)=pr_ens(i,j,nall+nens3)+ &
+                                    pwo(i,k)+edto(i)*pwdo(i,k)
+                 endif
+                 enddo
+              endif
+           enddo
+         if(pr_ens(i,j,nall+7).lt.1.e-6)then
+            ierr(i)=18
+            do nens3=1,maxens3
+               pr_ens(i,j,nall+nens3)=0.
+            enddo
+         endif
+         do nens3=1,maxens3
+           if(pr_ens(i,j,nall+nens3).lt.1.e-4)then
+            pr_ens(i,j,nall+nens3)=0.
+           endif
+         enddo
+         endif
+      enddo
+ 200  continue
+!
+!--- LARGE SCALE FORCING
+!
+!
+!------- CHECK wether aa0 should have been zero
+!
+!
+      CALL cup_MAXIMI(HEO_CUP,3,KBMAX,K22x,ierr, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      do i=its,itf
+         ierr2(i)=ierr(i)
+         ierr3(i)=ierr(i)
+      enddo
+      call cup_kbcon(cap_max_increment,2,k22x,kbconx,heo_cup, &
+           heso_cup,ierr2,kbmax,po_cup,cap_max, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      call cup_kbcon(cap_max_increment,3,k22x,kbconx,heo_cup, &
+           heso_cup,ierr3,kbmax,po_cup,cap_max, &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+!--- DETERMINE THE LEVEL OF CONVECTIVE CLOUD BASE  - KBCON
+!
+      call cup_forcing_ens(closure_n,xland1,aa0,aa1,xaa0_ens,mbdt_ens,dtime,   &
+           ierr,ierr2,ierr3,xf_ens,j,'deeps',                 &
+           maxens,iens,iedt,maxens2,maxens3,mconv,            &
+           po_cup,ktop,omeg,zdo,k22,zuo,pr_ens,edto,kbcon,    &
+           massflx,iact,direction,ensdim,massfln,ichoice,     &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+!
+      do k=kts,ktf
+      do i=its,itf
+        if(ierr(i).eq.0)then
+           dellat_ens(i,k,iedt)=dellat(i,k)
+           dellaq_ens(i,k,iedt)=dellaq(i,k)
+           dellaqc_ens(i,k,iedt)=dellaqc(i,k)
+           pwo_ens(i,k,iedt)=pwo(i,k)+edt(i)*pwdo(i,k)
+        else 
+           dellat_ens(i,k,iedt)=0.
+           dellaq_ens(i,k,iedt)=0.
+           dellaqc_ens(i,k,iedt)=0.
+           pwo_ens(i,k,iedt)=0.
+        endif
+!      if(i.eq.ipr.and.j.eq.jpr)then
+!        print *,iens,iedt,dellat(i,k),dellat_ens(i,k,iedt), &
+!          dellaq(i,k), dellaqc(i,k)
+!      endif
+      enddo
+      enddo
+ 250  continue
+!
+!--- FEEDBACK
+!
+      call cup_output_ens(xf_ens,ierr,dellat_ens,dellaq_ens, &
+           dellaqc_ens,outt,outq,outqc,pre,pwo_ens,xmb,ktop, &
+           j,'deep',maxens2,maxens,iens,ierr2,ierr3,         &
+           pr_ens,maxens3,ensdim,massfln,                    &
+           APR_GR,APR_W,APR_MC,APR_ST,APR_AS,                &
+           APR_CAPMA,APR_CAPME,APR_CAPMI,closure_n,xland1,   &
+           ids,ide, jds,jde, kds,kde, &
+           ims,ime, jms,jme, kms,kme, &
+           its,ite, jts,jte, kts,kte)
+      do i=its,itf
+           PRE(I)=MAX(PRE(I),0.)
+      enddo
+!
+!---------------------------done------------------------------
+!
+
+   END SUBROUTINE CUP_enss
+
+
+   SUBROUTINE cup_dd_aa0(edt,ierr,aa0,jmin,gamma_cup,t_cup, &
+              hcd,hes_cup,z,zd,                             &
+              ids,ide, jds,jde, kds,kde,                    &
+              ims,ime, jms,jme, kms,kme,                    &
+              its,ite, jts,jte, kts,kte                    )
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,                                     &
+        ims,ime, jms,jme, kms,kme,                                     &
+        its,ite, jts,jte, kts,kte
+  ! aa0 cloud work function for downdraft
+  ! gamma_cup = gamma on model cloud levels
+  ! t_cup = temperature (Kelvin) on model cloud levels
+  ! hes_cup = saturation moist static energy on model cloud levels
+  ! hcd = moist static energy in downdraft
+  ! edt = epsilon
+  ! zd normalized downdraft mass flux
+  ! z = heights of model levels 
+  ! ierr error value, maybe modified in this routine
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        z,zd,gamma_cup,t_cup,hes_cup,hcd
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        edt
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        jmin
+!
+! input and output
+!
+
+
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+     real,    dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+        aa0
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        i,k,kk
+     real                                 ::                           &
+        dz
+!
+     integer :: itf, ktf
+!
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+!
+!??    DO k=kts,kte-1
+       DO k=kts,ktf-1
+       do i=its,itf
+         IF(ierr(I).eq.0.and.k.lt.jmin(i))then
+         KK=JMIN(I)-K
+!
+!--- ORIGINAL
+!
+         DZ=(Z(I,KK)-Z(I,KK+1))
+         AA0(I)=AA0(I)+zd(i,kk)*EDT(I)*DZ*(9.81/(1004.*T_cup(I,KK))) &
+            *((hcd(i,kk)-hes_cup(i,kk))/(1.+GAMMA_cup(i,kk)))
+         endif
+      enddo
+      enddo
+
+   END SUBROUTINE CUP_dd_aa0
+
+
+   SUBROUTINE cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, &
+              pwev,edtmax,edtmin,maxens2,edtc,               &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+     integer, intent (in   )              ::                           &
+        maxens2
+  !
+  ! ierr error value, maybe modified in this routine
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        us,vs,z,p
+     real,    dimension (its:ite,1:maxens2)                            &
+        ,intent (out  )                   ::                           &
+        edtc
+     real,    dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+        edt
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        pwav,pwev
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        edtmax,edtmin
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        ktop,kbcon
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+!
+!  local variables in this routine
+!
+
+     integer i,k,kk
+     real    einc,pef,pefb,prezk,zkbc
+     real,    dimension (its:ite)         ::                           &
+      vshear,sdp,vws
+
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+!
+!--- DETERMINE DOWNDRAFT STRENGTH IN TERMS OF WINDSHEAR
+!
+! */ calculate an average wind shear over the depth of the cloud
+!
+       do i=its,itf
+        edt(i)=0.
+        vws(i)=0.
+        sdp(i)=0.
+        vshear(i)=0.
+       enddo
+       do kk = kts,ktf-1
+         do 62 i=its,itf
+          IF(ierr(i).ne.0)GO TO 62
+          if (kk .le. min0(ktop(i),ktf) .and. kk .ge. kbcon(i)) then
+             vws(i) = vws(i)+ &
+              (abs((us(i,kk+1)-us(i,kk))/(z(i,kk+1)-z(i,kk))) &
+          +   abs((vs(i,kk+1)-vs(i,kk))/(z(i,kk+1)-z(i,kk)))) * &
+              (p(i,kk) - p(i,kk+1))
+            sdp(i) = sdp(i) + p(i,kk) - p(i,kk+1)
+          endif
+          if (kk .eq. ktf)vshear(i) = 1.e3 * vws(i) / sdp(i)
+   62   continue
+       end do
+      do i=its,itf
+         IF(ierr(i).eq.0)then
+            pef=(1.591-.639*VSHEAR(I)+.0953*(VSHEAR(I)**2) &
+               -.00496*(VSHEAR(I)**3))
+            if(pef.gt.edtmax)pef=edtmax
+            if(pef.lt.edtmin)pef=edtmin
+!
+!--- cloud base precip efficiency
+!
+            zkbc=z(i,kbcon(i))*3.281e-3
+            prezk=.02
+            if(zkbc.gt.3.)then
+               prezk=.96729352+zkbc*(-.70034167+zkbc*(.162179896+zkbc &
+               *(- 1.2569798E-2+zkbc*(4.2772E-4-zkbc*5.44E-6))))
+            endif
+            if(zkbc.gt.25)then
+               prezk=2.4
+            endif
+            pefb=1./(1.+prezk)
+            if(pefb.gt.edtmax)pefb=edtmax
+            if(pefb.lt.edtmin)pefb=edtmin
+            EDT(I)=1.-.5*(pefb+pef)
+!--- edt here is 1-precipeff!
+!           einc=(1.-edt(i))/float(maxens2)
+!           einc=edt(i)/float(maxens2+1)
+!--- 20 percent
+            einc=.2*edt(i)
+            do k=1,maxens2
+                edtc(i,k)=edt(i)+float(k-2)*einc
+            enddo
+         endif
+      enddo
+      do i=its,itf
+         IF(ierr(i).eq.0)then
+            do k=1,maxens2
+               EDTC(I,K)=-EDTC(I,K)*PWAV(I)/PWEV(I)
+               IF(EDTC(I,K).GT.edtmax)EDTC(I,K)=edtmax
+               IF(EDTC(I,K).LT.edtmin)EDTC(I,K)=edtmin
+            enddo
+         endif
+      enddo
+
+   END SUBROUTINE cup_dd_edt
+
+
+   SUBROUTINE cup_dd_he(hes_cup,zd,hcd,z_cup,cdd,entr,       &
+              jmin,ierr,he,dby,he_cup,                       &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+                                  ids,ide, jds,jde, kds,kde,           &
+                                  ims,ime, jms,jme, kms,kme,           &
+                                  its,ite, jts,jte, kts,kte
+  ! hcd = downdraft moist static energy
+  ! he = moist static energy on model levels
+  ! he_cup = moist static energy on model cloud levels
+  ! hes_cup = saturation moist static energy on model cloud levels
+  ! dby = buoancy term
+  ! cdd= detrainment function 
+  ! z_cup = heights of model cloud levels 
+  ! entr = entrainment rate
+  ! zd   = downdraft normalized mass flux
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        he,he_cup,hes_cup,z_cup,cdd,zd
+  ! entr= entrainment rate 
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        entr
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        jmin
+!
+! input and output
+!
+
+   ! ierr error value, maybe modified in this routine
+
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        hcd,dby
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        i,k,ki
+     real                                 ::                           &
+        dz
+
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+
+      do k=kts+1,ktf
+      do i=its,itf
+      dby(i,k)=0.
+      IF(ierr(I).eq.0)then
+         hcd(i,k)=hes_cup(i,k)
+      endif
+      enddo
+      enddo
+!
+      do 100 i=its,itf
+      IF(ierr(I).eq.0)then
+      k=jmin(i)
+      hcd(i,k)=hes_cup(i,k)
+      dby(i,k)=hcd(i,jmin(i))-hes_cup(i,k)
+!
+      do ki=jmin(i)-1,1,-1
+         DZ=Z_cup(i,Ki+1)-Z_cup(i,Ki)
+         HCD(i,Ki)=(HCD(i,Ki+1)*(1.-.5*CDD(i,Ki)*DZ) &
+                  +entr*DZ*HE(i,Ki) &
+                  )/(1.+entr*DZ-.5*CDD(i,Ki)*DZ)
+         dby(i,ki)=HCD(i,Ki)-hes_cup(i,ki)
+      enddo
+!
+      endif
+!--- end loop over i
+100    continue
+
+
+   END SUBROUTINE cup_dd_he
+
+
+   SUBROUTINE cup_dd_moisture(zd,hcd,hes_cup,qcd,qes_cup,    &
+              pwd,q_cup,z_cup,cdd,entr,jmin,ierr,            &
+              gamma_cup,pwev,bu,qrcd,                        &
+              q,he,t_cup,iloop,xl,                           &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+                                  ids,ide, jds,jde, kds,kde,           &
+                                  ims,ime, jms,jme, kms,kme,           &
+                                  its,ite, jts,jte, kts,kte
+  ! cdd= detrainment function 
+  ! q = environmental q on model levels
+  ! q_cup = environmental q on model cloud levels
+  ! qes_cup = saturation q on model cloud levels
+  ! hes_cup = saturation h on model cloud levels
+  ! hcd = h in model cloud
+  ! bu = buoancy term
+  ! zd = normalized downdraft mass flux
+  ! gamma_cup = gamma on model cloud levels
+  ! mentr_rate = entrainment rate
+  ! qcd = cloud q (including liquid water) after entrainment
+  ! qrch = saturation q in cloud
+  ! pwd = evaporate at that level
+  ! pwev = total normalized integrated evaoprate (I2)
+  ! entr= entrainment rate 
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        zd,t_cup,hes_cup,hcd,qes_cup,q_cup,z_cup,cdd,gamma_cup,q,he 
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        entr,xl
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        iloop
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        jmin
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        qcd,qrcd,pwd
+     real,    dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+        pwev,bu
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        i,k,ki
+     real                                 ::                           &
+        dh,dz,dqeva
+
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+
+      do i=its,itf
+         bu(i)=0.
+         pwev(i)=0.
+      enddo
+      do k=kts,ktf
+      do i=its,itf
+         qcd(i,k)=0.
+         qrcd(i,k)=0.
+         pwd(i,k)=0.
+      enddo
+      enddo
+!
+!
+!
+      do 100 i=its,itf
+      IF(ierr(I).eq.0)then
+      k=jmin(i)
+      DZ=Z_cup(i,K+1)-Z_cup(i,K)
+      qcd(i,k)=q_cup(i,k)
+!     qcd(i,k)=.5*(qes_cup(i,k)+q_cup(i,k))
+      qrcd(i,k)=qes_cup(i,k)
+      pwd(i,jmin(i))=min(0.,qcd(i,k)-qrcd(i,k))
+      pwev(i)=pwev(i)+pwd(i,jmin(i))
+      qcd(i,k)=qes_cup(i,k)
+!
+      DH=HCD(I,k)-HES_cup(I,K)
+      bu(i)=dz*dh
+      do ki=jmin(i)-1,1,-1
+         DZ=Z_cup(i,Ki+1)-Z_cup(i,Ki)
+         QCD(i,Ki)=(qCD(i,Ki+1)*(1.-.5*CDD(i,Ki)*DZ) &
+                  +entr*DZ*q(i,Ki) &
+                  )/(1.+entr*DZ-.5*CDD(i,Ki)*DZ)
+!
+!--- to be negatively buoyant, hcd should be smaller than hes!
+!
+         DH=HCD(I,ki)-HES_cup(I,Ki)
+         bu(i)=bu(i)+dz*dh
+         QRCD(I,Ki)=qes_cup(i,ki)+(1./XL)*(GAMMA_cup(i,ki) &
+                  /(1.+GAMMA_cup(i,ki)))*DH
+         dqeva=qcd(i,ki)-qrcd(i,ki)
+         if(dqeva.gt.0.)dqeva=0.
+         pwd(i,ki)=zd(i,ki)*dqeva
+         qcd(i,ki)=qrcd(i,ki)
+         pwev(i)=pwev(i)+pwd(i,ki)
+!        if(iloop.eq.1.and.i.eq.102.and.j.eq.62)then
+!         print *,'in cup_dd_moi ', hcd(i,ki),HES_cup(I,Ki),dh,dqeva
+!        endif
+      enddo
+!
+!--- end loop over i
+       if(pwev(I).eq.0.and.iloop.eq.1)then
+!        print *,'problem with buoy in cup_dd_moisture',i
+         ierr(i)=7
+       endif
+       if(BU(I).GE.0.and.iloop.eq.1)then
+!        print *,'problem with buoy in cup_dd_moisture',i
+         ierr(i)=7
+       endif
+      endif
+100    continue
+
+   END SUBROUTINE cup_dd_moisture
+
+
+   SUBROUTINE cup_dd_nms(zd,z_cup,cdd,entr,jmin,ierr,        &
+              itest,kdet,z1,                                 &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+                                  ids,ide, jds,jde, kds,kde,           &
+                                  ims,ime, jms,jme, kms,kme,           &
+                                  its,ite, jts,jte, kts,kte
+  ! z_cup = height of cloud model level
+  ! z1 = terrain elevation
+  ! entr = downdraft entrainment rate
+  ! jmin = downdraft originating level
+  ! kdet = level above ground where downdraft start detraining
+  ! itest = flag to whether to calculate cdd
+  
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        z_cup
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        z1 
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        entr 
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        jmin,kdet
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        itest
+!
+! input and output
+!
+
+   ! ierr error value, maybe modified in this routine
+
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+                                                                 ierr
+   ! zd is the normalized downdraft mass flux
+   ! cdd is the downdraft detrainmen function
+
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+                                                             zd
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (inout)                   ::                           &
+                                                             cdd
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+                                                  i,k,ki
+     real                                 ::                           &
+                                            a,perc,dz
+
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+!
+!--- perc is the percentage of mass left when hitting the ground
+!
+      perc=.03
+
+      do k=kts,ktf
+      do i=its,itf
+         zd(i,k)=0.
+         if(itest.eq.0)cdd(i,k)=0.
+      enddo
+      enddo
+      a=1.-perc
+!
+!
+!
+      do 100 i=its,itf
+      IF(ierr(I).eq.0)then
+      zd(i,jmin(i))=1.
+!
+!--- integrate downward, specify detrainment(cdd)!
+!
+      do ki=jmin(i)-1,1,-1
+         DZ=Z_cup(i,Ki+1)-Z_cup(i,Ki)
+         if(ki.le.kdet(i).and.itest.eq.0)then
+           cdd(i,ki)=entr+(1.- (a*(z_cup(i,ki)-z1(i)) &
+                     +perc*(z_cup(i,kdet(i))-z1(i)) ) &
+                         /(a*(z_cup(i,ki+1)-z1(i)) &
+                      +perc*(z_cup(i,kdet(i))-z1(i))))/dz
+         endif
+         zd(i,ki)=zd(i,ki+1)*(1.+(entr-cdd(i,ki))*dz)
+      enddo
+!
+      endif
+!--- end loop over i
+100    continue
+
+   END SUBROUTINE cup_dd_nms
+
+
+   SUBROUTINE cup_dellabot(ipr,jpr,he_cup,ierr,z_cup,p_cup,  &
+              hcd,edt,zd,cdd,he,della,j,mentrd_rate,z,g,     &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+     integer, intent (in   )              ::                           &
+        j,ipr,jpr
+  !
+  ! ierr error value, maybe modified in this routine
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        della
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in  )                   ::                           &
+        z_cup,p_cup,hcd,zd,cdd,he,z,he_cup
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        edt
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        g,mentrd_rate
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+!
+!  local variables in this routine
+!
+
+      integer i
+      real detdo,detdo1,detdo2,entdo,dp,dz,subin,                      &
+      totmas
+!
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+!
+!
+!      if(j.eq.jpr)print *,'in cup dellabot '
+      do 100 i=its,itf
+      della(i,1)=0.
+      if(ierr(i).ne.0)go to 100
+      dz=z_cup(i,2)-z_cup(i,1)
+      DP=100.*(p_cup(i,1)-P_cup(i,2))
+      detdo1=edt(i)*zd(i,2)*CDD(i,1)*DZ
+      detdo2=edt(i)*zd(i,1)
+      entdo=edt(i)*zd(i,2)*mentrd_rate*dz
+      subin=-EDT(I)*zd(i,2)
+      detdo=detdo1+detdo2-entdo+subin
+      DELLA(I,1)=(detdo1*.5*(HCD(i,1)+HCD(i,2)) &
+                 +detdo2*hcd(i,1) &
+                 +subin*he_cup(i,2) &
+                 -entdo*he(i,1))*g/dp
+ 100  CONTINUE
+
+   END SUBROUTINE cup_dellabot
+
+
+   SUBROUTINE cup_dellas(ierr,z_cup,p_cup,hcd,edt,zd,cdd,              &
+              he,della,j,mentrd_rate,zu,g,                             &
+              cd,hc,ktop,k22,kbcon,mentr_rate,jmin,he_cup,kdet,kpbl,   &
+              ipr,jpr,name,                                            &
+              ids,ide, jds,jde, kds,kde,                               &
+              ims,ime, jms,jme, kms,kme,                               &
+              its,ite, jts,jte, kts,kte                               )
+
+   IMPLICIT NONE
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+     integer, intent (in   )              ::                           &
+        j,ipr,jpr
+  !
+  ! ierr error value, maybe modified in this routine
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        della
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in  )                   ::                           &
+        z_cup,p_cup,hcd,zd,cdd,he,hc,cd,zu,he_cup
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        edt
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        g,mentrd_rate,mentr_rate
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        kbcon,ktop,k22,jmin,kdet,kpbl
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+      character *(*), intent (in)        ::                           &
+       name
+!
+!  local variables in this routine
+!
+
+      integer i,k
+      real detdo1,detdo2,entdo,dp,dz,subin,detdo,entup,                &
+      detup,subdown,entdoj,entupk,detupk,totmas
+!
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+!
+!
+      i=ipr
+!      if(j.eq.jpr)then
+!        print *,'in dellas kpbl(i),k22(i),kbcon(i),ktop(i),jmin(i)'
+!        print *,kpbl(i),k22(i),kbcon(i),ktop(i),jmin(i)
+!      endif
+       DO K=kts+1,ktf
+       do i=its,itf
+          della(i,k)=0.
+       enddo
+       enddo
+!
+       DO 100 k=kts+1,ktf-1
+       DO 100 i=its,ite
+         IF(ierr(i).ne.0)GO TO 100
+         IF(K.Gt.KTOP(I))GO TO 100
+!
+!--- SPECIFY DETRAINMENT OF DOWNDRAFT, HAS TO BE CONSISTENT
+!--- WITH ZD CALCULATIONS IN SOUNDD.
+!
+         DZ=Z_cup(I,K+1)-Z_cup(I,K)
+         detdo=edt(i)*CDD(i,K)*DZ*ZD(i,k+1)
+         entdo=edt(i)*mentrd_rate*dz*zd(i,k+1)
+         subin=zu(i,k+1)-zd(i,k+1)*edt(i)
+         entup=0.
+         detup=0.
+         if(k.ge.kbcon(i).and.k.lt.ktop(i))then
+            entup=mentr_rate*dz*zu(i,k)
+            detup=CD(i,K+1)*DZ*ZU(i,k)
+         endif
+         subdown=(zu(i,k)-zd(i,k)*edt(i))
+         entdoj=0.
+         entupk=0.
+         detupk=0.
+!
+         if(k.eq.jmin(i))then
+         entdoj=edt(i)*zd(i,k)
+         endif
+
+         if(k.eq.k22(i)-1)then
+         entupk=zu(i,kpbl(i))
+         endif
+
+         if(k.gt.kdet(i))then
+            detdo=0.
+         endif
+
+         if(k.eq.ktop(i)-0)then
+         detupk=zu(i,ktop(i))
+         subin=0.
+         endif
+         if(k.lt.kbcon(i))then
+            detup=0.
+         endif
+!C
+!C--- CHANGED DUE TO SUBSIDENCE AND ENTRAINMENT
+!C
+         totmas=subin-subdown+detup-entup-entdo+ &
+                 detdo-entupk-entdoj+detupk
+!         if(j.eq.jpr.and.i.eq.ipr)print *,'k,totmas,sui,sud = ',k,
+!     1   totmas,subin,subdown
+!         if(j.eq.jpr.and.i.eq.ipr)print *,'updr stuff = ',detup,
+!     1      entup,entupk,detupk
+!         if(j.eq.jpr.and.i.eq.ipr)print *,'dddr stuff = ',entdo,
+!     1      detdo,entdoj
+         if(abs(totmas).gt.1.e-6)then
+!           print *,'*********************',i,j,k,totmas,name
+!           print *,kpbl(i),k22(i),kbcon(i),ktop(i)
+!c          print *,'updr stuff = ',subin,
+!c    1      subdown,detup,entup,entupk,detupk
+!c          print *,'dddr stuff = ',entdo,
+!c    1      detdo,entdoj
+!        call wrf_error_fatal ( 'totmas .gt.1.e-6' )
+         endif
+         dp=100.*(p_cup(i,k-1)-p_cup(i,k))
+         della(i,k)=(subin*he_cup(i,k+1) &
+                    -subdown*he_cup(i,k) &
+                    +detup*.5*(HC(i,K+1)+HC(i,K)) &
+                    +detdo*.5*(HCD(i,K+1)+HCD(i,K)) &
+                    -entup*he(i,k) &
+                    -entdo*he(i,k) &
+                    -entupk*he_cup(i,k22(i)) &
+                    -entdoj*he_cup(i,jmin(i)) &
+                    +detupk*hc(i,ktop(i)) &
+                     )*g/dp
+!      if(i.eq.ipr.and.j.eq.jpr)then
+!        print *,k,della(i,k),subin*he_cup(i,k+1),subdown*he_cup(i,k),
+!     1            detdo*.5*(HCD(i,K+1)+HCD(i,K))
+!        print *,k,detup*.5*(HC(i,K+1)+HC(i,K)),detupk*hc(i,ktop(i)),
+!     1         entup*he(i,k),entdo*he(i,k)
+!        print *,k,he_cup(i,k+1),he_cup(i,k),entupk*he_cup(i,k)
+!      endif
+
+ 100  CONTINUE
+
+   END SUBROUTINE cup_dellas
+
+
+   SUBROUTINE cup_direction2(i,j,dir,id,massflx,             &
+              iresult,imass,massfld,                         &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+     integer, intent (in   )              ::                           &
+        i,j,imass
+     integer, intent (out  )              ::                           &
+        iresult
+  !
+  ! ierr error value, maybe modified in this routine
+  !
+     integer,    dimension (ims:ime,jms:jme)                           &
+        ,intent (in   )                   ::                           &
+        id
+     real,    dimension (ims:ime,jms:jme)                              &
+        ,intent (in   )                   ::                           &
+        massflx
+     real,    dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        dir
+     real                                                              &
+        ,intent (out  )                   ::                           &
+        massfld
+!
+!  local variables in this routine
+!
+
+       integer k,ia,ja,ib,jb
+       real diff
+!
+!
+!
+       if(imass.eq.1)then
+           massfld=massflx(i,j)
+       endif
+       iresult=0
+!      return
+       diff=22.5
+       if(dir(i).lt.22.5)dir(i)=360.+dir(i)
+       if(id(i,j).eq.1)iresult=1
+!      ja=max(2,j-1)
+!      ia=max(2,i-1)
+!      jb=min(mjx-1,j+1)
+!      ib=min(mix-1,i+1)
+       ja=j-1
+       ia=i-1
+       jb=j+1
+       ib=i+1
+        if(dir(i).gt.90.-diff.and.dir(i).le.90.+diff)then
+!--- steering flow from the east
+          if(id(ib,j).eq.1)then
+            iresult=1
+            if(imass.eq.1)then
+               massfld=max(massflx(ib,j),massflx(i,j))
+            endif
+            return
+          endif
+        else if(dir(i).gt.135.-diff.and.dir(i).le.135.+diff)then
+!--- steering flow from the south-east
+          if(id(ib,ja).eq.1)then
+            iresult=1
+            if(imass.eq.1)then
+               massfld=max(massflx(ib,ja),massflx(i,j))
+            endif
+            return
+          endif
+!--- steering flow from the south
+        else if(dir(i).gt.180.-diff.and.dir(i).le.180.+diff)then
+          if(id(i,ja).eq.1)then
+            iresult=1
+            if(imass.eq.1)then
+               massfld=max(massflx(i,ja),massflx(i,j))
+            endif
+            return
+          endif
+!--- steering flow from the south west
+        else if(dir(i).gt.225.-diff.and.dir(i).le.225.+diff)then
+          if(id(ia,ja).eq.1)then
+            iresult=1
+            if(imass.eq.1)then
+               massfld=max(massflx(ia,ja),massflx(i,j))
+            endif
+            return
+          endif
+!--- steering flow from the west
+        else if(dir(i).gt.270.-diff.and.dir(i).le.270.+diff)then
+          if(id(ia,j).eq.1)then
+            iresult=1
+            if(imass.eq.1)then
+               massfld=max(massflx(ia,j),massflx(i,j))
+            endif
+            return
+          endif
+!--- steering flow from the north-west
+        else if(dir(i).gt.305.-diff.and.dir(i).le.305.+diff)then
+          if(id(ia,jb).eq.1)then
+            iresult=1
+            if(imass.eq.1)then
+               massfld=max(massflx(ia,jb),massflx(i,j))
+            endif
+            return
+          endif
+!--- steering flow from the north
+        else if(dir(i).gt.360.-diff.and.dir(i).le.360.+diff)then
+          if(id(i,jb).eq.1)then
+            iresult=1
+            if(imass.eq.1)then
+               massfld=max(massflx(i,jb),massflx(i,j))
+            endif
+            return
+          endif
+!--- steering flow from the north-east
+        else if(dir(i).gt.45.-diff.and.dir(i).le.45.+diff)then
+          if(id(ib,jb).eq.1)then
+            iresult=1
+            if(imass.eq.1)then
+               massfld=max(massflx(ib,jb),massflx(i,j))
+            endif
+            return
+          endif
+        endif
+
+   END SUBROUTINE cup_direction2
+
+
+   SUBROUTINE cup_env(z,qes,he,hes,t,q,p,z1,                 &
+              psur,ierr,tcrit,itest,xl,cp,                   &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+  !
+  ! ierr error value, maybe modified in this routine
+  ! q           = environmental mixing ratio
+  ! qes         = environmental saturation mixing ratio
+  ! t           = environmental temp
+  ! tv          = environmental virtual temp
+  ! p           = environmental pressure
+  ! z           = environmental heights
+  ! he          = environmental moist static energy
+  ! hes         = environmental saturation moist static energy
+  ! psur        = surface pressure
+  ! z1          = terrain elevation
+  ! 
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        p,t
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        he,hes,qes
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (inout)                   ::                           &
+        z,q
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        psur,z1
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        xl,cp
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        itest
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+       i,k,iph
+      real, dimension (1:2) :: AE,BE,HT
+      real, dimension (its:ite,kts:kte) :: tv
+      real :: tcrit,e,tvbar
+
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+
+      HT(1)=XL/CP
+      HT(2)=2.834E6/CP
+      BE(1)=.622*HT(1)/.286
+      AE(1)=BE(1)/273.+ALOG(610.71)
+      BE(2)=.622*HT(2)/.286
+      AE(2)=BE(2)/273.+ALOG(610.71)
+!      print *, 'TCRIT = ', tcrit,its,ite
+      DO k=kts,ktf
+      do i=its,itf
+        if(ierr(i).eq.0)then
+!Csgb - IPH is for phase, dependent on TCRIT (water or ice)
+        IPH=1
+        IF(T(I,K).LE.TCRIT)IPH=2
+!       print *, 'AE(IPH),BE(IPH) = ',AE(IPH),BE(IPH),AE(IPH)-BE(IPH),T(i,k),i,k
+        E=EXP(AE(IPH)-BE(IPH)/T(I,K))
+!       print *, 'P, E = ', P(I,K), E
+        QES(I,K)=.622*E/(100.*P(I,K)-E)
+        IF(QES(I,K).LE.1.E-08)QES(I,K)=1.E-08
+        IF(Q(I,K).GT.QES(I,K))Q(I,K)=QES(I,K)
+        TV(I,K)=T(I,K)+.608*Q(I,K)*T(I,K)
+        endif
+      enddo
+      enddo
+!
+!--- z's are calculated with changed h's and q's and t's
+!--- if itest=2
+!
+      if(itest.ne.2)then
+         do i=its,itf
+           if(ierr(i).eq.0)then
+             Z(I,1)=max(0.,Z1(I))-(ALOG(P(I,1))- &
+                 ALOG(PSUR(I)))*287.*TV(I,1)/9.81
+           endif
+         enddo
+
+! --- calculate heights
+         DO K=kts+1,ktf
+         do i=its,itf
+           if(ierr(i).eq.0)then
+              TVBAR=.5*TV(I,K)+.5*TV(I,K-1)
+              Z(I,K)=Z(I,K-1)-(ALOG(P(I,K))- &
+               ALOG(P(I,K-1)))*287.*TVBAR/9.81
+           endif
+         enddo
+         enddo
+      else
+         do k=kts,ktf
+         do i=its,itf
+           if(ierr(i).eq.0)then
+             z(i,k)=(he(i,k)-1004.*t(i,k)-2.5e6*q(i,k))/9.81
+             z(i,k)=max(1.e-3,z(i,k))
+           endif
+         enddo
+         enddo
+      endif
+!
+!--- calculate moist static energy - HE
+!    saturated moist static energy - HES
+!
+       DO k=kts,ktf
+       do i=its,itf
+         if(ierr(i).eq.0)then
+         if(itest.eq.0)HE(I,K)=9.81*Z(I,K)+1004.*T(I,K)+2.5E06*Q(I,K)
+         HES(I,K)=9.81*Z(I,K)+1004.*T(I,K)+2.5E06*QES(I,K)
+         IF(HE(I,K).GE.HES(I,K))HE(I,K)=HES(I,K)
+!         if(i.eq.2)then
+!           print *,k,z(i,k),t(i,k),p(i,k),he(i,k),hes(i,k)
+!         endif
+         endif
+      enddo
+      enddo
+
+   END SUBROUTINE cup_env
+
+
+   SUBROUTINE cup_env_clev(t,qes,q,he,hes,z,p,qes_cup,q_cup,   &
+              he_cup,hes_cup,z_cup,p_cup,gamma_cup,t_cup,psur, &
+              ierr,z1,xl,rv,cp,                                &
+              ids,ide, jds,jde, kds,kde,                       &
+              ims,ime, jms,jme, kms,kme,                       &
+              its,ite, jts,jte, kts,kte                       )
+
+   IMPLICIT NONE
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+  !
+  ! ierr error value, maybe modified in this routine
+  ! q           = environmental mixing ratio
+  ! q_cup       = environmental mixing ratio on cloud levels
+  ! qes         = environmental saturation mixing ratio
+  ! qes_cup     = environmental saturation mixing ratio on cloud levels
+  ! t           = environmental temp
+  ! t_cup       = environmental temp on cloud levels
+  ! p           = environmental pressure
+  ! p_cup       = environmental pressure on cloud levels
+  ! z           = environmental heights
+  ! z_cup       = environmental heights on cloud levels
+  ! he          = environmental moist static energy
+  ! he_cup      = environmental moist static energy on cloud levels
+  ! hes         = environmental saturation moist static energy
+  ! hes_cup     = environmental saturation moist static energy on cloud levels
+  ! gamma_cup   = gamma on cloud levels
+  ! psur        = surface pressure
+  ! z1          = terrain elevation
+  ! 
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        qes,q,he,hes,z,p,t
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        qes_cup,q_cup,he_cup,hes_cup,z_cup,p_cup,gamma_cup,t_cup
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        psur,z1
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        xl,rv,cp
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+       i,k
+
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+
+      do k=kts+1,ktf
+      do i=its,itf
+        if(ierr(i).eq.0)then
+        qes_cup(i,k)=.5*(qes(i,k-1)+qes(i,k))
+        q_cup(i,k)=.5*(q(i,k-1)+q(i,k))
+        hes_cup(i,k)=.5*(hes(i,k-1)+hes(i,k))
+        he_cup(i,k)=.5*(he(i,k-1)+he(i,k))
+        if(he_cup(i,k).gt.hes_cup(i,k))he_cup(i,k)=hes_cup(i,k)
+        z_cup(i,k)=.5*(z(i,k-1)+z(i,k))
+        p_cup(i,k)=.5*(p(i,k-1)+p(i,k))
+        t_cup(i,k)=.5*(t(i,k-1)+t(i,k))
+        gamma_cup(i,k)=(xl/cp)*(xl/(rv*t_cup(i,k) &
+                       *t_cup(i,k)))*qes_cup(i,k)
+        endif
+      enddo
+      enddo
+      do i=its,itf
+        if(ierr(i).eq.0)then
+        qes_cup(i,1)=qes(i,1)
+        q_cup(i,1)=q(i,1)
+        hes_cup(i,1)=hes(i,1)
+        he_cup(i,1)=he(i,1)
+        z_cup(i,1)=.5*(z(i,1)+z1(i))
+        p_cup(i,1)=.5*(p(i,1)+psur(i))
+        t_cup(i,1)=t(i,1)
+        gamma_cup(i,1)=xl/cp*(xl/(rv*t_cup(i,1) &
+                       *t_cup(i,1)))*qes_cup(i,1)
+        endif
+      enddo
+
+   END SUBROUTINE cup_env_clev
+
+
+   SUBROUTINE cup_forcing_ens(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2,ierr3,&
+              xf_ens,j,name,maxens,iens,iedt,maxens2,maxens3,mconv,    &
+              p_cup,ktop,omeg,zd,k22,zu,pr_ens,edt,kbcon,massflx,      &
+              iact_old_gr,dir,ensdim,massfln,icoic,                    &
+              ids,ide, jds,jde, kds,kde,                               &
+              ims,ime, jms,jme, kms,kme,                               &
+              its,ite, jts,jte, kts,kte                               )
+
+   IMPLICIT NONE
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+     integer, intent (in   )              ::                           &
+        j,ensdim,maxens,iens,iedt,maxens2,maxens3
+  !
+  ! ierr error value, maybe modified in this routine
+  ! pr_ens = precipitation ensemble
+  ! xf_ens = mass flux ensembles
+  ! massfln = downdraft mass flux ensembles used in next timestep
+  ! omeg = omega from large scale model
+  ! mconv = moisture convergence from large scale model
+  ! zd      = downdraft normalized mass flux
+  ! zu      = updraft normalized mass flux
+  ! aa0     = cloud work function without forcing effects
+  ! aa1     = cloud work function with forcing effects
+  ! xaa0    = cloud work function with cloud effects (ensemble dependent)
+  ! edt     = epsilon
+  ! dir     = "storm motion"
+  ! mbdt    = arbitrary numerical parameter
+  ! dtime   = dt over which forcing is applied
+  ! iact_gr_old = flag to tell where convection was active
+  ! kbcon       = LFC of parcel from k22
+  ! k22         = updraft originating level
+  ! icoic       = flag if only want one closure (usually set to zero!)
+  ! name        = deep or shallow convection flag
+  !
+     real,    dimension (ims:ime,jms:jme,1:ensdim)                     &
+        ,intent (inout)                   ::                           &
+        pr_ens
+     real,    dimension (ims:ime,jms:jme,1:ensdim)                     &
+        ,intent (out  )                   ::                           &
+        xf_ens,massfln
+     real,    dimension (ims:ime,jms:jme)                              &
+        ,intent (in   )                   ::                           &
+        massflx
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        omeg,zd,zu,p_cup
+     real,    dimension (its:ite,1:maxens)                             &
+        ,intent (in   )                   ::                           &
+        xaa0
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        aa1,edt,dir,mconv,xland
+     real,    dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        aa0,closure_n
+     real,    dimension (1:maxens)                                     &
+        ,intent (in   )                   ::                           &
+        mbdt
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        dtime
+     integer, dimension (ims:ime,jms:jme)                              &
+        ,intent (in   )                   ::                           &
+        iact_old_gr
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        k22,kbcon,ktop
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr,ierr2,ierr3
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        icoic
+      character *(*), intent (in)         ::                           &
+       name
+!
+!  local variables in this routine
+!
+
+     real,    dimension (1:maxens3)       ::                           &
+       xff_ens3
+     real,    dimension (1:maxens)        ::                           &
+       xk
+     integer                              ::                           &
+       i,k,nall,n,ne,nens,nens3,iresult,iresultd,iresulte,mkxcrt,kclim
+     parameter (mkxcrt=15)
+     real                                 ::                           &
+       a1,massfld,xff0,xomg,aclim1,aclim2,aclim3,aclim4
+     real,    dimension(1:mkxcrt)         ::                           &
+       pcrit,acrit,acritt
+
+     integer :: itf,nall2
+
+     itf=MIN(ite,ide-1)
+
+      DATA PCRIT/850.,800.,750.,700.,650.,600.,550.,500.,450.,400.,    &
+                 350.,300.,250.,200.,150./
+      DATA ACRIT/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216,       &
+                 .3151,.3677,.41,.5255,.7663,1.1686,1.6851/
+!  GDAS DERIVED ACRIT
+      DATA ACRITT/.203,.515,.521,.566,.625,.665,.659,.688,             &
+                  .743,.813,.886,.947,1.138,1.377,1.896/
+!
+       nens=0
+
+!--- LARGE SCALE FORCING
+!
+       DO 100 i=its,itf
+!       if(i.eq.ipr.and.j.eq.jpr)print *,'ierr = ',ierr(i)
+          if(name.eq.'deeps'.and.ierr(i).gt.995)then
+!          print *,i,j,ierr(i),aa0(i)
+           aa0(i)=0.
+           ierr(i)=0
+          endif
+          IF(ierr(i).eq.0)then
+!           kclim=0
+           do k=mkxcrt,1,-1
+             if(p_cup(i,ktop(i)).lt.pcrit(k))then
+               kclim=k
+               go to 9
+             endif
+           enddo
+           if(p_cup(i,ktop(i)).gt.pcrit(1))kclim=1
+ 9         continue
+           kclim=max(kclim,1)
+           k=max(kclim-1,1)
+           aclim1=acrit(kclim)*1.e3
+           aclim2=acrit(k)*1.e3
+           aclim3=acritt(kclim)*1.e3
+           aclim4=acritt(k)*1.e3
+!           print *,'p_cup(ktop(i)),kclim,pcrit(kclim)'
+!           print *,p_cup(i,ktop(i)),kclim,pcrit(kclim)
+!           print *,'aclim1,aclim2,aclim3,aclim4'
+!           print *,aclim1,aclim2,aclim3,aclim4
+!           print *,dtime,name,ierr(i),aa1(i),aa0(i)
+!          print *,dtime,name,ierr(i),aa1(i),aa0(i)
+!
+!--- treatment different for this closure
+!
+             if(name.eq.'deeps')then
+!
+                xff0= (AA1(I)-AA0(I))/DTIME
+                xff_ens3(1)=(AA1(I)-AA0(I))/dtime
+                xff_ens3(2)=.9*xff_ens3(1)
+                xff_ens3(3)=1.1*xff_ens3(1)
+!   
+!--- more original Arakawa-Schubert (climatologic value of aa0)
+!
+!
+!--- omeg is in bar/s, mconv done with omeg in Pa/s
+!     more like Brown (1979), or Frank-Cohen (199?)
+!
+                xff_ens3(4)=-omeg(i,k22(i))/9.81
+                xff_ens3(5)=-omeg(i,kbcon(i))/9.81
+                xff_ens3(6)=-omeg(i,1)/9.81
+                do k=2,kbcon(i)-1
+                  xomg=-omeg(i,k)/9.81
+                  if(xomg.gt.xff_ens3(6))xff_ens3(6)=xomg
+                enddo
+!
+!--- more like Krishnamurti et al.
+!
+                xff_ens3(7)=mconv(i)
+                xff_ens3(8)=mconv(i)
+                xff_ens3(9)=mconv(i)
+!
+!--- more like Fritsch Chappel or Kain Fritsch (plus triggers)
+!
+                xff_ens3(10)=AA1(I)/(60.*20.)
+                xff_ens3(11)=AA1(I)/(60.*30.)
+                xff_ens3(12)=AA1(I)/(60.*40.)
+!  
+!--- more original Arakawa-Schubert (climatologic value of aa0)
+!
+                xff_ens3(13)=max(0.,(AA1(I)-aclim1)/dtime)
+                xff_ens3(14)=max(0.,(AA1(I)-aclim2)/dtime)
+                xff_ens3(15)=max(0.,(AA1(I)-aclim3)/dtime)
+                xff_ens3(16)=max(0.,(AA1(I)-aclim4)/dtime)
+!               if(ierr2(i).gt.0.or.ierr3(i).gt.0)then
+!                 xff_ens3(10)=0.
+!                 xff_ens3(11)=0.
+!                 xff_ens3(12)=0.
+!                 xff_ens3(13)=0.
+!                 xff_ens3(14)=0.
+!                 xff_ens3(15)=0.
+!                 xff_ens3(16)=0.
+!               endif
+
+                do nens=1,maxens
+                   XK(nens)=(XAA0(I,nens)-AA1(I))/MBDT(2)
+                   if(xk(nens).le.0.and.xk(nens).gt.-1.e-6) &
+                           xk(nens)=-1.e-6
+                   if(xk(nens).gt.0.and.xk(nens).lt.1.e-6) &
+                           xk(nens)=1.e-6
+                enddo
+!
+!--- add up all ensembles
+!
+                do 350 ne=1,maxens
+!
+!--- for every xk, we have maxens3 xffs
+!--- iens is from outermost ensemble (most expensive!
+!
+!--- iedt (maxens2 belongs to it)
+!--- is from second, next outermost, not so expensive
+!
+!--- so, for every outermost loop, we have maxens*maxens2*3
+!--- ensembles!!! nall would be 0, if everything is on first
+!--- loop index, then ne would start counting, then iedt, then iens....
+!
+                   iresult=0
+                   iresultd=0
+                   iresulte=0
+                   nall=(iens-1)*maxens3*maxens*maxens2 &
+                        +(iedt-1)*maxens*maxens3 &
+                        +(ne-1)*maxens3
+!
+! over water, enfor!e small cap for some of the closures
+!
+                if(xland(i).lt.0.1)then
+                 if(ierr2(i).gt.0.or.ierr3(i).gt.0)then
+!       - ierr2 - 75 mb cap thickness, ierr3 - 125 cap thickness
+
+! - for larger cap, set Grell closure to zero
+                      xff_ens3(1) =0.
+                      massfln(i,j,nall+1)=0.
+                      xff_ens3(2) =0.
+                      massfln(i,j,nall+2)=0.
+                      xff_ens3(3) =0.
+                      massfln(i,j,nall+3)=0.
+                      closure_n(i)=closure_n(i)-1.
+
+                      xff_ens3(7) =0.
+                      massfln(i,j,nall+7)=0.
+                      xff_ens3(8) =0.
+                      massfln(i,j,nall+8)=0.
+                      xff_ens3(9) =0.
+!                     massfln(i,j,nall+9)=0.
+                      closure_n(i)=closure_n(i)-1.
+                endif
+!
+!   also take out some closures in general
+!
+                      xff_ens3(4) =0.
+                      massfln(i,j,nall+4)=0.
+                      xff_ens3(5) =0.
+                      massfln(i,j,nall+5)=0.
+                      xff_ens3(6) =0.
+                      massfln(i,j,nall+6)=0.
+                      closure_n(i)=closure_n(i)-3.
+
+                      xff_ens3(10)=0.
+                      massfln(i,j,nall+10)=0.
+                      xff_ens3(11)=0.
+                      massfln(i,j,nall+11)=0.
+                      xff_ens3(12)=0.
+                      massfln(i,j,nall+12)=0.
+                      if(ne.eq.1)closure_n(i)=closure_n(i)-3
+                      xff_ens3(13)=0.
+                      massfln(i,j,nall+13)=0.
+                      xff_ens3(14)=0.
+                      massfln(i,j,nall+14)=0.
+                      xff_ens3(15)=0.
+                      massfln(i,j,nall+15)=0.
+                      massfln(i,j,nall+16)=0.
+                      if(ne.eq.1)closure_n(i)=closure_n(i)-4
+
+                endif
+!
+! end water treatment
+!
+!--- check for upwind convection
+!                  iresult=0
+                   massfld=0.
+
+!                  call cup_direction2(i,j,dir,iact_old_gr, &
+!                       massflx,iresult,1,                  &
+!                       massfld,                            &
+!                       ids,ide, jds,jde, kds,kde,          &
+!                       ims,ime, jms,jme, kms,kme,          &
+!                       its,ite, jts,jte, kts,kte          )
+!                  if(i.eq.ipr.and.j.eq.jpr.and.iedt.eq.1.and.ne.eq.1)then
+!                  if(iedt.eq.1.and.ne.eq.1)then
+!                   print *,massfld,ne,iedt,iens
+!                   print *,xk(ne),xff_ens3(1),xff_ens3(2),xff_ens3(3)
+!                  endif
+!                  print *,i,j,massfld,aa0(i),aa1(i)
+                   IF(XK(ne).lt.0.and.xff0.gt.0.)iresultd=1
+                   iresulte=max(iresult,iresultd)
+                   iresulte=1
+                   if(iresulte.eq.1)then
+!
+!--- special treatment for stability closures
+!
+
+                      if(xff0.gt.0.)then
+                         xf_ens(i,j,nall+1)=max(0.,-xff_ens3(1)/xk(ne)) &
+                                        +massfld
+                         xf_ens(i,j,nall+2)=max(0.,-xff_ens3(2)/xk(ne)) &
+                                        +massfld
+                         xf_ens(i,j,nall+3)=max(0.,-xff_ens3(3)/xk(ne)) &
+                                        +massfld
+                         xf_ens(i,j,nall+13)=max(0.,-xff_ens3(13)/xk(ne)) &
+                                        +massfld
+                         xf_ens(i,j,nall+14)=max(0.,-xff_ens3(14)/xk(ne)) &
+                                        +massfld
+                         xf_ens(i,j,nall+15)=max(0.,-xff_ens3(15)/xk(ne)) &
+                                        +massfld
+                         xf_ens(i,j,nall+16)=max(0.,-xff_ens3(16)/xk(ne)) &
+                                        +massfld
+                      else
+                         xf_ens(i,j,nall+1)=massfld
+                         xf_ens(i,j,nall+2)=massfld
+                         xf_ens(i,j,nall+3)=massfld
+                         xf_ens(i,j,nall+13)=massfld
+                         xf_ens(i,j,nall+14)=massfld
+                         xf_ens(i,j,nall+15)=massfld
+                         xf_ens(i,j,nall+16)=massfld
+                      endif
+!
+!--- if iresult.eq.1, following independent of xff0
+!
+                         xf_ens(i,j,nall+4)=max(0.,xff_ens3(4) &
+                            +massfld)
+                         xf_ens(i,j,nall+5)=max(0.,xff_ens3(5) &
+                                        +massfld)
+                         xf_ens(i,j,nall+6)=max(0.,xff_ens3(6) &
+                                        +massfld)
+                         a1=max(1.e-3,pr_ens(i,j,nall+7))
+                         xf_ens(i,j,nall+7)=max(0.,xff_ens3(7) &
+                                     /a1)
+                         a1=max(1.e-3,pr_ens(i,j,nall+8))
+                         xf_ens(i,j,nall+8)=max(0.,xff_ens3(8) &
+                                     /a1)
+                         a1=max(1.e-3,pr_ens(i,j,nall+9))
+                         xf_ens(i,j,nall+9)=max(0.,xff_ens3(9) &
+                                     /a1)
+                         if(XK(ne).lt.0.)then
+                            xf_ens(i,j,nall+10)=max(0., &
+                                        -xff_ens3(10)/xk(ne)) &
+                                        +massfld
+                            xf_ens(i,j,nall+11)=max(0., &
+                                        -xff_ens3(11)/xk(ne)) &
+                                        +massfld
+                            xf_ens(i,j,nall+12)=max(0., &
+                                        -xff_ens3(12)/xk(ne)) &
+                                        +massfld
+                         else
+                            xf_ens(i,j,nall+10)=massfld
+                            xf_ens(i,j,nall+11)=massfld
+                            xf_ens(i,j,nall+12)=massfld
+                         endif
+                      if(icoic.ge.1)then
+                      closure_n(i)=0.
+                      xf_ens(i,j,nall+1)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+2)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+3)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+4)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+5)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+6)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+7)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+8)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+9)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+10)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+11)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+12)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+13)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+14)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+15)=xf_ens(i,j,nall+icoic)
+                      xf_ens(i,j,nall+16)=xf_ens(i,j,nall+icoic)
+                      endif
+!
+! replace 13-16 for now with other stab closures
+! (13 gave problems for mass model)
+!
+!                     xf_ens(i,j,nall+13)=xf_ens(i,j,nall+1)
+                      if(icoic.eq.0)xf_ens(i,j,nall+14)=xf_ens(i,j,nall+13)
+!                     xf_ens(i,j,nall+15)=xf_ens(i,j,nall+11)
+!                     xf_ens(i,j,nall+16)=xf_ens(i,j,nall+11)
+!                     xf_ens(i,j,nall+7)=xf_ens(i,j,nall+4)
+!                     xf_ens(i,j,nall+8)=xf_ens(i,j,nall+5)
+!                     xf_ens(i,j,nall+9)=xf_ens(i,j,nall+6)
+!
+!--- store new for next time step
+!
+                      do nens3=1,maxens3
+                        massfln(i,j,nall+nens3)=edt(i) &
+                                                *xf_ens(i,j,nall+nens3)
+                        massfln(i,j,nall+nens3)=max(0., &
+                                              massfln(i,j,nall+nens3))
+                      enddo
+!
+!
+!--- do some more on the caps!!! ne=1 for 175, ne=2 for 100,....
+!
+!     do not care for caps here for closure groups 1 and 5,
+!     they are fine, do not turn them off here
+!
+!
+                if(ne.eq.2.and.ierr2(i).gt.0)then
+                      xf_ens(i,j,nall+1) =0.
+                      xf_ens(i,j,nall+2) =0.
+                      xf_ens(i,j,nall+3) =0.
+                      xf_ens(i,j,nall+4) =0.
+                      xf_ens(i,j,nall+5) =0.
+                      xf_ens(i,j,nall+6) =0.
+                      xf_ens(i,j,nall+7) =0.
+                      xf_ens(i,j,nall+8) =0.
+                      xf_ens(i,j,nall+9) =0.
+                      xf_ens(i,j,nall+10)=0.
+                      xf_ens(i,j,nall+11)=0.
+                      xf_ens(i,j,nall+12)=0.
+                      xf_ens(i,j,nall+13)=0.
+                      xf_ens(i,j,nall+14)=0.
+                      xf_ens(i,j,nall+15)=0.
+                      xf_ens(i,j,nall+16)=0.
+                      massfln(i,j,nall+1)=0.
+                      massfln(i,j,nall+2)=0.
+                      massfln(i,j,nall+3)=0.
+                      massfln(i,j,nall+4)=0.
+                      massfln(i,j,nall+5)=0.
+                      massfln(i,j,nall+6)=0.
+                      massfln(i,j,nall+7)=0.
+                      massfln(i,j,nall+8)=0.
+                      massfln(i,j,nall+9)=0.
+                      massfln(i,j,nall+10)=0.
+                      massfln(i,j,nall+11)=0.
+                      massfln(i,j,nall+12)=0.
+                      massfln(i,j,nall+13)=0.
+                      massfln(i,j,nall+14)=0.
+                      massfln(i,j,nall+15)=0.
+                      massfln(i,j,nall+16)=0.
+                endif
+                if(ne.eq.3.and.ierr3(i).gt.0)then
+                      xf_ens(i,j,nall+1) =0.
+                      xf_ens(i,j,nall+2) =0.
+                      xf_ens(i,j,nall+3) =0.
+                      xf_ens(i,j,nall+4) =0.
+                      xf_ens(i,j,nall+5) =0.
+                      xf_ens(i,j,nall+6) =0.
+                      xf_ens(i,j,nall+7) =0.
+                      xf_ens(i,j,nall+8) =0.
+                      xf_ens(i,j,nall+9) =0.
+                      xf_ens(i,j,nall+10)=0.
+                      xf_ens(i,j,nall+11)=0.
+                      xf_ens(i,j,nall+12)=0.
+                      xf_ens(i,j,nall+13)=0.
+                      xf_ens(i,j,nall+14)=0.
+                      xf_ens(i,j,nall+15)=0.
+                      xf_ens(i,j,nall+16)=0.
+                      massfln(i,j,nall+1)=0.
+                      massfln(i,j,nall+2)=0.
+                      massfln(i,j,nall+3)=0.
+                      massfln(i,j,nall+4)=0.
+                      massfln(i,j,nall+5)=0.
+                      massfln(i,j,nall+6)=0.
+                      massfln(i,j,nall+7)=0.
+                      massfln(i,j,nall+8)=0.
+                      massfln(i,j,nall+9)=0.
+                      massfln(i,j,nall+10)=0.
+                      massfln(i,j,nall+11)=0.
+                      massfln(i,j,nall+12)=0.
+                      massfln(i,j,nall+13)=0.
+                      massfln(i,j,nall+14)=0.
+                      massfln(i,j,nall+15)=0.
+                      massfln(i,j,nall+16)=0.
+                endif
+
+                   endif
+ 350            continue
+! ne=1, cap=175
+!
+                   nall=(iens-1)*maxens3*maxens*maxens2 &
+                        +(iedt-1)*maxens*maxens3
+! ne=2, cap=100
+!
+                   nall2=(iens-1)*maxens3*maxens*maxens2 &
+                        +(iedt-1)*maxens*maxens3 &
+                        +(2-1)*maxens3
+                      xf_ens(i,j,nall+4) = xf_ens(i,j,nall2+4)
+                      xf_ens(i,j,nall+5) =xf_ens(i,j,nall2+5)
+                      xf_ens(i,j,nall+6) =xf_ens(i,j,nall2+6)
+                      xf_ens(i,j,nall+7) =xf_ens(i,j,nall2+7)
+                      xf_ens(i,j,nall+8) =xf_ens(i,j,nall2+8)
+                      xf_ens(i,j,nall+9) =xf_ens(i,j,nall2+9)
+                      xf_ens(i,j,nall+10)=xf_ens(i,j,nall2+10)
+                      xf_ens(i,j,nall+11)=xf_ens(i,j,nall2+11)
+                      xf_ens(i,j,nall+12)=xf_ens(i,j,nall2+12)
+                go to 100
+             endif
+          elseif(ierr(i).ne.20.and.ierr(i).ne.0)then
+             do n=1,ensdim
+               xf_ens(i,j,n)=0.
+               massfln(i,j,n)=0.
+             enddo
+          endif
+ 100   continue
+
+   END SUBROUTINE cup_forcing_ens
+
+
+   SUBROUTINE cup_kbcon(cap_inc,iloop,k22,kbcon,he_cup,hes_cup, &
+              ierr,kbmax,p_cup,cap_max,                         &
+              ids,ide, jds,jde, kds,kde,                        &
+              ims,ime, jms,jme, kms,kme,                        &
+              its,ite, jts,jte, kts,kte                        )
+
+   IMPLICIT NONE
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+  ! 
+  ! 
+  ! 
+  ! ierr error value, maybe modified in this routine
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        he_cup,hes_cup,p_cup
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        cap_max,cap_inc
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        kbmax
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        kbcon,k22,ierr
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        iloop
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        i
+     real                                 ::                           &
+        pbcdif,plus
+     integer :: itf
+
+     itf=MIN(ite,ide-1)
+!
+!--- DETERMINE THE LEVEL OF CONVECTIVE CLOUD BASE  - KBCON
+!
+       DO 27 i=its,itf
+      kbcon(i)=1
+      IF(ierr(I).ne.0)GO TO 27
+      KBCON(I)=K22(I)
+      GO TO 32
+ 31   CONTINUE
+      KBCON(I)=KBCON(I)+1
+      IF(KBCON(I).GT.KBMAX(i)+2)THEN
+         if(iloop.lt.4)ierr(i)=3
+!        if(iloop.lt.4)ierr(i)=997
+        GO TO 27
+      ENDIF
+ 32   CONTINUE
+      IF(HE_cup(I,K22(I)).LT.HES_cup(I,KBCON(I)))GO TO 31
+
+!     cloud base pressure and max moist static energy pressure
+!     i.e., the depth (in mb) of the layer of negative buoyancy
+      if(KBCON(I)-K22(I).eq.1)go to 27
+      PBCDIF=-P_cup(I,KBCON(I))+P_cup(I,K22(I))
+      plus=max(25.,cap_max(i)-float(iloop-1)*cap_inc(i))
+      if(iloop.eq.4)plus=cap_max(i)
+      IF(PBCDIF.GT.plus)THEN
+        K22(I)=K22(I)+1
+        KBCON(I)=K22(I)
+        GO TO 32
+      ENDIF
+ 27   CONTINUE
+
+   END SUBROUTINE cup_kbcon
+
+
+   SUBROUTINE cup_kbcon_cin(iloop,k22,kbcon,he_cup,hes_cup,  &
+              z,tmean,qes,ierr,kbmax,p_cup,cap_max,xl,cp,    &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+  ! 
+  ! 
+  ! 
+  ! ierr error value, maybe modified in this routine
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        he_cup,hes_cup,p_cup,z,tmean,qes
+     real,    dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        cap_max
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        xl,cp
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        kbmax
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        kbcon,k22,ierr
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        iloop
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        i,k
+     real                                 ::                           &
+        cin,cin_max,dh,tprim,gamma
+!
+     integer :: itf
+
+     itf=MIN(ite,ide-1)
+!
+!
+    
+!
+!--- DETERMINE THE LEVEL OF CONVECTIVE CLOUD BASE  - KBCON
+!
+       DO 27 i=its,itf
+      cin_max=-cap_max(i)
+      kbcon(i)=1
+      cin = 0.
+      IF(ierr(I).ne.0)GO TO 27
+      KBCON(I)=K22(I)
+      GO TO 32
+ 31   CONTINUE
+      KBCON(I)=KBCON(I)+1
+      IF(KBCON(I).GT.KBMAX(i)+2)THEN
+         if(iloop.eq.1)ierr(i)=3
+!        if(iloop.eq.2)ierr(i)=997
+        GO TO 27
+      ENDIF
+ 32   CONTINUE
+      dh      = HE_cup(I,K22(I)) - HES_cup(I,KBCON(I))
+      if (dh.lt. 0.) then
+        GAMMA=(xl/cp)*(xl/(461.525*(Tmean(I,K22(i))**2)))*QES(I,K22(i))
+        tprim = dh/(cp*(1.+gamma))
+
+        cin = cin + 9.8066 * tprim &
+              *(z(i,k22(i))-z(i,k22(i)-1)) / tmean(i,k22(i))
+        go to 31
+      end if
+
+
+!     If negative energy in negatively buoyant layer
+!       exceeds convective inhibition (CIN) threshold,
+!       then set K22 level one level up and see if that
+!       will work.
+
+      IF(cin.lT.cin_max)THEN
+!       print *,i,cin,cin_max,k22(i),kbcon(i)
+        K22(I)=K22(I)+1
+        KBCON(I)=K22(I)
+        GO TO 32
+      ENDIF
+ 27   CONTINUE
+
+   END SUBROUTINE cup_kbcon_cin
+
+
+   SUBROUTINE cup_ktop(ilo,dby,kbcon,ktop,ierr,              &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+  ! dby = buoancy term
+  ! ktop = cloud top (output)
+  ! ilo  = flag
+  ! ierr error value, maybe modified in this routine
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (inout)                   ::                           &
+        dby
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        kbcon
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ilo
+     integer, dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+        ktop
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        i,k
+!
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+!
+!
+        DO 42 i=its,itf
+        ktop(i)=1
+         IF(ierr(I).EQ.0)then
+          DO 40 K=KBCON(I)+1,ktf-1
+            IF(DBY(I,K).LE.0.)THEN
+                KTOP(I)=K-1
+                GO TO 41
+             ENDIF
+  40      CONTINUE
+          if(ilo.eq.1)ierr(i)=5
+!         if(ilo.eq.2)ierr(i)=998
+          GO TO 42
+  41     CONTINUE
+         do k=ktop(i)+1,ktf
+           dby(i,k)=0.
+         enddo
+         endif
+  42     CONTINUE
+
+   END SUBROUTINE cup_ktop
+
+
+   SUBROUTINE cup_MAXIMI(ARRAY,KS,KE,MAXX,ierr,              &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+         ids,ide, jds,jde, kds,kde,                                    &
+         ims,ime, jms,jme, kms,kme,                                    &
+         its,ite, jts,jte, kts,kte
+  ! array input array
+  ! x output array with return values
+  ! kt output array of levels
+  ! ks,kend  check-range
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+         array
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+         ierr,ke
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+         ks
+     integer, dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+         maxx
+     real,    dimension (its:ite)         ::                           &
+         x
+     real                                 ::                           &
+         xar
+     integer                              ::                           &
+         i,k
+     integer :: itf
+
+     itf=MIN(ite,ide-1)
+
+       DO 200 i=its,itf
+       MAXX(I)=KS
+       if(ierr(i).eq.0)then
+      X(I)=ARRAY(I,KS)
+!
+       DO 100 K=KS,KE(i)
+         XAR=ARRAY(I,K)
+         IF(XAR.GE.X(I)) THEN
+            X(I)=XAR
+            MAXX(I)=K
+         ENDIF
+ 100  CONTINUE
+      endif
+ 200  CONTINUE
+
+   END SUBROUTINE cup_MAXIMI
+
+
+   SUBROUTINE cup_minimi(ARRAY,KS,KEND,KT,ierr,              &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+         ids,ide, jds,jde, kds,kde,                                    &
+         ims,ime, jms,jme, kms,kme,                                    &
+         its,ite, jts,jte, kts,kte
+  ! array input array
+  ! x output array with return values
+  ! kt output array of levels
+  ! ks,kend  check-range
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+         array
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+         ierr,ks,kend
+     integer, dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+         kt
+     real,    dimension (its:ite)         ::                           &
+         x
+     integer                              ::                           &
+         i,k,kstop
+
+     integer :: itf
+
+     itf=MIN(ite,ide-1)
+
+       DO 200 i=its,itf
+      KT(I)=KS(I)
+      if(ierr(i).eq.0)then
+      X(I)=ARRAY(I,KS(I))
+       KSTOP=MAX(KS(I)+1,KEND(I))
+!
+       DO 100 K=KS(I)+1,KSTOP
+         IF(ARRAY(I,K).LT.X(I)) THEN
+              X(I)=ARRAY(I,K)
+              KT(I)=K
+         ENDIF
+ 100  CONTINUE
+      endif
+ 200  CONTINUE
+
+   END SUBROUTINE cup_MINIMI
+
+
+   SUBROUTINE cup_output_ens(xf_ens,ierr,dellat,dellaq,dellaqc,  &
+              outtem,outq,outqc,pre,pw,xmb,ktop,                 &
+              j,name,nx,nx2,iens,ierr2,ierr3,pr_ens,             &
+              maxens3,ensdim,massfln,                            &
+              APR_GR,APR_W,APR_MC,APR_ST,APR_AS,                 &
+              APR_CAPMA,APR_CAPME,APR_CAPMI,closure_n,xland1,    &
+              ids,ide, jds,jde, kds,kde, &
+              ims,ime, jms,jme, kms,kme, &
+              its,ite, jts,jte, kts,kte)
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,           &
+        ims,ime, jms,jme, kms,kme,           &
+        its,ite, jts,jte, kts,kte
+     integer, intent (in   )              ::                           &
+        j,ensdim,nx,nx2,iens,maxens3
+  ! xf_ens = ensemble mass fluxes
+  ! pr_ens = precipitation ensembles
+  ! dellat = change of temperature per unit mass flux of cloud ensemble
+  ! dellaq = change of q per unit mass flux of cloud ensemble
+  ! dellaqc = change of qc per unit mass flux of cloud ensemble
+  ! outtem = output temp tendency (per s)
+  ! outq   = output q tendency (per s)
+  ! outqc  = output qc tendency (per s)
+  ! pre    = output precip
+  ! xmb    = total base mass flux
+  ! xfac1  = correction factor
+  ! pw = pw -epsilon*pd (ensemble dependent)
+  ! ierr error value, maybe modified in this routine
+  !
+     real,    dimension (ims:ime,jms:jme,1:ensdim)                     &
+        ,intent (inout)                   ::                           &
+       xf_ens,pr_ens,massfln
+     real,    dimension (ims:ime,jms:jme)                              &
+        ,intent (inout)                   ::                           &
+               APR_GR,APR_W,APR_MC,APR_ST,APR_AS,APR_CAPMA,            &
+               APR_CAPME,APR_CAPMI 
+
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        outtem,outq,outqc
+     real,    dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+        pre,xmb
+     real,    dimension (its:ite)                                      &
+        ,intent (inout  )                   ::                           &
+        closure_n,xland1
+     real,    dimension (its:ite,kts:kte,1:ensdim)                     &
+        ,intent (in   )                   ::                           &
+       dellat,dellaqc,dellaq,pw
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        ktop
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr,ierr2,ierr3
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        i,k,n,ncount
+     real                                 ::                           &
+        outtes,ddtes,dtt,dtq,dtqc,dtpw,tuning,prerate,clos_wei
+     real,    dimension (its:ite)         ::                           &
+       xfac1
+     real,    dimension (its:ite)::                           &
+       xmb_ske,xmb_ave,xmb_std,xmb_cur,xmbweight
+     real,    dimension (its:ite)::                           &
+       pr_ske,pr_ave,pr_std,pr_cur
+     real,    dimension (its:ite,jts:jte)::                           &
+               pr_gr,pr_w,pr_mc,pr_st,pr_as,pr_capma,     &
+               pr_capme,pr_capmi
+
+!
+      character *(*), intent (in)        ::                           &
+       name
+!
+     integer :: itf, ktf
+
+     itf=MIN(ite,ide-1)
+     ktf=MIN(kte,kde-1)
+     tuning=0.
+!
+!
+      DO k=kts,ktf
+      do i=its,itf
+        outtem(i,k)=0.
+        outq(i,k)=0.
+        outqc(i,k)=0.
+      enddo
+      enddo
+      do i=its,itf
+        pre(i)=0.
+        xmb(i)=0.
+         xfac1(i)=1.
+        xmbweight(i)=1.
+      enddo
+      do i=its,itf
+        IF(ierr(i).eq.0)then
+        do n=(iens-1)*nx*nx2*maxens3+1,iens*nx*nx2*maxens3
+           if(pr_ens(i,j,n).le.0.)then
+             xf_ens(i,j,n)=0.
+           endif
+        enddo
+        endif
+      enddo
+!
+!--- calculate ensemble average mass fluxes
+!
+       call massflx_stats(xf_ens,ensdim,nx2,nx,maxens3,      &
+            xmb_ave,xmb_std,xmb_cur,xmb_ske,j,ierr,1,    &
+            APR_GR,APR_W,APR_MC,APR_ST,APR_AS,           &
+            APR_CAPMA,APR_CAPME,APR_CAPMI,               &
+            pr_gr,pr_w,pr_mc,pr_st,pr_as,                &
+            pr_capma,pr_capme,pr_capmi,                  &
+            ids,ide, jds,jde, kds,kde,                   &
+            ims,ime, jms,jme, kms,kme,                   &
+            its,ite, jts,jte, kts,kte                   )
+       call massflx_stats(pr_ens,ensdim,nx2,nx,maxens3,  &
+            pr_ave,pr_std,pr_cur,pr_ske,j,ierr,2,        &
+            APR_GR,APR_W,APR_MC,APR_ST,APR_AS,           &
+            APR_CAPMA,APR_CAPME,APR_CAPMI,               &
+            pr_gr,pr_w,pr_mc,pr_st,pr_as,                &
+            pr_capma,pr_capme,pr_capmi,                  &
+            ids,ide, jds,jde, kds,kde,                   &
+            ims,ime, jms,jme, kms,kme,                   &
+            its,ite, jts,jte, kts,kte                   )
+!
+!-- now do feedback
+!
+      ddtes=200.
+!     if(name.eq.'shal')ddtes=200.
+      do i=its,itf
+        if(ierr(i).eq.0)then
+         if(xmb_ave(i).le.0.)then
+              ierr(i)=13
+              xmb_ave(i)=0.
+         endif
+!        xmb(i)=max(0.,xmb_ave(i))
+         xmb(i)=max(.1*xmb_ave(i),xmb_ave(i)-tuning*xmb_std(i))
+! --- Now use proper count of how many closures were actually
+!       used in cup_forcing_ens (including screening of some
+!       closures over water) to properly normalize xmb
+           clos_wei=16./max(1.,closure_n(i))
+           if (xland1(i).lt.0.5)xmb(i)=xmb(i)*clos_wei
+           if(xmb(i).eq.0.)then
+              ierr(i)=19
+           endif
+           if(xmb(i).gt.100.)then
+              ierr(i)=19
+           endif
+           xfac1(i)=xmb(i)
+
+        endif
+        xfac1(i)=xmb_ave(i)
+      ENDDO
+      DO k=kts,ktf
+      do i=its,itf
+            dtt=0.
+            dtq=0.
+            dtqc=0.
+            dtpw=0.
+        IF(ierr(i).eq.0.and.k.le.ktop(i))then
+           do n=1,nx
+              dtt=dtt+dellat(i,k,n)
+              dtq=dtq+dellaq(i,k,n)
+              dtqc=dtqc+dellaqc(i,k,n)
+              dtpw=dtpw+pw(i,k,n)
+           enddo
+           outtes=dtt*XMB(I)*86400./float(nx)
+           IF((OUTTES.GT.2.*ddtes.and.k.gt.2))THEN
+             XMB(I)= 2.*ddtes/outtes * xmb(i)
+             outtes=1.*ddtes
+           endif
+           if (outtes .lt. -ddtes) then
+             XMB(I)= -ddtes/outtes * xmb(i)
+             outtes=-ddtes
+           endif
+           if (outtes .gt. .5*ddtes.and.k.le.2) then
+             XMB(I)= ddtes/outtes * xmb(i)
+             outtes=.5*ddtes
+           endif
+           OUTTEM(I,K)=XMB(I)*dtt/float(nx)
+           OUTQ(I,K)=XMB(I)*dtq/float(nx)
+           OUTQC(I,K)=XMB(I)*dtqc/float(nx)
+           PRE(I)=PRE(I)+XMB(I)*dtpw/float(nx)
+        endif
+      enddo
+      enddo
+      do i=its,itf
+        if(ierr(i).eq.0)then
+           prerate=pre(i)*3600.
+           if(prerate.lt.0.1)then
+              if(ierr2(i).gt.0.or.ierr3(i).gt.0)then
+                 pre(i)=0.
+                 ierr(i)=221
+                 do k=kts,ktf
+                    outtem(i,k)=0.
+                    outq(i,k)=0.
+                    outqc(i,k)=0.
+                 enddo
+                 do k=(iens-1)*nx*nx2*maxens3+1,iens*nx*nx2*maxens3
+                   massfln(i,j,k)=0.
+                   xf_ens(i,j,k)=0.
+                 enddo
+               endif
+            endif
+
+        endif
+      ENDDO
+
+      do i=its,itf
+        if(ierr(i).eq.0)then
+        xfac1(i)=xmb(i)/xfac1(i)
+        do k=(iens-1)*nx*nx2*maxens3+1,iens*nx*nx2*maxens3
+          massfln(i,j,k)=massfln(i,j,k)*xfac1(i)
+          xf_ens(i,j,k)=xf_ens(i,j,k)*xfac1(i)
+        enddo
+        endif
+      ENDDO
+
+   END SUBROUTINE cup_output_ens
+
+
+   SUBROUTINE cup_up_aa0(aa0,z,zu,dby,GAMMA_CUP,t_cup,       &
+              kbcon,ktop,ierr,                               &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+        ids,ide, jds,jde, kds,kde,                                     &
+        ims,ime, jms,jme, kms,kme,                                     &
+        its,ite, jts,jte, kts,kte
+  ! aa0 cloud work function
+  ! gamma_cup = gamma on model cloud levels
+  ! t_cup = temperature (Kelvin) on model cloud levels
+  ! dby = buoancy term
+  ! zu= normalized updraft mass flux
+  ! z = heights of model levels 
+  ! ierr error value, maybe modified in this routine
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        z,zu,gamma_cup,t_cup,dby
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        kbcon,ktop
+!
+! input and output
+!
+
+
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+     real,    dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+        aa0
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        i,k
+     real                                 ::                           &
+        dz,da
+!
+     integer :: itf, ktf
+
+     itf = MIN(ite,ide-1)
+     ktf = MIN(kte,kde-1)
+
+        do i=its,itf
+         aa0(i)=0.
+        enddo
+        DO 100 k=kts+1,ktf
+        DO 100 i=its,itf
+         IF(ierr(i).ne.0)GO TO 100
+         IF(K.LE.KBCON(I))GO TO 100
+         IF(K.Gt.KTOP(I))GO TO 100
+         DZ=Z(I,K)-Z(I,K-1)
+         da=zu(i,k)*DZ*(9.81/(1004.*( &
+                (T_cup(I,K)))))*DBY(I,K-1)/ &
+             (1.+GAMMA_CUP(I,K))
+         IF(K.eq.KTOP(I).and.da.le.0.)go to 100
+         AA0(I)=AA0(I)+da
+         if(aa0(i).lt.0.)aa0(i)=0.
+100     continue
+
+   END SUBROUTINE cup_up_aa0
+
+
+   SUBROUTINE cup_up_he(k22,hkb,z_cup,cd,entr,he_cup,hc,     &
+              kbcon,ierr,dby,he,hes_cup,                     &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+                                  ids,ide, jds,jde, kds,kde,           &
+                                  ims,ime, jms,jme, kms,kme,           &
+                                  its,ite, jts,jte, kts,kte
+  ! hc = cloud moist static energy
+  ! hkb = moist static energy at originating level
+  ! he = moist static energy on model levels
+  ! he_cup = moist static energy on model cloud levels
+  ! hes_cup = saturation moist static energy on model cloud levels
+  ! dby = buoancy term
+  ! cd= detrainment function 
+  ! z_cup = heights of model cloud levels 
+  ! entr = entrainment rate
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        he,he_cup,hes_cup,z_cup,cd
+  ! entr= entrainment rate 
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        entr
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        kbcon,k22
+!
+! input and output
+!
+
+   ! ierr error value, maybe modified in this routine
+
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        hc,dby
+     real,    dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+        hkb
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        i,k
+     real                                 ::                           &
+        dz
+!
+     integer :: itf, ktf
+
+     itf = MIN(ite,ide-1)
+     ktf = MIN(kte,kde-1)
+!
+!--- moist static energy inside cloud
+!
+      do i=its,itf
+      if(ierr(i).eq.0.)then
+      hkb(i)=he_cup(i,k22(i))
+      do k=1,k22(i)
+        hc(i,k)=he_cup(i,k)
+        DBY(I,K)=0.
+      enddo
+      do k=k22(i),kbcon(i)-1
+        hc(i,k)=hkb(i)
+        DBY(I,K)=0.
+      enddo
+        k=kbcon(i)
+        hc(i,k)=hkb(i)
+        DBY(I,Kbcon(i))=Hkb(I)-HES_cup(I,K)
+      endif
+      enddo
+      do k=kts+1,ktf
+      do i=its,itf
+        if(k.gt.kbcon(i).and.ierr(i).eq.0.)then
+           DZ=Z_cup(i,K)-Z_cup(i,K-1)
+           HC(i,K)=(HC(i,K-1)*(1.-.5*CD(i,K)*DZ)+entr* &
+                DZ*HE(i,K-1))/(1.+entr*DZ-.5*cd(i,k)*dz)
+           DBY(I,K)=HC(I,K)-HES_cup(I,K)
+        endif
+      enddo
+
+      enddo
+
+   END SUBROUTINE cup_up_he
+
+
+   SUBROUTINE cup_up_moisture(ierr,z_cup,qc,qrc,pw,pwav,     &
+              kbcon,ktop,cd,dby,mentr_rate,clw_all,          &
+              q,GAMMA_cup,zu,qes_cup,k22,qe_cup,xl,          &
+              ids,ide, jds,jde, kds,kde,                     &
+              ims,ime, jms,jme, kms,kme,                     &
+              its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+                                  ids,ide, jds,jde, kds,kde,           &
+                                  ims,ime, jms,jme, kms,kme,           &
+                                  its,ite, jts,jte, kts,kte
+  ! cd= detrainment function 
+  ! q = environmental q on model levels
+  ! qe_cup = environmental q on model cloud levels
+  ! qes_cup = saturation q on model cloud levels
+  ! dby = buoancy term
+  ! cd= detrainment function 
+  ! zu = normalized updraft mass flux
+  ! gamma_cup = gamma on model cloud levels
+  ! mentr_rate = entrainment rate
+  !
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+        q,zu,gamma_cup,qe_cup,dby,qes_cup,z_cup,cd
+  ! entr= entrainment rate 
+     real                                                              &
+        ,intent (in   )                   ::                           &
+        mentr_rate,xl
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+        kbcon,ktop,k22
+!
+! input and output
+!
+
+   ! ierr error value, maybe modified in this routine
+
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+        ierr
+   ! qc = cloud q (including liquid water) after entrainment
+   ! qrch = saturation q in cloud
+   ! qrc = liquid water content in cloud after rainout
+   ! pw = condensate that will fall out at that level
+   ! pwav = totan normalized integrated condensate (I1)
+   ! c0 = conversion rate (cloud to rain)
+
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+        qc,qrc,pw,clw_all
+     real,    dimension (its:ite)                                      &
+        ,intent (out  )                   ::                           &
+        pwav
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+        iall,i,k
+     real                                 ::                           &
+        dh,qrch,c0,dz,radius
+!
+     integer :: itf, ktf
+
+     itf = MIN(ite,ide-1)
+     ktf = MIN(kte,kde-1)
+
+        iall=0
+        c0=.002
+!
+!--- no precip for small clouds
+!
+        if(mentr_rate.gt.0.)then
+          radius=.2/mentr_rate
+          if(radius.lt.900.)c0=0.
+!         if(radius.lt.900.)iall=0
+        endif
+        do i=its,itf
+          pwav(i)=0.
+        enddo
+        do k=kts,ktf
+        do i=its,itf
+          pw(i,k)=0.
+          qc(i,k)=qes_cup(i,k)
+          clw_all(i,k)=0.
+          qrc(i,k)=0.
+        enddo
+        enddo
+      do i=its,itf
+      if(ierr(i).eq.0.)then
+      do k=k22(i),kbcon(i)-1
+        qc(i,k)=qe_cup(i,k22(i))
+      enddo
+      endif
+      enddo
+
+        DO 100 k=kts+1,ktf
+        DO 100 i=its,itf
+         IF(ierr(i).ne.0)GO TO 100
+         IF(K.Lt.KBCON(I))GO TO 100
+         IF(K.Gt.KTOP(I))GO TO 100
+         DZ=Z_cup(i,K)-Z_cup(i,K-1)
+!
+!------    1. steady state plume equation, for what could
+!------       be in cloud without condensation
+!
+!
+        QC(i,K)=(QC(i,K-1)*(1.-.5*CD(i,K)*DZ)+mentr_rate* &
+                DZ*Q(i,K-1))/(1.+mentr_rate*DZ-.5*cd(i,k)*dz)
+!
+!--- saturation  in cloud, this is what is allowed to be in it
+!
+         QRCH=QES_cup(I,K)+(1./XL)*(GAMMA_cup(i,k) &
+              /(1.+GAMMA_cup(i,k)))*DBY(I,K)
+!
+!------- LIQUID WATER CONTENT IN cloud after rainout
+!
+        clw_all(i,k)=QC(I,K)-QRCH
+        QRC(I,K)=(QC(I,K)-QRCH)/(1.+C0*DZ)
+        if(qrc(i,k).lt.0.)then
+          qrc(i,k)=0.
+        endif
+!
+!-------   3.Condensation
+!
+         PW(i,k)=c0*dz*QRC(I,K)*zu(i,k)
+        if(iall.eq.1)then
+          qrc(i,k)=0.
+          pw(i,k)=(QC(I,K)-QRCH)*zu(i,k)
+          if(pw(i,k).lt.0.)pw(i,k)=0.
+        endif
+!
+!----- set next level
+!
+         QC(I,K)=QRC(I,K)+qrch
+!
+!--- integrated normalized ondensate
+!
+         PWAV(I)=PWAV(I)+PW(I,K)
+ 100     CONTINUE
+
+   END SUBROUTINE cup_up_moisture
+
+
+   SUBROUTINE cup_up_nms(zu,z_cup,entr,cd,kbcon,ktop,ierr,k22,  &
+              ids,ide, jds,jde, kds,kde,                        &
+              ims,ime, jms,jme, kms,kme,                        &
+              its,ite, jts,jte, kts,kte                        )
+
+   IMPLICIT NONE
+
+!
+!  on input
+!
+
+   ! only local wrf dimensions are need as of now in this routine
+
+     integer                                                           &
+        ,intent (in   )                   ::                           &
+         ids,ide, jds,jde, kds,kde,                                    &
+         ims,ime, jms,jme, kms,kme,                                    &
+         its,ite, jts,jte, kts,kte
+  ! cd= detrainment function 
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (in   )                   ::                           &
+         z_cup,cd
+  ! entr= entrainment rate 
+     real                                                              &
+        ,intent (in   )                   ::                           &
+         entr
+     integer, dimension (its:ite)                                      &
+        ,intent (in   )                   ::                           &
+         kbcon,ktop,k22
+!
+! input and output
+!
+
+   ! ierr error value, maybe modified in this routine
+
+     integer, dimension (its:ite)                                      &
+        ,intent (inout)                   ::                           &
+         ierr
+   ! zu is the normalized mass flux
+
+     real,    dimension (its:ite,kts:kte)                              &
+        ,intent (out  )                   ::                           &
+         zu
+!
+!  local variables in this routine
+!
+
+     integer                              ::                           &
+         i,k
+     real                                 ::                           &
+         dz
+     integer :: itf, ktf
+
+     itf = MIN(ite,ide-1)
+     ktf = MIN(kte,kde-1)
+!
+!   initialize for this go around
+!
+       do k=kts,ktf
+       do i=its,itf
+         zu(i,k)=0.
+       enddo
+       enddo
+!
+! do normalized mass budget
+!
+       do i=its,itf
+          IF(ierr(I).eq.0)then
+             do k=k22(i),kbcon(i)
+               zu(i,k)=1.
+             enddo
+             DO K=KBcon(i)+1,KTOP(i)
+               DZ=Z_cup(i,K)-Z_cup(i,K-1)
+               ZU(i,K)=ZU(i,K-1)*(1.+(entr-cd(i,k))*DZ)
+             enddo
+          endif
+       enddo
+
+   END SUBROUTINE cup_up_nms
+
+!====================================================================
+   SUBROUTINE gdinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,           &
+                        MASS_FLUX,cp,restart,                       &
+                        P_QC,P_QI,P_FIRST_SCALAR,                   &
+                        RTHFTEN, RQVFTEN,                           &
+                        APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+                        APR_CAPMA,APR_CAPME,APR_CAPMI,              &
+                        allowed_to_read,                            &
+                        ids, ide, jds, jde, kds, kde,               &
+                        ims, ime, jms, jme, kms, kme,               &
+                        its, ite, jts, jte, kts, kte               )
+!--------------------------------------------------------------------   
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+   LOGICAL , INTENT(IN)           ::  restart,allowed_to_read
+   INTEGER , INTENT(IN)           ::  ids, ide, jds, jde, kds, kde, &
+                                      ims, ime, jms, jme, kms, kme, &
+                                      its, ite, jts, jte, kts, kte
+   INTEGER , INTENT(IN)           ::  P_FIRST_SCALAR, P_QI, P_QC
+   REAL,     INTENT(IN)           ::  cp
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+                                                          RTHCUTEN, &
+                                                          RQVCUTEN, &
+                                                          RQCCUTEN, &
+                                                          RQICUTEN   
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+                                                          RTHFTEN,  &
+                                                          RQVFTEN
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) ::        &
+                                APR_GR,APR_W,APR_MC,APR_ST,APR_AS,  &
+                                APR_CAPMA,APR_CAPME,APR_CAPMI,      &
+                                MASS_FLUX
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+ 
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+ 
+   IF(.not.restart)THEN
+     DO j=jts,jtf
+     DO k=kts,ktf
+     DO i=its,itf
+        RTHCUTEN(i,k,j)=0.
+        RQVCUTEN(i,k,j)=0.
+     ENDDO
+     ENDDO
+     ENDDO
+
+     DO j=jts,jtf
+     DO k=kts,ktf
+     DO i=its,itf
+        RTHFTEN(i,k,j)=0.
+        RQVFTEN(i,k,j)=0.
+     ENDDO
+     ENDDO
+     ENDDO
+
+     IF (P_QC .ge. P_FIRST_SCALAR) THEN
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           RQCCUTEN(i,k,j)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+     ENDIF
+
+     IF (P_QI .ge. P_FIRST_SCALAR) THEN
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           RQICUTEN(i,k,j)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+     ENDIF
+
+     DO j=jts,jtf
+     DO i=its,itf
+        mass_flux(i,j)=0.
+     ENDDO
+     ENDDO
+
+   ENDIF
+     DO j=jts,jtf
+     DO i=its,itf
+        APR_GR(i,j)=0.
+        APR_ST(i,j)=0.
+        APR_W(i,j)=0.
+        APR_MC(i,j)=0.
+        APR_AS(i,j)=0.
+        APR_CAPMA(i,j)=0.
+        APR_CAPME(i,j)=0.
+        APR_CAPMI(i,j)=0.
+     ENDDO
+     ENDDO
+
+   END SUBROUTINE gdinit
+
+
+   SUBROUTINE massflx_stats(xf_ens,ensdim,maxens,maxens2,maxens3, &
+              xt_ave,xt_std,xt_cur,xt_ske,j,ierr,itest,           &
+              APR_GR,APR_W,APR_MC,APR_ST,APR_AS,                  &
+              APR_CAPMA,APR_CAPME,APR_CAPMI,                      &
+              pr_gr,pr_w,pr_mc,pr_st,pr_as,                       &
+              pr_capma,pr_capme,pr_capmi,                         &
+              ids,ide, jds,jde, kds,kde,  &
+              ims,ime, jms,jme, kms,kme,  &
+              its,ite, jts,jte, kts,kte)
+
+   IMPLICIT NONE
+
+   integer, intent (in   )              ::                                    &
+                     j,ensdim,maxens3,maxens,maxens2,itest
+   INTEGER,      INTENT(IN   ) ::                                             &
+                                  ids,ide, jds,jde, kds,kde,                  &
+                                  ims,ime, jms,jme, kms,kme,                  &
+                                  its,ite, jts,jte, kts,kte
+
+
+     real, dimension (its:ite)                                                &
+         , intent(inout) ::                                                   &
+           xt_ave,xt_cur,xt_std,xt_ske
+     integer, dimension (its:ite), intent (in) ::                             &
+           ierr
+     real, dimension (ims:ime,jms:jme,1:ensdim)                               &
+         , intent(in   ) ::                                                   &
+           xf_ens
+     real, dimension (ims:ime,jms:jme)                                        &
+         , intent(inout) ::                                                   &
+           APR_GR,APR_W,APR_MC,APR_ST,APR_AS,                                 &
+           APR_CAPMA,APR_CAPME,APR_CAPMI
+     real, dimension (its:ite,jts:jte)                                        &
+         , intent(inout) ::                                                   &
+           pr_gr,pr_w,pr_mc,pr_st,pr_as,                                      &
+           pr_capma,pr_capme,pr_capmi
+
+!
+! local stuff
+!
+     real, dimension (its:ite , 1:maxens3 )       ::                          &
+           x_ave,x_cur,x_std,x_ske
+     real, dimension (its:ite , 1:maxens  )       ::                          &
+           x_ave_cap
+
+
+      integer, dimension (1:maxens3) :: nc1
+      integer :: i,k
+      integer :: num,kk,num2,iedt
+      real :: a3,a4
+
+      num=ensdim/maxens3
+      num2=ensdim/maxens
+      if(itest.eq.1)then
+      do i=its,ite
+       pr_gr(i,j) =  0.
+       pr_w(i,j) =  0.
+       pr_mc(i,j) = 0.
+       pr_st(i,j) = 0.
+       pr_as(i,j) = 0.
+       pr_capma(i,j) =  0.
+       pr_capme(i,j) = 0.
+       pr_capmi(i,j) = 0.
+      enddo
+      endif
+
+      do k=1,maxens
+      do i=its,ite
+        x_ave_cap(i,k)=0.
+      enddo
+      enddo
+      do k=1,maxens3
+      do i=its,ite
+        x_ave(i,k)=0.
+        x_std(i,k)=0.
+        x_ske(i,k)=0.
+        x_cur(i,k)=0.
+      enddo
+      enddo
+      do i=its,ite
+        xt_ave(i)=0.
+        xt_std(i)=0.
+        xt_ske(i)=0.
+        xt_cur(i)=0.
+      enddo
+      do kk=1,num
+      do k=1,maxens3
+      do i=its,ite
+        if(ierr(i).eq.0)then
+        x_ave(i,k)=x_ave(i,k)+xf_ens(i,j,maxens3*(kk-1)+k)
+        endif
+      enddo
+      enddo
+      enddo
+      do iedt=1,maxens2
+      do k=1,maxens
+      do kk=1,maxens3
+      do i=its,ite
+        if(ierr(i).eq.0)then
+        x_ave_cap(i,k)=x_ave_cap(i,k)                               &
+            +xf_ens(i,j,maxens3*(k-1)+(iedt-1)*maxens*maxens3+kk)
+        endif
+      enddo
+      enddo
+      enddo
+      enddo
+      do k=1,maxens
+      do i=its,ite
+        if(ierr(i).eq.0)then
+        x_ave_cap(i,k)=x_ave_cap(i,k)/float(num2)
+        endif
+      enddo
+      enddo
+
+      do k=1,maxens3
+      do i=its,ite
+        if(ierr(i).eq.0)then
+        x_ave(i,k)=x_ave(i,k)/float(num)
+        endif
+      enddo
+      enddo
+      do k=1,maxens3
+      do i=its,ite
+        if(ierr(i).eq.0)then
+        xt_ave(i)=xt_ave(i)+x_ave(i,k)
+        endif
+      enddo
+      enddo
+      do i=its,ite
+        if(ierr(i).eq.0)then
+        xt_ave(i)=xt_ave(i)/float(maxens3)
+        endif
+      enddo
+!
+!--- now do std, skewness,curtosis
+!
+      do kk=1,num
+      do k=1,maxens3
+      do i=its,ite
+        if(ierr(i).eq.0.and.x_ave(i,k).gt.0.)then
+!       print *,i,j,k,kk,x_std(i,k),xf_ens(i,j,maxens3*(kk-1)+k),x_ave(i,k)
+        x_std(i,k)=x_std(i,k)+(xf_ens(i,j,maxens3*(kk-1)+k)-x_ave(i,k))**2
+        x_ske(i,k)=x_ske(i,k)+(xf_ens(i,j,maxens3*(kk-1)+k)-x_ave(i,k))**3
+        x_cur(i,k)=x_cur(i,k)+(xf_ens(i,j,maxens3*(kk-1)+k)-x_ave(i,k))**4
+        endif
+      enddo
+      enddo
+      enddo
+      do k=1,maxens3
+      do i=its,ite
+        if(ierr(i).eq.0.and.xt_ave(i).gt.0.)then
+        xt_std(i)=xt_std(i)+(x_ave(i,k)-xt_ave(i))**2
+        xt_ske(i)=xt_ske(i)+(x_ave(i,k)-xt_ave(i))**3
+        xt_cur(i)=xt_cur(i)+(x_ave(i,k)-xt_ave(i))**4
+        endif
+      enddo
+      enddo
+      do k=1,maxens3
+      do i=its,ite
+        if(ierr(i).eq.0.and.x_std(i,k).gt.0.)then
+           x_std(i,k)=x_std(i,k)/float(num)
+           a3=max(1.e-6,x_std(i,k))
+           x_std(i,k)=sqrt(a3)
+           a3=max(1.e-6,x_std(i,k)**3)
+           a4=max(1.e-6,x_std(i,k)**4)
+           x_ske(i,k)=x_ske(i,k)/float(num)/a3
+           x_cur(i,k)=x_cur(i,k)/float(num)/a4
+        endif
+!       print*,'                               '
+!       print*,'Some statistics at gridpoint i,j, ierr',i,j,ierr(i)
+!       print*,'statistics for closure number ',k
+!       print*,'Average= ',x_ave(i,k),'  Std= ',x_std(i,k)
+!       print*,'Skewness= ',x_ske(i,k),' Curtosis= ',x_cur(i,k)
+!       print*,'                               '
+
+      enddo
+      enddo
+      do i=its,ite
+        if(ierr(i).eq.0.and.xt_std(i).gt.0.)then
+           xt_std(i)=xt_std(i)/float(maxens3)
+           a3=max(1.e-6,xt_std(i))
+           xt_std(i)=sqrt(a3)
+           a3=max(1.e-6,xt_std(i)**3)
+           a4=max(1.e-6,xt_std(i)**4)
+           xt_ske(i)=xt_ske(i)/float(maxens3)/a3
+           xt_cur(i)=xt_cur(i)/float(maxens3)/a4
+!       print*,'                               '
+!       print*,'Total ensemble independent statistics at i =',i
+!       print*,'Average= ',xt_ave(i),'  Std= ',xt_std(i)
+!       print*,'Skewness= ',xt_ske(i),' Curtosis= ',xt_cur(i)
+!       print*,'                               '
+!
+!  first go around: store massflx for different closures/caps
+!
+      if(itest.eq.1)then
+       pr_gr(i,j) = .333*(x_ave(i,1)+x_ave(i,2)+x_ave(i,3))
+       pr_w(i,j) = .333*(x_ave(i,4)+x_ave(i,5)+x_ave(i,6))
+       pr_mc(i,j) = .333*(x_ave(i,7)+x_ave(i,8)+x_ave(i,9))
+       pr_st(i,j) = .333*(x_ave(i,10)+x_ave(i,11)+x_ave(i,12))
+       pr_as(i,j) = .25*(x_ave(i,13)+x_ave(i,14)+x_ave(i,15) &
+                     + x_ave(i,16))
+       pr_capma(i,j) = x_ave_cap(i,1)
+       pr_capme(i,j) = x_ave_cap(i,2)
+       pr_capmi(i,j) = x_ave_cap(i,3)
+!
+!  second go around: store preciprates (mm/hour) for different closures/caps
+!
+        else if (itest.eq.2)then
+       APR_GR(i,j)=.333*(x_ave(i,1)+x_ave(i,2)+x_ave(i,3))*      &
+                  3600.*pr_gr(i,j) +APR_GR(i,j)
+       APR_W(i,j)=.333*(x_ave(i,4)+x_ave(i,5)+x_ave(i,6))*       &
+                  3600.*pr_w(i,j) +APR_W(i,j)
+       APR_MC(i,j)=.333*(x_ave(i,7)+x_ave(i,8)+x_ave(i,9))*      &
+                  3600.*pr_mc(i,j) +APR_MC(i,j)
+       APR_ST(i,j)=.333*(x_ave(i,10)+x_ave(i,11)+x_ave(i,12))*   &
+                  3600.*pr_st(i,j) +APR_ST(i,j)
+       APR_AS(i,j)=.25*(x_ave(i,13)+x_ave(i,14)+x_ave(i,15)      &
+                           + x_ave(i,16))*                       &
+                  3600.*pr_as(i,j) +APR_AS(i,j)
+       APR_CAPMA(i,j) = x_ave_cap(i,1)*                          &
+                  3600.*pr_capma(i,j) +APR_CAPMA(i,j)
+       APR_CAPME(i,j) = x_ave_cap(i,2)*                          &
+                  3600.*pr_capme(i,j) +APR_CAPME(i,j)
+       APR_CAPMI(i,j) = x_ave_cap(i,3)*                          &
+                  3600.*pr_capmi(i,j) +APR_CAPMI(i,j)
+        endif
+        endif
+      enddo
+
+   END SUBROUTINE massflx_stats
+
+
+   SUBROUTINE neg_check(dt,q,outq,outt,outqc,pret,its,ite,kts,kte,itf,ktf)
+
+   INTEGER,      INTENT(IN   ) ::            its,ite,kts,kte,itf,ktf
+
+     real, dimension (its:ite,kts:kte  )                    ,                 &
+      intent(inout   ) ::                                                     &
+       q,outq,outt,outqc
+     real, dimension (its:ite  )                            ,                 &
+      intent(inout   ) ::                                                     &
+       pret
+     real                                                                     &
+        ,intent (in  )                   ::                                   &
+        dt
+     real :: thresh,qmem,qmemf,qmem2,qtest,qmem1
+!
+! first do check on vertical heating rate
+!
+      thresh=200.01
+      do i=its,itf
+      qmemf=1.
+      qmem=0.
+      do k=kts,ktf
+         qmem=outt(i,k)*86400.
+         if(qmem.gt.2.*thresh)then
+           qmem2=2.*thresh/qmem
+           qmemf=min(qmemf,qmem2)
+!
+!
+!          print *,'1',' adjusted massflux by factor ',i,k,qmem,qmem2,qmemf
+         endif
+         if(qmem.lt.-thresh)then
+           qmem2=-thresh/qmem
+           qmemf=min(qmemf,qmem2)
+!
+!
+!          print *,'2',' adjusted massflux by factor ',i,k,qmem,qmem2,qmemf
+         endif
+      enddo
+      do k=kts,ktf
+         outq(i,k)=outq(i,k)*qmemf
+         outt(i,k)=outt(i,k)*qmemf
+         outqc(i,k)=outqc(i,k)*qmemf
+      enddo
+      pret(i)=pret(i)*qmemf 
+      enddo
+!
+! check whether routine produces negative q's. This can happen, since 
+! tendencies are calculated based on forced q's. This should have no
+! influence on conservation properties, it scales linear through all
+! tendencies
+!
+      thresh=1.e-10
+      do i=its,itf
+      qmemf=1.
+      do k=kts,ktf
+         qmem=outq(i,k)
+         if(abs(qmem).gt.0.)then
+         qtest=q(i,k)+outq(i,k)*dt
+         if(qtest.lt.thresh)then
+!
+! qmem2 would be the maximum allowable tendency
+!
+           qmem1=outq(i,k)
+           qmem2=(thresh-q(i,k))/dt
+           qmemf=min(qmemf,qmem2/qmem1)
+!          qmemf=max(0.,qmemf)
+!          print *,'4 adjusted tendencies ',i,k,qmem,qmem2,qmemf
+         endif
+         endif
+      enddo
+      do k=kts,ktf
+         outq(i,k)=outq(i,k)*qmemf
+         outt(i,k)=outt(i,k)*qmemf
+         outqc(i,k)=outqc(i,k)*qmemf
+      enddo
+      pret(i)=pret(i)*qmemf 
+      enddo
+
+   END SUBROUTINE neg_check
+
+
+!-------------------------------------------------------
+END MODULE module_cu_gd
Index: trunk/WRF.COMMON/WRFV2/phys/module_cu_kf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_cu_kf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_cu_kf.F	(revision 2744)
@@ -0,0 +1,2568 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+
+MODULE module_cu_kf
+
+   USE module_wrf_error
+
+   REAL    , PARAMETER :: RAD          = 1500.
+
+CONTAINS
+
+!-------------------------------------------------------------
+   SUBROUTINE KFCPS(                                         &
+               ids,ide, jds,jde, kds,kde                     &
+              ,ims,ime, jms,jme, kms,kme                     &
+              ,its,ite, jts,jte, kts,kte                     &
+              ,DT,KTAU,DX                                    &
+              ,rho                                           &
+              ,RAINCV,NCA                                    &
+              ,U,V,TH,T,W,QV,dz8w,Pcps,pi                    &
+              ,W0AVG,XLV0,XLV1,XLS0,XLS1,CP,R,G,EP1          &
+              ,EP2,SVP1,SVP2,SVP3,SVPT0                      &
+              ,STEPCU,CU_ACT_FLAG,warm_rain                  &
+            ! optional arguments
+              ,F_QV    ,F_QC    ,F_QR    ,F_QI    ,F_QS      &
+              ,RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN  &
+              ,RTHCUTEN                                      &
+                                                             )
+!-------------------------------------------------------------
+   IMPLICIT NONE
+!-------------------------------------------------------------
+   INTEGER,      INTENT(IN   ) ::                            &
+                                  ids,ide, jds,jde, kds,kde, & 
+                                  ims,ime, jms,jme, kms,kme, & 
+                                  its,ite, jts,jte, kts,kte
+
+   INTEGER,      INTENT(IN   ) :: STEPCU
+   LOGICAL,      INTENT(IN   ) :: warm_rain
+
+   REAL,         INTENT(IN   ) :: XLV0,XLV1,XLS0,XLS1
+   REAL,         INTENT(IN   ) :: CP,R,G,EP1,EP2
+   REAL,         INTENT(IN   ) :: SVP1,SVP2,SVP3,SVPT0
+
+   INTEGER,      INTENT(IN   ) :: KTAU                   
+
+   REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         , &
+          INTENT(IN   ) ::                                   &
+                                                          U, &
+                                                          V, &
+                                                          W, &
+                                                         TH, &
+                                                         QV, &
+                                                          T, &
+                                                       dz8w, &
+                                                       Pcps, &
+                                                        rho, &
+                                                         pi
+!
+   REAL,  INTENT(IN   ) :: DT, DX
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                     &
+          INTENT(INOUT) ::                                   &
+                                                     RAINCV  &
+                                                    ,   NCA
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),           &
+          INTENT(INOUT) ::                                   &
+                                                      W0AVG
+
+   LOGICAL, DIMENSION( ims:ime , jms:jme ),                  &
+          INTENT(INOUT) :: CU_ACT_FLAG
+
+!
+! Optional arguments
+!
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),           &
+         OPTIONAL,                                           &
+         INTENT(INOUT) ::                                    &
+                                                   RTHCUTEN  &
+                                                  ,RQVCUTEN  &
+                                                  ,RQCCUTEN  &
+                                                  ,RQRCUTEN  &
+                                                  ,RQICUTEN  &
+                                                  ,RQSCUTEN
+
+!
+! Flags relating to the optional tendency arrays declared above
+! Models that carry the optional tendencies will provdide the
+! optional arguments at compile time; these flags all the model
+! to determine at run-time whether a particular tracer is in 
+! use or not. 
+!
+
+   LOGICAL, OPTIONAL ::                                      &
+                                                   F_QV      &
+                                                  ,F_QC      &
+                                                  ,F_QR      &
+                                                  ,F_QI      &
+                                                  ,F_QS
+
+
+
+! LOCAL VARS
+
+   REAL, DIMENSION( kts:kte ) ::                             &
+                                                        U1D, &
+                                                        V1D, &
+                                                        T1D, &
+                                                       DZ1D, &
+                                                       QV1D, &
+                                                        P1D, &
+                                                      RHO1D, &
+                                                    W0AVG1D
+
+   REAL, DIMENSION( kts:kte )::                              &
+                                                       DQDT, &
+                                                      DQIDT, &
+                                                      DQCDT, &
+                                                      DQRDT, &
+                                                      DQSDT, &
+                                                       DTDT
+
+   REAL    ::         TST,tv,PRS,RHOE,W0,SCR1,DXSQ,tmp,RTHCUMAX
+
+   INTEGER :: i,j,k,NTST,ICLDCK
+
+   LOGICAL :: qi_flag , qs_flag
+
+!----------------------------------------------------------------------
+
+!--- CALL CUMULUS PARAMETERIZATION                                        
+!                                                                        
+!...TST IS THE NUMBER OF TIME STEPS IN 10 MINUTES...W0AVG IS CLOSE TO A    
+!...RUNNING MEAN VERTICAL VELOCITY...NOTE THAT IF YOU CHANGE TST, IT WIL  
+!...CHANGE THE FREQUENCY OF THE CONVECTIVE INTITIATION CHECK (SEE BELOW) 
+!...NOTE THAT THE ORDERING OF VERTICAL LAYERS MUST BE REVERSED FOR W0AVG
+!...BECAUSE THE ORDERING IS REVERSED IN KFPARA...                         
+!                                                                           
+   DXSQ=DX*DX
+   qi_flag = .FALSE.
+   qs_flag = .FALSE.
+   IF ( PRESENT( F_QI ) ) qi_flag = f_qi
+   IF ( PRESENT( F_QS ) ) qs_flag = f_qs
+
+!----------------------
+   NTST=STEPCU
+   TST=float(NTST*2)                                                         
+!----------------------
+!  NTST=NINT(1200./(DT*2.))                                                 
+!  TST=float(NTST)                                                         
+!  NTST=NINT(0.5*TST)                                                   
+!  NTST=MAX0(NTST,1)                                                   
+!----------------------
+   ICLDCK=MOD(KTAU,NTST)                                              
+!----------------------
+
+   DO J = jts,jte  
+      DO K=kts,kte
+         DO I= its,ite
+            SCR1=-5.0E-4*G*rho(I,K,J)*(w(I,K,J)+w(I,K+1,J))
+            TV=T(I,K,J)*(1.+EP1*QV(I,K,J))
+            RHOE=Pcps(I,K,J)/(R*TV)
+            W0=-101.9368*SCR1/RHOE
+            W0AVG(I,K,J)=(W0AVG(I,K,J)*(TST-1.)+W0)/TST
+         ENDDO
+      ENDDO
+   ENDDO
+!                                                                      
+!...CHECK FOR CONVECTIVE INITIATION EVERY 5 MINUTES (OR NTST/2)...      
+!                                                                     
+   RTHCUMAX=0.
+
+   IF(ICLDCK.EQ.0 .or. KTAU .eq. 1) then
+
+     DO J = jts,jte  
+     DO I= its,ite
+        CU_ACT_FLAG(i,j) = .true.
+     ENDDO
+     ENDDO
+
+     DO J = jts,jte  
+        DO I=its,ite
+         IF ( NINT(NCA(I,J)) .gt. 0 ) then
+            CU_ACT_FLAG(i,j) = .false. 
+         ELSE
+
+            DO k=kts,kte
+               DQDT(k)=0.
+               DQIDT(k)=0.      
+               DQCDT(k)=0.      
+               DQRDT(k)=0.      
+               DQSDT(k)=0.      
+               DTDT(k)=0.
+            ENDDO
+            RAINCV(I,J)=0.
+!
+! assign vars from 3D to 1D
+
+            DO K=kts,kte
+               U1D(K) =U(I,K,J)
+               V1D(K) =V(I,K,J)
+               T1D(K) =T(I,K,J)
+             RHO1D(K) =rho(I,K,J)
+               QV1D(K)=QV(I,K,J)
+               P1D(K) =Pcps(I,K,J)
+               W0AVG1D(K) =W0AVG(I,K,J)
+               DZ1D(k)=dz8w(I,K,J)
+            ENDDO
+
+!
+            CALL KFPARA(I, J,                       &
+                 U1D,V1D,T1D,QV1D,P1D,DZ1D,         &
+                 W0AVG1D,DT,DX,DXSQ,RHO1D,          &
+                 XLV0,XLV1,XLS0,XLS1,CP,R,G,        &
+                 EP2,SVP1,SVP2,SVP3,SVPT0,          &
+                 DQDT,DQIDT,DQCDT,DQRDT,DQSDT,DTDT, &
+                 RAINCV,NCA,                        &
+                 warm_rain,qi_flag,qs_flag,         &
+                 ids,ide, jds,jde, kds,kde,         &        
+                 ims,ime, jms,jme, kms,kme,         &
+                 its,ite, jts,jte, kts,kte          )
+ 
+            IF ( PRESENT( RTHCUTEN ) .AND. PRESENT( RQVCUTEN ) ) THEN
+              DO K=kts,kte
+                 RTHCUTEN(I,K,J)=DTDT(K)/pi(I,K,J)
+                 RQVCUTEN(I,K,J)=DQDT(K)
+              ENDDO
+            ENDIF
+
+            IF( PRESENT(RQRCUTEN) .AND. PRESENT(RQCCUTEN) .AND. &
+                PRESENT(F_QR)                                    ) THEN
+              IF ( F_QR            ) THEN
+                 DO K=kts,kte
+                    RQRCUTEN(I,K,J)=DQRDT(K)
+                    RQCCUTEN(I,K,J)=DQCDT(K)
+                 ENDDO
+               ELSE
+! This is the case for Eta microphysics without 3d rain field
+                 DO K=kts,kte
+                    RQRCUTEN(I,K,J)=0.
+                    RQCCUTEN(I,K,J)=DQRDT(K)+DQCDT(K)
+                 ENDDO
+              ENDIF
+            ENDIF
+
+!......     QSTEN STORES GRAUPEL TENDENCY IF IT EXISTS, OTHERISE SNOW (V2)     
+
+            IF( PRESENT( RQICUTEN ) .AND. qi_flag )THEN
+              DO K=kts,kte
+                 RQICUTEN(I,K,J)=DQIDT(K)
+              ENDDO
+            ENDIF
+
+            IF( PRESENT ( RQSCUTEN ) .AND. qs_flag )THEN
+              DO K=kts,kte
+                 RQSCUTEN(I,K,J)=DQSDT(K)
+              ENDDO
+            ENDIF                                                         
+!
+         ENDIF                                                         
+       ENDDO
+     ENDDO
+
+   ENDIF
+
+   END SUBROUTINE KFCPS
+   
+!-----------------------------------------------------------
+   SUBROUTINE KFPARA (I, J,                                &
+                      U0,V0,T0,QV0,P0,DZQ,W0AVG1D,         &
+                      DT,DX,DXSQ,rho,                      &
+                      XLV0,XLV1,XLS0,XLS1,CP,R,G,          &
+                      EP2,SVP1,SVP2,SVP3,SVPT0,            &
+                      DQDT,DQIDT,DQCDT,DQRDT,DQSDT,DTDT,   &
+                      RAINCV,NCA,                          &
+                      warm_rain,qi_flag,qs_flag,           &
+                      ids,ide, jds,jde, kds,kde,           & 
+                      ims,ime, jms,jme, kms,kme,           &
+                      its,ite, jts,jte, kts,kte            )
+!-----------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------
+      INTEGER, INTENT(IN   ) :: ids,ide, jds,jde, kds,kde, &
+                                ims,ime, jms,jme, kms,kme, &
+                                its,ite, jts,jte, kts,kte, &
+                                I,J
+      LOGICAL, INTENT(IN   ) :: warm_rain
+      LOGICAL           :: qi_flag, qs_flag
+
+!
+      REAL, DIMENSION( kts:kte ),                          &
+            INTENT(IN   ) ::                           U0, &
+                                                       V0, &
+                                                       T0, &
+                                                      QV0, &
+                                                       P0, &
+                                                      rho, &
+                                                      DZQ, &
+                                                  W0AVG1D
+!
+      REAL,  INTENT(IN   ) :: DT,DX,DXSQ
+!
+
+      REAL,  INTENT(IN   ) :: XLV0,XLV1,XLS0,XLS1,CP,R,G
+      REAL,  INTENT(IN   ) :: EP2,SVP1,SVP2,SVP3,SVPT0
+!
+      REAL, DIMENSION( kts:kte ), INTENT(INOUT) ::         &
+                                                     DQDT, &
+                                                    DQIDT, &
+                                                    DQCDT, &
+                                                    DQRDT, &
+                                                    DQSDT, &
+                                                     DTDT
+
+      REAL, DIMENSION( ims:ime , jms:jme ),                &
+            INTENT(INOUT) ::                       RAINCV, &
+                                                      NCA
+!
+!...DEFINE LOCAL VARIABLES...                                
+!                                                            
+      REAL, DIMENSION( kts:kte ) ::                        &
+            Q0,Z0,TV0,TU,TVU,QU,TZ,TVD,                    &
+            QD,QES,THTES,TG,TVG,QG,WU,WD,W0,EMS,EMSD,      &
+            UMF,UER,UDR,DMF,DER,DDR,UMF2,UER2,             &
+            UDR2,DMF2,DER2,DDR2,DZA,THTA0,THETEE,          &
+            THTAU,THETEU,THTAD,THETED,QLIQ,QICE,           &
+            QLQOUT,QICOUT,PPTLIQ,PPTICE,DETLQ,DETIC,       &
+            DETLQ2,DETIC2,RATIO,RATIO2
+
+      REAL, DIMENSION( kts:kte ) ::                        &
+            DOMGDP,EXN,RHOE,TVQU,DP,RH,EQFRC,WSPD,         &
+            QDT,FXM,THTAG,THTESG,THPA,THFXTOP,             &
+            THFXBOT,QPA,QFXTOP,QFXBOT,QLPA,QLFXIN,         &
+            QLFXOUT,QIPA,QIFXIN,QIFXOUT,QRPA,              &
+            QRFXIN,QRFXOUT,QSPA,QSFXIN,QSFXOUT,            &
+            QL0,QLG,QI0,QIG,QR0,QRG,QS0,QSG
+                                         
+      REAL, DIMENSION( kts:kte+1 ) :: OMG
+      REAL, DIMENSION( kts:kte ) :: RAINFB,SNOWFB
+
+! LOCAL VARS
+
+      REAL    :: P00,T00,CV,B61,RLF,RHIC,RHBC,PIE,         &
+                 TTFRZ,TBFRZ,C5,RATE
+      REAL    :: GDRY,ROCP,ALIQ,BLIQ,                      & 
+                 CLIQ,DLIQ,AICE,BICE,CICE,DICE
+      REAL    :: FBFRC,P300,DPTHMX,THMIX,QMIX,ZMIX,PMIX,   &
+                 ROCPQ,TMIX,EMIX,TLOG,TDPT,TLCL,TVLCL,     &
+                 CPORQ,PLCL,ES,DLP,TENV,QENV,TVEN,TVBAR,   &
+                 ZLCL,WKL,WABS,TRPPT,WSIGNE,DTLCL,GDT,WLCL,&
+                 TVAVG,QESE,WTW,RHOLCL,AU0,VMFLCL,UPOLD,   &
+                 UPNEW,ABE,WKLCL,THTUDL,TUDL,TTEMP,FRC1,   &
+                 QNEWIC,RL,R1,QNWFRZ,EFFQ,BE,BOTERM,ENTERM,&
+                 DZZ,WSQ,UDLBE,REI,EE2,UD2,TTMP,F1,F2,     &
+                 THTTMP,QTMP,TMPLIQ,TMPICE,TU95,TU10,EE1,  &
+                 UD1,CLDHGT,DPTT,QNEWLQ,DUMFDP,EE,TSAT,    &
+                 THTA,P150,USR,VCONV,TIMEC,SHSIGN,VWS,PEF, &
+                 CBH,RCBH,PEFCBH,PEFF,PEFF2,TDER,THTMIN,   &
+                 DTMLTD,QS,TADVEC,DPDD,FRC,DPT,RDD,A1,     &
+                 DSSDT,DTMP,T1RH,QSRH,PPTFLX,CPR,CNDTNF,   &
+                 UPDINC,AINCM2,DEVDMF,PPR,RCED,DPPTDF,     &
+                 DMFLFS,DMFLFS2,RCED2,DDINC,AINCMX,AINCM1, &
+                 AINC,TDER2,PPTFL2,FABE,STAB,DTT,DTT1,     &
+                 DTIME,TMA,TMB,TMM,BCOEFF,ACOEFF,QVDIFF,   &
+                 TOPOMG,CPM,DQ,ABEG,DABE,DFDA,FRC2,DR,     &
+                 UDFRC,TUC,QGS,RH0,RHG,QINIT,QFNL,ERR2,    &
+                 RELERR,RLC,RLS,RNC,FABEOLD,AINCOLD,UEFRC, &
+                 DDFRC,TDC,DEFRC         
+
+      INTEGER :: KX,K,KL
+!                                                    
+      INTEGER :: ISTOP,ML,L5,L4,KMIX,LOW,                  &
+                 LC,MXLAYR,LLFC,NLAYRS,NK,                 &
+                 KPBL,KLCL,LCL,LET,IFLAG,                  &
+                 KFRZ,NK1,LTOP,NJ,LTOP1,                   &
+                 LTOPM1,LVF,KSTART,KMIN,LFS,               &
+                 ND,NIC,LDB,LDT,ND1,NDK,                   &
+                 NM,LMAX,NCOUNT,NOITR,                     &
+                 NSTEP,NTC
+!                                                    
+      DATA P00,T00/1.E5,273.16/                     
+      DATA CV,B61,RLF/717.,0.608,3.339E5/          
+      DATA RHIC,RHBC/1.,0.90/                                    
+      DATA PIE,TTFRZ,TBFRZ,C5/3.141592654,268.16,248.16,1.0723E-3/
+      DATA RATE/0.01/                                           
+!-----------------------------------------------------------
+      GDRY=-G/CP                                               
+      ROCP=R/CP
+      KL=kte
+      KX=kte
+!
+!     ALIQ = 613.3   
+!     BLIQ = 17.502                                                   
+!     CLIQ = 4780.8                                                  
+!     DLIQ = 32.19                                                  
+      ALIQ = SVP1*1000.
+      BLIQ = SVP2
+      CLIQ = SVP2*SVPT0
+      DLIQ = SVP3
+      AICE = 613.2  
+      BICE = 22.452                                         
+      CICE = 6133.0                                        
+      DICE = 0.61                                         
+!
+
+!...OPTION TO FEED CONVECTIVELY GENERATED RAINWATER      
+!...INTO GRID-RESOLVED RAINWATER (OR SNOW/GRAUPEL)      
+!...FIELD.  'FBFRC' IS THE FRACTION OF AVAILABLE       
+!...PRECIPITATION TO BE FED BACK (0.0 - 1.0)...      
+!                                                   
+      FBFRC=0.0                                    
+!                                                                       
+!...SCHEME IS CALLED ONCE  ON EACH NORTH-SOUTH SLICE, THE LOOP BELOW   
+!...CHECKS FOR THE POSSIBILITY OF INITIATING PARAMETERIZED            
+!...CONVECTION AT EACH POINT WITHIN THE SLICE                        
+!                                                                   
+!...SEE IF IT IS NECESSARY TO CHECK FOR CONVECTIVE TRIGGERING AT THIS 
+!...GRID POINT. IF NCA>0, CONVECTION IS ALREADY ACTIVE AT THIS POINT,
+!...JUST FEED BACK THE TENDENCIES SAVED FROM THE TIME WHEN CONVECTION  
+!...WAS INITIATED.  IF NCA<0, CONVECTION IS NOT ACTIVE                
+!...AND YOU MAY WANT TO CHECK TO SEE IF IT CAN BE ACTIVATED FOR THE  
+!...CURRENT CONDITIONS.  IN PREVIOUS APLICATIONS OF THIS SCHEME,    
+!...THE VARIABLE ICLDCK WAS USED BELOW TO SAVE TIME BY ONLY CHECKING   
+!...FOR THE POSSIBILITY OF CONVECTIVE INITIATION EVERY 5 OR 10        
+!...MINUTES...                                                       
+!                                                                   
+
+!  10 CONTINUE                                                 
+!SUE  P300=1000.*(PSB(I,J)*A(KL)+PTOP-30.)+PP3D(I,J,KL)              
+
+      P300=P0(1)-30000.
+!                                                                     
+!...PRESSURE PERTURBATION TERM IS ONLY DEFINED AT MID-POINT OF       
+!...VERTICAL LAYERS...SINCE TOTAL PRESSURE IS NEEDED AT THE TOP AND 
+!...BOTTOM OF LAYERS BELOW, DO AN INTERPOLATION...                       
+!                                                                       
+!...INPUT A VERTICAL SOUNDING ... NOTE THAT MODEL LAYERS ARE NUMBERED  
+!...FROM BOTTOM-UP IN THE KF SCHEME...                                
+!                                                                    
+      ML=0                                                        
+!SUE  tmprpsb=1./PSB(I,J)
+!SUE  CELL=PTOP*tmprpsb
+
+      DO 15 K=1,KX                                               
+!SUE     P0(K)=1.E3*(A(NK)*PSB(I,J)+PTOP)+PP3D(I,J,NK)          
+!                                                                        
+!...IF Q0 IS ABOVE SATURATION VALUE, REDUCE IT TO SATURATION LEVEL...   
+!                                                                      
+         ES=ALIQ*EXP((BLIQ*T0(K)-CLIQ)/(T0(K)-DLIQ))                 
+         QES(K)=EP2*ES/(P0(K)-ES)                                 
+         Q0(K)=AMIN1(QES(K),QV0(K))                                 
+         Q0(K)=AMAX1(0.000001,Q0(K))                                 
+         QL0(K)=0.                                                
+         QI0(K)=0.                                               
+         QR0(K)=0.                                              
+         QS0(K)=0.                                             
+
+         TV0(K)=T0(K)*(1.+B61*Q0(K))                                 
+         RHOE(K)=P0(K)/(R*TV0(K))                                  
+
+         DP(K)=rho(k)*g*DZQ(k)
+!                                                                         
+!...DZQ IS DZ BETWEEN SIGMA SURFACES, DZA IS DZ BETWEEN MODEL HALF LEVEL 
+!   DP IS THE PRESSURE INTERVAL BETWEEN FULL SIGMA LEVELS...            
+!                                                                      
+         IF(P0(K).GE.500E2)L5=K                                       
+         IF(P0(K).GE.400E2)L4=K                                      
+         IF(P0(K).GE.P300)LLFC=K                                    
+         IF(T0(K).GT.T00)ML=K                                      
+   15   CONTINUE                                                   
+
+        Z0(1)=.5*DZQ(1)   
+        DO 20 K=2,KL                                              
+          Z0(K)=Z0(K-1)+.5*(DZQ(K)+DZQ(K-1))   
+          DZA(K-1)=Z0(K)-Z0(K-1)                                 
+   20   CONTINUE                                                       
+        DZA(KL)=0.                                                    
+        KMIX=1                                                       
+   25   LOW=KMIX                                                    
+
+        IF(LOW.GT.LLFC)GOTO 325                                    
+
+        LC=LOW                                                    
+        MXLAYR=0                                                 
+!                                                                        
+!...ASSUME THAT IN ORDER TO SUPPORT A DEEP UPDRAFT YOU NEED A LAYER OF 
+!...UNSTABLE AIR 50 TO 100 mb DEEP...TO APPROXIMATE THIS, ISOLATE A      
+!...GROUP OF ADJACENT INDIVIDUAL MODEL LAYERS, WITH THE BASE AT LEVEL   
+!...LC, SUCH THAT THE COMBINED DEPTH OF THESE LAYERS IS AT LEAST 60 mb..  
+!                                                                        
+        NLAYRS=0                                                        
+        DPTHMX=0.                                                      
+        DO 63 NK=LC,KX                                                
+          DPTHMX=DPTHMX+DP(NK)                                            
+          NLAYRS=NLAYRS+1                                                
+   63   IF(DPTHMX.GT.6.E3)GOTO 64                                       
+        GOTO 325                                                       
+   64   KPBL=LC+NLAYRS-1                                              
+        KMIX=LC+1                                                        
+   18   THMIX=0.                                                        
+        QMIX=0.                                                        
+        ZMIX=0.                                                       
+        PMIX=0.                                                             
+        DPTHMX=0.                                                          
+!                                                                         
+!...FIND THE THERMODYNAMIC CHARACTERISTICS OF THE LAYER BY              
+!...MASS-WEIGHTING THE CHARACTERISTICS OF THE INDIVIDUAL MODEL         
+!...LAYERS...                                                         
+!                                                                    
+        DO 17 NK=LC,KPBL                                            
+          DPTHMX=DPTHMX+DP(NK)                                     
+          ROCPQ=0.2854*(1.-0.28*Q0(NK))                           
+          THMIX=THMIX+DP(NK)*T0(NK)*(P00/P0(NK))**ROCPQ          
+          QMIX=QMIX+DP(NK)*Q0(NK)                               
+          ZMIX=ZMIX+DP(NK)*Z0(NK)                              
+   17   PMIX=PMIX+DP(NK)*P0(NK)                               
+        THMIX=THMIX/DPTHMX                                   
+        QMIX=QMIX/DPTHMX                                    
+        ZMIX=ZMIX/DPTHMX                                   
+        PMIX=PMIX/DPTHMX                                  
+        ROCPQ=0.2854*(1.-0.28*QMIX)                               
+        TMIX=THMIX*(PMIX/P00)**ROCPQ                             
+        EMIX=QMIX*PMIX/(EP2+QMIX)                             
+!                                                              
+!...FIND THE TEMPERATURE OF THE MIXTURE AT ITS LCL, PRESSURE       
+!...LEVEL OF LCL...                                               
+!                                                                
+        TLOG=ALOG(EMIX/ALIQ)                                    
+        TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)                             
+        TLCL=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(TMIX-T00))*(TMIX-  &
+             TDPT)                                                    
+        TLCL=AMIN1(TLCL,TMIX)                                       
+        TVLCL=TLCL*(1.+0.608*QMIX)                                 
+        CPORQ=1./ROCPQ                                            
+        PLCL=P00*(TLCL/THMIX)**CPORQ                             
+        DO 29 NK=LC,KL                                          
+          KLCL=NK                                              
+          IF(PLCL.GE.P0(NK))GOTO 35                           
+   29   CONTINUE                                            
+        GOTO 325                                                       
+   35   K=KLCL-1                                                      
+        DLP=ALOG(PLCL/P0(K))/ALOG(P0(KLCL)/P0(K))                    
+!                                                                   
+!...ESTIMATE ENVIRONMENTAL TEMPERATURE AND MIXING RATIO AT THE LCL...
+!                                                                   
+        TENV=T0(K)+(T0(KLCL)-T0(K))*DLP                            
+        QENV=Q0(K)+(Q0(KLCL)-Q0(K))*DLP                           
+        TVEN=TENV*(1.+0.608*QENV)                                
+        TVBAR=0.5*(TV0(K)+TVEN)                                 
+!        ZLCL=Z0(K)+R*TVBAR*ALOG(P0(K)/PLCL)/G                 
+        ZLCL=Z0(K)+(Z0(KLCL)-Z0(K))*DLP                                 
+!                                                                      
+!...CHECK TO SEE IF CLOUD IS BUOYANT USING FRITSCH-CHAPPELL TRIGGER  
+!...FUNCTION DESCRIBED IN KAIN AND FRITSCH (1992)...W0AVG IS AN     
+!...APROXIMATE VALUE FOR THE RUNNING-MEAN GRID-SCALE VERTICAL      
+!...VELOCITY, WHICH GIVES SMOOTHER FIELDS OF CONVECTIVE INITIATION 
+!...THAN THE INSTANTANEOUS VALUE...FORMULA RELATING TEMPERATURE            
+!...PERTURBATION TO VERTICAL VELOCITY HAS BEEN USED WITH THE MOST         
+!...SUCCESS AT GRID LENGTHS NEAR 25 km.  FOR DIFFERENT GRID-LENGTHS,     
+!...ADJUST VERTICAL VELOCITY TO EQUIVALENT VALUE FOR 25 KM GRID         
+!...LENGTH, ASSUMING LINEAR DEPENDENCE OF W ON GRID LENGTH...          
+!                                                                     
+        WKLCL=0.02*ZLCL/2.5E3                                             
+        WKL=(W0AVG1D(K)+(W0AVG1D(KLCL)-W0AVG1D(K))*DLP)*DX/25.E3- & 
+            WKLCL                                                           
+        WABS=ABS(WKL)+1.E-10                                               
+        WSIGNE=WKL/WABS                                                   
+        DTLCL=4.64*WSIGNE*WABS**0.33                                     
+        GDT=G*DTLCL*(ZLCL-Z0(LC))/(TV0(LC)+TVEN)                        
+        WLCL=1.+.5*WSIGNE*SQRT(ABS(GDT)+1.E-10)                        
+        IF(TLCL+DTLCL.GT.TENV)GOTO 45                                 
+        IF(KPBL.GE.LLFC)GOTO 325                                     
+        GOTO 25                                                     
+!                                                                       
+!...CONVECTIVE TRIGGERING CRITERIA HAS BEEN SATISFIED...COMPUTE           
+!...EQUIVALENT POTENTIAL TEMPERATURE                                     
+!...(THETEU) AND VERTICAL VELOCITY OF THE RISING PARCEL AT THE LCL...    
+!                                                                       
+   45   THETEU(K)=TMIX*(1.E5/PMIX)**(0.2854*(1.-0.28*QMIX))* & 
+                  EXP((3374.6525/TLCL-2.5403)*QMIX*(1.+0.81*QMIX))     
+        ES=ALIQ*EXP((TENV*BLIQ-CLIQ)/(TENV-DLIQ))                     
+        TVAVG=0.5*(TV0(KLCL)+TENV*(1.+0.608*QENV))                   
+        PLCL=P0(KLCL)*EXP(G/(R*TVAVG)*(Z0(KLCL)-ZLCL))              
+        QESE=EP2*ES/(PLCL-ES)                                    
+        GDT=G*DTLCL*(ZLCL-Z0(LC))/(TV0(LC)+TVEN)                  
+        WLCL=1.+.5*WSIGNE*SQRT(ABS(GDT)+1.E-10)                      
+        THTES(K)=TENV*(1.E5/PLCL)**(0.2854*(1.-0.28*QESE))* &    
+                 EXP((3374.6525/TENV-2.5403)*QESE*(1.+0.81*QESE))           
+        WTW=WLCL*WLCL                                                      
+        IF(WLCL.LT.0.)GOTO 25                                             
+        TVLCL=TLCL*(1.+0.608*QMIX)                                       
+        RHOLCL=PLCL/(R*TVLCL)                                           
+!                                                                      
+        LCL=KLCL                                                      
+        LET=LCL                                                            
+!                                                                         
+!*******************************************************************     
+!                                                                  *    
+!                 COMPUTE UPDRAFT PROPERTIES                       *   
+!                                                                  *  
+!******************************************************************* 
+!                                                                   
+!                                                                  
+!...ESTIMATE INITIAL UPDRAFT MASS FLUX (UMF(K))...                
+!                                                                
+        WU(K)=WLCL                                                          
+        AU0=PIE*RAD*RAD                                                    
+        UMF(K)=RHOLCL*AU0                                                 
+        VMFLCL=UMF(K)                                                    
+        UPOLD=VMFLCL                                                    
+        UPNEW=UPOLD                                                    
+!                                                                     
+!...RATIO2 IS THE DEGREE OF GLACIATION IN THE CLOUD (0 TO 1),        
+!...UER IS THE ENVIR ENTRAINMENT RATE, ABE IS AVAILABLE BUOYANT ENERGY,   
+!   TRPPT IS THE TOTAL RATE OF PRECIPITATION PRODUCTION...               
+!                                                                         
+        RATIO2(K)=0.                                                    
+        UER(K)=0.                                                      
+        ABE=0.                                                        
+        TRPPT=0.                                                     
+        TU(K)=TLCL                                                  
+        TVU(K)=TVLCL                                               
+        QU(K)=QMIX                                                
+        EQFRC(K)=1.                                              
+        QLIQ(K)=0.                                              
+        QICE(K)=0.                                             
+        QLQOUT(K)=0.                                          
+        QICOUT(K)=0.                                         
+        DETLQ(K)=0.                                         
+        DETIC(K)=0.                                        
+        PPTLIQ(K)=0.                                     
+        PPTICE(K)=0.                                    
+        IFLAG=0                                        
+        KFRZ=LC                                       
+!                                                    
+!...THE AMOUNT OF CONV AVAIL POT ENERGY (CAPE) IS CALCULATED WITH   
+!   RESPECT TO UNDILUTE PARCEL ASCENT; EQ POT TEMP OF UNDILUTE     
+!   PARCEL IS THTUDL, UNDILUTE TEMPERATURE IS GIVEN BY TUDL...    
+!                                                                
+        THTUDL=THETEU(K)                                        
+        TUDL=TLCL                                              
+!                                                             
+!...TTEMP IS USED DURING CALCULATION OF THE LINEAR GLACIATION        
+!   PROCESS; IT IS INITIALLY SET TO THE TEMPERATURE AT WHICH        
+!   FREEZING IS SPECIFIED TO BEGIN.  WITHIN THE GLACIATION         
+!   INTERVAL, IT IS SET EQUAL TO THE UPDRAFT TEMP AT THE          
+!   PREVIOUS MODEL LEVEL...                                      
+!                                                               
+        TTEMP=TTFRZ                                                   
+!                                                                    
+!...ENTER THE LOOP FOR UPDRAFT CALCULATIONS...CALCULATE UPDRAFT TEMP,    
+!   MIXING RATIO, VERTICAL MASS FLUX, LATERAL DETRAINMENT OF MASS AND   
+!   MOISTURE, PRECIPITATION RATES AT EACH MODEL LEVEL...               
+!                                                                     
+        DO 60 NK=K,KL-1
+          NK1=NK+1                                                         
+          RATIO2(NK1)=RATIO2(NK)                                          
+!                                                                        
+!...UPDATE UPDRAFT PROPERTIES AT THE NEXT MODEL LVL TO REFLECT          
+!   ENTRAINMENT OF ENVIRONMENTAL AIR...                                     
+!                                                                          
+          FRC1=0.                                                         
+          TU(NK1)=T0(NK1)                                                
+          THETEU(NK1)=THETEU(NK)                                        
+          QU(NK1)=QU(NK)                                               
+          QLIQ(NK1)=QLIQ(NK)                                          
+          QICE(NK1)=QICE(NK)                                         
+
+          CALL TPMIX(P0(NK1),THETEU(NK1),TU(NK1),QU(NK1),QLIQ(NK1), & 
+               QICE(NK1),QNEWLQ,QNEWIC,RATIO2(NK1),RL,XLV0,XLV1,XLS0, &
+               XLS1,EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE)        
+          TVU(NK1)=TU(NK1)*(1.+0.608*QU(NK1))                      
+!                                                                 
+!...CHECK TO SEE IF UPDRAFT TEMP IS WITHIN THE FREEZING INTERVAL,
+!   IF IT IS, CALCULATE THE FRACTIONAL CONVERSION TO GLACIATION     
+!   AND ADJUST QNEWLQ TO REFLECT THE GRADUAL CHANGE IN THETAU      
+!   SINCE THE LAST MODEL LEVEL...THE GLACIATION EFFECTS WILL BE   
+!   DETERMINED AFTER THE AMOUNT OF CONDENSATE AVAILABLE AFTER    
+!   PRECIP FALLOUT IS DETERMINED...TTFRZ IS THE TEMP AT WHICH   
+!   GLACIATION BEGINS, TBFRZ THE TEMP AT WHICH IT ENDS...     
+!                                                            
+          IF(TU(NK1).LE.TTFRZ.AND.IFLAG.LT.1)THEN                    
+            IF(TU(NK1).GT.TBFRZ)THEN                                
+              IF(TTEMP.GT.TTFRZ)TTEMP=TTFRZ                        
+              FRC1=(TTEMP-TU(NK1))/(TTFRZ-TBFRZ)                  
+              R1=(TTEMP-TU(NK1))/(TTEMP-TBFRZ)                   
+            ELSE                                                
+              FRC1=(TTEMP-TBFRZ)/(TTFRZ-TBFRZ)                
+              R1=1.                                          
+              IFLAG=1                                       
+            ENDIF                                          
+            QNWFRZ=QNEWLQ                                 
+            QNEWIC=QNEWIC+QNEWLQ*R1*0.5                  
+            QNEWLQ=QNEWLQ-QNEWLQ*R1*0.5                 
+            EFFQ=(TTFRZ-TBFRZ)/(TTEMP-TBFRZ)           
+            TTEMP=TU(NK1)                             
+          ENDIF                                      
+!                                                  
+!  CALCULATE UPDRAFT VERTICAL VELOCITY AND PRECIPITATION FALLOUT...  
+!                                                                   
+          IF(NK.EQ.K)THEN                                          
+            BE=(TVLCL+TVU(NK1))/(TVEN+TV0(NK1))-1.                
+            BOTERM=2.*(Z0(NK1)-ZLCL)*G*BE/1.5                    
+            ENTERM=0.                                           
+            DZZ=Z0(NK1)-ZLCL                                   
+          ELSE                                                
+            BE=(TVU(NK)+TVU(NK1))/(TV0(NK)+TV0(NK1))-1.      
+            BOTERM=2.*DZA(NK)*G*BE/1.5                                        
+            ENTERM=2.*UER(NK)*WTW/UPOLD                                      
+            DZZ=DZA(NK)                                                     
+          ENDIF                                                            
+          WSQ=WTW                                                         
+          CALL CONDLOAD(QLIQ(NK1),QICE(NK1),WTW,DZZ,BOTERM,ENTERM,RATE, & 
+               QNEWLQ,QNEWIC,QLQOUT(NK1),QICOUT(NK1), G)                    
+                                                              
+!...IF VERT VELOCITY IS LESS THAN ZERO, EXIT THE UPDRAFT LOOP AND,     
+!   IF CLOUD IS TALL ENOUGH, FINALIZE UPDRAFT CALCULATIONS...         
+!                                                                    
+          IF(WTW.LE.0.)GOTO 65                                      
+          WABS=SQRT(ABS(WTW))                                      
+          WU(NK1)=WTW/WABS                                        
+!                                                                
+!  UPDATE THE ABE FOR UNDILUTE ASCENT...                        
+!                                                                         
+          THTES(NK1)=T0(NK1)*(1.E5/P0(NK1))**(0.2854*(1.-0.28*QES(NK1))) & 
+                     *                                                   &
+                     EXP((3374.6525/T0(NK1)-2.5403)*QES(NK1)*(1.+0.81*   &
+                     QES(NK1)))                                          
+          UDLBE=((2.*THTUDL)/(THTES(NK)+THTES(NK1))-1.)*DZZ             
+          IF(UDLBE.GT.0.)ABE=ABE+UDLBE*G                               
+!                                                                     
+!  DETERMINE THE EFFECTS OF CLOUD GLACIATION IF WITHIN THE SPECIFIED 
+!  TEMP INTERVAL...                                                 
+!                                                                  
+          IF(FRC1.GT.1.E-6)THEN                                   
+            CALL DTFRZNEW(TU(NK1),P0(NK1),THETEU(NK1),QU(NK1),QLIQ(NK1), & 
+                 QICE(NK1),RATIO2(NK1),TTFRZ,TBFRZ,QNWFRZ,RL,FRC1,EFFQ,  &
+                 IFLAG,XLV0,XLV1,XLS0,XLS1,EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE &  
+                 ,CICE,DICE)                                     
+          ENDIF                                                 
+!                                                              
+!  CALL SUBROUTINE TO CALCULATE ENVIRONMENTAL EQUIVALENT POTENTIAL TEMP.      
+!  WITHIN GLACIATION INTERVAL, THETAE MUST BE CALCULATED WITH RESPECT TO     
+!  SAME DEGREE OF GLACIATION FOR ALL ENTRAINING AIR...                      
+!                                                                          
+          CALL ENVIRTHT(P0(NK1),T0(NK1),Q0(NK1),THETEE(NK1),RATIO2(NK1), &
+               RL,EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE)                
+                                                                         
+!...REI IS THE RATE OF ENVIRONMENTAL INFLOW...                          
+!                                                                      
+          REI=VMFLCL*DP(NK1)*0.03/RAD                                 
+          TVQU(NK1)=TU(NK1)*(1.+0.608*QU(NK1)-QLIQ(NK1)-QICE(NK1))   
+!                                                                   
+!...IF CLOUD PARCELS ARE VIRTUALLY COLDER THAN THE ENVIRONMENT, NO 
+!   ENTRAINMENT IS ALLOWED AT THIS LEVEL...                               
+!                                                                        
+          IF(TVQU(NK1).LE.TV0(NK1))THEN                                 
+            UER(NK1)=0.0                                               
+            UDR(NK1)=REI                                              
+            EE2=0.                                                   
+            UD2=1.                                                  
+            EQFRC(NK1)=0.                                          
+            GOTO 55                                                        
+          ENDIF                                                          
+          LET=NK1                                                       
+          TTMP=TVQU(NK1)                                               
+!                                                                          
+!...DETERMINE THE CRITICAL MIXED FRACTION OF UPDRAFT AND ENVIRONMENTAL    
+!   AIR FOR ESTIMATION OF ENTRAINMENT AND DETRAINMENT RATES...           
+!                                                                       
+          F1=0.95                                                      
+          F2=1.-F1                                                    
+          THTTMP=F1*THETEE(NK1)+F2*THETEU(NK1)                       
+          QTMP=F1*Q0(NK1)+F2*QU(NK1)                                
+          TMPLIQ=F2*QLIQ(NK1)                                      
+          TMPICE=F2*QICE(NK1)                                                
+          CALL TPMIX(P0(NK1),THTTMP,TTMP,QTMP,TMPLIQ,TMPICE,QNEWLQ,      & 
+               QNEWIC,RATIO2(NK1),RL,XLV0,XLV1,XLS0,XLS1,EP2,ALIQ,BLIQ,CLIQ, &
+               DLIQ,AICE,BICE,CICE,DICE)                                    
+          TU95=TTMP*(1.+0.608*QTMP-TMPLIQ-TMPICE)                          
+          IF(TU95.GT.TV0(NK1))THEN                                        
+            EE2=1.                                                       
+            UD2=0.                                                      
+            EQFRC(NK1)=1.0                                             
+            GOTO 50                                                   
+          ENDIF                                                              
+          F1=0.10                                                           
+          F2=1.-F1                                                         
+          THTTMP=F1*THETEE(NK1)+F2*THETEU(NK1)                            
+          QTMP=F1*Q0(NK1)+F2*QU(NK1)                                    
+          TMPLIQ=F2*QLIQ(NK1)                                            
+          TMPICE=F2*QICE(NK1)                                               
+          CALL TPMIX(P0(NK1),THTTMP,TTMP,QTMP,TMPLIQ,TMPICE,QNEWLQ,      & 
+               QNEWIC,RATIO2(NK1),RL,XLV0,XLV1,XLS0,XLS1,EP2,ALIQ,BLIQ,CLIQ, &
+               DLIQ,AICE,BICE,CICE,DICE)                                   
+          TU10=TTMP*(1.+0.608*QTMP-TMPLIQ-TMPICE)                         
+          IF(TU10.EQ.TVQU(NK1))THEN                                      
+            EE2=1.                                                      
+            UD2=0.                                                     
+            EQFRC(NK1)=1.0                                            
+            GOTO 50                                                  
+          ENDIF                                                     
+          EQFRC(NK1)=(TV0(NK1)-TVQU(NK1))*F1/(TU10-TVQU(NK1))      
+          EQFRC(NK1)=AMAX1(0.0,EQFRC(NK1))                        
+          EQFRC(NK1)=AMIN1(1.0,EQFRC(NK1))                       
+          IF(EQFRC(NK1).EQ.1)THEN                               
+            EE2=1.                                             
+            UD2=0.                                            
+            GOTO 50                                          
+          ELSEIF(EQFRC(NK1).EQ.0.)THEN                                       
+            EE2=0.                                                          
+            UD2=1.                                                         
+            GOTO 50                                                       
+          ELSE                                                           
+!                                                                       
+!...SUBROUTINE PROF5 INTEGRATES OVER THE GAUSSIAN DIST TO DETERMINE THE
+!   FRACTIONAL ENTRAINMENT AND DETRAINMENT RATES...                   
+!                                                                    
+            CALL PROF5(EQFRC(NK1),EE2,UD2)                          
+          ENDIF                                                    
+!                                                                 
+   50     IF(NK.EQ.K)THEN                                        
+            EE1=1.                                              
+            UD1=0.                                             
+          ENDIF                                               
+!                                                            
+!...NET ENTRAINMENT AND DETRAINMENT RATES ARE GIVEN BY THE AVERAGE         
+!   FRACTIONAL VALUES IN THE LAYER...                                     
+!                                                                        
+          UER(NK1)=0.5*REI*(EE1+EE2)                                    
+          UDR(NK1)=0.5*REI*(UD1+UD2)                                   
+!                                                                     
+!...IF THE CALCULATED UPDRAFT DETRAINMENT RATE IS GREATER THAN THE TOTAL  
+!   UPDRAFT MASS FLUX, ALL CLOUD MASS DETRAINS, EXIT UPDRAFT CALCULATION    
+!                                                                          
+   55     IF(UMF(NK)-UDR(NK1).LT.10.)THEN                                
+!                                                                       
+!...IF THE CALCULATED DETRAINED MASS FLUX IS GREATER THAN THE TOTAL    
+!   UPDRAFT FLUX, IMPOSE TOTAL DETRAINMENT OF UPDRAFT MASS AT THE     
+!   PREVIOUS MODEL                                                   
+!                                                                   
+            IF(UDLBE.GT.0.)ABE=ABE-UDLBE*G                         
+            LET=NK                                                
+!         WRITE(98,1015)P0(NK1)/100.                                 
+            GOTO 65                                                 
+          ENDIF                                                    
+          EE1=EE2                                                 
+          UD1=UD2                                                
+          UPOLD=UMF(NK)-UDR(NK1)                                
+          UPNEW=UPOLD+UER(NK1)                                 
+          UMF(NK1)=UPNEW                                      
+!                                                            
+!...DETLQ AND DETIC ARE THE RATES OF DETRAINMENT OF LIQUID AND ICE IN 
+!   THE DETRAINING UPDRAFT MASS...                                   
+!                                                                   
+          DETLQ(NK1)=QLIQ(NK1)*UDR(NK1)                            
+          DETIC(NK1)=QICE(NK1)*UDR(NK1)                           
+          QDT(NK1)=QU(NK1)                                       
+          QU(NK1)=(UPOLD*QU(NK1)+UER(NK1)*Q0(NK1))/UPNEW        
+          THETEU(NK1)=(THETEU(NK1)*UPOLD+THETEE(NK1)*UER(NK1))/UPNEW  
+          QLIQ(NK1)=QLIQ(NK1)*UPOLD/UPNEW                            
+          QICE(NK1)=QICE(NK1)*UPOLD/UPNEW                           
+!                                                                  
+!...KFRZ IS THE HIGHEST MODEL LEVEL AT WHICH LIQUID CONDENSATE IS 
+!   GENERATING PPTLIQ IS THE RATE OF GENERATION (FALLOUT) OF LIQUID     
+!   PRECIP AT A GIVING MODEL LVL, PPTICE THE SAME FOR ICE, TRPPT IS    
+!   THE TOTAL RATE OF PRODUCTION OF PRECIP UP TO THE CURRENT MODEL LEVEL 
+!                                                                       
+          IF(ABS(RATIO2(NK1)-1.).GT.1.E-6)KFRZ=NK1                     
+          PPTLIQ(NK1)=QLQOUT(NK1)*(UMF(NK)-UDR(NK1))                  
+          PPTICE(NK1)=QICOUT(NK1)*(UMF(NK)-UDR(NK1))                 
+          TRPPT=TRPPT+PPTLIQ(NK1)+PPTICE(NK1)                       
+          IF(NK1.LE.KPBL)UER(NK1)=UER(NK1)+VMFLCL*DP(NK1)/DPTHMX   
+   60   CONTINUE                                                  
+!                                                                
+!...CHECK CLOUD DEPTH...IF CLOUD IS TALL ENOUGH, ESTIMATE THE EQUILIBRIU
+!   TEMPERATURE LEVEL (LET) AND ADJUST MASS FLUX PROFILE AT CLOUD TOP SO
+!   THAT MASS FLUX DECREASES TO ZERO AS A LINEAR FUNCTION OF PRESSURE  
+!   BETWEEN THE LET AND CLOUD TOP...                                  
+!                                                                    
+!...LTOP IS THE MODEL LEVEL JUST BELOW THE LEVEL AT WHICH VERTICAL  
+!   VELOCITY FIRST BECOMES NEGATIVE...                             
+!                                                                 
+   65   LTOP=NK                                                  
+        CLDHGT=Z0(LTOP)-ZLCL                                    
+!                                                              
+!...IF CLOUD TOP HGT IS LESS THAN SPECIFIED MINIMUM HEIGHT, GO BACK AND 
+!   THE NEXT HIGHEST 60MB LAYER TO SEE IF A BIGGER CLOUD CAN BE OBTAINED
+!   THAT SOURCE AIR...                                                 
+!                                                                     
+!       IF(CLDHGT.LT.4.E3.OR.ABE.LT.1.)THEN                          
+        IF(CLDHGT.LT.3.E3.OR.ABE.LT.1.)THEN                         
+          DO 70 NK=K,LTOP                                          
+            UMF(NK)=0.                                            
+            UDR(NK)=0.                                           
+            UER(NK)=0.                                          
+            DETLQ(NK)=0.                                       
+            DETIC(NK)=0.                                      
+            PPTLIQ(NK)=0.                                    
+   70     PPTICE(NK)=0.                                     
+          GOTO 25                                          
+        ENDIF                                             
+!                                                                    
+!...IF THE LET AND LTOP ARE THE SAME, DETRAIN ALL OF THE UPDRAFT MASS 
+!   FLUX THIS LEVEL...                                               
+!                                                                   
+        IF(LET.EQ.LTOP)THEN                                        
+          UDR(LTOP)=UMF(LTOP)+UDR(LTOP)-UER(LTOP)                 
+          DETLQ(LTOP)=QLIQ(LTOP)*UDR(LTOP)*UPNEW/UPOLD           
+          DETIC(LTOP)=QICE(LTOP)*UDR(LTOP)*UPNEW/UPOLD          
+          TRPPT=TRPPT-(PPTLIQ(LTOP)+PPTICE(LTOP))              
+          UER(LTOP)=0.                                        
+          UMF(LTOP)=0.                                       
+          GOTO 85                                           
+        ENDIF                                              
+!                                                         
+!   BEGIN TOTAL DETRAINMENT AT THE LEVEL ABOVE THE LET...
+!                                                       
+        DPTT=0.                                        
+        DO 71 NJ=LET+1,LTOP                           
+   71   DPTT=DPTT+DP(NJ)                             
+        DUMFDP=UMF(LET)/DPTT                        
+!                                                  
+!...ADJUST MASS FLUX PROFILES, DETRAINMENT RATES, AND PRECIPITATION FALL 
+!   RATES TO REFLECT THE LINEAR DECREASE IN MASS FLX BETWEEN THE LET AND 
+!   PTOP                                                                
+!                                                                      
+        DO 75 NK=LET+1,LTOP                                           
+          UDR(NK)=DP(NK)*DUMFDP                                      
+          UMF(NK)=UMF(NK-1)-UDR(NK)                                 
+          DETLQ(NK)=QLIQ(NK)*UDR(NK)                               
+          DETIC(NK)=QICE(NK)*UDR(NK)                              
+          TRPPT=TRPPT-PPTLIQ(NK)-PPTICE(NK)                      
+          PPTLIQ(NK)=(UMF(NK-1)-UDR(NK))*QLQOUT(NK)             
+          PPTICE(NK)=(UMF(NK-1)-UDR(NK))*QICOUT(NK)            
+          TRPPT=TRPPT+PPTLIQ(NK)+PPTICE(NK)                   
+   75   CONTINUE                                             
+!                                                           
+!...SEND UPDRAFT CHARACTERISTICS TO OUTPUT FILES...        
+!                                                         
+   85   CONTINUE                                         
+!                                                       
+!...EXTEND THE UPDRAFT MASS FLUX PROFILE DOWN TO THE SOURCE LAYER FOR 
+!   THE UPDRAFT AIR...ALSO, DEFINE THETAE FOR LEVELS BELOW THE LCL...
+!                                                                   
+        DO 90 NK=1,K                                               
+          IF(NK.GE.LC)THEN                                        
+            IF(NK.EQ.LC)THEN                                     
+              UMF(NK)=VMFLCL*DP(NK)/DPTHMX                      
+              UER(NK)=VMFLCL*DP(NK)/DPTHMX                     
+            ELSEIF(NK.LE.KPBL)THEN                            
+              UER(NK)=VMFLCL*DP(NK)/DPTHMX                   
+              UMF(NK)=UMF(NK-1)+UER(NK)                     
+            ELSE                                         
+              UMF(NK)=VMFLCL                               
+              UER(NK)=0.                                
+            ENDIF                                         
+            TU(NK)=TMIX+(Z0(NK)-ZMIX)*GDRY             
+            QU(NK)=QMIX                               
+            WU(NK)=WLCL                              
+          ELSE                                      
+            TU(NK)=0.                              
+            QU(NK)=0.                                                      
+            UMF(NK)=0.                                                    
+            WU(NK)=0.                                                    
+            UER(NK)=0.                                                  
+          ENDIF                                                        
+          UDR(NK)=0.                                                  
+          QDT(NK)=0.                                                 
+          QLIQ(NK)=0.                                               
+          QICE(NK)=0.                                              
+          QLQOUT(NK)=0.                                           
+          QICOUT(NK)=0.                                          
+          PPTLIQ(NK)=0.                                         
+          PPTICE(NK)=0.                                        
+          DETLQ(NK)=0.                                        
+          DETIC(NK)=0.                                       
+          RATIO2(NK)=0.                                    
+          EE=Q0(NK)*P0(NK)/(EP2+Q0(NK))                 
+          TLOG=ALOG(EE/ALIQ)                             
+          TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)             
+          TSAT=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(T0(NK)-T00))*( & 
+               T0(NK)-TDPT)                                                
+          THTA=T0(NK)*(1.E5/P0(NK))**(0.2854*(1.-0.28*Q0(NK)))            
+          THETEE(NK)=THTA*                                               & 
+                     EXP((3374.6525/TSAT-2.5403)*Q0(NK)*(1.+0.81*Q0(NK)) &
+                     )                                                   
+          THTES(NK)=THTA*                                                &
+                    EXP((3374.6525/T0(NK)-2.5403)*QES(NK)*(1.+0.81*      &
+                    QES(NK)))                          
+          EQFRC(NK)=1.0                               
+   90   CONTINUE                                     
+!                                                   
+        LTOP1=LTOP+1                               
+        LTOPM1=LTOP-1                              
+!                                                  
+!...DEFINE VARIABLES ABOVE CLOUD TOP...            
+!                                                             
+        DO 95 NK=LTOP1,KX                                    
+          UMF(NK)=0.                                        
+          UDR(NK)=0.                                       
+          UER(NK)=0.                                      
+          QDT(NK)=0.                                     
+          QLIQ(NK)=0.                                                     
+          QICE(NK)=0.                                                    
+          QLQOUT(NK)=0.                                                 
+          QICOUT(NK)=0.                                                
+          DETLQ(NK)=0.                                                
+          DETIC(NK)=0.                                               
+          PPTLIQ(NK)=0.                                             
+          PPTICE(NK)=0.                                            
+          IF(NK.GT.LTOP1)THEN                                     
+            TU(NK)=0.                                            
+            QU(NK)=0.                                           
+            WU(NK)=0.                                          
+          ENDIF                                              
+          THTA0(NK)=0.                                      
+          THTAU(NK)=0.                                     
+          EMS(NK)=DP(NK)*DXSQ/G                           
+          EMSD(NK)=1./EMS(NK)                            
+          TG(NK)=T0(NK)                                 
+          QG(NK)=Q0(NK)                                
+          QLG(NK)=0.                                  
+          QIG(NK)=0.                                 
+          QRG(NK)=0.                                
+          QSG(NK)=0.                               
+   95   OMG(NK)=0.                                 
+        OMG(KL+1)=0.                               
+        P150=P0(KLCL)-1.50E4                       
+        DO 100 NK=1,LTOP                           
+          THTAD(NK)=0.                             
+          EMS(NK)=DP(NK)*DXSQ/G                   
+          EMSD(NK)=1./EMS(NK)                      
+!                                                  
+!...INITIALIZE SOME VARIABLES TO BE USED LATER IN THE VERT ADVECTION 
+!   SCHEME                                                          
+!                                                                  
+          EXN(NK)=(P00/P0(NK))**(0.2854*(1.-0.28*QDT(NK)))        
+          THTAU(NK)=TU(NK)*EXN(NK)                               
+          EXN(NK)=(P00/P0(NK))**(0.2854*(1.-0.28*Q0(NK)))       
+          THTA0(NK)=T0(NK)*EXN(NK)                             
+!                                                             
+!...LVF IS THE LEVEL AT WHICH MOISTURE FLUX IS ESTIMATED AS THE BASIS 
+!...FOR PRECIPITATION EFFICIENCY CALCULATIONS...                     
+!                                                                        
+          IF(P0(NK).GT.P150)LVF=NK                                      
+  100   OMG(NK)=0.                                                     
+        LVF=MIN0(LVF,LET)                                             
+        USR=UMF(LVF+1)*(QU(LVF+1)+QLIQ(LVF+1)+QICE(LVF+1))           
+        USR=AMIN1(USR,TRPPT)                                        
+        IF(USR.LT.1.E-8)USR=TRPPT
+!                                                                  
+!     WRITE(98,1025)KLCL,ZLCL,DTLCL,LTOP,P0(LTOP),IFLAG,          
+!    * TMIX-T00,PMIX,QMIX,ABE                                    
+!     WRITE(98,1030)P0(LET)/100.,P0(LTOP)/100.,VMFLCL,PLCL/100.,
+!    * WLCL,CLDHGT                                             
+!                                                             
+!...COMPUTE CONVECTIVE TIME SCALE(TIMEC). THE MEAN WIND AT THE LCL     
+!...AND MIDTROPOSPHERE IS USED.                                       
+!                                                                    
+        WSPD(KLCL)=SQRT(U0(KLCL)*U0(KLCL)+V0(KLCL)*V0(KLCL))        
+        WSPD(L5)=SQRT(U0(L5)*U0(L5)+V0(L5)*V0(L5))                 
+        WSPD(LTOP)=SQRT(U0(LTOP)*U0(LTOP)+V0(LTOP)*V0(LTOP))      
+        VCONV=.5*(WSPD(KLCL)+WSPD(L5))                           
+        if (VCONV .gt. 0.) then
+           TIMEC=DX/VCONV
+        else
+           TIMEC=3600.
+        endif
+!       TIMEC=DX/VCONV
+        TADVEC=TIMEC                                           
+        TIMEC=AMAX1(1800.,TIMEC)                              
+        TIMEC=AMIN1(3600.,TIMEC)                             
+        NIC=NINT(TIMEC/DT)                            
+        TIMEC=FLOAT(NIC)*DT                            
+!                                                         
+!...COMPUTE WIND SHEAR AND PRECIPITATION EFFICIENCY.     
+!                                                       
+!        SHSIGN = CVMGT(1.,-1.,WSPD(LTOP).GT.WSPD(KLCL))
+        IF(WSPD(LTOP).GT.WSPD(KLCL))THEN               
+          SHSIGN=1.                                   
+        ELSE                                         
+          SHSIGN=-1.                                
+        ENDIF                                      
+        VWS=(U0(LTOP)-U0(KLCL))*(U0(LTOP)-U0(KLCL))+(V0(LTOP)-V0(KLCL))* & 
+            (V0(LTOP)-V0(KLCL))                                         
+        VWS=1.E3*SHSIGN*SQRT(VWS)/(Z0(LTOP)-Z0(LCL))                   
+        PEF=1.591+VWS*(-.639+VWS*(9.53E-2-VWS*4.96E-3))               
+        PEF=AMAX1(PEF,.2)                                            
+        PEF=AMIN1(PEF,.9)                                           
+!                                                                  
+!...PRECIPITATION EFFICIENCY IS A FUNCTION OF THE HEIGHT OF CLOUD BASE. 
+!                                                                      
+        CBH=(ZLCL-Z0(1))*3.281E-3                                     
+        IF(CBH.LT.3.)THEN                                            
+          RCBH=.02                                                  
+        ELSE                                                       
+          RCBH=.96729352+CBH*(-.70034167+CBH*(.162179896+CBH*(-  & 
+               1.2569798E-2+CBH*(4.2772E-4-CBH*5.44E-6))))    
+        ENDIF                                                
+        IF(CBH.GT.25)RCBH=2.4                               
+        PEFCBH=1./(1.+RCBH)                                
+        PEFCBH=AMIN1(PEFCBH,.9)                           
+!                                                        
+!... MEAN PEF. IS USED TO COMPUTE RAINFALL.                           
+!                                                                    
+        PEFF=.5*(PEF+PEFCBH)                                        
+        PEFF2=PEFF                                                 
+!        WRITE(98,1035)PEF,PEFCBH,LC,LET,WKL,VWS                  
+!                                                                
+!*****************************************************************   
+!                                                                *  
+!                  COMPUTE DOWNDRAFT PROPERTIES                  * 
+!                                                                *
+!*****************************************************************         
+!                                                                         
+!...LET DOWNDRAFT ORIGINATE AT THE LEVEL OF MINIMUM SATURATION EQUIVALEN 
+!...POTENTIAL TEMPERATURE (SEQT) IN THE CLOUD LAYER, EXTEND DOWNWARD TO 
+!...SURFACE, OR TO THE LAYER BELOW CLOUD BASE AT WHICH ENVIR SEQT IS LES    
+!...THAN MIN SEQT IN THE CLOUD LAYER...LET DOWNDRAFT DETRAIN OVER A LAYE   
+!...OF SPECIFIED PRESSURE-DEPTH (DPDD)...                                 
+!                                                                       
+        TDER=0.                                                        
+        KSTART=MAX0(KPBL,KLCL)                                        
+        THTMIN=THTES(KSTART+1)                                       
+        KMIN=KSTART+1                                               
+        DO 104 NK=KSTART+2,LTOP-1                                  
+          THTMIN=AMIN1(THTMIN,THTES(NK))                          
+          IF(THTMIN.EQ.THTES(NK))KMIN=NK                         
+  104   CONTINUE                                                
+        LFS=KMIN                                               
+        IF(RATIO2(LFS).GT.0.)CALL ENVIRTHT(P0(LFS),T0(LFS),Q0(LFS),     &
+          THETEE(LFS),0.,RL,EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE)   
+        EQFRC(LFS)=(THTES(LFS)-THETEU(LFS))/(THETEE(LFS)-THETEU(LFS)) 
+        EQFRC(LFS)=AMAX1(EQFRC(LFS),0.)                              
+        EQFRC(LFS)=AMIN1(EQFRC(LFS),1.)                             
+        THETED(LFS)=THTES(LFS)                                     
+!                                                                 
+!...ESTIMATE THE EFFECT OF MELTING PRECIPITATION IN THE DOWNDRAFT...   
+!                                                                            
+        IF(ML.GT.0)THEN                                                    
+          DTMLTD=0.5*(QU(KLCL)-QU(LTOP))*RLF/CP                          
+        ELSE                                                            
+          DTMLTD=0.                                                    
+        ENDIF                                                         
+        TZ(LFS)=T0(LFS)-DTMLTD                                       
+        ES=ALIQ*EXP((TZ(LFS)*BLIQ-CLIQ)/(TZ(LFS)-DLIQ))             
+        QS=EP2*ES/(P0(LFS)-ES)                                   
+        QD(LFS)=EQFRC(LFS)*Q0(LFS)+(1.-EQFRC(LFS))*QU(LFS)             
+        THTAD(LFS)=TZ(LFS)*(P00/P0(LFS))**(0.2854*(1.-0.28*QD(LFS)))     
+        IF(QD(LFS).GE.QS)THEN                                           
+          THETED(LFS)=THTAD(LFS)*                                       & 
+                      EXP((3374.6525/TZ(LFS)-2.5403)*QS*(1.+0.81*QS))  
+        ELSE                                                          
+          CALL ENVIRTHT(P0(LFS),TZ(LFS),QD(LFS),THETED(LFS),0.,RL,EP2,ALIQ, & 
+               BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE)                   
+        ENDIF                                                       
+        DO 107 NK=1,LFS                                            
+          ND=LFS-NK                                             
+          IF(THETED(LFS).GT.THTES(ND).OR.ND.EQ.1)THEN          
+            LDB=ND                                            
+!                                                            
+!...IF DOWNDRAFT NEVER BECOMES NEGATIVELY BUOYANT OR IF IT  
+!...IS SHALLOWER 50 mb, DON'T ALLOW IT TO OCCUR AT ALL...             
+!                                                                    
+            IF(NK.EQ.1.OR.(P0(LDB)-P0(LFS)).LT.50.E2)GOTO 141       
+! testing ---- no downdraft
+!           GOTO 141       
+            GOTO 110                                               
+          ENDIF                                                   
+  107   CONTINUE                                                 
+!                                                               
+!...ALLOW DOWNDRAFT TO DETRAIN IN A SINGLE LAYER, BUT WITH DOWNDRAFT AIR 
+!...TYPICALLY FLUSHED UP INTO HIGHER LAYERS AS ALLOWED IN THE TOTAL     
+!...VERTICAL ADVECTION CALCULATIONS FARTHER DOWN IN THE CODE...        
+!                                                                     
+  110   DPDD=DP(LDB)                                                 
+        LDT=LDB                                                     
+        FRC=1.                                                     
+        DPT=0.                                                              
+!      DO 115 NK=LDB,LFS                                                   
+!        DPT=DPT+DP(NK)                                                   
+!        IF(DPT.GT.DPDD)THEN                                             
+!          LDT=NK                                                       
+!          FRC=(DPDD+DP(NK)-DPT)/DP(NK)                                
+!          GOTO 120                                                   
+!        ENDIF                                                       
+!        IF(NK.EQ.LFS-1)THEN                                        
+!         LDT=NK                                                   
+!        FRC=1.                                                   
+!        DPDD=DPT                                                
+!        GOTO 120                                               
+!        ENDIF                                                 
+!115   CONTINUE                                               
+  120   CONTINUE                                             
+!                                                           
+!...TAKE A FIRST GUESS AT THE INITIAL DOWNDRAFT MASS FLUX..
+!                                                         
+        TVD(LFS)=T0(LFS)*(1.+0.608*QES(LFS))             
+        RDD=P0(LFS)/(R*TVD(LFS))                        
+        A1=(1.-PEFF)*AU0                               
+        DMF(LFS)=-A1*RDD                              
+        DER(LFS)=EQFRC(LFS)*DMF(LFS)                 
+        DDR(LFS)=0.                                 
+        DO 140 ND=LFS-1,LDB,-1                     
+          ND1=ND+1                                 
+          IF(ND.LE.LDT)THEN                        
+            DER(ND)=0.                                              
+            DDR(ND)=-DMF(LDT+1)*DP(ND)*FRC/DPDD                    
+            DMF(ND)=DMF(ND1)+DDR(ND)                              
+            FRC=1.                                               
+            THETED(ND)=THETED(ND1)                              
+            QD(ND)=QD(ND1)                                     
+          ELSE                                                
+            DER(ND)=DMF(LFS)*0.03*DP(ND)/RAD                 
+            DDR(ND)=0.                                      
+            DMF(ND)=DMF(ND1)+DER(ND)                       
+            IF(RATIO2(ND).GT.0.)CALL ENVIRTHT(P0(ND),T0(ND),Q0(ND),      & 
+              THETEE(ND),0.,RL,EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE)   
+            THETED(ND)=(THETED(ND1)*DMF(ND1)+THETEE(ND)*DER(ND))/DMF(ND) 
+            QD(ND)=(QD(ND1)*DMF(ND1)+Q0(ND)*DER(ND))/DMF(ND)            
+          ENDIF                                                        
+  140   CONTINUE                                                      
+        TDER=0.                                                      
+!                                                                   
+!...CALCULATION AN EVAPORATION RATE FOR GIVEN MASS FLUX...        
+!                                                                
+        DO 135 ND=LDB,LDT                                       
+          TZ(ND)=                                                        & 
+                 TPDD(P0(ND),THETED(LDT),T0(ND),QS,QD(ND),1.0,XLV0,XLV1, &
+                 EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE)      
+          ES=ALIQ*EXP((TZ(ND)*BLIQ-CLIQ)/(TZ(ND)-DLIQ))        
+          QS=EP2*ES/(P0(ND)-ES)                             
+          DSSDT=(CLIQ-BLIQ*DLIQ)/((TZ(ND)-DLIQ)*(TZ(ND)-DLIQ))                
+          RL=XLV0-XLV1*TZ(ND)                                                
+          DTMP=RL*QS*(1.-RHBC)/(CP+RL*RHBC*QS*DSSDT)                        
+          T1RH=TZ(ND)+DTMP                                                 
+          ES=RHBC*ALIQ*EXP((BLIQ*T1RH-CLIQ)/(T1RH-DLIQ))                  
+          QSRH=EP2*ES/(P0(ND)-ES)                                      
+!                                                                       
+!...CHECK TO SEE IF MIXING RATIO AT SPECIFIED RH IS LESS THAN ACTUAL   
+!...MIXING RATIO...IF SO, ADJUST TO GIVE ZERO EVAPORATION...          
+!                                                                    
+          IF(QSRH.LT.QD(ND))THEN                                    
+            QSRH=QD(ND)                                            
+!          T1RH=T1+(QS-QSRH)*RL/CP                                
+            T1RH=TZ(ND)                                          
+          ENDIF                                                 
+          TZ(ND)=T1RH                                          
+          QS=QSRH                                             
+          TDER=TDER+(QS-QD(ND))*DDR(ND)                     
+          QD(ND)=QS                                                   
+  135   THTAD(ND)=TZ(ND)*(P00/P0(ND))**(0.2854*(1.-0.28*QD(ND)))         
+!                                                                       
+!...IF DOWNDRAFT DOES NOT EVAPORATE ANY WATER FOR SPECIFIED RELATIVE   
+!...HUMIDITY, NO DOWNDRAFT IS ALLOWED...                             
+!                                                                   
+  141   IF(TDER.LT.1.)THEN                                         
+!          WRITE(98,3004)I,J                                      
+ 3004       FORMAT(' ','I=',I3,2X,'J=',I3)                       
+          PPTFLX=TRPPT                                          
+          CPR=TRPPT                                            
+          TDER=0.                                             
+          CNDTNF=0.                                          
+          UPDINC=1.                                         
+          LDB=LFS                                          
+          DO 117 NDK=1,LTOP                               
+            DMF(NDK)=0.                                                    
+            DER(NDK)=0.                                  
+            DDR(NDK)=0.                                 
+            THTAD(NDK)=0.                              
+            WD(NDK)=0.                                
+            TZ(NDK)=0.                               
+  117     QD(NDK)=0.                                
+          AINCM2=100.                                                      
+          GOTO 165                                                        
+        ENDIF                                                            
+!                                                                       
+!...ADJUST DOWNDRAFT MASS FLUX SO THAT EVAPORATION RATE IN DOWNDRAFT IS
+!...CONSISTENT WITH PRECIPITATION EFFICIENCY RELATIONSHIP...          
+!                                                                    
+        DEVDMF=TDER/DMF(LFS)                                        
+        PPR=0.                                                     
+        PPTFLX=PEFF*USR                                           
+        RCED=TRPPT-PPTFLX                                        
+!                                                               
+!...PPR IS THE TOTAL AMOUNT OF PRECIPITATION THAT FALLS  OUT OF THE  
+!...UPDRAFT FROM CLOUD BASE TO THE LFS...UPDRAFT MASS FLUX WILL BE  
+!...INCREASED UP TO THE LFS TO ACCOUNT FOR UPDRAFT AIR MIXING WITH 
+!...ENVIRONMENTAL AIR TO THE UPDRAFT, SO PPR WILL INCREASE        
+!...PROPORTIONATELY...                                           
+!                                                               
+        DO 132 NM=KLCL,LFS                                     
+  132   PPR=PPR+PPTLIQ(NM)+PPTICE(NM)                         
+        IF(LFS.GE.KLCL)THEN                                  
+          DPPTDF=(1.-PEFF)*PPR*(1.-EQFRC(LFS))/UMF(LFS)     
+        ELSE                                               
+          DPPTDF=0.                                       
+        ENDIF                                            
+!                                                       
+!...CNDTNF IS THE AMOUNT OF CONDENSATE TRANSFERRED ALONG WITH UPDRAFT      
+!...MASS THE DOWNDRAFT AT THE LFS...                                      
+!                                                                        
+        CNDTNF=(QLIQ(LFS)+QICE(LFS))*(1.-EQFRC(LFS))                    
+        DMFLFS=RCED/(DEVDMF+DPPTDF+CNDTNF)                             
+        IF(DMFLFS.GT.0.)THEN                                         
+          TDER=0.                                                   
+          GOTO 141                                                 
+        ENDIF                                                     
+!                                                                
+!...DDINC IS THE FACTOR BY WHICH TO INCREASE THE FIRST-GUESS DOWNDRAFT    
+!...MASS FLUX TO SATISFY THE PRECIP EFFICIENCY RELATIONSHIP, UPDINC IS T 
+!...WHICH TO INCREASE THE UPDRAFT MASS FLUX BELOW THE LFS TO ACCOUNT FOR
+!...TRANSFER OF MASS FROM UPDRAFT TO DOWNDRAFT...                     
+!                                                                      
+!       DDINC=DMFLFS/DMF(LFS)                                        
+        IF(LFS.GE.KLCL)THEN                                         
+          UPDINC=(UMF(LFS)-(1.-EQFRC(LFS))*DMFLFS)/UMF(LFS)        
+!                                                                 
+!...LIMIT UPDINC TO LESS THAN OR EQUAL TO 1.5...                 
+!                                                                         
+          IF(UPDINC.GT.1.5)THEN                                          
+            UPDINC=1.5                                                  
+            DMFLFS2=UMF(LFS)*(UPDINC-1.)/(EQFRC(LFS)-1.)               
+            RCED2=DMFLFS2*(DEVDMF+DPPTDF+CNDTNF)                      
+            PPTFLX=PPTFLX+(RCED-RCED2)                               
+            PEFF2=PPTFLX/USR                                        
+            RCED=RCED2                                             
+            DMFLFS=DMFLFS2                                        
+          ENDIF                                                  
+        ELSE                                                    
+          UPDINC=1.                                            
+        ENDIF                                                 
+        DDINC=DMFLFS/DMF(LFS)                                
+        DO 149 NK=LDB,LFS                                   
+          DMF(NK)=DMF(NK)*DDINC                            
+          DER(NK)=DER(NK)*DDINC                           
+          DDR(NK)=DDR(NK)*DDINC                          
+  149   CONTINUE                                        
+        CPR=TRPPT+PPR*(UPDINC-1.)                      
+        PPTFLX=PPTFLX+PEFF*PPR*(UPDINC-1.)            
+        PEFF=PEFF2                                   
+        TDER=TDER*DDINC                             
+!                                                                          
+!...ADJUST UPDRAFT MASS FLUX, MASS DETRAINMENT RATE, AND LIQUID WATER AN  
+!   DETRAINMENT RATES TO BE CONSISTENT WITH THE TRANSFER OF THE ESTIMATE 
+!   FROM THE UPDRAFT TO THE DOWNDRAFT AT THE LFS...                    
+!                                                                     
+        DO 155 NK=LC,LFS                                             
+          UMF(NK)=UMF(NK)*UPDINC                                    
+          UDR(NK)=UDR(NK)*UPDINC                                   
+          UER(NK)=UER(NK)*UPDINC                                 
+          PPTLIQ(NK)=PPTLIQ(NK)*UPDINC                          
+          PPTICE(NK)=PPTICE(NK)*UPDINC                         
+          DETLQ(NK)=DETLQ(NK)*UPDINC                          
+  155   DETIC(NK)=DETIC(NK)*UPDINC                           
+!                                                           
+!...ZERO OUT THE ARRAYS FOR DOWNDRAFT DATA AT LEVELS ABOVE AND BELOW THE 
+!...DOWNDRAFT...                                                        
+!                                                                           
+        IF(LDB.GT.1)THEN                                                   
+          DO 156 NK=1,LDB-1                                               
+            DMF(NK)=0.                                                   
+            DER(NK)=0.                                                  
+            DDR(NK)=0.                                                 
+            WD(NK)=0.                                                 
+            TZ(NK)=0.                                                
+            QD(NK)=0.                                               
+            THTAD(NK)=0.                                           
+  156     CONTINUE                                                
+        ENDIF                                                    
+        DO 157 NK=LFS+1,KX                                      
+          DMF(NK)=0.                                           
+          DER(NK)=0.                                          
+          DDR(NK)=0.                                         
+          WD(NK)=0.                                         
+          TZ(NK)=0.                                        
+          QD(NK)=0.                                      
+          THTAD(NK)=0.                                  
+  157   CONTINUE                                       
+        DO 158 NK=LDT+1,LFS-1                         
+          TZ(NK)=0.                                  
+          QD(NK)=0.                                 
+  158   CONTINUE                                    
+!                                                                          
+!                                                                      
+!...SET LIMITS ON THE UPDRAFT AND DOWNDRAFT MASS FLUXES SO THAT THE   
+!   INFLOW INTO CONVECTIVE DRAFTS FROM A GIVEN LAYER IS NO MORE THAN 
+!   IS AVAILABLE IN THAT LAYER INITIALLY...                         
+!                                                                  
+  165   AINCMX=1000.                                              
+        LMAX=MAX0(KLCL,LFS)                                      
+        DO 166 NK=LC,LMAX                                       
+          IF((UER(NK)-DER(NK)).GT.0.)AINCM1=EMS(NK)/((UER(NK)-DER(NK))* & 
+            TIMEC)                                             
+          AINCMX=AMIN1(AINCMX,AINCM1)                         
+  166   CONTINUE                                             
+        AINC=1.                                             
+        IF(AINCMX.LT.AINC)AINC=AINCMX                      
+!                                                         
+!...SAVE THE RELEVENT VARIABLES FOR A UNIT UPDRFT AND DOWNDRFT...THEY    
+!...WILL ITERATIVELY ADJUSTED BY THE FACTOR AINC TO SATISFY THE         
+!...STABILIZATION CLOSURE...                                           
+!                                                                         
+        NCOUNT=0                                                         
+        TDER2=TDER                                                      
+        PPTFL2=PPTFLX                                                  
+        DO 170 NK=1,LTOP                                              
+          DETLQ2(NK)=DETLQ(NK)                                       
+          DETIC2(NK)=DETIC(NK)                                      
+          UDR2(NK)=UDR(NK)                                         
+          UER2(NK)=UER(NK)                                        
+          DDR2(NK)=DDR(NK)                                       
+          DER2(NK)=DER(NK)                                      
+          UMF2(NK)=UMF(NK)                                     
+          DMF2(NK)=DMF(NK)                                    
+  170   CONTINUE                                             
+        FABE=1.                                             
+        STAB=0.95                                          
+        NOITR=0                                           
+        IF(AINC/AINCMX.GT.0.999)THEN                     
+          NCOUNT=0                                      
+          GOTO 255                                     
+        ENDIF                                        
+        ISTOP=0                                     
+  175   NCOUNT=NCOUNT+1                             
+!                                                   
+!*****************************************************************         
+!                                                                *        
+!           COMPUTE PROPERTIES FOR COMPENSATIONAL SUBSIDENCE     *       
+!                                                                *      
+!*****************************************************************     
+!                                                                     
+!...DETERMINE OMEGA VALUE NECESSARY AT TOP AND BOTTOM OF EACH LAYER TO    
+!...SATISFY MASS CONTINUITY...                                           
+!                                                                       
+  185   CONTINUE                                                       
+        DTT=TIMEC                                                     
+        DO 200 NK=1,LTOP                                             
+          DOMGDP(NK)=-(UER(NK)-DER(NK)-UDR(NK)-DDR(NK))*EMSD(NK)    
+          IF(NK.GT.1)THEN                                          
+            OMG(NK)=OMG(NK-1)-DP(NK-1)*DOMGDP(NK-1)               
+            DTT1=0.75*DP(NK-1)/(ABS(OMG(NK))+1.E-10)             
+            DTT=AMIN1(DTT,DTT1)                                 
+          ENDIF                                                        
+  200   CONTINUE                                                      
+        DO 488 NK=1,LTOP                                             
+          THPA(NK)=THTA0(NK)                                        
+          QPA(NK)=Q0(NK)                                           
+          NSTEP=NINT(TIMEC/DTT+1)                                 
+          DTIME=TIMEC/FLOAT(NSTEP)                              
+          FXM(NK)=OMG(NK)*DXSQ/G                               
+  488   CONTINUE                                              
+!                                                            
+!...DO AN UPSTREAM/FORWARD-IN-TIME ADVECTION OF THETA, QV...
+!                                                          
+        DO 495 NTC=1,NSTEP                                
+!                                                        
+!...ASSIGN THETA AND Q VALUES AT THE TOP AND BOTTOM OF EACH LAYER BASED   
+!...SIGN OF OMEGA...                                                     
+!                                                                       
+          DO 493 NK=1,LTOP                                             
+            THFXTOP(NK)=0.                                             
+            THFXBOT(NK)=0.                                           
+            QFXTOP(NK)=0.                                            
+  493     QFXBOT(NK)=0.                                            
+          DO 494 NK=2,LTOP
+            IF(OMG(NK).LE.0.)THEN
+              THFXBOT(NK)=-FXM(NK)*THPA(NK-1)
+              QFXBOT(NK)=-FXM(NK)*QPA(NK-1)
+              THFXTOP(NK-1)=THFXTOP(NK-1)-THFXBOT(NK)
+              QFXTOP(NK-1)=QFXTOP(NK-1)-QFXBOT(NK)
+            ELSE
+              THFXBOT(NK)=-FXM(NK)*THPA(NK)
+              QFXBOT(NK)=-FXM(NK)*QPA(NK)
+              THFXTOP(NK-1)=THFXTOP(NK-1)-THFXBOT(NK)
+              QFXTOP(NK-1)=QFXTOP(NK-1)-QFXBOT(NK)
+            ENDIF
+  494     CONTINUE
+!                                                   
+!...UPDATE THE THETA AND QV VALUES AT EACH LEVEL..  
+!                                                       
+          DO 492 NK=1,LTOP                             
+            THPA(NK)=THPA(NK)+(THFXBOT(NK)+UDR(NK)*THTAU(NK)+DDR(NK)*     & 
+                     THTAD(NK)+THFXTOP(NK)-(UER(NK)-DER(NK))*THTA0(NK))* &
+                     DTIME*EMSD(NK)                                     
+            QPA(NK)=QPA(NK)+(QFXBOT(NK)+UDR(NK)*QDT(NK)+DDR(NK)*QD(NK)+   & 
+                    QFXTOP(NK)-(UER(NK)-DER(NK))*Q0(NK))*DTIME*EMSD(NK)  
+
+  492     CONTINUE                                                     
+  495   CONTINUE                                                      
+        DO 498 NK=1,LTOP                                             
+          THTAG(NK)=THPA(NK)                                        
+          QG(NK)=QPA(NK)                                           
+  498   CONTINUE                                                  
+!                                                                
+!...CHECK TO SEE IF MIXING RATIO DIPS BELOW ZERO ANYWHERE;  IF SO,        
+!...BORROW MOISTURE FROM ADJACENT LAYERS TO BRING IT BACK UP ABOVE ZERO. 
+!                                                                       
+        DO 499 NK=1,LTOP                                               
+          IF(QG(NK).LT.0.)THEN                                        
+            IF(NK.EQ.1)THEN                                          
+              CALL wrf_error_fatal ( 'module_cu_kf.F: problem with kf scheme:  qg = 0 at the surface' )
+            ENDIF                                                
+            NK1=NK+1                                            
+            IF(NK.EQ.LTOP)NK1=KLCL                             
+            TMA=QG(NK1)*EMS(NK1)                              
+            TMB=QG(NK-1)*EMS(NK-1)                           
+            TMM=(QG(NK)-1.E-9)*EMS(NK)                      
+            BCOEFF=-TMM/((TMA*TMA)/TMB+TMB)                
+            ACOEFF=BCOEFF*TMA/TMB                         
+            TMB=TMB*(1.-BCOEFF)                          
+            TMA=TMA*(1.-ACOEFF)                         
+            IF(NK.EQ.LTOP)THEN                                  
+              QVDIFF=(QG(NK1)-TMA*EMSD(NK1))*100./QG(NK1)     
+              IF(ABS(QVDIFF).GT.1.)THEN                        
+            PRINT *,'--WARNING-- CLOUD BASE WATER VAPOR CHANGES BY ',    & 
+            QVDIFF,                                                      &
+             ' PERCENT WHEN MOISTURE IS BORROWED TO PREVENT NEG VALUES', &   
+             ' IN KAIN-FRITSCH'                                             
+              ENDIF                                                         
+            ENDIF                                                          
+            QG(NK)=1.E-9                                                  
+            QG(NK1)=TMA*EMSD(NK1)                                        
+            QG(NK-1)=TMB*EMSD(NK-1)                                     
+          ENDIF                                                           
+  499   CONTINUE                                                         
+        TOPOMG=(UDR(LTOP)-UER(LTOP))*DP(LTOP)*EMSD(LTOP)                
+        IF(ABS(TOPOMG-OMG(LTOP)).GT.1.E-3)THEN                         
+!       WRITE(98,*)'ERROR:  MASS DOES NOT BALANCE IN KF SCHEME;'      
+!    * ,'TOPOMG, OMG =',TOPOMG,OMG(LTOP)                             
+        WRITE(6,*)'ERROR:  MASS DOES NOT BALANCE IN KF SCHEME;'        & 
+       ,'TOPOMG, OMG =',TOPOMG,OMG(LTOP)                            
+          ISTOP=1                                                  
+          GOTO 265                                                
+        ENDIF                                                    
+!                                                               
+!...CONVERT THETA TO T...                                      
+!                                                             
+! PAY ATTENTION ...
+!
+        DO 230 NK=1,LTOP                                     
+          EXN(NK)=(P00/P0(NK))**(0.2854*(1.-0.28*QG(NK)))   
+          TG(NK)=THTAG(NK)/EXN(NK)                         
+          TVG(NK)=TG(NK)*(1.+0.608*QG(NK))                
+  230   CONTINUE                                         
+!                                                       
+!*******************************************************************    
+!                                                                  *   
+!     COMPUTE NEW CLOUD AND CHANGE IN AVAILABLE BUOYANT ENERGY.    *  
+!                                                                  * 
+!*******************************************************************
+!                                                                  
+!...THE FOLLOWING COMPUTATIONS ARE SIMILAR TO THAT FOR UPDRAFT    
+!                                                                
+        THMIX=0.                                                
+        QMIX=0.                                                
+        PMIX=0.                                               
+        DO 217 NK=LC,KPBL                                    
+          ROCPQ=0.2854*(1.-0.28*QG(NK))                     
+          THMIX=THMIX+DP(NK)*TG(NK)*(P00/P0(NK))**ROCPQ    
+          QMIX=QMIX+DP(NK)*QG(NK)                         
+  217   PMIX=PMIX+DP(NK)*P0(NK)                          
+        THMIX=THMIX/DPTHMX                              
+        QMIX=QMIX/DPTHMX                              
+        PMIX=PMIX/DPTHMX                             
+        ROCPQ=0.2854*(1.-0.28*QMIX)                 
+        TMIX=THMIX*(PMIX/P00)**ROCPQ                
+        ES=ALIQ*EXP((TMIX*BLIQ-CLIQ)/(TMIX-DLIQ))                           
+        QS=EP2*ES/(PMIX-ES)                                              
+!                                                                         
+!...REMOVE SUPERSATURATION FOR DIAGNOSTIC PURPOSES, IF NECESSARY...      
+!                                                                       
+        IF(QMIX.GT.QS)THEN                                             
+          RL=XLV0-XLV1*TMIX                                          
+          CPM=CP*(1.+0.887*QMIX)                                    
+          DSSDT=QS*(CLIQ-BLIQ*DLIQ)/((TMIX-DLIQ)*(TMIX-DLIQ))      
+          DQ=(QMIX-QS)/(1.+RL*DSSDT/CPM)                          
+          TMIX=TMIX+RL/CP*DQ                                     
+          QMIX=QMIX-DQ                                          
+          ROCPQ=0.2854*(1.-0.28*QMIX)                          
+          THMIX=TMIX*(P00/PMIX)**ROCPQ                        
+          TLCL=TMIX                                          
+          PLCL=PMIX                                         
+        ELSE                                               
+          QMIX=AMAX1(QMIX,0.)                             
+          EMIX=QMIX*PMIX/(EP2+QMIX)                    
+          TLOG=ALOG(EMIX/ALIQ)                          
+          TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)            
+          TLCL=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(TMIX-T00))*(TMIX-  & 
+               TDPT)                                                      
+          TLCL=AMIN1(TLCL,TMIX)                                          
+          CPORQ=1./ROCPQ                                                
+          PLCL=P00*(TLCL/THMIX)**CPORQ                                 
+        ENDIF                                                         
+        TVLCL=TLCL*(1.+0.608*QMIX)                                   
+        DO 235 NK=LC,KL                                             
+          KLCL=NK                                                 
+  235   IF(PLCL.GE.P0(NK))GOTO 240                               
+  240   K=KLCL-1                                                
+        DLP=ALOG(PLCL/P0(K))/ALOG(P0(KLCL)/P0(K))              
+!                                                             
+!...ESTIMATE ENVIRONMENTAL TEMPERATURE AND MIXING RATIO AT THE LCL...
+!                                                                          
+        TENV=TG(K)+(TG(KLCL)-TG(K))*DLP                                   
+        QENV=QG(K)+(QG(KLCL)-QG(K))*DLP                                  
+        TVEN=TENV*(1.+0.608*QENV)                                       
+        TVBAR=0.5*(TVG(K)+TVEN)                                        
+!        ZLCL=Z0(K)+R*TVBAR*ALOG(P0(K)/PLCL)/G                        
+        ZLCL=Z0(K)+(Z0(KLCL)-Z0(K))*DLP                                     
+        TVAVG=0.5*(TVEN+TG(KLCL)*(1.+0.608*QG(KLCL)))                      
+        PLCL=P0(KLCL)*EXP(G/(R*TVAVG)*(Z0(KLCL)-ZLCL))                    
+        THETEU(K)=TMIX*(1.E5/PMIX)**(0.2854*(1.-0.28*QMIX))*            & 
+                  EXP((3374.6525/TLCL-2.5403)*QMIX*(1.+0.81*QMIX))      
+        ES=ALIQ*EXP((TENV*BLIQ-CLIQ)/(TENV-DLIQ))                        
+        QESE=EP2*ES/(PLCL-ES)                                              
+        THTESG(K)=TENV*(1.E5/PLCL)**(0.2854*(1.-0.28*QESE))*            &
+                  EXP((3374.6525/TENV-2.5403)*QESE*(1.+0.81*QESE))       
+!                                                                           
+!...COMPUTE ADJUSTED ABE(ABEG).                                            
+!                                                                         
+        ABEG=0.                                                         
+        THTUDL=THETEU(K)                                               
+        DO 245 NK=K,LTOPM1                                            
+          NK1=NK+1                                                   
+          ES=ALIQ*EXP((TG(NK1)*BLIQ-CLIQ)/(TG(NK1)-DLIQ))                    
+          QESE=EP2*ES/(P0(NK1)-ES)                                        
+          THTESG(NK1)=TG(NK1)*(1.E5/P0(NK1))**(0.2854*(1.-0.28*QESE))*    & 
+                      EXP((3374.6525/TG(NK1)-2.5403)*QESE*(1.+0.81*QESE)  & 
+                      )                                                     
+!         DZZ=CVMGT(Z0(KLCL)-ZLCL,DZA(NK),NK.EQ.K)                         
+          IF(NK.EQ.K)THEN                                                 
+            DZZ=Z0(KLCL)-ZLCL                                            
+          ELSE                                                          
+            DZZ=DZA(NK)                                                
+          ENDIF                                                       
+          BE=((2.*THTUDL)/(THTESG(NK1)+THTESG(NK))-1.)*DZZ           
+  245   IF(BE.GT.0.)ABEG=ABEG+BE*G                                  
+!                                                                  
+!...ASSUME AT LEAST 90% OF CAPE (ABE) IS REMOVED BY CONVECTION DURING     
+!...THE PERIOD TIMEC...                                                  
+!                                                                       
+        IF(NOITR.EQ.1)THEN                                             
+!        WRITE(98,1060)FABE                                           
+          GOTO 265                                                   
+        ENDIF                                                       
+        DABE=AMAX1(ABE-ABEG,0.1*ABE)                               
+        FABE=ABEG/(ABE+1.E-8)                                    
+        IF(FABE.GT.1.)THEN                                                
+!       WRITE(98,*)'UPDRAFT/DOWNDRAFT COUPLET INCREASES CAPE AT THIS '   
+!    *,'GRID POINT; NO CONVECTION ALLOWED!'                             
+          GOTO 325                                                     
+        ENDIF                                                         
+        IF(NCOUNT.NE.1)THEN                                          
+          DFDA=(FABE-FABEOLD)/(AINC-AINCOLD)                        
+          IF(DFDA.GT.0.)THEN                                       
+            NOITR=1                                               
+            AINC=AINCOLD                                         
+            GOTO 255                                            
+          ENDIF                                                
+        ENDIF                                                 
+        AINCOLD=AINC                                         
+        FABEOLD=FABE                                        
+        IF(AINC/AINCMX.GT.0.999.AND.FABE.GT.1.05-STAB)THEN 
+!      WRITE(98,1055)FABE                                             
+          GOTO 265                                                   
+        ENDIF                                                       
+        IF(FABE.LE.1.05-STAB.AND.FABE.GE.0.95-STAB)GOTO 265        
+        IF(NCOUNT.GT.10)THEN                                      
+!       WRITE(98,1060)FABE                                       
+          GOTO 265                                              
+        ENDIF                                                  
+!                                                                             
+!...IF MORE THAN 10% OF THE ORIGINAL CAPE REMAINS, INCREASE THE              
+!...CONVECTIVE MASS FLUX BY THE FACTOR AINC:                                
+!                                                                          
+        IF(FABE.EQ.0.)THEN                                               
+          AINC=AINC*0.5                                                 
+        ELSE                                                           
+          AINC=AINC*STAB*ABE/(DABE+1.E-8)                             
+        ENDIF                                                        
+  255   AINC=AMIN1(AINCMX,AINC)                                     
+!...IF AINC BECOMES VERY SMALL, EFFECTS OF CONVECTION              
+!...WILL BE MINIMAL SO JUST IGNORE IT...                          
+        IF(AINC.LT.0.05)GOTO 325                                 
+!       AINC=AMAX1(AINC,0.05)                                   
+        TDER=TDER2*AINC                                        
+        PPTFLX=PPTFL2*AINC                                    
+!     WRITE(98,1080)LFS,LDB,LDT,TIMEC,NSTEP,NCOUNT,FABEOLD,AINCOLD     
+        DO 260 NK=1,LTOP                                              
+          UMF(NK)=UMF2(NK)*AINC                                      
+          DMF(NK)=DMF2(NK)*AINC                                     
+          DETLQ(NK)=DETLQ2(NK)*AINC                                
+          DETIC(NK)=DETIC2(NK)*AINC                               
+          UDR(NK)=UDR2(NK)*AINC                                  
+          UER(NK)=UER2(NK)*AINC                                 
+          DER(NK)=DER2(NK)*AINC                                
+          DDR(NK)=DDR2(NK)*AINC                               
+  260   CONTINUE                                             
+!                                                           
+!...GO BACK UP FOR ANOTHER ITERATION...                    
+!                                                         
+        GOTO 175                                         
+  265   CONTINUE                                        
+!                                                      
+!...CLEAN THINGS UP, CALCULATE CONVECTIVE FEEDBACK TENDENCIES FOR THIS    
+!...GRID POINT...                                                        
+!                                                                       
+!...COMPUTE HYDROMETEOR TENDENCIES AS IS DONE FOR T, QV...             
+!                                                                     
+!...FRC2 IS THE FRACTION OF TOTAL CONDENSATE                         
+!...GENERATED THAT GOES INTO PRECIPITIATION                         
+        FRC2=PPTFLX/(CPR*AINC)                                     
+        DO 270 NK=1,LTOP                                          
+          QLPA(NK)=QL0(NK)                                       
+          QIPA(NK)=QI0(NK)                                      
+          QRPA(NK)=QR0(NK)                                     
+          QSPA(NK)=QS0(NK)                                    
+          RAINFB(NK)=PPTLIQ(NK)*AINC*FBFRC*FRC2                         
+          SNOWFB(NK)=PPTICE(NK)*AINC*FBFRC*FRC2                        
+  270   CONTINUE                                                      
+        DO 290 NTC=1,NSTEP                                           
+!                                                                   
+!...ASSIGN HYDROMETEORS CONCENTRATIONS AT THE TOP AND BOTTOM OF EACH 
+!...LAYER BASED ON THE SIGN OF OMEGA...                             
+!                                                                  
+          DO 275 NK=1,LTOP                                        
+            QLFXIN(NK)=0.                                        
+            QLFXOUT(NK)=0.                                      
+            QIFXIN(NK)=0.                                      
+            QIFXOUT(NK)=0.                                    
+            QRFXIN(NK)=0.                                    
+            QRFXOUT(NK)=0.                                  
+            QSFXIN(NK)=0.                                  
+            QSFXOUT(NK)=0.                               
+  275     CONTINUE                                                     
+          DO 280 NK=2,LTOP                                            
+            IF(OMG(NK).LE.0.)THEN                                    
+              QLFXIN(NK)=-FXM(NK)*QLPA(NK-1)                        
+              QIFXIN(NK)=-FXM(NK)*QIPA(NK-1)                       
+              QRFXIN(NK)=-FXM(NK)*QRPA(NK-1)                      
+              QSFXIN(NK)=-FXM(NK)*QSPA(NK-1)                     
+              QLFXOUT(NK-1)=QLFXOUT(NK-1)+QLFXIN(NK)            
+              QIFXOUT(NK-1)=QIFXOUT(NK-1)+QIFXIN(NK)           
+              QRFXOUT(NK-1)=QRFXOUT(NK-1)+QRFXIN(NK)          
+              QSFXOUT(NK-1)=QSFXOUT(NK-1)+QSFXIN(NK)         
+            ELSE                                            
+              QLFXOUT(NK)=FXM(NK)*QLPA(NK)                 
+              QIFXOUT(NK)=FXM(NK)*QIPA(NK)                
+              QRFXOUT(NK)=FXM(NK)*QRPA(NK)               
+              QSFXOUT(NK)=FXM(NK)*QSPA(NK)             
+              QLFXIN(NK-1)=QLFXIN(NK-1)+QLFXOUT(NK)   
+              QIFXIN(NK-1)=QIFXIN(NK-1)+QIFXOUT(NK)                      
+              QRFXIN(NK-1)=QRFXIN(NK-1)+QRFXOUT(NK)                     
+              QSFXIN(NK-1)=QSFXIN(NK-1)+QSFXOUT(NK)                    
+            ENDIF                                                     
+  280     CONTINUE                                                  
+!                                                                  
+!...UPDATE THE HYDROMETEOR CONCENTRATION VALUES AT EACH LEVEL...  
+!                                                                
+          DO 285 NK=1,LTOP                                                 
+            QLPA(NK)=QLPA(NK)+(QLFXIN(NK)+DETLQ(NK)-QLFXOUT(NK))*DTIME*  & 
+                     EMSD(NK)                                               
+            QIPA(NK)=QIPA(NK)+(QIFXIN(NK)+DETIC(NK)-QIFXOUT(NK))*DTIME*  & 
+                     EMSD(NK)                                             
+            QRPA(NK)=QRPA(NK)+(QRFXIN(NK)+QLQOUT(NK)*UDR(NK)-QRFXOUT(NK) & 
+                     +RAINFB(NK))*DTIME*EMSD(NK)                          
+            QSPA(NK)=QSPA(NK)+(QSFXIN(NK)+QICOUT(NK)*UDR(NK)-QSFXOUT(NK) &  
+                     +SNOWFB(NK))*DTIME*EMSD(NK)                           
+  285     CONTINUE                                                        
+  290   CONTINUE                                                         
+        DO 295 NK=1,LTOP                                                
+          QLG(NK)=QLPA(NK)                                             
+          QIG(NK)=QIPA(NK)                                            
+          QRG(NK)=QRPA(NK)                                           
+          QSG(NK)=QSPA(NK)                                          
+  295   CONTINUE                                                  
+!     WRITE(98,1080)LFS,LDB,LDT,TIMEC,NSTEP,NCOUNT,FABE,AINC     
+!                                                               
+!...SEND FINAL PARAMETERIZED VALUES TO OUTPUT FILES...         
+!                                                             
+        IF(ISTOP.EQ.1)THEN                                   
+        WRITE(6,1070)'  P  ','   DP ',' DT K/D ',' DR K/D ','   OMG  ',  & 
+      ' DOMGDP ','   UMF  ','   UER  ','   UDR  ','   DMF  ','   DER  '  & 
+      ,'   DDR  ','   EMS  ','    W0  ','  DETLQ ',' DETIC '              
+          DO 300 K=LTOP,1,-1                                                   
+            DTT=(TG(K)-T0(K))*86400./TIMEC                                 
+            RL=XLV0-XLV1*TG(K)                                            
+            DR=-(QG(K)-Q0(K))*RL*86400./(TIMEC*CP)                       
+            UDFRC=UDR(K)*TIMEC*EMSD(K)                                  
+            UEFRC=UER(K)*TIMEC*EMSD(K)                                 
+            DDFRC=DDR(K)*TIMEC*EMSD(K)                                
+            DEFRC=-DER(K)*TIMEC*EMSD(K)                              
+            WRITE (6,1075)P0(K)/100.,DP(K)/100.,DTT,DR,OMG(K),DOMGDP(K)* &  
+                          1.E4,UMF(K)/1.E6,UEFRC,UDFRC,DMF(K)/1.E6,DEFRC & 
+                          ,DDFRC,EMS(K)/1.E11,W0AVG1D(K)*1.E2,DETLQ(K) &
+                          *TIMEC*EMSD(K)*1.E3,DETIC(K)*TIMEC*EMSD(K)*    & 
+                          1.E3                                            
+  300     CONTINUE                                                       
+        WRITE(6,1085)'K','P','Z','T0','TG','DT','TU','TD','Q0','QG',     & 
+                  'DQ','QU','QD','QLG','QIG','QRG','QSG','RH0','RHG'    
+          DO 305 K=KX,1,-1                                               
+            DTT=TG(K)-T0(K)                                          
+            TUC=TU(K)-T00                                                    
+            IF(K.LT.LC.OR.K.GT.LTOP)TUC=0.                                  
+            TDC=TZ(K)-T00                                                  
+            IF((K.LT.LDB.OR.K.GT.LDT).AND.K.NE.LFS)TDC=0.                 
+            ES=ALIQ*EXP((BLIQ*TG(K)-CLIQ)/(TG(K)-DLIQ))                  
+            QGS=ES*EP2/(P0(K)-ES)                                     
+            RH0=Q0(K)/QES(K)                                              
+            RHG=QG(K)/QGS                                                
+            WRITE (6,1090)K,P0(K)/100.,Z0(K),T0(K)-T00,TG(K)-T00,DTT,TUC &
+                          ,TDC,Q0(K)*1000.,QG(K)*1000.,(QG(K)-Q0(K))*    &   
+                          1000.,QU(K)*1000.,QD(K)*1000.,QLG(K)*1000.,    &  
+                          QIG(K)*1000.,QRG(K)*1000.,QSG(K)*1000.,RH0,RHG   
+  305     CONTINUE                                                        
+!                                                                        
+!...IF CALCULATIONS ABOVE SHOW AN ERROR IN THE MASS BUDGET, PRINT OUT A 
+!...TO BE USED LATER FOR DIAGNOSTIC PURPOSES, THEN ABORT RUN...        
+!                                                                     
+          IF(ISTOP.EQ.1)THEN                                         
+            DO 310 K=1,KX                                           
+              WRITE ( wrf_err_message , 1115 )                         &
+                            Z0(K),P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,   &
+                            U0(K),V0(K),DP(K)/100.,W0AVG1D(K)         
+              CALL wrf_message ( TRIM( wrf_err_message ) )
+  310       CONTINUE                                                   
+            CALL wrf_error_fatal ( 'module_cu_kf.F: KAIN-FRITSCH' )
+          ENDIF                                                      
+        ENDIF                                                       
+        CNDTNF=(1.-EQFRC(LFS))*(QLIQ(LFS)+QICE(LFS))*DMF(LFS)            
+!     WRITE(98,1095)CPR*AINC,TDER+PPTFLX+CNDTNF                            
+!                                                                       
+!  EVALUATE MOISTURE BUDGET...                                         
+!                                                                     
+        QINIT=0.                                                     
+        QFNL=0.                                                     
+        DPT=0.                                                     
+        DO 315 NK=1,LTOP                                                    
+          DPT=DPT+DP(NK)                                                     
+          QINIT=QINIT+Q0(NK)*EMS(NK)                                       
+          QFNL=QFNL+QG(NK)*EMS(NK)                                        
+          QFNL=QFNL+(QLG(NK)+QIG(NK)+QRG(NK)+QSG(NK))*EMS(NK)            
+  315   CONTINUE                                                        
+        QFNL=QFNL+PPTFLX*TIMEC*(1.-FBFRC)                              
+        ERR2=(QFNL-QINIT)*100./QINIT                                  
+!     WRITE(98,1110)QINIT,QFNL,ERR2                                  
+!        IF(ABS(ERR2).GT.0.05)STOP 'QVERR'                           
+        IF(ABS(ERR2).GT.0.05)CALL wrf_error_fatal( 'module_cu_kf.F: QVERR' )
+        RELERR=ERR2*QINIT/(PPTFLX*TIMEC+1.E-10)                   
+!     WRITE(98,1120)RELERR                                       
+!     WRITE(98,*)'TDER, CPR, USR, TRPPT =',                     
+!    *TDER,CPR*AINC,USR*AINC,TRPPT*AINC                        
+!                                                             
+!...FEEDBACK TO RESOLVABLE SCALE TENDENCIES.                 
+!                                                           
+!...IF THE ADVECTIVE TIME PERIOD (TADVEC) IS LESS THAN SPECIFIED MINIMUM  
+!...TIMEC, ALLOW FEEDBACK TO OCCUR ONLY DURING TADVEC...                 
+!                                                                       
+        IF(TADVEC.LT.TIMEC)NIC=NINT(TADVEC/DT)                  
+        NCA(I,J)=FLOAT(NIC)                                                  
+        DO 320 K=1,KX                                                
+!         IF(IMOIST.NE.2)THEN
+!                                                                            
+!...IF HYDROMETEORS ARE NOT ALLOWED, THEY MUST BE EVAPORATED OR SUBLIMAT    
+!...AND FED BACK AS VAPOR, ALONG WITH ASSOCIATED CHANGES IN TEMPERATURE.   
+!...NOTE:  THIS WILL INTRODUCE CHANGES IN THE CONVECTIVE TEMPERATURE AND  
+!...WATER VAPOR FEEDBACK TENDENCIES AND MAY LEAD TO SUPERSATURATED VALUE 
+!...OF QG...                                                           
+!                                                                     
+!           RLC=XLV0-XLV1*TG(K)                                      
+!           RLS=XLS0-XLS1*TG(K)                                     
+!           CPM=CP*(1.+0.887*QG(K))                                
+!           TG(K)=TG(K)-(RLC*(QLG(K)+QRG(K))+RLS*(QIG(K)+QSG(K)))/CPM    
+!           QG(K)=QG(K)+(QLG(K)+QRG(K)+QIG(K)+QSG(K))                   
+!           DQCDT(K)=0.                                           
+!           DQIDT(K)=0.                                          
+!           DQRDT(K)=0.                                         
+!           DQSDT(K)=0.                                        
+!         ELSE                                                     
+            IF(.NOT. qi_flag .and. warm_rain)THEN                                          
+!                                                                         
+!...IF ICE PHASE IS NOT ALLOWED, MELT ALL FROZEN HYDROMETEORS...         
+!                                                                       
+              CPM=CP*(1.+0.887*QG(K))                                  
+              TG(K)=TG(K)-(QIG(K)+QSG(K))*RLF/CPM                     
+              DQCDT(K)=(QLG(K)+QIG(K)-QL0(K)-QI0(K))/TIMEC      
+              DQIDT(K)=0.                                      
+              DQRDT(K)=(QRG(K)+QSG(K)-QR0(K)-QS0(K))/TIMEC    
+              DQSDT(K)=0.                                    
+            ELSEIF(.NOT. qi_flag .and. .not. warm_rain)THEN                                          
+!                                                                      
+!...IF ICE PHASE IS ALLOWED, BUT MIXED PHASE IS NOT, MELT FROZEN HYDROME   
+!...BELOW THE MELTING LEVEL, FREEZE LIQUID WATER ABOVE THE MELTING LEVEL  
+!                                                                        
+              CPM=CP*(1.+0.887*QG(K))                                   
+              IF(K.LE.ML)THEN                                         
+                TG(K)=TG(K)-(QIG(K)+QSG(K))*RLF/CPM                  
+              ELSEIF(K.GT.ML)THEN                                              
+                TG(K)=TG(K)+(QLG(K)+QRG(K))*RLF/CPM                           
+              ENDIF                                                          
+              DQCDT(K)=(QLG(K)+QIG(K)-QL0(K)-QI0(K))/TIMEC             
+              DQIDT(K)=0.                                             
+              DQRDT(K)=(QRG(K)+QSG(K)-QR0(K)-QS0(K))/TIMEC           
+              DQSDT(K)=0.                                           
+            ELSEIF(qi_flag) THEN
+!                                                                           
+!...IF MIXED PHASE HYDROMETEORS ARE ALLOWED, FEED BACK CONVECTIVE          
+!...TENDENCY OF HYDROMETEORS DIRECTLY...                                  
+!                                                                        
+              DQCDT(K)=(QLG(K)-QL0(K))/TIMEC                       
+              DQIDT(K)=(QIG(K)-QI0(K))/TIMEC                      
+              DQRDT(K)=(QRG(K)-QR0(K))/TIMEC                     
+              IF (qs_flag ) THEN
+                 DQSDT(K)=(QSG(K)-QS0(K))/TIMEC                    
+              ELSE
+                 DQIDT(K)=DQIDT(K)+(QSG(K)-QS0(K))/TIMEC
+              ENDIF
+            ELSE                                                    
+              CALL wrf_error_fatal ( 'module_cu_kf: THIS COMBINATION OF IMOIST,  IICE NOT ALLOWED' )
+            ENDIF                                                 
+!         ENDIF                                                  
+          DTDT(K)=(TG(K)-T0(K))/TIMEC                      
+          DQDT(K)=(QG(K)-Q0(K))/TIMEC                                   
+  320   CONTINUE                                                            
+
+! RAINCV is in the unit of mm
+
+        RAINCV(I,J)=DT*PPTFLX*(1.-FBFRC)/DXSQ                       
+!         RNC=0.1*TIMEC*PPTFLX/DXSQ                                       
+        RNC=RAINCV(I,J)*NIC                                              
+!        WRITE(98,909)RNC                                               
+ 909     FORMAT(' CONVECTIVE RAINFALL =',F8.4,' CM')                   
+
+  325 CONTINUE                                                        
+
+1000  FORMAT(' ',10A8)                                                     
+1005  FORMAT(' ',F6.0,2X,F6.4,2X,F7.3,1X,F6.4,2X,4(F6.3,2X),2(F7.3,1X))   
+1010  FORMAT(' ',' VERTICAL VELOCITY IS NEGATIVE AT ',F4.0,' MB')        
+1015   FORMAT(' ','ALL REMAINING MASS DETRAINS BELOW ',F4.0,' MB')          
+1025   FORMAT(5X,' KLCL=',I2,' ZLCL=',F7.1,'M',                          &
+        ' DTLCL=',F5.2,' LTOP=',I2,' P0(LTOP)=',-2PF5.1,'MB FRZ LV=',    & 
+        I2,' TMIX=',0PF4.1,1X,'PMIX=',-2PF6.1,' QMIX=',3PF5.1,           &
+        ' CAPE=',0PF7.1)                                                    
+1030   FORMAT(' ',' P0(LET) = ',F6.1,' P0(LTOP) = ',F6.1,' VMFLCL =',    &   
+      E12.3,' PLCL =',F6.1,' WLCL =',F6.3,' CLDHGT =',                   & 
+      F8.1)                                                               
+1035  FORMAT(1X,'PEF(WS)=',F4.2,'(CB)=',F4.2,'LC,LET=',2I3,'WKL='        &
+      ,F6.3,'VWS=',F5.2)                                                    
+1040          FORMAT(' ','PRECIP EFF = 100%, ENVIR CANNOT SUPPORT DOWND' & 
+      ,'RAFTS')                                                          
+!1045  FORMAT('NUMBER OF DOWNDRAFT ITERATIONS EXCEEDS 10...PPTFLX'       & 
+!      ' IS DIFFERENT FROM THAT GIVEN BY PRECIP EFF RELATION')            
+! FLIC HAS TROUBLE WITH THIS ONE.                                         
+1045  FORMAT('NUMBER OF DOWNDRAFT ITERATIONS EXCEEDS 10')                
+1050  FORMAT(' ','LCOUNT= ',I3,' PPTFLX/CPR, PEFF= ',F5.3,1X,F5.3,       &  
+      'DMF(LFS)/UMF(LCL)= ',F5.3)                                          
+1055     FORMAT(/'*** DEGREE OF STABILIZATION =',F5.3,', NO MORE MASS F' &
+      ,'LUX IS ALLOWED')                                                
+!1060     FORMAT(/' ITERATION DOES NOT CONVERGE TO GIVE THE SPECIFIED '  & 
+!      'DEGREE OF STABILIZATION!  FABE= ',F6.4)                             
+1060  FORMAT(/' ITERATION DOES NOT CONVERGE.  FABE= ',F6.4)                
+ 1070 FORMAT (16A8)                                                       
+ 1075 FORMAT (F8.2,3(F8.2),2(F8.3),F8.2,2F8.3,F8.2,6F8.3)                
+1080   FORMAT(2X,'LFS,LDB,LDT =',3I3,' TIMEC, NSTEP=',F5.0,I3,           & 
+      'NCOUNT, FABE, AINC=',I2,1X,F5.3,F6.2)                              
+ 1085 FORMAT (A3,16A7,2A8)                                               
+ 1090 FORMAT (I3,F7.2,F7.0,10F7.2,4F7.3,2F8.3)                          
+1095   FORMAT(' ','  PPT PRODUCTION RATE= ',F10.0,' TOTAL EVAP+PPT= ',   &  
+       F10.0)                                                           
+1105   FORMAT(' ','NET LATENT HEAT RELEASE =',E12.5,' ACTUAL HEATING =', & 
+       E12.5,' J/KG-S, DIFFERENCE = ',F9.3,'PERCENT')                    
+1110   FORMAT(' ','INITIAL WATER =',E12.5,' FINAL WATER =',E12.5,        & 
+       ' TOTAL WATER CHANGE =',F8.2,'PERCENT')                              
+ 1115 FORMAT (2X,F6.0,2X,F7.2,2X,F5.1,2X,F6.3,2(2X,F5.1),2X,F7.2,2X,F7.4 &  
+             )                                                            
+1120   FORMAT(' ','MOISTURE ERROR AS FUNCTION OF TOTAL PPT =',F9.3,      & 
+            'PERCENT')                                                  
+
+   END SUBROUTINE KFPARA 
+
+!-----------------------------------------------------------------------
+   SUBROUTINE CONDLOAD(QLIQ,QICE,WTW,DZ,BOTERM,ENTERM,RATE,QNEWLQ,     & 
+                       QNEWIC,QLQOUT,QICOUT,G)                           
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+!  9/18/88...THIS PRECIPITATION FALLOUT SCHEME IS BASED ON THE SCHEME US    
+!  BY OGURA AND CHO (1973).  LIQUID WATER FALLOUT FROM A PARCEL IS CAL-    
+!  CULATED USING THE EQUATION DQ=-RATE*Q*DT, BUT TO SIMULATE A QUASI-     
+!  CONTINUOUS PROCESS, AND TO ELIMINATE A DEPENDENCY ON VERTICAL         
+!  RESOLUTION THIS IS EXPRESSED AS Q=Q*EXP(-RATE*DZ).                   
+
+      REAL, INTENT(IN   )   :: G
+      REAL, INTENT(IN   )   :: DZ,BOTERM,ENTERM,RATE
+      REAL, INTENT(INOUT)   :: QLQOUT,QICOUT,WTW,QLIQ,QICE,QNEWLQ,QNEWIC
+
+      REAL :: QTOT,QNEW,QEST,G1,WAVG,CONV,RATIO3,OLDQ,RATIO4,DQ,PPTDRG
+
+      QTOT=QLIQ+QICE                                                  
+      QNEW=QNEWLQ+QNEWIC                                            
+!                                                                  
+!  ESTIMATE THE VERTICAL VELOCITY SO THAT AN AVERAGE VERTICAL VELOCITY C
+!  BE CALCULATED TO ESTIMATE THE TIME REQUIRED FOR ASCENT BETWEEN MODEL
+!  LEVELS...                                                          
+!                                                                    
+      QEST=0.5*(QTOT+QNEW)                                          
+      G1=WTW+BOTERM-ENTERM-2.*G*DZ*QEST/1.5                        
+      IF(G1.LT.0.0)G1=0.                                          
+      WAVG=(SQRT(WTW)+SQRT(G1))/2.                               
+      CONV=RATE*DZ/WAVG                                         
+!                                                              
+!  RATIO3 IS THE FRACTION OF LIQUID WATER IN FRESH CONDENSATE, RATIO4 IS  
+!  THE FRACTION OF LIQUID WATER IN THE TOTAL AMOUNT OF CONDENSATE INVOLV 
+!  IN THE PRECIPITATION PROCESS - NOTE THAT ONLY 60% OF THE FRESH CONDEN
+!  SATE IS IS ALLOWED TO PARTICIPATE IN THE CONVERSION PROCESS...      
+!                                                                     
+      RATIO3=QNEWLQ/(QNEW+1.E-10)                                    
+!     OLDQ=QTOT                                                     
+      QTOT=QTOT+0.6*QNEW                                           
+      OLDQ=QTOT                                                   
+      RATIO4=(0.6*QNEWLQ+QLIQ)/(QTOT+1.E-10)                     
+      QTOT=QTOT*EXP(-CONV)                                      
+!                                                              
+!  DETERMINE THE AMOUNT OF PRECIPITATION THAT FALLS OUT OF THE UPDRAFT   
+!  PARCEL AT THIS LEVEL...                                              
+!                                                                      
+      DQ=OLDQ-QTOT                                                    
+      QLQOUT=RATIO4*DQ                                               
+      QICOUT=(1.-RATIO4)*DQ                                         
+!                                                                  
+!  ESTIMATE THE MEAN LOAD OF CONDENSATE ON THE UPDRAFT IN THE LAYER, CAL 
+!  LATE VERTICAL VELOCITY                                               
+!                                                                      
+      PPTDRG=0.5*(OLDQ+QTOT-0.2*QNEW)                                 
+      WTW=WTW+BOTERM-ENTERM-2.*G*DZ*PPTDRG/1.5                       
+!                                                                   
+!  DETERMINE THE NEW LIQUID WATER AND ICE CONCENTRATIONS INCLUDING LOSSE  
+!  DUE TO PRECIPITATION AND GAINS FROM CONDENSATION...                   
+!                                                                       
+      QLIQ=RATIO4*QTOT+RATIO3*0.4*QNEW                                 
+      QICE=(1.-RATIO4)*QTOT+(1.-RATIO3)*0.4*QNEW                      
+      QNEWLQ=0.                                                      
+      QNEWIC=0.                                                     
+
+   END SUBROUTINE CONDLOAD
+
+!-----------------------------------------------------------------------
+   SUBROUTINE DTFRZNEW(TU,P,THTEU,QVAP,QLIQ,QICE,RATIO2,TTFRZ,TBFRZ,   & 
+                       QNWFRZ,RL,FRC1,EFFQ,IFLAG,XLV0,XLV1,XLS0,XLS1,  & 
+                       EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE     )        
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: XLV0,XLV1
+   REAL,         INTENT(IN   )   :: P,TTFRZ,TBFRZ,EFFQ,XLS0,XLS1,EP2,ALIQ, &
+                                    BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE
+   REAL,         INTENT(INOUT)   :: TU,THTEU,QVAP,QLIQ,QICE,RATIO2,    &
+                                    FRC1,RL,QNWFRZ
+   INTEGER,      INTENT(INOUT)   :: IFLAG
+
+   REAL ::       CCP,RV,C5,QLQFRZ,QNEW,ESLIQ,ESICE,RLC,RLS,PI,ES,RLF,A, &
+                 B,C,DQVAP,DTFRZ,TU1,QVAP1
+!-----------------------------------------------------------------------
+!                                                                          
+!...ALLOW GLACIATION OF THE UPDRAFT TO OCCUR AS AN APPROXIMATELY LINEAR   
+!   FUNCTION OF TEMPERATURE IN THE TEMPERATURE RANGE TTFRZ TO TBFRZ...   
+!                                                                       
+
+      RV=461.5                                                         
+      C5=1.0723E-3                                                    
+!                                                                          
+!...ADJUST THE LIQUID WATER CONCENTRATIONS FROM FRESH CONDENSATE AND THA  
+!   BROUGHT UP FROM LOWER LEVELS TO AN AMOUNT THAT WOULD BE PRESENT IF N 
+!   LIQUID WATER HAD FROZEN THUS FAR...THIS IS NECESSARY BECAUSE THE    
+!   EXPRESSION FOR TEMP CHANGE IS MULTIPLIED BY THE FRACTION EQUAL TO TH       
+!   PARCEL TEMP DECREASE SINCE THE LAST MODEL LEVEL DIVIDED BY THE TOTAL      
+!   GLACIATION INTERVAL, SO THAT EFFECTIVELY THIS APPROXIMATELY ALLOWS A     
+!   AMOUNT OF LIQUID WATER TO FREEZE WHICH IS EQUAL TO THIS SAME FRACTIO    
+!   OF THE LIQUID WATER THAT WAS PRESENT BEFORE THE GLACIATION PROCESS W   
+!   INITIATED...ALSO, TO ALLOW THETAU TO CONVERT APPROXIMATELY LINEARLY   
+!   ITS VALUE WITH RESPECT TO ICE, WE NEED TO ALLOW A PORTION OF THE FRE 
+!   CONDENSATE TO CONTRIBUTE TO THE GLACIATION PROCESS; THE FRACTIONAL  
+!   AMOUNT THAT APPLIES TO THIS PORTION IS 1/2 OF THE FRACTIONAL AMOUNT     
+!   FROZEN OF THE "OLD" CONDENSATE BECAUSE THIS FRESH CONDENSATE IS ONLY   
+!   PRODUCED GRADUALLY OVER THE LAYER...NOTE THAT IN TERMS OF THE DYNAMI  
+!   OF THE PRECIPITATION PROCESS, IE. PRECIPITATION FALLOUT, THIS FRACTI 
+!   AMNT OF FRESH CONDENSATE HAS ALREADY BEEN INCLUDED IN THE ICE CATEGO
+!                                                                      
+      QLQFRZ=QLIQ*EFFQ                                                
+      QNEW=QNWFRZ*EFFQ*0.5                                           
+      ESLIQ=ALIQ*EXP((BLIQ*TU-CLIQ)/(TU-DLIQ))                      
+      ESICE=AICE*EXP((BICE*TU-CICE)/(TU-DICE))                     
+      RLC=2.5E6-2369.276*(TU-273.16)                              
+      RLS=2833922.-259.532*(TU-273.16)                           
+      RLF=RLS-RLC                                               
+      CCP=1005.7*(1.+0.89*QVAP)                                 
+!                                                             
+!  A = D(ES)/DT IS THAT CALCULATED FROM BUCK`S (1981) EMPIRICAL FORMULAS
+!  FOR SATURATION VAPOR PRESSURE...                                    
+!                                                                     
+      A=(CICE-BICE*DICE)/((TU-DICE)*(TU-DICE))                       
+      B=RLS*EP2/P                                                 
+      C=A*B*ESICE/CCP                                               
+      DQVAP=B*(ESLIQ-ESICE)/(RLS+RLS*C)-RLF*(QLQFRZ+QNEW)/(RLS+RLS/C)  
+      DTFRZ=(RLF*(QLQFRZ+QNEW)+B*(ESLIQ-ESICE))/(CCP+A*B*ESICE)        
+      TU1=TU                                                         
+      QVAP1=QVAP                                                    
+      TU=TU+FRC1*DTFRZ                                             
+      QVAP=QVAP-FRC1*DQVAP                                        
+      ES=QVAP*P/(EP2+QVAP)                                     
+      ESLIQ=ALIQ*EXP((BLIQ*TU-CLIQ)/(TU-DLIQ))                           
+      ESICE=AICE*EXP((BICE*TU-CICE)/(TU-DICE))                          
+      RATIO2=(ESLIQ-ES)/(ESLIQ-ESICE)                                  
+!                                                                     
+!  TYPICALLY, RATIO2 IS VERY CLOSE TO (TTFRZ-TU)/(TTFRZ-TBFRZ), USUALLY    
+!  WITHIN 1% (USING TU BEFORE GALCIATION EFFECTS ARE APPLIED);  IF THE    
+!  INITIAL UPDRAFT TEMP IS BELOW TBFRZ AND RATIO2 IS STILL LESS THAN 1,  
+!  AN ADJUSTMENT TO FRC1 AND RATIO2 IS INTRODUCED SO THAT GLACIATION    
+!  EFFECTS ARE NOT UNDERESTIMATED; CONVERSELY, IF RATIO2 IS GREATER THAN    
+!  FRC1 IS ADJUSTED SO THAT GLACIATION EFFECTS ARE NOT OVERESTIMATED...    
+!                                                                        
+      IF(IFLAG.GT.0.AND.RATIO2.LT.1)THEN                                
+        FRC1=FRC1+(1.-RATIO2)                                          
+        TU=TU1+FRC1*DTFRZ                                             
+        QVAP=QVAP1-FRC1*DQVAP                                        
+        RATIO2=1.                                                   
+        IFLAG=1                                                    
+        GOTO 20                                                   
+      ENDIF                                                                  
+      IF(RATIO2.GT.1.)THEN                                                  
+        FRC1=FRC1-(RATIO2-1.)                                              
+        FRC1=AMAX1(0.0,FRC1)                                              
+        TU=TU1+FRC1*DTFRZ                                                
+        QVAP=QVAP1-FRC1*DQVAP                                           
+        RATIO2=1.                                                      
+        IFLAG=1                                                       
+      ENDIF                                                                   
+!                                                                            
+!  CALCULATE A HYBRID VALUE OF THETAU, ASSUMING THAT THE LATENT HEAT OF     
+!  VAPORIZATION/SUBLIMATION CAN BE ESTIMATED USING THE SAME WEIGHTING      
+!  FUNCTION AS THAT USED TO CALCULATE SATURATION VAPOR PRESSURE, CALCU-   
+!  LATE NEW LIQUID WATER AND ICE CONCENTRATIONS...                       
+!                                                                       
+   20 RLC=XLV0-XLV1*TU                                                 
+      RLS=XLS0-XLS1*TU                                                
+      RL=RATIO2*RLS+(1.-RATIO2)*RLC                                  
+      PI=(1.E5/P)**(0.2854*(1.-0.28*QVAP))                          
+      THTEU=TU*PI*EXP(RL*QVAP*C5/TU*(1.+0.81*QVAP))               
+      IF(IFLAG.EQ.1)THEN                                           
+        QICE=QICE+FRC1*DQVAP+QLIQ                                
+        QLIQ=0.                                                             
+      ELSE                                                                   
+        QICE=QICE+FRC1*(DQVAP+QLQFRZ)                                      
+        QLIQ=QLIQ-FRC1*QLQFRZ                                             
+      ENDIF                                                              
+      QNWFRZ=0.                                                         
+                                                                    
+   END SUBROUTINE DTFRZNEW
+
+!-----------------------------------------------------------------------
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC    
+!  THIS SUBROUTINE INTEGRATES THE AREA UNDER THE CURVE IN THE GAUSSIAN     
+!  DISTRIBUTION...THE NUMERICAL APPROXIMATION TO THE INTEGRAL IS TAKEN F  
+!   HANDBOOK OF MATHEMATICAL FUNCTIONS WITH FORMULAS, GRAPHS AND MATHEMA 
+!  TABLES  ED. BY ABRAMOWITZ AND STEGUN, NAT L BUREAU OF STANDARDS APPLI
+!  MATHEMATICS SERIES.  JUNE, 1964., MAY, 1968.                        
+!                                     JACK KAIN                       
+!                                     7/6/89                         
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC     
+!***********************************************************************    
+!*****    GAUSSIAN TYPE MIXING PROFILE....******************************   
+   SUBROUTINE PROF5(EQ,EE,UD)                                          
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: EQ
+   REAL,         INTENT(INOUT)   :: EE,UD
+   REAL ::       SQRT2P,A1,A2,A3,P,SIGMA,FE,X,Y,EY,E45,T1,T2,C1,C2
+
+      DATA SQRT2P,A1,A2,A3,P,SIGMA,FE/2.506628,0.4361836,-0.1201676,    & 
+      0.9372980,0.33267,0.166666667,0.202765151/                        
+      X=(EQ-0.5)/SIGMA                                                 
+      Y=6.*EQ-3.                                                      
+      EY=EXP(Y*Y/(-2))                                               
+      E45=EXP(-4.5)                                                 
+      T2=1./(1.+P*ABS(Y))                                          
+      T1=0.500498                                                 
+      C1=A1*T1+A2*T1*T1+A3*T1*T1*T1                              
+      C2=A1*T2+A2*T2*T2+A3*T2*T2*T2                             
+      IF(Y.GE.0.)THEN                                                    
+        EE=SIGMA*(0.5*(SQRT2P-E45*C1-EY*C2)+SIGMA*(E45-EY))-E45*EQ*EQ/2.
+        UD=SIGMA*(0.5*(EY*C2-E45*C1)+SIGMA*(E45-EY))-E45*(0.5+EQ*EQ/2.-  &
+           EQ)                                                         
+      ELSE                                                            
+        EE=SIGMA*(0.5*(EY*C2-E45*C1)+SIGMA*(E45-EY))-E45*EQ*EQ/2.    
+        UD=SIGMA*(0.5*(SQRT2P-E45*C1-EY*C2)+SIGMA*(E45-EY))-E45*(0.5+EQ* & 
+           EQ/2.-EQ)                                                     
+      ENDIF                                                             
+      EE=EE/FE                                                         
+      UD=UD/FE                                                        
+
+   END SUBROUTINE PROF5
+
+!-----------------------------------------------------------------------
+   SUBROUTINE TPMIX(P,THTU,TU,QU,QLIQ,QICE,QNEWLQ,QNEWIC,RATIO2,RL,    & 
+                    XLV0,XLV1,XLS0,XLS1,                               &
+                    EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE        )      
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: XLV0,XLV1
+   REAL,         INTENT(IN   )   :: P,THTU,RATIO2,RL,XLS0,             &
+                                    XLS1,EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,&
+                                    CICE,DICE
+   REAL,         INTENT(INOUT)   :: QU,QLIQ,QICE,TU,QNEWLQ,QNEWIC
+   REAL    ::    ES,QS,PI,THTGS,F0,T1,T0,C5,RV,ESLIQ,ESICE,F1,DT,QNEW, &
+                 DQ, QTOT,DQICE,DQLIQ,RLL,CCP
+   INTEGER ::    ITCNT
+!-----------------------------------------------------------------------
+!                                                                       
+!...THIS SUBROUTINE ITERATIVELY EXTRACTS WET-BULB TEMPERATURE FROM EQUIV
+!   POTENTIAL TEMPERATURE, THEN CHECKS TO SEE IF SUFFICIENT MOISTURE IS
+!   AVAILABLE TO ACHIEVE SATURATION...IF NOT, TEMPERATURE IS ADJUSTED 
+!   ACCORDINGLY, IF SO, THE RESIDUAL LIQUID WATER/ICE CONCENTRATION IS
+!   DETERMINED...                                                    
+!                                                                   
+      C5=1.0723E-3                                                 
+      RV=461.5                                                    
+!                                                                
+!   ITERATE TO FIND WET BULB TEMPERATURE AS A FUNCTION OF EQUIVALENT POT 
+!   TEMP AND PRS, ASSUMING SATURATION VAPOR PRESSURE...RATIO2 IS THE DEG
+!   OF GLACIATION...                                                   
+!                                                                     
+      IF(RATIO2.LT.1.E-6)THEN                                        
+        ES=ALIQ*EXP((BLIQ*TU-CLIQ)/(TU-DLIQ))                       
+        QS=EP2*ES/(P-ES)                                         
+        PI=(1.E5/P)**(0.2854*(1.-0.28*QS))                        
+        THTGS=TU*PI*EXP((3374.6525/TU-2.5403)*QS*(1.+0.81*QS))   
+      ELSEIF(ABS(RATIO2-1.).LT.1.E-6)THEN                       
+        ES=AICE*EXP((BICE*TU-CICE)/(TU-DICE))                  
+        QS=EP2*ES/(P-ES)                                    
+        PI=(1.E5/P)**(0.2854*(1.-0.28*QS))                   
+        THTGS=TU*PI*EXP((3114.834/TU-0.278296)*QS*(1.+0.81*QS))          
+      ELSE                                                              
+        ESLIQ=ALIQ*EXP((BLIQ*TU-CLIQ)/(TU-DLIQ))                       
+        ESICE=AICE*EXP((BICE*TU-CICE)/(TU-DICE))                      
+        ES=(1.-RATIO2)*ESLIQ+RATIO2*ESICE                            
+        QS=EP2*ES/(P-ES)                                          
+        PI=(1.E5/P)**(0.2854*(1.-0.28*QS))                         
+        THTGS=TU*PI*EXP(RL*QS*C5/TU*(1.+0.81*QS))                 
+      ENDIF                                                      
+      F0=THTGS-THTU                                             
+      T1=TU-0.5*F0                                             
+      T0=TU                                                   
+      ITCNT=0                                                
+   90 IF(RATIO2.LT.1.E-6)THEN                               
+        ES=ALIQ*EXP((BLIQ*T1-CLIQ)/(T1-DLIQ))              
+        QS=EP2*ES/(P-ES)                                 
+        PI=(1.E5/P)**(0.2854*(1.-0.28*QS))                 
+        THTGS=T1*PI*EXP((3374.6525/T1-2.5403)*QS*(1.+0.81*QS))    
+      ELSEIF(ABS(RATIO2-1.).LT.1.E-6)THEN                        
+        ES=AICE*EXP((BICE*T1-CICE)/(T1-DICE))                  
+        QS=EP2*ES/(P-ES)                                    
+        PI=(1.E5/P)**(0.2854*(1.-0.28*QS))                   
+        THTGS=T1*PI*EXP((3114.834/T1-0.278296)*QS*(1.+0.81*QS))     
+      ELSE                                                         
+        ESLIQ=ALIQ*EXP((BLIQ*T1-CLIQ)/(T1-DLIQ))                  
+        ESICE=AICE*EXP((BICE*T1-CICE)/(T1-DICE))                 
+        ES=(1.-RATIO2)*ESLIQ+RATIO2*ESICE                       
+        QS=EP2*ES/(P-ES)                                     
+        PI=(1.E5/P)**(0.2854*(1.-0.28*QS))                    
+        THTGS=T1*PI*EXP(RL*QS*C5/T1*(1.+0.81*QS))            
+      ENDIF                                                 
+      F1=THTGS-THTU                                        
+      IF(ABS(F1).LT.0.01)GOTO 50         
+      ITCNT=ITCNT+1                                               
+      IF(ITCNT.GT.10)GOTO 50                                     
+      DT=F1*(T1-T0)/(F1-F0)                                     
+      T0=T1                                                   
+      F0=F1                                                  
+      T1=T1-DT                                              
+      GOTO 90                                              
+!                                                         
+!   IF THE PARCEL IS SUPERSATURATED, CALCULATE CONCENTRATION OF FRESH    
+!   CONDENSATE...                                                       
+!                                                                      
+   50 IF(QS.LE.QU)THEN                                                
+        QNEW=QU-QS                                                   
+        QU=QS                                                       
+        GOTO 96                                                          
+      ENDIF                                                             
+!                                                                      
+!   IF THE PARCEL IS SUBSATURATED, TEMPERATURE AND MIXING RATIO MUST BE  
+!   ADJUSTED...IF LIQUID WATER OR ICE IS PRESENT, IT IS ALLOWED TO EVAPO
+!   SUBLIMATE.                                                         
+!                                                                     
+      QNEW=0.                                                        
+      DQ=QS-QU                                                      
+      QTOT=QLIQ+QICE                                               
+!                                                                 
+!   IF THERE IS ENOUGH LIQUID OR ICE TO SATURATE THE PARCEL, TEMP STAYS   
+!   WET BULB VALUE, VAPOR MIXING RATIO IS AT SATURATED LEVEL, AND THE MI 
+!   RATIOS OF LIQUID AND ICE ARE ADJUSTED TO MAKE UP THE ORIGINAL SATURA
+!   DEFICIT... OTHERWISE, ANY AVAILABLE LIQ OR ICE VAPORIZES AND APPROPR  
+!   ADJUSTMENTS TO PARCEL TEMP; VAPOR, LIQUID, AND ICE MIXING RATIOS ARE 
+!                                                                       
+!...NOTE THAT THE LIQ AND ICE MAY BE PRESENT IN PROPORTIONS SLIGHTLY DIF 
+!   THAN SUGGESTED BY THE VALUE OF RATIO2...CHECK TO MAKE SURE THAT LIQ 
+!   ICE CONCENTRATIONS ARE NOT REDUCED TO BELOW ZERO WHEN EVAPORATION/
+!   SUBLIMATION OCCURS...                                            
+!                                                                   
+      IF(QTOT.GE.DQ)THEN                                           
+        DQICE=0.0                                                 
+        DQLIQ=0.0                                                
+        QLIQ=QLIQ-(1.-RATIO2)*DQ                                
+        IF(QLIQ.LT.0.)THEN                                     
+          DQICE=0.0-QLIQ                                      
+          QLIQ=0.0                                                   
+        ENDIF                                                       
+        QICE=QICE-RATIO2*DQ+DQICE                                  
+        IF(QICE.LT.0.)THEN                                        
+          DQLIQ=0.0-QICE                                         
+          QICE=0.0                                              
+        ENDIF                                                  
+        QLIQ=QLIQ+DQLIQ                                       
+        QU=QS                                                
+        GOTO 96                                             
+      ELSE                                                  
+        IF(RATIO2.LT.1.E-6)THEN                             
+          RLL=XLV0-XLV1*T1                                             
+        ELSEIF(ABS(RATIO2-1.).LT.1.E-6)THEN                           
+          RLL=XLS0-XLS1*T1                                           
+        ELSE                                                        
+          RLL=RL                                                   
+        ENDIF                                                     
+        CCP=1005.7*(1.+0.89*QU)                                            
+        IF(QTOT.LT.1.E-10)THEN                                           
+!                                                                       
+!...IF NO LIQUID WATER OR ICE IS AVAILABLE, TEMPERATURE IS GIVEN BY:   
+          T1=T1+RLL*(DQ/(1.+DQ))/CCP                                   
+          GOTO 96                                                    
+        ELSE                                                        
+!                                                                  
+!...IF SOME LIQ WATER/ICE IS AVAILABLE, BUT NOT ENOUGH TO ACHIEVE SATURA 
+!   THE TEMPERATURE IS GIVEN BY:                                        
+          T1=T1+RLL*((DQ-QTOT)/(1+DQ-QTOT))/CCP                             
+          QU=QU+QTOT                                                      
+          QTOT=0.                                                        
+        ENDIF                                                           
+        QLIQ=0                                                         
+        QICE=0.                                                       
+      ENDIF                                                          
+   96 TU=T1                                                             
+      QNEWLQ=(1.-RATIO2)*QNEW                                          
+      QNEWIC=RATIO2*QNEW                                             
+      IF(ITCNT.GT.10)PRINT*,'***** NUMBER OF ITERATIONS IN TPMIX =',   & 
+        ITCNT                                                       
+
+   END SUBROUTINE TPMIX
+!-----------------------------------------------------------------------
+   SUBROUTINE ENVIRTHT(P1,T1,Q1,THT1,R1,RL,                            & 
+                       EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE     )
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,  INTENT(IN   ) :: P1,T1,Q1,R1,RL,EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,&
+                           BICE,CICE,DICE      
+   REAL,  INTENT(INOUT) :: THT1
+   REAL:: T00,P00,C1,C2,C3,C4,C5,EE,TLOG,TDPT,TSAT,THT,TFPT,TLOGIC,    &
+          TSATLQ,TSATIC
+
+      DATA T00,P00,C1,C2,C3,C4,C5/273.16,1.E5,3374.6525,2.5403,3114.834,&
+           0.278296,1.0723E-3/                                       
+!                                                                   
+!  CALCULATE ENVIRONMENTAL EQUIVALENT POTENTIAL TEMPERATURE...     
+!                                                                 
+
+      IF(R1.LT.1.E-6)THEN                                        
+        EE=Q1*P1/(EP2+Q1)                                     
+        TLOG=ALOG(EE/ALIQ)                                     
+        TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)                     
+        TSAT=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(T1-T00))*(T1-TDPT)
+        THT=T1*(P00/P1)**(0.2854*(1.-0.28*Q1))                        
+        THT1=THT*EXP((C1/TSAT-C2)*Q1*(1.+0.81*Q1))                   
+      ELSEIF(ABS(R1-1.).LT.1.E-6)THEN                               
+        EE=Q1*P1/(EP2+Q1)                                        
+        TLOG=ALOG(EE/AICE)                                        
+        TFPT=(CICE-DICE*TLOG)/(BICE-TLOG)                        
+        THT=T1*(P00/P1)**(0.2854*(1.-0.28*Q1))                  
+        TSAT=TFPT-(.182+1.13E-3*(TFPT-T00)-3.58E-4*(T1-T00))*(T1-TFPT)
+        THT1=THT*EXP((C3/TSAT-C4)*Q1*(1.+0.81*Q1))                   
+      ELSE                                                          
+        EE=Q1*P1/(EP2+Q1)                                        
+        TLOG=ALOG(EE/ALIQ)                                        
+        TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)                        
+        TLOGIC=ALOG(EE/AICE)                                    
+        TFPT=(CICE-DICE*TLOGIC)/(BICE-TLOGIC)                  
+        THT=T1*(P00/P1)**(0.2854*(1.-0.28*Q1))                
+        TSATLQ=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(T1-T00))*(T1-TDPT)                                                       
+        TSATIC=TFPT-(.182+1.13E-3*(TFPT-T00)-3.58E-4*(T1-T00))*(T1-TFPT) 
+        TSAT=R1*TSATIC+(1.-R1)*TSATLQ                                   
+        THT1=THT*EXP(RL*Q1*C5/TSAT*(1.+0.81*Q1))                       
+      ENDIF                                                           
+
+   END SUBROUTINE ENVIRTHT
+
+!-----------------------------------------------------------------------
+!************************* TPDD.FOR ************************************  
+!   THIS SUBROUTINE ITERATIVELY EXTRACTS TEMPERATURE FROM EQUIVALENT   * 
+!   POTENTIAL TEMP.  IT IS DESIGNED FOR USE WITH DOWNDRAFT CALCULATIONS.
+!   IF RELATIVE HUMIDITY IS SPECIFIED TO BE LESS THAN 100%, PARCEL     * 
+!   TEMP, SPECIFIC HUMIDITY, AND LIQUID WATER CONTENT ARE ITERATIVELY  *
+!   CALCULATED.                                                        * 
+!***********************************************************************
+      FUNCTION TPDD(P,THTED,TGS,RS,RD,RH,XLV0,XLV1,                    &        
+                    EP2,ALIQ,BLIQ,CLIQ,DLIQ,AICE,BICE,CICE,DICE        ) 
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,   INTENT(IN   )   :: XLV0,XLV1
+   REAL,   INTENT(IN   )   :: P,THTED,TGS,RD,RH,EP2,ALIQ,BLIQ,         &
+                              CLIQ,DLIQ,AICE,BICE,CICE,DICE 
+   REAL,   INTENT(INOUT)   :: RS
+   REAL    :: TPDD,ES,PI,THTGS,F0,T1,T0,CCP,F1,DT,RL,DSSDT,T1RH,RSRH
+   INTEGER :: ITCNT
+!-----------------------------------------------------------------------
+      ES=ALIQ*EXP((BLIQ*TGS-CLIQ)/(TGS-DLIQ))                        
+      RS=EP2*ES/(P-ES)                                            
+      PI=(1.E5/P)**(0.2854*(1.-0.28*RS))                           
+      THTGS=TGS*PI*EXP((3374.6525/TGS-2.5403)*RS*(1.+0.81*RS))    
+      F0=THTGS-THTED                                             
+      T1=TGS-0.5*F0                                             
+      T0=TGS                                                   
+      CCP=1005.7                                               
+!                                                                          
+!...ITERATE TO FIND WET-BULB TEMPERATURE...                               
+!                                                                        
+      ITCNT=0                                                           
+   90 ES=ALIQ*EXP((BLIQ*T1-CLIQ)/(T1-DLIQ))                            
+      RS=EP2*ES/(P-ES)                                              
+      PI=(1.E5/P)**(0.2854*(1.-0.28*RS))                             
+      THTGS=T1*PI*EXP((3374.6525/T1-2.5403)*RS*(1.+0.81*RS))        
+      F1=THTGS-THTED                                               
+      IF(ABS(F1).LT.0.05)GOTO 50                                  
+      ITCNT=ITCNT+1                                              
+      IF(ITCNT.GT.10)GOTO 50                                    
+      DT=F1*(T1-T0)/(F1-F0)                                    
+      T0=T1                                                
+      F0=F1                                                   
+      T1=T1-DT                                               
+      GOTO 90                                               
+   50 RL=XLV0-XLV1*T1                                        
+!                                                           
+!...IF RELATIVE HUMIDITY IS SPECIFIED TO BE LESS THAN 100%, ESTIMATE THE  
+!   TEMPERATURE AND MIXING RATIO WHICH WILL YIELD THE APPROPRIATE VALUE. 
+!                                                                       
+      IF(RH.EQ.1.)GOTO 110                                             
+      DSSDT=(CLIQ-BLIQ*DLIQ)/((T1-DLIQ)*(T1-DLIQ))                    
+      DT=RL*RS*(1.-RH)/(CCP+RL*RH*RS*DSSDT)                           
+      T1RH=T1+DT                                                    
+      ES=RH*ALIQ*EXP((BLIQ*T1RH-CLIQ)/(T1RH-DLIQ))                        
+      RSRH=EP2*ES/(P-ES)                                               
+!                                                                       
+!...CHECK TO SEE IF MIXING RATIO AT SPECIFIED RH IS LESS THAN ACTUAL   
+!...MIXING RATIO...IF SO, ADJUST TO GIVE ZERO EVAPORATION...          
+!                                                                    
+      IF(RSRH.LT.RD)THEN                                            
+        RSRH=RD                                                    
+        T1RH=T1+(RS-RSRH)*RL/CCP                                   
+      ENDIF                                                      
+      T1=T1RH                                                   
+      RS=RSRH                                                  
+  110 TPDD=T1                                                 
+      IF(ITCNT.GT.10)PRINT*,'***** NUMBER OF ITERATIONS IN TPDD = ',  & 
+        ITCNT                                                         
+
+   END FUNCTION TPDD
+
+!====================================================================
+   SUBROUTINE kfinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,           &
+                     RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS,         &
+                     P_FIRST_SCALAR,restart,allowed_to_read,        &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte                   )
+!--------------------------------------------------------------------   
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+   LOGICAL , INTENT(IN)           ::  restart, allowed_to_read
+   INTEGER , INTENT(IN)           ::  ids, ide, jds, jde, kds, kde, &
+                                      ims, ime, jms, jme, kms, kme, &
+                                      its, ite, jts, jte, kts, kte
+   INTEGER , INTENT(IN)           ::  P_QI,P_QS,P_FIRST_SCALAR
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+                                                          RTHCUTEN, &
+                                                          RQVCUTEN, &
+                                                          RQCCUTEN, &
+                                                          RQRCUTEN, &
+                                                          RQICUTEN, &
+                                                          RQSCUTEN
+
+   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
+
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+ 
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+ 
+   IF(.not.restart)THEN
+     DO j=jts,jtf
+     DO k=kts,ktf
+     DO i=its,itf
+        RTHCUTEN(i,k,j)=0.
+        RQVCUTEN(i,k,j)=0.
+        RQCCUTEN(i,k,j)=0.
+        RQRCUTEN(i,k,j)=0.
+     ENDDO
+     ENDDO
+     ENDDO
+
+     IF (P_QI .ge. P_FIRST_SCALAR) THEN
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           RQICUTEN(i,k,j)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+     ENDIF
+
+     IF (P_QS .ge. P_FIRST_SCALAR) THEN
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           RQSCUTEN(i,k,j)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+     ENDIF
+
+     DO j=jts,jtf
+     DO i=its,itf
+        NCA(i,j)=-100.
+     ENDDO
+     ENDDO
+
+     DO j=jts,jtf
+     DO k=kts,ktf
+     DO i=its,itf
+        W0AVG(i,k,j)=0.
+     ENDDO
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   END SUBROUTINE kfinit
+
+!-------------------------------------------------------
+
+END MODULE module_cu_kf
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_cu_kfeta.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_cu_kfeta.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_cu_kfeta.F	(revision 2744)
@@ -0,0 +1,2861 @@
+MODULE module_cu_kfeta
+
+   USE module_wrf_error
+
+!--------------------------------------------------------------------
+! Lookup table variables:
+      INTEGER, PARAMETER :: KFNT=250,KFNP=220
+      REAL, DIMENSION(KFNT,KFNP),PRIVATE, SAVE :: TTAB,QSTAB
+      REAL, DIMENSION(KFNP),PRIVATE, SAVE :: THE0K
+      REAL, DIMENSION(200),PRIVATE, SAVE :: ALU
+      REAL, PRIVATE, SAVE :: RDPR,RDTHK,PLUTOP
+! Note:  KF Lookup table is used by subroutines KF_eta_PARA, TPMIX2,
+!        TPMIX2DD, ENVIRTHT
+! End of Lookup table variables:
+
+CONTAINS
+
+   SUBROUTINE KF_eta_CPS(                                    &
+              ids,ide, jds,jde, kds,kde                      &
+             ,ims,ime, jms,jme, kms,kme                      &
+             ,its,ite, jts,jte, kts,kte                      &
+             ,DT,KTAU,DX                                     &
+             ,rho,RAINCV,NCA                                 &
+             ,U,V,TH,T,W,dz8w,Pcps,pi                        &
+             ,W0AVG,XLV0,XLV1,XLS0,XLS1,CP,R,G,EP1           &
+             ,EP2,SVP1,SVP2,SVP3,SVPT0                       &
+             ,STEPCU,CU_ACT_FLAG,warm_rain,CUTOP,CUBOT       &
+             ,QV                                             &
+            ! optionals
+             ,F_QV    ,F_QC    ,F_QR    ,F_QI    ,F_QS       &
+             ,RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN            &
+             ,RQICUTEN,RQSCUTEN                              &
+                                                             )
+!
+!-------------------------------------------------------------
+   IMPLICIT NONE
+!-------------------------------------------------------------
+   INTEGER,      INTENT(IN   ) ::                            &
+                                  ids,ide, jds,jde, kds,kde, &
+                                  ims,ime, jms,jme, kms,kme, &
+                                  its,ite, jts,jte, kts,kte
+
+   INTEGER,      INTENT(IN   ) :: STEPCU
+   LOGICAL,      INTENT(IN   ) :: warm_rain
+
+   REAL,         INTENT(IN   ) :: XLV0,XLV1,XLS0,XLS1
+   REAL,         INTENT(IN   ) :: CP,R,G,EP1,EP2
+   REAL,         INTENT(IN   ) :: SVP1,SVP2,SVP3,SVPT0
+
+   INTEGER,      INTENT(IN   ) :: KTAU           
+
+   REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         , &
+          INTENT(IN   ) ::                                   &
+                                                          U, &
+                                                          V, &
+                                                          W, &
+                                                         TH, &
+                                                          T, &
+                                                         QV, &
+                                                       dz8w, &
+                                                       Pcps, &
+                                                        rho, &
+                                                         pi
+!
+   REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         , &
+          INTENT(INOUT) ::                                   &
+                                                      W0AVG
+
+   REAL,  INTENT(IN   ) :: DT, DX
+!
+   REAL, DIMENSION( ims:ime , jms:jme ),                     &
+          INTENT(INOUT) ::                           RAINCV
+
+   REAL,    DIMENSION( ims:ime , jms:jme ),                  &
+            INTENT(INOUT) ::                            NCA
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                     &
+          INTENT(OUT) ::                              CUBOT, &
+                                                      CUTOP    
+
+   LOGICAL, DIMENSION( ims:ime , jms:jme ),                  &
+          INTENT(INOUT) :: CU_ACT_FLAG
+
+!
+! Optional arguments
+!
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),           &
+         OPTIONAL,                                           &
+         INTENT(INOUT) ::                                    &
+                                                   RTHCUTEN, &
+                                                   RQVCUTEN, &
+                                                   RQCCUTEN, &
+                                                   RQRCUTEN, &
+                                                   RQICUTEN, &
+                                                   RQSCUTEN
+
+!
+! Flags relating to the optional tendency arrays declared above
+! Models that carry the optional tendencies will provdide the
+! optional arguments at compile time; these flags all the model
+! to determine at run-time whether a particular tracer is in
+! use or not.
+!
+   LOGICAL, OPTIONAL ::                                      &
+                                                   F_QV      &
+                                                  ,F_QC      &
+                                                  ,F_QR      &
+                                                  ,F_QI      &
+                                                  ,F_QS
+
+
+! LOCAL VARS
+
+   LOGICAL :: flag_qr, flag_qi, flag_qs
+
+   REAL, DIMENSION( kts:kte ) ::                             &
+                                                        U1D, &
+                                                        V1D, &
+                                                        T1D, &
+                                                       DZ1D, &
+                                                       QV1D, &
+                                                        P1D, &
+                                                      RHO1D, &
+                                                    W0AVG1D
+
+   REAL, DIMENSION( kts:kte )::                              &
+                                                       DQDT, &
+                                                      DQIDT, &
+                                                      DQCDT, &
+                                                      DQRDT, &
+                                                      DQSDT, &
+                                                       DTDT
+
+   REAL    ::         TST,tv,PRS,RHOE,W0,SCR1,DXSQ,tmp,RTHCUMAX
+
+   INTEGER :: i,j,k,NTST,ICLDCK
+!
+   DXSQ=DX*DX
+
+!----------------------
+   NTST=STEPCU
+   TST=float(NTST*2)
+   flag_qr = .FALSE.
+   flag_qi = .FALSE.
+   flag_qs = .FALSE.
+   IF ( PRESENT(F_QR) ) flag_qr = F_QR
+   IF ( PRESENT(F_QI) ) flag_qi = F_QI
+   IF ( PRESENT(F_QS) ) flag_qs = F_QS
+!
+  DO J = jts,jte
+      DO K=kts,kte
+         DO I= its,ite
+!            SCR1=-5.0E-4*G*rho(I,K,J)*(w(I,K,J)+w(I,K+1,J))
+!            TV=T(I,K,J)*(1.+EP1*QV(I,K,J))
+!            RHOE=Pcps(I,K,J)/(R*TV)
+!            W0=-101.9368*SCR1/RHOE
+            W0=0.5*(w(I,K,J)+w(I,K+1,J))
+            W0AVG(I,K,J)=(W0AVG(I,K,J)*(TST-1.)+W0)/TST
+         ENDDO
+      ENDDO
+   ENDDO
+!
+!...CHECK FOR CONVECTIVE INITIATION EVERY 5 MINUTES (OR NTST/2)...
+!
+!----------------------
+   ICLDCK=MOD(KTAU,NTST)
+   IF(ICLDCK.EQ.0 .or. KTAU .eq. 1) then
+!
+     DO J = jts,jte
+     DO I= its,ite
+        CU_ACT_FLAG(i,j) = .true.
+     ENDDO
+     ENDDO
+
+     DO J = jts,jte
+       DO I=its,ite
+
+         IF ( NINT(NCA(I,J)) .gt. 0 ) then
+            CU_ACT_FLAG(i,j) = .false.
+         ELSE
+
+            DO k=kts,kte
+               DQDT(k)=0.
+               DQIDT(k)=0.
+               DQCDT(k)=0.
+               DQRDT(k)=0.
+               DQSDT(k)=0.
+               DTDT(k)=0.
+            ENDDO
+            RAINCV(I,J)=0.
+            CUTOP(I,J)=KTS
+            CUBOT(I,J)=KTE+1
+!
+! assign vars from 3D to 1D
+
+            DO K=kts,kte
+               U1D(K) =U(I,K,J)
+               V1D(K) =V(I,K,J)
+               T1D(K) =T(I,K,J)
+               RHO1D(K) =rho(I,K,J)
+               QV1D(K)=QV(I,K,J)
+               P1D(K) =Pcps(I,K,J)
+               W0AVG1D(K) =W0AVG(I,K,J)
+               DZ1D(k)=dz8w(I,K,J)
+            ENDDO
+            CALL KF_eta_PARA(I, J,                  &
+                 U1D,V1D,T1D,QV1D,P1D,DZ1D,         &
+                 W0AVG1D,DT,DX,DXSQ,RHO1D,          &
+                 XLV0,XLV1,XLS0,XLS1,CP,R,G,        &
+                 EP2,SVP1,SVP2,SVP3,SVPT0,          &
+                 DQDT,DQIDT,DQCDT,DQRDT,DQSDT,DTDT, &
+                 RAINCV,NCA,NTST,                   &
+                 flag_QI,flag_QS,warm_rain,         &
+                 CUTOP,CUBOT,                       &
+                 ids,ide, jds,jde, kds,kde,         &
+                 ims,ime, jms,jme, kms,kme,         &
+                 its,ite, jts,jte, kts,kte)
+            IF(PRESENT(rthcuten).AND.PRESENT(rqvcuten)) THEN
+              DO K=kts,kte
+                 RTHCUTEN(I,K,J)=DTDT(K)/pi(I,K,J)
+!              RTHCUMAX=max(abs(RTHCUTEN(I,K,J)),RTHCUMAX)
+                 RQVCUTEN(I,K,J)=DQDT(K)
+              ENDDO
+            ENDIF
+
+            IF(PRESENT(rqrcuten).AND.PRESENT(rqccuten)) THEN
+              IF( F_QR )THEN
+                DO K=kts,kte
+                   RQRCUTEN(I,K,J)=DQRDT(K)
+                   RQCCUTEN(I,K,J)=DQCDT(K)
+                ENDDO
+              ELSE
+! This is the case for Eta microphysics without 3d rain field
+                DO K=kts,kte
+                   RQRCUTEN(I,K,J)=0.
+                   RQCCUTEN(I,K,J)=DQRDT(K)+DQCDT(K)
+                ENDDO
+              ENDIF
+            ENDIF
+
+!......     QSTEN STORES GRAUPEL TENDENCY IF IT EXISTS, OTHERISE SNOW (V2)
+
+
+            IF(PRESENT( rqicuten )) THEN
+              IF ( F_QI ) THEN
+                DO K=kts,kte
+                   RQICUTEN(I,K,J)=DQIDT(K)
+                ENDDO
+              ENDIF
+            ENDIF
+
+            IF(PRESENT( rqscuten )) THEN
+              IF ( F_QS ) THEN
+                DO K=kts,kte
+                   RQSCUTEN(I,K,J)=DQSDT(K)
+                ENDDO
+              ENDIF
+            ENDIF
+!
+         ENDIF 
+       ENDDO
+     ENDDO
+   ENDIF
+!
+   END SUBROUTINE KF_eta_CPS
+! ****************************************************************************
+!-----------------------------------------------------------
+   SUBROUTINE KF_eta_PARA (I, J,                           &
+                      U0,V0,T0,QV0,P0,DZQ,W0AVG1D,         &
+                      DT,DX,DXSQ,rhoe,                     &
+                      XLV0,XLV1,XLS0,XLS1,CP,R,G,          &
+                      EP2,SVP1,SVP2,SVP3,SVPT0,            &
+                      DQDT,DQIDT,DQCDT,DQRDT,DQSDT,DTDT,   &
+                      RAINCV,NCA,NTST,                     &
+                      F_QI,F_QS,warm_rain,                 &
+                      CUTOP,CUBOT,                         &
+                      ids,ide, jds,jde, kds,kde,           &
+                      ims,ime, jms,jme, kms,kme,           &
+                      its,ite, jts,jte, kts,kte)
+!-----------------------------------------------------------
+!***** The KF scheme that is currently used in experimental runs of EMCs 
+!***** Eta model....jsk 8/00
+!
+      IMPLICIT NONE
+!-----------------------------------------------------------
+      INTEGER, INTENT(IN   ) :: ids,ide, jds,jde, kds,kde, &
+                                ims,ime, jms,jme, kms,kme, &
+                                its,ite, jts,jte, kts,kte, &
+                                I,J,NTST
+          ! ,P_QI,P_QS,P_FIRST_SCALAR
+
+      LOGICAL, INTENT(IN   ) :: F_QI, F_QS
+
+      LOGICAL, INTENT(IN   ) :: warm_rain
+!
+      REAL, DIMENSION( kts:kte ),                          &
+            INTENT(IN   ) ::                           U0, &
+                                                       V0, &
+                                                       T0, &
+                                                      QV0, &
+                                                       P0, &
+                                                     rhoe, &
+                                                      DZQ, &
+                                                  W0AVG1D
+!
+      REAL,  INTENT(IN   ) :: DT,DX,DXSQ
+!
+
+      REAL,  INTENT(IN   ) :: XLV0,XLV1,XLS0,XLS1,CP,R,G
+      REAL,  INTENT(IN   ) :: EP2,SVP1,SVP2,SVP3,SVPT0
+
+!
+      REAL, DIMENSION( kts:kte ), INTENT(INOUT) ::         &
+                                                     DQDT, &
+                                                    DQIDT, &
+                                                    DQCDT, &
+                                                    DQRDT, &
+                                                    DQSDT, &
+                                                     DTDT
+
+      REAL,    DIMENSION( ims:ime , jms:jme ),             &
+            INTENT(INOUT) ::                          NCA
+
+      REAL, DIMENSION( ims:ime , jms:jme ),                &
+            INTENT(INOUT) ::                       RAINCV
+
+      REAL, DIMENSION( ims:ime , jms:jme ),                &
+            INTENT(OUT) ::                          CUBOT, &
+                                                    CUTOP
+!
+!...DEFINE LOCAL VARIABLES...
+!
+      REAL, DIMENSION( kts:kte ) ::                        &
+            Q0,Z0,TV0,TU,TVU,QU,TZ,TVD,                    &
+            QD,QES,THTES,TG,TVG,QG,WU,WD,W0,EMS,EMSD,      &
+            UMF,UER,UDR,DMF,DER,DDR,UMF2,UER2,             &
+            UDR2,DMF2,DER2,DDR2,DZA,THTA0,THETEE,          &
+            THTAU,THETEU,THTAD,THETED,QLIQ,QICE,           &
+            QLQOUT,QICOUT,PPTLIQ,PPTICE,DETLQ,DETIC,       &
+            DETLQ2,DETIC2,RATIO,RATIO2
+
+
+      REAL, DIMENSION( kts:kte ) ::                        &
+            DOMGDP,EXN,TVQU,DP,RH,EQFRC,WSPD,              &
+            QDT,FXM,THTAG,THPA,THFXOUT,                    &
+            THFXIN,QPA,QFXOUT,QFXIN,QLPA,QLFXIN,           &
+            QLFXOUT,QIPA,QIFXIN,QIFXOUT,QRPA,              &
+            QRFXIN,QRFXOUT,QSPA,QSFXIN,QSFXOUT,            &
+            QL0,QLG,QI0,QIG,QR0,QRG,QS0,QSG
+
+
+      REAL, DIMENSION( kts:kte+1 ) :: OMG
+      REAL, DIMENSION( kts:kte ) :: RAINFB,SNOWFB
+      REAL, DIMENSION( kts:kte ) ::                        &
+            CLDHGT,QSD,DILFRC,DDILFRC,TKE,TGU,QGU,THTEEG
+
+! LOCAL VARS
+
+      REAL    :: P00,T00,RLF,RHIC,RHBC,PIE,         &
+                 TTFRZ,TBFRZ,C5,RATE
+      REAL    :: GDRY,ROCP,ALIQ,BLIQ,                      &
+                 CLIQ,DLIQ
+      REAL    :: FBFRC,P300,DPTHMX,THMIX,QMIX,ZMIX,PMIX,   &
+                 ROCPQ,TMIX,EMIX,TLOG,TDPT,TLCL,TVLCL,     &
+                 CPORQ,PLCL,ES,DLP,TENV,QENV,TVEN,TVBAR,   &
+                 ZLCL,WKL,WABS,TRPPT,WSIGNE,DTLCL,GDT,WLCL,&
+                 TVAVG,QESE,WTW,RHOLCL,AU0,VMFLCL,UPOLD,   &
+                 UPNEW,ABE,WKLCL,TTEMP,FRC1,   &
+                 QNEWIC,RL,R1,QNWFRZ,EFFQ,BE,BOTERM,ENTERM,&
+                 DZZ,UDLBE,REI,EE2,UD2,TTMP,F1,F2,         &
+                 THTTMP,QTMP,TMPLIQ,TMPICE,TU95,TU10,EE1,  &
+                 UD1,DPTT,QNEWLQ,DUMFDP,EE,TSAT,           &
+                 THTA,VCONV,TIMEC,SHSIGN,VWS,PEF, &
+                 CBH,RCBH,PEFCBH,PEFF,PEFF2,TDER,THTMIN,   &
+                 DTMLTD,QS,TADVEC,DPDD,FRC,DPT,RDD,A1,     &
+                 DSSDT,DTMP,T1RH,QSRH,PPTFLX,CPR,CNDTNF,   &
+                 UPDINC,AINCM2,DEVDMF,PPR,RCED,DPPTDF,     &
+                 DMFLFS,DMFLFS2,RCED2,DDINC,AINCMX,AINCM1, &
+                 AINC,TDER2,PPTFL2,FABE,STAB,DTT,DTT1,     &
+                 DTIME,TMA,TMB,TMM,BCOEFF,ACOEFF,QVDIFF,   &
+                 TOPOMG,CPM,DQ,ABEG,DABE,DFDA,FRC2,DR,     &
+                 UDFRC,TUC,QGS,RH0,RHG,QINIT,QFNL,ERR2,    &
+                 RELERR,RLC,RLS,RNC,FABEOLD,AINCOLD,UEFRC, &
+                 DDFRC,TDC,DEFRC,RHBAR,DMFFRC,DPMIN,DILBE
+   REAL    ::    ASTRT,TP,VALUE,AINTRP,TKEMAX,QFRZ,&
+                 QSS,PPTMLT,DTMELT,RHH,EVAC,BINC
+!
+      INTEGER :: INDLU,NU,NUCHM,NNN,KLFS
+   REAL    :: CHMIN,PM15,CHMAX,DTRH,RAD,DPPP
+   REAL    :: TVDIFF,DTTOT,ABSOMG,ABSOMGTC,FRDP
+
+      INTEGER :: KX,K,KL
+!
+      INTEGER :: NCHECK
+      INTEGER, DIMENSION (kts:kte) :: KCHECK
+
+      INTEGER :: ISTOP,ML,L5,KMIX,LOW,                     &
+                 LC,MXLAYR,LLFC,NLAYRS,NK,                 &
+                 KPBL,KLCL,LCL,LET,IFLAG,                  &
+                 NK1,LTOP,NJ,LTOP1,                        &
+                 LTOPM1,LVF,KSTART,KMIN,LFS,               &
+                 ND,NIC,LDB,LDT,ND1,NDK,                   &
+                 NM,LMAX,NCOUNT,NOITR,                     &
+                 NSTEP,NTC,NCHM,ISHALL,NSHALL
+      LOGICAL :: IPRNT
+      CHARACTER*1024 message
+!
+      DATA P00,T00/1.E5,273.16/
+      DATA RLF/3.339E5/
+      DATA RHIC,RHBC/1.,0.90/
+      DATA PIE,TTFRZ,TBFRZ,C5/3.141592654,268.16,248.16,1.0723E-3/
+      DATA RATE/0.03/
+!-----------------------------------------------------------
+      IPRNT=.FALSE.
+      GDRY=-G/CP
+      ROCP=R/CP
+      NSHALL = 0
+      KL=kte
+      KX=kte
+!
+!     ALIQ = 613.3
+!     BLIQ = 17.502
+!     CLIQ = 4780.8
+!     DLIQ = 32.19
+      ALIQ = SVP1*1000.
+      BLIQ = SVP2
+      CLIQ = SVP2*SVPT0
+      DLIQ = SVP3
+!
+!
+!****************************************************************************
+!                                                      ! PPT FB MODS
+!...OPTION TO FEED CONVECTIVELY GENERATED RAINWATER    ! PPT FB MODS
+!...INTO GRID-RESOLVED RAINWATER (OR SNOW/GRAUPEL)     ! PPT FB MODS
+!...FIELD.  "FBFRC" IS THE FRACTION OF AVAILABLE       ! PPT FB MODS
+!...PRECIPITATION TO BE FED BACK (0.0 - 1.0)...        ! PPT FB MODS
+      FBFRC=0.0                                        ! PPT FB MODS
+!...mods to allow shallow convection...
+      NCHM = 0
+      ISHALL = 0
+      DPMIN = 5.E3
+!...
+      P300=P0(1)-30000.
+!
+!...PRESSURE PERTURBATION TERM IS ONLY DEFINED AT MID-POINT OF
+!...VERTICAL LAYERS...SINCE TOTAL PRESSURE IS NEEDED AT THE TOP AND
+!...BOTTOM OF LAYERS BELOW, DO AN INTERPOLATION...
+!
+!...INPUT A VERTICAL SOUNDING ... NOTE THAT MODEL LAYERS ARE NUMBERED
+!...FROM BOTTOM-UP IN THE KF SCHEME...
+!
+      ML=0 
+!SUE  tmprpsb=1./PSB(I,J)
+!SUE  CELL=PTOP*tmprpsb
+!
+      DO K=1,KX
+!
+!...IF Q0 IS ABOVE SATURATION VALUE, REDUCE IT TO SATURATION LEVEL...
+!
+         ES=ALIQ*EXP((BLIQ*T0(K)-CLIQ)/(T0(K)-DLIQ))
+         QES(K)=0.622*ES/(P0(K)-ES)
+         Q0(K)=AMIN1(QES(K),QV0(K))
+         Q0(K)=AMAX1(0.000001,Q0(K))
+         QL0(K)=0.
+         QI0(K)=0.
+         QR0(K)=0.
+         QS0(K)=0.
+         RH(K) = Q0(K)/QES(K)
+         DILFRC(K) = 1.
+         TV0(K)=T0(K)*(1.+0.608*Q0(K))
+!        RHOE(K)=P0(K)/(R*TV0(K))
+!   DP IS THE PRESSURE INTERVAL BETWEEN FULL SIGMA LEVELS...
+         DP(K)=rhoe(k)*g*DZQ(k)
+! IF Turbulent Kinetic Energy (TKE) is available from turbulent mixing scheme
+! use it for shallow convection...For now, assume it is not available....
+!         TKE(K) = Q2(I,J,NK)
+         TKE(K) = 0.
+         CLDHGT(K) = 0.
+!        IF(P0(K).GE.500E2)L5=K
+         IF(P0(K).GE.0.5*P0(1))L5=K
+         IF(P0(K).GE.P300)LLFC=K
+         IF(T0(K).GT.T00)ML=K
+      ENDDO
+!
+!...DZQ IS DZ BETWEEN SIGMA SURFACES, DZA IS DZ BETWEEN MODEL HALF LEVEL
+        Z0(1)=.5*DZQ(1)
+!cdir novector
+        DO K=2,KL
+          Z0(K)=Z0(K-1)+.5*(DZQ(K)+DZQ(K-1))
+          DZA(K-1)=Z0(K)-Z0(K-1)
+        ENDDO   
+        DZA(KL)=0.
+!
+!
+!  To save time, specify a pressure interval to move up in sequential
+!  check of different ~50 mb deep groups of adjacent model layers in
+!  the process of identifying updraft source layer (USL).  Note that 
+!  this search is terminated as soon as a buoyant parcel is found and 
+!  this parcel can produce a cloud greater than specifed minimum depth
+!  (CHMIN)...For now, set interval at 15 mb...
+!
+       NCHECK = 1
+       KCHECK(NCHECK)=1
+       PM15 = P0(1)-15.E2
+       DO K=2,LLFC
+         IF(P0(K).LT.PM15)THEN
+           NCHECK = NCHECK+1
+           KCHECK(NCHECK) = K
+           PM15 = PM15-15.E2
+         ENDIF
+       ENDDO
+!
+       NU=0
+       NUCHM=0
+usl:   DO
+           NU = NU+1
+           IF(NU.GT.NCHECK)THEN 
+             IF(ISHALL.EQ.1)THEN
+               CHMAX = 0.
+               NCHM = 0
+               DO NK = 1,NCHECK
+                 NNN=KCHECK(NK)
+                 IF(CLDHGT(NNN).GT.CHMAX)THEN
+                   NCHM = NNN
+                   NUCHM = NK
+                   CHMAX = CLDHGT(NNN)
+                 ENDIF
+               ENDDO
+               NU = NUCHM-1
+               FBFRC=1.
+               CYCLE usl
+             ELSE
+               RETURN
+             ENDIF
+           ENDIF      
+           KMIX = KCHECK(NU)
+           LOW=KMIX
+!...
+           LC = LOW
+!
+!...ASSUME THAT IN ORDER TO SUPPORT A DEEP UPDRAFT YOU NEED A LAYER OF
+!...UNSTABLE AIR AT LEAST 50 mb DEEP...TO APPROXIMATE THIS, ISOLATE A
+!...GROUP OF ADJACENT INDIVIDUAL MODEL LAYERS, WITH THE BASE AT LEVEL
+!...LC, SUCH THAT THE COMBINED DEPTH OF THESE LAYERS IS AT LEAST 50 mb..
+!   
+           NLAYRS=0
+           DPTHMX=0.
+           NK=LC-1
+           IF ( NK+1 .LT. KTS ) THEN
+             WRITE(message,*)'WOULD GO OFF BOTTOM: KF_ETA_PARA I,J,NK',I,J,NK
+             CALL wrf_message (TRIM(message)) 
+           ELSE
+             DO 
+               NK=NK+1   
+               IF ( NK .GT. KTE ) THEN
+                 WRITE(message,*)'WOULD GO OFF TOP: KF_ETA_PARA I,J,DPTHMX,DPMIN',I,J,DPTHMX,DPMIN
+                 CALL wrf_message (TRIM(message))
+                 EXIT
+               ENDIF
+               DPTHMX=DPTHMX+DP(NK)
+               NLAYRS=NLAYRS+1
+               IF(DPTHMX.GT.DPMIN)THEN
+                 EXIT 
+               ENDIF
+             END DO    
+           ENDIF
+           IF(DPTHMX.LT.DPMIN)THEN 
+             RETURN
+           ENDIF
+           KPBL=LC+NLAYRS-1   
+!
+!...********************************************************
+!...for computational simplicity without much loss in accuracy,
+!...mix temperature instead of theta for evaluating convective
+!...initiation (triggering) potential...
+!          THMIX=0.
+           TMIX=0.
+           QMIX=0.
+           ZMIX=0.
+           PMIX=0.
+!
+!...FIND THE THERMODYNAMIC CHARACTERISTICS OF THE LAYER BY
+!...MASS-WEIGHTING THE CHARACTERISTICS OF THE INDIVIDUAL MODEL
+!...LAYERS...
+!
+!cdir novector
+           DO NK=LC,KPBL
+             TMIX=TMIX+DP(NK)*T0(NK)
+             QMIX=QMIX+DP(NK)*Q0(NK)
+             ZMIX=ZMIX+DP(NK)*Z0(NK)
+             PMIX=PMIX+DP(NK)*P0(NK)
+           ENDDO   
+!         THMIX=THMIX/DPTHMX
+          TMIX=TMIX/DPTHMX
+          QMIX=QMIX/DPTHMX
+          ZMIX=ZMIX/DPTHMX
+          PMIX=PMIX/DPTHMX
+          EMIX=QMIX*PMIX/(0.622+QMIX)
+!
+!...FIND THE TEMPERATURE OF THE MIXTURE AT ITS LCL...
+!
+!        TLOG=ALOG(EMIX/ALIQ)
+! ...calculate dewpoint using lookup table...
+!
+          astrt=1.e-3
+          ainc=0.075
+          a1=emix/aliq
+          tp=(a1-astrt)/ainc
+          indlu=int(tp)+1
+          value=(indlu-1)*ainc+astrt
+          aintrp=(a1-value)/ainc
+          tlog=aintrp*alu(indlu+1)+(1-aintrp)*alu(indlu)
+          TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)
+          TLCL=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(TMIX-T00))*(TMIX-TDPT)
+          TLCL=AMIN1(TLCL,TMIX)
+          TVLCL=TLCL*(1.+0.608*QMIX)
+          ZLCL = ZMIX+(TLCL-TMIX)/GDRY
+          NK = LC-1
+          DO 
+            NK = NK+1
+            KLCL=NK
+            IF(ZLCL.LE.Z0(NK) .or. NK.GT.KL)THEN
+              EXIT
+            ENDIF 
+          ENDDO   
+          IF(NK.GT.KL)THEN
+            RETURN  
+          ENDIF
+          K=KLCL-1
+          DLP=(ZLCL-Z0(K))/(Z0(KLCL)-Z0(K))
+!     
+!...ESTIMATE ENVIRONMENTAL TEMPERATURE AND MIXING RATIO AT THE LCL...
+!     
+          TENV=T0(K)+(T0(KLCL)-T0(K))*DLP
+          QENV=Q0(K)+(Q0(KLCL)-Q0(K))*DLP
+          TVEN=TENV*(1.+0.608*QENV)
+!     
+!...CHECK TO SEE IF CLOUD IS BUOYANT USING FRITSCH-CHAPPELL TRIGGER
+!...FUNCTION DESCRIBED IN KAIN AND FRITSCH (1992)...W0 IS AN
+!...APROXIMATE VALUE FOR THE RUNNING-MEAN GRID-SCALE VERTICAL
+!...VELOCITY, WHICH GIVES SMOOTHER FIELDS OF CONVECTIVE INITIATION
+!...THAN THE INSTANTANEOUS VALUE...FORMULA RELATING TEMPERATURE
+!...PERTURBATION TO VERTICAL VELOCITY HAS BEEN USED WITH THE MOST
+!...SUCCESS AT GRID LENGTHS NEAR 25 km.  FOR DIFFERENT GRID-LENGTHS,
+!...ADJUST VERTICAL VELOCITY TO EQUIVALENT VALUE FOR 25 KM GRID
+!...LENGTH, ASSUMING LINEAR DEPENDENCE OF W ON GRID LENGTH...
+!     
+          IF(ZLCL.LT.2.E3)THEN
+            WKLCL=0.02*ZLCL/2.E3
+          ELSE
+            WKLCL=0.02
+          ENDIF
+          WKL=(W0AVG1D(K)+(W0AVG1D(KLCL)-W0AVG1D(K))*DLP)*DX/25.E3-WKLCL
+          IF(WKL.LT.0.0001)THEN
+            DTLCL=0.
+          ELSE 
+            DTLCL=4.64*WKL**0.33
+          ENDIF
+!
+!...for ETA model, give parcel an extra temperature perturbation based
+!...the threshold RH for condensation (U00)...
+!
+!...for now, just assume U00=0.75...
+!...!!!!!! for MM5, SET DTRH = 0. !!!!!!!!
+!         U00 = 0.75
+!         IF(U00.lt.1.)THEN
+!           QSLCL=QES(K)+(QES(KLCL)-QES(K))*DLP
+!           RHLCL = QENV/QSLCL
+!           DQSSDT = QMIX*(CLIQ-BLIQ*DLIQ)/((TLCL-DLIQ)*(TLCL-DLIQ))
+!           IF(RHLCL.ge.0.75 .and. RHLCL.le.0.95)then
+!             DTRH = 0.25*(RHLCL-0.75)*QMIX/DQSSDT
+!           ELSEIF(RHLCL.GT.0.95)THEN
+!             DTRH = (1./RHLCL-1.)*QMIX/DQSSDT
+!           ELSE
+               DTRH = 0.
+!           ENDIF
+!         ENDIF   
+!         IF(ISHALL.EQ.1)IPRNT=.TRUE.
+!         IPRNT=.TRUE.
+!         IF(TLCL+DTLCL.GT.TENV)GOTO 45
+!
+trigger:  IF(TLCL+DTLCL+DTRH.LT.TENV)THEN   
+!
+! Parcel not buoyant, CYCLE back to start of trigger and evaluate next potential USL...
+!
+            CYCLE usl
+!
+          ELSE                            ! Parcel is buoyant, determine updraft
+!     
+!...CONVECTIVE TRIGGERING CRITERIA HAS BEEN SATISFIED...COMPUTE
+!...EQUIVALENT POTENTIAL TEMPERATURE
+!...(THETEU) AND VERTICAL VELOCITY OF THE RISING PARCEL AT THE LCL...
+!     
+            CALL ENVIRTHT(PMIX,TMIX,QMIX,THETEU(K),ALIQ,BLIQ,CLIQ,DLIQ)
+!
+!...modify calculation of initial parcel vertical velocity...jsk 11/26/97
+!
+            DTTOT = DTLCL+DTRH
+            IF(DTTOT.GT.1.E-4)THEN
+              GDT=2.*G*DTTOT*500./TVEN
+              WLCL=1.+0.5*SQRT(GDT)
+              WLCL = AMIN1(WLCL,3.)
+            ELSE
+              WLCL=1.
+            ENDIF
+            PLCL=P0(K)+(P0(KLCL)-P0(K))*DLP
+            WTW=WLCL*WLCL
+!
+            TVLCL=TLCL*(1.+0.608*QMIX)
+            RHOLCL=PLCL/(R*TVLCL)
+!        
+            LCL=KLCL
+            LET=LCL
+! make RAD a function of background vertical velocity...
+            IF(WKL.LT.0.)THEN
+              RAD = 1000.
+            ELSEIF(WKL.GT.0.1)THEN
+              RAD = 2000.
+            ELSE
+              RAD = 1000.+1000*WKL/0.1
+            ENDIF
+!     
+!*******************************************************************
+!                                                                  *
+!                 COMPUTE UPDRAFT PROPERTIES                       *
+!                                                                  *
+!*******************************************************************
+!     
+!     
+!...
+!...ESTIMATE INITIAL UPDRAFT MASS FLUX (UMF(K))...
+!     
+            WU(K)=WLCL
+            AU0=0.01*DXSQ
+            UMF(K)=RHOLCL*AU0
+            VMFLCL=UMF(K)
+            UPOLD=VMFLCL
+            UPNEW=UPOLD
+!     
+!...RATIO2 IS THE DEGREE OF GLACIATION IN THE CLOUD (0 TO 1),
+!...UER IS THE ENVIR ENTRAINMENT RATE, ABE IS AVAILABLE
+!...BUOYANT ENERGY, TRPPT IS THE TOTAL RATE OF PRECIPITATION
+!...PRODUCTION...
+!     
+            RATIO2(K)=0.
+            UER(K)=0.
+            ABE=0.
+            TRPPT=0.
+            TU(K)=TLCL
+            TVU(K)=TVLCL
+            QU(K)=QMIX
+            EQFRC(K)=1.
+            QLIQ(K)=0.
+            QICE(K)=0.
+            QLQOUT(K)=0.
+            QICOUT(K)=0.
+            DETLQ(K)=0.
+            DETIC(K)=0.
+            PPTLIQ(K)=0.
+            PPTICE(K)=0.
+            IFLAG=0
+!     
+!...TTEMP IS USED DURING CALCULATION OF THE LINEAR GLACIATION
+!...PROCESS; IT IS INITIALLY SET TO THE TEMPERATURE AT WHICH
+!...FREEZING IS SPECIFIED TO BEGIN.  WITHIN THE GLACIATION
+!...INTERVAL, IT IS SET EQUAL TO THE UPDRAFT TEMP AT THE
+!...PREVIOUS MODEL LEVEL...
+!     
+            TTEMP=TTFRZ
+!     
+!...ENTER THE LOOP FOR UPDRAFT CALCULATIONS...CALCULATE UPDRAFT TEMP,
+!...MIXING RATIO, VERTICAL MASS FLUX, LATERAL DETRAINMENT OF MASS AND
+!...MOISTURE, PRECIPITATION RATES AT EACH MODEL LEVEL...
+!     
+!     
+            EE1=1.
+            UD1=0.
+            REI = 0.
+            DILBE = 0.
+updraft:    DO NK=K,KL-1
+              NK1=NK+1
+              RATIO2(NK1)=RATIO2(NK)
+              FRC1=0.
+              TU(NK1)=T0(NK1)
+              THETEU(NK1)=THETEU(NK)
+              QU(NK1)=QU(NK)
+              QLIQ(NK1)=QLIQ(NK)
+              QICE(NK1)=QICE(NK)
+              call tpmix2(p0(nk1),theteu(nk1),tu(nk1),qu(nk1),qliq(nk1),        &
+                     qice(nk1),qnewlq,qnewic,XLV1,XLV0)
+!
+!
+!...CHECK TO SEE IF UPDRAFT TEMP IS ABOVE THE TEMPERATURE AT WHICH
+!...GLACIATION IS ASSUMED TO INITIATE; IF IT IS, CALCULATE THE
+!...FRACTION OF REMAINING LIQUID WATER TO FREEZE...TTFRZ IS THE
+!...TEMP AT WHICH FREEZING BEGINS, TBFRZ THE TEMP BELOW WHICH ALL
+!...LIQUID WATER IS FROZEN AT EACH LEVEL...
+!
+              IF(TU(NK1).LE.TTFRZ)THEN
+                IF(TU(NK1).GT.TBFRZ)THEN
+                  IF(TTEMP.GT.TTFRZ)TTEMP=TTFRZ
+                  FRC1=(TTEMP-TU(NK1))/(TTEMP-TBFRZ)
+                ELSE
+                  FRC1=1.
+                  IFLAG=1
+                ENDIF
+                TTEMP=TU(NK1)
+!
+!  DETERMINE THE EFFECTS OF LIQUID WATER FREEZING WHEN TEMPERATURE
+!...IS BELOW TTFRZ...
+!
+                QFRZ = (QLIQ(NK1)+QNEWLQ)*FRC1
+                QNEWIC=QNEWIC+QNEWLQ*FRC1
+                QNEWLQ=QNEWLQ-QNEWLQ*FRC1
+                QICE(NK1) = QICE(NK1)+QLIQ(NK1)*FRC1
+                QLIQ(NK1) = QLIQ(NK1)-QLIQ(NK1)*FRC1
+                CALL DTFRZNEW(TU(NK1),P0(NK1),THETEU(NK1),QU(NK1),QFRZ,         &
+                          QICE(NK1),ALIQ,BLIQ,CLIQ,DLIQ)
+              ENDIF
+              TVU(NK1)=TU(NK1)*(1.+0.608*QU(NK1))
+!
+!  CALCULATE UPDRAFT VERTICAL VELOCITY AND PRECIPITATION FALLOUT...
+!
+              IF(NK.EQ.K)THEN
+                BE=(TVLCL+TVU(NK1))/(TVEN+TV0(NK1))-1.
+                BOTERM=2.*(Z0(NK1)-ZLCL)*G*BE/1.5
+                DZZ=Z0(NK1)-ZLCL
+              ELSE
+                BE=(TVU(NK)+TVU(NK1))/(TV0(NK)+TV0(NK1))-1.
+                BOTERM=2.*DZA(NK)*G*BE/1.5
+                DZZ=DZA(NK)
+              ENDIF
+              ENTERM=2.*REI*WTW/UPOLD
+
+              CALL CONDLOAD(QLIQ(NK1),QICE(NK1),WTW,DZZ,BOTERM,ENTERM,      &
+                        RATE,QNEWLQ,QNEWIC,QLQOUT(NK1),QICOUT(NK1),G)
+!
+!...IF VERT VELOCITY IS LESS THAN ZERO, EXIT THE UPDRAFT LOOP AND,
+!...IF CLOUD IS TALL ENOUGH, FINALIZE UPDRAFT CALCULATIONS...
+!
+              IF(WTW.LT.1.E-3)THEN
+                EXIT
+              ELSE
+                WU(NK1)=SQRT(WTW)
+              ENDIF
+!...Calculate value of THETA-E in environment to entrain into updraft...
+!
+              CALL ENVIRTHT(P0(NK1),T0(NK1),Q0(NK1),THETEE(NK1),ALIQ,BLIQ,CLIQ,DLIQ)
+!
+!...REI IS THE RATE OF ENVIRONMENTAL INFLOW...
+!
+              REI=VMFLCL*DP(NK1)*0.03/RAD
+              TVQU(NK1)=TU(NK1)*(1.+0.608*QU(NK1)-QLIQ(NK1)-QICE(NK1))
+              IF(NK.EQ.K)THEN
+                DILBE=((TVLCL+TVQU(NK1))/(TVEN+TV0(NK1))-1.)*DZZ
+              ELSE
+                DILBE=((TVQU(NK)+TVQU(NK1))/(TV0(NK)+TV0(NK1))-1.)*DZZ
+              ENDIF
+              IF(DILBE.GT.0.)ABE=ABE+DILBE*G
+!
+!...IF CLOUD PARCELS ARE VIRTUALLY COLDER THAN THE ENVIRONMENT, MINIMAL 
+!...ENTRAINMENT (0.5*REI) IS IMPOSED...
+!
+              IF(TVQU(NK1).LE.TV0(NK1))THEN    ! Entrain/Detrain IF BLOCK
+                EE2=0.5
+                UD2=1.
+                EQFRC(NK1)=0.
+              ELSE
+                LET=NK1
+                TTMP=TVQU(NK1)
+!
+!...DETERMINE THE CRITICAL MIXED FRACTION OF UPDRAFT AND ENVIRONMENTAL AIR...
+!
+                F1=0.95
+                F2=1.-F1
+                THTTMP=F1*THETEE(NK1)+F2*THETEU(NK1)
+                QTMP=F1*Q0(NK1)+F2*QU(NK1)
+                TMPLIQ=F2*QLIQ(NK1)
+                TMPICE=F2*QICE(NK1)
+                call tpmix2(p0(nk1),thttmp,ttmp,qtmp,tmpliq,tmpice,        &
+                           qnewlq,qnewic,XLV1,XLV0)
+                TU95=TTMP*(1.+0.608*QTMP-TMPLIQ-TMPICE)
+                IF(TU95.GT.TV0(NK1))THEN
+                  EE2=1.
+                  UD2=0.
+                  EQFRC(NK1)=1.0
+                ELSE
+                  F1=0.10
+                  F2=1.-F1
+                  THTTMP=F1*THETEE(NK1)+F2*THETEU(NK1)
+                  QTMP=F1*Q0(NK1)+F2*QU(NK1)
+                  TMPLIQ=F2*QLIQ(NK1)
+                  TMPICE=F2*QICE(NK1)
+                  call tpmix2(p0(nk1),thttmp,ttmp,qtmp,tmpliq,tmpice,        &
+                               qnewlq,qnewic,XLV1,XLV0)
+                  TU10=TTMP*(1.+0.608*QTMP-TMPLIQ-TMPICE)
+                  TVDIFF = ABS(TU10-TVQU(NK1))
+                  IF(TVDIFF.LT.1.e-3)THEN
+                    EE2=1.
+                    UD2=0.
+                    EQFRC(NK1)=1.0
+                  ELSE
+                    EQFRC(NK1)=(TV0(NK1)-TVQU(NK1))*F1/(TU10-TVQU(NK1))
+                    EQFRC(NK1)=AMAX1(0.0,EQFRC(NK1))
+                    EQFRC(NK1)=AMIN1(1.0,EQFRC(NK1))
+                    IF(EQFRC(NK1).EQ.1)THEN
+                      EE2=1.
+                      UD2=0.
+                    ELSEIF(EQFRC(NK1).EQ.0.)THEN
+                      EE2=0.
+                      UD2=1.
+                    ELSE
+!
+!...SUBROUTINE PROF5 INTEGRATES OVER THE GAUSSIAN DIST TO DETERMINE THE
+!   FRACTIONAL ENTRAINMENT AND DETRAINMENT RATES...
+!
+                      CALL PROF5(EQFRC(NK1),EE2,UD2)
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDIF                            ! End of Entrain/Detrain IF BLOCK
+!
+!
+!...NET ENTRAINMENT AND DETRAINMENT RATES ARE GIVEN BY THE AVERAGE FRACTIONAL
+!   VALUES IN THE LAYER...
+!
+              EE2 = AMAX1(EE2,0.5)
+              UD2 = 1.5*UD2
+              UER(NK1)=0.5*REI*(EE1+EE2)
+              UDR(NK1)=0.5*REI*(UD1+UD2)
+!
+!...IF THE CALCULATED UPDRAFT DETRAINMENT RATE IS GREATER THAN THE TOTAL
+!   UPDRAFT MASS FLUX, ALL CLOUD MASS DETRAINS, EXIT UPDRAFT CALCULATIONS...
+!
+              IF(UMF(NK)-UDR(NK1).LT.10.)THEN
+!
+!...IF THE CALCULATED DETRAINED MASS FLUX IS GREATER THAN THE TOTAL UPD MASS
+!   FLUX, IMPOSE TOTAL DETRAINMENT OF UPDRAFT MASS AT THE PREVIOUS MODEL LVL..
+!   First, correct ABE calculation if needed...
+!
+                IF(DILBE.GT.0.)THEN
+                  ABE=ABE-DILBE*G
+                ENDIF
+                LET=NK
+!               WRITE(98,1015)P0(NK1)/100.
+                EXIT 
+              ELSE
+                EE1=EE2
+                UD1=UD2
+                UPOLD=UMF(NK)-UDR(NK1)
+                UPNEW=UPOLD+UER(NK1)
+                UMF(NK1)=UPNEW
+                DILFRC(NK1) = UPNEW/UPOLD
+!
+!...DETLQ AND DETIC ARE THE RATES OF DETRAINMENT OF LIQUID AND
+!...ICE IN THE DETRAINING UPDRAFT MASS...
+!
+                DETLQ(NK1)=QLIQ(NK1)*UDR(NK1)
+                DETIC(NK1)=QICE(NK1)*UDR(NK1)
+                QDT(NK1)=QU(NK1)
+                QU(NK1)=(UPOLD*QU(NK1)+UER(NK1)*Q0(NK1))/UPNEW
+                THETEU(NK1)=(THETEU(NK1)*UPOLD+THETEE(NK1)*UER(NK1))/UPNEW
+                QLIQ(NK1)=QLIQ(NK1)*UPOLD/UPNEW
+                QICE(NK1)=QICE(NK1)*UPOLD/UPNEW
+!
+!...PPTLIQ IS THE RATE OF GENERATION (FALLOUT) OF
+!...LIQUID PRECIP AT A GIVEN MODEL LVL, PPTICE THE SAME FOR ICE,
+!...TRPPT IS THE TOTAL RATE OF PRODUCTION OF PRECIP UP TO THE
+!...CURRENT MODEL LEVEL...
+!
+                PPTLIQ(NK1)=QLQOUT(NK1)*UMF(NK)
+                PPTICE(NK1)=QICOUT(NK1)*UMF(NK)
+!
+                TRPPT=TRPPT+PPTLIQ(NK1)+PPTICE(NK1)
+                IF(NK1.LE.KPBL)UER(NK1)=UER(NK1)+VMFLCL*DP(NK1)/DPTHMX
+              ENDIF
+!
+            END DO updraft
+!
+!...CHECK CLOUD DEPTH...IF CLOUD IS TALL ENOUGH, ESTIMATE THE EQUILIBRIU
+!   TEMPERATURE LEVEL (LET) AND ADJUST MASS FLUX PROFILE AT CLOUD TOP SO
+!   THAT MASS FLUX DECREASES TO ZERO AS A LINEAR FUNCTION OF PRESSURE BE
+!   THE LET AND CLOUD TOP...
+!     
+!...LTOP IS THE MODEL LEVEL JUST BELOW THE LEVEL AT WHICH VERTICAL VELOC
+!   FIRST BECOMES NEGATIVE...
+!     
+            LTOP=NK
+            CLDHGT(LC)=Z0(LTOP)-ZLCL 
+!
+!...Instead of using the same minimum cloud height (for deep convection)
+!...everywhere, try specifying minimum cloud depth as a function of TLCL...
+!
+!
+!
+            IF(TLCL.GT.293.)THEN
+              CHMIN = 4.E3
+            ELSEIF(TLCL.LE.293. .and. TLCL.GE.273)THEN
+              CHMIN = 2.E3 + 100.*(TLCL-273.)
+            ELSEIF(TLCL.LT.273.)THEN
+              CHMIN = 2.E3
+            ENDIF
+
+!     
+!...If cloud top height is less than the specified minimum for deep 
+!...convection, save value to consider this level as source for 
+!...shallow convection, go back up to check next level...
+!     
+!...Try specifying minimum cloud depth as a function of TLCL...
+!
+!
+!...DO NOT ALLOW ANY CLOUD FROM THIS LAYER IF:
+!
+!...            1.) if there is no CAPE, or 
+!...            2.) cloud top is at model level just above LCL, or
+!...            3.) cloud top is within updraft source layer, or
+!...            4.) cloud-top detrainment layer begins within 
+!...                updraft source layer.
+!
+            IF(LTOP.LE.KLCL .or. LTOP.LE.KPBL .or. LET+1.LE.KPBL)THEN  ! No Convection Allowed
+              CLDHGT(LC)=0.
+              DO NK=K,LTOP
+                UMF(NK)=0.
+                UDR(NK)=0.
+                UER(NK)=0.
+                DETLQ(NK)=0.
+                DETIC(NK)=0.
+                PPTLIQ(NK)=0.
+                PPTICE(NK)=0.
+              ENDDO
+!        
+            ELSEIF(CLDHGT(LC).GT.CHMIN .and. ABE.GT.1)THEN      ! Deep Convection allowed
+              ISHALL=0
+              EXIT usl
+            ELSE
+!
+!...TO DISALLOW SHALLOW CONVECTION, COMMENT OUT NEXT LINE !!!!!!!!
+              ISHALL = 1
+              IF(NU.EQ.NUCHM)THEN
+                EXIT usl               ! Shallow Convection from this layer
+              ELSE
+! Remember this layer (by virtue of non-zero CLDHGT) as potential shallow-cloud layer
+                DO NK=K,LTOP
+                  UMF(NK)=0.
+                  UDR(NK)=0.
+                  UER(NK)=0.
+                  DETLQ(NK)=0.
+                  DETIC(NK)=0.
+                  PPTLIQ(NK)=0.
+                  PPTICE(NK)=0.
+                ENDDO
+              ENDIF
+            ENDIF
+          ENDIF trigger
+        END DO usl
+    IF(ISHALL.EQ.1)THEN
+      KSTART=MAX0(KPBL,KLCL)
+      LET=KSTART
+    endif
+!     
+!...IF THE LET AND LTOP ARE THE SAME, DETRAIN ALL OF THE UPDRAFT MASS FL
+!   THIS LEVEL...
+!     
+    IF(LET.EQ.LTOP)THEN
+      UDR(LTOP)=UMF(LTOP)+UDR(LTOP)-UER(LTOP)
+      DETLQ(LTOP)=QLIQ(LTOP)*UDR(LTOP)*UPNEW/UPOLD
+      DETIC(LTOP)=QICE(LTOP)*UDR(LTOP)*UPNEW/UPOLD
+      UER(LTOP)=0.
+      UMF(LTOP)=0.
+    ELSE 
+!     
+!   BEGIN TOTAL DETRAINMENT AT THE LEVEL ABOVE THE LET...
+!     
+      DPTT=0.
+      DO NJ=LET+1,LTOP
+        DPTT=DPTT+DP(NJ)
+      ENDDO
+      DUMFDP=UMF(LET)/DPTT
+!     
+!...ADJUST MASS FLUX PROFILES, DETRAINMENT RATES, AND PRECIPITATION FALL
+!   RATES TO REFLECT THE LINEAR DECREASE IN MASS FLX BETWEEN THE LET AND
+!     
+      DO NK=LET+1,LTOP
+!
+!...entrainment is allowed at every level except for LTOP, so disallow
+!...entrainment at LTOP and adjust entrainment rates between LET and LTOP
+!...so the the dilution factor due to entyrianment is not changed but 
+!...the actual entrainment rate will change due due forced total 
+!...detrainment in this layer...
+!
+        IF(NK.EQ.LTOP)THEN
+          UDR(NK) = UMF(NK-1)
+          UER(NK) = 0.
+          DETLQ(NK) = UDR(NK)*QLIQ(NK)*DILFRC(NK)
+          DETIC(NK) = UDR(NK)*QICE(NK)*DILFRC(NK)
+        ELSE
+          UMF(NK)=UMF(NK-1)-DP(NK)*DUMFDP
+          UER(NK)=UMF(NK)*(1.-1./DILFRC(NK))
+          UDR(NK)=UMF(NK-1)-UMF(NK)+UER(NK)
+          DETLQ(NK)=UDR(NK)*QLIQ(NK)*DILFRC(NK)
+          DETIC(NK)=UDR(NK)*QICE(NK)*DILFRC(NK)
+        ENDIF
+        IF(NK.GE.LET+2)THEN
+          TRPPT=TRPPT-PPTLIQ(NK)-PPTICE(NK)
+          PPTLIQ(NK)=UMF(NK-1)*QLQOUT(NK)
+          PPTICE(NK)=UMF(NK-1)*QICOUT(NK)
+          TRPPT=TRPPT+PPTLIQ(NK)+PPTICE(NK)
+        ENDIF
+      ENDDO
+    ENDIF
+!     
+! Initialize some arrays below cloud base and above cloud top...
+!
+    DO NK=1,K
+      IF(NK.GE.LC)THEN
+        IF(NK.EQ.LC)THEN
+          UMF(NK)=VMFLCL*DP(NK)/DPTHMX
+          UER(NK)=VMFLCL*DP(NK)/DPTHMX
+        ELSEIF(NK.LE.KPBL)THEN
+          UER(NK)=VMFLCL*DP(NK)/DPTHMX
+          UMF(NK)=UMF(NK-1)+UER(NK)
+        ELSE
+          UMF(NK)=VMFLCL
+          UER(NK)=0.
+        ENDIF
+        TU(NK)=TMIX+(Z0(NK)-ZMIX)*GDRY
+        QU(NK)=QMIX
+        WU(NK)=WLCL
+      ELSE
+        TU(NK)=0.
+        QU(NK)=0.
+        UMF(NK)=0.
+        WU(NK)=0.
+        UER(NK)=0.
+      ENDIF
+      UDR(NK)=0.
+      QDT(NK)=0.
+      QLIQ(NK)=0.
+      QICE(NK)=0.
+      QLQOUT(NK)=0.
+      QICOUT(NK)=0.
+      PPTLIQ(NK)=0.
+      PPTICE(NK)=0.
+      DETLQ(NK)=0.
+      DETIC(NK)=0.
+      RATIO2(NK)=0.
+      CALL ENVIRTHT(P0(NK),T0(NK),Q0(NK),THETEE(NK),ALIQ,BLIQ,CLIQ,DLIQ)
+      EQFRC(NK)=1.0
+    ENDDO
+!     
+      LTOP1=LTOP+1
+      LTOPM1=LTOP-1
+!     
+!...DEFINE VARIABLES ABOVE CLOUD TOP...
+!     
+      DO NK=LTOP1,KX
+        UMF(NK)=0.
+        UDR(NK)=0.
+        UER(NK)=0.
+        QDT(NK)=0.
+        QLIQ(NK)=0.
+        QICE(NK)=0.
+        QLQOUT(NK)=0.
+        QICOUT(NK)=0.
+        DETLQ(NK)=0.
+        DETIC(NK)=0.
+        PPTLIQ(NK)=0.
+        PPTICE(NK)=0.
+        IF(NK.GT.LTOP1)THEN
+          TU(NK)=0.
+          QU(NK)=0.
+          WU(NK)=0.
+        ENDIF
+        THTA0(NK)=0.
+        THTAU(NK)=0.
+        EMS(NK)=0.
+        EMSD(NK)=0.
+        TG(NK)=T0(NK)
+        QG(NK)=Q0(NK)
+        QLG(NK)=0.
+        QIG(NK)=0.
+        QRG(NK)=0.
+        QSG(NK)=0.
+        OMG(NK)=0.
+      ENDDO
+        OMG(KX+1)=0.
+        DO NK=1,LTOP
+          EMS(NK)=DP(NK)*DXSQ/G
+          EMSD(NK)=1./EMS(NK)
+!     
+!...INITIALIZE SOME VARIABLES TO BE USED LATER IN THE VERT ADVECTION SCH
+!     
+          EXN(NK)=(P00/P0(NK))**(0.2854*(1.-0.28*QDT(NK)))
+          THTAU(NK)=TU(NK)*EXN(NK)
+          EXN(NK)=(P00/P0(NK))**(0.2854*(1.-0.28*Q0(NK)))
+          THTA0(NK)=T0(NK)*EXN(NK)
+          DDILFRC(NK) = 1./DILFRC(NK)
+          OMG(NK)=0.
+        ENDDO
+!     IF (XTIME.LT.10.)THEN
+!      WRITE(98,1025)KLCL,ZLCL,DTLCL,LTOP,P0(LTOP),IFLAG,
+!    * TMIX-T00,PMIX,QMIX,ABE
+!      WRITE(98,1030)P0(LET)/100.,P0(LTOP)/100.,VMFLCL,PLCL/100.,
+!    * WLCL,CLDHGT
+!     ENDIF
+!     
+!...COMPUTE CONVECTIVE TIME SCALE(TIMEC). THE MEAN WIND AT THE LCL
+!...AND MIDTROPOSPHERE IS USED.
+!     
+        WSPD(KLCL)=SQRT(U0(KLCL)*U0(KLCL)+V0(KLCL)*V0(KLCL))
+        WSPD(L5)=SQRT(U0(L5)*U0(L5)+V0(L5)*V0(L5))
+        WSPD(LTOP)=SQRT(U0(LTOP)*U0(LTOP)+V0(LTOP)*V0(LTOP))
+        VCONV=.5*(WSPD(KLCL)+WSPD(L5))
+!...for ETA model, DX is a function of location...
+!       TIMEC=DX(I,J)/VCONV
+        TIMEC=DX/VCONV
+        TADVEC=TIMEC
+        TIMEC=AMAX1(1800.,TIMEC)
+        TIMEC=AMIN1(3600.,TIMEC)
+        IF(ISHALL.EQ.1)TIMEC=2400.
+        NIC=NINT(TIMEC/DT)
+        TIMEC=FLOAT(NIC)*DT
+!     
+!...COMPUTE WIND SHEAR AND PRECIPITATION EFFICIENCY.
+!     
+        IF(WSPD(LTOP).GT.WSPD(KLCL))THEN
+          SHSIGN=1.
+        ELSE
+          SHSIGN=-1.
+        ENDIF
+        VWS=(U0(LTOP)-U0(KLCL))*(U0(LTOP)-U0(KLCL))+(V0(LTOP)-V0(KLCL))*   &
+            (V0(LTOP)-V0(KLCL))
+        VWS=1.E3*SHSIGN*SQRT(VWS)/(Z0(LTOP)-Z0(LCL))
+        PEF=1.591+VWS*(-.639+VWS*(9.53E-2-VWS*4.96E-3))
+        PEF=AMAX1(PEF,.2)
+        PEF=AMIN1(PEF,.9)
+!     
+!...PRECIPITATION EFFICIENCY IS A FUNCTION OF THE HEIGHT OF CLOUD BASE.
+!     
+        CBH=(ZLCL-Z0(1))*3.281E-3
+        IF(CBH.LT.3.)THEN
+          RCBH=.02
+        ELSE
+          RCBH=.96729352+CBH*(-.70034167+CBH*(.162179896+CBH*(-            &
+               1.2569798E-2+CBH*(4.2772E-4-CBH*5.44E-6))))
+        ENDIF
+        IF(CBH.GT.25)RCBH=2.4
+        PEFCBH=1./(1.+RCBH)
+        PEFCBH=AMIN1(PEFCBH,.9)
+!     
+!... MEAN PEF. IS USED TO COMPUTE RAINFALL.
+!     
+        PEFF=.5*(PEF+PEFCBH)
+        PEFF2 = PEFF                                ! JSK MODS
+       IF(IPRNT)THEN  
+         WRITE(98,1035)PEF,PEFCBH,LC,LET,WKL,VWS
+!       call flush(98)   
+       endif     
+!        WRITE(98,1035)PEF,PEFCBH,LC,LET,WKL,VWS
+!*****************************************************************
+!                                                                *
+!                  COMPUTE DOWNDRAFT PROPERTIES                  *
+!                                                                *
+!*****************************************************************
+!     
+!     
+       TDER=0.
+ devap:IF(ISHALL.EQ.1)THEN
+         LFS = 1
+       ELSE
+!
+!...start downdraft about 150 mb above cloud base...
+!
+!        KSTART=MAX0(KPBL,KLCL)
+!        KSTART=KPBL                                  ! Changed 7/23/99
+         KSTART=KPBL+1                                ! Changed 7/23/99
+         KLFS = LET-1
+         DO NK = KSTART+1,KL
+           DPPP = P0(KSTART)-P0(NK)
+!          IF(DPPP.GT.200.E2)THEN
+           IF(DPPP.GT.150.E2)THEN
+             KLFS = NK
+             EXIT 
+           ENDIF
+         ENDDO
+         KLFS = MIN0(KLFS,LET-1)
+         LFS = KLFS
+!
+!...if LFS is not at least 50 mb above cloud base (implying that the 
+!...level of equil temp, LET, is just above cloud base) do not allow a
+!...downdraft...
+!
+        IF((P0(KSTART)-P0(LFS)).GT.50.E2)THEN
+          THETED(LFS) = THETEE(LFS)
+          QD(LFS) = Q0(LFS)
+!
+!...call tpmix2dd to find wet-bulb temp, qv...
+!
+          call tpmix2dd(p0(lfs),theted(lfs),tz(lfs),qss,i,j)
+          THTAD(LFS)=TZ(LFS)*(P00/P0(LFS))**(0.2854*(1.-0.28*QSS))
+!     
+!...TAKE A FIRST GUESS AT THE INITIAL DOWNDRAFT MASS FLUX...
+!     
+          TVD(LFS)=TZ(LFS)*(1.+0.608*QSS)
+          RDD=P0(LFS)/(R*TVD(LFS))
+          A1=(1.-PEFF)*AU0
+          DMF(LFS)=-A1*RDD
+          DER(LFS)=DMF(LFS)
+          DDR(LFS)=0.
+          RHBAR = RH(LFS)*DP(LFS)
+          DPTT = DP(LFS)
+          DO ND = LFS-1,KSTART,-1
+            ND1 = ND+1
+            DER(ND)=DER(LFS)*EMS(ND)/EMS(LFS)
+            DDR(ND)=0.
+            DMF(ND)=DMF(ND1)+DER(ND)
+            THETED(ND)=(THETED(ND1)*DMF(ND1)+THETEE(ND)*DER(ND))/DMF(ND)
+            QD(ND)=(QD(ND1)*DMF(ND1)+Q0(ND)*DER(ND))/DMF(ND)    
+            DPTT = DPTT+DP(ND)
+            RHBAR = RHBAR+RH(ND)*DP(ND)
+          ENDDO
+          RHBAR = RHBAR/DPTT
+          DMFFRC = 2.*(1.-RHBAR)
+          DPDD = 0.
+!...Calculate melting effect
+!... first, compute total frozen precipitation generated...
+!
+          pptmlt = 0.
+          DO NK = KLCL,LTOP
+            PPTMLT = PPTMLT+PPTICE(NK)
+          ENDDO
+          if(lc.lt.ml)then
+!...For now, calculate melting effect as if DMF = -UMF at KLCL, i.e., as
+!...if DMFFRC=1.  Otherwise, for small DMFFRC, DTMELT gets too large!
+!...12/14/98 jsk...
+            DTMELT = RLF*PPTMLT/(CP*UMF(KLCL))
+          else
+            DTMELT = 0.
+          endif
+          LDT = MIN0(LFS-1,KSTART-1)
+!
+          call tpmix2dd(p0(kstart),theted(kstart),tz(kstart),qss,i,j)
+!
+          tz(kstart) = tz(kstart)-dtmelt
+          ES=ALIQ*EXP((BLIQ*TZ(KSTART)-CLIQ)/(TZ(KSTART)-DLIQ))
+          QSS=0.622*ES/(P0(KSTART)-ES)
+          THETED(KSTART)=TZ(KSTART)*(1.E5/P0(KSTART))**(0.2854*(1.-0.28*QSS))*    &
+                EXP((3374.6525/TZ(KSTART)-2.5403)*QSS*(1.+0.81*QSS))
+!....  
+          LDT = MIN0(LFS-1,KSTART-1)
+          DO ND = LDT,1,-1
+            DPDD = DPDD+DP(ND)
+            THETED(ND) = THETED(KSTART)
+            QD(ND)     = QD(KSTART)       
+!
+!...call tpmix2dd to find wet bulb temp, saturation mixing ratio...
+!
+            call tpmix2dd(p0(nd),theted(nd),tz(nd),qss,i,j)
+            qsd(nd) = qss
+!
+!...specify RH decrease of 20%/km in downdraft...
+!
+            RHH = 1.-0.2/1000.*(Z0(KSTART)-Z0(ND))
+!
+!...adjust downdraft TEMP, Q to specified RH:
+!
+            IF(RHH.LT.1.)THEN
+              DSSDT=(CLIQ-BLIQ*DLIQ)/((TZ(ND)-DLIQ)*(TZ(ND)-DLIQ))
+              RL=XLV0-XLV1*TZ(ND)
+              DTMP=RL*QSS*(1.-RHH)/(CP+RL*RHH*QSS*DSSDT)
+              T1RH=TZ(ND)+DTMP
+              ES=RHH*ALIQ*EXP((BLIQ*T1RH-CLIQ)/(T1RH-DLIQ))
+              QSRH=0.622*ES/(P0(ND)-ES)
+!
+!...CHECK TO SEE IF MIXING RATIO AT SPECIFIED RH IS LESS THAN ACTUAL
+!...MIXING RATIO...IF SO, ADJUST TO GIVE ZERO EVAPORATION...
+!
+              IF(QSRH.LT.QD(ND))THEN
+                QSRH=QD(ND)
+                T1RH=TZ(ND)+(QSS-QSRH)*RL/CP
+              ENDIF
+              TZ(ND)=T1RH
+              QSS=QSRH
+              QSD(ND) = QSS
+            ENDIF         
+            TVD(nd) = tz(nd)*(1.+0.608*qsd(nd))
+            IF(TVD(ND).GT.TV0(ND).OR.ND.EQ.1)THEN
+              LDB=ND
+              EXIT
+            ENDIF
+          ENDDO
+          IF((P0(LDB)-P0(LFS)) .gt. 50.E2)THEN   ! minimum Downdraft depth! 
+            DO ND=LDT,LDB,-1
+              ND1 = ND+1
+              DDR(ND) = -DMF(KSTART)*DP(ND)/DPDD
+              DER(ND) = 0.
+              DMF(ND) = DMF(ND1)+DDR(ND)
+              TDER=TDER+(QSD(nd)-QD(ND))*DDR(ND)
+              QD(ND)=QSD(nd)
+              THTAD(ND)=TZ(ND)*(P00/P0(ND))**(0.2854*(1.-0.28*QD(ND)))
+            ENDDO
+          ENDIF
+        ENDIF
+      ENDIF devap
+!
+!...IF DOWNDRAFT DOES NOT EVAPORATE ANY WATER FOR SPECIFIED RELATIVE
+!...HUMIDITY, NO DOWNDRAFT IS ALLOWED...
+!
+d_mf:   IF(TDER.LT.1.)THEN
+!           WRITE(98,3004)I,J 
+!3004       FORMAT(' ','No Downdraft!;  I=',I3,2X,'J=',I3,'ISHALL =',I2)
+          PPTFLX=TRPPT
+          CPR=TRPPT
+          TDER=0.
+          CNDTNF=0.
+          UPDINC=1.
+          LDB=LFS
+          DO NDK=1,LTOP
+            DMF(NDK)=0.
+            DER(NDK)=0.
+            DDR(NDK)=0.
+            THTAD(NDK)=0.
+            WD(NDK)=0.
+            TZ(NDK)=0.
+            QD(NDK)=0.
+          ENDDO
+          AINCM2=100.
+        ELSE 
+          DDINC = -DMFFRC*UMF(KLCL)/DMF(KSTART)
+          UPDINC=1.
+          IF(TDER*DDINC.GT.TRPPT)THEN
+            DDINC = TRPPT/TDER
+          ENDIF
+          TDER = TDER*DDINC
+          DO NK=LDB,LFS
+            DMF(NK)=DMF(NK)*DDINC
+            DER(NK)=DER(NK)*DDINC
+            DDR(NK)=DDR(NK)*DDINC
+          ENDDO
+         CPR=TRPPT
+         PPTFLX = TRPPT-TDER
+         PEFF=PPTFLX/TRPPT
+         IF(IPRNT)THEN
+           write(98,*)'PRECIP EFFICIENCY =',PEFF
+!          call flush(98)   
+         ENDIF
+!
+!
+!...ADJUST UPDRAFT MASS FLUX, MASS DETRAINMENT RATE, AND LIQUID WATER AN
+!   DETRAINMENT RATES TO BE CONSISTENT WITH THE TRANSFER OF THE ESTIMATE
+!   FROM THE UPDRAFT TO THE DOWNDRAFT AT THE LFS...
+!     
+!         DO NK=LC,LFS
+!           UMF(NK)=UMF(NK)*UPDINC
+!           UDR(NK)=UDR(NK)*UPDINC
+!           UER(NK)=UER(NK)*UPDINC
+!           PPTLIQ(NK)=PPTLIQ(NK)*UPDINC
+!           PPTICE(NK)=PPTICE(NK)*UPDINC
+!           DETLQ(NK)=DETLQ(NK)*UPDINC
+!           DETIC(NK)=DETIC(NK)*UPDINC
+!         ENDDO
+!     
+!...ZERO OUT THE ARRAYS FOR DOWNDRAFT DATA AT LEVELS ABOVE AND BELOW THE
+!...DOWNDRAFT...
+!     
+         IF(LDB.GT.1)THEN
+           DO NK=1,LDB-1
+             DMF(NK)=0.
+             DER(NK)=0.
+             DDR(NK)=0.
+             WD(NK)=0.
+             TZ(NK)=0.
+             QD(NK)=0.
+             THTAD(NK)=0.
+           ENDDO
+         ENDIF
+         DO NK=LFS+1,KX
+           DMF(NK)=0.
+           DER(NK)=0.
+           DDR(NK)=0.
+           WD(NK)=0.
+           TZ(NK)=0.
+           QD(NK)=0.
+           THTAD(NK)=0.
+         ENDDO
+         DO NK=LDT+1,LFS-1
+           TZ(NK)=0.
+           QD(NK)=0.
+           THTAD(NK)=0.
+         ENDDO
+       ENDIF d_mf
+!
+!...SET LIMITS ON THE UPDRAFT AND DOWNDRAFT MASS FLUXES SO THAT THE INFL
+!   INTO CONVECTIVE DRAFTS FROM A GIVEN LAYER IS NO MORE THAN IS AVAILAB
+!   IN THAT LAYER INITIALLY...
+!     
+       AINCMX=1000.
+       LMAX=MAX0(KLCL,LFS)
+       DO NK=LC,LMAX
+         IF((UER(NK)-DER(NK)).GT.1.e-3)THEN
+           AINCM1=EMS(NK)/((UER(NK)-DER(NK))*TIMEC)
+           AINCMX=AMIN1(AINCMX,AINCM1)
+         ENDIF
+       ENDDO
+       AINC=1.
+       IF(AINCMX.LT.AINC)AINC=AINCMX
+!     
+!...SAVE THE RELEVENT VARIABLES FOR A UNIT UPDRAFT AND DOWNDRAFT...THEY WILL 
+!...BE ITERATIVELY ADJUSTED BY THE FACTOR AINC TO SATISFY THE STABILIZATION
+!...CLOSURE...
+!     
+       TDER2=TDER
+       PPTFL2=PPTFLX
+       DO NK=1,LTOP
+         DETLQ2(NK)=DETLQ(NK)
+         DETIC2(NK)=DETIC(NK)
+         UDR2(NK)=UDR(NK)
+         UER2(NK)=UER(NK)
+         DDR2(NK)=DDR(NK)
+         DER2(NK)=DER(NK)
+         UMF2(NK)=UMF(NK)
+         DMF2(NK)=DMF(NK)
+       ENDDO
+       FABE=1.
+       STAB=0.95
+       NOITR=0
+       ISTOP=0
+!
+        IF(ISHALL.EQ.1)THEN                              ! First for shallow convection
+!
+! No iteration for shallow convection; if turbulent kinetic energy (TKE) is available
+! from a turbulence parameterization, scale cloud-base updraft mass flux as a function
+! of TKE, but for now, just specify shallow-cloud mass flux using TKEMAX = 5...
+!
+!...find the maximum TKE value between LC and KLCL...
+!         TKEMAX = 0.
+          TKEMAX = 5.
+!          DO 173 K = LC,KLCL
+!            NK = KX-K+1
+!            TKEMAX = AMAX1(TKEMAX,Q2(I,J,NK))
+! 173      CONTINUE
+!          TKEMAX = AMIN1(TKEMAX,10.)
+!          TKEMAX = AMAX1(TKEMAX,5.)
+!c         TKEMAX = 10.
+!c...3_24_99...DPMIN was changed for shallow convection so that it is the
+!c...          the same as for deep convection (5.E3).  Since this doubles
+!c...          (roughly) the value of DPTHMX, add a factor of 0.5 to calcu-
+!c...          lation of EVAC...
+!c         EVAC  = TKEMAX*0.1
+          EVAC  = 0.5*TKEMAX*0.1
+!         AINC = 0.1*DPTHMX*DXIJ*DXIJ/(VMFLCL*G*TIMEC)
+!          AINC = EVAC*DPTHMX*DX(I,J)*DX(I,J)/(VMFLCL*G*TIMEC)
+          AINC = EVAC*DPTHMX*DXSQ/(VMFLCL*G*TIMEC)
+          TDER=TDER2*AINC
+          PPTFLX=PPTFL2*AINC
+          DO NK=1,LTOP
+            UMF(NK)=UMF2(NK)*AINC
+            DMF(NK)=DMF2(NK)*AINC
+            DETLQ(NK)=DETLQ2(NK)*AINC
+            DETIC(NK)=DETIC2(NK)*AINC
+            UDR(NK)=UDR2(NK)*AINC
+            UER(NK)=UER2(NK)*AINC
+            DER(NK)=DER2(NK)*AINC
+            DDR(NK)=DDR2(NK)*AINC
+          ENDDO
+        ENDIF                                           ! Otherwise for deep convection
+! use iterative procedure to find mass fluxes...
+iter:     DO NCOUNT=1,10
+!     
+!*****************************************************************
+!                                                                *
+!           COMPUTE PROPERTIES FOR COMPENSATIONAL SUBSIDENCE     *
+!                                                                *
+!*****************************************************************
+!     
+!...DETERMINE OMEGA VALUE NECESSARY AT TOP AND BOTTOM OF EACH LAYER TO
+!...SATISFY MASS CONTINUITY...
+!     
+            DTT=TIMEC
+            DO NK=1,LTOP
+              DOMGDP(NK)=-(UER(NK)-DER(NK)-UDR(NK)-DDR(NK))*EMSD(NK)
+              IF(NK.GT.1)THEN
+                OMG(NK)=OMG(NK-1)-DP(NK-1)*DOMGDP(NK-1)
+                ABSOMG = ABS(OMG(NK))
+                ABSOMGTC = ABSOMG*TIMEC
+                FRDP = 0.75*DP(NK-1)
+                IF(ABSOMGTC.GT.FRDP)THEN
+                  DTT1 = FRDP/ABSOMG
+                  DTT=AMIN1(DTT,DTT1)
+                ENDIF
+              ENDIF
+            ENDDO
+            DO NK=1,LTOP
+              THPA(NK)=THTA0(NK)
+              QPA(NK)=Q0(NK)
+              NSTEP=NINT(TIMEC/DTT+1)
+              DTIME=TIMEC/FLOAT(NSTEP)
+              FXM(NK)=OMG(NK)*DXSQ/G
+            ENDDO
+!     
+!...DO AN UPSTREAM/FORWARD-IN-TIME ADVECTION OF THETA, QV...
+!     
+        DO NTC=1,NSTEP
+!     
+!...ASSIGN THETA AND Q VALUES AT THE TOP AND BOTTOM OF EACH LAYER BASED
+!...SIGN OF OMEGA...
+!     
+            DO  NK=1,LTOP
+              THFXIN(NK)=0.
+              THFXOUT(NK)=0.
+              QFXIN(NK)=0.
+              QFXOUT(NK)=0.
+            ENDDO
+            DO NK=2,LTOP
+              IF(OMG(NK).LE.0.)THEN
+                THFXIN(NK)=-FXM(NK)*THPA(NK-1)
+                QFXIN(NK)=-FXM(NK)*QPA(NK-1)
+                THFXOUT(NK-1)=THFXOUT(NK-1)+THFXIN(NK)
+                QFXOUT(NK-1)=QFXOUT(NK-1)+QFXIN(NK)
+              ELSE
+                THFXOUT(NK)=FXM(NK)*THPA(NK)
+                QFXOUT(NK)=FXM(NK)*QPA(NK)
+                THFXIN(NK-1)=THFXIN(NK-1)+THFXOUT(NK)
+                QFXIN(NK-1)=QFXIN(NK-1)+QFXOUT(NK)
+              ENDIF
+            ENDDO
+!     
+!...UPDATE THE THETA AND QV VALUES AT EACH LEVEL...
+!     
+            DO NK=1,LTOP
+              THPA(NK)=THPA(NK)+(THFXIN(NK)+UDR(NK)*THTAU(NK)+DDR(NK)*      &
+                       THTAD(NK)-THFXOUT(NK)-(UER(NK)-DER(NK))*THTA0(NK))*  &
+                       DTIME*EMSD(NK)
+              QPA(NK)=QPA(NK)+(QFXIN(NK)+UDR(NK)*QDT(NK)+DDR(NK)*QD(NK)-    &
+                      QFXOUT(NK)-(UER(NK)-DER(NK))*Q0(NK))*DTIME*EMSD(NK)
+            ENDDO   
+          ENDDO   
+          DO NK=1,LTOP
+            THTAG(NK)=THPA(NK)
+            QG(NK)=QPA(NK)
+          ENDDO
+!     
+!...CHECK TO SEE IF MIXING RATIO DIPS BELOW ZERO ANYWHERE;  IF SO, BORRO
+!...MOISTURE FROM ADJACENT LAYERS TO BRING IT BACK UP ABOVE ZERO...
+!     
+        DO NK=1,LTOP
+          IF(QG(NK).LT.0.)THEN
+            IF(NK.EQ.1)THEN                             ! JSK MODS
+!              PRINT *,' PROBLEM WITH KF SCHEME:  ' ! JSK MODS
+!              PRINT *,'QG = 0 AT THE SURFACE!!!!!!!'    ! JSK MODS
+              CALL wrf_error_fatal ( 'QG, QG(NK).LT.0') ! JSK MODS
+            ENDIF                                       ! JSK MODS
+            NK1=NK+1
+            IF(NK.EQ.LTOP)THEN
+              NK1=KLCL
+            ENDIF
+            TMA=QG(NK1)*EMS(NK1)
+            TMB=QG(NK-1)*EMS(NK-1)
+            TMM=(QG(NK)-1.E-9)*EMS(NK  )
+            BCOEFF=-TMM/((TMA*TMA)/TMB+TMB)
+            ACOEFF=BCOEFF*TMA/TMB
+            TMB=TMB*(1.-BCOEFF)
+            TMA=TMA*(1.-ACOEFF)
+            IF(NK.EQ.LTOP)THEN
+              QVDIFF=(QG(NK1)-TMA*EMSD(NK1))*100./QG(NK1)
+!              IF(ABS(QVDIFF).GT.1.)THEN
+!             PRINT *,'!!!WARNING!!! CLOUD BASE WATER VAPOR CHANGES BY ',     &
+!                      QVDIFF,                                                &
+!                     '% WHEN MOISTURE IS BORROWED TO PREVENT NEGATIVE ',     &
+!                     'VALUES IN KAIN-FRITSCH'
+!              ENDIF
+            ENDIF
+            QG(NK)=1.E-9
+            QG(NK1)=TMA*EMSD(NK1)
+            QG(NK-1)=TMB*EMSD(NK-1)
+          ENDIF
+        ENDDO
+        TOPOMG=(UDR(LTOP)-UER(LTOP))*DP(LTOP)*EMSD(LTOP)
+        IF(ABS(TOPOMG-OMG(LTOP)).GT.1.E-3)THEN
+!       WRITE(99,*)'ERROR:  MASS DOES NOT BALANCE IN KF SCHEME;            &
+!      TOPOMG, OMG =',TOPOMG,OMG(LTOP)
+!      TOPOMG, OMG =',TOPOMG,OMG(LTOP)
+          ISTOP=1
+          IPRNT=.TRUE.
+          EXIT iter
+        ENDIF
+!     
+!...CONVERT THETA TO T...
+!     
+        DO NK=1,LTOP
+          EXN(NK)=(P00/P0(NK))**(0.2854*(1.-0.28*QG(NK)))
+          TG(NK)=THTAG(NK)/EXN(NK)
+          TVG(NK)=TG(NK)*(1.+0.608*QG(NK))
+        ENDDO
+        IF(ISHALL.EQ.1)THEN
+          EXIT iter
+        ENDIF
+!     
+!*******************************************************************
+!                                                                  *
+!     COMPUTE NEW CLOUD AND CHANGE IN AVAILABLE BUOYANT ENERGY.    *
+!                                                                  *
+!*******************************************************************
+!     
+!...THE FOLLOWING COMPUTATIONS ARE SIMILAR TO THAT FOR UPDRAFT
+!     
+!        THMIX=0.
+          TMIX=0.
+          QMIX=0.
+!
+!...FIND THE THERMODYNAMIC CHARACTERISTICS OF THE LAYER BY
+!...MASS-WEIGHTING THE CHARACTERISTICS OF THE INDIVIDUAL MODEL
+!...LAYERS...
+!
+          DO NK=LC,KPBL
+            TMIX=TMIX+DP(NK)*TG(NK)
+            QMIX=QMIX+DP(NK)*QG(NK)  
+          ENDDO
+          TMIX=TMIX/DPTHMX
+          QMIX=QMIX/DPTHMX
+          ES=ALIQ*EXP((TMIX*BLIQ-CLIQ)/(TMIX-DLIQ))
+          QSS=0.622*ES/(PMIX-ES)
+!     
+!...REMOVE SUPERSATURATION FOR DIAGNOSTIC PURPOSES, IF NECESSARY...
+!     
+          IF(QMIX.GT.QSS)THEN
+            RL=XLV0-XLV1*TMIX
+            CPM=CP*(1.+0.887*QMIX)
+            DSSDT=QSS*(CLIQ-BLIQ*DLIQ)/((TMIX-DLIQ)*(TMIX-DLIQ))
+            DQ=(QMIX-QSS)/(1.+RL*DSSDT/CPM)
+            TMIX=TMIX+RL/CP*DQ
+            QMIX=QMIX-DQ
+            TLCL=TMIX
+          ELSE
+            QMIX=AMAX1(QMIX,0.)
+            EMIX=QMIX*PMIX/(0.622+QMIX)
+            astrt=1.e-3
+            binc=0.075
+            a1=emix/aliq
+            tp=(a1-astrt)/binc
+            indlu=int(tp)+1
+            value=(indlu-1)*binc+astrt
+            aintrp=(a1-value)/binc
+            tlog=aintrp*alu(indlu+1)+(1-aintrp)*alu(indlu)
+            TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)
+            TLCL=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(TMIX-T00))*(TMIX-TDPT)
+            TLCL=AMIN1(TLCL,TMIX)
+          ENDIF
+          TVLCL=TLCL*(1.+0.608*QMIX)
+          ZLCL = ZMIX+(TLCL-TMIX)/GDRY
+          DO NK = LC,KL
+            KLCL=NK
+            IF(ZLCL.LE.Z0(NK))THEN
+              EXIT 
+            ENDIF
+          ENDDO
+          K=KLCL-1
+          DLP=(ZLCL-Z0(K))/(Z0(KLCL)-Z0(K))
+!     
+!...ESTIMATE ENVIRONMENTAL TEMPERATURE AND MIXING RATIO AT THE LCL...
+!     
+          TENV=TG(K)+(TG(KLCL)-TG(K))*DLP
+          QENV=QG(K)+(QG(KLCL)-QG(K))*DLP
+          TVEN=TENV*(1.+0.608*QENV)
+          PLCL=P0(K)+(P0(KLCL)-P0(K))*DLP
+          THETEU(K)=TMIX*(1.E5/PMIX)**(0.2854*(1.-0.28*QMIX))*             &
+                  EXP((3374.6525/TLCL-2.5403)*QMIX*(1.+0.81*QMIX))
+!     
+!...COMPUTE ADJUSTED ABE(ABEG).
+!     
+          ABEG=0.
+          DO NK=K,LTOPM1
+            NK1=NK+1
+            THETEU(NK1) = THETEU(NK)
+!
+            call tpmix2dd(p0(nk1),theteu(nk1),tgu(nk1),qgu(nk1),i,j)
+!
+            TVQU(NK1)=TGU(NK1)*(1.+0.608*QGU(NK1)-QLIQ(NK1)-QICE(NK1))
+            IF(NK.EQ.K)THEN
+              DZZ=Z0(KLCL)-ZLCL
+              DILBE=((TVLCL+TVQU(NK1))/(TVEN+TVG(NK1))-1.)*DZZ
+            ELSE
+              DZZ=DZA(NK)
+              DILBE=((TVQU(NK)+TVQU(NK1))/(TVG(NK)+TVG(NK1))-1.)*DZZ
+            ENDIF
+            IF(DILBE.GT.0.)ABEG=ABEG+DILBE*G
+!
+!...DILUTE BY ENTRAINMENT BY THE RATE AS ORIGINAL UPDRAFT...
+!
+            CALL ENVIRTHT(P0(NK1),TG(NK1),QG(NK1),THTEEG(NK1),ALIQ,BLIQ,CLIQ,DLIQ)
+            THETEU(NK1)=THETEU(NK1)*DDILFRC(NK1)+THTEEG(NK1)*(1.-DDILFRC(NK1))
+          ENDDO
+!     
+!...ASSUME AT LEAST 90% OF CAPE (ABE) IS REMOVED BY CONVECTION DURING
+!...THE PERIOD TIMEC...
+!     
+          IF(NOITR.EQ.1)THEN
+!         write(98,*)' '
+!         write(98,*)'TAU, I, J, =',NTSD,I,J
+!         WRITE(98,1060)FABE
+!          GOTO 265
+          EXIT iter
+          ENDIF
+          DABE=AMAX1(ABE-ABEG,0.1*ABE)
+          FABE=ABEG/ABE
+          IF(FABE.GT.1. .and. ISHALL.EQ.0)THEN
+!          WRITE(98,*)'UPDRAFT/DOWNDRAFT COUPLET INCREASES CAPE AT THIS
+!     *GRID POINT; NO CONVECTION ALLOWED!'
+            RETURN  
+          ENDIF
+          IF(NCOUNT.NE.1)THEN
+            IF(ABS(AINC-AINCOLD).LT.0.0001)THEN
+              NOITR=1
+              AINC=AINCOLD
+              CYCLE iter
+            ENDIF
+            DFDA=(FABE-FABEOLD)/(AINC-AINCOLD)
+            IF(DFDA.GT.0.)THEN
+              NOITR=1
+              AINC=AINCOLD
+              CYCLE iter
+            ENDIF
+          ENDIF
+          AINCOLD=AINC
+          FABEOLD=FABE
+          IF(AINC/AINCMX.GT.0.999.AND.FABE.GT.1.05-STAB)THEN
+!           write(98,*)' '
+!           write(98,*)'TAU, I, J, =',NTSD,I,J
+!           WRITE(98,1055)FABE
+!            GOTO 265
+            EXIT
+          ENDIF
+          IF((FABE.LE.1.05-STAB.AND.FABE.GE.0.95-STAB) .or. NCOUNT.EQ.10)THEN
+            EXIT iter
+          ELSE
+            IF(NCOUNT.GT.10)THEN
+!             write(98,*)' '
+!             write(98,*)'TAU, I, J, =',NTSD,I,J
+!             WRITE(98,1060)FABE
+!             GOTO 265
+              EXIT
+            ENDIF
+!     
+!...IF MORE THAN 10% OF THE ORIGINAL CAPE REMAINS, INCREASE THE CONVECTI
+!...MASS FLUX BY THE FACTOR AINC:
+!     
+            IF(FABE.EQ.0.)THEN
+              AINC=AINC*0.5
+            ELSE
+              IF(DABE.LT.1.e-4)THEN
+                NOITR=1
+                AINC=AINCOLD
+                CYCLE iter
+              ELSE
+                AINC=AINC*STAB*ABE/DABE
+              ENDIF
+            ENDIF
+!           AINC=AMIN1(AINCMX,AINC)
+            AINC=AMIN1(AINCMX,AINC)
+!...IF AINC BECOMES VERY SMALL, EFFECTS OF CONVECTION ! JSK MODS
+!...WILL BE MINIMAL SO JUST IGNORE IT...              ! JSK MODS
+            IF(AINC.LT.0.05)then
+              RETURN                          ! JSK MODS
+            ENDIF
+!            AINC=AMAX1(AINC,0.05)                        ! JSK MODS
+            TDER=TDER2*AINC
+            PPTFLX=PPTFL2*AINC
+!           IF (XTIME.LT.10.)THEN
+!           WRITE(98,1080)LFS,LDB,LDT,TIMEC,TADVEC,NSTEP,NCOUNT,
+!          *              FABEOLD,AINCOLD 
+!           ENDIF
+            DO NK=1,LTOP
+              UMF(NK)=UMF2(NK)*AINC
+              DMF(NK)=DMF2(NK)*AINC
+              DETLQ(NK)=DETLQ2(NK)*AINC
+              DETIC(NK)=DETIC2(NK)*AINC
+              UDR(NK)=UDR2(NK)*AINC
+              UER(NK)=UER2(NK)*AINC
+              DER(NK)=DER2(NK)*AINC
+              DDR(NK)=DDR2(NK)*AINC
+            ENDDO
+!     
+!...GO BACK UP FOR ANOTHER ITERATION...
+!     
+          ENDIF
+        ENDDO iter
+!     
+!...COMPUTE HYDROMETEOR TENDENCIES AS IS DONE FOR T, QV...
+!     
+!...FRC2 IS THE FRACTION OF TOTAL CONDENSATE      !  PPT FB MODS
+!...GENERATED THAT GOES INTO PRECIPITIATION       !  PPT FB MODS
+!
+!  Redistribute hydormeteors according to the final mass-flux values:
+!
+        IF(CPR.GT.0.)THEN 
+          FRC2=PPTFLX/(CPR*AINC)                    !  PPT FB MODS
+        ELSE
+           FRC2=0.
+        ENDIF
+        DO NK=1,LTOP
+          QLPA(NK)=QL0(NK)
+          QIPA(NK)=QI0(NK)
+          QRPA(NK)=QR0(NK)
+          QSPA(NK)=QS0(NK)
+          RAINFB(NK)=PPTLIQ(NK)*AINC*FBFRC*FRC2   !  PPT FB MODS
+          SNOWFB(NK)=PPTICE(NK)*AINC*FBFRC*FRC2   !  PPT FB MODS
+        ENDDO
+        DO NTC=1,NSTEP
+!     
+!...ASSIGN HYDROMETEORS CONCENTRATIONS AT THE TOP AND BOTTOM OF EACH LAY
+!...BASED ON THE SIGN OF OMEGA...
+!     
+          DO NK=1,LTOP
+            QLFXIN(NK)=0.
+            QLFXOUT(NK)=0.
+            QIFXIN(NK)=0.
+            QIFXOUT(NK)=0.
+            QRFXIN(NK)=0.
+            QRFXOUT(NK)=0.
+            QSFXIN(NK)=0.
+            QSFXOUT(NK)=0.
+          ENDDO   
+          DO NK=2,LTOP
+            IF(OMG(NK).LE.0.)THEN
+              QLFXIN(NK)=-FXM(NK)*QLPA(NK-1)
+              QIFXIN(NK)=-FXM(NK)*QIPA(NK-1)
+              QRFXIN(NK)=-FXM(NK)*QRPA(NK-1)
+              QSFXIN(NK)=-FXM(NK)*QSPA(NK-1)
+              QLFXOUT(NK-1)=QLFXOUT(NK-1)+QLFXIN(NK)
+              QIFXOUT(NK-1)=QIFXOUT(NK-1)+QIFXIN(NK)
+              QRFXOUT(NK-1)=QRFXOUT(NK-1)+QRFXIN(NK)
+              QSFXOUT(NK-1)=QSFXOUT(NK-1)+QSFXIN(NK)
+            ELSE
+              QLFXOUT(NK)=FXM(NK)*QLPA(NK)
+              QIFXOUT(NK)=FXM(NK)*QIPA(NK)
+              QRFXOUT(NK)=FXM(NK)*QRPA(NK)
+              QSFXOUT(NK)=FXM(NK)*QSPA(NK)
+              QLFXIN(NK-1)=QLFXIN(NK-1)+QLFXOUT(NK)
+              QIFXIN(NK-1)=QIFXIN(NK-1)+QIFXOUT(NK)
+              QRFXIN(NK-1)=QRFXIN(NK-1)+QRFXOUT(NK)
+              QSFXIN(NK-1)=QSFXIN(NK-1)+QSFXOUT(NK)
+            ENDIF
+          ENDDO   
+!     
+!...UPDATE THE HYDROMETEOR CONCENTRATION VALUES AT EACH LEVEL...
+!     
+          DO NK=1,LTOP
+            QLPA(NK)=QLPA(NK)+(QLFXIN(NK)+DETLQ(NK)-QLFXOUT(NK))*DTIME*EMSD(NK)
+            QIPA(NK)=QIPA(NK)+(QIFXIN(NK)+DETIC(NK)-QIFXOUT(NK))*DTIME*EMSD(NK)
+            QRPA(NK)=QRPA(NK)+(QRFXIN(NK)-QRFXOUT(NK)+RAINFB(NK))*DTIME*EMSD(NK)         !  PPT FB MODS
+            QSPA(NK)=QSPA(NK)+(QSFXIN(NK)-QSFXOUT(NK)+SNOWFB(NK))*DTIME*EMSD(NK)         !  PPT FB MODS
+          ENDDO     
+        ENDDO
+        DO NK=1,LTOP
+          QLG(NK)=QLPA(NK)
+          QIG(NK)=QIPA(NK)
+          QRG(NK)=QRPA(NK)
+          QSG(NK)=QSPA(NK)
+        ENDDO   
+!
+!...CLEAN THINGS UP, CALCULATE CONVECTIVE FEEDBACK TENDENCIES FOR THIS
+!...GRID POINT...
+!     
+!     IF (XTIME.LT.10.)THEN
+!     WRITE(98,1080)LFS,LDB,LDT,TIMEC,TADVEC,NSTEP,NCOUNT,FABE,AINC 
+!     ENDIF
+       IF(IPRNT)THEN  
+         WRITE(98,1080)LFS,LDB,LDT,TIMEC,TADVEC,NSTEP,NCOUNT,FABE,AINC
+!        call flush(98)   
+       endif  
+!     
+!...SEND FINAL PARAMETERIZED VALUES TO OUTPUT FILES...
+!     
+!297   IF(IPRNT)then 
+       IF(IPRNT)then 
+!    if(I.eq.16 .and. J.eq.41)then
+!      IF(ISTOP.EQ.1)THEN
+         write(98,*)
+!        write(98,*)'At t(h), I, J =',float(NTSD)*72./3600.,I,J
+         write(98,*)'P(LC), DTP, WKL, WKLCL =',p0(LC)/100.,       &
+                     TLCL+DTLCL+dtrh-TENV,WKL,WKLCL
+         write(98,*)'TLCL, DTLCL, DTRH, TENV =',TLCL,DTLCL,       &
+                      DTRH,TENV   
+         WRITE(98,1025)KLCL,ZLCL,DTLCL,LTOP,P0(LTOP),IFLAG,       &
+         TMIX-T00,PMIX,QMIX,ABE
+         WRITE(98,1030)P0(LET)/100.,P0(LTOP)/100.,VMFLCL,PLCL/100.,  &
+         WLCL,CLDHGT(LC)
+         WRITE(98,1035)PEF,PEFCBH,LC,LET,WKL,VWS 
+         write(98,*)'PRECIP EFFICIENCY =',PEFF 
+      WRITE(98,1080)LFS,LDB,LDT,TIMEC,TADVEC,NSTEP,NCOUNT,FABE,AINC
+!      ENDIF
+!!!!! HERE !!!!!!!
+           WRITE(98,1070)'  P  ','   DP ',' DT K/D ',' DR K/D ','   OMG  ',        &
+          ' DOMGDP ','   UMF  ','   UER  ','   UDR  ','   DMF  ','   DER  '        &
+          ,'   DDR  ','   EMS  ','    W0  ','  DETLQ ',' DETIC '
+           write(98,*)'just before DO 300...'
+!          call flush(98)
+           DO NK=1,LTOP
+             K=LTOP-NK+1
+             DTT=(TG(K)-T0(K))*86400./TIMEC
+             RL=XLV0-XLV1*TG(K)
+             DR=-(QG(K)-Q0(K))*RL*86400./(TIMEC*CP)
+             UDFRC=UDR(K)*TIMEC*EMSD(K)
+             UEFRC=UER(K)*TIMEC*EMSD(K)
+             DDFRC=DDR(K)*TIMEC*EMSD(K)
+             DEFRC=-DER(K)*TIMEC*EMSD(K)
+             WRITE(98,1075)P0(K)/100.,DP(K)/100.,DTT,DR,OMG(K),DOMGDP(K)*1.E4,       &
+             UMF(K)/1.E6,UEFRC,UDFRC,DMF(K)/1.E6,DEFRC,DDFRC,EMS(K)/1.E11,           &
+             W0AVG1D(K)*1.E2,DETLQ(K)*TIMEC*EMSD(K)*1.E3,DETIC(K)*                   &
+             TIMEC*EMSD(K)*1.E3
+           ENDDO
+           WRITE(98,1085)'K','P','Z','T0','TG','DT','TU','TD','Q0','QG',             &
+                  'DQ','QU','QD','QLG','QIG','QRG','QSG','RH0','RHG'
+           DO NK=1,KL
+             K=KX-NK+1
+             DTT=TG(K)-T0(K)
+             TUC=TU(K)-T00
+             IF(K.LT.LC.OR.K.GT.LTOP)TUC=0.
+             TDC=TZ(K)-T00
+             IF((K.LT.LDB.OR.K.GT.LDT).AND.K.NE.LFS)TDC=0.
+             IF(T0(K).LT.T00)THEN
+               ES=ALIQ*EXP((BLIQ*TG(K)-CLIQ)/(TG(K)-DLIQ))
+             ELSE
+               ES=ALIQ*EXP((BLIQ*TG(K)-CLIQ)/(TG(K)-DLIQ))
+             ENDIF  
+             QGS=ES*0.622/(P0(K)-ES)
+             RH0=Q0(K)/QES(K)
+             RHG=QG(K)/QGS
+             WRITE(98,1090)K,P0(K)/100.,Z0(K),T0(K)-T00,TG(K)-T00,DTT,TUC,            &
+             TDC,Q0(K)*1000.,QG(K)*1000.,(QG(K)-Q0(K))*1000.,QU(K)*                   &
+             1000.,QD(K)*1000.,QLG(K)*1000.,QIG(K)*1000.,QRG(K)*1000.,                &
+             QSG(K)*1000.,RH0,RHG
+           ENDDO
+!     
+!...IF CALCULATIONS ABOVE SHOW AN ERROR IN THE MASS BUDGET, PRINT OUT A
+!...TO BE USED LATER FOR DIAGNOSTIC PURPOSES, THEN ABORT RUN...
+!     
+!         IF(ISTOP.EQ.1 .or. ISHALL.EQ.1)THEN
+
+!         IF(ISHALL.NE.1)THEN
+!            write(98,4421)i,j,iyr,imo,idy,ihr,imn
+!           write(98)i,j,iyr,imo,idy,ihr,imn,kl
+! 4421       format(7i4)
+!            write(98,4422)kl
+! 4422       format(i6) 
+            DO 310 NK = 1,KL
+              k = kl - nk + 1
+              write(98,4455) p0(k)/100.,t0(k)-273.16,q0(k)*1000.,       &
+                       u0(k),v0(k),W0AVG1D(K),dp(k),tke(k)
+!             write(98) p0,t0,q0,u0,v0,w0,dp,tke
+!           WRITE(98,1115)Z0(K),P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,
+!    *               U0(K),V0(K),DP(K)/100.,W0AVG(I,J,K)
+ 310        CONTINUE
+            IF(ISTOP.EQ.1)THEN
+              CALL wrf_error_fatal ( 'KAIN-FRITSCH, istop=1, diags' )
+            ENDIF
+!         ENDIF
+  4455  format(8f11.3) 
+       ENDIF
+        CNDTNF=(1.-EQFRC(LFS))*(QLIQ(LFS)+QICE(LFS))*DMF(LFS)
+        RAINCV(I,J)=DT*PPTFLX*(1.-FBFRC)/DXSQ     !  PPT FB MODS
+!        RAINCV(I,J)=.1*.5*DT*PPTFLX/DXSQ               !  PPT FB MODS
+!         RNC=0.1*TIMEC*PPTFLX/DXSQ
+        RNC=RAINCV(I,J)*NIC
+       IF(ISHALL.EQ.0.AND.IPRNT)write (98,909)I,J,RNC
+
+!     WRITE(98,1095)CPR*AINC,TDER+PPTFLX+CNDTNF
+!     
+!  EVALUATE MOISTURE BUDGET...
+!     
+
+        QINIT=0.
+        QFNL=0.
+        DPT=0.
+        DO 315 NK=1,LTOP
+          DPT=DPT+DP(NK)
+          QINIT=QINIT+Q0(NK)*EMS(NK)
+          QFNL=QFNL+QG(NK)*EMS(NK)
+          QFNL=QFNL+(QLG(NK)+QIG(NK)+QRG(NK)+QSG(NK))*EMS(NK)
+  315   CONTINUE
+        QFNL=QFNL+PPTFLX*TIMEC*(1.-FBFRC)       !  PPT FB MODS
+!        QFNL=QFNL+PPTFLX*TIMEC                 !  PPT FB MODS
+        ERR2=(QFNL-QINIT)*100./QINIT
+       IF(IPRNT)WRITE(98,1110)QINIT,QFNL,ERR2
+      IF(ABS(ERR2).GT.0.05 .AND. ISTOP.EQ.0)THEN 
+!       write(99,*)'!!!!!!!! MOISTURE BUDGET ERROR IN KFPARA !!!'
+!       WRITE(99,1110)QINIT,QFNL,ERR2
+        IPRNT=.TRUE.
+        ISTOP=1
+            write(98,4422)kl
+ 4422       format(i6)
+            DO 311 NK = 1,KL
+              k = kl - nk + 1
+!             write(99,4455) p0(k)/100.,t0(k)-273.16,q0(k)*1000.,       &
+!                      u0(k),v0(k),W0AVG1D(K),dp(k)
+!             write(98) p0,t0,q0,u0,v0,w0,dp,tke
+!           WRITE(98,1115)P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,          &
+!                    U0(K),V0(K),W0AVG1D(K),dp(k)/100.,tke(k)
+            WRITE(98,4456)P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,          &
+                     U0(K),V0(K),W0AVG1D(K),dp(k)/100.,tke(k)
+ 311        CONTINUE
+!           call flush(98)
+
+!        GOTO 297
+!         STOP 'QVERR'
+      ENDIF
+ 1115 FORMAT (2X,F7.2,2X,F5.1,2X,F6.3,2(2X,F5.1),2X,F7.2,2X,F7.4)
+ 4456  format(8f12.3)
+        IF(PPTFLX.GT.0.)THEN
+          RELERR=ERR2*QINIT/(PPTFLX*TIMEC)
+        ELSE
+          RELERR=0.
+        ENDIF
+     IF(IPRNT)THEN
+        WRITE(98,1120)RELERR
+        WRITE(98,*)'TDER, CPR, TRPPT =',              &
+          TDER,CPR*AINC,TRPPT*AINC
+     ENDIF
+!     
+!...FEEDBACK TO RESOLVABLE SCALE TENDENCIES.
+!     
+!...IF THE ADVECTIVE TIME PERIOD (TADVEC) IS LESS THAN SPECIFIED MINIMUM
+!...TIMEC, ALLOW FEEDBACK TO OCCUR ONLY DURING TADVEC...
+!     
+        IF(TADVEC.LT.TIMEC)NIC=NINT(TADVEC/DT)
+        NCA(I,J)=FLOAT(NIC)
+        IF(ISHALL.EQ.1)THEN
+          TIMEC = 2400.
+          NCA(I,J) = FLOAT(NTST)
+          NSHALL = NSHALL+1
+        ENDIF 
+        DO K=1,KX
+!         IF(IMOIST(INEST).NE.2)THEN
+!
+!...IF HYDROMETEORS ARE NOT ALLOWED, THEY MUST BE EVAPORATED OR SUBLIMAT
+!...AND FED BACK AS VAPOR, ALONG WITH ASSOCIATED CHANGES IN TEMPERATURE.
+!...NOTE:  THIS WILL INTRODUCE CHANGES IN THE CONVECTIVE TEMPERATURE AND
+!...WATER VAPOR FEEDBACK TENDENCIES AND MAY LEAD TO SUPERSATURATED VALUE
+!...OF QG...
+!
+!           RLC=XLV0-XLV1*TG(K)
+!           RLS=XLS0-XLS1*TG(K)
+!           CPM=CP*(1.+0.887*QG(K))
+!           TG(K)=TG(K)-(RLC*(QLG(K)+QRG(K))+RLS*(QIG(K)+QSG(K)))/CPM
+!           QG(K)=QG(K)+(QLG(K)+QRG(K)+QIG(K)+QSG(K))
+!           DQLDT(I,J,NK)=0.
+!           DQIDT(I,J,NK)=0.
+!           DQRDT(I,J,NK)=0.
+!           DQSDT(I,J,NK)=0.
+!         ELSE
+!
+!...IF ICE PHASE IS NOT ALLOWED, MELT ALL FROZEN HYDROMETEORS...
+!
+          IF(.NOT. F_QI .and. warm_rain)THEN
+
+            CPM=CP*(1.+0.887*QG(K))
+            TG(K)=TG(K)-(QIG(K)+QSG(K))*RLF/CPM
+            DQCDT(K)=(QLG(K)+QIG(K)-QL0(K)-QI0(K))/TIMEC
+            DQIDT(K)=0.
+            DQRDT(K)=(QRG(K)+QSG(K)-QR0(K)-QS0(K))/TIMEC
+            DQSDT(K)=0.
+          ELSEIF(.NOT. F_QI .and. .not. warm_rain)THEN
+!
+!...IF ICE PHASE IS ALLOWED, BUT MIXED PHASE IS NOT, MELT FROZEN HYDROME
+!...BELOW THE MELTING LEVEL, FREEZE LIQUID WATER ABOVE THE MELTING LEVEL
+!
+            CPM=CP*(1.+0.887*QG(K))
+            IF(K.LE.ML)THEN
+              TG(K)=TG(K)-(QIG(K)+QSG(K))*RLF/CPM
+            ELSEIF(K.GT.ML)THEN
+              TG(K)=TG(K)+(QLG(K)+QRG(K))*RLF/CPM
+            ENDIF
+            DQCDT(K)=(QLG(K)+QIG(K)-QL0(K)-QI0(K))/TIMEC
+            DQIDT(K)=0.
+            DQRDT(K)=(QRG(K)+QSG(K)-QR0(K)-QS0(K))/TIMEC
+            DQSDT(K)=0.
+          ELSEIF(F_QI) THEN
+!
+!...IF MIXED PHASE HYDROMETEORS ARE ALLOWED, FEED BACK CONVECTIVE TENDEN
+!...OF HYDROMETEORS DIRECTLY...
+!
+            DQCDT(K)=(QLG(K)-QL0(K))/TIMEC
+            DQIDT(K)=(QIG(K)-QI0(K))/TIMEC
+            DQRDT(K)=(QRG(K)-QR0(K))/TIMEC
+            IF (F_QS) THEN
+               DQSDT(K)=(QSG(K)-QS0(K))/TIMEC
+            ELSE
+               DQIDT(K)=DQIDT(K)+(QSG(K)-QS0(K))/TIMEC
+            ENDIF
+          ELSE
+!              PRINT *,'THIS COMBINATION OF IMOIST, IEXICE, IICE NOT ALLOWED!'
+              CALL wrf_error_fatal ( 'KAIN-FRITSCH, THIS COMBINATION OF IMOIST, IEXICE, IICE NOT ALLOWED' )
+          ENDIF
+          DTDT(K)=(TG(K)-T0(K))/TIMEC
+          DQDT(K)=(QG(K)-Q0(K))/TIMEC
+        ENDDO
+        RAINCV(I,J)=DT*PPTFLX*(1.-FBFRC)/DXSQ     !  PPT FB MODS
+!        RAINCV(I,J)=.1*.5*DT*PPTFLX/DXSQ               !  PPT FB MODS
+!         RNC=0.1*TIMEC*PPTFLX/DXSQ
+        RNC=RAINCV(I,J)*NIC
+ 909     FORMAT('AT I, J =',i3,1x,i3,' CONVECTIVE RAINFALL =',F8.4,' mm')
+!      write (98,909)I,J,RNC
+!      write (6,909)I,J,RNC
+!      WRITE(98,*)'at NTSD =',NTSD,',No. of KF points activated =',
+!     *            NCCNT
+!      call flush(98)
+1000  FORMAT(' ',10A8)
+1005  FORMAT(' ',F6.0,2X,F6.4,2X,F7.3,1X,F6.4,2X,4(F6.3,2X),2(F7.3,1X))
+1010  FORMAT(' ',' VERTICAL VELOCITY IS NEGATIVE AT ',F4.0,' MB')
+1015   FORMAT(' ','ALL REMAINING MASS DETRAINS BELOW ',F4.0,' MB')
+1025   FORMAT(5X,' KLCL=',I2,' ZLCL=',F7.1,'M',                         &
+        ' DTLCL=',F5.2,' LTOP=',I2,' P0(LTOP)=',-2PF5.1,'MB FRZ LV=',   &
+        I2,' TMIX=',0PF4.1,1X,'PMIX=',-2PF6.1,' QMIX=',3PF5.1,          &
+        ' CAPE=',0PF7.1)
+1030   FORMAT(' ',' P0(LET) = ',F6.1,' P0(LTOP) = ',F6.1,' VMFLCL =',   &
+      E12.3,' PLCL =',F6.1,' WLCL =',F6.3,' CLDHGT =',                  &
+      F8.1)
+1035  FORMAT(1X,'PEF(WS)=',F4.2,'(CB)=',F4.2,'LC,LET=',2I3,'WKL='       &
+      ,F6.3,'VWS=',F5.2)
+!1055  FORMAT('*** DEGREE OF STABILIZATION =',F5.3,                  &
+!      ', NO MORE MASS FLUX IS ALLOWED!')
+!1060     FORMAT(' ITERATION DOES NOT CONVERGE TO GIVE THE SPECIFIED    &
+!      &DEGREE OF STABILIZATION!  FABE= ',F6.4) 
+ 1070 FORMAT (16A8) 
+ 1075 FORMAT (F8.2,3(F8.2),2(F8.3),F8.2,2F8.3,F8.2,6F8.3) 
+ 1080 FORMAT(2X,'LFS,LDB,LDT =',3I3,' TIMEC, TADVEC, NSTEP=',           &
+              2(1X,F5.0),I3,'NCOUNT, FABE, AINC=',I2,1X,F5.3,F6.2) 
+ 1085 FORMAT (A3,16A7,2A8) 
+ 1090 FORMAT (I3,F7.2,F7.0,10F7.2,4F7.3,2F8.3) 
+ 1095 FORMAT(' ','  PPT PRODUCTION RATE= ',F10.0,' TOTAL EVAP+PPT= ',F10.0)
+1105   FORMAT(' ','NET LATENT HEAT RELEASE =',E12.5,' ACTUAL HEATING =',&
+       E12.5,' J/KG-S, DIFFERENCE = ',F9.3,'%')
+1110   FORMAT(' ','INITIAL WATER =',E12.5,' FINAL WATER =',E12.5,       &
+       ' TOTAL WATER CHANGE =',F8.2,'%')
+! 1115 FORMAT (2X,F6.0,2X,F7.2,2X,F5.1,2X,F6.3,2(2X,F5.1),2X,F7.2,2X,F7.4)
+1120   FORMAT(' ','MOISTURE ERROR AS FUNCTION OF TOTAL PPT =',F9.3,'%')
+!
+!-----------------------------------------------------------------------
+!--------------SAVE CLOUD TOP AND BOTTOM FOR RADIATION------------------
+!-----------------------------------------------------------------------
+!
+      CUTOP(I,J)=REAL(LTOP)
+      CUBOT(I,J)=REAL(LCL)
+!
+!-----------------------------------------------------------------------
+   END SUBROUTINE  KF_eta_PARA
+!********************************************************************
+! ***********************************************************************
+   SUBROUTINE TPMIX2(p,thes,tu,qu,qliq,qice,qnewlq,qnewic,XLV1,XLV0)
+!
+! Lookup table variables:
+!     INTEGER, PARAMETER :: (KFNT=250,KFNP=220)
+!     REAL, SAVE, DIMENSION(1:KFNT,1:KFNP) :: TTAB,QSTAB
+!     REAL, SAVE, DIMENSION(1:KFNP) :: THE0K
+!     REAL, SAVE, DIMENSION(1:200) :: ALU
+!     REAL, SAVE :: RDPR,RDTHK,PLUTOP
+! End of Lookup table variables:
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: P,THES,XLV1,XLV0
+   REAL,         INTENT(OUT  )   :: QNEWLQ,QNEWIC
+   REAL,         INTENT(INOUT)   :: TU,QU,QLIQ,QICE
+   REAL    ::    TP,QQ,BTH,TTH,PP,T00,T10,T01,T11,Q00,Q10,Q01,Q11,          &
+                 TEMP,QS,QNEW,DQ,QTOT,RLL,CPP
+   INTEGER ::    IPTB,ITHTB
+!-----------------------------------------------------------------------
+
+!c******** LOOKUP TABLE VARIABLES... ****************************
+!      parameter(kfnt=250,kfnp=220)
+!c
+!      COMMON/KFLUT/ ttab(kfnt,kfnp),qstab(kfnt,kfnp),the0k(kfnp),
+!     *              alu(200),rdpr,rdthk,plutop 
+!C*************************************************************** 
+!c
+!c***********************************************************************
+!c     scaling pressure and tt table index                         
+!c***********************************************************************
+!c
+      tp=(p-plutop)*rdpr
+      qq=tp-aint(tp)
+      iptb=int(tp)+1
+
+!
+!***********************************************************************
+!              base and scaling factor for the                           
+!***********************************************************************
+!
+!  scaling the and tt table index                                        
+      bth=(the0k(iptb+1)-the0k(iptb))*qq+the0k(iptb)
+      tth=(thes-bth)*rdthk
+      pp   =tth-aint(tth)
+      ithtb=int(tth)+1
+       IF(IPTB.GE.220 .OR. IPTB.LE.1 .OR. ITHTB.GE.250 .OR. ITHTB.LE.1)THEN
+         write(98,*)'**** OUT OF BOUNDS *********'
+!        call flush(98)
+       ENDIF
+!
+      t00=ttab(ithtb  ,iptb  )
+      t10=ttab(ithtb+1,iptb  )
+      t01=ttab(ithtb  ,iptb+1)
+      t11=ttab(ithtb+1,iptb+1)
+!
+      q00=qstab(ithtb  ,iptb  )
+      q10=qstab(ithtb+1,iptb  )
+      q01=qstab(ithtb  ,iptb+1)
+      q11=qstab(ithtb+1,iptb+1)
+!
+!***********************************************************************
+!              parcel temperature                                        
+!***********************************************************************
+!
+      temp=(t00+(t10-t00)*pp+(t01-t00)*qq+(t00-t10-t01+t11)*pp*qq)
+!
+      qs=(q00+(q10-q00)*pp+(q01-q00)*qq+(q00-q10-q01+q11)*pp*qq)
+!
+      DQ=QS-QU
+      IF(DQ.LE.0.)THEN
+        QNEW=QU-QS
+        QU=QS
+      ELSE 
+!
+!   IF THE PARCEL IS SUBSATURATED, TEMPERATURE AND MIXING RATIO MUST BE
+!   ADJUSTED...IF LIQUID WATER IS PRESENT, IT IS ALLOWED TO EVAPORATE
+! 
+        QNEW=0.
+        QTOT=QLIQ+QICE
+!
+!   IF THERE IS ENOUGH LIQUID OR ICE TO SATURATE THE PARCEL, TEMP STAYS AT ITS
+!   WET BULB VALUE, VAPOR MIXING RATIO IS AT SATURATED LEVEL, AND THE MIXING
+!   RATIOS OF LIQUID AND ICE ARE ADJUSTED TO MAKE UP THE ORIGINAL SATURATION
+!   DEFICIT... OTHERWISE, ANY AVAILABLE LIQ OR ICE VAPORIZES AND APPROPRIATE
+!   ADJUSTMENTS TO PARCEL TEMP; VAPOR, LIQUID, AND ICE MIXING RATIOS ARE MADE.
+!
+!...subsaturated values only occur in calculations involving various mixtures of
+!...updraft and environmental air for estimation of entrainment and detrainment.
+!...For these purposes, assume that reasonable estimates can be given using 
+!...liquid water saturation calculations only - i.e., ignore the effect of the
+!...ice phase in this process only...will not affect conservative properties...
+!
+        IF(QTOT.GE.DQ)THEN
+          qliq=qliq-dq*qliq/(qtot+1.e-10)
+          qice=qice-dq*qice/(qtot+1.e-10)
+          QU=QS
+        ELSE
+          RLL=XLV0-XLV1*TEMP
+          CPP=1004.5*(1.+0.89*QU)
+          IF(QTOT.LT.1.E-10)THEN
+!
+!...IF NO LIQUID WATER OR ICE IS AVAILABLE, TEMPERATURE IS GIVEN BY:
+            TEMP=TEMP+RLL*(DQ/(1.+DQ))/CPP
+          ELSE
+!
+!...IF SOME LIQ WATER/ICE IS AVAILABLE, BUT NOT ENOUGH TO ACHIEVE SATURATION,
+!   THE TEMPERATURE IS GIVEN BY:
+!
+            TEMP=TEMP+RLL*((DQ-QTOT)/(1+DQ-QTOT))/CPP
+            QU=QU+QTOT
+            QTOT=0.
+            QLIQ=0.
+            QICE=0.
+          ENDIF
+        ENDIF
+      ENDIF
+      TU=TEMP
+      qnewlq=qnew
+      qnewic=0.
+!
+   END SUBROUTINE TPMIX2
+!******************************************************************************
+      SUBROUTINE DTFRZNEW(TU,P,THTEU,QU,QFRZ,QICE,ALIQ,BLIQ,CLIQ,DLIQ)
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: P,QFRZ,ALIQ,BLIQ,CLIQ,DLIQ
+   REAL,         INTENT(INOUT)   :: TU,THTEU,QU,QICE
+   REAL    ::    RLC,RLS,RLF,CPP,A,DTFRZ,ES,QS,DQEVAP,PII
+!-----------------------------------------------------------------------
+!
+!...ALLOW THE FREEZING OF LIQUID WATER IN THE UPDRAFT TO PROCEED AS AN 
+!...APPROXIMATELY LINEAR FUNCTION OF TEMPERATURE IN THE TEMPERATURE RANGE 
+!...TTFRZ TO TBFRZ...
+!...FOR COLDER TERMPERATURES, FREEZE ALL LIQUID WATER...
+!...THERMODYNAMIC PROPERTIES ARE STILL CALCULATED WITH RESPECT TO LIQUID WATER
+!...TO ALLOW THE USE OF LOOKUP TABLE TO EXTRACT TMP FROM THETAE...
+!
+      RLC=2.5E6-2369.276*(TU-273.16)
+      RLS=2833922.-259.532*(TU-273.16)
+      RLF=RLS-RLC
+      CPP=1004.5*(1.+0.89*QU)
+!
+!  A = D(es)/DT IS THAT CALCULATED FROM BUCK (1981) EMPERICAL FORMULAS
+!  FOR SATURATION VAPOR PRESSURE...
+!
+      A=(CLIQ-BLIQ*DLIQ)/((TU-DLIQ)*(TU-DLIQ))
+      DTFRZ = RLF*QFRZ/(CPP+RLS*QU*A)
+      TU = TU+DTFRZ
+      
+      ES = ALIQ*EXP((BLIQ*TU-CLIQ)/(TU-DLIQ))
+      QS = ES*0.622/(P-ES)
+!
+!...FREEZING WARMS THE AIR AND IT BECOMES UNSATURATED...ASSUME THAT SOME OF THE 
+!...LIQUID WATER THAT IS AVAILABLE FOR FREEZING EVAPORATES TO MAINTAIN SATURA-
+!...TION...SINCE THIS WATER HAS ALREADY BEEN TRANSFERRED TO THE ICE CATEGORY,
+!...SUBTRACT IT FROM ICE CONCENTRATION, THEN SET UPDRAFT MIXING RATIO AT THE NEW
+!...TEMPERATURE TO THE SATURATION VALUE...
+!
+      DQEVAP = QS-QU
+      QICE = QICE-DQEVAP
+      QU = QU+DQEVAP
+      PII=(1.E5/P)**(0.2854*(1.-0.28*QU))
+      THTEU=TU*PII*EXP((3374.6525/TU-2.5403)*QU*(1.+0.81*QU))
+!
+   END SUBROUTINE DTFRZNEW
+! --------------------------------------------------------------------------------
+
+      SUBROUTINE CONDLOAD(QLIQ,QICE,WTW,DZ,BOTERM,ENTERM,RATE,QNEWLQ,           &
+                          QNEWIC,QLQOUT,QICOUT,G)
+
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+!  9/18/88...THIS PRECIPITATION FALLOUT SCHEME IS BASED ON THE SCHEME US
+!  BY OGURA AND CHO (1973).  LIQUID WATER FALLOUT FROM A PARCEL IS CAL-
+!  CULATED USING THE EQUATION DQ=-RATE*Q*DT, BUT TO SIMULATE A QUASI-
+!  CONTINUOUS PROCESS, AND TO ELIMINATE A DEPENDENCY ON VERTICAL
+!  RESOLUTION THIS IS EXPRESSED AS Q=Q*EXP(-RATE*DZ).
+
+      REAL, INTENT(IN   )   :: G
+      REAL, INTENT(IN   )   :: DZ,BOTERM,ENTERM,RATE
+      REAL, INTENT(INOUT)   :: QLQOUT,QICOUT,WTW,QLIQ,QICE,QNEWLQ,QNEWIC
+      REAL :: QTOT,QNEW,QEST,G1,WAVG,CONV,RATIO3,OLDQ,RATIO4,DQ,PPTDRG
+
+!
+!  9/18/88...THIS PRECIPITATION FALLOUT SCHEME IS BASED ON THE SCHEME US
+!  BY OGURA AND CHO (1973).  LIQUID WATER FALLOUT FROM A PARCEL IS CAL- 
+!  CULATED USING THE EQUATION DQ=-RATE*Q*DT, BUT TO SIMULATE A QUASI-   
+!  CONTINUOUS PROCESS, AND TO ELIMINATE A DEPENDENCY ON VERTICAL        
+!  RESOLUTION THIS IS EXPRESSED AS Q=Q*EXP(-RATE*DZ).                   
+      QTOT=QLIQ+QICE                                                    
+      QNEW=QNEWLQ+QNEWIC                                                
+!                                                                       
+!  ESTIMATE THE VERTICAL VELOCITY SO THAT AN AVERAGE VERTICAL VELOCITY 
+!  BE CALCULATED TO ESTIMATE THE TIME REQUIRED FOR ASCENT BETWEEN MODEL 
+!  LEVELS...                                                            
+!                                                                       
+      QEST=0.5*(QTOT+QNEW)                                              
+      G1=WTW+BOTERM-ENTERM-2.*G*DZ*QEST/1.5                             
+      IF(G1.LT.0.0)G1=0.                                                
+      WAVG=0.5*(SQRT(WTW)+SQRT(G1))                                      
+      CONV=RATE*DZ/WAVG                                                 
+!                                                                       
+!  RATIO3 IS THE FRACTION OF LIQUID WATER IN FRESH CONDENSATE, RATIO4 IS
+!  THE FRACTION OF LIQUID WATER IN THE TOTAL AMOUNT OF CONDENSATE INVOLV
+!  IN THE PRECIPITATION PROCESS - NOTE THAT ONLY 60% OF THE FRESH CONDEN
+!  SATE IS IS ALLOWED TO PARTICIPATE IN THE CONVERSION PROCESS...       
+!                                                                       
+      RATIO3=QNEWLQ/(QNEW+1.E-8)                                       
+!     OLDQ=QTOT                                                         
+      QTOT=QTOT+0.6*QNEW                                                
+      OLDQ=QTOT                                                         
+      RATIO4=(0.6*QNEWLQ+QLIQ)/(QTOT+1.E-8)                            
+      QTOT=QTOT*EXP(-CONV)                                              
+!                                                                       
+!  DETERMINE THE AMOUNT OF PRECIPITATION THAT FALLS OUT OF THE UPDRAFT  
+!  PARCEL AT THIS LEVEL...                                              
+!                                                                       
+      DQ=OLDQ-QTOT                                                      
+      QLQOUT=RATIO4*DQ                                                  
+      QICOUT=(1.-RATIO4)*DQ                                             
+!                                                                       
+!  ESTIMATE THE MEAN LOAD OF CONDENSATE ON THE UPDRAFT IN THE LAYER, CAL
+!  LATE VERTICAL VELOCITY                                               
+!                                                                       
+      PPTDRG=0.5*(OLDQ+QTOT-0.2*QNEW)                                   
+      WTW=WTW+BOTERM-ENTERM-2.*G*DZ*PPTDRG/1.5                          
+      IF(ABS(WTW).LT.1.E-4)WTW=1.E-4
+!                                                                       
+!  DETERMINE THE NEW LIQUID WATER AND ICE CONCENTRATIONS INCLUDING LOSSE
+!  DUE TO PRECIPITATION AND GAINS FROM CONDENSATION...                  
+!                                                                       
+      QLIQ=RATIO4*QTOT+RATIO3*0.4*QNEW                                  
+      QICE=(1.-RATIO4)*QTOT+(1.-RATIO3)*0.4*QNEW                        
+      QNEWLQ=0.                                                         
+      QNEWIC=0.                                                         
+
+   END SUBROUTINE CONDLOAD
+
+! ----------------------------------------------------------------------
+   SUBROUTINE PROF5(EQ,EE,UD)                                        
+!
+!***********************************************************************
+!*****    GAUSSIAN TYPE MIXING PROFILE....******************************
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!  THIS SUBROUTINE INTEGRATES THE AREA UNDER THE CURVE IN THE GAUSSIAN  
+!  DISTRIBUTION...THE NUMERICAL APPROXIMATION TO THE INTEGRAL IS TAKEN FROM
+!  "HANDBOOK OF MATHEMATICAL FUNCTIONS WITH FORMULAS, GRAPHS AND MATHEMATICS TABLES"
+!  ED. BY ABRAMOWITZ AND STEGUN, NATL BUREAU OF STANDARDS APPLIED
+!  MATHEMATICS SERIES.  JUNE, 1964., MAY, 1968.                         
+!                                     JACK KAIN                         
+!                                     7/6/89                            
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: EQ
+   REAL,         INTENT(INOUT)   :: EE,UD
+   REAL ::       SQRT2P,A1,A2,A3,P,SIGMA,FE,X,Y,EY,E45,T1,T2,C1,C2
+
+      DATA SQRT2P,A1,A2,A3,P,SIGMA,FE/2.506628,0.4361836,-0.1201676,       &
+           0.9372980,0.33267,0.166666667,0.202765151/                        
+      X=(EQ-0.5)/SIGMA                                                  
+      Y=6.*EQ-3.                                                        
+      EY=EXP(Y*Y/(-2))                                                  
+      E45=EXP(-4.5)                                                     
+      T2=1./(1.+P*ABS(Y))                                               
+      T1=0.500498                                                       
+      C1=A1*T1+A2*T1*T1+A3*T1*T1*T1                                     
+      C2=A1*T2+A2*T2*T2+A3*T2*T2*T2                                     
+      IF(Y.GE.0.)THEN                                                   
+        EE=SIGMA*(0.5*(SQRT2P-E45*C1-EY*C2)+SIGMA*(E45-EY))-E45*EQ*EQ/2.
+        UD=SIGMA*(0.5*(EY*C2-E45*C1)+SIGMA*(E45-EY))-E45*(0.5+EQ*EQ/2.-    &
+           EQ)                                                          
+      ELSE                                                              
+        EE=SIGMA*(0.5*(EY*C2-E45*C1)+SIGMA*(E45-EY))-E45*EQ*EQ/2.       
+        UD=SIGMA*(0.5*(SQRT2P-E45*C1-EY*C2)+SIGMA*(E45-EY))-E45*(0.5+EQ*   &
+           EQ/2.-EQ)                                                    
+      ENDIF                                                             
+      EE=EE/FE                                                          
+      UD=UD/FE                                                          
+
+   END SUBROUTINE PROF5
+
+! ------------------------------------------------------------------------
+   SUBROUTINE TPMIX2DD(p,thes,ts,qs,i,j)
+!
+! Lookup table variables:
+!     INTEGER, PARAMETER :: (KFNT=250,KFNP=220)
+!     REAL, SAVE, DIMENSION(1:KFNT,1:KFNP) :: TTAB,QSTAB
+!     REAL, SAVE, DIMENSION(1:KFNP) :: THE0K
+!     REAL, SAVE, DIMENSION(1:200) :: ALU
+!     REAL, SAVE :: RDPR,RDTHK,PLUTOP
+! End of Lookup table variables:
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: P,THES
+   REAL,         INTENT(INOUT)   :: TS,QS
+   INTEGER,      INTENT(IN   )   :: i,j     ! avail for debugging
+   REAL    ::    TP,QQ,BTH,TTH,PP,T00,T10,T01,T11,Q00,Q10,Q01,Q11
+   INTEGER ::    IPTB,ITHTB
+   CHARACTER*256 :: MESS
+!-----------------------------------------------------------------------
+
+!
+!******** LOOKUP TABLE VARIABLES (F77 format)... ****************************
+!     parameter(kfnt=250,kfnp=220)
+!
+!     COMMON/KFLUT/ ttab(kfnt,kfnp),qstab(kfnt,kfnp),the0k(kfnp),        &
+!                   alu(200),rdpr,rdthk,plutop 
+!*************************************************************** 
+!
+!***********************************************************************
+!     scaling pressure and tt table index                         
+!***********************************************************************
+!
+      tp=(p-plutop)*rdpr
+      qq=tp-aint(tp)
+      iptb=int(tp)+1
+!
+!***********************************************************************
+!              base and scaling factor for the                           
+!***********************************************************************
+!
+!  scaling the and tt table index                                        
+      bth=(the0k(iptb+1)-the0k(iptb))*qq+the0k(iptb)
+      tth=(thes-bth)*rdthk
+      pp   =tth-aint(tth)
+      ithtb=int(tth)+1
+!
+      t00=ttab(ithtb  ,iptb  )
+      t10=ttab(ithtb+1,iptb  )
+      t01=ttab(ithtb  ,iptb+1)
+      t11=ttab(ithtb+1,iptb+1)
+!
+      q00=qstab(ithtb  ,iptb  )
+      q10=qstab(ithtb+1,iptb  )
+      q01=qstab(ithtb  ,iptb+1)
+      q11=qstab(ithtb+1,iptb+1)
+!
+!***********************************************************************
+!              parcel temperature and saturation mixing ratio                                        
+!***********************************************************************
+!
+      ts=(t00+(t10-t00)*pp+(t01-t00)*qq+(t00-t10-t01+t11)*pp*qq)
+!
+      qs=(q00+(q10-q00)*pp+(q01-q00)*qq+(q00-q10-q01+q11)*pp*qq)
+!
+   END SUBROUTINE TPMIX2DD
+
+! -----------------------------------------------------------------------
+  SUBROUTINE ENVIRTHT(P1,T1,Q1,THT1,ALIQ,BLIQ,CLIQ,DLIQ)                       
+!
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: P1,T1,Q1,ALIQ,BLIQ,CLIQ,DLIQ
+   REAL,         INTENT(INOUT)   :: THT1
+   REAL    ::    EE,TLOG,ASTRT,AINC,A1,TP,VALUE,AINTRP,TDPT,TSAT,THT,      &
+                 T00,P00,C1,C2,C3,C4,C5
+   INTEGER ::    INDLU
+!-----------------------------------------------------------------------
+      DATA T00,P00,C1,C2,C3,C4,C5/273.16,1.E5,3374.6525,2.5403,3114.834,   &
+           0.278296,1.0723E-3/                                          
+!                                                                       
+!  CALCULATE ENVIRONMENTAL EQUIVALENT POTENTIAL TEMPERATURE...          
+!                                                                       
+! NOTE: Calculations for mixed/ice phase no longer used...jsk 8/00
+!
+      EE=Q1*P1/(0.622+Q1)                                             
+!     TLOG=ALOG(EE/ALIQ)                                              
+! ...calculate LOG term using lookup table...
+!
+      astrt=1.e-3
+      ainc=0.075
+      a1=ee/aliq
+      tp=(a1-astrt)/ainc
+      indlu=int(tp)+1
+      value=(indlu-1)*ainc+astrt
+      aintrp=(a1-value)/ainc
+      tlog=aintrp*alu(indlu+1)+(1-aintrp)*alu(indlu)
+!
+      TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)                               
+      TSAT=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(T1-T00))*(T1-TDPT) 
+      THT=T1*(P00/P1)**(0.2854*(1.-0.28*Q1))                          
+      THT1=THT*EXP((C1/TSAT-C2)*Q1*(1.+0.81*Q1))                      
+!
+  END SUBROUTINE ENVIRTHT                                                              
+! ***********************************************************************
+!====================================================================
+   SUBROUTINE kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,      &
+                     RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS,         &
+                     SVP1,SVP2,SVP3,SVPT0,                          &
+                     P_FIRST_SCALAR,restart,allowed_to_read,        &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte                   )
+!--------------------------------------------------------------------
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+   LOGICAL , INTENT(IN)           ::  restart,allowed_to_read
+   INTEGER , INTENT(IN)           ::  ids, ide, jds, jde, kds, kde, &
+                                      ims, ime, jms, jme, kms, kme, &
+                                      its, ite, jts, jte, kts, kte
+   INTEGER , INTENT(IN)           ::  P_QI,P_QS,P_FIRST_SCALAR
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+                                                          RTHCUTEN, &
+                                                          RQVCUTEN, &
+                                                          RQCCUTEN, &
+                                                          RQRCUTEN, &
+                                                          RQICUTEN, &
+                                                          RQSCUTEN
+
+   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
+
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+   REAL, INTENT(IN)    :: SVP1,SVP2,SVP3,SVPT0
+
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+
+   IF(.not.restart)THEN
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         RTHCUTEN(i,k,j)=0.
+         RQVCUTEN(i,k,j)=0.
+         RQCCUTEN(i,k,j)=0.
+         RQRCUTEN(i,k,j)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QI .ge. P_FIRST_SCALAR) THEN
+         DO j=jts,jtf
+         DO k=kts,ktf
+         DO i=its,itf
+            RQICUTEN(i,k,j)=0.
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QS .ge. P_FIRST_SCALAR) THEN
+         DO j=jts,jtf
+         DO k=kts,ktf
+         DO i=its,itf
+            RQSCUTEN(i,k,j)=0.
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      DO j=jts,jtf
+      DO i=its,itf
+         NCA(i,j)=-100.
+      ENDDO
+      ENDDO
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         W0AVG(i,k,j)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+
+   endif
+ 
+   CALL KF_LUTAB(SVP1,SVP2,SVP3,SVPT0)
+
+   END SUBROUTINE kf_eta_init
+
+!-------------------------------------------------------
+
+      subroutine kf_lutab(SVP1,SVP2,SVP3,SVPT0)
+!
+!  This subroutine is a lookup table.
+!  Given a series of series of saturation equivalent potential 
+!  temperatures, the temperature is calculated.
+!
+!--------------------------------------------------------------------
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+! Lookup table variables
+!     INTEGER, SAVE, PARAMETER :: KFNT=250,KFNP=220
+!     REAL, SAVE, DIMENSION(1:KFNT,1:KFNP) :: TTAB,QSTAB
+!     REAL, SAVE, DIMENSION(1:KFNP) :: THE0K
+!     REAL, SAVE, DIMENSION(1:200) :: ALU
+!     REAL, SAVE :: RDPR,RDTHK,PLUTOP
+! End of Lookup table variables
+
+     INTEGER :: KP,IT,ITCNT,I
+     REAL :: DTH,TMIN,TOLER,PBOT,DPR,                               &
+             TEMP,P,ES,QS,PI,THES,TGUES,THGUES,F0,T1,T0,THGS,F1,DT, &
+             ASTRT,AINC,A1,THTGS
+!    REAL    :: ALIQ,BLIQ,CLIQ,DLIQ,SVP1,SVP2,SVP3,SVPT0
+     REAL    :: ALIQ,BLIQ,CLIQ,DLIQ
+     REAL, INTENT(IN)    :: SVP1,SVP2,SVP3,SVPT0
+!
+! equivalent potential temperature increment
+      data dth/1./
+! minimum starting temp 
+      data tmin/150./
+! tolerance for accuracy of temperature 
+      data toler/0.001/
+! top pressure (pascals)
+      plutop=5000.0
+! bottom pressure (pascals)
+      pbot=110000.0
+
+      ALIQ = SVP1*1000.
+      BLIQ = SVP2
+      CLIQ = SVP2*SVPT0
+      DLIQ = SVP3
+
+!
+! compute parameters
+!
+! 1._over_(sat. equiv. theta increment)
+      rdthk=1./dth
+! pressure increment
+!
+      DPR=(PBOT-PLUTOP)/REAL(KFNP-1)
+!      dpr=(pbot-plutop)/REAL(kfnp-1)
+! 1._over_(pressure increment)
+      rdpr=1./dpr
+! compute the spread of thes
+!     thespd=dth*(kfnt-1)
+!
+! calculate the starting sat. equiv. theta
+!
+      temp=tmin 
+      p=plutop-dpr
+      do kp=1,kfnp
+        p=p+dpr
+        es=aliq*exp((bliq*temp-cliq)/(temp-dliq))
+        qs=0.622*es/(p-es)
+        pi=(1.e5/p)**(0.2854*(1.-0.28*qs))
+        the0k(kp)=temp*pi*exp((3374.6525/temp-2.5403)*qs*        &
+               (1.+0.81*qs))
+      enddo   
+!
+! compute temperatures for each sat. equiv. potential temp.
+!
+      p=plutop-dpr
+      do kp=1,kfnp
+        thes=the0k(kp)-dth
+        p=p+dpr
+        do it=1,kfnt
+! define sat. equiv. pot. temp.
+          thes=thes+dth
+! iterate to find temperature
+! find initial guess
+          if(it.eq.1) then
+            tgues=tmin
+          else
+            tgues=ttab(it-1,kp)
+          endif
+          es=aliq*exp((bliq*tgues-cliq)/(tgues-dliq))
+          qs=0.622*es/(p-es)
+          pi=(1.e5/p)**(0.2854*(1.-0.28*qs))
+          thgues=tgues*pi*exp((3374.6525/tgues-2.5403)*qs*      &
+               (1.+0.81*qs))
+          f0=thgues-thes
+          t1=tgues-0.5*f0
+          t0=tgues
+          itcnt=0
+! iteration loop
+          do itcnt=1,11
+            es=aliq*exp((bliq*t1-cliq)/(t1-dliq))
+            qs=0.622*es/(p-es)
+            pi=(1.e5/p)**(0.2854*(1.-0.28*qs))
+            thtgs=t1*pi*exp((3374.6525/t1-2.5403)*qs*(1.+0.81*qs))
+            f1=thtgs-thes
+            if(abs(f1).lt.toler)then
+              exit
+            endif
+!           itcnt=itcnt+1
+            dt=f1*(t1-t0)/(f1-f0)
+            t0=t1
+            f0=f1
+            t1=t1-dt
+          enddo 
+          ttab(it,kp)=t1 
+          qstab(it,kp)=qs
+        enddo
+      enddo   
+!
+! lookup table for tlog(emix/aliq)
+!
+! set up intial values for lookup tables
+!
+       astrt=1.e-3
+       ainc=0.075
+!
+       a1=astrt-ainc
+       do i=1,200
+         a1=a1+ainc
+         alu(i)=alog(a1)
+       enddo   
+!
+   END SUBROUTINE KF_LUTAB
+
+END MODULE module_cu_kfeta
Index: trunk/WRF.COMMON/WRFV2/phys/module_cu_sas.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_cu_sas.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_cu_sas.F	(revision 2744)
@@ -0,0 +1,2485 @@
+!
+MODULE module_cu_sas
+
+#ifndef IFORT_KLUDGE
+USE module_configure, ONLY: nl_get_start_year, nl_get_start_month, &
+                            nl_get_start_day, nl_get_start_hour
+#endif
+CONTAINS
+
+!-----------------------------------------------------------------
+      SUBROUTINE CU_SAS(                                        &
+                 DT,ITIMESTEP,STEPCU                            &
+                ,RAINCV,HTOP,HBOT                               &
+                ,U3D,V3D,W,T3D,QV3D,QC3D,QI3D,PI3D,RHO3D        &
+                ,DZ8W,PCPS,P8W,XLAND,CU_ACT_FLAG                &
+                ,ids,ide, jds,jde, kds,kde                      &
+                ,ims,ime, jms,jme, kms,kme                      &
+                ,its,ite, jts,jte, kts,kte                      &
+                ,F_QV    ,F_QC    ,F_QR    ,F_QI    ,F_QS       &
+                ,RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN            &
+                                                                )
+
+!-------------------------------------------------------------------
+      USE MODULE_GFS_MACHINE , ONLY : kind_phys, kind_evod
+      USE MODULE_GFS_FUNCPHYS , ONLY : gfuncphys
+      USE MODULE_GFS_PHYSCONS, grav => con_g, CP => con_CP, HVAP => con_HVAP  &
+     &,             RV => con_RV, FV => con_fvirt, T0C => con_T0C       &
+     &,             CVAP => con_CVAP, CLIQ => con_CLIQ                  & 
+     &,             EPS => con_eps, EPSM1 => con_epsm1                  &
+     &,             ROVCP => con_rocp, RD => con_rd
+!-------------------------------------------------------------------
+      IMPLICIT NONE
+!-------------------------------------------------------------------
+!-- U3D         3D u-velocity interpolated to theta points (m/s)
+!-- V3D         3D v-velocity interpolated to theta points (m/s)
+!-- TH3D	3D potential temperature (K)
+!-- T3D         temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!-- QC3D        3D cloud mixing ratio (Kg/Kg)
+!-- QI3D        3D ice mixing ratio (Kg/Kg)
+!-- P8w         3D pressure at full levels (Pa)
+!-- Pcps        3D pressure (Pa)
+!-- PI3D	3D exner function (dimensionless)
+!-- rr3D	3D dry air density (kg/m^3)
+!-- RUBLTEN     U tendency due to
+!               PBL parameterization (m/s^2)
+!-- RVBLTEN     V tendency due to
+!               PBL parameterization (m/s^2)
+!-- RTHBLTEN    Theta tendency due to
+!               PBL parameterization (K/s)
+!-- RQVBLTEN    Qv tendency due to
+!               PBL parameterization (kg/kg/s)
+!-- RQCBLTEN    Qc tendency due to
+!               PBL parameterization (kg/kg/s)
+!-- RQIBLTEN    Qi tendency due to
+!               PBL parameterization (kg/kg/s)
+!-- CP          heat capacity at constant pressure for dry air (J/kg/K)
+!-- GRAV        acceleration due to gravity (m/s^2)
+!-- ROVCP       R/CP
+!-- RD          gas constant for dry air (J/kg/K)
+!-- ROVG 	R/G
+!-- P_QI	species index for cloud ice
+!-- dz8w	dz between full levels (m)
+!-- z		height above sea level (m)
+!-- PSFC        pressure at the surface (Pa)
+!-- UST		u* in similarity theory (m/s)
+!-- PBL		PBL height (m)
+!-- PSIM        similarity stability function for momentum
+!-- PSIH        similarity stability function for heat
+!-- HFX		upward heat flux at the surface (W/m^2)
+!-- QFX		upward moisture flux at the surface (kg/m^2/s)
+!-- TSK		surface temperature (K)
+!-- GZ1OZ0      log(z/z0) where z0 is roughness length
+!-- WSPD        wind speed at lowest model level (m/s)
+!-- BR          bulk Richardson number in surface layer
+!-- DT		time step (s)
+!-- rvovrd      R_v divided by R_d (dimensionless)
+!-- EP1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
+!-- KARMAN      Von Karman constant
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!-------------------------------------------------------------------
+
+      INTEGER ::                        ICLDCK
+
+      INTEGER, INTENT(IN) ::            ids,ide, jds,jde, kds,kde,      &
+                                        ims,ime, jms,jme, kms,kme,      &
+                                        its,ite, jts,jte, kts,kte,      &
+                                        ITIMESTEP,                      &
+                                        STEPCU
+
+      REAL,    INTENT(IN) ::                                            &
+                                        DT
+
+
+      REAL,    DIMENSION(ims:ime, jms:jme), INTENT(IN) ::               &
+                                        XLAND
+
+      REAL,    DIMENSION(ims:ime, jms:jme), INTENT(INOUT) ::            &
+                                        RAINCV
+
+      REAL,    DIMENSION(ims:ime, jms:jme), INTENT(OUT) ::              &
+                                        HBOT,                           &
+                                        HTOP
+
+      LOGICAL, DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) ::             &
+                                        CU_ACT_FLAG
+
+
+      REAL,    DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) ::      &
+                                        DZ8W,                           &
+                                        P8w,                            &
+                                        Pcps,                           &
+                                        PI3D,                           &
+                                        QC3D,                           &
+                                        QI3D,                           &
+                                        QV3D,                           &
+                                        RHO3D,                          &
+                                        T3D,                            &
+                                        U3D,                            &
+                                        V3D,                            &
+                                        W
+
+!--------------------------- OPTIONAL VARS ----------------------------
+                                                                                                      
+      REAL, DIMENSION(ims:ime, kms:kme, jms:jme),                       &
+               OPTIONAL, INTENT(INOUT) ::                               &
+                                        RQCCUTEN,                       &
+                                        RQICUTEN,                       &
+                                        RQVCUTEN,                       &
+                                        RTHCUTEN
+                                                                                                      
+!
+! Flags relating to the optional tendency arrays declared above
+! Models that carry the optional tendencies will provdide the
+! optional arguments at compile time; these flags all the model
+! to determine at run-time whether a particular tracer is in
+! use or not.
+!
+   LOGICAL, OPTIONAL ::                                      &
+                                                   F_QV      &
+                                                  ,F_QC      &
+                                                  ,F_QR      &
+                                                  ,F_QI      &
+                                                  ,F_QS
+ 
+
+!--------------------------- LOCAL VARS ------------------------------
+
+      REAL,    DIMENSION(ims:ime, jms:jme) ::                           &
+                                        PSFC
+
+      REAL     (kind=kind_evod),save :: seed0
+!      REAL     (kind=kind_evod) :: seed0
+      REAL     (kind=kind_evod) ::      wrk
+
+      REAL     (kind=kind_phys) ::                                      &
+                                        DELT,                           &
+                                        DPSHC,                          &
+                                        RDELT,                          &
+                                        RSEED
+
+      REAL     (kind=kind_phys), DIMENSION(ids:ide,jds:jde) ::          & 
+                                        RANNUM
+
+      REAL     (kind=kind_phys), DIMENSION(its:ite) ::                  &
+                                        CLDWRK,                         &
+                                        PS,                             &
+                                        RCS,                            &
+                                        RN,                             &
+                                        SLIMSK,                         &
+                                        XKT2
+
+      REAL     (kind=kind_phys), DIMENSION(its:ite, kts:kte+1) ::       &
+                                        PRSI                            
+
+      REAL     (kind=kind_phys), DIMENSION(its:ite, kts:kte) ::         &
+                                        DEL,                            &
+                                        DOT,                            &
+                                        PHIL,                           &
+                                        PRSL,                           &
+                                        PRSLK,                          &
+                                        Q1,                             & 
+                                        T1,                             & 
+                                        U1,                             & 
+                                        V1,                             & 
+                                        ZI,                             & 
+                                        ZL 
+
+      REAL     (kind=kind_phys), DIMENSION(its:ite, kts:kte, 2) ::      &
+                                        QL 
+
+      INTEGER, DIMENSION(its:ite) ::                                    &
+                                        KBOT,                           &
+                                        KTOP,                           &
+                                        KUO
+
+      INTEGER ::                                                        &
+                                        I,                              &
+!                                        IGPVS,                          &
+                                        IM,                             &
+                                        J,                              &
+                                        JCAP,                           &
+                                        K,                              &
+                                        KM,                             &
+                                        KP,                             &
+                                        KX,                             &
+                                        NCLOUD 
+
+      INTEGER :: start_year,start_month,start_day,start_hour
+
+      integer :: iseed
+!      integer, save :: krsize
+      integer :: krsize
+      integer,  allocatable ::  nrnd(:)
+      real :: fsec
+
+!      DATA IGPVS/0/
+
+!-----------------------------------------------------------------------
+!
+!***  CHECK TO SEE IF THIS IS A CONVECTION TIMESTEP
+!
+      ICLDCK=MOD(ITIMESTEP,STEPCU)
+!-----------------------------------------------------------------------
+
+
+   IF(ICLDCK.EQ.0.OR.ITIMESTEP.EQ.0)THEN
+
+      DO J=JTS,JTE
+         DO I=ITS,ITE
+            CU_ACT_FLAG(I,J)=.TRUE.
+         ENDDO
+      ENDDO
+ 
+      IM=ITE-ITS+1
+      KX=KTE-KTS+1
+      JCAP=126
+      DPSHC=30_kind_phys
+      DELT=DT*STEPCU
+      RDELT=1./DELT
+      NCLOUD=1
+
+
+   DO J=jms,jme
+     DO I=ims,ime
+       PSFC(i,j)=P8w(i,kms,j)
+     ENDDO
+   ENDDO
+
+   if(itimestep.eq.0) then
+      CALL GFUNCPHYS
+
+        CALL nl_get_start_year(1,start_year)   
+        CALL nl_get_start_month(1,start_month)   
+        CALL nl_get_start_day(1,start_day)   
+        CALL nl_get_start_hour(1,start_hour)   
+
+        call random_seed(size=krsize)
+        if (.not. allocated (nrnd)) allocate (nrnd(krsize))
+
+        seed0 = start_year + start_month + start_day + start_hour
+        nrnd = start_hour + start_day*24
+        call random_seed
+        call random_seed(put=nrnd)
+        call random_number(wrk)
+        seed0 = seed0 + nint(wrk*1000.0)
+  
+   endif
+
+   fsec = ITIMESTEP*DT
+   iseed = mod(100.0*sqrt(fsec),1.0e9) + 1 + seed0
+   call random_seed(size=krsize)
+   if (.not. allocated (nrnd)) allocate (nrnd(krsize))
+   nrnd = iseed
+   call random_seed
+   call random_seed(put=nrnd)
+   call random_number(rannum)
+
+!   igpvs=1
+
+!-------------  J LOOP (OUTER) --------------------------------------------------
+
+   DO J=jts,jte
+
+! --------------- compute zi and zl -----------------------------------------
+      DO i=its,ite
+        ZI(I,KTS)=0.0
+      ENDDO
+
+      DO k=kts+1,kte
+        KM=K-1
+        DO i=its,ite
+          ZI(I,K)=ZI(I,KM)+dz8w(i,km,j)
+        ENDDO
+      ENDDO
+
+      DO k=kts+1,kte
+        KM=K-1
+        DO i=its,ite
+          ZL(I,KM)=(ZI(I,K)+ZI(I,KM))*0.5
+        ENDDO
+      ENDDO
+
+      DO i=its,ite
+        ZL(I,KTE)=2.*ZI(I,KTE)-ZL(I,KTE-1)
+      ENDDO
+
+! --------------- end compute zi and zl -------------------------------------
+
+
+!      call random_number(XKT2)
+      DO i=its,ite
+        xkt2(i)=rannum(i,j)
+        PS(i)=PSFC(i,j)*.001
+        RCS(i)=1.
+        SLIMSK(i)=ABS(XLAND(i,j)-2.)
+      ENDDO
+
+      DO i=its,ite
+        PRSI(i,kts)=PS(i)
+      ENDDO
+
+      DO k=kts,kte
+        kp=k+1
+        DO i=its,ite
+          PRSL(I,K)=Pcps(i,k,j)*.001
+          PHIL(I,K)=ZL(I,K)*GRAV
+          DOT(i,k)=-5.0E-4*GRAV*rho3d(i,k,j)*(w(i,k,j)+w(i,kp,j))
+        ENDDO
+      ENDDO
+
+      DO k=kts,kte
+        DO i=its,ite
+          DEL(i,k)=PRSL(i,k)*GRAV/RD*dz8w(i,k,j)/T3D(i,k,j)
+          U1(i,k)=U3D(i,k,j)
+          V1(i,k)=V3D(i,k,j)
+          Q1(i,k)=QV3D(i,k,j)/(1.+QV3D(i,k,j))
+          T1(i,k)=T3D(i,k,j)
+          QL(i,k,1)=QI3D(i,k,j)/(1.+QI3D(i,k,j))
+          QL(i,k,2)=QC3D(i,k,j)/(1.+QC3D(i,k,j))
+          PRSLK(I,K)=(PRSL(i,k)*.01)**ROVCP
+        ENDDO
+      ENDDO
+
+      DO k=kts+1,kte+1
+        km=k-1
+        DO i=its,ite
+          PRSI(i,k)=PRSI(i,km)-del(i,km) 
+        ENDDO
+      ENDDO
+
+
+      CALL SASCNV(IM,IM,KX,JCAP,DELT,DEL,PRSL,PS,PHIL,                  &
+                  QL,Q1,T1,U1,V1,RCS,CLDWRK,RN,KBOT,                    &
+                  KTOP,KUO,SLIMSK,DOT,XKT2,NCLOUD)
+
+      CALL SHALCV(IM,IM,KX,DELT,DEL,PRSI,PRSL,PRSLK,KUO,Q1,T1,DPSHC)
+
+      DO I=ITS,ITE
+        RAINCV(I,J)=RN(I)*1000./STEPCU
+        HBOT(I,J)=KBOT(I)
+        HTOP(I,J)=KTOP(I)
+      ENDDO
+
+      DO K=KTS,KTE
+        DO I=ITS,ITE
+          RTHCUTEN(I,K,J)=(T1(I,K)-T3D(I,K,J))/PI3D(I,K,J)*RDELT
+          RQVCUTEN(I,K,J)=(Q1(I,K)/(1.-q1(i,k))-QV3D(I,K,J))*RDELT
+        ENDDO
+      ENDDO
+
+      IF(PRESENT(RQCCUTEN))THEN
+        IF ( F_QC ) THEN
+          DO K=KTS,KTE
+            DO I=ITS,ITE
+              RQCCUTEN(I,K,J)=(QL(I,K,2)/(1.-ql(i,k,2))-QC3D(I,K,J))*RDELT
+            ENDDO
+          ENDDO
+        ENDIF
+      ENDIF
+
+      IF(PRESENT(RQICUTEN))THEN
+        IF ( F_QI ) THEN
+          DO K=KTS,KTE
+            DO I=ITS,ITE
+              RQICUTEN(I,K,J)=(QL(I,K,1)/(1.-ql(i,k,1))-QI3D(I,K,J))*RDELT
+            ENDDO
+          ENDDO
+        ENDIF
+      ENDIF
+
+
+   ENDDO
+
+   ENDIF
+
+   END SUBROUTINE CU_SAS
+
+!====================================================================
+   SUBROUTINE sasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,              &
+                     RESTART,P_QC,P_QI,P_FIRST_SCALAR,                  &
+                     allowed_to_read,                                   &
+                     ids, ide, jds, jde, kds, kde,                      &
+                     ims, ime, jms, jme, kms, kme,                      &
+                     its, ite, jts, jte, kts, kte)
+!--------------------------------------------------------------------
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+   LOGICAL , INTENT(IN)           ::  allowed_to_read,restart
+   INTEGER , INTENT(IN)           ::  ids, ide, jds, jde, kds, kde, &
+                                      ims, ime, jms, jme, kms, kme, &
+                                      its, ite, jts, jte, kts, kte
+   INTEGER , INTENT(IN)           ::  P_FIRST_SCALAR, P_QI, P_QC
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::  &
+                                                              RTHCUTEN, &
+                                                              RQVCUTEN, &
+                                                              RQCCUTEN, &
+                                                              RQICUTEN
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+
+   IF(.not.restart)THEN
+     DO j=jts,jtf
+     DO k=kts,ktf
+     DO i=its,itf
+       RTHCUTEN(i,k,j)=0.
+       RQVCUTEN(i,k,j)=0.
+     ENDDO
+     ENDDO
+     ENDDO
+
+     IF (P_QC .ge. P_FIRST_SCALAR) THEN
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           RQCCUTEN(i,k,j)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+     ENDIF
+
+     IF (P_QI .ge. P_FIRST_SCALAR) THEN
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           RQICUTEN(i,k,j)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+     ENDIF
+   ENDIF
+
+      END SUBROUTINE sasinit
+
+! ------------------------------------------------------------------------
+
+      SUBROUTINE SASCNV(IM,IX,KM,JCAP,DELT,DEL,PRSL,PS,PHIL,QL,         &
+!     SUBROUTINE SASCNV(IM,IX,KM,JCAP,DLT,DEL,PRSL,PHIL,QL,             &
+     &       Q1,T1,U1,V1,RCS,CLDWRK,RN,KBOT,KTOP,KUO,SLIMSK,            &
+     &       DOT,XKT2,ncloud)
+!  for cloud water version
+!     parameter(ncloud=0)
+!     SUBROUTINE SASCNV(KM,JCAP,DELT,DEL,SL,SLK,PS,QL,
+!    &       Q1,T1,U1,V1,RCS,CLDWRK,RN,KBOT,KTOP,KUO,SLIMSK,
+!    &       DOT,xkt2,ncloud)
+!
+      USE MODULE_GFS_MACHINE , ONLY : kind_phys,kind_evod
+      USE MODULE_GFS_FUNCPHYS ,ONLY : fpvs
+      USE MODULE_GFS_PHYSCONS, grav => con_g, CP => con_CP, HVAP => con_HVAP &
+     &,             RV => con_RV, FV => con_fvirt, T0C => con_T0C       &
+     &,             CVAP => con_CVAP, CLIQ => con_CLIQ                  &
+     &,             EPS => con_eps, EPSM1 => con_epsm1
+
+      implicit none
+!
+!     include 'constant.h'
+!
+      integer            IM, IX,  KM, JCAP, ncloud,                     &
+     &                   KBOT(IM), KTOP(IM), KUO(IM)
+      real(kind=kind_phys) DELT
+      real(kind=kind_phys) PS(IM),      DEL(IX,KM),  PRSL(IX,KM),       &
+!     real(kind=kind_phys)              DEL(IX,KM),  PRSL(IX,KM),
+     &                     QL(IX,KM,2), Q1(IX,KM),   T1(IX,KM),         &
+     &                     U1(IX,KM),   V1(IX,KM),   RCS(IM),           &
+     &                     CLDWRK(IM),  RN(IM),      SLIMSK(IM),        &
+     &                     DOT(IX,KM),  XKT2(IM),    PHIL(IX,KM)
+!
+      integer              I, INDX, jmn, k, knumb, latd, lond, km1
+!
+      real(kind=kind_phys) adw,     alpha,   alphal,  alphas,           &
+     &                     aup,     beta,    betal,   betas,            &
+     &                     c0,      cpoel,   dellat,  delta,            &
+     &                     desdt,   deta,    detad,   dg,               &
+     &                     dh,      dhh,     dlnsig,  dp,               &
+     &                     dq,      dqsdp,   dqsdt,   dt,               &
+     &                     dt2,     dtmax,   dtmin,   dv1,              &
+     &                     dv1q,    dv2,     dv2q,    dv1u,             &
+     &                     dv1v,    dv2u,    dv2v,    dv3u,             &
+     &                     dv3v,    dv3,     dv3q,    dvq1,             &
+     &                     dz,      dz1,     e1,      edtmax,           &
+     &                     edtmaxl, edtmaxs, el2orc,  elocp,            &
+     &                     es,      etah,                               &
+     &                     evef,    evfact,  evfactl, fact1,            &
+     &                     fact2,   factor,  fjcap,   fkm,              &
+     &                     fuv,     g,       gamma,   onemf,            &
+     &                     onemfu,  pdetrn,  pdpdwn,  pprime,           &
+     &                     qc,      qlk,     qrch,    qs,               &
+     &                     rain,    rfact,   shear,   tem1,             &
+     &                     tem2,    terr,    val,     val1,             &
+     &                     val2,    w1,      w1l,     w1s,              &
+     &                     w2,      w2l,     w2s,     w3,               &
+     &                     w3l,     w3s,     w4,      w4l,              & 
+     &                     w4s,     xdby,    xpw,     xpwd,             & 
+     &                     xqc,     xqrch,   xlambu,  mbdt,             &
+     &                     tem
+!
+!
+      integer              JMIN(IM), KB(IM), KBCON(IM), KBDTR(IM),      & 
+     &                     KT2(IM),  KTCON(IM), LMIN(IM),               &
+     &                     kbm(IM),  kbmax(IM), kmax(IM)
+!
+      real(kind=kind_phys) AA1(IM),     ACRT(IM),   ACRTFCT(IM),        & 
+     &                     DELHBAR(IM), DELQ(IM),   DELQ2(IM),          &
+     &                     DELQBAR(IM), DELQEV(IM), DELTBAR(IM),        &
+     &                     DELTV(IM),   DTCONV(IM), EDT(IM),            &
+     &                     EDTO(IM),    EDTX(IM),   FLD(IM),            &
+     &                     HCDO(IM),    HKBO(IM),   HMAX(IM),           &
+     &                     HMIN(IM),    HSBAR(IM),  UCDO(IM),           &
+     &                     UKBO(IM),    VCDO(IM),   VKBO(IM),           &
+     &                     PBCDIF(IM),  PDOT(IM),   PO(IM,KM),          &
+     &                                  PWAVO(IM),  PWEVO(IM),          &
+!    &                     PSFC(IM),    PWAVO(IM),  PWEVO(IM),          &
+     &                     QCDO(IM),    QCOND(IM),  QEVAP(IM),          &
+     &                     QKBO(IM),    RNTOT(IM),  VSHEAR(IM),         &
+     &                     XAA0(IM),    XHCD(IM),   XHKB(IM),           & 
+     &                     XK(IM),      XLAMB(IM),  XLAMD(IM),          &
+     &                     XMB(IM),     XMBMAX(IM), XPWAV(IM),          &
+     &                     XPWEV(IM),   XQCD(IM),   XQKB(IM)
+!
+!  PHYSICAL PARAMETERS
+      PARAMETER(G=grav)
+      PARAMETER(CPOEL=CP/HVAP,ELOCP=HVAP/CP,                            &
+     &          EL2ORC=HVAP*HVAP/(RV*CP))
+      PARAMETER(TERR=0.,C0=.002,DELTA=fv)
+      PARAMETER(FACT1=(CVAP-CLIQ)/RV,FACT2=HVAP/RV-FACT1*T0C)
+!  LOCAL VARIABLES AND ARRAYS
+      real(kind=kind_phys) PFLD(IM,KM),    TO(IM,KM),     QO(IM,KM),    &
+     &                     UO(IM,KM),      VO(IM,KM),     QESO(IM,KM)
+!  cloud water
+      real(kind=kind_phys) QLKO_KTCON(IM), DELLAL(IM),    TVO(IM,KM),   &
+     &                     DBYO(IM,KM),    ZO(IM,KM),     SUMZ(IM,KM),  &
+     &                     SUMH(IM,KM),    HEO(IM,KM),    HESO(IM,KM),  &
+     &                     QRCD(IM,KM),    DELLAH(IM,KM), DELLAQ(IM,KM),&
+     &                     DELLAU(IM,KM),  DELLAV(IM,KM), HCKO(IM,KM),  &
+     &                     UCKO(IM,KM),    VCKO(IM,KM),   QCKO(IM,KM),  &
+     &                     ETA(IM,KM),     ETAU(IM,KM),   ETAD(IM,KM),  &
+     &                     QRCDO(IM,KM),   PWO(IM,KM),    PWDO(IM,KM),  &
+     &                     RHBAR(IM),      TX1(IM)
+!
+      LOGICAL TOTFLG, CNVFLG(IM), DWNFLG(IM), DWNFLG2(IM), FLG(IM)
+!
+      real(kind=kind_phys) PCRIT(15), ACRITT(15), ACRIT(15)
+!     SAVE PCRIT, ACRITT
+      DATA PCRIT/850.,800.,750.,700.,650.,600.,550.,500.,450.,400.,     &
+     &           350.,300.,250.,200.,150./
+      DATA ACRITT/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216,       &
+     &           .3151,.3677,.41,.5255,.7663,1.1686,1.6851/
+!  GDAS DERIVED ACRIT
+!     DATA ACRITT/.203,.515,.521,.566,.625,.665,.659,.688,              & 
+!    &            .743,.813,.886,.947,1.138,1.377,1.896/
+!
+      real(kind=kind_phys) TF, TCR, TCRF, RZERO, RONE
+      parameter (TF=233.16, TCR=263.16, TCRF=1.0/(TCR-TF))
+      parameter (RZERO=0.0,RONE=1.0)
+!-----------------------------------------------------------------------
+!
+      km1 = km - 1
+!  INITIALIZE ARRAYS
+!
+      DO I=1,IM
+        RN(I)=0.
+        KBOT(I)=KM+1
+        KTOP(I)=0
+        KUO(I)=0
+        CNVFLG(I) = .TRUE.
+        DTCONV(I) = 3600.
+        CLDWRK(I) = 0.
+        PDOT(I) = 0.
+        KT2(I) = 0
+        QLKO_KTCON(I) = 0.
+        DELLAL(I) = 0.
+      ENDDO
+!!
+      DO K = 1, 15
+        ACRIT(K) = ACRITT(K) * (975. - PCRIT(K))
+      ENDDO
+      DT2 = DELT
+!cmr  dtmin = max(dt2,1200.)
+      val   =         1200.
+      dtmin = max(dt2, val )
+!cmr  dtmax = max(dt2,3600.)
+      val   =         3600.
+      dtmax = max(dt2, val )
+!  MODEL TUNABLE PARAMETERS ARE ALL HERE
+      MBDT    = 10.
+      EDTMAXl = .3
+      EDTMAXs = .3
+      ALPHAl  = .5
+      ALPHAs  = .5
+      BETAl   = .15
+      betas   = .15
+      BETAl   = .05
+      betas   = .05
+!     EVEF    = 0.07
+      evfact  = 0.3
+      evfactl = 0.3
+      PDPDWN  = 0.
+      PDETRN  = 200.
+      xlambu  = 1.e-4
+      fjcap   = (float(jcap) / 126.) ** 2
+!cmr  fjcap   = max(fjcap,1.)
+      val     =           1.
+      fjcap   = max(fjcap,val)
+      fkm     = (float(km) / 28.) ** 2
+!cmr  fkm     = max(fkm,1.)
+      fkm     = max(fkm,val)
+      W1l     = -8.E-3 
+      W2l     = -4.E-2
+      W3l     = -5.E-3 
+      W4l     = -5.E-4
+      W1s     = -2.E-4
+      W2s     = -2.E-3
+      W3s     = -1.E-3
+      W4s     = -2.E-5
+!CCCC IF(IM.EQ.384) THEN
+        LATD  = 92
+        lond  = 189
+!CCCC ELSEIF(IM.EQ.768) THEN
+!CCCC   LATD = 80
+!CCCC ELSE
+!CCCC   LATD = 0
+!CCCC ENDIF
+!
+!  DEFINE TOP LAYER FOR SEARCH OF THE DOWNDRAFT ORIGINATING LAYER
+!  AND THE MAXIMUM THETAE FOR UPDRAFT
+!
+      DO I=1,IM
+        KBMAX(I) = KM
+        KBM(I)   = KM
+        KMAX(I)  = KM
+        TX1(I)   = 1.0 / PS(I)
+      ENDDO
+!     
+      DO K = 1, KM
+        DO I=1,IM
+          IF (prSL(I,K)*tx1(I) .GT. 0.45) KBMAX(I) = K + 1
+          IF (prSL(I,K)*tx1(I) .GT. 0.70) KBM(I)   = K + 1
+          IF (prSL(I,K)*tx1(I) .GT. 0.04) KMAX(I)  = MIN(KM,K + 1)
+        ENDDO
+      ENDDO
+      DO I=1,IM
+        KBMAX(I) = MIN(KBMAX(I),KMAX(I))
+        KBM(I)   = MIN(KBM(I),KMAX(I))
+      ENDDO
+!
+!   CONVERT SURFACE PRESSURE TO MB FROM CB
+!
+!!
+      DO K = 1, KM
+        DO I=1,IM
+          if (K .le. kmax(i)) then
+            PFLD(I,k) = PRSL(I,K) * 10.0
+            PWO(I,k)  = 0.
+            PWDO(I,k) = 0.
+            TO(I,k)   = T1(I,k)
+            QO(I,k)   = Q1(I,k)
+            UO(I,k)   = U1(I,k)
+            VO(I,k)   = V1(I,k)
+            DBYO(I,k) = 0.
+            SUMZ(I,k) = 0.
+            SUMH(I,k) = 0.
+          endif
+        ENDDO
+      ENDDO
+
+!
+!  COLUMN VARIABLES
+!  P IS PRESSURE OF THE LAYER (MB)
+!  T IS TEMPERATURE AT T-DT (K)..TN
+!  Q IS MIXING RATIO AT T-DT (KG/KG)..QN
+!  TO IS TEMPERATURE AT T+DT (K)... THIS IS AFTER ADVECTION AND TURBULAN
+!  QO IS MIXING RATIO AT T+DT (KG/KG)..Q1
+!
+      DO K = 1, KM
+        DO I=1,IM
+          if (k .le. kmax(i)) then
+         !jfe        QESO(I,k) = 10. * FPVS(T1(I,k))
+         !
+            QESO(I,k) = 0.01 * fpvs(T1(I,K))      ! fpvs is in Pa
+         !
+            QESO(I,k) = EPS * QESO(I,k) / (PFLD(I,k) + EPSM1*QESO(I,k))
+         !cmr        QESO(I,k) = MAX(QESO(I,k),1.E-8)
+            val1      =             1.E-8
+            QESO(I,k) = MAX(QESO(I,k), val1)
+         !cmr        QO(I,k)   = max(QO(I,k),1.e-10)
+            val2      =           1.e-10
+            QO(I,k)   = max(QO(I,k), val2 )
+         !           QO(I,k)   = MIN(QO(I,k),QESO(I,k))
+            TVO(I,k)  = TO(I,k) + DELTA * TO(I,k) * QO(I,k)
+          endif
+        ENDDO
+      ENDDO
+
+!
+!  HYDROSTATIC HEIGHT ASSUME ZERO TERR
+!
+      DO K = 1, KM
+        DO I=1,IM
+          ZO(I,k) = PHIL(I,k) / G
+        ENDDO
+      ENDDO
+!  COMPUTE MOIST STATIC ENERGY
+      DO K = 1, KM
+        DO I=1,IM
+          if (K .le. kmax(i)) then
+!           tem       = G * ZO(I,k) + CP * TO(I,k)
+            tem       = PHIL(I,k) + CP * TO(I,k)
+            HEO(I,k)  = tem  + HVAP * QO(I,k)
+            HESO(I,k) = tem  + HVAP * QESO(I,k)
+!           HEO(I,k)  = MIN(HEO(I,k),HESO(I,k))
+          endif
+        ENDDO
+      ENDDO
+!
+!  DETERMINE LEVEL WITH LARGEST MOIST STATIC ENERGY
+!  THIS IS THE LEVEL WHERE UPDRAFT STARTS
+!
+      DO I=1,IM
+        HMAX(I) = HEO(I,1)
+        KB(I) = 1
+      ENDDO
+!!
+      DO K = 2, KM
+        DO I=1,IM
+          if (k .le. kbm(i)) then
+            IF(HEO(I,k).GT.HMAX(I).AND.CNVFLG(I)) THEN
+              KB(I)   = K
+              HMAX(I) = HEO(I,k)
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!     DO K = 1, KMAX - 1
+!         TOL(k) = .5 * (TO(I,k) + TO(I,k+1))
+!         QOL(k) = .5 * (QO(I,k) + QO(I,k+1))
+!         QESOL(I,k) = .5 * (QESO(I,k) + QESO(I,k+1))
+!         HEOL(I,k) = .5 * (HEO(I,k) + HEO(I,k+1))
+!         HESOL(I,k) = .5 * (HESO(I,k) + HESO(I,k+1))
+!     ENDDO
+      DO K = 1, KM1
+        DO I=1,IM
+          if (k .le. kmax(i)-1) then
+            DZ      = .5 * (ZO(I,k+1) - ZO(I,k))
+            DP      = .5 * (PFLD(I,k+1) - PFLD(I,k))
+!jfe        ES      = 10. * FPVS(TO(I,k+1))
+!
+            ES      = 0.01 * fpvs(TO(I,K+1))      ! fpvs is in Pa
+!
+            PPRIME  = PFLD(I,k+1) + EPSM1 * ES
+            QS      = EPS * ES / PPRIME
+            DQSDP   = - QS / PPRIME
+            DESDT   = ES * (FACT1 / TO(I,k+1) + FACT2 / (TO(I,k+1)**2))
+            DQSDT   = QS * PFLD(I,k+1) * DESDT / (ES * PPRIME)
+            GAMMA   = EL2ORC * QESO(I,k+1) / (TO(I,k+1)**2)
+            DT      = (G * DZ + HVAP * DQSDP * DP) / (CP * (1. + GAMMA))
+            DQ      = DQSDT * DT + DQSDP * DP
+            TO(I,k) = TO(I,k+1) + DT
+            QO(I,k) = QO(I,k+1) + DQ
+            PO(I,k) = .5 * (PFLD(I,k) + PFLD(I,k+1))
+          endif
+        ENDDO
+      ENDDO
+!
+      DO K = 1, KM1
+        DO I=1,IM
+          if (k .le. kmax(I)-1) then
+!jfe        QESO(I,k) = 10. * FPVS(TO(I,k))
+!
+            QESO(I,k) = 0.01 * fpvs(TO(I,K))      ! fpvs is in Pa
+!
+            QESO(I,k) = EPS * QESO(I,k) / (PO(I,k) + EPSM1*QESO(I,k))
+!cmr        QESO(I,k) = MAX(QESO(I,k),1.E-8)
+            val1      =             1.E-8
+            QESO(I,k) = MAX(QESO(I,k), val1)
+!cmr        QO(I,k)   = max(QO(I,k),1.e-10)
+            val2      =           1.e-10
+            QO(I,k)   = max(QO(I,k), val2 )
+!           QO(I,k)   = MIN(QO(I,k),QESO(I,k))
+            HEO(I,k)  = .5 * G * (ZO(I,k) + ZO(I,k+1)) +                &
+     &                  CP * TO(I,k) + HVAP * QO(I,k)
+            HESO(I,k) = .5 * G * (ZO(I,k) + ZO(I,k+1)) +                & 
+     &                  CP * TO(I,k) + HVAP * QESO(I,k)
+            UO(I,k)   = .5 * (UO(I,k) + UO(I,k+1))
+            VO(I,k)   = .5 * (VO(I,k) + VO(I,k+1))
+          endif
+        ENDDO
+      ENDDO
+!     k = kmax
+!       HEO(I,k) = HEO(I,k)
+!       hesol(k) = HESO(I,k)
+!      IF(LAT.EQ.LATD.AND.lon.eq.lond.and.CNVFLG(I)) THEN
+!        PRINT *, '   HEO ='
+!        PRINT 6001, (HEO(I,K),K=1,KMAX)
+!        PRINT *, '   HESO ='
+!        PRINT 6001, (HESO(I,K),K=1,KMAX)
+!        PRINT *, '   TO ='
+!        PRINT 6002, (TO(I,K)-273.16,K=1,KMAX)
+!        PRINT *, '   QO ='
+!        PRINT 6003, (QO(I,K),K=1,KMAX)
+!        PRINT *, '   QSO ='
+!        PRINT 6003, (QESO(I,K),K=1,KMAX)
+!      ENDIF
+!
+!  LOOK FOR CONVECTIVE CLOUD BASE AS THE LEVEL OF FREE CONVECTION
+!
+      DO I=1,IM
+        IF(CNVFLG(I)) THEN
+          INDX    = KB(I)
+          HKBO(I) = HEO(I,INDX)
+          QKBO(I) = QO(I,INDX)
+          UKBO(I) = UO(I,INDX)
+          VKBO(I) = VO(I,INDX)
+        ENDIF
+        FLG(I)    = CNVFLG(I)
+        KBCON(I)  = KMAX(I)
+      ENDDO
+!!
+      DO K = 1, KM
+        DO I=1,IM
+          if (k .le. kbmax(i)) then
+            IF(FLG(I).AND.K.GT.KB(I)) THEN
+              HSBAR(I)   = HESO(I,k)
+              IF(HKBO(I).GT.HSBAR(I)) THEN
+                FLG(I)   = .FALSE.
+                KBCON(I) = K
+              ENDIF
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+      DO I=1,IM
+        IF(CNVFLG(I)) THEN
+          PBCDIF(I) = -PFLD(I,KBCON(I)) + PFLD(I,KB(I))
+          PDOT(I)   = 10.* DOT(I,KBCON(I))
+          IF(PBCDIF(I).GT.150.)    CNVFLG(I) = .FALSE.
+          IF(KBCON(I).EQ.KMAX(I))  CNVFLG(I) = .FALSE.
+        ENDIF
+      ENDDO
+!!
+      TOTFLG = .TRUE.
+      DO I=1,IM
+        TOTFLG = TOTFLG .AND. (.NOT. CNVFLG(I))
+      ENDDO
+      IF(TOTFLG) RETURN
+!  FOUND LFC, CAN DEFINE REST OF VARIABLES
+ 6001 FORMAT(2X,-2P10F12.2)
+ 6002 FORMAT(2X,10F12.2)
+ 6003 FORMAT(2X,3P10F12.2)
+
+!
+!  DETERMINE ENTRAINMENT RATE BETWEEN KB AND KBCON
+!
+      DO I = 1, IM
+        alpha = alphas
+        if(SLIMSK(I).eq.1.) alpha = alphal
+        IF(CNVFLG(I)) THEN
+          IF(KB(I).EQ.1) THEN
+            DZ = .5 * (ZO(I,KBCON(I)) + ZO(I,KBCON(I)-1)) - ZO(I,1)
+          ELSE
+            DZ = .5 * (ZO(I,KBCON(I)) + ZO(I,KBCON(I)-1))               &
+     &         - .5 * (ZO(I,KB(I)) + ZO(I,KB(I)-1))
+          ENDIF
+          IF(KBCON(I).NE.KB(I)) THEN
+!cmr        XLAMB(I) = -ALOG(ALPHA) / DZ
+            XLAMB(I) = - LOG(ALPHA) / DZ
+          ELSE
+            XLAMB(I) = 0.
+          ENDIF
+        ENDIF
+      ENDDO
+!  DETERMINE UPDRAFT MASS FLUX
+      DO K = 1, KM
+        DO I = 1, IM
+          if (k .le. kmax(i) .and. CNVFLG(I)) then
+            ETA(I,k)  = 1.
+            ETAU(I,k) = 1.
+          ENDIF
+        ENDDO
+      ENDDO
+      DO K = KM1, 2, -1
+        DO I = 1, IM
+          if (k .le. kbmax(i)) then
+            IF(CNVFLG(I).AND.K.LT.KBCON(I).AND.K.GE.KB(I)) THEN
+              DZ        = .5 * (ZO(I,k+1) - ZO(I,k-1))
+              ETA(I,k)  = ETA(I,k+1) * EXP(-XLAMB(I) * DZ)
+              ETAU(I,k) = ETA(I,k)
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+      DO I = 1, IM
+        IF(CNVFLG(I).AND.KB(I).EQ.1.AND.KBCON(I).GT.1) THEN
+          DZ = .5 * (ZO(I,2) - ZO(I,1))
+          ETA(I,1) = ETA(I,2) * EXP(-XLAMB(I) * DZ)
+          ETAU(I,1) = ETA(I,1)
+        ENDIF
+      ENDDO
+!
+!  WORK UP UPDRAFT CLOUD PROPERTIES
+!
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+          INDX         = KB(I)
+          HCKO(I,INDX) = HKBO(I)
+          QCKO(I,INDX) = QKBO(I)
+          UCKO(I,INDX) = UKBO(I)
+          VCKO(I,INDX) = VKBO(I)
+          PWAVO(I)     = 0.
+        ENDIF
+      ENDDO
+!
+!  CLOUD PROPERTY BELOW CLOUD BASE IS MODIFIED BY THE ENTRAINMENT PROCES
+!
+      DO K = 2, KM1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+            IF(CNVFLG(I).AND.K.GT.KB(I).AND.K.LE.KBCON(I)) THEN
+              FACTOR = ETA(I,k-1) / ETA(I,k)
+              ONEMF = 1. - FACTOR
+              HCKO(I,k) = FACTOR * HCKO(I,k-1) + ONEMF *                &
+     &                    .5 * (HEO(I,k) + HEO(I,k+1))
+              UCKO(I,k) = FACTOR * UCKO(I,k-1) + ONEMF *                & 
+     &                    .5 * (UO(I,k) + UO(I,k+1))
+              VCKO(I,k) = FACTOR * VCKO(I,k-1) + ONEMF *                &
+     &                    .5 * (VO(I,k) + VO(I,k+1))
+              DBYO(I,k) = HCKO(I,k) - HESO(I,k)
+            ENDIF
+            IF(CNVFLG(I).AND.K.GT.KBCON(I)) THEN
+              HCKO(I,k) = HCKO(I,k-1)
+              UCKO(I,k) = UCKO(I,k-1)
+              VCKO(I,k) = VCKO(I,k-1)
+              DBYO(I,k) = HCKO(I,k) - HESO(I,k)
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!  DETERMINE CLOUD TOP
+      DO I = 1, IM
+        FLG(I) = CNVFLG(I)
+        KTCON(I) = 1
+      ENDDO
+!     DO K = 2, KMAX
+!       KK = KMAX - K + 1
+!         IF(DBYO(I,kK).GE.0..AND.FLG(I).AND.KK.GT.KBCON(I)) THEN
+!           KTCON(I) = KK + 1
+!           FLG(I) = .FALSE.
+!         ENDIF
+!     ENDDO
+      DO K = 2, KM
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            IF(DBYO(I,k).LT.0..AND.FLG(I).AND.K.GT.KBCON(I)) THEN
+              KTCON(I) = K
+              FLG(I) = .FALSE.
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+      DO I = 1, IM
+        IF(CNVFLG(I).AND.(PFLD(I,KBCON(I)) - PFLD(I,KTCON(I))).LT.150.) &
+     &  CNVFLG(I) = .FALSE.
+      ENDDO
+      TOTFLG = .TRUE.
+      DO I = 1, IM
+        TOTFLG = TOTFLG .AND. (.NOT. CNVFLG(I))
+      ENDDO
+      IF(TOTFLG) RETURN
+!
+!  SEARCH FOR DOWNDRAFT ORIGINATING LEVEL ABOVE THETA-E MINIMUM
+!
+      DO I = 1, IM
+        HMIN(I) = HEO(I,KBCON(I))
+        LMIN(I) = KBMAX(I)
+        JMIN(I) = KBMAX(I)
+      ENDDO
+      DO I = 1, IM
+        DO K = KBCON(I), KBMAX(I)
+          IF(HEO(I,k).LT.HMIN(I).AND.CNVFLG(I)) THEN
+            LMIN(I) = K + 1
+            HMIN(I) = HEO(I,k)
+          ENDIF
+        ENDDO
+      ENDDO
+!
+!  Make sure that JMIN(I) is within the cloud
+!
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+          JMIN(I) = MIN(LMIN(I),KTCON(I)-1)
+          XMBMAX(I) = .1
+          JMIN(I) = MAX(JMIN(I),KBCON(I)+1)
+        ENDIF
+      ENDDO
+!
+!  ENTRAINING CLOUD
+!
+      do k = 2, km1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+            if(CNVFLG(I).and.k.gt.JMIN(I).and.k.le.KTCON(I)) THEN
+              SUMZ(I,k) = SUMZ(I,k-1) + .5 * (ZO(I,k+1) - ZO(I,k-1))
+              SUMH(I,k) = SUMH(I,k-1) + .5 * (ZO(I,k+1) - ZO(I,k-1))    &
+     &                  * HEO(I,k)
+            ENDIF
+          endif
+        enddo
+      enddo
+!!
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+!         call random_number(XKT2)
+!         call srand(fhour)
+!         XKT2(I) = rand()
+          KT2(I) = nint(XKT2(I)*float(KTCON(I)-JMIN(I))-.5)+JMIN(I)+1
+!         KT2(I) = nint(sqrt(XKT2(I))*float(KTCON(I)-JMIN(I))-.5) + JMIN(I) + 1
+!         KT2(I) = nint(ranf() *float(KTCON(I)-JMIN(I))-.5) + JMIN(I) + 1
+          tem1 = (HCKO(I,JMIN(I)) - HESO(I,KT2(I)))
+          tem2 = (SUMZ(I,KT2(I)) * HESO(I,KT2(I)) - SUMH(I,KT2(I)))
+          if (abs(tem2) .gt. 0.000001) THEN
+            XLAMB(I) = tem1 / tem2
+          else
+            CNVFLG(I) = .false.
+          ENDIF
+!         XLAMB(I) = (HCKO(I,JMIN(I)) - HESO(I,KT2(I)))
+!    &          / (SUMZ(I,KT2(I)) * HESO(I,KT2(I)) - SUMH(I,KT2(I)))
+          XLAMB(I) = max(XLAMB(I),RZERO)
+          XLAMB(I) = min(XLAMB(I),2.3/SUMZ(I,KT2(I)))
+        ENDIF
+      ENDDO
+!!
+      DO I = 1, IM
+       DWNFLG(I)  = CNVFLG(I)
+       DWNFLG2(I) = CNVFLG(I)
+       IF(CNVFLG(I)) THEN
+        if(KT2(I).ge.KTCON(I)) DWNFLG(I) = .false.
+      if(XLAMB(I).le.1.e-30.or.HCKO(I,JMIN(I))-HESO(I,KT2(I)).le.1.e-30)&
+     &  DWNFLG(I) = .false.
+        do k = JMIN(I), KT2(I)
+          if(DWNFLG(I).and.HEO(I,k).gt.HESO(I,KT2(I))) DWNFLG(I)=.false.
+        enddo
+!       IF(CNVFLG(I).AND.(PFLD(KBCON(I))-PFLD(KTCON(I))).GT.PDETRN)
+!    &     DWNFLG(I)=.FALSE.
+        IF(CNVFLG(I).AND.(PFLD(I,KBCON(I))-PFLD(I,KTCON(I))).LT.PDPDWN) &
+     &     DWNFLG2(I)=.FALSE.
+       ENDIF
+      ENDDO
+!!
+      DO K = 2, KM1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+            IF(DWNFLG(I).AND.K.GT.JMIN(I).AND.K.LE.KT2(I)) THEN
+              DZ        = .5 * (ZO(I,k+1) - ZO(I,k-1))
+!             ETA(I,k)  = ETA(I,k-1) * EXP( XLAMB(I) * DZ)
+!  to simplify matter, we will take the linear approach here
+!
+              ETA(I,k)  = ETA(I,k-1) * (1. + XLAMB(I) * dz)
+              ETAU(I,k) = ETAU(I,k-1) * (1. + (XLAMB(I)+xlambu) * dz)
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!!
+      DO K = 2, KM1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+!           IF(.NOT.DWNFLG(I).AND.K.GT.JMIN(I).AND.K.LE.KT2(I)) THEN
+            IF(.NOT.DWNFLG(I).AND.K.GT.JMIN(I).AND.K.LE.KTCON(I)) THEN
+              DZ        = .5 * (ZO(I,k+1) - ZO(I,k-1))
+              ETAU(I,k) = ETAU(I,k-1) * (1. + xlambu * dz)
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!      IF(LAT.EQ.LATD.AND.lon.eq.lond.and.CNVFLG(I)) THEN
+!        PRINT *, ' LMIN(I), KT2(I)=', LMIN(I), KT2(I)
+!        PRINT *, ' KBOT, KTOP, JMIN(I) =', KBCON(I), KTCON(I), JMIN(I)
+!      ENDIF
+!     IF(LAT.EQ.LATD.AND.lon.eq.lond) THEN
+!       print *, ' xlamb =', xlamb
+!       print *, ' eta =', (eta(k),k=1,KT2(I))
+!       print *, ' ETAU =', (ETAU(I,k),k=1,KT2(I))
+!       print *, ' HCKO =', (HCKO(I,k),k=1,KT2(I))
+!       print *, ' SUMZ =', (SUMZ(I,k),k=1,KT2(I))
+!       print *, ' SUMH =', (SUMH(I,k),k=1,KT2(I))
+!     ENDIF
+      DO I = 1, IM
+        if(DWNFLG(I)) THEN
+          KTCON(I) = KT2(I)
+        ENDIF
+      ENDDO
+!
+!  CLOUD PROPERTY ABOVE CLOUD Base IS MODIFIED BY THE DETRAINMENT PROCESS
+!
+      DO K = 2, KM1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+!jfe
+            IF(CNVFLG(I).AND.K.GT.KBCON(I).AND.K.LE.KTCON(I)) THEN
+!jfe      IF(K.GT.KBCON(I).AND.K.LE.KTCON(I)) THEN
+              FACTOR    = ETA(I,k-1) / ETA(I,k)
+              ONEMF     = 1. - FACTOR
+              fuv       = ETAU(I,k-1) / ETAU(I,k)
+              onemfu    = 1. - fuv
+              HCKO(I,k) = FACTOR * HCKO(I,k-1) + ONEMF *                &
+     &                    .5 * (HEO(I,k) + HEO(I,k+1))
+              UCKO(I,k) = fuv * UCKO(I,k-1) + ONEMFu *                  &
+     &                    .5 * (UO(I,k) + UO(I,k+1))
+              VCKO(I,k) = fuv * VCKO(I,k-1) + ONEMFu *                  &
+     &                    .5 * (VO(I,k) + VO(I,k+1))
+              DBYO(I,k) = HCKO(I,k) - HESO(I,k)
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!      IF(LAT.EQ.LATD.AND.lon.eq.lond.and.CNVFLG(I)) THEN
+!        PRINT *, ' UCKO=', (UCKO(I,k),k=KBCON(I)+1,KTCON(I))
+!        PRINT *, ' uenv=', (.5*(UO(I,k)+UO(I,k-1)),k=KBCON(I)+1,KTCON(I))
+!      ENDIF
+      DO I = 1, IM
+        if(CNVFLG(I).and.DWNFLG2(I).and.JMIN(I).le.KBCON(I))            &
+     &     THEN
+          CNVFLG(I) = .false.
+          DWNFLG(I) = .false.
+          DWNFLG2(I) = .false.
+        ENDIF
+      ENDDO
+!!
+      TOTFLG = .TRUE.
+      DO I = 1, IM
+        TOTFLG = TOTFLG .AND. (.NOT. CNVFLG(I))
+      ENDDO
+      IF(TOTFLG) RETURN
+!!
+!
+!  COMPUTE CLOUD MOISTURE PROPERTY AND PRECIPITATION
+!
+      DO I = 1, IM
+          AA1(I) = 0.
+          RHBAR(I) = 0.
+      ENDDO
+      DO K = 1, KM
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            IF(CNVFLG(I).AND.K.GT.KB(I).AND.K.LT.KTCON(I)) THEN
+              DZ = .5 * (ZO(I,k+1) - ZO(I,k-1))
+              DZ1 = (ZO(I,k) - ZO(I,k-1))
+              GAMMA = EL2ORC * QESO(I,k) / (TO(I,k)**2)
+              QRCH = QESO(I,k)                                          &
+     &             + GAMMA * DBYO(I,k) / (HVAP * (1. + GAMMA))
+              FACTOR = ETA(I,k-1) / ETA(I,k)
+              ONEMF = 1. - FACTOR
+              QCKO(I,k) = FACTOR * QCKO(I,k-1) + ONEMF *                &
+     &                    .5 * (QO(I,k) + QO(I,k+1))
+              DQ = ETA(I,k) * QCKO(I,k) - ETA(I,k) * QRCH
+              RHBAR(I) = RHBAR(I) + QO(I,k) / QESO(I,k)
+!
+!  BELOW LFC CHECK IF THERE IS EXCESS MOISTURE TO RELEASE LATENT HEAT
+!
+              IF(DQ.GT.0.) THEN
+                ETAH = .5 * (ETA(I,k) + ETA(I,k-1))
+                QLK = DQ / (ETA(I,k) + ETAH * C0 * DZ)
+                AA1(I) = AA1(I) - DZ1 * G * QLK
+                QC = QLK + QRCH
+                PWO(I,k) = ETAH * C0 * DZ * QLK
+                QCKO(I,k) = QC
+                PWAVO(I) = PWAVO(I) + PWO(I,k)
+              ENDIF
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+      DO I = 1, IM
+        RHBAR(I) = RHBAR(I) / float(KTCON(I) - KB(I) - 1)
+      ENDDO
+!
+!  this section is ready for cloud water
+!
+      if(ncloud.gt.0) THEN
+!
+!  compute liquid and vapor separation at cloud top
+!
+      DO I = 1, IM
+        k = KTCON(I)
+        IF(CNVFLG(I)) THEN
+          GAMMA = EL2ORC * QESO(I,K) / (TO(I,K)**2)
+          QRCH = QESO(I,K)                                              &
+     &         + GAMMA * DBYO(I,K) / (HVAP * (1. + GAMMA))
+          DQ = QCKO(I,K-1) - QRCH
+!
+!  CHECK IF THERE IS EXCESS MOISTURE TO RELEASE LATENT HEAT
+!
+          IF(DQ.GT.0.) THEN
+            QLKO_KTCON(I) = dq
+            QCKO(I,K-1) = QRCH
+          ENDIF
+        ENDIF
+      ENDDO
+      ENDIF
+!
+!  CALCULATE CLOUD WORK FUNCTION AT T+DT
+!
+      DO K = 1, KM
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            IF(CNVFLG(I).AND.K.GT.KBCON(I).AND.K.LE.KTCON(I)) THEN
+              DZ1 = ZO(I,k) - ZO(I,k-1)
+              GAMMA = EL2ORC * QESO(I,k-1) / (TO(I,k-1)**2)
+              RFACT =  1. + DELTA * CP * GAMMA                          &
+     &                 * TO(I,k-1) / HVAP
+              AA1(I) = AA1(I) +                                         &
+     &                 DZ1 * (G / (CP * TO(I,k-1)))                     &
+     &                 * DBYO(I,k-1) / (1. + GAMMA)                     &
+     &                 * RFACT
+              val = 0.
+              AA1(I)=AA1(I)+                                            &
+     &                 DZ1 * G * DELTA *                                &
+!cmr &                 MAX( 0.,(QESO(I,k-1) - QO(I,k-1)))               & 
+     &                 MAX(val,(QESO(I,k-1) - QO(I,k-1)))
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+      DO I = 1, IM
+        IF(CNVFLG(I).AND.AA1(I).LE.0.) DWNFLG(I)  = .FALSE.
+        IF(CNVFLG(I).AND.AA1(I).LE.0.) DWNFLG2(I) = .FALSE.
+        IF(CNVFLG(I).AND.AA1(I).LE.0.) CNVFLG(I)  = .FALSE.
+      ENDDO
+!!
+      TOTFLG = .TRUE.
+      DO I = 1, IM
+        TOTFLG = TOTFLG .AND. (.NOT. CNVFLG(I))
+      ENDDO
+      IF(TOTFLG) RETURN
+!!
+!cccc IF(LAT.EQ.LATD.AND.lon.eq.lond.and.CNVFLG(I)) THEN
+!cccc   PRINT *, ' AA1(I) BEFORE DWNDRFT =', AA1(I)
+!cccc ENDIF
+!
+!------- DOWNDRAFT CALCULATIONS
+!
+!
+!--- DETERMINE DOWNDRAFT STRENGTH IN TERMS OF WINDSHEAR
+!
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+          VSHEAR(I) = 0.
+        ENDIF
+      ENDDO
+      DO K = 1, KM
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            IF(K.GE.KB(I).AND.K.LE.KTCON(I).AND.CNVFLG(I)) THEN
+              shear=rcs(I) * sqrt((UO(I,k+1)-UO(I,k)) ** 2              &
+     &                          + (VO(I,k+1)-VO(I,k)) ** 2)
+              VSHEAR(I) = VSHEAR(I) + SHEAR
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+      DO I = 1, IM
+        EDT(I) = 0.
+        IF(CNVFLG(I)) THEN
+          KNUMB = KTCON(I) - KB(I) + 1
+          KNUMB = MAX(KNUMB,1)
+          VSHEAR(I) = 1.E3 * VSHEAR(I) / (ZO(I,KTCON(I))-ZO(I,KB(I)))
+          E1=1.591-.639*VSHEAR(I)                                       &
+     &       +.0953*(VSHEAR(I)**2)-.00496*(VSHEAR(I)**3)
+          EDT(I)=1.-E1
+!cmr      EDT(I) = MIN(EDT(I),.9)
+          val =         .9
+          EDT(I) = MIN(EDT(I),val)
+!cmr      EDT(I) = MAX(EDT(I),.0)
+          val =         .0
+          EDT(I) = MAX(EDT(I),val)
+          EDTO(I)=EDT(I)
+          EDTX(I)=EDT(I)
+        ENDIF
+      ENDDO
+!  DETERMINE DETRAINMENT RATE BETWEEN 1 AND KBDTR
+      DO I = 1, IM
+        KBDTR(I) = KBCON(I)
+        beta = betas
+        if(SLIMSK(I).eq.1.) beta = betal
+        IF(CNVFLG(I)) THEN
+          KBDTR(I) = KBCON(I)
+          KBDTR(I) = MAX(KBDTR(I),1)
+          XLAMD(I) = 0.
+          IF(KBDTR(I).GT.1) THEN
+            DZ = .5 * ZO(I,KBDTR(I)) + .5 * ZO(I,KBDTR(I)-1)            &
+     &         - ZO(I,1)
+            XLAMD(I) =  LOG(BETA) / DZ
+          ENDIF
+        ENDIF
+      ENDDO
+!  DETERMINE DOWNDRAFT MASS FLUX
+      DO K = 1, KM
+        DO I = 1, IM
+          IF(k .le. kmax(i)) then
+            IF(CNVFLG(I)) THEN
+              ETAD(I,k) = 1.
+            ENDIF
+            QRCDO(I,k) = 0.
+          endif
+        ENDDO
+      ENDDO
+      DO K = KM1, 2, -1
+        DO I = 1, IM
+          if (k .le. kbmax(i)) then
+            IF(CNVFLG(I).AND.K.LT.KBDTR(I)) THEN
+              DZ        = .5 * (ZO(I,k+1) - ZO(I,k-1))
+              ETAD(I,k) = ETAD(I,k+1) * EXP(XLAMD(I) * DZ)
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+      K = 1
+      DO I = 1, IM
+        IF(CNVFLG(I).AND.KBDTR(I).GT.1) THEN
+          DZ = .5 * (ZO(I,2) - ZO(I,1))
+          ETAD(I,k) = ETAD(I,k+1) * EXP(XLAMD(I) * DZ)
+        ENDIF
+      ENDDO
+!
+!--- DOWNDRAFT MOISTURE PROPERTIES
+!
+      DO I = 1, IM
+        PWEVO(I) = 0.
+        FLG(I) = CNVFLG(I)
+      ENDDO
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+          JMN = JMIN(I)
+          HCDO(I) = HEO(I,JMN)
+          QCDO(I) = QO(I,JMN)
+          QRCDO(I,JMN) = QESO(I,JMN)
+          UCDO(I) = UO(I,JMN)
+          VCDO(I) = VO(I,JMN)
+        ENDIF
+      ENDDO
+      DO K = KM1, 1, -1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+            IF(CNVFLG(I).AND.K.LT.JMIN(I)) THEN
+              DQ = QESO(I,k)
+              DT = TO(I,k)
+              GAMMA      = EL2ORC * DQ / DT**2
+              DH         = HCDO(I) - HESO(I,k)
+              QRCDO(I,k) = DQ+(1./HVAP)*(GAMMA/(1.+GAMMA))*DH
+              DETAD      = ETAD(I,k+1) - ETAD(I,k)
+              PWDO(I,k)  = ETAD(I,k+1) * QCDO(I) -                      &
+     &                     ETAD(I,k) * QRCDO(I,k)
+              PWDO(I,k)  = PWDO(I,k) - DETAD *                          &
+     &                    .5 * (QRCDO(I,k) + QRCDO(I,k+1))
+              QCDO(I)    = QRCDO(I,k)
+              PWEVO(I)   = PWEVO(I) + PWDO(I,k)
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!     IF(LAT.EQ.LATD.AND.lon.eq.lond.and.DWNFLG(I)) THEN
+!       PRINT *, ' PWAVO(I), PWEVO(I) =', PWAVO(I), PWEVO(I)
+!     ENDIF
+!
+!--- FINAL DOWNDRAFT STRENGTH DEPENDENT ON PRECIP
+!--- EFFICIENCY (EDT), NORMALIZED CONDENSATE (PWAV), AND
+!--- EVAPORATE (PWEV)
+!
+      DO I = 1, IM
+        edtmax = edtmaxl
+        if(SLIMSK(I).eq.0.) edtmax = edtmaxs
+        IF(DWNFLG2(I)) THEN
+          IF(PWEVO(I).LT.0.) THEN
+            EDTO(I) = -EDTO(I) * PWAVO(I) / PWEVO(I)
+            EDTO(I) = MIN(EDTO(I),EDTMAX)
+          ELSE
+            EDTO(I) = 0.
+          ENDIF
+        ELSE
+          EDTO(I) = 0.
+        ENDIF
+      ENDDO
+!
+!
+!--- DOWNDRAFT CLOUDWORK FUNCTIONS
+!
+!
+      DO K = KM1, 1, -1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+            IF(DWNFLG2(I).AND.K.LT.JMIN(I)) THEN
+              GAMMA = EL2ORC * QESO(I,k+1) / TO(I,k+1)**2
+              DHH=HCDO(I)
+              DT=TO(I,k+1)
+              DG=GAMMA
+              DH=HESO(I,k+1)
+              DZ=-1.*(ZO(I,k+1)-ZO(I,k))
+              AA1(I)=AA1(I)+EDTO(I)*DZ*(G/(CP*DT))*((DHH-DH)/(1.+DG))   &
+     &               *(1.+DELTA*CP*DG*DT/HVAP)
+              val=0.
+              AA1(I)=AA1(I)+EDTO(I)*                                    & 
+!cmr &        DZ*G*DELTA*MAX( 0.,(QESO(I,k+1)-QO(I,k+1)))               &
+     &        DZ*G*DELTA*MAX(val,(QESO(I,k+1)-QO(I,k+1)))
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!cccc IF(LAT.EQ.LATD.AND.lon.eq.lond.and.DWNFLG2(I)) THEN
+!cccc   PRINT *, '  AA1(I) AFTER DWNDRFT =', AA1(I)
+!cccc ENDIF
+      DO I = 1, IM
+        IF(AA1(I).LE.0.) CNVFLG(I)  = .FALSE.
+        IF(AA1(I).LE.0.) DWNFLG(I)  = .FALSE.
+        IF(AA1(I).LE.0.) DWNFLG2(I) = .FALSE.
+      ENDDO
+!!
+      TOTFLG = .TRUE.
+      DO I = 1, IM
+        TOTFLG = TOTFLG .AND. (.NOT. CNVFLG(I))
+      ENDDO
+      IF(TOTFLG) RETURN
+!!
+!
+!
+!--- WHAT WOULD THE CHANGE BE, THAT A CLOUD WITH UNIT MASS
+!--- WILL DO TO THE ENVIRONMENT?
+!
+      DO K = 1, KM
+        DO I = 1, IM
+          IF(k .le. kmax(i) .and. CNVFLG(I)) THEN
+            DELLAH(I,k) = 0.
+            DELLAQ(I,k) = 0.
+            DELLAU(I,k) = 0.
+            DELLAV(I,k) = 0.
+          ENDIF
+        ENDDO
+      ENDDO
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+          DP = 1000. * DEL(I,1)
+          DELLAH(I,1) = EDTO(I) * ETAD(I,1) * (HCDO(I)                  &
+     &                - HEO(I,1)) * G / DP
+          DELLAQ(I,1) = EDTO(I) * ETAD(I,1) * (QCDO(I)                  &
+     &                - QO(I,1)) * G / DP
+          DELLAU(I,1) = EDTO(I) * ETAD(I,1) * (UCDO(I)                  &
+     &                - UO(I,1)) * G / DP
+          DELLAV(I,1) = EDTO(I) * ETAD(I,1) * (VCDO(I)                  &
+     &                - VO(I,1)) * G / DP
+        ENDIF
+      ENDDO
+!
+!--- CHANGED DUE TO SUBSIDENCE AND ENTRAINMENT
+!
+      DO K = 2, KM1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+            IF(CNVFLG(I).AND.K.LT.KTCON(I)) THEN
+              AUP = 1.
+              IF(K.LE.KB(I)) AUP = 0.
+              ADW = 1.
+              IF(K.GT.JMIN(I)) ADW = 0.
+              DV1= HEO(I,k)
+              DV2 = .5 * (HEO(I,k) + HEO(I,k+1))
+              DV3= HEO(I,k-1)
+              DV1Q= QO(I,k)
+              DV2Q = .5 * (QO(I,k) + QO(I,k+1))
+              DV3Q= QO(I,k-1)
+              DV1U= UO(I,k)
+              DV2U = .5 * (UO(I,k) + UO(I,k+1))
+              DV3U= UO(I,k-1)
+              DV1V= VO(I,k)
+              DV2V = .5 * (VO(I,k) + VO(I,k+1))
+              DV3V= VO(I,k-1)
+              DP = 1000. * DEL(I,K)
+              DZ = .5 * (ZO(I,k+1) - ZO(I,k-1))
+              DETA = ETA(I,k) - ETA(I,k-1)
+              DETAD = ETAD(I,k) - ETAD(I,k-1)
+              DELLAH(I,k) = DELLAH(I,k) +                               &
+     &            ((AUP * ETA(I,k) - ADW * EDTO(I) * ETAD(I,k)) * DV1   &
+     &        - (AUP * ETA(I,k-1) - ADW * EDTO(I) * ETAD(I,k-1))* DV3   &
+     &                    - AUP * DETA * DV2                            &
+     &                    + ADW * EDTO(I) * DETAD * HCDO(I)) * G / DP
+              DELLAQ(I,k) = DELLAQ(I,k) +                               &
+     &            ((AUP * ETA(I,k) - ADW * EDTO(I) * ETAD(I,k)) * DV1Q  &
+     &        - (AUP * ETA(I,k-1) - ADW * EDTO(I) * ETAD(I,k-1))* DV3Q  &
+     &                    - AUP * DETA * DV2Q                           &
+     &       +ADW*EDTO(I)*DETAD*.5*(QRCDO(I,k)+QRCDO(I,k-1))) * G / DP
+              DELLAU(I,k) = DELLAU(I,k) +                               &
+     &            ((AUP * ETA(I,k) - ADW * EDTO(I) * ETAD(I,k)) * DV1U  &
+     &        - (AUP * ETA(I,k-1) - ADW * EDTO(I) * ETAD(I,k-1))* DV3U  &
+     &                     - AUP * DETA * DV2U                          &
+     &                    + ADW * EDTO(I) * DETAD * UCDO(I)             & 
+     &                    ) * G / DP
+              DELLAV(I,k) = DELLAV(I,k) +                               &
+     &            ((AUP * ETA(I,k) - ADW * EDTO(I) * ETAD(I,k)) * DV1V  &
+     &        - (AUP * ETA(I,k-1) - ADW * EDTO(I) * ETAD(I,k-1))* DV3V  &
+     &                     - AUP * DETA * DV2V                          &
+     &                    + ADW * EDTO(I) * DETAD * VCDO(I)             &
+     &                    ) * G / DP
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!
+!------- CLOUD TOP
+!
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+          INDX = KTCON(I)
+          DP = 1000. * DEL(I,INDX)
+          DV1 = HEO(I,INDX-1)
+          DELLAH(I,INDX) = ETA(I,INDX-1) *                              &
+     &                     (HCKO(I,INDX-1) - DV1) * G / DP
+          DVQ1 = QO(I,INDX-1) 
+          DELLAQ(I,INDX) = ETA(I,INDX-1) *                              &
+     &                     (QCKO(I,INDX-1) - DVQ1) * G / DP
+          DV1U = UO(I,INDX-1)
+          DELLAU(I,INDX) = ETA(I,INDX-1) *                              &
+     &                     (UCKO(I,INDX-1) - DV1U) * G / DP
+          DV1V = VO(I,INDX-1)
+          DELLAV(I,INDX) = ETA(I,INDX-1) *                              &
+     &                     (VCKO(I,INDX-1) - DV1V) * G / DP
+!
+!  cloud water
+!
+          DELLAL(I) = ETA(I,INDX-1) * QLKO_KTCON(I) * g / dp
+        ENDIF
+      ENDDO
+!
+!------- FINAL CHANGED VARIABLE PER UNIT MASS FLUX
+!
+      DO K = 1, KM
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            IF(CNVFLG(I).and.k.gt.KTCON(I)) THEN
+              QO(I,k) = Q1(I,k)
+              TO(I,k) = T1(I,k)
+              UO(I,k) = U1(I,k)
+              VO(I,k) = V1(I,k)
+            ENDIF
+            IF(CNVFLG(I).AND.K.LE.KTCON(I)) THEN
+              QO(I,k) = DELLAQ(I,k) * MBDT + Q1(I,k)
+              DELLAT = (DELLAH(I,k) - HVAP * DELLAQ(I,k)) / CP
+              TO(I,k) = DELLAT * MBDT + T1(I,k)
+!cmr          QO(I,k) = max(QO(I,k),1.e-10)
+              val   =           1.e-10
+              QO(I,k) = max(QO(I,k), val  )
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!--- THE ABOVE CHANGED ENVIRONMENT IS NOW USED TO CALULATE THE
+!--- EFFECT THE ARBITRARY CLOUD (WITH UNIT MASS FLUX)
+!--- WOULD HAVE ON THE STABILITY,
+!--- WHICH THEN IS USED TO CALCULATE THE REAL MASS FLUX,
+!--- NECESSARY TO KEEP THIS CHANGE IN BALANCE WITH THE LARGE-SCALE
+!--- DESTABILIZATION.
+!
+!--- ENVIRONMENTAL CONDITIONS AGAIN, FIRST HEIGHTS
+!
+      DO K = 1, KM
+        DO I = 1, IM
+          IF(k .le. kmax(i) .and. CNVFLG(I)) THEN
+!jfe        QESO(I,k) = 10. * FPVS(TO(I,k))
+!
+            QESO(I,k) = 0.01 * fpvs(TO(I,K))      ! fpvs is in Pa
+!
+            QESO(I,k) = EPS * QESO(I,k) / (PFLD(I,k)+EPSM1*QESO(I,k))
+!cmr        QESO(I,k) = MAX(QESO(I,k),1.E-8)
+            val       =             1.E-8
+            QESO(I,k) = MAX(QESO(I,k), val )
+            TVO(I,k)  = TO(I,k) + DELTA * TO(I,k) * QO(I,k)
+          ENDIF
+        ENDDO
+      ENDDO
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+          XAA0(I) = 0.
+          XPWAV(I) = 0.
+        ENDIF
+      ENDDO
+!
+!  HYDROSTATIC HEIGHT ASSUME ZERO TERR
+!
+!     DO I = 1, IM
+!       IF(CNVFLG(I)) THEN
+!         DLNSIG =  LOG(PRSL(I,1)/PS(I))
+!         ZO(I,1) = TERR - DLNSIG * RD / G * TVO(I,1)
+!       ENDIF
+!     ENDDO
+!     DO K = 2, KM
+!       DO I = 1, IM
+!         IF(k .le. kmax(i) .and. CNVFLG(I)) THEN
+!           DLNSIG =  LOG(PRSL(I,K) / PRSL(I,K-1))
+!           ZO(I,k) = ZO(I,k-1) - DLNSIG * RD / G
+!    &             * .5 * (TVO(I,k) + TVO(I,k-1))
+!         ENDIF
+!       ENDDO
+!     ENDDO
+!
+!--- MOIST STATIC ENERGY
+!
+      DO K = 1, KM1
+        DO I = 1, IM
+          IF(k .le. kmax(i)-1 .and. CNVFLG(I)) THEN
+            DZ = .5 * (ZO(I,k+1) - ZO(I,k))
+            DP = .5 * (PFLD(I,k+1) - PFLD(I,k))
+!jfe        ES = 10. * FPVS(TO(I,k+1))
+!
+            ES = 0.01 * fpvs(TO(I,K+1))      ! fpvs is in Pa
+!
+            PPRIME = PFLD(I,k+1) + EPSM1 * ES
+            QS = EPS * ES / PPRIME
+            DQSDP = - QS / PPRIME
+            DESDT = ES * (FACT1 / TO(I,k+1) + FACT2 / (TO(I,k+1)**2))
+            DQSDT = QS * PFLD(I,k+1) * DESDT / (ES * PPRIME)
+            GAMMA = EL2ORC * QESO(I,k+1) / (TO(I,k+1)**2)
+            DT = (G * DZ + HVAP * DQSDP * DP) / (CP * (1. + GAMMA))
+            DQ = DQSDT * DT + DQSDP * DP
+            TO(I,k) = TO(I,k+1) + DT
+            QO(I,k) = QO(I,k+1) + DQ
+            PO(I,k) = .5 * (PFLD(I,k) + PFLD(I,k+1))
+          ENDIF
+        ENDDO
+      ENDDO
+      DO K = 1, KM1
+        DO I = 1, IM
+          IF(k .le. kmax(i)-1 .and. CNVFLG(I)) THEN
+!jfe        QESO(I,k) = 10. * FPVS(TO(I,k))
+!
+            QESO(I,k) = 0.01 * fpvs(TO(I,K))      ! fpvs is in Pa
+!
+            QESO(I,k) = EPS * QESO(I,k) / (PO(I,k) + EPSM1 * QESO(I,k))
+!cmr        QESO(I,k) = MAX(QESO(I,k),1.E-8)
+            val1      =             1.E-8
+            QESO(I,k) = MAX(QESO(I,k), val1)
+!cmr        QO(I,k)   = max(QO(I,k),1.e-10)
+            val2      =           1.e-10
+            QO(I,k)   = max(QO(I,k), val2 )
+!           QO(I,k)   = MIN(QO(I,k),QESO(I,k))
+            HEO(I,k)   = .5 * G * (ZO(I,k) + ZO(I,k+1)) +               &
+     &                    CP * TO(I,k) + HVAP * QO(I,k)
+            HESO(I,k) = .5 * G * (ZO(I,k) + ZO(I,k+1)) +                &
+     &                  CP * TO(I,k) + HVAP * QESO(I,k)
+          ENDIF
+        ENDDO
+      ENDDO
+      DO I = 1, IM
+        k = kmax(i)
+        IF(CNVFLG(I)) THEN
+          HEO(I,k) = G * ZO(I,k) + CP * TO(I,k) + HVAP * QO(I,k)
+          HESO(I,k) = G * ZO(I,k) + CP * TO(I,k) + HVAP * QESO(I,k)
+!         HEO(I,k) = MIN(HEO(I,k),HESO(I,k))
+        ENDIF
+      ENDDO
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+          INDX = KB(I)
+          XHKB(I) = HEO(I,INDX)
+          XQKB(I) = QO(I,INDX)
+          HCKO(I,INDX) = XHKB(I)
+          QCKO(I,INDX) = XQKB(I)
+        ENDIF
+      ENDDO
+!
+!
+!**************************** STATIC CONTROL
+!
+!
+!------- MOISTURE AND CLOUD WORK FUNCTIONS
+!
+      DO K = 2, KM1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+!           IF(CNVFLG(I).AND.K.GT.KB(I).AND.K.LE.KBCON(I)) THEN
+            IF(CNVFLG(I).AND.K.GT.KB(I).AND.K.LE.KTCON(I)) THEN
+              FACTOR = ETA(I,k-1) / ETA(I,k)
+              ONEMF = 1. - FACTOR
+              HCKO(I,k) = FACTOR * HCKO(I,k-1) + ONEMF *                &
+     &                    .5 * (HEO(I,k) + HEO(I,k+1))
+            ENDIF
+!           IF(CNVFLG(I).AND.K.GT.KBCON(I)) THEN
+!             HEO(I,k) = HEO(I,k-1)
+!           ENDIF
+          endif
+        ENDDO
+      ENDDO
+      DO K = 2, KM1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+            IF(CNVFLG(I).AND.K.GT.KB(I).AND.K.LT.KTCON(I)) THEN
+              DZ = .5 * (ZO(I,k+1) - ZO(I,k-1))
+              GAMMA = EL2ORC * QESO(I,k) / (TO(I,k)**2)
+              XDBY = HCKO(I,k) - HESO(I,k)
+!cmr          XDBY = MAX(XDBY,0.)
+              val  =          0.
+              XDBY = MAX(XDBY,val)
+              XQRCH = QESO(I,k)                                         &
+     &              + GAMMA * XDBY / (HVAP * (1. + GAMMA))
+              FACTOR = ETA(I,k-1) / ETA(I,k)
+              ONEMF = 1. - FACTOR
+              QCKO(I,k) = FACTOR * QCKO(I,k-1) + ONEMF *                &
+     &                    .5 * (QO(I,k) + QO(I,k+1))
+              DQ = ETA(I,k) * QCKO(I,k) - ETA(I,k) * XQRCH
+              IF(DQ.GT.0.) THEN
+                ETAH = .5 * (ETA(I,k) + ETA(I,k-1))
+                QLK = DQ / (ETA(I,k) + ETAH * C0 * DZ)
+                XAA0(I) = XAA0(I) - (ZO(I,k) - ZO(I,k-1)) * G * QLK
+                XQC = QLK + XQRCH
+                XPW = ETAH * C0 * DZ * QLK
+                QCKO(I,k) = XQC
+                XPWAV(I) = XPWAV(I) + XPW
+              ENDIF
+            ENDIF
+!           IF(CNVFLG(I).AND.K.GT.KBCON(I).AND.K.LT.KTCON(I)) THEN
+            IF(CNVFLG(I).AND.K.GT.KBCON(I).AND.K.LE.KTCON(I)) THEN
+              DZ1 = ZO(I,k) - ZO(I,k-1)
+              GAMMA = EL2ORC * QESO(I,k-1) / (TO(I,k-1)**2)
+              RFACT =  1. + DELTA * CP * GAMMA                          &
+     &                 * TO(I,k-1) / HVAP
+              XDBY = HCKO(I,k-1) - HESO(I,k-1)
+              XAA0(I) = XAA0(I)                                         & 
+     &                + DZ1 * (G / (CP * TO(I,k-1)))                    &
+     &                * XDBY / (1. + GAMMA)                             &
+     &                * RFACT
+              val=0.
+              XAA0(I)=XAA0(I)+                                          &
+     &                 DZ1 * G * DELTA *                                &
+!cmr &                 MAX( 0.,(QESO(I,k-1) - QO(I,k-1)))               & 
+     &                 MAX(val,(QESO(I,k-1) - QO(I,k-1)))
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!cccc IF(LAT.EQ.LATD.AND.lon.eq.lond.and.CNVFLG(I)) THEN
+!cccc   PRINT *, ' XAA BEFORE DWNDRFT =', XAA0(I)
+!cccc ENDIF
+!
+!------- DOWNDRAFT CALCULATIONS
+!
+!
+!--- DOWNDRAFT MOISTURE PROPERTIES
+!
+      DO I = 1, IM
+        XPWEV(I) = 0.
+      ENDDO
+      DO I = 1, IM
+        IF(DWNFLG2(I)) THEN
+          JMN = JMIN(I)
+          XHCD(I) = HEO(I,JMN)
+          XQCD(I) = QO(I,JMN)
+          QRCD(I,JMN) = QESO(I,JMN)
+        ENDIF
+      ENDDO
+      DO K = KM1, 1, -1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+            IF(DWNFLG2(I).AND.K.LT.JMIN(I)) THEN
+              DQ = QESO(I,k)
+              DT = TO(I,k)
+              GAMMA    = EL2ORC * DQ / DT**2
+              DH       = XHCD(I) - HESO(I,k)
+              QRCD(I,k)=DQ+(1./HVAP)*(GAMMA/(1.+GAMMA))*DH
+              DETAD    = ETAD(I,k+1) - ETAD(I,k)
+              XPWD     = ETAD(I,k+1) * QRCD(I,k+1) -                    &
+     &                   ETAD(I,k) * QRCD(I,k)
+              XPWD     = XPWD - DETAD *                                 & 
+     &                 .5 * (QRCD(I,k) + QRCD(I,k+1))
+              XPWEV(I) = XPWEV(I) + XPWD
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!
+      DO I = 1, IM
+        edtmax = edtmaxl
+        if(SLIMSK(I).eq.0.) edtmax = edtmaxs
+        IF(DWNFLG2(I)) THEN
+          IF(XPWEV(I).GE.0.) THEN
+            EDTX(I) = 0.
+          ELSE
+            EDTX(I) = -EDTX(I) * XPWAV(I) / XPWEV(I)
+            EDTX(I) = MIN(EDTX(I),EDTMAX)
+          ENDIF
+        ELSE
+          EDTX(I) = 0.
+        ENDIF
+      ENDDO
+!
+!
+!
+!--- DOWNDRAFT CLOUDWORK FUNCTIONS
+!
+!
+      DO K = KM1, 1, -1
+        DO I = 1, IM
+          if (k .le. kmax(i)-1) then
+            IF(DWNFLG2(I).AND.K.LT.JMIN(I)) THEN
+              GAMMA = EL2ORC * QESO(I,k+1) / TO(I,k+1)**2
+              DHH=XHCD(I)
+              DT= TO(I,k+1)
+              DG= GAMMA
+              DH= HESO(I,k+1)
+              DZ=-1.*(ZO(I,k+1)-ZO(I,k))
+              XAA0(I)=XAA0(I)+EDTX(I)*DZ*(G/(CP*DT))*((DHH-DH)/(1.+DG)) &
+     &                *(1.+DELTA*CP*DG*DT/HVAP)
+              val=0.
+              XAA0(I)=XAA0(I)+EDTX(I)*                                  &
+!cmr &        DZ*G*DELTA*MAX( 0.,(QESO(I,k+1)-QO(I,k+1)))               &
+     &        DZ*G*DELTA*MAX(val,(QESO(I,k+1)-QO(I,k+1)))
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!cccc IF(LAT.EQ.LATD.AND.lon.eq.lond.and.DWNFLG2(I)) THEN
+!cccc   PRINT *, '  XAA AFTER DWNDRFT =', XAA0(I)
+!cccc ENDIF
+!
+!  CALCULATE CRITICAL CLOUD WORK FUNCTION
+!
+      DO I = 1, IM
+        ACRT(I) = 0.
+        IF(CNVFLG(I)) THEN
+!       IF(CNVFLG(I).AND.SLIMSK(I).NE.1.) THEN
+          IF(PFLD(I,KTCON(I)).LT.PCRIT(15))THEN
+            ACRT(I)=ACRIT(15)*(975.-PFLD(I,KTCON(I)))                   &    
+     &              /(975.-PCRIT(15))
+          ELSE IF(PFLD(I,KTCON(I)).GT.PCRIT(1))THEN
+            ACRT(I)=ACRIT(1)
+          ELSE
+!cmr        K = IFIX((850. - PFLD(I,KTCON(I)))/50.) + 2
+            K =  int((850. - PFLD(I,KTCON(I)))/50.) + 2
+            K = MIN(K,15)
+            K = MAX(K,2)
+            ACRT(I)=ACRIT(K)+(ACRIT(K-1)-ACRIT(K))*                     &
+     &           (PFLD(I,KTCON(I))-PCRIT(K))/(PCRIT(K-1)-PCRIT(K))
+           ENDIF
+!        ELSE
+!          ACRT(I) = .5 * (PFLD(I,KBCON(I)) - PFLD(I,KTCON(I)))
+         ENDIF
+      ENDDO
+      DO I = 1, IM
+        ACRTFCT(I) = 1.
+        IF(CNVFLG(I)) THEN
+          if(SLIMSK(I).eq.1.) THEN
+            w1 = w1l
+            w2 = w2l
+            w3 = w3l
+            w4 = w4l
+          else
+            w1 = w1s
+            w2 = w2s
+            w3 = w3s
+            w4 = w4s
+          ENDIF
+!C       IF(CNVFLG(I).AND.SLIMSK(I).EQ.1.) THEN
+!         ACRTFCT(I) = PDOT(I) / W3
+!
+!  modify critical cloud workfunction by cloud base vertical velocity
+!
+          IF(PDOT(I).LE.W4) THEN
+            ACRTFCT(I) = (PDOT(I) - W4) / (W3 - W4)
+          ELSEIF(PDOT(I).GE.-W4) THEN
+            ACRTFCT(I) = - (PDOT(I) + W4) / (W4 - W3)
+          ELSE
+            ACRTFCT(I) = 0.
+          ENDIF
+!cmr      ACRTFCT(I) = MAX(ACRTFCT(I),-1.)
+          val1    =             -1.
+          ACRTFCT(I) = MAX(ACRTFCT(I),val1)
+!cmr      ACRTFCT(I) = MIN(ACRTFCT(I),1.)
+          val2    =             1.
+          ACRTFCT(I) = MIN(ACRTFCT(I),val2)
+          ACRTFCT(I) = 1. - ACRTFCT(I)
+!
+!  modify ACRTFCT(I) by colume mean rh if RHBAR(I) is greater than 80 percent
+!
+!         if(RHBAR(I).ge..8) THEN
+!           ACRTFCT(I) = ACRTFCT(I) * (.9 - min(RHBAR(I),.9)) * 10.
+!         ENDIF
+!
+!  modify adjustment time scale by cloud base vertical velocity
+!
+          DTCONV(I) = DT2 + max((1800. - DT2),RZERO) *                  &
+     &                (PDOT(I) - W2) / (W1 - W2)
+!         DTCONV(I) = MAX(DTCONV(I), DT2)
+!         DTCONV(I) = 1800. * (PDOT(I) - w2) / (w1 - w2)
+          DTCONV(I) = max(DTCONV(I),dtmin)
+          DTCONV(I) = min(DTCONV(I),dtmax)
+
+        ENDIF
+      ENDDO
+!
+!--- LARGE SCALE FORCING
+!
+      DO I= 1, IM
+        FLG(I) = CNVFLG(I)
+        IF(CNVFLG(I)) THEN
+!         F = AA1(I) / DTCONV(I)
+          FLD(I) = (AA1(I) - ACRT(I) * ACRTFCT(I)) / DTCONV(I)
+          IF(FLD(I).LE.0.) FLG(I) = .FALSE.
+        ENDIF
+        CNVFLG(I) = FLG(I)
+        IF(CNVFLG(I)) THEN
+!         XAA0(I) = MAX(XAA0(I),0.)
+          XK(I) = (XAA0(I) - AA1(I)) / MBDT
+          IF(XK(I).GE.0.) FLG(I) = .FALSE.
+        ENDIF
+!
+!--- KERNEL, CLOUD BASE MASS FLUX
+!
+        CNVFLG(I) = FLG(I)
+        IF(CNVFLG(I)) THEN
+          XMB(I) = -FLD(I) / XK(I)
+          XMB(I) = MIN(XMB(I),XMBMAX(I))
+        ENDIF
+      ENDDO
+!      IF(LAT.EQ.LATD.AND.lon.eq.lond.and.CNVFLG(I)) THEN
+!        print *, ' RHBAR(I), ACRTFCT(I) =', RHBAR(I), ACRTFCT(I)
+!        PRINT *, '  A1, XA =', AA1(I), XAA0(I)
+!        PRINT *, ' XMB(I), ACRT =', XMB(I), ACRT
+!      ENDIF
+      TOTFLG = .TRUE.
+      DO I = 1, IM
+        TOTFLG = TOTFLG .AND. (.NOT. CNVFLG(I))
+      ENDDO
+      IF(TOTFLG) RETURN
+!
+!  restore t0 and QO to t1 and q1 in case convection stops
+!
+      do k = 1, km
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            TO(I,k) = T1(I,k)
+            QO(I,k) = Q1(I,k)
+!jfe        QESO(I,k) = 10. * FPVS(T1(I,k))
+!
+            QESO(I,k) = 0.01 * fpvs(T1(I,K))      ! fpvs is in Pa
+!
+            QESO(I,k) = EPS * QESO(I,k) / (PFLD(I,k) + EPSM1*QESO(I,k))
+!cmr        QESO(I,k) = MAX(QESO(I,k),1.E-8)
+            val     =             1.E-8
+            QESO(I,k) = MAX(QESO(I,k), val )
+          endif
+        enddo
+      enddo
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!--- FEEDBACK: SIMPLY THE CHANGES FROM THE CLOUD WITH UNIT MASS FLUX
+!---           MULTIPLIED BY  THE MASS FLUX NECESSARY TO KEEP THE
+!---           EQUILIBRIUM WITH THE LARGER-SCALE.
+!
+      DO I = 1, IM
+        DELHBAR(I) = 0.
+        DELQBAR(I) = 0.
+        DELTBAR(I) = 0.
+        QCOND(I) = 0.
+      ENDDO
+      DO K = 1, KM
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            IF(CNVFLG(I).AND.K.LE.KTCON(I)) THEN
+              AUP = 1.
+              IF(K.Le.KB(I)) AUP = 0.
+              ADW = 1.
+              IF(K.GT.JMIN(I)) ADW = 0.
+              DELLAT = (DELLAH(I,k) - HVAP * DELLAQ(I,k)) / CP
+              T1(I,k) = T1(I,k) + DELLAT * XMB(I) * DT2
+              Q1(I,k) = Q1(I,k) + DELLAQ(I,k) * XMB(I) * DT2
+              U1(I,k) = U1(I,k) + DELLAU(I,k) * XMB(I) * DT2
+              V1(I,k) = V1(I,k) + DELLAV(I,k) * XMB(I) * DT2
+              DP = 1000. * DEL(I,K)
+              DELHBAR(I) = DELHBAR(I) + DELLAH(I,k)*XMB(I)*DP/G
+              DELQBAR(I) = DELQBAR(I) + DELLAQ(I,k)*XMB(I)*DP/G
+              DELTBAR(I) = DELTBAR(I) + DELLAT*XMB(I)*DP/G
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+      DO K = 1, KM
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            IF(CNVFLG(I).AND.K.LE.KTCON(I)) THEN
+!jfe          QESO(I,k) = 10. * FPVS(T1(I,k))
+!
+              QESO(I,k) = 0.01 * fpvs(T1(I,K))      ! fpvs is in Pa
+!
+              QESO(I,k) = EPS * QESO(I,k)/(PFLD(I,k) + EPSM1*QESO(I,k))
+!cmr          QESO(I,k) = MAX(QESO(I,k),1.E-8)
+              val     =             1.E-8
+              QESO(I,k) = MAX(QESO(I,k), val )
+!
+!  cloud water
+!
+              if(ncloud.gt.0.and.CNVFLG(I).and.k.eq.KTCON(I)) THEN
+                tem  = DELLAL(I) * XMB(I) * dt2
+                tem1 = MAX(RZERO, MIN(RONE, (TCR-t1(I,K))*TCRF))
+                if (QL(I,k,2) .gt. -999.0) then
+                  QL(I,k,1) = QL(I,k,1) + tem * tem1            ! Ice
+                  QL(I,k,2) = QL(I,k,2) + tem *(1.0-tem1)       ! Water
+                else
+                  tem2      = QL(I,k,1) + tem
+                  QL(I,k,1) = tem2 * tem1                       ! Ice
+                  QL(I,k,2) = tem2 - QL(I,k,1)                  ! Water
+                endif
+!               QL(I,k) = QL(I,k) + DELLAL(I) * XMB(I) * dt2
+                dp = 1000. * del(i,k)
+                DELLAL(I) = DELLAL(I) * XMB(I) * dp / g
+              ENDIF
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!     IF(LAT.EQ.LATD.AND.lon.eq.lond.and.CNVFLG(I) ) THEN
+!       PRINT *, ' DELHBAR, DELQBAR, DELTBAR ='
+!       PRINT *, DELHBAR, HVAP*DELQBAR, CP*DELTBAR
+!       PRINT *, '   DELLBAR ='
+!       PRINT 6003,  HVAP*DELLbar
+!       PRINT *, '   DELLAQ ='
+!       PRINT 6003, (HVAP*DELLAQ(I,k)*XMB(I),K=1,KMAX)
+!       PRINT *, '   DELLAT ='
+!       PRINT 6003, (DELLAH(i,k)*XMB(I)-HVAP*DELLAQ(I,k)*XMB(I),         &
+!    &               K=1,KMAX)
+!     ENDIF
+      DO I = 1, IM
+        RNTOT(I) = 0.
+        DELQEV(I) = 0.
+        DELQ2(I) = 0.
+        FLG(I) = CNVFLG(I)
+      ENDDO
+      DO K = KM, 1, -1
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            IF(CNVFLG(I).AND.K.LE.KTCON(I)) THEN
+              AUP = 1.
+              IF(K.Le.KB(I)) AUP = 0.
+              ADW = 1.
+              IF(K.GT.JMIN(I)) ADW = 0.
+              rain =  AUP * PWO(I,k) + ADW * EDTO(I) * PWDO(I,k)
+              RNTOT(I) = RNTOT(I) + rain * XMB(I) * .001 * dt2
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+      DO K = KM, 1, -1
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            DELTV(I) = 0.
+            DELQ(I) = 0.
+            QEVAP(I) = 0.
+            IF(CNVFLG(I).AND.K.LE.KTCON(I)) THEN
+              AUP = 1.
+              IF(K.Le.KB(I)) AUP = 0.
+              ADW = 1.
+              IF(K.GT.JMIN(I)) ADW = 0.
+              rain =  AUP * PWO(I,k) + ADW * EDTO(I) * PWDO(I,k)
+              RN(I) = RN(I) + rain * XMB(I) * .001 * dt2
+            ENDIF
+            IF(FLG(I).AND.K.LE.KTCON(I)) THEN
+              evef = EDT(I) * evfact
+              if(SLIMSK(I).eq.1.) evef=EDT(I) * evfactl
+!             if(SLIMSK(I).eq.1.) evef=.07
+!             if(SLIMSK(I).ne.1.) evef = 0.
+              QCOND(I) = EVEF * (Q1(I,k) - QESO(I,k))                   &
+     &                 / (1. + EL2ORC * QESO(I,k) / T1(I,k)**2)
+              DP = 1000. * DEL(I,K)
+              IF(RN(I).GT.0..AND.QCOND(I).LT.0.) THEN
+                QEVAP(I) = -QCOND(I) * (1.-EXP(-.32*SQRT(DT2*RN(I))))
+                QEVAP(I) = MIN(QEVAP(I), RN(I)*1000.*G/DP)
+                DELQ2(I) = DELQEV(I) + .001 * QEVAP(I) * dp / g
+              ENDIF
+              if(RN(I).gt.0..and.QCOND(I).LT.0..and.                    &
+     &           DELQ2(I).gt.RNTOT(I)) THEN
+                QEVAP(I) = 1000.* g * (RNTOT(I) - DELQEV(I)) / dp
+                FLG(I) = .false.
+              ENDIF
+              IF(RN(I).GT.0..AND.QEVAP(I).gt.0.) THEN
+                Q1(I,k) = Q1(I,k) + QEVAP(I)
+                T1(I,k) = T1(I,k) - ELOCP * QEVAP(I)
+                RN(I) = RN(I) - .001 * QEVAP(I) * DP / G
+                DELTV(I) = - ELOCP*QEVAP(I)/DT2
+                DELQ(I) =  + QEVAP(I)/DT2
+                DELQEV(I) = DELQEV(I) + .001*dp*QEVAP(I)/g
+              ENDIF
+              DELLAQ(I,k) = DELLAQ(I,k) + DELQ(I) / XMB(I)
+              DELQBAR(I) = DELQBAR(I) + DELQ(I)*DP/G
+              DELTBAR(I) = DELTBAR(I) + DELTV(I)*DP/G
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!      IF(LAT.EQ.LATD.AND.lon.eq.lond.and.CNVFLG(I) ) THEN
+!        PRINT *, '   DELLAH ='
+!        PRINT 6003, (DELLAH(k)*XMB(I),K=1,KMAX)
+!        PRINT *, '   DELLAQ ='
+!        PRINT 6003, (HVAP*DELLAQ(I,k)*XMB(I),K=1,KMAX)
+!        PRINT *, ' DELHBAR, DELQBAR, DELTBAR ='
+!        PRINT *, DELHBAR, HVAP*DELQBAR, CP*DELTBAR
+!        PRINT *, ' PRECIP =', HVAP*RN(I)*1000./DT2
+!CCCC   PRINT *, '   DELLBAR ='
+!CCCC   PRINT *,  HVAP*DELLbar
+!      ENDIF
+!
+!  PRECIPITATION RATE CONVERTED TO ACTUAL PRECIP
+!  IN UNIT OF M INSTEAD OF KG
+!
+      DO I = 1, IM
+        IF(CNVFLG(I)) THEN
+!
+!  IN THE EVENT OF UPPER LEVEL RAIN EVAPORATION AND LOWER LEVEL DOWNDRAF
+!    MOISTENING, RN CAN BECOME NEGATIVE, IN THIS CASE, WE BACK OUT OF TH
+!    HEATING AND THE MOISTENING
+!
+          if(RN(I).lt.0..and..not.FLG(I)) RN(I) = 0.
+          IF(RN(I).LE.0.) THEN
+            RN(I) = 0.
+          ELSE
+            KTOP(I) = KTCON(I)
+            KBOT(I) = KBCON(I)
+            KUO(I) = 1
+            CLDWRK(I) = AA1(I)
+          ENDIF
+        ENDIF
+      ENDDO
+      DO K = 1, KM
+        DO I = 1, IM
+          if (k .le. kmax(i)) then
+            IF(CNVFLG(I).AND.RN(I).LE.0.) THEN
+              T1(I,k) = TO(I,k)
+              Q1(I,k) = QO(I,k)
+            ENDIF
+          endif
+        ENDDO
+      ENDDO
+!!
+      RETURN
+   END SUBROUTINE SASCNV
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      SUBROUTINE SHALCV(IM,IX,KM,DT,DEL,PRSI,PRSL,PRSLK,KUO,Q,T,DPSHC)
+!
+      USE MODULE_GFS_MACHINE , ONLY : kind_phys
+      USE MODULE_GFS_PHYSCONS, grav => con_g, CP => con_CP, HVAP => con_HVAP &
+     &,             RD => con_RD
+
+      implicit none
+!
+!     include 'constant.h'
+!
+      integer              IM, IX, KM, KUO(IM)
+      real(kind=kind_phys) DEL(IX,KM),   PRSI(IX,KM+1), PRSL(IX,KM),    &
+     &                     PRSLK(IX,KM),                                &
+     &                     Q(IX,KM),     T(IX,KM),      DT, DPSHC
+!
+!     Locals
+!
+      real(kind=kind_phys) ck,    cpdt,   dmse,   dsdz1, dsdz2,         &
+     &                     dsig,  dtodsl, dtodsu, eldq,  g,             &
+     &                     gocp,  rtdls
+!
+      integer              k,k1,k2,kliftl,kliftu,kt,N2,I,iku,ik1,ik,ii
+      integer              INDEX2(IM), KLCL(IM), KBOT(IM), KTOP(IM),kk  &
+     &,                    KTOPM(IM)
+!!
+!  PHYSICAL PARAMETERS
+      PARAMETER(G=GRAV, GOCP=G/CP)
+!  BOUNDS OF PARCEL ORIGIN
+      PARAMETER(KLIFTL=2,KLIFTU=2)
+      LOGICAL   LSHC(IM)
+      real(kind=kind_phys) Q2(IM*KM),     T2(IM*KM),                    &
+     &                     PRSL2(IM*KM),  PRSLK2(IM*KM),                &
+     &                     AL(IM*(KM-1)), AD(IM*KM), AU(IM*(KM-1))
+!-----------------------------------------------------------------------
+!  COMPRESS FIELDS TO POINTS WITH NO DEEP CONVECTION
+!  AND MOIST STATIC INSTABILITY.
+      DO I=1,IM
+        LSHC(I)=.FALSE.
+      ENDDO
+      DO K=1,KM-1
+        DO I=1,IM
+          IF(KUO(I).EQ.0) THEN
+            ELDQ    = HVAP*(Q(I,K)-Q(I,K+1))
+            CPDT    = CP*(T(I,K)-T(I,K+1))
+            RTDLS   = (PRSL(I,K)-PRSL(I,K+1)) /                         &
+     &                 PRSI(I,K+1)*RD*0.5*(T(I,K)+T(I,K+1))
+            DMSE    = ELDQ+CPDT-RTDLS
+            LSHC(I) = LSHC(I).OR.DMSE.GT.0.
+          ENDIF
+        ENDDO
+      ENDDO
+      N2 = 0
+      DO I=1,IM
+        IF(LSHC(I)) THEN
+          N2         = N2 + 1
+          INDEX2(N2) = I
+        ENDIF
+      ENDDO
+      IF(N2.EQ.0) RETURN
+      DO K=1,KM
+        KK = (K-1)*N2
+        DO I=1,N2
+          IK         = KK + I
+          ii         = index2(i)
+          Q2(IK)     = Q(II,K)
+          T2(IK)     = T(II,K)
+          PRSL2(IK)  = PRSL(II,K)
+          PRSLK2(IK) = PRSLK(II,K)
+        ENDDO
+      ENDDO
+      do i=1,N2
+        ktopm(i) = KM
+      enddo
+      do k=2,KM
+        do i=1,N2
+          ii = index2(i)
+          if (prsi(ii,1)-prsi(ii,k) .le. dpshc) ktopm(i) = k
+        enddo
+      enddo
+
+!-----------------------------------------------------------------------
+!  COMPUTE MOIST ADIABAT AND DETERMINE LIMITS OF SHALLOW CONVECTION.
+!  CHECK FOR MOIST STATIC INSTABILITY AGAIN WITHIN CLOUD.
+      CALL MSTADBT3(N2,KM-1,KLIFTL,KLIFTU,PRSL2,PRSLK2,T2,Q2,           &
+     &            KLCL,KBOT,KTOP,AL,AU)
+      DO I=1,N2
+        KBOT(I) = min(KLCL(I)-1, ktopm(i)-1)
+        KTOP(I) = min(KTOP(I)+1, ktopm(i))
+        LSHC(I) = .FALSE.
+      ENDDO
+      DO K=1,KM-1
+        KK = (K-1)*N2
+        DO I=1,N2
+          IF(K.GE.KBOT(I).AND.K.LT.KTOP(I)) THEN
+            IK      = KK + I
+            IKU     = IK + N2
+            ELDQ    = HVAP * (Q2(IK)-Q2(IKU))
+            CPDT    = CP   * (T2(IK)-T2(IKU))
+            RTDLS   = (PRSL2(IK)-PRSL2(IKU)) /                          &
+     &                 PRSI(index2(i),K+1)*RD*0.5*(T2(IK)+T2(IKU))
+            DMSE    = ELDQ + CPDT - RTDLS
+            LSHC(I) = LSHC(I).OR.DMSE.GT.0.
+            AU(IK)  = G/RTDLS
+          ENDIF
+        ENDDO
+      ENDDO
+      K1=KM+1
+      K2=0
+      DO I=1,N2
+        IF(.NOT.LSHC(I)) THEN
+          KBOT(I) = KM+1
+          KTOP(I) = 0
+        ENDIF
+        K1 = MIN(K1,KBOT(I))
+        K2 = MAX(K2,KTOP(I))
+      ENDDO
+      KT = K2-K1+1
+      IF(KT.LT.2) RETURN
+!-----------------------------------------------------------------------
+!  SET EDDY VISCOSITY COEFFICIENT CKU AT SIGMA INTERFACES.
+!  COMPUTE DIAGONALS AND RHS FOR TRIDIAGONAL MATRIX SOLVER.
+!  EXPAND FINAL FIELDS.
+      KK = (K1-1) * N2
+      DO I=1,N2
+        IK     = KK + I
+        AD(IK) = 1.
+      ENDDO
+!
+!     DTODSU=DT/DEL(K1)
+      DO K=K1,K2-1
+!       DTODSL=DTODSU
+!       DTODSU=   DT/DEL(K+1)
+!       DSIG=SL(K)-SL(K+1)
+        KK = (K-1) * N2
+        DO I=1,N2
+          ii     = index2(i)
+          DTODSL = DT/DEL(II,K)
+          DTODSU = DT/DEL(II,K+1)
+          DSIG   = PRSL(II,K) - PRSL(II,K+1)
+          IK     = KK + I
+          IKU    = IK + N2
+          IF(K.EQ.KBOT(I)) THEN
+            CK=1.5
+          ELSEIF(K.EQ.KTOP(I)-1) THEN
+            CK=1.
+          ELSEIF(K.EQ.KTOP(I)-2) THEN
+            CK=3.
+          ELSEIF(K.GT.KBOT(I).AND.K.LT.KTOP(I)-2) THEN
+            CK=5.
+          ELSE
+            CK=0.
+          ENDIF
+          DSDZ1   = CK*DSIG*AU(IK)*GOCP
+          DSDZ2   = CK*DSIG*AU(IK)*AU(IK)
+          AU(IK)  = -DTODSL*DSDZ2
+          AL(IK)  = -DTODSU*DSDZ2
+          AD(IK)  = AD(IK)-AU(IK)
+          AD(IKU) = 1.-AL(IK)
+          T2(IK)  = T2(IK)+DTODSL*DSDZ1
+          T2(IKU) = T2(IKU)-DTODSU*DSDZ1
+        ENDDO
+      ENDDO
+      IK1=(K1-1)*N2+1
+      CALL TRIDI2T3(N2,KT,AL(IK1),AD(IK1),AU(IK1),Q2(IK1),T2(IK1),      &
+     &                                  AU(IK1),Q2(IK1),T2(IK1))
+      DO K=K1,K2
+        KK = (K-1)*N2
+        DO I=1,N2
+          IK = KK + I
+          Q(INDEX2(I),K) = Q2(IK)
+          T(INDEX2(I),K) = T2(IK)
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      RETURN
+      END SUBROUTINE SHALCV
+!-----------------------------------------------------------------------
+      SUBROUTINE TRIDI2T3(L,N,CL,CM,CU,R1,R2,AU,A1,A2)
+!yt      INCLUDE DBTRIDI2;
+!!
+      USE MODULE_GFS_MACHINE , ONLY : kind_phys
+      implicit none
+      integer             k,n,l,i
+      real(kind=kind_phys) fk
+!!
+      real(kind=kind_phys)                                              &
+     &          CL(L,2:N),CM(L,N),CU(L,N-1),R1(L,N),R2(L,N),            &
+     &          AU(L,N-1),A1(L,N),A2(L,N)
+!-----------------------------------------------------------------------
+      DO I=1,L
+        FK=1./CM(I,1)
+        AU(I,1)=FK*CU(I,1)
+        A1(I,1)=FK*R1(I,1)
+        A2(I,1)=FK*R2(I,1)
+      ENDDO
+      DO K=2,N-1
+        DO I=1,L
+          FK=1./(CM(I,K)-CL(I,K)*AU(I,K-1))
+          AU(I,K)=FK*CU(I,K)
+          A1(I,K)=FK*(R1(I,K)-CL(I,K)*A1(I,K-1))
+          A2(I,K)=FK*(R2(I,K)-CL(I,K)*A2(I,K-1))
+        ENDDO
+      ENDDO
+      DO I=1,L
+        FK=1./(CM(I,N)-CL(I,N)*AU(I,N-1))
+        A1(I,N)=FK*(R1(I,N)-CL(I,N)*A1(I,N-1))
+        A2(I,N)=FK*(R2(I,N)-CL(I,N)*A2(I,N-1))
+      ENDDO
+      DO K=N-1,1,-1
+        DO I=1,L
+          A1(I,K)=A1(I,K)-AU(I,K)*A1(I,K+1)
+          A2(I,K)=A2(I,K)-AU(I,K)*A2(I,K+1)
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      RETURN
+      END SUBROUTINE TRIDI2T3
+!-----------------------------------------------------------------------
+
+      SUBROUTINE MSTADBT3(IM,KM,K1,K2,PRSL,PRSLK,TENV,QENV,             &
+     &                  KLCL,KBOT,KTOP,TCLD,QCLD)
+!yt      INCLUDE DBMSTADB;
+!!
+      USE MODULE_GFS_MACHINE, ONLY : kind_phys
+      USE MODULE_GFS_FUNCPHYS, ONLY : FTDP, FTHE, FTLCL, STMA
+      USE MODULE_GFS_PHYSCONS, EPS => con_eps, EPSM1 => con_epsm1, FV => con_FVirt
+
+      implicit none
+!!
+!     include 'constant.h'
+!!
+      integer              k,k1,k2,km,i,im
+      real(kind=kind_phys) pv,qma,slklcl,tdpd,thelcl,tlcl
+      real(kind=kind_phys) tma,tvcld,tvenv
+!!
+      real(kind=kind_phys) PRSL(IM,KM), PRSLK(IM,KM), TENV(IM,KM),      &
+     &                     QENV(IM,KM), TCLD(IM,KM),  QCLD(IM,KM)
+      INTEGER              KLCL(IM),    KBOT(IM),      KTOP(IM)
+!  LOCAL ARRAYS
+      real(kind=kind_phys) SLKMA(IM), THEMA(IM)
+!-----------------------------------------------------------------------
+!  DETERMINE WARMEST POTENTIAL WET-BULB TEMPERATURE BETWEEN K1 AND K2.
+!  COMPUTE ITS LIFTING CONDENSATION LEVEL.
+!
+      DO I=1,IM
+        SLKMA(I) = 0.
+        THEMA(I) = 0.
+      ENDDO
+      DO K=K1,K2
+        DO I=1,IM
+          PV   = 1000.0 * PRSL(I,K)*QENV(I,K)/(EPS-EPSM1*QENV(I,K))
+          TDPD = TENV(I,K)-FTDP(PV)
+          IF(TDPD.GT.0.) THEN
+            TLCL   = FTLCL(TENV(I,K),TDPD)
+            SLKLCL = PRSLK(I,K)*TLCL/TENV(I,K)
+          ELSE
+            TLCL   = TENV(I,K)
+            SLKLCL = PRSLK(I,K)
+          ENDIF
+          THELCL=FTHE(TLCL,SLKLCL)
+          IF(THELCL.GT.THEMA(I)) THEN
+            SLKMA(I) = SLKLCL
+            THEMA(I) = THELCL
+          ENDIF
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!  SET CLOUD TEMPERATURES AND HUMIDITIES WHEREVER THE PARCEL LIFTED UP
+!  THE MOIST ADIABAT IS BUOYANT WITH RESPECT TO THE ENVIRONMENT.
+      DO I=1,IM
+        KLCL(I)=KM+1
+        KBOT(I)=KM+1
+        KTOP(I)=0
+      ENDDO
+      DO K=1,KM
+        DO I=1,IM
+          TCLD(I,K)=0.
+          QCLD(I,K)=0.
+        ENDDO
+      ENDDO
+      DO K=K1,KM
+        DO I=1,IM
+          IF(PRSLK(I,K).LE.SLKMA(I)) THEN
+            KLCL(I)=MIN(KLCL(I),K)
+            CALL STMA(THEMA(I),PRSLK(I,K),TMA,QMA)
+!           TMA=FTMA(THEMA(I),PRSLK(I,K),QMA)
+            TVCLD=TMA*(1.+FV*QMA)
+            TVENV=TENV(I,K)*(1.+FV*QENV(I,K))
+            IF(TVCLD.GT.TVENV) THEN
+              KBOT(I)=MIN(KBOT(I),K)
+              KTOP(I)=MAX(KTOP(I),K)
+              TCLD(I,K)=TMA-TENV(I,K)
+              QCLD(I,K)=QMA-QENV(I,K)
+            ENDIF
+          ENDIF
+        ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+      RETURN
+      END SUBROUTINE MSTADBT3
+     
+      END MODULE module_cu_sas
Index: trunk/WRF.COMMON/WRFV2/phys/module_cumulus_driver.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_cumulus_driver.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_cumulus_driver.F	(revision 2744)
@@ -0,0 +1,465 @@
+!WRF:MEDIATION_LAYER:PHYSICS
+!
+
+MODULE module_cumulus_driver
+CONTAINS
+   SUBROUTINE cumulus_driver(                                         &
+                 ! Order dependent args for domain, mem, and tile dims
+                      ids,ide, jds,jde, kds,kde                       &
+                     ,ims,ime, jms,jme, kms,kme                       &
+                     ,i_start,i_end,j_start,j_end,kts,kte,num_tiles   &
+                 ! Order independent args (use VAR= in call)
+                 ! --Prognostic
+                     ,u,v,th,t,w                                      &
+                     ,p,pi,rho                                        &
+                 ! --Other arguments
+                     ,itimestep,dt,dx                                 &
+                     ,rainc,raincv,nca                                &
+                     ,dz8w,p8w,forcet,forceq                          &
+                     ,w0avg,stepcu,gsw                                &
+                     ,cldefi,lowlyr,xland,cu_act_flag,warm_rain       &
+                     ,htop,hbot,kpbl,ht                               &  
+                     ,ensdim,maxiens,maxens,maxens2,maxens3           &
+                 ! Package selection variable
+                     ,cu_physics                                      &
+                 ! Optional moisture tracers 
+                     ,qv_curr, qc_curr, qr_curr                       &
+                     ,qi_curr, qs_curr, qg_curr                       & 
+                     ,qv_prev, qc_prev, qr_prev                       & 
+                     ,qi_prev, qs_prev, qg_prev                       &
+                 ! Optional arguments for GD scheme
+                     ,apr_gr,apr_w,apr_mc,apr_st,apr_as,apr_capma     &
+                     ,apr_capme,apr_capmi                             &
+                     ,mass_flux,xf_ens,pr_ens                         &
+                     ,gd_cloud,gd_cloud2      &
+                 ! Optional moisture and other tendencies
+                     ,rqvcuten,rqccuten,rqrcuten                      &
+                     ,rqicuten,rqscuten,rqgcuten                      &
+                     ,rqvblten,rqvften                                &
+                     ,rthcuten,rthraten,rthblten,rthften              &
+                 ! Optional moisture tracer flags 
+                     ,f_qv,f_qc,f_qr                                  &
+                     ,f_qi,f_qs,f_qg                                  &
+                                                                      )
+!----------------------------------------------------------------------
+   USE module_model_constants
+   USE module_state_description, ONLY:     KFSCHEME,BMJSCHEME         &
+                                          ,KFETASCHEME,GDSCHEME       &
+                                          ,SASSCHEME
+
+! *** add new modules of schemes here
+
+   USE module_cu_kf
+   USE module_cu_bmj
+   USE module_cu_kfeta
+   USE module_cu_gd
+   USE module_cu_sas
+
+   !  This driver calls subroutines for the cumulus parameterizations.
+   !
+   !  1. Kain & Fritsch (1993)
+   !  2. Betts-Miller-Janjic (Janjic, 1994)
+   !
+!----------------------------------------------------------------------
+   IMPLICIT NONE
+!======================================================================
+! Grid structure in physics part of WRF
+!----------------------------------------------------------------------
+! The horizontal velocities used in the physics are unstaggered
+! relative to temperature/moisture variables. All predicted
+! variables are carried at half levels except w, which is at full
+! levels. Some arrays with names (*8w) are at w (full) levels.
+!
+!----------------------------------------------------------------------
+! In WRF, kms (smallest number) is the bottom level and kme (largest
+! number) is the top level.  In your scheme, if 1 is at the top level,
+! then you have to reverse the order in the k direction.
+!
+!         kme      -   half level (no data at this level)
+!         kme    ----- full level
+!         kme-1    -   half level
+!         kme-1  ----- full level
+!         .
+!         .
+!         .
+!         kms+2    -   half level
+!         kms+2  ----- full level
+!         kms+1    -   half level
+!         kms+1  ----- full level
+!         kms      -   half level
+!         kms    ----- full level
+!
+!======================================================================
+! Definitions
+!-----------
+! Rho_d      dry density (kg/m^3)
+! Theta_m    moist potential temperature (K)
+! Qv         water vapor mixing ratio (kg/kg)
+! Qc         cloud water mixing ratio (kg/kg)
+! Qr         rain water mixing ratio (kg/kg)
+! Qi         cloud ice mixing ratio (kg/kg)
+! Qs         snow mixing ratio (kg/kg)
+!-----------------------------------------------------------------
+!-- DT            time step (second)
+!-- itimestep     number of time step (integer)   
+!-- DX            horizontal space interval (m)
+!-- rr            dry air density (kg/m^3)
+!
+!-- RTHCUTEN      Theta tendency due to 
+!                 cumulus scheme precipitation (K/s)
+!-- RQVCUTEN      Qv tendency due to 
+!                 cumulus scheme precipitation (kg/kg/s)
+!-- RQRCUTEN      Qr tendency due to 
+!                 cumulus scheme precipitation (kg/kg/s)
+!-- RQCCUTEN      Qc tendency due to 
+!                 cumulus scheme precipitation (kg/kg/s)
+!-- RQSCUTEN      Qs tendency due to 
+!                 cumulus scheme precipitation (kg/kg/s)
+!-- RQICUTEN      Qi tendency due to 
+!                 cumulus scheme precipitation (kg/kg/s)
+!
+!-- RAINC         accumulated total cumulus scheme precipitation (mm)
+!-- RAINCV        cumulus scheme precipitation (mm)
+!-- NCA           counter of the cloud relaxation 
+!                 time in KF cumulus scheme (integer)
+!-- u_phy         u-velocity interpolated to theta points (m/s)
+!-- v_phy         v-velocity interpolated to theta points (m/s)
+!-- th_phy        potential temperature (K)
+!-- t_phy         temperature (K)
+!-- w             vertical velocity (m/s)
+!-- moist         moisture array (4D - last index is species) (kg/kg)
+!-- dz8w          dz between full levels (m)
+!-- p8w           pressure at full levels (Pa)  
+!-- p_phy         pressure (Pa)
+!-- pi_phy        exner function (dimensionless)
+!                 points (dimensionless)
+!-- RTHRATEN      radiative temp forcing for Grell-Devenyi scheme
+!-- RTHBLTEN      PBL temp forcing for Grell-Devenyi scheme
+!-- RQVBLTEN      PBL moisture forcing for Grell-Devenyi scheme
+!-- RTHFTEN
+!-- RQVFTEN
+!-- MASS_FLUX
+!-- XF_ENS
+!-- PR_ENS
+!-- warm_rain
+!-- CU_ACT_FLAG
+!-- W0AVG         average vertical velocity, (for KF scheme) (m/s)
+!-- rho           density (kg/m^3)
+!-- CLDEFI        precipitation efficiency (for BMJ scheme) (dimensionless)
+!-- STEPCU        # of fundamental timesteps between convection calls
+!-- XLAND         land-sea mask (1.0 for land; 2.0 for water)
+!-- LOWLYR        index of lowest model layer above the ground
+!-- XLV0          latent heat of vaporization constant 
+!                 used in temperature dependent formula (J/kg)
+!-- XLV1          latent heat of vaporization constant 
+!                 used in temperature dependent formula (J/kg/K)
+!-- XLS0          latent heat of sublimation constant 
+!                 used in temperature dependent formula (J/kg)
+!-- XLS1          latent heat of sublimation constant
+!                 used in temperature dependent formula (J/kg/K)
+!-- R_d           gas constant for dry air ( 287. J/kg/K)
+!-- R_v           gas constant for water vapor (461 J/k/kg)
+!-- Cp            specific heat at constant pressure (1004 J/k/kg)
+!-- rvovrd        R_v divided by R_d (dimensionless)
+!-- G             acceleration due to gravity (m/s^2)
+!-- EP_1          constant for virtual temperature 
+!                 (R_v/R_d - 1) (dimensionless)
+!-- pi_phy        the exner function, (p/p0)**(R/Cp) (none unit)
+!-- ids           start index for i in domain
+!-- ide           end index for i in domain
+!-- jds           start index for j in domain
+!-- jde           end index for j in domain
+!-- kds           start index for k in domain
+!-- kde           end index for k in domain
+!-- ims           start index for i in memory
+!-- ime           end index for i in memory
+!-- jms           start index for j in memory
+!-- jme           end index for j in memory
+!-- kms           start index for k in memory
+!-- kme           end index for k in memory
+!-- i_start       start indices for i in tile
+!-- i_end         end indices for i in tile
+!-- j_start       start indices for j in tile
+!-- j_end         end indices for j in tile
+!-- kts           start index for k in tile
+!-- kte           end index for k in tile
+!-- num_tiles     number of tiles
+!-- HBOT          index of lowest model layer with convection
+!-- HTOP          index of highest model layer with convection
+!-- LBOT          index of lowest model layer with convection
+!-- LTOP          index of highest model layer with convection
+!-- KPBL          layer index of the PBL
+!
+!======================================================================
+
+   INTEGER,      INTENT(IN   )    ::                             &
+                                      ids,ide, jds,jde, kds,kde, &
+                                      ims,ime, jms,jme, kms,kme, &
+                                                        kts,kte, &
+                                      itimestep, num_tiles
+   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
+     &           i_start,i_end,j_start,j_end
+
+   INTEGER,      INTENT(IN   )    ::                             &
+                           ensdim,maxiens,maxens,maxens2,maxens3
+
+   INTEGER,      INTENT(IN   )    ::   cu_physics
+   INTEGER,      INTENT(IN   )    ::   STEPCU
+   LOGICAL,      INTENT(IN   )    ::   warm_rain
+
+   INTEGER,DIMENSION( ims:ime, jms:jme ),                        &
+           INTENT(IN ) ::                                LOWLYR
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         INTENT(IN ) ::                                          &
+                                                           dz8w  &
+                                                      ,     p8w  &
+                                                      ,       p  &
+                                                      ,      pi  &
+                                                      ,       u  &
+                                                      ,       v  &
+                                                      ,      th  &
+                                                      ,       t  &
+                                                      ,     rho  &
+                                                      ,       w
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         INTENT(INOUT)  ::                                       &
+                                                          W0AVG
+
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) ::           &
+                                                 GSW,HT,XLAND
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                         &
+          INTENT(INOUT) ::                                RAINC  &
+                                                    ,    RAINCV  &
+                                                    ,       NCA  & 
+                                                    ,      HTOP  & 
+                                                    ,      HBOT  &
+                                                    ,    CLDEFI 
+ 
+
+   INTEGER, DIMENSION( ims:ime , jms:jme ),                      &
+                    INTENT(IN) ::                          KPBL
+
+
+   LOGICAL, DIMENSION( ims:ime , jms:jme ),                      &
+          INTENT(INOUT) :: CU_ACT_FLAG
+
+   REAL,  INTENT(IN   ) :: DT, DX
+
+!
+! optional arguments
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         OPTIONAL, INTENT(INOUT) ::                              &
+                      ! optional moisture tracers
+                      ! 2 time levels; if only one then use CURR
+                      qv_curr, qc_curr, qr_curr                  &
+                     ,qi_curr, qs_curr, qg_curr                  & 
+                     ,qv_prev, qc_prev, qr_prev                  & 
+                     ,qi_prev, qs_prev, qg_prev                  &
+                      ! optional moisture and other tendencies
+                     ,rqvcuten,rqccuten,rqrcuten                 &
+                     ,rqicuten,rqscuten,rqgcuten                 &
+                     ,rqvblten,rqvften                           &
+                     ,rthraten,rthblten                          &
+                                                      ,   forcet &
+                                                      ,   forceq &
+                     ,rthften,rthcuten
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                         &
+                    OPTIONAL,                                    &
+                    INTENT(INOUT) ::                             &
+                apr_gr,apr_w,apr_mc,apr_st,apr_as,apr_capma      &
+               ,apr_capme,apr_capmi                              &
+                                                    , MASS_FLUX
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         OPTIONAL, INTENT(INOUT) ::                              &
+                  GD_CLOUD,GD_CLOUD2
+   REAL, DIMENSION( ims:ime , jms:jme , 1:ensdim ),              &
+          OPTIONAL,                                              &
+          INTENT(INOUT) ::                       XF_ENS, PR_ENS
+
+!
+! Flags relating to the optional tendency arrays declared above
+! Models that carry the optional tendencies will provdide the
+! optional arguments at compile time; these flags all the model
+! to determine at run-time whether a particular tracer is in
+! use or not.
+!
+   LOGICAL, INTENT(IN), OPTIONAL ::                             &
+                                                      f_qv      &
+                                                     ,f_qc      &
+                                                     ,f_qr      &
+                                                     ,f_qi      &
+                                                     ,f_qs      &
+                                                     ,f_qg
+
+
+! LOCAL  VAR
+
+   INTEGER :: i,j,k,its,ite,jts,jte,ij
+
+!-----------------------------------------------------------------
+
+   IF (cu_physics .eq. 0) return
+
+! DON'T JUDGE TIME STEP HERE, SINCE KF NEEDS ACCUMULATED W FIELD.
+! DO IT INSIDE THE INDIVIDUAL CUMULUS SCHEME
+
+! SET START AND END POINTS FOR TILES
+      !$OMP PARALLEL DO   &
+      !$OMP PRIVATE ( ij ,its,ite,jts,jte, i,j,k)
+
+      DO ij = 1 , num_tiles
+        its = i_start(ij)
+        ite = i_end(ij)
+        jts = j_start(ij)
+        jte = j_end(ij)
+
+
+   cps_select: SELECT CASE(cu_physics)
+
+     CASE (KFSCHEME)
+          CALL wrf_debug(100,'in kfcps')
+
+          CALL KFCPS(                                           &
+              ! order independent arguments
+                DT=dt ,KTAU=itimestep ,DX=dx ,RHO=rho           &
+               ,U=u ,V=v ,TH=th ,T=t ,W=w                       &
+               ,PCPS=p ,PI=pi                                   &
+               ,XLV0=xlv0 ,XLV1=xlv1 ,XLS0=xls0 ,XLS1=xls1      &
+               ,RAINCV=raincv ,NCA=nca                          &
+               ,DZ8W=dz8w                                       &
+               ,W0AVG=w0avg                                     &
+               ,CP=cp ,R=r_d ,G=g ,EP1=ep_1 ,EP2=ep_2           &
+               ,SVP1=svp1 ,SVP2=svp2 ,SVP3=svp3 ,SVPT0=svpt0    &
+               ,STEPCU=stepcu                                   &
+               ,CU_ACT_FLAG=cu_act_flag                         &
+               ,WARM_RAIN=warm_rain                             &
+               ,QV=qv_curr                                      &
+               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
+               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
+               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
+              ! optionals
+               ,RTHCUTEN=rthcuten ,RQVCUTEN=rqvcuten            &
+               ,RQCCUTEN=rqccuten ,RQRCUTEN=rqrcuten            &
+               ,RQICUTEN=rqicuten ,RQSCUTEN=rqscuten            &
+               ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                   &
+               ,F_QI=f_qi,F_QS=f_qs                             &
+                                                                )
+
+     CASE (BMJSCHEME)
+          CALL wrf_debug(100,'in bmj_cps')
+          CALL BMJDRV(                                          &
+                TH=th,T=T ,RAINCV=raincv, RHO=rho               &
+               ,DT=dt ,ITIMESTEP=itimestep ,STEPCU=stepcu       &
+               ,CUTOP=htop, CUBOT=hbot, KPBL=kpbl               &
+               ,DZ8W=dz8w ,PINT=p8w, PMID=p, PI=pi              &
+               ,CP=cp ,R=r_d ,ELWV=xlv ,ELIV=xls ,G=g           &
+               ,TFRZ=svpt0 ,D608=ep_1 ,CLDEFI=cldefi            &
+               ,LOWLYR=lowlyr ,XLAND=xland                      &
+               ,CU_ACT_FLAG=cu_act_flag                         &
+               ,QV=qv_curr                                      &
+               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
+               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
+               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
+              ! optionals
+               ,RTHCUTEN=rthcuten ,RQVCUTEN=rqvcuten            &
+                                                                )
+
+     CASE (KFETASCHEME)
+          CALL wrf_debug(100,'in kf_eta_cps')
+          CALL KF_ETA_CPS(                                      &
+                U=u ,V=v ,TH=th ,T=t ,W=w ,RHO=rho              &
+               ,RAINCV=raincv, NCA=nca ,DZ8W=dz8w               &
+               ,PCPS=p, PI=pi ,W0AVG=W0AVG                      &
+               ,CUTOP=HTOP,CUBOT=HBOT                           &
+               ,XLV0=XLV0 ,XLV1=XLV1 ,XLS0=XLS0 ,XLS1=XLS1      &
+               ,CP=CP ,R=R_d ,G=G ,EP1=EP_1 ,EP2=EP_2           &
+               ,SVP1=SVP1 ,SVP2=SVP2 ,SVP3=SVP3 ,SVPT0=SVPT0    &
+               ,DT=dt ,KTAU=itimestep ,DX=dx                    &
+               ,STEPCU=stepcu                                   &
+               ,CU_ACT_FLAG=cu_act_flag ,warm_rain=warm_rain    &
+               ,QV=qv_curr                                      &
+               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
+               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
+               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
+              ! optionals
+               ,RTHCUTEN=rthcuten                               &
+               ,RQVCUTEN=rqvcuten ,RQCCUTEN=rqccuten            &
+               ,RQRCUTEN=rqrcuten ,RQICUTEN=rqicuten            &
+               ,RQSCUTEN=rqscuten                               &
+               ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                   &
+               ,F_QI=f_qi,F_QS=f_qs                             &
+                                                                )
+
+     CASE (GDSCHEME)
+          CALL wrf_debug(100,'in grelldrv')
+          CALL GRELLDRV(                                        &
+                DT=dt, ITIMESTEP=itimestep, DX=dx               &
+               ,U=u,V=v,T=t,W=w ,RHO=rho                        &
+               ,P=p,PI=pi ,Q=qv_curr ,RAINCV=raincv             &
+               ,DZ8W=dz8w,P8W=p8w,XLV=xlv,CP=cp,G=g,R_V=r_v     &
+               ,APR_GR=apr_gr,APR_W=apr_w,APR_MC=apr_mc         &
+               ,APR_ST=apr_st,APR_AS=apr_as                     &
+               ,APR_CAPMA=apr_capma,APR_CAPME=apr_capme         &
+               ,APR_CAPMI=apr_capmi,MASS_FLUX=mass_flux         &
+               ,XF_ENS=xf_ens,PR_ENS=pr_ens,HT=ht               &
+               ,xland=xland,gsw=gsw                             &
+               ,GDC=gd_cloud,GDC2=gd_cloud2 &
+               ,ENSDIM=ensdim,MAXIENS=maxiens,MAXENS=maxens     &
+               ,MAXENS2=maxens2,MAXENS3=maxens3                 &
+               ,STEPCU=STEPCU,htop=htop,hbot=hbot               &
+               ,CU_ACT_FLAG=CU_ACT_FLAG,warm_rain=warm_rain     &
+               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
+               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
+               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
+              ! optionals
+#if (NMM_CORE == 1 )
+               ,RTHCUTEN=RTHCUTEN ,RTHFTEN=forcet               & 
+               ,RQICUTEN=RQICUTEN ,RQVFTEN=forceq               &
+#else
+               ,RTHCUTEN=RTHCUTEN ,RTHFTEN=RTHFTEN              & 
+               ,RQICUTEN=RQICUTEN ,RQVFTEN=RQVFTEN              &
+#endif
+               ,RTHRATEN=RTHRATEN,RTHBLTEN=RTHBLTEN             &
+               ,RQVCUTEN=RQVCUTEN,RQCCUTEN=RQCCUTEN             &
+               ,RQVBLTEN=RQVBLTEN                               &
+               ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                   &
+               ,F_QI=f_qi,F_QS=f_qs                             &
+                                                                )
+     CASE (SASSCHEME)
+                                                                                                                                           
+          CALL wrf_debug(100,'in cu_sas')
+            CALL CU_SAS(                                        &
+                DT=dt,ITIMESTEP=itimestep,STEPCU=STEPCU         &
+               ,RAINCV=RAINCV,HTOP=HTOP,HBOT=HBOT               &
+               ,U3D=u,V3D=v,W=w,T3D=t,PI3D=pi,RHO3D=rho         &
+               ,QV3D=QV_CURR,QC3D=QC_CURR,QI3D=QI_CURR          &
+               ,DZ8W=dz8w,PCPS=p,P8W=p8w,XLAND=XLAND            &
+               ,CU_ACT_FLAG=CU_ACT_FLAG                         &
+               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
+               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
+               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
+              ! optionals
+               ,RTHCUTEN=RTHCUTEN,RQVCUTEN=RQVCUTEN             &
+               ,RQCCUTEN=RQCCUTEN,RQICUTEN=RQICUTEN             &
+               ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                   &
+               ,F_QI=f_qi,F_QS=f_qs                             &
+                                                                )
+
+     CASE DEFAULT 
+
+         WRITE( wrf_err_message , * ) 'The cumulus option does not exist: cu_physics = ', cu_physics
+         CALL wrf_error_fatal ( wrf_err_message )
+
+   END SELECT cps_select
+
+      ENDDO
+      !$OMP END PARALLEL DO
+
+   END SUBROUTINE cumulus_driver
+
+END MODULE module_cumulus_driver
Index: trunk/WRF.COMMON/WRFV2/phys/module_diagnostics.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_diagnostics.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_diagnostics.F	(revision 2744)
@@ -0,0 +1,256 @@
+!WRF:MEDIATION_LAYER:PHYSICS
+!
+
+MODULE module_diagnostics
+CONTAINS
+   SUBROUTINE diagnostic_output_calc(                                 &
+                      ids,ide, jds,jde, kds,kde,                      &
+                      ims,ime, jms,jme, kms,kme,                      &
+                      ips,ipe, jps,jpe, kps,kpe,                      & ! patch  dims
+                      i_start,i_end,j_start,j_end,kts,kte,num_tiles   &
+                     ,dpsdt,dmudt                                     &
+                     ,p_phy,pk1m,mu_2,mu_2m                           &
+                     ,u,v                                             &
+                     ,raincv,rainncv,rainc,rainnc                     &
+                     ,hfx,sfcevp,lh                                   &
+                     ,dt,xtime,sbw                                    &
+                     ,diag_print                                      &
+                                                                      )
+!----------------------------------------------------------------------
+
+   USE module_dm
+
+   IMPLICIT NONE
+!======================================================================
+! Definitions
+!-----------
+!-- DIAG_PRINT    print control: 0 - no diagnostics; 1 - dmudt only; 2 - all
+!-- DT            time step (second)
+!-- XTIME         forecast time
+!-- SBW           specified boundary width - used later
+!
+!-- P_PHY         3D pressure array
+!-- MU            dry column hydrostatic pressure
+!-- RAINC         cumulus scheme precipitation since hour 0
+!-- RAINCV        cumulus scheme precipitation in one time step (mm)
+!-- RAINNC        explicit scheme precipitation since hour 0
+!-- RAINNCV       explicit scheme precipitation in one time step (mm)
+!-- HFX           surface sensible heat flux
+!-- LH            surface latent heat flux
+!-- SFCEVP        total surface evaporation
+!-- U             u component of wind - to be used later to compute k.e.
+!-- V             v component of wind - to be used later to compute k.e.
+!
+!-- ids           start index for i in domain
+!-- ide           end index for i in domain
+!-- jds           start index for j in domain
+!-- jde           end index for j in domain
+!-- kds           start index for k in domain
+!-- kde           end index for k in domain
+!-- ims           start index for i in memory
+!-- ime           end index for i in memory
+!-- jms           start index for j in memory
+!-- jme           end index for j in memory
+!-- ips           start index for i in patch
+!-- ipe           end index for i in patch
+!-- jps           start index for j in patch
+!-- jpe           end index for j in patch
+!-- kms           start index for k in memory
+!-- kme           end index for k in memory
+!-- i_start       start indices for i in tile
+!-- i_end         end indices for i in tile
+!-- j_start       start indices for j in tile
+!-- j_end         end indices for j in tile
+!-- kts           start index for k in tile
+!-- kte           end index for k in tile
+!-- num_tiles     number of tiles
+!
+!======================================================================
+
+   INTEGER,      INTENT(IN   )    ::                             &
+                                      ids,ide, jds,jde, kds,kde, &
+                                      ims,ime, jms,jme, kms,kme, &
+                                      ips,ipe, jps,jpe, kps,kpe, &
+                                                        kts,kte, &
+                                                      num_tiles
+
+   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                  &
+     &           i_start,i_end,j_start,j_end
+
+   INTEGER,      INTENT(IN   )    ::   diag_print
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         INTENT(IN ) ::                                       u  &
+                                                    ,         v  &
+                                                    ,     p_phy
+
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) ::           &
+                                                           MU_2  &
+                                                    ,     RAINC  &
+                                                    ,    RAINNC  &
+                                                    ,    RAINCV  &
+                                                    ,   RAINNCV  &
+                                                    ,       HFX  &
+                                                    ,    SFCEVP  &  
+                                                    ,        LH  
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                         &
+          INTENT(INOUT) ::                                DPSDT  &
+                                                    ,     DMUDT  &
+                                                    ,     MU_2M  &
+                                                    ,      PK1M
+ 
+   REAL,  INTENT(IN   ) :: DT, XTIME
+   INTEGER,  INTENT(IN   ) :: SBW
+
+! LOCAL  VAR
+
+   INTEGER :: i,j,k,its,ite,jts,jte,ij
+
+   REAL              :: no_points
+   REAL              :: dpsdt_sum, dmudt_sum, dardt_sum, drcdt_sum, drndt_sum
+   REAL              :: hfx_sum, lh_sum, sfcevp_sum, rainc_sum, rainnc_sum, raint_sum
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+   CHARACTER*256     :: outstring
+   CHARACTER*6       :: grid_str
+
+!-----------------------------------------------------------------
+
+   if (diag_print .eq. 0 ) return
+
+   IF ( xtime .gt. 0. ) THEN
+
+! COMPUTE THE NUMBER OF MASS GRID POINTS
+   no_points = float((ide-ids)*(jde-jds))
+
+! SET START AND END POINTS FOR TILES
+!  !$OMP PARALLEL DO   &
+!  !$OMP PRIVATE ( ij )
+
+   DO ij = 1 , num_tiles
+
+!     print *, i_start(ij),i_end(ij),j_start(ij),j_end(ij)
+      DO j=j_start(ij),j_end(ij)
+      DO i=i_start(ij),i_end(ij)
+         dpsdt(i,j)=(p_phy(i,kms,j)-pk1m(i,j))/dt
+         dmudt(i,j)=(mu_2(i,j)-mu_2m(i,j))/dt
+      ENDDO      
+      ENDDO
+
+   ENDDO
+!  !$OMP END PARALLEL DO
+
+!  print *, 'p_phy(30,1,30),pk1m(30,30) : ', p_phy(30,1,30),pk1m(30,30)
+!  print *, 'mu_2(30,30),mu_2m(30,30) : ', mu_2(30,30),mu_2m(30,30)
+   dpsdt_sum = 0.
+   dmudt_sum = 0.
+
+   DO j = jps, min(jpe,jde-1)
+     DO i = ips, min(ipe,ide-1)
+       dpsdt_sum = dpsdt_sum + abs(dpsdt(i,j))
+       dmudt_sum = dmudt_sum + abs(dmudt(i,j))
+     ENDDO
+   ENDDO
+
+! compute global sum
+   dpsdt_sum = wrf_dm_sum_real ( dpsdt_sum )
+   dmudt_sum = wrf_dm_sum_real ( dmudt_sum )
+
+!  print *, 'dpsdt, dmudt : ', dpsdt_sum, dmudt_sum
+
+   IF ( diag_print .eq. 2 ) THEN
+   dardt_sum = 0.
+   drcdt_sum = 0.
+   drndt_sum = 0.
+   sfcevp_sum = 0.
+   hfx_sum = 0.
+   lh_sum = 0.
+
+   DO j = jps, min(jpe,jde-1)
+     DO i = ips, min(ipe,ide-1)
+       drcdt_sum = drcdt_sum + abs(raincv(i,j))
+       drndt_sum = drndt_sum + abs(rainncv(i,j))
+       dardt_sum = dardt_sum + abs(raincv(i,j)) + abs(rainncv(i,j))
+       rainc_sum = rainc_sum + abs(rainc(i,j))
+       rainnc_sum = rainnc_sum + abs(rainnc(i,j))
+       raint_sum = raint_sum + abs(rainc(i,j)) + abs(rainnc(i,j))
+       sfcevp_sum = sfcevp_sum + abs(sfcevp(i,j))
+       hfx_sum = hfx_sum + abs(hfx(i,j))
+       lh_sum = lh_sum + abs(lh(i,j))
+     ENDDO
+   ENDDO
+
+! compute global sum
+   drcdt_sum = wrf_dm_sum_real ( drcdt_sum )
+   drndt_sum = wrf_dm_sum_real ( drndt_sum )
+   dardt_sum = wrf_dm_sum_real ( dardt_sum )
+   rainc_sum = wrf_dm_sum_real ( rainc_sum )
+   rainnc_sum = wrf_dm_sum_real ( rainnc_sum )
+   raint_sum = wrf_dm_sum_real ( raint_sum )
+   sfcevp_sum = wrf_dm_sum_real ( sfcevp_sum )
+   hfx_sum = wrf_dm_sum_real ( hfx_sum )
+   lh_sum = wrf_dm_sum_real ( lh_sum )
+
+   ENDIF
+
+! print out the average values
+
+   CALL get_current_grid_name( grid_str )
+
+#ifdef DM_PARALLEL
+   IF ( wrf_dm_on_monitor() ) THEN
+#endif
+     WRITE(outstring,*) grid_str,'Domain average of dpsdt, dmudt (Pa/sec): ', xtime, &
+           dpsdt_sum/no_points, &
+           dmudt_sum/no_points
+     CALL wrf_message ( TRIM(outstring) )
+     IF ( diag_print .eq. 2) THEN
+     WRITE(outstring,*) grid_str,'Domain average of dardt, drcdt, drndt (mm/sec): ', xtime, &
+           dardt_sum/dt/no_points, &
+           drcdt_sum/dt/no_points, &
+           drndt_sum/dt/no_points
+     CALL wrf_message ( TRIM(outstring) )
+     WRITE(outstring,*) grid_str,'Domain average of rt_sum, rc_sum, rnc_sum (mm/sec): ', xtime, &
+           raint_sum/no_points, &
+           rainc_sum/no_points, &
+           rainnc_sum/no_points
+     CALL wrf_message ( TRIM(outstring) )
+     WRITE(outstring,*) grid_str,'Domain average of sfcevp, hfx, lh: ', xtime, &
+           sfcevp_sum/no_points, &
+           hfx_sum/no_points, &
+           lh_sum/no_points
+     CALL wrf_message ( TRIM(outstring) )
+     ENDIF
+#ifdef DM_PARALLEL
+   ENDIF
+#endif
+
+   ENDIF
+
+! save values at this time step
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij,i,j )
+   DO ij = 1 , num_tiles
+
+      DO j=j_start(ij),j_end(ij)
+      DO i=i_start(ij),i_end(ij)
+         pk1m(i,j)=p_phy(i,kms,j)
+         mu_2m(i,j)=mu_2(i,j)
+      ENDDO
+      ENDDO
+
+      IF ( xtime .lt. 0.0001 ) THEN
+      DO j=j_start(ij),j_end(ij)
+      DO i=i_start(ij),i_end(ij)
+         dpsdt(i,j)=0.
+         dmudt(i,j)=0.
+      ENDDO
+      ENDDO
+      ENDIF
+
+   ENDDO
+   !$OMP END PARALLEL DO
+
+   END SUBROUTINE diagnostic_output_calc
+
+END MODULE module_diagnostics
Index: trunk/WRF.COMMON/WRFV2/phys/module_fdda_psufddagd.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_fdda_psufddagd.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_fdda_psufddagd.F	(revision 2744)
@@ -0,0 +1,602 @@
+!wrf:model_layer:physics
+!
+!
+!
+MODULE module_fdda_psufddagd
+
+  USE module_dm
+
+CONTAINS
+!
+!-------------------------------------------------------------------
+!
+   SUBROUTINE fddagd(itimestep,dt,xtime,id,analysis_interval, end_fdda_hour, &
+               if_no_pbl_nudging_uv, if_no_pbl_nudging_t, if_no_pbl_nudging_q, &
+               if_zfac_uv, k_zfac_uv, if_zfac_t, k_zfac_t, if_zfac_q, k_zfac_q, &
+               guv, gt, gq, if_ramping, dtramp_min,  &
+               u3d,v3d,th3d,t3d,                 &
+               qv3d,     &
+               p3d,pi3d,                &
+               u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old,       &
+               u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new,       &
+               RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,&
+               pblh, ht, z, z_at_w,                             &
+               ids,ide, jds,jde, kds,kde,                           &
+               ims,ime, jms,jme, kms,kme,                           &
+               its,ite, jts,jte, kts,kte                        )
+
+!-------------------------------------------------------------------
+   implicit none
+!-------------------------------------------------------------------
+!-- u3d         3d u-velocity staggered on u points
+!-- v3d         3d v-velocity staggered on v points
+!-- th3d        3d potential temperature (k)
+!-- t3d         temperature (k)
+!-- qv3d        3d water vapor mixing ratio (kg/kg)
+!-- p3d         3d pressure (pa)
+!-- pi3d        3d exner function (dimensionless)
+!-- rundgdten   staggered u tendency due to
+!               fdda grid nudging (m/s/s)
+!-- rvndgdten   staggered v tendency due to
+!               fdda grid nudging (m/s/s)
+!-- rthndgdten  theta tendency due to
+!               fdda grid nudging (K/s)
+!-- rqvndgdten  qv tendency due to
+!               fdda grid nudging (kg/kg/s)
+!-- rmundgdten  mu tendency due to
+!               fdda grid nudging (Pa/s)
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!-------------------------------------------------------------------
+!
+   INTEGER,  INTENT(IN)   ::      itimestep, analysis_interval, end_fdda_hour
+
+   INTEGER,  INTENT(IN)   ::      if_no_pbl_nudging_uv, if_no_pbl_nudging_t, &
+                                  if_no_pbl_nudging_q
+   INTEGER,  INTENT(IN)   ::      if_zfac_uv, if_zfac_t, if_zfac_q
+   INTEGER,  INTENT(IN)   ::      k_zfac_uv,  k_zfac_t,  k_zfac_q
+   INTEGER,  INTENT(IN)   ::      if_ramping
+
+   INTEGER , INTENT(IN)   ::      id
+   REAL,     INTENT(IN)   ::      DT, xtime, dtramp_min
+
+   INTEGER,  INTENT(IN)   ::      ids,ide, jds,jde, kds,kde, &
+                                  ims,ime, jms,jme, kms,kme, &
+                                  its,ite, jts,jte, kts,kte
+ 
+   REAL,     DIMENSION( ims:ime, kms:kme, jms:jme ), &
+             INTENT(IN)   ::                   qv3d, &
+                                               p3d, &
+                                              pi3d, &
+                                              th3d, &
+                                               t3d, &
+                                                 z, &
+                                            z_at_w
+
+   REAL,     DIMENSION( ims:ime, kms:kme, jms:jme ), &
+             INTENT(INOUT)   ::           rundgdten, &
+                                          rvndgdten, &
+                                         rthndgdten, &
+                                         rqvndgdten
+
+   REAL,     DIMENSION( ims:ime, jms:jme ), &
+             INTENT(INOUT)   ::          rmundgdten
+
+   REAL,     DIMENSION( ims:ime, kms:kme, jms:jme ), &
+             INTENT(INOUT)   ::           u_ndg_old, &
+                                          v_ndg_old, &
+                                          t_ndg_old, &
+                                          q_ndg_old, &
+                                          u_ndg_new, &
+                                          v_ndg_new, &
+                                          t_ndg_new, &
+                                          q_ndg_new
+
+   REAL,     DIMENSION( ims:ime, jms:jme ), &
+             INTENT(INOUT) ::   mu_ndg_old, &
+                                mu_ndg_new
+
+   REAL,     DIMENSION( ims:ime, kms:kme, jms:jme ), &
+             INTENT(IN)   ::                    u3d, &
+                                                v3d
+
+   REAL,  DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: pblh, &
+                                                         ht
+
+   REAL, INTENT(IN)    :: guv, gt, gq
+
+   INTEGER             :: i, j, k, itsu, jtsv, itf, jtf, ktf, i0, k0, j0
+   REAL                :: xtime_old, xtime_new, coef, val_analysis
+   INTEGER             :: kpbl, dbg_level
+
+   REAL                :: zpbl, zagl, zagl_bot, zagl_top, tfac, actual_end_fdda_min
+   REAL, DIMENSION( its:ite, kts:kte, jts:jte, 4 ) :: wpbl  ! 1: u, 2: v, 3: t, 4: q
+   REAL, DIMENSION( kts:kte, 4 )                   :: wzfac ! 1: u, 2: v, 3: t, 4: q
+
+   LOGICAL , EXTERNAL  :: wrf_dm_on_monitor
+
+   CHARACTER (LEN=256) :: message
+
+   xtime_old = FLOOR(xtime/analysis_interval) * analysis_interval * 1.0
+   xtime_new = xtime_old + analysis_interval
+   coef = (xtime-xtime_old)/(xtime_new-xtime_old)
+
+
+   IF ( wrf_dm_on_monitor()) THEN
+
+     CALL get_wrf_debug_level( dbg_level )
+
+     IF( xtime-xtime_old < 0.5*dt/60.0 ) THEN
+
+       IF( xtime < end_fdda_hour*60.0 ) THEN
+         WRITE(message,'(a,i1,a,f10.3,a)') &
+          'D0',id,' Analysis nudging read in new data at time = ', xtime, ' min.'
+         CALL wrf_message( TRIM(message) )
+         WRITE(message,'(a,i1,a,2f8.2,a)') &
+          'D0',id,' Analysis nudging bracketing times = ', xtime_old, xtime_new, ' min.'
+         CALL wrf_message( TRIM(message) )
+       ENDIF
+
+       actual_end_fdda_min = end_fdda_hour*60.0
+       IF( if_ramping == 1 .AND. dtramp_min > 0.0 ) &
+           actual_end_fdda_min = end_fdda_hour*60.0 + ABS(dtramp_min)
+
+       IF( dbg_level .GE. 10 .AND. xtime <= actual_end_fdda_min ) THEN
+!        Find the mid point of the tile and print out the sample values
+         i0 = (ite-its)/2+its
+         j0 = (jte-jts)/2+jts 
+
+         IF( guv > 0.0 ) THEN
+           DO k = kts, kte
+             WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
+               '    D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
+               ' u_ndg_old=', u_ndg_old(i0,k,j0), ' u_ndg_new=', u_ndg_new(i0,k,j0)
+             CALL wrf_message( TRIM(message) )
+           ENDDO
+           DO k = kts, kte
+             WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
+               '    D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
+               ' v_ndg_old=', v_ndg_old(i0,k,j0), ' v_ndg_new=', v_ndg_new(i0,k,j0)
+             CALL wrf_message( TRIM(message) )
+           ENDDO
+         ENDIF
+
+         IF( gt > 0.0 ) THEN
+           DO k = kts, kte
+             WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
+               '    D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
+               ' t_ndg_old=', t_ndg_old(i0,k,j0), ' t_ndg_new=', t_ndg_new(i0,k,j0)
+             CALL wrf_message( TRIM(message) )
+           ENDDO
+         ENDIF
+
+         IF( gq > 0.0 ) THEN
+           DO k = kts, kte
+             WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
+               '    D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
+               ' q_ndg_old=', q_ndg_old(i0,k,j0), ' q_ndg_new=', q_ndg_new(i0,k,j0)
+             CALL wrf_message( TRIM(message) )
+           ENDDO
+         ENDIF
+
+       ENDIF
+     ENDIF
+   ENDIF
+
+   jtsv=MAX0(jts,jds+1)
+   itsu=MAX0(its,ids+1)
+
+   jtf=MIN0(jte,jde-1)
+   ktf=MIN0(kte,kde-1)
+   itf=MIN0(ite,ide-1)
+!
+! If the user-defined namelist switches (if_no_pbl_nudging_uv, if_no_pbl_nudging_t, 
+! if_no_pbl_nudging_q swithes) are set to 1, compute the weighting function, wpbl(:,k,:,:), 
+! based on the PBL depth.  wpbl = 1 above the PBL and wpbl = 0 in the PBL.  If all 
+! the switche are set to zero, wpbl = 1 (default value).
+!
+   wpbl(:,:,:,:) = 1.0
+
+   IF( if_no_pbl_nudging_uv == 1 ) THEN
+
+     DO j=jts,jtf 
+     DO i=itsu,itf
+
+       kpbl = 1
+       zpbl = 0.5 * ( pblh(i-1,j) + pblh(i,j) )
+
+       loop_ku: DO k=kts,ktf 
+         zagl     = 0.5 * ( z(i-1,k,j)-ht(i-1,j) + z(i,k,j)-ht(i,j) )
+         zagl_bot = 0.5 * ( z_at_w(i-1,k,  j)-ht(i-1,j) + z_at_w(i,k,  j)-ht(i,j) )
+         zagl_top = 0.5 * ( z_at_w(i-1,k+1,j)-ht(i-1,j) + z_at_w(i,k+1,j)-ht(i,j) )
+         IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
+           kpbl = k
+           EXIT loop_ku
+         ENDIF
+       ENDDO loop_ku
+
+       DO k=kts,ktf 
+         IF( k <= kpbl   ) wpbl(i, k, j, 1) = 0.0
+         IF( k == kpbl+1 ) wpbl(i, k, j, 1) = 0.1
+         IF( k >  kpbl+1 ) wpbl(i, k, j, 1) = 1.0
+       ENDDO
+
+     ENDDO
+     ENDDO
+
+     DO i=its,itf
+     DO j=jtsv,jtf
+
+       kpbl = 1
+       zpbl = 0.5 * ( pblh(i,j-1) + pblh(i,j) )
+
+       loop_kv: DO k=kts,ktf
+         zagl     = 0.5 * ( z(i,k,j-1)-ht(i,j-1) + z(i,k,j)-ht(i,j) )
+         zagl_bot = 0.5 * ( z_at_w(i,k,  j-1)-ht(i,j-1) + z_at_w(i,k,  j)-ht(i,j) )
+         zagl_top = 0.5 * ( z_at_w(i,k+1,j-1)-ht(i,j-1) + z_at_w(i,k+1,j)-ht(i,j) )
+         IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
+           kpbl = k
+           EXIT loop_kv
+         ENDIF
+       ENDDO loop_kv
+
+       DO k=kts,ktf
+         IF( k <= kpbl   ) wpbl(i, k, j, 2) = 0.0
+         IF( k == kpbl+1 ) wpbl(i, k, j, 2) = 0.1
+         IF( k >  kpbl+1 ) wpbl(i, k, j, 2) = 1.0
+       ENDDO
+
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   IF( if_no_pbl_nudging_t == 1 ) THEN
+   
+     DO j=jts,jtf
+     DO i=its,itf
+
+       kpbl = 1
+       zpbl = pblh(i,j)
+        
+       loop_kt: DO k=kts,ktf
+         zagl     = z(i,k,j)-ht(i,j)
+         zagl_bot = z_at_w(i,k,  j)-ht(i,j)
+         zagl_top = z_at_w(i,k+1,j)-ht(i,j)
+         IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
+           kpbl = k
+           EXIT loop_kt
+         ENDIF
+       ENDDO loop_kt
+
+       DO k=kts,ktf
+         IF( k <= kpbl   ) wpbl(i, k, j, 3) = 0.0
+         IF( k == kpbl+1 ) wpbl(i, k, j, 3) = 0.1
+         IF( k >  kpbl+1 ) wpbl(i, k, j, 3) = 1.0
+       ENDDO 
+        
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   IF( if_no_pbl_nudging_q == 1 ) THEN
+   
+     DO j=jts,jtf
+     DO i=its,itf
+
+       kpbl = 1
+       zpbl = pblh(i,j)
+          
+       loop_kq: DO k=kts,ktf
+         zagl     = z(i,k,j)-ht(i,j)
+         zagl_bot = z_at_w(i,k,  j)-ht(i,j)
+         zagl_top = z_at_w(i,k+1,j)-ht(i,j)
+         IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
+           kpbl = k
+           EXIT loop_kq
+         ENDIF
+       ENDDO loop_kq
+
+       DO k=kts,ktf
+         IF( k <= kpbl   ) wpbl(i, k, j, 4) = 0.0
+         IF( k == kpbl+1 ) wpbl(i, k, j, 4) = 0.1
+         IF( k >  kpbl+1 ) wpbl(i, k, j, 4) = 1.0
+       ENDDO 
+            
+     ENDDO  
+     ENDDO
+        
+   ENDIF
+!
+! If the user-defined namelist switches (if_zfac_uv, if_zfac_t,
+! if_zfac_q swithes) are set to 1, compute the weighting function, wzfac(k,:),
+! based on the namelist specified k values (k_zfac_uv, k_zfac_t and k_zfac_q) below which analysis 
+! nudging is turned off (wzfac = 1 above k_zfac_x and = 0 in below k_zfac_x).  If all
+! the switche are set to zero, wzfac = 1 (default value).
+!
+   wzfac(:,:) = 1.0
+
+   IF( if_zfac_uv == 1 ) THEN
+
+     DO j=jts,jtf
+     DO i=itsu,itf
+     DO k=kts,ktf
+       IF( k <= k_zfac_uv   ) wzfac(k, 1:2) = 0.0
+       IF( k == k_zfac_uv+1 ) wzfac(k, 1:2) = 0.1
+       IF( k >  k_zfac_uv+1 ) wzfac(k, 1:2) = 1.0
+     ENDDO
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   IF( if_zfac_t == 1 ) THEN
+
+     DO j=jts,jtf
+     DO i=itsu,itf
+     DO k=kts,ktf
+       IF( k <= k_zfac_t   ) wzfac(k, 3) = 0.0
+       IF( k == k_zfac_t+1 ) wzfac(k, 3) = 0.1
+       IF( k >  k_zfac_t+1 ) wzfac(k, 3) = 1.0
+     ENDDO
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   IF( if_zfac_q == 1 ) THEN
+       
+     DO j=jts,jtf
+     DO i=itsu,itf 
+     DO k=kts,ktf
+       IF( k <= k_zfac_q   ) wzfac(k, 4) = 0.0
+       IF( k == k_zfac_q+1 ) wzfac(k, 4) = 0.1 
+       IF( k >  k_zfac_q+1 ) wzfac(k, 4) = 1.0
+     ENDDO  
+     ENDDO
+     ENDDO
+
+   ENDIF
+!
+! If if_ramping and dtramp_min are defined by user, comput a time weighting function, tfac, 
+! for analysis nudging so that at the end of the nudging period (which has to be at a 
+! analysis time) we ramp down the nudging coefficient, based on the use-defined sign of dtramp_min.
+!
+! When dtramp_min is negative, ramping ends at end_fdda_hour and starts at 
+! end_fdda_hour-ABS(dtramp_min).  
+!
+! When dtramp_min is positive, ramping starts at end_fdda_hour and ends at 
+! end_fdda_hour+ABS(dtramp_min). In this case, the obs values are extrapolated using 
+! the obs tendency saved from the previous FDDA wondow.  More specifically for extrapolation, 
+! coef (see codes below) is recalculated to reflect extrapolation during the ramping period.
+!
+   tfac = 1.0
+
+   IF( if_ramping == 1 .AND. ABS(dtramp_min) > 0.0 ) THEN
+ 
+     IF( dtramp_min <= 0.0 ) THEN
+       actual_end_fdda_min = end_fdda_hour*60.0
+     ELSE
+       actual_end_fdda_min = end_fdda_hour*60.0 + dtramp_min
+     ENDIF
+
+     IF( xtime < actual_end_fdda_min-ABS(dtramp_min) )THEN 
+       tfac = 1.0
+     ELSEIF( xtime >= actual_end_fdda_min-ABS(dtramp_min) .AND. xtime <= actual_end_fdda_min )THEN
+       tfac = ( actual_end_fdda_min - xtime ) / ABS(dtramp_min)
+       IF( dtramp_min > 0.0 ) coef = (xtime-xtime_old+analysis_interval*60.0)/(analysis_interval*60.0)
+     ELSE                                                     
+       tfac = 0.0
+     ENDIF
+
+   ENDIF                                                  
+!
+! Compute 3-D nudging tendencies for u, v, t and q
+!
+   DO j=jts,jtf
+   DO k=kts,ktf
+   DO i=itsu,itf
+     val_analysis = u_ndg_old(i,k,j) *( 1.0 - coef ) + u_ndg_new(i,k,j) * coef
+     RUNDGDTEN(i,k,j) = guv * wpbl(i,k,j,1) * wzfac(k,1) * tfac * &
+                         ( val_analysis - u3d(i,k,j) )
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j=jtsv,jtf
+   DO k=kts,ktf
+   DO i=its,itf
+     val_analysis = v_ndg_old(i,k,j) *( 1.0 - coef ) + v_ndg_new(i,k,j) * coef
+     RVNDGDTEN(i,k,j) = guv * wpbl(i,k,j,2) * wzfac(k,2) * tfac * &
+                       ( val_analysis - v3d(i,k,j) )
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j=jts,jtf
+   DO k=kts,ktf
+   DO i=its,itf
+     val_analysis = t_ndg_old(i,k,j) *( 1.0 - coef ) + t_ndg_new(i,k,j) * coef
+     RTHNDGDTEN(i,k,j) =  gt * wpbl(i,k,j,3) * wzfac(k,3) * tfac * &
+                          ( val_analysis - th3d(i,k,j) + 300.0 )
+
+     val_analysis = q_ndg_old(i,k,j) *( 1.0 - coef ) + q_ndg_new(i,k,j) * coef
+     RQVNDGDTEN(i,k,j) =  gq * wpbl(i,k,j,4) * wzfac(k,4) * tfac * &
+                          ( val_analysis - qv3d(i,k,j) )
+   ENDDO
+   ENDDO
+   ENDDO
+
+   END SUBROUTINE fddagd
+
+
+   SUBROUTINE fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,&
+               run_hours,  &
+               if_no_pbl_nudging_uv, if_no_pbl_nudging_t, if_no_pbl_nudging_q, &
+               if_zfac_uv, k_zfac_uv, if_zfac_t, k_zfac_t, if_zfac_q, k_zfac_q, &
+               guv, gt, gq, if_ramping, dtramp_min, end_fdda_hour, &
+                      restart, allowed_to_read,                    &
+                      ids, ide, jds, jde, kds, kde,                &
+                      ims, ime, jms, jme, kms, kme,                &
+                      its, ite, jts, jte, kts, kte                 )
+!-------------------------------------------------------------------
+   IMPLICIT NONE
+!-------------------------------------------------------------------
+!
+   INTEGER , INTENT(IN)         ::  id
+   LOGICAL, INTENT(IN)          ::  restart, allowed_to_read
+   INTEGER, INTENT(IN)          ::  ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(OUT) :: &
+                                                       rundgdten, &
+                                                       rvndgdten, &
+                                                      rthndgdten, &
+                                                      rqvndgdten
+   INTEGER,  INTENT(IN)   ::      run_hours
+   INTEGER,  INTENT(IN)   ::      if_no_pbl_nudging_uv, if_no_pbl_nudging_t, &
+                                  if_no_pbl_nudging_q, end_fdda_hour
+   INTEGER,  INTENT(IN)   ::      if_zfac_uv, if_zfac_t, if_zfac_q
+   INTEGER,  INTENT(IN)   ::      k_zfac_uv,  k_zfac_t,  k_zfac_q
+   INTEGER,  INTENT(IN)   ::      if_ramping
+   REAL,     INTENT(IN)   ::      dtramp_min
+   REAL, INTENT(IN)       ::      guv, gt, gq
+   REAL                   ::      actual_end_fdda_min
+
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: rmundgdten
+   INTEGER :: i, j, k
+
+   LOGICAL , EXTERNAL     ::      wrf_dm_on_monitor
+
+   CHARACTER (LEN=256) :: message
+
+   IF ( wrf_dm_on_monitor() ) THEN  
+
+     IF( guv > 0.0 ) THEN
+       WRITE(message,'(a,i1,a,e12.4)') &
+           'D0',id,' Analysis nudging for wind is turned on and Guv= ', guv
+       CALL wrf_message(TRIM(message))
+     ELSE IF( guv < 0.0 ) THEN
+       CALL wrf_error_fatal('In grid FDDA, Guv must be positive.')
+     ELSE 
+       WRITE(message,'(a,i1,a,e12.4)') &
+           'D0',id,' Analysis nudging for wind is turned off and Guv= ', guv
+       CALL wrf_message(TRIM(message))
+     ENDIF
+
+     IF( gt > 0.0 ) THEN
+       WRITE(message,'(a,i1,a,e12.4)') &
+           'D0',id,' Analysis nudging for temperature is turned on and Gt= ', gt
+       CALL wrf_message(TRIM(message))
+     ELSE IF( gt < 0.0 ) THEN
+       CALL wrf_error_fatal('In grid FDDA, Gt must be positive.')
+     ELSE 
+       WRITE(message,'(a,i1,a,e12.4)') &
+           'D0',id,' Analysis nudging for temperature is turned off and Gt= ', gt
+       CALL wrf_message(TRIM(message))
+     ENDIF
+
+     IF( gq > 0.0 ) THEN
+       WRITE(message,'(a,i1,a,e12.4)') &
+         'D0',id,' Analysis nudging for water vapor mixing ratio is turned on and Gq= ', gq
+       CALL wrf_message(TRIM(message))
+     ELSE IF( gq < 0.0 ) THEN
+       CALL wrf_error_fatal('In grid FDDA, Gq must be positive.')
+     ELSE
+       WRITE(message,'(a,i1,a,e12.4)') &
+         'D0',id,' Analysis nudging for water vapor mixing ratio is turned off and Gq= ', gq
+       CALL wrf_message(TRIM(message))
+     ENDIF
+
+     IF( guv > 0.0 .AND. if_no_pbl_nudging_uv == 1 ) THEN
+        WRITE(message,'(a,i1,a)') &
+           'D0',id,' Analysis nudging for wind is turned off within the PBL.'
+        CALL wrf_message(TRIM(message))
+     ENDIF
+
+     IF( gt > 0.0 .AND. if_no_pbl_nudging_t == 1 ) THEN
+        WRITE(message,'(a,i1,a)') &
+           'D0',id,' Analysis nudging for temperature is turned off within the PBL.'
+        CALL wrf_message(TRIM(message))
+     ENDIF
+
+     IF( gq > 0.0 .AND. if_no_pbl_nudging_q == 1 ) THEN
+        WRITE(message,'(a,i1,a)') &
+         'D0',id,' Analysis nudging for water vapor mixing ratio is turned off within the PBL.'
+        CALL wrf_message(TRIM(message))
+     ENDIF
+
+     IF( guv > 0.0 .AND. if_zfac_uv == 1 ) THEN
+        WRITE(message,'(a,i1,a,i3)') &
+           'D0',id,' Analysis nudging for wind is turned off below layer', k_zfac_uv
+        CALL wrf_message(TRIM(message))
+     ENDIF
+
+     IF( gt > 0.0 .AND. if_zfac_t == 1 ) THEN
+        WRITE(message,'(a,i1,a,i3)') &
+           'D0',id,' Analysis nudging for temperature is turned off below layer', k_zfac_t
+        CALL wrf_message(TRIM(message))
+     ENDIF
+
+     IF( gq > 0.0 .AND. if_zfac_q == 1 ) THEN
+        WRITE(message,'(a,i1,a,i3)') &
+          'D0',id,' Analysis nudging for water vapor mixing ratio is turned off below layer', &
+           k_zfac_q
+        CALL wrf_message(TRIM(message))
+     ENDIF
+
+     IF( if_ramping == 1 .AND. ABS(dtramp_min) > 0.0 ) THEN
+       IF( dtramp_min <= 0.0 ) THEN
+         actual_end_fdda_min = end_fdda_hour*60.0
+       ELSE
+         actual_end_fdda_min = end_fdda_hour*60.0 + ABS(dtramp_min)
+       ENDIF
+
+       IF( actual_end_fdda_min <= run_hours*60. ) THEN
+          WRITE(message,'(a,i1,a)') &
+            'D0',id,' Analysis nudging is ramped down near the end of the nudging period,'
+          CALL wrf_message(TRIM(message))
+
+          WRITE(message,'(a,f6.2,a,f6.2,a)') &
+             '      starting at ', (actual_end_fdda_min - ABS(dtramp_min))/60.0, &
+             'h, ending at ', actual_end_fdda_min/60.0,'h.'
+          CALL wrf_message(TRIM(message))
+       ENDIF
+     ENDIF
+
+   ENDIF
+
+   IF(.not.restart) THEN
+     DO j = jts,jte
+     DO k = kts,kte
+     DO i = its,ite
+        rundgdten(i,k,j) = 0.
+        rvndgdten(i,k,j) = 0.
+        rthndgdten(i,k,j) = 0.
+        rqvndgdten(i,k,j) = 0.
+        if(k.eq.kts) rmundgdten(i,j) = 0.
+     ENDDO
+     ENDDO
+     ENDDO
+   ENDIF
+
+   END SUBROUTINE fddagdinit
+!-------------------------------------------------------------------
+END MODULE module_fdda_psufddagd
Index: trunk/WRF.COMMON/WRFV2/phys/module_fddagd_driver.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_fddagd_driver.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_fddagd_driver.F	(revision 2744)
@@ -0,0 +1,277 @@
+!WRF:MEDIATION_LAYER:PHYSICS
+!
+
+MODULE module_fddagd_driver
+CONTAINS
+
+!------------------------------------------------------------------
+   SUBROUTINE fddagd_driver(itimestep,dt,xtime,                   &
+                  id,  &
+                  RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,                 &
+                  RQVNDGDTEN,RMUNDGDTEN,                          &
+                  u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old,       &
+                  u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new,       &
+                  u3d,v3d,th_phy,rho,moist,                       &
+                  p_phy,pi_phy,p8w,t_phy,dz8w,z,z_at_w,           &
+                  config_flags,DX,n_moist,                        &
+                  STEPFG,                                         &
+                  pblh,ht,                                        &
+                  ids,ide, jds,jde, kds,kde,                      &
+                  ims,ime, jms,jme, kms,kme,                      &
+                  i_start,i_end, j_start,j_end, kts,kte, num_tiles)
+!------------------------------------------------------------------
+   USE module_configure
+   USE module_state_description
+   USE module_model_constants
+
+! *** add new modules of schemes here
+
+   USE module_fdda_psufddagd
+!------------------------------------------------------------------
+   IMPLICIT NONE
+!======================================================================
+! Grid structure in physics part of WRF
+!----------------------------------------------------------------------
+! The horizontal velocities used in the physics are unstaggered
+! relative to temperature/moisture variables. All predicted
+! variables are carried at half levels except w, which is at full
+! levels. Some arrays with names (*8w) are at w (full) levels.
+!
+!----------------------------------------------------------------------
+! In WRF, kms (smallest number) is the bottom level and kme (largest
+! number) is the top level.  In your scheme, if 1 is at the top level,
+! then you have to reverse the order in the k direction.
+!
+!         kme      -   half level (no data at this level)
+!         kme    ----- full level
+!         kme-1    -   half level
+!         kme-1  ----- full level
+!         .
+!         .
+!         .
+!         kms+2    -   half level
+!         kms+2  ----- full level
+!         kms+1    -   half level
+!         kms+1  ----- full level
+!         kms      -   half level
+!         kms    ----- full level
+!
+!======================================================================
+!-- RUNDGDTEN       U tendency due to 
+!                 FDDA analysis nudging (m/s^2)
+!-- RVNDGDTEN       V tendency due to 
+!                 FDDA analysis nudging (m/s^2)
+!-- RTHNDGDTEN      Theta tendency due to 
+!                 FDDA analysis nudging (K/s)
+!-- RQVNDGDTEN      Qv tendency due to 
+!                 FDDA analysis nudging (kg/kg/s)
+!-- RMUNDGDTEN      mu tendency due to 
+!                 FDDA analysis nudging (Pa/s)
+!-- itimestep     number of time steps
+!-- u3d           u-velocity staggered on u points (m/s)
+!-- v3d           v-velocity staggered on v points (m/s)
+!-- th_phy        potential temperature (K)
+!-- moist         moisture array (4D - last index is species) (kg/kg)
+!-- p_phy         pressure (Pa)
+!-- pi_phy        exner function (dimensionless)
+!-- p8w           pressure at full levels (Pa)
+!-- t_phy         temperature (K)
+!-- dz8w          dz between full levels (m)
+!-- z             height above sea level (m)
+!-- config_flags
+!-- DX            horizontal space interval (m)
+!-- DT            time step (second)
+!-- n_moist       number of moisture species
+!-- STEPFG        number of timesteps per FDDA re-calculation
+!-- KPBL          k-index of PBL top
+!-- ids           start index for i in domain
+!-- ide           end index for i in domain
+!-- jds           start index for j in domain
+!-- jde           end index for j in domain
+!-- kds           start index for k in domain
+!-- kde           end index for k in domain
+!-- ims           start index for i in memory
+!-- ime           end index for i in memory
+!-- jms           start index for j in memory
+!-- jme           end index for j in memory
+!-- kms           start index for k in memory
+!-- kme           end index for k in memory
+!-- jts           start index for j in tile
+!-- jte           end index for j in tile
+!-- kts           start index for k in tile
+!-- kte           end index for k in tile
+!
+!******************************************************************
+!------------------------------------------------------------------ 
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+!
+
+   INTEGER , INTENT(IN)         ::     id
+
+   INTEGER,    INTENT(IN   )    ::     ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       kts,kte, num_tiles,        &
+                                       n_moist           
+
+   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                   &
+  &                                    i_start,i_end,j_start,j_end
+
+   INTEGER,    INTENT(IN   )    ::     itimestep,STEPFG
+!
+   REAL,       INTENT(IN   )    ::     DT,DX,XTIME
+
+
+!
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
+               INTENT(IN   )    ::                         p_phy, &
+                                                          pi_phy, &
+                                                             p8w, &
+                                                             rho, &
+                                                           t_phy, &
+                                                             u3d, &
+                                                             v3d, &
+                                                            dz8w, &
+                                                               z, &
+                                                          z_at_w, &
+                                                          th_phy
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ),         &
+         INTENT(IN ) ::                                    moist
+!
+!
+!
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
+               INTENT(INOUT)    ::                       RUNDGDTEN, &
+                                                         RVNDGDTEN, &
+                                                        RTHNDGDTEN, &
+                                                        RQVNDGDTEN
+
+   REAL,       DIMENSION( ims:ime,  jms:jme ),            &
+               INTENT(INOUT)    ::                      RMUNDGDTEN
+
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
+               INTENT(INOUT)    ::                       u_ndg_old, &
+                                                         v_ndg_old, &
+                                                         t_ndg_old, &
+                                                         q_ndg_old, &
+                                                         u_ndg_new, &
+                                                         v_ndg_new, &
+                                                         t_ndg_new, &
+                                                         q_ndg_new
+   REAL,       DIMENSION( ims:ime,  jms:jme ),            &
+               INTENT(INOUT)    ::                       mu_ndg_old, &
+                                                         mu_ndg_new
+
+!
+   REAL,    DIMENSION( ims:ime , jms:jme ),     &
+               INTENT(IN   ) ::           pblh, &
+                                            ht
+
+!  LOCAL  VAR
+
+!
+   INTEGER :: i,J,K,NK,jj,ij
+
+!------------------------------------------------------------------
+!
+#if  ! ( NMM_CORE == 1 )
+  if (config_flags%grid_fdda .eq. 0) return
+
+  IF (itimestep == 1) THEN
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij,i,j,k )
+   DO ij = 1 , num_tiles
+      DO j=j_start(ij),j_end(ij)
+      DO i=i_start(ij),i_end(ij)
+
+         DO k=kts,min(kte+1,kde)
+            u_ndg_old(i,k,j) = u3d(i,k,j)
+            v_ndg_old(i,k,j) = v3d(i,k,j)
+            t_ndg_old(i,k,j) = th_phy(i,k,j) - 300.0
+            q_ndg_old(i,k,j) = moist(i,k,j,P_QV)
+         ENDDO
+         mu_ndg_old(i,j) = 0.0
+
+      ENDDO
+      ENDDO
+
+   ENDDO
+   !$OMP END PARALLEL DO
+
+  ENDIF
+
+  IF (itimestep .eq. 1 .or. mod(itimestep,STEPFG) .eq. 0) THEN
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij,i,j,k )
+   DO ij = 1 , num_tiles
+      DO j=j_start(ij),j_end(ij)
+      DO i=i_start(ij),i_end(ij)
+
+         DO k=kts,min(kte+1,kde)
+            RTHNDGDTEN(I,K,J)=0.
+            RUNDGDTEN(I,K,J)=0.
+            RVNDGDTEN(I,K,J)=0.
+            RQVNDGDTEN(I,K,J)=0.
+         ENDDO
+
+         RMUNDGDTEN(I,J)=0.
+
+      ENDDO
+      ENDDO
+
+   ENDDO
+   !$OMP END PARALLEL DO
+!
+  !$OMP PARALLEL DO   &
+  !$OMP PRIVATE ( ij, i,j,k )
+  DO ij = 1 , num_tiles
+   fdda_select: SELECT CASE(config_flags%grid_fdda)
+
+      CASE (PSUFDDAGD)
+        CALL wrf_debug(100,'in PSU FDDA scheme')
+           CALL FDDAGD(itimestep,dt,xtime, &
+               id, &
+               config_flags%gfdda_interval_m, &
+               config_flags%gfdda_end_h, &
+               config_flags%if_no_pbl_nudging_uv, &
+               config_flags%if_no_pbl_nudging_t, &
+               config_flags%if_no_pbl_nudging_q, &
+               config_flags%if_zfac_uv, &
+               config_flags%k_zfac_uv, &
+               config_flags%if_zfac_t, &
+               config_flags%k_zfac_t, &
+               config_flags%if_zfac_q, &
+               config_flags%k_zfac_q, &
+               config_flags%guv, &
+               config_flags%gt, config_flags%gq, &
+               config_flags%if_ramping, config_flags%dtramp_min, &
+               u3d,v3d,th_phy,t_phy,                 &
+               moist(ims,kms,jms,P_QV),     &
+               p_phy,pi_phy,                &
+               u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old,       &
+               u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new,       &
+               RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,&
+               pblh, ht, z, z_at_w,                             &
+               ids,ide, jds,jde, kds,kde,                           &
+               ims,ime, jms,jme, kms,kme,                           &
+               i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte  )
+
+
+     CASE DEFAULT
+
+       WRITE( wrf_err_message , * ) 'The fdda option does not exist: grid_fdda = ', config_flags%grid_fdda
+       CALL wrf_error_fatal ( wrf_err_message )
+
+   END SELECT fdda_select
+
+   ENDDO
+   !$OMP END PARALLEL DO
+
+   ENDIF
+
+#endif
+!
+   END SUBROUTINE fddagd_driver
+END MODULE module_fddagd_driver
Index: trunk/WRF.COMMON/WRFV2/phys/module_fddaobs_driver.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_fddaobs_driver.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_fddaobs_driver.F	(revision 2744)
@@ -0,0 +1,384 @@
+!WRF:MODEL_LAYER:PHYSICS
+MODULE module_fddaobs_driver
+
+! This obs-nudging FDDA module (RTFDDA) is developed by the 
+! NCAR/RAL/NSAP (National Security Application Programs), under the 
+! sponsorship of ATEC (Army Test and Evaluation Commands). ATEC is 
+! acknowledged for releasing this capability for WRF community 
+! research applications.
+!
+! The NCAR/RAL RTFDDA module was adapted, and significantly modified 
+! from the obs-nudging module in the standard MM5V3.1 which was originally 
+! developed by PSU (Stauffer and Seaman, 1994). 
+! 
+! Yubao Liu (NCAR/RAL): lead developer of the RTFDDA module 
+! Al Bourgeois (NCAR/RAL): lead engineer implementing RTFDDA into WRF-ARW
+! Nov. 2006
+! 
+! References:
+!   
+!   Liu, Y., A. Bourgeois, T. Warner, S. Swerdlin and J. Hacker, 2005: An
+!     implementation of obs-nudging-based FDDA into WRF for supporting 
+!     ATEC test operations. 2005 WRF user workshop. Paper 10.7.
+!
+!   Liu, Y., A. Bourgeois, T. Warner, S. Swerdlin and W. Yu, 2006: An update 
+!     on "obs-nudging"-based FDDA for WRF-ARW: Verification using OSSE 
+!     and performance of real-time forecasts. 2006 WRF user workshop. Paper 4.7. 
+
+!   
+!   Stauffer, D.R., and N.L. Seaman, 1994: Multi-scale four-dimensional data 
+!     assimilation. J. Appl. Meteor., 33, 416-434.
+!
+!   http://www.rap.ucar.edu/projects/armyrange/references.html
+!
+ 
+CONTAINS
+
+!-----------------------------------------------------------------------
+SUBROUTINE fddaobs_driver( inest, domid, parid, restart,         &
+               nudge_opt, iprt_errob, iprt_nudob,                &
+               fdasta, fdaend,                                   &
+               nudge_wind, nudge_temp, nudge_mois,               &
+               nudge_pstr,                                       &
+               coef_wind, coef_temp, coef_mois,                  &
+               coef_pstr, rinxy, rinsig, twindo,                 &
+               npfi, ionf, idynin, dtramp,                       &
+               xlatc_cg, xlonc_cg, true_lat1, true_lat2,         &
+               map_proj, i_parent_start, j_parent_start,         &
+               parent_grid_ratio, maxdom, itimestep,             &
+               dt, gmt, julday,                                  &
+#if ( EM_CORE == 1 ) 
+               fdob,                                             &
+#endif
+               max_obs, nobs_ndg_vars,    &
+               nobs_err_flds, nstat, varobs, errf, dx,           &
+               KPBL, HT, mut, muu, muv,                          &
+               msft, msfu, msfv, p_phy, t_tendf, t0,             &
+               ub, vb, tb, qvb, pbase, ptop, pp,                 &
+               uratx, vratx, tratx, ru_tendf, rv_tendf,          &
+               moist_tend, savwt,                                &
+               ids,ide, jds,jde, kds,kde,                        & ! domain dims
+               ims,ime, jms,jme, kms,kme,                        & ! memory dims
+               its,ite, jts,jte, kts,kte                         ) ! tile   dims
+
+!-----------------------------------------------------------------------
+  USE module_domain
+  USE module_bc
+  USE module_model_constants, ONLY : rovg, rcp
+  USE module_fddaobs_rtfdda
+
+! This driver calls subroutines for fdda obs-nudging and
+! returns computed tendencies
+
+!
+!-----------------------------------------------------------------------
+  IMPLICIT NONE
+!-----------------------------------------------------------------------
+! taken from MM5 code - 03 Feb 2004.
+!-----------------------------------------------------------------------
+
+!=======================================================================
+! Definitions
+!-----------
+!-- KPBL          vertical layer index for PBL top
+!-- HT            terrain height (m)
+!-- p_phy         pressure (Pa)
+!-- t_tendf       temperature tendency
+
+  INTEGER, intent(in)  :: ids,ide, jds,jde, kds,kde  ! domain dims.
+  INTEGER, intent(in)  :: ims,ime, jms,jme, kms,kme  ! memory dims.
+  INTEGER, intent(in)  :: its,ite, jts,jte, kts,kte  ! tile   dims.
+
+  INTEGER, intent(in)  :: inest
+  INTEGER, intent(in)  :: maxdom
+  INTEGER, intent(in)  :: domid(maxdom)           ! Domain IDs
+  INTEGER, intent(in)  :: parid(maxdom)           ! Parent domain IDs
+  LOGICAL, intent(in)  :: restart
+  INTEGER, intent(in)  :: itimestep
+  INTEGER, intent(in)  :: nudge_opt
+  LOGICAL, intent(in)  :: iprt_errob 
+  LOGICAL, intent(in)  :: iprt_nudob 
+  REAL, intent(in)     :: fdasta
+  REAL, intent(in)     :: fdaend
+  INTEGER, intent(in)  :: nudge_wind
+  INTEGER, intent(in)  :: nudge_temp
+  INTEGER, intent(in)  :: nudge_mois
+  INTEGER, intent(in)  :: nudge_pstr
+  REAL, intent(in) :: coef_wind
+  REAL, intent(in) :: coef_temp
+  REAL, intent(in) :: coef_mois
+  REAL, intent(in) :: coef_pstr
+  REAL, intent(inout)  :: rinxy
+  REAL, intent(inout)  :: rinsig
+  REAL, intent(inout)  :: twindo
+  INTEGER, intent(in) :: npfi
+  INTEGER, intent(in) :: ionf
+  INTEGER, intent(in) :: idynin
+  REAL, intent(inout) :: dtramp
+  REAL, intent(in) :: xlatc_cg         ! center latitude  of coarse grid
+  REAL, intent(in) :: xlonc_cg         ! center longitude of coarse grid
+  REAL, intent(in) :: true_lat1
+  REAL, intent(in) :: true_lat2
+  INTEGER, intent(in) :: map_proj
+  INTEGER, intent(in) :: i_parent_start(maxdom)
+  INTEGER, intent(in) :: j_parent_start(maxdom)
+  INTEGER, intent(in) :: parent_grid_ratio
+  REAL, intent(in)     :: dt
+  REAL, intent(in)     :: gmt
+  INTEGER, intent(in)  :: julday
+  INTEGER, intent(in)  :: max_obs         ! max number of observations
+  INTEGER, intent(in)  :: nobs_ndg_vars
+  INTEGER, intent(in)  :: nobs_err_flds
+  INTEGER, intent(in)  :: nstat
+  REAL, intent(inout)  :: varobs(nobs_ndg_vars, max_obs)
+  REAL, intent(inout)  :: errf(nobs_err_flds, max_obs)
+  REAL, intent(in)     :: dx           ! this-domain grid cell-size (m)
+  INTEGER, INTENT(IN) :: kpbl( ims:ime, jms:jme )
+  REAL, INTENT(IN) :: ht( ims:ime, jms:jme )
+  REAL, INTENT(IN) :: mut( ims:ime , jms:jme )   ! Air mass on t-grid 
+  REAL, INTENT(IN) :: muu( ims:ime , jms:jme )   ! Air mass on u-grid 
+  REAL, INTENT(IN) :: muv( ims:ime , jms:jme )   ! Air mass on v-grid
+  REAL, INTENT(IN) :: msft( ims:ime , jms:jme )  ! Map scale on t-grid
+  REAL, INTENT(IN) :: msfu( ims:ime , jms:jme )  ! Map scale on u-grid
+  REAL, INTENT(IN) :: msfv( ims:ime , jms:jme )  ! Map scale on v-grid
+
+  REAL, INTENT(IN) :: p_phy( ims:ime, kms:kme, jms:jme )
+  REAL, INTENT(INOUT) :: t_tendf( ims:ime, kms:kme, jms:jme )
+  REAL, INTENT(IN) :: t0
+  REAL, INTENT(INOUT) :: savwt( nobs_ndg_vars, ims:ime, kms:kme, jms:jme )
+
+#if ( EM_CORE == 1 ) 
+  TYPE(fdob_type), intent(inout)  :: fdob
+#endif
+
+  REAL,   INTENT(IN) :: ub( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(IN) :: vb( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(IN) :: tb( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(IN) :: qvb( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(IN) :: pbase( ims:ime, kms:kme, jms:jme ) ! Base press. (Pa)
+  REAL,   INTENT(IN) :: ptop
+  REAL,   INTENT(IN) :: pp( ims:ime, kms:kme, jms:jme )  ! Press. pert. (Pa)
+  REAL,   INTENT(IN) :: uratx( ims:ime, jms:jme )     ! On mass points
+  REAL,   INTENT(IN) :: vratx( ims:ime, jms:jme )     !       "
+  REAL,   INTENT(IN) :: tratx( ims:ime, jms:jme )     !       "
+  REAL,   INTENT(INOUT) :: ru_tendf( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(INOUT) :: rv_tendf( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(INOUT) :: moist_tend( ims:ime, kms:kme, jms:jme )
+
+! Local variables
+  logical            :: nudge_flag   ! Flag for doing nudging 
+  integer            :: KTAU         ! Forecast timestep
+  real               :: xtime        ! Forecast time in minutes
+  real               :: dtmin        ! dt in minutes
+  integer            :: i, j, k      ! Loop counters.
+  integer            :: idom         ! Loop counter.
+  integer            :: nsta         ! Number of observation stations
+  integer            :: infr         ! Frequency for obs input and error calc 
+  integer            :: idarst       ! Flag for calling sub errob on restart
+  real               :: dtr          ! Abs value of dtramp (for dynamic init)
+  real               :: tconst       ! Reciprocal of dtr
+  integer :: KPBLJ(its:ite)          ! 1D temp array.
+#ifdef RAL
+  real    :: HTIJ(ids:ide, jds:jde) = 0.  ! Terrain ht on global grid.
+#endif
+
+#if ( EM_CORE == 1 ) 
+  nudge_flag = (nudge_opt  .eq. 1)
+
+  if (.not. nudge_flag) return
+
+!----------------------------------------------------------------------
+! ***************       BEGIN FDDA SETUP SECTION        ***************
+
+! Calculate forecast time.
+  dtmin = dt/60.     
+  xtime = dtmin*(itimestep-1)
+
+  ktau  = itimestep - 1        !ktau corresponds to xtime
+
+! DEFINE NSTA WHEN NOT NUDGING TO IND. OBS.
+! print *,'in fddaobs_driver, xtime=',xtime
+  IF(ktau.EQ.fdob%ktaur) THEN
+     IF (iprt_nudob) PRINT *,3333,fdob%domain_tot
+!    print *,'ktau,ktaur,inest=',ktau,fdob%ktaur,inest
+3333 FORMAT(1X,'IN fddaobs_driver: I4DITOT = ',I2)
+     nsta=0.
+  ELSE
+     nsta=fdob%nstat
+  ENDIF
+  
+  infr = ionf*(parent_grid_ratio**fdob%levidn(inest))
+  nsta=fdob%nstat
+  idarst = 0
+  IF(restart .AND. ktau.EQ.fdob%ktaur) idarst=1
+
+! COMPUTE ERROR BETWEEN OBSERVATIONS and MODEL
+  IF( nsta.GT.0 ) THEN
+    IF( MOD(ktau,infr).EQ.0 .OR. idarst.EQ.1) THEN
+
+        CALL ERROB(inest, ub, vb, tb, t0, qvb, pbase, pp, rcp,       &
+                   uratx, vratx, tratx,                              &
+                   nobs_ndg_vars, nobs_err_flds, max_obs, maxdom,    &
+                   fdob%levidn, parid, fdob%nstat,                   &
+                   nudge_wind, nudge_temp, nudge_mois, nudge_pstr,   &
+                   fdob%rio, fdob%rjo, fdob%rko, varobs, errf,       &
+                   i_parent_start, j_parent_start, ktau,             &
+                   parent_grid_ratio, npfi, iprt_errob,              &
+                   ids,ide, jds,jde, kds,kde,                        &
+                   ims,ime, jms,jme, kms,kme,                        &
+                   its,ite, jts,jte, kts,kte)
+    ENDIF
+  ENDIF
+
+  fdob%tfaci=1.0
+  IF(idynin.EQ.1.AND.nudge_opt.EQ.1) THEN
+    dtr=ABS(dtramp)
+    tconst=1./dtr
+! FDAEND(IN) IS THE TIME IN MINUTES TO END THE DYNAMIC INITIALIZATION CY
+    IF(xtime.LT.fdaend-dtr)THEN
+      fdob%tfaci=1.
+    ELSEIF(xtime.GE.fdaend-dtr.AND.xtime.LE.fdaend) THEN
+      fdob%tfaci=(fdaend-xtime)*tconst
+    ELSE
+      fdob%tfaci=0.0
+    ENDIF
+    IF(ktau.EQ.fdob%ktaur.OR.MOD(ktau,10).EQ.0) THEN
+      IF (iprt_nudob)                                                  &
+         PRINT*,' DYNINOBS: IN,KTAU,XTIME,FDAEND,DTRAMP,DTR,TCONST',   &
+         ',TFACI: ',INEST,KTAU,XTIME,FDAEND,DTRAMP,DTR,TCONST,         &
+         fdob%TFACI
+    ENDIF
+  ENDIF
+
+#ifdef RAL
+! MEIXU: collect terrain array HT into a global array HTIJ
+  CALL loc2glob(HT, HTIJ, "2D", "REAL",                  &
+                ids,ide, jds,jde, kds,kde,               &
+                ims,ime, jms,jme, kms,kme )
+! MEIXU end
+#endif
+!
+! ***************        END FDDA SETUP SECTION         ***************
+!----------------------------------------------------------------------
+
+!----------------------------------------------------------------------
+! ***************         BEGIN NUDGING SECTION         ***************
+
+  DO J = jts, jte
+!
+! IF NUDGING SURFACE WINDS IN THE BOUNDARY LAYER, IF IWINDS(INEST+2)=1
+! USE A SIMILARITY CORRECTION BASED ON ROUGHNESS TO APPLY 10M
+! WIND TO THE SURFACE LAYER (K=KL) AT 40M.  TO DO THIS WE MUST
+! STORE ROUGHNESS AND REGIME FOR EACH J SLICE AFTER THE CALL TO
+! HIRPBL FOR LATER USE IN BLNUDGD.
+!
+     DO I=its,ite
+       KPBLJ(I)=KPBL(I,J)
+     ENDDO
+!
+!--- OBS NUDGING FOR TEMP AND MOISTURE
+!
+     NSTA=NSTAT
+     IF(J .GT. 2 .and. J .LT.fdob%sn_end) THEN
+       IF(nudge_temp.EQ.1 .AND. NSTA.GT.0)  &
+       THEN
+!         write(6,*) 'calling nudob: IVAR=3, J = ',j
+          CALL NUDOB(J, 3, t_tendf(ims,kms,j),                       &
+                  inest, restart, ktau, fdob%ktaur, xtime,           &
+                  mut(ims,j), msft(ims,j),                           &
+                  nobs_ndg_vars, nobs_err_flds, max_obs, maxdom,     &
+                  npfi, ionf, rinxy, twindo,                         &
+                  fdob%levidn,                                       &
+                  parid, nstat, i_parent_start, j_parent_start,      &
+                  fdob, fdob%lev_in_ob, fdob%plfo, fdob%nlevs_ob,    &
+                  parent_grid_ratio, dx, dtmin, fdob%rio, fdob%rjo,  &
+                  fdob%rko, fdob%timeob, varobs, errf,               &
+                  pbase(ims,kms,j), ptop, pp(ims,kms,j),             &
+                  nudge_wind, nudge_temp, nudge_mois,                &
+                  coef_wind, coef_temp, coef_mois,                   &
+                  savwt(1,ims,kms,j), kpblj, 0,                      &
+                  iprt_nudob,                                        &
+                  ids,ide, jds,jde, kds,kde,                         & ! domain dims
+                  ims,ime, jms,jme, kms,kme,                         & ! memory dims
+                  its,ite, jts,jte, kts,kte         )                  ! tile   dims
+!         write(6,*) 'return from nudob: IVAR=3, J = ',j
+       ENDIF
+
+       IF(nudge_mois.EQ.1 .AND. NSTA.GT.0)  &
+       THEN
+!         write(6,*) 'calling nudob: IVAR=4, J = ',j
+          CALL NUDOB(J, 4, moist_tend(ims,kms,j),                    &
+                  inest, restart, ktau, fdob%ktaur, xtime,           &
+                  mut(ims,j), msft(ims,j),                           &
+                  nobs_ndg_vars, nobs_err_flds, max_obs, maxdom,     &
+                  npfi, ionf, rinxy, twindo,                         &
+                  fdob%levidn,                                       &
+                  parid, nstat, i_parent_start, j_parent_start,      &
+                  fdob, fdob%lev_in_ob, fdob%plfo, fdob%nlevs_ob,    &
+                  parent_grid_ratio, dx, dtmin, fdob%rio, fdob%rjo,  &
+                  fdob%rko, fdob%timeob, varobs, errf,               &
+                  pbase(ims,kms,j), ptop, pp(ims,kms,j),             &
+                  nudge_wind, nudge_temp, nudge_mois,                &
+                  coef_wind, coef_temp, coef_mois,                   &
+                  savwt(1,ims,kms,j), kpblj, 0,                      &
+                  iprt_nudob,                                        &
+                  ids,ide, jds,jde, kds,kde,                         & ! domain dims
+                  ims,ime, jms,jme, kms,kme,                         & ! memory dims
+                  its,ite, jts,jte, kts,kte         )                  ! tile   dims
+!         write(6,*) 'return from nudob: IVAR=4, J = ',j
+       ENDIF
+     ENDIF
+
+     IF(nudge_wind.EQ.1 .AND. NSTA.GT.0)    &
+     THEN
+!       write(6,*) 'calling nudob: IVAR=1, J = ',j
+        CALL NUDOB(J, 1, ru_tendf(ims,kms,j),                        &
+                inest, restart, ktau, fdob%ktaur, xtime,             &
+                muu(ims,j), msfu(ims,j),                             &
+                nobs_ndg_vars, nobs_err_flds, max_obs, maxdom,       &
+                npfi, ionf, rinxy, twindo,                           &
+                fdob%levidn,                                         &
+                parid, nstat, i_parent_start, j_parent_start,        &
+                fdob, fdob%lev_in_ob, fdob%plfo, fdob%nlevs_ob,      &
+                parent_grid_ratio, dx, dtmin, fdob%rio, fdob%rjo,    &
+                fdob%rko, fdob%timeob, varobs, errf,                 &
+                pbase(ims,kms,j), ptop, pp(ims,kms,j),               &
+                nudge_wind, nudge_temp, nudge_mois,                  &
+                coef_wind, coef_temp, coef_mois,                     &
+                savwt(1,ims,kms,j), kpblj, 0,                        &
+                iprt_nudob,                                          &
+                ids,ide, jds,jde, kds,kde,                           & ! domain dims
+                ims,ime, jms,jme, kms,kme,                           & ! memory dims
+                its,ite, jts,jte, kts,kte         )                    ! tile   dims
+!       write(6,*) 'return from nudob: IVAR=1, J = ',j
+
+!       write(6,*) 'calling nudob: IVAR=2, J = ',j
+        CALL NUDOB(J, 2, rv_tendf(ims,kms,j),                        &
+                inest, restart, ktau, fdob%ktaur, xtime,             &
+                muv(ims,j), msfv(ims,j),                             &
+                nobs_ndg_vars, nobs_err_flds, max_obs, maxdom,       &
+                npfi, ionf, rinxy, twindo,                           &
+                fdob%levidn,                                         &
+                parid, nstat, i_parent_start, j_parent_start,        &
+                fdob, fdob%lev_in_ob, fdob%plfo, fdob%nlevs_ob,      &
+                parent_grid_ratio, dx, dtmin, fdob%rio, fdob%rjo,    &
+                fdob%rko, fdob%timeob, varobs, errf,                 &
+                pbase(ims,kms,j), ptop, pp(ims,kms,j),               &
+                nudge_wind, nudge_temp, nudge_mois,                  &
+                coef_wind, coef_temp, coef_mois,                     &
+                savwt(1,ims,kms,j), kpblj, 0,                        &
+                iprt_nudob,                                          &
+                ids,ide, jds,jde, kds,kde,                           & ! domain dims
+                ims,ime, jms,jme, kms,kme,                           & ! memory dims
+                its,ite, jts,jte, kts,kte         )                    ! tile   dims
+!       write(6,*) 'return from nudob: IVAR=2, J = ',j
+     ENDIF
+  ENDDO
+!
+! --- END OF 4DDA
+!
+  RETURN
+#endif
+  END SUBROUTINE fddaobs_driver
+
+END MODULE module_fddaobs_driver
Index: trunk/WRF.COMMON/WRFV2/phys/module_fddaobs_rtfdda.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_fddaobs_rtfdda.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_fddaobs_rtfdda.F	(revision 2744)
@@ -0,0 +1,2383 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+MODULE module_fddaobs_rtfdda
+
+! This obs-nudging FDDA module (RTFDDA) is developed by the 
+! NCAR/RAL/NSAP (National Security Application Programs), under the 
+! sponsorship of ATEC (Army Test and Evaluation Commands). ATEC is 
+! acknowledged for releasing this capability for WRF community 
+! research applications.
+!
+! The NCAR/RAL RTFDDA module was adapted, and significantly modified 
+! from the obs-nudging module in the standard MM5V3.1 which was originally 
+! developed by PSU (Stauffer and Seaman, 1994). 
+! 
+! Yubao Liu (NCAR/RAL): lead developer of the RTFDDA module 
+! Al Bourgeois (NCAR/RAL): lead engineer implementing RTFDDA into WRF-ARW
+! Nov. 2006
+! 
+! References:
+!   
+!   Liu, Y., A. Bourgeois, T. Warner, S. Swerdlin and J. Hacker, 2005: An
+!     implementation of obs-nudging-based FDDA into WRF for supporting 
+!     ATEC test operations. 2005 WRF user workshop. Paper 10.7.
+!
+!   Liu, Y., A. Bourgeois, T. Warner, S. Swerdlin and W. Yu, 2006: An update 
+!     on "obs-nudging"-based FDDA for WRF-ARW: Verification using OSSE 
+!     and performance of real-time forecasts. 2006 WRF user workshop. Paper 4.7. 
+
+!   
+!   Stauffer, D.R., and N.L. Seaman, 1994: Multi-scale four-dimensional data 
+!     assimilation. J. Appl. Meteor., 33, 416-434.
+!
+!   http://www.rap.ucar.edu/projects/armyrange/references.html
+!
+
+CONTAINS
+
+!------------------------------------------------------------------------------
+  SUBROUTINE fddaobs_init(obs_nudge_opt, maxdom, inest, parid,         &
+                          dx_coarse, restart, obs_twindo, itimestep,   &
+                          e_sn, s_sn_cg, e_sn_cg, s_we_cg, e_we_cg,    &
+#if ( EM_CORE == 1 )
+                          fdob,                                        &
+#endif
+                          ids,ide, jds,jde, kds,kde,                   &
+                          ims,ime, jms,jme, kms,kme,                   &
+                          its,ite, jts,jte, kts,kte)     
+!-----------------------------------------------------------------------
+!  This routine does initialization for real time fdda obs-nudging.
+!
+!-----------------------------------------------------------------------
+  USE module_domain
+!-----------------------------------------------------------------------
+  IMPLICIT NONE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+! Definitions
+!-----------
+  INTEGER, intent(in)  :: maxdom
+  INTEGER, intent(in)  :: obs_nudge_opt(maxdom)
+  INTEGER, intent(in)  :: ids,ide, jds,jde, kds,kde,                 &
+                          ims,ime, jms,jme, kms,kme,                 &
+                          its,ite, jts,jte, kts,kte
+  INTEGER, intent(in)  :: inest
+  INTEGER, intent(in)  :: parid(maxdom)
+  REAL    ,intent(in)  :: dx_coarse    ! coarse-domain grid cell-size (km)
+  LOGICAL, intent(in)  :: restart
+  REAL, intent(inout)  :: obs_twindo
+  INTEGER, intent(in)  :: itimestep
+  INTEGER, intent(in)  :: e_sn         ! ending   south-north grid index
+  INTEGER, intent(in)  :: s_sn_cg      ! starting south-north coarse-grid index
+  INTEGER, intent(in)  :: e_sn_cg      ! ending   south-north coarse-grid index
+  INTEGER, intent(in)  :: s_we_cg      ! starting west-east   coarse-grid index
+  INTEGER, intent(in)  :: e_we_cg      ! ending   west-east   coarse-grid index
+#if ( EM_CORE == 1 ) 
+  TYPE(fdob_type), intent(inout)  :: fdob
+#endif
+
+! Local variables
+  logical            :: nudge_flag      ! nudging flag for this nest 
+  integer            :: ktau            ! current timestep
+  integer            :: nest            ! loop counter
+  integer            :: idom            ! domain id
+  integer            :: parent          ! parent domain
+
+#if ( EM_CORE == 1 ) 
+! This routine should only be called once. This is a check to make
+! certain that initialization only happens once.
+  if (fdob%domain_init .ne. 1) then
+!   Obs-nudging will be initialized on this call
+    fdob%domain_init = 1
+  else
+!   Obs-nudging has already been initialized, so return
+    return
+  endif
+
+! Set flag for nudging on pressure (not sigma) surfaces
+  fdob%iwtsig = 0
+
+! Set ending nudging date (used with dynamic ramp-down) to zero.
+  fdob%datend = 0.
+
+! Convert twindo from minutes to hours.
+  obs_twindo = obs_twindo / 60.
+
+! Initialize flags.
+
+  fdob%domain_tot=0
+  do nest=1,maxdom
+    fdob%domain_tot = fdob%domain_tot + obs_nudge_opt(nest)
+  end do
+
+! Set parameters.
+
+  fdob%pfree = 50.0
+  fdob%rinfmn = 1.0
+  fdob%rinfmx = 2.0
+  fdob%dpsmx = 7.5
+  fdob%dcon = 1.0/fdob%dpsmx
+  fdob%xn = 0.7155668                     ! cone factor
+
+  fdob%ds_cg = dx_coarse / 1000.          ! coarse gridsize (km)
+  fdob%sn_maxcg = e_sn_cg - s_sn_cg + 1   ! coarse domain grid dimension in N-S 
+  fdob%we_maxcg = e_we_cg - s_we_cg + 1   ! coarse domain grid dimension in W-E
+  fdob%sn_end = e_sn - 1                  ! ending S-N grid coordinate
+
+! Calculate the nest levels, levidn. Note that each nest
+! must know the nest levels levidn(maxdom) of each domain.
+  do nest=1,maxdom
+
+! Initialize nest level for each domain.
+    if (nest .eq. 1) then
+      fdob%levidn(nest) = 0  ! Mother domain has nest level 0
+    else
+      fdob%levidn(nest) = 1  ! All other domains start with 1
+    endif
+    idom = nest
+100 parent = parid(idom)      ! Go up the parent tree
+      if (parent .gt. 1) then   ! If not up to mother domain
+        fdob%levidn(nest) = fdob%levidn(nest) + 1
+        idom = parid(parent)
+        goto 100
+      endif
+  enddo
+
+! Check to see if the nudging flag has been set. If not,
+! simply RETURN.
+  nudge_flag = (obs_nudge_opt(inest) .eq. 1)
+  if (.not. nudge_flag) return
+
+  ktau  = itimestep
+  if(restart) then
+    fdob%ktaur = ktau
+  else
+    fdob%ktaur = 0 
+  endif
+
+  RETURN
+#endif
+  END SUBROUTINE fddaobs_init
+
+#if ( EM_CORE == 1 )
+!-----------------------------------------------------------------------
+SUBROUTINE errob(inest, ub, vb, tb, t0, qvb, pbase, pp, rovcp,  &
+                 uratx, vratx, tratx, nndgv,                    & 
+                 nerrf, niobf, maxdom, levidn, parid, nstat,    &
+                 iswind,                                        &
+                 istemp, ismois, ispstr, rio, rjo, rko, varobs, &
+                 errf, i_parent_start, j_parent_start,          &
+                 ktau, iratio, npfi, iprt,                      &
+                 ids,ide, jds,jde, kds,kde,                     &
+                 ims,ime, jms,jme, kms,kme,                     &
+                 its,ite, jts,jte, kts,kte  )
+
+!-----------------------------------------------------------------------
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+  USE module_dm, ONLY : get_full_obs_vector
+#endif
+
+!-----------------------------------------------------------------------
+  IMPLICIT NONE
+!-----------------------------------------------------------------------
+!
+! PURPOSE: THIS SUBROUTINE CALCULATES THE DIFFERENCE BETWEEN THE
+!     OBSERVED VALUES AND THE FORECAST VALUES AT THE OBSERVATION
+!     POINTS.  THE OBSERVED VALUES CLOSEST TO THE CURRENT
+!     FORECAST TIME (XTIME) WERE DETERMINED IN SUBROUTINE
+!     IN4DOB AND STORED IN ARRAY VAROBS.  THE DIFFERENCES
+!     CALCULATED BY SUBROUTINE ERROB WILL BE STORED IN ARRAY
+!     ERRF FOR THE NSTA OBSERVATION LOCATIONS.  MISSING
+!     OBSERVATIONS ARE DENOTED BY THE DUMMY VALUE 99999.
+!
+!     HISTORY: Original author: MM5 version???
+!              02/04/2004 - Creation of WRF version.           Al Bourgeois
+!              08/28/2006 - Conversion from F77 to F90         Al Bourgeois
+!------------------------------------------------------------------------------
+
+! THE STORAGE ORDER IN VAROBS AND ERRF IS AS FOLLOWS:
+!        IVAR                VARIABLE TYPE(TAU-1)
+!        ----                --------------------
+!         1                    U error
+!         2                    V error
+!         3                    T error
+!         4                    Q error
+!         5                    Surface press error at T points (not used)
+!         6                    Model surface press at T-points
+!         7                    Model surface press at U-points
+!         8                    Model surface press at V-points
+!         9                    RKO at U-points
+
+!-----------------------------------------------------------------------
+!
+!     Description of input arguments.
+!
+!-----------------------------------------------------------------------
+
+  INTEGER, INTENT(IN)  :: inest                        ! Domain index.
+  INTEGER, INTENT(IN)  :: nndgv                        ! Number of nudge variables.
+  INTEGER, INTENT(IN)  :: nerrf                        ! Number of error fields.
+  INTEGER, INTENT(IN)  :: niobf                        ! Number of observations.
+  INTEGER, INTENT(IN)  :: maxdom                       ! Maximum number of domains.
+  INTEGER, INTENT(IN)  :: levidn(maxdom)               ! Level of nest.
+  INTEGER, INTENT(IN)  :: parid(maxdom)                ! Id of parent grid.
+  INTEGER, INTENT(IN)  :: i_parent_start(maxdom)       ! Start i index in parent domain.
+  INTEGER, INTENT(IN)  :: j_parent_start(maxdom)       ! Start j index in parent domain.
+  INTEGER, INTENT(IN)  :: ktau
+  INTEGER, INTENT(IN)  :: iratio                       ! Nest to parent gridsize ratio.
+  INTEGER, INTENT(IN)  :: npfi                         ! Coarse-grid diagnostics freq.
+  LOGICAL, INTENT(IN)  :: iprt                         ! Print flag
+  INTEGER, INTENT(IN)  :: nstat
+  INTEGER, intent(in)  :: iswind
+  INTEGER, intent(in)  :: istemp
+  INTEGER, intent(in)  :: ismois
+  INTEGER, intent(in)  :: ispstr
+  INTEGER, INTENT(IN)  :: ids,ide, jds,jde, kds,kde  ! domain dims.
+  INTEGER, INTENT(IN)  :: ims,ime, jms,jme, kms,kme  ! memory dims.
+  INTEGER, INTENT(IN)  :: its,ite, jts,jte, kts,kte  ! tile   dims.
+
+  REAL,   INTENT(IN) :: ub( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(IN) :: vb( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(IN) :: tb( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(IN) :: t0
+  REAL,   INTENT(IN) :: qvb( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(IN) :: pbase( ims:ime, kms:kme, jms:jme )
+  REAL,   INTENT(IN) :: pp( ims:ime, kms:kme, jms:jme ) ! Press. perturbation (Pa)
+  REAL,   INTENT(IN)  :: rovcp
+  REAL,   INTENT(IN) :: uratx( ims:ime, jms:jme ) ! U to U10 ratio on mass points.
+  REAL,   INTENT(IN) :: vratx( ims:ime, jms:jme ) ! V to V10 ratio on mass points.
+  REAL,   INTENT(IN) :: tratx( ims:ime, jms:jme ) ! T to TH2 ratio on mass points.
+  REAL,   INTENT(IN) :: rio(niobf)                ! West-east coordinate.
+  REAL,   INTENT(IN) :: rjo(niobf)                ! South-north coordinate.
+  REAL,   INTENT(INOUT) :: rko(niobf)
+  REAL,   INTENT(INOUT) :: varobs(nndgv, niobf)
+  REAL,   INTENT(INOUT) :: errf(nerrf, niobf)
+
+! Local variables
+  INTEGER :: iobmg(niobf)   ! Obs i-coord on mass grid
+  INTEGER :: jobmg(niobf)   ! Obs j-coord on mass grid
+  INTEGER :: ia(niobf)
+  INTEGER :: ib(niobf)
+  INTEGER :: ic(niobf)
+  REAL :: pbbo(kds:kde)    ! column base pressure (cb) at obs loc.
+  REAL :: ppbo(kds:kde)    ! column pressure perturbation (cb) at obs loc.
+
+  REAL :: ra(niobf)
+  REAL :: rb(niobf)
+  REAL :: rc(niobf)
+  REAL :: dxobmg(niobf)     ! Interp. fraction (x dir) referenced to mass-grid
+  REAL :: dyobmg(niobf)     ! Interp. fraction (y dir) referenced to mass-grid
+  INTEGER MM(MAXDOM)
+  INTEGER NNL
+  real :: uratio( ims:ime, jms:jme )   ! U to U10 ratio on momentum points.
+  real :: vratio( ims:ime, jms:jme )   ! V to V10 ratio on momentum points.
+  real :: pug1,pug2,pvg1,pvg2
+
+! Define staggers for U, V, and T grids, referenced from non-staggered grid.
+  real, parameter :: gridx_t = 0.5     ! Mass-point x stagger
+  real, parameter :: gridy_t = 0.5     ! Mass-point y stagger
+  real, parameter :: gridx_u = 0.0     ! U-point x stagger
+  real, parameter :: gridy_u = 0.5     ! U-point y stagger
+  real, parameter :: gridx_v = 0.5     ! V-point x stagger
+  real, parameter :: gridy_v = 0.0     ! V-point y stagger
+
+  real :: dummy = 99999.
+
+  real :: pbhi, pphi
+  real :: press,ttemp                  !ajb scratch variables
+! real model_temp,pot_temp             !ajb scratch variables
+
+!***  DECLARATIONS FOR IMPLICIT NONE
+  integer nsta,ivar,n,ityp
+  integer iob,job,kob,iob_ms,job_ms
+  integer k,kbot,nml,nlb,nle
+  integer iobm,jobm,iobp,jobp,kobp,inpf,i,j
+  integer i_start,i_end,j_start,j_end    ! loop ranges for uratio,vratio calc.
+  integer k_start,k_end
+
+  real gridx,gridy,dxob,dyob,dzob,dxob_ms,dyob_ms
+  real pob
+  real grfacx,grfacy,uratiob,vratiob,tratiob,tratxob,fnpf
+  real stagx                       ! For x correction to mass-point stagger
+  real stagy                       ! For y correction to mass-point stagger
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+  LOGICAL MP_LOCAL_DUMMASK(NIOBF)  ! Mask for work to be done on this processor
+  LOGICAL MP_LOCAL_UOBMASK(NIOBF)  ! Dot-point mask
+  LOGICAL MP_LOCAL_VOBMASK(NIOBF)  ! Dot-point mask
+  LOGICAL MP_LOCAL_COBMASK(NIOBF)  ! Cross-point mask
+#endif
+! LOGICAL, EXTERNAL :: TILE_MASK
+
+  NSTA=NSTAT
+
+! FIRST, DETERMINE THE GRID TYPE CORRECTION FOR U-momentum, V-momentum,
+! AND MASS POINTS, AND WHEN INEST=2, CONVERT THE STORED COARSE MESH INDICES
+! TO THE FINE MESH INDEX EQUIVALENTS
+
+! ITYP=1 FOR U-POINTS, ITYP=2 for V-POINTS, and ITYP=3 FOR MASS POINTS
+
+  if (iprt) then
+    write(6,'(a,i5,a,i2,a,i5,a)') '++++++CALL ERROB AT KTAU = ', &
+            KTAU,' AND INEST = ',INEST,':  NSTA = ',NSTA,' ++++++'
+  endif
+
+  ERRF = 0.0    ! Zero out errf array
+
+! Set up loop bounds for this grid's boundary conditions
+  i_start = max( its-1,ids )
+  i_end   = min( ite+1,ide-1 )
+  j_start = max( jts-1,jds )
+  j_end   = min( jte+1,jde-1 )
+  k_start = kts
+  k_end = min( kte, kde-1 )
+
+  DO ITYP=1,3   ! Big loop: ityp=1 for U, ityp=2 for V, ityp=3 for T,Q,SP 
+
+!   Set grid stagger
+    IF(ITYP.EQ.1) THEN        ! U-POINT CASE
+       GRIDX = gridx_u
+       GRIDY = gridy_u
+    ELSE IF(ITYP.EQ.2) THEN   ! V-POINT CASE
+       GRIDX = gridx_v
+       GRIDY = gridy_v
+    ELSE                      ! MASS-POINT CASE
+       GRIDX = gridx_t
+       GRIDY = gridy_t
+    ENDIF
+
+!   Compute URATIO and VRATIO fields on momentum (u,v) points.
+    IF(ityp.eq.1)THEN
+      call upoint(i_start,i_end, j_start,j_end, ids,ide, ims,ime, jms,jme, uratx, uratio)
+    ELSE IF (ityp.eq.2) THEN
+      call vpoint(i_start,i_end, j_start,j_end, jds,jde, ims,ime, jms,jme, vratx, vratio)
+    ENDIF
+
+    IF(INEST.EQ.1) THEN       ! COARSE MESH CASE...
+      DO N=1,NSTA
+        RA(N)=RIO(N)-GRIDX
+        RB(N)=RJO(N)-GRIDY
+        IA(N)=RA(N)
+        IB(N)=RB(N)
+        IOB=MAX0(1,IA(N))
+        IOB=MIN0(IOB,ide-1)
+        JOB=MAX0(1,IB(N))
+        JOB=MIN0(JOB,jde-1)
+        DXOB=RA(N)-FLOAT(IA(N))
+        DYOB=RB(N)-FLOAT(IB(N))
+
+!       Save mass-point arrays for computing rko for all var types
+        if(ityp.eq.1) then
+          iobmg(n) = MIN0(MAX0(1,int(RIO(n)-gridx_t)),ide-1)
+          jobmg(n) = MIN0(MAX0(1,int(RJO(n)-gridy_t)),jde-1)
+          dxobmg(n) = RIO(N)-gridx_t-FLOAT(int(RIO(N)-gridx_t))
+          dyobmg(n) = RJO(N)-gridy_t-FLOAT(int(RJO(N)-gridy_t))
+        endif
+        iob_ms = iobmg(n)
+        job_ms = jobmg(n)
+        dxob_ms = dxobmg(n)
+        dyob_ms = dyobmg(n)
+
+
+!if(n.eq.1 .and. iprt) then
+!        write(6,*) 'ERROB - COARSE MESH:'
+!        write(6,'(a,i1,a,i1,4(a,f5.2),2(a,i3),2(a,f6.3))') 'OBS= ',n,  &
+!                   '  ityp= ',ityp,                                    &
+!                   '  ra= ',ra(n),'  rb= ',rb(n),                      &
+!                   '  rio= ',rio(n),'  rjo= ',rjo(n),                  &
+!                   '  iob= ',iob,'  job= ',job,                        &
+!                   '  dxob= ',dxob,'  dyob= ',dyob
+!        write(6,'(a,i3,a,i3,a,f5.2,a,f5.2)')                           &
+!                   '  iob_ms= ',iob_ms,'  job_ms= ',job_ms,            &
+!                   '  dxob_ms= ',dxob_ms,'  dyob_ms= ',dyob_ms
+!endif
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+!       Set mask for obs to be handled by this processor
+        MP_LOCAL_DUMMASK(N) = TILE_MASK(IOB, JOB, its, ite, jts, jte)
+  
+        IF ( MP_LOCAL_DUMMASK(N) ) THEN
+#endif
+
+!         Interpolate pressure to obs location column and convert from Pa to cb.
+
+          do k = kds, kde
+            pbbo(k) = .001*(                                            &
+               (1.-DYOB_MS)*( (1.-DXOB_MS)*pbase(IOB_MS,K,JOB_MS) +     &
+                                  DXOB_MS *pbase(IOB_MS+1,K,JOB_MS) ) + &
+                   DYOB_MS* ( (1.-DXOB_MS)*pbase(IOB_MS,K,JOB_MS+1) +   &
+                                  DXOB_MS *pbase(IOB_MS+1,K,JOB_MS+1) ) )  
+            ppbo(k) = .001*(                                            &
+               (1.-DYOB_MS)*( (1.-DXOB_MS)*pp(IOB_MS,K,JOB_MS) +        &
+                                  DXOB_MS *pp(IOB_MS+1,K,JOB_MS) ) +    &
+                   DYOB_MS* ( (1.-DXOB_MS)*pp(IOB_MS,K,JOB_MS+1) +      &
+                                  DXOB_MS *pp(IOB_MS+1,K,JOB_MS+1) ) )  
+
+!     write(6,'(a,i2,2(a,f9.3)') ' k= ',k,' pbbo= ',pbbo(k),' ppbo= ',ppbo(k)
+          enddo
+
+!ajb      20040119: Note based on bugfix for dot/cross points split across processors,
+!ajb                which was actually a serial code fix: The ityp=2 (v-points) and
+!ajb                itype=3 (mass-points) cases should not use the ityp=1 (u-points)
+!ajb                case rko! This is necessary for bit-for-bit reproducability
+!ajb                with the parallel run.   (coarse mesh)
+
+
+          if(abs(rko(n)+99).lt.1.)then
+            pob = varobs(5,n)
+
+            if(pob .gt.-800000.)then
+              do k=k_end-1,1,-1
+                kbot = k
+                if(pob .le. pbbo(k)+ppbo(k)) then
+                  goto 199
+                endif
+              enddo
+ 199          continue
+
+              pphi = ppbo(kbot+1)
+              pbhi = pbbo(kbot+1)
+
+              rko(n) = real(kbot+1)-                                    &
+                 ( (pob-pbhi-pphi) / (pbbo(kbot)+ppbo(kbot)-pbhi-pphi) )
+
+              rko(n)=max(rko(n),1.0)
+            endif
+          endif
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+        ENDIF       !end IF( MP_LOCAL_DUMMASK(N) )                                 !ajb
+#endif
+
+        RC(N)=RKO(N)
+
+      ENDDO      ! END COARSE MESH LOOP OVER NSTA 
+
+    ELSE       ! FINE MESH CASE
+            
+!     CONVERT (I,J,K) OF OBSERVATIONS TO THE EQUIVALENT FINE MESH VALUES.
+      DO N=1,NSTA
+
+!       COMPUTE THE OBS LOCATION WITH RESPECT TO THIS MESH (INEST)...
+        NML=INEST
+        MM(LEVIDN(INEST)+1)=INEST
+!       WORKING TOWARD COARSER MESHES, DETERMINE THE HIERARCHY OF MOTHER
+!       MESHES WITH RESPECT TO EACH MOTHER MESH STARTING AT MESH "IN"...
+!       THAT IS, DETERMINE ITS MOTHER, GRANDMOTHER, GREAT-GRANDMOTHER, ETC.
+!       OUT TO THE COARSE GRID MESH (INEST=1).
+!       LEVIDN HOLDS THE NEST LEVEL AND PARID HOLDS THE MOTHER MESH FOR EACH
+!       GRID (E.G., FOR 3 MESHES AND 2 NEST LEVELS, IN=1 IS THE COARSE GRID
+!       MESH, IN=2 HAS LEVIDN(2)=1 AND PARID(2)=1, AND IN=3 HAS LEVIDN(3)=2
+!       AND PARID(3)=2...)
+        DO NNL=LEVIDN(INEST),1,-1
+          MM(NNL)=PARID(NML)
+          NML=MM(NNL)
+        ENDDO
+
+!       NOTE: MM(1) MUST BE THE COARSE GRID MESH (INEST=0)
+        IF(MM(1).NE.1) then 
+            if(iprt) write(6,*) 'stopping in errob: inest = ',inest
+            STOP 21
+        ENDIF
+
+        RA(N)=RIO(N)
+        RB(N)=RJO(N)
+        DO NNL=1,LEVIDN(INEST)
+          GRFACX=0.
+          GRFACY=0.
+!         COMPUTE THE OBS LOCATION WITH RESPECT TO THE INNER GRID IN NON-
+!         STAGGERED SPACE (GRID=0.).  WHEN WE REACH MESH INEST, THEN
+!         APPLY THE APPRPRIATE STAGGER, DEPENDING ON THE VARIABLE...
+          IF(NNL.EQ.LEVIDN(INEST)) THEN
+            GRFACX=GRIDX
+            GRFACY=GRIDY
+          ENDIF
+  
+          RA(N)=(RA(N)-FLOAT(i_parent_start(MM(NNL+1))))*  &
+                       FLOAT(IRATIO)+1.-GRFACX
+          RB(N)=(RB(N)-FLOAT(j_parent_start(MM(NNL+1))))*  &
+                       FLOAT(IRATIO)+1.-GRFACY
+
+          IA(N)=RA(N)
+          IB(N)=RB(N)
+          IOB=MAX0(1,IA(N))
+          IOB=MIN0(IOB,ide-1)
+          JOB=MAX0(1,IB(N))
+          JOB=MIN0(JOB,jde-1)
+          DXOB=RA(N)-FLOAT(IA(N))
+          DYOB=RB(N)-FLOAT(IB(N))
+
+!         Save mass-point arrays for computing rko for all var types
+          if(ityp.eq.1) then
+            stagx = grfacx - gridx_t     !Correct x stagger to mass-point
+            stagy = grfacy - gridy_t     !Correct y stagger to mass-point
+            iobmg(n) = MIN0(MAX0(1,int(RA(n)+stagx)),ide-1)
+            jobmg(n) = MIN0(MAX0(1,int(RB(n)+stagy)),jde-1)
+            dxobmg(n) = RA(N)+stagx-FLOAT(int(RA(N)+stagx))
+            dyobmg(n) = RB(N)+stagy-FLOAT(int(RB(N)+stagy))
+          endif 
+          iob_ms = iobmg(n)
+          job_ms = jobmg(n)
+          dxob_ms = dxobmg(n)
+          dyob_ms = dyobmg(n)
+
+!if(n.eq.1) then
+!        write(6,*) 'ERROB - FINE MESH:'
+!        write(6,*) 'RA = ',ra(n),' RB = ',rb(n)
+!        write(6,'(a,i1,a,i1,4(a,f5.2),2(a,i3),2(a,f6.3))') 'OBS= ',n,  &
+!                   '  ityp= ',ityp,                                    &
+!                   '  ra= ',ra(n),'  rb= ',rb(n),                      &
+!                   '  rio= ',rio(n),'  rjo= ',rjo(n),                  &
+!                   '  iob= ',iob,'  job= ',job,                        &
+!                   '  dxob= ',dxob,'  dyob= ',dyob
+!        write(6,'(a,i3,a,i3,a,f5.2,a,f5.2)')                           &
+!                   '  iob_ms= ',iob_ms,'  job_ms= ',job_ms,            &
+!                   '  dxob_ms= ',dxob_ms,'  dyob_ms= ',dyob_ms
+!endif
+
+        ENDDO    ! end do nnl=1,levidn(inest)
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+!       Set mask for obs to be handled by this processor
+        MP_LOCAL_DUMMASK(N) = TILE_MASK(IOB, JOB, its, ite, jts, jte)
+
+        IF ( MP_LOCAL_DUMMASK(N) ) THEN
+#endif
+
+!         Interpolate pressure to obs location column and convert from Pa to cb.
+
+          do k = kds, kde
+            pbbo(k) = .001*(                                            &
+               (1.-DYOB_MS)*( (1.-DXOB_MS)*pbase(IOB_MS,K,JOB_MS) +     &
+                                  DXOB_MS *pbase(IOB_MS+1,K,JOB_MS) ) + &
+                   DYOB_MS* ( (1.-DXOB_MS)*pbase(IOB_MS,K,JOB_MS+1) +   &
+                                  DXOB_MS *pbase(IOB_MS+1,K,JOB_MS+1) ) )
+            ppbo(k) = .001*(                                            &
+               (1.-DYOB_MS)*( (1.-DXOB_MS)*pp(IOB_MS,K,JOB_MS) +        &
+                                  DXOB_MS *pp(IOB_MS+1,K,JOB_MS) ) +    &
+                   DYOB_MS* ( (1.-DXOB_MS)*pp(IOB_MS,K,JOB_MS+1) +      &
+                                  DXOB_MS *pp(IOB_MS+1,K,JOB_MS+1) ) )
+
+!     write(6,'(a,i2,2(a,f9.3)') ' k= ',k,' pbbo= ',pbbo(k),' ppbo= ',ppbo(k)
+          enddo
+
+!ajb      20040119: Note based on bugfix for dot/cross points split across processors,
+!ajb                which was actually a serial code fix: The ityp=2 (v-points) and
+!ajb                itype=3 (mass-points) cases should not use the ityp=1 (u-points)
+!ajb                case) rko! This is necessary for bit-for-bit reproducability
+!ajb                with parallel run.   (fine mesh)
+
+          if(abs(rko(n)+99).lt.1.)then
+            pob = varobs(5,n)
+
+            if(pob .gt.-800000.)then
+              do k=k_end-1,1,-1
+                kbot = k
+                if(pob .le. pbbo(k)+ppbo(k)) then
+                  goto 198
+                endif
+              enddo
+ 198          continue
+
+              pphi = ppbo(kbot+1)
+              pbhi = pbbo(kbot+1)
+
+              rko(n) = real(kbot+1)-                                    &
+                 ( (pob-pbhi-pphi) / (pbbo(kbot)+ppbo(kbot)-pbhi-pphi) )
+              rko(n)=max(rko(n),1.0)
+            endif
+          endif
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+        ENDIF       !end IF( MP_LOCAL_DUMMASK(N) )                                 !ajb
+#endif
+
+        RC(N)=RKO(N)
+
+      ENDDO      ! END FINE MESH LOOP OVER NSTA
+    
+    ENDIF      ! end if(inest.eq.1)
+
+!   INITIALIZE THE ARRAY OF DIFFERENCES BETWEEN THE OBSERVATIONS
+!   AND THE LOCAL FORECAST VALUES TO ZERO.  FOR THE FINE MESH
+!   ONLY, SET THE DIFFERENCE TO A LARGE DUMMY VALUE IF THE
+!   OBSERVATION IS OUTSIDE THE FINE MESH DOMAIN.
+
+!   SET DIFFERENCE VALUE TO A DUMMY VALUE FOR OBS POINTS OUTSIDE
+!   CURRENT DOMAIN
+    IF(ITYP.EQ.1) THEN
+      NLB=1
+      NLE=1
+    ELSE IF(ITYP.EQ.2) THEN
+      NLB=2
+      NLE=2
+    ELSE
+      NLB=3
+      NLE=5
+    ENDIF
+    DO IVAR=NLB,NLE
+      DO N=1,NSTA
+        IF((RA(N)-1.).LT.0)THEN
+           ERRF(IVAR,N)=ERRF(IVAR,N)+DUMMY
+        ENDIF
+        IF((RB(N)-1.).LT.0)THEN
+           ERRF(IVAR,N)=ERRF(IVAR,N)+DUMMY
+        ENDIF
+        IF((FLOAT(ide)-2.0*GRIDX-RA(N)-1.E-10).LT.0)THEN
+           ERRF(IVAR,N)=ERRF(IVAR,N)+DUMMY
+        ENDIF
+        IF((FLOAT(jde)-2.0*GRIDY-RB(N)-1.E-10).LT.0)THEN
+           ERRF(IVAR,N)=ERRF(IVAR,N)+DUMMY
+        ENDIF
+        if(rc(n).lt.1.)errf(ivar,n)=errf(ivar,n)+dummy
+      ENDDO
+    ENDDO
+
+!   NOW FIND THE EXACT OFFSET OF EACH OBSERVATION FROM THE
+!   GRID POINT TOWARD THE LOWER LEFT
+    DO N=1,NSTA
+        IA(N)=RA(N)
+        IB(N)=RB(N)
+        IC(N)=RC(N)
+    ENDDO
+    DO N=1,NSTA
+        RA(N)=RA(N)-FLOAT(IA(N))
+        RB(N)=RB(N)-FLOAT(IB(N))
+        RC(N)=RC(N)-FLOAT(IC(N))
+    ENDDO
+!   PERFORM A TRILINEAR EIGHT-POINT (3-D) INTERPOLATION
+!   TO FIND THE FORECAST VALUE AT THE EXACT OBSERVATION
+!   POINTS FOR U, V, T, AND Q.
+
+!   Compute local masks for dot and cross points.
+    if(ityp.eq.1) then
+      DO N=1,NSTA
+        IOB=MAX0(1,IA(N))
+        IOB=MIN0(IOB,ide-1)
+        JOB=MAX0(1,IB(N))
+        JOB=MIN0(JOB,jde-1)
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+!       Set mask for U-momemtum points to be handled by this processor
+        MP_LOCAL_UOBMASK(N) = TILE_MASK(IOB, JOB, its, ite, jts, jte)
+#endif
+      ENDDO
+    endif
+    if(ityp.eq.2) then
+      DO N=1,NSTA
+        IOB=MAX0(1,IA(N))
+        IOB=MIN0(IOB,ide-1)
+        JOB=MAX0(1,IB(N))
+        JOB=MIN0(JOB,jde-1)
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+!       Set mask for V-momentum points to be handled by this processor
+        MP_LOCAL_VOBMASK(N) = TILE_MASK(IOB, JOB, its, ite, jts, jte)
+#endif
+      ENDDO
+    endif
+    if(ityp.eq.3) then
+      DO N=1,NSTA
+        IOB=MAX0(1,IA(N))
+        IOB=MIN0(IOB,ide-1)
+        JOB=MAX0(1,IB(N))
+        JOB=MIN0(JOB,jde-1)
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+!       Set mask for cross (mass) points to be handled by this processor
+        MP_LOCAL_COBMASK(N) = TILE_MASK(IOB, JOB, its, ite, jts, jte)
+#endif
+      ENDDO
+    endif
+
+!**********************************************************
+!   PROCESS U VARIABLE (IVAR=1)
+!**********************************************************
+    IF(ITYP.EQ.1) THEN
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+      DO N=1,NSTA
+        IF(MP_LOCAL_UOBMASK(N)) THEN
+          ERRF(9,N)=rko(n)       !RKO is needed by neighboring processors     !ajb
+        ENDIF
+      ENDDO
+#endif
+      IF(ISWIND.EQ.1) THEN
+        DO N=1,NSTA
+          IOB=MAX0(2,IA(N))
+          IOB=MIN0(IOB,ide-1)
+          IOBM=MAX0(1,IOB-1)
+          IOBP=MIN0(ide-1,IOB+1)
+          JOB=MAX0(2,IB(N))
+          JOB=MIN0(JOB,jde-1)
+          JOBM=MAX0(1,JOB-1)
+          JOBP=MIN0(jde-1,JOB+1)
+          KOB=MIN0(K_END,IC(N))
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+          IF(MP_LOCAL_UOBMASK(N))THEN     ! Do if obs on this processor
+#endif
+            KOBP=MIN0(KOB+1,k_end)
+            DXOB=RA(N)
+            DYOB=RB(N)
+            DZOB=RC(N)
+
+!           Compute surface pressure values at surrounding U and V points
+            PUG1 = .5*( pbase(IOBM,1,JOB) + pbase(IOB,1,JOB) )
+            PUG2 = .5*( pbase(IOB,1,JOB) + pbase(IOBP,1,JOB) )
+
+!           This is to correct obs to model sigma level using reverse similarity theory
+            if(rko(n).eq.1.0)then
+              uratiob=((1.-DXOB)*((1.-DYOB)*uratio(IOB,JOB)+     &
+                    DYOB*uratio(IOBP,JOB)                        &
+                  )+DXOB*((1.-DYOB)*uratio(IOB,JOBP)+            &
+                  DYOB*uratio(IOBP,JOBP)))
+            else
+              uratiob=1.
+            endif
+!YLIU       Some PBL scheme do not define the vratio/uratio
+            if(abs(uratiob).lt.1.0e-3) then
+              uratiob=1.
+            endif
+
+!           INITIAL ERRF(IVAR,N) IS ZERO FOR OBSERVATIONS POINTS
+!           WITHIN THE DOMAIN, AND A LARGE DUMMY VALUE FOR POINTS
+!           OUTSIDE THE CURRENT DOMAIN
+  
+!           U COMPONENT WIND ERROR
+            ERRF(1,N)=ERRF(1,N)+uratiob*VAROBS(1,N)-((1.-DZOB)*        &
+                      ((1.-DyOB)*((1.-                                 &
+                      DxOB)*UB(IOB,KOB,JOB)+DxOB*UB(IOB+1,KOB,JOB)     &
+                      )+DyOB*((1.-DxOB)*UB(IOB,KOB,JOB+1)+DxOB*        &
+                      UB(IOB+1,KOB,JOB+1)))+DZOB*((1.-DyOB)*((1.-DxOB) &
+                      *UB(IOB,KOBP,JOB)+DxOB*UB(IOB+1,KOBP,JOB))+      &
+                      DyOB*((1.-DxOB)*UB(IOB,KOBP,JOB+1)+DxOB*         &
+                      UB(IOB+1,KOBP,JOB+1))))
+
+!      if(n.le.10) then
+!        write(6,*)
+!        write(6,'(a,i3,i3,i3,a,i3,a,i2)') 'ERRF1 at ',iob,job,kob,   &
+!                                     ' N = ',n,' inest = ',inest
+!        write(6,*) 'VAROBS(1,N) = ',varobs(1,n)
+!        write(6,*) 'VAROBS(5,N) = ',varobs(5,n)
+!        write(6,*) 'UB(IOB,KOB,JOB) = ',UB(IOB,KOB,JOB)
+!        write(6,*) 'UB(IOB+1,KOB,JOB) = ',UB(IOB+1,KOB,JOB)
+!        write(6,*) 'UB(IOB,KOB,JOB+1) = ',UB(IOB,KOB,JOB+1)
+!        write(6,*) 'UB(IOB+1,KOB,JOB+1) = ',UB(IOB+1,KOB,JOB+1)
+!        write(6,*) 'UB(IOB,KOBP,JOB) = ',UB(IOB,KOBP,JOB)
+!        write(6,*) 'UB(IOB+1,KOBP,JOB) = ',UB(IOB+1,KOBP,JOB)
+!        write(6,*) 'UB(IOB,KOBP,JOB+1) = ',UB(IOB,KOBP,JOB+1)
+!        write(6,*) 'UB(IOB+1,KOBP,JOB+1) = ',UB(IOB+1,KOBP,JOB+1)
+!        write(6,*) 'uratiob = ',uratiob
+!        write(6,*) 'DXOB,DYOB,DZOB = ',DXOB,DYOB,DZOB
+!        write(6,*) 'ERRF(1,N) = ',errf(1,n)
+!        write(6,*)
+!      endif
+
+
+!           Store model surface pressure (not the error!) at U point.
+            ERRF(7,N)=.001*( (1.-DXOB)*PUG1 + DXOB*PUG2 )
+  
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+          ENDIF       ! end IF( MP_LOCAL_UOBMASK(N) )
+#endif
+        ENDDO    ! END U-POINT LOOP OVER OBS
+
+      ENDIF    ! end if(iswind.eq.1)
+
+    ENDIF   ! ITYP=1: PROCESS U
+
+!**********************************************************
+!   PROCESS V VARIABLE (IVAR=2)
+!**********************************************************
+    IF(ITYP.EQ.2) THEN
+
+      IF(ISWIND.EQ.1) THEN
+        DO N=1,NSTA
+          IOB=MAX0(2,IA(N))
+          IOB=MIN0(IOB,ide-1)
+          IOBM=MAX0(1,IOB-1)
+          IOBP=MIN0(ide-1,IOB+1)
+          JOB=MAX0(2,IB(N))
+          JOB=MIN0(JOB,jde-1)
+          JOBM=MAX0(1,JOB-1)
+          JOBP=MIN0(jde-1,JOB+1)
+          KOB=MIN0(K_END,IC(N))
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+          IF(MP_LOCAL_VOBMASK(N))THEN     ! Do if obs on this processor
+#endif
+            KOBP=MIN0(KOB+1,k_end)
+            DXOB=RA(N)
+            DYOB=RB(N)
+            DZOB=RC(N)
+
+!           Compute surface pressure values at surrounding U and V points
+            PVG1 = .5*( pbase(IOB,1,JOBM) + pbase(IOB,1,JOB) )
+            PVG2 = .5*( pbase(IOB,1,JOB) + pbase(IOB,1,JOBP) )
+
+!           This is to correct obs to model sigma level using reverse similarity theory
+            if(rko(n).eq.1.0)then
+              vratiob=((1.-DXOB)*((1.-DYOB)*vratio(IOB,JOB)+     &
+                    DYOB*vratio(IOBP,JOB)                        &
+                  )+DXOB*((1.-DYOB)*vratio(IOB,JOBP)+            &
+                  DYOB*vratio(IOBP,JOBP)))
+            else
+              vratiob=1.
+            endif
+!YLIU       Some PBL scheme do not define the vratio/uratio
+            if(abs(vratiob).lt.1.0e-3) then
+              vratiob=1.
+            endif
+
+!           INITIAL ERRF(IVAR,N) IS ZERO FOR OBSERVATIONS POINTS
+!           WITHIN THE DOMAIN, AND A LARGE DUMMY VALUE FOR POINTS
+!           OUTSIDE THE CURRENT DOMAIN
+  
+!           V COMPONENT WIND ERROR
+            ERRF(2,N)=ERRF(2,N)+vratiob*VAROBS(2,N)-((1.-DZOB)*        &
+                     ((1.-DyOB)*((1.-                                  &
+                      DxOB)*VB(IOB,KOB,JOB)+DxOB*VB(IOB+1,KOB,JOB)     &
+                      )+DyOB*((1.-DxOB)*VB(IOB,KOB,JOB+1)+DxOB*        &
+                      VB(IOB+1,KOB,JOB+1)))+DZOB*((1.-DyOB)*((1.-DxOB) &
+                      *VB(IOB,KOBP,JOB)+DxOB*VB(IOB+1,KOBP,JOB))+      &
+                      DyOB*((1.-DxOB)*VB(IOB,KOBP,JOB+1)+DxOB*         &
+                      VB(IOB+1,KOBP,JOB+1))))
+  
+!           Store model surface pressure (not the error!) at V point.
+            ERRF(8,N)=.001*( (1.-DYOB)*PVG1 + DYOB*PVG2 )
+  
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+          ENDIF       ! end IF( MP_LOCAL_VOBMASK(N) )
+#endif
+        ENDDO    ! END V-POINT LOOP OVER OBS
+
+      ENDIF    ! end if(iswind.eq.1)
+
+    ENDIF   ! ITYP=1: PROCESS V
+
+!**********************************************************
+!   PROCESS MASS-POINT VARIABLES IVAR=3 (T) AND IVAR=4 (QV)
+!**********************************************************
+    IF(ITYP.EQ.3) THEN
+
+      IF(ISTEMP.EQ.1 .OR. ISMOIS.EQ.1) THEN
+        DO N=1,NSTA
+          IOB=MAX0(1,IA(N))
+          IOB=MIN0(IOB,ide-1)
+          JOB=MAX0(1,IB(N))
+          JOB=MIN0(JOB,jde-1)
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+          IF(MP_LOCAL_COBMASK(N)) THEN     ! Do if obs on this processor
+#endif
+            KOB=MIN0(k_end,IC(N))
+            KOBP=MIN0(KOB+1,K_END)
+            DXOB=RA(N)
+            DYOB=RB(N)
+            DZOB=RC(N)
+
+!           This is to correct obs to model sigma level using reverse similarity theory
+            if(rko(n).eq.1.0)then
+              tratxob=((1.-DXOB)*((1.-DYOB)*tratx(IOB,JOB)+        &
+                    DYOB*tratx(IOB+1,JOB)                          &
+                  )+DXOB*((1.-DYOB)*tratx(IOB,JOB+1)+              &
+                  DYOB*tratx(IOB+1,JOB+1)))
+            else
+              tratxob=1.
+            endif
+
+!yliu
+            if(abs(tratxob) .lt. 1.0E-3) tratxob=1.
+
+!ajb        testing only
+            if(iprt .and. n.eq.81)  then
+              write(6,*) 'POTENTIAL TEMP FOR N=81:'
+              write(6,*)
+              write(6,*) '            K      THETA       TEMPERATURE', &
+                         '       PBASE'
+              write(6,*)
+              do k=k_end,1,-1
+                press = pbase(iob,k,job)+pp(iob,k,job)
+                ttemp = exp ( alog(300.+TB(IOB,k,JOB)) - &
+                                           .2857143*alog(100000./press) ) 
+                write(6,*) k,300.+TB(IOB,k,JOB),ttemp,pbase(iob,k,job)
+              enddo
+            endif
+!ajb        end testing only
+
+!           TEMPERATURE ERROR
+!          if(n.le.10) then
+!             write(6,*) 'before: errf(3,n) = ',errf(3,n)
+!          endif
+            ERRF(3,N)=ERRF(3,N)+tratxob*VAROBS(3,N)-((1.-DZOB)*     &
+                      ((1.-DyOB)*((1.-                              &
+                      DxOB)*(TB(IOB,KOB,JOB))+DxOB*                 &
+                      (TB(IOB+1,KOB,JOB)))+DyOB*((1.-DxOB)*         &
+                      (TB(IOB,KOB,JOB+1))+DxOB*                     &
+                      (TB(IOB+1,KOB,JOB+1))))+DZOB*((1.-            &
+                      DyOB)*((1.-DxOB)*(TB(IOB,KOBP,JOB))+DxOB*     &
+                      (TB(IOB+1,KOBP,JOB)))+DyOB*((1.-DxOB)*        &
+                      (TB(IOB,KOBP,JOB+1))+DxOB*                    &
+                      (TB(IOB+1,KOBP,JOB+1)))))
+
+!       if(n.le.10) then
+!         write(6,*)
+!         write(6,'(a,i3,i3,i3,a,i3,a,i2)') 'ERRF3 at ',iob,job,kob,   &
+!                                      ' N = ',n,' inest = ',inest
+!         write(6,*) 'VAROBS(3,N) = ',varobs(3,n)
+!         write(6,*) 'VAROBS(5,N) = ',varobs(5,n)
+!         write(6,*) 'TB(IOB,KOB,JOB) = ',TB(IOB,KOB,JOB)
+!         write(6,*) 'TB(IOB+1,KOB,JOB) = ',TB(IOB+1,KOB,JOB)
+!         write(6,*) 'TB(IOB,KOB,JOB+1) = ',TB(IOB,KOB,JOB+1)
+!         write(6,*) 'TB(IOB+1,KOB,JOB+1) = ',TB(IOB+1,KOB,JOB+1)
+!         write(6,*) 'TB(IOB,KOBP,JOB) = ',TB(IOB,KOBP,JOB)
+!         write(6,*) 'TB(IOB+1,KOBP,JOB) = ',TB(IOB+1,KOBP,JOB)
+!         write(6,*) 'TB(IOB,KOBP,JOB+1) = ',TB(IOB,KOBP,JOB+1)
+!         write(6,*) 'TB(IOB+1,KOBP,JOB+1) = ',TB(IOB+1,KOBP,JOB+1)
+!         write(6,*) 'tratxob = ',tratxob
+!         write(6,*) 'DXOB,DYOB,DZOB = ',DXOB,DYOB,DZOB
+!         write(6,*) 'ERRF(3,N) = ',errf(3,n)
+!         write(6,*)
+!       endif
+
+
+!           MOISTURE ERROR
+            ERRF(4,N)=ERRF(4,N)+VAROBS(4,N)-((1.-DZOB)*((1.-DyOB)*((1.- &
+                      DxOB)*QVB(IOB,KOB,JOB)+DxOB*                      &
+                      QVB(IOB+1,KOB,JOB))+DyOB*((1.-DxOB)*              &
+                      QVB(IOB,KOB,JOB+1)+DxOB*                          &
+                      QVB(IOB+1,KOB,JOB+1)))+DZOB*((1.-                 &
+                      DyOB)*((1.-DxOB)*QVB(IOB,KOBP,JOB)+DxOB           &
+                      *QVB(IOB+1,KOBP,JOB))+DyOB*((1.-DxOB              &
+                      )*QVB(IOB,KOBP,JOB+1)+DxOB*                       &
+                      QVB(IOB+1,KOBP,JOB+1))))
+
+!           Store model surface pressure (not the error!) at T-point
+            ERRF(6,N)= .001*                                            &
+                      ((1.-DyOB)*((1.-DxOB)*pbase(IOB,1,JOB)+DxOB*      &
+                      pbase(IOB+1,1,JOB))+DyOB*((1.-DxOB)*              &
+                      pbase(IOB,1,JOB+1)+DxOB*pbase(IOB+1,1,JOB+1) ))
+ 
+      if(iprt .and. n.eq.81) then
+       write(6,*) 'ERRF(6,81) calculation:'
+       write(6,*) 'iob,job = ',iob,job
+       write(6,*) 'pbase(iob,1,job) = ',pbase(iob,1,job)
+       write(6,*) 'pbase(iob+1,1,job) = ',pbase(iob+1,1,job)
+       write(6,*) 'pbase(iob,1,job+1) = ',pbase(iob,1,job+1)
+       write(6,*) 'pbase(iob+1,1,job+1) = ',pbase(iob+1,1,job+1)
+       write(6,*) 'ERRF(6,81) = ',errf(6,n)
+!      call flush(6)
+      endif
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+          ENDIF       ! end IF( MP_LOCAL_COBMASK(N) )
+#endif
+        ENDDO     ! END T and QV LOOP OVER OBS
+
+      ENDIF   !end if(istemp.eq.1 .or. ismois.eq.1)
+
+!**********************************************************
+!     PROCESS SURFACE PRESSURE CROSS-POINT FIELD, IVAR=5,
+!     USING BILINEAR FOUR-POINT 2-D INTERPOLATION
+!**********************************************************
+      IF(ISPSTR.EQ.1) THEN 
+        DO N=1,NSTA
+          IOB=MAX0(1,IA(N))
+          IOB=MIN0(IOB,ide-1)
+          JOB=MAX0(1,IB(N))
+          JOB=MIN0(JOB,jde-1)
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+          IF(MP_LOCAL_COBMASK(N)) THEN    ! Do if obs on this processor
+#endif
+            DXOB=RA(N)
+            DYOB=RB(N)
+!ajb        fix this (put in correct pressure calc for IOB,JOB here)
+            ERRF(5,N)=ERRF(5,N)+VAROBS(5,N)-((1.-DyOB)*((1.-DxOB)*      &
+               pbase(IOB,1,JOB)+DxOB*pbase(IOB+1,1,JOB))+DyOB*          &
+               ((1.-DxOB)*pbase(IOB,1,JOB+1)+DxOB*                      &
+               pbase(IOB+1,1,JOB+1)))
+
+      if(n.eq.81) then
+       write(6,*) 'ERRF(5,81) calculation:'
+       write(6,*) 'iob,job = ',iob,job
+       write(6,*) 'pbase(iob,1,job) = ',pbase(iob,1,job)
+       write(6,*) 'pbase(iob+1,1,job) = ',pbase(iob+1,1,job)
+       write(6,*) 'pbase(iob,1,job+1) = ',pbase(iob,1,job+1)
+       write(6,*) 'pbase(iob+1,1,job+1) = ',pbase(iob+1,1,job+1)
+       write(6,*) 'errf(5,81) = ',errf(5,n)
+!      call flush(6)
+      endif
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+          ENDIF       ! end IF( MP_LOCAL_COBMASK(N) )
+#endif
+
+        ENDDO
+
+      ENDIF   ! end if(ispstr.eq.1)
+
+    ENDIF   ! end if(ityp.eq.3)
+
+  ENDDO   ! END BIG LOOP
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+! Gather the errf values calculated by the processors with the obs.
+  CALL get_full_obs_vector(nsta, nerrf, niobf, mp_local_uobmask,     &
+                           mp_local_vobmask, mp_local_cobmask, errf)
+#endif
+
+! DIFFERENCE BETWEEN OBS AND FCST IS COMPLETED
+  IF(INEST.EQ.1)THEN
+    INPF=NPFI
+  ELSE
+    FNPF=IRATIO**LEVIDN(INEST)
+    INPF=FNPF*NPFI
+  ENDIF
+! Gross error check for temperature. Set all vars bad.
+  do n=1,nsta
+    if((abs(errf(3,n)).gt.20.).and.           &
+           (errf(3,n).gt.-800000.))then
+
+       errf(1,n)=-888888.
+       errf(2,n)=-888888.
+       errf(3,n)=-888888.
+       errf(4,n)=-888888.
+       varobs(1,n)=-888888.
+       varobs(2,n)=-888888.
+       varobs(3,n)=-888888.
+       varobs(4,n)=-888888.
+    endif
+  enddo
+
+! For printout
+!  IF(MOD(KTAU,INPF).NE.0) THEN
+!      RETURN
+!  ENDIF
+
+  RETURN
+  END SUBROUTINE errob
+
+  SUBROUTINE upoint(i_start,i_end, j_start,j_end, ids,ide, ims,ime, jms,jme,  &
+                    arrin, arrout)
+!------------------------------------------------------------------------------
+!     PURPOSE: This subroutine interpolates a real 2D array defined over mass
+!              coordinate points, to U (momentum) points.
+!
+!------------------------------------------------------------------------------
+  IMPLICIT NONE
+
+  INTEGER, INTENT(IN) :: i_start     ! Starting i index for this model tile
+  INTEGER, INTENT(IN) :: i_end       ! Ending   i index for this model tile
+  INTEGER, INTENT(IN) :: j_start     ! Starting j index for this model tile
+  INTEGER, INTENT(IN) :: j_end       ! Ending   j index for this model tile
+  INTEGER, INTENT(IN) :: ids         ! Starting i index for entire model domain
+  INTEGER, INTENT(IN) :: ide         ! Ending   i index for entire model domain
+  INTEGER, INTENT(IN) :: ims         ! Starting i index for model patch 
+  INTEGER, INTENT(IN) :: ime         ! Ending   i index for model patch 
+  INTEGER, INTENT(IN) :: jms         ! Starting j index for model patch 
+  INTEGER, INTENT(IN) :: jme         ! Ending   j index for model patch 
+  REAL,   INTENT(IN)  :: arrin ( ims:ime, jms:jme )  ! input array on mass points
+  REAL,   INTENT(OUT) :: arrout( ims:ime, jms:jme )  ! output array on U points 
+
+! Local variables
+  integer :: i, j
+
+! Do domain interior first
+  do j = j_start, j_end
+    do i = max(2,i_start), i_end
+       arrout(i,j) = 0.5*(arrin(i,j)+arrin(i-1,j))
+    enddo
+  enddo
+
+! Do west-east boundaries
+  if(i_start .eq. ids) then
+    do j = j_start, j_end
+      arrout(i_start,j) = arrin(i_start,j)
+    enddo
+  endif
+  if(i_end .eq. ide-1) then
+    do j = j_start, j_end
+      arrout(i_end+1,j) = arrin(i_end,j)
+    enddo
+  endif
+
+  RETURN
+  END SUBROUTINE upoint
+
+  SUBROUTINE vpoint(i_start,i_end, j_start,j_end, jds,jde, ims,ime, jms,jme,  &
+                    arrin, arrout)
+!------------------------------------------------------------------------------
+!     PURPOSE: This subroutine interpolates a real 2D array defined over mass
+!              coordinate points, to V (momentum) points.
+!
+!------------------------------------------------------------------------------
+  IMPLICIT NONE
+
+  INTEGER, INTENT(IN) :: i_start     ! Starting i index for this model tile
+  INTEGER, INTENT(IN) :: i_end       ! Ending   i index for this model tile
+  INTEGER, INTENT(IN) :: j_start     ! Starting j index for this model tile
+  INTEGER, INTENT(IN) :: j_end       ! Ending   j index for this model tile
+  INTEGER, INTENT(IN) :: jds         ! Starting j index for entire model domain
+  INTEGER, INTENT(IN) :: jde         ! Ending   j index for entire model domain
+  INTEGER, INTENT(IN) :: ims         ! Starting i index for model patch 
+  INTEGER, INTENT(IN) :: ime         ! Ending   i index for model patch 
+  INTEGER, INTENT(IN) :: jms         ! Starting j index for model patch 
+  INTEGER, INTENT(IN) :: jme         ! Ending   j index for model patch 
+  REAL,   INTENT(IN)  :: arrin ( ims:ime, jms:jme )  ! input array on mass points
+  REAL,   INTENT(OUT) :: arrout( ims:ime, jms:jme )  ! output array on V points 
+
+! Local variables
+  integer :: i, j
+
+! Do domain interior first
+  do j = max(2,j_start), j_end
+    do i = i_start, i_end
+      arrout(i,j) = 0.5*(arrin(i,j)+arrin(i,j-1))
+    enddo
+  enddo
+
+! Do south-north boundaries
+  if(j_start .eq. jds) then
+    do i = i_start, i_end
+      arrout(i,j_start) = arrin(i,j_start)
+    enddo
+  endif
+  if(j_end .eq. jde-1) then
+    do i = i_start, i_end
+      arrout(i,j_end+1) = arrin(i,j_end)
+    enddo
+  endif
+
+  RETURN
+  END SUBROUTINE vpoint
+
+  LOGICAL FUNCTION TILE_MASK(iloc, jloc, its, ite, jts, jte)
+!------------------------------------------------------------------------------
+! PURPOSE: Check to see if an i, j grid coordinate is in the tile index range.
+!      
+! Returns: TRUE if the grid coordinate (ILOC,JLOC) is in the tile defined by
+!                  tile-range indices (its,jts) and (ite,jte)
+!          FALSE otherwise.
+!
+!------------------------------------------------------------------------------
+  IMPLICIT NONE
+
+  INTEGER, INTENT(IN) :: iloc
+  INTEGER, INTENT(IN) :: jloc
+  INTEGER, INTENT(IN) :: its
+  INTEGER, INTENT(IN) :: ite
+  INTEGER, INTENT(IN) :: jts
+  INTEGER, INTENT(IN) :: jte
+
+! Local variables
+  LOGICAL :: retval
+
+  TILE_MASK = (iloc .LE. ite .AND. iloc .GE. its .AND.    &
+               jloc .LE. jte .AND. jloc .GE. jts )
+
+  RETURN
+  END FUNCTION TILE_MASK
+
+!-----------------------------------------------------------------------
+  SUBROUTINE nudob(j, ivar, aten, inest, ifrest, ktau, ktaur,         &
+                       xtime, mu, msf, nndgv, nerrf, niobf, maxdom,   &
+                       npfi, ionf, rinxy, twindo, levidn,             &
+                       parid, nstat, i_parent_start, j_parent_start,  &
+                       fdob, lev_in_ob, plfo, nlevs_ob,               &
+                       iratio, dx, dtmin, rio, rjo, rko,              &
+                       timeob, varobs, errf, pbase, ptop, pp,         &
+                       iswind, istemp, ismois, giv, git, giq,         &
+                       savwt, kpblt, nscan,                           &
+                       iprt,                                          &
+                       ids,ide, jds,jde, kds,kde,                     &  ! domain dims
+                       ims,ime, jms,jme, kms,kme,                     &  ! memory dims
+                       its,ite, jts,jte, kts,kte )                       ! tile   dims
+
+!-----------------------------------------------------------------------
+  USE module_model_constants
+  USE module_domain
+!-----------------------------------------------------------------------
+  IMPLICIT NONE
+!-----------------------------------------------------------------------
+!
+! PURPOSE: THIS SUBROUTINE GENERATES NUDGING TENDENCIES FOR THE J-TH
+!     VERTICAL SLICE (I-K PLANE) FOR FOUR-DIMENSIONAL DATA
+!     ASSIMILATION FROM INDIVIDUAL OBSERVATIONS.  THE NUDGING
+!     TENDENCIES ARE FOUND FROM A ONE-PASS CALCULATION OF
+!     WEIGHTING FACTORS SIMILAR TO THE BENJAMIN-SEAMAN OBJECTIVE
+!     ANALYSIS.  THIS SUBROUTINE IS DESIGNED FOR RAPID EXECUTION
+!     AND MINIMAL STORAGE REQUIREMENTS.  ALGORITHMS SHOULD BE
+!     VECTORIZED WHEREVER POSSIBLE.
+!
+!     HISTORY: Original author: MM5 version???
+!              02/04/2004 - Creation of WRF version.           Al Bourgeois
+!              08/28/2006 - Conversion from F77 to F90         Al Bourgeois
+!------------------------------------------------------------------------------
+!
+! NOTE: This routine was originally designed for MM5, which uses
+!       a nonstandard (I,J) coordinate system. For WRF, I is the 
+!       east-west running coordinate, and J is the south-north
+!       running coordinate. So a "J-slab" here is west-east in
+!       extent, not south-north as for MM5.      -ajb 06/10/2004
+!
+!     NET WEIGHTING (WT) OF THE DIFFERENCE BETWEEN THE OBSERVATIONS
+!     AND LOCAL FORECAST VALUES IS BASED ON THE MULTIPLE OF THREE
+!
+!     NET WEIGHTING (WT) OF THE DIFFERENCE BETWEEN THE OBSERVATIONS
+!     AND LOCAL FORECAST VALUES IS BASED ON THE MULTIPLE OF THREE
+!     TYPES OF FACTORS:
+!       1) TIME WEIGHTING - ONLY OBSERVATIONS WITHIN A SELECTED
+!          TIME WINDOW (TWINDO) CENTERED AT THE CURRENT FORECAST
+!          TIME (XTIME) ARE USED.  OBSERVATIONS CLOSEST TO
+!          XTIME ARE TIME-WEIGHTED MOST HEAVILY (TIMEWT)
+!       2) VERTICAL WEIGHTING - NON-ZERO WEIGHTS (WTSIG) ARE
+!          CALCULATED WITHIN A VERTICAL REGION OF INFLUENCE
+!          (RINSIG).
+!       3) HORIZONTAL WEIGHTING - NON-ZERO WEIGHTS (WTIJ) ARE
+!          CALCULATED WITHIN A RADIUS OF INFLUENCE (RINXY).  THE
+!          VALUE OF RIN IS DEFINED IN KILOMETERS, AND CONVERTED
+!          TO GRID LENGTHS FOR THE APPROPRIATE MESH SIZE.
+!
+!     THE FIVE FORECAST VARIABLES ARE PROCESSED BY CHANGING THE
+!     VALUE OF IVAR AS FOLLOWS:
+!             IVAR                     VARIABLE(TAU-1)
+!             ----                     ---------------
+!               1                             U
+!               2                             V
+!               3                             T
+!               4                             QV
+!               5                          PSB(CROSS)   REMOVED IN V3
+!              (6)                           PSB(DOT)
+!
+!-----------------------------------------------------------------------
+!
+!     Description of input arguments.
+!
+!-----------------------------------------------------------------------
+
+  INTEGER, INTENT(IN)  :: ids,ide, jds,jde, kds,kde  ! domain dims.
+  INTEGER, INTENT(IN)  :: ims,ime, jms,jme, kms,kme  ! memory dims.
+  INTEGER, INTENT(IN)  :: its,ite, jts,jte, kts,kte  ! tile   dims.
+  INTEGER, INTENT(IN)  :: j                          ! south-north running coordinate.
+  INTEGER, INTENT(IN)  :: ivar
+  INTEGER, INTENT(IN)  :: inest                      ! domain index
+  LOGICAL, INTENT(IN)  :: ifrest
+  INTEGER, INTENT(IN)  :: ktau
+  INTEGER, INTENT(IN)  :: ktaur
+  REAL, INTENT(IN)     :: xtime                      ! forecast time in minutes
+  INTEGER, INTENT(IN)  :: nndgv                      ! number of nudge variables
+  INTEGER, INTENT(IN)  :: nerrf                      ! number of error fields
+  INTEGER, INTENT(IN)  :: niobf                      ! number of observations
+  INTEGER, INTENT(IN)  :: maxdom                     ! maximum number of domains
+  INTEGER, INTENT(IN)  :: npfi 
+  INTEGER, INTENT(IN)  :: ionf
+  REAL, INTENT(IN)     :: rinxy
+  REAL, INTENT(IN)     :: twindo
+  INTEGER, INTENT(IN)  :: levidn(maxdom)             ! level of nest
+  INTEGER, INTENT(IN)  :: parid(maxdom)              ! parent domain id
+  INTEGER, INTENT(IN)  :: nstat                      ! number of obs stations
+  INTEGER, INTENT(IN)  :: i_parent_start(maxdom)     ! Start i index in parent domain.
+  INTEGER, INTENT(IN)  :: j_parent_start(maxdom)     ! Start j index in parent domain.
+  TYPE(fdob_type), intent(inout)  :: fdob
+  REAL, INTENT(IN)     :: lev_in_ob(niobf)           ! Level in sounding-type obs.
+  REAL, intent(IN)     :: plfo(niobf)
+  REAL, INTENT(IN)     :: nlevs_ob(niobf)            ! Number of levels in sounding.
+  INTEGER, INTENT(IN)  :: iratio                     ! Nest to parent gridsize ratio.
+  REAL, INTENT(IN)     :: dx                         ! This domain grid cell-size (m)
+  REAL, INTENT(IN)     :: dtmin
+  REAL, INTENT(IN)     :: rio(niobf)
+  REAL, INTENT(IN)     :: rjo(niobf)
+  REAL, INTENT(INOUT)  :: rko(niobf)
+  REAL, INTENT(IN)     :: timeob(niobf)
+  REAL, INTENT(IN)     :: varobs(nndgv,niobf)
+  REAL, INTENT(IN)     :: errf(nerrf, niobf)
+  REAL, INTENT(IN)     :: pbase( ims:ime, kms:kme )  ! Base pressure.
+  REAL, INTENT(IN)     :: ptop
+  REAL, INTENT(IN)     :: pp( ims:ime, kms:kme ) ! Pressure perturbation (Pa)
+  REAL, INTENT(IN)     :: mu(ims:ime)   ! Air mass on u, v, or mass-grid
+  REAL, INTENT(IN)     :: msf(ims:ime)  ! Map scale (only used for vars u & v)
+  INTEGER, intent(in)  :: iswind        ! Nudge flag for wind
+  INTEGER, intent(in)  :: istemp        ! Nudge flag for temperature
+  INTEGER, intent(in)  :: ismois        ! Nudge flag for moisture
+  REAL, intent(in)     :: giv           ! Coefficient for wind
+  REAL, intent(in)     :: git           ! Coefficient for temperature
+  REAL, intent(in)     :: giq           ! Coefficient for moisture
+  REAL, INTENT(INOUT)  :: aten( ims:ime, kms:kme)
+  REAL, INTENT(INOUT)  :: savwt( nndgv, ims:ime, kms:kme )
+  INTEGER, INTENT(IN)  :: kpblt(its:ite)
+  INTEGER, INTENT(IN)  :: nscan                      ! number of scans
+  LOGICAL, INTENT(IN)  :: iprt                       ! print flag
+
+! Local variables
+  integer :: mm(maxdom)
+  real :: ra(niobf)
+  real :: rb(niobf)
+  real :: psurf(niobf)
+  real :: wtsig(kms:kme),wt(ims:ime,kms:kme),wt2err(ims:ime,kms:kme)
+  real :: rscale(ims:ime)           ! For converting to rho-coupled units.
+!      real :: tscale(ims:ime,kms:kme)   ! For converting to potential temp. units.
+  real :: reserf(100)
+  character*40 name
+  character*3 chr_hr
+
+!***  DECLARATIONS FOR IMPLICIT NONE
+  integer :: i,k,iplo,icut,ipl,inpf,infr,jjjn
+  integer :: igrid,n,nml,nnl,nsthis,nsmetar,nsspeci,nsship
+  integer :: nssynop,nstemp,nspilot,nssatwnds,nssams,nsprofs
+  integer :: maxi,mini,maxj,minj,nnn,nsndlev,njcsnd,kob
+  integer :: komin,komax,nn,nhi,nlo,nnjc
+  integer :: i_s,i_e
+  integer :: istq
+  real :: gfactor,rfactor,gridx,gridy,rindx,schnes,ris
+  real :: grfacx,grfacy
+  real :: fdtim,tw1,tw2,tconst,timewt,timewt2,ttim,dift,pob
+  real :: ri,rj,rx,ry,rsq,wtij,pdfac,erfivr,dk,slope,rinfac
+  real :: rinprs,pijk,pobhi,poblo,pdiffj,w2eowt,gitq
+
+  real :: scratch
+
+!      print *,'start nudob, nstat,j,ivar=',nstat,j,ivar
+!      if(ivar.ne.4)return
+!yliu start -- for multi-scans: NSCAN=0: original
+!                               NSCAN=1: added a scan with a larger Ri and smaller G
+!       if(NSCAN.ne.0 .and. NSCAN.ne.1)  stop
+! ajb note: Will need to increase memory for SAVWT if NSCAN=1:
+  if(NSCAN.ne.0) then
+    IF (iprt) write(6,*) 'SAVWT must be resized for NSCAN=1'
+    stop
+  endif
+  IPLO=0  + NSCAN*4
+  GFACTOR=1. +  NSCAN*(-1. + 0.33333) 
+  RFACTOR=1. +  NSCAN*(-1. + 3.0)
+!yliu end
+! jc
+
+! return if too close to j boundary
+  if(inest.eq.1.and.ivar.lt.3.and.(j.le.2.or.j.ge.jde-1)) then
+!       write(6,*) '1 RETURN: IVAR = ',ivar,' J = ',j,
+!    $             ' too close to boundary.'
+    return
+  endif
+  if(inest.eq.1.and.ivar.ge.3.and.(j.le.2.or.j.ge.jde-2)) then
+!       write(6,*) '2 RETURN: IVAR = ',ivar,' J = ',j,
+!    $             ' too close to boundary.'
+    return
+  endif
+
+! COMPUTE IPL WHICH REPRESENTS IVAR FOR EACH MESH IN SAVWT MODS
+  ICUT=0
+  IF(INEST.GT.1)ICUT=1
+  i_s = max0(2+icut,its)
+  i_e = min0(ide-1-icut,ite)
+
+  IPL=IVAR    + IPLO     !yliu +IPLO
+
+! DEFINE GRID-TYPE OFFSET FACTORS, IGRID AND GRID
+
+  IF(INEST.EQ.1)THEN
+    INPF=NPFI
+    INFR=IONF
+  ELSE
+    IF(IRATIO.NE.3) THEN
+      IF (iprt) THEN
+        write(6,*) 'iratio = ',iratio
+        write(6,*) 'stop 1 in nudob: iratio = ',iratio
+      ENDIF
+      STOP 1
+    ENDIF
+    INPF=(3**LEVIDN(INEST))*NPFI
+    INFR=(3**LEVIDN(INEST))*IONF
+  ENDIF
+  GRIDX=0.0
+  GRIDY=0.0
+  IGRID=0
+  IF(IVAR.GE.3)THEN
+    GRIDX=0.5
+    GRIDY=0.5
+    IGRID=1
+  ELSEIF(IVAR.eq.1) THEN
+    GRIDY=0.5
+    IGRID=1
+  ELSEIF(IVAR.eq.2) THEN
+    GRIDX=0.5
+    IGRID=1
+  ENDIF
+
+! TRANSFORM THE HORIZONTAL RADIUS OF INFLUENCE, RINXY, FROM
+! KILOMETERS TO GRID LENGTHS, RINDX
+
+  RINDX=RINXY*1000./DX          * RFACTOR   !yliu *RFACTOR
+
+! jc
+! make horizontal radius vary per nest
+!     rindx=rindx/float(inest)
+! yliu test1 -- En 3, 4
+!     rindx=rindx/float(3**(in-1))                                               !YLIU
+! jc
+! make horizontal radius vary per nest
+!     schnes=1/float(inest)                                                      !JC
+! yliu test1 -- En 3, 4                                                          !YLIU
+  schnes=1/float(3**(inest-1))                                                   !JC
+! reduce the Rinf in the nested grid proportionally
+  rindx=rindx*schnes
+! rinfmn =1., rinfmx=2., pfree=50 in param.F
+! yliu test: for upper-air data, use larger influence radii
+!            Essentially increase the slope -- the same radii
+!            at 500mb and above as the coarse mesh and the
+!            same small radii at sfc as that for sfc obs
+  fdob%rinfmx=2. *1.0 /schnes                                                    !YLIU
+!         rinfmx=1.2*1.0 /schnes                                                 !YLIU
+! jc
+  RIS=RINDX*RINDX
+  IF(IFREST.AND.KTAU.EQ.KTAUR)GOTO 5
+  IF(MOD(KTAU,INFR).NE.0)GOTO 126
+5 CONTINUE
+  IF (iprt) THEN
+   IF(J.EQ.10) write(6,6) INEST,J,KTAU,XTIME,IVAR,IPL,rindx
+  ENDIF
+6 FORMAT(1X,'OBS NUDGING FOR IN,J,KTAU,XTIME,',                    &
+            'IVAR,IPL: ',I2,1X,I2,1X,I5,1X,F8.2,1X,I2,1X,I2,       &
+            ' rindx=',f4.1)
+
+! SET RA AND RB
+  IF(INEST.EQ.1) THEN
+
+! SET RA AND RB FOR THE COARSE MESH...
+    DO N=1,NSTAT
+      RA(N)=RIO(N)-GRIDX
+      RB(N)=RJO(N)-GRIDY
+    ENDDO
+
+  ELSE
+
+! SET RA AND RB FOR THE FINE MESH CASE...
+    DO N=1,NSTAT
+
+! COMPUTE THE OBS LOCATION WITH RESPECT TO THIS MESH (INEST)...
+      NML=INEST
+      MM(LEVIDN(INEST)+1)=INEST
+! WORKING TOWARD COARSER MESHES, DETERMINE THE HIERARCHY OF MOTHER
+! MESHES WITH RESPECT TO EACH MOTHER MESH STARTING AT MESH "INEST"...
+! THAT IS, DETERMINE ITS MOTHER, GRANDMOTHER, GREAT-GRANDMOTHER, ETC.
+! OUT TO THE COARSE GRID MESH (INEST=1).
+! LEVIDN HOLDS THE NEST LEVEL AND PARID HOLDS THE MOTHER MESH FOR EACH
+! GRID (E.G., FOR 3 MESHES AND 2 NEST LEVELS, INEST=1 IS THE COARSE GRID
+! MESH, INEST=2 HAS LEVIDN(2)=1 AND PARID(2)=1, AND INEST=3 HAS LEVIDN(3)=2
+! AND PARID(3)=2...)
+      DO NNL=LEVIDN(INEST),1,-1
+        MM(NNL)=PARID(NML)
+        NML=MM(NNL)
+      ENDDO
+
+! MM(1) MUST BE THE COARSE GRID MESH (INEST=0)
+
+      IF(MM(1).NE.1) then
+        IF (iprt) write(6,*) 'stop 21 in nudob: inest = ',inest
+        STOP 21
+      ENDIF
+      RA(N)=RIO(N)
+      RB(N)=RJO(N)
+      DO NNL=1,LEVIDN(INEST)
+        GRFACX=0.
+        GRFACY=0.
+! COMPUTE THE OBS LOCATION WITH RESPECT TO THE INNER GRID IN DOT-POINT
+! SPACE (GRID=0.).  WHEN WE REACH MESH IN, THEN USE "GRID" TO GO TO
+! CROSS OR DOT DEPENDING ON THE VARIABLE...
+        IF(NNL.EQ.LEVIDN(INEST)) THEN
+          GRFACX=GRIDX
+          GRFACY=GRIDY
+        ENDIF
+
+        RA(N)=(RA(N)-FLOAT(i_parent_start(MM(NNL+1))))*       &
+                     FLOAT(IRATIO)+1.-GRFACX
+        RB(N)=(RB(N)-FLOAT(j_parent_start(MM(NNL+1))))*       &
+                     FLOAT(IRATIO)+1.-GRFACY
+
+      ENDDO
+
+    ENDDO    ! END LOOP OVER OBS STATIONS FOR FINE MESH CASE
+
+  ENDIF    ! END SECTION FOR SETTING RA AND RB
+
+
+! OUTPUT OBS PER GRID EVERY HOUR
+  if ( mod(xtime,60.).gt.56. .and. ivar.eq.3 .and. j.eq.10) then
+    IF (iprt) print *,'outputting obs number on grid ',    &
+                 inest,' at time=',xtime
+    write(chr_hr(1:3),'(i3)')nint(xtime/60.)
+    if(chr_hr(1:1).eq.' ')chr_hr(1:1)='0'
+    if(chr_hr(2:2).eq.' ')chr_hr(2:2)='0'
+    IF (iprt) print *,'chr_hr=',chr_hr(1:3),nint(xtime/60.)
+    open(91,file=                                             &
+        'obs_g'//char(inest+ichar('0'))//'_'//chr_hr(1:3),    &
+        form='FORMATted',status='unknown')
+    write(91,911)nstat
+    write(6,911)nstat
+911 FORMAT('total obs=',i8)
+    nsthis=0
+    nsmetar=0
+    nsspeci=0
+    nsship=0
+    nssynop=0
+    nstemp=0
+    nspilot=0
+    nssatwnds=0
+    nssams=0
+    nsprofs=0
+!   print *,'ide,jde=',ide,jde
+    do jjjn=1,nstat
+! DETERMINE THE TIME-WEIGHT FACTOR FOR N
+      FDTIM=XTIME-DTMIN
+! CONVERT TWINDO AND TIMEOB FROM HOURS TO MINUTES:
+      TW1=TWINDO/2.*60.
+      TW2=TWINDO*60.
+      TCONST=1./TW1
+      TIMEWT2=0.0
+      TTIM=TIMEOB(jjjn)*60.
+!***********TTIM=TARGET TIME IN MINUTES
+      DIFT=ABS(FDTIM-TTIM)
+      IF(DIFT.LE.TW1)TIMEWT2=1.0
+
+      IF(DIFT.GT.TW1.AND.DIFT.LE.TW2) THEN
+        IF(FDTIM.LT.TTIM)TIMEWT2=(FDTIM-(TTIM-TW2))*TCONST
+        IF(FDTIM.GT.TTIM)TIMEWT2=((TTIM+TW2)-FDTIM)*TCONST
+      ENDIF
+
+!     print *,'timewt2=',timewt2,ttim,fdtim
+      if (ra(jjjn).ge.1. .and. rb(jjjn).ge.1.                    &
+      .and.ra(jjjn).le.real(ide) .and. rb(jjjn).le.real(jde)     &
+      .and.timewt2.gt.0.) then
+        if(lev_in_ob(jjjn).eq.1.)nsthis=nsthis+1
+        if(plfo(jjjn).eq.1.)nsmetar=nsmetar+1
+        if(plfo(jjjn).eq.2.)nsspeci=nsspeci+1
+        if(plfo(jjjn).eq.3.)nsship=nsship+1
+        if(plfo(jjjn).eq.4.)nssynop=nssynop+1
+        if(plfo(jjjn).eq.5..and.lev_in_ob(jjjn).eq.1.) nstemp=nstemp+1
+        if(plfo(jjjn).eq.6..and.lev_in_ob(jjjn).eq.1.) nspilot=nspilot+1
+        if(plfo(jjjn).eq.7.)nssatwnds=nssatwnds+1
+        if(plfo(jjjn).eq.8.)nssams=nssams+1
+        if(plfo(jjjn).eq.9..and.lev_in_ob(jjjn).eq.1.) nsprofs=nsprofs+1
+      endif
+    enddo
+    write(91,912)nsthis
+    write(6,912)nsthis
+912 FORMAT('total obs on this grid=',i8)
+    write(91,921)nsmetar
+    write(6,921)nsmetar
+921 FORMAT('total metar obs on this grid=',i8)
+    write(91,922)nsspeci
+    write(6,922)nsspeci
+922 FORMAT('total special obs on this grid=',i8)
+    write(91,923)nsship
+    write(6,923)nsship
+923 FORMAT('total ship obs on this grid=',i8)
+    write(91,924)nssynop
+    write(6,924)nssynop
+924 FORMAT('total synop obs on this grid=',i8)
+    write(91,925)nstemp
+    write(6,925)nstemp
+925 FORMAT('total temp obs on this grid=',i8)
+    write(91,926)nspilot
+    write(6,926)nspilot
+926 FORMAT('total pilot obs on this grid=',i8)
+    write(91,927)nssatwnds
+    write(6,927)nssatwnds
+927 FORMAT('total sat-wind obs on this grid=',i8)
+    write(91,928)nssams
+    write(6,928)nssams
+928 FORMAT('total sams obs on this grid=',i8)
+    write(91,929)nsprofs
+    write(6,929)nsprofs
+929 FORMAT('total profiler obs on this grid=',i8)
+    close(91)
+  endif  ! END OUTPUT OBS PER GRID EVERY HOUR
+
+
+! INITIALIZE WEIGHTING ARRAYS TO ZERO
+  DO I=its,ite
+    DO K=1,kte
+      WT(I,K)=0.0
+      WT2ERR(I,K)=0.0
+    ENDDO
+  ENDDO
+
+! DO P* COMPUTATIONS ON DOT POINTS FOR IVAR.LT.3 (U AND V)
+! AND CROSS POINTS FOR IVAR.GE.3 (T,Q,P*).
+!
+! COMPUTE P* AT OBS LOCATION (RA,RB).  DO THIS AS SEPARATE VECTOR LOOP H
+! SO IT IS ALREADY AVAILABLE IN NSTAT LOOP 120 BELOW
+
+! PSURF IS NOT AVAILABLE GLOBALLY, THEREFORE, THE BILINEAR INTERPOLATION
+! AROUND THE OBS POINT IS DONE IN ERROB() AND STORED IN ERRF([678],N) FOR
+! THE POINT (6=PRESS, 7=U-MOM, 8=V-MOM).
+  DO N=1,NSTAT
+    IF(IVAR.GE.3)THEN
+      PSURF(N)=ERRF(6,N)
+    ELSE
+      IF(IVAR.EQ.1)THEN
+        PSURF(N)=ERRF(7,N)        ! U-points
+      ELSE
+        PSURF(N)=ERRF(8,N)        ! V-points
+      ENDIF
+    ENDIF
+  ENDDO
+
+! DETERMINE THE LIMITS OF THE SEARCH REGION FOR THE CURRENT
+! J-STRIP
+
+  MAXJ=J+IFIX(RINDX*fdob%RINFMX+0.99)                                        !ajb
+  MINJ=J-IFIX(RINDX*fdob%RINFMX+0.99)                                        !ajb
+
+! jc comment out this? want to use obs beyond the domain?
+!      MAXJ=MIN0(JL-IGRID,MAXJ)           !yliu
+!      MINJ=MAX0(1,MINJ)                  !yliu
+
+  n=1
+
+!***********************************************************************
+  DO nnn=1,NSTAT   ! BEGIN OUTER LOOP FOR THE NSTAT OBSERVATIONS
+!***********************************************************************
+! Soundings are consecutive obs, but they need to be treated as a single 
+! entity. Thus change the looping to nnn, with n defined separately.
+
+
+!yliu 
+!  note for sfc data: nsndlev=1 and njcsnd=1
+    nsndlev=int(nlevs_ob(n)-lev_in_ob(n))+1   
+
+! yliu start -- set together with the other parts
+! test: do the sounding levels as individual obs
+!   nsndlev=1
+! yliu end
+    njcsnd=nsndlev
+! set pob here, to be used later
+    pob=varobs(5,n)
+!     print *, "s-- n=,nsndlev",n,njcsnd,J, ipl
+!     print *, "s--",ivar,(errf(ivar,i),i=n,n+njcsnd)
+! CHECK TO SEE OF STATION N HAS DATA FOR VARIABLE IVAR
+! AND IF IT IS SUFFICIENTLY CLOSE TO THE J STRIP.  THIS
+! SHOULD ELIMINATE MOST STATIONS FROM FURTHER CONSIDER-
+! ATION.
+
+!yliu: Skip bad obs if it is sfc or single level sounding.
+!yliu: Before this (020918), a snd will be skipped if its first 
+!yliu        level has bad data- often true due to elevation
+
+    IF( ABS(ERRF(IVAR,N)).GT.9.E4 .and. njcsnd.eq.1 ) THEN
+!     print *, " bad obs skipped"
+
+    ELSEIF( RB(N).LT.FLOAT(MINJ) .OR. RB(N).GT.FLOAT(MAXJ) ) THEN
+!     print *, " skipped obs far away from this J-slice"
+
+!----------------------------------------------------------------------
+    ELSE    ! BEGIN SECTION FOR PROCESSING THE OBSERVATION
+!----------------------------------------------------------------------
+
+! DETERMINE THE TIME-WEIGHT FACTOR FOR N
+      FDTIM=XTIME-DTMIN
+! TWINDO IS IN MINUTES:
+      TW1=TWINDO/2.*60.
+      TW2=TWINDO*60.
+      TCONST=1./TW1
+      TIMEWT=0.0
+      TTIM=TIMEOB(N)*60.
+!***********TTIM=TARGET TIME IN MINUTES
+      DIFT=ABS(FDTIM-TTIM)
+      IF(DIFT.LE.TW1)TIMEWT=1.0
+      IF(DIFT.GT.TW1.AND.DIFT.LE.TW2) THEN
+        IF(FDTIM.LT.TTIM)TIMEWT=(FDTIM-(TTIM-TW2))*TCONST
+        IF(FDTIM.GT.TTIM)TIMEWT=((TTIM+TW2)-FDTIM)*TCONST
+      ENDIF
+
+! DETERMINE THE LIMITS OF APPLICATION OF THE OBS IN THE VERTICAL
+! FOR THE VERTICAL WEIGHTING, WTSIG
+
+! ASSIMILATE OBSERVATIONS ON PRESSURE LEVELS, EXCEPT FOR SURFACE
+!ajb 20021210: (Bugfix) RKO is not available globally. It is computed in
+!ajb ERROB() by the processor handling the obs point, and stored in ERRF(9,N).
+
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
+      rko(n) = errf(9,n)        !ajb 20021210
+#endif
+      KOB=nint(RKO(N))
+      KOB=MIN0(kte,KOB)
+      KOB=MAX0(1,KOB)
+
+! ASSIMILATE SURFACE LAYER DATA ON SIGMA
+      IF(KOB.EQ.1.AND.IVAR.LE.4.and.nlevs_ob(n).lt.1.5) THEN
+        DO K=1,kte
+          WTSIG(K)=0.0
+        ENDDO
+! DEFINE WTSIG: (FOR SRP: SPREAD SURFACE DATA THROUGH LOWEST 200 M)
+!       WTSIG(1)=1.0
+!       WTSIG(2)=0.67
+!       WTSIG(3)=0.33
+!       KOMIN=3
+!       KOMAX=1
+! DEFINE THE MAX AND MIN I VALUES FOR POSSIBLE NONZERO
+! WEIGHTS, BASED ON THE RADIUS OF INFLUENCE, RINDX (IN GRID LENGTHS).
+! fix this because kpblt at 1 and il is 0
+        MAXI=IFIX(RA(N)+0.99+RINDX)
+        MAXI=MIN0(ide-1,MAXI)
+        MINI=IFIX(RA(N)-RINDX-0.99)
+        MINI=MAX0(2,MINI)
+!yliu start
+! use also obs outside of this domain  -- surface obs
+!     if(RA(N).LT.0.-RINDX .or. RA(N).GT.float(IL+RINDX) .or.
+!    &   RB(N).LT.0.-RINDX .or. RB(N).GT.float(JL+RINDX)) then
+!        print *, " skipped obs far away from this domain"
+! currently can use obs within this domain or ones very close to (1/3
+!   influence of radius in the coarse domain) this
+!   domain. In later case, use BC column value to approximate the model value
+!   at obs point -- ERRF need model field in errob.F !!
+        if (  RA(N).GE.(0.-RINDX/3)                        &
+        .and. RA(N).LE.float(ide)+RINDX/3                  &
+        .and. RB(N).GE.(0.-RINDX/3)                        &
+        .and. RB(N).LE.float(jde)+RINDX/3) then
+
+! or use obs within this domain only
+!     if(RA(N).LT.1 .or. RA(N).GT.float(IL) .or.
+!    &   RB(N).LT.1 .or. RB(N).GT.float(JL)) then
+!        print *, " skipped obs far outside of this domain"
+!        if(j.eq.3 .and. ivar.eq.3) then
+!           write(6,*) 'N = ',n,' exit 120 3'
+!        endif
+!yliu end
+!
+! LOOP THROUGH THE NECESSARY GRID POINTS SURROUNDING
+! OBSERVATION N.  COMPUTE THE HORIZONTAL DISTANCE TO
+! THE OBS AND FIND THE WEIGHTING SUM OVER ALL OBS
+          RJ=FLOAT(J)
+          RX=RJ-RB(N)
+! WEIGHTS FOR THE 3-D VARIABLES
+          ERFIVR=ERRF(IVAR,N)
+!
+!JM I will be local, because it indexes into PDOC, WT, and others
+
+!      if((ivar.eq.1 .or. ivar.eq.3) .and. n.le.200) then
+!        write(6,'(a,i3,a,i3)')'SURF OBS NEAR: N = ',n,' nest = ',inest
+!        write(6,'(a,f10.3,a,f10.3,a,i3,a,i3,a,i3,a,i2)')
+!     $        ' RA =',RA(N),' RB =',RB(N),' J =',j,
+!     $        ' MINI =',MINI,' MAXI =',MAXI,' NEST =',inest
+!      endif
+
+          DO I=max0(its,MINI),min0(ite,MAXI)
+
+            RI=FLOAT(I)
+            RY=RI-RA(N)
+            RIS=RINDX*RINDX
+            RSQ=RX*RX+RY*RY
+!           DPRIM=SQRT(RSQ)
+! THIS FUNCTION DECREASES WTIJ AS PSFC CHANGES WITHIN SEARCH RADIUS
+!           D=DPRIM+RINDX*DCON*ABS(PSBO(N)-PDOC(I,J))
+!           DSQ=D*D
+!           WTIJ=(RIS-DSQ)/(RIS+DSQ)
+            wtij=(ris-rsq)/(ris+rsq)
+            scratch = (abs(psurf(n)-.001*pbase(i,1))*fdob%DCON)
+            pdfac=1.-AMIN1(1.0,scratch)
+            wtij=wtij*pdfac
+            WTIJ=AMAX1(0.0,WTIJ)
+
+! try making sfc obs weighting go thru pbl
+! jc kpbl is at dot or cross only - need to interpolate?
+!          wtsig(1)=1.
+            komax=max0(3,kpblt(i))
+
+! jc arbitrary check here
+            IF (iprt) THEN
+              if (kpblt(i).gt.25 .and. ktau.ne.0)                         &
+                                     write(6,552)inest,i,j,kpblt(i)
+552           FORMAT('kpblt is gt 25, inest,i,j,kpblt=',4i4)
+            ENDIF
+
+            if(kpblt(i).gt.25) komax=3
+            komin=1
+            dk=float(komax)
+
+            do k=komin,komax
+  
+              wtsig(k)=float(komax-k+1)/dk
+              WT(I,K)=WT(I,K)+TIMEWT*WTSIG(K)*WTIJ
+
+              WT2ERR(I,K)=WT2ERR(I,K)+TIMEWT*TIMEWT*WTIJ*WTIJ*WTSIG(K)    &
+                          *WTSIG(K)*ERFIVR
+
+!            if(ivar.eq.1 .and. i.eq.38 .and. j.eq.78) then
+!
+!             write(6,'(a,i2,a,f8.3,a,f8.3,a,f8.3,a,f8.3,a,f8.3)')
+!                         'Surface obs, after: k = ',k,            &
+!                         ' WT2ERR = ',wt2err(i,k),                &
+!                         ' TIMEWT = ',timewt,                     &
+!                         ' WTIJ = ',wtij,                         &
+!                         ' WSIG = ',wtsig(k),                     &
+!                         ' ERFIVR = ',erfivr
+!            endif
+
+            enddo
+
+          ENDDO
+
+!         print *, "  Surface "
+
+        endif   ! end check for obs in domain
+! END SURFACE-LAYER U OR V OBS NUDGING
+
+      ELSE    
+! BEGIN CALCULATIONS TO SPREAD OBS INFLUENCE ALONG PRESSURE LEVELS
+!
+!       print *,'in upper air section'
+! DEFINE THE MAX AND MIN I VALUES FOR POSSIBLE NONZERO
+! WEIGHTS, BASED ON THE RADIUS OF INFLUENCE, RINDX, AND RINFAC.
+! RINFAC VARIES AS A LINEAR FUNCTION FROM FROM RINFMN AT P*+PTOP
+! TO RINFMX AT PFREE AND "ABOVE" (LOWER PRESSURE).
+!ajb          SLOPE=(RINFMN-RINFMX)/(PSBO(N)+PTOP-PFREE)
+
+        slope = (fdob%RINFMN-fdob%RINFMX)/(psurf(n)-fdob%PFREE)
+
+        RINFAC=SLOPE*POB+fdob%RINFMX-SLOPE*fdob%pfree
+        RINFAC=AMAX1(RINFAC,fdob%RINFMN)
+        RINFAC=AMIN1(RINFAC,fdob%RINFMX)
+!yliu: for multilevel upper-air data, take the maximum
+!      for the I loop.
+        if(nsndlev.gt.1) RINFAC = fdob%RINFMX 
+!yliu end
+
+        MAXI=IFIX(RA(N)+0.99+RINDX*RINFAC)
+        MAXI=MIN0(ide-IGRID,MAXI)
+        MINI=IFIX(RA(N)-RINDX*RINFAC-0.99)
+        MINI=MAX0(1,MINI)
+
+! yliu start
+! use also obs outside of but close to this domain  -- upr data   
+!     if(   RA(N).LT.(0.-RINFAC*RINDX)
+!    & .or. RA(N).GT.float(IL)+RINFAC*RINDX
+!    & .or. RB(N).LT.(0.-RINFAC*RINDX)
+!    & .or. RB(N).GT.float(JL)+RINFAC*RINDX)then          
+!        print *, " skipped obs far away from this I-range"
+! currently can use obs within this domain or ones very close to (1/3
+!   influence of radius in the coarse domain) this 
+!   domain. In later case, use BC column value to approximate the model value 
+!   at obs point -- ERRF need model field in errob.F !!
+
+!cc         if (i.eq.39 .and. j.eq.34) then
+!cc            write(6,*) 'RA(N) = ',ra(n) 
+!cc            write(6,*) 'rinfac = ',rinfac,' rindx = ',rindx
+!cc         endif
+        if(   RA(N).GE.(0.-RINFAC*RINDX/3)                      &
+        .and. RA(N).LE.float(ide)+RINFAC*RINDX/3                &
+        .and. RB(N).GE.(0.-RINFAC*RINDX/3)                      &
+        .and. RB(N).LE.float(jde)+RINFAC*RINDX/3) then
+! or use obs within this domain only
+!     if(RA(N).LT.1 .or. RA(N).GT.float(IL) .or.
+!    &   RB(N).LT.1 .or. RB(N).GT.float(JL)) then
+!        print *, " skipped obs far outside of this domain"
+
+! yliu end
+! is this 2 needed here - kpbl not used?
+!          MINI=MAX0(2,MINI)
+
+! LOOP THROUGH THE NECESSARY GRID POINTS SURROUNDING
+! OBSERVATION N.  COMPUTE THE HORIZONTAL DISTANCE TO
+! THE OBS AND FIND THE WEIGHTING SUM OVER ALL OBS
+          RJ=FLOAT(J)
+          RX=RJ-RB(N)
+! WEIGHTS FOR THE 3-D VARIABLES
+!
+          ERFIVR=ERRF(IVAR,N)
+! jc
+          nsndlev=int(nlevs_ob(n)-lev_in_ob(n))+1
+! yliu start
+! test: do the sounding levels as individual obs
+!        nsndlev=1
+! yliu end
+          njcsnd=nsndlev
+!
+          DO I=max0(its,MINI),min0(ite,MAXI)
+! jc
+            RI=FLOAT(I)
+            RY=RI-RA(N)
+            RIS=RINDX*RINFAC*RINDX*RINFAC
+            RSQ=RX*RX+RY*RY
+! yliu test: for upper-air data, keep D1 influence radii
+!           RIS=RIS  /schnes /schnes
+            WTIJ=(RIS-RSQ)/(RIS+RSQ)
+            WTIJ=AMAX1(0.0,WTIJ)
+! weight ob in vertical with +- 50 mb
+! yliu: 75 hba for single upper-air, 30hba for multi-level soundings
+            if(nsndlev.eq.1) then
+              rinprs=7.5
+            else
+             rinprs=3.0
+            endif
+! yliu end
+! 
+!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+!   ---  HANDLE 1-LEVEL and MULTI-LEVEL OBSERVATIONS SEPARATELY  ---
+!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+
+            if(nsndlev.eq.1)then 
+!----------------------------------------------------------------------
+!         ---   HANDLE 1-LEVEL OBSERVATIONS  ---
+!----------------------------------------------------------------------
+
+!         if(I.eq.MINI) print *, "  Single snd "
+! ERFIVR is the residual (difference) between the ob and the model
+! at that point. We can analyze that residual up and down.
+! First find komin for ob.
+!yliu start -- in the old code, komax and komin were reversed!
+              do k=kte,1,-1
+                pijk = .001*(pbase(i,k)+pp(i,k))
+!               print *,'k,pijk,pob,rinprs=',k,pijk,pob,rinprs
+                if(pijk.ge.(pob+rinprs)) then
+                  komin=k
+                  go to 325
+                endif
+              enddo
+              komin=1
+ 325          continue
+! now find komax for ob
+              do k=3,kte
+                pijk = .001*(pbase(i,k)+pp(i,k))
+                if(pijk.le.(pob-rinprs)) then
+                  komax=k
+                  go to 326
+                endif
+              enddo
+              komax=kte   ! yliu 20050706
+ 326          continue
+
+! yliu: single-level upper-air data will act either above or below the PBL top
+!          komax=min0(kpblt(i), komax) 
+              if(komax.gt.kpblt(i)) komin=max0(kpblt(i), komin) 
+              if(komin.lt.kpblt(i)) komax=min0(kpblt(i), komax) 
+! yliu end
+!
+!           print *,'1 level, komin,komax=',komin,komax
+!           if(i.eq.MINI) then
+!             print *, "yyyyyyyyyyS IPL erfivr=", IPL, ERFIVR,J,pob
+!             ERFIVR=0
+!           endif
+              do k=1,kte
+                reserf(k)=0.0
+                wtsig(k)=0.0
+              enddo
+!yliu end
+
+!cc         if (i.eq.39 .and. j.eq.34) then
+!cc              write(6,*) ' komin = ', komin,' komax = ',komax
+!cc         endif
+
+              do k=komin,komax
+                pijk = .001*(pbase(i,k)+pp(i,k))
+                reserf(k)=erfivr
+                wtsig(k)=1.-abs(pijk-pob)/rinprs
+                wtsig(k)=amax1(wtsig(k),0.0)
+!             print *,'k,pijk,pob,rinprs,wtsig=',k,pijk,pob,rinprs,wtsig(k)
+! Now calculate WT and WT2ERR for each i,j,k point                      cajb
+                WT(I,K)=WT(I,K)+TIMEWT*WTIJ*wtsig(k)
+
+                WT2ERR(I,K)=WT2ERR(I,K)+TIMEWT*TIMEWT*WTIJ*WTIJ*        &
+                            reserf(k)*wtsig(k)*wtsig(k)
+              enddo
+
+            else
+!----------------------------------------------------------------------
+!         ---   HANDLE MULTI-LEVEL OBSERVATIONS  ---
+!----------------------------------------------------------------------
+!yliu start 
+!           if(I.eq.MINI) print *, "  Multi-level  snd "
+!             print *, "   n=,nsndlev",n,nsndlev,nlevs_ob(n),lev_in_ob(n)  &
+!                  ,nlevs_ob(n+nsndlev-1),lev_in_ob(n+nsndlev-1) 
+              if(nlevs_ob(n+nsndlev-1).ne.lev_in_ob(n+nsndlev-1)) then
+                IF (iprt) THEN
+                  print *, "n = ",n,"nsndlev = ",nsndlev 
+                  print *, "nlevs_ob,lev_in_ob",                          &
+                           nlevs_ob(n+nsndlev-1),lev_in_ob(n+nsndlev-1)
+                  print *, "in nudobs.F: sounding level messed up, stopping"
+                ENDIF
+                stop
+              endif       
+!yliu end
+! This is for a multi-level observation
+! The trick here is that the sounding is "one ob". You don't
+!    want multiple levels to each be treated like separate
+!    and independent observations.
+! At each i,j want to interpolate sounding to the model levels at that
+!    particular point.
+              komin=1
+              komax=kte-2
+! this loop goes to 1501
+! do from kte-2 to 1 so don't adjust top of model. Arbitrary.
+!yliu start
+              do k=1,kte
+                reserf(k)=0.0
+                wtsig(k)=0.0
+              enddo
+!yliu end
+
+              do k=komax,komin,-1
+  
+                pijk = .001*(pbase(i,k)+pp(i,k))
+
+! if sigma level pressure is .gt. than the lowest ob level, don't interpolate
+                if(pijk.gt.varobs(5,n)) then
+                  go to 1501
+                endif
+
+! if sigma level pressure is .lt. than the highest ob level, don't interpolate
+                if(pijk.le.varobs(5,n+nsndlev-1)) then 
+                  go to 1501
+                endif
+
+! now interpolate sounding to this k
+! yliu start-- recalculate WTij for each k-level
+!ajb      SLOPE = (fdob%RINFMN-fdob%RINFMX)/(pdoc(i,j)+PTOP-fdob%PFREE)        
+                slope = (fdob%RINFMN-fdob%RINFMX)/ (.001*pbase(i,1)-fdob%PFREE)
+                RINFAC=SLOPE*pijk+fdob%RINFMX-SLOPE*fdob%PFREE              
+                RINFAC=AMAX1(RINFAC,fdob%RINFMN)      
+                RINFAC=AMIN1(RINFAC,fdob%RINFMX)
+                RIS=RINDX*RINFAC*RINDX*RINFAC  
+                RSQ=RX*RX+RY*RY               
+
+! for upper-air data, keep D1 influence radii
+!         RIS=RIS  /schnes /schnes
+                WTIJ=(RIS-RSQ)/(RIS+RSQ)      
+                WTIJ=AMAX1(0.0,WTIJ)
+! yliu end
+
+! this loop goes to 1503
+                do nn=2,nsndlev
+! only set pobhi if varobs(ivar) is ok
+                  pobhi=-888888.
+
+                  if(varobs(ivar,n+nn-1).gt.-800000.                           &
+                  .and. varobs(5,n+nn-1).gt.-800000.) then
+                    pobhi=varobs(5,n+nn-1)
+                    nhi=n+nn-1
+                    if(pobhi.lt.pijk .and. abs(pobhi-pijk).lt.20.) then
+                      go to 1502        ! within 200mb of obs height
+                    endif
+                  endif
+
+                enddo
+
+! did not find any ob above within 100 mb, so jump out 
+                go to 1501
+ 1502           continue
+
+                nlo=nhi-1
+                do nnjc=nhi-1,n,-1 
+                  if(varobs(ivar,nnjc).gt.-800000.                             &
+                  .and. varobs(5,nnjc).gt.-800000.) then
+                    poblo=varobs(5,nnjc)
+                    nlo=nnjc
+                    if(poblo.gt.pijk .and. abs(poblo-pijk).lt.20.) then
+                      go to 1505        ! within 200mb of obs height
+                    endif
+                  endif
+                enddo
+!yliu end --
+
+! did not find any ob below within 200 mb, so jump out 
+                go to 1501
+ 1505           continue
+
+! interpolate to model level
+                pdiffj=alog(pijk/poblo)/alog(pobhi/poblo)
+                reserf(k)=errf(ivar,nlo)+                               &
+                            (errf(ivar,nhi)-errf(ivar,nlo))*pdiffj
+                wtsig(k)=1.
+  
+ 1501           continue
+
+! now calculate WT and WT2ERR for each i,j,k point                               cajb
+                WT(I,K)=WT(I,K)+TIMEWT*WTIJ*wtsig(k)
+  
+                WT2ERR(I,K)=WT2ERR(I,K)+TIMEWT*TIMEWT*WTIJ*WTIJ*        &
+                            reserf(k)*wtsig(k)*wtsig(k)
+
+!        if(ivar.eq.1 .and. i.eq.38 .and. j.eq.78) then
+!
+!            if(wt(i,k) .ne. 0.0) then
+!               scratch = WT2ERR(I,K)/WT(I,K)
+!            else
+!               scratch = 999.
+!            endif
+!
+!         write(6,'(a,i2,a,f8.3,a,f4.2,a,f7.4,a,f4.2,a,f5.3,a,f7.4)')
+!    $                    'Multi-level obs: k = ',k,
+!    $                    ' WT2ERR = ',wt2err(i,k),
+!    $                    ' WTIJ = ',wtij,
+!    $                    ' RSF = ',reserf(k),
+!    $                    ' WSIG = ',wtsig(k),
+!    $                    ' WT = ',wt(i,k),
+!    $                    ' W2EOWT = ',scratch
+!        endif
+
+
+! end do k
+              enddo   ! enddo k levels
+! end multi-levels
+            endif  ! end if(nsndlev.eq.1)
+!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+!   END 1-LEVEL AND MULTI-LEVEL OBSERVATIONS
+!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+!
+          ENDDO ! END DO MINI,MAXI LOOP
+
+        endif ! check for obs in domain
+
+! END OF NUDGING TO OBS ON PRESSURE LEVELS
+
+      ENDIF !end IF(KOB.EQ.1.AND.IVAR.LE.4.and.nlevs_ob(n).lt.1.5)
+
+!----------------------------------------------------------------------
+    ENDIF  ! END SECTION FOR PROCESSING OF OBSERVATION
+!----------------------------------------------------------------------
+
+!   n=n+1
+    n=n+njcsnd
+
+!yliu  1202 continue
+    if(n.gt.nstat)then
+!     print *,'n,nstat=',n,nstat,ivar,j
+      go to 1203
+    endif
+!   print *, "e-- n=,nsndlev",n,njcsnd,nlevs_ob(n),lev_in_ob(n) 
+
+!***********************************************************************
+  ENDDO  ! END OUTER LOOP FOR THE NSTAT OBSERVATIONS
+!***********************************************************************
+
+ 1203 continue
+
+! WEIGHTS AND WEIGHTED DIFFERENCES HAVE BEEN SUMMED.  NOW
+! APPLY THE NUDGING FACTOR AND THE RESULTANT TENDENCY TO
+! THE ATEN ARRAY
+! ASSURE THAT WT(I,K) AND WTP(I,K) ARE NONZERO SINCE
+! THEY ARE USED BELOW IN THE DENOMINATOR.
+  DO K=kts,kte
+    DO I=its,ite
+      IF(WT(I,K).EQ.0)THEN
+        WT2ERR(I,K)=0.0
+      ENDIF
+      IF(WT(I,K).EQ.0)THEN
+        WT(I,K)=1.0
+      ENDIF
+    ENDDO
+  ENDDO
+
+126 CONTINUE
+
+  IF(IVAR.GE.3)GOTO 170
+! this is for u,v
+! 3-D DOT POINT TENDENCIES
+ 
+! Calculate scales for converting nudge factor from u (v)
+! to rho_u (or rho_v) units.
+  
+  call calc_rcouple_scales(mu,msf,rscale,ims,ime,its,ite)
+ 
+  DO K=1,kte
+
+    DO I=i_s,i_e
+
+      IF(MOD(KTAU,INFR).EQ.0.OR.(IFREST.AND.KTAU.EQ.KTAUR))THEN
+        W2EOWT=WT2ERR(I,K)/WT(I,K)
+      ELSE
+        W2EOWT=SAVWT(IPL,I,K)
+      ENDIF
+
+!      if(ivar .eq. 1 .and. i.eq.38 .and. j.eq.78 .and. k.eq.1) then
+!           scratch = GIV*RSCALE(I)*W2EOWT*fdob%TFACI*ISWIND*GFACTOR
+!           write(6,*) 'ATEN calc: k = ',k
+!           write(6,*) 'U before: aten = ',aten(i,k),' scr = ',scratch
+!           write(6,*) 'GIV = ',giv,' rscale = ',rscale(i),
+!     $               ' W2EOWT = ',w2eowt
+!           write(6,*) 'TFACI = ',fdob%tfaci,' ISWIND = ',iswind,
+!     $               ' GFACTOR = ',gfactor
+!       endif
+!
+!      if(ivar .eq. 2 .and. i.eq.39 .and. j.eq.29) then
+!           scratch = GIV*RSCALE(I)*W2EOWT*fdob%TFACI*ISWIND*GFACTOR
+!           write(6,*) 'ATEN calc: k = ',k
+!           write(6,*) 'V before: aten = ',aten(i,k),' scr = ',scratch
+!           write(6,*) 'GIV = ',giv,' rscale = ',rscale(i),
+!     $                ' W2EOWT = ',w2eowt
+!           write(6,*) 'TFACI = ',fdob%tfaci,' ISWIND = ',iswind,
+!     $                ' GFACTOR = ',gfactor
+!       endif
+
+        ATEN(i,k)=ATEN(i,k)+GIV*RSCALE(I)                        &
+                    *W2EOWT*fdob%TFACI                           &
+                    *ISWIND       *GFACTOR   !yliu *GFACTOR 
+
+!      if(ivar .eq. 1 .and. i.eq.38 .and. j.eq.78 .and. k.eq.1) then
+!           write(6,*) 'U after: aten = ',aten(i,k),' scr = ',scratch
+!      endif
+!      if(ivar .eq. 2 .and. i.eq.39 .and. j.eq.29) then
+!           write(6,*) 'V after: aten = ',aten(i,k),' scr = ',scratch
+!      endif
+
+    ENDDO
+  ENDDO
+
+  IF(MOD(KTAU,INFR).EQ.0.OR.(IFREST.AND.KTAU.EQ.KTAUR))THEN
+    DO K=1,kte
+      DO I=its,ite
+        SAVWT(IPL,I,K)=WT2ERR(I,K)/WT(I,K)
+      ENDDO
+    ENDDO
+  ENDIF
+
+  RETURN
+
+170 CONTINUE
+
+! 3-D CROSS-POINT TENDENCIES
+! this is for t (ivar=3) and q (ivsr=4)
+  IF(3-IVAR.LT.0)THEN
+    GITQ=GIQ
+  ELSE
+    GITQ=GIT
+  ENDIF
+  IF(3-IVAR.LT.0)THEN
+    ISTQ=ISMOIS
+  ELSE
+    ISTQ=ISTEMP
+  ENDIF
+
+  DO K=1,kte
+    DO I=i_s,i_e
+      IF(MOD(KTAU,INFR).EQ.0.OR.(IFREST.AND.KTAU.EQ.KTAUR))THEN
+        W2EOWT=WT2ERR(I,K)/WT(I,K)
+      ELSE
+        W2EOWT=SAVWT(IPL,I,K)
+      ENDIF
+
+!        if(ivar .eq. 3 .and. i.eq.39 .and. j.eq.29) then
+!            scratch = GITQ*MU(I)*W2EOWT*fdob%TFACI*ISTQ*GFACTOR
+!            write(6,*) 'ATEN calc: k = ',k
+!            write(6,*) 'T before: aten = ',aten(i,k),' scr = ',scratch
+!            write(6,*) 'GITQ = ',gitq,' MU = ',mu(i),
+!     $                 ' W2EOWT = ',w2eowt
+!            write(6,*) ' TFACI = ',fdob%tfaci,' ISTQ = ',istq,
+!     $                 ' GFACTOR = ',gfactor
+!        endif
+!
+!        if(ivar .eq. 4 .and. i.eq.39 .and. j.eq.29) then
+!            scratch = GITQ*MU(I)*W2EOWT*fdob%TFACI*ISTQ*GFACTOR
+!            write(6,*) 'ATEN calc: k = ',k
+!            write(6,*) 'Q before: aten = ',aten(i,k),' scr = ',scratch
+!            write(6,*) 'GITQ = ',gitq,' MU = ',mu(i),
+!     $                 ' W2EOWT = ',w2eowt
+!            write(6,*) ' TFACI = ',fdob%tfaci,' ISTQ = ',istq,
+!     $                 ' GFACTOR = ',gfactor
+!        endif
+
+      ATEN(i,k)=ATEN(i,k)+GITQ*MU(I)                       &
+                  *W2EOWT*fdob%TFACI*ISTQ       *GFACTOR   !yliu *GFACTOR
+
+!        if(ivar .eq. 3 .and. i.eq.39 .and. j.eq.29) then
+!            write(6,*) 'T after: aten = ',aten(i,k),' scr = ',scratch
+!        endif
+!        if(ivar .eq. 4 .and. i.eq.39 .and. j.eq.29) then
+!            write(6,*) 'Q after: aten = ',aten(i,k),' scr = ',scratch
+!        endif
+
+    ENDDO
+  ENDDO
+
+  IF(MOD(KTAU,INFR).EQ.0.OR.(IFREST.AND.KTAU.EQ.KTAUR)) THEN
+    DO K=1,kte
+      DO I=its,ite
+        SAVWT(IPL,I,K)=WT2ERR(I,K)/WT(I,K)
+      ENDDO
+    ENDDO
+  ENDIF
+
+  RETURN
+  END SUBROUTINE nudob
+
+  SUBROUTINE calc_rcouple_scales(a, msf, rscale, ims,ime, its,ite)
+!-----------------------------------------------------------------------
+  IMPLICIT NONE
+!-----------------------------------------------------------------------
+
+  INTEGER, INTENT(IN)  :: ims,ime           ! Memory dimensions
+  INTEGER, INTENT(IN)  :: its,ite           ! Tile   dimensions
+  REAL, INTENT(IN)     :: a( ims:ime )      ! Air mass array 
+  REAL, INTENT(IN)     :: msf( ims:ime )    ! Map scale factor array
+  REAL, INTENT(OUT)    :: rscale( ims:ime ) ! Scales for rho-coupling
+
+! Local variables
+  integer :: i
+
+! Calculate scales to be used for producing rho-coupled nudging factors.
+  do i = its,ite
+    rscale(i) = a(i)/msf(i)
+  enddo
+
+  RETURN
+  END SUBROUTINE calc_rcouple_scales
+
+!ajb: Not used
+  SUBROUTINE set_real_array(rscale, value, ims,ime, its,ite)
+!-----------------------------------------------------------------------
+  IMPLICIT NONE
+!-----------------------------------------------------------------------
+
+  INTEGER, INTENT(IN)  :: ims,ime           ! Memory dimensions
+  INTEGER, INTENT(IN)  :: its,ite           ! Tile   dimensions
+  REAL, INTENT(IN)     :: value             ! Constant array value
+  REAL, INTENT(OUT)    :: rscale( ims:ime ) ! Output array
+
+! Local variables
+  integer :: i
+
+! Set array to constant value
+  do i = its,ite
+    rscale(i) = value 
+  enddo
+
+  RETURN
+  END SUBROUTINE set_real_array
+
+!ajb: Not used
+  SUBROUTINE calc_pottemp_scales(ivar, rcp, pb, p, tscale,             &
+                                       ims,ime, its,ite,               &
+                                     kms,kme, kts,kte)
+!-----------------------------------------------------------------------
+  IMPLICIT NONE
+!-----------------------------------------------------------------------
+
+  INTEGER, INTENT(IN)  :: ims,ime, kms,kme      ! Memory dimensions
+  INTEGER, INTENT(IN)  :: its,ite, kts,kte      ! Tile   dimensions
+  INTEGER, INTENT(IN)  :: ivar                  ! Variable identifier 
+  REAL, INTENT(IN)     :: rcp                   ! Constant (2./7.)
+  REAL, INTENT(IN)     :: pb(ims:ime, kms:kme)  ! Base pressure (Pa) array 
+  REAL, INTENT(IN)     :: p(ims:ime, kms:kme)   ! Pressure pert. (Pa) array
+  REAL, INTENT(OUT)    :: tscale(ims:ime, kms:kme) ! Scales for pot. temp.
+! Local variables
+  integer :: i,k
+
+  if(ivar.eq.3) then
+
+! Calculate scales to be used for producing potential temperature nudging factors.
+    do k = kts,kte
+    do i = its,ite
+      tscale(i,k) = ( 1000000. / ( pb(i,k)+p(i,k)) )**rcp
+    enddo
+    enddo
+  else
+! Set to 1. for moisture scaling.
+    do k = kts,kte
+      do i = its,ite
+        tscale(i,k) = 1.0 
+      enddo
+    enddo
+  endif
+      
+  RETURN
+  END SUBROUTINE calc_pottemp_scales
+#endif
+
+END MODULE module_fddaobs_rtfdda
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_gfs_funcphys.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_gfs_funcphys.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_gfs_funcphys.F	(revision 2744)
@@ -0,0 +1,2935 @@
+!-------------------------------------------------------------------------------
+module module_gfs_funcphys
+!$$$  Module Documentation Block
+!
+! Module:    funcphys        API for basic thermodynamic physics
+!   Author: Iredell          Org: W/NX23     Date: 1999-03-01
+!
+! Abstract: This module provides an Application Program Interface
+!   for computing basic thermodynamic physics functions, in particular
+!     (1) saturation vapor pressure as a function of temperature,
+!     (2) dewpoint temperature as a function of vapor pressure,
+!     (3) equivalent potential temperature as a function of temperature
+!         and scaled pressure to the kappa power,
+!     (4) temperature and specific humidity along a moist adiabat
+!         as functions of equivalent potential temperature and
+!         scaled pressure to the kappa power,
+!     (5) scaled pressure to the kappa power as a function of pressure, and
+!     (6) temperature at the lifting condensation level as a function
+!         of temperature and dewpoint depression.
+!   The entry points required to set up lookup tables start with a "g".
+!   All the other entry points are functions starting with an "f" or
+!   are subroutines starting with an "s".  These other functions and
+!   subroutines are elemental; that is, they return a scalar if they
+!   are passed only scalars, but they return an array if they are passed
+!   an array.  These other functions and subroutines can be inlined, too.
+!   
+! Program History Log:
+!   1999-03-01  Mark Iredell
+!   1999-10-15  Mark Iredell  SI unit for pressure (Pascals)
+!   2001-02-26  Mark Iredell  Ice phase changes of Hong and Moorthi
+!
+! Public Variables:
+!   krealfp         Integer parameter kind or length of reals (=kind_phys)
+!
+! Public Subprograms:
+!   gpvsl            Compute saturation vapor pressure over liquid table
+!
+!   fpvsl           Elementally compute saturation vapor pressure over liquid
+!     function result Real(krealfp) saturation vapor pressure in Pascals
+!     t               Real(krealfp) temperature in Kelvin
+!
+!   fpvslq          Elementally compute saturation vapor pressure over liquid
+!     function result Real(krealfp) saturation vapor pressure in Pascals
+!     t               Real(krealfp) temperature in Kelvin
+!
+!   fpvslx          Elementally compute saturation vapor pressure over liquid
+!     function result Real(krealfp) saturation vapor pressure in Pascals
+!     t               Real(krealfp) temperature in Kelvin
+!
+!   gpvsi            Compute saturation vapor pressure over ice table
+!
+!   fpvsi           Elementally compute saturation vapor pressure over ice
+!     function result Real(krealfp) saturation vapor pressure in Pascals
+!     t               Real(krealfp) temperature in Kelvin
+!
+!   fpvsiq          Elementally compute saturation vapor pressure over ice
+!     function result Real(krealfp) saturation vapor pressure in Pascals
+!     t               Real(krealfp) temperature in Kelvin
+!
+!   fpvsix          Elementally compute saturation vapor pressure over ice
+!     function result Real(krealfp) saturation vapor pressure in Pascals
+!     t               Real(krealfp) temperature in Kelvin
+!
+!   gpvs            Compute saturation vapor pressure table
+!
+!   fpvs            Elementally compute saturation vapor pressure
+!     function result Real(krealfp) saturation vapor pressure in Pascals
+!     t               Real(krealfp) temperature in Kelvin
+!
+!   fpvsq           Elementally compute saturation vapor pressure
+!     function result Real(krealfp) saturation vapor pressure in Pascals
+!     t               Real(krealfp) temperature in Kelvin
+!
+!   fpvsx           Elementally compute saturation vapor pressure
+!     function result Real(krealfp) saturation vapor pressure in Pascals
+!     t               Real(krealfp) temperature in Kelvin
+!
+!   gtdpl           Compute dewpoint temperature over liquid table
+!
+!   ftdpl           Elementally compute dewpoint temperature over liquid
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   ftdplq          Elementally compute dewpoint temperature over liquid
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   ftdplx          Elementally compute dewpoint temperature over liquid
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   ftdplxg         Elementally compute dewpoint temperature over liquid
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     t               Real(krealfp) guess dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   gtdpi           Compute dewpoint temperature table over ice
+!
+!   ftdpi           Elementally compute dewpoint temperature over ice
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   ftdpiq          Elementally compute dewpoint temperature over ice
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   ftdpix          Elementally compute dewpoint temperature over ice
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   ftdpixg         Elementally compute dewpoint temperature over ice
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     t               Real(krealfp) guess dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   gtdp            Compute dewpoint temperature table
+!
+!   ftdp            Elementally compute dewpoint temperature
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   ftdpq           Elementally compute dewpoint temperature
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   ftdpx           Elementally compute dewpoint temperature
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   ftdpxg          Elementally compute dewpoint temperature
+!     function result Real(krealfp) dewpoint temperature in Kelvin
+!     t               Real(krealfp) guess dewpoint temperature in Kelvin
+!     pv              Real(krealfp) vapor pressure in Pascals
+!
+!   gthe            Compute equivalent potential temperature table
+!
+!   fthe            Elementally compute equivalent potential temperature
+!     function result Real(krealfp) equivalent potential temperature in Kelvin
+!     t               Real(krealfp) LCL temperature in Kelvin
+!     pk              Real(krealfp) LCL pressure over 1e5 Pa to the kappa power
+!
+!   ftheq           Elementally compute equivalent potential temperature
+!     function result Real(krealfp) equivalent potential temperature in Kelvin
+!     t               Real(krealfp) LCL temperature in Kelvin
+!     pk              Real(krealfp) LCL pressure over 1e5 Pa to the kappa power
+!
+!   fthex           Elementally compute equivalent potential temperature
+!     function result Real(krealfp) equivalent potential temperature in Kelvin
+!     t               Real(krealfp) LCL temperature in Kelvin
+!     pk              Real(krealfp) LCL pressure over 1e5 Pa to the kappa power
+!
+!   gtma            Compute moist adiabat tables
+!
+!   stma            Elementally compute moist adiabat temperature and moisture
+!     the             Real(krealfp) equivalent potential temperature in Kelvin
+!     pk              Real(krealfp) pressure over 1e5 Pa to the kappa power
+!     tma             Real(krealfp) parcel temperature in Kelvin
+!     qma             Real(krealfp) parcel specific humidity in kg/kg
+!
+!   stmaq           Elementally compute moist adiabat temperature and moisture
+!     the             Real(krealfp) equivalent potential temperature in Kelvin
+!     pk              Real(krealfp) pressure over 1e5 Pa to the kappa power
+!     tma             Real(krealfp) parcel temperature in Kelvin
+!     qma             Real(krealfp) parcel specific humidity in kg/kg
+!
+!   stmax           Elementally compute moist adiabat temperature and moisture
+!     the             Real(krealfp) equivalent potential temperature in Kelvin
+!     pk              Real(krealfp) pressure over 1e5 Pa to the kappa power
+!     tma             Real(krealfp) parcel temperature in Kelvin
+!     qma             Real(krealfp) parcel specific humidity in kg/kg
+!
+!   stmaxg          Elementally compute moist adiabat temperature and moisture
+!     tg              Real(krealfp) guess parcel temperature in Kelvin
+!     the             Real(krealfp) equivalent potential temperature in Kelvin
+!     pk              Real(krealfp) pressure over 1e5 Pa to the kappa power
+!     tma             Real(krealfp) parcel temperature in Kelvin
+!     qma             Real(krealfp) parcel specific humidity in kg/kg
+!
+!   gpkap           Compute pressure to the kappa table
+!
+!   fpkap           Elementally raise pressure to the kappa power.
+!     function result Real(krealfp) p over 1e5 Pa to the kappa power
+!     p               Real(krealfp) pressure in Pascals
+!
+!   fpkapq          Elementally raise pressure to the kappa power.
+!     function result Real(krealfp) p over 1e5 Pa to the kappa power
+!     p               Real(krealfp) pressure in Pascals
+!
+!   fpkapo          Elementally raise pressure to the kappa power.
+!     function result Real(krealfp) p over 1e5 Pa to the kappa power
+!     p               Real(krealfp) surface pressure in Pascals
+!
+!   fpkapx          Elementally raise pressure to the kappa power.
+!     function result Real(krealfp) p over 1e5 Pa to the kappa power
+!     p               Real(krealfp) pressure in Pascals
+!
+!   grkap           Compute pressure to the 1/kappa table
+!
+!   frkap           Elementally raise pressure to the 1/kappa power.
+!     function result Real(krealfp) pressure in Pascals
+!     pkap            Real(krealfp) p over 1e5 Pa to the 1/kappa power
+!
+!   frkapq          Elementally raise pressure to the kappa power.
+!     function result Real(krealfp) pressure in Pascals
+!     pkap            Real(krealfp) p over 1e5 Pa to the kappa power
+!
+!   frkapx          Elementally raise pressure to the kappa power.
+!     function result Real(krealfp) pressure in Pascals
+!     pkap            Real(krealfp) p over 1e5 Pa to the kappa power
+!
+!   gtlcl           Compute LCL temperature table
+!
+!   ftlcl           Elementally compute LCL temperature.
+!     function result Real(krealfp) temperature at the LCL in Kelvin
+!     t               Real(krealfp) temperature in Kelvin
+!     tdpd            Real(krealfp) dewpoint depression in Kelvin
+!
+!   ftlclq          Elementally compute LCL temperature.
+!     function result Real(krealfp) temperature at the LCL in Kelvin
+!     t               Real(krealfp) temperature in Kelvin
+!     tdpd            Real(krealfp) dewpoint depression in Kelvin
+!
+!   ftlclo          Elementally compute LCL temperature.
+!     function result Real(krealfp) temperature at the LCL in Kelvin
+!     t               Real(krealfp) temperature in Kelvin
+!     tdpd            Real(krealfp) dewpoint depression in Kelvin
+!
+!   ftlclx          Elementally compute LCL temperature.
+!     function result Real(krealfp) temperature at the LCL in Kelvin
+!     t               Real(krealfp) temperature in Kelvin
+!     tdpd            Real(krealfp) dewpoint depression in Kelvin
+!
+!   gfuncphys       Compute all physics function tables
+!
+! Attributes:
+!   Language: Fortran 90
+!
+!$$$
+  use module_gfs_machine,only:kind_phys
+  use module_gfs_physcons
+  implicit none
+  private
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Public Variables
+! integer,public,parameter:: krealfp=selected_real_kind(15,45)
+  integer,public,parameter:: krealfp=kind_phys
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Private Variables
+  real(krealfp),parameter:: psatb=con_psat*1.e-5
+  integer,parameter:: nxpvsl=7501
+  real(krealfp) c1xpvsl,c2xpvsl,tbpvsl(nxpvsl)
+  integer,parameter:: nxpvsi=7501
+  real(krealfp) c1xpvsi,c2xpvsi,tbpvsi(nxpvsi)
+  integer,parameter:: nxpvs=7501
+  real(krealfp) c1xpvs,c2xpvs,tbpvs(nxpvs)
+  integer,parameter:: nxtdpl=5001
+  real(krealfp) c1xtdpl,c2xtdpl,tbtdpl(nxtdpl)
+  integer,parameter:: nxtdpi=5001
+  real(krealfp) c1xtdpi,c2xtdpi,tbtdpi(nxtdpi)
+  integer,parameter:: nxtdp=5001
+  real(krealfp) c1xtdp,c2xtdp,tbtdp(nxtdp)
+  integer,parameter:: nxthe=241,nythe=151
+  real(krealfp) c1xthe,c2xthe,c1ythe,c2ythe,tbthe(nxthe,nythe)
+  integer,parameter:: nxma=151,nyma=121
+  real(krealfp) c1xma,c2xma,c1yma,c2yma,tbtma(nxma,nyma),tbqma(nxma,nyma)
+! integer,parameter:: nxpkap=5501
+  integer,parameter:: nxpkap=11001
+  real(krealfp) c1xpkap,c2xpkap,tbpkap(nxpkap)
+  integer,parameter:: nxrkap=5501
+  real(krealfp) c1xrkap,c2xrkap,tbrkap(nxrkap)
+  integer,parameter:: nxtlcl=151,nytlcl=61
+  real(krealfp) c1xtlcl,c2xtlcl,c1ytlcl,c2ytlcl,tbtlcl(nxtlcl,nytlcl)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Public Subprograms
+  public gpvsl,fpvsl,fpvslq,fpvslx
+  public gpvsi,fpvsi,fpvsiq,fpvsix
+  public gpvs,fpvs,fpvsq,fpvsx
+  public gtdpl,ftdpl,ftdplq,ftdplx,ftdplxg
+  public gtdpi,ftdpi,ftdpiq,ftdpix,ftdpixg
+  public gtdp,ftdp,ftdpq,ftdpx,ftdpxg
+  public gthe,fthe,ftheq,fthex
+  public gtma,stma,stmaq,stmax,stmaxg
+  public gpkap,fpkap,fpkapq,fpkapo,fpkapx
+  public grkap,frkap,frkapq,frkapx
+  public gtlcl,ftlcl,ftlclq,ftlclo,ftlclx
+  public gfuncphys
+contains
+!-------------------------------------------------------------------------------
+  subroutine gpvsl
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gpvsl        Compute saturation vapor pressure table over liquid
+!   Author: N Phillips            W/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Computes saturation vapor pressure table as a function of
+!   temperature for the table lookup function fpvsl.
+!   Exact saturation vapor pressures are calculated in subprogram fpvslx.
+!   The current implementation computes a table with a length
+!   of 7501 for temperatures ranging from 180. to 330. Kelvin.
+!
+! Program History Log:
+!   91-05-07  Iredell
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call gpvsl
+!
+! Subprograms called:
+!   (fpvslx)   inlinable function to compute saturation vapor pressure
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx
+    real(krealfp) xmin,xmax,xinc,x,t
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=180.0_krealfp
+    xmax=330.0_krealfp
+    xinc=(xmax-xmin)/(nxpvsl-1)
+!   c1xpvsl=1.-xmin/xinc
+    c2xpvsl=1./xinc
+    c1xpvsl=1.-xmin*c2xpvsl
+    do jx=1,nxpvsl
+      x=xmin+(jx-1)*xinc
+      t=x
+      tbpvsl(jx)=fpvslx(t)
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function fpvsl(t)
+  function fpvsl(t)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpvsl        Compute saturation vapor pressure over liquid
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute saturation vapor pressure from the temperature.
+!   A linear interpolation is done between values in a lookup table
+!   computed in gpvsl. See documentation for fpvslx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is almost 6 decimal places.
+!   On the Cray, fpvsl is about 4 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   pvsl=fpvsl(t)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!
+!   Output argument list:
+!     fpvsl      Real(krealfp) saturation vapor pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpvsl
+    real(krealfp),intent(in):: t
+    integer jx
+    real(krealfp) xj
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xpvsl+c2xpvsl*t,1._krealfp),real(nxpvsl,krealfp))
+    jx=min(xj,nxpvsl-1._krealfp)
+    fpvsl=tbpvsl(jx)+(xj-jx)*(tbpvsl(jx+1)-tbpvsl(jx))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function fpvslq(t)
+  function fpvslq(t)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpvslq       Compute saturation vapor pressure over liquid
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute saturation vapor pressure from the temperature.
+!   A quadratic interpolation is done between values in a lookup table
+!   computed in gpvsl. See documentation for fpvslx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is almost 9 decimal places.
+!   On the Cray, fpvslq is about 3 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             quadratic interpolation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   pvsl=fpvslq(t)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!
+!   Output argument list:
+!     fpvslq     Real(krealfp) saturation vapor pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpvslq
+    real(krealfp),intent(in):: t
+    integer jx
+    real(krealfp) xj,dxj,fj1,fj2,fj3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xpvsl+c2xpvsl*t,1._krealfp),real(nxpvsl,krealfp))
+    jx=min(max(nint(xj),2),nxpvsl-1)
+    dxj=xj-jx
+    fj1=tbpvsl(jx-1)
+    fj2=tbpvsl(jx)
+    fj3=tbpvsl(jx+1)
+    fpvslq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function fpvslx(t)
+  function fpvslx(t)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpvslx       Compute saturation vapor pressure over liquid
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Exactly compute saturation vapor pressure from temperature.
+!   The water model assumes a perfect gas, constant specific heats
+!   for gas and liquid, and neglects the volume of the liquid.
+!   The model does account for the variation of the latent heat
+!   of condensation with temperature.  The ice option is not included.
+!   The Clausius-Clapeyron equation is integrated from the triple point
+!   to get the formula
+!       pvsl=con_psat*(tr**xa)*exp(xb*(1.-tr))
+!   where tr is ttp/t and other values are physical constants.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   pvsl=fpvslx(t)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!
+!   Output argument list:
+!     fpvslx     Real(krealfp) saturation vapor pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpvslx
+    real(krealfp),intent(in):: t
+    real(krealfp),parameter:: dldt=con_cvap-con_cliq
+    real(krealfp),parameter:: heat=con_hvap
+    real(krealfp),parameter:: xpona=-dldt/con_rv
+    real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp)
+    real(krealfp) tr
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    tr=con_ttp/t
+    fpvslx=con_psat*(tr**xpona)*exp(xponb*(1.-tr))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine gpvsi
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gpvsi        Compute saturation vapor pressure table over ice
+!   Author: N Phillips            W/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Computes saturation vapor pressure table as a function of
+!   temperature for the table lookup function fpvsi.
+!   Exact saturation vapor pressures are calculated in subprogram fpvsix.
+!   The current implementation computes a table with a length
+!   of 7501 for temperatures ranging from 180. to 330. Kelvin.
+!
+! Program History Log:
+!   91-05-07  Iredell
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:  call gpvsi
+!
+! Subprograms called:
+!   (fpvsix)   inlinable function to compute saturation vapor pressure
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx
+    real(krealfp) xmin,xmax,xinc,x,t
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=180.0_krealfp
+    xmax=330.0_krealfp
+    xinc=(xmax-xmin)/(nxpvsi-1)
+!   c1xpvsi=1.-xmin/xinc
+    c2xpvsi=1./xinc
+    c1xpvsi=1.-xmin*c2xpvsi
+    do jx=1,nxpvsi
+      x=xmin+(jx-1)*xinc
+      t=x
+      tbpvsi(jx)=fpvsix(t)
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function fpvsi(t)
+  function fpvsi(t)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpvsi        Compute saturation vapor pressure over ice
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute saturation vapor pressure from the temperature.
+!   A linear interpolation is done between values in a lookup table
+!   computed in gpvsi. See documentation for fpvsix for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is almost 6 decimal places.
+!   On the Cray, fpvsi is about 4 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   pvsi=fpvsi(t)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!
+!   Output argument list:
+!     fpvsi      Real(krealfp) saturation vapor pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpvsi
+    real(krealfp),intent(in):: t
+    integer jx
+    real(krealfp) xj
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xpvsi+c2xpvsi*t,1._krealfp),real(nxpvsi,krealfp))
+    jx=min(xj,nxpvsi-1._krealfp)
+    fpvsi=tbpvsi(jx)+(xj-jx)*(tbpvsi(jx+1)-tbpvsi(jx))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function fpvsiq(t)
+  function fpvsiq(t)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpvsiq       Compute saturation vapor pressure over ice
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute saturation vapor pressure from the temperature.
+!   A quadratic interpolation is done between values in a lookup table
+!   computed in gpvsi. See documentation for fpvsix for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is almost 9 decimal places.
+!   On the Cray, fpvsiq is about 3 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             quadratic interpolation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   pvsi=fpvsiq(t)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!
+!   Output argument list:
+!     fpvsiq     Real(krealfp) saturation vapor pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpvsiq
+    real(krealfp),intent(in):: t
+    integer jx
+    real(krealfp) xj,dxj,fj1,fj2,fj3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xpvsi+c2xpvsi*t,1._krealfp),real(nxpvsi,krealfp))
+    jx=min(max(nint(xj),2),nxpvsi-1)
+    dxj=xj-jx
+    fj1=tbpvsi(jx-1)
+    fj2=tbpvsi(jx)
+    fj3=tbpvsi(jx+1)
+    fpvsiq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function fpvsix(t)
+  function fpvsix(t)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpvsix       Compute saturation vapor pressure over ice
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Exactly compute saturation vapor pressure from temperature.
+!   The water model assumes a perfect gas, constant specific heats
+!   for gas and ice, and neglects the volume of the ice.
+!   The model does account for the variation of the latent heat
+!   of condensation with temperature.  The liquid option is not included.
+!   The Clausius-Clapeyron equation is integrated from the triple point
+!   to get the formula
+!       pvsi=con_psat*(tr**xa)*exp(xb*(1.-tr))
+!   where tr is ttp/t and other values are physical constants.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   pvsi=fpvsix(t)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!
+!   Output argument list:
+!     fpvsix     Real(krealfp) saturation vapor pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpvsix
+    real(krealfp),intent(in):: t
+    real(krealfp),parameter:: dldt=con_cvap-con_csol
+    real(krealfp),parameter:: heat=con_hvap+con_hfus
+    real(krealfp),parameter:: xpona=-dldt/con_rv
+    real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp)
+    real(krealfp) tr
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    tr=con_ttp/t
+    fpvsix=con_psat*(tr**xpona)*exp(xponb*(1.-tr))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine gpvs
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gpvs         Compute saturation vapor pressure table
+!   Author: N Phillips            W/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Computes saturation vapor pressure table as a function of
+!   temperature for the table lookup function fpvs.
+!   Exact saturation vapor pressures are calculated in subprogram fpvsx.
+!   The current implementation computes a table with a length
+!   of 7501 for temperatures ranging from 180. to 330. Kelvin.
+!
+! Program History Log:
+!   91-05-07  Iredell
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:  call gpvs
+!
+! Subprograms called:
+!   (fpvsx)    inlinable function to compute saturation vapor pressure
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx
+    real(krealfp) xmin,xmax,xinc,x,t
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=180.0_krealfp
+    xmax=330.0_krealfp
+    xinc=(xmax-xmin)/(nxpvs-1)
+!   c1xpvs=1.-xmin/xinc
+    c2xpvs=1./xinc
+    c1xpvs=1.-xmin*c2xpvs
+    do jx=1,nxpvs
+      x=xmin+(jx-1)*xinc
+      t=x
+      tbpvs(jx)=fpvsx(t)
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function fpvs(t)
+  function fpvs(t)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpvs         Compute saturation vapor pressure
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute saturation vapor pressure from the temperature.
+!   A linear interpolation is done between values in a lookup table
+!   computed in gpvs. See documentation for fpvsx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is almost 6 decimal places.
+!   On the Cray, fpvs is about 4 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   pvs=fpvs(t)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!
+!   Output argument list:
+!     fpvs       Real(krealfp) saturation vapor pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpvs
+    real(krealfp),intent(in):: t
+    integer jx
+    real(krealfp) xj
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xpvs+c2xpvs*t,1._krealfp),real(nxpvs,krealfp))
+    jx=min(xj,nxpvs-1._krealfp)
+    fpvs=tbpvs(jx)+(xj-jx)*(tbpvs(jx+1)-tbpvs(jx))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function fpvsq(t)
+  function fpvsq(t)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpvsq        Compute saturation vapor pressure
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute saturation vapor pressure from the temperature.
+!   A quadratic interpolation is done between values in a lookup table
+!   computed in gpvs. See documentation for fpvsx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is almost 9 decimal places.
+!   On the Cray, fpvsq is about 3 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             quadratic interpolation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   pvs=fpvsq(t)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!
+!   Output argument list:
+!     fpvsq      Real(krealfp) saturation vapor pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpvsq
+    real(krealfp),intent(in):: t
+    integer jx
+    real(krealfp) xj,dxj,fj1,fj2,fj3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xpvs+c2xpvs*t,1._krealfp),real(nxpvs,krealfp))
+    jx=min(max(nint(xj),2),nxpvs-1)
+    dxj=xj-jx
+    fj1=tbpvs(jx-1)
+    fj2=tbpvs(jx)
+    fj3=tbpvs(jx+1)
+    fpvsq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function fpvsx(t)
+  function fpvsx(t)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpvsx        Compute saturation vapor pressure
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Exactly compute saturation vapor pressure from temperature.
+!   The saturation vapor pressure over either liquid and ice is computed
+!   over liquid for temperatures above the triple point,
+!   over ice for temperatures 20 degress below the triple point,
+!   and a linear combination of the two for temperatures in between.
+!   The water model assumes a perfect gas, constant specific heats
+!   for gas, liquid and ice, and neglects the volume of the condensate.
+!   The model does account for the variation of the latent heat
+!   of condensation and sublimation with temperature.
+!   The Clausius-Clapeyron equation is integrated from the triple point
+!   to get the formula
+!       pvsl=con_psat*(tr**xa)*exp(xb*(1.-tr))
+!   where tr is ttp/t and other values are physical constants.
+!   The reference for this computation is Emanuel(1994), pages 116-117.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   pvs=fpvsx(t)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!
+!   Output argument list:
+!     fpvsx      Real(krealfp) saturation vapor pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpvsx
+    real(krealfp),intent(in):: t
+    real(krealfp),parameter:: tliq=con_ttp
+    real(krealfp),parameter:: tice=con_ttp-20.0
+    real(krealfp),parameter:: dldtl=con_cvap-con_cliq
+    real(krealfp),parameter:: heatl=con_hvap
+    real(krealfp),parameter:: xponal=-dldtl/con_rv
+    real(krealfp),parameter:: xponbl=-dldtl/con_rv+heatl/(con_rv*con_ttp)
+    real(krealfp),parameter:: dldti=con_cvap-con_csol
+    real(krealfp),parameter:: heati=con_hvap+con_hfus
+    real(krealfp),parameter:: xponai=-dldti/con_rv
+    real(krealfp),parameter:: xponbi=-dldti/con_rv+heati/(con_rv*con_ttp)
+    real(krealfp) tr,w,pvl,pvi
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    tr=con_ttp/t
+    if(t.ge.tliq) then
+      fpvsx=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
+    elseif(t.lt.tice) then
+      fpvsx=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
+    else
+      w=(t-tice)/(tliq-tice)
+      pvl=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
+      pvi=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
+      fpvsx=w*pvl+(1.-w)*pvi
+    endif
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine gtdpl
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gtdpl        Compute dewpoint temperature over liquid table
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute dewpoint temperature table as a function of
+!   vapor pressure for inlinable function ftdpl.
+!   Exact dewpoint temperatures are calculated in subprogram ftdplxg.
+!   The current implementation computes a table with a length
+!   of 5001 for vapor pressures ranging from 1 to 10001 Pascals
+!   giving a dewpoint temperature range of 208 to 319 Kelvin.
+!
+! Program History Log:
+!   91-05-07  Iredell
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call gtdpl
+!
+! Subprograms called:
+!   (ftdplxg)  inlinable function to compute dewpoint temperature over liquid
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx
+    real(krealfp) xmin,xmax,xinc,t,x,pv
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=1
+    xmax=10001
+    xinc=(xmax-xmin)/(nxtdpl-1)
+    c1xtdpl=1.-xmin/xinc
+    c2xtdpl=1./xinc
+    t=208.0
+    do jx=1,nxtdpl
+      x=xmin+(jx-1)*xinc
+      pv=x
+      t=ftdplxg(t,pv)
+      tbtdpl(jx)=t
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function ftdpl(pv)
+  function ftdpl(pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdpl        Compute dewpoint temperature over liquid
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute dewpoint temperature from vapor pressure.
+!   A linear interpolation is done between values in a lookup table
+!   computed in gtdpl. See documentation for ftdplxg for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is better than 0.0005 Kelvin
+!   for dewpoint temperatures greater than 250 Kelvin,
+!   but decreases to 0.02 Kelvin for a dewpoint around 230 Kelvin.
+!   On the Cray, ftdpl is about 75 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   tdpl=ftdpl(pv)
+!
+!   Input argument list:
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdpl      Real(krealfp) dewpoint temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdpl
+    real(krealfp),intent(in):: pv
+    integer jx
+    real(krealfp) xj
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xtdpl+c2xtdpl*pv,1._krealfp),real(nxtdpl,krealfp))
+    jx=min(xj,nxtdpl-1._krealfp)
+    ftdpl=tbtdpl(jx)+(xj-jx)*(tbtdpl(jx+1)-tbtdpl(jx))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftdplq(pv)
+  function ftdplq(pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdplq       Compute dewpoint temperature over liquid
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute dewpoint temperature from vapor pressure.
+!   A quadratic interpolation is done between values in a lookup table
+!   computed in gtdpl. see documentation for ftdplxg for details.
+!   Input values outside table range are reset to table extrema.
+!   the interpolation accuracy is better than 0.00001 Kelvin
+!   for dewpoint temperatures greater than 250 Kelvin,
+!   but decreases to 0.002 Kelvin for a dewpoint around 230 Kelvin.
+!   On the Cray, ftdplq is about 60 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             quadratic interpolation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   tdpl=ftdplq(pv)
+!
+!   Input argument list:
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdplq     Real(krealfp) dewpoint temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdplq
+    real(krealfp),intent(in):: pv
+    integer jx
+    real(krealfp) xj,dxj,fj1,fj2,fj3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xtdpl+c2xtdpl*pv,1._krealfp),real(nxtdpl,krealfp))
+    jx=min(max(nint(xj),2),nxtdpl-1)
+    dxj=xj-jx
+    fj1=tbtdpl(jx-1)
+    fj2=tbtdpl(jx)
+    fj3=tbtdpl(jx+1)
+    ftdplq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftdplx(pv)
+  function ftdplx(pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdplx       Compute dewpoint temperature over liquid
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: exactly compute dewpoint temperature from vapor pressure.
+!   An approximate dewpoint temperature for function ftdplxg
+!   is obtained using ftdpl so gtdpl must be already called.
+!   See documentation for ftdplxg for details.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   tdpl=ftdplx(pv)
+!
+!   Input argument list:
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdplx     Real(krealfp) dewpoint temperature in Kelvin
+!
+! Subprograms called:
+!   (ftdpl)    inlinable function to compute dewpoint temperature over liquid
+!   (ftdplxg)  inlinable function to compute dewpoint temperature over liquid
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdplx
+    real(krealfp),intent(in):: pv
+    real(krealfp) tg
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    tg=ftdpl(pv)
+    ftdplx=ftdplxg(tg,pv)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftdplxg(tg,pv)
+  function ftdplxg(tg,pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdplxg      Compute dewpoint temperature over liquid
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Exactly compute dewpoint temperature from vapor pressure.
+!   A guess dewpoint temperature must be provided.
+!   The water model assumes a perfect gas, constant specific heats
+!   for gas and liquid, and neglects the volume of the liquid.
+!   The model does account for the variation of the latent heat
+!   of condensation with temperature.  The ice option is not included.
+!   The Clausius-Clapeyron equation is integrated from the triple point
+!   to get the formula
+!       pvs=con_psat*(tr**xa)*exp(xb*(1.-tr))
+!   where tr is ttp/t and other values are physical constants.
+!   The formula is inverted by iterating Newtonian approximations
+!   for each pvs until t is found to within 1.e-6 Kelvin.
+!   This function can be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   tdpl=ftdplxg(tg,pv)
+!
+!   Input argument list:
+!     tg         Real(krealfp) guess dewpoint temperature in Kelvin
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdplxg    Real(krealfp) dewpoint temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdplxg
+    real(krealfp),intent(in):: tg,pv
+    real(krealfp),parameter:: terrm=1.e-6
+    real(krealfp),parameter:: dldt=con_cvap-con_cliq
+    real(krealfp),parameter:: heat=con_hvap
+    real(krealfp),parameter:: xpona=-dldt/con_rv
+    real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp)
+    real(krealfp) t,tr,pvt,el,dpvt,terr
+    integer i
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    t=tg
+    do i=1,100
+      tr=con_ttp/t
+      pvt=con_psat*(tr**xpona)*exp(xponb*(1.-tr))
+      el=heat+dldt*(t-con_ttp)
+      dpvt=el*pvt/(con_rv*t**2)
+      terr=(pvt-pv)/dpvt
+      t=t-terr
+      if(abs(terr).le.terrm) exit
+    enddo
+    ftdplxg=t
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine gtdpi
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gtdpi        Compute dewpoint temperature over ice table
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute dewpoint temperature table as a function of
+!   vapor pressure for inlinable function ftdpi.
+!   Exact dewpoint temperatures are calculated in subprogram ftdpixg.
+!   The current implementation computes a table with a length
+!   of 5001 for vapor pressures ranging from 0.1 to 1000.1 Pascals
+!   giving a dewpoint temperature range of 197 to 279 Kelvin.
+!
+! Program History Log:
+!   91-05-07  Iredell
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:  call gtdpi
+!
+! Subprograms called:
+!   (ftdpixg)  inlinable function to compute dewpoint temperature over ice
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx
+    real(krealfp) xmin,xmax,xinc,t,x,pv
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=0.1
+    xmax=1000.1
+    xinc=(xmax-xmin)/(nxtdpi-1)
+    c1xtdpi=1.-xmin/xinc
+    c2xtdpi=1./xinc
+    t=197.0
+    do jx=1,nxtdpi
+      x=xmin+(jx-1)*xinc
+      pv=x
+      t=ftdpixg(t,pv)
+      tbtdpi(jx)=t
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function ftdpi(pv)
+  function ftdpi(pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdpi        Compute dewpoint temperature over ice
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute dewpoint temperature from vapor pressure.
+!   A linear interpolation is done between values in a lookup table
+!   computed in gtdpi. See documentation for ftdpixg for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is better than 0.0005 Kelvin
+!   for dewpoint temperatures greater than 250 Kelvin,
+!   but decreases to 0.02 Kelvin for a dewpoint around 230 Kelvin.
+!   On the Cray, ftdpi is about 75 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   tdpi=ftdpi(pv)
+!
+!   Input argument list:
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdpi      Real(krealfp) dewpoint temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdpi
+    real(krealfp),intent(in):: pv
+    integer jx
+    real(krealfp) xj
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xtdpi+c2xtdpi*pv,1._krealfp),real(nxtdpi,krealfp))
+    jx=min(xj,nxtdpi-1._krealfp)
+    ftdpi=tbtdpi(jx)+(xj-jx)*(tbtdpi(jx+1)-tbtdpi(jx))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftdpiq(pv)
+  function ftdpiq(pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdpiq       Compute dewpoint temperature over ice
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute dewpoint temperature from vapor pressure.
+!   A quadratic interpolation is done between values in a lookup table
+!   computed in gtdpi. see documentation for ftdpixg for details.
+!   Input values outside table range are reset to table extrema.
+!   the interpolation accuracy is better than 0.00001 Kelvin
+!   for dewpoint temperatures greater than 250 Kelvin,
+!   but decreases to 0.002 Kelvin for a dewpoint around 230 Kelvin.
+!   On the Cray, ftdpiq is about 60 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             quadratic interpolation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   tdpi=ftdpiq(pv)
+!
+!   Input argument list:
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdpiq     Real(krealfp) dewpoint temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdpiq
+    real(krealfp),intent(in):: pv
+    integer jx
+    real(krealfp) xj,dxj,fj1,fj2,fj3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xtdpi+c2xtdpi*pv,1._krealfp),real(nxtdpi,krealfp))
+    jx=min(max(nint(xj),2),nxtdpi-1)
+    dxj=xj-jx
+    fj1=tbtdpi(jx-1)
+    fj2=tbtdpi(jx)
+    fj3=tbtdpi(jx+1)
+    ftdpiq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftdpix(pv)
+  function ftdpix(pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdpix       Compute dewpoint temperature over ice
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: exactly compute dewpoint temperature from vapor pressure.
+!   An approximate dewpoint temperature for function ftdpixg
+!   is obtained using ftdpi so gtdpi must be already called.
+!   See documentation for ftdpixg for details.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   tdpi=ftdpix(pv)
+!
+!   Input argument list:
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdpix     Real(krealfp) dewpoint temperature in Kelvin
+!
+! Subprograms called:
+!   (ftdpi)    inlinable function to compute dewpoint temperature over ice
+!   (ftdpixg)  inlinable function to compute dewpoint temperature over ice
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdpix
+    real(krealfp),intent(in):: pv
+    real(krealfp) tg
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    tg=ftdpi(pv)
+    ftdpix=ftdpixg(tg,pv)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftdpixg(tg,pv)
+  function ftdpixg(tg,pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdpixg      Compute dewpoint temperature over ice
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Exactly compute dewpoint temperature from vapor pressure.
+!   A guess dewpoint temperature must be provided.
+!   The water model assumes a perfect gas, constant specific heats
+!   for gas and ice, and neglects the volume of the ice.
+!   The model does account for the variation of the latent heat
+!   of sublimation with temperature.  The liquid option is not included.
+!   The Clausius-Clapeyron equation is integrated from the triple point
+!   to get the formula
+!       pvs=con_psat*(tr**xa)*exp(xb*(1.-tr))
+!   where tr is ttp/t and other values are physical constants.
+!   The formula is inverted by iterating Newtonian approximations
+!   for each pvs until t is found to within 1.e-6 Kelvin.
+!   This function can be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   tdpi=ftdpixg(tg,pv)
+!
+!   Input argument list:
+!     tg         Real(krealfp) guess dewpoint temperature in Kelvin
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdpixg    Real(krealfp) dewpoint temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdpixg
+    real(krealfp),intent(in):: tg,pv
+    real(krealfp),parameter:: terrm=1.e-6
+    real(krealfp),parameter:: dldt=con_cvap-con_csol
+    real(krealfp),parameter:: heat=con_hvap+con_hfus
+    real(krealfp),parameter:: xpona=-dldt/con_rv
+    real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp)
+    real(krealfp) t,tr,pvt,el,dpvt,terr
+    integer i
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    t=tg
+    do i=1,100
+      tr=con_ttp/t
+      pvt=con_psat*(tr**xpona)*exp(xponb*(1.-tr))
+      el=heat+dldt*(t-con_ttp)
+      dpvt=el*pvt/(con_rv*t**2)
+      terr=(pvt-pv)/dpvt
+      t=t-terr
+      if(abs(terr).le.terrm) exit
+    enddo
+    ftdpixg=t
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine gtdp
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gtdp         Compute dewpoint temperature table
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute dewpoint temperature table as a function of
+!   vapor pressure for inlinable function ftdp.
+!   Exact dewpoint temperatures are calculated in subprogram ftdpxg.
+!   The current implementation computes a table with a length
+!   of 5001 for vapor pressures ranging from 0.5 to 1000.5 Pascals
+!   giving a dewpoint temperature range of 208 to 319 Kelvin.
+!
+! Program History Log:
+!   91-05-07  Iredell
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:  call gtdp
+!
+! Subprograms called:
+!   (ftdpxg)   inlinable function to compute dewpoint temperature
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx
+    real(krealfp) xmin,xmax,xinc,t,x,pv
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=0.5
+    xmax=10000.5
+    xinc=(xmax-xmin)/(nxtdp-1)
+    c1xtdp=1.-xmin/xinc
+    c2xtdp=1./xinc
+    t=208.0
+    do jx=1,nxtdp
+      x=xmin+(jx-1)*xinc
+      pv=x
+      t=ftdpxg(t,pv)
+      tbtdp(jx)=t
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function ftdp(pv)
+  function ftdp(pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdp         Compute dewpoint temperature 
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute dewpoint temperature from vapor pressure.
+!   A linear interpolation is done between values in a lookup table
+!   computed in gtdp. See documentation for ftdpxg for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is better than 0.0005 Kelvin
+!   for dewpoint temperatures greater than 250 Kelvin,
+!   but decreases to 0.02 Kelvin for a dewpoint around 230 Kelvin.
+!   On the Cray, ftdp is about 75 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   tdp=ftdp(pv)
+!
+!   Input argument list:
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdp       Real(krealfp) dewpoint temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdp
+    real(krealfp),intent(in):: pv
+    integer jx
+    real(krealfp) xj
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xtdp+c2xtdp*pv,1._krealfp),real(nxtdp,krealfp))
+    jx=min(xj,nxtdp-1._krealfp)
+    ftdp=tbtdp(jx)+(xj-jx)*(tbtdp(jx+1)-tbtdp(jx))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftdpq(pv)
+  function ftdpq(pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdpq        Compute dewpoint temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute dewpoint temperature from vapor pressure.
+!   A quadratic interpolation is done between values in a lookup table
+!   computed in gtdp. see documentation for ftdpxg for details.
+!   Input values outside table range are reset to table extrema.
+!   the interpolation accuracy is better than 0.00001 Kelvin
+!   for dewpoint temperatures greater than 250 Kelvin,
+!   but decreases to 0.002 Kelvin for a dewpoint around 230 Kelvin.
+!   On the Cray, ftdpq is about 60 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             quadratic interpolation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   tdp=ftdpq(pv)
+!
+!   Input argument list:
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdpq      Real(krealfp) dewpoint temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdpq
+    real(krealfp),intent(in):: pv
+    integer jx
+    real(krealfp) xj,dxj,fj1,fj2,fj3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xtdp+c2xtdp*pv,1._krealfp),real(nxtdp,krealfp))
+    jx=min(max(nint(xj),2),nxtdp-1)
+    dxj=xj-jx
+    fj1=tbtdp(jx-1)
+    fj2=tbtdp(jx)
+    fj3=tbtdp(jx+1)
+    ftdpq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftdpx(pv)
+  function ftdpx(pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdpx        Compute dewpoint temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: exactly compute dewpoint temperature from vapor pressure.
+!   An approximate dewpoint temperature for function ftdpxg
+!   is obtained using ftdp so gtdp must be already called.
+!   See documentation for ftdpxg for details.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   tdp=ftdpx(pv)
+!
+!   Input argument list:
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdpx      Real(krealfp) dewpoint temperature in Kelvin
+!
+! Subprograms called:
+!   (ftdp)     inlinable function to compute dewpoint temperature
+!   (ftdpxg)   inlinable function to compute dewpoint temperature
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdpx
+    real(krealfp),intent(in):: pv
+    real(krealfp) tg
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    tg=ftdp(pv)
+    ftdpx=ftdpxg(tg,pv)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftdpxg(tg,pv)
+  function ftdpxg(tg,pv)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftdpxg       Compute dewpoint temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Exactly compute dewpoint temperature from vapor pressure.
+!   A guess dewpoint temperature must be provided.
+!   The saturation vapor pressure over either liquid and ice is computed
+!   over liquid for temperatures above the triple point,
+!   over ice for temperatures 20 degress below the triple point,
+!   and a linear combination of the two for temperatures in between.
+!   The water model assumes a perfect gas, constant specific heats
+!   for gas, liquid and ice, and neglects the volume of the condensate.
+!   The model does account for the variation of the latent heat
+!   of condensation and sublimation with temperature.
+!   The Clausius-Clapeyron equation is integrated from the triple point
+!   to get the formula
+!       pvsl=con_psat*(tr**xa)*exp(xb*(1.-tr))
+!   where tr is ttp/t and other values are physical constants.
+!   The reference for this decision is Emanuel(1994), pages 116-117.
+!   The formula is inverted by iterating Newtonian approximations
+!   for each pvs until t is found to within 1.e-6 Kelvin.
+!   This function can be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+! 2001-02-26  Iredell             ice phase
+!
+! Usage:   tdp=ftdpxg(tg,pv)
+!
+!   Input argument list:
+!     tg         Real(krealfp) guess dewpoint temperature in Kelvin
+!     pv         Real(krealfp) vapor pressure in Pascals
+!
+!   Output argument list:
+!     ftdpxg     Real(krealfp) dewpoint temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftdpxg
+    real(krealfp),intent(in):: tg,pv
+    real(krealfp),parameter:: terrm=1.e-6
+    real(krealfp),parameter:: tliq=con_ttp
+    real(krealfp),parameter:: tice=con_ttp-20.0
+    real(krealfp),parameter:: dldtl=con_cvap-con_cliq
+    real(krealfp),parameter:: heatl=con_hvap
+    real(krealfp),parameter:: xponal=-dldtl/con_rv
+    real(krealfp),parameter:: xponbl=-dldtl/con_rv+heatl/(con_rv*con_ttp)
+    real(krealfp),parameter:: dldti=con_cvap-con_csol
+    real(krealfp),parameter:: heati=con_hvap+con_hfus
+    real(krealfp),parameter:: xponai=-dldti/con_rv
+    real(krealfp),parameter:: xponbi=-dldti/con_rv+heati/(con_rv*con_ttp)
+    real(krealfp) t,tr,w,pvtl,pvti,pvt,ell,eli,el,dpvt,terr
+    integer i
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    t=tg
+    do i=1,100
+      tr=con_ttp/t
+      if(t.ge.tliq) then
+        pvt=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
+        el=heatl+dldtl*(t-con_ttp)
+        dpvt=el*pvt/(con_rv*t**2)
+      elseif(t.lt.tice) then
+        pvt=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
+        el=heati+dldti*(t-con_ttp)
+        dpvt=el*pvt/(con_rv*t**2)
+      else
+        w=(t-tice)/(tliq-tice)
+        pvtl=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
+        pvti=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
+        pvt=w*pvtl+(1.-w)*pvti
+        ell=heatl+dldtl*(t-con_ttp)
+        eli=heati+dldti*(t-con_ttp)
+        dpvt=(w*ell*pvtl+(1.-w)*eli*pvti)/(con_rv*t**2)
+      endif
+      terr=(pvt-pv)/dpvt
+      t=t-terr
+      if(abs(terr).le.terrm) exit
+    enddo
+    ftdpxg=t
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine gthe
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gthe        Compute equivalent potential temperature table
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute equivalent potential temperature table
+!   as a function of LCL temperature and pressure over 1e5 Pa
+!   to the kappa power for function fthe.
+!   Equivalent potential temperatures are calculated in subprogram fthex
+!   the current implementation computes a table with a first dimension
+!   of 241 for temperatures ranging from 183.16 to 303.16 Kelvin
+!   and a second dimension of 151 for pressure over 1e5 Pa
+!   to the kappa power ranging from 0.04**rocp to 1.10**rocp.
+!
+! Program History Log:
+!   91-05-07  Iredell
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call gthe
+!
+! Subprograms called:
+!   (fthex)    inlinable function to compute equiv. pot. temperature
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx,jy
+    real(krealfp) xmin,xmax,ymin,ymax,xinc,yinc,x,y,pk,t
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=con_ttp-90._krealfp
+    xmax=con_ttp+30._krealfp
+    ymin=0.04_krealfp**con_rocp
+    ymax=1.10_krealfp**con_rocp
+    xinc=(xmax-xmin)/(nxthe-1)
+    c1xthe=1.-xmin/xinc
+    c2xthe=1./xinc
+    yinc=(ymax-ymin)/(nythe-1)
+    c1ythe=1.-ymin/yinc
+    c2ythe=1./yinc
+    do jy=1,nythe
+      y=ymin+(jy-1)*yinc
+      pk=y
+      do jx=1,nxthe
+        x=xmin+(jx-1)*xinc
+        t=x
+        tbthe(jx,jy)=fthex(t,pk)
+      enddo
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function fthe(t,pk)
+  function fthe(t,pk)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fthe         Compute equivalent potential temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute equivalent potential temperature at the LCL
+!   from temperature and pressure over 1e5 Pa to the kappa power.
+!   A bilinear interpolation is done between values in a lookup table
+!   computed in gthe. see documentation for fthex for details.
+!   Input values outside table range are reset to table extrema,
+!   except zero is returned for too cold or high LCLs.
+!   The interpolation accuracy is better than 0.01 Kelvin.
+!   On the Cray, fthe is almost 6 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   the=fthe(t,pk)
+!
+!   Input argument list:
+!     t          Real(krealfp) LCL temperature in Kelvin
+!     pk         Real(krealfp) LCL pressure over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     fthe       Real(krealfp) equivalent potential temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fthe
+    real(krealfp),intent(in):: t,pk
+    integer jx,jy
+    real(krealfp) xj,yj,ftx1,ftx2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(c1xthe+c2xthe*t,real(nxthe,krealfp))
+    yj=min(c1ythe+c2ythe*pk,real(nythe,krealfp))
+    if(xj.ge.1..and.yj.ge.1.) then
+      jx=min(xj,nxthe-1._krealfp)
+      jy=min(yj,nythe-1._krealfp)
+      ftx1=tbthe(jx,jy)+(xj-jx)*(tbthe(jx+1,jy)-tbthe(jx,jy))
+      ftx2=tbthe(jx,jy+1)+(xj-jx)*(tbthe(jx+1,jy+1)-tbthe(jx,jy+1))
+      fthe=ftx1+(yj-jy)*(ftx2-ftx1)
+    else
+      fthe=0.
+    endif
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftheq(t,pk)
+  function ftheq(t,pk)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftheq        Compute equivalent potential temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute equivalent potential temperature at the LCL
+!   from temperature and pressure over 1e5 Pa to the kappa power.
+!   A biquadratic interpolation is done between values in a lookup table
+!   computed in gthe. see documentation for fthex for details.
+!   Input values outside table range are reset to table extrema,
+!   except zero is returned for too cold or high LCLs.
+!   The interpolation accuracy is better than 0.0002 Kelvin.
+!   On the Cray, ftheq is almost 3 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             quadratic interpolation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   the=ftheq(t,pk)
+!
+!   Input argument list:
+!     t          Real(krealfp) LCL temperature in Kelvin
+!     pk         Real(krealfp) LCL pressure over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     ftheq      Real(krealfp) equivalent potential temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftheq
+    real(krealfp),intent(in):: t,pk
+    integer jx,jy
+    real(krealfp) xj,yj,dxj,dyj
+    real(krealfp) ft11,ft12,ft13,ft21,ft22,ft23,ft31,ft32,ft33
+    real(krealfp) ftx1,ftx2,ftx3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(c1xthe+c2xthe*t,real(nxthe,krealfp))
+    yj=min(c1ythe+c2ythe*pk,real(nythe,krealfp))
+    if(xj.ge.1..and.yj.ge.1.) then
+      jx=min(max(nint(xj),2),nxthe-1)
+      jy=min(max(nint(yj),2),nythe-1)
+      dxj=xj-jx
+      dyj=yj-jy
+      ft11=tbthe(jx-1,jy-1)
+      ft12=tbthe(jx-1,jy)
+      ft13=tbthe(jx-1,jy+1)
+      ft21=tbthe(jx,jy-1)
+      ft22=tbthe(jx,jy)
+      ft23=tbthe(jx,jy+1)
+      ft31=tbthe(jx+1,jy-1)
+      ft32=tbthe(jx+1,jy)
+      ft33=tbthe(jx+1,jy+1)
+      ftx1=(((ft31+ft11)/2-ft21)*dxj+(ft31-ft11)/2)*dxj+ft21
+      ftx2=(((ft32+ft12)/2-ft22)*dxj+(ft32-ft12)/2)*dxj+ft22
+      ftx3=(((ft33+ft13)/2-ft23)*dxj+(ft33-ft13)/2)*dxj+ft23
+      ftheq=(((ftx3+ftx1)/2-ftx2)*dyj+(ftx3-ftx1)/2)*dyj+ftx2
+    else
+      ftheq=0.
+    endif
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function fthex(t,pk)
+            function fthex(t,pk)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fthex        Compute equivalent potential temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Exactly compute equivalent potential temperature at the LCL
+!   from temperature and pressure over 1e5 Pa to the kappa power.
+!   Equivalent potential temperature is constant for a saturated parcel
+!   rising adiabatically up a moist adiabat when the heat and mass
+!   of the condensed water are neglected.  Ice is also neglected.
+!   The formula for equivalent potential temperature (Holton) is
+!       the=t*(pd**(-rocp))*exp(el*eps*pv/(cp*t*pd))
+!   where t is the temperature, pv is the saturated vapor pressure,
+!   pd is the dry pressure p-pv, el is the temperature dependent
+!   latent heat of condensation hvap+dldt*(t-ttp), and other values
+!   are physical constants defined in parameter statements in the code.
+!   Zero is returned if the input values make saturation impossible.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   the=fthex(t,pk)
+!
+!   Input argument list:
+!     t          Real(krealfp) LCL temperature in Kelvin
+!     pk         Real(krealfp) LCL pressure over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     fthex      Real(krealfp) equivalent potential temperature in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fthex
+    real(krealfp),intent(in):: t,pk
+    real(krealfp) p,tr,pv,pd,el,expo,expmax
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    p=pk**con_cpor
+    tr=con_ttp/t
+    pv=psatb*(tr**con_xpona)*exp(con_xponb*(1.-tr))
+    pd=p-pv
+    if(pd.gt.pv) then
+      el=con_hvap+con_dldt*(t-con_ttp)
+      expo=el*con_eps*pv/(con_cp*t*pd)
+      fthex=t*pd**(-con_rocp)*exp(expo)
+    else
+      fthex=0.
+    endif
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine gtma
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gtma         Compute moist adiabat tables
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute temperature and specific humidity tables
+!   as a function of equivalent potential temperature and
+!   pressure over 1e5 Pa to the kappa power for subprogram stma.
+!   Exact parcel temperatures are calculated in subprogram stmaxg.
+!   The current implementation computes a table with a first dimension
+!   of 151 for equivalent potential temperatures ranging from 200 to 500
+!   Kelvin and a second dimension of 121 for pressure over 1e5 Pa
+!   to the kappa power ranging from 0.01**rocp to 1.10**rocp.
+!
+! Program History Log:
+!   91-05-07  Iredell
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call gtma
+!
+! Subprograms called:
+!   (stmaxg)   inlinable subprogram to compute parcel temperature
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx,jy
+    real(krealfp) xmin,xmax,ymin,ymax,xinc,yinc,x,y,pk,the,t,q,tg
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=200._krealfp
+    xmax=500._krealfp
+    ymin=0.01_krealfp**con_rocp
+    ymax=1.10_krealfp**con_rocp
+    xinc=(xmax-xmin)/(nxma-1)
+    c1xma=1.-xmin/xinc
+    c2xma=1./xinc
+    yinc=(ymax-ymin)/(nyma-1)
+    c1yma=1.-ymin/yinc
+    c2yma=1./yinc
+    do jy=1,nyma
+      y=ymin+(jy-1)*yinc
+      pk=y
+      tg=xmin*y
+      do jx=1,nxma
+        x=xmin+(jx-1)*xinc
+        the=x
+        call stmaxg(tg,the,pk,t,q)
+        tbtma(jx,jy)=t
+        tbqma(jx,jy)=q
+        tg=t
+      enddo
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental subroutine stma(the,pk,tma,qma)
+  subroutine stma(the,pk,tma,qma)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: stma         Compute moist adiabat temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute temperature and specific humidity of a parcel
+!   lifted up a moist adiabat from equivalent potential temperature
+!   at the LCL and pressure over 1e5 Pa to the kappa power.
+!   Bilinear interpolations are done between values in a lookup table
+!   computed in gtma. See documentation for stmaxg for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is better than 0.01 Kelvin
+!   and 5.e-6 kg/kg for temperature and humidity, respectively.
+!   On the Cray, stma is about 35 times faster than exact calculation.
+!   This subprogram should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             expand table
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call stma(the,pk,tma,qma)
+!
+!   Input argument list:
+!     the        Real(krealfp) equivalent potential temperature in Kelvin
+!     pk         Real(krealfp) pressure over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     tma        Real(krealfp) parcel temperature in Kelvin
+!     qma        Real(krealfp) parcel specific humidity in kg/kg
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp),intent(in):: the,pk
+    real(krealfp),intent(out):: tma,qma
+    integer jx,jy
+    real(krealfp) xj,yj,ftx1,ftx2,qx1,qx2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xma+c2xma*the,1._krealfp),real(nxma,krealfp))
+    yj=min(max(c1yma+c2yma*pk,1._krealfp),real(nyma,krealfp))
+    jx=min(xj,nxma-1._krealfp)
+    jy=min(yj,nyma-1._krealfp)
+    ftx1=tbtma(jx,jy)+(xj-jx)*(tbtma(jx+1,jy)-tbtma(jx,jy))
+    ftx2=tbtma(jx,jy+1)+(xj-jx)*(tbtma(jx+1,jy+1)-tbtma(jx,jy+1))
+    tma=ftx1+(yj-jy)*(ftx2-ftx1)
+    qx1=tbqma(jx,jy)+(xj-jx)*(tbqma(jx+1,jy)-tbqma(jx,jy))
+    qx2=tbqma(jx,jy+1)+(xj-jx)*(tbqma(jx+1,jy+1)-tbqma(jx,jy+1))
+    qma=qx1+(yj-jy)*(qx2-qx1)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental subroutine stmaq(the,pk,tma,qma)
+  subroutine stmaq(the,pk,tma,qma)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: stmaq        Compute moist adiabat temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute temperature and specific humidity of a parcel
+!   lifted up a moist adiabat from equivalent potential temperature
+!   at the LCL and pressure over 1e5 Pa to the kappa power.
+!   Biquadratic interpolations are done between values in a lookup table
+!   computed in gtma. See documentation for stmaxg for details.
+!   Input values outside table range are reset to table extrema.
+!   the interpolation accuracy is better than 0.0005 Kelvin
+!   and 1.e-7 kg/kg for temperature and humidity, respectively.
+!   On the Cray, stmaq is about 25 times faster than exact calculation.
+!   This subprogram should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             quadratic interpolation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call stmaq(the,pk,tma,qma)
+!
+!   Input argument list:
+!     the        Real(krealfp) equivalent potential temperature in Kelvin
+!     pk         Real(krealfp) pressure over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     tmaq       Real(krealfp) parcel temperature in Kelvin
+!     qma        Real(krealfp) parcel specific humidity in kg/kg
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp),intent(in):: the,pk
+    real(krealfp),intent(out):: tma,qma
+    integer jx,jy
+    real(krealfp) xj,yj,dxj,dyj
+    real(krealfp) ft11,ft12,ft13,ft21,ft22,ft23,ft31,ft32,ft33
+    real(krealfp) ftx1,ftx2,ftx3
+    real(krealfp) q11,q12,q13,q21,q22,q23,q31,q32,q33,qx1,qx2,qx3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xma+c2xma*the,1._krealfp),real(nxma,krealfp))
+    yj=min(max(c1yma+c2yma*pk,1._krealfp),real(nyma,krealfp))
+    jx=min(max(nint(xj),2),nxma-1)
+    jy=min(max(nint(yj),2),nyma-1)
+    dxj=xj-jx
+    dyj=yj-jy
+    ft11=tbtma(jx-1,jy-1)
+    ft12=tbtma(jx-1,jy)
+    ft13=tbtma(jx-1,jy+1)
+    ft21=tbtma(jx,jy-1)
+    ft22=tbtma(jx,jy)
+    ft23=tbtma(jx,jy+1)
+    ft31=tbtma(jx+1,jy-1)
+    ft32=tbtma(jx+1,jy)
+    ft33=tbtma(jx+1,jy+1)
+    ftx1=(((ft31+ft11)/2-ft21)*dxj+(ft31-ft11)/2)*dxj+ft21
+    ftx2=(((ft32+ft12)/2-ft22)*dxj+(ft32-ft12)/2)*dxj+ft22
+    ftx3=(((ft33+ft13)/2-ft23)*dxj+(ft33-ft13)/2)*dxj+ft23
+    tma=(((ftx3+ftx1)/2-ftx2)*dyj+(ftx3-ftx1)/2)*dyj+ftx2
+    q11=tbqma(jx-1,jy-1)
+    q12=tbqma(jx-1,jy)
+    q13=tbqma(jx-1,jy+1)
+    q21=tbqma(jx,jy-1)
+    q22=tbqma(jx,jy)
+    q23=tbqma(jx,jy+1)
+    q31=tbqma(jx+1,jy-1)
+    q32=tbqma(jx+1,jy)
+    q33=tbqma(jx+1,jy+1)
+    qx1=(((q31+q11)/2-q21)*dxj+(q31-q11)/2)*dxj+q21
+    qx2=(((q32+q12)/2-q22)*dxj+(q32-q12)/2)*dxj+q22
+    qx3=(((q33+q13)/2-q23)*dxj+(q33-q13)/2)*dxj+q23
+    qma=(((qx3+qx1)/2-qx2)*dyj+(qx3-qx1)/2)*dyj+qx2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental subroutine stmax(the,pk,tma,qma)
+  subroutine stmax(the,pk,tma,qma)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: stmax        Compute moist adiabat temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Exactly compute temperature and humidity of a parcel
+!   lifted up a moist adiabat from equivalent potential temperature
+!   at the LCL and pressure over 1e5 Pa to the kappa power.
+!   An approximate parcel temperature for subprogram stmaxg
+!   is obtained using stma so gtma must be already called.
+!   See documentation for stmaxg for details.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call stmax(the,pk,tma,qma)
+!
+!   Input argument list:
+!     the        Real(krealfp) equivalent potential temperature in Kelvin
+!     pk         Real(krealfp) pressure over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     tma        Real(krealfp) parcel temperature in Kelvin
+!     qma        Real(krealfp) parcel specific humidity in kg/kg
+!
+! Subprograms called:
+!   (stma)     inlinable subprogram to compute parcel temperature
+!   (stmaxg)   inlinable subprogram to compute parcel temperature
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp),intent(in):: the,pk
+    real(krealfp),intent(out):: tma,qma
+    real(krealfp) tg,qg
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    call stma(the,pk,tg,qg)
+    call stmaxg(tg,the,pk,tma,qma)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental subroutine stmaxg(tg,the,pk,tma,qma)
+  subroutine stmaxg(tg,the,pk,tma,qma)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: stmaxg       Compute moist adiabat temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: exactly compute temperature and humidity of a parcel
+!   lifted up a moist adiabat from equivalent potential temperature
+!   at the LCL and pressure over 1e5 Pa to the kappa power.
+!   A guess parcel temperature must be provided.
+!   Equivalent potential temperature is constant for a saturated parcel
+!   rising adiabatically up a moist adiabat when the heat and mass
+!   of the condensed water are neglected.  Ice is also neglected.
+!   The formula for equivalent potential temperature (Holton) is
+!       the=t*(pd**(-rocp))*exp(el*eps*pv/(cp*t*pd))
+!   where t is the temperature, pv is the saturated vapor pressure,
+!   pd is the dry pressure p-pv, el is the temperature dependent
+!   latent heat of condensation hvap+dldt*(t-ttp), and other values
+!   are physical constants defined in parameter statements in the code.
+!   The formula is inverted by iterating Newtonian approximations
+!   for each the and p until t is found to within 1.e-4 Kelvin.
+!   The specific humidity is then computed from pv and pd.
+!   This subprogram can be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             exact computation
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call stmaxg(tg,the,pk,tma,qma)
+!
+!   Input argument list:
+!     tg         Real(krealfp) guess parcel temperature in Kelvin
+!     the        Real(krealfp) equivalent potential temperature in Kelvin
+!     pk         Real(krealfp) pressure over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     tma        Real(krealfp) parcel temperature in Kelvin
+!     qma        Real(krealfp) parcel specific humidity in kg/kg
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp),intent(in):: tg,the,pk
+    real(krealfp),intent(out):: tma,qma
+    real(krealfp),parameter:: terrm=1.e-4
+    real(krealfp) t,p,tr,pv,pd,el,expo,thet,dthet,terr
+    integer i
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    t=tg
+    p=pk**con_cpor
+    do i=1,100
+      tr=con_ttp/t
+      pv=psatb*(tr**con_xpona)*exp(con_xponb*(1.-tr))
+      pd=p-pv
+      el=con_hvap+con_dldt*(t-con_ttp)
+      expo=el*con_eps*pv/(con_cp*t*pd)
+      thet=t*pd**(-con_rocp)*exp(expo)
+      dthet=thet/t*(1.+expo*(con_dldt*t/el+el*p/(con_rv*t*pd)))
+      terr=(thet-the)/dthet
+      t=t-terr
+      if(abs(terr).le.terrm) exit
+    enddo
+    tma=t
+    tr=con_ttp/t
+    pv=psatb*(tr**con_xpona)*exp(con_xponb*(1.-tr))
+    pd=p-pv
+    qma=con_eps*pv/(pd+con_eps*pv)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+  subroutine gpkap
+!$$$   Subprogram  documentation  block
+!
+! Subprogram: gpkap        Compute coefficients for p**kappa
+!   Author: Phillips         org: w/NMC2X2   Date: 29 dec 82
+!
+! Abstract: Computes pressure to the kappa table as a function of pressure
+!   for the table lookup function fpkap.
+!   Exact pressure to the kappa values are calculated in subprogram fpkapx.
+!   The current implementation computes a table with a length
+!   of 5501 for pressures ranging up to 110000 Pascals.
+!
+! Program History Log:
+!   94-12-30  Iredell
+! 1999-03-01  Iredell             f90 module
+! 1999-03-24  Iredell             table lookup
+!
+! Usage:  call gpkap
+!
+! Subprograms called:
+!   fpkapx     function to compute exact pressure to the kappa
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx
+    real(krealfp) xmin,xmax,xinc,x,p
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=0._krealfp
+    xmax=110000._krealfp
+    xinc=(xmax-xmin)/(nxpkap-1)
+    c1xpkap=1.-xmin/xinc
+    c2xpkap=1./xinc
+    do jx=1,nxpkap
+      x=xmin+(jx-1)*xinc
+      p=x
+      tbpkap(jx)=fpkapx(p)
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function fpkap(p)
+  function fpkap(p)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpkap        raise pressure to the kappa power.
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Raise pressure over 1e5 Pa to the kappa power.
+!   A linear interpolation is done between values in a lookup table
+!   computed in gpkap. See documentation for fpkapx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy ranges from 9 decimal places
+!   at 100000 Pascals to 5 decimal places at 1000 Pascals.
+!   On the Cray, fpkap is over 5 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             standardized kappa,
+!                                 increased range and accuracy
+! 1999-03-01  Iredell             f90 module
+! 1999-03-24  Iredell             table lookup
+!
+! Usage:   pkap=fpkap(p)
+!
+!   Input argument list:
+!     p          Real(krealfp) pressure in Pascals
+!
+!   Output argument list:
+!     fpkap      Real(krealfp) p over 1e5 Pa to the kappa power
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpkap
+    real(krealfp),intent(in):: p
+    integer jx
+    real(krealfp) xj
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xpkap+c2xpkap*p,1._krealfp),real(nxpkap,krealfp))
+    jx=min(xj,nxpkap-1._krealfp)
+    fpkap=tbpkap(jx)+(xj-jx)*(tbpkap(jx+1)-tbpkap(jx))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function fpkapq(p)
+  function fpkapq(p)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: fpkapq       raise pressure to the kappa power.
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Raise pressure over 1e5 Pa to the kappa power.
+!   A quadratic interpolation is done between values in a lookup table
+!   computed in gpkap. see documentation for fpkapx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy ranges from 12 decimal places
+!   at 100000 Pascals to 7 decimal places at 1000 Pascals.
+!   On the Cray, fpkap is over 4 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             standardized kappa,
+!                                 increased range and accuracy
+! 1999-03-01  Iredell             f90 module
+! 1999-03-24  Iredell             table lookup
+!
+! Usage:   pkap=fpkapq(p)
+!
+!   Input argument list:
+!     p          Real(krealfp) pressure in Pascals
+!
+!   Output argument list:
+!     fpkapq     Real(krealfp) p over 1e5 Pa to the kappa power
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpkapq
+    real(krealfp),intent(in):: p
+    integer jx
+    real(krealfp) xj,dxj,fj1,fj2,fj3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xpkap+c2xpkap*p,1._krealfp),real(nxpkap,krealfp))
+    jx=min(max(nint(xj),2),nxpkap-1)
+    dxj=xj-jx
+    fj1=tbpkap(jx-1)
+    fj2=tbpkap(jx)
+    fj3=tbpkap(jx+1)
+    fpkapq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  function fpkapo(p)
+!$$$   Subprogram  documentation  block
+!
+! Subprogram: fpkapo       raise surface pressure to the kappa power.
+!   Author: Phillips         org: w/NMC2X2   Date: 29 dec 82
+!
+! Abstract: Raise surface pressure over 1e5 Pa to the kappa power
+!   using a rational weighted chebyshev approximation.
+!   The numerator is of order 2 and the denominator is of order 4.
+!   The pressure range is 40000-110000 Pa and kappa is defined in fpkapx.
+!   The accuracy of this approximation is almost 8 decimal places.
+!   On the Cray, fpkap is over 10 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             standardized kappa,
+!                                 increased range and accuracy
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  pkap=fpkapo(p)
+!
+!   Input argument list:
+!     p          Real(krealfp) surface pressure in Pascals
+!                p should be in the range 40000 to 110000
+!
+!   Output argument list:
+!     fpkapo     Real(krealfp) p over 1e5 Pa to the kappa power
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpkapo
+    real(krealfp),intent(in):: p
+    integer,parameter:: nnpk=2,ndpk=4
+    real(krealfp):: cnpk(0:nnpk)=(/3.13198449e-1,5.78544829e-2,&
+                                         8.35491871e-4/)
+    real(krealfp):: cdpk(0:ndpk)=(/1.,8.15968401e-2,5.72839518e-4,&
+                                         -4.86959812e-7,5.24459889e-10/)
+    integer n
+    real(krealfp) pkpa,fnpk,fdpk
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    pkpa=p*1.e-3_krealfp
+    fnpk=cnpk(nnpk)
+    do n=nnpk-1,0,-1
+      fnpk=pkpa*fnpk+cnpk(n)
+    enddo
+    fdpk=cdpk(ndpk)
+    do n=ndpk-1,0,-1
+      fdpk=pkpa*fdpk+cdpk(n)
+    enddo
+    fpkapo=fnpk/fdpk
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function fpkapx(p)
+  function fpkapx(p)
+!$$$   Subprogram  documentation  block
+!
+! Subprogram: fpkapx       raise pressure to the kappa power.
+!   Author: Phillips         org: w/NMC2X2   Date: 29 dec 82
+!
+! Abstract: raise pressure over 1e5 Pa to the kappa power.
+!   Kappa is equal to rd/cp where rd and cp are physical constants.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   94-12-30  Iredell             made into inlinable function
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  pkap=fpkapx(p)
+!
+!   Input argument list:
+!     p          Real(krealfp) pressure in Pascals
+!
+!   Output argument list:
+!     fpkapx     Real(krealfp) p over 1e5 Pa to the kappa power
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) fpkapx
+    real(krealfp),intent(in):: p
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    fpkapx=(p/1.e5_krealfp)**con_rocp
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine grkap
+!$$$   Subprogram  documentation  block
+!
+! Subprogram: grkap        Compute coefficients for p**(1/kappa)
+!   Author: Phillips         org: w/NMC2X2   Date: 29 dec 82
+!
+! Abstract: Computes pressure to the 1/kappa table as a function of pressure
+!   for the table lookup function frkap.
+!   Exact pressure to the 1/kappa values are calculated in subprogram frkapx.
+!   The current implementation computes a table with a length
+!   of 5501 for pressures ranging up to 110000 Pascals.
+!
+! Program History Log:
+!   94-12-30  Iredell
+! 1999-03-01  Iredell             f90 module
+! 1999-03-24  Iredell             table lookup
+!
+! Usage:  call grkap
+!
+! Subprograms called:
+!   frkapx     function to compute exact pressure to the 1/kappa
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx
+    real(krealfp) xmin,xmax,xinc,x,p
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=0._krealfp
+    xmax=fpkapx(110000._krealfp)
+    xinc=(xmax-xmin)/(nxrkap-1)
+    c1xrkap=1.-xmin/xinc
+    c2xrkap=1./xinc
+    do jx=1,nxrkap
+      x=xmin+(jx-1)*xinc
+      p=x
+      tbrkap(jx)=frkapx(p)
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function frkap(pkap)
+  function frkap(pkap)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: frkap        raise pressure to the 1/kappa power.
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Raise pressure over 1e5 Pa to the 1/kappa power.
+!   A linear interpolation is done between values in a lookup table
+!   computed in grkap. See documentation for frkapx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is better than 7 decimal places.
+!   On the IBM, fpkap is about 4 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             standardized kappa,
+!                                 increased range and accuracy
+! 1999-03-01  Iredell             f90 module
+! 1999-03-24  Iredell             table lookup
+!
+! Usage:   p=frkap(pkap)
+!
+!   Input argument list:
+!     pkap       Real(krealfp) p over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     frkap      Real(krealfp) pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) frkap
+    real(krealfp),intent(in):: pkap
+    integer jx
+    real(krealfp) xj
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xrkap+c2xrkap*pkap,1._krealfp),real(nxrkap,krealfp))
+    jx=min(xj,nxrkap-1._krealfp)
+    frkap=tbrkap(jx)+(xj-jx)*(tbrkap(jx+1)-tbrkap(jx))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function frkapq(pkap)
+  function frkapq(pkap)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: frkapq       raise pressure to the 1/kappa power.
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Raise pressure over 1e5 Pa to the 1/kappa power.
+!   A quadratic interpolation is done between values in a lookup table
+!   computed in grkap. see documentation for frkapx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is better than 11 decimal places.
+!   On the IBM, fpkap is almost 4 times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+!   94-12-30  Iredell             standardized kappa,
+!                                 increased range and accuracy
+! 1999-03-01  Iredell             f90 module
+! 1999-03-24  Iredell             table lookup
+!
+! Usage:   p=frkapq(pkap)
+!
+!   Input argument list:
+!     pkap       Real(krealfp) p over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     frkapq     Real(krealfp) pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) frkapq
+    real(krealfp),intent(in):: pkap
+    integer jx
+    real(krealfp) xj,dxj,fj1,fj2,fj3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xrkap+c2xrkap*pkap,1._krealfp),real(nxrkap,krealfp))
+    jx=min(max(nint(xj),2),nxrkap-1)
+    dxj=xj-jx
+    fj1=tbrkap(jx-1)
+    fj2=tbrkap(jx)
+    fj3=tbrkap(jx+1)
+    frkapq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function frkapx(pkap)
+  function frkapx(pkap)
+!$$$   Subprogram  documentation  block
+!
+! Subprogram: frkapx       raise pressure to the 1/kappa power.
+!   Author: Phillips         org: w/NMC2X2   Date: 29 dec 82
+!
+! Abstract: raise pressure over 1e5 Pa to the 1/kappa power.
+!   Kappa is equal to rd/cp where rd and cp are physical constants.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   94-12-30  Iredell             made into inlinable function
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  p=frkapx(pkap)
+!
+!   Input argument list:
+!     pkap       Real(krealfp) p over 1e5 Pa to the kappa power
+!
+!   Output argument list:
+!     frkapx     Real(krealfp) pressure in Pascals
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) frkapx
+    real(krealfp),intent(in):: pkap
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    frkapx=pkap**(1/con_rocp)*1.e5_krealfp
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine gtlcl
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gtlcl        Compute equivalent potential temperature table
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute lifting condensation level temperature table
+!   as a function of temperature and dewpoint depression for function ftlcl.
+!   Lifting condensation level temperature is calculated in subprogram ftlclx
+!   The current implementation computes a table with a first dimension
+!   of 151 for temperatures ranging from 180.0 to 330.0 Kelvin
+!   and a second dimension of 61 for dewpoint depression ranging from
+!   0 to 60 Kelvin.
+!
+! Program History Log:
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call gtlcl
+!
+! Subprograms called:
+!   (ftlclx)    inlinable function to compute LCL temperature
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    integer jx,jy
+    real(krealfp) xmin,xmax,ymin,ymax,xinc,yinc,x,y,tdpd,t
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xmin=180._krealfp
+    xmax=330._krealfp
+    ymin=0._krealfp
+    ymax=60._krealfp
+    xinc=(xmax-xmin)/(nxtlcl-1)
+    c1xtlcl=1.-xmin/xinc
+    c2xtlcl=1./xinc
+    yinc=(ymax-ymin)/(nytlcl-1)
+    c1ytlcl=1.-ymin/yinc
+    c2ytlcl=1./yinc
+    do jy=1,nytlcl
+      y=ymin+(jy-1)*yinc
+      tdpd=y
+      do jx=1,nxtlcl
+        x=xmin+(jx-1)*xinc
+        t=x
+        tbtlcl(jx,jy)=ftlclx(t,tdpd)
+      enddo
+    enddo
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+! elemental function ftlcl(t,tdpd)
+  function ftlcl(t,tdpd)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftlcl        Compute LCL temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute temperature at the lifting condensation level
+!   from temperature and dewpoint depression.
+!   A bilinear interpolation is done between values in a lookup table
+!   computed in gtlcl. See documentation for ftlclx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is better than 0.0005 Kelvin.
+!   On the Cray, ftlcl is ? times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   tlcl=ftlcl(t,tdpd)
+!
+!   Input argument list:
+!     t          Real(krealfp) LCL temperature in Kelvin
+!     tdpd       Real(krealfp) dewpoint depression in Kelvin
+!
+!   Output argument list:
+!     ftlcl      Real(krealfp) temperature at the LCL in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftlcl
+    real(krealfp),intent(in):: t,tdpd
+    integer jx,jy
+    real(krealfp) xj,yj,ftx1,ftx2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xtlcl+c2xtlcl*t,1._krealfp),real(nxtlcl,krealfp))
+    yj=min(max(c1ytlcl+c2ytlcl*tdpd,1._krealfp),real(nytlcl,krealfp))
+    jx=min(xj,nxtlcl-1._krealfp)
+    jy=min(yj,nytlcl-1._krealfp)
+    ftx1=tbtlcl(jx,jy)+(xj-jx)*(tbtlcl(jx+1,jy)-tbtlcl(jx,jy))
+    ftx2=tbtlcl(jx,jy+1)+(xj-jx)*(tbtlcl(jx+1,jy+1)-tbtlcl(jx,jy+1))
+    ftlcl=ftx1+(yj-jy)*(ftx2-ftx1)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftlclq(t,tdpd)
+  function ftlclq(t,tdpd)
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: ftlclq       Compute LCL temperature
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute temperature at the lifting condensation level
+!   from temperature and dewpoint depression.
+!   A biquadratic interpolation is done between values in a lookup table
+!   computed in gtlcl. see documentation for ftlclx for details.
+!   Input values outside table range are reset to table extrema.
+!   The interpolation accuracy is better than 0.000003 Kelvin.
+!   On the Cray, ftlclq is ? times faster than exact calculation.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:   tlcl=ftlclq(t,tdpd)
+!
+!   Input argument list:
+!     t          Real(krealfp) LCL temperature in Kelvin
+!     tdpd       Real(krealfp) dewpoint depression in Kelvin
+!
+!   Output argument list:
+!     ftlcl      Real(krealfp) temperature at the LCL in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftlclq
+    real(krealfp),intent(in):: t,tdpd
+    integer jx,jy
+    real(krealfp) xj,yj,dxj,dyj
+    real(krealfp) ft11,ft12,ft13,ft21,ft22,ft23,ft31,ft32,ft33
+    real(krealfp) ftx1,ftx2,ftx3
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    xj=min(max(c1xtlcl+c2xtlcl*t,1._krealfp),real(nxtlcl,krealfp))
+    yj=min(max(c1ytlcl+c2ytlcl*tdpd,1._krealfp),real(nytlcl,krealfp))
+    jx=min(max(nint(xj),2),nxtlcl-1)
+    jy=min(max(nint(yj),2),nytlcl-1)
+    dxj=xj-jx
+    dyj=yj-jy
+    ft11=tbtlcl(jx-1,jy-1)
+    ft12=tbtlcl(jx-1,jy)
+    ft13=tbtlcl(jx-1,jy+1)
+    ft21=tbtlcl(jx,jy-1)
+    ft22=tbtlcl(jx,jy)
+    ft23=tbtlcl(jx,jy+1)
+    ft31=tbtlcl(jx+1,jy-1)
+    ft32=tbtlcl(jx+1,jy)
+    ft33=tbtlcl(jx+1,jy+1)
+    ftx1=(((ft31+ft11)/2-ft21)*dxj+(ft31-ft11)/2)*dxj+ft21
+    ftx2=(((ft32+ft12)/2-ft22)*dxj+(ft32-ft12)/2)*dxj+ft22
+    ftx3=(((ft33+ft13)/2-ft23)*dxj+(ft33-ft13)/2)*dxj+ft23
+    ftlclq=(((ftx3+ftx1)/2-ftx2)*dyj+(ftx3-ftx1)/2)*dyj+ftx2
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  function ftlclo(t,tdpd)
+!$$$   Subprogram  documentation  block
+!
+! Subprogram: ftlclo       Compute LCL temperature.
+!   Author: Phillips         org: w/NMC2X2   Date: 29 dec 82
+!
+! Abstract: Compute temperature at the lifting condensation level
+!   from temperature and dewpoint depression.  the formula used is
+!   a polynomial taken from Phillips mstadb routine which empirically
+!   approximates the original exact implicit relationship.
+!   (This kind of approximation is customary (inman, 1969), but
+!   the original source for this particular one is not yet known. -MI)
+!   Its accuracy is about 0.03 Kelvin for a dewpoint depression of 30.
+!   This function should be expanded inline in the calling routine.
+!
+! Program History Log:
+!   91-05-07  Iredell             made into inlinable function
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  tlcl=ftlclo(t,tdpd)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!     tdpd       Real(krealfp) dewpoint depression in Kelvin
+!
+!   Output argument list:
+!     ftlclo     Real(krealfp) temperature at the LCL in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftlclo
+    real(krealfp),intent(in):: t,tdpd
+    real(krealfp),parameter:: clcl1= 0.954442e+0,clcl2= 0.967772e-3,&
+                                    clcl3=-0.710321e-3,clcl4=-0.270742e-5
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    ftlclo=t-tdpd*(clcl1+clcl2*t+tdpd*(clcl3+clcl4*t))
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+! elemental function ftlclx(t,tdpd)
+  function ftlclx(t,tdpd)
+!$$$   Subprogram  documentation  block
+!
+! Subprogram: ftlclx       Compute LCL temperature.
+!   Author: Iredell          org: w/NMC2X2   Date: 25 March 1999
+!
+! Abstract: Compute temperature at the lifting condensation level
+!   from temperature and dewpoint depression.  A parcel lifted
+!   adiabatically becomes saturated at the lifting condensation level.
+!   The water model assumes a perfect gas, constant specific heats
+!   for gas and liquid, and neglects the volume of the liquid.
+!   The model does account for the variation of the latent heat
+!   of condensation with temperature.  The ice option is not included.
+!   The Clausius-Clapeyron equation is integrated from the triple point
+!   to get the formulas
+!       pvlcl=con_psat*(trlcl**xa)*exp(xb*(1.-trlcl))
+!       pvdew=con_psat*(trdew**xa)*exp(xb*(1.-trdew))
+!   where pvlcl is the saturated parcel vapor pressure at the LCL,
+!   pvdew is the unsaturated parcel vapor pressure initially,
+!   trlcl is ttp/tlcl and trdew is ttp/tdew.  The adiabatic lifting
+!   of the parcel is represented by the following formula
+!       pvdew=pvlcl*(t/tlcl)**(1/kappa)
+!   This formula is inverted by iterating Newtonian approximations
+!   until tlcl is found to within 1.e-6 Kelvin.  Note that the minimum
+!   returned temperature is 180 Kelvin.
+!
+! Program History Log:
+! 1999-03-25  Iredell
+!
+! Usage:  tlcl=ftlclx(t,tdpd)
+!
+!   Input argument list:
+!     t          Real(krealfp) temperature in Kelvin
+!     tdpd       Real(krealfp) dewpoint depression in Kelvin
+!
+!   Output argument list:
+!     ftlclx     Real(krealfp) temperature at the LCL in Kelvin
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+    real(krealfp) ftlclx
+    real(krealfp),intent(in):: t,tdpd
+    real(krealfp),parameter:: terrm=1.e-4,tlmin=180.,tlminx=tlmin-5.
+    real(krealfp) tr,pvdew,tlcl,ta,pvlcl,el,dpvlcl,terr,terrp
+    integer i
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    tr=con_ttp/(t-tdpd)
+    pvdew=con_psat*(tr**con_xpona)*exp(con_xponb*(1.-tr))
+    tlcl=t-tdpd
+    do i=1,100
+      tr=con_ttp/tlcl
+      ta=t/tlcl
+      pvlcl=con_psat*(tr**con_xpona)*exp(con_xponb*(1.-tr))*ta**(1/con_rocp)
+      el=con_hvap+con_dldt*(tlcl-con_ttp)
+      dpvlcl=(el/(con_rv*t**2)+1/(con_rocp*tlcl))*pvlcl
+      terr=(pvlcl-pvdew)/dpvlcl
+      tlcl=tlcl-terr
+      if(abs(terr).le.terrm.or.tlcl.lt.tlminx) exit
+    enddo
+    ftlclx=max(tlcl,tlmin)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end function
+!-------------------------------------------------------------------------------
+  subroutine gfuncphys
+!$$$     Subprogram Documentation Block
+!
+! Subprogram: gfuncphys    Compute all physics function tables
+!   Author: N Phillips            w/NMC2X2   Date: 30 dec 82
+!
+! Abstract: Compute all physics function tables.  Lookup tables are
+!   set up for computing saturation vapor pressure, dewpoint temperature,
+!   equivalent potential temperature, moist adiabatic temperature and humidity,
+!   pressure to the kappa, and lifting condensation level temperature.
+!
+! Program History Log:
+! 1999-03-01  Iredell             f90 module
+!
+! Usage:  call gfuncphys
+!
+! Subprograms called:
+!   gpvsl       compute saturation vapor pressure over liquid table
+!   gpvsi       compute saturation vapor pressure over ice table
+!   gpvs        compute saturation vapor pressure table
+!   gtdpl       compute dewpoint temperature over liquid table
+!   gtdpi       compute dewpoint temperature over ice table
+!   gtdp        compute dewpoint temperature table
+!   gthe        compute equivalent potential temperature table
+!   gtma        compute moist adiabat tables
+!   gpkap       compute pressure to the kappa table
+!   grkap       compute pressure to the 1/kappa table
+!   gtlcl       compute LCL temperature table
+!
+! Attributes:
+!   Language: Fortran 90.
+!
+!$$$
+    implicit none
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    call gpvsl
+    call gpvsi
+    call gpvs
+    call gtdpl
+    call gtdpi
+    call gtdp
+    call gthe
+    call gtma
+    call gpkap
+    call grkap
+    call gtlcl
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  end subroutine
+!-------------------------------------------------------------------------------
+end module module_gfs_funcphys
Index: trunk/WRF.COMMON/WRFV2/phys/module_gfs_machine.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_gfs_machine.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_gfs_machine.F	(revision 2744)
@@ -0,0 +1,16 @@
+      MODULE MODULE_GFS_MACHINE
+
+      IMPLICIT NONE
+      SAVE
+!  Machine dependant constants
+      integer kind_io4,kind_io8,kind_phys,kind_rad,kind_evod
+      parameter (kind_rad  = selected_real_kind(13,60)) ! the '60' maps to 64-bit real
+      parameter (kind_phys = selected_real_kind(13,60)) ! the '60' maps to 64-bit real
+      parameter (kind_io4  = 4)
+      parameter (kind_io8  = 8)
+      parameter (kind_evod = 8)
+
+      real(kind=kind_evod) mprec ! machine precision to restrict dep
+      parameter(mprec  = 1.e-12 )
+
+      END MODULE MODULE_GFS_MACHINE
Index: trunk/WRF.COMMON/WRFV2/phys/module_gfs_physcons.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_gfs_physcons.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_gfs_physcons.F	(revision 2744)
@@ -0,0 +1,40 @@
+module module_gfs_physcons
+  use module_gfs_machine,only:kind_phys
+!  Physical constants as set in NMC handbook from Smithsonian tables.
+!  Physical constants are given to 5 places.
+!  1990/04/30: g and rd are made consistent with NWS usage.
+!  2001/10/22: g made consistent with SI usage.
+!  Math constants
+  real(kind=kind_phys),parameter:: con_pi      =3.1415926535897931 ! pi
+  real(kind=kind_phys),parameter:: con_sqrt2   =1.414214e+0 ! square root of 2
+  real(kind=kind_phys),parameter:: con_sqrt3   =1.732051e+0 ! square root of 3
+!  Primary constants
+  real(kind=kind_phys),parameter:: con_rerth   =6.3712e+6 ! radius of earth     (m)
+  real(kind=kind_phys),parameter:: con_g       =9.80665e+0! gravity             (m/s2)
+  real(kind=kind_phys),parameter:: con_omega   =7.2921e-5 ! ang vel of earth    (1/s)
+  real(kind=kind_phys),parameter:: con_rd      =2.8705e+2 ! gas constant air    (J/kg/K)
+  real(kind=kind_phys),parameter:: con_rv      =4.6150e+2 ! gas constant H2O    (J/kg/K)
+  real(kind=kind_phys),parameter:: con_cp      =1.0046e+3 ! spec heat air @p    (J/kg/K)
+  real(kind=kind_phys),parameter:: con_cv      =7.1760e+2 ! spec heat air @v    (J/kg/K)
+  real(kind=kind_phys),parameter:: con_cvap    =1.8460e+3 ! spec heat H2O gas   (J/kg/K)
+  real(kind=kind_phys),parameter:: con_cliq    =4.1855e+3 ! spec heat H2O liq   (J/kg/K)
+  real(kind=kind_phys),parameter:: con_csol    =2.1060e+3 ! spec heat H2O ice   (J/kg/K)
+  real(kind=kind_phys),parameter:: con_hvap    =2.5000e+6 ! lat heat H2O cond   (J/kg)
+  real(kind=kind_phys),parameter:: con_hfus    =3.3358e+5 ! lat heat H2O fusion (J/kg)
+  real(kind=kind_phys),parameter:: con_psat    =6.1078e+2 ! pres at H2O 3pt     (Pa)  
+  real(kind=kind_phys),parameter:: con_sbc     =5.6730e-8 ! stefan-boltzmann    (W/m2/K4)
+  real(kind=kind_phys),parameter:: con_solr    =1.3533e+3 ! solar constant      (W/m2)
+  real(kind=kind_phys),parameter:: con_t0c     =2.7315e+2 ! temp at 0C          (K)
+  real(kind=kind_phys),parameter:: con_ttp     =2.7316e+2 ! temp at H2O 3pt     (K)
+  real(kind=kind_phys),parameter:: con_jcal    =4.1855E+0 ! JOULES PER CALORIE  ()
+!  Secondary constants
+  real(kind=kind_phys),parameter:: con_rocp    =con_rd/con_cp
+  real(kind=kind_phys),parameter:: con_cpor    =con_cp/con_rd
+  real(kind=kind_phys),parameter:: con_rog     =con_rd/con_g
+  real(kind=kind_phys),parameter:: con_fvirt   =con_rv/con_rd-1.
+  real(kind=kind_phys),parameter:: con_eps     =con_rd/con_rv
+  real(kind=kind_phys),parameter:: con_epsm1   =con_rd/con_rv-1.
+  real(kind=kind_phys),parameter:: con_dldt    =con_cvap-con_cliq
+  real(kind=kind_phys),parameter:: con_xpona   =-con_dldt/con_rv
+  real(kind=kind_phys),parameter:: con_xponb   =-con_dldt/con_rv+con_hvap/(con_rv*con_ttp)
+end module module_gfs_physcons
Index: trunk/WRF.COMMON/WRFV2/phys/module_lmd_driver.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_lmd_driver.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_lmd_driver.F	(revision 2744)
@@ -0,0 +1,1731 @@
+!*******************************************************************************
+! PURPOSE: LMD_driver is the WRF mediation layer routine that provides the
+! interface to LMD physics packages in the WRF model layer. For those familiar
+! with the LMD GCM, the aim of this driver is to do part of the job of the
+! calfis.F routine.
+!*******************************************************************************
+! AUTHOR: A. Spiga - January 2007
+!*******************************************************************************
+! UPDATES:  - included all final updates for the paper - March 2008
+!           - general cleaning of code and comments - October 2008 
+!           - additions for idealized cases - January 2009
+!           - additions for new soil model in physics - January 2010 
+!           - unified module_lmd_driver: old, new phys and LES - February 2011
+!*******************************************************************************
+MODULE module_lmd_driver
+CONTAINS
+    SUBROUTINE lmd_driver(id,max_dom,DT,ITIMESTEP,XLAT,XLONG, &
+        IDS,IDE,JDS,JDE,KDS,KDE,IMS,IME,JMS,JME,KMS,KME, &
+        i_start,i_end,j_start,j_end,kts,kte,num_tiles, &
+        DX,DY, &
+        MSFT,MSFU,MSFV, &
+        GMT,JULYR,JULDAY, &
+        P8W,DZ8W,T8W,Z,HT, &
+        U,V,W,TH,T,P,EXNER,RHO, &
+        PTOP, &
+        RADT,CUDT, &
+        TSK,PSFC, &
+        RTHBLTEN,RUBLTEN,RVBLTEN, &
+        num_3d_s,SCALAR, &
+        num_3d_m,MOIST,&
+        MARS_MODE, &
+        M_ALBEDO,M_TI,M_CO2ICE,M_EMISS, &
+        M_H2OICE, &
+        M_TSOIL, &
+        M_Q2, &
+        M_TSURF, &
+#ifdef NEWPHYS
+        M_FLUXRAD, &
+        M_WSTAR, &
+        M_ISOIL, &
+        M_DSOIL, &
+        M_Z0, &
+        CST_Z0, &
+#endif
+        M_GW, &
+        NUM_SOIL_LAYERS, &
+        CST_AL, &
+        CST_TI, &
+        isfflx, &
+        diff_opt, &
+        km_opt, &
+        HISTORY_INTERVAL, &
+#ifndef NOPHYS
+#include "module_lmd_driver_output1.inc"
+#endif
+        SLPX,SLPY,RESTART)
+! NB: module_lmd_driver_output1.inc : output arguments generated from Registry
+
+
+
+
+
+!==================================================================
+! USES
+!==================================================================
+   USE module_model_constants
+   USE module_wrf_error
+! add new modules here, if needed ...
+
+!==================================================================
+  IMPLICIT NONE
+!==================================================================
+
+!==================================================================
+! COMMON
+!==================================================================
+
+#ifndef NOPHYS
+!! the only common needed is the one defining the physical grid
+!! -- path is hardcoded, but the structure is not subject to change
+!! -- please put # if needed by the pre-compilation process	
+!
+!
+include "../mars_lmd/libf/phymars/dimphys.h"
+!
+!--to be commented because there are tests in the physics ?
+!--TODO: get rid of the ...mx first in this routine and .inc
+
+!
+! INCLUDE AUTOMATIQUEMENT GENERE A PARTIR DU REGISTRY
+!
+include "../mars_lmd/libf/phymars/wrf_output_2d.h"
+include "../mars_lmd/libf/phymars/wrf_output_3d.h"
+#endif
+
+!==================================================================
+! VARIABLES
+!==================================================================
+
+! WRF Dimensions
+INTEGER, INTENT(IN   )    ::   &
+      ids,ide,jds,jde,kds,kde, &
+      ims,ime,jms,jme,kms,kme, &
+            kts,kte,num_tiles, &
+              NUM_SOIL_LAYERS
+INTEGER, DIMENSION(num_tiles), INTENT(IN) ::  &
+      i_start,i_end,j_start,j_end   
+! Scalars
+INTEGER, INTENT(IN  ) :: JULDAY, itimestep, julyr,id,max_dom,MARS_MODE
+INTEGER, INTENT(IN  ) :: isfflx,diff_opt,km_opt
+REAL, INTENT(IN  ) :: GMT,dt,dx,dy,RADT,CUDT
+REAL, INTENT(IN  ) :: CST_AL, CST_TI 
+REAL, INTENT(IN  ) :: PTOP
+! 2D arrays          
+REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   )  :: &
+     MSFT,MSFU,MSFV, &
+     XLAT,XLONG,HT,  &
+     M_ALBEDO,M_TI,M_EMISS, &
+     SLPX,SLPY
+REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT   )  :: &
+     M_CO2ICE,M_H2OICE, &
+     M_TSURF
+! 3D arrays 
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: &
+     dz8w,p8w,p,exner,t,t8w,rho,u,v,w,z,th
+!REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT ) :: &
+!     M_Q2
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: &
+     M_Q2
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+INTEGER, INTENT(IN   ) :: HISTORY_INTERVAL
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+REAL, DIMENSION( ims:ime, NUM_SOIL_LAYERS, jms:jme ), INTENT(INOUT )  :: &
+     M_TSOIL 
+#ifdef NEWPHYS
+REAL, INTENT(IN  ) :: CST_Z0
+REAL, DIMENSION( ims:ime, NUM_SOIL_LAYERS, jms:jme ), INTENT(IN   )  :: &
+     M_ISOIL, M_DSOIL         
+REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   )  :: &
+     M_Z0
+REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT   )  :: &
+     M_FLUXRAD,M_WSTAR
+#endif
+REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: &
+     M_GW
+! 4D arrays
+INTEGER, INTENT(IN ) :: num_3d_s,num_3d_m
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_3d_s ), INTENT(INOUT ) :: &
+     scalar
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_3d_m ), INTENT(INOUT ) :: &
+     moist
+! Logical
+LOGICAL, INTENT(IN ) :: restart
+
+!-------------------------------------------
+! OUTPUT VARIABLES
+!-------------------------------------------
+!
+! Generated from Registry
+!
+! default definitions :
+! 2D : TSK, PSFC
+! 3D : RTHBLTEN,RUBLTEN,RVBLTEN
+#ifndef NOPHYS
+#include "module_lmd_driver_output2.inc"
+   REAL, DIMENSION(:,:), ALLOCATABLE :: output_tab2d
+   REAL, DIMENSION(:,:,:), ALLOCATABLE :: output_tab3d
+#else
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: PSFC,TSK
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(OUT)  :: RTHBLTEN,RUBLTEN,RVBLTEN
+   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: dtrad
+#endif
+!-------------------------------------------
+! OUTPUT VARIABLES
+!-------------------------------------------
+
+
+!-------------------------------------------   
+! LOCAL  VARIABLES
+!-------------------------------------------
+   INTEGER ::    i,j,k,its,ite,jts,jte,ij,kk
+   INTEGER ::    subs,iii
+
+   ! *** for Mars Mode 20 and 21 ***
+   REAL ::    tau_decay, lct, zilctmin
+   INTEGER, SAVE :: zipbl(500) !index of zi in file input_zipbl
+   REAL, SAVE :: zilct(500) !corresponding local time in input_zipbl
+   INTEGER :: lctindex,ziindex
+   LOGICAL :: end_of_file
+   ! *** ----------------------- ***
+
+   ! *** for LMD physics
+   ! ------> inputs:
+   INTEGER :: ngrid,nlayer,nq,nsoil 
+   REAL :: pday,ptime,MY  
+   REAL :: aire_val,lat_val,lon_val
+   REAL :: phisfi_val,albedodat_val,inertiedat_val
+   REAL :: tsurf_val,co2ice_val,emis_val
+   REAL :: zmea_val,zstd_val,zsig_val,zgam_val,zthe_val
+   REAL :: theta_val, psi_val
+   LOGICAL :: firstcall,lastcall,tracerdyn
+   REAL,DIMENSION(:),ALLOCATABLE :: q2_val, qsurf_val, tsoil_val
+#ifdef NEWPHYS
+   REAL :: wstar_val,fluxrad_val
+   REAL,DIMENSION(:),ALLOCATABLE :: isoil_val, dsoil_val
+   REAL :: z0_val
+#endif
+   REAL,DIMENSION(:),ALLOCATABLE :: aire_vec,lat_vec,lon_vec
+   REAL,DIMENSION(:),ALLOCATABLE :: walbedodat,winertiedat,wphisfi
+   REAL,DIMENSION(:),ALLOCATABLE :: wzmea,wzstd,wzsig,wzgam,wzthe
+   REAL,DIMENSION(:),ALLOCATABLE :: wtheta, wpsi
+   ! v--- can they be modified ?
+   REAL,DIMENSION(:),ALLOCATABLE :: wtsurf,wco2ice,wemis
+   REAL,DIMENSION(:,:),ALLOCATABLE :: wq2,wqsurf,wtsoil 
+#ifdef NEWPHYS
+   REAL,DIMENSION(:),ALLOCATABLE :: wwstar,wfluxrad
+   REAL,DIMENSION(:),ALLOCATABLE :: wz0tab
+   REAL,DIMENSION(:,:),ALLOCATABLE :: wisoil,wdsoil
+   CHARACTER*20,DIMENSION(:),ALLOCATABLE :: wtnom
+#endif 
+   ! ----------	
+   REAL,DIMENSION(:,:),ALLOCATABLE :: pplev,pplay,pphi,pu,pv,pt,pw
+   REAL,DIMENSION(:,:,:),ALLOCATABLE :: pq  
+
+   ! <------ outputs:
+   !     physical tendencies
+   REAL,DIMENSION(:),ALLOCATABLE :: pdpsrf
+   REAL,DIMENSION(:,:),ALLOCATABLE :: pdu,pdv,pdt
+   REAL,DIMENSION(:,:,:),ALLOCATABLE :: pdq
+   ! ... intermediate arrays
+   REAL, DIMENSION(:), ALLOCATABLE  :: &
+     dz8w_prof,p8w_prof,p_prof,t_prof,t8w_prof, &
+     u_prof,v_prof,z_prof
+!!   pi_prof, rho_prof, th_prof, &
+#ifdef NEWPHYS
+   REAL, DIMENSION(:,:), ALLOCATABLE :: q_prof
+#else
+   REAL, DIMENSION(:), ALLOCATABLE  :: &
+     water_vapor_prof, water_ice_prof
+#endif
+
+
+   ! Additional control variables
+   INTEGER :: sponge_top,relax,ips,ipe,jps,jpe,kps,kpe
+   REAL :: elaps, ptimestep
+   INTEGER :: wday_ini, test, test2
+   REAL :: wappel_phys
+   LOGICAL :: flag_LES
+   LOGICAL, SAVE :: flag_first_restart
+!**************************************************
+! IMPORTANT: pour travailler avec grid nesting
+! --- deux comportements distincts du save
+! ... ex1: ferme planeto avec PGF+MPI: standard
+! ... ex2: iDataPlex avec IFORT+MPI: SPECIAL_NEST_SAVE 
+!**************************************************
+#ifdef SPECIAL_NEST_SAVE
+      !  une dimension supplementaire liee au nest
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             dp_save
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: &
+             du_save, dv_save, dt_save
+      REAL, DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: &
+             dq_save      
+#ifndef NORESTART
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: &
+             save_tsoil_restart
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             save_tsurf_restart
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             save_co2ice_restart
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: &
+             save_q2_restart
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: &
+             save_qsurf_restart
+#ifdef NEWPHYS
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             save_wstar_restart
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             save_fluxrad_restart
+#endif
+#endif
+#else
+      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: &
+             dp_save
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             du_save, dv_save, dt_save
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: &
+             dq_save      
+#ifndef NORESTART
+!! FOR RESTART
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             save_tsoil_restart
+      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: &
+             save_tsurf_restart
+      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: &
+             save_co2ice_restart
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             save_q2_restart
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             save_qsurf_restart
+#ifdef NEWPHYS
+      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: &
+             save_wstar_restart
+      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: &
+             save_fluxrad_restart
+#endif
+#endif
+#endif
+
+!!!IDEALIZED IDEALIZED
+      REAL :: lat_input, lon_input, ls_input, lct_input
+!!!IDEALIZED IDEALIZED
+
+!!!!!!!!!!!!!! TEST NaN or Inf : ne fonction qu'avec r4 i4
+integer :: mask_nan = 2139095040
+integer :: chuck_norris
+!!!!!!!!!!!!!! TEST NaN or Inf : ne fonction qu'avec r4 i4
+
+!REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: &
+!     UMAX, UMIN, VMAX, VMIN, WMAX, WMIN, TMAX, TMIN
+
+
+
+!==================================================================
+! CODE
+!==================================================================
+
+IF (JULYR .ne. 9999) THEN
+    flag_LES = .false.  ! "True" LES is not available in this version
+    PRINT *, '*** REAL-CASE SIMULATION ***'
+ELSE
+     PRINT *, '*** IDEALIZED SIMULATION ***'
+     IF ((diff_opt .eq. 2) .and. (km_opt .eq. 2)) THEN
+          PRINT *, '*** type: LES ***'
+          PRINT *, '*** diff_opt = 2 *** km_opt = 2'
+          PRINT *, '*** forcing is isfflx = ',isfflx 
+          flag_LES = .true.
+          !! SPECIAL LES
+     ELSE
+          PRINT *, '*** type: not LES ***'
+          PRINT *, '*** diff_opt = ',diff_opt
+          PRINT *, '*** km_opt = ',km_opt
+          flag_LES = .false.
+          !! IDEALIZED, no LES
+          !! cependant, ne veut-on pas pouvoir
+          !! prescrire un flux en idealise ??
+     ENDIF
+ENDIF
+
+
+print *,'** Mars ** DOMAIN',id
+
+!-------------------------!
+! TWEAK on WRF DIMENSIONS !
+!-------------------------!
+its = i_start(1)   ! define here one big tile
+ite = i_end(num_tiles)
+jts = j_start(1)
+jte = j_end(num_tiles)
+!!
+IF (flag_LES .eqv. .false.) THEN
+ relax=0
+ sponge_top=0               ! another value than 0 triggers instabilities  
+ IF (id .gt. 1) relax=2     ! fix to avoid noise in nesting simulations ; 1 >> too much noise ...
+ENDIF
+ips=its
+ipe=ite
+jps=jts
+jpe=jte
+IF (flag_LES .eqv. .false.) THEN
+ IF (ips .eq. ids)   ips=its+relax !! IF tests necesary for parallel runs
+ IF (ipe .eq. ide-1) ipe=ite-relax
+ IF (jps .eq. jds)   jps=jts+relax
+ IF (jpe .eq. jde-1) jpe=jte-relax
+ENDIF
+kps=kts         !! start at surface 
+IF (flag_LES .eqv. .false.) THEN
+ kpe=kte-sponge_top
+ELSE
+ PRINT *, '*** IDEALIZED SIMULATION: LES *** kpe=kte'
+ kpe=kte !-sponge_top
+ENDIF
+
+!----------------------------!
+! DIMENSIONS FOR THE PHYSICS !
+!----------------------------!
+wday_ini = JULDAY - 1      !! GCM convention
+wappel_phys = RADT
+ptimestep = dt*wappel_phys            ! physical timestep (s)
+ngrid=(ipe-ips+1)*(jpe-jps+1)         ! size of the horizontal grid
+nlayer = kpe-kps+1                    ! number of vertical layers: nlayermx
+nsoil = NUM_SOIL_LAYERS               ! number of soil layers: nsoilmx
+if (num_3d_s > 1) then                ! number of advected fields
+        nq = num_3d_s-1               
+else
+        nq = 1
+endif
+! **** needed but hardcoded
+lastcall = .false.
+! **** needed but hardcoded
+
+          !PRINT *, ips, ipe, jps, jpe
+          !PRINT *, ngrid
+
+elaps = (float(itimestep)-1.)*dt  ! elapsed seconds of simulation
+!----------------------------------------------!
+! what is done at the first step of simulation !
+!----------------------------------------------!
+IF (elaps .eq. 0.) THEN
+   flag_first_restart = .false.
+ELSE
+   flag_first_restart=flag_first_restart.OR.(.NOT. ALLOCATED(dp_save))
+ENDIF
+
+IF ((elaps .eq. 0.).or.flag_first_restart) THEN
+firstcall=.true.  !! for continuity with GCM, physics are always called at the first WRF timestep
+  !firstcall=.false. !! just in case you'd want to get rid of the physics 
+test=0
+#ifdef SPECIAL_NEST_SAVE
+PRINT *, 'ALLOCATED dp_save ???', ALLOCATED( dp_save ), id
+IF( .NOT. ALLOCATED( dp_save  ) ) THEN
+   PRINT *, '**** check **** OK I ALLOCATE one save ARRAY for all NESTS ', max_dom, id
+   !! here are the arrays that would be useful to save physics tendencies
+   ALLOCATE(dp_save(ngrid,max_dom))
+   ALLOCATE(du_save(ngrid,nlayer,max_dom))
+   ALLOCATE(dv_save(ngrid,nlayer,max_dom))
+   ALLOCATE(dt_save(ngrid,nlayer,max_dom))
+   ALLOCATE(dq_save(ngrid,nlayer,nq,max_dom))
+   dp_save(:,:)=0.    !! initialize these arrays ...
+   du_save(:,:,:)=0.
+   dv_save(:,:,:)=0.
+   dt_save(:,:,:)=0.
+   dq_save(:,:,:,:)=0.
+#ifndef NORESTART
+   ! Restart save arrays
+   ALLOCATE(save_tsoil_restart(ngrid,nsoil,max_dom))
+   ALLOCATE(save_co2ice_restart(ngrid,max_dom))
+   ALLOCATE(save_q2_restart(ngrid,nlayer+1,max_dom))
+   ALLOCATE(save_qsurf_restart(ngrid,nq,max_dom))
+   ALLOCATE(save_tsurf_restart(ngrid,max_dom))
+   save_tsoil_restart(:,:,:)=0.
+   save_co2ice_restart(:,:)=0.
+   save_q2_restart(:,:,:)=0.
+   save_qsurf_restart(:,:,:)=0.
+   save_tsurf_restart(:,:)=0.
+#ifdef NEWPHYS
+   ALLOCATE(save_wstar_restart(ngrid,max_dom))
+   ALLOCATE(save_fluxrad_restart(ngrid,max_dom))
+   save_wstar_restart(:,:)=0.
+   save_fluxrad_restart(:,:)=0.
+#endif
+#endif
+ENDIF
+IF (id .lt. max_dom) THEN
+   flag_first_restart=.true.
+ELSE
+   flag_first_restart=.false.
+ENDIF
+#else
+IF( .NOT. ALLOCATED( dp_save  ) ) THEN
+ALLOCATE(dp_save(ngrid)) !! here are the arrays that would be useful to save physics tendencies
+ALLOCATE(du_save(ngrid,nlayer))
+ALLOCATE(dv_save(ngrid,nlayer))
+ALLOCATE(dt_save(ngrid,nlayer))
+ALLOCATE(dq_save(ngrid,nlayer,nq))
+ENDIF
+dp_save(:)=0.    !! initialize these arrays ...
+du_save(:,:)=0.
+dv_save(:,:)=0.
+dt_save(:,:)=0.
+dq_save(:,:,:)=0.
+flag_first_restart=.false.
+#ifndef NORESTART
+! Restart save arrays
+IF( .NOT. ALLOCATED( save_tsoil_restart  ) ) THEN
+ALLOCATE(save_tsoil_restart(ngrid,nsoil))
+ALLOCATE(save_co2ice_restart(ngrid))
+ALLOCATE(save_q2_restart(ngrid,nlayer+1))
+ALLOCATE(save_qsurf_restart(ngrid,nq))
+ALLOCATE(save_tsurf_restart(ngrid))
+ENDIF
+save_tsoil_restart(:,:)=0.
+save_co2ice_restart(:)=0.
+save_q2_restart(:,:)=0.
+save_qsurf_restart(:,:)=0.
+save_tsurf_restart(:)=0.
+#ifdef NEWPHYS
+IF( .NOT. ALLOCATED( save_wstar_restart  ) ) THEN
+ALLOCATE(save_wstar_restart(ngrid))
+ALLOCATE(save_fluxrad_restart(ngrid))
+ENDIF
+save_wstar_restart(:)=0.
+save_fluxrad_restart(:)=0.
+#endif
+#endif
+#endif
+
+!! put here some general information you'd like to print just once
+    print *, 'TILES: ', i_start,i_end, j_start, j_end  ! numbers for simple runs, arrays for parallel runs
+    print *, 'DOMAIN: ', ids, ide, jds, jde
+    print *, 'MEMORY: ', ims, ime, jms, jme
+    print *, 'ADVECTED TRACERS: ', num_3d_s-1
+    print *, 'PHYSICS IS CALLED EACH...',wappel_phys
+!! put here some general information you'd like to print just once
+ELSE
+!-------------------------------------------------!
+! what is done for the other steps of simulation  !
+!-------------------------------------------------!
+IF (wappel_phys .gt. 0.) THEN
+firstcall = .false.
+test = MODULO(itimestep-1,int(wappel_phys)) ! WRF time is integrated time (itimestep=1 at the end of first step) 
+                                            ! -- same strategy as diagfi in the LMD GCM 
+                                            ! -- arguments of modulo must be of the same kind (here: integers)
+ELSE
+firstcall = .false.
+test = 9999   
+ENDIF
+ENDIF 
+
+!!!!! for 'subgrid' temporal diagnostics
+!test2 = MODULO(elaps,history_interval*100.)
+
+!!!******!!
+!!! TIME !!
+!!!******!!
+IF (JULYR .ne. 9999) THEN
+  !
+  ! specified
+  !
+  ptime = (GMT + elaps/3700.) !! universal time (0<ptime<1): ptime=0.5 at 12:00 UT 
+  ptime = MODULO(ptime,24.)   !! the two arguments of MODULO must be of the same type 
+  ptime = ptime / 24.
+  pday = (JULDAY - 1 + INT((3700*GMT+elaps)/88800))
+  pday = MODULO(int(pday),669)
+  MY = (JULYR-2000) + (88800.*(JULDAY - 1)+3700.*GMT+elaps)/59496000.
+  MY = INT(MY)
+ELSE
+  !
+  ! idealized
+  !
+  PRINT *,'** Mars ** IDEALIZED SIMULATION'
+  PRINT *,'** Mars ** BEWARE: input_coord must be here'
+  open(unit=14,file='input_coord',form='formatted',status='old')
+  rewind(14)
+  read(14,*) lon_input
+  read(14,*) lat_input
+  read(14,*) ls_input
+  read(14,*) lct_input
+  close(14)
+  ptime = lct_input - lon_input / 15. + elaps/3700.
+  ptime = MODULO(ptime,24.)
+  ptime = ptime / 24.
+  pday = floor(ls2sol(ls_input)) + INT((3700*(lct_input - lon_input / 15.) + elaps)/88800)
+  pday = MODULO(int(pday),669)
+  MY = 2024
+  wday_ini = floor(ls2sol(ls_input))
+ENDIF
+print *,'** Mars ** TIME IS', pday, ptime*24.
+
+
+!!****************!!
+!! CHECK DYNAMICS !!
+!!****************!!
+!IF ((MAXVAL(t) > 500).OR.(MINVAL(t,MASK = t > 0) <= 50)) THEN
+!        PRINT *,'******************   CRASH   *******************'
+!        PRINT *,'Irrealistic temperature...', MAXLOC(t), MINLOC(t)
+!PRINT *, t
+!        PRINT *,'************************************************'
+!        STOP
+!ENDIF   
+
+!print *, 'check dynamics'
+!  !!! in some cases, weird values are displayed
+!  !!! despite the fact that outputs are OK...
+!  !print *, 'u', MAXVAL(u), MINVAL(u)
+!  !print *, 'v', MAXVAL(v), MINVAL(v)
+!  !print *, 'w', MAXVAL(w), MINVAL(w)
+!  !print *, 't', MAXVAL(t), MINVAL(t, MASK = t > 0)
+!print *, 'u', u(10,1,10), u(10,15,10)
+!print *, 'v', v(10,1,10), v(10,15,10)
+!print *, 'w', w(10,1,10), w(10,15,10) 
+!print *, 't', t(10,1,10), t(10,15,10)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!IF (test2.EQ.0) THEN
+!  print *, 'compute stats'
+!  print *, 'RESET'
+!   uave  = uave*0.
+!     vave  = vave*0.
+!     tave  = tave*0.
+!     wave  = wave*0.
+!   ustd  = ustd*0.
+!     vstd  = vstd*0.
+!     tstd  = tstd*0.
+!     wstd  = wstd*0.
+!ENDIF
+!  uave = uave + u  * dt / (float(history_interval)*100.)
+!  vave = vave + v  * dt / (float(history_interval)*100.)
+!  tave = tave + th * dt / (float(history_interval)*100.)
+!  wave = wave + w  * dt / (float(history_interval)*100.)
+!  ustd = ustd + u  * u  * dt / (float(history_interval)*100.)
+!  vstd = vstd + v  * v  * dt / (float(history_interval)*100.)
+!  tstd = tstd + th * th * dt / (float(history_interval)*100.)
+!  wstd = wstd + w  * w  * dt / (float(history_interval)*100.)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!!
+!!!!! PROBLEME avec 3 NESTS !!!
+!!!!!
+!chuck_norris = transfer( u(1,1,1),chuck_norris )        !! astuce J. Lefrere - test NaN or Inf 
+!PRINT *,'check stability' 
+!IF ( iand( chuck_norris,mask_nan ) == mask_nan ) THEN   !! astuce J. Lefrere - test NaN or Inf
+!        PRINT *, u(1,1,1)
+!        PRINT *,'******************   CRASH   *******************'
+!        PRINT *,'************************************************'
+!        PRINT *,'NaN or Inf appeared in the simulation ...'
+!        PRINT *,'...this may be due to numerical or dynamical instability'
+!        PRINT *,'************************************************'
+!        PRINT *,'POSSIBLE SOLUTIONS:'
+!        PRINT *,'>> IF nonhydrostatic mode,' 
+!        PRINT *,'   --> check that smdiv, emdiv and epssm are not 0.'
+!        PRINT *,'>> IF cfl is violated, '
+!        PRINT *,'   --> try to lower the dynamical timestep'
+!        PRINT *,'>> IF topographical gradients are high near specified bdy,'
+!        PRINT *,'   --> try to redefine the domain'
+!        PRINT *,'************************************************'
+!        STOP
+!ELSE
+!        PRINT *,'OK OK OK OK'
+!ENDIF
+!ENDIF
+        !IF (          ANY(isNaN(u)) &
+        !         .OR. ANY(isNaN(v)) &
+        !         .OR. ANY(isNaN(t)) ) THEN
+        ! >>> ne marche qu'avec g95
+!print *, 'check dynamics'
+!print *, 'u', MAXVAL(u), MINVAL(u)
+!print *, 'v', MAXVAL(v), MINVAL(v)
+!print *, 't', MAXVAL(t), MINVAL(t, MASK = t > 0) 
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!----------!
+! ALLOCATE !
+!----------!
+ALLOCATE(pdpsrf(ngrid))
+ALLOCATE(pdu(ngrid,nlayer))
+ALLOCATE(pdv(ngrid,nlayer))
+ALLOCATE(pdt(ngrid,nlayer))
+ALLOCATE(pdq(ngrid,nlayer,nq))
+!!!
+!!! BIG LOOP : 1. no call for physics, used saved values
+!!!
+IF (test.NE.0) THEN
+print *,'** Mars ** NO CALL FOR PHYSICS, go to next step...',test
+#ifdef SPECIAL_NEST_SAVE
+pdpsrf(:)=dp_save(:,id)
+pdu(:,:)=du_save(:,:,id)
+pdv(:,:)=dv_save(:,:,id)
+pdt(:,:)=dt_save(:,:,id)
+pdq(:,:,:)=dq_save(:,:,:,id)
+#else
+pdpsrf(:)=dp_save(:)
+pdu(:,:)=du_save(:,:)
+pdv(:,:)=dv_save(:,:)
+pdt(:,:)=dt_save(:,:)
+pdq(:,:,:)=dq_save(:,:,:)
+#endif
+!!!
+!!! BIG LOOP : 2. calculate physical tendencies
+!!!
+ELSE
+!----------!
+! ALLOCATE !
+!----------!
+! inputs ...
+IF (firstcall .EQV. .true.) THEN
+  ALLOCATE(aire_vec(ngrid))!
+  ALLOCATE(lon_vec(ngrid))!
+  ALLOCATE(lat_vec(ngrid))!
+  ALLOCATE(walbedodat(ngrid))!
+  ALLOCATE(winertiedat(ngrid))!
+  ALLOCATE(wphisfi(ngrid))!
+  ALLOCATE(wzmea(ngrid))!
+  ALLOCATE(wzstd(ngrid))!
+  ALLOCATE(wzsig(ngrid))!
+  ALLOCATE(wzgam(ngrid))!
+  ALLOCATE(wzthe(ngrid))!
+  ALLOCATE(wtheta(ngrid))!
+  ALLOCATE(wpsi(ngrid))!
+#ifdef NEWPHYS
+  ALLOCATE(wz0tab(ngrid))!
+#endif
+ENDIF
+ALLOCATE(wtsurf(ngrid))          !!!!!
+#ifndef NOPHYS
+ALLOCATE(output_tab2d(ngrid,n2d))
+ALLOCATE(output_tab3d(ngrid,nlayer,n3d))
+#endif
+ALLOCATE(wco2ice(ngrid))         !!!!!
+ALLOCATE(wemis(ngrid))           !!!!!
+ALLOCATE(q2_val(nlayer+1))
+ALLOCATE(qsurf_val(nq))
+ALLOCATE(tsoil_val(nsoil))
+#ifdef NEWPHYS
+ALLOCATE(isoil_val(nsoil))
+ALLOCATE(dsoil_val(nsoil))
+#endif
+ALLOCATE(wq2(ngrid,nlayer+1))    !!!!!
+ALLOCATE(wqsurf(ngrid,nq))       !!!!!
+ALLOCATE(wtsoil(ngrid,nsoil))    !!!!!
+#ifdef NEWPHYS
+ALLOCATE(wfluxrad(ngrid))
+ALLOCATE(wwstar(ngrid))
+ALLOCATE(wisoil(ngrid,nsoil))    !!!!!
+ALLOCATE(wdsoil(ngrid,nsoil))    !!!!!
+#endif
+ALLOCATE(pplev(ngrid,nlayer+1))  !!!!!
+ALLOCATE(pplay(ngrid,nlayer))    !!!!!
+ALLOCATE(pphi(ngrid,nlayer))     !!!!!
+ALLOCATE(pu(ngrid,nlayer))       !!!!!
+ALLOCATE(pv(ngrid,nlayer))       !!!!!
+ALLOCATE(pt(ngrid,nlayer))       !!!!!
+ALLOCATE(pw(ngrid,nlayer))       !!!!!
+ALLOCATE(pq(ngrid,nlayer,nq))    !!!!!
+! interm
+ALLOCATE(dz8w_prof(nlayer))
+ALLOCATE(p8w_prof(nlayer))
+ALLOCATE(p_prof(nlayer))
+ALLOCATE(t_prof(nlayer))
+ALLOCATE(t8w_prof(nlayer))
+ALLOCATE(u_prof(nlayer))
+ALLOCATE(v_prof(nlayer))
+ALLOCATE(z_prof(nlayer))
+!ALLOCATE(th_prof(nlayer))
+!ALLOCATE(rho_prof(nlayer))
+!ALLOCATE(pi_prof(nlayer))
+#ifdef NEWPHYS
+ALLOCATE(q_prof(nlayer,nq))
+ALLOCATE(wtnom(nq))              !!!!!
+#else
+ALLOCATE(water_vapor_prof(nlayer))
+ALLOCATE(water_ice_prof(nlayer))
+#endif
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! PREPARE PHYSICS INPUTS !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!SELECT CASE (MARS_MODE) !! ONLY ALLOW FOR MODES DEFINED IN Registry.EM
+!   CASE(4-10,13-19,22-41,43:)      !! -- CHANGE THIS if YOU ADDED CASES in REGISTRY.EM
+!   PRINT *, 'NOT SUPPORTED, to be done'
+!   STOP
+!END SELECT
+!!!!!!!!!!!!!!!!!!! FOR REFERENCE ; FROM REGISTRY.EM
+!package   default      mars==0                      -              -
+!package   water        mars==1                      -              scalar:qh2o,qh2o_ice
+!package   dust1        mars==2                      -              scalar:qdust
+!package   dust2eq      mars==3                      -              scalar:qdust,qdustn
+!package   newwater     mars==11                     -              scalar:qh2o,qh2o_ice,qdust,qdustn
+!package   radioac      mars==20                     -              scalar:qtrac1
+!package   radioac2     mars==21                     -              scalar:upward,downward
+!package   photochem    mars==42                     -              scalar:qco2,chem_co,chem_o,chem_o1d,chem_o2,chem_o3,chem_h,chem_h2,chem_oh,chem_ho2,chem_h2o2,chem_ch4,chem_n2,chem_ar,qh2o_ice,qh2o,qdust,qdustn
+!!!!!!!!!!!!!!!!!!! FOR REFERENCE
+
+#ifdef NEWPHYS
+!!! name of tracers to mimic entries in tracer.def 
+!!! ----> IT IS IMPORTANT TO KEEP SAME ORDERING AS IN THE REGISTRY !!!!
+!!!                               SAME NAMING   AS IN THE LMD PHYSICS !!!!
+SELECT CASE (MARS_MODE)
+    CASE(0,10)  
+      wtnom(nq) = 'co2'
+    CASE(1)
+      wtnom(1)  = 'h2o_vap'
+      wtnom(2)  = 'h2o_ice' 
+    CASE(2)
+      wtnom(1)  = 'dust01'      
+    CASE(3)
+      wtnom(1)  = 'dust_mass'
+      wtnom(2)  = 'dust_number' 
+    CASE(11) 
+      wtnom(1)  = 'h2o_vap'
+      wtnom(2)  = 'h2o_ice' 
+      wtnom(3)  = 'dust_mass'
+      wtnom(4)  = 'dust_number'
+    CASE(12)
+      wtnom(1)  = 'h2o_vap'
+      wtnom(2)  = 'h2o_ice'
+      wtnom(3)  = 'dust_mass'
+      wtnom(4)  = 'dust_number'
+      wtnom(5)  = 'ccn_mass'
+      wtnom(6)  = 'ccn_number'
+    CASE(20) 
+      wtnom(1) = 'qtrac1'
+    CASE(21)
+      wtnom(1) = 'upward'
+      wtnom(2) = 'downward' 
+    CASE(42)
+      wtnom(1)  = 'co2'
+      wtnom(2)  = 'co'
+      wtnom(3)  = 'o'
+      wtnom(4)  = 'o1d'
+      wtnom(5)  = 'o2'
+      wtnom(6)  = 'o3'
+      wtnom(7)  = 'h'
+      wtnom(8)  = 'h2'
+      wtnom(9)  = 'oh'
+      wtnom(10)  = 'ho2'
+      wtnom(11)  = 'h2o2'
+      wtnom(12)  = 'ch4'
+      wtnom(13)  = 'n2'
+      wtnom(14)  = 'ar'
+      wtnom(15)  = 'h2o_ice'
+      wtnom(16)  = 'h2o_vap'
+      wtnom(17)  = 'dust_mass'
+      wtnom(18)  = 'dust_number'
+END SELECT
+#endif
+
+!!*******************************************!!
+!!*******************************************!!
+
+DO j = jps,jpe
+DO i = ips,ipe
+
+!!*******************************************!!
+!! FROM 3D WRF FIELDS TO 1D PHYSICS PROFILES !!
+!!*******************************************!!
+
+!-----------------------------------!
+! 1D subscript for physics "cursor" !
+!-----------------------------------!
+subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+!--------------------------------------!
+! 1D columns : inputs for the physics  !
+! ... vert. coord., meteor. fields ... !
+!--------------------------------------!
+dz8w_prof(:) = dz8w(i,kps:kpe,j)   ! dz between full levels (m)   
+p8w_prof(:) = p8w(i,kps:kpe,j)     ! pressure full level (Pa) >> pplev
+p_prof(:) = p(i,kps:kpe,j)         ! pressure half level (Pa) >> pplay
+t_prof(:) = t(i,kps:kpe,j)         ! temperature half level (K) >> pt
+t8w_prof(:) = t8w(i,kps:kpe,j)     ! temperature full level (K)
+u_prof(:) = u(i,kps:kpe,j)         ! zonal wind (A-grid: unstaggered) half level (m/s) >> pu  
+v_prof(:) = v(i,kps:kpe,j)         ! meridional wind (A-grid: unstaggered) half level (m/s) >> pv
+z_prof(:) = z(i,kps:kpe,j)         ! geopotential height half level (m) >> pphi/g
+!pi_prof(:) = exner(i,kps:kpe,j)    ! exner function (dimensionless) half level 
+!rho_prof(:) = rho(i,kps:kpe,j)     ! density half level  
+!th_prof(:) = th(i,kps:kpe,j)       ! pot. temperature half level (K)
+
+!--------------------------------!
+! specific treatment for tracers !
+!--------------------------------!
+#ifndef NOPHYS
+#ifdef NEWPHYS
+IF (MARS_MODE .EQ. 0) THEN
+    q_prof(:,1)=0.95
+ELSE
+    q_prof(:,1:nq) = SCALAR(i,kps:kpe,j,2:nq+1)  !! the names were set above !! one dummy tracer in WRF
+ENDIF
+  !!!! CAS DU CO2
+  !DO iii=1,nq 
+  ! IF ( wtnom(iii) .eq. 'co2' .and. (.not. restart)) q_prof(:,iii) = 0.95
+  !ENDDO
+  IF ((MARS_MODE .EQ. 20) .OR. (MARS_MODE .EQ. 21)) THEN
+   IF (firstcall .EQV. .true. .and. (.not. restart)) THEN
+      q_prof(:,:) = 0.95
+   ENDIF
+  ENDIF
+#else
+SELECT CASE (MARS_MODE)
+    CASE(0)  !! NO TRACERS (mars=0)
+    water_vapor_prof(:) = 0.
+    water_ice_prof(:) = 0.
+    CASE(1)  !! WATER CYCLE (mars=1)
+    water_vapor_prof(:) = scalar(i,kps:kpe,j,2)  !! H2O vapor is tracer 1 in the Registry for mars=1
+    water_ice_prof(:) = scalar(i,kps:kpe,j,3)    !! H2O ice is tracer 2 in the Registry for mars=1
+    CASE(2)  !! DUST CYCLE (mars=2)
+    water_vapor_prof(:) = 0.
+    water_ice_prof(:) = 0.
+    CASE(3:)
+    print *, 'OOOPS... not ready yet.'
+    STOP
+END SELECT
+#endif
+#endif
+
+!!**********************************************************!!
+!! STATIC FIELDS FOR THE PHYSICS - NEEDED ONLY AT FIRSTCALL !!
+!!**********************************************************!!
+needed_ini_phys : IF (firstcall .EQV. .true.) THEN
+
+!----------------------------------------!
+! Surface of each part of the grid (m^2) !
+!----------------------------------------!
+!aire_val = dx*dy                           !! 1. idealized cases - computational grid
+aire_val = (dx/msft(i,j))*(dy/msft(i,j))    !! 2. WRF map scale factors - assume that msfx=msfy (msf=covariance)
+!aire_val=dx*dy/msfu(i,j)                   !! 3. special for Mercator GCM-like simulations
+
+!---------------------------------------------!
+! Mass-point latitude and longitude (radians) !
+!---------------------------------------------!
+IF (JULYR .ne. 9999) THEN
+ lat_val = XLAT(i,j)*DEGRAD
+ lon_val = XLONG(i,j)*DEGRAD
+ELSE
+ !!! IDEALIZED CASE
+ IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lat: ',lat_input
+ IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lon: ',lon_input
+ lat_val = lat_input*DEGRAD
+ lon_val = lon_input*DEGRAD
+ENDIF
+
+!-----------------------------------------!
+! Gravity wave parametrization            !
+! NB: usually 0 in mesoscale applications !
+!-----------------------------------------!
+IF (JULYR .ne. 9999) THEN
+ zmea_val=M_GW(i,1,j)
+ zstd_val=M_GW(i,2,j)
+ zsig_val=M_GW(i,3,j)
+ zgam_val=M_GW(i,4,j)
+ zthe_val=M_GW(i,5,j)
+ELSE
+ IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION GWdrag OFF'
+ zmea_val=0.
+ zstd_val=0.
+ zsig_val=0.
+ zgam_val=0.
+ zthe_val=0.
+ENDIF
+
+!---------------------------------!
+! Ground albedo & Thermal Inertia !
+!---------------------------------!
+IF (JULYR .ne. 9999) THEN
+ IF (CST_AL == 0) THEN 
+ albedodat_val=M_ALBEDO(i,j) 
+ ELSE 
+ albedodat_val=CST_AL
+ IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT ALBEDO ', albedodat_val
+ ENDIF
+ IF (CST_TI == 0) THEN 
+ inertiedat_val=M_TI(i,j) 
+ ELSE 
+ inertiedat_val=CST_TI
+ IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT THERMAL INERTIA ', inertiedat_val
+ ENDIF
+ELSE
+ IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION albedo: ', CST_AL
+ IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION inertia: ',CST_TI
+ albedodat_val=CST_AL
+ inertiedat_val=CST_TI
+ENDIF
+
+#ifdef NEWPHYS
+!----------------------------!
+! Variable surface roughness !
+!----------------------------!
+IF (JULYR .ne. 9999) THEN
+ IF (CST_Z0 == 0) THEN 
+   z0_val = M_Z0(i,j) 
+ ELSE 
+   z0_val = CST_Z0
+   IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT SURF ROUGHNESS (m) ',CST_Z0
+ ENDIF 
+ELSE
+ IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION z0 (m) ', CST_Z0
+ z0_val=CST_Z0
+ENDIF
+!!!! ADDITIONAL SECURITY. THIS MIGHT HAPPEN WITH OLD INIT FILES.
+IF (z0_val == 0.) THEN
+   IF ( (i == ips) .AND. (j == jps) ) PRINT *, 'WELL, z0 is 0, this is no good. Setting to old defaults value 0.01 m'
+   z0_val = 0.01
+ENDIF
+!!!! ADDITIONAL SECURITY. INTERP+SMOOTH IN GEOGRID MIGHT YIELD NEGATIVE Z0 !!!
+IF (z0_val < 0.) THEN
+   PRINT *, 'WELL, z0 is NEGATIVE, this is impossible. better stop here.'
+   PRINT *, 'advice --> correct interpolation / smoothing of z0 in WPS'
+   PRINT *, '           -- or check the constant value set in namelist.input'
+   STOP
+ENDIF
+#endif
+
+!---------------------------------------------------------!
+! Ground geopotential                                     !
+! (=g*HT(i,j), only used in the microphysics: newcondens) !
+!---------------------------------------------------------! 
+phisfi_val=g*(z_prof(1)-dz8w_prof(1)/2.)   !! NB: z_prof are half levels, so z_prof(1) is not the surface
+
+!-----------------------------------------------!
+! Ground temperature, emissivity, CO2 ice cover !
+!-----------------------------------------------!
+IF (M_TSURF(i,j) .gt. 0.) THEN
+  tsurf_val=M_TSURF(i,j)
+ELSE
+  tsurf_val=TSK(i,j) ! retro-compatibility
+ENDIF
+emis_val=M_EMISS(i,j)
+co2ice_val=M_CO2ICE(i,j)
+
+!------------------------!
+! Deep soil temperatures ! 
+!------------------------!
+IF (JULYR .ne. 9999) THEN
+  IF (M_TSOIL(i,1,j) .gt. 0.) THEN
+   tsoil_val(:)=M_TSOIL(i,:,j)
+  ELSE
+   tsoil_val = tsoil_val*0. + tsurf_val
+  ENDIF
+#ifdef NEWPHYS
+  isoil_val(:)=M_ISOIL(i,:,j)
+  dsoil_val(:)=M_DSOIL(i,:,j)
+#endif
+ELSE
+  IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION tsoil is set to tsurf'
+  do k=1,nsoil
+   IF (.not.restart) THEN
+     tsoil_val(k) = tsurf_val
+   ELSE
+     !this is a restart run. We must not set tsoil to tsurf in the init.
+     !tsoil was saved in physiq.F under the name M_TSOIL in the restart file
+     !(see Registry)
+     tsoil_val(k)=M_TSOIL(i,k,j)
+   ENDIF
+
+#ifdef NEWPHYS
+   IF ( nsoil .lt. 18 ) THEN
+       PRINT *,'** Mars ** WRONG NUMBER OF SOIL LAYERS. SHOULD BE 18 AND IT IS ',nsoil
+       STOP
+   ENDIF
+   IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION isoil and dsoil standard'
+   isoil_val(k) = inertiedat_val
+!  dsoil_val(k) = sqrt(887.75/3.14)*((2.**(k-0.5))-1.) * inertiedat_val / wvolcapa    ! old setting
+   dsoil_val(k) = 2.E-4 * (2.**(k-0.5-1.))                                            ! new gcm settings
+   IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** ISOIL DSOIL are ',isoil_val(k), dsoil_val(k)
+#endif
+  enddo
+ENDIF
+
+!-------------------!
+! Tracer at surface !
+!-------------------!
+#ifndef NOPHYS
+SELECT CASE (MARS_MODE)
+    CASE(0)  
+    qsurf_val(:)=0.
+    CASE(1) 
+    qsurf_val(1)=0. 
+    qsurf_val(2)=M_H2OICE(i,j)    !! logique avec wtnom(2) = 'h2o_ice' defini ci-dessus
+                                   !! ----- retrocompatible ancienne physique
+                                   !! ----- [H2O ice is last tracer in qsurf in LMD physics]
+    CASE(2)  
+    qsurf_val(1)=0.                !! not coupled with lifting for the moment [non remobilise]
+#ifdef NEWPHYS
+    CASE(3)
+    qsurf_val(1)=q_prof(1,1)                !!! temporaire, a definir       
+    qsurf_val(2)=q_prof(1,2)     
+    CASE(11) 
+    qsurf_val(1)=0.
+    qsurf_val(2)=M_H2OICE(i,j)    !! logique avec wtnom(2) = 'h2o_ice' defini ci-dessus
+    qsurf_val(3)=0.                !! not coupled with lifting for the moment [non remobilise]
+    qsurf_val(4)=0.
+    CASE(12)    
+    qsurf_val(1)=0.
+    qsurf_val(2)=M_H2OICE(i,j)    !! logique avec wtnom(2) = 'h2o_ice' defini ci-dessus
+    qsurf_val(3)=0.                !! not coupled with lifting for the moment [non remobilise]
+    qsurf_val(4)=0.
+    qsurf_val(5)=0.
+    qsurf_val(6)=0.
+    CASE(20)
+    qsurf_val(:)=0.
+    CASE(21)
+    qsurf_val(:)=0.
+#else
+    CASE(3:)
+    print *, 'OOOPS... not ready yet.'
+    STOP
+#endif
+
+END SELECT
+#endif
+
+!-------------------!
+! Slope inclination !
+!-------------------!
+IF (JULYR .ne. 9999) THEN
+  theta_val=atan(sqrt( (1000.*SLPX(i,j))**2 + (1000.*SLPY(i,j))**2 ))
+  theta_val=theta_val/DEGRAD
+ELSE
+  IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION slope inclination is 0'
+  theta_val=0.
+ENDIF
+
+!-------------------------------------------!
+! Slope orientation; 0 is north, 90 is east !
+!-------------------------------------------!
+IF (JULYR .ne. 9999) THEN
+  psi_val=-90.*DEGRAD-atan(SLPY(i,j)/SLPX(i,j))
+  if (SLPX(i,j) .ge. 0.) then
+    psi_val=psi_val-180.*DEGRAD
+  endif
+  psi_val=360.*DEGRAD+psi_val
+  psi_val=psi_val/DEGRAD
+  psi_val = MODULO(psi_val+180.,360.)
+ELSE
+  IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION slope orientation is 0 (well, whatever)'
+  psi_val=0.
+ENDIF
+
+!-----------------!
+! Optional output !
+!-----------------!
+IF ( (i == ips) .AND. (j == jps) ) THEN
+PRINT *,'lat/lon ', lat_val/DEGRAD, lon_val/DEGRAD
+PRINT *,'emiss ', emis_val
+PRINT *,'albedo ', albedodat_val
+PRINT *,'inertie ', inertiedat_val
+PRINT *,'phi ',phisfi_val
+PRINT *,'tsurf ',tsurf_val
+PRINT *,'aire ',aire_val
+PRINT *,'z_prof ',z_prof
+PRINT *,'dz8w_prof',dz8w_prof
+PRINT *,'p8w_prof ',p8w_prof
+PRINT *,'p_prof ',p_prof
+PRINT *,'t_prof ',t_prof
+PRINT *,'t8w_prof ',t8w_prof
+PRINT *,'u_prof ',u_prof
+PRINT *,'v_prof ',v_prof
+PRINT *,'tsoil ',tsoil_val 
+PRINT *,'qsurf ',qsurf_val 
+#ifdef NEWPHYS
+PRINT *,'isoil ',isoil_val
+PRINT *,'dsoil ',dsoil_val
+PRINT *,'q_prof ',q_prof
+PRINT *,'z0 ',z0_val
+#endif
+ENDIF
+
+!-------------------------! 
+!-------------------------!
+!      PROVISOIRE         !
+!-------------------------!
+!-------------------------!
+IF (.not. restart) THEN
+   q2_val(:)=1.E-6      !PBL wind variance
+#ifdef NEWPHYS
+   fluxrad_val=0.
+   wstar_val=0.
+#endif
+ELSE
+   q2_val(:)=M_Q2(i,:,j)
+#ifdef NEWPHYS
+   fluxrad_val=M_FLUXRAD(i,j)
+   wstar_val=M_WSTAR(i,j)
+#endif
+ENDIF
+
+!-----------------!
+! Fill the arrays !
+!-----------------!
+aire_vec(subs) = aire_val   !! NB: total area in square km is SUM(aire_vec)/1.0E6
+lat_vec(subs) = lat_val
+lon_vec(subs) = lon_val
+wphisfi(subs) = phisfi_val
+walbedodat(subs) = albedodat_val
+winertiedat(subs) = inertiedat_val
+wzmea(subs) = zmea_val
+wzstd(subs) = zstd_val
+wzsig(subs) = zsig_val
+wzgam(subs) = zgam_val
+wzthe(subs) = zthe_val
+wtsurf(subs) = tsurf_val
+wco2ice(subs) = co2ice_val
+wemis(subs) = emis_val
+wq2(subs,:) = q2_val(:)
+wqsurf(subs,:) = qsurf_val(:)
+wtsoil(subs,:) = tsoil_val(:)
+#ifdef NEWPHYS
+wfluxrad(subs) = fluxrad_val
+wwstar(subs) = wstar_val
+wisoil(subs,:) = isoil_val(:)
+wdsoil(subs,:) = dsoil_val(:)
+wz0tab(subs) = z0_val
+#endif
+wtheta(subs) = theta_val
+wpsi(subs) = psi_val
+
+ENDIF needed_ini_phys
+
+!!*****************************!!
+!! PREPARE "FOOD" FOR PHYSIQ.F !!
+!!*****************************!!
+
+!---------------------------------------------!
+! in LMD physics, geopotential must be        !
+! expressed with respect to the local surface !
+!---------------------------------------------!
+pphi(subs,:) = g*( z_prof(:)-(z_prof(1)-dz8w_prof(1)/2.) )
+
+!--------------------------------!
+! Dynamic fields for LMD physics !
+!--------------------------------!
+pplev(subs,1:nlayer) = p8w_prof(1:nlayer)  !! NB: last level: no data
+pplay(subs,:) = p_prof(:)
+pt(subs,:) = t_prof(:)
+pu(subs,:) = u_prof(:)
+pv(subs,:) = v_prof(:)
+pw(subs,:) = 0   !! NB: not used in the physics, only diagnostic...
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! for IDEALIZED CASES ONLY
+IF (JULYR .eq. 9999) pplev(subs,nlayer+1)=0.  !! pplev(subs,nlayer+1)=ptop >> NO !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! NOTE:
+! IF ( pplev(subs,nlayer+1) .le. 0 ) pplev(subs,nlayer+1)=ptop
+! cree des diagnostics delirants et aleatoires dans le transfert radiatif 
+
+!---------!
+! Tracers !  
+!---------!
+#ifndef NOPHYS
+#ifdef NEWPHYS
+pq(subs,:,:) = q_prof(:,:)  !! traceurs generiques, seuls noms sont specifiques
+#else
+SELECT CASE (MARS_MODE)
+    CASE(0)  !! NO TRACERS (mars=0)
+    pq(subs,:,nq) = water_vapor_prof(:) !! NB: which is 0, actually (see above) 
+    CASE(1)  !! WATER CYCLE (mars=1)
+    pq(subs,:,nq) = water_vapor_prof(:)
+    pq(subs,:,nq-1) = water_ice_prof(:)
+    CASE(2)  !! DUST CYCLE (mars=2)
+    pq(subs,:,nq) = water_vapor_prof(:) !! NB: which is 0, actually (see above)
+    CASE(3:)
+    print *, 'OOOPS... not ready yet.'
+    STOP    
+END SELECT
+#endif
+#endif
+ENDDO
+ENDDO
+
+!!*****************!!
+!! CLEAN THE PLACE !!
+!!*****************!!
+DEALLOCATE(q2_val)
+DEALLOCATE(qsurf_val)
+DEALLOCATE(tsoil_val)
+#ifdef NEWPHYS
+DEALLOCATE(isoil_val)
+DEALLOCATE(dsoil_val)
+#endif
+DEALLOCATE(dz8w_prof)
+DEALLOCATE(z_prof)
+DEALLOCATE(p8w_prof)
+DEALLOCATE(p_prof)
+DEALLOCATE(t_prof)
+DEALLOCATE(t8w_prof)
+DEALLOCATE(u_prof)
+DEALLOCATE(v_prof)
+#ifdef NEWPHYS
+DEALLOCATE(q_prof)
+#else
+DEALLOCATE(water_vapor_prof)
+DEALLOCATE(water_ice_prof)
+#endif
+    !!! no use
+    !DEALLOCATE(pi_prof)
+    !DEALLOCATE(rho_prof)
+    !DEALLOCATE(th_prof)
+
+
+!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!
+!! CALL LMD PHYSICS !!  
+!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!***********************!!
+!! INIFIS, AT FIRST CALL !!
+!!***********************!!
+IF (firstcall .EQV. .true.) THEN
+#ifndef NOPHYS
+print *, '** Mars ** LMD INITIALIZATION'
+#include "../call_meso_inifis.inc"
+!!! le # est important pour newphys
+#endif
+DEALLOCATE(aire_vec)
+DEALLOCATE(lat_vec)
+DEALLOCATE(lon_vec)
+DEALLOCATE(walbedodat)
+DEALLOCATE(winertiedat)
+DEALLOCATE(wphisfi)
+DEALLOCATE(wzmea)
+DEALLOCATE(wzstd)
+DEALLOCATE(wzsig)
+DEALLOCATE(wzgam)
+DEALLOCATE(wzthe)
+DEALLOCATE(wtheta)
+DEALLOCATE(wpsi)
+#ifdef NEWPHYS
+DEALLOCATE(wz0tab)
+#endif
+ENDIF
+
+!!********!!
+!! PHYSIQ !!
+!!********!!
+call_physics : IF (wappel_phys .ne. 0.) THEN
+
+!-------------------------------------------------------------------------------!
+! outputs:									!	
+!    pdu(ngrid,nlayermx)        \						!
+!    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding	!
+!    pdt(ngrid,nlayermx)         /  variables due to physical processes.	!
+!    pdq(ngrid,nlayermx)        /						!
+!    pdpsrf(ngrid)             /						!
+!    tracerdyn                 call tracer in dynamical part of GCM ?		!
+!-------------------------------------------------------------------------------!
+pdpsrf(:)=0.
+pdu(:,:)=0.
+pdv(:,:)=0.
+pdt(:,:)=0.
+pdq(:,:,:)=0.
+#ifndef NOPHYS
+print *, '** Mars ** CALL TO LMD PHYSICS'
+#include "../call_meso_physiq.inc" 
+!!! le # est important pour newphys
+#endif
+DEALLOCATE(pplev)
+DEALLOCATE(pplay)
+DEALLOCATE(pphi)
+DEALLOCATE(pu)
+DEALLOCATE(pv)
+DEALLOCATE(pt)
+DEALLOCATE(pw)
+DEALLOCATE(pq)
+!DEALLOCATE(wtsurf)
+!DEALLOCATE(wco2ice)
+DEALLOCATE(wemis)
+!DEALLOCATE(wq2)
+!DEALLOCATE(wqsurf)
+!DEALLOCATE(wtsoil)
+!DEALLOCATE(wwstar)
+!DEALLOCATE(wfluxrad)
+#ifdef NEWPHYS
+DEALLOCATE(wisoil)
+DEALLOCATE(wdsoil)
+DEALLOCATE(wtnom)
+#endif
+
+
+!-------------------------------!
+! PHYSIQ OUTPUT IN THE WRF FILE !
+!-------------------------------!
+#ifndef NOPHYS
+DO j = jps,jpe
+DO i = ips,ipe
+subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+!!!! SEMBLE T IL PROBLEME AVEC NEWPHYS .... qui marche tres bien sans !
+!#ifndef NEWPHYS           
+!            !!! sparadrap pour regler un probleme avec mpiifort en LES
+!            !!! -- HFX apparaissait nul aux interfaces des tuiles
+!            if ( output_tab2d(subs,ind_HFX) .le. 1.e-8 ) then
+!               !print *, 'HFX is zero !!! ', i, j
+!               !print *, 'I substituted the value right next to it ', output_tab2d(subs+1,ind_HFX) 
+!               output_tab2d(subs,ind_HFX) = output_tab2d(subs+1,ind_HFX)
+!            endif
+!#endif
+
+#include "module_lmd_driver_output3.inc"  
+       !  ^-- generated from Registry
+ENDDO
+ENDDO
+DEALLOCATE(output_tab2d)
+DEALLOCATE(output_tab3d)
+#endif
+
+!!!!!! PATCH SPECIAL STORM
+#ifdef NEWPHYS
+#ifdef storm
+#include "../mars_lmd/storm.inc"
+#endif
+#endif
+!!!!!! PATCH SPECIAL STORM
+
+
+!---------------------------------------------------------------------------------!
+! PHYSIQ TENDENCIES ARE SAVED TO BE SPLIT WITHIN INTERMEDIATE DYNAMICAL TIMESTEPS !
+!---------------------------------------------------------------------------------!
+#ifdef SPECIAL_NEST_SAVE
+dp_save(:,id)=pdpsrf(:)
+du_save(:,:,id)=pdu(:,:)
+dv_save(:,:,id)=pdv(:,:)
+dt_save(:,:,id)=pdt(:,:)
+dq_save(:,:,:,id)=pdq(:,:,:)
+#ifndef NORESTART
+save_tsoil_restart(:,:,id)=wtsoil(:,:)
+save_co2ice_restart(:,id)=wco2ice(:)
+save_q2_restart(:,:,id)=wq2(:,:)
+save_qsurf_restart(:,:,id)=wqsurf(:,:)
+save_tsurf_restart(:,id)=wtsurf(:)
+#ifdef NEWPHYS
+save_wstar_restart(:,id)=wwstar(:)
+save_fluxrad_restart(:,id)=wfluxrad(:)
+#endif
+#endif
+#else
+dp_save(:)=pdpsrf(:)
+du_save(:,:)=pdu(:,:)
+dv_save(:,:)=pdv(:,:)
+dt_save(:,:)=pdt(:,:)
+dq_save(:,:,:)=pdq(:,:,:)
+#ifndef NORESTART
+save_tsoil_restart(:,:)=wtsoil(:,:)
+save_co2ice_restart(:)=wco2ice(:)
+save_q2_restart(:,:)=wq2(:,:)
+save_qsurf_restart(:,:)=wqsurf(:,:)
+save_tsurf_restart(:)=wtsurf(:)
+#ifdef NEWPHYS
+save_wstar_restart(:)=wwstar(:)
+save_fluxrad_restart(:)=wfluxrad(:)
+#endif
+#endif
+#endif
+DEALLOCATE(wtsoil)
+DEALLOCATE(wco2ice)
+DEALLOCATE(wq2)
+DEALLOCATE(wqsurf)
+DEALLOCATE(wtsurf)
+#ifdef NEWPHYS
+DEALLOCATE(wfluxrad)
+DEALLOCATE(wwstar)
+#endif
+ENDIF call_physics
+
+ENDIF    ! end of BIG LOOP 2.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!***************************!!
+!! DEDUCE TENDENCIES FOR WRF !!
+!!***************************!!
+RTHBLTEN(ims:ime,kms:kme,jms:jme)=0.
+RUBLTEN(ims:ime,kms:kme,jms:jme)=0.
+RVBLTEN(ims:ime,kms:kme,jms:jme)=0.
+PSFC(ims:ime,jms:jme)=p8w(ims:ime,kms,jms:jme) ! was done in surface driver in regular WRF 
+!------------------------------------------------------------------!
+! WRF adds the physical and dynamical tendencies                   !
+! thus the tendencies must be passed as 'per second' tendencies    !
+! --when physics is not called, the applied physical tendency      !
+! --is the one calculated during the last call to physics          !
+!------------------------------------------------------------------!
+
+! PBL top index reading for MARS_MODE 21 :
+IF (MARS_MODE .EQ. 21) THEN
+      IF (firstcall .EQV. .true.) THEN
+           open(unit=15,file='input_zipbl',form='formatted',status='old')
+           rewind(15)
+           end_of_file = .false.
+           kk = 0
+           do while (.not. end_of_file)
+             read(15,*,end=101) zipbl(kk+1),zilct(kk+1)
+             write(*,*) kk, zipbl(kk+1),zilct(kk+1)
+             kk = kk+1
+             go to 112
+101          end_of_file = .true.
+112          continue
+           enddo
+           close(unit=15,status = 'keep')
+      ENDIF
+      lct=lct_input + elaps/3700.
+      zilctmin=MINVAL(ABS(zilct(:)-lct))
+      lctindex=0
+      DO kk=1,500
+        IF(ABS(zilct(kk)-lct) .eq. zilctmin) lctindex=kk
+      ENDDO
+      IF(lctindex .eq. 0) print*, 'probleme index'
+        IF ((zilct(lctindex) .gt. 12.) .and.( zilct(lctindex) .lt. 18)) THEN
+            ziindex=MAX(0.,zipbl(lctindex)-7.)
+        ELSE
+            ziindex=0.
+        ENDIF
+ENDIF
+
+#ifdef NOPHYS
+!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!
+IF (firstcall .EQV. .true.) THEN
+  ALLOCATE(dtrad(nlayer+1))
+  DO k=kps,kpe+1
+    !! the only solution to avoid 0 points in M_Q2
+    !! -- in each domain decomposition case
+    dtrad(k) = MAXVAL(M_Q2(:,k,:)) + MINVAL(M_Q2(:,k,:))
+  ENDDO
+  print*,"HEATING RATE",dtrad(kps:kpe+1)
+ENDIF
+DO i= 1,ngrid
+  pdt(i,kps:kpe) = dtrad(kps:kpe)
+ENDDO
+!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!
+#endif
+
+DO j = jps,jpe
+DO i = ips,ipe
+subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+!------------!
+! zonal wind !
+!------------!
+RUBLTEN(i,kps:kpe,j) = pdu(subs,kps:kpe)                        
+
+!-----------------!
+! meridional wind !
+!-----------------!
+RVBLTEN(i,kps:kpe,j) = pdv(subs,kps:kpe)                        
+
+!-----------------------!
+! potential temperature !
+!-----------------------!
+! (dT = dtheta * exner for isobaric coordinates or if pressure variations are negligible)
+RTHBLTEN(i,kps:kpe,j) = pdt(subs,kps:kpe) / exner(i,kps:kpe,j)   
+
+!---------------------------!
+! update surface pressure   !
+! (cf CO2 cycle in physics) !
+!---------------------------!
+PSFC(i,j)=PSFC(i,j)+pdpsrf(subs)*dt    !!! here dt is needed
+
+!------------------------------------!
+! Save key variables for restart !  
+!------------------------------------!
+#ifndef NORESTART
+#ifdef SPECIAL_NEST_SAVE
+M_TSOIL(i,:,j)=save_tsoil_restart(subs,:,id)
+M_CO2ICE(i,j)=save_co2ice_restart(subs,id)
+M_Q2(i,kps:kpe+1,j)=save_q2_restart(subs,:,id)
+SELECT CASE (MARS_MODE)
+   CASE (1,11,12)
+     M_H2OICE(i,j)=save_qsurf_restart(subs,2,id)  !! see above Tracer at surface
+END SELECT
+M_TSURF(i,j)=save_tsurf_restart(subs,id)
+#ifdef NEWPHYS
+M_WSTAR(i,j)=save_wstar_restart(subs,id)
+M_FLUXRAD(i,j)=save_fluxrad_restart(subs,id)
+#endif
+#else
+M_TSOIL(i,:,j)=save_tsoil_restart(subs,:)
+M_CO2ICE(i,j)=save_co2ice_restart(subs)
+M_Q2(i,kps:kpe+1,j)=save_q2_restart(subs,:)
+SELECT CASE (MARS_MODE)
+   CASE (1,11,12)
+     M_H2OICE(i,j)=save_qsurf_restart(subs,2)  !! see above Tracer at surface
+END SELECT
+M_TSURF(i,j)=save_tsurf_restart(subs)
+#ifdef NEWPHYS
+M_WSTAR(i,j)=save_wstar_restart(subs)
+M_FLUXRAD(i,j)=save_fluxrad_restart(subs)
+#endif
+#endif
+#endif
+
+!---------!
+! Tracers !  
+!---------!
+#ifndef NOPHYS
+#ifdef NEWPHYS
+SCALAR(i,kps:kpe,j,1)=0.
+
+SELECT CASE (MARS_MODE)
+CASE(0)
+        SCALAR(i,kps:kpe,j,:)=0.
+CASE(20)
+   !! Mars mode 20 : add a passive tracer with radioactive-like decay
+   IF ( (i == ips) .AND. (j == jps) )   print *, 'RADIOACTIVE-LIKE TRACER WITH SOURCE AT SURFACE LAYER.'
+   tau_decay=60.*10. !! why not make it a namelist argument?
+   SCALAR(i,kps:kpe,j,2) = SCALAR(i,kps:kpe,j,2)*exp(-dt/tau_decay)
+   SCALAR(i,1,j,2) = SCALAR(i,1,j,2) + 1. !! this tracer is emitted in the surface layer
+CASE(21)
+   !! Mars mode 21 : add a passive tracer with radioactive-like decay at surface and pbl top
+   IF ( (i == ips) .AND. (j == jps) )   print *, 'RADIOACTIVE-LIKE TRACER WITH SOURCE AT SURFACE LAYER AND PBL TOP.'
+   tau_decay=60.*10. !! why not make it a namelist argument?
+   SCALAR(i,kps:kpe,j,2) = SCALAR(i,kps:kpe,j,2)*exp(-dt/tau_decay)
+   SCALAR(i,kps:kpe,j,3) = SCALAR(i,kps:kpe,j,3)*exp(-dt/tau_decay)
+   SCALAR(i,1,j,2) = SCALAR(i,1,j,2) + 1. !! this tracer is emitted in the surface layer
+   IF ( (i == ips) .AND. (j == jps) )   print *, 'index of pbl emission: ',ziindex
+   IF (ziindex .NE. 0) THEN
+   SCALAR(i,ziindex,j,3) = SCALAR(i,ziindex,j,3) + 1. !! this tracer is emitted at pbl top
+   ENDIF
+CASE DEFAULT
+   SCALAR(i,kps:kpe,j,2:nq+1)=SCALAR(i,kps:kpe,j,2:nq+1)+pdq(subs,kps:kpe,1:nq)*dt  !!! here dt is needed
+END SELECT
+#else
+SELECT CASE (MARS_MODE)
+CASE(0)
+        SCALAR(i,kps:kpe,j,:)=0.
+CASE(1)
+        !!! Water vapor
+        SCALAR(i,kps:kpe,j,2)=SCALAR(i,kps:kpe,j,2)+pdq(subs,kps:kpe,nq)*dt  !!! here dt is needed
+        !!! Water ice
+        SCALAR(i,kps:kpe,j,3)=SCALAR(i,kps:kpe,j,3)+pdq(subs,kps:kpe,nq-1)*dt  !!! here dt is needed
+CASE(2)
+        !!! Dust 
+        SCALAR(i,kps:kpe,j,2)=SCALAR(i,kps:kpe,j,2)+pdq(subs,kps:kpe,nq)*dt  !!! here dt is needed
+CASE(3:)
+        print *, 'OOOPS... not ready yet.'
+        STOP    
+END SELECT
+#endif
+#endif
+        !!TODO: check if adding the whole tendency once, and set the
+        !!TODO: following tendencies to 0 until physics is called again
+        !!TODO: is a good strategy ?
+        !RUBLTEN(i,kps:kpe,j) = pdu(subs,kps:kpe)*ptimestep/dt
+        !RVBLTEN(i,kps:kpe,j) = pdv(subs,kps:kpe)*ptimestep/dt
+        !RTHBLTEN(i,kps:kpe,j) = pdt(subs,kps:kpe)*ptimestep/dt
+        !RTHBLTEN(i,kps:kpe,j) = RTHBLTEN(i,kps:kpe,j)/exner(i,kps:kpe,j) 
+        !PSFC(i,j)=PSFC(i,j)+pdpsrf(subs)*ptimestep/dt      
+        !SELECT CASE (MARS_MODE)
+        !CASE(0)
+        !SCALAR(i,kps:kpe,j,:)=0.
+        !CASE(1)
+        !!!! Water vapor
+        !SCALAR(i,kps:kpe,j,2)=SCALAR(i,kps:kpe,j,2)+pdq(subs,kps:kpe,nq)*ptimestep/dt
+        !!!! Water ice
+        !SCALAR(i,kps:kpe,j,3)=SCALAR(i,kps:kpe,j,3)+pdq(subs,kps:kpe,nq-1)*ptimestep/dt
+        !CASE(2)
+        !!!! Dust 
+        !SCALAR(i,kps:kpe,j,2)=SCALAR(i,kps:kpe,j,2)+pdq(subs,kps:kpe,nq)*ptimestep/dt
+        !END SELECT
+
+ENDDO
+ENDDO
+DEALLOCATE(pdpsrf)
+DEALLOCATE(pdu)
+DEALLOCATE(pdv)
+DEALLOCATE(pdt)
+DEALLOCATE(pdq)
+
+!!---------!
+!! display !
+!!---------!
+!PRINT *, '** Mars ** Results from LMD physics'
+!PRINT *, 'u non-zero tendencies'
+!!PRINT *, 'max',MAXVAL(RUBLTEN, MASK=RUBLTEN/=0.),&
+!!        ' at',MAXLOC(RUBLTEN, MASK=RUBLTEN/=0.)
+!!PRINT *, 'min',MINVAL(RUBLTEN, MASK=RUBLTEN/=0.),&
+!!        ' at',MINLOC(RUBLTEN, MASK=RUBLTEN/=0.)
+!PRINT *, RUBLTEN(10,1,10), RUBLTEN(10,15,10)
+!PRINT *, 'v non-zero tendencies'
+!!PRINT *, 'max',MAXVAL(RVBLTEN, MASK=RVBLTEN/=0.),&
+!!        ' at',MAXLOC(RVBLTEN, MASK=RVBLTEN/=0.)
+!!PRINT *, 'min',MINVAL(RVBLTEN, MASK=RVBLTEN/=0.),&
+!!        ' at',MINLOC(RVBLTEN, MASK=RVBLTEN/=0.)
+!PRINT *, RVBLTEN(10,1,10), RVBLTEN(10,15,10)
+!!! STOP IF CRASH
+!IF (MAXVAL(RUBLTEN, MASK=RUBLTEN/=0.) == 0.) STOP
+!IF (MAXVAL(RVBLTEN, MASK=RVBLTEN/=0.) == 0.) STOP
+
+!!*****!!
+!! END !!
+!!*****!!
+print *,'** Mars ** END LMD PHYSICS'
+!----------------------------------------------------------------!
+! use debug (see solve_em) if you wanna display some message ... !
+!----------------------------------------------------------------!
+END SUBROUTINE lmd_driver
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      real function ls2sol(ls)
+
+!c  Returns solar longitude, Ls (in deg.), from day number (in sol),
+!c  where sol=0=Ls=0 at the northern hemisphere spring equinox
+
+      implicit none
+
+!c  Arguments:
+      real ls
+
+!c  Local:
+      double precision xref,zx0,zteta,zz
+!c	xref: mean anomaly, zteta: true anomaly, zx0: eccentric anomaly
+      double precision year_day 
+      double precision peri_day,timeperi,e_elips
+      double precision pi,degrad 
+      parameter (year_day=668.6d0) ! number of sols in a amartian year
+!c      data peri_day /485.0/
+      parameter (peri_day=485.35d0) ! date (in sols) of perihelion
+!c  timeperi: 2*pi*( 1 - Ls(perihelion)/ 360 ); Ls(perihelion)=250.99
+      parameter (timeperi=1.90258341759902d0)
+      parameter (e_elips=0.0934d0)  ! eccentricity of orbit
+      parameter (pi=3.14159265358979d0)
+      parameter (degrad=57.2957795130823d0)
+
+      if (abs(ls).lt.1.0e-5) then
+         if (ls.ge.0.0) then
+            ls2sol = 0.0
+         else
+            ls2sol = year_day
+         end if
+         return
+      end if
+
+      zteta = ls/degrad + timeperi
+      zx0 = 2.0*datan(dtan(0.5*zteta)/dsqrt((1.+e_elips)/(1.-e_elips)))
+      xref = zx0-e_elips*dsin(zx0)
+      zz = xref/(2.*pi)
+      ls2sol = zz*year_day + peri_day
+      if (ls2sol.lt.0.0) ls2sol = ls2sol + year_day
+      if (ls2sol.ge.year_day) ls2sol = ls2sol - year_day
+
+      return
+      end function ls2sol
+!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+END MODULE module_lmd_driver
Index: trunk/WRF.COMMON/WRFV2/phys/module_lmd_driver.F.new
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_lmd_driver.F.new	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_lmd_driver.F.new	(revision 2744)
@@ -0,0 +1,830 @@
+!*******************************************************************************
+! PURPOSE: LMD_driver is the WRF mediation layer routine that provides the
+! interface to LMD physics packages in the WRF model layer. For those familiar
+! with the LMD GCM, the aim of this driver is to do part of the job of the
+! calfis.F routine.
+!*******************************************************************************
+! AUTHOR: A. Spiga - January 2007
+!*******************************************************************************
+! UPDATES:  - included all final updates for the paper - March 2008
+!           - general cleaning of code and comments - October 2008 
+!           - additions for idealized cases - January 2009
+!           - additions for new soil model in physics - January 2010 
+!           - unified module_lmd_driver: old, new phys and LES - February 2011
+!           - a new paradigm to prepare nested simulations - April 2014
+!           - adapted to new interface philosophy & other planets - August 2016
+!*******************************************************************************
+MODULE module_lmd_driver
+CONTAINS
+    SUBROUTINE lmd_driver(id,max_dom,DT,ITIMESTEP,XLAT,XLONG, &
+        IDS,IDE,JDS,JDE,KDS,KDE,IMS,IME,JMS,JME,KMS,KME, &
+        i_start,i_end,j_start,j_end,kts,kte,num_tiles, &
+        DX,DY, &
+        MSFT,MSFU,MSFV, &
+        GMT,JULYR,JULDAY, &
+        P8W,DZ8W,T8W,Z,HT, &
+        U,V,W,TH,T,P,EXNER,RHO, &
+        PTOP, &
+        RADT,CUDT, &
+        TSK,PSFC, &
+        RTHBLTEN,RUBLTEN,RVBLTEN, &
+        num_3d_s,SCALAR, &
+        num_3d_m,moist, &
+        MARS_MODE, &
+        planet_type, &
+        M_ALBEDO,M_TI,M_CO2ICE,M_EMISS, &
+        M_H2OICE,M_TSOIL,M_Q2,M_TSURF, &
+        M_FLUXRAD,M_WSTAR,M_ISOIL,M_DSOIL,&
+        M_Z0, CST_Z0, M_GW, &
+        NUM_SOIL_LAYERS, &
+        CST_AL, CST_TI, &
+        isfflx, diff_opt, km_opt, &
+        HISTORY_INTERVAL, &
+        HR_SW,HR_LW,HR_DYN,DDT,DT_RAD,DT_VDF,DT_AJS,&
+        CLOUDFRAC,TOTCLOUDFRAC, &
+        GRAIN,GSNOW,REEVAP,SURFRAIN,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+        FLUXSURF_LW,FLXGRD,LSCEZ,H2OICE_REFF,LATENT_HF,SWDOWNZ,&
+        TAU_DUST,RDUST,QSURFDUST,&
+        MTOT,ICETOT,VMR_ICE,TAU_ICE,RICE,&
+        HFMAX,ZMAX,&
+        USTM,HFX,&
+        SLPX,SLPY,RESTART)
+! NB: module_lmd_driver_output1.inc : output arguments generated from Registry
+
+
+
+
+
+!==================================================================
+! USES
+!==================================================================
+   USE module_model_constants
+   USE module_wrf_error
+   !!!!!!!! interface modules
+   USE variables_mod !! to set variables
+   USE update_inputs_physiq_mod !! to set inputs for physiq
+   USE update_outputs_physiq_mod !! to get outputs from physiq
+   USE iniphysiq_mod !! to get iniphysiq subroutine
+   USE callphysiq_mod !! to call the LMD physics
+   !!!!!!!! interface modules
+
+!==================================================================
+  IMPLICIT NONE
+!==================================================================
+
+!==================================================================
+! VARIABLES
+!==================================================================
+
+CHARACTER(len=10),INTENT(IN) :: planet_type
+! WRF Dimensions
+INTEGER, INTENT(IN   )    ::   &
+      ids,ide,jds,jde,kds,kde, &
+      ims,ime,jms,jme,kms,kme, &
+            kts,kte,num_tiles, &
+              NUM_SOIL_LAYERS
+INTEGER, DIMENSION(num_tiles), INTENT(IN) ::  &
+      i_start,i_end,j_start,j_end   
+! Scalars
+INTEGER, INTENT(IN  ) :: JULDAY, itimestep, julyr,id,max_dom,MARS_MODE
+INTEGER, INTENT(IN  ) :: isfflx,diff_opt,km_opt
+REAL, INTENT(IN  ) :: GMT,dt,dx,dy,RADT,CUDT
+REAL, INTENT(IN  ) :: CST_AL, CST_TI 
+REAL, INTENT(IN  ) :: PTOP
+INTEGER, INTENT(IN   ) :: HISTORY_INTERVAL
+! 2D arrays          
+REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+     MSFT,MSFU,MSFV, &
+     XLAT,XLONG,HT,  &
+     M_ALBEDO,M_TI,M_EMISS, &
+     SLPX,SLPY, &
+     M_CO2ICE,M_H2OICE, &
+     M_TSURF, M_Z0, &
+     M_FLUXRAD,M_WSTAR, &
+     PSFC,TSK
+REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: &
+     SWDOWNZ,&
+     TAU_DUST,QSURFDUST,&
+     MTOT,ICETOT,TAU_ICE,&
+     HFMAX,ZMAX,&
+     USTM,HFX,TOTCLOUDFRAC,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+     FLUXSURF_LW,FLXGRD,LATENT_HF,REEVAP,SURFRAIN
+! 3D arrays 
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: &
+     dz8w,p8w,p,exner,t,t8w,rho,u,v,w,z,th
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(OUT ) :: &
+     RTHBLTEN,RUBLTEN,RVBLTEN, &
+     HR_SW,HR_LW,HR_DYN,DDT,DT_RAD,DT_VDF,DT_AJS,RDUST,VMR_ICE,RICE,&
+     CLOUDFRAC,GRAIN,GSNOW,LSCEZ,H2OICE_REFF
+REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT ) :: &
+     M_Q2
+REAL, DIMENSION( ims:ime, NUM_SOIL_LAYERS, jms:jme ), INTENT(INOUT )  :: &
+     M_TSOIL,M_ISOIL, M_DSOIL 
+REAL, INTENT(IN  ) :: CST_Z0
+REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: &
+     M_GW
+! 4D arrays
+INTEGER, INTENT(IN ) :: num_3d_s,num_3d_m
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_3d_s ), INTENT(INOUT ) :: scalar
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_3d_m ), INTENT(INOUT ) ::  moist
+! Logical
+LOGICAL, INTENT(IN ) :: restart
+
+!-------------------------------------------   
+! LOCAL  VARIABLES
+!-------------------------------------------
+   INTEGER ::    i,j,k,its,ite,jts,jte,ij,kk
+   INTEGER ::    subs,iii
+   
+
+   ! *** for tracer Mode 20 ***
+   REAL ::    tau_decay
+   ! *** ----------------------- ***
+
+   ! *** for LMD physics
+   ! ------> inputs:
+   INTEGER :: ngrid,nlayer,nq,nsoil 
+   REAL :: MY  
+   REAL :: phisfi_val
+   LOGICAL :: firstcall,lastcall
+   ! ----------	
+
+   ! <------ outputs:
+   !     physical tendencies
+   REAL*8,DIMENSION(:,:),ALLOCATABLE :: pdtheta
+   ! ... intermediate arrays
+   REAL, DIMENSION(:), ALLOCATABLE  :: &
+     dz8w_prof,p8w_prof,p_prof,t_prof,t8w_prof, &
+     u_prof,v_prof,z_prof
+   REAL, DIMENSION(:,:), ALLOCATABLE :: q_prof
+
+   ! Additional control variables
+   INTEGER :: sponge_top,relax,ips,ipe,jps,jpe,kps,kpe
+   REAL :: elaps
+   INTEGER :: test
+   REAL :: wappel_phys
+   LOGICAL, SAVE :: flag_first_restart
+   INTEGER, SAVE :: previous_id = 0
+!**************************************************
+! IMPORTANT: pour travailler avec grid nesting
+! --- deux comportements distincts du save
+! ... ex1: ferme planeto avec PGF+MPI: standard
+! ... ex2: iDataPlex avec IFORT+MPI: SPECIAL_NEST_SAVE 
+!**************************************************
+#ifdef SPECIAL_NEST_SAVE
+      !  une dimension supplementaire liee au nest
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             dp_save
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: &
+             du_save, dv_save, dt_save,dtheta_save
+      REAL, DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: &
+             dq_save      
+#else
+      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: &
+             dp_save
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             du_save, dv_save, dt_save,dtheta_save
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: &
+             dq_save      
+#endif
+
+!!!IDEALIZED IDEALIZED
+      REAL :: lat_input, lon_input, ls_input, lct_input
+      LOGICAL :: isles
+!!!IDEALIZED IDEALIZED
+
+   REAL :: tk1,tk2
+
+!==================================================================
+! CODE
+!==================================================================
+
+print *, '** ',planet_type,'** ENTER WRF-LMD DRIVER'
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! determine here if this is turbulence-resolving or not
+IF (JULYR .ne. 9999) THEN
+    isles = .false.  ! "True" LES is not available in this version
+    PRINT *, '*** REAL-CASE SIMULATION ***'
+ELSE
+     PRINT *, '*** IDEALIZED SIMULATION ***'
+     IF ((diff_opt .eq. 2) .and. (km_opt .eq. 2)) THEN
+          PRINT *, '*** type: LES ***'
+          PRINT *, '*** diff_opt = 2 *** km_opt = 2'
+          PRINT *, '*** forcing is isfflx = ',isfflx 
+          isles = .true.
+          !! SPECIAL LES
+     ELSE
+          PRINT *, '*** type: not LES ***'
+          PRINT *, '*** diff_opt = ',diff_opt
+          PRINT *, '*** km_opt = ',km_opt
+          isles = .false.
+          !! IDEALIZED, no LES
+          !! cependant, ne veut-on pas pouvoir
+          !! prescrire un flux en idealise ??
+     ENDIF
+ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!-------------------------!
+! TWEAK on WRF DIMENSIONS !
+!-------------------------!
+its = i_start(1)   ! define here one big tile
+ite = i_end(num_tiles)
+jts = j_start(1)
+jte = j_end(num_tiles)
+!!
+IF (isles .eqv. .false.) THEN
+ relax=0
+ sponge_top=0               ! another value than 0 triggers instabilities  
+ IF (id .gt. 1) relax=2     ! fix to avoid noise in nesting simulations ; 1 >> too much noise ...
+ENDIF
+ips=its
+ipe=ite
+jps=jts
+jpe=jte
+IF (isles .eqv. .false.) THEN
+ IF (ips .eq. ids)   ips=its+relax !! IF tests necesary for parallel runs
+ IF (ipe .eq. ide-1) ipe=ite-relax
+ IF (jps .eq. jds)   jps=jts+relax
+ IF (jpe .eq. jde-1) jpe=jte-relax
+ENDIF
+kps=kts         !! start at surface 
+IF (isles .eqv. .false.) THEN
+ kpe=kte-sponge_top
+ELSE
+ PRINT *, '*** IDEALIZED SIMULATION: LES *** kpe=kte'
+ kpe=kte !-sponge_top
+ENDIF
+
+!----------------------------!
+! DIMENSIONS FOR THE PHYSICS !
+!----------------------------!
+!day_ini = JULDAY - 1      !! GCM convention  !! pday at firstcall is day_ini
+wappel_phys = RADT
+zdt_split = dt*wappel_phys            ! physical timestep (s)
+ptopwrf = ptop                        ! top pressure in WRF coordinates (in variables_mod)
+ngrid=(ipe-ips+1)*(jpe-jps+1)         ! size of the horizontal grid
+nlayer = kpe-kps+1                    ! number of vertical layers: nlayermx
+nsoil = NUM_SOIL_LAYERS               ! number of soil layers: nsoilmx
+if (num_3d_s > 1) then                ! number of advected fields
+        nq = num_3d_s-1               
+else
+        nq = 1
+endif
+! **** needed but hardcoded
+lastcall = .false.
+! **** needed but hardcoded
+
+          !PRINT *, ips, ipe, jps, jpe
+          !PRINT *, ngrid
+
+elaps = (float(itimestep)-1.)*dt  ! elapsed seconds of simulation
+!----------------------------------------------!
+! what is done at the first step of simulation !
+!----------------------------------------------!
+IF (elaps .eq. 0.) THEN
+   flag_first_restart = .false.
+ELSE
+   flag_first_restart=flag_first_restart.OR.(.NOT. ALLOCATED(dp_save))
+ENDIF
+
+is_first_step: IF ((elaps .eq. 0.).or.flag_first_restart) THEN
+firstcall=.true.  !! for continuity with GCM, physics are always called at the first WRF timestep
+  !firstcall=.false. !! just in case you'd want to get rid of the physics 
+test=0
+#ifdef SPECIAL_NEST_SAVE
+PRINT *, 'ALLOCATED dp_save ???', ALLOCATED( dp_save ), id
+IF( .NOT. ALLOCATED( dp_save  ) ) THEN
+   PRINT *, '**** check **** OK I ALLOCATE one save ARRAY for all NESTS ', max_dom, id
+   !! here are the arrays that would be useful to save physics tendencies
+   ALLOCATE(dp_save(ngrid,max_dom))
+   ALLOCATE(du_save(ngrid,nlayer,max_dom))
+   ALLOCATE(dv_save(ngrid,nlayer,max_dom))
+   ALLOCATE(dt_save(ngrid,nlayer,max_dom))
+   ALLOCATE(dtheta_save(ngrid,nlayer,max_dom))
+   ALLOCATE(dq_save(ngrid,nlayer,nq,max_dom))
+   dp_save(:,:)=0.    !! initialize these arrays ...
+   du_save(:,:,:)=0.
+   dv_save(:,:,:)=0.
+   dt_save(:,:,:)=0.
+   dtheta_save(:,:,:)=0.
+   dq_save(:,:,:,:)=0.
+ENDIF
+IF (id .lt. max_dom) THEN
+   flag_first_restart=.true.
+ELSE
+   flag_first_restart=.false.
+ENDIF
+#else
+IF( .NOT. ALLOCATED( dp_save  ) ) THEN
+ALLOCATE(dp_save(ngrid)) !! here are the arrays that would be useful to save physics tendencies
+ALLOCATE(du_save(ngrid,nlayer))
+ALLOCATE(dv_save(ngrid,nlayer))
+ALLOCATE(dt_save(ngrid,nlayer))
+ALLOCATE(dtheta_save(ngrid,nlayer))
+ALLOCATE(dq_save(ngrid,nlayer,nq))
+ENDIF
+dp_save(:)=0.    !! initialize these arrays ...
+du_save(:,:)=0.
+dv_save(:,:)=0.
+dt_save(:,:)=0.
+dtheta_save(:,:)=0.
+dq_save(:,:,:)=0.
+flag_first_restart=.false.
+#endif
+ELSE
+!-------------------------------------------------!
+! what is done for the other steps of simulation  !
+!-------------------------------------------------!
+IF (wappel_phys .gt. 0.) THEN
+firstcall = .false.
+test = MODULO(itimestep-1,int(wappel_phys)) ! WRF time is integrated time (itimestep=1 at the end of first step) 
+                                            ! -- same strategy as diagfi in the LMD GCM 
+                                            ! -- arguments of modulo must be of the same kind (here: integers)
+ELSE
+firstcall = .false.
+test = 9999   
+ENDIF
+ENDIF is_first_step
+
+!------------------------------------!
+! print info about domain initially  !
+! ... and whenever domain is changed !
+!------------------------------------!
+print *,'** ',planet_type,' ** DOMAIN',id
+IF (previous_id .ne. id) THEN
+    print *, '** ',planet_type,' ** ... INITIALIZE DOMAIN',id
+    print *, '** ',planet_type,' ** ... PREVIOUS DOMAIN was',previous_id
+    print *, 'ITIMESTEP: ',itimestep
+    print *, 'TILES: ', i_start,i_end, j_start, j_end  ! numbers for simple runs, arrays for parallel runs
+    print *, 'DOMAIN: ', ids, ide, jds, jde
+    print *, 'MEMORY: ', ims, ime, jms, jme
+    print *, 'COMPUT: ', ips, ipe, jps, jpe
+    print *, 'SIZE OF PHYSICS GRID for this process: ',ngrid
+    print *, 'ADVECTED TRACERS: ', num_3d_s-1
+    print *, 'PHYSICS IS CALLED EACH...',wappel_phys
+    print *, '-- means: PHYSICAL TIMESTEP=',zdt_split
+ENDIF
+
+
+!!!***********!!
+!!! IDEALIZED !!
+!!!***********!!
+IF (JULYR .eq. 9999) THEN
+  PRINT *,'** ',planet_type,'** IDEALIZED SIMULATION'
+  PRINT *,'** ',planet_type,'** BEWARE: input_coord must be here'
+  open(unit=14,file='input_coord',form='formatted',status='old')
+  rewind(14)
+  read(14,*) lon_input
+  read(14,*) lat_input
+  read(14,*) ls_input
+  read(14,*) lct_input
+  close(14)
+ENDIF
+
+!----------!
+! ALLOCATE !
+!----------!
+CALL allocate_interface(ngrid,nlayer,nq)
+ALLOCATE(pdtheta(ngrid,nlayer))
+!!!
+!!! BIG LOOP : 1. no call for physics, used saved values
+!!!
+IF (test.NE.0) THEN
+print *,'** ',planet_type,'** NO CALL FOR PHYSICS, go to next step...',test
+#ifdef SPECIAL_NEST_SAVE
+zdpsrf_omp(:)=dp_save(:,id)
+zdufi_omp(:,:)=du_save(:,:,id)
+zdvfi_omp(:,:)=dv_save(:,:,id)
+zdtfi_omp(:,:)=dt_save(:,:,id)
+pdtheta(:,:)=dtheta_save(:,:,id)
+zdqfi_omp(:,:,:)=dq_save(:,:,:,id)
+#else
+print*,'else'
+zdpsrf_omp(:)=dp_save(:)
+zdufi_omp(:,:)=du_save(:,:)
+zdvfi_omp(:,:)=dv_save(:,:)
+zdtfi_omp(:,:)=dt_save(:,:)
+pdtheta(:,:)=dtheta_save(:,:)
+zdqfi_omp(:,:,:)=dq_save(:,:,:)
+#endif
+!!!
+!!! BIG LOOP : 2. calculate physical tendencies
+!!!
+ELSE
+!----------!
+! ALLOCATE !
+!----------!
+! interm
+ALLOCATE(dz8w_prof(nlayer))
+ALLOCATE(p8w_prof(nlayer))
+ALLOCATE(p_prof(nlayer))
+ALLOCATE(t_prof(nlayer))
+ALLOCATE(t8w_prof(nlayer))
+ALLOCATE(u_prof(nlayer))
+ALLOCATE(v_prof(nlayer))
+ALLOCATE(z_prof(nlayer))
+ALLOCATE(q_prof(nlayer,nq))
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! PREPARE PHYSICS INPUTS !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! INITIALIZE AND ALLOCATE EVERYTHING !! here, only firstcall
+allocation_firstcall: IF (firstcall .EQV. .true.) THEN
+  !! tracers' name
+  PRINT *,'** ',planet_type,'** TRACERS NAMES'
+  CALL update_inputs_physiq_tracers(nq,MARS_MODE)
+  !! PHYSICS VARIABLES (cf. iniphysiq in LMD GCM)
+  !! parameters are defined in the module_model_constants.F WRF routine
+  PRINT *,'** ',planet_type,'** INITIALIZE ARRAYS FOR PHYSICS'
+  !! need to get initial time first
+  CALL update_inputs_physiq_time(&
+            JULYR,JULDAY,GMT,&
+            elaps,&
+            lct_input,lon_input,ls_input,&
+            MY)
+  !! Set up initial time
+  phour_ini = JH_cur_split
+  !! Fill planetary parameters in modules
+  !! Values defined in the module_model_constants.F WRF routine
+  CALL update_inputs_physiq_constants
+  !! Initialize physics
+  CALL iniphysiq(ngrid,nlayer,nq,wappel_phys,&
+                     wdaysec,floor(JD_cur), &
+                     1./reradius,g,r_d,cp,1)
+                     
+                     
+ENDIF allocation_firstcall
+
+!!*****************************!!
+!! PREPARE "FOOD" FOR PHYSIQ.F !!
+!!*****************************!!
+
+DO j = jps,jpe
+DO i = ips,ipe
+
+!!*******************************************!!
+!! FROM 3D WRF FIELDS TO 1D PHYSICS PROFILES !!
+!!*******************************************!!
+
+!-----------------------------------!
+! 1D subscript for physics "cursor" !
+!-----------------------------------!
+subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+  
+!--------------------------------------!
+! 1D columns : inputs for the physics  !
+! ... vert. coord., meteor. fields ... !
+!--------------------------------------!
+dz8w_prof(:) = dz8w(i,kps:kpe,j)   ! dz between full levels (m)   
+p8w_prof(:) = p8w(i,kps:kpe,j)     ! pressure full level (Pa) >> zplev_omp
+p_prof(:) = p(i,kps:kpe,j)         ! pressure half level (Pa) >> zplay_omp
+t_prof(:) = t(i,kps:kpe,j)         ! temperature half level (K) >> pt
+t8w_prof(:) = t8w(i,kps:kpe,j)     ! temperature full level (K)
+u_prof(:) = u(i,kps:kpe,j)         ! zonal wind (A-grid: unstaggered) half level (m/s) >> zufi_omp  
+v_prof(:) = v(i,kps:kpe,j)         ! meridional wind (A-grid: unstaggered) half level (m/s) >> pv
+z_prof(:) = z(i,kps:kpe,j)         ! geopotential height half level (m) >> zphi_omp/g
+
+!--------------------------------!
+! specific treatment for tracers !
+!--------------------------------!
+IF (MARS_MODE .EQ. 0) THEN
+    q_prof(:,1)=0.95
+ELSE IF (MARS_MODE .EQ. 42) THEN
+    q_prof(:,1) = moist(i,kps:kpe,j,P_QV) !! the names were set above !! one dummy tracer in WRF
+    q_prof(:,2) = SCALAR(i,kps:kpe,j,3) !! the names were set above !! one dummy tracer in WRF  
+ELSE
+    q_prof(:,1:nq) = SCALAR(i,kps:kpe,j,2:nq+1)  !! the names were set above !! one dummy tracer in WRF
+ENDIF
+
+IF (MARS_MODE .EQ. 20) THEN
+  IF (firstcall .EQV. .true. .and. (.not. restart)) THEN
+      q_prof(:,:) = 0.95
+  ENDIF
+ENDIF
+
+IF (MARS_MODE .EQ. 32) THEN
+  IF (firstcall .EQV. .true. .and. (.not. restart)) THEN
+      q_prof(:,7) = 0.95
+!! traceurs(7)   = 'co2'
+  ENDIF
+ENDIF
+
+IF (firstcall .EQV. .true.) THEN
+  !-----------------!
+  ! Optional output !
+  !-----------------!
+  IF ( (i == ips) .AND. (j == jps) ) THEN
+  PRINT *,'z_prof ',z_prof
+  PRINT *,'dz8w_prof',dz8w_prof
+  PRINT *,'p8w_prof ',p8w_prof
+  PRINT *,'p_prof ',p_prof
+  PRINT *,'t_prof ',t_prof
+  PRINT *,'t8w_prof ',t8w_prof
+  PRINT *,'u_prof ',u_prof
+  PRINT *,'v_prof ',v_prof
+  PRINT *,'q_prof ',q_prof
+  ENDIF
+ENDIF
+
+!---------------------------------------------!
+! in LMD physics, geopotential must be        !
+! expressed with respect to the local surface !
+!---------------------------------------------!
+zphi_omp(subs,:) = g*( z_prof(:)-(z_prof(1)-dz8w_prof(1)/2.) )
+
+!--------------------------------!
+! Dynamic fields for LMD physics !
+!--------------------------------!
+zplev_omp(subs,1:nlayer) = p8w_prof(1:nlayer)  !! NB: last level: no data
+zplay_omp(subs,:) = p_prof(:)
+ztfi_omp(subs,:) = t_prof(:)
+zufi_omp(subs,:) = u_prof(:)
+zvfi_omp(subs,:) = v_prof(:)
+flxwfi_omp(subs,:) = 0   !! NB: not used in the physics, only diagnostic...
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! for IDEALIZED CASES ONLY
+IF (JULYR .eq. 9999) zplev_omp(subs,nlayer+1)=0.  !! zplev_omp(subs,nlayer+1)=ptop >> NO !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! NOTE:
+! IF ( zplev_omp(subs,nlayer+1) .le. 0 ) zplev_omp(subs,nlayer+1)=ptop
+! cree des diagnostics delirants et aleatoires dans le transfert radiatif 
+
+!---------!
+! Tracers !  
+!---------!
+zqfi_omp(subs,:,:) = q_prof(:,:)  !! traceurs generiques, seuls noms sont specifiques
+
+ENDDO
+ENDDO
+
+!---------------------------------------------------------!
+! Ground geopotential                                     !
+! (=g*HT(i,j), only used in the microphysics: newcondens) !
+!---------------------------------------------------------! 
+phisfi_val=g*(z_prof(1)-dz8w_prof(1)/2.)   !! NB: z_prof are half levels, so z_prof(1) is not the surface
+
+!!*****************!!
+!! CLEAN THE PLACE !!
+!!*****************!!
+DEALLOCATE(dz8w_prof)
+DEALLOCATE(z_prof)
+DEALLOCATE(p8w_prof)
+DEALLOCATE(p_prof)
+DEALLOCATE(t_prof)
+DEALLOCATE(t8w_prof)
+DEALLOCATE(u_prof)
+DEALLOCATE(v_prof)
+DEALLOCATE(q_prof)
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! ONE DOMAIN CASE
+!!! --> we simply need to initialize static and physics inputs
+!!! SEVERAL DOMAINS
+!!! --> we update static and physics inputs each time
+!!!     to account for domain change 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+pass_interface: IF ( (firstcall .EQV. .true.) .or. (max_dom .GT. 1) ) THEN
+PRINT *,'** ',planet_type,'** PASS INTERFACE. EITHER FIRSTCALL or NESTED SIMULATION.'
+!!*******************************************!!
+!!*******************************************!!
+CALL update_inputs_physiq_geom( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,ngrid,nlayer,&
+            DX,DY,MSFT,&
+            lat_input, lon_input,&
+            XLAT,XLONG)
+!!!
+CALL update_inputs_physiq_slope( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,&
+            SLPX,SLPY)
+!!!
+CALL update_inputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,nsoil,&
+            M_TI,CST_TI,&
+            M_ISOIL,M_DSOIL,&
+            M_TSOIL,M_TSURF)
+!!!
+CALL update_inputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            JULYR,MARS_MODE,&
+            M_ALBEDO,CST_AL,&
+            M_TSURF,M_EMISS,M_CO2ICE,&
+            M_GW,M_Z0,CST_Z0,&
+            M_H2OICE,&
+            phisfi_val)
+!!!
+CALL update_inputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,&
+            RESTART,isles,&
+            M_Q2,M_WSTAR)
+!!!
+CALL update_inputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            RESTART,&
+            M_FLUXRAD)
+!!!
+ENDIF pass_interface
+!!*******************************************!!
+!!*******************************************!!
+
+!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!
+!! CALL LMD PHYSICS !!  
+!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!
+
+call_physics : IF (wappel_phys .ne. 0.) THEN
+!!! initialize tendencies (security)
+zdpsrf_omp(:)=0.
+zdufi_omp(:,:)=0.
+zdvfi_omp(:,:)=0.
+zdtfi_omp(:,:)=0.
+pdtheta(:,:)=0.
+zdqfi_omp(:,:,:)=0.
+print *, '** ',planet_type,'** CALL TO LMD PHYSICS'
+!!!
+CALL update_inputs_physiq_time(&
+            JULYR,JULDAY,GMT,&
+            elaps,&
+            lct_input,lon_input,ls_input,&
+            MY)
+!!!
+CALL call_physiq(planet_type,ngrid,nlayer,nq,       &
+                       firstcall,lastcall)
+!!!
+
+!! specific scenario. necessary to add the right amount of dust.
+#ifdef DUSTSTORM
+IF (firstcall .EQV. .true.) THEN
+  zdqfi_omp(:,:,:) = zdqfi_omp(:,:,:) / dt
+ENDIF
+#endif
+
+IF (planet_type .eq. "venus" ) THEN
+  DO j=jps,jpe
+  DO i=ips,ipe
+    do k=kps,kpe
+      subs=(j-jps)*(ipe-ips+1)+(i-ips+1)
+      tk1=(ztfi_omp(subs,k)**nu + nu*TT00**nu*log((p1000mb/zplay_omp(subs,k))**rcp))**(1/nu)
+      tk2=((ztfi_omp(subs,k) + zdtfi_omp(subs,k))**nu + nu*TT00**nu*log((p1000mb/zplay_omp(subs,k))**rcp))**(1/nu)
+      pdtheta(subs,k)=tk2-tk1
+    enddo
+  ENDDO
+  ENDDO
+ENDIF
+
+print *, '** ',planet_type,'** CALL TO LMD PHYSICS DONE'
+
+!---------------------------------------------------------------------------------!
+! PHYSIQ TENDENCIES ARE SAVED TO BE SPLIT WITHIN INTERMEDIATE DYNAMICAL TIMESTEPS !
+!---------------------------------------------------------------------------------!
+#ifdef SPECIAL_NEST_SAVE
+dp_save(:,id)=zdpsrf_omp(:)
+du_save(:,:,id)=zdufi_omp(:,:)
+dv_save(:,:,id)=zdvfi_omp(:,:)
+dt_save(:,:,id)=zdtfi_omp(:,:)
+dtheta_save(:,:,id)=pdtheta(:,:)
+dq_save(:,:,:,id)=zdqfi_omp(:,:,:)
+#else
+dp_save(:)=zdpsrf_omp(:)
+du_save(:,:)=zdufi_omp(:,:)
+dv_save(:,:)=zdvfi_omp(:,:)
+dt_save(:,:)=zdtfi_omp(:,:)
+dtheta_save(:,:)=pdtheta(:,:)
+dq_save(:,:,:)=zdqfi_omp(:,:,:)
+#endif
+
+!! OUTPUT OUTPUT OUTPUT
+!-------------------------------------------------------!
+! Save key variables for restart and output and nesting !  
+!-------------------------------------------------------!
+!!!
+CALL update_outputs_physiq_surf( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            MARS_MODE,&
+            M_TSURF,M_CO2ICE,&
+            M_H2OICE)
+!!!
+CALL update_outputs_physiq_soil( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            nsoil,&
+            M_TSOIL)
+!!!
+CALL update_outputs_physiq_rad( &
+            ims,ime,jms,jme,&
+            ips,ipe,jps,jpe,&
+            M_FLUXRAD)
+!!!
+CALL update_outputs_physiq_turb( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            M_Q2,M_WSTAR,&
+            HFMAX,ZMAX,USTM,HFX)
+!!!
+CALL update_outputs_physiq_diag( &
+            ims,ime,jms,jme,kms,kme,&
+            ips,ipe,jps,jpe,kps,kpe,&
+            SWDOWNZ,TAU_DUST,QSURFDUST,&
+            MTOT,ICETOT,TAU_ICE,&
+            HR_SW,HR_LW,HR_DYN,DDT,DT_RAD,&
+            RDUST,VMR_ICE,RICE,&
+            CLOUDFRAC,TOTCLOUDFRAC,&
+            GRAIN,GSNOW,REEVAP,SURFRAIN,&
+            ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
+            FLUXSURF_LW,FLXGRD,LSCEZ,H2OICE_REFF,LATENT_HF)
+!!!
+print *, '** ',planet_type,'** OUTPUT PHYSICS DONE'
+
+ENDIF call_physics
+
+ENDIF    ! end of BIG LOOP 2.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!***************************!!
+!! DEDUCE TENDENCIES FOR WRF !!
+!!***************************!!
+RTHBLTEN(ims:ime,kms:kme,jms:jme)=0.
+RUBLTEN(ims:ime,kms:kme,jms:jme)=0.
+RVBLTEN(ims:ime,kms:kme,jms:jme)=0.
+PSFC(ims:ime,jms:jme)=p8w(ims:ime,kms,jms:jme) ! was done in surface driver in regular WRF 
+!------------------------------------------------------------------!
+! WRF adds the physical and dynamical tendencies                   !
+! thus the tendencies must be passed as 'per second' tendencies    !
+! --when physics is not called, the applied physical tendency      !
+! --is the one calculated during the last call to physics          !
+!------------------------------------------------------------------!
+!print*,'pdt',pdt(1,1),pdt(1,nlayer)
+!print*,'exner',exner(1,:,1)
+DO j = jps,jpe
+DO i = ips,ipe
+
+  subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+    ! zonal wind
+  RUBLTEN(i,kps:kpe,j) = zdufi_omp(subs,kps:kpe) 
+    ! meridional wind
+  RVBLTEN(i,kps:kpe,j) = zdvfi_omp(subs,kps:kpe) 
+    ! potential temperature
+    ! (dT = dtheta * exner for isobaric coordinates or if pressure variations are negligible)
+  IF (planet_type .eq. "venus" ) THEN
+    RTHBLTEN(i,kps:kpe,j) = pdtheta(subs,kps:kpe)
+  ELSE
+    RTHBLTEN(i,kps:kpe,j) = zdtfi_omp(subs,kps:kpe) / exner(i,kps:kpe,j)
+  ENDIF
+    ! update surface pressure (cf CO2 cycle in physics)
+    ! here dt is needed
+  PSFC(i,j)=PSFC(i,j)+zdpsrf_omp(subs)*dt 
+    ! tracers
+  SCALAR(i,kps:kpe,j,1)=0.
+  SELECT CASE (MARS_MODE)
+    CASE(0)
+      SCALAR(i,kps:kpe,j,:)=0.
+    CASE(20)
+      !! tracer mode 20 : add a passive tracer with radioactive-like decay
+      IF ( (i == ips) .AND. (j == jps) )   print *, 'RADIOACTIVE-LIKE TRACER WITH SOURCE AT SURFACE LAYER.'
+      tau_decay=60.*10. !! why not make it a namelist argument?
+      SCALAR(i,kps:kpe,j,2) = SCALAR(i,kps:kpe,j,2)*exp(-dt/tau_decay)
+      SCALAR(i,1,j,2) = SCALAR(i,1,j,2) + 1. !! this tracer is emitted in the surface layer
+    CASE(42)
+      moist(i,kps:kpe,j,P_QV)=moist(i,kps:kpe,j,P_QV)+zdqfi_omp(subs,kps:kpe,1)*dt  !!! here dt is needed
+      scalar(i,kps:kpe,j,3)=scalar(i,kps:kpe,j,3)+zdqfi_omp(subs,kps:kpe,2)*dt  !!! here dt is needed
+    CASE DEFAULT
+      SCALAR(i,kps:kpe,j,2:nq+1)=SCALAR(i,kps:kpe,j,2:nq+1)+zdqfi_omp(subs,kps:kpe,1:nq)*dt !!! here dt is needed
+  END SELECT
+
+ENDDO
+ENDDO
+CALL deallocate_interface
+DEALLOCATE(pdtheta)
+!!*****!!
+!! END !!
+!!*****!!
+print *,'** ',planet_type,'** END LMD PHYSICS'
+previous_id = id
+!----------------------------------------------------------------!
+! use debug (see solve_em) if you wanna display some message ... !
+!----------------------------------------------------------------!
+END SUBROUTINE lmd_driver
+
+END MODULE module_lmd_driver
Index: trunk/WRF.COMMON/WRFV2/phys/module_microphysics_driver.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_microphysics_driver.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_microphysics_driver.F	(revision 2744)
@@ -0,0 +1,564 @@
+!WRF:MEDIATION_LAYER:PHYSICS
+! *** add new modules of schemes here
+!
+MODULE module_microphysics_driver
+CONTAINS
+
+SUBROUTINE microphysics_driver(                                          &
+                       th, rho, pi_phy, p                                &
+                      ,ht, dz8w, p8w, dt,dx,dy                           &
+                      ,mp_physics, spec_zone                             &
+                      ,specified, channel_switch                         &
+                      ,warm_rain                                         &
+                      ,xland,itimestep                                   &
+                      ,f_ice_phy,f_rain_phy,f_rimef_phy                  &
+                      ,lowlyr,sr                                         &
+                      ,ids,ide, jds,jde, kds,kde                         &
+                      ,ims,ime, jms,jme, kms,kme                         &
+                      ,i_start,i_end,j_start,j_end,kts,kte,num_tiles     &
+                      ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr   &
+                      ,qni_curr                                          &
+                      ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qni               &
+                      ,qt_curr,f_qt                                      &
+                      ,mp_restart_state,tbpvs_state,tbpvs0_state         & ! for etampnew
+                      ,w ,z                                              &
+                      ,rainnc, rainncv                                   &
+                      ,snownc, snowncv                                   &
+                      ,graupelnc, graupelncv                             &
+                                                                         )
+! Framework
+   USE module_state_description, ONLY :                                  &
+                     KESSLERSCHEME, LINSCHEME, WSM3SCHEME, WSM5SCHEME    &
+                    ,WSM6SCHEME, ETAMPNEW, NCEPCLOUD3, NCEPCLOUD5, THOMPSON
+
+
+! Model Layer
+   USE module_model_constants
+   USE module_wrf_error
+
+! *** add new modules of schemes here
+
+   USE module_mp_kessler
+   USE module_mp_lin
+   USE module_mp_ncloud3
+   USE module_mp_ncloud5
+   USE module_mp_wsm3
+   USE module_mp_wsm5
+   USE module_mp_wsm6
+   USE module_mp_etanew
+   USE module_mp_thompson
+    
+!----------------------------------------------------------------------
+   ! This driver calls subroutines for the microphys.
+   !
+   ! Schemes
+   !
+   ! Kessler scheme
+   ! Lin et al. (1983), Rutledge and Hobbs (1984)
+   ! WRF Single-Moment 3-class, Hong, Dudhia and Chen (2004)
+   ! WRF Single-Moment 5-class, Hong, Dudhia and Chen (2004)
+   ! WRF Single-Moment 6-class, Lim and Hong (2003 WRF workshop)
+   ! Eta Grid-scale Cloud and Precipitation scheme (EGCP01, Ferrier)
+   ! NCEP cloud3, Hong et al. (1998) with some mod, Dudhia (1989)
+   ! NCEP cloud5, Hong et al. (1998) with some mod, Rutledge and Hobbs (1984)
+   ! 
+!----------------------------------------------------------------------
+   IMPLICIT NONE
+!======================================================================
+! Grid structure in physics part of WRF
+!----------------------------------------------------------------------  
+! The horizontal velocities used in the physics are unstaggered
+! relative to temperature/moisture variables. All predicted
+! variables are carried at half levels except w, which is at full
+! levels. Some arrays with names (*8w) are at w (full) levels.
+!
+!----------------------------------------------------------------------  
+! In WRF, kms (smallest number) is the bottom level and kme (largest 
+! number) is the top level.  In your scheme, if 1 is at the top level, 
+! then you have to reverse the order in the k direction.
+!                 
+!         kme      -   half level (no data at this level)
+!         kme    ----- full level
+!         kme-1    -   half level
+!         kme-1  ----- full level
+!         .
+!         .
+!         .
+!         kms+2    -   half level
+!         kms+2  ----- full level
+!         kms+1    -   half level
+!         kms+1  ----- full level
+!         kms      -   half level
+!         kms    ----- full level
+!
+!======================================================================
+! Definitions
+!-----------
+! Rho_d      dry density (kg/m^3)
+! Theta_m    moist potential temperature (K)
+! Qv         water vapor mixing ratio (kg/kg)
+! Qc         cloud water mixing ratio (kg/kg)
+! Qr         rain water mixing ratio (kg/kg)
+! Qi         cloud ice mixing ratio (kg/kg)
+! Qs         snow mixing ratio (kg/kg)
+! Qni        cloud ice number concentration (#/kg)
+!
+!----------------------------------------------------------------------
+!-- th        potential temperature    (K)
+!-- moist_new     updated moisture array   (kg/kg)
+!-- moist_old     Old moisture array       (kg/kg)
+!-- rho           density of air           (kg/m^3)
+!-- pi_phy        exner function           (dimensionless)
+!-- p             pressure                 (Pa)
+!-- RAINNC        grid scale precipitation (mm)
+!-- RAINNCV       one time step grid scale precipitation (mm/step)
+!-- SNOWNC        grid scale snow and ice (mm)
+!-- SNOWNCV       one time step grid scale snow and ice (mm/step)
+!-- GRAUPELNC     grid scale graupel (mm)
+!-- GRAUPELNCV    one time step grid scale graupel (mm/step)
+!-- SR            one time step mass ratio of snow to total precip
+!-- z             Height above sea level   (m)
+!-- dt            Time step              (s)
+!-- G             acceleration due to gravity  (m/s^2)
+!-- CP            heat capacity at constant pressure for dry air (J/kg/K)
+!-- R_d           gas constant for dry air (J/kg/K)
+!-- R_v           gas constant for water vapor (J/kg/K)
+!-- XLS           latent heat of sublimation   (J/kg)
+!-- XLV           latent heat of vaporization  (J/kg)
+!-- XLF           latent heat of melting       (J/kg)
+!-- rhowater      water density                      (kg/m^3)
+!-- rhosnow       snow density               (kg/m^3)
+!-- F_ICE_PHY     Fraction of ice.
+!-- F_RAIN_PHY    Fraction of rain.
+!-- F_RIMEF_PHY   Mass ratio of rimed ice (rime factor)
+!-- P_QV          species index for water vapor
+!-- P_QC          species index for cloud water
+!-- P_QR          species index for rain water
+!-- P_QI          species index for cloud ice
+!-- P_QS          species index for snow
+!-- P_QG          species index for graupel
+!-- P_QNI         species index for cloud ice number concentration
+!-- ids           start index for i in domain
+!-- ide           end index for i in domain
+!-- jds           start index for j in domain
+!-- jde           end index for j in domain
+!-- kds           start index for k in domain
+!-- kde           end index for k in domain
+!-- ims           start index for i in memory
+!-- ime           end index for i in memory
+!-- jms           start index for j in memory
+!-- jme           end index for j in memory
+!-- kms           start index for k in memory
+!-- kme           end index for k in memory
+!-- i_start       start indices for i in tile
+!-- i_end         end indices for i in tile
+!-- j_start       start indices for j in tile
+!-- j_end         end indices for j in tile
+!-- its           start index for i in tile
+!-- ite           end index for i in tile
+!-- jts           start index for j in tile
+!-- jte           end index for j in tile
+!-- kts           start index for k in tile
+!-- kte           end index for k in tile
+!-- num_tiles     number of tiles
+!
+!======================================================================
+
+   INTEGER,    INTENT(IN   )    :: mp_physics
+   LOGICAL,    INTENT(IN   )    :: specified
+!
+   INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
+   INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
+   INTEGER,      INTENT(IN   )    ::                         kts,kte
+   INTEGER,      INTENT(IN   )    ::     itimestep,num_tiles,spec_zone
+   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
+     &           i_start,i_end,j_start,j_end
+
+   LOGICAL,      INTENT(IN   )    ::   warm_rain
+!
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                    &
+         INTENT(INOUT) ::                                     th
+!
+
+!
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                    &
+         INTENT(IN   ) ::                                             &
+                                                                 rho, &
+                                                                dz8w, &
+                                                                 p8w, &
+                                                              pi_phy, &
+                                                               p
+!
+
+   REAL, INTENT(INOUT),  DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
+                                     F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
+
+!
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN)   :: XLAND
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT)   :: SR
+
+   REAL, INTENT(IN   ) :: dt,dx,dy
+
+   INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: LOWLYR
+
+!
+! Optional
+!
+   LOGICAL,  OPTIONAL,   INTENT(IN   )    :: channel_switch
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         OPTIONAL,                                                &
+         INTENT(INOUT ) ::                                        &
+                  w, z                                            & 
+                 ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr &
+                 ,qt_curr,qni_curr                                
+
+!
+   REAL, DIMENSION( ims:ime , jms:jme ),                          &
+         INTENT(INOUT),                                           &
+         OPTIONAL   ::                                            &
+                                                           RAINNC &
+                                                         ,RAINNCV &
+                                                          ,SNOWNC &
+                                                         ,SNOWNCV &
+                                                       ,GRAUPELNC &
+                                                      ,GRAUPELNCV
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , OPTIONAL ,             &
+         INTENT(IN)   ::                                       ht
+
+   REAL, DIMENSION (:), OPTIONAL, INTENT(INOUT) :: mp_restart_state &
+                                         ,tbpvs_state,tbpvs0_state
+!
+
+   LOGICAL, OPTIONAL ::      f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qni,f_qt
+
+
+! LOCAL  VAR
+
+   INTEGER :: i,j,k,its,ite,jts,jte,ij,sz,n
+   LOGICAL :: channel
+
+!---------------------------------------------------------------------
+!  check for microphysics type.  We need a clean way to 
+!  specify these things!
+!---------------------------------------------------------------------
+
+   channel = .FALSE.
+   IF ( PRESENT ( channel_switch ) ) channel = channel_switch
+
+   if (mp_physics .eq. 0) return
+   IF( specified ) THEN
+     sz = spec_zone
+   ELSE
+     sz = 0
+   ENDIF
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij, its, ite, jts, jte, i,j,k,n )
+
+   DO ij = 1 , num_tiles
+
+       IF (channel) THEN
+         its = max(i_start(ij),ids)
+         ite = min(i_end(ij),ide-1)
+       ELSE
+         its = max(i_start(ij),ids+sz)
+         ite = min(i_end(ij),ide-1-sz)
+       ENDIF
+       jts = max(j_start(ij),jds+sz)
+       jte = min(j_end(ij),jde-1-sz)
+
+!-----------
+
+     micro_select: SELECT CASE(mp_physics)
+
+        CASE (KESSLERSCHEME)
+             CALL wrf_debug ( 100 , 'microphysics_driver: calling kessler' )
+             IF ( PRESENT( QV_CURR ) .AND. PRESENT( QC_CURR ) .AND.  &
+                                           PRESENT( QR_CURR ) .AND.  &
+                  PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
+                                           PRESENT( Z       ))  THEN
+               CALL kessler(                                        &
+                  T=th                                              &
+                 ,QV=qv_curr                                        &
+                 ,QC=qc_curr                                        &
+                 ,QR=qr_curr                                        &
+                 ,RHO=rho, PII=pi_phy,DT_IN=dt, Z=z, XLV=xlv, CP=cp &
+                 ,EP2=ep_2,SVP1=svp1,SVP2=svp2                      &
+                 ,SVP3=svp3,SVPT0=svpt0,RHOWATER=rhowater           &
+                 ,DZ8W=dz8w                                         &
+                 ,RAINNC=rainnc,RAINNCV=rainncv                     &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+             ELSE 
+                CALL wrf_error_fatal ( 'arguments not present for calling kessler' )
+             ENDIF
+
+!
+        CASE (THOMPSON)
+             CALL wrf_debug ( 100 , 'microphysics_driver: calling thompson et al' )
+             IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
+                  PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
+                  PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND.  &
+                                           PRESENT ( QNI_CURR ).AND.  &
+                  PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) ) THEN
+             CALL mp_gt_driver(                          &
+                     QV=qv_curr,                         &
+                     QC=qc_curr,                         &
+                     QR=qr_curr,                         &
+                     QI=qi_curr,                         &
+                     QS=qs_curr,                         &
+                     QG=qg_curr,                         &
+                     NI=qni_curr,                        &
+                     TH=th,                              &
+                     PII=pi_phy,                         &
+                     P=p,                                &
+                     DZ=dz8w,                            &
+                     DT_IN=dt,                           &
+                     ITIMESTEP=itimestep,                &
+                     RAINNC=RAINNC,                      &
+                     RAINNCV=RAINNCV,                    &
+                     SR=SR                               &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
+             ELSE
+                CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
+             ENDIF
+!
+        CASE (LINSCHEME)
+             CALL wrf_debug ( 100 , 'microphysics_driver: calling lin_et_al' )
+             IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
+                  PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
+                  PRESENT( QS_CURR )                           .AND.  &
+                  PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
+                  PRESENT( Z       ) ) THEN
+               CALL lin_et_al(                                      &
+                  TH=th                                             &
+                 ,QV=qv_curr                                        &
+                 ,QL=qc_curr                                        &
+                 ,QR=qr_curr                                        &
+                 ,QI=qi_curr                                        &
+                 ,QS=qs_curr                                        &
+                 ,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z           &
+                 ,HT=ht, DZ8W=dz8w, GRAV=G,  CP=cp                  &
+                 ,RAIR=r_d, RVAPOR=R_v                              &
+                 ,XLS=xls, XLV=xlv, XLF=xlf                         &
+                 ,RHOWATER=rhowater, RHOSNOW=rhosnow                &
+                 ,EP2=ep_2,SVP1=svp1,SVP2=svp2                      &
+                 ,SVP3=svp3,SVPT0=svpt0                             &
+                 ,RAINNC=rainnc, RAINNCV=rainncv                    &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                 ,F_QG=f_qg                                         &
+                 ,QG=qg_curr                                        &
+                                                                    )
+             ELSE 
+                CALL wrf_error_fatal ( 'arguments not present for calling lin_et_al' )
+             ENDIF
+
+        CASE (WSM3SCHEME)
+             CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm3' )
+             IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
+                  PRESENT( QR_CURR ) .AND.                            &
+                  PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
+                  PRESENT( W       )                            ) THEN
+             CALL wsm3(                                             &
+                  TH=th                                             &
+                 ,Q=qv_curr                                         &
+                 ,QCI=qc_curr                                       &
+                 ,QRS=qr_curr                                       &
+                 ,W=w,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w              &
+                 ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
+                 ,RD=r_d,RV=r_v,T0C=svpt0                           &
+                 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
+                 ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
+                 ,DEN0=rhoair0, DENR=rhowater                       &
+                 ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
+                 ,RAIN=rainnc ,RAINNCV=rainncv                      &
+                 ,SNOW=snownc ,SNOWNCV=snowncv                      &
+                 ,SR=sr                                             &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+             ELSE 
+                CALL wrf_error_fatal ( 'arguments not present for calling wsm3' )
+             ENDIF
+
+        CASE (WSM5SCHEME)
+             CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm5' )
+             IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
+                  PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
+                  PRESENT( QS_CURR ) .AND.                            &
+                  PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV )  ) THEN
+             CALL wsm5(                                             &
+                  TH=th                                             &
+                 ,Q=qv_curr                                         &
+                 ,QC=qc_curr                                        &
+                 ,QR=qr_curr                                        &
+                 ,QI=qi_curr                                        &
+                 ,QS=qs_curr                                        &
+                 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w                  &
+                 ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
+                 ,RD=r_d,RV=r_v,T0C=svpt0                           &
+                 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
+                 ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
+                 ,DEN0=rhoair0, DENR=rhowater                       &
+                 ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
+                 ,RAIN=rainnc ,RAINNCV=rainncv                      &
+                 ,SNOW=snownc ,SNOWNCV=snowncv                      &
+                 ,SR=sr                                             &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+             ELSE
+                CALL wrf_error_fatal ( 'arguments not present for calling wsm5' )
+             ENDIF
+
+        CASE (WSM6SCHEME)
+             CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm6' )
+             IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
+                  PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
+                  PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND.  &
+                  PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV )  ) THEN
+             CALL wsm6(                                             &
+                  TH=th                                             &
+                 ,Q=qv_curr                                         &
+                 ,QC=qc_curr                                        &
+                 ,QR=qr_curr                                        &
+                 ,QI=qi_curr                                        &
+                 ,QS=qs_curr                                        &
+                 ,QG=qg_curr                                        &
+                 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w                  &
+                 ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
+                 ,RD=r_d,RV=r_v,T0C=svpt0                           &
+                 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
+                 ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
+                 ,DEN0=rhoair0, DENR=rhowater                       &
+                 ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
+                 ,RAIN=rainnc ,RAINNCV=rainncv                      &
+                 ,SNOW=snownc ,SNOWNCV=snowncv                      &
+                 ,SR=sr                                             &
+                 ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv          &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+             ELSE
+                CALL wrf_error_fatal ( 'arguments not present for calling wsm6' )
+             ENDIF
+
+        CASE (ETAMPNEW)
+             CALL wrf_debug ( 100 , 'microphysics_driver: calling etampnew')
+
+             IF ( PRESENT( qv_curr ) .AND. PRESENT( qt_curr ) .AND. &
+                  PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
+                  PRESENT( mp_restart_state )                  .AND. &
+                  PRESENT( tbpvs_state )                      .AND. &
+                  PRESENT( tbpvs0_state )                       ) THEN
+               CALL ETAMP_NEW(                                      &
+                  ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy             &
+                 ,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
+                 ,QV=qv_curr                                        &
+                 ,QC=qc_curr                                        &
+                 ,QS=qs_curr                                        & 
+                 ,QR=qr_curr                                        &
+                 ,QT=qt_curr                                        &
+                 ,LOWLYR=LOWLYR,SR=SR                               &
+                 ,F_ICE_PHY=F_ICE_PHY,F_RAIN_PHY=F_RAIN_PHY         &
+                 ,F_RIMEF_PHY=F_RIMEF_PHY                           &
+                 ,RAINNC=rainnc,RAINNCV=rainncv                     &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                 ,MP_RESTART_STATE=mp_restart_state                 &
+                 ,TBPVS_STATE=tbpvs_state,TBPVS0_STATE=tbpvs0_state &
+                                                                    )
+             ELSE
+                CALL wrf_error_fatal ( 'arguments not present for calling etampnew' )
+             ENDIF
+
+        CASE (NCEPCLOUD3)
+             CALL wrf_debug ( 100 , 'microphysics_driver: calling ncloud3' )
+             IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
+                  PRESENT( QR_CURR ) .AND.                            &
+                  PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
+                  PRESENT( W       )                            ) THEN
+             CALL ncloud3(                                          &
+                  TH=th                                             &
+                 ,Q=qv_curr                                         &
+                 ,QCI=qc_curr                                       &
+                 ,QRS=qr_curr                                       &
+                 ,W=w, DEN=rho, PII=pi_phy, P=p, DELZ=dz8w          &
+                 ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
+                 ,RD=r_d,RV=r_v,T0C=SVPT0                           &
+                 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
+                 ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
+                 ,DEN0=rhoair0, DENR=rhowater                       &
+                 ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
+                 ,RAIN=RAINNC,RAINNCV=RAINNCV                       &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+
+             ELSE
+                CALL wrf_error_fatal ( 'arguments not present for calling ncepcloud3' )
+             ENDIF
+
+        CASE (NCEPCLOUD5)
+             CALL wrf_debug ( 100 , 'microphysics_driver: calling ncloud5' )
+             IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
+                  PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
+                  PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND.  &
+                  PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
+                  PRESENT( W       )                            ) THEN
+             CALL ncloud5(                                          &
+                  TH=th                                             &
+                 ,Q=qv_curr                                         &
+                 ,QC=qc_curr                                        &
+                 ,QR=qr_curr                                        &
+                 ,QI=qi_curr                                        &
+                 ,QS=qs_curr                                        &
+                 ,W=w, DEN=rho, PII=pi_phy, P=p, DELZ=dz8w          &
+                 ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
+                 ,RD=r_d,RV=r_v,T0C=SVPT0                           &
+                 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
+                 ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
+                 ,DEN0=rhoair0, DENR=rhowater                       &
+                 ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
+                 ,RAIN=RAINNC,RAINNCV=RAINNCV                       &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+             ELSE
+                CALL wrf_error_fatal ( 'arguments not present for calling ncepcloud5' )
+             ENDIF
+
+
+      CASE DEFAULT 
+
+         WRITE( wrf_err_message , * ) 'The microphysics option does not exist: mp_physics = ', mp_physics
+         CALL wrf_error_fatal ( wrf_err_message )
+
+      END SELECT micro_select 
+
+   ENDDO
+   !$OMP END PARALLEL DO
+
+   CALL wrf_debug ( 200 , 'microphysics_driver: returning from' )
+
+   RETURN
+
+   END SUBROUTINE microphysics_driver
+
+END MODULE module_microphysics_driver
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_microphysics_zero_out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_microphysics_zero_out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_microphysics_zero_out.F	(revision 2744)
@@ -0,0 +1,128 @@
+!WRF:MEDIATION_LAYER:PHYSICS
+!
+MODULE module_microphysics_zero_out
+CONTAINS
+
+SUBROUTINE microphysics_zero_out (                                       &
+                       moist_new , n_moist                               &
+                      ,config_flags                                      &
+                      ,ids,ide, jds,jde, kds,kde                         &
+                      ,ims,ime, jms,jme, kms,kme                         &
+                      ,its,ite, jts,jte, kts,kte                         )
+
+
+   USE module_state_description
+   USE module_configure
+   USE module_wrf_error
+
+   IMPLICIT NONE
+   TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
+   INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
+   INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
+   INTEGER,      INTENT(IN   )    ::       its,ite, jts,jte, kts,kte
+
+   INTEGER,      INTENT(IN   )    :: n_moist
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: moist_new
+
+! Local
+
+   INTEGER i,j,k,n
+
+
+   ! Zero out small condensate values  FSL-BLS-12-JUL-2004
+
+   IF ( config_flags%mp_zero_out .EQ. 0 ) THEN
+      !  do nothing
+   ELSE IF ( config_flags%mp_zero_out .EQ. 1 ) THEN
+      !  All of the "moist" fields, except for vapor, that are below a critical
+      !  threshold are set to zero.
+      CALL wrf_debug ( 100 , 'zero out small condensates, vapor not included')
+      DO n = PARAM_FIRST_SCALAR,n_moist
+         IF ( n .NE. P_QV ) THEN
+            DO j = jts, jte
+            DO k = kts, kte
+            DO i = its, ite
+               IF ( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh )  moist_new(i,k,j,n) =0.
+            ENDDO
+            ENDDO
+            ENDDO
+         END IF
+      ENDDO
+   ELSE IF ( config_flags%mp_zero_out .EQ. 2 ) then
+      !  All of the non-Qv "moist" fields that are below a critical threshold are set to 
+      !  zero.  The vapor is constrained to be non-negative.
+      CALL wrf_debug ( 100 , 'zero out small condensates, zero out negative vapor')
+      DO n = PARAM_FIRST_SCALAR,n_moist
+         IF ( n .NE. P_QV ) THEN
+            DO j = jts, jte
+            DO k = kts, kte
+            DO i = its, ite
+               IF ( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh )  moist_new(i,k,j,n) =0.
+            ENDDO
+            ENDDO
+            ENDDO
+         ELSE IF ( n .EQ. P_QV ) THEN
+            DO j = jts, jte
+            DO k = kts, kte
+            DO i = its, ite
+               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
+            ENDDO
+            ENDDO
+            ENDDO
+         END IF
+      ENDDO
+   END IF
+
+   ! Make sure that the boundary is .GE. 0 if the config_flags%mp_zero_out option is selected (1 or 2)
+   ! Just do the outer row/col, no interior points.
+
+   IF ( config_flags%mp_zero_out .NE. 0 ) THEN
+      DO n = PARAM_FIRST_SCALAR,n_moist
+         !  bottom row
+         j = jds
+         IF ( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
+            DO k = kts, kte
+            DO i = its , MIN ( ite , ide-1 )
+               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
+            ENDDO
+            ENDDO
+         END IF
+         !  top row
+         j = jde-1
+         IF ( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
+            DO k = kts, kte
+            DO i = its , MIN ( ite , ide-1 )
+               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
+            ENDDO
+            ENDDO
+         END IF
+         !  left column
+         i = ids
+         IF ( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
+            DO j = jts , MIN ( jte , jde-1 )
+            DO k = kts, kte
+               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
+            ENDDO
+            ENDDO
+         END IF
+         !  right column
+         i = ide-1
+         IF ( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
+            DO j = jts , MIN ( jte , jde-1 )
+            DO k = kts, kte
+               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
+            ENDDO
+            ENDDO
+         END IF
+      ENDDO
+   END IF
+
+   RETURN
+
+   END SUBROUTINE microphysics_zero_out
+
+END MODULE module_microphysics_zero_out
+
+
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_mp_etanew.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_mp_etanew.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_mp_etanew.F	(revision 2744)
@@ -0,0 +1,2589 @@
+!WRF:MODEL_MP:PHYSICS
+!
+MODULE module_mp_etanew
+!
+!-----------------------------------------------------------------------
+      REAL,PRIVATE,SAVE ::  ABFR, CBFR, CIACW, CIACR, C_N0r0,           &
+     &  CN0r0, CN0r_DMRmin, CN0r_DMRmax, CRACW, CRAUT, ESW0,            &
+     &  RFmax, RQR_DR1, RQR_DR2, RQR_DR3, RQR_DRmin,                    &
+     &  RQR_DRmax, RR_DRmin, RR_DR1, RR_DR2, RR_DR3, RR_DRmax
+!
+      INTEGER, PRIVATE,PARAMETER :: MY_T1=1, MY_T2=35
+      REAL,PRIVATE,DIMENSION(MY_T1:MY_T2),SAVE :: MY_GROWTH
+!
+      REAL, PRIVATE,PARAMETER :: DMImin=.05e-3, DMImax=1.e-3,           &
+     &      DelDMI=1.e-6,XMImin=1.e6*DMImin
+      INTEGER, PUBLIC,PARAMETER :: XMImax=1.e6*DMImax, XMIexp=.0536,    &
+     &                             MDImin=XMImin, MDImax=XMImax
+      REAL, PRIVATE,DIMENSION(MDImin:MDImax) ::                         &
+     &      ACCRI,SDENS,VSNOWI,VENTI1,VENTI2
+!
+      REAL, PRIVATE,PARAMETER :: DMRmin=.05e-3, DMRmax=.45e-3,          &
+     &      DelDMR=1.e-6,XMRmin=1.e6*DMRmin, XMRmax=1.e6*DMRmax
+      INTEGER, PRIVATE,PARAMETER :: MDRmin=XMRmin, MDRmax=XMRmax                   
+      REAL, PRIVATE,DIMENSION(MDRmin:MDRmax)::                          &
+     &      ACCRR,MASSR,RRATE,VRAIN,VENTR1,VENTR2
+!
+      INTEGER, PRIVATE,PARAMETER :: Nrime=40
+      REAL, DIMENSION(2:9,0:Nrime),PRIVATE,SAVE :: VEL_RF
+!
+      INTEGER,PARAMETER :: NX=7501
+      REAL, PARAMETER :: XMIN=180.0,XMAX=330.0
+      REAL, DIMENSION(NX),PRIVATE,SAVE :: TBPVS,TBPVS0
+      REAL, PRIVATE,SAVE :: C1XPVS0,C2XPVS0,C1XPVS,C2XPVS
+!
+      REAL, PRIVATE,PARAMETER ::                                        &
+!--- Physical constants follow:
+     &   CP=1004.6, EPSQ=1.E-12, GRAV=9.806, RHOL=1000., RD=287.04      &
+     &  ,RV=461.5, T0C=273.15, XLS=2.834E6                              &
+!--- Derived physical constants follow:
+     &  ,EPS=RD/RV, EPS1=RV/RD-1., EPSQ1=1.001*EPSQ                     &
+     &  ,RCP=1./CP, RCPRV=RCP/RV, RGRAV=1./GRAV, RRHOL=1./RHOL          &
+     &  ,XLS1=XLS*RCP, XLS2=XLS*XLS*RCPRV, XLS3=XLS*XLS/RV              &
+!--- Constants specific to the parameterization follow:
+!--- CLIMIT/CLIMIT1 are lower limits for treating accumulated precipitation
+     &  ,CLIMIT=10.*EPSQ, CLIMIT1=-CLIMIT                               &
+     &  ,C1=1./3.                                                       &
+     &  ,DMR1=.1E-3, DMR2=.2E-3, DMR3=.32E-3                            &
+     &  ,XMR1=1.e6*DMR1, XMR2=1.e6*DMR2, XMR3=1.e6*DMR3
+      INTEGER, PARAMETER :: MDR1=XMR1, MDR2=XMR2, MDR3=XMR3
+!
+! ======================================================================
+!--- Important tunable parameters that are exported to other modules
+!  * RHgrd - threshold relative humidity for onset of condensation
+!  * T_ICE - temperature (C) threshold at which all remaining liquid water
+!            is glaciated to ice
+!  * T_ICE_init - maximum temperature (C) at which ice nucleation occurs
+!  * NLImax - maximum number concentrations (m**-3) of large ice (snow/graupel/sleet) 
+!  * NLImin - minimum number concentrations (m**-3) of large ice (snow/graupel/sleet) 
+!  * N0r0 - assumed intercept (m**-4) of rain drops if drop diameters are between 0.2 and 0.45 mm
+!  * N0rmin - minimum intercept (m**-4) for rain drops 
+!  * NCW - number concentrations of cloud droplets (m**-3)
+!  * FLARGE1, FLARGE2 - number fraction of large ice to total (large+snow) ice 
+!          at T>0C and in presence of sublimation (FLARGE1), otherwise in
+!          presence of ice saturated/supersaturated conditions
+! ======================================================================
+      REAL, PUBLIC,PARAMETER ::                                         &
+     &  RHgrd=1.                                                        &
+     & ,T_ICE=-30.                                                      &
+     & ,T_ICEK=T0C+T_ICE                                                &
+     & ,T_ICE_init=-5.                                                  &
+     & ,NLImax=5.E3                                                     &
+     & ,NLImin=1.E3                                                     &
+     & ,N0r0=8.E6                                                       &
+     & ,N0rmin=1.E4                                                     &
+     & ,NCW=100.E6                                                      &
+     & ,FLARGE1=1.                                                      &
+     & ,FLARGE2=.2
+!--- Other public variables passed to other routines:
+      REAL,PUBLIC,SAVE ::  QAUT0
+      REAL, PUBLIC,DIMENSION(MDImin:MDImax) :: MASSI
+!
+!
+      CONTAINS
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      SUBROUTINE ETAMP_NEW (itimestep,DT,DX,DY,                         &
+     &                      dz8w,rho_phy,p_phy,pi_phy,th_phy,qv,qt,     &
+     &                      LOWLYR,SR,                                  &
+     &                      F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,           &
+     &                      QC,QR,QS,                                   &
+     &                      mp_restart_state,tbpvs_state,tbpvs0_state,  &
+     &                      RAINNC,RAINNCV,                             &
+     &                      ids,ide, jds,jde, kds,kde,		        &
+     &                      ims,ime, jms,jme, kms,kme,		        &
+     &                      its,ite, jts,jte, kts,kte )
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      INTEGER, PARAMETER :: ITLO=-60, ITHI=40
+
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE                     &
+     &                     ,ITIMESTEP
+
+      REAL, INTENT(IN) 	    :: DT,DX,DY
+      REAL, INTENT(IN),     DIMENSION(ims:ime, kms:kme, jms:jme)::      &
+     &                      dz8w,p_phy,pi_phy,rho_phy
+      REAL, INTENT(INOUT),  DIMENSION(ims:ime, kms:kme, jms:jme)::      &
+     &                      th_phy,qv,qt
+      REAL, INTENT(INOUT),  DIMENSION(ims:ime, kms:kme, jms:jme ) ::    &
+     &                      qc,qr,qs
+      REAL, INTENT(INOUT),  DIMENSION(ims:ime, kms:kme, jms:jme ) ::    &
+     &                      F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
+      REAL, INTENT(INOUT),  DIMENSION(ims:ime,jms:jme)           ::     &
+     &                                                   RAINNC,RAINNCV
+      REAL, INTENT(OUT),    DIMENSION(ims:ime,jms:jme):: SR
+!
+      REAL,DIMENSION(*),INTENT(INOUT) :: MP_RESTART_STATE
+!
+      REAL,DIMENSION(nx),INTENT(INOUT) :: TBPVS_STATE,TBPVS0_STATE
+!
+      INTEGER, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT) :: LOWLYR
+
+!-----------------------------------------------------------------------
+!     LOCAL VARS
+!-----------------------------------------------------------------------
+
+!     NSTATS,QMAX,QTOT are diagnostic vars
+
+      INTEGER,DIMENSION(ITLO:ITHI,4) :: NSTATS
+      REAL,   DIMENSION(ITLO:ITHI,5) :: QMAX
+      REAL,   DIMENSION(ITLO:ITHI,22):: QTOT
+
+!     SOME VARS WILL BE USED FOR DATA ASSIMILATION (DON'T NEED THEM NOW). 
+!     THEY ARE TREATED AS LOCAL VARS, BUT WILL BECOME STATE VARS IN THE 
+!     FUTURE. SO, WE DECLARED THEM AS MEMORY SIZES FOR THE FUTURE USE
+
+!     TLATGS_PHY,TRAIN_PHY,APREC,PREC,ACPREC,SR are not directly related 
+!     the microphysics scheme. Instead, they will be used by Eta precip 
+!     assimilation.
+
+      REAL,  DIMENSION( ims:ime, kms:kme, jms:jme ) ::                  &
+     &       TLATGS_PHY,TRAIN_PHY
+      REAL,  DIMENSION(ims:ime,jms:jme):: APREC,PREC,ACPREC
+      REAL,  DIMENSION(its:ite, kts:kte, jts:jte):: t_phy
+
+      INTEGER :: I,J,K,KFLIP
+      REAL :: WC
+!
+!-----------------------------------------------------------------------
+!**********************************************************************
+!-----------------------------------------------------------------------
+!
+      MY_GROWTH(MY_T1:MY_T2)=MP_RESTART_STATE(MY_T1:MY_T2)
+!
+      C1XPVS0=MP_RESTART_STATE(MY_T2+1)
+      C2XPVS0=MP_RESTART_STATE(MY_T2+2)
+      C1XPVS =MP_RESTART_STATE(MY_T2+3)
+      C2XPVS =MP_RESTART_STATE(MY_T2+4)
+      CIACW  =MP_RESTART_STATE(MY_T2+5)
+      CIACR  =MP_RESTART_STATE(MY_T2+6)
+      CRACW  =MP_RESTART_STATE(MY_T2+7)
+      CRAUT  =MP_RESTART_STATE(MY_T2+8)
+!
+      TBPVS(1:NX) =TBPVS_STATE(1:NX)
+      TBPVS0(1:NX)=TBPVS0_STATE(1:NX)
+!
+      DO j = jts,jte
+      DO k = kts,kte
+      DO i = its,ite
+        t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j)
+        qv(i,k,j)=qv(i,k,j)/(1.+qv(i,k,j)) !Convert to specific humidity
+      ENDDO
+      ENDDO
+      ENDDO
+
+!     initial diagnostic variables and data assimilation vars
+!     (will need to delete this part in the future)
+
+      DO k = 1,4
+      DO i = ITLO,ITHI
+         NSTATS(i,k)=0. 
+      ENDDO
+      ENDDO
+
+      DO k = 1,5
+      DO i = ITLO,ITHI
+         QMAX(i,k)=0.
+      ENDDO
+      ENDDO
+
+      DO k = 1,22
+      DO i = ITLO,ITHI
+         QTOT(i,k)=0.
+      ENDDO
+      ENDDO
+
+! initial data assimilation vars (will need to delete this part in the future)
+
+      DO j = jts,jte
+      DO k = kts,kte
+      DO i = its,ite
+	 TLATGS_PHY (i,k,j)=0.
+	 TRAIN_PHY  (i,k,j)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+
+      DO j = jts,jte
+      DO i = its,ite
+         ACPREC(i,j)=0.
+         APREC (i,j)=0.
+         PREC  (i,j)=0.
+         SR    (i,j)=0.
+      ENDDO
+      ENDDO
+
+!-----------------------------------------------------------------------
+
+      CALL EGCP01DRV(DT,LOWLYR,                                         &
+     &               APREC,PREC,ACPREC,SR,NSTATS,QMAX,QTOT,	        &
+     &               dz8w,rho_phy,qt,t_phy,qv,F_ICE_PHY,P_PHY,          &
+     &               F_RAIN_PHY,F_RIMEF_PHY,TLATGS_PHY,TRAIN_PHY,       &
+     &               ids,ide, jds,jde, kds,kde,		                &
+     &               ims,ime, jms,jme, kms,kme,		                &
+     &               its,ite, jts,jte, kts,kte		          )
+!-----------------------------------------------------------------------
+
+     DO j = jts,jte
+        DO k = kts,kte
+	DO i = its,ite
+  	   th_phy(i,k,j) = t_phy(i,k,j)/pi_phy(i,k,j)
+           qv(i,k,j)=qv(i,k,j)/(1.-qv(i,k,j))  !Convert to mixing ratio
+           WC=qt(I,K,J)
+           QS(I,K,J)=0.
+           QR(I,K,J)=0.
+           QC(I,K,J)=0.
+           IF(F_ICE_PHY(I,K,J)>=1.)THEN
+             QS(I,K,J)=WC
+           ELSEIF(F_ICE_PHY(I,K,J)<=0.)THEN
+             QC(I,K,J)=WC
+           ELSE
+             QS(I,K,J)=F_ICE_PHY(I,K,J)*WC
+             QC(I,K,J)=WC-QS(I,K,J)
+           ENDIF
+!
+           IF(QC(I,K,J)>0..AND.F_RAIN_PHY(I,K,J)>0.)THEN
+             IF(F_RAIN_PHY(I,K,J).GE.1.)THEN
+               QR(I,K,J)=QC(I,K,J)
+               QC(I,K,J)=0.
+             ELSE
+               QR(I,K,J)=F_RAIN_PHY(I,K,J)*QC(I,K,J)
+               QC(I,K,J)=QC(I,K,J)-QR(I,K,J)
+             ENDIF
+           ENDIF
+	ENDDO
+        ENDDO
+     ENDDO
+! 
+! update rain (from m to mm)
+
+       DO j=jts,jte
+       DO i=its,ite
+          RAINNC(i,j)=APREC(i,j)*1000.+RAINNC(i,j)
+          RAINNCV(i,j)=APREC(i,j)*1000.
+       ENDDO
+       ENDDO
+!
+     MP_RESTART_STATE(MY_T1:MY_T2)=MY_GROWTH(MY_T1:MY_T2)
+     MP_RESTART_STATE(MY_T2+1)=C1XPVS0
+     MP_RESTART_STATE(MY_T2+2)=C2XPVS0
+     MP_RESTART_STATE(MY_T2+3)=C1XPVS
+     MP_RESTART_STATE(MY_T2+4)=C2XPVS
+     MP_RESTART_STATE(MY_T2+5)=CIACW
+     MP_RESTART_STATE(MY_T2+6)=CIACR
+     MP_RESTART_STATE(MY_T2+7)=CRACW
+     MP_RESTART_STATE(MY_T2+8)=CRAUT
+!
+     TBPVS_STATE(1:NX) =TBPVS(1:NX)
+     TBPVS0_STATE(1:NX)=TBPVS0(1:NX)
+
+!-----------------------------------------------------------------------
+
+  END SUBROUTINE ETAMP_NEW
+
+!-----------------------------------------------------------------------
+
+      SUBROUTINE EGCP01DRV(                                             &
+     &  DTPH,LOWLYR,APREC,PREC,ACPREC,SR,                               &
+     &  NSTATS,QMAX,QTOT,                                               &
+     &  dz8w,RHO_PHY,CWM_PHY,T_PHY,Q_PHY,F_ICE_PHY,P_PHY,               &
+     &  F_RAIN_PHY,F_RIMEF_PHY,TLATGS_PHY,TRAIN_PHY,                    &
+     &  ids,ide, jds,jde, kds,kde,                                      &
+     &  ims,ime, jms,jme, kms,kme,                                      &
+     &  its,ite, jts,jte, kts,kte)
+!-----------------------------------------------------------------------
+! DTPH           Physics time step (s)
+! CWM_PHY (qt)   Mixing ratio of the total condensate. kg/kg
+! Q_PHY          Mixing ratio of water vapor. kg/kg
+! F_RAIN_PHY     Fraction of rain. 
+! F_ICE_PHY      Fraction of ice.
+! F_RIMEF_PHY    Mass ratio of rimed ice (rime factor).
+!
+!TLATGS_PHY,TRAIN_PHY,APREC,PREC,ACPREC,SR are not directly related the
+!micrphysics sechme. Instead, they will be used by Eta precip assimilation.
+!
+!NSTATS,QMAX,QTOT are used for diagnosis purposes.
+!
+!-----------------------------------------------------------------------
+!--- Variables APREC,PREC,ACPREC,SR are calculated for precip assimilation
+!    and/or ZHAO's scheme in Eta and are not required by this microphysics 
+!    scheme itself.  
+!--- NSTATS,QMAX,QTOT are used for diagnosis purposes only.  They will be 
+!    printed out when PRINT_diag is true.
+!
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+!
+      INTEGER, PARAMETER :: ITLO=-60, ITHI=40
+      LOGICAL, PARAMETER :: PRINT_diag=.FALSE.
+!     VARIABLES PASSED IN/OUT
+      INTEGER,INTENT(IN ) :: ids,ide, jds,jde, kds,kde                  &
+     &                      ,ims,ime, jms,jme, kms,kme                  &
+     &                      ,its,ite, jts,jte, kts,kte
+      REAL,INTENT(IN) :: DTPH
+      INTEGER, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT) :: LOWLYR
+      INTEGER,DIMENSION(ITLO:ITHI,4),INTENT(INOUT) :: NSTATS
+      REAL,DIMENSION(ITLO:ITHI,5),INTENT(INOUT) :: QMAX
+      REAL,DIMENSION(ITLO:ITHI,22),INTENT(INOUT) :: QTOT
+      REAL,DIMENSION(ims:ime,jms:jme),INTENT(INOUT) ::                  &
+     &                         APREC,PREC,ACPREC,SR
+      REAL,DIMENSION( its:ite, kts:kte, jts:jte ),INTENT(INOUT) :: t_phy
+      REAL,DIMENSION( ims:ime, kms:kme, jms:jme ),INTENT(IN) ::         &
+     &                                             dz8w,P_PHY,RHO_PHY
+      REAL,DIMENSION( ims:ime, kms:kme, jms:jme ),INTENT(INOUT) ::      &
+     &   CWM_PHY, F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,TLATGS_PHY           &
+     &   ,Q_PHY,TRAIN_PHY
+!
+!-----------------------------------------------------------------------
+!LOCAL VARIABLES
+!-----------------------------------------------------------------------
+!
+#define CACHE_FRIENDLY_MP_ETANEW
+#ifdef CACHE_FRIENDLY_MP_ETANEW
+#  define TEMP_DIMS  kts:kte,its:ite,jts:jte
+#  define TEMP_DEX   L,I,J
+#else
+#  define TEMP_DIMS  its:ite,jts:jte,kts:kte
+#  define TEMP_DEX   I,J,L
+#endif
+!
+      INTEGER :: LSFC,I,J,I_index,J_index,L,K,KFLIP
+      REAL,DIMENSION(TEMP_DIMS) :: CWM,T,Q,TRAIN,TLATGS,P
+      REAL,DIMENSION(kts:kte,its:ite,jts:jte) :: F_ice,F_rain,F_RimeF       
+      INTEGER,DIMENSION(its:ite,jts:jte) :: LMH
+      REAL :: TC,WC,QI,QR,QW,Fice,Frain,DUM,ASNOW,ARAIN
+      REAL,DIMENSION(kts:kte) :: P_col,Q_col,T_col,QV_col,WC_col,       &
+         RimeF_col,QI_col,QR_col,QW_col, THICK_col,DPCOL 
+      REAL,DIMENSION(2) :: PRECtot,PRECmax
+!-----------------------------------------------------------------------
+!
+        DO J=JTS,JTE    
+        DO I=ITS,ITE  
+           LMH(I,J) = KTE-LOWLYR(I,J)+1
+        ENDDO
+        ENDDO
+
+        DO 98  J=JTS,JTE    
+        DO 98  I=ITS,ITE  
+           DO L=KTS,KTE
+             KFLIP=KTE+1-L
+             CWM(TEMP_DEX)=CWM_PHY(I,KFLIP,J)
+             T(TEMP_DEX)=T_PHY(I,KFLIP,J)
+             Q(TEMP_DEX)=Q_PHY(I,KFLIP,J)
+             P(TEMP_DEX)=P_PHY(I,KFLIP,J)
+             TLATGS(TEMP_DEX)=TLATGS_PHY(I,KFLIP,J)
+             TRAIN(TEMP_DEX)=TRAIN_PHY(I,KFLIP,J)
+             F_ice(L,I,J)=F_ice_PHY(I,KFLIP,J)
+             F_rain(L,I,J)=F_rain_PHY(I,KFLIP,J)
+             F_RimeF(L,I,J)=F_RimeF_PHY(I,KFLIP,J)
+           ENDDO
+98      CONTINUE
+     
+       DO 100 J=JTS,JTE    
+        DO 100 I=ITS,ITE  
+          LSFC=LMH(I,J)                      ! "L" of surface
+!
+          DO K=KTS,KTE
+            KFLIP=KTE+1-K
+            DPCOL(K)=RHO_PHY(I,KFLIP,J)*GRAV*dz8w(I,KFLIP,J)
+          ENDDO
+!   
+   !
+   !--- Initialize column data (1D arrays)
+   !
+        L=1
+        IF (CWM(TEMP_DEX) .LE. EPSQ) CWM(TEMP_DEX)=EPSQ
+          F_ice(1,I,J)=1.
+          F_rain(1,I,J)=0.
+          F_RimeF(1,I,J)=1.
+          DO L=1,LSFC
+      !
+      !--- Pressure (Pa) = (Psfc-Ptop)*(ETA/ETA_sfc)+Ptop
+      !
+            P_col(L)=P(TEMP_DEX)
+      !
+      !--- Layer thickness = RHO*DZ = -DP/G = (Psfc-Ptop)*D_ETA/(G*ETA_sfc)
+      !
+            THICK_col(L)=DPCOL(L)*RGRAV
+            T_col(L)=T(TEMP_DEX)
+            TC=T_col(L)-T0C
+            QV_col(L)=max(EPSQ, Q(TEMP_DEX))
+            IF (CWM(TEMP_DEX) .LE. EPSQ1) THEN
+              WC_col(L)=0.
+              IF (TC .LT. T_ICE) THEN
+                F_ice(L,I,J)=1.
+              ELSE
+                F_ice(L,I,J)=0.
+              ENDIF
+              F_rain(L,I,J)=0.
+              F_RimeF(L,I,J)=1.
+            ELSE
+              WC_col(L)=CWM(TEMP_DEX)
+            ENDIF
+      !
+      !--- Determine composition of condensate in terms of 
+      !      cloud water, ice, & rain
+      !
+            WC=WC_col(L)
+            QI=0.
+            QR=0.
+            QW=0.
+            Fice=F_ice(L,I,J)
+            Frain=F_rain(L,I,J)
+            IF (Fice .GE. 1.) THEN
+              QI=WC
+            ELSE IF (Fice .LE. 0.) THEN
+              QW=WC
+            ELSE
+              QI=Fice*WC
+              QW=WC-QI
+            ENDIF
+            IF (QW.GT.0. .AND. Frain.GT.0.) THEN
+              IF (Frain .GE. 1.) THEN
+                QR=QW
+                QW=0.
+              ELSE
+                QR=Frain*QW
+                QW=QW-QR
+              ENDIF
+            ENDIF
+            RimeF_col(L)=F_RimeF(L,I,J)               ! (real)
+            QI_col(L)=QI
+            QR_col(L)=QR
+            QW_col(L)=QW
+          ENDDO
+!
+!#######################################################################
+   !
+   !--- Perform the microphysical calculations in this column
+   !
+          I_index=I
+          J_index=J
+       CALL EGCP01COLUMN ( ARAIN, ASNOW, DTPH, I_index, J_index, LSFC,  &
+     & P_col, QI_col, QR_col, QV_col, QW_col, RimeF_col, T_col,         &
+     & THICK_col, WC_col,KTS,KTE,NSTATS,QMAX,QTOT )
+
+
+   !
+!#######################################################################
+!
+   !
+   !--- Update storage arrays
+   !
+          DO L=1,LSFC
+            TRAIN(TEMP_DEX)=(T_col(L)-T(TEMP_DEX))/DTPH
+            TLATGS(TEMP_DEX)=T_col(L)-T(TEMP_DEX)
+            T(TEMP_DEX)=T_col(L)
+            Q(TEMP_DEX)=QV_col(L)
+            CWM(TEMP_DEX)=WC_col(L)
+      !
+      !--- REAL*4 array storage
+      !
+            F_RimeF(L,I,J)=MAX(1., RimeF_col(L))
+            IF (QI_col(L) .LE. EPSQ) THEN
+              F_ice(L,I,J)=0.
+              IF (T_col(L) .LT. T_ICEK) F_ice(L,I,J)=1.
+            ELSE
+              F_ice(L,I,J)=MAX( 0., MIN(1., QI_col(L)/WC_col(L)) )
+            ENDIF
+            IF (QR_col(L) .LE. EPSQ) THEN
+              DUM=0
+            ELSE
+              DUM=QR_col(L)/(QR_col(L)+QW_col(L))
+            ENDIF
+            F_rain(L,I,J)=DUM
+      !
+          ENDDO
+   !
+   !--- Update accumulated precipitation statistics
+   !
+   !--- Surface precipitation statistics; SR is fraction of surface 
+   !    precipitation (if >0) associated with snow
+   !
+        APREC(I,J)=(ARAIN+ASNOW)*RRHOL       ! Accumulated surface precip (depth in m)  !<--- Ying
+        PREC(I,J)=PREC(I,J)+APREC(I,J)
+        ACPREC(I,J)=ACPREC(I,J)+APREC(I,J)
+        IF(APREC(I,J) .LT. 1.E-8) THEN
+          SR(I,J)=0.
+        ELSE
+          SR(I,J)=RRHOL*ASNOW/APREC(I,J)
+        ENDIF
+   !
+   !--- Debug statistics 
+   !
+        IF (PRINT_diag) THEN
+          PRECtot(1)=PRECtot(1)+ARAIN
+          PRECtot(2)=PRECtot(2)+ASNOW
+          PRECmax(1)=MAX(PRECmax(1), ARAIN)
+          PRECmax(2)=MAX(PRECmax(2), ASNOW)
+        ENDIF
+
+
+!#######################################################################
+!#######################################################################
+!
+100   CONTINUE                          ! End "I" & "J" loops
+        DO 101 J=JTS,JTE    
+        DO 101 I=ITS,ITE  
+           DO L=KTS,KTE
+              KFLIP=KTE+1-L
+             CWM_PHY(I,KFLIP,J)=CWM(TEMP_DEX)
+             T_PHY(I,KFLIP,J)=T(TEMP_DEX)
+             Q_PHY(I,KFLIP,J)=Q(TEMP_DEX)
+             TLATGS_PHY(I,KFLIP,J)=TLATGS(TEMP_DEX)
+             TRAIN_PHY(I,KFLIP,J)=TRAIN(TEMP_DEX)
+             F_ice_PHY(I,KFLIP,J)=F_ice(L,I,J)
+             F_rain_PHY(I,KFLIP,J)=F_rain(L,I,J)
+             F_RimeF_PHY(I,KFLIP,J)=F_RimeF(L,I,J)
+           ENDDO
+101     CONTINUE
+      END SUBROUTINE EGCP01DRV
+!
+!
+!###############################################################################
+! ***** VERSION OF MICROPHYSICS DESIGNED FOR HIGHER RESOLUTION MESO ETA MODEL
+!       (1) Represents sedimentation by preserving a portion of the precipitation
+!           through top-down integration from cloud-top.  Modified procedure to
+!           Zhao and Carr (1997).
+!       (2) Microphysical equations are modified to be less sensitive to time
+!           steps by use of Clausius-Clapeyron equation to account for changes in
+!           saturation mixing ratios in response to latent heating/cooling.  
+!       (3) Prevent spurious temperature oscillations across 0C due to 
+!           microphysics.
+!       (4) Uses lookup tables for: calculating two different ventilation 
+!           coefficients in condensation and deposition processes; accretion of
+!           cloud water by precipitation; precipitation mass; precipitation rate
+!           (and mass-weighted precipitation fall speeds).
+!       (5) Assumes temperature-dependent variation in mean diameter of large ice
+!           (Houze et al., 1979; Ryan et al., 1996).
+!        -> 8/22/01: This relationship has been extended to colder temperatures
+!           to parameterize smaller large-ice particles down to mean sizes of MDImin,
+!           which is 50 microns reached at -55.9C.
+!       (6) Attempts to differentiate growth of large and small ice, mainly for
+!           improved transition from thin cirrus to thick, precipitating ice
+!           anvils.
+!        -> 8/22/01: This feature has been diminished by effectively adjusting to
+!           ice saturation during depositional growth at temperatures colder than
+!           -10C.  Ice sublimation is calculated more explicitly.  The logic is
+!           that sources of are either poorly understood (e.g., nucleation for NWP) 
+!           or are not represented in the Eta model (e.g., detrainment of ice from 
+!           convection).  Otherwise the model is too wet compared to the radiosonde
+!           observations based on 1 Feb - 18 March 2001 retrospective runs.  
+!       (7) Top-down integration also attempts to treat mixed-phase processes,
+!           allowing a mixture of ice and water.  Based on numerous observational
+!           studies, ice growth is based on nucleation at cloud top &
+!           subsequent growth by vapor deposition and riming as the ice particles 
+!           fall through the cloud.  Effective nucleation rates are a function
+!           of ice supersaturation following Meyers et al. (JAM, 1992).  
+!        -> 8/22/01: The simulated relative humidities were far too moist compared 
+!           to the rawinsonde observations.  This feature has been substantially 
+!           diminished, limited to a much narrower temperature range of 0 to -10C.  
+!       (8) Depositional growth of newly nucleated ice is calculated for large time
+!           steps using Fig. 8 of Miller and Young (JAS, 1979), at 1 deg intervals
+!           using their ice crystal masses calculated after 600 s of growth in water
+!           saturated conditions.  The growth rates are normalized by time step
+!           assuming 3D growth with time**1.5 following eq. (6.3) in Young (1993).
+!        -> 8/22/01: This feature has been effectively limited to 0 to -10C.  
+!       (9) Ice precipitation rates can increase due to increase in response to
+!           cloud water riming due to (a) increased density & mass of the rimed
+!           ice, and (b) increased fall speeds of rimed ice.
+!        -> 8/22/01: This feature has been effectively limited to 0 to -10C.  
+!###############################################################################
+!###############################################################################
+!
+      SUBROUTINE EGCP01COLUMN ( ARAIN, ASNOW, DTPH, I_index, J_index,   &
+     & LSFC, P_col, QI_col, QR_col, QV_col, QW_col, RimeF_col, T_col,   &
+     & THICK_col, WC_col ,KTS,KTE,NSTATS,QMAX,QTOT)                          
+!
+!###############################################################################
+!###############################################################################
+!
+!-------------------------------------------------------------------------------
+!----- NOTE:  Code is currently set up w/o threading!  
+!-------------------------------------------------------------------------------
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:  Grid-scale microphysical processes - condensation & precipitation
+!   PRGRMMR: Ferrier         ORG: W/NP22     DATE: 08-2001
+!   PRGRMMR: Jin  (Modification for WRF structure)
+!-------------------------------------------------------------------------------
+! ABSTRACT:
+!   * Merges original GSCOND & PRECPD subroutines.   
+!   * Code has been substantially streamlined and restructured.
+!   * Exchange between water vapor & small cloud condensate is calculated using
+!     the original Asai (1965, J. Japan) algorithm.  See also references to
+!     Yau and Austin (1979, JAS), Rutledge and Hobbs (1983, JAS), and Tao et al.
+!     (1989, MWR).  This algorithm replaces the Sundqvist et al. (1989, MWR)
+!     parameterization.  
+!-------------------------------------------------------------------------------
+!     
+! USAGE: 
+!   * CALL EGCP01COLUMN FROM SUBROUTINE EGCP01DRV
+!
+! INPUT ARGUMENT LIST:
+!   DTPH       - physics time step (s)
+!   I_index    - I index
+!   J_index    - J index
+!   LSFC       - Eta level of level above surface, ground
+!   P_col      - vertical column of model pressure (Pa)
+!   QI_col     - vertical column of model ice mixing ratio (kg/kg)
+!   QR_col     - vertical column of model rain ratio (kg/kg)
+!   QV_col     - vertical column of model water vapor specific humidity (kg/kg)
+!   QW_col     - vertical column of model cloud water mixing ratio (kg/kg)
+!   RimeF_col  - vertical column of rime factor for ice in model (ratio, defined below)
+!   T_col      - vertical column of model temperature (deg K)
+!   THICK_col  - vertical column of model mass thickness (density*height increment)
+!   WC_col     - vertical column of model mixing ratio of total condensate (kg/kg)
+!   
+!
+! OUTPUT ARGUMENT LIST: 
+!   ARAIN      - accumulated rainfall at the surface (kg)
+!   ASNOW      - accumulated snowfall at the surface (kg)
+!   QV_col     - vertical column of model water vapor specific humidity (kg/kg)
+!   WC_col     - vertical column of model mixing ratio of total condensate (kg/kg)
+!   QW_col     - vertical column of model cloud water mixing ratio (kg/kg)
+!   QI_col     - vertical column of model ice mixing ratio (kg/kg)
+!   QR_col     - vertical column of model rain ratio (kg/kg)
+!   RimeF_col  - vertical column of rime factor for ice in model (ratio, defined below)
+!   T_col      - vertical column of model temperature (deg K)
+!     
+! OUTPUT FILES:
+!     NONE
+!     
+! Subprograms & Functions called:
+!   * Real Function CONDENSE  - cloud water condensation
+!   * Real Function DEPOSIT   - ice deposition (not sublimation)
+!
+! UNIQUE: NONE
+!  
+! LIBRARY: NONE
+!  
+! COMMON BLOCKS:  
+!     CMICRO_CONS  - key constants initialized in GSMCONST
+!     CMICRO_STATS - accumulated and maximum statistics
+!     CMY_GROWTH   - lookup table for growth of ice crystals in 
+!                    water saturated conditions (Miller & Young, 1979)
+!     IVENT_TABLES - lookup tables for ventilation effects of ice
+!     IACCR_TABLES - lookup tables for accretion rates of ice
+!     IMASS_TABLES - lookup tables for mass content of ice
+!     IRATE_TABLES - lookup tables for precipitation rates of ice
+!     IRIME_TABLES - lookup tables for increase in fall speed of rimed ice
+!     RVENT_TABLES - lookup tables for ventilation effects of rain
+!     RACCR_TABLES - lookup tables for accretion rates of rain
+!     RMASS_TABLES - lookup tables for mass content of rain
+!     RVELR_TABLES - lookup tables for fall speeds of rain
+!     RRATE_TABLES - lookup tables for precipitation rates of rain
+!   
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!
+!
+!------------------------------------------------------------------------- 
+!--------------- Arrays & constants in argument list --------------------- 
+!------------------------------------------------------------------------- 
+!
+      IMPLICIT NONE
+!    
+      INTEGER,INTENT(IN) :: KTS,KTE,I_index, J_index, LSFC
+      REAL,INTENT(INOUT) ::  ARAIN, ASNOW
+      REAL,DIMENSION(KTS:KTE),INTENT(INOUT) ::  P_col, QI_col,QR_col    &
+     & ,QV_col ,QW_col, RimeF_col, T_col, THICK_col,WC_col
+!
+!------------------------------------------------------------------------- 
+!-------------- Common blocks for microphysical statistics ---------------
+!------------------------------------------------------------------------- 
+!
+!------------------------------------------------------------------------- 
+!--------- Common blocks for constants initialized in GSMCONST ----------
+!
+      INTEGER, PARAMETER :: ITLO=-60, ITHI=40
+      INTEGER,INTENT(INOUT) :: NSTATS(ITLO:ITHI,4)
+      REAL,INTENT(INOUT) :: QMAX(ITLO:ITHI,5),QTOT(ITLO:ITHI,22) 
+!
+!------------------------------------------------------------------------- 
+!--------------- Common blocks for various lookup tables -----------------
+!
+!--- Discretized growth rates of small ice crystals after their nucleation 
+!     at 1 C intervals from -1 C to -35 C, based on calculations by Miller 
+!     and Young (1979, JAS) after 600 s of growth.  Resultant growth rates
+!     are multiplied by physics time step in GSMCONST.
+!
+!------------------------------------------------------------------------- 
+!
+!--- Mean ice-particle diameters varying from 50 microns to 1000 microns
+!      (1 mm), assuming an exponential size distribution.  
+!
+!---- Meaning of the following arrays: 
+!        - mdiam - mean diameter (m)
+!        - VENTI1 - integrated quantity associated w/ ventilation effects 
+!                   (capacitance only) for calculating vapor deposition onto ice
+!        - VENTI2 - integrated quantity associated w/ ventilation effects 
+!                   (with fall speed) for calculating vapor deposition onto ice
+!        - ACCRI  - integrated quantity associated w/ cloud water collection by ice
+!        - MASSI  - integrated quantity associated w/ ice mass 
+!        - VSNOWI - mass-weighted fall speed of snow (large ice), used to calculate 
+!                   precipitation rates
+!
+!
+!------------------------------------------------------------------------- 
+!
+!--- VEL_RF - velocity increase of rimed particles as functions of crude
+!      particle size categories (at 0.1 mm intervals of mean ice particle
+!      sizes) and rime factor (different values of Rime Factor of 1.1**N, 
+!      where N=0 to Nrime).
+!
+!------------------------------------------------------------------------- 
+!
+!--- Mean rain drop diameters varying from 50 microns (0.05 mm) to 450 microns 
+!      (0.45 mm), assuming an exponential size distribution.  
+!
+!------------------------------------------------------------------------- 
+!------- Key parameters, local variables, & important comments ---------
+!-----------------------------------------------------------------------
+!
+!--- TOLER => Tolerance or precision for accumulated precipitation 
+!
+      REAL, PARAMETER :: TOLER=5.E-7, C2=1./6., RHO0=1.194, Xratio=.025                                           
+!
+!--- If BLEND=1:
+!      precipitation (large) ice amounts are estimated at each level as a 
+!      blend of ice falling from the grid point above and the precip ice
+!      present at the start of the time step (see TOT_ICE below).
+!--- If BLEND=0:
+!      precipitation (large) ice amounts are estimated to be the precip
+!      ice present at the start of the time step.
+!
+!--- Extended to include sedimentation of rain on 2/5/01 
+!
+      REAL, PARAMETER :: BLEND=1.
+!
+!--- This variable is for debugging purposes (if .true.)
+!
+      LOGICAL, PARAMETER :: PRINT_diag=.FALSE.
+!
+!-----------------------------------------------------------------------
+!--- Local variables
+!-----------------------------------------------------------------------
+!
+      REAL EMAIRI, N0r, NLICE, NSmICE
+      LOGICAL CLEAR, ICE_logical, DBG_logical, RAIN_logical
+      INTEGER :: IDR,INDEX_MY,INDEXR,INDEXR1,INDEXS,IPASS,ITDX,IXRF,    &
+     &           IXS,LBEF,L
+!
+      REAL :: ABI,ABW,AIEVP,ARAINnew,ASNOWnew,BLDTRH,BUDGET,            &
+     &        CREVP,DELI,DELR,DELT,DELV,DELW,DENOMF,                    &
+     &        DENOMI,DENOMW,DENOMWI,DIDEP,                              &
+     &        DIEVP,DIFFUS,DLI,DTPH,DTRHO,DUM,DUM1,                     &
+     &        DUM2,DWV0,DWVI,DWVR,DYNVIS,ESI,ESW,FIR,FLARGE,FLIMASS,    &
+     &        FSMALL,FWR,FWS,GAMMAR,GAMMAS,                             &
+     &        PCOND,PIACR,PIACW,PIACWI,PIACWR,PICND,PIDEP,PIDEP_max,    &
+     &        PIEVP,PILOSS,PIMLT,PP,PRACW,PRAUT,PREVP,PRLOSS,           &
+     &        QI,QInew,QLICE,QR,QRnew,QSI,QSIgrd,QSInew,QSW,QSW0,       &
+     &        QSWgrd,QSWnew,QT,QTICE,QTnew,QTRAIN,QV,QW,QW0,QWnew,      &
+     &        RFACTOR,RHO,RIMEF,RIMEF1,RQR,RR,RRHO,SFACTOR,             &
+     &        TC,TCC,TFACTOR,THERM_COND,THICK,TK,TK2,TNEW,              &
+     &        TOT_ICE,TOT_ICEnew,TOT_RAIN,TOT_RAINnew,                  &
+     &        VEL_INC,VENTR,VENTIL,VENTIS,VRAIN1,VRAIN2,VRIMEF,VSNOW,   &
+     &        WC,WCnew,WSgrd,WS,WSnew,WV,WVnew,WVQW,                    &
+     &        XLF,XLF1,XLI,XLV,XLV1,XLV2,XLIMASS,XRF,XSIMASS          
+!
+!#######################################################################
+!########################## Begin Execution ############################
+!#######################################################################
+!
+!
+      ARAIN=0.                ! Accumulated rainfall into grid box from above (kg/m**2)
+      ASNOW=0.                ! Accumulated snowfall into grid box from above (kg/m**2)
+!
+!-----------------------------------------------------------------------
+!------------ Loop from top (L=1) to surface (L=LSFC) ------------------
+!-----------------------------------------------------------------------
+!
+
+      DO 10 L=1,LSFC
+
+!--- Skip this level and go to the next lower level if no condensate 
+!      and very low specific humidities
+!
+        IF (QV_col(L).LE.EPSQ .AND. WC_col(L).LE.EPSQ) GO TO 10
+!
+!-----------------------------------------------------------------------
+!------------ Proceed with cloud microphysics calculations -------------
+!-----------------------------------------------------------------------
+!
+          TK=T_col(L)         ! Temperature (deg K)
+          TC=TK-T0C           ! Temperature (deg C)
+          PP=P_col(L)         ! Pressure (Pa)
+          QV=QV_col(L)        ! Specific humidity of water vapor (kg/kg)
+          WV=QV/(1.-QV)       ! Water vapor mixing ratio (kg/kg)
+          WC=WC_col(L)        ! Grid-scale mixing ratio of total condensate (water or ice; kg/kg)
+!
+!-----------------------------------------------------------------------
+!--- Moisture variables below are mixing ratios & not specifc humidities
+!-----------------------------------------------------------------------
+!
+          CLEAR=.TRUE.
+!    
+!--- This check is to determine grid-scale saturation when no condensate is present
+!    
+          ESW=1000.*FPVS0(TK)              ! Saturation vapor pressure w/r/t water
+          QSW=EPS*ESW/(PP-ESW)             ! Saturation mixing ratio w/r/t water
+          WS=QSW                           ! General saturation mixing ratio (water/ice)
+          IF (TC .LT. 0.) THEN
+            ESI=1000.*FPVS(TK)             ! Saturation vapor pressure w/r/t ice
+            QSI=EPS*ESI/(PP-ESI)           ! Saturation mixing ratio w/r/t water
+            WS=QSI                         ! General saturation mixing ratio (water/ice)
+          ENDIF
+!
+!--- Effective grid-scale Saturation mixing ratios
+!
+          QSWgrd=RHgrd*QSW
+          QSIgrd=RHgrd*QSI
+          WSgrd=RHgrd*WS
+!
+!--- Check if air is subsaturated and w/o condensate
+!
+          IF (WV.GT.WSgrd .OR. WC.GT.EPSQ) CLEAR=.FALSE.
+!
+!--- Check if any rain is falling into layer from above
+!
+          IF (ARAIN .GT. CLIMIT) THEN
+            CLEAR=.FALSE.
+          ELSE
+            ARAIN=0.
+          ENDIF
+!
+!--- Check if any ice is falling into layer from above
+!
+!--- NOTE that "SNOW" in variable names is synonomous with 
+!    large, precipitation ice particles
+!
+          IF (ASNOW .GT. CLIMIT) THEN
+            CLEAR=.FALSE.
+          ELSE
+            ASNOW=0.
+          ENDIF
+!
+!-----------------------------------------------------------------------
+!-- Loop to the end if in clear, subsaturated air free of condensate ---
+!-----------------------------------------------------------------------
+!
+          IF (CLEAR) GO TO 10
+!
+!-----------------------------------------------------------------------
+!--------- Initialize RHO, THICK & microphysical processes -------------
+!-----------------------------------------------------------------------
+!
+!
+!--- Virtual temperature, TV=T*(1./EPS-1)*Q, Q is specific humidity;
+!    (see pp. 63-65 in Fleagle & Businger, 1963)
+!
+          RHO=PP/(RD*TK*(1.+EPS1*QV))   ! Air density (kg/m**3)
+          RRHO=1./RHO                ! Reciprocal of air density
+          DTRHO=DTPH*RHO             ! Time step * air density
+          BLDTRH=BLEND*DTRHO         ! Blend parameter * time step * air density
+          THICK=THICK_col(L)         ! Layer thickness = RHO*DZ = -DP/G = (Psfc-Ptop)*D_ETA/(G*ETA_sfc)
+!
+          ARAINnew=0.                ! Updated accumulated rainfall
+          ASNOWnew=0.                ! Updated accumulated snowfall
+          QI=QI_col(L)               ! Ice mixing ratio
+          QInew=0.                   ! Updated ice mixing ratio
+          QR=QR_col(L)               ! Rain mixing ratio
+          QRnew=0.                   ! Updated rain ratio
+          QW=QW_col(L)               ! Cloud water mixing ratio
+          QWnew=0.                   ! Updated cloud water ratio
+!
+          PCOND=0.                   ! Condensation (>0) or evaporation (<0) of cloud water (kg/kg)
+          PIDEP=0.                   ! Deposition (>0) or sublimation (<0) of ice crystals (kg/kg)
+          PIACW=0.                   ! Cloud water collection (riming) by precipitation ice (kg/kg; >0)
+          PIACWI=0.                  ! Growth of precip ice by riming (kg/kg; >0)
+          PIACWR=0.                  ! Shedding of accreted cloud water to form rain (kg/kg; >0)
+          PIACR=0.                   ! Freezing of rain onto large ice at supercooled temps (kg/kg; >0)
+          PICND=0.                   ! Condensation (>0) onto wet, melting ice (kg/kg)
+          PIEVP=0.                   ! Evaporation (<0) from wet, melting ice (kg/kg)
+          PIMLT=0.                   ! Melting ice (kg/kg; >0)
+          PRAUT=0.                   ! Cloud water autoconversion to rain (kg/kg; >0)
+          PRACW=0.                   ! Cloud water collection (accretion) by rain (kg/kg; >0)
+          PREVP=0.                   ! Rain evaporation (kg/kg; <0)
+!
+!--- Double check input hydrometeor mixing ratios
+!
+!          DUM=WC-(QI+QW+QR)
+!          DUM1=ABS(DUM)
+!          DUM2=TOLER*MIN(WC, QI+QW+QR)
+!          IF (DUM1 .GT. DUM2) THEN
+!            WRITE(6,"(/2(a,i4),a,i2)") '{@ i=',I_index,' j=',J_index,
+!     &                                 ' L=',L
+!            WRITE(6,"(4(a12,g11.4,1x))") 
+!     & '{@ TCold=',TC,'P=',.01*PP,'DIFF=',DUM,'WCold=',WC,
+!     & '{@ QIold=',QI,'QWold=',QW,'QRold=',QR
+!          ENDIF
+!
+!***********************************************************************
+!*********** MAIN MICROPHYSICS CALCULATIONS NOW FOLLOW! ****************
+!***********************************************************************
+!
+!--- Calculate a few variables, which are used more than once below
+!
+!--- Latent heat of vaporization as a function of temperature from
+!      Bolton (1980, JAS)
+!
+          XLV=3.148E6-2370*TK        ! Latent heat of vaporization (Lv)
+          XLF=XLS-XLV                ! Latent heat of fusion (Lf)
+          XLV1=XLV*RCP               ! Lv/Cp
+          XLF1=XLF*RCP               ! Lf/Cp
+          TK2=1./(TK*TK)             ! 1./TK**2
+          XLV2=XLV*XLV*QSW*TK2/RV    ! Lv**2*Qsw/(Rv*TK**2)
+          DENOMW=1.+XLV2*RCP         ! Denominator term, Clausius-Clapeyron correction
+!
+!--- Basic thermodynamic quantities
+!      * DYNVIS - dynamic viscosity  [ kg/(m*s) ]
+!      * THERM_COND - thermal conductivity  [ J/(m*s*K) ]
+!      * DIFFUS - diffusivity of water vapor  [ m**2/s ]
+!
+          TFACTOR=TK**1.5/(TK+120.)
+          DYNVIS=1.496E-6*TFACTOR
+          THERM_COND=2.116E-3*TFACTOR
+          DIFFUS=8.794E-5*TK**1.81/PP
+!
+!--- Air resistance term for the fall speed of ice following the
+!      basic research by Heymsfield, Kajikawa, others 
+!
+          GAMMAS=(1.E5/PP)**C1
+!
+!--- Air resistance for rain fall speed (Beard, 1985, JAS, p.470)
+!
+          GAMMAR=(RHO0/RHO)**.4
+!
+!----------------------------------------------------------------------
+!-------------  IMPORTANT MICROPHYSICS DECISION TREE  -----------------
+!----------------------------------------------------------------------
+!
+!--- Determine if conditions supporting ice are present
+!
+          IF (TC.LT.0. .OR. QI.GT. EPSQ .OR. ASNOW.GT.CLIMIT) THEN
+            ICE_logical=.TRUE.
+          ELSE
+            ICE_logical=.FALSE.
+            QLICE=0.
+            QTICE=0.
+          ENDIF
+!
+!--- Determine if rain is present
+!
+          RAIN_logical=.FALSE.
+          IF (ARAIN.GT.CLIMIT .OR. QR.GT.EPSQ) RAIN_logical=.TRUE.
+!
+          IF (ICE_logical) THEN
+!
+!--- IMPORTANT:  Estimate time-averaged properties.
+!
+!---
+!  * FLARGE  - ratio of number of large ice to total (large & small) ice
+!  * FSMALL  - ratio of number of small ice crystals to large ice particles
+!  ->  Small ice particles are assumed to have a mean diameter of 50 microns.
+!  * XSIMASS - used for calculating small ice mixing ratio
+!---
+!  * TOT_ICE - total mass (small & large) ice before microphysics,
+!              which is the sum of the total mass of large ice in the 
+!              current layer and the input flux of ice from above
+!  * PILOSS  - greatest loss (<0) of total (small & large) ice by
+!              sublimation, removing all of the ice falling from above
+!              and the ice within the layer
+!  * RimeF1  - Rime Factor, which is the mass ratio of total (unrimed & rimed) 
+!              ice mass to the unrimed ice mass (>=1)
+!  * VrimeF  - the velocity increase due to rime factor or melting (ratio, >=1)
+!  * VSNOW   - Fall speed of rimed snow w/ air resistance correction
+!  * EMAIRI  - equivalent mass of air associated layer and with fall of snow into layer
+!  * XLIMASS - used for calculating large ice mixing ratio
+!  * FLIMASS - mass fraction of large ice
+!  * QTICE   - time-averaged mixing ratio of total ice
+!  * QLICE   - time-averaged mixing ratio of large ice
+!  * NLICE   - time-averaged number concentration of large ice
+!  * NSmICE  - number concentration of small ice crystals at current level
+!---
+!--- Assumed number fraction of large ice particles to total (large & small) 
+!    ice particles, which is based on a general impression of the literature.
+!
+            WVQW=WV+QW                ! Water vapor & cloud water
+!
+
+
+            IF (TC.GE.0. .OR. WVQW.LT.QSIgrd) THEN
+   !
+   !--- Eliminate small ice particle contributions for melting & sublimation
+   !
+              FLARGE=FLARGE1
+            ELSE
+   !
+   !--- Enhanced number of small ice particles during depositional growth
+   !    (effective only when 0C > T >= T_ice [-10C] )
+   !
+              FLARGE=FLARGE2
+   !
+   !--- Larger number of small ice particles due to rime splintering
+   !
+              IF (TC.GE.-8. .AND. TC.LE.-3.) FLARGE=.5*FLARGE
+!
+            ENDIF            ! End IF (TC.GE.0. .OR. WVQW.LT.QSIgrd)
+            FSMALL=(1.-FLARGE)/FLARGE
+            XSIMASS=RRHO*MASSI(MDImin)*FSMALL
+            IF (QI.LE.EPSQ .AND. ASNOW.LE.CLIMIT) THEN
+              INDEXS=MDImin
+              TOT_ICE=0.
+              PILOSS=0.
+              RimeF1=1.
+              VrimeF=1.
+              VEL_INC=GAMMAS
+              VSNOW=0.
+              EMAIRI=THICK
+              XLIMASS=RRHO*RimeF1*MASSI(INDEXS)
+              FLIMASS=XLIMASS/(XLIMASS+XSIMASS)
+              QLICE=0.
+              QTICE=0.
+              NLICE=0.
+              NSmICE=0.
+            ELSE
+   !
+   !--- For T<0C mean particle size follows Houze et al. (JAS, 1979, p. 160), 
+   !    converted from Fig. 5 plot of LAMDAs.  Similar set of relationships 
+   !    also shown in Fig. 8 of Ryan (BAMS, 1996, p. 66).
+   !
+              DUM=XMImax*EXP(.0536*TC)
+              INDEXS=MIN(MDImax, MAX(MDImin, INT(DUM) ) )
+              TOT_ICE=THICK*QI+BLEND*ASNOW
+              PILOSS=-TOT_ICE/THICK
+              LBEF=MAX(1,L-1)
+              DUM1=RimeF_col(LBEF)
+              DUM2=RimeF_col(L)
+              RimeF1=(DUM2*THICK*QI+DUM1*BLEND*ASNOW)/TOT_ICE
+              RimeF1=MIN(RimeF1, RFmax)
+              DO IPASS=0,1
+                IF (RimeF1 .LE. 1.) THEN
+                  RimeF1=1.
+                  VrimeF=1.
+                ELSE
+                  IXS=MAX(2, MIN(INDEXS/100, 9))
+                  XRF=10.492*ALOG(RimeF1)
+                  IXRF=MAX(0, MIN(INT(XRF), Nrime))
+                  IF (IXRF .GE. Nrime) THEN
+                    VrimeF=VEL_RF(IXS,Nrime)
+                  ELSE
+                    VrimeF=VEL_RF(IXS,IXRF)+(XRF-FLOAT(IXRF))*          &
+     &                    (VEL_RF(IXS,IXRF+1)-VEL_RF(IXS,IXRF))
+                  ENDIF
+                ENDIF            ! End IF (RimeF1 .LE. 1.)
+                VEL_INC=GAMMAS*VrimeF
+                VSNOW=VEL_INC*VSNOWI(INDEXS)
+                EMAIRI=THICK+BLDTRH*VSNOW
+                XLIMASS=RRHO*RimeF1*MASSI(INDEXS)
+                FLIMASS=XLIMASS/(XLIMASS+XSIMASS)
+                QTICE=TOT_ICE/EMAIRI
+                QLICE=FLIMASS*QTICE
+                NLICE=QLICE/XLIMASS
+                NSmICE=Fsmall*NLICE
+   !
+                IF ( (NLICE.GE.NLImin .AND. NLICE.LE.NLImax)            &
+     &                .OR. IPASS.EQ.1) THEN
+                  EXIT
+                ELSE
+        !
+        !--- Reduce excessive accumulation of ice at upper levels
+        !    associated with strong grid-resolved ascent
+        !
+        !--- Force NLICE to be between NLImin and NLImax
+        !
+                  DUM=MAX(NLImin, MIN(NLImax, NLICE) )
+                  XLI=RHO*(QTICE/DUM-XSIMASS)/RimeF1
+                  IF (XLI .LE. MASSI(MDImin) ) THEN
+                    INDEXS=MDImin
+                  ELSE IF (XLI .LE. MASSI(450) ) THEN
+                    DLI=9.5885E5*XLI**.42066         ! DLI in microns
+                    INDEXS=MIN(MDImax, MAX(MDImin, INT(DLI) ) )
+                  ELSE IF (XLI .LE. MASSI(MDImax) ) THEN
+                    DLI=3.9751E6*XLI**.49870         ! DLI in microns
+                    INDEXS=MIN(MDImax, MAX(MDImin, INT(DLI) ) )
+                  ELSE 
+                    INDEXS=MDImax
+           !
+           !--- 8/22/01: Increase density of large ice if maximum limits 
+           !    are reached for number concentration (NLImax) and mean size 
+           !    (MDImax).  Done to increase fall out of ice.
+           !
+                    IF (DUM .GE. NLImax)                                &
+     &                RimeF1=RHO*(QTICE/NLImax-XSIMASS)/MASSI(INDEXS)
+                  ENDIF             ! End IF (XLI .LE. MASSI(MDImin) ) 
+!            WRITE(6,"(4(a12,g11.4,1x))") 
+!     & '{$ TC=',TC,'P=',.01*PP,'NLICE=',NLICE,'DUM=',DUM,
+!     & '{$ XLI=',XLI,'INDEXS=',FLOAT(INDEXS),'RHO=',RHO,'QTICE=',QTICE,
+!     & '{$ XSIMASS=',XSIMASS,'RimeF1=',RimeF1
+                ENDIF                  ! End IF ( (NLICE.GE.NLImin .AND. NLICE.LE.NLImax) ...
+              ENDDO                    ! End DO IPASS=0,1
+            ENDIF                      ! End IF (QI.LE.EPSQ .AND. ASNOW.LE.CLIMIT)
+          ENDIF                        ! End IF (ICE_logical)
+!
+!----------------------------------------------------------------------
+!--------------- Calculate individual processes -----------------------
+!----------------------------------------------------------------------
+!
+!--- Cloud water autoconversion to rain and collection by rain
+!
+          IF (QW.GT.EPSQ .AND. TC.GE.T_ICE) THEN
+   !
+   !--- QW0 could be modified based on land/sea properties, 
+   !      presence of convection, etc.  This is why QAUT0 and CRAUT
+   !      are passed into the subroutine as externally determined
+   !      parameters.  Can be changed in the future if desired.
+   !
+            QW0=QAUT0*RRHO
+            PRAUT=MAX(0., QW-QW0)*CRAUT
+            IF (QLICE .GT. EPSQ) THEN
+      !
+      !--- Collection of cloud water by large ice particles ("snow")
+      !    PIACWI=PIACW for riming, PIACWI=0 for shedding
+      !
+              FWS=MIN(1., CIACW*VEL_INC*NLICE*ACCRI(INDEXS)/PP**C1)
+              PIACW=FWS*QW
+              IF (TC .LT. 0.) PIACWI=PIACW    ! Large ice riming
+            ENDIF           ! End IF (QLICE .GT. EPSQ)
+          ENDIF             ! End IF (QW.GT.EPSQ .AND. TC.GE.T_ICE)
+!
+!----------------------------------------------------------------------
+!--- Loop around some of the ice-phase processes if no ice should be present
+!----------------------------------------------------------------------
+!
+          IF (ICE_logical .EQV. .FALSE.) GO TO 20
+!
+!--- Now the pretzel logic of calculating ice deposition
+!
+          IF (TC.LT.T_ICE .AND. (WV.GT.QSIgrd .OR. QW.GT.EPSQ)) THEN
+   !
+   !--- Adjust to ice saturation at T<T_ICE (-10C) if supersaturated.
+   !    Sources of ice due to nucleation and convective detrainment are
+   !    either poorly understood, poorly resolved at typical NWP 
+   !    resolutions, or are not represented (e.g., no detrained 
+   !    condensate in BMJ Cu scheme).
+   !    
+            PCOND=-QW
+            DUM1=TK+XLV1*PCOND                 ! Updated (dummy) temperature (deg K)
+            DUM2=WV+QW                         ! Updated (dummy) water vapor mixing ratio
+            DUM=1000.*FPVS(DUM1)               ! Updated (dummy) saturation vapor pressure w/r/t ice
+            DUM=RHgrd*EPS*DUM/(PP-DUM)         ! Updated (dummy) saturation mixing ratio w/r/t ice
+            IF (DUM2 .GT. DUM) PIDEP=DEPOSIT (PP, DUM1, DUM2)
+            DWVi=0.    ! Used only for debugging
+   !
+          ELSE IF (TC .LT. 0.) THEN
+   !
+   !--- These quantities are handy for ice deposition/sublimation
+   !    PIDEP_max - max deposition or minimum sublimation to ice saturation
+   !
+            DENOMI=1.+XLS2*QSI*TK2
+            DWVi=MIN(WVQW,QSW)-QSI
+            PIDEP_max=MAX(PILOSS, DWVi/DENOMI)
+            IF (QTICE .GT. 0.) THEN
+      !
+      !--- Calculate ice deposition/sublimation
+      !      * SFACTOR - [VEL_INC**.5]*[Schmidt**(1./3.)]*[(RHO/DYNVIS)**.5],
+      !        where Schmidt (Schmidt Number) =DYNVIS/(RHO*DIFFUS)
+      !      * Units: SFACTOR - s**.5/m ;  ABI - m**2/s ;  NLICE - m**-3 ;
+      !               VENTIL, VENTIS - m**-2 ;  VENTI1 - m ;  
+      !               VENTI2 - m**2/s**.5 ; DIDEP - unitless
+      !
+              SFACTOR=VEL_INC**.5*(RHO/(DIFFUS*DIFFUS*DYNVIS))**C2
+              ABI=1./(RHO*XLS3*QSI*TK2/THERM_COND+1./DIFFUS)
+      !
+      !--- VENTIL - Number concentration * ventilation factors for large ice
+      !--- VENTIS - Number concentration * ventilation factors for small ice
+      !
+      !--- Variation in the number concentration of ice with time is not
+      !      accounted for in these calculations (could be in the future).
+      !
+              VENTIL=(VENTI1(INDEXS)+SFACTOR*VENTI2(INDEXS))*NLICE
+              VENTIS=(VENTI1(MDImin)+SFACTOR*VENTI2(MDImin))*NSmICE
+              DIDEP=ABI*(VENTIL+VENTIS)*DTPH
+      !
+      !--- Account for change in water vapor supply w/ time
+      !
+              IF (DIDEP .GE. Xratio)then
+                DIDEP=(1.-EXP(-DIDEP*DENOMI))/DENOMI
+              endif
+              IF (DWVi .GT. 0.) THEN
+                PIDEP=MIN(DWVi*DIDEP, PIDEP_max)
+              ELSE IF (DWVi .LT. 0.) THEN
+                PIDEP=MAX(DWVi*DIDEP, PIDEP_max)
+              ENDIF
+      !
+            ELSE IF (WVQW.GT.QSI .AND. TC.LE.T_ICE_init) THEN
+      !
+      !--- Ice nucleation in near water-saturated conditions.  Ice crystal
+      !    growth during time step calculated using Miller & Young (1979, JAS).
+      !--- These deposition rates could drive conditions below water saturation,
+      !    which is the basis of these calculations.  Intended to approximate
+      !    more complex & computationally intensive calculations.
+      !
+              INDEX_MY=MAX(MY_T1, MIN( INT(.5-TC), MY_T2 ) )
+      !
+      !--- DUM1 is the supersaturation w/r/t ice at water-saturated conditions
+      !
+      !--- DUM2 is the number of ice crystals nucleated at water-saturated 
+      !    conditions based on Meyers et al. (JAM, 1992).
+      !
+      !--- Prevent unrealistically large ice initiation (limited by PIDEP_max)
+      !      if DUM2 values are increased in future experiments
+      !
+              DUM1=QSW/QSI-1.      
+              DUM2=1.E3*EXP(12.96*DUM1-.639)
+              PIDEP=MIN(PIDEP_max, DUM2*MY_GROWTH(INDEX_MY)*RRHO)
+      !
+            ENDIF       ! End IF (QTICE .GT. 0.)
+   !
+          ENDIF         ! End IF (TC.LT.T_ICE .AND. (WV.GT.QSIgrd .OR. QW.GT.EPSQ))
+!
+!------------------------------------------------------------------------
+!
+20      CONTINUE     ! Jump here if conditions for ice are not present
+
+
+!
+!------------------------------------------------------------------------
+!
+!--- Cloud water condensation
+!
+          IF (TC.GE.T_ICE .AND. (QW.GT.EPSQ .OR. WV.GT.QSWgrd)) THEN
+            IF (PIACWI.EQ.0. .AND. PIDEP.EQ.0.) THEN
+              PCOND=CONDENSE (PP, QW, TK, WV)
+            ELSE
+   !
+   !--- Modify cloud condensation in response to ice processes
+   !
+              DUM=XLV*QSWgrd*RCPRV*TK2
+              DENOMWI=1.+XLS*DUM
+              DENOMF=XLF*DUM
+              DUM=MAX(0., PIDEP)
+              PCOND=(WV-QSWgrd-DENOMWI*DUM-DENOMF*PIACWI)/DENOMW
+              DUM1=-QW
+              DUM2=PCOND-PIACW
+              IF (DUM2 .LT. DUM1) THEN
+      !
+      !--- Limit cloud water sinks
+      !
+                DUM=DUM1/DUM2
+                PCOND=DUM*PCOND
+                PIACW=DUM*PIACW
+                PIACWI=DUM*PIACWI
+              ENDIF        ! End IF (DUM2 .LT. DUM1)
+            ENDIF          ! End IF (PIACWI.EQ.0. .AND. PIDEP.EQ.0.)
+          ENDIF            ! End IF (TC.GE.T_ICE .AND. (QW.GT.EPSQ .OR. WV.GT.QSWgrd))
+!
+!--- Limit freezing of accreted rime to prevent temperature oscillations,
+!    a crude Schumann-Ludlam limit (p. 209 of Young, 1993). 
+!
+          TCC=TC+XLV1*PCOND+XLS1*PIDEP+XLF1*PIACWI
+          IF (TCC .GT. 0.) THEN
+            PIACWI=0.
+            TCC=TC+XLV1*PCOND+XLS1*PIDEP
+          ENDIF
+          IF (TC.GT.0. .AND. TCC.GT.0. .AND. ICE_logical) THEN
+   !
+   !--- Calculate melting and evaporation/condensation
+   !      * Units: SFACTOR - s**.5/m ;  ABI - m**2/s ;  NLICE - m**-3 ;
+   !               VENTIL - m**-2 ;  VENTI1 - m ;  
+   !               VENTI2 - m**2/s**.5 ; CIEVP - /s
+   !
+            SFACTOR=VEL_INC**.5*(RHO/(DIFFUS*DIFFUS*DYNVIS))**C2
+            VENTIL=NLICE*(VENTI1(INDEXS)+SFACTOR*VENTI2(INDEXS))
+            AIEVP=VENTIL*DIFFUS*DTPH
+            IF (AIEVP .LT. Xratio) THEN
+              DIEVP=AIEVP
+            ELSE
+              DIEVP=1.-EXP(-AIEVP)
+            ENDIF
+            QSW0=EPS*ESW0/(PP-ESW0)
+            DWV0=MIN(WV,QSW)-QSW0
+            DUM=QW+PCOND
+            IF (WV.LT.QSW .AND. DUM.LE.EPSQ) THEN
+   !
+   !--- Evaporation from melting snow (sink of snow) or shedding
+   !    of water condensed onto melting snow (source of rain)
+   !
+              DUM=DWV0*DIEVP
+              PIEVP=MAX( MIN(0., DUM), PILOSS)
+              PICND=MAX(0., DUM)
+            ENDIF            ! End IF (WV.LT.QSW .AND. DUM.LE.EPSQ)
+            PIMLT=THERM_COND*TCC*VENTIL*RRHO*DTPH/XLF
+   !
+   !--- Limit melting to prevent temperature oscillations across 0C
+   !
+            DUM1=MAX( 0., (TCC+XLV1*PIEVP)/XLF1 )
+            PIMLT=MIN(PIMLT, DUM1)
+   !
+   !--- Limit loss of snow by melting (>0) and evaporation
+   !
+            DUM=PIEVP-PIMLT
+            IF (DUM .LT. PILOSS) THEN
+              DUM1=PILOSS/DUM
+              PIMLT=PIMLT*DUM1
+              PIEVP=PIEVP*DUM1
+            ENDIF           ! End IF (DUM .GT. QTICE)
+          ENDIF             ! End IF (TC.GT.0. .AND. TCC.GT.0. .AND. ICE_logical) 
+!
+!--- IMPORTANT:  Estimate time-averaged properties.
+!
+!  * TOT_RAIN - total mass of rain before microphysics, which is the sum of
+!               the total mass of rain in the current layer and the input 
+!               flux of rain from above
+!  * VRAIN1   - fall speed of rain into grid from above (with air resistance correction)
+!  * QTRAIN   - time-averaged mixing ratio of rain (kg/kg)
+!  * PRLOSS   - greatest loss (<0) of rain, removing all rain falling from
+!               above and the rain within the layer
+!  * RQR      - rain content (kg/m**3)
+!  * INDEXR   - mean size of rain drops to the nearest 1 micron in size
+!  * N0r      - intercept of rain size distribution (typically 10**6 m**-4)
+!
+          TOT_RAIN=0.
+          VRAIN1=0.
+          QTRAIN=0.
+          PRLOSS=0.
+          RQR=0.
+          N0r=0.
+          INDEXR1=0
+          INDEXR=MDRmin
+          IF (RAIN_logical) THEN
+            IF (ARAIN .LE. 0.) THEN
+              INDEXR=MDRmin
+              VRAIN1=0.
+            ELSE
+   !
+   !--- INDEXR (related to mean diameter) & N0r could be modified 
+   !      by land/sea properties, presence of convection, etc.
+   !
+   !--- Rain rate normalized to a density of 1.194 kg/m**3
+   !
+              RR=ARAIN/(DTPH*GAMMAR)
+   !
+              IF (RR .LE. RR_DRmin) THEN
+        !
+        !--- Assume fixed mean diameter of rain (0.2 mm) for low rain rates, 
+        !      instead vary N0r with rain rate
+        !
+                INDEXR=MDRmin
+              ELSE IF (RR .LE. RR_DR1) THEN
+        !
+        !--- Best fit to mass-weighted fall speeds (V) from rain lookup tables 
+        !      for mean diameters (Dr) between 0.05 and 0.10 mm:
+        !      V(Dr)=5.6023e4*Dr**1.136, V in m/s and Dr in m
+        !      RR = PI*1000.*N0r0*5.6023e4*Dr**(4+1.136) = 1.408e15*Dr**5.136,
+        !        RR in kg/(m**2*s)
+        !      Dr (m) = 1.123e-3*RR**.1947 -> Dr (microns) = 1.123e3*RR**.1947
+        !
+                INDEXR=INT( 1.123E3*RR**.1947 + .5 )
+                INDEXR=MAX( MDRmin, MIN(INDEXR, MDR1) )
+              ELSE IF (RR .LE. RR_DR2) THEN
+        !
+        !--- Best fit to mass-weighted fall speeds (V) from rain lookup tables 
+        !      for mean diameters (Dr) between 0.10 and 0.20 mm:
+        !      V(Dr)=1.0867e4*Dr**.958, V in m/s and Dr in m
+        !      RR = PI*1000.*N0r0*1.0867e4*Dr**(4+.958) = 2.731e14*Dr**4.958,
+        !        RR in kg/(m**2*s)
+        !      Dr (m) = 1.225e-3*RR**.2017 -> Dr (microns) = 1.225e3*RR**.2017
+        !
+                INDEXR=INT( 1.225E3*RR**.2017 + .5 )
+                INDEXR=MAX( MDR1, MIN(INDEXR, MDR2) )
+              ELSE IF (RR .LE. RR_DR3) THEN
+        !
+        !--- Best fit to mass-weighted fall speeds (V) from rain lookup tables 
+        !      for mean diameters (Dr) between 0.20 and 0.32 mm:
+        !      V(Dr)=2831.*Dr**.80, V in m/s and Dr in m
+        !      RR = PI*1000.*N0r0*2831.*Dr**(4+.80) = 7.115e13*Dr**4.80, 
+        !        RR in kg/(m**2*s)
+        !      Dr (m) = 1.3006e-3*RR**.2083 -> Dr (microns) = 1.3006e3*RR**.2083
+        !
+                INDEXR=INT( 1.3006E3*RR**.2083 + .5 )
+                INDEXR=MAX( MDR2, MIN(INDEXR, MDR3) )
+              ELSE IF (RR .LE. RR_DRmax) THEN
+        !
+        !--- Best fit to mass-weighted fall speeds (V) from rain lookup tables 
+        !      for mean diameters (Dr) between 0.32 and 0.45 mm:
+        !      V(Dr)=944.8*Dr**.6636, V in m/s and Dr in m
+        !      RR = PI*1000.*N0r0*944.8*Dr**(4+.6636) = 2.3745e13*Dr**4.6636,
+        !        RR in kg/(m**2*s)
+        !      Dr (m) = 1.355e-3*RR**.2144 -> Dr (microns) = 1.355e3*RR**.2144
+        !
+                INDEXR=INT( 1.355E3*RR**.2144 + .5 )
+                INDEXR=MAX( MDR3, MIN(INDEXR, MDRmax) )
+              ELSE 
+        !
+        !--- Assume fixed mean diameter of rain (0.45 mm) for high rain rates, 
+        !      instead vary N0r with rain rate
+        !
+                INDEXR=MDRmax
+              ENDIF              ! End IF (RR .LE. RR_DRmin) etc. 
+              VRAIN1=GAMMAR*VRAIN(INDEXR)
+            ENDIF              ! End IF (ARAIN .LE. 0.)
+            INDEXR1=INDEXR     ! For debugging only
+            TOT_RAIN=THICK*QR+BLEND*ARAIN
+            QTRAIN=TOT_RAIN/(THICK+BLDTRH*VRAIN1)
+            PRLOSS=-TOT_RAIN/THICK
+            RQR=RHO*QTRAIN
+   !
+   !--- RQR - time-averaged rain content (kg/m**3)
+   !
+            IF (RQR .LE. RQR_DRmin) THEN
+              N0r=MAX(N0rmin, CN0r_DMRmin*RQR)
+              INDEXR=MDRmin
+            ELSE IF (RQR .GE. RQR_DRmax) THEN
+              N0r=CN0r_DMRmax*RQR
+              INDEXR=MDRmax
+            ELSE
+              N0r=N0r0
+              INDEXR=MAX( XMRmin, MIN(CN0r0*RQR**.25, XMRmax) )
+            ENDIF
+   !
+            IF (TC .LT. T_ICE) THEN
+              PIACR=-PRLOSS
+            ELSE
+              DWVr=WV-PCOND-QSW
+              DUM=QW+PCOND
+              IF (DWVr.LT.0. .AND. DUM.LE.EPSQ) THEN
+      !
+      !--- Rain evaporation
+      !
+      !    * RFACTOR - [GAMMAR**.5]*[Schmidt**(1./3.)]*[(RHO/DYNVIS)**.5],
+      !        where Schmidt (Schmidt Number) =DYNVIS/(RHO*DIFFUS)
+      !
+      !    * Units: RFACTOR - s**.5/m ;  ABW - m**2/s ;  VENTR - m**-2 ;  
+      !             N0r - m**-4 ;  VENTR1 - m**2 ;  VENTR2 - m**3/s**.5 ;
+      !             CREVP - unitless
+      !
+                RFACTOR=GAMMAR**.5*(RHO/(DIFFUS*DIFFUS*DYNVIS))**C2
+                ABW=1./(RHO*XLV2/THERM_COND+1./DIFFUS)
+      !
+      !--- Note that VENTR1, VENTR2 lookup tables do not include the 
+      !      1/Davg multiplier as in the ice tables
+      !
+                VENTR=N0r*(VENTR1(INDEXR)+RFACTOR*VENTR2(INDEXR))
+                CREVP=ABW*VENTR*DTPH
+                IF (CREVP .LT. Xratio) THEN
+                  DUM=DWVr*CREVP
+                ELSE
+                  DUM=DWVr*(1.-EXP(-CREVP*DENOMW))/DENOMW
+                ENDIF
+                PREVP=MAX(DUM, PRLOSS)
+              ELSE IF (QW .GT. EPSQ) THEN
+                FWR=CRACW*GAMMAR*N0r*ACCRR(INDEXR)
+                PRACW=MIN(1.,FWR)*QW
+              ENDIF           ! End IF (DWVr.LT.0. .AND. DUM.LE.EPSQ)
+      !
+              IF (TC.LT.0. .AND. TCC.LT.0.) THEN
+         !
+         !--- Biggs (1953) heteorogeneous freezing (e.g., Lin et al., 1983)
+         !   - Rescaled mean drop diameter from microns (INDEXR) to mm (DUM) to prevent underflow
+         !
+                DUM=.001*FLOAT(INDEXR)
+                DUM=(EXP(ABFR*TC)-1.)*DUM*DUM*DUM*DUM*DUM*DUM*DUM
+                PIACR=MIN(CBFR*N0r*RRHO*DUM, QTRAIN)
+                IF (QLICE .GT. EPSQ) THEN
+            !
+            !--- Freezing of rain by collisions w/ large ice
+            !
+                  DUM=GAMMAR*VRAIN(INDEXR)
+                  DUM1=DUM-VSNOW
+            !
+            !--- DUM2 - Difference in spectral fall speeds of rain and
+            !      large ice, parameterized following eq. (48) on p. 112 of 
+            !      Murakami (J. Meteor. Soc. Japan, 1990)
+            !
+                  DUM2=(DUM1*DUM1+.04*DUM*VSNOW)**.5
+                  DUM1=5.E-12*INDEXR*INDEXR+2.E-12*INDEXR*INDEXS        &
+     &                 +.5E-12*INDEXS*INDEXS
+                  FIR=MIN(1., CIACR*NLICE*DUM1*DUM2)
+            !
+            !--- Future?  Should COLLECTION BY SMALL ICE SHOULD BE INCLUDED???
+            !
+                  PIACR=MIN(PIACR+FIR*QTRAIN, QTRAIN)
+                ENDIF        ! End IF (QLICE .GT. EPSQ)
+                DUM=PREVP-PIACR
+                If (DUM .LT. PRLOSS) THEN
+                  DUM1=PRLOSS/DUM
+                  PREVP=DUM1*PREVP
+                  PIACR=DUM1*PIACR
+                ENDIF        ! End If (DUM .LT. PRLOSS)
+              ENDIF          ! End IF (TC.LT.0. .AND. TCC.LT.0.)
+            ENDIF            ! End IF (TC .LT. T_ICE)
+          ENDIF              ! End IF (RAIN_logical) 
+!
+!----------------------------------------------------------------------
+!---------------------- Main Budget Equations -------------------------
+!----------------------------------------------------------------------
+!
+!
+!-----------------------------------------------------------------------
+!--- Update fields, determine characteristics for next lower layer ----
+!-----------------------------------------------------------------------
+!
+!--- Carefully limit sinks of cloud water
+!
+          DUM1=PIACW+PRAUT+PRACW-MIN(0.,PCOND)
+          IF (DUM1 .GT. QW) THEN
+            DUM=QW/DUM1
+            PIACW=DUM*PIACW
+            PIACWI=DUM*PIACWI
+            PRAUT=DUM*PRAUT
+            PRACW=DUM*PRACW
+            IF (PCOND .LT. 0.) PCOND=DUM*PCOND
+          ENDIF
+          PIACWR=PIACW-PIACWI          ! TC >= 0C
+!
+!--- QWnew - updated cloud water mixing ratio
+!
+          DELW=PCOND-PIACW-PRAUT-PRACW
+          QWnew=QW+DELW
+          IF (QWnew .LE. EPSQ) QWnew=0.
+          IF (QW.GT.0. .AND. QWnew.NE.0.) THEN
+            DUM=QWnew/QW
+            IF (DUM .LT. TOLER) QWnew=0.
+          ENDIF
+!
+!--- Update temperature and water vapor mixing ratios
+!
+          DELT= XLV1*(PCOND+PIEVP+PICND+PREVP)                          &
+     &         +XLS1*PIDEP+XLF1*(PIACWI+PIACR-PIMLT)
+          Tnew=TK+DELT
+!
+          DELV=-PCOND-PIDEP-PIEVP-PICND-PREVP
+          WVnew=WV+DELV
+!
+!--- Update ice mixing ratios
+!
+!---
+!  * TOT_ICEnew - total mass (small & large) ice after microphysics,
+!                 which is the sum of the total mass of large ice in the 
+!                 current layer and the flux of ice out of the grid box below
+!  * RimeF      - Rime Factor, which is the mass ratio of total (unrimed & 
+!                 rimed) ice mass to the unrimed ice mass (>=1)
+!  * QInew      - updated mixing ratio of total (large & small) ice in layer
+!      -> TOT_ICEnew=QInew*THICK+BLDTRH*QLICEnew*VSNOW
+!        -> But QLICEnew=QInew*FLIMASS, so
+!      -> TOT_ICEnew=QInew*(THICK+BLDTRH*FLIMASS*VSNOW)
+!  * ASNOWnew   - updated accumulation of snow at bottom of grid cell
+!---
+!
+          DELI=0.
+          RimeF=1.
+          IF (ICE_logical) THEN
+            DELI=PIDEP+PIEVP+PIACWI+PIACR-PIMLT
+            TOT_ICEnew=TOT_ICE+THICK*DELI
+            IF (TOT_ICE.GT.0. .AND. TOT_ICEnew.NE.0.) THEN
+              DUM=TOT_ICEnew/TOT_ICE
+              IF (DUM .LT. TOLER) TOT_ICEnew=0.
+            ENDIF
+            IF (TOT_ICEnew .LE. CLIMIT) THEN
+              TOT_ICEnew=0.
+              RimeF=1.
+              QInew=0.
+              ASNOWnew=0.
+            ELSE
+      !
+      !--- Update rime factor if appropriate
+      !
+              DUM=PIACWI+PIACR
+              IF (DUM.LE.EPSQ .AND. PIDEP.LE.EPSQ) THEN
+                RimeF=RimeF1
+              ELSE
+         !
+         !--- Rime Factor, RimeF = (Total ice mass)/(Total unrimed ice mass)
+         !      DUM1 - Total ice mass, rimed & unrimed
+         !      DUM2 - Estimated mass of *unrimed* ice
+         !
+                DUM1=TOT_ICE+THICK*(PIDEP+DUM)
+                DUM2=TOT_ICE/RimeF1+THICK*PIDEP
+                IF (DUM2 .LE. 0.) THEN
+                  RimeF=RFmax
+                ELSE
+                  RimeF=MIN(RFmax, MAX(1., DUM1/DUM2) )
+                ENDIF
+              ENDIF       ! End IF (DUM.LE.EPSQ .AND. PIDEP.LE.EPSQ)
+              QInew=TOT_ICEnew/(THICK+BLDTRH*FLIMASS*VSNOW)
+              IF (QInew .LE. EPSQ) QInew=0.
+              IF (QI.GT.0. .AND. QInew.NE.0.) THEN
+                DUM=QInew/QI
+                IF (DUM .LT. TOLER) QInew=0.
+              ENDIF
+              ASNOWnew=BLDTRH*FLIMASS*VSNOW*QInew
+              IF (ASNOW.GT.0. .AND. ASNOWnew.NE.0.) THEN
+                DUM=ASNOWnew/ASNOW
+                IF (DUM .LT. TOLER) ASNOWnew=0.
+              ENDIF
+            ENDIF         ! End IF (TOT_ICEnew .LE. CLIMIT)
+          ENDIF           ! End IF (ICE_logical)
+
+
+!
+!--- Update rain mixing ratios
+!
+!---
+! * TOT_RAINnew - total mass of rain after microphysics
+!                 current layer and the input flux of ice from above
+! * VRAIN2      - time-averaged fall speed of rain in grid and below 
+!                 (with air resistance correction)
+! * QRnew       - updated rain mixing ratio in layer
+!      -> TOT_RAINnew=QRnew*(THICK+BLDTRH*VRAIN2)
+!  * ARAINnew  - updated accumulation of rain at bottom of grid cell
+!---
+!
+          DELR=PRAUT+PRACW+PIACWR-PIACR+PIMLT+PREVP+PICND
+          TOT_RAINnew=TOT_RAIN+THICK*DELR
+          IF (TOT_RAIN.GT.0. .AND. TOT_RAINnew.NE.0.) THEN
+            DUM=TOT_RAINnew/TOT_RAIN
+            IF (DUM .LT. TOLER) TOT_RAINnew=0.
+          ENDIF
+          IF (TOT_RAINnew .LE. CLIMIT) THEN
+            TOT_RAINnew=0.
+            VRAIN2=0.
+            QRnew=0.
+            ARAINnew=0.
+          ELSE
+   !
+   !--- 1st guess time-averaged rain rate at bottom of grid box
+   !
+            RR=TOT_RAINnew/(DTPH*GAMMAR)
+   !
+   !--- Use same algorithm as above for calculating mean drop diameter
+   !      (IDR, in microns), which is used to estimate the time-averaged
+   !      fall speed of rain drops at the bottom of the grid layer.  This
+   !      isn't perfect, but the alternative is solving a transcendental 
+   !      equation that is numerically inefficient and nasty to program
+   !      (coded in earlier versions of GSMCOLUMN prior to 8-22-01).
+   !
+            IF (RR .LE. RR_DRmin) THEN
+              IDR=MDRmin
+            ELSE IF (RR .LE. RR_DR1) THEN
+              IDR=INT( 1.123E3*RR**.1947 + .5 )
+              IDR=MAX( MDRmin, MIN(IDR, MDR1) )
+            ELSE IF (RR .LE. RR_DR2) THEN
+              IDR=INT( 1.225E3*RR**.2017 + .5 )
+              IDR=MAX( MDR1, MIN(IDR, MDR2) )
+            ELSE IF (RR .LE. RR_DR3) THEN
+              IDR=INT( 1.3006E3*RR**.2083 + .5 )
+              IDR=MAX( MDR2, MIN(IDR, MDR3) )
+            ELSE IF (RR .LE. RR_DRmax) THEN
+              IDR=INT( 1.355E3*RR**.2144 + .5 )
+              IDR=MAX( MDR3, MIN(IDR, MDRmax) )
+            ELSE 
+              IDR=MDRmax
+            ENDIF              ! End IF (RR .LE. RR_DRmin)
+            VRAIN2=GAMMAR*VRAIN(IDR)
+            QRnew=TOT_RAINnew/(THICK+BLDTRH*VRAIN2)
+            IF (QRnew .LE. EPSQ) QRnew=0.
+            IF (QR.GT.0. .AND. QRnew.NE.0.) THEN
+              DUM=QRnew/QR
+              IF (DUM .LT. TOLER) QRnew=0.
+            ENDIF
+            ARAINnew=BLDTRH*VRAIN2*QRnew
+            IF (ARAIN.GT.0. .AND. ARAINnew.NE.0.) THEN
+              DUM=ARAINnew/ARAIN
+              IF (DUM .LT. TOLER) ARAINnew=0.
+            ENDIF
+          ENDIF
+!
+          WCnew=QWnew+QRnew+QInew
+!
+!----------------------------------------------------------------------
+!-------------- Begin debugging & verification ------------------------
+!----------------------------------------------------------------------
+!
+!--- QT, QTnew - total water (vapor & condensate) before & after microphysics, resp.
+!
+
+
+          QT=THICK*(WV+WC)+ARAIN+ASNOW
+          QTnew=THICK*(WVnew+WCnew)+ARAINnew+ASNOWnew
+          BUDGET=QT-QTnew
+!
+!--- Additional check on budget preservation, accounting for truncation effects
+!
+          DBG_logical=.FALSE.
+!          DUM=ABS(BUDGET)
+!          IF (DUM .GT. TOLER) THEN
+!            DUM=DUM/MIN(QT, QTnew)
+!            IF (DUM .GT. TOLER) DBG_logical=.TRUE.
+!          ENDIF
+!!
+!          DUM=(RHgrd+.001)*QSInew
+!          IF ( (QWnew.GT.EPSQ) .OR. QRnew.GT.EPSQ .OR. WVnew.GT.DUM)
+!     &        .AND. TC.LT.T_ICE )  DBG_logical=.TRUE.
+!
+!          IF (TC.GT.5. .AND. QInew.GT.EPSQ) DBG_logical=.TRUE.
+!
+          IF ((WVnew.LT.EPSQ .OR. DBG_logical) .AND. PRINT_diag) THEN
+   !
+            WRITE(6,"(/2(a,i4),2(a,i2))") '{} i=',I_index,' j=',J_index,&
+     &                                    ' L=',L,' LSFC=',LSFC
+   !
+            ESW=1000.*FPVS0(Tnew)
+            QSWnew=EPS*ESW/(PP-ESW)
+            IF (TC.LT.0. .OR. Tnew .LT. 0.) THEN
+              ESI=1000.*FPVS(Tnew)
+              QSInew=EPS*ESI/(PP-ESI)
+            ELSE
+              QSI=QSW
+              QSInew=QSWnew
+            ENDIF
+            WSnew=QSInew
+            WRITE(6,"(4(a12,g11.4,1x))")                                   &
+     & '{} TCold=',TC,'TCnew=',Tnew-T0C,'P=',.01*PP,'RHO=',RHO,            &
+     & '{} THICK=',THICK,'RHold=',WV/WS,'RHnew=',WVnew/WSnew,              &
+     &   'RHgrd=',RHgrd,                                                   &
+     & '{} RHWold=',WV/QSW,'RHWnew=',WVnew/QSWnew,'RHIold=',WV/QSI,        &
+     &   'RHInew=',WVnew/QSInew,                                           &
+     & '{} QSWold=',QSW,'QSWnew=',QSWnew,'QSIold=',QSI,'QSInew=',QSInew,   &
+     & '{} WSold=',WS,'WSnew=',WSnew,'WVold=',WV,'WVnew=',WVnew,           &
+     & '{} WCold=',WC,'WCnew=',WCnew,'QWold=',QW,'QWnew=',QWnew,           &
+     & '{} QIold=',QI,'QInew=',QInew,'QRold=',QR,'QRnew=',QRnew,           &
+     & '{} ARAINold=',ARAIN,'ARAINnew=',ARAINnew,'ASNOWold=',ASNOW,        &
+     &   'ASNOWnew=',ASNOWnew,                                             &
+     & '{} TOT_RAIN=',TOT_RAIN,'TOT_RAINnew=',TOT_RAINnew,                 &
+     &   'TOT_ICE=',TOT_ICE,'TOT_ICEnew=',TOT_ICEnew,                      &
+     & '{} BUDGET=',BUDGET,'QTold=',QT,'QTnew=',QTnew                       
+   !
+            WRITE(6,"(4(a12,g11.4,1x))")                                   &
+     & '{} DELT=',DELT,'DELV=',DELV,'DELW=',DELW,'DELI=',DELI,             &
+     & '{} DELR=',DELR,'PCOND=',PCOND,'PIDEP=',PIDEP,'PIEVP=',PIEVP,       &
+     & '{} PICND=',PICND,'PREVP=',PREVP,'PRAUT=',PRAUT,'PRACW=',PRACW,     &
+     & '{} PIACW=',PIACW,'PIACWI=',PIACWI,'PIACWR=',PIACWR,'PIMLT=',       &
+     &    PIMLT,                                                           &
+     & '{} PIACR=',PIACR                                                    
+   !
+            IF (ICE_logical) WRITE(6,"(4(a12,g11.4,1x))")                  &
+     & '{} RimeF1=',RimeF1,'GAMMAS=',GAMMAS,'VrimeF=',VrimeF,              &
+     &   'VSNOW=',VSNOW,                                                   &
+     & '{} INDEXS=',FLOAT(INDEXS),'FLARGE=',FLARGE,'FSMALL=',FSMALL,       &
+     &   'FLIMASS=',FLIMASS,                                               &
+     & '{} XSIMASS=',XSIMASS,'XLIMASS=',XLIMASS,'QLICE=',QLICE,            &
+     &   'QTICE=',QTICE,                                                   &
+     & '{} NLICE=',NLICE,'NSmICE=',NSmICE,'PILOSS=',PILOSS,                &
+     &   'EMAIRI=',EMAIRI,                                                 &
+     & '{} RimeF=',RimeF                                                    
+   !
+            IF (TOT_RAIN.GT.0. .OR. TOT_RAINnew.GT.0.)                     &
+     &        WRITE(6,"(4(a12,g11.4,1x))")                                 &
+     & '{} INDEXR1=',FLOAT(INDEXR1),'INDEXR=',FLOAT(INDEXR),               &
+     &   'GAMMAR=',GAMMAR,'N0r=',N0r,                                      &
+     & '{} VRAIN1=',VRAIN1,'VRAIN2=',VRAIN2,'QTRAIN=',QTRAIN,'RQR=',RQR,   &
+     & '{} PRLOSS=',PRLOSS,'VOLR1=',THICK+BLDTRH*VRAIN1,                   &
+     &   'VOLR2=',THICK+BLDTRH*VRAIN2
+   !
+            IF (PRAUT .GT. 0.) WRITE(6,"(a12,g11.4,1x)") '{} QW0=',QW0
+   !
+            IF (PRACW .GT. 0.) WRITE(6,"(a12,g11.4,1x)") '{} FWR=',FWR
+   !
+            IF (PIACR .GT. 0.) WRITE(6,"(a12,g11.4,1x)") '{} FIR=',FIR
+   !
+            DUM=PIMLT+PICND-PREVP-PIEVP
+            IF (DUM.GT.0. .or. DWVi.NE.0.)                                 &
+     &        WRITE(6,"(4(a12,g11.4,1x))")                                 &
+     & '{} TFACTOR=',TFACTOR,'DYNVIS=',DYNVIS,                             &
+     &   'THERM_CON=',THERM_COND,'DIFFUS=',DIFFUS
+   !
+            IF (PREVP .LT. 0.) WRITE(6,"(4(a12,g11.4,1x))")                &
+     & '{} RFACTOR=',RFACTOR,'ABW=',ABW,'VENTR=',VENTR,'CREVP=',CREVP,     &
+     & '{} DWVr=',DWVr,'DENOMW=',DENOMW
+   !
+            IF (PIDEP.NE.0. .AND. DWVi.NE.0.)                              &
+     &        WRITE(6,"(4(a12,g11.4,1x))")                                 &
+     & '{} DWVi=',DWVi,'DENOMI=',DENOMI,'PIDEP_max=',PIDEP_max,            &
+     &   'SFACTOR=',SFACTOR,                                               &
+     & '{} ABI=',ABI,'VENTIL=',VENTIL,'VENTIL1=',VENTI1(INDEXS),           &
+     &   'VENTIL2=',SFACTOR*VENTI2(INDEXS),                                &
+     & '{} VENTIS=',VENTIS,'DIDEP=',DIDEP
+   !
+            IF (PIDEP.GT.0. .AND. PCOND.NE.0.)                             &
+     &        WRITE(6,"(4(a12,g11.4,1x))")                                 &
+     & '{} DENOMW=',DENOMW,'DENOMWI=',DENOMWI,'DENOMF=',DENOMF,            &
+     &    'DUM2=',PCOND-PIACW
+   !
+            IF (FWS .GT. 0.) WRITE(6,"(4(a12,g11.4,1x))")                  &
+     & '{} FWS=',FWS                     
+   !
+            DUM=PIMLT+PICND-PIEVP
+            IF (DUM.GT. 0.) WRITE(6,"(4(a12,g11.4,1x))")                   &
+     & '{} SFACTOR=',SFACTOR,'VENTIL=',VENTIL,'VENTIL1=',VENTI1(INDEXS),   &
+     &   'VENTIL2=',SFACTOR*VENTI2(INDEXS),                                &
+     & '{} AIEVP=',AIEVP,'DIEVP=',DIEVP,'QSW0=',QSW0,'DWV0=',DWV0       
+   !
+          ENDIF
+
+
+!
+!-----------------------------------------------------------------------
+!--------------- Water budget statistics & maximum values --------------
+!-----------------------------------------------------------------------
+!
+          IF (PRINT_diag) THEN
+            ITdx=MAX( ITLO, MIN( INT(Tnew-T0C), ITHI ) )
+            IF (QInew .GT. EPSQ) NSTATS(ITdx,1)=NSTATS(ITdx,1)+1
+            IF (QInew.GT.EPSQ  .AND.  QRnew+QWnew.GT.EPSQ)              &
+     &        NSTATS(ITdx,2)=NSTATS(ITdx,2)+1
+            IF (QWnew .GT. EPSQ) NSTATS(ITdx,3)=NSTATS(ITdx,3)+1 
+            IF (QRnew .GT. EPSQ) NSTATS(ITdx,4)=NSTATS(ITdx,4)+1
+  !
+            QMAX(ITdx,1)=MAX(QMAX(ITdx,1), QInew)
+            QMAX(ITdx,2)=MAX(QMAX(ITdx,2), QWnew)
+            QMAX(ITdx,3)=MAX(QMAX(ITdx,3), QRnew)
+            QMAX(ITdx,4)=MAX(QMAX(ITdx,4), ASNOWnew)
+            QMAX(ITdx,5)=MAX(QMAX(ITdx,5), ARAINnew)
+            QTOT(ITdx,1)=QTOT(ITdx,1)+QInew*THICK
+            QTOT(ITdx,2)=QTOT(ITdx,2)+QWnew*THICK
+            QTOT(ITdx,3)=QTOT(ITdx,3)+QRnew*THICK
+  !
+            QTOT(ITdx,4)=QTOT(ITdx,4)+PCOND*THICK
+            QTOT(ITdx,5)=QTOT(ITdx,5)+PICND*THICK
+            QTOT(ITdx,6)=QTOT(ITdx,6)+PIEVP*THICK
+            QTOT(ITdx,7)=QTOT(ITdx,7)+PIDEP*THICK
+            QTOT(ITdx,8)=QTOT(ITdx,8)+PREVP*THICK
+            QTOT(ITdx,9)=QTOT(ITdx,9)+PRAUT*THICK
+            QTOT(ITdx,10)=QTOT(ITdx,10)+PRACW*THICK
+            QTOT(ITdx,11)=QTOT(ITdx,11)+PIMLT*THICK
+            QTOT(ITdx,12)=QTOT(ITdx,12)+PIACW*THICK
+            QTOT(ITdx,13)=QTOT(ITdx,13)+PIACWI*THICK
+            QTOT(ITdx,14)=QTOT(ITdx,14)+PIACWR*THICK
+            QTOT(ITdx,15)=QTOT(ITdx,15)+PIACR*THICK
+  !
+            QTOT(ITdx,16)=QTOT(ITdx,16)+(WVnew-WV)*THICK
+            QTOT(ITdx,17)=QTOT(ITdx,17)+(QWnew-QW)*THICK
+            QTOT(ITdx,18)=QTOT(ITdx,18)+(QInew-QI)*THICK
+            QTOT(ITdx,19)=QTOT(ITdx,19)+(QRnew-QR)*THICK
+            QTOT(ITdx,20)=QTOT(ITdx,20)+(ARAINnew-ARAIN)
+            QTOT(ITdx,21)=QTOT(ITdx,21)+(ASNOWnew-ASNOW)
+            IF (QInew .GT. 0.)                                          &
+     &        QTOT(ITdx,22)=QTOT(ITdx,22)+QInew*THICK/RimeF
+  !
+          ENDIF
+!
+!----------------------------------------------------------------------
+!------------------------- Update arrays ------------------------------
+!----------------------------------------------------------------------
+!
+
+
+          T_col(L)=Tnew                           ! Updated temperature
+!
+          QV_col(L)=max(EPSQ, WVnew/(1.+WVnew))   ! Updated specific humidity
+          WC_col(L)=max(EPSQ, WCnew)              ! Updated total condensate mixing ratio
+          QI_col(L)=max(EPSQ, QInew)              ! Updated ice mixing ratio
+          QR_col(L)=max(EPSQ, QRnew)              ! Updated rain mixing ratio
+          QW_col(L)=max(EPSQ, QWnew)              ! Updated cloud water mixing ratio
+          RimeF_col(L)=RimeF                      ! Updated rime factor
+          ASNOW=ASNOWnew                          ! Updated accumulated snow
+          ARAIN=ARAINnew                          ! Updated accumulated rain
+!
+!#######################################################################
+!
+10      CONTINUE         ! ##### End "L" loop through model levels #####
+
+
+!
+!#######################################################################
+!
+!-----------------------------------------------------------------------
+!--------------------------- Return to GSMDRIVE -----------------------
+!-----------------------------------------------------------------------
+!
+        CONTAINS
+!#######################################################################
+!--------- Produces accurate calculation of cloud condensation ---------
+!#######################################################################
+!
+      REAL FUNCTION CONDENSE (PP, QW, TK, WV)
+!
+!---------------------------------------------------------------------------------
+!------   The Asai (1965) algorithm takes into consideration the release of ------
+!------   latent heat in increasing the temperature & in increasing the     ------
+!------   saturation mixing ratio (following the Clausius-Clapeyron eqn.).  ------
+!---------------------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+      INTEGER, PARAMETER :: HIGH_PRES=Selected_Real_Kind(15)
+      REAL (KIND=HIGH_PRES), PARAMETER ::                               &
+     & RHLIMIT=.001, RHLIMIT1=-RHLIMIT
+      REAL (KIND=HIGH_PRES) :: COND, SSAT, WCdum
+!
+      REAL,INTENT(IN) :: QW,PP,WV,TK
+      REAL WVdum,Tdum,XLV2,DWV,WS,ESW,XLV1,XLV
+integer nsteps
+!
+!-----------------------------------------------------------------------
+!
+!--- LV (T) is from Bolton (JAS, 1980)
+!
+      XLV=3.148E6-2370.*TK
+      XLV1=XLV*RCP
+      XLV2=XLV*XLV*RCPRV
+      Tdum=TK
+      WVdum=WV
+      WCdum=QW
+      ESW=1000.*FPVS0(Tdum)                     ! Saturation vapor press w/r/t water
+      WS=RHgrd*EPS*ESW/(PP-ESW)                 ! Saturation mixing ratio w/r/t water
+      DWV=WVdum-WS                              ! Deficit grid-scale water vapor mixing ratio
+      SSAT=DWV/WS                               ! Supersaturation ratio
+      CONDENSE=0.
+nsteps = 0
+      DO WHILE ((SSAT.LT.RHLIMIT1 .AND. WCdum.GT.EPSQ)                  &
+     &           .OR. SSAT.GT.RHLIMIT)
+        nsteps = nsteps + 1
+        COND=DWV/(1.+XLV2*WS/(Tdum*Tdum))       ! Asai (1965, J. Japan)
+        COND=MAX(COND, -WCdum)                  ! Limit cloud water evaporation
+        Tdum=Tdum+XLV1*COND                     ! Updated temperature
+        WVdum=WVdum-COND                        ! Updated water vapor mixing ratio
+        WCdum=WCdum+COND                        ! Updated cloud water mixing ratio
+        CONDENSE=CONDENSE+COND                  ! Total cloud water condensation
+        ESW=1000.*FPVS0(Tdum)                   ! Updated saturation vapor press w/r/t water
+        WS=RHgrd*EPS*ESW/(PP-ESW)               ! Updated saturation mixing ratio w/r/t water
+        DWV=WVdum-WS                            ! Deficit grid-scale water vapor mixing ratio
+        SSAT=DWV/WS                             ! Grid-scale supersaturation ratio
+      ENDDO
+!
+      END FUNCTION CONDENSE
+!
+!#######################################################################
+!---------------- Calculate ice deposition at T<T_ICE ------------------
+!#######################################################################
+!
+      REAL FUNCTION DEPOSIT (PP, Tdum, WVdum)
+!
+!--- Also uses the Asai (1965) algorithm, but uses a different target
+!      vapor pressure for the adjustment
+!
+      IMPLICIT NONE      
+!
+      INTEGER, PARAMETER :: HIGH_PRES=Selected_Real_Kind(15)
+      REAL (KIND=HIGH_PRES), PARAMETER :: RHLIMIT=.001,                 &
+     & RHLIMIT1=-RHLIMIT
+      REAL (KIND=HIGH_PRES) :: DEP, SSAT
+!    
+      real,INTENT(IN) ::  PP
+      real,INTENT(INOUT) ::  WVdum,Tdum
+      real ESI,WS,DWV
+!
+!-----------------------------------------------------------------------
+!
+      ESI=1000.*FPVS(Tdum)                      ! Saturation vapor press w/r/t ice
+      WS=RHgrd*EPS*ESI/(PP-ESI)                 ! Saturation mixing ratio
+      DWV=WVdum-WS                              ! Deficit grid-scale water vapor mixing ratio
+      SSAT=DWV/WS                               ! Supersaturation ratio
+      DEPOSIT=0.
+      DO WHILE (SSAT.GT.RHLIMIT .OR. SSAT.LT.RHLIMIT1)
+   !
+   !--- Note that XLVS2=LS*LV/(CP*RV)=LV*WS/(RV*T*T)*(LS/CP*DEP1), 
+   !     where WS is the saturation mixing ratio following Clausius-
+   !     Clapeyron (see Asai,1965; Young,1993,p.405) 
+   !
+        DEP=DWV/(1.+XLS2*WS/(Tdum*Tdum))        ! Asai (1965, J. Japan)
+        Tdum=Tdum+XLS1*DEP                      ! Updated temperature
+        WVdum=WVdum-DEP                         ! Updated ice mixing ratio
+        DEPOSIT=DEPOSIT+DEP                     ! Total ice deposition
+        ESI=1000.*FPVS(Tdum)                    ! Updated saturation vapor press w/r/t ice
+        WS=RHgrd*EPS*ESI/(PP-ESI)               ! Updated saturation mixing ratio w/r/t ice
+        DWV=WVdum-WS                            ! Deficit grid-scale water vapor mixing ratio
+        SSAT=DWV/WS                             ! Grid-scale supersaturation ratio
+      ENDDO
+!
+      END FUNCTION DEPOSIT
+!
+      END SUBROUTINE EGCP01COLUMN 
+
+!#######################################################################
+!------- Initialize constants & lookup tables for microphysics ---------
+!#######################################################################
+!
+
+! SH 0211/2002
+
+!-----------------------------------------------------------------------
+      SUBROUTINE etanewinit (GSMDT,DT,DELX,DELY,LOWLYR,restart,         &
+     &   F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,                              &
+     &   MP_RESTART_STATE,TBPVS_STATE,TBPVS0_STATE,                     &
+     &   ALLOWED_TO_READ,                                               &
+     &   IDS,IDE,JDS,JDE,KDS,KDE,                                       &
+     &   IMS,IME,JMS,JME,KMS,KME,                                       &
+     &   ITS,ITE,JTS,JTE,KTS,KTE                                       )
+!-----------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!---  SUBPROGRAM DOCUMENTATION BLOCK
+!   PRGRMMR: Ferrier         ORG: W/NP22     DATE: February 2001
+!            Jin             ORG: W/NP22     DATE: January 2002 
+!        (Modification for WRF structure)
+!                                               
+!-------------------------------------------------------------------------------
+! ABSTRACT:
+!   * Reads various microphysical lookup tables used in COLUMN_MICRO
+!   * Lookup tables were created "offline" and are read in during execution
+!   * Creates lookup tables for saturation vapor pressure w/r/t water & ice
+!-------------------------------------------------------------------------------
+!     
+! USAGE: CALL etanewinit FROM SUBROUTINE GSMDRIVE AT MODEL START TIME
+!
+!   INPUT ARGUMENT LIST:
+!       DTPH - physics time step (s)
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     NONE
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBROUTINES:
+!     MY_GROWTH_RATES - lookup table for growth of nucleated ice
+!     GPVS            - lookup tables for saturation vapor pressure (water, ice)
+!
+!   UNIQUE: NONE
+!  
+!   LIBRARY: NONE
+!  
+!   COMMON BLOCKS:
+!     CMICRO_CONS - constants used in GSMCOLUMN
+!     CMY600       - lookup table for growth of ice crystals in 
+!                    water saturated conditions (Miller & Young, 1979)
+!     IVENT_TABLES - lookup tables for ventilation effects of ice
+!     IACCR_TABLES - lookup tables for accretion rates of ice
+!     IMASS_TABLES - lookup tables for mass content of ice
+!     IRATE_TABLES - lookup tables for precipitation rates of ice
+!     IRIME_TABLES - lookup tables for increase in fall speed of rimed ice
+!     MAPOT        - Need lat/lon grid resolution
+!     RVENT_TABLES - lookup tables for ventilation effects of rain
+!     RACCR_TABLES - lookup tables for accretion rates of rain
+!     RMASS_TABLES - lookup tables for mass content of rain
+!     RVELR_TABLES - lookup tables for fall speeds of rain
+!     RRATE_TABLES - lookup tables for precipitation rates of rain
+!   
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!
+!-----------------------------------------------------------------------
+!
+!
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+!------------------------------------------------------------------------- 
+!-------------- Parameters & arrays for lookup tables -------------------- 
+!------------------------------------------------------------------------- 
+!
+!--- Common block of constants used in column microphysics
+!
+!WRF
+!     real DLMD,DPHD
+!WRF
+!
+!-----------------------------------------------------------------------
+!--- Parameters & data statement for local calculations
+!-----------------------------------------------------------------------
+!
+      INTEGER, PARAMETER :: MDR1=XMR1, MDR2=XMR2, MDR3=XMR3
+!
+!     VARIABLES PASSED IN
+      integer,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     & 
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE       
+!WRF
+       INTEGER, DIMENSION(ims:ime,jms:jme),INTENT(INOUT) :: LOWLYR
+!
+      real, INTENT(IN) ::  DELX,DELY
+      real,DIMENSION(*), INTENT(INOUT) :: MP_RESTART_STATE
+      real,DIMENSION(NX), INTENT(INOUT) :: TBPVS_STATE,TBPVS0_STATE
+      real,DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(OUT) ::          &
+     &  F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
+      INTEGER, PARAMETER :: ITLO=-60, ITHI=40
+!     integer,DIMENSION(ITLO:ITHI,4),INTENT(INOUT) :: NSTATS
+!     real,DIMENSION(ITLO:ITHI,5),INTENT(INOUT) :: QMAX
+!     real,DIMENSION(ITLO:ITHI,22),INTENT(INOUT) :: QTOT
+!     real,INTENT(INOUT) :: PRECtot(2),PRECmax(2)
+      real,INTENT(IN) :: DT,GSMDT
+      LOGICAL,INTENT(IN) :: allowed_to_read,restart
+!
+!-----------------------------------------------------------------------
+!     LOCAL VARIABLES
+!-----------------------------------------------------------------------
+      REAL :: BBFR,DTPH,PI,DX,Thour_print
+      INTEGER :: I,IM,J,L,K,JTF,KTF,ITF
+      INTEGER :: etampnew_unit1
+      LOGICAL, PARAMETER :: PRINT_diag=.FALSE.
+      LOGICAL :: opened
+      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+      CHARACTER*80 errmess
+!
+!-----------------------------------------------------------------------
+!
+      JTF=MIN0(JTE,JDE-1)
+      KTF=MIN0(KTE,KDE-1)
+      ITF=MIN0(ITE,IDE-1)
+!
+      DO J=JTS,JTF
+      DO I=ITS,ITF
+        LOWLYR(I,J)=1
+      ENDDO
+      ENDDO
+!    
+      IF(.NOT.RESTART)THEN
+        DO J = jts,jte
+        DO K = kts,kte
+        DO I= its,ite
+          F_ICE_PHY(i,k,j)=0.
+          F_RAIN_PHY(i,k,j)=0.
+          F_RIMEF_PHY(i,k,j)=1.
+        ENDDO
+        ENDDO
+        ENDDO
+      ENDIF
+!    
+!-----------------------------------------------------------------------
+      IF(ALLOWED_TO_READ)THEN
+!-----------------------------------------------------------------------
+!
+        DX=((DELX)**2+(DELY)**2)**.5/1000.    ! Model resolution at equator (km)
+        DX=MIN(100., MAX(5., DX) )
+!
+!-- Relative humidity threshold for the onset of grid-scale condensation
+!!-- 9/1/01:  Assume the following functional dependence for 5 - 100 km resolution:
+!!       RHgrd=0.90 for dx=100 km, 0.98 for dx=5 km, where
+!        RHgrd=0.90+.08*((100.-DX)/95.)**.5
+!
+        DTPH=MAX(GSMDT*60.,DT)
+        DTPH=NINT(DTPH/DT)*DT
+!
+!--- Create lookup tables for saturation vapor pressure w/r/t water & ice
+!
+        CALL GPVS
+!
+!--- Read in various lookup tables
+!
+        IF ( wrf_dm_on_monitor() ) THEN
+          DO i = 31,99
+            INQUIRE ( i , OPENED = opened )
+            IF ( .NOT. opened ) THEN
+              etampnew_unit1 = i
+              GOTO 2061
+            ENDIF
+          ENDDO
+          etampnew_unit1 = -1
+ 2061     CONTINUE
+        ENDIF
+!
+        CALL wrf_dm_bcast_bytes ( etampnew_unit1 , IWORDSIZE )
+!
+        IF ( etampnew_unit1 < 0 ) THEN
+          CALL wrf_error_fatal ( 'module_mp_etanew: etanewinit: Can not find '// &
+                                 'unused fortran unit to read in lookup table.' )
+        ENDIF
+!
+        IF ( wrf_dm_on_monitor() ) THEN
+!!was     OPEN (UNIT=1,FILE="eta_micro_lookup.dat",FORM="UNFORMATTED")
+          OPEN(UNIT=etampnew_unit1,FILE="ETAMPNEW_DATA",                  &
+     &        FORM="UNFORMATTED",STATUS="OLD",ERR=9061)
+!
+          READ(etampnew_unit1) VENTR1
+          READ(etampnew_unit1) VENTR2
+          READ(etampnew_unit1) ACCRR
+          READ(etampnew_unit1) MASSR
+          READ(etampnew_unit1) VRAIN
+          READ(etampnew_unit1) RRATE
+          READ(etampnew_unit1) VENTI1
+          READ(etampnew_unit1) VENTI2
+          READ(etampnew_unit1) ACCRI
+          READ(etampnew_unit1) MASSI
+          READ(etampnew_unit1) VSNOWI
+          READ(etampnew_unit1) VEL_RF
+!        read(etampnew_unit1) my_growth    ! Applicable only for DTPH=180 s
+          CLOSE (etampnew_unit1)
+        ENDIF
+!
+        CALL wrf_dm_bcast_bytes ( VENTR1 , size ( VENTR1 ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( VENTR2 , size ( VENTR2 ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( ACCRR , size ( ACCRR ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( MASSR , size ( MASSR ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( VRAIN , size ( VRAIN ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( RRATE , size ( RRATE ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( VENTI1 , size ( VENTI1 ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( VENTI2 , size ( VENTI2 ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( ACCRI , size ( ACCRI ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( MASSI , size ( MASSI ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( VSNOWI , size ( VSNOWI ) * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes ( VEL_RF , size ( VEL_RF ) * RWORDSIZE )
+!
+!--- Calculates coefficients for growth rates of ice nucleated in water
+!    saturated conditions, scaled by physics time step (lookup table)
+!
+        CALL MY_GROWTH_RATES (DTPH)
+!       CALL MY_GROWTH_RATES (DTPH,MY_GROWTH)
+!
+        PI=ACOS(-1.)
+!
+!--- Constants associated with Biggs (1953) freezing of rain, as parameterized
+!    following Lin et al. (JCAM, 1983) & Reisner et al. (1998, QJRMS).
+!
+        ABFR=-0.66
+        BBFR=100.
+        CBFR=20.*PI*PI*BBFR*RHOL*1.E-21
+!
+!--- CIACW is used in calculating riming rates
+!      The assumed effective collection efficiency of cloud water rimed onto
+!      ice is =0.5 below:
+!
+        CIACW=DTPH*0.25*PI*0.5*(1.E5)**C1
+!
+!--- CIACR is used in calculating freezing of rain colliding with large ice
+!      The assumed collection efficiency is 1.0
+!
+        CIACR=PI*DTPH
+!
+!--- Based on rain lookup tables for mean diameters from 0.05 to 0.45 mm
+!    * Four different functional relationships of mean drop diameter as 
+!      a function of rain rate (RR), derived based on simple fits to 
+!      mass-weighted fall speeds of rain as functions of mean diameter
+!      from the lookup tables.  
+!
+        RR_DRmin=N0r0*RRATE(MDRmin)     ! RR for mean drop diameter of .05 mm
+        RR_DR1=N0r0*RRATE(MDR1)         ! RR for mean drop diameter of .10 mm
+        RR_DR2=N0r0*RRATE(MDR2)         ! RR for mean drop diameter of .20 mm
+        RR_DR3=N0r0*RRATE(MDR3)         ! RR for mean drop diameter of .32 mm
+        RR_DRmax=N0r0*RRATE(MDRmax)     ! RR for mean drop diameter of .45 mm
+!
+        RQR_DRmin=N0r0*MASSR(MDRmin)    ! Rain content for mean drop diameter of .05 mm
+        RQR_DR1=N0r0*MASSR(MDR1)        ! Rain content for mean drop diameter of .10 mm
+        RQR_DR2=N0r0*MASSR(MDR2)        ! Rain content for mean drop diameter of .20 mm
+        RQR_DR3=N0r0*MASSR(MDR3)        ! Rain content for mean drop diameter of .32 mm
+        RQR_DRmax=N0r0*MASSR(MDRmax)    ! Rain content for mean drop diameter of .45 mm
+        C_N0r0=PI*RHOL*N0r0
+        CN0r0=1.E6/C_N0r0**.25
+        CN0r_DMRmin=1./(PI*RHOL*DMRmin**4)
+        CN0r_DMRmax=1./(PI*RHOL*DMRmax**4)
+!
+!--- CRACW is used in calculating collection of cloud water by rain (an
+!      assumed collection efficiency of 1.0)
+!
+        CRACW=DTPH*0.25*PI*1.0
+!
+        ESW0=1000.*FPVS0(T0C)     ! Saturation vapor pressure at 0C
+        RFmax=1.1**Nrime          ! Maximum rime factor allowed
+!
+!------------------------------------------------------------------------
+!--------------- Constants passed through argument list -----------------
+!------------------------------------------------------------------------
+!
+!--- Important parameters for self collection (autoconversion) of 
+!    cloud water to rain. 
+!
+!--- CRAUT is proportional to the rate that cloud water is converted by
+!      self collection to rain (autoconversion rate)
+!
+        CRAUT=1.-EXP(-1.E-3*DTPH)
+!
+!--- QAUT0 is the threshold cloud content for autoconversion to rain 
+!      needed for droplets to reach a diameter of 20 microns (following
+!      Manton and Cotton, 1977; Banta and Hanson, 1987, JCAM)
+!--- QAUT0=1.2567, 0.8378, or 0.4189 g/m**3 for droplet number concentrations
+!          of 300, 200, and 100 cm**-3, respectively
+!
+        QAUT0=PI*RHOL*NCW*(20.E-6)**3/6.
+!
+!--- For calculating snow optical depths by considering bulk density of
+!      snow based on emails from Q. Fu (6/27-28/01), where optical 
+!      depth (T) = 1.5*SWP/(Reff*DENS), SWP is snow water path, Reff 
+!      is effective radius, and DENS is the bulk density of snow.
+!
+!    SWP (kg/m**2)=(1.E-3 kg/g)*SWPrad, SWPrad in g/m**2 used in radiation
+!    T = 1.5*1.E3*SWPrad/(Reff*DENS)
+!  
+!    See derivation for MASSI(INDEXS), note equal to RHO*QSNOW/NSNOW
+!
+!      SDENS=1.5e3/DENS, DENS=MASSI(INDEXS)/[PI*(1.E-6*INDEXS)**3]
+!
+        DO I=MDImin,MDImax
+          SDENS(I)=PI*1.5E-15*FLOAT(I*I*I)/MASSI(I)
+        ENDDO
+!
+        Thour_print=-DTPH/3600.
+
+! SH 0211/2002
+!       IF (PRINT_diag) THEN
+       
+      !-------- Total and maximum quantities
+      !
+!         NSTATS=0      ! Microphysical statistics dealing w/ grid-point counts
+!         QMAX=0.       ! Microphysical statistics dealing w/ hydrometeor mass
+!         QTOT=0.       ! Microphysical statistics dealing w/ hydrometeor mass
+!         PRECmax=0.    ! Maximum precip rates (rain, snow) at surface (mm/h)
+!         PRECtot=0.    ! Total precipitation (rain, snow) accumulation at surface
+!       ENDIF
+
+!wrf
+        IF(.NOT.RESTART)THEN
+          MP_RESTART_STATE(MY_T1:MY_T2)=MY_GROWTH(MY_T1:MY_T2)
+          MP_RESTART_STATE(MY_T2+1)=C1XPVS0
+          MP_RESTART_STATE(MY_T2+2)=C2XPVS0
+          MP_RESTART_STATE(MY_T2+3)=C1XPVS
+          MP_RESTART_STATE(MY_T2+4)=C2XPVS
+          MP_RESTART_STATE(MY_T2+5)=CIACW
+          MP_RESTART_STATE(MY_T2+6)=CIACR
+          MP_RESTART_STATE(MY_T2+7)=CRACW
+          MP_RESTART_STATE(MY_T2+8)=CRAUT
+          TBPVS_STATE(1:NX) =TBPVS(1:NX)
+          TBPVS0_STATE(1:NX)=TBPVS0(1:NX)
+        ENDIF
+
+      ENDIF  ! Allowed_to_read
+
+      RETURN
+!
+!-----------------------------------------------------------------------
+!
+9061 CONTINUE
+      WRITE( errmess , '(A,I4)' )                                        &
+       'module_mp_etanew: error opening ETAMPNEW_DATA on unit '          &
+     &, etampnew_unit1
+      CALL wrf_error_fatal(errmess)
+!
+!-----------------------------------------------------------------------
+      END SUBROUTINE etanewinit
+!
+      SUBROUTINE MY_GROWTH_RATES (DTPH)
+!     SUBROUTINE MY_GROWTH_RATES (DTPH,MY_GROWTH)
+!
+!--- Below are tabulated values for the predicted mass of ice crystals
+!    after 600 s of growth in water saturated conditions, based on 
+!    calculations from Miller and Young (JAS, 1979).  These values are
+!    crudely estimated from tabulated curves at 600 s from Fig. 6.9 of
+!    Young (1993).  Values at temperatures colder than -27C were 
+!    assumed to be invariant with temperature.  
+!
+!--- Used to normalize Miller & Young (1979) calculations of ice growth
+!    over large time steps using their tabulated values at 600 s.
+!    Assumes 3D growth with time**1.5 following eq. (6.3) in Young (1993).
+!
+      IMPLICIT NONE
+!
+      REAL,INTENT(IN) :: DTPH
+!
+      REAL  DT_ICE
+      REAL,DIMENSION(35) :: MY_600
+!WRF
+!
+!-----------------------------------------------------------------------
+      DATA MY_600 /                                                     &
+     & 5.5e-8, 1.4E-7, 2.8E-7, 6.E-7, 3.3E-6,                           & 
+     & 2.E-6, 9.E-7, 8.8E-7, 8.2E-7, 9.4e-7,                            & 
+     & 1.2E-6, 1.85E-6, 5.5E-6, 1.5E-5, 1.7E-5,                         & 
+     & 1.5E-5, 1.E-5, 3.4E-6, 1.85E-6, 1.35E-6,                         & 
+     & 1.05E-6, 1.E-6, 9.5E-7, 9.0E-7, 9.5E-7,                          & 
+     & 9.5E-7, 9.E-7, 9.E-7, 9.E-7, 9.E-7,                              & 
+     & 9.E-7, 9.E-7, 9.E-7, 9.E-7, 9.E-7 /        ! -31 to -35 deg C
+!
+!-----------------------------------------------------------------------
+!
+      DT_ICE=(DTPH/600.)**1.5
+      MY_GROWTH=DT_ICE*MY_600
+!
+!-----------------------------------------------------------------------
+!
+      END SUBROUTINE MY_GROWTH_RATES
+!
+!-----------------------------------------------------------------------
+!---------  Old GFS saturation vapor pressure lookup tables  -----------
+!-----------------------------------------------------------------------
+!
+      SUBROUTINE GPVS
+!     ******************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    GPVS        COMPUTE SATURATION VAPOR PRESSURE TABLE
+!   AUTHOR: N PHILLIPS       W/NP2      DATE: 30 DEC 82
+!
+! ABSTRACT: COMPUTE SATURATION VAPOR PRESSURE TABLE AS A FUNCTION OF
+!   TEMPERATURE FOR THE TABLE LOOKUP FUNCTION FPVS.
+!   EXACT SATURATION VAPOR PRESSURES ARE CALCULATED IN SUBPROGRAM FPVSX.
+!   THE CURRENT IMPLEMENTATION COMPUTES A TABLE WITH A LENGTH
+!   OF 7501 FOR TEMPERATURES RANGING FROM 180.0 TO 330.0 KELVIN.
+!
+! PROGRAM HISTORY LOG:
+!   91-05-07  IREDELL
+!   94-12-30  IREDELL             EXPAND TABLE
+!   96-02-19  HONG                ICE EFFECT
+!   01-11-29  JIN                 MODIFIED FOR WRF
+!
+! USAGE:  CALL GPVS
+!
+! SUBPROGRAMS CALLED:
+!   (FPVSX)  - INLINABLE FUNCTION TO COMPUTE SATURATION VAPOR PRESSURE
+!
+! COMMON BLOCKS:
+!   COMPVS   - SCALING PARAMETERS AND TABLE FOR FUNCTION FPVS.
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!
+!$$$
+      IMPLICIT NONE
+      real :: X,XINC,T
+      integer :: JX
+!----------------------------------------------------------------------
+      XINC=(XMAX-XMIN)/(NX-1)
+      C1XPVS=1.-XMIN/XINC
+      C2XPVS=1./XINC
+      C1XPVS0=1.-XMIN/XINC
+      C2XPVS0=1./XINC
+!
+      DO JX=1,NX
+        X=XMIN+(JX-1)*XINC
+        T=X
+        TBPVS(JX)=FPVSX(T)
+        TBPVS0(JX)=FPVSX0(T)
+      ENDDO
+! 
+      END SUBROUTINE GPVS
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+                     REAL   FUNCTION FPVS(T)
+!-----------------------------------------------------------------------
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    FPVS        COMPUTE SATURATION VAPOR PRESSURE
+!   AUTHOR: N PHILLIPS            W/NP2      DATE: 30 DEC 82
+!
+! ABSTRACT: COMPUTE SATURATION VAPOR PRESSURE FROM THE TEMPERATURE.
+!   A LINEAR INTERPOLATION IS DONE BETWEEN VALUES IN A LOOKUP TABLE
+!   COMPUTED IN GPVS. SEE DOCUMENTATION FOR FPVSX FOR DETAILS.
+!   INPUT VALUES OUTSIDE TABLE RANGE ARE RESET TO TABLE EXTREMA.
+!   THE INTERPOLATION ACCURACY IS ALMOST 6 DECIMAL PLACES.
+!   ON THE CRAY, FPVS IS ABOUT 4 TIMES FASTER THAN EXACT CALCULATION.
+!   THIS FUNCTION SHOULD BE EXPANDED INLINE IN THE CALLING ROUTINE.
+!
+! PROGRAM HISTORY LOG:
+!   91-05-07  IREDELL             MADE INTO INLINABLE FUNCTION
+!   94-12-30  IREDELL             EXPAND TABLE
+!   96-02-19  HONG                ICE EFFECT
+!   01-11-29  JIN                 MODIFIED FOR WRF
+!
+! USAGE:   PVS=FPVS(T)
+!
+!   INPUT ARGUMENT LIST:
+!     T        - REAL TEMPERATURE IN KELVIN
+!
+!   OUTPUT ARGUMENT LIST:
+!     FPVS     - REAL SATURATION VAPOR PRESSURE IN KILOPASCALS (CB)
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!$$$
+      IMPLICIT NONE
+      real,INTENT(IN) :: T
+      real XJ
+      integer :: JX
+!-----------------------------------------------------------------------
+      XJ=MIN(MAX(C1XPVS+C2XPVS*T,1.),FLOAT(NX))
+      JX=MIN(XJ,NX-1.)
+      FPVS=TBPVS(JX)+(XJ-JX)*(TBPVS(JX+1)-TBPVS(JX))
+!
+      END FUNCTION FPVS
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+                     REAL FUNCTION FPVS0(T)
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+      real,INTENT(IN) :: T
+      real :: XJ1
+      integer :: JX1
+!-----------------------------------------------------------------------
+      XJ1=MIN(MAX(C1XPVS0+C2XPVS0*T,1.),FLOAT(NX))
+      JX1=MIN(XJ1,NX-1.)
+      FPVS0=TBPVS0(JX1)+(XJ1-JX1)*(TBPVS0(JX1+1)-TBPVS0(JX1))
+!
+      END FUNCTION FPVS0
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+                    REAL FUNCTION FPVSX(T)
+!-----------------------------------------------------------------------
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .
+! SUBPROGRAM:    FPVSX       COMPUTE SATURATION VAPOR PRESSURE
+!   AUTHOR: N PHILLIPS            W/NP2      DATE: 30 DEC 82
+!
+! ABSTRACT: EXACTLY COMPUTE SATURATION VAPOR PRESSURE FROM TEMPERATURE.
+!   THE WATER MODEL ASSUMES A PERFECT GAS, CONSTANT SPECIFIC HEATS
+!   FOR GAS AND LIQUID, AND NEGLECTS THE VOLUME OF THE LIQUID.
+!   THE MODEL DOES ACCOUNT FOR THE VARIATION OF THE LATENT HEAT
+!   OF CONDENSATION WITH TEMPERATURE.  THE ICE OPTION IS NOT INCLUDED.
+!   THE CLAUSIUS-CLAPEYRON EQUATION IS INTEGRATED FROM THE TRIPLE POINT
+!   TO GET THE FORMULA
+!       PVS=PSATK*(TR**XA)*EXP(XB*(1.-TR))
+!   WHERE TR IS TTP/T AND OTHER VALUES ARE PHYSICAL CONSTANTS
+!   THIS FUNCTION SHOULD BE EXPANDED INLINE IN THE CALLING ROUTINE.
+!
+! PROGRAM HISTORY LOG:
+!   91-05-07  IREDELL             MADE INTO INLINABLE FUNCTION
+!   94-12-30  IREDELL             EXACT COMPUTATION
+!   96-02-19  HONG                ICE EFFECT 
+!   01-11-29  JIN                 MODIFIED FOR WRF
+!
+! USAGE:   PVS=FPVSX(T)
+! REFERENCE:   EMANUEL(1994),116-117
+!
+!   INPUT ARGUMENT LIST:
+!     T        - REAL TEMPERATURE IN KELVIN
+!
+!   OUTPUT ARGUMENT LIST:
+!     FPVSX    - REAL SATURATION VAPOR PRESSURE IN KILOPASCALS (CB)
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!$$$
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+       real, parameter :: TTP=2.7316E+2,HVAP=2.5000E+6,PSAT=6.1078E+2   &
+      ,         CLIQ=4.1855E+3,CVAP= 1.8460E+3                          &
+      ,         CICE=2.1060E+3,HSUB=2.8340E+6
+!
+      real, parameter :: PSATK=PSAT*1.E-3
+      real, parameter :: DLDT=CVAP-CLIQ,XA=-DLDT/RV,XB=XA+HVAP/(RV*TTP)
+      real, parameter :: DLDTI=CVAP-CICE                                &
+      ,                  XAI=-DLDTI/RV,XBI=XAI+HSUB/(RV*TTP)
+      real T,TR
+!-----------------------------------------------------------------------
+      TR=TTP/T
+!
+      IF(T.GE.TTP)THEN
+        FPVSX=PSATK*(TR**XA)*EXP(XB*(1.-TR))
+      ELSE
+        FPVSX=PSATK*(TR**XAI)*EXP(XBI*(1.-TR))
+      ENDIF
+! 
+      END FUNCTION FPVSX
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+                 REAL   FUNCTION FPVSX0(T)
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+      real,parameter :: TTP=2.7316E+2,HVAP=2.5000E+6,PSAT=6.1078E+2     &
+      ,         CLIQ=4.1855E+3,CVAP=1.8460E+3                           &
+      ,         CICE=2.1060E+3,HSUB=2.8340E+6
+      real,PARAMETER :: PSATK=PSAT*1.E-3
+      real,PARAMETER :: DLDT=CVAP-CLIQ,XA=-DLDT/RV,XB=XA+HVAP/(RV*TTP)
+      real,PARAMETER :: DLDTI=CVAP-CICE                                 &
+      ,                 XAI=-DLDT/RV,XBI=XA+HSUB/(RV*TTP)
+      real :: T,TR
+!-----------------------------------------------------------------------
+      TR=TTP/T
+      FPVSX0=PSATK*(TR**XA)*EXP(XB*(1.-TR))
+!
+      END FUNCTION FPVSX0
+!
+      END MODULE module_mp_etanew
Index: trunk/WRF.COMMON/WRFV2/phys/module_mp_kessler.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_mp_kessler.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_mp_kessler.F	(revision 2744)
@@ -0,0 +1,244 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+
+MODULE module_mp_kessler
+
+CONTAINS
+!----------------------------------------------------------------
+   SUBROUTINE kessler( t, qv, qc, qr, rho, pii                  &
+                      ,dt_in, z, xlv, cp                        &
+                      ,EP2,SVP1,SVP2,SVP3,SVPT0,rhowater        &
+                      ,dz8w                                     &
+                      ,RAINNC, RAINNCV                          &
+                      ,ids,ide, jds,jde, kds,kde                & ! domain dims
+                      ,ims,ime, jms,jme, kms,kme                & ! memory dims
+                      ,its,ite, jts,jte, kts,kte                & ! tile   dims
+                                                                )
+!----------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------
+   !  taken from the COMMAS code - WCS 10 May 1999.
+   !  converted from FORTRAN 77 to 90, tiled, WCS 10 May 1999.
+!----------------------------------------------------------------
+   REAL    , PARAMETER ::  c1 = .001 
+   REAL    , PARAMETER ::  c2 = .001 
+   REAL    , PARAMETER ::  c3 = 2.2 
+   REAL    , PARAMETER ::  c4 = .875 
+   REAL    , PARAMETER ::  fudge = 1.0 
+   REAL    , PARAMETER ::  mxfall = 10.0 
+!----------------------------------------------------------------
+   INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde, &
+                                     ims,ime, jms,jme, kms,kme, &
+                                     its,ite, jts,jte, kts,kte
+   REAL   ,      INTENT(IN   )    :: xlv, cp
+   REAL   ,      INTENT(IN   )    :: EP2,SVP1,SVP2,SVP3,SVPT0
+   REAL   ,      INTENT(IN   )    :: rhowater
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),              &
+         INTENT(INOUT) ::                                       &
+                                                            t , &
+                                                            qv, &
+                                                            qc, &
+                                                            qr
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),              &
+         INTENT(IN   ) ::                                       &
+                                                           rho, &
+                                                           pii, &
+                                                          dz8w 
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),              &
+         INTENT(IN   ) ::                                    z
+
+   REAL, INTENT(IN   ) :: dt_in
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                        &
+         INTENT(INOUT) ::                               RAINNC, &
+                                                       RAINNCV
+
+
+
+   ! local variables
+
+   REAL :: qrprod, ern, gam, rcgs, rcgsi
+   REAL, DIMENSION( its:ite , kts:kte, jts:jte ) ::     prod
+   REAL, DIMENSION(kts:kte) :: vt, prodk, vtden,rdzk,rhok,factor,rdzw
+   INTEGER :: i,j,k
+   INTEGER :: nfall, n, nfall_new
+   REAL    :: qrr, pressure, temp, es, qvs, dz, dt
+   REAL    :: f5, dtfall, rdz, product
+   REAL    :: max_heating, max_condense, max_rain, maxqrp
+   REAL    :: vtmax, ernmax, crmax, factorn, time_sediment
+   REAL    :: qcr, factorr, ppt
+   REAL, PARAMETER :: max_cr_sedimentation = 0.75
+!----------------------------------------------------------------
+
+   INTEGER :: imax, kmax
+
+    dt = dt_in
+
+!   f5 = 237.3 * 17.27 * 2.5e6 / cp 
+    f5 = svp2*(svpt0-svp3)*xlv/cp
+    ernmax = 0.
+    maxqrp = -100.
+
+!------------------------------------------------------------------------------
+! parameters for the time split terminal advection
+!------------------------------------------------------------------------------
+
+      max_heating = 0.
+      max_condense = 0.
+      max_rain = 0.
+
+!-----------------------------------------------------------------------------
+! outer J loop for entire microphysics, outer i loop for sedimentation
+!-----------------------------------------------------------------------------
+
+  microphysics_outer_j_loop: DO j = jts, jte
+
+  sedimentation_outer_i_loop: DO i = its,ite
+
+!   vtmax = 0.
+   crmax = 0.
+
+
+!------------------------------------------------------------------------------
+! Terminal velocity calculation and advection, set up coefficients and
+! compute stable timestep
+!------------------------------------------------------------------------------
+
+   DO k = 1, kte
+     prodk(k)   = qr(i,k,j)
+     rhok(k) = rho(i,k,j)
+     qrr = amax1(0.,qr(i,k,j)*0.001*rhok(k))
+     vtden(k) = sqrt(rhok(1)/rhok(k))
+     vt(k) = 36.34*(qrr**0.1364) * vtden(k)
+!     vtmax = amax1(vt(k), vtmax)
+     rdzw(k) = 1./dz8w(i,k,j)
+     crmax = amax1(vt(k)*dt*rdzw(k),crmax)
+   ENDDO
+   DO k = 1, kte-1
+     rdzk(k) = 1./(z(i,k+1,j) - z(i,k,j))
+   ENDDO
+   rdzk(kte) = 1./(z(i,kte,j) - z(i,kte-1,j))
+
+   nfall = max(1,nint(0.5+crmax/max_cr_sedimentation))  ! courant number for big timestep.
+   dtfall = dt / float(nfall)                           ! splitting so courant number for sedimentation
+   time_sediment = dt                                   ! is stable
+
+!------------------------------------------------------------------------------
+! Terminal velocity calculation and advection
+! Do a time split loop on this for stability.
+!------------------------------------------------------------------------------
+
+   column_sedimentation: DO WHILE ( nfall > 0 )
+
+   time_sediment = time_sediment - dtfall
+   DO k = 1, kte-1
+     factor(k) = dtfall*rdzk(k)/rhok(k)
+   ENDDO
+   factor(kte) = dtfall*rdzk(kte)
+
+   ppt=0.
+
+      k = 1
+      ppt=rhok(k)*prodk(k)*vt(k)*dtfall/rhowater
+      RAINNCV(i,j)=ppt*1000.
+      RAINNC(i,j)=RAINNC(i,j)+ppt*1000.  ! unit = mm
+ 
+!------------------------------------------------------------------------------
+! Time split loop, Fallout done with flux upstream
+!------------------------------------------------------------------------------
+
+      DO k = kts, kte-1
+        prodk(k) = prodk(k) - factor(k)           &
+                  * (rhok(k)*prodk(k)*vt(k)       &
+                    -rhok(k+1)*prodk(k+1)*vt(k+1))
+      ENDDO
+
+      k = kte
+      prodk(k) = prodk(k) - factor(k)*prodk(k)*vt(k)
+
+!------------------------------------------------------------------------------
+! compute new sedimentation velocity, and check/recompute new 
+! sedimentation timestep if this isn't the last split step.
+!------------------------------------------------------------------------------
+
+      IF( nfall > 1 ) THEN ! this wasn't the last split sedimentation timestep
+
+        nfall = nfall - 1
+        crmax = 0.
+        DO k = kts, kte 
+          qrr = amax1(0.,prodk(k)*0.001*rhok(k))
+          vt(k) = 36.34*(qrr**0.1364) * vtden(k)
+!          vtmax = amax1(vt(k), vtmax)
+          crmax = amax1(vt(k)*time_sediment*rdzw(k),crmax)
+        ENDDO
+
+        nfall_new = max(1,nint(0.5+crmax/max_cr_sedimentation))
+        if (nfall_new /= nfall ) then
+          nfall = nfall_new
+          dtfall = time_sediment/nfall
+        end if
+
+      ELSE  ! this was the last timestep
+
+        DO k=kts,kte
+          prod(i,k,j) = prodk(k)
+        ENDDO
+        nfall = 0  ! exit condition for sedimentation loop
+
+      END IF
+
+   ENDDO column_sedimentation
+
+   ENDDO sedimentation_outer_i_loop
+
+!------------------------------------------------------------------------------
+! Production of rain and deletion of qc
+! Production of qc from supersaturation
+! Evaporation of QR
+!------------------------------------------------------------------------------
+
+     DO k = kts, kte
+     DO i = its, ite
+       factorn = 1.0 / (1.+c3*dt*amax1(0.,qr(i,k,j))**c4)
+       qrprod = qc(i,k,j) * (1.0 - factorn)           &
+             + factorn*c1*dt*amax1(qc(i,k,j)-c2,0.)      
+       rcgs = 0.001*rho(i,k,j)
+
+       qc(i,k,j) = amax1(qc(i,k,j) - qrprod,0.)
+       qr(i,k,j) = (qr(i,k,j) + prod(i,k,j)-qr(i,k,j))
+       qr(i,k,j) = amax1(qr(i,k,j) + qrprod,0.)
+
+       temp      = pii(i,k,j)*t(i,k,j)
+       pressure = 1.000e+05 * (pii(i,k,j)**(1004./287.))
+       gam = 2.5e+06/(1004.*pii(i,k,j))
+!      qvs       = 380.*exp(17.27*(temp-273.)/(temp- 36.))/pressure
+       es        = 1000.*svp1*exp(svp2*(temp-svpt0)/(temp-svp3))
+       qvs       = ep2*es/(pressure-es)
+!      prod(i,k,j) = (qv(i,k,j)-qvs) / (1.+qvs*f5/(temp-36.)**2)
+       prod(i,k,j) = (qv(i,k,j)-qvs) / (1.+pressure/(pressure-es)*qvs*f5/(temp-svp3)**2)
+       ern  = amin1(dt*(((1.6+124.9*(rcgs*qr(i,k,j))**.2046)   &
+          *(rcgs*qr(i,k,j))**.525)/(2.55e8/(pressure*qvs)       &
+          +5.4e5))*(dim(qvs,qv(i,k,j))/(rcgs*qvs)),             &
+          amax1(-prod(i,k,j)-qc(i,k,j),0.),qr(i,k,j))
+
+! Update all variables
+
+       product = amax1(prod(i,k,j),-qc(i,k,j))
+       t (i,k,j) = t(i,k,j) + gam*(product - ern)
+       qv(i,k,j) = amax1(qv(i,k,j) - product + ern,0.)
+       qc(i,k,j) =       qc(i,k,j) + product
+       qr(i,k,j) = qr(i,k,j) - ern
+
+     ENDDO
+     ENDDO
+
+  ENDDO  microphysics_outer_j_loop
+
+  RETURN
+
+  END SUBROUTINE kessler
+
+END MODULE module_mp_kessler
Index: trunk/WRF.COMMON/WRFV2/phys/module_mp_lin.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_mp_lin.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_mp_lin.F	(revision 2744)
@@ -0,0 +1,2484 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+
+MODULE module_mp_lin
+
+   USE     module_wrf_error
+!
+   REAL    , PARAMETER, PRIVATE ::       RH = 1.0
+!  REAL    , PARAMETER, PRIVATE ::   episp0 = 0.622*611.21
+   REAL    , PARAMETER, PRIVATE ::     xnor = 8.0e6
+   REAL    , PARAMETER, PRIVATE ::     xnos = 3.0e6
+
+!  Lin
+!  REAL    , PARAMETER, PRIVATE ::     xnog = 4.0e4
+!  REAL    , PARAMETER, PRIVATE ::     rhograul = 917.
+
+! Hobbs
+  REAL     , PARAMETER, PRIVATE ::     xnog = 4.0e6
+  REAL     , PARAMETER, PRIVATE ::     rhograul = 400.
+
+!
+  REAL     , PARAMETER, PRIVATE ::                              &
+             qi0 = 1.0e-3, ql0 = 7.0e-4, qs0 = 6.0E-4,          &
+             xmi50 = 4.8e-10, xmi40 = 2.46e-10,                 &
+             constb = 0.8, constd = 0.25,                       &
+             o6 = 1./6.,  cdrag = 0.6,                          &
+             avisc = 1.49628e-6, adiffwv = 8.7602e-5,           &
+             axka = 1.4132e3, di50 = 1.0e-4, xmi = 4.19e-13,    &
+             cw = 4.187e3, vf1s = 0.78, vf2s = 0.31,            &
+             xni0 = 1.0e-2, xmnin = 1.05e-18, bni = 0.5,        &
+             ci = 2.093e3
+CONTAINS
+
+!-------------------------------------------------------------------
+!  Lin et al., 1983, JAM, 1065-1092, and
+!  Rutledge and Hobbs, 1984, JAS, 2949-2972
+!-------------------------------------------------------------------
+  SUBROUTINE lin_et_al(th                                          &
+                      ,qv, ql, qr                                  &
+                      ,qi, qs                                      &
+                      ,rho, pii, p                                 &
+                      ,dt_in                                       &
+                      ,z,ht, dz8w                                  &
+                      ,grav, cp, Rair, rvapor                      &
+                      ,XLS, XLV, XLF, rhowater, rhosnow            &
+                      ,EP2,SVP1,SVP2,SVP3,SVPT0                    &
+                      , RAINNC, RAINNCV                            &
+                      ,ids,ide, jds,jde, kds,kde                   &
+                      ,ims,ime, jms,jme, kms,kme                   &
+                      ,its,ite, jts,jte, kts,kte                   &
+                  ! Optional 
+                      , F_QG                                       &
+                      , qg                                         &
+                                                                   )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!
+! Shuhua 12/17/99
+!
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(INOUT) ::                                          &
+                                                              th, &
+                                                              qv, &
+                                                              ql, &
+                                                              qr
+
+
+!
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(IN   ) ::                                          &
+                                                             rho, &
+                                                             pii, &
+                                                               p, &
+                                                            dz8w
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(IN   ) ::                                       z
+
+
+
+  REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::       ht
+
+  REAL, INTENT(IN   ) ::                                   dt_in, &
+                                                            grav, &
+                                                            Rair, &
+                                                          rvapor, &
+                                                              cp, &
+                                                             XLS, &
+                                                             XLV, &
+                                                             XLF, &
+                                                        rhowater, &
+                                                         rhosnow
+
+  REAL, INTENT(IN   ) :: EP2,SVP1,SVP2,SVP3,SVPT0
+
+  REAL, DIMENSION( ims:ime , jms:jme ),                           &
+        INTENT(INOUT) ::                                  RAINNC, &
+                                                         RAINNCV
+
+! Optional
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        OPTIONAL,                                                 &
+        INTENT(INOUT) ::                                          &
+                                                              qi, &
+                                                              qs, &
+                                                              qg
+
+  LOGICAL, INTENT(IN), OPTIONAL :: F_QG
+
+! LOCAL VAR
+
+  INTEGER             ::                            min_q, max_q
+
+  REAL, DIMENSION( its:ite , jts:jte )                            &
+                               ::        rain, snow, graupel,ice
+
+  REAL, DIMENSION( kts:kte )   ::                  qvz, qlz, qrz, &
+                                                   qiz, qsz, qgz, &
+                                                             thz, &
+                                                     tothz, rhoz, &
+                                                   orhoz, sqrhoz, &
+                                                        prez, zz, &
+                                                        dzw
+
+  LOGICAL flag_qg
+!
+  REAL    ::         dt, pptrain, pptsnow, pptgraul, rhoe_s,      &
+                     gindex, pptice
+
+  INTEGER ::               i,j,k
+!
+   flag_qg = .false.
+   IF ( PRESENT ( f_qg ) ) flag_qg = f_qg
+!
+   dt=dt_in
+   rhoe_s=1.29
+   gindex=1.0
+
+   IF (.not.flag_qg) gindex=0.
+
+   j_loop:  DO j = jts, jte
+   i_loop:  DO i = its, ite
+!
+!- write data from 3-D to 1-D
+!
+   DO k = kts, kte
+      qvz(k)=qv(i,k,j)
+      qlz(k)=ql(i,k,j)
+      qrz(k)=qr(i,k,j)
+      thz(k)=th(i,k,j)
+!
+      rhoz(k)=rho(i,k,j)
+      orhoz(k)=1./rhoz(k)
+      prez(k)=p(i,k,j)
+      sqrhoz(k)=sqrt(rhoe_s*orhoz(k))
+      tothz(k)=pii(i,k,j)
+      zz(k)=z(i,k,j)
+      dzw(k)=dz8w(i,k,j)
+   END DO
+
+      DO k = kts, kte
+         qiz(k)=qi(i,k,j)
+         qsz(k)=qs(i,k,j)
+      ENDDO
+
+   IF ( flag_qg .AND. PRESENT( qg ) ) THEN
+      DO k = kts, kte
+         qgz(k)=qg(i,k,j)
+      ENDDO
+   ELSE
+      DO k = kts, kte
+         qgz(k)=0.
+      ENDDO
+   ENDIF
+!
+   pptrain=0.
+   pptsnow=0.
+   pptgraul=0.
+   pptice=0.
+   CALL clphy1d(    dt, qvz, qlz, qrz, qiz, qsz, qgz,         &
+                    thz, tothz, rhoz, orhoz, sqrhoz,          &
+                    prez, zz, dzw, ht(I,J),                   &
+                    pptrain, pptsnow, pptgraul, pptice,       &
+                    grav, cp, Rair, rvapor, gindex,           &
+                    XLS, XLV, XLF, rhowater, rhosnow,         &
+                    EP2,SVP1,SVP2,SVP3,SVPT0,                 &
+                    kts, kte, i, j                            )
+
+!
+! Precipitation from cloud microphysics -- only for one time step
+!
+! unit is transferred from m to mm
+
+!
+   rain(i,j)=pptrain
+   snow(i,j)=pptsnow
+   graupel(i,j)=pptgraul
+   ice(i,j)=pptice
+!
+   RAINNCV(i,j)= pptrain + pptsnow + pptgraul + pptice
+   RAINNC(i,j)=RAINNC(i,j) + pptrain + pptsnow + pptgraul + pptice
+
+!
+!- update data from 1-D back to 3-D
+!
+!
+   DO k = kts, kte
+      qv(i,k,j)=qvz(k)
+      ql(i,k,j)=qlz(k)
+      qr(i,k,j)=qrz(k)
+      th(i,k,j)=thz(k)
+   END DO
+!
+      DO k = kts, kte
+         qi(i,k,j)=qiz(k)
+         qs(i,k,j)=qsz(k)
+      ENDDO
+
+   IF ( flag_qg .AND. PRESENT( qg ) ) THEN
+      DO k = kts, kte
+         qg(i,k,j)=qgz(k)
+      ENDDO
+   ENDIF
+!
+   ENDDO i_loop
+   ENDDO j_loop
+
+   END SUBROUTINE lin_et_al
+
+
+!-----------------------------------------------------------------------
+   SUBROUTINE clphy1d(dt, qvz, qlz, qrz, qiz, qsz, qgz,                &
+                      thz, tothz, rho, orho, sqrho,                    &
+                      prez, zz, dzw, zsfc, pptrain, pptsnow, pptgraul, &
+                      pptice, grav, cp, Rair, rvapor, gindex,          &
+                      XLS, XLV, XLF, rhowater, rhosnow,                &
+                      EP2,SVP1,SVP2,SVP3,SVPT0,                        &
+                      kts, kte, i, j                                   )
+!-----------------------------------------------------------------------
+    IMPLICIT NONE
+!-----------------------------------------------------------------------
+!  This program handles the vertical 1-D cloud micphysics
+!-----------------------------------------------------------------------
+! avisc: constant in empirical formular for dynamic viscosity of air
+!         =1.49628e-6 [kg/m/s] = 1.49628e-5 [g/cm/s]
+! adiffwv: constant in empirical formular for diffusivity of water
+!          vapor in air
+!          = 8.7602e-5 [kgm/s3] = 8.7602 [gcm/s3]
+! axka: constant in empirical formular for thermal conductivity of air
+!       = 1.4132e3 [m2/s2/K] = 1.4132e7 [cm2/s2/K]
+! qi0: mixing ratio threshold for cloud ice aggregation [kg/kg]
+! xmi50: mass of a 50 micron ice crystal
+!        = 4.8e-10 [kg] =4.8e-7 [g]
+! xmi40: mass of a 40 micron ice crystal
+!        = 2.46e-10 [kg] = 2.46e-7 [g]
+! di50: diameter of a 50 micro (radius) ice crystal
+!       =1.0e-4 [m]
+! xmi: mass of one cloud ice crystal
+!      =4.19e-13 [kg] = 4.19e-10 [g]
+! oxmi=1.0/xmi
+!
+! xni0=1.0e-2 [m-3] The value given in Lin et al. is wrong.(see
+!                   Hsie et al.(1980) and Rutledge and Hobbs(1983) )
+! bni=0.5 [K-1]
+! xmnin: mass of a natural ice nucleus
+!    = 1.05e-18 [kg] = 1.05e-15 [g] This values is suggested by
+!                    Hsie et al. (1980)
+!    = 1.0e-12 [kg] suggested by Rutlegde and Hobbs (1983)
+! rhowater: density of water=1.0 g/cm3=1000.0 kg/m3
+! consta: constant in empirical formular for terminal
+!         velocity of raindrop
+!         =2115.0 [cm**(1-b)/s] = 2115.0*0.01**(1-b) [m**(1-b)/s]
+! constb: constant in empirical formular for terminal
+!         velocity of raindrop
+!         =0.8
+! xnor: intercept parameter of the raindrop size distribution
+!       = 0.08 cm-4 = 8.0e6 m-4
+! araut: time sacle for autoconversion of cloud water to raindrops
+!       =1.0e-3 [s-1]
+! ql0: mixing ratio threshold for cloud watercoalescence [kg/kg]
+! vf1r: ventilation factors for rain =0.78
+! vf2r: ventilation factors for rain =0.31
+! rhosnow: density of snow=0.1 g/cm3=100.0 kg/m3
+! constc: constant in empirical formular for terminal
+!         velocity of snow
+!         =152.93 [cm**(1-d)/s] = 152.93*0.01**(1-d) [m**(1-d)/s]
+! constd: constant in empirical formular for terminal
+!         velocity of snow
+!         =0.25
+! xnos: intercept parameter of the snowflake size distribution
+! vf1s: ventilation factors for snow =0.78
+! vf2s: ventilation factors for snow =0.31
+!
+!----------------------------------------------------------------------
+
+  INTEGER, INTENT(IN   )               :: kts, kte, i, j
+
+  REAL,    DIMENSION( kts:kte ),                                      &
+           INTENT(INOUT)               :: qvz, qlz, qrz, qiz, qsz,    &
+                                          qgz, thz
+
+  REAL,    DIMENSION( kts:kte ),                                      &
+           INTENT(IN   )               :: tothz, rho, orho, sqrho,    &
+                                          prez, zz, dzw
+
+  REAL,    INTENT(IN   )               :: dt, grav, cp, Rair, rvapor, &
+                                          XLS, XLV, XLF, rhowater,    &
+                                          rhosnow,EP2,SVP1,SVP2,SVP3,SVPT0
+
+  REAL,    INTENT(INOUT)               :: pptrain, pptsnow, pptgraul, pptice
+
+  REAL,    INTENT(IN   )               :: zsfc
+
+! local vars
+
+   REAL                                :: obp4, bp3, bp5, bp6, odp4,  &
+                                          dp3, dp5, dp5o2
+
+
+! temperary vars
+
+   REAL                                :: tmp, tmp0, tmp1, tmp2,tmp3,  &
+                                          tmp4,delta2,delta3, delta4,  &
+                                          tmpa,tmpb,tmpc,tmpd,alpha1,  &
+                                          qic, abi,abr, abg, odtberg,  &
+                                          vti50,eiw,eri,esi,esr, esw,  &
+                                          erw,delrs,term0,term1,araut, &
+                                          constg2, vf1r, vf2r,alpha2,  &
+                                          Ap, Bp, egw, egi, egs, egr,  &
+                                          constg, gdelta4, g1sdelt4,   &
+                                          factor, tmp_r, tmp_s,tmp_g,  &
+                                          qlpqi, rsat, a1, a2, xnin
+
+  INTEGER                              :: k
+!
+  REAL, DIMENSION( kts:kte )    ::  oprez, tem, temcc, theiz, qswz,    &
+                                    qsiz, qvoqswz, qvoqsiz, qvzodt,    &
+                                    qlzodt, qizodt, qszodt, qrzodt,    &
+                                    qgzodt
+
+  REAL, DIMENSION( kts:kte )    :: psnow, psaut, psfw,  psfi,  praci,  &
+                                   piacr, psaci, psacw, psdep, pssub,  &
+                                   pracs, psacr, psmlt, psmltevp,      &
+                                   prain, praut, pracw, prevp, pvapor, &
+                                   pclw,  pladj, pcli,  pimlt, pihom,  &
+                                   pidw,  piadj, pgraupel, pgaut,      &
+                                   pgfr,  pgacw, pgaci, pgacr, pgacs,  &
+                                   pgacip,pgacrp,pgacsp,pgwet, pdry,   &
+                                   pgsub, pgdep, pgmlt, pgmltevp,      &
+                                   qschg, qgchg
+!
+
+  REAL, DIMENSION( kts:kte )    :: qvsbar, rs0, viscmu, visc, diffwv,  &
+                                   schmidt, xka
+
+  REAL, DIMENSION( kts:kte )    :: vtr, vts, vtg,                      &
+                                   vtrold, vtsold, vtgold, vtiold,     &
+                                   xlambdar, xlambdas, xlambdag,       &
+                                   olambdar, olambdas, olambdag
+
+  REAL                          :: episp0k, dtb, odtb, pi, pio4,       &
+                                   pio6, oxLf, xLvocp, xLfocp, consta, &
+                                   constc, ocdrag, gambp4, gamdp4,     &
+                                   gam4pt5, Cpor, oxmi, gambp3, gamdp3,&
+                                   gambp6, gam3pt5, gam2pt75, gambp5o2,&
+                                   gamdp5o2, cwoxlf, ocp, xni50, es
+!
+  REAL                          :: qvmin=1.e-20
+  REAL                          :: gindex
+  REAL                          :: temc1,save1,save2,xni50mx
+
+! for terminal velocity flux
+
+  INTEGER                       :: min_q, max_q
+  REAL                          :: t_del_tv, del_tv, flux, fluxin, fluxout ,tmpqrz
+  LOGICAL                       :: notlast
+!
+
+   dtb=dt
+   odtb=1./dtb
+   pi=acos(-1.)
+   pio4=acos(-1.)/4.
+   pio6=acos(-1.)/6.
+   ocp=1./cp
+   oxLf=1./xLf
+   xLvocp=xLv/cp
+   xLfocp=xLf/cp
+   consta=2115.0*0.01**(1-constb)
+   constc=152.93*0.01**(1-constd)
+   ocdrag=1./Cdrag
+!  episp0k=RH*episp0
+   episp0k=RH*ep2*1000.*svp1
+!
+   gambp4=ggamma(constb+4.)
+   gamdp4=ggamma(constd+4.)
+   gam4pt5=ggamma(4.5)
+   Cpor=cp/Rair
+   oxmi=1.0/xmi
+   gambp3=ggamma(constb+3.)
+   gamdp3=ggamma(constd+3.)
+   gambp6=ggamma(constb+6)
+   gam3pt5=ggamma(3.5)
+   gam2pt75=ggamma(2.75)
+   gambp5o2=ggamma((constb+5.)/2.)
+   gamdp5o2=ggamma((constd+5.)/2.)
+   cwoxlf=cw/xlf
+   delta2=0.
+   delta3=0.
+   delta4=0.
+!
+!-----------------------------------------------------------------------
+!     oprez       1./prez ( prez : pressure)
+!     qsw         saturated mixing ratio on water surface
+!     qsi         saturated mixing ratio on ice surface
+!     episp0k     RH*e*saturated pressure at 273.15 K
+!     qvoqsw      qv/qsw
+!     qvoqsi      qv/qsi
+!     qvzodt      qv/dt
+!     qlzodt      ql/dt
+!     qizodt      qi/dt
+!     qszodt      qs/dt
+!     qrzodt      qr/dt
+!     qgzodt      qg/dt
+!
+!     temcc       temperature in dregee C
+!
+
+      obp4=1.0/(constb+4.0)
+      bp3=constb+3.0
+      bp5=constb+5.0
+      bp6=constb+6.0
+      odp4=1.0/(constd+4.0)
+      dp3=constd+3.0
+      dp5=constd+5.0
+      dp5o2=0.5*(constd+5.0)
+!
+      do k=kts,kte
+         oprez(k)=1./prez(k)
+      enddo
+
+      do k=kts,kte
+         qlz(k)=amax1( 0.0,qlz(k) )
+         qiz(k)=amax1( 0.0,qiz(k) )
+         qvz(k)=amax1( qvmin,qvz(k) )
+         qsz(k)=amax1( 0.0,qsz(k) )
+         qrz(k)=amax1( 0.0,qrz(k) )
+         qgz(k)=amax1( 0.0,qgz(k) )
+!
+         tem(k)=thz(k)*tothz(k)
+         temcc(k)=tem(k)-273.15
+!
+!        qswz(k)=episp0k*oprez(k)* &
+!               exp( svp2*temcc(k)/(tem(k)-svp3) )
+         es=1000.*svp1*exp( svp2*temcc(k)/(tem(k)-svp3) )
+         qswz(k)=ep2*es/(prez(k)-es)
+         if (tem(k) .lt. 273.15 ) then
+!           qsiz(k)=episp0k*oprez(k)* &
+!                  exp( 21.8745584*(tem(k)-273.16)/(tem(k)-7.66) )
+            es=1000.*svp1*exp( 21.8745584*(tem(k)-273.16)/(tem(k)-7.66) )
+            qsiz(k)=ep2*es/(prez(k)-es)
+            if (temcc(k) .lt. -40.0) qswz(k)=qsiz(k)
+         else
+            qsiz(k)=qswz(k)
+         endif
+!
+         qvoqswz(k)=qvz(k)/qswz(k)
+         qvoqsiz(k)=qvz(k)/qsiz(k)
+         qvzodt(k)=amax1( 0.0,odtb*qvz(k) )
+         qlzodt(k)=amax1( 0.0,odtb*qlz(k) )
+         qizodt(k)=amax1( 0.0,odtb*qiz(k) )
+         qszodt(k)=amax1( 0.0,odtb*qsz(k) )
+         qrzodt(k)=amax1( 0.0,odtb*qrz(k) )
+         qgzodt(k)=amax1( 0.0,odtb*qgz(k) )
+
+         theiz(k)=thz(k)+(xlvocp*qvz(k)-xlfocp*qiz(k))/tothz(k)
+      enddo
+
+
+!
+!
+!-----------------------------------------------------------------------
+! In this simple stable cloud parameterization scheme, only five
+! forms of water substance (water vapor, cloud water, cloud ice,
+! rain and snow are considered. The prognostic variables are total
+! water (qp),cloud water (ql), and cloud ice (qi). Rain and snow are
+! diagnosed following Nagata and Ogura, 1991, MWR, 1309-1337. Eq (A7).
+! the micro physics are based on (1) Hsie et al.,1980, JAM, 950-977 ;
+! (2) Lin et al., 1983, JAM, 1065-1092 ; (3) Rutledge and Hobbs, 1983,
+! JAS, 1185-1206 ; (4) Rutledge and Hobbs, 1984, JAS, 2949-2972.
+!-----------------------------------------------------------------------
+!
+! rhowater: density of water=1.0 g/cm3=1000.0 kg/m3
+! rhosnow: density of snow=0.1 g/cm3=100.0 kg/m3
+! xnor: intercept parameter of the raindrop size distribution
+!       = 0.08 cm-4 = 8.0e6 m-4
+! xnos: intercept parameter of the snowflake size distribution
+!       = 0.03 cm-4 = 3.0e6 m-4
+! xnog: intercept parameter of the graupel size distribution
+!       = 4.0e-4 cm-4 = 4.0e4 m-4
+! consta: constant in empirical formular for terminal
+!         velocity of raindrop
+!         =2115.0 [cm**(1-b)/s] = 2115.0*0.01**(1-b) [m**(1-b)/s]
+! constb: constant in empirical formular for terminal
+!         velocity of raindrop
+!         =0.8
+! constc: constant in empirical formular for terminal
+!         velocity of snow
+!         =152.93 [cm**(1-d)/s] = 152.93*0.01**(1-d) [m**(1-d)/s]
+! constd: constant in empirical formular for terminal
+!         velocity of snow
+!         =0.25
+! avisc: constant in empirical formular for dynamic viscosity of air
+!         =1.49628e-6 [kg/m/s] = 1.49628e-5 [g/cm/s]
+! adiffwv: constant in empirical formular for diffusivity of water
+!          vapor in air
+!          = 8.7602e-5 [kgm/s3] = 8.7602 [gcm/s3]
+! axka: constant in empirical formular for thermal conductivity of air
+!       = 1.4132e3 [m2/s2/K] = 1.4132e7 [cm2/s2/K]
+! qi0: mixing ratio threshold for cloud ice aggregation [kg/kg]
+!      = 1.0e-3 g/g = 1.0e-3 kg/gk
+! ql0: mixing ratio threshold for cloud watercoalescence [kg/kg]
+!      = 2.0e-3 g/g = 2.0e-3 kg/gk
+! qs0: mixing ratio threshold for snow aggregation
+!      = 6.0e-4 g/g = 6.0e-4 kg/gk
+! xmi50: mass of a 50 micron ice crystal
+!        = 4.8e-10 [kg] =4.8e-7 [g]
+! xmi40: mass of a 40 micron ice crystal
+!        = 2.46e-10 [kg] = 2.46e-7 [g]
+! di50: diameter of a 50 micro (radius) ice crystal
+!       =1.0e-4 [m]
+! xmi: mass of one cloud ice crystal
+!      =4.19e-13 [kg] = 4.19e-10 [g]
+! oxmi=1.0/xmi
+!
+
+
+! if gindex=1.0 include graupel
+! if gindex=0. no graupel
+!
+!
+      do k=kts,kte
+         psnow(k)=0.0
+         psaut(k)=0.0
+         psfw(k)=0.0
+         psfi(k)=0.0
+         praci(k)=0.0
+         piacr(k)=0.0
+         psaci(k)=0.0
+         psacw(k)=0.0
+         psdep(k)=0.0
+         pssub(k)=0.0
+         pracs(k)=0.0
+         psacr(k)=0.0
+         psmlt(k)=0.0
+         psmltevp(k)=0.0
+!
+         prain(k)=0.0
+         praut(k)=0.0
+         pracw(k)=0.0
+         prevp(k)=0.0
+!
+         pvapor(k)=0.0
+!
+         pclw(k)=0.0
+         pladj(k)=0.0
+!
+         pcli(k)=0.0
+         pimlt(k)=0.0
+         pihom(k)=0.0
+         pidw(k)=0.0
+         piadj(k)=0.0
+      enddo
+
+!
+!!! graupel
+!
+      do k=kts,kte
+         pgraupel(k)=0.0
+         pgaut(k)=0.0
+         pgfr(k)=0.0
+         pgacw(k)=0.0
+         pgaci(k)=0.0
+         pgacr(k)=0.0
+         pgacs(k)=0.0
+         pgacip(k)=0.0
+         pgacrP(k)=0.0
+         pgacsp(k)=0.0
+         pgwet(k)=0.0
+         pdry(k)=0.0
+         pgsub(k)=0.0
+         pgdep(k)=0.0
+         pgmlt(k)=0.0
+         pgmltevp(k)=0.0
+         qschg(k)=0.
+         qgchg(k)=0.
+      enddo
+!
+!
+! Set rs0=episp0*oprez(k)
+! episp0=e*saturated pressure at 273.15 K
+! e     = 0.622
+!
+      DO k=kts,kte
+         rs0(k)=ep2*1000.*svp1/(prez(k)-1000.*svp1)
+      END DO
+!
+!***********************************************************************
+! Calculate precipitation fluxes due to terminal velocities.
+!***********************************************************************
+!
+!- Calculate termianl velocity (vt?)  of precipitation q?z
+!- Find maximum vt? to determine the small delta t
+!
+!-- rain
+!
+    t_del_tv=0.
+    del_tv=dtb
+    notlast=.true.
+    DO while (notlast)
+!
+      min_q=kte
+      max_q=kts-1
+!
+      do k=kts,kte-1
+         if (qrz(k) .gt. 1.0e-8) then
+            min_q=min0(min_q,k)
+            max_q=max0(max_q,k)
+            tmp1=sqrt(pi*rhowater*xnor/rho(k)/qrz(k))
+            tmp1=sqrt(tmp1)
+            vtrold(k)=o6*consta*gambp4*sqrho(k)/tmp1**constb
+            if (k .eq. 1) then
+               del_tv=amin1(del_tv,0.9*(zz(k)-zsfc)/vtrold(k))
+            else
+               del_tv=amin1(del_tv,0.9*(zz(k)-zz(k-1))/vtrold(k))
+            endif
+         else
+            vtrold(k)=0.
+         endif
+      enddo
+
+      if (max_q .ge. min_q) then
+!
+!- Check if the summation of the small delta t >=  big delta t
+!             (t_del_tv)          (del_tv)             (dtb)
+
+         t_del_tv=t_del_tv+del_tv
+!
+         if ( t_del_tv .ge. dtb ) then
+              notlast=.false.
+              del_tv=dtb+del_tv-t_del_tv
+         endif
+!
+         fluxin=0.
+         do k=max_q,min_q,-1
+            fluxout=rho(k)*vtrold(k)*qrz(k)
+            flux=(fluxin-fluxout)/rho(k)/dzw(k)
+            tmpqrz=qrz(k)
+            qrz(k)=qrz(k)+del_tv*flux
+            fluxin=fluxout
+         enddo
+         if (min_q .eq. 1) then
+            pptrain=pptrain+fluxin*del_tv
+         else
+            qrz(min_q-1)=qrz(min_q-1)+del_tv*  &
+                          fluxin/rho(min_q-1)/dzw(min_q-1)
+         endif
+!
+      else
+         notlast=.false.
+      endif
+    ENDDO
+
+!
+!-- snow
+!
+    t_del_tv=0.
+    del_tv=dtb
+    notlast=.true.
+
+    DO while (notlast)
+!
+      min_q=kte
+      max_q=kts-1
+!
+      do k=kts,kte-1
+         if (qsz(k) .gt. 1.0e-8) then
+            min_q=min0(min_q,k)
+            max_q=max0(max_q,k)
+            tmp1=sqrt(pi*rhosnow*xnos/rho(k)/qsz(k))
+            tmp1=sqrt(tmp1)
+            vtsold(k)=o6*constc*gamdp4*sqrho(k)/tmp1**constd
+            if (k .eq. 1) then
+               del_tv=amin1(del_tv,0.9*(zz(k)-zsfc)/vtsold(k))
+            else
+               del_tv=amin1(del_tv,0.9*(zz(k)-zz(k-1))/vtsold(k))
+            endif
+         else
+            vtsold(k)=0.
+         endif
+      enddo
+
+      if (max_q .ge. min_q) then
+!
+!
+!- Check if the summation of the small delta t >=  big delta t
+!             (t_del_tv)          (del_tv)             (dtb)
+
+         t_del_tv=t_del_tv+del_tv
+
+         if ( t_del_tv .ge. dtb ) then
+              notlast=.false.
+              del_tv=dtb+del_tv-t_del_tv
+         endif
+!
+         fluxin=0.
+         do k=max_q,min_q,-1
+            fluxout=rho(k)*vtsold(k)*qsz(k)
+            flux=(fluxin-fluxout)/rho(k)/dzw(k)
+            qsz(k)=qsz(k)+del_tv*flux
+            qsz(k)=amax1(0.,qsz(k))
+            fluxin=fluxout
+         enddo
+         if (min_q .eq. 1) then
+            pptsnow=pptsnow+fluxin*del_tv
+         else
+            qsz(min_q-1)=qsz(min_q-1)+del_tv*  &
+                         fluxin/rho(min_q-1)/dzw(min_q-1)
+         endif
+!
+      else
+         notlast=.false.
+      endif
+
+    ENDDO
+!
+!-- grauupel
+!
+    t_del_tv=0.
+    del_tv=dtb
+    notlast=.true.
+!
+    DO while (notlast)
+!
+      min_q=kte
+      max_q=kts-1
+!
+      do k=kts,kte-1
+         if (qgz(k) .gt. 1.0e-8) then
+            min_q=min0(min_q,k)
+            max_q=max0(max_q,k)
+            tmp1=sqrt(pi*rhograul*xnog/rho(k)/qgz(k))
+            tmp1=sqrt(tmp1)
+            term0=sqrt(4.*grav*rhograul*0.33334/rho(k)/cdrag)
+            vtgold(k)=o6*gam4pt5*term0*sqrt(1./tmp1)
+            if (k .eq. 1) then
+               del_tv=amin1(del_tv,0.9*(zz(k)-zsfc)/vtgold(k))
+            else
+               del_tv=amin1(del_tv,0.9*(zz(k)-zz(k-1))/vtgold(k))
+            endif
+         else
+            vtgold(k)=0.
+         endif
+      enddo
+
+      if (max_q .ge. min_q) then
+!
+!
+!- Check if the summation of the small delta t >=  big delta t
+!             (t_del_tv)          (del_tv)             (dtb)
+
+         t_del_tv=t_del_tv+del_tv
+
+         if ( t_del_tv .ge. dtb ) then
+              notlast=.false.
+              del_tv=dtb+del_tv-t_del_tv
+         endif
+
+!
+         fluxin=0.
+         do k=max_q,min_q,-1
+            fluxout=rho(k)*vtgold(k)*qgz(k)
+            flux=(fluxin-fluxout)/rho(k)/dzw(k)
+            qgz(k)=qgz(k)+del_tv*flux
+            qgz(k)=amax1(0.,qgz(k))
+            fluxin=fluxout
+         enddo
+         if (min_q .eq. 1) then
+            pptgraul=pptgraul+fluxin*del_tv
+         else
+            qgz(min_q-1)=qgz(min_q-1)+del_tv*  &
+                         fluxin/rho(min_q-1)/dzw(min_q-1)
+         endif
+!
+      else
+         notlast=.false.
+      endif
+!
+   ENDDO
+
+!
+!-- cloud ice  (03/21/02) follow Vaughan T.J. Phillips at GFDL
+!
+    t_del_tv=0.
+    del_tv=dtb
+    notlast=.true.
+!
+    DO while (notlast)
+!
+      min_q=kte
+      max_q=kts-1
+!
+      do k=kts,kte-1
+         if (qiz(k) .gt. 1.0e-8) then
+            min_q=min0(min_q,k)
+            max_q=max0(max_q,k)
+            vtiold(k)= 3.29 * (rho(k)* qiz(k))** 0.16  ! Heymsfield and Donner
+            if (k .eq. 1) then
+               del_tv=amin1(del_tv,0.9*(zz(k)-zsfc)/vtiold(k))
+            else
+               del_tv=amin1(del_tv,0.9*(zz(k)-zz(k-1))/vtiold(k))
+            endif
+         else
+            vtiold(k)=0.
+         endif
+      enddo
+
+      if (max_q .ge. min_q) then
+!
+!
+!- Check if the summation of the small delta t >=  big delta t
+!             (t_del_tv)          (del_tv)             (dtb)
+
+         t_del_tv=t_del_tv+del_tv
+
+         if ( t_del_tv .ge. dtb ) then
+              notlast=.false.
+              del_tv=dtb+del_tv-t_del_tv
+         endif
+
+         fluxin=0.
+         do k=max_q,min_q,-1
+            fluxout=rho(k)*vtiold(k)*qiz(k)
+            flux=(fluxin-fluxout)/rho(k)/dzw(k)
+            qiz(k)=qiz(k)+del_tv*flux
+            qiz(k)=amax1(0.,qiz(k))
+            fluxin=fluxout
+         enddo
+         if (min_q .eq. 1) then
+            pptice=pptice+fluxin*del_tv
+         else
+            qiz(min_q-1)=qiz(min_q-1)+del_tv*  &
+                         fluxin/rho(min_q-1)/dzw(min_q-1)
+         endif
+!
+      else
+         notlast=.false.
+      endif
+!
+   ENDDO
+
+! Microphpysics processes
+!
+      DO 2000 k=kts,kte
+!
+!***********************************************************************
+!*****   diagnose mixing ratios (qrz,qsz), terminal                *****
+!*****   velocities (vtr,vts), and slope parameters in size        *****
+!*****   distribution(xlambdar,xlambdas) of rain and snow          *****
+!*****   follows Nagata and Ogura, 1991, MWR, 1309-1337. Eq (A7)   *****
+!***********************************************************************
+!
+!**** assuming no cloud water can exist in the top two levels due to
+!**** radiation consideration
+!
+!!  if
+!!     unsaturated,
+!!     no cloud water, rain, ice, snow and graupel
+!!  then
+!!     skip these processes and jump to line 2000
+!
+!
+        tmp=qiz(k)+qlz(k)+qsz(k)+qrz(k)+qgz(k)*gindex
+        if( qvz(k)+qlz(k)+qiz(k) .lt. qsiz(k)  &
+            .and. tmp .eq. 0.0 ) go to 2000
+
+!! calculate terminal velocity of rain
+!
+        if (qrz(k) .gt. 1.0e-8) then
+            tmp1=sqrt(pi*rhowater*xnor*orho(k)/qrz(k))
+            xlambdar(k)=sqrt(tmp1)
+            olambdar(k)=1.0/xlambdar(k)
+            vtrold(k)=o6*consta*gambp4*sqrho(k)*olambdar(k)**constb
+        else
+            vtrold(k)=0.
+            olambdar(k)=0.
+        endif
+!
+!       if (qrz(k) .gt. 1.0e-12) then
+        if (qrz(k) .gt. 1.0e-8) then
+            tmp1=sqrt(pi*rhowater*xnor*orho(k)/qrz(k))
+            xlambdar(k)=sqrt(tmp1)
+            olambdar(k)=1.0/xlambdar(k)
+            vtr(k)=o6*consta*gambp4*sqrho(k)*olambdar(k)**constb
+        else
+            vtr(k)=0.
+            olambdar(k)=0.
+        endif
+!
+!! calculate terminal velocity of snow
+!
+        if (qsz(k) .gt. 1.0e-8) then
+            tmp1=sqrt(pi*rhosnow*xnos*orho(k)/qsz(k))
+            xlambdas(k)=sqrt(tmp1)
+            olambdas(k)=1.0/xlambdas(k)
+            vtsold(k)=o6*constc*gamdp4*sqrho(k)*olambdas(k)**constd
+        else
+            vtsold(k)=0.
+            olambdas(k)=0.
+        endif
+!
+!       if (qsz(k) .gt. 1.0e-12) then
+        if (qsz(k) .gt. 1.0e-8) then
+            tmp1=sqrt(pi*rhosnow*xnos*orho(k)/qsz(k))
+            xlambdas(k)=sqrt(tmp1)
+            olambdas(k)=1.0/xlambdas(k)
+            vts(k)=o6*constc*gamdp4*sqrho(k)*olambdas(k)**constd
+        else
+            vts(k)=0.
+            olambdas(k)=0.
+        endif
+!
+!! calculate terminal velocity of graupel
+!
+        if (qgz(k) .gt. 1.0e-8) then
+            tmp1=sqrt( pi*rhograul*xnog*orho(k)/qgz(k))
+            xlambdag(k)=sqrt(tmp1)
+            olambdag(k)=1.0/xlambdag(k)
+            term0=sqrt(4.*grav*rhograul*0.33334*orho(k)*ocdrag)
+            vtgold(k)=o6*gam4pt5*term0*sqrt(olambdag(k))
+        else
+            vtgold(k)=0.
+            olambdag(k)=0.
+        endif
+!
+!       if (qgz(k) .gt. 1.0e-12) then
+        if (qgz(k) .gt. 1.0e-8) then
+            tmp1=sqrt( pi*rhograul*xnog*orho(k)/qgz(k))
+            xlambdag(k)=sqrt(tmp1)
+            olambdag(k)=1.0/xlambdag(k)
+            term0=sqrt(4.*grav*rhograul*0.33334*orho(k)*ocdrag)
+            vtg(k)=o6*gam4pt5*term0*sqrt(olambdag(k))
+        else
+            vtg(k)=0.
+            olambdag(k)=0.
+        endif
+!
+!***********************************************************************
+!*****  compute viscosity,difusivity,thermal conductivity, and    ******
+!*****  Schmidt number                                            ******
+!***********************************************************************
+!c------------------------------------------------------------------
+!c      viscmu: dynamic viscosity of air kg/m/s
+!c      visc: kinematic viscosity of air = viscmu/rho (m2/s)
+!c      avisc=1.49628e-6 kg/m/s=1.49628e-5 g/cm/s
+!c      viscmu=1.718e-5 kg/m/s in RH
+!c      diffwv: Diffusivity of water vapor in air
+!c      adiffwv = 8.7602e-5 (8.794e-5 in MM5) kgm/s3
+!c              = 8.7602 (8.794 in MM5) gcm/s3
+!c      diffwv(k)=2.26e-5 m2/s
+!c      schmidt: Schmidt number=visc/diffwv
+!c      xka: thermal conductivity of air J/m/s/K (Kgm/s3/K)
+!c      xka(k)=2.43e-2 J/m/s/K in RH
+!c      axka=1.4132e3 (1.414e3 in MM5) m2/s2/k = 1.4132e7 cm2/s2/k
+!c------------------------------------------------------------------
+
+        viscmu(k)=avisc*tem(k)**1.5/(tem(k)+120.0)
+        visc(k)=viscmu(k)*orho(k)
+        diffwv(k)=adiffwv*tem(k)**1.81*oprez(k)
+        schmidt(k)=visc(k)/diffwv(k)
+        xka(k)=axka*viscmu(k)
+
+        if (tem(k) .lt. 273.15) then
+
+!
+!***********************************************************************
+!*********        snow production processes for T < 0 C       **********
+!***********************************************************************
+!c
+!c (1) ICE CRYSTAL AGGREGATION TO SNOW (Psaut): Lin (21)
+!c!    psaut=alpha1*(qi-qi0)
+!c!    alpha1=1.0e-3*exp(0.025*(T-T0))
+!c
+!          alpha1=1.0e-3*exp( 0.025*temcc(k) )
+
+           alpha1=1.0e-3*exp( 0.025*temcc(k) )
+!
+           if(temcc(k) .lt. -20.0) then
+             tmp1=-7.6+4.0*exp( -0.2443e-3*(abs(temcc(k))-20)**2.455 )
+             qic=1.0e-3*exp(tmp1)*orho(k)
+           else
+             qic=qi0
+           end if
+!testing
+!          tmp1=amax1( 0.0,alpha1*(qiz(k)-qic) )
+!          psaut(k)=amin1( tmp1,qizodt(k) )
+
+           tmp1=odtb*(qiz(k)-qic)*(1.0-exp(-alpha1*dtb))
+           psaut(k)=amax1( 0.0,tmp1 )
+
+!c
+!c (2) BERGERON PROCESS TRANSFER OF CLOUD WATER TO SNOW (Psfw)
+!c     this process only considered when -31 C < T < 0 C
+!c     Lin (33) and Hsie (17)
+!c
+!c!
+!c!    parama1 and parama2 functions must be user supplied
+!c!
+
+! testing
+          if( qlz(k) .gt. 1.0e-10 ) then
+            temc1=amax1(-30.99,temcc(k))
+!           print*,'temc1',temc1,qlz(k)
+            a1=parama1( temc1 )
+            a2=parama2( temc1 )
+            tmp1=1.0-a2
+!! change unit from cgs to mks
+            a1=a1*0.001**tmp1
+!c!   dtberg is the time needed for a crystal to grow from 40 to 50 um
+!c !  odtberg=1.0/dtberg
+            odtberg=(a1*tmp1)/(xmi50**tmp1-xmi40**tmp1)
+!
+!c!   compute terminal velocity of a 50 micron ice cystal
+!
+            vti50=constc*di50**constd*sqrho(k)
+!
+            eiw=1.0
+            save1=a1*xmi50**a2
+            save2=0.25*pi*eiw*rho(k)*di50*di50*vti50
+!
+            tmp2=( save1 + save2*qlz(k) )
+!
+!! maximum number of 50 micron crystals limited by the amount
+!!  of supercool water
+!
+            xni50mx=qlzodt(k)/tmp2
+!
+!!   number of 50 micron crystals produced
+!
+!
+            xni50=qiz(k)*( 1.0-exp(-dtb*odtberg) )/xmi50
+            xni50=amin1(xni50,xni50mx)
+!
+            tmp3=odtb*tmp2/save2*( 1.0-exp(-save2*xni50*dtb) )
+            psfw(k)=amin1( tmp3,qlzodt(k) )
+!testing
+!           psfw(k)=0.
+
+!0915     if( temcc(k).gt.-30.99 ) then
+!0915        a1=parama1( temcc(k) )
+!0915        a2=parama2( temcc(k) )
+!0915        tmp1=1.0-a2
+!!     change unit from cgs to mks
+!0915        a1=a1*0.001**tmp1
+
+!c!    dtberg is the time needed for a crystal to grow from 40 to 50 um
+!c!    odtberg=1.0/dtberg
+!0915        odtberg=(a1*tmp1)/(xmi50**tmp1-xmi40**tmp1)
+
+!c!    number of 50 micron crystals produced
+!0915        xni50=qiz(k)*dtb*odtberg/xmi50
+
+!c!    need to calculate the terminal velocity of a 50 micron
+!c!    ice cystal
+!0915        vti50=constc*di50**constd*sqrho(k)
+!0915        eiw=1.0
+!0915        tmp2=xni50*( a1*xmi50**a2 + &
+!0915             0.25*qlz(k)*pi*eiw*rho(k)*di50*di50*vti50 )
+!0915        psfw(k)=amin1( tmp2,qlzodt(k) )
+!0915        psfw(k)=0.
+!c
+!c (3) REDUCTION OF CLOUD ICE BY BERGERON PROCESS (Psfi): Lin (34)
+!c     this process only considered when -31 C < T < 0 C
+!c
+            tmp1=xni50*xmi50-psfw(k)
+            psfi(k)=amin1(tmp1,qizodt(k))
+! testing
+!           psfi(k)=0.
+          end if
+!
+
+!0915        tmp1=qiz(k)*odtberg
+!0915        psfi(k)=amin1(tmp1,qizodt(k))
+! testing
+!0915        psfi(k)=0.
+!0915     end if
+!
+          if(qrz(k) .le. 0.0) go to 1000
+!
+! Processes (4) and (5) only need when qrz > 0.0
+!
+!c
+!c (4) CLOUD ICE ACCRETION BY RAIN (Praci): Lin (25)
+!c     may produce snow or graupel
+!c
+          eri=1.0
+!0915     tmp1=qiz(k)*pio4*eri*xnor*consta*sqrho(k)
+!0915     tmp2=tmp1*gambp3*olambdar(k)**bp3
+!0915     praci(k)=amin1( tmp2,qizodt(k) )
+
+          save1=pio4*eri*xnor*consta*sqrho(k)
+          tmp1=save1*gambp3*olambdar(k)**bp3
+          praci(k)=qizodt(k)*( 1.0-exp(-tmp1*dtb) )
+
+!c
+!c (5) RAIN ACCRETION BY CLOUD ICE (Piacr): Lin (26)
+!c
+!0915     tmp2=tmp1*rho(k)*pio6*rhowater*gambp6*oxmi* &
+!0915              olambdar(k)**bp6
+!0915     piacr(k)=amin1( tmp2,qrzodt(k) )
+
+          tmp2=qiz(k)*save1*rho(k)*pio6*rhowater*gambp6*oxmi* &
+                   olambdar(k)**bp6
+          piacr(k)=amin1( tmp2,qrzodt(k) )
+
+!
+1000      continue
+!
+          if(qsz(k) .le. 0.0) go to 1200
+!
+! Compute the following processes only when qsz > 0.0
+!
+!c
+!c (6) ICE CRYSTAL ACCRETION BY SNOW (Psaci): Lin (22)
+!c
+          esi=exp( 0.025*temcc(k) )
+          save1=pio4*xnos*constc*gamdp3*sqrho(k)* &
+               olambdas(k)**dp3
+          tmp1=esi*save1
+          psaci(k)=qizodt(k)*( 1.0-exp(-tmp1*dtb) )
+
+!0915     tmp1=pio4*xnos*constc*gamdp3*sqrho(k)* &
+!0915          olambdas(k)**dp3
+!0915     tmp2=qiz(k)*esi*tmp1
+!0915     psaci(k)=amin1( tmp2,qizodt(k) )
+!c
+!c (7) CLOUD WATER ACCRETION BY SNOW (Psacw): Lin (24)
+!c
+          esw=1.0
+          tmp1=esw*save1
+          psacw(k)=qlzodt(K)*( 1.0-exp(-tmp1*dtb) )
+
+!0915     tmp2=qlz(k)*esw*tmp1
+!0915     psacw(k)=amin1( tmp2,qlzodt(k) )
+!c
+!c (8) DEPOSITION/SUBLIMATION OF SNOW (Psdep/Pssub): Lin (31)
+!c     includes consideration of ventilation effect
+!c
+!c     abi=2*pi*(Si-1)/rho/(A"+B")
+!c
+          tmpa=rvapor*xka(k)*tem(k)*tem(k)
+          tmpb=xls*xls*rho(k)*qsiz(k)*diffwv(k)
+          tmpc=tmpa*qsiz(k)*diffwv(k)
+          abi=2.0*pi*(qvoqsiz(k)-1.0)*tmpc/(tmpa+tmpb)
+!
+!c     vf1s,vf2s=ventilation factors for snow
+!c     vf1s=0.78,vf2s=0.31 in LIN
+!
+          tmp1=constc*sqrho(k)*olambdas(k)**dp5/visc(k)
+          tmp2=abi*xnos*( vf1s*olambdas(k)*olambdas(k)+ &
+                    vf2s*schmidt(k)**0.33334*gamdp5o2*sqrt(tmp1) )
+          tmp3=odtb*( qvz(k)-qsiz(k) )
+!
+          if( tmp2 .le. 0.0) then
+            tmp2=amax1( tmp2,tmp3)
+            pssub(k)=amax1( tmp2,-qszodt(k) )
+            psdep(k)=0.0
+          else
+            psdep(k)=amin1( tmp2,tmp3 )
+            pssub(k)=0.0
+          end if
+
+!0915     psdep(k)=amax1(0.0,tmp2)
+!0915     pssub(k)=amin1(0.0,tmp2)
+!0915     pssub(k)=amax1( pssub(k),-qszodt(k) )
+!
+          if(qrz(k) .le. 0.0) go to 1200
+!
+! Compute processes (9) and (10) only when qsz > 0.0 and qrz > 0.0
+!
+!c
+!c (9) ACCRETION OF SNOW BY RAIN (Pracs): Lin (27)
+!c
+          esr=1.0
+          tmpa=olambdar(k)*olambdar(k)
+          tmpb=olambdas(k)*olambdas(k)
+          tmpc=olambdar(k)*olambdas(k)
+          tmp1=pi*pi*esr*xnor*xnos*abs( vtr(k)-vts(k) )*orho(k)
+          tmp2=tmpb*tmpb*olambdar(k)*(5.0*tmpb+2.0*tmpc+0.5*tmpa)
+          tmp3=tmp1*rhosnow*tmp2
+          pracs(k)=amin1( tmp3,qszodt(k) )
+!c
+!c (10)  ACCRETION OF RAIN BY SNOW (Psacr): Lin (28)
+!c
+          tmp3=tmpa*tmpa*olambdas(k)*(5.0*tmpa+2.0*tmpc+0.5*tmpb)
+          tmp4=tmp1*rhowater*tmp3
+          psacr(k)=amin1( tmp4,qrzodt(k) )
+!
+1200      continue
+!
+        else
+!
+!***********************************************************************
+!*********        snow production processes for T > 0 C       **********
+!***********************************************************************
+!
+         if (qsz(k) .le. 0.0) go to 1400
+!c
+!c (1) CLOUD WATER ACCRETION BY SNOW (Psacw): Lin (24)
+!c
+            esw=1.0
+
+            tmp1=esw*pio4*xnos*constc*gamdp3*sqrho(k)* &
+                 olambdas(k)**dp3
+            psacw(k)=qlzodt(k)*( 1.0-exp(-tmp1*dtb) )
+
+!0915       tmp1=pio4*xnos*constc*gamdp3*sqrho(k)* &
+!0915            olambdas(k)**dp3
+!0915       tmp2=qlz(k)*esw*tmp1
+!0915       psacw(k)=amin1( tmp2,qlzodt(k) )
+!c
+!c (2) ACCRETION OF RAIN BY SNOW (Psacr): Lin (28)
+!c
+            esr=1.0
+            tmpa=olambdar(k)*olambdar(k)
+            tmpb=olambdas(k)*olambdas(k)
+            tmpc=olambdar(k)*olambdas(k)
+            tmp1=pi*pi*esr*xnor*xnos*abs( vtr(k)-vts(k) )*orho(k)
+            tmp2=tmpa*tmpa*olambdas(k)*(5.0*tmpa+2.0*tmpc+0.5*tmpb)
+            tmp3=tmp1*rhowater*tmp2
+            psacr(k)=amin1( tmp3,qrzodt(k) )
+!c
+!c (3) MELTING OF SNOW (Psmlt): Lin (32)
+!c     Psmlt is negative value
+!
+            delrs=rs0(k)-qvz(k)
+            term1=2.0*pi*orho(k)*( xlv*diffwv(k)*rho(k)*delrs- &
+                  xka(k)*temcc(k) )
+            tmp1=constc*sqrho(k)*olambdas(k)**dp5/visc(k)
+            tmp2=xnos*( vf1s*olambdas(k)*olambdas(k)+  &
+                 vf2s*schmidt(k)**0.33334*gamdp5o2*sqrt(tmp1) )
+            tmp3=term1*oxlf*tmp2-cwoxlf*temcc(k)*( psacw(k)+psacr(k) )
+            tmp4=amin1(0.0,tmp3)
+            psmlt(k)=amax1( tmp4,-qszodt(k) )
+!c
+!c (4) EVAPORATION OF MELTING SNOW (Psmltevp): HR (A27)
+!c     but use Lin et al. coefficience
+!c     Psmltevp is a negative value
+!c
+            tmpa=rvapor*xka(k)*tem(k)*tem(k)
+            tmpb=xlv*xlv*rho(k)*qswz(k)*diffwv(k)
+            tmpc=tmpa*qswz(k)*diffwv(k)
+            tmpd=amin1( 0.0,(qvoqswz(k)-0.90)*qswz(k)*odtb )
+
+!      abr=2.0*pi*(qvoqswz(k)-1.0)*tmpc/(tmpa+tmpb)
+
+            abr=2.0*pi*(qvoqswz(k)-0.90)*tmpc/(tmpa+tmpb)
+!
+!**** allow evaporation to occur when RH less than 90%
+!**** here not using 100% because the evaporation cooling
+!**** of temperature is not taking into account yet; hence,
+!**** the qsw value is a little bit larger. This will avoid
+!**** evaporation can generate cloud.
+!
+!c    vf1s,vf2s=ventilation factors for snow
+!c    vf1s=0.78,vf2s=0.31 in LIN
+!
+            tmp1=constc*sqrho(k)*olambdas(k)**dp5/visc(k)
+            tmp2=abr*xnos*( vf1s*olambdas(k)*olambdas(k)+  &
+                 vf2s*schmidt(k)**0.33334*gamdp5o2*sqrt(tmp1) )
+            tmp3=amin1(0.0,tmp2)
+            tmp3=amax1( tmp3,tmpd )
+            psmltevp(k)=amax1( tmp3,-qszodt(k) )
+1400     continue
+!
+        end if
+
+!***********************************************************************
+!*********           rain production processes                **********
+!***********************************************************************
+!
+!c
+!c (1) AUTOCONVERSION OF RAIN (Praut): RH
+!c     araut=afa*rho
+!c     afa=0.001 Rate coefficient for autoconvergence
+!c
+!c     araut=1.0e-3
+!c
+         araut=0.001
+!testing
+!        tmp1=amax1( 0.0,araut*(qlz(k)-ql0) )
+!        praut(k)=amin1( tmp1,qlzodt(k) )
+         tmp1=odtb*(qlz(k)-ql0)*( 1.0-exp(-araut*dtb) )
+         praut(k)=amax1( 0.0,tmp1 )
+
+!c
+!c (2) ACCRETION OF CLOUD WATER BY RAIN (Pracw): Lin (51)
+!c
+         erw=1.0
+!        tmp1=qlz(k)*pio4*erw*xnor*consta*sqrho(k)
+!        tmp2=tmp1*gambp3*olambdar(k)**bp3
+!        pracw(k)=amin1( tmp2,qlzodt(k) )
+
+        tmp1=pio4*erw*xnor*consta*sqrho(k)* &
+             gambp3*olambdar(k)**bp3
+        pracw(k)=qlzodt(k)*( 1.0-exp(-tmp1*dtb) )
+
+!c
+!c (3) EVAPORATION OF RAIN (Prevp): Lin (52)
+!c     Prevp is negative value
+!c
+!c     Sw=qvoqsw : saturation ratio
+!c
+         tmpa=rvapor*xka(k)*tem(k)*tem(k)
+         tmpb=xlv*xlv*rho(k)*qswz(k)*diffwv(k)
+         tmpc=tmpa*qswz(k)*diffwv(k)
+         tmpd=amin1(0.0,(qvoqswz(k)-0.90)*qswz(k)*odtb)
+!
+!      abr=2.0*pi*(qvoqswz(k)-1.0)*tmpc/(tmpa+tmpb)
+
+         abr=2.0*pi*(qvoqswz(k)-0.90)*tmpc/(tmpa+tmpb)
+!
+!c     vf1r,vf2r=ventilation factors for rain
+!c     vf1r=0.78,vf2r=0.31 in RH, LIN  and MM5
+!
+         vf1r=0.78
+         vf2r=0.31
+         tmp1=consta*sqrho(k)*olambdar(k)**bp5/visc(k)
+         tmp2=abr*xnor*( vf1r*olambdar(k)*olambdar(k)+  &
+              vf2r*schmidt(k)**0.33334*gambp5o2*sqrt(tmp1) )
+         tmp3=amin1( 0.0,tmp2 )
+         tmp3=amax1( tmp3,tmpd )
+         prevp(k)=amax1( tmp3,-qrzodt(k) )
+
+!
+!      if(iout .gt. 0) write(20,*)'tmp1,tmp2,tmp3=',tmp1,tmp2,tmp3
+!      if(iout .gt. 0) write(20,*)'qlz,qiz,qrz=',qlz(k),qiz(k),qrz(k)
+!      if(iout .gt. 0) write(20,*)'tem,qsz,qvz=',tem(k),qsz(k),qvz(k)
+
+
+
+!     if (gindex .eq. 0.) goto 900
+!
+      if (tem(k) .lt. 273.15) then
+!
+!
+!-- graupel
+!***********************************************************************
+!*********        graupel production processes for T < 0 C    **********
+!***********************************************************************
+!c
+!c (1) AUTOCONVERSION OF SNOW TO FORM GRAUPEL (Pgaut): Lin (37)
+!c     pgaut=alpha2*(qsz-qs0)
+!c     qs0=6.0E-4
+!c     alpha2=1.0e-3*exp(0.09*temcc(k))      Lin (38)
+!
+            alpha2=1.0e-3*exp(0.09*temcc(k))
+!
+
+! testing
+!           tmp1=alpha2*(qsz(k)-qs0)
+!           tmp1=amax1(0.0,tmp1)
+!           pgaut(k)=amin1( tmp1,qszodt(k) )
+
+            tmp1=odtb*(qsz(k)-qs0)*(1.0-exp(-alpha2*dtb))
+            pgaut(k)=amax1( 0.0,tmp1 )
+
+!c
+!c (2) FREEZING OF RAIN TO FORM GRAUPEL  (Pgfr): Lin (45)
+!c     positive value
+!c     Constant in Bigg freezing Aplume=Ap=0.66 /k
+!c     Constant in raindrop freezing equ. Bplume=Bp=100./m/m/m/s
+!
+
+            if (qrz(k) .gt. 1.e-8 ) then
+               Bp=100.
+               Ap=0.66
+               tmp1=olambdar(k)*olambdar(k)*olambdar(k)
+               tmp2=20.*pi*pi*Bp*xnor*rhowater*orho(k)*  &
+                    (exp(-Ap*temcc(k))-1.0)*tmp1*tmp1*olambdar(k)
+               Pgfr(k)=amin1( tmp2,qrzodt(k) )
+            else
+               Pgfr(k)=0
+            endif
+
+!c
+!c       if (qgz(k) = 0.0) skip the other step below about graupel
+!c
+         if (qgz(k) .eq. 0.0) goto 4000
+
+!c
+!c       Comparing Pgwet(wet process) and Pdry(dry process),
+!c       we will pick up the small one.
+!c
+
+!c       ---------------
+!c      | dry processes |
+!c       ---------------
+!c
+!c (3)   ACCRETION OF CLOUD WATER BY GRAUPEL  (Pgacw): Lin (40)
+!c       egw=1.0
+!c       Cdrag=0.6 drag coefficients for hairstone
+!c       constg=sqrt(4.*grav*rhograul*0.33334*orho(k)/Cdrag)
+!c
+         egw=1.0
+         constg=sqrt(4.*grav*rhograul*0.33334*orho(k)*oCdrag)
+         tmp1=pio4*xnog*gam3pt5*constg*olambdag(k)**3.5
+         tmp2=qlz(k)*egw*tmp1
+         Pgacw(k)=amin1( tmp2,qlzodt(k) )
+!c
+!c (4)   ACCRETION OF ICE CRYSTAL BY GRAUPEL  (Pgaci): Lin (41)
+!c       egi=1.   for wet growth
+!c       egi=0.1  for dry growth
+!c
+         egi=0.1
+         tmp2=qiz(k)*egi*tmp1
+         pgaci(k)=amin1( tmp2,qizodt(k) )
+
+
+!c
+!c (5)   ACCRETION OF SNOW BY GRAUPEL  (Pgacs) : Lin (29)
+!c       Compute processes (6) only when qsz > 0.0 and qgz > 0.0
+!c
+         egs=exp(0.09*temcc(k))
+         tmpa=olambdas(k)*olambdas(k)
+         tmpb=olambdag(k)*olambdag(k)
+         tmpc=olambdas(k)*olambdag(k)
+         tmp1=pi*pi*xnos*xnog*abs( vts(k)-vtg(k) )*orho(k)
+         tmp2=tmpa*tmpa*olambdag(k)*(5.0*tmpa+2.0*tmpc+0.5*tmpb)
+         tmp3=tmp1*egs*rhosnow*tmp2
+         Pgacs(k)=amin1( tmp3,qszodt(k) )
+
+
+!c
+!c (6)   ACCRETION OF RAIN BY GRAUPEL (Pgacr): Lin (42)
+!c       Compute processes (6) only when qrz > 0.0 and qgz > 0.0
+!c       egr=1.
+!c
+         egr=1.
+         tmpa=olambdar(k)*olambdar(k)
+         tmpb=olambdag(k)*olambdag(k)
+         tmpc=olambdar(k)*olambdag(k)
+         tmp1=pi*pi*xnor*xnog*abs( vtr(k)-vtg(k) )*orho(k)
+         tmp2=tmpa*tmpa*olambdag(k)*(5.0*tmpa+2.0*tmpc+0.5*tmpb)
+         tmp3=tmp1*egr*rhowater*tmp2
+         pgacr(k)=amin1( tmp3,qrzodt(k) )
+
+!c
+!c (7)   Calculate total dry process effect Pdry(k)
+!c
+         Pdry(k)=Pgacw(k)+pgaci(k)+Pgacs(k)+pgacr(k)
+
+!c       ---------------
+!c      | wet processes |
+!c       ---------------
+!c
+!c (3)   ACCRETION OF ICE CRYSTAL BY GRAUPEL  (Pgacip): Lin (41)
+!c       egi=1.   for wet growth
+!c       egi=0.1  for dry growth
+!c
+         tmp2=10.*pgaci(k)
+         pgacip(k)=amin1( tmp2,qizodt(k) )
+
+!c
+!c (4)   ACCRETION OF SNOW BY GRAUPEL  ((Pgacsp) : Lin (29)
+!c       Compute processes (6) only when qsz > 0.0 and qgz > 0.0
+!c       egs=exp(0.09*(tem(k)-273.15))  when T < 273.15 k
+!c
+         tmp3=Pgacs(k)*1.0/egs
+         Pgacsp(k)=amin1( tmp3,qszodt(k) )
+
+!c
+!c (5)   WET GROWTH OF GRAUPEL (Pgwet) : Lin (43)
+!c       may involve Pgacs or Pgaci and
+!c       must include PPgacw or Pgacr, or both.
+!c       ( The amount of Pgacw which is not able
+!c       to freeze is shed to rain. )
+         IF(temcc(k).gt.-40.)THEN
+
+             term0=constg*olambdag(k)**5.5/visc(k)
+
+!c
+!c    vf1s,vf2s=ventilation factors for graupel
+!c    vf1s=0.78,vf2s=0.31 in LIN
+!c    Cdrag=0.6  drag coefficient for hairstone
+!c    constg2=vf1s*olambdag(k)*olambdag(k)+
+!c            vf2s*schmidt(k)**0.33334*gam2pt75*sqrt(term0)
+
+             delrs=rs0(k)-qvz(k)
+             tmp0=1./(xlf+cw*temcc(k))
+             tmp1=2.*pi*xnog*(rho(k)*xlv*diffwv(k)*delrs-xka(k)*  &
+                  temcc(k))*orho(k)*tmp0
+             constg2=vf1s*olambdag(k)*olambdag(k)+  &
+                     vf2s*schmidt(k)**0.33334*gam2pt75*sqrt(term0)
+             tmp3=tmp1*constg2+(Pgacip(k)+Pgacsp(k))*  &
+                  (1-Ci*temcc(k)*tmp0)
+             tmp3=amax1(0.0,tmp3)
+             Pgwet(k)=amax1(tmp3,qlzodt(k)+qszodt(k)+qizodt(k) )
+
+!c
+!c     Comparing Pgwet(wet process) and Pdry(dry process),
+!c     we will apply the small one.
+!c     if dry processes then delta4=1.0
+!c     if wet processes then delta4=0.0
+!
+         if ( Pdry(k) .lt. Pgwet(k) ) then
+            delta4=1.0
+         else
+            delta4=0.0
+         endif
+         ELSE
+            delta4=1.0
+         ENDIF
+
+!c
+!c
+!c (6)   Pgacrp(k)=Pgwet(k)-Pgacw(k)-Pgacip(k)-Pgacsp(k)
+!c       if Pgacrp(k) > 0. then some of the rain is frozen to hail
+!c       if Pgacrp(k) < 0. then some of the cloud water collected
+!c                            by the hail is unable to freeze and is
+!c                            shed as rain.
+!c
+            Pgacrp(k)=Pgwet(k)-Pgacw(k)-Pgacip(k)-Pgacsp(k)
+
+!c
+!c (8)   DEPOSITION/SUBLIMATION OF GRAUPEL  (Pgdep/Pgsub): Lin (46)
+!c       includes ventilation effect
+!c       constg=sqrt(4.*grav*rhograul*0.33334*orho(k)/Cdrag)
+!c       constg2=vf1s*olambdag(k)*olambdag(k)+
+!c             vf2s*schmidt(k)**0.33334*gam2pt75*constg
+!c
+!c       abg=2*pi*(Si-1)/rho/(A"+B")
+!c
+            tmpa=rvapor*xka(k)*tem(k)*tem(k)
+            tmpb=xls*xls*rho(k)*qsiz(k)*diffwv(k)
+            tmpc=tmpa*qsiz(k)*diffwv(k)
+            abg=2.0*pi*(qvoqsiz(k)-1.0)*tmpc/(tmpa+tmpb)
+!c
+!c     vf1s,vf2s=ventilation factors for graupel
+!c     vf1s=0.78,vf2s=0.31 in LIN
+!c     Cdrag=0.6  drag coefficient for hairstone
+!c
+            tmp2=abg*xnog*constg2
+            pgdep(k)=amax1(0.0,tmp2)
+            pgsub(k)=amin1(0.0,tmp2)
+            pgsub(k)=amax1( pgsub(k),-qgzodt(k) )
+
+ 4000    continue
+        else
+!
+!***********************************************************************
+!*********      graupel production processes for T > 0 C      **********
+!***********************************************************************
+!
+!c
+!c (1) ACCRETION OF CLOUD WATER BY GRAUPEL (Pgacw): Lin (40)
+!c     egw=1.0
+!c     Cdrag=0.6 drag coefficients for hairstone
+!c     constg=sqrt(4.*grav*rhograul*0.33334*orho(k)/Cdrag)
+
+            egw=1.0
+            constg=sqrt(4.*grav*rhograul*0.33334*orho(k)*oCdrag)
+            tmp1=pio4*xnog*gam3pt5*constg*olambdag(k)**3.5
+            tmp2=qlz(k)*egw*tmp1
+            Pgacw(k)=amin1( tmp2,qlzodt(k) )
+
+!c
+!c (2) ACCRETION OF RAIN BY GRAUPEL (Pgacr): Lin (42)
+!c     Compute processes (5) only when qrz > 0.0 and qgz > 0.0
+!c     egr=1.
+!c
+            egr=1.
+            tmpa=olambdar(k)*olambdar(k)
+            tmpb=olambdag(k)*olambdag(k)
+            tmpc=olambdar(k)*olambdag(k)
+            tmp1=pi*pi*xnor*xnog*abs( vtr(k)-vtg(k) )*orho(k)
+            tmp2=tmpa*tmpa*olambdag(k)*(5.0*tmpa+2.0*tmpc+0.5*tmpb)
+            tmp3=tmp1*egr*rhowater*tmp2
+            pgacr(k)=amin1( tmp3,qrzodt(k) )
+
+
+!c
+!c (3) GRAUPEL MELTING TO FORM RAIN (Pgmlt): Lin (47)
+!c     Pgmlt is negative value
+!c     constg=sqrt(4.*grav*rhograul*0.33334*orho(k)/Cdrag)
+!c     constg2=vf1s*olambdag(k)*olambdag(k)+
+!c             vf2s*schmidt(k)**0.33334*gam2pt75*constg
+!c     Cdrag=0.6  drag coefficients for hairstone
+!
+            delrs=rs0(k)-qvz(k)
+            term1=2.0*pi*orho(k)*( xlv*diffwv(k)*rho(k)*delrs- &
+                  xka(k)*temcc(k) )
+            term0=sqrt(4.*grav*rhograul*0.33334*orho(k)*ocdrag) &
+                  *olambdag(k)**5.5/visc(k)
+
+            constg2=vf1s*olambdag(k)*olambdag(k)+ &
+                    vf2s*schmidt(k)**0.33334*gam2pt75*sqrt(term0)
+            tmp2=xnog*constg2
+            tmp3=term1*oxlf*tmp2-cwoxlf*temcc(k)*( pgacw(k)+pgacr(k) )
+            tmp4=amin1(0.0,tmp3)
+            pgmlt(k)=amax1( tmp4,-qgzodt(k) )
+
+
+!c
+!c (4) EVAPORATION OF MELTING GRAUPEL (Pgmltevp) : HR (A19)
+!c     but use Lin et al. coefficience
+!c     Pgmltevp is a negative value
+!c     abg=2.0*pi*(qvoqsiz(k)-1.0)*tmpc/(tmpa+tmpb)
+!c
+            tmpa=rvapor*xka(k)*tem(k)*tem(k)
+            tmpb=xlv*xlv*rho(k)*qswz(k)*diffwv(k)
+            tmpc=tmpa*qswz(k)*diffwv(k)
+            tmpd=amin1( 0.0,(qvoqswz(k)-0.90)*qswz(k)*odtb )
+
+!c
+!c     abg=2*pi*(Si-1)/rho/(A"+B")
+!c
+            abg=2.0*pi*(qvoqswz(k)-0.90)*tmpc/(tmpa+tmpb)
+!
+!**** allow evaporation to occur when RH less than 90%
+!**** here not using 100% because the evaporation cooling
+!**** of temperature is not taking into account yet; hence,
+!**** the qgw value is a little bit larger. This will avoid
+!**** evaporation can generate cloud.
+!
+!c    vf1s,vf2s=ventilation factors for snow
+!c    vf1s=0.78,vf2s=0.31 in LIN
+!c    constg=sqrt(4.*grav*rhograul*0.33334*orho(k)/Cdrag)
+!c    constg2=vf1s*olambdag(k)*olambdag(k)+
+!c            vf2s*schmidt(k)**0.33334*gam2pt75*constg
+!
+            tmp2=abg*xnog*constg2
+            tmp3=amin1(0.0,tmp2)
+            tmp3=amax1( tmp3,tmpd )
+            pgmltevp(k)=amax1( tmp3,-qgzodt(k) )
+
+!c
+!c (5) ACCRETION OF SNOW BY GRAUPEL (Pgacs) : Lin (29)
+!c     Compute processes (3) only when qsz > 0.0 and qgz > 0.0
+!c     egs=1.0
+!c
+           egs=1.
+           tmpa=olambdas(k)*olambdas(k)
+           tmpb=olambdag(k)*olambdag(k)
+           tmpc=olambdas(k)*olambdag(k)
+           tmp1=pi*pi*xnos*xnog*abs( vts(k)-vtg(k) )*orho(k)
+           tmp2=tmpa*tmpa*olambdag(k)*(5.0*tmpa+2.0*tmpc+0.5*tmpb)
+           tmp3=tmp1*egs*rhosnow*tmp2
+           Pgacs(k)=amin1( tmp3,qszodt(k) )
+
+        endif
+
+
+!
+  900   continue
+
+!cc
+!c
+!c**********************************************************************
+!c*****     combine all processes together and avoid negative      *****
+!c*****     water substances
+!***********************************************************************
+!c
+      if ( temcc(k) .lt. 0.0) then
+!,delta4,1.-delta4
+!c
+!c  gdelta4=gindex*delta4
+!c  g1sdelt4=gindex*(1.-delta4)
+!c
+           gdelta4=gindex*delta4
+           g1sdelt4=gindex*(1.-delta4)
+!c
+!c  combined water vapor depletions
+!c
+!cc graupel
+           tmp=psdep(k)+pgdep(k)*gindex
+           if ( tmp .gt. qvzodt(k) ) then
+              factor=qvzodt(k)/tmp
+              psdep(k)=psdep(k)*factor
+              pgdep(k)=pgdep(k)*factor*gindex
+           end if
+!c
+!c  combined cloud water depletions
+!c
+           tmp=praut(k)+psacw(k)+psfw(k)+pracw(k)+gindex*Pgacw(k)
+           if ( tmp .gt. qlzodt(k) ) then
+              factor=qlzodt(k)/tmp
+              praut(k)=praut(k)*factor
+              psacw(k)=psacw(k)*factor
+              psfw(k)=psfw(k)*factor
+              pracw(k)=pracw(k)*factor
+!cc graupel
+              Pgacw(k)=Pgacw(k)*factor*gindex
+           end if
+!c
+!c  combined cloud ice depletions
+!c
+           tmp=psaut(k)+psaci(k)+praci(k)+psfi(k)+Pgaci(k)*gdelta4 &
+               +Pgacip(k)*g1sdelt4
+           if (tmp .gt. qizodt(k) ) then
+              factor=qizodt(k)/tmp
+              psaut(k)=psaut(k)*factor
+              psaci(k)=psaci(k)*factor
+              praci(k)=praci(k)*factor
+              psfi(k)=psfi(k)*factor
+!cc graupel
+              Pgaci(k)=Pgaci(k)*factor*gdelta4
+              Pgacip(k)=Pgacip(k)*factor*g1sdelt4
+           endif
+!c
+!c  combined all rain processes
+!c
+          tmp_r=piacr(k)+psacr(k)-prevp(k)-praut(k)-pracw(k) &
+                +Pgfr(k)*gindex+Pgacr(k)*gdelta4 &
+                +Pgacrp(k)*g1sdelt4
+          if (tmp_r .gt. qrzodt(k) ) then
+             factor=qrzodt(k)/tmp_r
+             piacr(k)=piacr(k)*factor
+             psacr(k)=psacr(k)*factor
+             prevp(k)=prevp(k)*factor
+!cc graupel
+             Pgfr(k)=Pgfr(k)*factor*gindex
+             Pgacr(k)=Pgacr(k)*factor*gdelta4
+             Pgacrp(k)=Pgacrp(k)*factor*g1sdelt4
+          endif
+
+!c
+!c     if qrz < 1.0E-4 and qsz < 1.0E-4  then delta2=1.
+!c                  (all Pracs and Psacr become to snow)
+!c     if qrz >= 1.0E-4 or qsz >= 1.0E-4 then delta2=0.
+!c                 (all Pracs and Psacr become to graupel)
+!c
+          if (qrz(k) .lt. 1.0E-4 .and. qsz(k) .lt. 1.0E-4) then
+             delta2=1.0
+          else
+             delta2=0.0
+          endif
+!
+!cc graupel
+
+!c
+!c  if qrz(k) < 1.0e-4 then delta3=1. means praci(k) -->  qs
+!c                                          piacr(k) -->  qs
+!c  if qrz(k) > 1.0e-4 then delta3=0. means praci(k) -->  qg
+!c                                          piacr(k) -->  qg : Lin (20)
+
+          if (qrz(k) .lt. 1.0e-4) then
+             delta3=1.0
+          else
+             delta3=0.0
+          endif
+!
+!c
+!c     if gindex = 0.(no graupel) then delta2=1.0
+!c                                     delta3=1.0
+!c
+          if (gindex .eq. 0.) then
+              delta2=1.0
+              delta3=1.0
+         endif
+!
+!c
+!c   combined all snow processes
+!c
+          tmp_s=-pssub(k)-(psaut(k)+psaci(k)+psacw(k)+psfw(k)+ &
+                 psfi(k)+praci(k)*delta3+piacr(k)*delta3+ &
+                 psdep(k))+Pgaut(k)*gindex+Pgacs(k)*gdelta4+ &
+                 Pgacsp(k)*g1sdelt4+Pracs(k)*(1.-delta2)- &
+                 Psacr(k)*delta2
+          if ( tmp_s .gt. qszodt(k) ) then
+             factor=qszodt(k)/tmp_s
+             pssub(k)=pssub(k)*factor
+             Pracs(k)=Pracs(k)*factor
+!cc graupel
+             Pgaut(k)=Pgaut(k)*factor*gindex
+             Pgacs(k)=Pgacs(k)*factor*gdelta4
+             Pgacsp(k)=Pgacsp(k)*factor*g1sdelt4
+          endif
+
+!cc graupel
+!
+
+!          if (gindex .eq. 0.) goto 998
+!c
+!c  combined all graupel processes
+!c
+           tmp_g=-pgaut(k)-pgfr(k)-Pgacw(k)*delta4-Pgaci(k)*delta4  &
+                 -Pgacr(k)*delta4-Pgacs(k)*delta4  &
+                 -pgwet(k)*(1.-delta4)-pgsub(k)-pgdep(k)  &
+                 -psacr(k)*(1-delta2)-Pracs(k)*(1-delta2)  &
+                 -praci(k)*(1-delta3)-piacr(k)*(1-delta3)
+           if (tmp_g .gt. qgzodt(k)) then
+               factor=qgzodt(k)/tmp_g
+               pgsub(k)=pgsub(k)*factor
+           endif
+
+  998      continue
+!c
+!c  calculate new water substances, thetae, tem, and qvsbar
+!c
+
+!cc graupel
+         pvapor(k)=-pssub(k)-psdep(k)-prevp(k)-pgsub(k)*gindex &
+                   -pgdep(k)*gindex
+         qvz(k)=amax1( qvmin,qvz(k)+dtb*pvapor(k) )
+         pclw(k)=-praut(k)-pracw(k)-psacw(k)-psfw(k)-pgacw(k)*gindex
+         qlz(k)=amax1( 0.0,qlz(k)+dtb*pclw(k) )
+         pcli(k)=-psaut(k)-psfi(k)-psaci(k)-praci(k)-pgaci(k)*gdelta4 &
+                 -Pgacip(k)*g1sdelt4
+         qiz(k)=amax1( 0.0,qiz(k)+dtb*pcli(k) )
+         tmp_r=piacr(k)+psacr(k)-prevp(k)-praut(k)-pracw(k) &
+                +Pgfr(k)*gindex+Pgacr(k)*gdelta4 &
+                +Pgacrp(k)*g1sdelt4
+ 232     format(i2,1x,6(f9.3,1x))
+         prain(k)=-tmp_r
+         qrz(k)=amax1( 0.0,qrz(k)+dtb*prain(k) )
+         tmp_s=-pssub(k)-(psaut(k)+psaci(k)+psacw(k)+psfw(k)+  &
+                psfi(k)+praci(k)*delta3+piacr(k)*delta3+  &
+                psdep(k))+Pgaut(k)*gindex+Pgacs(k)*gdelta4+  &
+                Pgacsp(k)*g1sdelt4+Pracs(k)*(1.-delta2)-  &
+                Psacr(k)*delta2
+         psnow(k)=-tmp_s
+         qsz(k)=amax1( 0.0,qsz(k)+dtb*psnow(k) )
+         qschg(k)=qschg(k)+psnow(k)
+         qschg(k)=psnow(k)
+!cc graupel
+         tmp_g=-pgaut(k)-pgfr(k)-Pgacw(k)*delta4-Pgaci(k)*delta4 &
+               -Pgacr(k)*delta4-Pgacs(k)*delta4 &
+               -pgwet(k)*(1.-delta4)-pgsub(k)-pgdep(k) &
+               -psacr(k)*(1-delta2)-Pracs(k)*(1-delta2) &
+               -praci(k)*(1-delta3)-piacr(k)*(1-delta3)
+ 252     format(i2,1x,6(f12.9,1x))
+ 262     format(i2,1x,7(f12.9,1x))
+         pgraupel(k)=-tmp_g
+         pgraupel(k)=pgraupel(k)*gindex
+         qgz(k)=amax1( 0.0,qgz(k)+dtb*pgraupel(k))
+!        qgchg(k)=qgchg(k)+pgraupel(k)
+         qgchg(k)=pgraupel(k)
+         qgz(k)=qgz(k)*gindex
+
+         tmp=ocp/tothz(k)*xLf*(qschg(k)+qgchg(k))
+         theiz(k)=theiz(k)+dtb*tmp
+         thz(k)=theiz(k)-(xLvocp*qvz(k)-xLfocp*qiz(k))/tothz(k)
+         tem(k)=thz(k)*tothz(k)
+
+         temcc(k)=tem(k)-273.15
+
+         if( temcc(k) .lt. -40.0 ) qswz(k)=qsiz(k)
+         qlpqi=qlz(k)+qiz(k)
+         if ( qlpqi .eq. 0.0 ) then
+            qvsbar(k)=qsiz(k)
+         else
+            qvsbar(k)=( qiz(k)*qsiz(k)+qlz(k)*qswz(k) )/qlpqi
+         endif
+
+!
+      else
+!c
+!c  combined cloud water depletions
+!c
+          tmp=praut(k)+psacw(k)+pracw(k)+pgacw(k)*gindex
+          if ( tmp .gt. qlzodt(k) ) then
+             factor=qlzodt(k)/tmp
+             praut(k)=praut(k)*factor
+             psacw(k)=psacw(k)*factor
+             pracw(k)=pracw(k)*factor
+!cc graupel
+             pgacw(k)=pgacw(k)*factor*gindex
+          end if
+!c
+!c  combined all snow processes
+!c
+          tmp_s=-(psmlt(k)+psmltevp(k))+Pgacs(k)*gindex
+          if (tmp_s .gt. qszodt(k) ) then
+             factor=qszodt(k)/tmp_s
+             psmlt(k)=psmlt(k)*factor
+             psmltevp(k)=psmltevp(k)*factor
+!cc graupel
+             Pgacs(k)=Pgacs(k)*factor*gindex
+          endif
+
+!c
+!c
+!cc graupel
+!c
+!         if (gindex .eq. 0.) goto 997
+
+!c
+!c  combined all graupel processes
+!c
+            tmp_g=-pgmlt(k)-pgacs(k)-pgmltevp(k)
+            if (tmp_g .gt. qgzodt(k)) then
+              factor=qgzodt(k)/tmp_g
+              pgmltevp(k)=pgmltevp(k)*factor
+              pgmlt(k)=pgmlt(k)*factor
+            endif
+!c
+  997     continue
+
+!c
+!c  combined all rain processes
+!c
+          tmp_r=-prevp(k)-(praut(k)+pracw(k)+psacw(k)-psmlt(k)) &
+                +pgmlt(k)*gindex-pgacw(k)*gindex
+          if (tmp_r .gt. qrzodt(k) ) then
+             factor=qrzodt(k)/tmp_r
+             prevp(k)=prevp(k)*factor
+          endif
+!c
+!c
+!c  calculate new water substances and thetae
+!c
+
+
+          pvapor(k)=-psmltevp(k)-prevp(k)-pgmltevp(k)
+          qvz(k)=amax1( qvmin,qvz(k)+dtb*pvapor(k))
+          pclw(k)=-praut(k)-pracw(k)-psacw(k)-pgacw(k)*gindex
+          qlz(k)=amax1( 0.0,qlz(k)+dtb*pclw(k) )
+          pcli(k)=0.0
+          qiz(k)=amax1( 0.0,qiz(k)+dtb*pcli(k) )
+          tmp_r=-prevp(k)-(praut(k)+pracw(k)+psacw(k)-psmlt(k)) &
+                +pgmlt(k)*gindex-pgacw(k)*gindex
+ 242      format(i2,1x,7(f9.6,1x))
+          prain(k)=-tmp_r
+          tmpqrz=qrz(k)
+          qrz(k)=amax1( 0.0,qrz(k)+dtb*prain(k) )
+          tmp_s=-(psmlt(k)+psmltevp(k))+Pgacs(k)*gindex
+          psnow(k)=-tmp_s
+          qsz(k)=amax1( 0.0,qsz(k)+dtb*psnow(k) )
+!         qschg(k)=qschg(k)+psnow(k)
+          qschg(k)=psnow(k)
+!cc graupel
+
+          tmp_g=-pgmlt(k)-pgacs(k)-pgmltevp(k)
+!         write(*,272)k,pgmlt(k),pgacs(k),pgmltevp(k),
+ 272      format(i2,1x,3(f12.9,1x))
+          pgraupel(k)=-tmp_g*gindex
+          qgz(k)=amax1( 0.0,qgz(k)+dtb*pgraupel(k))
+!         qgchg(k)=qgchg(k)+pgraupel(k)
+          qgchg(k)=pgraupel(k)
+          qgz(k)=qgz(k)*gindex
+!
+          tmp=ocp/tothz(k)*xLf*(qschg(k)+qgchg(k))
+          theiz(k)=theiz(k)+dtb*tmp
+          thz(k)=theiz(k)-(xLvocp*qvz(k)-xLfocp*qiz(k))/tothz(k)
+
+          tem(k)=thz(k)*tothz(k)
+          temcc(k)=tem(k)-273.15
+!         qswz(k)=episp0k*oprez(k)*  &
+!                exp( svp2*temcc(k)/(tem(k)-svp3) )
+          es=1000.*svp1*exp( svp2*temcc(k)/(tem(k)-svp3) )
+          qswz(k)=ep2*es/(prez(k)-es)
+          qsiz(k)=qswz(k)
+          qvsbar(k)=qswz(k)
+!
+      end if
+
+!
+!***********************************************************************
+!**********              saturation adjustment                **********
+!***********************************************************************
+!
+!    allow supersaturation exits linearly from 0% at 500 mb to 50%
+!    above 300 mb
+!    5.0e-5=1.0/(500mb-300mb)
+!
+         rsat=1.0+0.5*(50000.0-prez(k))*5.0e-5
+         rsat=amax1(1.0,rsat)
+         rsat=amin1(1.5,rsat)
+         rsat=1.0
+         if( qvz(k)+qlz(k)+qiz(k) .lt. rsat*qvsbar(k) ) then
+
+!c
+!c   unsaturated
+!c
+          qvz(k)=qvz(k)+qlz(k)+qiz(k)
+          qlz(k)=0.0
+          qiz(k)=0.0
+
+          thz(k)=theiz(k)-(xLvocp*qvz(k)-xLfocp*qiz(k))/tothz(k)
+          tem(k)=thz(k)*tothz(k)
+          temcc(k)=tem(k)-273.15
+
+          go to 1800
+!
+        else
+!c
+!c   saturated
+!c
+!
+          pladj(k)=qlz(k)
+          piadj(k)=qiz(k)
+!
+
+          CALL satadj(qvz, qlz, qiz, prez, theiz, thz, tothz, kts, kte, &
+                      k, xLvocp, xLfocp, episp0k, EP2,SVP1,SVP2,SVP3,SVPT0 )
+
+!
+          pladj(k)=odtb*(qlz(k)-pladj(k))
+          piadj(k)=odtb*(qiz(k)-piadj(k))
+!
+          pclw(k)=pclw(k)+pladj(k)
+          pcli(k)=pcli(k)+piadj(k)
+          pvapor(k)=pvapor(k)-( pladj(k)+piadj(k) )
+!
+          thz(k)=theiz(k)-(xLvocp*qvz(k)-xLfocp*qiz(k))/tothz(k)
+          tem(k)=thz(k)*tothz(k)
+
+          temcc(k)=tem(k)-273.15
+
+!         qswz(k)=episp0k*oprez(k)*  &
+!                 exp( svp2*temcc(k)/(tem(k)-svp3) )
+          es=1000.*svp1*exp( svp2*temcc(k)/(tem(k)-svp3) )
+          qswz(k)=ep2*es/(prez(k)-es)
+          if (tem(k) .lt. 273.15 ) then
+!            qsiz(k)=episp0k*oprez(k)* &
+!                   exp( 21.8745584*(tem(k)-273.16)/(tem(k)-7.66) )
+             es=1000.*svp1*exp( 21.8745584*(tem(k)-273.16)/(tem(k)-7.66) )
+             qsiz(k)=ep2*es/(prez(k)-es)
+             if (temcc(k) .lt. -40.0) qswz(k)=qsiz(k)
+          else
+             qsiz(k)=qswz(k)
+          endif
+          qlpqi=qlz(k)+qiz(k)
+          if ( qlpqi .eq. 0.0 ) then
+             qvsbar(k)=qsiz(k)
+          else
+             qvsbar(k)=( qiz(k)*qsiz(k)+qlz(k)*qswz(k) )/qlpqi
+          endif
+
+        end if
+
+!
+!***********************************************************************
+!*****     melting and freezing of cloud ice and cloud water       *****
+!***********************************************************************
+        qlpqi=qlz(k)+qiz(k)
+        if(qlpqi .le. 0.0) go to 1800
+!
+!c
+!c (1)  HOMOGENEOUS NUCLEATION WHEN T< -40 C (Pihom)
+!c
+        if(temcc(k) .lt. -40.0) pihom(k)=qlz(k)*odtb
+!c
+!c (2)  MELTING OF ICE CRYSTAL WHEN T> 0 C (Pimlt)
+!c
+        if(temcc(k) .gt. 0.0) pimlt(k)=qiz(k)*odtb
+!c
+!c (3) PRODUCTION OF CLOUD ICE BY BERGERON PROCESS (Pidw): Hsie (p957)
+!c     this process only considered when -31 C < T < 0 C
+!c
+        if(temcc(k) .lt. 0.0 .and. temcc(k) .gt. -31.0) then
+!c!
+!c!   parama1 and parama2 functions must be user supplied
+!c!
+          a1=parama1( temcc(k) )
+          a2=parama2( temcc(k) )
+!! change unit from cgs to mks
+          a1=a1*0.001**(1.0-a2)
+          xnin=xni0*exp(-bni*temcc(k))
+          pidw(k)=xnin*orho(k)*(a1*xmnin**a2)
+        end if
+!
+        pcli(k)=pcli(k)+pihom(k)-pimlt(k)+pidw(k)
+        pclw(k)=pclw(k)-pihom(k)+pimlt(k)-pidw(k)
+        qlz(k)=amax1( 0.0,qlz(k)+dtb*(-pihom(k)+pimlt(k)-pidw(k)) )
+        qiz(k)=amax1( 0.0,qiz(k)+dtb*(pihom(k)-pimlt(k)+pidw(k)) )
+
+!
+        CALL satadj(qvz, qlz, qiz, prez, theiz, thz, tothz, kts, kte, &
+                    k, xLvocp, xLfocp, episp0k ,EP2,SVP1,SVP2,SVP3,SVPT0)
+
+        thz(k)=theiz(k)-(xLvocp*qvz(k)-xLfocp*qiz(k))/tothz(k)
+        tem(k)=thz(k)*tothz(k)
+
+        temcc(k)=tem(k)-273.15
+
+!       qswz(k)=episp0k*oprez(k)* &
+!              exp( svp2*temcc(k)/(tem(k)-svp3) )
+        es=1000.*svp1*exp( svp2*temcc(k)/(tem(k)-svp3) )
+        qswz(k)=ep2*es/(prez(k)-es)
+
+        if (tem(k) .lt. 273.15 ) then
+!          qsiz(k)=episp0k*oprez(k)* &
+!                 exp( 21.8745584*(tem(k)-273.16)/(tem(k)-7.66) )
+           es=1000.*svp1*exp( 21.8745584*(tem(k)-273.16)/(tem(k)-7.66) )
+           qsiz(k)=ep2*es/(prez(k)-es)
+           if (temcc(k) .lt. -40.0) qswz(k)=qsiz(k)
+        else
+           qsiz(k)=qswz(k)
+        endif
+        qlpqi=qlz(k)+qiz(k)
+        if ( qlpqi .eq. 0.0 ) then
+           qvsbar(k)=qsiz(k)
+        else
+           qvsbar(k)=( qiz(k)*qsiz(k)+qlz(k)*qswz(k) )/qlpqi
+        endif
+
+1800  continue
+!
+!***********************************************************************
+!**********    integrate the productions of rain and snow     **********
+!***********************************************************************
+!c
+
+2000  continue
+
+
+!---------------------------------------------------------------------
+
+!
+!***********************************************************************
+!******      Write terms in cloud physics to time series dataset   *****
+!***********************************************************************
+!
+!     open(unit=24,form='formatted',status='new',
+!    &     file='cloud.dat')
+
+!9030  format(10e12.6)
+
+!      write(24,*)'tmp'
+!      write(24,9030) (tem(k),k=kts+1,kte)
+!      write(24,*)'qiz'
+!      write(24,9030) (qiz(k),k=kts+1,kte)
+!      write(24,*)'qsz'
+!      write(24,9030) (qsz(k),k=kts+1,kte)
+!      write(24,*)'qrz'
+!      write(24,9030) (qrz(k),k=kts+1,kte)
+!      write(24,*)'qgz'
+!      write(24,9030) (qgz(k),k=kts+1,kte)
+!      write(24,*)'qvoqsw'
+!      write(24,9030) (qvoqswz(k),k=kts+1,kte)
+!      write(24,*)'qvoqsi'
+!      write(24,9030) (qvoqsiz(k),k=kts+1,kte)
+!      write(24,*)'vtr'
+!      write(24,9030) (vtr(k),k=kts+1,kte)
+!      write(24,*)'vts'
+!      write(24,9030) (vts(k),k=kts+1,kte)
+!      write(24,*)'vtg'
+!      write(24,9030) (vtg(k),k=kts+1,kte)
+!      write(24,*)'pclw'
+!      write(24,9030) (pclw(k),k=kts+1,kte)
+!      write(24,*)'pvapor'
+!      write(24,9030) (pvapor(k),k=kts+1,kte)
+!      write(24,*)'pcli'
+!      write(24,9030) (pcli(k),k=kts+1,kte)
+!      write(24,*)'pimlt'
+!      write(24,9030) (pimlt(k),k=kts+1,kte)
+!      write(24,*)'pihom'
+!      write(24,9030) (pihom(k),k=kts+1,kte)
+!      write(24,*)'pidw'
+!      write(24,9030) (pidw(k),k=kts+1,kte)
+!      write(24,*)'prain'
+!      write(24,9030) (prain(k),k=kts+1,kte)
+!      write(24,*)'praut'
+!      write(24,9030) (praut(k),k=kts+1,kte)
+!      write(24,*)'pracw'
+!      write(24,9030) (pracw(k),k=kts+1,kte)
+!      write(24,*)'prevp'
+!      write(24,9030) (prevp(k),k=kts+1,kte)
+!      write(24,*)'psnow'
+!      write(24,9030) (psnow(k),k=kts+1,kte)
+!      write(24,*)'psaut'
+!      write(24,9030) (psaut(k),k=kts+1,kte)
+!      write(24,*)'psfw'
+!      write(24,9030) (psfw(k),k=kts+1,kte)
+!      write(24,*)'psfi'
+!      write(24,9030) (psfi(k),k=kts+1,kte)
+!      write(24,*)'praci'
+!      write(24,9030) (praci(k),k=kts+1,kte)
+!      write(24,*)'piacr'
+!      write(24,9030) (piacr(k),k=kts+1,kte)
+!      write(24,*)'psaci'
+!      write(24,9030) (psaci(k),k=kts+1,kte)
+!      write(24,*)'psacw'
+!      write(24,9030) (psacw(k),k=kts+1,kte)
+!      write(24,*)'psdep'
+!      write(24,9030) (psdep(k),k=kts+1,kte)
+!      write(24,*)'pssub'
+!      write(24,9030) (pssub(k),k=kts+1,kte)
+!      write(24,*)'pracs'
+!      write(24,9030) (pracs(k),k=kts+1,kte)
+!      write(24,*)'psacr'
+!      write(24,9030) (psacr(k),k=kts+1,kte)
+!      write(24,*)'psmlt'
+!      write(24,9030) (psmlt(k),k=kts+1,kte)
+!      write(24,*)'psmltevp'
+!      write(24,9030) (psmltevp(k),k=kts+1,kte)
+!      write(24,*)'pladj'
+!      write(24,9030) (pladj(k),k=kts+1,kte)
+!      write(24,*)'piadj'
+!      write(24,9030) (piadj(k),k=kts+1,kte)
+!      write(24,*)'pgraupel'
+!      write(24,9030) (pgraupel(k),k=kts+1,kte)
+!      write(24,*)'pgaut'
+!      write(24,9030) (pgaut(k),k=kts+1,kte)
+!      write(24,*)'pgfr'
+!      write(24,9030) (pgfr(k),k=kts+1,kte)
+!      write(24,*)'pgacw'
+!      write(24,9030) (pgacw(k),k=kts+1,kte)
+!      write(24,*)'pgaci'
+!      write(24,9030) (pgaci(k),k=kts+1,kte)
+!      write(24,*)'pgacr'
+!      write(24,9030) (pgacr(k),k=kts+1,kte)
+!      write(24,*)'pgacs'
+!      write(24,9030) (pgacs(k),k=kts+1,kte)
+!      write(24,*)'pgacip'
+!      write(24,9030) (pgacip(k),k=kts+1,kte)
+!      write(24,*)'pgacrP'
+!      write(24,9030) (pgacrP(k),k=kts+1,kte)
+!      write(24,*)'pgacsp'
+!      write(24,9030) (pgacsp(k),k=kts+1,kte)
+!      write(24,*)'pgwet'
+!      write(24,9030) (pgwet(k),k=kts+1,kte)
+!      write(24,*)'pdry'
+!      write(24,9030) (pdry(k),k=kts+1,kte)
+!      write(24,*)'pgsub'
+!      write(24,9030) (pgsub(k),k=kts+1,kte)
+!      write(24,*)'pgdep'
+!      write(24,9030) (pgdep(k),k=kts+1,kte)
+!      write(24,*)'pgmlt'
+!      write(24,9030) (pgmlt(k),k=kts+1,kte)
+!      write(24,*)'pgmltevp'
+!      write(24,9030) (pgmltevp(k),k=kts+1,kte)
+
+
+
+!**** below if qv < qvmin then qv=qvmin, ql=0.0, and qi=0.0
+!
+      do k=kts+1,kte
+         if ( qvz(k) .lt. qvmin ) then
+            qlz(k)=0.0
+            qiz(k)=0.0
+            qvz(k)=amax1( qvmin,qvz(k)+qlz(k)+qiz(k) )
+         end if
+      enddo
+!
+  END SUBROUTINE clphy1d
+
+
+!---------------------------------------------------------------------
+!                         SATURATED ADJUSTMENT
+!---------------------------------------------------------------------
+      SUBROUTINE satadj(qvz, qlz, qiz, prez, theiz, thz, tothz,      &
+                        kts, kte, k, xLvocp, xLfocp, episp0k, EP2,SVP1,SVP2,SVP3,SVPT0)
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!---------------------------------------------------------------------
+!  This program use Newton's method for finding saturated temperature
+!  and saturation mixing ratio.
+!
+! In this saturation adjustment scheme we assume
+! (1)  the saturation mixing ratio is the mass weighted average of
+!      saturation values over liquid water (qsw), and ice (qsi)
+!      following Lord et al., 1984 and Tao, 1989
+!
+! (2) the percentage of cloud liquid and cloud ice will
+!      be fixed during the saturation calculation
+!---------------------------------------------------------------------
+!
+
+  INTEGER, INTENT(IN   )             :: kts, kte, k
+
+  REAL,      DIMENSION( kts:kte ),                                   &
+                       INTENT(INOUT) :: qvz, qlz, qiz
+!
+  REAL,      DIMENSION( kts:kte ),                                   &
+                       INTENT(IN   ) :: prez, theiz, tothz
+
+  REAL,     INTENT(IN   )            :: xLvocp, xLfocp, episp0k
+  REAL,     INTENT(IN   )            :: EP2,SVP1,SVP2,SVP3,SVPT0
+
+! LOCAL VARS
+
+  INTEGER                            :: n
+
+  REAL, DIMENSION( kts:kte )         :: thz, tem, temcc, qsiz,       &
+                                        qswz, qvsbar
+
+  REAL ::   qsat, qlpqi, ratql, t0, t1, tmp1, ratqi, tsat, absft,    &
+            denom1, denom2, dqvsbar, ftsat, dftsat, qpz,             &
+            gindex, es
+!
+!---------------------------------------------------------------------
+
+      thz(k)=theiz(k)-(xLvocp*qvz(k)-xLfocp*qiz(k))/tothz(k)
+
+      tem(k)=tothz(k)*thz(k)
+      if (tem(k) .gt. 273.15) then
+!        qsat=episp0k/prez(k)*  &
+!            exp( svp2*(tem(k)-273.15)/(tem(k)-svp3) )
+         es=1000.*svp1*exp( svp2*(tem(k)-svpt0)/(tem(k)-svp3) )
+         qsat=ep2*es/(prez(k)-es)
+      else
+        qsat=episp0k/prez(k)*  &
+             exp( 21.8745584*(tem(k)-273.15)/(tem(k)-7.66) )
+      end if
+      qpz=qvz(k)+qlz(k)+qiz(k)
+      if (qpz .lt. qsat) then
+         qvz(k)=qpz
+         qiz(k)=0.0
+         qlz(k)=0.0
+         go to 400
+      end if
+      qlpqi=qlz(k)+qiz(k)
+      if( qlpqi .ge. 1.0e-5) then
+        ratql=qlz(k)/qlpqi
+        ratqi=qiz(k)/qlpqi
+      else
+        t0=273.15
+!       t1=233.15
+        t1=248.15
+        tmp1=( t0-tem(k) )/(t0-t1)
+        tmp1=amin1(1.0,tmp1)
+        tmp1=amax1(0.0,tmp1)
+        ratqi=tmp1
+        ratql=1.0-tmp1
+      end if
+!
+!
+!--  saturation mixing ratios over water and ice
+!--  at the outset we will follow Bolton 1980 MWR for
+!--  the water and Murray JAS 1967 for the ice
+!
+!-- dqvsbar=d(qvsbar)/dT
+!-- ftsat=F(Tsat)
+!-- dftsat=d(F(T))/dT
+!
+!  First guess of tsat
+
+      tsat=tem(k)
+      absft=1.0
+!
+      do 200 n=1,20
+         denom1=1.0/(tsat-svp3)
+         denom2=1.0/(tsat-7.66)
+!        qswz(k)=episp0k/prez(k)*  &
+!                exp( svp2*denom1*(tsat-273.15) )
+         es=1000.*svp1*exp( svp2*denom1*(tsat-svpt0) )
+         qswz(k)=ep2*es/(prez(k)-es)
+         if (tem(k) .lt. 273.15) then
+!           qsiz(k)=episp0k/prez(k)*  &
+!                   exp( 21.8745584*denom2*(tsat-273.15) )
+            es=1000.*svp1*exp( 21.8745584*denom2*(tsat-273.15) )
+            qsiz(k)=ep2*es/(prez(k)-es)
+            if (tem(k) .lt. 233.15) qswz(k)=qsiz(k)
+         else
+            qsiz(k)=qswz(k)
+         endif
+         qvsbar(k)=ratql*qswz(k)+ratqi*qsiz(k)
+!
+!        if( absft .lt. 0.01 .and. n .gt. 3 ) go to 300
+         if( absft .lt. 0.01 ) go to 300
+!
+         dqvsbar=ratql*qswz(k)*svp2*243.5*denom1*denom1+  &
+                 ratqi*qsiz(k)*21.8745584*265.5*denom2*denom2
+         ftsat=tsat+(xlvocp+ratqi*xlfocp)*qvsbar(k)-  &
+               tothz(k)*theiz(k)-xlfocp*ratqi*(qvz(k)+qlz(k)+qiz(k))
+         dftsat=1.0+(xlvocp+ratqi*xlfocp)*dqvsbar
+         tsat=tsat-ftsat/dftsat
+         absft=abs(ftsat)
+
+200   continue
+9020  format(1x,'point can not converge, absft,n=',e12.5,i5)
+!
+300   continue
+      if( qpz .gt. qvsbar(k) ) then
+        qvz(k)=qvsbar(k)
+        qiz(k)=ratqi*( qpz-qvz(k) )
+        qlz(k)=ratql*( qpz-qvz(k) )
+      else
+        qvz(k)=qpz
+        qiz(k)=0.0
+        qlz(k)=0.0
+      end if
+ 400  continue
+
+   END SUBROUTINE satadj
+
+
+!----------------------------------------------------------------
+   REAL FUNCTION parama1(temp)
+!----------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------
+!  This program calculate the parameter for crystal growth rate
+!  in Bergeron process
+!----------------------------------------------------------------
+
+      REAL, INTENT (IN   )   :: temp
+      REAL, DIMENSION(32)    :: a1
+      INTEGER                :: i1, i1p1
+      REAL                   :: ratio
+
+      data a1/0.100e-10,0.7939e-7,0.7841e-6,0.3369e-5,0.4336e-5, &
+              0.5285e-5,0.3728e-5,0.1852e-5,0.2991e-6,0.4248e-6, &
+              0.7434e-6,0.1812e-5,0.4394e-5,0.9145e-5,0.1725e-4, &
+              0.3348e-4,0.1725e-4,0.9175e-5,0.4412e-5,0.2252e-5, &
+              0.9115e-6,0.4876e-6,0.3473e-6,0.4758e-6,0.6306e-6, &
+              0.8573e-6,0.7868e-6,0.7192e-6,0.6513e-6,0.5956e-6, &
+              0.5333e-6,0.4834e-6/
+
+      i1=int(-temp)+1
+      i1p1=i1+1
+      ratio=-(temp)-float(i1-1)
+      parama1=a1(i1)+ratio*( a1(i1p1)-a1(i1) )
+
+   END FUNCTION parama1
+
+!----------------------------------------------------------------
+   REAL FUNCTION parama2(temp)
+!----------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------
+!  This program calculate the parameter for crystal growth rate
+!  in Bergeron process
+!----------------------------------------------------------------
+
+      REAL, INTENT (IN   )   :: temp
+      REAL, DIMENSION(32)    :: a2
+      INTEGER                :: i1, i1p1
+      REAL                   :: ratio
+
+      data a2/0.0100,0.4006,0.4831,0.5320,0.5307,0.5319,0.5249, &
+              0.4888,0.3849,0.4047,0.4318,0.4771,0.5183,0.5463, &
+              0.5651,0.5813,0.5655,0.5478,0.5203,0.4906,0.4447, &
+              0.4126,0.3960,0.4149,0.4320,0.4506,0.4483,0.4460, &
+              0.4433,0.4413,0.4382,0.4361/
+      i1=int(-temp)+1
+      i1p1=i1+1
+      ratio=-(temp)-float(i1-1)
+      parama2=a2(i1)+ratio*( a2(i1p1)-a2(i1) )
+
+   END FUNCTION parama2
+
+!----------------------------------------------------------------
+   REAL FUNCTION ggamma(X)
+!----------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------
+      REAL, INTENT(IN   ) :: x
+      REAL, DIMENSION(8)  :: B
+      INTEGER             ::j, K1
+      REAL                ::PF, G1TO2 ,TEMP
+
+      DATA B/-.577191652,.988205891,-.897056937,.918206857,  &
+             -.756704078,.482199394,-.193527818,.035868343/
+
+      PF=1.
+      TEMP=X
+      DO 10 J=1,200
+      IF (TEMP .LE. 2) GO TO 20
+      TEMP=TEMP-1.
+   10 PF=PF*TEMP
+  100 FORMAT(//,5X,'module_mp_lin: INPUT TO GAMMA FUNCTION TOO LARGE, X=',E12.5)
+      WRITE(wrf_err_message,100)X
+      CALL wrf_error_fatal(wrf_err_message)
+   20 G1TO2=1.
+      TEMP=TEMP - 1.
+      DO 30 K1=1,8
+   30 G1TO2=G1TO2 + B(K1)*TEMP**K1
+      ggamma=PF*G1TO2
+
+      END FUNCTION ggamma
+
+!----------------------------------------------------------------
+
+END MODULE module_mp_lin
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_mp_ncloud3.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_mp_ncloud3.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_mp_ncloud3.F	(revision 2744)
@@ -0,0 +1,830 @@
+MODULE module_mp_ncloud3
+
+   REAL, PARAMETER, PRIVATE :: dtcldcr     = 240.
+   INTEGER, PARAMETER, PRIVATE :: mstepmax = 100
+
+   REAL, PARAMETER, PRIVATE :: n0r = 8.e6
+   REAL, PARAMETER, PRIVATE :: avtr = 841.9
+   REAL, PARAMETER, PRIVATE :: bvtr = 0.8
+   REAL, PARAMETER, PRIVATE :: r0 = .8e-5 ! 8 microm  in contrast to 10 micro m
+   REAL, PARAMETER, PRIVATE :: peaut = .55   ! collection efficiency
+   REAL, PARAMETER, PRIVATE :: xncr = 3.e8   ! maritime cloud in contrast to 3.e8 in tc80
+   REAL, PARAMETER, PRIVATE :: xmyu = 1.718e-5 ! the dynamic viscosity kgm-1s-1
+
+   REAL, PARAMETER, PRIVATE :: avts = 16.2
+   REAL, PARAMETER, PRIVATE :: bvts = .527
+   REAL, PARAMETER, PRIVATE :: xncmax =  1.e8
+   REAL, PARAMETER, PRIVATE :: n0smax =  1.e9
+   REAL, PARAMETER, PRIVATE :: betai = .6
+   REAL, PARAMETER, PRIVATE :: xn0 = 1.e-2
+   REAL, PARAMETER, PRIVATE :: dicon = 16.3
+   REAL, PARAMETER, PRIVATE :: di0 = 12.9e-6*.8
+   REAL, PARAMETER, PRIVATE :: dimax = 400.e-6
+   REAL, PARAMETER, PRIVATE :: n0s = 2.e6             ! temperature dependent n0s
+   REAL, PARAMETER, PRIVATE :: alpha = 1./8.18        ! .122 exponen factor for n0s
+!  REAL, PARAMETER, PRIVATE :: lamdarmax = 1.e15  
+   REAL, PARAMETER, PRIVATE :: lamdarmax = 1.e5  
+   REAL, PARAMETER, PRIVATE :: qcrmin = 1.e-6  
+
+   REAL, SAVE ::                                     &
+             qc0, qck1,bvtr1,bvtr2,bvtr3,bvtr4,g1pbr,&
+             g3pbr,g4pbr,g5pbro2,pvtr,eacrr,pacrr,   &
+             precr1,precr2,xm0,xmmax,bvts1,          &
+             bvts2,bvts3,bvts4,g1pbs,g3pbs,g4pbs,    &
+             g5pbso2,pvts,pacrs,precs1,precs2,pidn0r,&
+                   pidn0s,xlv1
+
+CONTAINS
+
+!===================================================================
+!
+  SUBROUTINE ncloud3(th, q, qci, qrs                               &
+                   , w, den, pii, p, delz                          &
+                   , delt,g, cpd, cpv, rd, rv, t0c                 &
+                   , ep1, ep2, qmin                                &
+                   , XLS, XLV0, XLF0, den0, denr                   &
+                   , cliq,cice,psat                                &
+                   , rain, rainncv                                 &
+                   , ids,ide, jds,jde, kds,kde                     &
+                   , ims,ime, jms,jme, kms,kme                     &
+                   , its,ite, jts,jte, kts,kte                     &
+                                                                   )
+                   
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!
+!Coded by Song-You Hong (NCEP) and implemented by Shuhua Chen (NCAR)
+!
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(INOUT) ::                                          &
+                                                             th,  &
+                                                              q,  &
+                                                             qci, &
+                                                             qrs
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(IN   ) ::                                       w, &
+                                                             den, &
+                                                             pii, &
+                                                               p, &
+                                                            delz
+
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                              rd, &
+                                                              rv, &
+                                                             T0c, &
+                                                            den0, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             XLS, &
+                                                            XLV0, &
+                                                            XLF0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime , jms:jme ),                           &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv
+
+! LOCAL VAR
+
+  REAL, DIMENSION( its:ite , kts:kte ) ::   t
+  INTEGER ::               i,j,k
+
+!-------------------------------------------------------------------
+      DO J=jts,jte
+
+         DO K=kts,kte
+         DO I=its,ite
+            t(i,k)=th(i,k,j)*pii(i,k,j)
+         ENDDO
+         ENDDO
+
+         CALL ncloud32D(t, q(ims,kms,j), qci(ims,kms,j)            &
+                    ,qrs(ims,kms,j),w(ims,kms,j), den(ims,kms,j)   &
+                    ,p(ims,kms,j), delz(ims,kms,j)                 &
+                    , delt,g, cpd, cpv, rd, rv, t0c                &
+                    ,ep1, ep2, qmin                                &
+                    ,XLS, XLV0, XLF0, den0, denr                   &
+                    ,cliq,cice,psat                                &
+                    ,J                                             &
+                    ,rain(ims,j), rainncv(ims,j)                   &
+                    ,ids,ide, jds,jde, kds,kde                     &
+                    ,ims,ime, jms,jme, kms,kme                     &
+                    ,its,ite, jts,jte, kts,kte                     &
+                                                                   )
+
+         DO K=kts,kte
+         DO I=its,ite
+            th(i,k,j)=t(i,k)/pii(i,k,j)
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+  END SUBROUTINE ncloud3
+
+!===================================================================
+!
+  SUBROUTINE ncloud32D(t, q, qci, qrs,w, den, p, delz              &
+                    ,delt,g, cpd, cpv, rd, rv, t0c                 &
+                    ,ep1, ep2, qmin                                &
+                    ,XLS, XLV0, XLF0, den0, denr                   &
+                    ,cliq,cice,psat                                &
+                    ,lat                                           &
+                    ,rain, rainncv                                 &
+                    ,ids,ide, jds,jde, kds,kde                     &
+                    ,ims,ime, jms,jme, kms,kme                     &
+                    ,its,ite, jts,jte, kts,kte                     &
+                                                                   )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte,  &
+                                      lat
+
+  REAL, DIMENSION( its:ite , kts:kte ),                           &
+        INTENT(INOUT) ::                                          &
+                                                              t
+
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(INOUT) ::                                          &
+                                                              q,  &
+                                                             qci, &
+                                                             qrs
+
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(IN   ) ::                                       w, &
+                                                             den, &
+                                                               p, &
+                                                            delz
+
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             T0c, &
+                                                            den0, &
+                                                              rd, &
+                                                              rv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             XLS, &
+                                                            XLV0, &
+                                                            XLF0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime ),                                     &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv
+
+! LOCAL VAR
+
+  INTEGER, PARAMETER :: iun      = 84
+
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+        rh, qs, denfac, slope, slope2, slopeb,                    &
+        pgen, paut, pacr, pisd, pres, pcon, fall, falk,           &
+        xl, cpm, work1, work2, q1, t1,                            &
+        pgens, pauts, pacrss, pisds, press, pcons
+
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+              falkc, work1c, work2c, fallc
+
+  INTEGER, DIMENSION( its:ite ) :: mstep
+  LOGICAL, DIMENSION( its:ite ) :: flgcld
+
+  REAL  ::  n0sfac, pi,                                         &
+            cpmcal, xlcal, tvcal, lamdar, lamdas, diffus,       &
+            viscos, xka, venfac, conden, diffac,                &
+            x, y, z, a, b, c, d, e,                             &
+            qdt, pvt, qik, delq, facq, qrsci, frzmlt,           &
+            snomlt, hold, holdrs, facqci, supcol, coeres,       &
+            supsat, dtcld, xmi, qciik, delqci, eacrs, satdt, xnc
+
+  INTEGER :: i,j,k,                                             &
+            iprt, latd, lond, loop, loops, ifsat, kk, n, numdt
+
+!
+!=================================================================
+!   compute internal functions
+!
+      cpmcal(x) = cpd*(1.-max(x,qmin))+max(x,qmin)*cpv
+      xlcal(x) = xlv0-xlv1*(x-t0c)
+      tvcal(x,y) = x+x*ep1*max(y,qmin)
+!----------------------------------------------------------------
+!     size distributions: (x=mixing ratio, y=air density):
+!     valid for mixing ratio > 1.e-30 kg/kg.
+!     otherwise use uniform distribution value (1.e15)
+!
+      lamdar(x,y)=(pidn0r/(x*y))**.25
+      lamdas(x,y,z)=(pidn0s*z/(x*y))**.25
+!
+!----------------------------------------------------------------
+!     diffus: diffusion coefficient of the water vapor
+!     viscos: kinematic viscosity(m2s-1)
+!
+      diffus(x,y) = 8.794e-5*x**1.81/y
+      viscos(x,y) = 1.496e-6*x**1.5/(x+120.)/y
+      xka(x,y) = 1.414e3*viscos(x,y)*y
+      diffac(a,b,c,d,e) = d*a*a/(xka(c,d)*rv*c*c)+1./(e*diffus(c,b))
+      venfac(a,b,c) = (viscos(b,c)/diffus(b,a))**(.3333333)       &
+             /viscos(b,c)**(.5)*(den0/c)**0.25
+      conden(a,b,c,d,e) = (max(b,qmin)-c)/(1.+d*d/(rv*e)*c/(a*a))
+!
+      pi = 4. * atan(1.)
+!
+!=================================================================
+!     set iprt = 0 for no unit fort.84 output
+! 
+!     iprt = 0
+!     if(iprt.eq.1) then
+!       qdt = delt * 1000.
+!       latd = jts
+!       lond = its
+!     else
+!       latd = 0
+!       lond = 0
+!     endif
+!
+!----------------------------------------------------------------
+!     paddint 0 for negative values generated by dynamics
+!
+      do k = kts, kte
+        do i = its, ite
+          qci(i,k) = max(qci(i,k),0.0)
+          qrs(i,k) = max(qrs(i,k),0.0)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     latent heat for phase changes and heat capacity. neglect the
+!     changes during microphysical process calculation
+!     emanuel(1994)
+!
+      do k = kts, kte
+        do i = its, ite
+          cpm(i,k) = cpmcal(q(i,k))
+          xl(i,k) = xlcal(t(i,k))
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     compute the minor time steps.
+!
+      loops = max(nint(delt/dtcldcr),1)
+      dtcld = delt/loops
+      if(delt.le.dtcldcr) dtcld = delt
+!
+      do loop = 1,loops
+!
+!----------------------------------------------------------------
+!     initialize the large scale variables
+!
+      do i = its, ite
+        mstep(i) = 1
+        flgcld(i) = .true.
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          work1(i,k) = tvcal(t(i,k),q(i,k))
+          denfac(i,k) = sqrt(den0/den(i,k))
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          qs(i,k) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+          qs(i,k) = ep2 * qs(i,k) / (p(i,k) - qs(i,k))
+          qs(i,k) = max(qs(i,k),qmin)
+          rh(i,k) = max(q(i,k) / qs(i,k),qmin)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     initialize the variables for microphysical physics
+!
+!     if(lat.eq.latd) then
+!       i = lond
+!       print*,'lat',latd,lat,i
+
+!       do k = kts, kte
+!         press(i,k) = 0.
+!         pauts(i,k) = 0.
+!         pacrss(i,k)= 0.
+!         pgens(i,k) = 0.
+!         pisds(i,k) = 0.
+!         pcons(i,k) = 0.
+!         t1(i,k) = t(i,k)
+!         q1(i,k) = q(i,k)
+!       enddo
+!     endif
+!
+      do k = kts, kte
+        do i = its, ite
+          pres(i,k) = 0.
+          paut(i,k) = 0.
+          pacr(i,k) = 0.
+          pgen(i,k) = 0.
+          pisd(i,k) = 0.
+          pcon(i,k) = 0.
+          fall(i,k) = 0.
+          falk(i,k) = 0.
+          fallc(i,k) = 0.
+          falkc(i,k) = 0.
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     sloper: the slope parameter of the rain(m-1)
+!     xka:    thermal conductivity of air(jm-1s-1k-1)
+!     work1:  the thermodynamic term in the denominator associated with
+!             heat conduction and vapor diffusion
+!             (ry88, y93, h85)
+!     work2: parameter associated with the ventilation effects(y93)
+!
+      do k = kts, kte
+        do i = its, ite
+          if(qrs(i,k).le.qcrmin)then
+            slope(i,k) = lamdarmax
+            slopeb(i,k) = slope(i,k)**bvtr
+          else
+            if(t(i,k).ge.t0c) then
+              slope(i,k) = lamdar(qrs(i,k),den(i,k))
+              slopeb(i,k) = slope(i,k)**bvtr
+            else
+              supcol = t0c-t(i,k)
+              n0sfac = min(exp(alpha*supcol),n0smax)
+              slope(i,k) = lamdas(qrs(i,k),den(i,k),n0sfac)
+              slopeb(i,k) = slope(i,k)**bvts
+            endif
+          endif
+          slope2(i,k) = slope(i,k)*slope(i,k)
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          if(t(i,k).ge.t0c) then
+            work1(i,k) = diffac(xl(i,k),p(i,k),t(i,k),den(i,k),qs(i,k))
+          else
+            work1(i,k) = diffac(xls,p(i,k),t(i,k),den(i,k),qs(i,k))
+          endif
+          work2(i,k) = venfac(p(i,k),t(i,k),den(i,k))
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          supsat = max(q(i,k),qmin)-qs(i,k)
+          satdt = supsat/dtcld
+          if(t(i,k).ge.t0c) then
+!
+!----------------------------------------------------------------
+!     warm rain process
+!     paut: auto conversion rate from cloud to rain (kgkg-1s-1)(kessler)
+!     pacr: accretion rate of rain by cloud(lin83)
+!     pres: evaporation/condensation rate of rain(rh83)
+!
+            if(qci(i,k).gt.qc0) then
+              paut(i,k) = qck1*qci(i,k)**(7./3.)
+              paut(i,k) = min(paut(i,k),qci(i,k)/dtcld)
+            endif
+!
+            if(qrs(i,k).gt.qcrmin) then
+              if(qci(i,k).gt.qcrmin)                                     &
+                pacr(i,k) = min(pacrr/slope2(i,k)/slope(i,k)/slopeb(i,k) &
+                     *qci(i,k)*denfac(i,k),qci(i,k)/dtcld)
+              coeres = slope2(i,k)*sqrt(slope(i,k)*slopeb(i,k))
+              pres(i,k) = (rh(i,k)-1.)*(precr1/slope2(i,k)               &
+                       +precr2*work2(i,k)/coeres)/work1(i,k)
+              if(pres(i,k).lt.0.) then
+                pres(i,k) = max(pres(i,k),-qrs(i,k)/dtcld)
+                pres(i,k) = max(pres(i,k),satdt/2)
+              else
+                pres(i,k) = min(pres(i,k),qrs(i,k)/dtcld)
+                pres(i,k) = min(pres(i,k),satdt/2)
+              endif
+            endif
+          else
+!
+!----------------------------------------------------------------
+!     cold rain process
+!     paut: conversion(aggregation) of ice to snow(kgkg-1s-1)(rh83)
+!     pgen: generation(nucleation) of ice from vapor(kgkg-1s-1)(rh83)
+!     pacr: accretion rate of snow by ice(lin83)
+!     pisd: deposition/sublimation rate of ice(rh83)
+!     pres: deposition/sublimation rate of snow(lin83)
+!
+            supcol = t0c-t(i,k)
+            ifsat = 0
+            n0sfac = min(exp(alpha*supcol),n0smax)
+            xnc = min(xn0 * exp(betai*supcol)/den(i,k),xncmax)
+!
+            if(qrs(i,k).gt.qcrmin.and.qci(i,k).gt.qcrmin) then
+              eacrs = exp(0.025*(-supcol))
+              pacr(i,k) = pacrs*n0sfac*eacrs/slope2(i,k)/slope(i,k)     &
+                      /slopeb(i,k)*qci(i,k)*denfac(i,k)
+            endif
+!
+            if(qci(i,k).gt.qcrmin) then
+              xmi = qci(i,k)*xnc
+              pisd(i,k) = 4.*dicon*sqrt(xmi)*den(i,k)*(rh(i,k)-1.)      &
+                        /work1(i,k)
+              if(pisd(i,k).lt.0.) then
+                pisd(i,k) = max(pisd(i,k),satdt/2)
+                pisd(i,k) = max(pisd(i,k),-qci(i,k)/dtcld)
+              else
+                pisd(i,k) = min(pisd(i,k),satdt/2)
+              endif
+              if(abs(pisd(i,k)).ge.abs(satdt)) ifsat = 1
+            endif
+!
+            if(qrs(i,k).gt.qcrmin.and.ifsat.ne.1) then
+              coeres = slope2(i,k)*sqrt(slope(i,k)*slopeb(i,k))
+              pres(i,k) = (rh(i,k)-1.)*n0sfac*(precs1/slope2(i,k)       &
+                        +precs2*work2(i,k)/coeres)/work1(i,k)
+              if(pres(i,k).lt.0.) then
+                pres(i,k) = max(pres(i,k),-qrs(i,k)/dtcld)
+                pres(i,k) = max(pres(i,k),satdt/2)
+              else
+                pres(i,k) = min(pres(i,k),satdt/2)
+                pres(i,k) = min(pres(i,k),qrs(i,k)/dtcld)
+              endif
+              if(abs(pisd(i,k)+pres(i,k)).ge.abs(satdt)) ifsat = 1
+            endif
+!
+            if(supsat.gt.0.and.ifsat.ne.1) then
+              pgen(i,k) = max(0.,(xm0*xnc-max(qci(i,k),0.))/dtcld)
+              pgen(i,k) = min(pgen(i,k),satdt)
+            endif
+!
+            if(qci(i,k).gt.qcrmin) paut(i,k)                           &
+                = max(0.,(qci(i,k)-xmmax*xnc)/dtcld)
+          endif
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     check mass conservation of generation terms and feedback to the
+!     large scale
+!
+      do k = kts, kte
+        do i = its, ite
+          qciik = max(qcrmin,qci(i,k))
+          delqci = (paut(i,k)+pacr(i,k)-pgen(i,k)-pisd(i,k))*dtcld
+          if(delqci.ge.qciik) then
+            facqci = qciik/delqci
+            paut(i,k) = paut(i,k)*facqci
+            pacr(i,k) = pacr(i,k)*facqci
+            pgen(i,k) = pgen(i,k)*facqci
+            pisd(i,k) = pisd(i,k)*facqci
+          endif
+          qik = max(qcrmin,q(i,k))
+          delq = (pres(i,k)+pgen(i,k)+pisd(i,k))*dtcld
+          if(delq.ge.qik) then
+            facq = qik/delq
+            pres(i,k) = pres(i,k)*facq
+            pgen(i,k) = pgen(i,k)*facq
+            pisd(i,k) = pisd(i,k)*facq
+          endif
+          work2(i,k) = -pres(i,k)-pgen(i,k)-pisd(i,k)
+          q(i,k) = q(i,k)+work2(i,k)*dtcld
+          qci(i,k) = max(qci(i,k)-(paut(i,k)+pacr(i,k)-pgen(i,k)     &
+                   -pisd(i,k))*dtcld,0.)
+          qrs(i,k) = max(qrs(i,k)+(paut(i,k)+pacr(i,k)               &
+                   +pres(i,k))*dtcld,0.)
+          if(t(i,k).lt.t0c) then
+            t(i,k) = t(i,k)-xls*work2(i,k)/cpm(i,k)*dtcld
+          else
+            t(i,k) = t(i,k)-xl(i,k)*work2(i,k)/cpm(i,k)*dtcld
+          endif
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          qs(i,k) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+          qs(i,k) = ep2 * qs(i,k) / (p(i,k) - qs(i,k))
+          qs(i,k) = max(qs(i,k),qmin)
+          denfac(i,k) = sqrt(den0/den(i,k))
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     condensational/evaporational rate of cloud water if there exists
+!     additional water vapor condensated/if evaporation of cloud water
+!     is not enough to remove subsaturation.
+!     use fall bariable for this process(pcon)
+!
+!     if(lat.eq.latd) write(iun,603)
+      do k = kts, kte
+        do i = its, ite
+          work1(i,k) = conden(t(i,k),q(i,k),qs(i,k),xl(i,k),cpm(i,k))
+          work2(i,k) = qci(i,k)+work1(i,k)
+          pcon(i,k) = min(max(work1(i,k),0.),max(q(i,k),0.))/dtcld
+          if(qci(i,k).gt.qcrmin.and.work1(i,k).lt.0.and.t(i,k).gt.t0c)   &
+            pcon(i,k) = max(work1(i,k),-qci(i,k))/dtcld
+          q(i,k) = q(i,k)-pcon(i,k)*dtcld
+          qci(i,k) = max(qci(i,k)+pcon(i,k)*dtcld,0.)
+          t(i,k) = t(i,k)+pcon(i,k)*xl(i,k)/cpm(i,k)*dtcld
+
+!
+!         if(lat.eq.latd.and.i.eq.lond) then
+!           pgens(i,k) = pgens(i,k)+pgen(i,k)
+!           pcons(i,k) = pcons(i,k)+pcon(i,k)
+!           pisds(i,k) = pisds(i,k)+pisd(i,k)
+!           pacrss(i,k) = pacrss(i,k)+pacr(i,k)
+!           press(i,k) = press(i,k)+pres(i,k)
+!           pauts(i,k) = pauts(i,k)+paut(i,k)
+!           write(iun,604) k,p(i,k)/100.,                                   &
+!             t(i,k)-t0c,t(i,k)-t1(i,k),q(i,k)*1000.,                       &
+!             (q(i,k)-q1(i,k))*1000.,rh(i,k)*100.,pgens(i,k)*qdt,           &
+!             pcons(i,k)*qdt,pisds(i,k)*qdt,pauts(i,k)*qdt,pacrss(i,k)*qdt, &
+!             press(i,k)*qdt,qci(i,k)*1000.,qrs(i,k)*1000.
+!         endif
+
+        enddo
+      enddo
+603   format(1x,'  k','     p',                                          &
+           '    t',' delt','    q',' delq','   rh',                      &
+           ' pgen',' pcon',' pisd',' paut',' pacr',' pres',              &
+           '  qci','  qrs')
+604   format(1x,i3,f6.0,4f5.1,f5.0,8f5.2)
+!
+!----------------------------------------------------------------
+!     compute the fallout term:
+!     first, vertical terminal velosity for minor loops
+!
+      do k = kts, kte
+        do i = its, ite
+          denfac(i,k) = sqrt(den0/den(i,k))
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          if(qrs(i,k).le.qcrmin)then
+            slope(i,k) = lamdarmax
+            slopeb(i,k) = slope(i,k)**bvtr
+          else
+            if(t(i,k).ge.t0c) then
+              slope(i,k) = lamdar(qrs(i,k),den(i,k))
+              slopeb(i,k) = slope(i,k)**bvtr
+            else
+              supcol = t0c-t(i,k)
+              n0sfac = min(exp(alpha*supcol),n0smax)
+              slope(i,k) = lamdas(qrs(i,k),den(i,k),n0sfac)
+              slopeb(i,k) = slope(i,k)**bvts
+            endif
+          endif
+          slope2(i,k) = slope(i,k)*slope(i,k)
+        enddo
+      enddo
+!
+      do i = its, ite
+        do k = kte, kts, -1
+          if(t(i,k).lt.t0c) then
+            pvt = pvts
+          else
+            pvt = pvtr
+          endif
+          work1(i,k) = pvt/slopeb(i,k)*denfac(i,k)
+          work2(i,k) = work1(i,k)/delz(i,k)
+          if(qrs(i,k).le.qcrmin) work2(i,k) = 0.
+          numdt = max(nint(work2(i,k)*dtcld+.5),1)
+          if(t(i,k).lt.t0c.and.qci(i,k).gt.qmin) then
+            work1c(i,k) = 3.29*(den(i,k)*qci(i,k))**0.16
+          else
+            work1c(i,k) = 0.
+          endif
+          if(qci(i,k).le.qmin) then
+            work2c(i,k) = 0.
+          else
+            work2c(i,k) = work1c(i,k)/delz(i,k)
+          endif
+          numdt = max(nint(work2c(i,k)*dtcld+.5),numdt)
+          if(numdt.ge.mstep(i)) mstep(i) = numdt
+        enddo
+        mstep(i) = min(mstep(i),mstepmax)
+      enddo
+!
+!     if(lat.eq.latd) write(iun,605)
+      do n = 1,mstepmax
+        k = kte
+          do i = its, ite
+            if(n.le.mstep(i)) then
+              falk(i,k) = den(i,k)*qrs(i,k)*work2(i,k)/mstep(i)
+              hold = falk(i,k)
+              fall(i,k) = fall(i,k)+falk(i,k)
+              holdrs = qrs(i,k)
+              qrs(i,k) = max(qrs(i,k)-falk(i,k)*dtcld/den(i,k),0.)
+              falkc(i,k) = den(i,k)*qci(i,k)*work2c(i,k)/mstep(i)
+              fallc(i,k) = fallc(i,k)+falkc(i,k)
+              qci(i,k) = max(qci(i,k)-falkc(i,k)*dtcld/den(i,k),0.)
+            endif
+          enddo
+        do k = kte-1, kts, -1
+          do i = its, ite
+            if(n.le.mstep(i)) then
+              falk(i,k) = den(i,k)*qrs(i,k)*work2(i,k)/mstep(i)
+              hold = falk(i,k)
+              fall(i,k) = fall(i,k)+falk(i,k)
+              holdrs = qrs(i,k)
+              qrs(i,k) = max(qrs(i,k)-(falk(i,k)                        &
+                        -falk(i,k+1)*delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+              falkc(i,k) = den(i,k)*qci(i,k)*work2c(i,k)/mstep(i)
+              fallc(i,k) = fallc(i,k)+falkc(i,k)
+              qci(i,k) = max(qci(i,k)-(falkc(i,k)                       &
+                        -falkc(i,k+1)*delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+            endif
+          enddo
+        enddo
+      enddo
+605   format(1x,'  k','     p','    t','    q','   rh','     w',        &
+            '    vt','  falk','  falt','  qrsi','  qrsf',' mstep')
+606   format(1x,i3,f6.0,2f5.1,f5.0,f6.2,5f6.2,i5)
+!
+!----------------------------------------------------------------
+!     compute the freezing/melting term.
+!     freezing occurs one layer above the melting level
+!
+      do i = its, ite
+        mstep(i) = 0
+      enddo
+      do k = kts, kte
+!
+        do i = its, ite
+          if(t(i,k).ge.t0c) then
+            mstep(i) = k
+          endif
+        enddo
+      enddo
+!
+      do i = its, ite
+        if(mstep(i).ne.0.and.w(i,mstep(i)).gt.0.) then
+          work1(i,1) = float(mstep(i) + 1)
+          work1(i,2) = float(mstep(i))
+        else
+          work1(i,1) = float(mstep(i))
+          work1(i,2) = float(mstep(i))
+        endif
+      enddo
+!
+      do i = its, ite
+        k  = nint(work1(i,1))
+        kk = nint(work1(i,2))
+        if(k*kk.ge.1) then
+          qrsci = qrs(i,k) + qci(i,k)
+          if(qrsci.gt.qcrmin.or.fall(i,kk).gt.0.) then
+            frzmlt = min(max(-w(i,k)*qrsci/delz(i,k),-qrsci/dtcld),    &
+                     qrsci/dtcld)
+            snomlt = min(max(fall(i,kk)/den(i,kk),-qrs(i,k)/dtcld),qrs(i,k)/dtcld)
+            if(k.eq.kk) then
+              t(i,k) = t(i,k) - xlf0/cpm(i,k)*(frzmlt+snomlt)*dtcld
+            else
+              t(i,k) = t(i,k) - xlf0/cpm(i,k)*frzmlt*dtcld
+              t(i,kk) = t(i,kk) - xlf0/cpm(i,kk)*snomlt*dtcld
+            endif
+ 
+!           if(lat.eq.latd.and.i.eq.lond) write(iun,608) k,t(i,k)-t0c, &
+!             w(i,k),frzmlt*qdt,snomlt*qdt
+
+          endif
+        endif
+      enddo
+ 608  format(1x,'k = ',i3,' t = ',f5.1,' w = ',f6.2,' frz/mlt = ',f5.1, &
+                 ' snomlt = ',f5.1)
+!
+!----------------------------------------------------------------
+!      rain (unit is mm/sec;kgm-2s-1: /1000*delt ===> m)==> mm for wrf
+!
+      do i = its, ite
+        if(fall(i,1).gt.0.) then
+          rainncv(i) = fall(i,1)*delz(i,1)/denr*dtcld*1000.
+          rain(i) = fall(i,1)*delz(i,1)/denr*dtcld*1000.       &
+                  + rain(i)
+        endif
+      enddo
+!
+!     if(lat.eq.latd) write(iun,601) latd,lond,loop,rain(lond)
+ 601  format(1x,' ncloud3 lat lon loop : rain(mm) ',3i6,f20.2)
+!
+      enddo                  ! big loops
+
+  END SUBROUTINE ncloud32D
+! ...................................................................
+      real function rgmma(x)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!     rgmma function:  use infinite product form
+      REAL :: euler
+      parameter (euler=0.577215664901532)
+      REAL :: x, y
+      INTEGER :: i
+
+      if(x.eq.1.)then
+        rgmma=0.
+          else
+        rgmma=x*exp(euler*x)
+        do i=1,10000
+          y=float(i)
+          rgmma=rgmma*(1.000+x/y)*exp(-x/y)
+        enddo
+        rgmma=1./rgmma
+      endif
+      END FUNCTION rgmma
+!
+!--------------------------------------------------------------------------
+      real function fpvs(t,ice,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c)
+!--------------------------------------------------------------------------
+      IMPLICIT NONE
+!--------------------------------------------------------------------------
+      real t,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c,dldt,xa,xb,dldti, &
+           xai,xbi,ttp,tr
+      INTEGER ice
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      tr=ttp/t
+      if(t.lt.ttp.and.ice.eq.1) then
+        fpvs=psat*(tr**xai)*exp(xbi*(1.-tr))
+      else
+        fpvs=psat*(tr**xa)*exp(xb*(1.-tr))
+      endif
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END FUNCTION fpvs
+
+!-------------------------------------------------------------------
+  SUBROUTINE ncloud3init(den0,denr,dens,cl,cpv,allowed_to_read)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!.... constants which may not be tunable
+
+   REAL, INTENT(IN) :: den0,denr,dens,cl,cpv
+   LOGICAL,INTENT(IN) :: allowed_to_read
+   REAL :: pi
+
+   pi = 4.*atan(1.)
+   xlv1 = cl-cpv
+
+   qc0  = 4./3.*pi*denr*r0**3*xncr/den0  ! 0.419e-3 -- .61e-3
+   qck1 = .104*9.8*peaut/(xncr*denr)**(1./3.)/xmyu ! 7.03
+   bvtr1 = 1.+bvtr
+   bvtr2 = 2.5+.5*bvtr
+   bvtr3 = 3.+bvtr
+   bvtr4 = 4.+bvtr
+   g1pbr = rgmma(bvtr1)
+   g3pbr = rgmma(bvtr3)
+   g4pbr = rgmma(bvtr4)            ! 17.837825
+   g5pbro2 = rgmma(bvtr2)          ! 1.8273
+   pvtr = avtr*g4pbr/6.
+   eacrr = 1.0
+   pacrr = pi*n0r*avtr*g3pbr*.25*eacrr
+   precr1 = 2.*pi*n0r*.78
+   precr2 = 2.*pi*n0r*.31*avtr**.5*g5pbro2
+   xm0  = (di0/dicon)**2
+   xmmax = (dimax/dicon)**2
+!
+   bvts1 = 1.+bvts
+   bvts2 = 2.5+.5*bvts
+   bvts3 = 3.+bvts
+   bvts4 = 4.+bvts
+   g1pbs = rgmma(bvts1)    !.8875
+   g3pbs = rgmma(bvts3)
+   g4pbs = rgmma(bvts4)    ! 12.0786
+   g5pbso2 = rgmma(bvts2)
+   pvts = avts*g4pbs/6.
+   pacrs = pi*n0s*avts*g3pbs*.25
+   precs1 = 4.*n0s*.65
+   precs2 = 4.*n0s*.44*avts**.5*g5pbso2
+   pidn0r =  pi*denr*n0r
+   pidn0s =  pi*dens*n0s
+!
+  END SUBROUTINE ncloud3init
+
+END MODULE module_mp_ncloud3
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_mp_ncloud5.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_mp_ncloud5.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_mp_ncloud5.F	(revision 2744)
@@ -0,0 +1,945 @@
+MODULE module_mp_ncloud5
+
+   REAL, PARAMETER, PRIVATE :: dtcldcr     = 240.
+   INTEGER, PARAMETER, PRIVATE :: mstepmax = 100
+
+   REAL, PARAMETER, PRIVATE :: r0 = .8e-5 ! 8 microm  in contrast to 10 micro m
+   REAL, PARAMETER, PRIVATE :: n0r = 8.e6
+   REAL, PARAMETER, PRIVATE :: avtr = 841.9
+   REAL, PARAMETER, PRIVATE :: bvtr = 0.8
+   REAL, PARAMETER, PRIVATE :: peaut = .55   ! collection efficiency
+   REAL, PARAMETER, PRIVATE :: xncr = 3.e8   ! maritime cloud in contrast to 3.e8 in tc80
+   REAL, PARAMETER, PRIVATE :: xmyu = 1.718e-5 ! the dynamic viscosity kgm-1s-1
+
+   REAL, PARAMETER, PRIVATE :: avts = 16.2
+   REAL, PARAMETER, PRIVATE :: bvts = .527
+   REAL, PARAMETER, PRIVATE :: xncmax =  1.e8
+   REAL, PARAMETER, PRIVATE :: n0smax =  1.e9
+   REAL, PARAMETER, PRIVATE :: betai = .6
+   REAL, PARAMETER, PRIVATE :: xn0 = 1.e-2
+   REAL, PARAMETER, PRIVATE :: dicon = 16.3
+   REAL, PARAMETER, PRIVATE :: di0 = 12.9e-6*.8
+   REAL, PARAMETER, PRIVATE :: dimax = 400.e-6
+   REAL, PARAMETER, PRIVATE :: n0s = 2.e6             ! temperature dependent n0s
+   REAL, PARAMETER, PRIVATE :: alpha = 1./8.18        ! .122 exponen factor for n0s
+   REAL, PARAMETER, PRIVATE :: pfrz1 = 100.
+   REAL, PARAMETER, PRIVATE :: pfrz2 = 0.66
+!  REAL, PARAMETER, PRIVATE :: lamdarmax = 1.e15
+   REAL, PARAMETER, PRIVATE :: lamdarmax = 1.e5
+   REAL, PARAMETER, PRIVATE :: qcrmin = 1.e-6
+
+   REAL, PARAMETER, PRIVATE ::    t40c   =  233.16
+   REAL, PARAMETER, PRIVATE ::    eacrc  =  1.0
+
+   REAL, SAVE ::                               &
+       qc0, qck1,bvtr1,bvtr2,bvtr3,bvtr4,g1pbr,&
+       g3pbr,g4pbr,g5pbro2,pvtr,eacrr,pacrr,   &
+       precr1,precr2,xm0,xmmax,bvts1,          &
+             bvts2,bvts3,bvts4,g1pbs,g3pbs,g4pbs,    &
+             g5pbso2,pvts,pacrs,precs1,precs2,pidn0r,&
+             pidn0s,xlv1,pacrc
+
+CONTAINS
+
+!===================================================================
+!
+  SUBROUTINE ncloud5(th, q, qc, qr, qi, qs                         &
+                    ,w, den, pii, p, delz                          &
+                    ,delt,g, cpd, cpv, rd, rv, t0c                 &
+                    ,ep1, ep2, qmin                                &
+                    ,XLS, XLV0, XLF0, den0, denr                   &
+                    ,cliq,cice,psat                                &
+                    ,rain, rainncv                                 &
+                    ,ids,ide, jds,jde, kds,kde                     &
+                    ,ims,ime, jms,jme, kms,kme                     &
+                    ,its,ite, jts,jte, kts,kte                     &
+                                                                   )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!
+!Coded by Song-You Hong (NCEP) and implemented by Shuhua Chen (NCAR)
+!
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(INOUT) ::                                          &
+                                                             th,  &
+                                                              q,  &
+                                                              qc, &
+                                                              qi, &
+                                                              qr, &
+                                                              qs
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(IN   ) ::                                       w, &
+                                                             den, &
+                                                             pii, &
+                                                               p, &
+                                                            delz
+
+
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                              rd, &
+                                                              rv, &
+                                                             t0c, &
+                                                            den0, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             xls, &
+                                                            xlv0, &
+                                                            xlf0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime , jms:jme ),                           &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv
+
+! LOCAL VAR
+
+  REAL, DIMENSION( its:ite , kts:kte ) ::   t
+  REAL, DIMENSION( its:ite , kts:kte, 2 ) ::   qci, qrs
+  INTEGER ::               i,j,k
+
+!-------------------------------------------------------------------
+      DO J=jts,jte
+
+         DO k=kts,kte
+         DO i=its,ite
+            t(i,k)=th(i,k,j)*pii(i,k,j)
+            qci(i,k,1) = qc(i,k,j)
+            qci(i,k,2) = qi(i,k,j)
+            qrs(i,k,1) = qr(i,k,j)
+            qrs(i,k,2) = qs(i,k,j)
+         ENDDO
+         ENDDO
+
+         CALL ncloud52D(t, q(ims,kms,j), qci, qrs                  &
+                    ,w(ims,kms,j), den(ims,kms,j)                  &
+                    ,p(ims,kms,j), delz(ims,kms,j)                 &
+                    ,delt,g, cpd, cpv, rd, rv, t0c                 &
+                    ,ep1, ep2, qmin                                &
+                    ,XLS, XLV0, XLF0, den0, denr                   &
+                    ,cliq,cice,psat                                &
+                    ,j                                             &
+                    ,rain(ims,j),rainncv(ims,j)                    &
+                    ,ids,ide, jds,jde, kds,kde                     &
+                    ,ims,ime, jms,jme, kms,kme                     &
+                    ,its,ite, jts,jte, kts,kte                     &
+                                                                   )
+
+         DO K=kts,kte
+         DO I=its,ite
+            th(i,k,j)=t(i,k)/pii(i,k,j)
+            qc(i,k,j) = qci(i,k,1)
+            qi(i,k,j) = qci(i,k,2)
+            qr(i,k,j) = qrs(i,k,1)
+            qs(i,k,j) = qrs(i,k,2)
+         ENDDO
+         ENDDO
+
+      ENDDO
+
+  END SUBROUTINE ncloud5
+
+!===================================================================
+!
+  SUBROUTINE ncloud52D(t, q, qci, qrs,w, den, p, delz              &
+                    ,delt,g, cpd, cpv, rd, rv, t0c                 &
+                    ,ep1, ep2, qmin                                &
+                    ,XLS, XLV0, XLF0, den0, denr                   &
+                    ,cliq,cice,psat                                &
+                    ,lat                                           &
+                    ,rain,rainncv                                  &
+                    ,ids,ide, jds,jde, kds,kde                     &
+                    ,ims,ime, jms,jme, kms,kme                     &
+                    ,its,ite, jts,jte, kts,kte                     &
+                                                                   )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte,  &
+                                      lat
+
+  REAL, DIMENSION( its:ite , kts:kte ),                           &
+        INTENT(INOUT) ::                                          &
+                                                               t
+  REAL, DIMENSION( its:ite , kts:kte, 2 ),                        &
+        INTENT(INOUT) ::                                          &
+                                                        qci, qrs
+
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(INOUT) ::                                          &
+                                                               q
+
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(IN   ) ::                                       p, &
+                                                               w, &
+                                                             den, &
+                                                            delz
+
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             t0c, &
+                                                            den0, &
+                                                              rd, &
+                                                              rv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             xls, &
+                                                            xlv0, &
+                                                            xlf0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime ),                                     &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv
+
+! LOCAL VAR
+
+  INTEGER, PARAMETER :: iun      = 84
+
+  REAL, DIMENSION( its:ite , kts:kte , 2) ::                      &
+        rh, qs, slope, slope2, slopeb,                            &
+        paut, pres, falk, fall, work1    
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+              falkc, work1c, work2c, fallc
+  REAL, DIMENSION( its:ite , kts:kte, 3 ) ::                      &
+        pacr
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+        pgen, pisd, pcon, xl, cpm, work2, q1, t1, denfac,         &
+        pgens, pauts, pacrss, pisds, press, pcons, psml, psev
+
+  INTEGER, DIMENSION( its:ite ) :: mstep
+  LOGICAL, DIMENSION( its:ite ) :: flgcld
+
+  REAL  ::  n0sfac, pi,                                         &
+            cpmcal, xlcal, lamdar, lamdas, diffus,              &
+            viscos, xka, venfac, conden, diffac,                &
+            x, y, z, a, b, c, d, e,                             &
+            qdt, holdrr, holdrs, supcol,                        &
+            coeres, supsat, dtcld, xmi, eacrs, satdt, xnc,      &
+            fallsum, xlwork2, factor, source, value,            &
+            xlf,pfrzdtc,pfrzdtr
+
+  INTEGER :: i,j,k,                                             &
+            iprt, latd, lond, loop, loops, ifsat, n, numdt
+
+!
+!=================================================================
+!   compute internal functions
+!
+      cpmcal(x) = cpd*(1.-max(x,qmin))+max(x,qmin)*cpv
+      xlcal(x) = xlv0-xlv1*(x-t0c)
+!     tvcal(x,y) = x+x*ep1*max(y,qmin)
+!----------------------------------------------------------------
+!     size distributions: (x=mixing ratio, y=air density):
+!     valid for mixing ratio > 1.e-30 kg/kg.
+!     otherwise use uniform distribution value (1.e15)
+!
+      lamdar(x,y)=(pidn0r/(x*y))**.25
+      lamdas(x,y,z)=(pidn0s*z/(x*y))**.25
+!
+!----------------------------------------------------------------
+!     diffus: diffusion coefficient of the water vapor
+!     viscos: kinematic viscosity(m2s-1)
+!
+      diffus(x,y) = 8.794e-5*x**1.81/y
+      viscos(x,y) = 1.496e-6*x**1.5/(x+120.)/y
+      xka(x,y) = 1.414e3*viscos(x,y)*y
+      diffac(a,b,c,d,e) = d*a*a/(xka(c,d)*rv*c*c)+1./(e*diffus(c,b))
+      venfac(a,b,c) = (viscos(b,c)/diffus(b,a))**(.3333333)       &
+             /viscos(b,c)**(.5)*(den0/c)**0.25
+      conden(a,b,c,d,e) = (max(b,qmin)-c)/(1.+d*d/(rv*e)*c/(a*a))
+!
+      pi = 4. * atan(1.)
+!
+!=================================================================
+!     set iprt = 0 for no unit fort.84 output
+!
+      iprt = 1
+      if(iprt.eq.1) then
+        qdt = delt * 1000.
+        latd = (jte+jts)/2 + 1
+        lond = (ite+its)/2 + 1
+      else
+        latd = jts
+        lond = its
+      endif
+!
+!----------------------------------------------------------------
+!     paddint 0 for negative values generated by dynamics
+!
+      do k = kts, kte
+        do i = its, ite
+          qci(i,k,1) = max(qci(i,k,1),0.0)
+          qrs(i,k,1) = max(qrs(i,k,1),0.0)
+          qci(i,k,2) = max(qci(i,k,2),0.0)
+          qrs(i,k,2) = max(qrs(i,k,2),0.0)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     latent heat for phase changes and heat capacity. neglect the
+!     changes during microphysical process calculation
+!     emanuel(1994)
+!
+      do k = kts, kte
+        do i = its, ite
+          cpm(i,k) = cpmcal(q(i,k))
+          xl(i,k) = xlcal(t(i,k))
+        enddo
+      enddo
+      if(lat.eq.latd) then
+        i = lond
+        do k = kts, kte
+          press(i,k) = 0.
+          pauts(i,k) = 0.
+          pacrss(i,k)= 0.
+          pgens(i,k) = 0.
+          pisds(i,k) = 0.
+          pcons(i,k) = 0.
+          t1(i,k) = t(i,k)
+          q1(i,k) = q(i,k)
+        enddo
+      endif
+!
+!----------------------------------------------------------------
+!     compute the minor time steps.
+!
+      loops = max(nint(delt/dtcldcr),1)
+      dtcld = delt/loops
+      if(delt.le.dtcldcr) dtcld = delt
+!
+      do loop = 1,loops
+!
+      do i = its, ite
+        mstep(i) = 1
+        flgcld(i) = .true.
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          denfac(i,k) = sqrt(den0/den(i,k))
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          qs(i,k,1) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+          qs(i,k,1) = ep2 * qs(i,k,1) / (p(i,k) - qs(i,k,1))
+          qs(i,k,1) = max(qs(i,k,1),qmin)
+          rh(i,k,1) = max(q(i,k) / qs(i,k,1),qmin)
+          qs(i,k,2) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+          qs(i,k,2) = ep2 * qs(i,k,2) / (p(i,k) - qs(i,k,2))
+          qs(i,k,2) = max(qs(i,k,2),qmin)
+          rh(i,k,2) = max(q(i,k) / qs(i,k,2),qmin)
+!         if(lat.eq.latd.and.i.eq.lond) write(iun,700) qci(i,k,1)*1000., &
+!           qrs(i,k,1)*1000.,qci(i,k,2)*1000.,qrs(i,k,2)*1000.
+!700       format(1x,'before computation', 4f10.4)
+        enddo
+      enddo
+!
+!
+!----------------------------------------------------------------
+!     initialize the variables for microphysical physics
+!
+!
+      do k = kts, kte
+        do i = its, ite
+          pres(i,k,1) = 0.
+          pres(i,k,2) = 0.
+          paut(i,k,1) = 0.
+          paut(i,k,2) = 0.
+          pacr(i,k,1) = 0.
+          pacr(i,k,2) = 0.
+          pacr(i,k,3) = 0.
+          pgen(i,k) = 0.
+          pisd(i,k) = 0.
+          pcon(i,k) = 0.
+          psml(i,k) = 0.
+          psev(i,k) = 0.
+          falk(i,k,1) = 0.
+          falk(i,k,2) = 0.
+          fall(i,k,1) = 0.
+          fall(i,k,2) = 0.
+          fallc(i,k) = 0.
+          falkc(i,k) = 0.
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     sloper: the slope parameter of the rain(m-1)
+!     xka:    thermal conductivity of air(jm-1s-1k-1)
+!     work1:  the thermodynamic term in the denominator associated with
+!             heat conduction and vapor diffusion
+!             (ry88, y93, h85)
+!     work2: parameter associated with the ventilation effects(y93)
+!
+      do k = kts, kte
+        do i = its, ite
+          if(qrs(i,k,1).le.qcrmin)then
+            slope(i,k,1) = lamdarmax
+            slopeb(i,k,1) = slope(i,k,1)**bvtr
+          else
+            slope(i,k,1) = lamdar(qrs(i,k,1),den(i,k))
+            slopeb(i,k,1) = slope(i,k,1)**bvtr
+          endif
+          if(qrs(i,k,2).le.qcrmin)then
+            slope(i,k,2) = lamdarmax
+            slopeb(i,k,2) = slope(i,k,2)**bvts
+          else
+            supcol = t0c-t(i,k)
+            n0sfac = min(exp(alpha*supcol),n0smax)
+            slope(i,k,2) = lamdas(qrs(i,k,2),den(i,k),n0sfac)
+            slopeb(i,k,2) = slope(i,k,2)**bvts
+          endif
+          slope2(i,k,1) = slope(i,k,1)*slope(i,k,1)
+          slope2(i,k,2) = slope(i,k,2)*slope(i,k,2)
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          work1(i,k,1) = diffac(xl(i,k),p(i,k),t(i,k),den(i,k),qs(i,k,1))
+          work1(i,k,2) = diffac(xls,p(i,k),t(i,k),den(i,k),qs(i,k,2))
+          work2(i,k) = venfac(p(i,k),t(i,k),den(i,k))
+        enddo
+      enddo
+!
+!     instantaneous melting of cloud ice
+!
+      do k = kts, kte
+        do i = its, ite
+          supcol = t0c-t(i,k)
+          xlf = xls-xl(i,k)
+          if(supcol.lt.0..and.qci(i,k,2).gt.qcrmin) then
+            qci(i,k,1) = qci(i,k,1) + qci(i,k,2)
+            t(i,k) = t(i,k) - xlf/cpm(i,k)*qci(i,k,2)
+            qci(i,k,2) = 0.
+!           if(lat.eq.latd.and.i.eq.lond) write(iun,607) k,-supcol, &
+!             qci(i,k,2)*1000.,xlf/cpm(i,k)*qci(i,k,2)
+          endif
+!607  format(1x,'k = ',i3,' t = ',f5.1,' qi melting = ',f10.6,     &
+!            '  del t  = ',f10.6)
+!
+!     homogeneous freezing of cloud water below -40c
+!
+          if(supcol.gt.40..and.qci(i,k,1).gt.qcrmin) then
+            qci(i,k,2) = qci(i,k,2) + qci(i,k,1)
+            t(i,k) = t(i,k) + xlf/cpm(i,k)*qci(i,k,1)
+            qci(i,k,1) = 0.
+!           if(lat.eq.latd.and.i.eq.lond) write(iun,608) k,-supcol, &
+!             qci(i,k,1)*1000.,xlf/cpm(i,k)*qci(i,k,1)
+          endif
+!608  format(1x,'k = ',i3,' t = ',f5.1,' qc home freezing = ',f10.6, &
+!           '  del t  = ',f10.6)
+!
+!     heterogeneous freezing of cloud water
+!
+          if(supcol.gt.0..and.qci(i,k,1).gt.qcrmin) then
+            pfrzdtc = min(pfrz1*exp(pfrz2*supcol-1.)                &
+               *den(i,k)/denr/xncr*qci(i,k,1)**2*dtcld,qci(i,k,1))
+            qci(i,k,2) = qci(i,k,2) + pfrzdtc
+            t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtc
+            qci(i,k,1) = qci(i,k,1)-pfrzdtc
+!           if(lat.eq.latd.and.i.eq.lond) write(iun,609) k,-supcol,  &
+!             pfrzdtc*1000.,xlf/cpm(i,k)*pfrzdtc
+          endif
+!609  format(1x,'k = ',i3,' t = ',f5.1,' qc hete freezing = ',f10.6, &
+!           '  del t  = ',f10.6)
+!
+!     freezing of rain water
+!
+          if(supcol.gt.0..and.qrs(i,k,1).gt.qcrmin) then
+            pfrzdtr = min(20.*pi**2*pfrz1*n0r*denr/den(i,k)          &
+                  *exp(pfrz2*supcol-1.)*slope(i,k,1)**(-7)*dtcld,       &
+                  qrs(i,k,1))
+            qrs(i,k,2) = qrs(i,k,2) + pfrzdtr
+            t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtr
+            qrs(i,k,1) = qrs(i,k,1)-pfrzdtr
+!           if(lat.eq.latd.and.i.eq.lond) write(iun,610) k,-supcol,  &
+!             pfrzdtr*1000.,xlf/cpm(i,k)*pfrzdtr
+!610  format(1x,'k = ',i3,' t = ',f5.1,' qr      freezing = ',f10.6, &
+!           '  del t  = ',f10.6)
+          endif
+        enddo
+      enddo
+!
+!     warm rain process
+!     paut: auto conversion rate from cloud to rain (kgkg-1s-1)
+!     pacr: accretion rate of rain by cloud(lin83)
+!     pres: evaporation/condensation rate of rain(rh83)
+!
+      do k = kts, kte
+        do i = its, ite
+          supsat = max(q(i,k),qmin)-qs(i,k,1)
+          satdt = supsat/dtcld
+          if(qci(i,k,1).gt.qc0) then
+            paut(i,k,1) = qck1*qci(i,k,1)**(7./3.)
+            paut(i,k,1) = min(paut(i,k,1),qci(i,k,1)/dtcld)
+          endif
+          if(qrs(i,k,1).gt.qcrmin) then
+            if(qci(i,k,1).gt.qcrmin) pacr(i,k,1)                           &
+              = min(pacrr/slope2(i,k,1)/slope(i,k,1)/slopeb(i,k,1)       &
+                *qci(i,k,1)*denfac(i,k),qci(i,k,1)/dtcld)
+            coeres = slope2(i,k,1)*sqrt(slope(i,k,1)*slopeb(i,k,1))
+            pres(i,k,1) = (rh(i,k,1)-1.)*(precr1/slope2(i,k,1)           &
+                        +precr2*work2(i,k)/coeres)/work1(i,k,1)
+            if(pres(i,k,1).lt.0.) then
+              pres(i,k,1) = max(pres(i,k,1),-qrs(i,k,1)/dtcld)
+              pres(i,k,1) = max(pres(i,k,1),satdt/2)
+            else
+              pres(i,k,1) = min(pres(i,k,1),satdt/2)
+              pres(i,k,1) = min(pres(i,k,1),qrs(i,k,1)/dtcld)
+            endif
+          endif
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     cold rain process
+!     paut: conversion(aggregation) of ice to snow(kgkg-1s-1)(rh83)
+!     pgen: generation(nucleation) of ice from vapor(kgkg-1s-1)(rh83)
+!     pacr: accretion rate of snow by ice(lin83)
+!     pisd: deposition/sublimation rate of ice(rh83)
+!     pres: deposition/sublimation rate of snow(lin83)
+!
+      do k = kts, kte
+        do i = its, ite
+          supcol = t0c-t(i,k)
+          supsat = max(q(i,k),qmin)-qs(i,k,2)
+          satdt = supsat/dtcld
+          ifsat = 0
+          n0sfac = min(exp(alpha*supcol),n0smax)
+          xnc = min(xn0 * exp(betai*supcol)/den(i,k),xncmax)
+!
+          if(qrs(i,k,2).gt.qcrmin.and.qci(i,k,2).gt.qcrmin) then
+            eacrs = exp(0.025*(-supcol))
+            pacr(i,k,2) = min(pacrs*n0sfac*eacrs/slope2(i,k,2)/slope(i,k,2)   &
+                      /slopeb(i,k,2)*qci(i,k,2)*denfac(i,k),qci(i,k,2)/dtcld)
+          endif
+          if(qrs(i,k,2).gt.qcrmin.and.qci(i,k,1).gt.qcrmin) then
+            pacr(i,k,3) = min(pacrc/slope2(i,k,2)/slope(i,k,2)                &
+                      /slopeb(i,k,2)*qci(i,k,1)*denfac(i,k),qci(i,k,1)/dtcld)
+          endif
+!
+          if(qci(i,k,2).gt.qcrmin) then
+            xmi = qci(i,k,2)*xnc
+            if(ifsat.ne.1) pisd(i,k) = 4.*dicon*sqrt(xmi)*den(i,k)         &
+                                     *(rh(i,k,2)-1.)/work1(i,k,2)
+            if(pisd(i,k).lt.0.) then
+              pisd(i,k) = max(pisd(i,k),satdt)
+              pisd(i,k) = max(pisd(i,k),-qci(i,k,2)/dtcld)
+            else
+              pisd(i,k) = min(pisd(i,k),satdt)
+            endif
+            if(abs(pisd(i,k)).gt.abs(satdt)) ifsat = 1
+          endif
+!
+          if(qrs(i,k,2).gt.qcrmin.and.ifsat.ne.1) then
+            coeres = slope2(i,k,2)*sqrt(slope(i,k,2)*slopeb(i,k,2))
+            if(ifsat.ne.1) pres(i,k,2) = (rh(i,k,2)-1.)*(precs1             &
+                                       /slope2(i,k,2)+precs2*work2(i,k)     &
+                                       /coeres)/work1(i,k,2)
+            if(pres(i,k,2).lt.0.) then
+              pres(i,k,2) = max(pres(i,k,2),-qrs(i,k,2)/dtcld)
+              pres(i,k,2) = max(pres(i,k,2),satdt/2)
+            else
+              pres(i,k,2) = min(pres(i,k,2),satdt/2)
+              pres(i,k,2) = min(pres(i,k,2),qrs(i,k,2)/dtcld)
+            endif
+            if(abs(pisd(i,k)+pres(i,k,2)).ge.abs(satdt)) ifsat = 1
+          endif
+!
+          if(supsat.gt.0.and.ifsat.ne.1) then
+            pgen(i,k) = max(0.,(xm0*xnc-max(qci(i,k,2),0.))/dtcld)
+            pgen(i,k) = min(pgen(i,k),satdt)
+          endif
+!
+          if(qci(i,k,2).gt.qcrmin) paut(i,k,2)                           &
+                 = max(0.,(qci(i,k,2)-xmmax*xnc)/dtcld)
+!
+          if(t(i,k).gt.t0c) then
+            xlf = xls - xl(i,k)
+            if(qrs(i,k,2).gt.qcrmin) then
+              psml(i,k) = xka(t(i,k),den(i,k))/xlf*(t0c-t(i,k))*pi/2.    &
+                          *(precs1/slope2(i,k,2)+precs2*work2(i,k)/coeres)
+              psml(i,k) = min(max(psml(i,k),-qrs(i,k,2)/dtcld),0.)
+            endif
+            if(qrs(i,k,2).gt.qcrmin.and.rh(i,k,1).lt.1.)                 &
+              psev(i,k) = pres(i,k,2)*work1(i,k,2)/work1(i,k,1)
+              psev(i,k) = min(max(psev(i,k),-qrs(i,k,2)/dtcld),0.)
+          endif
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     check mass conservation of generation terms and feedback to the
+!     large scale
+!
+      do k = kts, kte
+        do i = its, ite
+          if(t(i,k).le.t0c) then
+!
+!     cloud water
+!
+            value = max(qcrmin,qci(i,k,1))
+            source = (paut(i,k,1)+pacr(i,k,1)+pacr(i,k,3))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              paut(i,k,1) = paut(i,k,1)*factor
+              pacr(i,k,1) = pacr(i,k,1)*factor
+              pacr(i,k,3) = pacr(i,k,3)*factor
+            endif
+!
+!     cloud ice
+!
+            value = max(qcrmin,qci(i,k,2))
+            source = (paut(i,k,2)+pacr(i,k,2)-pgen(i,k)-pisd(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              paut(i,k,2) = paut(i,k,2)*factor
+              pacr(i,k,2) = pacr(i,k,2)*factor
+              pgen(i,k) = pgen(i,k)*factor
+              pisd(i,k) = pisd(i,k)*factor
+            endif
+            work2(i,k)=-(pres(i,k,1)+pres(i,k,2)+pgen(i,k)+pisd(i,k))
+!     update
+            q(i,k) = q(i,k)+work2(i,k)*dtcld
+            qci(i,k,1) = max(qci(i,k,1)-(paut(i,k,1)+pacr(i,k,1)   &
+                           +pacr(i,k,3))*dtcld,0.)
+            qrs(i,k,1) = max(qrs(i,k,1)+(paut(i,k,1)+pacr(i,k,1)   &
+                           +pres(i,k,1))*dtcld,0.)
+            qci(i,k,2) = max(qci(i,k,2)-(paut(i,k,2)+pacr(i,k,2)   &
+                           -pgen(i,k)-pisd(i,k))*dtcld,0.)
+            qrs(i,k,2) = max(qrs(i,k,2)+(pres(i,k,2)+paut(i,k,2)   &
+                           +pacr(i,k,2)+pacr(i,k,3))*dtcld,0.)
+            xlf = xls-xl(i,k)
+            xlwork2 = -xls*(pres(i,k,2)+pisd(i,k)+pgen(i,k))       &
+                         -xl(i,k)*pres(i,k,1)                      &
+                         -xlf*pacr(i,k,3)
+            t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld
+          else
+!
+!     cloud water
+!
+            value = max(qcrmin,qci(i,k,1))
+            source=(paut(i,k,1)+pacr(i,k,1)+pacr(i,k,3))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              paut(i,k,1) = paut(i,k,1)*factor
+              pacr(i,k,1) = pacr(i,k,1)*factor
+              pacr(i,k,3) = pacr(i,k,3)*factor
+            endif
+!
+!     snow
+!
+            value = max(qcrmin,qrs(i,k,2))
+            source=(-psev(i,k)-psml(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              psev(i,k) = psev(i,k)*factor
+              psml(i,k) = psml(i,k)*factor
+            endif
+            work2(i,k)=-(pres(i,k,1)+psev(i,k))
+!     update
+            q(i,k) = q(i,k)+work2(i,k)*dtcld
+            qci(i,k,1) = max(qci(i,k,1)-(paut(i,k,1)+pacr(i,k,1)        &
+                    +pacr(i,k,3))*dtcld,0.)
+            qrs(i,k,1) = max(qrs(i,k,1)+(paut(i,k,1)+pacr(i,k,1)        &
+                    +pres(i,k,1) -psml(i,k)+pacr(i,k,3))*dtcld,0.)
+            qrs(i,k,2) = max(qrs(i,k,2)+(psml(i,k)+psev(i,k))*dtcld,0.)
+            xlf = xls-xl(i,k)
+            xlwork2 = -xlf*(psml(i,k))-xl(i,k)*(pres(i,k,1)+psev(i,k))
+            t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld
+          endif
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          qs(i,k,1) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+          qs(i,k,1) = ep2 * qs(i,k,1) / (p(i,k) - qs(i,k,1))
+          qs(i,k,1) = max(qs(i,k,1),qmin)
+          qs(i,k,2) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+          qs(i,k,2) = ep2 * qs(i,k,2) / (p(i,k) - qs(i,k,2))
+          qs(i,k,2) = max(qs(i,k,2),qmin)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     condensational/evaporational rate of cloud water if there exists
+!     additional water vapor condensated/if evaporation of cloud water
+!     is not enough to remove subsaturation.
+!     use fall bariable for this process(pcon)
+!
+!     if(lat.eq.latd) write(iun,603)
+      do k = kts, kte
+        do i = its, ite
+          work1(i,k,1) = conden(t(i,k),q(i,k),qs(i,k,1),xl(i,k),cpm(i,k))
+          work2(i,k) = qci(i,k,1)+work1(i,k,1)
+          pcon(i,k) = min(max(work1(i,k,1)/dtcld,0.),max(q(i,k),0.)/dtcld)
+          if(qci(i,k,1).gt.qcrmin.and.work1(i,k,1).lt.0.and.t(i,k).gt.t0c)    &
+            pcon(i,k) = max(work1(i,k,1),-qci(i,k,1))/dtcld
+          q(i,k) = q(i,k)-pcon(i,k)*dtcld
+          qci(i,k,1) = max(qci(i,k,1)+pcon(i,k)*dtcld,0.)
+          t(i,k) = t(i,k)+pcon(i,k)*xl(i,k)/cpm(i,k)*dtcld
+!
+          if(lat.eq.latd.and.i.eq.lond) then
+            pgens(i,k) = pgens(i,k)+pgen(i,k)
+            pcons(i,k) = pcons(i,k)+pcon(i,k)
+            pisds(i,k) = pisds(i,k)+pisd(i,k)
+            pacrss(i,k) = pacrss(i,k)+pacr(i,k,1)+pacr(i,k,2)+pacr(i,k,3)
+            press(i,k) = press(i,k)+pres(i,k,1)+pres(i,k,2)
+            pauts(i,k) = pauts(i,k)+paut(i,k,1)+paut(i,k,2)
+!           write(iun,604) k,p(i,k)/100.,                                   &
+!             t(i,k)-t0c,t(i,k)-t1(i,k),q(i,k)*1000.,                       &
+!             (q(i,k)-q1(i,k))*1000.,rh(i,k,2)*100.,pgens(i,k)*qdt,         &
+!             pcons(i,k)*qdt,pisds(i,k)*qdt,pauts(i,k)*qdt,pacrss(i,k)*qdt, &
+!             press(i,k)*qdt,qci(i,k,1)*1000.,qrs(i,k,1)*1000.,             &
+!             qci(i,k,2)*1000.,qrs(i,k,2)*1000.
+          endif
+        enddo
+      enddo
+!603   format(1x,'  k','     p',                                             &
+!           '    t',' delt','    q',' delq','   rh',                         &
+!           ' pgen',' pcon',' pisd',' paut',' pacr',' pres',                 &
+!           '   qc','   qr','   qi','   qs')
+!604   format(1x,i3,f6.0,4f5.1,f5.0,10f5.2)
+!
+!----------------------------------------------------------------
+!     compute the fallout term:
+!     first, vertical terminal velosity for minor loops
+!
+      do k = kts, kte
+        do i = its, ite
+          if(qrs(i,k,1).le.qcrmin)then
+            slope(i,k,1) = lamdarmax
+            slopeb(i,k,1) = slope(i,k,1)**bvtr
+          else
+            slope(i,k,1) = lamdar(qrs(i,k,1),den(i,k))
+            slopeb(i,k,1) = slope(i,k,1)**bvtr
+          endif
+          if(qrs(i,k,2).le.qcrmin)then
+            slope(i,k,2) = lamdarmax
+            slopeb(i,k,2) = slope(i,k,2)**bvts
+          else
+            supcol = t0c-t(i,k)
+            n0sfac = min(exp(alpha*supcol),n0smax)
+            slope(i,k,2) = lamdas(qrs(i,k,2),den(i,k),n0sfac)
+            slopeb(i,k,2) = slope(i,k,2)**bvts
+          endif
+          slope2(i,k,1) = slope(i,k,1)*slope(i,k,1)
+          slope2(i,k,2) = slope(i,k,2)*slope(i,k,2)
+        enddo
+      enddo
+!
+      do i = its, ite
+        do k = kte, kts, -1
+          work1(i,k,1) = pvtr/slopeb(i,k,1)*denfac(i,k)/delz(i,k)
+          work1(i,k,2) = pvts/slopeb(i,k,2)*denfac(i,k)/delz(i,k)
+          if(qrs(i,k,1).le.qcrmin) work1(i,k,1) = 0.
+          if(qrs(i,k,2).le.qcrmin) work1(i,k,2) = 0.
+          numdt = max(nint(max(work1(i,k,1),work1(i,k,2))*dtcld+.5),1)
+          if(qci(i,k,2).le.qmin) then
+            work2c(i,k) = 0.
+          else
+            work1c(i,k) = 3.29*(den(i,k)*qci(i,k,2))**0.16
+            work2c(i,k) = work1c(i,k)/delz(i,k)
+          endif
+          numdt = max(nint(work2c(i,k)*dtcld+.5),numdt)
+          if(numdt.ge.mstep(i)) mstep(i) = numdt
+        enddo
+        mstep(i) = min(mstep(i),mstepmax)
+      enddo
+!
+!      if(lat.eq.latd) write(iun,605)
+      do n = 1,mstepmax
+          k = kte
+          do i = its, ite
+            if(n.le.mstep(i)) then
+              falk(i,k,1) = den(i,k)*qrs(i,k,1)*work1(i,k,1)/mstep(i)
+              falk(i,k,2) = den(i,k)*qrs(i,k,2)*work1(i,k,2)/mstep(i)
+              fall(i,k,1) = fall(i,k,1)+falk(i,k,1)
+              fall(i,k,2) = fall(i,k,2)+falk(i,k,2)
+              holdrr = qrs(i,k,1)
+              holdrs = qrs(i,k,2)
+              qrs(i,k,1) = max(qrs(i,k,1)-falk(i,k,1)*dtcld/den(i,k),0.)
+              qrs(i,k,2) = max(qrs(i,k,2)-falk(i,k,2)*dtcld/den(i,k),0.)
+              falkc(i,k) = den(i,k)*qci(i,k,2)*work2c(i,k)/mstep(i)
+              fallc(i,k) = fallc(i,k)+falkc(i,k)
+              qci(i,k,2) = max(qci(i,k,2)-falkc(i,k)*dtcld/den(i,k),0.)
+!
+!              if(lat.eq.latd.and.i.eq.lond)                                        &
+!                write(iun,606) k,p(i,k)/100.,                                      &
+!                t(i,k)-t0c,q(i,k)*1000.,rh(i,k,2)*100.,w(i,k),work1(i,k,1)         &
+!                *delz(i,k), work1(i,k,2)*delz(i,k),holdrr*1000.,holdrs*1000.,      &
+!                qrs(i,k,1)*1000.,qrs(i,k,2)*1000.,n
+            endif
+          enddo
+        do k = kte-1, kts, -1
+          do i = its, ite
+            if(n.le.mstep(i)) then
+              falk(i,k,1) = den(i,k)*qrs(i,k,1)*work1(i,k,1)/mstep(i)
+              falk(i,k,2) = den(i,k)*qrs(i,k,2)*work1(i,k,2)/mstep(i)
+              fall(i,k,1) = fall(i,k,1)+falk(i,k,1)
+              fall(i,k,2) = fall(i,k,2)+falk(i,k,2)
+              holdrr = qrs(i,k,1)
+              holdrs = qrs(i,k,2)
+              qrs(i,k,1) = max(qrs(i,k,1)-(falk(i,k,1)                             &
+                         -falk(i,k+1,1)*delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+              qrs(i,k,2) = max(qrs(i,k,2)-(falk(i,k,2)                             &
+                         -falk(i,k+1,2)*delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+              falkc(i,k) = den(i,k)*qci(i,k,2)*work2c(i,k)/mstep(i)
+              fallc(i,k) = fallc(i,k)+falkc(i,k)
+              qci(i,k,2) = max(qci(i,k,2)-(falkc(i,k)                       &
+                        -falkc(i,k+1)*delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+!
+!              if(lat.eq.latd.and.i.eq.lond)                                        &
+!                write(iun,606) k,p(i,k)/100.,                                      &
+!                t(i,k)-t0c,q(i,k)*1000.,rh(i,k,2)*100.,w(i,k),work1(i,k,1)         &
+!                *delz(i,k), work1(i,k,2)*delz(i,k),holdrr*1000.,holdrs*1000.,      &
+!                qrs(i,k,1)*1000.,qrs(i,k,2)*1000.,n
+            endif
+          enddo
+        enddo
+      enddo
+!605   format(1x,'  k','     p','    t','    q','   rh','     w',                   &
+!            '   vtr','   vts','   qri','   qsi','   qrf','   qsf',' mstep')
+!606   format(1x,i3,f6.0,2f5.1,f5.0,f6.2,6f6.2,i5)
+!
+!----------------------------------------------------------------
+!      rain (unit is mm/sec;kgm-2s-1: /1000*delt ===> m)==> mm for wrf
+!
+      do i = its, ite
+        fallsum = fall(i,1,1)+fall(i,1,2)
+        if(fallsum.gt.0.) then
+          rainncv(i) = fallsum*delz(i,1)/denr*dtcld*1000.
+          rain(i) = fallsum*delz(i,1)/denr*dtcld*1000.        &
+                  + rain(i)
+        endif
+      enddo
+!
+!      if(lat.eq.latd) write(iun,601) latd,lond,loop,rain(lond)
+! 601  format(1x,' ncloud5 lat lon loop : rain(mm) ',3i6,f20.2)
+!
+      enddo                  ! big loops
+
+  END SUBROUTINE ncloud52d
+! ...................................................................
+      REAL FUNCTION rgmma(x)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!     rgmma function:  use infinite product form
+      REAL :: euler
+      PARAMETER (euler=0.577215664901532)
+      REAL :: x, y
+      INTEGER :: i
+
+      if(x.eq.1.)then
+        rgmma=0.
+          else
+        rgmma=x*exp(euler*x)
+        do i=1,10000
+          y=float(i)
+          rgmma=rgmma*(1.000+x/y)*exp(-x/y)
+        enddo
+        rgmma=1./rgmma
+      endif
+      end function rgmma
+!
+!--------------------------------------------------------------------------
+      REAL FUNCTION fpvs(t,ice,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c)
+!--------------------------------------------------------------------------
+      IMPLICIT NONE
+!--------------------------------------------------------------------------
+      REAL t,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c,dldt,xa,xb,dldti, &
+           xai,xbi,ttp,tr
+      INTEGER ice
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      tr=ttp/t
+      if(t.lt.ttp.and.ice.eq.1) then
+        fpvs=psat*(tr**xai)*exp(xbi*(1.-tr))
+      else
+        fpvs=psat*(tr**xa)*exp(xb*(1.-tr))
+      endif
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END FUNCTION fpvs
+
+!-------------------------------------------------------------------
+  SUBROUTINE ncloud5init(den0,denr,dens,cl,cpv,allowed_to_read)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!.... constants which may not be tunable
+
+   real, intent(in) :: den0,denr,dens,cl,cpv
+   logical, intent(in) :: allowed_to_read
+   real :: pi
+
+   pi = 4.*atan(1.)
+   xlv1 = cl-cpv
+
+   qc0  = 4./3.*pi*denr*r0**3*xncr/den0  ! 0.419e-3 -- .61e-3
+   qck1 = .104*9.8*peaut/(xncr*denr)**(1./3.)/xmyu ! 7.03
+   bvtr1 = 1.+bvtr
+   bvtr2 = 2.5+.5*bvtr
+   bvtr3 = 3.+bvtr
+   bvtr4 = 4.+bvtr
+   g1pbr = rgmma(bvtr1)
+   g3pbr = rgmma(bvtr3)
+   g4pbr = rgmma(bvtr4)            ! 17.837825
+   g5pbro2 = rgmma(bvtr2)          ! 1.8273
+   pvtr = avtr*g4pbr/6.
+   eacrr = 1.0
+   pacrr = pi*n0r*avtr*g3pbr*.25*eacrr
+   precr1 = 2.*pi*n0r*.78
+   precr2 = 2.*pi*n0r*.31*avtr**.5*g5pbro2
+   xm0  = (di0/dicon)**2
+   xmmax = (dimax/dicon)**2
+!
+   bvts1 = 1.+bvts
+   bvts2 = 2.5+.5*bvts
+   bvts3 = 3.+bvts
+   bvts4 = 4.+bvts
+   g1pbs = rgmma(bvts1)    !.8875
+   g3pbs = rgmma(bvts3)
+   g4pbs = rgmma(bvts4)    ! 12.0786
+   g5pbso2 = rgmma(bvts2)
+   pvts = avts*g4pbs/6.
+   pacrs = pi*n0s*avts*g3pbs*.25
+   precs1 = 4.*n0s*.65
+   precs2 = 4.*n0s*.44*avts**.5*g5pbso2
+   pidn0r =  pi*denr*n0r
+   pidn0s =  pi*dens*n0s
+!
+   pacrc = pi*n0s*avts*g3pbs*.25*eacrc
+!
+  END SUBROUTINE ncloud5init
+
+END MODULE module_mp_ncloud5
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_mp_thompson.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_mp_thompson.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_mp_thompson.F	(revision 2744)
@@ -0,0 +1,3081 @@
+!+---+-----------------------------------------------------------------+
+!.. This subroutine computes the moisture tendencies of water vapor,
+!.. cloud droplets, rain, cloud ice (pristine), snow, and graupel.
+!.. Previously this code was based on Reisner et al (1998), but few of
+!.. those pieces remain.  A complete description is now found in
+!.. Thompson et al. (2004, 2006).
+!.. Most importantly, users may wish to modify the prescribed number of
+!.. cloud droplets (Nt_c; see guidelines mentioned below).  Otherwise,
+!.. users may alter the rain and graupel size distribution parameters
+!.. to use exponential (Marshal-Palmer) or generalized gamma shape.
+!.. The snow field assumes a combination of two gamma functions (from
+!.. Field et al. 2005) and would require significant modifications
+!.. throughout the entire code to alter its shape as well as accretion
+!.. rates.  Users may also alter the constants used for density of rain,
+!.. graupel, ice, and snow, but the latter is not constant when using
+!.. Paul Field's snow distribution and moments methods.  Other values
+!.. users can modify include the constants for mass and/or velocity
+!.. power law relations and assumed capacitances used in deposition/
+!.. sublimation/evaporation/melting.
+!.. Remaining values should probably be left alone.
+!..
+!..Author: Greg Thompson, NCAR-RAL, gthompsn@ucar.edu, 303-497-2805
+!..Last modified: 26 Oct 2006
+!+---+-----------------------------------------------------------------+
+!wrft:model_layer:physics
+!+---+-----------------------------------------------------------------+
+!
+      MODULE module_mp_thompson
+      USE module_wrf_error
+
+      IMPLICIT NONE
+
+      LOGICAL, PARAMETER, PRIVATE:: iiwarm = .false.
+      INTEGER, PARAMETER, PRIVATE:: IFDRY = 0
+      REAL, PARAMETER, PRIVATE:: T_0 = 273.15
+      REAL, PARAMETER, PRIVATE:: PI = 3.1415926536
+
+!..Densities of rain, snow, graupel, and cloud ice.
+      REAL, PARAMETER, PRIVATE:: rho_w = 1000.0
+      REAL, PARAMETER, PRIVATE:: rho_s = 100.0
+      REAL, PARAMETER, PRIVATE:: rho_g = 400.0
+      REAL, PARAMETER, PRIVATE:: rho_i = 890.0
+
+!..Prescribed number of cloud droplets.  Set according to known data or
+!.. roughly 100 per cc (100.E6 m^-3) for Maritime cases and
+!.. 300 per cc (300.E6 m^-3) for Continental.  Gamma shape parameter,
+!.. mu_c, calculated based on Nt_c is important in autoconversion
+!.. scheme.
+      REAL, PARAMETER, PRIVATE:: Nt_c = 100.E6
+
+!..Generalized gamma distributions for rain, graupel and cloud ice.
+!.. N(D) = N_0 * D**mu * exp(-lamda*D);  mu=0 is exponential.
+      REAL, PARAMETER, PRIVATE:: mu_r = 0.0
+      REAL, PARAMETER, PRIVATE:: mu_g = 0.0
+      REAL, PARAMETER, PRIVATE:: mu_i = 0.0
+      REAL, PRIVATE:: mu_c
+
+!..Sum of two gamma distrib for snow (Field et al. 2005).
+!.. N(D) = M2**4/M3**3 * [Kap0*exp(-M2*Lam0*D/M3)
+!..    + Kap1*(M2/M3)**mu_s * D**mu_s * exp(-M2*Lam1*D/M3)]
+!.. M2 and M3 are the (bm_s)th and (bm_s+1)th moments respectively
+!.. calculated as function of ice water content and temperature.
+      REAL, PARAMETER, PRIVATE:: mu_s = 0.6357
+      REAL, PARAMETER, PRIVATE:: Kap0 = 490.6
+      REAL, PARAMETER, PRIVATE:: Kap1 = 17.46
+      REAL, PARAMETER, PRIVATE:: Lam0 = 20.78
+      REAL, PARAMETER, PRIVATE:: Lam1 = 3.29
+
+!..Y-intercept parameters for rain & graupel.  However, these are not
+!.. constant and vary depending on mixing ratio.  Furthermore, when
+!.. mu is non-zero, these become equiv y-intercept for an exponential
+!.. distrib and proper values computed based on assumed mu value.
+      REAL, PARAMETER, PRIVATE:: gonv_min = 1.E4
+      REAL, PARAMETER, PRIVATE:: gonv_max = 1.E6
+      REAL, PARAMETER, PRIVATE:: ronv_min = 2.E6
+      REAL, PARAMETER, PRIVATE:: ronv_max = 2.E9
+      REAL, PARAMETER, PRIVATE:: ronv_sl  = 1./4.
+      REAL, PARAMETER, PRIVATE:: ronv_r0 = 0.10E-3
+      REAL, PARAMETER, PRIVATE:: ronv_c0 = ronv_sl/ronv_r0
+      REAL, PARAMETER, PRIVATE:: ronv_c1 = (ronv_max-ronv_min)*0.5
+      REAL, PARAMETER, PRIVATE:: ronv_c2 = (ronv_max+ronv_min)*0.5
+
+!..Mass power law relations:  mass = am*D**bm
+!.. Snow from Field et al. (2005), others assume spherical form.
+      REAL, PARAMETER, PRIVATE:: am_r = PI*rho_w/6.0
+      REAL, PARAMETER, PRIVATE:: bm_r = 3.0
+      REAL, PARAMETER, PRIVATE:: am_s = 0.069
+      REAL, PARAMETER, PRIVATE:: bm_s = 2.0
+      REAL, PARAMETER, PRIVATE:: am_g = PI*rho_g/6.0
+      REAL, PARAMETER, PRIVATE:: bm_g = 3.0
+      REAL, PARAMETER, PRIVATE:: am_i = 0.069
+      REAL, PARAMETER, PRIVATE:: bm_i = 2.0
+
+!..Fallspeed power laws relations:  v = (av*D**bv)*exp(-fv*D)
+!.. Rain from Ferrier (1994), ice, snow, and graupel from
+!.. Thompson et al (2006). Coefficient fv is zero for graupel/ice.
+      REAL, PARAMETER, PRIVATE:: av_r = 4854.0
+      REAL, PARAMETER, PRIVATE:: bv_r = 1.0
+      REAL, PARAMETER, PRIVATE:: fv_r = 195.0
+      REAL, PARAMETER, PRIVATE:: av_s = 40.0
+      REAL, PARAMETER, PRIVATE:: bv_s = 0.55
+      REAL, PARAMETER, PRIVATE:: fv_s = 125.0
+      REAL, PARAMETER, PRIVATE:: av_g = 442.0
+      REAL, PARAMETER, PRIVATE:: bv_g = 0.89
+      REAL, PARAMETER, PRIVATE:: av_i = 2247.0
+      REAL, PARAMETER, PRIVATE:: bv_i = 1.0
+
+!..Capacitance of sphere and plates/aggregates: D**3, D**2
+      REAL, PARAMETER, PRIVATE:: C_cube = 0.5
+      REAL, PARAMETER, PRIVATE:: C_sqrd = 0.3
+
+!..Collection efficiencies.  Rain/snow/graupel collection of cloud
+!.. droplets use variables (Ef_rw, Ef_ri, Ef_sw, Ef_gw respectively) and
+!.. get computed elsewhere because they are dependent on stokes
+!.. number.
+      REAL, PARAMETER, PRIVATE:: Ef_si = 0.1
+      REAL, PARAMETER, PRIVATE:: Ef_rs = 0.99
+      REAL, PARAMETER, PRIVATE:: Ef_rg = 0.99
+
+!..Minimum microphys values
+!.. R1 value, 1.E-12, cannot be set lower because of numerical
+!.. problems with Paul Field's moments and should not be set larger
+!.. because of truncation problems in snow/ice growth.
+      REAL, PARAMETER, PRIVATE:: R1 = 1.E-12
+      REAL, PARAMETER, PRIVATE:: R2 = 1.E-8
+      REAL, PARAMETER, PRIVATE:: eps = 1.E-29
+
+!..Constants in Cooper curve relation for cloud ice number.
+      REAL, PARAMETER, PRIVATE:: TNO = 5.0
+      REAL, PARAMETER, PRIVATE:: ATO = 0.304
+
+!..Rho_not used in fallspeed relations (rho_not/rho)**.5 adjustment.
+      REAL, PARAMETER, PRIVATE:: rho_not = 101325.0/(287.05*298.0)
+
+!..Schmidt number
+      REAL, PARAMETER, PRIVATE:: Sc = 0.632
+      REAL, PRIVATE:: Sc3
+
+!..Homogeneous freezing temperature
+      REAL, PARAMETER, PRIVATE:: HGFR = 235.16
+
+!..Water vapor and air gas constants at constant pressure
+      REAL, PARAMETER, PRIVATE:: Rv = 461.5
+      REAL, PARAMETER, PRIVATE:: oRv = 1./Rv
+      REAL, PARAMETER, PRIVATE:: R = 287.04
+      REAL, PARAMETER, PRIVATE:: Cp = 1004.0
+
+!..Enthalpy of sublimation, vaporization, and fusion at 0C.
+      REAL, PARAMETER, PRIVATE:: lsub = 2.834E6
+      REAL, PARAMETER, PRIVATE:: lvap0 = 2.5E6
+      REAL, PARAMETER, PRIVATE:: lfus = lsub - lvap0
+      REAL, PARAMETER, PRIVATE:: olfus = 1./lfus
+
+!..Ice initiates with this mass (kg), corresponding diameter calc.
+!..Min diameters and mass of cloud, rain, snow, and graupel (m, kg).
+      REAL, PARAMETER, PRIVATE:: xm0i = 1.E-12
+      REAL, PARAMETER, PRIVATE:: D0c = 1.E-6
+      REAL, PARAMETER, PRIVATE:: D0r = 50.E-6
+      REAL, PARAMETER, PRIVATE:: D0s = 125.E-6
+      REAL, PARAMETER, PRIVATE:: D0g = 150.E-6
+      REAL, PRIVATE:: D0i, xm0s, xm0g
+
+!..Lookup table dimensions
+      INTEGER, PARAMETER, PRIVATE:: ntb_c = 37
+      INTEGER, PARAMETER, PRIVATE:: ntb_i = 64
+      INTEGER, PARAMETER, PRIVATE:: ntb_r = 28
+      INTEGER, PARAMETER, PRIVATE:: ntb_s = 28
+      INTEGER, PARAMETER, PRIVATE:: ntb_g = 28
+      INTEGER, PARAMETER, PRIVATE:: ntb_r1 = 37
+      INTEGER, PARAMETER, PRIVATE:: ntb_i1 = 55
+      INTEGER, PARAMETER, PRIVATE:: ntb_t = 9
+      INTEGER, PRIVATE:: nic2, nii2, nii3, nir2, nir3, nis2, nig2
+
+!..Lookup tables for cloud water content (kg/m**3).
+      REAL, DIMENSION(ntb_c), PARAMETER, PRIVATE:: &
+      r_c = (/1.e-6,2.e-6,3.e-6,4.e-6,5.e-6,6.e-6,7.e-6,8.e-6,9.e-6, &
+              1.e-5,2.e-5,3.e-5,4.e-5,5.e-5,6.e-5,7.e-5,8.e-5,9.e-5, &
+              1.e-4,2.e-4,3.e-4,4.e-4,5.e-4,6.e-4,7.e-4,8.e-4,9.e-4, &
+              1.e-3,2.e-3,3.e-3,4.e-3,5.e-3,6.e-3,7.e-3,8.e-3,9.e-3, &
+              1.e-2/)
+
+!..Lookup tables for cloud ice content (kg/m**3).
+      REAL, DIMENSION(ntb_i), PARAMETER, PRIVATE:: &
+      r_i = (/1.e-10,2.e-10,3.e-10,4.e-10, &
+              5.e-10,6.e-10,7.e-10,8.e-10,9.e-10, &
+              1.e-9,2.e-9,3.e-9,4.e-9,5.e-9,6.e-9,7.e-9,8.e-9,9.e-9, &
+              1.e-8,2.e-8,3.e-8,4.e-8,5.e-8,6.e-8,7.e-8,8.e-8,9.e-8, &
+              1.e-7,2.e-7,3.e-7,4.e-7,5.e-7,6.e-7,7.e-7,8.e-7,9.e-7, &
+              1.e-6,2.e-6,3.e-6,4.e-6,5.e-6,6.e-6,7.e-6,8.e-6,9.e-6, &
+              1.e-5,2.e-5,3.e-5,4.e-5,5.e-5,6.e-5,7.e-5,8.e-5,9.e-5, &
+              1.e-4,2.e-4,3.e-4,4.e-4,5.e-4,6.e-4,7.e-4,8.e-4,9.e-4, &
+              1.e-3/)
+
+!..Lookup tables for rain content (kg/m**3).
+      REAL, DIMENSION(ntb_r), PARAMETER, PRIVATE:: &
+      r_r = (/1.e-5,2.e-5,3.e-5,4.e-5,5.e-5,6.e-5,7.e-5,8.e-5,9.e-5, &
+              1.e-4,2.e-4,3.e-4,4.e-4,5.e-4,6.e-4,7.e-4,8.e-4,9.e-4, &
+              1.e-3,2.e-3,3.e-3,4.e-3,5.e-3,6.e-3,7.e-3,8.e-3,9.e-3, &
+              1.e-2/)
+
+!..Lookup tables for graupel content (kg/m**3).
+      REAL, DIMENSION(ntb_g), PARAMETER, PRIVATE:: &
+      r_g = (/1.e-5,2.e-5,3.e-5,4.e-5,5.e-5,6.e-5,7.e-5,8.e-5,9.e-5, &
+              1.e-4,2.e-4,3.e-4,4.e-4,5.e-4,6.e-4,7.e-4,8.e-4,9.e-4, &
+              1.e-3,2.e-3,3.e-3,4.e-3,5.e-3,6.e-3,7.e-3,8.e-3,9.e-3, &
+              1.e-2/)
+
+!..Lookup tables for snow content (kg/m**3).
+      REAL, DIMENSION(ntb_s), PARAMETER, PRIVATE:: &
+      r_s = (/1.e-5,2.e-5,3.e-5,4.e-5,5.e-5,6.e-5,7.e-5,8.e-5,9.e-5, &
+              1.e-4,2.e-4,3.e-4,4.e-4,5.e-4,6.e-4,7.e-4,8.e-4,9.e-4, &
+              1.e-3,2.e-3,3.e-3,4.e-3,5.e-3,6.e-3,7.e-3,8.e-3,9.e-3, &
+              1.e-2/)
+
+!..Lookup tables for rain y-intercept parameter (/m**4).
+      REAL, DIMENSION(ntb_r1), PARAMETER, PRIVATE:: &
+      N0r_exp = (/1.e6,2.e6,3.e6,4.e6,5.e6,6.e6,7.e6,8.e6,9.e6, &
+                  1.e7,2.e7,3.e7,4.e7,5.e7,6.e7,7.e7,8.e7,9.e7, &
+                  1.e8,2.e8,3.e8,4.e8,5.e8,6.e8,7.e8,8.e8,9.e8, &
+                  1.e9,2.e9,3.e9,4.e9,5.e9,6.e9,7.e9,8.e9,9.e9, &
+                  1.e10/)
+
+!..Lookup tables for ice number concentration (/m**3).
+      REAL, DIMENSION(ntb_i1), PARAMETER, PRIVATE:: &
+      Nt_i = (/1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0, &
+               1.e1,2.e1,3.e1,4.e1,5.e1,6.e1,7.e1,8.e1,9.e1, &
+               1.e2,2.e2,3.e2,4.e2,5.e2,6.e2,7.e2,8.e2,9.e2, &
+               1.e3,2.e3,3.e3,4.e3,5.e3,6.e3,7.e3,8.e3,9.e3, &
+               1.e4,2.e4,3.e4,4.e4,5.e4,6.e4,7.e4,8.e4,9.e4, &
+               1.e5,2.e5,3.e5,4.e5,5.e5,6.e5,7.e5,8.e5,9.e5, &
+               1.e6/)
+
+!..For snow moments conversions (from Field et al. 2005)
+      REAL, DIMENSION(10), PARAMETER, PRIVATE:: &
+      sa = (/ 5.065339, -0.062659, -3.032362, 0.029469, -0.000285, &
+              0.31255,   0.000204,  0.003199, 0.0,      -0.015952/)
+      REAL, DIMENSION(10), PARAMETER, PRIVATE:: &
+      sb = (/ 0.476221, -0.015896,  0.165977, 0.007468, -0.000141, &
+              0.060366,  0.000079,  0.000594, 0.0,      -0.003577/)
+      
+!..Lookup table for A1 and A2 in Bergeron process (Koenig 1971)
+      REAL, DIMENSION(31), PARAMETER, PRIVATE:: &
+      ABER1 = (/.7939E-07,.7841E-06,.3369E-05,.4336E-05, &
+                .5285E-05,.3728E-05,.1852E-05,.2991E-06,.4248E-06, &
+                .7434E-06,.1812E-05,.4394E-05,.9145E-05,.1725E-04, &
+                .3348E-04,.1725E-04,.9175E-05,.4412E-05,.2252E-05, &
+                .9115E-06,.4876E-06,.3473E-06,.4758E-06,.6306E-06, &
+                .8573E-06,.7868E-06,.7192E-06,.6513E-06,.5956E-06, &
+                .5333E-06,.4834E-06/)
+      REAL, DIMENSION(31), PARAMETER, PRIVATE:: &
+      ABER2 = (/.4006,.4831,.5320,.5307,.5319,.5249, &
+                .4888,.3894,.4047,.4318,.4771,.5183,.5463,.5651, &
+                .5813,.5655,.5478,.5203,.4906,.4447,.4126,.3960, &
+                .4149,.4320,.4506,.4483,.4460,.4433,.4413,.4382, &
+                .4361/)
+      REAL, DIMENSION(31), PRIVATE:: CBG
+
+!..Temperatures (5 C interval 0 to -40) used in lookup tables.
+      REAL, DIMENSION(ntb_t), PARAMETER, PRIVATE:: &
+      Tc = (/-0.01, -5., -10., -15., -20., -25., -30., -35., -40./)
+
+!..Lookup tables for various accretion/collection terms.
+!.. ntb_x refers to the number of elements for rain, snow, graupel,
+!.. and temperature array indices.  Variables beginning with tp/tc/tm
+!.. represent lookup tables.
+      DOUBLE PRECISION, DIMENSION(ntb_g,ntb_r1,ntb_r):: &
+                tcg_racg, tmr_racg, tcr_gacr, tmg_gacr
+      DOUBLE PRECISION, DIMENSION(ntb_s,ntb_t,ntb_r1,ntb_r):: &
+                tcs_racs1, tmr_racs1, tcs_racs2, tmr_racs2, &
+                tcr_sacr1, tms_sacr1, tcr_sacr2, tms_sacr2
+      DOUBLE PRECISION, DIMENSION(ntb_c,45):: &
+                tpi_qcfz, tni_qcfz
+      DOUBLE PRECISION, DIMENSION(ntb_r,ntb_r1,45):: &
+                tpi_qrfz, tpg_qrfz, tni_qrfz
+      DOUBLE PRECISION, DIMENSION(ntb_i,ntb_i1):: &
+                tps_iaus, tni_iaus, tpi_ide
+
+!..Variables holding a bunch of exponents and gamma values (cloud water,
+!.. cloud ice, rain, snow, then graupel).
+      REAL, DIMENSION(3), PRIVATE:: cce, ccg
+      REAL, PRIVATE::  ocg1, ocg2
+      REAL, DIMENSION(6), PRIVATE:: cie, cig
+      REAL, PRIVATE:: oig1, oig2, obmi
+      REAL, DIMENSION(12), PRIVATE:: cre, crg
+      REAL, PRIVATE:: ore1, org1, org2, org3, obmr
+      REAL, DIMENSION(18), PRIVATE:: cse, csg
+      REAL, PRIVATE:: oams, obms
+      REAL, DIMENSION(12), PRIVATE:: cge, cgg
+      REAL, PRIVATE:: oge1, ogg1, ogg2, ogg3, obmg
+
+!..Declaration of precomputed constants in various rate eqns.
+      REAL:: t1_qr_qc, t1_qr_qi, t2_qr_qi, t1_qg_qc, t1_qs_qc, t1_qs_qi
+      REAL:: t1_qr_ev, t2_qr_ev
+      REAL:: t1_qs_sd, t2_qs_sd, t1_qg_sd, t2_qg_sd
+      REAL:: t1_qs_me, t2_qs_me, t1_qg_me, t2_qg_me
+
+!+---+
+!+---+-----------------------------------------------------------------+
+!..END DECLARATIONS
+!+---+-----------------------------------------------------------------+
+!+---+
+!
+
+
+      CONTAINS
+
+      SUBROUTINE thompson_init
+
+      IMPLICIT NONE
+
+      INTEGER:: i, j, k, m, n
+
+!..From Martin et al. (1994), assign gamma shape parameter mu for cloud
+!.. drops according to general dispersion characteristics (disp=~0.25
+!.. for Maritime and 0.45 for Continental).
+!.. disp=SQRT((mu+2)/(mu+1) - 1) so mu varies from 15 for Maritime
+!.. to 2 for really dirty air.
+      mu_c = AMIN1(15., (1000.E6/Nt_c + 2.))
+
+!..Schmidt number to one-third used numerous times.
+      Sc3 = Sc**(1./3.)
+
+!..Compute min ice diam from mass, min snow/graupel mass from diam.
+      D0i = (xm0i/am_i)**(1./bm_i)
+      xm0s = am_s * D0s**bm_s
+      xm0g = am_g * D0g**bm_g
+
+!..These constants various exponents and gamma() assoc with cloud,
+!.. rain, snow, and graupel.
+      cce(1) = mu_c + 1.
+      cce(2) = bm_r + mu_c + 1.
+      cce(3) = bm_r + mu_c + 4.
+      ccg(1) = WGAMMA(cce(1))
+      ccg(2) = WGAMMA(cce(2))
+      ccg(3) = WGAMMA(cce(3))
+      ocg1 = 1./ccg(1)
+      ocg2 = 1./ccg(2)
+
+      cie(1) = mu_i + 1.
+      cie(2) = bm_i + mu_i + 1.
+      cie(3) = bm_i + mu_i + bv_i + 1.
+      cie(4) = mu_i + bv_i + 1.
+      cie(5) = mu_i + 2.
+      cie(6) = bm_i + bv_i
+      cig(1) = WGAMMA(cie(1))
+      cig(2) = WGAMMA(cie(2))
+      cig(3) = WGAMMA(cie(3))
+      cig(4) = WGAMMA(cie(4))
+      cig(5) = WGAMMA(cie(5))
+      cig(6) = WGAMMA(cie(6))
+      oig1 = 1./cig(1)
+      oig2 = 1./cig(2)
+      obmi = 1./bm_i
+
+      do n = 1, 31
+         CBG(n) = WGAMMA(mu_i + 1 + ABER2(n)*bm_i)
+      enddo
+
+      cre(1) = bm_r + 1.
+      cre(2) = mu_r + 1.
+      cre(3) = bm_r + mu_r + 1.
+      cre(4) = bm_r + mu_r + 2.
+      cre(5) = bm_r + mu_r + 3.
+      cre(6) = bm_r + mu_r + bv_r + 1.
+      cre(7) = bm_r + mu_r + bv_r + 2.
+      cre(8) = bm_r + mu_r + bv_r + 3.
+      cre(9) = mu_r + bv_r + 3.
+      cre(10) = mu_r + 2.
+      cre(11) = 0.5*(bv_r + 5. + 2.*mu_r)
+      cre(12) = bm_r + mu_r + 4.
+      do n = 1, 12
+         crg(n) = WGAMMA(cre(n))
+      enddo
+      obmr = 1./bm_r
+      ore1 = 1./cre(1)
+      org1 = 1./crg(1)
+      org2 = 1./crg(2)
+      org3 = 1./crg(3)
+
+      cse(1) = bm_s + 1.
+      cse(2) = bm_s + 2.
+      cse(3) = bm_s + 3.
+      cse(4) = bm_s + bv_s + 1.
+      cse(5) = bm_s + bv_s + 2.
+      cse(6) = bm_s + bv_s + 3.
+      cse(7) = bm_s + mu_s + 1.
+      cse(8) = bm_s + mu_s + 2.
+      cse(9) = bm_s + mu_s + 3.
+      cse(10) = bm_s + mu_s + bv_s + 1.
+      cse(11) = bm_s + mu_s + bv_s + 2.
+      cse(12) = bm_s + mu_s + bv_s + 3.
+      cse(13) = bv_s + 2.
+      cse(14) = bm_s + bv_s
+      cse(15) = bm_s - 1.
+      cse(16) = 1.0 + (1.0 + bv_s)/2.
+      cse(17) = bv_s + 3.
+      cse(18) = bv_s + mu_s + 3.
+      do n = 1, 18
+         csg(n) = WGAMMA(cse(n))
+      enddo
+      oams = 1./am_s
+      obms = 1./bm_s
+!      sg_lam = csg(2) / csg(1)
+!      sg_nos = csg(2)**cse(1) / csg(1)**cse(2)
+
+      cge(1) = bm_g + 1.
+      cge(2) = mu_g + 1.
+      cge(3) = bm_g + mu_g + 1.
+      cge(4) = bm_g + mu_g + 2.
+      cge(5) = bm_g + mu_g + 3.
+      cge(6) = bm_g + mu_g + bv_g + 1.
+      cge(7) = bm_g + mu_g + bv_g + 2.
+      cge(8) = bm_g + mu_g + bv_g + 3.
+      cge(9) = mu_g + bv_g + 3.
+      cge(10) = mu_g + 2.
+      cge(11) = 0.5*(bv_g + 5. + 2.*mu_g)
+      cge(12) = 0.5*(bv_g + 5.) + mu_g
+      do n = 1, 12
+         cgg(n) = WGAMMA(cge(n))
+      enddo
+      obmg = 1./bm_g
+      oge1 = 1./cge(1)
+      ogg1 = 1./cgg(1)
+      ogg2 = 1./cgg(2)
+      ogg3 = 1./cgg(3)
+
+!+---+-----------------------------------------------------------------+
+!..Simplify various rate eqns the best we can now.
+!+---+-----------------------------------------------------------------+
+
+!..Rain collecting cloud water and cloud ice
+      t1_qr_qc = PI*.25*av_r * crg(9)
+      t1_qr_qi = PI*.25*av_r * crg(9)
+      t2_qr_qi = PI*.25*am_r*av_r * crg(8)
+
+!..Graupel collecting cloud water
+      t1_qg_qc = PI*.25*av_g * cgg(9)
+
+!..Snow collecting cloud water
+      t1_qs_qc = PI*.25*av_s
+
+!..Snow collecting cloud ice
+      t1_qs_qi = PI*.25*av_s
+
+!..Evaporation of rain; ignore depositional growth of rain.
+      t1_qr_ev = 0.78 * crg(10)
+      t2_qr_ev = 0.308*Sc3*SQRT(av_r) * crg(11)
+
+!..Sublimation/depositional growth of snow
+      t1_qs_sd = 0.86
+      t2_qs_sd = 0.28*Sc3*SQRT(av_s)
+
+!..Melting of snow
+      t1_qs_me = PI*4.*C_sqrd*olfus * 0.86
+      t2_qs_me = PI*4.*C_sqrd*olfus * 0.28*Sc3*SQRT(av_s)
+
+!..Sublimation/depositional growth of graupel
+      t1_qg_sd = 0.86 * cgg(10)
+      t2_qg_sd = 0.28*Sc3*SQRT(av_g) * cgg(11)
+
+!..Melting of graupel
+      t1_qg_me = PI*4.*C_cube*olfus * 0.86 * cgg(10)
+      t2_qg_me = PI*4.*C_cube*olfus * 0.28*Sc3*SQRT(av_g) * cgg(11)
+
+!..Constants for helping find lookup table indexes.
+      nic2 = NINT(ALOG10(r_c(1)))
+      nii2 = NINT(ALOG10(r_i(1)))
+      nii3 = NINT(ALOG10(Nt_i(1)))
+      nir2 = NINT(ALOG10(r_r(1)))
+      nir3 = NINT(ALOG10(N0r_exp(1)))
+      nis2 = NINT(ALOG10(r_s(1)))
+      nig2 = NINT(ALOG10(r_g(1)))
+
+!+---+-----------------------------------------------------------------+
+!..Create lookup tables for most costly calculations.
+!+---+-----------------------------------------------------------------+
+
+      do k = 1, ntb_r
+         do j = 1, ntb_r1
+            do i = 1, ntb_g
+               tcg_racg(i,j,k) = 0.0d0
+               tmr_racg(i,j,k) = 0.0d0
+               tcr_gacr(i,j,k) = 0.0d0
+               tmg_gacr(i,j,k) = 0.0d0
+            enddo
+         enddo
+      enddo
+
+      do m = 1, ntb_r
+         do k = 1, ntb_r1
+            do j = 1, ntb_t
+               do i = 1, ntb_s
+                  tcs_racs1(i,j,k,m) = 0.0d0
+                  tmr_racs1(i,j,k,m) = 0.0d0
+                  tcs_racs2(i,j,k,m) = 0.0d0
+                  tmr_racs2(i,j,k,m) = 0.0d0
+                  tcr_sacr1(i,j,k,m) = 0.0d0
+                  tms_sacr1(i,j,k,m) = 0.0d0
+                  tcr_sacr2(i,j,k,m) = 0.0d0
+                  tms_sacr2(i,j,k,m) = 0.0d0
+               enddo
+            enddo
+         enddo
+      enddo
+
+      do k = 1, 45
+         do j = 1, ntb_r1
+            do i = 1, ntb_r
+               tpi_qrfz(i,j,k) = 0.0d0
+               tni_qrfz(i,j,k) = 0.0d0
+               tpg_qrfz(i,j,k) = 0.0d0
+            enddo
+         enddo
+         do i = 1, ntb_c
+            tpi_qcfz(i,k) = 0.0d0
+            tni_qcfz(i,k) = 0.0d0
+         enddo
+      enddo
+
+      do j = 1, ntb_i1
+         do i = 1, ntb_i
+            tps_iaus(i,j) = 0.0d0
+            tni_iaus(i,j) = 0.0d0
+            tpi_ide(i,j) = 0.0d0
+         enddo
+      enddo
+
+      if (.not. iiwarm) then
+      CALL wrf_debug(150, 'CREATING MICROPHYSICS LOOKUP TABLES ... ')
+      WRITE (wrf_err_message, '(a, f5.2, a, f5.2, a, f5.2, a, f5.2)') &
+          ' using: mu_c=',mu_c,' mu_i=',mu_i,' mu_r=',mu_r,' mu_g=',mu_g
+      CALL wrf_debug(150, wrf_err_message)
+
+!..Rain collecting graupel & graupel collecting rain.
+      CALL wrf_debug(200, '  creating rain collecting graupel table')
+      call qr_acr_qg
+
+!..Rain collecting snow & snow collecting rain.
+      CALL wrf_debug(200, '  creating rain collecting snow table')
+      call qr_acr_qs
+
+!..Cloud water and rain freezing (Bigg, 1953).
+      CALL wrf_debug(200, '  creating freezing of water drops table')
+      call freezeH2O
+
+!..Conversion of some ice mass into snow category.
+      CALL wrf_debug(200, '  creating ice converting to snow table')
+      call qi_aut_qs
+
+      CALL wrf_debug(150, ' ... DONE microphysical lookup tables')
+      endif
+
+      END SUBROUTINE thompson_init
+!+---+-----------------------------------------------------------------+
+!
+
+!+---+-----------------------------------------------------------------+
+!..This is a wrapper routine designed to transfer values from 3D to 1D.
+!+---+-----------------------------------------------------------------+
+      SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, &
+                              th, pii, p, dz, dt_in, itimestep, &
+                              RAINNC, RAINNCV, SR, &
+                              ids,ide, jds,jde, kds,kde, &             ! domain dims
+                              ims,ime, jms,jme, kms,kme, &             ! memory dims
+                              its,ite, jts,jte, kts,kte)               ! tile dims
+
+      implicit none
+
+!..Subroutine arguments
+      INTEGER, INTENT(IN):: ids,ide, jds,jde, kds,kde, &
+                            ims,ime, jms,jme, kms,kme, &
+                            its,ite, jts,jte, kts,kte
+      REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
+                          qv, qc, qr, qi, qs, qg, ni, th
+      REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN):: &
+                          pii, p, dz
+      REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: &
+                          RAINNC, RAINNCV, SR
+      REAL, INTENT(IN):: dt_in
+      INTEGER, INTENT(IN):: itimestep
+
+!..Local variables
+      REAL, DIMENSION(kts:kte):: &
+                          qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, &
+                          t1d, p1d, dz1d
+      REAL, DIMENSION(its:ite, jts:jte):: pcp_ra, pcp_sn, pcp_gr, pcp_ic
+      REAL:: dt, pptrain, pptsnow, pptgraul, pptice
+      REAL:: qc_max, qr_max, qs_max, qi_max, qg_max, ni_max
+      INTEGER:: i, j, k
+      INTEGER:: imax_qc, imax_qr, imax_qi, imax_qs, imax_qg, imax_ni
+      INTEGER:: jmax_qc, jmax_qr, jmax_qi, jmax_qs, jmax_qg, jmax_ni
+      INTEGER:: kmax_qc, kmax_qr, kmax_qi, kmax_qs, kmax_qg, kmax_ni
+      CHARACTER*256:: mp_debug
+
+!+---+
+
+      dt = dt_in
+   
+      qc_max = 0.
+      qr_max = 0.
+      qs_max = 0.
+      qi_max = 0.
+      qg_max = 0
+      ni_max = 0.
+      imax_qc = 0
+      imax_qr = 0
+      imax_qi = 0
+      imax_qs = 0
+      imax_qg = 0
+      imax_ni = 0
+      jmax_qc = 0
+      jmax_qr = 0
+      jmax_qi = 0
+      jmax_qs = 0
+      jmax_qg = 0
+      jmax_ni = 0
+      kmax_qc = 0
+      kmax_qr = 0
+      kmax_qi = 0
+      kmax_qs = 0
+      kmax_qg = 0
+      kmax_ni = 0
+      do i = 1, 256
+         mp_debug(i:i) = char(0)
+      enddo
+  
+      j_loop:  do j = jts, jte
+      i_loop:  do i = its, ite   
+
+         pptrain = 0.
+         pptsnow = 0.
+         pptgraul = 0.
+         pptice = 0.
+         RAINNCV(i,j) = 0.
+         SR(i,j) = 0.
+
+         do k = kts, kte
+            t1d(k) = th(i,k,j)*pii(i,k,j)
+            p1d(k) = p(i,k,j)
+            dz1d(k) = dz(i,k,j)
+            qv1d(k) = qv(i,k,j)
+            qc1d(k) = qc(i,k,j)
+            qi1d(k) = qi(i,k,j)
+            qr1d(k) = qr(i,k,j)
+            qs1d(k) = qs(i,k,j)
+            qg1d(k) = qg(i,k,j)
+            ni1d(k) = ni(i,k,j)
+         enddo
+
+         call mp_thompson(qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, &
+                      t1d, p1d, dz1d, &
+                      pptrain, pptsnow, pptgraul, pptice, &
+                      kts, kte, dt, i, j)
+
+         pcp_ra(i,j) = pptrain
+         pcp_sn(i,j) = pptsnow
+         pcp_gr(i,j) = pptgraul
+         pcp_ic(i,j) = pptice
+         RAINNCV(i,j) = pptrain + pptsnow + pptgraul + pptice
+         RAINNC(i,j) = RAINNC(i,j) + pptrain + pptsnow + pptgraul + pptice
+         SR(i,j) = (pptsnow + pptgraul + pptice)/(RAINNCV(i,j)+1.e-12)
+
+         do k = kts, kte
+            qv(i,k,j) = qv1d(k)
+            qc(i,k,j) = qc1d(k)
+            qi(i,k,j) = qi1d(k)
+            qr(i,k,j) = qr1d(k)
+            qs(i,k,j) = qs1d(k)
+            qg(i,k,j) = qg1d(k)
+            ni(i,k,j) = ni1d(k)
+            th(i,k,j) = t1d(k)/pii(i,k,j)
+            if (qc1d(k) .gt. qc_max) then
+             imax_qc = i
+             jmax_qc = j
+             kmax_qc = k
+             qc_max = qc1d(k)
+            elseif (qc1d(k) .lt. 0.0) then
+             write(mp_debug,*) 'WARNING, negative qc ', qc1d(k),        &
+                        ' at i,j,k=', i,j,k
+             CALL wrf_debug(150, mp_debug)
+            endif
+            if (qr1d(k) .gt. qr_max) then
+             imax_qr = i
+             jmax_qr = j
+             kmax_qr = k
+             qr_max = qr1d(k)
+            elseif (qr1d(k) .lt. 0.0) then
+             write(mp_debug,*) 'WARNING, negative qr ', qr1d(k),        &
+                        ' at i,j,k=', i,j,k
+             CALL wrf_debug(150, mp_debug)
+            endif
+            if (qs1d(k) .gt. qs_max) then
+             imax_qs = i
+             jmax_qs = j
+             kmax_qs = k
+             qs_max = qs1d(k)
+            elseif (qs1d(k) .lt. 0.0) then
+             write(mp_debug,*) 'WARNING, negative qs ', qs1d(k),        &
+                        ' at i,j,k=', i,j,k
+             CALL wrf_debug(150, mp_debug)
+            endif
+            if (qi1d(k) .gt. qi_max) then
+             imax_qi = i
+             jmax_qi = j
+             kmax_qi = k
+             qi_max = qi1d(k)
+            elseif (qi1d(k) .lt. 0.0) then
+             write(mp_debug,*) 'WARNING, negative qi ', qi1d(k),        &
+                        ' at i,j,k=', i,j,k
+             CALL wrf_debug(150, mp_debug)
+            endif
+            if (qg1d(k) .gt. qg_max) then
+             imax_qg = i
+             jmax_qg = j
+             kmax_qg = k
+             qg_max = qg1d(k)
+            elseif (qg1d(k) .lt. 0.0) then
+             write(mp_debug,*) 'WARNING, negative qg ', qg1d(k),        &
+                        ' at i,j,k=', i,j,k
+             CALL wrf_debug(150, mp_debug)
+            endif
+            if (ni1d(k) .gt. ni_max) then
+             imax_ni = i
+             jmax_ni = j
+             kmax_ni = k
+             ni_max = ni1d(k)
+            elseif (ni1d(k) .lt. 0.0) then
+             write(mp_debug,*) 'WARNING, negative ni ', ni1d(k),        &
+                        ' at i,j,k=', i,j,k
+             CALL wrf_debug(150, mp_debug)
+            endif
+         enddo
+
+      enddo i_loop
+      enddo j_loop
+
+! DEBUG - GT
+      write(mp_debug,'(a,6(a,e13.6,1x,a,i3,a,i3,a,i3,a,1x))') 'MP-GT:', &
+         'qc: ', qc_max, '(', imax_qc, ',', jmax_qc, ',', kmax_qc, ')', &
+         'qr: ', qr_max, '(', imax_qr, ',', jmax_qr, ',', kmax_qr, ')', &
+         'qi: ', qi_max, '(', imax_qi, ',', jmax_qi, ',', kmax_qi, ')', &
+         'qs: ', qs_max, '(', imax_qs, ',', jmax_qs, ',', kmax_qs, ')', &
+         'qg: ', qg_max, '(', imax_qg, ',', jmax_qg, ',', kmax_qg, ')', &
+         'ni: ', ni_max, '(', imax_ni, ',', jmax_ni, ',', kmax_ni, ')'
+      CALL wrf_debug(150, mp_debug)
+! END DEBUG - GT
+
+      END SUBROUTINE mp_gt_driver
+
+!+---+-----------------------------------------------------------------+
+!
+
+!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+
+!.. This subroutine computes the moisture tendencies of water vapor,
+!.. cloud droplets, rain, cloud ice (pristine), snow, and graupel.
+!.. Previously this code was based on Reisner et al (1998), but few of
+!.. those pieces remain.  A complete description is now found in
+!.. Thompson et al. (2004, 2006).
+!+---+-----------------------------------------------------------------+
+!
+      subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, &
+                          t1d, p1d, dzq, &
+                          pptrain, pptsnow, pptgraul, pptice, &
+                          kts, kte, dt, ii, jj)
+
+      implicit none
+
+!..Sub arguments
+      INTEGER, INTENT(IN):: kts, kte, ii, jj
+      REAL, DIMENSION(kts:kte), INTENT(INOUT):: &
+                          qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, &
+                          t1d, p1d
+      REAL, DIMENSION(kts:kte), INTENT(IN):: dzq
+      REAL, INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice
+      REAL, INTENT(IN):: dt
+
+!..Local variables
+      REAL, DIMENSION(kts:kte):: tten, qvten, qcten, qiten, &
+           qrten, qsten, qgten, niten
+
+      REAL, DIMENSION(kts:kte):: prw_vcd
+
+      REAL, DIMENSION(kts:kte):: prr_wau, prr_rcw, prr_rcs, &
+           prr_rcg, prr_sml, prr_gml, &
+           prr_rci, prv_rev
+
+      REAL, DIMENSION(kts:kte):: pri_inu, pni_inu, pri_ihm, &
+           pni_ihm, pri_wfz, pni_wfz, &
+           pri_rfz, pni_rfz, pri_ide, &
+           pni_ide, pri_rci, pni_rci, &
+           pni_sci, pni_iau
+
+      REAL, DIMENSION(kts:kte):: prs_iau, prs_sci, prs_rcs, &
+           prs_scw, prs_sde, prs_ihm, &
+           prs_ide
+
+      REAL, DIMENSION(kts:kte):: prg_scw, prg_rfz, prg_gde, &
+           prg_gcw, prg_rci, prg_rcs, &
+           prg_rcg, prg_ihm
+
+      REAL, DIMENSION(kts:kte):: temp, pres, qv
+      REAL, DIMENSION(kts:kte):: rc, ri, rr, rs, rg, ni
+      REAL, DIMENSION(kts:kte):: rho, rhof, rhof2
+      REAL, DIMENSION(kts:kte):: qvs, qvsi
+      REAL, DIMENSION(kts:kte):: satw, sati, ssatw, ssati
+      REAL, DIMENSION(kts:kte):: diffu, visco, vsc2, &
+           tcond, lvap, ocp, lvt2
+
+      REAL, DIMENSION(kts:kte):: ilamr, ilamg, N0_r, N0_g
+      REAL, DIMENSION(kts:kte):: mvd_r, mvd_c
+      REAL, DIMENSION(kts:kte):: smob, smo2, smo1, &
+           smoc, smod, smoe, smof
+
+      REAL, DIMENSION(kts:kte):: sed_r, sed_s, sed_g, sed_i, sed_n
+
+      REAL:: rgvm, delta_tp, orho, onstep, lfus2
+      REAL:: N0_exp, N0_min, lam_exp, lamc, lamr, lamg
+      REAL:: lami, ilami
+      REAL:: Dc, Dc_b, Dc_g, Di, Dr, Ds, Dg, Ds_m, Dg_m
+      REAL:: zeta1, zeta, taud, tau
+      REAL:: stoke_r, stoke_s, stoke_g, stoke_i
+      REAL:: vti, vtr, vts, vtg
+      REAL, DIMENSION(kts:kte+1):: vtik, vtnk, vtrk, vtsk, vtgk
+      REAL, DIMENSION(kts:kte):: vts_boost
+      REAL:: Mrat, ils1, ils2, t1_vts, t2_vts, t3_vts, t4_vts, C_snow
+      REAL:: a_, b_, loga_, A1, A2, tf
+      REAL:: tempc, tc0, r_mvd1, r_mvd2, xkrat
+      REAL:: xnc, xri, xni, xmi, oxmi, xrc
+      REAL:: xsat, rate_max, sump, ratio
+      REAL:: clap, fcd, dfcd
+      REAL:: otemp, rvs, rvs_p, rvs_pp, gamsc, alphsc, t1_evap, t1_subl
+      REAL:: r_frac, g_frac
+      REAL:: Ef_rw, Ef_ri, Ef_sw, Ef_gw
+      REAL:: dts, odts, odt, odzq
+      INTEGER:: i, k, k2, ksed1, ku, n, nn, nstep, k_0, kbot, IT, iexfrq
+      INTEGER:: nir, nis, nig, nii, nic
+      INTEGER:: idx_tc,idx_t,idx_s,idx_g,idx_r1,idx_r,idx_i1,idx_i,idx_c
+      LOGICAL:: melti, no_micro
+      LOGICAL, DIMENSION(kts:kte):: L_qc, L_qi, L_qr, L_qs, L_qg
+
+!+---+
+
+      no_micro = .true.
+      dts = dt
+      odt = 1./dt
+      odts = 1./dts
+      iexfrq = 1
+
+!+---+-----------------------------------------------------------------+
+!.. Source/sink terms.  First 2 chars: "pr" represents source/sink of
+!.. mass while "pn" represents source/sink of number.  Next char is one
+!.. of "v" for water vapor, "r" for rain, "i" for cloud ice, "w" for
+!.. cloud water, "s" for snow, and "g" for graupel.  Next chars
+!.. represent processes: "de" for sublimation/deposition, "ev" for
+!.. evaporation, "fz" for freezing, "ml" for melting, "au" for
+!.. autoconversion, "nu" for ice nucleation, "hm" for Hallet/Mossop
+!.. secondary ice production, and "c" for collection followed by the
+!.. character for the species being collected.  ALL of these terms are
+!.. positive (except for deposition/sublimation terms which can switch
+!.. signs based on super/subsaturation) and are treated as negatives
+!.. where necessary in the tendency equations.
+!+---+-----------------------------------------------------------------+
+
+      do k = kts, kte
+         tten(k) = 0.
+         qvten(k) = 0.
+         qcten(k) = 0.
+         qiten(k) = 0.
+         qrten(k) = 0.
+         qsten(k) = 0.
+         qgten(k) = 0.
+         niten(k) = 0.
+
+         prw_vcd(k) = 0.
+
+         prv_rev(k) = 0.
+         prr_wau(k) = 0.
+         prr_rcw(k) = 0.
+         prr_rcs(k) = 0.
+         prr_rcg(k) = 0.
+         prr_sml(k) = 0.
+         prr_gml(k) = 0.
+         prr_rci(k) = 0.
+
+         pri_inu(k) = 0.
+         pni_inu(k) = 0.
+         pri_ihm(k) = 0.
+         pni_ihm(k) = 0.
+         pri_wfz(k) = 0.
+         pni_wfz(k) = 0.
+         pri_rfz(k) = 0.
+         pni_rfz(k) = 0.
+         pri_ide(k) = 0.
+         pni_ide(k) = 0.
+         pri_rci(k) = 0.
+         pni_rci(k) = 0.
+         pni_sci(k) = 0.
+         pni_iau(k) = 0.
+
+         prs_iau(k) = 0.
+         prs_sci(k) = 0.
+         prs_rcs(k) = 0.
+         prs_scw(k) = 0.
+         prs_sde(k) = 0.
+         prs_ihm(k) = 0.
+         prs_ide(k) = 0.
+
+         prg_scw(k) = 0.
+         prg_rfz(k) = 0.
+         prg_gde(k) = 0.
+         prg_gcw(k) = 0.
+         prg_rci(k) = 0.
+         prg_rcs(k) = 0.
+         prg_rcg(k) = 0.
+         prg_ihm(k) = 0.
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Put column of data into local arrays.
+!+---+-----------------------------------------------------------------+
+      do k = kts, kte
+         temp(k) = t1d(k)
+         qv(k) = AMAX1(1.E-10, qv1d(k))
+         pres(k) = p1d(k)
+         rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622))
+         if (qc1d(k) .gt. R1) then
+            no_micro = .false.
+            rc(k) = qc1d(k)*rho(k)
+            L_qc(k) = .true.
+         else
+            qc1d(k) = 0.0
+            rc(k) = R1
+            L_qc(k) = .false.
+         endif
+         if (qi1d(k) .gt. R1) then
+            no_micro = .false.
+            ri(k) = qi1d(k)*rho(k)
+            ni(k) = AMAX1(1., ni1d(k)*rho(k))
+            L_qi(k) = .true.
+         else
+            qi1d(k) = 0.0
+            ni1d(k) = 0.0
+            ri(k) = R1
+            ni(k) = 0.01
+            L_qi(k) = .false.
+         endif
+         if (qr1d(k) .gt. R1) then
+            no_micro = .false.
+            rr(k) = qr1d(k)*rho(k)
+            L_qr(k) = .true.
+         else
+            qr1d(k) = 0.0
+            rr(k) = R1
+            L_qr(k) = .false.
+         endif
+         mvd_r(k) = D0r
+         if (qs1d(k) .gt. R1) then
+            no_micro = .false.
+            rs(k) = qs1d(k)*rho(k)
+            L_qs(k) = .true.
+         else
+            qs1d(k) = 0.0
+            rs(k) = R1
+            L_qs(k) = .false.
+         endif
+         if (qg1d(k) .gt. R1) then
+            no_micro = .false.
+            rg(k) = qg1d(k)*rho(k)
+            L_qg(k) = .true.
+         else
+            qg1d(k) = 0.0
+            rg(k) = R1
+            L_qg(k) = .false.
+         endif
+      enddo
+
+
+!+---+-----------------------------------------------------------------+
+!..Derive various thermodynamic variables frequently used.
+!.. Saturation vapor pressure (mixing ratio) over liquid/ice comes from
+!.. Flatau et al. 1992; enthalpy (latent heat) of vaporization from
+!.. Bohren & Albrecht 1998; others from Pruppacher & Klett 1978.
+!+---+-----------------------------------------------------------------+
+      do k = kts, kte
+         tempc = temp(k) - 273.15
+         rhof(k) = SQRT(RHO_NOT/rho(k))
+         rhof2(k) = SQRT(rhof(k))
+         qvs(k) = rslf(pres(k), temp(k))
+         if (tempc .le. 0.0) then
+          qvsi(k) = rsif(pres(k), temp(k))
+         else
+          qvsi(k) = qvs(k)
+         endif
+         satw(k) = qv(k)/qvs(k)
+         sati(k) = qv(k)/qvsi(k)
+         ssatw(k) = satw(k) - 1.
+         ssati(k) = sati(k) - 1.
+         if (abs(ssatw(k)).lt. eps) ssatw(k) = 0.0
+         if (abs(ssati(k)).lt. eps) ssati(k) = 0.0
+         if (no_micro .and. ssati(k).gt. 0.0) no_micro = .false.
+         diffu(k) = 2.11E-5*(temp(k)/273.15)**1.94 * (101325./pres(k))
+         if (tempc .ge. 0.0) then
+            visco(k) = (1.718+0.0049*tempc)*1.0E-5
+         else
+            visco(k) = (1.718+0.0049*tempc-1.2E-5*tempc*tempc)*1.0E-5
+         endif
+         ocp(k) = 1./(Cp*(1.+0.887*qv(k)))
+         vsc2(k) = SQRT(rho(k)/visco(k))
+         lvap(k) = lvap0 + (2106.0 - 4218.0)*tempc
+         tcond(k) = (5.69 + 0.0168*tempc)*1.0E-5 * 418.936
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..If no existing hydrometeor species and no chance to initiate ice or
+!.. condense cloud water, just exit quickly!
+!+---+-----------------------------------------------------------------+
+
+      if (no_micro) return
+
+!+---+-----------------------------------------------------------------+
+!..Calculate y-intercept, slope, and useful moments for snow.
+!+---+-----------------------------------------------------------------+
+      if (.not. iiwarm) then
+      do k = kts, kte
+         if (.not. L_qs(k)) CYCLE
+         tc0 = AMIN1(-0.1, temp(k)-273.15)
+         smob(k) = rs(k)*oams
+
+!..All other moments based on reference, 2nd moment.  If bm_s.ne.2,
+!.. then we must compute actual 2nd moment and use as reference.
+         if (bm_s.gt.(2.0-1.e-3) .and. bm_s.lt.(2.0+1.e-3)) then
+            smo2(k) = smob(k)
+         else
+            loga_ = sa(1) + sa(2)*tc0 + sa(3)*bm_s &
+               + sa(4)*tc0*bm_s + sa(5)*tc0*tc0 &
+               + sa(6)*bm_s*bm_s + sa(7)*tc0*tc0*bm_s &
+               + sa(8)*tc0*bm_s*bm_s + sa(9)*tc0*tc0*tc0 &
+               + sa(10)*bm_s*bm_s*bm_s
+            a_ = 10.0**loga_
+            b_ = sb(1) + sb(2)*tc0 + sb(3)*bm_s &
+               + sb(4)*tc0*bm_s + sb(5)*tc0*tc0 &
+               + sb(6)*bm_s*bm_s + sb(7)*tc0*tc0*bm_s &
+               + sb(8)*tc0*bm_s*bm_s + sb(9)*tc0*tc0*tc0 &
+               + sb(10)*bm_s*bm_s*bm_s
+            smo2(k) = (smob(k)/a_)**(1./b_)
+         endif
+
+!..Calculate 1st moment.  Useful for depositional growth and melting.
+         loga_ = sa(1) + sa(2)*tc0 + sa(3) &
+               + sa(4)*tc0 + sa(5)*tc0*tc0 &
+               + sa(6) + sa(7)*tc0*tc0 &
+               + sa(8)*tc0 + sa(9)*tc0*tc0*tc0 &
+               + sa(10)
+         a_ = 10.0**loga_
+         b_ = sb(1)+ sb(2)*tc0 + sb(3) + sb(4)*tc0 &
+              + sb(5)*tc0*tc0 + sb(6) &
+              + sb(7)*tc0*tc0 + sb(8)*tc0 &
+              + sb(9)*tc0*tc0*tc0 + sb(10)
+         smo1(k) = a_ * smo2(k)**b_
+
+!..Calculate bm_s+1 (th) moment.  Useful for diameter calcs.
+         loga_ = sa(1) + sa(2)*tc0 + sa(3)*cse(1) &
+               + sa(4)*tc0*cse(1) + sa(5)*tc0*tc0 &
+               + sa(6)*cse(1)*cse(1) + sa(7)*tc0*tc0*cse(1) &
+               + sa(8)*tc0*cse(1)*cse(1) + sa(9)*tc0*tc0*tc0 &
+               + sa(10)*cse(1)*cse(1)*cse(1)
+         a_ = 10.0**loga_
+         b_ = sb(1)+ sb(2)*tc0 + sb(3)*cse(1) + sb(4)*tc0*cse(1) &
+              + sb(5)*tc0*tc0 + sb(6)*cse(1)*cse(1) &
+              + sb(7)*tc0*tc0*cse(1) + sb(8)*tc0*cse(1)*cse(1) &
+              + sb(9)*tc0*tc0*tc0 + sb(10)*cse(1)*cse(1)*cse(1)
+         smoc(k) = a_ * smo2(k)**b_
+
+!..Calculate bv_s+2 (th) moment.  Useful for riming.
+         loga_ = sa(1) + sa(2)*tc0 + sa(3)*cse(13) &
+               + sa(4)*tc0*cse(13) + sa(5)*tc0*tc0 &
+               + sa(6)*cse(13)*cse(13) + sa(7)*tc0*tc0*cse(13) &
+               + sa(8)*tc0*cse(13)*cse(13) + sa(9)*tc0*tc0*tc0 &
+               + sa(10)*cse(13)*cse(13)*cse(13)
+         a_ = 10.0**loga_
+         b_ = sb(1)+ sb(2)*tc0 + sb(3)*cse(13) + sb(4)*tc0*cse(13) &
+              + sb(5)*tc0*tc0 + sb(6)*cse(13)*cse(13) &
+              + sb(7)*tc0*tc0*cse(13) + sb(8)*tc0*cse(13)*cse(13) &
+              + sb(9)*tc0*tc0*tc0 + sb(10)*cse(13)*cse(13)*cse(13)
+         smoe(k) = a_ * smo2(k)**b_
+
+!..Calculate 1+(bv_s+1)/2 (th) moment.  Useful for depositional growth.
+         loga_ = sa(1) + sa(2)*tc0 + sa(3)*cse(16) &
+               + sa(4)*tc0*cse(16) + sa(5)*tc0*tc0 &
+               + sa(6)*cse(16)*cse(16) + sa(7)*tc0*tc0*cse(16) &
+               + sa(8)*tc0*cse(16)*cse(16) + sa(9)*tc0*tc0*tc0 &
+               + sa(10)*cse(16)*cse(16)*cse(16)
+         a_ = 10.0**loga_
+         b_ = sb(1)+ sb(2)*tc0 + sb(3)*cse(16) + sb(4)*tc0*cse(16) &
+              + sb(5)*tc0*tc0 + sb(6)*cse(16)*cse(16) &
+              + sb(7)*tc0*tc0*cse(16) + sb(8)*tc0*cse(16)*cse(16) &
+              + sb(9)*tc0*tc0*tc0 + sb(10)*cse(16)*cse(16)*cse(16)
+         smof(k) = a_ * smo2(k)**b_
+
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Calculate y-intercept, slope values for graupel.
+!+---+-----------------------------------------------------------------+
+      N0_min = gonv_max
+      do k = kte, kts, -1
+         if (.not. L_qg(k)) CYCLE
+         N0_exp = 100.0*rho(k)/rg(k)
+         N0_exp = AMAX1(gonv_min, AMIN1(N0_exp, gonv_max))
+         N0_min = AMIN1(N0_exp, N0_min)
+         N0_exp = N0_min
+         lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1
+         lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg
+         ilamg(k) = 1./lamg
+         N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2)
+      enddo
+
+      endif
+
+!+---+-----------------------------------------------------------------+
+!..Calculate y-intercept & slope values for rain.
+!.. New treatment for variable y-intercept of rain.  When rain comes
+!.. from melted snow/graupel, compute mass-weighted mean size, melt
+!.. into water, compute its mvd and recompute slope/intercept.
+!.. If rain not from melted snow, use old relation but hold N0_r
+!.. constant at its lowest value.  While doing all this, ensure rain
+!.. mvd does not exceed reasonable size like 3 mm.
+!+---+-----------------------------------------------------------------+
+      N0_min = ronv_max
+      do k = kte, kts, -1
+         if (.not. L_qr(k)) CYCLE
+         N0_exp = ronv_c1*tanh(ronv_c0*(ronv_r0-rr(k))) + ronv_c2
+         N0_min = AMIN1(N0_exp, N0_min)
+         N0_exp = N0_min
+         lam_exp = (N0_exp*am_r*crg(1)/rr(k))**ore1
+         lamr = lam_exp * (crg(3)*org2*org1)**obmr
+         mvd_r(k) = (3.0+mu_r+0.672) / lamr
+         if (mvd_r(k) .gt. 3.e-3) then
+            mvd_r(k) = 3.e-3
+            lamr = (3.0+mu_r+0.672) / 3.e-3
+            lam_exp = lamr * (crg(3)*org2*org1)**bm_r
+            N0_exp = org1*rr(k)/am_r * lam_exp**cre(1)
+         endif
+         N0_r(k) = N0_exp/(crg(2)*lam_exp) * lamr**cre(2)
+         ilamr(k) = 1./lamr
+      enddo
+
+      if (.not. iiwarm) then
+      k_0 = kts
+      melti = .false.
+      do k = kte-1, kts, -1
+         if ( (temp(k).gt. T_0) .and. (rr(k).gt. 0.001e-3) &
+                   .and. ((rs(k+1)+rg(k+1)).gt. 0.01e-3) ) then
+            k_0 = MAX(k+1, k_0)
+            melti=.true.
+            goto 135
+         endif
+      enddo
+ 135  continue
+
+      if (melti) then
+!.. Locate bottom of melting layer (if any).
+         kbot = kts
+         do k = k_0-1, kts, -1
+            if ( (rs(k)+rg(k)).lt. 0.01e-3) goto 136
+         enddo
+ 136     continue
+         kbot = MAX(k, kts)
+
+!.. Compute melted snow/graupel equiv water diameter one K-level above
+!.. melting.  Set starting rain mvd to either 50 microns or max from
+!.. higher up in column.
+         if (L_qs(k_0)) then
+          Ds = smoc(k_0) / smob(k_0)
+          Ds_m = (am_s*Ds**bm_s / am_r)**obmr
+         else
+          Ds_m = 1.0e-6
+         endif
+         if (L_qg(k_0)) then
+          Dg = (bm_g + mu_g + 1.) * ilamg(k_0)
+          Dg_m = (am_g*Dg**bm_g / am_r)**obmr
+         else
+          Dg_m = 1.0e-6
+         endif
+         r_mvd1 = mvd_r(k_0)
+         r_mvd2 = AMIN1(AMAX1(Ds_m, Dg_m, r_mvd1+1.e-6, mvd_r(kbot)), &
+                        3.e-3)
+
+!.. Within melting layer, apply linear increase of rain mvd from r_mvd1
+!.. to equiv melted snow/graupel value (r_mvd2).  So, by the bottom of
+!.. the melting layer, the rain will have an mvd that matches that from
+!.. melted snow and/or graupel.
+         if (kbot.gt. 2) then
+         do k = k_0-1, kbot, -1
+            if (.not. L_qr(k)) CYCLE
+            xkrat = REAL(k_0-k)/REAL(k_0-kbot)
+            mvd_r(k) = AMAX1(mvd_r(k), xkrat*(r_mvd2-r_mvd1)+r_mvd1)
+            lamr = (4.0+mu_r) / mvd_r(k)
+            lam_exp = lamr * (crg(3)*org2*org1)**bm_r
+            N0_exp = org1*rr(k)/am_r * lam_exp**cre(1)
+            N0_exp = AMAX1(ronv_min, AMIN1(N0_exp, ronv_max))
+            lam_exp = (N0_exp*am_r*crg(1)/rr(k))**ore1
+            lamr = lam_exp * (crg(3)*org2*org1)**obmr
+            mvd_r(k) = (3.0+mu_r+0.672) / lamr
+            N0_r(k) = rr(k)*lamr**cre(3) / (am_r*crg(3))
+            ilamr(k) = 1./lamr
+         enddo
+
+!.. Below melting layer, hold N0_r constant unless changes to mixing
+!.. ratio increase mvd beyond 3 mm threshold, then adjust slope and
+!.. intercept to cap mvd at 3 mm.  In future, we could lower N0_r to
+!.. account for self-collection or other sinks.
+         do k = kbot-1, kts, -1
+            if (.not. L_qr(k)) CYCLE
+            N0_r(k) = AMIN1(N0_r(k), N0_r(kbot))
+            lamr = (N0_r(k)*am_r*crg(3)/rr(k))**(1./cre(3))
+            lam_exp = lamr * (crg(3)*org2*org1)**bm_r
+            N0_exp = org1*rr(k)/am_r * lam_exp**cre(1)
+            N0_exp = AMAX1(ronv_min, AMIN1(N0_exp, ronv_max))
+            lam_exp = (N0_exp*am_r*crg(1)/rr(k))**ore1
+            lamr = lam_exp * (crg(3)*org2*org1)**obmr
+            mvd_r(k) = (3.0+mu_r+0.672) / lamr
+            if (mvd_r(k) .gt. 3.e-3) then
+               mvd_r(k) = 3.e-3
+               lamr = (3.0+mu_r+0.672) / mvd_r(k)
+            endif
+            N0_r(k) = rr(k)*lamr**cre(3) / (am_r*crg(3))
+            ilamr(k) = 1./lamr
+         enddo
+         endif
+
+      endif
+      endif
+
+!+---+-----------------------------------------------------------------+
+!..Compute warm-rain process terms (except evap done later).
+!+---+-----------------------------------------------------------------+
+
+      do k = kts, kte
+         if (.not. L_qc(k)) CYCLE
+         Dc = AMAX1(D0c*1.E6, ((rc(k)/(am_r*Nt_c))**obmr) * 1.E6)
+         lamc = (Nt_c*am_r* ccg(2) * ocg1 / rc(k))**obmr
+         mvd_c(k) = (3.0+mu_c+0.672) / lamc
+
+!..Autoconversion follows Berry & Reinhardt (1974) with characteristic
+!.. diameters correctly computed from gamma distrib of cloud droplets.
+         if (rc(k).gt. 0.01e-3) then
+          Dc_g = ((ccg(3)*ocg2)**obmr / lamc) * 1.E6
+          Dc_b = (Dc*Dc*Dc*Dc_g*Dc_g*Dc_g - Dc*Dc*Dc*Dc*Dc*Dc)**(1./6.)
+          zeta1 = 0.5*((6.25E-6*Dc*Dc_b*Dc_b*Dc_b - 0.4) &
+                     + abs(6.25E-6*Dc*Dc_b*Dc_b*Dc_b - 0.4))
+          zeta = 0.027*rc(k)*zeta1
+          taud = 0.5*((0.5*Dc_b - 7.5) + abs(0.5*Dc_b - 7.5)) + R1
+          tau  = 3.72/(rc(k)*taud)
+          prr_wau(k) = zeta/tau
+          prr_wau(k) = AMIN1(rc(k)*odts, prr_wau(k))
+         endif
+
+!..Rain collecting cloud water.  In SCE, assume Dc<<Dr and vtc=~0.
+         if (L_qr(k)) then
+          Dr = (bm_r + mu_r + 1.) * ilamr(k)
+          lamr = 1./ilamr(k)
+          vtr = rhof(k)*av_r*crg(6)*org3 * (lamr/(lamr+fv_r))**cre(3) &
+                         / (lamr+fv_r)**bv_r
+          stoke_r = mvd_c(k)*mvd_c(k)*vtr*rho_w/(9.*visco(k)*Dr)
+          Ef_rw = stoke_r*stoke_r/((stoke_r+0.5)*(stoke_r+0.5))
+          Ef_rw = AMAX1(0.0, AMIN1(0.99, Ef_rw))
+          prr_rcw(k) = rhof(k)*t1_qr_qc*Ef_rw*rc(k)*N0_r(k) &
+                         / (lamr+fv_r)**cre(9)
+          prr_rcw(k) = AMIN1(rc(k)*odts, prr_rcw(k))
+         endif
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Compute all frozen hydrometeor species' process terms.
+!+---+-----------------------------------------------------------------+
+      if (.not. iiwarm) then
+      do k = kts, kte
+         vts_boost(k) = 1.5
+
+!..Temperature lookup table indexes.
+         tempc = temp(k) - 273.15
+         idx_tc = MAX(1, MIN(NINT(-tempc), 45) )
+         idx_t = INT( (tempc-2.5)/5. ) - 1
+         idx_t = MAX(1, -idx_t)
+         idx_t = MIN(idx_t, ntb_t)
+         IT = MAX(1, MIN(NINT(-tempc), 31) )
+
+!..Cloud water lookup table index.
+         if (rc(k).gt. r_c(1)) then
+          nic = NINT(ALOG10(rc(k)))
+          do nn = nic-1, nic+1
+             n = nn
+             if ( (rc(k)/10.**nn).ge.1.0 .and. &
+                  (rc(k)/10.**nn).lt.10.0) goto 141
+          enddo
+ 141      continue
+          idx_c = INT(rc(k)/10.**n) + 10*(n-nic2) - (n-nic2)
+          idx_c = MAX(1, MIN(idx_c, ntb_c))
+         else
+          idx_c = 1
+         endif
+
+!..Cloud ice lookup table indexes.
+         if (ri(k).gt. r_i(1)) then
+          nii = NINT(ALOG10(ri(k)))
+          do nn = nii-1, nii+1
+             n = nn
+             if ( (ri(k)/10.**nn).ge.1.0 .and. &
+                  (ri(k)/10.**nn).lt.10.0) goto 142
+          enddo
+ 142      continue
+          idx_i = INT(ri(k)/10.**n) + 10*(n-nii2) - (n-nii2)
+          idx_i = MAX(1, MIN(idx_i, ntb_i))
+         else
+          idx_i = 1
+         endif
+
+         if (ni(k).gt. Nt_i(1)) then
+          nii = NINT(ALOG10(ni(k)))
+          do nn = nii-1, nii+1
+             n = nn
+             if ( (ni(k)/10.**nn).ge.1.0 .and. &
+                  (ni(k)/10.**nn).lt.10.0) goto 143
+          enddo
+ 143      continue
+          idx_i1 = INT(ni(k)/10.**n) + 10*(n-nii3) - (n-nii3)
+          idx_i1 = MAX(1, MIN(idx_i1, ntb_i1))
+         else
+          idx_i1 = 1
+         endif
+
+!..Rain lookup table indexes.
+         if (rr(k).gt. r_r(1)) then
+          nir = NINT(ALOG10(rr(k)))
+          do nn = nir-1, nir+1
+             n = nn
+             if ( (rr(k)/10.**nn).ge.1.0 .and. &
+                  (rr(k)/10.**nn).lt.10.0) goto 144
+          enddo
+ 144      continue
+          idx_r = INT(rr(k)/10.**n) + 10*(n-nir2) - (n-nir2)
+          idx_r = MAX(1, MIN(idx_r, ntb_r))
+
+          lam_exp = lamr * (crg(3)*org2*org1)**bm_r
+          N0_exp = org1*rr(k)/am_r * lam_exp**cre(1)
+          nir = NINT(ALOG10(N0_exp))
+          do nn = nir-1, nir+1
+             n = nn
+             if ( (N0_exp/10.**nn).ge.1.0 .and. &
+                  (N0_exp/10.**nn).lt.10.0) goto 145
+          enddo
+ 145      continue
+          idx_r1 = INT(N0_exp/10.**n) + 10*(n-nir3) - (n-nir3)
+          idx_r1 = MAX(1, MIN(idx_r1, ntb_r1))
+         else
+          idx_r = 1
+          idx_r1 = ntb_r1
+         endif
+
+!..Snow lookup table index.
+         if (rs(k).gt. r_s(1)) then
+          nis = NINT(ALOG10(rs(k)))
+          do nn = nis-1, nis+1
+             n = nn
+             if ( (rs(k)/10.**nn).ge.1.0 .and. &
+                  (rs(k)/10.**nn).lt.10.0) goto 146
+          enddo
+ 146      continue
+          idx_s = INT(rs(k)/10.**n) + 10*(n-nis2) - (n-nis2)
+          idx_s = MAX(1, MIN(idx_s, ntb_s))
+         else
+          idx_s = 1
+         endif
+
+!..Graupel lookup table index.
+         if (rg(k).gt. r_g(1)) then
+          nig = NINT(ALOG10(rg(k)))
+          do nn = nig-1, nig+1
+             n = nn
+             if ( (rg(k)/10.**nn).ge.1.0 .and. &
+                  (rg(k)/10.**nn).lt.10.0) goto 147
+          enddo
+ 147      continue
+          idx_g = INT(rg(k)/10.**n) + 10*(n-nig2) - (n-nig2)
+          idx_g = MAX(1, MIN(idx_g, ntb_g))
+         else
+          idx_g = 1
+         endif
+
+!..Deposition/sublimation prefactor (from Srivastava & Coen 1992).
+         otemp = 1./temp(k)
+         rvs = rho(k)*qvsi(k)
+         rvs_p = rvs*otemp*(lsub*otemp*oRv - 1.)
+         rvs_pp = rvs * ( otemp*(lsub*otemp*oRv - 1.) &
+                         *otemp*(lsub*otemp*oRv - 1.) &
+                         + (-2.*lsub*otemp*otemp*otemp*oRv) &
+                         + otemp*otemp)
+         gamsc = lsub*diffu(k)/tcond(k) * rvs_p
+         alphsc = 0.5*(gamsc/(1.+gamsc))*(gamsc/(1.+gamsc)) &
+                    * rvs_pp/rvs_p * rvs/rvs_p
+         alphsc = AMAX1(1.E-9, alphsc)
+         xsat = ssati(k)
+         if (abs(xsat).lt. 1.E-9) xsat=0.
+         t1_subl = 4.*PI*( 1.0 - alphsc*xsat &
+                + 2.*alphsc*alphsc*xsat*xsat &
+                - 5.*alphsc*alphsc*alphsc*xsat*xsat*xsat ) &
+                / (1.+gamsc)
+
+!..Snow collecting cloud water.  In SCE, assume Dc<<Ds and vtc=~0.
+         if (L_qc(k)) then
+          Ds = 0.0
+          if (L_qs(k)) Ds = smoc(k) / smob(k)
+          if (Ds .gt. D0s) then
+           Mrat = 1./Ds
+           ils1 = 1./(Mrat*Lam0 + fv_s)
+           ils2 = 1./(Mrat*Lam1 + fv_s)
+           t1_vts = Kap0*csg(4)*ils1**cse(4)
+           t2_vts = Kap1*Mrat**mu_s*csg(10)*ils2**cse(10)
+           t3_vts = Kap0*csg(1)*ils1**cse(1)
+           t4_vts = Kap1*Mrat**mu_s*csg(7)*ils2**cse(7)
+           vts = rhof(k)*av_s * (t1_vts+t2_vts)/(t3_vts+t4_vts)
+           stoke_s = mvd_c(k)*mvd_c(k)*vts*rho_w/(9.*visco(k)*Ds)
+           Ef_sw = stoke_s*stoke_s/((stoke_s+0.4)*(stoke_s+0.4))
+           Ef_sw = AMAX1(0.0, AMIN1(0.99, Ef_sw))
+           prs_scw(k) = rhof(k)*t1_qs_qc*Ef_sw*rc(k)*smoe(k)
+          endif
+
+!..Graupel collecting cloud water.  In SCE, assume Dc<<Dg and vtc=~0.
+          if (rg(k).ge. r_g(1)) then
+           Dg = (bm_g + mu_g + 1.) * ilamg(k)
+           vtg = rhof(k)*av_g*cgg(6)*ogg3 * ilamg(k)**bv_g
+           stoke_g = mvd_c(k)*mvd_c(k)*vtg*rho_w/(9.*visco(k)*Dg)
+           Ef_gw = stoke_g*stoke_g/((stoke_g+0.5)*(stoke_g+0.5))
+           Ef_gw = AMAX1(0.0, AMIN1(0.99, Ef_gw))
+           prg_gcw(k) = rhof(k)*t1_qg_qc*Ef_gw*rc(k)*N0_g(k) &
+                          *ilamg(k)**cge(9)
+          endif
+         endif
+
+!..Rain collecting snow.  Cannot assume Wisner (1972) approximation
+!.. or Mizuno (1990) approach so we solve the SCE explicitly and store
+!.. results in lookup table.
+         if (rr(k).ge. r_r(1)) then
+          if (rs(k).ge. r_s(1)) then
+           if (temp(k).lt.T_0) then
+            prr_rcs(k) = -(tmr_racs2(idx_s,idx_t,idx_r1,idx_r) &
+                           + tcr_sacr2(idx_s,idx_t,idx_r1,idx_r) &
+                           + tmr_racs1(idx_s,idx_t,idx_r1,idx_r) &
+                           + tcr_sacr1(idx_s,idx_t,idx_r1,idx_r))
+            prs_rcs(k) = tmr_racs2(idx_s,idx_t,idx_r1,idx_r) &
+                         + tcr_sacr2(idx_s,idx_t,idx_r1,idx_r) &
+                         - tcs_racs1(idx_s,idx_t,idx_r1,idx_r) &
+                         - tms_sacr1(idx_s,idx_t,idx_r1,idx_r)
+            prg_rcs(k) = tmr_racs1(idx_s,idx_t,idx_r1,idx_r) &
+                         + tcr_sacr1(idx_s,idx_t,idx_r1,idx_r) &
+                         + tcs_racs1(idx_s,idx_t,idx_r1,idx_r) &
+                         + tms_sacr1(idx_s,idx_t,idx_r1,idx_r)
+            prr_rcs(k) = AMAX1(-rr(k)*odts, prr_rcs(k))
+            prs_rcs(k) = AMAX1(-rs(k)*odts, prs_rcs(k))
+            prg_rcs(k) = AMIN1((rr(k)+rs(k))*odts, prg_rcs(k))
+           else
+            prs_rcs(k) = -(tcs_racs1(idx_s,idx_t,idx_r1,idx_r) &
+                           + tcs_racs2(idx_s,idx_t,idx_r1,idx_r))
+            prs_rcs(k) = AMAX1(-rs(k)*odts, prs_rcs(k))
+            prr_rcs(k) = -prs_rcs(k)
+           endif
+          endif
+
+!..Rain collecting graupel.  Cannot assume Wisner (1972) approximation
+!.. or Mizuno (1990) approach so we solve the SCE explicitly and store
+!.. results in lookup table.
+          if (rg(k).ge. r_g(1)) then
+           if (temp(k).lt.T_0) then
+            prg_rcg(k) = tmr_racg(idx_g,idx_r1,idx_r) &
+                         + tcr_gacr(idx_g,idx_r1,idx_r)
+            prg_rcg(k) = AMIN1(rr(k)*odts, prg_rcg(k))
+            prr_rcg(k) = -prg_rcg(k)
+           else
+            prr_rcg(k) = tcg_racg(idx_g,idx_r1,idx_r)
+            prr_rcg(k) = AMIN1(rg(k)*odts, prr_rcg(k))
+            prg_rcg(k) = -prr_rcg(k)
+           endif
+          endif
+         endif
+
+!+---+-----------------------------------------------------------------+
+!..Next IF block handles only those processes below 0C.
+!+---+-----------------------------------------------------------------+
+
+         if (temp(k).lt.T_0) then
+
+          vts_boost(k) = 1.0
+          rate_max = (qv(k)-qvsi(k))*rho(k)*odts*0.95
+
+!..Freezing of water drops into graupel/cloud ice (Bigg 1953).
+          if (rr(k).gt. r_r(1)) then
+           prg_rfz(k) = tpg_qrfz(idx_r,idx_r1,idx_tc)*odts
+           pri_rfz(k) = tpi_qrfz(idx_r,idx_r1,idx_tc)*odts
+           pni_rfz(k) = tni_qrfz(idx_r,idx_r1,idx_tc)*odts
+          endif
+          if (rc(k).gt. r_c(1)) then
+           pri_wfz(k) = tpi_qcfz(idx_c,idx_tc)*odts
+           pri_wfz(k) = AMIN1(rc(k)*odts, pri_wfz(k))
+           pni_wfz(k) = tni_qcfz(idx_c,idx_tc)*odts
+           pni_wfz(k) = AMIN1(Nt_c*odts, pri_wfz(k)/(2.*xm0i), &
+                                pni_wfz(k))
+          endif
+
+!..Nucleate ice from deposition & condensation freezing (Cooper 1986)
+!.. but only if water or 8%+ ice supersaturated.
+          if ( (ssati(k).ge. 0.08) .or. (ssatw(k).gt. eps &
+                                .and. temp(k).lt.265.15) ) then
+           xnc = AMIN1(5.E5, TNO*EXP(ATO*(T_0-temp(k))))
+           xni = ni(k) + (pni_rfz(k)+pni_wfz(k))*dts
+           pni_inu(k) = 0.5*(xnc-xni + abs(xnc-xni))*odts
+           pri_inu(k) = AMIN1(rate_max, xm0i*pni_inu(k))
+           pni_inu(k) = pri_inu(k)/xm0i
+          endif
+
+!..Deposition/sublimation of cloud ice (Koenig 1971 for
+!.. temps > -31C then Srivastava & Coen 1992 for lower temps).
+          if (L_qi(k)) then
+           lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi
+           ilami = 1./lami
+           Di = AMAX1(D0i, (bm_i + mu_i + 1.) * ilami)
+           xmi = am_i*Di**bm_i
+           oxmi = 1./xmi
+!          if (temp(k).lt. (T_0-31.0) ) then
+            pri_ide(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs &
+                  *oig1*cig(5)*ni(k)*ilami
+!          else
+!           A2 = ABER2(IT) 
+!           A1 = ABER1(IT) * 0.001**(1.-A2)
+!           pri_ide(k) = (qv(k)-qvsi(k))/(qvs(k)-qvsi(k)) &
+!                  *A1*(am_i**A2) * ni(k)*oig1*cbg(IT)*ilami**(bm_i*A2)
+!          endif
+
+           if (pri_ide(k) .lt. 0.0) then
+            pri_ide(k) = AMAX1(-ri(k)*odts, pri_ide(k), rate_max)
+            pni_ide(k) = pri_ide(k)*oxmi
+            pni_ide(k) = AMAX1(-ni(k)*odts, pni_ide(k))
+           else
+            pri_ide(k) = AMIN1(pri_ide(k), rate_max)
+            prs_ide(k) = (1.0D0-tpi_ide(idx_i,idx_i1))*pri_ide(k)
+            pri_ide(k) = tpi_ide(idx_i,idx_i1)*pri_ide(k)
+           endif
+
+!..Some cloud ice needs to move into the snow category.  Use lookup
+!.. table that resulted from explicit bin representation of distrib.
+           if ( (idx_i.eq. ntb_i) .or. (Di.gt. 5.0*D0s) ) then
+            prs_iau(k) = ri(k)*.99*odts
+            pni_iau(k) = ni(k)*.95*odts
+           elseif (Di.lt. 0.1*D0s) then
+            prs_iau(k) = 0.
+            pni_iau(k) = 0.
+           else
+            prs_iau(k) = tps_iaus(idx_i,idx_i1)*odts
+            prs_iau(k) = AMIN1(ri(k)*.99*odts, prs_iau(k))
+            pni_iau(k) = tni_iaus(idx_i,idx_i1)*odts
+            pni_iau(k) = AMIN1(ni(k)*.95*odts, pni_iau(k))
+           endif
+          endif
+
+!..Deposition/sublimation of snow/graupel follows Srivastava & Coen
+!.. (1992).
+          if (L_qs(k)) then
+           C_snow = C_sqrd + (tempc+15.)*(C_cube-C_sqrd)/(-30.+15.)
+           C_snow = AMAX1(C_sqrd, AMIN1(C_snow, C_cube))
+           prs_sde(k) = C_snow*t1_subl*diffu(k)*ssati(k)*rvs &
+                        * (t1_qs_sd*smo1(k) &
+                         + t2_qs_sd*rhof2(k)*vsc2(k)*smof(k))
+           if (prs_sde(k).lt. 0.) then
+            prs_sde(k) = AMAX1(-rs(k)*odts, prs_sde(k), rate_max)
+           else
+            prs_sde(k) = AMIN1(prs_sde(k), rate_max)
+           endif
+          endif
+
+          if (L_qg(k) .and. ssati(k).lt. -eps) then
+           prg_gde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs &
+               * N0_g(k) * (t1_qg_sd*ilamg(k)**cge(10) &
+               + t2_qg_sd*vsc2(k)*rhof2(k)*ilamg(k)**cge(11))
+           if (prg_gde(k).lt. 0.) then
+            prg_gde(k) = AMAX1(-rg(k)*odts, prg_gde(k), rate_max)
+           else
+            prg_gde(k) = AMIN1(prg_gde(k), rate_max)
+           endif
+          endif
+
+!..Snow collecting cloud ice.  In SCE, assume Di<<Ds and vti=~0.
+          if (L_qi(k)) then
+           lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi
+           ilami = 1./lami
+           Di = AMAX1(D0i, (bm_i + mu_i + 1.) * ilami)
+           xmi = am_i*Di**bm_i
+           oxmi = 1./xmi
+           if (rs(k).ge. r_s(1)) then
+            prs_sci(k) = t1_qs_qi*rhof(k)*Ef_si*ri(k)*smoe(k)
+            pni_sci(k) = prs_sci(k) * oxmi
+           endif
+
+!..Rain collecting cloud ice.  In SCE, assume Di<<Dr and vti=~0.
+           if (rr(k).ge. r_r(1)) then
+            lamr = 1./ilamr(k)
+            Dr = (bm_r + mu_r + 1.) * ilamr(k)
+            lamr = 1./ilamr(k)
+            vtr = rhof(k)*av_r*crg(6)*org3*(lamr/(lamr+fv_r))**cre(3) &
+                           /(lamr+fv_r)**bv_r
+            stoke_i = Di*Di*vtr*rho_i/(9.*visco(k)*Dr)
+            Ef_ri = stoke_i*stoke_i/((stoke_i+0.5)*(stoke_i+0.5))
+            Ef_ri = AMAX1(0.0, AMIN1(0.99, Ef_ri))
+            pri_rci(k) = rhof(k)*t1_qr_qi*Ef_ri*ri(k)*N0_r(k) &
+                           /(lamr+fv_r)**cre(9)
+            pni_rci(k) = pri_rci(k) * oxmi
+            prr_rci(k) = rhof(k)*t2_qr_qi*Ef_ri*ni(k)*N0_r(k) &
+                           /(lamr+fv_r)**cre(8)
+            prr_rci(k) = AMIN1(rr(k), prr_rci(k))
+            prg_rci(k) = pri_rci(k) + prr_rci(k) 
+           endif
+          endif
+
+!..Ice multiplication from rime-splinters (Hallet & Mossop 1974).
+          if (prg_gcw(k).gt. eps .and. tempc.gt.-8.0) then
+           tf = 0.
+           if (tempc.ge.-5.0 .and. tempc.lt.-3.0) then
+            tf = 0.5*(-3.0 - tempc)
+           elseif (tempc.gt.-8.0 .and. tempc.lt.-5.0) then
+            tf = 0.33333333*(8.0 + tempc)
+           endif
+           pni_ihm(k) = 3.5E8*tf*prg_gcw(k)
+           pri_ihm(k) = xm0i*pni_ihm(k)
+           prs_ihm(k) = prs_scw(k)/(prs_scw(k)+prg_gcw(k)) &
+                          * pri_ihm(k)
+           prg_ihm(k) = prg_gcw(k)/(prs_scw(k)+prg_gcw(k)) &
+                          * pri_ihm(k)
+          endif
+
+!..A portion of rimed snow converts to graupel but some remains snow.
+!.. Interp from 5 to 75% as riming factor increases from 5.0 to 30.0
+!.. 0.028 came from (.75-.05)/(30.-5.).  This remains ad-hoc and should
+!.. be revisited.
+          if (prs_scw(k).gt.5.0*prs_sde(k) .and. &
+                         prs_sde(k).gt.eps) then
+           r_frac = AMIN1(30.0, prs_scw(k)/prs_sde(k))
+           g_frac = AMIN1(0.75, 0.05 + (r_frac-5.)*.028)
+           vts_boost(k) = AMIN1(1.5, 1.1 + (r_frac-5.)*.016)
+           prg_scw(k) = g_frac*prs_scw(k)
+           prs_scw(k) = (1. - g_frac)*prs_scw(k)
+          endif
+
+         else
+
+!..Melt snow and graupel and enhance from collisions with liquid.
+!.. We also need to sublimate snow and graupel if subsaturated.
+          if (L_qs(k)) then
+           prr_sml(k) = tempc*tcond(k)*(t1_qs_me*smo1(k) &
+                      + t2_qs_me*rhof2(k)*vsc2(k)*smof(k))
+           prr_sml(k) = prr_sml(k) + 4218.*olfus*tempc &
+                                   * (prr_rcs(k)+prs_scw(k))
+           prr_sml(k) = AMIN1(rs(k)*odts, prr_sml(k))
+
+           if (ssati(k).lt. 0.) then
+            prs_sde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs &
+                         * (t1_qs_sd*smo1(k) &
+                          + t2_qs_sd*rhof2(k)*vsc2(k)*smof(k))
+            prs_sde(k) = AMAX1(-rs(k)*odts, prs_sde(k))
+           endif
+          endif
+
+          if (L_qg(k)) then
+           prr_gml(k) = tempc*N0_g(k)*tcond(k) &
+                    *(t1_qg_me*ilamg(k)**cge(10) &
+                    + t2_qg_me*rhof2(k)*vsc2(k)*ilamg(k)**cge(11))
+           prr_gml(k) = prr_gml(k) + 4218.*olfus*tempc &
+                                   * (prr_rcg(k)+prg_gcw(k))
+           prr_gml(k) = AMIN1(rg(k)*odts, prr_gml(k))
+
+           if (ssati(k).lt. 0.) then
+            prg_gde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs &
+                * N0_g(k) * (t1_qg_sd*ilamg(k)**cge(10) &
+                + t2_qg_sd*vsc2(k)*rhof2(k)*ilamg(k)**cge(11))
+            prg_gde(k) = AMAX1(-rg(k)*odts, prg_gde(k))
+           endif
+          endif
+
+         endif
+
+      enddo
+      endif
+
+!+---+-----------------------------------------------------------------+
+!..Ensure we do not deplete more hydrometeor species than exists.
+!+---+-----------------------------------------------------------------+
+      do k = kts, kte
+
+!..If ice supersaturated, ensure sum of depos growth terms does not
+!.. deplete more vapor than possibly exists.  If subsaturated, limit
+!.. sum of sublimation terms such that vapor does not reproduce ice
+!.. supersat again.
+         sump = pri_inu(k) + pri_ide(k) + prs_ide(k) &
+              + prs_sde(k) + prg_gde(k)
+         rate_max = (qv(k)-qvsi(k))*odts*0.95
+         if ( (sump.gt. eps .and. sump.gt. rate_max) .or. &
+              (sump.lt. -eps .and. sump.lt. rate_max) ) then
+          ratio = rate_max/sump
+          pri_inu(k) = pri_inu(k) * ratio
+          pri_ide(k) = pri_ide(k) * ratio
+          pni_ide(k) = pni_ide(k) * ratio
+          prs_ide(k) = prs_ide(k) * ratio
+          prs_sde(k) = prs_sde(k) * ratio
+          prg_gde(k) = prg_gde(k) * ratio
+         endif
+
+!..Cloud water conservation.
+         sump = -prr_wau(k) - pri_wfz(k) - prr_rcw(k) &
+                - prs_scw(k) - prg_scw(k) - prg_gcw(k)
+         rate_max = -rc(k)*odts
+         if (sump.lt. rate_max .and. L_qc(k)) then
+          ratio = rate_max/sump
+          prr_wau(k) = prr_wau(k) * ratio
+          pri_wfz(k) = pri_wfz(k) * ratio
+          prr_rcw(k) = prr_rcw(k) * ratio
+          prs_scw(k) = prs_scw(k) * ratio
+          prg_scw(k) = prg_scw(k) * ratio
+          prg_gcw(k) = prg_gcw(k) * ratio
+         endif
+
+!..Cloud ice conservation.
+         sump = pri_ide(k) - prs_iau(k) - prs_sci(k) &
+                - pri_rci(k)
+         rate_max = -ri(k)*odts
+         if (sump.lt. rate_max .and. L_qi(k)) then
+          ratio = rate_max/sump
+          pri_ide(k) = pri_ide(k) * ratio
+          prs_iau(k) = prs_iau(k) * ratio
+          prs_sci(k) = prs_sci(k) * ratio
+          pri_rci(k) = pri_rci(k) * ratio
+         endif
+
+!..Rain conservation.
+         sump = -prg_rfz(k) - pri_rfz(k) - prr_rci(k) &
+                + prr_rcs(k) + prr_rcg(k)
+         rate_max = -rr(k)*odts
+         if (sump.lt. rate_max .and. L_qr(k)) then
+          ratio = rate_max/sump
+          prg_rfz(k) = prg_rfz(k) * ratio
+          pri_rfz(k) = pri_rfz(k) * ratio
+          prr_rci(k) = prr_rci(k) * ratio
+          prr_rcs(k) = prr_rcs(k) * ratio
+          prr_rcg(k) = prr_rcg(k) * ratio
+         endif
+
+!..Snow conservation.
+         sump = prs_sde(k) - prs_ihm(k) - prr_sml(k) &
+                + prs_rcs(k)
+         rate_max = -rs(k)*odts
+         if (sump.lt. rate_max .and. L_qs(k)) then
+          ratio = rate_max/sump
+          prs_sde(k) = prs_sde(k) * ratio
+          prs_ihm(k) = prs_ihm(k) * ratio
+          prr_sml(k) = prr_sml(k) * ratio
+          prs_rcs(k) = prs_rcs(k) * ratio
+         endif
+
+!..Graupel conservation.
+         sump = prg_gde(k) - prg_ihm(k) - prr_gml(k) &
+              + prg_rcg(k)
+         rate_max = -rg(k)*odts
+         if (sump.lt. rate_max .and. L_qg(k)) then
+          ratio = rate_max/sump
+          prg_gde(k) = prg_gde(k) * ratio
+          prg_ihm(k) = prg_ihm(k) * ratio
+          prr_gml(k) = prr_gml(k) * ratio
+          prg_rcg(k) = prg_rcg(k) * ratio
+         endif
+
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Calculate tendencies of all species but constrain the number of ice
+!.. to reasonable values.
+!+---+-----------------------------------------------------------------+
+      do k = kts, kte
+         orho = 1./rho(k)
+         lfus2 = lsub - lvap(k)
+
+!..Water vapor tendency
+         qvten(k) = qvten(k) + (-pri_inu(k) - pri_ide(k) &
+                      - prs_ide(k) - prs_sde(k) - prg_gde(k)) &
+                      * orho
+
+!..Cloud water tendency
+         qcten(k) = qcten(k) + (-prr_wau(k) - pri_wfz(k) &
+                      - prr_rcw(k) - prs_scw(k) - prg_scw(k) &
+                      - prg_gcw(k)) &
+                      * orho
+
+!..Cloud ice mixing ratio tendency
+         qiten(k) = qiten(k) + (pri_inu(k) + pri_ihm(k) &
+                      + pri_wfz(k) + pri_rfz(k) + pri_ide(k) &
+                      - prs_iau(k) - prs_sci(k) - pri_rci(k)) &
+                      * orho
+
+!..Cloud ice number tendency.
+         niten(k) = niten(k) + (pni_inu(k) + pni_ihm(k) &
+                      + pni_wfz(k) + pni_rfz(k) + pni_ide(k) &
+                      - pni_iau(k) - pni_sci(k) - pni_rci(k)) &
+                      * orho
+
+!..Cloud ice mass/number balance; keep mass-wt mean size between 0.15*D0s
+!.. and 5*D0s.  Also no more than 500 xtals per liter.
+         xri=AMAX1(R1,(qi1d(k) + qiten(k)*dts)*rho(k))
+         xni=AMAX1(1.,(ni1d(k) + niten(k)*dts)*rho(k))
+         if (xri.gt. R1) then
+           lami = (am_i*cig(2)*oig1*xni/xri)**obmi
+           ilami = 1./lami
+           Di = (bm_i + mu_i + 1.) * ilami
+           if (Di.lt. 0.15*D0s) then
+            lami = cie(2)/(0.15*D0s)
+            xni = AMIN1(5.E5, cig(1)*oig2*xri/am_i*lami**bm_i)
+            niten(k) = (xni-ni1d(k)*rho(k))*odts*orho
+           elseif (Di.gt. 5.0*D0s) then
+            lami = cie(2)/(5.0*D0s)
+            xni = cig(1)*oig2*xri/am_i*lami**bm_i
+            niten(k) = (xni-ni1d(k)*rho(k))*odts*orho
+           endif
+         else
+          niten(k) = -ni1d(k)*odts
+         endif
+         xni=AMAX1(0.,(ni1d(k) + niten(k)*dts)*rho(k))
+         if (xni.gt.5.E5) &
+                niten(k) = (5.E5-ni1d(k)*rho(k))*odts*orho
+
+!..Rain tendency
+         qrten(k) = qrten(k) + (prr_wau(k) + prr_rcw(k) &
+                      + prr_sml(k) + prr_gml(k) + prr_rcs(k) &
+                      + prr_rcg(k) - prg_rfz(k) &
+                      - pri_rfz(k) - prr_rci(k)) &
+                      * orho
+
+!..Snow tendency
+         qsten(k) = qsten(k) + (prs_iau(k) + prs_sde(k) &
+                      + prs_sci(k) + prs_scw(k) + prs_rcs(k) &
+                      + prs_ide(k) - prs_ihm(k) - prr_sml(k)) &
+                      * orho
+
+!..Graupel tendency
+         qgten(k) = qgten(k) + (prg_scw(k) + prg_rfz(k) &
+                      + prg_gde(k) + prg_rcg(k) + prg_gcw(k) &
+                      + prg_rci(k) + prg_rcs(k) - prg_ihm(k) &
+                      - prr_gml(k)) &
+                      * orho
+
+!..Temperature tendency
+         if (temp(k).lt.T_0) then
+          tten(k) = tten(k) &
+                    + ( lsub*ocp(k)*(pri_inu(k) + pri_ide(k) &
+                                     + prs_ide(k) + prs_sde(k) &
+                                     + prg_gde(k)) &
+                     + lfus2*ocp(k)*(pri_wfz(k) + pri_rfz(k) &
+                                     + prg_rfz(k) + prs_scw(k) &
+                                     + prg_scw(k) + prg_gcw(k) &
+                                     + prg_rcs(k) + prs_rcs(k) &
+                                     + prr_rci(k) + prg_rcg(k)) &
+                       )*orho * (1-IFDRY)
+         else
+          tten(k) = tten(k) &
+                    + ( lfus*ocp(k)*(-prr_sml(k) - prr_gml(k) &
+                                     - prr_rcg(k) - prr_rcs(k)) &
+                      + lsub*ocp(k)*(prs_sde(k) + prg_gde(k)) &
+                       )*orho * (1-IFDRY)
+         endif
+
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Update variables for TAU+1 before condensation & sedimention.
+!+---+-----------------------------------------------------------------+
+      do k = kts, kte
+         temp(k) = t1d(k) + DT*tten(k)
+         otemp = 1./temp(k)
+         tempc = temp(k) - 273.15
+         qv(k) = AMAX1(1.E-10, qv1d(k) + DT*qvten(k))
+         rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622))
+         rhof(k) = SQRT(RHO_NOT/rho(k))
+         rhof2(k) = SQRT(rhof(k))
+         qvs(k) = rslf(pres(k), temp(k))
+         ssatw(k) = qv(k)/qvs(k) - 1.
+         if (abs(ssatw(k)).lt. eps) ssatw(k) = 0.0
+         diffu(k) = 2.11E-5*(temp(k)/273.15)**1.94 * (101325./pres(k))
+         if (tempc .ge. 0.0) then
+            visco(k) = (1.718+0.0049*tempc)*1.0E-5
+         else
+            visco(k) = (1.718+0.0049*tempc-1.2E-5*tempc*tempc)*1.0E-5
+         endif
+         vsc2(k) = SQRT(rho(k)/visco(k))
+         lvap(k) = lvap0 + (2106.0 - 4218.0)*tempc
+         tcond(k) = (5.69 + 0.0168*tempc)*1.0E-5 * 418.936
+         ocp(k) = 1./(Cp*(1.+0.887*qv(k)))
+         lvt2(k)=lvap(k)*lvap(k)*ocp(k)*oRv*otemp*otemp
+
+         if ((qc1d(k) + qcten(k)*DT) .gt. R1) then
+            rc(k) = (qc1d(k) + qcten(k)*DT)*rho(k)
+            L_qc(k) = .true.
+         else
+            rc(k) = R1
+            L_qc(k) = .false.
+         endif
+
+         if ((qi1d(k) + qiten(k)*DT) .gt. R1) then
+            ri(k) = (qi1d(k) + qiten(k)*DT)*rho(k)
+            ni(k) = AMAX1(1., (ni1d(k) + niten(k)*DT)*rho(k))
+            L_qi(k) = .true. 
+         else
+            ri(k) = R1
+            ni(k) = 1.
+            L_qi(k) = .false.
+         endif
+
+         if ((qr1d(k) + qrten(k)*DT) .gt. R1) then
+            rr(k) = (qr1d(k) + qrten(k)*DT)*rho(k)
+            L_qr(k) = .true.
+         else
+            rr(k) = R1
+            L_qr(k) = .false.
+         endif
+               
+         if ((qs1d(k) + qsten(k)*DT) .gt. R1) then
+            rs(k) = (qs1d(k) + qsten(k)*DT)*rho(k)
+            L_qs(k) = .true.
+         else
+            rs(k) = R1
+            L_qs(k) = .false.
+         endif
+
+         if ((qg1d(k) + qgten(k)*DT) .gt. R1) then
+            rg(k) = (qg1d(k) + qgten(k)*DT)*rho(k)
+            L_qg(k) = .true.
+         else
+            rg(k) = R1
+            L_qg(k) = .false.
+         endif
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..With tendency-updated mixing ratios, recalculate snow moments and
+!.. intercepts/slopes of graupel and rain.
+!+---+-----------------------------------------------------------------+
+      if (.not. iiwarm) then
+      do k = kts, kte
+         if (.not. L_qs(k)) CYCLE
+         tc0 = AMIN1(-0.1, temp(k)-273.15)
+         smob(k) = rs(k)*oams
+
+!..All other moments based on reference, 2nd moment.  If bm_s.ne.2,
+!.. then we must compute actual 2nd moment and use as reference.
+         if (bm_s.gt.(2.0-1.e-3) .and. bm_s.lt.(2.0+1.e-3)) then
+            smo2(k) = smob(k)
+         else
+            loga_ = sa(1) + sa(2)*tc0 + sa(3)*bm_s &
+               + sa(4)*tc0*bm_s + sa(5)*tc0*tc0 &
+               + sa(6)*bm_s*bm_s + sa(7)*tc0*tc0*bm_s &
+               + sa(8)*tc0*bm_s*bm_s + sa(9)*tc0*tc0*tc0 &
+               + sa(10)*bm_s*bm_s*bm_s
+            a_ = 10.0**loga_
+            b_ = sb(1) + sb(2)*tc0 + sb(3)*bm_s &
+               + sb(4)*tc0*bm_s + sb(5)*tc0*tc0 &
+               + sb(6)*bm_s*bm_s + sb(7)*tc0*tc0*bm_s &
+               + sb(8)*tc0*bm_s*bm_s + sb(9)*tc0*tc0*tc0 &
+               + sb(10)*bm_s*bm_s*bm_s
+            smo2(k) = (smob(k)/a_)**(1./b_)
+         endif
+
+!..Calculate bm_s+1 (th) moment.  Useful for diameter calcs.
+         loga_ = sa(1) + sa(2)*tc0 + sa(3)*cse(1) &
+               + sa(4)*tc0*cse(1) + sa(5)*tc0*tc0 &
+               + sa(6)*cse(1)*cse(1) + sa(7)*tc0*tc0*cse(1) &
+               + sa(8)*tc0*cse(1)*cse(1) + sa(9)*tc0*tc0*tc0 &
+               + sa(10)*cse(1)*cse(1)*cse(1)
+         a_ = 10.0**loga_
+         b_ = sb(1)+ sb(2)*tc0 + sb(3)*cse(1) + sb(4)*tc0*cse(1) &
+              + sb(5)*tc0*tc0 + sb(6)*cse(1)*cse(1) &
+              + sb(7)*tc0*tc0*cse(1) + sb(8)*tc0*cse(1)*cse(1) &
+              + sb(9)*tc0*tc0*tc0 + sb(10)*cse(1)*cse(1)*cse(1)
+         smoc(k) = a_ * smo2(k)**b_
+
+!..Calculate bm_s+bv_s (th) moment.  Useful for sedimentation.
+         loga_ = sa(1) + sa(2)*tc0 + sa(3)*cse(14) &
+               + sa(4)*tc0*cse(14) + sa(5)*tc0*tc0 &
+               + sa(6)*cse(14)*cse(14) + sa(7)*tc0*tc0*cse(14) &
+               + sa(8)*tc0*cse(14)*cse(14) + sa(9)*tc0*tc0*tc0 &
+               + sa(10)*cse(14)*cse(14)*cse(14)
+         a_ = 10.0**loga_
+         b_ = sb(1)+ sb(2)*tc0 + sb(3)*cse(14) + sb(4)*tc0*cse(14) &
+              + sb(5)*tc0*tc0 + sb(6)*cse(14)*cse(14) &
+              + sb(7)*tc0*tc0*cse(14) + sb(8)*tc0*cse(14)*cse(14) &
+              + sb(9)*tc0*tc0*tc0 + sb(10)*cse(14)*cse(14)*cse(14)
+         smod(k) = a_ * smo2(k)**b_
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Calculate y-intercept, slope values for graupel.
+!+---+-----------------------------------------------------------------+
+      N0_min = gonv_max
+      do k = kte, kts, -1
+         if (.not. L_qg(k)) CYCLE
+         N0_exp = 100.0*rho(k)/rg(k)
+         N0_exp = AMAX1(gonv_min, AMIN1(N0_exp, gonv_max))
+         N0_min = AMIN1(N0_exp, N0_min)
+         N0_exp = N0_min
+         lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1
+         lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg
+         ilamg(k) = 1./lamg
+         N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2)
+      enddo
+
+      endif
+
+!+---+-----------------------------------------------------------------+
+!..Calculate y-intercept, slope values for rain.
+!+---+-----------------------------------------------------------------+
+      N0_min = ronv_max
+      do k = kte, kts, -1
+         if (.not. L_qr(k)) CYCLE
+         N0_exp = ronv_c1*tanh(ronv_c0*(ronv_r0-rr(k))) + ronv_c2
+         N0_min = AMIN1(N0_exp, N0_min)
+         N0_exp = N0_min
+         lam_exp = (N0_exp*am_r*crg(1)/rr(k))**ore1
+         lamr = lam_exp * (crg(3)*org2*org1)**obmr
+         mvd_r(k) = (3.0+mu_r+0.672) / lamr
+         if (mvd_r(k) .gt. 3.e-3) then
+            mvd_r(k) = 3.e-3
+            lamr = (3.0+mu_r+0.672) / 3.e-3
+            lam_exp = lamr * (crg(3)*org2*org1)**bm_r
+            N0_exp = org1*rr(k)/am_r * lam_exp**cre(1)
+         endif
+         N0_r(k) = N0_exp/(crg(2)*lam_exp) * lamr**cre(2)
+         ilamr(k) = 1./lamr
+      enddo
+
+      if (.not. iiwarm) then
+      k_0 = kts
+      melti = .false.
+      do k = kte-1, kts, -1
+         if ( (temp(k).gt. T_0) .and. (rr(k).gt. 0.001e-3) &
+                   .and. ((rs(k+1)+rg(k+1)).gt. 0.01e-3) ) then
+            k_0 = MAX(k+1, k_0)
+            melti=.true.
+            goto 137
+         endif
+      enddo
+ 137  continue
+
+      if (melti) then
+!.. Locate bottom of melting layer (if any).
+         kbot = kts
+         do k = k_0-1, kts, -1
+            if ( (rs(k)+rg(k)).lt. 0.01e-3) goto 138
+         enddo
+ 138     continue
+         kbot = MAX(k, kts)
+
+!.. Compute melted snow/graupel equiv water diameter one K-level above
+!.. melting.  Set starting rain mvd to either 50 microns or max from
+!.. higher up in column.
+         if (L_qs(k_0)) then
+          Ds = smoc(k_0) / smob(k_0)
+          Ds_m = (am_s*Ds**bm_s / am_r)**obmr
+         else
+          Ds_m = 1.0e-6
+         endif
+         if (L_qg(k_0)) then
+          Dg = (bm_g + mu_g + 1.) * ilamg(k_0)
+          Dg_m = (am_g*Dg**bm_g / am_r)**obmr
+         else
+          Dg_m = 1.0e-6
+         endif
+         r_mvd1 = mvd_r(k_0)
+         r_mvd2 = AMIN1(AMAX1(Ds_m, Dg_m, r_mvd1+1.e-6, mvd_r(kbot)), &
+                        3.e-3)
+
+!.. Within melting layer, apply linear increase of rain mvd from r_mvd1
+!.. to equiv melted snow/graupel value (r_mvd2).  So, by the bottom of
+!.. the melting layer, the rain will have an mvd that matches that from
+!.. melted snow and/or graupel.
+         if (kbot.gt. 2) then
+         do k = k_0-1, kbot, -1
+            if (.not. L_qr(k)) CYCLE
+            xkrat = REAL(k_0-k)/REAL(k_0-kbot)
+            mvd_r(k) = AMAX1(mvd_r(k), xkrat*(r_mvd2-r_mvd1)+r_mvd1)
+            lamr = (4.0+mu_r) / mvd_r(k)
+            lam_exp = lamr * (crg(3)*org2*org1)**bm_r
+            N0_exp = org1*rr(k)/am_r * lam_exp**cre(1)
+            N0_exp = AMAX1(ronv_min, AMIN1(N0_exp, ronv_max))
+            lam_exp = (N0_exp*am_r*crg(1)/rr(k))**ore1
+            lamr = lam_exp * (crg(3)*org2*org1)**obmr
+            mvd_r(k) = (3.0+mu_r+0.672) / lamr
+            N0_r(k) = rr(k)*lamr**cre(3) / (am_r*crg(3))
+            ilamr(k) = 1./lamr
+         enddo
+
+!.. Below melting layer, hold N0_r constant unless changes to mixing
+!.. ratio increase mvd beyond 3 mm threshold, then adjust slope and
+!.. intercept to cap mvd at 3 mm.  In future, we could lower N0_r to
+!.. account for self-collection or other sinks.
+         do k = kbot-1, kts, -1
+            if (.not. L_qr(k)) CYCLE
+            N0_r(k) = AMIN1(N0_r(k), N0_r(kbot))
+            lamr = (N0_r(k)*am_r*crg(3)/rr(k))**(1./cre(3))
+            lam_exp = lamr * (crg(3)*org2*org1)**bm_r
+            N0_exp = org1*rr(k)/am_r * lam_exp**cre(1)
+            N0_exp = AMAX1(ronv_min, AMIN1(N0_exp, ronv_max))
+            lam_exp = (N0_exp*am_r*crg(1)/rr(k))**ore1
+            lamr = lam_exp * (crg(3)*org2*org1)**obmr
+            mvd_r(k) = (3.0+mu_r+0.672) / lamr
+            if (mvd_r(k) .gt. 3.e-3) then
+               mvd_r(k) = 3.e-3
+               lamr = (3.0+mu_r+0.672) / mvd_r(k)
+            endif
+            N0_r(k) = rr(k)*lamr**cre(3) / (am_r*crg(3))
+            ilamr(k) = 1./lamr
+         enddo
+         endif
+
+
+      endif
+      endif
+
+!+---+-----------------------------------------------------------------+
+!..Cloud water condensation and evaporation.  Newly formulated using
+!.. Newton-Raphson iterations (3 should suffice) as provided by B. Hall.
+!+---+-----------------------------------------------------------------+
+      do k = kts, kte
+         if ( (ssatw(k).gt. eps) .or. (ssatw(k).lt. -eps .and. &
+                   L_qc(k)) ) then
+          clap = (qv(k)-qvs(k))/(1. + lvt2(k)*qvs(k))
+          do n = 1, 3
+             fcd = qvs(k)* EXP(lvt2(k)*clap) - qv(k) + clap
+             dfcd = qvs(k)*lvt2(k)* EXP(lvt2(k)*clap) + 1.
+             clap = clap - fcd/dfcd
+          enddo
+          xrc = rc(k) + clap
+          if (xrc.gt. 0.0) then
+             prw_vcd(k) = clap*odt
+          else
+             prw_vcd(k) = -rc(k)/rho(k)*odt
+          endif
+
+          qcten(k) = qcten(k) + prw_vcd(k)
+          qvten(k) = qvten(k) - prw_vcd(k)
+          tten(k) = tten(k) + lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY)
+          rc(k) = AMAX1(R1, (qc1d(k) + DT*qcten(k))*rho(k))
+          qv(k) = AMAX1(1.E-10, qv1d(k) + DT*qvten(k))
+          temp(k) = t1d(k) + DT*tten(k)
+          rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622))
+          qvs(k) = rslf(pres(k), temp(k))
+          ssatw(k) = qv(k)/qvs(k) - 1.
+         endif
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!.. If still subsaturated, allow rain to evaporate, following
+!.. Srivastava & Coen (1992).
+!+---+-----------------------------------------------------------------+
+      do k = kts, kte
+         if ( (ssatw(k).lt. -eps) .and. L_qr(k) &
+                     .and. (.not.(prw_vcd(k).gt. 0.)) ) then
+          tempc = temp(k) - 273.15
+          otemp = 1./temp(k)
+          rhof(k) = SQRT(RHO_NOT/rho(k))
+          rhof2(k) = SQRT(rhof(k))
+          diffu(k) = 2.11E-5*(temp(k)/273.15)**1.94 * (101325./pres(k))
+          if (tempc .ge. 0.0) then
+             visco(k) = (1.718+0.0049*tempc)*1.0E-5
+          else
+             visco(k) = (1.718+0.0049*tempc-1.2E-5*tempc*tempc)*1.0E-5
+          endif
+          vsc2(k) = SQRT(rho(k)/visco(k))
+          lvap(k) = lvap0 + (2106.0 - 4218.0)*tempc
+          tcond(k) = (5.69 + 0.0168*tempc)*1.0E-5 * 418.936
+          ocp(k) = 1./(Cp*(1.+0.887*qv(k)))
+
+          rvs = rho(k)*qvs(k)
+          rvs_p = rvs*otemp*(lvap(k)*otemp*oRv - 1.)
+          rvs_pp = rvs * ( otemp*(lvap(k)*otemp*oRv - 1.) &
+                          *otemp*(lvap(k)*otemp*oRv - 1.) &
+                          + (-2.*lvap(k)*otemp*otemp*otemp*oRv) &
+                          + otemp*otemp)
+          gamsc = lvap(k)*diffu(k)/tcond(k) * rvs_p
+          alphsc = 0.5*(gamsc/(1.+gamsc))*(gamsc/(1.+gamsc)) &
+                     * rvs_pp/rvs_p * rvs/rvs_p
+          alphsc = AMAX1(1.E-9, alphsc)
+          xsat = ssatw(k)
+          if (xsat.lt. -1.E-9) xsat = -1.E-9
+          t1_evap = 2.*PI*( 1.0 - alphsc*xsat  &
+                 + 2.*alphsc*alphsc*xsat*xsat  &
+                 - 5.*alphsc*alphsc*alphsc*xsat*xsat*xsat ) &
+                 / (1.+gamsc)
+
+          lamr = 1./ilamr(k)
+          prv_rev(k) = t1_evap*diffu(k)*(-ssatw(k))*N0_r(k)*rvs &
+              * (t1_qr_ev*ilamr(k)**cre(10) &
+              + t2_qr_ev*vsc2(k)*rhof2(k)/(lamr+0.5*fv_r)**cre(11))
+          prv_rev(k) = AMIN1(rr(k)/rho(k)*odts, &
+                               prv_rev(k)/rho(k))
+
+          qrten(k) = qrten(k) - prv_rev(k)
+          qvten(k) = qvten(k) + prv_rev(k)
+          tten(k) = tten(k) - lvap(k)*ocp(k)*prv_rev(k)*(1-IFDRY)
+
+          rr(k) = AMAX1(R1, (qr1d(k) + DT*qrten(k))*rho(k))
+          qv(k) = AMAX1(1.E-10, qv1d(k) + DT*qvten(k))
+          temp(k) = t1d(k) + DT*tten(k)
+          rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622))
+         endif
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Find max terminal fallspeed (distribution mass-weighted mean
+!.. velocity) and use it to determine if we need to split the timestep
+!.. (var nstep>1).  Either way, only bother to do sedimentation below
+!.. 1st level that contains any sedimenting particles (k=ksed1 on down).
+!+---+-----------------------------------------------------------------+
+      nstep = 0
+      ksed1 = 0
+      do k = kte+1, kts, -1
+         vtrk(k) = 0.
+         vtik(k) = 0.
+         vtnk(k) = 0.
+         vtsk(k) = 0.
+         vtgk(k) = 0.
+      enddo
+      do k = kte, kts, -1
+         vtr = 0.
+         vti = 0.
+         vts = 0.
+         vtg = 0.
+         rhof(k) = SQRT(RHO_NOT/rho(k))
+
+         if (rr(k).gt. R2) then
+          lamr = 1./ilamr(k)
+          vtr = rhof(k)*av_r*crg(6)*org3 * (lamr/(lamr+fv_r))**cre(3) &
+                      / (lamr+fv_r)**bv_r
+          vtrk(k) = vtr
+         endif
+
+         if (.not. iiwarm) then
+          if (ri(k).gt. R2) then
+           lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi
+           ilami = 1./lami
+           vti = rhof(k)*av_i*cig(3)*oig2 * ilami**bv_i
+           vtik(k) = vti
+           vti = rhof(k)*av_i*cig(4)*oig1 * ilami**bv_i
+           vtnk(k) = vti
+          endif
+
+          if (rs(k).gt. R2) then
+           Ds = smoc(k) / smob(k)
+           Mrat = 1./Ds
+           ils1 = 1./(Mrat*Lam0 + fv_s)
+           ils2 = 1./(Mrat*Lam1 + fv_s)
+           t1_vts = Kap0*csg(4)*ils1**cse(4)
+           t2_vts = Kap1*Mrat**mu_s*csg(10)*ils2**cse(10)
+           t3_vts = Kap0*csg(1)*ils1**cse(1)
+           t4_vts = Kap1*Mrat**mu_s*csg(7)*ils2**cse(7)
+           vts = rhof(k)*av_s * (t1_vts+t2_vts)/(t3_vts+t4_vts)
+           if (temp(k).gt. T_0) then
+            vtsk(k) = AMAX1(vts*vts_boost(k), vtrk(k))
+           else
+            vtsk(k) = vts*vts_boost(k)
+           endif
+          endif
+
+          if (rg(k).gt. R2) then
+           vtg = rhof(k)*av_g*cgg(6)*ogg3 * ilamg(k)**bv_g
+           if (temp(k).gt. T_0) then
+            vtgk(k) = AMAX1(vtg, vtrk(k))
+           else
+            vtgk(k) = vtg
+           endif
+          endif
+         endif
+
+         rgvm = AMAX1(vtik(k), vtrk(k), vtsk(k), vtgk(k))
+         if (rgvm .gt. 1.E-3) then
+            ksed1 = MAX(ksed1, k)
+            delta_tp = dzq(k)/rgvm
+            nstep = MAX(nstep, INT(DT/delta_tp + 1.))
+         endif
+      enddo
+      if (ksed1 .eq. kte) ksed1 = kte-1
+      if (nstep .gt. 0) onstep = 1./REAL(nstep)
+
+!+---+-----------------------------------------------------------------+
+!..Sedimentation of mixing ratio is the integral of v(D)*m(D)*N(D)*dD,
+!.. whereas neglect m(D) term for number concentration.  Therefore,
+!.. cloud ice has proper differential sedimentation.
+!+---+-----------------------------------------------------------------+
+      do n = 1, nstep
+         do k = kte, kts, -1
+            sed_r(k) = vtrk(k)*rr(k)
+            sed_i(k) = vtik(k)*ri(k)
+            sed_n(k) = vtnk(k)*ni(k)
+            sed_g(k) = vtgk(k)*rg(k)
+            sed_s(k) = vtsk(k)*rs(k)
+         enddo
+         k = kte
+         odzq = 1./dzq(k)
+         orho = 1./rho(k)
+         qrten(k) = qrten(k) - sed_r(k)*odzq*onstep*orho
+         qiten(k) = qiten(k) - sed_i(k)*odzq*onstep*orho
+         niten(k) = niten(k) - sed_n(k)*odzq*onstep*orho
+         qgten(k) = qgten(k) - sed_g(k)*odzq*onstep*orho
+         qsten(k) = qsten(k) - sed_s(k)*odzq*onstep*orho
+         rr(k) = AMAX1(R1, rr(k) - sed_r(k)*odzq*DT*onstep)
+         ri(k) = AMAX1(R1, ri(k) - sed_i(k)*odzq*DT*onstep)
+         ni(k) = AMAX1(1., ni(k) - sed_n(k)*odzq*DT*onstep)
+         rg(k) = AMAX1(R1, rg(k) - sed_g(k)*odzq*DT*onstep)
+         rs(k) = AMAX1(R1, rs(k) - sed_s(k)*odzq*DT*onstep)
+         do k = ksed1, kts, -1
+            odzq = 1./dzq(k)
+            orho = 1./rho(k)
+            qrten(k) = qrten(k) + (sed_r(k+1)-sed_r(k)) &
+                                               *odzq*onstep*orho
+            qiten(k) = qiten(k) + (sed_i(k+1)-sed_i(k)) &
+                                               *odzq*onstep*orho
+            niten(k) = niten(k) + (sed_n(k+1)-sed_n(k)) &
+                                               *odzq*onstep*orho
+            qgten(k) = qgten(k) + (sed_g(k+1)-sed_g(k)) &
+                                               *odzq*onstep*orho
+            qsten(k) = qsten(k) + (sed_s(k+1)-sed_s(k)) &
+                                               *odzq*onstep*orho
+            rr(k) = AMAX1(R1, rr(k) + (sed_r(k+1)-sed_r(k)) &
+                                           *odzq*DT*onstep)
+            ri(k) = AMAX1(R1, ri(k) + (sed_i(k+1)-sed_i(k)) &
+                                           *odzq*DT*onstep)
+            ni(k) = AMAX1(1., ni(k) + (sed_n(k+1)-sed_n(k)) &
+                                           *odzq*DT*onstep)
+            rg(k) = AMAX1(R1, rg(k) + (sed_g(k+1)-sed_g(k)) &
+                                           *odzq*DT*onstep)
+            rs(k) = AMAX1(R1, rs(k) + (sed_s(k+1)-sed_s(k)) &
+                                           *odzq*DT*onstep)
+         enddo
+
+!+---+-----------------------------------------------------------------+
+!..Precipitation reaching the ground.
+!+---+-----------------------------------------------------------------+
+         pptrain = pptrain + sed_r(kts)*DT*onstep
+         pptsnow = pptsnow + sed_s(kts)*DT*onstep
+         pptgraul = pptgraul + sed_g(kts)*DT*onstep
+         pptice = pptice + sed_i(kts)*DT*onstep
+
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!.. Instantly melt any cloud ice into cloud water if above 0C and
+!.. instantly freeze any cloud water found below HGFR.
+!+---+-----------------------------------------------------------------+
+      if (.not. iiwarm) then
+      do k = kts, kte
+         xri = AMAX1(0.0, qi1d(k) + qiten(k)*DT)
+         if ( (temp(k).gt. T_0) .and. (xri.gt. 0.0) ) then
+          qcten(k) = qcten(k) + xri*odt
+          qiten(k) = -qi1d(k)*odt
+          niten(k) = -ni1d(k)*odt
+          tten(k) = tten(k) - lfus*ocp(k)*xri*odt*(1-IFDRY)
+         endif
+
+         xrc = AMAX1(0.0, qc1d(k) + qcten(k)*DT)
+         if ( (temp(k).lt. HGFR) .and. (xrc.gt. 0.0) ) then
+          lfus2 = lsub - lvap(k)
+          qiten(k) = qiten(k) + xrc*odt
+          niten(k) = niten(k) + xrc/(2.*xm0i)*odt
+          qcten(k) = -xrc*odt
+          tten(k) = tten(k) + lfus2*ocp(k)*xrc*odt*(1-IFDRY)
+         endif
+      enddo
+      endif
+
+!+---+-----------------------------------------------------------------+
+!.. All tendencies computed, apply and pass back final values to parent.
+!+---+-----------------------------------------------------------------+
+      do k = kts, kte
+         t1d(k)  = t1d(k) + tten(k)*DT
+         qv1d(k) = AMAX1(1.E-10, qv1d(k) + qvten(k)*DT)
+         qc1d(k) = qc1d(k) + qcten(k)*DT
+         if (qc1d(k) .le. R1) qc1d(k) = 0.0
+         qi1d(k) = qi1d(k) + qiten(k)*DT
+         ni1d(k) = ni1d(k) + niten(k)*DT
+         if (qi1d(k) .le. R1) then
+           qi1d(k) = 0.0
+           ni1d(k) = 0.0
+         else
+           if (ni1d(k) .gt. 0.01) then
+            lami = (am_i*cig(2)*oig1*ni1d(k)/qi1d(k))**obmi
+            ilami = 1./lami
+            Di = (bm_i + mu_i + 1.) * ilami
+            if (Di.lt. 0.15*D0s) then
+             lami = cie(2)/(0.15*D0s)
+             ni1d(k) = AMIN1(5.E5, cig(1)*oig2*qi1d(k)/am_i*lami**bm_i)
+            elseif (Di.gt. 5.0*D0s) then
+             lami = cie(2)/(5.0*D0s)
+             ni1d(k) = cig(1)*oig2*qi1d(k)/am_i*lami**bm_i
+            endif
+           else
+            lami = cie(2)/(0.15*D0s)
+            ni1d(k) = AMIN1(5.E5, cig(1)*oig2*qi1d(k)/am_i*lami**bm_i)
+           endif
+         endif
+         qr1d(k) = qr1d(k) + qrten(k)*DT
+         if (qr1d(k) .le. R1) qr1d(k) = 0.0
+         qs1d(k) = qs1d(k) + qsten(k)*DT
+         if (qs1d(k) .le. R1) qs1d(k) = 0.0
+         qg1d(k) = qg1d(k) + qgten(k)*DT
+         if (qg1d(k) .le. R1) qg1d(k) = 0.0
+      enddo
+
+      end subroutine mp_thompson
+!+---+-----------------------------------------------------------------+
+!
+
+!+---+-----------------------------------------------------------------+
+!..Creation of the lookup tables and support functions found below here.
+!+---+-----------------------------------------------------------------+
+!..Rain collecting graupel (and inverse).  Explicit SCE integration.
+!+---+-----------------------------------------------------------------+
+
+      subroutine qr_acr_qg
+
+      implicit none
+
+!..Local variables
+      INTEGER:: i, j, k, n, n2
+      INTEGER, PARAMETER:: nbr = 100
+      INTEGER, PARAMETER:: nbg = 100
+      DOUBLE PRECISION, DIMENSION(nbg):: Dg, vg, N_g, dtg
+      DOUBLE PRECISION, DIMENSION(nbr):: Dr, vr, N_r, dtr
+      DOUBLE PRECISION, DIMENSION(nbg+1):: Dx
+      DOUBLE PRECISION, DIMENSION(nbr+1):: Dy
+      DOUBLE PRECISION:: N0_exp, N0_r, N0_g, lam_exp, lamg, lamr, N0_s
+      DOUBLE PRECISION:: massg, massr, dvg, dvr, t1, t2, z1, z2
+
+!+---+
+
+!..Create bins of rain (from min diameter up to 5 mm).
+      Dy(1) = D0r*1.0d0
+      Dy(nbr+1) = 0.005d0
+      do n2 = 2, nbr
+         Dy(n2) = DEXP(DFLOAT(n2-1)/DFLOAT(nbr) &
+                  *DLOG(Dy(nbr+1)/Dy(1)) +DLOG(Dy(1)))
+      enddo
+      do n2 = 1, nbr
+         Dr(n2) = DSQRT(Dy(n2)*Dy(n2+1))
+         vr(n2) = av_r*Dr(n2)**bv_r * DEXP(-fv_r*Dr(n2))
+         dtr(n2) = Dy(n2+1) - Dy(n2)
+      enddo
+
+!..Create bins of graupel (from min diameter up to 5 cm).
+      Dx(1) = D0g*1.0d0
+      Dx(nbg+1) = 0.05d0
+      do n = 2, nbg
+         Dx(n) = DEXP(DFLOAT(n-1)/DFLOAT(nbg) &
+                  *DLOG(Dx(nbg+1)/Dx(1)) +DLOG(Dx(1)))
+      enddo
+      do n = 1, nbg
+         Dg(n) = DSQRT(Dx(n)*Dx(n+1))
+         vg(n) = av_g*Dg(n)**bv_g
+         dtg(n) = Dx(n+1) - Dx(n)
+      enddo
+
+      do k = 1, ntb_r
+         do j = 1, ntb_r1
+
+            lam_exp = (N0r_exp(j)*am_r*crg(1)/r_r(k))**ore1
+            lamr = lam_exp * (crg(3)*org2*org1)**obmr
+            N0_r = N0r_exp(j)/(crg(2)*lam_exp) * lamr**cre(2)
+            do n2 = 1, nbr
+               N_r(n2) = N0_r*Dr(n2)**mu_r *DEXP(-lamr*Dr(n2))*dtr(n2)
+            enddo
+
+            do i = 1, ntb_g
+               N0_exp = 100.0d0/r_g(i)
+               N0_exp = DMAX1(gonv_min*1.d0,DMIN1(N0_exp,gonv_max*1.d0))
+               lam_exp = (N0_exp*am_g*cgg(1)/r_g(i))**oge1
+               lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg
+               N0_g = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2)
+               do n = 1, nbg
+                  N_g(n) = N0_g*Dg(n)**mu_g * DEXP(-lamg*Dg(n))*dtg(n)
+               enddo
+
+               t1 = 0.0d0
+               t2 = 0.0d0
+               z1 = 0.0d0
+               z2 = 0.0d0
+               do n2 = 1, nbr
+                  massr = am_r * Dr(n2)**bm_r
+                  do n = 1, nbg
+                     massg = am_g * Dg(n)**bm_g
+
+                     dvg = 0.5d0*((vr(n2) - vg(n)) + DABS(vr(n2)-vg(n)))
+                     dvr = 0.5d0*((vg(n) - vr(n2)) + DABS(vg(n)-vr(n2)))
+
+                     t1 = t1+ PI*.25*Ef_rg*(Dg(n)+Dr(n2))*(Dg(n)+Dr(n2)) &
+                         *dvg*massg * N_g(n)* N_r(n2)
+                     z1 = z1+ PI*.25*Ef_rg*(Dg(n)+Dr(n2))*(Dg(n)+Dr(n2)) &
+                         *dvg*massr * N_g(n)* N_r(n2)
+
+                     t2 = t2+ PI*.25*Ef_rg*(Dg(n)+Dr(n2))*(Dg(n)+Dr(n2)) &
+                         *dvr*massr * N_g(n)* N_r(n2)
+                     z2 = z2+ PI*.25*Ef_rg*(Dg(n)+Dr(n2))*(Dg(n)+Dr(n2)) &
+                         *dvr*massg * N_g(n)* N_r(n2)
+                  enddo
+ 97               continue
+               enddo
+               tcg_racg(i,j,k) = t1
+               tmr_racg(i,j,k) = DMIN1(z1, r_r(k)*1.0d0)
+               tcr_gacr(i,j,k) = t2
+               tmg_gacr(i,j,k) = z2
+            enddo
+         enddo
+      enddo
+
+      end subroutine qr_acr_qg
+!+---+-----------------------------------------------------------------+
+!
+
+!+---+-----------------------------------------------------------------+
+!..Rain collecting snow (and inverse).  Explicit SCE integration.
+!+---+-----------------------------------------------------------------+
+
+      subroutine qr_acr_qs
+
+      implicit none
+
+!..Local variables
+      INTEGER:: i, j, k, m, n, n2
+      INTEGER, PARAMETER:: nbr = 100
+      INTEGER, PARAMETER:: nbs = 100
+      DOUBLE PRECISION, DIMENSION(nbr):: Dr, vr, D1, N_r, dtr
+      DOUBLE PRECISION, DIMENSION(nbs):: Ds, vs, N_s, dts
+      DOUBLE PRECISION, DIMENSION(nbr+1):: Dy
+      DOUBLE PRECISION, DIMENSION(nbs+1):: Dx
+      DOUBLE PRECISION:: loga_, a_, b_, second, M0, M2, M3, Mrat, oM3
+      DOUBLE PRECISION:: N0_r, lam_exp, lamr, slam1, slam2
+      DOUBLE PRECISION:: dvs, dvr, masss, massr
+      DOUBLE PRECISION:: t1, t2, t3, t4, z1, z2, z3, z4
+
+!+---+
+
+!..Create bins of rain (from min diameter up to 5 mm).
+      Dy(1) = D0r*1.0d0
+      Dy(nbr+1) = 0.005d0
+      do n2 = 2, nbr
+         Dy(n2) = DEXP(DFLOAT(n2-1)/DFLOAT(nbr) &
+                  *DLOG(Dy(nbr+1)/Dy(1)) +DLOG(Dy(1)))
+      enddo
+      do n2 = 1, nbr
+         Dr(n2) = DSQRT(Dy(n2)*Dy(n2+1))  
+         vr(n2) = av_r*Dr(n2)**bv_r * DEXP(-fv_r*Dr(n2))
+         D1(n2) = (vr(n2)/av_s)**(1./bv_s)
+         dtr(n2) = Dy(n2+1) - Dy(n2)
+      enddo
+
+!..Create bins of snow (from min diameter up to 2 cm).
+      Dx(1) = D0s*1.0d0
+      Dx(nbs+1) = 0.02d0
+      do n = 2, nbs
+         Dx(n) = DEXP(DFLOAT(n-1)/DFLOAT(nbs) &
+                  *DLOG(Dx(nbs+1)/Dx(1)) +DLOG(Dx(1)))
+      enddo
+      do n = 1, nbs
+         Ds(n) = DSQRT(Dx(n)*Dx(n+1))
+         vs(n) = 1.5*av_s*Ds(n)**bv_s * DEXP(-fv_s*Ds(n))
+         dts(n) = Dx(n+1) - Dx(n)
+      enddo
+
+      do m = 1, ntb_r
+      do k = 1, ntb_r1
+         lam_exp = (N0r_exp(k)*am_r*crg(1)/r_r(m))**ore1
+         lamr = lam_exp * (crg(3)*org2*org1)**obmr
+         N0_r = N0r_exp(k)/(crg(2)*lam_exp) * lamr**cre(2)
+         do n2 = 1, nbr
+            N_r(n2) = N0_r*Dr(n2)**mu_r * DEXP(-lamr*Dr(n2))*dtr(n2)
+         enddo
+
+         do j = 1, ntb_t
+            do i = 1, ntb_s
+
+!..From the bm_s moment, compute plus one moment.  If we are not
+!.. using bm_s=2, then we must transform to the pure 2nd moment
+!.. (variable called "second") and then to the bm_s+1 moment.
+
+               M2 = r_s(i)*oams *1.0d0
+               if (bm_s.gt.2.0-1.E-3 .and. bm_s.lt.2.0+1.E-3) then
+                  loga_ = sa(1) + sa(2)*Tc(j) + sa(3)*bm_s &
+                     + sa(4)*Tc(j)*bm_s + sa(5)*Tc(j)*Tc(j) &
+                     + sa(6)*bm_s*bm_s + sa(7)*Tc(j)*Tc(j)*bm_s &
+                     + sa(8)*Tc(j)*bm_s*bm_s + sa(9)*Tc(j)*Tc(j)*Tc(j) &
+                     + sa(10)*bm_s*bm_s*bm_s
+                  a_ = 10.0**loga_
+                  b_ = sb(1) + sb(2)*Tc(j) + sb(3)*bm_s &
+                     + sb(4)*Tc(j)*bm_s + sb(5)*Tc(j)*Tc(j) &
+                     + sb(6)*bm_s*bm_s + sb(7)*Tc(j)*Tc(j)*bm_s &
+                     + sb(8)*Tc(j)*bm_s*bm_s + sb(9)*Tc(j)*Tc(j)*Tc(j) &
+                     + sb(10)*bm_s*bm_s*bm_s
+                  second = (M2/a_)**(1./b_)
+               else
+                  second = M2
+               endif
+
+               loga_ = sa(1) + sa(2)*Tc(j) + sa(3)*cse(1) &
+                  + sa(4)*Tc(j)*cse(1) + sa(5)*Tc(j)*Tc(j) &
+                  + sa(6)*cse(1)*cse(1) + sa(7)*Tc(j)*Tc(j)*cse(1) &
+                  + sa(8)*Tc(j)*cse(1)*cse(1) + sa(9)*Tc(j)*Tc(j)*Tc(j) &
+                  + sa(10)*cse(1)*cse(1)*cse(1)
+               a_ = 10.0**loga_
+               b_ = sb(1)+sb(2)*Tc(j)+sb(3)*cse(1) + sb(4)*Tc(j)*cse(1) &
+                  + sb(5)*Tc(j)*Tc(j) + sb(6)*cse(1)*cse(1) &
+                  + sb(7)*Tc(j)*Tc(j)*cse(1) + sb(8)*Tc(j)*cse(1)*cse(1) &
+                  + sb(9)*Tc(j)*Tc(j)*Tc(j)+sb(10)*cse(1)*cse(1)*cse(1)
+               M3 = a_ * second**b_
+
+               oM3 = 1./M3
+               Mrat = M2*(M2*oM3)*(M2*oM3)*(M2*oM3)
+               M0   = (M2*oM3)**mu_s
+               slam1 = M2 * oM3 * Lam0
+               slam2 = M2 * oM3 * Lam1
+
+               do n = 1, nbs
+                  N_s(n) = Mrat*(Kap0*DEXP(-slam1*Ds(n)) &
+                      + Kap1*M0*Ds(n)**mu_s * DEXP(-slam2*Ds(n)))*dts(n)
+               enddo
+
+               t1 = 0.0d0
+               t2 = 0.0d0
+               t3 = 0.0d0
+               t4 = 0.0d0
+               z1 = 0.0d0
+               z2 = 0.0d0
+               z3 = 0.0d0
+               z4 = 0.0d0
+               do n2 = 1, nbr
+                  massr = am_r * Dr(n2)**bm_r
+                  do n = 1, nbs
+                     masss = am_s * Ds(n)**bm_s
+      
+                     dvs = 0.5d0*((vr(n2) - vs(n)) + DABS(vr(n2)-vs(n)))
+                     dvr = 0.5d0*((vs(n) - vr(n2)) + DABS(vs(n)-vr(n2)))
+
+                     if (massr .gt. masss) then
+                     t1 = t1+ PI*.25*Ef_rs*(Ds(n)+Dr(n2))*(Ds(n)+Dr(n2)) &
+                         *dvs*masss * N_s(n)* N_r(n2)
+                     z1 = z1+ PI*.25*Ef_rs*(Ds(n)+Dr(n2))*(Ds(n)+Dr(n2)) &
+                         *dvs*massr * N_s(n)* N_r(n2)
+                     else
+                     t3 = t3+ PI*.25*Ef_rs*(Ds(n)+Dr(n2))*(Ds(n)+Dr(n2)) &
+                         *dvs*masss * N_s(n)* N_r(n2)
+                     z3 = z3+ PI*.25*Ef_rs*(Ds(n)+Dr(n2))*(Ds(n)+Dr(n2)) &
+                         *dvs*massr * N_s(n)* N_r(n2)
+                     endif
+
+                     if (massr .gt. masss) then
+                     t2 = t2+ PI*.25*Ef_rs*(Ds(n)+Dr(n2))*(Ds(n)+Dr(n2)) &
+                         *dvr*massr * N_s(n)* N_r(n2)
+                     z2 = z2+ PI*.25*Ef_rs*(Ds(n)+Dr(n2))*(Ds(n)+Dr(n2)) &
+                         *dvr*masss * N_s(n)* N_r(n2)
+                     else
+                     t4 = t4+ PI*.25*Ef_rs*(Ds(n)+Dr(n2))*(Ds(n)+Dr(n2)) &
+                         *dvr*massr * N_s(n)* N_r(n2)
+                     z4 = z4+ PI*.25*Ef_rs*(Ds(n)+Dr(n2))*(Ds(n)+Dr(n2)) &
+                         *dvr*masss * N_s(n)* N_r(n2)
+                     endif
+
+                  enddo
+               enddo
+               tcs_racs1(i,j,k,m) = t1
+               tmr_racs1(i,j,k,m) = DMIN1(z1, r_r(m)*1.0d0)
+               tcs_racs2(i,j,k,m) = t3
+               tmr_racs2(i,j,k,m) = z3
+               tcr_sacr1(i,j,k,m) = t2
+               tms_sacr1(i,j,k,m) = z2
+               tcr_sacr2(i,j,k,m) = t4
+               tms_sacr2(i,j,k,m) = z4
+            enddo
+         enddo
+      enddo
+      enddo
+
+      end subroutine qr_acr_qs
+!+---+-----------------------------------------------------------------+
+!
+
+!+---+-----------------------------------------------------------------+
+!..This is a literal adaptation of Bigg (1954) probability of drops of
+!..a particular volume freezing.  Given this probability, simply freeze
+!..the proportion of drops summing their masses.
+!+---+-----------------------------------------------------------------+
+
+      subroutine freezeH2O
+
+      implicit none
+
+!..Local variables
+      INTEGER:: i, j, k, n, n2
+      INTEGER, PARAMETER:: nbr = 100
+      INTEGER, PARAMETER:: nbc = 50
+      DOUBLE PRECISION, DIMENSION(nbr):: Dr, N_r, dtr, massr
+      DOUBLE PRECISION, DIMENSION(nbr+1):: Dy
+      DOUBLE PRECISION, DIMENSION(nbc):: Dc, N_c, dtc, massc
+      DOUBLE PRECISION:: sum1, sum2, sumn1, sumn2, &
+                         prob, vol, Texp, orho_w, &
+                         lam_exp, lamr, N0_r, lamc, N0_c, y
+
+!+---+
+
+      orho_w = 1./rho_w
+
+!..Create bins of rain (from min diameter up to 5 mm).
+      Dy(1) = D0r*1.0d0
+      Dy(nbr+1) = 0.005d0
+      do n2 = 2, nbr
+         Dy(n2) = DEXP(DFLOAT(n2-1)/DFLOAT(nbr) &
+                  *DLOG(Dy(nbr+1)/Dy(1)) +DLOG(Dy(1)))
+      enddo
+      do n2 = 1, nbr
+         Dr(n2) = DSQRT(Dy(n2)*Dy(n2+1))
+         massr(n2) = am_r*Dr(n2)**bm_r
+         dtr(n2) = Dy(n2+1) - Dy(n2)
+      enddo
+
+!..Create bins of cloud water (from min diameter up to 50 microns).
+      Dc(1) = D0c*1.0d0
+      massc(1) = am_r*Dc(1)**bm_r
+      dtc(1) = D0c*1.0D6
+      do n = 2, nbc
+         Dc(n) = Dc(n-1) + 1.0D-6
+         massc(n) = am_r*Dc(n)**bm_r
+         dtc(n) = (Dc(n) - Dc(n-1)) * 1.0D6
+      enddo
+
+!..Freeze water (smallest drops become cloud ice, otherwise graupel).
+      do k = 1, 45
+!         print*, ' Freezing water for temp = ', -k
+         Texp = DEXP( DFLOAT(k) ) - 1.0D0
+         do j = 1, ntb_r1
+            do i = 1, ntb_r
+               lam_exp = (N0r_exp(j)*am_r*crg(1)/r_r(i))**ore1
+               lamr = lam_exp * (crg(3)*org2*org1)**obmr
+               N0_r = N0r_exp(j)/(crg(2)*lam_exp) * lamr**cre(2)
+               sum1 = 0.0d0
+               sum2 = 0.0d0
+               sumn1 = 0.0d0
+               do n2 = 1, nbr
+                  N_r(n2) = N0_r*Dr(n2)**mu_r*DEXP(-lamr*Dr(n2))*dtr(n2)
+                  vol = massr(n2)*orho_w
+                  prob = 1.0D0 - DEXP(-120.0D0*vol*5.2D-4 * Texp)
+                  if (massr(n2) .lt. xm0g) then
+                     sumn1 = sumn1 + prob*N_r(n2)
+                     sum1 = sum1 + prob*N_r(n2)*massr(n2)
+                  else
+                     sum2 = sum2 + prob*N_r(n2)*massr(n2)
+                  endif
+               enddo
+               tpi_qrfz(i,j,k) = sum1
+               tni_qrfz(i,j,k) = sumn1
+               tpg_qrfz(i,j,k) = sum2
+            enddo
+         enddo
+         do i = 1, ntb_c
+            lamc = 1.0D-6 * (Nt_c*am_r* ccg(2) * ocg1 / r_c(i))**obmr
+            N0_c = 1.0D-18 * Nt_c*ocg1 * lamc**cce(1)
+            sum1 = 0.0d0
+            sumn2 = 0.0d0
+            do n = 1, nbc
+               y = Dc(n)*1.0D6
+               vol = massc(n)*orho_w
+               prob = 1.0D0 - DEXP(-120.0D0*vol*5.2D-4 * Texp)
+               N_c(n) = N0_c* y**mu_c * EXP(-lamc*y)*dtc(n)
+               N_c(n) = 1.0D18 * N_c(n)
+               sumn2 = sumn2 + prob*N_c(n)
+               sum1 = sum1 + prob*N_c(n)*massc(n)
+            enddo
+            tpi_qcfz(i,k) = sum1
+            tni_qcfz(i,k) = sumn2
+         enddo
+      enddo
+
+      end subroutine freezeH2O
+!+---+-----------------------------------------------------------------+
+!
+
+!+---+-----------------------------------------------------------------+
+!..Cloud ice converting to snow since portion greater than min snow
+!.. size.  Given cloud ice content (kg/m**3), number concentration
+!.. (#/m**3) and gamma shape parameter, mu_i, break the distrib into
+!.. bins and figure out the mass/number of ice with sizes larger than
+!.. D0s.  Also, compute incomplete gamma function for the integration
+!.. of ice depositional growth from diameter=0 to D0s.  Amount of
+!.. ice depositional growth is this portion of distrib while larger
+!.. diameters contribute to snow growth (as in Harrington et al. 1995).
+!+---+-----------------------------------------------------------------+
+            
+      subroutine qi_aut_qs
+
+      implicit none
+
+!..Local variables
+      INTEGER:: i, j, n2
+      INTEGER, PARAMETER:: nbi = 100
+      DOUBLE PRECISION, DIMENSION(nbi):: Di, N_i, dti
+      DOUBLE PRECISION, DIMENSION(nbi+1):: Dy
+      DOUBLE PRECISION:: N0_i, lami, Di_mean, t1, t2
+
+!+---+
+
+!..Create bins of cloud ice (from min diameter up to 10x min snow size).
+      Dy(1) = D0i*1.0d0
+      Dy(nbi+1) = 10.0d0*D0s
+      do n2 = 2, nbi
+         Dy(n2) = DEXP(DFLOAT(n2-1)/DFLOAT(nbi) &
+                  *DLOG(Dy(nbi+1)/Dy(1)) +DLOG(Dy(1)))
+      enddo
+      do n2 = 1, nbi
+         Di(n2) = DSQRT(Dy(n2)*Dy(n2+1))
+         dti(n2) = Dy(n2+1) - Dy(n2)
+      enddo
+
+      do j = 1, ntb_i1
+         do i = 1, ntb_i
+            lami = (am_i*cig(2)*oig1*Nt_i(j)/r_i(i))**obmi
+            Di_mean = (bm_i + mu_i + 1.) / lami
+            N0_i = Nt_i(j)*oig1 * lami**cie(1)
+            t1 = 0.0d0
+            t2 = 0.0d0
+            if (SNGL(Di_mean) .gt. 5.*D0s) then
+             t1 = r_i(i)
+             t2 = Nt_i(j)
+             tpi_ide(i,j) = 0.0D0
+            elseif (SNGL(Di_mean) .lt. D0i) then
+             t1 = 0.0D0
+             t2 = 0.0D0
+             tpi_ide(i,j) = 1.0D0
+            else
+             tpi_ide(i,j) = GAMMP(mu_i+2.0, SNGL(lami)*D0s) * 1.0D0
+             do n2 = 1, nbi
+               N_i(n2) = N0_i*Di(n2)**mu_i * DEXP(-lami*Di(n2))*dti(n2)
+               if (Di(n2).ge.D0s) then
+                  t1 = t1 + N_i(n2) * am_i*Di(n2)**bm_i
+                  t2 = t2 + N_i(n2)
+               endif
+             enddo
+            endif
+            tps_iaus(i,j) = t1
+            tni_iaus(i,j) = t2
+         enddo
+      enddo
+
+      end subroutine qi_aut_qs
+!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+
+      SUBROUTINE GCF(GAMMCF,A,X,GLN)
+!     --- RETURNS THE INCOMPLETE GAMMA FUNCTION Q(A,X) EVALUATED BY ITS
+!     --- CONTINUED FRACTION REPRESENTATION AS GAMMCF.  ALSO RETURNS
+!     --- LN(GAMMA(A)) AS GLN.  THE CONTINUED FRACTION IS EVALUATED BY
+!     --- A MODIFIED LENTZ METHOD.
+!     --- USES GAMMLN
+      IMPLICIT NONE
+      INTEGER, PARAMETER:: ITMAX=100
+      REAL, PARAMETER:: gEPS=3.E-7
+      REAL, PARAMETER:: FPMIN=1.E-30
+      REAL, INTENT(IN):: A, X
+      REAL:: GAMMCF,GLN
+      INTEGER:: I
+      REAL:: AN,B,C,D,DEL,H
+      GLN=GAMMLN(A)
+      B=X+1.-A
+      C=1./FPMIN
+      D=1./B
+      H=D
+      DO 11 I=1,ITMAX
+        AN=-I*(I-A)
+        B=B+2.
+        D=AN*D+B
+        IF(ABS(D).LT.FPMIN)D=FPMIN
+        C=B+AN/C
+        IF(ABS(C).LT.FPMIN)C=FPMIN
+        D=1./D
+        DEL=D*C
+        H=H*DEL
+        IF(ABS(DEL-1.).LT.gEPS)GOTO 1
+ 11   CONTINUE
+      PRINT *, 'A TOO LARGE, ITMAX TOO SMALL IN GCF'
+ 1    GAMMCF=EXP(-X+A*LOG(X)-GLN)*H
+      END SUBROUTINE GCF
+!  (C) Copr. 1986-92 Numerical Recipes Software 2.02
+!+---+-----------------------------------------------------------------+
+      SUBROUTINE GSER(GAMSER,A,X,GLN)
+!     --- RETURNS THE INCOMPLETE GAMMA FUNCTION P(A,X) EVALUATED BY ITS
+!     --- ITS SERIES REPRESENTATION AS GAMSER.  ALSO RETURNS LN(GAMMA(A)) 
+!     --- AS GLN.
+!     --- USES GAMMLN
+      IMPLICIT NONE
+      INTEGER, PARAMETER:: ITMAX=100
+      REAL, PARAMETER:: gEPS=3.E-7
+      REAL, INTENT(IN):: A, X
+      REAL:: GAMSER,GLN
+      INTEGER:: N
+      REAL:: AP,DEL,SUM
+      GLN=GAMMLN(A)
+      IF(X.LE.0.)THEN
+        IF(X.LT.0.) PRINT *, 'X < 0 IN GSER'
+        GAMSER=0.
+        RETURN
+      ENDIF
+      AP=A
+      SUM=1./A
+      DEL=SUM
+      DO 11 N=1,ITMAX
+        AP=AP+1.
+        DEL=DEL*X/AP
+        SUM=SUM+DEL
+        IF(ABS(DEL).LT.ABS(SUM)*gEPS)GOTO 1
+ 11   CONTINUE
+      PRINT *,'A TOO LARGE, ITMAX TOO SMALL IN GSER'
+ 1    GAMSER=SUM*EXP(-X+A*LOG(X)-GLN)
+      END SUBROUTINE GSER
+!  (C) Copr. 1986-92 Numerical Recipes Software 2.02
+!+---+-----------------------------------------------------------------+
+      REAL FUNCTION GAMMLN(XX)
+!     --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0.
+      IMPLICIT NONE
+      REAL, INTENT(IN):: XX
+      DOUBLE PRECISION, PARAMETER:: STP = 2.5066282746310005D0
+      DOUBLE PRECISION, DIMENSION(6), PARAMETER:: &
+               COF = (/76.18009172947146D0, -86.50532032941677D0, &
+                       24.01409824083091D0, -1.231739572450155D0, &
+                      .1208650973866179D-2, -.5395239384953D-5/)
+      DOUBLE PRECISION:: SER,TMP,X,Y
+      INTEGER:: J
+
+      X=XX
+      Y=X
+      TMP=X+5.5D0
+      TMP=(X+0.5D0)*LOG(TMP)-TMP
+      SER=1.000000000190015D0
+      DO 11 J=1,6
+        Y=Y+1.D0
+        SER=SER+COF(J)/Y
+11    CONTINUE
+      GAMMLN=TMP+LOG(STP*SER/X)
+      END FUNCTION GAMMLN
+!  (C) Copr. 1986-92 Numerical Recipes Software 2.02
+!+---+-----------------------------------------------------------------+
+      REAL FUNCTION GAMMP(A,X)
+!     --- COMPUTES THE INCOMPLETE GAMMA FUNCTION P(A,X)
+!     --- SEE ABRAMOWITZ AND STEGUN 6.5.1
+!     --- USES GCF,GSER
+      IMPLICIT NONE
+      REAL, INTENT(IN):: A,X
+      REAL:: GAMMCF,GAMSER,GLN
+      GAMMP = 0.
+      IF((X.LT.0.) .OR. (A.LE.0.)) THEN
+        PRINT *, 'BAD ARGUMENTS IN GAMMP'
+        RETURN
+      ELSEIF(X.LT.A+1.)THEN
+        CALL GSER(GAMSER,A,X,GLN)
+        GAMMP=GAMSER
+      ELSE
+        CALL GCF(GAMMCF,A,X,GLN)
+        GAMMP=1.-GAMMCF
+      ENDIF
+      END FUNCTION GAMMP
+!  (C) Copr. 1986-92 Numerical Recipes Software 2.02
+!+---+-----------------------------------------------------------------+
+      REAL FUNCTION WGAMMA(y)
+
+      IMPLICIT NONE
+      REAL, INTENT(IN):: y
+
+      WGAMMA = EXP(GAMMLN(y))
+
+      END FUNCTION WGAMMA
+!+---+-----------------------------------------------------------------+
+! THIS FUNCTION CALCULATES THE LIQUID SATURATION VAPOR MIXING RATIO AS
+! A FUNCTION OF TEMPERATURE AND PRESSURE
+!
+      REAL FUNCTION RSLF(P,T)
+
+      IMPLICIT NONE
+      REAL, INTENT(IN):: P, T
+      REAL:: ESL,X
+      REAL, PARAMETER:: C0= .611583699E03
+      REAL, PARAMETER:: C1= .444606896E02
+      REAL, PARAMETER:: C2= .143177157E01
+      REAL, PARAMETER:: C3= .264224321E-1
+      REAL, PARAMETER:: C4= .299291081E-3
+      REAL, PARAMETER:: C5= .203154182E-5
+      REAL, PARAMETER:: C6= .702620698E-8
+      REAL, PARAMETER:: C7= .379534310E-11
+      REAL, PARAMETER:: C8=-.321582393E-13
+
+      X=AMAX1(-80.,T-273.16)
+
+!      ESL=612.2*EXP(17.67*X/(T-29.65))
+      ESL=C0+X*(C1+X*(C2+X*(C3+X*(C4+X*(C5+X*(C6+X*(C7+X*C8)))))))
+      RSLF=.622*ESL/(P-ESL)
+
+      END FUNCTION RSLF
+!
+!+---+-----------------------------------------------------------------+
+! THIS FUNCTION CALCULATES THE ICE SATURATION VAPOR MIXING RATIO AS A
+! FUNCTION OF TEMPERATURE AND PRESSURE
+!
+      REAL FUNCTION RSIF(P,T)
+
+      IMPLICIT NONE
+      REAL, INTENT(IN):: P, T
+      REAL:: ESI,X
+      REAL, PARAMETER:: C0= .609868993E03
+      REAL, PARAMETER:: C1= .499320233E02
+      REAL, PARAMETER:: C2= .184672631E01
+      REAL, PARAMETER:: C3= .402737184E-1
+      REAL, PARAMETER:: C4= .565392987E-3
+      REAL, PARAMETER:: C5= .521693933E-5
+      REAL, PARAMETER:: C6= .307839583E-7
+      REAL, PARAMETER:: C7= .105785160E-9
+      REAL, PARAMETER:: C8= .161444444E-12
+
+      X=AMAX1(-80.,T-273.16)
+      ESI=C0+X*(C1+X*(C2+X*(C3+X*(C4+X*(C5+X*(C6+X*(C7+X*C8)))))))
+      RSIF=.622*ESI/(P-ESI)
+
+      END FUNCTION RSIF
+!+---+-----------------------------------------------------------------+
+END MODULE module_mp_thompson
+!+---+-----------------------------------------------------------------+
+!
+! MODIFICATIONS TO MAKE IN OTHER MODULES
+!
+! Use this new code by changing the "THOMPSON" section of code found
+! in "module_microphysics_driver.F" with this section.  [Of course
+! remove the leading comment character that you see here.]
+!
+!       CASE (THOMPSON)
+!            CALL wrf_debug ( 100 , 'microphysics_driver: calling thompson et al' )
+!            IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
+!                 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
+!                 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND.  &
+!                                          PRESENT ( QNI_CURR ).AND.  &
+!                 PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) ) THEN  
+!            CALL mp_gt_driver(                          &
+!                    QV=qv_curr,                         &
+!                    QC=qc_curr,                         &
+!                    QR=qr_curr,                         &
+!                    QI=qi_curr,                         &
+!                    QS=qs_curr,                         &
+!                    QG=qg_curr,                         &
+!                    NI=qni_curr,                        &
+!                    TH=th,                              &
+!                    PII=pi_phy,                         &
+!                    P=p,                                & 
+!                    DZ=dz8w,                            &
+!                    DT_IN=dt,                           &
+!                    ITIMESTEP=itimestep,                &
+!                    RAINNC=RAINNC,                      &
+!                    RAINNCV=RAINNCV,                    &
+!                    SR=SR                               &
+!                ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+!                ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+!                ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
+!            ELSE
+!               CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
+!            ENDIF
+!
+! Then rename the call from "thomp_init" to "thompson_init" in the file
+! "module_physics_init.F" (seen below):
+!
+!    CASE (THOMPSON)
+!        CALL thompson_init
Index: trunk/WRF.COMMON/WRFV2/phys/module_mp_wsm3.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_mp_wsm3.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_mp_wsm3.F	(revision 2744)
@@ -0,0 +1,987 @@
+#if ( RWORDSIZE == 4 )
+#  define VREC vsrec
+#  define VSQRT vssqrt
+#else
+#  define VREC vrec
+#  define VSQRT vsqrt
+#endif
+
+MODULE module_mp_wsm3
+!
+!
+   REAL, PARAMETER, PRIVATE :: dtcldcr     = 120.
+   REAL, PARAMETER, PRIVATE :: n0r = 8.e6
+   REAL, PARAMETER, PRIVATE :: avtr = 841.9
+   REAL, PARAMETER, PRIVATE :: bvtr = 0.8
+   REAL, PARAMETER, PRIVATE :: r0 = .8e-5 ! 8 microm  in contrast to 10 micro m
+   REAL, PARAMETER, PRIVATE :: peaut = .55   ! collection efficiency
+   REAL, PARAMETER, PRIVATE :: xncr = 3.e8   ! maritime cloud in contrast to 3.e8 in tc80
+   REAL, PARAMETER, PRIVATE :: xmyu = 1.718e-5 ! the dynamic viscosity kgm-1s-1
+   REAL, PARAMETER, PRIVATE :: avts = 11.72
+   REAL, PARAMETER, PRIVATE :: bvts = .41
+   REAL, PARAMETER, PRIVATE :: n0smax =  1.e11 ! t=-90C unlimited
+   REAL, PARAMETER, PRIVATE :: lamdarmax = 8.e4
+   REAL, PARAMETER, PRIVATE :: lamdasmax = 1.e5
+   REAL, PARAMETER, PRIVATE :: lamdagmax = 6.e4
+   REAL, PARAMETER, PRIVATE :: betai = .6
+   REAL, PARAMETER, PRIVATE :: xn0 = 1.e-2
+   REAL, PARAMETER, PRIVATE :: dicon = 11.9
+   REAL, PARAMETER, PRIVATE :: di0 = 12.9e-6
+   REAL, PARAMETER, PRIVATE :: dimax = 500.e-6
+   REAL, PARAMETER, PRIVATE :: n0s = 2.e6             ! temperature dependent n0s
+   REAL, PARAMETER, PRIVATE :: alpha = .12        ! .122 exponen factor for n0s
+   REAL, PARAMETER, PRIVATE :: qcrmin = 1.e-9
+   REAL, SAVE ::                                     &
+             qc0, qck1,bvtr1,bvtr2,bvtr3,bvtr4,g1pbr,&
+             g3pbr,g4pbr,g5pbro2,pvtr,eacrr,pacrr,   &
+             precr1,precr2,xm0,xmmax,roqimax,bvts1,  &
+             bvts2,bvts3,bvts4,g1pbs,g3pbs,g4pbs,    &
+             g5pbso2,pvts,pacrs,precs1,precs2,pidn0r,&
+             pidn0s,xlv1,                            &
+             rslopermax,rslopesmax,rslopegmax,       &
+             rsloperbmax,rslopesbmax,rslopegbmax,    &
+             rsloper2max,rslopes2max,rslopeg2max,    &
+             rsloper3max,rslopes3max,rslopeg3max
+!
+! Specifies code-inlining of fpvs function in WSM32D below. JM 20040507
+!
+CONTAINS
+!===================================================================
+!
+  SUBROUTINE wsm3(th, q, qci, qrs                                  &
+                   , w, den, pii, p, delz                          &
+                   , delt,g, cpd, cpv, rd, rv, t0c                 &
+                   , ep1, ep2, qmin                                &
+                   , XLS, XLV0, XLF0, den0, denr                   &
+                   , cliq,cice,psat                                &
+                   , rain, rainncv                                 &
+                   ,snow, snowncv                                  &
+                   ,sr                                             &
+                   , ids,ide, jds,jde, kds,kde                     &
+                   , ims,ime, jms,jme, kms,kme                     &
+                   , its,ite, jts,jte, kts,kte                     &
+                                                                   )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!
+!
+!  This code is a 3-class simple ice microphyiscs scheme (WSM3) of the WRF
+!  Single-Moment MicroPhyiscs (WSMMP). The WSMMP assumes that ice nuclei
+!  number concentration is a function of temperature, and seperate assumption
+!  is developed, in which ice crystal number concentration is a function
+!  of ice amount. A theoretical background of the ice-microphysics and related
+!  processes in the WSMMPs are described in Hong et al. (2004).
+!  Production terms in the WSM6 scheme are described in Hong and Lim (2006).
+!  All units are in m.k.s. and source/sink terms in kgkg-1s-1.
+!
+!  WSM3 cloud scheme
+!
+!  Coded by Song-You Hong (Yonsei Univ.)
+!             Jimy Dudhia (NCAR) and Shu-Hua Chen (UC Davis)
+!             Summer 2002
+!
+!  Implemented by Song-You Hong (Yonsei Univ.) and Jimy Dudhia (NCAR)
+!             Summer 2003
+!
+!  Reference) Hong, Dudhia, Chen (HDC, 2004) Mon. Wea. Rev.
+!             Dudhia (D89, 1989) J. Atmos. Sci.
+!             Hong and Lim (HL, 2006) J. Korean Meteor. Soc.
+!
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(INOUT) ::                                          &
+                                                             th,  &
+                                                              q,  &
+                                                             qci, &
+                                                             qrs
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(IN   ) ::                                       w, &
+                                                             den, &
+                                                             pii, &
+                                                               p, &
+                                                            delz
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                              rd, &
+                                                              rv, &
+                                                             t0c, &
+                                                            den0, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             XLS, &
+                                                            XLV0, &
+                                                            XLF0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime , jms:jme ),                           &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv, &
+                                                              sr
+
+  REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL,                &
+        INTENT(INOUT) ::                                    snow, &
+                                                         snowncv
+
+! LOCAL VAR
+  REAL, DIMENSION( its:ite , kts:kte ) ::   t
+  INTEGER ::               i,j,k
+!-------------------------------------------------------------------
+      DO j=jts,jte
+         DO k=kts,kte
+         DO i=its,ite
+            t(i,k)=th(i,k,j)*pii(i,k,j)
+         ENDDO
+         ENDDO
+         CALL wsm32D(t, q(ims,kms,j), qci(ims,kms,j)               &
+                    ,qrs(ims,kms,j),w(ims,kms,j), den(ims,kms,j)   &
+                    ,p(ims,kms,j), delz(ims,kms,j)                 &
+                    ,delt,g, cpd, cpv, rd, rv, t0c                 &
+                    ,ep1, ep2, qmin                                &
+                    ,XLS, XLV0, XLF0, den0, denr                   &
+                    ,cliq,cice,psat                                &
+                    ,j                                             &
+                    ,rain(ims,j), rainncv(ims,j)                   &
+                    ,sr(ims,j)                                     &
+                    ,ids,ide, jds,jde, kds,kde                     &
+                    ,ims,ime, jms,jme, kms,kme                     &
+                    ,its,ite, jts,jte, kts,kte                     &
+                    ,snow(ims,j),snowncv(ims,j)                    &
+                                                                   )
+         DO K=kts,kte
+         DO I=its,ite
+            th(i,k,j)=t(i,k)/pii(i,k,j)
+         ENDDO
+         ENDDO
+      ENDDO
+  END SUBROUTINE wsm3
+!===================================================================
+!
+  SUBROUTINE wsm32D(t, q, qci, qrs,w, den, p, delz                &
+                   ,delt,g, cpd, cpv, rd, rv, t0c                 &
+                   ,ep1, ep2, qmin                                &
+                   ,XLS, XLV0, XLF0, den0, denr                   &
+                   ,cliq,cice,psat                                &
+                   ,lat                                           &
+                   ,rain, rainncv                                 &
+                   ,sr                                            &
+                   ,ids,ide, jds,jde, kds,kde                     &
+                   ,ims,ime, jms,jme, kms,kme                     &
+                   ,its,ite, jts,jte, kts,kte                     &
+                   ,snow,snowncv                                  &
+                                                                  )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte,  &
+                                      lat
+  REAL, DIMENSION( its:ite , kts:kte ),                           &
+        INTENT(INOUT) ::                                          &
+                                                               t
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(INOUT) ::                                          &
+                                                               q, &
+                                                             qci, &
+                                                             qrs
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(IN   ) ::                                       w, &
+                                                             den, &
+                                                               p, &
+                                                            delz
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             t0c, &
+                                                            den0, &
+                                                              rd, &
+                                                              rv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             XLS, &
+                                                            XLV0, &
+                                                            XLF0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime ),                                     &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv, &
+                                                              sr
+
+  REAL, DIMENSION( ims:ime ),     OPTIONAL,                       &
+        INTENT(INOUT) ::                                    snow, &
+                                                         snowncv
+! LOCAL VAR
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+        rh, qs, denfac, rslope, rslope2, rslope3, rslopeb,        &
+        pgen, paut, pacr, pisd, pres, pcon, fall, falk,           &
+        xl, cpm, work1, work2, xni, qs0, n0sfac
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+              falkc, work1c, work2c, fallc
+! variables for optimization
+  REAL, DIMENSION( its:ite )           :: tvec1
+  INTEGER, DIMENSION( its:ite ) :: mstep, numdt
+  LOGICAL, DIMENSION( its:ite ) :: flgcld
+  REAL  ::  pi,                                                   &
+            cpmcal, xlcal, lamdar, lamdas, diffus,                &
+            viscos, xka, venfac, conden, diffac,                  &
+            x, y, z, a, b, c, d, e,                               &
+            fallsum, fallsum_qsi, vt2i,vt2s,acrfac,               &      
+            qdt, pvt, qik, delq, facq, qrsci, frzmlt,             &
+            snomlt, hold, holdrs, facqci, supcol, coeres,         &
+            supsat, dtcld, xmi, qciik, delqci, eacrs, satdt,      &
+            qimax, diameter, xni0, roqi0, supice
+  REAL  :: holdc, holdci
+  INTEGER :: i, j, k, mstepmax,                                   &
+            iprt, latd, lond, loop, loops, ifsat, kk, n
+! Temporaries used for inlining fpvs function
+  REAL  :: dldti, xb, xai, tr, xbi, xa, hvap, cvap, hsub, dldt, ttp
+!
+!=================================================================
+!   compute internal functions
+!
+      cpmcal(x) = cpd*(1.-max(x,qmin))+max(x,qmin)*cpv
+      xlcal(x) = xlv0-xlv1*(x-t0c)
+!----------------------------------------------------------------
+!     size distributions: (x=mixing ratio, y=air density):
+!     valid for mixing ratio > 1.e-9 kg/kg.
+!
+! Optimizatin : A**B => exp(log(A)*(B))
+      lamdar(x,y)=   sqrt(sqrt(pidn0r/(x*y)))      ! (pidn0r/(x*y))**.25
+      lamdas(x,y,z)= sqrt(sqrt(pidn0s*z/(x*y)))    ! (pidn0s*z/(x*y))**.25
+!
+!----------------------------------------------------------------
+!     diffus: diffusion coefficient of the water vapor
+!     viscos: kinematic viscosity(m2s-1)
+!
+      diffus(x,y) = 8.794e-5 * exp(log(x)*(1.81)) / y        ! 8.794e-5*x**1.81/y
+      viscos(x,y) = 1.496e-6 * (x*sqrt(x)) /(x+120.)/y  ! 1.496e-6*x**1.5/(x+120.)/y
+      xka(x,y) = 1.414e3*viscos(x,y)*y
+      diffac(a,b,c,d,e) = d*a*a/(xka(c,d)*rv*c*c)+1./(e*diffus(c,b))
+!      venfac(a,b,c) = (viscos(b,c)/diffus(b,a))**(.3333333)       &
+!                      /viscos(b,c)**(.5)*(den0/c)**0.25
+      venfac(a,b,c) = exp(log((viscos(b,c)/diffus(b,a)))*((.3333333)))    &
+                     /sqrt(viscos(b,c))*sqrt(sqrt(den0/c))
+      conden(a,b,c,d,e) = (max(b,qmin)-c)/(1.+d*d/(rv*e)*c/(a*a))
+!
+      pi = 4. * atan(1.)
+!
+!----------------------------------------------------------------
+!     paddint 0 for negative values generated by dynamics
+!
+      do k = kts, kte
+        do i = its, ite
+          qci(i,k) = max(qci(i,k),0.0)
+          qrs(i,k) = max(qrs(i,k),0.0)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     latent heat for phase changes and heat capacity. neglect the
+!     changes during microphysical process calculation
+!     emanuel(1994)
+!
+      do k = kts, kte
+        do i = its, ite
+          cpm(i,k) = cpmcal(q(i,k))
+          xl(i,k) = xlcal(t(i,k))
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     compute the minor time steps.
+!
+      loops = max(nint(delt/dtcldcr),1)
+      dtcld = delt/loops
+      if(delt.le.dtcldcr) dtcld = delt
+!
+      do loop = 1,loops
+!
+!----------------------------------------------------------------
+!     initialize the large scale variables
+!
+      do i = its, ite
+        mstep(i) = 1
+        flgcld(i) = .true.
+      enddo
+!
+!     do k = kts, kte
+!       do i = its, ite
+!         denfac(i,k) = sqrt(den0/den(i,k))
+!       enddo
+!     enddo
+      do k = kts, kte
+        CALL VREC( tvec1(its), den(its,k), ite-its+1)
+        do i = its, ite
+          tvec1(i) = tvec1(i)*den0
+        enddo
+        CALL VSQRT( denfac(its,k), tvec1(its), ite-its+1)
+      enddo
+!
+! Inline expansion for fpvs
+!         qs(i,k) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+!         qs0(i,k) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+      cvap = cpv
+      hvap=xlv0
+      hsub=xls
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      do k = kts, kte
+        do i = its, ite
+!         tr=ttp/t(i,k)
+!         if(t(i,k).lt.ttp) then
+!           qs(i,k) =psat*(tr**xai)*exp(xbi*(1.-tr))
+!         else
+!           qs(i,k) =psat*(tr**xa)*exp(xb*(1.-tr))
+!         endif
+!         qs0(i,k)  =psat*(tr**xa)*exp(xb*(1.-tr))
+          tr=ttp/t(i,k)
+          if(t(i,k).lt.ttp) then
+            qs(i,k) =psat*(exp(log(tr)*(xai)))*exp(xbi*(1.-tr))
+          else
+            qs(i,k) =psat*(exp(log(tr)*(xa)))*exp(xb*(1.-tr))
+          endif
+          qs0(i,k)  =psat*(exp(log(tr)*(xa)))*exp(xb*(1.-tr))
+          qs0(i,k) = (qs0(i,k)-qs(i,k))/qs(i,k)
+          qs(i,k) = ep2 * qs(i,k) / (p(i,k) - qs(i,k))
+          qs(i,k) = max(qs(i,k),qmin)
+          rh(i,k) = max(q(i,k) / qs(i,k),qmin)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     initialize the variables for microphysical physics
+!
+!
+      do k = kts, kte
+        do i = its, ite
+          pres(i,k) = 0.
+          paut(i,k) = 0.
+          pacr(i,k) = 0.
+          pgen(i,k) = 0.
+          pisd(i,k) = 0.
+          pcon(i,k) = 0.
+          fall(i,k) = 0.
+          falk(i,k) = 0.
+          fallc(i,k) = 0.
+          falkc(i,k) = 0.
+          xni(i,k) = 1.e3
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     compute the fallout term:
+!     first, vertical terminal velosity for minor loops
+!---------------------------------------------------------------
+! n0s: Intercept parameter for snow [m-4] [HDC 6]
+!---------------------------------------------------------------
+      do k = kts, kte
+        do i = its, ite
+          supcol = t0c-t(i,k)
+          n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.)
+          if(t(i,k).ge.t0c) then
+            if(qrs(i,k).le.qcrmin)then
+              rslope(i,k) = rslopermax
+              rslopeb(i,k) = rsloperbmax
+              rslope2(i,k) = rsloper2max
+              rslope3(i,k) = rsloper3max
+            else
+              rslope(i,k) = 1./lamdar(qrs(i,k),den(i,k))
+!             rslopeb(i,k) = rslope(i,k)**bvtr
+              rslopeb(i,k) = exp(log(rslope(i,k))*(bvtr))
+              rslope2(i,k) = rslope(i,k)*rslope(i,k)
+              rslope3(i,k) = rslope2(i,k)*rslope(i,k)
+            endif
+          else
+            if(qrs(i,k).le.qcrmin)then
+              rslope(i,k) = rslopesmax
+              rslopeb(i,k) = rslopesbmax
+              rslope2(i,k) = rslopes2max
+              rslope3(i,k) = rslopes3max
+            else
+              rslope(i,k) = 1./lamdas(qrs(i,k),den(i,k),n0sfac(i,k))
+!             rslopeb(i,k) = rslope(i,k)**bvts
+              rslopeb(i,k) = exp(log(rslope(i,k))*(bvts))
+              rslope2(i,k) = rslope(i,k)*rslope(i,k)
+              rslope3(i,k) = rslope2(i,k)*rslope(i,k)
+            endif
+          endif
+!-------------------------------------------------------------
+! Ni: ice crystal number concentraiton   [HDC 5c]
+!-------------------------------------------------------------
+!         xni(i,k) = min(max(5.38e7*(den(i,k)                           &
+!                   *max(qci(i,k),qmin))**0.75,1.e3),1.e6)
+          xni(i,k) = min(max(5.38e7*exp(log((den(i,k)*max(qci(i,k),qmin)))*(0.75)),1.e3),1.e6)
+        enddo
+      enddo
+!
+      mstepmax = 1
+      numdt = 1
+      do k = kte, kts, -1
+        do i = its, ite
+          if(t(i,k).lt.t0c) then
+            pvt = pvts
+          else
+            pvt = pvtr
+          endif
+          work1(i,k) = pvt*rslopeb(i,k)*denfac(i,k)
+          work2(i,k) = work1(i,k)/delz(i,k)
+          numdt(i) = max(nint(work2(i,k)*dtcld+.5),1)
+          if(numdt(i).ge.mstep(i)) mstep(i) = numdt(i)
+        enddo
+      enddo
+      do i = its, ite
+        if(mstepmax.le.mstep(i)) mstepmax = mstep(i)
+      enddo
+!
+      do n = 1, mstepmax
+        k = kte
+        do i = its, ite
+          if(n.le.mstep(i)) then
+            falk(i,k) = den(i,k)*qrs(i,k)*work2(i,k)/mstep(i)
+            hold = falk(i,k)
+            fall(i,k) = fall(i,k)+falk(i,k)
+            holdrs = qrs(i,k)
+            qrs(i,k) = max(qrs(i,k)-falk(i,k)*dtcld/den(i,k),0.)
+          endif
+        enddo
+        do k = kte-1, kts, -1
+          do i = its, ite
+            if(n.le.mstep(i)) then
+              falk(i,k) = den(i,k)*qrs(i,k)*work2(i,k)/mstep(i)
+              hold = falk(i,k)
+              fall(i,k) = fall(i,k)+falk(i,k)
+              holdrs = qrs(i,k)
+              qrs(i,k) = max(qrs(i,k)-(falk(i,k)                        &
+                        -falk(i,k+1)*delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+            endif
+          enddo
+        enddo
+      enddo
+!---------------------------------------------------------------
+! Vice [ms-1] : fallout of ice crystal [HDC 5a]
+!---------------------------------------------------------------
+      mstepmax = 1
+      mstep = 1
+      numdt = 1
+      do k = kte, kts, -1
+        do i = its, ite
+          if(t(i,k).lt.t0c.and.qci(i,k).gt.0.) then
+            xmi = den(i,k)*qci(i,k)/xni(i,k)
+!           diameter  = dicon * sqrt(xmi)
+!           work1c(i,k) = 1.49e4*diameter**1.31
+            diameter  = max(dicon * sqrt(xmi), 1.e-25)
+            work1c(i,k) = 1.49e4*exp(log(diameter)*(1.31))
+          else
+            work1c(i,k) = 0.
+          endif
+          if(qci(i,k).le.0.) then
+            work2c(i,k) = 0.
+          else
+            work2c(i,k) = work1c(i,k)/delz(i,k)
+          endif
+          numdt(i) = max(nint(work2c(i,k)*dtcld+.5),1)
+          if(numdt(i).ge.mstep(i)) mstep(i) = numdt(i)
+        enddo
+      enddo
+      do i = its, ite
+        if(mstepmax.le.mstep(i)) mstepmax = mstep(i)
+      enddo
+!
+      do n = 1, mstepmax
+        k = kte
+        do i = its, ite
+          if (n.le.mstep(i)) then
+            falkc(i,k) = den(i,k)*qci(i,k)*work2c(i,k)/mstep(i)
+            holdc = falkc(i,k)
+            fallc(i,k) = fallc(i,k)+falkc(i,k)
+            holdci = qci(i,k)
+            qci(i,k) = max(qci(i,k)-falkc(i,k)*dtcld/den(i,k),0.)
+          endif
+        enddo
+        do k = kte-1, kts, -1
+          do i = its, ite
+            if (n.le.mstep(i)) then
+              falkc(i,k) = den(i,k)*qci(i,k)*work2c(i,k)/mstep(i)
+              holdc = falkc(i,k)
+              fallc(i,k) = fallc(i,k)+falkc(i,k)
+              holdci = qci(i,k)
+              qci(i,k) = max(qci(i,k)-(falkc(i,k)                       &
+                        -falkc(i,k+1)*delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+            endif
+          enddo
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     compute the freezing/melting term. [D89 B16-B17]
+!     freezing occurs one layer above the melting level
+!
+      do i = its, ite
+        mstep(i) = 0
+      enddo
+      do k = kts, kte
+!
+        do i = its, ite
+          if(t(i,k).ge.t0c) then
+            mstep(i) = k
+          endif
+        enddo
+      enddo
+!
+      do i = its, ite
+        if(mstep(i).ne.0.and.w(i,mstep(i)).gt.0.) then
+          work1(i,1) = float(mstep(i) + 1)
+          work1(i,2) = float(mstep(i))
+        else
+          work1(i,1) = float(mstep(i))
+          work1(i,2) = float(mstep(i))
+        endif
+      enddo
+!
+      do i = its, ite
+        k  = nint(work1(i,1))
+        kk = nint(work1(i,2))
+        if(k*kk.ge.1) then
+          qrsci = qrs(i,k) + qci(i,k)
+          if(qrsci.gt.0..or.fall(i,kk).gt.0.) then
+            frzmlt = min(max(-w(i,k)*qrsci/delz(i,k),-qrsci/dtcld),    &
+                     qrsci/dtcld)
+            snomlt = min(max(fall(i,kk)/den(i,kk),-qrs(i,k)/dtcld),    &
+                     qrs(i,k)/dtcld)
+            if(k.eq.kk) then
+              t(i,k) = t(i,k) - xlf0/cpm(i,k)*(frzmlt+snomlt)*dtcld
+            else
+              t(i,k) = t(i,k) - xlf0/cpm(i,k)*frzmlt*dtcld
+              t(i,kk) = t(i,kk) - xlf0/cpm(i,kk)*snomlt*dtcld
+            endif
+          endif
+        endif
+      enddo
+!
+!----------------------------------------------------------------
+!      rain (unit is mm/sec;kgm-2s-1: /1000*delt ===> m)==> mm for wrf
+!
+      do i = its, ite
+        fallsum = fall(i,1)
+        fallsum_qsi = 0.
+        if((t0c-t(i,1)).gt.0) then
+        fallsum = fallsum+fallc(i,1)
+        fallsum_qsi = fall(i,1)+fallc(i,1)
+        endif
+        rainncv(i) = 0.
+        if(fallsum.gt.0.) then
+          rainncv(i) = fallsum*delz(i,1)/denr*dtcld*1000.
+          rain(i) = fallsum*delz(i,1)/denr*dtcld*1000.                &
+                  + rain(i)
+        endif
+        IF ( PRESENT (snowncv) .AND. PRESENT (snow)) THEN
+        snowncv(i) = 0.
+        if(fallsum_qsi.gt.0.) then
+          snowncv(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000.
+          snow(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000. + snow(i)
+        endif
+        ENDIF
+        sr(i) = 0.
+        if(fallsum.gt.0.)sr(i)=fallsum_qsi*delz(i,kts)/denr*dtcld*1000./(rainncv(i)+1.e-12)
+      enddo
+!
+!----------------------------------------------------------------
+!     rsloper: reverse of the slope parameter of the rain(m)
+!     xka:    thermal conductivity of air(jm-1s-1k-1)
+!     work1:  the thermodynamic term in the denominator associated with
+!             heat conduction and vapor diffusion
+!             (ry88, y93, h85)
+!     work2: parameter associated with the ventilation effects(y93)
+!
+      do k = kts, kte
+        do i = its, ite
+          if(t(i,k).ge.t0c) then
+            if(qrs(i,k).le.qcrmin)then
+              rslope(i,k) = rslopermax
+              rslopeb(i,k) = rsloperbmax
+              rslope2(i,k) = rsloper2max
+              rslope3(i,k) = rsloper3max
+            else
+              rslope(i,k) = 1./lamdar(qrs(i,k),den(i,k))
+              rslopeb(i,k) = exp(log(rslope(i,k))*(bvtr))
+              rslope2(i,k) = rslope(i,k)*rslope(i,k)
+              rslope3(i,k) = rslope2(i,k)*rslope(i,k)
+            endif
+          else
+            if(qrs(i,k).le.qcrmin)then
+              rslope(i,k) = rslopesmax
+              rslopeb(i,k) = rslopesbmax
+              rslope2(i,k) = rslopes2max
+              rslope3(i,k) = rslopes3max
+            else
+              rslope(i,k) = 1./lamdas(qrs(i,k),den(i,k),n0sfac(i,k))
+              rslopeb(i,k) = exp(log(rslope(i,k))*(bvts))
+              rslope2(i,k) = rslope(i,k)*rslope(i,k)
+              rslope3(i,k) = rslope2(i,k)*rslope(i,k)
+            endif
+          endif
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          if(t(i,k).ge.t0c) then
+            work1(i,k) = diffac(xl(i,k),p(i,k),t(i,k),den(i,k),qs(i,k))
+          else
+            work1(i,k) = diffac(xls,p(i,k),t(i,k),den(i,k),qs(i,k))
+          endif
+          work2(i,k) = venfac(p(i,k),t(i,k),den(i,k))
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          supsat = max(q(i,k),qmin)-qs(i,k)
+          satdt = supsat/dtcld
+          if(t(i,k).ge.t0c) then
+!
+!===============================================================
+!
+! warm rain processes
+!
+! - follows the processes in RH83 and LFO except for autoconcersion
+!
+!===============================================================
+!---------------------------------------------------------------
+! praut: auto conversion rate from cloud to rain [HDC 16]
+!        (C->R)
+!---------------------------------------------------------------
+            if(qci(i,k).gt.qc0) then
+!             paut(i,k) = qck1*qci(i,k)**(7./3.)
+              paut(i,k) = qck1*exp(log(qci(i,k))*((7./3.)))
+              paut(i,k) = min(paut(i,k),qci(i,k)/dtcld)
+            endif
+!---------------------------------------------------------------
+! pracw: accretion of cloud water by rain [HL A40] [D89 B15]
+!        (C->R)
+!---------------------------------------------------------------
+            if(qrs(i,k).gt.qcrmin.and.qci(i,k).gt.qmin) then
+                pacr(i,k) = min(pacrr*rslope3(i,k)*rslopeb(i,k)          &
+                     *qci(i,k)*denfac(i,k),qci(i,k)/dtcld)
+            endif
+!---------------------------------------------------------------
+! prevp: evaporation/condensation rate of rain [HDC 14]
+!        (V->R or R->V)
+!---------------------------------------------------------------
+            if(qrs(i,k).gt.0.) then
+                coeres = rslope2(i,k)*sqrt(rslope(i,k)*rslopeb(i,k))
+                pres(i,k) = (rh(i,k)-1.)*(precr1*rslope2(i,k)            &
+                         +precr2*work2(i,k)*coeres)/work1(i,k)
+              if(pres(i,k).lt.0.) then
+                pres(i,k) = max(pres(i,k),-qrs(i,k)/dtcld)
+                pres(i,k) = max(pres(i,k),satdt/2)
+              else
+                pres(i,k) = min(pres(i,k),satdt/2)
+              endif
+            endif
+          else
+!
+!===============================================================
+!
+! cold rain processes
+!
+! - follows the revised ice microphysics processes in HDC
+! - the processes same as in RH83 and LFO behave
+!   following ice crystal hapits defined in HDC, inclduing
+!   intercept parameter for snow (n0s), ice crystal number
+!   concentration (ni), ice nuclei number concentration
+!   (n0i), ice diameter (d)
+!
+!===============================================================
+!
+            supcol = t0c-t(i,k)
+            ifsat = 0
+!-------------------------------------------------------------
+! Ni: ice crystal number concentraiton   [HDC 5c]
+!-------------------------------------------------------------
+!           xni(i,k) = min(max(5.38e7*(den(i,k)                         &
+!                     *max(qci(i,k),qmin))**0.75,1.e3),1.e6)
+            xni(i,k) = min(max(5.38e7*exp(log((den(i,k)*max(qci(i,k),qmin)))*(0.75)),1.e3),1.e6)
+            eacrs = exp(0.07*(-supcol))
+!
+            if(qrs(i,k).gt.qcrmin.and.qci(i,k).gt.qmin) then
+              xmi = den(i,k)*qci(i,k)/xni(i,k)
+              diameter  = min(dicon * sqrt(xmi),dimax)
+              vt2i = 1.49e4*diameter**1.31
+              vt2s = pvts*rslopeb(i,k)*denfac(i,k)
+!-------------------------------------------------------------
+! praci: Accretion of cloud ice by rain [HL A15] [LFO 25]
+!        (T<T0: I->R)
+!-------------------------------------------------------------
+              acrfac = 2.*rslope3(i,k)+2.*diameter*rslope2(i,k)          &
+                      +diameter**2*rslope(i,k)
+              pacr(i,k) = min(pi*qci(i,k)*eacrs*n0s*n0sfac(i,k)          &
+                       *abs(vt2s-vt2i)*acrfac/4.,qci(i,k)/dtcld)
+            endif
+!-------------------------------------------------------------
+! pidep: Deposition/Sublimation rate of ice [HDC 9]
+!       (T<T0: V->I or I->V)
+!-------------------------------------------------------------
+            if(qci(i,k).gt.0.) then
+              xmi = den(i,k)*qci(i,k)/xni(i,k)
+              diameter = dicon * sqrt(xmi)
+              pisd(i,k) = 4.*diameter*xni(i,k)*(rh(i,k)-1.)/work1(i,k)
+              if(pisd(i,k).lt.0.) then
+                pisd(i,k) = max(pisd(i,k),satdt/2)
+                pisd(i,k) = max(pisd(i,k),-qci(i,k)/dtcld)
+              else
+                pisd(i,k) = min(pisd(i,k),satdt/2)
+              endif
+              if(abs(pisd(i,k)).ge.abs(satdt)) ifsat = 1
+            endif
+!-------------------------------------------------------------
+! psdep: deposition/sublimation rate of snow [HDC 14]
+!        (V->S or S->V)
+!-------------------------------------------------------------
+            if(qrs(i,k).gt.0..and.ifsat.ne.1) then
+              coeres = rslope2(i,k)*sqrt(rslope(i,k)*rslopeb(i,k))
+              pres(i,k) = (rh(i,k)-1.)*n0sfac(i,k)*(precs1*rslope2(i,k)   &
+                        +precs2*work2(i,k)*coeres)/work1(i,k)
+              supice = satdt-pisd(i,k)
+              if(pres(i,k).lt.0.) then
+                pres(i,k) = max(pres(i,k),-qrs(i,k)/dtcld)
+                pres(i,k) = max(max(pres(i,k),satdt/2),supice)
+              else
+                pres(i,k) = min(min(pres(i,k),satdt/2),supice)
+              endif
+              if(abs(pisd(i,k)+pres(i,k)).ge.abs(satdt)) ifsat = 1
+            endif
+!-------------------------------------------------------------
+! pigen: generation(nucleation) of ice from vapor [HDC 7-8]
+!       (T<T0: V->I)
+!-------------------------------------------------------------
+            if(supsat.gt.0.and.ifsat.ne.1) then
+              supice = satdt-pisd(i,k)-pres(i,k)
+              xni0 = 1.e3*exp(0.1*supcol)
+!             roqi0 = 4.92e-11*xni0**1.33
+              roqi0 = 4.92e-11*exp(log(xni0)*(1.33))
+              pgen(i,k) = max(0.,(roqi0/den(i,k)-max(qci(i,k),0.))/dtcld)
+              pgen(i,k) = min(min(pgen(i,k),satdt),supice)
+            endif
+!-------------------------------------------------------------
+! psaut: conversion(aggregation) of ice to snow [HDC 12]
+!       (T<T0: I->S)
+!-------------------------------------------------------------
+            if(qci(i,k).gt.0.) then
+              qimax = roqimax/den(i,k)
+              paut(i,k) = max(0.,(qci(i,k)-qimax)/dtcld)
+            endif
+          endif
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     check mass conservation of generation terms and feedback to the
+!     large scale
+!
+      do k = kts, kte
+        do i = its, ite
+          qciik = max(qmin,qci(i,k))
+          delqci = (paut(i,k)+pacr(i,k)-pgen(i,k)-pisd(i,k))*dtcld
+          if(delqci.ge.qciik) then
+            facqci = qciik/delqci
+            paut(i,k) = paut(i,k)*facqci
+            pacr(i,k) = pacr(i,k)*facqci
+            pgen(i,k) = pgen(i,k)*facqci
+            pisd(i,k) = pisd(i,k)*facqci
+          endif
+          qik = max(qmin,q(i,k))
+          delq = (pres(i,k)+pgen(i,k)+pisd(i,k))*dtcld
+          if(delq.ge.qik) then
+            facq = qik/delq
+            pres(i,k) = pres(i,k)*facq
+            pgen(i,k) = pgen(i,k)*facq
+            pisd(i,k) = pisd(i,k)*facq
+          endif
+          work2(i,k) = -pres(i,k)-pgen(i,k)-pisd(i,k)
+          q(i,k) = q(i,k)+work2(i,k)*dtcld
+          qci(i,k) = max(qci(i,k)-(paut(i,k)+pacr(i,k)-pgen(i,k)     &
+                   -pisd(i,k))*dtcld,0.)
+          qrs(i,k) = max(qrs(i,k)+(paut(i,k)+pacr(i,k)               &
+                   +pres(i,k))*dtcld,0.)
+          if(t(i,k).lt.t0c) then
+            t(i,k) = t(i,k)-xls*work2(i,k)/cpm(i,k)*dtcld
+          else
+            t(i,k) = t(i,k)-xl(i,k)*work2(i,k)/cpm(i,k)*dtcld
+          endif
+        enddo
+      enddo
+!
+      cvap = cpv
+      hvap = xlv0
+      hsub = xls
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      do k = kts, kte
+        do i = its, ite
+          tr=ttp/t(i,k)
+!         qs(i,k)=psat*(tr**xa)*exp(xb*(1.-tr))
+          qs(i,k)=psat*(exp(log(tr)*(xa)))*exp(xb*(1.-tr))
+          qs(i,k) = ep2 * qs(i,k) / (p(i,k) - qs(i,k))
+          qs(i,k) = max(qs(i,k),qmin)
+          denfac(i,k) = sqrt(den0/den(i,k))
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!  pcond: condensational/evaporational rate of cloud water [HL A46] [RH83 A6]
+!     if there exists additional water vapor condensated/if
+!     evaporation of cloud water is not enough to remove subsaturation
+!
+      do k = kts, kte
+        do i = its, ite
+          work1(i,k) = conden(t(i,k),q(i,k),qs(i,k),xl(i,k),cpm(i,k))
+          work2(i,k) = qci(i,k)+work1(i,k)
+          pcon(i,k) = min(max(work1(i,k),0.),max(q(i,k),0.))/dtcld
+          if(qci(i,k).gt.0..and.work1(i,k).lt.0.and.t(i,k).gt.t0c)      &
+            pcon(i,k) = max(work1(i,k),-qci(i,k))/dtcld
+          q(i,k) = q(i,k)-pcon(i,k)*dtcld
+          qci(i,k) = max(qci(i,k)+pcon(i,k)*dtcld,0.)
+          t(i,k) = t(i,k)+pcon(i,k)*xl(i,k)/cpm(i,k)*dtcld
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     padding for small values
+!
+      do k = kts, kte
+        do i = its, ite
+          if(qci(i,k).le.qmin) qci(i,k) = 0.0
+        enddo
+      enddo
+!
+      enddo                  ! big loops
+  END SUBROUTINE wsm32D
+! ...................................................................
+      REAL FUNCTION rgmma(x)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!     rgmma function:  use infinite product form
+      REAL :: euler
+      PARAMETER (euler=0.577215664901532)
+      REAL :: x, y
+      INTEGER :: i
+      if(x.eq.1.)then
+        rgmma=0.
+          else
+        rgmma=x*exp(euler*x)
+        do i=1,10000
+          y=float(i)
+          rgmma=rgmma*(1.000+x/y)*exp(-x/y)
+        enddo
+        rgmma=1./rgmma
+      endif
+      END FUNCTION rgmma
+!
+!--------------------------------------------------------------------------
+      REAL FUNCTION fpvs(t,ice,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c)
+!--------------------------------------------------------------------------
+      IMPLICIT NONE
+!--------------------------------------------------------------------------
+      REAL t,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c,dldt,xa,xb,dldti,   &
+           xai,xbi,ttp,tr
+      INTEGER ice
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      tr=ttp/t
+      if(t.lt.ttp.and.ice.eq.1) then
+        fpvs=psat*(tr**xai)*exp(xbi*(1.-tr))
+      else
+        fpvs=psat*(tr**xa)*exp(xb*(1.-tr))
+      endif
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END FUNCTION fpvs
+!-------------------------------------------------------------------
+  SUBROUTINE wsm3init(den0,denr,dens,cl,cpv,allowed_to_read)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!.... constants which may not be tunable
+   REAL, INTENT(IN) :: den0,denr,dens,cl,cpv
+   LOGICAL, INTENT(IN) :: allowed_to_read
+   REAL :: pi
+!
+   pi = 4.*atan(1.)
+   xlv1 = cl-cpv
+!
+   qc0  = 4./3.*pi*denr*r0**3*xncr/den0  ! 0.419e-3 -- .61e-3
+   qck1 = .104*9.8*peaut/(xncr*denr)**(1./3.)/xmyu*den0**(4./3.) ! 7.03
+!
+   bvtr1 = 1.+bvtr
+   bvtr2 = 2.5+.5*bvtr
+   bvtr3 = 3.+bvtr
+   bvtr4 = 4.+bvtr
+   g1pbr = rgmma(bvtr1)
+   g3pbr = rgmma(bvtr3)
+   g4pbr = rgmma(bvtr4)            ! 17.837825
+   g5pbro2 = rgmma(bvtr2)          ! 1.8273
+   pvtr = avtr*g4pbr/6.
+   eacrr = 1.0
+   pacrr = pi*n0r*avtr*g3pbr*.25*eacrr
+   precr1 = 2.*pi*n0r*.78
+   precr2 = 2.*pi*n0r*.31*avtr**.5*g5pbro2
+   xm0  = (di0/dicon)**2
+   xmmax = (dimax/dicon)**2
+   roqimax = 2.08e22*dimax**8
+!
+   bvts1 = 1.+bvts
+   bvts2 = 2.5+.5*bvts
+   bvts3 = 3.+bvts
+   bvts4 = 4.+bvts
+   g1pbs = rgmma(bvts1)    !.8875
+   g3pbs = rgmma(bvts3)
+   g4pbs = rgmma(bvts4)    ! 12.0786
+   g5pbso2 = rgmma(bvts2)
+   pvts = avts*g4pbs/6.
+   pacrs = pi*n0s*avts*g3pbs*.25
+   precs1 = 4.*n0s*.65
+   precs2 = 4.*n0s*.44*avts**.5*g5pbso2
+   pidn0r =  pi*denr*n0r
+   pidn0s =  pi*dens*n0s
+!
+   rslopermax = 1./lamdarmax
+   rslopesmax = 1./lamdasmax
+   rsloperbmax = rslopermax ** bvtr
+   rslopesbmax = rslopesmax ** bvts
+   rsloper2max = rslopermax * rslopermax
+   rslopes2max = rslopesmax * rslopesmax
+   rsloper3max = rsloper2max * rslopermax
+   rslopes3max = rslopes2max * rslopesmax
+!
+  END SUBROUTINE wsm3init
+END MODULE module_mp_wsm3
Index: trunk/WRF.COMMON/WRFV2/phys/module_mp_wsm5.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_mp_wsm5.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_mp_wsm5.F	(revision 2744)
@@ -0,0 +1,1195 @@
+#if ( RWORDSIZE == 4 )
+#  define VREC vsrec
+#  define VSQRT vssqrt
+#else
+#  define VREC vrec
+#  define VSQRT vsqrt
+#endif
+
+!Including inline expansion statistical function 
+MODULE module_mp_wsm5
+!
+!
+   REAL, PARAMETER, PRIVATE :: dtcldcr     = 120.
+   REAL, PARAMETER, PRIVATE :: n0r = 8.e6
+   REAL, PARAMETER, PRIVATE :: avtr = 841.9
+   REAL, PARAMETER, PRIVATE :: bvtr = 0.8
+   REAL, PARAMETER, PRIVATE :: r0 = .8e-5 ! 8 microm  in contrast to 10 micro m
+   REAL, PARAMETER, PRIVATE :: peaut = .55   ! collection efficiency
+   REAL, PARAMETER, PRIVATE :: xncr = 3.e8   ! maritime cloud in contrast to 3.e8 in tc80
+   REAL, PARAMETER, PRIVATE :: xmyu = 1.718e-5 ! the dynamic viscosity kgm-1s-1
+   REAL, PARAMETER, PRIVATE :: avts = 11.72
+   REAL, PARAMETER, PRIVATE :: bvts = .41
+   REAL, PARAMETER, PRIVATE :: n0smax =  1.e11 ! t=-90C unlimited
+   REAL, PARAMETER, PRIVATE :: lamdarmax = 8.e4
+   REAL, PARAMETER, PRIVATE :: lamdasmax = 1.e5
+   REAL, PARAMETER, PRIVATE :: lamdagmax = 6.e4
+   REAL, PARAMETER, PRIVATE :: betai = .6
+   REAL, PARAMETER, PRIVATE :: xn0 = 1.e-2
+   REAL, PARAMETER, PRIVATE :: dicon = 11.9
+   REAL, PARAMETER, PRIVATE :: di0 = 12.9e-6
+   REAL, PARAMETER, PRIVATE :: dimax = 500.e-6
+   REAL, PARAMETER, PRIVATE :: n0s = 2.e6             ! temperature dependent n0s
+   REAL, PARAMETER, PRIVATE :: alpha = .12        ! .122 exponen factor for n0s
+   REAL, PARAMETER, PRIVATE :: pfrz1 = 100.
+   REAL, PARAMETER, PRIVATE :: pfrz2 = 0.66
+   REAL, PARAMETER, PRIVATE :: qcrmin = 1.e-9
+   REAL, PARAMETER, PRIVATE :: t40c = 233.16
+   REAL, PARAMETER, PRIVATE :: eacrc = 1.0
+   REAL, SAVE ::                                     &
+             qc0, qck1,bvtr1,bvtr2,bvtr3,bvtr4,g1pbr,&
+             g3pbr,g4pbr,g5pbro2,pvtr,eacrr,pacrr,   &
+             precr1,precr2,xm0,xmmax,roqimax,bvts1,  &
+             bvts2,bvts3,bvts4,g1pbs,g3pbs,g4pbs,    &
+             g5pbso2,pvts,pacrs,precs1,precs2,pidn0r,&
+             pidn0s,xlv1,pacrc,                      &
+             rslopermax,rslopesmax,rslopegmax,       &
+             rsloperbmax,rslopesbmax,rslopegbmax,    &
+             rsloper2max,rslopes2max,rslopeg2max,    &
+             rsloper3max,rslopes3max,rslopeg3max
+!
+! Specifies code-inlining of fpvs function in WSM52D below. JM 20040507
+!
+CONTAINS
+!===================================================================
+!
+  SUBROUTINE wsm5(th, q, qc, qr, qi, qs                            &
+                 ,den, pii, p, delz                                &
+                 ,delt,g, cpd, cpv, rd, rv, t0c                    &
+                 ,ep1, ep2, qmin                                   &
+                 ,XLS, XLV0, XLF0, den0, denr                      &
+                 ,cliq,cice,psat                                   &
+                 ,rain, rainncv                                    &
+                 ,snow, snowncv                                    &
+                 ,sr                                               &
+                 ,ids,ide, jds,jde, kds,kde                        &
+                 ,ims,ime, jms,jme, kms,kme                        &
+                 ,its,ite, jts,jte, kts,kte                        &
+                                                                   )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!
+!  This code is a 5-class mixed ice microphyiscs scheme (WSM5) of the WRF
+!  Single-Moment MicroPhyiscs (WSMMP). The WSMMP assumes that ice nuclei
+!  number concentration is a function of temperature, and seperate assumption
+!  is developed, in which ice crystal number concentration is a function
+!  of ice amount. A theoretical background of the ice-microphysics and related
+!  processes in the WSMMPs are described in Hong et al. (2004).
+!  Production terms in the WSM6 scheme are described in Hong and Lim (2006).
+!  All units are in m.k.s. and source/sink terms in kgkg-1s-1.
+!
+!  WSM5 cloud scheme
+!
+!  Coded by Song-You Hong (Yonsei Univ.)
+!             Jimy Dudhia (NCAR) and Shu-Hua Chen (UC Davis)
+!             Summer 2002
+!
+!  Implemented by Song-You Hong (Yonsei Univ.) and Jimy Dudhia (NCAR)
+!             Summer 2003
+!
+!  Reference) Hong, Dudhia, Chen (HDC, 2004) Mon. Wea. Rev.
+!             Rutledge, Hobbs (RH83, 1983) J. Atmos. Sci.
+!             Hong and Lim (HL, 2006) J. Korean Meteor. Soc.
+!
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(INOUT) ::                                          &
+                                                             th,  &
+                                                              q,  &
+                                                              qc, &
+                                                              qi, &
+                                                              qr, &
+                                                              qs
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(IN   ) ::                                          &
+                                                             den, &
+                                                             pii, &
+                                                               p, &
+                                                            delz
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                              rd, &
+                                                              rv, &
+                                                             t0c, &
+                                                            den0, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             XLS, &
+                                                            XLV0, &
+                                                            XLF0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime , jms:jme ),                           &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv, &
+                                                              sr
+
+  REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL,                &
+        INTENT(INOUT) ::                                    snow, &
+                                                         snowncv
+
+! LOCAL VAR
+  REAL, DIMENSION( its:ite , kts:kte ) ::   t
+  REAL, DIMENSION( its:ite , kts:kte, 2 ) ::   qci, qrs
+  INTEGER ::               i,j,k
+!-------------------------------------------------------------------
+      DO j=jts,jte
+         DO k=kts,kte
+         DO i=its,ite
+            t(i,k)=th(i,k,j)*pii(i,k,j)
+            qci(i,k,1) = qc(i,k,j)
+            qci(i,k,2) = qi(i,k,j)
+            qrs(i,k,1) = qr(i,k,j)
+            qrs(i,k,2) = qs(i,k,j)
+         ENDDO
+         ENDDO
+         CALL wsm52D(t, q(ims,kms,j), qci, qrs                     &
+                    ,den(ims,kms,j)                                &
+                    ,p(ims,kms,j), delz(ims,kms,j)                 &
+                    ,delt,g, cpd, cpv, rd, rv, t0c                 &
+                    ,ep1, ep2, qmin                                &
+                    ,XLS, XLV0, XLF0, den0, denr                   &
+                    ,cliq,cice,psat                                &
+                    ,j                                             &
+                    ,rain(ims,j),rainncv(ims,j)                    &
+                    ,sr(ims,j)                                     &
+                    ,ids,ide, jds,jde, kds,kde                     &
+                    ,ims,ime, jms,jme, kms,kme                     &
+                    ,its,ite, jts,jte, kts,kte                     &
+                    ,snow(ims,j),snowncv(ims,j)                    &
+                                                                   )
+         DO K=kts,kte
+         DO I=its,ite
+            th(i,k,j)=t(i,k)/pii(i,k,j)
+            qc(i,k,j) = qci(i,k,1)
+            qi(i,k,j) = qci(i,k,2)
+            qr(i,k,j) = qrs(i,k,1)
+            qs(i,k,j) = qrs(i,k,2)
+         ENDDO
+         ENDDO
+      ENDDO
+  END SUBROUTINE wsm5
+!===================================================================
+!
+  SUBROUTINE wsm52D(t, q, qci, qrs, den, p, delz                   &
+                   ,delt,g, cpd, cpv, rd, rv, t0c                  &
+                   ,ep1, ep2, qmin                                 &
+                   ,XLS, XLV0, XLF0, den0, denr                    &
+                   ,cliq,cice,psat                                 &
+                   ,lat                                            &
+                   ,rain,rainncv                                   &
+                   ,sr                                             &
+                   ,ids,ide, jds,jde, kds,kde                      &
+                   ,ims,ime, jms,jme, kms,kme                      &
+                   ,its,ite, jts,jte, kts,kte                      &
+                   ,snow,snowncv                                   &
+                                                                   )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte,  &
+                                      lat
+  REAL, DIMENSION( its:ite , kts:kte ),                           &
+        INTENT(INOUT) ::                                          &
+                                                               t
+  REAL, DIMENSION( its:ite , kts:kte, 2 ),                        &
+        INTENT(INOUT) ::                                          &
+                                                             qci, &
+                                                             qrs
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(INOUT) ::                                          &
+                                                               q
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(IN   ) ::                                          &
+                                                             den, &
+                                                               p, &
+                                                            delz
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             t0c, &
+                                                            den0, &
+                                                              rd, &
+                                                              rv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             XLS, &
+                                                            XLV0, &
+                                                            XLF0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime ),                                     &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv, &
+                                                              sr
+
+  REAL, DIMENSION( ims:ime ),     OPTIONAL,                       &
+        INTENT(INOUT) ::                                    snow, &
+                                                         snowncv
+
+! LOCAL VAR
+  REAL, DIMENSION( its:ite , kts:kte , 2) ::                      &
+        rh, qs, rslope, rslope2, rslope3, rslopeb,                &
+        falk, fall, work1
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+              falkc, work1c, work2c, fallc
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+        praut, psaut, prevp, psdep, pracw, psaci, psacw,          &  
+        pigen, pidep, pcond, xl, cpm, work2, psmlt, psevp, denfac, xni,&
+        n0sfac
+! variables for optimization
+  REAL, DIMENSION( its:ite )           :: tvec1
+  INTEGER, DIMENSION( its:ite ) :: mstep, numdt
+  REAL, DIMENSION(its:ite) :: rmstep
+  REAL dtcldden, rdelz, rdtcld
+  LOGICAL, DIMENSION( its:ite ) :: flgcld
+  REAL  ::  pi,                                                   &
+            cpmcal, xlcal, lamdar, lamdas, diffus,                &
+            viscos, xka, venfac, conden, diffac,                  &
+            x, y, z, a, b, c, d, e,                               &
+            qdt, holdrr, holdrs, supcol, pvt,                     &
+            coeres, supsat, dtcld, xmi, eacrs, satdt,             &
+            vt2i,vt2s,acrfac,                                     &
+            qimax, diameter, xni0, roqi0,                         &
+            fallsum, fallsum_qsi, xlwork2, factor, source,        &
+            value, xlf, pfrzdtc, pfrzdtr, supice
+  REAL :: temp 
+  REAL  :: holdc, holdci
+  INTEGER :: i, j, k, mstepmax,                                   &
+            iprt, latd, lond, loop, loops, ifsat, n
+! Temporaries used for inlining fpvs function
+  REAL  :: dldti, xb, xai, tr, xbi, xa, hvap, cvap, hsub, dldt, ttp
+!
+!=================================================================
+!   compute internal functions
+!
+      cpmcal(x) = cpd*(1.-max(x,qmin))+max(x,qmin)*cpv
+      xlcal(x) = xlv0-xlv1*(x-t0c)
+!----------------------------------------------------------------
+!     size distributions: (x=mixing ratio, y=air density):
+!     valid for mixing ratio > 1.e-9 kg/kg.
+!
+! Optimizatin : A**B => exp(log(A)*(B))
+      lamdar(x,y)=   sqrt(sqrt(pidn0r/(x*y)))      ! (pidn0r/(x*y))**.25
+      lamdas(x,y,z)= sqrt(sqrt(pidn0s*z/(x*y)))    ! (pidn0s*z/(x*y))**.25
+!
+!----------------------------------------------------------------
+!     diffus: diffusion coefficient of the water vapor
+!     viscos: kinematic viscosity(m2s-1)
+!     diffus(x,y) = 8.794e-5 * exp(log(x)*(1.81)) / y        ! 8.794e-5*x**1.81/y
+!     viscos(x,y) = 1.496e-6 * (x*sqrt(x)) /(x+120.)/y  ! 1.496e-6*x**1.5/(x+120.)/y
+!     xka(x,y) = 1.414e3*viscos(x,y)*y
+!     diffac(a,b,c,d,e) = d*a*a/(xka(c,d)*rv*c*c)+1./(e*diffus(c,b))
+!     venfac(a,b,c) = exp(log((viscos(b,c)/diffus(b,a)))*((.3333333)))    &
+!                    /sqrt(viscos(b,c))*sqrt(sqrt(den0/c))
+!     conden(a,b,c,d,e) = (max(b,qmin)-c)/(1.+d*d/(rv*e)*c/(a*a))
+!
+!
+      pi = 4. * atan(1.)
+!
+!----------------------------------------------------------------
+!     paddint 0 for negative values generated by dynamics
+!
+      do k = kts, kte
+        do i = its, ite
+          qci(i,k,1) = max(qci(i,k,1),0.0)
+          qrs(i,k,1) = max(qrs(i,k,1),0.0)
+          qci(i,k,2) = max(qci(i,k,2),0.0)
+          qrs(i,k,2) = max(qrs(i,k,2),0.0)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     latent heat for phase changes and heat capacity. neglect the
+!     changes during microphysical process calculation
+!     emanuel(1994)
+!
+      do k = kts, kte
+        do i = its, ite
+          cpm(i,k) = cpmcal(q(i,k))
+          xl(i,k) = xlcal(t(i,k))
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     compute the minor time steps.
+!
+      loops = max(nint(delt/dtcldcr),1)
+      dtcld = delt/loops
+      if(delt.le.dtcldcr) dtcld = delt
+!
+      do loop = 1,loops
+!
+!----------------------------------------------------------------
+!     initialize the large scale variables
+!
+      do i = its, ite
+        mstep(i) = 1
+        flgcld(i) = .true.
+      enddo
+!
+!     do k = kts, kte
+!       do i = its, ite
+!         denfac(i,k) = sqrt(den0/den(i,k))
+!       enddo
+!     enddo
+      do k = kts, kte
+        CALL VREC( tvec1(its), den(its,k), ite-its+1)
+        do i = its, ite
+          tvec1(i) = tvec1(i)*den0
+        enddo
+        CALL VSQRT( denfac(its,k), tvec1(its), ite-its+1)
+      enddo
+!
+! Inline expansion for fpvs
+!         qs(i,k,1) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+!         qs(i,k,2) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+      hsub = xls
+      hvap = xlv0
+      cvap = cpv
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      do k = kts, kte
+        do i = its, ite
+          tr=ttp/t(i,k)
+          qs(i,k,1)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
+          qs(i,k,1) = ep2 * qs(i,k,1) / (p(i,k) - qs(i,k,1))
+          qs(i,k,1) = max(qs(i,k,1),qmin)
+          rh(i,k,1) = max(q(i,k) / qs(i,k,1),qmin)
+          tr=ttp/t(i,k)
+          if(t(i,k).lt.ttp) then
+            qs(i,k,2)=psat*exp(log(tr)*(xai))*exp(xbi*(1.-tr))
+          else
+            qs(i,k,2)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
+          endif
+          qs(i,k,2) = ep2 * qs(i,k,2) / (p(i,k) - qs(i,k,2))
+          qs(i,k,2) = max(qs(i,k,2),qmin)
+          rh(i,k,2) = max(q(i,k) / qs(i,k,2),qmin)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     initialize the variables for microphysical physics
+!
+!
+      do k = kts, kte
+        do i = its, ite
+          prevp(i,k) = 0.
+          psdep(i,k) = 0.
+          praut(i,k) = 0.
+          psaut(i,k) = 0.
+          pracw(i,k) = 0.
+          psaci(i,k) = 0.
+          psacw(i,k) = 0.
+          pigen(i,k) = 0.
+          pidep(i,k) = 0.
+          pcond(i,k) = 0.
+          psmlt(i,k) = 0.
+          psevp(i,k) = 0.
+          falk(i,k,1) = 0.
+          falk(i,k,2) = 0.
+          fall(i,k,1) = 0.
+          fall(i,k,2) = 0.
+          fallc(i,k) = 0.
+          falkc(i,k) = 0.
+          xni(i,k) = 1.e3
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     compute the fallout term:
+!     first, vertical terminal velosity for minor loops
+!
+      do k = kts, kte
+        do i = its, ite
+          supcol = t0c-t(i,k)
+!---------------------------------------------------------------
+! n0s: Intercept parameter for snow [m-4] [HDC 6]
+!---------------------------------------------------------------
+          n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.)
+          if(qrs(i,k,1).le.qcrmin)then
+            rslope(i,k,1) = rslopermax
+            rslopeb(i,k,1) = rsloperbmax
+            rslope2(i,k,1) = rsloper2max
+            rslope3(i,k,1) = rsloper3max
+          else
+            rslope(i,k,1) = 1./lamdar(qrs(i,k,1),den(i,k))
+            rslopeb(i,k,1) = exp(log(rslope(i,k,1))*(bvtr))
+            rslope2(i,k,1) = rslope(i,k,1)*rslope(i,k,1)
+            rslope3(i,k,1) = rslope2(i,k,1)*rslope(i,k,1)
+          endif
+          if(qrs(i,k,2).le.qcrmin)then
+            rslope(i,k,2) = rslopesmax
+            rslopeb(i,k,2) = rslopesbmax
+            rslope2(i,k,2) = rslopes2max
+            rslope3(i,k,2) = rslopes3max
+          else
+            rslope(i,k,2) = 1./lamdas(qrs(i,k,2),den(i,k),n0sfac(i,k))
+            rslopeb(i,k,2) = exp(log(rslope(i,k,2))*(bvts))
+            rslope2(i,k,2) = rslope(i,k,2)*rslope(i,k,2)
+            rslope3(i,k,2) = rslope2(i,k,2)*rslope(i,k,2)
+          endif
+!-------------------------------------------------------------
+! Ni: ice crystal number concentraiton   [HDC 5c]
+!-------------------------------------------------------------
+!         xni(i,k) = min(max(5.38e7*(den(i,k)                           &
+!                   *max(qci(i,k,2),qmin))**0.75,1.e3),1.e6)
+          temp = (den(i,k)*max(qci(i,k,2),qmin))
+          temp = sqrt(sqrt(temp*temp*temp))
+          xni(i,k) = min(max(5.38e7*temp,1.e3),1.e6)
+        enddo
+      enddo
+!
+      mstepmax = 1
+      numdt = 1
+      do k = kte, kts, -1
+        do i = its, ite
+          work1(i,k,1) = pvtr*rslopeb(i,k,1)*denfac(i,k)/delz(i,k)
+          work1(i,k,2) = pvts*rslopeb(i,k,2)*denfac(i,k)/delz(i,k)
+          numdt(i) = max(nint(max(work1(i,k,1),work1(i,k,2))*dtcld+.5),1)
+          if(numdt(i).ge.mstep(i)) mstep(i) = numdt(i)
+        enddo
+      enddo
+      do i = its, ite
+        if(mstepmax.le.mstep(i)) mstepmax = mstep(i)
+        rmstep(i) = 1./mstep(i)
+      enddo
+!
+      do n = 1, mstepmax
+        k = kte
+        do i = its, ite
+          if(n.le.mstep(i)) then
+!             falk(i,k,1) = den(i,k)*qrs(i,k,1)*work1(i,k,1)/mstep(i)
+!             falk(i,k,2) = den(i,k)*qrs(i,k,2)*work1(i,k,2)/mstep(i)
+              falk(i,k,1) = den(i,k)*qrs(i,k,1)*work1(i,k,1)*rmstep(i)
+              falk(i,k,2) = den(i,k)*qrs(i,k,2)*work1(i,k,2)*rmstep(i)
+              fall(i,k,1) = fall(i,k,1)+falk(i,k,1)
+              fall(i,k,2) = fall(i,k,2)+falk(i,k,2)
+!             qrs(i,k,1) = max(qrs(i,k,1)-falk(i,k,1)*dtcld/den(i,k),0.)
+!             qrs(i,k,2) = max(qrs(i,k,2)-falk(i,k,2)*dtcld/den(i,k),0.)
+              dtcldden = dtcld/den(i,k)
+              qrs(i,k,1) = max(qrs(i,k,1)-falk(i,k,1)*dtcldden,0.)
+              qrs(i,k,2) = max(qrs(i,k,2)-falk(i,k,2)*dtcldden,0.)
+            endif
+          enddo
+        do k = kte-1, kts, -1
+          do i = its, ite
+            if(n.le.mstep(i)) then
+!             falk(i,k,1) = den(i,k)*qrs(i,k,1)*work1(i,k,1)/mstep(i)
+!             falk(i,k,2) = den(i,k)*qrs(i,k,2)*work1(i,k,2)/mstep(i)
+              falk(i,k,1) = den(i,k)*qrs(i,k,1)*work1(i,k,1)*rmstep(i)
+              falk(i,k,2) = den(i,k)*qrs(i,k,2)*work1(i,k,2)*rmstep(i)
+              fall(i,k,1) = fall(i,k,1)+falk(i,k,1)
+              fall(i,k,2) = fall(i,k,2)+falk(i,k,2)
+!             qrs(i,k,1) = max(qrs(i,k,1)-(falk(i,k,1)-falk(i,k+1,1)    &
+!                         *delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+!             qrs(i,k,2) = max(qrs(i,k,2)-(falk(i,k,2)-falk(i,k+1,2)    &
+!                         *delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+              dtcldden = dtcld/den(i,k)
+              rdelz = 1./delz(i,k)
+              qrs(i,k,1) = max(qrs(i,k,1)-(falk(i,k,1)-falk(i,k+1,1)    &
+                          *delz(i,k+1)*rdelz)*dtcldden,0.)
+              qrs(i,k,2) = max(qrs(i,k,2)-(falk(i,k,2)-falk(i,k+1,2)    &
+                          *delz(i,k+1)*rdelz)*dtcldden,0.)
+            endif
+          enddo
+        enddo
+        do k = kte, kts, -1
+          do i = its, ite
+            if(n.le.mstep(i)) then
+              if(t(i,k).gt.t0c.and.qrs(i,k,2).gt.0.) then
+!----------------------------------------------------------------
+! psmlt: melting of snow [HL A33] [RH83 A25]
+!       (T>T0: S->R)
+!----------------------------------------------------------------
+                xlf = xlf0
+!               work2(i,k)= venfac(p(i,k),t(i,k),den(i,k))
+                work2(i,k)= (exp(log(((1.496e-6*((t(i,k))*sqrt(t(i,k))) &
+                            /((t(i,k))+120.)/(den(i,k)))/(8.794e-5      &
+                            *exp(log(t(i,k))*(1.81))/p(i,k))))          &
+                            *((.3333333)))/sqrt((1.496e-6*((t(i,k))     &
+                            *sqrt(t(i,k)))/((t(i,k))+120.)/(den(i,k)))) &
+                            *sqrt(sqrt(den0/(den(i,k)))))
+                coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2))
+!               psmlt(i,k) = xka(t(i,k),den(i,k))/xlf*(t0c-t(i,k))*pi/2. &
+!                           *n0sfac(i,k)*(precs1*rslope2(i,k,2)+precs2  &
+!                           *work2(i,k)*coeres)
+                psmlt(i,k) = &
+(1.414e3*(1.496e-6 * ((t(i,k))*sqrt(t(i,k))) /((t(i,k))+120.)/(den(i,k)) )*(den(i,k)))&
+                            /xlf*(t0c-t(i,k))*pi/2.                     &
+                            *n0sfac(i,k)*(precs1*rslope2(i,k,2)+precs2  &
+                            *work2(i,k)*coeres)
+                psmlt(i,k) = min(max(psmlt(i,k)*dtcld/mstep(i),           &
+                            -qrs(i,k,2)/mstep(i)),0.)
+                qrs(i,k,2) = qrs(i,k,2) + psmlt(i,k)
+                qrs(i,k,1) = qrs(i,k,1) - psmlt(i,k)
+                t(i,k) = t(i,k) + xlf/cpm(i,k)*psmlt(i,k)
+              endif
+            endif
+          enddo
+        enddo
+      enddo
+!---------------------------------------------------------------
+! Vice [ms-1] : fallout of ice crystal [HDC 5a]
+!---------------------------------------------------------------
+      mstepmax = 1
+      mstep = 1
+      numdt = 1
+      do k = kte, kts, -1
+        do i = its, ite
+          if(qci(i,k,2).le.0.) then
+            work2c(i,k) = 0.
+          else
+            xmi = den(i,k)*qci(i,k,2)/xni(i,k)
+!           diameter  = min(dicon * sqrt(xmi),dimax)
+            diameter  = max(min(dicon * sqrt(xmi),dimax), 1.e-25)
+            work1c(i,k) = 1.49e4*exp(log(diameter)*(1.31))
+            work2c(i,k) = work1c(i,k)/delz(i,k)
+          endif
+          numdt(i) = max(nint(work2c(i,k)*dtcld+.5),1)
+          if(numdt(i).ge.mstep(i)) mstep(i) = numdt(i)
+        enddo
+      enddo
+      do i = its, ite
+        if(mstepmax.le.mstep(i)) mstepmax = mstep(i)
+      enddo
+!
+      do n = 1, mstepmax
+        k = kte
+        do i = its, ite
+          if(n.le.mstep(i)) then
+            falkc(i,k) = den(i,k)*qci(i,k,2)*work2c(i,k)/mstep(i)
+            holdc = falkc(i,k)
+            fallc(i,k) = fallc(i,k)+falkc(i,k)
+            holdci = qci(i,k,2)
+            qci(i,k,2) = max(qci(i,k,2)-falkc(i,k)*dtcld/den(i,k),0.)
+          endif
+        enddo
+        do k = kte-1, kts, -1
+          do i = its, ite
+            if(n.le.mstep(i)) then
+              falkc(i,k) = den(i,k)*qci(i,k,2)*work2c(i,k)/mstep(i)
+              holdc = falkc(i,k)
+              fallc(i,k) = fallc(i,k)+falkc(i,k)
+              holdci = qci(i,k,2)
+              qci(i,k,2) = max(qci(i,k,2)-(falkc(i,k)-falkc(i,k+1)      &
+                          *delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+            endif
+          enddo
+        enddo
+      enddo
+!
+!
+!----------------------------------------------------------------
+!      rain (unit is mm/sec;kgm-2s-1: /1000*delt ===> m)==> mm for wrf
+!
+      do i = its, ite
+        fallsum = fall(i,1,1)+fall(i,1,2)+fallc(i,1)
+        fallsum_qsi = fall(i,1,2)+fallc(i,1)
+        rainncv(i) = 0.
+        if(fallsum.gt.0.) then
+          rainncv(i) = fallsum*delz(i,1)/denr*dtcld*1000.
+          rain(i) = fallsum*delz(i,1)/denr*dtcld*1000. + rain(i)
+        endif
+        IF ( PRESENT (snowncv) .AND. PRESENT (snow)) THEN
+        snowncv(i) = 0.
+        if(fallsum_qsi.gt.0.) then
+          snowncv(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000.
+          snow(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000. + snow(i)
+        endif
+        ENDIF
+        sr(i) = 0.
+        if(fallsum.gt.0.)sr(i)=fallsum_qsi*delz(i,kts)/denr*dtcld*1000./(rainncv(i)+1.e-12)
+      enddo
+!
+!---------------------------------------------------------------
+! pimlt: instantaneous melting of cloud ice [HL A47] [RH83 A28]
+!       (T>T0: I->C)
+!---------------------------------------------------------------
+      do k = kts, kte
+        do i = its, ite
+          supcol = t0c-t(i,k)
+          xlf = xls-xl(i,k)
+          if(supcol.lt.0.) xlf = xlf0
+          if(supcol.lt.0.and.qci(i,k,2).gt.0.) then
+            qci(i,k,1) = qci(i,k,1) + qci(i,k,2)
+            t(i,k) = t(i,k) - xlf/cpm(i,k)*qci(i,k,2)
+            qci(i,k,2) = 0.
+          endif
+!---------------------------------------------------------------
+! pihmf: homogeneous freezing of cloud water below -40c [HL A45]
+!        (T<-40C: C->I)
+!---------------------------------------------------------------
+          if(supcol.gt.40..and.qci(i,k,1).gt.0.) then
+            qci(i,k,2) = qci(i,k,2) + qci(i,k,1)
+            t(i,k) = t(i,k) + xlf/cpm(i,k)*qci(i,k,1)
+            qci(i,k,1) = 0.
+          endif
+!---------------------------------------------------------------
+! pihtf: heterogeneous freezing of cloud water [HL A44]
+!        (T0>T>-40C: C->I)
+!---------------------------------------------------------------
+          if(supcol.gt.0..and.qci(i,k,1).gt.0.) then
+!           pfrzdtc = min(pfrz1*(exp(pfrz2*supcol)-1.)                  &
+!              *den(i,k)/denr/xncr*qci(i,k,1)**2*dtcld,qci(i,k,1))
+            pfrzdtc = min(pfrz1*(exp(pfrz2*supcol)-1.)                  &
+            *den(i,k)/denr/xncr*qci(i,k,1)*qci(i,k,1)*dtcld,qci(i,k,1))
+            qci(i,k,2) = qci(i,k,2) + pfrzdtc
+            t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtc
+            qci(i,k,1) = qci(i,k,1)-pfrzdtc
+          endif
+!---------------------------------------------------------------
+! psfrz: freezing of rain water [HL A20] [LFO 45]
+!        (T<T0, R->S)
+!---------------------------------------------------------------
+          if(supcol.gt.0..and.qrs(i,k,1).gt.0.) then
+!           pfrzdtr = min(20.*pi**2*pfrz1*n0r*denr/den(i,k)             &
+!                 *(exp(pfrz2*supcol)-1.)*rslope(i,k,1)**7*dtcld,       &
+!                 qrs(i,k,1))
+            temp = rslope(i,k,1)
+            temp = temp*temp*temp*temp*temp*temp*temp
+            pfrzdtr = min(20.*(pi*pi)*pfrz1*n0r*denr/den(i,k)             &
+                  *(exp(pfrz2*supcol)-1.)*temp*dtcld,                   &
+                  qrs(i,k,1))
+            qrs(i,k,2) = qrs(i,k,2) + pfrzdtr
+            t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtr
+            qrs(i,k,1) = qrs(i,k,1)-pfrzdtr
+          endif
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     rsloper: reverse of the slope parameter of the rain(m)
+!     xka:    thermal conductivity of air(jm-1s-1k-1)
+!     work1:  the thermodynamic term in the denominator associated with
+!             heat conduction and vapor diffusion
+!             (ry88, y93, h85)
+!     work2: parameter associated with the ventilation effects(y93)
+!
+      do k = kts, kte
+        do i = its, ite
+          if(qrs(i,k,1).le.qcrmin)then
+            rslope(i,k,1) = rslopermax
+            rslopeb(i,k,1) = rsloperbmax
+            rslope2(i,k,1) = rsloper2max
+            rslope3(i,k,1) = rsloper3max
+          else
+!           rslope(i,k,1) = 1./lamdar(qrs(i,k,1),den(i,k))
+            rslope(i,k,1) = 1./(sqrt(sqrt(pidn0r/((qrs(i,k,1))*(den(i,k))))))
+            rslopeb(i,k,1) = exp(log(rslope(i,k,1))*(bvtr))
+            rslope2(i,k,1) = rslope(i,k,1)*rslope(i,k,1)
+            rslope3(i,k,1) = rslope2(i,k,1)*rslope(i,k,1)
+          endif
+          if(qrs(i,k,2).le.qcrmin)then
+            rslope(i,k,2) = rslopesmax
+            rslopeb(i,k,2) = rslopesbmax
+            rslope2(i,k,2) = rslopes2max
+            rslope3(i,k,2) = rslopes3max
+          else
+!            rslope(i,k,2) = 1./lamdas(qrs(i,k,2),den(i,k),n0sfac(i,k))
+            rslope(i,k,2) = 1./(sqrt(sqrt(pidn0s*(n0sfac(i,k))/((qrs(i,k,2))*(den(i,k))))))
+            rslopeb(i,k,2) = exp(log(rslope(i,k,2))*(bvts))
+            rslope2(i,k,2) = rslope(i,k,2)*rslope(i,k,2)
+            rslope3(i,k,2) = rslope2(i,k,2)*rslope(i,k,2)
+          endif
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+!         work1(i,k,1) = diffac(xl(i,k),p(i,k),t(i,k),den(i,k),qs(i,k,1))
+          work1(i,k,1) =                                                     &
+        ((((den(i,k))*(xl(i,k))*(xl(i,k))) * ((t(i,k))+120.) * (den(i,k)))   &
+           /                                                                 &
+         ( 1.414e3 * (1.496e-6 * ((t(i,k))*sqrt(t(i,k)))) * (den(i,k)) *     &
+                                                   (rv*(t(i,k))*(t(i,k)))))  &
+        +                                                                    &
+        p(i,k) / ( (qs(i,k,1)) * ( 8.794e-5 * exp(log(t(i,k))*(1.81)) ) )
+!         work1(i,k,2) = diffac(xls,p(i,k),t(i,k),den(i,k),qs(i,k,2))
+          work1(i,k,2) =                                                     &
+        (                                                                    &
+         (((den(i,k))*(xls)*(xls))*((t(i,k))+120.)*(den(i,k)))               &
+           /                                                                 &
+          (                                                                  &
+         1.414e3 * (1.496e-6 * ((t(i,k))*sqrt(t(i,k)))) * (den(i,k)) *       &
+                                                   (rv*(t(i,k))*(t(i,k)))    &
+          )                                                                  &
+          +                                                                  &
+         p(i,k)                                                              &
+          /                                                                  &
+         ( qs(i,k,2) * (8.794e-5 * exp(log(t(i,k))*(1.81))))                 &
+        )
+!         work2(i,k) = venfac(p(i,k),t(i,k),den(i,k))
+          work2(i,k) =                                                       &
+        (                                                                    &
+         exp(.3333333*log(                                                   &
+             ((1.496e-6 * ((t(i,k))*sqrt(t(i,k))))*p(i,k))                   &
+                /                                                            &
+             (((t(i,k))+120.)*den(i,k)*(8.794e-5 * exp(log(t(i,k))*(1.81)))) &
+           ))                                                                &
+           *                                                                 &
+           sqrt(sqrt(den0/(den(i,k))))                                       &
+        )                                                                    &
+        /                                                                    &
+        sqrt(                                                                &
+           (1.496e-6 * ((t(i,k))*sqrt(t(i,k))))                              &
+             /                                                               &
+           (                                                                 &
+            ((t(i,k))+120.) * den(i,k)                                       &
+           )                                                                 &
+        )
+        ENDDO
+      ENDDO
+!
+!===============================================================
+!
+! warm rain processes
+!
+! - follows the processes in RH83 and LFO except for autoconcersion
+!
+!===============================================================
+!
+      do k = kts, kte
+        do i = its, ite
+          supsat = max(q(i,k),qmin)-qs(i,k,1)
+          satdt = supsat/dtcld
+!---------------------------------------------------------------
+! praut: auto conversion rate from cloud to rain [HDC 16]
+!        (C->R)
+!---------------------------------------------------------------
+          if(qci(i,k,1).gt.qc0) then
+            praut(i,k) = qck1*exp(log(qci(i,k,1))*((7./3.)))
+            praut(i,k) = min(praut(i,k),qci(i,k,1)/dtcld)
+          endif
+!---------------------------------------------------------------
+! pracw: accretion of cloud water by rain [HL A40] [LFO 51]
+!        (C->R)
+!---------------------------------------------------------------
+          if(qrs(i,k,1).gt.qcrmin.and.qci(i,k,1).gt.qmin) then
+            pracw(i,k) = min(pacrr*rslope3(i,k,1)*rslopeb(i,k,1)       &
+                         *qci(i,k,1)*denfac(i,k),qci(i,k,1)/dtcld)
+          endif
+!---------------------------------------------------------------
+! prevp: evaporation/condensation rate of rain [HDC 14]
+!        (V->R or R->V)
+!---------------------------------------------------------------
+          if(qrs(i,k,1).gt.0.) then
+            coeres = rslope2(i,k,1)*sqrt(rslope(i,k,1)*rslopeb(i,k,1))
+            prevp(i,k) = (rh(i,k,1)-1.)*(precr1*rslope2(i,k,1)         &
+                         +precr2*work2(i,k)*coeres)/work1(i,k,1)
+            if(prevp(i,k).lt.0.) then
+              prevp(i,k) = max(prevp(i,k),-qrs(i,k,1)/dtcld)
+              prevp(i,k) = max(prevp(i,k),satdt/2)
+            else
+              prevp(i,k) = min(prevp(i,k),satdt/2)
+            endif
+          endif
+        enddo
+      enddo
+!
+!===============================================================
+!
+! cold rain processes
+!
+! - follows the revised ice microphysics processes in HDC
+! - the processes same as in RH83 and RH84  and LFO behave
+!   following ice crystal hapits defined in HDC, inclduing
+!   intercept parameter for snow (n0s), ice crystal number
+!   concentration (ni), ice nuclei number concentration
+!   (n0i), ice diameter (d)
+!
+!===============================================================
+!
+      rdtcld = 1./dtcld
+      do k = kts, kte
+        do i = its, ite
+          supcol = t0c-t(i,k)
+          supsat = max(q(i,k),qmin)-qs(i,k,2)
+          satdt = supsat/dtcld
+          ifsat = 0
+!-------------------------------------------------------------
+! Ni: ice crystal number concentraiton   [HDC 5c]
+!-------------------------------------------------------------
+!         xni(i,k) = min(max(5.38e7*(den(i,k)                           &
+!                      *max(qci(i,k,2),qmin))**0.75,1.e3),1.e6)
+          temp = (den(i,k)*max(qci(i,k,2),qmin))
+          temp = sqrt(sqrt(temp*temp*temp))
+          xni(i,k) = min(max(5.38e7*temp,1.e3),1.e6)
+          eacrs = exp(0.07*(-supcol))
+!
+          if(supcol.gt.0) then
+            if(qrs(i,k,2).gt.qcrmin.and.qci(i,k,2).gt.qmin) then
+              xmi = den(i,k)*qci(i,k,2)/xni(i,k)
+              diameter  = min(dicon * sqrt(xmi),dimax)
+              vt2i = 1.49e4*diameter**1.31
+              vt2s = pvts*rslopeb(i,k,2)*denfac(i,k)
+!-------------------------------------------------------------
+! psaci: Accretion of cloud ice by rain [HDC 10]
+!        (T<T0: I->S)
+!-------------------------------------------------------------
+              acrfac = 2.*rslope3(i,k,2)+2.*diameter*rslope2(i,k,2)     &
+                      +diameter**2*rslope(i,k,2)
+              psaci(i,k) = pi*qci(i,k,2)*eacrs*n0s*n0sfac(i,k)         &
+                           *abs(vt2s-vt2i)*acrfac/4.
+            endif
+!-------------------------------------------------------------
+! psacw: Accretion of cloud water by snow  [HL A7] [LFO 24]
+!        (T<T0: C->S, and T>=T0: C->R)
+!-------------------------------------------------------------
+            if(qrs(i,k,2).gt.qcrmin.and.qci(i,k,1).gt.qmin) then
+              psacw(i,k) = min(pacrc*n0sfac(i,k)*rslope3(i,k,2)        &
+                           *rslopeb(i,k,2)*qci(i,k,1)*denfac(i,k)       &
+!                          ,qci(i,k,1)/dtcld)
+                           ,qci(i,k,1)*rdtcld)
+            endif
+!-------------------------------------------------------------
+! pidep: Deposition/Sublimation rate of ice [HDC 9]
+!       (T<T0: V->I or I->V)
+!-------------------------------------------------------------
+            if(qci(i,k,2).gt.0.and.ifsat.ne.1) then
+              xmi = den(i,k)*qci(i,k,2)/xni(i,k)
+              diameter = dicon * sqrt(xmi)
+              pidep(i,k) = 4.*diameter*xni(i,k)*(rh(i,k,2)-1.)/work1(i,k,2)
+              supice = satdt-prevp(i,k)
+              if(pidep(i,k).lt.0.) then
+!               pidep(i,k) = max(max(pidep(i,k),satdt/2),supice)
+!               pidep(i,k) = max(pidep(i,k),-qci(i,k,2)/dtcld)
+                pidep(i,k) = max(max(pidep(i,k),satdt*.5),supice)
+                pidep(i,k) = max(pidep(i,k),-qci(i,k,2)*rdtcld)
+              else
+!               pidep(i,k) = min(min(pidep(i,k),satdt/2),supice)
+                pidep(i,k) = min(min(pidep(i,k),satdt*.5),supice)
+              endif
+              if(abs(prevp(i,k)+pidep(i,k)).ge.abs(satdt)) ifsat = 1
+            endif
+          endif
+!-------------------------------------------------------------
+! psdep: deposition/sublimation rate of snow [HDC 14]
+!        (V->S or S->V)
+!-------------------------------------------------------------
+          if(qrs(i,k,2).gt.0..and.ifsat.ne.1) then
+            coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2))
+            psdep(i,k) = (rh(i,k,2)-1.)*n0sfac(i,k)                    &
+                         *(precs1*rslope2(i,k,2)+precs2                 &
+                         *work2(i,k)*coeres)/work1(i,k,2)
+            supice = satdt-prevp(i,k)-pidep(i,k)
+            if(psdep(i,k).lt.0.) then
+!             psdep(i,k) = max(psdep(i,k),-qrs(i,k,2)/dtcld)
+!             psdep(i,k) = max(max(psdep(i,k),satdt/2),supice)
+              psdep(i,k) = max(psdep(i,k),-qrs(i,k,2)*rdtcld)
+              psdep(i,k) = max(max(psdep(i,k),satdt*.5),supice)
+            else
+!             psdep(i,k) = min(min(psdep(i,k),satdt/2),supice)
+              psdep(i,k) = min(min(psdep(i,k),satdt*.5),supice)
+            endif
+            if(abs(prevp(i,k)+pidep(i,k)+psdep(i,k)).ge.abs(satdt))    &
+              ifsat = 1
+          endif
+!-------------------------------------------------------------
+! pigen: generation(nucleation) of ice from vapor [HL A50] [HDC 7-8]
+!       (T<T0: V->I)
+!-------------------------------------------------------------
+          if(supcol.gt.0) then
+            if(supsat.gt.0.and.ifsat.ne.1) then
+              supice = satdt-prevp(i,k)-pidep(i,k)-psdep(i,k)
+              xni0 = 1.e3*exp(0.1*supcol)
+              roqi0 = 4.92e-11*exp(log(xni0)*(1.33))
+              pigen(i,k) = max(0.,(roqi0/den(i,k)-max(qci(i,k,2),0.))    &
+!                        /dtcld)
+                         *rdtcld)
+              pigen(i,k) = min(min(pigen(i,k),satdt),supice)
+            endif
+!
+!-------------------------------------------------------------
+! psaut: conversion(aggregation) of ice to snow [HDC 12]
+!       (T<T0: I->S)
+!-------------------------------------------------------------
+            if(qci(i,k,2).gt.0.) then
+              qimax = roqimax/den(i,k)
+!             psaut(i,k) = max(0.,(qci(i,k,2)-qimax)/dtcld)
+              psaut(i,k) = max(0.,(qci(i,k,2)-qimax)*rdtcld)
+            endif
+          endif
+!-------------------------------------------------------------
+! psevp: Evaporation of melting snow [HL A35] [RH83 A27]
+!       (T>T0: S->V)
+!-------------------------------------------------------------
+          if(supcol.lt.0.) then
+            if(qrs(i,k,2).gt.0..and.rh(i,k,1).lt.1.)                    &
+              psevp(i,k) = psdep(i,k)*work1(i,k,2)/work1(i,k,1)
+!              psevp(i,k) = min(max(psevp(i,k),-qrs(i,k,2)/dtcld),0.)
+              psevp(i,k) = min(max(psevp(i,k),-qrs(i,k,2)*rdtcld),0.)
+          endif
+        enddo
+      enddo
+!
+!
+!----------------------------------------------------------------
+!     check mass conservation of generation terms and feedback to the
+!     large scale
+!
+      do k = kts, kte
+        do i = its, ite
+          if(t(i,k).le.t0c) then
+!
+!     cloud water
+!
+            value = max(qmin,qci(i,k,1))
+            source = (praut(i,k)+pracw(i,k)+psacw(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              praut(i,k) = praut(i,k)*factor
+              pracw(i,k) = pracw(i,k)*factor
+              psacw(i,k) = psacw(i,k)*factor
+            endif
+!
+!     cloud ice
+!
+            value = max(qmin,qci(i,k,2))
+            source = (psaut(i,k)+psaci(i,k)-pigen(i,k)-pidep(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              psaut(i,k) = psaut(i,k)*factor
+              psaci(i,k) = psaci(i,k)*factor
+              pigen(i,k) = pigen(i,k)*factor
+              pidep(i,k) = pidep(i,k)*factor
+            endif
+!
+            work2(i,k)=-(prevp(i,k)+psdep(i,k)+pigen(i,k)+pidep(i,k))
+!     update
+            q(i,k) = q(i,k)+work2(i,k)*dtcld
+            qci(i,k,1) = max(qci(i,k,1)-(praut(i,k)+pracw(i,k)         &
+                        +psacw(i,k))*dtcld,0.)
+            qrs(i,k,1) = max(qrs(i,k,1)+(praut(i,k)+pracw(i,k)         &
+                        +prevp(i,k))*dtcld,0.)
+            qci(i,k,2) = max(qci(i,k,2)-(psaut(i,k)+psaci(i,k)         &
+                        -pigen(i,k)-pidep(i,k))*dtcld,0.)
+            qrs(i,k,2) = max(qrs(i,k,2)+(psdep(i,k)+psaut(i,k)         &
+                        +psaci(i,k)+psacw(i,k))*dtcld,0.)
+            xlf = xls-xl(i,k)
+            xlwork2 = -xls*(psdep(i,k)+pidep(i,k)+pigen(i,k))             &
+                      -xl(i,k)*prevp(i,k)-xlf*psacw(i,k)
+            t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld
+          else
+!
+!     cloud water
+!
+            value = max(qmin,qci(i,k,1))
+            source=(praut(i,k)+pracw(i,k)+psacw(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              praut(i,k) = praut(i,k)*factor
+              pracw(i,k) = pracw(i,k)*factor
+              psacw(i,k) = psacw(i,k)*factor
+            endif
+!
+!     snow
+!
+            value = max(qcrmin,qrs(i,k,2))
+            source=(-psevp(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              psevp(i,k) = psevp(i,k)*factor
+            endif
+            work2(i,k)=-(prevp(i,k)+psevp(i,k))
+!     update
+            q(i,k) = q(i,k)+work2(i,k)*dtcld
+            qci(i,k,1) = max(qci(i,k,1)-(praut(i,k)+pracw(i,k)        &
+                        +psacw(i,k))*dtcld,0.)
+            qrs(i,k,1) = max(qrs(i,k,1)+(praut(i,k)+pracw(i,k)        &
+                        +prevp(i,k) +psacw(i,k))*dtcld,0.)
+            qrs(i,k,2) = max(qrs(i,k,2)+psevp(i,k)*dtcld,0.)
+            xlf = xls-xl(i,k)
+            xlwork2 = -xl(i,k)*(prevp(i,k)+psevp(i,k))
+            t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld
+          endif
+        enddo
+      enddo
+!
+! Inline expansion for fpvs
+!         qs(i,k,1) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+!         qs(i,k,2) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+      hsub = xls
+      hvap = xlv0
+      cvap = cpv
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      do k = kts, kte
+        do i = its, ite
+          tr=ttp/t(i,k)
+          qs(i,k,1)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
+          qs(i,k,1) = ep2 * qs(i,k,1) / (p(i,k) - qs(i,k,1))
+          qs(i,k,1) = max(qs(i,k,1),qmin)
+          tr=ttp/t(i,k)
+          if(t(i,k).lt.ttp) then
+            qs(i,k,2)=psat*exp(log(tr)*(xai))*exp(xbi*(1.-tr))
+          else
+            qs(i,k,2)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
+          endif
+          qs(i,k,2) = ep2 * qs(i,k,2) / (p(i,k) - qs(i,k,2))
+          qs(i,k,2) = max(qs(i,k,2),qmin)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!  pcond: condensational/evaporational rate of cloud water [HL A46] [RH83 A6]
+!     if there exists additional water vapor condensated/if
+!     evaporation of cloud water is not enough to remove subsaturation
+!
+      do k = kts, kte
+        do i = its, ite
+!         work1(i,k,1) = conden(t(i,k),q(i,k),qs(i,k,1),xl(i,k),cpm(i,k))
+          work1(i,k,1) = ((max(q(i,k),qmin)-(qs(i,k,1)))/              & 
+          (1.+(xl(i,k))*(xl(i,k))/(rv*(cpm(i,k)))*(qs(i,k,1))/((t(i,k))*(t(i,k)))))
+          work2(i,k) = qci(i,k,1)+work1(i,k,1)
+          pcond(i,k) = min(max(work1(i,k,1)/dtcld,0.),max(q(i,k),0.)/dtcld)
+          if(qci(i,k,1).gt.0..and.work1(i,k,1).lt.0.)                   &
+            pcond(i,k) = max(work1(i,k,1),-qci(i,k,1))/dtcld
+          q(i,k) = q(i,k)-pcond(i,k)*dtcld
+          qci(i,k,1) = max(qci(i,k,1)+pcond(i,k)*dtcld,0.)
+          t(i,k) = t(i,k)+pcond(i,k)*xl(i,k)/cpm(i,k)*dtcld
+        enddo
+      enddo
+!
+!
+!----------------------------------------------------------------
+!     padding for small values
+!
+      do k = kts, kte
+        do i = its, ite
+          if(qci(i,k,1).le.qmin) qci(i,k,1) = 0.0
+          if(qci(i,k,2).le.qmin) qci(i,k,2) = 0.0
+        enddo
+      enddo
+      enddo                  ! big loops
+  END SUBROUTINE wsm52d
+! ...................................................................
+      REAL FUNCTION rgmma(x)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!     rgmma function:  use infinite product form
+      REAL :: euler
+      PARAMETER (euler=0.577215664901532)
+      REAL :: x, y
+      INTEGER :: i
+      if(x.eq.1.)then
+        rgmma=0.
+          else
+        rgmma=x*exp(euler*x)
+        do i=1,10000
+          y=float(i)
+          rgmma=rgmma*(1.000+x/y)*exp(-x/y)
+        enddo
+        rgmma=1./rgmma
+      endif
+      END FUNCTION rgmma
+!
+!--------------------------------------------------------------------------
+      REAL FUNCTION fpvs(t,ice,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c)
+!--------------------------------------------------------------------------
+      IMPLICIT NONE
+!--------------------------------------------------------------------------
+      REAL t,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c,dldt,xa,xb,dldti,   &
+           xai,xbi,ttp,tr
+      INTEGER ice
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      tr=ttp/t
+      if(t.lt.ttp.and.ice.eq.1) then
+        fpvs=psat*exp(log(tr)*(xai))*exp(xbi*(1.-tr))
+      else
+        fpvs=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
+      endif
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END FUNCTION fpvs
+!-------------------------------------------------------------------
+  SUBROUTINE wsm5init(den0,denr,dens,cl,cpv,allowed_to_read)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!.... constants which may not be tunable
+   REAL, INTENT(IN) :: den0,denr,dens,cl,cpv
+   LOGICAL, INTENT(IN) :: allowed_to_read
+   REAL :: pi
+!
+   pi = 4.*atan(1.)
+   xlv1 = cl-cpv
+!
+   qc0  = 4./3.*pi*denr*r0**3*xncr/den0  ! 0.419e-3 -- .61e-3
+   qck1 = .104*9.8*peaut/(xncr*denr)**(1./3.)/xmyu*den0**(4./3.) ! 7.03
+!
+   bvtr1 = 1.+bvtr
+   bvtr2 = 2.5+.5*bvtr
+   bvtr3 = 3.+bvtr
+   bvtr4 = 4.+bvtr
+   g1pbr = rgmma(bvtr1)
+   g3pbr = rgmma(bvtr3)
+   g4pbr = rgmma(bvtr4)            ! 17.837825
+   g5pbro2 = rgmma(bvtr2)          ! 1.8273
+   pvtr = avtr*g4pbr/6.
+   eacrr = 1.0
+   pacrr = pi*n0r*avtr*g3pbr*.25*eacrr
+   precr1 = 2.*pi*n0r*.78
+   precr2 = 2.*pi*n0r*.31*avtr**.5*g5pbro2
+   xm0  = (di0/dicon)**2
+   xmmax = (dimax/dicon)**2
+   roqimax = 2.08e22*dimax**8
+!
+   bvts1 = 1.+bvts
+   bvts2 = 2.5+.5*bvts
+   bvts3 = 3.+bvts
+   bvts4 = 4.+bvts
+   g1pbs = rgmma(bvts1)    !.8875
+   g3pbs = rgmma(bvts3)
+   g4pbs = rgmma(bvts4)    ! 12.0786
+   g5pbso2 = rgmma(bvts2)
+   pvts = avts*g4pbs/6.
+   pacrs = pi*n0s*avts*g3pbs*.25
+   precs1 = 4.*n0s*.65
+   precs2 = 4.*n0s*.44*avts**.5*g5pbso2
+   pidn0r =  pi*denr*n0r
+   pidn0s =  pi*dens*n0s
+   pacrc = pi*n0s*avts*g3pbs*.25*eacrc
+!
+   rslopermax = 1./lamdarmax
+   rslopesmax = 1./lamdasmax
+   rsloperbmax = rslopermax ** bvtr
+   rslopesbmax = rslopesmax ** bvts
+   rsloper2max = rslopermax * rslopermax
+   rslopes2max = rslopesmax * rslopesmax
+   rsloper3max = rsloper2max * rslopermax
+   rslopes3max = rslopes2max * rslopesmax
+!
+  END SUBROUTINE wsm5init
+END MODULE module_mp_wsm5
Index: trunk/WRF.COMMON/WRFV2/phys/module_mp_wsm6.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_mp_wsm6.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_mp_wsm6.F	(revision 2744)
@@ -0,0 +1,1501 @@
+#if ( RWORDSIZE == 4 )
+#  define VREC vsrec
+#  define VSQRT vssqrt
+#else
+#  define VREC vrec
+#  define VSQRT vsqrt
+#endif
+
+MODULE module_mp_wsm6
+!
+!
+   REAL, PARAMETER, PRIVATE :: dtcldcr     = 120.
+   REAL, PARAMETER, PRIVATE :: n0r = 8.e6
+   REAL, PARAMETER, PRIVATE :: n0g = 4.e6
+   REAL, PARAMETER, PRIVATE :: avtr = 841.9
+   REAL, PARAMETER, PRIVATE :: bvtr = 0.8
+   REAL, PARAMETER, PRIVATE :: r0 = .8e-5 ! 8 microm  in contrast to 10 micro m
+   REAL, PARAMETER, PRIVATE :: peaut = .55   ! collection efficiency
+   REAL, PARAMETER, PRIVATE :: xncr = 3.e8   ! maritime cloud in contrast to 3.e8 in tc80
+   REAL, PARAMETER, PRIVATE :: xmyu = 1.718e-5 ! the dynamic viscosity kgm-1s-1
+   REAL, PARAMETER, PRIVATE :: avts = 11.72
+   REAL, PARAMETER, PRIVATE :: bvts = .41
+   REAL, PARAMETER, PRIVATE :: avtg = 330.
+   REAL, PARAMETER, PRIVATE :: bvtg = 0.8
+   REAL, PARAMETER, PRIVATE :: deng = 500.
+   REAL, PARAMETER, PRIVATE :: n0smax =  1.e11 ! t=-90C unlimited
+   REAL, PARAMETER, PRIVATE :: lamdarmax = 8.e4
+   REAL, PARAMETER, PRIVATE :: lamdasmax = 1.e5
+   REAL, PARAMETER, PRIVATE :: lamdagmax = 6.e4
+   REAL, PARAMETER, PRIVATE :: betai = .6
+   REAL, PARAMETER, PRIVATE :: xn0 = 1.e-2
+   REAL, PARAMETER, PRIVATE :: dicon = 11.9
+   REAL, PARAMETER, PRIVATE :: di0 = 12.9e-6
+   REAL, PARAMETER, PRIVATE :: dimax = 500.e-6
+   REAL, PARAMETER, PRIVATE :: n0s = 2.e6             ! temperature dependent n0s
+   REAL, PARAMETER, PRIVATE :: alpha = .12        ! .122 exponen factor for n0s
+   REAL, PARAMETER, PRIVATE :: pfrz1 = 100.
+   REAL, PARAMETER, PRIVATE :: pfrz2 = 0.66
+   REAL, PARAMETER, PRIVATE :: qcrmin = 1.e-9
+   REAL, PARAMETER, PRIVATE :: t40c = 233.16
+   REAL, PARAMETER, PRIVATE :: eacrc = 1.0
+   REAL, PARAMETER, PRIVATE :: dens  =  100.0
+   REAL, PARAMETER, PRIVATE :: qs0   =  6.e-4   ! pgaut
+   REAL, SAVE ::                                     &
+             qc0, qck1,bvtr1,bvtr2,bvtr3,bvtr4,g1pbr,&
+             g3pbr,g4pbr,g5pbro2,pvtr,eacrr,pacrr,   &
+             bvtr6,g6pbr,                            &
+             precr1,precr2,xm0,xmmax,roqimax,bvts1,  &
+             bvts2,bvts3,bvts4,g1pbs,g3pbs,g4pbs,    &
+             g5pbso2,pvts,pacrs,precs1,precs2,pidn0r,&
+             pidn0s,xlv1,pacrc,                      &
+             bvtg1,bvtg2,bvtg3,bvtg4,g1pbg,          &
+             g3pbg,g4pbg,g5pbgo2,pvtg,pacrg,         &
+             precg1,precg2,pidn0g,                   &
+             rslopermax,rslopesmax,rslopegmax,       &
+             rsloperbmax,rslopesbmax,rslopegbmax,    &
+             rsloper2max,rslopes2max,rslopeg2max,    &
+             rsloper3max,rslopes3max,rslopeg3max
+CONTAINS
+!===================================================================
+!
+  SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg                        &
+                 ,den, pii, p, delz                                &
+                 ,delt,g, cpd, cpv, rd, rv, t0c                    &
+                 ,ep1, ep2, qmin                                   &
+                 ,XLS, XLV0, XLF0, den0, denr                      &
+                 ,cliq,cice,psat                                   &
+                 ,rain, rainncv                                    &
+                 ,snow, snowncv                                    &
+                 ,graupel, graupelncv                              &
+                 ,sr                                               &
+                 ,ids,ide, jds,jde, kds,kde                        &
+                 ,ims,ime, jms,jme, kms,kme                        &
+                 ,its,ite, jts,jte, kts,kte                        &
+                                                                   )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!
+!  This code is a 6-class GRAUPEL phase microphyiscs scheme (WSM6) of the WRF
+!  Single-Moment MicroPhyiscs (WSMMP). The WSMMP assumes that ice nuclei
+!  number concentration is a function of temperature, and seperate assumption
+!  is developed, in which ice crystal number concentration is a function
+!  of ice amount. A theoretical background of the ice-microphysics and related
+!  processes in the WSMMPs are described in Hong et al. (2004).
+!  All production terms in the WSM6 scheme are described in Hong and Lim (2006).
+!  All units are in m.k.s. and source/sink terms in kgkg-1s-1.
+!
+!  WSM6 cloud scheme
+!
+!  Coded by Song-You Hong and Jeong-Ock Jade Lim (Yonsei Univ.)
+!           Summer 2003
+!
+!  Implemented by Song-You Hong (Yonsei Univ.) and Jimy Dudhia (NCAR)
+!           Summer 2004
+!
+!  Reference) Hong, Dudhia, Chen (HDC, 2004) Mon. Wea. Rev. 
+!             Hong and Lim (HL, 2006) J. Korean Meteor. Soc. 
+!             Lin, Farley, Orville (LFO, 1983) J. Appl. Meteor.
+!             Rutledge, Hobbs (RH83, 1983) J. Atmos. Sci.
+!             Rutledge, Hobbs (RH84, 1984) J. Atmos. Sci.
+!
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(INOUT) ::                                          &
+                                                             th,  &
+                                                              q,  &
+                                                              qc, &
+                                                              qi, &
+                                                              qr, &
+                                                              qs, &
+                                                              qg
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                 &
+        INTENT(IN   ) ::                                          &
+                                                             den, &
+                                                             pii, &
+                                                               p, &
+                                                            delz
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                              rd, &
+                                                              rv, &
+                                                             t0c, &
+                                                            den0, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             XLS, &
+                                                            XLV0, &
+                                                            XLF0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime , jms:jme ),                           &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv, &
+                                                              sr
+
+  REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL,                &
+        INTENT(INOUT) ::                                    snow, &
+                                                         snowncv
+
+  REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL,                &
+        INTENT(INOUT) ::                                graupel, &
+                                                        graupelncv
+! LOCAL VAR
+  REAL, DIMENSION( its:ite , kts:kte ) ::   t
+  REAL, DIMENSION( its:ite , kts:kte, 2 ) ::   qci
+  REAL, DIMENSION( its:ite , kts:kte, 3 ) ::   qrs
+  INTEGER ::               i,j,k
+!-------------------------------------------------------------------
+      DO j=jts,jte
+         DO k=kts,kte
+         DO i=its,ite
+            t(i,k)=th(i,k,j)*pii(i,k,j)
+            qci(i,k,1) = qc(i,k,j)
+            qci(i,k,2) = qi(i,k,j)
+            qrs(i,k,1) = qr(i,k,j)
+            qrs(i,k,2) = qs(i,k,j)
+            qrs(i,k,3) = qg(i,k,j)
+         ENDDO
+         ENDDO
+         CALL wsm62D(t, q(ims,kms,j), qci, qrs                     &
+                    ,den(ims,kms,j)                                &
+                    ,p(ims,kms,j), delz(ims,kms,j)                 &
+                    ,delt,g, cpd, cpv, rd, rv, t0c                 &
+                    ,ep1, ep2, qmin                                &
+                    ,XLS, XLV0, XLF0, den0, denr                   &
+                    ,cliq,cice,psat                                &
+                    ,j                                             &
+                    ,rain(ims,j),rainncv(ims,j)                    &
+                    ,sr(ims,j)                                     &
+                    ,ids,ide, jds,jde, kds,kde                     &
+                    ,ims,ime, jms,jme, kms,kme                     &
+                    ,its,ite, jts,jte, kts,kte                     &
+                    ,snow(ims,j),snowncv(ims,j)                    &
+                    ,graupel(ims,j),graupelncv(ims,j)              &
+                                                                   )
+         DO K=kts,kte
+         DO I=its,ite
+            th(i,k,j)=t(i,k)/pii(i,k,j)
+            qc(i,k,j) = qci(i,k,1)
+            qi(i,k,j) = qci(i,k,2)
+            qr(i,k,j) = qrs(i,k,1)
+            qs(i,k,j) = qrs(i,k,2)
+            qg(i,k,j) = qrs(i,k,3)
+         ENDDO
+         ENDDO
+      ENDDO
+  END SUBROUTINE wsm6
+!===================================================================
+!
+  SUBROUTINE wsm62D(t, q, qci, qrs, den, p, delz                  &
+                   ,delt,g, cpd, cpv, rd, rv, t0c                 &
+                   ,ep1, ep2, qmin                                &
+                   ,XLS, XLV0, XLF0, den0, denr                   &
+                   ,cliq,cice,psat                                &
+                   ,lat                                           &
+                   ,rain,rainncv                                  &
+                   ,sr                                            &
+                   ,ids,ide, jds,jde, kds,kde                     &
+                   ,ims,ime, jms,jme, kms,kme                     &
+                   ,its,ite, jts,jte, kts,kte                     &
+                   ,snow,snowncv                                  &
+                   ,graupel,graupelncv                            &
+                                                                  )
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+  INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde , &
+                                      ims,ime, jms,jme, kms,kme , &
+                                      its,ite, jts,jte, kts,kte,  &
+                                      lat
+  REAL, DIMENSION( its:ite , kts:kte ),                           &
+        INTENT(INOUT) ::                                          &
+                                                               t
+  REAL, DIMENSION( its:ite , kts:kte, 2 ),                        &
+        INTENT(INOUT) ::                                          &
+                                                             qci
+  REAL, DIMENSION( its:ite , kts:kte, 3 ),                        &
+        INTENT(INOUT) ::                                          &
+                                                             qrs
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(INOUT) ::                                          &
+                                                               q
+  REAL, DIMENSION( ims:ime , kms:kme ),                           &
+        INTENT(IN   ) ::                                          &
+                                                             den, &
+                                                               p, &
+                                                            delz
+  REAL, INTENT(IN   ) ::                                    delt, &
+                                                               g, &
+                                                             cpd, &
+                                                             cpv, &
+                                                             t0c, &
+                                                            den0, &
+                                                              rd, &
+                                                              rv, &
+                                                             ep1, &
+                                                             ep2, &
+                                                            qmin, &
+                                                             XLS, &
+                                                            XLV0, &
+                                                            XLF0, &
+                                                            cliq, &
+                                                            cice, &
+                                                            psat, &
+                                                            denr
+  REAL, DIMENSION( ims:ime ),                                     &
+        INTENT(INOUT) ::                                    rain, &
+                                                         rainncv, &
+                                                              sr
+
+  REAL, DIMENSION( ims:ime ),     OPTIONAL,                       &
+        INTENT(INOUT) ::                                    snow, &
+                                                         snowncv
+
+  REAL, DIMENSION( ims:ime ),     OPTIONAL,                       &
+        INTENT(INOUT) ::                                 graupel, &
+                                                      graupelncv
+! LOCAL VAR
+  REAL, DIMENSION( its:ite , kts:kte , 3) ::                      &
+        rh, qs, rslope, rslope2, rslope3, rslopeb,                &
+        falk, fall, work1
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+              falkc, work1c, work2c, fallc
+  REAL, DIMENSION( its:ite , kts:kte) ::                          &
+        prevp, psdep, pgdep, praut, psaut, pgaut,                 &
+        pracw, psacw, pgacw, pgacr, pgacs, psaci, pgmlt, praci,   &
+        piacr, pracs, psacr, pgaci, pseml, pgeml      
+  REAL, DIMENSION( its:ite , kts:kte ) ::                         &
+        pigen, pidep, pcond, xl, cpm, work2, psmlt, psevp, denfac,     &
+        xni, pgevp,n0sfac
+! variables for optimization
+  REAL, DIMENSION( its:ite )           :: tvec1
+  REAL :: temp
+  INTEGER, DIMENSION( its:ite ) :: mstep, numdt
+  LOGICAL, DIMENSION( its:ite ) :: flgcld
+  REAL  ::  pi,                                                   &
+            cpmcal, xlcal, lamdar, lamdas, lamdag, diffus,        &
+            viscos, xka, venfac, conden, diffac,                  &
+            x, y, z, a, b, c, d, e,                               &
+            qdt, holdrr, holdrs, holdrg, supcol, pvt,             &
+            coeres, supsat, dtcld, xmi, eacrs, satdt,             &
+            qimax, diameter, xni0, roqi0,                         &
+            fallsum, fallsum_qsi, fallsum_qg,                     &
+             vt2i,vt2r,vt2s,vt2g,acrfac,egs,egi,     &
+            xlwork2, factor, source, value,              &
+            xlf, pfrzdtc, pfrzdtr, supice, alpha2, delta2, delta3  
+  REAL  :: holdc, holdci
+  INTEGER :: i, j, k, mstepmax,                                   &
+            iprt, latd, lond, loop, loops, ifsat, n
+! Temporaries used for inlining fpvs function
+  REAL  :: dldti, xb, xai, tr, xbi, xa, hvap, cvap, hsub, dldt, ttp
+!
+!=================================================================
+!   compute internal functions
+!
+      cpmcal(x) = cpd*(1.-max(x,qmin))+max(x,qmin)*cpv
+      xlcal(x) = xlv0-xlv1*(x-t0c)
+!----------------------------------------------------------------
+!     size distributions: (x=mixing ratio, y=air density):
+!     valid for mixing ratio > 1.e-9 kg/kg.
+!
+! Optimizatin : A**B => exp(log(A)*(B)) 
+      lamdar(x,y)=   sqrt(sqrt(pidn0r/(x*y)))      ! (pidn0r/(x*y))**.25
+      lamdas(x,y,z)= sqrt(sqrt(pidn0s*z/(x*y)))    ! (pidn0s*z/(x*y))**.25
+      lamdag(x,y)=   sqrt(sqrt(pidn0g/(x*y)))      ! (pidn0g/(x*y))**.25
+!
+!----------------------------------------------------------------
+!     diffus: diffusion coefficient of the water vapor
+!     viscos: kinematic viscosity(m2s-1)
+!
+      diffus(x,y) = 8.794e-5 * exp(log(x)*(1.81)) / y        ! 8.794e-5*x**1.81/y
+      viscos(x,y) = 1.496e-6 * (x*sqrt(x)) /(x+120.)/y  ! 1.496e-6*x**1.5/(x+120.)/y
+      xka(x,y) = 1.414e3*viscos(x,y)*y
+      diffac(a,b,c,d,e) = d*a*a/(xka(c,d)*rv*c*c)+1./(e*diffus(c,b))
+      venfac(a,b,c) = exp(log((viscos(b,c)/diffus(b,a)))*((.3333333)))    &
+                     /sqrt(viscos(b,c))*sqrt(sqrt(den0/c))
+      conden(a,b,c,d,e) = (max(b,qmin)-c)/(1.+d*d/(rv*e)*c/(a*a))
+!
+      pi = 4. * atan(1.)
+!
+!
+!----------------------------------------------------------------
+!     paddint 0 for negative values generated by dynamics
+!
+      do k = kts, kte
+        do i = its, ite
+          qci(i,k,1) = max(qci(i,k,1),0.0)
+          qrs(i,k,1) = max(qrs(i,k,1),0.0)
+          qci(i,k,2) = max(qci(i,k,2),0.0)
+          qrs(i,k,2) = max(qrs(i,k,2),0.0)
+          qrs(i,k,3) = max(qrs(i,k,3),0.0)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     latent heat for phase changes and heat capacity. neglect the
+!     changes during microphysical process calculation
+!     emanuel(1994)
+!
+      do k = kts, kte
+        do i = its, ite
+          cpm(i,k) = cpmcal(q(i,k))
+          xl(i,k) = xlcal(t(i,k))
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     compute the minor time steps.
+!
+      loops = max(nint(delt/dtcldcr),1)
+      dtcld = delt/loops
+      if(delt.le.dtcldcr) dtcld = delt
+!
+      do loop = 1,loops
+!
+!----------------------------------------------------------------
+!     initialize the large scale variables
+!
+      do i = its, ite
+        mstep(i) = 1
+        flgcld(i) = .true.
+      enddo
+!
+!     do k = kts, kte
+!       do i = its, ite
+!         denfac(i,k) = sqrt(den0/den(i,k))
+!       enddo
+!     enddo
+      do k = kts, kte
+        CALL VREC( tvec1(its), den(its,k), ite-its+1)
+        do i = its, ite
+          tvec1(i) = tvec1(i)*den0
+        enddo
+        CALL VSQRT( denfac(its,k), tvec1(its), ite-its+1)
+      enddo
+!
+! Inline expansion for fpvs
+!         qs(i,k,1) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+!         qs(i,k,2) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+      hsub = xls
+      hvap = xlv0
+      cvap = cpv
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      do k = kts, kte
+        do i = its, ite
+          tr=ttp/t(i,k)
+          qs(i,k,1)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
+          qs(i,k,1) = ep2 * qs(i,k,1) / (p(i,k) - qs(i,k,1))
+          qs(i,k,1) = max(qs(i,k,1),qmin)
+          rh(i,k,1) = max(q(i,k) / qs(i,k,1),qmin)
+          tr=ttp/t(i,k)
+          if(t(i,k).lt.ttp) then
+            qs(i,k,2)=psat*exp(log(tr)*(xai))*exp(xbi*(1.-tr))
+          else
+            qs(i,k,2)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
+          endif
+          qs(i,k,2) = ep2 * qs(i,k,2) / (p(i,k) - qs(i,k,2))
+          qs(i,k,2) = max(qs(i,k,2),qmin)
+          rh(i,k,2) = max(q(i,k) / qs(i,k,2),qmin)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     initialize the variables for microphysical physics
+!
+!
+      do k = kts, kte
+        do i = its, ite
+          prevp(i,k) = 0.
+          psdep(i,k) = 0.
+          pgdep(i,k) = 0.
+          praut(i,k) = 0.
+          psaut(i,k) = 0.
+          pgaut(i,k) = 0.
+          pracw(i,k) = 0.
+          praci(i,k) = 0.
+          piacr(i,k) = 0.
+          psaci(i,k) = 0.
+          psacw(i,k) = 0.
+          pracs(i,k) = 0.
+          psacr(i,k) = 0.
+          pgacw(i,k) = 0.
+          pgaci(i,k) = 0.
+          pgacr(i,k) = 0.
+          pgacs(i,k) = 0.
+          pigen(i,k) = 0.
+          pidep(i,k) = 0.
+          pcond(i,k) = 0.
+          psmlt(i,k) = 0.
+          pgmlt(i,k) = 0.
+          pseml(i,k) = 0.
+          pgeml(i,k) = 0.
+          psevp(i,k) = 0.
+          pgevp(i,k) = 0.
+          falk(i,k,1) = 0.
+          falk(i,k,2) = 0.
+          falk(i,k,3) = 0.
+          fall(i,k,1) = 0.
+          fall(i,k,2) = 0.
+          fall(i,k,3) = 0.
+          fallc(i,k) = 0.
+          falkc(i,k) = 0.
+          xni(i,k) = 1.e3
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!     compute the fallout term:
+!     first, vertical terminal velosity for minor loops
+!
+      do k = kts, kte
+        do i = its, ite
+          supcol = t0c-t(i,k)
+!---------------------------------------------------------------
+! n0s: Intercept parameter for snow [m-4] [HDC 6]
+!---------------------------------------------------------------
+          n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.)
+          if(qrs(i,k,1).le.qcrmin)then
+            rslope(i,k,1) = rslopermax
+            rslopeb(i,k,1) = rsloperbmax
+            rslope2(i,k,1) = rsloper2max
+            rslope3(i,k,1) = rsloper3max
+          else
+            rslope(i,k,1) = 1./lamdar(qrs(i,k,1),den(i,k))
+            rslopeb(i,k,1) = rslope(i,k,1)**bvtr
+            rslope2(i,k,1) = rslope(i,k,1)*rslope(i,k,1)
+            rslope3(i,k,1) = rslope2(i,k,1)*rslope(i,k,1)
+          endif
+          if(qrs(i,k,2).le.qcrmin)then
+            rslope(i,k,2) = rslopesmax
+            rslopeb(i,k,2) = rslopesbmax
+            rslope2(i,k,2) = rslopes2max
+            rslope3(i,k,2) = rslopes3max
+          else
+            rslope(i,k,2) = 1./lamdas(qrs(i,k,2),den(i,k),n0sfac(i,k))
+            rslopeb(i,k,2) = rslope(i,k,2)**bvts
+            rslope2(i,k,2) = rslope(i,k,2)*rslope(i,k,2)
+            rslope3(i,k,2) = rslope2(i,k,2)*rslope(i,k,2)
+          endif
+          if(qrs(i,k,3).le.qcrmin)then
+            rslope(i,k,3) = rslopegmax
+            rslopeb(i,k,3) = rslopegbmax
+            rslope2(i,k,3) = rslopeg2max
+            rslope3(i,k,3) = rslopeg3max
+          else
+            rslope(i,k,3) = 1./lamdag(qrs(i,k,3),den(i,k))
+            rslopeb(i,k,3) = rslope(i,k,3)**bvtg
+            rslope2(i,k,3) = rslope(i,k,3)*rslope(i,k,3)
+            rslope3(i,k,3) = rslope2(i,k,3)*rslope(i,k,3)
+          endif
+!-------------------------------------------------------------
+! Ni: ice crystal number concentraiton   [HDC 5c]
+!-------------------------------------------------------------
+!         xni(i,k) = min(max(5.38e7*(den(i,k)                           &
+!                   *max(qci(i,k,2),qmin))**0.75,1.e3),1.e6)
+          temp = (den(i,k)*max(qci(i,k,2),qmin))
+          temp = sqrt(sqrt(temp*temp*temp))
+          xni(i,k) = min(max(5.38e7*temp,1.e3),1.e6)
+        enddo
+      enddo
+!
+      mstepmax = 1
+      numdt = 1
+      do k = kte, kts, -1
+        do i = its, ite
+          work1(i,k,1) = pvtr*rslopeb(i,k,1)*denfac(i,k)/delz(i,k)
+          work1(i,k,2) = pvts*rslopeb(i,k,2)*denfac(i,k)/delz(i,k)
+          work1(i,k,3) = pvtg*rslopeb(i,k,3)*denfac(i,k)/delz(i,k)
+          numdt(i) = max(nint(max(work1(i,k,1),work1(i,k,2),work1(i,k,3)) &
+                    *dtcld+.5),1)
+          if(numdt(i).ge.mstep(i)) mstep(i) = numdt(i)
+        enddo
+      enddo
+      do i = its, ite
+        if(mstepmax.le.mstep(i)) mstepmax = mstep(i)
+      enddo
+!
+      do n = 1, mstepmax
+        k = kte
+        do i = its, ite
+          if(n.le.mstep(i)) then
+              falk(i,k,1) = den(i,k)*qrs(i,k,1)*work1(i,k,1)/mstep(i)
+              falk(i,k,2) = den(i,k)*qrs(i,k,2)*work1(i,k,2)/mstep(i)
+              falk(i,k,3) = den(i,k)*qrs(i,k,3)*work1(i,k,3)/mstep(i)
+              fall(i,k,1) = fall(i,k,1)+falk(i,k,1)
+              fall(i,k,2) = fall(i,k,2)+falk(i,k,2)
+              fall(i,k,3) = fall(i,k,3)+falk(i,k,3)
+              qrs(i,k,1) = max(qrs(i,k,1)-falk(i,k,1)*dtcld/den(i,k),0.)
+              qrs(i,k,2) = max(qrs(i,k,2)-falk(i,k,2)*dtcld/den(i,k),0.)
+              qrs(i,k,3) = max(qrs(i,k,3)-falk(i,k,3)*dtcld/den(i,k),0.)
+            endif
+          enddo
+        do k = kte-1, kts, -1
+          do i = its, ite
+            if(n.le.mstep(i)) then
+              falk(i,k,1) = den(i,k)*qrs(i,k,1)*work1(i,k,1)/mstep(i)
+              falk(i,k,2) = den(i,k)*qrs(i,k,2)*work1(i,k,2)/mstep(i)
+              falk(i,k,3) = den(i,k)*qrs(i,k,3)*work1(i,k,3)/mstep(i)
+              fall(i,k,1) = fall(i,k,1)+falk(i,k,1)
+              fall(i,k,2) = fall(i,k,2)+falk(i,k,2)
+              fall(i,k,3) = fall(i,k,3)+falk(i,k,3)
+              qrs(i,k,1) = max(qrs(i,k,1)-(falk(i,k,1)-falk(i,k+1,1)    &
+                          *delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+              qrs(i,k,2) = max(qrs(i,k,2)-(falk(i,k,2)-falk(i,k+1,2)    &
+                          *delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+              qrs(i,k,3) = max(qrs(i,k,3)-(falk(i,k,3)-falk(i,k+1,3)    &
+                          *delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+            endif
+          enddo
+        enddo
+        do k = kte, kts, -1
+          do i = its, ite
+            if(n.le.mstep(i).and.t(i,k).gt.t0c) then
+!---------------------------------------------------------------
+! psmlt: melting of snow [HL A33] [RH83 A25]
+!       (T>T0: S->R)
+!---------------------------------------------------------------
+              xlf = xlf0
+              work2(i,k) = venfac(p(i,k),t(i,k),den(i,k))
+              if(qrs(i,k,2).gt.0.) then
+                coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2))
+                psmlt(i,k) = xka(t(i,k),den(i,k))/xlf*(t0c-t(i,k))*pi/2. &
+                           *n0sfac(i,k)*(precs1*rslope2(i,k,2)          &
+                           +precs2*work2(i,k)*coeres)
+                psmlt(i,k) = min(max(psmlt(i,k)*dtcld/mstep(i),           &
+                            -qrs(i,k,2)/mstep(i)),0.)
+                qrs(i,k,2) = qrs(i,k,2) + psmlt(i,k)
+                qrs(i,k,1) = qrs(i,k,1) - psmlt(i,k)
+                t(i,k) = t(i,k) + xlf/cpm(i,k)*psmlt(i,k)
+              endif
+!---------------------------------------------------------------
+! pgmlt: melting of graupel [HL A23]  [LFO 47]
+!       (T>T0: G->R)
+!---------------------------------------------------------------
+              if(qrs(i,k,3).gt.0.) then
+                coeres = rslope2(i,k,3)*sqrt(rslope(i,k,3)*rslopeb(i,k,3))
+                pgmlt(i,k) = xka(t(i,k),den(i,k))/xlf                    &
+                           *(t0c-t(i,k))*(precg1*rslope2(i,k,3)         &
+                           +precg2*work2(i,k)*coeres)
+                pgmlt(i,k) = min(max(pgmlt(i,k)*dtcld/mstep(i),           &
+                            -qrs(i,k,3)/mstep(i)),0.)
+                qrs(i,k,3) = qrs(i,k,3) + pgmlt(i,k)
+                qrs(i,k,1) = qrs(i,k,1) - pgmlt(i,k)
+                t(i,k) = t(i,k) + xlf/cpm(i,k)*pgmlt(i,k)
+              endif
+            endif
+          enddo
+        enddo
+      enddo
+!---------------------------------------------------------------
+! Vice [ms-1] : fallout of ice crystal [HDC 5a]
+!---------------------------------------------------------------
+      mstepmax = 1
+      mstep = 1
+      numdt = 1
+      do k = kte, kts, -1
+        do i = its, ite
+          if(qci(i,k,2).le.0.) then
+            work2c(i,k) = 0.
+          else
+            xmi = den(i,k)*qci(i,k,2)/xni(i,k)
+!           diameter  = min(dicon * sqrt(xmi),dimax)
+            diameter  = max(min(dicon * sqrt(xmi),dimax), 1.e-25)
+            work1c(i,k) = 1.49e4*diameter**1.31
+            work2c(i,k) = work1c(i,k)/delz(i,k)
+          endif
+          numdt(i) = max(nint(work2c(i,k)*dtcld+.5),1)
+          if(numdt(i).ge.mstep(i)) mstep(i) = numdt(i)
+        enddo
+      enddo
+      do i = its, ite
+        if(mstepmax.le.mstep(i)) mstepmax = mstep(i)
+      enddo
+!
+      do n = 1, mstepmax
+        k = kte
+        do i = its, ite
+          if(n.le.mstep(i)) then
+            falkc(i,k) = den(i,k)*qci(i,k,2)*work2c(i,k)/mstep(i)
+            holdc = falkc(i,k)
+            fallc(i,k) = fallc(i,k)+falkc(i,k)
+            holdci = qci(i,k,2)
+            qci(i,k,2) = max(qci(i,k,2)-falkc(i,k)*dtcld/den(i,k),0.)
+          endif
+        enddo
+        do k = kte-1, kts, -1
+          do i = its, ite
+            if(n.le.mstep(i)) then
+              falkc(i,k) = den(i,k)*qci(i,k,2)*work2c(i,k)/mstep(i)
+              holdc = falkc(i,k)
+              fallc(i,k) = fallc(i,k)+falkc(i,k)
+              holdci = qci(i,k,2)
+              qci(i,k,2) = max(qci(i,k,2)-(falkc(i,k)-falkc(i,k+1)      &
+                          *delz(i,k+1)/delz(i,k))*dtcld/den(i,k),0.)
+            endif
+          enddo
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!      rain (unit is mm/sec;kgm-2s-1: /1000*delt ===> m)==> mm for wrf
+!
+      do i = its, ite
+        fallsum = fall(i,kts,1)+fall(i,kts,2)+fall(i,kts,3)+fallc(i,kts)
+        fallsum_qsi = fall(i,kts,2)+fallc(i,kts)
+        fallsum_qg = fall(i,kts,3)
+        rainncv(i) = 0.
+        if(fallsum.gt.0.) then
+          rainncv(i) = fallsum*delz(i,kts)/denr*dtcld*1000.
+          rain(i) = fallsum*delz(i,kts)/denr*dtcld*1000. + rain(i)
+        endif
+        IF ( PRESENT (snowncv) .AND. PRESENT (snow)) THEN
+        snowncv(i) = 0.
+        if(fallsum_qsi.gt.0.) then
+          snowncv(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000.
+          snow(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000. + snow(i)
+        endif
+        ENDIF
+        IF ( PRESENT (graupelncv) .AND. PRESENT (graupel)) THEN
+        graupelncv(i) = 0.
+        if(fallsum_qg.gt.0.) then
+          graupelncv(i) = fallsum_qg*delz(i,kts)/denr*dtcld*1000.
+          graupel(i) = fallsum_qg*delz(i,kts)/denr*dtcld*1000. + graupel(i)
+        endif
+        ENDIF
+        sr(i) = 0.
+        if(fallsum.gt.0.)sr(i)=(fallsum_qsi*delz(i,kts)/denr*dtcld*1000. + &
+                                fallsum_qg*delz(i,kts)/denr*dtcld*1000.)/(rainncv(i)+1.e-12)
+      enddo
+!
+!---------------------------------------------------------------
+! pimlt: instantaneous melting of cloud ice [HL A47] [RH83 A28]
+!       (T>T0: I->C)
+!---------------------------------------------------------------
+      do k = kts, kte
+        do i = its, ite
+          supcol = t0c-t(i,k)
+          xlf = xls-xl(i,k)
+          if(supcol.lt.0.) xlf = xlf0
+          if(supcol.lt.0.and.qci(i,k,2).gt.0.) then
+            qci(i,k,1) = qci(i,k,1) + qci(i,k,2)
+            t(i,k) = t(i,k) - xlf/cpm(i,k)*qci(i,k,2)
+            qci(i,k,2) = 0.
+          endif
+!---------------------------------------------------------------
+! pihmf: homogeneous freezing of cloud water below -40c [HL A45]
+!        (T<-40C: C->I)
+!---------------------------------------------------------------
+          if(supcol.gt.40..and.qci(i,k,1).gt.0.) then
+            qci(i,k,2) = qci(i,k,2) + qci(i,k,1)
+            t(i,k) = t(i,k) + xlf/cpm(i,k)*qci(i,k,1)
+            qci(i,k,1) = 0.
+          endif
+!---------------------------------------------------------------
+! pihtf: heterogeneous freezing of cloud water [HL A44]
+!        (T0>T>-40C: C->I)
+!---------------------------------------------------------------
+          if(supcol.gt.0..and.qci(i,k,1).gt.qmin) then
+!           pfrzdtc = min(pfrz1*(exp(pfrz2*supcol)-1.)                  &
+!              *den(i,k)/denr/xncr*qci(i,k,1)**2*dtcld,qci(i,k,1))
+            pfrzdtc = min(pfrz1*(exp(pfrz2*supcol)-1.)                  &
+            *den(i,k)/denr/xncr*qci(i,k,1)*qci(i,k,1)*dtcld,qci(i,k,1))
+            qci(i,k,2) = qci(i,k,2) + pfrzdtc
+            t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtc
+            qci(i,k,1) = qci(i,k,1)-pfrzdtc
+          endif
+!---------------------------------------------------------------
+! pgfrz: freezing of rain water [HL A20] [LFO 45]
+!        (T<T0, R->G)
+!---------------------------------------------------------------
+          if(supcol.gt.0..and.qrs(i,k,1).gt.0.) then
+!           pfrzdtr = min(20.*pi**2*pfrz1*n0r*denr/den(i,k)             &
+!                 *(exp(pfrz2*supcol)-1.)*rslope3(i,k,1)**2             &
+!                 *rslope(i,k,1)*dtcld,qrs(i,k,1))
+            temp = rslope3(i,k,1)
+            temp = temp*temp*rslope(i,k,1)
+            pfrzdtr = min(20.*(pi*pi)*pfrz1*n0r*denr/den(i,k)           &
+                  *(exp(pfrz2*supcol)-1.)*temp*dtcld,                   &
+                  qrs(i,k,1))
+            qrs(i,k,3) = qrs(i,k,3) + pfrzdtr
+            t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtr
+            qrs(i,k,1) = qrs(i,k,1)-pfrzdtr
+          endif
+        enddo
+      enddo
+!
+!
+!----------------------------------------------------------------
+!     rsloper: reverse of the slope parameter of the rain(m)
+!     xka:    thermal conductivity of air(jm-1s-1k-1)
+!     work1:  the thermodynamic term in the denominator associated with
+!             heat conduction and vapor diffusion
+!             (ry88, y93, h85)
+!     work2: parameter associated with the ventilation effects(y93)
+!
+      do k = kts, kte
+        do i = its, ite
+          if(qrs(i,k,1).le.qcrmin)then
+            rslope(i,k,1) = rslopermax
+            rslopeb(i,k,1) = rsloperbmax
+            rslope2(i,k,1) = rsloper2max
+            rslope3(i,k,1) = rsloper3max
+          else
+            rslope(i,k,1) = 1./lamdar(qrs(i,k,1),den(i,k))
+            rslopeb(i,k,1) = rslope(i,k,1)**bvtr
+            rslope2(i,k,1) = rslope(i,k,1)*rslope(i,k,1)
+            rslope3(i,k,1) = rslope2(i,k,1)*rslope(i,k,1)
+          endif
+          if(qrs(i,k,2).le.qcrmin)then
+            rslope(i,k,2) = rslopesmax
+            rslopeb(i,k,2) = rslopesbmax
+            rslope2(i,k,2) = rslopes2max
+            rslope3(i,k,2) = rslopes3max
+          else
+            rslope(i,k,2) = 1./lamdas(qrs(i,k,2),den(i,k),n0sfac(i,k))
+            rslopeb(i,k,2) = rslope(i,k,2)**bvts
+            rslope2(i,k,2) = rslope(i,k,2)*rslope(i,k,2)
+            rslope3(i,k,2) = rslope2(i,k,2)*rslope(i,k,2)
+          endif
+          if(qrs(i,k,3).le.qcrmin)then
+            rslope(i,k,3) = rslopegmax
+            rslopeb(i,k,3) = rslopegbmax
+            rslope2(i,k,3) = rslopeg2max
+            rslope3(i,k,3) = rslopeg3max
+          else
+            rslope(i,k,3) = 1./lamdag(qrs(i,k,3),den(i,k))
+            rslopeb(i,k,3) = rslope(i,k,3)**bvtg
+            rslope2(i,k,3) = rslope(i,k,3)*rslope(i,k,3)
+            rslope3(i,k,3) = rslope2(i,k,3)*rslope(i,k,3)
+          endif
+        enddo
+      enddo
+!
+      do k = kts, kte
+        do i = its, ite
+          work1(i,k,1) = diffac(xl(i,k),p(i,k),t(i,k),den(i,k),qs(i,k,1))
+          work1(i,k,2) = diffac(xls,p(i,k),t(i,k),den(i,k),qs(i,k,2))
+          work2(i,k) = venfac(p(i,k),t(i,k),den(i,k))
+        enddo
+      enddo
+!
+!===============================================================
+!
+! warm rain processes
+!
+! - follows the processes in RH83 and LFO except for autoconcersion
+!
+!===============================================================
+!
+      do k = kts, kte
+        do i = its, ite
+          supsat = max(q(i,k),qmin)-qs(i,k,1)
+          satdt = supsat/dtcld
+!---------------------------------------------------------------
+! praut: auto conversion rate from cloud to rain [HDC 16]
+!        (C->R)
+!---------------------------------------------------------------
+          if(qci(i,k,1).gt.qc0) then
+            praut(i,k) = qck1*qci(i,k,1)**(7./3.)
+            praut(i,k) = min(praut(i,k),qci(i,k,1)/dtcld)
+          endif
+!---------------------------------------------------------------
+! pracw: accretion of cloud water by rain [HL A40] [LFO 51]
+!        (C->R)
+!---------------------------------------------------------------
+          if(qrs(i,k,1).gt.qcrmin.and.qci(i,k,1).gt.qmin) then
+            pracw(i,k) = min(pacrr*rslope3(i,k,1)*rslopeb(i,k,1)        &
+                        *qci(i,k,1)*denfac(i,k),qci(i,k,1)/dtcld)
+          endif
+!---------------------------------------------------------------
+! prevp: evaporation/condensation rate of rain [HDC 14]
+!        (V->R or R->V)
+!---------------------------------------------------------------
+          if(qrs(i,k,1).gt.0.) then
+            coeres = rslope2(i,k,1)*sqrt(rslope(i,k,1)*rslopeb(i,k,1))
+            prevp(i,k) = (rh(i,k,1)-1.)*(precr1*rslope2(i,k,1)         &
+                         +precr2*work2(i,k)*coeres)/work1(i,k,1)
+            if(prevp(i,k).lt.0.) then
+              prevp(i,k) = max(prevp(i,k),-qrs(i,k,1)/dtcld)
+              prevp(i,k) = max(prevp(i,k),satdt/2)
+            else
+              prevp(i,k) = min(prevp(i,k),satdt/2)
+            endif
+          endif
+        enddo
+      enddo
+!
+!===============================================================
+!
+! cold rain processes
+!
+! - follows the revised ice microphysics processes in HDC
+! - the processes same as in RH83 and RH84  and LFO behave
+!   following ice crystal hapits defined in HDC, inclduing
+!   intercept parameter for snow (n0s), ice crystal number
+!   concentration (ni), ice nuclei number concentration
+!   (n0i), ice diameter (d)
+!
+!===============================================================
+!
+      do k = kts, kte
+        do i = its, ite
+          supcol = t0c-t(i,k)
+          supsat = max(q(i,k),qmin)-qs(i,k,2)
+          satdt = supsat/dtcld
+          ifsat = 0
+!-------------------------------------------------------------
+! Ni: ice crystal number concentraiton   [HDC 5c]
+!-------------------------------------------------------------
+!         xni(i,k) = min(max(5.38e7*(den(i,k)                           &
+!                      *max(qci(i,k,2),qmin))**0.75,1.e3),1.e6)
+          temp = (den(i,k)*max(qci(i,k,2),qmin))
+          temp = sqrt(sqrt(temp*temp*temp))
+          xni(i,k) = min(max(5.38e7*temp,1.e3),1.e6)
+          eacrs = exp(0.07*(-supcol))
+!
+          xmi = den(i,k)*qci(i,k,2)/xni(i,k)
+          diameter  = min(dicon * sqrt(xmi),dimax)
+          vt2i = 1.49e4*diameter**1.31
+          vt2r=pvtr*rslopeb(i,k,1)*denfac(i,k)
+          vt2s=pvts*rslopeb(i,k,2)*denfac(i,k)
+          vt2g=pvtg*rslopeb(i,k,3)*denfac(i,k)
+          if(supcol.gt.0.and.qci(i,k,2).gt.qmin) then
+            if(qrs(i,k,1).gt.qcrmin) then
+!-------------------------------------------------------------
+! praci: Accretion of cloud ice by rain [HL A15] [LFO 25]
+!        (T<T0: I->R)
+!-------------------------------------------------------------
+              acrfac = 2.*rslope3(i,k,1)+2.*diameter*rslope2(i,k,1)     &
+                      +diameter**2*rslope(i,k,1)
+              praci(i,k) = pi*qci(i,k,2)*n0r*abs(vt2r-vt2i)*acrfac/4.
+              praci(i,k) = min(praci(i,k),qci(i,k,2)/dtcld)
+!-------------------------------------------------------------
+! piacr: Accretion of rain by cloud ice [HL A19] [LFO 26]
+!        (T<T0: R->S or R->G)
+!-------------------------------------------------------------
+              piacr(i,k) = pi**2*avtr*n0r*denr*xni(i,k)*denfac(i,k)     &
+                          *g6pbr*rslope3(i,k,1)*rslope3(i,k,1)          &
+                          *rslopeb(i,k,1)/24./den(i,k)
+              piacr(i,k) = min(piacr(i,k),qrs(i,k,1)/dtcld)
+            endif
+!-------------------------------------------------------------
+! psaci: Accretion of cloud ice by snow [HDC 10]
+!        (T<T0: I->S)
+!-------------------------------------------------------------
+            if(qrs(i,k,2).gt.qcrmin) then
+              acrfac = 2.*rslope3(i,k,2)+2.*diameter*rslope2(i,k,2)     &
+                      +diameter**2*rslope(i,k,2)
+              psaci(i,k) = pi*qci(i,k,2)*eacrs*n0s*n0sfac(i,k)          &
+                          *abs(vt2s-vt2i)*acrfac/4.
+              psaci(i,k) = min(psaci(i,k),qci(i,k,2)/dtcld)
+            endif
+!-------------------------------------------------------------
+! pgaci: Accretion of cloud ice by graupel [HL A17] [LFO 41]
+!        (T<T0: I->G)
+!-------------------------------------------------------------
+            if(qrs(i,k,3).gt.qcrmin) then
+              egi = exp(0.07*(-supcol))
+              acrfac = 2.*rslope3(i,k,3)+2.*diameter*rslope2(i,k,3)     &
+                      +diameter**2*rslope(i,k,3)
+              pgaci(i,k) = pi*egi*qci(i,k,2)*n0g*abs(vt2g-vt2i)*acrfac/4.
+              pgaci(i,k) = min(pgaci(i,k),qci(i,k,2)/dtcld)
+            endif
+          endif
+!-------------------------------------------------------------
+! psacw: Accretion of cloud water by snow  [HL A7] [LFO 24]
+!        (T<T0: C->G, and T>=T0: C->R)
+!-------------------------------------------------------------
+          if(qrs(i,k,2).gt.qcrmin.and.qci(i,k,1).gt.qmin) then
+            psacw(i,k) = min(pacrc*n0sfac(i,k)*rslope3(i,k,2)           &
+                        *rslopeb(i,k,2)*qci(i,k,1)*denfac(i,k)          &
+                        ,qci(i,k,1)/dtcld)
+          endif
+!-------------------------------------------------------------
+! pgacw: Accretion of cloud water by graupel [HL A6] [LFO 40]
+!        (T<T0: C->G, and T>=T0: C->R)
+!-------------------------------------------------------------
+          if(qrs(i,k,3).gt.qcrmin.and.qci(i,k,1).gt.qmin) then
+            pgacw(i,k) = min(pacrg*rslope3(i,k,3)*rslopeb(i,k,3)        &
+                        *qci(i,k,1)*denfac(i,k),qci(i,k,1)/dtcld)
+          endif
+!-------------------------------------------------------------
+! pracs: Accretion of snow by rain [HL A11] [LFO 27]
+!         (T<T0: S->G)
+!-------------------------------------------------------------
+          if(qrs(i,k,2).gt.qcrmin.and.qrs(i,k,1).gt.qcrmin) then
+            if(supcol.gt.0) then
+              acrfac = 5.*rslope3(i,k,2)*rslope3(i,k,2)*rslope(i,k,1)   &
+                      +2.*rslope3(i,k,2)*rslope2(i,k,2)*rslope2(i,k,1)  &
+                      +.5*rslope2(i,k,2)*rslope2(i,k,2)*rslope3(i,k,1)
+              pracs(i,k) = pi**2*n0r*n0s*n0sfac(i,k)*abs(vt2r-vt2s)     &
+                          *(dens/den(i,k))*acrfac
+              pracs(i,k) = min(pracs(i,k),qrs(i,k,2)/dtcld)
+            endif
+!-------------------------------------------------------------
+! psacr: Accretion of rain by snow [HL A10] [LFO 28]
+!         (T<T0:R->S or R->G) (T>=T0: enhance melting of snow)
+!-------------------------------------------------------------
+            acrfac = 5.*rslope3(i,k,1)*rslope3(i,k,1)*rslope(i,k,2)     &
+                    +2.*rslope3(i,k,1)*rslope2(i,k,1)*rslope2(i,k,2)    &
+                    +.5*rslope2(i,k,1)*rslope2(i,k,1)*rslope3(i,k,2)
+            psacr(i,k) = pi**2*n0r*n0s*n0sfac(i,k)*abs(vt2s-vt2r)       &
+                        *(denr/den(i,k))*acrfac
+            psacr(i,k) = min(psacr(i,k),qrs(i,k,1)/dtcld)
+          endif
+!-------------------------------------------------------------
+! pgacr: Accretion of rain by graupel [HL A12] [LFO 42]
+!         (T<T0: R->G) (T>=T0: enhance melting of graupel)
+!-------------------------------------------------------------
+          if(qrs(i,k,3).gt.qcrmin.and.qrs(i,k,1).gt.qcrmin) then
+            acrfac = 5.*rslope3(i,k,1)*rslope3(i,k,1)*rslope(i,k,3)     &
+                    +2.*rslope3(i,k,1)*rslope2(i,k,1)*rslope2(i,k,3)    &
+                    +.5*rslope2(i,k,1)*rslope2(i,k,1)*rslope3(i,k,3)
+            pgacr(i,k) = pi**2*n0r*n0g*abs(vt2g-vt2r)*(denr/den(i,k))   &
+                        *acrfac
+            pgacr(i,k) = min(pgacr(i,k),qrs(i,k,1)/dtcld)
+          endif
+!
+!-------------------------------------------------------------
+! pgacs: Accretion of snow by graupel [HL A13] [LFO 29]
+!        (S->G)
+!-------------------------------------------------------------
+          if(qrs(i,k,3).gt.qcrmin.and.qrs(i,k,2).gt.qcrmin) then
+            acrfac = 5.*rslope3(i,k,2)*rslope3(i,k,2)*rslope(i,k,3)     &
+                    +2.*rslope3(i,k,2)*rslope2(i,k,2)*rslope2(i,k,3)    &
+                    +.5*rslope2(i,k,2)*rslope2(i,k,2)*rslope3(i,k,3)
+            if(supcol.gt.0) then
+              egs = exp(-0.09*supcol)
+            else
+              egs = 1.
+            endif
+            pgacs(i,k) = pi**2*egs*n0s*n0sfac(i,k)*n0g*abs(vt2g-vt2s)   &
+                        *(dens/den(i,k))*acrfac
+            pgacs(i,k) = min(pgacs(i,k),qrs(i,k,2)/dtcld)
+          endif
+          if(supcol.le.0) then
+            xlf = xlf0
+!-------------------------------------------------------------
+! pseml: Enhanced melting of snow by accretion of water [HL A34]
+!        (T>=T0: S->R)
+!-------------------------------------------------------------
+            if(qrs(i,k,2).gt.0.)                                        &
+              pseml(i,k) = min(max(cliq*supcol*(psacw(i,k)+psacr(i,k))  &
+                          /xlf,-qrs(i,k,2)/dtcld),0.)
+!-------------------------------------------------------------
+! pgeml: Enhanced melting of graupel by accretion of water [HL A24] [RH84 A21-A22]
+!        (T>=T0: G->R)
+!-------------------------------------------------------------
+            if(qrs(i,k,3).gt.0.)                                        &
+              pgeml(i,k) = min(max(cliq*supcol*(pgacw(i,k)+pgacr(i,k))  &
+                          /xlf,-qrs(i,k,3)/dtcld),0.)
+          endif
+          if(supcol.gt.0) then
+!-------------------------------------------------------------
+! pidep: Deposition/Sublimation rate of ice [HDC 9]
+!       (T<T0: V->I or I->V)
+!-------------------------------------------------------------
+            if(qci(i,k,2).gt.0.and.ifsat.ne.1) then
+              pidep(i,k) = 4.*diameter*xni(i,k)*(rh(i,k,2)-1.)/work1(i,k,2)
+              supice = satdt-prevp(i,k)
+              if(pidep(i,k).lt.0.) then
+                pidep(i,k) = max(max(pidep(i,k),satdt/2),supice)
+                pidep(i,k) = max(pidep(i,k),-qci(i,k,2)/dtcld)
+              else
+                pidep(i,k) = min(min(pidep(i,k),satdt/2),supice)
+              endif
+              if(abs(prevp(i,k)+pidep(i,k)).ge.abs(satdt)) ifsat = 1
+            endif
+!-------------------------------------------------------------
+! psdep: deposition/sublimation rate of snow [HDC 14]
+!        (T<T0: V->S or S->V)
+!-------------------------------------------------------------
+            if(qrs(i,k,2).gt.0..and.ifsat.ne.1) then
+              coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2))
+              psdep(i,k) = (rh(i,k,2)-1.)*n0sfac(i,k)*(precs1          &
+                           *rslope2(i,k,2)+precs2*work2(i,k)            &
+                           *coeres)/work1(i,k,2)
+              supice = satdt-prevp(i,k)-pidep(i,k)
+              if(psdep(i,k).lt.0.) then
+                psdep(i,k) = max(psdep(i,k),-qrs(i,k,2)/dtcld)
+                psdep(i,k) = max(max(psdep(i,k),satdt/2),supice)
+              else
+                psdep(i,k) = min(min(psdep(i,k),satdt/2),supice)
+              endif
+              if(abs(prevp(i,k)+pidep(i,k)+psdep(i,k)).ge.abs(satdt))  &
+                ifsat = 1
+            endif
+!-------------------------------------------------------------
+! pgdep: deposition/sublimation rate of graupel [HL A21] [LFO 46]
+!        (T<T0: V->G or G->V)
+!-------------------------------------------------------------
+            if(qrs(i,k,3).gt.0..and.ifsat.ne.1) then
+              coeres = rslope2(i,k,3)*sqrt(rslope(i,k,3)*rslopeb(i,k,3))
+              pgdep(i,k) = (rh(i,k,2)-1.)*(precg1*rslope2(i,k,3)       &
+                              +precg2*work2(i,k)*coeres)/work1(i,k,2)
+              supice = satdt-prevp(i,k)-pidep(i,k)-psdep(i,k)
+              if(pgdep(i,k).lt.0.) then
+                pgdep(i,k) = max(pgdep(i,k),-qrs(i,k,3)/dtcld)
+                pgdep(i,k) = max(max(pgdep(i,k),satdt/2),supice)
+              else
+                pgdep(i,k) = min(min(pgdep(i,k),satdt/2),supice)
+              endif
+              if(abs(prevp(i,k)+pidep(i,k)+psdep(i,k)+pgdep(i,k)).ge. &
+                abs(satdt)) ifsat = 1
+            endif
+!-------------------------------------------------------------
+! pigen: generation(nucleation) of ice from vapor [HL 50] [HDC 7-8]
+!       (T<T0: V->I)
+!-------------------------------------------------------------
+            if(supsat.gt.0.and.ifsat.ne.1) then
+              supice = satdt-prevp(i,k)-pidep(i,k)-psdep(i,k)-pgdep(i,k)
+              xni0 = 1.e3*exp(0.1*supcol)
+              roqi0 = 4.92e-11*xni0**1.33
+              pigen(i,k) = max(0.,(roqi0/den(i,k)-max(qci(i,k,2),0.))    &
+                         /dtcld)
+              pigen(i,k) = min(min(pigen(i,k),satdt),supice)
+            endif
+!
+!-------------------------------------------------------------
+! psaut: conversion(aggregation) of ice to snow [HDC 12]
+!        (T<T0: I->S)
+!-------------------------------------------------------------
+            if(qci(i,k,2).gt.0.) then
+              qimax = roqimax/den(i,k)
+              psaut(i,k) = max(0.,(qci(i,k,2)-qimax)/dtcld)
+            endif
+!
+!-------------------------------------------------------------
+! pgaut: conversion(aggregation) of snow to graupel [HL A4] [LFO 37]
+!        (T<T0: S->G)
+!-------------------------------------------------------------
+            if(qrs(i,k,2).gt.0.) then
+              alpha2 = 1.e-3*exp(0.09*(-supcol))
+              pgaut(i,k) = min(max(0.,alpha2*(qrs(i,k,2)-qs0))         &
+                           ,qrs(i,k,2)/dtcld)
+            endif
+          endif
+!
+!-------------------------------------------------------------
+! psevp: Evaporation of melting snow [HL A35] [RH83 A27]
+!       (T>=T0: S->V)
+!-------------------------------------------------------------
+          if(supcol.lt.0.) then
+            if(qrs(i,k,2).gt.0..and.rh(i,k,1).lt.1.) then
+              coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2))
+              psevp(i,k) = (rh(i,k,1)-1.)*n0sfac(i,k)*(precs1            &
+                           *rslope2(i,k,2)+precs2*work2(i,k)            &
+                           *coeres)/work1(i,k,1)
+              psevp(i,k) = min(max(psevp(i,k),-qrs(i,k,2)/dtcld),0.)
+            endif
+!-------------------------------------------------------------
+! pgevp: Evaporation of melting graupel [HL A25] [RH84 A19]
+!       (T>=T0: G->V)
+!-------------------------------------------------------------
+            if(qrs(i,k,3).gt.0..and.rh(i,k,1).lt.1.) then
+              coeres = rslope2(i,k,3)*sqrt(rslope(i,k,3)*rslopeb(i,k,3))
+              pgevp(i,k) = (rh(i,k,1)-1.)*(precg1*rslope2(i,k,3)         &
+                         +precg2*work2(i,k)*coeres)/work1(i,k,1)
+              pgevp(i,k) = min(max(pgevp(i,k),-qrs(i,k,3)/dtcld),0.)
+            endif
+          endif
+        enddo
+      enddo
+!
+!
+!----------------------------------------------------------------
+!     check mass conservation of generation terms and feedback to the
+!     large scale
+!
+      do k = kts, kte
+        do i = its, ite
+!
+          delta2=0.
+          delta3=0.
+          if(qrs(i,k,1).lt.1.e-4.and.qrs(i,k,2).lt.1.e-4) delta2=1.
+          if(qrs(i,k,1).lt.1.e-4) delta3=1.
+          if(t(i,k).le.t0c) then
+!
+!     cloud water
+!
+            value = max(qmin,qci(i,k,1))
+            source = (praut(i,k)+pracw(i,k)+psacw(i,k)+pgacw(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              praut(i,k) = praut(i,k)*factor
+              pracw(i,k) = pracw(i,k)*factor
+              psacw(i,k) = psacw(i,k)*factor
+              pgacw(i,k) = pgacw(i,k)*factor
+            endif
+!
+!     cloud ice
+!
+            value = max(qmin,qci(i,k,2))
+            source = (psaut(i,k)-pigen(i,k)-pidep(i,k)+praci(i,k)        &
+                    +psaci(i,k)+pgaci(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              psaut(i,k) = psaut(i,k)*factor
+              pigen(i,k) = pigen(i,k)*factor
+              pidep(i,k) = pidep(i,k)*factor
+              praci(i,k) = praci(i,k)*factor
+              psaci(i,k) = psaci(i,k)*factor
+              pgaci(i,k) = pgaci(i,k)*factor
+            endif
+!
+!     rain
+!
+            value = max(qmin,qrs(i,k,1))
+            source = (-praut(i,k)-prevp(i,k)-pracw(i,k)+piacr(i,k)    &
+                    +psacr(i,k)+pgacr(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              praut(i,k) = praut(i,k)*factor
+              prevp(i,k) = prevp(i,k)*factor
+              pracw(i,k) = pracw(i,k)*factor
+              piacr(i,k) = piacr(i,k)*factor
+              psacr(i,k) = psacr(i,k)*factor
+              pgacr(i,k) = pgacr(i,k)*factor
+            endif
+!
+!     snow
+!
+            value = max(qmin,qrs(i,k,2))
+            source = -(psdep(i,k)+psaut(i,k)-pgaut(i,k)+psacw(i,k)      &
+                     +piacr(i,k)*delta3+praci(i,k)*delta3               &
+                     -pracs(i,k)*(1.-delta2)+psacr(i,k)*delta2          &
+                     +psaci(i,k)-pgacs(i,k) )*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              psdep(i,k) = psdep(i,k)*factor
+              psaut(i,k) = psaut(i,k)*factor
+              pgaut(i,k) = pgaut(i,k)*factor
+              psacw(i,k) = psacw(i,k)*factor
+              piacr(i,k) = piacr(i,k)*factor
+              praci(i,k) = praci(i,k)*factor
+              psaci(i,k) = psaci(i,k)*factor
+              pracs(i,k) = pracs(i,k)*factor
+              psacr(i,k) = psacr(i,k)*factor
+              pgacs(i,k) = pgacs(i,k)*factor
+            endif
+!
+!     graupel
+!
+            value = max(qmin,qrs(i,k,3))
+            source = -(pgdep(i,k)+pgaut(i,k)               &
+                     +piacr(i,k)*(1.-delta3)+praci(i,k)*(1.-delta3)     &
+                     +psacr(i,k)*(1.-delta2)+pracs(i,k)*(1.-delta2)     &
+                     +pgaci(i,k)+pgacw(i,k)+pgacr(i,k)+pgacs(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              pgdep(i,k) = pgdep(i,k)*factor
+              pgaut(i,k) = pgaut(i,k)*factor
+              piacr(i,k) = piacr(i,k)*factor
+              praci(i,k) = praci(i,k)*factor
+              psacr(i,k) = psacr(i,k)*factor
+              pracs(i,k) = pracs(i,k)*factor
+              pgacw(i,k) = pgacw(i,k)*factor
+              pgaci(i,k) = pgaci(i,k)*factor
+              pgacr(i,k) = pgacr(i,k)*factor
+              pgacs(i,k) = pgacs(i,k)*factor
+            endif
+!
+            work2(i,k)=-(prevp(i,k)+psdep(i,k)+pgdep(i,k)+pigen(i,k)   &
+                       +pidep(i,k))
+!     update
+            q(i,k) = q(i,k)+work2(i,k)*dtcld
+            qci(i,k,1) = max(qci(i,k,1)-(praut(i,k)+pracw(i,k)          &
+                           +psacw(i,k)+pgacw(i,k))*dtcld,0.)
+            qrs(i,k,1) = max(qrs(i,k,1)+(praut(i,k)+pracw(i,k)          &
+                           +prevp(i,k)-piacr(i,k)-pgacr(i,k)            &
+                           -psacr(i,k))*dtcld,0.)
+            qci(i,k,2) = max(qci(i,k,2)-(psaut(i,k)+praci(i,k)          &
+                           +psaci(i,k)+pgaci(i,k)-pigen(i,k)-pidep(i,k))   &
+                           *dtcld,0.)
+            qrs(i,k,2) = max(qrs(i,k,2)+(psdep(i,k)+psaut(i,k)+psacw(i,k)  &
+                           -pgaut(i,k)+piacr(i,k)*delta3                &
+                           +praci(i,k)*delta3+psaci(i,k)-pgacs(i,k)      &
+                           -pracs(i,k)*(1.-delta2)+psacr(i,k)*delta2)    &
+                           *dtcld,0.)
+            qrs(i,k,3) = max(qrs(i,k,3)+(pgdep(i,k)+pgaut(i,k)         &
+                           +piacr(i,k)*(1.-delta3)            &
+                           +praci(i,k)*(1.-delta3)+psacr(i,k)*(1.-delta2)&
+                           +pracs(i,k)*(1.-delta2)+pgaci(i,k)+pgacw(i,k) &
+                           +pgacr(i,k)+pgacs(i,k))*dtcld,0.)
+            xlf = xls-xl(i,k)
+            xlwork2 = -xls*(psdep(i,k)+pgdep(i,k)+pidep(i,k)+pigen(i,k)) &
+                      -xl(i,k)*prevp(i,k)-xlf*(piacr(i,k)+psacw(i,k)    &
+                      +pgacw(i,k)+pgacr(i,k)+psacr(i,k))
+            t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld
+          else
+!
+!     cloud water
+!
+            value = max(qmin,qci(i,k,1))
+            source=(praut(i,k)+pracw(i,k)+psacw(i,k)+pgacw(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              praut(i,k) = praut(i,k)*factor
+              pracw(i,k) = pracw(i,k)*factor
+              psacw(i,k) = psacw(i,k)*factor
+              pgacw(i,k) = pgacw(i,k)*factor
+            endif
+!
+!     rain
+!
+            value = max(qmin,qrs(i,k,1))
+            source = (-psacw(i,k)-praut(i,k)+pseml(i,k)+pgeml(i,k)     &
+                     -pracw(i,k)-pgacw(i,k)-prevp(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              praut(i,k) = praut(i,k)*factor
+              prevp(i,k) = prevp(i,k)*factor
+              pgacw(i,k) = pgacw(i,k)*factor
+              pracw(i,k) = pracw(i,k)*factor
+              psacw(i,k) = psacw(i,k)*factor
+              pseml(i,k) = pseml(i,k)*factor
+              pgeml(i,k) = pgeml(i,k)*factor
+            endif
+!
+!     snow
+!
+            value = max(qcrmin,qrs(i,k,2))
+            source=(pgacs(i,k)-pseml(i,k)-psevp(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              pgacs(i,k) = pgacs(i,k)*factor
+              psevp(i,k) = psevp(i,k)*factor
+              pseml(i,k) = pseml(i,k)*factor
+            endif
+!
+!     graupel
+!
+            value = max(qcrmin,qrs(i,k,3))
+            source=-(pgacs(i,k)+pgevp(i,k)+pgeml(i,k))*dtcld
+            if (source.gt.value) then
+              factor = value/source
+              pgacs(i,k) = pgacs(i,k)*factor
+              pgevp(i,k) = pgevp(i,k)*factor
+              pgeml(i,k) = pgeml(i,k)*factor
+            endif
+            work2(i,k)=-(prevp(i,k)+psevp(i,k)+pgevp(i,k))
+!     update
+            q(i,k) = q(i,k)+work2(i,k)*dtcld
+            qci(i,k,1) = max(qci(i,k,1)-(praut(i,k)+pracw(i,k)         &
+                    +psacw(i,k)+pgacw(i,k))*dtcld,0.)
+            qrs(i,k,1) = max(qrs(i,k,1)+(praut(i,k)+pracw(i,k)         &
+                    +prevp(i,k)+psacw(i,k)+pgacw(i,k)-pseml(i,k)       &
+                    -pgeml(i,k))*dtcld,0.)
+            qrs(i,k,2) = max(qrs(i,k,2)+(psevp(i,k)-pgacs(i,k)           &
+                    +pseml(i,k))*dtcld,0.)
+            qrs(i,k,3) = max(qrs(i,k,3)+(pgacs(i,k)+pgevp(i,k)           &
+                    +pgeml(i,k))*dtcld,0.)
+            xlf = xls-xl(i,k)
+            xlwork2 = -xl(i,k)*(prevp(i,k)+psevp(i,k)+pgevp(i,k))        &
+                      -xlf*(pseml(i,k)+pgeml(i,k))
+            t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld
+          endif
+        enddo
+      enddo
+!
+! Inline expansion for fpvs
+!         qs(i,k,1) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+!         qs(i,k,2) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c)
+      hsub = xls
+      hvap = xlv0
+      cvap = cpv
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      do k = kts, kte
+        do i = its, ite
+          tr=ttp/t(i,k)
+          qs(i,k,1)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
+          qs(i,k,1) = ep2 * qs(i,k,1) / (p(i,k) - qs(i,k,1))
+          qs(i,k,1) = max(qs(i,k,1),qmin)
+          tr=ttp/t(i,k)
+          if(t(i,k).lt.ttp) then
+            qs(i,k,2)=psat*exp(log(tr)*(xai))*exp(xbi*(1.-tr))
+          else
+            qs(i,k,2)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
+          endif
+          qs(i,k,2) = ep2 * qs(i,k,2) / (p(i,k) - qs(i,k,2))
+          qs(i,k,2) = max(qs(i,k,2),qmin)
+        enddo
+      enddo
+!
+!----------------------------------------------------------------
+!  pcond: condensational/evaporational rate of cloud water [HL A46] [RH83 A6]
+!     if there exists additional water vapor condensated/if
+!     evaporation of cloud water is not enough to remove subsaturation
+!
+      do k = kts, kte
+        do i = its, ite
+          work1(i,k,1) = conden(t(i,k),q(i,k),qs(i,k,1),xl(i,k),cpm(i,k))
+          work2(i,k) = qci(i,k,1)+work1(i,k,1)
+          pcond(i,k) = min(max(work1(i,k,1)/dtcld,0.),max(q(i,k),0.)/dtcld)
+          if(qci(i,k,1).gt.0..and.work1(i,k,1).lt.0.)                   &
+            pcond(i,k) = max(work1(i,k,1),-qci(i,k,1))/dtcld
+          q(i,k) = q(i,k)-pcond(i,k)*dtcld
+          qci(i,k,1) = max(qci(i,k,1)+pcond(i,k)*dtcld,0.)
+          t(i,k) = t(i,k)+pcond(i,k)*xl(i,k)/cpm(i,k)*dtcld
+        enddo
+      enddo
+!
+!
+!----------------------------------------------------------------
+!     padding for small values
+!
+      do k = kts, kte
+        do i = its, ite
+          if(qci(i,k,1).le.qmin) qci(i,k,1) = 0.0
+          if(qci(i,k,2).le.qmin) qci(i,k,2) = 0.0
+        enddo
+      enddo
+      enddo                  ! big loops
+  END SUBROUTINE wsm62d
+! ...................................................................
+      REAL FUNCTION rgmma(x)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!     rgmma function:  use infinite product form
+      REAL :: euler
+      PARAMETER (euler=0.577215664901532)
+      REAL :: x, y
+      INTEGER :: i
+      if(x.eq.1.)then
+        rgmma=0.
+          else
+        rgmma=x*exp(euler*x)
+        do i=1,10000
+          y=float(i)
+          rgmma=rgmma*(1.000+x/y)*exp(-x/y)
+        enddo
+        rgmma=1./rgmma
+      endif
+      END FUNCTION rgmma
+!
+!--------------------------------------------------------------------------
+      REAL FUNCTION fpvs(t,ice,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c)
+!--------------------------------------------------------------------------
+      IMPLICIT NONE
+!--------------------------------------------------------------------------
+      REAL t,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c,dldt,xa,xb,dldti,  &
+           xai,xbi,ttp,tr
+      INTEGER ice
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      ttp=t0c+0.01
+      dldt=cvap-cliq
+      xa=-dldt/rv
+      xb=xa+hvap/(rv*ttp)
+      dldti=cvap-cice
+      xai=-dldti/rv
+      xbi=xai+hsub/(rv*ttp)
+      tr=ttp/t
+      if(t.lt.ttp.and.ice.eq.1) then
+        fpvs=psat*(tr**xai)*exp(xbi*(1.-tr))
+      else
+        fpvs=psat*(tr**xa)*exp(xb*(1.-tr))
+      endif
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      END FUNCTION fpvs
+!-------------------------------------------------------------------
+  SUBROUTINE wsm6init(den0,denr,dens,cl,cpv,allowed_to_read)
+!-------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------
+!.... constants which may not be tunable
+   REAL, INTENT(IN) :: den0,denr,dens,cl,cpv
+   LOGICAL, INTENT(IN) :: allowed_to_read
+   REAL :: pi
+!
+   pi = 4.*atan(1.)
+   xlv1 = cl-cpv
+!
+   qc0  = 4./3.*pi*denr*r0**3*xncr/den0  ! 0.419e-3 -- .61e-3
+   qck1 = .104*9.8*peaut/(xncr*denr)**(1./3.)/xmyu*den0**(4./3.) ! 7.03
+!
+   bvtr1 = 1.+bvtr
+   bvtr2 = 2.5+.5*bvtr
+   bvtr3 = 3.+bvtr
+   bvtr4 = 4.+bvtr
+   bvtr6 = 6.+bvtr
+   g1pbr = rgmma(bvtr1)
+   g3pbr = rgmma(bvtr3)
+   g4pbr = rgmma(bvtr4)            ! 17.837825
+   g6pbr = rgmma(bvtr6)
+   g5pbro2 = rgmma(bvtr2)          ! 1.8273
+   pvtr = avtr*g4pbr/6.
+   eacrr = 1.0
+   pacrr = pi*n0r*avtr*g3pbr*.25*eacrr
+   precr1 = 2.*pi*n0r*.78
+   precr2 = 2.*pi*n0r*.31*avtr**.5*g5pbro2
+   xm0  = (di0/dicon)**2
+   xmmax = (dimax/dicon)**2
+   roqimax = 2.08e22*dimax**8
+!
+   bvts1 = 1.+bvts
+   bvts2 = 2.5+.5*bvts
+   bvts3 = 3.+bvts
+   bvts4 = 4.+bvts
+   g1pbs = rgmma(bvts1)    !.8875
+   g3pbs = rgmma(bvts3)
+   g4pbs = rgmma(bvts4)    ! 12.0786
+   g5pbso2 = rgmma(bvts2)
+   pvts = avts*g4pbs/6.
+   pacrs = pi*n0s*avts*g3pbs*.25
+   precs1 = 4.*n0s*.65
+   precs2 = 4.*n0s*.44*avts**.5*g5pbso2
+   pidn0r =  pi*denr*n0r
+   pidn0s =  pi*dens*n0s
+!
+   pacrc = pi*n0s*avts*g3pbs*.25*eacrc
+!
+   bvtg1 = 1.+bvtg
+   bvtg2 = 2.5+.5*bvtg
+   bvtg3 = 3.+bvtg
+   bvtg4 = 4.+bvtg
+   g1pbg = rgmma(bvtg1)
+   g3pbg = rgmma(bvtg3)
+   g4pbg = rgmma(bvtg4)
+   pacrg = pi*n0g*avtg*g3pbg*.25
+   g5pbgo2 = rgmma(bvtg2)
+   pvtg = avtg*g4pbg/6.
+   precg1 = 2.*pi*n0g*.78
+   precg2 = 2.*pi*n0g*.31*avtg**.5*g5pbgo2
+   pidn0g =  pi*deng*n0g
+!
+   rslopermax = 1./lamdarmax
+   rslopesmax = 1./lamdasmax
+   rslopegmax = 1./lamdagmax
+   rsloperbmax = rslopermax ** bvtr
+   rslopesbmax = rslopesmax ** bvts
+   rslopegbmax = rslopegmax ** bvtg
+   rsloper2max = rslopermax * rslopermax
+   rslopes2max = rslopesmax * rslopesmax
+   rslopeg2max = rslopegmax * rslopegmax
+   rsloper3max = rsloper2max * rslopermax
+   rslopes3max = rslopes2max * rslopesmax
+   rslopeg3max = rslopeg2max * rslopegmax
+!
+  END SUBROUTINE wsm6init
+END MODULE module_mp_wsm6
Index: trunk/WRF.COMMON/WRFV2/phys/module_pbl_driver.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_pbl_driver.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_pbl_driver.F	(revision 2744)
@@ -0,0 +1,535 @@
+!WRF:MEDIATION_LAYER:PHYSICS
+!
+
+MODULE module_pbl_driver
+CONTAINS
+
+!------------------------------------------------------------------
+   SUBROUTINE pbl_driver(                                          &
+                  itimestep,dt,u_frame,v_frame                     &
+                 ,rublten,rvblten,rthblten                         &
+                 ,tsk,xland,znt,ht                                 &
+                 ,ust,pblh,hfx,qfx,grdflx                          &
+                 ,u_phy,v_phy,th_phy,rho                           &
+                 ,p_phy,pi_phy,p8w,t_phy,dz8w,z                    &
+                 ,tke_myj,el_myj,exch_h,akhs,akms                  &
+                 ,thz0,qz0,uz0,vz0,qsfc                            &
+                 ,lowlyr                                           &
+                 ,psim,psih,gz1oz0, wspd,br,chklowq                &
+                 ,bl_pbl_physics, ra_lw_physics, dx                &
+                 ,stepbl,warm_rain                                 &
+                 ,kpbl,ct,lh,snow,xice                             &
+                 ,ids,ide, jds,jde, kds,kde                        &
+                 ,ims,ime, jms,jme, kms,kme                        &
+                 ,i_start,i_end, j_start,j_end, kts,kte, num_tiles &
+             ! Optional
+                 ,hol, mol, regime                                 &
+             !  Optional moisture tracers
+                 ,qv_curr, qc_curr, qr_curr                        &
+                 ,qi_curr, qs_curr, qg_curr                        &
+                 ,rqvblten,rqcblten,rqiblten                       &
+                 ,rqrblten,rqsblten,rqgblten                       &
+             !  Optional moisture tracer flags
+                 ,f_qv,f_qc,f_qr                                   &
+                 ,f_qi,f_qs,f_qg                                   &
+                                                                   )
+!------------------------------------------------------------------
+   USE module_state_description, ONLY :                            &
+                   YSUSCHEME,MRFSCHEME,GFSSCHEME,MYJPBLSCHEME
+
+   USE module_model_constants
+
+! *** add new modules of schemes here
+
+   USE module_bl_myjpbl
+   USE module_bl_ysu
+   USE module_bl_mrf
+   USE module_bl_gfs
+
+   !  This driver calls subroutines for the PBL parameterizations.
+   !
+   !  pbl scheme:
+   !      1. ysupbl
+   !      2. myjpbl
+   !      99. mrfpbl
+   !
+!------------------------------------------------------------------
+   IMPLICIT NONE
+!======================================================================
+! Grid structure in physics part of WRF
+!----------------------------------------------------------------------
+! The horizontal velocities used in the physics are unstaggered
+! relative to temperature/moisture variables. All predicted
+! variables are carried at half levels except w, which is at full
+! levels. Some arrays with names (*8w) are at w (full) levels.
+!
+!----------------------------------------------------------------------
+! In WRF, kms (smallest number) is the bottom level and kme (largest
+! number) is the top level.  In your scheme, if 1 is at the top level,
+! then you have to reverse the order in the k direction.
+!
+!         kme      -   half level (no data at this level)
+!         kme    ----- full level
+!         kme-1    -   half level
+!         kme-1  ----- full level
+!         .
+!         .
+!         .
+!         kms+2    -   half level
+!         kms+2  ----- full level
+!         kms+1    -   half level
+!         kms+1  ----- full level
+!         kms      -   half level
+!         kms    ----- full level
+!
+!======================================================================
+! Definitions
+!-----------
+! Rho_d      dry density (kg/m^3)
+! Theta_m    moist potential temperature (K)
+! Qv         water vapor mixing ratio (kg/kg)
+! Qc         cloud water mixing ratio (kg/kg)
+! Qr         rain water mixing ratio (kg/kg)
+! Qi         cloud ice mixing ratio (kg/kg)
+! Qs         snow mixing ratio (kg/kg)
+!-----------------------------------------------------------------
+!-- RUBLTEN       U tendency due to 
+!                 PBL parameterization (m/s^2)
+!-- RVBLTEN       V tendency due to 
+!                 PBL parameterization (m/s^2)
+!-- RTHBLTEN      Theta tendency due to 
+!                 PBL parameterization (K/s)
+!-- RQVBLTEN      Qv tendency due to 
+!                 PBL parameterization (kg/kg/s)
+!-- RQCBLTEN      Qc tendency due to 
+!                 PBL parameterization (kg/kg/s)
+!-- RQIBLTEN      Qi tendency due to 
+!                 PBL parameterization (kg/kg/s)
+!-- itimestep     number of time steps
+!-- GLW           downward long wave flux at ground surface (W/m^2)
+!-- GSW           downward short wave flux at ground surface (W/m^2)
+!-- EMISS         surface emissivity (between 0 and 1)
+!-- TSK           surface temperature (K)
+!-- TMN           soil temperature at lower boundary (K)
+!-- XLAND         land mask (1 for land, 2 for water)
+!-- ZNT           roughness length (m)
+!-- MAVAIL        surface moisture availability (between 0 and 1)
+!-- UST           u* in similarity theory (m/s)
+!-- MOL           T* (similarity theory) (K)
+!-- HOL           PBL height over Monin-Obukhov length
+!-- PBLH          PBL height (m)
+!-- CAPG          heat capacity for soil (J/K/m^3)
+!-- THC           thermal inertia (Cal/cm/K/s^0.5)
+!-- SNOWC         flag indicating snow coverage (1 for snow cover)
+!-- HFX           upward heat flux at the surface (W/m^2)
+!-- QFX           upward moisture flux at the surface (kg/m^2/s)
+!-- REGIME        flag indicating PBL regime (stable, unstable, etc.)
+!-- tke_myj       turbulence kinetic energy from Mellor-Yamada-Janjic (MYJ) (m^2/s^2)
+!-- el_myj        mixing length from Mellor-Yamada-Janjic (MYJ) (m)
+!-- akhs          sfc exchange coefficient of heat/moisture from MYJ
+!-- akms          sfc exchange coefficient of momentum from MYJ
+!-- thz0          potential temperature at roughness length (K)
+!-- uz0           u wind component at roughness length (m/s)
+!-- vz0           v wind component at roughness length (m/s)
+!-- qsfc          specific humidity at lower boundary (kg/kg)
+!-- th2           diagnostic 2-m theta from surface layer and lsm
+!-- t2            diagnostic 2-m temperature from surface layer and lsm
+!-- q2            diagnostic 2-m mixing ratio from surface layer and lsm
+!-- lowlyr        index of lowest model layer above ground
+!-- rr            dry air density (kg/m^3)
+!-- u_phy         u-velocity interpolated to theta points (m/s)
+!-- v_phy         v-velocity interpolated to theta points (m/s)
+!-- th_phy        potential temperature (K)
+!-- p_phy         pressure (Pa)
+!-- pi_phy        exner function (dimensionless)
+!-- p8w           pressure at full levels (Pa)
+!-- t_phy         temperature (K)
+!-- dz8w          dz between full levels (m)
+!-- z             height above sea level (m)
+!-- DX            horizontal space interval (m)
+!-- DT            time step (second)
+!-- n_moist       number of moisture species
+!-- PSFC          pressure at the surface (Pa)
+!-- TSLB          
+!-- ZS
+!-- DZS
+!-- num_soil_layers number of soil layer
+!-- IFSNOW      ifsnow=1 for snow-cover effects
+!
+!-- P_QV          species index for water vapor
+!-- P_QC          species index for cloud water
+!-- P_QR          species index for rain water
+!-- P_QI          species index for cloud ice
+!-- P_QS          species index for snow
+!-- P_QG          species index for graupel
+!-- ids           start index for i in domain
+!-- ide           end index for i in domain
+!-- jds           start index for j in domain
+!-- jde           end index for j in domain
+!-- kds           start index for k in domain
+!-- kde           end index for k in domain
+!-- ims           start index for i in memory
+!-- ime           end index for i in memory
+!-- jms           start index for j in memory
+!-- jme           end index for j in memory
+!-- kms           start index for k in memory
+!-- kme           end index for k in memory
+!-- jts           start index for j in tile
+!-- jte           end index for j in tile
+!-- kts           start index for k in tile
+!-- kte           end index for k in tile
+!
+!******************************************************************
+!------------------------------------------------------------------ 
+!
+
+
+   INTEGER,    INTENT(IN   )    ::     bl_pbl_physics, ra_lw_physics
+
+   INTEGER,    INTENT(IN   )    ::     ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       kts,kte, num_tiles
+
+   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                   &
+  &                                    i_start,i_end,j_start,j_end
+
+   INTEGER,    INTENT(IN   )    ::     itimestep,STEPBL
+   INTEGER,    DIMENSION( ims:ime , jms:jme ),                    &
+               INTENT(IN   )    ::                        LOWLYR
+!
+   LOGICAL,      INTENT(IN   )    ::   warm_rain
+!
+   REAL,       INTENT(IN   )    ::     DT,DX
+
+
+!
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
+               INTENT(IN   )    ::                         p_phy, &
+                                                          pi_phy, &
+                                                             p8w, &
+                                                             rho, &
+                                                           t_phy, &
+                                                           u_phy, &
+                                                           v_phy, &
+                                                            dz8w, &
+                                                               z, &
+                                                          th_phy
+!
+!
+   REAL,       DIMENSION( ims:ime , jms:jme ),                    &
+               INTENT(IN   )    ::                         XLAND, &
+                                                              HT, &
+                                                            PSIM, &
+                                                            PSIH, &
+                                                          GZ1OZ0, &
+                                                              BR, &
+                                                         CHKLOWQ
+!
+   REAL,       DIMENSION( ims:ime, jms:jme )                    , &
+               INTENT(INOUT)    ::                           TSK, &
+                                                             UST, &
+                                                            PBLH, &
+                                                             HFX, &
+                                                             QFX, &
+                                                             ZNT, &
+                                                            QSFC, &
+                                                            AKHS, &
+                                                            AKMS, &
+                                                             QZ0, &
+                                                            THZ0, &
+                                                             UZ0, &
+                                                             VZ0, &
+                                                              CT, &
+                                                          GRDFLX  , &
+                                                            WSPD
+
+!
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
+               INTENT(INOUT)    ::                       RUBLTEN, &
+                                                         RVBLTEN, &
+                                                        RTHBLTEN, &
+                                                  EXCH_H,TKE_MYJ
+!
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
+               INTENT(OUT)    ::                          EL_MYJ
+
+   REAL ,                             INTENT(IN   )  ::  u_frame, &
+                                                         v_frame
+!
+
+   INTEGER,    DIMENSION( ims:ime , jms:jme ),                    &
+               INTENT(INOUT) ::                             KPBL
+
+   REAL,       DIMENSION( ims:ime , jms:jme ),                    &
+               INTENT(IN)    :: XICE, SNOW, LH
+
+!
+! Optional
+!
+!
+! Flags relating to the optional tendency arrays declared above
+! Models that carry the optional tendencies will provdide the
+! optional arguments at compile time; these flags all the model
+! to determine at run-time whether a particular tracer is in
+! use or not.
+!
+   LOGICAL, INTENT(IN), OPTIONAL ::                             &
+                                                      f_qv      &
+                                                     ,f_qc      &
+                                                     ,f_qr      &
+                                                     ,f_qi      &
+                                                     ,f_qs      &
+                                                     ,f_qg
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         OPTIONAL, INTENT(INOUT) ::                              &
+                      ! optional moisture tracers
+                      ! 2 time levels; if only one then use CURR
+                      qv_curr, qc_curr, qr_curr                  &
+                     ,qi_curr, qs_curr, qg_curr                  &
+                     ,rqvblten,rqcblten,rqrblten                 &
+                     ,rqiblten,rqsblten,rqgblten
+
+   REAL,       DIMENSION( ims:ime, jms:jme )                    , &
+               OPTIONAL                                         , &
+               INTENT(INOUT)    ::                           HOL, &
+                                                             MOL, &
+                                                          REGIME
+
+!  LOCAL  VAR
+
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
+
+   REAL,       DIMENSION( ims:ime, jms:jme )          ::  TSKOLD, &
+                                                          USTOLD, &
+                                                          ZNTOLD, &
+                                                             ZOL, &
+                                                            PSFC
+
+!
+
+   REAL    :: DTMIN,DTBL
+!
+   INTEGER :: i,J,K,NK,jj,ij,its,ite,jts,jte
+   LOGICAL :: radiation
+   LOGICAL :: flag_qv, flag_qc, flag_qr, flag_qi, flag_qs, flag_qg
+   CHARACTER*256 :: message
+
+!------------------------------------------------------------------
+!
+
+  flag_qv = .FALSE. ; IF ( PRESENT( F_QV ) ) flag_qv = F_QV
+  flag_qc = .FALSE. ; IF ( PRESENT( F_QC ) ) flag_qv = F_QC
+  flag_qr = .FALSE. ; IF ( PRESENT( F_QR ) ) flag_qv = F_QR
+  flag_qi = .FALSE. ; IF ( PRESENT( F_QI ) ) flag_qv = F_QI
+  flag_qs = .FALSE. ; IF ( PRESENT( F_QS ) ) flag_qv = F_QS
+  flag_qg = .FALSE. ; IF ( PRESENT( F_QG ) ) flag_qv = F_QG
+
+
+  if (bl_pbl_physics .eq. 0) return
+! RAINBL in mm (Accumulation between PBL calls)
+
+
+  IF (itimestep .eq. 1 .or. mod(itimestep,STEPBL) .eq. 0) THEN
+
+  radiation = .false.
+  IF (ra_lw_physics .gt. 0) radiation = .true.
+
+!---- 
+! CALCULATE CONSTANT
+ 
+   DTMIN=DT/60.
+! PBL schemes need PBL time step for updates
+   DTBL=DT*STEPBL
+
+! SAVE OLD VALUES
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij,i,j,k )
+   DO ij = 1 , num_tiles
+      DO j=j_start(ij),j_end(ij)
+      DO i=i_start(ij),i_end(ij)
+         TSKOLD(i,j)=TSK(i,j)
+         USTOLD(i,j)=UST(i,j)
+         ZNTOLD(i,j)=ZNT(i,j)
+
+! REVERSE ORDER IN THE VERTICAL DIRECTION
+
+! testing change later
+
+         DO k=kts,kte
+            v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
+            u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
+         ENDDO
+
+! PSFC : in Pa
+
+         PSFC(I,J)=p8w(I,kms,J)
+
+         DO k=kts,min(kte+1,kde)
+            RTHBLTEN(I,K,J)=0.
+            RUBLTEN(I,K,J)=0.
+            RVBLTEN(I,K,J)=0.
+            IF ( PRESENT( RQCBLTEN )) RQCBLTEN(I,K,J)=0.
+            IF ( PRESENT( RQVBLTEN )) RQVBLTEN(I,K,J)=0.
+         ENDDO
+
+         IF (flag_QI .AND. PRESENT(RQIBLTEN) ) THEN
+            DO k=kts,min(kte+1,kde)
+               RQIBLTEN(I,K,J)=0.
+            ENDDO
+         ENDIF
+      ENDDO
+      ENDDO
+
+   ENDDO
+   !$OMP END PARALLEL DO
+!
+  !$OMP PARALLEL DO   &
+  !$OMP PRIVATE ( ij, i,j,k, its, ite, jts, jte )
+  DO ij = 1 , num_tiles
+
+   its = i_start(ij)
+   ite = i_end(ij)
+   jts = j_start(ij)
+   jte = j_end(ij)
+
+   pbl_select: SELECT CASE(bl_pbl_physics)
+
+      CASE (YSUSCHEME)
+        CALL wrf_debug(100,'in YSU PBL')
+           IF ( PRESENT( qv_curr )  .AND. PRESENT( qc_curr )  .AND. &
+                PRESENT( qi_curr )                            .AND. &
+                PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. &
+                PRESENT( rqiblten )                           .AND. &
+                PRESENT( hol      )                           .AND. &
+                                                        .TRUE.  ) THEN
+             CALL ysu(                                              &
+               U3D=u_phytmp,V3D=v_phytmp,TH3D=th_phy,T3D=t_phy      &
+              ,QV3D=qv_curr,QC3D=qc_curr,QI3D=qi_curr               &
+              ,P3D=p_phy,PI3D=pi_phy                                &
+              ,RUBLTEN=rublten,RVBLTEN=rvblten                      &
+              ,RTHBLTEN=rthblten,RQVBLTEN=rqvblten                  &
+              ,RQCBLTEN=rqcblten,RQIBLTEN=rqiblten                  &
+              ,CP=cp,G=g,ROVCP=rcp,RD=r_D,ROVG=rovg                 &
+              ,DZ8W=dz8w,Z=z,XLV=XLV,RV=r_v,PSFC=PSFC               &
+              ,ZNT=znt,UST=ust,ZOL=zol,HOL=hol,HPBL=pblh            &
+              ,PSIM=psim,PSIH=psih,XLAND=xland                      &
+              ,HFX=hfx,QFX=qfx,TSK=tskold,GZ1OZ0=gz1oz0             &
+              ,WSPD=wspd,BR=br,DT=dtbl,DTMIN=dtmin,KPBL2D=kpbl      &
+              ,SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0            &
+              ,EP1=ep_1,EP2=ep_2,KARMAN=karman,EOMEG=eomeg          &
+              ,STBOLT=stbolt,EXCH_H=exch_h,REGIME=regime            &
+              ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde      &
+              ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme      &
+              ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte      &
+                                                                    )
+           ELSE
+               CALL wrf_error_fatal('Lack arguments to call YSU pbl')
+           ENDIF
+
+      CASE (MRFSCHEME)
+           IF ( PRESENT( qv_curr )  .AND. PRESENT( qc_curr )  .AND. &
+                PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. &
+                PRESENT( hol      )                           .AND. &
+                                                        .TRUE.  ) THEN
+
+             CALL wrf_debug(100,'in MRF')
+             CALL mrf(                                              &
+               U3D=u_phytmp,V3D=v_phytmp,TH3D=th_phy,T3D=t_phy      &
+              ,QV3D=qv_curr                                         &
+              ,QC3D=qc_curr                                         &
+              ,QI3D=qi_curr                                         &
+              ,P3D=p_phy,PI3D=pi_phy                                &
+              ,RUBLTEN=rublten,RVBLTEN=rvblten                      &
+              ,RTHBLTEN=rthblten,RQVBLTEN=rqvblten                  &
+              ,RQCBLTEN=rqcblten,RQIBLTEN=rqiblten                  &
+              ,CP=cp,G=g,ROVCP=rcp,R=r_d,ROVG=rovg                  &
+              ,DZ8W=dz8w,Z=z,XLV=xlv,RV=r_v,PSFC=psfc               &
+              ,ZNT=znt,UST=ust,ZOL=zol,HOL=hol                      &
+              ,PBL=pblh,PSIM=psim,PSIH=psih                         &
+              ,XLAND=xland,HFX=hfx,QFX=qfx,TSK=tskold               &
+              ,GZ1OZ0=gz1oz0,WSPD=wspd,BR=br                        &
+              ,DT=dtbl,DTMIN=dtmin,KPBL2D=kpbl                      &
+              ,SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0            &
+              ,EP1=ep_1,EP2=ep_2,KARMAN=karman,EOMEG=eomeg          &
+              ,STBOLT=stbolt,REGIME=regime                          &
+              ,FLAG_QI=flag_qi                                      &
+              ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde      &
+              ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme      &
+              ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte      &
+                                                                    )
+           ELSE
+               CALL wrf_error_fatal('Lack arguments to call MRF pbl')
+           ENDIF
+
+      CASE (GFSSCHEME)
+           IF ( PRESENT( qv_curr )  .AND. PRESENT( qc_curr )  .AND. &
+                PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. &
+                                                        .TRUE.  ) THEN
+             CALL wrf_debug(100,'in GFS')
+             CALL bl_gfs(                                           &
+               U3D=u_phytmp,V3D=v_phytmp                            &
+              ,TH3D=th_phy,T3D=t_phy                                &
+              ,QV3D=qv_curr,QC3D=qc_curr,QI3D=qi_curr               &
+              ,P3D=p_phy,PI3D=pi_phy                                &
+              ,RUBLTEN=rublten,RVBLTEN=rvblten,RTHBLTEN=rthblten    &
+              ,RQVBLTEN=rqvblten,RQCBLTEN=rqcblten                  &
+              ,RQIBLTEN=rqiblten                                    &
+              ,CP=cp,G=g,ROVCP=rcp,R=r_d,ROVG=rovg,FLAG_QI=flag_qi  &
+              ,DZ8W=dz8w,z=z,PSFC=psfc                              &
+              ,UST=ust,PBL=pblh,PSIM=psim,PSIH=psih                 &
+              ,HFX=hfx,QFX=qfx,TSK=tskold,GZ1OZ0=gz1oz0             &
+              ,WSPD=wspd,BR=br                                      &
+              ,DT=dtbl,KPBL2D=kpbl,EP1=ep_1,KARMAN=karman           &
+              ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde      &
+              ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme      &
+              ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte      &
+                                                                    )
+           ELSE
+               CALL wrf_error_fatal('Lack arguments to call GFS pbl')
+           ENDIF
+
+      CASE (MYJPBLSCHEME)
+           IF ( PRESENT( qv_curr )  .AND. PRESENT( qc_curr )  .AND. &
+                PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. &
+                                                        .TRUE.  ) THEN
+
+             CALL wrf_debug(100,'in MYJPBL')
+             CALL myjpbl(                                           &
+               DT=dt,STEPBL=stepbl,HT=ht,DZ=dz8w                    &
+              ,PMID=p_phy,PINT=p8w,TH=th_phy,T=t_phy,EXNER=pi_phy   &
+              ,QV=qv_curr, CWM=qc_curr                               &
+              ,U=u_phy,V=v_phy,RHO=rho                              &
+              ,TSK=tsk,QSFC=qsfc,CHKLOWQ=chklowq,THZ0=thz0          &
+              ,QZ0=qz0,UZ0=uz0,VZ0=vz0                              &
+              ,LOWLYR=lowlyr                                        &
+              ,XLAND=xland,SICE=xice,SNOW=snow                      &
+              ,TKE_MYJ=tke_myj,EXCH_H=exch_h,USTAR=ust,ZNT=znt      &
+              ,EL_MYJ=el_myj,PBLH=pblh,KPBL=kpbl,CT=ct              &
+              ,AKHS=akhs,AKMS=akms,ELFLX=lh                         &
+              ,RUBLTEN=rublten,RVBLTEN=rvblten,RTHBLTEN=rthblten    &
+              ,RQVBLTEN=rqvblten,RQCBLTEN=rqcblten                  &
+              ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde      &
+              ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme      &
+              ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte      &
+                                                                    )
+           ELSE
+               CALL wrf_error_fatal('Lack arguments to call MYJ pbl')
+           ENDIF
+
+     CASE DEFAULT
+
+       WRITE( message , * ) 'The pbl option does not exist: bl_pbl_physics = ', bl_pbl_physics
+       CALL wrf_error_fatal ( message )
+
+   END SELECT pbl_select
+
+   ENDDO
+   !$OMP END PARALLEL DO
+
+   ENDIF
+!
+   END SUBROUTINE pbl_driver
+END MODULE module_pbl_driver
Index: trunk/WRF.COMMON/WRFV2/phys/module_physics_addtendc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_physics_addtendc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_physics_addtendc.F	(revision 2744)
@@ -0,0 +1,1079 @@
+!WRF:MODEL_LAYER: PHYSICS
+!
+! note: this module really belongs in the dyn_em directory since it is 
+!       specific only to the EM core. Leaving here for now, with an 
+!       #if ( EM_CORE == 1 ) directive. JM 20031201
+!
+
+!  This MODULE holds the routines which are used to perform updates of the
+!  model C-grid tendencies with physics A-grid tendencies
+!  The module consolidates code that was (up to v1.2) duplicated in 
+!  module_em and module_rk and in
+!  module_big_step_utilities.F and module_big_step_utilities_em.F
+
+!  This MODULE CONTAINS the following routines:
+!  update_phy_ten, phy_ra_ten, phy_bl_ten, phy_cu_ten, advance_ppt,
+!  add_a2a, add_a2c_u, and add_a2c_v
+
+
+MODULE module_physics_addtendc
+
+#if ( EM_CORE == 1 )
+
+   USE module_state_description
+   USE module_configure
+
+CONTAINS
+
+SUBROUTINE update_phy_ten(rt_tendf,ru_tendf,rv_tendf,moist_tendf,  &
+                      mu_tendf,                                    &
+                      RTHRATEN,RTHBLTEN,RTHCUTEN,RUBLTEN,RVBLTEN,  &
+                      RQVBLTEN,RQCBLTEN,RQIBLTEN,                  &
+                      RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN,&
+                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,   &
+                      RMUNDGDTEN,                                  &
+                      n_moist,config_flags,rk_step,                &
+                      ids, ide, jds, jde, kds, kde,                &
+                      ims, ime, jms, jme, kms, kme,                &
+                      its, ite, jts, jte, kts, kte                 )
+!-------------------------------------------------------------------
+   IMPLICIT NONE
+!-------------------------------------------------------------------
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde,   &
+                                   ims, ime, jms, jme, kms, kme,   &
+                                   its, ite, jts, jte, kts, kte,   &
+                                   n_moist,rk_step
+
+   REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) ::   &
+                                                         ru_tendf, &
+                                                         rv_tendf, &
+                                                         rt_tendf
+
+   REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) ::  mu_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),           &
+          INTENT(INOUT)     ::                        moist_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHRATEN, &
+                                                       RTHBLTEN, &
+                                                       RTHCUTEN, &
+                                                        RUBLTEN, &
+                                                        RVBLTEN, &
+                                                       RQVBLTEN, &
+                                                       RQCBLTEN, &
+                                                       RQIBLTEN, &
+                                                       RQVCUTEN, &
+                                                       RQCCUTEN, &
+                                                       RQRCUTEN, &
+                                                       RQICUTEN, &
+                                                       RQSCUTEN, &
+                                                     RTHNDGDTEN, &
+                                                     RQVNDGDTEN, &
+                                                      RUNDGDTEN, &
+                                                      RVNDGDTEN
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) :: RMUNDGDTEN
+!------------------------------------------------------------------
+
+!  set up loop bounds for this grid's boundary conditions
+
+
+   if (config_flags%ra_lw_physics .gt. 0 .or.                  &
+       config_flags%ra_sw_physics .gt. 0)                      &
+      CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN,          &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+
+!****MARS
+! - All the LMD physics packages provide one tendency in the WRF sense
+! - PBL was chosen for practical reasons (U+V+T)
+! - The tendencies are supposed to be A-gridded
+   if ( (config_flags%bl_pbl_physics .gt. 0)                   &
+        .OR. (config_flags%modif_wrf) )                        &
+      CALL phy_bl_ten(config_flags,rk_step,n_moist,            &
+                      rt_tendf,ru_tendf,rv_tendf,moist_tendf,  &
+                      RTHBLTEN,RUBLTEN,RVBLTEN,                &
+                      RQVBLTEN,RQCBLTEN,RQIBLTEN,              &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+   if (config_flags%cu_physics .gt. 0)                         &
+      CALL phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf,   &
+                      RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,     &
+                      RQICUTEN,RQSCUTEN,moist_tendf,           &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+   if (config_flags%grid_fdda .gt. 0)                          &
+      CALL phy_fg_ten(config_flags,rk_step,n_moist,            &
+                      rt_tendf,ru_tendf,rv_tendf,              &
+                      mu_tendf, moist_tendf,                   &
+                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
+                      RQVNDGDTEN,RMUNDGDTEN,                   &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+END SUBROUTINE update_phy_ten
+
+!=================================================================
+SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN,            &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHRATEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
+                                                       rt_tendf
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k
+
+   CALL add_a2a(rt_tendf,RTHRATEN,config_flags,                  &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+END SUBROUTINE phy_ra_ten
+
+!=================================================================
+SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,             &
+                      rt_tendf,ru_tendf,rv_tendf,moist_tendf,    &
+                      RTHBLTEN,RUBLTEN,RVBLTEN,                  & 
+                      RQVBLTEN,RQCBLTEN,RQIBLTEN,                &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   n_moist, rk_step
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
+          INTENT(INOUT)     ::                      moist_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   & 
+                                                       RTHBLTEN, &
+                                                        RUBLTEN, &
+                                                        RVBLTEN, &
+                                                       RQVBLTEN, &
+                                                       RQCBLTEN, &
+                                                       RQIBLTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
+                                                       rt_tendf, &
+                                                       ru_tendf, &
+                                                       rv_tendf
+! LOCAL VARS
+
+   INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
+
+!-----------------------------------------------------------------
+
+
+!****MARS
+!****MARS
+!update with LMD physics tendencies
+if (config_flags%modif_wrf) then
+CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+     ids,ide, jds, jde, kds, kde,                     &
+     ims, ime, jms, jme, kms, kme,                    &
+     its, ite, jts, jte, kts, kte                     )
+CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+     ids,ide, jds, jde, kds, kde,                     &
+     ims, ime, jms, jme, kms, kme,                    &
+     its, ite, jts, jte, kts, kte                     )
+CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+     ids,ide, jds, jde, kds, kde,                     &
+     ims, ime, jms, jme, kms, kme,                    &
+     its, ite, jts, jte, kts, kte                     )
+endif
+!****MARS
+!****MARS    
+
+
+   SELECT CASE(config_flags%bl_pbl_physics)
+
+      CASE (YSUSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+      CASE (MRFSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+      CASE (MYJPBLSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+      CASE (GFSSCHEME)
+                                                                                                                                        
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+      CASE DEFAULT
+
+       !print*,'phy_bl_ten: The pbl scheme does not exist'
+
+   END SELECT
+
+END SUBROUTINE phy_bl_ten
+
+!=================================================================
+SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf,    &
+                      RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,       &
+                      RQICUTEN,RQSCUTEN,moist_tendf,             &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   n_moist, rk_step
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
+          INTENT(INOUT)     ::                      moist_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHCUTEN, &
+                                                       RQVCUTEN, &
+                                                       RQCCUTEN, &
+                                                       RQRCUTEN, &
+                                                       RQICUTEN, &
+                                                       RQSCUTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
+                                                       rt_tendf
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k
+
+   SELECT CASE (config_flags%cu_physics)   
+
+   CASE (KFSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (BMJSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,                          &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (KFETASCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (GDSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (SASSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+          
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+          
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE DEFAULT
+
+   END SELECT
+
+END SUBROUTINE phy_cu_ten
+
+!=================================================================
+SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist,            &
+                      rt_tendf,ru_tendf,rv_tendf,              &
+                      mu_tendf, moist_tendf,                   &
+                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
+                      RQVNDGDTEN,RMUNDGDTEN,                   &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   n_moist, rk_step
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
+          INTENT(INOUT)     ::                      moist_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHNDGDTEN, &
+                                                        RUNDGDTEN, &
+                                                        RVNDGDTEN, &
+                                                       RQVNDGDTEN
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) ::  RMUNDGDTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
+                                                       rt_tendf, &
+                                                       ru_tendf, &
+                                                       rv_tendf
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT)::  mu_tendf
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
+
+!-----------------------------------------------------------------
+
+   SELECT CASE(config_flags%grid_fdda)
+
+      CASE (PSUFDDAGD)
+
+           CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags,        &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+! note fdda u and v tendencies are staggered
+           CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags,       &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags,       &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags,      &
+                ids,ide, jds, jde, kds, kds,                     &
+                ims, ime, jms, jme, kms, kms,                    &
+                its, ite, jts, jte, kts, kts                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+
+      CASE DEFAULT
+
+   END SELECT
+
+END SUBROUTINE phy_fg_ten
+
+!----------------------------------------------------------------------
+SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,           &
+                     RQICUTEN,RQSCUTEN,RAINC,RAINCV,NCA,              &
+                     HTOP,HBOT,CUTOP,CUBOT,                           &
+                     CUPPT, config_flags,                             &
+                     ids,ide, jds,jde, kds,kde,                       &
+                     ims,ime, jms,jme, kms,kme,                       &
+                     its,ite, jts,jte, kts,kte                        )     
+!----------------------------------------------------------------------
+   USE module_state_description
+
+!!!******MARS MARS
+!!!******MARS MARS
+!!!******MARS MARS
+
+!   USE module_cu_kf
+!   USE module_cu_kfeta
+!----------------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------------
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER,      INTENT(IN   )    ::                             &
+                                      ids,ide, jds,jde, kds,kde, &
+                                      ims,ime, jms,jme, kms,kme, &
+                                      its,ite, jts,jte, kts,kte
+
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         INTENT(INOUT)  ::                             RTHCUTEN, &
+                                                       RQVCUTEN, &
+                                                       RQCCUTEN, &
+                                                       RQRCUTEN, &
+                                                       RQICUTEN, &
+                                                       RQSCUTEN
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                         &
+          INTENT(INOUT) ::                                RAINC, &
+                                                         RAINCV, &
+                                                            NCA, &
+                                                           HTOP, &
+                                                           HBOT, &
+                                                          CUTOP, &
+                                                          CUBOT, &
+                                                          CUPPT
+
+! LOCAL  VAR
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
+   INTEGER :: NCUTOP, NCUBOT
+
+!-----------------------------------------------------------------
+
+   IF (config_flags%cu_physics .eq. 0) return
+
+! SET START AND END POINTS FOR TILES
+
+   i_start = its
+   i_end   = min( ite,ide-1 )
+   j_start = jts
+   j_end   = min( jte,jde-1 )
+!
+!  IF( config_flags%nested .or. config_flags%specified ) THEN
+!    i_start = max( its,ids+1 )
+!    i_end   = min( ite,ide-2 )
+!    j_start = max( jts,jds+1 )
+!    j_end   = min( jte,jde-2 )
+!  ENDIF
+!
+   k_start = kts
+   k_end = min( kte, kde-1 )
+
+! Update total cumulus scheme precipitation
+
+! in mm  
+
+   DO J = j_start,j_end
+   DO i = i_start,i_end
+      RAINC(I,J)=RAINC(I,J)+RAINCV(I,J)
+      CUPPT(I,J)=CUPPT(I,J)+RAINCV(I,J)/1000.
+   ENDDO
+   ENDDO
+
+   SELECT CASE (config_flags%cu_physics)
+
+   CASE (KFSCHEME)
+
+        DO J = j_start,j_end
+        DO i = i_start,i_end
+
+           IF ( NINT(NCA(I,J)).GT. 0 ) THEN
+
+              IF ( NINT(NCA(I,J)) .eq. 1 ) THEN
+
+              ! set tendency to zero
+                 RAINCV(I,J)=0.
+                 DO k = k_start,k_end
+                    RTHCUTEN(i,k,j)=0.
+                    RQVCUTEN(i,k,j)=0.
+                    RQCCUTEN(i,k,j)=0.
+                    RQRCUTEN(i,k,j)=0.
+                    if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
+                    if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
+                 ENDDO
+              ENDIF
+
+              NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
+
+           ENDIF
+!
+        ENDDO
+        ENDDO
+
+   CASE (BMJSCHEME)
+ 
+        DO J = j_start,j_end
+        DO i = i_start,i_end
+
+! HTOP, HBOT FOR GFDL RADIATION
+           NCUTOP=NINT(CUTOP(I,J))
+           NCUBOT=NINT(CUBOT(I,J))
+           IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
+             HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
+           ENDIF
+           IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
+             HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
+           ENDIF
+
+        ENDDO
+        ENDDO
+
+   CASE (KFETASCHEME)
+
+        DO J = j_start,j_end
+        DO i = i_start,i_end
+
+! HTOP, HBOT FOR GFDL RADIATION
+           NCUTOP=NINT(CUTOP(I,J))
+           NCUBOT=NINT(CUBOT(I,J))
+           IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
+             HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
+           ENDIF
+           IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
+             HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
+           ENDIF
+
+           IF ( NINT(NCA(I,J)).GT. 0 ) THEN
+
+              IF ( NINT(NCA(I,J)) .eq. 1 ) THEN
+
+              ! set tendency to zero
+                 RAINCV(I,J)=0.
+                 DO k = k_start,k_end
+                    RTHCUTEN(i,k,j)=0.
+                    RQVCUTEN(i,k,j)=0.
+                    RQCCUTEN(i,k,j)=0.
+                    RQRCUTEN(i,k,j)=0.
+                    if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
+                    if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
+                 ENDDO
+              ENDIF
+
+              NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
+
+           ENDIF
+!
+        ENDDO
+        ENDDO
+
+   CASE DEFAULT
+
+   END SELECT
+
+END SUBROUTINE advance_ppt
+
+SUBROUTINE add_a2a(lvar,rvar,config_flags,                  &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+   TYPE(grid_config_rec_type),  INTENT(IN) :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+   ktf = min(kte,kde-1)
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+   DO j = j_start,j_end
+   DO k = kts,ktf
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_a2a
+
+!------------------------------------------------------------
+SUBROUTINE add_a2c_u(lvar,rvar,config_flags,                &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   ktf=min(kte,kde-1)
+
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+   DO j = j_start,j_end
+   DO k = kts,ktf
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + &
+                       0.5*(rvar(i,k,j)+rvar(i-1,k,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_a2c_u
+
+!------------------------------------------------------------
+SUBROUTINE add_a2c_v(lvar,rvar,config_flags,                &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   ktf=min(kte,kde-1)
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+   DO j = j_start,j_end
+   DO k = kts,kte
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + &
+                     0.5*(rvar(i,k,j)+rvar(i,k,j-1))
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_a2c_v
+
+!------------------------------------------------------------
+SUBROUTINE add_c2c_u(lvar,rvar,config_flags,                &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   ktf=min(kte,kde-1)
+
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+
+!  write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
+
+   DO j = j_start,j_end
+   DO k = kts,ktf
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_c2c_u
+
+SUBROUTINE add_c2c_v(lvar,rvar,config_flags,                &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   ktf=min(kte,kde-1)
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+
+!  write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
+
+   DO j = j_start,j_end
+   DO k = kts,kte
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_c2c_v
+
+#endif
+
+END MODULE module_physics_addtendc
Index: trunk/WRF.COMMON/WRFV2/phys/module_physics_init.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_physics_init.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_physics_init.F	(revision 2744)
@@ -0,0 +1,1654 @@
+!WRF:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform model start-up operations
+!  for the individual domains.  This is the stage after inputting wrfinput and before
+!  calling 'integrate'.
+
+!  This MODULE CONTAINS the following routines:
+
+
+MODULE module_physics_init
+
+!  USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+!  USE module_timing
+   USE module_configure
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+CONTAINS
+
+
+!=================================================================
+   SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
+                         p_top, TSK,RADT,BLDT,CUDT,MPDT,         &
+                         RTHCUTEN, RQVCUTEN, RQRCUTEN,           &
+                         RQCCUTEN, RQSCUTEN, RQICUTEN,           &
+                         RUBLTEN,RVBLTEN,RTHBLTEN,               &
+                         RQVBLTEN,RQCBLTEN,RQIBLTEN,             &
+                         RTHRATEN,RTHRATENLW,RTHRATENSW,         &
+                         STEPBL,STEPRA,STEPCU,                   &
+                         W0AVG, RAINNC, RAINC, RAINCV, RAINNCV,  &
+                         NCA,swrad_scat,                         &
+                         CLDEFI,LOWLYR,                          &
+                         MASS_FLUX,                              &
+                         RTHFTEN, RQVFTEN,                       &
+                         CLDFRA,GLW,GSW,EMISS,LU_INDEX,          &
+                         landuse_ISICE, landuse_LUCATS,          &
+                         landuse_LUSEAS, landuse_ISN,            &
+                         lu_state,                               &
+                         XLAT,XLONG,ALBEDO,ALBBCK,GMT,JULYR,JULDAY,&
+                         levsiz, n_ozmixm, n_aerosolc, paerlev,  &
+                         TMN,XLAND,ZNT,Z0,UST,MOL,PBLH,TKE_MYJ,  &
+                         EXCH_H,THC,SNOWC,MAVAIL,HFX,QFX,RAINBL, &
+                         TSLB,ZS,DZS,num_soil_layers,warm_rain,  & 
+                         adv_moist_cond,                         &
+                         APR_GR,APR_W,APR_MC,APR_ST,APR_AS,      &
+                         APR_CAPMA,APR_CAPME,APR_CAPMI,          &
+                         XICE,VEGFRA,SNOW,CANWAT,SMSTAV,         &
+                         SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW,&
+                         ACSNOM,IVGTYP,ISLTYP, SFCEVP, SMOIS,    &
+                         SH2O, SNOWH, SMFR3D,                    &  ! temporary
+                         DX,DY,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, &
+                         mp_restart_state,tbpvs_state,tbpvs0_state,&
+                         allowed_to_read, moved, start_of_simulation,&
+                         ids, ide, jds, jde, kds, kde,           &
+                         ims, ime, jms, jme, kms, kme,           &
+                         its, ite, jts, jte, kts, kte,           &
+                         ozmixm,pin,                             &    ! Optional
+                         m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& ! Optional
+                         RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,         &    ! Optional
+                         RQVNDGDTEN,RMUNDGDTEN,                  &    ! Optional
+                         FGDT,STEPFG,                            &    ! Optional
+!                        num_roof_layers,num_wall_layers,        & !Optional urban
+!                        num_road_layers,                        & !Optional urban
+                         DZR, DZB, DZG,                          & !Optional urban
+                         TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,    & !Optional urban
+                         QC_URB2D, XXXR_URB2D,XXXB_URB2D,        & !Optional urban
+                         XXXG_URB2D, XXXC_URB2D,                 & !Optional urban
+                         TRL_URB3D, TBL_URB3D, TGL_URB3D,        & !Optional urban
+                         SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D,  & !Optional urban
+                         TS_URB2D, FRC_URB2D, UTYPE_URB2D,       & !Optional urban
+                         itimestep                              & !Optional obs fdda
+#if ( EM_CORE == 1 )
+                         ,fdob                                   & !Optional obs fdda
+#endif
+                         )
+
+!-----------------------------------------------------------------
+   USE module_domain
+   USE module_wrf_error
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   INTEGER , INTENT(IN)        :: id
+   LOGICAL , INTENT(OUT)       :: warm_rain,adv_moist_cond
+!   LOGICAL , INTENT (IN)       :: FNDSOILW, FNDSNOWH
+   LOGICAL, PARAMETER          :: FNDSOILW=.true., FNDSNOWH=.true.
+   INTEGER , INTENT(IN)        :: ids, ide, jds, jde, kds, kde,  &
+                                  ims, ime, jms, jme, kms, kme,  &
+                                  its, ite, jts, jte, kts, kte
+
+   INTEGER , INTENT(IN)        :: num_soil_layers
+
+   LOGICAL,  INTENT(IN)        :: start_of_simulation
+   REAL,     INTENT(IN)        :: DT, p_top, DX, DY
+   LOGICAL,  INTENT(IN)        :: restart
+   REAL,     INTENT(IN)        :: RADT,BLDT,CUDT,MPDT
+   REAL,     INTENT(IN)        :: swrad_scat
+
+   REAL,     DIMENSION( kms:kme ) , INTENT(IN) :: zfull, zhalf
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: TSK, XLAT, XLONG
+
+   INTEGER,      INTENT(IN   )    ::   levsiz, n_ozmixm
+   INTEGER,      INTENT(IN   )    ::   paerlev, n_aerosolc
+
+   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL, &
+          INTENT(INOUT) ::                                  OZMIXM
+
+   REAL,  DIMENSION(levsiz), OPTIONAL, INTENT(INOUT)  ::        PIN
+
+   REAL,  DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT)  :: m_ps_1,m_ps_2
+   REAL,  DIMENSION(paerlev), OPTIONAL,INTENT(INOUT)  ::          m_hybi
+   REAL,  DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, &
+          INTENT(INOUT) ::                    aerosolc_1, aerosolc_2
+
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),&
+                 INTENT(INOUT) :: SMOIS, SH2O,TSLB
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), INTENT(OUT) :: SMFR3D
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                           SNOW, &
+                                                         SNOWC, &
+                                                         SNOWH, &
+                                                        CANWAT, &
+                                                        SMSTAV, &
+                                                        SMSTOT, &
+                                                     SFCRUNOFF, &
+                                                      UDRUNOFF, &
+                                                        SFCEVP, &
+                                                        GRDFLX, &
+                                                        ACSNOW, &
+                                                          XICE, &
+                                                        VEGFRA, &
+                                                        ACSNOM
+
+   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                         IVGTYP, &
+                                                        ISLTYP
+
+! rad
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+             RTHRATEN, RTHRATENLW, RTHRATENSW, CLDFRA
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) ::         &
+             GSW,ALBEDO,ALBBCK,GLW,EMISS
+
+   REAL,     INTENT(IN) :: GMT
+
+   INTEGER , INTENT(OUT) :: STEPRA, STEPBL, STEPCU
+   INTEGER , INTENT(IN) :: JULYR, JULDAY
+
+! cps
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+             RTHCUTEN, RQVCUTEN, RQRCUTEN, RQCCUTEN, RQSCUTEN,   &
+             RQICUTEN
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: MASS_FLUX,   &
+                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+                      APR_CAPMA,APR_CAPME,APR_CAPMI
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+             RTHFTEN, RQVFTEN
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) ::           &
+             RAINNC, RAINC, RAINCV, RAINNCV
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: CLDEFI, NCA
+
+   INTEGER,  DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: LOWLYR
+
+!pbl
+
+   ! soil layer
+
+
+   REAL,     DIMENSION(1:num_soil_layers),      INTENT(INOUT) :: ZS,DZS
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+             RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN,RQIBLTEN,EXCH_H,TKE_MYJ
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) ::         &
+             XLAND,ZNT,Z0,UST,MOL,LU_INDEX,                         &
+             PBLH,THC,MAVAIL,HFX,QFX,RAINBL
+   INTEGER , INTENT(INOUT)  :: landuse_ISICE, landuse_LUCATS
+   INTEGER , INTENT(INOUT)  :: landuse_LUSEAS, landuse_ISN
+   REAL    , INTENT(INOUT)  , DIMENSION( : ) :: lu_state
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: TMN
+
+!mp
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::   &
+             F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
+   REAL, DIMENSION(:), INTENT(INOUT)   :: mp_restart_state,tbpvs_state,tbpvs0_state
+   LOGICAL,  INTENT(IN)  :: allowed_to_read, moved
+
+!fdda
+   REAL,     OPTIONAL, INTENT(IN) :: FGDT
+   INTEGER , OPTIONAL, INTENT(OUT) :: STEPFG
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) ::    &
+             RUNDGDTEN, RVNDGDTEN, RTHNDGDTEN, RQVNDGDTEN
+   REAL,     DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(OUT) ::    &
+             RMUNDGDTEN
+
+!URBAN
+!   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR   !urban
+!   REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB   !urban
+!   REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG   !urban
+   REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR    !urban
+   REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB    !urban
+   REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG    !urban
+
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !urban
+
+!   REAL, DIMENSION(ims:ime, 1:num_roof_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D !urban
+!   REAL, DIMENSION(ims:ime, 1:num_wall_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D !urban
+!   REAL, DIMENSION(ims:ime, 1:num_road_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D !urban
+   REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D  !urban
+   REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D  !urban
+   REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D  !urban
+
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !urban
+   INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !urban
+
+!obs fdda
+   INTEGER, OPTIONAL, INTENT(IN) :: itimestep
+#if ( EM_CORE == 1 ) 
+   TYPE(fdob_type), OPTIONAL, INTENT(INOUT) :: fdob
+#endif
+
+! Local data
+
+   REAL    :: ALBLND,ZZLND,ZZWTR,THINLD,XMAVA,CEN_LAT,pptop 
+   REAL,     DIMENSION( kms:kme )  :: sfull, shalf
+   REAL :: obs_twindo
+   
+   CHARACTER*4 :: MMINLU_loc
+   CHARACTER*80 :: message
+   INTEGER :: ISWATER
+   INTEGER :: ucmcall
+! to be added to namelist: option to use climatological monthly albedo
+   LOGICAL :: usebgalb
+
+   INTEGER :: i, j, itf, jtf
+integer myproc
+
+!-----------------------------------------------------------------
+   ucmcall=config_flags%ucmcall
+#if ( EM_CORE == 1 ) 
+   obs_twindo=config_flags%obs_twindo
+#endif
+
+!-- should be from the namelist
+
+   sfull = 0.
+   shalf = 0.
+
+   CALL wrf_debug(100,'top of phy_init')
+
+   WRITE(wrf_err_message,*) 'phy_init:  start_of_simulation = ',start_of_simulation
+   CALL wrf_debug ( 100, TRIM(wrf_err_message) )
+
+   itf=min0(ite,ide-1)
+   jtf=min0(jte,jde-1)
+
+   ZZLND=0.1
+   ZZWTR=0.0001
+   THINLD=0.04
+   ALBLND=0.2
+   XMAVA=0.3
+   usebgalb = .FALSE.
+
+   CALL nl_get_cen_lat(id,cen_lat)
+   CALL wrf_debug(100,'calling nl_get_iswater, nl_get_mminlu_loc')
+   CALL nl_get_iswater(id,iswater)
+   CALL nl_get_mminlu( 1, mminlu_loc )
+   CALL wrf_debug(100,'after nl_get_iswater, nl_get_mminlu_loc')
+
+  IF(.not.restart)THEN
+!-- initialize common variables
+
+   IF ( .NOT. moved ) THEN
+   DO j=jts,jtf
+   DO i=its,itf
+      XLAND(i,j)=1.
+      GSW(i,j)=0.
+      GLW(i,j)=0.
+      UST(i,j)=0.
+      MOL(i,j)=0.0
+      PBLH(i,j)=0.0
+      HFX(i,j)=0.
+      QFX(i,j)=0.
+      RAINBL(i,j)=0.
+      RAINNCV(i,j)=0.
+      ACSNOW(i,j)=0.
+   ENDDO
+   ENDDO
+   ENDIF
+
+!
+   DO j=jts,jtf
+   DO i=its,itf
+     IF(XLAND(i,j) .LT. 1.5)THEN
+       IF(mminlu_loc .EQ. '    ') ALBBCK(i,j)=ALBLND
+       ALBEDO(i,j)=ALBBCK(i,j)
+       EMISS(i,j)=0.85
+       THC(i,j)=THINLD
+       ZNT(i,j)=ZZLND
+#if  ! ( NMM_CORE == 1 ) 
+       Z0(i,j)=ZZLND
+#endif
+       MAVAIL(i,j)=XMAVA
+     ELSE
+       IF(mminlu_loc .EQ. '    ') ALBBCK(i,j)=0.08
+       ALBEDO(i,j)=ALBBCK(i,j)
+       EMISS(i,j)=0.98
+       THC(i,j)=THINLD
+       ZNT(i,j)=ZZWTR
+#if  ! ( NMM_CORE == 1 ) 
+       Z0(i,j)=ZZWTR
+#endif
+       MAVAIL(i,j)=1.0 
+     ENDIF
+
+   ENDDO
+   ENDDO
+
+   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to landuse_init' )
+
+!!!******MARS MARS : no use of LANDUSE values
+!   IF(mminlu_loc .ne. '    ')THEN
+!!-- initialize surface properties
+!
+!     CALL landuse_init(lu_index, snowc, albedo, albbck, mavail, emiss,      &
+!                znt, Z0, thc, xland, xice, julday, cen_lat, iswater, mminlu_loc,  &
+!                landuse_ISICE, landuse_LUCATS,                      &
+!                landuse_LUSEAS, landuse_ISN,                        &
+!                lu_state,                                           &
+!                allowed_to_read , usebgalb ,                        &
+!                ids, ide, jds, jde, kds, kde,                       &
+!                ims, ime, jms, jme, kms, kme,                       &
+!                its, ite, jts, jte, kts, kte                       ) 
+!   ENDIF
+!!!******MARS MARS : no use of LANDUSE values
+
+  ENDIF
+
+!-- convert zfull and zhalf to sigma values for ra_init (Eta CO2 needs these)
+!-- zfull/zhalf may be either zeta or eta
+!-- what is done here depends on coordinate (check this code if adding new coordinates)
+   CALL z2sigma(zfull,zhalf,sfull,shalf,p_top,pptop,config_flags, &
+                allowed_to_read,                                  &
+                kds,kde,kms,kme,kts,kte)
+
+!!!******MARS MARS
+!!!******MARS MARS
+!!!******MARS MARS
+
+!!-- initialize physics
+!!-- ra: radiation
+!!-- bl: pbl
+!!-- cu: cumulus
+!!-- mp: microphysics
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to ra_init' )
+!
+!   CALL ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,             &
+!                RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT,    &
+!                levsiz,XLAT,n_ozmixm,                           &
+!                ozmixm,pin,                                     & ! Optional
+!                m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,     & ! Optional
+!                paerlev,n_aerosolc,                             &
+!                sfull,shalf,pptop,swrad_scat,                   &
+!                config_flags,restart,                           & 
+!                allowed_to_read, start_of_simulation,           &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to bl_init' )
+!
+!   CALL bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,        &
+!                RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN,             &
+!                config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS,    &
+!                num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA,          &
+!                SNOW,SNOWC, CANWAT,SMSTAV,                      &
+!                SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM,       &
+!                IVGTYP,ISLTYP,SMOIS,SMFR3D,MAVAIL,              &
+!                SNOWH,SH2O,FNDSOILW, FNDSNOWH,                  &
+!#if (NMM_CORE == 1)
+!                Z0,XLAND,XICE,                                  &
+!#else
+!                ZNT,XLAND,XICE,                                 &
+!#endif
+!                SFCEVP,GRDFLX,                                  &
+!                allowed_to_read ,                               &
+!                DZR, DZB, DZG,                                  & !Optional urban
+!                TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D,   & !Optional urban
+!                XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,    & !Optional urban
+!                TRL_URB3D, TBL_URB3D, TGL_URB3D,                & !Optional urban
+!                SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D,          & !Optional urban
+!                TS_URB2D, FRC_URB2D, UTYPE_URB2D, UCMCALL,      & !Optional urban
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to cu_init' )
+!
+!   CALL cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN,      &
+!                RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC,           &
+!                RAINCV,W0AVG,config_flags,restart,              &
+!                CLDEFI,LOWLYR,MASS_FLUX,                        &
+!                RTHFTEN, RQVFTEN,                               &
+!                APR_GR,APR_W,APR_MC,APR_ST,APR_AS,              &
+!                APR_CAPMA,APR_CAPME,APR_CAPMI,                  &
+!                allowed_to_read, start_of_simulation,           &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to mp_init' )
+!
+!   CALL mp_init(RAINNC,config_flags,restart,warm_rain,          &
+!                adv_moist_cond,                                 &
+!                MPDT, DT, DX, DY, LOWLYR,                       & 
+!                F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,               &
+!                mp_restart_state,tbpvs_state,tbpvs0_state,      &
+!                allowed_to_read, start_of_simulation,           &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!   write(message,*)'STEPRA,STEPCU,STEPBL',STEPRA,STEPCU,STEPBL
+!   CALL wrf_message( message )
+!
+!#if  ( EM_CORE == 1 )
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fg_init' )
+!
+!   CALL fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN,          &
+!                RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,               &
+!                config_flags,restart,                           &
+!                allowed_to_read ,                               &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fdob_init' )
+!
+!   CALL fdob_init(model_config_rec%obs_nudge_opt,               &
+!                  model_config_rec%max_dom,                     &
+!                  id,                                           &
+!                  model_config_rec%parent_id,                   &
+!                  model_config_rec%dx(1),                       &
+!                  config_flags%restart,                         &
+!                  obs_twindo,                                   &
+!                  itimestep,                                    &
+!                  model_config_rec%s_sn(1),                     &
+!                  model_config_rec%e_sn(1),                     &
+!                  model_config_rec%s_we(1),                     &
+!                  model_config_rec%e_we(1),                     &
+!                  fdob,                                         &
+!                  ids, ide, jds, jde, kds, kde,                 &
+!                  ims, ime, jms, jme, kms, kme,                 &
+!                  its, ite, jts, jte, kts, kte                  )
+!
+!#endif
+
+   END SUBROUTINE phy_init
+
+!=====================================================================
+   SUBROUTINE landuse_init(lu_index, snowc, albedo, albbck, mavail, emiss,  &
+                znt,Z0,thc,xland, xice, julday, cen_lat, iswater, mminlu, &
+                ISICE, LUCATS, LUSEAS, ISN,                         &
+                lu_state,                                           &
+                allowed_to_read , usebgalb ,                        &
+                ids, ide, jds, jde, kds, kde,                       &
+                ims, ime, jms, jme, kms, kme,                       &
+                its, ite, jts, jte, kts, kte                       )
+
+   USE module_wrf_error
+   IMPLICIT NONE
+
+!---------------------------------------------------------------------
+   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,   &
+                                     ims, ime, jms, jme, kms, kme,   &
+                                     its, ite, jts, jte, kts, kte
+
+   INTEGER , INTENT(IN)           :: iswater, julday
+   REAL    , INTENT(IN)           :: cen_lat
+   CHARACTER*4, INTENT(IN)        :: mminlu
+   LOGICAL,  INTENT(IN)           :: allowed_to_read , usebgalb
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: lu_index, snowc, xice
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT  ) :: albedo, albbck, mavail, emiss, &
+                                                               znt, Z0, thc, xland
+   INTEGER , INTENT(INOUT)  :: ISICE, LUCATS, LUSEAS, ISN
+   REAL    , INTENT(INOUT)  , DIMENSION( : ) :: lu_state
+
+!---------------------------------------------------------------------
+! Local
+   CHARACTER*4 LUTYPE
+   CHARACTER*80 :: message
+   INTEGER  :: landuse_unit, LS, LC, LI, LUN, NSN
+   INTEGER  :: i, j, itf, jtf, is, cats, seas, curs
+   INTEGER , PARAMETER :: OPEN_OK = 0
+   INTEGER :: ierr
+   INTEGER , PARAMETER :: max_cats = 100 , max_seas = 12 
+   REAL    , DIMENSION( max_cats, max_seas ) :: ALBD, SLMO, SFEM, SFZ0, THERIN, SFHC
+   REAL    , DIMENSION( max_cats )     :: SCFX
+! save these fields in case nest moves or has to be reinitialized
+! and this routine is called with allowed_to_read set to false
+! note that by saving these, we're locking in the same landuse for
+! the duration of a run; possible implications for long climate runs
+   LOGICAL :: found_lu, end_of_file
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+!---------------------------------------------------------------------
+
+   CALL wrf_debug( 100 , 'top of landuse_init' )
+
+   NSN=-1  ! set this to suppress uninitalized data messages from tools
+
+! recover LU variables from state
+   IF ( 6*(max_cats*max_seas)+1*max_cats .GT. 7501 ) THEN
+      WRITE(message,*)'landuse_init: lu_state overflow. Make Registry dimspec p > ',6*(max_cats*max_seas)+1*max_cats
+   ENDIF
+   curs = 1
+   DO cats = 1, max_cats
+     SCFX(cats) =           lu_state(curs)         ; curs = curs + 1
+     DO seas = 1, max_seas
+       ALBD(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SLMO(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SFEM(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SFZ0(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SFHC(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       THERIN(cats,seas) =  lu_state(curs)         ; curs = curs + 1
+     ENDDO
+   ENDDO
+
+! Determine season (summer=1, winter=2)
+   ISN=1                                                            
+   IF(JULDAY.LT.105.OR.JULDAY.GT.288)ISN=2                         
+   IF(CEN_LAT.LT.0.0)ISN=3-ISN                                   
+
+   FOUND_LU = .TRUE.
+   IF ( allowed_to_read ) THEN
+      landuse_unit = 29
+      IF ( wrf_dm_on_monitor() ) THEN
+        OPEN(landuse_unit, FILE='LANDUSE.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
+        IF ( ierr .NE. OPEN_OK ) THEN
+          WRITE(message,FMT='(A)') &
+          'module_physics_init.F: LANDUSE_INIT: open failure for LANDUSE.TBL'
+          CALL wrf_error_fatal ( message ) 
+        END IF
+      ENDIF
+
+! Read info from file LANDUSE.TBL
+      IF(MMINLU.EQ.'OLD ')THEN
+!       ISWATER=7
+        ISICE=11 
+      ELSE IF(MMINLU.EQ.'USGS')THEN
+!       ISWATER=16
+        ISICE=24
+      ELSE IF(MMINLU.EQ.'SiB ')THEN
+!       ISWATER=15
+        ISICE=16
+      ELSE IF(MMINLU.EQ.'LW12')THEN
+!       ISWATER=15
+        ISICE=3
+      ENDIF
+      PRINT *, 'INPUT LANDUSE = ',MMINLU
+      FOUND_LU = .FALSE.
+      end_of_file = .FALSE.
+!!! BEGINNING OF 1999 LOOP
+ 1999 CONTINUE                                                      
+      IF ( wrf_dm_on_monitor() ) THEN
+        READ (landuse_unit,2000,END=2002)LUTYPE                                
+        GOTO 2003
+ 2002   CONTINUE
+        CALL wrf_message( 'INPUT FILE FOR LANDUSE REACHED END OF FILE' )
+        end_of_file = .TRUE.
+ 2003   CONTINUE
+        IF ( .NOT. end_of_file ) READ (landuse_unit,*)LUCATS,LUSEAS                                    
+        FOUND_LU = LUTYPE.EQ.MMINLU
+      ENDIF
+      CALL wrf_dm_bcast_bytes (end_of_file, LWORDSIZE )
+      IF ( .NOT. end_of_file ) THEN
+        CALL wrf_dm_bcast_string(lutype, 4)
+        CALL wrf_dm_bcast_bytes (lucats,  IWORDSIZE )
+        CALL wrf_dm_bcast_bytes (luseas,  IWORDSIZE )
+        CALL wrf_dm_bcast_bytes (found_lu,  LWORDSIZE )
+ 2000   FORMAT (A4)                                                
+        IF(FOUND_LU)THEN                                  
+          LUN=LUCATS                                             
+          NSN=LUSEAS                                            
+            PRINT *, 'LANDUSE TYPE = ',LUTYPE,' FOUND',        &
+                   LUCATS,' CATEGORIES',LUSEAS,' SEASONS',     &
+                   ' WATER CATEGORY = ',ISWATER,               &
+                   ' SNOW CATEGORY = ',ISICE                
+        ENDIF                                             
+        DO ls=1,luseas                                   
+          if ( wrf_dm_on_monitor() ) then
+            READ (landuse_unit,*)                                   
+          endif
+          DO LC=1,LUCATS                               
+            IF(found_lu)THEN                  
+              IF ( wrf_dm_on_monitor() ) THEN
+                READ (landuse_unit,*)LI,ALBD(LC,LS),SLMO(LC,LS),SFEM(LC,LS),        &       
+                           SFZ0(LC,LS),THERIN(LC,LS),SCFX(LC),SFHC(LC,LS)       
+              ENDIF
+              CALL wrf_dm_bcast_bytes (LI,  IWORDSIZE )
+              IF(LC.NE.LI)CALL wrf_error_fatal ( 'module_start: MISSING LANDUSE UNIT ' )
+            ELSE                                                            
+              IF ( wrf_dm_on_monitor() ) THEN
+                READ (landuse_unit,*)                                                  
+              ENDIF
+            ENDIF                                                         
+          ENDDO                                                          
+        ENDDO                                                           
+        IF(NSN.EQ.1.AND.FOUND_LU) THEN
+           ISN = 1
+        END IF
+        CALL wrf_dm_bcast_bytes (albd,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (slmo,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (sfem,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (sfz0,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (therin, max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (sfhc,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (scfx,   max_cats *            RWORDSIZE )
+      ENDIF
+
+      IF(.NOT. found_lu .AND. .NOT. end_of_file ) GOTO 1999
+!!! END OF 1999 LOOP
+
+      IF(.NOT. found_lu .OR. end_of_file )THEN                                         
+        CALL wrf_message ( 'LANDUSE IN INPUT FILE DOES NOT MATCH LUTABLE: TABLE NOT USED' )
+      ENDIF                                                     
+    ENDIF  ! allowed_to_read
+
+    IF(FOUND_LU)THEN
+! Set arrays according to lu_index
+      itf = min0(ite, ide-1)
+      jtf = min0(jte, jde-1)
+      IF(usebgalb)CALL wrf_message ( 'Climatological albedo is used instead of table values' )
+      DO j = jts, jtf
+        DO i = its, itf
+          IS=nint(lu_index(i,j))
+          ! only do this check on read-in data
+          IF(IS.LT.0.OR.IS.GT.LUN.AND.allowed_to_read)THEN                                        
+            WRITE ( wrf_err_message , * ) 'ERROR: LANDUSE OUTSIDE RANGE =',IS,' AT ',I,J,' LUN= ',LUN
+            CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+          ENDIF                                                            
+!   SET NO-DATA POINTS (IS=0) TO WATER                                    
+          IF(IS.EQ.0)THEN                                                
+            IS=ISWATER                                                  
+          ENDIF                                                        
+          IF(.NOT.usebgalb)ALBBCK(I,J)=ALBD(IS,ISN)/100.                                  
+          ALBEDO(I,J)=ALBBCK(I,J)
+          IF(SNOWC(I,J) .GT. 0.5)ALBEDO(I,J)=ALBBCK(I,J)*(1.+SCFX(IS))
+          THC(I,J)=THERIN(IS,ISN)/100.                               
+          Z0(I,J)=SFZ0(IS,ISN)/100.                                
+          ZNT(I,J)=Z0(I,J)
+          EMISS(I,J)=SFEM(IS,ISN)                                  
+          MAVAIL(I,J)=SLMO(IS,ISN)                                
+          IF(IS.NE.ISWATER)THEN                                  
+            XLAND(I,J)=1.0                                      
+          ELSE                                                 
+            XLAND(I,J)=2.0                                    
+          ENDIF                                              
+!    SET SEA-ICE POINTS TO LAND WITH ICE/SNOW SURFACE PROPERTIES
+          IF(XICE(I,J).GT.0.5)THEN
+            XLAND(I,J)=1.0
+            ALBBCK(I,J)=ALBD(ISICE,ISN)/100.
+            ALBEDO(I,J)=ALBBCK(I,J)
+            THC(I,J)=THERIN(ISICE,ISN)/100.                              
+            Z0(I,J)=SFZ0(ISICE,ISN)/100.                               
+            ZNT(I,J)=Z0(I,J)
+            EMISS(I,J)=SFEM(ISICE,ISN)                                 
+            MAVAIL(I,J)=SLMO(ISICE,ISN)                               
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDIF
+    if ( wrf_dm_on_monitor() .and. allowed_to_read ) then
+      CLOSE (landuse_unit)
+    endif
+    CALL wrf_debug( 100 , 'returning from of landuse_init' )
+
+! restore LU variables from state
+    curs = 1
+    DO cats = 1, max_cats
+      lu_state(curs) = SCFX(cats)                 ; curs = curs + 1
+      DO seas = 1, max_seas
+        lu_state(curs) = ALBD(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SLMO(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SFEM(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SFZ0(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SFHC(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = THERIN(cats,seas)        ; curs = curs + 1
+      ENDDO
+    ENDDO
+
+    RETURN
+        
+   END SUBROUTINE landuse_init 
+
+!!!******MARS MARS
+!!!******MARS MARS
+!!!******MARS MARS
+
+!!=====================================================================
+!   SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       & 
+!                      RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT,    &
+!                      levsiz,XLAT,n_ozmixm,                           &
+!                      ozmixm,pin,                                     & ! Optional
+!                      m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,     & ! Optional
+!                      paerlev,n_aerosolc,                             &
+!                      sfull,shalf,pptop,swrad_scat,                  &
+!                      config_flags,restart,                          & 
+!                      allowed_to_read, start_of_simulation,          &
+!                      ids, ide, jds, jde, kds, kde,                  &
+!                      ims, ime, jms, jme, kms, kme,                  &
+!                      its, ite, jts, jte, kts, kte                   )
+!!---------------------------------------------------------------------
+!   USE module_ra_rrtm
+!   USE module_ra_cam
+!   USE module_ra_sw
+!   USE module_ra_gsfcsw
+!   USE module_ra_gfdleta
+!   USE module_domain
+!!---------------------------------------------------------------------
+!   IMPLICIT NONE
+!!---------------------------------------------------------------------
+!   INTEGER,  INTENT(IN)           :: id
+!   TYPE (grid_config_rec_type)    :: config_flags
+!   LOGICAL , INTENT(IN)           :: restart
+!   LOGICAL,  INTENT(IN)           :: allowed_to_read
+!
+!   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,   &
+!                                     ims, ime, jms, jme, kms, kme,   &
+!                                     its, ite, jts, jte, kts, kte
+!
+!   INTEGER , INTENT(IN)           :: JULDAY,JULYR
+!   REAL ,    INTENT(IN)           :: DT, RADT, cen_lat, GMT, pptop,  &
+!                                     swrad_scat
+!   LOGICAL,  INTENT(IN)           :: start_of_simulation
+!
+!   INTEGER,      INTENT(IN   )    ::   levsiz, n_ozmixm
+!   INTEGER,      INTENT(IN   )    ::   paerlev, n_aerosolc
+!
+!   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::  XLAT
+!
+!   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL,      &
+!          INTENT(INOUT) ::                                  OZMIXM
+!
+!   REAL,  DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT)  :: m_ps_1,m_ps_2
+!   REAL,  DIMENSION(paerlev), OPTIONAL, INTENT(INOUT)  ::         m_hybi
+!   REAL,  DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL,     &
+!          INTENT(INOUT) ::                      aerosolc_1, aerosolc_2
+!
+!   REAL,  DIMENSION(levsiz), OPTIONAL, INTENT(INOUT)  ::          PIN
+!
+!   INTEGER , INTENT(INOUT)        :: STEPRA
+!   INTEGER :: isn
+!
+!   REAL , DIMENSION( kms:kme ) , INTENT(IN) :: sfull, shalf
+!   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::           &
+!                                                           RTHRATEN, &
+!                                                         RTHRATENLW, &
+!                                                         RTHRATENSW, &
+!                                                             CLDFRA
+!   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: EMISS
+!   LOGICAL :: etalw = .false.
+!   LOGICAL :: camlw = .false.
+!   LOGICAL :: etamp = .false.
+!   integer :: month,iday
+!   INTEGER :: i, j, k, itf, jtf, ktf
+!!---------------------------------------------------------------------
+!
+!   jtf=min0(jte,jde-1)
+!   ktf=min0(kte,kde-1)
+!   itf=min0(ite,ide-1)
+!
+!!---------------------------------------------------------------------
+!
+!!-- calculate radiation time step
+!
+!    STEPRA = nint(RADT*60./DT)
+!    STEPRA = max(STEPRA,1)
+!
+!!-- initialization
+!
+!   IF(start_of_simulation)THEN
+!     DO j=jts,jtf
+!     DO k=kts,ktf
+!     DO i=its,itf
+!        RTHRATEN(i,k,j)=0.
+!        RTHRATENLW(i,k,j)=0.
+!        RTHRATENSW(i,k,j)=0.
+!        CLDFRA(i,k,j)=0.
+!     ENDDO
+!     ENDDO
+!     ENDDO
+!   ENDIF
+!
+!!-- find out which microphysics option is used first
+!
+!   mp_select: SELECT CASE(config_flags%mp_physics)
+!
+!        CASE (ETAMPNEW)
+!             etamp = .true.
+!
+!   END SELECT mp_select
+!
+!!-- chose long wave radiation scheme
+! 
+!   lwrad_select: SELECT CASE(config_flags%ra_lw_physics)
+!
+!        CASE (RRTMSCHEME)
+!             CALL rrtminit(                                 &
+!                           allowed_to_read ,                &
+!                           ids, ide, jds, jde, kds, kde,    &
+!                           ims, ime, jms, jme, kms, kme,    &
+!                           its, ite, jts, jte, kts, kte     )
+!
+!        CASE (CAMLWSCHEME)
+!#ifdef MAC_KLUDGE
+!             CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' )
+!#endif
+!             IF ( PRESENT( OZMIXM ) .AND. PRESENT( PIN ) .AND. &
+!                  PRESENT(M_PS_1) .AND. PRESENT(M_PS_2) .AND.  &
+!                  PRESENT(M_HYBI) .AND. PRESENT(AEROSOLC_1)    &
+!                  .AND. PRESENT(AEROSOLC_2)) THEN
+!             CALL camradinit(                                  &
+!                         R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, &
+!                         ozmixm,pin,levsiz,XLAT,n_ozmixm,      &
+!                         m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,&
+!                         paerlev, n_aerosolc,              &
+!                         ids, ide, jds, jde, kds, kde,     &
+!                         ims, ime, jms, jme, kms, kme,     &
+!                         its, ite, jts, jte, kts, kte      )
+!             ELSE
+!                CALL wrf_error_fatal ( 'arguments not present for calling cam radiation' )
+!             ENDIF
+!
+!             camlw = .true.
+!
+!        CASE (GFDLLWSCHEME)
+!             CALL nl_get_start_month(id,month)
+!             CALL nl_get_start_day(id,iday)
+!             CALL gfdletainit(emiss,sfull,shalf,pptop,      &
+!                              julyr,month,iday,gmt,         &
+!                              config_flags,allowed_to_read, &
+!                              ids, ide, jds, jde, kds, kde, &
+!                              ims, ime, jms, jme, kms, kme, &
+!                              its, ite, jts, jte, kts, kte  )
+!             etalw = .true.
+!        CASE DEFAULT
+!
+!   END SELECT lwrad_select
+!!-- initialize short wave radiation scheme
+! 
+!   swrad_select: SELECT CASE(config_flags%ra_sw_physics)
+!
+!        CASE (SWRADSCHEME)
+!             CALL swinit(                                  &
+!                         swrad_scat,                       &
+!                         allowed_to_read ,                 &
+!                         ids, ide, jds, jde, kds, kde,     &
+!                         ims, ime, jms, jme, kms, kme,     &
+!                         its, ite, jts, jte, kts, kte      )
+!
+!        CASE (CAMSWSCHEME)
+!#ifdef MAC_KLUDGE
+!             CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' )
+!#endif
+!             IF(.not.camlw)THEN
+!             CALL camradinit(                              &
+!                         R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop,               &
+!                         ozmixm,pin,levsiz,XLAT,n_ozmixm,     &
+!                         m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,&
+!                         paerlev, n_aerosolc,              &
+!                         ids, ide, jds, jde, kds, kde,     &
+!                         ims, ime, jms, jme, kms, kme,     &
+!                         its, ite, jts, jte, kts, kte      )
+!             ENDIF
+!
+!        CASE (GSFCSWSCHEME)
+!             CALL gsfc_swinit(cen_lat, allowed_to_read )
+!
+!        CASE (GFDLSWSCHEME)
+!             IF(.not.etalw)THEN
+!             CALL nl_get_start_month(id,month)
+!             CALL nl_get_start_day(id,iday)
+!             CALL gfdletainit(emiss,sfull,shalf,pptop,      &
+!                              julyr,month,iday,gmt,         &
+!                              config_flags,allowed_to_read, &
+!                              ids, ide, jds, jde, kds, kde, &
+!                              ims, ime, jms, jme, kms, kme, &
+!                              its, ite, jts, jte, kts, kte  )
+!             ENDIF
+!
+!        CASE DEFAULT
+!
+!   END SELECT swrad_select
+!
+!   END SUBROUTINE ra_init
+!
+!   SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
+!                RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN,             &
+!                config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS,    &
+!                num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA,          &
+!                SNOW,SNOWC, CANWAT,SMSTAV,                      &
+!                SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM,       &
+!                IVGTYP,ISLTYP,SMOIS,SMFR3D,mavail,              &
+!                SNOWH,SH2O,FNDSOILW, FNDSNOWH,                  &
+!#if  ( NMM_CORE == 1 )
+!                Z0,XLAND,XICE,                                  &
+!#else
+!                ZNT,XLAND,XICE,                                 &
+!#endif
+!                SFCEVP,GRDFLX,                                  &
+!                allowed_to_read,                                &
+!!                num_roof_layers,num_wall_layers,num_road_layers,& !Optional urban
+!                DZR, DZB, DZG,                                  & !Optional urban
+!                TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D,   & !Optional urban
+!                XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,    & !Optional urban
+!                TRL_URB3D, TBL_URB3D, TGL_URB3D,                & !Optional urban
+!                SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D,             & !Optional urban
+!                TS_URB2D, FRC_URB2D, UTYPE_URB2D,UCMCALL,       & !Optional urban
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!!--------------------------------------------------------------------
+!   USE module_sf_sfclay
+!   USE module_sf_slab
+!   USE module_bl_ysu
+!   USE module_bl_mrf
+!   USE module_bl_gfs
+!   USE module_sf_myjsfc
+!   USE module_sf_noahlsm
+!   USE module_sf_urban
+!   USE module_sf_ruclsm
+!   USE module_bl_myjpbl
+!#if (NMM_CORE == 1)
+!   USE module_sf_lsm_nmm
+!#endif
+!!--------------------------------------------------------------------
+!   IMPLICIT NONE
+!!--------------------------------------------------------------------
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!   LOGICAL, INTENT(IN)         ::   FNDSOILW, FNDSNOWH
+!
+!   INTEGER , INTENT(IN)        ::     ids, ide, jds, jde, kds, kde, &
+!                                      ims, ime, jms, jme, kms, kme, &
+!                                      its, ite, jts, jte, kts, kte
+!   INTEGER , INTENT(IN)        ::     num_soil_layers
+!   INTEGER , INTENT(IN)        ::     UCMCALL 
+!
+!   REAL ,    INTENT(IN)        ::     DT, BLDT
+!   INTEGER , INTENT(INOUT)     ::     STEPBL
+!
+!   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),    &
+!             INTENT(OUT) :: SMFR3D
+!
+!   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),&
+!                   INTENT(INOUT) :: SMOIS,SH2O,TSLB 
+!
+!   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+!            INTENT(INOUT)    ::                           SNOW, &
+!                                                         SNOWH, &
+!                                                         SNOWC, &
+!                                                        CANWAT, &
+!                                                        MAVAIL, &
+!                                                        SMSTAV, &
+!                                                        SMSTOT, &
+!                                                     SFCRUNOFF, &
+!                                                      UDRUNOFF, &
+!                                                        ACSNOW, &
+!                                                        VEGFRA, &
+!                                                        ACSNOM, &
+!                                                        SFCEVP, &
+!                                                        GRDFLX, &
+!                                                           UST, &
+!#if ( NMM_CORE == 1 )
+!                                                            Z0, &
+!#else
+!                                                           ZNT, &
+!#endif
+!                                                         XLAND, &
+!                                                         XICE
+!
+!   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+!            INTENT(INOUT)    ::                         IVGTYP, &
+!                                                        ISLTYP, &
+!                                                        LOWLYR
+!
+!
+!   REAL,     DIMENSION(1:num_soil_layers), INTENT(INOUT)  ::  ZS,DZS
+!
+!   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+!                                                           RUBLTEN, &
+!                                                           RVBLTEN, &
+! 						          EXCH_H,   &
+!                                                          RTHBLTEN, &
+!                                                          RQVBLTEN, &
+!                                                          RQCBLTEN, &
+!                                                          RQIBLTEN, &
+!                                                          TKE_MYJ
+!
+!   REAL,  DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::     TSK
+!   REAL,  DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) ::  TMN
+!   LOGICAL,  INTENT(IN)           :: allowed_to_read
+!   INTEGER :: isn, isfc
+!
+!!URBAN
+!!   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR  !Optional urban
+!!   REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB  !Optional urban
+!!   REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG  !Optional urban
+!    REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR  !Optional urban
+!    REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB  !Optional urban
+!    REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG  !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !Optional urban
+!    INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !Optional urban
+!!    REAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban
+!!    REAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban
+!!    REAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban
+!
+!
+!!-- calculate pbl time step
+!
+!   STEPBL = nint(BLDT*60./DT)
+!   STEPBL = max(STEPBL,1)
+!
+!
+!!-- initialize surface layer scheme
+!
+!   sfclay_select: SELECT CASE(config_flags%sf_sfclay_physics)
+!
+!      CASE (SFCLAYSCHEME)
+!           CALL sfclayinit( allowed_to_read )
+!           isfc = 1
+!      CASE (MYJSFCSCHEME)
+!           CALL myjsfcinit(LOWLYR,UST,                         &
+!#if ( NMM_CORE == 1 )
+!                                      Z0,                      &
+!#else
+!                                      ZNT,                     &
+!#endif
+!                                          XLAND,XICE,          &
+!                         IVGTYP,restart,                       &
+!                         allowed_to_read ,                     &
+!                         ids, ide, jds, jde, kds, kde,         &
+!                         ims, ime, jms, jme, kms, kme,         &
+!                         its, ite, jts, jte, kts, kte          )
+!           isfc = 2
+!
+!      CASE (GFSSFCSCHEME)
+!           CALL myjsfcinit(LOWLYR,UST,                         &
+!#if ( NMM_CORE == 1 )
+!                                      Z0,                      &
+!#else
+!                                      ZNT,                     &
+!#endif
+!                                          XLAND,XICE,          &
+!                         IVGTYP,restart,                       &
+!                         allowed_to_read ,                     &
+!                         ids, ide, jds, jde, kds, kde,         &
+!                         ims, ime, jms, jme, kms, kme,         &
+!                         its, ite, jts, jte, kts, kte          )
+!           isfc = 1
+!
+!      CASE DEFAULT
+!
+!   END SELECT sfclay_select
+!
+!
+!!-- initialize surface scheme
+!
+!   sfc_select: SELECT CASE(config_flags%sf_surface_physics)
+!
+!      CASE (SLABSCHEME)
+!           CALL slabinit(TSK,TMN,                              &
+!                         TSLB,ZS,DZS,num_soil_layers,          & 
+!                         restart,                              &
+!                         allowed_to_read ,                     &
+!                         ids, ide, jds, jde, kds, kde,         &
+!                         ims, ime, jms, jme, kms, kme,         &
+!                         its, ite, jts, jte, kts, kte          )
+!#if (NMM_CORE == 1)
+!      CASE (NMMLSMSCHEME)
+!           CALL nmmlsminit(isn,XICE,VEGFRA,SNOW,SNOWC, CANWAT,SMSTAV, &
+!                     SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW,     &
+!                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,DZS,SFCEVP,   &
+!                     TMN,                                          &
+!                     num_soil_layers,                              &
+!                     allowed_to_read ,                             &
+!                     ids,ide, jds,jde, kds,kde,                    &
+!                     ims,ime, jms,jme, kms,kme,                    &
+!                     its,ite, jts,jte, kts,kte                     )
+!#endif
+!      CASE (LSMSCHEME)
+!          CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,  &
+!                     SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,        &
+!                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
+!                     FNDSOILW, FNDSNOWH,                       &
+!                     num_soil_layers, restart,                 &
+!                     allowed_to_read ,                         &
+!                     ids,ide, jds,jde, kds,kde,                &
+!                     ims,ime, jms,jme, kms,kme,                &
+!                     its,ite, jts,jte, kts,kte                 )
+!
+!!URBAN
+!          IF(UCMCALL.eq.1) THEN
+!
+!             IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN
+!
+!                CALL urban_param_init(DZR,DZB,DZG,num_soil_layers                    & !urban
+!                                )
+!!                                num_roof_layers,num_wall_layers,road_soil_layers)   !urban
+!                CALL urban_var_init(TSK,TSLB,TMN,IVGTYP,                             & !urban
+!                              ims,ime,jms,jme,num_soil_layers,                 & !urban
+!!                              num_roof_layers,num_wall_layers,num_road_layers, & !urban
+!                              XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,     & !urban
+!                              TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D,    & !urban
+!                              TRL_URB3D,TBL_URB3D,TGL_URB3D,                   & !urban
+!                              SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, TS_URB2D,    & ! urban
+!                              FRC_URB2D, UTYPE_URB2D)                            !urban
+!             ELSE
+!                CALL wrf_error_fatal ( 'arguments not present for calling urban model' )
+!             ENDIF
+!          ENDIF
+!
+!
+!      CASE (RUCLSMSCHEME)
+!!          if(isfc .ne. 2)CALL wrf_error_fatal &
+!!           ( 'module_physics_init: use myjsfc and myjpbl scheme for this lsm option' )
+!           CALL lsmrucinit( SMFR3D,TSLB,SMOIS,ISLTYP,mavail,       &
+!                     num_soil_layers, restart,                     &
+!                     allowed_to_read ,                             &
+!                     ids,ide, jds,jde, kds,kde,                    &
+!                     ims,ime, jms,jme, kms,kme,                    &
+!                     its,ite, jts,jte, kts,kte                     )
+!
+!      CASE DEFAULT
+!
+!   END SELECT sfc_select
+!
+!
+!!-- initialize pbl scheme
+!
+!   pbl_select: SELECT CASE(config_flags%bl_pbl_physics)
+!
+!      CASE (YSUSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL ysuinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (MRFSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL mrfinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (GFSSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL gfsinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (MYJPBLSCHEME)
+!           if(isfc .ne. 2)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use myjsfc scheme for this pbl option' )
+!           CALL myjpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, &
+!                        TKE_MYJ,EXCH_H,restart,               &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE DEFAULT
+!
+!   END SELECT pbl_select
+!
+!   END SUBROUTINE bl_init
+!
+!!==================================================================
+!   SUBROUTINE cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN,  &
+!                      RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC,       &
+!                      RAINCV,W0AVG,config_flags,restart,          &
+!                      CLDEFI,LOWLYR,MASS_FLUX,                    &
+!                      RTHFTEN, RQVFTEN,                           &
+!                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+!                      APR_CAPMA,APR_CAPME,APR_CAPMI,              &
+!                      allowed_to_read, start_of_simulation,       &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!!------------------------------------------------------------------
+!   USE module_cu_kf
+!   USE module_cu_kfeta
+!   USE MODULE_CU_BMJ
+!   USE module_cu_gd
+!   USE module_cu_sas
+!!------------------------------------------------------------------
+!   IMPLICIT NONE
+!!------------------------------------------------------------------
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!
+!
+!   INTEGER , INTENT(IN)        :: ids, ide, jds, jde, kds, kde,   &
+!                                  ims, ime, jms, jme, kms, kme,   &
+!                                  its, ite, jts, jte, kts, kte
+!
+!   REAL ,    INTENT(IN)        :: DT, CUDT
+!   LOGICAL , INTENT(IN)        :: start_of_simulation
+!   LOGICAL , INTENT(IN)        :: allowed_to_read
+!   INTEGER , INTENT(INOUT)     :: STEPCU
+!
+!   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &
+!            RTHCUTEN, RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN,     &
+!            RQSCUTEN
+!
+!   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
+!
+!   REAL,    DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+!            RTHFTEN, RQVFTEN
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: RAINC, RAINCV
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: CLDEFI
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX,   &
+!                                   APR_GR,APR_W,APR_MC,APR_ST,APR_AS,    &
+!                                   APR_CAPMA,APR_CAPME,APR_CAPMI
+!
+!   INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR
+!
+!! LOCAL VAR
+!   
+!  INTEGER :: i,j,itf,jtf
+!
+!!--------------------------------------------------------------------
+!
+!!-- calculate cumulus parameterization time step
+!
+!   itf=min0(ite,ide-1)
+!   jtf=min0(jte,jde-1)
+!!
+!   STEPCU = nint(CUDT*60./DT)
+!   STEPCU = max(STEPCU,1)
+!
+!!-- initialization
+!
+!   IF(start_of_simulation)THEN
+!     DO j=jts,jtf
+!     DO i=its,itf
+!        RAINC(i,j)=0.
+!        RAINCV(i,j)=0.
+!     ENDDO
+!     ENDDO
+!   ENDIF
+!
+!   cps_select: SELECT CASE(config_flags%cu_physics)
+!
+!     CASE (KFSCHEME)
+!          CALL kfinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,        &
+!                      RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS,      &
+!                      PARAM_FIRST_SCALAR,restart,                 &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!
+!     CASE (BMJSCHEME)
+!          CALL bmjinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,       &
+!                      CLDEFI,LOWLYR,cp,r_d,restart,               &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!
+!     CASE (KFETASCHEME)
+!          CALL kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,   &
+!                      RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS,      &
+!                      SVP1,SVP2,SVP3,SVPT0,                       &
+!                      PARAM_FIRST_SCALAR,restart,                 &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!     CASE (GDSCHEME)
+!          CALL gdinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,        &
+!                      MASS_FLUX,cp,restart,                       &
+!                      P_QC,P_QI,PARAM_FIRST_SCALAR,               &
+!                      RTHFTEN, RQVFTEN,                           &
+!                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+!                      APR_CAPMA,APR_CAPME,APR_CAPMI,              &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!     CASE (SASSCHEME)
+!          CALL sasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,       &
+!                      restart,P_QC,P_QI,PARAM_FIRST_SCALAR,       &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!
+!     CASE DEFAULT
+!
+!   END SELECT cps_select
+!
+!   END SUBROUTINE cu_init
+!
+!!==================================================================
+!   SUBROUTINE mp_init(RAINNC,config_flags,restart,warm_rain,      &
+!                      adv_moist_cond,                             &
+!                      MPDT, DT, DX, DY, LOWLYR,                   & ! for eta mp
+!                      F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,           & ! for eta mp
+!                      mp_restart_state,tbpvs_state,tbpvs0_state,   & ! eta mp
+!                      allowed_to_read, start_of_simulation,       &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!!------------------------------------------------------------------
+!   USE module_mp_ncloud3
+!   USE module_mp_ncloud5
+!   USE module_mp_wsm3
+!   USE module_mp_wsm5
+!   USE module_mp_wsm6
+!   USE module_mp_etanew
+!   USE module_mp_thompson
+!!------------------------------------------------------------------
+!   IMPLICIT NONE
+!!------------------------------------------------------------------
+!! Arguments
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!   LOGICAL , INTENT(OUT)       :: warm_rain,adv_moist_cond
+!   REAL    , INTENT(IN)        :: MPDT, DT, DX, DY
+!   LOGICAL , INTENT(IN)        :: start_of_simulation
+!
+!   INTEGER , INTENT(IN)        :: ids, ide, jds, jde, kds, kde,   &
+!                                  ims, ime, jms, jme, kms, kme,   &
+!                                  its, ite, jts, jte, kts, kte
+!
+!   INTEGER , DIMENSION( ims:ime , jms:jme ) ,INTENT(INOUT)  :: LOWLYR
+!   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: RAINNC
+!   REAL,     DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: &
+!                                  F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
+!   REAL , DIMENSION(:) ,INTENT(INOUT)  :: mp_restart_state,tbpvs_state,tbpvs0_state
+!   LOGICAL , INTENT(IN)  :: allowed_to_read
+!
+!! Local
+!   INTEGER :: i, j, itf, jtf
+!
+!   warm_rain = .false.
+!   adv_moist_cond = .true.
+!   itf=min0(ite,ide-1)
+!   jtf=min0(jte,jde-1)
+!
+!   IF(start_of_simulation)THEN
+!     DO j=jts,jtf
+!     DO i=its,itf
+!        RAINNC(i,j) = 0.
+!     ENDDO
+!     ENDDO
+!   ENDIF
+!
+!   mp_select: SELECT CASE(config_flags%mp_physics)
+!
+!     CASE (KESSLERSCHEME)
+!          warm_rain = .true.
+!     CASE (WSM3SCHEME)
+!          CALL wsm3init(rhoair0,rhowater,rhosnow,cliq,cv, allowed_to_read )
+!     CASE (WSM5SCHEME)
+!          CALL wsm5init(rhoair0,rhowater,rhosnow,cliq,cv, allowed_to_read )
+!     CASE (WSM6SCHEME)
+!          CALL wsm6init(rhoair0,rhowater,rhosnow,cliq,cv, allowed_to_read )
+!     CASE (ETAMPNEW)
+!         adv_moist_cond = .false.
+!         CALL etanewinit (MPDT,DT,DX,DY,LOWLYR,restart,           &
+!                          F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,       &
+!                          mp_restart_state,tbpvs_state,tbpvs0_state,&
+!                          allowed_to_read,                        &
+!                          ids, ide, jds, jde, kds, kde,           &
+!                          ims, ime, jms, jme, kms, kme,           &
+!                          its, ite, jts, jte, kts, kte            )
+!     CASE (THOMPSON)
+!         CALL thompson_init
+!     CASE (NCEPCLOUD3)
+!          CALL ncloud3init(rhoair0,rhowater,rhosnow,cliq,cv, allowed_to_read )
+!     CASE (NCEPCLOUD5)
+!          CALL ncloud5init(rhoair0,rhowater,rhosnow,cliq,cv, allowed_to_read )
+!
+!     CASE DEFAULT
+!
+!   END SELECT mp_select
+!
+!   END SUBROUTINE mp_init
+!
+!#if  ( EM_CORE == 1 )
+!!==========================================================
+!   SUBROUTINE fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN,    &
+!                RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,               &
+!                config_flags,restart,                           &
+!                allowed_to_read ,                               &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!
+!!--------------------------------------------------------------------
+!   USE module_fdda_psufddagd
+!!--------------------------------------------------------------------
+!   IMPLICIT NONE
+!!--------------------------------------------------------------------
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!
+!   INTEGER , INTENT(IN)        ::     ids, ide, jds, jde, kds, kde, &
+!                                      ims, ime, jms, jme, kms, kme, &
+!                                      its, ite, jts, jte, kts, kte
+!
+!   REAL ,    INTENT(IN)        ::     DT, FGDT
+!   INTEGER , INTENT(IN)        ::     id
+!   INTEGER , INTENT(INOUT)     ::     STEPFG
+!   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+!                                                           RUNDGDTEN, &
+!                                                           RVNDGDTEN, &
+!                                                          RTHNDGDTEN, &
+!                                                          RQVNDGDTEN
+!   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: RMUNDGDTEN
+!
+!   LOGICAL,  INTENT(IN)           :: allowed_to_read
+!!--------------------------------------------------------------------
+!
+!!-- calculate pbl time step
+!
+!   STEPFG = nint(FGDT*60./DT)
+!   STEPFG = max(STEPFG,1)
+!
+!
+!!-- initialize fdda scheme
+!
+!   fdda_select: SELECT CASE(config_flags%grid_fdda)
+!
+!      CASE (PSUFDDAGD)
+!           CALL fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,&
+!               config_flags%run_hours, &
+!               config_flags%if_no_pbl_nudging_uv, &
+!               config_flags%if_no_pbl_nudging_t, &
+!               config_flags%if_no_pbl_nudging_q, &
+!               config_flags%if_zfac_uv, &
+!               config_flags%k_zfac_uv, &
+!               config_flags%if_zfac_t, &
+!               config_flags%k_zfac_t, &
+!               config_flags%if_zfac_q, &
+!               config_flags%k_zfac_q, &
+!               config_flags%guv, &
+!               config_flags%gt, config_flags%gq, &
+!               config_flags%if_ramping, config_flags%dtramp_min, &
+!               config_flags%gfdda_end_h, &
+!                      restart, allowed_to_read,                    &
+!                      ids, ide, jds, jde, kds, kde,                &
+!                      ims, ime, jms, jme, kms, kme,                &
+!                      its, ite, jts, jte, kts, kte                 )
+!      CASE DEFAULT
+!
+!   END SELECT fdda_select
+!
+!   END SUBROUTINE fg_init
+!
+!!-------------------------------------------------------------------
+!   SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid,       &
+!                        dx_coarse, restart, obs_twindo, itimestep, &
+!                        s_sn_cg, e_sn_cg, s_we_cg, e_we_cg,  &
+!                        fdob,                                      &
+!                        ids, ide, jds, jde, kds, kde,              &
+!                        ims, ime, jms, jme, kms, kme,              &
+!                        its, ite, jts, jte, kts, kte               )
+!
+!
+!!--------------------------------------------------------------------
+!   USE module_domain
+!   USE module_fddaobs_rtfdda
+!!--------------------------------------------------------------------
+!   IMPLICIT NONE
+!!--------------------------------------------------------------------
+!   INTEGER , INTENT(IN)    :: maxdom
+!   INTEGER , INTENT(IN)    :: obs_nudge_opt(maxdom)
+!   INTEGER , INTENT(IN)    :: ids,ide, jds,jde, kds,kde,           &
+!                              ims,ime, jms,jme, kms,kme,           &
+!                              its,ite, jts,jte, kts,kte
+!   INTEGER , INTENT(IN)    :: inest
+!   INTEGER , INTENT(IN)    :: parid(maxdom)
+!   REAL    , INTENT(IN)    :: dx_coarse
+!   LOGICAL , INTENT(IN)    :: restart
+!   REAL    , INTENT(INOUT) :: obs_twindo
+!   INTEGER , INTENT(IN)    :: itimestep
+!   INTEGER, intent(in)     :: s_sn_cg      ! starting north-south coarse-grid index
+!   INTEGER, intent(in)     :: e_sn_cg      ! ending   north-south coarse-grid index
+!   INTEGER, intent(in)     :: s_we_cg      ! starting west-east   coarse-grid index
+!   INTEGER, intent(in)     :: e_we_cg      ! ending   west-east   coarse-grid index
+!
+!   TYPE(fdob_type), INTENT(INOUT)  :: fdob
+!
+!   INTEGER                 :: e_sn         ! ending   north-south grid index
+!!--------------------------------------------------------------------
+!!-- initialize fdda obs-nudging scheme
+!
+!      e_sn = jde
+!      CALL fddaobs_init(obs_nudge_opt, maxdom, inest, parid,       &  
+!                        dx_coarse, restart, obs_twindo, itimestep, &
+!                        e_sn, s_sn_cg, e_sn_cg, s_we_cg, e_we_cg,  &
+!                        fdob,                                      &  
+!                        ids,ide, jds,jde, kds,kde,                 &  
+!                        ims,ime, jms,jme, kms,kme,                 &  
+!                        its,ite, jts,jte, kts,kte)
+!
+!   END SUBROUTINE fdob_init
+!#endif
+!
+!--------------------------------------------------------------------
+   SUBROUTINE z2sigma(zf,zh,sf,sh,p_top,pptop,config_flags, &
+                allowed_to_read , &
+                kds,kde,kms,kme,kts,kte)
+   IMPLICIT NONE
+! Arguments
+   INTEGER, INTENT(IN) :: kds,kde,kms,kme,kts,kte
+   REAL , DIMENSION( kms:kme ), INTENT(IN) :: zf,zh
+   REAL , DIMENSION( kms:kme ), INTENT(OUT):: sf,sh
+   REAL , INTENT(IN) :: p_top
+   REAL , INTENT(OUT) :: pptop
+   TYPE (grid_config_rec_type)              :: config_flags
+   LOGICAL , INTENT(IN) :: allowed_to_read
+! Local
+   REAL R, G, TS, GAMMA, PS, ZTROP, TSTRAT, PTROP, Z, T, P, ZTOP, PTOP
+   INTEGER K
+
+   IF(zf(kde/2) .GT. 1.0)THEN
+! Height levels assumed (zeta coordinate)
+! Convert to sigma using standard atmosphere for pressure-height relation
+! constants for standard atmosphere definition
+      r=287.05
+      g=9.80665
+      ts=288.15
+      gamma=-6.5/1000.
+      ps=1013.25
+      ztrop=11000.
+      tstrat=ts+gamma*ztrop
+      ptrop=ps*(tstrat/ts)**(-g/(gamma*r))
+
+      do k=kde,kds,-1
+! full levels
+        z=zf(k)
+        if(z.le.ztrop)then
+          t=ts+gamma*z
+          p=ps*(t/ts)**(-g/(gamma*r))
+        else
+          t=tstrat
+          p=ptrop*exp(-g*(z-ztrop)/(r*tstrat))
+        endif
+        if(k.eq.kde)then
+          ztop=zf(k)
+          ptop=p
+        endif
+        sf(k)=(p-ptop)/(ps-ptop)
+! half levels
+        if(k.ne.kds)then
+        z=0.5*(zf(k)+zf(k-1))
+        if(z.le.ztrop)then
+          t=ts+gamma*z
+          p=ps*(t/ts)**(-g/(gamma*r))
+        else
+          t=tstrat
+          p=ptrop*exp(-g*(z-ztrop)/(r*tstrat))
+        endif
+        sh(k-1)=(p-ptop)/(ps-ptop)
+        endif
+      enddo
+      pptop=ptop/10.
+   ELSE
+!  Levels are already sigma/eta
+      do k=kde,kds,-1
+!        sf(k)=zf(kde-k+kds)
+!        if(k .ne. kde)sh(k)=zh(kde-1-k+kds)
+         sf(k)=zf(k)
+         if(k .ne. kde)sh(k)=zh(k)
+      enddo
+      pptop=p_top/1000.
+
+   ENDIF
+
+   END SUBROUTINE z2sigma
+
+END MODULE module_physics_init
Index: trunk/WRF.COMMON/WRFV2/phys/module_progtm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_progtm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_progtm.F	(revision 2744)
@@ -0,0 +1,93 @@
+      module module_progtm
+      USE MODULE_GFS_MACHINE , ONLY : kind_phys
+      implicit none
+      SAVE
+!
+      integer,parameter:: NTYPE=9
+      integer,parameter:: NGRID=22
+      real(kind=kind_phys) B(NTYPE), SATPSI(NTYPE), SATKT(NTYPE),       &
+     &                     TSAT(NTYPE),                                 & 
+     &                     DFK(NGRID,NTYPE),                            &
+     &                     KTK(NGRID,NTYPE),                            &
+     &                     DFKT(NGRID,NTYPE)
+!
+!  the nine soil types are:
+!    1  ... loamy sand (coarse)
+!    2  ... silty clay loam (medium)
+!    3  ... light clay (fine)
+!    4  ... sandy loam (coarse-medium)
+!    5  ... sandy clay (coarse-fine)
+!    6  ... clay loam  (medium-fine)
+!    7  ... sandy clay loam (coarse-med-fine)
+!    8  ... loam  (organic)
+!    9  ... ice (use loamy sand property)
+!
+!     DATA B/4.05,4.38,4.9,5.3,5.39,7.12,7.75,8.52,
+!    &       10.4,10.4,11.4/
+!     DATA SATPSI/.121,.09,.218,.786,.478,.299,.356,.63,
+!    &            .153,.49,.405/
+!     DATA SATKT/1.76E-4,1.5633E-4,3.467E-5,7.2E-6,6.95E-6,
+!    &           6.3E-6,1.7E-6,2.45E-6,2.167E-6,1.033E-6,
+!    &           1.283E-6/
+!     DATA TSAT/.395,.41,.435,.485,.451,.42,.477,.476,
+!    &          .426,.492,.482/
+      data b/4.26,8.72,11.55,4.74,10.73,8.17,6.77,5.25,4.26/
+      data satpsi/.04,.62,.47,.14,.10,.26,.14,.36,.04/
+      data satkt/1.41e-5,.20e-5,.10e-5,.52e-5,.72e-5,                   &
+     &           .25e-5,.45e-5,.34e-5,1.41e-5/
+      data tsat/.421,.464,.468,.434,.406,.465,.404,.439,.421/
+!
+      contains
+      subroutine GRDDF
+      USE MODULE_GFS_MACHINE , ONLY : kind_phys
+      implicit none
+      integer              i,    k
+      real(kind=kind_phys) dynw, f1, f2, theta
+!
+!  GRDDF SETS UP MOISTURE DIFFUSIVITY AND HYDROLIC CONDUCTIVITY
+!  FOR ALL SOIL TYPES
+!  GRDDFS SETS UP THERMAL DIFFUSIVITY FOR ALL SOIL TYPES
+!
+      DO K = 1, NTYPE
+        DYNW = TSAT(K) * .05
+        F1 = B(K) * SATKT(K) * SATPSI(K) / TSAT(K) ** (B(K) + 3.)
+        F2 = SATKT(K) / TSAT(K) ** (B(K) * 2. + 3.)
+!
+!  CONVERT FROM M/S TO KG M-2 S-1 UNIT
+!
+        F1 = F1 * 1000.
+        F2 = F2 * 1000.
+        DO I = 1, NGRID
+          THETA = FLOAT(I-1) * DYNW
+          THETA = MIN(TSAT(K),THETA)
+          DFK(I,K) = F1 * THETA ** (B(K) + 2.)
+          KTK(I,K) = F2 * THETA ** (B(K) * 2. + 3.)
+        ENDDO
+      ENDDO
+      END SUBROUTINE
+      subroutine GRDKT
+      USE MODULE_GFS_MACHINE , ONLY : kind_phys
+      implicit none
+      integer              i,    k
+      real(kind=kind_phys) dynw, f1, theta, pf
+      DO K = 1, NTYPE
+        DYNW = TSAT(K) * .05
+        F1 = LOG10(SATPSI(K)) + B(K) * LOG10(TSAT(K)) + 2.
+        DO I = 1, NGRID
+          THETA = FLOAT(I-1) * DYNW
+          THETA = MIN(TSAT(K),THETA)
+          IF(THETA.GT.0.) THEN
+            PF = F1 - B(K) * LOG10(THETA)
+          ELSE
+            PF = 5.2
+          ENDIF
+          IF(PF.LE.5.1) THEN
+            DFKT(I,K) = EXP(-(2.7+PF)) * 420.
+          ELSE
+            DFKT(I,K) = .1744
+          ENDIF
+        ENDDO
+      ENDDO
+      END SUBROUTINE
+!
+      end module module_progtm
Index: trunk/WRF.COMMON/WRFV2/phys/module_ra_cam.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_ra_cam.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_ra_cam.F	(revision 2744)
@@ -0,0 +1,11544 @@
+MODULE module_ra_cam
+      integer, parameter :: r8 = 8
+      real(r8), parameter:: inf = 1.e20 ! CAM sets this differently in infnan.F90
+      integer, parameter:: bigint = O'17777777777'           ! largest possible 32-bit integer 
+
+      integer :: ixcldliq 
+      integer :: ixcldice
+!     integer :: levsiz    ! size of level dimension on dataset
+      integer, parameter :: nbands = 2          ! Number of spectral bands
+      integer, parameter :: naer_all = 12 + 1
+      integer, parameter :: naer = 10 + 1
+      integer, parameter :: bnd_nbr_LW=7 
+      integer, parameter :: ndstsz = 4    ! number of dust size bins
+      integer :: idxSUL
+      integer :: idxSSLT
+      integer :: idxDUSTfirst
+      integer :: idxCARBONfirst
+      integer :: idxOCPHO
+      integer :: idxBCPHO
+      integer :: idxOCPHI
+      integer :: idxBCPHI
+      integer :: idxBG  
+      integer :: idxVOLC
+
+  integer :: mxaerl                            ! Maximum level of background aerosol
+
+! indices to sections of array that represent
+! groups of aerosols
+
+  integer, parameter :: &
+      numDUST         = 4, &
+      numCARBON      = 4
+
+! portion of each species group to use in computation
+! of relative radiative forcing.
+
+  real(r8) :: sulscl_rf  = 0._r8 !
+  real(r8) :: carscl_rf  = 0._r8
+  real(r8) :: ssltscl_rf = 0._r8
+  real(r8) :: dustscl_rf = 0._r8
+  real(r8) :: bgscl_rf   = 0._r8
+  real(r8) :: volcscl_rf = 0._r8
+
+! "background" aerosol species mmr.
+  real(r8) :: tauback = 0._r8
+
+! portion of each species group to use in computation
+! of aerosol forcing in driving the climate
+  real(r8) :: sulscl  = 1._r8
+  real(r8) :: carscl  = 1._r8
+  real(r8) :: ssltscl = 1._r8
+  real(r8) :: dustscl = 1._r8
+  real(r8) :: volcscl = 1._r8
+
+!From volcrad.F90 module
+     integer, parameter :: idx_LW_0500_0650=3
+     integer, parameter :: idx_LW_0650_0800=4
+     integer, parameter :: idx_LW_0800_1000=5
+     integer, parameter :: idx_LW_1000_1200=6
+     integer, parameter :: idx_LW_1200_2000=7
+
+! First two values represent the overlap of volcanics with the non-window
+! (0-800, 1200-2200 cm^-1) and window (800-1200 cm^-1) regions.|  Coefficients
+! were derived using crm_volc_minimize.pro with spectral flux optimization
+! on first iteration, total heating rate on subsequent iterations (2-9).
+! Five profiles for HLS, HLW, MLS, MLW, and TRO conditions were given equal
+! weight.  RMS heating rate errors for a visible stratospheric optical
+! depth of 1.0 are 0.02948 K/day.
+!
+      real(r8) :: abs_cff_mss_aer(bnd_nbr_LW) = &
+         (/ 70.257384, 285.282943, &
+         1.0273851e+02, 6.3073303e+01, 1.2039569e+02, &
+         3.6343643e+02, 2.7138528e+02 /)
+
+!From radae.F90 module
+      real(r8), parameter:: min_tp_h2o = 160.0        ! min T_p for pre-calculated abs/emis
+      real(r8), parameter:: max_tp_h2o = 349.999999   ! max T_p for pre-calculated abs/emis
+      real(r8), parameter:: dtp_h2o = 21.111111111111 ! difference in adjacent elements of tp_h2o
+      real(r8), parameter:: min_te_h2o = -120.0       ! min T_e-T_p for pre-calculated abs/emis
+      real(r8), parameter:: max_te_h2o = 79.999999    ! max T_e-T_p for pre-calculated abs/emis
+      real(r8), parameter:: dte_h2o  = 10.0           ! difference in adjacent elements of te_h2o
+      real(r8), parameter:: min_rh_h2o = 0.0          ! min RH for pre-calculated abs/emis
+      real(r8), parameter:: max_rh_h2o = 1.19999999   ! max RH for pre-calculated abs/emis
+      real(r8), parameter:: drh_h2o = 0.2             ! difference in adjacent elements of RH
+      real(r8), parameter:: min_lu_h2o = -8.0         ! min log_10(U) for pre-calculated abs/emis
+      real(r8), parameter:: min_u_h2o  = 1.0e-8       ! min pressure-weighted path-length
+      real(r8), parameter:: max_lu_h2o =  3.9999999   ! max log_10(U) for pre-calculated abs/emis
+      real(r8), parameter:: dlu_h2o  = 0.5            ! difference in adjacent elements of lu_h2o
+      real(r8), parameter:: min_lp_h2o = -3.0         ! min log_10(P) for pre-calculated abs/emis
+      real(r8), parameter:: min_p_h2o = 1.0e-3        ! min log_10(P) for pre-calculated abs/emis
+      real(r8), parameter:: max_lp_h2o = -0.0000001   ! max log_10(P) for pre-calculated abs/emis
+      real(r8), parameter:: dlp_h2o = 0.3333333333333 ! difference in adjacent elements of lp_h2o
+      integer, parameter :: n_u = 25   ! Number of U in abs/emis tables
+      integer, parameter :: n_p = 10   ! Number of P in abs/emis tables
+      integer, parameter :: n_tp = 10  ! Number of T_p in abs/emis tables
+      integer, parameter :: n_te = 21  ! Number of T_e in abs/emis tables
+      integer, parameter :: n_rh = 7   ! Number of RH in abs/emis tables
+      real(r8):: c16,c17,c26,c27,c28,c29,c30,c31
+      real(r8):: fwcoef      ! Farwing correction constant
+      real(r8):: fwc1,fwc2   ! Farwing correction constants
+      real(r8):: fc1         ! Farwing correction constant
+      real(r8):: amco2 ! Molecular weight of co2   (g/mol)
+      real(r8):: amd   ! Molecular weight of dry air (g/mol)
+      real(r8):: p0    ! Standard pressure (dynes/cm**2)
+
+  real(r8):: ah2onw(n_p, n_tp, n_u, n_te, n_rh)   ! absorptivity (non-window)
+  real(r8):: eh2onw(n_p, n_tp, n_u, n_te, n_rh)   ! emissivity   (non-window)
+  real(r8):: ah2ow(n_p, n_tp, n_u, n_te, n_rh)    ! absorptivity (window, for adjacent layers)
+  real(r8):: cn_ah2ow(n_p, n_tp, n_u, n_te, n_rh)    ! continuum transmission for absorptivity (window)
+  real(r8):: cn_eh2ow(n_p, n_tp, n_u, n_te, n_rh)    ! continuum transmission for emissivity   (window)
+  real(r8):: ln_ah2ow(n_p, n_tp, n_u, n_te, n_rh)    ! line-only transmission for absorptivity (window)
+  real(r8):: ln_eh2ow(n_p, n_tp, n_u, n_te, n_rh)    ! line-only transmission for emissivity   (window)
+
+!
+! Constant coefficients for water vapor overlap with trace gases.
+! Reference: Ramanathan, V. and  P.Downey, 1986: A Nonisothermal
+!            Emissivity and Absorptivity Formulation for Water Vapor
+!            Journal of Geophysical Research, vol. 91., D8, pp 8649-8666
+!
+#ifndef G95
+  real(r8):: coefh(2,4) = reshape(  &
+         (/ (/5.46557e+01,-7.30387e-02/), &
+            (/1.09311e+02,-1.46077e-01/), &
+            (/5.11479e+01,-6.82615e-02/), &
+            (/1.02296e+02,-1.36523e-01/) /), (/2,4/) )
+!
+  real(r8):: coefj(3,2) = reshape( &
+            (/ (/2.82096e-02,2.47836e-04,1.16904e-06/), &
+               (/9.27379e-02,8.04454e-04,6.88844e-06/) /), (/3,2/) )
+!
+  real(r8):: coefk(3,2) = reshape( &
+            (/ (/2.48852e-01,2.09667e-03,2.60377e-06/) , &
+               (/1.03594e+00,6.58620e-03,4.04456e-06/) /), (/3,2/) )
+#else
+! this use of reshape does not work in g95, as of 20061212 jm
+  real(r8):: coefh(2,4)
+  real(r8):: coefj(3,2)
+  real(r8):: coefk(3,2)
+#endif
+
+  integer, parameter :: ntemp = 192 ! Number of temperatures in H2O sat. table for Tp
+  real(r8) :: estblh2o(0:ntemp)       ! saturation vapor pressure for H2O for Tp rang
+  integer, parameter :: o_fa = 6   ! Degree+1 of poly of T_e for absorptivity as U->inf.
+  integer, parameter :: o_fe = 6   ! Degree+1 of poly of T_e for emissivity as U->inf.
+
+!-----------------------------------------------------------------------------
+! Data for f in C/H/E fit -- value of A and E as U->infinity
+! New C/LT/E fit (Hitran 2K, CKD 2.4) -- no change
+!     These values are determined by integrals of Planck functions or
+!     derivatives of Planck functions only.
+!-----------------------------------------------------------------------------
+!
+! fa/fe coefficients for 2 bands (0-800 & 1200-2200, 800-1200 cm^-1)
+!
+! Coefficients of polynomial for f_a in T_e
+!
+#ifndef G95
+  real(r8), parameter:: fat(o_fa,nbands) = reshape( (/ &
+       (/-1.06665373E-01,  2.90617375E-02, -2.70642049E-04,   &   ! 0-800&1200-2200 cm^-1
+          1.07595511E-06, -1.97419681E-09,  1.37763374E-12/), &   !   0-800&1200-2200 cm^-1
+       (/ 1.10666537E+00, -2.90617375E-02,  2.70642049E-04,   &   ! 800-1200 cm^-1
+         -1.07595511E-06,  1.97419681E-09, -1.37763374E-12/) /) & !   800-1200 cm^-1
+       , (/o_fa,nbands/) )
+!
+! Coefficients of polynomial for f_e in T_e
+!
+  real(r8), parameter:: fet(o_fe,nbands) = reshape( (/ &
+      (/3.46148163E-01,  1.51240299E-02, -1.21846479E-04,   &   ! 0-800&1200-2200 cm^-1
+        4.04970123E-07, -6.15368936E-10,  3.52415071E-13/), &   !   0-800&1200-2200 cm^-1
+      (/6.53851837E-01, -1.51240299E-02,  1.21846479E-04,   &   ! 800-1200 cm^-1
+       -4.04970123E-07,  6.15368936E-10, -3.52415071E-13/) /) & !   800-1200 cm^-1
+      , (/o_fa,nbands/) )
+#else
+! this use of reshape does not work in g95, as of 20061212 jm
+  real(r8):: fat(o_fa,nbands)
+  real(r8):: fet(o_fe,nbands)
+#endif
+
+
+      real(r8) ::  gravit     ! Acceleration of gravity (cgs)
+      real(r8) ::  rga        ! 1./gravit
+      real(r8) ::  gravmks    ! Acceleration of gravity (mks)
+      real(r8) ::  cpair      ! Specific heat of dry air
+      real(r8) ::  epsilo     ! Ratio of mol. wght of H2O to dry air
+      real(r8) ::  epsqs      ! Ratio of mol. wght of H2O to dry air
+      real(r8) ::  sslp       ! Standard sea-level pressure
+      real(r8) ::  stebol     ! Stefan-Boltzmann's constant
+      real(r8) ::  rgsslp     ! 0.5/(gravit*sslp)
+      real(r8) ::  dpfo3      ! Voigt correction factor for O3
+      real(r8) ::  dpfco2     ! Voigt correction factor for CO2
+      real(r8) ::  dayspy     ! Number of days per 1 year
+      real(r8) ::  pie        ! 3.14.....
+      real(r8) ::  mwdry      ! molecular weight dry air ~ kg/kmole (shr_const_mwdair)
+      real(r8) ::  scon       ! solar constant (not used in WRF)
+      real(r8) ::  co2mmr
+real(r8) ::   mwco2              ! molecular weight of carbon dioxide
+real(r8) ::   mwh2o              ! molecular weight water vapor (shr_const_mwwv)
+real(r8) ::   mwch4              ! molecular weight ch4
+real(r8) ::   mwn2o              ! molecular weight n2o
+real(r8) ::   mwf11              ! molecular weight cfc11
+real(r8) ::   mwf12              ! molecular weight cfc12
+real(r8) ::   cappa              ! R/Cp
+real(r8) ::   rair               ! Gas constant for dry air (J/K/kg)
+real(r8) ::   tmelt              ! freezing T of fresh water ~ K
+real(r8) ::   r_universal        ! Universal gas constant ~ J/K/kmole
+real(r8) ::   latvap             ! latent heat of evaporation ~ J/kg
+real(r8) ::   latice             ! latent heat of fusion ~ J/kg
+real(r8) ::   zvir               ! R_V/R_D - 1.
+  integer plenest  ! length of saturation vapor pressure table
+  parameter (plenest=250)
+! 
+! Table of saturation vapor pressure values es from tmin degrees
+! to tmax+1 degrees k in one degree increments.  ttrice defines the
+! transition region where es is a combination of ice & water values
+!
+real(r8) estbl(plenest)      ! table values of saturation vapor pressure
+real(r8) tmin       ! min temperature (K) for table
+real(r8) tmax       ! max temperature (K) for table
+real(r8) pcf(6)     ! polynomial coeffs -> es transition water to ice
+!real(r8), allocatable :: pin(:)           ! ozone pressure level (levsiz)
+!real(r8), allocatable :: ozmix(:,:,:)     ! mixing ratio
+!real(r8), allocatable, target :: abstot_3d(:,:,:,:) ! Non-adjacent layer absorptivites
+!real(r8), allocatable, target :: absnxt_3d(:,:,:,:) ! Nearest layer absorptivities
+!real(r8), allocatable, target :: emstot_3d(:,:,:)   ! Total emissivity
+
+!From aer_optics.F90 module
+integer, parameter :: idxVIS = 8     ! index to visible band
+integer, parameter :: nrh = 1000   ! number of relative humidity values for look-up-table
+integer, parameter :: nspint = 19   ! number of spectral intervals
+real(r8) :: ksul(nrh, nspint)    ! sulfate specific extinction  ( m^2 g-1 )
+real(r8) :: wsul(nrh, nspint)    ! sulfate single scattering albedo
+real(r8) :: gsul(nrh, nspint)    ! sulfate asymmetry parameter
+real(r8) :: kbg(nspint)          ! background specific extinction  ( m^2 g-1 )
+real(r8) :: wbg(nspint)          ! background single scattering albedo
+real(r8) :: gbg(nspint)          ! background asymmetry parameter
+real(r8) :: ksslt(nrh, nspint)   ! sea-salt specific extinction  ( m^2 g-1 )
+real(r8) :: wsslt(nrh, nspint)   ! sea-salt single scattering albedo
+real(r8) :: gsslt(nrh, nspint)   ! sea-salt asymmetry parameter
+real(r8) :: kcphil(nrh, nspint)  ! hydrophilic carbon specific extinction  ( m^2 g-1 )
+real(r8) :: wcphil(nrh, nspint)  ! hydrophilic carbon single scattering albedo
+real(r8) :: gcphil(nrh, nspint)  ! hydrophilic carbon asymmetry parameter
+real(r8) :: kcphob(nspint)       ! hydrophobic carbon specific extinction  ( m^2 g-1 )
+real(r8) :: wcphob(nspint)       ! hydrophobic carbon single scattering albedo
+real(r8) :: gcphob(nspint)       ! hydrophobic carbon asymmetry parameter
+real(r8) :: kcb(nspint)          ! black carbon specific extinction  ( m^2 g-1 )
+real(r8) :: wcb(nspint)          ! black carbon single scattering albedo
+real(r8) :: gcb(nspint)          ! black carbon asymmetry parameter
+real(r8) :: kvolc(nspint)        ! volcanic specific extinction  ( m^2 g-1)
+real(r8) :: wvolc(nspint)        ! volcanic single scattering albedo
+real(r8) :: gvolc(nspint)        ! volcanic asymmetry parameter
+real(r8) :: kdst(ndstsz, nspint) ! dust specific extinction  ( m^2 g-1 )
+real(r8) :: wdst(ndstsz, nspint) ! dust single scattering albedo
+real(r8) :: gdst(ndstsz, nspint) ! dust asymmetry parameter
+!
+!From comozp.F90 module
+      real(r8) cplos    ! constant for ozone path length integral
+      real(r8) cplol    ! constant for ozone path length integral
+
+!From ghg_surfvals.F90 module
+   real(r8) :: co2vmr = 3.550e-4         ! co2   volume mixing ratio
+   real(r8) :: n2ovmr = 0.311e-6         ! n2o   volume mixing ratio
+   real(r8) :: ch4vmr = 1.714e-6         ! ch4   volume mixing ratio
+   real(r8) :: f11vmr = 0.280e-9         ! cfc11 volume mixing ratio
+   real(r8) :: f12vmr = 0.503e-9         ! cfc12 volume mixing ratio
+
+
+      integer  :: ntoplw      ! top level to solve for longwave cooling (WRF sets this to 1 for model top below 10 mb)
+
+      logical :: masterproc = .true.
+      logical :: ozncyc            ! true => cycle ozone dataset
+      logical :: dosw              ! True => shortwave calculation this timestep
+      logical :: dolw              ! True => longwave calculation this timestep
+      logical :: indirect          ! True => include indirect radiative effects of sulfate aerosols
+!     logical :: doabsems          ! True => abs/emiss calculation this timestep
+      logical :: radforce   = .false.          ! True => calculate aerosol shortwave forcing
+      logical :: trace_gas=.false.             ! set true for chemistry
+      logical :: strat_volcanic   = .false.    ! True => volcanic aerosol mass available
+ 
+
+CONTAINS
+
+subroutine camrad(RTHRATENLW,RTHRATENSW,                           &
+                     SWUPT,SWUPTC,SWDNT,SWDNTC,                    &
+                     LWUPT,LWUPTC,LWDNT,LWDNTC,                    &
+                     SWUPB,SWUPBC,SWDNB,SWDNBC,                    &
+                     LWUPB,LWUPBC,LWDNB,LWDNBC,                    &
+                     swcf,lwcf,olr,cemiss,taucldc,taucldi,coszr,   &
+                     GSW,GLW,XLAT,XLONG,                           &
+                     ALBEDO,t_phy,TSK,EMISS,                       &
+                     QV3D,QC3D,QR3D,QI3D,QS3D,QG3D,                &
+                     F_QV,F_QC,F_QR,F_QI,F_QS,F_QG,                &
+                     f_ice_phy,f_rain_phy,                         &
+                     p_phy,p8w,z,pi_phy,rho_phy,dz8w,               &
+                     CLDFRA,XLAND,XICE,SNOW,                        &
+                     ozmixm,pin0,levsiz,num_months,                 &
+                     m_psp,m_psn,aerosolcp,aerosolcn,m_hybi0,       &
+                     cam_abs_dim1, cam_abs_dim2,                    &
+                     paerlev,naer_c,                                &
+                     GMT,JULDAY,JULIAN,DT,XTIME,DECLIN,SOLCON,         &
+                     RADT,DEGRAD,n_cldadv,                                  &
+                     abstot_3d, absnxt_3d, emstot_3d,              &
+                     doabsems,                                     &
+                     ids,ide, jds,jde, kds,kde,                    &
+                     ims,ime, jms,jme, kms,kme,                    &
+                     its,ite, jts,jte, kts,kte                     )
+
+   USE module_wrf_error
+
+!------------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------------
+
+   INTEGER,    INTENT(IN   ) ::        ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte
+   LOGICAL,    INTENT(IN   ) ::        F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
+   LOGICAL,    INTENT(INout) ::        doabsems
+
+   INTEGER,    INTENT(IN  )  ::        n_cldadv
+   INTEGER,    INTENT(IN  )  ::        JULDAY
+   REAL,       INTENT(IN  )  ::        JULIAN
+   REAL,       INTENT(IN  )  ::        DT
+   INTEGER,      INTENT(IN   )    ::   levsiz, num_months
+   INTEGER,      INTENT(IN   )    ::   paerlev, naer_c
+   INTEGER,      INTENT(IN   )    ::   cam_abs_dim1, cam_abs_dim2
+
+
+   REAL, INTENT(IN    )      ::        RADT,DEGRAD,             &
+                                       XTIME,DECLIN,SOLCON,GMT
+!
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(IN    ) ::                                   P_PHY, &
+                                                           P8W, &
+                                                             Z, &
+                                                            pi_PHY, &
+                                                           rho_PHY, &
+                                                              dz8w, &
+                                                             T_PHY, &
+                                                            QV3D, &
+                                                            QC3D, &
+                                                            QR3D, &
+                                                            QI3D, &
+                                                            QS3D, &
+                                                            QG3D, &
+                                                        CLDFRA
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(INOUT)  ::                              RTHRATENLW, &
+                                                        RTHRATENSW
+!
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(IN   )  ::                                  XLAT, &
+                                                           XLONG, &
+                                                           XLAND, &
+                                                           XICE, &
+                                                           SNOW, &
+                                                           EMISS, &
+                                                             TSK, &
+                                                             ALBEDO
+
+   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, num_months ),      &
+          INTENT(IN   ) ::                                  OZMIXM
+
+   REAL,  DIMENSION(levsiz), INTENT(IN )  ::                   PIN0
+
+   REAL,  DIMENSION(ims:ime,jms:jme), INTENT(IN )  ::      m_psp,m_psn
+   REAL,  DIMENSION(paerlev), intent(in)             ::      m_hybi0
+   REAL,  DIMENSION( ims:ime, paerlev, jms:jme, naer_c ),      &
+          INTENT(IN   ) ::                    aerosolcp, aerosolcn
+
+!
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(INOUT)  ::                                   GSW, GLW
+
+! saving arrays for doabsems reduction of radiation calcs
+
+   REAL, DIMENSION( ims:ime, kms:kme, cam_abs_dim2 , jms:jme ),           &
+         INTENT(INOUT)  ::                                  abstot_3d
+   REAL, DIMENSION( ims:ime, kms:kme, cam_abs_dim1 , jms:jme ),           &
+         INTENT(INOUT)  ::                                  absnxt_3d
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),           &
+         INTENT(INOUT)  ::                                  emstot_3d
+
+
+! Added outputs of total and clearsky fluxes etc
+! Note that k=1 refers to the half level below the model lowest level (Sfc)
+!           k=kme refers to the half level above the model highest level (TOA)
+!
+!   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                &
+!         INTENT(INOUT)  ::                                  swup, &
+!                                                       swupclear, &
+!                                                            swdn, &
+!                                                       swdnclear, &
+!                                                            lwup, &
+!                                                       lwupclear, &
+!                                                            lwdn, &
+!                                                       lwdnclear
+
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::&
+                    SWUPT,SWUPTC,SWDNT,SWDNTC,                    &
+                    LWUPT,LWUPTC,LWDNT,LWDNTC,                    &
+                    SWUPB,SWUPBC,SWDNB,SWDNBC,                    &
+                    LWUPB,LWUPBC,LWDNB,LWDNBC
+
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(INOUT)  ::                                  swcf, &
+                                                            lwcf, &
+                                                             olr, &
+                                                            coszr    
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
+         INTENT(OUT   )  ::                               cemiss, &        ! cloud emissivity for isccp
+                                                         taucldc, &        ! cloud water optical depth for isccp
+                                                         taucldi           ! cloud ice optical depth for isccp
+!
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                     &
+         INTENT(IN   ) ::                                            &
+                                                          F_ICE_PHY, &
+                                                         F_RAIN_PHY
+
+
+! LOCAL VARIABLES
+ 
+   INTEGER :: lchnk, ncol, pcols, pver, pverp, pverr, pverrp
+   INTEGER :: pcnst, pnats, ppcnst, i, j, k, ii, kk, kk1, m, n
+   integer :: begchunk, endchunk
+
+   REAL :: XT24, TLOCTM, HRANG, XXLAT, oldXT24
+ 
+   real(r8), DIMENSION( 1:ite-its+1 ) :: coszrs, landfrac, landm, snowh, icefrac, lwups
+   real(r8), DIMENSION( 1:ite-its+1 ) :: asdir, asdif, aldir, aldif, ps
+   real(r8), DIMENSION( 1:ite-its+1, 1:kte-kts+1 ) :: cld, pmid, lnpmid, pdel, zm, t
+   real(r8), DIMENSION( 1:ite-its+1, 1:kte-kts+2 ) ::  pint, lnpint
+   real(r8), DIMENSION( its:ite , kts:kte+1 ) :: phyd
+   real(r8), DIMENSION( its:ite , kts:kte   ) :: phydmid
+   real(r8), DIMENSION( its:ite ) :: fp
+   real(r8), DIMENSION( 1:ite-its+1, 1:kte-kts+1, n_cldadv) :: q
+!   real(r8), DIMENSION( 1:kte-kts+1 ) :: hypm       ! reference pressures at midpoints
+!   real(r8), DIMENSION( 1:kte-kts+2 ) :: hypi       ! reference pressures at interfaces
+    real(r8), dimension(  1:ite-its+1, 1:kte-kts+1 ) :: cicewp      ! in-cloud cloud ice water path
+    real(r8), dimension(  1:ite-its+1, 1:kte-kts+1 ) :: cliqwp      ! in-cloud cloud liquid water path
+    real(r8), dimension(  1:ite-its+1, 0:kte-kts+1 ) :: tauxcl      ! cloud water optical depth
+    real(r8), dimension(  1:ite-its+1, 0:kte-kts+1 ) :: tauxci      ! cloud ice optical depth
+    real(r8), dimension(  1:ite-its+1, 1:kte-kts+1 ) :: emis        ! cloud emissivity
+    real(r8), dimension(  1:ite-its+1, 1:kte-kts+1 ) :: rel         ! effective drop radius (microns)
+    real(r8), dimension(  1:ite-its+1, 1:kte-kts+1 ) :: rei         ! ice effective drop size (microns)
+    real(r8), dimension(  1:ite-its+1, 1:kte-kts+2 ) :: pmxrgn      ! Maximum values of pressure for each
+    integer , dimension(  1:ite-its+1 ) :: nmxrgn               ! Number of maximally overlapped regions
+
+   real(r8), dimension(  1:ite-its+1 ) :: fsns          ! Surface absorbed solar flux
+   real(r8), dimension(  1:ite-its+1 ) :: fsnt          ! Net column abs solar flux at model top
+   real(r8), dimension(  1:ite-its+1 ) :: flns          ! Srf longwave cooling (up-down) flux
+   real(r8), dimension(  1:ite-its+1 ) :: flnt          ! Net outgoing lw flux at model top
+! Added outputs of total and clearsky fluxes etc
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+2 )  :: fsup        ! Upward total sky solar
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+2 )  :: fsupc       ! Upward clear sky solar
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+2 )  :: fsdn        ! Downward total sky solar
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+2 )  :: fsdnc       ! Downward clear sky solar
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+2 )  :: flup        ! Upward total sky longwave
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+2 )  :: flupc       ! Upward clear sky longwave
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+2 )  :: fldn        ! Downward total sky longwave
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+2 )  :: fldnc       ! Downward clear sky longwave
+   real(r8), dimension(  1:ite-its+1 ) :: swcftoa                 ! Top of the atmosphere solar cloud forcing
+   real(r8), dimension(  1:ite-its+1 ) :: lwcftoa                 ! Top of the atmosphere longwave cloud forcing
+   real(r8), dimension(  1:ite-its+1 ) :: olrtoa                  ! Top of the atmosphere outgoing longwave 
+!
+   real(r8), dimension(  1:ite-its+1 ) :: sols          ! Downward solar rad onto surface (sw direct)
+   real(r8), dimension(  1:ite-its+1 ) :: soll          ! Downward solar rad onto surface (lw direct)
+   real(r8), dimension(  1:ite-its+1 ) :: solsd         ! Downward solar rad onto surface (sw diffuse)
+   real(r8), dimension(  1:ite-its+1 ) :: solld         ! Downward solar rad onto surface (lw diffuse)
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+1 ) :: qrs      ! Solar heating rate
+   real(r8), dimension(  1:ite-its+1 ) :: fsds          ! Flux Shortwave Downwelling Surface
+   real(r8), dimension(  1:ite-its+1, 1:kte-kts+1 ) :: qrl      ! Longwave cooling rate
+   real(r8), dimension(  1:ite-its+1 ) :: flwds          ! Surface down longwave flux
+   real(r8), dimension(  1:ite-its+1, levsiz, num_months ) :: ozmixmj        ! monthly ozone mixing ratio
+   real(r8), dimension(  1:ite-its+1, levsiz ) :: ozmix          ! ozone mixing ratio (time interpolated)
+   real(r8), dimension(levsiz)         :: pin            ! ozone pressure level
+   real(r8), dimension(1:ite-its+1)    :: m_psjp,m_psjn          ! MATCH surface pressure
+   real(r8), dimension(  1:ite-its+1, paerlev, naer_c ) :: aerosoljp        ! monthly aerosol concentrations
+   real(r8), dimension(  1:ite-its+1, paerlev, naer_c ) :: aerosoljn        ! monthly aerosol concentrations
+   real(r8), dimension(paerlev)                           :: m_hybi
+   real(r8), dimension(1:ite-its+1 )          :: clat           ! latitude in radians for columns
+   real(r8), dimension(its:ite,kts:kte+1,kts:kte+1) :: abstot ! Total absorptivity
+   real(r8), dimension(its:ite,kts:kte,4)           :: absnxt ! Total nearest layer absorptivity
+   real(r8), dimension(its:ite,kts:kte+1)           :: emstot ! Total emissivity
+   CHARACTER(LEN=256) :: msgstr
+
+#if !defined(MAC_KLUDGE) && !defined(G95)
+   lchnk = 1
+   begchunk = ims
+   endchunk = ime
+   ncol = ite - its + 1
+   pcols= ite - its + 1
+   pver = kte - kts + 1
+   pverp= pver + 1
+   pverr = kte - kts + 1
+   pverrp= pverr + 1
+! number of advected constituents and non-advected constituents (including water vapor)
+   ppcnst = n_cldadv
+! number of non-advected constituents
+   pnats = 0
+   pcnst = ppcnst-pnats
+
+! check the # species defined for the input climatology and naer
+
+!  if(naer_c.ne.naer) then
+!            WRITE( wrf_err_message , * ) 'naer_c ne naer ', naer_c, naer
+   if(naer_c.ne.naer_all) then
+             WRITE( wrf_err_message , * ) 'naer_c-1 ne naer_all ', naer_c, naer_all
+             CALL wrf_error_fatal ( wrf_err_message )
+   endif 
+!
+!===================================================
+! Radiation computations
+!===================================================
+
+      do k=1,levsiz
+      pin(k)=pin0(k)
+      enddo
+
+      do k=1,paerlev
+      m_hybi(k)=m_hybi0(k)
+      enddo
+
+! check for uninitialized arrays
+      if(abstot_3d(its,kts,kts,jts) .eq. 0.0 .and. .not.doabsems)then
+        CALL wrf_debug(0, 'camrad lw: CAUTION: re-calculating abstot, absnxt, emstot on restart')
+        doabsems = .true.
+      endif
+
+   do j =jts,jte
+
+!
+! Cosine solar zenith angle for current time step
+!
+
+!  call zenith (calday, clat, clon, coszrs, ncol)
+
+      do i = its,ite
+      ii = i - its + 1
+      ! XT24 is the fractional part of simulation days plus half of RADT expressed in 
+      ! units of minutes
+      ! JULIAN is in days
+      ! RADT is in minutes
+      XT24=MOD(XTIME+RADT*0.5,1440.)
+      TLOCTM=GMT+XT24/60.+XLONG(I,J)/15.
+      HRANG=15.*(TLOCTM-12.)*DEGRAD
+      XXLAT=XLAT(I,J)*DEGRAD
+      clat(ii)=xxlat
+      coszrs(II)=SIN(XXLAT)*SIN(DECLIN)+COS(XXLAT)*COS(DECLIN)*COS(HRANG)
+      enddo
+
+! moist variables
+
+      do k = kts,kte
+      kk = kte - k + kts 
+      do i = its,ite
+      ii = i - its + 1
+      q(ii,kk,1) = max(1.e-10,qv3d(i,k,j))
+     IF ( F_QI .and. F_QC .and. F_QS ) THEN
+      q(ii,kk,ixcldliq) = max(0.,qc3d(i,k,j))
+      q(ii,kk,ixcldice) = max(0.,qi3d(i,k,j)+qs3d(i,k,j))
+     ELSE IF ( F_QC .and. F_QR ) THEN
+! Warm rain or simple ice
+      q(ii,kk,ixcldliq) = 0.
+      q(ii,kk,ixcldice) = 0.
+      if(t_phy(i,k,j).gt.273.15)q(ii,kk,ixcldliq) = max(0.,qc3d(i,k,j))
+      if(t_phy(i,k,j).le.273.15)q(ii,kk,ixcldice) = max(0.,qi3d(i,k,j))
+     ELSE IF ( F_QC ) THEN
+! For Ferrier
+      q(ii,kk,ixcldice) = max(0.,qc3d(i,k,j)*f_ice_phy(i,k,j))
+      q(ii,kk,ixcldliq) = max(0.,qc3d(i,k,j)*(1.-f_ice_phy(i,k,j))*(1.-f_rain_phy(i,k,j)))
+     ELSE
+      q(ii,kk,ixcldliq) = 0.
+      q(ii,kk,ixcldice) = 0.
+     ENDIF
+      cld(ii,kk) = CLDFRA(I,K,J)
+      enddo
+      enddo
+
+      do i = its,ite
+      ii = i - its + 1
+      landfrac(ii) = 2.-XLAND(I,J)
+      landm(ii) = landfrac(ii)
+      snowh(ii) = 0.001*SNOW(I,J)
+      icefrac(ii) = XICE(I,J)
+      enddo
+
+      do m=1,num_months
+      do k=1,levsiz
+      do i = its,ite
+      ii = i - its + 1
+      ozmixmj(ii,k,m) = ozmixm(i,k,j,m)
+      enddo
+      enddo
+      enddo
+
+      do i = its,ite
+      ii = i - its + 1
+      m_psjp(ii) = m_psp(i,j)
+      m_psjn(ii) = m_psn(i,j)
+      enddo
+
+      do n=1,naer_c
+      do k=1,paerlev
+      do i = its,ite
+      ii = i - its + 1
+      aerosoljp(ii,k,n) = aerosolcp(i,k,j,n)
+      aerosoljn(ii,k,n) = aerosolcn(i,k,j,n)
+      enddo
+      enddo
+      enddo
+
+!
+! Complete radiation calculations
+!
+      do i = its,ite
+      ii = i - its + 1
+      lwups(ii) = stebol*EMISS(I,J)*TSK(I,J)**4
+      enddo
+
+! first guess
+      do k = kts,kte+1
+      do i = its,ite
+      if(k.eq.kts)then
+        phyd(i,k)=p8w(i,kts,j)
+      else
+        phyd(i,k)=phyd(i,k-1) - gravmks*rho_phy(i,k-1,j)*dz8w(i,k-1,j)
+      endif
+      enddo
+      enddo
+
+! correction factor FP to match p8w(I,kts,J)-p8w(I,kte+1,J)
+      do i = its,ite
+        fp(i)=(p8w(I,kts,J)-p8w(I,kte+1,J))/(PHYD(i,KTS)-PHYD(i,KTE+1))
+      enddo
+
+! final pass
+      do k = kts+1,kte+1
+      do i = its,ite
+        phyd(i,k)=phyd(i,k-1) - gravmks*rho_phy(i,k-1,j)*dz8w(i,k-1,j)*fp(i)
+        phydmid(i,k-1)=0.5*(phyd(i,k-1)+phyd(i,k))
+      enddo
+      enddo
+
+      do k = kts,kte+1
+      kk = kte - k + kts + 1
+      do i = its,ite
+      ii = i - its + 1
+      pint(ii,kk) = phyd(i,k)
+      if(k.eq.kts)ps(ii)=pint(ii,kk)
+      lnpint(ii,kk) = log(pint(ii,kk))
+      enddo
+      enddo
+
+      if(.not.doabsems)then
+!      do kk = kts,kte+1
+      do kk = 1,cam_abs_dim2
+        do kk1 = kts,kte+1
+          do i = its,ite
+            abstot(i,kk1,kk) = abstot_3d(i,kk1,kk,j)
+          enddo
+        enddo
+      enddo
+!      do kk = 1,4
+      do kk = 1,cam_abs_dim1
+        do kk1 = kts,kte
+          do i = its,ite
+            absnxt(i,kk1,kk) = absnxt_3d(i,kk1,kk,j)
+          enddo
+        enddo
+      enddo
+      do kk = kts,kte+1
+          do i = its,ite
+            emstot(i,kk) = emstot_3d(i,kk,j)
+          enddo
+      enddo
+      endif
+
+      do k = kts,kte
+      kk = kte - k + kts 
+      do i = its,ite
+      ii = i - its + 1
+      pmid(ii,kk) = phydmid(i,k)
+      lnpmid(ii,kk) = log(pmid(ii,kk))
+      lnpint(ii,kk) = log(pint(ii,kk))
+      pdel(ii,kk) = pint(ii,kk+1) - pint(ii,kk)
+      t(ii,kk) = t_phy(i,k,j)
+      zm(ii,kk) = z(i,k,j)
+      enddo
+      enddo
+
+
+! Compute cloud water/ice paths and optical properties for input to radiation
+
+      call param_cldoptics_calc(ncol, pcols, pver, pverp, pverr, pverrp, ppcnst, q, cld, landfrac, landm,icefrac, &
+                                pdel, t, ps, pmid, pint, cicewp, cliqwp, emis, rel, rei, pmxrgn, nmxrgn, snowh)
+
+      do i = its,ite
+      ii = i - its + 1
+! use same albedo for direct and diffuse
+! change this when separate values are provided
+      asdir(ii) = albedo(i,j)
+      asdif(ii) = albedo(i,j)
+      aldir(ii) = albedo(i,j)
+      aldif(ii) = albedo(i,j)
+      enddo
+
+! WRF allocate space here (not needed if oznini is called)
+!  allocate (ozmix(pcols,levsiz,begchunk:endchunk)) ! This line from oznini.F90
+
+      call radctl (j,lchnk, ncol, pcols, pver, pverp, pverr, pverrp, ppcnst, pcnst, lwups, emis, pmid,             &
+                   pint, lnpmid, lnpint, pdel, t, q,   &
+                   cld, cicewp, cliqwp, tauxcl, tauxci, coszrs, clat, asdir, asdif,               &
+                   aldir, aldif, solcon, GMT,JULDAY,JULIAN,DT,XTIME,   &
+                   pin, ozmixmj, ozmix, levsiz, num_months,  & 
+                   m_psjp,m_psjn, aerosoljp, aerosoljn,  m_hybi, paerlev, naer_c, pmxrgn, nmxrgn, &
+                   doabsems, abstot, absnxt, emstot, &
+                   fsup, fsupc, fsdn, fsdnc, flup, flupc, fldn, fldnc, swcftoa, lwcftoa, olrtoa,  &
+                   fsns, fsnt    ,flns    ,flnt    , &
+                   qrs, qrl, flwds, rel, rei,                       &
+                   sols, soll, solsd, solld,                  &
+                   landfrac, zm, fsds)
+
+      do k = kts,kte
+      kk = kte - k + kts 
+      do i = its,ite
+      ii = i - its + 1
+      RTHRATENLW(I,K,J) = 1.e4*qrl(ii,kk)/(cpair*pi_phy(i,k,j))
+      RTHRATENSW(I,K,J) = 1.e4*qrs(ii,kk)/(cpair*pi_phy(i,k,j))
+      cemiss(i,k,j)     = emis(ii,kk)
+      taucldc(i,k,j)    = tauxcl(ii,kk)
+      taucldi(i,k,j)    = tauxci(ii,kk)
+      enddo
+      enddo
+
+      if(doabsems)then
+!      do kk = kts,kte+1
+      do kk = 1,cam_abs_dim2
+        do kk1 = kts,kte+1
+          do i = its,ite
+            abstot_3d(i,kk1,kk,j) = abstot(i,kk1,kk)
+          enddo
+        enddo
+      enddo
+!      do kk = 1,4
+      do kk = 1,cam_abs_dim1
+        do kk1 = kts,kte
+          do i = its,ite
+            absnxt_3d(i,kk1,kk,j) = absnxt(i,kk1,kk)
+          enddo
+        enddo
+      enddo
+      do kk = kts,kte+1
+          do i = its,ite
+            emstot_3d(i,kk,j) = emstot(i,kk)
+          enddo
+      enddo
+      endif
+
+      IF(PRESENT(SWUPT))THEN
+! Added shortwave and longwave upward/downward total and clear sky fluxes
+      do k = kts,kte+1
+      kk = kte +1 - k + kts
+      do i = its,ite
+      ii = i - its + 1
+!      swup(i,k,j)      = fsup(ii,kk)
+!      swupclear(i,k,j) = fsupc(ii,kk)
+!      swdn(i,k,j)      = fsdn(ii,kk)
+!      swdnclear(i,k,j) = fsdnc(ii,kk)
+!      lwup(i,k,j)      = flup(ii,kk)
+!      lwupclear(i,k,j) = flupc(ii,kk)
+!      lwdn(i,k,j)      = fldn(ii,kk)
+!      lwdnclear(i,k,j) = fldnc(ii,kk)
+       if(k.eq.kte+1)then
+         swupt(i,j)     = fsup(ii,kk)
+         swuptc(i,j)    = fsupc(ii,kk)
+         swdnt(i,j)     = fsdn(ii,kk)
+         swdntc(i,j)    = fsdnc(ii,kk)
+         lwupt(i,j)     = fsup(ii,kk)
+         lwuptc(i,j)    = fsupc(ii,kk)
+         lwdnt(i,j)     = fsdn(ii,kk)
+         lwdntc(i,j)    = fsdnc(ii,kk)
+       endif
+       if(k.eq.kts)then
+         swupb(i,j)     = fsup(ii,kk)
+         swupbc(i,j)    = fsupc(ii,kk)
+         swdnb(i,j)     = fsdn(ii,kk)
+         swdnbc(i,j)    = fsdnc(ii,kk)
+         lwupb(i,j)     = fsup(ii,kk)
+         lwupbc(i,j)    = fsupc(ii,kk)
+         lwdnb(i,j)     = fsdn(ii,kk)
+         lwdnbc(i,j)    = fsdnc(ii,kk)
+       endif
+!            if(i.eq.30.and.j.eq.30) then
+!            print 1234, 'short ', i,ii,k,kk,fsup(ii,kk),fsupc(ii,kk),fsdn(ii,kk),fsdnc(ii,kk)
+!            print 1234, 'long  ', i,ii,k,kk,flup(ii,kk),flupc(ii,kk),fldn(ii,kk),fldnc(ii,kk)
+!            1234 format (a6,4i4,4f10.3)
+!            endif
+      enddo
+      enddo
+      ENDIF
+
+      do i = its,ite
+      ii = i - its + 1
+      GLW(I,J) = flwds(ii)
+      GSW(I,J) = fsns(ii)
+! Added shortwave and longwave cloud forcing at TOA
+      swcf(i,j) = swcftoa(ii)
+      lwcf(i,j) = lwcftoa(ii)
+      olr(i,j)  = olrtoa(ii)
+      coszr(i,j) = coszrs(ii)
+      enddo
+
+    enddo    ! j-loop
+
+#endif
+
+end subroutine camrad
+!====================================================================
+   SUBROUTINE camradinit(                                           &
+                         R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop,               &
+                         ozmixm,pin,levsiz,XLAT,num_months,         &
+                         m_psp,m_psn,m_hybi,aerosolcp,aerosolcn,    &
+                         paerlev,naer_c,                            &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte                   )
+
+   USE module_wrf_error
+   USE module_configure
+
+!--------------------------------------------------------------------
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,  &
+                                     ims, ime, jms, jme, kms, kme,  &
+                                     its, ite, jts, jte, kts, kte
+   REAL, intent(in)               :: pptop
+   REAL, INTENT(IN)               :: R_D,R_V,CP,G,STBOLT,EP_2
+
+   REAL,     DIMENSION( kms:kme )  :: shalf
+
+   INTEGER,      INTENT(IN   )    ::   levsiz, num_months
+   INTEGER,      INTENT(IN   )    ::   paerlev, naer_c
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   )  :: XLAT
+
+   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, num_months ),      &
+          INTENT(INOUT   ) ::                                  OZMIXM
+
+   REAL,  DIMENSION(levsiz), INTENT(INOUT )  ::                   PIN
+   REAL,  DIMENSION(ims:ime, jms:jme), INTENT(INOUT )  ::                  m_psp,m_psn
+   REAL,  DIMENSION(paerlev), INTENT(INOUT )  ::               m_hybi
+   REAL,  DIMENSION( ims:ime, paerlev, jms:jme, naer_c ),      &
+          INTENT(INOUT) ::                             aerosolcp,aerosolcn
+
+   REAL(r8)    :: pstd
+   REAL(r8)    :: rh2o, cpair
+
+#if !defined(MAC_KLUDGE) && !defined(G95)
+   ozncyc = .true.
+   dosw = .true.
+   dolw = .true.
+   indirect = .true.
+   ixcldliq = 2
+   ixcldice = 3
+#if (NMM_CORE != 1)
+! aerosol array is not in the NMM Registry 
+!   since CAM radiation not available to NMM (yet)
+!   so this is blocked out to enable CAM compilation with NMM
+   idxSUL = P_SUL
+   idxSSLT = P_SSLT
+   idxDUSTfirst = P_DUST1
+   idxOCPHO = P_OCPHO
+   idxCARBONfirst = P_OCPHO
+   idxBCPHO = P_BCPHO
+   idxOCPHI = P_OCPHI
+   idxBCPHI = P_BCPHI
+   idxBG = P_BG
+   idxVOLC = P_VOLC
+#endif
+
+   pstd = 101325.0
+! from physconst module
+   mwdry = 28.966            ! molecular weight dry air ~ kg/kmole (shr_const_mwdair)
+   mwco2 =  44.              ! molecular weight co2
+   mwh2o = 18.016            ! molecular weight water vapor (shr_const_mwwv)
+   mwch4 =  16.              ! molecular weight ch4
+   mwn2o =  44.              ! molecular weight n2o
+   mwf11 = 136.              ! molecular weight cfc11
+   mwf12 = 120.              ! molecular weight cfc12
+   cappa = R_D/CP
+   rair = R_D
+   tmelt = 273.16            ! freezing T of fresh water ~ K 
+   r_universal = 6.02214e26 * STBOLT   ! Universal gas constant ~ J/K/kmole
+   latvap = 2.501e6          ! latent heat of evaporation ~ J/kg
+   latice = 3.336e5          ! latent heat of fusion ~ J/kg
+   zvir = R_V/R_D - 1.
+   rh2o = R_V
+   cpair = CP
+!
+   epsqs = EP_2
+
+   CALL radini(G, CP, EP_2, STBOLT, pstd*10.0 )
+   CALL esinti(epsqs  ,latvap  ,latice  ,rh2o    ,cpair   ,tmelt   )
+   CALL oznini(ozmixm,pin,levsiz,num_months,XLAT,                   &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte)                   
+   CALL aerosol_init(m_psp,m_psn,m_hybi,aerosolcp,aerosolcn,paerlev,naer_c,shalf,pptop,    &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte)
+
+#endif
+
+   END SUBROUTINE camradinit
+
+#if !defined(MAC_KLUDGE) && !defined(G95)
+subroutine oznini(ozmixm,pin,levsiz,num_months,XLAT,                &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte)
+!
+! This subroutine assumes uniform distribution of ozone concentration.
+! It should be replaced by monthly climatology that varies latitudinally and vertically
+!
+
+      IMPLICIT NONE
+
+   INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte   
+
+   INTEGER,      INTENT(IN   )    ::   levsiz, num_months
+
+   REAL,  DIMENSION( ims:ime, jms:jme ), INTENT(IN   )  ::     XLAT
+
+   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, num_months ),      &
+          INTENT(OUT   ) ::                                  OZMIXM
+
+   REAL,  DIMENSION(levsiz), INTENT(OUT )  ::                   PIN
+
+! Local
+   INTEGER, PARAMETER :: latsiz = 64
+   INTEGER, PARAMETER :: lonsiz = 1
+   INTEGER :: i, j, k, itf, jtf, ktf, m, pin_unit, lat_unit, oz_unit
+   REAL    :: interp_pt
+   CHARACTER*256 :: message
+
+   REAL,  DIMENSION( lonsiz, levsiz, latsiz, num_months )    ::   &
+                                                            OZMIXIN
+
+   REAL,  DIMENSION(latsiz)                ::             lat_ozone
+
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+
+
+!-- read in ozone pressure data
+
+     WRITE(message,*)'num_months = ',num_months
+     CALL wrf_debug(50,message)
+
+      pin_unit = 27
+        OPEN(pin_unit, FILE='ozone_plev.formatted',FORM='FORMATTED',STATUS='OLD')
+        do k = 1,levsiz
+        READ (pin_unit,*)pin(k)
+        end do
+      close(27)
+
+      do k=1,levsiz
+        pin(k) = pin(k)*100.
+      end do
+
+!-- read in ozone lat data
+
+      lat_unit = 28
+        OPEN(lat_unit, FILE='ozone_lat.formatted',FORM='FORMATTED',STATUS='OLD')
+        do j = 1,latsiz
+        READ (lat_unit,*)lat_ozone(j)
+        end do
+      close(28)
+
+
+!-- read in ozone data
+
+      oz_unit = 29
+      OPEN(oz_unit, FILE='ozone.formatted',FORM='FORMATTED',STATUS='OLD')
+
+      do m=2,num_months
+      do j=1,latsiz ! latsiz=64
+      do k=1,levsiz ! levsiz=59
+      do i=1,lonsiz ! lonsiz=1
+        READ (oz_unit,*)ozmixin(i,k,j,m)
+      enddo
+      enddo
+      enddo
+      enddo
+      close(29)
+
+
+!-- latitudinally interpolate ozone data (and extend longitudinally)
+!-- using function lin_interpol2(x, f, y) result(g)
+! Purpose:
+!   interpolates f(x) to point y
+!   assuming f(x) = f(x0) + a * (x - x0)
+!   where a = ( f(x1) - f(x0) ) / (x1 - x0)
+!   x0 <= x <= x1
+!   assumes x is monotonically increasing
+!    real, intent(in), dimension(:) :: x  ! grid points
+!    real, intent(in), dimension(:) :: f  ! grid function values
+!    real, intent(in) :: y                ! interpolation point
+!    real :: g                            ! interpolated function value
+!---------------------------------------------------------------------------
+
+      do m=2,num_months
+      do j=jts,jtf
+      do k=1,levsiz
+      do i=its,itf
+         interp_pt=XLAT(i,j)
+         ozmixm(i,k,j,m)=lin_interpol2(lat_ozone(:),ozmixin(1,k,:,m),interp_pt)
+      enddo
+      enddo
+      enddo
+      enddo
+
+! Old code for fixed ozone
+
+!     pin(1)=70.
+!     DO k=2,levsiz
+!     pin(k)=pin(k-1)+16.
+!     ENDDO
+
+!     DO k=1,levsiz
+!         pin(k) = pin(k)*100.
+!     end do
+
+!     DO m=1,num_months
+!     DO j=jts,jtf
+!     DO i=its,itf
+!     DO k=1,2
+!      ozmixm(i,k,j,m)=1.e-6
+!     ENDDO
+!     DO k=3,levsiz
+!      ozmixm(i,k,j,m)=1.e-7
+!     ENDDO
+!     ENDDO
+!     ENDDO
+!     ENDDO
+
+END SUBROUTINE oznini
+
+subroutine aerosol_init(m_psp,m_psn,m_hybi,aerosolcp,aerosolcn,paerlev,naer_c,shalf,pptop,    &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte)
+!
+!  This subroutine assumes a uniform aerosol distribution in both time and space.
+!  It should be modified if aerosol data are available from WRF-CHEM or other sources
+!
+      IMPLICIT NONE
+
+   INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte
+
+   INTEGER,      INTENT(IN   )    ::   paerlev,naer_c 
+
+   REAL,     intent(in)                        :: pptop
+   REAL,     DIMENSION( kms:kme ), intent(in)  :: shalf
+
+   REAL,  DIMENSION( ims:ime, paerlev, jms:jme, naer_c ),      &
+          INTENT(INOUT   ) ::                                  aerosolcn , aerosolcp
+
+   REAL,  DIMENSION(paerlev), INTENT(OUT )  ::                m_hybi
+   REAL,  DIMENSION( ims:ime, jms:jme),  INTENT(OUT )  ::       m_psp,m_psn 
+
+   REAL ::                                                      psurf
+   real, dimension(29) :: hybi  
+   integer k ! index through vertical levels
+
+   INTEGER :: i, j, itf, jtf, ktf,m
+
+   data hybi/0, 0.0065700002014637, 0.0138600002974272, 0.023089999333024, &
+    0.0346900001168251, 0.0491999983787537, 0.0672300010919571,      &
+     0.0894500017166138, 0.116539999842644, 0.149159997701645,       &
+    0.187830001115799, 0.232859998941422, 0.284209996461868,         &
+    0.341369986534119, 0.403340011835098, 0.468600004911423,         &
+    0.535290002822876, 0.601350009441376, 0.66482001543045,          &
+    0.724009990692139, 0.777729988098145, 0.825269997119904,         & 
+    0.866419970989227, 0.901350021362305, 0.930540025234222,         & 
+    0.954590022563934, 0.974179983139038, 0.990000009536743, 1/
+
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+
+    do k=1,paerlev
+      m_hybi(k)=hybi(k)
+    enddo
+
+!
+! mxaerl = max number of levels (from bottom) for background aerosol
+! Limit background aerosol height to regions below 900 mb
+!
+
+   psurf = 1.e05
+   mxaerl = 0
+!  do k=pver,1,-1
+   do k=kms,kme-1
+!     if (hypm(k) >= 9.e4) mxaerl = mxaerl + 1
+      if (shalf(k)*psurf+pptop  >= 9.e4) mxaerl = mxaerl + 1
+   end do
+   mxaerl = max(mxaerl,1)
+!  if (masterproc) then
+      write(6,*)'AEROSOLS:  Background aerosol will be limited to ', &
+                'bottom ',mxaerl,' model interfaces.'
+!               'bottom ',mxaerl,' model interfaces. Top interface is ', &
+!               hypi(pverp-mxaerl),' pascals'
+!  end if
+
+     DO j=jts,jtf
+     DO i=its,itf
+      m_psp(i,j)=psurf
+      m_psn(i,j)=psurf
+     ENDDO
+     ENDDO
+
+     DO j=jts,jtf
+     DO i=its,itf
+     DO k=1,paerlev
+      aerosolcp(i,k,j,idxSUL)=1.e-7
+      aerosolcn(i,k,j,idxSUL)=1.e-7
+      aerosolcp(i,k,j,idxSSLT)=1.e-22
+      aerosolcn(i,k,j,idxSSLT)=1.e-22
+      aerosolcp(i,k,j,idxDUSTfirst)=1.e-7
+      aerosolcn(i,k,j,idxDUSTfirst)=1.e-7
+      aerosolcp(i,k,j,idxDUSTfirst+1)=1.e-7
+      aerosolcn(i,k,j,idxDUSTfirst+1)=1.e-7
+      aerosolcp(i,k,j,idxDUSTfirst+2)=1.e-7
+      aerosolcn(i,k,j,idxDUSTfirst+2)=1.e-7
+      aerosolcp(i,k,j,idxDUSTfirst+3)=1.e-7
+      aerosolcn(i,k,j,idxDUSTfirst+3)=1.e-7
+      aerosolcp(i,k,j,idxOCPHO)=1.e-7
+      aerosolcn(i,k,j,idxOCPHO)=1.e-7
+      aerosolcp(i,k,j,idxBCPHO)=1.e-9
+      aerosolcn(i,k,j,idxBCPHO)=1.e-9
+      aerosolcp(i,k,j,idxOCPHI)=1.e-7
+      aerosolcn(i,k,j,idxOCPHI)=1.e-7
+      aerosolcp(i,k,j,idxBCPHI)=1.e-8
+      aerosolcn(i,k,j,idxBCPHI)=1.e-8
+     ENDDO
+     ENDDO
+     ENDDO
+
+     call aer_optics_initialize
+ 
+
+END subroutine aerosol_init
+
+  subroutine aer_optics_initialize
+
+USE module_wrf_error
+USE module_dm
+
+!   use shr_kind_mod, only: r8 => shr_kind_r8
+!   use pmgrid  ! masterproc is here
+!   use ioFileMod, only: getfil
+
+!#if ( defined SPMD )
+!    use mpishorthand
+!#endif
+    implicit none
+
+!   include 'netcdf.inc'
+
+
+    integer :: nrh_opac  ! number of relative humidity values for OPAC data
+    integer :: nbnd      ! number of spectral bands, should be identical to nspint
+    real(r8), parameter :: wgt_sscm = 6.0 / 7.0
+    integer :: krh_opac  ! rh index for OPAC rh grid
+    integer :: krh       ! another rh index
+    integer :: ksz       ! dust size bin index
+    integer :: kbnd      ! band index
+
+    real(r8) :: rh   ! local relative humidity variable
+
+    integer, parameter :: irh=8
+    real(r8) :: rh_opac(irh)        ! OPAC relative humidity grid
+    real(r8) :: ksul_opac(irh,nspint)    ! sulfate  extinction
+    real(r8) :: wsul_opac(irh,nspint)    !          single scattering albedo
+    real(r8) :: gsul_opac(irh,nspint)    !          asymmetry parameter
+    real(r8) :: ksslt_opac(irh,nspint)   ! sea-salt
+    real(r8) :: wsslt_opac(irh,nspint)
+    real(r8) :: gsslt_opac(irh,nspint)
+    real(r8) :: kssam_opac(irh,nspint)   ! sea-salt accumulation mode
+    real(r8) :: wssam_opac(irh,nspint)
+    real(r8) :: gssam_opac(irh,nspint)
+    real(r8) :: ksscm_opac(irh,nspint)   ! sea-salt coarse mode
+    real(r8) :: wsscm_opac(irh,nspint)
+    real(r8) :: gsscm_opac(irh,nspint)
+    real(r8) :: kcphil_opac(irh,nspint)  ! hydrophilic organic carbon
+    real(r8) :: wcphil_opac(irh,nspint)
+    real(r8) :: gcphil_opac(irh,nspint)
+    real(r8) :: dummy(nspint)
+
+      LOGICAL                 :: opened
+      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+
+      CHARACTER*80 errmess
+      INTEGER cam_aer_unit
+      integer :: i
+
+!   read aerosol optics data
+
+      IF ( wrf_dm_on_monitor() ) THEN
+        DO i = 10,99
+          INQUIRE ( i , OPENED = opened )
+          IF ( .NOT. opened ) THEN
+            cam_aer_unit = i
+            GOTO 2010
+          ENDIF
+        ENDDO
+        cam_aer_unit = -1
+ 2010   CONTINUE
+      ENDIF
+      CALL wrf_dm_bcast_bytes ( cam_aer_unit , IWORDSIZE )
+      IF ( cam_aer_unit < 0 ) THEN
+        CALL wrf_error_fatal ( 'module_ra_cam: aer_optics_initialize: Can not find unused fortran unit to read in lookup table.' )
+      ENDIF
+
+        IF ( wrf_dm_on_monitor() ) THEN
+          OPEN(cam_aer_unit,FILE='CAM_AEROPT_DATA',                  &
+               FORM='UNFORMATTED',STATUS='OLD',ERR=9010)
+          call wrf_debug(50,'reading CAM_AEROPT_DATA')
+        ENDIF
+
+#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * r8 )
+
+         IF ( wrf_dm_on_monitor() ) then
+         READ (cam_aer_unit,ERR=9010) dummy
+         READ (cam_aer_unit,ERR=9010) rh_opac 
+         READ (cam_aer_unit,ERR=9010) ksul_opac 
+         READ (cam_aer_unit,ERR=9010) wsul_opac 
+         READ (cam_aer_unit,ERR=9010) gsul_opac 
+         READ (cam_aer_unit,ERR=9010) kssam_opac 
+         READ (cam_aer_unit,ERR=9010) wssam_opac 
+         READ (cam_aer_unit,ERR=9010) gssam_opac 
+         READ (cam_aer_unit,ERR=9010) ksscm_opac 
+         READ (cam_aer_unit,ERR=9010) wsscm_opac 
+         READ (cam_aer_unit,ERR=9010) gsscm_opac
+         READ (cam_aer_unit,ERR=9010) kcphil_opac 
+         READ (cam_aer_unit,ERR=9010) wcphil_opac 
+         READ (cam_aer_unit,ERR=9010) gcphil_opac 
+         READ (cam_aer_unit,ERR=9010) kcb 
+         READ (cam_aer_unit,ERR=9010) wcb 
+         READ (cam_aer_unit,ERR=9010) gcb 
+         READ (cam_aer_unit,ERR=9010) kdst 
+         READ (cam_aer_unit,ERR=9010) wdst 
+         READ (cam_aer_unit,ERR=9010) gdst 
+         READ (cam_aer_unit,ERR=9010) kbg 
+         READ (cam_aer_unit,ERR=9010) wbg 
+         READ (cam_aer_unit,ERR=9010) gbg
+         READ (cam_aer_unit,ERR=9010) kvolc 
+         READ (cam_aer_unit,ERR=9010) wvolc 
+         READ (cam_aer_unit,ERR=9010) gvolc
+         endif
+
+         DM_BCAST_MACRO(rh_opac)
+         DM_BCAST_MACRO(ksul_opac)
+         DM_BCAST_MACRO(wsul_opac)
+         DM_BCAST_MACRO(gsul_opac)
+         DM_BCAST_MACRO(kssam_opac)
+         DM_BCAST_MACRO(wssam_opac)
+         DM_BCAST_MACRO(gssam_opac)
+         DM_BCAST_MACRO(ksscm_opac)
+         DM_BCAST_MACRO(wsscm_opac)
+         DM_BCAST_MACRO(gsscm_opac)
+         DM_BCAST_MACRO(kcphil_opac)
+         DM_BCAST_MACRO(wcphil_opac)
+         DM_BCAST_MACRO(gcphil_opac)
+         DM_BCAST_MACRO(kcb)
+         DM_BCAST_MACRO(wcb)
+         DM_BCAST_MACRO(gcb)
+         DM_BCAST_MACRO(kvolc)
+         DM_BCAST_MACRO(wvolc)
+         DM_BCAST_MACRO(kdst)
+         DM_BCAST_MACRO(wdst)
+         DM_BCAST_MACRO(gdst)
+         DM_BCAST_MACRO(kbg)
+         DM_BCAST_MACRO(wbg)
+         DM_BCAST_MACRO(gbg)
+
+         IF ( wrf_dm_on_monitor() ) CLOSE (cam_aer_unit)
+
+    ! map OPAC aerosol species onto CAM aerosol species
+    ! CAM name             OPAC name
+    ! sul   or SO4         = suso                  sulfate soluble
+    ! sslt  or SSLT        = 1/7 ssam + 6/7 sscm   sea-salt accumulation/coagulation mode
+    ! cphil or CPHI        = waso                  water soluble (carbon)
+    ! cphob or CPHO        = waso @ rh = 0
+    ! cb    or BCPHI/BCPHO = soot
+
+    ksslt_opac(:,:) = (1.0 - wgt_sscm) * kssam_opac(:,:) + wgt_sscm * ksscm_opac(:,:)
+
+    wsslt_opac(:,:) = ( (1.0 - wgt_sscm) * kssam_opac(:,:) * wssam_opac(:,:) &
+                  + wgt_sscm * ksscm_opac(:,:) * wsscm_opac(:,:) ) &
+                  / ksslt_opac(:,:)
+
+    gsslt_opac(:,:) = ( (1.0 - wgt_sscm) * kssam_opac(:,:) * wssam_opac(:,:) * gssam_opac(:,:) &
+                  + wgt_sscm * ksscm_opac(:,:) * wsscm_opac(:,:) * gsscm_opac(:,:) ) &
+                   / ( ksslt_opac(:,:) * wsslt_opac(:,:) )
+
+    do i=1,nspint
+    kcphob(i) = kcphil_opac(1,i)
+    wcphob(i) = wcphil_opac(1,i)
+    gcphob(i) = gcphil_opac(1,i)
+    end do
+
+    ! interpolate optical properties of hygrospopic aerosol species
+    !   onto a uniform relative humidity grid
+
+    nbnd = nspint
+
+    do krh = 1, nrh
+      rh = 1.0_r8 / nrh * (krh - 1)
+      do kbnd = 1, nbnd
+        ksul(krh, kbnd) = exp_interpol( rh_opac, &
+          ksul_opac(:, kbnd) / ksul_opac(1, kbnd), rh ) * ksul_opac(1, kbnd)
+        wsul(krh, kbnd) = lin_interpol( rh_opac, &
+          wsul_opac(:, kbnd) / wsul_opac(1, kbnd), rh ) * wsul_opac(1, kbnd)
+        gsul(krh, kbnd) = lin_interpol( rh_opac, &
+          gsul_opac(:, kbnd) / gsul_opac(1, kbnd), rh ) * gsul_opac(1, kbnd)
+        ksslt(krh, kbnd) = exp_interpol( rh_opac, &
+          ksslt_opac(:, kbnd) / ksslt_opac(1, kbnd), rh ) * ksslt_opac(1, kbnd)
+        wsslt(krh, kbnd) = lin_interpol( rh_opac, &
+          wsslt_opac(:, kbnd) / wsslt_opac(1, kbnd), rh ) * wsslt_opac(1, kbnd)
+        gsslt(krh, kbnd) = lin_interpol( rh_opac, &
+          gsslt_opac(:, kbnd) / gsslt_opac(1, kbnd), rh ) * gsslt_opac(1, kbnd)
+        kcphil(krh, kbnd) = exp_interpol( rh_opac, &
+          kcphil_opac(:, kbnd) / kcphil_opac(1, kbnd), rh ) * kcphil_opac(1, kbnd)
+        wcphil(krh, kbnd) = lin_interpol( rh_opac, &
+          wcphil_opac(:, kbnd) / wcphil_opac(1, kbnd), rh ) * wcphil_opac(1, kbnd)
+        gcphil(krh, kbnd) = lin_interpol( rh_opac, &
+          gcphil_opac(:, kbnd) / gcphil_opac(1, kbnd), rh )  * gcphil_opac(1, kbnd)
+      end do
+    end do
+
+     RETURN
+9010 CONTINUE
+     WRITE( errmess , '(A35,I4)' ) 'module_ra_cam: error reading unit ',cam_aer_unit
+     CALL wrf_error_fatal(errmess)
+
+END subroutine aer_optics_initialize
+
+  function exp_interpol(x, f, y) result(g)
+
+    ! Purpose:
+    !   interpolates f(x) to point y
+    !   assuming f(x) = f(x0) exp a(x - x0)
+    !   where a = ( ln f(x1) - ln f(x0) ) / (x1 - x0)
+    !   x0 <= x <= x1
+    !   assumes x is monotonically increasing
+
+    ! Author: D. Fillmore
+
+!   use shr_kind_mod, only: r8 => shr_kind_r8
+
+    implicit none
+
+    real(r8), intent(in), dimension(:) :: x  ! grid points
+    real(r8), intent(in), dimension(:) :: f  ! grid function values
+    real(r8), intent(in) :: y                ! interpolation point
+    real(r8) :: g                            ! interpolated function value
+
+    integer :: k  ! interpolation point index
+    integer :: n  ! length of x
+    real(r8) :: a
+
+    n = size(x)
+
+    ! find k such that x(k) < y =< x(k+1)
+    ! set k = 1 if y <= x(1)  and  k = n-1 if y > x(n)
+
+    if (y <= x(1)) then
+      k = 1
+    else if (y >= x(n)) then
+      k = n - 1
+    else
+      k = 1
+      do while (y > x(k+1) .and. k < n)
+        k = k + 1
+      end do
+    end if
+
+    ! interpolate
+    a = (  log( f(k+1) / f(k) )  ) / ( x(k+1) - x(k) )
+    g = f(k) * exp( a * (y - x(k)) )
+
+  end function exp_interpol
+
+  function lin_interpol(x, f, y) result(g)
+    
+    ! Purpose:
+    !   interpolates f(x) to point y
+    !   assuming f(x) = f(x0) + a * (x - x0)
+    !   where a = ( f(x1) - f(x0) ) / (x1 - x0)
+    !   x0 <= x <= x1
+    !   assumes x is monotonically increasing
+
+    ! Author: D. Fillmore
+
+!   use shr_kind_mod, only: r8 => shr_kind_r8
+
+    implicit none
+    
+    real(r8), intent(in), dimension(:) :: x  ! grid points
+    real(r8), intent(in), dimension(:) :: f  ! grid function values
+    real(r8), intent(in) :: y                ! interpolation point
+    real(r8) :: g                            ! interpolated function value
+    
+    integer :: k  ! interpolation point index
+    integer :: n  ! length of x
+    real(r8) :: a
+
+    n = size(x)
+
+    ! find k such that x(k) < y =< x(k+1)
+    ! set k = 1 if y <= x(1)  and  k = n-1 if y > x(n)
+
+    if (y <= x(1)) then 
+      k = 1 
+    else if (y >= x(n)) then
+      k = n - 1
+    else 
+      k = 1 
+      do while (y > x(k+1) .and. k < n)
+        k = k + 1
+      end do
+    end if
+
+    ! interpolate
+    a = (  f(k+1) - f(k) ) / ( x(k+1) - x(k) )
+    g = f(k) + a * (y - x(k))
+
+  end function lin_interpol
+
+  function lin_interpol2(x, f, y) result(g)
+
+    ! Purpose:
+    !   interpolates f(x) to point y
+    !   assuming f(x) = f(x0) + a * (x - x0)
+    !   where a = ( f(x1) - f(x0) ) / (x1 - x0)
+    !   x0 <= x <= x1
+    !   assumes x is monotonically increasing
+
+    ! Author: D. Fillmore ::  J. Done changed from r8 to r4
+
+    implicit none
+
+    real, intent(in), dimension(:) :: x  ! grid points
+    real, intent(in), dimension(:) :: f  ! grid function values
+    real, intent(in) :: y                ! interpolation point
+    real :: g                            ! interpolated function value
+
+    integer :: k  ! interpolation point index
+    integer :: n  ! length of x
+    real    :: a
+
+    n = size(x)
+
+    ! find k such that x(k) < y =< x(k+1)
+    ! set k = 1 if y <= x(1)  and  k = n-1 if y > x(n)
+
+    if (y <= x(1)) then
+      k = 1
+    else if (y >= x(n)) then
+      k = n - 1
+    else
+      k = 1
+      do while (y > x(k+1) .and. k < n)
+        k = k + 1
+      end do
+    end if
+
+    ! interpolate
+    a = (  f(k+1) - f(k) ) / ( x(k+1) - x(k) )
+    g = f(k) + a * (y - x(k))
+
+  end function lin_interpol2
+
+subroutine oznint(julday,julian,dt,gmt,xtime,ozmixmj,ozmix,levsiz,num_months,pcols)
+
+      IMPLICIT NONE
+
+   INTEGER,      INTENT(IN   )    ::   levsiz, num_months,pcols
+
+   REAL(r8),  DIMENSION( pcols, levsiz, num_months ),      &
+          INTENT(IN   ) ::                                  ozmixmj 
+
+   REAL, INTENT(IN    )      ::        XTIME,GMT
+   INTEGER, INTENT(IN )      ::        JULDAY
+   REAL,    INTENT(IN )      ::        JULIAN
+   REAL,    INTENT(IN )      ::        DT
+
+   REAL(r8),  DIMENSION( pcols, levsiz ),      &
+          INTENT(OUT  ) ::                                  ozmix
+   !Local
+   REAL(r8)  :: intJULIAN
+   integer   :: np1,np,nm,m,k,i
+   integer   :: IJUL
+   integer, dimension(12) ::  date_oz
+   data date_oz/16, 45, 75, 105, 136, 166, 197, 228, 258, 289, 319, 350/
+   real(r8) :: cdayozp, cdayozm
+   real(r8) :: fact1, fact2
+   logical  :: finddate
+   CHARACTER(LEN=256) :: msgstr
+
+   ! JULIAN starts from 0.0 at 0Z on 1 Jan.
+   intJULIAN = JULIAN + 1.0_r8    ! offset by one day
+! jan 1st 00z is julian=1.0 here
+   IJUL=INT(intJULIAN)
+!  Note that following will drift. 
+!    Need to use actual month/day info to compute julian.
+   intJULIAN=intJULIAN-FLOAT(IJUL)
+   IJUL=MOD(IJUL,365)
+   IF(IJUL.EQ.0)IJUL=365
+   intJULIAN=intJULIAN+IJUL
+   np1=1
+   finddate=.false.
+   do m=1,num_months
+   if(date_oz(m).gt.intjulian.and..not.finddate) then
+     np1=m
+     finddate=.true.
+   endif
+   enddo
+   cdayozp=date_oz(np1)
+   if(np1.gt.1) then
+   cdayozm=date_oz(np1-1)
+   np=np1
+   nm=np-1
+   else
+   cdayozm=date_oz(12)
+   np=np1
+   nm=12
+   endif
+   call getfactors(ozncyc,np1, cdayozm, cdayozp,intjulian, &
+                    fact1, fact2) 
+
+!
+! Time interpolation.
+!
+      do k=1,levsiz
+         do i=1,pcols
+            ozmix(i,k) = ozmixmj(i,k,nm)*fact1 + ozmixmj(i,k,np)*fact2
+         end do
+      end do
+
+END subroutine oznint
+
+subroutine getfactors (cycflag, np1, cdayminus, cdayplus, cday, &
+                       fact1, fact2)
+!---------------------------------------------------------------------------
+!
+! Purpose: Determine time interpolation factors (normally for a boundary dataset)
+!          for linear interpolation.
+!
+! Method:  Assume 365 days per year.  Output variable fact1 will be the weight to
+!          apply to data at calendar time "cdayminus", and fact2 the weight to apply
+!          to data at time "cdayplus".  Combining these values will produce a result
+!          valid at time "cday".  Output arguments fact1 and fact2 will be between
+!          0 and 1, and fact1 + fact2 = 1 to roundoff.
+!
+! Author:  Jim Rosinski
+!
+!---------------------------------------------------------------------------
+   implicit none
+!
+! Arguments
+!
+   logical, intent(in) :: cycflag             ! flag indicates whether dataset is being cycled yearly
+
+   integer, intent(in) :: np1                 ! index points to forward time slice matching cdayplus
+
+   real(r8), intent(in) :: cdayminus          ! calendar day of rearward time slice
+   real(r8), intent(in) :: cdayplus           ! calendar day of forward time slice
+   real(r8), intent(in) :: cday               ! calenar day to be interpolated to
+   real(r8), intent(out) :: fact1             ! time interpolation factor to apply to rearward time slice
+   real(r8), intent(out) :: fact2             ! time interpolation factor to apply to forward time slice
+
+!  character(len=*), intent(in) :: str        ! string to be added to print in case of error (normally the callers name)
+!
+! Local workspace
+!
+   real(r8) :: deltat                         ! time difference (days) between cdayminus and cdayplus
+   real(r8), parameter :: daysperyear = 365.  ! number of days in a year
+!
+! Initial sanity checks
+!
+!  if (np1 == 1 .and. .not. cycflag) then
+!     call endrun ('GETFACTORS:'//str//' cycflag false and forward month index = Jan. not allowed')
+!  end if
+
+!  if (np1 < 1) then
+!     call endrun ('GETFACTORS:'//str//' input arg np1 must be > 0')
+!  end if
+
+   if (cycflag) then
+      if ((cday < 1.) .or. (cday > (daysperyear+1.))) then
+         write(6,*) 'GETFACTORS:', ' bad cday=',cday
+!        call endrun ()
+      end if
+   else
+      if (cday < 1.) then
+         write(6,*) 'GETFACTORS:',  ' bad cday=',cday
+!        call endrun ()
+      end if
+   end if
+!
+! Determine time interpolation factors.  Account for December-January
+! interpolation if dataset is being cycled yearly.
+!
+   if (cycflag .and. np1 == 1) then                     ! Dec-Jan interpolation
+      deltat = cdayplus + daysperyear - cdayminus
+      if (cday > cdayplus) then                         ! We are in December
+         fact1 = (cdayplus + daysperyear - cday)/deltat
+         fact2 = (cday - cdayminus)/deltat
+      else                                              ! We are in January
+         fact1 = (cdayplus - cday)/deltat
+         fact2 = (cday + daysperyear - cdayminus)/deltat
+      end if
+   else
+      deltat = cdayplus - cdayminus
+      fact1 = (cdayplus - cday)/deltat
+      fact2 = (cday - cdayminus)/deltat
+   end if
+
+   if (.not. validfactors (fact1, fact2)) then
+      write(6,*) 'GETFACTORS: ', ' bad fact1 and/or fact2=', fact1, fact2
+!     call endrun ()
+   end if
+
+   return
+end subroutine getfactors
+
+logical function validfactors (fact1, fact2)
+!---------------------------------------------------------------------------
+!
+! Purpose: check sanity of time interpolation factors to within 32-bit roundoff
+!
+!---------------------------------------------------------------------------
+   implicit none
+
+   real(r8), intent(in) :: fact1, fact2           ! time interpolation factors
+
+   validfactors = .true.
+   if (abs(fact1+fact2-1.) > 1.e-6 .or. &
+       fact1 > 1.000001 .or. fact1 < -1.e-6 .or. &
+       fact2 > 1.000001 .or. fact2 < -1.e-6) then
+
+      validfactors = .false.
+   end if
+
+   return
+end function validfactors
+
+subroutine get_rf_scales(scales)
+
+  real(r8), intent(out)::scales(naer_all)  ! scale aerosols by this amount
+
+  integer i                                  ! loop index
+
+  scales(idxBG) = bgscl_rf
+  scales(idxSUL) = sulscl_rf
+  scales(idxSSLT) = ssltscl_rf
+
+  do i = idxCARBONfirst, idxCARBONfirst+numCARBON-1
+    scales(i) = carscl_rf
+  enddo
+
+  do i = idxDUSTfirst, idxDUSTfirst+numDUST-1
+    scales(i) = dustscl_rf
+  enddo
+
+  scales(idxVOLC) = volcscl_rf
+
+end subroutine get_rf_scales
+
+subroutine get_aerosol(c, julday, julian, dt, gmt, xtime, m_psp, m_psn, aerosoljp, &
+  aerosoljn, m_hybi, paerlev, naer_c, pint, pcols, pver, pverp, pverr, pverrp, AEROSOLt, scale)
+!------------------------------------------------------------------
+!
+!  Input:
+!     time at which aerosol mmrs are needed (get_curr_calday())
+!     chunk index
+!     CAM's vertical grid (pint)
+!
+!  Output:
+!     values for Aerosol Mass Mixing Ratios at specified time
+!     on vertical grid specified by CAM (AEROSOLt)
+!
+!  Method:
+!     first determine which indexs of aerosols are the bounding data sets
+!     interpolate both onto vertical grid aerm(),aerp().
+!     from those two, interpolate in time.
+!
+!------------------------------------------------------------------
+
+!  use volcanicmass, only: get_volcanic_mass
+!  use timeinterp, only: getfactors
+!
+! aerosol fields interpolated to current time step
+!   on pressure levels of this time step.
+! these should be made read-only for other modules
+! Is allocation done correctly here?
+!
+   integer, intent(in) :: c                   ! Chunk Id.
+   integer, intent(in) :: paerlev, naer_c, pcols, pver, pverp, pverr, pverrp
+   real(r8), intent(in) :: pint(pcols,pverp)  ! midpoint pres.
+   real(r8), intent(in) :: scale(naer_all)    ! scale each aerosol by this amount
+   REAL, INTENT(IN    )      ::        XTIME,GMT
+   INTEGER, INTENT(IN )      ::        JULDAY
+   REAL, INTENT(IN    )      ::        JULIAN
+   REAL, INTENT(IN    )      ::        DT
+   real(r8), intent(in   )      ::        m_psp(pcols),m_psn(pcols)  ! Match surface pressure
+   real(r8), intent(in   )   ::        aerosoljp(pcols,paerlev,naer_c) 
+   real(r8), intent(in   )   ::        aerosoljn(pcols,paerlev,naer_c) 
+   real(r8), intent(in   )   ::        m_hybi(paerlev)
+
+   real(r8), intent(out) :: AEROSOLt(pcols, pver, naer_all) ! aerosols
+!
+! Local workspace
+!
+   real(r8) caldayloc                     ! calendar day of current timestep
+   real(r8) fact1, fact2                  ! time interpolation factors
+
+  integer :: nm = 1                ! index to prv month in array. init to 1 and toggle between 1 and 2
+  integer :: np = 2                ! index to nxt month in array. init to 2 and toggle between 1 and 2
+  integer :: mo_nxt = bigint       ! index to nxt month in file
+  integer :: mo_prv                       ! index to previous month
+
+  real(r8) :: cdaym = inf          ! calendar day of prv month
+  real(r8) :: cdayp = inf          ! calendar day of next month
+  real(r8) :: Mid(12)              ! Days into year for mid month date
+  data Mid/16.5, 46.0, 75.5, 106.0, 136.5, 167.0, 197.5, 228.5, 259.0, 289.5, 320.0, 350.5 /
+
+   integer i, k, j                        ! spatial indices
+   integer m                              ! constituent index
+   integer lats(pcols),lons(pcols)        ! latitude and longitudes of column
+   integer ncol                           ! number of columns
+   INTEGER IJUL
+   REAL(r8) intJULIAN
+
+   real(r8) speciesmin(naer)              ! minimal value for each species
+!
+! values before current time step "the minus month"
+! aerosolm(pcols,pver) is value of preceeding month's aerosol mmr
+! aerosolp(pcols,pver) is value of next month's aerosol mmr
+!  (think minus and plus or values to left and right of point to be interpolated)
+!
+   real(r8) AEROSOLm(pcols,pver,naer) ! aerosol mmr from MATCH in column at previous (minus) month
+!
+! values beyond (or at) current time step "the plus month"
+!
+   real(r8) AEROSOLp(pcols,pver,naer) ! aerosol mmr from MATCH in column at next (plus) month
+   CHARACTER(LEN=256) :: msgstr
+
+   ! JULIAN starts from 0.0 at 0Z on 1 Jan.
+   intJULIAN = JULIAN + 1.0_r8    ! offset by one day
+! jan 1st 00z is julian=1.0 here
+   IJUL=INT(intJULIAN)
+!  Note that following will drift. 
+!    Need to use actual month/day info to compute julian.
+   intJULIAN=intJULIAN-FLOAT(IJUL)
+   IJUL=MOD(IJUL,365)
+   IF(IJUL.EQ.0)IJUL=365
+   caldayloc=intJULIAN+IJUL
+
+   if (caldayloc < Mid(1)) then
+      mo_prv = 12
+      mo_nxt =  1
+   else if (caldayloc >= Mid(12)) then
+      mo_prv = 12
+      mo_nxt =  1
+   else
+      do i = 2 , 12
+         if (caldayloc < Mid(i)) then
+            mo_prv = i-1
+            mo_nxt = i
+            exit
+         end if
+      end do
+   end if
+!
+! Set initial calendar day values
+!
+   cdaym = Mid(mo_prv)
+   cdayp = Mid(mo_nxt)
+
+!
+! Determine time interpolation factors.  1st arg says we are cycling 1 year of data
+!
+   call getfactors (.true., mo_nxt, cdaym, cdayp, caldayloc, &
+                    fact1, fact2)
+!
+! interpolate (prv and nxt month) bounding datasets onto cam vertical grid.
+! compute mass mixing ratios on CAMS's pressure coordinate
+!  for both the "minus" and "plus" months
+!
+!  ncol = get_ncols_p(c)
+   ncol = pcols
+
+!  call vert_interpolate (M_ps_cam_col(1,c,nm), pint, nm, AEROSOLm, ncol, c)
+!  call vert_interpolate (M_ps_cam_col(1,c,np), pint, np, AEROSOLp, ncol, c)
+
+   call vert_interpolate (m_psp, aerosoljp, m_hybi, paerlev, naer_c, pint, nm, AEROSOLm, pcols, pver, pverp, ncol, c)
+   call vert_interpolate (m_psn, aerosoljn, m_hybi, paerlev, naer_c, pint, np, AEROSOLp, pcols, pver, pverp, ncol, c)
+
+!
+! Time interpolate.
+!
+   do m=1,naer
+      do k=1,pver
+         do i=1,ncol
+            AEROSOLt(i,k,m) = AEROSOLm(i,k,m)*fact1 + AEROSOLp(i,k,m)*fact2
+         end do
+      end do
+   end do
+
+!  do i=1,ncol
+!     Match_ps_chunk(i,c) = m_ps(i,nm)*fact1 + m_ps(i,np)*fact2
+!  end do
+!
+! get background aerosol (tuning) field
+!
+   call background (c, ncol, pint, pcols, pverr, pverrp, AEROSOLt(:, :, idxBG))
+
+!
+! find volcanic aerosol masses
+!
+! if (strat_volcanic) then
+!   call get_volcanic_mass(c, AEROSOLt(:,:,idxVOLC))
+! else
+    AEROSOLt(:,:,idxVOLC) = 0._r8
+! endif
+
+!
+! exit if mmr is negative (we have previously set
+!  cumulative mass to be a decreasing function.)
+!
+   speciesmin(:) = 0. ! speciesmin(m) = 0 is minimum mmr for each species
+
+   do m=1,naer
+      do k=1,pver
+         do i=1,ncol
+            if (AEROSOLt(i, k, m) < speciesmin(m)) then
+               write(6,*) 'AEROSOL_INTERPOLATE: negative mass mixing ratio, exiting'
+               write(6,*) 'm, column, pver',m, i, k ,AEROSOLt(i, k, m)
+!              call endrun ()
+            end if
+         end do
+      end do
+   end do
+!
+! scale any AEROSOLS as required
+!
+   call scale_aerosols (AEROSOLt, pcols, pver, ncol, c, scale)
+
+   return
+end subroutine get_aerosol
+
+subroutine vert_interpolate (Match_ps, aerosolc, m_hybi, paerlev, naer_c, pint, n, AEROSOL_mmr, pcols, pver, pverp, ncol, c)
+!--------------------------------------------------------------------
+! Input: match surface pressure, cam interface pressure,
+!        month index, number of columns, chunk index
+!
+! Output: Aerosol mass mixing ratio (AEROSOL_mmr)
+!
+! Method:
+!         interpolate column mass (cumulative) from match onto
+!           cam's vertical grid (pressure coordinate)
+!         convert back to mass mixing ratio
+!
+!--------------------------------------------------------------------
+
+!  use physconst,     only: gravit
+
+   integer, intent(in)  :: paerlev,naer_c,pcols,pver,pverp
+   real(r8), intent(out) :: AEROSOL_mmr(pcols,pver,naer)  ! aerosol mmr from MATCH
+   real(r8), intent(in) :: Match_ps(pcols)                ! surface pressure at a particular month
+   real(r8), intent(in) :: pint(pcols,pverp)              ! interface pressure from CAM
+   real(r8), intent(in) :: aerosolc(pcols,paerlev,naer_c)
+   real(r8), intent(in) :: m_hybi(paerlev)
+
+   integer, intent(in) :: ncol,c                          ! chunk index and number of columns
+   integer, intent(in) :: n                               ! prv or nxt month index
+!
+! Local workspace
+!
+   integer m                           ! index to aerosol species
+   integer kupper(pcols)               ! last upper bound for interpolation
+   integer i, k, kk, kkstart, kount    ! loop vars for interpolation
+   integer isv, ksv, msv               ! loop indices to save
+
+   logical bad                         ! indicates a bad point found
+   logical lev_interp_comp             ! interpolation completed for a level
+
+   real(r8) AEROSOL(pcols,pverp,naer)  ! cumulative mass of aerosol in column beneath upper
+                                       ! interface of level in column at particular month
+   real(r8) dpl, dpu                   ! lower and upper intepolation factors
+   real(r8) v_coord                    ! vertical coordinate
+   real(r8) m_to_mmr                   ! mass to mass mixing ratio conversion factor
+   real(r8) AER_diff                   ! temp var for difference between aerosol masses
+
+!  call t_startf ('vert_interpolate')
+!
+! Initialize index array
+!
+   do i=1,ncol
+      kupper(i) = 1
+   end do
+!
+! assign total mass to topmost level
+!
+   
+   do i=1,ncol
+   do m=1,naer
+   AEROSOL(i,1,m) = AEROSOLc(i,1,m)
+   enddo
+   enddo
+!
+! At every pressure level, interpolate onto that pressure level
+!
+   do k=2,pver
+!
+! Top level we need to start looking is the top level for the previous k
+! for all longitude points
+!
+      kkstart = paerlev
+      do i=1,ncol
+         kkstart = min0(kkstart,kupper(i))
+      end do
+      kount = 0
+!
+! Store level indices for interpolation
+!
+! for the pressure interpolation should be comparing
+! pint(column,lev) with M_hybi(lev)*M_ps_cam_col(month,column,chunk)
+!
+      lev_interp_comp = .false.
+      do kk=kkstart,paerlev-1
+         if(.not.lev_interp_comp) then
+         do i=1,ncol
+            v_coord = pint(i,k)
+            if (M_hybi(kk)*Match_ps(i) .lt. v_coord .and. v_coord .le. M_hybi(kk+1)*Match_ps(i)) then
+               kupper(i) = kk
+               kount = kount + 1
+            end if
+         end do
+!
+! If all indices for this level have been found, do the interpolation and
+! go to the next level
+!
+! Interpolate in pressure.
+!
+         if (kount.eq.ncol) then
+            do i=1,ncol
+             do m=1,naer
+               dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i)
+               dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k)
+               AEROSOL(i,k,m) = &
+                    (AEROSOLc(i,kupper(i)  ,m)*dpl + &
+                     AEROSOLc(i,kupper(i)+1,m)*dpu)/(dpl + dpu)
+             enddo
+            enddo !i
+            lev_interp_comp = .true.
+         end if
+         end if
+      end do
+!
+! If we've fallen through the kk=1,levsiz-1 loop, we cannot interpolate and
+
+! must extrapolate from the bottom or top pressure level for at least some
+! of the longitude points.
+!
+
+      if(.not.lev_interp_comp) then
+         do i=1,ncol
+          do m=1,naer 
+            if (pint(i,k) .lt. M_hybi(1)*Match_ps(i)) then
+               AEROSOL(i,k,m) =  AEROSOLc(i,1,m)
+            else if (pint(i,k) .gt. M_hybi(paerlev)*Match_ps(i)) then
+               AEROSOL(i,k,m) = 0.0
+            else
+               dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i)
+               dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k)
+               AEROSOL(i,k,m) = &
+                    (AEROSOLc(i,kupper(i)  ,m)*dpl + &
+                     AEROSOLc(i,kupper(i)+1,m)*dpu)/(dpl + dpu)
+            end if
+          enddo
+         end do
+
+         if (kount.gt.ncol) then
+!           call endrun ('VERT_INTERPOLATE: Bad data: non-monotonicity suspected in dependent variable')
+         end if
+      end if
+   end do
+
+!  call t_startf ('vi_checks')
+!
+! aerosol mass beneath lowest interface (pverp) must be 0
+!
+   AEROSOL(1:ncol,pverp,:) = 0.
+!
+! Set mass in layer to zero whenever it is less than
+!   1.e-40 kg/m^2 in the layer
+!
+   do m = 1, naer
+      do k = 1, pver
+         do i = 1, ncol
+            if (AEROSOL(i,k,m) < 1.e-40_r8) AEROSOL(i,k,m) = 0.
+         end do
+      end do
+   end do
+!
+! Set mass in layer to zero whenever it is less than
+!   10^-15 relative to column total mass
+! convert back to mass mixing ratios.
+! exit if mmr is negative
+!
+   do m = 1, naer
+      do k = 1, pver
+         do i = 1, ncol
+            AER_diff = AEROSOL(i,k,m) - AEROSOL(i,k+1,m)
+            if( abs(AER_diff) < 1e-15*AEROSOL(i,1,m)) then
+               AER_diff = 0.
+            end if
+            m_to_mmr = gravmks / (pint(i,k+1)-pint(i,k))
+            AEROSOL_mmr(i,k,m)= AER_diff * m_to_mmr
+            if (AEROSOL_mmr(i,k,m) < 0) then
+               write(6,*)'vert_interpolate: mmr < 0, m, col, lev, mmr',m, i, k, AEROSOL_mmr(i,k,m)
+               write(6,*)'vert_interpolate: aerosol(k),(k+1)',AEROSOL(i,k,m),AEROSOL(i,k+1,m)
+               write(6,*)'vert_interpolate: pint(k+1),(k)',pint(i,k+1),pint(i,k)
+               write(6,*)'n,c',n,c
+!              call endrun()
+            end if
+         end do
+      end do
+   end do
+
+!  call t_stopf ('vi_checks')
+!  call t_stopf ('vert_interpolate')
+
+   return
+end subroutine vert_interpolate
+
+subroutine aerosol_indirect(ncol,lchnk,pcols,pver,ppcnst,landfrac,pmid,t,qm1,cld,zm,rel)
+!--------------------------------------------------------------
+! Compute effect of sulfate on effective liquid water radius
+!  Method of Martin et. al.
+!--------------------------------------------------------------
+
+! use constituents, only: ppcnst, cnst_get_ind
+! use history, only: outfld
+
+!#include <comctl.h>
+
+  integer, intent(in) :: ncol                  ! number of atmospheric columns
+  integer, intent(in) :: lchnk                 ! chunk identifier
+  integer, intent(in) :: pcols,pver,ppcnst
+
+  real(r8), intent(in) :: landfrac(pcols)      ! land fraction
+  real(r8), intent(in) :: pmid(pcols,pver)     ! Model level pressures
+  real(r8), intent(in) :: t(pcols,pver)        ! Model level temperatures
+  real(r8), intent(in) :: qm1(pcols,pver,ppcnst) ! Specific humidity and tracers
+  real(r8), intent(in) :: cld(pcols,pver)      ! Fractional cloud cover
+  real(r8), intent(in) :: zm(pcols,pver)       ! Height of midpoints (above surface)
+  real(r8), intent(in) :: rel(pcols,pver)      ! liquid effective drop size (microns)
+!
+! local variables
+!
+  real(r8) locrhoair(pcols,pver)  ! dry air density            [kg/m^3 ]
+  real(r8) lwcwat(pcols,pver)     ! in-cloud liquid water path [kg/m^3 ]
+  real(r8) sulfmix(pcols,pver)    ! sulfate mass mixing ratio  [kg/kg  ]
+  real(r8) so4mass(pcols,pver)    ! sulfate mass concentration [g/cm^3 ]
+  real(r8) Aso4(pcols,pver)       ! sulfate # concentration    [#/cm^3 ]
+  real(r8) Ntot(pcols,pver)       ! ccn # concentration        [#/cm^3 ]
+  real(r8) relmod(pcols,pver)     ! effective radius           [microns]
+
+  real(r8) wrel(pcols,pver)       ! weighted effective radius    [microns]
+  real(r8) wlwc(pcols,pver)       ! weighted liq. water content  [kg/m^3 ]
+  real(r8) cldfrq(pcols,pver)     ! frequency of occurance of...
+!                                  ! clouds (cld => 0.01)         [fraction]
+  real(r8) locPi                  ! my piece of the pi
+  real(r8) Rdryair                ! gas constant of dry air   [J/deg/kg]
+  real(r8) rhowat                 ! density of water          [kg/m^3  ]
+  real(r8) Acoef                  ! m->A conversion factor; assumes
+!                                  ! Dbar=0.10, sigma=2.0      [g^-1    ]
+  real(r8) rekappa                ! kappa in evaluation of re(lmod)
+  real(r8) recoef                 ! temp. coeficient for calc of re(lmod)
+  real(r8) reexp                  ! 1.0/3.0
+  real(r8) Ntotb                  ! temp var to hold below cloud ccn
+! -- Parameters for background CDNC (from `ambient' non-sulfate aerosols)...
+  real(r8) Cmarn                  ! Coef for CDNC_marine         [cm^-3]
+  real(r8) Cland                  ! Coef for CDNC_land           [cm^-3]
+  real(r8) Hmarn                  ! Scale height for CDNC_marine [m]
+  real(r8) Hland                  ! Scale height for CDNC_land   [m]
+  parameter ( Cmarn = 50.0, Cland = 100.0 )
+  parameter ( Hmarn = 1000.0, Hland = 2000.0 )
+  real(r8) bgaer                  ! temp var to hold background CDNC
+
+  integer i,k     ! loop indices
+!
+! Statement functions
+!
+  logical land    ! is this a column over land?
+  land(i) = nint(landfrac(i)).gt.0.5_r8
+
+  if (indirect) then
+
+!   call endrun ('AEROSOL_INDIRECT:  indirect effect is obsolete')
+
+!   ramping is not yet resolved so sulfmix is 0.
+    sulfmix(1:ncol,1:pver) = 0._r8
+
+    locPi = 3.141592654
+    Rdryair = 287.04
+    rhowat = 1000.0
+    Acoef = 1.2930E14
+    recoef = 3.0/(4.0*locPi*rhowat)
+    reexp = 1.0/3.0
+
+!   call cnst_get_ind('CLDLIQ', ixcldliq)
+    do k=pver,1,-1
+      do i = 1,ncol
+        locrhoair(i,k) = pmid(i,k)/( Rdryair*t(i,k) )
+        lwcwat(i,k) = ( qm1(i,k,ixcldliq)/max(0.01_r8,cld(i,k)) )* &
+                      locrhoair(i,k)
+!          NOTE: 0.001 converts kg/m3 -> g/cm3
+        so4mass(i,k) = sulfmix(i,k)*locrhoair(i,k)*0.001
+        Aso4(i,k) = so4mass(i,k)*Acoef
+
+        if (Aso4(i,k) <= 280.0) then
+           Aso4(i,k) = max(36.0_r8,Aso4(i,k))
+           Ntot(i,k) = -1.15E-3*Aso4(i,k)**2 + 0.963*Aso4(i,k)+5.30
+           rekappa = 0.80
+        else
+           Aso4(i,k) = min(1500.0_r8,Aso4(i,k))
+           Ntot(i,k) = -2.10E-4*Aso4(i,k)**2 + 0.568*Aso4(i,k)-27.9
+           rekappa = 0.67
+        end if
+        if (land(i)) then ! Account for local background aerosol;
+           bgaer = Cland*exp(-(zm(i,k)/Hland))
+           Ntot(i,k) = max(bgaer,Ntot(i,k))
+        else
+           bgaer = Cmarn*exp(-(zm(i,k)/Hmarn))
+           Ntot(i,k) = max(bgaer,Ntot(i,k))
+        end if
+
+        if (k == pver) then
+           Ntotb = Ntot(i,k)
+        else
+           Ntotb = Ntot(i,k+1)
+        end if
+
+        relmod(i,k) = (( (recoef*lwcwat(i,k))/(rekappa*Ntotb))**reexp)*10000.0
+        relmod(i,k) = max(4.0_r8,relmod(i,k))
+        relmod(i,k) = min(20.0_r8,relmod(i,k))
+        if (cld(i,k) >= 0.01) then
+           cldfrq(i,k) = 1.0
+        else
+           cldfrq(i,k) = 0.0
+        end if
+        wrel(i,k) = relmod(i,k)*cldfrq(i,k)
+        wlwc(i,k) = lwcwat(i,k)*cldfrq(i,k)
+      end do
+    end do
+!   call outfld('MSO4    ',so4mass,pcols,lchnk)
+!   call outfld('LWC     ',lwcwat ,pcols,lchnk)
+!   call outfld('CLDFRQ  ',cldfrq ,pcols,lchnk)
+!   call outfld('WREL    ',wrel   ,pcols,lchnk)
+!   call outfld('WLWC    ',wlwc   ,pcols,lchnk)
+!   write(6,*)'WARNING: indirect calculation has no effects'
+  else
+    do k = 1, pver
+      do i = 1, ncol
+        relmod(i,k) = rel(i,k)
+      end do
+    end do
+  endif
+
+! call outfld('REL     ',relmod ,pcols,lchnk)
+
+  return
+end subroutine aerosol_indirect
+
+
+subroutine background(lchnk, ncol, pint, pcols, pverr, pverrp, mmr)
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Set global mean tropospheric aerosol background (or tuning) field
+!
+! Method:
+! Specify aerosol mixing ratio.
+! Aerosol mass mixing ratio
+! is specified so that the column visible aerosol optical depth is a
+! specified global number (tauback). This means that the actual mixing
+! ratio depends on pressure thickness of the lowest three atmospheric
+! layers near the surface.
+!
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use aer_optics, only: kbg,idxVIS
+!  use physconst, only: gravit
+!-----------------------------------------------------------------------
+   implicit none
+!-----------------------------------------------------------------------
+!#include <ptrrgrid.h>
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                 ! chunk identifier
+   integer, intent(in) :: ncol                  ! number of atmospheric columns
+   integer, intent(in) :: pcols,pverr,pverrp
+
+   real(r8), intent(in) :: pint(pcols,pverrp)   ! Interface pressure (mks)
+!
+! Output arguments
+!
+   real(r8), intent(out) :: mmr(pcols,pverr)    ! "background" aerosol mass mixing ratio
+!
+!---------------------------Local variables-----------------------------
+!
+   integer i          ! Longitude index
+   integer k          ! Level index
+!
+   real(r8) mass2mmr  ! Factor to convert mass to mass mixing ratio
+   real(r8) mass      ! Mass of "background" aerosol as specified by tauback
+!
+!-----------------------------------------------------------------------
+!
+   do i=1,ncol
+      mass2mmr =  gravmks / (pint(i,pverrp)-pint(i,pverrp-mxaerl))
+      do k=1,pverr
+!
+! Compute aerosol mass mixing ratio for specified levels (1.e3 factor is
+! for units conversion of the extinction coefficiant from m2/g to m2/kg)
+!
+        if ( k >= pverrp-mxaerl ) then
+! kaervs is not consistent with the values in aer_optics
+! this ?should? be changed.
+! rhfac is also implemented differently
+            mass = tauback / (1.e3 * kbg(idxVIS))
+            mmr(i,k) = mass2mmr*mass
+         else
+            mmr(i,k) = 0._r8
+         endif
+!
+      enddo
+   enddo
+!
+   return
+end subroutine background
+
+subroutine scale_aerosols(AEROSOLt, pcols, pver, ncol, lchnk, scale)
+!-----------------------------------------------------------------
+! scale each species as determined by scale factors
+!-----------------------------------------------------------------
+  integer, intent(in) :: ncol, lchnk ! number of columns and chunk index
+  integer, intent(in) :: pcols, pver
+  real(r8), intent(in) :: scale(naer_all) ! scale each aerosol by this amount
+  real(r8), intent(inout) :: AEROSOLt(pcols, pver, naer_all) ! aerosols
+  integer m
+
+  do m = 1, naer_all
+     AEROSOLt(:ncol, :, m) = scale(m)*AEROSOLt(:ncol, :, m)
+  end do
+
+  return
+end subroutine scale_aerosols
+
+subroutine get_int_scales(scales)
+  real(r8), intent(out)::scales(naer_all)  ! scale each aerosol by this amount
+  integer i                                  ! index through species
+
+!initialize
+  scales = 1.
+
+  scales(idxBG) = 1._r8
+  scales(idxSUL) = sulscl 
+  scales(idxSSLT) = ssltscl  
+  
+  do i = idxCARBONfirst, idxCARBONfirst+numCARBON-1
+    scales(i) = carscl
+  enddo
+  
+  do i = idxDUSTfirst, idxDUSTfirst+numDUST-1
+    scales(i) = dustscl
+  enddo
+
+  scales(idxVOLC) = volcscl
+
+  return
+end subroutine get_int_scales
+
+      subroutine aer_trn(aer_mpp, aer_trn_ttl, pcols, plev, plevp )
+!
+!     Purpose: Compute strat. aerosol transmissions needed in absorptivity/
+!              emissivity calculations
+!              aer_trn() is called by radclw() when doabsems is .true.
+!
+!     use shr_kind_mod, only: r8 => shr_kind_r8
+!     use pmgrid
+!     use ppgrid
+!     use prescribed_aerosols, only: strat_volcanic
+      implicit none
+
+!     Input arguments
+!
+!       [kg m-2] Volcanics path above kth interface level
+!
+      integer, intent(in)         :: pcols, plev, plevp
+      real(r8), intent(in) :: aer_mpp(pcols,plevp)
+
+!     Output arguments
+!
+!       [fraction] Total volcanic transmission between interfaces k1 and k2
+!
+      real(r8), intent(out) ::  aer_trn_ttl(pcols,plevp,plevp,bnd_nbr_LW)
+
+!-------------------------------------------------------------------------
+!     Local variables
+
+      integer bnd_idx           ! LW band index
+      integer i                 ! lon index
+      integer k1                ! lev index
+      integer k2                ! lev index
+      real(r8) aer_pth_dlt      ! [kg m-2] Volcanics path between interface
+                                !          levels k1 and k2
+      real(r8) odap_aer_ttl     ! [fraction] Total path absorption optical
+                                !            depth
+
+!-------------------------------------------------------------------------
+
+      if (strat_volcanic) then
+        do bnd_idx=1,bnd_nbr_LW
+           do i=1,pcols
+              aer_trn_ttl(i,1,1,bnd_idx)=1.0
+           end do
+           do k1=2,plevp
+              do i=1,pcols
+                 aer_trn_ttl(i,k1,k1,bnd_idx)=1.0
+
+                 aer_pth_dlt  = abs(aer_mpp(i,k1) - aer_mpp(i,1))
+                 odap_aer_ttl = abs_cff_mss_aer(bnd_idx) * aer_pth_dlt
+
+                 aer_trn_ttl(i,1,k1,bnd_idx) = exp(-1.66 * odap_aer_ttl)
+              end do
+           end do
+
+           do k1=2,plev
+              do k2=k1+1,plevp
+                 do i=1,pcols
+                    aer_trn_ttl(i,k1,k2,bnd_idx) = &
+                         aer_trn_ttl(i,1,k2,bnd_idx) / &
+                         aer_trn_ttl(i,1,k1,bnd_idx)
+                 end do
+              end do
+           end do
+
+           do k1=2,plevp
+              do k2=1,k1-1
+                 do i=1,pcols
+                    aer_trn_ttl(i,k1,k2,bnd_idx)=aer_trn_ttl(i,k2,k1,bnd_idx)
+                 end do
+              end do
+           end do
+        end do
+      else
+        aer_trn_ttl = 1.0
+      endif
+
+      return
+      end subroutine aer_trn
+
+      subroutine aer_pth(aer_mass, aer_mpp, ncol, pcols, plev, plevp)
+!------------------------------------------------------
+!     Purpose: convert mass per layer to cumulative mass from Top
+!------------------------------------------------------
+!     use shr_kind_mod, only: r8 => shr_kind_r8
+!     use ppgrid
+!     use pmgrid
+      implicit none
+!#include <crdcon.h>
+
+!     Parameters
+!     Input
+      integer, intent(in)        :: pcols, plev, plevp
+      real(r8), intent(in):: aer_mass(pcols,plev)  ! Rad level aerosol mass mixing ratio
+      integer, intent(in):: ncol
+!
+!     Output
+      real(r8), intent(out):: aer_mpp(pcols,plevp) ! [kg m-2] Volcanics path above kth interface
+!
+!     Local
+      integer i      ! Column index
+      integer k      ! Level index
+!------------------------------------------------------
+!------------------------------------------------------
+
+      aer_mpp(1:ncol,1) =  0._r8
+      do k=2,plevp
+          aer_mpp(1:ncol,k) = aer_mpp(1:ncol,k-1) + aer_mass(1:ncol,k-1)
+      enddo
+!
+      return
+      end subroutine aer_pth
+
+subroutine radctl(j, lchnk   ,ncol    , pcols, pver, pverp, pverr, pverrp, ppcnst, pcnst,  &
+                  lwups   ,emis    ,          &
+                  pmid    ,pint    ,pmln    ,piln    ,pdel    ,t       , &
+!                 qm1     ,cld     ,cicewp  ,cliqwp  ,coszrs,  clat, &
+                  qm1     ,cld     ,cicewp  ,cliqwp  ,tauxcl, tauxci, coszrs,  clat, &
+                  asdir   ,asdif   ,aldir   ,aldif   ,solcon, GMT,JULDAY,JULIAN,DT,XTIME,  &
+                  pin, ozmixmj, ozmix, levsiz, num_months,      &
+                  m_psp, m_psn,  aerosoljp, aerosoljn, m_hybi, paerlev, naer_c, pmxrgn  , &
+                  nmxrgn  ,                   &
+                  doabsems, abstot, absnxt, emstot, &
+                  fsup    ,fsupc   ,fsdn    ,fsdnc   , &
+                  flup    ,flupc   ,fldn    ,fldnc   , &
+                  swcf    ,lwcf    ,flut    ,          &
+                  fsns    ,fsnt    ,flns    ,flnt    , &
+                  qrs     ,qrl     ,flwds   ,rel     ,rei     , &
+                  sols    ,soll    ,solsd   ,solld   , &
+                  landfrac,zm      ,fsds     )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Driver for radiation computation.
+! 
+! Method: 
+! Radiation uses cgs units, so conversions must be done from
+! model fields to radiation fields.
+!
+! Author: CCM1,  CMS Contact: J. Truesdale
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use pspect
+!  use commap
+!  use history, only: outfld
+!  use constituents, only: ppcnst, cnst_get_ind
+!  use prescribed_aerosols, only: get_aerosol, naer_all, aerosol_diagnostics, &
+!     aerosol_indirect, get_rf_scales, get_int_scales, radforce, idxVOLC
+!  use physics_types, only: physics_state
+!  use wv_saturation, only: aqsat
+!  use chemistry,    only: trace_gas
+!  use physconst, only: cpair, epsilo
+!  use aer_optics, only: idxVIS
+!  use aerosol_intr, only: set_aerosol_from_prognostics
+
+
+   implicit none
+
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk,j                 ! chunk identifier
+   integer, intent(in) :: ncol                  ! number of atmospheric columns
+   integer, intent(in) :: levsiz                ! number of ozone data levels
+   integer, intent(in) :: num_months            ! 12 months
+   integer, intent(in) :: paerlev,naer_c          ! aerosol vertical level and # species
+   integer, intent(in) :: pcols, pver, pverp, pverr, pverrp, ppcnst, pcnst
+   logical, intent(in) :: doabsems
+
+
+   integer nspint            ! Num of spctrl intervals across solar spectrum
+   integer naer_groups       ! Num of aerosol groups for optical diagnostics
+   parameter ( nspint = 19 )
+   parameter ( naer_groups = 7 )    ! current groupings are sul, sslt, all carbons, all dust, background, and all aerosols
+
+
+   real(r8), intent(in) :: lwups(pcols)         ! Longwave up flux at surface
+   real(r8), intent(in) :: emis(pcols,pver)     ! Cloud emissivity
+   real(r8), intent(in) :: pmid(pcols,pver)     ! Model level pressures
+   real(r8), intent(in) :: pint(pcols,pverp)    ! Model interface pressures
+   real(r8), intent(in) :: pmln(pcols,pver)     ! Natural log of pmid
+   real(r8), intent(in) :: rel(pcols,pver)      ! liquid effective drop size (microns)
+   real(r8), intent(in) :: rei(pcols,pver)      ! ice effective drop size (microns)
+   real(r8), intent(in) :: piln(pcols,pverp)    ! Natural log of pint
+   real(r8), intent(in) :: pdel(pcols,pverp)    ! Pressure difference across layer 
+   real(r8), intent(in) :: t(pcols,pver)        ! Model level temperatures
+   real(r8), intent(in) :: qm1(pcols,pver,ppcnst) ! Specific humidity and tracers
+   real(r8), intent(in) :: cld(pcols,pver)      ! Fractional cloud cover
+   real(r8), intent(in) :: cicewp(pcols,pver)   ! in-cloud cloud ice water path
+   real(r8), intent(in) :: cliqwp(pcols,pver)   ! in-cloud cloud liquid water path
+   real(r8), intent(inout) :: tauxcl(pcols,0:pver) ! cloud water optical depth
+   real(r8), intent(inout) :: tauxci(pcols,0:pver) ! cloud ice optical depth
+   real(r8), intent(in) :: coszrs(pcols)        ! Cosine solar zenith angle
+   real(r8), intent(in) :: clat(pcols)          ! latitude in radians for columns 
+   real(r8), intent(in) :: asdir(pcols)         ! albedo shortwave direct
+   real(r8), intent(in) :: asdif(pcols)         ! albedo shortwave diffuse
+   real(r8), intent(in) :: aldir(pcols)         ! albedo longwave direct
+   real(r8), intent(in) :: aldif(pcols)         ! albedo longwave diffuse
+   real(r8), intent(in) :: landfrac(pcols)      ! land fraction
+   real(r8), intent(in) :: zm(pcols,pver)       ! Height of midpoints (above surface)
+   real(r8), intent(in) :: pin(levsiz)          ! Pressure levels of ozone data
+   real(r8), intent(in) :: ozmixmj(pcols,levsiz,num_months)  ! monthly ozone mixing ratio
+   real(r8), intent(inout) :: ozmix(pcols,levsiz)  ! Ozone data
+   real, intent(in) :: solcon               ! solar constant with eccentricity factor
+   REAL, INTENT(IN    )      ::        XTIME,GMT              
+   INTEGER, INTENT(IN )      ::        JULDAY
+   REAL,    INTENT(IN )      ::        JULIAN
+   REAL,    INTENT(IN )      ::        DT
+   real(r8), intent(in)     :: m_psp(pcols),m_psn(pcols)       ! MATCH surface pressure
+   real(r8), intent(in)     :: aerosoljp(pcols,paerlev,naer_c)   ! aerosol concentrations
+   real(r8), intent(in)     :: aerosoljn(pcols,paerlev,naer_c)   ! aerosol concentrations
+   real(r8), intent(in)     :: m_hybi(paerlev)
+!  type(physics_state), intent(in) :: state     
+   real(r8), intent(inout) :: pmxrgn(pcols,pverp) ! Maximum values of pmid for each
+!    maximally overlapped region.
+!    0->pmxrgn(i,1) is range of pmid for
+!    1st region, pmxrgn(i,1)->pmxrgn(i,2) for
+!    2nd region, etc
+   integer, intent(inout) :: nmxrgn(pcols)     ! Number of maximally overlapped regions
+
+    real(r8) :: pmxrgnrf(pcols,pverp)             ! temporary copy of pmxrgn
+    integer  :: nmxrgnrf(pcols)     ! temporary copy of nmxrgn
+
+!
+! Output solar arguments
+!
+   real(r8), intent(out) :: fsns(pcols)          ! Surface absorbed solar flux
+   real(r8), intent(out) :: fsnt(pcols)          ! Net column abs solar flux at model top
+   real(r8), intent(out) :: flns(pcols)          ! Srf longwave cooling (up-down) flux
+   real(r8), intent(out) :: flnt(pcols)          ! Net outgoing lw flux at model top
+   real(r8), intent(out) :: sols(pcols)          ! Downward solar rad onto surface (sw direct)
+   real(r8), intent(out) :: soll(pcols)          ! Downward solar rad onto surface (lw direct)
+   real(r8), intent(out) :: solsd(pcols)         ! Downward solar rad onto surface (sw diffuse)
+   real(r8), intent(out) :: solld(pcols)         ! Downward solar rad onto surface (lw diffuse)
+   real(r8), intent(out) :: qrs(pcols,pver)      ! Solar heating rate
+   real(r8), intent(out) :: fsds(pcols)          ! Flux Shortwave Downwelling Surface
+! Added outputs of total and clearsky fluxes etc
+   real(r8), intent(out) :: fsup(pcols,pverp)    ! Upward total sky solar
+   real(r8), intent(out) :: fsupc(pcols,pverp)   ! Upward clear sky solar
+   real(r8), intent(out) :: fsdn(pcols,pverp)    ! Downward total sky solar
+   real(r8), intent(out) :: fsdnc(pcols,pverp)   ! Downward clear sky solar
+   real(r8), intent(out) :: flup(pcols,pverp)    ! Upward total sky longwave
+   real(r8), intent(out) :: flupc(pcols,pverp)   ! Upward clear sky longwave
+   real(r8), intent(out) :: fldn(pcols,pverp)    ! Downward total sky longwave
+   real(r8), intent(out) :: fldnc(pcols,pverp)   ! Downward clear sky longwave
+   real(r8), intent(out) :: swcf(pcols)          ! Top of the atmosphere solar cloud forcing
+   real(r8), intent(out) :: lwcf(pcols)          ! Top of the atmosphere longwave cloud forcing
+   real(r8), intent(out) :: flut(pcols)          ! Top of the atmosphere outgoing longwave
+!
+! Output longwave arguments
+!
+   real(r8), intent(out) :: qrl(pcols,pver)      ! Longwave cooling rate
+   real(r8), intent(out) :: flwds(pcols)         ! Surface down longwave flux
+
+   real(r8), intent(inout) :: abstot(pcols,pverp,pverp) ! Total absorptivity
+   real(r8), intent(inout) :: absnxt(pcols,pver,4)      ! Total nearest layer absorptivity
+   real(r8), intent(inout) :: emstot(pcols,pverp)     ! Total emissivity
+
+
+!
+!---------------------------Local variables-----------------------------
+!
+   integer i, k              ! index
+
+   integer :: in2o, ich4, if11, if12 ! indexes of gases in constituent array
+
+   real(r8) solin(pcols)         ! Solar incident flux
+!  real(r8) fsds(pcols)          ! Flux Shortwave Downwelling Surface
+   real(r8) fsntoa(pcols)        ! Net solar flux at TOA
+   real(r8) fsntoac(pcols)       ! Clear sky net solar flux at TOA
+   real(r8) fsnirt(pcols)        ! Near-IR flux absorbed at toa
+   real(r8) fsnrtc(pcols)        ! Clear sky near-IR flux absorbed at toa
+   real(r8) fsnirtsq(pcols)      ! Near-IR flux absorbed at toa >= 0.7 microns
+   real(r8) fsntc(pcols)         ! Clear sky total column abs solar flux
+   real(r8) fsnsc(pcols)         ! Clear sky surface abs solar flux
+   real(r8) fsdsc(pcols)         ! Clear sky surface downwelling solar flux
+!  real(r8) flut(pcols)          ! Upward flux at top of model
+!  real(r8) lwcf(pcols)          ! longwave cloud forcing
+!  real(r8) swcf(pcols)          ! shortwave cloud forcing
+   real(r8) flutc(pcols)         ! Upward Clear Sky flux at top of model
+   real(r8) flntc(pcols)         ! Clear sky lw flux at model top
+   real(r8) flnsc(pcols)         ! Clear sky lw flux at srf (up-down)
+   real(r8) ftem(pcols,pver)     ! temporary array for outfld
+
+   real(r8) pbr(pcols,pverr)     ! Model mid-level pressures (dynes/cm2)
+   real(r8) pnm(pcols,pverrp)    ! Model interface pressures (dynes/cm2)
+   real(r8) o3vmr(pcols,pverr)   ! Ozone volume mixing ratio
+   real(r8) o3mmr(pcols,pverr)   ! Ozone mass mixing ratio
+   real(r8) eccf                 ! Earth/sun distance factor
+   real(r8) n2o(pcols,pver)      ! nitrous oxide mass mixing ratio
+   real(r8) ch4(pcols,pver)      ! methane mass mixing ratio
+   real(r8) cfc11(pcols,pver)    ! cfc11 mass mixing ratio
+   real(r8) cfc12(pcols,pver)    ! cfc12 mass mixing ratio
+   real(r8) rh(pcols,pverr)      ! level relative humidity (fraction)
+   real(r8) lwupcgs(pcols)       ! Upward longwave flux in cgs units
+
+   real(r8) esat(pcols,pverr)    ! saturation vapor pressure
+   real(r8) qsat(pcols,pverr)    ! saturation specific humidity
+
+   real(r8) :: frc_day(pcols) ! = 1 for daylight, =0 for night colums
+   real(r8) :: aertau(pcols,nspint,naer_groups) ! Aerosol column optical depth
+   real(r8) :: aerssa(pcols,nspint,naer_groups) ! Aerosol column averaged single scattering albedo
+   real(r8) :: aerasm(pcols,nspint,naer_groups) ! Aerosol column averaged asymmetry parameter
+   real(r8) :: aerfwd(pcols,nspint,naer_groups) ! Aerosol column averaged forward scattering
+
+   real(r8) aerosol(pcols, pver, naer_all) ! aerosol mass mixing ratios
+   real(r8) scales(naer_all)               ! scaling factors for aerosols
+
+
+!
+! Interpolate ozone volume mixing ratio to model levels
+!
+! WRF: added pin, levsiz, ozmix here
+   call oznint(julday,julian,dt,gmt,xtime,ozmixmj,ozmix,levsiz,num_months,pcols)
+
+   call radozn(lchnk   ,ncol    &
+              ,pcols, pver &
+              ,pmid    ,pin, levsiz, ozmix, o3vmr   )
+
+!  call outfld('O3VMR   ',o3vmr ,pcols, lchnk)
+
+!
+! Set chunk dependent radiation input
+!
+   call radinp(lchnk   ,ncol    ,pcols, pver, pverp,      &
+               pmid    ,pint    ,o3vmr   , pbr     ,&
+               pnm     ,eccf    ,o3mmr   )
+
+!
+! Solar radiation computation
+!
+   if (dosw) then
+
+!
+! calculate heating with aerosols
+!
+      call aqsat(t, pmid, esat, qsat, pcols, &
+                 ncol, pver, 1, pver)
+
+      ! calculate relative humidity
+!     rh(1:ncol,1:pver) = q(1:ncol,1:pver,1) / qsat(1:ncol,1:pver) * &
+!        ((1.0 - epsilo) * qsat(1:ncol,1:pver) + epsilo) / &
+!        ((1.0 - epsilo) * q(1:ncol,1:pver,1) + epsilo)
+      rh(1:ncol,1:pver) = qm1(1:ncol,1:pver,1) / qsat(1:ncol,1:pver) * &
+         ((1.0 - epsilo) * qsat(1:ncol,1:pver) + epsilo) / &
+         ((1.0 - epsilo) * qm1(1:ncol,1:pver,1) + epsilo)
+
+      if (radforce) then
+
+         pmxrgnrf = pmxrgn
+         nmxrgnrf = nmxrgn
+
+         call get_rf_scales(scales)
+
+         call get_aerosol(lchnk, julday, julian, dt, gmt, xtime, m_psp, m_psn, aerosoljp, &
+           aerosoljn, m_hybi, paerlev, naer, pint, pcols, pver, pverp, pverr, pverrp, aerosol, scales)
+
+         ! overwrite with prognostics aerosols
+
+!   no feedback from prognostic aerosols 
+!        call set_aerosol_from_prognostics (ncol, q, aerosol)
+
+         call aerosol_indirect(ncol,lchnk,pcols,pver,ppcnst,landfrac,pmid,t,qm1,cld,zm,rel)
+   
+!        call t_startf('radcswmx_rf')
+         call radcswmx(j, lchnk   ,ncol ,pcols, pver, pverp,         &
+                    pnm     ,pbr     ,qm1     ,rh      ,o3mmr   , &
+                    aerosol ,cld     ,cicewp  ,cliqwp  ,rel     , &
+!                   rei     ,eccf    ,coszrs  ,scon    ,solin   ,solcon , &
+                    rei     ,tauxcl  ,tauxci  ,eccf    ,coszrs  ,scon    ,solin   ,solcon , &
+                    asdir   ,asdif   ,aldir   ,aldif   ,nmxrgnrf, &
+                    pmxrgnrf,qrs     ,fsnt    ,fsntc   ,fsntoa  , &
+                    fsntoac ,fsnirt  ,fsnrtc  ,fsnirtsq,fsns    , &
+                    fsnsc   ,fsdsc   ,fsds    ,sols    ,soll    , &
+                    solsd   ,solld   ,frc_day ,                   &
+                    fsup    ,fsupc   ,fsdn    ,fsdnc   ,          &
+                    aertau  ,aerssa  ,aerasm  ,aerfwd             )
+!        call t_stopf('radcswmx_rf')
+
+!
+! Convert units of shortwave fields needed by rest of model from CGS to MKS
+!
+
+            do i = 1, ncol
+            solin(i) = solin(i)*1.e-3
+            fsnt(i)  = fsnt(i) *1.e-3
+            fsns(i)  = fsns(i) *1.e-3
+            fsntc(i) = fsntc(i)*1.e-3
+            fsnsc(i) = fsnsc(i)*1.e-3
+            end do
+         ftem(:ncol,:pver) = qrs(:ncol,:pver)/cpair
+!
+! Dump shortwave radiation information to history tape buffer (diagnostics)
+!
+!        call outfld('QRS_RF  ',ftem  ,pcols,lchnk)
+!        call outfld('FSNT_RF ',fsnt  ,pcols,lchnk)
+!        call outfld('FSNS_RF ',fsns  ,pcols,lchnk)
+!        call outfld('FSNTC_RF',fsntc ,pcols,lchnk)
+!        call outfld('FSNSC_RF',fsnsc ,pcols,lchnk)
+ 
+      endif ! if (radforce)
+
+      call get_int_scales(scales)
+
+      call get_aerosol(lchnk, julday, julian, dt, gmt, xtime, m_psp, m_psn, aerosoljp, aerosoljn, &
+             m_hybi, paerlev, naer, pint, pcols, pver, pverp, pverr, pverrp, aerosol, scales)
+
+      ! overwrite with prognostics aerosols
+!     call set_aerosol_from_prognostics (ncol, q, aerosol)
+
+      call aerosol_indirect(ncol,lchnk,pcols,pver,ppcnst,landfrac,pmid,t,qm1,cld,zm,rel)
+!     call t_startf('radcswmx')
+
+      call radcswmx(j, lchnk   ,ncol    ,pcols, pver, pverp,         &
+                    pnm     ,pbr     ,qm1     ,rh      ,o3mmr   , &
+                    aerosol ,cld     ,cicewp  ,cliqwp  ,rel     , &
+!                   rei     ,eccf    ,coszrs  ,scon    ,solin   ,solcon , &
+                    rei     ,tauxcl  ,tauxci  ,eccf    ,coszrs  ,scon    ,solin   ,solcon , &
+                    asdir   ,asdif   ,aldir   ,aldif   ,nmxrgn  , &
+                    pmxrgn  ,qrs     ,fsnt    ,fsntc   ,fsntoa  , &
+                    fsntoac ,fsnirt  ,fsnrtc  ,fsnirtsq,fsns    , &
+                    fsnsc   ,fsdsc   ,fsds    ,sols    ,soll    , &
+                    solsd   ,solld   ,frc_day ,                   &
+                    fsup    ,fsupc   ,fsdn    ,fsdnc   ,          &
+                    aertau  ,aerssa  ,aerasm  ,aerfwd             )
+!     call t_stopf('radcswmx')
+
+! -- tls ---------------------------------------------------------------2
+!
+! Convert units of shortwave fields needed by rest of model from CGS to MKS
+!
+      do i=1,ncol
+         solin(i) = solin(i)*1.e-3
+         fsds(i)  = fsds(i)*1.e-3
+         fsnirt(i)= fsnirt(i)*1.e-3
+         fsnrtc(i)= fsnrtc(i)*1.e-3
+         fsnirtsq(i)= fsnirtsq(i)*1.e-3
+         fsnt(i)  = fsnt(i) *1.e-3
+         fsns(i)  = fsns(i) *1.e-3
+         fsntc(i) = fsntc(i)*1.e-3
+         fsnsc(i) = fsnsc(i)*1.e-3
+         fsdsc(i) = fsdsc(i)*1.e-3
+         fsntoa(i)=fsntoa(i)*1.e-3
+         fsntoac(i)=fsntoac(i)*1.e-3
+      end do
+      ftem(:ncol,:pver) = qrs(:ncol,:pver)/cpair
+
+! Added upward/downward total and clear sky fluxes
+         do k = 1, pverp
+            do i = 1, ncol
+            fsup(i,k)  = fsup(i,k)*1.e-3
+            fsupc(i,k) = fsupc(i,k)*1.e-3
+            fsdn(i,k)  = fsdn(i,k)*1.e-3
+            fsdnc(i,k) = fsdnc(i,k)*1.e-3
+            end do
+         end do
+
+!
+! Dump shortwave radiation information to history tape buffer (diagnostics)
+!
+
+!     call outfld('frc_day ', frc_day, pcols, lchnk)
+!     call outfld('SULOD_v ', aertau(:,idxVIS,1) ,pcols,lchnk)
+!     call outfld('SSLTOD_v', aertau(:,idxVIS,2) ,pcols,lchnk)
+!     call outfld('CAROD_v ', aertau(:,idxVIS,3) ,pcols,lchnk)
+!     call outfld('DUSTOD_v', aertau(:,idxVIS,4) ,pcols,lchnk)
+!     call outfld('BGOD_v  ', aertau(:,idxVIS,5) ,pcols,lchnk)
+!     call outfld('VOLCOD_v', aertau(:,idxVIS,6) ,pcols,lchnk)
+!     call outfld('AEROD_v ', aertau(:,idxVIS,7) ,pcols,lchnk)
+!     call outfld('AERSSA_v', aerssa(:,idxVIS,7) ,pcols,lchnk)
+!     call outfld('AERASM_v', aerasm(:,idxVIS,7) ,pcols,lchnk)
+!     call outfld('AERFWD_v', aerfwd(:,idxVIS,7) ,pcols,lchnk)
+!     call aerosol_diagnostics (lchnk, ncol, pdel, aerosol)
+
+!     call outfld('QRS     ',ftem  ,pcols,lchnk)
+!     call outfld('SOLIN   ',solin ,pcols,lchnk)
+!     call outfld('FSDS    ',fsds  ,pcols,lchnk)
+!     call outfld('FSNIRTOA',fsnirt,pcols,lchnk)
+!     call outfld('FSNRTOAC',fsnrtc,pcols,lchnk)
+!     call outfld('FSNRTOAS',fsnirtsq,pcols,lchnk)
+!     call outfld('FSNT    ',fsnt  ,pcols,lchnk)
+!     call outfld('FSNS    ',fsns  ,pcols,lchnk)
+!     call outfld('FSNTC   ',fsntc ,pcols,lchnk)
+!     call outfld('FSNSC   ',fsnsc ,pcols,lchnk)
+!     call outfld('FSDSC   ',fsdsc ,pcols,lchnk)
+!     call outfld('FSNTOA  ',fsntoa,pcols,lchnk)
+!     call outfld('FSNTOAC ',fsntoac,pcols,lchnk)
+!     call outfld('SOLS    ',sols  ,pcols,lchnk)
+!     call outfld('SOLL    ',soll  ,pcols,lchnk)
+!     call outfld('SOLSD   ',solsd ,pcols,lchnk)
+!     call outfld('SOLLD   ',solld ,pcols,lchnk)
+
+   end if
+!
+! Longwave radiation computation
+!
+   if (dolw) then
+!
+! Convert upward longwave flux units to CGS
+!
+      do i=1,ncol
+!        lwupcgs(i) = lwup(i)*1000.
+         lwupcgs(i) = lwups(i)
+      end do
+!
+! Do longwave computation. If not implementing greenhouse gas code then
+! first specify trace gas mixing ratios. If greenhouse gas code then:
+!  o ixtrcg   => indx of advected n2o tracer
+!  o ixtrcg+1 => indx of advected ch4 tracer
+!  o ixtrcg+2 => indx of advected cfc11 tracer
+!  o ixtrcg+3 => indx of advected cfc12 tracer
+!
+      if (trace_gas) then
+!        call cnst_get_ind('N2O'  , in2o)
+!        call cnst_get_ind('CH4'  , ich4)
+!        call cnst_get_ind('CFC11', if11)
+!        call cnst_get_ind('CFC12', if12)
+!        call t_startf("radclwmx")
+         call radclwmx(lchnk   ,ncol    ,pcols, pver, pverp ,        & 
+                       lwupcgs ,t       ,qm1(1,1,1)       ,o3vmr ,   &
+                       pbr     ,pnm     ,pmln    ,piln    ,          &
+                       qm1(1,1,in2o)    ,qm1(1,1,ich4)    ,          &
+                       qm1(1,1,if11)    ,qm1(1,1,if12)    ,          &
+                       cld     ,emis    ,pmxrgn  ,nmxrgn  ,qrl     , &
+                       doabsems, abstot, absnxt, emstot,             &
+                       flns    ,flnt    ,flnsc   ,flntc   ,flwds   , &
+                       flut    ,flutc   ,                            &
+                       flup    ,flupc   ,fldn    ,fldnc   ,          &
+                       aerosol(:,:,idxVOLC))
+!        call t_stopf("radclwmx")
+      else
+         call trcmix(lchnk   ,ncol    ,pcols, pver,  &
+                     pmid    ,clat, n2o     ,ch4     ,                     &
+                     cfc11   ,cfc12   )
+
+!        call t_startf("radclwmx")
+         call radclwmx(lchnk     ,ncol    ,pcols, pver, pverp ,        &
+                       lwupcgs   ,t       ,qm1(1,1,1)       ,o3vmr ,   &
+                       pbr       ,pnm     ,pmln    ,piln    ,          &
+                       n2o       ,ch4     ,cfc11   ,cfc12   ,          &
+                       cld       ,emis    ,pmxrgn  ,nmxrgn  ,qrl     , &
+                       doabsems, abstot, absnxt, emstot,             &
+                       flns      ,flnt    ,flnsc   ,flntc   ,flwds   , &
+                       flut      ,flutc   ,                            &
+                       flup      ,flupc   ,fldn    ,fldnc   ,          &
+                       aerosol(:,:,idxVOLC))
+!        call t_stopf("radclwmx")
+      endif
+!
+! Convert units of longwave fields needed by rest of model from CGS to MKS
+!
+      do i=1,ncol
+         flnt(i)  = flnt(i)*1.e-3
+         flut(i)  = flut(i)*1.e-3
+         flutc(i) = flutc(i)*1.e-3
+         flns(i)  = flns(i)*1.e-3
+         flntc(i) = flntc(i)*1.e-3
+         flnsc(i) = flnsc(i)*1.e-3
+         flwds(i) = flwds(i)*1.e-3
+         lwcf(i)  = flutc(i) - flut(i)
+         swcf(i)  = fsntoa(i) - fsntoac(i)
+      end do
+
+! Added upward/downward total and clear sky fluxes
+         do k = 1, pverp
+            do i = 1, ncol
+            flup(i,k)  = flup(i,k)*1.e-3
+            flupc(i,k) = flupc(i,k)*1.e-3
+            fldn(i,k)  = fldn(i,k)*1.e-3
+            fldnc(i,k) = fldnc(i,k)*1.e-3
+            end do
+         end do
+!
+! Dump longwave radiation information to history tape buffer (diagnostics)
+!
+!     call outfld('QRL     ',qrl(:ncol,:)/cpair,ncol,lchnk)
+!     call outfld('FLNT    ',flnt  ,pcols,lchnk)
+!     call outfld('FLUT    ',flut  ,pcols,lchnk)
+!     call outfld('FLUTC   ',flutc ,pcols,lchnk)
+!     call outfld('FLNTC   ',flntc ,pcols,lchnk)
+!     call outfld('FLNS    ',flns  ,pcols,lchnk)
+!     call outfld('FLNSC   ',flnsc ,pcols,lchnk)
+!     call outfld('LWCF    ',lwcf  ,pcols,lchnk)
+!     call outfld('SWCF    ',swcf  ,pcols,lchnk)
+!
+   end if
+!
+   return
+end subroutine radctl
+  subroutine param_cldoptics_calc(ncol, pcols, pver, pverp, pverr, pverrp, ppcnst, &
+                                  q, cldn, landfrac, landm,icefrac, &
+        pdel,  t, ps, pmid, pint, cicewp, cliqwp, emis, rel, rei, pmxrgn, nmxrgn, snowh )
+!
+! Compute (liquid+ice) water path and cloud water/ice diagnostics
+! *** soon this code will compute liquid and ice paths from input liquid and ice mixing ratios
+! 
+! **** mixes interface and physics code temporarily
+!-----------------------------------------------------------------------
+!   use physics_types, only: physics_state
+!   use history,       only: outfld
+!   use pkg_cldoptics, only: cldefr, cldems, cldovrlap, cldclw
+
+    implicit none
+
+! Arguments
+    integer, intent(in) :: ncol, pcols, pver, pverp, pverr, pverrp, ppcnst
+    real(r8), intent(in)  :: q(pcols,pver,ppcnst)     ! moisture arrays
+    real(r8), intent(in)  :: cldn(pcols,pver)        ! new cloud fraction
+    real(r8), intent(in)  :: pdel(pcols,pver)        ! pressure thickness
+    real(r8), intent(in)  :: t(pcols,pver)           ! temperature
+    real(r8), intent(in)  :: pmid(pcols,pver)        ! pressure 
+    real(r8), intent(in)  :: pint(pcols,pverp)       ! pressure 
+    real(r8), intent(in)  :: ps(pcols)               ! surface pressure 
+    real(r8), intent(in)  :: landfrac(pcols)         ! Land fraction
+    real(r8), intent(in)  :: icefrac(pcols)          ! Ice fraction
+    real(r8), intent(in)  :: landm(pcols)            ! Land fraction ramped
+    real(r8), intent(in) :: snowh(pcols)         ! Snow depth over land, water equivalent (m)
+
+!!$    real(r8), intent(out) :: cwp   (pcols,pver)      ! in-cloud cloud (total) water path
+    real(r8), intent(out) :: cicewp(pcols,pver)      ! in-cloud cloud ice water path
+    real(r8), intent(out) :: cliqwp(pcols,pver)      ! in-cloud cloud liquid water path
+    real(r8), intent(out) :: emis  (pcols,pver)      ! cloud emissivity
+    real(r8), intent(out) :: rel   (pcols,pver)      ! effective drop radius (microns)
+    real(r8), intent(out) :: rei   (pcols,pver)      ! ice effective drop size (microns)
+    real(r8), intent(out) :: pmxrgn(pcols,pver+1)    ! Maximum values of pressure for each
+    integer , intent(out) :: nmxrgn(pcols)           ! Number of maximally overlapped regions
+
+! Local variables
+    real(r8) :: cwp   (pcols,pver)      ! in-cloud cloud (total) water path
+!!$    real(r8) :: cicewp(pcols,pver)      ! in-cloud cloud ice water path
+!!$    real(r8) :: cliqwp(pcols,pver)      ! in-cloud cloud liquid water path
+    real(r8) :: effcld(pcols,pver)                   ! effective cloud=cld*emis
+    real(r8) :: gicewp(pcols,pver)                   ! grid-box cloud ice water path
+    real(r8) :: gliqwp(pcols,pver)                   ! grid-box cloud liquid water path
+    real(r8) :: gwp   (pcols,pver)                   ! grid-box cloud (total) water path
+    real(r8) :: hl     (pcols)                       ! Liquid water scale height
+    real(r8) :: tgicewp(pcols)                       ! Vertically integrated ice water path
+    real(r8) :: tgliqwp(pcols)                       ! Vertically integrated liquid water path
+    real(r8) :: tgwp   (pcols)                       ! Vertically integrated (total) cloud water path
+    real(r8) :: tpw    (pcols)                       ! total precipitable water
+    real(r8) :: clwpold(pcols,pver)                  ! Presribed cloud liq. h2o path
+    real(r8) :: ficemr (pcols,pver)                  ! Ice fraction from ice and liquid mixing ratios
+
+    real(r8) :: rgrav                ! inverse gravitational acceleration
+
+    integer :: i,k                                   ! loop indexes
+    integer :: lchnk
+
+!-----------------------------------------------------------------------
+
+! Compute liquid and ice water paths
+    tgicewp(:ncol) = 0.
+    tgliqwp(:ncol) = 0.
+    do k=1,pver
+       do i = 1,ncol
+          gicewp(i,k) = q(i,k,ixcldice)*pdel(i,k)/gravmks*1000.0  ! Grid box ice water path.
+          gliqwp(i,k) = q(i,k,ixcldliq)*pdel(i,k)/gravmks*1000.0  ! Grid box liquid water path.
+!!$          gwp   (i,k) = gicewp(i,k) + gliqwp(i,k)
+          cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k))                 ! In-cloud ice water path.
+          cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k))                 ! In-cloud liquid water path.
+!!$          cwp   (i,k) = gwp   (i,k) / max(0.01_r8,cldn(i,k))
+          ficemr(i,k) = q(i,k,ixcldice) /                 &
+               max(1.e-10_r8,(q(i,k,ixcldice)+q(i,k,ixcldliq)))
+          
+          tgicewp(i)  = tgicewp(i) + gicewp(i,k)
+          tgliqwp(i)  = tgliqwp(i) + gliqwp(i,k)
+       end do
+    end do
+    tgwp(:ncol) = tgicewp(:ncol) + tgliqwp(:ncol)
+    gwp(:ncol,:pver) = gicewp(:ncol,:pver) + gliqwp(:ncol,:pver) 
+    cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) 
+
+! Compute total preciptable water in column (in mm)
+    tpw(:ncol) = 0.0
+    rgrav = 1.0/gravmks
+    do k=1,pver
+       do i=1,ncol
+          tpw(i) = tpw(i) + pdel(i,k)*q(i,k,1)*rgrav
+       end do
+    end do
+
+! Diagnostic liquid water path (old specified form)
+!   call cldclw(lchnk, ncol, pcols, pver, pverp, state%zi, clwpold, tpw, hl)
+
+! Cloud water and ice particle sizes
+    call cldefr(lchnk, ncol, pcols, pver, pverp, landfrac, t, rel, rei, ps, pmid, landm, icefrac, snowh)
+
+! Cloud emissivity.
+    call cldems(lchnk, ncol, pcols, pver, pverp, cwp, ficemr, rei, emis)
+
+! Effective cloud cover
+    do k=1,pver
+       do i=1,ncol
+          effcld(i,k) = cldn(i,k)*emis(i,k)
+       end do
+    end do
+
+! Determine parameters for maximum/random overlap
+    call cldovrlap(lchnk, ncol, pcols, pver, pverp, pint, cldn, nmxrgn, pmxrgn)
+
+!   call outfld('GCLDLWP' ,gwp    , pcols,lchnk)
+!   call outfld('TGCLDCWP',tgwp   , pcols,lchnk)
+!   call outfld('TGCLDLWP',tgliqwp, pcols,lchnk)
+!   call outfld('TGCLDIWP',tgicewp, pcols,lchnk)
+!   call outfld('ICLDLWP' ,cwp    , pcols,lchnk)
+!   call outfld('SETLWP'  ,clwpold, pcols,lchnk)
+!   call outfld('EFFCLD'  ,effcld , pcols,lchnk)
+!   call outfld('LWSH'    ,hl     , pcols,lchnk)
+
+  end subroutine param_cldoptics_calc
+
+subroutine radabs(lchnk   ,ncol    ,pcols, pver, pverp,   &
+   pbr    ,pnm     ,co2em    ,co2eml  ,tplnka  , &
+   s2c    ,tcg     ,w        ,h2otr   ,plco2   , &
+   plh2o  ,co2t    ,tint     ,tlayr   ,plol    , &
+   plos   ,pmln    ,piln     ,ucfc11  ,ucfc12  , &
+   un2o0  ,un2o1   ,uch4     ,uco211  ,uco212  , &
+   uco213 ,uco221  ,uco222   ,uco223  ,uptype  , &
+   bn2o0  ,bn2o1   ,bch4    ,abplnk1  ,abplnk2 , &
+   abstot ,absnxt  ,plh2ob  ,wb       , &
+   aer_mpp ,aer_trn_ttl)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Compute absorptivities for h2o, co2, o3, ch4, n2o, cfc11 and cfc12
+! 
+! Method: 
+! h2o  ....  Uses nonisothermal emissivity method for water vapor from
+!            Ramanathan, V. and  P.Downey, 1986: A Nonisothermal
+!            Emissivity and Absorptivity Formulation for Water Vapor
+!            Journal of Geophysical Research, vol. 91., D8, pp 8649-8666
+!
+!            Implementation updated by Collins, Hackney, and Edwards (2001)
+!               using line-by-line calculations based upon Hitran 1996 and
+!               CKD 2.1 for absorptivity and emissivity
+!
+!            Implementation updated by Collins, Lee-Taylor, and Edwards (2003)
+!               using line-by-line calculations based upon Hitran 2000 and
+!               CKD 2.4 for absorptivity and emissivity
+!
+! co2  ....  Uses absorptance parameterization of the 15 micro-meter
+!            (500 - 800 cm-1) band system of Carbon Dioxide, from
+!            Kiehl, J.T. and B.P.Briegleb, 1991: A New Parameterization
+!            of the Absorptance Due to the 15 micro-meter Band System
+!            of Carbon Dioxide Jouranl of Geophysical Research,
+!            vol. 96., D5, pp 9013-9019.
+!            Parameterizations for the 9.4 and 10.4 mircon bands of CO2
+!            are also included.
+!
+! o3   ....  Uses absorptance parameterization of the 9.6 micro-meter
+!            band system of ozone, from Ramanathan, V. and R.Dickinson,
+!            1979: The Role of stratospheric ozone in the zonal and
+!            seasonal radiative energy balance of the earth-troposphere
+!            system. Journal of the Atmospheric Sciences, Vol. 36,
+!            pp 1084-1104
+!
+! ch4  ....  Uses a broad band model for the 7.7 micron band of methane.
+!
+! n20  ....  Uses a broad band model for the 7.8, 8.6 and 17.0 micron
+!            bands of nitrous oxide
+!
+! cfc11 ...  Uses a quasi-linear model for the 9.2, 10.7, 11.8 and 12.5
+!            micron bands of CFC11
+!
+! cfc12 ...  Uses a quasi-linear model for the 8.6, 9.1, 10.8 and 11.2
+!            micron bands of CFC12
+!
+!
+! Computes individual absorptivities for non-adjacent layers, accounting
+! for band overlap, and sums to obtain the total; then, computes the
+! nearest layer contribution.
+! 
+! Author: W. Collins (H2O absorptivity) and J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                       ! chunk identifier
+   integer, intent(in) :: ncol                        ! number of atmospheric columns
+   integer, intent(in) :: pcols, pver, pverp
+
+   real(r8), intent(in) :: pbr(pcols,pver)            ! Prssr at mid-levels (dynes/cm2)
+   real(r8), intent(in) :: pnm(pcols,pverp)           ! Prssr at interfaces (dynes/cm2)
+   real(r8), intent(in) :: co2em(pcols,pverp)         ! Co2 emissivity function
+   real(r8), intent(in) :: co2eml(pcols,pver)         ! Co2 emissivity function
+   real(r8), intent(in) :: tplnka(pcols,pverp)        ! Planck fnctn level temperature
+   real(r8), intent(in) :: s2c(pcols,pverp)           ! H2o continuum path length
+   real(r8), intent(in) :: tcg(pcols,pverp)           ! H2o-mass-wgted temp. (Curtis-Godson approx.)
+   real(r8), intent(in) :: w(pcols,pverp)             ! H2o prs wghted path
+   real(r8), intent(in) :: h2otr(pcols,pverp)         ! H2o trnsmssn fnct for o3 overlap
+   real(r8), intent(in) :: plco2(pcols,pverp)         ! Co2 prs wghted path length
+   real(r8), intent(in) :: plh2o(pcols,pverp)         ! H2o prs wfhted path length
+   real(r8), intent(in) :: co2t(pcols,pverp)          ! Tmp and prs wghted path length
+   real(r8), intent(in) :: tint(pcols,pverp)          ! Interface temperatures
+   real(r8), intent(in) :: tlayr(pcols,pverp)         ! K-1 level temperatures
+   real(r8), intent(in) :: plol(pcols,pverp)          ! Ozone prs wghted path length
+   real(r8), intent(in) :: plos(pcols,pverp)          ! Ozone path length
+   real(r8), intent(in) :: pmln(pcols,pver)           ! Ln(pmidm1)
+   real(r8), intent(in) :: piln(pcols,pverp)          ! Ln(pintm1)
+   real(r8), intent(in) :: plh2ob(nbands,pcols,pverp) ! Pressure weighted h2o path with 
+                                                      !    Hulst-Curtis-Godson temp. factor 
+                                                      !    for H2O bands 
+   real(r8), intent(in) :: wb(nbands,pcols,pverp)     ! H2o path length with 
+                                                      !    Hulst-Curtis-Godson temp. factor 
+                                                      !    for H2O bands 
+
+   real(r8), intent(in) :: aer_mpp(pcols,pverp) ! STRAER path above kth interface level
+   real(r8), intent(in) :: aer_trn_ttl(pcols,pverp,pverp,bnd_nbr_LW) ! aer trn.
+
+
+!
+! Trace gas variables
+!
+   real(r8), intent(in) :: ucfc11(pcols,pverp)        ! CFC11 path length
+   real(r8), intent(in) :: ucfc12(pcols,pverp)        ! CFC12 path length
+   real(r8), intent(in) :: un2o0(pcols,pverp)         ! N2O path length
+   real(r8), intent(in) :: un2o1(pcols,pverp)         ! N2O path length (hot band)
+   real(r8), intent(in) :: uch4(pcols,pverp)          ! CH4 path length
+   real(r8), intent(in) :: uco211(pcols,pverp)        ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco212(pcols,pverp)        ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco213(pcols,pverp)        ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco221(pcols,pverp)        ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uco222(pcols,pverp)        ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uco223(pcols,pverp)        ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uptype(pcols,pverp)        ! continuum path length
+   real(r8), intent(in) :: bn2o0(pcols,pverp)         ! pressure factor for n2o
+   real(r8), intent(in) :: bn2o1(pcols,pverp)         ! pressure factor for n2o
+   real(r8), intent(in) :: bch4(pcols,pverp)          ! pressure factor for ch4
+   real(r8), intent(in) :: abplnk1(14,pcols,pverp)    ! non-nearest layer Planck factor
+   real(r8), intent(in) :: abplnk2(14,pcols,pverp)    ! nearest layer factor
+!
+! Output arguments
+!
+   real(r8), intent(out) :: abstot(pcols,pverp,pverp) ! Total absorptivity
+   real(r8), intent(out) :: absnxt(pcols,pver,4)      ! Total nearest layer absorptivity
+!
+!---------------------------Local variables-----------------------------
+!
+   integer i                   ! Longitude index
+   integer k                   ! Level index
+   integer k1                  ! Level index
+   integer k2                  ! Level index
+   integer kn                  ! Nearest level index
+   integer wvl                 ! Wavelength index
+
+   real(r8) abstrc(pcols)              ! total trace gas absorptivity
+   real(r8) bplnk(14,pcols,4)          ! Planck functions for sub-divided layers
+   real(r8) pnew(pcols)        ! Effective pressure for H2O vapor linewidth
+   real(r8) pnewb(nbands)      ! Effective pressure for h2o linewidth w/
+                               !    Hulst-Curtis-Godson correction for
+                               !    each band
+   real(r8) u(pcols)           ! Pressure weighted H2O path length
+   real(r8) ub(nbands)         ! Pressure weighted H2O path length with
+                               !    Hulst-Curtis-Godson correction for
+                               !    each band
+   real(r8) tbar(pcols,4)      ! Mean layer temperature
+   real(r8) emm(pcols,4)       ! Mean co2 emissivity
+   real(r8) o3emm(pcols,4)     ! Mean o3 emissivity
+   real(r8) o3bndi             ! Ozone band parameter
+   real(r8) temh2o(pcols,4)    ! Mean layer temperature equivalent to tbar
+   real(r8) k21                ! Exponential coefficient used to calculate
+!                              !  rotation band transmissvty in the 650-800
+!                              !  cm-1 region (tr1)
+   real(r8) k22                ! Exponential coefficient used to calculate
+!                              !  rotation band transmissvty in the 500-650
+!                              !  cm-1 region (tr2)
+   real(r8) uc1(pcols)         ! H2o continuum pathlength in 500-800 cm-1
+   real(r8) to3h2o(pcols)      ! H2o trnsmsn for overlap with o3
+   real(r8) pi                 ! For co2 absorptivity computation
+   real(r8) sqti(pcols)        ! Used to store sqrt of mean temperature
+   real(r8) et                 ! Co2 hot band factor
+   real(r8) et2                ! Co2 hot band factor squared
+   real(r8) et4                ! Co2 hot band factor to fourth power
+   real(r8) omet               ! Co2 stimulated emission term
+   real(r8) f1co2              ! Co2 central band factor
+   real(r8) f2co2(pcols)       ! Co2 weak band factor
+   real(r8) f3co2(pcols)       ! Co2 weak band factor
+   real(r8) t1co2(pcols)       ! Overlap factr weak bands on strong band
+   real(r8) sqwp               ! Sqrt of co2 pathlength
+   real(r8) f1sqwp(pcols)      ! Main co2 band factor
+   real(r8) oneme              ! Co2 stimulated emission term
+   real(r8) alphat             ! Part of the co2 stimulated emission term
+   real(r8) wco2               ! Constants used to define co2 pathlength
+   real(r8) posqt              ! Effective pressure for co2 line width
+   real(r8) u7(pcols)          ! Co2 hot band path length
+   real(r8) u8                 ! Co2 hot band path length
+   real(r8) u9                 ! Co2 hot band path length
+   real(r8) u13                ! Co2 hot band path length
+   real(r8) rbeta7(pcols)      ! Inverse of co2 hot band line width par
+   real(r8) rbeta8             ! Inverse of co2 hot band line width par
+   real(r8) rbeta9             ! Inverse of co2 hot band line width par
+   real(r8) rbeta13            ! Inverse of co2 hot band line width par
+   real(r8) tpatha             ! For absorptivity computation
+   real(r8) abso(pcols,4)      ! Absorptivity for various gases/bands
+   real(r8) dtx(pcols)         ! Planck temperature minus 250 K
+   real(r8) dty(pcols)         ! Path temperature minus 250 K
+   real(r8) term7(pcols,2)     ! Kl_inf(i) in eq(r8) of table A3a of R&D
+   real(r8) term8(pcols,2)     ! Delta kl_inf(i) in eq(r8)
+   real(r8) tr1                ! Eqn(6) in table A2 of R&D for 650-800
+   real(r8) tr10(pcols)        ! Eqn (6) times eq(4) in table A2
+!                              !  of R&D for 500-650 cm-1 region
+   real(r8) tr2                ! Eqn(6) in table A2 of R&D for 500-650
+   real(r8) tr5                ! Eqn(4) in table A2 of R&D for 650-800
+   real(r8) tr6                ! Eqn(4) in table A2 of R&D for 500-650
+   real(r8) tr9(pcols)         ! Equation (6) times eq(4) in table A2
+!                              !  of R&D for 650-800 cm-1 region
+   real(r8) sqrtu(pcols)       ! Sqrt of pressure weighted h20 pathlength
+   real(r8) fwk(pcols)         ! Equation(33) in R&D far wing correction
+   real(r8) fwku(pcols)        ! GU term in eqs(1) and (6) in table A2
+   real(r8) to3co2(pcols)      ! P weighted temp in ozone band model
+   real(r8) dpnm(pcols)        ! Pressure difference between two levels
+   real(r8) pnmsq(pcols,pverp) ! Pressure squared
+   real(r8) dw(pcols)          ! Amount of h2o between two levels
+   real(r8) uinpl(pcols,4)     ! Nearest layer subdivision factor
+   real(r8) winpl(pcols,4)     ! Nearest layer subdivision factor
+   real(r8) zinpl(pcols,4)     ! Nearest layer subdivision factor
+   real(r8) pinpl(pcols,4)     ! Nearest layer subdivision factor
+   real(r8) dplh2o(pcols)      ! Difference in press weighted h2o amount
+   real(r8) r293               ! 1/293
+   real(r8) r250               ! 1/250
+   real(r8) r3205              ! Line width factor for o3 (see R&Di)
+   real(r8) r300               ! 1/300
+   real(r8) rsslp              ! Reciprocal of sea level pressure
+   real(r8) r2sslp             ! 1/2 of rsslp
+   real(r8) ds2c               ! Y in eq(7) in table A2 of R&D
+   real(r8)  dplos             ! Ozone pathlength eq(A2) in R&Di
+   real(r8) dplol              ! Presure weighted ozone pathlength
+   real(r8) tlocal             ! Local interface temperature
+   real(r8) beta               ! Ozone mean line parameter eq(A3) in R&Di
+!                               (includes Voigt line correction factor)
+   real(r8) rphat              ! Effective pressure for ozone beta
+   real(r8) tcrfac             ! Ozone temperature factor table 1 R&Di
+   real(r8) tmp1               ! Ozone band factor see eq(A1) in R&Di
+   real(r8) u1                 ! Effective ozone pathlength eq(A2) in R&Di
+   real(r8) realnu             ! 1/beta factor in ozone band model eq(A1)
+   real(r8) tmp2               ! Ozone band factor see eq(A1) in R&Di
+   real(r8) u2                 ! Effective ozone pathlength eq(A2) in R&Di
+   real(r8) rsqti              ! Reciprocal of sqrt of path temperature
+   real(r8) tpath              ! Path temperature used in co2 band model
+   real(r8) tmp3               ! Weak band factor see K&B
+   real(r8) rdpnmsq            ! Reciprocal of difference in press^2
+   real(r8) rdpnm              ! Reciprocal of difference in press
+   real(r8) p1                 ! Mean pressure factor
+   real(r8) p2                 ! Mean pressure factor
+   real(r8) dtym10             ! T - 260 used in eq(9) and (10) table A3a
+   real(r8) dplco2             ! Co2 path length
+   real(r8) te                 ! A_0 T factor in ozone model table 1 of R&Di
+   real(r8) denom              ! Denominator in eq(r8) of table A3a of R&D
+   real(r8) th2o(pcols)        ! transmission due to H2O
+   real(r8) tco2(pcols)        ! transmission due to CO2
+   real(r8) to3(pcols)         ! transmission due to O3
+!
+! Transmission terms for various spectral intervals:
+!
+   real(r8) trab2(pcols)       ! H2o   500 -  800 cm-1
+   real(r8) absbnd             ! Proportional to co2 band absorptance
+   real(r8) dbvtit(pcols,pverp)! Intrfc drvtv plnck fnctn for o3
+   real(r8) dbvtly(pcols,pver) ! Level drvtv plnck fnctn for o3
+!
+! Variables for Collins/Hackney/Edwards (C/H/E) & 
+!       Collins/Lee-Taylor/Edwards (C/LT/E) H2O parameterization
+
+!
+! Notation:
+! U   = integral (P/P_0 dW)  eq. 15 in Ramanathan/Downey 1986
+! P   = atmospheric pressure
+! P_0 = reference atmospheric pressure
+! W   = precipitable water path
+! T_e = emission temperature
+! T_p = path temperature
+! RH  = path relative humidity
+!
+   real(r8) fa               ! asymptotic value of abs. as U->infinity
+   real(r8) a_star           ! normalized absorptivity for non-window
+   real(r8) l_star           ! interpolated line transmission
+   real(r8) c_star           ! interpolated continuum transmission
+
+   real(r8) te1              ! emission temperature
+   real(r8) te2              ! te^2
+   real(r8) te3              ! te^3
+   real(r8) te4              ! te^4
+   real(r8) te5              ! te^5
+
+   real(r8) log_u            ! log base 10 of U 
+   real(r8) log_uc           ! log base 10 of H2O continuum path
+   real(r8) log_p            ! log base 10 of P
+   real(r8) t_p              ! T_p
+   real(r8) t_e              ! T_e (offset by T_p)
+
+   integer iu                ! index for log10(U)
+   integer iu1               ! iu + 1
+   integer iuc               ! index for log10(H2O continuum path)
+   integer iuc1              ! iuc + 1
+   integer ip                ! index for log10(P)
+   integer ip1               ! ip + 1
+   integer itp               ! index for T_p
+   integer itp1              ! itp + 1
+   integer ite               ! index for T_e
+   integer ite1              ! ite + 1
+   integer irh               ! index for RH
+   integer irh1              ! irh + 1
+
+   real(r8) dvar             ! normalized variation in T_p/T_e/P/U
+   real(r8) uvar             ! U * diffusivity factor
+   real(r8) uscl             ! factor for lineary scaling as U->0
+
+   real(r8) wu               ! weight for U
+   real(r8) wu1              ! 1 - wu
+   real(r8) wuc              ! weight for H2O continuum path
+   real(r8) wuc1             ! 1 - wuc
+   real(r8) wp               ! weight for P
+   real(r8) wp1              ! 1 - wp
+   real(r8) wtp              ! weight for T_p
+   real(r8) wtp1             ! 1 - wtp
+   real(r8) wte              ! weight for T_e
+   real(r8) wte1             ! 1 - wte
+   real(r8) wrh              ! weight for RH
+   real(r8) wrh1             ! 1 - wrh
+
+   real(r8) w_0_0_           ! weight for Tp/Te combination
+   real(r8) w_0_1_           ! weight for Tp/Te combination
+   real(r8) w_1_0_           ! weight for Tp/Te combination
+   real(r8) w_1_1_           ! weight for Tp/Te combination
+
+   real(r8) w_0_00           ! weight for Tp/Te/RH combination
+   real(r8) w_0_01           ! weight for Tp/Te/RH combination
+   real(r8) w_0_10           ! weight for Tp/Te/RH combination
+   real(r8) w_0_11           ! weight for Tp/Te/RH combination
+   real(r8) w_1_00           ! weight for Tp/Te/RH combination
+   real(r8) w_1_01           ! weight for Tp/Te/RH combination
+   real(r8) w_1_10           ! weight for Tp/Te/RH combination
+   real(r8) w_1_11           ! weight for Tp/Te/RH combination
+
+   real(r8) w00_00           ! weight for P/Tp/Te/RH combination
+   real(r8) w00_01           ! weight for P/Tp/Te/RH combination
+   real(r8) w00_10           ! weight for P/Tp/Te/RH combination
+   real(r8) w00_11           ! weight for P/Tp/Te/RH combination
+   real(r8) w01_00           ! weight for P/Tp/Te/RH combination
+   real(r8) w01_01           ! weight for P/Tp/Te/RH combination
+   real(r8) w01_10           ! weight for P/Tp/Te/RH combination
+   real(r8) w01_11           ! weight for P/Tp/Te/RH combination
+   real(r8) w10_00           ! weight for P/Tp/Te/RH combination
+   real(r8) w10_01           ! weight for P/Tp/Te/RH combination
+   real(r8) w10_10           ! weight for P/Tp/Te/RH combination
+   real(r8) w10_11           ! weight for P/Tp/Te/RH combination
+   real(r8) w11_00           ! weight for P/Tp/Te/RH combination
+   real(r8) w11_01           ! weight for P/Tp/Te/RH combination
+   real(r8) w11_10           ! weight for P/Tp/Te/RH combination
+   real(r8) w11_11           ! weight for P/Tp/Te/RH combination
+
+   integer ib                ! spectral interval:
+                             !   1 = 0-800 cm^-1 and 1200-2200 cm^-1
+                             !   2 = 800-1200 cm^-1
+
+
+   real(r8) pch2o            ! H2O continuum path
+   real(r8) fch2o            ! temp. factor for continuum
+   real(r8) uch2o            ! U corresponding to H2O cont. path (window)
+
+   real(r8) fdif             ! secant(zenith angle) for diffusivity approx.
+
+   real(r8) sslp_mks         ! Sea-level pressure in MKS units
+   real(r8) esx              ! saturation vapor pressure returned by vqsatd
+   real(r8) qsx              ! saturation mixing ratio returned by vqsatd
+   real(r8) pnew_mks         ! pnew in MKS units
+   real(r8) q_path           ! effective specific humidity along path
+   real(r8) rh_path          ! effective relative humidity along path
+   real(r8) omeps            ! 1 - epsilo
+
+   integer  iest             ! index in estblh2o
+
+      integer bnd_idx        ! LW band index
+      real(r8) aer_pth_dlt   ! [kg m-2] STRAER path between interface levels k1 and k2
+      real(r8) aer_pth_ngh(pcols)
+                             ! [kg m-2] STRAER path between neighboring layers
+      real(r8) odap_aer_ttl  ! [fraction] Total path absorption optical depth
+      real(r8) aer_trn_ngh(pcols,bnd_nbr_LW) 
+                             ! [fraction] Total transmission between 
+                             !            nearest neighbor sub-levels
+!
+!--------------------------Statement function---------------------------
+!
+   real(r8) dbvt,t             ! Planck fnctn tmp derivative for o3
+!
+   dbvt(t)=(-2.8911366682e-4+(2.3771251896e-6+1.1305188929e-10*t)*t)/ &
+      (1.0+(-6.1364820707e-3+1.5550319767e-5*t)*t)
+!
+!
+!-----------------------------------------------------------------------
+!
+! Initialize
+!
+   do k2=1,ntoplw-1
+      do k1=1,ntoplw-1
+         abstot(:,k1,k2) = inf    ! set unused portions for lf95 restart write
+      end do
+   end do
+   do k2=1,4
+      do k1=1,ntoplw-1
+         absnxt(:,k1,k2) = inf    ! set unused portions for lf95 restart write
+      end do
+   end do
+
+   do k=ntoplw,pverp
+      abstot(:,k,k) = inf         ! set unused portions for lf95 restart write
+   end do
+
+   do k=ntoplw,pver
+      do i=1,ncol
+         dbvtly(i,k) = dbvt(tlayr(i,k+1))
+         dbvtit(i,k) = dbvt(tint(i,k))
+      end do
+   end do
+   do i=1,ncol
+      dbvtit(i,pverp) = dbvt(tint(i,pverp))
+   end do
+!
+   r293    = 1./293.
+   r250    = 1./250.
+   r3205   = 1./.3205
+   r300    = 1./300.
+   rsslp   = 1./sslp
+   r2sslp  = 1./(2.*sslp)
+!
+!Constants for computing U corresponding to H2O cont. path
+!
+   fdif       = 1.66
+   sslp_mks   = sslp / 10.0
+   omeps      = 1.0 - epsilo
+!
+! Non-adjacent layer absorptivity:
+!
+! abso(i,1)     0 -  800 cm-1   h2o rotation band
+! abso(i,1)  1200 - 2200 cm-1   h2o vibration-rotation band
+! abso(i,2)   800 - 1200 cm-1   h2o window
+!
+! Separation between rotation and vibration-rotation dropped, so
+!                only 2 slots needed for H2O absorptivity
+!
+! 500-800 cm^-1 H2o continuum/line overlap already included
+!                in abso(i,1).  This used to be in abso(i,4)
+!
+! abso(i,3)   o3  9.6 micrometer band (nu3 and nu1 bands)
+! abso(i,4)   co2 15  micrometer band system
+!
+   do k=ntoplw,pverp
+      do i=1,ncol
+         pnmsq(i,k) = pnm(i,k)**2
+         dtx(i) = tplnka(i,k) - 250.
+      end do
+   end do
+!
+! Non-nearest layer level loops
+!
+   do k1=pverp,ntoplw,-1
+      do k2=pverp,ntoplw,-1
+         if (k1 == k2) cycle
+         do i=1,ncol
+            dplh2o(i) = plh2o(i,k1) - plh2o(i,k2)
+            u(i)      = abs(dplh2o(i))
+            sqrtu(i)  = sqrt(u(i))
+            ds2c      = abs(s2c(i,k1) - s2c(i,k2))
+            dw(i)     = abs(w(i,k1) - w(i,k2))
+            uc1(i)    = (ds2c + 1.7e-3*u(i))*(1. +  2.*ds2c)/(1. + 15.*ds2c)
+            pch2o     = ds2c
+            pnew(i)   = u(i)/dw(i)
+            pnew_mks  = pnew(i) * sslp_mks
+!
+! Changed effective path temperature to std. Curtis-Godson form
+!
+            tpatha = abs(tcg(i,k1) - tcg(i,k2))/dw(i)
+            t_p = min(max(tpatha, min_tp_h2o), max_tp_h2o)
+            iest = floor(t_p) - min_tp_h2o
+            esx = estblh2o(iest) + (estblh2o(iest+1)-estblh2o(iest)) * &
+                 (t_p - min_tp_h2o - iest)
+            qsx = epsilo * esx / (pnew_mks - omeps * esx)
+!
+! Compute effective RH along path
+!
+            q_path = dw(i) / abs(pnm(i,k1) - pnm(i,k2)) / rga
+!
+! Calculate effective u, pnew for each band using
+!        Hulst-Curtis-Godson approximation:
+! Formulae: Goody and Yung, Atmospheric Radiation: Theoretical Basis, 
+!           2nd edition, Oxford University Press, 1989.
+! Effective H2O path (w)
+!      eq. 6.24, p. 228
+! Effective H2O path pressure (pnew = u/w):
+!      eq. 6.29, p. 228
+!
+            ub(1) = abs(plh2ob(1,i,k1) - plh2ob(1,i,k2)) / psi(t_p,1)
+            ub(2) = abs(plh2ob(2,i,k1) - plh2ob(2,i,k2)) / psi(t_p,2)
+            
+            pnewb(1) = ub(1) / abs(wb(1,i,k1) - wb(1,i,k2)) * phi(t_p,1)
+            pnewb(2) = ub(2) / abs(wb(2,i,k1) - wb(2,i,k2)) * phi(t_p,2)
+
+            dtx(i)      = tplnka(i,k2) - 250.
+            dty(i)      = tpatha       - 250.
+
+            fwk(i)  = fwcoef + fwc1/(1. + fwc2*u(i))
+            fwku(i) = fwk(i)*u(i)
+!
+! Define variables for C/H/E (now C/LT/E) fit
+!
+! abso(i,1)     0 -  800 cm-1   h2o rotation band
+! abso(i,1)  1200 - 2200 cm-1   h2o vibration-rotation band
+! abso(i,2)   800 - 1200 cm-1   h2o window
+!
+! Separation between rotation and vibration-rotation dropped, so
+!                only 2 slots needed for H2O absorptivity
+!
+! Notation:
+! U   = integral (P/P_0 dW)  
+! P   = atmospheric pressure
+! P_0 = reference atmospheric pressure
+! W   = precipitable water path
+! T_e = emission temperature
+! T_p = path temperature
+! RH  = path relative humidity
+!
+!
+! Terms for asymptotic value of emissivity
+!
+            te1  = tplnka(i,k2)
+            te2  = te1 * te1
+            te3  = te2 * te1
+            te4  = te3 * te1
+            te5  = te4 * te1
+
+!
+!  Band-independent indices for lines and continuum tables
+!
+            dvar = (t_p - min_tp_h2o) / dtp_h2o
+            itp = min(max(int(aint(dvar,r8)) + 1, 1), n_tp - 1)
+            itp1 = itp + 1
+            wtp = dvar - floor(dvar)
+            wtp1 = 1.0 - wtp
+            
+            t_e = min(max(tplnka(i,k2)-t_p, min_te_h2o), max_te_h2o)
+            dvar = (t_e - min_te_h2o) / dte_h2o
+            ite = min(max(int(aint(dvar,r8)) + 1, 1), n_te - 1)
+            ite1 = ite + 1
+            wte = dvar - floor(dvar)
+            wte1 = 1.0 - wte
+            
+            rh_path = min(max(q_path / qsx, min_rh_h2o), max_rh_h2o)
+            dvar = (rh_path - min_rh_h2o) / drh_h2o
+            irh = min(max(int(aint(dvar,r8)) + 1, 1), n_rh - 1)
+            irh1 = irh + 1
+            wrh = dvar - floor(dvar)
+            wrh1 = 1.0 - wrh
+
+            w_0_0_ = wtp  * wte
+            w_0_1_ = wtp  * wte1
+            w_1_0_ = wtp1 * wte 
+            w_1_1_ = wtp1 * wte1
+            
+            w_0_00 = w_0_0_ * wrh
+            w_0_01 = w_0_0_ * wrh1
+            w_0_10 = w_0_1_ * wrh
+            w_0_11 = w_0_1_ * wrh1
+            w_1_00 = w_1_0_ * wrh
+            w_1_01 = w_1_0_ * wrh1
+            w_1_10 = w_1_1_ * wrh
+            w_1_11 = w_1_1_ * wrh1
+
+!
+! H2O Continuum path for 0-800 and 1200-2200 cm^-1
+!
+!    Assume foreign continuum dominates total H2O continuum in these bands
+!    per Clough et al, JGR, v. 97, no. D14 (Oct 20, 1992), p. 15776
+!    Then the effective H2O path is just 
+!         U_c = integral[ f(P) dW ]
+!    where 
+!           W = water-vapor mass and 
+!        f(P) = dependence of foreign continuum on pressure 
+!             = P / sslp
+!    Then 
+!         U_c = U (the same effective H2O path as for lines)
+!
+!
+! Continuum terms for 800-1200 cm^-1
+!
+!    Assume self continuum dominates total H2O continuum for this band
+!    per Clough et al, JGR, v. 97, no. D14 (Oct 20, 1992), p. 15776
+!    Then the effective H2O self-continuum path is 
+!         U_c = integral[ h(e,T) dW ]                        (*eq. 1*)
+!    where 
+!           W = water-vapor mass and 
+!           e = partial pressure of H2O along path
+!           T = temperature along path
+!      h(e,T) = dependence of foreign continuum on e,T
+!             = e / sslp * f(T)
+!
+!    Replacing
+!           e =~ q * P / epsilo
+!           q = mixing ratio of H2O
+!     epsilo = 0.622
+!
+!    and using the definition
+!           U = integral [ (P / sslp) dW ]
+!             = (P / sslp) W                                 (homogeneous path)
+!
+!    the effective path length for the self continuum is
+!         U_c = (q / epsilo) f(T) U                         (*eq. 2*)
+!
+!    Once values of T, U, and q have been calculated for the inhomogeneous
+!        path, this sets U_c for the corresponding
+!        homogeneous atmosphere.  However, this need not equal the
+!        value of U_c' defined by eq. 1 for the actual inhomogeneous atmosphere
+!        under consideration.
+!
+!    Solution: hold T and q constant, solve for U' that gives U_c' by
+!        inverting eq. (2):
+!
+!        U' = (U_c * epsilo) / (q * f(T))
+!
+            fch2o = fh2oself(t_p) 
+            uch2o = (pch2o * epsilo) / (q_path * fch2o)
+
+!
+! Band-dependent indices for non-window
+!
+            ib = 1
+
+            uvar = ub(ib) * fdif
+            log_u  = min(log10(max(uvar, min_u_h2o)), max_lu_h2o)
+            dvar = (log_u - min_lu_h2o) / dlu_h2o
+            iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1)
+            iu1 = iu + 1
+            wu = dvar - floor(dvar)
+            wu1 = 1.0 - wu
+            
+            log_p  = min(log10(max(pnewb(ib), min_p_h2o)), max_lp_h2o)
+            dvar = (log_p - min_lp_h2o) / dlp_h2o
+            ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1)
+            ip1 = ip + 1
+            wp = dvar - floor(dvar)
+            wp1 = 1.0 - wp
+         
+            w00_00 = wp  * w_0_00 
+            w00_01 = wp  * w_0_01 
+            w00_10 = wp  * w_0_10 
+            w00_11 = wp  * w_0_11 
+            w01_00 = wp  * w_1_00 
+            w01_01 = wp  * w_1_01 
+            w01_10 = wp  * w_1_10 
+            w01_11 = wp  * w_1_11 
+            w10_00 = wp1 * w_0_00 
+            w10_01 = wp1 * w_0_01 
+            w10_10 = wp1 * w_0_10 
+            w10_11 = wp1 * w_0_11 
+            w11_00 = wp1 * w_1_00 
+            w11_01 = wp1 * w_1_01 
+            w11_10 = wp1 * w_1_10 
+            w11_11 = wp1 * w_1_11 
+!
+! Asymptotic value of absorptivity as U->infinity
+!
+            fa = fat(1,ib) + &
+                 fat(2,ib) * te1 + &
+                 fat(3,ib) * te2 + &
+                 fat(4,ib) * te3 + &
+                 fat(5,ib) * te4 + &
+                 fat(6,ib) * te5
+
+            a_star = &
+                 ah2onw(ip , itp , iu , ite , irh ) * w11_11 * wu1 + &
+                 ah2onw(ip , itp , iu , ite , irh1) * w11_10 * wu1 + &
+                 ah2onw(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + &
+                 ah2onw(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + &
+                 ah2onw(ip , itp , iu1, ite , irh ) * w11_11 * wu  + &
+                 ah2onw(ip , itp , iu1, ite , irh1) * w11_10 * wu  + &
+                 ah2onw(ip , itp , iu1, ite1, irh ) * w11_01 * wu  + &
+                 ah2onw(ip , itp , iu1, ite1, irh1) * w11_00 * wu  + &
+                 ah2onw(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + &
+                 ah2onw(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + &
+                 ah2onw(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + &
+                 ah2onw(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + &
+                 ah2onw(ip , itp1, iu1, ite , irh ) * w10_11 * wu  + &
+                 ah2onw(ip , itp1, iu1, ite , irh1) * w10_10 * wu  + &
+                 ah2onw(ip , itp1, iu1, ite1, irh ) * w10_01 * wu  + &
+                 ah2onw(ip , itp1, iu1, ite1, irh1) * w10_00 * wu  + &
+                 ah2onw(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + &
+                 ah2onw(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + &
+                 ah2onw(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + &
+                 ah2onw(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + &
+                 ah2onw(ip1, itp , iu1, ite , irh ) * w01_11 * wu  + &
+                 ah2onw(ip1, itp , iu1, ite , irh1) * w01_10 * wu  + &
+                 ah2onw(ip1, itp , iu1, ite1, irh ) * w01_01 * wu  + &
+                 ah2onw(ip1, itp , iu1, ite1, irh1) * w01_00 * wu  + &
+                 ah2onw(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + &
+                 ah2onw(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + &
+                 ah2onw(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + &
+                 ah2onw(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + &
+                 ah2onw(ip1, itp1, iu1, ite , irh ) * w00_11 * wu  + &
+                 ah2onw(ip1, itp1, iu1, ite , irh1) * w00_10 * wu  + &
+                 ah2onw(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu  + &
+                 ah2onw(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu 
+            abso(i,ib) = min(max(fa * (1.0 - (1.0 - a_star) * &
+                                 aer_trn_ttl(i,k1,k2,ib)), &
+                             0.0_r8), 1.0_r8)
+!
+! Invoke linear limit for scaling wrt u below min_u_h2o
+!
+            if (uvar < min_u_h2o) then
+               uscl = uvar / min_u_h2o
+               abso(i,ib) = abso(i,ib) * uscl
+            endif
+                         
+!
+! Band-dependent indices for window
+!
+            ib = 2
+
+            uvar = ub(ib) * fdif
+            log_u  = min(log10(max(uvar, min_u_h2o)), max_lu_h2o)
+            dvar = (log_u - min_lu_h2o) / dlu_h2o
+            iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1)
+            iu1 = iu + 1
+            wu = dvar - floor(dvar)
+            wu1 = 1.0 - wu
+            
+            log_p  = min(log10(max(pnewb(ib), min_p_h2o)), max_lp_h2o)
+            dvar = (log_p - min_lp_h2o) / dlp_h2o
+            ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1)
+            ip1 = ip + 1
+            wp = dvar - floor(dvar)
+            wp1 = 1.0 - wp
+         
+            w00_00 = wp  * w_0_00 
+            w00_01 = wp  * w_0_01 
+            w00_10 = wp  * w_0_10 
+            w00_11 = wp  * w_0_11 
+            w01_00 = wp  * w_1_00 
+            w01_01 = wp  * w_1_01 
+            w01_10 = wp  * w_1_10 
+            w01_11 = wp  * w_1_11 
+            w10_00 = wp1 * w_0_00 
+            w10_01 = wp1 * w_0_01 
+            w10_10 = wp1 * w_0_10 
+            w10_11 = wp1 * w_0_11 
+            w11_00 = wp1 * w_1_00 
+            w11_01 = wp1 * w_1_01 
+            w11_10 = wp1 * w_1_10 
+            w11_11 = wp1 * w_1_11 
+
+            log_uc  = min(log10(max(uch2o * fdif, min_u_h2o)), max_lu_h2o)
+            dvar = (log_uc - min_lu_h2o) / dlu_h2o
+            iuc = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1)
+            iuc1 = iuc + 1
+            wuc = dvar - floor(dvar)
+            wuc1 = 1.0 - wuc
+!
+! Asymptotic value of absorptivity as U->infinity
+!
+            fa = fat(1,ib) + &
+                 fat(2,ib) * te1 + &
+                 fat(3,ib) * te2 + &
+                 fat(4,ib) * te3 + &
+                 fat(5,ib) * te4 + &
+                 fat(6,ib) * te5
+
+            l_star = &
+                 ln_ah2ow(ip , itp , iu , ite , irh ) * w11_11 * wu1 + &
+                 ln_ah2ow(ip , itp , iu , ite , irh1) * w11_10 * wu1 + &
+                 ln_ah2ow(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + &
+                 ln_ah2ow(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + &
+                 ln_ah2ow(ip , itp , iu1, ite , irh ) * w11_11 * wu  + &
+                 ln_ah2ow(ip , itp , iu1, ite , irh1) * w11_10 * wu  + &
+                 ln_ah2ow(ip , itp , iu1, ite1, irh ) * w11_01 * wu  + &
+                 ln_ah2ow(ip , itp , iu1, ite1, irh1) * w11_00 * wu  + &
+                 ln_ah2ow(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + &
+                 ln_ah2ow(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + &
+                 ln_ah2ow(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + &
+                 ln_ah2ow(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + &
+                 ln_ah2ow(ip , itp1, iu1, ite , irh ) * w10_11 * wu  + &
+                 ln_ah2ow(ip , itp1, iu1, ite , irh1) * w10_10 * wu  + &
+                 ln_ah2ow(ip , itp1, iu1, ite1, irh ) * w10_01 * wu  + &
+                 ln_ah2ow(ip , itp1, iu1, ite1, irh1) * w10_00 * wu  + &
+                 ln_ah2ow(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + &
+                 ln_ah2ow(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + &
+                 ln_ah2ow(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + &
+                 ln_ah2ow(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + &
+                 ln_ah2ow(ip1, itp , iu1, ite , irh ) * w01_11 * wu  + &
+                 ln_ah2ow(ip1, itp , iu1, ite , irh1) * w01_10 * wu  + &
+                 ln_ah2ow(ip1, itp , iu1, ite1, irh ) * w01_01 * wu  + &
+                 ln_ah2ow(ip1, itp , iu1, ite1, irh1) * w01_00 * wu  + &
+                 ln_ah2ow(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + &
+                 ln_ah2ow(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + &
+                 ln_ah2ow(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + &
+                 ln_ah2ow(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + &
+                 ln_ah2ow(ip1, itp1, iu1, ite , irh ) * w00_11 * wu  + &
+                 ln_ah2ow(ip1, itp1, iu1, ite , irh1) * w00_10 * wu  + &
+                 ln_ah2ow(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu  + &
+                 ln_ah2ow(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu 
+
+            c_star = &
+                 cn_ah2ow(ip , itp , iuc , ite , irh ) * w11_11 * wuc1 + &
+                 cn_ah2ow(ip , itp , iuc , ite , irh1) * w11_10 * wuc1 + &
+                 cn_ah2ow(ip , itp , iuc , ite1, irh ) * w11_01 * wuc1 + &
+                 cn_ah2ow(ip , itp , iuc , ite1, irh1) * w11_00 * wuc1 + &
+                 cn_ah2ow(ip , itp , iuc1, ite , irh ) * w11_11 * wuc  + &
+                 cn_ah2ow(ip , itp , iuc1, ite , irh1) * w11_10 * wuc  + &
+                 cn_ah2ow(ip , itp , iuc1, ite1, irh ) * w11_01 * wuc  + &
+                 cn_ah2ow(ip , itp , iuc1, ite1, irh1) * w11_00 * wuc  + &
+                 cn_ah2ow(ip , itp1, iuc , ite , irh ) * w10_11 * wuc1 + &
+                 cn_ah2ow(ip , itp1, iuc , ite , irh1) * w10_10 * wuc1 + &
+                 cn_ah2ow(ip , itp1, iuc , ite1, irh ) * w10_01 * wuc1 + &
+                 cn_ah2ow(ip , itp1, iuc , ite1, irh1) * w10_00 * wuc1 + &
+                 cn_ah2ow(ip , itp1, iuc1, ite , irh ) * w10_11 * wuc  + &
+                 cn_ah2ow(ip , itp1, iuc1, ite , irh1) * w10_10 * wuc  + &
+                 cn_ah2ow(ip , itp1, iuc1, ite1, irh ) * w10_01 * wuc  + &
+                 cn_ah2ow(ip , itp1, iuc1, ite1, irh1) * w10_00 * wuc  + &
+                 cn_ah2ow(ip1, itp , iuc , ite , irh ) * w01_11 * wuc1 + &
+                 cn_ah2ow(ip1, itp , iuc , ite , irh1) * w01_10 * wuc1 + &
+                 cn_ah2ow(ip1, itp , iuc , ite1, irh ) * w01_01 * wuc1 + &
+                 cn_ah2ow(ip1, itp , iuc , ite1, irh1) * w01_00 * wuc1 + &
+                 cn_ah2ow(ip1, itp , iuc1, ite , irh ) * w01_11 * wuc  + &
+                 cn_ah2ow(ip1, itp , iuc1, ite , irh1) * w01_10 * wuc  + &
+                 cn_ah2ow(ip1, itp , iuc1, ite1, irh ) * w01_01 * wuc  + &
+                 cn_ah2ow(ip1, itp , iuc1, ite1, irh1) * w01_00 * wuc  + &
+                 cn_ah2ow(ip1, itp1, iuc , ite , irh ) * w00_11 * wuc1 + &
+                 cn_ah2ow(ip1, itp1, iuc , ite , irh1) * w00_10 * wuc1 + &
+                 cn_ah2ow(ip1, itp1, iuc , ite1, irh ) * w00_01 * wuc1 + &
+                 cn_ah2ow(ip1, itp1, iuc , ite1, irh1) * w00_00 * wuc1 + &
+                 cn_ah2ow(ip1, itp1, iuc1, ite , irh ) * w00_11 * wuc  + &
+                 cn_ah2ow(ip1, itp1, iuc1, ite , irh1) * w00_10 * wuc  + &
+                 cn_ah2ow(ip1, itp1, iuc1, ite1, irh ) * w00_01 * wuc  + &
+                 cn_ah2ow(ip1, itp1, iuc1, ite1, irh1) * w00_00 * wuc 
+            abso(i,ib) = min(max(fa * (1.0 - l_star * c_star * &
+                                 aer_trn_ttl(i,k1,k2,ib)), &
+                             0.0_r8), 1.0_r8) 
+!
+! Invoke linear limit for scaling wrt u below min_u_h2o
+!
+            if (uvar < min_u_h2o) then
+               uscl = uvar / min_u_h2o
+               abso(i,ib) = abso(i,ib) * uscl
+            endif
+
+         end do
+!
+! Line transmission in 800-1000 and 1000-1200 cm-1 intervals
+!
+         do i=1,ncol
+            term7(i,1) = coefj(1,1) + coefj(2,1)*dty(i)*(1. + c16*dty(i))
+            term8(i,1) = coefk(1,1) + coefk(2,1)*dty(i)*(1. + c17*dty(i))
+            term7(i,2) = coefj(1,2) + coefj(2,2)*dty(i)*(1. + c26*dty(i))
+            term8(i,2) = coefk(1,2) + coefk(2,2)*dty(i)*(1. + c27*dty(i))
+         end do
+!
+! 500 -  800 cm-1   h2o rotation band overlap with co2
+!
+         do i=1,ncol
+            k21    = term7(i,1) + term8(i,1)/ &
+               (1. + (c30 + c31*(dty(i)-10.)*(dty(i)-10.))*sqrtu(i))
+            k22    = term7(i,2) + term8(i,2)/ &
+               (1. + (c28 + c29*(dty(i)-10.))*sqrtu(i))
+            tr1    = exp(-(k21*(sqrtu(i) + fc1*fwku(i))))
+            tr2    = exp(-(k22*(sqrtu(i) + fc1*fwku(i))))
+            tr1=tr1*aer_trn_ttl(i,k1,k2,idx_LW_0650_0800) 
+!                                          ! H2O line+STRAER trn 650--800 cm-1
+            tr2=tr2*aer_trn_ttl(i,k1,k2,idx_LW_0500_0650)
+!                                          ! H2O line+STRAER trn 500--650 cm-1
+            tr5    = exp(-((coefh(1,3) + coefh(2,3)*dtx(i))*uc1(i)))
+            tr6    = exp(-((coefh(1,4) + coefh(2,4)*dtx(i))*uc1(i)))
+            tr9(i)   = tr1*tr5
+            tr10(i)  = tr2*tr6
+            th2o(i) = tr10(i)
+            trab2(i) = 0.65*tr9(i) + 0.35*tr10(i)
+         end do
+         if (k2 < k1) then
+            do i=1,ncol
+               to3h2o(i) = h2otr(i,k1)/h2otr(i,k2)
+            end do
+         else
+            do i=1,ncol
+               to3h2o(i) = h2otr(i,k2)/h2otr(i,k1)
+            end do
+         end if
+!
+! abso(i,3)   o3  9.6 micrometer band (nu3 and nu1 bands)
+!
+         do i=1,ncol
+            dpnm(i)  = pnm(i,k1) - pnm(i,k2)
+            to3co2(i) = (pnm(i,k1)*co2t(i,k1) - pnm(i,k2)*co2t(i,k2))/dpnm(i)
+            te       = (to3co2(i)*r293)**.7
+            dplos    = plos(i,k1) - plos(i,k2)
+            dplol    = plol(i,k1) - plol(i,k2)
+            u1       = 18.29*abs(dplos)/te
+            u2       = .5649*abs(dplos)/te
+            rphat    = dplol/dplos
+            tlocal   = tint(i,k2)
+            tcrfac   = sqrt(tlocal*r250)*te
+            beta     = r3205*(rphat + dpfo3*tcrfac)
+            realnu   = te/beta
+            tmp1     = u1/sqrt(4. + u1*(1. + realnu))
+            tmp2     = u2/sqrt(4. + u2*(1. + realnu))
+            o3bndi    = 74.*te*log(1. + tmp1 + tmp2)
+            abso(i,3) = o3bndi*to3h2o(i)*dbvtit(i,k2)
+            to3(i)   = 1.0/(1. + 0.1*tmp1 + 0.1*tmp2)
+         end do
+!
+! abso(i,4)      co2 15  micrometer band system
+!
+         do i=1,ncol
+            sqwp      = sqrt(abs(plco2(i,k1) - plco2(i,k2)))
+            et        = exp(-480./to3co2(i))
+            sqti(i)   = sqrt(to3co2(i))
+            rsqti     = 1./sqti(i)
+            et2       = et*et
+            et4       = et2*et2
+            omet      = 1. - 1.5*et2
+            f1co2     = 899.70*omet*(1. + 1.94774*et + 4.73486*et2)*rsqti
+            f1sqwp(i) = f1co2*sqwp
+            t1co2(i)  = 1./(1. + (245.18*omet*sqwp*rsqti))
+            oneme     = 1. - et2
+            alphat    = oneme**3*rsqti
+            pi        = abs(dpnm(i))
+            wco2      =  2.5221*co2vmr*pi*rga
+            u7(i)     =  4.9411e4*alphat*et2*wco2
+            u8        =  3.9744e4*alphat*et4*wco2
+            u9        =  1.0447e5*alphat*et4*et2*wco2
+            u13       = 2.8388e3*alphat*et4*wco2
+            tpath     = to3co2(i)
+            tlocal    = tint(i,k2)
+            tcrfac    = sqrt(tlocal*r250*tpath*r300)
+            posqt     = ((pnm(i,k2) + pnm(i,k1))*r2sslp + dpfco2*tcrfac)*rsqti
+            rbeta7(i) = 1./(5.3228*posqt)
+            rbeta8    = 1./(10.6576*posqt)
+            rbeta9    = rbeta7(i)
+            rbeta13   = rbeta9
+            f2co2(i)  = (u7(i)/sqrt(4. + u7(i)*(1. + rbeta7(i)))) + &
+               (u8   /sqrt(4. + u8*(1. + rbeta8))) + &
+               (u9   /sqrt(4. + u9*(1. + rbeta9)))
+            f3co2(i)  = u13/sqrt(4. + u13*(1. + rbeta13))
+         end do
+         if (k2 >= k1) then
+            do i=1,ncol
+               sqti(i) = sqrt(tlayr(i,k2))
+            end do
+         end if
+!
+         do i=1,ncol
+            tmp1      = log(1. + f1sqwp(i))
+            tmp2      = log(1. + f2co2(i))
+            tmp3      = log(1. + f3co2(i))
+            absbnd    = (tmp1 + 2.*t1co2(i)*tmp2 + 2.*tmp3)*sqti(i)
+            abso(i,4) = trab2(i)*co2em(i,k2)*absbnd
+            tco2(i)   = 1./(1.0+10.0*(u7(i)/sqrt(4. + u7(i)*(1. + rbeta7(i)))))
+         end do
+!
+! Calculate absorptivity due to trace gases, abstrc
+!
+         call trcab( lchnk   ,ncol    ,pcols, pverp,                   &
+            k1      ,k2      ,ucfc11  ,ucfc12  ,un2o0   , &
+            un2o1   ,uch4    ,uco211  ,uco212  ,uco213  , &
+            uco221  ,uco222  ,uco223  ,bn2o0   ,bn2o1   , &
+            bch4    ,to3co2  ,pnm     ,dw      ,pnew    , &
+            s2c     ,uptype  ,u       ,abplnk1 ,tco2    , &
+            th2o    ,to3     ,abstrc  , &
+            aer_trn_ttl)
+!
+! Sum total absorptivity
+!
+         do i=1,ncol
+            abstot(i,k1,k2) = abso(i,1) + abso(i,2) + &
+               abso(i,3) + abso(i,4) + abstrc(i)
+         end do
+      end do ! do k2 = 
+   end do ! do k1 = 
+!
+! Adjacent layer absorptivity:
+!
+! abso(i,1)     0 -  800 cm-1   h2o rotation band
+! abso(i,1)  1200 - 2200 cm-1   h2o vibration-rotation band
+! abso(i,2)   800 - 1200 cm-1   h2o window
+!
+! Separation between rotation and vibration-rotation dropped, so
+!                only 2 slots needed for H2O absorptivity
+!
+! 500-800 cm^-1 H2o continuum/line overlap already included
+!                in abso(i,1).  This used to be in abso(i,4)
+!
+! abso(i,3)   o3  9.6 micrometer band (nu3 and nu1 bands)
+! abso(i,4)   co2 15  micrometer band system
+!
+! Nearest layer level loop
+!
+   do k2=pver,ntoplw,-1
+      do i=1,ncol
+         tbar(i,1)   = 0.5*(tint(i,k2+1) + tlayr(i,k2+1))
+         emm(i,1)    = 0.5*(co2em(i,k2+1) + co2eml(i,k2))
+         tbar(i,2)   = 0.5*(tlayr(i,k2+1) + tint(i,k2))
+         emm(i,2)    = 0.5*(co2em(i,k2) + co2eml(i,k2))
+         tbar(i,3)   = 0.5*(tbar(i,2) + tbar(i,1))
+         emm(i,3)    = emm(i,1)
+         tbar(i,4)   = tbar(i,3)
+         emm(i,4)    = emm(i,2)
+         o3emm(i,1)  = 0.5*(dbvtit(i,k2+1) + dbvtly(i,k2))
+         o3emm(i,2)  = 0.5*(dbvtit(i,k2) + dbvtly(i,k2))
+         o3emm(i,3)  = o3emm(i,1)
+         o3emm(i,4)  = o3emm(i,2)
+         temh2o(i,1) = tbar(i,1)
+         temh2o(i,2) = tbar(i,2)
+         temh2o(i,3) = tbar(i,1)
+         temh2o(i,4) = tbar(i,2)
+         dpnm(i)     = pnm(i,k2+1) - pnm(i,k2)
+      end do
+!
+!  Weighted Planck functions for trace gases
+!
+      do wvl = 1,14
+         do i = 1,ncol
+            bplnk(wvl,i,1) = 0.5*(abplnk1(wvl,i,k2+1) + abplnk2(wvl,i,k2))
+            bplnk(wvl,i,2) = 0.5*(abplnk1(wvl,i,k2) + abplnk2(wvl,i,k2))
+            bplnk(wvl,i,3) = bplnk(wvl,i,1)
+            bplnk(wvl,i,4) = bplnk(wvl,i,2)
+         end do
+      end do
+      
+      do i=1,ncol
+         rdpnmsq    = 1./(pnmsq(i,k2+1) - pnmsq(i,k2))
+         rdpnm      = 1./dpnm(i)
+         p1         = .5*(pbr(i,k2) + pnm(i,k2+1))
+         p2         = .5*(pbr(i,k2) + pnm(i,k2  ))
+         uinpl(i,1) =  (pnmsq(i,k2+1) - p1**2)*rdpnmsq
+         uinpl(i,2) = -(pnmsq(i,k2  ) - p2**2)*rdpnmsq
+         uinpl(i,3) = -(pnmsq(i,k2  ) - p1**2)*rdpnmsq
+         uinpl(i,4) =  (pnmsq(i,k2+1) - p2**2)*rdpnmsq
+         winpl(i,1) = (.5*( pnm(i,k2+1) - pbr(i,k2)))*rdpnm
+         winpl(i,2) = (.5*(-pnm(i,k2  ) + pbr(i,k2)))*rdpnm
+         winpl(i,3) = (.5*( pnm(i,k2+1) + pbr(i,k2)) - pnm(i,k2  ))*rdpnm
+         winpl(i,4) = (.5*(-pnm(i,k2  ) - pbr(i,k2)) + pnm(i,k2+1))*rdpnm
+         tmp1       = 1./(piln(i,k2+1) - piln(i,k2))
+         tmp2       = piln(i,k2+1) - pmln(i,k2)
+         tmp3       = piln(i,k2  ) - pmln(i,k2)
+         zinpl(i,1) = (.5*tmp2          )*tmp1
+         zinpl(i,2) = (        - .5*tmp3)*tmp1
+         zinpl(i,3) = (.5*tmp2 -    tmp3)*tmp1
+         zinpl(i,4) = (   tmp2 - .5*tmp3)*tmp1
+         pinpl(i,1) = 0.5*(p1 + pnm(i,k2+1))
+         pinpl(i,2) = 0.5*(p2 + pnm(i,k2  ))
+         pinpl(i,3) = 0.5*(p1 + pnm(i,k2  ))
+         pinpl(i,4) = 0.5*(p2 + pnm(i,k2+1))
+         if(strat_volcanic) then
+           aer_pth_ngh(i) = abs(aer_mpp(i,k2)-aer_mpp(i,k2+1))
+         endif
+      end do
+      do kn=1,4
+         do i=1,ncol
+            u(i)     = uinpl(i,kn)*abs(plh2o(i,k2) - plh2o(i,k2+1))
+            sqrtu(i) = sqrt(u(i))
+            dw(i)    = abs(w(i,k2) - w(i,k2+1))
+            pnew(i)  = u(i)/(winpl(i,kn)*dw(i))
+            pnew_mks  = pnew(i) * sslp_mks
+            t_p = min(max(tbar(i,kn), min_tp_h2o), max_tp_h2o)
+            iest = floor(t_p) - min_tp_h2o
+            esx = estblh2o(iest) + (estblh2o(iest+1)-estblh2o(iest)) * &
+                 (t_p - min_tp_h2o - iest)
+            qsx = epsilo * esx / (pnew_mks - omeps * esx)
+            q_path = dw(i) / ABS(dpnm(i)) / rga
+            
+            ds2c     = abs(s2c(i,k2) - s2c(i,k2+1))
+            uc1(i)   = uinpl(i,kn)*ds2c
+            pch2o    = uc1(i)
+            uc1(i)   = (uc1(i) + 1.7e-3*u(i))*(1. +  2.*uc1(i))/(1. + 15.*uc1(i))
+            dtx(i)      = temh2o(i,kn) - 250.
+            dty(i)      = tbar(i,kn) - 250.
+            
+            fwk(i)    = fwcoef + fwc1/(1. + fwc2*u(i))
+            fwku(i)   = fwk(i)*u(i)
+
+            if(strat_volcanic) then
+              aer_pth_dlt=uinpl(i,kn)*aer_pth_ngh(i)
+  
+              do bnd_idx=1,bnd_nbr_LW
+                 odap_aer_ttl=abs_cff_mss_aer(bnd_idx) * aer_pth_dlt 
+                 aer_trn_ngh(i,bnd_idx)=exp(-fdif * odap_aer_ttl)
+              end do
+            else
+              aer_trn_ngh(i,:) = 1.0
+            endif
+
+!
+! Define variables for C/H/E (now C/LT/E) fit
+!
+! abso(i,1)     0 -  800 cm-1   h2o rotation band
+! abso(i,1)  1200 - 2200 cm-1   h2o vibration-rotation band
+! abso(i,2)   800 - 1200 cm-1   h2o window
+!
+! Separation between rotation and vibration-rotation dropped, so
+!                only 2 slots needed for H2O absorptivity
+!
+! Notation:
+! U   = integral (P/P_0 dW)  
+! P   = atmospheric pressure
+! P_0 = reference atmospheric pressure
+! W   = precipitable water path
+! T_e = emission temperature
+! T_p = path temperature
+! RH  = path relative humidity
+!
+!
+! Terms for asymptotic value of emissivity
+!
+            te1  = temh2o(i,kn)
+            te2  = te1 * te1
+            te3  = te2 * te1
+            te4  = te3 * te1
+            te5  = te4 * te1
+
+!
+! Indices for lines and continuum tables 
+! Note: because we are dealing with the nearest layer,
+!       the Hulst-Curtis-Godson corrections
+!       for inhomogeneous paths are not applied.
+!
+            uvar = u(i)*fdif
+            log_u  = min(log10(max(uvar, min_u_h2o)), max_lu_h2o)
+            dvar = (log_u - min_lu_h2o) / dlu_h2o
+            iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1)
+            iu1 = iu + 1
+            wu = dvar - floor(dvar)
+            wu1 = 1.0 - wu
+            
+            log_p  = min(log10(max(pnew(i), min_p_h2o)), max_lp_h2o)
+            dvar = (log_p - min_lp_h2o) / dlp_h2o
+            ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1)
+            ip1 = ip + 1
+            wp = dvar - floor(dvar)
+            wp1 = 1.0 - wp
+            
+            dvar = (t_p - min_tp_h2o) / dtp_h2o
+            itp = min(max(int(aint(dvar,r8)) + 1, 1), n_tp - 1)
+            itp1 = itp + 1
+            wtp = dvar - floor(dvar)
+            wtp1 = 1.0 - wtp
+            
+            t_e = min(max(temh2o(i,kn)-t_p,min_te_h2o),max_te_h2o)
+            dvar = (t_e - min_te_h2o) / dte_h2o
+            ite = min(max(int(aint(dvar,r8)) + 1, 1), n_te - 1)
+            ite1 = ite + 1
+            wte = dvar - floor(dvar)
+            wte1 = 1.0 - wte
+            
+            rh_path = min(max(q_path / qsx, min_rh_h2o), max_rh_h2o)
+            dvar = (rh_path - min_rh_h2o) / drh_h2o
+            irh = min(max(int(aint(dvar,r8)) + 1, 1), n_rh - 1)
+            irh1 = irh + 1
+            wrh = dvar - floor(dvar)
+            wrh1 = 1.0 - wrh
+            
+            w_0_0_ = wtp  * wte
+            w_0_1_ = wtp  * wte1
+            w_1_0_ = wtp1 * wte 
+            w_1_1_ = wtp1 * wte1
+            
+            w_0_00 = w_0_0_ * wrh
+            w_0_01 = w_0_0_ * wrh1
+            w_0_10 = w_0_1_ * wrh
+            w_0_11 = w_0_1_ * wrh1
+            w_1_00 = w_1_0_ * wrh
+            w_1_01 = w_1_0_ * wrh1
+            w_1_10 = w_1_1_ * wrh
+            w_1_11 = w_1_1_ * wrh1
+            
+            w00_00 = wp  * w_0_00 
+            w00_01 = wp  * w_0_01 
+            w00_10 = wp  * w_0_10 
+            w00_11 = wp  * w_0_11 
+            w01_00 = wp  * w_1_00 
+            w01_01 = wp  * w_1_01 
+            w01_10 = wp  * w_1_10 
+            w01_11 = wp  * w_1_11 
+            w10_00 = wp1 * w_0_00 
+            w10_01 = wp1 * w_0_01 
+            w10_10 = wp1 * w_0_10 
+            w10_11 = wp1 * w_0_11 
+            w11_00 = wp1 * w_1_00 
+            w11_01 = wp1 * w_1_01 
+            w11_10 = wp1 * w_1_10 
+            w11_11 = wp1 * w_1_11 
+
+!
+! Non-window absorptivity
+!
+            ib = 1
+            
+            fa = fat(1,ib) + &
+                 fat(2,ib) * te1 + &
+                 fat(3,ib) * te2 + &
+                 fat(4,ib) * te3 + &
+                 fat(5,ib) * te4 + &
+                 fat(6,ib) * te5
+            
+            a_star = &
+                 ah2onw(ip , itp , iu , ite , irh ) * w11_11 * wu1 + &
+                 ah2onw(ip , itp , iu , ite , irh1) * w11_10 * wu1 + &
+                 ah2onw(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + &
+                 ah2onw(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + &
+                 ah2onw(ip , itp , iu1, ite , irh ) * w11_11 * wu  + &
+                 ah2onw(ip , itp , iu1, ite , irh1) * w11_10 * wu  + &
+                 ah2onw(ip , itp , iu1, ite1, irh ) * w11_01 * wu  + &
+                 ah2onw(ip , itp , iu1, ite1, irh1) * w11_00 * wu  + &
+                 ah2onw(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + &
+                 ah2onw(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + &
+                 ah2onw(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + &
+                 ah2onw(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + &
+                 ah2onw(ip , itp1, iu1, ite , irh ) * w10_11 * wu  + &
+                 ah2onw(ip , itp1, iu1, ite , irh1) * w10_10 * wu  + &
+                 ah2onw(ip , itp1, iu1, ite1, irh ) * w10_01 * wu  + &
+                 ah2onw(ip , itp1, iu1, ite1, irh1) * w10_00 * wu  + &
+                 ah2onw(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + &
+                 ah2onw(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + &
+                 ah2onw(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + &
+                 ah2onw(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + &
+                 ah2onw(ip1, itp , iu1, ite , irh ) * w01_11 * wu  + &
+                 ah2onw(ip1, itp , iu1, ite , irh1) * w01_10 * wu  + &
+                 ah2onw(ip1, itp , iu1, ite1, irh ) * w01_01 * wu  + &
+                 ah2onw(ip1, itp , iu1, ite1, irh1) * w01_00 * wu  + &
+                 ah2onw(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + &
+                 ah2onw(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + &
+                 ah2onw(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + &
+                 ah2onw(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + &
+                 ah2onw(ip1, itp1, iu1, ite , irh ) * w00_11 * wu  + &
+                 ah2onw(ip1, itp1, iu1, ite , irh1) * w00_10 * wu  + &
+                 ah2onw(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu  + &
+                 ah2onw(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu
+            
+            abso(i,ib) = min(max(fa * (1.0 - (1.0 - a_star) * &
+                                 aer_trn_ngh(i,ib)), &
+                             0.0_r8), 1.0_r8)
+
+!
+! Invoke linear limit for scaling wrt u below min_u_h2o
+!
+            if (uvar < min_u_h2o) then
+               uscl = uvar / min_u_h2o
+               abso(i,ib) = abso(i,ib) * uscl
+            endif
+            
+!
+! Window absorptivity
+!
+            ib = 2
+            
+            fa = fat(1,ib) + &
+                 fat(2,ib) * te1 + &
+                 fat(3,ib) * te2 + &
+                 fat(4,ib) * te3 + &
+                 fat(5,ib) * te4 + &
+                 fat(6,ib) * te5
+            
+            a_star = &
+                 ah2ow(ip , itp , iu , ite , irh ) * w11_11 * wu1 + &
+                 ah2ow(ip , itp , iu , ite , irh1) * w11_10 * wu1 + &
+                 ah2ow(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + &
+                 ah2ow(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + &
+                 ah2ow(ip , itp , iu1, ite , irh ) * w11_11 * wu  + &
+                 ah2ow(ip , itp , iu1, ite , irh1) * w11_10 * wu  + &
+                 ah2ow(ip , itp , iu1, ite1, irh ) * w11_01 * wu  + &
+                 ah2ow(ip , itp , iu1, ite1, irh1) * w11_00 * wu  + &
+                 ah2ow(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + &
+                 ah2ow(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + &
+                 ah2ow(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + &
+                 ah2ow(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + &
+                 ah2ow(ip , itp1, iu1, ite , irh ) * w10_11 * wu  + &
+                 ah2ow(ip , itp1, iu1, ite , irh1) * w10_10 * wu  + &
+                 ah2ow(ip , itp1, iu1, ite1, irh ) * w10_01 * wu  + &
+                 ah2ow(ip , itp1, iu1, ite1, irh1) * w10_00 * wu  + &
+                 ah2ow(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + &
+                 ah2ow(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + &
+                 ah2ow(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + &
+                 ah2ow(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + &
+                 ah2ow(ip1, itp , iu1, ite , irh ) * w01_11 * wu  + &
+                 ah2ow(ip1, itp , iu1, ite , irh1) * w01_10 * wu  + &
+                 ah2ow(ip1, itp , iu1, ite1, irh ) * w01_01 * wu  + &
+                 ah2ow(ip1, itp , iu1, ite1, irh1) * w01_00 * wu  + &
+                 ah2ow(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + &
+                 ah2ow(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + &
+                 ah2ow(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + &
+                 ah2ow(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + &
+                 ah2ow(ip1, itp1, iu1, ite , irh ) * w00_11 * wu  + &
+                 ah2ow(ip1, itp1, iu1, ite , irh1) * w00_10 * wu  + &
+                 ah2ow(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu  + &
+                 ah2ow(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu
+            
+            abso(i,ib) = min(max(fa * (1.0 - (1.0 - a_star) * &
+                                 aer_trn_ngh(i,ib)), &
+                             0.0_r8), 1.0_r8)
+
+!
+! Invoke linear limit for scaling wrt u below min_u_h2o
+!
+            if (uvar < min_u_h2o) then
+               uscl = uvar / min_u_h2o
+               abso(i,ib) = abso(i,ib) * uscl
+            endif
+            
+         end do
+!
+! Line transmission in 800-1000 and 1000-1200 cm-1 intervals
+!
+         do i=1,ncol
+            term7(i,1) = coefj(1,1) + coefj(2,1)*dty(i)*(1. + c16*dty(i))
+            term8(i,1) = coefk(1,1) + coefk(2,1)*dty(i)*(1. + c17*dty(i))
+            term7(i,2) = coefj(1,2) + coefj(2,2)*dty(i)*(1. + c26*dty(i))
+            term8(i,2) = coefk(1,2) + coefk(2,2)*dty(i)*(1. + c27*dty(i))
+         end do
+!
+! 500 -  800 cm-1   h2o rotation band overlap with co2
+!
+         do i=1,ncol
+            dtym10     = dty(i) - 10.
+            denom      = 1. + (c30 + c31*dtym10*dtym10)*sqrtu(i)
+            k21        = term7(i,1) + term8(i,1)/denom
+            denom      = 1. + (c28 + c29*dtym10       )*sqrtu(i)
+            k22        = term7(i,2) + term8(i,2)/denom
+            tr1     = exp(-(k21*(sqrtu(i) + fc1*fwku(i))))
+            tr2     = exp(-(k22*(sqrtu(i) + fc1*fwku(i))))
+            tr1=tr1*aer_trn_ngh(i,idx_LW_0650_0800) 
+!                                         ! H2O line+STRAER trn 650--800 cm-1
+            tr2=tr2*aer_trn_ngh(i,idx_LW_0500_0650) 
+!                                         ! H2O line+STRAER trn 500--650 cm-1
+            tr5     = exp(-((coefh(1,3) + coefh(2,3)*dtx(i))*uc1(i)))
+            tr6     = exp(-((coefh(1,4) + coefh(2,4)*dtx(i))*uc1(i)))
+            tr9(i)  = tr1*tr5
+            tr10(i) = tr2*tr6
+            trab2(i)= 0.65*tr9(i) + 0.35*tr10(i)
+            th2o(i) = tr10(i)
+         end do
+!
+! abso(i,3)  o3  9.6 micrometer (nu3 and nu1 bands)
+!
+         do i=1,ncol
+            te        = (tbar(i,kn)*r293)**.7
+            dplos     = abs(plos(i,k2+1) - plos(i,k2))
+            u1        = zinpl(i,kn)*18.29*dplos/te
+            u2        = zinpl(i,kn)*.5649*dplos/te
+            tlocal    = tbar(i,kn)
+            tcrfac    = sqrt(tlocal*r250)*te
+            beta      = r3205*(pinpl(i,kn)*rsslp + dpfo3*tcrfac)
+            realnu    = te/beta
+            tmp1      = u1/sqrt(4. + u1*(1. + realnu))
+            tmp2      = u2/sqrt(4. + u2*(1. + realnu))
+            o3bndi    = 74.*te*log(1. + tmp1 + tmp2)
+            abso(i,3) = o3bndi*o3emm(i,kn)*(h2otr(i,k2+1)/h2otr(i,k2))
+            to3(i)    = 1.0/(1. + 0.1*tmp1 + 0.1*tmp2)
+         end do
+!
+! abso(i,4)   co2 15  micrometer band system
+!
+         do i=1,ncol
+            dplco2   = plco2(i,k2+1) - plco2(i,k2)
+            sqwp     = sqrt(uinpl(i,kn)*dplco2)
+            et       = exp(-480./tbar(i,kn))
+            sqti(i)  = sqrt(tbar(i,kn))
+            rsqti    = 1./sqti(i)
+            et2      = et*et
+            et4      = et2*et2
+            omet     = (1. - 1.5*et2)
+            f1co2    = 899.70*omet*(1. + 1.94774*et + 4.73486*et2)*rsqti
+            f1sqwp(i)= f1co2*sqwp
+            t1co2(i) = 1./(1. + (245.18*omet*sqwp*rsqti))
+            oneme    = 1. - et2
+            alphat   = oneme**3*rsqti
+            pi       = abs(dpnm(i))*winpl(i,kn)
+            wco2     = 2.5221*co2vmr*pi*rga
+            u7(i)    = 4.9411e4*alphat*et2*wco2
+            u8       = 3.9744e4*alphat*et4*wco2
+            u9       = 1.0447e5*alphat*et4*et2*wco2
+            u13      = 2.8388e3*alphat*et4*wco2
+            tpath    = tbar(i,kn)
+            tlocal   = tbar(i,kn)
+            tcrfac   = sqrt((tlocal*r250)*(tpath*r300))
+            posqt    = (pinpl(i,kn)*rsslp + dpfco2*tcrfac)*rsqti
+            rbeta7(i)= 1./(5.3228*posqt)
+            rbeta8   = 1./(10.6576*posqt)
+            rbeta9   = rbeta7(i)
+            rbeta13  = rbeta9
+            f2co2(i) = u7(i)/sqrt(4. + u7(i)*(1. + rbeta7(i))) + &
+                 u8   /sqrt(4. + u8*(1. + rbeta8)) + &
+                 u9   /sqrt(4. + u9*(1. + rbeta9))
+            f3co2(i) = u13/sqrt(4. + u13*(1. + rbeta13))
+            tmp1     = log(1. + f1sqwp(i))
+            tmp2     = log(1. + f2co2(i))
+            tmp3     = log(1. + f3co2(i))
+            absbnd   = (tmp1 + 2.*t1co2(i)*tmp2 + 2.*tmp3)*sqti(i)
+            abso(i,4)= trab2(i)*emm(i,kn)*absbnd
+            tco2(i)  = 1.0/(1.0+ 10.0*u7(i)/sqrt(4. + u7(i)*(1. + rbeta7(i))))
+         end do ! do i =
+!
+! Calculate trace gas absorptivity for nearest layer, abstrc
+!
+         call trcabn(lchnk   ,ncol    ,pcols, pverp,                   &
+              k2      ,kn      ,ucfc11  ,ucfc12  ,un2o0   , &
+              un2o1   ,uch4    ,uco211  ,uco212  ,uco213  , &
+              uco221  ,uco222  ,uco223  ,tbar    ,bplnk   , &
+              winpl   ,pinpl   ,tco2    ,th2o    ,to3     , &
+              uptype  ,dw      ,s2c     ,u       ,pnew    , &
+              abstrc  ,uinpl   , &
+              aer_trn_ngh)
+!
+! Total next layer absorptivity:
+!
+         do i=1,ncol
+            absnxt(i,k2,kn) = abso(i,1) + abso(i,2) + &
+                 abso(i,3) + abso(i,4) + abstrc(i)
+         end do
+      end do ! do kn =
+   end do ! do k2 =
+
+   return
+end subroutine radabs
+
+function psi(tpx,iband)
+!    
+! History: First version for Hitran 1996 (C/H/E)
+!          Current version for Hitran 2000 (C/LT/E)
+! Short function for Hulst-Curtis-Godson temperature factors for
+!   computing effective H2O path
+! Line data for H2O: Hitran 2000, plus H2O patches v11.0 for 1341 missing
+!                    lines between 500 and 2820 cm^-1.
+!                    See cfa-www.harvard.edu/HITRAN
+! Isotopes of H2O: all
+! Line widths: air-broadened only (self set to 0)
+! Code for line strengths and widths: GENLN3
+! Reference: Edwards, D.P., 1992: GENLN2, A General Line-by-Line Atmospheric
+!                     Transmittance and Radiance Model, Version 3.0 Description
+!                     and Users Guide, NCAR/TN-367+STR, 147 pp.
+!     
+! Note: functions have been normalized by dividing by their values at
+!       a path temperature of 160K
+!
+! spectral intervals:     
+!   1 = 0-800 cm^-1 and 1200-2200 cm^-1
+!   2 = 800-1200 cm^-1      
+!
+! Formulae: Goody and Yung, Atmospheric Radiation: Theoretical Basis,
+!           2nd edition, Oxford University Press, 1989.
+! Psi: function for pressure along path
+!      eq. 6.30, p. 228
+!
+   real(r8),intent(in):: tpx      ! path temperature
+   integer, intent(in):: iband    ! band to process
+   real(r8) psi                   ! psi for given band
+   real(r8),parameter ::  psi_r0(nbands) = (/ 5.65308452E-01, -7.30087891E+01/)
+   real(r8),parameter ::  psi_r1(nbands) = (/ 4.07519005E-03,  1.22199547E+00/)
+   real(r8),parameter ::  psi_r2(nbands) = (/-1.04347237E-05, -7.12256227E-03/)
+   real(r8),parameter ::  psi_r3(nbands) = (/ 1.23765354E-08,  1.47852825E-05/)
+
+   psi = (((psi_r3(iband) * tpx) + psi_r2(iband)) * tpx + psi_r1(iband)) * tpx + psi_r0(iband)
+end function psi
+
+function phi(tpx,iband)
+!
+! History: First version for Hitran 1996 (C/H/E)
+!          Current version for Hitran 2000 (C/LT/E)
+! Short function for Hulst-Curtis-Godson temperature factors for
+!   computing effective H2O path
+! Line data for H2O: Hitran 2000, plus H2O patches v11.0 for 1341 missing
+!                    lines between 500 and 2820 cm^-1.
+!                    See cfa-www.harvard.edu/HITRAN
+! Isotopes of H2O: all
+! Line widths: air-broadened only (self set to 0)
+! Code for line strengths and widths: GENLN3
+! Reference: Edwards, D.P., 1992: GENLN2, A General Line-by-Line Atmospheric
+!                     Transmittance and Radiance Model, Version 3.0 Description
+!                     and Users Guide, NCAR/TN-367+STR, 147 pp.
+!
+! Note: functions have been normalized by dividing by their values at
+!       a path temperature of 160K
+!
+! spectral intervals:
+!   1 = 0-800 cm^-1 and 1200-2200 cm^-1
+!   2 = 800-1200 cm^-1
+!
+! Formulae: Goody and Yung, Atmospheric Radiation: Theoretical Basis,
+!           2nd edition, Oxford University Press, 1989.
+! Phi: function for H2O path
+!      eq. 6.25, p. 228
+!
+   real(r8),intent(in):: tpx      ! path temperature
+   integer, intent(in):: iband    ! band to process
+   real(r8) phi                   ! phi for given band
+   real(r8),parameter ::  phi_r0(nbands) = (/ 9.60917711E-01, -2.21031342E+01/)
+   real(r8),parameter ::  phi_r1(nbands) = (/ 4.86076751E-04,  4.24062610E-01/)
+   real(r8),parameter ::  phi_r2(nbands) = (/-1.84806265E-06, -2.95543415E-03/)
+   real(r8),parameter ::  phi_r3(nbands) = (/ 2.11239959E-09,  7.52470896E-06/)
+
+   phi = (((phi_r3(iband) * tpx) + phi_r2(iband)) * tpx + phi_r1(iband)) &
+          * tpx + phi_r0(iband)
+end function phi
+
+function fh2oself( temp )
+!
+! Short function for H2O self-continuum temperature factor in
+!   calculation of effective H2O self-continuum path length
+!
+! H2O Continuum: CKD 2.4
+! Code for continuum: GENLN3
+! Reference: Edwards, D.P., 1992: GENLN2, A General Line-by-Line Atmospheric
+!                     Transmittance and Radiance Model, Version 3.0 Description
+!                     and Users Guide, NCAR/TN-367+STR, 147 pp.
+!
+! In GENLN, the temperature scaling of the self-continuum is handled
+!    by exponential interpolation/extrapolation from observations at
+!    260K and 296K by:
+!
+!         TFAC =  (T(IPATH) - 296.0)/(260.0 - 296.0)
+!         CSFFT = CSFF296*(CSFF260/CSFF296)**TFAC
+!
+! For 800-1200 cm^-1, (CSFF260/CSFF296) ranges from ~2.1 to ~1.9
+!     with increasing wavenumber.  The ratio <CSFF260>/<CSFF296>,
+!     where <> indicates average over wavenumber, is ~2.07
+!
+! fh2oself is (<CSFF260>/<CSFF296>)**TFAC
+!
+   real(r8),intent(in) :: temp     ! path temperature
+   real(r8) fh2oself               ! mean ratio of self-continuum at temp and 296K
+
+   fh2oself = 2.0727484**((296.0 - temp) / 36.0)
+end function fh2oself
+
+! from wv_saturation.F90
+
+   real(r8) function estblf( td )
+!
+! Saturation vapor pressure table lookup
+!
+   real(r8), intent(in) :: td         ! Temperature for saturation lookup
+!
+   real(r8) :: e       ! intermediate variable for es look-up
+   real(r8) :: ai
+   integer  :: i
+!
+   e = max(min(td,tmax),tmin)   ! partial pressure
+   i = int(e-tmin)+1
+   ai = aint(e-tmin)
+   estblf = (tmin+ai-e+1.)* &
+            estbl(i)-(tmin+ai-e)* &
+            estbl(i+1)
+   end function estblf
+
+
+subroutine esinti(epslon  ,latvap  ,latice  ,rh2o    ,cpair   ,tmelt   )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Initialize es lookup tables
+! 
+! Method: 
+! <Describe the algorithm(s) used in the routine.> 
+! <Also include any applicable external references.> 
+! 
+! Author: J. Hack
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use wv_saturation, only: gestbl
+   implicit none
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   real(r8), intent(in) :: epslon          ! Ratio of h2o to dry air molecular weights
+   real(r8), intent(in) :: latvap          ! Latent heat of vaporization
+   real(r8), intent(in) :: latice          ! Latent heat of fusion
+   real(r8), intent(in) :: rh2o            ! Gas constant for water vapor
+   real(r8), intent(in) :: cpair           ! Specific heat of dry air
+   real(r8), intent(in) :: tmelt           ! Melting point of water (K)
+!
+!---------------------------Local workspace-----------------------------
+!
+   real(r8) tmn             ! Minimum temperature entry in table
+   real(r8) tmx             ! Maximum temperature entry in table
+   real(r8) trice           ! Trans range from es over h2o to es over ice
+   logical ip           ! Ice phase (true or false)
+!
+!-----------------------------------------------------------------------
+!
+! Specify control parameters first
+!
+   tmn   = 173.16
+   tmx   = 375.16
+   trice =  20.00
+   ip    = .true.
+!
+! Call gestbl to build saturation vapor pressure table.
+!
+   call gestbl(tmn     ,tmx     ,trice   ,ip      ,epslon  , &
+               latvap  ,latice  ,rh2o    ,cpair   ,tmelt )
+!
+   return
+end subroutine esinti
+
+subroutine gestbl(tmn     ,tmx     ,trice   ,ip      ,epsil   , &
+                  latvap  ,latice  ,rh2o    ,cpair   ,tmeltx   )
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Builds saturation vapor pressure table for later lookup procedure.
+!
+! Method:
+! Uses Goff & Gratch (1946) relationships to generate the table
+! according to a set of free parameters defined below.  Auxiliary
+! routines are also included for making rapid estimates (well with 1%)
+! of both es and d(es)/dt for the particular table configuration.
+!
+! Author: J. Hack
+!
+!-----------------------------------------------------------------------
+!  use pmgrid, only: masterproc
+   implicit none
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   real(r8), intent(in) :: tmn           ! Minimum temperature entry in es lookup table
+   real(r8), intent(in) :: tmx           ! Maximum temperature entry in es lookup table
+   real(r8), intent(in) :: epsil         ! Ratio of h2o to dry air molecular weights
+   real(r8), intent(in) :: trice         ! Transition range from es over range to es over ice
+   real(r8), intent(in) :: latvap        ! Latent heat of vaporization
+   real(r8), intent(in) :: latice        ! Latent heat of fusion
+   real(r8), intent(in) :: rh2o          ! Gas constant for water vapor
+   real(r8), intent(in) :: cpair         ! Specific heat of dry air
+   real(r8), intent(in) :: tmeltx        ! Melting point of water (K)
+!
+!---------------------------Local variables-----------------------------
+!
+   real(r8) t             ! Temperature
+   real(r8) rgasv 
+   real(r8) cp
+   real(r8) hlatf
+   real(r8) ttrice
+   real(r8) hlatv
+   integer n          ! Increment counter
+   integer lentbl     ! Calculated length of lookup table
+   integer itype      ! Ice phase: 0 -> no ice phase
+!            1 -> ice phase, no transition
+!           -x -> ice phase, x degree transition
+   logical ip         ! Ice phase logical flag
+   logical icephs
+!
+!-----------------------------------------------------------------------
+!
+! Set es table parameters
+!
+   tmin   = tmn       ! Minimum temperature entry in table
+   tmax   = tmx       ! Maximum temperature entry in table
+   ttrice = trice     ! Trans. range from es over h2o to es over ice
+   icephs = ip        ! Ice phase (true or false)
+!
+! Set physical constants required for es calculation
+!
+   epsqs  = epsil
+   hlatv  = latvap
+   hlatf  = latice
+   rgasv  = rh2o
+   cp     = cpair
+   tmelt  = tmeltx
+!
+   lentbl = INT(tmax-tmin+2.000001)
+   if (lentbl .gt. plenest) then
+      write(6,9000) tmax, tmin, plenest
+!     call endrun ('GESTBL')    ! Abnormal termination
+   end if
+!
+! Begin building es table.
+! Check whether ice phase requested.
+! If so, set appropriate transition range for temperature
+!
+   if (icephs) then
+      if (ttrice /= 0.0) then
+         itype = -ttrice
+      else
+         itype = 1
+      end if
+   else
+      itype = 0
+   end if
+!
+   t = tmin - 1.0
+   do n=1,lentbl
+      t = t + 1.0
+      call gffgch(t,estbl(n),itype)
+   end do
+!
+   do n=lentbl+1,plenest
+      estbl(n) = -99999.0
+   end do
+!
+! Table complete -- Set coefficients for polynomial approximation of
+! difference between saturation vapor press over water and saturation
+! pressure over ice for -ttrice < t < 0 (degrees C). NOTE: polynomial
+! is valid in the range -40 < t < 0 (degrees C).
+!
+!                  --- Degree 5 approximation ---
+!
+   pcf(1) =  5.04469588506e-01
+   pcf(2) = -5.47288442819e+00
+   pcf(3) = -3.67471858735e-01
+   pcf(4) = -8.95963532403e-03
+   pcf(5) = -7.78053686625e-05
+!
+!                  --- Degree 6 approximation ---
+!
+!-----pcf(1) =  7.63285250063e-02
+!-----pcf(2) = -5.86048427932e+00
+!-----pcf(3) = -4.38660831780e-01
+!-----pcf(4) = -1.37898276415e-02
+!-----pcf(5) = -2.14444472424e-04
+!-----pcf(6) = -1.36639103771e-06
+!
+   if (masterproc) then
+      write(6,*)' *** SATURATION VAPOR PRESSURE TABLE COMPLETED ***'
+   end if
+
+   return
+!
+9000 format('GESTBL: FATAL ERROR *********************************',/, &
+            ' TMAX AND TMIN REQUIRE A LARGER DIMENSION ON THE LENGTH', &
+            ' OF THE SATURATION VAPOR PRESSURE TABLE ESTBL(PLENEST)',/, &
+            ' TMAX, TMIN, AND PLENEST => ', 2f7.2, i3)
+!
+end subroutine gestbl
+
+subroutine gffgch(t       ,es      ,itype   )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Computes saturation vapor pressure over water and/or over ice using
+! Goff & Gratch (1946) relationships. 
+! <Say what the routine does> 
+! 
+! Method: 
+! T (temperature), and itype are input parameters, while es (saturation
+! vapor pressure) is an output parameter.  The input parameter itype
+! serves two purposes: a value of zero indicates that saturation vapor
+! pressures over water are to be returned (regardless of temperature),
+! while a value of one indicates that saturation vapor pressures over
+! ice should be returned when t is less than freezing degrees.  If itype
+! is negative, its absolute value is interpreted to define a temperature
+! transition region below freezing in which the returned
+! saturation vapor pressure is a weighted average of the respective ice
+! and water value.  That is, in the temperature range 0 => -itype
+! degrees c, the saturation vapor pressures are assumed to be a weighted
+! average of the vapor pressure over supercooled water and ice (all
+! water at 0 c; all ice at -itype c).  Maximum transition range => 40 c
+! 
+! Author: J. Hack
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use physconst, only: tmelt
+!  use abortutils, only: endrun
+    
+   implicit none
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   real(r8), intent(in) :: t          ! Temperature
+!
+! Output arguments
+!
+   integer, intent(inout) :: itype   ! Flag for ice phase and associated transition
+
+   real(r8), intent(out) :: es         ! Saturation vapor pressure
+!
+!---------------------------Local variables-----------------------------
+!
+   real(r8) e1         ! Intermediate scratch variable for es over water
+   real(r8) e2         ! Intermediate scratch variable for es over water
+   real(r8) eswtr      ! Saturation vapor pressure over water
+   real(r8) f          ! Intermediate scratch variable for es over water
+   real(r8) f1         ! Intermediate scratch variable for es over water
+   real(r8) f2         ! Intermediate scratch variable for es over water
+   real(r8) f3         ! Intermediate scratch variable for es over water
+   real(r8) f4         ! Intermediate scratch variable for es over water
+   real(r8) f5         ! Intermediate scratch variable for es over water
+   real(r8) ps         ! Reference pressure (mb)
+   real(r8) t0         ! Reference temperature (freezing point of water)
+   real(r8) term1      ! Intermediate scratch variable for es over ice
+   real(r8) term2      ! Intermediate scratch variable for es over ice
+   real(r8) term3      ! Intermediate scratch variable for es over ice
+   real(r8) tr         ! Transition range for es over water to es over ice
+   real(r8) ts         ! Reference temperature (boiling point of water)
+   real(r8) weight     ! Intermediate scratch variable for es transition
+   integer itypo   ! Intermediate scratch variable for holding itype
+!
+!-----------------------------------------------------------------------
+!
+! Check on whether there is to be a transition region for es
+!
+   if (itype < 0) then
+      tr    = abs(float(itype))
+      itypo = itype
+      itype = 1
+   else
+      tr    = 0.0
+      itypo = itype
+   end if
+   if (tr > 40.0) then
+      write(6,900) tr
+!     call endrun ('GFFGCH')                ! Abnormal termination
+   end if
+!
+   if(t < (tmelt - tr) .and. itype == 1) go to 10
+!
+! Water
+!
+   ps = 1013.246
+   ts = 373.16
+   e1 = 11.344*(1.0 - t/ts)
+   e2 = -3.49149*(ts/t - 1.0)
+   f1 = -7.90298*(ts/t - 1.0)
+   f2 = 5.02808*log10(ts/t)
+   f3 = -1.3816*(10.0**e1 - 1.0)/10000000.0
+   f4 = 8.1328*(10.0**e2 - 1.0)/1000.0
+   f5 = log10(ps)
+   f  = f1 + f2 + f3 + f4 + f5
+   es = (10.0**f)*100.0
+   eswtr = es
+!
+   if(t >= tmelt .or. itype == 0) go to 20
+!
+! Ice
+!
+10 continue
+   t0    = tmelt
+   term1 = 2.01889049/(t0/t)
+   term2 = 3.56654*log(t0/t)
+   term3 = 20.947031*(t0/t)
+   es    = 575.185606e10*exp(-(term1 + term2 + term3))
+!
+   if (t < (tmelt - tr)) go to 20
+!
+! Weighted transition between water and ice
+!
+   weight = min((tmelt - t)/tr,1.0_r8)
+   es = weight*es + (1.0 - weight)*eswtr
+!
+20 continue
+   itype = itypo
+   return
+!
+900 format('GFFGCH: FATAL ERROR ******************************',/, &
+           'TRANSITION RANGE FOR WATER TO ICE SATURATION VAPOR', &
+           ' PRESSURE, TR, EXCEEDS MAXIMUM ALLOWABLE VALUE OF', &
+           ' 40.0 DEGREES C',/, ' TR = ',f7.2)
+!
+end subroutine gffgch
+
+subroutine radems(lchnk   ,ncol    ,pcols, pver, pverp,         &
+                  s2c     ,tcg     ,w       ,tplnke  ,plh2o   , &
+                  pnm     ,plco2   ,tint    ,tint4   ,tlayr   , &
+                  tlayr4  ,plol    ,plos    ,ucfc11  ,ucfc12  , &
+                  un2o0   ,un2o1   ,uch4    ,uco211 ,uco212   , &
+                  uco213  ,uco221  ,uco222  ,uco223  ,uptype  , &
+                  bn2o0   ,bn2o1   ,bch4    ,co2em   ,co2eml  , &
+                  co2t    ,h2otr   ,abplnk1 ,abplnk2 ,emstot  , &
+                  plh2ob  ,wb      , &
+                  aer_trn_ttl)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Compute emissivity for H2O, CO2, O3, CH4, N2O, CFC11 and CFC12
+! 
+! Method: 
+! H2O  ....  Uses nonisothermal emissivity method for water vapor from
+!            Ramanathan, V. and  P.Downey, 1986: A Nonisothermal
+!            Emissivity and Absorptivity Formulation for Water Vapor
+!            Jouranl of Geophysical Research, vol. 91., D8, pp 8649-8666
+!
+!            Implementation updated by Collins,Hackney, and Edwards 2001
+!               using line-by-line calculations based upon Hitran 1996 and
+!               CKD 2.1 for absorptivity and emissivity
+!
+!            Implementation updated by Collins, Lee-Taylor, and Edwards (2003)
+!               using line-by-line calculations based upon Hitran 2000 and
+!               CKD 2.4 for absorptivity and emissivity
+!
+! CO2  ....  Uses absorptance parameterization of the 15 micro-meter
+!            (500 - 800 cm-1) band system of Carbon Dioxide, from
+!            Kiehl, J.T. and B.P.Briegleb, 1991: A New Parameterization
+!            of the Absorptance Due to the 15 micro-meter Band System
+!            of Carbon Dioxide Jouranl of Geophysical Research,
+!            vol. 96., D5, pp 9013-9019. Also includes the effects
+!            of the 9.4 and 10.4 micron bands of CO2.
+!
+! O3   ....  Uses absorptance parameterization of the 9.6 micro-meter
+!            band system of ozone, from Ramanathan, V. and R. Dickinson,
+!            1979: The Role of stratospheric ozone in the zonal and
+!            seasonal radiative energy balance of the earth-troposphere
+!            system. Journal of the Atmospheric Sciences, Vol. 36,
+!            pp 1084-1104
+!
+! ch4  ....  Uses a broad band model for the 7.7 micron band of methane.
+!
+! n20  ....  Uses a broad band model for the 7.8, 8.6 and 17.0 micron
+!            bands of nitrous oxide
+!
+! cfc11 ...  Uses a quasi-linear model for the 9.2, 10.7, 11.8 and 12.5
+!            micron bands of CFC11
+!
+! cfc12 ...  Uses a quasi-linear model for the 8.6, 9.1, 10.8 and 11.2
+!            micron bands of CFC12
+!
+!
+! Computes individual emissivities, accounting for band overlap, and
+! sums to obtain the total.
+!
+! Author: W. Collins (H2O emissivity) and J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                    ! chunk identifier
+   integer, intent(in) :: ncol                     ! number of atmospheric columns
+   integer, intent(in) :: pcols, pver, pverp
+
+   real(r8), intent(in) :: s2c(pcols,pverp)        ! H2o continuum path length
+   real(r8), intent(in) :: tcg(pcols,pverp)        ! H2o-mass-wgted temp. (Curtis-Godson approx.)
+   real(r8), intent(in) :: w(pcols,pverp)          ! H2o path length
+   real(r8), intent(in) :: tplnke(pcols)           ! Layer planck temperature
+   real(r8), intent(in) :: plh2o(pcols,pverp)      ! H2o prs wghted path length
+   real(r8), intent(in) :: pnm(pcols,pverp)        ! Model interface pressure
+   real(r8), intent(in) :: plco2(pcols,pverp)      ! Prs wghted path of co2
+   real(r8), intent(in) :: tint(pcols,pverp)       ! Model interface temperatures
+   real(r8), intent(in) :: tint4(pcols,pverp)      ! Tint to the 4th power
+   real(r8), intent(in) :: tlayr(pcols,pverp)      ! K-1 model layer temperature
+   real(r8), intent(in) :: tlayr4(pcols,pverp)     ! Tlayr to the 4th power
+   real(r8), intent(in) :: plol(pcols,pverp)       ! Pressure wghtd ozone path
+   real(r8), intent(in) :: plos(pcols,pverp)       ! Ozone path
+   real(r8), intent(in) :: plh2ob(nbands,pcols,pverp) ! Pressure weighted h2o path with 
+                                                      !    Hulst-Curtis-Godson temp. factor 
+                                                      !    for H2O bands 
+   real(r8), intent(in) :: wb(nbands,pcols,pverp)     ! H2o path length with 
+                                                      !    Hulst-Curtis-Godson temp. factor 
+                                                      !    for H2O bands 
+
+   real(r8), intent(in) :: aer_trn_ttl(pcols,pverp,pverp,bnd_nbr_LW) 
+!                               ! [fraction] Total strat. aerosol
+!                               ! transmission between interfaces k1 and k2  
+
+!
+! Trace gas variables
+!
+   real(r8), intent(in) :: ucfc11(pcols,pverp)     ! CFC11 path length
+   real(r8), intent(in) :: ucfc12(pcols,pverp)     ! CFC12 path length
+   real(r8), intent(in) :: un2o0(pcols,pverp)      ! N2O path length
+   real(r8), intent(in) :: un2o1(pcols,pverp)      ! N2O path length (hot band)
+   real(r8), intent(in) :: uch4(pcols,pverp)       ! CH4 path length
+   real(r8), intent(in) :: uco211(pcols,pverp)     ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco212(pcols,pverp)     ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco213(pcols,pverp)     ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco221(pcols,pverp)     ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uco222(pcols,pverp)     ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uco223(pcols,pverp)     ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: bn2o0(pcols,pverp)      ! pressure factor for n2o
+   real(r8), intent(in) :: bn2o1(pcols,pverp)      ! pressure factor for n2o
+   real(r8), intent(in) :: bch4(pcols,pverp)       ! pressure factor for ch4
+   real(r8), intent(in) :: uptype(pcols,pverp)     ! p-type continuum path length
+!
+! Output arguments
+!
+   real(r8), intent(out) :: emstot(pcols,pverp)     ! Total emissivity
+   real(r8), intent(out) :: co2em(pcols,pverp)      ! Layer co2 normalzd plnck funct drvtv
+   real(r8), intent(out) :: co2eml(pcols,pver)      ! Intrfc co2 normalzd plnck func drvtv
+   real(r8), intent(out) :: co2t(pcols,pverp)       ! Tmp and prs weighted path length
+   real(r8), intent(out) :: h2otr(pcols,pverp)      ! H2o transmission over o3 band
+   real(r8), intent(out) :: abplnk1(14,pcols,pverp) ! non-nearest layer Plack factor
+   real(r8), intent(out) :: abplnk2(14,pcols,pverp) ! nearest layer factor
+
+!
+!---------------------------Local variables-----------------------------
+!
+   integer i                    ! Longitude index
+   integer k                    ! Level index]
+   integer k1                   ! Level index
+!
+! Local variables for H2O:
+!
+   real(r8) h2oems(pcols,pverp)     ! H2o emissivity
+   real(r8) tpathe                  ! Used to compute h2o emissivity
+   real(r8) dtx(pcols)              ! Planck temperature minus 250 K
+   real(r8) dty(pcols)              ! Path temperature minus 250 K
+!
+! The 500-800 cm^-1 emission in emis(i,4) has been combined
+!              into the 0-800 cm^-1 emission in emis(i,1)
+!
+   real(r8) emis(pcols,2)           ! H2O emissivity 
+!
+!
+!
+   real(r8) term7(pcols,2)          ! Kl_inf(i) in eq(r8) of table A3a of R&D
+   real(r8) term8(pcols,2)          ! Delta kl_inf(i) in eq(r8)
+   real(r8) tr1(pcols)              ! Equation(6) in table A2 for 650-800
+   real(r8) tr2(pcols)              ! Equation(6) in table A2 for 500-650
+   real(r8) tr3(pcols)              ! Equation(4) in table A2 for 650-800
+   real(r8) tr4(pcols)              ! Equation(4),table A2 of R&D for 500-650
+   real(r8) tr7(pcols)              ! Equation (6) times eq(4) in table A2
+!                                      of R&D for 650-800 cm-1 region
+   real(r8) tr8(pcols)              ! Equation (6) times eq(4) in table A2
+!                                      of R&D for 500-650 cm-1 region
+   real(r8) k21(pcols)              ! Exponential coefficient used to calc
+!                                     rot band transmissivity in the 650-800
+!                                     cm-1 region (tr1)
+   real(r8) k22(pcols)              ! Exponential coefficient used to calc
+!                                     rot band transmissivity in the 500-650
+!                                     cm-1 region (tr2)
+   real(r8) u(pcols)                ! Pressure weighted H2O path length
+   real(r8) ub(nbands)              ! Pressure weighted H2O path length with
+                                    !  Hulst-Curtis-Godson correction for
+                                    !  each band
+   real(r8) pnew                    ! Effective pressure for h2o linewidth
+   real(r8) pnewb(nbands)           ! Effective pressure for h2o linewidth w/
+                                    !  Hulst-Curtis-Godson correction for
+                                    !  each band
+   real(r8) uc1(pcols)              ! H2o continuum pathlength 500-800 cm-1
+   real(r8) fwk                     ! Equation(33) in R&D far wing correction
+   real(r8) troco2(pcols,pverp)     ! H2o overlap factor for co2 absorption
+   real(r8) emplnk(14,pcols)        ! emissivity Planck factor
+   real(r8) emstrc(pcols,pverp)     ! total trace gas emissivity
+!
+! Local variables for CO2:
+!
+   real(r8) co2ems(pcols,pverp)      ! Co2 emissivity
+   real(r8) co2plk(pcols)            ! Used to compute co2 emissivity
+   real(r8) sum(pcols)               ! Used to calculate path temperature
+   real(r8) t1i                      ! Co2 hot band temperature factor
+   real(r8) sqti                     ! Sqrt of temperature
+   real(r8) pi                       ! Pressure used in co2 mean line width
+   real(r8) et                       ! Co2 hot band factor
+   real(r8) et2                      ! Co2 hot band factor
+   real(r8) et4                      ! Co2 hot band factor
+   real(r8) omet                     ! Co2 stimulated emission term
+   real(r8) ex                       ! Part of co2 planck function
+   real(r8) f1co2                    ! Co2 weak band factor
+   real(r8) f2co2                    ! Co2 weak band factor
+   real(r8) f3co2                    ! Co2 weak band factor
+   real(r8) t1co2                    ! Overlap factor weak bands strong band
+   real(r8) sqwp                     ! Sqrt of co2 pathlength
+   real(r8) f1sqwp                   ! Main co2 band factor
+   real(r8) oneme                    ! Co2 stimulated emission term
+   real(r8) alphat                   ! Part of the co2 stimulated emiss term
+   real(r8) wco2                     ! Consts used to define co2 pathlength
+   real(r8) posqt                    ! Effective pressure for co2 line width
+   real(r8) rbeta7                   ! Inverse of co2 hot band line width par
+   real(r8) rbeta8                   ! Inverse of co2 hot band line width par
+   real(r8) rbeta9                   ! Inverse of co2 hot band line width par
+   real(r8) rbeta13                  ! Inverse of co2 hot band line width par
+   real(r8) tpath                    ! Path temp used in co2 band model
+   real(r8) tmp1                     ! Co2 band factor
+   real(r8) tmp2                     ! Co2 band factor
+   real(r8) tmp3                     ! Co2 band factor
+   real(r8) tlayr5                   ! Temperature factor in co2 Planck func
+   real(r8) rsqti                    ! Reciprocal of sqrt of temperature
+   real(r8) exm1sq                   ! Part of co2 Planck function
+   real(r8) u7                       ! Absorber amt for various co2 band systems
+   real(r8) u8                       ! Absorber amt for various co2 band systems
+   real(r8) u9                       ! Absorber amt for various co2 band systems
+   real(r8) u13                      ! Absorber amt for various co2 band systems
+   real(r8) r250                     ! Inverse 250K
+   real(r8) r300                     ! Inverse 300K
+   real(r8) rsslp                    ! Inverse standard sea-level pressure
+!
+! Local variables for O3:
+!
+   real(r8) o3ems(pcols,pverp)       ! Ozone emissivity
+   real(r8) dbvtt(pcols)             ! Tmp drvtv of planck fctn for tplnke
+   real(r8) dbvt,fo3,t,ux,vx
+   real(r8) te                       ! Temperature factor
+   real(r8) u1                       ! Path length factor
+   real(r8) u2                       ! Path length factor
+   real(r8) phat                     ! Effecitive path length pressure
+   real(r8) tlocal                   ! Local planck function temperature
+   real(r8) tcrfac                   ! Scaled temperature factor
+   real(r8) beta                     ! Absorption funct factor voigt effect
+   real(r8) realnu                   ! Absorption function factor
+   real(r8) o3bndi                   ! Band absorption factor
+!
+! Transmission terms for various spectral intervals:
+!
+   real(r8) absbnd                   ! Proportional to co2 band absorptance
+   real(r8) tco2(pcols)              ! co2 overlap factor
+   real(r8) th2o(pcols)              ! h2o overlap factor
+   real(r8) to3(pcols)               ! o3 overlap factor
+!
+! Variables for new H2O parameterization
+!
+! Notation:
+! U   = integral (P/P_0 dW)  eq. 15 in Ramanathan/Downey 1986
+! P   = atmospheric pressure
+! P_0 = reference atmospheric pressure
+! W   = precipitable water path
+! T_e = emission temperature
+! T_p = path temperature
+! RH  = path relative humidity
+!
+   real(r8) fe               ! asymptotic value of emis. as U->infinity
+   real(r8) e_star           ! normalized non-window emissivity
+   real(r8) l_star           ! interpolated line transmission
+   real(r8) c_star           ! interpolated continuum transmission
+
+   real(r8) te1              ! emission temperature
+   real(r8) te2              ! te^2
+   real(r8) te3              ! te^3
+   real(r8) te4              ! te^4
+   real(r8) te5              ! te^5
+
+   real(r8) log_u            ! log base 10 of U 
+   real(r8) log_uc           ! log base 10 of H2O continuum path
+   real(r8) log_p            ! log base 10 of P
+   real(r8) t_p              ! T_p
+   real(r8) t_e              ! T_e (offset by T_p)
+
+   integer iu                ! index for log10(U)
+   integer iu1               ! iu + 1
+   integer iuc               ! index for log10(H2O continuum path)
+   integer iuc1              ! iuc + 1
+   integer ip                ! index for log10(P)
+   integer ip1               ! ip + 1
+   integer itp               ! index for T_p
+   integer itp1              ! itp + 1
+   integer ite               ! index for T_e
+   integer ite1              ! ite + 1
+   integer irh               ! index for RH
+   integer irh1              ! irh + 1
+
+   real(r8) dvar             ! normalized variation in T_p/T_e/P/U
+   real(r8) uvar             ! U * diffusivity factor
+   real(r8) uscl             ! factor for lineary scaling as U->0
+
+   real(r8) wu               ! weight for U
+   real(r8) wu1              ! 1 - wu
+   real(r8) wuc              ! weight for H2O continuum path
+   real(r8) wuc1             ! 1 - wuc
+   real(r8) wp               ! weight for P
+   real(r8) wp1              ! 1 - wp
+   real(r8) wtp              ! weight for T_p
+   real(r8) wtp1             ! 1 - wtp
+   real(r8) wte              ! weight for T_e
+   real(r8) wte1             ! 1 - wte
+   real(r8) wrh              ! weight for RH
+   real(r8) wrh1             ! 1 - wrh
+
+   real(r8) w_0_0_           ! weight for Tp/Te combination
+   real(r8) w_0_1_           ! weight for Tp/Te combination
+   real(r8) w_1_0_           ! weight for Tp/Te combination
+   real(r8) w_1_1_           ! weight for Tp/Te combination
+
+   real(r8) w_0_00           ! weight for Tp/Te/RH combination
+   real(r8) w_0_01           ! weight for Tp/Te/RH combination
+   real(r8) w_0_10           ! weight for Tp/Te/RH combination
+   real(r8) w_0_11           ! weight for Tp/Te/RH combination
+   real(r8) w_1_00           ! weight for Tp/Te/RH combination
+   real(r8) w_1_01           ! weight for Tp/Te/RH combination
+   real(r8) w_1_10           ! weight for Tp/Te/RH combination
+   real(r8) w_1_11           ! weight for Tp/Te/RH combination
+
+   real(r8) w00_00           ! weight for P/Tp/Te/RH combination
+   real(r8) w00_01           ! weight for P/Tp/Te/RH combination
+   real(r8) w00_10           ! weight for P/Tp/Te/RH combination
+   real(r8) w00_11           ! weight for P/Tp/Te/RH combination
+   real(r8) w01_00           ! weight for P/Tp/Te/RH combination
+   real(r8) w01_01           ! weight for P/Tp/Te/RH combination
+   real(r8) w01_10           ! weight for P/Tp/Te/RH combination
+   real(r8) w01_11           ! weight for P/Tp/Te/RH combination
+   real(r8) w10_00           ! weight for P/Tp/Te/RH combination
+   real(r8) w10_01           ! weight for P/Tp/Te/RH combination
+   real(r8) w10_10           ! weight for P/Tp/Te/RH combination
+   real(r8) w10_11           ! weight for P/Tp/Te/RH combination
+   real(r8) w11_00           ! weight for P/Tp/Te/RH combination
+   real(r8) w11_01           ! weight for P/Tp/Te/RH combination
+   real(r8) w11_10           ! weight for P/Tp/Te/RH combination
+   real(r8) w11_11           ! weight for P/Tp/Te/RH combination
+
+   integer ib                ! spectral interval:
+                             !   1 = 0-800 cm^-1 and 1200-2200 cm^-1
+                             !   2 = 800-1200 cm^-1
+
+   real(r8) pch2o            ! H2O continuum path
+   real(r8) fch2o            ! temp. factor for continuum
+   real(r8) uch2o            ! U corresponding to H2O cont. path (window)
+
+   real(r8) fdif             ! secant(zenith angle) for diffusivity approx.
+
+   real(r8) sslp_mks         ! Sea-level pressure in MKS units
+   real(r8) esx              ! saturation vapor pressure returned by vqsatd
+   real(r8) qsx              ! saturation mixing ratio returned by vqsatd
+   real(r8) pnew_mks         ! pnew in MKS units
+   real(r8) q_path           ! effective specific humidity along path
+   real(r8) rh_path          ! effective relative humidity along path
+   real(r8) omeps            ! 1 - epsilo
+
+   integer  iest             ! index in estblh2o
+
+!
+!---------------------------Statement functions-------------------------
+!
+! Derivative of planck function at 9.6 micro-meter wavelength, and
+! an absorption function factor:
+!
+!
+   dbvt(t)=(-2.8911366682e-4+(2.3771251896e-6+1.1305188929e-10*t)*t)/ &
+           (1.0+(-6.1364820707e-3+1.5550319767e-5*t)*t)
+!
+   fo3(ux,vx)=ux/sqrt(4.+ux*(1.+vx))
+!
+!
+!
+!-----------------------------------------------------------------------
+!
+! Initialize
+!
+   r250  = 1./250.
+   r300  = 1./300.
+   rsslp = 1./sslp
+!
+! Constants for computing U corresponding to H2O cont. path
+!
+   fdif       = 1.66
+   sslp_mks   = sslp / 10.0
+   omeps      = 1.0 - epsilo
+!
+! Planck function for co2
+!
+   do i=1,ncol
+      ex             = exp(960./tplnke(i))
+      co2plk(i)      = 5.e8/((tplnke(i)**4)*(ex - 1.))
+      co2t(i,ntoplw) = tplnke(i)
+      sum(i)         = co2t(i,ntoplw)*pnm(i,ntoplw)
+   end do
+   k = ntoplw
+   do k1=pverp,ntoplw+1,-1
+      k = k + 1
+      do i=1,ncol
+         sum(i)         = sum(i) + tlayr(i,k)*(pnm(i,k)-pnm(i,k-1))
+         ex             = exp(960./tlayr(i,k1))
+         tlayr5         = tlayr(i,k1)*tlayr4(i,k1)
+         co2eml(i,k1-1) = 1.2e11*ex/(tlayr5*(ex - 1.)**2)
+         co2t(i,k)      = sum(i)/pnm(i,k)
+      end do
+   end do
+!
+! Initialize planck function derivative for O3
+!
+   do i=1,ncol
+      dbvtt(i) = dbvt(tplnke(i))
+   end do
+!
+! Calculate trace gas Planck functions
+!
+   call trcplk(lchnk   ,ncol    ,pcols, pver, pverp,         &
+               tint    ,tlayr   ,tplnke  ,emplnk  ,abplnk1 , &
+               abplnk2 )
+!
+! Interface loop
+!
+   do k1=ntoplw,pverp
+!
+! H2O emissivity
+!
+! emis(i,1)     0 -  800 cm-1   h2o rotation band
+! emis(i,1)  1200 - 2200 cm-1   h2o vibration-rotation band
+! emis(i,2)   800 - 1200 cm-1   h2o window
+!
+! Separation between rotation and vibration-rotation dropped, so
+!                only 2 slots needed for H2O emissivity
+!
+!      emis(i,3)   = 0.0
+!
+! For the p type continuum
+!
+      do i=1,ncol
+         u(i)        = plh2o(i,k1)
+         pnew        = u(i)/w(i,k1)
+         pnew_mks    = pnew * sslp_mks
+!
+! Apply scaling factor for 500-800 continuum
+!
+         uc1(i)      = (s2c(i,k1) + 1.7e-3*plh2o(i,k1))*(1. + 2.*s2c(i,k1))/ &
+                       (1. + 15.*s2c(i,k1))
+         pch2o       = s2c(i,k1)
+!
+! Changed effective path temperature to std. Curtis-Godson form
+!
+         tpathe   = tcg(i,k1)/w(i,k1)
+         t_p = min(max(tpathe, min_tp_h2o), max_tp_h2o)
+         iest = floor(t_p) - min_tp_h2o
+         esx = estblh2o(iest) + (estblh2o(iest+1)-estblh2o(iest)) * &
+               (t_p - min_tp_h2o - iest)
+         qsx = epsilo * esx / (pnew_mks - omeps * esx)
+!
+! Compute effective RH along path
+!
+         q_path = w(i,k1) / pnm(i,k1) / rga
+!
+! Calculate effective u, pnew for each band using
+!        Hulst-Curtis-Godson approximation:
+! Formulae: Goody and Yung, Atmospheric Radiation: Theoretical Basis, 
+!           2nd edition, Oxford University Press, 1989.
+! Effective H2O path (w)
+!      eq. 6.24, p. 228
+! Effective H2O path pressure (pnew = u/w):
+!      eq. 6.29, p. 228
+!
+         ub(1) = plh2ob(1,i,k1) / psi(t_p,1)
+         ub(2) = plh2ob(2,i,k1) / psi(t_p,2)
+
+         pnewb(1) = ub(1) / wb(1,i,k1) * phi(t_p,1)
+         pnewb(2) = ub(2) / wb(2,i,k1) * phi(t_p,2)
+!
+!
+!
+         dtx(i) = tplnke(i) - 250.
+         dty(i) = tpathe - 250.
+!
+! Define variables for C/H/E (now C/LT/E) fit
+!
+! emis(i,1)     0 -  800 cm-1   h2o rotation band
+! emis(i,1)  1200 - 2200 cm-1   h2o vibration-rotation band
+! emis(i,2)   800 - 1200 cm-1   h2o window
+!
+! Separation between rotation and vibration-rotation dropped, so
+!                only 2 slots needed for H2O emissivity
+!
+! emis(i,3)   = 0.0
+!
+! Notation:
+! U   = integral (P/P_0 dW)  
+! P   = atmospheric pressure
+! P_0 = reference atmospheric pressure
+! W   = precipitable water path
+! T_e = emission temperature
+! T_p = path temperature
+! RH  = path relative humidity
+!
+! Terms for asymptotic value of emissivity
+!
+         te1  = tplnke(i)
+         te2  = te1 * te1
+         te3  = te2 * te1
+         te4  = te3 * te1
+         te5  = te4 * te1
+!
+! Band-independent indices for lines and continuum tables
+!
+         dvar = (t_p - min_tp_h2o) / dtp_h2o
+         itp = min(max(int(aint(dvar,r8)) + 1, 1), n_tp - 1)
+         itp1 = itp + 1
+         wtp = dvar - floor(dvar)
+         wtp1 = 1.0 - wtp
+
+         t_e = min(max(tplnke(i) - t_p, min_te_h2o), max_te_h2o)
+         dvar = (t_e - min_te_h2o) / dte_h2o
+         ite = min(max(int(aint(dvar,r8)) + 1, 1), n_te - 1)
+         ite1 = ite + 1
+         wte = dvar - floor(dvar)
+         wte1 = 1.0 - wte
+
+         rh_path = min(max(q_path / qsx, min_rh_h2o), max_rh_h2o)
+         dvar = (rh_path - min_rh_h2o) / drh_h2o
+         irh = min(max(int(aint(dvar,r8)) + 1, 1), n_rh - 1)
+         irh1 = irh + 1
+         wrh = dvar - floor(dvar)
+         wrh1 = 1.0 - wrh
+
+         w_0_0_ = wtp  * wte
+         w_0_1_ = wtp  * wte1
+         w_1_0_ = wtp1 * wte 
+         w_1_1_ = wtp1 * wte1
+
+         w_0_00 = w_0_0_ * wrh
+         w_0_01 = w_0_0_ * wrh1
+         w_0_10 = w_0_1_ * wrh
+         w_0_11 = w_0_1_ * wrh1
+         w_1_00 = w_1_0_ * wrh
+         w_1_01 = w_1_0_ * wrh1
+         w_1_10 = w_1_1_ * wrh
+         w_1_11 = w_1_1_ * wrh1
+!
+! H2O Continuum path for 0-800 and 1200-2200 cm^-1
+!
+!    Assume foreign continuum dominates total H2O continuum in these bands
+!    per Clough et al, JGR, v. 97, no. D14 (Oct 20, 1992), p. 15776
+!    Then the effective H2O path is just 
+!         U_c = integral[ f(P) dW ]
+!    where 
+!           W = water-vapor mass and 
+!        f(P) = dependence of foreign continuum on pressure 
+!             = P / sslp
+!    Then 
+!         U_c = U (the same effective H2O path as for lines)
+!
+!
+! Continuum terms for 800-1200 cm^-1
+!
+!    Assume self continuum dominates total H2O continuum for this band
+!    per Clough et al, JGR, v. 97, no. D14 (Oct 20, 1992), p. 15776
+!    Then the effective H2O self-continuum path is 
+!         U_c = integral[ h(e,T) dW ]                        (*eq. 1*)
+!    where 
+!           W = water-vapor mass and 
+!           e = partial pressure of H2O along path
+!           T = temperature along path
+!      h(e,T) = dependence of foreign continuum on e,T
+!             = e / sslp * f(T)
+!
+!    Replacing
+!           e =~ q * P / epsilo
+!           q = mixing ratio of H2O
+!     epsilo = 0.622
+!
+!    and using the definition
+!           U = integral [ (P / sslp) dW ]
+!             = (P / sslp) W                                 (homogeneous path)
+!
+!    the effective path length for the self continuum is
+!         U_c = (q / epsilo) f(T) U                         (*eq. 2*)
+!
+!    Once values of T, U, and q have been calculated for the inhomogeneous
+!        path, this sets U_c for the corresponding
+!        homogeneous atmosphere.  However, this need not equal the
+!        value of U_c' defined by eq. 1 for the actual inhomogeneous atmosphere
+!        under consideration.
+!
+!    Solution: hold T and q constant, solve for U' that gives U_c' by
+!        inverting eq. (2):
+!
+!        U' = (U_c * epsilo) / (q * f(T))
+!
+         fch2o = fh2oself(t_p)
+         uch2o = (pch2o * epsilo) / (q_path * fch2o)
+
+!
+! Band-dependent indices for non-window
+!
+         ib = 1
+
+         uvar = ub(ib) * fdif
+         log_u  = min(log10(max(uvar, min_u_h2o)), max_lu_h2o)
+         dvar = (log_u - min_lu_h2o) / dlu_h2o
+         iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1)
+         iu1 = iu + 1
+         wu = dvar - floor(dvar)
+         wu1 = 1.0 - wu
+         
+         log_p  = min(log10(max(pnewb(ib), min_p_h2o)), max_lp_h2o)
+         dvar = (log_p - min_lp_h2o) / dlp_h2o
+         ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1)
+         ip1 = ip + 1
+         wp = dvar - floor(dvar)
+         wp1 = 1.0 - wp
+
+         w00_00 = wp  * w_0_00 
+         w00_01 = wp  * w_0_01 
+         w00_10 = wp  * w_0_10 
+         w00_11 = wp  * w_0_11 
+         w01_00 = wp  * w_1_00 
+         w01_01 = wp  * w_1_01 
+         w01_10 = wp  * w_1_10 
+         w01_11 = wp  * w_1_11 
+         w10_00 = wp1 * w_0_00 
+         w10_01 = wp1 * w_0_01 
+         w10_10 = wp1 * w_0_10 
+         w10_11 = wp1 * w_0_11 
+         w11_00 = wp1 * w_1_00 
+         w11_01 = wp1 * w_1_01 
+         w11_10 = wp1 * w_1_10 
+         w11_11 = wp1 * w_1_11 
+
+!
+! Asymptotic value of emissivity as U->infinity
+!
+         fe = fet(1,ib) + &
+              fet(2,ib) * te1 + &
+              fet(3,ib) * te2 + &
+              fet(4,ib) * te3 + &
+              fet(5,ib) * te4 + &
+              fet(6,ib) * te5
+
+         e_star = &
+              eh2onw(ip , itp , iu , ite , irh ) * w11_11 * wu1 + &
+              eh2onw(ip , itp , iu , ite , irh1) * w11_10 * wu1 + &
+              eh2onw(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + &
+              eh2onw(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + &
+              eh2onw(ip , itp , iu1, ite , irh ) * w11_11 * wu  + &
+              eh2onw(ip , itp , iu1, ite , irh1) * w11_10 * wu  + &
+              eh2onw(ip , itp , iu1, ite1, irh ) * w11_01 * wu  + &
+              eh2onw(ip , itp , iu1, ite1, irh1) * w11_00 * wu  + &
+              eh2onw(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + &
+              eh2onw(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + &
+              eh2onw(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + &
+              eh2onw(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + &
+              eh2onw(ip , itp1, iu1, ite , irh ) * w10_11 * wu  + &
+              eh2onw(ip , itp1, iu1, ite , irh1) * w10_10 * wu  + &
+              eh2onw(ip , itp1, iu1, ite1, irh ) * w10_01 * wu  + &
+              eh2onw(ip , itp1, iu1, ite1, irh1) * w10_00 * wu  + &
+              eh2onw(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + &
+              eh2onw(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + &
+              eh2onw(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + &
+              eh2onw(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + &
+              eh2onw(ip1, itp , iu1, ite , irh ) * w01_11 * wu  + &
+              eh2onw(ip1, itp , iu1, ite , irh1) * w01_10 * wu  + &
+              eh2onw(ip1, itp , iu1, ite1, irh ) * w01_01 * wu  + &
+              eh2onw(ip1, itp , iu1, ite1, irh1) * w01_00 * wu  + &
+              eh2onw(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + &
+              eh2onw(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + &
+              eh2onw(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + &
+              eh2onw(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + &
+              eh2onw(ip1, itp1, iu1, ite , irh ) * w00_11 * wu  + &
+              eh2onw(ip1, itp1, iu1, ite , irh1) * w00_10 * wu  + &
+              eh2onw(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu  + &
+              eh2onw(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu 
+         emis(i,ib) = min(max(fe * (1.0 - (1.0 - e_star) * &
+                              aer_trn_ttl(i,k1,1,ib)), &
+                          0.0_r8), 1.0_r8)
+!
+! Invoke linear limit for scaling wrt u below min_u_h2o
+!
+         if (uvar < min_u_h2o) then
+            uscl = uvar / min_u_h2o
+            emis(i,ib) = emis(i,ib) * uscl
+         endif
+
+                      
+
+!
+! Band-dependent indices for window
+!
+         ib = 2
+
+         uvar = ub(ib) * fdif
+         log_u  = min(log10(max(uvar, min_u_h2o)), max_lu_h2o)
+         dvar = (log_u - min_lu_h2o) / dlu_h2o
+         iu = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1)
+         iu1 = iu + 1
+         wu = dvar - floor(dvar)
+         wu1 = 1.0 - wu
+         
+         log_p  = min(log10(max(pnewb(ib), min_p_h2o)), max_lp_h2o)
+         dvar = (log_p - min_lp_h2o) / dlp_h2o
+         ip = min(max(int(aint(dvar,r8)) + 1, 1), n_p - 1)
+         ip1 = ip + 1
+         wp = dvar - floor(dvar)
+         wp1 = 1.0 - wp
+
+         w00_00 = wp  * w_0_00 
+         w00_01 = wp  * w_0_01 
+         w00_10 = wp  * w_0_10 
+         w00_11 = wp  * w_0_11 
+         w01_00 = wp  * w_1_00 
+         w01_01 = wp  * w_1_01 
+         w01_10 = wp  * w_1_10 
+         w01_11 = wp  * w_1_11 
+         w10_00 = wp1 * w_0_00 
+         w10_01 = wp1 * w_0_01 
+         w10_10 = wp1 * w_0_10 
+         w10_11 = wp1 * w_0_11 
+         w11_00 = wp1 * w_1_00 
+         w11_01 = wp1 * w_1_01 
+         w11_10 = wp1 * w_1_10 
+         w11_11 = wp1 * w_1_11 
+
+         log_uc  = min(log10(max(uch2o * fdif, min_u_h2o)), max_lu_h2o)
+         dvar = (log_uc - min_lu_h2o) / dlu_h2o
+         iuc = min(max(int(aint(dvar,r8)) + 1, 1), n_u - 1)
+         iuc1 = iuc + 1
+         wuc = dvar - floor(dvar)
+         wuc1 = 1.0 - wuc
+!
+! Asymptotic value of emissivity as U->infinity
+!
+         fe = fet(1,ib) + &
+              fet(2,ib) * te1 + &
+              fet(3,ib) * te2 + &
+              fet(4,ib) * te3 + &
+              fet(5,ib) * te4 + &
+              fet(6,ib) * te5
+
+         l_star = &
+              ln_eh2ow(ip , itp , iu , ite , irh ) * w11_11 * wu1 + &
+              ln_eh2ow(ip , itp , iu , ite , irh1) * w11_10 * wu1 + &
+              ln_eh2ow(ip , itp , iu , ite1, irh ) * w11_01 * wu1 + &
+              ln_eh2ow(ip , itp , iu , ite1, irh1) * w11_00 * wu1 + &
+              ln_eh2ow(ip , itp , iu1, ite , irh ) * w11_11 * wu  + &
+              ln_eh2ow(ip , itp , iu1, ite , irh1) * w11_10 * wu  + &
+              ln_eh2ow(ip , itp , iu1, ite1, irh ) * w11_01 * wu  + &
+              ln_eh2ow(ip , itp , iu1, ite1, irh1) * w11_00 * wu  + &
+              ln_eh2ow(ip , itp1, iu , ite , irh ) * w10_11 * wu1 + &
+              ln_eh2ow(ip , itp1, iu , ite , irh1) * w10_10 * wu1 + &
+              ln_eh2ow(ip , itp1, iu , ite1, irh ) * w10_01 * wu1 + &
+              ln_eh2ow(ip , itp1, iu , ite1, irh1) * w10_00 * wu1 + &
+              ln_eh2ow(ip , itp1, iu1, ite , irh ) * w10_11 * wu  + &
+              ln_eh2ow(ip , itp1, iu1, ite , irh1) * w10_10 * wu  + &
+              ln_eh2ow(ip , itp1, iu1, ite1, irh ) * w10_01 * wu  + &
+              ln_eh2ow(ip , itp1, iu1, ite1, irh1) * w10_00 * wu  + &
+              ln_eh2ow(ip1, itp , iu , ite , irh ) * w01_11 * wu1 + &
+              ln_eh2ow(ip1, itp , iu , ite , irh1) * w01_10 * wu1 + &
+              ln_eh2ow(ip1, itp , iu , ite1, irh ) * w01_01 * wu1 + &
+              ln_eh2ow(ip1, itp , iu , ite1, irh1) * w01_00 * wu1 + &
+              ln_eh2ow(ip1, itp , iu1, ite , irh ) * w01_11 * wu  + &
+              ln_eh2ow(ip1, itp , iu1, ite , irh1) * w01_10 * wu  + &
+              ln_eh2ow(ip1, itp , iu1, ite1, irh ) * w01_01 * wu  + &
+              ln_eh2ow(ip1, itp , iu1, ite1, irh1) * w01_00 * wu  + &
+              ln_eh2ow(ip1, itp1, iu , ite , irh ) * w00_11 * wu1 + &
+              ln_eh2ow(ip1, itp1, iu , ite , irh1) * w00_10 * wu1 + &
+              ln_eh2ow(ip1, itp1, iu , ite1, irh ) * w00_01 * wu1 + &
+              ln_eh2ow(ip1, itp1, iu , ite1, irh1) * w00_00 * wu1 + &
+              ln_eh2ow(ip1, itp1, iu1, ite , irh ) * w00_11 * wu  + &
+              ln_eh2ow(ip1, itp1, iu1, ite , irh1) * w00_10 * wu  + &
+              ln_eh2ow(ip1, itp1, iu1, ite1, irh ) * w00_01 * wu  + &
+              ln_eh2ow(ip1, itp1, iu1, ite1, irh1) * w00_00 * wu 
+
+         c_star = &
+              cn_eh2ow(ip , itp , iuc , ite , irh ) * w11_11 * wuc1 + &
+              cn_eh2ow(ip , itp , iuc , ite , irh1) * w11_10 * wuc1 + &
+              cn_eh2ow(ip , itp , iuc , ite1, irh ) * w11_01 * wuc1 + &
+              cn_eh2ow(ip , itp , iuc , ite1, irh1) * w11_00 * wuc1 + &
+              cn_eh2ow(ip , itp , iuc1, ite , irh ) * w11_11 * wuc  + &
+              cn_eh2ow(ip , itp , iuc1, ite , irh1) * w11_10 * wuc  + &
+              cn_eh2ow(ip , itp , iuc1, ite1, irh ) * w11_01 * wuc  + &
+              cn_eh2ow(ip , itp , iuc1, ite1, irh1) * w11_00 * wuc  + &
+              cn_eh2ow(ip , itp1, iuc , ite , irh ) * w10_11 * wuc1 + &
+              cn_eh2ow(ip , itp1, iuc , ite , irh1) * w10_10 * wuc1 + &
+              cn_eh2ow(ip , itp1, iuc , ite1, irh ) * w10_01 * wuc1 + &
+              cn_eh2ow(ip , itp1, iuc , ite1, irh1) * w10_00 * wuc1 + &
+              cn_eh2ow(ip , itp1, iuc1, ite , irh ) * w10_11 * wuc  + &
+              cn_eh2ow(ip , itp1, iuc1, ite , irh1) * w10_10 * wuc  + &
+              cn_eh2ow(ip , itp1, iuc1, ite1, irh ) * w10_01 * wuc  + &
+              cn_eh2ow(ip , itp1, iuc1, ite1, irh1) * w10_00 * wuc  + &
+              cn_eh2ow(ip1, itp , iuc , ite , irh ) * w01_11 * wuc1 + &
+              cn_eh2ow(ip1, itp , iuc , ite , irh1) * w01_10 * wuc1 + &
+              cn_eh2ow(ip1, itp , iuc , ite1, irh ) * w01_01 * wuc1 + &
+              cn_eh2ow(ip1, itp , iuc , ite1, irh1) * w01_00 * wuc1 + &
+              cn_eh2ow(ip1, itp , iuc1, ite , irh ) * w01_11 * wuc  + &
+              cn_eh2ow(ip1, itp , iuc1, ite , irh1) * w01_10 * wuc  + &
+              cn_eh2ow(ip1, itp , iuc1, ite1, irh ) * w01_01 * wuc  + &
+              cn_eh2ow(ip1, itp , iuc1, ite1, irh1) * w01_00 * wuc  + &
+              cn_eh2ow(ip1, itp1, iuc , ite , irh ) * w00_11 * wuc1 + &
+              cn_eh2ow(ip1, itp1, iuc , ite , irh1) * w00_10 * wuc1 + &
+              cn_eh2ow(ip1, itp1, iuc , ite1, irh ) * w00_01 * wuc1 + &
+              cn_eh2ow(ip1, itp1, iuc , ite1, irh1) * w00_00 * wuc1 + &
+              cn_eh2ow(ip1, itp1, iuc1, ite , irh ) * w00_11 * wuc  + &
+              cn_eh2ow(ip1, itp1, iuc1, ite , irh1) * w00_10 * wuc  + &
+              cn_eh2ow(ip1, itp1, iuc1, ite1, irh ) * w00_01 * wuc  + &
+              cn_eh2ow(ip1, itp1, iuc1, ite1, irh1) * w00_00 * wuc 
+         emis(i,ib) = min(max(fe * (1.0 - l_star * c_star * &
+                              aer_trn_ttl(i,k1,1,ib)), &
+                          0.0_r8), 1.0_r8) 
+!
+! Invoke linear limit for scaling wrt u below min_u_h2o
+!
+         if (uvar < min_u_h2o) then
+            uscl = uvar / min_u_h2o
+            emis(i,ib) = emis(i,ib) * uscl
+         endif
+
+                      
+!
+! Compute total emissivity for H2O
+!
+         h2oems(i,k1) = emis(i,1)+emis(i,2)
+
+      end do
+!
+!
+!
+
+      do i=1,ncol
+         term7(i,1) = coefj(1,1) + coefj(2,1)*dty(i)*(1.+c16*dty(i))
+         term8(i,1) = coefk(1,1) + coefk(2,1)*dty(i)*(1.+c17*dty(i))
+         term7(i,2) = coefj(1,2) + coefj(2,2)*dty(i)*(1.+c26*dty(i))
+         term8(i,2) = coefk(1,2) + coefk(2,2)*dty(i)*(1.+c27*dty(i))
+      end do
+      do i=1,ncol
+!
+! 500 -  800 cm-1   rotation band overlap with co2
+!
+         k21(i) = term7(i,1) + term8(i,1)/ &
+                 (1. + (c30 + c31*(dty(i)-10.)*(dty(i)-10.))*sqrt(u(i)))
+         k22(i) = term7(i,2) + term8(i,2)/ &
+                 (1. + (c28 + c29*(dty(i)-10.))*sqrt(u(i)))
+         fwk    = fwcoef + fwc1/(1.+fwc2*u(i))
+         tr1(i) = exp(-(k21(i)*(sqrt(u(i)) + fc1*fwk*u(i))))
+         tr2(i) = exp(-(k22(i)*(sqrt(u(i)) + fc1*fwk*u(i))))
+         tr1(i)=tr1(i)*aer_trn_ttl(i,k1,1,idx_LW_0650_0800) 
+!                                            ! H2O line+aer trn 650--800 cm-1
+         tr2(i)=tr2(i)*aer_trn_ttl(i,k1,1,idx_LW_0500_0650) 
+!                                            ! H2O line+aer trn 500--650 cm-1
+         tr3(i) = exp(-((coefh(1,1) + coefh(2,1)*dtx(i))*uc1(i)))
+         tr4(i) = exp(-((coefh(1,2) + coefh(2,2)*dtx(i))*uc1(i)))
+         tr7(i) = tr1(i)*tr3(i)
+         tr8(i) = tr2(i)*tr4(i)
+         troco2(i,k1) = 0.65*tr7(i) + 0.35*tr8(i)
+         th2o(i) = tr8(i)
+      end do
+!
+! CO2 emissivity for 15 micron band system
+!
+      do i=1,ncol
+         t1i    = exp(-480./co2t(i,k1))
+         sqti   = sqrt(co2t(i,k1))
+         rsqti  = 1./sqti
+         et     = t1i
+         et2    = et*et
+         et4    = et2*et2
+         omet   = 1. - 1.5*et2
+         f1co2  = 899.70*omet*(1. + 1.94774*et + 4.73486*et2)*rsqti
+         sqwp   = sqrt(plco2(i,k1))
+         f1sqwp = f1co2*sqwp
+         t1co2  = 1./(1. + 245.18*omet*sqwp*rsqti)
+         oneme  = 1. - et2
+         alphat = oneme**3*rsqti
+         wco2   = 2.5221*co2vmr*pnm(i,k1)*rga
+         u7     = 4.9411e4*alphat*et2*wco2
+         u8     = 3.9744e4*alphat*et4*wco2
+         u9     = 1.0447e5*alphat*et4*et2*wco2
+         u13    = 2.8388e3*alphat*et4*wco2
+!
+         tpath  = co2t(i,k1)
+         tlocal = tplnke(i)
+         tcrfac = sqrt((tlocal*r250)*(tpath*r300))
+         pi     = pnm(i,k1)*rsslp + 2.*dpfco2*tcrfac
+         posqt  = pi/(2.*sqti)
+         rbeta7 =  1./( 5.3288*posqt)
+         rbeta8 = 1./ (10.6576*posqt)
+         rbeta9 = rbeta7
+         rbeta13= rbeta9
+         f2co2  = (u7/sqrt(4. + u7*(1. + rbeta7))) + &
+                  (u8/sqrt(4. + u8*(1. + rbeta8))) + &
+                  (u9/sqrt(4. + u9*(1. + rbeta9)))
+         f3co2  = u13/sqrt(4. + u13*(1. + rbeta13))
+         tmp1   = log(1. + f1sqwp)
+         tmp2   = log(1. +  f2co2)
+         tmp3   = log(1. +  f3co2)
+         absbnd = (tmp1 + 2.*t1co2*tmp2 + 2.*tmp3)*sqti
+         tco2(i)=1.0/(1.0+10.0*(u7/sqrt(4. + u7*(1. + rbeta7))))
+         co2ems(i,k1)  = troco2(i,k1)*absbnd*co2plk(i)
+         ex     = exp(960./tint(i,k1))
+         exm1sq = (ex - 1.)**2
+         co2em(i,k1) = 1.2e11*ex/(tint(i,k1)*tint4(i,k1)*exm1sq)
+      end do
+!
+! O3 emissivity
+!
+      do i=1,ncol
+         h2otr(i,k1) = exp(-12.*s2c(i,k1))
+          h2otr(i,k1)=h2otr(i,k1)*aer_trn_ttl(i,k1,1,idx_LW_1000_1200)
+         te          = (co2t(i,k1)/293.)**.7
+         u1          = 18.29*plos(i,k1)/te
+         u2          = .5649*plos(i,k1)/te
+         phat        = plos(i,k1)/plol(i,k1)
+         tlocal      = tplnke(i)
+         tcrfac      = sqrt(tlocal*r250)*te
+         beta        = (1./.3205)*((1./phat) + (dpfo3*tcrfac))
+         realnu      = (1./beta)*te
+         o3bndi      = 74.*te*(tplnke(i)/375.)*log(1. + fo3(u1,realnu) + fo3(u2,realnu))
+         o3ems(i,k1) = dbvtt(i)*h2otr(i,k1)*o3bndi
+         to3(i)=1.0/(1. + 0.1*fo3(u1,realnu) + 0.1*fo3(u2,realnu))
+      end do
+!
+!   Calculate trace gas emissivities
+!
+      call trcems(lchnk   ,ncol    ,pcols, pverp,               &
+                  k1      ,co2t    ,pnm     ,ucfc11  ,ucfc12  , &
+                  un2o0   ,un2o1   ,bn2o0   ,bn2o1   ,uch4    , &
+                  bch4    ,uco211  ,uco212  ,uco213  ,uco221  , &
+                  uco222  ,uco223  ,uptype  ,w       ,s2c     , &
+                  u       ,emplnk  ,th2o    ,tco2    ,to3     , &
+                  emstrc  , &
+                  aer_trn_ttl)
+!
+! Total emissivity:
+!
+      do i=1,ncol
+         emstot(i,k1) = h2oems(i,k1) + co2ems(i,k1) + o3ems(i,k1)  &
+                        + emstrc(i,k1)
+      end do
+   end do ! End of interface loop
+
+   return
+end subroutine radems
+
+subroutine radtpl(lchnk   ,ncol    ,pcols, pver, pverp,                 &
+                  tnm     ,lwupcgs ,qnm     ,pnm     ,plco2   ,plh2o   , &
+                  tplnka  ,s2c     ,tcg     ,w       ,tplnke  , &
+                  tint    ,tint4   ,tlayr   ,tlayr4  ,pmln    , &
+                  piln    ,plh2ob  ,wb      )
+!--------------------------------------------------------------------
+!
+! Purpose:
+! Compute temperatures and path lengths for longwave radiation
+!
+! Method:
+! <Describe the algorithm(s) used in the routine.>
+! <Also include any applicable external references.>
+!
+! Author: CCM1
+!
+!--------------------------------------------------------------------
+
+!------------------------------Arguments-----------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                 ! chunk identifier
+   integer, intent(in) :: ncol                  ! number of atmospheric columns
+   integer, intent(in) :: pcols, pver, pverp
+
+   real(r8), intent(in) :: tnm(pcols,pver)      ! Model level temperatures
+   real(r8), intent(in) :: lwupcgs(pcols)       ! Surface longwave up flux
+   real(r8), intent(in) :: qnm(pcols,pver)      ! Model level specific humidity
+   real(r8), intent(in) :: pnm(pcols,pverp)     ! Pressure at model interfaces (dynes/cm2)
+   real(r8), intent(in) :: pmln(pcols,pver)     ! Ln(pmidm1)
+   real(r8), intent(in) :: piln(pcols,pverp)    ! Ln(pintm1)
+!
+! Output arguments
+!
+   real(r8), intent(out) :: plco2(pcols,pverp)   ! Pressure weighted co2 path
+   real(r8), intent(out) :: plh2o(pcols,pverp)   ! Pressure weighted h2o path
+   real(r8), intent(out) :: tplnka(pcols,pverp)  ! Level temperature from interface temperatures
+   real(r8), intent(out) :: s2c(pcols,pverp)     ! H2o continuum path length
+   real(r8), intent(out) :: tcg(pcols,pverp)     ! H2o-mass-wgted temp. (Curtis-Godson approx.)
+   real(r8), intent(out) :: w(pcols,pverp)       ! H2o path length
+   real(r8), intent(out) :: tplnke(pcols)        ! Equal to tplnka
+   real(r8), intent(out) :: tint(pcols,pverp)    ! Layer interface temperature
+   real(r8), intent(out) :: tint4(pcols,pverp)   ! Tint to the 4th power
+   real(r8), intent(out) :: tlayr(pcols,pverp)   ! K-1 level temperature
+   real(r8), intent(out) :: tlayr4(pcols,pverp)  ! Tlayr to the 4th power
+   real(r8), intent(out) :: plh2ob(nbands,pcols,pverp)! Pressure weighted h2o path with 
+                                                      !    Hulst-Curtis-Godson temp. factor 
+                                                      !    for H2O bands 
+   real(r8), intent(out) :: wb(nbands,pcols,pverp)    ! H2o path length with 
+                                                      !    Hulst-Curtis-Godson temp. factor 
+                                                      !    for H2O bands 
+
+!
+!---------------------------Local variables--------------------------
+!
+   integer i                 ! Longitude index
+   integer k                 ! Level index
+   integer kp1               ! Level index + 1
+
+   real(r8) repsil               ! Inver ratio mol weight h2o to dry air
+   real(r8) dy                   ! Thickness of layer for tmp interp
+   real(r8) dpnm                 ! Pressure thickness of layer
+   real(r8) dpnmsq               ! Prs squared difference across layer
+   real(r8) dw                   ! Increment in H2O path length
+   real(r8) dplh2o               ! Increment in plh2o
+   real(r8) cpwpl                ! Const in co2 mix ratio to path length conversn
+
+!--------------------------------------------------------------------
+!
+   repsil = 1./epsilo
+!
+! Compute co2 and h2o paths
+!
+   cpwpl = amco2/amd * 0.5/(gravit*p0)
+   do i=1,ncol
+      plh2o(i,ntoplw)  = rgsslp*qnm(i,ntoplw)*pnm(i,ntoplw)*pnm(i,ntoplw)
+      plco2(i,ntoplw)  = co2vmr*cpwpl*pnm(i,ntoplw)*pnm(i,ntoplw)
+   end do
+   do k=ntoplw,pver
+      do i=1,ncol
+         plh2o(i,k+1)  = plh2o(i,k) + rgsslp* &
+                         (pnm(i,k+1)**2 - pnm(i,k)**2)*qnm(i,k)
+         plco2(i,k+1)  = co2vmr*cpwpl*pnm(i,k+1)**2
+      end do
+   end do
+!
+! Set the top and bottom intermediate level temperatures,
+! top level planck temperature and top layer temp**4.
+!
+! Tint is lower interface temperature
+! (not available for bottom layer, so use ground temperature)
+!
+   do i=1,ncol
+      tint4(i,pverp)   = lwupcgs(i)/stebol
+      tint(i,pverp)    = sqrt(sqrt(tint4(i,pverp)))
+      tplnka(i,ntoplw) = tnm(i,ntoplw)
+      tint(i,ntoplw)   = tplnka(i,ntoplw)
+      tlayr4(i,ntoplw) = tplnka(i,ntoplw)**4
+      tint4(i,ntoplw)  = tlayr4(i,ntoplw)
+   end do
+!
+! Intermediate level temperatures are computed using temperature
+! at the full level below less dy*delta t,between the full level
+!
+   do k=ntoplw+1,pver
+      do i=1,ncol
+         dy = (piln(i,k) - pmln(i,k))/(pmln(i,k-1) - pmln(i,k))
+         tint(i,k)  = tnm(i,k) - dy*(tnm(i,k)-tnm(i,k-1))
+         tint4(i,k) = tint(i,k)**4
+      end do
+   end do
+!
+! Now set the layer temp=full level temperatures and establish a
+! planck temperature for absorption (tplnka) which is the average
+! the intermediate level temperatures.  Note that tplnka is not
+! equal to the full level temperatures.
+!
+   do k=ntoplw+1,pverp
+      do i=1,ncol
+         tlayr(i,k)  = tnm(i,k-1)
+         tlayr4(i,k) = tlayr(i,k)**4
+         tplnka(i,k) = .5*(tint(i,k) + tint(i,k-1))
+      end do
+   end do
+!
+! Calculate tplank for emissivity calculation.
+! Assume isothermal tplnke i.e. all levels=ttop.
+!
+   do i=1,ncol
+      tplnke(i)       = tplnka(i,ntoplw)
+      tlayr(i,ntoplw) = tint(i,ntoplw)
+   end do
+!
+! Now compute h2o path fields:
+!
+   do i=1,ncol
+!
+! Changed effective path temperature to std. Curtis-Godson form
+!
+      tcg(i,ntoplw) = rga*qnm(i,ntoplw)*pnm(i,ntoplw)*tnm(i,ntoplw)
+      w(i,ntoplw)   = sslp * (plh2o(i,ntoplw)*2.) / pnm(i,ntoplw)
+!
+! Hulst-Curtis-Godson scaling for H2O path
+!
+      wb(1,i,ntoplw) = w(i,ntoplw) * phi(tnm(i,ntoplw),1)
+      wb(2,i,ntoplw) = w(i,ntoplw) * phi(tnm(i,ntoplw),2)
+!
+! Hulst-Curtis-Godson scaling for effective pressure along H2O path
+!
+      plh2ob(1,i,ntoplw) = plh2o(i,ntoplw) * psi(tnm(i,ntoplw),1)
+      plh2ob(2,i,ntoplw) = plh2o(i,ntoplw) * psi(tnm(i,ntoplw),2)
+
+      s2c(i,ntoplw) = plh2o(i,ntoplw)*fh2oself(tnm(i,ntoplw))*qnm(i,ntoplw)*repsil
+   end do
+
+   do k=ntoplw,pver
+      do i=1,ncol
+         dpnm       = pnm(i,k+1) - pnm(i,k)
+         dpnmsq     = pnm(i,k+1)**2 - pnm(i,k)**2
+         dw         = rga*qnm(i,k)*dpnm
+         kp1        = k+1
+         w(i,kp1)   = w(i,k) + dw
+!
+! Hulst-Curtis-Godson scaling for H2O path
+!
+         wb(1,i,kp1) = wb(1,i,k) + dw * phi(tnm(i,k),1)
+         wb(2,i,kp1) = wb(2,i,k) + dw * phi(tnm(i,k),2)
+!
+! Hulst-Curtis-Godson scaling for effective pressure along H2O path
+!
+         dplh2o = plh2o(i,kp1) - plh2o(i,k)
+
+         plh2ob(1,i,kp1) = plh2ob(1,i,k) + dplh2o * psi(tnm(i,k),1)
+         plh2ob(2,i,kp1) = plh2ob(2,i,k) + dplh2o * psi(tnm(i,k),2)
+!
+! Changed effective path temperature to std. Curtis-Godson form
+!
+         tcg(i,kp1) = tcg(i,k) + dw*tnm(i,k)
+         s2c(i,kp1) = s2c(i,k) + rgsslp*dpnmsq*qnm(i,k)* &
+                      fh2oself(tnm(i,k))*qnm(i,k)*repsil
+      end do
+   end do
+!
+   return
+end subroutine radtpl
+
+subroutine radaeini( pstdx, mwdryx, mwco2x )
+
+USE module_wrf_error
+USE module_dm
+
+!
+! Initialize radae module data
+!
+!
+! Input variables
+!
+   real(r8), intent(in) :: pstdx   ! Standard pressure (dynes/cm^2)
+   real(r8), intent(in) :: mwdryx  ! Molecular weight of dry air 
+   real(r8), intent(in) :: mwco2x  ! Molecular weight of carbon dioxide
+!
+!      Variables for loading absorptivity/emissivity
+!
+   integer ncid_ae                ! NetCDF file id for abs/ems file
+
+   integer pdimid                 ! pressure dimension id
+   integer psize                  ! pressure dimension size
+
+   integer tpdimid                ! path temperature dimension id
+   integer tpsize                 ! path temperature size
+
+   integer tedimid                ! emission temperature dimension id
+   integer tesize                 ! emission temperature size
+
+   integer udimid                 ! u (H2O path) dimension id
+   integer usize                  ! u (H2O path) dimension size
+
+   integer rhdimid                ! relative humidity dimension id
+   integer rhsize                 ! relative humidity dimension size
+
+   integer    ah2onwid            ! var. id for non-wndw abs.
+   integer    eh2onwid            ! var. id for non-wndw ems.
+   integer    ah2owid             ! var. id for wndw abs. (adjacent layers)
+   integer cn_ah2owid             ! var. id for continuum trans. for wndw abs.
+   integer cn_eh2owid             ! var. id for continuum trans. for wndw ems.
+   integer ln_ah2owid             ! var. id for line trans. for wndw abs.
+   integer ln_eh2owid             ! var. id for line trans. for wndw ems.
+   
+!  character*(NF_MAX_NAME) tmpname! dummy variable for var/dim names
+   character(len=256) locfn       ! local filename
+   integer tmptype                ! dummy variable for variable type
+   integer ndims                  ! number of dimensions
+!  integer dims(NF_MAX_VAR_DIMS)  ! vector of dimension ids
+   integer natt                   ! number of attributes
+!
+! Variables for setting up H2O table
+!
+   integer t                     ! path temperature
+   integer tmin                  ! mininum path temperature
+   integer tmax                  ! maximum path temperature
+   integer itype                 ! type of sat. pressure (=0 -> H2O only)
+   integer i
+   real(r8) tdbl
+
+      LOGICAL                 :: opened
+      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+
+      CHARACTER*80 errmess
+      INTEGER cam_abs_unit
+
+!
+! Constants to set
+!
+   p0     = pstdx
+   amd    = mwdryx
+   amco2  = mwco2x
+!
+! Coefficients for h2o emissivity and absorptivity for overlap of H2O 
+!    and trace gases.
+!
+   c16  = coefj(3,1)/coefj(2,1)
+   c17  = coefk(3,1)/coefk(2,1)
+   c26  = coefj(3,2)/coefj(2,2)
+   c27  = coefk(3,2)/coefk(2,2)
+   c28  = .5
+   c29  = .002053
+   c30  = .1
+   c31  = 3.0e-5
+!
+! Initialize further longwave constants referring to far wing
+! correction for overlap of H2O and trace gases; R&D refers to:
+!
+!            Ramanathan, V. and  P.Downey, 1986: A Nonisothermal
+!            Emissivity and Absorptivity Formulation for Water Vapor
+!            Journal of Geophysical Research, vol. 91., D8, pp 8649-8666
+!
+   fwcoef = .1           ! See eq(33) R&D
+   fwc1   = .30          ! See eq(33) R&D
+   fwc2   = 4.5          ! See eq(33) and eq(34) in R&D
+   fc1    = 2.6          ! See eq(34) R&D
+
+      IF ( wrf_dm_on_monitor() ) THEN
+        DO i = 10,99
+          INQUIRE ( i , OPENED = opened )
+          IF ( .NOT. opened ) THEN
+            cam_abs_unit = i
+            GOTO 2010
+          ENDIF
+        ENDDO
+        cam_abs_unit = -1
+ 2010   CONTINUE
+      ENDIF
+      CALL wrf_dm_bcast_bytes ( cam_abs_unit , IWORDSIZE )
+      IF ( cam_abs_unit < 0 ) THEN
+        CALL wrf_error_fatal ( 'module_ra_cam: radaeinit: Can not find unused fortran unit to read in lookup table.' )
+      ENDIF
+
+        IF ( wrf_dm_on_monitor() ) THEN
+          OPEN(cam_abs_unit,FILE='CAM_ABS_DATA',                  &
+               FORM='UNFORMATTED',STATUS='OLD',ERR=9010)
+          call wrf_debug(50,'reading CAM_ABS_DATA')
+        ENDIF
+
+#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * r8 )
+
+         IF ( wrf_dm_on_monitor() ) then
+         READ (cam_abs_unit,ERR=9010) ah2onw
+         READ (cam_abs_unit,ERR=9010) eh2onw 
+         READ (cam_abs_unit,ERR=9010) ah2ow 
+         READ (cam_abs_unit,ERR=9010) cn_ah2ow 
+         READ (cam_abs_unit,ERR=9010) cn_eh2ow 
+         READ (cam_abs_unit,ERR=9010) ln_ah2ow 
+         READ (cam_abs_unit,ERR=9010) ln_eh2ow 
+
+         endif
+
+         DM_BCAST_MACRO(ah2onw)
+         DM_BCAST_MACRO(eh2onw)
+         DM_BCAST_MACRO(ah2ow)
+         DM_BCAST_MACRO(cn_ah2ow)
+         DM_BCAST_MACRO(cn_eh2ow)
+         DM_BCAST_MACRO(ln_ah2ow)
+         DM_BCAST_MACRO(ln_eh2ow)
+
+         IF ( wrf_dm_on_monitor() ) CLOSE (cam_abs_unit)
+      
+! Set up table of H2O saturation vapor pressures for use in calculation
+!     effective path RH.  Need separate table from table in wv_saturation 
+!     because:
+!     (1. Path temperatures can fall below minimum of that table; and
+!     (2. Abs/Emissivity tables are derived with RH for water only.
+!
+      tmin = nint(min_tp_h2o)
+      tmax = nint(max_tp_h2o)+1
+      itype = 0
+      do t = tmin, tmax
+!        call gffgch(dble(t),estblh2o(t-tmin),itype)
+         tdbl = t
+         call gffgch(tdbl,estblh2o(t-tmin),itype)
+      end do
+
+     RETURN
+9010 CONTINUE
+     WRITE( errmess , '(A35,I4)' ) 'module_ra_cam: error reading unit ',cam_abs_unit
+     CALL wrf_error_fatal(errmess)
+end subroutine radaeini
+
+subroutine radclwmx(lchnk   ,ncol    ,pcols, pver, pverp,         &
+                    lwupcgs ,tnm     ,qnm     ,o3vmr   , &
+                    pmid    ,pint    ,pmln    ,piln    ,          &
+                             n2o     ,ch4     ,cfc11   ,cfc12   , &
+                    cld     ,emis    ,pmxrgn  ,nmxrgn  ,qrl     , &
+                    doabsems, abstot, absnxt, emstot,             &
+                    flns    ,flnt    ,flnsc   ,flntc   ,flwds   , &
+                    flut    ,flutc   , &
+                    flup    ,flupc   ,fldn    ,fldnc   ,          &
+                    aer_mass)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Compute longwave radiation heating rates and boundary fluxes
+! 
+! Method: 
+! Uses broad band absorptivity/emissivity method to compute clear sky;
+! assumes randomly overlapped clouds with variable cloud emissivity to
+! include effects of clouds.
+!
+! Computes clear sky absorptivity/emissivity at lower frequency (in
+! general) than the model radiation frequency; uses previously computed
+! and stored values for efficiency
+!
+! Note: This subroutine contains vertical indexing which proceeds
+!       from bottom to top rather than the top to bottom indexing
+!       used in the rest of the model.
+! 
+! Author: B. Collins
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use radae, only: nbands, radems, radabs, radtpl, abstot_3d, absnxt_3d, emstot_3d
+!  use volcrad
+
+   implicit none
+
+   integer pverp2,pverp3,pverp4
+!  parameter (pverp2=pver+2,pverp3=pver+3,pverp4=pver+4)
+
+   real(r8) cldmin
+   parameter (cldmin = 1.0d-80)
+!------------------------------Commons----------------------------------
+!-----------------------------------------------------------------------
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                 ! chunk identifier
+   integer, intent(in) :: pcols, pver, pverp
+   integer, intent(in) :: ncol                  ! number of atmospheric columns
+!    maximally overlapped region.
+!    0->pmxrgn(i,1) is range of pmid for
+!    1st region, pmxrgn(i,1)->pmxrgn(i,2) for
+!    2nd region, etc
+   integer, intent(in) :: nmxrgn(pcols)         ! Number of maximally overlapped regions
+   logical, intent(in) :: doabsems
+
+   real(r8), intent(in) :: pmxrgn(pcols,pverp)  ! Maximum values of pmid for each
+   real(r8), intent(in) :: lwupcgs(pcols)       ! Longwave up flux in CGS units
+!
+! Input arguments which are only passed to other routines
+!
+   real(r8), intent(in) :: tnm(pcols,pver)      ! Level temperature
+   real(r8), intent(in) :: qnm(pcols,pver)      ! Level moisture field
+   real(r8), intent(in) :: o3vmr(pcols,pver)    ! ozone volume mixing ratio
+   real(r8), intent(in) :: pmid(pcols,pver)     ! Level pressure
+   real(r8), intent(in) :: pint(pcols,pverp)    ! Model interface pressure
+   real(r8), intent(in) :: pmln(pcols,pver)     ! Ln(pmid)
+   real(r8), intent(in) :: piln(pcols,pverp)    ! Ln(pint)
+   real(r8), intent(in) :: n2o(pcols,pver)      ! nitrous oxide mass mixing ratio
+   real(r8), intent(in) :: ch4(pcols,pver)      ! methane mass mixing ratio
+   real(r8), intent(in) :: cfc11(pcols,pver)    ! cfc11 mass mixing ratio
+   real(r8), intent(in) :: cfc12(pcols,pver)    ! cfc12 mass mixing ratio
+   real(r8), intent(in) :: cld(pcols,pver)      ! Cloud cover
+   real(r8), intent(in) :: emis(pcols,pver)     ! Cloud emissivity
+   real(r8), intent(in) :: aer_mass(pcols,pver) ! STRAER mass in layer
+
+!
+! Output arguments
+!
+   real(r8), intent(out) :: qrl(pcols,pver)      ! Longwave heating rate
+   real(r8), intent(out) :: flns(pcols)          ! Surface cooling flux
+   real(r8), intent(out) :: flnt(pcols)          ! Net outgoing flux
+   real(r8), intent(out) :: flut(pcols)          ! Upward flux at top of model
+   real(r8), intent(out) :: flnsc(pcols)         ! Clear sky surface cooing
+   real(r8), intent(out) :: flntc(pcols)         ! Net clear sky outgoing flux
+   real(r8), intent(out) :: flutc(pcols)         ! Upward clear-sky flux at top of model
+   real(r8), intent(out) :: flwds(pcols)         ! Down longwave flux at surface
+! Added downward/upward total and clear sky fluxes
+   real(r8), intent(out) :: flup(pcols,pverp)      ! Total sky upward longwave flux 
+   real(r8), intent(out) :: flupc(pcols,pverp)     ! Clear sky upward longwave flux 
+   real(r8), intent(out) :: fldn(pcols,pverp)      ! Total sky downward longwave flux 
+   real(r8), intent(out) :: fldnc(pcols,pverp)     ! Clear sky downward longwave flux
+!
+   real(r8), intent(inout) :: abstot(pcols,pverp,pverp) ! Total absorptivity
+   real(r8), intent(inout) :: absnxt(pcols,pver,4)      ! Total nearest layer absorptivity
+   real(r8), intent(inout) :: emstot(pcols,pverp)     ! Total emissivity
+
+!---------------------------Local variables-----------------------------
+!
+   integer i                 ! Longitude index
+   integer ilon              ! Longitude index
+   integer ii                ! Longitude index
+   integer iimx              ! Longitude index (max overlap)
+   integer k                 ! Level index
+   integer k1                ! Level index
+   integer k2                ! Level index
+   integer k3                ! Level index
+   integer km                ! Level index
+   integer km1               ! Level index
+   integer km3               ! Level index
+   integer km4               ! Level index
+   integer irgn              ! Index for max-overlap regions
+   integer l                 ! Index for clouds to overlap
+   integer l1                ! Index for clouds to overlap
+   integer n                 ! Counter
+
+!
+   real(r8) :: plco2(pcols,pverp)   ! Path length co2
+   real(r8) :: plh2o(pcols,pverp)   ! Path length h2o
+   real(r8) tmp(pcols)           ! Temporary workspace
+   real(r8) tmp2(pcols)          ! Temporary workspace
+   real(r8) absbt(pcols)         ! Downward emission at model top
+   real(r8) plol(pcols,pverp)    ! O3 pressure wghted path length
+   real(r8) plos(pcols,pverp)    ! O3 path length
+   real(r8) aer_mpp(pcols,pverp) ! STRAER path above kth interface level
+   real(r8) co2em(pcols,pverp)   ! Layer co2 normalized planck funct. derivative
+   real(r8) co2eml(pcols,pver)   ! Interface co2 normalized planck funct. deriv.
+   real(r8) delt(pcols)          ! Diff t**4 mid layer to top interface
+   real(r8) delt1(pcols)         ! Diff t**4 lower intrfc to mid layer
+   real(r8) bk1(pcols)           ! Absrptvty for vertical quadrature
+   real(r8) bk2(pcols)           ! Absrptvty for vertical quadrature
+   real(r8) cldp(pcols,pverp)    ! Cloud cover with extra layer
+   real(r8) ful(pcols,pverp)     ! Total upwards longwave flux
+   real(r8) fsul(pcols,pverp)    ! Clear sky upwards longwave flux
+   real(r8) fdl(pcols,pverp)     ! Total downwards longwave flux
+   real(r8) fsdl(pcols,pverp)    ! Clear sky downwards longwv flux
+   real(r8) fclb4(pcols,-1:pver)    ! Sig t**4 for cld bottom interfc
+   real(r8) fclt4(pcols,0:pver)    ! Sig t**4 for cloud top interfc
+   real(r8) s(pcols,pverp,pverp) ! Flx integral sum
+   real(r8) tplnka(pcols,pverp)  ! Planck fnctn temperature
+   real(r8) s2c(pcols,pverp)     ! H2o cont amount
+   real(r8) tcg(pcols,pverp)     ! H2o-mass-wgted temp. (Curtis-Godson approx.)
+   real(r8) w(pcols,pverp)       ! H2o path
+   real(r8) tplnke(pcols)        ! Planck fnctn temperature
+   real(r8) h2otr(pcols,pverp)   ! H2o trnmsn for o3 overlap
+   real(r8) co2t(pcols,pverp)    ! Prs wghted temperature path
+   real(r8) tint(pcols,pverp)    ! Interface temperature
+   real(r8) tint4(pcols,pverp)   ! Interface temperature**4
+   real(r8) tlayr(pcols,pverp)   ! Level temperature
+   real(r8) tlayr4(pcols,pverp)  ! Level temperature**4
+   real(r8) plh2ob(nbands,pcols,pverp)! Pressure weighted h2o path with 
+                                      !    Hulst-Curtis-Godson temp. factor 
+                                      !    for H2O bands 
+   real(r8) wb(nbands,pcols,pverp)    ! H2o path length with 
+                                      !    Hulst-Curtis-Godson temp. factor 
+                                      !    for H2O bands 
+
+   real(r8) cld0                 ! previous cloud amt (for max overlap)
+   real(r8) cld1                 ! next cloud amt (for max overlap)
+   real(r8) emx(0:pverp)         ! Emissivity factors (max overlap)
+   real(r8) emx0                 ! Emissivity factors for BCs (max overlap)
+   real(r8) trans                ! 1 - emis
+   real(r8) asort(pver)          ! 1 - cloud amounts to be sorted for max ovrlp.
+   real(r8) atmp                 ! Temporary storage for sort when nxs = 2
+   real(r8) maxcld(pcols)        ! Maximum cloud at any layer
+
+   integer indx(pcols)       ! index vector of gathered array values
+!!$   integer indxmx(pcols+1,pverp)! index vector of gathered array values
+   integer indxmx(pcols,pverp)! index vector of gathered array values
+!    (max overlap)
+   integer nrgn(pcols)       ! Number of max overlap regions at longitude
+   integer npts              ! number of values satisfying some criterion
+   integer ncolmx(pverp)     ! number of columns with clds in region
+   integer kx1(pcols,pverp)  ! Level index for top of max-overlap region
+   integer kx2(pcols,0:pverp)! Level index for bottom of max-overlap region
+   integer kxs(0:pverp,pcols,pverp)! Level indices for cld layers sorted by cld()
+!    in descending order
+   integer nxs(pcols,pverp)  ! Number of cloudy layers between kx1 and kx2
+   integer nxsk              ! Number of cloudy layers between (kx1/kx2)&k
+   integer ksort(0:pverp)    ! Level indices of cloud amounts to be sorted
+!    for max ovrlp. calculation
+   integer ktmp              ! Temporary storage for sort when nxs = 2
+
+!  real aer_trn_ttl(pcols,pverp,pverp,bnd_nbr_LW) ! [fraction] Total
+  real(r8) aer_trn_ttl(pcols,pverp,pverp,bnd_nbr_LW) ! [fraction] Total
+!                               ! transmission between interfaces k1 and k2  
+!
+! Pointer variables to 3d structures
+!
+!  real(r8), pointer :: abstot(:,:,:)
+!  real(r8), pointer :: absnxt(:,:,:)
+!  real(r8), pointer :: emstot(:,:)
+
+!
+! Trace gas variables
+!
+   real(r8) ucfc11(pcols,pverp)  ! CFC11 path length
+   real(r8) ucfc12(pcols,pverp)  ! CFC12 path length
+   real(r8) un2o0(pcols,pverp)   ! N2O path length
+   real(r8) un2o1(pcols,pverp)   ! N2O path length (hot band)
+   real(r8) uch4(pcols,pverp)    ! CH4 path length
+   real(r8) uco211(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8) uco212(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8) uco213(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8) uco221(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8) uco222(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8) uco223(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8) bn2o0(pcols,pverp)   ! pressure factor for n2o
+   real(r8) bn2o1(pcols,pverp)   ! pressure factor for n2o
+   real(r8) bch4(pcols,pverp)    ! pressure factor for ch4
+   real(r8) uptype(pcols,pverp)  ! p-type continuum path length
+   real(r8) abplnk1(14,pcols,pverp)  ! non-nearest layer Plack factor
+   real(r8) abplnk2(14,pcols,pverp)  ! nearest layer factor
+!
+!
+!-----------------------------------------------------------------------
+!
+!
+   pverp2=pver+2
+   pverp3=pver+3
+   pverp4=pver+4
+!
+! Set pointer variables
+!
+!  abstot => abstot_3d(:,:,:,lchnk)
+!  absnxt => absnxt_3d(:,:,:,lchnk)
+!  emstot => emstot_3d(:,:,lchnk)
+!
+! accumulate mass path from top of atmosphere
+!
+  call aer_pth(aer_mass, aer_mpp, ncol, pcols, pver, pverp)
+
+!
+! Calculate some temperatures needed to derive absorptivity and
+! emissivity, as well as some h2o path lengths
+!
+   call radtpl(lchnk   ,ncol    ,pcols, pver, pverp,                  &
+               tnm     ,lwupcgs ,qnm     ,pint    ,plco2   ,plh2o   , &
+               tplnka  ,s2c     ,tcg     ,w       ,tplnke  , &
+               tint    ,tint4   ,tlayr   ,tlayr4  ,pmln    , &
+               piln    ,plh2ob  ,wb      )
+   if (doabsems) then
+!
+! Compute ozone path lengths at frequency of a/e calculation.
+!
+      call radoz2(lchnk, ncol, pcols, pver, pverp, o3vmr   ,pint    ,plol    ,plos, ntoplw    )
+!
+! Compute trace gas path lengths
+!
+      call trcpth(lchnk   ,ncol    ,pcols, pver, pverp,         &
+                  tnm     ,pint    ,cfc11   ,cfc12   ,n2o     , &
+                  ch4     ,qnm     ,ucfc11  ,ucfc12  ,un2o0   , &
+                  un2o1   ,uch4    ,uco211  ,uco212  ,uco213  , &
+                  uco221  ,uco222  ,uco223  ,bn2o0   ,bn2o1   , &
+                  bch4    ,uptype  )
+
+!     Compute transmission through STRAER absorption continuum
+      call aer_trn(aer_mpp, aer_trn_ttl, pcols, pver, pverp)
+
+!
+!
+! Compute total emissivity:
+!
+      call radems(lchnk   ,ncol    ,pcols, pver, pverp,         &
+                  s2c     ,tcg     ,w       ,tplnke  ,plh2o   , &
+                  pint    ,plco2   ,tint    ,tint4   ,tlayr   , &
+                  tlayr4  ,plol    ,plos    ,ucfc11  ,ucfc12  , &
+                  un2o0   ,un2o1   ,uch4    ,uco211  ,uco212  , &
+                  uco213  ,uco221  ,uco222  ,uco223  ,uptype  , &
+                  bn2o0   ,bn2o1   ,bch4    ,co2em   ,co2eml  , &
+                  co2t    ,h2otr   ,abplnk1 ,abplnk2 ,emstot  , &
+                  plh2ob  ,wb      , &
+                  aer_trn_ttl)
+!
+! Compute total absorptivity:
+!
+      call radabs(lchnk   ,ncol    ,pcols, pver, pverp,         &
+                  pmid    ,pint    ,co2em   ,co2eml  ,tplnka  , &
+                  s2c     ,tcg     ,w       ,h2otr   ,plco2   , &
+                  plh2o   ,co2t    ,tint    ,tlayr   ,plol    , &
+                  plos    ,pmln    ,piln    ,ucfc11  ,ucfc12  , &
+                  un2o0   ,un2o1   ,uch4    ,uco211  ,uco212  , &
+                  uco213  ,uco221  ,uco222  ,uco223  ,uptype  , &
+                  bn2o0   ,bn2o1   ,bch4    ,abplnk1 ,abplnk2 , &
+                  abstot  ,absnxt  ,plh2ob  ,wb      , &
+                  aer_mpp ,aer_trn_ttl)
+   end if
+!
+! Compute sums used in integrals (all longitude points)
+!
+! Definition of bk1 & bk2 depends on finite differencing.  for
+! trapezoidal rule bk1=bk2. trapezoidal rule applied for nonadjacent
+! layers only.
+!
+! delt=t**4 in layer above current sigma level km.
+! delt1=t**4 in layer below current sigma level km.
+!
+   do i=1,ncol
+      delt(i) = tint4(i,pver) - tlayr4(i,pverp)
+      delt1(i) = tlayr4(i,pverp) - tint4(i,pverp)
+      s(i,pverp,pverp) = stebol*(delt1(i)*absnxt(i,pver,1) + delt (i)*absnxt(i,pver,4))
+      s(i,pver,pverp)  = stebol*(delt (i)*absnxt(i,pver,2) + delt1(i)*absnxt(i,pver,3))
+   end do
+   do k=ntoplw,pver-1
+      do i=1,ncol
+         bk2(i) = (abstot(i,k,pver) + abstot(i,k,pverp))*0.5
+         bk1(i) = bk2(i)
+         s(i,k,pverp) = stebol*(bk2(i)*delt(i) + bk1(i)*delt1(i))
+      end do
+   end do
+!
+! All k, km>1
+!
+   do km=pver,ntoplw+1,-1
+      do i=1,ncol
+         delt(i)  = tint4(i,km-1) - tlayr4(i,km)
+         delt1(i) = tlayr4(i,km) - tint4(i,km)
+      end do
+      do k=pverp,ntoplw,-1
+         if (k == km) then
+            do i=1,ncol
+               bk2(i) = absnxt(i,km-1,4)
+               bk1(i) = absnxt(i,km-1,1)
+            end do
+         else if (k == km-1) then
+            do i=1,ncol
+               bk2(i) = absnxt(i,km-1,2)
+               bk1(i) = absnxt(i,km-1,3)
+            end do
+         else
+            do i=1,ncol
+               bk2(i) = (abstot(i,k,km-1) + abstot(i,k,km))*0.5
+               bk1(i) = bk2(i)
+            end do
+         end if
+         do i=1,ncol
+            s(i,k,km) = s(i,k,km+1) + stebol*(bk2(i)*delt(i) + bk1(i)*delt1(i))
+         end do
+      end do
+   end do
+!
+! Computation of clear sky fluxes always set first level of fsul
+!
+   do i=1,ncol
+      fsul(i,pverp) = lwupcgs(i)
+   end do
+!
+! Downward clear sky fluxes store intermediate quantities in down flux
+! Initialize fluxes to clear sky values.
+!
+   do i=1,ncol
+      tmp(i) = fsul(i,pverp) - stebol*tint4(i,pverp)
+      fsul(i,ntoplw) = fsul(i,pverp) - abstot(i,ntoplw,pverp)*tmp(i) + s(i,ntoplw,ntoplw+1)
+      fsdl(i,ntoplw) = stebol*(tplnke(i)**4)*emstot(i,ntoplw)
+   end do
+!
+! fsdl(i,pverp) assumes isothermal layer
+!
+   do k=ntoplw+1,pver
+      do i=1,ncol
+         fsul(i,k) = fsul(i,pverp) - abstot(i,k,pverp)*tmp(i) + s(i,k,k+1)
+         fsdl(i,k) = stebol*(tplnke(i)**4)*emstot(i,k) - (s(i,k,ntoplw+1) - s(i,k,k+1))
+      end do
+   end do
+!
+! Store the downward emission from level 1 = total gas emission * sigma
+! t**4.  fsdl does not yet include all terms
+!
+   do i=1,ncol
+      absbt(i) = stebol*(tplnke(i)**4)*emstot(i,pverp)
+      fsdl(i,pverp) = absbt(i) - s(i,pverp,ntoplw+1)
+   end do
+!
+!----------------------------------------------------------------------
+! Modifications for clouds -- max/random overlap assumption
+!
+! The column is divided into sets of adjacent layers, called regions,
+!   in which the clouds are maximally overlapped.  The clouds are
+!   randomly overlapped between different regions.  The number of
+!   regions in a column is set by nmxrgn, and the range of pressures
+!   included in each region is set by pmxrgn.  The max/random overlap
+!   can be written in terms of the solutions of random overlap with
+!   cloud amounts = 1.  The random overlap assumption is equivalent to
+!   setting the flux boundary conditions (BCs) at the edges of each region
+!   equal to the mean all-sky flux at those boundaries.  Since the
+!   emissivity array for propogating BCs is only computed for the
+!   TOA BC, the flux BCs elsewhere in the atmosphere have to be formulated
+!   in terms of solutions to the random overlap equations.  This is done
+!   by writing the flux BCs as the sum of a clear-sky flux and emission
+!   from a cloud outside the region weighted by an emissivity.  This
+!   emissivity is determined from the location of the cloud and the
+!   flux BC.
+!
+! Copy cloud amounts to buffer with extra layer (needed for overlap logic)
+!
+   cldp(:ncol,ntoplw:pver) = cld(:ncol,ntoplw:pver)
+   cldp(:ncol,pverp) = 0.0
+!
+!
+! Select only those locations where there are no clouds
+!    (maximum cloud fraction <= 1.e-3 treated as clear)
+!    Set all-sky fluxes to clear-sky values.
+!
+   maxcld(1:ncol) = maxval(cldp(1:ncol,ntoplw:pver),dim=2)
+
+   npts = 0
+   do i=1,ncol
+      if (maxcld(i) < cldmin) then
+         npts = npts + 1
+         indx(npts) = i
+      end if
+   end do
+
+   do ii = 1, npts
+      i = indx(ii)
+      do k = ntoplw, pverp
+         fdl(i,k) = fsdl(i,k)
+         ful(i,k) = fsul(i,k)
+      end do
+   end do
+!
+! Select only those locations where there are clouds
+!
+   npts = 0
+   do i=1,ncol
+      if (maxcld(i) >= cldmin) then
+         npts = npts + 1
+         indx(npts) = i
+      end if
+   end do
+
+!
+! Initialize all-sky fluxes. fdl(i,1) & ful(i,pverp) are boundary conditions
+!
+   do ii = 1, npts
+      i = indx(ii)
+      fdl(i,ntoplw) = fsdl(i,ntoplw)
+      fdl(i,pverp)  = 0.0
+      ful(i,ntoplw) = 0.0
+      ful(i,pverp)  = fsul(i,pverp)
+      do k = ntoplw+1, pver
+         fdl(i,k) = 0.0
+         ful(i,k) = 0.0
+      end do
+!
+! Initialize Planck emission from layer boundaries
+!
+      do k = ntoplw, pver
+         fclt4(i,k-1) = stebol*tint4(i,k)
+         fclb4(i,k-1) = stebol*tint4(i,k+1)
+      enddo
+      fclb4(i,ntoplw-2) =  stebol*tint4(i,ntoplw)
+      fclt4(i,pver)     = stebol*tint4(i,pverp)
+!
+! Initialize indices for layers to be max-overlapped
+!
+      do irgn = 0, nmxrgn(i)
+         kx2(i,irgn) = ntoplw-1
+      end do
+      nrgn(i) = 0
+   end do
+
+!----------------------------------------------------------------------
+! INDEX CALCULATIONS FOR MAX OVERLAP
+
+   do ii = 1, npts
+      ilon = indx(ii)
+
+!
+! Outermost loop over regions (sets of adjacent layers) to be max overlapped
+!
+      do irgn = 1, nmxrgn(ilon)
+!
+! Calculate min/max layer indices inside region.
+!
+         n = 0
+         if (kx2(ilon,irgn-1) < pver) then
+            nrgn(ilon) = irgn
+            k1 = kx2(ilon,irgn-1)+1
+            kx1(ilon,irgn) = k1
+            kx2(ilon,irgn) = 0
+            do k2 = pver, k1, -1
+               if (pmid(ilon,k2) <= pmxrgn(ilon,irgn)) then
+                  kx2(ilon,irgn) = k2
+                  exit
+               end if
+            end do
+!
+! Identify columns with clouds in the given region.
+!
+            do k = k1, k2
+               if (cldp(ilon,k) >= cldmin) then
+                  n = n+1
+                  indxmx(n,irgn) = ilon
+                  exit
+               endif
+            end do
+         endif
+         ncolmx(irgn) = n
+!
+! Dummy value for handling clear-sky regions
+!
+!!$         indxmx(ncolmx(irgn)+1,irgn) = ncol+1
+!
+! Outer loop over columns with clouds in the max-overlap region
+!
+         do iimx = 1, ncolmx(irgn)
+            i = indxmx(iimx,irgn)
+!
+! Sort cloud areas and corresponding level indices.
+!
+            n = 0
+            do k = kx1(i,irgn),kx2(i,irgn)
+               if (cldp(i,k) >= cldmin) then
+                  n = n+1
+                  ksort(n) = k
+!
+! We need indices for clouds in order of largest to smallest, so
+!    sort 1-cld in ascending order
+!
+                  asort(n) = 1.0-cldp(i,k)
+               end if
+            end do
+            nxs(i,irgn) = n
+!
+! If nxs(i,irgn) eq 1, no need to sort.
+! If nxs(i,irgn) eq 2, sort by swapping if necessary
+! If nxs(i,irgn) ge 3, sort using local sort routine
+!
+            if (nxs(i,irgn) == 2) then
+               if (asort(2) < asort(1)) then
+                  ktmp = ksort(1)
+                  ksort(1) = ksort(2)
+                  ksort(2) = ktmp
+
+                  atmp = asort(1)
+                  asort(1) = asort(2)
+                  asort(2) = atmp
+               endif
+            else if (nxs(i,irgn) >= 3) then
+               call sortarray(nxs(i,irgn),asort,ksort(1:))
+            endif
+
+            do l = 1, nxs(i,irgn)
+               kxs(l,i,irgn) = ksort(l)
+            end do
+!
+! End loop over longitude i for fluxes
+!
+         end do
+!
+! End loop over regions irgn for max-overlap
+!
+      end do
+!
+!----------------------------------------------------------------------
+! DOWNWARD FLUXES:
+! Outermost loop over regions (sets of adjacent layers) to be max overlapped
+!
+      do irgn = 1, nmxrgn(ilon)
+!
+! Compute clear-sky fluxes for regions without clouds
+!
+         iimx = 1
+         if (ilon < indxmx(iimx,irgn) .and. irgn <= nrgn(ilon)) then
+!
+! Calculate emissivity so that downward flux at upper boundary of region
+!    can be cast in form of solution for downward flux from cloud above
+!    that boundary.  Then solutions for fluxes at other levels take form of
+!    random overlap expressions.  Try to locate "cloud" as close as possible
+!    to TOA such that the "cloud" pseudo-emissivity is between 0 and 1.
+!
+            k1 = kx1(ilon,irgn)
+            do km1 = ntoplw-2, k1-2
+               km4 = km1+3
+               k2 = k1
+               k3 = k2+1
+               tmp(ilon) = s(ilon,k2,min(k3,pverp))*min(1,pverp2-k3)
+               emx0 = (fdl(ilon,k1)-fsdl(ilon,k1))/ &
+                      ((fclb4(ilon,km1)-s(ilon,k2,km4)+tmp(ilon))- fsdl(ilon,k1))
+               if (emx0 >= 0.0 .and. emx0 <= 1.0) exit
+            end do
+            km1 = min(km1,k1-2)
+            do k2 = kx1(ilon,irgn)+1, kx2(ilon,irgn)+1
+               k3 = k2+1
+               tmp(ilon) = s(ilon,k2,min(k3,pverp))*min(1,pverp2-k3)
+               fdl(ilon,k2) = (1.0-emx0)*fsdl(ilon,k2) + &
+                               emx0*(fclb4(ilon,km1)-s(ilon,k2,km4)+tmp(ilon))
+            end do
+         else if (ilon==indxmx(iimx,irgn) .and. iimx<=ncolmx(irgn)) then
+            iimx = iimx+1
+         end if
+!
+! Outer loop over columns with clouds in the max-overlap region
+!
+         do iimx = 1, ncolmx(irgn)
+            i = indxmx(iimx,irgn)
+
+!
+! Calculate emissivity so that downward flux at upper boundary of region
+!    can be cast in form of solution for downward flux from cloud above that
+!    boundary.  Then solutions for fluxes at other levels take form of
+!    random overlap expressions.  Try to locate "cloud" as close as possible
+!    to TOA such that the "cloud" pseudo-emissivity is between 0 and 1.
+!
+            k1 = kx1(i,irgn)
+            do km1 = ntoplw-2,k1-2
+               km4 = km1+3
+               k2 = k1
+               k3 = k2 + 1
+               tmp(i) = s(i,k2,min(k3,pverp))*min(1,pverp2-k3)
+               tmp2(i) = s(i,k2,min(km4,pverp))*min(1,pverp2-km4)
+               emx0 = (fdl(i,k1)-fsdl(i,k1))/((fclb4(i,km1)-tmp2(i)+tmp(i))-fsdl(i,k1))
+               if (emx0 >= 0.0 .and. emx0 <= 1.0) exit
+            end do
+            km1 = min(km1,k1-2)
+            ksort(0) = km1 + 1
+!
+! Loop to calculate fluxes at level k
+!
+            nxsk = 0
+            do k = kx1(i,irgn), kx2(i,irgn)
+!
+! Identify clouds (largest to smallest area) between kx1 and k
+!    Since nxsk will increase with increasing k up to nxs(i,irgn), once
+!    nxsk == nxs(i,irgn) then use the list constructed for previous k
+!
+               if (nxsk < nxs(i,irgn)) then
+                  nxsk = 0
+                  do l = 1, nxs(i,irgn)
+                     k1 = kxs(l,i,irgn)
+                     if (k >= k1) then
+                        nxsk = nxsk + 1
+                        ksort(nxsk) = k1
+                     endif
+                  end do
+               endif
+!
+! Dummy value of index to insure computation of cloud amt is valid for l=nxsk+1
+!
+               ksort(nxsk+1) = pverp
+!
+! Initialize iterated emissivity factors
+!
+               do l = 1, nxsk
+                  emx(l) = emis(i,ksort(l))
+               end do
+!
+! Initialize iterated emissivity factor for bnd. condition at upper interface
+!
+               emx(0) = emx0
+!
+! Initialize previous cloud amounts
+!
+               cld0 = 1.0
+!
+! Indices for flux calculations
+!
+               k2 = k+1
+               k3 = k2+1
+               tmp(i) = s(i,k2,min(k3,pverp))*min(1,pverp2-k3)
+!
+! Loop over number of cloud levels inside region (biggest to smallest cld area)
+!
+               do l = 1, nxsk+1
+!
+! Calculate downward fluxes
+!
+                  cld1 = cldp(i,ksort(l))*min(1,nxsk+1-l)
+                  if (cld0 /= cld1) then
+                     fdl(i,k2) = fdl(i,k2)+(cld0-cld1)*fsdl(i,k2)
+                     do l1 = 0, l - 1
+                        km1 = ksort(l1)-1
+                        km4 = km1+3
+                        tmp2(i) = s(i,k2,min(km4,pverp))* min(1,pverp2-km4)
+                        fdl(i,k2) = fdl(i,k2)+(cld0-cld1)*emx(l1)*(fclb4(i,km1)-tmp2(i)+tmp(i)- &
+                                    fsdl(i,k2))
+                     end do
+                  endif
+                  cld0 = cld1
+!
+! Multiply emissivity factors by current cloud transmissivity
+!
+                  if (l <= nxsk) then
+                     k1 = ksort(l)
+                     trans = 1.0-emis(i,k1)
+!
+! Ideally the upper bound on l1 would be l-1, but the sort routine
+!    scrambles the order of layers with identical cloud amounts
+!
+                     do l1 = 0, nxsk
+                        if (ksort(l1) < k1) then
+                           emx(l1) = emx(l1)*trans
+                        endif
+                     end do
+                  end if
+!
+! End loop over number l of cloud levels
+!
+               end do
+!
+! End loop over level k for fluxes
+!
+            end do
+!
+! End loop over longitude i for fluxes
+!
+         end do
+!
+! End loop over regions irgn for max-overlap
+!
+      end do
+
+!
+!----------------------------------------------------------------------
+! UPWARD FLUXES:
+! Outermost loop over regions (sets of adjacent layers) to be max overlapped
+!
+      do irgn = nmxrgn(ilon), 1, -1
+!
+! Compute clear-sky fluxes for regions without clouds
+!
+         iimx = 1
+         if (ilon < indxmx(iimx,irgn) .and. irgn <= nrgn(ilon)) then
+!
+! Calculate emissivity so that upward flux at lower boundary of region
+!    can be cast in form of solution for upward flux from cloud below that
+!    boundary.  Then solutions for fluxes at other levels take form of
+!    random overlap expressions.  Try to locate "cloud" as close as possible
+!    to surface such that the "cloud" pseudo-emissivity is between 0 and 1.
+! Include allowance for surface emissivity (both numerator and denominator
+!    equal 1)
+!
+            k1 = kx2(ilon,irgn)+1
+            if (k1 < pverp) then
+               do km1 = pver-1,kx2(ilon,irgn),-1
+                  km3 = km1+2
+                  k2 = k1
+                  k3 = k2+1
+                  tmp(ilon) = s(ilon,k2,min(km3,pverp))* min(1,pverp2-km3)
+                  emx0 = (ful(ilon,k1)-fsul(ilon,k1))/ &
+                         ((fclt4(ilon,km1)+s(ilon,k2,k3)-tmp(ilon))- fsul(ilon,k1))
+                  if (emx0 >= 0.0 .and. emx0 <= 1.0) exit
+               end do
+               km1 = max(km1,kx2(ilon,irgn))
+            else
+               km1 = k1-1
+               km3 = km1+2
+               emx0 = 1.0
+            endif
+
+            do k2 = kx1(ilon,irgn), kx2(ilon,irgn)
+               k3 = k2+1
+!
+! If km3 == pver+2, one of the s integrals = 0 (integration limits both = p_s)
+!
+               tmp(ilon) = s(ilon,k2,min(km3,pverp))* min(1,pverp2-km3)
+               ful(ilon,k2) =(1.0-emx0)*fsul(ilon,k2) + emx0* &
+                             (fclt4(ilon,km1)+s(ilon,k2,k3)-tmp(ilon))
+            end do
+         else if (ilon==indxmx(iimx,irgn) .and. iimx<=ncolmx(irgn)) then
+            iimx = iimx+1
+         end if
+!
+! Outer loop over columns with clouds in the max-overlap region
+!
+         do iimx = 1, ncolmx(irgn)
+            i = indxmx(iimx,irgn)
+
+!
+! Calculate emissivity so that upward flux at lower boundary of region
+!    can be cast in form of solution for upward flux from cloud at that
+!    boundary.  Then solutions for fluxes at other levels take form of
+!    random overlap expressions.  Try to locate "cloud" as close as possible
+!    to surface such that the "cloud" pseudo-emissivity is between 0 and 1.
+! Include allowance for surface emissivity (both numerator and denominator
+!    equal 1)
+!
+            k1 = kx2(i,irgn)+1
+            if (k1 < pverp) then
+               do km1 = pver-1,kx2(i,irgn),-1
+                  km3 = km1+2
+                  k2 = k1
+                  k3 = k2+1
+                  tmp(i) = s(i,k2,min(km3,pverp))*min(1,pverp2-km3)
+                  emx0 = (ful(i,k1)-fsul(i,k1))/((fclt4(i,km1)+s(i,k2,k3)-tmp(i))-fsul(i,k1))
+                  if (emx0 >= 0.0 .and. emx0 <= 1.0) exit
+               end do
+               km1 = max(km1,kx2(i,irgn))
+            else
+               emx0 = 1.0
+               km1 = k1-1
+            endif
+            ksort(0) = km1 + 1
+
+!
+! Loop to calculate fluxes at level k
+!
+            nxsk = 0
+            do k = kx2(i,irgn), kx1(i,irgn), -1
+!
+! Identify clouds (largest to smallest area) between k and kx2
+!    Since nxsk will increase with decreasing k up to nxs(i,irgn), once
+!    nxsk == nxs(i,irgn) then use the list constructed for previous k
+!
+               if (nxsk < nxs(i,irgn)) then
+                  nxsk = 0
+                  do l = 1, nxs(i,irgn)
+                     k1 = kxs(l,i,irgn)
+                     if (k <= k1) then
+                        nxsk = nxsk + 1
+                        ksort(nxsk) = k1
+                     endif
+                  end do
+               endif
+!
+! Dummy value of index to insure computation of cloud amt is valid for l=nxsk+1
+!
+               ksort(nxsk+1) = pverp
+!
+! Initialize iterated emissivity factors
+!
+               do l = 1, nxsk
+                  emx(l) = emis(i,ksort(l))
+               end do
+!
+! Initialize iterated emissivity factor for bnd. condition at lower interface
+!
+               emx(0) = emx0
+!
+! Initialize previous cloud amounts
+!
+               cld0 = 1.0
+!
+! Indices for flux calculations
+!
+               k2 = k
+               k3 = k2+1
+!
+! Loop over number of cloud levels inside region (biggest to smallest cld area)
+!
+               do l = 1, nxsk+1
+!
+! Calculate upward fluxes
+!
+                  cld1 = cldp(i,ksort(l))*min(1,nxsk+1-l)
+                  if (cld0 /= cld1) then
+                     ful(i,k2) = ful(i,k2)+(cld0-cld1)*fsul(i,k2)
+                     do l1 = 0, l - 1
+                        km1 = ksort(l1)-1
+                        km3 = km1+2
+!
+! If km3 == pver+2, one of the s integrals = 0 (integration limits both = p_s)
+!
+                        tmp(i) = s(i,k2,min(km3,pverp))* min(1,pverp2-km3)
+                        ful(i,k2) = ful(i,k2)+(cld0-cld1)*emx(l1)* &
+                                   (fclt4(i,km1)+s(i,k2,k3)-tmp(i)- fsul(i,k2))
+                     end do
+                  endif
+                  cld0 = cld1
+!
+! Multiply emissivity factors by current cloud transmissivity
+!
+                  if (l <= nxsk) then
+                     k1 = ksort(l)
+                     trans = 1.0-emis(i,k1)
+!
+! Ideally the upper bound on l1 would be l-1, but the sort routine
+!    scrambles the order of layers with identical cloud amounts
+!
+                     do l1 = 0, nxsk
+                        if (ksort(l1) > k1) then
+                           emx(l1) = emx(l1)*trans
+                        endif
+                     end do
+                  end if
+!
+! End loop over number l of cloud levels
+!
+               end do
+!
+! End loop over level k for fluxes
+!
+            end do
+!
+! End loop over longitude i for fluxes
+!
+         end do
+!
+! End loop over regions irgn for max-overlap
+!
+      end do
+!
+! End outermost longitude loop
+!
+   end do
+!
+! End cloud modification loops
+!
+!----------------------------------------------------------------------
+! All longitudes: store history tape quantities
+!
+   do i=1,ncol
+      flwds(i) = fdl (i,pverp )
+      flns(i)  = ful (i,pverp ) - fdl (i,pverp )
+      flnsc(i) = fsul(i,pverp ) - fsdl(i,pverp )
+      flnt(i)  = ful (i,ntoplw) - fdl (i,ntoplw)
+      flntc(i) = fsul(i,ntoplw) - fsdl(i,ntoplw)
+      flut(i)  = ful (i,ntoplw)
+      flutc(i) = fsul(i,ntoplw)
+   end do
+!
+! Computation of longwave heating (J/kg/s)
+!
+   do k=ntoplw,pver
+      do i=1,ncol
+         qrl(i,k) = (ful(i,k) - fdl(i,k) - ful(i,k+1) + fdl(i,k+1))* &
+                     1.E-4*gravit/((pint(i,k) - pint(i,k+1)))
+      end do
+   end do
+! Return 0 above solution domain
+   if ( ntoplw > 1 )then
+      qrl(:ncol,:ntoplw-1) = 0.
+   end if
+
+! Added downward/upward total and clear sky fluxes
+!
+   do k=ntoplw,pverp
+      do i=1,ncol
+        flup(i,k)  = ful(i,k)
+        flupc(i,k) = fsul(i,k)
+        fldn(i,k)  = fdl(i,k)
+        fldnc(i,k) = fsdl(i,k)
+      end do
+   end do
+! Return 0 above solution domain
+   if ( ntoplw > 1 )then
+      flup(:ncol,:ntoplw-1) = 0.
+      flupc(:ncol,:ntoplw-1) = 0.
+      fldn(:ncol,:ntoplw-1) = 0.
+      fldnc(:ncol,:ntoplw-1) = 0.
+   end if
+!
+   return
+end subroutine radclwmx
+
+subroutine radcswmx(jj, lchnk   ,ncol    ,pcols, pver, pverp,         &
+                    pint    ,pmid    ,h2ommr  ,rh      ,o3mmr   , &
+                    aermmr  ,cld     ,cicewp  ,cliqwp  ,rel     , &
+!                   rei     ,eccf    ,coszrs  ,scon    ,solin   ,solcon,  &
+                    rei     ,tauxcl  ,tauxci  ,eccf    ,coszrs  ,scon    ,solin   ,solcon,  &
+                    asdir   ,asdif   ,aldir   ,aldif   ,nmxrgn  , &
+                    pmxrgn  ,qrs     ,fsnt    ,fsntc   ,fsntoa  , &
+                    fsntoac ,fsnirtoa,fsnrtoac,fsnrtoaq,fsns    , &
+                    fsnsc   ,fsdsc   ,fsds    ,sols    ,soll    , &
+                    solsd   ,solld   ,frc_day ,                   &
+                    fsup    ,fsupc   ,fsdn    ,fsdnc   ,          &
+                    aertau  ,aerssa  ,aerasm  ,aerfwd             )
+!-----------------------------------------------------------------------
+! 
+! Purpose: 
+! Solar radiation code
+! 
+! Method: 
+! Basic method is Delta-Eddington as described in:
+! 
+! Briegleb, Bruce P., 1992: Delta-Eddington
+! Approximation for Solar Radiation in the NCAR Community Climate Model,
+! Journal of Geophysical Research, Vol 97, D7, pp7603-7612).
+! 
+! Five changes to the basic method described above are:
+! (1) addition of sulfate aerosols (Kiehl and Briegleb, 1993)
+! (2) the distinction between liquid and ice particle clouds 
+! (Kiehl et al, 1996);
+! (3) provision for calculating TOA fluxes with spectral response to
+! match Nimbus-7 visible/near-IR radiometers (Collins, 1998);
+! (4) max-random overlap (Collins, 2001)
+! (5) The near-IR absorption by H2O was updated in 2003 by Collins, 
+!     Lee-Taylor, and Edwards for consistency with the new line data in
+!     Hitran 2000 and the H2O continuum version CKD 2.4.  Modifications
+!     were optimized by reducing RMS errors in heating rates relative
+!     to a series of benchmark calculations for the 5 standard AFGL 
+!     atmospheres.  The benchmarks were performed using DISORT2 combined
+!     with GENLN3.  The near-IR scattering optical depths for Rayleigh
+!     scattering were also adjusted, as well as the correction for
+!     stratospheric heating by H2O.
+!
+! The treatment of maximum-random overlap is described in the
+! comment block "INDEX CALCULATIONS FOR MAX OVERLAP".
+! 
+! Divides solar spectrum into 19 intervals from 0.2-5.0 micro-meters.
+! solar flux fractions specified for each interval. allows for
+! seasonally and diurnally varying solar input.  Includes molecular,
+! cloud, aerosol, and surface scattering, along with h2o,o3,co2,o2,cloud, 
+! and surface absorption. Computes delta-eddington reflections and
+! transmissions assuming homogeneously mixed layers. Adds the layers 
+! assuming scattering between layers to be isotropic, and distinguishes 
+! direct solar beam from scattered radiation.
+! 
+! Longitude loops are broken into 1 or 2 sections, so that only daylight
+! (i.e. coszrs > 0) computations are done.
+! 
+! Note that an extra layer above the model top layer is added.
+! 
+! cgs units are used.
+! 
+! Special diagnostic calculation of the clear sky surface and total column
+! absorbed flux is also done for cloud forcing diagnostics.
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use ghg_surfvals, only: co2mmr
+!  use prescribed_aerosols, only: idxBG, idxSUL, idxSSLT, idxOCPHO, idxBCPHO, idxOCPHI, idxBCPHI, &
+!    idxDUSTfirst, numDUST, idxVOLC, naer_all
+!  use aer_optics, only: nrh, ndstsz, ksul, wsul, gsul, &
+!    ksslt, wsslt, gsslt, kcphil, wcphil, gcphil, kcphob, wcphob, gcphob, &
+!    kcb, wcb, gcb, kdst, wdst, gdst, kbg, wbg, gbg, kvolc, wvolc, gvolc
+!  use abortutils, only: endrun
+
+   implicit none
+
+   integer nspint            ! Num of spctrl intervals across solar spectrum
+   integer naer_groups       ! Num of aerosol groups for optical diagnostics
+
+   parameter ( nspint = 19 )
+   parameter ( naer_groups = 7 )    ! current groupings are sul, sslt, all carbons, all dust, and all aerosols
+!-----------------------Constants for new band (640-700 nm)-------------
+   real(r8) v_raytau_35
+   real(r8) v_raytau_64
+   real(r8) v_abo3_35
+   real(r8) v_abo3_64
+   parameter( &
+        v_raytau_35 = 0.155208, &
+        v_raytau_64 = 0.0392, &
+        v_abo3_35 = 2.4058030e+01, &  
+        v_abo3_64 = 2.210e+01 &
+        )
+
+
+!-------------Parameters for accelerating max-random solution-------------
+! 
+! The solution time scales like prod(j:1->N) (1 + n_j) where 
+! N   = number of max-overlap regions (nmxrgn)
+! n_j = number of unique cloud amounts in region j
+! 
+! Therefore the solution cost can be reduced by decreasing n_j.
+! cldmin reduces n_j by treating cloud amounts < cldmin as clear sky.
+! cldeps reduces n_j by treating cloud amounts identical to log(1/cldeps)
+! decimal places as identical
+! 
+! areamin reduces the cost by dropping configurations that occupy
+! a surface area < areamin of the model grid box.  The surface area
+! for a configuration C(j,k_j), where j is the region number and k_j is the
+! index for a unique cloud amount (in descending order from biggest to
+! smallest clouds) in region j, is
+! 
+! A = prod(j:1->N) [C(j,k_j) - C(j,k_j+1)]
+! 
+! where C(j,0) = 1.0 and C(j,n_j+1) = 0.0.
+! 
+! nconfgmax reduces the cost and improves load balancing by setting an upper
+! bound on the number of cloud configurations in the solution.  If the number
+! of configurations exceeds nconfgmax, the nconfgmax configurations with the
+! largest area are retained, and the fluxes are normalized by the total area
+! of these nconfgmax configurations.  For the current max/random overlap 
+! assumption (see subroutine cldovrlap), 30 levels, and cloud-amount 
+! parameterization, the mean and RMS number of configurations are 
+! both roughly 5.  nconfgmax has been set to the mean+2*RMS number, or 15.
+! 
+! Minimum cloud amount (as a fraction of the grid-box area) to 
+! distinguish from clear sky
+! 
+   real(r8) cldmin
+   parameter (cldmin = 1.0e-80_r8)
+! 
+! Minimimum horizontal area (as a fraction of the grid-box area) to retain 
+! for a unique cloud configuration in the max-random solution
+! 
+   real(r8) areamin
+   parameter (areamin = 0.01_r8)
+! 
+! Decimal precision of cloud amount (0 -> preserve full resolution;
+! 10^-n -> preserve n digits of cloud amount)
+! 
+   real(r8) cldeps
+   parameter (cldeps = 0.0_r8)
+! 
+! Maximum number of configurations to include in solution
+! 
+   integer nconfgmax
+   parameter (nconfgmax = 15)
+!------------------------------Commons----------------------------------
+! 
+! Input arguments
+! 
+   integer, intent(in) :: lchnk,jj             ! chunk identifier
+   integer, intent(in) :: pcols, pver, pverp
+   integer, intent(in) :: ncol              ! number of atmospheric columns
+
+   real(r8), intent(in) :: pmid(pcols,pver) ! Level pressure
+   real(r8), intent(in) :: pint(pcols,pverp) ! Interface pressure
+   real(r8), intent(in) :: h2ommr(pcols,pver) ! Specific humidity (h2o mass mix ratio)
+   real(r8), intent(in) :: o3mmr(pcols,pver) ! Ozone mass mixing ratio
+   real(r8), intent(in) :: aermmr(pcols,pver,naer_all) ! Aerosol mass mixing ratio
+   real(r8), intent(in) :: rh(pcols,pver)   ! Relative humidity (fraction)
+! 
+   real(r8), intent(in) :: cld(pcols,pver)  ! Fractional cloud cover
+   real(r8), intent(in) :: cicewp(pcols,pver) ! in-cloud cloud ice water path
+   real(r8), intent(in) :: cliqwp(pcols,pver) ! in-cloud cloud liquid water path
+   real(r8), intent(in) :: rel(pcols,pver)  ! Liquid effective drop size (microns)
+   real(r8), intent(in) :: rei(pcols,pver)  ! Ice effective drop size (microns)
+! 
+   real(r8), intent(in) :: eccf             ! Eccentricity factor (1./earth-sun dist^2)
+   real, intent(in) :: solcon           ! solar constant with eccentricity factor
+   real(r8), intent(in) :: coszrs(pcols)    ! Cosine solar zenith angle
+   real(r8), intent(in) :: asdir(pcols)     ! 0.2-0.7 micro-meter srfc alb: direct rad
+   real(r8), intent(in) :: aldir(pcols)     ! 0.7-5.0 micro-meter srfc alb: direct rad
+   real(r8), intent(in) :: asdif(pcols)     ! 0.2-0.7 micro-meter srfc alb: diffuse rad
+   real(r8), intent(in) :: aldif(pcols)     ! 0.7-5.0 micro-meter srfc alb: diffuse rad
+
+   real(r8), intent(in) :: scon             ! solar constant 
+! 
+! IN/OUT arguments
+! 
+   real(r8), intent(inout) :: pmxrgn(pcols,pverp) ! Maximum values of pressure for each
+!                                                 !    maximally overlapped region. 
+!                                                 !    0->pmxrgn(i,1) is range of pressure for
+!                                                 !    1st region,pmxrgn(i,1)->pmxrgn(i,2) for
+!                                                 !    2nd region, etc
+   integer, intent(inout) ::  nmxrgn(pcols)    ! Number of maximally overlapped regions
+! 
+! Output arguments
+! 
+
+   real(r8), intent(out) :: solin(pcols)     ! Incident solar flux
+   real(r8), intent(out) :: qrs(pcols,pver)  ! Solar heating rate
+   real(r8), intent(out) :: fsns(pcols)      ! Surface absorbed solar flux
+   real(r8), intent(out) :: fsnt(pcols)      ! Total column absorbed solar flux
+   real(r8), intent(out) :: fsntoa(pcols)    ! Net solar flux at TOA
+   real(r8), intent(out) :: fsds(pcols)      ! Flux shortwave downwelling surface
+! 
+   real(r8), intent(out) :: fsnsc(pcols)     ! Clear sky surface absorbed solar flux
+   real(r8), intent(out) :: fsdsc(pcols)     ! Clear sky surface downwelling solar flux
+   real(r8), intent(out) :: fsntc(pcols)     ! Clear sky total column absorbed solar flx
+   real(r8), intent(out) :: fsntoac(pcols)   ! Clear sky net solar flx at TOA
+   real(r8), intent(out) :: sols(pcols)      ! Direct solar rad on surface (< 0.7)
+   real(r8), intent(out) :: soll(pcols)      ! Direct solar rad on surface (>= 0.7)
+   real(r8), intent(out) :: solsd(pcols)     ! Diffuse solar rad on surface (< 0.7)
+   real(r8), intent(out) :: solld(pcols)     ! Diffuse solar rad on surface (>= 0.7)
+   real(r8), intent(out) :: fsnirtoa(pcols)  ! Near-IR flux absorbed at toa
+   real(r8), intent(out) :: fsnrtoac(pcols)  ! Clear sky near-IR flux absorbed at toa
+   real(r8), intent(out) :: fsnrtoaq(pcols)  ! Net near-IR flux at toa >= 0.7 microns
+   real(r8), intent(out) :: tauxcl(pcols,0:pver) ! water cloud extinction optical depth
+   real(r8), intent(out) :: tauxci(pcols,0:pver) ! ice cloud extinction optical depth
+
+! Added downward/upward total and clear sky fluxes
+   real(r8), intent(out) :: fsup(pcols,pverp)      ! Total sky upward solar flux (spectrally summed)
+   real(r8), intent(out) :: fsupc(pcols,pverp)     ! Clear sky upward solar flux (spectrally summed)
+   real(r8), intent(out) :: fsdn(pcols,pverp)      ! Total sky downward solar flux (spectrally summed)
+   real(r8), intent(out) :: fsdnc(pcols,pverp)     ! Clear sky downward solar flux (spectrally summed)
+!
+   real(r8) , intent(out) :: frc_day(pcols) ! = 1 for daylight, =0 for night columns
+   real(r8) :: aertau(pcols,nspint,naer_groups) ! Aerosol column optical depth
+   real(r8) :: aerssa(pcols,nspint,naer_groups) ! Aerosol column averaged single scattering albedo
+   real(r8) :: aerasm(pcols,nspint,naer_groups) ! Aerosol column averaged asymmetry parameter
+   real(r8) :: aerfwd(pcols,nspint,naer_groups) ! Aerosol column averaged forward scattering
+!  real(r8), intent(out) :: aertau(pcols,nspint,naer_groups) ! Aerosol column optical depth
+!  real(r8), intent(out) :: aerssa(pcols,nspint,naer_groups) ! Aerosol column averaged single scattering albedo
+!  real(r8), intent(out) :: aerasm(pcols,nspint,naer_groups) ! Aerosol column averaged asymmetry parameter
+!  real(r8), intent(out) :: aerfwd(pcols,nspint,naer_groups) ! Aerosol column averaged forward scattering
+! 
+!---------------------------Local variables-----------------------------
+! 
+! Max/random overlap variables
+! 
+   real(r8) asort(pverp)     ! 1 - cloud amounts to be sorted for max ovrlp.
+   real(r8) atmp             ! Temporary storage for sort when nxs = 2
+   real(r8) cld0             ! 1 - (cld amt) used to make wstr, cstr, nstr
+   real(r8) totwgt           ! Total of xwgts = total fractional area of 
+!   grid-box covered by cloud configurations
+!   included in solution to fluxes
+
+   real(r8) wgtv(nconfgmax)  ! Weights for fluxes
+!   1st index is configuration number
+   real(r8) wstr(pverp,pverp) ! area weighting factors for streams
+!   1st index is for stream #, 
+!   2nd index is for region #
+
+   real(r8) xexpt            ! solar direct beam trans. for layer above
+   real(r8) xrdnd            ! diffuse reflectivity for layer above
+   real(r8) xrupd            ! diffuse reflectivity for layer below
+   real(r8) xrups            ! direct-beam reflectivity for layer below
+   real(r8) xtdnt            ! total trans for layers above
+
+   real(r8) xwgt             ! product of cloud amounts
+
+   real(r8) yexpt            ! solar direct beam trans. for layer above
+   real(r8) yrdnd            ! diffuse reflectivity for layer above
+   real(r8) yrupd            ! diffuse reflectivity for layer below
+   real(r8) ytdnd            ! dif-beam transmission for layers above
+   real(r8) ytupd            ! dif-beam transmission for layers below
+
+   real(r8) zexpt            ! solar direct beam trans. for layer above
+   real(r8) zrdnd            ! diffuse reflectivity for layer above
+   real(r8) zrupd            ! diffuse reflectivity for layer below
+   real(r8) zrups            ! direct-beam reflectivity for layer below
+   real(r8) ztdnt            ! total trans for layers above
+
+   logical new_term          ! Flag for configurations to include in fluxes
+   logical region_found      ! flag for identifying regions
+
+   integer ccon(0:pverp,nconfgmax)                                
+! flags for presence of clouds
+!   1st index is for level # (including 
+!    layer above top of model and at surface)
+!   2nd index is for configuration #
+   integer cstr(0:pverp,pverp)                                
+! flags for presence of clouds
+!   1st index is for level # (including 
+!    layer above top of model and at surface)
+!   2nd index is for stream #
+   integer icond(0:pverp,nconfgmax)
+! Indices for copying rad. properties from
+!     one identical downward cld config.
+!     to another in adding method (step 2)
+!   1st index is for interface # (including 
+!     layer above top of model and at surface)
+!   2nd index is for configuration # range
+   integer iconu(0:pverp,nconfgmax)
+! Indices for copying rad. properties from
+!     one identical upward configuration
+!     to another in adding method (step 2)
+!   1st index is for interface # (including 
+!     layer above top of model and at surface)
+!   2nd index is for configuration # range
+   integer iconfig           ! Counter for random-ovrlap configurations
+   integer irgn              ! Index for max-overlap regions
+   integer is0               ! Lower end of stream index range
+   integer is1               ! Upper end of stream index range
+   integer isn               ! Stream index
+   integer istr(pverp+1)     ! index for stream #s during flux calculation
+   integer istrtd(0:pverp,0:nconfgmax+1)
+! indices into icond 
+!   1st index is for interface # (including 
+!     layer above top of model and at surface)
+!   2nd index is for configuration # range
+   integer istrtu(0:pverp,0:nconfgmax+1)
+! indices into iconu 
+!   1st index is for interface # (including 
+!     layer above top of model and at surface)
+!   2nd index is for configuration # range
+   integer j                 ! Configuration index
+   integer k1                ! Level index
+   integer k2                ! Level index
+   integer ksort(pverp)      ! Level indices of cloud amounts to be sorted
+   integer ktmp              ! Temporary storage for sort when nxs = 2
+   integer kx1(0:pverp)      ! Level index for top of max-overlap region
+   integer kx2(0:pverp)      ! Level index for bottom of max-overlap region
+   integer l                 ! Index 
+   integer l0                ! Index
+   integer mrgn              ! Counter for nrgn
+   integer mstr              ! Counter for nstr
+   integer n0                ! Number of configurations with ccon(k,:)==0
+   integer n1                ! Number of configurations with ccon(k,:)==1
+   integer nconfig           ! Number of random-ovrlap configurations
+   integer nconfigm          ! Value of config before testing for areamin,
+!    nconfgmax
+   integer npasses           ! number of passes over the indexing loop
+   integer nrgn              ! Number of max overlap regions at current 
+!    longitude
+   integer nstr(pverp)       ! Number of unique cloud configurations
+!   ("streams") in a max-overlapped region
+!   1st index is for region #
+   integer nuniq             ! # of unique cloud configurations
+   integer nuniqd(0:pverp)   ! # of unique cloud configurations: TOA 
+!   to level k
+   integer nuniqu(0:pverp)   ! # of unique cloud configurations: surface
+!   to level k 
+   integer nxs               ! Number of cloudy layers between k1 and k2 
+   integer ptr0(nconfgmax)   ! Indices of configurations with ccon(k,:)==0
+   integer ptr1(nconfgmax)   ! Indices of configurations with ccon(k,:)==1
+   integer ptrc(nconfgmax)   ! Pointer for configurations sorted by wgtv
+!  integer findvalue         ! Function for finding kth smallest element
+!   in a vector
+!  external findvalue
+
+! 
+! Other
+! 
+   integer ns                ! Spectral loop index
+   integer i                 ! Longitude loop index
+   integer k                 ! Level loop index
+   integer km1               ! k - 1
+   integer kp1               ! k + 1
+   integer n                 ! Loop index for daylight
+   integer ndayc             ! Number of daylight columns
+   integer idayc(pcols)      ! Daytime column indices
+   integer indxsl            ! Index for cloud particle properties
+   integer ksz               ! dust size bin index
+   integer krh               ! relative humidity bin index
+   integer kaer              ! aerosol group index
+   real(r8) wrh              ! weight for linear interpolation between lut points
+   real(r8) :: rhtrunc       ! rh, truncated for the purposes of extrapolating
+                             ! aerosol optical properties 
+! 
+! A. Slingo's data for cloud particle radiative properties (from 'A GCM
+! Parameterization for the Shortwave Properties of Water Clouds' JAS
+! vol. 46 may 1989 pp 1419-1427)
+! 
+   real(r8) abarl(4)         ! A coefficient for extinction optical depth
+   real(r8) bbarl(4)         ! B coefficient for extinction optical depth
+   real(r8) cbarl(4)         ! C coefficient for single scat albedo
+   real(r8) dbarl(4)         ! D coefficient for single  scat albedo
+   real(r8) ebarl(4)         ! E coefficient for asymmetry parameter
+   real(r8) fbarl(4)         ! F coefficient for asymmetry parameter
+
+   save abarl, bbarl, cbarl, dbarl, ebarl, fbarl
+
+   data abarl/ 2.817e-02, 2.682e-02,2.264e-02,1.281e-02/
+   data bbarl/ 1.305    , 1.346    ,1.454    ,1.641    /
+   data cbarl/-5.62e-08 ,-6.94e-06 ,4.64e-04 ,0.201    /
+   data dbarl/ 1.63e-07 , 2.35e-05 ,1.24e-03 ,7.56e-03 /
+   data ebarl/ 0.829    , 0.794    ,0.754    ,0.826    /
+   data fbarl/ 2.482e-03, 4.226e-03,6.560e-03,4.353e-03/
+
+   real(r8) abarli           ! A coefficient for current spectral band
+   real(r8) bbarli           ! B coefficient for current spectral band
+   real(r8) cbarli           ! C coefficient for current spectral band
+   real(r8) dbarli           ! D coefficient for current spectral band
+   real(r8) ebarli           ! E coefficient for current spectral band
+   real(r8) fbarli           ! F coefficient for current spectral band
+! 
+! Caution... A. Slingo recommends no less than 4.0 micro-meters nor
+! greater than 20 micro-meters
+! 
+! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836)
+! 
+   real(r8) abari(4)         ! a coefficient for extinction optical depth
+   real(r8) bbari(4)         ! b coefficient for extinction optical depth
+   real(r8) cbari(4)         ! c coefficient for single scat albedo
+   real(r8) dbari(4)         ! d coefficient for single scat albedo
+   real(r8) ebari(4)         ! e coefficient for asymmetry parameter
+   real(r8) fbari(4)         ! f coefficient for asymmetry parameter
+
+   save abari, bbari, cbari, dbari, ebari, fbari
+
+   data abari/ 3.448e-03, 3.448e-03,3.448e-03,3.448e-03/
+   data bbari/ 2.431    , 2.431    ,2.431    ,2.431    /
+   data cbari/ 1.00e-05 , 1.10e-04 ,1.861e-02,.46658   /
+   data dbari/ 0.0      , 1.405e-05,8.328e-04,2.05e-05 /
+   data ebari/ 0.7661   , 0.7730   ,0.794    ,0.9595   /
+   data fbari/ 5.851e-04, 5.665e-04,7.267e-04,1.076e-04/
+
+   real(r8) abarii           ! A coefficient for current spectral band
+   real(r8) bbarii           ! B coefficient for current spectral band
+   real(r8) cbarii           ! C coefficient for current spectral band
+   real(r8) dbarii           ! D coefficient for current spectral band
+   real(r8) ebarii           ! E coefficient for current spectral band
+   real(r8) fbarii           ! F coefficient for current spectral band
+! 
+   real(r8) delta            ! Pressure (in atm) for stratos. h2o limit
+   real(r8) o2mmr            ! O2 mass mixing ratio:
+
+   save delta, o2mmr
+
+!
+! UPDATE TO H2O NEAR-IR: Delta optimized for Hitran 2K and CKD 2.4
+!
+   data delta / 0.0014257179260883 /
+!
+! END UPDATE
+!
+   data o2mmr / .23143 /
+
+   real(r8) albdir(pcols,nspint) ! Current spc intrvl srf alb to direct rad
+   real(r8) albdif(pcols,nspint) ! Current spc intrvl srf alb to diffuse rad
+! 
+! Next series depends on spectral interval
+! 
+   real(r8) frcsol(nspint)   ! Fraction of solar flux in spectral interval
+   real(r8) wavmin(nspint)   ! Min wavelength (micro-meters) of interval
+   real(r8) wavmax(nspint)   ! Max wavelength (micro-meters) of interval
+   real(r8) raytau(nspint)   ! Rayleigh scattering optical depth
+   real(r8) abh2o(nspint)    ! Absorption coefficiant for h2o (cm2/g)
+   real(r8) abo3 (nspint)    ! Absorption coefficiant for o3  (cm2/g)
+   real(r8) abco2(nspint)    ! Absorption coefficiant for co2 (cm2/g)
+   real(r8) abo2 (nspint)    ! Absorption coefficiant for o2  (cm2/g)
+   real(r8) ph2o(nspint)     ! Weight of h2o in spectral interval
+   real(r8) pco2(nspint)     ! Weight of co2 in spectral interval
+   real(r8) po2 (nspint)     ! Weight of o2  in spectral interval
+   real(r8) nirwgt(nspint)   ! Spectral Weights to simulate Nimbus-7 filter
+   real(r8) wgtint           ! Weight for specific spectral interval
+
+   save frcsol ,wavmin ,wavmax ,raytau ,abh2o ,abo3 , &
+        abco2  ,abo2   ,ph2o   ,pco2   ,po2   ,nirwgt
+
+   data frcsol / .001488, .001389, .001290, .001686, .002877, &
+                 .003869, .026336, .360739, .065392, .526861, &
+                 .526861, .526861, .526861, .526861, .526861, &
+                 .526861, .006239, .001834, .001834/
+! 
+! weight for 0.64 - 0.7 microns  appropriate to clear skies over oceans
+! 
+   data nirwgt /  0.0,   0.0,   0.0,      0.0,   0.0, &
+                  0.0,   0.0,   0.0, 0.320518,   1.0,  1.0, &
+                  1.0,   1.0,   1.0,      1.0,   1.0, &
+                  1.0,   1.0,   1.0 /
+
+   data wavmin / .200,  .245,  .265,  .275,  .285, &
+                 .295,  .305,  .350,  .640,  .700,  .701, &
+                 .701,  .701,  .701,  .702,  .702, &
+                 2.630, 4.160, 4.160/
+
+   data wavmax / .245,  .265,  .275,  .285,  .295, &
+                 .305,  .350,  .640,  .700, 5.000, 5.000, &
+                 5.000, 5.000, 5.000, 5.000, 5.000, &
+                 2.860, 4.550, 4.550/
+
+!
+! UPDATE TO H2O NEAR-IR: Rayleigh scattering optimized for Hitran 2K & CKD 2.4
+!
+   data raytau / 4.020, 2.180, 1.700, 1.450, 1.250, &
+                  1.085, 0.730, v_raytau_35, v_raytau_64, &
+                  0.02899756, 0.01356763, 0.00537341, &
+                  0.00228515, 0.00105028, 0.00046631, &
+                  0.00025734, &
+                 .0001, .0001, .0001/
+!
+! END UPDATE
+!
+
+! 
+! Absorption coefficients
+! 
+!
+! UPDATE TO H2O NEAR-IR: abh2o optimized for Hitran 2K and CKD 2.4
+!
+   data abh2o /    .000,     .000,    .000,    .000,    .000, &
+                   .000,     .000,    .000,    .000,    &
+                   0.00256608,  0.06310504,   0.42287445, 2.45397941, &
+                  11.20070807, 47.66091389, 240.19010243, &
+                   .000,    .000,    .000/
+!
+! END UPDATE
+!
+
+   data abo3  /5.370e+04, 13.080e+04,  9.292e+04, 4.530e+04, 1.616e+04, &
+               4.441e+03,  1.775e+02, v_abo3_35, v_abo3_64,      .000, &
+               .000,   .000    ,   .000   ,   .000   ,      .000, &
+               .000,   .000    ,   .000   ,   .000    /
+
+   data abco2  /   .000,     .000,    .000,    .000,    .000, &
+                   .000,     .000,    .000,    .000,    .000, &
+                   .000,     .000,    .000,    .000,    .000, &
+                   .000,     .094,    .196,   1.963/
+
+   data abo2  /    .000,     .000,    .000,    .000,    .000, &
+                   .000,     .000,    .000,1.11e-05,6.69e-05, &
+                   .000,     .000,    .000,    .000,    .000, &  
+                   .000,     .000,    .000,    .000/
+! 
+! Spectral interval weights
+! 
+   data ph2o  /    .000,     .000,    .000,    .000,    .000, &
+        .000,     .000,    .000,    .000,    .505,     &
+        .210,     .120,    .070,    .048,    .029,     &
+        .018,     .000,    .000,    .000/
+
+   data pco2  /    .000,     .000,    .000,    .000,    .000, &
+        .000,     .000,    .000,    .000,    .000,     &
+        .000,     .000,    .000,    .000,    .000,     &
+        .000,    1.000,    .640,    .360/
+
+   data po2   /    .000,     .000,    .000,    .000,    .000, &
+        .000,     .000,    .000,   1.000,   1.000,     &
+        .000,     .000,    .000,    .000,    .000,     &
+        .000,     .000,    .000,    .000/
+! 
+! Diagnostic and accumulation arrays; note that sfltot, fswup, and
+! fswdn are not used in the computation,but are retained for future use.
+! 
+   real(r8) solflx           ! Solar flux in current interval
+   real(r8) sfltot           ! Spectrally summed total solar flux
+   real(r8) totfld(0:pver)   ! Spectrally summed flux divergence
+   real(r8) fswup(0:pverp)   ! Spectrally summed up flux
+   real(r8) fswdn(0:pverp)   ! Spectrally summed down flux
+   real(r8) fswupc(0:pverp)  ! Spectrally summed up clear sky flux
+   real(r8) fswdnc(0:pverp)  ! Spectrally summed down clear sky flux
+! 
+! Cloud radiative property arrays
+! 
+!  real(r8) tauxcl(pcols,0:pver) ! water cloud extinction optical depth
+!  real(r8) tauxci(pcols,0:pver) ! ice cloud extinction optical depth
+   real(r8) wcl(pcols,0:pver) ! liquid cloud single scattering albedo
+   real(r8) gcl(pcols,0:pver) ! liquid cloud asymmetry parameter
+   real(r8) fcl(pcols,0:pver) ! liquid cloud forward scattered fraction
+   real(r8) wci(pcols,0:pver) ! ice cloud single scattering albedo
+   real(r8) gci(pcols,0:pver) ! ice cloud asymmetry parameter
+   real(r8) fci(pcols,0:pver) ! ice cloud forward scattered fraction
+!
+! Aerosol mass paths by species
+!
+  real(r8) usul(pcols,pver)   ! sulfate (SO4)
+  real(r8) ubg(pcols,pver)    ! background aerosol
+  real(r8) usslt(pcols,pver)  ! sea-salt (SSLT)
+  real(r8) ucphil(pcols,pver) ! hydrophilic organic carbon (OCPHI)
+  real(r8) ucphob(pcols,pver) ! hydrophobic organic carbon (OCPHO)
+  real(r8) ucb(pcols,pver)    ! black carbon (BCPHI + BCPHO)
+  real(r8) uvolc(pcols,pver) ! volcanic mass
+  real(r8) udst(ndstsz,pcols,pver) ! dust
+
+!
+! local variables used for the external mixing of aerosol species
+!
+  real(r8) tau_sul             ! optical depth, sulfate
+  real(r8) tau_bg              ! optical depth, background aerosol
+  real(r8) tau_sslt            ! optical depth, sea-salt
+  real(r8) tau_cphil           ! optical depth, hydrophilic carbon
+  real(r8) tau_cphob           ! optical depth, hydrophobic carbon
+  real(r8) tau_cb              ! optical depth, black carbon
+  real(r8) tau_volc            ! optical depth, volcanic
+  real(r8) tau_dst(ndstsz)     ! optical depth, dust, by size category
+  real(r8) tau_dst_tot         ! optical depth, total dust
+  real(r8) tau_tot             ! optical depth, total aerosol
+
+  real(r8) tau_w_sul           ! optical depth * single scattering albedo, sulfate
+  real(r8) tau_w_bg            ! optical depth * single scattering albedo, background aerosol
+  real(r8) tau_w_sslt          ! optical depth * single scattering albedo, sea-salt
+  real(r8) tau_w_cphil         ! optical depth * single scattering albedo, hydrophilic carbon
+  real(r8) tau_w_cphob         ! optical depth * single scattering albedo, hydrophobic carbon
+  real(r8) tau_w_cb            ! optical depth * single scattering albedo, black carbon
+  real(r8) tau_w_volc          ! optical depth * single scattering albedo, volcanic
+  real(r8) tau_w_dst(ndstsz)   ! optical depth * single scattering albedo, dust, by size
+  real(r8) tau_w_dst_tot       ! optical depth * single scattering albedo, total dust
+  real(r8) tau_w_tot           ! optical depth * single scattering albedo, total aerosol
+
+  real(r8) tau_w_g_sul         ! optical depth * single scattering albedo * asymmetry parameter, sulfate
+  real(r8) tau_w_g_bg          ! optical depth * single scattering albedo * asymmetry parameter, background aerosol
+  real(r8) tau_w_g_sslt        ! optical depth * single scattering albedo * asymmetry parameter, sea-salt
+  real(r8) tau_w_g_cphil       ! optical depth * single scattering albedo * asymmetry parameter, hydrophilic carbon
+  real(r8) tau_w_g_cphob       ! optical depth * single scattering albedo * asymmetry parameter, hydrophobic carbon
+  real(r8) tau_w_g_cb          ! optical depth * single scattering albedo * asymmetry parameter, black carbon
+  real(r8) tau_w_g_volc        ! optical depth * single scattering albedo * asymmetry parameter, volcanic
+  real(r8) tau_w_g_dst(ndstsz) ! optical depth * single scattering albedo * asymmetry parameter, dust, by size
+  real(r8) tau_w_g_dst_tot     ! optical depth * single scattering albedo * asymmetry parameter, total dust
+  real(r8) tau_w_g_tot         ! optical depth * single scattering albedo * asymmetry parameter, total aerosol
+
+  real(r8) f_sul               ! forward scattering fraction, sulfate
+  real(r8) f_bg                ! forward scattering fraction, background aerosol
+  real(r8) f_sslt              ! forward scattering fraction, sea-salt
+  real(r8) f_cphil             ! forward scattering fraction, hydrophilic carbon
+  real(r8) f_cphob             ! forward scattering fraction, hydrophobic carbon
+  real(r8) f_cb                ! forward scattering fraction, black carbon
+  real(r8) f_volc              ! forward scattering fraction, volcanic
+  real(r8) f_dst(ndstsz)       ! forward scattering fraction, dust, by size
+  real(r8) f_dst_tot           ! forward scattering fraction, total dust
+  real(r8) f_tot               ! forward scattering fraction, total aerosol
+
+  real(r8) tau_w_f_sul         ! optical depth * forward scattering fraction * single scattering albedo, sulfate
+  real(r8) tau_w_f_bg          ! optical depth * forward scattering fraction * single scattering albedo, background
+  real(r8) tau_w_f_sslt        ! optical depth * forward scattering fraction * single scattering albedo, sea-salt
+  real(r8) tau_w_f_cphil       ! optical depth * forward scattering fraction * single scattering albedo, hydrophilic C
+  real(r8) tau_w_f_cphob       ! optical depth * forward scattering fraction * single scattering albedo, hydrophobic C
+  real(r8) tau_w_f_cb          ! optical depth * forward scattering fraction * single scattering albedo, black C
+  real(r8) tau_w_f_volc        ! optical depth * forward scattering fraction * single scattering albedo, volcanic
+  real(r8) tau_w_f_dst(ndstsz) ! optical depth * forward scattering fraction * single scattering albedo, dust, by size
+  real(r8) tau_w_f_dst_tot     ! optical depth * forward scattering fraction * single scattering albedo, total dust
+  real(r8) tau_w_f_tot         ! optical depth * forward scattering fraction * single scattering albedo, total aerosol
+  real(r8) w_dst_tot           ! single scattering albedo, total dust
+  real(r8) w_tot               ! single scattering albedo, total aerosol
+  real(r8) g_dst_tot           ! asymmetry parameter, total dust
+  real(r8) g_tot               ! asymmetry parameter, total aerosol
+  real(r8) ksuli               ! specific extinction interpolated between rh look-up-table points, sulfate
+  real(r8) ksslti              ! specific extinction interpolated between rh look-up-table points, sea-salt
+  real(r8) kcphili             ! specific extinction interpolated between rh look-up-table points, hydrophilic carbon
+  real(r8) wsuli               ! single scattering albedo interpolated between rh look-up-table points, sulfate
+  real(r8) wsslti              ! single scattering albedo interpolated between rh look-up-table points, sea-salt
+  real(r8) wcphili             ! single scattering albedo interpolated between rh look-up-table points, hydrophilic carbon
+  real(r8) gsuli               ! asymmetry parameter interpolated between rh look-up-table points, sulfate
+  real(r8) gsslti              ! asymmetry parameter interpolated between rh look-up-table points, sea-salt
+  real(r8) gcphili             ! asymmetry parameter interpolated between rh look-up-table points, hydrophilic carbon
+! 
+! Aerosol radiative property arrays
+! 
+   real(r8) tauxar(pcols,0:pver) ! aerosol extinction optical depth
+   real(r8) wa(pcols,0:pver) ! aerosol single scattering albedo
+   real(r8) ga(pcols,0:pver) ! aerosol assymetry parameter
+   real(r8) fa(pcols,0:pver) ! aerosol forward scattered fraction
+
+! 
+! Various arrays and other constants:
+! 
+   real(r8) pflx(pcols,0:pverp) ! Interface press, including extra layer
+   real(r8) zenfac(pcols)    ! Square root of cos solar zenith angle
+   real(r8) sqrco2           ! Square root of the co2 mass mixg ratio
+   real(r8) tmp1             ! Temporary constant array
+   real(r8) tmp2             ! Temporary constant array
+   real(r8) pdel             ! Pressure difference across layer
+   real(r8) path             ! Mass path of layer
+   real(r8) ptop             ! Lower interface pressure of extra layer
+   real(r8) ptho2            ! Used to compute mass path of o2
+   real(r8) ptho3            ! Used to compute mass path of o3
+   real(r8) pthco2           ! Used to compute mass path of co2
+   real(r8) pthh2o           ! Used to compute mass path of h2o
+   real(r8) h2ostr           ! Inverse sq. root h2o mass mixing ratio
+   real(r8) wavmid(nspint)   ! Spectral interval middle wavelength
+   real(r8) trayoslp         ! Rayleigh optical depth/standard pressure
+   real(r8) tmp1l            ! Temporary constant array
+   real(r8) tmp2l            ! Temporary constant array
+   real(r8) tmp3l            ! Temporary constant array
+   real(r8) tmp1i            ! Temporary constant array
+   real(r8) tmp2i            ! Temporary constant array
+   real(r8) tmp3i            ! Temporary constant array
+   real(r8) rdenom           ! Multiple scattering term
+   real(r8) rdirexp          ! layer direct ref times exp transmission
+   real(r8) tdnmexp          ! total transmission - exp transmission
+   real(r8) psf(nspint)      ! Frac of solar flux in spect interval
+! 
+! Layer absorber amounts; note that 0 refers to the extra layer added
+! above the top model layer
+! 
+   real(r8) uh2o(pcols,0:pver) ! Layer absorber amount of h2o
+   real(r8) uo3(pcols,0:pver) ! Layer absorber amount of  o3
+   real(r8) uco2(pcols,0:pver) ! Layer absorber amount of co2
+   real(r8) uo2(pcols,0:pver) ! Layer absorber amount of  o2
+   real(r8) uaer(pcols,0:pver) ! Layer aerosol amount 
+! 
+! Total column absorber amounts:
+! 
+   real(r8) uth2o(pcols)     ! Total column  absorber amount of  h2o
+   real(r8) uto3(pcols)      ! Total column  absorber amount of  o3
+   real(r8) utco2(pcols)     ! Total column  absorber amount of  co2
+   real(r8) uto2(pcols)      ! Total column  absorber amount of  o2
+! 
+! These arrays are defined for pver model layers; 0 refers to the extra
+! layer on top:
+! 
+   real(r8) rdir(nspint,pcols,0:pver) ! Layer reflectivity to direct rad
+   real(r8) rdif(nspint,pcols,0:pver) ! Layer reflectivity to diffuse rad
+   real(r8) tdir(nspint,pcols,0:pver) ! Layer transmission to direct rad
+   real(r8) tdif(nspint,pcols,0:pver) ! Layer transmission to diffuse rad
+   real(r8) explay(nspint,pcols,0:pver) ! Solar beam exp trans. for layer
+
+   real(r8) rdirc(nspint,pcols,0:pver) ! Clear Layer reflec. to direct rad
+   real(r8) rdifc(nspint,pcols,0:pver) ! Clear Layer reflec. to diffuse rad
+   real(r8) tdirc(nspint,pcols,0:pver) ! Clear Layer trans. to direct rad
+   real(r8) tdifc(nspint,pcols,0:pver) ! Clear Layer trans. to diffuse rad
+   real(r8) explayc(nspint,pcols,0:pver) ! Solar beam exp trans. clear layer
+
+   real(r8) flxdiv           ! Flux divergence for layer
+! 
+! 
+! Radiative Properties:
+! 
+! There are 1 classes of properties:
+! (1. All-sky bulk properties
+! (2. Clear-sky properties
+! 
+! The first set of properties are generated during step 2 of the solution.
+! 
+! These arrays are defined at model interfaces; in 1st index (for level #),
+! 0 is the top of the extra layer above the model top, and
+! pverp is the earth surface.  2nd index is for cloud configuration
+! defined over a whole column.
+! 
+   real(r8) exptdn(0:pverp,nconfgmax) ! Sol. beam trans from layers above
+   real(r8) rdndif(0:pverp,nconfgmax) ! Ref to dif rad for layers above
+   real(r8) rupdif(0:pverp,nconfgmax) ! Ref to dif rad for layers below
+   real(r8) rupdir(0:pverp,nconfgmax) ! Ref to dir rad for layers below
+   real(r8) tdntot(0:pverp,nconfgmax) ! Total trans for layers above
+! 
+! Bulk properties used during the clear-sky calculation.
+! 
+   real(r8) exptdnc(0:pverp) ! clr: Sol. beam trans from layers above
+   real(r8) rdndifc(0:pverp) ! clr: Ref to dif rad for layers above
+   real(r8) rupdifc(0:pverp) ! clr: Ref to dif rad for layers below
+   real(r8) rupdirc(0:pverp) ! clr: Ref to dir rad for layers below
+   real(r8) tdntotc(0:pverp) ! clr: Total trans for layers above
+
+   real(r8) fluxup(0:pverp)  ! Up   flux at model interface
+   real(r8) fluxdn(0:pverp)  ! Down flux at model interface
+   real(r8) wexptdn          ! Direct solar beam trans. to surface
+
+! 
+!-----------------------------------------------------------------------
+! START OF CALCULATION
+!-----------------------------------------------------------------------
+! 
+!  write (6, '(a, x, i3)') 'radcswmx : chunk identifier', lchnk
+
+   do i=1, ncol
+! 
+! Initialize output fields:
+! 
+      fsds(i)     = 0.0_r8
+
+      fsnirtoa(i) = 0.0_r8
+      fsnrtoac(i) = 0.0_r8
+      fsnrtoaq(i) = 0.0_r8
+
+      fsns(i)     = 0.0_r8
+      fsnsc(i)    = 0.0_r8
+      fsdsc(i)    = 0.0_r8
+
+      fsnt(i)     = 0.0_r8
+      fsntc(i)    = 0.0_r8
+      fsntoa(i)   = 0.0_r8
+      fsntoac(i)  = 0.0_r8
+
+      solin(i)    = 0.0_r8
+
+      sols(i)     = 0.0_r8
+      soll(i)     = 0.0_r8
+      solsd(i)    = 0.0_r8
+      solld(i)    = 0.0_r8
+
+! initialize added downward/upward total and clear sky fluxes
+
+         do k=1,pverp
+            fsup(i,k)  = 0.0_r8
+            fsupc(i,k) = 0.0_r8
+            fsdn(i,k)  = 0.0_r8
+            fsdnc(i,k) = 0.0_r8
+            tauxcl(i,k-1) = 0.0_r8
+            tauxci(i,k-1) = 0.0_r8
+         end do
+
+      do k=1, pver
+         qrs(i,k) = 0.0_r8
+      end do
+
+      ! initialize aerosol diagnostic fields to 0.0 
+      ! Average can be obtained by dividing <aerod>/<frc_day>
+      do kaer = 1, naer_groups
+         do ns = 1, nspint
+            frc_day(i) = 0.0_r8
+            aertau(i,ns,kaer) = 0.0_r8
+            aerssa(i,ns,kaer) = 0.0_r8
+            aerasm(i,ns,kaer) = 0.0_r8
+            aerfwd(i,ns,kaer) = 0.0_r8
+         end do
+      end do
+
+   end do
+! 
+! Compute starting, ending daytime loop indices:
+!  *** Note this logic assumes day and night points are contiguous so
+!  *** will not work in general with chunked data structure.
+! 
+   ndayc = 0
+   do i=1,ncol
+      if (coszrs(i) > 0.0_r8) then
+         ndayc = ndayc + 1
+         idayc(ndayc) = i
+      end if
+   end do
+! 
+! If night everywhere, return:
+! 
+   if (ndayc == 0) return
+! 
+! Perform other initializations
+! 
+   tmp1   = 0.5_r8/(gravit*sslp)
+   tmp2   = delta/gravit
+   sqrco2 = sqrt(co2mmr)
+
+   do n=1,ndayc
+      i=idayc(n)
+! 
+! Define solar incident radiation and interface pressures:
+! 
+!        solin(i)  = scon*eccf*coszrs(i)
+!WRF use SOLCON (MKS) calculated outside
+         solin(i)  = solcon*coszrs(i)*1000.
+         pflx(i,0) = 0._r8
+         do k=1,pverp
+            pflx(i,k) = pint(i,k)
+         end do
+! 
+! Compute optical paths:
+! 
+         ptop      = pflx(i,1)
+         ptho2     = o2mmr * ptop / gravit
+         ptho3     = o3mmr(i,1) * ptop / gravit
+         pthco2    = sqrco2 * (ptop / gravit)
+         h2ostr    = sqrt( 1._r8 / h2ommr(i,1) )
+         zenfac(i) = sqrt(coszrs(i))
+         pthh2o    = ptop**2*tmp1 + (ptop*rga)* &
+                    (h2ostr*zenfac(i)*delta)
+         uh2o(i,0) = h2ommr(i,1)*pthh2o
+         uco2(i,0) = zenfac(i)*pthco2
+         uo2 (i,0) = zenfac(i)*ptho2
+         uo3 (i,0) = ptho3
+         uaer(i,0) = 0.0_r8
+         do k=1,pver
+            pdel      = pflx(i,k+1) - pflx(i,k)
+            path      = pdel / gravit
+            ptho2     = o2mmr * path
+            ptho3     = o3mmr(i,k) * path
+            pthco2    = sqrco2 * path
+            h2ostr    = sqrt(1.0_r8/h2ommr(i,k))
+            pthh2o    = (pflx(i,k+1)**2 - pflx(i,k)**2)*tmp1 + pdel*h2ostr*zenfac(i)*tmp2
+            uh2o(i,k) = h2ommr(i,k)*pthh2o
+            uco2(i,k) = zenfac(i)*pthco2
+            uo2 (i,k) = zenfac(i)*ptho2
+            uo3 (i,k) = ptho3
+            usul(i,k) = aermmr(i,k,idxSUL) * path 
+            ubg(i,k) = aermmr(i,k,idxBG) * path 
+            usslt(i,k) = aermmr(i,k,idxSSLT) * path
+            if (usslt(i,k) .lt. 0.0) then  ! usslt is sometimes small and negative, will be fixed
+              usslt(i,k) = 0.0
+            end if
+            ucphil(i,k) = aermmr(i,k,idxOCPHI) * path
+            ucphob(i,k) = aermmr(i,k,idxOCPHO) * path
+            ucb(i,k) = ( aermmr(i,k,idxBCPHO) + aermmr(i,k,idxBCPHI) ) * path
+            uvolc(i,k) =  aermmr(i,k,idxVOLC)
+            do ksz = 1, ndstsz
+              udst(ksz,i,k) = aermmr(i,k,idxDUSTfirst-1+ksz) * path
+            end do
+         end do
+! 
+! Compute column absorber amounts for the clear sky computation:
+! 
+         uth2o(i) = 0.0_r8
+         uto3(i)  = 0.0_r8
+         utco2(i) = 0.0_r8
+         uto2(i)  = 0.0_r8
+
+         do k=1,pver
+            uth2o(i) = uth2o(i) + uh2o(i,k)
+            uto3(i)  = uto3(i)  + uo3(i,k)
+            utco2(i) = utco2(i) + uco2(i,k)
+            uto2(i)  = uto2(i)  + uo2(i,k)
+         end do
+! 
+! Set cloud properties for top (0) layer; so long as tauxcl is zero,
+! there is no cloud above top of model; the other cloud properties
+! are arbitrary:
+! 
+         tauxcl(i,0)  = 0._r8
+         wcl(i,0)     = 0.999999_r8
+         gcl(i,0)     = 0.85_r8
+         fcl(i,0)     = 0.725_r8
+         tauxci(i,0)  = 0._r8
+         wci(i,0)     = 0.999999_r8
+         gci(i,0)     = 0.85_r8
+         fci(i,0)     = 0.725_r8
+! 
+! Aerosol 
+! 
+         tauxar(i,0)  = 0._r8
+         wa(i,0)      = 0.925_r8
+         ga(i,0)      = 0.850_r8
+         fa(i,0)      = 0.7225_r8
+! 
+! End  do n=1,ndayc
+! 
+   end do
+! 
+! Begin spectral loop
+! 
+   do ns=1,nspint
+! 
+! Set index for cloud particle properties based on the wavelength,
+! according to A. Slingo (1989) equations 1-3:
+! Use index 1 (0.25 to 0.69 micrometers) for visible
+! Use index 2 (0.69 - 1.19 micrometers) for near-infrared
+! Use index 3 (1.19 to 2.38 micrometers) for near-infrared
+! Use index 4 (2.38 to 4.00 micrometers) for near-infrared
+! 
+! Note that the minimum wavelength is encoded (with .001, .002, .003)
+! in order to specify the index appropriate for the near-infrared
+! cloud absorption properties
+! 
+      if(wavmax(ns) <= 0.7_r8) then
+         indxsl = 1
+      else if(wavmin(ns) == 0.700_r8) then
+         indxsl = 2
+      else if(wavmin(ns) == 0.701_r8) then
+         indxsl = 3
+      else if(wavmin(ns) == 0.702_r8 .or. wavmin(ns) > 2.38_r8) then
+         indxsl = 4
+      end if
+! 
+! Set cloud extinction optical depth, single scatter albedo,
+! asymmetry parameter, and forward scattered fraction:
+! 
+      abarli = abarl(indxsl)
+      bbarli = bbarl(indxsl)
+      cbarli = cbarl(indxsl)
+      dbarli = dbarl(indxsl)
+      ebarli = ebarl(indxsl)
+      fbarli = fbarl(indxsl)
+! 
+      abarii = abari(indxsl)
+      bbarii = bbari(indxsl)
+      cbarii = cbari(indxsl)
+      dbarii = dbari(indxsl)
+      ebarii = ebari(indxsl)
+      fbarii = fbari(indxsl)
+! 
+! adjustfraction within spectral interval to allow for the possibility of
+! sub-divisions within a particular interval:
+! 
+      psf(ns) = 1.0_r8
+      if(ph2o(ns)/=0._r8) psf(ns) = psf(ns)*ph2o(ns)
+      if(pco2(ns)/=0._r8) psf(ns) = psf(ns)*pco2(ns)
+      if(po2 (ns)/=0._r8) psf(ns) = psf(ns)*po2 (ns)
+
+      do n=1,ndayc
+         i=idayc(n)
+
+         frc_day(i) = 1.0_r8
+         do kaer = 1, naer_groups
+            aertau(i,ns,kaer) = 0.0
+            aerssa(i,ns,kaer) = 0.0
+            aerasm(i,ns,kaer) = 0.0
+            aerfwd(i,ns,kaer) = 0.0
+         end do
+
+            do k=1,pver
+! 
+! liquid
+! 
+               tmp1l = abarli + bbarli/rel(i,k)
+               tmp2l = 1._r8 - cbarli - dbarli*rel(i,k)
+               tmp3l = fbarli*rel(i,k)
+! 
+! ice
+! 
+               tmp1i = abarii + bbarii/rei(i,k)
+               tmp2i = 1._r8 - cbarii - dbarii*rei(i,k)
+               tmp3i = fbarii*rei(i,k)
+
+               if (cld(i,k) >= cldmin .and. cld(i,k) >= cldeps) then
+                  tauxcl(i,k) = cliqwp(i,k)*tmp1l
+                  tauxci(i,k) = cicewp(i,k)*tmp1i
+               else
+                  tauxcl(i,k) = 0.0
+                  tauxci(i,k) = 0.0
+               endif
+! 
+! Do not let single scatter albedo be 1.  Delta-eddington solution
+! for non-conservative case has different analytic form from solution
+! for conservative case, and raddedmx is written for non-conservative case.
+! 
+               wcl(i,k) = min(tmp2l,.999999_r8)
+               gcl(i,k) = ebarli + tmp3l
+               fcl(i,k) = gcl(i,k)*gcl(i,k)
+! 
+               wci(i,k) = min(tmp2i,.999999_r8)
+               gci(i,k) = ebarii + tmp3i
+               fci(i,k) = gci(i,k)*gci(i,k)
+! 
+! Set aerosol properties
+! Conversion factor to adjust aerosol extinction (m2/g)
+! 
+               rhtrunc = rh(i,k)
+               rhtrunc = min(rh(i,k),1._r8)
+!              if(rhtrunc.lt.0._r8) call endrun ('RADCSWMX')
+               krh = min(floor( rhtrunc * nrh ) + 1, nrh - 1)
+               wrh = rhtrunc * nrh - krh
+
+               ! linear interpolation of optical properties between rh table points
+               ksuli = ksul(krh + 1, ns) * (wrh + 1) - ksul(krh, ns) * wrh
+               ksslti = ksslt(krh + 1, ns) * (wrh + 1) - ksslt(krh, ns) * wrh
+               kcphili = kcphil(krh + 1, ns) * (wrh + 1) - kcphil(krh, ns) * wrh
+               wsuli = wsul(krh + 1, ns) * (wrh + 1) - wsul(krh, ns) * wrh
+               wsslti = wsslt(krh + 1, ns) * (wrh + 1) - wsslt(krh, ns) * wrh
+               wcphili = wcphil(krh + 1, ns) * (wrh + 1) - wcphil(krh, ns) * wrh
+               gsuli = gsul(krh + 1, ns) * (wrh + 1) - gsul(krh, ns) * wrh
+               gsslti = gsslt(krh + 1, ns) * (wrh + 1) - gsslt(krh, ns) * wrh
+               gcphili = gcphil(krh + 1, ns) * (wrh + 1) - gcphil(krh, ns) * wrh
+
+               tau_sul = 1.e4 * ksuli * usul(i,k)
+               tau_sslt = 1.e4 * ksslti * usslt(i,k)
+               tau_cphil = 1.e4 * kcphili * ucphil(i,k)
+               tau_cphob = 1.e4 * kcphob(ns) * ucphob(i,k)
+               tau_cb = 1.e4 * kcb(ns) * ucb(i,k)
+               tau_volc = 1.e3 * kvolc(ns) * uvolc(i,k)
+               tau_dst(:) = 1.e4 * kdst(:,ns) * udst(:,i,k)
+               tau_bg = 1.e4 * kbg(ns) * ubg(i,k)
+
+               tau_w_sul = tau_sul * wsuli
+               tau_w_sslt = tau_sslt * wsslti
+               tau_w_cphil = tau_cphil * wcphili
+               tau_w_cphob = tau_cphob * wcphob(ns)
+               tau_w_cb = tau_cb * wcb(ns)
+               tau_w_volc = tau_volc * wvolc(ns)
+               tau_w_dst(:) = tau_dst(:) * wdst(:,ns)
+               tau_w_bg = tau_bg * wbg(ns)
+
+               tau_w_g_sul = tau_w_sul * gsuli
+               tau_w_g_sslt = tau_w_sslt * gsslti
+               tau_w_g_cphil = tau_w_cphil * gcphili
+               tau_w_g_cphob = tau_w_cphob * gcphob(ns)
+               tau_w_g_cb = tau_w_cb * gcb(ns)
+               tau_w_g_volc = tau_w_volc * gvolc(ns)
+               tau_w_g_dst(:) = tau_w_dst(:) * gdst(:,ns)
+               tau_w_g_bg = tau_w_bg * gbg(ns)
+
+               f_sul = gsuli * gsuli
+               f_sslt = gsslti * gsslti
+               f_cphil = gcphili * gcphili
+               f_cphob = gcphob(ns) * gcphob(ns)
+               f_cb = gcb(ns) * gcb(ns)
+               f_volc = gvolc(ns) * gvolc(ns)
+               f_dst(:) = gdst(:,ns) * gdst(:,ns)
+               f_bg = gbg(ns) * gbg(ns)
+
+               tau_w_f_sul = tau_w_sul * f_sul
+               tau_w_f_bg = tau_w_bg * f_bg
+               tau_w_f_sslt = tau_w_sslt * f_sslt
+               tau_w_f_cphil = tau_w_cphil * f_cphil
+               tau_w_f_cphob = tau_w_cphob * f_cphob
+               tau_w_f_cb = tau_w_cb * f_cb
+               tau_w_f_volc = tau_w_volc * f_volc
+               tau_w_f_dst(:) = tau_w_dst(:) * f_dst(:)
+!
+! mix dust aerosol size bins
+!   w_dst_tot, g_dst_tot, w_dst_tot are currently not used anywhere
+!   but calculate them anyway for future use
+!
+               tau_dst_tot = sum(tau_dst)
+               tau_w_dst_tot = sum(tau_w_dst)
+               tau_w_g_dst_tot = sum(tau_w_g_dst)
+               tau_w_f_dst_tot = sum(tau_w_f_dst)
+
+               if (tau_dst_tot .gt. 0.0) then
+                 w_dst_tot = tau_w_dst_tot / tau_dst_tot
+               else
+                 w_dst_tot = 0.0
+               endif
+
+               if (tau_w_dst_tot .gt. 0.0) then
+                 g_dst_tot = tau_w_g_dst_tot / tau_w_dst_tot
+                 f_dst_tot = tau_w_f_dst_tot / tau_w_dst_tot
+               else
+                 g_dst_tot = 0.0
+                 f_dst_tot = 0.0
+               endif
+!
+! mix aerosols
+!
+               tau_tot     = tau_sul + tau_sslt &
+                           + tau_cphil + tau_cphob + tau_cb + tau_dst_tot
+               tau_tot     = tau_tot + tau_bg + tau_volc
+
+               tau_w_tot   = tau_w_sul + tau_w_sslt &
+                           + tau_w_cphil + tau_w_cphob + tau_w_cb + tau_w_dst_tot
+               tau_w_tot   = tau_w_tot + tau_w_bg + tau_w_volc
+
+               tau_w_g_tot = tau_w_g_sul + tau_w_g_sslt &
+                           + tau_w_g_cphil + tau_w_g_cphob + tau_w_g_cb + tau_w_g_dst_tot
+               tau_w_g_tot = tau_w_g_tot + tau_w_g_bg + tau_w_g_volc
+
+               tau_w_f_tot = tau_w_f_sul + tau_w_f_sslt &
+                           + tau_w_f_cphil + tau_w_f_cphob + tau_w_f_cb + tau_w_f_dst_tot
+               tau_w_f_tot = tau_w_f_tot + tau_w_f_bg  + tau_w_f_volc
+
+               if (tau_tot .gt. 0.0) then
+                 w_tot = tau_w_tot / tau_tot
+               else
+                 w_tot = 0.0
+               endif
+
+               if (tau_w_tot .gt. 0.0) then
+                 g_tot = tau_w_g_tot / tau_w_tot
+                 f_tot = tau_w_f_tot / tau_w_tot
+               else
+                 g_tot = 0.0
+                 f_tot = 0.0
+               endif
+
+               tauxar(i,k) = tau_tot
+               wa(i,k)     = min(w_tot, 0.999999_r8)
+               if (g_tot.gt.1._r8) write(6,*) "g_tot > 1"
+               if (g_tot.lt.-1._r8) write(6,*) "g_tot < -1"
+!              if (g_tot.gt.1._r8) call endrun ('RADCSWMX')
+!              if (g_tot.lt.-1._r8) call endrun ('RADCSWMX')
+               ga(i,k)     = g_tot
+               if (f_tot.gt.1._r8) write(6,*)"f_tot > 1"
+               if (f_tot.lt.0._r8) write(6,*)"f_tot < 0"
+!              if (f_tot.gt.1._r8) call endrun ('RADCSWMX')
+!              if (f_tot.lt.0._r8) call endrun ('RADCSWMX')
+               fa(i,k)     = f_tot
+
+               aertau(i,ns,1) = aertau(i,ns,1) + tau_sul
+               aertau(i,ns,2) = aertau(i,ns,2) + tau_sslt
+               aertau(i,ns,3) = aertau(i,ns,3) + tau_cphil + tau_cphob + tau_cb
+               aertau(i,ns,4) = aertau(i,ns,4) + tau_dst_tot
+               aertau(i,ns,5) = aertau(i,ns,5) + tau_bg
+               aertau(i,ns,6) = aertau(i,ns,6) + tau_volc
+               aertau(i,ns,7) = aertau(i,ns,7) + tau_tot
+
+               aerssa(i,ns,1) = aerssa(i,ns,1) + tau_w_sul
+               aerssa(i,ns,2) = aerssa(i,ns,2) + tau_w_sslt
+               aerssa(i,ns,3) = aerssa(i,ns,3) + tau_w_cphil + tau_w_cphob + tau_w_cb
+               aerssa(i,ns,4) = aerssa(i,ns,4) + tau_w_dst_tot
+               aerssa(i,ns,5) = aerssa(i,ns,5) + tau_w_bg
+               aerssa(i,ns,6) = aerssa(i,ns,6) + tau_w_volc
+               aerssa(i,ns,7) = aerssa(i,ns,7) + tau_w_tot
+
+               aerasm(i,ns,1) = aerasm(i,ns,1) + tau_w_g_sul
+               aerasm(i,ns,2) = aerasm(i,ns,2) + tau_w_g_sslt
+               aerasm(i,ns,3) = aerasm(i,ns,3) + tau_w_g_cphil + tau_w_g_cphob + tau_w_g_cb
+               aerasm(i,ns,4) = aerasm(i,ns,4) + tau_w_g_dst_tot
+               aerasm(i,ns,5) = aerasm(i,ns,5) + tau_w_g_bg
+               aerasm(i,ns,6) = aerasm(i,ns,6) + tau_w_g_volc
+               aerasm(i,ns,7) = aerasm(i,ns,7) + tau_w_g_tot
+
+               aerfwd(i,ns,1) = aerfwd(i,ns,1) + tau_w_f_sul
+               aerfwd(i,ns,2) = aerfwd(i,ns,2) + tau_w_f_sslt
+               aerfwd(i,ns,3) = aerfwd(i,ns,3) + tau_w_f_cphil + tau_w_f_cphob + tau_w_f_cb
+               aerfwd(i,ns,4) = aerfwd(i,ns,4) + tau_w_f_dst_tot
+               aerfwd(i,ns,5) = aerfwd(i,ns,5) + tau_w_f_bg
+               aerfwd(i,ns,6) = aerfwd(i,ns,6) + tau_w_f_volc
+               aerfwd(i,ns,7) = aerfwd(i,ns,7) + tau_w_f_tot
+
+! 
+! End do k=1,pver
+! 
+            end do
+
+            ! normalize aerosol optical diagnostic fields
+            do kaer = 1, naer_groups
+
+               if (aerssa(i,ns,kaer) .gt. 0.0) then   ! aerssa currently holds product of tau and ssa
+                  aerasm(i,ns,kaer) = aerasm(i,ns,kaer) / aerssa(i,ns,kaer)
+                  aerfwd(i,ns,kaer) = aerfwd(i,ns,kaer) / aerssa(i,ns,kaer)
+               else
+                  aerasm(i,ns,kaer) = 0.0_r8
+                  aerfwd(i,ns,kaer) = 0.0_r8
+               end if
+
+               if (aertau(i,ns,kaer) .gt. 0.0) then
+                  aerssa(i,ns,kaer) = aerssa(i,ns,kaer) / aertau(i,ns,kaer)
+               else
+                  aerssa(i,ns,kaer) = 0.0_r8
+               end if
+
+            end do
+
+
+! 
+! End do n=1,ndayc
+! 
+      end do
+
+! 
+! Set reflectivities for surface based on mid-point wavelength
+! 
+      wavmid(ns) = 0.5_r8*(wavmin(ns) + wavmax(ns))
+! 
+! Wavelength less  than 0.7 micro-meter
+! 
+      if (wavmid(ns) < 0.7_r8 ) then
+         do n=1,ndayc
+            i=idayc(n)
+               albdir(i,ns) = asdir(i)
+               albdif(i,ns) = asdif(i)
+         end do
+! 
+! Wavelength greater than 0.7 micro-meter
+! 
+      else
+         do n=1,ndayc
+            i=idayc(n)
+               albdir(i,ns) = aldir(i)
+               albdif(i,ns) = aldif(i)
+         end do
+      end if
+      trayoslp = raytau(ns)/sslp
+! 
+! Layer input properties now completely specified; compute the
+! delta-Eddington solution reflectivities and transmissivities
+! for each layer
+! 
+      call raddedmx(pver, pverp, pcols, coszrs   ,ndayc    ,idayc   , &
+              abh2o(ns),abo3(ns) ,abco2(ns),abo2(ns) , &
+              uh2o     ,uo3      ,uco2     ,uo2      , &
+              trayoslp ,pflx     ,ns       , &
+              tauxcl   ,wcl      ,gcl      ,fcl      , &
+              tauxci   ,wci      ,gci      ,fci      , &
+              tauxar   ,wa       ,ga       ,fa       , &
+              rdir     ,rdif     ,tdir     ,tdif     ,explay  , &
+              rdirc    ,rdifc    ,tdirc    ,tdifc    ,explayc )
+! 
+! End spectral loop
+! 
+   end do
+! 
+!----------------------------------------------------------------------
+! 
+! Solution for max/random cloud overlap.  
+! 
+! Steps:
+! (1. delta-Eddington solution for each layer (called above)
+! 
+! (2. The adding method is used to
+! compute the reflectivity and transmissivity to direct and diffuse
+! radiation from the top and bottom of the atmosphere for each
+! cloud configuration.  This calculation is based upon the
+! max-random overlap assumption.
+! 
+! (3. to solve for the fluxes, combine the
+! bulk properties of the atmosphere above/below the region.
+! 
+! Index calculations for steps 2-3 are performed outside spectral
+! loop to avoid redundant calculations.  Index calculations (with
+! application of areamin & nconfgmax conditions) are performed 
+! first to identify the minimum subset of terms for the configurations 
+! satisfying the areamin & nconfgmax conditions. This minimum set is 
+! used to identify the corresponding minimum subset of terms in 
+! steps 2 and 3.
+! 
+
+   do n=1,ndayc
+      i=idayc(n)
+
+!----------------------------------------------------------------------
+! INDEX CALCULATIONS FOR MAX OVERLAP
+! 
+! The column is divided into sets of adjacent layers, called regions, 
+! in which the clouds are maximally overlapped.  The clouds are
+! randomly overlapped between different regions.  The number of
+! regions in a column is set by nmxrgn, and the range of pressures
+! included in each region is set by pmxrgn.  
+! 
+! The following calculations determine the number of unique cloud 
+! configurations (assuming maximum overlap), called "streams",
+! within each region. Each stream consists of a vector of binary
+! clouds (either 0 or 100% cloud cover).  Over the depth of the region, 
+! each stream requires a separate calculation of radiative properties. These
+! properties are generated using the adding method from
+! the radiative properties for each layer calculated by raddedmx.
+! 
+! The upward and downward-propagating streams are treated
+! separately.
+! 
+! We will refer to a particular configuration of binary clouds
+! within a single max-overlapped region as a "stream".  We will 
+! refer to a particular arrangement of binary clouds over the entire column
+! as a "configuration".
+! 
+! This section of the code generates the following information:
+! (1. nrgn    : the true number of max-overlap regions (need not = nmxrgn)
+! (2. nstr    : the number of streams in a region (>=1)
+! (3. cstr    : flags for presence of clouds at each layer in each stream
+! (4. wstr    : the fractional horizontal area of a grid box covered
+! by each stream
+! (5. kx1,2   : level indices for top/bottom of each region
+! 
+! The max-overlap calculation proceeds in 3 stages:
+! (1. compute layer radiative properties in raddedmx.
+! (2. combine these properties between layers 
+! (3. combine properties to compute fluxes at each interface.  
+! 
+! Most of the indexing information calculated here is used in steps 2-3
+! after the call to raddedmx.
+! 
+! Initialize indices for layers to be max-overlapped
+! 
+! Loop to handle fix in totwgt=0. For original overlap config 
+! from npasses = 0.
+! 
+         npasses = 0
+         do
+            do irgn = 0, nmxrgn(i)
+               kx2(irgn) = 0
+            end do
+            mrgn = 0
+! 
+! Outermost loop over regions (sets of adjacent layers) to be max overlapped
+! 
+            do irgn = 1, nmxrgn(i)
+! 
+! Calculate min/max layer indices inside region.  
+! 
+               region_found = .false.
+               if (kx2(irgn-1) < pver) then
+                  k1 = kx2(irgn-1)+1
+                  kx1(irgn) = k1
+                  kx2(irgn) = k1-1
+                  do k2 = pver, k1, -1
+                     if (pmid(i,k2) <= pmxrgn(i,irgn)) then
+                        kx2(irgn) = k2
+                        mrgn = mrgn+1
+                        region_found = .true.
+                        exit
+                     end if
+                  end do
+               else
+                  exit
+               endif
+
+               if (region_found) then
+! 
+! Sort cloud areas and corresponding level indices.  
+! 
+                  nxs = 0
+                  if (cldeps > 0) then 
+                     do k = k1,k2
+                        if (cld(i,k) >= cldmin .and. cld(i,k) >= cldeps) then
+                           nxs = nxs+1
+                           ksort(nxs) = k
+! 
+! We need indices for clouds in order of largest to smallest, so
+! sort 1-cld in ascending order
+! 
+                           asort(nxs) = 1.0_r8-(floor(cld(i,k)/cldeps)*cldeps)
+                        end if
+                     end do
+                  else
+                     do k = k1,k2
+                        if (cld(i,k) >= cldmin) then
+                           nxs = nxs+1
+                           ksort(nxs) = k
+! 
+! We need indices for clouds in order of largest to smallest, so
+! sort 1-cld in ascending order
+! 
+                           asort(nxs) = 1.0_r8-cld(i,k)
+                        end if
+                     end do
+                  endif
+! 
+! If nxs eq 1, no need to sort. 
+! If nxs eq 2, sort by swapping if necessary
+! If nxs ge 3, sort using local sort routine
+! 
+                  if (nxs == 2) then
+                     if (asort(2) < asort(1)) then
+                        ktmp = ksort(1)
+                        ksort(1) = ksort(2)
+                        ksort(2) = ktmp
+
+                        atmp = asort(1)
+                        asort(1) = asort(2)
+                        asort(2) = atmp
+                     endif
+                  else if (nxs >= 3) then
+                     call sortarray(nxs,asort,ksort)
+                  endif
+! 
+! Construct wstr, cstr, nstr for this region
+! 
+                  cstr(k1:k2,1:nxs+1) = 0
+                  mstr = 1
+                  cld0 = 0.0_r8
+                  do l = 1, nxs
+                     if (asort(l) /= cld0) then
+                        wstr(mstr,mrgn) = asort(l) - cld0
+                        cld0 = asort(l)
+                        mstr = mstr + 1
+                     endif
+                     cstr(ksort(l),mstr:nxs+1) = 1
+                  end do
+                  nstr(mrgn) = mstr
+                  wstr(mstr,mrgn) = 1.0_r8 - cld0
+! 
+! End test of region_found = true
+! 
+               endif
+! 
+! End loop over regions irgn for max-overlap
+! 
+            end do
+            nrgn = mrgn
+! 
+! Finish construction of cstr for additional top layer
+! 
+            cstr(0,1:nstr(1)) = 0
+! 
+! INDEX COMPUTATIONS FOR STEP 2-3
+! This section of the code generates the following information:
+! (1. totwgt     step 3     total frac. area of configurations satisfying
+! areamin & nconfgmax criteria
+! (2. wgtv       step 3     frac. area of configurations 
+! (3. ccon       step 2     binary flag for clouds in each configuration
+! (4. nconfig    steps 2-3  number of configurations
+! (5. nuniqu/d   step 2     Number of unique cloud configurations for
+! up/downwelling rad. between surface/TOA
+! and level k
+! (6. istrtu/d   step 2     Indices into iconu/d
+! (7. iconu/d    step 2     Cloud configurations which are identical
+! for up/downwelling rad. between surface/TOA
+! and level k
+! 
+! Number of configurations (all permutations of streams in each region)
+! 
+            nconfigm = product(nstr(1: nrgn))
+! 
+! Construction of totwgt, wgtv, ccon, nconfig
+! 
+            istr(1: nrgn) = 1
+            nconfig = 0
+            totwgt = 0.0_r8
+            new_term = .true.
+            do iconfig = 1, nconfigm
+               xwgt = 1.0_r8
+               do mrgn = 1,  nrgn
+                  xwgt = xwgt * wstr(istr(mrgn),mrgn)
+               end do
+               if (xwgt >= areamin) then
+                  nconfig = nconfig + 1
+                  if (nconfig <= nconfgmax) then
+                     j = nconfig
+                     ptrc(nconfig) = nconfig
+                  else
+                     nconfig = nconfgmax
+                     if (new_term) then
+                        j = findvalue(1,nconfig,wgtv,ptrc)
+                     endif
+                     if (wgtv(j) < xwgt) then
+                        totwgt = totwgt - wgtv(j)
+                        new_term = .true.
+                     else
+                        new_term = .false.
+                     endif
+                  endif
+                  if (new_term) then
+                     wgtv(j) = xwgt
+                     totwgt = totwgt + xwgt
+                     do mrgn = 1, nrgn
+                        ccon(kx1(mrgn):kx2(mrgn),j) = cstr(kx1(mrgn):kx2(mrgn),istr(mrgn))
+                     end do
+                  endif
+               endif
+
+               mrgn =  nrgn
+               istr(mrgn) = istr(mrgn) + 1
+               do while (istr(mrgn) > nstr(mrgn) .and. mrgn > 1)
+                  istr(mrgn) = 1
+                  mrgn = mrgn - 1
+                  istr(mrgn) = istr(mrgn) + 1
+               end do
+! 
+! End do iconfig = 1, nconfigm
+! 
+            end do
+! 
+! If totwgt = 0 implement maximum overlap and make another pass
+! if totwgt = 0 on this second pass then terminate.
+! 
+            if (totwgt > 0.) then
+               exit
+            else
+               npasses = npasses + 1
+               if (npasses >= 2 ) then
+                  write(6,*)'RADCSWMX: Maximum overlap of column ','failed'
+!                 call endrun
+               endif
+               nmxrgn(i)=1
+               pmxrgn(i,1)=1.0e30
+            end if
+!
+! End npasses = 0, do
+!
+         end do
+! 
+! 
+! Finish construction of ccon
+! 
+         ccon(0,:) = 0
+         ccon(pverp,:) = 0
+! 
+! Construction of nuniqu/d, istrtu/d, iconu/d using binary tree 
+! 
+         nuniqd(0) = 1
+         nuniqu(pverp) = 1
+
+         istrtd(0,1) = 1
+         istrtu(pverp,1) = 1
+
+         do j = 1, nconfig
+            icond(0,j)=j
+            iconu(pverp,j)=j
+         end do
+
+         istrtd(0,2) = nconfig+1
+         istrtu(pverp,2) = nconfig+1
+
+         do k = 1, pverp
+            km1 = k-1
+            nuniq = 0
+            istrtd(k,1) = 1
+            do l0 = 1, nuniqd(km1)
+               is0 = istrtd(km1,l0)
+               is1 = istrtd(km1,l0+1)-1
+               n0 = 0
+               n1 = 0
+               do isn = is0, is1
+                  j = icond(km1,isn)
+                  if (ccon(k,j) == 0) then
+                     n0 = n0 + 1
+                     ptr0(n0) = j
+                  endif
+                  if (ccon(k,j) == 1) then
+                     n1 = n1 + 1
+                     ptr1(n1) = j
+                  endif
+               end do
+               if (n0 > 0) then
+                  nuniq = nuniq + 1
+                  istrtd(k,nuniq+1) = istrtd(k,nuniq)+n0
+                  icond(k,istrtd(k,nuniq):istrtd(k,nuniq+1)-1) =  ptr0(1:n0)
+               endif
+               if (n1 > 0) then
+                  nuniq = nuniq + 1
+                  istrtd(k,nuniq+1) = istrtd(k,nuniq)+n1
+                  icond(k,istrtd(k,nuniq):istrtd(k,nuniq+1)-1) =  ptr1(1:n1)
+               endif
+            end do
+            nuniqd(k) = nuniq
+         end do
+
+         do k = pver, 0, -1
+            kp1 = k+1
+            nuniq = 0
+            istrtu(k,1) = 1
+            do l0 = 1, nuniqu(kp1)
+               is0 = istrtu(kp1,l0)
+               is1 = istrtu(kp1,l0+1)-1
+               n0 = 0
+               n1 = 0
+               do isn = is0, is1
+                  j = iconu(kp1,isn)
+                  if (ccon(k,j) == 0) then
+                     n0 = n0 + 1
+                     ptr0(n0) = j
+                  endif
+                  if (ccon(k,j) == 1) then
+                     n1 = n1 + 1
+                     ptr1(n1) = j
+                  endif
+               end do
+               if (n0 > 0) then
+                  nuniq = nuniq + 1
+                  istrtu(k,nuniq+1) = istrtu(k,nuniq)+n0
+                  iconu(k,istrtu(k,nuniq):istrtu(k,nuniq+1)-1) =  ptr0(1:n0)
+               endif
+               if (n1 > 0) then
+                  nuniq = nuniq + 1
+                  istrtu(k,nuniq+1) = istrtu(k,nuniq)+n1
+                  iconu(k,istrtu(k,nuniq):istrtu(k,nuniq+1)-1) = ptr1(1:n1)
+               endif
+            end do
+            nuniqu(k) = nuniq
+         end do
+! 
+!----------------------------------------------------------------------
+! End of index calculations
+!----------------------------------------------------------------------
+
+
+!----------------------------------------------------------------------
+! Start of flux calculations
+!----------------------------------------------------------------------
+! 
+! Initialize spectrally integrated totals:
+! 
+         do k=0,pver
+            totfld(k) = 0.0_r8
+            fswup (k) = 0.0_r8
+            fswdn (k) = 0.0_r8
+            fswupc (k) = 0.0_r8
+            fswdnc (k) = 0.0_r8
+         end do
+
+         sfltot        = 0.0_r8
+         fswup (pverp) = 0.0_r8
+         fswdn (pverp) = 0.0_r8
+         fswupc (pverp) = 0.0_r8
+         fswdnc (pverp) = 0.0_r8
+! 
+! Start spectral interval
+! 
+         do ns = 1,nspint
+            wgtint = nirwgt(ns)
+!----------------------------------------------------------------------
+! STEP 2
+! 
+! 
+! Apply adding method to solve for radiative properties
+! 
+! First initialize the bulk properties at TOA
+! 
+            rdndif(0,1:nconfig) = 0.0_r8
+            exptdn(0,1:nconfig) = 1.0_r8
+            tdntot(0,1:nconfig) = 1.0_r8
+! 
+! Solve for properties involving downward propagation of radiation.
+! The bulk properties are:
+! 
+! (1. exptdn   Sol. beam dwn. trans from layers above
+! (2. rdndif   Ref to dif rad for layers above
+! (3. tdntot   Total trans for layers above
+! 
+            do k = 1, pverp
+               km1 = k - 1
+               do l0 = 1, nuniqd(km1)
+                  is0 = istrtd(km1,l0)
+                  is1 = istrtd(km1,l0+1)-1
+
+                  j = icond(km1,is0)
+
+                  xexpt   = exptdn(km1,j)
+                  xrdnd   = rdndif(km1,j)
+                  tdnmexp = tdntot(km1,j) - xexpt
+
+                  if (ccon(km1,j) == 1) then
+! 
+! If cloud in layer, use cloudy layer radiative properties
+! 
+                     ytdnd = tdif(ns,i,km1)
+                     yrdnd = rdif(ns,i,km1)
+
+                     rdenom  = 1._r8/(1._r8-yrdnd*xrdnd)
+                     rdirexp = rdir(ns,i,km1)*xexpt
+
+                     zexpt = xexpt * explay(ns,i,km1)
+                     zrdnd = yrdnd + xrdnd*(ytdnd**2)*rdenom
+                     ztdnt = xexpt*tdir(ns,i,km1) + ytdnd*(tdnmexp + xrdnd*rdirexp)*rdenom
+                  else
+! 
+! If clear layer, use clear-sky layer radiative properties
+! 
+                     ytdnd = tdifc(ns,i,km1)
+                     yrdnd = rdifc(ns,i,km1)
+
+                     rdenom  = 1._r8/(1._r8-yrdnd*xrdnd)
+                     rdirexp = rdirc(ns,i,km1)*xexpt
+
+                     zexpt = xexpt * explayc(ns,i,km1)
+                     zrdnd = yrdnd + xrdnd*(ytdnd**2)*rdenom
+                     ztdnt = xexpt*tdirc(ns,i,km1) + ytdnd* &
+                                            (tdnmexp + xrdnd*rdirexp)*rdenom
+                  endif
+
+! 
+! If 2 or more configurations share identical properties at a given level k,
+! the properties (at level k) are computed once and copied to 
+! all the configurations for efficiency.
+! 
+                  do isn = is0, is1
+                     j = icond(km1,isn)
+                     exptdn(k,j) = zexpt
+                     rdndif(k,j) = zrdnd
+                     tdntot(k,j) = ztdnt
+                  end do
+! 
+! end do l0 = 1, nuniqd(k)
+! 
+               end do
+! 
+! end do k = 1, pverp
+! 
+            end do
+! 
+! Solve for properties involving upward propagation of radiation.
+! The bulk properties are:
+! 
+! (1. rupdif   Ref to dif rad for layers below
+! (2. rupdir   Ref to dir rad for layers below
+! 
+! Specify surface boundary conditions (surface albedos)
+! 
+            rupdir(pverp,1:nconfig) = albdir(i,ns)
+            rupdif(pverp,1:nconfig) = albdif(i,ns)
+
+            do k = pver, 0, -1
+               do l0 = 1, nuniqu(k)
+                  is0 = istrtu(k,l0)
+                  is1 = istrtu(k,l0+1)-1
+
+                  j = iconu(k,is0)
+
+                  xrupd = rupdif(k+1,j)
+                  xrups = rupdir(k+1,j)
+
+                  if (ccon(k,j) == 1) then
+! 
+! If cloud in layer, use cloudy layer radiative properties
+! 
+                     yexpt = explay(ns,i,k)
+                     yrupd = rdif(ns,i,k)
+                     ytupd = tdif(ns,i,k)
+
+                     rdenom  = 1._r8/( 1._r8 - yrupd*xrupd)
+                     tdnmexp = (tdir(ns,i,k)-yexpt)
+                     rdirexp = xrups*yexpt
+
+                     zrupd = yrupd + xrupd*(ytupd**2)*rdenom
+                     zrups = rdir(ns,i,k) + ytupd*(rdirexp + xrupd*tdnmexp)*rdenom
+                  else
+! 
+! If clear layer, use clear-sky layer radiative properties
+! 
+                     yexpt = explayc(ns,i,k)
+                     yrupd = rdifc(ns,i,k)
+                     ytupd = tdifc(ns,i,k)
+
+                     rdenom  = 1._r8/( 1._r8 - yrupd*xrupd)
+                     tdnmexp = (tdirc(ns,i,k)-yexpt)
+                     rdirexp = xrups*yexpt
+
+                     zrupd = yrupd + xrupd*(ytupd**2)*rdenom
+                     zrups = rdirc(ns,i,k) + ytupd*(rdirexp + xrupd*tdnmexp)*rdenom
+                  endif
+
+! 
+! If 2 or more configurations share identical properties at a given level k,
+! the properties (at level k) are computed once and copied to 
+! all the configurations for efficiency.
+! 
+                  do isn = is0, is1
+                     j = iconu(k,isn)
+                     rupdif(k,j) = zrupd
+                     rupdir(k,j) = zrups
+                  end do
+! 
+! end do l0 = 1, nuniqu(k)
+! 
+               end do
+! 
+! end do k = pver,0,-1
+! 
+            end do
+! 
+!----------------------------------------------------------------------
+! 
+! STEP 3
+! 
+! Compute up and down fluxes for each interface k.  This requires
+! adding up the contributions from all possible permutations
+! of streams in all max-overlap regions, weighted by the
+! product of the fractional areas of the streams in each region
+! (the random overlap assumption).  The adding principle has been
+! used in step 2 to combine the bulk radiative properties 
+! above and below the interface.
+! 
+            do k = 0,pverp
+! 
+! Initialize the fluxes
+! 
+               fluxup(k)=0.0_r8
+               fluxdn(k)=0.0_r8
+
+               do iconfig = 1, nconfig
+                  xwgt = wgtv(iconfig)
+                  xexpt = exptdn(k,iconfig)
+                  xtdnt = tdntot(k,iconfig)
+                  xrdnd = rdndif(k,iconfig)
+                  xrupd = rupdif(k,iconfig)
+                  xrups = rupdir(k,iconfig)
+! 
+! Flux computation
+! 
+                  rdenom = 1._r8/(1._r8 - xrdnd * xrupd)
+
+                  fluxup(k) = fluxup(k) + xwgt *  &
+                              ((xexpt * xrups + (xtdnt - xexpt) * xrupd) * rdenom)
+                  fluxdn(k) = fluxdn(k) + xwgt *  &
+                              (xexpt + (xtdnt - xexpt + xexpt * xrups * xrdnd) * rdenom)
+! 
+! End do iconfig = 1, nconfig
+! 
+               end do
+! 
+! Normalize by total area covered by cloud configurations included
+! in solution
+! 
+               fluxup(k)=fluxup(k) / totwgt
+               fluxdn(k)=fluxdn(k) / totwgt                  
+! 
+! End do k = 0,pverp
+! 
+            end do
+! 
+! Initialize the direct-beam flux at surface
+! 
+            wexptdn = 0.0_r8
+
+            do iconfig = 1, nconfig
+               wexptdn =  wexptdn + wgtv(iconfig) * exptdn(pverp,iconfig)
+            end do
+
+            wexptdn = wexptdn / totwgt
+! 
+! Monochromatic computation completed; accumulate in totals
+! 
+            solflx   = solin(i)*frcsol(ns)*psf(ns)
+            fsnt(i)  = fsnt(i) + solflx*(fluxdn(1) - fluxup(1))
+            fsntoa(i)= fsntoa(i) + solflx*(fluxdn(0) - fluxup(0))
+            fsns(i)  = fsns(i) + solflx*(fluxdn(pverp)-fluxup(pverp))
+            sfltot   = sfltot + solflx
+            fswup(0) = fswup(0) + solflx*fluxup(0)
+            fswdn(0) = fswdn(0) + solflx*fluxdn(0)
+! 
+! Down spectral fluxes need to be in mks; thus the .001 conversion factors
+! 
+            if (wavmid(ns) < 0.7_r8) then
+               sols(i)  = sols(i) + wexptdn*solflx*0.001_r8
+               solsd(i) = solsd(i)+(fluxdn(pverp)-wexptdn)*solflx*0.001_r8
+            else
+               soll(i)  = soll(i) + wexptdn*solflx*0.001_r8
+               solld(i) = solld(i)+(fluxdn(pverp)-wexptdn)*solflx*0.001_r8
+               fsnrtoaq(i) = fsnrtoaq(i) + solflx*(fluxdn(0) - fluxup(0))
+            end if
+            fsnirtoa(i) = fsnirtoa(i) + wgtint*solflx*(fluxdn(0) - fluxup(0))
+
+            do k=0,pver
+! 
+! Compute flux divergence in each layer using the interface up and down
+! fluxes:
+! 
+               kp1 = k+1
+               flxdiv = (fluxdn(k  ) - fluxdn(kp1)) + (fluxup(kp1) - fluxup(k  ))
+               totfld(k)  = totfld(k)  + solflx*flxdiv
+               fswdn(kp1) = fswdn(kp1) + solflx*fluxdn(kp1)
+               fswup(kp1) = fswup(kp1) + solflx*fluxup(kp1)
+            end do
+! 
+! Perform clear-sky calculation
+! 
+            exptdnc(0) =   1.0_r8
+            rdndifc(0) =   0.0_r8
+            tdntotc(0) =   1.0_r8
+            rupdirc(pverp) = albdir(i,ns)
+            rupdifc(pverp) = albdif(i,ns)
+
+            do k = 1, pverp
+               km1 = k - 1
+               xexpt = exptdnc(km1)
+               xrdnd = rdndifc(km1)
+               yrdnd = rdifc(ns,i,km1)
+               ytdnd = tdifc(ns,i,km1)
+
+               exptdnc(k) = xexpt*explayc(ns,i,km1)
+
+               rdenom  = 1._r8/(1._r8 - yrdnd*xrdnd)
+               rdirexp = rdirc(ns,i,km1)*xexpt
+               tdnmexp = tdntotc(km1) - xexpt
+
+               tdntotc(k) = xexpt*tdirc(ns,i,km1) + ytdnd*(tdnmexp + xrdnd*rdirexp)* &
+                                rdenom
+               rdndifc(k) = yrdnd + xrdnd*(ytdnd**2)*rdenom
+            end do
+
+            do k=pver,0,-1
+               xrupd = rupdifc(k+1)
+               yexpt = explayc(ns,i,k)
+               yrupd = rdifc(ns,i,k)
+               ytupd = tdifc(ns,i,k)
+
+               rdenom = 1._r8/( 1._r8 - yrupd*xrupd)
+
+               rupdirc(k) = rdirc(ns,i,k) + ytupd*(rupdirc(k+1)*yexpt + &
+                            xrupd*(tdirc(ns,i,k)-yexpt))*rdenom
+               rupdifc(k) = yrupd + xrupd*ytupd**2*rdenom
+            end do
+
+            do k=0,1
+               rdenom    = 1._r8/(1._r8 - rdndifc(k)*rupdifc(k))
+               fluxup(k) = (exptdnc(k)*rupdirc(k) + (tdntotc(k)-exptdnc(k))*rupdifc(k))* &
+                           rdenom
+               fluxdn(k) = exptdnc(k) + &
+                           (tdntotc(k) - exptdnc(k) + exptdnc(k)*rupdirc(k)*rdndifc(k))* &
+                           rdenom
+               fswupc(k) = fswupc(k) + solflx*fluxup(k)
+               fswdnc(k) = fswdnc(k) + solflx*fluxdn(k)
+            end do
+!           k = pverp
+            do k=2,pverp
+            rdenom      = 1._r8/(1._r8 - rdndifc(k)*rupdifc(k))
+            fluxup(k)   = (exptdnc(k)*rupdirc(k) + (tdntotc(k)-exptdnc(k))*rupdifc(k))* &
+                           rdenom
+            fluxdn(k)   = exptdnc(k) + (tdntotc(k) - exptdnc(k) + &
+                          exptdnc(k)*rupdirc(k)*rdndifc(k))*rdenom
+            fswupc(k)   = fswupc(k) + solflx*fluxup(k)
+            fswdnc(k)   = fswdnc(k) + solflx*fluxdn(k)
+            end do
+
+            fsntc(i)    = fsntc(i)+solflx*(fluxdn(1)-fluxup(1))
+            fsntoac(i)  = fsntoac(i)+solflx*(fluxdn(0)-fluxup(0))
+            fsnsc(i)    = fsnsc(i)+solflx*(fluxdn(pverp)-fluxup(pverp))
+            fsdsc(i)    = fsdsc(i)+solflx*(fluxdn(pverp))
+            fsnrtoac(i) = fsnrtoac(i)+wgtint*solflx*(fluxdn(0)-fluxup(0))
+! 
+! End of clear sky calculation
+! 
+
+! 
+! End of spectral interval loop
+! 
+         end do
+! 
+! Compute solar heating rate (J/kg/s)
+! 
+         do k=1,pver
+            qrs(i,k) = -1.E-4*gravit*totfld(k)/(pint(i,k) - pint(i,k+1))
+         end do
+
+! Added downward/upward total and clear sky fluxes
+
+         do k=1,pverp
+            fsup(i,k)  = fswup(k)
+            fsupc(i,k) = fswupc(k)
+            fsdn(i,k)  = fswdn(k)
+            fsdnc(i,k) = fswdnc(k)
+         end do
+! 
+! Set the downwelling flux at the surface 
+! 
+         fsds(i) = fswdn(pverp)
+! 
+! End do n=1,ndayc
+! 
+   end do
+
+!  write (6, '(a, x, i3)') 'radcswmx : exiting, chunk identifier', lchnk
+
+   return
+end subroutine radcswmx
+
+subroutine raddedmx(pver, pverp, pcols, coszrs  ,ndayc   ,idayc   ,abh2o   , &
+                    abo3    ,abco2   ,abo2    ,uh2o    ,uo3     , &
+                    uco2    ,uo2     ,trayoslp,pflx    ,ns      , &
+                    tauxcl  ,wcl     ,gcl     ,fcl     ,tauxci  , &
+                    wci     ,gci     ,fci     ,tauxar  ,wa      , &
+                    ga      ,fa      ,rdir    ,rdif    ,tdir    , &
+                    tdif    ,explay  ,rdirc   ,rdifc   ,tdirc   , &
+                    tdifc   ,explayc )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Computes layer reflectivities and transmissivities, from the top down
+! to the surface using the delta-Eddington solutions for each layer
+! 
+! Method: 
+! For more details , see Briegleb, Bruce P., 1992: Delta-Eddington
+! Approximation for Solar Radiation in the NCAR Community Climate Model,
+! Journal of Geophysical Research, Vol 97, D7, pp7603-7612).
+!
+! Modified for maximum/random cloud overlap by Bill Collins and John
+!    Truesdale
+! 
+! Author: Bill Collins
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+
+   implicit none
+
+   integer nspint           ! Num of spctrl intervals across solar spectrum
+
+   parameter ( nspint = 19 )
+!
+! Minimum total transmission below which no layer computation are done:
+!
+   real(r8) trmin                ! Minimum total transmission allowed
+   real(r8) wray                 ! Rayleigh single scatter albedo
+   real(r8) gray                 ! Rayleigh asymetry parameter
+   real(r8) fray                 ! Rayleigh forward scattered fraction
+
+   parameter (trmin = 1.e-3)
+   parameter (wray = 0.999999)
+   parameter (gray = 0.0)
+   parameter (fray = 0.1)
+!
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: pver, pverp, pcols
+   real(r8), intent(in) :: coszrs(pcols)        ! Cosine zenith angle
+   real(r8), intent(in) :: trayoslp             ! Tray/sslp
+   real(r8), intent(in) :: pflx(pcols,0:pverp)  ! Interface pressure
+   real(r8), intent(in) :: abh2o                ! Absorption coefficiant for h2o
+   real(r8), intent(in) :: abo3                 ! Absorption coefficiant for o3
+   real(r8), intent(in) :: abco2                ! Absorption coefficiant for co2
+   real(r8), intent(in) :: abo2                 ! Absorption coefficiant for o2
+   real(r8), intent(in) :: uh2o(pcols,0:pver)   ! Layer absorber amount of h2o
+   real(r8), intent(in) :: uo3(pcols,0:pver)    ! Layer absorber amount of  o3
+   real(r8), intent(in) :: uco2(pcols,0:pver)   ! Layer absorber amount of co2
+   real(r8), intent(in) :: uo2(pcols,0:pver)    ! Layer absorber amount of  o2
+   real(r8), intent(in) :: tauxcl(pcols,0:pver) ! Cloud extinction optical depth (liquid)
+   real(r8), intent(in) :: wcl(pcols,0:pver)    ! Cloud single scattering albedo (liquid)
+   real(r8), intent(in) :: gcl(pcols,0:pver)    ! Cloud asymmetry parameter (liquid)
+   real(r8), intent(in) :: fcl(pcols,0:pver)    ! Cloud forward scattered fraction (liquid)
+   real(r8), intent(in) :: tauxci(pcols,0:pver) ! Cloud extinction optical depth (ice)
+   real(r8), intent(in) :: wci(pcols,0:pver)    ! Cloud single scattering albedo (ice)
+   real(r8), intent(in) :: gci(pcols,0:pver)    ! Cloud asymmetry parameter (ice)
+   real(r8), intent(in) :: fci(pcols,0:pver)    ! Cloud forward scattered fraction (ice)
+   real(r8), intent(in) :: tauxar(pcols,0:pver) ! Aerosol extinction optical depth
+   real(r8), intent(in) :: wa(pcols,0:pver)     ! Aerosol single scattering albedo
+   real(r8), intent(in) :: ga(pcols,0:pver)     ! Aerosol asymmetry parameter
+   real(r8), intent(in) :: fa(pcols,0:pver)     ! Aerosol forward scattered fraction
+
+   integer, intent(in) :: ndayc                 ! Number of daylight columns
+   integer, intent(in) :: idayc(pcols)          ! Daylight column indices
+   integer, intent(in) :: ns                    ! Index of spectral interval
+!
+! Input/Output arguments
+!
+! Following variables are defined for each layer; 0 refers to extra
+! layer above top of model:
+!
+   real(r8), intent(inout) :: rdir(nspint,pcols,0:pver)   ! Layer reflectivity to direct rad
+   real(r8), intent(inout) :: rdif(nspint,pcols,0:pver)   ! Layer reflectivity to diffuse rad
+   real(r8), intent(inout) :: tdir(nspint,pcols,0:pver)   ! Layer transmission to direct rad
+   real(r8), intent(inout) :: tdif(nspint,pcols,0:pver)   ! Layer transmission to diffuse rad
+   real(r8), intent(inout) :: explay(nspint,pcols,0:pver) ! Solar beam exp transm for layer
+!
+! Corresponding quantities for clear-skies
+!
+   real(r8), intent(inout) :: rdirc(nspint,pcols,0:pver)  ! Clear layer reflec. to direct rad
+   real(r8), intent(inout) :: rdifc(nspint,pcols,0:pver)  ! Clear layer reflec. to diffuse rad
+   real(r8), intent(inout) :: tdirc(nspint,pcols,0:pver)  ! Clear layer trans. to direct rad
+   real(r8), intent(inout) :: tdifc(nspint,pcols,0:pver)  ! Clear layer trans. to diffuse rad
+   real(r8), intent(inout) :: explayc(nspint,pcols,0:pver)! Solar beam exp transm clear layer
+!
+!---------------------------Local variables-----------------------------
+!
+   integer i                 ! Column indices
+   integer k                 ! Level index
+   integer nn                ! Index of column loops (max=ndayc)
+
+   real(r8) taugab(pcols)        ! Layer total gas absorption optical depth
+   real(r8) tauray(pcols)        ! Layer rayleigh optical depth
+   real(r8) taucsc               ! Layer cloud scattering optical depth
+   real(r8) tautot               ! Total layer optical depth
+   real(r8) wtot                 ! Total layer single scatter albedo
+   real(r8) gtot                 ! Total layer asymmetry parameter
+   real(r8) ftot                 ! Total layer forward scatter fraction
+   real(r8) wtau                 !  rayleigh layer scattering optical depth
+   real(r8) wt                   !  layer total single scattering albedo
+   real(r8) ts                   !  layer scaled extinction optical depth
+   real(r8) ws                   !  layer scaled single scattering albedo
+   real(r8) gs                   !  layer scaled asymmetry parameter
+!
+!---------------------------Statement functions-------------------------
+!
+! Statement functions and other local variables
+!
+   real(r8) alpha                ! Term in direct reflect and transmissivity
+   real(r8) gamma                ! Term in direct reflect and transmissivity
+   real(r8) el                   ! Term in alpha,gamma,n,u
+   real(r8) taus                 ! Scaled extinction optical depth
+   real(r8) omgs                 ! Scaled single particle scattering albedo
+   real(r8) asys                 ! Scaled asymmetry parameter
+   real(r8) u                    ! Term in diffuse reflect and
+!    transmissivity
+   real(r8) n                    ! Term in diffuse reflect and
+!    transmissivity
+   real(r8) lm                   ! Temporary for el
+   real(r8) ne                   ! Temporary for n
+   real(r8) w                    ! Dummy argument for statement function
+   real(r8) uu                   ! Dummy argument for statement function
+   real(r8) g                    ! Dummy argument for statement function
+   real(r8) e                    ! Dummy argument for statement function
+   real(r8) f                    ! Dummy argument for statement function
+   real(r8) t                    ! Dummy argument for statement function
+   real(r8) et                   ! Dummy argument for statement function
+!
+! Intermediate terms for delta-eddington solution
+!
+   real(r8) alp                  ! Temporary for alpha
+   real(r8) gam                  ! Temporary for gamma
+   real(r8) ue                   ! Temporary for u
+   real(r8) arg                  ! Exponential argument
+   real(r8) extins               ! Extinction
+   real(r8) amg                  ! Alp - gam
+   real(r8) apg                  ! Alp + gam
+!
+   alpha(w,uu,g,e) = .75_r8*w*uu*((1._r8 + g*(1._r8-w))/(1._r8 - e*e*uu*uu))
+   gamma(w,uu,g,e) = .50_r8*w*((3._r8*g*(1._r8-w)*uu*uu + 1._r8)/(1._r8-e*e*uu*uu))
+   el(w,g)         = sqrt(3._r8*(1._r8-w)*(1._r8 - w*g))
+   taus(w,f,t)     = (1._r8 - w*f)*t
+   omgs(w,f)       = (1._r8 - f)*w/(1._r8 - w*f)
+   asys(g,f)       = (g - f)/(1._r8 - f)
+   u(w,g,e)        = 1.5_r8*(1._r8 - w*g)/e
+   n(uu,et)        = ((uu+1._r8)*(uu+1._r8)/et ) - ((uu-1._r8)*(uu-1._r8)*et)
+!
+!-----------------------------------------------------------------------
+!
+! Compute layer radiative properties
+!
+! Compute radiative properties (reflectivity and transmissivity for
+!    direct and diffuse radiation incident from above, under clear
+!    and cloudy conditions) and transmission of direct radiation
+!    (under clear and cloudy conditions) for each layer.
+!
+   do k=0,pver
+      do nn=1,ndayc
+         i=idayc(nn)
+            tauray(i) = trayoslp*(pflx(i,k+1)-pflx(i,k))
+            taugab(i) = abh2o*uh2o(i,k) + abo3*uo3(i,k) + abco2*uco2(i,k) + abo2*uo2(i,k)
+            tautot = tauxcl(i,k) + tauxci(i,k) + tauray(i) + taugab(i) + tauxar(i,k)
+            taucsc = tauxcl(i,k)*wcl(i,k) + tauxci(i,k)*wci(i,k) + tauxar(i,k)*wa(i,k)
+            wtau   = wray*tauray(i)
+            wt     = wtau + taucsc
+            wtot   = wt/tautot
+            gtot   = (wtau*gray + gcl(i,k)*wcl(i,k)*tauxcl(i,k) &
+                     + gci(i,k)*wci(i,k)*tauxci(i,k) + ga(i,k) *wa(i,k) *tauxar(i,k))/wt
+            ftot   = (wtau*fray + fcl(i,k)*wcl(i,k)*tauxcl(i,k) &
+                     + fci(i,k)*wci(i,k)*tauxci(i,k) + fa(i,k) *wa(i,k) *tauxar(i,k))/wt
+            ts   = taus(wtot,ftot,tautot)
+            ws   = omgs(wtot,ftot)
+            gs   = asys(gtot,ftot)
+            lm   = el(ws,gs)
+            alp  = alpha(ws,coszrs(i),gs,lm)
+            gam  = gamma(ws,coszrs(i),gs,lm)
+            ue   = u(ws,gs,lm)
+!
+!     Limit argument of exponential to 25, in case lm very large:
+!
+            arg  = min(lm*ts,25._r8)
+            extins = exp(-arg)
+            ne = n(ue,extins)
+            rdif(ns,i,k) = (ue+1._r8)*(ue-1._r8)*(1._r8/extins - extins)/ne
+            tdif(ns,i,k)   =   4._r8*ue/ne
+!
+!     Limit argument of exponential to 25, in case coszrs is very small:
+!
+            arg       = min(ts/coszrs(i),25._r8)
+            explay(ns,i,k) = exp(-arg)
+            apg = alp + gam
+            amg = alp - gam
+            rdir(ns,i,k) = amg*(tdif(ns,i,k)*explay(ns,i,k)-1._r8) + apg*rdif(ns,i,k)
+            tdir(ns,i,k) = apg*tdif(ns,i,k) + (amg*rdif(ns,i,k)-(apg-1._r8))*explay(ns,i,k)
+!
+!     Under rare conditions, reflectivies and transmissivities can be
+!     negative; zero out any negative values
+!
+            rdir(ns,i,k) = max(rdir(ns,i,k),0.0_r8)
+            tdir(ns,i,k) = max(tdir(ns,i,k),0.0_r8)
+            rdif(ns,i,k) = max(rdif(ns,i,k),0.0_r8)
+            tdif(ns,i,k) = max(tdif(ns,i,k),0.0_r8)
+!
+!     Clear-sky calculation
+!
+            if (tauxcl(i,k) == 0.0_r8 .and. tauxci(i,k) == 0.0_r8) then
+
+               rdirc(ns,i,k) = rdir(ns,i,k)
+               tdirc(ns,i,k) = tdir(ns,i,k)
+               rdifc(ns,i,k) = rdif(ns,i,k)
+               tdifc(ns,i,k) = tdif(ns,i,k)
+               explayc(ns,i,k) = explay(ns,i,k)
+            else
+               tautot = tauray(i) + taugab(i) + tauxar(i,k)
+               taucsc = tauxar(i,k)*wa(i,k)
+!
+! wtau already computed for all-sky
+!
+               wt     = wtau + taucsc
+               wtot   = wt/tautot
+               gtot   = (wtau*gray + ga(i,k)*wa(i,k)*tauxar(i,k))/wt
+               ftot   = (wtau*fray + fa(i,k)*wa(i,k)*tauxar(i,k))/wt
+               ts   = taus(wtot,ftot,tautot)
+               ws   = omgs(wtot,ftot)
+               gs   = asys(gtot,ftot)
+               lm   = el(ws,gs)
+               alp  = alpha(ws,coszrs(i),gs,lm)
+               gam  = gamma(ws,coszrs(i),gs,lm)
+               ue   = u(ws,gs,lm)
+!
+!     Limit argument of exponential to 25, in case lm very large:
+!
+               arg  = min(lm*ts,25._r8)
+               extins = exp(-arg)
+               ne = n(ue,extins)
+               rdifc(ns,i,k) = (ue+1._r8)*(ue-1._r8)*(1._r8/extins - extins)/ne
+               tdifc(ns,i,k)   =   4._r8*ue/ne
+!
+!     Limit argument of exponential to 25, in case coszrs is very small:
+!
+               arg       = min(ts/coszrs(i),25._r8)
+               explayc(ns,i,k) = exp(-arg)
+               apg = alp + gam
+               amg = alp - gam
+               rdirc(ns,i,k) = amg*(tdifc(ns,i,k)*explayc(ns,i,k)-1._r8)+ &
+                               apg*rdifc(ns,i,k)
+               tdirc(ns,i,k) = apg*tdifc(ns,i,k) + (amg*rdifc(ns,i,k) - (apg-1._r8))* &
+                               explayc(ns,i,k)
+!
+!     Under rare conditions, reflectivies and transmissivities can be
+!     negative; zero out any negative values
+!
+               rdirc(ns,i,k) = max(rdirc(ns,i,k),0.0_r8)
+               tdirc(ns,i,k) = max(tdirc(ns,i,k),0.0_r8)
+               rdifc(ns,i,k) = max(rdifc(ns,i,k),0.0_r8)
+               tdifc(ns,i,k) = max(tdifc(ns,i,k),0.0_r8)
+            end if
+         end do
+   end do
+
+   return
+end subroutine raddedmx
+subroutine radini(gravx   ,cpairx  ,epsilox ,stebolx, pstdx )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Initialize various constants for radiation scheme; note that
+! the radiation scheme uses cgs units.
+! 
+! Method: 
+! <Describe the algorithm(s) used in the routine.> 
+! <Also include any applicable external references.> 
+! 
+! Author: W. Collins (H2O parameterization) and J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid,       only: pver, pverp
+!  use comozp,       only: cplos, cplol
+!  use pmgrid,       only: masterproc, plev, plevp
+!  use radae,        only: radaeini
+!  use physconst,    only: mwdry, mwco2
+#if ( defined SPMD )
+!   use mpishorthand
+#endif
+   implicit none
+
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   real, intent(in) :: gravx      ! Acceleration of gravity (MKS)
+   real, intent(in) :: cpairx     ! Specific heat of dry air (MKS)
+   real, intent(in) :: epsilox    ! Ratio of mol. wght of H2O to dry air
+   real, intent(in) :: stebolx    ! Stefan-Boltzmann's constant (MKS)
+   real(r8), intent(in) :: pstdx      ! Standard pressure (Pascals)
+!
+!---------------------------Local variables-----------------------------
+!
+   integer k       ! Loop variable
+
+   real(r8) v0         ! Volume of a gas at stp (m**3/kmol)
+   real(r8) p0         ! Standard pressure (pascals)
+   real(r8) amd        ! Effective molecular weight of dry air (kg/kmol)
+   real(r8) goz        ! Acceleration of gravity (m/s**2)
+!
+!-----------------------------------------------------------------------
+!
+! Set general radiation consts; convert to cgs units where appropriate:
+!
+   gravit  =  100.*gravx
+   rga     =  1./gravit
+   gravmks =  gravx
+   cpair   =  1.e4*cpairx
+   epsilo  =  epsilox
+   sslp    =  1.013250e6
+   stebol  =  1.e3*stebolx
+   rgsslp  =  0.5/(gravit*sslp)
+   dpfo3   =  2.5e-3
+   dpfco2  =  5.0e-3
+   dayspy  =  365.
+   pie     =  4.*atan(1.)
+!
+! Initialize ozone data.
+!
+   v0  = 22.4136         ! Volume of a gas at stp (m**3/kmol)
+   p0  = 0.1*sslp        ! Standard pressure (pascals)
+   amd = 28.9644         ! Molecular weight of dry air (kg/kmol)
+   goz = gravx           ! Acceleration of gravity (m/s**2)
+!
+! Constants for ozone path integrals (multiplication by 100 for unit
+! conversion to cgs from mks):
+!
+   cplos = v0/(amd*goz)       *100.0
+   cplol = v0/(amd*goz*p0)*0.5*100.0
+!
+! Derived constants
+! If the top model level is above ~90 km (0.1 Pa), set the top level to compute
+! longwave cooling to about 80 km (1 Pa)
+! WRF: assume top level > 0.1 mb
+!  if (hypm(1) .lt. 0.1) then
+!     do k = 1, pver
+!        if (hypm(k) .lt. 1.) ntoplw  = k
+!     end do
+!  else
+      ntoplw = 1
+!  end if
+!   if (masterproc) then
+!     write (6,*) 'RADINI: ntoplw =',ntoplw, ' pressure:',hypm(ntoplw)
+!   endif
+
+   call radaeini( pstdx, mwdry, mwco2 )
+   return
+end subroutine radini
+subroutine radinp(lchnk   ,ncol    , pcols, pver, pverp,     &
+                  pmid    ,pint    ,o3vmr   , pmidrd  ,&
+                  pintrd  ,eccf    ,o3mmr   )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Set latitude and time dependent arrays for input to solar
+! and longwave radiation.
+! Convert model pressures to cgs, and compute ozone mixing ratio, needed for
+! the solar radiation.
+! 
+! Method: 
+! <Describe the algorithm(s) used in the routine.> 
+! <Also include any applicable external references.> 
+! 
+! Author: CCM1, CMS Contact J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use time_manager, only: get_curr_calday
+
+   implicit none
+
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                ! chunk identifier
+   integer, intent(in) :: pcols, pver, pverp
+   integer, intent(in) :: ncol                 ! number of atmospheric columns
+
+   real(r8), intent(in) :: pmid(pcols,pver)    ! Pressure at model mid-levels (pascals)
+   real(r8), intent(in) :: pint(pcols,pverp)   ! Pressure at model interfaces (pascals)
+   real(r8), intent(in) :: o3vmr(pcols,pver)   ! ozone volume mixing ratio
+!
+! Output arguments
+!
+   real(r8), intent(out) :: pmidrd(pcols,pver)  ! Pressure at mid-levels (dynes/cm*2)
+   real(r8), intent(out) :: pintrd(pcols,pverp) ! Pressure at interfaces (dynes/cm*2)
+   real(r8), intent(out) :: eccf                ! Earth-sun distance factor
+   real(r8), intent(out) :: o3mmr(pcols,pver)   ! Ozone mass mixing ratio
+
+!
+!---------------------------Local variables-----------------------------
+!
+   integer i                ! Longitude loop index
+   integer k                ! Vertical loop index
+
+   real(r8) :: calday           ! current calendar day
+   real(r8) amd                 ! Effective molecular weight of dry air (g/mol)
+   real(r8) amo                 ! Molecular weight of ozone (g/mol)
+   real(r8) vmmr                ! Ozone volume mixing ratio
+   real(r8) delta               ! Solar declination angle
+
+   save     amd   ,amo
+
+   data amd   /  28.9644   /
+   data amo   /  48.0000   /
+!
+!-----------------------------------------------------------------------
+!
+!  calday = get_curr_calday()
+   eccf = 1. ! declared intent(out) so fill a value (not used in WRF)
+!  call shr_orb_decl (calday  ,eccen     ,mvelpp  ,lambm0  ,obliqr  , &
+!                     delta   ,eccf)
+
+!
+! Convert pressure from pascals to dynes/cm2
+!
+   do k=1,pver
+      do i=1,ncol
+         pmidrd(i,k) = pmid(i,k)*10.0
+         pintrd(i,k) = pint(i,k)*10.0
+      end do
+   end do
+   do i=1,ncol
+      pintrd(i,pverp) = pint(i,pverp)*10.0
+   end do
+!
+! Convert ozone volume mixing ratio to mass mixing ratio:
+!
+   vmmr = amo/amd
+   do k=1,pver
+      do i=1,ncol
+         o3mmr(i,k) = vmmr*o3vmr(i,k)
+      end do
+   end do
+!
+   return
+end subroutine radinp
+subroutine radoz2(lchnk   ,ncol    ,pcols, pver, pverp, o3vmr   ,pint    ,plol    ,plos, ntoplw    )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Computes the path length integrals to the model interfaces given the
+! ozone volume mixing ratio
+! 
+! Method: 
+! <Describe the algorithm(s) used in the routine.> 
+! <Also include any applicable external references.> 
+! 
+! Author: CCM1, CMS Contact J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use comozp
+
+   implicit none
+!------------------------------Input arguments--------------------------
+!
+   integer, intent(in) :: lchnk                ! chunk identifier
+   integer, intent(in) :: ncol                 ! number of atmospheric columns
+   integer, intent(in) :: pcols, pver, pverp
+
+   real(r8), intent(in) :: o3vmr(pcols,pver)   ! ozone volume mixing ratio
+   real(r8), intent(in) :: pint(pcols,pverp)   ! Model interface pressures
+
+   integer, intent(in) :: ntoplw               ! topmost level/layer longwave is solved for
+
+!
+!----------------------------Output arguments---------------------------
+!
+   real(r8), intent(out) :: plol(pcols,pverp)   ! Ozone prs weighted path length (cm)
+   real(r8), intent(out) :: plos(pcols,pverp)   ! Ozone path length (cm)
+
+!
+!---------------------------Local workspace-----------------------------
+!
+   integer i                ! longitude index
+   integer k                ! level index
+!
+!-----------------------------------------------------------------------
+!
+! Evaluate the ozone path length integrals to interfaces;
+! factors of .1 and .01 to convert pressures from cgs to mks:
+!
+   do i=1,ncol
+      plos(i,ntoplw) = 0.1 *cplos*o3vmr(i,ntoplw)*pint(i,ntoplw)
+      plol(i,ntoplw) = 0.01*cplol*o3vmr(i,ntoplw)*pint(i,ntoplw)*pint(i,ntoplw)
+   end do
+   do k=ntoplw+1,pverp
+      do i=1,ncol
+         plos(i,k) = plos(i,k-1) + 0.1*cplos*o3vmr(i,k-1)*(pint(i,k) - pint(i,k-1))
+         plol(i,k) = plol(i,k-1) + 0.01*cplol*o3vmr(i,k-1)* &
+                    (pint(i,k)*pint(i,k) - pint(i,k-1)*pint(i,k-1))
+      end do
+   end do
+!
+   return
+end subroutine radoz2
+
+
+subroutine radozn (lchnk, ncol, pcols, pver,pmid, pin, levsiz, ozmix, o3vmr)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: Interpolate ozone from current time-interpolated values to model levels
+! 
+! Method: Use pressure values to determine interpolation levels
+! 
+! Author: Bruce Briegleb
+! 
+!--------------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use phys_grid,     only: get_lat_all_p, get_lon_all_p
+!  use comozp
+!  use abortutils, only: endrun
+!--------------------------------------------------------------------------
+   implicit none
+!--------------------------------------------------------------------------
+!
+! Arguments
+!
+   integer, intent(in) :: lchnk               ! chunk identifier
+   integer, intent(in) :: pcols, pver
+   integer, intent(in) :: ncol                ! number of atmospheric columns
+   integer, intent(in) :: levsiz              ! number of ozone layers
+
+   real(r8), intent(in) :: pmid(pcols,pver)   ! level pressures (mks)
+   real(r8), intent(in) :: pin(levsiz)        ! ozone data level pressures (mks)
+   real(r8), intent(in) :: ozmix(pcols,levsiz) ! ozone mixing ratio
+
+   real(r8), intent(out) :: o3vmr(pcols,pver) ! ozone volume mixing ratio
+!
+! local storage
+!
+   integer i                   ! longitude index
+   integer k, kk, kkstart      ! level indices
+   integer kupper(pcols)       ! Level indices for interpolation
+   integer kount               ! Counter
+   integer lats(pcols)         ! latitude indices
+   integer lons(pcols)         ! latitude indices
+
+   real(r8) dpu                ! upper level pressure difference
+   real(r8) dpl                ! lower level pressure difference
+!
+! Initialize latitude indices
+!
+!  call get_lat_all_p(lchnk, ncol, lats)
+!  call get_lon_all_p(lchnk, ncol, lons)
+!
+! Initialize index array
+!
+   do i=1,ncol
+      kupper(i) = 1
+   end do
+
+   do k=1,pver
+!
+! Top level we need to start looking is the top level for the previous k
+! for all longitude points
+!
+      kkstart = levsiz
+      do i=1,ncol
+         kkstart = min0(kkstart,kupper(i))
+      end do
+      kount = 0
+!
+! Store level indices for interpolation
+!
+      do kk=kkstart,levsiz-1
+         do i=1,ncol
+            if (pin(kk).lt.pmid(i,k) .and. pmid(i,k).le.pin(kk+1)) then
+               kupper(i) = kk
+               kount = kount + 1
+            end if
+         end do
+!
+! If all indices for this level have been found, do the interpolation and
+! go to the next level
+!
+         if (kount.eq.ncol) then
+            do i=1,ncol
+               dpu = pmid(i,k) - pin(kupper(i))
+               dpl = pin(kupper(i)+1) - pmid(i,k)
+               o3vmr(i,k) = (ozmix(i,kupper(i))*dpl + &
+                             ozmix(i,kupper(i)+1)*dpu)/(dpl + dpu)
+            end do
+            goto 35
+         end if
+      end do
+!
+! If we've fallen through the kk=1,levsiz-1 loop, we cannot interpolate and
+! must extrapolate from the bottom or top ozone data level for at least some
+! of the longitude points.
+!
+      do i=1,ncol
+         if (pmid(i,k) .lt. pin(1)) then
+            o3vmr(i,k) = ozmix(i,1)*pmid(i,k)/pin(1)
+         else if (pmid(i,k) .gt. pin(levsiz)) then
+            o3vmr(i,k) = ozmix(i,levsiz)
+         else
+            dpu = pmid(i,k) - pin(kupper(i))
+            dpl = pin(kupper(i)+1) - pmid(i,k)
+            o3vmr(i,k) = (ozmix(i,kupper(i))*dpl + &
+                          ozmix(i,kupper(i)+1)*dpu)/(dpl + dpu)
+         end if
+      end do
+
+      if (kount.gt.ncol) then
+!        call endrun ('RADOZN: Bad ozone data: non-monotonicity suspected')
+      end if
+35    continue
+   end do
+
+   return
+end subroutine radozn
+
+
+subroutine sortarray(n, ain, indxa) 
+!-----------------------------------------------
+!
+! Purpose:
+!       Sort an array
+! Alogrithm:
+!       Based on Shell's sorting method.
+!
+! Author: T. Craig
+!-----------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+   implicit none
+!
+!  Arguments
+!
+   integer , intent(in) :: n             ! total number of elements
+   integer , intent(inout) :: indxa(n)   ! array of integers
+   real(r8), intent(inout) :: ain(n)     ! array to sort
+!
+!  local variables
+!
+   integer :: i, j                ! Loop indices
+   integer :: ni                  ! Starting increment
+   integer :: itmp                ! Temporary index
+   real(r8):: atmp                ! Temporary value to swap
+ 
+   ni = 1 
+   do while(.TRUE.) 
+      ni = 3*ni + 1 
+      if (ni <= n) cycle  
+      exit  
+   end do 
+ 
+   do while(.TRUE.) 
+      ni = ni/3 
+      do i = ni + 1, n 
+         atmp = ain(i) 
+         itmp = indxa(i) 
+         j = i 
+         do while(.TRUE.) 
+            if (ain(j-ni) <= atmp) exit  
+            ain(j) = ain(j-ni) 
+            indxa(j) = indxa(j-ni) 
+            j = j - ni 
+            if (j > ni) cycle  
+            exit  
+         end do 
+         ain(j) = atmp 
+         indxa(j) = itmp 
+      end do 
+      if (ni > 1) cycle  
+      exit  
+   end do 
+   return  
+ 
+end subroutine sortarray
+subroutine trcab(lchnk   ,ncol    ,pcols, pverp,               &
+                 k1      ,k2      ,ucfc11  ,ucfc12  ,un2o0   , &
+                 un2o1   ,uch4    ,uco211  ,uco212  ,uco213  , &
+                 uco221  ,uco222  ,uco223  ,bn2o0   ,bn2o1   , &
+                 bch4    ,to3co2  ,pnm     ,dw      ,pnew    , &
+                 s2c     ,uptype  ,dplh2o  ,abplnk1 ,tco2    , &
+                 th2o    ,to3     ,abstrc  , &
+                 aer_trn_ttl)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Calculate absorptivity for non nearest layers for CH4, N2O, CFC11 and
+! CFC12.
+! 
+! Method: 
+! See CCM3 description for equations.
+! 
+! Author: J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use volcrad
+
+   implicit none
+
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                    ! chunk identifier
+   integer, intent(in) :: ncol                     ! number of atmospheric columns
+   integer, intent(in) :: pcols, pverp
+   integer, intent(in) :: k1,k2                    ! level indices
+!
+   real(r8), intent(in) :: to3co2(pcols)           ! pressure weighted temperature
+   real(r8), intent(in) :: pnm(pcols,pverp)        ! interface pressures
+   real(r8), intent(in) :: ucfc11(pcols,pverp)     ! CFC11 path length
+   real(r8), intent(in) :: ucfc12(pcols,pverp)     ! CFC12 path length
+   real(r8), intent(in) :: un2o0(pcols,pverp)      ! N2O path length
+!
+   real(r8), intent(in) :: un2o1(pcols,pverp)      ! N2O path length (hot band)
+   real(r8), intent(in) :: uch4(pcols,pverp)       ! CH4 path length
+   real(r8), intent(in) :: uco211(pcols,pverp)     ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco212(pcols,pverp)     ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco213(pcols,pverp)     ! CO2 9.4 micron band path length
+!
+   real(r8), intent(in) :: uco221(pcols,pverp)     ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uco222(pcols,pverp)     ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uco223(pcols,pverp)     ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: bn2o0(pcols,pverp)      ! pressure factor for n2o
+   real(r8), intent(in) :: bn2o1(pcols,pverp)      ! pressure factor for n2o
+!
+   real(r8), intent(in) :: bch4(pcols,pverp)       ! pressure factor for ch4
+   real(r8), intent(in) :: dw(pcols)               ! h2o path length
+   real(r8), intent(in) :: pnew(pcols)             ! pressure
+   real(r8), intent(in) :: s2c(pcols,pverp)        ! continuum path length
+   real(r8), intent(in) :: uptype(pcols,pverp)     ! p-type h2o path length
+!
+   real(r8), intent(in) :: dplh2o(pcols)           ! p squared h2o path length
+   real(r8), intent(in) :: abplnk1(14,pcols,pverp) ! Planck factor
+   real(r8), intent(in) :: tco2(pcols)             ! co2 transmission factor
+   real(r8), intent(in) :: th2o(pcols)             ! h2o transmission factor
+   real(r8), intent(in) :: to3(pcols)              ! o3 transmission factor
+
+   real(r8), intent(in) :: aer_trn_ttl(pcols,pverp,pverp,bnd_nbr_LW) ! aer trn.
+
+!
+!  Output Arguments
+!
+   real(r8), intent(out) :: abstrc(pcols)           ! total trace gas absorptivity
+!
+!--------------------------Local Variables------------------------------
+!
+   integer  i,l                     ! loop counters
+
+   real(r8) sqti(pcols)             ! square root of mean temp
+   real(r8) du1                     ! cfc11 path length
+   real(r8) du2                     ! cfc12 path length
+   real(r8) acfc1                   ! cfc11 absorptivity 798 cm-1
+   real(r8) acfc2                   ! cfc11 absorptivity 846 cm-1
+!
+   real(r8) acfc3                   ! cfc11 absorptivity 933 cm-1
+   real(r8) acfc4                   ! cfc11 absorptivity 1085 cm-1
+   real(r8) acfc5                   ! cfc12 absorptivity 889 cm-1
+   real(r8) acfc6                   ! cfc12 absorptivity 923 cm-1
+   real(r8) acfc7                   ! cfc12 absorptivity 1102 cm-1
+!
+   real(r8) acfc8                   ! cfc12 absorptivity 1161 cm-1
+   real(r8) du01                    ! n2o path length
+   real(r8) dbeta01                 ! n2o pressure factor
+   real(r8) dbeta11                 !         "
+   real(r8) an2o1                   ! absorptivity of 1285 cm-1 n2o band
+!
+   real(r8) du02                    ! n2o path length
+   real(r8) dbeta02                 ! n2o pressure factor
+   real(r8) an2o2                   ! absorptivity of 589 cm-1 n2o band
+   real(r8) du03                    ! n2o path length
+   real(r8) dbeta03                 ! n2o pressure factor
+!
+   real(r8) an2o3                   ! absorptivity of 1168 cm-1 n2o band
+   real(r8) duch4                   ! ch4 path length
+   real(r8) dbetac                  ! ch4 pressure factor
+   real(r8) ach4                    ! absorptivity of 1306 cm-1 ch4 band
+   real(r8) du11                    ! co2 path length
+!
+   real(r8) du12                    !       "
+   real(r8) du13                    !       "
+   real(r8) dbetc1                  ! co2 pressure factor
+   real(r8) dbetc2                  ! co2 pressure factor
+   real(r8) aco21                   ! absorptivity of 1064 cm-1 band
+!
+   real(r8) du21                    ! co2 path length
+   real(r8) du22                    !       "
+   real(r8) du23                    !       "
+   real(r8) aco22                   ! absorptivity of 961 cm-1 band
+   real(r8) tt(pcols)               ! temp. factor for h2o overlap factor
+!
+   real(r8) psi1                    !                 "
+   real(r8) phi1                    !                 "
+   real(r8) p1                      ! h2o overlap factor
+   real(r8) w1                      !        "
+   real(r8) ds2c(pcols)             ! continuum path length
+!
+   real(r8) duptyp(pcols)           ! p-type path length
+   real(r8) tw(pcols,6)             ! h2o transmission factor
+   real(r8) g1(6)                   !         "
+   real(r8) g2(6)                   !         "
+   real(r8) g3(6)                   !         "
+!
+   real(r8) g4(6)                   !         "
+   real(r8) ab(6)                   ! h2o temp. factor
+   real(r8) bb(6)                   !         "
+   real(r8) abp(6)                  !         "
+   real(r8) bbp(6)                  !         "
+!
+   real(r8) tcfc3                   ! transmission for cfc11 band
+   real(r8) tcfc4                   ! transmission for cfc11 band
+   real(r8) tcfc6                   ! transmission for cfc12 band
+   real(r8) tcfc7                   ! transmission for cfc12 band
+   real(r8) tcfc8                   ! transmission for cfc12 band
+!
+   real(r8) tlw                     ! h2o transmission
+   real(r8) tch4                    ! ch4 transmission
+!
+!--------------------------Data Statements------------------------------
+!
+   data g1 /0.0468556,0.0397454,0.0407664,0.0304380,0.0540398,0.0321962/
+   data g2 /14.4832,4.30242,5.23523,3.25342,0.698935,16.5599/
+   data g3 /26.1898,18.4476,15.3633,12.1927,9.14992,8.07092/
+   data g4 /0.0261782,0.0369516,0.0307266,0.0243854,0.0182932,0.0161418/
+   data ab /3.0857e-2,2.3524e-2,1.7310e-2,2.6661e-2,2.8074e-2,2.2915e-2/
+   data bb /-1.3512e-4,-6.8320e-5,-3.2609e-5,-1.0228e-5,-9.5743e-5,-1.0304e-4/
+   data abp/2.9129e-2,2.4101e-2,1.9821e-2,2.6904e-2,2.9458e-2,1.9892e-2/
+   data bbp/-1.3139e-4,-5.5688e-5,-4.6380e-5,-8.0362e-5,-1.0115e-4,-8.8061e-5/
+!
+!--------------------------Statement Functions--------------------------
+!
+   real(r8) func, u, b
+   func(u,b) = u/sqrt(4.0 + u*(1.0 + 1.0 / b))
+!
+!------------------------------------------------------------------------
+!
+   do i = 1,ncol
+      sqti(i) = sqrt(to3co2(i))
+!
+! h2o transmission
+!
+      tt(i) = abs(to3co2(i) - 250.0)
+      ds2c(i) = abs(s2c(i,k1) - s2c(i,k2))
+      duptyp(i) = abs(uptype(i,k1) - uptype(i,k2))
+   end do
+!
+   do l = 1,6
+      do i = 1,ncol
+         psi1 = exp(abp(l)*tt(i) + bbp(l)*tt(i)*tt(i))
+         phi1 = exp(ab(l)*tt(i) + bb(l)*tt(i)*tt(i))
+         p1 = pnew(i)*(psi1/phi1)/sslp
+         w1 = dw(i)*phi1
+         tw(i,l) = exp(-g1(l)*p1*(sqrt(1.0 + g2(l)*(w1/p1)) - 1.0) - &
+                   g3(l)*ds2c(i)-g4(l)*duptyp(i))
+      end do
+   end do
+!
+   do i=1,ncol
+      tw(i,1)=tw(i,1)*(0.7*aer_trn_ttl(i,k1,k2,idx_LW_0650_0800)+&! l=1: 0750--0820 cm-1
+                       0.3*aer_trn_ttl(i,k1,k2,idx_LW_0800_1000)) 
+      tw(i,2)=tw(i,2)*aer_trn_ttl(i,k1,k2,idx_LW_0800_1000) ! l=2: 0820--0880 cm-1
+      tw(i,3)=tw(i,3)*aer_trn_ttl(i,k1,k2,idx_LW_0800_1000) ! l=3: 0880--0900 cm-1
+      tw(i,4)=tw(i,4)*aer_trn_ttl(i,k1,k2,idx_LW_0800_1000) ! l=4: 0900--1000 cm-1
+      tw(i,5)=tw(i,5)*aer_trn_ttl(i,k1,k2,idx_LW_1000_1200) ! l=5: 1000--1120 cm-1
+      tw(i,6)=tw(i,6)*aer_trn_ttl(i,k1,k2,idx_LW_1000_1200) ! l=6: 1120--1170 cm-1
+   end do                    ! end loop over lon
+   do i = 1,ncol
+      du1 = abs(ucfc11(i,k1) - ucfc11(i,k2))
+      du2 = abs(ucfc12(i,k1) - ucfc12(i,k2))
+!
+! cfc transmissions
+!
+      tcfc3 = exp(-175.005*du1)
+      tcfc4 = exp(-1202.18*du1)
+      tcfc6 = exp(-5786.73*du2)
+      tcfc7 = exp(-2873.51*du2)
+      tcfc8 = exp(-2085.59*du2)
+!
+! Absorptivity for CFC11 bands
+!
+      acfc1 =  50.0*(1.0 - exp(-54.09*du1))*tw(i,1)*abplnk1(7,i,k2)
+      acfc2 =  60.0*(1.0 - exp(-5130.03*du1))*tw(i,2)*abplnk1(8,i,k2)
+      acfc3 =  60.0*(1.0 - tcfc3)*tw(i,4)*tcfc6*abplnk1(9,i,k2)
+      acfc4 = 100.0*(1.0 - tcfc4)*tw(i,5)*abplnk1(10,i,k2)
+!
+! Absorptivity for CFC12 bands
+!
+      acfc5 = 45.0*(1.0 - exp(-1272.35*du2))*tw(i,3)*abplnk1(11,i,k2)
+      acfc6 = 50.0*(1.0 - tcfc6)* tw(i,4) * abplnk1(12,i,k2)
+      acfc7 = 80.0*(1.0 - tcfc7)* tw(i,5) * tcfc4*abplnk1(13,i,k2)
+      acfc8 = 70.0*(1.0 - tcfc8)* tw(i,6) * abplnk1(14,i,k2)
+!
+! Emissivity for CH4 band 1306 cm-1
+!
+      tlw = exp(-1.0*sqrt(dplh2o(i)))
+      tlw=tlw*aer_trn_ttl(i,k1,k2,idx_LW_1200_2000)
+      duch4 = abs(uch4(i,k1) - uch4(i,k2))
+      dbetac = abs(bch4(i,k1) - bch4(i,k2))/duch4
+      ach4 = 6.00444*sqti(i)*log(1.0 + func(duch4,dbetac))*tlw*abplnk1(3,i,k2)
+      tch4 = 1.0/(1.0 + 0.02*func(duch4,dbetac))
+!
+! Absorptivity for N2O bands
+!
+      du01 = abs(un2o0(i,k1) - un2o0(i,k2))
+      du11 = abs(un2o1(i,k1) - un2o1(i,k2))
+      dbeta01 = abs(bn2o0(i,k1) - bn2o0(i,k2))/du01
+      dbeta11 = abs(bn2o1(i,k1) - bn2o1(i,k2))/du11
+!
+! 1285 cm-1 band
+!
+      an2o1 = 2.35558*sqti(i)*log(1.0 + func(du01,dbeta01) &
+              + func(du11,dbeta11))*tlw*tch4*abplnk1(4,i,k2)
+      du02 = 0.100090*du01
+      du12 = 0.0992746*du11
+      dbeta02 = 0.964282*dbeta01
+!
+! 589 cm-1 band
+!
+      an2o2 = 2.65581*sqti(i)*log(1.0 + func(du02,dbeta02) + &
+              func(du12,dbeta02))*th2o(i)*tco2(i)*abplnk1(5,i,k2)
+      du03 = 0.0333767*du01
+      dbeta03 = 0.982143*dbeta01
+!
+! 1168 cm-1 band
+!
+      an2o3 = 2.54034*sqti(i)*log(1.0 + func(du03,dbeta03))* &
+              tw(i,6)*tcfc8*abplnk1(6,i,k2)
+!
+! Emissivity for 1064 cm-1 band of CO2
+!
+      du11 = abs(uco211(i,k1) - uco211(i,k2))
+      du12 = abs(uco212(i,k1) - uco212(i,k2))
+      du13 = abs(uco213(i,k1) - uco213(i,k2))
+      dbetc1 = 2.97558*abs(pnm(i,k1) + pnm(i,k2))/(2.0*sslp*sqti(i))
+      dbetc2 = 2.0*dbetc1
+      aco21 = 3.7571*sqti(i)*log(1.0 + func(du11,dbetc1) &
+              + func(du12,dbetc2) + func(du13,dbetc2)) &
+              *to3(i)*tw(i,5)*tcfc4*tcfc7*abplnk1(2,i,k2)
+!
+! Emissivity for 961 cm-1 band
+!
+      du21 = abs(uco221(i,k1) - uco221(i,k2))
+      du22 = abs(uco222(i,k1) - uco222(i,k2))
+      du23 = abs(uco223(i,k1) - uco223(i,k2))
+      aco22 = 3.8443*sqti(i)*log(1.0 + func(du21,dbetc1) &
+              + func(du22,dbetc1) + func(du23,dbetc2)) &
+              *tw(i,4)*tcfc3*tcfc6*abplnk1(1,i,k2)
+!
+! total trace gas absorptivity
+!
+      abstrc(i) = acfc1 + acfc2 + acfc3 + acfc4 + acfc5 + acfc6 + &
+                  acfc7 + acfc8 + an2o1 + an2o2 + an2o3 + ach4 + &
+                  aco21 + aco22
+   end do
+!
+   return
+!
+end subroutine trcab
+
+
+
+subroutine trcabn(lchnk   ,ncol    ,pcols, pverp,               &
+                  k2      ,kn      ,ucfc11  ,ucfc12  ,un2o0   , &
+                  un2o1   ,uch4    ,uco211  ,uco212  ,uco213  , &
+                  uco221  ,uco222  ,uco223  ,tbar    ,bplnk   , &
+                  winpl   ,pinpl   ,tco2    ,th2o    ,to3     , &
+                  uptype  ,dw      ,s2c     ,up2     ,pnew    , &
+                  abstrc  ,uinpl   , &
+                  aer_trn_ngh)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Calculate nearest layer absorptivity due to CH4, N2O, CFC11 and CFC12
+! 
+! Method: 
+! Equations in CCM3 description
+! 
+! Author: J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use volcrad
+
+   implicit none
+ 
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                 ! chunk identifier
+   integer, intent(in) :: ncol                  ! number of atmospheric columns
+   integer, intent(in) :: pcols, pverp
+   integer, intent(in) :: k2                    ! level index
+   integer, intent(in) :: kn                    ! level index
+!
+   real(r8), intent(in) :: tbar(pcols,4)        ! pressure weighted temperature
+   real(r8), intent(in) :: ucfc11(pcols,pverp)  ! CFC11 path length
+   real(r8), intent(in) :: ucfc12(pcols,pverp)  ! CFC12 path length
+   real(r8), intent(in) :: un2o0(pcols,pverp)   ! N2O path length
+   real(r8), intent(in) :: un2o1(pcols,pverp)   ! N2O path length (hot band)
+!
+   real(r8), intent(in) :: uch4(pcols,pverp)    ! CH4 path length
+   real(r8), intent(in) :: uco211(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco212(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco213(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco221(pcols,pverp)  ! CO2 10.4 micron band path length
+!
+   real(r8), intent(in) :: uco222(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uco223(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: bplnk(14,pcols,4)    ! weighted Planck fnc. for absorptivity
+   real(r8), intent(in) :: winpl(pcols,4)       ! fractional path length
+   real(r8), intent(in) :: pinpl(pcols,4)       ! pressure factor for subdivided layer
+!
+   real(r8), intent(in) :: tco2(pcols)          ! co2 transmission
+   real(r8), intent(in) :: th2o(pcols)          ! h2o transmission
+   real(r8), intent(in) :: to3(pcols)           ! o3 transmission
+   real(r8), intent(in) :: dw(pcols)            ! h2o path length
+   real(r8), intent(in) :: pnew(pcols)          ! pressure factor
+!
+   real(r8), intent(in) :: s2c(pcols,pverp)     ! h2o continuum factor
+   real(r8), intent(in) :: uptype(pcols,pverp)  ! p-type path length
+   real(r8), intent(in) :: up2(pcols)           ! p squared path length
+   real(r8), intent(in) :: uinpl(pcols,4)       ! Nearest layer subdivision factor
+   real(r8), intent(in) :: aer_trn_ngh(pcols,bnd_nbr_LW) 
+                             ! [fraction] Total transmission between 
+                             !            nearest neighbor sub-levels
+!
+!  Output Arguments
+!
+   real(r8), intent(out) :: abstrc(pcols)        ! total trace gas absorptivity
+
+!
+!--------------------------Local Variables------------------------------
+!
+   integer i,l                   ! loop counters
+!
+   real(r8) sqti(pcols)          ! square root of mean temp
+   real(r8) rsqti(pcols)         ! reciprocal of sqti
+   real(r8) du1                  ! cfc11 path length
+   real(r8) du2                  ! cfc12 path length
+   real(r8) acfc1                ! absorptivity of cfc11 798 cm-1 band
+!
+   real(r8) acfc2                ! absorptivity of cfc11 846 cm-1 band
+   real(r8) acfc3                ! absorptivity of cfc11 933 cm-1 band
+   real(r8) acfc4                ! absorptivity of cfc11 1085 cm-1 band
+   real(r8) acfc5                ! absorptivity of cfc11 889 cm-1 band
+   real(r8) acfc6                ! absorptivity of cfc11 923 cm-1 band
+!
+   real(r8) acfc7                ! absorptivity of cfc11 1102 cm-1 band
+   real(r8) acfc8                ! absorptivity of cfc11 1161 cm-1 band
+   real(r8) du01                 ! n2o path length
+   real(r8) dbeta01              ! n2o pressure factors
+   real(r8) dbeta11              !        "
+!
+   real(r8)  an2o1               ! absorptivity of the 1285 cm-1 n2o band
+   real(r8) du02                 ! n2o path length
+   real(r8) dbeta02              ! n2o pressure factor
+   real(r8) an2o2                ! absorptivity of the 589 cm-1 n2o band
+   real(r8) du03                 ! n2o path length
+!
+   real(r8) dbeta03              ! n2o pressure factor
+   real(r8) an2o3                ! absorptivity of the 1168 cm-1 n2o band
+   real(r8) duch4                ! ch4 path length
+   real(r8) dbetac               ! ch4 pressure factor
+   real(r8) ach4                 ! absorptivity of the 1306 cm-1 ch4 band
+!
+   real(r8) du11                 ! co2 path length
+   real(r8) du12                 !       "
+   real(r8) du13                 !       "
+   real(r8) dbetc1               ! co2 pressure factor
+   real(r8) dbetc2               ! co2 pressure factor
+!
+   real(r8) aco21                ! absorptivity of the 1064 cm-1 co2 band
+   real(r8) du21                 ! co2 path length
+   real(r8) du22                 !       "
+   real(r8) du23                 !       "
+   real(r8) aco22                ! absorptivity of the 961 cm-1 co2 band
+!
+   real(r8) tt(pcols)            ! temp. factor for h2o overlap
+   real(r8) psi1                 !          "
+   real(r8) phi1                 !          "
+   real(r8) p1                   ! factor for h2o overlap
+   real(r8) w1                   !          "
+!
+   real(r8) ds2c(pcols)          ! continuum path length
+   real(r8) duptyp(pcols)        ! p-type path length
+   real(r8) tw(pcols,6)          ! h2o transmission overlap
+   real(r8) g1(6)                ! h2o overlap factor
+   real(r8) g2(6)                !         "
+!
+   real(r8) g3(6)                !         "
+   real(r8) g4(6)                !         "
+   real(r8) ab(6)                ! h2o temp. factor
+   real(r8) bb(6)                !         "
+   real(r8) abp(6)               !         "
+!
+   real(r8) bbp(6)               !         "
+   real(r8) tcfc3                ! transmission of cfc11 band
+   real(r8) tcfc4                ! transmission of cfc11 band
+   real(r8) tcfc6                ! transmission of cfc12 band
+   real(r8) tcfc7                !         "
+!
+   real(r8) tcfc8                !         "
+   real(r8) tlw                  ! h2o transmission
+   real(r8) tch4                 ! ch4 transmission
+!
+!--------------------------Data Statements------------------------------
+!
+   data g1 /0.0468556,0.0397454,0.0407664,0.0304380,0.0540398,0.0321962/
+   data g2 /14.4832,4.30242,5.23523,3.25342,0.698935,16.5599/
+   data g3 /26.1898,18.4476,15.3633,12.1927,9.14992,8.07092/
+   data g4 /0.0261782,0.0369516,0.0307266,0.0243854,0.0182932,0.0161418/
+   data ab /3.0857e-2,2.3524e-2,1.7310e-2,2.6661e-2,2.8074e-2,2.2915e-2/
+   data bb /-1.3512e-4,-6.8320e-5,-3.2609e-5,-1.0228e-5,-9.5743e-5,-1.0304e-4/
+   data abp/2.9129e-2,2.4101e-2,1.9821e-2,2.6904e-2,2.9458e-2,1.9892e-2/
+   data bbp/-1.3139e-4,-5.5688e-5,-4.6380e-5,-8.0362e-5,-1.0115e-4,-8.8061e-5/
+!
+!--------------------------Statement Functions--------------------------
+!
+   real(r8) func, u, b
+   func(u,b) = u/sqrt(4.0 + u*(1.0 + 1.0 / b))
+!
+!------------------------------------------------------------------
+!
+   do i = 1,ncol
+      sqti(i) = sqrt(tbar(i,kn))
+      rsqti(i) = 1. / sqti(i)
+!
+! h2o transmission
+!
+      tt(i) = abs(tbar(i,kn) - 250.0)
+      ds2c(i) = abs(s2c(i,k2+1) - s2c(i,k2))*uinpl(i,kn)
+      duptyp(i) = abs(uptype(i,k2+1) - uptype(i,k2))*uinpl(i,kn)
+   end do
+!
+   do l = 1,6
+      do i = 1,ncol
+         psi1 = exp(abp(l)*tt(i)+bbp(l)*tt(i)*tt(i))
+         phi1 = exp(ab(l)*tt(i)+bb(l)*tt(i)*tt(i))
+         p1 = pnew(i) * (psi1/phi1) / sslp
+         w1 = dw(i) * winpl(i,kn) * phi1
+         tw(i,l) = exp(- g1(l)*p1*(sqrt(1.0+g2(l)*(w1/p1))-1.0) &
+                   - g3(l)*ds2c(i)-g4(l)*duptyp(i))
+      end do
+   end do
+!
+   do i=1,ncol
+      tw(i,1)=tw(i,1)*(0.7*aer_trn_ngh(i,idx_LW_0650_0800)+&! l=1: 0750--0820 cm-1
+                       0.3*aer_trn_ngh(i,idx_LW_0800_1000))
+      tw(i,2)=tw(i,2)*aer_trn_ngh(i,idx_LW_0800_1000) ! l=2: 0820--0880 cm-1
+      tw(i,3)=tw(i,3)*aer_trn_ngh(i,idx_LW_0800_1000) ! l=3: 0880--0900 cm-1
+      tw(i,4)=tw(i,4)*aer_trn_ngh(i,idx_LW_0800_1000) ! l=4: 0900--1000 cm-1
+      tw(i,5)=tw(i,5)*aer_trn_ngh(i,idx_LW_1000_1200) ! l=5: 1000--1120 cm-1
+      tw(i,6)=tw(i,6)*aer_trn_ngh(i,idx_LW_1000_1200) ! l=6: 1120--1170 cm-1
+   end do                    ! end loop over lon
+
+   do i = 1,ncol
+!
+      du1 = abs(ucfc11(i,k2+1) - ucfc11(i,k2)) * winpl(i,kn)
+      du2 = abs(ucfc12(i,k2+1) - ucfc12(i,k2)) * winpl(i,kn)
+!
+! cfc transmissions
+!
+      tcfc3 = exp(-175.005*du1)
+      tcfc4 = exp(-1202.18*du1)
+      tcfc6 = exp(-5786.73*du2)
+      tcfc7 = exp(-2873.51*du2)
+      tcfc8 = exp(-2085.59*du2)
+!
+! Absorptivity for CFC11 bands
+!
+      acfc1 = 50.0*(1.0 - exp(-54.09*du1)) * tw(i,1)*bplnk(7,i,kn)
+      acfc2 = 60.0*(1.0 - exp(-5130.03*du1))*tw(i,2)*bplnk(8,i,kn)
+      acfc3 = 60.0*(1.0 - tcfc3)*tw(i,4)*tcfc6 * bplnk(9,i,kn)
+      acfc4 = 100.0*(1.0 - tcfc4)* tw(i,5) * bplnk(10,i,kn)
+!
+! Absorptivity for CFC12 bands
+!
+      acfc5 = 45.0*(1.0 - exp(-1272.35*du2))*tw(i,3)*bplnk(11,i,kn)
+      acfc6 = 50.0*(1.0 - tcfc6)*tw(i,4)*bplnk(12,i,kn)
+      acfc7 = 80.0*(1.0 - tcfc7)* tw(i,5)*tcfc4 *bplnk(13,i,kn)
+      acfc8 = 70.0*(1.0 - tcfc8)*tw(i,6)*bplnk(14,i,kn)
+!
+! Absorptivity for CH4 band 1306 cm-1
+!
+      tlw = exp(-1.0*sqrt(up2(i)))
+      tlw=tlw*aer_trn_ngh(i,idx_LW_1200_2000)
+      duch4 = abs(uch4(i,k2+1) - uch4(i,k2)) * winpl(i,kn)
+      dbetac = 2.94449 * pinpl(i,kn) * rsqti(i) / sslp
+      ach4 = 6.00444*sqti(i)*log(1.0 + func(duch4,dbetac)) * tlw * bplnk(3,i,kn)
+      tch4 = 1.0/(1.0 + 0.02*func(duch4,dbetac))
+!
+! Absorptivity for N2O bands
+!
+      du01 = abs(un2o0(i,k2+1) - un2o0(i,k2)) * winpl(i,kn)
+      du11 = abs(un2o1(i,k2+1) - un2o1(i,k2)) * winpl(i,kn)
+      dbeta01 = 19.399 *  pinpl(i,kn) * rsqti(i) / sslp
+      dbeta11 = dbeta01
+!
+! 1285 cm-1 band
+!
+      an2o1 = 2.35558*sqti(i)*log(1.0 + func(du01,dbeta01) &
+              + func(du11,dbeta11)) * tlw * tch4 * bplnk(4,i,kn)
+      du02 = 0.100090*du01
+      du12 = 0.0992746*du11
+      dbeta02 = 0.964282*dbeta01
+!
+! 589 cm-1 band
+!
+      an2o2 = 2.65581*sqti(i)*log(1.0 + func(du02,dbeta02) &
+              +  func(du12,dbeta02)) * tco2(i) * th2o(i) * bplnk(5,i,kn)
+      du03 = 0.0333767*du01
+      dbeta03 = 0.982143*dbeta01
+!
+! 1168 cm-1 band
+!
+      an2o3 = 2.54034*sqti(i)*log(1.0 + func(du03,dbeta03)) * &
+              tw(i,6) * tcfc8 * bplnk(6,i,kn)
+!
+! Absorptivity for 1064 cm-1 band of CO2
+!
+      du11 = abs(uco211(i,k2+1) - uco211(i,k2)) * winpl(i,kn)
+      du12 = abs(uco212(i,k2+1) - uco212(i,k2)) * winpl(i,kn)
+      du13 = abs(uco213(i,k2+1) - uco213(i,k2)) * winpl(i,kn)
+      dbetc1 = 2.97558 * pinpl(i,kn) * rsqti(i) / sslp
+      dbetc2 = 2.0 * dbetc1
+      aco21 = 3.7571*sqti(i)*log(1.0 + func(du11,dbetc1) &
+              + func(du12,dbetc2) + func(du13,dbetc2)) &
+              * to3(i) * tw(i,5) * tcfc4 * tcfc7 * bplnk(2,i,kn)
+!
+! Absorptivity for 961 cm-1 band of co2
+!
+      du21 = abs(uco221(i,k2+1) - uco221(i,k2)) * winpl(i,kn)
+      du22 = abs(uco222(i,k2+1) - uco222(i,k2)) * winpl(i,kn)
+      du23 = abs(uco223(i,k2+1) - uco223(i,k2)) * winpl(i,kn)
+      aco22 = 3.8443*sqti(i)*log(1.0 + func(du21,dbetc1) &
+              + func(du22,dbetc1) + func(du23,dbetc2)) &
+              * tw(i,4) * tcfc3 * tcfc6 * bplnk(1,i,kn)
+!
+! total trace gas absorptivity
+!
+      abstrc(i) = acfc1 + acfc2 + acfc3 + acfc4 + acfc5 + acfc6 + &
+                  acfc7 + acfc8 + an2o1 + an2o2 + an2o3 + ach4 + &
+                  aco21 + aco22
+   end do
+!
+   return
+!
+end subroutine trcabn
+
+
+
+
+
+subroutine trcems(lchnk   ,ncol    ,pcols, pverp,               &
+                  k       ,co2t    ,pnm     ,ucfc11  ,ucfc12  , &
+                  un2o0   ,un2o1   ,bn2o0   ,bn2o1   ,uch4    , &
+                  bch4    ,uco211  ,uco212  ,uco213  ,uco221  , &
+                  uco222  ,uco223  ,uptype  ,w       ,s2c     , &
+                  up2     ,emplnk  ,th2o    ,tco2    ,to3     , &
+                  emstrc  , &
+                 aer_trn_ttl)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+!  Calculate emissivity for CH4, N2O, CFC11 and CFC12 bands.
+! 
+! Method: 
+!  See CCM3 Description for equations.
+! 
+! Author: J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use volcrad
+
+   implicit none
+
+!
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                 ! chunk identifier
+   integer, intent(in) :: ncol                  ! number of atmospheric columns
+   integer, intent(in) :: pcols, pverp
+
+   real(r8), intent(in) :: co2t(pcols,pverp)    ! pressure weighted temperature
+   real(r8), intent(in) :: pnm(pcols,pverp)     ! interface pressure
+   real(r8), intent(in) :: ucfc11(pcols,pverp)  ! CFC11 path length
+   real(r8), intent(in) :: ucfc12(pcols,pverp)  ! CFC12 path length
+   real(r8), intent(in) :: un2o0(pcols,pverp)   ! N2O path length
+!
+   real(r8), intent(in) :: un2o1(pcols,pverp)   ! N2O path length (hot band)
+   real(r8), intent(in) :: uch4(pcols,pverp)    ! CH4 path length
+   real(r8), intent(in) :: uco211(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco212(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8), intent(in) :: uco213(pcols,pverp)  ! CO2 9.4 micron band path length
+!
+   real(r8), intent(in) :: uco221(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uco222(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uco223(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8), intent(in) :: uptype(pcols,pverp)  ! continuum path length
+   real(r8), intent(in) :: bn2o0(pcols,pverp)   ! pressure factor for n2o
+!
+   real(r8), intent(in) :: bn2o1(pcols,pverp)   ! pressure factor for n2o
+   real(r8), intent(in) :: bch4(pcols,pverp)    ! pressure factor for ch4
+   real(r8), intent(in) :: emplnk(14,pcols)     ! emissivity Planck factor
+   real(r8), intent(in) :: th2o(pcols)          ! water vapor overlap factor
+   real(r8), intent(in) :: tco2(pcols)          ! co2 overlap factor
+!
+   real(r8), intent(in) :: to3(pcols)           ! o3 overlap factor
+   real(r8), intent(in) :: s2c(pcols,pverp)     ! h2o continuum path length
+   real(r8), intent(in) :: w(pcols,pverp)       ! h2o path length
+   real(r8), intent(in) :: up2(pcols)           ! pressure squared h2o path length
+!
+   integer, intent(in) :: k                 ! level index
+
+   real(r8), intent(in) :: aer_trn_ttl(pcols,pverp,pverp,bnd_nbr_LW) ! aer trn.
+
+!
+!  Output Arguments
+!
+   real(r8), intent(out) :: emstrc(pcols,pverp)  ! total trace gas emissivity
+
+!
+!--------------------------Local Variables------------------------------
+!
+   integer i,l               ! loop counters
+!
+   real(r8) sqti(pcols)          ! square root of mean temp
+   real(r8) ecfc1                ! emissivity of cfc11 798 cm-1 band
+   real(r8) ecfc2                !     "      "    "   846 cm-1 band
+   real(r8) ecfc3                !     "      "    "   933 cm-1 band
+   real(r8) ecfc4                !     "      "    "   1085 cm-1 band
+!
+   real(r8) ecfc5                !     "      "  cfc12 889 cm-1 band
+   real(r8) ecfc6                !     "      "    "   923 cm-1 band
+   real(r8) ecfc7                !     "      "    "   1102 cm-1 band
+   real(r8) ecfc8                !     "      "    "   1161 cm-1 band
+   real(r8) u01                  ! n2o path length
+!
+   real(r8) u11                  ! n2o path length
+   real(r8) beta01               ! n2o pressure factor
+   real(r8) beta11               ! n2o pressure factor
+   real(r8) en2o1                ! emissivity of the 1285 cm-1 N2O band
+   real(r8) u02                  ! n2o path length
+!
+   real(r8) u12                  ! n2o path length
+   real(r8) beta02               ! n2o pressure factor
+   real(r8) en2o2                ! emissivity of the 589 cm-1 N2O band
+   real(r8) u03                  ! n2o path length
+   real(r8) beta03               ! n2o pressure factor
+!
+   real(r8) en2o3                ! emissivity of the 1168 cm-1 N2O band
+   real(r8) betac                ! ch4 pressure factor
+   real(r8) ech4                 ! emissivity of 1306 cm-1 CH4 band
+   real(r8) betac1               ! co2 pressure factor
+   real(r8) betac2               ! co2 pressure factor
+!
+   real(r8) eco21                ! emissivity of 1064 cm-1 CO2 band
+   real(r8) eco22                ! emissivity of 961 cm-1 CO2 band
+   real(r8) tt(pcols)            ! temp. factor for h2o overlap factor
+   real(r8) psi1                 ! narrow band h2o temp. factor
+   real(r8) phi1                 !             "
+!
+   real(r8) p1                   ! h2o line overlap factor
+   real(r8) w1                   !          "
+   real(r8) tw(pcols,6)          ! h2o transmission overlap
+   real(r8) g1(6)                ! h2o overlap factor
+   real(r8) g2(6)                !          "
+!
+   real(r8) g3(6)                !          "
+   real(r8) g4(6)                !          "
+   real(r8) ab(6)                !          "
+   real(r8) bb(6)                !          "
+   real(r8) abp(6)               !          "
+!
+   real(r8) bbp(6)               !          "
+   real(r8) tcfc3                ! transmission for cfc11 band
+   real(r8) tcfc4                !          "
+   real(r8) tcfc6                ! transmission for cfc12 band
+   real(r8) tcfc7                !          "
+!
+   real(r8) tcfc8                !          "
+   real(r8) tlw                  ! h2o overlap factor
+   real(r8) tch4                 ! ch4 overlap factor
+!
+!--------------------------Data Statements------------------------------
+!
+   data g1 /0.0468556,0.0397454,0.0407664,0.0304380,0.0540398,0.0321962/
+   data g2 /14.4832,4.30242,5.23523,3.25342,0.698935,16.5599/
+   data g3 /26.1898,18.4476,15.3633,12.1927,9.14992,8.07092/
+   data g4 /0.0261782,0.0369516,0.0307266,0.0243854,0.0182932,0.0161418/
+   data ab /3.0857e-2,2.3524e-2,1.7310e-2,2.6661e-2,2.8074e-2,2.2915e-2/
+   data bb /-1.3512e-4,-6.8320e-5,-3.2609e-5,-1.0228e-5,-9.5743e-5,-1.0304e-4/
+   data abp/2.9129e-2,2.4101e-2,1.9821e-2,2.6904e-2,2.9458e-2,1.9892e-2/
+   data bbp/-1.3139e-4,-5.5688e-5,-4.6380e-5,-8.0362e-5,-1.0115e-4,-8.8061e-5/
+!
+!--------------------------Statement Functions--------------------------
+!
+   real(r8) func, u, b
+   func(u,b) = u/sqrt(4.0 + u*(1.0 + 1.0 / b))
+!
+!-----------------------------------------------------------------------
+!
+   do i = 1,ncol
+      sqti(i) = sqrt(co2t(i,k))
+!
+! Transmission for h2o
+!
+      tt(i) = abs(co2t(i,k) - 250.0)
+   end do
+!
+   do l = 1,6
+      do i = 1,ncol
+         psi1 = exp(abp(l)*tt(i)+bbp(l)*tt(i)*tt(i))
+         phi1 = exp(ab(l)*tt(i)+bb(l)*tt(i)*tt(i))
+         p1 = pnm(i,k) * (psi1/phi1) / sslp
+         w1 = w(i,k) * phi1
+         tw(i,l) = exp(- g1(l)*p1*(sqrt(1.0+g2(l)*(w1/p1))-1.0) &
+                   - g3(l)*s2c(i,k)-g4(l)*uptype(i,k))
+      end do
+   end do
+
+!     Overlap H2O tranmission with STRAER continuum in 6 trace gas 
+!                 subbands
+
+      do i=1,ncol
+         tw(i,1)=tw(i,1)*(0.7*aer_trn_ttl(i,k,1,idx_LW_0650_0800)+&! l=1: 0750--0820 cm-1
+                          0.3*aer_trn_ttl(i,k,1,idx_LW_0800_1000))
+         tw(i,2)=tw(i,2)*aer_trn_ttl(i,k,1,idx_LW_0800_1000) ! l=2: 0820--0880 cm-1
+         tw(i,3)=tw(i,3)*aer_trn_ttl(i,k,1,idx_LW_0800_1000) ! l=3: 0880--0900 cm-1
+         tw(i,4)=tw(i,4)*aer_trn_ttl(i,k,1,idx_LW_0800_1000) ! l=4: 0900--1000 cm-1
+         tw(i,5)=tw(i,5)*aer_trn_ttl(i,k,1,idx_LW_1000_1200) ! l=5: 1000--1120 cm-1
+         tw(i,6)=tw(i,6)*aer_trn_ttl(i,k,1,idx_LW_1000_1200) ! l=6: 1120--1170 cm-1
+      end do                    ! end loop over lon
+!
+   do i = 1,ncol
+!
+! transmission due to cfc bands
+!
+      tcfc3 = exp(-175.005*ucfc11(i,k))
+      tcfc4 = exp(-1202.18*ucfc11(i,k))
+      tcfc6 = exp(-5786.73*ucfc12(i,k))
+      tcfc7 = exp(-2873.51*ucfc12(i,k))
+      tcfc8 = exp(-2085.59*ucfc12(i,k))
+!
+! Emissivity for CFC11 bands
+!
+      ecfc1 = 50.0*(1.0 - exp(-54.09*ucfc11(i,k))) * tw(i,1) * emplnk(7,i)
+      ecfc2 = 60.0*(1.0 - exp(-5130.03*ucfc11(i,k)))* tw(i,2) * emplnk(8,i)
+      ecfc3 = 60.0*(1.0 - tcfc3)*tw(i,4)*tcfc6*emplnk(9,i)
+      ecfc4 = 100.0*(1.0 - tcfc4)*tw(i,5)*emplnk(10,i)
+!
+! Emissivity for CFC12 bands
+!
+      ecfc5 = 45.0*(1.0 - exp(-1272.35*ucfc12(i,k)))*tw(i,3)*emplnk(11,i)
+      ecfc6 = 50.0*(1.0 - tcfc6)*tw(i,4)*emplnk(12,i)
+      ecfc7 = 80.0*(1.0 - tcfc7)*tw(i,5)* tcfc4 * emplnk(13,i)
+      ecfc8 = 70.0*(1.0 - tcfc8)*tw(i,6) * emplnk(14,i)
+!
+! Emissivity for CH4 band 1306 cm-1
+!
+      tlw = exp(-1.0*sqrt(up2(i)))
+
+!     Overlap H2O vibration rotation band with STRAER continuum 
+!             for CH4 1306 cm-1 and N2O 1285 cm-1 bands
+
+            tlw=tlw*aer_trn_ttl(i,k,1,idx_LW_1200_2000)
+      betac = bch4(i,k)/uch4(i,k)
+      ech4 = 6.00444*sqti(i)*log(1.0 + func(uch4(i,k),betac)) *tlw * emplnk(3,i)
+      tch4 = 1.0/(1.0 + 0.02*func(uch4(i,k),betac))
+!
+! Emissivity for N2O bands
+!
+      u01 = un2o0(i,k)
+      u11 = un2o1(i,k)
+      beta01 = bn2o0(i,k)/un2o0(i,k)
+      beta11 = bn2o1(i,k)/un2o1(i,k)
+!
+! 1285 cm-1 band
+!
+      en2o1 = 2.35558*sqti(i)*log(1.0 + func(u01,beta01) + &
+              func(u11,beta11))*tlw*tch4*emplnk(4,i)
+      u02 = 0.100090*u01
+      u12 = 0.0992746*u11
+      beta02 = 0.964282*beta01
+!
+! 589 cm-1 band
+!
+      en2o2 = 2.65581*sqti(i)*log(1.0 + func(u02,beta02) + &
+              func(u12,beta02)) * tco2(i) * th2o(i) * emplnk(5,i)
+      u03 = 0.0333767*u01
+      beta03 = 0.982143*beta01
+!
+! 1168 cm-1 band
+!
+      en2o3 = 2.54034*sqti(i)*log(1.0 + func(u03,beta03)) * &
+              tw(i,6) * tcfc8 * emplnk(6,i)
+!
+! Emissivity for 1064 cm-1 band of CO2
+!
+      betac1 = 2.97558*pnm(i,k) / (sslp*sqti(i))
+      betac2 = 2.0 * betac1
+      eco21 = 3.7571*sqti(i)*log(1.0 + func(uco211(i,k),betac1) &
+              + func(uco212(i,k),betac2) + func(uco213(i,k),betac2)) &
+              * to3(i) * tw(i,5) * tcfc4 * tcfc7 * emplnk(2,i)
+!
+! Emissivity for 961 cm-1 band
+!
+      eco22 = 3.8443*sqti(i)*log(1.0 + func(uco221(i,k),betac1) &
+              + func(uco222(i,k),betac1) + func(uco223(i,k),betac2)) &
+              * tw(i,4) * tcfc3 * tcfc6 * emplnk(1,i)
+!
+! total trace gas emissivity
+!
+      emstrc(i,k) = ecfc1 + ecfc2 + ecfc3 + ecfc4 + ecfc5 +ecfc6 + &
+                    ecfc7 + ecfc8 + en2o1 + en2o2 + en2o3 + ech4 + &
+                    eco21 + eco22
+   end do
+!
+   return
+!
+end subroutine trcems
+
+subroutine trcmix(lchnk   ,ncol     ,pcols, pver, &
+                  pmid    ,clat, n2o      ,ch4     ,          &
+                  cfc11   , cfc12   )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Specify zonal mean mass mixing ratios of CH4, N2O, CFC11 and
+! CFC12
+! 
+! Method: 
+! Distributions assume constant mixing ratio in the troposphere
+! and a decrease of mixing ratio in the stratosphere. Tropopause
+! defined by ptrop. The scale height of the particular trace gas
+! depends on latitude. This assumption produces a more realistic
+! stratospheric distribution of the various trace gases.
+! 
+! Author: J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use phys_grid,    only: get_rlat_all_p
+!  use physconst,    only: mwdry, mwch4, mwn2o, mwf11, mwf12
+!  use ghg_surfvals, only: ch4vmr, n2ovmr, f11vmr, f12vmr
+
+   implicit none
+
+!-----------------------------Arguments---------------------------------
+!
+! Input
+!
+   integer, intent(in) :: lchnk                    ! chunk identifier
+   integer, intent(in) :: ncol                     ! number of atmospheric columns
+   integer, intent(in) :: pcols, pver
+
+   real(r8), intent(in) :: pmid(pcols,pver)        ! model pressures
+   real(r8), intent(in) :: clat(pcols)             ! latitude in radians for columns
+!
+! Output
+!
+   real(r8), intent(out) :: n2o(pcols,pver)         ! nitrous oxide mass mixing ratio
+   real(r8), intent(out) :: ch4(pcols,pver)         ! methane mass mixing ratio
+   real(r8), intent(out) :: cfc11(pcols,pver)       ! cfc11 mass mixing ratio
+   real(r8), intent(out) :: cfc12(pcols,pver)       ! cfc12 mass mixing ratio
+
+!
+!--------------------------Local Variables------------------------------
+
+   real(r8) :: rmwn2o       ! ratio of molecular weight n2o   to dry air
+   real(r8) :: rmwch4       ! ratio of molecular weight ch4   to dry air
+   real(r8) :: rmwf11       ! ratio of molecular weight cfc11 to dry air
+   real(r8) :: rmwf12       ! ratio of molecular weight cfc12 to dry air
+!
+   integer i                ! longitude loop index
+   integer k                ! level index
+!
+!  real(r8) clat(pcols)         ! latitude in radians for columns
+   real(r8) coslat(pcols)       ! cosine of latitude
+   real(r8) dlat                ! latitude in degrees
+   real(r8) ptrop               ! pressure level of tropopause
+   real(r8) pratio              ! pressure divided by ptrop
+!
+   real(r8) xn2o                ! pressure scale height for n2o
+   real(r8) xch4                ! pressure scale height for ch4
+   real(r8) xcfc11              ! pressure scale height for cfc11
+   real(r8) xcfc12              ! pressure scale height for cfc12
+!
+   real(r8) ch40                ! tropospheric mass mixing ratio for ch4
+   real(r8) n2o0                ! tropospheric mass mixing ratio for n2o
+   real(r8) cfc110              ! tropospheric mass mixing ratio for cfc11
+   real(r8) cfc120              ! tropospheric mass mixing ratio for cfc12
+!
+!-----------------------------------------------------------------------
+   rmwn2o = mwn2o/mwdry      ! ratio of molecular weight n2o   to dry air
+   rmwch4 = mwch4/mwdry      ! ratio of molecular weight ch4   to dry air
+   rmwf11 = mwf11/mwdry      ! ratio of molecular weight cfc11 to dry air
+   rmwf12 = mwf12/mwdry      ! ratio of molecular weight cfc12 to dry air
+!
+! get latitudes
+!
+!  call get_rlat_all_p(lchnk, ncol, clat)
+   do i = 1, ncol
+      coslat(i) = cos(clat(i))
+   end do
+!
+! set tropospheric mass mixing ratios
+!
+   ch40   = rmwch4 * ch4vmr
+   n2o0   = rmwn2o * n2ovmr
+   cfc110 = rmwf11 * f11vmr
+   cfc120 = rmwf12 * f12vmr
+
+   do i = 1, ncol
+      coslat(i) = cos(clat(i))
+   end do
+!
+   do k = 1,pver
+      do i = 1,ncol
+!
+!        set stratospheric scale height factor for gases
+         dlat = abs(57.2958 * clat(i))
+         if(dlat.le.45.0) then
+            xn2o = 0.3478 + 0.00116 * dlat
+            xch4 = 0.2353
+            xcfc11 = 0.7273 + 0.00606 * dlat
+            xcfc12 = 0.4000 + 0.00222 * dlat
+         else
+            xn2o = 0.4000 + 0.013333 * (dlat - 45)
+            xch4 = 0.2353 + 0.0225489 * (dlat - 45)
+            xcfc11 = 1.00 + 0.013333 * (dlat - 45)
+            xcfc12 = 0.50 + 0.024444 * (dlat - 45)
+         end if
+!
+!        pressure of tropopause
+         ptrop = 250.0e2 - 150.0e2*coslat(i)**2.0
+!
+!        determine output mass mixing ratios
+         if (pmid(i,k) >= ptrop) then
+            ch4(i,k) = ch40
+            n2o(i,k) = n2o0
+            cfc11(i,k) = cfc110
+            cfc12(i,k) = cfc120
+         else
+            pratio = pmid(i,k)/ptrop
+            ch4(i,k) = ch40 * (pratio)**xch4
+            n2o(i,k) = n2o0 * (pratio)**xn2o
+            cfc11(i,k) = cfc110 * (pratio)**xcfc11
+            cfc12(i,k) = cfc120 * (pratio)**xcfc12
+         end if
+      end do
+   end do
+!
+   return
+!
+end subroutine trcmix
+
+subroutine trcplk(lchnk   ,ncol    ,pcols, pver, pverp,         &
+                  tint    ,tlayr   ,tplnke  ,emplnk  ,abplnk1 , &
+                  abplnk2 )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+!   Calculate Planck factors for absorptivity and emissivity of
+!   CH4, N2O, CFC11 and CFC12
+! 
+! Method: 
+!   Planck function and derivative evaluated at the band center.
+! 
+! Author: J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+
+   implicit none
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                ! chunk identifier
+   integer, intent(in) :: ncol                 ! number of atmospheric columns
+   integer, intent(in) :: pcols, pver, pverp
+
+   real(r8), intent(in) :: tint(pcols,pverp)   ! interface temperatures
+   real(r8), intent(in) :: tlayr(pcols,pverp)  ! k-1 level temperatures
+   real(r8), intent(in) :: tplnke(pcols)       ! Top Layer temperature
+!
+! output arguments
+!
+   real(r8), intent(out) :: emplnk(14,pcols)         ! emissivity Planck factor
+   real(r8), intent(out) :: abplnk1(14,pcols,pverp)  ! non-nearest layer Plack factor
+   real(r8), intent(out) :: abplnk2(14,pcols,pverp)  ! nearest layer factor
+
+!
+!--------------------------Local Variables------------------------------
+!
+   integer wvl                   ! wavelength index
+   integer i,k                   ! loop counters
+!
+   real(r8) f1(14)                   ! Planck function factor
+   real(r8) f2(14)                   !        "
+   real(r8) f3(14)                   !        "
+!
+!--------------------------Data Statements------------------------------
+!
+   data f1 /5.85713e8,7.94950e8,1.47009e9,1.40031e9,1.34853e8, &
+            1.05158e9,3.35370e8,3.99601e8,5.35994e8,8.42955e8, &
+            4.63682e8,5.18944e8,8.83202e8,1.03279e9/
+   data f2 /2.02493e11,3.04286e11,6.90698e11,6.47333e11, &
+            2.85744e10,4.41862e11,9.62780e10,1.21618e11, &
+            1.79905e11,3.29029e11,1.48294e11,1.72315e11, &
+            3.50140e11,4.31364e11/
+   data f3 /1383.0,1531.0,1879.0,1849.0,848.0,1681.0, &
+            1148.0,1217.0,1343.0,1561.0,1279.0,1328.0, &
+            1586.0,1671.0/
+!
+!-----------------------------------------------------------------------
+!
+! Calculate emissivity Planck factor
+!
+   do wvl = 1,14
+      do i = 1,ncol
+         emplnk(wvl,i) = f1(wvl)/(tplnke(i)**4.0*(exp(f3(wvl)/tplnke(i))-1.0))
+      end do
+   end do
+!
+! Calculate absorptivity Planck factor for tint and tlayr temperatures
+!
+   do wvl = 1,14
+      do k = ntoplw, pverp
+         do i = 1, ncol
+!
+! non-nearlest layer function
+!
+            abplnk1(wvl,i,k) = (f2(wvl)*exp(f3(wvl)/tint(i,k)))  &
+                               /(tint(i,k)**5.0*(exp(f3(wvl)/tint(i,k))-1.0)**2.0)
+!
+! nearest layer function
+!
+            abplnk2(wvl,i,k) = (f2(wvl)*exp(f3(wvl)/tlayr(i,k))) &
+                               /(tlayr(i,k)**5.0*(exp(f3(wvl)/tlayr(i,k))-1.0)**2.0)
+         end do
+      end do
+   end do
+!
+   return
+end subroutine trcplk
+
+subroutine trcpth(lchnk   ,ncol    ,pcols, pver, pverp,         &
+                  tnm     ,pnm     ,cfc11   ,cfc12   ,n2o     , &
+                  ch4     ,qnm     ,ucfc11  ,ucfc12  ,un2o0   , &
+                  un2o1   ,uch4    ,uco211  ,uco212  ,uco213  , &
+                  uco221  ,uco222  ,uco223  ,bn2o0   ,bn2o1   , &
+                  bch4    ,uptype  )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Calculate path lengths and pressure factors for CH4, N2O, CFC11
+! and CFC12.
+! 
+! Method: 
+! See CCM3 description for details
+! 
+! Author: J. Kiehl
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+!  use ppgrid
+!  use ghg_surfvals, only: co2mmr
+
+   implicit none
+
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: lchnk                 ! chunk identifier
+   integer, intent(in) :: ncol                  ! number of atmospheric columns
+   integer, intent(in) :: pcols, pver, pverp
+
+   real(r8), intent(in) :: tnm(pcols,pver)      ! Model level temperatures
+   real(r8), intent(in) :: pnm(pcols,pverp)     ! Pres. at model interfaces (dynes/cm2)
+   real(r8), intent(in) :: qnm(pcols,pver)      ! h2o specific humidity
+   real(r8), intent(in) :: cfc11(pcols,pver)    ! CFC11 mass mixing ratio
+!
+   real(r8), intent(in) :: cfc12(pcols,pver)    ! CFC12 mass mixing ratio
+   real(r8), intent(in) :: n2o(pcols,pver)      ! N2O mass mixing ratio
+   real(r8), intent(in) :: ch4(pcols,pver)      ! CH4 mass mixing ratio
+
+!
+! Output arguments
+!
+   real(r8), intent(out) :: ucfc11(pcols,pverp)  ! CFC11 path length
+   real(r8), intent(out) :: ucfc12(pcols,pverp)  ! CFC12 path length
+   real(r8), intent(out) :: un2o0(pcols,pverp)   ! N2O path length
+   real(r8), intent(out) :: un2o1(pcols,pverp)   ! N2O path length (hot band)
+   real(r8), intent(out) :: uch4(pcols,pverp)    ! CH4 path length
+!
+   real(r8), intent(out) :: uco211(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8), intent(out) :: uco212(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8), intent(out) :: uco213(pcols,pverp)  ! CO2 9.4 micron band path length
+   real(r8), intent(out) :: uco221(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8), intent(out) :: uco222(pcols,pverp)  ! CO2 10.4 micron band path length
+!
+   real(r8), intent(out) :: uco223(pcols,pverp)  ! CO2 10.4 micron band path length
+   real(r8), intent(out) :: bn2o0(pcols,pverp)   ! pressure factor for n2o
+   real(r8), intent(out) :: bn2o1(pcols,pverp)   ! pressure factor for n2o
+   real(r8), intent(out) :: bch4(pcols,pverp)    ! pressure factor for ch4
+   real(r8), intent(out) :: uptype(pcols,pverp)  ! p-type continuum path length
+
+!
+!---------------------------Local variables-----------------------------
+!
+   integer   i               ! Longitude index
+   integer   k               ! Level index
+!
+   real(r8) co2fac(pcols,1)      ! co2 factor
+   real(r8) alpha1(pcols)        ! stimulated emission term
+   real(r8) alpha2(pcols)        ! stimulated emission term
+   real(r8) rt(pcols)            ! reciprocal of local temperature
+   real(r8) rsqrt(pcols)         ! reciprocal of sqrt of temp
+!
+   real(r8) pbar(pcols)          ! mean pressure
+   real(r8) dpnm(pcols)          ! difference in pressure
+   real(r8) diff                 ! diffusivity factor
+!
+!--------------------------Data Statements------------------------------
+!
+   data diff /1.66/
+!
+!-----------------------------------------------------------------------
+!
+!  Calculate path lengths for the trace gases at model top
+!
+   do i = 1,ncol
+      ucfc11(i,ntoplw) = 1.8 * cfc11(i,ntoplw) * pnm(i,ntoplw) * rga
+      ucfc12(i,ntoplw) = 1.8 * cfc12(i,ntoplw) * pnm(i,ntoplw) * rga
+      un2o0(i,ntoplw) = diff * 1.02346e5 * n2o(i,ntoplw) * pnm(i,ntoplw) * rga / sqrt(tnm(i,ntoplw))
+      un2o1(i,ntoplw) = diff * 2.01909 * un2o0(i,ntoplw) * exp(-847.36/tnm(i,ntoplw))
+      uch4(i,ntoplw)  = diff * 8.60957e4 * ch4(i,ntoplw) * pnm(i,ntoplw) * rga / sqrt(tnm(i,ntoplw))
+      co2fac(i,1)     = diff * co2mmr * pnm(i,ntoplw) * rga
+      alpha1(i) = (1.0 - exp(-1540.0/tnm(i,ntoplw)))**3.0/sqrt(tnm(i,ntoplw))
+      alpha2(i) = (1.0 - exp(-1360.0/tnm(i,ntoplw)))**3.0/sqrt(tnm(i,ntoplw))
+      uco211(i,ntoplw) = 3.42217e3 * co2fac(i,1) * alpha1(i) * exp(-1849.7/tnm(i,ntoplw))
+      uco212(i,ntoplw) = 6.02454e3 * co2fac(i,1) * alpha1(i) * exp(-2782.1/tnm(i,ntoplw))
+      uco213(i,ntoplw) = 5.53143e3 * co2fac(i,1) * alpha1(i) * exp(-3723.2/tnm(i,ntoplw))
+      uco221(i,ntoplw) = 3.88984e3 * co2fac(i,1) * alpha2(i) * exp(-1997.6/tnm(i,ntoplw))
+      uco222(i,ntoplw) = 3.67108e3 * co2fac(i,1) * alpha2(i) * exp(-3843.8/tnm(i,ntoplw))
+      uco223(i,ntoplw) = 6.50642e3 * co2fac(i,1) * alpha2(i) * exp(-2989.7/tnm(i,ntoplw))
+      bn2o0(i,ntoplw) = diff * 19.399 * pnm(i,ntoplw)**2.0 * n2o(i,ntoplw) * &
+                   1.02346e5 * rga / (sslp*tnm(i,ntoplw))
+      bn2o1(i,ntoplw) = bn2o0(i,ntoplw) * exp(-847.36/tnm(i,ntoplw)) * 2.06646e5
+      bch4(i,ntoplw) = diff * 2.94449 * ch4(i,ntoplw) * pnm(i,ntoplw)**2.0 * rga * &
+                  8.60957e4 / (sslp*tnm(i,ntoplw))
+      uptype(i,ntoplw) = diff * qnm(i,ntoplw) * pnm(i,ntoplw)**2.0 *  &
+                    exp(1800.0*(1.0/tnm(i,ntoplw) - 1.0/296.0)) * rga / sslp
+   end do
+!
+! Calculate trace gas path lengths through model atmosphere
+!
+   do k = ntoplw,pver
+      do i = 1,ncol
+         rt(i) = 1./tnm(i,k)
+         rsqrt(i) = sqrt(rt(i))
+         pbar(i) = 0.5 * (pnm(i,k+1) + pnm(i,k)) / sslp
+         dpnm(i) = (pnm(i,k+1) - pnm(i,k)) * rga
+         alpha1(i) = diff * rsqrt(i) * (1.0 - exp(-1540.0/tnm(i,k)))**3.0
+         alpha2(i) = diff * rsqrt(i) * (1.0 - exp(-1360.0/tnm(i,k)))**3.0
+         ucfc11(i,k+1) = ucfc11(i,k) +  1.8 * cfc11(i,k) * dpnm(i)
+         ucfc12(i,k+1) = ucfc12(i,k) +  1.8 * cfc12(i,k) * dpnm(i)
+         un2o0(i,k+1) = un2o0(i,k) + diff * 1.02346e5 * n2o(i,k) * rsqrt(i) * dpnm(i)
+         un2o1(i,k+1) = un2o1(i,k) + diff * 2.06646e5 * n2o(i,k) * &
+                        rsqrt(i) * exp(-847.36/tnm(i,k)) * dpnm(i)
+         uch4(i,k+1) = uch4(i,k) + diff * 8.60957e4 * ch4(i,k) * rsqrt(i) * dpnm(i)
+         uco211(i,k+1) = uco211(i,k) + 1.15*3.42217e3 * alpha1(i) * &
+                         co2mmr * exp(-1849.7/tnm(i,k)) * dpnm(i)
+         uco212(i,k+1) = uco212(i,k) + 1.15*6.02454e3 * alpha1(i) * &
+                         co2mmr * exp(-2782.1/tnm(i,k)) * dpnm(i)
+         uco213(i,k+1) = uco213(i,k) + 1.15*5.53143e3 * alpha1(i) * &
+                         co2mmr * exp(-3723.2/tnm(i,k)) * dpnm(i)
+         uco221(i,k+1) = uco221(i,k) + 1.15*3.88984e3 * alpha2(i) * &
+                         co2mmr * exp(-1997.6/tnm(i,k)) * dpnm(i)
+         uco222(i,k+1) = uco222(i,k) + 1.15*3.67108e3 * alpha2(i) * &
+                         co2mmr * exp(-3843.8/tnm(i,k)) * dpnm(i)
+         uco223(i,k+1) = uco223(i,k) + 1.15*6.50642e3 * alpha2(i) * &
+                         co2mmr * exp(-2989.7/tnm(i,k)) * dpnm(i)
+         bn2o0(i,k+1) = bn2o0(i,k) + diff * 19.399 * pbar(i) * rt(i) &
+                        * 1.02346e5 * n2o(i,k) * dpnm(i)
+         bn2o1(i,k+1) = bn2o1(i,k) + diff * 19.399 * pbar(i) * rt(i) &
+                        * 2.06646e5 * exp(-847.36/tnm(i,k)) * n2o(i,k)*dpnm(i)
+         bch4(i,k+1) = bch4(i,k) + diff * 2.94449 * rt(i) * pbar(i) &
+                       * 8.60957e4 * ch4(i,k) * dpnm(i)
+         uptype(i,k+1) = uptype(i,k) + diff *qnm(i,k) * &
+                         exp(1800.0*(1.0/tnm(i,k) - 1.0/296.0)) * pbar(i) * dpnm(i)
+      end do
+   end do
+!
+   return
+end subroutine trcpth
+subroutine aqsat(t       ,p       ,es      ,qs        ,ii      , &
+                 ilen    ,kk      ,kstart  ,kend      )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Utility procedure to look up and return saturation vapor pressure from
+! precomputed table, calculate and return saturation specific humidity
+! (g/g),for input arrays of temperature and pressure (dimensioned ii,kk)
+! This routine is useful for evaluating only a selected region in the
+! vertical.
+! 
+! Method: 
+! <Describe the algorithm(s) used in the routine.> 
+! <Also include any applicable external references.> 
+! 
+! Author: J. Hack
+! 
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+   integer, intent(in) :: ii             ! I dimension of arrays t, p, es, qs
+   integer, intent(in) :: kk             ! K dimension of arrays t, p, es, qs
+   integer, intent(in) :: ilen           ! Length of vectors in I direction which
+   integer, intent(in) :: kstart         ! Starting location in K direction
+   integer, intent(in) :: kend           ! Ending location in K direction
+   real(r8), intent(in) :: t(ii,kk)          ! Temperature
+   real(r8), intent(in) :: p(ii,kk)          ! Pressure
+!
+! Output arguments
+!
+   real(r8), intent(out) :: es(ii,kk)         ! Saturation vapor pressure
+   real(r8), intent(out) :: qs(ii,kk)         ! Saturation specific humidity
+!
+!---------------------------Local workspace-----------------------------
+!
+   real(r8) omeps             ! 1 - 0.622
+   integer i, k           ! Indices
+!
+!-----------------------------------------------------------------------
+!
+   omeps = 1.0 - epsqs
+   do k=kstart,kend
+      do i=1,ilen
+         es(i,k) = estblf(t(i,k))
+!
+! Saturation specific humidity
+!
+         qs(i,k) = epsqs*es(i,k)/(p(i,k) - omeps*es(i,k))
+!
+! The following check is to avoid the generation of negative values
+! that can occur in the upper stratosphere and mesosphere
+!
+         qs(i,k) = min(1.0_r8,qs(i,k))
+!
+         if (qs(i,k) < 0.0) then
+            qs(i,k) = 1.0
+            es(i,k) = p(i,k)
+         end if
+      end do
+   end do
+!
+   return
+end subroutine aqsat
+!===============================================================================
+  subroutine cldefr(lchnk   ,ncol    ,pcols, pver, pverp, &
+       landfrac,t       ,rel     ,rei     ,ps      ,pmid    , landm, icefrac, snowh)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Compute cloud water and ice particle size 
+! 
+! Method: 
+! use empirical formulas to construct effective radii
+! 
+! Author: J.T. Kiehl, B. A. Boville, P. Rasch
+! 
+!-----------------------------------------------------------------------
+
+    implicit none
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+    integer, intent(in) :: lchnk                 ! chunk identifier
+    integer, intent(in) :: ncol                  ! number of atmospheric columns
+    integer, intent(in) :: pcols, pver, pverp
+
+    real(r8), intent(in) :: landfrac(pcols)      ! Land fraction
+    real(r8), intent(in) :: icefrac(pcols)       ! Ice fraction
+    real(r8), intent(in) :: t(pcols,pver)        ! Temperature
+    real(r8), intent(in) :: ps(pcols)            ! Surface pressure
+    real(r8), intent(in) :: pmid(pcols,pver)     ! Midpoint pressures
+    real(r8), intent(in) :: landm(pcols)
+    real(r8), intent(in) :: snowh(pcols)         ! Snow depth over land, water equivalent (m)
+!
+! Output arguments
+!
+    real(r8), intent(out) :: rel(pcols,pver)      ! Liquid effective drop size (microns)
+    real(r8), intent(out) :: rei(pcols,pver)      ! Ice effective drop size (microns)
+!
+
+!++pjr
+! following Kiehl
+         call reltab(ncol, pcols, pver, t, landfrac, landm, icefrac, rel, snowh)
+
+! following Kristjansson and Mitchell
+         call reitab(ncol, pcols, pver, t, rei)
+!--pjr
+!
+!
+    return
+  end subroutine cldefr
+
+!===============================================================================
+  subroutine cldems(lchnk   ,ncol    ,pcols, pver, pverp, clwp    ,fice    ,rei     ,emis    )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Compute cloud emissivity using cloud liquid water path (g/m**2)
+! 
+! Method: 
+! <Describe the algorithm(s) used in the routine.> 
+! <Also include any applicable external references.> 
+! 
+! Author: J.T. Kiehl
+! 
+!-----------------------------------------------------------------------
+
+    implicit none
+!------------------------------Parameters-------------------------------
+!
+    real(r8) kabsl                  ! longwave liquid absorption coeff (m**2/g)
+    parameter (kabsl = 0.090361)
+!
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+    integer, intent(in) :: lchnk                   ! chunk identifier
+    integer, intent(in) :: ncol                    ! number of atmospheric columns
+    integer, intent(in) :: pcols, pver, pverp
+
+    real(r8), intent(in) :: clwp(pcols,pver)       ! cloud liquid water path (g/m**2)
+    real(r8), intent(in) :: rei(pcols,pver)        ! ice effective drop size (microns)
+    real(r8), intent(in) :: fice(pcols,pver)       ! fractional ice content within cloud
+!
+! Output arguments
+!
+    real(r8), intent(out) :: emis(pcols,pver)       ! cloud emissivity (fraction)
+!
+!---------------------------Local workspace-----------------------------
+!
+    integer i,k                 ! longitude, level indices
+    real(r8) kabs                   ! longwave absorption coeff (m**2/g)
+    real(r8) kabsi                  ! ice absorption coefficient
+!
+!-----------------------------------------------------------------------
+!
+    do k=1,pver
+       do i=1,ncol
+          kabsi = 0.005 + 1./rei(i,k)
+          kabs = kabsl*(1.-fice(i,k)) + kabsi*fice(i,k)
+          emis(i,k) = 1. - exp(-1.66*kabs*clwp(i,k))
+       end do
+    end do
+!
+    return
+  end subroutine cldems
+
+!===============================================================================
+  subroutine cldovrlap(lchnk   ,ncol    ,pcols, pver, pverp, pint    ,cld     ,nmxrgn  ,pmxrgn  )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Partitions each column into regions with clouds in neighboring layers.
+! This information is used to implement maximum overlap in these regions
+! with random overlap between them.
+! On output,
+!    nmxrgn contains the number of regions in each column
+!    pmxrgn contains the interface pressures for the lower boundaries of
+!           each region! 
+! Method: 
+
+! 
+! Author: W. Collins
+! 
+!-----------------------------------------------------------------------
+
+    implicit none
+!
+! Input arguments
+!
+    integer, intent(in) :: lchnk                ! chunk identifier
+    integer, intent(in) :: ncol                 ! number of atmospheric columns
+    integer, intent(in) :: pcols, pver, pverp
+
+    real(r8), intent(in) :: pint(pcols,pverp)   ! Interface pressure
+    real(r8), intent(in) :: cld(pcols,pver)     ! Fractional cloud cover
+!
+! Output arguments
+!
+    real(r8), intent(out) :: pmxrgn(pcols,pverp)! Maximum values of pressure for each
+!    maximally overlapped region.
+!    0->pmxrgn(i,1) is range of pressure for
+!    1st region,pmxrgn(i,1)->pmxrgn(i,2) for
+!    2nd region, etc
+    integer nmxrgn(pcols)                    ! Number of maximally overlapped regions
+!
+!---------------------------Local variables-----------------------------
+!
+    integer i                    ! Longitude index
+    integer k                    ! Level index
+    integer n                    ! Max-overlap region counter
+
+    real(r8) pnm(pcols,pverp)    ! Interface pressure
+
+    logical cld_found            ! Flag for detection of cloud
+    logical cld_layer(pver)      ! Flag for cloud in layer
+!
+!------------------------------------------------------------------------
+!
+
+    do i = 1, ncol
+       cld_found = .false.
+       cld_layer(:) = cld(i,:) > 0.0_r8
+       pmxrgn(i,:) = 0.0
+       pnm(i,:)=pint(i,:)*10.
+       n = 1
+       do k = 1, pver
+          if (cld_layer(k) .and.  .not. cld_found) then
+             cld_found = .true.
+          else if ( .not. cld_layer(k) .and. cld_found) then
+             cld_found = .false.
+             if (count(cld_layer(k:pver)) == 0) then
+                exit
+             endif
+             pmxrgn(i,n) = pnm(i,k)
+             n = n + 1
+          endif
+       end do
+       pmxrgn(i,n) = pnm(i,pverp)
+       nmxrgn(i) = n
+    end do
+
+    return
+  end subroutine cldovrlap
+
+!===============================================================================
+  subroutine cldclw(lchnk   ,ncol    ,pcols, pver, pverp, zi      ,clwp    ,tpw     ,hl      )
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Evaluate cloud liquid water path clwp (g/m**2)
+! 
+! Method: 
+! <Describe the algorithm(s) used in the routine.> 
+! <Also include any applicable external references.> 
+! 
+! Author: J.T. Kiehl
+! 
+!-----------------------------------------------------------------------
+
+    implicit none
+
+!
+! Input arguments
+!
+    integer, intent(in) :: lchnk                 ! chunk identifier
+    integer, intent(in) :: ncol                  ! number of atmospheric columns
+    integer, intent(in) :: pcols, pver, pverp
+
+    real(r8), intent(in) :: zi(pcols,pverp)      ! height at layer interfaces(m)
+    real(r8), intent(in) :: tpw(pcols)           ! total precipitable water (mm)
+!
+! Output arguments
+!
+    real(r8) clwp(pcols,pver)     ! cloud liquid water path (g/m**2)
+    real(r8) hl(pcols)            ! liquid water scale height
+    real(r8) rhl(pcols)           ! 1/hl
+
+!
+!---------------------------Local workspace-----------------------------
+!
+    integer i,k               ! longitude, level indices
+    real(r8) clwc0                ! reference liquid water concentration (g/m**3)
+    real(r8) emziohl(pcols,pverp) ! exp(-zi/hl)
+!
+!-----------------------------------------------------------------------
+!
+! Set reference liquid water concentration
+!
+    clwc0 = 0.21
+!
+! Diagnose liquid water scale height from precipitable water
+!
+    do i=1,ncol
+       hl(i)  = 700.0*log(max(tpw(i)+1.0_r8,1.0_r8))
+       rhl(i) = 1.0/hl(i)
+    end do
+!
+! Evaluate cloud liquid water path (vertical integral of exponential fn)
+!
+    do k=1,pverp
+       do i=1,ncol
+          emziohl(i,k) = exp(-zi(i,k)*rhl(i))
+       end do
+    end do
+    do k=1,pver
+       do i=1,ncol
+          clwp(i,k) = clwc0*hl(i)*(emziohl(i,k+1) - emziohl(i,k))
+       end do
+    end do
+!
+    return
+  end subroutine cldclw
+
+
+!===============================================================================
+  subroutine reltab(ncol, pcols, pver, t, landfrac, landm, icefrac, rel, snowh)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Compute cloud water size
+! 
+! Method: 
+! analytic formula following the formulation originally developed by J. T. Kiehl
+! 
+! Author: Phil Rasch
+! 
+!-----------------------------------------------------------------------
+!   use physconst,          only: tmelt
+    implicit none
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+    integer, intent(in) :: ncol
+    integer, intent(in) :: pcols, pver
+    real(r8), intent(in) :: landfrac(pcols)      ! Land fraction
+    real(r8), intent(in) :: icefrac(pcols)       ! Ice fraction
+    real(r8), intent(in) :: snowh(pcols)         ! Snow depth over land, water equivalent (m)
+    real(r8), intent(in) :: landm(pcols)         ! Land fraction ramping to zero over ocean
+    real(r8), intent(in) :: t(pcols,pver)        ! Temperature
+
+!
+! Output arguments
+!
+    real(r8), intent(out) :: rel(pcols,pver)      ! Liquid effective drop size (microns)
+!
+!---------------------------Local workspace-----------------------------
+!
+    integer i,k               ! Lon, lev indices
+    real(r8) rliqland         ! liquid drop size if over land
+    real(r8) rliqocean        ! liquid drop size if over ocean
+    real(r8) rliqice          ! liquid drop size if over sea ice
+!
+!-----------------------------------------------------------------------
+!
+    rliqocean = 14.0_r8
+    rliqice   = 14.0_r8
+    rliqland  = 8.0_r8
+    do k=1,pver
+       do i=1,ncol
+! jrm Reworked effective radius algorithm
+          ! Start with temperature-dependent value appropriate for continental air
+          ! Note: findmcnew has a pressure dependence here
+          rel(i,k) = rliqland + (rliqocean-rliqland) * min(1.0_r8,max(0.0_r8,(tmelt-t(i,k))*0.05))
+          ! Modify for snow depth over land
+          rel(i,k) = rel(i,k) + (rliqocean-rel(i,k)) * min(1.0_r8,max(0.0_r8,snowh(i)*10.))
+          ! Ramp between polluted value over land to clean value over ocean.
+          rel(i,k) = rel(i,k) + (rliqocean-rel(i,k)) * min(1.0_r8,max(0.0_r8,1.0-landm(i)))
+          ! Ramp between the resultant value and a sea ice value in the presence of ice.
+          rel(i,k) = rel(i,k) + (rliqice-rel(i,k)) * min(1.0_r8,max(0.0_r8,icefrac(i)))
+! end jrm
+       end do
+    end do
+  end subroutine reltab
+
+!===============================================================================
+  subroutine reitab(ncol, pcols, pver, t, re)
+    !
+
+    integer, intent(in) :: ncol, pcols, pver
+    real(r8), intent(out) :: re(pcols,pver)
+    real(r8), intent(in) :: t(pcols,pver)
+    real(r8) retab(95)
+    real(r8) corr
+    integer i
+    integer k
+    integer index
+    !
+    !       Tabulated values of re(T) in the temperature interval
+    !       180 K -- 274 K; hexagonal columns assumed:
+    !
+    data retab / 						&
+         5.92779, 6.26422, 6.61973, 6.99539, 7.39234,	&
+         7.81177, 8.25496, 8.72323, 9.21800, 9.74075, 10.2930,	&
+         10.8765, 11.4929, 12.1440, 12.8317, 13.5581, 14.2319, 	&
+         15.0351, 15.8799, 16.7674, 17.6986, 18.6744, 19.6955,	&
+         20.7623, 21.8757, 23.0364, 24.2452, 25.5034, 26.8125,	&
+         27.7895, 28.6450, 29.4167, 30.1088, 30.7306, 31.2943, 	&
+         31.8151, 32.3077, 32.7870, 33.2657, 33.7540, 34.2601, 	&
+         34.7892, 35.3442, 35.9255, 36.5316, 37.1602, 37.8078,	&
+         38.4720, 39.1508, 39.8442, 40.5552, 41.2912, 42.0635,	&
+         42.8876, 43.7863, 44.7853, 45.9170, 47.2165, 48.7221,	&
+         50.4710, 52.4980, 54.8315, 57.4898, 60.4785, 63.7898,	&
+         65.5604, 71.2885, 75.4113, 79.7368, 84.2351, 88.8833,	&
+         93.6658, 98.5739, 103.603, 108.752, 114.025, 119.424, 	&
+         124.954, 130.630, 136.457, 142.446, 148.608, 154.956,	&
+         161.503, 168.262, 175.248, 182.473, 189.952, 197.699,	&
+         205.728, 214.055, 222.694, 231.661, 240.971, 250.639/	
+    !
+    save retab
+    !
+    do k=1,pver
+       do i=1,ncol
+          index = int(t(i,k)-179.)
+          index = min(max(index,1),94)
+          corr = t(i,k) - int(t(i,k))
+          re(i,k) = retab(index)*(1.-corr)		&
+               +retab(index+1)*corr
+          !           re(i,k) = amax1(amin1(re(i,k),30.),10.)
+       end do
+    end do
+    !
+    return
+  end subroutine reitab
+
+
+function findvalue(ix,n,ain,indxa)
+!----------------------------------------------------------------------- 
+! 
+! Purpose: 
+! Subroutine for finding ix-th smallest value in the array
+! The elements are rearranged so that the ix-th smallest
+! element is in the ix place and all smaller elements are
+! moved to the elements up to ix (with random order).
+!
+! Algorithm: Based on the quicksort algorithm.
+!
+! Author:       T. Craig
+! 
+!-----------------------------------------------------------------------
+!  use shr_kind_mod, only: r8 => shr_kind_r8
+   implicit none
+!
+! arguments
+!
+   integer, intent(in) :: ix                ! element to search for
+   integer, intent(in) :: n                 ! total number of elements
+   integer, intent(inout):: indxa(n)        ! array of integers
+   real(r8), intent(in) :: ain(n)           ! array to search
+!
+   integer findvalue                        ! return value
+!
+! local variables
+!
+   integer i,j
+   integer il,im,ir
+
+   integer ia
+   integer itmp
+!
+!---------------------------Routine-----------------------------
+!
+   il=1
+   ir=n
+   do
+      if (ir-il <= 1) then
+         if (ir-il == 1) then
+            if (ain(indxa(ir)) < ain(indxa(il))) then
+               itmp=indxa(il)
+               indxa(il)=indxa(ir)
+               indxa(ir)=itmp
+            endif
+         endif
+         findvalue=indxa(ix)
+         return
+      else
+         im=(il+ir)/2
+         itmp=indxa(im)
+         indxa(im)=indxa(il+1)
+         indxa(il+1)=itmp
+         if (ain(indxa(il+1)) > ain(indxa(ir))) then
+            itmp=indxa(il+1)
+            indxa(il+1)=indxa(ir)
+            indxa(ir)=itmp
+         endif
+         if (ain(indxa(il)) > ain(indxa(ir))) then
+            itmp=indxa(il)
+            indxa(il)=indxa(ir)
+            indxa(ir)=itmp
+         endif
+         if (ain(indxa(il+1)) > ain(indxa(il))) then
+            itmp=indxa(il+1)
+            indxa(il+1)=indxa(il)
+            indxa(il)=itmp
+         endif
+         i=il+1
+         j=ir
+         ia=indxa(il)
+         do
+            do
+               i=i+1
+               if (ain(indxa(i)) >= ain(ia)) exit
+            end do
+            do
+               j=j-1
+               if (ain(indxa(j)) <= ain(ia)) exit
+            end do
+            if (j < i) exit
+            itmp=indxa(i)
+            indxa(i)=indxa(j)
+            indxa(j)=itmp
+         end do
+         indxa(il)=indxa(j)
+         indxa(j)=ia
+         if (j >= ix)ir=j-1
+         if (j <= ix)il=i
+      endif
+   end do
+end function findvalue
+
+#endif
+
+
+
+END MODULE module_ra_cam
Index: trunk/WRF.COMMON/WRFV2/phys/module_ra_gfdleta.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_ra_gfdleta.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_ra_gfdleta.F	(revision 2744)
@@ -0,0 +1,10245 @@
+!WRF:MODEL_RA:RADIATION
+!
+#define FERRIER_GFDL
+MODULE MODULE_RA_GFDLETA
+      USE MODULE_CONFIGURE,ONLY : GRID_CONFIG_REC_TYPE
+      USE MODULE_MODEL_CONSTANTS
+#ifdef FERRIER_GFDL
+      USE MODULE_MP_ETANEW, ONLY :                                      &
+     & RHgrd,T_ICE,FPVS,QAUT0,XMImax,XMIexp,MDImin,MDImax,MASSI,        &
+     & FLARGE1,FLARGE2,NLImin,NLImax
+#endif
+      INTEGER,PARAMETER :: NL=81
+      INTEGER,PARAMETER :: NBLY=15
+      REAL,PARAMETER :: RTHRESH=1.E-15,DTR=1./DEGRAD
+
+      INTEGER, SAVE, DIMENSION(3)     :: LTOP
+      REAL   , SAVE, DIMENSION(37,NL) :: XDUO3N,XDO3N2,XDO3N3,XDO3N4
+      REAL   , SAVE, DIMENSION(NL)    :: PRGFDL
+      REAL   , SAVE                   :: AB15WD,SKO2D,SKC1R,SKO3R
+
+      REAL   , SAVE :: EM1(28,180),EM1WDE(28,180),TABLE1(28,180),     &
+                           TABLE2(28,180),TABLE3(28,180),EM3(28,180), &
+                           SOURCE(28,NBLY), DSRCE(28,NBLY)
+
+      REAL   ,SAVE, DIMENSION(5040):: T1,T2,T4,EM1V,EM1VW,EM3V
+      REAL   ,SAVE                 :: R1,RSIN1,RCOS1,RCOS2
+! Created by CO2 initialization
+      REAL,   SAVE, ALLOCATABLE, DIMENSION(:,:) :: CO251,CDT51,CDT58,C2D51,&
+                                           C2D58,CO258
+      REAL,   SAVE, ALLOCATABLE, DIMENSION(:)   :: STEMP,GTEMP,CO231,CO238, &
+                                           C2D31,C2D38,CDT31,CDT38, &
+                                           CO271,CO278,C2D71,C2D78, &
+                                           CDT71,CDT78
+      REAL,   SAVE, ALLOCATABLE, DIMENSION(:)   :: CO2M51,CO2M58,CDTM51,CDTM58, &
+                                           C2DM51,C2DM58
+      CHARACTER(256) :: ERRMESS
+
+! Used by CO2 initialization
+!     COMMON/PRESS/PA(109)
+!     COMMON/TRAN/ TRANSA(109,109)
+!     COMMON/COEFS/XA(109),CA(109),ETA(109),SEXPV(109),CORE,UEXP,SEXP
+      REAL   ,SAVE, DIMENSION(109) :: PA, XA, CA, ETA, SEXPV
+      REAL   ,SAVE, DIMENSION(109,109) :: TRANSA
+      REAL   ,SAVE  :: CORE,UEXP,SEXP
+
+      EQUIVALENCE (EM1V(1),EM1(1,1)),(EM1VW(1),EM1WDE(1,1)) 
+      EQUIVALENCE (EM3V(1),EM3(1,1))
+      EQUIVALENCE (T1(1),TABLE1(1,1)),(T2(1),TABLE2(1,1)), &
+                  (T4(1),TABLE3(1,1))
+      REAL,SAVE,DIMENSION(4) :: PTOPC
+!
+!--- Used for Gaussian look up tables
+!
+      REAL, PRIVATE,PARAMETER :: XSDmax=3.1, DXSD=.01
+      INTEGER, PRIVATE,PARAMETER :: NXSD=XSDmax/DXSD
+      REAL, DIMENSION(NXSD),PRIVATE,SAVE :: AXSD
+      REAL, PRIVATE :: RSQR
+      LOGICAL, PRIVATE,SAVE :: SDprint=.FALSE.
+
+
+#ifndef FERRIER_GFDL
+      REAL, PRIVATE, PARAMETER :: RHgrd=1.0
+      REAL, PRIVATE, PARAMETER :: T_ice=-30.0
+#endif
+
+!
+!--- Important parameters for cloud properties - see extensive comments in
+!    DO 580 loop within subroutine RADTN 
+!
+      REAL, PARAMETER ::  &
+     &   TRAD_ice=0.5*T_ice      & !--- Very tunable parameter
+     &,  ABSCOEF_W=800.          & !--- Very tunable parameter
+     &,  ABSCOEF_I=500.          & !--- Very tunable parameter
+     &,  SECANG=-1.66            & !--- Very tunable parameter
+     &,  CLDCOEF_LW=1.5          & !--- Enhance LW cloud depths
+     &,  ABSCOEF_LW=SECANG*CLDCOEF_LW  & !--- Final factor for cloud emissivities
+     &,  Qconv=0.1e-3            & !--- Very tunable parameter
+     &,  CTauCW=ABSCOEF_W*Qconv  &
+     &,  CTauCI=ABSCOEF_I*Qconv
+!
+
+CONTAINS
+
+!-----------------------------------------------------------------------
+      SUBROUTINE GFDLETAINIT(EMISS,SFULL,SHALF,PPTOP,                   &
+     &                       JULYR,MONTH,IDAY,GMT,                      &
+     &                       CONFIG_FLAGS,ALLOWED_TO_READ,              &
+     &                       IDS, IDE, JDS, JDE, KDS, KDE,              &
+     &                       IMS, IME, JMS, JME, KMS, KME,              &
+     &                       ITS, ITE, JTS, JTE, KTS, KTE              )
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      TYPE (GRID_CONFIG_REC_TYPE) :: CONFIG_FLAGS
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+      INTEGER,INTENT(IN) :: JULYR,MONTH,IDAY
+      REAL,INTENT(IN) :: GMT,PPTOP
+      REAL,DIMENSION(KMS:KME),INTENT(IN) :: SFULL, SHALF
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: EMISS
+      LOGICAL,INTENT(IN) :: ALLOWED_TO_READ
+!
+      INTEGER :: I,IHRST,J,N
+      REAL :: PCLD,XSD,PI,SQR2PI
+      REAL :: SSLP=1013.25
+      REAL, PARAMETER :: PTOP_HI=150.,PTOP_MID=350.,PTOP_LO=642.,       &
+     &                   PLBTM=105000.
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+!
+!***  INITIALIZE DIAGNOSTIC LOW,MIDDLE,HIGH CLOUD LAYER PRESSURE LIMITS.
+!
+      LTOP(1)=0
+      LTOP(2)=0
+      LTOP(3)=0
+!
+      DO N=1,KTE
+        PCLD=(SSLP-PPTOP*10.)*SHALF(N)+PPTOP*10.
+        IF(PCLD>=PTOP_LO)LTOP(1)=N
+        IF(PCLD>=PTOP_MID)LTOP(2)=N
+        IF(PCLD>=PTOP_HI)LTOP(3)=N
+!       PRINT *,N,PCLD,SHALF(N),PSTAR,PPTOP
+      ENDDO
+!***  
+!***  ASSIGN THE PRESSURES FOR CLOUD DOMAIN BOUNDARIES
+!***
+      PTOPC(1)=PLBTM
+      PTOPC(2)=PTOP_LO*100.
+      PTOPC(3)=PTOP_MID*100.
+      PTOPC(4)=PTOP_HI*100.
+!
+!***  USE CALL TO CONRAD FOR DIRECT READ OF CO2 FUNCTIONS
+!***  OTHERWISE CALL CO2O3.
+!
+      IF(ALLOWED_TO_READ)THEN
+        IF(CONFIG_FLAGS%CO2TF==1)THEN
+          CALL CO2O3(SFULL,SHALF,PPTOP,KME-KMS,KME-KMS+1,KME-KMS+2)
+        ELSE
+          CALL CONRAD(KDS,KDE,KMS,KME,KTS,KTE)
+        ENDIF
+!
+        CALL O3CLIM
+        CALL TABLE
+        IHRST=NINT(GMT)
+!       WRITE(0,*)'into solard ',gmt,ihrst
+        CALL SOLARD(IHRST,IDAY,MONTH,JULYR)
+      ENDIF
+!
+!***  FOR NOW, GFDL RADIATION ASSUMES EMISSIVITY = 1.0
+!
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        EMISS(I,J) = 1.0
+      ENDDO
+      ENDDO
+!
+!---  Calculate the area under the Gaussian curve at the start of the
+!---  model run and build the look up table AXSD
+!
+      PI=ACOS(-1.)
+      SQR2PI=SQRT(2.*PI)
+      RSQR=1./SQR2PI
+      DO I=1,NXSD
+        XSD=REAL(I)*DXSD
+        AXSD(I)=GAUSIN(XSD)
+        if (SDprint) print *,'I, XSD, AXSD =',I,XSD,AXSD(I)
+      ENDDO
+!! !***
+!! !***  MESO STANDARD DEVIATION OF EK AND MAHRT'S CLOUD COVER ALOGRITHM
+!! !***
+!!         SDM=-0.03-0.00015*DX+0.02*LOG(DX)  ! meso SD
+!!         if (SDprint) print *,'DX, SDM=',DX,SDM
+!       if (SDprint) print *,                                            &
+!     & 'RHgrd,T_ICE,NLImin,NLImax,FLARGE1,FLARGE2,MDImin,MDImax=',&
+!     &  RHgrd,T_ICE,NLImin,NLImax,FLARGE1,FLARGE2,MDImin,MDImax
+!
+!-----------------------------------------------------------------------
+      END SUBROUTINE GFDLETAINIT
+!-----------------------------------------------------------------------
+!
+!------------------------------------------------------------------
+! urban related variable are added to arguments of etara
+!---------------------------------------------------------------------
+!
+!-----------------------------------------------------------------------
+      SUBROUTINE ETARA(DT,THRATEN,THRATENLW,THRATENSW,CLDFRA,PI3D       & 
+     &                ,XLAND,P8W,DZ8W,RHO_PHY,P_PHY,T                   &
+     &                ,QV,QW,QI,QS                                      & 
+     &                ,TSK2D,GLW,RSWIN,GSW,RSWINC                       &
+     &                ,RSWTOA,RLWTOA,CZMEAN                             & 
+     &                ,GLAT,GLON,HTOP,HBOT,HTOPR,HBOTR,ALBEDO,CUPPT     &
+     &                ,VEGFRA,SNOW,G,GMT                                &
+!BSF => for NAMX changes, pass in surface emissivity (SFCEMS) [different for snow]
+     &                ,NSTEPRA,NPHS,ITIMESTEP                           &
+     &                ,XTIME,JULIAN                                     &
+     &                ,COSZ_URB2D,OMG_URB2D                             & ! urban
+     &                ,JULYR,JULDAY,GFDL_LW,GFDL_SW                     &
+     &                ,CFRACL,CFRACM,CFRACH                             &
+     &                ,ACFRST,NCFRST,ACFRCV,NCFRCV                      &
+     &                ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &                ,IMS,IME,JMS,JME,KMS,KME                          &
+     &                ,ITS,ITE,JTS,JTE,KTS,KTE)
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                     &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE,ITIMESTEP           &
+     &                     ,NPHS,NSTEPRA
+ 
+      INTEGER,INTENT(IN) :: julyr,julday   
+      INTEGER,INTENT(INOUT),DIMENSION(ims:ime,jms:jme) :: NCFRST        & !Added
+                                                         ,NCFRCV          !Added
+      REAL,INTENT(IN) :: DT,GMT,G,XTIME,JULIAN
+
+      REAL,INTENT(INOUT),DIMENSION(ims:ime, kms:kme, jms:jme)::         &
+                                    THRATEN,THRATENLW,THRATENSW,CLDFRA  !Added CLDFRA
+      REAL,INTENT(IN),DIMENSION(ims:ime, kms:kme, jms:jme)::p8w,dz8w,   &
+     &                                                      rho_phy,    &
+     &                                                      p_phy,      &
+     &                                                      PI3D
+      REAL, INTENT(IN), DIMENSION(ims:ime, jms:jme):: ALBEDO,SNOW,      &
+     &                                                TSK2D,VEGFRA,     &
+     &                                                XLAND
+      REAL, INTENT(IN), DIMENSION(ims:ime, jms:jme):: GLAT,GLON
+      REAL, INTENT(INOUT), DIMENSION(ims:ime, jms:jme):: HTOP,HBOT,HTOPR,HBOTR,CUPPT
+      REAL, INTENT(INOUT), DIMENSION(ims:ime, jms:jme):: RSWTOA,        & !Added
+     &                                                   RLWTOA,        & !Added
+     &                                                   ACFRST,        & !Added
+     &                                                   ACFRCV
+      REAL,INTENT(INOUT),DIMENSION(ims:ime, jms:jme):: GLW,GSW
+      REAL,INTENT(OUT),DIMENSION(ims:ime, jms:jme):: CZMEAN             &
+     &                                           ,RSWIN,RSWINC        &
+     &                                           ,CFRACL,CFRACM,CFRACH
+      REAL, INTENT(IN), DIMENSION(ims:ime, kms:kme, jms:jme):: QS,QV,   &
+     &                                                         QW,T
+      LOGICAL, INTENT(IN) :: gfdl_lw,gfdl_sw
+      REAL, OPTIONAL, INTENT(IN), DIMENSION(ims:ime, kms:kme, jms:jme):: QI
+
+      REAL, DIMENSION(its:ite, kms:kme, jts:jte):: PFLIP,QIFLIP,QFLIP,  &
+     &                                             QWFLIP,TFLIP
+      REAL, DIMENSION(its:ite, kms:kme, jts:jte)::P8WFLIP,PHYD
+      REAL, DIMENSION(its:ite, kts:kte, jts:jte)::TENDS,TENDL
+      REAL, DIMENSION(ims:ime, jms:jme):: CUTOP,CUBOT
+      INTEGER :: IDAT(3),Jmonth,Jday
+      INTEGER :: I,J,K,KFLIP,IHRST
+
+!-------------------------------------------------
+! urban related variables are added to declaration
+!-------------------------------------------------
+      REAL, OPTIONAL, INTENT(OUT), DIMENSION(ims:ime,jms:jme)  :: COSZ_URB2D  !urban
+      REAL, OPTIONAL, INTENT(OUT), DIMENSION(ims:ime,jms:jme)  :: OMG_URB2D   !urban
+! begin debugging radiation
+      integer :: imd,jmd
+      real :: FSWrat
+! end debugging radiation
+!-----------------------------------------------------------------------
+!***********************************************************************
+!-----------------------------------------------------------------------
+      IF(GFDL_LW.AND.GFDL_SW )GO TO 100
+!
+      DO J=JMS,JME
+        DO K=KMS,KME
+          DO I=IMS,IME
+            CLDFRA(I,K,J)=0.
+          ENDDO
+        ENDDO
+      ENDDO
+! NEED HYDROSTATIC PRESSURE HERE (MONOTONIC CHANGE WITH HEIGHT)
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        PHYD(I,KTS,J)=P8W(I,KTS,J) 
+      ENDDO
+      ENDDO
+!
+      DO J=JTS,JTE
+        DO K=KTS,KTE
+        DO I=ITS,ITE
+          PHYD(I,K+1,J)=PHYD(I,K,J)-G*RHO_PHY(I,K,J)*DZ8W(I,K,J)
+        ENDDO
+        ENDDO
+      ENDDO
+!
+      DO K=KMS,KME
+         KFLIP=KME+1-K
+         DO J=JTS,JTE
+         DO I=ITS,ITE
+           P8WFLIP(I,K,J)=PHYD(I,KFLIP,J)
+         ENDDO
+         ENDDO
+      ENDDO
+!
+!- Note that the effects of rain are ignored in this radiation package (BSF 2005-01-25)
+!
+      DO K=KTS,KTE
+        KFLIP=KTE+1-K
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          TFLIP (I,K,J)=T(I,KFLIP,J)
+          QFLIP (I,K,J)=MAX(0.,QV(I,KFLIP,J)/(1.+QV(I,KFLIP,J)))
+          QWFLIP(I,K,J)=QW(I,KFLIP,J)      !Modified
+! Note that QIFLIP will contain QS+QI if both are passed in, otherwise just QS 
+!     Eta MP now outputs QS instead of QI (JD 2006-05-12)
+          QIFLIP(I,K,J)=QS(I,KFLIP,J)      !Added QS
+          IF(PRESENT(QI))QIFLIP(I,K,J)=QIFLIP(I,K,J)+QI(I,KFLIP,J)      !Added QI
+!         PFLIP (I,K,J)=P_PHY(I,KFLIP,J)
+!
+!***  USE MONOTONIC HYDROSTATIC PRESSURE INTERPOLATED TO MID-LEVEL
+!
+          PFLIP(I,K,J)=0.5*(P8WFLIP(I,K,J)+P8WFLIP(I,K+1,J))
+        ENDDO
+        ENDDO
+      ENDDO
+!
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        CUBOT(I,J)=KTE+1-HBOT(I,J)
+        CUTOP(I,J)=KTE+1-HTOP(I,J)
+      ENDDO
+      ENDDO
+!
+      CALL CAL_MON_DAY(JULDAY,JULYR,JMONTH,JDAY)     
+!
+      IDAT(1)=JMONTH
+      IDAT(2)=JDAY
+      IDAT(3)=JULYR
+      IHRST  =NINT(GMT)
+
+!-----------------------------------------------------------------------
+      CALL RADTN (DT,TFLIP,QFLIP,QWFLIP,QIFLIP,                         &
+     &            PFLIP,P8WFLIP,XLAND,TSK2D,                            &
+     &            GLAT,GLON,CUTOP,CUBOT,ALBEDO,CUPPT,                   &
+     &            ACFRCV,NCFRCV,ACFRST,NCFRST,                          &
+     &            VEGFRA,SNOW,GLW,GSW,RSWIN,RSWINC,                     &
+!BSF => for NAMX changes, pass in surface emissivity (SFCEMS) [different for snow]
+     &            IDAT,IHRST,XTIME,JULIAN,                              &
+     &            NSTEPRA,NSTEPRA,NPHS,ITIMESTEP,                       &
+     &            TENDS,TENDL,CLDFRA,RSWTOA,RLWTOA,CZMEAN,              &
+     &            CFRACL,CFRACM,CFRACH,                                 &
+!     &            COSZ2D,OMG2D,                                         & !urban
+     &            COSZ_URB2D,OMG_URB2D,                                 & !urban
+     &            IDS,IDE,JDS,JDE,KDS,KDE,                              &
+     &            IMS,IME,JMS,JME,KMS,KME,                              &
+     &            ITS,ITE,JTS,JTE,KTS,KTE                              )
+!-----------------------------------------------------------------------
+! begin debugging radiation
+!     imd=(ims+ime)/2
+!     jmd=(jms+jme)/2
+!     FSWrat=0.
+!     if (RSWIN(imd,jmd) .gt. 0.)   &
+!        FSWrat=(RSWIN(imd,jmd)-GSW(imd,jmd))/RSWIN(imd,jmd)
+!     write(6,"(2a,2i5,5f9.2,f8.4,i3,2f8.4)") & 
+!       '{rad4 imd,jmd,GSW,RSWIN,RSWOUT=RSWIN-GSW,RSWINC,GLW,' &
+!      ,'ACFRCV,NCFRCV,ALBEDO,RSWOUT/RSWIN = '   &
+!      ,imd,jmd, GSW(imd,jmd),RSWIN(imd,jmd)  &
+!      ,RSWIN(imd,jmd)-GSW(imd,jmd),RSWINC(imd,jmd),GLW(imd,jmd) &
+!      ,ACFRCV(imd,jmd),NCFRCV(imd,jmd),ALBEDO(imd,jmd),FSWrat
+! end debugging radiation
+!
+!--- Need to save LW & SW tendencies since radiation calculates both and this block
+!    is skipped when GFDL SW is called, both only if GFDL LW is also called
+!    
+      IF(GFDL_LW)THEN
+        DO J=JTS,JTE
+        DO K = KTS,KTE
+          KFLIP=KTE+1-K
+          DO I=ITS,ITE
+            THRATENLW(I,K,J)=TENDL(I,KFLIP,J)/PI3D(I,K,J)
+            THRATENSW(I,K,J)=TENDS(I,KFLIP,J)/PI3D(I,K,J)
+            THRATEN(I,K,J)  =THRATEN(I,K,J) + THRATENLW(I,K,J)
+          ENDDO
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!*** THIS ASSUMES THAT LONGWAVE IS CALLED FIRST IN THE RADIATION_DRIVER.
+!    Only gets executed if a different LW scheme (not GFDL) is called
+!
+      IF(GFDL_SW)THEN
+        DO J=JTS,JTE
+        DO K=KTS,KTE
+          KFLIP=KTE+1-K
+          DO I=ITS,ITE
+            THRATENSW(I,K,J)=TENDS(I,KFLIP,J)/PI3D(I,K,J)
+          ENDDO
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!***  RESET ACCUMULATED CONVECTIVE CLOUD TOP/BOT AND CONVECTIVE PRECIP
+!***  FOR NEXT INTERVAL BETWEEN RADIATION CALLS
+!
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+! SAVE VALUE USED BY RADIATION BEFORE RESETTING HTOP AND HBOT
+        HBOTR(I,J)=HBOT(I,J)
+        HTOPR(I,J)=HTOP(I,J)
+        HBOT(I,J)=REAL(KTE+1)
+        HTOP(I,J)=0.
+        CUPPT(I,J)=0.
+      ENDDO
+      ENDDO
+!
+  100 IF(GFDL_SW)THEN
+        DO J=JTS,JTE
+        DO K=KTS,KTE
+          KFLIP=KTE+1-K
+          DO I=ITS,ITE
+            THRATEN(I,K,J)=THRATEN(I,K,J)+THRATENSW(I,K,J)
+          ENDDO
+        ENDDO
+        ENDDO
+      ENDIF
+!
+  END SUBROUTINE ETARA
+!
+!-----------------------------------------------------------------------
+      SUBROUTINE RADTN(DT,T,Q,QCW,QICE,                                 &
+     &                 PFLIP,P8WFLIP,XLAND,TSK2D,                       &
+     &                 GLAT,GLON,CUTOP,CUBOT,ALB,CUPPT,                 &
+     &                 ACFRCV,NCFRCV,ACFRST,NCFRST,                     &
+     &                 VEGFRC,SNO,GLW,GSW,RSWIN,RSWINC,                 & 
+!BSF => for NAMX changes, pass in surface emissivity (SFCEMS) [different for snow]
+     &                 IDAT,IHRST,XTIME,JULIAN,                         &
+     &                 NRADS,NRADL,NPHS,NTSD,                           &
+     &                 TENDS,TENDL,CLDFRA,RSWTOA,RLWTOA,CZMEAN,         &
+     &                 CFRACL,CFRACM,CFRACH,                            &
+     &                 COSZ_URB2D,OMG_URB2D,                            & !urban
+     &                 ids,ide, jds,jde, kds,kde,                       &
+     &                 ims,ime, jms,jme, kms,kme,                       &
+     &                 its,ite, jts,jte, kts,kte                       )
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+
+! GLAT : geodetic latitude in radians of the mass points on the computational grid.
+
+! CZEN : instantaneous cosine of the solar zenith angle.
+
+! CUTOP : (REAL) model layer number that is highest in the atmosphere
+!        in which convective cloud occurred since the previous call to the
+!        radiation driver.
+
+! CUBOT : (REAL) model layer number that is lowest in the atmosphere
+!        in which convective cloud occurred since the previous call to the
+!        radiation driver.
+
+! ALB  : is no longer used in the operational radiation.  Prior to 24 July 2001
+!        ALB was the climatological albedo that was modified within RADTN to
+!        account for vegetation fraction and snow.
+!
+! ALB  : reintroduced as the dynamic albedo from LSM
+
+! CUPPT: accumulated convective precipitation (meters) since the
+!        last call to the radiation.
+
+! TSK2D : skin temperature
+
+! IHE and IHW are relative location indices needed to locate neighboring
+!       points on the Eta's Arakawa E grid since arrays are indexed locally on
+!       each MPI task rather than globally.  IHE refers to the adjacent grid
+!       point (a V point) to the east of the mass point being considered.  IHW
+!       is the adjacent grid point to the west of the given mass point.
+
+! IRAD is a relic from older code that is no longer needed.
+
+! ACFRCV : sum of the convective cloud fractions that were computed
+!          during each call to the radiation between calls to the subroutines that
+!          do the forecast output.
+
+! NCFRCV : the total number of times in which the convective cloud
+!          fraction was computed to be greater than zero in the radiation between
+!          calls to the output routines.  In the post-processor, ACFRCV is divided
+!          by NCFRCV to yield an average convective cloud fraction.
+
+!          ACFRST and NCFRST are the analogs for stratiform cloud cover.
+
+!          VEGFRC is the fraction of the gridbox with vegetation.
+
+!          LVL holds the number of model layers that lie below the ground surface
+!          at each point.  Clearly for sigma coordinates LVL is zero everywhere.
+
+! CTHK  :  an assumed maximum thickness of stratiform clouds currently set
+!          to 20000 Pascals.  I think this is relevant for computing "low",
+!          "middle", and "high" cloud fractions which are post-processed but which
+!          do not feed back into the integration.
+
+! IDAT  : a 3-element integer array holding the month, day, and year,
+!        respectively, of the date for the start time of the free forecast.
+
+! ABCFF : holds coefficients for various absorption bands.  You can see
+!         where they are set in GFDLRD.F.
+
+! LTOP  : a 3-element integer array holding the model layer that is at or
+!         immediately below the specified pressure levels for the tops 
+!         of "high" (15000 Pa), "middle" (35000 Pa), and "low" (64200 Pa) 
+!         stratiform clouds.  These are for the diagnostic cloud layers 
+!         needed in the output but not in the integration.
+
+! NRADS : integer number of fundamental timesteps (our smallest
+!         timestep, i.e., the one for inertial gravity wave adjustment) 
+!         between updates of the shortwave tendencies.  
+
+! NRADL : integer number of fundamental timesteps between updates of
+!         the longwave tendencies.  
+
+! NTSD   : integer counter of the fundamental timesteps that have
+!         elapsed since the start of the forecast.
+
+! GLW : incoming longwave radiation at the surface
+! GSW : NET (down minus up, or incoming minus outgoing) all-sky shortwave radiation at the surface
+! RSWIN  : total (clear + cloudy sky) incoming (downward) solar radiation at the surface
+! RSWINC : clear sky incoming (downward) solar radiation at the surface
+
+! TENDS,TENDL : shortwave,longwave (respectively) temperature tendency
+
+! CLDFRA : 3D cloud fraction
+
+! RSWTOA, RLWTOA : outgoing shortwave, longwave (respectively) fluxes at top of atmosphere
+
+! CZMEAN : time-average cosine of the zenith angle
+
+! CFRACL,CFRACM,CFRACH : low, middle, & high (diagnosed) cloud fractions
+
+! XTIME : time since simulation start (minutes)
+                                                                                                                                              
+! JULIAN: Day of year (0.0 at 00Z Jan 1st)
+
+!**********************************************************************
+!****************************** NOTE **********************************
+!**********************************************************************
+!*** DUE TO THE RESETTING OF CONVECTIVE PRECIP AND CONVECTIVE CLOUD
+!*** TOPS AND BOTTOMS, SHORTWAVE MUST NOT BE CALLED LESS FREQUENTLY
+!*** THAN LONGWAVE.
+!**********************************************************************
+!****************************** NOTE **********************************
+!**********************************************************************
+!-----------------------------------------------------------------------
+!     INTEGER, PARAMETER         :: NL=81
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,         &
+     &                              ims,ime, jms,jme, kms,kme ,         &
+     &                              its,ite, jts,jte, kts,kte
+      INTEGER, INTENT(IN)        :: NRADS,NRADL,NTSD,NPHS 
+!     LOGICAL, INTENT(IN)        :: RESTRT
+      REAL   , INTENT(IN)        :: DT,XTIME,JULIAN
+!     REAL   , INTENT(IN), DIMENSION(37,NL) :: XDUO3N,XDO3N2,XDO3N3,XDO3N4
+      INTEGER, INTENT(IN), DIMENSION(3) :: IDAT
+!-----------------------------------------------------------------------
+      INTEGER            :: LM1,LP1,LM
+      INTEGER, INTENT(IN)               :: IHRST
+!     REAL,    INTENT(IN), DIMENSION(NL)    :: PRGFDL
+!
+      REAL, PARAMETER :: EPSQ1=1.E-5,EPSQ=1.E-12,EPSO3=1.E-10,H0=0.     &
+     &, H1=1.,HALF=.5,T0C=273.15,CUPRATE=24.*1000.,HPINC=HALF*1.E1      &
+!------------------------ For Clouds ----------------------------------
+     &, CLFRmin=0.01, TAUCmax=4.161                                     &
+!--- Parameters used for new cloud cover scheme
+     &, XSDmin=-XSDmax, DXSD1=-DXSD, STSDM=0.01, CVSDM=.04              &
+     &, DXSD2=HALF*DXSD, DXSD2N=-DXSD2, PCLDY=0.25
+!
+      INTEGER, PARAMETER :: NB=12,KSMUD=0
+      INTEGER,PARAMETER :: K15=SELECTED_REAL_KIND(15)
+      REAL (KIND=K15) :: DDX,EEX,PROD
+!     REAL, INTENT(IN) :: SKO3R,AB15WD,SKC1R,SKO2D
+!-----------------------------------------------------------------------
+      LOGICAL :: SHORT,LONG
+      LOGICAL :: BITX,BITY,BITZ,BITW,BIT1,BIT2,BITC,BITCP1,BITSP1
+      LOGICAL, SAVE :: CNCLD=.TRUE.
+      LOGICAL :: NEW_CLOUD
+!-----------------------------------------------------------------------
+      REAL, INTENT(IN), DIMENSION(ims:ime,jms:jme) :: XLAND,TSK2D
+      REAL, INTENT(IN), DIMENSION(its:ite, kms:kme, jts:jte):: Q,QCW,   &
+     &                                                         QICE,T,  &
+     &                                                         PFLIP,   &
+     &                                                         P8WFLIP
+
+!     REAL, INTENT(IN), DIMENSION(28,180) :: TABLE1,TABLE2,TABLE3,EM3,EM1,EM1WDE
+      REAL, INTENT(OUT), DIMENSION(ims:ime, jms:jme):: GLW,GSW,CZMEAN   &
+     &                                                ,RSWIN,RSWINC     & !Added
+     &                                                ,CFRACL,CFRACM    &
+     &                                                ,CFRACH
+      REAL, INTENT(OUT),DIMENSION(ims:ime,kms:kme,jms:jme) :: CLDFRA   !added
+
+!     REAL,   INTENT(IN), DIMENSION(kms:kme)   :: ETAD
+!     REAL,   INTENT(IN), DIMENSION(kms:kme)   :: AETA
+!-----------------------------------------------------------------------
+      REAL, INTENT(IN), DIMENSION(ims:ime,jms:jme) :: CUTOP,CUBOT,CUPPT
+      REAL,   INTENT(IN   ), DIMENSION(ims:ime,jms:jme)  :: ALB,SNO
+!BSF => for NAMX changes, pass in surface emissivity (SFCEMS) [different for snow]
+      REAL,   INTENT(IN   ), DIMENSION(ims:ime,jms:jme)  :: GLAT,GLON
+!-----------------------------------------------------------------------
+      REAL,   DIMENSION(ims:ime,jms:jme)  :: CZEN
+      INTEGER, DIMENSION(its:ite, jts:jte):: LMH
+!-----------------------------------------------------------------------
+!     INTEGER,INTENT(IN), DIMENSION(jms:jme) :: IHE,IHW
+!-----------------------------------------------------------------------
+      REAL,   INTENT(INOUT), DIMENSION(ims:ime,jms:jme) :: ACFRCV,ACFRST &
+                                                          ,RSWTOA,RLWTOA
+      INTEGER,INTENT(INOUT), DIMENSION(ims:ime,jms:jme) :: NCFRCV,NCFRST
+!-----------------------------------------------------------------------
+      REAL,   INTENT(IN),   DIMENSION(ims:ime,jms:jme) :: VEGFRC
+      REAL,   INTENT(INOUT),DIMENSION(its:ite,kts:kte,jts:jte) :: TENDL,&
+     &                                                            TENDS
+!-----------------------------------------------------------------------
+      REAL :: CTHK(3)
+      DATA CTHK/20000.0,20000.0,20000.0/
+
+      REAL,DIMENSION(10),SAVE :: CC,PPT
+!-----------------------------------------------------------------------
+      REAL,SAVE :: ABCFF(NB)
+      INTEGER,DIMENSION(its:ite,jts:jte) :: LVL
+      REAL,   DIMENSION(its:ite, jts:jte):: PDSL,FNE,FSE,TL
+      REAL,   DIMENSION(  0:kte)  :: CLDAMT
+      REAL,   DIMENSION(its:ite,3):: CLDCFR
+      INTEGER,   DIMENSION(its:ite,3):: MBOT,MTOP
+      REAL,   DIMENSION(its:ite)  :: PSFC,TSKN,ALBEDO,XLAT,COSZ,        &
+     &                               SLMSK,FLWUP,                       &
+     &                               FSWDN,FSWUP,FSWDNS,FSWUPS,FLWDNS,  &
+     &                               FLWUPS,FSWDNSC
+
+      REAL,   DIMENSION(its:ite,kts:kte) :: PMID,TMID
+      REAL,   DIMENSION(its:ite,kts:kte) :: QMID,THMID,OZN,POZN
+      REAL,   DIMENSION(its:ite,jts:jte) :: TOT 
+
+      REAL,   DIMENSION(its:ite,kts:kte+1) :: PINT,EMIS,CAMT
+      INTEGER,DIMENSION(its:ite,kts:kte+1) :: KBTM,KTOP
+      INTEGER,DIMENSION(its:ite)   :: NCLDS,KCLD 
+      REAL,   DIMENSION(its:ite)   :: TAUDAR
+      REAL,   DIMENSION(its:ite,NB,kts:kte+1) ::RRCL,TTCL
+
+      REAL,   DIMENSION(its:ite,kts:kte):: CSMID,CCMID,QWMID,QIMID
+!!      &                                     ,QOVRCST                  ! Added
+      REAL,SAVE :: P400=40000.
+      INTEGER,SAVE :: NFILE=14
+
+!-----------------------------------------------------------------------
+      REAL    :: CLSTP,TIME,DAYI,HOUR,ADDL,RANG
+      REAL    :: TIMES,EXNER,APES,SNOFAC,CCLIMIT,CLIMIT,P1,P2,CC1,CC2
+      REAL    :: PMOD,CLFR1,CTAU,WV,ARG,CLDMAX
+      REAL    :: CL1,CL2,CR1,DPCL,QSUM,PRS1,PRS2,DELP,TCLD,DD,EE,AA,FF
+      REAL    :: BB,GG,FCTR,PDSLIJ,CFRAVG,SNOMM
+      REAL    :: THICK,CONVPRATE,CLFR,ESAT,QSAT,RHUM,QCLD
+      REAL    :: RHtot,RRHO,FLARGE,FSMALL,DSNOW,SDM,QPCLDY,DIFCLD
+      REAL    :: TauC,CTauL,CTauS,  CFSmax,CFCmax
+      INTEGER :: I,J,MYJS,MYJE,MYIS,MYIE,NTSPH,NRADPP,ITIMSW,ITIMLW,    &
+     &           JD,II
+      INTEGER :: L,N,LML,LVLIJ,IR,KNTLYR,LL,NC,L400,NMOD,LTROP,IWKL
+      INTEGER :: LCNVB,LCNVT
+      INTEGER :: NLVL,MALVL,LLTOP,LLBOT,KBT2,KTH1,KBT1,KTH2,KTOP1,KFLIP
+      INTEGER :: NBAND,NCLD,LBASE,NKTP,NBTM,KS,MYJS1,MYJS2,MYJE2,MYJE1
+
+!-------------------------------------------------
+! urban related variables are added to declaration
+!-------------------------------------------------
+      REAL, OPTIONAL, INTENT(OUT), DIMENSION(ims:ime,jms:jme)  :: COSZ_URB2D  !urban
+      REAL, OPTIONAL, INTENT(OUT), DIMENSION(ims:ime,jms:jme)  :: OMG_URB2D   !urban
+
+      INTEGER :: INDEXS,IXSD
+      DATA    CC/0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0/
+      DATA    PPT/0.,.14,.31,.70,1.6,3.4,7.7,17.,38.,85./
+      DATA ABCFF/2*4.0E-5,.002,.035,.377,1.95,9.40,44.6,190.,989.,      &
+     &           2706.,39011./
+! begin debugging radiation
+      integer :: imd,jmd, Jndx
+      real :: FSWrat
+      imd=(ims+ime)/2
+      jmd=(jms+jme)/2
+! end debugging radiation
+!
+!=======================================================================
+!
+      MYJS=jts
+      MYJE=jte
+      MYIS=its
+      MYIE=ite
+      MYJS1=jts !????
+      MYJE1=jte
+      MYJS2=jts
+      MYJE2=jte
+      LM=kte
+      LM1=LM-1
+      LP1=LM+1
+!
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        LMH(I,J)=KME-1
+        LVL(I,J)=0
+      ENDDO
+      ENDDO
+!**********************************************************************
+!***  THE FOLLOWING CODE IS EXECUTED EACH TIME THE RADIATION IS CALLED.
+!**********************************************************************
+!----------------------CONVECTION--------------------------------------
+!  NRADPP IS THE NUMBER OF TIME STEPS TO ACCUMULATE CONVECTIVE PRECIP
+!     FOR RADIATION
+!   NOTE: THIS WILL NOT WORK IF NRADS AND NRADL ARE DIFFERENT UNLESS
+!         THEY ARE INTEGER MULTIPLES OF EACH OTHER
+!  CLSTP IS THE NUMBER OF HOURS OF THE ACCUMULATION PERIOD
+!
+      NTSPH=NINT(3600./DT)
+      NRADPP=MIN(NRADS,NRADL)
+      CLSTP=1.0*NRADPP/NTSPH
+      CONVPRATE=CUPRATE/CLSTP
+!----------------------CONVECTION--------------------------------------
+!***
+!***  STATE WHETHER THE SHORT OR LONGWAVE COMPUTATIONS ARE TO BE DONE.
+!***
+      SHORT=.TRUE. 
+      LONG=.TRUE. 
+      ITIMSW=0
+      ITIMLW=0
+      IF(SHORT)ITIMSW=1
+      IF(LONG) ITIMLW=1
+!***
+!***  FIND THE MEAN COSINE OF THE SOLAR ZENITH ANGLE 
+!***  BETWEEN THE CURRENT TIME AND THE NEXT TIME RADIATION IS
+!***  CALLED.  ONLY AVERAGE IF THE SUN IS ABOVE THE HORIZON.
+!***
+!     TIME=NTSD*DT
+      TIME=XTIME*60.
+!-----------------------------------------------------------------------
+      CALL ZENITH(TIME,DAYI,HOUR,IDAT,IHRST,GLON,GLAT,CZEN,             &
+     &            MYIS,MYIE,MYJS,MYJE,                                  &
+     &            ids,ide, jds,jde, kds,kde,                            &
+     &            ims,ime, jms,jme, kms,kme,                            &
+     &            its,ite, jts,jte, kts,kte,                            & 
+     &            OMG_URB2d=OMG_URB2D                                   ) !Optional urban
+!-----------------------------------------------------------------------
+!     write(0,*)'1st ZEN ',TIME,DAYI,HOUR,IDAT,IHRST,CZEN(ITS,JTS)
+      ADDL=0.
+      IF(MOD(IDAT(3),4).EQ.0)ADDL=1.
+      RANG=PI2*(DAYI-RLAG)/(365.+ADDL)
+      RSIN1=SIN(RANG)
+      RCOS1=COS(RANG)
+      RCOS2=COS(2.*RANG)
+!
+!-----------------------------------------------------------------------
+      IF(SHORT)THEN
+        DO J=MYJS,MYJE
+        DO I=MYIS,MYIE
+          CZMEAN(I,J)=0.
+          TOT(I,J)=0.
+        ENDDO
+        ENDDO
+!
+        DO II=0,NRADS,NPHS
+          TIMES=XTIME*60.+II*DT
+      CALL ZENITH(TIME,DAYI,HOUR,IDAT,IHRST,GLON,GLAT,CZEN,             &
+     &                MYIS,MYIE,MYJS,MYJE,                              &
+     &                ids,ide, jds,jde, kds,kde,                        &
+     &                ims,ime, jms,jme, kms,kme,                        &
+     &                its,ite, jts,jte, kts,kte,                        & 
+     &                OMG_URB2D)                                         !Optional urban
+!         write(0,*)'2nd ZEN ',TIMES,DAYI,HOUR,IDAT,IHRST,CZEN(ITS,JTS),&
+!    &                II,NRADS,NPHS,NTSD,DT
+          DO J=MYJS,MYJE
+          DO I=MYIS,MYIE
+            IF(CZEN(I,J).GT.0.)THEN
+              CZMEAN(I,J)=CZMEAN(I,J)+CZEN(I,J)
+              TOT(I,J)=TOT(I,J)+1.
+            ENDIF
+          ENDDO
+          ENDDO
+        ENDDO
+        DO J=MYJS,MYJE
+        DO I=MYIS,MYIE
+          IF(TOT(I,J).GT.0.)CZMEAN(I,J)=CZMEAN(I,J)/TOT(I,J)
+        ENDDO
+        ENDDO
+      ENDIF
+
+!--------------------------------------------
+! COSZ2D is calculated for urban
+!--------------------------------------------
+      DO J=MYJS,MYJE              !urban
+      DO I=MYIS,MYIE              !urban
+      if(present(COSZ_URB2D)) COSZ_URB2D(I,J)=CZEN(I,J)   !urban
+      ENDDO                       !urban
+      ENDDO                       !urban
+!
+!
+!***  Do not modify pressure for ozone concentrations below the top layer
+!***
+      DO L=2,LM
+      DO I=MYIS,MYIE
+        POZN(I,L)=H1
+      ENDDO
+      ENDDO
+!-----------------------------------------------------------------------
+!
+!***********************************************************************
+!***  THIS IS THE BEGINNING OF THE PRIMARY LOOP THROUGH THE DOMAIN
+!***********************************************************************
+!                        *********************
+                         DO 700 J = MYJS, MYJE
+!                        *********************
+!
+      DO 125 L=1,LM
+      DO I=MYIS,MYIE
+        TMID(I,L)=T(I,1,J)
+        QMID(I,L)=EPSQ
+        QWMID(I,L)=0.
+        QIMID(I,L)=0.
+        CSMID(I,L)=0.
+        CCMID(I,L)=0.
+        OZN(I,L)=EPSO3
+        TENDS(I,L,J)=0.
+        TENDL(I,L,J)=0.
+      ENDDO
+  125 CONTINUE
+!
+      DO 140 N=1,3
+      DO I=MYIS,MYIE
+        CLDCFR(I,N)=0.
+        MTOP(I,N)=0
+        MBOT(I,N)=0
+      ENDDO
+  140 CONTINUE
+!***
+!***  FILL IN WORKING ARRAYS WHERE VALUES AT L=LM ARE THOSE THAT
+!***  ARE ACTUALLY AT ETA LEVEL L=LMH.
+!***
+      DO 200 I=MYIS,MYIE
+!     IR=IRAD(I)
+      LML=LMH(I,J)
+      LVLIJ=LVL(I,J)
+!
+      DO L=1,LML
+        PMID(I,L+LVLIJ)=PFLIP(I,L,J)
+        PINT(I,L+LVLIJ+1)=P8WFLIP(I,L+1,J)
+        EXNER=(1.E5/PMID(I,L+LVLIJ))**RCP
+        TMID(I,L+LVLIJ)=T(I,L,J)
+        THMID(I,L+LVLIJ)=T(I,L,J)*EXNER
+        QMID(I,L+LVLIJ)=MAX(EPSQ, Q(I,L,J))
+!--- Note that rain is ignored, only effects from cloud water and 
+!    ice (cloud ice + snow) are considered
+        QWMID(I,L+LVLIJ)=QCW(I,L,J)
+        QIMID(I,L+LVLIJ)=QICE(I,L,J)
+      ENDDO
+!***
+!***  FILL IN ARTIFICIAL VALUES ABOVE THE TOP OF THE DOMAIN.
+!***  PRESSURE DEPTHS OF THESE LAYERS IS 1 HPA.
+!***  TEMPERATURES ABOVE ARE ALREADY ISOTHERMAL WITH (TRUE) LAYER 1.
+!***
+      IF(LVLIJ.GT.0)THEN
+        KNTLYR=0
+!
+        DO L=LVLIJ,1,-1
+          KNTLYR=KNTLYR+1
+          PMID(I,L)=P8WFLIP(I,1,J)-REAL(2*KNTLYR-1)*HPINC
+          PINT(I,L+1)=PMID(I,L)+HPINC
+          EXNER=(1.E5/PMID(I,L))**RCP
+          THMID(I,L)=TMID(I,L)*EXNER
+        ENDDO
+      ENDIF
+!
+      IF(LVLIJ.EQ.0) THEN
+         PINT(I,1)=P8WFLIP(I,1,J)
+      ELSE
+         PINT(I,1)=PMID(I,1)-HPINC
+      ENDIF
+  200 CONTINUE
+!***
+!***  FILL IN THE SURFACE PRESSURE, SKIN TEMPERATURE, GEODETIC LATITUDE,
+!***  ZENITH ANGLE, SEA MASK, AND ALBEDO.  THE SKIN TEMPERATURE IS
+!***  NEGATIVE OVER WATER.
+!***
+      DO 250 I=MYIS,MYIE
+      PSFC(I)=P8WFLIP(I,KME,J)
+      APES=(PSFC(I)*1.E-5)**RCP
+!     TSKN(I)=THS(I,J)*APES*(1.-2.*SM(I,J))
+      IF((XLAND(I,J)-1.5).GT.0.)THEN
+        TSKN(I)=-TSK2D(I,J)
+      ELSE
+        TSKN(I)=TSK2D(I,J)
+      ENDIF
+
+!     TSKN(I)=THS(I,J)*APES*(1.-2.*(XLAND(I,J)-1.))
+!     SLMSK(I)=SM(I,J)
+      SLMSK(I)=XLAND(I,J)-1.
+!
+!     SNO(I,J)=AMAX1(SNO(I,J),0.)
+!BSF => for NAMX changes, pass in surface emissivity (SFCEMS) [different for snow]
+      SNOMM=AMAX1(SNO(I,J),0.)
+      SNOFAC=AMIN1(SNOMM/0.02, 1.0)
+!!!!  ALBEDO(I)=ALB(I,J)+(1.0-0.01*VEGFRC(I,J))*SNOFAC*(SNOALB-ALB(I,J))
+      ALBEDO(I)=ALB(I,J)
+!
+      XLAT(I)=GLAT(I,J)/DTR
+      COSZ(I)=CZMEAN(I,J)
+  250 CONTINUE
+!-----------------------------------------------------------------------
+!---  COMPUTE GRID-SCALE CLOUD COVER FOR RADIATION  (Ferrier, Nov '04)
+!
+!--- Assumes Gaussian-distributed probability density functions (PDFs) for
+!    total relative humidity (RHtot) within the grid for convective and
+!    grid-scale cloud processes.  The standard deviation of RHtot is assumed
+!    to be larger for convective clouds than grid-scale (stratiform) clouds.
+!-----------------------------------------------------------------------
+!
+      DO I=MYIS,MYIE
+        LML=LMH(I,J)
+        LVLIJ=LVL(I,J)
+        DO 255 L=1,LML
+            LL=L+LVLIJ
+            WV=QMID(I,LL)/(1.-QMID(I,LL))       !--- Water vapor mixing ratio
+            QCLD=QWMID(I,LL)+QIMID(I,LL)        !--- Total cloud water + ice mixing ratio
+            IF (QCLD .LE. EPSQ) GO TO 255       !--- Skip if no condensate is present
+            CLFR=H0
+            WV=QMID(I,LL)/(1.-QMID(I,LL))       !--- Water vapor mixing ratio
+               
+    !
+    !--- Saturation vapor pressure w/r/t water ( >=0C ) or ice ( <0C )
+    !
+#ifdef FERRIER_GFDL
+            ESAT=1000.*FPVS(TMID(I,LL))         !--- Saturation vapor pressure (Pa)
+#else
+            ESAT=FPVS_new(TMID(I,LL))           !--- Saturation vapor pressure (Pa)
+#endif
+            QSAT=EP_2*ESAT/(PMID(I,LL)-ESAT)    !--- Saturation mixing ratio
+            RHUM=WV/QSAT                        !--- Relative humidity
+    !
+    !--- Revised cloud cover parameterization (temporarily ignore rain)
+    !
+            RHtot=(WV+QCLD)/QSAT                !--- Total relative humidity
+!!    !
+!!    !--- QOVRCST is the amount of cloud condensate associated with full
+!!    !    overcast, PCLDY is an arbitrary factor for partial cloudiness
+!!    !
+!!            TCLD=TMID(I,LL)-T0C                 !--- Air temp in deg C
+!!            RRHO=(R_D*TMID(I,LL)*(1.+EP_1*QMID(I,LL)))/PMID(I,LL)
+!!            IF (TCLD .GE. 0.) THEN
+!!               QOVRCST(I,LL)=QAUT0*RRHO
+!!            ELSE
+!!               IF (TCLD.GE.-8. .AND. TCLD.LE.-3.) THEN
+!!                  FLARGE=FLARGE1
+!!               ELSE
+!!                  FLARGE=FLARGE2
+!!               ENDIF
+!!               FSMALL=(1.-FLARGE)/FLARGE
+!!               DSNOW=XMImax*EXP(XMIexp*TCLD)
+!!               INDEXS=MAX(MDImin, MIN(MDImax, INT(DSNOW)))
+!!               QOVRCST(I,LL)=NLImax*( FSMALL*MASSI(MDImin)              &
+!!     &                               +MASSI(INDEXS) )*RRHO
+!!            ENDIF                 !--- End IF (TCLD .GE. 0.)
+!!            QOVRCST(I,LL)=PCLDY*QOVRCST(I,LL)
+            LCNVT=NINT(CUTOP(I,J))+LVLIJ
+            LCNVT=MIN(LM,LCNVT)
+            LCNVB=NINT(CUBOT(I,J))+LVLIJ
+            LCNVB=MIN(LM,LCNVB)
+            IF (LL.GE.LCNVT .AND. LL.LE.LCNVB) THEN
+               SDM=CVSDM
+            ELSE
+               SDM=STSDM
+            ENDIF
+            ARG=(RHtot-RHgrd)/SDM
+            IF (ARG.LE.DXSD2 .AND. ARG.GE.DXSD2N) THEN
+               CLFR=HALF
+            ELSE IF (ARG .GT. DXSD2) THEN
+               IF (ARG .GE. XSDmax) THEN
+                  CLFR=H1
+               ELSE
+                  IXSD=INT(ARG/DXSD+HALF)
+                  IXSD=MIN(NXSD, MAX(IXSD,1))
+                  CLFR=HALF+AXSD(IXSD)
+                  if (SDprint)                                          &
+     & write(6,"(a,3i3,i4,f8.4,f7.4,2f6.3,f7.3,f6.1,f6.0)")                 &
+     & 'I,LL,J,IXSD,ARG,SDM,CLFR,RHtot,QSAT,T,P=', I,LL,J,IXSD,ARG,SDM,CLFR,RHtot     &
+     & ,1000.*QSAT,TCLD,.01*PMID(I,LL)
+               ENDIF              !--- End IF (ARG .GE. XSDmax)
+            ELSE
+               IF (ARG .LE. XSDmin) THEN
+                  CLFR=H0
+               ELSE
+                  IXSD=INT(ARG/DXSD1+HALF)
+                  IXSD=MIN(NXSD, MAX(IXSD,1))
+                  CLFR=HALF-AXSD(IXSD)
+                  if (SDprint)                                          &
+     & write(6,"(a,3i3,i4,f8.4,f7.4,2f6.3,f7.3,f6.1,f6.0)")                 &
+     & 'I,LL,J,IXSD,ARG,SDM,CLFR,RHtot,QSAT,T,P=', I,LL,J,IXSD,ARG,SDM,CLFR,RHtot     &
+     & ,1000.*QSAT,TCLD,.01*PMID(I,LL)
+                  IF (CLFR .LT. CLFRmin) CLFR=H0
+               ENDIF        !--- End IF (ARG .LE. XSDmin) 
+            ENDIF           !--- IF (ARG.LE.DXSD2 .AND. ARG.GE.DXSD2N)
+            CSMID(I,LL)=CLFR
+!!  !
+!!  !--- Here the condensate is adjusted to be only over the cloudy area
+!!  !
+!!            IF (CLFR.GT.0. .AND. QCLD.LE.0.) THEN
+!!  !
+!!  !--- Put in modest amounts of cloud water & cloud ice for partially cloudy grids
+!!  !
+!!               QPCLDY=MIN(.01*QSAT, QOVRCST(I,LL))
+!!               IF (TCLD .GE. H0) THEN
+!!                  QWMID(I,LL)=QPCLDY
+!!               ELSE
+!!                  QIMID(I,LL)=QPCLDY
+!!               ENDIF
+!!            ENDIF          !--- End IF (CLFR.GT.0. .AND. QCLD.LE.0.) 
+255       CONTINUE         !--- End DO L=1,LML
+      ENDDO                !--- End DO I=MYIS,MYIE
+!
+!***********************************************************************
+!******************  END OF GRID-SCALE CLOUD FRACTIONS  ****************
+!
+!---  COMPUTE CONVECTIVE CLOUD COVER FOR RADIATION 
+!
+!--- The parameterization of Slingo (1987, QJRMS, Table 1, p. 904) is 
+!    used for convective cloud fraction as a function of precipitation 
+!    rate.  Cloud fractions have been increased by 20% for each rainrate
+!    interval so that shallow, nonprecipitating convection is ascribed a
+!    constant cloud fraction of 0.1  (Ferrier, Feb '02).
+!***********************************************************************
+!
+      IF (CNCLD) THEN
+        DO I=MYIS,MYIE
+!
+!***  CLOUD TOPS AND BOTTOMS COME FROM CUCNVC
+!     Convective clouds need to be at least 2 model layers thick
+!
+          IF (CUBOT(I,J)-CUTOP(I,J) .GT. 1.0) THEN
+ !--- Compute convective cloud fractions if appropriate  (Ferrier, Feb '02)
+            CLFR=CC(1)
+            PMOD=CUPPT(I,J)*CONVPRATE
+            IF (PMOD .GT. PPT(1)) THEN
+              DO NC=1,10
+                IF(PMOD.GT.PPT(NC)) NMOD=NC
+              ENDDO
+              IF (NMOD .GE. 10) THEN
+                CLFR=CC(10)
+              ELSE
+                CC1=CC(NMOD)
+                CC2=CC(NMOD+1)
+                P1=PPT(NMOD)
+                P2=PPT(NMOD+1)
+                CLFR=CC1+(CC2-CC1)*(PMOD-P1)/(P2-P1)
+              ENDIF      !--- End IF (NMOD .GE. 10) ...
+              CLFR=MIN(H1, CLFR)
+            ENDIF        !--- End IF (PMOD .GT. PPT(1)) ...
+  !
+  !***  ADD LVL TO BE CONSISTENT WITH OTHER WORKING ARRAYS
+  !
+            LVLIJ=LVL(I,J)
+            LCNVT=NINT(CUTOP(I,J))+LVLIJ
+            LCNVT=MIN(LM,LCNVT)
+            LCNVB=NINT(CUBOT(I,J))+LVLIJ
+            LCNVB=MIN(LM,LCNVB)
+!! !
+!! !---- For debugging
+!! !
+!!      WRITE(6,"(2(A,I3),2(A,I2),2(A,F5.2),2(A,I2),A,F6.4)") 
+!!     & ' J=',J,' I=',I,' LCNVB=',LCNVB,' LCNVT=',LCNVT
+!!     &, ' CUBOT=',CUBOT(I,J),' CUTOP=',CUTOP(I,J)
+!!     &,' LVL=',LVLIJ,' LMH=',LMH(I,J),' CCMID=',CLFR
+!! !
+   !
+   !--- Build in small amounts of subgrid-scale convective condensate 
+   !    (simple assumptions), but only if the convective cloud fraction 
+   !    exceeds that of the grid-scale cloud fraction
+   !
+            DO LL=LCNVT,LCNVB
+              ARG=MAX(H0, H1-CSMID(I,LL))
+              CCMID(I,LL)=MIN(ARG,CLFR)
+            ENDDO           !--- End DO LL=LCNVT,LCNVB
+          ENDIF             !--- IF (CUBOT(I,J)-CUTOP(I,J) .GT. 1.0) ...
+        ENDDO               !--- End DO I loop
+      ENDIF                 !--- End IF (CNCLD) ...
+!
+!*********************************************************************
+!***************  END OF CONVECTIVE CLOUD FRACTIONS  *****************
+!*********************************************************************
+!***
+!***  DETERMINE THE FRACTIONAL CLOUD COVERAGE FOR HIGH, MID
+!***  AND LOW OF CLOUDS FROM THE CLOUD COVERAGE AT EACH LEVEL
+!***
+!***  NOTE: THIS IS FOR DIAGNOSTICS ONLY!!!
+!***
+!***
+       DO 500 I=MYIS,MYIE
+!!
+       DO L=0,LM
+         CLDAMT(L)=0.
+       ENDDO
+!!  
+!!***  NOW GOES LOW, MIDDLE, HIGH
+!!
+       DO 480 NLVL=1,3
+       CLDMAX=0.
+       MALVL=LM
+       LLTOP=LM+1-LTOP(NLVL)+LVL(I,J)
+!!***
+!!***  GO TO THE NEXT CLOUD LAYER IF THE TOP OF THE CLOUD-TYPE IN
+!!***  QUESTION IS BELOW GROUND OR IS IN THE LOWEST LAYER ABOVE GROUND.
+!!***
+       IF(LLTOP.GE.LM)GO TO 480
+!!
+       IF(NLVL.GT.1)THEN
+         LLBOT=LM+1-LTOP(NLVL-1)-1+LVL(I,J)
+         LLBOT=MIN(LLBOT,LM1)
+       ELSE
+         LLBOT=LM1
+       ENDIF
+!!
+       DO 435 L=LLTOP,LLBOT
+       CLDAMT(L)=AMAX1(CSMID(I,L),CCMID(I,L))
+       IF(CLDAMT(L).GT.CLDMAX)THEN
+         MALVL=L
+         CLDMAX=CLDAMT(L)
+       ENDIF
+   435 CONTINUE
+!!*********************************************************************
+!! NOW, CALCULATE THE TOTAL CLOUD FRACTION IN THIS PRESSURE DOMAIN
+!! USING THE METHOD DEVELOPED BY Y.H., K.A.C. AND A.K. (NOV., 1992).
+!! IN THIS METHOD, IT IS ASSUMED THAT SEPERATED CLOUD LAYERS ARE
+!! RADOMLY OVERLAPPED AND ADJACENT CLOUD LAYERS ARE MAXIMUM OVERLAPPED.
+!! VERTICAL LOCATION OF EACH TYPE OF CLOUD IS DETERMINED BY THE THICKEST
+!! CONTINUING CLOUD LAYERS IN THE DOMAIN.
+!!*********************************************************************
+       CL1=0.0
+       CL2=0.0
+       KBT1=LLBOT
+       KBT2=LLBOT
+       KTH1=0
+       KTH2=0
+!!
+       DO 450 LL=LLTOP,LLBOT
+       L=LLBOT-LL+LLTOP
+       BIT1=.FALSE.
+       CR1=CLDAMT(L)
+       BITX=(PINT(I,L).GE.PTOPC(NLVL+1)).AND.                           &
+      &     (PINT(I,L).LT.PTOPC(NLVL)).AND.                             &
+      &     (CLDAMT(L).GT.0.0)
+       BIT1=BIT1.OR.BITX
+       IF(.NOT.BIT1)GO TO 450
+!!***
+!!***  BITY=T: FIRST CLOUD LAYER; BITZ=T:CONSECUTIVE CLOUD LAYER
+!!***  NOTE:  WE ASSUME THAT THE THICKNESS OF EACH CLOUD LAYER IN THE
+!!***         DOMAIN IS LESS THAN 200 MB TO AVOID TOO MUCH COOLING OR
+!!***         HEATING. SO WE SET CTHK(NLVL)=200*E2. BUT THIS LIMIT MAY
+!!***         WORK WELL FOR CONVECTIVE CLOUDS. MODIFICATION MAY BE
+!!***         NEEDED IN THE FUTURE.
+!!***
+       BITY=BITX.AND.(KTH2.LE.0)
+       BITZ=BITX.AND.(KTH2.GT.0)
+!!
+       IF(BITY)THEN
+         KBT2=L
+         KTH2=1
+       ENDIF
+!!
+       IF(BITZ)THEN
+         KTOP1=KBT2-KTH2+1
+         DPCL=PMID(I,KBT2)-PMID(I,KTOP1)
+         IF(DPCL.LT.CTHK(NLVL))THEN
+           KTH2=KTH2+1
+         ELSE
+           KBT2=KBT2-1
+         ENDIF
+       ENDIF
+       IF(BITX)CL2=AMAX1(CL2,CR1)
+!!***
+!!*** AT THE DOMAIN BOUNDARY OR SEPARATED CLD LAYERS, RANDOM OVERLAP.
+!!*** CHOOSE THE THICKEST OR THE LARGEST FRACTION AMT AS THE CLD
+!!*** LAYER IN THAT DOMAIN.
+!!***
+       BIT2=.FALSE.
+       BITY=BITX.AND.(CLDAMT(L-1).LE.0.0.OR. &
+            PINT(I,L-1).LT.PTOPC(NLVL+1))
+       BITZ=BITY.AND.CL1.GT.0.0
+       BITW=BITY.AND.CL1.LE.0.0
+       BIT2=BIT2.OR.BITY
+       IF(.NOT.BIT2)GO TO 450
+!!
+       IF(BITZ)THEN
+         KBT1=INT((CL1*KBT1+CL2*KBT2)/(CL1+CL2))
+         KTH1=INT((CL1*KTH1+CL2*KTH2)/(CL1+CL2))+1
+         CL1=CL1+CL2-CL1*CL2
+       ENDIF
+!!
+       IF(BITW)THEN
+         KBT1=KBT2
+         KTH1=KTH2
+         CL1=CL2
+       ENDIF
+!!
+       IF(BITY)THEN
+         KBT2=LLBOT
+         KTH2=0
+         CL2=0.0
+       ENDIF
+   450 CONTINUE
+!
+       CLDCFR(I,NLVL)=AMIN1(1.0,CL1)
+       MTOP(I,NLVL)=MIN(KBT1,KBT1-KTH1+1)
+       MBOT(I,NLVL)=KBT1
+   480 CONTINUE
+   500 CONTINUE
+
+!***
+!***  SET THE UN-NEEDED TAUDAR TO ONE
+!***
+      DO I=MYIS,MYIE
+        TAUDAR(I)=1.0
+      ENDDO
+!----------------------------------------------------------------------
+! NOW, CALCULATE THE CLOUD RADIATIVE PROPERTIES AFTER DAVIS (1982),
+! HARSHVARDHAN ET AL (1987) AND Y.H., K.A.C. AND A.K. (1993).
+! 
+! UPDATE: THE FOLLOWING PARTS ARE MODIFIED, AFTER Y.T.H. (1994), TO 
+!         CALCULATE THE RADIATIVE PROPERTIES OF CLOUDS ON EACH MODEL
+!         LAYER. BOTH CONVECTIVE AND STRATIFORM CLOUDS ARE USED
+!         IN THIS CALCULATIONS.
+!
+!                                     QINGYUN ZHAO   95-3-22
+!
+!----------------------------------------------------------------------
+!
+!***
+!*** INITIALIZE ARRAYS FOR USES LATER
+!***
+
+      DO 600 I=MYIS,MYIE
+      LML=LMH(I,J)
+      LVLIJ=LVL(I,J)
+!
+!***
+!*** NOTE: LAYER=1 IS THE SURFACE, AND LAYER=2 IS THE FIRST CLOUD
+!***       LAYER ABOVE THE SURFACE AND SO ON.
+!***
+      EMIS(I,1)=1.0
+      KTOP(I,1)=LP1
+      KBTM(I,1)=LP1
+      CAMT(I,1)=1.0
+      KCLD(I)=2
+!
+      DO NBAND=1,NB
+        RRCL(I,NBAND,1)=0.0
+        TTCL(I,NBAND,1)=1.0
+      ENDDO
+!
+      DO 510 L=2,LP1
+      CAMT(I,L)=0.0
+      KTOP(I,L)=1
+      KBTM(I,L)=1
+      EMIS(I,L)=0.0
+!
+      DO NBAND=1,NB
+        RRCL(I,NBAND,L)=0.0
+        TTCL(I,NBAND,L)=1.0
+      ENDDO
+  510 CONTINUE
+
+!### End changes so far
+!***
+!*** NOW CALCULATE THE AMOUNT, TOP, BOTTOM AND TYPE OF EACH CLOUD LAYER
+!*** CLOUD TYPE=1: STRATIFORM CLOUD
+!***       TYPE=2: CONVECTIVE CLOUD
+!*** WHEN BOTH CONVECTIVE AND STRATIFORM CLOUDS EXIST AT THE SAME POINT,
+!*** SELECT CONVECTIVE CLOUD WITH THE HIGHER CLOUD FRACTION.
+!*** CLOUD LAYERS ARE SEPARATED BY TOTAL ABSENCE OF CLOUDINESS.
+!*** NOTE: THERE IS ONLY ONE CONVECTIVE CLOUD LAYER IN ONE COLUMN.
+!*** KTOP AND KBTM ARE THE TOP AND BOTTOM OF EACH CLOUD LAYER IN TERMS
+!*** OF MODEL LEVEL.
+!***
+      NEW_CLOUD=.TRUE.
+!
+      DO L=2,LML
+        LL=LML-L+1+LVLIJ                        !-- Model layer
+        CLFR=MAX(CCMID(I,LL),CSMID(I,LL))       !-- Cloud fraction in layer
+        CLFR1=MAX(CCMID(I,LL+1),CSMID(I,LL+1))  !-- Cloud fraction in lower layer
+!-------------------
+        IF (CLFR .GE. CLFRMIN) THEN
+!--- Cloud present at level
+          IF (NEW_CLOUD) THEN
+!--- New cloud layer
+            IF(L==2.AND.CLFR1>=CLFRmin)THEN
+              KBTM(I,KCLD(I))=LL+1
+              CAMT(I,KCLD(I))=CLFR1
+            ELSE
+              KBTM(I,KCLD(I))=LL
+              CAMT(I,KCLD(I))=CLFR
+            ENDIF
+            NEW_CLOUD=.FALSE.
+          ELSE
+!--- Existing cloud layer
+            CAMT(I,KCLD(I))=AMAX1(CAMT(I,KCLD(I)), CLFR)
+          ENDIF        ! End IF (NEW_CLOUD .EQ. 0) ...
+        ELSE IF (CLFR1 .GE. CLFRMIN) THEN
+!--- Cloud is not present at level but did exist at lower level, then ...
+          IF (L .EQ. 2) THEN
+!--- For the case of ground fog
+            KBTM(I,KCLD(I))=LL+1
+            CAMT(I,KCLD(I))=CLFR1
+          ENDIF
+          KTOP(I,KCLD(I))=LL+1
+          NEW_CLOUD=.TRUE.
+          KCLD(I)=KCLD(I)+1
+          CAMT(I,KCLD(I))=0.0
+        ENDIF
+!-------------------
+      ENDDO      !--- End DO L loop
+!***
+!*** THE REAL NUMBER OF CLOUD LAYERS IS (THE FIRST IS THE GROUND;
+!*** THE LAST IS THE SKY):
+!***
+      NCLDS(I)=KCLD(I)-2
+      NCLD=NCLDS(I)
+!***
+!***  NOW CALCULATE CLOUD RADIATIVE PROPERTIES
+!***
+      IF(NCLD.GE.1)THEN
+!***
+!*** NOTE: THE FOLLOWING CALCULATIONS, THE UNIT FOR PRESSURE IS MB!!!
+!***
+        DO 580 NC=2,NCLD+1
+!
+        TauC=0.    !--- Total optical depth for each cloud layer (solar & longwave)
+        QSUM=0.0
+        NKTP=LP1
+        NBTM=0
+        BITX=CAMT(I,NC).GE.CLFRMIN
+        NKTP=MIN(NKTP,KTOP(I,NC))
+        NBTM=MAX(NBTM,KBTM(I,NC))
+!
+        DO LL=NKTP,NBTM
+          IF(LL.GE.KTOP(I,NC).AND.LL.LE.KBTM(I,NC).AND.BITX)THEN
+            PRS1=PINT(I,LL)*0.01
+            PRS2=PINT(I,LL+1)*0.01
+            DELP=PRS2-PRS1
+            TCLD=TMID(I,LL)-T0C
+            QSUM=QSUM+QMID(I,LL)*DELP*(PRS1+PRS2)                       &     
+     &           /(120.1612*SQRT(TMID(I,LL)))
+!
+!***********************************************************************
+!****  IMPORTANT NOTES concerning input cloud optical properties  ******
+!***********************************************************************
+!
+!--- The simple optical depth parameterization from eq. (1) of Harshvardhan
+!    et al. (1989, JAS, p. 1924; hereafter referred to as HRCD by authorship)
+!    is used for convective cloud properties with some simple changes.
+!
+!--- The optical depth Tau is Tau=CTau*DELP, where values of CTau are
+!    described below.
+!      1) CTau=0.08*(Qc/Q0) for cloud water mixing ratio (Qc), where
+!         Q0 is assumed to be the threshold mixing ratio for "thick anvils",
+!         as noted in the 2nd paragraph after eq. (1) in Harshvardhan et al.
+!         (1989).  A value of Q0=0.1 g/kg is assumed based on experience w/
+!         cloud observations, and it is intended only to be a crude scaling
+!         factor for "order of magnitude" effects.  The functional dependence
+!         on mixing ratio is based on Stephens (1978, JAS, p. 2124, eq. 7).
+!         Result: CTau=800.*Qc => note that the "800." factor is referred to
+!         as an absorption coefficient
+!      2) For an assumed value of Q0=1 g/kg for "thick anvils", then 
+!         CTau=80.*Qc, or an absorption coefficient that is an order of 
+!         magnitude less.
+!      => ABSCOEF_W can vary from 100. to 1000. !!
+!      3) From p. 3105 of Dudhia (1989), values of 
+!         0.14 (m**2/g) * 1000 (g/kg) / 9.81 (m/s**2) = 14.27 /Pa
+!         => 14.27 (/Pa) * 100 (Pa/mb) = 1427 /mb
+!      4) From Dudhia's SW radiation, ABSCOEF_W ~ 1000.  after units conversion
+!      5) Again from p. 3105 of Dudhia (1989), he notes that ice absorption 
+!         coefficients are roughly half those of cloud water, it was decided
+!         to keep this simple and assume half that of water.
+!      => ABSCOEF_I=0.5*ABSCOEF_W
+!
+!--- For convection, the following is assumed:
+!      1) A characteristic water/ice mixing ratio (Qconv)
+!      2) A temperature threshold for water or ice (TRAD_ice)
+!
+!-----------------------------------------------------------------------
+!
+            CTau=0.
+!-- For crude estimation of convective cloud optical depths
+            IF (CCMID(I,LL) .GE. CLFRmin) THEN
+              IF (TCLD .GE. TRAD_ice) THEN
+                CTau=CTauCW            !--- Convective cloud water
+              ELSE
+                CTau=CTauCI            !--- Convective ice
+              ENDIF
+!              CTau=CTau*CCMID(I,LL)    !--- Reduce by convective cloud fraction
+            ENDIF
+!
+!-- For crude estimation of grid-scale cloud optical depths
+!
+!--   => The following 2 lines were intended to reduce cloud optical depths further 
+!        than what's parameterized in the NAM and what's theoretically justified
+!            CTau=CTau+CSMID(I,LL)*   &
+!     &           ( ABSCOEF_W*QWMID(I,LL)+ABSCOEF_I*QIMID(I,LL) )
+            CTau=CTau+ABSCOEF_W*QWMID(I,LL)+ABSCOEF_I*QIMID(I,LL)
+            TauC=TauC+DELP*CTau
+          ENDIF      !--- End IF(LL.GE.KTOP(I,NC) ....
+        ENDDO        !--- End DO LL
+!
+!!!     IF(BITX)EMIS(I,NC)=1.0-EXP(-0.75*TauC)
+        IF(BITX)EMIS(I,NC)=1.0-EXP(ABSCOEF_LW*TauC)
+        IF(QSUM.GE.EPSQ1)THEN
+!
+          DO 570 NBAND=1,NB
+          IF(BITX)THEN
+            PROD=ABCFF(NBAND)*QSUM
+            DDX=TauC/(TauC+PROD)
+            EEX=1.0-DDX
+            IF(ABS(EEX).GE.1.E-8)THEN
+              DD=DDX
+              EE=EEX
+              FF=1.0-DD*0.85
+              AA=MIN(50.0,SQRT(3.0*EE*FF)*TauC)
+              AA=EXP(-AA)
+              BB=FF/EE
+              GG=SQRT(BB)
+              DD=(GG+1.0)*(GG+1.0)-(GG-1.0)*(GG-1.0)*AA*AA
+              RRCL(I,NBAND,NC)=MAX(0.1E-5,(BB-1.0)*(1.0-AA*AA)/DD)
+              TTCL(I,NBAND,NC)=AMAX1(0.1E-5,4.0*GG*AA/DD)
+            ENDIF
+          ENDIF
+  570     CONTINUE
+        ENDIF
+  580   CONTINUE
+!
+      ENDIF
+!
+  600 CONTINUE
+!*********************************************************************
+!******************  COMPUTE OZONE AT MIDLAYERS  *********************
+!*********************************************************************
+!
+!***  MODIFY PRESSURE AT THE TOP MODEL LAYER TO ACCOUNT FOR THE TOTAL
+!***  OZONE FROM MODEL TOP (PINT_1) TO THE TOP OF THE ATMOSPHERE (0 MB)
+!
+      DO I=MYIS,MYIE
+        FCTR=PINT(I,2)/(PINT(I,2)-PINT(I,1))
+        POZN(I,1)=FCTR*(PMID(I,1)-PINT(I,1))
+      ENDDO
+!
+      CALL OZON2D(LM,POZN,XLAT,OZN,                                &
+                  MYIS,MYIE,                                       &
+                  ids,ide, jds,jde, kds,kde,                       &
+                  ims,ime, jms,jme, kms,kme,                       &
+                  its,ite, jts,jte, kts,kte                        )
+!
+!***  
+!***  NOW THE VARIABLES REQUIRED BY RADFS HAVE BEEN CALCULATED.
+!***
+!----------------------------------------------------------------------
+!***
+!***  CALL THE GFDL RADIATION DRIVER
+!***
+!***
+      Jndx=J
+      CALL RADFS &
+     &     (PSFC,PMID,PINT,QMID,TMID,OZN,TSKN,SLMSK,ALBEDO,XLAT         &
+!BSF => for NAMX changes, pass in surface emissivity (SFCEMS) [different for snow]
+     &,     CAMT,KTOP,KBTM,NCLDS,EMIS,RRCL,TTCL                         &
+     &,     COSZ,TAUDAR,1                                               &
+     &,     1,0                                                         &
+     &,     ITIMSW,ITIMLW                                               &
+     &,     TENDS(ITS,KTS,J),TENDL(ITS,KTS,J)                           &
+     &,     FLWUP,FSWUP,FSWDN,FSWDNS,FSWUPS,FLWDNS,FLWUPS,FSWDNSC       &
+     &,     ids,ide, jds,jde, kds,kde                                   &
+     &,     ims,ime, jms,jme, kms,kme                                   &
+! begin debugging radiation
+     &,     its,ite, jts,jte, kts,kte                                   &
+     &,     imd,jmd, Jndx                                       )
+! end debugging radiation
+!----------------------------------------------------------------------
+      IF(LONG)THEN
+!
+!--  All fluxes in W/m**2
+!--- GLW    => downward longwave at the surface (formerly RLWIN) 
+!--- RLWTOA => outgoing longwave at the top of the atmosphere
+!-- Note:  RLWOUT & SIGT4 have been removed because they are no longer being used!
+!
+        DO I=MYIS,MYIE
+          GLW(I,J)=FLWDNS(I)
+          RLWTOA(I,J)=FLWUP(I)
+        ENDDO
+      ENDIF
+!
+      IF(SHORT)THEN
+!
+!--  All fluxes in W/m**2
+!--- GSW    => NET shortwave at the surface 
+!--- RSWIN  => incoming shortwave at the surface (all sky)
+!--- RSWINC => clear-sky incoming shortwave at the surface
+!--- RSWTOA => outgoing (reflected) shortwave at the top of the atmosphere 
+!
+        DO I=MYIS,MYIE
+          GSW(I,J)=FSWDNS(I)-FSWUPS(I)
+          RSWIN(I,J) =FSWDNS(I)
+          RSWINC(I,J)=FSWDNSC(I)
+          RSWTOA(I,J)=FSWUP(I)
+        ENDDO
+      ENDIF
+!
+!***  ARRAYS ACFRST AND ACFRCV ACCUMULATE AVERAGE STRATIFORM AND
+!***  CONVECTIVE CLOUD FRACTIONS, RESPECTIVELY. 
+!***  ACCUMLATE THESE VARIABLES ONLY ONCE PER RADIATION CALL.
+!
+!***  ASSUME RANDOM OVERLAP BETWEEN LOW, MIDDLE, & HIGH LAYERS.
+!
+!***  UPDATE NEW 3D CLOUD FRACTION (CLDFRA)
+!
+      DO I=MYIS,MYIE
+        CFRACL(I,J)=CLDCFR(I,1)
+        CFRACM(I,J)=CLDCFR(I,2)
+        CFRACH(I,J)=CLDCFR(I,3)
+        IF(CNCLD)THEN
+          CFSmax=0.   !-- Maximum cloud fraction (stratiform component)
+          CFCmax=0.   !-- Maximum cloud fraction (convective component)
+          DO L=1,LMH(I,J)
+            LL=L+LVL(I,J)
+            CFSmax=MAX(CFSmax, CSMID(I,LL) )
+            CFCmax=MAX(CFCmax, CCMID(I,LL) )
+          ENDDO
+          ACFRST(I,J)=ACFRST(I,J)+CFSmax
+          NCFRST(I,J)=NCFRST(I,J)+1
+          ACFRCV(I,J)=ACFRCV(I,J)+CFCmax
+          NCFRCV(I,J)=NCFRCV(I,J)+1
+        ELSE
+  !--- Count only locations with grid-scale cloudiness, ignore convective clouds
+  !    (option not used, but if so set to the total cloud fraction)
+          CFRAVG=1.-(1.-CFRACL(I,J))*(1.-CFRACM(I,J))*(1.-CFRACH(I,J))
+          ACFRST(I,J)=ACFRST(I,J)+CFRAVG
+          NCFRST(I,J)=NCFRST(I,J)+1
+        ENDIF
+!--- Flip 3D cloud fractions in the vertical and save time
+        LML=LMH(I,J)
+        DO L=1,LML
+          LL=LML-L+1+LVL(I,J)
+          CLDFRA(I,L,J)=MAX(CCMID(I,LL),CSMID(I,LL))
+        ENDDO
+      ENDDO      !-- I index
+!***
+!***  THIS ROW IS FINISHED. GO TO NEXT
+!***
+!                        *********************
+  700                          CONTINUE
+!                        *********************
+!----------------------------------------------------------------------
+!***
+!***  CALLS TO RADIATION THIS TIME STEP ARE COMPLETE.
+!***
+!----------------------------------------------------------------------
+! begin debugging radiation
+!     FSWrat=0.
+!     if (RSWIN(imd,jmd) .gt. 0.)  &
+!        FSWrat=(RSWIN(imd,jmd)-GSW(imd,jmd))/RSWIN(imd,jmd)
+!     write(6,"(2a,2i5,7f9.2)") &
+!       '{rad3 imd,jmd,GSW,RSWIN,RSWOUT=RSWIN-GSW,RSWINC,GLW,' &
+!      ,'ALBEDO,RSWOUT/RSWIN = '&
+!      ,imd,jmd, GSW(imd,jmd),RSWIN(imd,jmd)  &
+!      ,RSWIN(imd,jmd)-GSW(imd,jmd),RSWINC(imd,jmd),GLW(imd,jmd) &
+!      ,ALB(imd,jmd),FSWrat
+! end debugging radiation
+!----------------------------------------------------------------------
+!
+!--- Need to save LW & SW tendencies since radiation calculates both and this block
+
+      END SUBROUTINE RADTN
+
+!----------------------------------------------------------------------
+
+      REAL FUNCTION GAUSIN(xsd)
+      REAL, PARAMETER :: crit=1.e-3
+      REAL A1,A2,RN,B1,B2,B3,SUM
+!
+!  This function calculate area under the Gaussian curve between mean
+!  and xsd # of standard deviation (03/22/2004  Hsin-mu Lin)
+!
+      a1=xsd*RSQR
+      a2=exp(-0.5*xsd**2)
+      rn=1.
+      b1=1.
+      b2=1.
+      b3=1.
+      sum=1.
+      do while (b2 .gt. crit)
+         rn=rn+1.
+         b2=xsd**2/(2.*rn-1.)
+         b3=b1*b2
+         sum=sum+b3
+         b1=b3
+      enddo
+      GAUSIN=a1*a2*sum
+      RETURN
+      END FUNCTION GAUSIN
+
+!----------------------------------------------------------------------
+
+      SUBROUTINE ZENITH(TIMES,DAYI,HOUR,IDAT,IHRST,GLON,GLAT,CZEN,     &
+                        MYIS,MYIE,MYJS,MYJE,                           &
+                        IDS,IDE, JDS,JDE, KDS,KDE,                     &
+                        IMS,IME, JMS,JME, KMS,KME,                     &
+                        ITS,ITE, JTS,JTE, KTS,KTE,                     &
+                        OMG_URB2D)                                       !Optional urban
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)        :: IDS,IDE, JDS,JDE, KDS,KDE ,        &
+                                    IMS,IME, JMS,JME, KMS,KME ,        &
+                                    ITS,ITE, JTS,JTE, KTS,KTE
+      INTEGER, INTENT(IN)        :: MYJS,MYJE,MYIS,MYIE
+
+      REAL,    INTENT(IN)        :: TIMES
+      REAL,    INTENT(OUT)       :: HOUR,DAYI
+      INTEGER, INTENT(IN)        :: IHRST
+
+      INTEGER, INTENT(IN), DIMENSION(3) :: IDAT 
+      REAL,    INTENT(IN), DIMENSION(IMS:IME,JMS:JME) :: GLAT,GLON
+      REAL,    INTENT(OUT), DIMENSION(IMS:IME,JMS:JME) :: CZEN
+      REAL,   OPTIONAL,  INTENT(OUT), DIMENSION(ims:ime,jms:jme)  :: OMG_URB2D !Optional urban
+
+      REAL,    PARAMETER :: GSTC1=24110.54841,GSTC2=8640184.812866,    &
+                            GSTC3=9.3104E-2,GSTC4=-6.2E-6,             &
+                            PI=3.1415926,PI2=2.*PI,PIH=0.5*PI,         &
+!#$                         DEG2RD=1.745329E-2,OBLIQ=23.440*DEG2RD,    &
+                            DEG2RD=3.1415926/180.,OBLIQ=23.440*DEG2RD, &
+                            ZEROJD=2451545.0
+
+      REAL    :: DAY,YFCTR,ADDDAY,STARTYR,DATJUL,DIFJD,SLONM,   &
+                 ANOM,SLON,DEC,RA,DATJ0,TU,STIM0,SIDTIM,HRANG
+      REAL    :: HRLCL,SINALT
+      INTEGER :: KMNTH,KNT,IDIFYR,J,I
+      LOGICAL :: LEAP
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      INTEGER :: MONTH (12)
+!-----------------------------------------------------------------------
+      DATA MONTH/31,28,31,30,31,30,31,31,30,31,30,31/
+!***********************************************************************
+!     SAVE MONTH
+      DAY=0.
+      LEAP=.FALSE.
+      IF(MOD(IDAT(3),4).EQ.0)THEN
+        MONTH(2)=29
+        LEAP=.TRUE.
+      ENDIF
+      IF(IDAT(1).GT.1)THEN
+        KMNTH=IDAT(1)-1
+        DO 10 KNT=1,KMNTH
+        DAY=DAY+REAL(MONTH(KNT))
+   10   CONTINUE
+      ENDIF
+!***
+!***  CALCULATE EXACT NUMBER OF DAYS FROM BEGINNING OF YEAR TO
+!***  FORECAST TIME OF INTEREST 
+!***
+      DAY=DAY+REAL(IDAT(2)-1)+(REAL(IHRST)+TIMES/3600.)/24.
+      DAYI=REAL(INT(DAY)+1)
+      HOUR=(DAY-DAYI+1.)*24.
+      YFCTR=2000.-IDAT(3)
+!-----------------------------------------------------------------------
+!***
+!***  FIND CELESTIAL LONGITUDE OF THE SUN THEN THE SOLAR DECLINATION AND
+!***  RIGHT ASCENSION.
+!***
+!-----------------------------------------------------------------------
+      IDIFYR=IDAT(3)-2000
+!***
+!***  FIND JULIAN DATE OF START OF THE RELEVANT YEAR
+!***  ADDING IN LEAP DAYS AS NEEDED
+!***
+      IF(IDIFYR.LT.0)THEN
+        ADDDAY=REAL(IDIFYR/4)
+      ELSE
+        ADDDAY=REAL((IDIFYR+3)/4)
+      ENDIF
+      STARTYR=ZEROJD+IDIFYR*365.+ADDDAY-0.5
+!***
+!***  THE JULIAN DATE OF THE TIME IN QUESTION
+!***
+      DATJUL=STARTYR+DAY
+!
+!***  DIFFERENCE OF ACTUAL JULIAN DATE FROM JULIAN DATE
+!***  AT 00H 1 January 2000
+!
+      DIFJD=DATJUL-ZEROJD
+!
+!***  MEAN GEOMETRIC LONGITUDE OF THE SUN
+!
+      SLONM=(280.460+0.9856474*DIFJD)*DEG2RD+YFCTR*PI2
+!
+!***  THE MEAN ANOMOLY
+!
+      ANOM=(357.528+0.9856003*DIFJD)*DEG2RD
+!
+!***  APPARENT GEOMETRIC LONGITUDE OF THE SUN
+!
+      SLON=SLONM+(1.915*SIN(ANOM)+0.020*SIN(2.*ANOM))*DEG2RD
+      IF(SLON.GT.PI2)SLON=SLON-PI2
+!
+!***  DECLINATION AND RIGHT ASCENSION
+! 
+      DEC=ASIN(SIN(SLON)*SIN(OBLIQ))
+      RA=ACOS(COS(SLON)/COS(DEC))
+      IF(SLON.GT.PI)RA=PI2-RA
+!***
+!***  FIND THE GREENWICH SIDEREAL TIME THEN THE LOCAL SOLAR
+!***  HOUR ANGLE.
+!***
+      DATJ0=STARTYR+DAYI-1.
+      TU=(DATJ0-2451545.)/36525.
+      STIM0=GSTC1+TU*(GSTC2+GSTC3*TU+GSTC4*TU*TU)
+      SIDTIM=STIM0/3600.+YFCTR*24.+1.00273791*HOUR
+      SIDTIM=SIDTIM*15.*DEG2RD
+      IF(SIDTIM.LT.0.)SIDTIM=SIDTIM+PI2
+      IF(SIDTIM.GT.PI2)SIDTIM=SIDTIM-PI2
+      HRANG=SIDTIM-RA
+!
+      DO 100 J=MYJS,MYJE
+      DO 100 I=MYIS,MYIE
+!     HRLCL=HRANG-GLON(I,J)
+      HRLCL=HRANG+GLON(I,J)+PI2
+!***
+!***  THE ZENITH ANGLE IS THE COMPLEMENT OF THE ALTITUDE THUS THE
+!***  COSINE OF THE ZENITH ANGLE EQUALS THE SINE OF THE ALTITUDE.
+!***
+      SINALT=SIN(DEC)*SIN(GLAT(I,J))+COS(DEC)*COS(HRLCL)* &
+       COS(GLAT(I,J))
+      IF(SINALT.LT.0.)SINALT=0.
+      CZEN(I,J)=SINALT
+      if(present(OMG_URB2D))OMG_URB2D(I,J)=HRLCL  !urban
+  100 CONTINUE
+!***
+!***  IF THE FORECAST IS IN A DIFFERENT YEAR THAN THE START TIME,
+!***  RESET DAYI TO THE PROPER DAY OF THE NEW YEAR (IT MUST NOT BE
+!***  RESET BEFORE THE SOLAR ZENITH ANGLE IS COMPUTED).
+!***
+      IF(DAYI.GT.365.)THEN
+        IF(.NOT.LEAP)THEN
+          DAYI=DAYI-365.
+        ELSEIF(LEAP.AND.DAYI.GT.366.)THEN
+          DAYI=DAYI-366.
+        ENDIF
+      ENDIF
+!
+      END SUBROUTINE ZENITH
+!-----------------------------------------------------------------------
+
+  SUBROUTINE OZON2D (LK,POZN,XLAT,QO3,                                &
+                     MYIS,MYIE,                                       &
+                     ids,ide, jds,jde, kds,kde,                       &
+                     ims,ime, jms,jme, kms,kme,                       &
+                     its,ite, jts,jte, kts,kte                        )
+!----------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte  
+      INTEGER, INTENT(IN)        :: LK,MYIS,MYIE
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte) :: POZN
+      REAL,    INTENT(IN), DIMENSION(its:ite)  :: XLAT
+      REAL,    INTENT(INOUT), DIMENSION(its:ite,kts:kte) :: QO3
+!----------------------------------------------------------------------
+      INTEGER, PARAMETER ::  NL=81,NLP1=NL+1,LNGTH=37*NL
+
+!     REAL,    INTENT(IN),  DIMENSION(37,NL) :: XDUO3N,XDO3N4,XDO3N2,XDO3N3
+!     REAL,    INTENT(IN), DIMENSION(NL)    :: PRGFDL
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+      INTEGER,DIMENSION(its:ite)    :: JJROW
+      REAL,   DIMENSION(its:ite)    :: TTHAN
+      REAL,   DIMENSION(its:ite,NL) :: QO3O3
+
+      INTEGER :: I,K,NUMITR,ILOG,IT,NHALF
+      REAL    :: TH2,DO3V,DO3VP,APHI,APLO
+!----------------------------------------------------------------------
+      DO I=MYIS,MYIE
+        TH2=0.2*XLAT(I)
+        JJROW(I)=19.001-TH2
+        TTHAN(I)=(19-JJROW(I))-TH2
+      ENDDO
+!
+!***  SEASONAL AND SPATIAL INTERPOLATION DONE BELOW.
+!
+      DO K=1,NL
+      DO I=MYIS,MYIE
+        DO3V=XDUO3N(JJROW(I),K)+RSIN1*XDO3N2(JJROW(I),K)  &
+                   +RCOS1*XDO3N3(JJROW(I),K)  &
+                   +RCOS2*XDO3N4(JJROW(I),K)
+        DO3VP=XDUO3N(JJROW(I)+1,K)+RSIN1*XDO3N2(JJROW(I)+1,K) &
+                    +RCOS1*XDO3N3(JJROW(I)+1,K) &
+                    +RCOS2*XDO3N4(JJROW(I)+1,K)
+!
+!***  NOW LATITUDINAL INTERPOLATION
+!***  AND CONVERT O3 INTO MASS MIXING RATIO (ORIG DATA MPY BY 1.E4)
+! 
+        QO3O3(I,K)=1.E-4*(DO3V+TTHAN(I)*(DO3VP-DO3V))
+      ENDDO
+      ENDDO
+!***
+!***  VERTICAL INTERPOLATION FOR EACH GRIDPOINT (LINEAR IN LN P)
+!***
+      NUMITR=0
+      ILOG=NL
+   20 CONTINUE
+      ILOG=(ILOG+1)/2
+        IF(ILOG.EQ.1)GO TO 25
+        NUMITR=NUMITR+1
+        GO TO 20
+   25 CONTINUE
+!
+      DO 60 K=1,LK
+!
+      NHALF=(NL+1)/2
+      DO I=MYIS,MYIE
+        JJROW(I)=NHALF
+      ENDDO
+!
+      DO 40 IT=1,NUMITR
+      NHALF=(NHALF+1)/2
+      DO I=MYIS,MYIE
+        IF(POZN(I,K).LT.PRGFDL(JJROW(I)-1))THEN
+          JJROW(I)=JJROW(I)-NHALF
+        ELSEIF(POZN(I,K).GE.PRGFDL(JJROW(I)))THEN
+          JJROW(I)=JJROW(I)+NHALF
+        ENDIF
+        JJROW(I)=MIN(JJROW(I),NL)
+        JJROW(I)=MAX(JJROW(I),2)
+      ENDDO
+   40 CONTINUE
+!
+      DO 50 I=MYIS,MYIE
+      IF(POZN(I,K).LT.PRGFDL(1))THEN
+        QO3(I,K)=QO3O3(I,1)
+      ELSE IF(POZN(I,K).GT.PRGFDL(NL))THEN
+        QO3(I,K)=QO3O3(I,NL)
+      ELSE
+        APLO=ALOG(PRGFDL(JJROW(I)-1))
+        APHI=ALOG(PRGFDL(JJROW(I)))
+        QO3(I,K)=QO3O3(I,JJROW(I))+(ALOG(POZN(I,K))-APHI)/ &
+                   (APLO-APHI)* &
+                   (QO3O3(I,JJROW(I)-1)-QO3O3(I,JJROW(I)))
+      ENDIF
+   50 CONTINUE
+!
+   60 CONTINUE
+
+  END SUBROUTINE OZON2D
+!-----------------------------------------------------------------------
+
+! SUBROUTINE ZERO2(ARRAY, &
+!                  ids,ide, jds,jde, kds,kde,                         &
+!                  ims,ime, jms,jme, kms,kme,                         &
+!                  its,ite, jts,jte, kts,kte                          )
+!----------------------------------------------------------------------
+!IMPLICIT NONE
+!----------------------------------------------------------------------
+!     INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+!                                   ims,ime, jms,jme, kms,kme ,      &
+!                                   its,ite, jts,jte, kts,kte
+!     REAL, INTENT(INOUT), DIMENSION(its:ite,jts:jte) :: ARRAY
+!     INTEGER :: I,J
+!----------------------------------------------------------------------
+!     DO J=jts,jte
+!     DO I=its,ite
+!       ARRAY(I,J)=0.
+!     ENDDO
+!     ENDDO
+
+! END SUBROUTINE ZERO2
+
+!----------------------------------------------------------------
+
+      SUBROUTINE O3INT(PHALF,DDUO3N,DDO3N2,DDO3N3,DDO3N4, &
+                 ids,ide, jds,jde, kds,kde,            &
+                 ims,ime, jms,jme, kms,kme,            &
+                 its,ite, jts,jte, kts,kte             )
+!----------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                                       .
+! SUBPROGRAM:    O3INT       COMPUTE ZONAL MEAN OZONE FOR ETA LYRS
+!   PRGMMR: KENNETH CAMPANA  ORG: W/NMC23    DATE: 89-07-07
+!           MICHAEL BALDWIN  ORG: W/NMC22    DATE: 92-06-08
+!
+! ABSTRACT: THIS CODE WRITTEN AT GFDL...
+!   CALCULATES SEASONAL ZONAL MEAN OZONE,EVERY 5 DEG OF LATITUDE,
+!   FOR CURRENT MODEL VERTICAL COORDINATE. OUTPUT DATA IN G/G * 1.E4
+!   CODE IS CALLED ONLY ONCE.
+!
+! PROGRAM HISTORY LOG:
+!   84-01-01  FELS AND SCHWARZKOPF,GFDL.
+!   89-07-07  K. CAMPANA - ADAPTED STAND-ALONE CODE FOR IN-LINE USE.
+!   92-06-08  M. BALDWIN - UPDATE TO RUN IN ETA MODEL
+!
+! USAGE:    CALL O3INT(O3,SIGL) OLD
+!   INPUT ARGUMENT LIST:
+!     PHALF    - MID LAYER PRESSURE (K=LM+1 IS MODEL SURFACE)
+!   OUTPUT ARGUMENT LIST:
+!     DDUO3N   - ZONAL MEAN OZONE DATA IN ALL MODEL LAYERS (G/G*1.E4)
+!     DDO3N2     DIMENSIONED(L,N),WHERE L(=37) IS LATITUDE BETWEEN
+!     DDO3N3     N AND S POLES,N=NUM OF VERTICAL LYRS(K=1 IS TOP LYR)
+!     DDO3N4     AND SEASON-WIN,SPR,SUM,FALL.
+!        IN COMMON
+!
+!   OUTPUT FILES:
+!     OUTPUT   - PRINT FILE.
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 200.
+!
+!$$$
+!....     PROGRAM O3INT FROM DAN SCHWARZKOPF-GETS ZONAL MEAN O3
+!..    OUTPUT O3 IS WINTER,SPRING,SUMMER,FALL (NORTHERN HEMISPHERE)
+!-----------------------------------------------------------------------
+!      INCLUDE "parmeta"
+!-----------------------------------------------------------------------
+!     *********************************************************
+
+      INTEGER :: N,NP,NP2,NM1
+
+!     PARAMETER (N=LM,NP=N+1,NP2=N+2,NM1=N-1)
+!     *********************************************************
+!-----------------------------------------------------------------------
+!***
+!***  SEASONAL CLIMATOLOGIES OF O3 (OBTAINED FROM A PREVIOUSLY RUN
+!***  CODE WHICH INTERPOLATES O3 TO USER VERTICAL COORDINATE).
+!***  DEFINED AS 5 DEG LAT MEANS N.P.->S.P.
+!***
+      REAL, INTENT(OUT), DIMENSION(37,kte):: DDUO3N,DDO3N2,DDO3N3,DDO3N4
+
+!                        C O M M O N /SAVMEM/
+!       ...WINTER....  ...SPRING....  ...SUMMER....  ....FALL.....
+!    1  DDUO3N(37,LM), DDO3N2(37,LM), DDO3N3(37,LM), DDO3N4(37,LM)
+!          ..... K.CAMPANA   OCTOBER 1988
+!CCC  DIMENSION T41(NP2,2),O3O3(37,N,4)
+!     DIMENSION SIGL(N)
+!     *********************************************************
+      REAL ::   QI(82)
+      REAL ::   DDUO3(19,kts:kte),RO31(10,41),RO32(10,41),DUO3N(19,41)
+      REAL ::   TEMPN(19)
+      REAL ::   O3HI(10,25),O3LO1(10,16),O3LO2(10,16),O3LO3(10,16), &
+                O3LO4(10,16)
+      REAL ::   O3HI1(10,16),O3HI2(10,9),PH1(45),PH2(37),P1(48),P2(33)
+      REAL ::   O35DEG(37,kts:kte)
+      REAL ::   RSTD(81),RO3(10,41),RO3M(10,40),RBAR(kts:kte),RDATA(81), &
+                PHALF(kts:kte+1),P(81),PH(82)
+
+      INTEGER :: NKK,NK,NKP,K,L,NCASE,ITAPE,IPLACE,NKMM,NKM,KI,KK,KQ,JJ,KEN
+      REAL :: O3RD,O3TOT,O3DU
+
+      EQUIVALENCE (O3HI1(1,1),O3HI(1,1)),(O3HI2(1,1),O3HI(1,17))
+      EQUIVALENCE (PH1(1),PH(1)),(PH2(1),PH(46))
+      EQUIVALENCE (P1(1),P(1)),(P2(1),P(49))
+      DATA PH1/      0., &
+           0.1027246E-04, 0.1239831E-04, 0.1491845E-04, 0.1788053E-04, &
+           0.2135032E-04, 0.2540162E-04, 0.3011718E-04, 0.3558949E-04, &
+           0.4192172E-04, 0.4922875E-04, 0.5763817E-04, 0.6729146E-04, &
+           0.7834518E-04, 0.9097232E-04, 0.1053635E-03, 0.1217288E-03, &
+           0.1402989E-03, 0.1613270E-03, 0.1850904E-03, 0.2119495E-03, &
+           0.2423836E-03, 0.2768980E-03, 0.3160017E-03, 0.3602623E-03, &
+           0.4103126E-03, 0.4668569E-03, 0.5306792E-03, 0.6026516E-03, &
+           0.6839018E-03, 0.7759249E-03, 0.8803303E-03, 0.9987843E-03, &
+           0.1133178E-02, 0.1285955E-02, 0.1460360E-02, 0.1660001E-02, &
+           0.1888764E-02, 0.2151165E-02, 0.2452466E-02, 0.2798806E-02, &
+           0.3197345E-02, 0.3656456E-02, 0.4185934E-02, 0.4797257E-02/
+      DATA PH2/ &
+           0.5503893E-02, 0.6321654E-02, 0.7269144E-02, 0.8368272E-02, &
+           0.9644873E-02, 0.1112946E-01, 0.1285810E-01, 0.1487354E-01, &
+           0.1722643E-01, 0.1997696E-01, 0.2319670E-01, 0.2697093E-01, &
+           0.3140135E-01, 0.3660952E-01, 0.4274090E-01, 0.4996992E-01, &
+           0.5848471E-01, 0.6847525E-01, 0.8017242E-01, 0.9386772E-01, &
+           0.1099026E+00, 0.1286765E+00, 0.1506574E+00, 0.1763932E+00, &
+           0.2065253E+00, 0.2415209E+00, 0.2814823E+00, 0.3266369E+00, &
+           0.3774861E+00, 0.4345638E+00, 0.4984375E+00, 0.5697097E+00, &
+           0.6490189E+00, 0.7370409E+00, 0.8344896E+00, 0.9421190E+00, &
+           0.1000000E+01/
+      DATA P1/ &
+           0.9300000E-05, 0.1129521E-04, 0.1360915E-04, 0.1635370E-04, &
+           0.1954990E-04, 0.2331653E-04, 0.2767314E-04, 0.3277707E-04, &
+           0.3864321E-04, 0.4547839E-04, 0.5328839E-04, 0.6234301E-04, &
+           0.7263268E-04, 0.8450696E-04, 0.9793231E-04, 0.1133587E-03, &
+           0.1307170E-03, 0.1505832E-03, 0.1728373E-03, 0.1982122E-03, &
+           0.2266389E-03, 0.2592220E-03, 0.2957792E-03, 0.3376068E-03, &
+           0.3844381E-03, 0.4379281E-03, 0.4976965E-03, 0.5658476E-03, &
+           0.6418494E-03, 0.7287094E-03, 0.8261995E-03, 0.9380076E-03, &
+           0.1063498E-02, 0.1207423E-02, 0.1369594E-02, 0.1557141E-02, &
+           0.1769657E-02, 0.2015887E-02, 0.2295520E-02, 0.2620143E-02, &
+           0.2989651E-02, 0.3419469E-02, 0.3909867E-02, 0.4481491E-02, &
+           0.5135272E-02, 0.5898971E-02, 0.6774619E-02, 0.7799763E-02/
+      DATA P2/ &
+           0.8978218E-02, 0.1036103E-01, 0.1195488E-01, 0.1382957E-01, &
+           0.1599631E-01, 0.1855114E-01, 0.2151235E-01, 0.2501293E-01, &
+           0.2908220E-01, 0.3390544E-01, 0.3952926E-01, 0.4621349E-01, &
+           0.5403168E-01, 0.6330472E-01, 0.7406807E-01, 0.8677983E-01, &
+           0.1015345E+00, 0.1189603E+00, 0.1391863E+00, 0.1630739E+00, &
+           0.1908004E+00, 0.2235461E+00, 0.2609410E+00, 0.3036404E+00, &
+           0.3513750E+00, 0.4055375E+00, 0.4656677E+00, 0.5335132E+00, &
+           0.6083618E+00, 0.6923932E+00, 0.7845676E+00, 0.8875882E+00, &
+           0.1000000E+01/
+      DATA O3HI1/ &
+       .55,.50,.45,.45,.40,.35,.35,.30,.30,.30, &
+       .55,.51,.46,.47,.42,.38,.37,.36,.35,.35, &
+       .55,.53,.48,.49,.44,.42,.41,.40,.38,.38, &
+       .60,.55,.52,.52,.50,.47,.46,.44,.42,.41, &
+       .65,.60,.55,.56,.53,.52,.50,.48,.45,.45, &
+       .75,.65,.60,.60,.55,.55,.55,.50,.48,.47, &
+       .80,.75,.75,.75,.70,.70,.65,.63,.60,.60, &
+       .90,.85,.85,.80,.80,.75,.75,.74,.72,.71, &
+       1.10,1.05,1.00,.90,.90,.90,.85,.83,.80,.80, &
+       1.40,1.30,1.25,1.25,1.25,1.20,1.15,1.10,1.05,1.00, &
+       1.7,1.7,1.6,1.6,1.6,1.6,1.6,1.6,1.5,1.5, &
+       2.1,2.0,1.9,1.9,1.9,1.8,1.8,1.8,1.7,1.7, &
+       2.4,2.3,2.2,2.2,2.2,2.1,2.1,2.1,2.0,2.0, &
+       2.7,2.5,2.5,2.5,2.5,2.5,2.4,2.4,2.3,2.3, &
+       2.9,2.8,2.7,2.7,2.7,2.7,2.7,2.7,2.6,2.6, &
+       3.1,3.1,3.0,3.0,3.0,3.0,3.0,3.0,2.9,2.8/
+      DATA O3HI2/ &
+       3.3,3.4,3.4,3.6,3.7,3.9,4.0,4.1,4.0,3.8, &
+       3.6,3.8,3.9,4.2,4.7,5.3,5.6,5.7,5.5,5.2, &
+       4.1,4.3,4.7,5.2,6.0,6.7,7.0,6.8,6.4,6.2, &
+       5.4,5.7,6.0,6.6,7.3,8.0,8.4,7.7,7.1,6.7, &
+       6.7,6.8,7.0,7.6,8.3,10.0,9.6,8.2,7.5,7.2, &
+       9.2,9.3,9.4,9.6,10.3,10.6,10.0,8.5,7.7,7.3, &
+       12.6,12.1,12.0,12.1,11.7,11.0,10.0,8.6,7.8,7.4, &
+       14.2,13.5,13.1,12.8,11.9,10.9,9.8,8.5,7.8,7.5, &
+       14.3,14.0,13.4,12.7,11.6,10.6,9.3,8.4,7.6,7.3/
+      DATA O3LO1/ &
+       14.9,14.2,13.3,12.5,11.2,10.3,9.5,8.6,7.5,7.4, &
+       14.5,14.1,13.0,11.8,10.5,9.8,9.2,7.9,7.4,7.4, &
+       11.8,11.5,10.9,10.5,9.9,9.6,8.9,7.5,7.2,7.2, &
+       7.3,7.7,7.8,8.4,8.4,8.5,7.9,7.4,7.1,7.1, &
+       4.1,4.4,5.3,6.6,6.9,7.5,7.4,7.2,7.0,6.9, &
+       1.8,1.9,2.5,3.3,4.5,5.8,6.3,6.3,6.4,6.1, &
+       0.4,0.5,0.8,1.2,2.7,3.6,4.6,4.7,5.0,5.2, &
+       .10,.15,.20,.50,1.4,2.1,3.0,3.2,3.5,3.9, &
+       .07,.10,.12,.30,1.0,1.4,1.8,1.9,2.3,2.5, &
+       .06,.08,.10,.15,.60,.80,1.4,1.5,1.5,1.6, &
+       .05,.05,.06,.09,.20,.40,.70,.80,.90,.90, &
+       .05,.05,.06,.08,.10,.13,.20,.25,.30,.40, &
+       .05,.05,.05,.06,.07,.07,.08,.09,.10,.13, &
+       .05,.05,.05,.05,.06,.06,.06,.06,.07,.07, &
+       .05,.05,.05,.05,.05,.05,.05,.06,.06,.06, &
+       .04,.04,.04,.04,.04,.04,.04,.05,.05,.05/
+      DATA O3LO2/ &
+       14.8,14.2,13.8,12.2,11.0,9.8,8.5,7.8,7.4,6.9, &
+       13.2,13.0,12.5,11.3,10.4,9.0,7.8,7.5,7.0,6.6, &
+       10.6,10.6,10.7,10.1,9.4,8.6,7.5,7.0,6.5,6.1, &
+       7.0,7.3,7.5,7.5,7.5,7.3,6.7,6.4,6.0,5.8, &
+       3.8,4.0,4.7,5.0,5.2,5.9,5.8,5.6,5.5,5.5, &
+       1.4,1.6,2.4,3.0,3.7,4.1,4.6,4.8,5.1,5.0, &
+       .40,.50,.90,1.2,2.0,2.7,3.2,3.6,4.3,4.1, &
+       .07,.10,.20,.30,.80,1.4,2.1,2.4,2.7,3.0, &
+       .06,.07,.09,.15,.30,.70,1.2,1.4,1.6,2.0, &
+       .05,.05,.06,.12,.15,.30,.60,.70,.80,.80, &
+       .04,.05,.06,.08,.09,.15,.30,.40,.40,.40, &
+       .04,.04,.05,.055,.06,.09,.12,.13,.15,.15, &
+       .03,.03,.045,.052,.055,.06,.07,.07,.06,.07, &
+       .03,.03,.04,.051,.052,.052,.06,.06,.05,.05, &
+       .02,.02,.03,.05,.05,.05,.04,.04,.04,.04, &
+       .02,.02,.02,.04,.04,.04,.03,.03,.03,.03/
+      DATA O3LO3/ &
+       14.5,14.0,13.5,11.3,11.0,10.0,9.0,8.3,7.5,7.3, &
+       13.5,13.2,12.5,11.1,10.4,9.7,8.2,7.8,7.4,6.8, &
+       10.8,10.9,11.0,10.4,10.0,9.6,7.9,7.5,7.0,6.7, &
+       7.3,7.5,7.8,8.5,9.0,8.5,7.7,7.4,6.9,6.5, &
+       4.1,4.5,5.3,6.2,7.3,7.7,7.3,7.0,6.6,6.4, &
+       1.8,2.0,2.2,3.8,4.3,5.6,6.2,6.2,6.4,6.2, &
+       .30,.50,.60,1.5,2.8,3.7,4.5,4.7,5.5,5.6, &
+       .09,.10,.15,.60,1.2,2.1,3.0,3.5,4.0,4.3, &
+       .06,.08,.10,.30,.60,1.1,1.9,2.2,2.9,3.0, &
+       .04,.05,.06,.15,.45,.60,1.1,1.3,1.6,1.8, &
+       .04,.04,.04,.08,.20,.30,.55,.60,.75,.90, &
+       .04,.04,.04,.05,.06,.10,.12,.15,.20,.25, &
+       .04,.04,.03,.04,.05,.06,.07,.07,.07,.08, &
+       .03,.03,.04,.05,.05,.05,.05,.05,.05,.05, &
+       .03,.03,.03,.04,.04,.04,.05,.05,.04,.04, &
+       .02,.02,.02,.04,.04,.04,.04,.04,.03,.03/
+      DATA O3LO4/ &
+       14.2,13.8,13.2,12.5,11.7,10.5,8.6,7.8,7.5,6.6, &
+       12.5,12.4,12.2,11.7,10.8,9.8,7.8,7.2,6.5,6.1, &
+       10.6,10.5,10.4,10.1,9.6,9.0,7.1,6.8,6.1,5.9, &
+       7.0,7.4,7.9,7.8,7.6,7.3,6.2,6.1,5.8,5.6, &
+       4.2,4.6,5.1,5.6,5.9,5.9,5.9,5.8,5.6,5.3, &
+       2.1,2.3,2.6,2.9,3.5,4.3,4.8,4.9,5.1,5.1, &
+       0.7,0.8,1.0,1.5,2.0,2.8,3.5,3.6,3.7,4.0, &
+       .15,.20,.40,.50,.60,1.4,2.1,2.2,2.3,2.5, &
+       .08,.10,.15,.25,.30,.90,1.2,1.3,1.4,1.6, &
+       .07,.08,.10,.14,.20,.50,.70,.90,.90,.80, &
+       .05,.06,.08,.12,.14,.20,.35,.40,.60,.50, &
+       .05,.05,.08,.09,.09,.09,.11,.12,.15,.18, &
+       .04,.05,.06,.07,.07,.08,.08,.08,.08,.08, &
+       .04,.04,.05,.07,.07,.07,.07,.07,.06,.05, &
+       .02,.02,.04,.05,.05,.05,.05,.05,.04,.04, &
+       .02,.02,.03,.04,.04,.04,.04,.04,.03,.03/
+
+!!!!!
+!     PSS=101325.
+!     PDIF=PSS-PT
+!
+!     DO L=1,LM1
+!       PHALF(L+1)=AETA(L)*PDIF+PT
+!     ENDDO
+!
+!     PHALF(1)=0.
+!     PHALF(LP1)=PSS
+!!!!
+      N=kte;NP=N+1;NP2=N+2;NM1=N-1
+
+      NKK=41
+      NK=81
+      NKP=NK+1
+      DO 24 K=1,NP
+!  24 PHALF(K)=PHALF(K)*1.0E 03
+   24 PHALF(K)=PHALF(K)*0.01*1.0E+03
+!  24 PSTD(K)=PSTD(K+1)*1.0E 03
+      DO 25 K=1,NK
+      PH(K)=PH(K)*1013250.
+   25 P(K)=P(K)*1013250.
+      PH(NKP)=PH(NKP)*1013250.
+!KAC  WRITE (6,3) PH
+!KAC  WRITE (6,3) P
+!     WRITE (6,3) (PHALF(K),K=1,NP)
+!     WRITE (6,3) (PSTD(K),K=1,NP)
+!***LOAD ARRAYS RO31,RO32,AS IN DICKS PGM.
+      DO 1010 K=1,25
+      DO 1010 L=1,10
+        RO31(L,K)=O3HI(L,K)
+        RO32(L,K)=O3HI(L,K)
+1010  CONTINUE
+!
+      DO 3000 NCASE=1,4
+      ITAPE=NCASE+50
+      IPLACE=2
+      IF (NCASE.EQ.2) IPLACE=4
+      IF (NCASE.EQ.3) IPLACE=1
+      IF (NCASE.EQ.4) IPLACE=3
+!***NCASE=1: SPRING (IN N.H.)
+!***NCASE=2: FALL   (IN N.H.)
+!***NCASE=3: WINTER (IN N.H.)
+!***NCASE=4: SUMMER (IN N.H.)
+      IF (NCASE.EQ.1.OR.NCASE.EQ.2) THEN
+         DO 1011 K=26,41
+         DO 1011 L=1,10
+           RO31(L,K)=O3LO1(L,K-25)
+           RO32(L,K)=O3LO2(L,K-25)
+1011     CONTINUE
+      ENDIF
+      IF (NCASE.EQ.3.OR.NCASE.EQ.4) THEN
+         DO 1031 K=26,41
+         DO 1031 L=1,10
+           RO31(L,K)=O3LO3(L,K-25)
+           RO32(L,K)=O3LO4(L,K-25)
+1031     CONTINUE
+      ENDIF
+      DO 30 KK=1,NKK
+      DO 31 L=1,10
+      DUO3N(L,KK)=RO31(11-L,KK)
+   31 DUO3N(L+9,KK)=RO32(L,KK)
+      DUO3N(10,KK)=.5*(RO31(1,KK)+RO32(1,KK))
+   30 CONTINUE
+!***FOR NCASE=2 OR NCASE=4,REVERSE LATITUDE ARRANGEMENT OF CORR. SEASON
+      IF (NCASE.EQ.2.OR.NCASE.EQ.4) THEN
+         DO 1024 KK=1,NKK
+         DO 1025 L=1,19
+           TEMPN(L)=DUO3N(20-L,KK)
+1025     CONTINUE
+         DO 1026 L=1,19
+           DUO3N(L,KK)=TEMPN(L)
+1026     CONTINUE
+1024     CONTINUE
+      ENDIF
+!***DUO3N NOW IS O3 PROFILE FOR APPROPRIATE SEASON,AT STD. PRESSURE
+!      LEVELS
+!KAC  WRITE (6,800) DUO3N
+!***BEGIN LATITUDE (10 DEG) LOOP
+      DO 33 L=1,19
+      DO 22 KK=1,NKK
+   22 RSTD(KK)=DUO3N(L,KK)
+      NKM=NK-1
+      NKMM=NK-3
+!     BESSELS HALF-POINT INTERPOLATION FORMULA
+      DO 60 K=4,NKMM,2
+      KI=K/2
+   60 RDATA(K)=.5*(RSTD(KI)+RSTD(KI+1))-(RSTD(KI+2)-RSTD(KI+1)-RSTD(KI)+ &
+      RSTD(KI-1))/16.
+      RDATA(2)=.5*(RSTD(2)+RSTD(1))
+      RDATA(NKM)=.5*(RSTD(NKK)+RSTD(NKK-1))
+!     PUT UNCHANGED DATA INTO NEW ARRAY
+      DO 61 K=1,NK,2
+      KQ=(K+1)/2
+   61 RDATA(K)=RSTD(KQ)
+!---NOTE TO NMC: THIS WRITE IS COMMENTED OUT TO REDUCE PRINTOUT
+!     WRITE (6,798) RDATA
+!     CALCULATE LAYER-MEAN OZONE MIXING RATIO FOR EACH MODEL LEVEL
+      DO 99 KK=1,N
+      RBAR(KK)=0.
+!     LOOP TO CALCULATE SUMS TO GET LAYER OZONE MEAN
+      DO 98 K=1,NK
+      IF(PH(K+1).LT.PHALF(KK)) GO TO 98
+      IF(PH(K).GT.PHALF(KK+1)) GO TO 98
+      IF(PH(K+1).LT.PHALF(KK+1).AND.PH(K).LT.PHALF(KK)) RBAR(KK)=RBAR(KK &
+      )+RDATA(K)*(PH(K+1)-PHALF(KK))
+      IF(PH(K+1).LT.PHALF(KK+1).AND.PH(K).GE.PHALF(KK)) RBAR(KK)=RBAR(KK &
+      )+RDATA(K)*(PH(K+1)-PH(K))
+      IF(PH(K+1).GT.PHALF(KK+1).AND.PH(K).GT.PHALF(KK)) RBAR(KK)=RBAR(KK &
+      )+RDATA(K)*(PHALF(KK+1)-PH(K))
+   98 CONTINUE
+      RBAR(KK)=RBAR(KK)/(PHALF(KK+1)-PHALF(KK))
+      IF(RBAR(KK).GT..0000) GO TO 99
+!     CODE TO COVER CASE WHEN MODEL RESOLUTION IS SO FINE THAT NO VALUE
+!     OF P(K) IN THE OZONE DATA ARRAY FALLS BETWEEN PHALF(KK+1) AND
+!     PHALF(KK).   PROCEDURE IS TO SIMPLY GRAB THE NEAREST VALUE FROM
+!     RDATA
+      DO 29 K=1,NK
+      IF(PH(K).LT.PHALF(KK).AND.PH(K+1).GE.PHALF(KK+1)) RBAR(KK)=RDATA(K)
+   29 CONTINUE
+   99 CONTINUE
+!     CALCULATE TOTAL OZONE
+      O3RD=0.
+      DO 89 KK=1,80
+   89 O3RD=O3RD+RDATA(KK)*(PH(KK+1)-PH(KK))
+      O3RD=O3RD+RDATA(81)*(P(81)-PH(81))
+      O3RD=O3RD/980.
+      O3TOT=0.
+      DO 88 KK=1,N
+   88 O3TOT=O3TOT+RBAR(KK)*(PHALF(KK+1)-PHALF(KK))
+      O3TOT=O3TOT/980.
+!     UNITS ARE MICROGRAMS/CM**2
+      O3DU=O3TOT/2.144
+!     O3DU UNITS ARE DOBSON UNITS (10**-3 ATM-CM)
+!--NOTE TO NMC: THIS IS COMMENTED OUT TO SAVE PRINTOUT
+!     WRITE (6,796) O3RD,O3TOT,O3DU
+      DO 23 KK=1,N
+   23 DDUO3(L,KK)=RBAR(KK)*.01
+   33 CONTINUE
+!***END OF LATITUDE LOOP
+!
+!***CREATE 5 DEG OZONE QUANTITIES BY LINEAR INTERPOLATION OF
+!      10 DEG VALUES
+      DO 1060 KK=1,N
+        DO 1061 L=1,19
+          O35DEG(2*L-1,KK)=DDUO3(L,KK)
+1061    CONTINUE
+        DO 1062 L=1,18
+          O35DEG(2*L,KK)=0.5*(DDUO3(L,KK)+DDUO3(L+1,KK))
+1062    CONTINUE
+1060  CONTINUE
+!***OUTPUT TO UNIT (ITAPE) THE OZONE VALUES FOR LATER USE
+!O222  ***************************************************
+!C          WRITE (66) O35DEG
+      IF (IPLACE.EQ.1) THEN
+      DO 302 JJ=1,37
+       DO 302 KEN=1,N
+        DDUO3N(JJ,KEN) = O35DEG(JJ,KEN)
+  302 CONTINUE
+      ELSE IF (IPLACE.EQ.2) THEN
+      DO 312 JJ=1,37
+       DO 312 KEN=1,N
+        DDO3N2(JJ,KEN) = O35DEG(JJ,KEN)
+  312 CONTINUE
+      ELSE IF (IPLACE.EQ.3) THEN
+      DO 322 JJ=1,37
+       DO 322 KEN=1,N
+        DDO3N3(JJ,KEN) = O35DEG(JJ,KEN)
+  322 CONTINUE
+      ELSE IF (IPLACE.EQ.4) THEN
+      DO 332 JJ=1,37
+       DO 332 KEN=1,N
+        DDO3N4(JJ,KEN) = O35DEG(JJ,KEN)
+  332 CONTINUE
+      END IF
+!O222  ***************************************************
+3000  CONTINUE
+!***END OF LOOP OVER CASES
+      RETURN
+   1  FORMAT(10F4.2)
+    2 FORMAT(10X,E14.7,1X,E14.7,1X,E14.7,1X,E14.7,1X)
+   3  FORMAT(10E12.5)
+  797 FORMAT(10F7.2)
+  799 FORMAT(19F6.4)
+  800 FORMAT(19F6.2)
+  102 FORMAT(' O3 IPLACE=',I4)
+ 1033 FORMAT(19F6.5)
+  101 FORMAT(5X,1H*,F6.5,1H,,F6.5,1H,,F6.5,1H,,F6.5,1H,,F6.5,1H,,F6.5, &
+      1H,,F6.5,1H,,F6.5,1H,,F6.5,1H,)
+      
+      END SUBROUTINE O3INT
+!----------------------------------------------------------------
+
+  SUBROUTINE CLO89(CLDFAC,CAMT,NCLDS,KBTM,KTOP                  &
+      ,          ids,ide, jds,jde, kds,kde                      &
+      ,          ims,ime, jms,jme, kms,kme                      &
+      ,          its,ite, jts,jte, kts,kte                      )
+!----------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+!----------------------------------------------------------------------
+
+!     ************************************************************
+!     *                                                          *
+!     * THIS SUBROUTINE WAS MODIFIED TO BE USED IN THE ETA MODEL *
+!     *                                                          *
+!     *                            Q. ZHAO    95-3-22            *
+!     *                                                          *
+!     ************************************************************
+
+      REAL,    INTENT(OUT),DIMENSION(its:ite,kts:kte+1,kts:kte+1) :: CLDFAC
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: CAMT
+      INTEGER, INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: KBTM,KTOP
+      INTEGER, INTENT(IN), DIMENSION(its:ite)           :: NCLDS
+
+      REAL,    DIMENSION(kts:kte+1,kts:kte+1,64) :: CLDIPT
+      REAL,    DIMENSION(kts:kte+1) :: CLDROW
+      INTEGER:: IQ,ITOP,I,J,JTOP,IR,IP,K1,K2,KB,K,KP,KT,NC
+      REAL   :: XCLD
+
+      INTEGER :: L,LP1,LP2,LP3,LM1,LM2,LM3,MYIS,MYIE
+
+    !  DIMENSION CLDIPT(LP1,LP1, 64 )
+    !  DIMENSION NCLDS(IDIM1:IDIM2),KTOP(IDIM1:IDIM2,LP1), &
+    !            KBTM(IDIM1:IDIM2,LP1)
+    !  DIMENSION CLDROW(LP1)
+    !  DIMENSION CAMT(IDIM1:IDIM2,LP1),CLDFAC(IDIM1:IDIM2,LP1,LP1)
+
+      L=kte
+      LP1=L+1;  LP2=L+2;  LP3=L+3
+      LM1=L-1;  LM2=L-2;  LM3=L-3
+      MYIS=its; MYIE=ite
+
+!
+      DO 1 IQ=MYIS,MYIE,64
+      ITOP=IQ+63
+      IF(ITOP.GT.MYIE) ITOP=MYIE
+      JTOP=ITOP-IQ+1
+      DO 11 IP=1,JTOP
+      IR=IQ+IP-1
+      IF (NCLDS(IR).EQ.0) THEN
+        DO 25 J=1,LP1
+        DO 25 I=1,LP1
+        CLDIPT(I,J,IP)=1.
+25      CONTINUE
+      ENDIF
+      IF (NCLDS(IR).GE.1) THEN
+          XCLD=1.-CAMT(IR,2)
+           K1=KTOP(IR,2)+1
+           K2=KBTM(IR,2)
+          DO 27 J=1,LP1
+              CLDROW(J)=1.
+27        CONTINUE
+          DO 29 J=1,K2
+              CLDROW(J)=XCLD
+29        CONTINUE
+          KB=MAX(K1,K2+1)
+          DO 33 K=KB,LP1
+          DO 33 KP=1,LP1
+               CLDIPT(KP,K,IP)=CLDROW(KP)
+33        CONTINUE
+          DO 37 J=1,LP1
+              CLDROW(J)=1.
+37        CONTINUE
+          DO 39 J=K1,LP1
+              CLDROW(J)=XCLD
+39        CONTINUE
+          KT=MIN(K1-1,K2)
+          DO 43 K=1,KT
+          DO 43 KP=1,LP1
+              CLDIPT(KP,K,IP)=CLDROW(KP)
+43        CONTINUE
+          IF(K2+1.LE.K1-1) THEN
+            DO 31 J=K2+1,K1-1
+            DO 31 I=1,LP1
+                CLDIPT(I,J,IP)=1.
+31          CONTINUE
+          ELSE IF(K1.LE.K2) THEN
+            DO 32 J=K1,K2
+            DO 32 I=1,LP1
+                CLDIPT(I,J,IP)=XCLD
+32          CONTINUE
+          ENDIF
+      ENDIF
+
+      IF (NCLDS(IR).GE.2) THEN
+        DO 21 NC=2,NCLDS(IR)
+          XCLD=1.-CAMT(IR,NC+1)
+           K1=KTOP(IR,NC+1)+1
+           K2=KBTM(IR,NC+1)
+          DO 47 J=1,LP1
+              CLDROW(J)=1.
+47        CONTINUE
+          DO 49 J=1,K2
+              CLDROW(J)=XCLD
+49        CONTINUE
+          KB=MAX(K1,K2+1)
+          DO 53 K=KB,LP1
+          DO 53 KP=1,LP1
+               CLDIPT(KP,K,IP)=CLDIPT(KP,K,IP)*CLDROW(KP)
+53        CONTINUE
+          DO 57 J=1,LP1
+              CLDROW(J)=1.
+57        CONTINUE
+          DO 59 J=K1,LP1
+              CLDROW(J)=XCLD
+59        CONTINUE
+          KT=MIN(K1-1,K2)
+          DO 63 K=1,KT
+          DO 63 KP=1,LP1
+              CLDIPT(KP,K,IP)=CLDIPT(KP,K,IP)*CLDROW(KP)
+63        CONTINUE
+          IF(K1.LE.K2) THEN
+            DO 52 J=K1,K2
+            DO 52 I=1,LP1
+                CLDIPT(I,J,IP)=CLDIPT(I,J,IP)*XCLD
+52          CONTINUE
+          ENDIF
+21        CONTINUE
+      ENDIF
+11    CONTINUE
+      DO 71 J=1,LP1
+      DO 71 I=1,LP1
+      DO 71 IP=1,JTOP
+      IR=IQ+IP-1
+      CLDFAC(IR,I,J)=CLDIPT(I,J,IP)
+71    CONTINUE
+1     CONTINUE
+
+  END SUBROUTINE CLO89
+!----------------------------------------------------------------
+!     SUBROUTINE LWR88(HEATRA,GRNFLX,TOPFLX,                         &
+!                      PRESS,TEMP,RH2O,QO3,CLDFAC,                   &
+!                      CAMT,NCLDS,KTOP,KBTM,                         &
+!!                     BO3RND,AO3RND,T1,T2,T4,EM1V,EM1VW,EM3V,       &
+!                      BO3RND,AO3RND, &
+!                      APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+!                      ZERO,ONE,H18E3,P0INV,H6P08108,DIFFCTR,        &
+!                      GINV,H3M4,BETINW,RATH2OMW,GP0INV,P0,P0XZP8,   &
+!                      P0XZP2,H3M3,H1M3,H1M2,H25E2,B0,B2,B1,B3,HAF,  &
+!                      TEN,HP1,FOUR,HM1EZ,SKO3R,                     &
+!                      AB15WD,SKC1R,RADCON,QUARTR,TWO,               &
+!                      HM6666M2,HMP66667,HMP5, HP166666,H41666M2,    &
+!                      RADCON1,H16E1, H28E1,H44194M2,H1P41819,SKO2D, &
+!                      ids,ide, jds,jde, kds,kde,                    &
+!                      ims,ime, jms,jme, kms,kme,                    &
+!                      its,ite, jts,jte, kts,kte                     )
+
+      SUBROUTINE LWR88(HEATRA,GRNFLX,TOPFLX,                         &
+                       PRESS,TEMP,RH2O,QO3,CLDFAC,                   &
+                       CAMT,NCLDS,KTOP,KBTM,                         &
+!                      BO3RND,AO3RND,T1,T2,T4,EM1V,EM1VW,EM3V,       &
+                       BO3RND,AO3RND, &
+                       APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+                       ZERO,ONE,H18E3,P0INV,H6P08108,DIFFCTR,        &
+                       GINV,H3M4,BETINW,RATH2OMW,GP0INV,P0,P0XZP8,   &
+                       P0XZP2,H3M3,H1M3,H1M2,H25E2,B0,B2,B1,B3,HAF,  &
+                       TEN,HP1,FOUR,HM1EZ,                           &
+                       RADCON,QUARTR,TWO,                            &
+                       HM6666M2,HMP66667,HMP5, HP166666,H41666M2,    &
+                       RADCON1,H16E1, H28E1,H44194M2,H1P41819,       &
+                       ids,ide, jds,jde, kds,kde,                    &
+                       ims,ime, jms,jme, kms,kme,                    &
+                       its,ite, jts,jte, kts,kte                     )
+!---------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+!     INTEGER, PARAMETER :: NBLY=15
+
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte  
+      REAL,    INTENT(IN)        :: ZERO,ONE,H18E3,P0INV,H6P08108,DIFFCTR
+      REAL,    INTENT(IN)        :: GINV,H3M4,BETINW,RATH2OMW,GP0INV
+      REAL,    INTENT(IN)        :: P0XZP8,P0XZP2,H3M3,P0,H1M3
+      REAL,    INTENT(IN)        :: H1M2,H25E2,B0,B1,B2,B3,HAF
+!     REAL,    INTENT(IN)        :: TEN,HP1,FOUR,HM1EZ,SKO3R
+      REAL,    INTENT(IN)        :: TEN,HP1,FOUR,HM1EZ         
+!     REAL,    INTENT(IN)        :: AB15WD,SKC1R,RADCON,QUARTR,TWO
+      REAL,    INTENT(IN)        :: RADCON,QUARTR,TWO
+      REAL,    INTENT(IN)        :: HM6666M2,HMP66667,HMP5, HP166666,H41666M2
+!     REAL,    INTENT(IN) :: RADCON1,H16E1, H28E1,H44194M2,H1P41819,SKO2D
+      REAL,    INTENT(IN) :: RADCON1,H16E1, H28E1,H44194M2,H1P41819
+!----------------------------------------------------------------------
+      REAL, INTENT(IN), DIMENSION(3) :: BO3RND,AO3RND
+!     REAL,INTENT(IN),DIMENSION(5040):: T1,T2,T4,EM1V,EM1VW
+!     REAL, INTENT(IN), DIMENSION(5040) :: EM3V
+      REAL,INTENT(IN),DIMENSION(NBLY) :: APCM,BPCM,ATPCM,BTPCM,ACOMB, &
+                                         BCOMB,BETACM
+
+      REAL,    INTENT(IN),DIMENSION(its:ite,kts:kte+1,kts:kte+1) :: CLDFAC
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: CAMT
+      INTEGER, INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: KBTM,KTOP
+      INTEGER, INTENT(IN), DIMENSION(its:ite)           :: NCLDS
+     
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: PRESS,TEMP
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte)   :: RH2O,QO3
+      REAL,    INTENT(OUT), DIMENSION(its:ite,kts:kte)   :: HEATRA
+      REAL,    INTENT(OUT), DIMENSION(its:ite)           :: GRNFLX,TOPFLX
+
+!     REAL,    DIMENSION(kts:kte+1,kts:kte+1,64) :: CLDIPT
+
+!     Include co2 data from a file, which needs to have exactly vertical
+!     dimension of the model.
+      
+
+!!! ??? co2 table
+!     REAL,    DIMENSION(kts:kte+1,kts:kte+1) :: CO251,CDT51,CDT58,C2D51,&
+!                                                C2D58,CO258
+!     REAL,    DIMENSION(kts:kte+1)           :: STEMP,GTEMP,CO231,CO238, &
+!                                                C2D31,C2D38,CDT31,CDT38, &
+!                                                CO271,CO278,C2D71,C2D78, &
+!                                                CDT71,CDT78
+!     REAL,    DIMENSION(kts:kte)             :: CO2M51,CO2M58,CDTM51,CDTM58, &
+!                                                C2DM51,C2DM58
+!!! end co2 table
+
+!     REAL,    DIMENSION(kts:kte+1) :: CLDROW
+
+      REAL,    DIMENSION(its:ite,kts:kte+1) :: TEXPSL,TOTPHI,TOTO3,CNTVAL,&
+                                               TPHIO3,TOTVO2,TSTDAV,TDAV, & 
+                                               VSUM3,CO2R1,D2CD21,DCO2D1, &
+                                               CO2R2,D2CD22,DCO2D2,CO2SP1,&
+                                               CO2SP2,CO2R,DCO2DT,D2CDT2, &
+                                               TLSQU,DIFT
+      REAL,    DIMENSION(its:ite,kts:kte)   :: DELP2,DELP,CO2NBL,&
+                                               QH2O,VV,VAR1,VAR2,VAR3,VAR4
+      REAL,    DIMENSION(its:ite,kts:kte+1) :: P,T
+      REAL,    DIMENSION(its:ite,kts:kte)   :: CO2MR,CO2MD,CO2M2D
+      REAL,    DIMENSION(its:ite,kts:kte*2+1):: EMPL
+
+      REAL,    DIMENSION(its:ite)           :: EMX1,EMX2,VSUM1,VSUM2,A1,A2 
+      REAL,    DIMENSION(its:ite,kts:kte+1,kts:kte+1) :: CO21
+
+   !  COMMON/CO2BD3/CO251(LP1,LP1),CO258(LP1,LP1),CDT51(LP1,LP1),
+   !  DIMENSION CO21(IDIM1:IDIM2,LP1,LP1),CO2NBL(IDIM1:IDIM2,L)
+   !  DIMENSION CO2R(IDIM1:IDIM2,LP1),DIFT(IDIM1:IDIM2,LP1)
+   ! 1   CO2M2D(IDIM1:IDIM2,L)
+   !  DIMENSION CO2MR(IDIM1:IDIM2,L),CO2MD(IDIM1:IDIM2,L),
+   ! 2 CO2M58(L),CDTM51(L),CDTM58(L),C2DM51(L),C2DM58(L),
+   ! 1 CDT58(LP1,LP1),C2D51(LP1,LP1),C2D58(LP1,LP1),CO2M51(L),
+   !  COMMON / CO2BD2 / CO231(LP1),CO238(LP1),CDT31(LP1),
+   ! 1 CDT38(LP1),C2D31(LP1),C2D38(LP1)
+   !  DIMENSION CO2R1(IDIM1:IDIM2,LP1),DCO2D1(IDIM1:IDIM2,LP1)
+   !  DIMENSION D2CD21(IDIM1:IDIM2,LP1),D2CD22(IDIM1:IDIM2,LP1)
+   ! 3 STEMP(LP1),GTEMP(LP1),B0,B1,B2,B3
+   ! 1 VV(IDIM1:IDIM2,L),VSUM3(IDIM1:IDIM2,LP1),VSUM1(IDIM1:IDIM2),
+   ! 2 VSUM2(IDIM1:IDIM2)
+   !  DIMENSION TDAV(IDIM1:IDIM2,LP1),TSTDAV(IDIM1:IDIM2,LP1),
+   !  LLP1=LL+1, LL = 2L
+   !  EMX2(IDIM1:IDIM2),EMPL(IDIM1:IDIM2,LLP1)
+   !  DIMENSION TPHIO3(IDIM1:IDIM2,LP1),
+   !  DIMENSION TEXPSL(IDIM1:IDIM2,LP1)
+   !  DIMENSION QH2O(IDIM1:IDIM2,L)
+   !  DIMENSION DELP2(IDIM1:IDIM2,L)
+   !  DIMENSION VAR1(IDIM1:IDIM2,L),VAR2(IDIM1:IDIM2,L),
+   ! 1   VAR3(IDIM1:IDIM2,L),VAR4(IDIM1:IDIM2,L)
+   ! 1 VV(IDIM1:IDIM2,L)
+   !  DIMENSION CNTVAL(IDIM1:IDIM2,LP1)
+   !  DIMENSION TOTO3(IDIM1:IDIM2,LP1)
+   !  DIMENSION EMX1(IDIM1:IDIM2),
+
+   !  DIMENSION PRESS(IDIM1:IDIM2,LP1),TEMP(IDIM1:IDIM2,LP1), &
+   !     RH2O(IDIM1:IDIM2,L),QO3(IDIM1:IDIM2,L)
+   !  DIMENSION HEATRA(IDIM1:IDIM2,L),GRNFLX(IDIM1:IDIM2),    &
+   !     TOPFLX(IDIM1:IDIM2)
+
+!
+!
+!****COMPUTE FLUX PRESSURES (P) AND DIFFERENCES (DELP2,DELP)
+!****COMPUTE FLUX LEVEL TEMPERATURES (T) AND CONTINUUM TEMPERATURE
+!    CORRECTIONS (TEXPSL)
+    
+      INTEGER :: K, I,KP
+      INTEGER :: L,LP1,LP2,LP3,LM1,LM2,LM3,MYIS,MYIE,LLP1,LL
+
+      L=kte
+      LP1=L+1;  LP2=L+2;  LP3=L+3; LLP1 = 2*L + 1
+      LM1=L-1;  LM2=L-2;  LM3=L-3; LL = 2*L
+      MYIS=its; MYIE=ite
+
+
+      DO 103 K=2,L
+      DO 103 I=MYIS,MYIE
+      P(I,K)=HAF*(PRESS(I,K-1)+PRESS(I,K))
+      T(I,K)=HAF*(TEMP(I,K-1)+TEMP(I,K))
+103   CONTINUE
+      DO 105 I=MYIS,MYIE
+      P(I,1)=ZERO
+      P(I,LP1)=PRESS(I,LP1)
+      T(I,1)=TEMP(I,1)
+      T(I,LP1)=TEMP(I,LP1)
+105   CONTINUE
+      DO 107 K=1,L
+      DO 107 I=MYIS,MYIE
+      DELP2(I,K)=P(I,K+1)-P(I,K)
+      DELP(I,K)=ONE/DELP2(I,K)
+107   CONTINUE
+!****COMPUTE ARGUMENT FOR CONT.TEMP.COEFF.
+!    (THIS IS 1800.(1./TEMP-1./296.))
+      DO 125 K=1,LP1
+      DO 125 I=MYIS,MYIE
+      TEXPSL(I,K)=H18E3/TEMP(I,K)-H6P08108
+!...THEN TAKE EXPONENTIAL
+      TEXPSL(I,K)=EXP(TEXPSL(I,K))
+125   CONTINUE
+!***COMPUTE OPTICAL PATHS FOR H2O AND O3, USING THE DIFFUSIVITY
+!   APPROXIMATION FOR THE ANGULAR INTEGRATION (1.66). OBTAIN THE
+!   UNWEIGHTED VALUES(VAR1,VAR3) AND THE WEIGHTED VALUES(VAR2,VAR4).
+!   THE QUANTITIES H3M4(.0003) AND H3M3(.003) APPEARING IN THE VAR2 AND
+!   VAR4 EXPRESSIONS ARE THE APPROXIMATE VOIGT CORRECTIONS FOR H2O AND
+!   O3,RESPECTIVELY.
+!
+      DO 131 K=1,L
+      DO 131 I=MYIS,MYIE
+      QH2O(I,K)=RH2O(I,K)*DIFFCTR
+!---VV IS THE LAYER-MEAN PRESSURE (IN ATM),WHICH IS NOT THE SAME AS
+!   THE LEVEL PRESSURE (PRESS)
+      VV(I,K)=HAF*(P(I,K+1)+P(I,K))*P0INV
+      VAR1(I,K)=DELP2(I,K)*QH2O(I,K)*GINV
+      VAR3(I,K)=DELP2(I,K)*QO3(I,K)*DIFFCTR*GINV
+      VAR2(I,K)=VAR1(I,K)*(VV(I,K)+H3M4)
+      VAR4(I,K)=VAR3(I,K)*(VV(I,K)+H3M3)
+!  COMPUTE OPTICAL PATH FOR THE H2O CONTINUUM, USING ROBERTS COEFFS.
+!  (BETINW),AND TEMP. CORRECTION (TEXPSL). THE DIFFUSIVITY FACTOR
+!  (WHICH CANCELS OUT IN THIS EXPRESSION) IS ASSUMED TO BE 1.66. THE
+!  USE OF THE DIFFUSIVITY FACTOR HAS BEEN SHOWN TO BE A SIGNIFICANT
+!  SOURCE OF ERROR IN THE CONTINUUM CALCS.,BUT THE TIME PENALTY OF
+!  AN ANGULAR INTEGRATION IS SEVERE.
+!
+      CNTVAL(I,K)=TEXPSL(I,K)*RH2O(I,K)*VAR2(I,K)*BETINW/ &
+                   (RH2O(I,K)+RATH2OMW)
+131   CONTINUE
+!   COMPUTE SUMMED OPTICAL PATHS FOR H2O,O3 AND CONTINUUM
+      DO 201 I=MYIS,MYIE
+      TOTPHI(I,1)=ZERO
+      TOTO3(I,1)=ZERO
+      TPHIO3(I,1)=ZERO
+      TOTVO2(I,1)=ZERO
+201   CONTINUE
+      DO 203 K=2,LP1
+      DO 203 I=MYIS,MYIE
+      TOTPHI(I,K)=TOTPHI(I,K-1)+VAR2(I,K-1)
+      TOTO3(I,K)=TOTO3(I,K-1)+VAR3(I,K-1)
+      TPHIO3(I,K)=TPHIO3(I,K-1)+VAR4(I,K-1)
+      TOTVO2(I,K)=TOTVO2(I,K-1)+CNTVAL(I,K-1)
+203   CONTINUE
+!---EMX1 IS THE ADDITIONAL PRESSURE-SCALED MASS FROM PRESS(L) TO
+!   P(L). IT IS USED IN NEARBY LAYER AND EMISS CALCULATIONS.
+!---EMX2 IS THE ADDITIONAL PRESSURE-SCALED MASS FROM PRESS(L) TO
+!   P(LP1). IT IS USED IN CALCULATIONS BETWEEN FLUX LEVELS L AND LP1.
+!
+      DO 801 I=MYIS,MYIE
+      EMX1(I)=QH2O(I,L)*PRESS(I,L)*(PRESS(I,L)-P(I,L))*GP0INV
+      EMX2(I)=QH2O(I,L)*PRESS(I,L)*(P(I,LP1)-PRESS(I,L))*GP0INV
+801   CONTINUE
+!---EMPL IS THE PRESSURE SCALED MASS FROM P(K) TO PRESS(K) (INDEX 2-LP1)
+!   OR TO PRESS(K+1) (INDEX LP2-LL)
+      DO 811 K=1,L
+      DO 811 I=MYIS,MYIE
+      EMPL(I,K+1)=QH2O(I,K)*P(I,K+1)*(P(I,K+1)-PRESS(I,K))*GP0INV
+811   CONTINUE
+      DO 812 K=1,LM1
+      DO 812 I=MYIS,MYIE
+      EMPL(I,LP2+K-1)=QH2O(I,K+1)*P(I,K+1)*(PRESS(I,K+1)-P(I,K+1)) &
+                     *GP0INV
+812   CONTINUE
+      DO 821 I=MYIS,MYIE
+      EMPL(I,1)=VAR2(I,L)
+      EMPL(I,LLP1)=EMPL(I,LL)
+821   CONTINUE
+!***COMPUTE WEIGHTED TEMPERATURE (TDAV) AND PRESSURE (TSTDAV) INTEGRALS
+!   FOR USE IN OBTAINING TEMP. DIFFERENCE BET. SOUNDING AND STD.
+!   TEMP. SOUNDING (DIFT)
+      DO 161 I=MYIS,MYIE
+      TSTDAV(I,1)=ZERO
+      TDAV(I,1)=ZERO
+161   CONTINUE
+      DO 162 K=1,LP1
+      DO 162 I=MYIS,MYIE
+      VSUM3(I,K)=TEMP(I,K)-STEMP(K)
+162   CONTINUE
+      DO 163 K=1,L
+      DO 165 I=MYIS,MYIE
+      VSUM2(I)=GTEMP(K)*DELP2(I,K)
+      VSUM1(I)=VSUM2(I)*VSUM3(I,K)
+      TSTDAV(I,K+1)=TSTDAV(I,K)+VSUM2(I)
+      TDAV(I,K+1)=TDAV(I,K)+VSUM1(I)
+165   CONTINUE
+163   CONTINUE
+!
+!****EVALUATE COEFFICIENTS FOR CO2 PRESSURE INTERPOLATION (A1,A2)
+      DO 171 I=MYIS,MYIE
+      A1(I)=(PRESS(I,LP1)-P0XZP8)/P0XZP2
+      A2(I)=(P0-PRESS(I,LP1))/P0XZP2
+171   CONTINUE
+!***PERFORM CO2 PRESSURE INTERPOLATION ON ALL INPUTTED TRANSMISSION
+!   FUNCTIONS AND TEMP. DERIVATIVES
+!---SUCCESSIVELY COMPUTING CO2R,DCO2DT AND D2CDT2 IS DONE TO SAVE
+!   STORAGE (AT A SLIGHT LOSS IN COMPUTATION TIME)
+      DO 184 K=1,LP1
+      DO 184 I=MYIS,MYIE
+        CO2R1(I,K)=A1(I)*CO231(K)+A2(I)*CO238(K)
+        D2CD21(I,K)=H1M3*(A1(I)*C2D31(K)+A2(I)*C2D38(K))
+        DCO2D1(I,K)=H1M2*(A1(I)*CDT31(K)+A2(I)*CDT38(K))
+        CO2R2(I,K)=A1(I)*CO271(K)+A2(I)*CO278(K)
+        D2CD22(I,K)=H1M3*(A1(I)*C2D71(K)+A2(I)*C2D78(K))
+        DCO2D2(I,K)=H1M2*(A1(I)*CDT71(K)+A2(I)*CDT78(K))
+184   CONTINUE
+      DO 190 K=1,L
+      DO 190 I=MYIS,MYIE
+        CO2MR(I,K)=A1(I)*CO2M51(K)+A2(I)*CO2M58(K)
+        CO2MD(I,K)=H1M2*(A1(I)*CDTM51(K)+A2(I)*CDTM58(K))
+        CO2M2D(I,K)=H1M3*(A1(I)*C2DM51(K)+A2(I)*C2DM58(K))
+190   CONTINUE
+!***COMPUTE CO2 TEMPERATURE INTERPOLATIONS FOR ALL BANDS,USING DIFT
+!
+!   THE CASE WHERE K=1 IS HANDLED FIRST. WE ARE NOW REPLACING
+!   3-DIMENSIONAL ARRAYS BY 2-D ARRAYS, TO SAVE SPACE. THUS THIS
+!   CALCULATION IS FOR (I,KP,1)
+      DO 211 KP=2,LP1
+      DO 211 I=MYIS,MYIE
+      DIFT(I,KP)=TDAV(I,KP)/TSTDAV(I,KP)
+211   CONTINUE
+      DO 212 I=MYIS,MYIE
+      CO21(I,1,1)=1.0
+      CO2SP1(I,1)=1.0
+      CO2SP2(I,1)=1.0
+212   CONTINUE
+      DO 215 KP=2,LP1
+      DO 215 I=MYIS,MYIE
+!---CALCULATIONS FOR KP>1 FOR K=1
+      CO2R(I,KP)=A1(I)*CO251(KP,1)+A2(I)*CO258(KP,1)
+      DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(KP,1)+A2(I)*CDT58(KP,1))
+      D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(KP,1)+A2(I)*C2D58(KP,1))
+      CO21(I,KP,1)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+ &
+                   HAF*DIFT(I,KP)*D2CDT2(I,KP))
+!---CALCULATIONS FOR (EFFECTIVELY) KP=1,K>KP. THESE USE THE
+!   SAME VALUE OF DIFT DUE TO SYMMETRY
+      CO2R(I,KP)=A1(I)*CO251(1,KP)+A2(I)*CO258(1,KP)
+      DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(1,KP)+A2(I)*CDT58(1,KP))
+      D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(1,KP)+A2(I)*C2D58(1,KP))
+      CO21(I,1,KP)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+ &
+                   HAF*DIFT(I,KP)*D2CDT2(I,KP))
+215   CONTINUE
+!   THE TRANSMISSION FUNCTIONS USED IN SPA88 MAY BE COMPUTED NOW.
+!---(IN THE 250 LOOP,DIFT REALLY SHOULD BE (I,1,K), BUT DIFT IS
+!    INVARIANT WITH RESPECT TO K,KP,AND SO (I,1,K)=(I,K,1))
+      DO 250 K=2,LP1
+      DO 250 I=MYIS,MYIE
+      CO2SP1(I,K)=CO2R1(I,K)+DIFT(I,K)*(DCO2D1(I,K)+HAF*DIFT(I,K)* &
+       D2CD21(I,K))
+      CO2SP2(I,K)=CO2R2(I,K)+DIFT(I,K)*(DCO2D2(I,K)+HAF*DIFT(I,K)* &
+       D2CD22(I,K))
+250   CONTINUE
+!
+!   NEXT THE CASE WHEN K=2...L
+      DO 220 K=2,L
+      DO 222 KP=K+1,LP1
+      DO 222 I=MYIS,MYIE
+      DIFT(I,KP)=(TDAV(I,KP)-TDAV(I,K))/ &
+                    (TSTDAV(I,KP)-TSTDAV(I,K))
+      CO2R(I,KP)=A1(I)*CO251(KP,K)+A2(I)*CO258(KP,K)
+      DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(KP,K)+A2(I)*CDT58(KP,K))
+      D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(KP,K)+A2(I)*C2D58(KP,K))
+      CO21(I,KP,K)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+ &
+                   HAF*DIFT(I,KP)*D2CDT2(I,KP))
+      CO2R(I,KP)=A1(I)*CO251(K,KP)+A2(I)*CO258(K,KP)
+      DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(K,KP)+A2(I)*CDT58(K,KP))
+      D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(K,KP)+A2(I)*C2D58(K,KP))
+      CO21(I,K,KP)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+ &
+                   HAF*DIFT(I,KP)*D2CDT2(I,KP))
+222   CONTINUE
+220   CONTINUE
+!   FINALLY THE CASE WHEN K=KP,K=2..LP1
+      DO 206 K=2,LP1
+      DO 206 I=MYIS,MYIE
+      DIFT(I,K)=HAF*(VSUM3(I,K)+VSUM3(I,K-1))
+      CO2R(I,K)=A1(I)*CO251(K,K)+A2(I)*CO258(K,K)
+      DCO2DT(I,K)=H1M2*(A1(I)*CDT51(K,K)+A2(I)*CDT58(K,K))
+      D2CDT2(I,K)=H1M3*(A1(I)*C2D51(K,K)+A2(I)*C2D58(K,K))
+      CO21(I,K,K)=CO2R(I,K)+DIFT(I,K)*(DCO2DT(I,K)+ &
+                   HAF*DIFT(I,K)*D2CDT2(I,K))
+206   CONTINUE
+!--- WE AREN'T DOING NBL TFS ON THE 100 CM-1 BANDS .
+      DO 260 K=1,L
+      DO 260 I=MYIS,MYIE
+      CO2NBL(I,K)=CO2MR(I,K)+VSUM3(I,K)*(CO2MD(I,K)+HAF* &
+       VSUM3(I,K)*CO2M2D(I,K))
+260   CONTINUE
+!***COMPUTE TEMP. COEFFICIENT BASED ON T(K) (SEE REF.2)
+      DO 264 K=1,LP1
+      DO 264 I=MYIS,MYIE
+      IF (T(I,K).LE.H25E2) THEN
+         TLSQU(I,K)=B0+(T(I,K)-H25E2)* &
+                            (B1+(T(I,K)-H25E2)* &
+                         (B2+B3*(T(I,K)-H25E2)))
+      ELSE
+         TLSQU(I,K)=B0
+      ENDIF
+264   CONTINUE
+!***APPLY TO ALL CO2 TFS
+      DO 280 K=1,LP1
+      DO 282 KP=1,LP1
+      DO 282 I=MYIS,MYIE
+      CO21(I,KP,K)=CO21(I,KP,K)*(ONE-TLSQU(I,KP))+TLSQU(I,KP)
+282   CONTINUE
+280   CONTINUE
+      DO 284 K=1,LP1
+      DO 286 I=MYIS,MYIE
+      CO2SP1(I,K)=CO2SP1(I,K)*(ONE-TLSQU(I,1))+TLSQU(I,1)
+      CO2SP2(I,K)=CO2SP2(I,K)*(ONE-TLSQU(I,1))+TLSQU(I,1)
+286   CONTINUE
+284   CONTINUE
+      DO 288 K=1,L
+      DO 290 I=MYIS,MYIE
+      CO2NBL(I,K)=CO2NBL(I,K)*(ONE-TLSQU(I,K))+TLSQU(I,K)
+290   CONTINUE
+288   CONTINUE
+!     CALL FST88(HEATRA,GRNFLX,TOPFLX, &
+!                QH2O,PRESS,P,DELP,DELP2,TEMP,T, &
+!                CLDFAC,NCLDS,KTOP,KBTM,CAMT, &
+!                CO21,CO2NBL,CO2SP1,CO2SP2, &
+!                VAR1,VAR2,VAR3,VAR4,CNTVAL, &
+!                TOTO3,TPHIO3,TOTPHI,TOTVO2, &
+!                EMX1,EMX2,EMPL, &
+!
+!                BO3RND,AO3RND, &
+!!               T1,T2,T4 , EM1V,EM1VW, EM3V, &
+!                APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+!                TEN,HP1,HAF,ONE,FOUR,HM1EZ,SKO3R, &
+!                AB15WD,SKC1R,RADCON,QUARTR,TWO, &
+!                HM6666M2,HMP66667,HMP5, &
+!                HP166666,H41666M2,RADCON1, &
+!                H16E1, H28E1, H25E2, H44194M2,H1P41819, &
+!                SKO2D,                                        &
+!                ids,ide, jds,jde, kds,kde,                    &
+!                ims,ime, jms,jme, kms,kme,                    &
+!                its,ite, jts,jte, kts,kte                     )
+
+      CALL FST88(HEATRA,GRNFLX,TOPFLX, &
+                 QH2O,PRESS,P,DELP,DELP2,TEMP,T, &
+                 CLDFAC,NCLDS,KTOP,KBTM,CAMT, &
+                 CO21,CO2NBL,CO2SP1,CO2SP2, &
+                 VAR1,VAR2,VAR3,VAR4,CNTVAL, &
+                 TOTO3,TPHIO3,TOTPHI,TOTVO2, &
+                 EMX1,EMX2,EMPL, &
+!
+                 BO3RND,AO3RND, &
+!                T1,T2,T4 , EM1V,EM1VW, EM3V, &
+                 APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+                 TEN,HP1,HAF,ONE,FOUR,HM1EZ,       &
+                 RADCON,QUARTR,TWO,  &
+                 HM6666M2,HMP66667,HMP5, &
+                 HP166666,H41666M2,RADCON1, &
+                 H16E1, H28E1, H25E2, H44194M2,H1P41819, &
+                 ids,ide, jds,jde, kds,kde,                    &
+                 ims,ime, jms,jme, kms,kme,                    &
+                 its,ite, jts,jte, kts,kte                     )
+
+  END SUBROUTINE LWR88
+!---------------------------------------------------------------------
+! SUBROUTINE FST88(HEATRA,GRNFLX,TOPFLX, &
+!                      QH2O,PRESS,P,DELP,DELP2,TEMP,T, &
+!                      CLDFAC,NCLDS,KTOP,KBTM,CAMT, &
+!                      CO21,CO2NBL,CO2SP1,CO2SP2, &
+!                      VAR1,VAR2,VAR3,VAR4,CNTVAL, &
+!                      TOTO3,TPHIO3,TOTPHI,TOTVO2, &
+!                      EMX1,EMX2,EMPL, &
+!                      BO3RND,AO3RND, &
+!!                     T1,T2,T4 , EM1V,EM1VW, EM3V, &
+!                      APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+!                      TEN,HP1,HAF,ONE,FOUR,HM1EZ,SKO3R, &
+!                      AB15WD,SKC1R,RADCON,QUARTR,TWO, &
+!                      HM6666M2,HMP66667,HMP5, &
+!                      HP166666,H41666M2,RADCON1, &
+!                      H16E1, H28E1, H25E2, H44194M2,H1P41819, &
+!                      SKO2D,                                        &
+!                      ids,ide, jds,jde, kds,kde,                    &
+!                      ims,ime, jms,jme, kms,kme,                    &
+!                      its,ite, jts,jte, kts,kte                     )
+
+  SUBROUTINE FST88(HEATRA,GRNFLX,TOPFLX, &
+                       QH2O,PRESS,P,DELP,DELP2,TEMP,T, &
+                       CLDFAC,NCLDS,KTOP,KBTM,CAMT, &
+                       CO21,CO2NBL,CO2SP1,CO2SP2, &
+                       VAR1,VAR2,VAR3,VAR4,CNTVAL, &
+                       TOTO3,TPHIO3,TOTPHI,TOTVO2, &
+                       EMX1,EMX2,EMPL, &
+                       BO3RND,AO3RND, &
+!                      T1,T2,T4 , EM1V,EM1VW, EM3V, &
+                       APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+                       TEN,HP1,HAF,ONE,FOUR,HM1EZ,       &
+                       RADCON,QUARTR,TWO, &
+                       HM6666M2,HMP66667,HMP5, &
+                       HP166666,H41666M2,RADCON1, &
+                       H16E1, H28E1, H25E2, H44194M2,H1P41819, &
+                       ids,ide, jds,jde, kds,kde,                    &
+                       ims,ime, jms,jme, kms,kme,                    &
+                       its,ite, jts,jte, kts,kte                     )
+!---------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+!     INTEGER, PARAMETER :: NBLY=15
+
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+
+!     REAL,    INTENT(IN)        :: TEN,HP1,HAF,ONE,FOUR,HM1EZ,SKO3R
+      REAL,    INTENT(IN)        :: TEN,HP1,HAF,ONE,FOUR,HM1EZ
+!     REAL,    INTENT(IN)        :: AB15WD,SKC1R,RADCON,QUARTR,TWO
+      REAL,    INTENT(IN)        :: RADCON,QUARTR,TWO
+      REAL,    INTENT(IN)        :: HM6666M2,HMP66667,HMP5
+      REAL,    INTENT(IN)        :: HP166666,H41666M2,RADCON1,H16E1, H28E1 
+!     REAL,    INTENT(IN)        :: H25E2,H44194M2,H1P41819,SKO2D
+      REAL,    INTENT(IN)        :: H25E2,H44194M2,H1P41819
+
+      REAL,INTENT(IN),DIMENSION(NBLY) :: APCM,BPCM,ATPCM,BTPCM,ACOMB, &
+                                         BCOMB,BETACM
+
+!     REAL, INTENT(IN), DIMENSION(5040) :: T1,T2,T4,EM1V,EM1VW
+!     REAL, INTENT(IN), DIMENSION(5040) :: EM3V
+      REAL, INTENT(IN), DIMENSION(its:ite,kts:kte*2+1) :: EMPL
+      REAL, INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: TOTO3,TPHIO3,TOTPHI,CNTVAL,&
+                                                        CO2SP1,CO2SP2   
+
+      REAL,    INTENT(IN),DIMENSION(its:ite,kts:kte+1,kts:kte+1) :: CLDFAC
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: CAMT,TOTVO2
+      INTEGER, INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: KBTM,KTOP
+      INTEGER, INTENT(IN), DIMENSION(its:ite)           :: NCLDS
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte)   :: QH2O
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: PRESS,TEMP
+      REAL,    INTENT(OUT), DIMENSION(its:ite,kts:kte)  :: HEATRA
+      REAL,    INTENT(OUT), DIMENSION(its:ite)          :: GRNFLX,TOPFLX
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: P,T
+      REAL,    INTENT(INOUT), DIMENSION(its:ite,kts:kte+1,kts:kte+1) :: CO21
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte)   :: CO2NBL,DELP2, &
+                                                           DELP,&
+                                               VAR1,VAR2,VAR3,VAR4
+      REAL, INTENT(IN), DIMENSION(3) :: BO3RND,AO3RND
+      REAL, INTENT(IN), DIMENSION(its:ite)   :: EMX1,EMX2
+      
+      REAL, DIMENSION(its:ite,kts:kte*2+1) :: TPL,EMD,ALP,C,CSUB,CSUB2
+      REAL, DIMENSION(its:ite,kts:kte*2+1) :: C2
+      INTEGER, DIMENSION(its:ite,kts:kte+1) :: IXO
+      REAL, DIMENSION(its:ite,kts:kte+1) :: VTMP3,FXO,DT,FXOE2,DTE2, &
+                                            SS1,CSOUR,TC,OSS,CSS,DTC,SS2,&
+                                            AVEPHI,E1CTS1,E1FLX,  &
+                                            E1CTW1,DSORC,EMISS,FAC1,&
+                                            TO3SP,OVER1D,CNTTAU,TOTEVV,&
+                                            CO2SP,FLX,AVMO3, &
+                                            AVPHO3,AVVO2,CONT1D,TO31D,EMISDG,&
+                                            DELPR1
+      REAL, DIMENSION(its:ite,kts:kte+1) :: EMISSB,DELPR2,CONTDG,TO3DG,HEATEM,&
+                                            VSUM1,FLXNET,Z1
+
+      REAL, DIMENSION(its:ite,kts:kte+1,NBLY) :: SORC
+      REAL, DIMENSION(its:ite,kts:kte)   :: E1CTS2,E1CTW2,TO3SPC,RLOG,EXCTS,&
+                                            CTSO3,CTS
+      REAL, DIMENSION(its:ite)   :: GXCTS,FLX1E1
+      REAL, DIMENSION(its:ite)   :: PTOP,PBOT,FTOP,FBOT,DELPTC
+      REAL, DIMENSION(its:ite,2) :: FXOSP,DTSP,EMSPEC
+!     REAL, DIMENSION(28,NBLY) :: SOURCE,DSRCE
+      INTEGER :: K, I,KP,LLM2,J1,J3,KMAX,KMIN,KCLDS,ICNT,LLM1
+      INTEGER :: L,LP1,LP2,LP3,LM1,LM2,LM3,MYIS,MYIE,LLP1,LL,KK,KLEN
+
+      L=kte
+      LP1=L+1;  LP2=L+2;  LP3=L+3; LLP1 = 2*L + 1
+      LM1=L-1;  LM2=L-2;  LM3=L-3; LL = 2*L
+      LLM2 = LL-2; LLM1=LL-1
+      MYIS=its; MYIE=ite
+
+!
+      DO 101 K=1,LP1
+      DO 101 I=MYIS,MYIE
+!---TEMP. INDICES FOR E1,SOURCE
+      VTMP3(I,K)=AINT(TEMP(I,K)*HP1)
+      FXO(I,K)=VTMP3(I,K)-9.
+      DT(I,K)=TEMP(I,K)-TEN*VTMP3(I,K)
+!---INTEGER INDEX FOR SOURCE (USED IMMEDIATELY)
+      IXO(I,K)=FXO(I,K)
+101   CONTINUE
+      DO 103 k=1,L
+      DO 103 I=MYIS,MYIE
+!---TEMP. INDICES FOR E2 (KP=1 LAYER NOT USED IN FLUX CALCULATIONS)
+      VTMP3(I,K)=AINT(T(I,K+1)*HP1)
+      FXOE2(I,K)=VTMP3(I,K)-9.
+      DTE2(I,K)=T(I,K+1)-TEN*VTMP3(I,K)
+103   CONTINUE
+!---SPECIAL CASE TO HANDLE KP=LP1 LAYER AND SPECIAL E2 CALCS.
+      DO 105 I=MYIS,MYIE
+      FXOE2(I,LP1)=FXO(I,L)
+      DTE2(I,LP1)=DT(I,L)
+      FXOSP(I,1)=FXOE2(I,LM1)
+      FXOSP(I,2)=FXO(I,LM1)
+      DTSP(I,1)=DTE2(I,LM1)
+      DTSP(I,2)=DT(I,LM1)
+105   CONTINUE
+!
+!---SOURCE FUNCTION FOR COMBINED BAND 1
+      DO 4114 I=MYIS,MYIE
+      DO 4114 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),1)
+        DSORC(I,K)=DSRCE(IXO(I,K),1)
+4114   CONTINUE
+      DO 4112 K=1,LP1
+      DO 4112 I=MYIS,MYIE
+      SORC(I,K,1)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+4112   CONTINUE
+!---SOURCE FUNCTION FOR COMBINED BAND 2
+      DO 4214 I=MYIS,MYIE
+      DO 4214 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),2)
+        DSORC(I,K)=DSRCE(IXO(I,K),2)
+4214   CONTINUE
+      DO 4212 K=1,LP1
+      DO 4212 I=MYIS,MYIE
+      SORC(I,K,2)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+4212   CONTINUE
+!---SOURCE FUNCTION FOR COMBINED BAND 3
+      DO 4314 I=MYIS,MYIE
+      DO 4314 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),3)
+        DSORC(I,K)=DSRCE(IXO(I,K),3)
+4314   CONTINUE
+      DO 4312 K=1,LP1
+      DO 4312 I=MYIS,MYIE
+      SORC(I,K,3)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+4312   CONTINUE
+!---SOURCE FUNCTION FOR COMBINED BAND 4
+      DO 4414 I=MYIS,MYIE
+      DO 4414 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),4)
+        DSORC(I,K)=DSRCE(IXO(I,K),4)
+4414   CONTINUE
+      DO 4412 K=1,LP1
+      DO 4412 I=MYIS,MYIE
+      SORC(I,K,4)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+4412   CONTINUE
+!---SOURCE FUNCTION FOR COMBINED BAND 5
+      DO 4514 I=MYIS,MYIE
+      DO 4514 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),5)
+        DSORC(I,K)=DSRCE(IXO(I,K),5)
+4514   CONTINUE
+      DO 4512 K=1,LP1
+      DO 4512 I=MYIS,MYIE
+      SORC(I,K,5)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+4512   CONTINUE
+!---SOURCE FUNCTION FOR COMBINED BAND 6
+      DO 4614 I=MYIS,MYIE
+      DO 4614 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),6)
+        DSORC(I,K)=DSRCE(IXO(I,K),6)
+4614   CONTINUE
+      DO 4612 K=1,LP1
+      DO 4612 I=MYIS,MYIE
+      SORC(I,K,6)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+4612   CONTINUE
+!---SOURCE FUNCTION FOR COMBINED BAND 7
+      DO 4714 I=MYIS,MYIE
+      DO 4714 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),7)
+        DSORC(I,K)=DSRCE(IXO(I,K),7)
+4714   CONTINUE
+      DO 4712 K=1,LP1
+      DO 4712 I=MYIS,MYIE
+      SORC(I,K,7)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+4712   CONTINUE
+!---SOURCE FUNCTION FOR COMBINED BAND 8
+      DO 4814 I=MYIS,MYIE
+      DO 4814 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),8)
+        DSORC(I,K)=DSRCE(IXO(I,K),8)
+4814   CONTINUE
+      DO 4812 K=1,LP1
+      DO 4812 I=MYIS,MYIE
+      SORC(I,K,8)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+4812   CONTINUE
+!---SOURCE FUNCTION FOR BAND 9 (560-670 CM-1)
+      DO 4914 I=MYIS,MYIE
+      DO 4914 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),9)
+        DSORC(I,K)=DSRCE(IXO(I,K),9)
+4914   CONTINUE
+      DO 4912 K=1,LP1
+      DO 4912 I=MYIS,MYIE
+      SORC(I,K,9)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+4912   CONTINUE
+!---SOURCE FUNCTION FOR BAND 10 (670-800 CM-1)
+      DO 5014 I=MYIS,MYIE
+      DO 5014 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),10)
+        DSORC(I,K)=DSRCE(IXO(I,K),10)
+5014  CONTINUE
+      DO 5012 K=1,LP1
+      DO 5012 I=MYIS,MYIE
+      SORC(I,K,10)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+5012   CONTINUE
+!---SOURCE FUNCTION FOR BAND 11 (800-900 CM-1)
+      DO 5114 I=MYIS,MYIE
+      DO 5114 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),11)
+        DSORC(I,K)=DSRCE(IXO(I,K),11)
+5114   CONTINUE
+      DO 5112 K=1,LP1
+      DO 5112 I=MYIS,MYIE
+      SORC(I,K,11)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+5112   CONTINUE
+!---SOURCE FUNCTION FOR BAND 12 (900-990 CM-1)
+      DO 5214 I=MYIS,MYIE
+      DO 5214 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),12)
+        DSORC(I,K)=DSRCE(IXO(I,K),12)
+5214   CONTINUE
+      DO 5212 K=1,LP1
+      DO 5212 I=MYIS,MYIE
+      SORC(I,K,12)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+5212   CONTINUE
+!---SOURCE FUNCTION FOR BAND 13 (990-1070 CM-1)
+      DO 5314 I=MYIS,MYIE
+      DO 5314 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),13)
+        DSORC(I,K)=DSRCE(IXO(I,K),13)
+5314   CONTINUE
+      DO 5312 K=1,LP1
+      DO 5312 I=MYIS,MYIE
+      SORC(I,K,13)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+5312   CONTINUE
+!---SOURCE FUNCTION FOR BAND 14 (1070-1200 CM-1)
+      DO 5414 I=MYIS,MYIE
+      DO 5414 K=1,LP1
+        VTMP3(I,K)=SOURCE(IXO(I,K),14)
+        DSORC(I,K)=DSRCE(IXO(I,K),14)
+5414   CONTINUE
+      DO 5412 K=1,LP1
+      DO 5412 I=MYIS,MYIE
+      SORC(I,K,14)=VTMP3(I,K)+DT(I,K)*DSORC(I,K)
+5412   CONTINUE
+!
+!        THE FOLLOWING SUBROUTINE OBTAINS NLTE SOURCE FUNCTION FOR CO2
+!
+!
+!     CALL NLTE
+!
+!
+!---OBTAIN SPECIAL SOURCE FUNCTIONS FOR THE 15 UM BAND (CSOUR)
+!   AND THE WINDOW REGION (SS1)
+      DO 131 K=1,LP1
+      DO 131 I=MYIS,MYIE
+      SS1(I,K)=SORC(I,K,11)+SORC(I,K,12)+SORC(I,K,14)
+131   CONTINUE
+      DO 143 K=1,LP1
+      DO 143 I=MYIS,MYIE
+      CSOUR(I,K)=SORC(I,K,9)+SORC(I,K,10)
+143   CONTINUE
+!
+!---COMPUTE TEMP**4 (TC) AND VERTICAL TEMPERATURE DIFFERENCES
+!   (OSS,CSS,SS2,DTC). ALL THESE WILL BE USED LATER IN FLUX COMPUTA-
+!   TIONS.
+!
+      DO 901 K=1,LP1
+      DO 901 I=MYIS,MYIE
+      TC(I,K)=TEMP(I,K)*TEMP(I,K)*TEMP(I,K)*TEMP(I,K)
+901   CONTINUE
+      DO 903 K=1,L
+      DO 903 I=MYIS,MYIE
+      OSS(I,K+1)=SORC(I,K+1,13)-SORC(I,K,13)
+      CSS(I,K+1)=CSOUR(I,K+1)-CSOUR(I,K)
+      DTC(I,K+1)=TC(I,K+1)-TC(I,K)
+      SS2(I,K+1)=SS1(I,K+1)-SS1(I,K)
+903   CONTINUE
+!
+!
+!---THE FOLLOWIMG IS A DRASTIC REWRITE OF THE RADIATION CODE TO
+!    (LARGELY) ELIMINATE THREE-DIMENSIONAL ARRAYS. THE CODE WORKS
+!    ON THE FOLLOWING PRINCIPLES:
+!
+!          LET K = FIXED FLUX LEVEL, KP = VARYING FLUX LEVEL
+!          THEN FLUX(K)=SUM OVER KP : (DELTAB(KP)*TAU(KP,K))
+!               OVER ALL KP'S, FROM 1 TO LP1.
+!
+!          WE CAN BREAK DOWN THE CALCULATIONS FOR ALL K'S AS FOLLOWS:
+!
+!          FOR ALL K'S K=1 TO LP1:
+!              FLUX(K)=SUM OVER KP : (DELTAB(KP)*TAU(KP,K))  (1)
+!                      OVER ALL KP'S, FROM K+1 TO LP1
+!          AND
+!              FOR KP FROM K+1 TO LP1:
+!                 FLUX(KP) = DELTAB(K)*TAU(K,KP)              (2)
+!
+!          NOW IF TAU(K,KP)=TAU(KP,K) (SYMMETRICAL ARRAYS)
+!          WE CAN COMPUTE A 1-DIMENSIONAL ARRAY TAU1D(KP) FROM
+!          K+1 TO LP1, EACH TIME K IS INCREMENTED.
+!          EQUATIONS (1) AND (2) THEN BECOME:
+!
+!             TAU1D(KP) = (VALUES FOR TAU(KP,K) AT THE PARTICULAR K)
+!             FLUX(K) = SUM OVER KP : (DELTAB(KP)*TAU1D(KP))   (3)
+!             FLUX(KP) = DELTAB(K)*TAU1D(KP)                   (4)
+!
+!         THE TERMS FOR TAU (K,K) AND OTHER SPECIAL TERMS (FOR
+!         NEARBY LAYERS) MUST, OF COURSE, BE HANDLED SEPARATELY, AND
+!         WITH CARE.
+!
+!      COMPUTE "UPPER TRIANGLE" TRANSMISSION FUNCTIONS FOR
+!      THE 9.6 UM BAND (TO3SP) AND THE 15 UM BAND (OVER1D). ALSO,
+!      THE
+!      STAGE 1...COMPUTE O3 ,OVER TRANSMISSION FCTNS AND AVEPHI
+!---DO K=1 CALCULATION (FROM FLUX LAYER KK TO THE TOP) SEPARATELY
+!   AS VECTORIZATION IS IMPROVED,AND OZONE CTS TRANSMISSIVITY
+!   MAY BE EXTRACTED HERE.
+      DO 3021 K=1,L
+      DO 3021 I=MYIS,MYIE
+      AVEPHI(I,K)=TOTPHI(I,K+1)
+3021  CONTINUE
+!---IN ORDER TO PROPERLY EVALUATE EMISS INTEGRATED OVER THE (LP1)
+!   LAYER, A SPECIAL EVALUATION OF EMISS IS DONE. THIS REQUIRES
+!   A SPECIAL COMPUTATION OF AVEPHI, AND IT IS STORED IN THE
+!   (OTHERWISE VACANT) LP1'TH POSITION
+!
+      DO 803 I=MYIS,MYIE
+      AVEPHI(I,LP1)=AVEPHI(I,LM1)+EMX1(I)
+803   CONTINUE
+!   COMPUTE FLUXES FOR K=1
+      CALL E1E290(E1CTS1,E1CTS2,E1FLX,E1CTW1,E1CTW2,EMISS, &
+                  FXO,DT,FXOE2,DTE2,AVEPHI,TEMP,T,         &
+!                 T1,T2,T4 ,EM1V,EM1VW,                    &
+                  H16E1,TEN,HP1,H28E1,HAF,                 &
+                  ids,ide, jds,jde, kds,kde,               &
+                  ims,ime, jms,jme, kms,kme,               &
+                  its,ite, jts,jte, kts,kte                )
+
+      DO 302 K=1,L
+      DO 302 I=MYIS,MYIE
+      FAC1(I,K)=BO3RND(2)*TPHIO3(I,K+1)/TOTO3(I,K+1)
+      TO3SPC(I,K)=HAF*(FAC1(I,K)* &
+          (SQRT(ONE+(FOUR*AO3RND(2)*TOTO3(I,K+1))/FAC1(I,K))-ONE))
+!   FOR K=1, TO3SP IS USED INSTEAD OF TO31D (THEY ARE EQUAL IN THIS
+!   CASE); TO3SP IS PASSED TO SPA90, WHILE TO31D IS A WORK-ARRAY.
+      TO3SP(I,K)=EXP(HM1EZ*(TO3SPC(I,K)+SKO3R*TOTVO2(I,K+1)))
+      OVER1D(I,K)=EXP(HM1EZ*(SQRT(AB15WD*TOTPHI(I,K+1))+ &
+                  SKC1R*TOTVO2(I,K+1)))
+!---BECAUSE ALL CONTINUUM TRANSMISSIVITIES ARE OBTAINED FROM THE
+!  2-D QUANTITY CNTTAU (AND ITS RECIPROCAL TOTEVV) WE STORE BOTH
+!  OF THESE HERE. FOR K=1, CONT1D EQUALS CNTTAU
+      CNTTAU(I,K)=EXP(HM1EZ*TOTVO2(I,K+1))
+      TOTEVV(I,K)=1./CNTTAU(I,K)
+302   CONTINUE
+      DO 3022 K=1,L
+      DO 3022 I=MYIS,MYIE
+      CO2SP(I,K+1)=OVER1D(I,K)*CO21(I,1,K+1)
+3022  CONTINUE
+      DO 3023 K=1,L
+      DO 3023 I=MYIS,MYIE
+      CO21(I,K+1,1)=CO21(I,K+1,1)*OVER1D(I,K)
+3023  CONTINUE
+!---RLOG IS THE NBL AMOUNT FOR THE 15 UM BAND CALCULATION
+      DO 1808 I=MYIS,MYIE
+      RLOG(I,1)=OVER1D(I,1)*CO2NBL(I,1)
+1808  CONTINUE
+!---THE TERMS WHEN KP=1 FOR ALL K ARE THE PHOTON EXCHANGE WITH
+!   THE TOP OF THE ATMOSPHERE, AND ARE OBTAINED DIFFERENTLY THAN
+!   THE OTHER CALCULATIONS
+      DO 305 K=2,LP1
+      DO 305 I=MYIS,MYIE
+      FLX(I,K)= (TC(I,1)*E1FLX(I,K) &
+                +SS1(I,1)*CNTTAU(I,K-1) &
+                +SORC(I,1,13)*TO3SP(I,K-1) &
+                +CSOUR(I,1)*CO2SP(I,K)) &
+                *CLDFAC(I,1,K)
+305   CONTINUE
+      DO 307 I=MYIS,MYIE
+      FLX(I,1)= TC(I,1)*E1FLX(I,1)+SS1(I,1)+SORC(I,1,13) &
+                +CSOUR(I,1)
+307   CONTINUE
+!---THE KP TERMS FOR K=1...
+      DO 303 KP=2,LP1
+      DO 303 I=MYIS,MYIE
+      FLX(I,1)=FLX(I,1)+(OSS(I,KP)*TO3SP(I,KP-1) &
+                        +SS2(I,KP)*CNTTAU(I,KP-1) &
+                        +CSS(I,KP)*CO21(I,KP,1) &
+                        +DTC(I,KP)*EMISS(I,KP-1))*CLDFAC(I,KP,1)
+303   CONTINUE
+!          SUBROUTINE SPA88 IS CALLED TO OBTAIN EXACT CTS FOR WATER
+!     CO2 AND O3, AND APPROXIMATE CTS CO2 AND O3 CALCULATIONS.
+!
+      CALL SPA88(EXCTS,CTSO3,GXCTS,SORC,CSOUR, &
+                 CLDFAC,TEMP,PRESS,VAR1,VAR2, &
+                 P,DELP,DELP2,TOTVO2,TO3SP,TO3SPC, &
+                 CO2SP1,CO2SP2,CO2SP,              &
+                 APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+                 H25E2,ONE,H44194M2,H1P41819,HAF,HM1EZ,TWO,    &
+!                SKO2D,RADCON,                                 &
+                 RADCON,                                 &
+                 ids,ide, jds,jde, kds,kde,                    &
+                 ims,ime, jms,jme, kms,kme,                    &
+                 its,ite, jts,jte, kts,kte                     )
+
+!
+!    THIS SECTION COMPUTES THE EMISSIVITY CTS HEATING RATES FOR 2
+!    EMISSIVITY BANDS: THE 0-160,1200-2200 CM-1 BAND AND THE 800-
+!    990,1070-1200 CM-1 BAND. THE REMAINING CTS COMTRIBUTIONS ARE
+!    CONTAINED IN CTSO3, COMPUTED IN SPA88.
+!
+      DO 998 I=MYIS,MYIE
+      VTMP3(I,1)=1.
+998   CONTINUE
+      DO 999 K=1,L
+      DO 999 I=MYIS,MYIE
+      VTMP3(I,K+1)=CNTTAU(I,K)*CLDFAC(I,K+1,1)
+999   CONTINUE
+      DO 1001 K=1,L
+      DO 1001 I=MYIS,MYIE
+      CTS(I,K)=RADCON*DELP(I,K)*(TC(I,K)* &
+           (E1CTW2(I,K)*CLDFAC(I,K+1,1)-E1CTW1(I,K)*CLDFAC(I,K,1)) + &
+            SS1(I,K)*(VTMP3(I,K+1)-VTMP3(I,K)))
+1001  CONTINUE
+!
+      DO 1011 K=1,L
+      DO 1011 I=MYIS,MYIE
+      VTMP3(I,K)=TC(I,K)*(CLDFAC(I,K,1)*(E1CTS1(I,K)-E1CTW1(I,K)) - &
+                        CLDFAC(I,K+1,1)*(E1CTS2(I,K)-E1CTW2(I,K)))
+1011  CONTINUE
+      DO 1012 I=MYIS,MYIE
+      FLX1E1(I)=TC(I,LP1)*CLDFAC(I,LP1,1)* &
+                (E1CTS1(I,LP1)-E1CTW1(I,LP1))
+1012  CONTINUE
+      DO 1014 K=1,L
+      DO 1013 I=MYIS,MYIE
+      FLX1E1(I)=FLX1E1(I)+VTMP3(I,K)
+1013  CONTINUE
+1014  CONTINUE
+!
+!---NOW REPEAT FLUX CALCULATIONS FOR THE K=2..LM1  CASES.
+!   CALCULATIONS FOR FLUX LEVEL L AND LP1 ARE DONE SEPARATELY, AS ALL
+!   EMISSIVITY AND CO2 CALCULATIONS ARE SPECIAL CASES OR NEARBY LAYERS.
+!
+      DO 321 K=2,LM1
+      KLEN=K
+!
+      DO 3218 KK=1,LP1-K
+      DO 3218 I=MYIS,MYIE
+      AVEPHI(I,KK+K-1)=TOTPHI(I,KK+K)-TOTPHI(I,K)
+3218  CONTINUE
+      DO 1803 I=MYIS,MYIE
+      AVEPHI(I,LP1)=AVEPHI(I,LM1)+EMX1(I)
+1803   CONTINUE
+!---COMPUTE EMISSIVITY FLUXES (E2) FOR THIS CASE. NOTE THAT
+!   WE HAVE OMITTED THE NEARBY LATER CASE (EMISS(I,K,K)) AS WELL
+!   AS ALL CASES WITH K=L OR LP1. BUT THESE CASES HAVE ALWAYS
+!   BEEN HANDLED AS SPECIAL CASES, SO WE MAY AS WELL COMPUTE
+!    THEIR FLUXES SEPARASTELY.
+!
+      CALL E290(EMISSB,EMISS,AVEPHI,KLEN,FXOE2,DTE2,  &
+!                      T1,T2,T4,                      &
+                       H16E1,HP1,H28E1,HAF,TEN,       &
+                       ids,ide, jds,jde, kds,kde,     &
+                       ims,ime, jms,jme, kms,kme,     &
+                       its,ite, jts,jte, kts,kte      )
+
+      DO 322 KK=1,LP1-K
+      DO 322 I=MYIS,MYIE
+      AVMO3(I,KK+K-1)=TOTO3(I,KK+K)-TOTO3(I,K)
+      AVPHO3(I,KK+K-1)=TPHIO3(I,KK+K)-TPHIO3(I,K)
+      AVVO2(I,KK+K-1)=TOTVO2(I,KK+K)-TOTVO2(I,K)
+      CONT1D(I,KK+K-1)=CNTTAU(I,KK+K-1)*TOTEVV(I,K-1)
+322   CONTINUE
+!
+      DO 3221 KK=1,LP1-K
+      DO 3221 I=MYIS,MYIE
+      FAC1(I,K+KK-1)=BO3RND(2)*AVPHO3(I,K+KK-1)/AVMO3(I,K+KK-1)
+      VTMP3(I,K+KK-1)=HAF*(FAC1(I,K+KK-1)* &
+        (SQRT(ONE+(FOUR*AO3RND(2)*AVMO3(I,K+KK-1))/ &
+         FAC1(I,K+KK-1))-ONE))
+      TO31D(I,K+KK-1)=EXP(HM1EZ*(VTMP3(I,K+KK-1) &
+                         +SKO3R*AVVO2(I,K+KK-1)))
+      OVER1D(I,K+KK-1)=EXP(HM1EZ*(SQRT(AB15WD*AVEPHI(I,K+KK-1))+ &
+                  SKC1R*AVVO2(I,K+KK-1)))
+      CO21(I,K+KK,K)=OVER1D(I,K+KK-1)*CO21(I,K+KK,K)
+3221  CONTINUE
+      DO 3223 KP=K+1,LP1
+      DO 3223 I=MYIS,MYIE
+      CO21(I,K,KP)=OVER1D(I,KP-1)*CO21(I,K,KP)
+3223  CONTINUE
+!---RLOG IS THE NBL AMOUNT FOR THE 15 UM BAND CALCULATION
+      DO 1804 I=MYIS,MYIE
+      RLOG(I,K)=OVER1D(I,K)*CO2NBL(I,K)
+1804  CONTINUE
+!---THE KP TERMS FOR ARBIRRARY K..
+      DO 3423 KP=K+1,LP1
+      DO 3423 I=MYIS,MYIE
+      FLX(I,K)=FLX(I,K)+(OSS(I,KP)*TO31D(I,KP-1) &
+                        +SS2(I,KP)*CONT1D(I,KP-1) &
+                        +CSS(I,KP)*CO21(I,KP,K) &
+                        +DTC(I,KP)*EMISS(I,KP-1))*CLDFAC(I,KP,K)
+3423  CONTINUE
+      DO 3425 KP=K+1,LP1
+      DO 3425 I=MYIS,MYIE
+      FLX(I,KP)=FLX(I,KP)+(OSS(I,K)*TO31D(I,KP-1) &
+                         +SS2(I,K)*CONT1D(I,KP-1) &
+                         +CSS(I,K)*CO21(I,K,KP) &
+                         +DTC(I,K)*EMISSB(I,KP-1))*CLDFAC(I,K,KP)
+3425  CONTINUE
+321   CONTINUE
+!
+      DO 821 I=MYIS,MYIE
+      TPL(I,1)=TEMP(I,L)
+      TPL(I,LP1)=HAF*(T(I,LP1)+TEMP(I,L))
+      TPL(I,LLP1)=HAF*(T(I,L)+TEMP(I,L))
+821   CONTINUE
+      DO 823 K=2,L
+      DO 823 I=MYIS,MYIE
+      TPL(I,K)=T(I,K)
+      TPL(I,K+L)=T(I,K)
+823   CONTINUE
+!
+!---E2 FUNCTIONS ARE REQUIRED IN THE NBL CALCULATIONS FOR 2 CASES,
+!   DENOTED (IN OLD CODE) AS (L,LP1) AND (LP1,LP1)
+      DO 833 I=MYIS,MYIE
+      AVEPHI(I,1)=VAR2(I,L)
+      AVEPHI(I,2)=VAR2(I,L)+EMPL(I,L)
+833   CONTINUE
+      CALL E2SPEC(EMISS,AVEPHI,FXOSP,DTSP,                          &
+!                     T1,T2,T4, &
+                      H16E1,TEN,H28E1,HP1,                          &
+                      ids,ide, jds,jde, kds,kde,                    &
+                      ims,ime, jms,jme, kms,kme,                    &
+                      its,ite, jts,jte, kts,kte                     )
+
+!
+!     CALL E3V88 FOR NBL H2O TRANSMISSIVITIES
+!          CALL E3V88(EMD,TPL,EMPL,EM3V, &
+           CALL E3V88(EMD,TPL,EMPL, &
+                      TEN,HP1,H28E1,H16E1,  &
+                      ids,ide, jds,jde, kds,kde,                    &
+                      ims,ime, jms,jme, kms,kme,                    &
+                      its,ite, jts,jte, kts,kte                     )
+!
+!   COMPUTE NEARBY LAYER AND SPECIAL-CASE TRANSMISSIVITIES FOR EMISS
+!    USING METHODS FOR H2O GIVEN IN REF. (4)
+      DO 851 K=2,L
+      DO 851 I=MYIS,MYIE
+      EMISDG(I,K)=EMD(I,K+L)+EMD(I,K)
+851   CONTINUE
+!
+!   NOTE THAT EMX1/2 (PRESSURE SCALED PATHS) ARE NOW COMPUTED IN
+!   LWR88
+      DO 861 I=MYIS,MYIE
+      EMSPEC(I,1)=(EMD(I,1)*EMPL(I,1)-EMD(I,LP1)*EMPL(I,LP1))/ &
+       EMX1(I) + QUARTR*(EMISS(I,1)+EMISS(I,2))
+      EMISDG(I,LP1)=TWO*EMD(I,LP1)
+      EMSPEC(I,2)=TWO*(EMD(I,1)*EMPL(I,1)-EMD(I,LLP1)*EMPL(I,LLP1))/ &
+       EMX2(I)
+861   CONTINUE
+      DO 331 I=MYIS,MYIE
+      FAC1(I,L)=BO3RND(2)*VAR4(I,L)/VAR3(I,L)
+      VTMP3(I,L)=HAF*(FAC1(I,L)* &
+          (SQRT(ONE+(FOUR*AO3RND(2)*VAR3(I,L))/FAC1(I,L))-ONE))
+      TO31D(I,L)=EXP(HM1EZ*(VTMP3(I,L)+SKO3R*CNTVAL(I,L)))
+      OVER1D(I,L)=EXP(HM1EZ*(SQRT(AB15WD*VAR2(I,L))+ &
+                  SKC1R*CNTVAL(I,L)))
+      CONT1D(I,L)=CNTTAU(I,L)*TOTEVV(I,LM1)
+      RLOG(I,L)=OVER1D(I,L)*CO2NBL(I,L)
+331   CONTINUE
+      DO 618 K=1,L
+      DO 618 I=MYIS,MYIE
+      RLOG(I,K)=LOG(RLOG(I,K))
+618   CONTINUE
+      DO 601 K=1,LM1
+      DO 601 I=MYIS,MYIE
+      DELPR1(I,K+1)=DELP(I,K+1)*(PRESS(I,K+1)-P(I,K+1))
+      ALP(I,LP1+K-1)=-SQRT(DELPR1(I,K+1))*RLOG(I,K+1)
+601   CONTINUE
+      DO 603 K=1,L
+      DO 603 I=MYIS,MYIE
+      DELPR2(I,K+1)=DELP(I,K)*(P(I,K+1)-PRESS(I,K))
+      ALP(I,K)=-SQRT(DELPR2(I,K+1))*RLOG(I,K)
+603   CONTINUE
+      DO 625 I=MYIS,MYIE
+      ALP(I,LL)=-RLOG(I,L)
+      ALP(I,LLP1)=-RLOG(I,L)*SQRT(DELP(I,L)*(P(I,LP1)-PRESS(I,LM1)))
+625   CONTINUE
+!        THE FIRST COMPUTATION IS FOR THE 15 UM BAND,WITH THE
+!     FOR THE COMBINED H2O AND CO2 TRANSMISSION FUNCTION.
+!
+!       PERFORM NBL COMPUTATIONS FOR THE 15 UM BAND
+!***THE STATEMENT FUNCTION SF IN PREV. VERSIONS IS NOW EXPLICITLY
+!   EVALUATED.
+      DO 631 K=1,LLP1
+      DO 631 I=MYIS,MYIE
+      C(I,K)=ALP(I,K)*(HMP66667+ALP(I,K)*(QUARTR+ALP(I,K)*HM6666M2))
+631   CONTINUE
+      DO 641 I=MYIS,MYIE
+      CO21(I,LP1,LP1)=ONE+C(I,L)
+      CO21(I,LP1,L)=ONE+(DELP2(I,L)*C(I,LL)-(PRESS(I,L)-P(I,L))* &
+       C(I,LLM1))/(P(I,LP1)-PRESS(I,L))
+      CO21(I,L,LP1)=ONE+((P(I,LP1)-PRESS(I,LM1))*C(I,LLP1)- &
+       (P(I,LP1)-PRESS(I,L))*C(I,L))/(PRESS(I,L)-PRESS(I,LM1))
+641   CONTINUE
+      DO 643 K=2,L
+      DO 643 I=MYIS,MYIE
+      CO21(I,K,K)=ONE+HAF*(C(I,LM1+K)+C(I,K-1))
+643   CONTINUE
+!
+!    COMPUTE NEARBY-LAYER TRANSMISSIVITIES FOR THE O3 BAND AND FOR THE
+!    ONE-BAND CONTINUUM BAND (TO3 AND EMISS2). THE SF2 FUNCTION IS
+!    USED. THE METHOD IS THE SAME AS DESCRIBED FOR CO2 IN REF (4).
+      DO 651 K=1,LM1
+      DO 651 I=MYIS,MYIE
+      CSUB(I,K+1)=CNTVAL(I,K+1)*DELPR1(I,K+1)
+      CSUB(I,LP1+K-1)=CNTVAL(I,K)*DELPR2(I,K+1)
+651   CONTINUE
+!---THE SF2 FUNCTION IN PREV. VERSIONS IS NOW EXPLICITLY EVALUATED
+      DO 655 K=1,LLM2
+      DO 655 I=MYIS,MYIE
+      CSUB2(I,K+1)=SKO3R*CSUB(I,K+1)
+      C(I,K+1)=CSUB(I,K+1)*(HMP5+CSUB(I,K+1)* &
+                (HP166666-CSUB(I,K+1)*H41666M2))
+      C2(I,K+1)=CSUB2(I,K+1)*(HMP5+CSUB2(I,K+1)* &
+                 (HP166666-CSUB2(I,K+1)*H41666M2))
+655   CONTINUE
+      DO 661 I=MYIS,MYIE
+      CONTDG(I,LP1)=1.+C(I,LLM1)
+      TO3DG(I,LP1)=1.+C2(I,LLM1)
+661   CONTINUE
+      DO 663 K=2,L
+      DO 663 I=MYIS,MYIE
+      CONTDG(I,K)=ONE+HAF*(C(I,K)+C(I,LM1+K))
+      TO3DG(I,K)=ONE+HAF*(C2(I,K)+C2(I,LM1+K))
+663   CONTINUE
+!---NOW OBTAIN FLUXES
+!
+!    FOR THE DIAGONAL TERMS...
+      DO 871 K=2,LP1
+      DO 871 I=MYIS,MYIE
+      FLX(I,K)=FLX(I,K)+(DTC(I,K)*EMISDG(I,K) &
+                       +SS2(I,K)*CONTDG(I,K) &
+                       +OSS(I,K)*TO3DG(I,K) &
+                       +CSS(I,K)*CO21(I,K,K))*CLDFAC(I,K,K)
+871   CONTINUE
+!     FOR THE TWO OFF-DIAGONAL TERMS...
+      DO 873 I=MYIS,MYIE
+      FLX(I,L)=FLX(I,L)+(CSS(I,LP1)*CO21(I,LP1,L) &
+                        +DTC(I,LP1)*EMSPEC(I,2) &
+                        +OSS(I,LP1)*TO31D(I,L) &
+                        +SS2(I,LP1)*CONT1D(I,L))*CLDFAC(I,LP1,L)
+      FLX(I,LP1)=FLX(I,LP1)+(CSS(I,L)*CO21(I,L,LP1) &
+                            +OSS(I,L)*TO31D(I,L) &
+                            +SS2(I,L)*CONT1D(I,L) &
+                            +DTC(I,L)*EMSPEC(I,1))*CLDFAC(I,L,LP1)
+873   CONTINUE
+!
+!     FINAL SECTION OBTAINS EMISSIVITY HEATING RATES,
+!     TOTAL HEATING RATES AND THE FLUX AT THE GROUND
+!
+!     .....CALCULATE THE EMISSIVITY HEATING RATES
+      DO 1101 K=1,L
+      DO 1101 I=MYIS,MYIE
+      HEATEM(I,K)=RADCON*(FLX(I,K+1)-FLX(I,K))*DELP(I,K)
+1101  CONTINUE
+!     .....CALCULATE THE TOTAL HEATING RATES
+      DO 1103 K=1,L
+      DO 1103 I=MYIS,MYIE
+      HEATRA(I,K)=HEATEM(I,K)-CTS(I,K)-CTSO3(I,K)+EXCTS(I,K)
+1103  CONTINUE
+!     .....CALCULATE THE FLUX AT EACH FLUX LEVEL USING THE FLUX AT THE
+!    TOP (FLX1E1+GXCTS) AND THE INTEGRAL OF THE HEATING RATES (VSUM1)
+      DO 1111 K=1,L
+      DO 1111 I=MYIS,MYIE
+      VSUM1(I,K)=HEATRA(I,K)*DELP2(I,K)*RADCON1
+1111  CONTINUE
+      DO 1115 I=MYIS,MYIE
+      TOPFLX(I)=FLX1E1(I)+GXCTS(I)
+      FLXNET(I,1)=TOPFLX(I)
+1115  CONTINUE
+!---ONLY THE SURFACE VALUE OF FLUX (GRNFLX) IS NEEDED UNLESS
+!    THE THICK CLOUD SECTION IS INVOKED.
+      DO 1123 K=2,LP1
+      DO 1123 I=MYIS,MYIE
+      FLXNET(I,K)=FLXNET(I,K-1)+VSUM1(I,K-1)
+1123  CONTINUE
+      DO 1125 I=MYIS,MYIE
+      GRNFLX(I)=FLXNET(I,LP1)
+1125  CONTINUE
+!
+!     THIS IS THE THICK CLOUD SECTION.OPTIONALLY,IF THICK CLOUD
+!     FLUXES ARE TO BE "CONVECTIVELY ADJUSTED",IE,DF/DP IS CONSTANT,
+!     FOR CLOUDY PART OF GRID POINT, THE FOLLOWING CODE IS EXECUTED.
+!***FIRST,COUNT THE NUMBER OF CLOUDS ALONG THE LAT. ROW. SKIP THE
+!   ENTIRE THICK CLOUD COMPUTATION OF THERE ARE NO CLOUDS.
+      ICNT=0
+      DO 1301 I=MYIS,MYIE
+      ICNT=ICNT+NCLDS(I)
+1301  CONTINUE
+      IF (ICNT.EQ.0) GO TO 6999
+!---FIND THE MAXIMUM NUMBER OF CLOUDS IN THE LATITUDE ROW
+      KCLDS=NCLDS(MYIS)
+      DO 2106 I=MYIS,MYIE
+      KCLDS=MAX(NCLDS(I),KCLDS)
+2106  CONTINUE
+!
+!
+!***OBTAIN THE PRESSURES AND FLUXES OF THE TOP AND BOTTOM OF
+!   THE NC'TH CLOUD (IT IS ASSUMED THAT ALL KTOP AND KBTM'S HAVE
+!   BEEN DEFINED!).
+      DO 1361 KK=1,KCLDS
+      KMIN=LP1
+      KMAX=0
+      DO 1362 I=MYIS,MYIE
+        J1=KTOP(I,KK+1)
+!       IF (J1.EQ.1) GO TO 1362
+        J3=KBTM(I,KK+1)
+        IF (J3.GT.J1) THEN
+          PTOP(I)=P(I,J1)
+          PBOT(I)=P(I,J3+1)
+          FTOP(I)=FLXNET(I,J1)
+          FBOT(I)=FLXNET(I,J3+1)
+!***OBTAIN THE "FLUX DERIVATIVE" DF/DP (DELPTC)
+          DELPTC(I)=(FTOP(I)-FBOT(I))/(PTOP(I)-PBOT(I))
+          KMIN=MIN(KMIN,J1)
+          KMAX=MAX(KMAX,J3)
+        ENDIF
+1362  CONTINUE
+      KMIN=KMIN+1
+!***CALCULATE THE TOT. FLUX CHG. FROM THE TOP OF THE CLOUD, FOR
+!   ALL LEVELS.
+      DO 1365 K=KMIN,KMAX
+      DO 1363 I=MYIS,MYIE
+!       IF (KTOP(I,KK+1).EQ.1) GO TO 1363
+        IF(KTOP(I,KK+1).LT.K .AND. K.LE.KBTM(I,KK+1)) THEN
+          Z1(I,K)=(P(I,K)-PTOP(I))*DELPTC(I)+FTOP(I)
+!ORIGINAL FLXNET(I,K)=FLXNET(I,K)*(ONE-CAMT(I,KK+1)) +
+!ORIGINAL1            Z1(I,K)*CAMT(I,KK+1)
+          FLXNET(I,K)=Z1(I,K)
+        ENDIF
+1363  CONTINUE
+1365  CONTINUE
+1361  CONTINUE
+!***USING THIS FLUX CHG. IN THE CLOUDY PART OF THE GRID BOX, OBTAIN
+!   THE NEW FLUXES, WEIGHTING THE CLEAR AND CLOUDY FLUXES:AGAIN, ONLY
+!    THE FLUXES IN THICK-CLOUD LEVELS WILL EVENTUALLY BE USED.
+!     DO 6051 K=1,LP1
+!     DO 6051 I=MYIS,MYIE
+!     FLXNET(I,K)=FLXNET(I,K)*(ONE-CAMT(I,NC)) +
+!    1            Z1(I,K)*CAMT(I,NC)
+!051  CONTINUE
+!***MERGE FLXTHK INTO FLXNET FOR APPROPRIATE LEVELS.
+!     DO 1401 K=1,LP1
+!     DO 1401 I=MYIS,MYIE
+!     IF (K.GT.ITOP(I) .AND. K.LE.IBOT(I)
+!    1  .AND.  (NC-1).LE.NCLDS(I))  THEN
+!          FLXNET(I,K)=FLXTHK(I,K)
+!     ENDIF
+!401  CONTINUE
+!
+!******END OF CLOUD LOOP*****
+6001  CONTINUE
+6999  CONTINUE
+!***THE FINAL STEP IS TO RECOMPUTE THE HEATING RATES BASED ON THE
+!   REVISED FLUXES:
+      DO 6101 K=1,L
+      DO 6101 I=MYIS,MYIE
+      HEATRA(I,K)=RADCON*(FLXNET(I,K+1)-FLXNET(I,K))*DELP(I,K)
+6101  CONTINUE
+!     THE THICK CLOUD SECTION ENDS HERE.
+
+  END SUBROUTINE FST88
+
+!----------------------------------------------------------------------
+
+  SUBROUTINE E1E290(G1,G2,G3,G4,G5,EMISS,FXOE1,DTE1,FXOE2,DTE2,      &
+                       AVEPHI,TEMP,T,                                &
+!                      T1,T2,T4,EM1V,EM1VW,                          &
+                       H16E1,TEN,HP1,H28E1,HAF,                      &
+                       ids,ide, jds,jde, kds,kde,                    &
+                       ims,ime, jms,jme, kms,kme,                    &
+                       its,ite, jts,jte, kts,kte                     )
+!---------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+      REAL,INTENT(IN) :: H16E1,TEN,HP1,H28E1,HAF
+
+      REAL,INTENT(OUT),DIMENSION(its:ite,kts:kte+1) :: G1,G4,G3,EMISS
+      REAL,INTENT(IN),DIMENSION(its:ite,kts:kte+1) :: FXOE1,DTE1,FXOE2,DTE2
+      REAL,INTENT(IN),DIMENSION(its:ite,kts:kte+1) :: AVEPHI,TEMP,T
+      REAL,INTENT(OUT),DIMENSION(its:ite,kts:kte)   :: G2,G5
+!     REAL,INTENT(IN),DIMENSION(5040):: T1,T2,T4 ,EM1V,EM1VW
+
+      REAL,DIMENSION(its:ite,kts:kte+1) :: TMP3,DU,FYO,WW1,WW2
+      INTEGER,DIMENSION(its:ite,kts:kte*3+2)   :: IT1
+      INTEGER,DIMENSION(its:ite,kts:kte+1) :: IVAL
+
+!     REAL,DIMENSION(28,180):: EM1,EM1WDE,TABLE1,TABLE2, &
+!                              TABLE3
+!     EQUIVALENCE (EM1V(1),EM1(1,1)),(EM1VW(1),EM1WDE(1,1))
+!     EQUIVALENCE (T1(1),TABLE1(1,1)),(T2(1),TABLE2(1,1)), &
+!      (T4(1),TABLE3(1,1))
+
+      INTEGER :: K, I,KP,LLM2,J1,J3,KMAX,KMIN,KCLDS,ICNT,LLM1
+      INTEGER :: L,LP1,LP2,LP3,LM1,LM2,LM3,MYIS,MYIE,LLP1,LL,KK,KLEN
+
+      L=kte
+      LP1=L+1;  LP2=L+2;  LP3=L+3; LLP1 = 2*L + 1
+      LM1=L-1;  LM2=L-2;  LM3=L-3; LL = 2*L
+      LLM2 = LL-2; LLM1=LL-1
+      MYIS=its; MYIE=ite
+
+!---FIRST WE OBTAIN THE EMISSIVITIES AS A FUNCTION OF TEMPERATURE
+!   (INDEX FXO) AND WATER AMOUNT (INDEX FYO). THIS PART OF THE CODE
+!   THUS GENERATES THE E2 FUNCTION. THE FXO INDICES HAVE BEEN
+!   OBTAINED IN FST88, FOR CONVENIENCE.
+!
+!---THIS SUBROUTINE EVALUATES THE K=1 CASE ONLY--
+!
+!---THIS LOOP REPLACES LOOPS GOING FROMI=1,IMAX AND KP=2,LP1 PLUS
+!   THE SPECIAL CASE FOR THE LP1TH LAYER.
+
+      DO 1322 K=1,LP1
+      DO 1322 I=MYIS,MYIE
+      TMP3(I,K)=LOG10(AVEPHI(I,K))+H16E1
+      FYO(I,K)=AINT(TMP3(I,K)*TEN)
+      DU(I,K)=TMP3(I,K)-HP1*FYO(I,K)
+      FYO(I,K)=H28E1*FYO(I,K)
+      IVAL(I,K)=FYO(I,K)+FXOE2(I,K)
+      EMISS(I,K)=T1(IVAL(I,K))+DU(I,K)*T2(IVAL(I,K)) &
+                              +DTE2(I,K)*T4(IVAL(I,K))
+1322  CONTINUE
+!
+!---THE SPECIAL CASE EMISS(I,L) (LAYER KP) IS OBTAINED NOW
+!   BY AVERAGING THE VALUES FOR L AND LP1:
+      DO 1344 I=MYIS,MYIE
+      EMISS(I,L)=HAF*(EMISS(I,L)+EMISS(I,LP1))
+1344  CONTINUE
+!
+!   CALCULATIONS FOR THE KP=1 LAYER ARE NOT PERFORMED, AS
+!   THE RADIATION CODE ASSUMES THAT THE TOP FLUX LAYER (ABOVE THE
+!   TOP DATA LEVEL) IS ISOTHERMAL, AND HENCE CONTRIBUTES NOTHING
+!   TO THE FLUXES AT OTHER LEVELS.
+!
+!***THE FOLLOWING IS THE CALCULATION FOR THE E1 FUNCTION, FORMERLY
+!    DONE IN SUBROUTINE E1V88. THE MOVE TO E1E288 IS DUE TO THE
+!    SAVINGS IN OBTAINING INDEX VALUES (THE TEMP. INDICES HAVE
+!    BEEN OBTAINED IN FST88, WHILE THE U-INDICES ARE OBTAINED
+!    IN THE E2 CALCS.,WITH K=1).
+!
+!
+!   FOR TERMS INVOLVING TOP LAYER, DU IS NOT KNOWN; IN FACT, WE
+!   USE INDEX 2 TO REPERSENT INDEX 1 IN PREV. CODE. THIS MEANS THAT
+!    THE IT1 INDEX 1 AND LLP1 HAS TO BE CALCULATED SEPARATELY. THE
+!   INDEX LLP2 GIVES THE SAME VALUE AS 1; IT CAN BE OMITTED.
+      DO 208 I=MYIS,MYIE
+      IT1(I,1)=FXOE1(I,1)
+      WW1(I,1)=TEN-DTE1(I,1)
+      WW2(I,1)=HP1
+208   CONTINUE
+      DO 209 K=1,L
+      DO 209 I=MYIS,MYIE
+      IT1(I,K+1)=FYO(I,K)+FXOE1(I,K+1)
+      IT1(I,LP2+K-1)=FYO(I,K)+FXOE1(I,K)
+      WW1(I,K+1)=TEN-DTE1(I,K+1)
+      WW2(I,K+1)=HP1-DU(I,K)
+209   CONTINUE
+      DO 211 KP=1,L
+      DO 211 I=MYIS,MYIE
+      IT1(I,KP+LLP1)=FYO(I,KP)+FXOE1(I,1)
+211   CONTINUE
+!
+!
+!  G3(I,1) HAS THE SAME VALUES AS G1 (AND DID ALL ALONG)
+      DO 230 I=MYIS,MYIE
+      G1(I,1)=WW1(I,1)*WW2(I,1)*EM1V(IT1(I,1))+ &
+              WW2(I,1)*DTE1(I,1)*EM1V(IT1(I,1)+1)
+      G3(I,1)=G1(I,1)
+230   CONTINUE
+      DO 240 K=1,L
+      DO 240 I=MYIS,MYIE
+      G1(I,K+1)=WW1(I,K+1)*WW2(I,K+1)*EM1V(IT1(I,K+1))+ &
+              WW2(I,K+1)*DTE1(I,K+1)*EM1V(IT1(I,K+1)+1)+ &
+              WW1(I,K+1)*DU(I,K)*EM1V(IT1(I,K+1)+28)+ &
+              DTE1(I,K+1)*DU(I,K)*EM1V(IT1(I,K+1)+29)
+      G2(I,K)=WW1(I,K)*WW2(I,K+1)*EM1V(IT1(I,K+LP2-1))+ &
+              WW2(I,K+1)*DTE1(I,K)*EM1V(IT1(I,K+LP2-1)+1)+ &
+              WW1(I,K)*DU(I,K)*EM1V(IT1(I,K+LP2-1)+28)+ &
+              DTE1(I,K)*DU(I,K)*EM1V(IT1(I,K+LP2-1)+29)
+240   CONTINUE
+      DO 241 KP=2,LP1
+      DO 241 I=MYIS,MYIE
+      G3(I,KP)=WW1(I,1)*WW2(I,KP)*EM1V(IT1(I,LL+KP))+ &
+              WW2(I,KP)*DTE1(I,1)*EM1V(IT1(I,LL+KP)+1)+ &
+              WW1(I,1)*DU(I,KP-1)*EM1V(IT1(I,LL+KP)+28)+ &
+              DTE1(I,1)*DU(I,KP-1)*EM1V(IT1(I,LL+KP)+29)
+241   CONTINUE
+!
+      DO 244 I=MYIS,MYIE
+      G4(I,1)=WW1(I,1)*WW2(I,1)*EM1VW(IT1(I,1))+ &
+              WW2(I,1)*DTE1(I,1)*EM1VW(IT1(I,1)+1)
+244   CONTINUE
+      DO 242 K=1,L
+      DO 242 I=MYIS,MYIE
+      G4(I,K+1)=WW1(I,K+1)*WW2(I,K+1)*EM1VW(IT1(I,K+1))+ &
+              WW2(I,K+1)*DTE1(I,K+1)*EM1VW(IT1(I,K+1)+1)+ &
+              WW1(I,K+1)*DU(I,K)*EM1VW(IT1(I,K+1)+28)+ &
+              DTE1(I,K+1)*DU(I,K)*EM1VW(IT1(I,K+1)+29)
+      G5(I,K)=WW1(I,K)*WW2(I,K+1)*EM1VW(IT1(I,K+LP2-1))+ &
+              WW2(I,K+1)*DTE1(I,K)*EM1VW(IT1(I,K+LP2-1)+1)+ &
+              WW1(I,K)*DU(I,K)*EM1VW(IT1(I,K+LP2-1)+28)+ &
+              DTE1(I,K)*DU(I,K)*EM1VW(IT1(I,K+LP2-1)+29)
+242   CONTINUE
+!
+  END SUBROUTINE E1E290
+
+!----------------------------------------------------------------------
+
+ SUBROUTINE SPA88(EXCTS,CTSO3,GXCTS,SORC,CSOUR,                      &
+                       CLDFAC,TEMP,PRESS,VAR1,VAR2,                  &
+                       P,DELP,DELP2,TOTVO2,TO3SP,TO3SPC,             &
+                       CO2SP1,CO2SP2,CO2SP,                          &
+                       APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+                       H25E2,ONE,H44194M2,H1P41819,HAF,HM1EZ,TWO,    &
+!                      SKO2D,RADCON,                                 &
+                       RADCON,                                 &
+                       ids,ide, jds,jde, kds,kde,                    &
+                       ims,ime, jms,jme, kms,kme,                    &
+                       its,ite, jts,jte, kts,kte                     )
+!---------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+!     INTEGER, PARAMETER :: NBLY=15
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+
+      REAL,INTENT(IN) :: H25E2,ONE,H44194M2,H1P41819,HAF,HM1EZ,TWO, &
+                         RADCON
+!                        SKO2D,RADCON
+
+      REAL,INTENT(IN),DIMENSION(its:ite,kts:kte+1) :: CSOUR
+      REAL,INTENT(OUT),DIMENSION(its:ite,kts:kte)  :: CTSO3
+      REAL,INTENT(OUT),DIMENSION(its:ite,kts:kte)  :: EXCTS
+      REAL,INTENT(OUT),DIMENSION(its:ite)          :: GXCTS
+      REAL,INTENT(IN),DIMENSION(its:ite,kts:kte+1,NBLY) :: SORC
+      REAL,INTENT(IN),DIMENSION(its:ite,kts:kte+1,kts:kte+1) :: CLDFAC
+      REAL,INTENT(IN), DIMENSION(its:ite,kts:kte+1) :: PRESS,TEMP
+
+      REAL,INTENT(IN),DIMENSION(its:ite,kts:kte) :: VAR1,VAR2 
+      REAL,INTENT(IN),DIMENSION(its:ite,kts:kte+1) :: P
+      REAL,INTENT(IN),DIMENSION(its:ite,kts:kte)   :: DELP,DELP2,TO3SPC
+      REAL,INTENT(IN),DIMENSION(its:ite,kts:kte+1) ::TOTVO2,TO3SP,CO2SP1,&
+                                                     CO2SP2,CO2SP
+      REAL,INTENT(IN),DIMENSION(NBLY) :: APCM,BPCM,ATPCM,BTPCM,ACOMB, &
+                                         BCOMB,BETACM
+
+      REAL,DIMENSION(its:ite,kts:kte+1) ::CTMP,CTMP2,CTMP3
+      REAL,DIMENSION(its:ite,kts:kte)   ::X,Y,FAC1,FAC2,F,FF,AG,AGG, &
+                                          PHITMP,PSITMP,TOPM,TOPPHI,TT
+
+      INTEGER :: K, I,KP,LLM2,J1,J3,KMAX,KMIN,KCLDS,ICNT,LLM1
+      INTEGER :: L,LP1,LP2,LP3,LM1,LM2,LM3,MYIS,MYIE,LLP1,LL,KK,KLEN
+
+      L=kte
+      LP1=L+1;  LP2=L+2;  LP3=L+3; LLP1 = 2*L + 1
+      LM1=L-1;  LM2=L-2;  LM3=L-3; LL = 2*L
+      LLM2 = LL-2; LLM1=LL-1
+      MYIS=its; MYIE=ite
+
+!--!COMPUTE TEMPERATURE QUANTITIES FOR USE IN PROGRAM
+
+      DO 101 K=1,L
+      DO 101 I=MYIS,MYIE
+      X(I,K)=TEMP(I,K)-H25E2
+      Y(I,K)=X(I,K)*X(I,K)
+101   CONTINUE
+!---INITIALIZE CTMP(I,1),CTMP2(I,1),CTMP3(I,1) TO UNITY; THESE ARE
+!   TRANSMISSION FCTNS AT THE TOP.
+      DO 345 I=MYIS,MYIE
+      CTMP(I,1)=ONE
+      CTMP2(I,1)=1.
+      CTMP3(I,1)=1.
+345   CONTINUE
+!***BEGIN LOOP ON FREQUENCY BANDS (1)***
+!
+!---CALCULATION FOR BAND 1 (COMBINED BAND 1)
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 301 K=1,L
+      DO 301 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(1)*X(I,K)+BPCM(1)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(1)*X(I,K)+BTPCM(1)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+301   CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 315 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+315   CONTINUE
+      DO 319 K=2,L
+      DO 317 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+317   CONTINUE
+319   CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 321 K=1,L
+      DO 321 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(1)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(1)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*FAC1(I,K)/SQRT(1.+FAC2(I,K)))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+321   CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 353 K=1,L
+      DO 353 I=MYIS,MYIE
+      EXCTS(I,K)=SORC(I,K,1)*(CTMP(I,K+1)-CTMP(I,K))
+353   CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 361 I=MYIS,MYIE
+      GXCTS(I)=CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,1)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,1)-SORC(I,L,1)))
+361   CONTINUE
+!
+!
+!-----CALCULATION FOR BAND 2 (COMBINED BAND 2)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 401 K=1,L
+      DO 401 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(2)*X(I,K)+BPCM(2)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(2)*X(I,K)+BTPCM(2)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+401   CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 415 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+415   CONTINUE
+      DO 419 K=2,L
+      DO 417 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+417   CONTINUE
+419   CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 421 K=1,L
+      DO 421 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(2)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(2)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*FAC1(I,K)/SQRT(1.+FAC2(I,K)))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+421   CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 453 K=1,L
+      DO 453 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,2)* & 
+                   (CTMP(I,K+1)-CTMP(I,K))
+453   CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 461 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,2)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,2)-SORC(I,L,2)))
+461   CONTINUE
+!
+!-----CALCULATION FOR BAND 3 (COMBINED BAND 3)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 501 K=1,L
+      DO 501 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(3)*X(I,K)+BPCM(3)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(3)*X(I,K)+BTPCM(3)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+501   CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 515 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+515   CONTINUE
+      DO 519 K=2,L
+      DO 517 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+517   CONTINUE
+519   CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 521 K=1,L
+      DO 521 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(3)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(3)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*FAC1(I,K)/SQRT(1.+FAC2(I,K)))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+521   CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 553 K=1,L
+      DO 553 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,3)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+553   CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 561 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,3)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,3)-SORC(I,L,3)))
+561   CONTINUE
+!
+!-----CALCULATION FOR BAND 4 (COMBINED BAND 4)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 601 K=1,L
+      DO 601 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(4)*X(I,K)+BPCM(4)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(4)*X(I,K)+BTPCM(4)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+601   CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 615 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+615   CONTINUE
+      DO 619 K=2,L
+      DO 617 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+617   CONTINUE
+619   CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 621 K=1,L
+      DO 621 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(4)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(4)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*FAC1(I,K)/SQRT(1.+FAC2(I,K)))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+621   CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 653 K=1,L
+      DO 653 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,4)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+653   CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 661 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,4)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,4)-SORC(I,L,4)))
+661   CONTINUE
+!
+!-----CALCULATION FOR BAND 5 (COMBINED BAND 5)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 701 K=1,L
+      DO 701 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(5)*X(I,K)+BPCM(5)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(5)*X(I,K)+BTPCM(5)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+701   CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 715 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+715   CONTINUE
+      DO 719 K=2,L
+      DO 717 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+717   CONTINUE
+719   CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 721 K=1,L
+      DO 721 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(5)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(5)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(5)*TOTVO2(I,K+1)*SKO2D))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+721   CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 753 K=1,L
+      DO 753 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,5)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+753   CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 761 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,5)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,5)-SORC(I,L,5)))
+761   CONTINUE
+!
+!-----CALCULATION FOR BAND 6 (COMBINED BAND 6)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 801 K=1,L
+      DO 801 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(6)*X(I,K)+BPCM(6)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(6)*X(I,K)+BTPCM(6)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+801   CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 815 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+815   CONTINUE
+      DO 819 K=2,L
+      DO 817 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+817   CONTINUE
+819   CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 821 K=1,L
+      DO 821 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(6)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(6)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(6)*TOTVO2(I,K+1)*SKO2D))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+821   CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 853 K=1,L
+      DO 853 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,6)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+853   CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 861 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,6)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,6)-SORC(I,L,6)))
+861   CONTINUE
+!
+!-----CALCULATION FOR BAND 7 (COMBINED BAND 7)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 901 K=1,L
+      DO 901 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(7)*X(I,K)+BPCM(7)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(7)*X(I,K)+BTPCM(7)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+901   CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 915 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+915   CONTINUE
+      DO 919 K=2,L
+      DO 917 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+917   CONTINUE
+919   CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 921 K=1,L
+      DO 921 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(7)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(7)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(7)*TOTVO2(I,K+1)*SKO2D))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+921   CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 953 K=1,L
+      DO 953 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,k,7)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+953   CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 961 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,7)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,7)-SORC(I,L,7)))
+961   CONTINUE
+!
+!-----CALCULATION FOR BAND 8 (COMBINED BAND 8)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 1001 K=1,L
+      DO 1001 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(8)*X(I,K)+BPCM(8)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(8)*X(I,K)+BTPCM(8)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+1001  CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 1015 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+1015  CONTINUE
+      DO 1019 K=2,L
+      DO 1017 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+1017  CONTINUE
+1019  CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 1021 K=1,L
+      DO 1021 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(8)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(8)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(8)*TOTVO2(I,K+1)*SKO2D))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+1021  CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 1053 K=1,L
+      DO 1053 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,8)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+1053  CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 1061 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,8)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,8)-SORC(I,L,8)))
+1061  CONTINUE
+!
+!-----CALCULATION FOR BAND 9 ( 560-670 CM-1; INCLUDES CO2)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 1101 K=1,L
+      DO 1101 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(9)*X(I,K)+BPCM(9)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(9)*X(I,K)+BTPCM(9)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+1101  CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 1115 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+1115  CONTINUE
+      DO 1119 K=2,L
+      DO 1117 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+1117  CONTINUE
+1119  CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 1121 K=1,L
+      DO 1121 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(9)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(9)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(9)*TOTVO2(I,K+1)*SKO2D))*CO2SP1(I,K+1)
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+1121  CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 1153 K=1,L
+      DO 1153 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,9)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+1153  CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 1161 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,9)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,9)-SORC(I,L,9)))
+1161  CONTINUE
+!
+!-----CALCULATION FOR BAND 10 (670-800 CM-1; INCLUDES CO2)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 1201 K=1,L
+      DO 1201 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(10)*X(I,K)+BPCM(10)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(10)*X(I,K)+BTPCM(10)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+1201  CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 1215 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+1215  CONTINUE
+      DO 1219 K=2,L
+      DO 1217 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+1217  CONTINUE
+1219  CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 1221 K=1,L
+      DO 1221 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(10)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(10)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(10)*TOTVO2(I,K+1)*SKO2D))*CO2SP2(I,K+1)
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+1221  CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 1253 K=1,L
+      DO 1253 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,10)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+1253  CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 1261 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,10)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,10)-SORC(I,L,10)))
+1261  CONTINUE
+!
+!-----CALCULATION FOR BAND 11 (800-900 CM-1)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 1301 K=1,L
+      DO 1301 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(11)*X(I,K)+BPCM(11)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(11)*X(I,K)+BTPCM(11)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+1301  CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 1315 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+1315  CONTINUE
+      DO 1319 K=2,L
+      DO 1317 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+1317  CONTINUE
+1319  CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 1321 K=1,L
+      DO 1321 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(11)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(11)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(11)*TOTVO2(I,K+1)*SKO2D))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+1321  CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 1353 K=1,L
+      DO 1353 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,11)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+1353  CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 1361 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,11)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,11)-SORC(I,L,11)))
+1361  CONTINUE
+!
+!-----CALCULATION FOR BAND 12 (900-990 CM-1)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 1401 K=1,L
+      DO 1401 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(12)*X(I,K)+BPCM(12)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(12)*X(I,K)+BTPCM(12)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+1401  CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 1415 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+1415  CONTINUE
+      DO 1419 K=2,L
+      DO 1417 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+1417  CONTINUE
+1419  CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 1421 K=1,L
+      DO 1421 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(12)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(12)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(12)*TOTVO2(I,K+1)*SKO2D))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+1421  CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 1453 K=1,L
+      DO 1453 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,12)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+1453  CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 1461 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,12)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,12)-SORC(I,L,12)))
+1461  CONTINUE
+!
+!-----CALCULATION FOR BAND 13 (990-1070 CM-1; INCLUDES O3))
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 1501 K=1,L
+      DO 1501 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(13)*X(I,K)+BPCM(13)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(13)*X(I,K)+BTPCM(13)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+1501  CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 1515 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+1515  CONTINUE
+      DO 1519 K=2,L
+      DO 1517 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+1517  CONTINUE
+1519  CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 1521 K=1,L
+      DO 1521 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(13)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(13)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(13)*TOTVO2(I,K+1)*SKO2D+TO3SPC(I,K)))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+1521  CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 1553 K=1,L
+      DO 1553 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,13)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+1553  CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 1561 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,13)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,13)-SORC(I,L,13)))
+1561  CONTINUE
+!
+!-----CALCULATION FOR BAND 14 (1070-1200 CM-1)
+!
+!
+!---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
+!   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
+!   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
+      DO 1601 K=1,L
+      DO 1601 I=MYIS,MYIE
+      F(I,K)=H44194M2*(APCM(14)*X(I,K)+BPCM(14)*Y(I,K))
+      FF(I,K)=H44194M2*(ATPCM(14)*X(I,K)+BTPCM(14)*Y(I,K))
+      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
+      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
+      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
+      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
+1601  CONTINUE
+!---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
+!   P(K) (TOPM,TOPPHI)
+      DO 1615 I=MYIS,MYIE
+      TOPM(I,1)=PHITMP(I,1)
+      TOPPHI(I,1)=PSITMP(I,1)
+1615  CONTINUE
+      DO 1619 K=2,L
+      DO 1617 I=MYIS,MYIE
+      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
+      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
+1617  CONTINUE
+1619  CONTINUE
+!---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
+      DO 1621 K=1,L
+      DO 1621 I=MYIS,MYIE
+      FAC1(I,K)=ACOMB(14)*TOPM(I,K)
+      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(14)*TOPPHI(I,K))
+      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+ &
+                 BETACM(14)*TOTVO2(I,K+1)*SKO2D))
+      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
+1621  CONTINUE
+!---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
+      DO 1653 K=1,L
+      DO 1653 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,14)* &
+                   (CTMP(I,K+1)-CTMP(I,K))
+1653  CONTINUE
+!---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
+      DO 1661 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,14)+ &
+         (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) + &
+         TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) * &
+         (SORC(I,LP1,14)-SORC(I,L,14)))
+1661  CONTINUE
+!
+!
+!   OBTAIN CTS FLUX AT THE TOP BY INTEGRATION OF HEATING RATES AND
+!   USING CTS FLUX AT THE BOTTOM (CURRENT VALUE OF GXCTS). NOTE
+!   THAT THE PRESSURE QUANTITIES AND CONVERSION FACTORS HAVE NOT
+!   BEEN INCLUDED EITHER IN EXCTS OR IN GXCTS. THESE CANCEL OUT, THUS
+!   REDUCING COMPUTATIONS!
+      DO 1731 K=1,L
+      DO 1731 I=MYIS,MYIE
+      GXCTS(I)=GXCTS(I)-EXCTS(I,K)
+1731  CONTINUE
+!
+!   NOW SCALE THE COOLING RATE (EXCTS) BY INCLUDING THE PRESSURE
+!   FACTOR (DELP) AND THE CONVERSION FACTOR (RADCON)
+      DO 1741 K=1,L
+      DO 1741 I=MYIS,MYIE
+      EXCTS(I,K)=EXCTS(I,K)*RADCON*DELP(I,K)
+1741  CONTINUE
+!---THIS IS THE END OF THE EXACT CTS COMPUTATIONS; AT THIS POINT
+!   EXCTS HAS ITS APPROPRIATE VALUE.
+!
+!*** COMPUTE APPROXIMATE CTS HEATING RATES FOR 15UM AND 9.6 UM BANDS
+!     (CTSO3)
+      DO 1711 K=1,L
+      DO 1711 I=MYIS,MYIE
+      CTMP2(I,K+1)=CO2SP(I,K+1)*CLDFAC(I,K+1,1)
+      CTMP3(I,K+1)=TO3SP(I,K)*CLDFAC(I,K+1,1)
+1711  CONTINUE
+      DO 1701 K=1,L
+      DO 1701 I=MYIS,MYIE
+      CTSO3(I,K)=RADCON*DELP(I,K)* &
+           (CSOUR(I,K)*(CTMP2(I,K+1)-CTMP2(I,K)) + &
+            SORC(I,K,13)*(CTMP3(I,K+1)-CTMP3(I,K)))
+1701  CONTINUE
+
+ END SUBROUTINE SPA88
+!----------------------------------------------------------------------
+
+ SUBROUTINE E290(EMISSB,EMISS,AVEPHI,KLEN,FXOE2,DTE2, &
+!                      T1,T2,T4,                                     &
+                       H16E1,HP1,H28E1,HAF,TEN,                      &
+                       ids,ide, jds,jde, kds,kde,                    &
+                       ims,ime, jms,jme, kms,kme,                    &
+                       its,ite, jts,jte, kts,kte                     )
+!---------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+      INTEGER, INTENT(IN)        :: KLEN
+      REAL, INTENT(IN) :: H16E1,HP1,H28E1,HAF ,TEN
+      REAL, INTENT(OUT),DIMENSION(its:ite,kts:kte+1) :: EMISSB
+      REAL, INTENT(IN ),DIMENSION(its:ite,kts:kte+1) :: AVEPHI,FXOE2,DTE2
+
+!     REAL, INTENT(IN ), DIMENSION(5040) :: T1,T2,T4
+
+      REAL, INTENT(INOUT), DIMENSION(its:ite,kts:kte+1) :: EMISS
+
+      REAL, DIMENSION(its:ite,kts:kte+1) :: TMP3,DT,FYO,DU
+      INTEGER, DIMENSION(its:ite,kts:kte+1) :: IVAL
+
+!     REAL,    DIMENSION(28,180) :: TABLE1,TABLE2,TABLE3
+!     EQUIVALENCE (T1(1),TABLE1(1,1)),(T2(1),TABLE2(1,1)), &
+!                 (T4(1),TABLE3(1,1))
+!     EQUIVALENCE (TMP3,DT)
+
+      INTEGER :: K, I,KP,LLM2,J1,J3,KMAX,KMIN,KCLDS,ICNT,LLM1
+      INTEGER :: L,LP1,LP2,LP3,LM1,LM2,LM3,MYIS,MYIE,LLP1,LL,KK
+
+      L=kte
+      LP1=L+1;  LP2=L+2;  LP3=L+3; LLP1 = 2*L + 1
+      LM1=L-1;  LM2=L-2;  LM3=L-3; LL = 2*L
+      LLM2 = LL-2; LLM1=LL-1
+      MYIS=its; MYIE=ite
+
+
+!---FIRST WE OBTAIN THE EMISSIVITIES AS A FUNCTION OF TEMPERATURE
+!   (INDEX FXO) AND WATER AMOUNT (INDEX FYO). THIS PART OF THE CODE
+!   THUS GENERATES THE E2 FUNCTION.
+!
+!---CALCULATIONS FOR VARYING KP (FROM KP=K+1 TO LP1, INCLUDING SPECIAL
+!   CASE: RESULTS ARE IN EMISS
+
+
+
+      DO 132 K=1,LP2-KLEN
+      DO 132 I=MYIS,MYIE
+      TMP3(I,K)=LOG10(AVEPHI(I,KLEN+K-1))+H16E1
+      FYO(I,K)=AINT(TMP3(I,K)*TEN)
+      DU(I,K)=TMP3(I,K)-HP1*FYO(I,K)
+      FYO(I,K)=H28E1*FYO(I,K)
+      IVAL(I,K)=FYO(I,K)+FXOE2(I,KLEN+K-1)
+      EMISS(I,KLEN+K-1)=T1(IVAL(I,K))+DU(I,K)*T2(IVAL(I,K)) & 
+                                 +DTE2(I,KLEN+K-1)*T4(IVAL(I,K))
+132   CONTINUE
+!---THE SPECIAL CASE EMISS(I,L) (LAYER KP) IS OBTAINED NOW
+!   BY AVERAGING THE VALUES FOR L AND LP1:
+      DO 1344 I=MYIS,MYIE
+      EMISS(I,L)=HAF*(EMISS(I,L)+EMISS(I,LP1))
+1344  CONTINUE
+!---NOTE THAT EMISS(I,LP1) IS NOT USEFUL AFTER THIS POINT.
+!
+!---CALCULATIONS FOR KP=KLEN AND VARYING K; RESULTS ARE IN EMISSB.
+!  IN THIS CASE, THE TEMPERATURE INDEX IS UNCHANGED, ALWAYS BEING
+!  FXO(I,KLEN-1); THE WATER INDEX CHANGES, BUT IS SYMMETRICAL WITH
+!  THAT FOR THE VARYING KP CASE.NOTE THAT THE SPECIAL CASE IS NOT
+!  INVOLVED HERE.
+!     (FIXED LEVEL) K VARIES FROM (KLEN+1) TO LP1; RESULTS ARE IN
+!   EMISSB(I,(KLEN) TO L)
+      DO 142 K=1,LP1-KLEN
+      DO 142 I=MYIS,MYIE
+      DT(I,K)=DTE2(I,KLEN-1)
+      IVAL(I,K)=FYO(I,K)+FXOE2(I,KLEN-1)
+142   CONTINUE
+!
+      DO 234 K=1,LP1-KLEN
+      DO 234 I=MYIS,MYIE
+      EMISSB(I,KLEN+K-1)=T1(IVAL(I,K))+DU(I,K)*T2(IVAL(I,K)) &
+                                      +DT(I,K)*T4(IVAL(I,K))
+234   CONTINUE
+
+ END SUBROUTINE E290
+
+!---------------------------------------------------------------------
+
+  SUBROUTINE E2SPEC(EMISS,AVEPHI,FXOSP,DTSP,                         &
+!                      T1,T2,T4,                                     &
+                       H16E1,TEN,H28E1,HP1,                          &
+                       ids,ide, jds,jde, kds,kde,                    &
+                       ims,ime, jms,jme, kms,kme,                    &
+                       its,ite, jts,jte, kts,kte                     )
+!---------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+      REAL,INTENT(IN ) :: H16E1,TEN,H28E1,HP1  
+      REAL,INTENT(INOUT),DIMENSION(its:ite,kts:kte+1) :: EMISS
+      REAL,INTENT(IN ),DIMENSION(its:ite,kts:kte+1) :: AVEPHI
+      REAL,INTENT(IN ),DIMENSION(its:ite,2) :: FXOSP,DTSP
+
+!     REAL, INTENT(IN ),DIMENSION(5040) :: T1,T2,T4
+
+!     REAL, DIMENSION(28,180) :: TABLE1,TABLE2,TABLE3
+!     EQUIVALENCE (T1(1),TABLE1(1,1)),(T2(1),TABLE2(1,1)), &
+!                 (T4(1),TABLE3(1,1))
+
+      INTEGER :: K,I,MYIS,MYIE
+
+      REAL,    DIMENSION(its:ite,kts:kte+1) :: TMP3,FYO,DU
+      INTEGER, DIMENSION(its:ite,kts:kte+1) :: IVAL
+
+      MYIS=its
+      MYIE=ite
+
+      DO 132 K=1,2
+      DO 132 I=MYIS,MYIE
+      TMP3(I,K)=LOG10(AVEPHI(I,K))+H16E1
+      FYO(I,K)=AINT(TMP3(I,K)*TEN)
+      DU(I,K)=TMP3(I,K)-HP1*FYO(I,K)
+      IVAL(I,K)=H28E1*FYO(I,K)+FXOSP(I,K)
+      EMISS(I,K)=T1(IVAL(I,K))+DU(I,K)*T2(IVAL(I,K))+ &
+                               DTSP(I,K)*T4(IVAL(I,K))
+132   CONTINUE
+
+  END SUBROUTINE E2SPEC
+
+!---------------------------------------------------------------------
+
+! SUBROUTINE E3V88(EMV,TV,AV,EM3V,            &
+  SUBROUTINE E3V88(EMV,TV,AV, &
+                       TEN,HP1,H28E1,H16E1,  &
+                       ids,ide, jds,jde, kds,kde,                    &
+                       ims,ime, jms,jme, kms,kme,                    &
+                       its,ite, jts,jte, kts,kte                     )
+!---------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+      REAL,    INTENT(IN)  :: TEN,HP1,H28E1,H16E1 
+!-----------------------------------------------------------------------
+      REAL, INTENT(OUT), DIMENSION(its:ite,kts:kte*2+1) :: EMV
+      REAL, INTENT(IN),  DIMENSION(its:ite,kts:kte*2+1) :: TV,AV
+!     REAL, INTENT(IN),  DIMENSION(5040) :: EM3V
+
+      REAL,DIMENSION(its:ite,kts:kte*2+1) ::FXO,TMP3,DT,WW1,WW2,DU,&
+                                            FYO
+!     REAL, DIMENSION(5040) :: EM3V
+
+!     EQUIVALENCE (EM3V(1),EM3(1,1))
+
+      INTEGER,DIMENSION(its:ite,kts:kte*2+1) ::IT
+
+      INTEGER :: LLP1,I,K,MYIS,MYIE ,L
+      L = kte
+      LLP1 = 2*L + 1
+      MYIS=its; MYIE=ite
+
+!---THE FOLLOWING LOOP REPLACES A DOUBLE LOOP OVER I (1-IMAX) AND
+!   K (1-LLP1)
+
+      DO 203 K=1,LLP1
+      DO 203 I=MYIS,MYIE
+        FXO(I,K)=AINT(TV(I,K)*HP1)
+        TMP3(I,K)=LOG10(AV(I,K))+H16E1
+        DT(I,K)=TV(I,K)-TEN*FXO(I,K)
+        FYO(I,K)=AINT(TMP3(I,K)*TEN)
+        DU(I,K)=TMP3(I,K)-HP1*FYO(I,K)
+!---OBTAIN INDEX FOR TABLE LOOKUP; THIS VALUE WILL HAVE TO BE
+!   DECREMENTED BY 9 TO ACCOUNT FOR TABLE TEMPS STARTING AT 100K.
+        IT(I,K)=FXO(I,K)+FYO(I,K)*H28E1
+        WW1(I,K)=TEN-DT(I,K)
+        WW2(I,K)=HP1-DU(I,K)
+        EMV(I,K)=WW1(I,K)*WW2(I,K)*EM3V(IT(I,K)-9)+ &
+                 WW2(I,K)*DT(I,K)*EM3V(IT(I,K)-8)+ & 
+                 WW1(I,K)*DU(I,K)*EM3V(IT(I,K)+19)+ & 
+                 DT(I,K)*DU(I,K)*EM3V(IT(I,K)+20)
+203   CONTINUE
+
+  END SUBROUTINE E3V88
+!-----------------------------------------------------------------------
+
+  SUBROUTINE SWR93(FSWC,HSWC,UFSWC,DFSWC,FSWL,HSWL,UFSWL,             &
+                       DFSWL,                                         &
+                       PRESS,COSZRO,TAUDAR,RH2O,RRCO2,SSOLAR,QO3,     &
+                       NCLDS,KTOPSW,KBTMSW,CAMT,CRR,CTT,              &
+                       ALVB,ALNB,ALVD,ALND,GDFVB,GDFNB,GDFVD,GDFND,   &
+!                      UCO2,UO3,TUCO2,TUO3,TDO3,TDCO2,                &
+                       ABCFF,PWTS,                                    &
+                       H35E1,H1224E3,ONE,ZERO,HAF,H69766E5,HP219,     &
+                       HP816,RRAYAV,GINV,CFCO2,CFO3,                  &
+                       TWO,H235M3,HP26,H129M2,H75826M4,H1036E2,       &
+                       H1P082,HMP805,H1386E2,H658M2,H2118M2,H42M2,    &
+                       H323M4,HM1EZ,DIFFCTR,O3DIFCTR,FIFTY,RADCON,    &
+                       ids,ide, jds,jde, kds,kde,                     &
+                       ims,ime, jms,jme, kms,kme,                     &
+                       its,ite, jts,jte, kts,kte                      )
+!----------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+      REAL,INTENT(IN) :: RRCO2,SSOLAR
+      REAL,INTENT(IN) :: H35E1,H1224E3,ONE,ZERO,HAF,H69766E5,HP219,HP816,RRAYAV,&
+                         GINV,CFCO2,CFO3
+      REAL,INTENT(IN) :: TWO,H235M3,HP26,H129M2,H75826M4,H1036E2  
+      REAL,INTENT(IN) :: H1P082,HMP805,H1386E2,H658M2,H2118M2,H42M2,H323M4,HM1EZ
+      REAL,INTENT(IN) :: DIFFCTR,O3DIFCTR,FIFTY,RADCON
+!----------------------------------------------------------------------
+      INTEGER, PARAMETER :: NB=12
+      REAL,    INTENT(IN ),DIMENSION(its:ite,kts:kte+1) :: PRESS,CAMT
+      REAL,    INTENT(IN ),DIMENSION(its:ite,kts:kte) :: RH2O,QO3
+      REAL,    INTENT(IN ),DIMENSION(its:ite) :: COSZRO,TAUDAR,ALVB,ALVD,ALNB,ALND
+      INTEGER, INTENT(IN ),DIMENSION(its:ite) :: NCLDS
+      INTEGER, INTENT(IN ),DIMENSION(its:ite,kts:kte+1) ::KTOPSW,KBTMSW
+      REAL, INTENT(IN ),DIMENSION(its:ite,NB,kts:kte+1) ::CRR,CTT
+           
+      REAL, INTENT(OUT),DIMENSION(its:ite,kts:kte+1) ::     &
+                                       FSWC,HSWC,UFSWC,DFSWC,FSWL,HSWL,UFSWL,DFSWL
+      REAL, INTENT(OUT),DIMENSION(its:ite) :: GDFVB,GDFVD,GDFNB,GDFND
+      REAL, INTENT(IN), DIMENSION(NB) :: ABCFF,PWTS
+
+!     REAL, INTENT(IN), DIMENSION(its:ite,kts:kte*2+2) :: UCO2,UO3
+!     REAL, INTENT(IN), DIMENSION(its:ite,kts:kte+1)   :: TUCO2,TUO3,TDO3,TDCO2
+
+      REAL, DIMENSION(its:ite,kts:kte*2+2) :: UCO2,UO3
+      REAL, DIMENSION(its:ite,kts:kte+1)   :: TUCO2,TUO3,TDO3,TDCO2
+
+      REAL, DIMENSION(its:ite,kts:kte*2+2) :: TCO2,TO3
+      REAL, DIMENSION(its:ite,kts:kte+1) :: PP,DP,PR2,DU,DUCO2,DUO3,UD,TTD
+      REAL, DIMENSION(its:ite,kts:kte+1) :: UDCO2,UDO3,UR,URCO2,URO3,TTU
+      REAL, DIMENSION(its:ite,kts:kte+1) :: DFN,UFN
+      REAL, DIMENSION(its:ite,kts:kte+1) :: XAMT,FF,FFCO2,FFO3,CR,CT
+      REAL, DIMENSION(its:ite,kts:kte+1) :: PPTOP,DPCLD,TTDB1,TTUB1
+      REAL, DIMENSION(its:ite,kts:kte+1) :: TDCL1,TUCL1,TDCL2,DFNTRN,  &
+                                            UFNTRN,TCLU,TCLD,ALFA,ALFAU, &
+                                            UFNCLU,DFNCLU
+
+      REAL, DIMENSION(its:ite,NB) :: DFNTOP
+      REAL, DIMENSION(its:ite) :: SECZ,TMP1,RRAY,REFL,REFL2,CCMAX
+
+!                    EQUIVALENCE &
+!       (UDO3,UO3(its,1),DFNCLU), (URO3,UO3(its,kte+2), UFNCLU) &
+!     , (UDCO2,UCO2(its,1),TCLD), (URCO2,UCO2(its,kte+2), TCLU) &
+!     , (TDO3 ,TO3(its,1),DFNTRN),(TUO3,TO3(its,kte+2), UFNTRN) &
+!     , (TDCO2,TCO2(its,1)      ),(TUCO2,TCO2(its,kte+2)        ) &
+!     , (FF   , ALFA ),   (FFCO2 , ALFAU ),   (FFO3  , TTDB1 ) &
+!     , (DU   , TTUB1),   (DUCO2 , TUCL1 ),   (DUO3  , TDCL1 ) &
+!     , (PR2  , TDCL2)
+
+!                    EQUIVALENCE &
+!       (UDO3,DFNCLU), (URO3,UFNCLU) &
+!     , (UDCO2,TCLD ), (URCO2,TCLU) &
+!     , (TDO3 ,DFNTRN),(TUO3,UFNTRN) &
+!!    , (TDCO2,TCO2(its,1)      ),(TUCO2,TCO2(its,kte+2)        ) &
+!     , (FF   , ALFA ),   (FFCO2 , ALFAU ),   (FFO3  , TTDB1 ) &
+!     , (DU   , TTUB1),   (DUCO2 , TUCL1 ),   (DUO3  , TDCL1 ) &
+!     , (PR2  , TDCL2)
+
+      INTEGER :: K,I,KP,N,IP,MYIS1,KCLDS,NNCLDS,JTOP,KK,J2,J3,J1
+      INTEGER :: L,LP1,LP2,LP3,LM1,LM2,LM3,MYIS,MYIE,LLP1,LL
+      REAL    :: DENOM,HTEMP,TEMPF,TEMPG
+
+      L=kte
+      LP1=L+1;  LP2=L+2;  LP3=L+3; LLP1 = 2*L + 1
+      LM1=L-1;  LM2=L-2;  LM3=L-3; LL = 2*L
+      MYIS=its; MYIE=ite
+      MYIS1=MYIS+1    ! ??
+
+      DO 100 I=MYIS,MYIE
+        SECZ(I) = H35E1/SQRT(H1224E3*COSZRO(I)*COSZRO(I)+ONE)
+        PP(I,1)   = ZERO
+        PP(I,LP1) = PRESS(I,LP1)
+        TMP1(I)  = ONE/PRESS(I,LP1)
+100   CONTINUE
+      DO 110 K=1,LM1
+      DO 110 I=MYIS,MYIE
+        PP(I,K+1) = HAF*(PRESS(I,K+1)+PRESS(I,K))
+110   CONTINUE
+      DO 120 K=1,L
+      DO 120 I=MYIS,MYIE
+        DP (I,K) = PP(I,K+1)-PP(I,K)
+        PR2(I,K) = HAF*(PP(I,K)+PP(I,K+1))
+120   CONTINUE
+      DO 130 K=1,L
+      DO 130 I=MYIS,MYIE
+        PR2(I,K) = PR2(I,K)*TMP1(I)
+130   CONTINUE
+!     CALCULATE ENTERING FLUX AT THE TOP FOR EACH BAND(IN CGS UNITS)
+      DO 140 N=1,NB
+      DO 140 IP=MYIS,MYIE
+        DFNTOP(IP,N) = SSOLAR*H69766E5*COSZRO(IP)*TAUDAR(IP)*PWTS(N)
+140   CONTINUE
+!     EXECUTE THE LACIS-HANSEN REFLECTIVITY PARAMETERIZATION
+!     FOR THE VISIBLE BAND
+      DO 150 I=MYIS,MYIE
+        RRAY(I) = HP219/(ONE+HP816*COSZRO(I))
+        REFL(I) = RRAY(I) + (ONE-RRAY(I))*(ONE-RRAYAV)*ALVB(I)/ &
+                  (ONE-ALVD(I)*RRAYAV)
+150   CONTINUE
+      DO 155 I=MYIS,MYIE
+        RRAY(I) = 0.104/(ONE+4.8*COSZRO(I))
+        REFL2(I)= RRAY(I) + (ONE-RRAY(I))*(ONE-0.093)*ALVB(I)/ &
+                  (ONE-ALVD(I)*0.093)
+155   CONTINUE
+!     CALCULATE PRESSURE-WEIGHTED OPTICAL PATHS FOR EACH LAYER
+!     IN UNITS OF CM-ATM. PRESSURE WEIGHTING IS USING PR2.
+!     DU= VALUE FOR H2O;DUCO2 FOR CO2;DUO3 FOR O3.
+      DO 160 K=1,L
+      DO 160 I=MYIS,MYIE
+        DU   (I,K) = GINV*RH2O(I,K)*DP(I,K)*PR2(I,K)
+        DUCO2(I,K) = (RRCO2*GINV*CFCO2)*DP(I,K)*PR2(I,K)
+        DUO3 (I,K) = (GINV*CFO3)*QO3(I,K)*DP(I,K)
+160   CONTINUE
+!
+!                 CALCULATE CLEAR SKY SW FLUX
+!
+!     OBTAIN THE OPTICAL PATH FROM THE TOP OF THE ATMOSPHERE TO THE
+!     FLUX PRESSURE. ANGULAR FACTORS ARE NOW INCLUDED. UD=DOWNWARD
+!     PATH FOR H2O,WIGTH UR THE UPWARD PATH FOR H2O. CORRESPONDING
+!     QUANTITIES FOR CO2,O3 ARE UDCO2/URCO2 AND UDO3/URO3.
+      DO 200 IP=MYIS,MYIE
+        UD   (IP,1) = ZERO
+        UDCO2(IP,1) = ZERO
+        UDO3 (IP,1) = ZERO
+! SH
+        UO3  (IP,1) = UDO3 (IP,1)
+        UCO2 (IP,1) = UDCO2(IP,1)
+
+200   CONTINUE
+      DO 210 K=2,LP1
+      DO 210 I=MYIS,MYIE
+        UD   (I,K) = UD   (I,K-1)+DU   (I,K-1)*SECZ(I)
+        UDCO2(I,K) = UDCO2(I,K-1)+DUCO2(I,K-1)*SECZ(I)
+        UDO3 (I,K) = UDO3 (I,K-1)+DUO3 (I,K-1)*SECZ(I)
+! SH
+        UO3  (I,K) = UDO3 (I,K)
+        UCO2 (I,K) = UDCO2(I,K)
+
+210   CONTINUE
+      DO 220 IP=MYIS,MYIE
+        UR   (IP,LP1) = UD   (IP,LP1)
+        URCO2(IP,LP1) = UDCO2(IP,LP1)
+        URO3 (IP,LP1) = UDO3 (IP,LP1)
+! SH
+        UO3  (IP,LP1+LP1) = URO3 (IP,LP1) 
+        UCO2 (IP,LP1+LP1) = URCO2(IP,LP1)
+
+220   CONTINUE
+      DO 230 K=L,1,-1
+      DO 230 IP=MYIS,MYIE
+        UR   (IP,K) = UR   (IP,K+1)+DU   (IP,K)*DIFFCTR
+        URCO2(IP,K) = URCO2(IP,K+1)+DUCO2(IP,K)*DIFFCTR
+        URO3 (IP,K) = URO3 (IP,K+1)+DUO3 (IP,K)*O3DIFCTR
+! SH
+        UO3 (IP,LP1+K) = URO3 (IP,K)
+        UCO2(IP,LP1+K) = URCO2(IP,K)
+
+230   CONTINUE
+!     CALCULATE CO2 ABSORPTIONS . THEY WILL BE USED IN NEAR INFRARED
+!     BANDS.SINCE THE ABSORPTION AMOUNT IS GIVEN (IN THE FORMULA USED
+!     BELOW, DERIVED FROM SASAMORI) IN TERMS OF THE TOTAL SOLAR FLUX,
+!     AND THE ABSORPTION IS ONLY INCLUDED IN THE NEAR IR (50 PERCENT
+!     OF THE SOLAR SPECTRUM), THE ABSORPTIONS ARE MULTIPLIED BY 2.
+!       SINCE CODE ACTUALLY REQUIRES TRANSMISSIONS, THESE ARE THE
+!     VALUES ACTUALLY STORED IN TCO2.
+      DO 240 K=1,LL
+      DO 240 I=MYIS,MYIE
+       TCO2(I,K+1)=ONE-TWO*(H235M3*EXP(HP26*LOG(UCO2(I,K+1)+H129M2)) &
+                             -H75826M4)
+240   CONTINUE
+
+! SH
+      DO 241 K=1,L
+      DO 241 I=MYIS,MYIE
+        TDCO2(I,K+1)=TCO2(I,K+1)
+241   CONTINUE
+      DO 242 K=1,L
+      DO 242 I=MYIS,MYIE
+        TUCO2(I,K)=TCO2(I,LP1+K)
+242   CONTINUE
+
+!     NOW CALCULATE OZONE ABSORPTIONS. THESE WILL BE USED IN
+!     THE VISIBLE BAND.JUST AS IN THE CO2 CASE, SINCE THIS BAND IS
+!     50 PERCENT OF THE SOLAR SPECTRUM,THE ABSORPTIONS ARE MULTIPLIED
+!     BY 2. THE TRANSMISSIONS ARE STORED IN TO3.
+      HTEMP = H1036E2*H1036E2*H1036E2
+      DO 250 K=1,LL
+      DO 250 I=MYIS,MYIE
+        TO3(I,K+1)=ONE-TWO*UO3(I,K+1)* &
+                  (H1P082*EXP(HMP805*LOG(ONE+H1386E2*UO3(I,K+1)))+ &
+                  H658M2/(ONE+HTEMP*UO3(I,K+1)*UO3(I,K+1)*UO3(I,K+1))+ &
+                  H2118M2/(ONE+UO3(I,K+1)*(H42M2+H323M4*UO3(I,K+1))))
+250   CONTINUE
+
+! SH
+      DO 251 K=1,L
+      DO 251 I=MYIS,MYIE
+        TDO3(I,K+1)=TO3(I,K+1)
+251   CONTINUE
+      DO 252 K=1,L
+      DO 252 I=MYIS,MYIE
+        TUO3(I,K)=TO3(I,LP1+K)
+252   CONTINUE
+
+
+!   START FREQUENCY LOOP (ON N) HERE
+!
+!--- BAND 1 (VISIBLE) INCLUDES O3 AND H2O ABSORPTION
+      DO 260 K=1,L
+      DO 260 I=MYIS,MYIE
+        TTD(I,K+1) = EXP(HM1EZ*MIN(FIFTY,ABCFF(1)*UD(I,K+1)))
+        TTU(I,K) = EXP(HM1EZ*MIN(FIFTY,ABCFF(1)*UR(I,K)))
+        DFN(I,K+1) = TTD(I,K+1)*TDO3(I,K+1)
+        UFN(I,K) = TTU(I,K)*TUO3(I,K)
+260   CONTINUE
+      DO 270 I=MYIS,MYIE
+        DFN(I,1)   = ONE
+        UFN(I,LP1) = DFN(I,LP1)
+270   CONTINUE
+!     SCALE VISIBLE BAND FLUXES BY SOLAR FLUX AT THE TOP OF THE
+!     ATMOSPHERE (DFNTOP(I,1))
+!     DFSW/UFSW WILL BE THE FLUXES, SUMMED OVER ALL BANDS
+      DO 280  K=1,LP1
+      DO 280  I=MYIS,MYIE
+        DFSWL(I,K) =         DFN(I,K)*DFNTOP(I,1)
+        UFSWL(I,K) = REFL(I)*UFN(I,K)*DFNTOP(I,1)
+280   CONTINUE
+      DO 285 I=MYIS,MYIE
+        GDFVB(I) = DFSWL(I,LP1)*EXP(-0.15746*SECZ(I))
+        GDFVD(I) = ((ONE-REFL2(I))*DFSWL(I,LP1) - &
+                    (ONE-ALVB(I)) *GDFVB(I)) / (ONE-ALVD(I))
+        GDFNB(I) = ZERO
+        GDFND(I) = ZERO
+285   CONTINUE
+!---NOW OBTAIN FLUXES FOR THE NEAR IR BANDS. THE METHODS ARE THE SAME
+!   AS FOR THE VISIBLE BAND, EXCEPT THAT THE REFLECTION AND
+!   TRANSMISSION COEFFICIENTS (OBTAINED BELOW) ARE DIFFERENT, AS
+!   RAYLEIGH SCATTERING NEED NOT BE CONSIDERED.
+      DO 350 N=2,NB
+        IF (N.EQ.2) THEN
+!   THE WATER VAPOR TRANSMISSION FUNCTION FOR BAND 2 IS EQUAL TO
+!   THAT OF BAND 1 (SAVED AS TTD,TTU)
+!--- BAND 2-9 (NEAR-IR) INCLUDES O3, CO2 AND H2O ABSORPTION
+          DO 290 K=1,L
+          DO 290 I=MYIS,MYIE
+            DFN(I,K+1) = TTD(I,K+1)*TDCO2(I,K+1)
+            UFN(I,K) = TTU(I,K)*TUCO2(I,K)
+290       CONTINUE
+        ELSE
+!   CALCULATE WATER VAPOR TRANSMISSION FUNCTIONS FOR NEAR INFRARED
+!   BANDS. INCLUDE CO2 TRANSMISSION (TDCO2/TUCO2), WHICH
+!   IS THE SAME FOR ALL INFRARED BANDS.
+          DO 300 K=1,L
+          DO 300 I=MYIS,MYIE
+            DFN(I,K+1)=EXP(HM1EZ*MIN(FIFTY,ABCFF(N)*UD(I,K+1))) &
+                       *TDCO2(I,K+1)
+            UFN(I,K)=EXP(HM1EZ*MIN(FIFTY,ABCFF(N)*UR(I,K))) &
+                     *TUCO2(I,K)
+300       CONTINUE
+        ENDIF
+!---AT THIS POINT,INCLUDE DFN(1),UFN(LP1), NOTING THAT DFN(1)=1 FOR
+!   ALL BANDS, AND THAT UFN(LP1)=DFN(LP1) FOR ALL BANDS.
+        DO 310 I=MYIS,MYIE
+          DFN(I,1)   = ONE
+          UFN(I,LP1) = DFN(I,LP1)
+310     CONTINUE
+!     SCALE THE PREVIOUSLY COMPUTED FLUXES BY THE FLUX AT THE TOP
+!     AND SUM OVER BANDS
+        DO 320 K=1,LP1
+        DO 320 I=MYIS,MYIE
+          DFSWL(I,K) = DFSWL(I,K) +         DFN(I,K)*DFNTOP(I,N)
+          UFSWL(I,K) = UFSWL(I,K) + ALNB(I)*UFN(I,K)*DFNTOP(I,N)
+320     CONTINUE
+        DO 330 I=MYIS,MYIE
+          GDFNB(I) = GDFNB(I) + DFN(I,LP1)*DFNTOP(I,N)
+330     CONTINUE
+350   CONTINUE
+      DO 360 K=1,LP1
+      DO 360 I=MYIS,MYIE
+        FSWL(I,K) = UFSWL(I,K)-DFSWL(I,K)
+360   CONTINUE
+      DO 370 K=1,L
+      DO 370 I=MYIS,MYIE
+        HSWL(I,K)=RADCON*(FSWL(I,K+1)-FSWL(I,K))/DP(I,K)
+370   CONTINUE
+!
+!---END OF FREQUENCY LOOP (OVER N)
+!
+!                 CALCULATE CLOUDY SKY SW FLUX
+!
+      KCLDS=NCLDS(MYIS)
+      DO 400 I=MYIS1,MYIE
+        KCLDS=MAX(NCLDS(I),KCLDS)
+400   CONTINUE
+        DO 410 K=1,LP1
+        DO 410 I=MYIS,MYIE
+          DFSWC(I,K) = DFSWL(I,K)
+          UFSWC(I,K) = UFSWL(I,K)
+          FSWC (I,K) = FSWL (I,K)
+410     CONTINUE
+        DO 420 K=1,L
+        DO 420 I=MYIS,MYIE
+          HSWC(I,K) = HSWL(I,K)
+420     CONTINUE
+!*******************************************************************
+      IF (KCLDS .EQ. 0)  RETURN
+!*******************************************************************
+      DO 430 K=1,LP1
+      DO 430 I=MYIS,MYIE
+        XAMT(I,K) = CAMT(I,K)
+430   CONTINUE
+      DO 470 I=MYIS,MYIE
+        NNCLDS   = NCLDS(I)
+        CCMAX(I) = ZERO
+        IF (NNCLDS .LE. 0) GO TO 470
+        CCMAX(I) = ONE
+        DO 450 K=1,NNCLDS
+          CCMAX(I) = CCMAX(I) * (ONE - CAMT(I,K+1))
+450     CONTINUE
+        CCMAX(I) = ONE - CCMAX(I)
+        IF (CCMAX(I) .GT. ZERO) THEN
+          DO 460 K=1,NNCLDS
+            XAMT(I,K+1) = CAMT(I,K+1)/CCMAX(I)
+460       CONTINUE
+        END IF
+470   CONTINUE
+      DO 480 K=1,LP1
+      DO 480 I=MYIS,MYIE
+        FF   (I,K) = DIFFCTR
+        FFCO2(I,K) = DIFFCTR
+        FFO3 (I,K) = O3DIFCTR
+480   CONTINUE
+      DO 490 IP=MYIS,MYIE
+        JTOP = KTOPSW(IP,NCLDS(IP)+1)
+      DO 490 K=1,JTOP
+        FF   (IP,K) = SECZ(IP)
+        FFCO2(IP,K) = SECZ(IP)
+        FFO3 (IP,K) = SECZ(IP)
+490   CONTINUE
+      DO 500 I=MYIS,MYIE
+        RRAY(I) = HP219/(ONE+HP816*COSZRO(I))
+        REFL(I) = RRAY(I) + (ONE-RRAY(I))*(ONE-RRAYAV)*ALVD(I)/ &
+                  (ONE-ALVD(I)*RRAYAV)
+500   CONTINUE
+      DO 510 IP=MYIS,MYIE
+        UD   (IP,1) = ZERO
+        UDCO2(IP,1) = ZERO
+        UDO3 (IP,1) = ZERO
+! SH
+        UO3  (IP,1) = UDO3 (IP,1)
+        UCO2 (IP,1) = UDCO2(IP,1)
+
+510   CONTINUE
+      DO 520 K=2,LP1
+      DO 520 I=MYIS,MYIE
+        UD   (I,K) = UD   (I,K-1)+DU   (I,K-1)*FF   (I,K)
+        UDCO2(I,K) = UDCO2(I,K-1)+DUCO2(I,K-1)*FFCO2(I,K)
+        UDO3 (I,K) = UDO3 (I,K-1)+DUO3 (I,K-1)*FFO3 (I,K)
+! SH
+        UO3 (I,K)  = UDO3 (I,K)
+        UCO2(I,K)  = UDCO2(I,K)
+
+520   CONTINUE
+      DO 530 IP=MYIS,MYIE
+        UR   (IP,LP1) = UD   (IP,LP1)
+        URCO2(IP,LP1) = UDCO2(IP,LP1)
+        URO3 (IP,LP1) = UDO3 (IP,LP1)
+! SH
+        UO3  (IP,LP1+LP1) = URO3 (IP,LP1)
+        UCO2 (IP,LP1+LP1) = URCO2(IP,LP1)
+
+530   CONTINUE
+      DO 540 K=L,1,-1
+      DO 540 IP=MYIS,MYIE
+        UR   (IP,K) = UR   (IP,K+1)+DU   (IP,K)*DIFFCTR
+        URCO2(IP,K) = URCO2(IP,K+1)+DUCO2(IP,K)*DIFFCTR
+        URO3 (IP,K) = URO3 (IP,K+1)+DUO3 (IP,K)*O3DIFCTR
+! SH
+        UO3 (IP,LP1+K) = URO3 (IP,K)
+        UCO2(IP,LP1+K) = URCO2(IP,K)
+
+540   CONTINUE
+      DO 550 K=1,LL
+      DO 550 I=MYIS,MYIE
+        TCO2(I,K+1)=ONE-TWO*(H235M3*EXP(HP26*LOG(UCO2(I,K+1)+H129M2)) &
+                              -H75826M4)
+550   CONTINUE
+! SH
+      DO 551 K=1,L
+      DO 551 I=MYIS,MYIE
+        TDCO2(I,K+1)=TCO2(I,K+1)
+551   CONTINUE
+      DO 552 K=1,L
+      DO 552 I=MYIS,MYIE
+        TUCO2(I,K)=TCO2(I,LP1+K)
+552   CONTINUE
+
+      DO 560 K=1,LL
+      DO 560 I=MYIS,MYIE
+        TO3(I,K+1)=ONE-TWO*UO3(I,K+1)* &
+                 (H1P082*EXP(HMP805*LOG(ONE+H1386E2*UO3(I,K+1)))+ &
+                H658M2/(ONE+HTEMP*UO3(I,K+1)*UO3(I,K+1)*UO3(I,K+1))+ &
+                H2118M2/(ONE+UO3(I,K+1)*(H42M2+H323M4*UO3(I,K+1))))
+560   CONTINUE
+! SH
+      DO 561 K=1,L
+      DO 561 I=MYIS,MYIE
+        TDO3(I,K+1)=TO3(I,K+1)
+561   CONTINUE
+      DO 562 K=1,L
+      DO 562 I=MYIS,MYIE
+        TUO3(I,K)=TO3(I,LP1+K)
+562   CONTINUE
+
+!********************************************************************
+!---THE FIRST CLOUD IS THE GROUND; ITS PROPERTIES ARE GIVEN
+!   BY REFL (THE TRANSMISSION (0) IS IRRELEVANT FOR NOW!).
+!********************************************************************
+      DO 570 I=MYIS,MYIE
+        CR(I,1) = REFL(I)
+570   CONTINUE
+!***OBTAIN CLOUD REFLECTION AND TRANSMISSION COEFFICIENTS FOR
+!   REMAINING CLOUDS (IF ANY) IN THE VISIBLE BAND
+!---THE MAXIMUM NO OF CLOUDS IN THE ROW (KCLDS) IS USED. THIS CREATES
+!   EXTRA WORK (MAY BE REMOVED IN A SUBSEQUENT UPDATE).
+      DO 581 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 581
+      DO 580 KK=2,KCLDS+1
+        CR(I,KK) = CRR(I,1,KK)*XAMT(I,KK)
+        CT(I,KK) = ONE - (ONE-CTT(I,1,KK))*XAMT(I,KK)
+580   CONTINUE
+581   CONTINUE
+!---OBTAIN THE PRESSURE AT THE TOP,BOTTOM AND THE THICKNESS OF
+!   "THICK" CLOUDS (THOSE AT LEAST 2 LAYERS THICK). THIS IS USED
+!   LATER IS OBTAINING FLUXES INSIDE THE THICK CLOUDS, FOR ALL
+!   FREQUENCY BANDS.
+      DO 591 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 591
+      DO 590 KK=1,KCLDS
+        IF ((KBTMSW(I,KK+1)-1).GT.KTOPSW(I,KK+1)) THEN
+           PPTOP(I,KK)=PP(I,KTOPSW(I,KK+1))
+           DPCLD(I,KK)=ONE/(PPTOP(I,KK)-PP(I,KBTMSW(I,KK+1)))
+        ENDIF
+590   CONTINUE
+591   CONTINUE
+      DO 600 K=1,L
+      DO 600 I=MYIS,MYIE
+        TTDB1(I,K+1) = EXP(HM1EZ*MIN(FIFTY,ABCFF(1)*UD(I,K+1)))
+        TTUB1(I,K) = EXP(HM1EZ*MIN(FIFTY,ABCFF(1)*UR(I,K)))
+        TTD  (I,K+1) = TTDB1(I,K+1)*TDO3(I,K+1)
+        TTU  (I,K) = TTUB1(I,K)*TUO3(I,K)
+600   CONTINUE
+      DO 610 I=MYIS,MYIE
+        TTD(I,1)   = ONE
+        TTU(I,LP1) = TTD(I,LP1)
+610   CONTINUE
+!***FOR EXECUTION OF THE CLOUD LOOP, IT IS NECESSARY TO SEPARATE OUT
+!   TRANSMISSION FCTNS AT THE TOP AND BOTTOM OF THE CLOUDS, FOR
+!   EACH BAND N. THE REQUIRED QUANTITIES ARE:
+!      TTD(I,KTOPSW(I,K),N)  K RUNS FROM 1 TO NCLDS(I)+1:
+!      TTU(I,KTOPSW(I,K),N)  K RUNS FROM 1 TO NCLDS(I)+1:
+!      TTD(I,KBTMSW(I,K),N)  K RUNS FROM 1 TO NCLDS(I)+1:
+!      AND INVERSES OF THE FIRST TWO. THE ABOVE QUANTITIES ARE
+!      STORED IN TDCL1,TUCL1,TDCL2, AND DFNTRN,UFNTRN, RESPECTIVELY,
+!      AS THEY HAVE MULTIPLE USE IN THE PGM.
+!---FOR FIRST CLOUD LAYER (GROUND) TDCL1,TUCL1 ARE KNOWN:
+      DO 620 I=MYIS,MYIE
+        TDCL1 (I,1) = TTD(I,LP1)
+        TUCL1 (I,1) = TTU(I,LP1)
+        TDCL2 (I,1) = TDCL1(I,1)
+        DFNTRN(I,1) = ONE/TDCL1(I,1)
+        UFNTRN(I,1) = DFNTRN(I,1)
+620   CONTINUE
+      DO 631 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 631
+      DO 630 KK=2,KCLDS+1
+        TDCL1(I,KK) = TTD(I,KTOPSW(I,KK))
+        TUCL1(I,KK) = TTU(I,KTOPSW(I,KK))
+        TDCL2(I,KK) = TTD(I,KBTMSW(I,KK))
+630   CONTINUE
+631   CONTINUE
+!---COMPUTE INVERSES
+      DO 641 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 641
+! SH
+      DO 640 KK=2,KCLDS+1
+        DFNTRN(I,KK) = ONE/TDCL1(I,KK)
+        UFNTRN(I,KK) = ONE/TUCL1(I,KK)
+640   CONTINUE
+641   CONTINUE
+!---COMPUTE THE TRANSMISSIVITY FROM THE TOP OF CLOUD (K+1) TO THE
+!   TOP OF CLOUD (K). THE CLOUD TRANSMISSION (CT) IS INCLUDED. THIS
+!   QUANTITY IS CALLED TCLU (INDEX K). ALSO, OBTAIN THE TRANSMISSIVITY
+!   FROM THE BOTTOM OF CLOUD (K+1) TO THE TOP OF CLOUD (K)(A PATH
+!   ENTIRELY OUTSIDE CLOUDS). THIS QUANTITY IS CALLED TCLD (INDEX K).
+      DO 651 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 651
+      DO 650 KK=1,KCLDS
+        TCLU(I,KK) = TDCL1(I,KK)*DFNTRN(I,KK+1)*CT(I,KK+1)
+        TCLD(I,KK) = TDCL1(I,KK)/TDCL2(I,KK+1)
+650   CONTINUE
+651   CONTINUE
+!***THE FOLLOWING IS THE RECURSION RELATION FOR ALFA: THE REFLECTION
+!   COEFFICIENT FOR A SYSTEM INCLUDING THE CLOUD IN QUESTION AND THE
+!   FLUX COMING OUT OF THE CLOUD SYSTEM INCLUDING ALL CLOUDS BELOW
+!   THE CLOUD IN QUESTION.
+!---ALFAU IS ALFA WITHOUT THE REFLECTION OF THE CLOUD IN QUESTION
+      DO 660 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 660
+        ALFA (I,1)=CR(I,1)
+        ALFAU(I,1)=ZERO
+660   CONTINUE
+!---AGAIN,EXCESSIVE CALCULATIONS-MAY BE CHANGED LATER!
+      DO 671 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 671
+      DO 670 KK=2,KCLDS+1
+        ALFAU(I,KK)= TCLU(I,KK-1)*TCLU(I,KK-1)*ALFA(I,KK-1)/ &
+              (ONE - TCLD(I,KK-1)*TCLD(I,KK-1)*ALFA(I,KK-1)*CR(I,KK))
+        ALFA (I,KK)= ALFAU(I,KK)+CR(I,KK)
+670   CONTINUE
+671   CONTINUE
+!     CALCULATE UFN AT CLOUD TOPS AND DFN AT CLOUD BOTTOMS
+!---NOTE THAT UFNCLU(I,KCLDS+1) GIVES THE UPWARD FLUX AT THE TOP
+!   OF THE HIGHEST REAL CLOUD (IF NCLDS(I)=KCLDS). IT GIVES THE FLUX
+!   AT THE TOP OF THE ATMOSPHERE IF NCLDS(I) < KCLDS. IN THE FIRST
+!   CASE, TDCL1 EQUALS THE TRANSMISSION FCTN TO THE TOP OF THE
+!   HIGHEST CLOUD, AS WE WANT. IN THE SECOND CASE, TDCL1=1, SO UFNCLU
+!   EQUALS ALFA. THIS IS ALSO CORRECT.
+      DO 680 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 680
+        UFNCLU(I,KCLDS+1) = ALFA(I,KCLDS+1)*TDCL1(I,KCLDS+1)
+        DFNCLU(I,KCLDS+1) = TDCL1(I,KCLDS+1)
+680   CONTINUE
+!---THIS CALCULATION IS THE REVERSE OF THE RECURSION RELATION USED
+!  ABOVE
+      DO 691 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 691
+      DO 690 KK=KCLDS,1,-1
+        UFNCLU(I,KK) = UFNCLU(I,KK+1)*ALFAU(I,KK+1)/(ALFA(I,KK+1)* &
+                       TCLU(I,KK))
+        DFNCLU(I,KK) = UFNCLU(I,KK)/ALFA(I,KK)
+690   CONTINUE
+691   CONTINUE
+      DO 701 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 701
+      DO 700 KK=1,KCLDS+1
+        UFNTRN(I,KK) = UFNCLU(I,KK)*UFNTRN(I,KK)
+        DFNTRN(I,KK) = DFNCLU(I,KK)*DFNTRN(I,KK)
+700   CONTINUE
+701   CONTINUE
+!---CASE OF KK=1( FROM THE GROUND TO THE BOTTOM OF THE LOWEST CLOUD)
+      DO 720 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 720
+        J2=KBTMSW(I,2)
+        DO 710 K=J2,LP1
+          UFN(I,K) = UFNTRN(I,1)*TTU(I,K)
+          DFN(I,K) = DFNTRN(I,1)*TTD(I,K)
+710     CONTINUE
+720   CONTINUE
+!---REMAINING LEVELS (IF ANY!)
+      DO 760 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 760
+      DO 755 KK=2,KCLDS+1
+        J1=KTOPSW(I,KK)
+        J2=KBTMSW(I,KK+1)
+        IF (J1.EQ.1) GO TO 755
+        DO 730 K=J2,J1
+          UFN(I,K) = UFNTRN(I,KK)*TTU(I,K)
+          DFN(I,K) = DFNTRN(I,KK)*TTD(I,K)
+730     CONTINUE
+!---FOR THE THICK CLOUDS, THE FLUX DIVERGENCE THROUGH THE CLOUD
+!   LAYER IS ASSUMED TO BE CONSTANT. THE FLUX DERIVATIVE IS GIVEN BY
+!   TEMPF (FOR THE UPWARD FLUX) AND TEMPG (FOR THE DOWNWARD FLUX).
+        J3=KBTMSW(I,KK)
+        IF ((J3-J1).GT.1) THEN
+          TEMPF = (UFNCLU(I,KK)-UFN(I,J3))*DPCLD(I,KK-1)
+          TEMPG = (DFNCLU(I,KK)-DFN(I,J3))*DPCLD(I,KK-1)
+          DO 740 K=J1+1,J3-1
+            UFN(I,K) = UFNCLU(I,KK)+TEMPF*(PP(I,K)-PPTOP(I,KK-1))
+            DFN(I,K) = DFNCLU(I,KK)+TEMPG*(PP(I,K)-PPTOP(I,KK-1))
+740       CONTINUE
+        ENDIF
+755   CONTINUE
+760   CONTINUE
+      DO 770 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 770
+      DO 771 K=1,LP1
+        DFSWC(I,K) = DFN(I,K)*DFNTOP(I,1)
+        UFSWC(I,K) = UFN(I,K)*DFNTOP(I,1)
+771   CONTINUE
+770   CONTINUE
+      DO 780 I=MYIS,MYIE
+      KCLDS=NCLDS(I)
+      IF(KCLDS.EQ.0) GO TO 780
+        TMP1(I) = ONE - CCMAX(I)
+        GDFVB(I) = TMP1(I)*GDFVB(I)
+        GDFNB(I) = TMP1(I)*GDFNB(I)
+        GDFVD(I) = TMP1(I)*GDFVD(I) + CCMAX(I)*DFSWC(I,LP1)
+780   CONTINUE
+!---NOW OBTAIN FLUXES FOR THE NEAR IR BANDS. THE METHODS ARE THE SAME
+!   AS FOR THE VISIBLE BAND, EXCEPT THAT THE REFLECTION AND
+!   TRANSMISSION COEFFICIENTS ARE DIFFERENT, AS
+!   RAYLEIGH SCATTERING NEED NOT BE CONSIDERED.
+!
+      DO 1000 N=2,NB
+!YH93
+        DO 791 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 791
+        DO 790 K=1,KCLDS+1
+          CR(I,K) = CRR(I,N,K)*XAMT(I,K)
+          CT(I,K) = ONE - (ONE-CTT(I,N,K))*XAMT(I,K)
+790     CONTINUE
+791     CONTINUE
+!YH93
+        IF (N.EQ.2) THEN
+!   THE WATER VAPOR TRANSMISSION FUNCTION FOR BAND 2 IS EQUAL TO
+!   THAT OF BAND 1 (SAVED AS TTDB1,TTUB1)
+          DO 800 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 800
+        DO 801 KK=2,LP1
+            TTD(I,KK) = TTDB1(I,KK)*TDCO2(I,KK)
+801     CONTINUE
+        DO 802 KK=1,L
+            TTU(I,KK) = TTUB1(I,KK)*TUCO2(I,KK)
+802     CONTINUE
+800       CONTINUE
+        ELSE
+          DO 810 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 810
+        DO 811 KK=2,LP1
+            TTD(I,KK) = EXP(HM1EZ*MIN(FIFTY,ABCFF(N)*UD(I,KK))) &
+                     * TDCO2(I,KK)
+811     CONTINUE
+        DO 812 KK=1,L
+            TTU(I,KK) = EXP(HM1EZ*MIN(FIFTY,ABCFF(N)*UR(I,KK))) &
+                     * TUCO2(I,KK)
+812     CONTINUE
+810       CONTINUE
+        ENDIF
+!---AT THIS POINT,INCLUDE TTD(1),TTU(LP1), NOTING THAT TTD(1)=1 FOR
+!   ALL BANDS, AND THAT TTU(LP1)=TTD(LP1) FOR ALL BANDS.
+        DO 820 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 820
+          TTU(I,LP1) = TTD(I,LP1)
+          TTD(I,1)   = ONE
+820     CONTINUE
+!***FOR EXECUTION OF THE CLOUD LOOP, IT IS NECESSARY TO SEPARATE OUT
+!   TRANSMISSION FCTNS AT THE TOP AND BOTTOM OF THE CLOUDS, FOR
+!   EACH BAND N. THE REQUIRED QUANTITIES ARE:
+!      TTD(I,KTOPSW(I,K),N)  K RUNS FROM 1 TO NCLDS(I)+1:
+!      TTD(I,KBTMSW(I,K),N)  K RUNS FROM 2 TO NCLDS(I)+1:
+!      TTU(I,KTOPSW(I,K),N)  K RUNS FROM 1 TO NCLDS(I)+1:
+!      AND INVERSES OF THE ABOVE. THE ABOVE QUANTITIES ARE STORED
+!      IN TDCL1,TDCL2,TUCL1,AND DFNTRN,UFNTRN,RESPECTIVELY, AS
+!      THEY HAVE MULTIPLE USE IN THE PGM.
+!---FOR FIRST CLOUD LAYER (GROUND) TDCL1,TUCL1 ARE KNOWN:
+        DO 830 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 830
+          TDCL1 (I,1) = TTD(I,LP1)
+          TUCL1 (I,1) = TTU(I,LP1)
+          TDCL2 (I,1) = TDCL1(I,1)
+          DFNTRN(I,1) = ONE/TDCL1(I,1)
+          UFNTRN(I,1) = DFNTRN(I,1)
+830     CONTINUE
+        DO 841 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 841
+        DO 840 KK=2,KCLDS+1
+          TDCL1(I,KK) = TTD(I,KTOPSW(I,KK))
+          TUCL1(I,KK) = TTU(I,KTOPSW(I,KK))
+          TDCL2(I,KK) = TTD(I,KBTMSW(I,KK))
+840     CONTINUE
+841     CONTINUE
+        DO 851 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 851
+        DO 850 KK=2,KCLDS+1
+          DFNTRN(I,KK) = ONE/TDCL1(I,KK)
+          UFNTRN(I,KK) = ONE/TUCL1(I,KK)
+850     CONTINUE
+851     CONTINUE
+        DO 861 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 861
+        DO 860 KK=1,KCLDS
+          TCLU(I,KK) = TDCL1(I,KK)*DFNTRN(I,KK+1)*CT(I,KK+1)
+          TCLD(I,KK) = TDCL1(I,KK)/TDCL2(I,KK+1)
+860     CONTINUE
+861     CONTINUE
+!***THE FOLLOWING IS THE RECURSION RELATION FOR ALFA: THE REFLECTION
+!   COEFFICIENT FOR A SYSTEM INCLUDING THE CLOUD IN QUESTION AND THE
+!   FLUX COMING OUT OF THE CLOUD SYSTEM INCLUDING ALL CLOUDS BELOW
+!   THE CLOUD IN QUESTION.
+        DO 870 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 870
+          ALFA (I,1) = CR(I,1)
+          ALFAU(I,1) = ZERO
+870     CONTINUE
+!---AGAIN,EXCESSIVE CALCULATIONS-MAY BE CHANGED LATER!
+        DO 881 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 881
+        DO 880 KK=2,KCLDS+1
+          ALFAU(I,KK) = TCLU(I,KK-1)*TCLU(I,KK-1)*ALFA(I,KK-1)/(ONE - &
+                   TCLD(I,KK-1)*TCLD(I,KK-1)*ALFA(I,KK-1)*CR(I,KK))
+          ALFA (I,KK) = ALFAU(I,KK)+CR(I,KK)
+880     CONTINUE
+881     CONTINUE
+!     CALCULATE UFN AT CLOUD TOPS AND DFN AT CLOUD BOTTOMS
+!---NOTE THAT UFNCLU(I,KCLDS+1) GIVES THE UPWARD FLUX AT THE TOP
+!   OF THE HIGHEST REAL CLOUD (IF NCLDS(I)=KCLDS). IT GIVES THE FLUX
+!   AT THE TOP OF THE ATMOSPHERE IF NCLDS(I) < KCLDS. IT THE FIRST
+!   CASE, TDCL1 EQUALS THE TRANSMISSION FCTN TO THE TOP OF THE
+!   HIGHEST CLOUD, AS WE WANT. IN THE SECOND CASE, TDCL1=1, SO UFNCLU
+!   EQUALS ALFA. THIS IS ALSO CORRECT.
+        DO 890 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 890
+          UFNCLU(I,KCLDS+1) = ALFA(I,KCLDS+1)*TDCL1(I,KCLDS+1)
+          DFNCLU(I,KCLDS+1) = TDCL1(I,KCLDS+1)
+890     CONTINUE
+        DO 901 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 901
+        DO 900 KK=KCLDS,1,-1
+!
+!***  ACCOUNT FOR UNREALISTICALLY SMALL CLOUD AMOUNT
+!
+        DENOM=ALFA(I,KK+1)*TCLU(I,KK)
+        IF(DENOM.GT.RTHRESH)THEN
+          UFNCLU(I,KK)=UFNCLU(I,KK+1)*ALFAU(I,KK+1)/DENOM
+        ELSE
+          UFNCLU(I,KK)=0.
+        ENDIF
+        IF(ALFA(I,KK).GT.RTHRESH)THEN
+          DFNCLU(I,KK)=UFNCLU(I,KK)/ALFA(I,KK)
+        ELSE
+          DFNCLU(I,KK)=0.
+        ENDIF
+900     CONTINUE
+901     CONTINUE
+!     NOW OBTAIN DFN AND UFN FOR LEVELS BETWEEN THE CLOUDS
+        DO 911 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 911
+        DO 910 KK=1,KCLDS+1
+          UFNTRN(I,KK) = UFNCLU(I,KK)*UFNTRN(I,KK)
+          DFNTRN(I,KK) = DFNCLU(I,KK)*DFNTRN(I,KK)
+910     CONTINUE
+911     CONTINUE
+        DO 930 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 930
+          J2=KBTMSW(I,2)
+          DO 920 K=J2,LP1
+            UFN(I,K) = UFNTRN(I,1)*TTU(I,K)
+            DFN(I,K) = DFNTRN(I,1)*TTD(I,K)
+920       CONTINUE
+930     CONTINUE
+        DO 970  I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 970
+        DO 965  KK=2,KCLDS+1
+          J1 = KTOPSW(I,KK)
+          J2 = KBTMSW(I,KK+1)
+          IF (J1.EQ.1) GO TO 965
+          DO 940 K=J2,J1
+            UFN(I,K) = UFNTRN(I,KK)*TTU(I,K)
+            DFN(I,K) = DFNTRN(I,KK)*TTD(I,K)
+940       CONTINUE
+          J3 = KBTMSW(I,KK)
+          IF ((J3-J1).GT.1) THEN
+            TEMPF = (UFNCLU(I,KK)-UFN(I,J3))*DPCLD(I,KK-1)
+            TEMPG = (DFNCLU(I,KK)-DFN(I,J3))*DPCLD(I,KK-1)
+            DO 950 K=J1+1,J3-1
+              UFN(I,K) = UFNCLU(I,KK)+TEMPF*(PP(I,K)-PPTOP(I,KK-1))
+              DFN(I,K) = DFNCLU(I,KK)+TEMPG*(PP(I,K)-PPTOP(I,KK-1))
+950         CONTINUE
+          ENDIF
+965     CONTINUE
+970     CONTINUE
+        DO 980 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 980
+        DO 981 K=1,LP1
+          DFSWC(I,K) = DFSWC(I,K) + DFN(I,K)*DFNTOP(I,N)
+          UFSWC(I,K) = UFSWC(I,K) + UFN(I,K)*DFNTOP(I,N)
+981     CONTINUE
+980     CONTINUE
+        DO 990 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 990
+          GDFND(I) = GDFND(I) + CCMAX(I)*DFN(I,LP1)*DFNTOP(I,N)
+990     CONTINUE
+1000  CONTINUE
+      DO 1100 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 1100
+      DO 1101 K=1,LP1
+        DFSWC(I,K) = TMP1(I)*DFSWL(I,K) + CCMAX(I)*DFSWC(I,K)
+        UFSWC(I,K) = TMP1(I)*UFSWL(I,K) + CCMAX(I)*UFSWC(I,K)
+1101  CONTINUE
+1100  CONTINUE
+      DO 1200 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 1200
+        DO 1201 KK=1,LP1
+        FSWC(I,KK) = UFSWC(I,KK)-DFSWC(I,KK)
+1201    CONTINUE
+1200  CONTINUE
+      DO 1250 I=MYIS,MYIE
+        KCLDS=NCLDS(I)
+        IF(KCLDS.EQ.0) GO TO 1250
+        DO 1251 KK=1, L
+        HSWC(I,KK) = RADCON*(FSWC(I,KK+1)-FSWC(I,KK))/DP(I,KK)
+1251    CONTINUE
+1250  CONTINUE
+
+  END SUBROUTINE SWR93
+!-----------------------------------------------------------------------
+
+  SUBROUTINE RADFS & 
+
+!     *****************************************************************
+!     *                                                               *
+!     *   THE INTERNAL DRIVE FOR GFDL RADIATION                       *
+!     *   THIS SUBROUTINE WAS FROM Y.H AND K.A.C (1993)               *
+!     *   AND MODIFIED BY Q. ZHAO FOR USE IN THE ETA MODEL            *
+!     *                   NOV. 18,  1993                              *
+!     *                                                               *
+!     * UPDATE: THIS SUBROUTINE WAS MODIFIED TO USE CLOUD FRACTION    *
+!     *         ON EACH MODEL LAYER.                                  *
+!     *                                QINGYUN  ZHAO   95-3-22        *
+!     *****************************************************************
+!***
+!***  REQUIRED INPUT:
+!***
+                (QS,PP,PPI,QQH2O,TT,O3QO3,TSFC,SLMSK,ALBEDO,XLAT &
+!BSF => for NAMX changes, pass in surface emissivity (SFCEMS) [different for snow]
+      ,          CAMT,KTOP,KBTM,NCLDS,EMCLD,RRCL,TTCL &
+      ,          COSZRO,TAUDAR,IBEG &
+      ,          KO3,KALB &
+      ,          ITIMSW,ITIMLW &
+!***************************************************************************
+!*              IX IS THE LENGTH OF A ROW IN THE DOMAIN
+!
+!*   QS(IX):		THE SURFACE PRESSURE (PA)
+!*   PP(IX,L):		THE MIDLAYER PRESSURES (PA)  (L IS THE VERT. DIMEN.)
+!*   PPI(IX,LP1)	THE INTERFACE PRESSURES (PA)
+!*   QQH2O(IX,L):	THE MIDLAYER WATER VAPOR MIXING RATIO (KG/KG)
+!*   TT(IX,L):		THE MIDLAYER TEMPERATURE (K)
+!*   O3QO3(IX,L):	THE MIDLAYER OZONE MIXING RATIO
+!*   TSFC(IX):		THE SKIN TEMP. (K); NEGATIVE OVER WATER
+!*   SLMSK(IX):		THE SEA MASK (LAND=0,SEA=1)
+!*   ALBEDO(IX):	THE SURFACE ALBEDO (EXPRESSED AS A FRACTION)
+!*   XLAT(IX):		THE GEODETIC LATITUDES OF EACH COLUMN IN DEGREES
+!*				(N.H.> 0)
+!* THE FOLLOWING ARE CLOUD INFORMATION FOR EACH CLOUD LAYER
+!*                      LAYER=1:SURFACE
+!*                      LAYER=2:FIRST LAYER ABOVE GROUND, AND SO ON
+!*   CAMT(IX,LP1):      CLOUD FRACTION OF EACH CLOUD LAYER
+!*   ITYP(IX,LP1):      CLOUD TYPE(=1: STRATIFORM, =2:CONVECTIVE)
+!*   KTOP(IX,LP1):      HEIGHT OF CLOUD TOP OF EACH CLOUD LAYER (IN ETA LEVEL)
+!*   KBTM(IX,LP1):      BOTTOM OF EACH CLOUD LAYER
+!*   NCLDS(IX):         NUMBER OF CLOUD LAYERS
+!*   EMCLD(IX,LP1):     CLOUD EMISSIVITY
+!*   RRCL(IX,NB,LP1)    CLOUD REFLECTTANCES FOR SW SPECTRAL BANDS
+!*   TTCL(IX,NB,LP1)    CLOUD TRANSMITANCES FOR SW SPECTRAL BANDS
+!* THE ABOVE ARE CLOUD INFORMATION FOR EACH CLOUD LAYER
+!*
+!*   COSZRO(IX):	THE COSINE OF THE SOLAR ZENITH ANGLE
+!*   TAUDAR:		=1.0
+!*   IBEG:		=1
+!*   KO3:		=1 ( READ IN THE QZONE DATA)
+!*   KALB:		=0
+!*   ITIMSW:		=1/0 (SHORTWAVE CALC. ARE DESIRED/NOT DESIRED)
+!*   ITIMLW:		=1/0 (LONGWAVE CALC. ARE DESIRED/NOT DESIRED)
+!************************************************************************
+!***
+!*** GENERATED OUTPUT REQUIRED BY THE ETA MODEL
+!***
+      ,          SWH,HLW &
+      ,          FLWUP,FSWUP,FSWDN,FSWDNS,FSWUPS,FLWDNS,FLWUPS,FSWDNSC  &
+      ,          ids,ide, jds,jde, kds,kde                      &
+      ,          ims,ime, jms,jme, kms,kme                      &
+! begin debugging radiation
+      ,          its,ite, jts,jte, kts,kte                      &
+      ,          imd,jmd, Jndx                                  )
+! end debugging radiation
+!************************************************************************
+!*    SWH: ATMOSPHERIC SHORTWAVE HEATING RATES IN K/S.
+!*         SWH IS A REAL ARRAY DIMENSIONED (NCOL X LM).
+!*    HLW: ATMOSPHERIC LONGWAVE HEATING RATES IN K/S.
+!*         HLW IS A REAL ARRAY DIMENSIONED (NCOL X LM).
+!*  FLWUP: UPWARD LONGWAVE FLUX AT TOP OF THE ATMOSPHERE IN W/M**2.
+!*         FLWUP IS A REAL ARRAY DIMENSIONED (NCOL).
+!*  FSWUP: UPWARD SHORTWAVE FLUX AT TOP OF THE ATMOSPHERE IN W/M**2.
+!*         FSWUP IS A REAL ARRAY DIMENSIONED (NCOL).
+!*  FSWDN: DOWNWARD SHORTWAVE FLUX AT TOP OF THE ATMOSPHERE IN W/M**2.
+!*         FSWDN IS A REAL ARRAY DIMENSIONED (NCOL).
+!* FSWDNS: DOWNWARD SHORTWAVE FLUX AT THE SURFACE IN W/M**2.
+!*         FSWDNS IS A REAL ARRAY DIMENSIONED (NCOL).
+!* FSWUPS: UPWARD SHORTWAVE FLUX AT THE SURFACE IN W/M**2.
+!*         FSWUPS IS A REAL ARRAY DIMENSIONED (NCOL).
+!* FLWDNS: DOWNWARD LONGWAVE FLUX AT THE SURFACE IN W/M**2.
+!*         FLWDNS IS A REAL ARRAY DIMENSIONED (NCOL).
+!* FLWUPS: UPWARD LONGWAVE FLUX AT THE SURFACE IN W/M**2.
+!*         FLWUPS IS A REAL ARRAY DIMENSIONED (NCOL).
+!* FSWDNSC: CLEAR-SKY DOWNWARD SHORTWAVE FLUX AT THE SURFACE IN W/M**2.
+!*         FSWDNSC IS A REAL ARRAY DIMENSIONED (NCOL).
+!************************************************************************
+!***
+!*** THE FOLLOWING OUTPUTS ARE NOT REQUIRED BY THE ETA MODEL
+!***
+!----------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+!INTEGER, PARAMETER :: NBLY=15
+ INTEGER, PARAMETER :: NB=12
+ INTEGER, PARAMETER :: NBLX=47
+ INTEGER , PARAMETER:: NBLW = 163
+
+ REAL,PARAMETER ::      AMOLWT=28.9644
+ REAL,PARAMETER ::      CSUBP=1.00484E7
+ REAL,PARAMETER ::      DIFFCTR=1.66
+ REAL,PARAMETER ::      G=980.665
+ REAL,PARAMETER ::      GINV=1./G
+ REAL,PARAMETER ::      GRAVDR=980.0
+ REAL,PARAMETER ::      O3DIFCTR=1.90
+ REAL,PARAMETER ::      P0=1013250.
+ REAL,PARAMETER ::      P0INV=1./P0
+ REAL,PARAMETER ::      GP0INV=GINV*P0INV
+ REAL,PARAMETER ::      P0XZP2=202649.902
+ REAL,PARAMETER ::      P0XZP8=810600.098
+ REAL,PARAMETER ::      P0X2=2.*1013250.
+ REAL,PARAMETER ::      RADCON=8.427
+ REAL,PARAMETER ::      RADCON1=1./8.427
+ REAL,PARAMETER ::      RATCO2MW=1.519449738
+ REAL,PARAMETER ::      RATH2OMW=.622
+ REAL,PARAMETER ::      RGAS=8.3142E7
+ REAL,PARAMETER ::      RGASSP=8.31432E7
+ REAL,PARAMETER ::      SECPDA=8.64E4
+!
+!******THE FOLLOWING ARE MATHEMATICAL CONSTANTS*******
+!        ARRANGED IN DECREASING ORDER
+ REAL,PARAMETER ::      HUNDRED=100.
+ REAL,PARAMETER ::      HNINETY=90.
+ REAL,PARAMETER ::      HNINE=9.0
+ REAL,PARAMETER ::      SIXTY=60.
+ REAL,PARAMETER ::      FIFTY=50.
+ REAL,PARAMETER ::      TEN=10.
+ REAL,PARAMETER ::      EIGHT=8.
+ REAL,PARAMETER ::      FIVE=5.
+ REAL,PARAMETER ::      FOUR=4.
+ REAL,PARAMETER ::      THREE=3.
+ REAL,PARAMETER ::      TWO=2.
+ REAL,PARAMETER ::      ONE=1.
+ REAL,PARAMETER ::      HAF=0.5
+ REAL,PARAMETER ::      QUARTR=0.25
+ REAL,PARAMETER ::      ZERO=0.
+!
+!******FOLLOWING ARE POSITIVE FLOATING POINT CONSTANTS(H'S)
+!       ARRANGED IN DECREASING ORDER
+ REAL,PARAMETER ::      H83E26=8.3E26
+ REAL,PARAMETER ::      H71E26=7.1E26
+ REAL,PARAMETER ::      H1E15=1.E15
+ REAL,PARAMETER ::      H1E13=1.E13
+ REAL,PARAMETER ::      H1E11=1.E11
+ REAL,PARAMETER ::      H1E8=1.E8
+ REAL,PARAMETER ::      H2E6=2.0E6
+ REAL,PARAMETER ::      H1E6=1.0E6
+ REAL,PARAMETER ::      H69766E5=6.97667E5
+ REAL,PARAMETER ::      H4E5=4.E5
+ REAL,PARAMETER ::      H165E5=1.65E5
+ REAL,PARAMETER ::      H5725E4=57250.
+ REAL,PARAMETER ::      H488E4=48800.
+ REAL,PARAMETER ::      H1E4=1.E4
+ REAL,PARAMETER ::      H24E3=2400.
+ REAL,PARAMETER ::      H20788E3=2078.8
+ REAL,PARAMETER ::      H2075E3=2075.
+ REAL,PARAMETER ::      H18E3=1800.
+ REAL,PARAMETER ::      H1224E3=1224.
+ REAL,PARAMETER ::      H67390E2=673.9057
+ REAL,PARAMETER ::      H5E2=500.
+ REAL,PARAMETER ::      H3082E2=308.2
+ REAL,PARAMETER ::      H3E2=300.
+ REAL,PARAMETER ::      H2945E2=294.5
+ REAL,PARAMETER ::      H29316E2=293.16
+ REAL,PARAMETER ::      H26E2=260.0
+ REAL,PARAMETER ::      H25E2=250.
+ REAL,PARAMETER ::      H23E2=230.
+ REAL,PARAMETER ::      H2E2=200.0
+ REAL,PARAMETER ::      H15E2=150.
+ REAL,PARAMETER ::      H1386E2=138.6
+ REAL,PARAMETER ::      H1036E2=103.6
+ REAL,PARAMETER ::      H8121E1=81.21
+ REAL,PARAMETER ::      H35E1=35.
+ REAL,PARAMETER ::      H3116E1=31.16
+ REAL,PARAMETER ::      H28E1=28.
+ REAL,PARAMETER ::      H181E1=18.1
+ REAL,PARAMETER ::      H18E1=18.
+ REAL,PARAMETER ::      H161E1=16.1
+ REAL,PARAMETER ::      H16E1=16.
+ REAL,PARAMETER ::      H1226E1=12.26
+ REAL,PARAMETER ::      H9P94=9.94
+ REAL,PARAMETER ::      H6P08108=6.081081081
+ REAL,PARAMETER ::      H3P6=3.6
+ REAL,PARAMETER ::      H3P5=3.5
+ REAL,PARAMETER ::      H2P9=2.9
+ REAL,PARAMETER ::      H2P8=2.8
+ REAL,PARAMETER ::      H2P5=2.5
+ REAL,PARAMETER ::      H1P8=1.8
+ REAL,PARAMETER ::      H1P4387=1.4387
+ REAL,PARAMETER ::      H1P41819=1.418191
+ REAL,PARAMETER ::      H1P4=1.4
+ REAL,PARAMETER ::      H1P25892=1.258925411
+ REAL,PARAMETER ::      H1P082=1.082
+ REAL,PARAMETER ::      HP816=0.816
+ REAL,PARAMETER ::      HP805=0.805
+ REAL,PARAMETER ::      HP8=0.8
+ REAL,PARAMETER ::      HP60241=0.60241
+ REAL,PARAMETER ::      HP602409=0.60240964
+ REAL,PARAMETER ::      HP6=0.6
+ REAL,PARAMETER ::      HP526315=0.52631579
+ REAL,PARAMETER ::      HP518=0.518
+ REAL,PARAMETER ::      HP5048=0.5048
+ REAL,PARAMETER ::      HP3795=0.3795
+ REAL,PARAMETER ::      HP369=0.369
+ REAL,PARAMETER ::      HP26=0.26
+ REAL,PARAMETER ::      HP228=0.228
+ REAL,PARAMETER ::      HP219=0.219
+ REAL,PARAMETER ::      HP166666=.166666
+ REAL,PARAMETER ::      HP144=0.144
+ REAL,PARAMETER ::      HP118666=0.118666192
+ REAL,PARAMETER ::      HP1=0.1
+!        (NEGATIVE EXPONENTIALS BEGIN HERE)
+ REAL,PARAMETER ::      H658M2=0.0658
+ REAL,PARAMETER ::      H625M2=0.0625
+ REAL,PARAMETER ::      H44871M2=4.4871E-2
+ REAL,PARAMETER ::      H44194M2=.044194
+ REAL,PARAMETER ::      H42M2=0.042
+ REAL,PARAMETER ::      H41666M2=0.0416666
+ REAL,PARAMETER ::      H28571M2=.02857142857
+ REAL,PARAMETER ::      H2118M2=0.02118
+ REAL,PARAMETER ::      H129M2=0.0129
+ REAL,PARAMETER ::      H1M2=.01
+ REAL,PARAMETER ::      H559M3=5.59E-3
+ REAL,PARAMETER ::      H3M3=0.003
+ REAL,PARAMETER ::      H235M3=2.35E-3
+ REAL,PARAMETER ::      H1M3=1.0E-3
+ REAL,PARAMETER ::      H987M4=9.87E-4
+ REAL,PARAMETER ::      H323M4=0.000323
+ REAL,PARAMETER ::      H3M4=0.0003
+ REAL,PARAMETER ::      H285M4=2.85E-4
+ REAL,PARAMETER ::      H1M4=0.0001
+ REAL,PARAMETER ::      H75826M4=7.58265E-4
+ REAL,PARAMETER ::      H6938M5=6.938E-5
+ REAL,PARAMETER ::      H394M5=3.94E-5
+ REAL,PARAMETER ::      H37412M5=3.7412E-5
+ REAL,PARAMETER ::      H15M5=1.5E-5
+ REAL,PARAMETER ::      H1439M5=1.439E-5
+ REAL,PARAMETER ::      H128M5=1.28E-5
+ REAL,PARAMETER ::      H102M5=1.02E-5
+ REAL,PARAMETER ::      H1M5=1.0E-5
+ REAL,PARAMETER ::      H7M6=7.E-6
+ REAL,PARAMETER ::      H4999M6=4.999E-6
+ REAL,PARAMETER ::      H451M6=4.51E-6
+ REAL,PARAMETER ::      H25452M6=2.5452E-6
+ REAL,PARAMETER ::      H1M6=1.E-6
+ REAL,PARAMETER ::      H391M7=3.91E-7
+ REAL,PARAMETER ::      H1174M7=1.174E-7
+ REAL,PARAMETER ::      H8725M8=8.725E-8
+ REAL,PARAMETER ::      H327M8=3.27E-8
+ REAL,PARAMETER ::      H257M8=2.57E-8
+ REAL,PARAMETER ::      H1M8=1.0E-8
+ REAL,PARAMETER ::      H23M10=2.3E-10
+ REAL,PARAMETER ::      H14M10=1.4E-10
+ REAL,PARAMETER ::      H11M10=1.1E-10
+ REAL,PARAMETER ::      H1M10=1.E-10
+ REAL,PARAMETER ::      H83M11=8.3E-11
+ REAL,PARAMETER ::      H82M11=8.2E-11
+ REAL,PARAMETER ::      H8M11=8.E-11
+ REAL,PARAMETER ::      H77M11=7.7E-11
+ REAL,PARAMETER ::      H72M11=7.2E-11
+ REAL,PARAMETER ::      H53M11=5.3E-11
+ REAL,PARAMETER ::      H48M11=4.8E-11
+ REAL,PARAMETER ::      H44M11=4.4E-11
+ REAL,PARAMETER ::      H42M11=4.2E-11
+ REAL,PARAMETER ::      H37M11=3.7E-11
+ REAL,PARAMETER ::      H35M11=3.5E-11
+ REAL,PARAMETER ::      H32M11=3.2E-11
+ REAL,PARAMETER ::      H3M11=3.0E-11
+ REAL,PARAMETER ::      H28M11=2.8E-11
+ REAL,PARAMETER ::      H24M11=2.4E-11
+ REAL,PARAMETER ::      H23M11=2.3E-11
+ REAL,PARAMETER ::      H2M11=2.E-11
+ REAL,PARAMETER ::      H18M11=1.8E-11
+ REAL,PARAMETER ::      H15M11=1.5E-11
+ REAL,PARAMETER ::      H14M11=1.4E-11
+ REAL,PARAMETER ::      H114M11=1.14E-11
+ REAL,PARAMETER ::      H11M11=1.1E-11
+ REAL,PARAMETER ::      H1M11=1.E-11
+ REAL,PARAMETER ::      H96M12=9.6E-12
+ REAL,PARAMETER ::      H93M12=9.3E-12
+ REAL,PARAMETER ::      H77M12=7.7E-12
+ REAL,PARAMETER ::      H74M12=7.4E-12
+ REAL,PARAMETER ::      H65M12=6.5E-12
+ REAL,PARAMETER ::      H62M12=6.2E-12
+ REAL,PARAMETER ::      H6M12=6.E-12
+ REAL,PARAMETER ::      H45M12=4.5E-12
+ REAL,PARAMETER ::      H44M12=4.4E-12
+ REAL,PARAMETER ::      H4M12=4.E-12
+ REAL,PARAMETER ::      H38M12=3.8E-12
+ REAL,PARAMETER ::      H37M12=3.7E-12
+ REAL,PARAMETER ::      H3M12=3.E-12
+ REAL,PARAMETER ::      H29M12=2.9E-12
+ REAL,PARAMETER ::      H28M12=2.8E-12
+ REAL,PARAMETER ::      H24M12=2.4E-12
+ REAL,PARAMETER ::      H21M12=2.1E-12
+ REAL,PARAMETER ::      H16M12=1.6E-12
+ REAL,PARAMETER ::      H14M12=1.4E-12
+ REAL,PARAMETER ::      H12M12=1.2E-12
+ REAL,PARAMETER ::      H8M13=8.E-13
+ REAL,PARAMETER ::      H46M13=4.6E-13
+ REAL,PARAMETER ::      H36M13=3.6E-13
+ REAL,PARAMETER ::      H135M13=1.35E-13
+ REAL,PARAMETER ::      H12M13=1.2E-13
+ REAL,PARAMETER ::      H1M13=1.E-13
+ REAL,PARAMETER ::      H3M14=3.E-14
+ REAL,PARAMETER ::      H15M14=1.5E-14
+ REAL,PARAMETER ::      H14M14=1.4E-14
+!
+!******FOLLOWING ARE NEGATIVE FLOATING POINT CONSTANTS (HM'S)
+!          ARRANGED IN DESCENDING ORDER
+ REAL,PARAMETER ::      HM2M2=-.02
+ REAL,PARAMETER ::      HM6666M2=-.066667
+ REAL,PARAMETER ::      HMP5=-0.5
+ REAL,PARAMETER ::      HMP575=-0.575
+ REAL,PARAMETER ::      HMP66667=-.66667
+ REAL,PARAMETER ::      HMP805=-0.805
+ REAL,PARAMETER ::      HM1EZ=-1.
+ REAL,PARAMETER ::      HM13EZ=-1.3
+ REAL,PARAMETER ::      HM19EZ=-1.9
+ REAL,PARAMETER ::      HM1E1=-10.
+ REAL,PARAMETER ::      HM1597E1=-15.97469413
+ REAL,PARAMETER ::      HM161E1=-16.1
+ REAL,PARAMETER ::      HM1797E1=-17.97469413
+ REAL,PARAMETER ::      HM181E1=-18.1
+ REAL,PARAMETER ::      HM8E1=-80.
+ REAL,PARAMETER ::      HM1E2=-100.
+!
+ REAL,PARAMETER ::      H1M16=1.0E-16
+ REAL,PARAMETER ::      H1M20=1.E-20
+ REAL,PARAMETER ::      Q19001=19.001
+ REAL,PARAMETER ::      DAYSEC=1.1574E-5
+ REAL,PARAMETER ::      HSIGMA=5.673E-8
+ REAL,PARAMETER ::      TWENTY=20.0
+ REAL,PARAMETER ::      HP537=0.537
+ REAL,PARAMETER ::      HP2=0.2
+ REAL,PARAMETER ::      RCO2=3.3E-4
+ REAL,PARAMETER ::      H3M6=3.0E-6
+ REAL,PARAMETER ::      PI=3.1415927
+ REAL,PARAMETER ::      DEGRAD=180.0/PI
+ REAL,PARAMETER ::      H74E1=74.0
+ REAL,PARAMETER ::      H15E1=15.0
+
+ REAL, PARAMETER:: B0 = -.51926410E-4
+ REAL, PARAMETER:: B1 = -.18113332E-3
+ REAL, PARAMETER:: B2 = -.10680132E-5
+ REAL, PARAMETER:: B3 = -.67303519E-7
+ REAL, PARAMETER:: AWIDE = 0.309801E+01
+ REAL, PARAMETER:: BWIDE = 0.495357E-01
+ REAL, PARAMETER:: BETAWD = 0.347839E+02
+ REAL, PARAMETER:: BETINW = 0.766811E+01
+
+
+      INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+                                    ims,ime, jms,jme, kms,kme ,      &
+                                    its,ite, jts,jte, kts,kte
+      INTEGER, INTENT(IN)        :: IBEG,KO3,KALB,ITIMSW,ITIMLW
+!----------------------------------------------------------------------
+!      ****************************************************************
+!      *  GENERALIZED FOR PLUG-COMPATIBILITY -                        *
+!      *    ORIGINAL CODE WAS CLEANED-UP GFDL CODE...K.CAMPANA MAR89..*
+!......*  EXAMPLE FOR MRF:                                            *
+!      *    KO3  =0  AND O3QO3=DUMMY ARRAY.   (GFDL CLIMO O3 USED)    *
+!      *    KEMIS=0  AND HI CLD EMIS COMPUTED HERE (CEMIS=DUMMY INPUT)*
+!      *    KALB =0  AND SFC ALBEDO OVER OPEN WATER COMPUTED BELOW... *
+!      *    KCCO2=0,CO2 OBTAINED FROM BLOCK DATA                      *
+!      *         =1,CO2 COMPUTED IN HERE --- NOT AVAILABLE YET...     *
+!      *  UPDATED FOR YUTAI HOU SIB SW RADIATION....KAC 6 MAR 92      *
+!      *    OCEAN ALBEDO FOR BEAM SET TO BULK SFCALB, SINCE           *
+!      *       COSINE ZENITH ANGLE EFFECTS ALREADY THERE(REF:PAYNE)   *
+!      *       SLMSK = 0.                                             *
+!      *    SNOW ICE ALBEDO FOR BEAM NOT ENHANCED VIA COSINE ZENITH   *
+!      *       ANGLE EITHER CAUSE VALU ALREADY HIGH (WE SEE POLAR     *
+!      *       COOLING IF WE DO BEAM CALCULATION)....KAC 17MAR92      *
+!      *       ALBEDO GE .5                                           *
+!      *   UPDATED TO OBTAIN CLEAR SKY FLUXES "ON THE FLY" FOR        *
+!      *       CLOUD FORCING DIAGNOSTICS ELSEWHERE...KAC 7AUG92       *
+!      *       SEE ##CLR LINES...RADFS,LWR88,FST88,SPA88 .......      *
+!      *  UPDATED FOR USE NEW CLD SCHEME      ......YH  DEC 92        *
+!      *    INPUT CLD MAY BE AS ORIGINAL IN 3 DOMAIN (CLD,MTOP,MBOT)  *
+!      *       OR IN A VERTICAL ARRAY OF 18 MDL LAYERS (CLDARY)       *
+!      *    IEMIS=0  USE THE ORG. CLD EMIS SCHEME                     *
+!      *         =1  USE TEMP DEP. CLD EMIS SCHEME                    *
+!      *  UPDATED TO COMPUTE CLD LAYER REFLECTTANCE AND TRANSMITTANCE *
+!      *    INPUT CLD EMISSIVITY AND OPTICAL THICKNESS 'EMIS0,TAUC0'  *
+!      *                                      ......YH FEB 93         *
+!      ****************************************************************
+!--------------------------------
+!     INTEGER, PARAMETER:: LNGTH=37*kte
+!--------------------------------
+     
+!     REAL, INTENT(IN) :: SKO3R,AB15WD,SKC1R,SKO2D
+
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte):: PP,TT
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte):: QQH2O
+      REAL,    INTENT(IN), DIMENSION(its:ite,kts:kte+1):: PPI,CAMT,EMCLD
+      REAL,    INTENT(IN), DIMENSION(its:ite):: QS,TSFC,SLMSK,ALBEDO,XLAT
+      REAL,    INTENT(IN), DIMENSION(its:ite):: COSZRO,TAUDAR
+      REAL,    INTENT(OUT), DIMENSION(its:ite):: FLWUPS
+      INTEGER, INTENT(IN), DIMENSION(its:ite):: NCLDS
+      INTEGER, INTENT(IN), DIMENSION(its:ite,kts:kte+1):: KTOP,KBTM
+      REAL,    INTENT(INOUT), DIMENSION(its:ite,NB,kts:kte+1):: TTCL,RRCL
+      REAL, intent(IN), DIMENSION(its:ite,kts:kte):: O3QO3
+!     REAL,  INTENT(IN),  DIMENSION(5040):: T1,T2,T4,EM1V,EM1VW
+!     REAL,  INTENT(IN),  DIMENSION(5040) :: EM3V
+
+!     REAL, DIMENSION(its:ite)::ALVBR,ALNBR, ALVDR,ALNDR
+
+! TABLE ???
+
+      REAL,  DIMENSION(3) :: BO3RND,AO3RND
+      REAL,  DIMENSION(NBLY) :: APCM,BPCM,ATPCM,BTPCM,ACOMB, &
+                                BCOMB,BETACM
+
+      DATA AO3RND / 0.543368E+02,  0.234676E+04,  0.384881E+02/ 
+      DATA BO3RND / 0.526064E+01,  0.922424E+01,  0.496515E+01/
+
+      DATA ACOMB  / &
+         0.152070E+05,  0.332194E+04,  0.527177E+03,  0.163124E+03, &
+         0.268808E+03,  0.534591E+02,  0.268071E+02,  0.123133E+02, &
+         0.600199E+01,  0.640803E+00,  0.501549E-01,  0.167961E-01, &
+         0.178110E-01,  0.170166E+00,  0.537083E-02/
+      DATA BCOMB  / &
+         0.152538E+00,  0.118677E+00,  0.103660E+00,  0.100119E+00, &
+         0.127518E+00,  0.118409E+00,  0.904061E-01,  0.642011E-01, &
+         0.629660E-01,  0.643346E-01,  0.717082E-01,  0.629730E-01, &
+         0.875182E-01,  0.857907E-01,  0.214005E+00/
+      DATA APCM   / &
+        -0.671879E-03,  0.654345E-02,  0.143657E-01,  0.923593E-02, &
+         0.117022E-01,  0.159596E-01,  0.181600E-01,  0.145013E-01, &
+         0.170062E-01,  0.233303E-01,  0.256735E-01,  0.274745E-01, &
+         0.279259E-01,  0.197002E-01,  0.349782E-01/
+      DATA BPCM   / &
+        -0.113520E-04, -0.323965E-04, -0.448417E-04, -0.230779E-04, &
+        -0.361981E-04, -0.145117E-04,  0.198349E-04, -0.486529E-04, &
+        -0.550050E-04, -0.684057E-04, -0.447093E-04, -0.778390E-04, &
+        -0.982953E-04, -0.772497E-04, -0.748263E-04/
+      DATA ATPCM  / &
+        -0.106346E-02,  0.641531E-02,  0.137362E-01,  0.922513E-02, &
+         0.136162E-01,  0.169791E-01,  0.206959E-01,  0.166223E-01, &
+         0.171776E-01,  0.229724E-01,  0.275530E-01,  0.302731E-01, &
+         0.281662E-01,  0.199525E-01,  0.370962E-01/
+      DATA BTPCM  / &
+        -0.735731E-05, -0.294149E-04, -0.505592E-04, -0.280894E-04, &
+        -0.492972E-04, -0.341508E-04, -0.362947E-04, -0.250487E-04, &
+        -0.521369E-04, -0.746260E-04, -0.744124E-04, -0.881905E-04, &
+        -0.933645E-04, -0.664045E-04, -0.115290E-03/
+      DATA BETACM / &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.188625E+03,  0.144293E+03,  0.174098E+03,  0.909366E+02, &
+         0.497489E+02,  0.221212E+02,  0.113124E+02,  0.754174E+01, &
+         0.589554E+01,  0.495227E+01,  0.000000E+00/
+
+
+!        *********************************************
+!====>   *   OUTPUT TO CALLING PROGRAM               *
+!        *********************************************
+
+       REAL, INTENT(INOUT),DIMENSION(its:ite,kts:kte)::SWH,HLW
+       REAL, INTENT(OUT), DIMENSION(its:ite):: FSWUP,FSWUPS,FSWDN, &
+                           FSWDNS,FLWUP,FLWDNS,FSWDNSC
+      
+!        *********************************************
+!====>   *   POSSIBLE OUTPUT TO CALLING PROGRAM      *
+!        *********************************************
+
+      REAL, DIMENSION(its:ite):: GDFVBR,GDFNBR,GDFVDR,GDFNDR
+
+!        ************************************************************
+!====>   *   ARRAYS NEEDED BY SWR91SIB..FOR CLEAR SKY DATA(EG.FSWL) *
+!        ************************************************************
+
+      REAL, DIMENSION(its:ite,kts:kte+1)::FSWL,HSWL,UFL,DFL
+
+!        ******************************************************
+!====>   *   ARRAYS NEEDED BY CLO88, LWR88, SWR89 OR SWR91SIB *
+!        ******************************************************
+
+       REAL, DIMENSION(its:ite,kts:kte+1,kts:kte+1)::CLDFAC
+       REAL, DIMENSION(its:ite,kts:kte+1)::EQCMT,PRESS,TEMP,FSW,HSW,UF,DF
+       REAL, DIMENSION(its:ite,kts:kte)::RH2O,QO3,HEATRA
+       REAL, DIMENSION(its:ite):: COSZEN,TAUDA,GRNFLX,TOPFLX,GRDFLX
+       REAL, DIMENSION(kts:kte+1)::PHALF
+!..... ADD PRESSURE INTERFACE
+
+       REAL,    DIMENSION(NB) :: ABCFF,PWTS
+
+       DATA ABCFF/2*4.0E-5,.002,.035,.377,1.95,9.40,44.6,190., &
+                  989.,2706.,39011./
+       DATA PWTS/.5000,.121416,.0698,.1558,.0631,.0362,.0243,.0158,.0087, &
+                 .001467,.002342,.001075/
+
+       REAL     :: CFCO2,CFO3,REFLO3,RRAYAV
+
+       DATA CFCO2,CFO3/508.96,466.64/
+       DATA REFLO3/1.9/
+       DATA RRAYAV/0.144/
+
+!        *********************************************
+!====>   *   VECTOR TEMPORARIES FOR CLOUD CALC.      *
+!        *********************************************
+
+       REAL,    DIMENSION(its:ite):: TTHAN
+       REAL,    DIMENSION(its:ite,kts:kte):: DO3V,DO3VP
+       INTEGER, DIMENSION(its:ite):: JJROW
+
+!====>    **************************************************************
+!--     SEASONAL CLIMATOLOGIES OF O3 (OBTAINED FROM A PREVIOUSLY RUN
+!             CODE WHICH INTERPOLATES O3 TO USER VERTICAL COORDINATE).
+!         DEFINED AS 5 DEG LAT MEANS N.P.->S.P.
+!         COMMON /SAVMEM/ &
+!-       ...WINTER....  ...SPRING....  ...SUMMER....  ....FALL.....
+!        DDUO3N(37,L), DDO3N2(37,L), DDO3N3(37,L), DDO3N4(37,L)
+
+       REAL, DIMENSION(37,kte) :: DDUO3N,DDO3N2,DDO3N3,DDO3N4
+
+!====>    **************************************************************
+!
+      REAL,   DIMENSION(21,20) :: ALBD
+      REAL,   DIMENSION(20)    :: ZA
+      REAL,   DIMENSION(21)    :: TRN
+      REAL,   DIMENSION(19)    :: DZA
+
+      REAL    :: YEAR,TPI,SSOLAR,DATE,TH2,ZEN,DZEN,ALB1,ALB2
+      INTEGER :: IR,IQ,JX
+      DATA TRN/.00,.05,.10,.15,.20,.25,.30,.35,.40,.45,.50,.55,.60,.65, &
+               .70,.75,.80,.85,.90,.95,1.00/
+
+      REAL ::  ALB11(21,7),ALB22(21,7),ALB33(21,6)
+
+      EQUIVALENCE (ALB11(1,1),ALBD(1,1)),(ALB22(1,1),ALBD(1,8)), &
+                  (ALB33(1,1),ALBD(1,15))
+      DATA ALB11/ .061,.062,.072,.087,.115,.163,.235,.318,.395,.472,.542, &
+       .604,.655,.693,.719,.732,.730,.681,.581,.453,.425,.061,.062,.070, &
+       .083,.108,.145,.198,.263,.336,.415,.487,.547,.595,.631,.656,.670, &
+       .652,.602,.494,.398,.370,.061,.061,.068,.079,.098,.130,.174,.228, &
+       .290,.357,.424,.498,.556,.588,.603,.592,.556,.488,.393,.342,.325, &
+       .061,.061,.065,.073,.086,.110,.150,.192,.248,.306,.360,.407,.444, &
+       .469,.480,.474,.444,.386,.333,.301,.290,.061,.061,.065,.070,.082, &
+       .101,.131,.168,.208,.252,.295,.331,.358,.375,.385,.377,.356,.320, &
+       .288,.266,.255,.061,.061,.063,.068,.077,.092,.114,.143,.176,.210, &
+       .242,.272,.288,.296,.300,.291,.273,.252,.237,.266,.220,.061,.061, &
+       .062,.066,.072,.084,.103,.127,.151,.176,.198,.219,.236,.245,.250, &
+       .246,.235,.222,.211,.205,.200/
+      DATA ALB22/ .061,.061,.061,.065,.071,.079,.094,.113,.134,.154,.173, &
+       .185,.190,.193,.193,.190,.188,.185,.182,.180,.178,.061,.061,.061, &
+       .064,.067,.072,.083,.099,.117,.135,.150,.160,.164,.165,.164,.162, &
+       .160,.159,.158,.157,.157,.061,.061,.061,.062,.065,.068,.074,.084, &
+       .097,.111,.121,.127,.130,.131,.131,.130,.129,.127,.126,.125,.122, &
+       .061,.061,.061,.061,.062,.064,.070,.076,.085,.094,.101,.105,.107, &
+       .106,.103,.100,.097,.096,.095,.095,.095,.061,.061,.061,.060,.061, &
+       .062,.065,.070,.075,.081,.086,.089,.090,.088,.084,.080,.077,.075, &
+       .074,.074,.074,.061,.061,.060,.060,.060,.061,.063,.065,.068,.072, &
+       .076,.077,.076,.074,.071,.067,.064,.062,.061,.061,.061,.061,.061, &
+       .060,.060,.060,.060,.061,.062,.065,.068,.069,.069,.068,.065,.061, &
+       .058,.055,.054,.053,.052,.052/
+      DATA ALB33/ .061,.061,.060,.060,.060,.060,.060,.060,.062,.065,.065, &
+       .063,.060,.057,.054,.050,.047,.046,.045,.044,.044,.061,.061,.060, &
+       .060,.060,.059,.059,.059,.059,.059,.058,.055,.051,.047,.043,.039, &
+       .035,.033,.032,.031,.031,.061,.061,.060,.060,.060,.059,.059,.058, &
+       .057,.056,.054,.051,.047,.043,.039,.036,.033,.030,.028,.027,.026, &
+       .061,.061,.060,.060,.060,.059,.059,.058,.057,.055,.052,.049,.045, &
+       .040,.036,.032,.029,.027,.026,.025,.025,.061,.061,.060,.060,.060, &
+       .059,.059,.058,.056,.053,.050,.046,.042,.038,.034,.031,.028,.026, &
+       .025,.025,.025,.061,.061,.060,.060,.059,.058,.058,.057,.055,.053, &
+       .050,.046,.042,.038,.034,.030,.028,.029,.025,.025,.025/
+      DATA ZA/90.,88.,86.,84.,82.,80.,78.,76.,74.,70.,66.,62.,58.,54., &
+              50.,40.,30.,20.,10.,0.0/
+      DATA DZA/8*2.0,6*4.0,5*10.0/
+
+!    ***********************************************************
+!
+
+       REAL,    DIMENSION(its:ite)        :: ALVB,ALNB,ALVD,ALND, &
+                                             GDFVB,   &
+                                             GDFNB,GDFVD,GDFND,   &
+                                             SFCALB
+
+       REAL    :: RRVCO2,RRCO2,TDUM
+       REAL    :: ALBD0,ALVD1,ALND1
+       INTEGER :: N
+!
+!***  The following two lines are for debugging.
+       integer :: imd,jmd, Jndx
+       real :: FSWrat,FSWrat1,FSWDNS1
+!***
+
+!====>    BEGIN HERE             .......................
+!
+!--- SSOLAR IS THE SOLAR CONSTANT SCALED TO A MORE CURRENT VALUE;
+!          I.E. IF SOLC=2.0 LY/MIN THEN SSOLAR=1.96 LY/MIN.
+      REAL,PARAMETER :: H196=1.96
+
+      INTEGER :: K, I,KP,LLM2,J1,J3,KMAX,KMIN,KCLDS,ICNT,LLM1
+      INTEGER :: L,LP1,LP2,LP3,LM1,LM2,LM3,MYIS,MYIE,LLP1,LL,KK,KLEN
+
+      L=kte
+      LP1=L+1;  LP2=L+2;  LP3=L+3; LLP1 = 2*L + 1
+      LM1=L-1;  LM2=L-2;  LM3=L-3; LL = 2*L
+      LLM2 = LL-2; LLM1=LL-1
+      MYIS=its; MYIE=ite
+
+!******ZHAO
+!  NOTE: XLAT IS IN DEGREE HERE
+!*****ZHAO
+!-- Formerly =>  SOLC=2./(R1*R1), SSOLAR=0.98*SOLC
+      SSOLAR=H196/(R1*R1)
+!*********************************************************
+! Special note: The solar constant is reduced extra 3 percent to account
+!               for the lack of aerosols in the shortwave radiation
+!               parameterization.       Q. Zhao    96-7-23
+! ### May also be due not accounting for reduction in solar constant due to
+!     absorption by ozone above the top of the model domain (Ferrier, Apr-2005)
+!*********************************************************
+      SSOLAR=SSOLAR*0.97
+!
+      DO 40 I=MYIS,MYIE
+        IR = I + IBEG - 1
+        TH2=HP2*XLAT(IR)
+        JJROW(I)=Q19001-TH2
+        TTHAN(I)=(19-JJROW(I))-TH2
+!.....  NOTE THAT THE NMC VARIABLES ARE IN MKS (THUS PRESSURE IS IN
+!          CENTIBARS)WHILE ALL GFDL VARIABLES ARE IN CGS UNITS
+        SFCALB(I) = ALBEDO(IR)
+!.....  NOW PUT SFC TEMP,PRESSURES, ZENITH ANGLE INTO SW COMMON BLOCK...
+!***ZHAO
+!  NOTE: ALL PRESSURES INPUT FROM THE ETA MODEL ARE IN PA
+!        THE UNIT FOR PRESS IS MICRO BAR 
+!        SURFACE TEMPERATURE ARE NEGATIVE OVER OCEANS IN THE ETA MODEL
+!***ZHAO
+        PRESS(I,LP1)=QS(IR)*10.0
+        TEMP(I,LP1)=ABS(TSFC(IR))
+        COSZEN(I) = COSZRO(IR)
+        TAUDA(I) = TAUDAR(IR)
+   40 CONTINUE
+!***ZHAO
+!.....  ALL GFDL VARIABLES HAVE K=1 AT THE TOP OF THE ATMOSPHERE.NMC
+!       ETA MODEL HAS THE SAME STRUCTURE
+!***ZHAO
+      DO 50 K=1,L
+       DO 50 I=MYIS,MYIE
+        IR = I + IBEG - 1
+!.....  NOW PUT TEMP,PRESSURES, INTO SW COMMON BLOCK..........
+        TEMP(I,K) = TT(IR,K)
+        PRESS(I,K) = 10.0 * PP(IR,K)
+!.... STORE LYR MOISTURE AND ADD TO SW COMMON BLOCK
+        RH2O(I,K)=QQH2O(IR,K)
+        IF(RH2O(I,K).LT.H3M6) RH2O(I,K)=H3M6
+   50 CONTINUE
+!...    *************************
+      IF (KO3.EQ.0) GO TO 65
+!...    *************************
+      DO 60 K=1,L
+       DO 60 I=MYIS,MYIE
+        QO3(I,K) = O3QO3(I+IBEG-1,K)
+   60 CONTINUE
+   65 CONTINUE
+!...   ************************************
+      IF (KALB.GT.0) GO TO 110
+!...   ************************************
+!..... THE FOLLOWING CODE GETS ALBEDO FROM PAYNE,1972 TABLES IF
+!         1) OPEN SEA POINT (SLMSK=1);2) KALB=0
+      IQ=INT(TWENTY*HP537+ONE)
+      DO 105 I=MYIS,MYIE
+         IF(COSZEN(I).GT.0.0 .AND. SLMSK(I+IBEG-1).GT.0.5) THEN
+           ZEN=DEGRAD*ACOS(MAX(COSZEN(I),0.0))
+           IF(ZEN.GE.H74E1) JX=INT(HAF*(HNINETY-ZEN)+ONE)
+           IF(ZEN.LT.H74E1.AND.ZEN.GE.FIFTY) &
+              JX=INT(QUARTR*(H74E1-ZEN)+HNINE)
+           IF(ZEN.LT.FIFTY) JX=INT(HP1*(FIFTY-ZEN)+H15E1)
+           DZEN=-(ZEN-ZA(JX))/DZA(JX)
+           ALB1=ALBD(IQ,JX)+DZEN*(ALBD(IQ,JX+1)-ALBD(IQ,JX))
+           ALB2=ALBD(IQ+1,JX)+DZEN*(ALBD(IQ+1,JX+1)-ALBD(IQ+1,JX))
+           SFCALB(I)=ALB1+TWENTY*(ALB2-ALB1)*(HP537-TRN(IQ))
+         ENDIF
+  105 CONTINUE
+  110 CONTINUE
+!        **********************************
+      IF (KO3.GT.0) GO TO 135
+!        **********************************
+!.... COMPUTE CLIMATOLOGICAL ZONAL MEAN OZONE,
+!....   SEASONAL AND SPATIAL INTERPOLATION DONE BELOW.
+      DO 125 I=MYIS,MYIE
+
+         PHALF(1)=0.
+         PHALF(LP1)=PPI(I,kme)
+         DO K=1,LM1
+            PHALF(K+1)=PP(I,K) !  AETA(K)*PDIF+PT ! BSF index was erroneously L
+         ENDDO
+
+         CALL O3INT(PHALF,DDUO3N,DDO3N2,DDO3N3,DDO3N4, &
+                 ids,ide, jds,jde, kds,kde,            &
+                 ims,ime, jms,jme, kms,kme,            &
+                 its,ite, jts,jte, kts,kte             )
+
+         DO 130 K=1,L
+          DO3V(I,K)  = DDUO3N(JJROW(I),K) + RSIN1*DDO3N2(JJROW(I),K) &
+                      +RCOS1*DDO3N3(JJROW(I),K) &
+                      +RCOS2*DDO3N4(JJROW(I),K)
+          DO3VP(I,K) = DDUO3N(JJROW(I)+1,K) + RSIN1*DDO3N2(JJROW(I)+1,K) &
+                     +RCOS1*DDO3N3(JJROW(I)+1,K) &
+                     +RCOS2*DDO3N4(JJROW(I)+1,K)
+!...   NOW LATITUDINAL INTERPOLATION, AND
+!          CONVERT O3 INTO MASS MIXING RATIO(ORIGINAL DATA MPY BY 1.E4)
+          QO3(I,K) = H1M4 * (DO3V(I,K)+TTHAN(I)*(DO3VP(I,K)-DO3V(I,K)))
+  130   CONTINUE
+  125 CONTINUE
+  135 CONTINUE
+!.............
+      DO 195 I=MYIS,MYIE
+!.....     VISIBLE AND NEAR IR DIFFUSE ALBEDO
+        ALVD(I) = SFCALB(I)
+        ALND(I) = SFCALB(I)
+!.....     VISIBLE AND NEAR IR DIRECT BEAM ALBEDO
+        ALVB(I) = SFCALB(I)
+        ALNB(I) = SFCALB(I)
+!
+!--- Remove diurnal variation of land surface albedos (Ferrier, 6/28/05)
+!--- Turn back on to mimic NAM 8/17/05
+!
+!.....     VISIBLE AND NEAR IR DIRECT BEAM ALBEDO,IF NOT OCEAN NOR SNOW
+!        ..FUNCTION OF COSINE SOLAR ZENITH ANGLE..
+        IF (SLMSK(I+IBEG-1).LT.0.5) THEN
+         IF (SFCALB(I).LE.0.5) THEN
+          ALBD0 = -18.0 * (0.5 - ACOS(COSZEN(I))/PI)
+          ALBD0 = EXP (ALBD0)
+          ALVD1 = (ALVD(I) - 0.054313) / 0.945687
+          ALND1 = (ALND(I) - 0.054313) / 0.945687
+          ALVB(I) = ALVD1 + (1.0 - ALVD1) * ALBD0
+          ALNB(I) = ALND1 + (1.0 - ALND1) * ALBD0
+ !-- Put in an upper limit on beam albedos
+          ALVB(I) = MIN(0.5,ALVB(I))
+          ALNB(I) = MIN(0.5,ALNB(I))
+         END IF
+        END IF
+  195 CONTINUE
+!.....SURFACE VALUES OF RRCL AND TTCL
+      DO 200 N=1,2
+        DO 200 I=MYIS,MYIE
+      RRCL(I,N,1)=ALVD(I)
+      TTCL(I,N,1)=ZERO
+  200 CONTINUE
+      DO 220 N=3,NB
+      DO 220 I=MYIS,MYIE
+         RRCL(I,N,1)=ALND(I)
+         TTCL(I,N,1)=ZERO
+  220 CONTINUE
+!...     **************************
+!...     *  END OF CLOUD SECTION  *
+!...     **************************
+!... THE FOLLOWING CODE CONVERTS RRVCO2,THE VOLUME MIXING RATIO OF CO2
+!   INTO RRCO2,THE MASS MIXING RATIO.
+      RRVCO2=RCO2
+      RRCO2=RRVCO2*RATCO2MW
+  250 IF(ITIMLW .EQ. 0) GO TO 300
+!
+!             ***********************
+!====>        * LONG WAVE RADIATION *
+!             ***********************
+!
+!....     ACCOUNT FOR REDUCED EMISSIVITY OF ANY CLDS
+      DO 240 K=1,LP1
+      DO 240 I=MYIS,MYIE
+        EQCMT(I,K)=CAMT(I,K)*EMCLD(I,K)
+  240 CONTINUE
+!....    GET CLD FACTOR FOR LW CALCULATIONS
+!....
+
+! shuhua
+
+      CALL CLO89(CLDFAC,EQCMT,NCLDS,KBTM,KTOP, &
+                 ids,ide, jds,jde, kds,kde,    &
+                 ims,ime, jms,jme, kms,kme,    &
+                 its,ite, jts,jte, kts,kte     )
+
+! shuhua
+!===>        LONG WAVE RADIATION
+!     CALL LWR88(HEATRA,GRNFLX,TOPFLX,         &
+!                PRESS,TEMP,RH2O,QO3,CLDFAC,   &
+!                EQCMT,NCLDS,KTOP,KBTM,        &
+!
+!!               BO3RND,AO3RND,T1,T2,T4,EM1V,EM1VW,EM3V, &
+!                BO3RND,AO3RND, &
+!                APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+!                ZERO,ONE,H18E3,P0INV,H6P08108,DIFFCTR,        &
+!                GINV,H3M4,BETINW,RATH2OMW,GP0INV,P0,P0XZP8,   &
+!                P0XZP2,H3M3,H1M3,H1M2,H25E2,B0,B2,B1,B3,HAF,  &
+!                TEN,HP1,FOUR,HM1EZ,SKO3R,                     &
+!                AB15WD,SKC1R,RADCON,QUARTR,TWO,               &
+!                HM6666M2,HMP66667,HMP5, HP166666,H41666M2,    &
+!                RADCON1,H16E1, H28E1,H44194M2,H1P41819,SKO2D, &
+!                ids,ide, jds,jde, kds,kde,                    &
+!                ims,ime, jms,jme, kms,kme,                    &
+!                its,ite, jts,jte, kts,kte                    )
+
+      CALL LWR88(HEATRA,GRNFLX,TOPFLX,         &
+                 PRESS,TEMP,RH2O,QO3,CLDFAC,   &
+                 EQCMT,NCLDS,KTOP,KBTM,        &
+!
+!                BO3RND,AO3RND,T1,T2,T4,EM1V,EM1VW,EM3V, &
+                 BO3RND,AO3RND, &
+                 APCM,BPCM,ATPCM,BTPCM,ACOMB,BCOMB,BETACM,     &
+                 ZERO,ONE,H18E3,P0INV,H6P08108,DIFFCTR,        &
+                 GINV,H3M4,BETINW,RATH2OMW,GP0INV,P0,P0XZP8,   &
+                 P0XZP2,H3M3,H1M3,H1M2,H25E2,B0,B2,B1,B3,HAF,  &
+                 TEN,HP1,FOUR,HM1EZ,                           &
+                 RADCON,QUARTR,TWO,                            &
+                 HM6666M2,HMP66667,HMP5, HP166666,H41666M2,    &
+                 RADCON1,H16E1, H28E1,H44194M2,H1P41819,       &
+                 ids,ide, jds,jde, kds,kde,                    &
+                 ims,ime, jms,jme, kms,kme,                    &
+                  its,ite, jts,jte, kts,kte                    )
+
+!....
+!================================================================================
+!--- IMPORTANT!!  Y.-T Hou advised Ferrier, Mitchell, & Ek on 7/28/05 to use 
+!    the following algorithm, because the GFDL code calculates NET longwave flux 
+!    (GRNFLX, Up - Down) as its fundamental quantity.  
+!
+!    1.  Calculate upward LW at surface (FLWUPS)
+!    2.  Calculate downward LW at surface (FLWDNS) = FLWUPS - .001*GRNFLX
+!
+!--- Note:  The following fluxes must be multipled by .001 to convert to mks
+!       => GRNFLX, or GRound Net FLuX 
+!       => TOPFLX, or top of the atmosphere fluxes (FLWUP)
+!
+!--- IMPORTANT!!  If the surface emissivity (SFCEMS) differs from 1.0, then 
+!    uncomment the line below starting with "!BSF"
+!================================================================================
+      DO 280 I=MYIS,MYIE
+        IR = I + IBEG - 1
+        FLWUP(IR) = .001*TOPFLX(I)
+!        TDUM=TEMP(I,LP1)
+!--- Use an average of the skin & lowest model level temperature
+        TDUM=.5*(TEMP(I,LP1)+TEMP(I,L))
+        FLWUPS(IR)=HSIGMA*TDUM*TDUM*TDUM*TDUM
+!BSF        FLWUPS(IR)=SFCEMS*HSIGMA*TDUM*TDUM*TDUM*TDUM
+        FLWDNS(IR)=FLWUPS(IR)-.001*GRNFLX(I)
+  280 CONTINUE
+!....  Average LW heating/cooling rates over the lowest 2 atmospheric layers,
+!      which may be necessary for when dealing with thin layers near the surface
+      DO I=MYIS,MYIE
+         TDUM=.5*(HEATRA(I,L)+HEATRA(I,LM1))
+         HEATRA(I,L)=TDUM
+         HEATRA(I,LM1)=TDUM
+      ENDDO
+!....      CONVERT HEATING RATES TO DEG/SEC
+      DO 290 K=1,L
+        DO 290 I=MYIS,MYIE
+          HLW(I+IBEG-1,K)=HEATRA(I,K)*DAYSEC
+  290 CONTINUE
+  300 CONTINUE
+      IF(ITIMSW .EQ. 0) GO TO 350
+!SW
+      CALL SWR93(FSW,HSW,UF,DF,FSWL,HSWL,UFL,DFL, &
+                 PRESS,COSZEN,TAUDA,RH2O,RRCO2,SSOLAR,QO3, &
+                 NCLDS,KTOP,KBTM,CAMT,RRCL,TTCL, &
+                 ALVB,ALNB,ALVD,ALND,GDFVB,GDFNB,GDFVD,GDFND, &
+!
+!                UCO2,UO3,TUCO2,TUO3,TDO3,TDCO2,                &
+                 ABCFF,PWTS,                                    &
+                 H35E1,H1224E3,ONE,ZERO,HAF,H69766E5,HP219,     &
+                 HP816,RRAYAV,GINV,CFCO2,CFO3,                  &
+                 TWO,H235M3,HP26,H129M2,H75826M4,H1036E2,       &
+                 H1P082,HMP805,H1386E2,H658M2,H2118M2,H42M2,    &
+                 H323M4,HM1EZ,DIFFCTR,O3DIFCTR,FIFTY,RADCON,    &
+                 ids,ide, jds,jde, kds,kde,                     &
+                 ims,ime, jms,jme, kms,kme,                     &
+                 its,ite, jts,jte, kts,kte                      )
+
+!SW
+!
+!.....    GET SW FLUXES IN WATTS/M**2
+      DO 320 I=MYIS,MYIE
+       IR = I + IBEG - 1
+       FSWUP(IR) = UF(I,1) * 1.E-3
+       FSWDN(IR) = DF(I,1) * 1.E-3
+       FSWUPS(IR) = UF(I,LP1) * 1.E-3
+!-- FSWDNS is more accurate using array DF than summing the GDFxx arrays
+!C..COUPLE W/M2 DIFF, IF FSWDNS(IR)=DF(I,LP1)*1.#E-3
+!!       FSWDNS(IR) = (GDFVB(I)+GDFNB(I)+GDFVD(I)+GDFND(I)) * 1.E-3
+       FSWDNS(IR) = DF(I,LP1) * 1.E-3
+       FSWDNSC(IR) = DFL(I,LP1) * 1.E-3
+!...    DOWNWARD SFC FLUX FOR THE SIB PARAMETERATION
+!.....     VISIBLE AND NEAR IR DIFFUSE
+       GDFVDR(IR) = GDFVD(I) * 1.E-3
+       GDFNDR(IR) = GDFND(I) * 1.E-3
+!.....     VISIBLE AND NEAR IR DIRECT BEAM
+       GDFVBR(IR) = GDFVB(I) * 1.E-3
+       GDFNBR(IR) = GDFNB(I) * 1.E-3
+  320 CONTINUE
+!....      CONVERT HEATING RATES TO DEG/SEC
+      DO 330 K=1,L
+        DO 330 I=MYIS,MYIE
+          SWH(I+IBEG-1,K)=HSW(I,K)*DAYSEC
+  330 CONTINUE
+  350 CONTINUE
+! begin debugging radiation
+
+!     if (Jndx .eq. jmd) then
+!       FSWDNS1=(GDFVB(imd)+GDFNB(imd)+GDFVD(imd)+GDFND(imd))*.001
+!       write(6,"(3a,2i5,7f9.2)") '{rad2 imd,Jndx,'  &
+!      ,'GSW=FSWDNS-FSWUPS,RSWIN=FSWDNS,RSWIN_1=FSWDNS1,' &
+!      ,'FSWDNS-FSWDNS1,RSWOUT=FSWUPS,RSWINC=FSWDNSC,GLW=FLWDNS = ' &
+!      ,imd,Jndx, FSWDNS(imd)-FSWUPS(imd),FSWDNS(imd),FSWDNS1  &
+!      ,FSWDNS(imd)-FSWDNS1,FSWUPS(imd),FSWDNSC(imd),FLWDNS(imd)
+!       FSWrat=0.
+!       if (FSWDNS(imd) .ne. 0.) FSWrat=FSWUPS(imd)/FSWDNS(imd)
+!       FSWrat1=0.
+!       if (FSWDNS1 .ne. 0.) FSWrat1=FSWUPS(imd)/FSWDNS1
+!       write(6,"(2a,10f8.4)") '{rad2a ALBEDO,SFCALB,ALVD,ALND,ALVB,' &
+!      ,'ALNB,CZEN,SLMSK,FSWUPS/FSWDNS,FSWUPS/FSWDNS1 = ' &
+!      ,ALBEDO(imd),SFCALB(imd),ALVD(imd),ALND(imd),ALVB(imd)  &
+!      ,ALNB(imd),COSZEN(imd),SLMSK(imd),FSWrat,FSWrat1
+!     endif
+! end debugging radiation
+      RETURN
+ 1000 FORMAT(1H ,' YOU ARE CALLING GFDL RADIATION CODE FOR',I5,' PTS', &
+                 'AND',I4,' LYRS,WITH KDAPRX,KO3,KCZ,KEMIS,KALB = ',5I2)
+ 
+  END SUBROUTINE RADFS 
+
+!-----------------------------------------------------------------------
+    SUBROUTINE O3CLIM
+!                (XDUO3N,XDO3N2,XDO3N3,XDO3N4,PRGFDL,         &
+!                ids,ide, jds,jde, kds,kde,                   &
+!                ims,ime, jms,jme, kms,kme,                   &
+!                its,ite, jts,jte, kts,kte                    )
+!----------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+!     INTEGER, INTENT(IN)        :: ids,ide, jds,jde, kds,kde ,      &
+!                                   ims,ime, jms,jme, kms,kme ,      &
+!                                   its,ite, jts,jte, kts,kte
+
+!     ******************************************************************
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .     
+! SUBPROGRAM:    O3CLIM      GENERATE SEASONAL OZONE DISTRIBUTION
+!   PRGRMMR: GFDL/CAMPANA    ORG: W/NP22     DATE: ??-??-??
+!     
+! ABSTRACT:
+!     O3CLIM COMPUTES THE SEASONAL CLIMATOLOGY OF OZONE USING
+!     81-LAYER DATA FROM GFDL.
+!     
+! PROGRAM HISTORY LOG:
+!   ??-??-??  GFDL/KC    - ORIGINATOR
+!   96-07-26  BLACK      - MODIFIED FOR ETA MODEL
+!     
+! USAGE: CALL O3CLIM FROM SUBROUTINE RADTN
+!   INPUT ARGUMENT LIST:
+!     NONE     
+!  
+!   OUTPUT ARGUMENT LIST: 
+!     NONE
+!     
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE:
+!        NONE
+!  
+!     LIBRARY:
+!        NONE
+!  
+!   COMMON BLOCKS: SEASO3
+!                  O3DATA
+!   
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!$$$  
+!----------------------------------------------------------------------
+!      INTEGER   :: NL,NLP1,NLGTH,NKK,NK,NKP
+       INTEGER, PARAMETER :: NL=81,NLP1=NL+1,NLGTH=37*NL,NKK=41,NK=81,NKP=NK+1
+!----------------------------------------------------------------------
+!     INCLUDE "SEASO3.comm"
+!---------------------------------------------------------------------
+!     REAL, INTENT(OUT), DIMENSION(37,NL) :: XDUO3N,XDO3N2,XDO3N3,XDO3N4
+!     REAL, INTENT(OUT), DIMENSION(NL)    :: PRGFDL
+
+!      COMMON /SEASO3/
+!      ...WINTER....  ...SPRING....  ...SUMMER....  ....FALL.....
+!    & XDUO3N(37,NL), XDO3N2(37,NL), XDO3N3(37,NL), XDO3N4(37,NL)
+!
+!    &,PRGFDL(NL)
+!---------------------------------------------------------------------
+       REAL :: PH1(45),PH2(37),P1(48),P2(33),O3HI1(10,16),O3HI2(10,9) &
+              ,O3LO1(10,16),O3LO2(10,16),O3LO3(10,16),O3LO4(10,16)
+!----------------------------------------------------------------------
+       REAL    :: AVG,A1,B1,B2
+       INTEGER :: K,N,NCASE,IPLACE,KK,NKM,NKMM,KI,KQ,JJ,KEN,I,iindex,jindex
+!----------------------------------------------------------------------
+       REAL :: PSTD(NL),TEMPN(19),O3O3(37,NL,4),O35DEG(37,NL) &
+      ,XRAD1(NLGTH),XRAD2(NLGTH),XRAD3(NLGTH),XRAD4(NLGTH) &
+      ,DDUO3N(19,NL),DUO3N(19,41) &
+      ,RO3(10,41),RO3M(10,40),RO31(10,41),RO32(10,41) &
+      ,O3HI(10,25) &
+      ,RSTD(81),RBAR(NL),RDATA(81) &
+      ,PHALF(NL),P(81),PH(82)
+       REAL   :: PXX(81),PYY(82)                       !  fix for nesting
+!----------------------------------------------------------------------
+!nesting                         EQUIVALENCE &
+!nesting     (O3HI1(1,1),O3HI(1,1)),(O3HI2(1,1),O3HI(1,17)) &
+!nesting    ,(PH1(1),PH(1)),(PH2(1),PH(46)) &
+!nesting    ,(P1(1),P(1)),(P2(1),P(49))
+                           EQUIVALENCE &
+       (O3HI1(1,1),O3HI(1,1)),(O3HI2(1,1),O3HI(1,17)) &
+      ,(PH1(1),PYY(1)),(PH2(1),PYY(46)) &               ! fix for nesting
+      ,(P1(1),PXX(1)),(P2(1),PXX(49))                   ! fix for nesting
+!----------------------------------------------------------------------
+!                          EQUIVALENCE &
+!      (XRAD1(1),XDUO3N(1,1),O3O3(1,1,1)) &
+!     ,(XRAD2(1),XDO3N2(1,1)) &
+!     ,(XRAD3(1),XDO3N3(1,1)),(XRAD4(1),XDO3N4(1,1),)
+                           EQUIVALENCE &
+       (XRAD1(1),O3O3(1,1,1)) &
+      ,(XRAD2(1),O3O3(1,1,2)) &
+      ,(XRAD3(1),O3O3(1,1,3)),(XRAD4(1),O3O3(1,1,4))
+!----------------------------------------------------------------------
+!---------------------------------------------------------------------
+      DATA PH1/      0.,     &
+           0.1027246E-04, 0.1239831E-04, 0.1491845E-04, 0.1788053E-04,     &
+           0.2135032E-04, 0.2540162E-04, 0.3011718E-04, 0.3558949E-04,     &
+           0.4192172E-04, 0.4922875E-04, 0.5763817E-04, 0.6729146E-04,     &
+           0.7834518E-04, 0.9097232E-04, 0.1053635E-03, 0.1217288E-03,     &
+           0.1402989E-03, 0.1613270E-03, 0.1850904E-03, 0.2119495E-03,     &
+           0.2423836E-03, 0.2768980E-03, 0.3160017E-03, 0.3602623E-03,     &
+           0.4103126E-03, 0.4668569E-03, 0.5306792E-03, 0.6026516E-03,     &
+           0.6839018E-03, 0.7759249E-03, 0.8803303E-03, 0.9987843E-03,     &
+           0.1133178E-02, 0.1285955E-02, 0.1460360E-02, 0.1660001E-02,     &
+           0.1888764E-02, 0.2151165E-02, 0.2452466E-02, 0.2798806E-02,     &
+           0.3197345E-02, 0.3656456E-02, 0.4185934E-02, 0.4797257E-02/     
+      DATA PH2/     &
+           0.5503893E-02, 0.6321654E-02, 0.7269144E-02, 0.8368272E-02,     &
+           0.9644873E-02, 0.1112946E-01, 0.1285810E-01, 0.1487354E-01,     &
+           0.1722643E-01, 0.1997696E-01, 0.2319670E-01, 0.2697093E-01,     &
+           0.3140135E-01, 0.3660952E-01, 0.4274090E-01, 0.4996992E-01,     &
+           0.5848471E-01, 0.6847525E-01, 0.8017242E-01, 0.9386772E-01,     &
+           0.1099026E+00, 0.1286765E+00, 0.1506574E+00, 0.1763932E+00,     &
+           0.2065253E+00, 0.2415209E+00, 0.2814823E+00, 0.3266369E+00,     &
+           0.3774861E+00, 0.4345638E+00, 0.4984375E+00, 0.5697097E+00,     &
+           0.6490189E+00, 0.7370409E+00, 0.8344896E+00, 0.9421190E+00,     &
+           0.1000000E+01/     
+      DATA P1/     &
+           0.9300000E-05, 0.1129521E-04, 0.1360915E-04, 0.1635370E-04,     &
+           0.1954990E-04, 0.2331653E-04, 0.2767314E-04, 0.3277707E-04,     &
+           0.3864321E-04, 0.4547839E-04, 0.5328839E-04, 0.6234301E-04,     &
+           0.7263268E-04, 0.8450696E-04, 0.9793231E-04, 0.1133587E-03,     &
+           0.1307170E-03, 0.1505832E-03, 0.1728373E-03, 0.1982122E-03,     &
+           0.2266389E-03, 0.2592220E-03, 0.2957792E-03, 0.3376068E-03,     &
+           0.3844381E-03, 0.4379281E-03, 0.4976965E-03, 0.5658476E-03,     &
+           0.6418494E-03, 0.7287094E-03, 0.8261995E-03, 0.9380076E-03,     &
+           0.1063498E-02, 0.1207423E-02, 0.1369594E-02, 0.1557141E-02,     &
+           0.1769657E-02, 0.2015887E-02, 0.2295520E-02, 0.2620143E-02,     &
+           0.2989651E-02, 0.3419469E-02, 0.3909867E-02, 0.4481491E-02,     &
+           0.5135272E-02, 0.5898971E-02, 0.6774619E-02, 0.7799763E-02/     
+      DATA P2/     &
+           0.8978218E-02, 0.1036103E-01, 0.1195488E-01, 0.1382957E-01,     &
+           0.1599631E-01, 0.1855114E-01, 0.2151235E-01, 0.2501293E-01,     &
+           0.2908220E-01, 0.3390544E-01, 0.3952926E-01, 0.4621349E-01,     &
+           0.5403168E-01, 0.6330472E-01, 0.7406807E-01, 0.8677983E-01,     &
+           0.1015345E+00, 0.1189603E+00, 0.1391863E+00, 0.1630739E+00,     &
+           0.1908004E+00, 0.2235461E+00, 0.2609410E+00, 0.3036404E+00,     &
+           0.3513750E+00, 0.4055375E+00, 0.4656677E+00, 0.5335132E+00,     &
+           0.6083618E+00, 0.6923932E+00, 0.7845676E+00, 0.8875882E+00,     &
+           0.1000000E+01/     
+      DATA O3HI1/     &
+       .55,.50,.45,.45,.40,.35,.35,.30,.30,.30,     &
+       .55,.51,.46,.47,.42,.38,.37,.36,.35,.35,     &
+       .55,.53,.48,.49,.44,.42,.41,.40,.38,.38,     &
+       .60,.55,.52,.52,.50,.47,.46,.44,.42,.41,     &
+       .65,.60,.55,.56,.53,.52,.50,.48,.45,.45,     &
+       .75,.65,.60,.60,.55,.55,.55,.50,.48,.47,     &
+       .80,.75,.75,.75,.70,.70,.65,.63,.60,.60,     &
+       .90,.85,.85,.80,.80,.75,.75,.74,.72,.71,     &
+       1.10,1.05,1.00,.90,.90,.90,.85,.83,.80,.80,        &
+       1.40,1.30,1.25,1.25,1.25,1.20,1.15,1.10,1.05,1.00, &
+       1.7,1.7,1.6,1.6,1.6,1.6,1.6,1.6,1.5,1.5,     &
+       2.1,2.0,1.9,1.9,1.9,1.8,1.8,1.8,1.7,1.7,     &
+       2.4,2.3,2.2,2.2,2.2,2.1,2.1,2.1,2.0,2.0,     &
+       2.7,2.5,2.5,2.5,2.5,2.5,2.4,2.4,2.3,2.3,     &
+       2.9,2.8,2.7,2.7,2.7,2.7,2.7,2.7,2.6,2.6,     &
+       3.1,3.1,3.0,3.0,3.0,3.0,3.0,3.0,2.9,2.8/     
+      DATA O3HI2/     &
+       3.3,3.4,3.4,3.6,3.7,3.9,4.0,4.1,4.0,3.8,     &
+       3.6,3.8,3.9,4.2,4.7,5.3,5.6,5.7,5.5,5.2,     &
+       4.1,4.3,4.7,5.2,6.0,6.7,7.0,6.8,6.4,6.2,     &
+       5.4,5.7,6.0,6.6,7.3,8.0,8.4,7.7,7.1,6.7,     &
+       6.7,6.8,7.0,7.6,8.3,10.0,9.6,8.2,7.5,7.2,     &
+       9.2,9.3,9.4,9.6,10.3,10.6,10.0,8.5,7.7,7.3,     &
+       12.6,12.1,12.0,12.1,11.7,11.0,10.0,8.6,7.8,7.4, &
+       14.2,13.5,13.1,12.8,11.9,10.9,9.8,8.5,7.8,7.5,  &
+       14.3,14.0,13.4,12.7,11.6,10.6,9.3,8.4,7.6,7.3/     
+      DATA O3LO1/     &
+       14.9,14.2,13.3,12.5,11.2,10.3,9.5,8.6,7.5,7.4,  &
+       14.5,14.1,13.0,11.8,10.5,9.8,9.2,7.9,7.4,7.4,   &
+       11.8,11.5,10.9,10.5,9.9,9.6,8.9,7.5,7.2,7.2,    &
+       7.3,7.7,7.8,8.4,8.4,8.5,7.9,7.4,7.1,7.1,     &
+       4.1,4.4,5.3,6.6,6.9,7.5,7.4,7.2,7.0,6.9,     &
+       1.8,1.9,2.5,3.3,4.5,5.8,6.3,6.3,6.4,6.1,     &
+       0.4,0.5,0.8,1.2,2.7,3.6,4.6,4.7,5.0,5.2,     &
+       .10,.15,.20,.50,1.4,2.1,3.0,3.2,3.5,3.9,     &
+       .07,.10,.12,.30,1.0,1.4,1.8,1.9,2.3,2.5,     &
+       .06,.08,.10,.15,.60,.80,1.4,1.5,1.5,1.6,     &
+       .05,.05,.06,.09,.20,.40,.70,.80,.90,.90,     &
+       .05,.05,.06,.08,.10,.13,.20,.25,.30,.40,     &
+       .05,.05,.05,.06,.07,.07,.08,.09,.10,.13,     &
+       .05,.05,.05,.05,.06,.06,.06,.06,.07,.07,     &
+       .05,.05,.05,.05,.05,.05,.05,.06,.06,.06,     &
+       .04,.04,.04,.04,.04,.04,.04,.05,.05,.05/     
+      DATA O3LO2/     &
+       14.8,14.2,13.8,12.2,11.0,9.8,8.5,7.8,7.4,6.9,   &
+       13.2,13.0,12.5,11.3,10.4,9.0,7.8,7.5,7.0,6.6,   &
+       10.6,10.6,10.7,10.1,9.4,8.6,7.5,7.0,6.5,6.1,    &
+       7.0,7.3,7.5,7.5,7.5,7.3,6.7,6.4,6.0,5.8,     &
+       3.8,4.0,4.7,5.0,5.2,5.9,5.8,5.6,5.5,5.5,     &
+       1.4,1.6,2.4,3.0,3.7,4.1,4.6,4.8,5.1,5.0,     &
+       .40,.50,.90,1.2,2.0,2.7,3.2,3.6,4.3,4.1,     &
+       .07,.10,.20,.30,.80,1.4,2.1,2.4,2.7,3.0,     &
+       .06,.07,.09,.15,.30,.70,1.2,1.4,1.6,2.0,     &
+       .05,.05,.06,.12,.15,.30,.60,.70,.80,.80,     &
+       .04,.05,.06,.08,.09,.15,.30,.40,.40,.40,     &
+       .04,.04,.05,.055,.06,.09,.12,.13,.15,.15,    &
+       .03,.03,.045,.052,.055,.06,.07,.07,.06,.07,  &
+       .03,.03,.04,.051,.052,.052,.06,.06,.05,.05,  &
+       .02,.02,.03,.05,.05,.05,.04,.04,.04,.04,     &
+       .02,.02,.02,.04,.04,.04,.03,.03,.03,.03/     
+      DATA O3LO3/     &
+       14.5,14.0,13.5,11.3,11.0,10.0,9.0,8.3,7.5,7.3,    &
+       13.5,13.2,12.5,11.1,10.4,9.7,8.2,7.8,7.4,6.8,     &
+       10.8,10.9,11.0,10.4,10.0,9.6,7.9,7.5,7.0,6.7,     &
+       7.3,7.5,7.8,8.5,9.0,8.5,7.7,7.4,6.9,6.5,     &
+       4.1,4.5,5.3,6.2,7.3,7.7,7.3,7.0,6.6,6.4,     &
+       1.8,2.0,2.2,3.8,4.3,5.6,6.2,6.2,6.4,6.2,     &
+       .30,.50,.60,1.5,2.8,3.7,4.5,4.7,5.5,5.6,     &
+       .09,.10,.15,.60,1.2,2.1,3.0,3.5,4.0,4.3,     &
+       .06,.08,.10,.30,.60,1.1,1.9,2.2,2.9,3.0,     &
+       .04,.05,.06,.15,.45,.60,1.1,1.3,1.6,1.8,     &
+       .04,.04,.04,.08,.20,.30,.55,.60,.75,.90,     &
+       .04,.04,.04,.05,.06,.10,.12,.15,.20,.25,     &
+       .04,.04,.03,.04,.05,.06,.07,.07,.07,.08,     &
+       .03,.03,.04,.05,.05,.05,.05,.05,.05,.05,     &
+       .03,.03,.03,.04,.04,.04,.05,.05,.04,.04,     &
+       .02,.02,.02,.04,.04,.04,.04,.04,.03,.03/      
+      DATA O3LO4/     &
+       14.2,13.8,13.2,12.5,11.7,10.5,8.6,7.8,7.5,6.6,  &
+       12.5,12.4,12.2,11.7,10.8,9.8,7.8,7.2,6.5,6.1,   &
+       10.6,10.5,10.4,10.1,9.6,9.0,7.1,6.8,6.1,5.9,    &
+       7.0,7.4,7.9,7.8,7.6,7.3,6.2,6.1,5.8,5.6,     &
+       4.2,4.6,5.1,5.6,5.9,5.9,5.9,5.8,5.6,5.3,     &
+       2.1,2.3,2.6,2.9,3.5,4.3,4.8,4.9,5.1,5.1,     &
+       0.7,0.8,1.0,1.5,2.0,2.8,3.5,3.6,3.7,4.0,     &
+       .15,.20,.40,.50,.60,1.4,2.1,2.2,2.3,2.5,     &
+       .08,.10,.15,.25,.30,.90,1.2,1.3,1.4,1.6,     &
+       .07,.08,.10,.14,.20,.50,.70,.90,.90,.80,     &
+       .05,.06,.08,.12,.14,.20,.35,.40,.60,.50,     &
+       .05,.05,.08,.09,.09,.09,.11,.12,.15,.18,     &
+       .04,.05,.06,.07,.07,.08,.08,.08,.08,.08,     &
+       .04,.04,.05,.07,.07,.07,.07,.07,.06,.05,     &
+       .02,.02,.04,.05,.05,.05,.05,.05,.04,.04,     &
+       .02,.02,.03,.04,.04,.04,.04,.04,.03,.03/     
+!----------------------------------------------------------------------
+!***
+!***  COMPUTE DETAILED O3 PROFILE FROM THE ORIGINAL GFDL PRESSURES
+!***  WHERE OUTPUT FROM O3INT (PSTD) IS TOP DOWN IN MB*1.E3
+!***  AND PSFC=1013.25 MB    ......K.A.C. DEC94
+!***
+      DO K=1,NK
+!        PH(K)=PH(K)*1013250.
+!        P(K)=P(K)*1013250.
+        PH(K)=PYY(K)*1013250.         ! fix for nesting
+        P(K)=PXX(K)*1013250.          ! fix for nesting
+      ENDDO
+!
+!      PH(NKP)=PH(NKP)*1013250.
+      PH(NKP)=PYY(NKP)*1013250.       ! fix for nesting
+!
+      DO K=1,NL
+        PSTD(K)=P(K)
+      ENDDO
+!
+      DO K=1,25
+      DO N=1,10
+        RO31(N,K)=O3HI(N,K)
+        RO32(N,K)=O3HI(N,K)
+      ENDDO
+      ENDDO
+!----------------------------------------------------------------------
+      DO 100 NCASE=1,4
+!
+!***  NCASE=1: SPRING (IN N.H.)
+!***  NCASE=2: FALL   (IN N.H.)
+!***  NCASE=3: WINTER (IN N.H.)
+!***  NCASE=4: SUMMER (IN N.H.)
+!
+      IPLACE=2
+      IF(NCASE.EQ.2)IPLACE=4
+      IF(NCASE.EQ.3)IPLACE=1
+      IF(NCASE.EQ.4)IPLACE=3
+!
+      IF(NCASE.EQ.1.OR.NCASE.EQ.2)THEN
+        DO K=26,41
+        DO N=1,10
+          RO31(N,K)=O3LO1(N,K-25)
+          RO32(N,K)=O3LO2(N,K-25)
+        ENDDO
+        ENDDO
+      ENDIF
+!
+      IF(NCASE.EQ.3.OR.NCASE.EQ.4)THEN
+        DO K=26,41
+        DO N=1,10
+          RO31(N,K)=O3LO3(N,K-25)
+          RO32(N,K)=O3LO4(N,K-25)
+        ENDDO
+        ENDDO
+      ENDIF
+!
+      DO 25 KK=1,NKK
+      DO N=1,10
+        DUO3N(N,KK)=RO31(11-N,KK)
+        DUO3N(N+9,KK)=RO32(N,KK)
+      ENDDO
+      DUO3N(10,KK)=0.5*(RO31(1,KK)+RO32(1,KK))
+   25 CONTINUE
+!
+!***FOR NCASE=2 OR NCASE=4,REVERSE LATITUDE ARRANGEMENT OF CORR. SEASON
+!
+      IF(NCASE.EQ.2.OR.NCASE.EQ.4)THEN
+        DO 50 KK=1,NKK
+        DO N=1,19
+          TEMPN(N)=DUO3N(20-N,KK)
+        ENDDO
+         DO N=1,19
+           DUO3N(N,KK)=TEMPN(N)
+         ENDDO
+   50   CONTINUE
+      ENDIF
+!
+!***  DUO3N NOW IS O3 PROFILE FOR APPROPRIATE SEASON AT STD PRESSURE
+!***  LEVELS
+!
+!***  BEGIN LATITUDE (10 DEG) LOOP
+!
+      DO 75 N=1,19
+!
+      DO KK=1,NKK
+        RSTD(KK)=DUO3N(N,KK)
+      ENDDO
+!
+      NKM=NK-1
+      NKMM=NK-3
+!***
+!***  BESSELS HALF-POINT INTERPOLATION FORMULA
+!***
+      DO K=4,NKMM,2
+        KI=K/2
+        RDATA(K)=0.5*(RSTD(KI)+RSTD(KI+1))-(RSTD(KI+2)-RSTD(KI+1) &
+                                           -RSTD(KI)+RSTD(KI-1))/16.
+      ENDDO
+!
+      RDATA(2)=0.5*(RSTD(2)+RSTD(1))
+      RDATA(NKM)=0.5*(RSTD(NKK)+RSTD(NKK-1))
+!
+!***  PUT UNCHANGED DATA INTO NEW ARRAY
+!
+      DO K=1,NK,2
+        KQ=(K+1)/2
+        RDATA(K)=RSTD(KQ)
+      ENDDO
+!
+      DO KK=1,NL
+        DDUO3N(N,KK)=RDATA(KK)*.01
+      ENDDO
+!
+   75 CONTINUE
+!
+!***  END OF LATITUDE LOOP
+!
+!----------------------------------------------------------------------
+!***
+!***  CREATE 5 DEG OZONE QUANTITIES BY LINEAR INTERPOLATION OF
+!***  10 DEG VALUES
+!***
+      DO 90 KK=1,NL
+!
+      DO N=1,19
+        O35DEG(2*N-1,KK)=DDUO3N(N,KK)
+      ENDDO
+!
+      DO N=1,18
+        O35DEG(2*N,KK)=0.5*(DDUO3N(N,KK)+DDUO3N(N+1,KK))
+      ENDDO
+!
+   90 CONTINUE
+!
+      DO JJ=1,37
+      DO KEN=1,NL
+        O3O3(JJ,KEN,IPLACE)=O35DEG(JJ,KEN)
+      ENDDO
+      ENDDO
+!
+  100 CONTINUE
+!----------------------------------------------------------------------
+!***  END OF LOOP OVER CASES
+!----------------------------------------------------------------------
+!***
+!***  AVERAGE CLIMATOLOGICAL VALUS OF O3 FROM 5 DEG LAT MEANS, SO THAT
+!***  TIME AND SPACE INTERPOLATION WILL WORK (SEE SUBR OZON2D)
+!***
+      DO I=1,NLGTH
+        AVG=0.25*(XRAD1(I)+XRAD2(I)+XRAD3(I)+XRAD4(I))
+        A1=0.5*(XRAD2(I)-XRAD4(I))
+        B1=0.5*(XRAD1(I)-XRAD3(I))
+        B2=0.25*((XRAD1(I)+XRAD3(I))-(XRAD2(I)+XRAD4(I)))
+
+!       XRAD1(I)=AVG
+!       XRAD2(I)=A1
+!       XRAD3(I)=B1
+!       XRAD4(I)=B2
+
+        iindex = 1+mod((I-1),37)
+        jindex = 1+(I-1)/37
+        XDUO3N(iindex,jindex)=AVG
+        XDO3N2(iindex,jindex)=A1
+        XDO3N3(iindex,jindex)=B1
+        XDO3N4(iindex,jindex)=B2
+      ENDDO
+!***
+!***  CONVERT GFDL PRESSURE (MICROBARS) TO PA 
+!***
+      DO N=1,NL
+        PRGFDL(N)=PSTD(N)*1.E-1
+      ENDDO
+!
+    END SUBROUTINE O3CLIM
+
+!---------------------------------------------------------------------
+      SUBROUTINE TABLE 
+!                     (TABLE1,TABLE2,TABLE3,EM1,EM1WDE,EM3,          &
+!                      SOURCE,DSRCE                                  )
+!---------------------------------------------------------------------
+ IMPLICIT NONE
+!----------------------------------------------------------------------
+
+!INTEGER, PARAMETER :: NBLY=15
+ INTEGER, PARAMETER :: NB=12
+ INTEGER, PARAMETER :: NBLX=47
+ INTEGER , PARAMETER:: NBLW = 163
+
+ REAL,PARAMETER ::      AMOLWT=28.9644
+ REAL,PARAMETER ::      CSUBP=1.00484E7
+ REAL,PARAMETER ::      DIFFCTR=1.66
+ REAL,PARAMETER ::      G=980.665
+ REAL,PARAMETER ::      GINV=1./G
+ REAL,PARAMETER ::      GRAVDR=980.0
+ REAL,PARAMETER ::      O3DIFCTR=1.90
+ REAL,PARAMETER ::      P0=1013250.
+ REAL,PARAMETER ::      P0INV=1./P0
+ REAL,PARAMETER ::      GP0INV=GINV*P0INV
+ REAL,PARAMETER ::      P0XZP2=202649.902
+ REAL,PARAMETER ::      P0XZP8=810600.098
+ REAL,PARAMETER ::      P0X2=2.*1013250.
+ REAL,PARAMETER ::      RADCON=8.427
+ REAL,PARAMETER ::      RADCON1=1./8.427
+ REAL,PARAMETER ::      RATCO2MW=1.519449738
+ REAL,PARAMETER ::      RATH2OMW=.622
+ REAL,PARAMETER ::      RGAS=8.3142E7
+ REAL,PARAMETER ::      RGASSP=8.31432E7
+ REAL,PARAMETER ::      SECPDA=8.64E4
+!
+!******THE FOLLOWING ARE MATHEMATICAL CONSTANTS*******
+!        ARRANGED IN DECREASING ORDER
+ REAL,PARAMETER ::      HUNDRED=100.
+ REAL,PARAMETER ::      HNINETY=90.
+ REAL,PARAMETER ::      HNINE=9.0
+ REAL,PARAMETER ::      SIXTY=60.
+ REAL,PARAMETER ::      FIFTY=50.
+ REAL,PARAMETER ::      TEN=10.
+ REAL,PARAMETER ::      EIGHT=8.
+ REAL,PARAMETER ::      FIVE=5.
+ REAL,PARAMETER ::      FOUR=4.
+ REAL,PARAMETER ::      THREE=3.
+ REAL,PARAMETER ::      TWO=2.
+ REAL,PARAMETER ::      ONE=1.
+ REAL,PARAMETER ::      HAF=0.5
+ REAL,PARAMETER ::      QUARTR=0.25
+ REAL,PARAMETER ::      ZERO=0.
+!
+!******FOLLOWING ARE POSITIVE FLOATING POINT CONSTANTS(H'S)
+!       ARRANGED IN DECREASING ORDER
+ REAL,PARAMETER ::      H83E26=8.3E26
+ REAL,PARAMETER ::      H71E26=7.1E26
+ REAL,PARAMETER ::      H1E15=1.E15
+ REAL,PARAMETER ::      H1E13=1.E13
+ REAL,PARAMETER ::      H1E11=1.E11
+ REAL,PARAMETER ::      H1E8=1.E8
+ REAL,PARAMETER ::      H2E6=2.0E6
+ REAL,PARAMETER ::      H1E6=1.0E6
+ REAL,PARAMETER ::      H69766E5=6.97667E5
+ REAL,PARAMETER ::      H4E5=4.E5
+ REAL,PARAMETER ::      H165E5=1.65E5
+ REAL,PARAMETER ::      H5725E4=57250.
+ REAL,PARAMETER ::      H488E4=48800.
+ REAL,PARAMETER ::      H1E4=1.E4
+ REAL,PARAMETER ::      H24E3=2400.
+ REAL,PARAMETER ::      H20788E3=2078.8
+ REAL,PARAMETER ::      H2075E3=2075.
+ REAL,PARAMETER ::      H18E3=1800.
+ REAL,PARAMETER ::      H1224E3=1224.
+ REAL,PARAMETER ::      H67390E2=673.9057
+ REAL,PARAMETER ::      H5E2=500.
+ REAL,PARAMETER ::      H3082E2=308.2
+ REAL,PARAMETER ::      H3E2=300.
+ REAL,PARAMETER ::      H2945E2=294.5
+ REAL,PARAMETER ::      H29316E2=293.16
+ REAL,PARAMETER ::      H26E2=260.0
+ REAL,PARAMETER ::      H25E2=250.
+ REAL,PARAMETER ::      H23E2=230.
+ REAL,PARAMETER ::      H2E2=200.0
+ REAL,PARAMETER ::      H15E2=150.
+ REAL,PARAMETER ::      H1386E2=138.6
+ REAL,PARAMETER ::      H1036E2=103.6
+ REAL,PARAMETER ::      H8121E1=81.21
+ REAL,PARAMETER ::      H35E1=35.
+ REAL,PARAMETER ::      H3116E1=31.16
+ REAL,PARAMETER ::      H28E1=28.
+ REAL,PARAMETER ::      H181E1=18.1
+ REAL,PARAMETER ::      H18E1=18.
+ REAL,PARAMETER ::      H161E1=16.1
+ REAL,PARAMETER ::      H16E1=16.
+ REAL,PARAMETER ::      H1226E1=12.26
+ REAL,PARAMETER ::      H9P94=9.94
+ REAL,PARAMETER ::      H6P08108=6.081081081
+ REAL,PARAMETER ::      H3P6=3.6
+ REAL,PARAMETER ::      H3P5=3.5
+ REAL,PARAMETER ::      H2P9=2.9
+ REAL,PARAMETER ::      H2P8=2.8
+ REAL,PARAMETER ::      H2P5=2.5
+ REAL,PARAMETER ::      H1P8=1.8
+ REAL,PARAMETER ::      H1P4387=1.4387
+ REAL,PARAMETER ::      H1P41819=1.418191
+ REAL,PARAMETER ::      H1P4=1.4
+ REAL,PARAMETER ::      H1P25892=1.258925411
+ REAL,PARAMETER ::      H1P082=1.082
+ REAL,PARAMETER ::      HP816=0.816
+ REAL,PARAMETER ::      HP805=0.805
+ REAL,PARAMETER ::      HP8=0.8
+ REAL,PARAMETER ::      HP60241=0.60241
+ REAL,PARAMETER ::      HP602409=0.60240964
+ REAL,PARAMETER ::      HP6=0.6
+ REAL,PARAMETER ::      HP526315=0.52631579
+ REAL,PARAMETER ::      HP518=0.518
+ REAL,PARAMETER ::      HP5048=0.5048
+ REAL,PARAMETER ::      HP3795=0.3795
+ REAL,PARAMETER ::      HP369=0.369
+ REAL,PARAMETER ::      HP26=0.26
+ REAL,PARAMETER ::      HP228=0.228
+ REAL,PARAMETER ::      HP219=0.219
+ REAL,PARAMETER ::      HP166666=.166666
+ REAL,PARAMETER ::      HP144=0.144
+ REAL,PARAMETER ::      HP118666=0.118666192
+ REAL,PARAMETER ::      HP1=0.1
+!        (NEGATIVE EXPONENTIALS BEGIN HERE)
+ REAL,PARAMETER ::      H658M2=0.0658
+ REAL,PARAMETER ::      H625M2=0.0625
+ REAL,PARAMETER ::      H44871M2=4.4871E-2
+ REAL,PARAMETER ::      H44194M2=.044194
+ REAL,PARAMETER ::      H42M2=0.042
+ REAL,PARAMETER ::      H41666M2=0.0416666
+ REAL,PARAMETER ::      H28571M2=.02857142857
+ REAL,PARAMETER ::      H2118M2=0.02118
+ REAL,PARAMETER ::      H129M2=0.0129
+ REAL,PARAMETER ::      H1M2=.01
+ REAL,PARAMETER ::      H559M3=5.59E-3
+ REAL,PARAMETER ::      H3M3=0.003
+ REAL,PARAMETER ::      H235M3=2.35E-3
+ REAL,PARAMETER ::      H1M3=1.0E-3
+ REAL,PARAMETER ::      H987M4=9.87E-4
+ REAL,PARAMETER ::      H323M4=0.000323
+ REAL,PARAMETER ::      H3M4=0.0003
+ REAL,PARAMETER ::      H285M4=2.85E-4
+ REAL,PARAMETER ::      H1M4=0.0001
+ REAL,PARAMETER ::      H75826M4=7.58265E-4
+ REAL,PARAMETER ::      H6938M5=6.938E-5
+ REAL,PARAMETER ::      H394M5=3.94E-5
+ REAL,PARAMETER ::      H37412M5=3.7412E-5
+ REAL,PARAMETER ::      H15M5=1.5E-5
+ REAL,PARAMETER ::      H1439M5=1.439E-5
+ REAL,PARAMETER ::      H128M5=1.28E-5
+ REAL,PARAMETER ::      H102M5=1.02E-5
+ REAL,PARAMETER ::      H1M5=1.0E-5
+ REAL,PARAMETER ::      H7M6=7.E-6
+ REAL,PARAMETER ::      H4999M6=4.999E-6
+ REAL,PARAMETER ::      H451M6=4.51E-6
+ REAL,PARAMETER ::      H25452M6=2.5452E-6
+ REAL,PARAMETER ::      H1M6=1.E-6
+ REAL,PARAMETER ::      H391M7=3.91E-7
+ REAL,PARAMETER ::      H1174M7=1.174E-7
+ REAL,PARAMETER ::      H8725M8=8.725E-8
+ REAL,PARAMETER ::      H327M8=3.27E-8
+ REAL,PARAMETER ::      H257M8=2.57E-8
+ REAL,PARAMETER ::      H1M8=1.0E-8
+ REAL,PARAMETER ::      H23M10=2.3E-10
+ REAL,PARAMETER ::      H14M10=1.4E-10
+ REAL,PARAMETER ::      H11M10=1.1E-10
+ REAL,PARAMETER ::      H1M10=1.E-10
+ REAL,PARAMETER ::      H83M11=8.3E-11
+ REAL,PARAMETER ::      H82M11=8.2E-11
+ REAL,PARAMETER ::      H8M11=8.E-11
+ REAL,PARAMETER ::      H77M11=7.7E-11
+ REAL,PARAMETER ::      H72M11=7.2E-11
+ REAL,PARAMETER ::      H53M11=5.3E-11
+ REAL,PARAMETER ::      H48M11=4.8E-11
+ REAL,PARAMETER ::      H44M11=4.4E-11
+ REAL,PARAMETER ::      H42M11=4.2E-11
+ REAL,PARAMETER ::      H37M11=3.7E-11
+ REAL,PARAMETER ::      H35M11=3.5E-11
+ REAL,PARAMETER ::      H32M11=3.2E-11
+ REAL,PARAMETER ::      H3M11=3.0E-11
+ REAL,PARAMETER ::      H28M11=2.8E-11
+ REAL,PARAMETER ::      H24M11=2.4E-11
+ REAL,PARAMETER ::      H23M11=2.3E-11
+ REAL,PARAMETER ::      H2M11=2.E-11
+ REAL,PARAMETER ::      H18M11=1.8E-11
+ REAL,PARAMETER ::      H15M11=1.5E-11
+ REAL,PARAMETER ::      H14M11=1.4E-11
+ REAL,PARAMETER ::      H114M11=1.14E-11
+ REAL,PARAMETER ::      H11M11=1.1E-11
+ REAL,PARAMETER ::      H1M11=1.E-11
+ REAL,PARAMETER ::      H96M12=9.6E-12
+ REAL,PARAMETER ::      H93M12=9.3E-12
+ REAL,PARAMETER ::      H77M12=7.7E-12
+ REAL,PARAMETER ::      H74M12=7.4E-12
+ REAL,PARAMETER ::      H65M12=6.5E-12
+ REAL,PARAMETER ::      H62M12=6.2E-12
+ REAL,PARAMETER ::      H6M12=6.E-12
+ REAL,PARAMETER ::      H45M12=4.5E-12
+ REAL,PARAMETER ::      H44M12=4.4E-12
+ REAL,PARAMETER ::      H4M12=4.E-12
+ REAL,PARAMETER ::      H38M12=3.8E-12
+ REAL,PARAMETER ::      H37M12=3.7E-12
+ REAL,PARAMETER ::      H3M12=3.E-12
+ REAL,PARAMETER ::      H29M12=2.9E-12
+ REAL,PARAMETER ::      H28M12=2.8E-12
+ REAL,PARAMETER ::      H24M12=2.4E-12
+ REAL,PARAMETER ::      H21M12=2.1E-12
+ REAL,PARAMETER ::      H16M12=1.6E-12
+ REAL,PARAMETER ::      H14M12=1.4E-12
+ REAL,PARAMETER ::      H12M12=1.2E-12
+ REAL,PARAMETER ::      H8M13=8.E-13
+ REAL,PARAMETER ::      H46M13=4.6E-13
+ REAL,PARAMETER ::      H36M13=3.6E-13
+ REAL,PARAMETER ::      H135M13=1.35E-13
+ REAL,PARAMETER ::      H12M13=1.2E-13
+ REAL,PARAMETER ::      H1M13=1.E-13
+ REAL,PARAMETER ::      H3M14=3.E-14
+ REAL,PARAMETER ::      H15M14=1.5E-14
+ REAL,PARAMETER ::      H14M14=1.4E-14
+!
+!******FOLLOWING ARE NEGATIVE FLOATING POINT CONSTANTS (HM'S)
+!          ARRANGED IN DESCENDING ORDER
+ REAL,PARAMETER ::      HM2M2=-.02
+ REAL,PARAMETER ::      HM6666M2=-.066667
+ REAL,PARAMETER ::      HMP5=-0.5
+ REAL,PARAMETER ::      HMP575=-0.575
+ REAL,PARAMETER ::      HMP66667=-.66667
+ REAL,PARAMETER ::      HMP805=-0.805
+ REAL,PARAMETER ::      HM1EZ=-1.
+ REAL,PARAMETER ::      HM13EZ=-1.3
+ REAL,PARAMETER ::      HM19EZ=-1.9
+ REAL,PARAMETER ::      HM1E1=-10.
+ REAL,PARAMETER ::      HM1597E1=-15.97469413
+ REAL,PARAMETER ::      HM161E1=-16.1
+ REAL,PARAMETER ::      HM1797E1=-17.97469413
+ REAL,PARAMETER ::      HM181E1=-18.1
+ REAL,PARAMETER ::      HM8E1=-80.
+ REAL,PARAMETER ::      HM1E2=-100.
+!
+ REAL,PARAMETER ::      H1M16=1.0E-16
+ REAL,PARAMETER ::      H1M20=1.E-20
+ REAL,PARAMETER ::      HP98=0.98
+ REAL,PARAMETER ::      Q19001=19.001
+ REAL,PARAMETER ::      DAYSEC=1.1574E-5
+ REAL,PARAMETER ::      HSIGMA=5.673E-5
+ REAL,PARAMETER ::      TWENTY=20.0
+ REAL,PARAMETER ::      HP537=0.537
+ REAL,PARAMETER ::      HP2=0.2
+ REAL,PARAMETER ::      RCO2=3.3E-4
+ REAL,PARAMETER ::      H3M6=3.0E-6
+ REAL,PARAMETER ::      PI=3.1415927
+ REAL,PARAMETER ::      DEGRAD=180.0/PI
+ REAL,PARAMETER ::      H74E1=74.0
+ REAL,PARAMETER ::      H15E1=15.0
+
+ REAL, PARAMETER:: B0 = -.51926410E-4
+ REAL, PARAMETER:: B1 = -.18113332E-3
+ REAL, PARAMETER:: B2 = -.10680132E-5
+ REAL, PARAMETER:: B3 = -.67303519E-7
+ REAL, PARAMETER:: AWIDE = 0.309801E+01
+ REAL, PARAMETER:: BWIDE = 0.495357E-01
+ REAL, PARAMETER:: BETAWD = 0.347839E+02
+ REAL, PARAMETER:: BETINW = 0.766811E+01
+
+
+!     REAL, INTENT(OUT) :: EM1(28,180),EM1WDE(28,180),TABLE1(28,180), &
+!                          TABLE2(28,180),TABLE3(28,180),EM3(28,180), &
+!                          SOURCE(28,NBLY), DSRCE(28,NBLY)
+
+!
+      REAL :: ARNDM(NBLW),BRNDM(NBLW),BETAD(NBLW)
+      REAL :: BANDLO(NBLW),BANDHI(NBLW)
+
+      INTEGER :: IBAND(40)
+
+      REAL :: BANDL1(64),BANDL2(64),BANDL3(35)
+      REAL :: BANDH1(64),BANDH2(64),BANDH3(35) 
+!     REAL :: AB15WD,SKO2D,SKC1R,SKO3R
+
+!     REAL :: AWIDE,BWIDE,BETAWD,BETINW
+
+!     DATA AWIDE  / 0.309801E+01/
+!     DATA BWIDE  / 0.495357E-01/
+!     DATA BETAWD / 0.347839E+02/
+!     DATA BETINW / 0.766811E+01/
+
+!
+!% #NPADL = #PAGE*#NPAGE -  4*28*180  -  2*181 - 7*28 - 180 ;
+!% #NPADL = #NPADL       -  11*28  - 2*180 - 2*30 ;
+
+!     PARAMETER (NPADL = #NPADL - 28*NBLX - 2*28*NBLW - 7*NBLW)
+
+      REAL ::  &
+               SUM(28,180),PERTSM(28,180),SUM3(28,180),       &
+               SUMWDE(28,180),SRCWD(28,NBLX),SRC1NB(28,NBLW), &
+               DBDTNB(28,NBLW)
+      REAL ::  &
+               ZMASS(181),ZROOT(181),SC(28),DSC(28),XTEMV(28), &
+               TFOUR(28),FORTCU(28),X(28),X1(28),X2(180),SRCS(28), &
+               SUM4(28),SUM6(28),SUM7(28),SUM8(28),SUM4WD(28),     &
+               R1T(28),R2(28),S2(28),T3(28),R1WD(28)
+      REAL ::  EXPO(180),FAC(180)
+      REAL ::  CNUSB(30),DNUSB(30)
+      REAL ::  ALFANB(NBLW),AROTNB(NBLW)
+      REAL ::  ANB(NBLW),BNB(NBLW),CENTNB(NBLW),DELNB(NBLW), &
+               BETANB(NBLW)
+
+      REAL ::  AB15(2)
+
+      REAL ::   ARNDM1(64),ARNDM2(64),ARNDM3(35)
+      REAL ::   BRNDM1(64),BRNDM2(64),BRNDM3(35)
+      REAL ::   BETAD1(64),BETAD2(64),BETAD3(35)
+
+      EQUIVALENCE (ARNDM1(1),ARNDM(1)),(ARNDM2(1),ARNDM(65)), &
+                  (ARNDM3(1),ARNDM(129))
+      EQUIVALENCE (BRNDM1(1),BRNDM(1)),(BRNDM2(1),BRNDM(65)), &
+                  (BRNDM3(1),BRNDM(129))
+      EQUIVALENCE (BETAD1(1),BETAD(1)),(BETAD2(1),BETAD(65)), &
+                  (BETAD3(1),BETAD(129))
+
+!---------------------------------------------------------------
+      REAL    :: CENT,DEL,BDLO,BDHI,C1,ANU,tmp
+      INTEGER :: N,I,ICNT,I1,I2E,I2
+      INTEGER :: J,JP,NSUBDS,NSB,IA
+
+!---------------------------------------------------------------
+
+      DATA IBAND  / &
+          2,   1,   2,   2,   1,   2,   1,   3,   2,   2, &
+          3,   2,   2,   4,   2,   4,   2,   3,   3,   2, &
+          4,   3,   4,   3,   7,   5,   6,   7,   6,   5, &
+          7,   6,   7,   8,   6,   6,   8,   8,   8,   8/
+
+      DATA BANDL1 / &
+         0.000000E+00,  0.100000E+02,  0.200000E+02,  0.300000E+02, &
+         0.400000E+02,  0.500000E+02,  0.600000E+02,  0.700000E+02, &
+         0.800000E+02,  0.900000E+02,  0.100000E+03,  0.110000E+03, &
+         0.120000E+03,  0.130000E+03,  0.140000E+03,  0.150000E+03, &
+         0.160000E+03,  0.170000E+03,  0.180000E+03,  0.190000E+03, &
+         0.200000E+03,  0.210000E+03,  0.220000E+03,  0.230000E+03, &
+         0.240000E+03,  0.250000E+03,  0.260000E+03,  0.270000E+03, &
+         0.280000E+03,  0.290000E+03,  0.300000E+03,  0.310000E+03, &
+         0.320000E+03,  0.330000E+03,  0.340000E+03,  0.350000E+03, &
+         0.360000E+03,  0.370000E+03,  0.380000E+03,  0.390000E+03, &
+         0.400000E+03,  0.410000E+03,  0.420000E+03,  0.430000E+03, &
+         0.440000E+03,  0.450000E+03,  0.460000E+03,  0.470000E+03, &
+         0.480000E+03,  0.490000E+03,  0.500000E+03,  0.510000E+03, &
+         0.520000E+03,  0.530000E+03,  0.540000E+03,  0.550000E+03, &
+         0.560000E+03,  0.670000E+03,  0.800000E+03,  0.900000E+03, &
+         0.990000E+03,  0.107000E+04,  0.120000E+04,  0.121000E+04/
+      DATA BANDL2 / &
+         0.122000E+04,  0.123000E+04,  0.124000E+04,  0.125000E+04, &
+         0.126000E+04,  0.127000E+04,  0.128000E+04,  0.129000E+04, &
+         0.130000E+04,  0.131000E+04,  0.132000E+04,  0.133000E+04, &
+         0.134000E+04,  0.135000E+04,  0.136000E+04,  0.137000E+04, &
+         0.138000E+04,  0.139000E+04,  0.140000E+04,  0.141000E+04, &
+         0.142000E+04,  0.143000E+04,  0.144000E+04,  0.145000E+04, &
+         0.146000E+04,  0.147000E+04,  0.148000E+04,  0.149000E+04, &
+         0.150000E+04,  0.151000E+04,  0.152000E+04,  0.153000E+04, &
+         0.154000E+04,  0.155000E+04,  0.156000E+04,  0.157000E+04, &
+         0.158000E+04,  0.159000E+04,  0.160000E+04,  0.161000E+04, &
+         0.162000E+04,  0.163000E+04,  0.164000E+04,  0.165000E+04, &
+         0.166000E+04,  0.167000E+04,  0.168000E+04,  0.169000E+04, &
+         0.170000E+04,  0.171000E+04,  0.172000E+04,  0.173000E+04, &
+         0.174000E+04,  0.175000E+04,  0.176000E+04,  0.177000E+04, &
+         0.178000E+04,  0.179000E+04,  0.180000E+04,  0.181000E+04, &
+         0.182000E+04,  0.183000E+04,  0.184000E+04,  0.185000E+04/
+      DATA BANDL3 / &
+         0.186000E+04,  0.187000E+04,  0.188000E+04,  0.189000E+04, &
+         0.190000E+04,  0.191000E+04,  0.192000E+04,  0.193000E+04, &
+         0.194000E+04,  0.195000E+04,  0.196000E+04,  0.197000E+04, &
+         0.198000E+04,  0.199000E+04,  0.200000E+04,  0.201000E+04, &
+         0.202000E+04,  0.203000E+04,  0.204000E+04,  0.205000E+04, &
+         0.206000E+04,  0.207000E+04,  0.208000E+04,  0.209000E+04, &
+         0.210000E+04,  0.211000E+04,  0.212000E+04,  0.213000E+04, &
+         0.214000E+04,  0.215000E+04,  0.216000E+04,  0.217000E+04, &
+         0.218000E+04,  0.219000E+04,  0.227000E+04/
+
+      DATA BANDH1 / &
+         0.100000E+02,  0.200000E+02,  0.300000E+02,  0.400000E+02, &
+         0.500000E+02,  0.600000E+02,  0.700000E+02,  0.800000E+02, &
+         0.900000E+02,  0.100000E+03,  0.110000E+03,  0.120000E+03, &
+         0.130000E+03,  0.140000E+03,  0.150000E+03,  0.160000E+03, &
+         0.170000E+03,  0.180000E+03,  0.190000E+03,  0.200000E+03, &
+         0.210000E+03,  0.220000E+03,  0.230000E+03,  0.240000E+03, &
+         0.250000E+03,  0.260000E+03,  0.270000E+03,  0.280000E+03, &
+         0.290000E+03,  0.300000E+03,  0.310000E+03,  0.320000E+03, &
+         0.330000E+03,  0.340000E+03,  0.350000E+03,  0.360000E+03, &
+         0.370000E+03,  0.380000E+03,  0.390000E+03,  0.400000E+03, &
+         0.410000E+03,  0.420000E+03,  0.430000E+03,  0.440000E+03, &
+         0.450000E+03,  0.460000E+03,  0.470000E+03,  0.480000E+03, &
+         0.490000E+03,  0.500000E+03,  0.510000E+03,  0.520000E+03, &
+         0.530000E+03,  0.540000E+03,  0.550000E+03,  0.560000E+03, &
+         0.670000E+03,  0.800000E+03,  0.900000E+03,  0.990000E+03, &
+         0.107000E+04,  0.120000E+04,  0.121000E+04,  0.122000E+04/
+      DATA BANDH2 / &
+         0.123000E+04,  0.124000E+04,  0.125000E+04,  0.126000E+04, &
+         0.127000E+04,  0.128000E+04,  0.129000E+04,  0.130000E+04, &
+         0.131000E+04,  0.132000E+04,  0.133000E+04,  0.134000E+04, &
+         0.135000E+04,  0.136000E+04,  0.137000E+04,  0.138000E+04, &
+         0.139000E+04,  0.140000E+04,  0.141000E+04,  0.142000E+04, &
+         0.143000E+04,  0.144000E+04,  0.145000E+04,  0.146000E+04, &
+         0.147000E+04,  0.148000E+04,  0.149000E+04,  0.150000E+04, &
+         0.151000E+04,  0.152000E+04,  0.153000E+04,  0.154000E+04, &
+         0.155000E+04,  0.156000E+04,  0.157000E+04,  0.158000E+04, &
+         0.159000E+04,  0.160000E+04,  0.161000E+04,  0.162000E+04, &
+         0.163000E+04,  0.164000E+04,  0.165000E+04,  0.166000E+04, &
+         0.167000E+04,  0.168000E+04,  0.169000E+04,  0.170000E+04, &
+         0.171000E+04,  0.172000E+04,  0.173000E+04,  0.174000E+04, &
+         0.175000E+04,  0.176000E+04,  0.177000E+04,  0.178000E+04, &
+         0.179000E+04,  0.180000E+04,  0.181000E+04,  0.182000E+04, &
+         0.183000E+04,  0.184000E+04,  0.185000E+04,  0.186000E+04/
+      DATA BANDH3 / &
+         0.187000E+04,  0.188000E+04,  0.189000E+04,  0.190000E+04, &
+         0.191000E+04,  0.192000E+04,  0.193000E+04,  0.194000E+04, &
+         0.195000E+04,  0.196000E+04,  0.197000E+04,  0.198000E+04, &
+         0.199000E+04,  0.200000E+04,  0.201000E+04,  0.202000E+04, &
+         0.203000E+04,  0.204000E+04,  0.205000E+04,  0.206000E+04, &
+         0.207000E+04,  0.208000E+04,  0.209000E+04,  0.210000E+04, &
+         0.211000E+04,  0.212000E+04,  0.213000E+04,  0.214000E+04, &
+         0.215000E+04,  0.216000E+04,  0.217000E+04,  0.218000E+04, &
+         0.219000E+04,  0.220000E+04,  0.238000E+04/
+
+!
+!***THE FOLLOWING DATA STATEMENTS ARE BAND PARAMETERS OBTAINED USING
+!   THE 1982 AFGL CATALOG ON THE SPECIFIED BANDS
+      DATA ARNDM1  / &
+         0.354693E+00,  0.269857E+03,  0.167062E+03,  0.201314E+04, &
+         0.964533E+03,  0.547971E+04,  0.152933E+04,  0.599429E+04, &
+         0.699329E+04,  0.856721E+04,  0.962489E+04,  0.233348E+04, &
+         0.127091E+05,  0.104383E+05,  0.504249E+04,  0.181227E+05, &
+         0.856480E+03,  0.136354E+05,  0.288635E+04,  0.170200E+04, &
+         0.209761E+05,  0.126797E+04,  0.110096E+05,  0.336436E+03, &
+         0.491663E+04,  0.863701E+04,  0.540389E+03,  0.439786E+04, &
+         0.347836E+04,  0.130557E+03,  0.465332E+04,  0.253086E+03, &
+         0.257387E+04,  0.488041E+03,  0.892991E+03,  0.117148E+04, &
+         0.125880E+03,  0.458852E+03,  0.142975E+03,  0.446355E+03, &
+         0.302887E+02,  0.394451E+03,  0.438112E+02,  0.348811E+02, &
+         0.615503E+02,  0.143165E+03,  0.103958E+02,  0.725108E+02, &
+         0.316628E+02,  0.946456E+01,  0.542675E+02,  0.351557E+02, &
+         0.301797E+02,  0.381010E+01,  0.126319E+02,  0.548010E+01, &
+         0.600199E+01,  0.640803E+00,  0.501549E-01,  0.167961E-01, &
+         0.178110E-01,  0.170166E+00,  0.273514E-01,  0.983767E+00/
+      DATA ARNDM2  / &
+         0.753946E+00,  0.941763E-01,  0.970547E+00,  0.268862E+00, &
+         0.564373E+01,  0.389794E+01,  0.310955E+01,  0.128235E+01, &
+         0.196414E+01,  0.247113E+02,  0.593435E+01,  0.377552E+02, &
+         0.305173E+02,  0.852479E+01,  0.116780E+03,  0.101490E+03, &
+         0.138939E+03,  0.324228E+03,  0.683729E+02,  0.471304E+03, &
+         0.159684E+03,  0.427101E+03,  0.114716E+03,  0.106190E+04, &
+         0.294607E+03,  0.762948E+03,  0.333199E+03,  0.830645E+03, &
+         0.162512E+04,  0.525676E+03,  0.137739E+04,  0.136252E+04, &
+         0.147164E+04,  0.187196E+04,  0.131118E+04,  0.103975E+04, &
+         0.621637E+01,  0.399459E+02,  0.950648E+02,  0.943161E+03, &
+         0.526821E+03,  0.104150E+04,  0.905610E+03,  0.228142E+04, &
+         0.806270E+03,  0.691845E+03,  0.155237E+04,  0.192241E+04, &
+         0.991871E+03,  0.123907E+04,  0.457289E+02,  0.146146E+04, &
+         0.319382E+03,  0.436074E+03,  0.374214E+03,  0.778217E+03, &
+         0.140227E+03,  0.562540E+03,  0.682685E+02,  0.820292E+02, &
+         0.178779E+03,  0.186150E+03,  0.383864E+03,  0.567416E+01/ 
+      DATA ARNDM3  / &
+         0.225129E+03,  0.473099E+01,  0.753149E+02,  0.233689E+02, &
+         0.339802E+02,  0.108855E+03,  0.380016E+02,  0.151039E+01, &
+         0.660346E+02,  0.370165E+01,  0.234169E+02,  0.440206E+00, &
+         0.615283E+01,  0.304077E+02,  0.117769E+01,  0.125248E+02, &
+         0.142652E+01,  0.241831E+00,  0.483721E+01,  0.226357E-01, &
+         0.549835E+01,  0.597067E+00,  0.404553E+00,  0.143584E+01, &
+         0.294291E+00,  0.466273E+00,  0.156048E+00,  0.656185E+00, &
+         0.172727E+00,  0.118349E+00,  0.141598E+00,  0.588581E-01, &
+         0.919409E-01,  0.155521E-01,  0.537083E-02/
+      DATA BRNDM1  / &
+         0.789571E-01,  0.920256E-01,  0.696960E-01,  0.245544E+00, &
+         0.188503E+00,  0.266127E+00,  0.271371E+00,  0.330917E+00, &
+         0.190424E+00,  0.224498E+00,  0.282517E+00,  0.130675E+00, &
+         0.212579E+00,  0.227298E+00,  0.138585E+00,  0.187106E+00, &
+         0.194527E+00,  0.177034E+00,  0.115902E+00,  0.118499E+00, &
+         0.142848E+00,  0.216869E+00,  0.149848E+00,  0.971585E-01, &
+         0.151532E+00,  0.865628E-01,  0.764246E-01,  0.100035E+00, &
+         0.171133E+00,  0.134737E+00,  0.105173E+00,  0.860832E-01, &
+         0.148921E+00,  0.869234E-01,  0.106018E+00,  0.184865E+00, &
+         0.767454E-01,  0.108981E+00,  0.123094E+00,  0.177287E+00, &
+         0.848146E-01,  0.119356E+00,  0.133829E+00,  0.954505E-01, &
+         0.155405E+00,  0.164167E+00,  0.161390E+00,  0.113287E+00, &
+         0.714720E-01,  0.741598E-01,  0.719590E-01,  0.140616E+00, &
+         0.355356E-01,  0.832779E-01,  0.128680E+00,  0.983013E-01, &
+         0.629660E-01,  0.643346E-01,  0.717082E-01,  0.629730E-01, &
+         0.875182E-01,  0.857907E-01,  0.358808E+00,  0.178840E+00/
+      DATA BRNDM2  / &
+         0.254265E+00,  0.297901E+00,  0.153916E+00,  0.537774E+00, &
+         0.267906E+00,  0.104254E+00,  0.400723E+00,  0.389670E+00, &
+         0.263701E+00,  0.338116E+00,  0.351528E+00,  0.267764E+00, &
+         0.186419E+00,  0.238237E+00,  0.210408E+00,  0.176869E+00, &
+         0.114715E+00,  0.173299E+00,  0.967770E-01,  0.172565E+00, &
+         0.162085E+00,  0.157782E+00,  0.886832E-01,  0.242999E+00, &
+         0.760298E-01,  0.164248E+00,  0.221428E+00,  0.166799E+00, &
+         0.312514E+00,  0.380600E+00,  0.353828E+00,  0.269500E+00, &
+         0.254759E+00,  0.285408E+00,  0.159764E+00,  0.721058E-01, &
+         0.170528E+00,  0.231595E+00,  0.307184E+00,  0.564136E-01, &
+         0.159884E+00,  0.147907E+00,  0.185666E+00,  0.183567E+00, &
+         0.182482E+00,  0.230650E+00,  0.175348E+00,  0.195978E+00, &
+         0.255323E+00,  0.198517E+00,  0.195500E+00,  0.208356E+00, &
+         0.309603E+00,  0.112011E+00,  0.102570E+00,  0.128276E+00, &
+         0.168100E+00,  0.177836E+00,  0.105533E+00,  0.903330E-01, &
+         0.126036E+00,  0.101430E+00,  0.124546E+00,  0.221406E+00/ 
+      DATA BRNDM3  / &
+         0.137509E+00,  0.911365E-01,  0.724508E-01,  0.795788E-01, &
+         0.137411E+00,  0.549175E-01,  0.787714E-01,  0.165544E+00, &
+         0.136484E+00,  0.146729E+00,  0.820496E-01,  0.846211E-01, &
+         0.785821E-01,  0.122527E+00,  0.125359E+00,  0.101589E+00, &
+         0.155756E+00,  0.189239E+00,  0.999086E-01,  0.480993E+00, &
+         0.100233E+00,  0.153754E+00,  0.130780E+00,  0.136136E+00, &
+         0.159353E+00,  0.156634E+00,  0.272265E+00,  0.186874E+00, &
+         0.192090E+00,  0.135397E+00,  0.131497E+00,  0.127463E+00, &
+         0.227233E+00,  0.190562E+00,  0.214005E+00/ 
+      DATA BETAD1  / &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.234879E+03,  0.217419E+03,  0.201281E+03,  0.186364E+03, &
+         0.172576E+03,  0.159831E+03,  0.148051E+03,  0.137163E+03, &
+         0.127099E+03,  0.117796E+03,  0.109197E+03,  0.101249E+03, &
+         0.939031E+02,  0.871127E+02,  0.808363E+02,  0.750349E+02, &
+         0.497489E+02,  0.221212E+02,  0.113124E+02,  0.754174E+01, &
+         0.589554E+01,  0.495227E+01,  0.000000E+00,  0.000000E+00/ 
+      DATA BETAD2  / &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00/ 
+      DATA BETAD3  / &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00,  0.000000E+00, &
+         0.000000E+00,  0.000000E+00,  0.000000E+00/ 
+!---------------------------------------------------------------
+!     EQUIVALENCE (BANDL1(1),BANDLO(1)),(BANDL2(1),BANDLO(65)), &
+!                 (BANDL3(1),BANDLO(129))
+
+!     L     = kme-1
+!     LP1   = L+1
+!     LP1V  = LP1*(1+2*L/2)
+!     IMAX  = ite
+!     LP2   = L + 2
+ 
+      DO I = 1,64
+         BANDLO(I)=BANDL1(I)
+      ENDDO
+
+      DO I = 65,128
+         BANDLO(I)=BANDL2(I-64)
+      ENDDO
+
+      DO I = 129,163
+         BANDLO(I)=BANDL3(I-128)
+      ENDDO
+
+      DO I = 1,64
+         BANDHI(I)=BANDH1(I)
+      ENDDO
+
+      DO I = 65,128
+         BANDHI(I)=BANDH2(I-64)
+      ENDDO
+
+      DO I = 129,163
+         BANDHI(I)=BANDH3(I-128)
+      ENDDO
+
+!****************************************
+!***COMPUTE LOCAL QUANTITIES AND AO3,BO3,AB15
+!....FOR NARROW-BANDS...
+      DO 101 N=1,NBLW
+      ANB(N)=ARNDM(N)
+      BNB(N)=BRNDM(N)
+      CENTNB(N)=HAF*(BANDLO(N)+BANDHI(N))
+      DELNB(N)=BANDHI(N)-BANDLO(N)
+      BETANB(N)=BETAD(N)
+101   CONTINUE
+      AB15(1)=ANB(57)*BNB(57)
+      AB15(2)=ANB(58)*BNB(58)
+!....FOR WIDE BANDS...
+      AB15WD=AWIDE*BWIDE
+!
+!***COMPUTE INDICES: IND,INDX2,KMAXV
+!SH   ICNT=0
+!SH   DO 113 I1=1,L
+!SH     I2E=LP1-I1
+!SH     DO 115 I2=1,I2E
+!SH       ICNT=ICNT+1
+!SH       INDX2(ICNT)=LP1*(I2-1)+LP2*I1
+!SH115     CONTINUE
+!SH113   CONTINUE
+!SH   KMAXV(1)=1
+!SH   DO 117 I=2,L
+!SH   KMAXV(I)=KMAXV(I-1)+(LP2-I)
+117   CONTINUE
+!SH   KMAXVM=KMAXV(L)
+!***COMPUTE RATIOS OF CONT. COEFFS
+      SKC1R=BETAWD/BETINW
+      SKO3R=BETAD(61)/BETINW
+      SKO2D=ONE/BETINW
+!
+!****BEGIN TABLE COMPUTATIONS HERE***
+!***COMPUTE TEMPS, MASSES FOR TABLE ENTRIES
+!---NOTE: THE DIMENSIONING AND INITIALIZATION OF XTEMV AND OTHER ARRAYS
+!   WITH DIMENSION OF 28 IMPLY A RESTRICTION OF MODEL TEMPERATURES FROM
+!   100K TO 370K.
+!---THE DIMENSIONING OF ZMASS,ZROOT AND OTHER ARRAYS WITH DIMENSION OF
+!   180 IMPLY A RESTRICTION OF MODEL H2O AMOUNTS SUCH THAT OPTICAL PATHS
+!   ARE BETWEEN 10**-16 AND 10**2, IN CGS UNITS.
+      ZMASS(1)=H1M16
+      DO 201 J=1,180
+      JP=J+1
+      ZROOT(J)=SQRT(ZMASS(J))
+      ZMASS(JP)=ZMASS(J)*H1P25892
+201   CONTINUE
+      DO 203 I=1,28
+      XTEMV(I)=HNINETY+TEN*I
+      TFOUR(I)=XTEMV(I)*XTEMV(I)*XTEMV(I)*XTEMV(I)
+      FORTCU(I)=FOUR*XTEMV(I)*XTEMV(I)*XTEMV(I)
+203   CONTINUE
+!******THE COMPUTATION OF SOURCE,DSRCE IS  NEEDED ONLY
+!   FOR THE COMBINED WIDE-BAND CASE.TO OBTAIN THEM,THE SOURCE
+!   MUST BE COMPUTED FOR EACH OF THE (NBLX) WIDE BANDS(=SRCWD)
+!   THEN COMBINED (USING IBAND) INTO SOURCE.
+      DO 205 N=1,NBLY
+      DO 205 I=1,28
+      SOURCE(I,N)=ZERO
+205   CONTINUE
+      DO 207 N=1,NBLX
+      DO 207 I=1,28
+      SRCWD(I,N)=ZERO
+207   CONTINUE
+!---BEGIN FREQ. LOOP (ON N)
+      DO 211 N=1,NBLX
+        IF (N.LE.46) THEN
+!***THE 160-1200 BAND CASES
+          CENT=CENTNB(N+16)
+          DEL=DELNB(N+16)
+          BDLO=BANDLO(N+16)
+          BDHI=BANDHI(N+16)
+        ENDIF
+        IF (N.EQ.NBLX) THEN
+!***THE 2270-2380 BAND CASE
+          CENT=CENTNB(NBLW)
+          DEL=DELNB(NBLW)
+          BDLO=BANDLO(NBLW)
+          BDHI=BANDHI(NBLW)
+        ENDIF
+!***FOR PURPOSES OF ACCURACY, ALL EVALUATIONS OF PLANCK FCTNS ARE MADE
+!  ON 10 CM-1 INTERVALS, THEN SUMMED INTO THE (NBLX) WIDE BANDS.
+      NSUBDS=(DEL-H1M3)/10+1
+      DO 213 NSB=1,NSUBDS
+      IF (NSB.NE.NSUBDS) THEN
+        CNUSB(NSB)=TEN*(NSB-1)+BDLO+FIVE
+        DNUSB(NSB)=TEN
+      ELSE
+        CNUSB(NSB)=HAF*(TEN*(NSB-1)+BDLO+BDHI)
+        DNUSB(NSB)=BDHI-(TEN*(NSB-1)+BDLO)
+      ENDIF
+      C1=(H37412M5)*CNUSB(NSB)**3
+!---BEGIN TEMP. LOOP (ON I)
+      DO 215 I=1,28
+      X(I)=H1P4387*CNUSB(NSB)/XTEMV(I)
+      X1(I)=EXP(X(I))
+      SRCS(I)=C1/(X1(I)-ONE)
+      SRCWD(I,N)=SRCWD(I,N)+SRCS(I)*DNUSB(NSB)
+215   CONTINUE
+213   CONTINUE
+211   CONTINUE
+!***THE FOLLOWING LOOPS CREATE THE COMBINED WIDE BAND QUANTITIES SOURCE
+!   AND DSRCE
+      DO 221 N=1,40
+      DO 221 I=1,28
+      SOURCE(I,IBAND(N))=SOURCE(I,IBAND(N))+SRCWD(I,N)
+221   CONTINUE
+      DO 223 N=9,NBLY
+      DO 223 I=1,28
+      SOURCE(I,N)=SRCWD(I,N+32)
+223   CONTINUE
+      DO 225 N=1,NBLY
+      DO 225 I=1,27
+      DSRCE(I,N)=(SOURCE(I+1,N)-SOURCE(I,N))*HP1
+225   CONTINUE
+      DO 231 N=1,NBLW
+      ALFANB(N)=BNB(N)*ANB(N)
+      AROTNB(N)=SQRT(ALFANB(N))
+231   CONTINUE
+!***FIRST COMPUTE PLANCK FCTNS (SRC1NB) AND DERIVATIVES (DBDTNB) FOR
+!   USE IN TABLE EVALUATIONS. THESE ARE DIFFERENT FROM SOURCE,DSRCE
+!   BECAUSE DIFFERENT FREQUENCY PTS ARE USED IN EVALUATION, THE FREQ.
+!   RANGES ARE DIFFERENT, AND THE DERIVATIVE ALGORITHM IS DIFFERENT.
+!
+      DO 301 N=1,NBLW
+      CENT=CENTNB(N)
+      DEL=DELNB(N)
+!---NOTE: AT PRESENT, THE IA LOOP IS ONLY USED FOR IA=2. THE LOOP STRUCT
+!   IS KEPT SO THAT IN THE FUTURE, WE MAY USE A QUADRATURE SCHEME FOR
+!   THE PLANCK FCTN EVALUATION, RATHER THAN USE THE MID-BAND FREQUENCY.
+#if 0
+      DO 303 IA=1,3
+#else
+!jm -- getting floating point exceptions for IA=1, since 2 is only
+!      used anyway, I disabled the looping.
+      DO 303 IA=2,2
+#endif
+      ANU=CENT+HAF*(IA-2)*DEL
+      C1=(H37412M5)*ANU*ANU*ANU+H1M20
+!---TEMPERATURE LOOP---
+      DO 305 I=1,28
+         X(I)=H1P4387*ANU/XTEMV(I)
+         X1(I)=EXP(X(I))
+!#$      tmp=max((X1(I)-ONE),H1M20)
+!#$      SC(I)=C1/tmp
+         SC(I)=C1/((X1(I)-ONE)+H1M20)
+!#$      DSC(I)=X(I)*SC(I)*SC(I)*X1(I)/(XTEMV(I)*C1)
+         DSC(I)=SC(I)*SC(I)*X(I)*X1(I)/(XTEMV(I)*C1)
+305      CONTINUE
+      IF (IA.EQ.2) THEN
+         DO 307 I=1,28
+         SRC1NB(I,N)=DEL*SC(I)
+         DBDTNB(I,N)=DEL*DSC(I)
+307      CONTINUE
+      ENDIF
+303   CONTINUE
+301   CONTINUE
+!***NEXT COMPUTE R1T,R2,S2,AND T3- COEFFICIENTS USED FOR E3 FUNCTION
+!   WHEN THE OPTICAL PATH IS LESS THAN 10-4. IN THIS CASE, WE ASSUME A
+!   DIFFERENT DEPENDENCE ON (ZMASS).
+!---ALSO OBTAIN R1WD, WHICH IS R1T SUMMED OVER THE 160-560 CM-1 RANGE
+      DO 311 I=1,28
+      SUM4(I)=ZERO
+      SUM6(I)=ZERO
+      SUM7(I)=ZERO
+      SUM8(I)=ZERO
+      SUM4WD(I)=ZERO
+311   CONTINUE
+      DO 313 N=1,NBLW
+      CENT=CENTNB(N)
+!***PERFORM SUMMATIONS FOR FREQ. RANGES OF 0-560,1200-2200 CM-1 FOR SUM4
+!   SUM6,SUM7,SUM8
+      IF (CENT.LT.560. .OR. CENT.GT.1200..AND.CENT.LE.2200.) THEN
+         DO 315 I=1,28
+         SUM4(I)=SUM4(I)+SRC1NB(I,N)
+         SUM6(I)=SUM6(I)+DBDTNB(I,N)
+         SUM7(I)=SUM7(I)+DBDTNB(I,N)*AROTNB(N)
+         SUM8(I)=SUM8(I)+DBDTNB(I,N)*ALFANB(N)
+315      CONTINUE
+      ENDIF
+!***PERFORM SUMMATIONS OVER 160-560 CM-1 FREQ RANGE FOR E1 CALCS (SUM4WD
+      IF (CENT.GT.160. .AND. CENT.LT.560.) THEN
+         DO 316 I=1,28
+         SUM4WD(I)=SUM4WD(I)+SRC1NB(I,N)
+316      CONTINUE
+      ENDIF
+313   CONTINUE
+      DO 317 I=1,28
+      R1T(I)=SUM4(I)/TFOUR(I)
+      R2(I)=SUM6(I)/FORTCU(I)
+      S2(I)=SUM7(I)/FORTCU(I)
+      T3(I)=SUM8(I)/FORTCU(I)
+      R1WD(I)=SUM4WD(I)/TFOUR(I)
+317   CONTINUE
+      DO 401 J=1,180
+      DO 401 I=1,28
+      SUM(I,J)=ZERO
+      PERTSM(I,J)=ZERO
+      SUM3(I,J)=ZERO
+      SUMWDE(I,J)=ZERO
+401   CONTINUE
+!---FREQUENCY LOOP BEGINS---
+      DO 411 N=1,NBLW
+      CENT=CENTNB(N)
+!***PERFORM CALCULATIONS FOR FREQ. RANGES OF 0-560,1200-2200 CM-1
+      IF (CENT.LT.560. .OR. CENT.GT.1200..AND.CENT.LE.2200.) THEN
+         DO 413 J=1,180
+         X2(J)=AROTNB(N)*ZROOT(J)
+         EXPO(J)=EXP(-X2(J))
+413      CONTINUE
+         DO 415 J=1,180
+         IF (X2(J).GE.HUNDRED) THEN
+              EXPO(J)=ZERO
+         ENDIF
+415      CONTINUE
+         DO 417 J=121,180
+         FAC(J)=ZMASS(J)*(ONE-(ONE+X2(J))*EXPO(J))/(X2(J)*X2(J))
+417      CONTINUE
+         DO 419 J=1,180
+         DO 419 I=1,28
+         SUM(I,J)=SUM(I,J)+SRC1NB(I,N)*EXPO(J)
+         PERTSM(I,J)=PERTSM(I,J)+DBDTNB(I,N)*EXPO(J)
+419      CONTINUE
+         DO 421 J=121,180
+         DO 421 I=1,28
+         SUM3(I,J)=SUM3(I,J)+DBDTNB(I,N)*FAC(J)
+421      CONTINUE
+      ENDIF
+!---COMPUTE SUM OVER 160-560 CM-1 RANGE FOR USE IN E1 CALCS (SUMWDE)
+      IF (CENT.GT.160. .AND. CENT.LT.560.) THEN
+         DO 420 J=1,180
+         DO 420 I=1,28
+         SUMWDE(I,J)=SUMWDE(I,J)+SRC1NB(I,N)*EXPO(J)
+420      CONTINUE
+      ENDIF
+411   CONTINUE
+      DO 431 J=1,180
+      DO 431 I=1,28
+      EM1(I,J)=SUM(I,J)/TFOUR(I)
+      TABLE1(I,J)=PERTSM(I,J)/FORTCU(I)
+431   CONTINUE
+      DO 433 J=121,180
+      DO 433 I=1,28
+      EM3(I,J)=SUM3(I,J)/FORTCU(I)
+433   CONTINUE
+      DO 441 J=1,179
+      DO 441 I=1,28
+      TABLE2(I,J)=(TABLE1(I,J+1)-TABLE1(I,J))*TEN
+441   CONTINUE
+      DO 443 J=1,180
+      DO 443 I=1,27
+      TABLE3(I,J)=(TABLE1(I+1,J)-TABLE1(I,J))*HP1
+443   CONTINUE
+      DO 445 I=1,28
+      TABLE2(I,180)=ZERO
+445   CONTINUE
+      DO 447 J=1,180
+      TABLE3(28,J)=ZERO
+447   CONTINUE
+      DO 449 J=1,2
+      DO 449 I=1,28
+      EM1(I,J)=R1T(I)
+449   CONTINUE
+      DO 451 J=1,120
+      DO 451 I=1,28
+      EM3(I,J)=R2(I)/TWO-S2(I)*SQRT(ZMASS(J))/THREE+T3(I)*ZMASS(J)/EIGHT
+451   CONTINUE
+      DO 453 J=121,180
+      DO 453 I=1,28
+      EM3(I,J)=EM3(I,J)/ZMASS(J)
+453   CONTINUE
+!***NOW COMPUTE E1 TABLES FOR 160-560 CM-1 BANDS ONLY.
+!   WE USE R1WD AND SUMWDE OBTAINED ABOVE.
+      DO 501 J=1,180
+      DO 501 I=1,28
+      EM1WDE(I,J)=SUMWDE(I,J)/TFOUR(I)
+501   CONTINUE
+      DO 503 J=1,2
+      DO 503 I=1,28
+      EM1WDE(I,J)=R1WD(I)
+503   CONTINUE
+   
+      END SUBROUTINE TABLE
+
+!---------------------------------------------------------------------
+    SUBROUTINE SOLARD(IHRST,IDAY,MONTH,JULYR)
+!---------------------------------------------------------------------
+    IMPLICIT NONE
+!---------------------------------------------------------------------
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK
+!                .      .    .                               .
+! SUBPROGRAM:    SOLARD      COMPUTE THE SOLAR-EARTH DISTANCE
+!   PRGRMMR: Q.ZHAO           ORG: W/NMC2     DATE: 96-7-23       
+!     
+! ABSTRACT:
+!     SOLARD CALCULATES THE SOLAR-EARTH DISTANCE ON EACH DAY
+!     FOR USE IN SHORT-WAVE RADIATION.
+!     
+! PROGRAM HISTORY LOG:
+!   96-07-23  Q.ZHAO      - ORIGINATOR
+!   98-10-09  Q.ZHAO      - CHANGED TO USE IW3JDN IN W3LIB TO
+!                           CALCULATE JD.
+!   04-11-18  Y.-T. HOU   - FIXED ERROR IN JULIAN DAY CALCULATION
+!     
+! USAGE: CALL SOLARD FROM SUBROUTINE INIT
+!
+!   INPUT ARGUMENT LIST:
+!       NONE
+!  
+!   OUTPUT ARGUMENT LIST: 
+!       R1   - THE NON-DIMENSIONAL DISTANCE BETWEEN SUN AND THE EARTH
+!              (LESS THAN 1.0 IN SUMMER AND LARGER THAN 1.0 IN WINTER).
+!     
+!   INPUT FILES:
+!     NONE
+!        
+!   OUTPUT FILES:
+!     NONE
+!     
+!   SUBPROGRAMS CALLED:
+!  
+!     UNIQUE: NONE
+!  
+!     LIBRARY: IW3JDN
+!  
+!   COMMON BLOCKS: CTLBLK
+!   
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN 90
+!   MACHINE : IBM SP
+!***********************************************************************
+     REAL, PARAMETER :: PI=3.1415926,PI2=2.*PI
+!-----------------------------------------------------------------------
+!     INTEGER, INTENT(IN ) :: IHRST,IDAT(3)
+      INTEGER, INTENT(IN ) :: IHRST,IDAY,MONTH,JULYR
+!     REAL   , INTENT(OUT) :: R1
+!-----------------------------------------------------------------------
+      INTEGER :: NDM(12),JYR19,JMN
+      REAL    :: CCR
+
+      DATA JYR19/1900/, JMN/0/, CCR/1.3E-6/
+      DATA NDM/0,31,59,90,120,151,181,212,243,273,304,334/
+ 
+!.....TPP = DAYS BETWEEN EPOCH AND PERIHELION PASSAGE OF 1900
+!.....JDOR1 = JD OF DECEMBER 30, 1899 AT 12 HOURS UT
+!.....JDOR2 = JD OF EPOCH WHICH IS JANUARY 0, 1990 AT 12 HOURS UT
+!
+      REAL    :: TPP
+      DATA TPP/1.55/
+
+      INTEGER :: JDOR2,JDOR1
+      DATA JDOR2/2415020/, JDOR1/2415019/
+
+      REAL    :: DAYINC,DAT,T,YEAR,DATE,EM,E,EC,EP,CR,FJD,FJD1
+      INTEGER :: JHR,JD,ITER
+!
+!     LIBRARY: IW3JDN
+!
+!    --------------------------------------------------------------------
+!     COMPUTES JULIAN DAY AND FRACTION FROM YEAR, MONTH, DAY AND TIME UT
+!     ACCURATE ONLY BETWEEN MARCH 1, 1900 AND FEBRUARY 28, 2100
+!     BASED ON JULIAN CALENDAR CORRECTED TO CORRESPOND TO GREGORIAN
+!     CALENDAR DURING THIS PERIOD
+!    --------------------------------------------------------------------
+
+      JHR=IHRST
+!
+      JD=IDAY-32075                                                     &
+             +1461*(JULYR+4800+(MONTH-14)/12)/4                         &
+             +367*(MONTH-2-(MONTH-14)/12*12)/12                         &
+             -3*((JULYR+4900+(MONTH-14)/12)/100)/4
+      IF(JHR.LT.12)THEN
+        JD=JD-1
+        FJD=.5+.041666667*REAL(JHR)+.00069444444*REAL(JMN)
+      ELSE
+  7     FJD=.041666667E0*FLOAT(JHR-12)+.00069444444E0*FLOAT(JMN)
+      END IF
+      DAYINC=JHR/24.0
+      FJD1=JD+FJD+DAYINC
+      JD=FJD1
+      FJD=FJD1-JD
+!***
+!*** CALCULATE THE SOLAR-EARTH DISTANCE
+!***
+      DAT=REAL(JD-JDOR2)-TPP+FJD
+!***
+!    COMPUTES TIME IN JULIAN CENTURIES AFTER EPOCH
+!***
+      T=FLOAT(JD-JDOR2)/36525.E0
+!***
+!    COMPUTES LENGTH OF ANOMALISTIC AND TROPICAL YEARS (MINUS 365 DAYS)
+!***
+      YEAR=.25964134E0+.304E-5*T
+!***
+!    COMPUTES ORBIT ECCENTRICITY FROM T
+!***
+      EC=.01675104E0-(.418E-4+.126E-6*T)*T
+      YEAR=YEAR+365.E0
+!***
+!    DATE=DAYS SINCE LAST PERIHELION PASSAGE
+!***
+      DATE = MOD(DAT,YEAR)
+!***
+!    SOLVE ORBIT EQUATIONS BY NEWTON'S METHOD
+!***
+      EM=PI2*DATE/YEAR
+      E=1.E0
+      ITER = 0
+ 31   EP=E-(E-EC*SIN(E)-EM)/(1.E0-EC*COS(E))
+      CR=ABS(E-EP)
+      E=EP
+      ITER = ITER + 1
+      IF(ITER.GT.10) GOTO 1031
+      IF(CR.GT.CCR) GO TO 31
+ 1031 CONTINUE
+      R1=1.E0-EC*COS(E)
+!
+      WRITE(0,1000)JULYR,MONTH,IDAY,IHRST,R1
+ 1000 FORMAT('SUN-EARTH DISTANCE CALCULATION FINISHED IN SOLARD'/ &
+             'YEAR=',I5,'  MONTH=',I3,'  DAY=',I3,' HOUR=' &
+      ,      I3,' R1=',F9.4)
+!***
+!    RETURN TO RADTN
+!***
+    END SUBROUTINE SOLARD
+!---------------------------------------------------------------------
+    SUBROUTINE CAL_MON_DAY(JULDAY,julyr,Jmonth,Jday)     
+!---------------------------------------------------------------------
+    IMPLICIT NONE
+!-----------------------------------------------------------------------
+    INTEGER, INTENT(IN) :: JULDAY,julyr
+    INTEGER, INTENT(OUT) :: Jmonth,Jday
+    LOGICAL :: LEAP,NOT_FIND_DATE
+    INTEGER :: MONTH (12),itmpday,itmpmon,i
+!-----------------------------------------------------------------------
+    DATA MONTH/31,28,31,30,31,30,31,31,30,31,30,31/
+!***********************************************************************
+    NOT_FIND_DATE = .true.
+
+    itmpday = JULDAY
+    itmpmon = 1
+    LEAP=.FALSE.
+    IF(MOD(julyr,4).EQ.0)THEN
+      MONTH(2)=29
+      LEAP=.TRUE.
+    ENDIF
+
+    i = 1
+    DO WHILE (NOT_FIND_DATE)
+       IF(itmpday.GT.MONTH(i))THEN
+         itmpday=itmpday-MONTH(i)
+       ELSE
+         Jday=itmpday
+         Jmonth=i
+         NOT_FIND_DATE = .false.
+       ENDIF
+       i = i+1
+    END DO
+
+    END SUBROUTINE CAL_MON_DAY
+!!================================================================================
+! CO2 initialization code
+
+      FUNCTION ANTEMP(L,Z)
+      REAL :: ZB(10,7),C(11,7),DELTA(10,7),TSTAR(7)
+! ************** TROPICAL SOUNDING **************************
+      DATA (ZB(N,1),N=1,10)/  2.0,   3.0,   16.5,  21.5,  45.0, &
+                              51.0,  70.0,  100.,  200.,  300./
+      DATA (C(N,1),N=1,11)/ -6.0,  -4.0,  -6.7,   4.0,   2.2,   &
+                         1.0,  -2.8,  -.27,   0.0,   0.0,  0.0/
+      DATA (DELTA(N,1),N=1,10)/.5,    .5,    .3,    .5,    1.0, &
+                              1.0,   1.0,   1.0,   1.0,    1.0/
+! ************** SUB-TROPICAL SUMMER ************************
+      DATA (ZB(N,2),N=1,10)/ 1.5,   6.5,  13.0,  18.0,  26.0, &
+                              36.0,  48.0,  50.0, 70.0,  100./
+      DATA (C(N,2),N=1,11)/ -4.0,  -6.0,  -6.5,   0.0,   1.2, &
+                        2.2,   2.5,   0.0,  -3.0,  -0.25,  0.0/
+      DATA (DELTA(N,2),N=1,10)/ .5,  1.0,    .5,    .5,   1.0, &
+                              1.0,  2.5,    .5,   1.0,   1.0/
+! ************** SUB-TROPICAL WINTER ************************
+      DATA (ZB(N,3),N=1,10)/ 3.0,  10.0,  19.0,  25.0,  32.0, &
+                              44.5, 50.0,  71.0,  98.0,  200.0/
+      DATA (C(N,3),N=1,11)/ -3.5,  -6.0,  -0.5,  0.0,   0.4, &
+                              3.2,   1.6,  -1.8, -0.7,   0.0,   0.0/
+      DATA (DELTA(N,3),N=1,10)/ .5,   .5,  1.0,   1.0,   1.0, &
+                              1.0,  1.0,  1.0,   1.0,   1.0/
+! *************  SUB-ARCTIC SUMMER *************************
+      DATA (ZB(N,4),N=1,10)/ 4.7, 10.0,  23.0,  31.8,  44.0, &
+                              50.2, 69.2, 100.0, 102.0, 103.0/
+      DATA (C(N,4),N=1,11)/ -5.3, -7.0,   0.0,  1.4,   3.0, &
+                               0.7, -3.3,  -0.2,  0.0,   0.0,  0.0/
+      DATA (DELTA(N,4),N=1,10)/ .5,   .3,  1.0,   1.0,   2.0, &
+                              1.0,  1.5,  1.0,   1.0,   1.0/
+! ************ SUB-ARCTIC WINTER *****************************
+      DATA (ZB(N,5),N=1,10)/ 1.0,   3.2,   8.5,   15.5,   25.0, &
+                              30.0,  35.0,  50.0,  70.0,  100.0/
+      DATA (C(N,5),N=1,11)/ 3.0,  -3.2,  -6.8,  0.0,  -0.6, &
+                              1.0,   1.2,   2.5, -0.7,  -1.2,  0.0/
+      DATA (DELTA(N,5),N=1,10)/ .4,   1.5,    .3 ,   .5,   1.0, &
+                              1.0,   1.0,   1.0,   1.0,   1.0/
+! ************ US STANDARD 1976 ******************************
+      DATA (ZB(N,6),N=1,10)/ 11.0,  20.0,  32.0,  47.0,  51.0, & 
+                             71.0,  84.8520,  90.0,  91.0,  92.0/
+      DATA (C(N,6),N=1,11)/ -6.5,   0.0,   1.0,   2.80,  0.0, &
+                             -2.80, -2.00,  0.0,   0.0,   0.0,  0.0/
+      DATA (DELTA(N,6),N=1,10)/ 0.3,   1.0,   1.0,   1.0,   1.0, &
+                              1.0,   1.0,   1.0,   1.0,   1.0/
+!
+! ************ ENLARGED US STANDARD 1976 **********************
+      DATA (ZB(N,7),N=1,10)/ 11.0,  20.0,  32.0,  47.0,  51.0, &
+                             71.0,  84.8520,  90.0,  91.0,  92.0/
+      DATA (C(N,7),N=1,11)/ -6.5,   0.0,   1.0,   2.80,  0.0, &
+                             -2.80, -2.00,  0.0,   0.0,   0.0,  0.0/
+      DATA (DELTA(N,7),N=1,10)/ 0.3,   1.0,   1.0,   1.0,   1.0, &
+                              1.0,   1.0,   1.0,   1.0,   1.0/
+!
+      DATA TSTAR/ 300.0,  294.0,  272.2,  287.0,  257.1, 2*288.15/
+!
+      NLAST=10
+      TEMP=TSTAR(L)+C(1,L)*Z
+      DO 20 N=1,NLAST
+      EXPO=(Z-ZB(N,L))/DELTA(N,L)
+      EXPP=ZB(N,L)/DELTA(N,L)
+!JD single-precision change
+!      FAC=EXP(EXPP)+EXP(-EXPP)
+!mp	write(6,*) '.........................................'
+!mp what in the hell does the next line do?
+!mp	
+!mp	apparently if statement <0 or =0 then 23, else 24
+!mp     IF(ABS(EXPO)-100.0) 23,23,24
+!
+! changed to a more reasonable value for the workstation	
+!
+      IF(ABS(EXPO)-50.0) 23,23,24
+   23 X=EXP(EXPO)
+      Y=X+1.0/X
+      ZLOG=ALOG(Y)
+      GO TO 25
+   24 ZLOG=ABS(EXPO)
+!mp   25 IF(EXPP-100.0) 27,27,28
+   25 IF(EXPP-50.0) 27,27,28
+!JD single-precision change
+   27 FAC=EXP(EXPP)+EXP(-EXPP)
+      FACLOG=ALOG(FAC)
+      GO TO 29
+   28 FACLOG=EXPP
+!     TEMP=TEMP+(C(N+1,L)-C(N,L))*0.5*(Z+DELTA(N,L)*
+!    1     ALOG((EXP(EXPO)+EXP(-EXPO))/FAC))
+   29 TEMP=TEMP+(C(N+1,L)-C(N,L))*0.5*(Z+DELTA(N,L)* &
+           (ZLOG-FACLOG))
+!mp	write(6,*) 'ANTEMP pieces (C,C,ZLOG,FACLOG)', C(N+1,L),C(N,L),
+!mp     +	ZLOG,FACLOG
+   20 CONTINUE
+      ANTEMP=TEMP
+
+      END FUNCTION ANTEMP
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
+
+      SUBROUTINE COEINT(RAT,IR)
+! **********************************************************************
+!
+!
+!            THE TRANSMISSION FUNCTION BETWEEN P1 AND P2 IS ASSUMED TO
+!       THE  FUNCTIONAL FORM
+!                     TAU(P1,P2)= 1.0-SQRT(C*LOG(1.0+X*PATH)),
+!               WHERE
+!                     PATH(P1,P2)=((P1-P2)**2)*(P1+P2+CORE)/
+!                                 (ETA*(P1+P2+CORE)+(P1-P2))
+!
+!
+!        THE PARAMETERS C AND X ARE FUNCTIONS OF P2, AND ARE TO BE DETER
+!        WHILE CORE IS A PRESPECIFIED NUMBER.ETA IS A FUNCTION OF THE TH
+!        PRODUCT (CX);IT IS OBTAITED ITERATIVELY. THE DERIVATION OF ALL
+!        VALUES WILL BE EXPLAINED IN A FORTHCOMING PAPER.
+!            SUBROUTINE COEINT DETERMINES C(I) AND X(I) BY USING THE ACT
+!        VALUES OF TAU(P(I-2),P(I)) AND TAU(P(I-1),P(I)) AND THE PREVIOU
+!        ITERATION VALUE OF ETA.
+!             DEFINE:
+!                PATHA=PATH(P(I),P(I-2),CORE,ETA)
+!                PATHB=PATH(P(I),P(I-1),CORE,ETA);
+!        THEN
+!                R=(1-TAU(P(I),P(I-2)))/(1-TAU(P(I),P(I-1)))
+!                 = SQRT(LOG(1+X*PATHA)/LOG(1+X*PATHB)),
+!        SO THAT
+!                R**2= LOG(1+X*PATHA)/LOG(1+X*PATHB).
+!        THIS EQUATION CAN BE SOLVED BY NEWTON S METHOD FOR X AND THEN T
+!        RESULT USED TO FIND C. THIS IS REPEATED FOR EACH VALUE OF I GRE
+!        THAN 2 TO GIVE THE ARRAYS X(I) AND C(I).
+!             NEWTON S METHOD FOR SOLVING THE EQUATION
+!                 F(X)=0
+!        MAKES USE OF THE LOOP XNEW= XOLD-F(XOLD)/FPRIME(XOLD).
+!        THIS IS ITERATED 20 TIMES, WHICH IS PROBABLY EXCESSIVE.
+!        THE FIRST GUESS FOR ETA IS 3.2E-4*EXP(-P(I)/1000),WHICH HAS
+!        BEEN FOUND TO BE FAIRLY REALISTIC BY EXPERIMENT; WE ITERATE 5 T
+!        (AGAIN,PROBABLY EXCESSIVELY) TO OBTAIN THE VALUES FOR C,X,ETA T
+!        USED FOR INTERPOLATION.
+!           THERE ARE SEVERAL POSSIBLE PITFALLS:
+!              1) IN THE COURSE OF ITERATION, X MAY REACH A VALUE WHICH
+!                 1+X*PATHA NEGATIVE; IN THIS CASE THE ITERATION IS STOP
+!                 AND AN ERROR MESSAGE IS PRINTED OUT.
+!              2) EVEN IF (1) DOES NOT OCCUR, IT IS STILL POSSIBLE THAT
+!                 BE NEGATIVE AND LARGE ENOUGH TO MAKE 1+X*PATH(P(I),0,C
+!                 NEGATIVE. THIS IS CHECKED FOR IN A FINAL LOOP, AND IF
+!                 A WARNING IS PRINTED OUT.
+!
+!  *********************************************************************
+!....
+!     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+!     COMMON/PRESS/PA(109)
+      REAL RAT,SINV
+!     REAL PA,CORE,TRANSA,PATH,UEXP,SEXP,ETA,SEXPV
+      REAL PA2
+!     COMMON/TRAN/ TRANSA(109,109)
+!     COMMON/COEFS/XA(109),CA(109),ETA(109),SEXPV(109),CORE,UEXP,SEXP
+      DIMENSION PATH0(109),ETAP(109),XAP(109),CAP(109)
+      DIMENSION SINV(4)
+      INTEGER :: IERR
+      DATA SINV/2.74992,2.12731,4.38111,0.0832926/
+!NOV89   DIMENSION SINV(3)
+!NOV89   DATA SINV/2.74992,2.12731,4.38111/
+!O222  OLD CODE USED 2.7528 RATHER THAN 2.74992 ---K.A.C. OCTOBER 1988
+!O222   WHEN 2.7528 WAS USED,WE EXACTLY REPRODUCED THE MRF CO2 ARRAYS
+      CORE=5.000
+      UEXP=0.90
+!      P0=0.7
+      DO 902 I=1,109
+      PA2=PA(I)*PA(I)
+      SEXPV(I)=.505+2.0E-5*PA(I)+.035*(PA2-.25)/(PA2+.25)
+902   CONTINUE
+      DO 900 I=1,109
+      ETA(I)=3.2E-4*EXP(-PA(I)/500.)
+      ETAP(I)=ETA(I)
+900   CONTINUE
+      DO 1200 NP=1,10
+      DO 1000 I=3,109
+      SEXP=SEXPV(I)
+      R=(1.0D0-TRANSA(I,I-2))/(1.0D0-TRANSA(I,I-1))
+      REXP=R**(UEXP/SEXP)
+      arg1=path(pa(i),pa(i-2),core,eta(i))
+      arg2=path(pa(i),pa(i-1),core,eta(i))
+      PATHA=(PATH(PA(I),PA(I-2),CORE,ETA(I)))**UEXP
+      PATHB=(PATH(PA(I),PA(I-1),CORE,ETA(I)))**UEXP
+      XX=2.0D0*(PATHB*REXP-PATHA)/(PATHB*PATHB*REXP-PATHA*PATHA)
+      DO 1010 LL=1,20
+      F1=DLOG(1.0D0+XX*PATHA)
+      F2=DLOG(1.0D0+XX*PATHB)
+      F=F1/F2-REXP
+      FPRIME=(F2*PATHA/(1.0D0+XX*PATHA)-F1*PATHB/(1.0D0+XX*PATHB))/ &
+          (F2*F2)
+      XX=XX-F/FPRIME
+      CHECK=1.0D0+XX*PATHA
+!!!!  IF (CHECK) 1020,1020,1025
+      IF(CHECK.LE.0.)THEN
+        WRITE(errmess,360)I,LL,CHECK
+        WRITE(errmess,*)' xx=',xx,' patha=',patha
+  360   FORMAT(' ERROR,I=',I3,'LL=',I3,'CHECK=',F20.10)
+        CALL wrf_error_fatal ( errmess )
+      ENDIF
+ 1010 CONTINUE
+      CA(I)=(1.0D0-TRANSA(I,I-2))**(UEXP/SEXP)/ &
+       (DLOG(1.0D0+XX*PATHA)+1.0D-20)
+      XA(I)=XX
+1000  CONTINUE
+      XA(2)=XA(3)
+      XA(1)=XA(3)
+      CA(2)=CA(3)
+      CA(1)=CA(3)
+      DO 1100 I=3,109
+      PATH0(I)=(PATH(PA(I),0.,CORE,ETA(I)))**UEXP
+      PATH0(I)=1.0D0+XA(I)*PATH0(I)
+!+++  IF (PATH0(I).LT.0.) WRITE (6,361) I,PATH0(I),XA(I)
+1100  CONTINUE
+      DO 1035 I=1,109
+      SEXP=SEXPV(I)
+      ETAP(I)=ETA(I)
+      ETA(I)=(SINV(IR)/RAT)**(1./SEXP)* &
+        (CA(I)*XA(I))**(1./UEXP)
+1035  CONTINUE
+!
+!     THE ETA FORMULATION IS DETAILED IN SCHWARZKOPF AND FELS(1985).
+!        THE QUANTITY SINV=(G*DELTANU)/(RCO2*D*S)
+!      IN CGS UNITS,WITH D,THE DIFFUSICITY FACTOR=2, AND
+!      S,THE SUM OF CO2 LINE STRENGTHS OVER THE 15UM CO2 BAND
+!       ALSO,THE DENOMINATOR IS MULTIPLIED BY
+!      1000 TO PERMIT USE OF MB UNITS FOR PRESSURE.
+!        S IS ACTUALLY WEIGHTED BY B(250) AT 10 CM-1 WIDE INTERVALS,IN
+!      ORDER TO BE CONSISTENT WITH THE METHODS USED TO OBTAIN THE LBL
+!      1-BAND CONSOLIDATED TRANCMISSION FUNCTIONS.
+!      FOR THE 490-850 INTERVAL (DELTANU=360,IR=1) SINV=2.74992.
+!      (SLIGHTLY DIFFERENT FROM 2.7528 USED IN EARLIER VERSIONS)
+!      FOR THE 490-670 INTERVAL (IR=2) SINV=2.12731
+!      FOR THE 670-850 INTERVAL (IR=3) SINV=4.38111
+!      FOR THE 2270-2380 INTERVAL (IR=4) SINV=0.0832926
+!      SINV HAS BEEN OBTAINED USING THE 1982 AFGL CATALOG FOR CO2
+!        RAT IS THE ACTUAL CO2 MIXING RATIO IN UNITS OF 330 PPMV,
+!      LETTING USE OF THIS FORMULATION FOR ANY CO2 CONCENTRATION.
+!
+!     WRITE (6,366) (NP,I,CA(I),XA(I),ETA(I),SEXPV(I),I=1,109)
+!366   FORMAT (2I4,4E20.12)
+1200  CONTINUE
+ 361  FORMAT (' **WARNING:** 1+XA*PATH(PA(I),0) IS NEGATIVE,I= ',I3,/ &
+       20X,'PATH0(I)=',F16.6,' XA(I)=',F16.6)
+      RETURN
+      END SUBROUTINE COEINT
+
+!--------------
+
+
+!CCC  PROGRAM CO2INS
+      SUBROUTINE CO2INS(T22,T23,T66,IQ,L,LP1,iflag)
+!     *********************************************************
+!       SAVE DATA ON PERMANENT DATA SET DENOTED BY CO222 ******
+!          ..... K.CAMPANA   MARCH 1988,OCTOBER 1988...
+!          ..... K.CAMPANA   DECEMBER 1988-CLEANED UP FOR LAUNCHER
+!          ..... K.CAMPANA   NOVEMBER 1989-ALTERED FOR NEW RADIATION
+!     *********************************************************
+      DIMENSION T22(LP1,LP1,3),T23(LP1,LP1,3),T66(LP1,LP1,6)
+      DIMENSION DCDT8(LP1,LP1),DCDT10(LP1,LP1),CO2PO(LP1,LP1), &
+       CO2800(LP1,LP1),CO2PO1(LP1,LP1),CO2801(LP1,LP1),CO2PO2(LP1,LP1), &
+       CO2802(LP1,LP1),N(LP1),D2CT8(LP1,LP1),D2CT10(LP1,LP1)
+!CC   ITIN=22
+!CC   ITIN1=23
+!O222  LATEST CODE HAD  IQ=1
+!CC      IQ=4
+1011  FORMAT (4F20.14)
+!CC      READ (ITIN,1011) ((CO2PO(I,J),I=1,LP1),J=1,LP1)
+!CC      READ (ITIN1,1011) ((CO2800(I,J),I=1,LP1),J=1,LP1)
+!CC      READ (ITIN,1011) ((CO2PO1(I,J),I=1,LP1),J=1,LP1)
+!CC      READ (ITIN1,1011) ((CO2801(I,J),I=1,LP1),J=1,LP1)
+!CC      READ (ITIN,1011) ((CO2PO2(I,J),I=1,LP1),J=1,LP1)
+!CC      READ (ITIN1,1011) ((CO2802(I,J),I=1,LP1),J=1,LP1)
+      DO 300 J=1,LP1
+        DO 300 I=1,LP1
+          CO2PO(I,J) = T22(I,J,1)
+!NOV89
+          IF (IQ.EQ.5) GO TO 300
+!NOV89
+          CO2PO1(I,J) = T22(I,J,2)
+          CO2PO2(I,J) = T22(I,J,3)
+  300 CONTINUE
+      DO 301 J=1,LP1
+        DO 301 I=1,LP1
+          CO2800(I,J) = T23(I,J,1)
+!NOV89
+          IF (IQ.EQ.5) GO TO 301
+!NOV89
+          CO2801(I,J) = T23(I,J,2)
+          CO2802(I,J) = T23(I,J,3)
+  301 CONTINUE
+!***THE FOLLOWING CODE IS REWRITTEN SO THAT THE RADIATIVE BANDS
+!   ARE:
+!        IQ=1    560-800     (CONSOL.=490-850)
+!        IQ=2    560-670     (CONSOL.=490-670)
+!        IQ=3    670-800     (CONSOL.=670-850)
+!        IQ=4    560-760 (ORIGINAL CODE)   (CONSOL.=490-850)
+!NOV89
+!        IQ=5   2270-2380    (CONSOL.=2270-2380)
+!NOV89
+!  THE FOLLOWING LOOP OBTAINS TRANSMISSION FUNCTIONS FOR BANDS
+!  USED IN RADIATIVE MODEL CALCULATIONS,WITH THE EQUIVALENT
+!  WIDTHS KEPT FROM THE ORIGINAL CONSOLIDATED CO2 TF S.
+!NOV89
+!      NOTE: ALTHOUGH THE BAND TRANSMISSION FUNCTIONS ARE
+!  COMPUTED FOR ALL RADIATIVE BANDS, AS OF 9/28/88, THEY
+!  ARE WRITTEN OUT IN FULL ONLY FOR THE FULL 15 UM BAND CASES
+!  (IQ=1,4).  IN OTHER CASES, THE TRANSMISSIVITIES (1,K) ARE
+!  WRITTEN OUT, AS THESE ARE THE ONLY ONES NEEDED FOR CTS
+!  CALCULATIONS.  ALSO, FOR THE 4.3 UM BAND (IQ=5) THE TEMP.
+!  DERIVATIVE TERMS ARE NOT WRITTEN OUT, AS THEY ARE UNUSED.
+!NOV89
+      IF (IQ.EQ.1) THEN
+         C1=1.5
+         C2x=0.5
+      ENDIF
+      IF (IQ.EQ.2) THEN
+        C1=18./11.
+        C2x=7./11.
+      ENDIF
+      IF (IQ.EQ.3) THEN
+        C1=18./13.
+        C2x=5./13.
+      ENDIF
+      IF (IQ.EQ.4) THEN
+        C1=1.8
+        C2x=0.8
+      ENDIF
+!NOV89
+      IF (IQ.EQ.5) THEN
+        C1=1.0
+        C2x=0.0
+      ENDIF
+!NOV89
+      DO 1021 I=1,LP1
+      DO 1021 J=1,LP1
+      CO2PO(J,I)=C1*CO2PO(J,I)-C2x
+      CO2800(J,I)=C1*CO2800(J,I)-C2x
+!NOV89
+      IF (IQ.EQ.5) GO TO 1021
+!NOV89
+      CO2PO1(J,I)=C1*CO2PO1(J,I)-C2x
+      CO2801(J,I)=C1*CO2801(J,I)-C2x
+      CO2PO2(J,I)=C1*CO2PO2(J,I)-C2x
+      CO2802(J,I)=C1*CO2802(J,I)-C2x
+1021  CONTINUE
+!NOV89
+      IF (IQ.GE.1.AND.IQ.LE.4) THEN
+!NOV89
+      DO 1 J=1,LP1
+      DO 1 I=1,LP1
+      DCDT8(I,J)=.02*(CO2801(I,J)-CO2802(I,J))*100.
+      DCDT10(I,J)=.02*(CO2PO1(I,J)-CO2PO2(I,J))*100.
+      D2CT8(I,J)=.0016*(CO2801(I,J)+CO2802(I,J)-2.*CO2800(I,J))*1000.
+      D2CT10(I,J)=.0016*(CO2PO1(I,J)+CO2PO2(I,J)-2.*CO2PO(I,J))*1000.
+1     CONTINUE
+!NOV89
+      ENDIF
+!NOV89
+!O222 *********************************************************
+!CC       REWIND 66
+!        SAVE CDT51,CO251,C2D51,CDT58,CO258,C2D58..ON TEMPO FILE
+!CC       WRITE (66) DCDT10
+!CC       WRITE (66) CO2PO
+!CC       WRITE (66) D2CT10
+!CC       WRITE (66) DCDT8
+!CC       WRITE (66) CO2800
+!CC       WRITE (66) D2CT8
+!CC       REWIND 66
+!NOV89
+      IF (IQ.EQ.1.OR.IQ.EQ.4) THEN
+!NOV89
+      DO 400 J=1,LP1
+       DO 400 I=1,LP1
+        T66(I,J,1) = DCDT10(I,J)
+        T66(I,J,2) = CO2PO(I,J)
+        T66(I,J,3) = D2CT10(I,J)
+        T66(I,J,4) = DCDT8(I,J)
+        T66(I,J,5) = CO2800(I,J)
+        T66(I,J,6) = D2CT8(I,J)
+  400 CONTINUE
+!NOV89
+      ELSE
+      DO 409 I=1,LP1
+        T66(I,1,2) = CO2PO(1,I)
+        T66(I,1,5) = CO2800(1,I)
+        IF (IQ.EQ.5) GO TO 409
+        T66(I,1,1) = DCDT10(1,I)
+        T66(I,1,3) = D2CT10(1,I)
+        T66(I,1,4) = DCDT8(1,I)
+        T66(I,1,6) = D2CT8(1,I)
+  409 CONTINUE
+      ENDIF
+!NOV89
+!O222 *********************************************************
+      RETURN
+      END SUBROUTINE CO2INS
+!O222 PROGRAM CO2INT(INPUT,TAPE5=INPUT)
+!NOV89
+      SUBROUTINE CO2INT(ITAPE,T15A,T15B,T22,RATIO,IR,NMETHD,NLEVLS,NLP1,NLP2)
+!NOV89
+!     *********************************************************
+!       CHANGES TO DATA READ  AND FORMAT SEE CO222     ***
+!          ..... K.CAMPANA   MARCH 1988,OCTOBER 1988
+!       CHANGES TO PASS ITAPE,AND IF IR=4,READ 1 CO2 REC..KAC NOV89
+!     *********************************************************
+!       CO2INT INTERPOLATES CARBON DIOXIDE TRANSMISSION FUNCTIONS
+!  FROM THE 109 LEVEL GRID,FOR WHICH THE TRANSMISSION FUNCTIONS
+!  HAVE BEEN PRE-CALCULATED, TO THE GRID STRUCTURE SPECIFIED BY THE
+!  USER.
+!
+!        METHOD:
+!
+!      CO2INT IS EMPLOYABLE FOR TWO PURPOSES: 1) TO OBTAIN TRANSMIS-
+!  SIVITIES BETWEEN ANY 2 OF AN ARRAY OF USER-DEFINED PRESSURES; AND
+!  2) TO OBTAIN LAYER-MEAN TRANSMISSIVITIES BETWEEN ANY 2 OF AN ARRAY
+!  OF USER-DEFINED PRESSURE LAYERS.TO CLARIFY THESE TWO PURPOSES,SEE
+!  THE DIAGRAM AND DISCUSSION BELOW.
+!      CO2INT MAY BE USED TO EXECUTE ONLY ONE PURPOSE AT ONE TIME.
+!
+!     LET P BE AN ARRAY OF USER-DEFINED PRESSURES
+!     AND PD BE USER-DEFINED PRESSURE LAYERS.
+!
+!       - - - - - - - - -   PD(I-1) ---
+!                                     ^
+!       -----------------   P(I)      ^  PRESSURE LAYER I  (PLM(I))
+!                                     ^
+!       - - - - - - - - -   PD(I)  ---
+!                                     ^
+!       -----------------   P(I+1)    ^  PRESSURE LAYER I+1 (PLM(I+1))
+!                                     ^
+!       - - - - - - - - -   PD(I+1)---
+!            ...                          (THE NOTATION USED IS
+!            ...                          CONSISTENT WITH THE CODE)
+!            ...
+!      - - - - - - - - -    PD(J-1)
+!
+!      -----------------    P(J)
+!
+!      - - - - - - - - -    PD(J)
+!
+!      PURPOSE 1:   THE TRANSMISSIVITY BETWEEN SPECIFIC PRESSURES
+!      P(I) AND P(J) ,TAU(P(I),P(J))  IS COMPUTED BY THIS PROGRAM.
+!      IN THIS MODE,THERE IS NO REFERENCE TO LAYER PRESSURES PD
+!      (PD,PLM ARE NOT INPUTTED).
+!
+!      PURPOSE 2:   THE LAYER-MEAN TRANSMISSIVITY BETWEEN A LAYER-
+!      MEAN PRESSURE PLM(J) AND PRESSURE LAYER I IS GIVEN BY
+!         TAULM(PLM(I),PLM(J)). IT IS COMPUTED BY THE INTEGRAL
+!
+!                           PD(I)
+!                           ----
+!             1             ^
+!        -------------  *   ^   TAU ( P',PLM(J) )  DP'
+!        PD(I)-PD(I-1)      ^
+!                        ----
+!                        PD(I-1)
+!
+!           THE LAYER-MEAN PRESSURE PLM(I) IS SPECIFIED BY THE USER.
+!        FOR MANY PURPOSES,PLM WILL BE CHOSEN TO BE THE AVERAGE
+!        PRESSURE IN THE LAYER-IE,PLM(I)=0.5*(PD(I-1)+PD(I)).
+!           FOR LAYER-MEAN TRANSMISSIVITIES,THE USER THUS INPUTS
+!        A PRESSURE ARRAY (PD) DEFINING THE PRESSURE LAYERS AND AN
+!        ARRAY (PLM) DEFINING THE LAYER-MEAN PRESSURES.THE CALCULATION
+!        DOES NOT DEPEND ON THE P ARRAY USED FOR PURPOSE 1 (P IS NOT
+!        INPUTTED).
+!
+!            THE FOLLOWING PARAGRAPHS DEPICT THE UTILIZATION OF THIS
+!       CODE WHEN USED TO COMPUTE TRANSMISSIVITIES BETWEEN SPECIFIC
+!       PRESSURES. LATER PARAGRAPHS DESCRIBE ADDITIONAL FEATURES NEEDED
+!       FOR LAYER-MEAN TRANSMISSIVITIES.
+!
+!          FOR A GIVEN CO2 MIXING RATIO AND STANDARD TEMPERATURE
+!      PROFILE,A TABLE OF TRANSMISSION FUNCTIONS FOR A FIXED GRID
+!     OF ATMOSPHERIC PRESSURES HAS BEEN PRE-CALCULATED.
+!      THE STANDARD TEMPERATURE PROFILE IS COMPUTED FROM THE US
+!     STANDARD ATMOSPHERE (1977) TABLE.ADDITIONALLY, THE
+!     SAME TRANSMISSION FUNCTIONS HAVE BEEN PRE-CALCULATED FOR A
+!     TEMPERATURE PROFILE INCREASED AND DECREASED (AT ALL LEVELS)
+!     BY 25 DEGREES.
+!         THIS PROGRAM READS IN THE PRESPECIFIED TRANSMISSION FUNCTIONS
+!     AND A USER-SUPPLIED PRESSURE GRID (P(I)) AND CALCULATES TRANS-
+!     MISSION FUNCTIONS ,TAU(P(I),P(J)), FOR ALL P(I) S AND P(J) S.
+!     A LOGARITHMIC INTERPOLATION SCHEME IS USED.
+!         THIS METHOD IS REPEATED FOR THE THREE TEMPERATURE PROFILES
+!     GIVEN ABOVE .THEREFORE OUTPUTS FROM THE PROGRAM ARE THREE TABLES
+!     OF TRANSMISSION FUNCTIONS FOR THE USER-SUPPLIED PRESSURE GRID.
+!     THE EXISTENCE OF THE THREE TABLES PERMITS SUBSEQUENT INTERPO-
+!     LATION TO A USER-SUPPLIED TEMPERATURE PROFILE USING THE METHOD
+!     DESCRIBED IN THE REFERENCE.SEE LIMITATIONS SECTION IF THE
+!     USER DESIRES TO OBTAIN ONLY 1 TABLE OF TRANSMISSIVITIES.
+!
+!     MODIFICATIONS FOR LAYER-MEAN TRANSMISSIVITIES:
+!          THE PRESSURES INPUTTED ARE THE LAYER-MEAN PRESSURES,PD,
+!     AND THE LAYER-MEAN PRESSURES ,PLM. A SERIES OF TRANSMISSIVITIES
+!     (TAU(P'',PLM(J)) ARE COMPUTED AND THE INTEGRAL GIVEN IN THE
+!     DISCUSSION OF PURPOSE 2 IS COMPUTED.FOR PLM(I) NOT EQUAL TO
+!     PLM(J) SIMPSON S RULE IS USED WITH 5 POINTS. IF PLM(I)=PLM(J)
+!     (THE -NEARBY LAYER- CASE) A 49-POINT QUADRATURE IS USED FOR
+!     GREATER ACCURACY.THE OUTPUT IS IN TAULM(PLM(I),PLM(J)).
+!        NOTE:
+!     TAULM IS NOT A SYMMETRICAL MATRIX. FOR THE ARRAY ELEMENT
+!     TAULM(PLM(I),PLM(J)),THE INNER(FIRST,MOST RAPIDLY VARYING)
+!     DIMENSION IS THE VARYING LAYER-MEAN PRESSURE,PLM(I);THE OUTER
+!     (SECOND) DIMENSION IS THE FIXED LAYER-MEAN PRESSURE PLM(J).
+!     THUS THE ELEMENT TAULM(2,3) IS THE TRANSMISSION FUNCTION BETWEEN
+!     THE FIXED PRESSURE PLM(3)  AND THE PRESSURE LAYER HAVING AN AVERAG
+!     PRESSURE OF PLM(2).
+!         ALSO NOTE THAT NO QUADRATURE IS PERFORMED OVER THE LAYER
+!     BETWEEN THE SMALLEST NONZERO PRESSURE AND ZERO PRESSURE;
+!     TAULM IS TAULM(0,PLM(J)) IN THIS CASE,AND TAULM(0,0)=1.
+!
+!
+!             REFERENCE:
+!         S.B.FELS AND M.D.SCHWARZKOPF,-AN EFFICIENT ACCURATE
+!     ALGORITHM FOR CALCULATING CO2 15 UM BAND COOLING RATES-,JOURNAL
+!     OF GEOPHYSICAL RESEARCH,VOL.86,NO. C2, PP.1205-1232,1981.
+!        MODIFICATIONS TO THE ALGORITHM HAVE BEEN MADE BY THE AUTHORS;
+!     CONTACT S.B.F.OR M.D.S. FOR FURTHER DETAILS.A NOTE TO J.G.R.
+!     IS PLANNED TO DOCUMENT THESE CHANGES.
+!
+!            AUTHOR:    M.DANIEL SCHWARZKOPF
+!
+!            DATE:      14 JULY 1983
+!
+!            ADDRESS:
+!
+!                      G.F.D.L.
+!                      P.O.BOX 308
+!                      PRINCETON,N.J.08540
+!                      U.S.A.
+!            TELEPHONE:  (609) 452-6521
+!
+!            INFORMATION ON TAPE: THIS SOURCE IS THE FIRST FILE
+!        ON THIS TAPE.THE SIX FILES THAT FOLLOW ARE CO2 TRANS-
+!        MISSIVITIES FOR THE 500-850 CM-1 INTERVAL FOR CO2
+!        CONCENTRATIONS OF 330 PPMV (1X) ,660 PPMV (2X), AND
+!        1320 PPMV (4X). THE FILES ARE ARRANGED AS FOLLOWS:
+!          FILE 2   1X,CONSOLIDATED USING B(250) WEIGHTING FCTN.
+!          FILE 3   1X,CONSOLIDATED WITH NO WEIGHTING FCTN.
+!          FILE 4   2X,CONSOLIDATED USING B(250) WEIGHTING FCTN.
+!          FILE 5   2X,CONSOLIDATED WITH NO WEIGHTING FCTN.
+!          FILE 6   4X,CONSOLIDATED USING B(250) WEIGHTING FCTN.
+!          FILE 7   4X,CONSOLIDATED WITH NO WEIGHTING FCTN.
+!            FILES 2,4,6 ARE RECOMMENDED FOR USE IN OBTAINING
+!        TRANSMISSION FUNCTIONS FOR USE IN HEATING RATE
+!        COMPUTATIONS;THEY CORRESPOND TO THE TRANSMISSIVITIES
+!        DISCUSSED IN THE 1980 PAPER.FILES 3,5,7 ARE PROVIDED
+!        TO FACILITATE COMPARISON WITH OBSERVATION AND WITH OTHER
+!        CALCULATIONS.
+!
+!            PROGRAM LANGUAGE: FORTRAN 1977,INCLUDING PARAMETER
+!        AND PROGRAM STATEMENTS.THE PROGRAM IS WRITTEN ON A
+!        CYBER 170-730.SEE THE SECTION ON LIMITATIONS FOR
+!        ADAPTATIONS TO OTHER MACHINES.
+!
+!          INPUT UNITS,FORMATS AND FORMAT STATEMENT NOS:
+!
+!   UNIT NO    VARIABLES       FORMAT      STATEMENT NO.    TYPE
+!      5        P (PURPOSE 1)  (5E16.9)        201         CARDS
+!      5        PD (PURPOSE 2) (5E16.9)        201         CARDS
+!      5        PLM(PURPOSE 2) (5E16.9)        201         CARDS
+!      5        NMETHD         (I3)            202         CARDS
+!      20       TRANSA         (4F20.14)       102          TAPE
+!NOV89
+!      ITAPE    TRANSA         (4F20.14)       102          TAPE
+!NOV89
+!
+!         OUTPUT UNITS,FORMATS AND FORMAT STATEMENT NOS:
+!
+!   UNIT NO    VARIABLES       FORMAT     STATEMENT NO.
+!      6         TRNFCT        (1X,8F15.8)     301         PRINT
+!      22        TRNFCT        (4F20.14)       102          TAPE
+!
+!            PARAMETER INPUTS:
+!     A) NLEVLS    : NLEVLS IS AN (INTEGER) PARAMETER DENOTING
+!        THE NUMBER OF NONZERO PRESSURE LEVELS FOR PURPOSE 1
+!        OR THE NUMBER OF NONZERO LAYER PRESSURES NEEDED TO
+!        SPECIFY THE PRESSURE LAYERS(PURPOSE 2) IN THE OUTPUT
+!        GRID. FOR EXAMPLE,IN PURPOSE 1,IF P=0,100,1000,NLEVLS=2.
+!        IF,IN PURPOSE 2,PD=0,100,500,1000,THE NUMBER OF NONZERO
+!        PRESSURE LAYERS=2,SO NLEVLS=2
+!           IN THE CODE AS WRITTEN,NLEVLS=40; THE USER SHOULD
+!        CHANGE THIS VALUE TO A USER-SPECIFIED VALUE.
+!     B) NLP1,NLP2 : INTEGER PARAMETERS DEFINED AS: NLP1=NLEVLS+1;
+!        NLP2=NLEVLS+2.
+!           SEE LIMITATIONS FOR CODE MODIFICATIONS IF PARAMETER
+!        STATEMENTS ARE NOT ALLOWED ON YOUR MACHINE.
+!
+!            INPUTS:
+!
+!     A) TRANSA    : THE 109X109 GRID OF TRANSMISSION FUNCTIONS
+!            TRANSA IS A  DOUBLE PRECISION REAL ARRAY.
+!
+!           TRANSA  IS READ FROM FILE 20. THIS FILE CONTAINS 3
+!     RECORDS,AS FOLLOWS:
+!        1)   TRANSA, STANDARD TEMPERATURE PROFILE
+!        3)   TRANSA, STANDARD TEMPERATURES + 25 DEG
+!        5)   TRANSA, STANDARD TEMPERATURES - 25 DEG
+!
+!     B)   NMETHD: AN INTEGER WHOSE VALUE IS EITHER 1 (IF CO2INT IS
+!       TO BE USED FOR PURPOSE 1) OR 2 (IF CO2INT IS TO BE USED FOR
+!       PURPOSE 2).
+!
+!     C)     P,PD,PLM :
+!          P IS A REAL ARRAY (LENGTH NLP1) SPECIFYING THE PRESSURE
+!       GRID AT WHICH TRANSMISSION FUNCTIONS ARE TO BE COMPUTED FOR
+!       PURPOSE 1.THE DIMENSION  OF P IS  IN MILLIBARS.THE
+!       FOLLOWING LIMITATIONS WILL BE EXPLAINED MORE
+!       IN THE SECTION ON LIMITATIONS: P(1) MUST BE ZERO; P(NLP1),THE
+!       LARGEST PRESSURE, MUST NOT EXCEED 1165 MILLIBARS.
+!         PD IS A REAL ARRAY (LENGTH NLP2) SPECIFYING THE PRESSURE
+!       LAYERS FOR WHICH LAYER-AVERAGED TRANSMISSION FUNCTIONS ARE
+!       TO BE COMPUTED.THE DIMENSION OF PD IS MILLIBARS.THE LIMITATIONS
+!       FOR PD ARE THE SAME AS FOR P,AND ARE GIVEN IN THE SECTION ON
+!       LIMITATIONS.
+!         PLM IS A REAL ARRAY (LENGTH NLP2) SPECIFYING THE LAYER-MEAN
+!       PRESSURES. THE DIMENSION OF PLM IS MILLIBARS. THE LIMITATIONS
+!       FOR PLM ARE THE SAME AS FOR P,AND ARE GIVEN IN THE SECTION ON
+!       LIMITATIONS.PD IS READ IN BEFORE PLM.
+!
+!          NOTE: AGAIN,WE NOTE THAT THE USER WILL INPUT EITHER P (FOR
+!       PURPOSE 1) OR PD AND PLM(FOR PURPOSE 2) BUT NOT BOTH.
+!
+!
+!
+!
+!           LIMITATIONS:
+!     1)       P(1)=0.,PD(1)=0.,PLM(1)=0. THE TOP PRESSURE LEVEL
+!       MUST BE ZERO,OR THE TOP PRESSURE LAYER MUST BE BOUNDED BY ZERO.
+!       THE TOP LAYER-MEAN PRESSURE (PLM(1)) MUST BE ZERO; NO
+!       QUADRATURE IS DONE ON THE TOP PRESSURE LAYER.EVEN IF ONE IS
+!       NOT INTERESTED IN THE TRANSMISSION FUNCTION BETWEEN 0 AND P(J),
+!       ONE MUST INCLUDE SUCH A LEVEL.
+!     2)      PD(NLP2)=P(NLP1) IS LESS THAN OR EQUAL TO 1165 MB.
+!       EXTRAPOLATION TO HIGHER PRESSURES IS NOT POSSIBLE.
+!     3)      IF PROGRAM IS NOT PERMITTED ON YOUR COMPILER,
+!       SIMPLY DELETE THE LINE.
+!     4)      IF PARAMETER IS NOT PERMITTED,DO THE FOLLOWING:
+!            1) DELETE ALL PARAMETER STATEMENTS IN CO2INT
+!            2) AT THE POINT WHERE NMETHOD IS READ IN,ADD:
+!                READ (5,202) NLEVLS
+!                NLP1=NLEVLS+1
+!                NLP2=NLEVLS+2
+!            3) CHANGE DIMENSION AND/OR COMMON STATEMENTS DEFINING
+!              ARRAYS TRNS,DELTA,P,PD,TRNFCT,PS,PDS,PLM IN CO2INT.
+!              THE NUMERICAL VALUE OF (NLEVLS+1) SHOULD BE INSERTED
+!              IN DIMENSION OR COMMON STATEMENTS FOR TRNS,DELTA,
+!              P,TRNFCT,PS,PLM; THE NUMERICAL VALUE OF (NLEVLS+2)
+!              IN DIMENSION OR COMMON STATEMENTS FOR PD,PDS.
+!      5)    PARAMETER (NLEVLS=40) AND THE OTHER PARAMETER
+!       STATEMENTS ARE WRITTEN IN CDC FORTRAN; ON OTHER MACHINES THE
+!       SAME STATEMENT MAY BE WRITTEN DIFFERENTLY,FOR EXAMPLE AS
+!       PARAMETER   NLEVLS=40
+!      6) -DOUBLE PRECISION- IS USED INSTEAD OF -REAL*8- ,DUE TO
+!       REQUIREMENTS OF CDC FORTAN.
+!      7) THE STATEMENT -DO 400 KKK=1,3- CONTROLS THE NUMBER OF
+!       TRANSMISSIVITY OUTPUT MATRICES PORDUCED BY THE PROGRAM.TO
+!       PRODUCE 1 OUTPUT MATRIX,DELETE THIS STATEMENT.
+!
+!     OUTPUT:
+!         A) TRNFCT IS AN (NLP1,NLP1) REAL ARRAY OF THE TRANSMISSION
+!     FUNCTIONS APPROPRIATE TO YOUR ARRAY. IT IS TO BE SAVED ON FILE 22.
+!     THE PROCEDURE FOR SAVING MAY BE MODIFIED; AS GIVEN HERE,THE
+!     OUTPUT IS IN CARD IMAGE FORM WITH A FORMAT OF (4F20.14).
+!
+!         B)  PRINTED  OUTPUT IS A LISTING OF TRNFCT ON UNIT 6, IN
+!     THE FORMAT (1X,8F15.8) (FORMAT STATEMENT 301). THE USER MAY
+!     MODIFY OR ELIMINATE THIS AT WILL.
+!
+!      ************   FUNCTION INTERPOLATER ROUTINE  *****************
+!
+!
+!     ******   THE FOLLOWING PARAMETER GIVES THE NUMBER OF     *******
+!     ******           DATA LEVELS IN THE MODEL                *******
+!     ****************************************************************
+!     ****************************************************************
+      COMMON/INPUT/P1,P2,TRNSLO,IA,JA,N
+!     COMMON/PRESS/PA(109)
+!     COMMON/TRAN/ TRANSA(109,109)
+!     COMMON / OUTPUT / TRNS(NLP1,NLP1)
+!     COMMON/INPUTP/P(NLP1),PD(NLP2)
+      DIMENSION TRNS(NLP1,NLP1)
+      DIMENSION P(NLP1),PD(NLP2)
+      DIMENSION PS(NLP1),PDS(NLP2),PLM(NLP1)
+      DIMENSION NRTAB(3)
+      DIMENSION T15A(NLP2,2),T15B(NLP1)
+      DIMENSION T22(NLP1,NLP1,3)
+      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+      DATA NRTAB/1,2,4/
+!***********************************
+!   THE FOLLOWING ARE THE INPUT FORMATS
+100   FORMAT (4F20.14)
+743   FORMAT (F20.14)
+201   FORMAT (5E16.9)
+202   FORMAT (I3)
+!O222   203   FORMAT (F12.6,I2)
+203   FORMAT (F12.6)
+!    THE FOLLOWING ARE THE OUTPUT FORMATS
+102   FORMAT (4F20.14)
+301   FORMAT (1X,8F15.8)
+!
+!CC   REWIND 15
+!CC   REWIND 20
+!NOV89
+      REWIND ITAPE
+!NOV89
+!CC   REWIND 22
+!
+!     CALCULATION OF PA -THE -TABLE- OF 109 GRID PRESSURES
+!     NOTE-THIS CODE MUST NOT BE CHANGED BY THE USER^^^^^^^^^
+      PA(1)=0.
+      FACT15=10.**(1./15.)
+      FACT30=10.**(1./30.)
+      PA(2)=1.0E-3
+      DO 231 I=2,76
+      PA(I+1)=PA(I)*FACT15
+231   CONTINUE
+      DO 232 I=77,108
+      PA(I+1)=PA(I)*FACT30
+232   CONTINUE
+!
+      N=25
+      NLV=NLEVLS
+      NLP1V=NLP1
+      NLP2V=NLP2
+!     READ IN THE CO2 MIXING RATIO(IN UNITS OF 330 PPMV),AND AN INDEX
+!     GIVING THE FREQUENCY RANGE OF THE LBL DATA
+!O222    READ (5,203) RATIO,IR
+!CC         IR = 1
+!CC         READ (5,203) RATIO
+!O222   ***********************************
+!***VALUES FOR IR*****
+!          IR=1     CONSOL. LBL TRANS. =490-850
+!          IR=2     CONSOL. LBL TRANS. =490-670
+!          IR=3     CONSOL. LBL TRANS. =670-850
+!          IR=4     CONSOL. LBL TRANS. =2270-2380
+!*** IR MUST BE 1,2,3 OR 4 FOR THE PGM. TO WORK
+!     ALSO READ IN THE METHOD NO.(1 OR 2)
+!CC         READ (5,202) NMETHD
+      IF (RATIO.EQ.1.0) GO TO 621
+      CALL wrf_error_fatal( 'SUBROUTINE CO2INT: 8746' )
+!NOV89  621   ITAP1=20
+621   ITAP1=ITAPE
+!NOV89
+      NTAP=1
+      IF (NMETHD.EQ.2) GO TO 502
+!   *****CARDS FOR PURPOSE 1(NMETHD=1)
+!CC         READ (15,201) (P(I),I=1,NLP1)
+      DO 300 I=1,NLP1
+        P(I)=T15B(I)
+  300 CONTINUE
+      DO 801 I=1,NLP1
+      PS(I)=P(I)
+801   CONTINUE
+      GO TO 503
+502   CONTINUE
+!  *****CARDS FOR PURPOSE 2(NMETHD=2)
+!CC         READ (15,201) (PD(I),I=1,NLP2)
+!CC         READ (15,201) (PLM(I),I=1,NLP1)
+      DO 303 I=1,NLP2
+        PD(I)=T15A(I,1)
+  303 CONTINUE
+      DO 302 I=1,NLP1
+        PLM(I)=T15A(I,2)
+  302 CONTINUE
+      DO 802 I=1,NLP1
+      PDS(I)=PD(I+1)
+      PS(I)=PLM(I)
+802   CONTINUE
+!
+503   CONTINUE
+!  *****DO LOOP CONTROLLING NUMBER OF OUTPUT MATRICES
+!NOV89
+!NOV89    DO 400 KKK=1,3
+      ICLOOP = 3
+      IF (IR.EQ.4) ICLOOP = 1
+      DO 400 KKK=1,ICLOOP
+!NOV89
+!  **********************
+      IF (NMETHD.EQ.2) GO TO 505
+!   *****CARDS FOR PURPOSE 1(NMETHD=1)
+      DO 803 I=1,NLP1
+      P(I)=PS(I)
+803   CONTINUE
+      GO TO 506
+505   CONTINUE
+!  *****CARDS FOR PURPOSE 2(NMETHD=2)
+      DO 804 I=1,NLP1
+      PD(I)=PDS(I)
+      P(I)=PS(I)
+804   CONTINUE
+!
+506   CONTINUE
+      IA=108
+      IAP=IA+1
+!NOV89   IF (NTAP.EQ.1) READ (20,100) ((TRANSA(I,J),I=1,109),J=1,109)
+!mp       IF (NTAP.EQ.1) READ (ITAPE,100) ((TRANSA(I,J),I=1,109),J=1,109)
+        IF (NTAP.EQ.1) THEN
+           IF ( wrf_dm_on_monitor() ) READ (ITAPE,743) ((TRANSA(I,J),I=1,109),J=1,109)
+           CALL wrf_dm_bcast_bytes ( TRANSA , size ( TRANSA ) * RWORDSIZE )
+        ENDIF
+!mp	IF (NTAP.EQ.1) READ (ITAPE,100) (tmp(I),I=1,11881
+!mp
+	do J=109,1,-6
+!mp	write(6,697)(TRANSA(I,J),I=5,105,10)
+	enddo
+! 697	format(11(f5.3,1x))
+!mp
+!NOV89
+      DO 4 I=1,IAP
+      TRANSA(I,I)=1.0
+    4 CONTINUE
+      CALL COEINT(RATIO,IR)
+      DO 805 I=1,NLP1
+      DO 805 J=1,NLP1
+      TRNS(J,I)=1.00
+805   CONTINUE
+      DO 10 I=1,NLP1
+      DO 20 J=1,I
+      IF (I.EQ.J) GO TO 20
+      P1=P(J)
+      P2=P(I)
+      CALL SINTR2
+      TRNS(J,I)=TRNSLO
+20    CONTINUE
+10    CONTINUE
+      DO 47 I=1,NLP1
+      DO 47 J=I,NLP1
+      TRNS(J,I)=TRNS(I,J)
+47    CONTINUE
+!  *****THIS IS THE END OF PURPOSE 1 CALCULATIONS
+      IF (NMETHD.EQ.1) GO TO 2872
+!
+      DO 51 J=1,NLP1
+      DO 52 I=2,NLP1
+      IA=I
+      JA=J
+      N=25
+      IF (I.NE.J) N=3
+      CALL QUADSR(NLV,NLP1V,NLP2V,P,PD,TRNS)
+52    CONTINUE
+51    CONTINUE
+!  *****THIS IS THE END OF PURPOSE 2 CALCULATIONS
+2872  CONTINUE
+!
+!+++  WRITE (6,301) ((TRNS(I,J),I=1,NLP1),J=1,NLP1)
+!CC         WRITE (22,102) ((TRNS(I,J),I=1,NLP1),J=1,NLP1)
+      DO 304 J=1,NLP1
+       DO 304 I=1,NLP1
+        T22(I,J,KKK) = TRNS(I,J)
+  304 CONTINUE
+400   CONTINUE
+      RETURN
+      END SUBROUTINE CO2INT
+!CCC  PROGRAM CO2IN1
+      SUBROUTINE CO2IN1(T20,T21,T66,IQ,L,LP1)
+!    CO2IN1=CO2INS FOR METHOD 1
+!     *********************************************************
+!       SAVE DATA ON PERMANENT DATA SET DENOTED BY CO222 ***
+!          ..... K.CAMPANA   MARCH 1988,OCTOBER 1988
+!          ..... K.CAMPANA   DECEMBER 88 CLEANED UP FOR LAUNCHER
+!     *********************************************************
+      DIMENSION T20(LP1,LP1,3),T21(LP1,LP1,3),T66(L,6)
+      DIMENSION DCDT8(LP1,LP1),DCDT10(LP1,LP1),CO2PO(LP1,LP1), &
+       CO2800(LP1,LP1),CO2PO1(LP1,LP1),CO2801(LP1,LP1),CO2PO2(LP1,LP1), &
+       CO2802(LP1,LP1),N(LP1),D2CT8(LP1,LP1),D2CT10(LP1,LP1)
+      ITIN=20
+      ITIN1=21
+!O222 LATEST CODE HAS IQ=1
+!CC         IQ=4
+1011  FORMAT (4F20.14)
+!CC        READ (ITIN,1011) ((CO2PO(I,J),I=1,LP1),J=1,LP1)
+!CC        READ (ITIN1,1011) ((CO2800(I,J),I=1,LP1),J=1,LP1)
+!CC        READ (ITIN,1011) ((CO2PO1(I,J),I=1,LP1),J=1,LP1)
+!CC        READ (ITIN1,1011) ((CO2801(I,J),I=1,LP1),J=1,LP1)
+!CC        READ (ITIN,1011) ((CO2PO2(I,J),I=1,LP1),J=1,LP1)
+!CC        READ (ITIN1,1011) ((CO2802(I,J),I=1,LP1),J=1,LP1)
+      DO 300 J=1,LP1
+        DO 300 I=1,LP1
+          CO2PO(I,J) = T20(I,J,1)
+!NOV89
+          IF (IQ.EQ.5) GO TO 300
+!NOV89
+          CO2PO1(I,J) = T20(I,J,2)
+          CO2PO2(I,J) = T20(I,J,3)
+  300 CONTINUE
+      DO 301 J=1,LP1
+        DO 301 I=1,LP1
+          CO2800(I,J) = T21(I,J,1)
+!NOV89
+          IF (IQ.EQ.5) GO TO 301
+!NOV89
+          CO2801(I,J) = T21(I,J,2)
+          CO2802(I,J) = T21(I,J,3)
+  301 CONTINUE
+!***THE FOLLOWING CODE IS REWRITTEN SO THAT THE RADIATIVE BANDS
+!   ARE:
+!        IQ=1    560-800     (CONSOL.=490-850)
+!        IQ=2    560-670     (CONSOL.=490-670)
+!        IQ=3    670-800     (CONSOL.=670-850)
+!        IQ=4    560-760 (ORIGINAL CODE)   (CONSOL.=490-850)
+!NOV89
+!        IQ=5   2270-2380    (CONSOL.=2270-2380)
+!NOV89
+!  THE FOLLOWING LOOP OBTAINS TRANSMISSION FUNCTIONS FOR BANDS
+!  USED IN RADIATIVE MODEL CALCULATIONS,WITH THE EQUIVALENT
+!  WIDTHS KEPT FROM THE ORIGINAL CONSOLIDATED CO2 TF S.
+      IF (IQ.EQ.1) THEN
+         C1=1.5
+         C2x=0.5
+      ENDIF
+      IF (IQ.EQ.2) THEN
+        C1=18./11.
+        C2x=7./11.
+      ENDIF
+      IF (IQ.EQ.3) THEN
+        C1=18./13.
+        C2x=5./13.
+      ENDIF
+      IF (IQ.EQ.4) THEN
+        C1=1.8
+        C2x=0.8
+      ENDIF
+!NOV89
+      IF (IQ.EQ.5) THEN
+        C1=1.0
+        C2x=0.0
+      ENDIF
+!NOV89
+      DO 1021 I=1,LP1
+      DO 1021 J=1,LP1
+      CO2PO(J,I)=C1*CO2PO(J,I)-C2x
+      CO2800(J,I)=C1*CO2800(J,I)-C2x
+!NOV89
+      IF (IQ.EQ.5) GO TO 1021
+!NOV89
+      CO2PO1(J,I)=C1*CO2PO1(J,I)-C2x
+      CO2801(J,I)=C1*CO2801(J,I)-C2x
+      CO2PO2(J,I)=C1*CO2PO2(J,I)-C2x
+      CO2802(J,I)=C1*CO2802(J,I)-C2x
+1021  CONTINUE
+!NOV89
+      IF (IQ.GE.1.AND.IQ.LE.4) THEN
+!NOV89
+      DO 1 J=1,LP1
+      DO 1 I=1,LP1
+      DCDT8(I,J)=.02*(CO2801(I,J)-CO2802(I,J))*100.
+      DCDT10(I,J)=.02*(CO2PO1(I,J)-CO2PO2(I,J))*100.
+      D2CT8(I,J)=.0016*(CO2801(I,J)+CO2802(I,J)-2.*CO2800(I,J))*1000.
+      D2CT10(I,J)=.0016*(CO2PO1(I,J)+CO2PO2(I,J)-2.*CO2PO(I,J))*1000.
+1     CONTINUE
+!NOV89
+      ENDIF
+!NOV89
+!O222 *********************************************************
+!CC          REWIND 66
+!        SAVE CDTM51,CO2M51,C2DM51,CDTM58,CO2M58,C2DM58..ON TEMPO FILE
+!CC          WRITE (66) (DCDT10(I,I+1),I=1,L)
+!CC          WRITE (66) (CO2PO(I,I+1),I=1,L)
+!CC          WRITE (66) (D2CT10(I,I+1),I=1,L)
+!CC          WRITE (66) (DCDT8(I,I+1),I=1,L)
+!CC          WRITE (66) (CO2800(I,I+1),I=1,L)
+!CC          WRITE (66) (D2CT8(I,I+1),I=1,L)
+!CC          REWIND 66
+!O222 *********************************************************
+      DO 400 I=1,L
+        T66(I,2) = CO2PO(I,I+1)
+        T66(I,5) = CO2800(I,I+1)
+!NOV89
+        IF (IQ.EQ.5) GO TO 400
+!NOV89
+        T66(I,1) = DCDT10(I,I+1)
+        T66(I,3) = D2CT10(I,I+1)
+        T66(I,4) = DCDT8(I,I+1)
+        T66(I,6) = D2CT8(I,I+1)
+  400 CONTINUE
+      RETURN
+      END SUBROUTINE CO2IN1
+!CCC  PROGRAM PTZ - COURTESY OF DAN SCHWARZKOPF,GFDL DEC 1987....
+      SUBROUTINE CO2PTZ(SGTEMP,T41,T42,T43,T44,SGLVNU,SIGLNU, &
+                        SFULL,SHALF,PPTOP,LREAD,NL,NLP,NLP2)
+!
+! **         THIS PROGRAM CALCULATES TEMPERATURES ,H2O MIXING RATIOS
+! **         AND O3 MIXING RATIOS BY USING AN ANALYTICAL
+! **         FUNCTION WHICH APPROXIMATES
+! **         THE US STANDARD (1976).  THIS IS
+! **         CALCULATED IN FUNCTION 'ANTEMP', WHICH IS CALLED BY THE
+! **         MAIN PROGRAM.  THE FORM OF THE ANALYTICAL FUNCTION WAS
+! **         SUGGESTED TO ME IN 1971 BY RICHARD S. LINDZEN.
+! ******************************************************************
+!         CODE TO SAVE STEMP,GTEMP ON DATA SET,BRACKETED BY CO222  **
+!             ....K. CAMPANA MARCH 88,OCTOBER 88
+      DIMENSION SGTEMP(NLP,2),T41(NLP2,2),T42(NLP), &
+                T43(NLP2,2),T44(NLP)
+      DIMENSION SGLVNU(NLP),SIGLNU(NL)
+      DIMENSION SFULL(NLP),SHALF(NL)
+! ******************************************************************
+!
+!*****THIS VERSION IS ONLY USABLE FOR 1976 US STD ATM AND OBTAINS
+!     QUANTITIES FOR CO2 INTERPOLATION AND INSERTION INTO OPERA-
+!     TIONAL RADIATION CODES
+!
+      CHARACTER*20 PROFIL
+      DIMENSION PRESS(NLP),TEMP(NLP),ALT(NLP),WMIX(NLP),O3MIX(NLP)
+      DIMENSION WMXINT(NLP,4),WMXOUT(NLP2),OMXINT(NLP,4),OMXOUT(NLP2)
+      DIMENSION PD(NLP2),GTEMP(NLP)
+      DIMENSION PRS(NLP),TEMPS(NLP),PRSINT(NLP),TMPINT(NLP,4),A(NLP,4)
+      DIMENSION PROUT(NLP2),TMPOUT(NLP2),TMPFLX(NLP2),TMPMID(NLP2)
+!
+!
+      DATA PROFIL/ &
+         'US STANDARD 1976'/
+      DATA PSMAX/1013.250/
+!
+! **         NTYPE IS AN INTEGER VARIABLE WHICH HAS THE FOLLOWING
+! **        VALUES:    0 =SIGMA LEVELS ARE USED;   1= SKYHI L40 LEVELS
+! **        ARE USED;   2 = SKYHI L80 LEVELS ARE USED. DEFAULT: 0
+!
+      NTYPE=0
+!O222 READ (*,*) NTYPE
+    5 NLEV=NL
+      DELZAP=0.5
+      R=8.31432
+      G0=9.80665
+      ZMASS=28.9644
+      AA=6356.766
+         ALT(1)=0.0
+         TEMP(1)=ANTEMP(6,0.0)
+!*******DETERMINE THE PRESSURES (PRESS)
+      PSTAR=PSMAX
+!
+!***  LTOP COMPUTATION MOVED FROM MODEL INITIALIZATION
+!
+      LTOP(1)=0
+      LTOP(2)=0
+      LTOP(3)=0
+      DO 30 N=1,NL
+        PCLD=(PSTAR-PPTOP*10.)*SHALF(N)+PPTOP*10.
+        IF(PCLD.GE.642.)LTOP(1)=N
+        IF(PCLD.GE.350.)LTOP(2)=N
+        IF(PCLD.GE.150.)LTOP(3)=N
+!       PRINT *,N,PCLD,SHALF(N),PSTAR,PPTOP
+   30 CONTINUE
+!
+!O222 IF (NTYPE.EQ.1) CALL SKYP(PSTAR,PD,GTEMP)
+!O222 IF (NTYPE.EQ.2) CALL SKY80P(PSTAR,PD,GTEMP)
+!O222 IF (NTYPE.EQ.0) CALL SIGP(PSTAR,PD,GTEMP)
+!CC----      CALL SIGP(PSTAR,PD,GTEMP)
+      NLM=NL-1
+      CALL SIGP(PSTAR,PD,GTEMP,T41,T42,T43,T44,SGLVNU,SIGLNU, &
+                SFULL,SHALF,PPTOP,LREAD,NL,NLP,NLM,NLP2)
+      PD(NLP2)=PSTAR
+      DO 40 N=1,NLP
+      PRSINT(N)=PD(NLP2+1-N)
+ 40   CONTINUE
+!    *** CALCULATE TEMPS FOR SEVERAL PRESSURES TO DO QUADRATURE
+      DO 504 NQ=1,4
+      DO 505 N=2,NLP
+ 505  PRESS(N)=PRSINT(N)+0.25*(NQ-1)*(PRSINT(N-1)-PRSINT(N))
+      PRESS(1)=PRSINT(1)
+!*********************
+      DO 100 N=1,NLEV
+!
+! **         ESTABLISH COMPUTATATIONAL LEVELS BETWEEN USER LEVELS AT
+! **         INTERVALS OF APPROXIMATELY 'DELZAP' KM.
+!
+      DLOGP=7.0*ALOG(PRESS(N)/PRESS(N+1))
+      NINT=DLOGP/DELZAP
+      NINT=NINT+1
+      ZNINT=NINT
+!     G=G0
+      DZ=R*DLOGP/(7.0*ZMASS*G0*ZNINT)
+      HT=ALT(N)
+!
+! **         CALCULATE HEIGHT AT NEXT USER LEVEL BY MEANS OF
+! **                   RUNGE-KUTTA INTEGRATION.
+!
+      DO 200 M=1,NINT
+      RK1=ANTEMP(6,HT)*DZ
+      RK2=ANTEMP(6,HT+0.5*RK1)*DZ
+      RK3=ANTEMP(6,HT+0.5*RK2)*DZ
+      RK4=ANTEMP(6,HT+RK3)*DZ
+!mp	write(6,*) 'RK values,DZ ', RK1,RK2,RK3,RK4,DZ
+      HT=HT+0.16666667*(RK1+RK2+RK2+RK3+RK3+RK4)
+  200 CONTINUE
+      ALT(N+1)=HT
+      TEMP(N+1)=ANTEMP(6,HT)
+  100 CONTINUE
+      DO 506 N=1,NLP
+      TMPINT(N,NQ)=TEMP(N)
+      A(N,NQ)=ALT(N)
+506   CONTINUE
+504   CONTINUE
+!O222   *****************************************************
+!***OUTPUT TEMPERATURES
+!O222   *****************************************************
+      DO 901 N=1,NLP
+        SGTEMP(N,1) = TMPINT(NLP2-N,1)
+  901 CONTINUE
+!O222   *****************************************************
+!***OUTPUT GTEMP
+!O222   *****************************************************
+      DO 902 N=1,NLP
+        SGTEMP(N,2) = GTEMP(N)
+  902 CONTINUE
+!O222   *****************************************************
+      RETURN
+      END SUBROUTINE CO2PTZ
+      FUNCTION PATH(A,B,C,E)
+!....
+!     DOUBLE PRECISION XA,CA
+!     COMMON/COEFS/XA(109),CA(109),ETA(109),SEXPV(109),CORE,UEXP,SEXP
+      PEXP=1./SEXP
+      PATH=((A-B)**PEXP*(A+B+C))/(E*(A+B+C)+(A-B)**(PEXP-1.))
+      RETURN
+      END FUNCTION PATH
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+      SUBROUTINE QINTRP(XM,X0,XP,FM,F0,FP,X,F)
+!....
+!     DOUBLE PRECISION FM,F0,FP,F,D1,D2,B,A,DEL
+      D1=(FP-F0)/(XP-X0)
+      D2=(FM-F0)/(XM-X0)
+      B=(D1-D2)/(XP-XM)
+      A=D1-B*(XP-X0)
+      DEL=(X-X0)
+      F=F0+DEL*(A+DEL*B)
+      RETURN
+      END SUBROUTINE QINTRP
+      SUBROUTINE QUADSR(NLV,NLP1V,NLP2V,P,PD,TRNS)
+      COMMON/INPUT/P1,P2,TRNSLO,IA,JA,N
+      DIMENSION P(NLP1V),PD(NLP2V),TRNS(NLP1V,NLP1V)
+      DIMENSION WT(101)
+      N2=2*N
+      N2P=2*N+1
+!  *****WEIGHTS ARE CALCULATED
+      WT(1)=1.
+      DO 21 I=1,N
+      WT(2*I)=4.
+      WT(2*I+1)=1.
+21    CONTINUE
+      IF (N.EQ.1) GO TO 25
+      DO 22 I=2,N
+      WT(2*I-1)=2.
+22    CONTINUE
+25    CONTINUE
+      TRNSNB=0.
+      DP=(PD(IA)-PD(IA-1))/N2
+      PFIX=P(JA)
+      DO 1 KK=1,N2P
+      PVARY=PD(IA-1)+(KK-1)*DP
+      IF (PVARY.GE.PFIX) P2=PVARY
+      IF (PVARY.GE.PFIX) P1=PFIX
+      IF (PVARY.LT.PFIX) P1=PVARY
+      IF (PVARY.LT.PFIX) P2=PFIX
+      CALL SINTR2
+      TRNSNB=TRNSNB+TRNSLO*WT(KK)
+1     CONTINUE
+      TRNS(IA,JA)=TRNSNB*DP/(3.*(PD(IA)-PD(IA-1)))
+      RETURN
+      END SUBROUTINE QUADSR
+!---------------------------------------------------------------------
+      SUBROUTINE SIGP(PSTAR,PD,GTEMP,T41,T42,T43,T44,SGLVNU,SIGLNU, &
+                      SIGLV,SIGLY,PPTOP,LREAD,KD,KP,KM,KP2)
+      DIMENSION Q(KD),QMH(KP),PD(KP2),PLM(KP),GTEMP(KP),PDT(KP2)
+      DIMENSION SIGLY(KD),SIGLV(KP)
+      DIMENSION CI(KP),SGLVNU(KP),DEL(KD),SIGLNU(KD),CL(KD),RPI(KM)
+      DIMENSION IDATE(4)
+      DIMENSION T41(KP2,2),T42(KP), &
+                T43(KP2,2),T44(KP)
+!     integer :: retval
+!     character(50) :: prsmid='prsmid'
+!CC   18 LEVEL SIGMAS FOR NMC MRF(NEW) MODEL
+!CC   DATA Q/.021,.074,.124,.175,.225,.275,.325,.375,.425,.497, &
+!CC          .594,.688,.777,.856,.920,.960,.981,.995/
+!     FOR SIGMA MODELS,Q=SIGMA,QMH=0.5(Q(I)+Q(I+1),
+!     PD=Q*PSS,PLM=QMH*PSS.PSS=SURFACE PRESSURE(SPEC.)
+!
+!.....   GET NMC SIGMA STRUCTURE
+!CC   IF (LREAD.GT.0) GO TO 914
+!---   PPTOP IS MODEL TOP PRESSURE IN CB....
+!        SIGMA DATA IS BOTTOM OF ATMOSPHERE TO T.O.A.....
+!cccc PPTOP=5.0
+!     READ(11,PPTOP,END=12321)
+12321 CONTINUE
+!     WRITE(6,88221)PPTOP,KD,KP
+!88221 FORMAT(' ENTER SIGP PPTOP=',E12.5,' KD=',I2,' KP=',I2)
+!     open(unit=23,file='fort.23',form='unformatted' &
+!     ,    access='sequential')
+!     REWIND 23
+!     READ(23)SIGLY
+!     DO KKK=1,KD
+!      SIGLY(KKK)=1.-(FLOAT(KKK)-0.5)/KD
+!     END DO
+!     WRITE(6,88222)
+!88222 FORMAT(' READ AETA')
+!     DO 37821 LLL=1,KD
+!     WRITE(6,37820)LLL,SIGLY(LLL)
+!37820 FORMAT(' L=',I2,' AETA=',E12.5)
+!37821 CONTINUE
+!     READ(23)SIGLV
+!     DO KKK=1,KP
+!      SIGLV(KKK)=1.-(FLOAT(KKK-1))/KD
+!     END DO
+!     WRITE(6,88223)
+!88223 FORMAT(' READ ETA')
+!     PRINT 704,(SIGLY(K),K=1,KD)
+!     PRINT 704,(SIGLV(K),K=1,KP)
+!      DO 37823 LLL=1,KP
+!      WRITE(6,37822)LLL,SIGLV(LLL)
+!37822 FORMAT(' L=',I2,' ETA=',E12.5)
+!37823 CONTINUE
+  701 FORMAT(F6.2)
+  702 FORMAT(7F10.6)
+      IF (PPTOP.LE.0.) GO TO 708
+      PSFC=100.
+!--- IF PTOP NOT EQUAL TO ZERO ADJUST SIGMA SO AS TO GET PROPER STD ATM
+!      VERTICAL LOCATION
+      DO 706 K=1,KD
+       SIGLY(K) = (SIGLY(K)*(PSFC-PPTOP)+PPTOP)/PSFC
+  706 CONTINUE
+      DO 707 K=1,KP
+       SIGLV(K) = (SIGLV(K)*(PSFC-PPTOP)+PPTOP)/PSFC
+  707 CONTINUE
+  708 CONTINUE
+!     PRINT 703,PPTOP
+!     PRINT 704,(SIGLY(K),K=1,KD)
+!     PRINT 704,(SIGLV(K),K=1,KP)
+  703 FORMAT(1H ,'PTOP =',F6.2)
+  704 FORMAT(1H ,7F10.6)
+      DO 913 K=1,KP
+       SGLVNU(K) = SIGLV(K)
+       IF (K.LE.KD) SIGLNU(K) = SIGLY(K)
+  913 CONTINUE
+      DO 77 K=1,KD
+         Q(K) = SIGLNU(KD+1-K)
+   77 CONTINUE
+      PSS=    1013250.
+      QMH(1)=0.
+      QMH(KP)=1.
+      DO 1 K=2,KD
+      QMH(K)=0.5*(Q(K-1)+Q(K))
+1     CONTINUE
+      PD(1)=0.
+      PD(KP2)=PSS
+      DO 2 K=2,KP
+      PD(K)=Q(K-1)*PSS
+2     CONTINUE
+!       call int_get_fresh_handle(retval)
+!       close(retval)
+!       write(0,*)' before open in CO2O3'
+!       open(unit=retval,file=prsmid,form='UNFORMATTED',iostat=ier)
+!       write(0,*)' after open1'
+!       do k=1,62
+!         write(retval)pd(k)
+!       enddo
+!       close(retval)
+      PLM(1)=0.
+      DO 3 K=1,KM
+      PLM(K+1)=0.5*(PD(K+1)+PD(K+2))
+3     CONTINUE
+      PLM(KP)=PSS
+      DO 4 K=1,KD
+      GTEMP(K)=PD(K+1)**0.2*(1.+PD(K+1)/30000.)**0.8/1013250.
+4     CONTINUE
+      GTEMP(KP)=0.
+!+++  WRITE (6,100) (GTEMP(K),K=1,KD)
+!+++  WRITE (6,100) (PD(K),K=1,KP2)
+!+++  WRITE (6,100) (PLM(K),K=1,KP)
+!***TAPES 41,42 ARE OUTPUT TO THE CO2 INTERPOLATION PROGRAM (PS=1013MB)
+!  THE FOLLOWING PUTS P-DATA INTO MB
+      DO 11 I=1,KP
+      PD(I)=PD(I)*1.0E-3
+      PLM(I)=PLM(I)*1.0E-3
+11    CONTINUE
+      PD(KP2)=PD(KP2)*1.0E-3
+!CC         WRITE (41,101) (PD(K),K=1,KP2)
+!CC         WRITE (41,101) (PLM(K),K=1,KP)
+!CC         WRITE (42,101) (PLM(K),K=1,KP)
+      DO 300 K=1,KP2
+       T41(K,1) = PD(K)
+  300 CONTINUE
+      DO 301 K=1,KP
+       T41(K,2) = PLM(K)
+       T42(K) = PLM(K)
+  301 CONTINUE
+!***STORE AS PDT,SO THAT RIGHT PD IS RETURNED TO PTZ
+      DO 12 I=1,KP2
+      PDT(I)=PD(I)
+12    CONTINUE
+!***SECOND PASS: PSS=810MB,GTEMP NOT COMPUTED
+      PSS=0.8*1013250.
+      QMH(1)=0.
+      QMH(KP)=1.
+      DO 201 K=2,KD
+      QMH(K)=0.5*(Q(K-1)+Q(K))
+201   CONTINUE
+      PD(1)=0.
+      PD(KP2)=PSS
+      DO 202 K=2,KP
+      PD(K)=Q(K-1)*PSS
+202   CONTINUE
+      PLM(1)=0.
+      DO 203 K=1,KM
+      PLM(K+1)=0.5*(PD(K+1)+PD(K+2))
+203   CONTINUE
+      PLM(KP)=PSS
+!+++  WRITE (6,100) (PD(K),K=1,KP2)
+!+++  WRITE (6,100) (PLM(K),K=1,KP)
+!***TAPES 43,44 ARE OUTPUT TO THE CO2 INTERPOLATION PROGRAM(PS=810 MB)
+!  THE FOLLOWING PUTS P-DATA INTO MB
+      DO 211 I=1,KP
+      PD(I)=PD(I)*1.0E-3
+      PLM(I)=PLM(I)*1.0E-3
+211   CONTINUE
+      PD(KP2)=PD(KP2)*1.0E-3
+!CC       WRITE (43,101) (PD(K),K=1,KP2)
+!CC       WRITE (43,101) (PLM(K),K=1,KP)
+!CC       WRITE (44,101) (PLM(K),K=1,KP)
+      DO 302 K=1,KP2
+       T43(K,1) = PD(K)
+  302 CONTINUE
+      DO 303 K=1,KP
+       T43(K,2) = PLM(K)
+       T44(K) = PLM(K)
+  303 CONTINUE
+!***RESTORE PD
+      DO 212 I=1,KP2
+      PD(I)=PDT(I)
+212   CONTINUE
+100   FORMAT (1X,5E20.13)
+101   FORMAT (5E16.9)
+      RETURN
+      END SUBROUTINE SIGP
+!---------------------------------------------------------------------
+      SUBROUTINE SINTR2
+!....
+!     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+!     REAL P1,P2,PA,TRNSLO,CORE,TRANSA,PATH,UEXP,SEXP,ETA,SEXPV
+      COMMON/INPUT/P1,P2,TRNSLO,IA,JA,N
+!     COMMON/PRESS/ PA(109)
+!     COMMON/TRAN/ TRANSA(109,109)
+!     COMMON/COEFS/XA(109),CA(109),ETA(109),SEXPV(109),CORE,UEXP,SEXP
+      DO 70 L=1,109
+      IP1=L
+      IF (P2-PA(L)) 65,65,70
+   70 CONTINUE
+   65 I=IP1-1
+      IF (IP1.EQ.1) IP1=2
+      IF (I.EQ.0) I=1
+      DO 80 L=1,109
+      JP1=L
+      IF (P1-PA(L)) 75,75,80
+   80 CONTINUE
+   75 J=JP1-1
+      IF (JP1.EQ.1) JP1=2
+      IF (J.EQ.0) J=1
+      JJJ=J
+      III=I
+      J=JJJ
+      JP1=J+1
+      I=III
+      IP1=I+1
+!  DETERMINE ETAP,THE VALUE OF ETA TO USE BY LINEAR INTERPOLATION
+!    FOR PETA(=0.5*(P1+P2))
+      PETA=P2
+      DO 90 L=1,109
+      IETAP1=L
+      IF (PETA-PA(L)) 85,85,90
+90    CONTINUE
+85    IETA=IETAP1-1
+      IF (IETAP1.EQ.1) IETAP1=2
+      IF (IETA.EQ.0) IETA=1
+      ETAP=ETA(IETA)+(PETA-PA(IETA))*(ETA(IETAP1)-ETA(IETA))/ &
+       (PA(IETAP1)-PA(IETA))
+      SEXP=SEXPV(IETA)+(PETA-PA(IETA))*(SEXPV(IETAP1)- &
+       SEXPV(IETA))/ (PA(IETAP1)-PA(IETA))
+      PIPMPI=PA(IP1)-PA(I)
+      UP2P1=(PATH(P2,P1,CORE,ETAP))**UEXP
+      IF (I-J) 126,126,127
+  126 CONTINUE
+      TRIP=(CA(IP1)*DLOG(1.0D0+XA(IP1)*UP2P1))**(SEXP/UEXP)
+      TRI=(CA(I)*DLOG(1.0D0+XA(I)*UP2P1))**(SEXP/UEXP)
+      TRNSLO=1.0D0-((PA(IP1)-P2)*TRI+(P2-PA(I))*TRIP)/PIPMPI
+      GO TO 128
+  127 TIJ=TRANSA(I,J)
+      TIPJ=TRANSA(I+1,J)
+      TIJP=TRANSA(I,J+1)
+      TIPJP=TRANSA(I+1,J+1)
+      UIJ=(PATH(PA(I),PA(J),CORE,ETAP))**UEXP
+      UIPJ=(PATH(PA(I+1),PA(J),CORE,ETAP))**UEXP
+      UIJP=(PATH(PA(I),PA(J+1),CORE,ETAP))**UEXP
+      UIPJP=(PATH(PA(I+1),PA(J+1),CORE,ETAP))**UEXP
+      PRODI=CA(I)*XA(I)
+      PRODIP=CA(I+1)*XA(I+1)
+      PROD=((PA(I+1)-P2)*PRODI+(P2-PA(I))*PRODIP)/PIPMPI
+      XINT=((PA(I+1)-P2)*XA(I)+(P2-PA(I))*XA(I+1))/PIPMPI
+      CINT=PROD/XINT
+      AIJ=(CINT*DLOG(1.0D0+XINT*UIJ))**(SEXP/UEXP)
+      AIJP=(CINT*DLOG(1.0D0+XINT*UIJP))**(SEXP/UEXP)
+      AIPJ=(CINT*DLOG(1.0D0+XINT*UIPJ))**(SEXP/UEXP)
+      AIPJP=(CINT*DLOG(1.0D0+XINT*UIPJP))**(SEXP/UEXP)
+      EIJ=TIJ+AIJ
+      EIPJ=TIPJ+AIPJ
+      EIJP=TIJP+AIJP
+      EIPJP=TIPJP+AIPJP
+      DTDJ=(EIJP-EIJ)/(PA(J+1)-PA(J))
+      DTDPJ=(EIPJP-EIPJ)/(PA(J+1)-PA(J))
+      EPIP1=EIJ+DTDJ*(P1-PA(J))
+      EPIPP1=EIPJ+DTDPJ*(P1-PA(J))
+      EPP2P1=((PA(I+1)-P2)*EPIP1+(P2-PA(I))*EPIPP1)/PIPMPI
+      TRNSLO=EPP2P1-(CINT*DLOG(1.0D0+XINT*UP2P1))**(SEXP/UEXP)
+      IF (I.GE.108.OR.J.GE.108) GO TO 350
+      IF (I-J-2) 350,350,355
+355   CONTINUE
+      TIP2J=TRANSA(I+2,J)
+      TIP2JP=TRANSA(I+2,J+1)
+      TI2J2=TRANSA(I+2,J+2)
+      TIJP2=TRANSA(I,J+2)
+      TIPJP2=TRANSA(I+1,J+2)
+      UIP2J=(PATH(PA(I+2),PA(J),CORE,ETAP))**UEXP
+      UIJP2=(PATH(PA(I),PA(J+2),CORE,ETAP))**UEXP
+      UIPJP2=(PATH(PA(I+1),PA(J+2),CORE,ETAP))**UEXP
+      UI2J2=(PATH(PA(I+2),PA(J+2),CORE,ETAP))**UEXP
+      UIP2JP=(PATH(PA(I+2),PA(J+1),CORE,ETAP))**UEXP
+      AIJP2=(CINT*DLOG(1.0D0+XINT*UIJP2))**(SEXP/UEXP)
+      AIPJP2=(CINT*DLOG(1.0D0+XINT*UIPJP2))**(SEXP/UEXP)
+      AIP2J=(CINT*DLOG(1.0D0+XINT*UIP2J))**(SEXP/UEXP)
+      AIP2JP=(CINT*DLOG(1.0D0+XINT*UIP2JP))**(SEXP/UEXP)
+      AI2J2=(CINT*DLOG(1.0D0+XINT*UI2J2))**(SEXP/UEXP)
+      EIP2J=TIP2J+AIP2J
+      EIP2JP=TIP2JP+AIP2JP
+      EIJP2=TIJP2+AIJP2
+      EIPJP2=TIPJP2+AIPJP2
+      EI2J2=TI2J2+AI2J2
+      CALL QINTRP(PA(J),PA(J+1),PA(J+2),EIJ,EIJP,EIJP2,P1,EI)
+      CALL QINTRP(PA(J),PA(J+1),PA(J+2),EIPJ,EIPJP,EIPJP2,P1,EP)
+      CALL QINTRP(PA(J),PA(J+1),PA(J+2),EIP2J,EIP2JP,EI2J2,P1,EP2)
+      CALL QINTRP(PA(I),PA(I+1),PA(I+2),EI,EP,EP2,P2,EPSIL)
+      TRNSLO=EPSIL-(CINT*DLOG(1.0D0+XINT*UP2P1))**(SEXP/UEXP)
+  350 CONTINUE
+  128 CONTINUE
+  205 CONTINUE
+      RETURN
+      END SUBROUTINE SINTR2
+      SUBROUTINE CO2O3(SFULL,SHALF,PPTOP,L,LP1,LP2)
+!CCC  PROGRAM CO2O3 = CONSOLIDATION OF A NUMBER OF DAN SCHWARZKOPF,GFDL
+!                     CODES TO PRODUCE A FILE OF CO2 HGT DATA
+!                     FOR ANY VERTICAL COORDINATE (READ BY SUBROUTINE
+!                     CONRAD IN THE GFDL RADIATION CODES)-K.A.C. JUN89.
+!NOV89--UPDATED (NOV 89) FOR LATEST GFDL LW RADIATION.....K.A.C.
+      LOGICAL                 :: opened
+      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+      CHARACTER*80 errmess
+!     integer :: retval,kk,ka,kb
+!     character(50) :: co2='co2'
+      INTEGER etarad_unit61, etarad_unit62, etarad_unit63,IERROR
+      DIMENSION SGTEMP(LP1,2),CO2D1D(L,6),CO2D2D(LP1,LP1,6)
+!NOV89
+      DIMENSION CO2IQ2(LP1,LP1,6),CO2IQ3(LP1,LP1,6),CO2IQ5(LP1,LP1,6)
+!NOV89
+      DIMENSION T41(LP2,2),T42(LP1), &
+                T43(LP2,2),T44(LP1)
+      DIMENSION T20(LP1,LP1,3),T21(LP1,LP1,3)
+      DIMENSION T22(LP1,LP1,3),T23(LP1,LP1,3)
+      DIMENSION SGLVNU(LP1),SIGLNU(L)
+      DIMENSION SFULL(LP1),SHALF(L)
+!     DIMENSION STEMP(LP1),GTEMP(LP1)
+!     DIMENSION CDTM51(L),CO2M51(L),C2DM51(L)
+!     DIMENSION CDTM58(L),CO2M58(L),C2DM58(L)
+!     DIMENSION CDT51(LP1,LP1),CO251(LP1,LP1),C2D51(LP1,LP1)
+!     DIMENSION CDT58(LP1,LP1),CO258(LP1,LP1),C2D58(LP1,LP1)
+!NOV89
+!     DIMENSION CDT31(LP1),CO231(LP1),C2D31(LP1)
+!     DIMENSION CDT38(LP1),CO238(LP1),C2D38(LP1)
+!     DIMENSION CDT71(LP1),CO271(LP1),C2D71(LP1)
+!     DIMENSION CDT78(LP1),CO278(LP1),C2D78(LP1)
+!     DIMENSION CO211(LP1),CO218(LP1)
+!     EQUIVALENCE (CDT31(1),CO2IQ2(1,1,1)),(CO231(1),CO2IQ2(1,1,2))
+!     EQUIVALENCE (C2D31(1),CO2IQ2(1,1,3)),(CDT38(1),CO2IQ2(1,1,4))
+!     EQUIVALENCE (CO238(1),CO2IQ2(1,1,5)),(C2D38(1),CO2IQ2(1,1,6))
+!     EQUIVALENCE (CDT71(1),CO2IQ3(1,1,1)),(CO271(1),CO2IQ3(1,1,2))
+!     EQUIVALENCE (C2D71(1),CO2IQ3(1,1,3)),(CDT78(1),CO2IQ3(1,1,4))
+!     EQUIVALENCE (CO278(1),CO2IQ3(1,1,5)),(C2D78(1),CO2IQ3(1,1,6))
+!     EQUIVALENCE (CO211(1),CO2IQ5(1,1,2)),(CO218(1),CO2IQ5(1,1,5))
+!NOV89
+!     EQUIVALENCE (STEMP(1),SGTEMP(1,1)),(GTEMP(1),SGTEMP(1,2))
+!     EQUIVALENCE (CDTM51(1),CO2D1D(1,1)),(CO2M51(1),CO2D1D(1,2))
+!     EQUIVALENCE (C2DM51(1),CO2D1D(1,3)),(CDTM58(1),CO2D1D(1,4))
+!     EQUIVALENCE (CO2M58(1),CO2D1D(1,5)),(C2DM58(1),CO2D1D(1,6))
+!     EQUIVALENCE (CDT51(1,1),CO2D2D(1,1,1)),(CO251(1,1),CO2D2D(1,1,2))
+!     EQUIVALENCE (C2D51(1,1),CO2D2D(1,1,3)),(CDT58(1,1),CO2D2D(1,1,4))
+!     EQUIVALENCE (CO258(1,1),CO2D2D(1,1,5)),(C2D58(1,1),CO2D2D(1,1,6))
+
+!
+!    Deallocate before reading. This is required for nested domain init.
+!
+      IF(ALLOCATED (CO251))DEALLOCATE(CO251)
+      IF(ALLOCATED (CDT51))DEALLOCATE(CDT51)
+      IF(ALLOCATED (C2D51))DEALLOCATE(C2D51)
+      IF(ALLOCATED (CO258))DEALLOCATE(CO258)
+      IF(ALLOCATED (CDT58))DEALLOCATE(CDT58)
+      IF(ALLOCATED (C2D58))DEALLOCATE(C2D58)
+      IF(ALLOCATED (STEMP))DEALLOCATE(STEMP)
+      IF(ALLOCATED (GTEMP))DEALLOCATE(GTEMP)
+      IF(ALLOCATED (CO231))DEALLOCATE(CO231)
+      IF(ALLOCATED (CDT31))DEALLOCATE(CDT31)
+      IF(ALLOCATED (C2D31))DEALLOCATE(C2D31)
+      IF(ALLOCATED (CO238))DEALLOCATE(CO238)
+      IF(ALLOCATED (CDT38))DEALLOCATE(CDT38)
+      IF(ALLOCATED (C2D38))DEALLOCATE(C2D38)
+      IF(ALLOCATED (CO271))DEALLOCATE(CO271)
+      IF(ALLOCATED (CDT71))DEALLOCATE(CDT71)
+      IF(ALLOCATED (C2D71))DEALLOCATE(C2D71)
+      IF(ALLOCATED (CO278))DEALLOCATE(CO278)
+      IF(ALLOCATED (CDT78))DEALLOCATE(CDT78)
+      IF(ALLOCATED (C2D78))DEALLOCATE(C2D78)
+      IF(ALLOCATED (CO2M51))DEALLOCATE(CO2M51)
+      IF(ALLOCATED (CDTM51))DEALLOCATE(CDTM51)
+      IF(ALLOCATED (C2DM51))DEALLOCATE(C2DM51)
+      IF(ALLOCATED (CO2M58))DEALLOCATE(CO2M58)
+      IF(ALLOCATED (CDTM58))DEALLOCATE(CDTM58)
+      IF(ALLOCATED (C2DM58))DEALLOCATE(C2DM58)
+!
+      ALLOCATE(CO251(LP1,LP1))
+      ALLOCATE(CDT51(LP1,LP1))
+      ALLOCATE(C2D51(LP1,LP1))
+      ALLOCATE(CO258(LP1,LP1))
+      ALLOCATE(CDT58(LP1,LP1))
+      ALLOCATE(C2D58(LP1,LP1))
+      ALLOCATE(STEMP(LP1))
+      ALLOCATE(GTEMP(LP1))
+      ALLOCATE(CO231(LP1))
+      ALLOCATE(CDT31(LP1))
+      ALLOCATE(C2D31(LP1))
+      ALLOCATE(CO238(LP1))
+      ALLOCATE(CDT38(LP1))
+      ALLOCATE(C2D38(LP1))
+      ALLOCATE(CO271(LP1))
+      ALLOCATE(CDT71(LP1))
+      ALLOCATE(C2D71(LP1))
+      ALLOCATE(CO278(LP1))
+      ALLOCATE(CDT78(LP1))
+      ALLOCATE(C2D78(LP1))
+      ALLOCATE(CO2M51(L))
+      ALLOCATE(CDTM51(L))
+      ALLOCATE(C2DM51(L))
+      ALLOCATE(CO2M58(L))
+      ALLOCATE(CDTM58(L))
+      ALLOCATE(C2DM58(L))
+      IF ( wrf_dm_on_monitor() ) THEN
+        DO i = 61,99
+          INQUIRE ( i , OPENED = opened )
+          IF ( .NOT. opened ) THEN
+            etarad_unit61 = i
+            GOTO 2061
+          ENDIF
+        ENDDO
+        etarad_unit61 = -1
+ 2061   CONTINUE
+        DO i = 62,99
+          INQUIRE ( i , OPENED = opened )
+          IF ( .NOT. opened ) THEN
+            etarad_unit62 = i
+            GOTO 2062
+          ENDIF
+        ENDDO
+        etarad_unit62 = -1
+ 2062   CONTINUE
+        DO i = 63,99
+          INQUIRE ( i , OPENED = opened )
+          IF ( .NOT. opened ) THEN
+            etarad_unit63 = i
+            GOTO 2063
+          ENDIF
+        ENDDO
+        etarad_unit63 = -1
+ 2063   CONTINUE
+      ENDIF
+      CALL wrf_dm_bcast_bytes ( etarad_unit61 , IWORDSIZE )
+      IF ( etarad_unit61 < 0 ) THEN
+        CALL wrf_error_fatal ( 'module_ra_gfdleta: co2o3: Can not find unused fortran unit to read in lookup table.' )
+      ENDIF
+      CALL wrf_dm_bcast_bytes ( etarad_unit62 , IWORDSIZE )
+      IF ( etarad_unit62 < 0 ) THEN
+        CALL wrf_error_fatal ( 'module_ra_gfdleta: co2o3: Can not find unused fortran unit to read in lookup table.' )
+      ENDIF
+      CALL wrf_dm_bcast_bytes ( etarad_unit63 , IWORDSIZE )
+      IF ( etarad_unit63 < 0 ) THEN
+        CALL wrf_error_fatal ( 'module_ra_gfdleta: co2o3: Can not find unused fortran unit to read in lookup table.' )
+      ENDIF
+        IF ( wrf_dm_on_monitor() ) THEN
+          OPEN(etarad_unit61,FILE='tr49t85',                  &
+               FORM='FORMATTED',STATUS='OLD',ERR=9061,IOSTAT=IERROR)
+        ENDIF
+        IF ( wrf_dm_on_monitor() ) THEN
+          OPEN(etarad_unit62,FILE='tr49t67',                  &
+               FORM='FORMATTED',STATUS='OLD',ERR=9062,IOSTAT=IERROR)
+        ENDIF
+        IF ( wrf_dm_on_monitor() ) THEN
+          OPEN(etarad_unit63,FILE='tr67t85',                  &
+               FORM='FORMATTED',STATUS='OLD',ERR=9063,IOSTAT=IERROR)
+        ENDIF
+
+!===>  GET SGTEMP AND OUTPUT WHICH USED TO BE ON UNITS 41,42,43,44....
+      LREAD = 0
+!     DO KKK=1,L
+!JD      READ(23)SIGLNU(KKK)
+!      SIGLNU(KKK)=1.-FLOAT(KKK)/LP1
+!     END DO
+      CALL CO2PTZ(SGTEMP,T41,T42,T43,T44,SGLVNU,SIGLNU, &
+                  SFULL,SHALF,PPTOP,LREAD,L,LP1,LP2)
+!       call int_get_fresh_handle(retval)
+!       close(retval)
+!       open(unit=retval,file=co2,form='UNFORMATTED',iostat=ier)
+!       do kk=1,2
+!         write(retval)(sgtemp(k,kk),k=1,61)
+!       enddo
+      DO K=1,LP1
+        STEMP(K)=SGTEMP(K,1)
+        GTEMP(K)=SGTEMP(K,2)
+      ENDDO
+!===>  INTERPOLATE DESIRED CO2 DATA FROM THE DETAILED(109,109) GRID..
+!         IR=1,IQ=1 IS FOR COMMON /CO2BD3/ IN RADIATION CODE...
+!           FOR THE CONSOLIDATED 490-850 CM-1 BAND...
+!NOV89
+!     ICO2TP=61
+      ICO2TP=etarad_unit61
+!NOV89
+      IR = 1
+      RATIO = 1.0
+      NMETHD = 2
+      CALL CO2INT(ICO2TP,T41,T42,T22,RATIO,IR,NMETHD,L,LP1,LP2)
+      IR = 1
+      RATIO = 1.0
+      NMETHD = 1
+      CALL CO2INT(ICO2TP,T41,T42,T20,RATIO,IR,NMETHD,L,LP1,LP2)
+      IR = 1
+      RATIO = 1.0
+      NMETHD = 2
+      CALL CO2INT(ICO2TP,T43,T44,T23,RATIO,IR,NMETHD,L,LP1,LP2)
+      IR = 1
+      RATIO = 1.0
+      NMETHD = 1
+      CALL CO2INT(ICO2TP,T43,T44,T21,RATIO,IR,NMETHD,L,LP1,LP2)
+!===>    FILL UP THE CO2D1D ARRAY
+!       THE FOLLOWING GETS CO2 TRANSMISSION FUNCTIONS AND
+!         THEIR DERIVATIVES FOR TAU(I,I+1),I=1,LEVS,
+!         WHERE THE VALUES ARE NOT OBTAINED BY QUADRATURE BUT ARE THE
+!         ACTUAL TRANSMISSIVITIES,ETC,BETWEEN A PAIR OF PRESSURES. THESE
+!         ARE USED ONLY FOR NEARBY LAYER CALCULATIONS INCLUDING H2O..
+!
+      IQ = 1
+      CALL CO2IN1(T20,T21,CO2D1D,IQ,L,LP1)
+!       do kk=1,6
+!         write(retval)(co2d1d(k,kk),k=1,60)
+!       enddo
+      DO K=1,L
+        CDTM51(K)=CO2D1D(K,1)
+        CO2M51(K)=CO2D1D(K,2)
+        C2DM51(K)=CO2D1D(K,3)
+        CDTM58(K)=CO2D1D(K,4)
+        CO2M58(K)=CO2D1D(K,5)
+        C2DM58(K)=CO2D1D(K,6)
+      ENDDO
+!
+!===>    FILL UP THE CO2D2D ARRAY
+!    THE FOLLOWING GETS CO2 TRANSMISSION FUNCTIONS AND THEIR DERIVATIVES
+!        FROM 109-LEVEL LINE-BY-LINE CALCULATIONS MADE USING THE 1982
+!        MCCLATCHY TAPE (12511 LINES),CONSOLIDATED,INTERPOLATED
+!        TO THE MRF VERTICAL COORDINATE,AND RE-CONSOLIDATED TO A
+!        200 CM-1 BANDWIDTH. THE INTERPOLATION METHOD IS DESCRIBED IN
+!        SCHWARZKOPF AND FELS (J.G.R.,1985).
+!
+      CALL CO2INS(T22,T23,CO2D2D,IQ,L,LP1,1)
+!       do kk=1,6
+!         write(retval)((co2d2d(ka,kb,kk),ka=1,61),kb=1,61)
+!       enddo
+      DO K1=1,LP1
+      DO K2=1,LP1
+        CDT51(K1,K2)=CO2D2D(K1,K2,1)
+        CO251(K1,K2)=CO2D2D(K1,K2,2)
+        C2D51(K1,K2)=CO2D2D(K1,K2,3)
+        CDT58(K1,K2)=CO2D2D(K1,K2,4)
+        CO258(K1,K2)=CO2D2D(K1,K2,5)
+        C2D58(K1,K2)=CO2D2D(K1,K2,6)
+      ENDDO
+      ENDDO
+!
+!NOV89
+!===>  INTERPOLATE DESIRED CO2 DATA FROM THE DETAILED(109,109) GRID..
+!         IR=2,IQ=2 IS FOR COMMON /CO2BD2/ IN RADIATION CODE...
+!           FOR THE CONSOLIDATED 490-670 CM-1 BAND...
+!     ICO2TP=62
+      ICO2TP=etarad_unit62
+      IR = 2
+      RATIO = 1.0
+      NMETHD = 2
+      CALL CO2INT(ICO2TP,T41,T42,T22,RATIO,IR,NMETHD,L,LP1,LP2)
+      CALL CO2INT(ICO2TP,T43,T44,T23,RATIO,IR,NMETHD,L,LP1,LP2)
+      IQ = 2
+      CALL CO2INS(T22,T23,CO2IQ2,IQ,L,LP1,2)
+!       do kk=1,6
+!         write(retval)(co2iq2(k,1,kk),k=1,61)
+!       enddo
+      DO K=1,LP1
+        CDT31(K)=CO2IQ2(K,1,1)
+        CO231(K)=CO2IQ2(K,1,2)
+        C2D31(K)=CO2IQ2(K,1,3)
+        CDT38(K)=CO2IQ2(K,1,4)
+        CO238(K)=CO2IQ2(K,1,5)
+        C2D38(K)=CO2IQ2(K,1,6)
+      ENDDO
+!===>  INTERPOLATE DESIRED CO2 DATA FROM THE DETAILED(109,109) GRID..
+!         IR=3,IQ=3 IS FOR COMMON /CO2BD4/ IN RADIATION CODE...
+!           FOR THE CONSOLIDATED 670-850 CM-1 BAND...
+!     ICO2TP=63
+      ICO2TP=etarad_unit63
+      IR = 3
+      RATIO = 1.0
+      NMETHD = 2
+      CALL CO2INT(ICO2TP,T41,T42,T22,RATIO,IR,NMETHD,L,LP1,LP2)
+      CALL CO2INT(ICO2TP,T43,T44,T23,RATIO,IR,NMETHD,L,LP1,LP2)
+      IQ = 3
+      CALL CO2INS(T22,T23,CO2IQ3,IQ,L,LP1,3)
+!       do kk=1,6
+!         write(retval)(co2iq3(k,1,kk),k=1,61)
+!       enddo
+!       close(retval)
+      DO K=1,LP1
+        CDT71(K)=CO2IQ3(K,1,1)
+        CO271(K)=CO2IQ3(K,1,2)
+        C2D71(K)=CO2IQ3(K,1,3)
+        CDT78(K)=CO2IQ3(K,1,4)
+        CO278(K)=CO2IQ3(K,1,5)
+        C2D78(K)=CO2IQ3(K,1,6)
+      ENDDO
+!---      FOLLOWING CODE NOT WORKING AND NOT NEEDED YET
+!===>  INTERPOLATE DESIRED CO2 DATA FROM THE DETAILED(109,109) GRID..
+!         IR=4,IQ=5 IS FOR COMMON /CO2BD5/ IN RADIATION CODE...
+!           FOR THE 4.3 MICRON BAND...
+! NOT USED YET      ICO2TP=65
+! NOT USED YET      IR = 4
+! NOT USED YET      RATIO = 1.0
+! DAN SCHWARZ --- USE 300PPMV  RATIO = 0.9091   (NOT TESTED YET).....
+! NOT USED YET      NMETHD = 2
+! NOT USED YET      CALL CO2INT(ICO2TP,T41,T42,T22,RATIO,IR,NMETHD)
+! NOT USED YET      CALL CO2INT(ICO2TP,T43,T44,T23,RATIO,IR,NMETHD)
+! NOT USED YET      IQ = 5
+! NOT USED YET      CALL CO2INS(T22,T23,CO2IQ5,IQ)
+!NOV89
+!...     WRITE DATA TO DISK..
+!            ...SINCE THESE CODES ARE COMPILED WITH AUTODBL,THE CO2 DATA
+!               IS CONVERTED TO SINGLE PRECISION IN A LATER JOB STEP..
+
+! NOT USED YET      WRITE(66) CO211
+! NOT USED YET      WRITE(66) CO218
+!NOV89
+         IF ( wrf_dm_on_monitor() ) THEN
+           CLOSE (etarad_unit61)
+           CLOSE (etarad_unit62)
+           CLOSE (etarad_unit63)
+         ENDIF
+
+      RETURN
+9061 CONTINUE
+     WRITE( errmess , '(A49,I4)' ) 'module_ra_gfdleta: error reading tr49t85 on unit ',etarad_unit61
+     write(0,*)' IERROR=',IERROR
+     CALL wrf_error_fatal(errmess)
+9062 CONTINUE
+     WRITE( errmess , '(A49,I4)' ) 'module_ra_gfdleta: error reading tr49t67 on unit ',etarad_unit62
+     write(0,*)' IERROR=',IERROR
+     CALL wrf_error_fatal(errmess)
+9063 CONTINUE
+     WRITE( errmess , '(A49,I4)' ) 'module_ra_gfdleta: error reading tr67t85 on unit ',etarad_unit63
+     write(0,*)' IERROR=',IERROR
+     CALL wrf_error_fatal(errmess)
+      END SUBROUTINE CO2O3
+
+
+!!================================================================================
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+      SUBROUTINE CONRAD(KDS,KDE,KMS,KME,KTS,KTE)
+!----------------------------------------------------------------------
+!    *******************************************************************
+!    *                           C O N R A D                           *
+!    *    READ CO2 TRANSMISSION DATA FROM UNIT(NFILE)FOR NEW VERTICAL  *
+!    *      COORDINATE TESTS      ...                                  *
+!    *    THESE ARRAYS USED TO BE IN BLOCK DATA    ...K.CAMPANA-MAR 90 *
+!    *******************************************************************
+!
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: KDS,KDE,KMS,KME,KTS,KTE
+!----------------------------------------------------------------------
+!
+      INTEGER :: I,I1,I2,IERROR,IRTN,J,K,KK,L,LP1,N,NUNIT_CO2,RSIZE
+      INTEGER,DIMENSION(3) :: RSZE
+!
+      REAL,DIMENSION(KMS:KME-1,6) :: CO21D
+      REAL,DIMENSION(KMS:KME,2) :: SGTMP
+      REAL,DIMENSION(KMS:KME,6) :: CO21D3,CO21D7
+      REAL,DIMENSION(KMS:KME,KMS:KME,6) :: CO22D
+      REAL,DIMENSION((KME-KMS+1)*(KME-KMS+1)) :: DATA2
+      LOGICAL :: OPENED
+      LOGICAL,EXTERNAL :: wrf_dm_on_monitor
+      CHARACTER*80 errmess
+!
+!----------------------------------------------------------------------
+!
+!                 CO2 DATA TABLES FOR USER'S VERTICAL COORDINATE
+!
+!   THE FOLLOWING COMMON BLOCKS CONTAIN PRETABULATED CO2 TRANSMISSION
+!       FUNCTIONS, EVALUATED USING THE METHODS OF FELS AND
+!       SCHWARZKOPF (1981) AND SCHWARZKOPF AND FELS (1985),
+!-----  THE 2-DIMENSIONAL ARRAYS ARE
+!                    CO2 TRANSMISSION FUNCTIONS AND THEIR DERIVATIVES
+!        FROM 109-LEVEL LINE-BY-LINE CALCULATIONS MADE USING THE 1982
+!        MCCLATCHY TAPE (12511 LINES),CONSOLIDATED,INTERPOLATED
+!        TO THE NMC MRF VERTICAL COORDINATTE,AND RE-CONSOLIDATED TO A
+!        200 CM-1 BANDWIDTH. THE INTERPOLATION METHOD IS DESCRIBED IN
+!        SCHWARZKOPF AND FELS (J.G.R.,1985).
+!-----  THE 1-DIM ARRAYS ARE
+!                  CO2 TRANSMISSION FUNCTIONS AND THEIR DERIVATIVES
+!          FOR TAU(I,I+1),I=1,L,
+!            WHERE THE VALUES ARE NOT OBTAINED BY QUADRATURE,BUT ARE THE
+!            ACTUAL TRANSMISSIVITIES,ETC,BETWEEN A PAIR OF PRESSURES.
+!          THESE USED ONLY FOR NEARBY LAYER CALCULATIONS INCLUDING QH2O.
+!-----  THE WEIGHTING FUNCTION GTEMP=P(K)**0.2*(1.+P(K)/30000.)**0.8/
+!         1013250.,WHERE P(K)=PRESSURE,NMC MRF(NEW)  L18 DATA LEVELS FOR
+!         PSTAR=1013250.
+!-----  STEMP IS US STANDARD ATMOSPHERES,1976,AT DATA PRESSURE LEVELS
+!        USING NMC MRF SIGMAS,WHERE PSTAR=1013.25 MB (PTZ PROGRAM)
+!
+!***CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE
+!   AND PRESSURE DERIVATIVES FOR THE 560-800 CM-1 BAND. ALSO INCLUDED
+!   ARE THE STANDARD TEMPERATURES AND THE WEIGHTING FUNCTION. THESE
+!   DATA ARE IN BLOCK DATA BD3:
+!         CO251    =  TRANSMISSION FCTNS FOR T0 (STD. PROFILE)
+!                       WITH P(SFC)=1013.25 MB
+!         CO258    =  TRANSMISSION FCTNS. FOR T0 (STD. PROFILE)
+!                       WITH P(SFC)= 810 MB
+!         CDT51    =  FIRST TEMPERATURE DERIVATIVE OF CO251
+!         CDT58    =  FIRST TEMPERATURE DERIVATIVE OF CO258
+!         C2D51    =  SECOND TEMPERATURE DERIVATIVE OF CO251
+!         C2D58    =  SECOND TEMPERATURE DERIVATIVE OF CO251
+!         CO2M51   =  TRANSMISSION FCTNS FOR T0 FOR ADJACENT PRESSURE
+!                        LEVELS, WITH NO PRESSURE QUADRATURE. USED FOR
+!                        NEARBY LAYER COMPUTATIONS. P(SFC)=1013.25 MB
+!         CO2M58   =  SAME AS CO2M51,WITH P(SFC)= 810 MB
+!         CDTM51   =  FIRST TEMPERATURE DERIVATIVE OF CO2M51
+!         CDTM58   =  FIRST TEMPERATURE DERIVATIVE OF CO2M58
+!         C2DM51   =  SECOND TEMPERATURE DERIVATIVE OF CO2M51
+!         C2DM58   =  SECOND TEMPERATURE DERIVATIVE OF CO2M58
+!         STEMP    =  STANDARD TEMPERATURES FOR MODEL PRESSURE LEVEL
+!                        STRUCTURE WITH P(SFC)=1013.25 MB
+!         GTEMP    =  WEIGHTING FUNCTION FOR MODEL PRESSURE LEVEL
+!                        STRUCTURE WITH P(SFC)=1013.25 MB.
+!-----       THE FOLLOWING ARE STILL IN BLOCK DATA
+!         B0       =  TEMP. COEFFICIENT USED FOR CO2 TRANS. FCTN.
+!                        CORRECTION FOR T(K). (SEE REF. 4 AND BD3)
+!         B1       =  TEMP. COEFFICIENT, USED ALONG WITH B0
+!         B2       =  TEMP. COEFFICIENT, USED ALONG WITH B0
+!         B3       =  TEMP. COEFFICIENT, USED ALONG WITH B0
+!
+!***CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE
+!   AND PRESSURE DERIVATIVES FOR THE 560-670 CM-1 PART OF THE 15 UM
+!   CO2 BAND.  THESE DATA ARE IN BLOCK DATA BD2.
+!     FOR THE 560-670 CM-1 BAND,ONLY THE (1,I) VALUES ARE USED , SINCE
+!     THESE ARE USED FOR CTS COMPUTATIONS.
+!         CO231    =  TRANSMISSION FCTNS FOR T0 (STD. PROFILE)
+!                       WITH P(SFC)=1013.25 MB
+!         CO238    =  TRANSMISSION FCTNS. FOR T0 (STD. PROFILE)
+!                       WITH P(SFC)= 810 MB
+!         CDT31    =  FIRST TEMPERATURE DERIVATIVE OF CO231
+!         CDT38    =  FIRST TEMPERATURE DERIVATIVE OF CO238
+!         C2D31    =  SECOND TEMPERATURE DERIVATIVE OF CO231
+!         C2D38    =  SECOND TEMPERATURE DERIVATIVE OF CO231
+!
+!***CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE
+!   AND PRESSURE DERIVATIVES FOR THE 670-800 CM-1 PART OF THE 15 UM
+!   CO2 BAND.  THESE DATA ARE IN BLOCK DATA BD4.
+!         CO271    =  TRANSMISSION FCTNS FOR T0 (STD. PROFILE)
+!                       WITH P(SFC)=1013.25 MB
+!         CO278    =  TRANSMISSION FCTNS. FOR T0 (STD. PROFILE)
+!                       WITH P(SFC)= 810 MB
+!         CDT71    =  FIRST TEMPERATURE DERIVATIVE OF CO271
+!         CDT78    =  FIRST TEMPERATURE DERIVATIVE OF CO278
+!         C2D71    =  SECOND TEMPERATURE DERIVATIVE OF CO271
+!         C2D78    =  SECOND TEMPERATURE DERIVATIVE OF CO271
+!
+! *****THE FOLLOWING NOT USED IN CURRENT VERSION OF RADIATION *******
+!
+! --CO2 TRANSMISSION FUNCTIONS FOR THE 2270-
+!       2380 PART OF THE 4.3 UM CO2 BAND.
+!              THESE DATA ARE IN BLOCK DATA BD5.
+!         CO211    =  TRANSMISSION FCTNS FOR T0 (STD. PROFILE)
+!                        WITH P(SFC)=1013.25 MB
+!         CO218    =  TRANSMISSION FCTNS. FOR T0 (STD. PROFILE)
+!                       WITH P(SFC)= 810 MB
+!
+! *****THE ABOVE NOT USED IN CURRENT VERSION OF RADIATION ***********
+!----------------------------------------------------------------------
+!
+      L=KME-KMS
+      LP1=KME-KMS+1
+!
+!----------------------------------------------------------------------
+      IF ( wrf_dm_on_monitor() ) THEN
+        DO i = 14,99
+      write(0,*)' in CONRAD i=',i,' opened=',opened
+          INQUIRE ( i , OPENED = opened )
+          IF ( .NOT. opened ) THEN
+            nunit_co2 = i
+            GOTO 2014
+          ENDIF
+        ENDDO
+        nunit_co2 = -1
+ 2014   CONTINUE
+      ENDIF
+        IF ( wrf_dm_on_monitor() ) THEN
+          OPEN(nunit_co2,FILE='co2_trans',                  &
+               FORM='UNFORMATTED',STATUS='OLD',ERR=9014,IOSTAT=IERROR)
+        ENDIF
+
+      REWIND NUNIT_CO2
+!----------------------------------------------------------------------
+!
+!***  READ IN PRE-COMPUTED CO2 TRANSMISSION DATA.
+!
+      RSZE(1) = LP1
+      RSZE(2) = L
+      RSZE(3) = LP1*LP1
+!----------------------------------------------------------------------
+!
+      RSIZE = RSZE(1)
+!
+      DO KK=1,2
+        IF( wrf_dm_on_monitor() )READ(NUNIT_CO2)(SGTMP(I,KK),I=1,RSIZE)
+        CALL wrf_dm_bcast_real( SGTMP(1,KK), RSIZE )
+      ENDDO
+!
+!----------------------------------------------------------------------
+!
+      RSIZE = RSZE(2)
+!
+      DO KK=1,6
+        IF( wrf_dm_on_monitor() )READ(NUNIT_CO2)(CO21D(I,KK),I=1,RSIZE)
+        CALL wrf_dm_bcast_real( CO21D(1,KK), RSIZE )
+      ENDDO
+!
+!----------------------------------------------------------------------
+!
+      RSIZE = RSZE(3)
+!
+      DO KK=1,6
+        IF( wrf_dm_on_monitor() )READ(NUNIT_CO2)(DATA2(I),I=1,RSIZE)
+        CALL wrf_dm_bcast_real( DATA2(1), RSIZE )
+        N=0
+!
+        DO I1=1,LP1
+        DO I2=1,LP1
+          N=N+1
+          CO22D(I1,I2,KK)=DATA2(N)
+        ENDDO
+        ENDDO
+!
+      ENDDO
+
+!
+!    Deallocate before reading. This is required for nested domain init.
+!
+      IF(ALLOCATED (CO251))DEALLOCATE(CO251)
+      IF(ALLOCATED (CDT51))DEALLOCATE(CDT51)
+      IF(ALLOCATED (C2D51))DEALLOCATE(C2D51)
+      IF(ALLOCATED (CO258))DEALLOCATE(CO258)
+      IF(ALLOCATED (CDT58))DEALLOCATE(CDT58)
+      IF(ALLOCATED (C2D58))DEALLOCATE(C2D58)
+      IF(ALLOCATED (STEMP))DEALLOCATE(STEMP)
+      IF(ALLOCATED (GTEMP))DEALLOCATE(GTEMP)
+      IF(ALLOCATED (CO231))DEALLOCATE(CO231)
+      IF(ALLOCATED (CDT31))DEALLOCATE(CDT31)
+      IF(ALLOCATED (C2D31))DEALLOCATE(C2D31)
+      IF(ALLOCATED (CO238))DEALLOCATE(CO238)
+      IF(ALLOCATED (CDT38))DEALLOCATE(CDT38)
+      IF(ALLOCATED (C2D38))DEALLOCATE(C2D38)
+      IF(ALLOCATED (CO271))DEALLOCATE(CO271)
+      IF(ALLOCATED (CDT71))DEALLOCATE(CDT71)
+      IF(ALLOCATED (C2D71))DEALLOCATE(C2D71)
+      IF(ALLOCATED (CO278))DEALLOCATE(CO278)
+      IF(ALLOCATED (CDT78))DEALLOCATE(CDT78)
+      IF(ALLOCATED (C2D78))DEALLOCATE(C2D78)
+      IF(ALLOCATED (CO2M51))DEALLOCATE(CO2M51)
+      IF(ALLOCATED (CDTM51))DEALLOCATE(CDTM51)
+      IF(ALLOCATED (C2DM51))DEALLOCATE(C2DM51)
+      IF(ALLOCATED (CO2M58))DEALLOCATE(CO2M58)
+      IF(ALLOCATED (CDTM58))DEALLOCATE(CDTM58)
+      IF(ALLOCATED (C2DM58))DEALLOCATE(C2DM58)
+!
+!----------------------------------------------------------------------
+!
+      RSIZE = RSZE(1)
+!
+      DO KK=1,6
+        IF( wrf_dm_on_monitor() )READ(NUNIT_CO2)(CO21D3(I,KK),I=1,RSIZE)
+        CALL wrf_dm_bcast_real( CO21D3(1,KK), RSIZE )
+      ENDDO
+!
+!----------------------------------------------------------------------
+!
+      DO KK=1,6
+        IF( wrf_dm_on_monitor() )READ(NUNIT_CO2)(CO21D7(I,KK),I=1,RSIZE)
+        CALL wrf_dm_bcast_real ( CO21D7(1,KK), RSIZE )
+      ENDDO
+!
+!----------------------------------------------------------------------
+      ALLOCATE(CO251(LP1,LP1))
+      ALLOCATE(CDT51(LP1,LP1))
+      ALLOCATE(C2D51(LP1,LP1))
+      ALLOCATE(CO258(LP1,LP1))
+      ALLOCATE(CDT58(LP1,LP1))
+      ALLOCATE(C2D58(LP1,LP1))
+      ALLOCATE(STEMP(LP1))
+      ALLOCATE(GTEMP(LP1))
+      ALLOCATE(CO231(LP1))
+      ALLOCATE(CDT31(LP1))
+      ALLOCATE(C2D31(LP1))
+      ALLOCATE(CO238(LP1))
+      ALLOCATE(CDT38(LP1))
+      ALLOCATE(C2D38(LP1))
+      ALLOCATE(CO271(LP1))
+      ALLOCATE(CDT71(LP1))
+      ALLOCATE(C2D71(LP1))
+      ALLOCATE(CO278(LP1))
+      ALLOCATE(CDT78(LP1))
+      ALLOCATE(C2D78(LP1))
+      ALLOCATE(CO2M51(L))
+      ALLOCATE(CDTM51(L))
+      ALLOCATE(C2DM51(L))
+      ALLOCATE(CO2M58(L))
+      ALLOCATE(CDTM58(L))
+      ALLOCATE(C2DM58(L))
+!----------------------------------------------------------------------
+!
+      DO K=1,LP1
+        STEMP(K) = SGTMP(K,1)
+        GTEMP(K) = SGTMP(K,2)
+      ENDDO
+!
+      DO K=1,L
+        CDTM51(K) = CO21D(K,1)
+        CO2M51(K) = CO21D(K,2)
+        C2DM51(K) = CO21D(K,3)
+        CDTM58(K) = CO21D(K,4)
+        CO2M58(K) = CO21D(K,5)
+        C2DM58(K) = CO21D(K,6)
+      ENDDO
+!
+      DO J=1,LP1
+      DO I=1,LP1
+        CDT51(I,J) = CO22D(I,J,1)
+        CO251(I,J) = CO22D(I,J,2)
+        C2D51(I,J) = CO22D(I,J,3)
+        CDT58(I,J) = CO22D(I,J,4)
+        CO258(I,J) = CO22D(I,J,5)
+        C2D58(I,J) = CO22D(I,J,6)
+      ENDDO
+      ENDDO
+!
+      DO K=1,LP1
+        CDT31(K) = CO21D3(K,1)
+        CO231(K) = CO21D3(K,2)
+        C2D31(K) = CO21D3(K,3)
+        CDT38(K) = CO21D3(K,4)
+        CO238(K) = CO21D3(K,5)
+        C2D38(K) = CO21D3(K,6)
+      ENDDO
+!
+      DO K=1,LP1
+        CDT71(K) = CO21D7(K,1)
+        CO271(K) = CO21D7(K,2)
+        C2D71(K) = CO21D7(K,3)
+        CDT78(K) = CO21D7(K,4)
+        CO278(K) = CO21D7(K,5)
+        C2D78(K) = CO21D7(K,6)
+      ENDDO
+!
+!----------------------------------------------------------------------
+      IF(wrf_dm_on_monitor())WRITE(0,66)NUNIT_CO2
+   66 FORMAT('----READ CO2 TRANSMISSION FUNCTIONS FROM UNIT ',I2)
+!----------------------------------------------------------------------
+      IF( wrf_dm_on_monitor() )THEN
+        CLOSE(nunit_co2)
+      ENDIF
+      RETURN
+!
+9014 CONTINUE
+     WRITE(errmess,'(A51,I4)')'module_ra_gfdleta: error reading co2_trans on unit ',nunit_co2
+     CALL wrf_error_fatal(errmess)
+!----------------------------------------------------------------------
+      END SUBROUTINE CONRAD
+!+---+-----------------------------------------------------------------+
+! Replacement routine to compute saturation vapor pressure over
+! water/ice.  This is needed here in case we run microphysics other
+! than ETAMPNEW (Ferrier) because it initializes a lookup table to
+! facilitate calculations of FVPS.  For speed, we use the polynomial
+! expansion of Flatau & Walko, 1989.
+!+---+-----------------------------------------------------------------+
+      REAL FUNCTION FPVS_new(T)
+
+      IMPLICIT NONE
+      REAL, INTENT(IN):: T
+
+      if (T .ge. 273.16) then
+         FPVS_new = e_sub_l(T)
+      else
+         FPVS_new = e_sub_i(T)
+      endif
+
+      END FUNCTION FPVS_new
+!
+!+---+-----------------------------------------------------------------+
+! THIS FUNCTION CALCULATES THE LIQUID SATURATION PRESSURE AS
+! A FUNCTION OF TEMPERATURE.
+!
+      REAL FUNCTION e_sub_l(T)
+
+      IMPLICIT NONE
+      REAL, INTENT(IN):: T
+      REAL:: ESL,X
+      REAL, PARAMETER:: C0= .611583699E03
+      REAL, PARAMETER:: C1= .444606896E02
+      REAL, PARAMETER:: C2= .143177157E01
+      REAL, PARAMETER:: C3= .264224321E-1
+      REAL, PARAMETER:: C4= .299291081E-3
+      REAL, PARAMETER:: C5= .203154182E-5
+      REAL, PARAMETER:: C6= .702620698E-8
+      REAL, PARAMETER:: C7= .379534310E-11
+      REAL, PARAMETER:: C8=-.321582393E-13
+
+      X=AMAX1(-80.,T-273.16)
+
+      ESL=C0+X*(C1+X*(C2+X*(C3+X*(C4+X*(C5+X*(C6+X*(C7+X*C8)))))))
+
+      e_sub_l = ESL
+
+      END FUNCTION e_sub_l
+!
+!+---+-----------------------------------------------------------------+
+! THIS FUNCTION CALCULATES THE ICE SATURATION VAPOR PRESSURE AS A
+! FUNCTION OF TEMPERATURE.
+!
+      REAL FUNCTION e_sub_i(T)
+
+      IMPLICIT NONE
+      REAL, INTENT(IN):: T
+      REAL:: ESI,X
+      REAL, PARAMETER:: C0= .609868993E03
+      REAL, PARAMETER:: C1= .499320233E02
+      REAL, PARAMETER:: C2= .184672631E01
+      REAL, PARAMETER:: C3= .402737184E-1
+      REAL, PARAMETER:: C4= .565392987E-3
+      REAL, PARAMETER:: C5= .521693933E-5
+      REAL, PARAMETER:: C6= .307839583E-7
+      REAL, PARAMETER:: C7= .105785160E-9
+      REAL, PARAMETER:: C8= .161444444E-12
+
+      X=AMAX1(-80.,T-273.16)
+      ESI=C0+X*(C1+X*(C2+X*(C3+X*(C4+X*(C5+X*(C6+X*(C7+X*C8)))))))
+
+      e_sub_i = ESI
+
+      END FUNCTION e_sub_i
+
+!
+
+!----------------------------------------------------------------------
+!
+      END MODULE module_RA_GFDLETA
+!
+!----------------------------------------------------------------------
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_ra_gsfcsw.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_ra_gsfcsw.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_ra_gsfcsw.F	(revision 2744)
@@ -0,0 +1,3108 @@
+!Comment the following out to turn off aerosol-radiation
+!feedback between MOSAIC and GSFCSW. wig, 21-Feb-2005
+#ifdef WRF_CHEM
+#define AER_RA_FEEDBACK   
+#endif
+
+MODULE module_ra_gsfcsw
+
+   REAL,    PARAMETER, PRIVATE ::   thresh=1.e-9
+   REAL,    SAVE               ::   center_lat
+
+!  Assign co2 and trace gases amount (units are parts/part by volumn)
+
+   REAL,    PARAMETER, PRIVATE ::   co2   = 300.e-6
+
+CONTAINS
+
+!------------------------------------------------------------------
+! urban related variable are added to arguments of gsfcswrad
+!------------------------------------------------------------------
+   SUBROUTINE GSFCSWRAD(rthraten,gsw,xlat,xlong                   &
+                   ,dz8w,rho_phy                                  &
+                   ,alb,t3d,qv3d,qc3d,qr3d                        &
+                   ,qi3d,qs3d,qg3d                                &
+                   ,p3d,p8w3d,pi3d,cldfra3d                       &
+                   ,gmt,cp,g,julday,xtime,declin,solcon           &
+                   ,radfrq,degrad,taucldi,taucldc,warm_rain       &
+                   ,tauaer300,tauaer400,tauaer600,tauaer999       & ! jcb
+                   ,gaer300,gaer400,gaer600,gaer999               & ! jcb
+                   ,waer300,waer400,waer600,waer999               & ! jcb
+                   ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg                 &
+                   ,ids,ide, jds,jde, kds,kde                     & 
+                   ,ims,ime, jms,jme, kms,kme                     &
+                   ,its,ite, jts,jte, kts,kte                     & 
+                   ,cosz_urb2d,omg_urb2d                          ) !Optional urban
+!------------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------------
+   INTEGER,    PARAMETER     ::        np    = 75
+
+   INTEGER,    INTENT(IN   ) ::        ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte
+   LOGICAL,    INTENT(IN   ) ::        warm_rain
+
+   INTEGER,    INTENT(IN  )  ::                           JULDAY  
+
+
+   REAL, INTENT(IN    )      ::        RADFRQ,DEGRAD,             &
+                                       XTIME,DECLIN,SOLCON
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(IN    ) ::                                   P3D, &
+                                                           P8W3D, &
+                                                            pi3D, &
+                                                             T3D, &
+                                                            dz8w, &
+                                                         rho_phy, &
+                                                        CLDFRA3D
+
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(INOUT)  ::                              RTHRATEN
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(INOUT)  ::                               taucldi, &
+                                                         taucldc
+!
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(IN   )  ::                                  XLAT, &
+                                                           XLONG, &
+                                                             ALB
+!
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(INOUT)  ::                                   GSW
+!
+   REAL, INTENT(IN   )  ::                              GMT,CP,G
+!
+
+!
+! Optional
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL ,       &
+         INTENT(IN    ) :: tauaer300,tauaer400,tauaer600,tauaer999, & ! jcb
+                                 gaer300,gaer400,gaer600,gaer999, & ! jcb
+                                 waer300,waer400,waer600,waer999    ! jcb
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         OPTIONAL,                                                &           
+         INTENT(IN    ) ::                                        &
+                                                            QV3D, &
+                                                            QC3D, &
+                                                            QR3D, &
+                                                            QI3D, &
+                                                            QS3D, &
+                                                            QG3D
+
+   LOGICAL, OPTIONAL, INTENT(IN )      ::        F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
+
+! LOCAL VARS
+ 
+   REAL, DIMENSION( its:ite ) ::                                  &
+                                                              ts, &
+                                                            cosz, &
+                                                          rsuvbm, &
+                                                          rsuvdf, &
+                                                          rsirbm, &
+                                                          rsirdf, &
+                                                            p400, &
+                                                            p700
+
+   INTEGER, DIMENSION( its:ite ) ::                               &
+                                                             ict, &
+                                                             icb   
+
+   REAL, DIMENSION( its:ite, kts-1:kte, 2 ) ::            taucld
+
+   REAL, DIMENSION( its:ite, kts-1:kte+1 )  ::               flx, &
+                                                            flxd
+!
+   REAL, DIMENSION( its:ite, kts-1:kte ) ::                     O3
+!
+   REAL, DIMENSION( its:ite, kts-1:kte, 11 ) ::                   &
+                                                           taual, &
+                                                           ssaal, &
+                                                           asyal
+
+   REAL, DIMENSION( its:ite, kts-1:kte, 2 ) ::                    &
+                                                            reff, &    
+                                                             cwc    
+   REAL, DIMENSION( its: ite, kts-1:kte+1 ) ::                    &
+                                                           P8W2D
+   REAL, DIMENSION( its: ite, kts-1:kte ) ::                      &
+                                                          TTEN2D, &
+                                                            SH2D, &
+                                                             P2D, &
+                                                             T2D, &
+                                                          fcld2D
+   real, DIMENSION( its:ite , kts:kte+1 ) :: phyd
+   real, DIMENSION( its:ite , kts:kte   ) :: phydmid
+
+   REAL, DIMENSION( np, 5 ) ::                              pres, &
+                                                           ozone
+   REAL, DIMENSION( np )    ::                                 p
+
+   LOGICAL :: cldwater,overcast, predicate
+!
+   INTEGER :: i,j,K,NK,ib,kk,mix,mkx
+
+!  iprof = 1  :  mid-latitude summer profile
+!        = 2  :  mid-latitude winter profile
+!        = 3  :  sub-arctic   summer profile
+!        = 4  :  sub-arctic   winter profile
+!        = 5  :  tropical profile
+!
+
+   INTEGER  ::                                             iprof, &
+                                                       is_summer, &
+                                                       ie_summer, &
+                                                          lattmp
+
+
+!
+   REAL    :: XLAT0,XLONG0
+   REAL    :: fac,latrmp
+   REAL    :: xt24,tloctm,hrang,xxlat
+
+!URBAN
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)  :: COSZ_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)  :: OMG_URB2D  !urban
+
+   real, dimension(11) :: midbands  ! jcb
+   data midbands/.2,.235,.27,.2875,.3025,.305,.3625,.55,1.92,1.745,6.135/   ! jcb
+   real :: ang,slope ! jcb
+   character(len=200) :: msg !wig
+!
+!--------------------------------------------------------------------------------
+!   data set 1
+!     mid-latitude summer (75 levels) :  p(mb)  o3(g/g)
+!     surface temp = 294.0
+!
+      data (pres(i,1),i=1,np)/ &
+          0.0006244,   0.0008759,   0.0012286,   0.0017234,   0.0024174, &
+          0.0033909,   0.0047565,   0.0066720,   0.0093589,   0.0131278, &
+          0.0184145,   0.0258302,   0.0362323,   0.0508234,   0.0712906, &
+          0.1000000,   0.1402710,   0.1967600,   0.2759970,   0.3871430, &
+          0.5430,    0.7617,    1.0685,    1.4988,    2.1024,    2.9490, &
+          4.1366,    5.8025,    8.1392,   11.4170,   16.0147,   22.4640, &
+         31.5105,   44.2001,   62.0000,   85.7750,  109.5500,  133.3250, &
+        157.1000,  180.8750,  204.6500,  228.4250,  252.2000,  275.9750, &
+        299.7500,  323.5250,  347.3000,  371.0750,  394.8500,  418.6250, &
+        442.4000,  466.1750,  489.9500,  513.7250,  537.5000,  561.2750, &
+        585.0500,  608.8250,  632.6000,  656.3750,  680.1500,  703.9250, &
+        727.7000,  751.4750,  775.2500,  799.0250,  822.8000,  846.5750, &
+        870.3500,  894.1250,  917.9000,  941.6750,  965.4500,  989.2250, &
+       1013.0000/
+!
+      data (ozone(i,1),i=1,np)/ &
+        0.1793E-06,  0.2228E-06,  0.2665E-06,  0.3104E-06,  0.3545E-06, &
+        0.3989E-06,  0.4435E-06,  0.4883E-06,  0.5333E-06,  0.5786E-06, &
+        0.6241E-06,  0.6698E-06,  0.7157E-06,  0.7622E-06,  0.8557E-06, &
+        0.1150E-05,  0.1462E-05,  0.1793E-05,  0.2143E-05,  0.2512E-05, &
+        0.2902E-05,  0.3313E-05,  0.4016E-05,  0.5193E-05,  0.6698E-05, &
+        0.8483E-05,  0.9378E-05,  0.9792E-05,  0.1002E-04,  0.1014E-04, &
+        0.9312E-05,  0.7834E-05,  0.6448E-05,  0.5159E-05,  0.3390E-05, &
+        0.1937E-05,  0.1205E-05,  0.8778E-06,  0.6935E-06,  0.5112E-06, &
+        0.3877E-06,  0.3262E-06,  0.2770E-06,  0.2266E-06,  0.2020E-06, &
+        0.1845E-06,  0.1679E-06,  0.1519E-06,  0.1415E-06,  0.1317E-06, &
+        0.1225E-06,  0.1137E-06,  0.1055E-06,  0.1001E-06,  0.9487E-07, &
+        0.9016E-07,  0.8641E-07,  0.8276E-07,  0.7930E-07,  0.7635E-07, &
+        0.7347E-07,  0.7065E-07,  0.6821E-07,  0.6593E-07,  0.6368E-07, &
+        0.6148E-07,  0.5998E-07,  0.5859E-07,  0.5720E-07,  0.5582E-07, &
+        0.5457E-07,  0.5339E-07,  0.5224E-07,  0.5110E-07,  0.4999E-07/
+
+!--------------------------------------------------------------------------------
+!   data set 2
+!   mid-latitude winter (75 levels) :  p(mb)  o3(g/g)
+!   surface temp = 272.2
+!
+      data (pres(i,2),i=1,np)/ &
+          0.0006244,   0.0008759,   0.0012286,   0.0017234,   0.0024174, &
+          0.0033909,   0.0047565,   0.0066720,   0.0093589,   0.0131278, &
+          0.0184145,   0.0258302,   0.0362323,   0.0508234,   0.0712906, &
+          0.1000000,   0.1402710,   0.1967600,   0.2759970,   0.3871430, &
+          0.5430,    0.7617,    1.0685,    1.4988,    2.1024,    2.9490, &
+          4.1366,    5.8025,    8.1392,   11.4170,   16.0147,   22.4640, &
+         31.5105,   44.2001,   62.0000,   85.9000,  109.8000,  133.7000, &
+        157.6000,  181.5000,  205.4000,  229.3000,  253.2000,  277.1000, &
+        301.0000,  324.9000,  348.8000,  372.7000,  396.6000,  420.5000, &
+        444.4000,  468.3000,  492.2000,  516.1000,  540.0000,  563.9000, &
+        587.8000,  611.7000,  635.6000,  659.5000,  683.4000,  707.3000, &
+        731.2000,  755.1000,  779.0000,  802.9000,  826.8000,  850.7000, &
+        874.6000,  898.5000,  922.4000,  946.3000,  970.2000,  994.1000, &
+       1018.0000/
+!
+      data (ozone(i,2),i=1,np)/ &
+        0.2353E-06,  0.3054E-06,  0.3771E-06,  0.4498E-06,  0.5236E-06, &
+        0.5984E-06,  0.6742E-06,  0.7511E-06,  0.8290E-06,  0.9080E-06, &
+        0.9881E-06,  0.1069E-05,  0.1152E-05,  0.1319E-05,  0.1725E-05, &
+        0.2145E-05,  0.2581E-05,  0.3031E-05,  0.3497E-05,  0.3980E-05, &
+        0.4478E-05,  0.5300E-05,  0.6725E-05,  0.8415E-05,  0.1035E-04, &
+        0.1141E-04,  0.1155E-04,  0.1143E-04,  0.1093E-04,  0.1060E-04, &
+        0.9720E-05,  0.8849E-05,  0.7424E-05,  0.6023E-05,  0.4310E-05, &
+        0.2820E-05,  0.1990E-05,  0.1518E-05,  0.1206E-05,  0.9370E-06, &
+        0.7177E-06,  0.5450E-06,  0.4131E-06,  0.3277E-06,  0.2563E-06, &
+        0.2120E-06,  0.1711E-06,  0.1524E-06,  0.1344E-06,  0.1199E-06, &
+        0.1066E-06,  0.9516E-07,  0.8858E-07,  0.8219E-07,  0.7598E-07, &
+        0.6992E-07,  0.6403E-07,  0.5887E-07,  0.5712E-07,  0.5540E-07, &
+        0.5370E-07,  0.5214E-07,  0.5069E-07,  0.4926E-07,  0.4785E-07, &
+        0.4713E-07,  0.4694E-07,  0.4676E-07,  0.4658E-07,  0.4641E-07, &
+        0.4634E-07,  0.4627E-07,  0.4619E-07,  0.4612E-07,  0.4605E-07/
+
+
+!--------------------------------------------------------------------------------
+!   data set 3
+!   sub-arctic summer (75 levels) :  p(mb)  o3(g/g)
+!   surface temp = 287.0
+!
+      data (pres(i,3),i=1,np)/ &
+          0.0006244,   0.0008759,   0.0012286,   0.0017234,   0.0024174, &
+          0.0033909,   0.0047565,   0.0066720,   0.0093589,   0.0131278, &
+          0.0184145,   0.0258302,   0.0362323,   0.0508234,   0.0712906, &
+          0.1000000,   0.1402710,   0.1967600,   0.2759970,   0.3871430, &
+          0.5430,    0.7617,    1.0685,    1.4988,    2.1024,    2.9490, &
+          4.1366,    5.8025,    8.1392,   11.4170,   16.0147,   22.4640, &
+         31.5105,   44.2001,   62.0000,   85.7000,  109.4000,  133.1000, &
+        156.8000,  180.5000,  204.2000,  227.9000,  251.6000,  275.3000, &
+        299.0000,  322.7000,  346.4000,  370.1000,  393.8000,  417.5000, &
+        441.2000,  464.9000,  488.6000,  512.3000,  536.0000,  559.7000, &
+        583.4000,  607.1000,  630.8000,  654.5000,  678.2000,  701.9000, &
+        725.6000,  749.3000,  773.0000,  796.7000,  820.4000,  844.1000, &
+        867.8000,  891.5000,  915.2000,  938.9000,  962.6000,  986.3000, &
+       1010.0000/
+!
+      data (ozone(i,3),i=1,np)/ &
+        0.1728E-06,  0.2131E-06,  0.2537E-06,  0.2944E-06,  0.3353E-06, &
+        0.3764E-06,  0.4176E-06,  0.4590E-06,  0.5006E-06,  0.5423E-06, &
+        0.5842E-06,  0.6263E-06,  0.6685E-06,  0.7112E-06,  0.7631E-06, &
+        0.1040E-05,  0.1340E-05,  0.1660E-05,  0.2001E-05,  0.2362E-05, &
+        0.2746E-05,  0.3153E-05,  0.3762E-05,  0.4988E-05,  0.6518E-05, &
+        0.8352E-05,  0.9328E-05,  0.9731E-05,  0.8985E-05,  0.7632E-05, &
+        0.6814E-05,  0.6384E-05,  0.5718E-05,  0.4728E-05,  0.4136E-05, &
+        0.3033E-05,  0.2000E-05,  0.1486E-05,  0.1121E-05,  0.8680E-06, &
+        0.6474E-06,  0.5164E-06,  0.3921E-06,  0.2996E-06,  0.2562E-06, &
+        0.2139E-06,  0.1723E-06,  0.1460E-06,  0.1360E-06,  0.1267E-06, &
+        0.1189E-06,  0.1114E-06,  0.1040E-06,  0.9678E-07,  0.8969E-07, &
+        0.8468E-07,  0.8025E-07,  0.7590E-07,  0.7250E-07,  0.6969E-07, &
+        0.6694E-07,  0.6429E-07,  0.6208E-07,  0.5991E-07,  0.5778E-07, &
+        0.5575E-07,  0.5403E-07,  0.5233E-07,  0.5067E-07,  0.4904E-07, &
+        0.4721E-07,  0.4535E-07,  0.4353E-07,  0.4173E-07,  0.3997E-07/
+
+
+!--------------------------------------------------------------------------------
+!   data set 3
+!   sub-arctic winter (75 levels) :   p(mb)  o3(g/g)
+!   surface temp = 257.1
+!
+      data (pres(i,4),i=1,np)/ &
+          0.0006244,   0.0008759,   0.0012286,   0.0017234,   0.0024174, &
+          0.0033909,   0.0047565,   0.0066720,   0.0093589,   0.0131278, &
+          0.0184145,   0.0258302,   0.0362323,   0.0508234,   0.0712906, &
+          0.1000000,   0.1402710,   0.1967600,   0.2759970,   0.3871430, &
+          0.5430,    0.7617,    1.0685,    1.4988,    2.1024,    2.9490, &
+          4.1366,    5.8025,    8.1392,   11.4170,   16.0147,   22.4640, &
+         31.5105,   44.2001,   62.0000,   85.7750,  109.5500,  133.3250, &
+        157.1000,  180.8750,  204.6500,  228.4250,  252.2000,  275.9750, &
+        299.7500,  323.5250,  347.3000,  371.0750,  394.8500,  418.6250, &
+        442.4000,  466.1750,  489.9500,  513.7250,  537.5000,  561.2750, &
+        585.0500,  608.8250,  632.6000,  656.3750,  680.1500,  703.9250, &
+        727.7000,  751.4750,  775.2500,  799.0250,  822.8000,  846.5750, &
+        870.3500,  894.1250,  917.9000,  941.6750,  965.4500,  989.2250, &
+       1013.0000/
+!
+      data (ozone(i,4),i=1,np)/ &
+        0.2683E-06,  0.3562E-06,  0.4464E-06,  0.5387E-06,  0.6333E-06, &
+        0.7301E-06,  0.8291E-06,  0.9306E-06,  0.1034E-05,  0.1140E-05, &
+        0.1249E-05,  0.1360E-05,  0.1474E-05,  0.1855E-05,  0.2357E-05, &
+        0.2866E-05,  0.3383E-05,  0.3906E-05,  0.4437E-05,  0.4975E-05, &
+        0.5513E-05,  0.6815E-05,  0.8157E-05,  0.1008E-04,  0.1200E-04, &
+        0.1242E-04,  0.1250E-04,  0.1157E-04,  0.1010E-04,  0.9063E-05, &
+        0.8836E-05,  0.8632E-05,  0.8391E-05,  0.7224E-05,  0.6054E-05, &
+        0.4503E-05,  0.3204E-05,  0.2278E-05,  0.1833E-05,  0.1433E-05, &
+        0.9996E-06,  0.7440E-06,  0.5471E-06,  0.3944E-06,  0.2852E-06, &
+        0.1977E-06,  0.1559E-06,  0.1333E-06,  0.1126E-06,  0.9441E-07, &
+        0.7678E-07,  0.7054E-07,  0.6684E-07,  0.6323E-07,  0.6028E-07, &
+        0.5746E-07,  0.5468E-07,  0.5227E-07,  0.5006E-07,  0.4789E-07, &
+        0.4576E-07,  0.4402E-07,  0.4230E-07,  0.4062E-07,  0.3897E-07, &
+        0.3793E-07,  0.3697E-07,  0.3602E-07,  0.3506E-07,  0.3413E-07, &
+        0.3326E-07,  0.3239E-07,  0.3153E-07,  0.3069E-07,  0.2987E-07/ 
+
+!--------------------------------------------------------------------------------
+!   data set 4
+!   tropical (75 levels) :   p(mb)  o3(g/g)
+!   surface temp = 300.0
+!
+      data (pres(i,5),i=1,np)/ &
+          0.0006244,   0.0008759,   0.0012286,   0.0017234,   0.0024174, &
+          0.0033909,   0.0047565,   0.0066720,   0.0093589,   0.0131278, &
+          0.0184145,   0.0258302,   0.0362323,   0.0508234,   0.0712906, &
+          0.1000000,   0.1402710,   0.1967600,   0.2759970,   0.3871430, &
+          0.5430,    0.7617,    1.0685,    1.4988,    2.1024,    2.9490, &
+          4.1366,    5.8025,    8.1392,   11.4170,   16.0147,   22.4640, &
+         31.5105,   44.2001,   62.0000,   85.7750,  109.5500,  133.3250, &
+        157.1000,  180.8750,  204.6500,  228.4250,  252.2000,  275.9750, &
+        299.7500,  323.5250,  347.3000,  371.0750,  394.8500,  418.6250, &
+        442.4000,  466.1750,  489.9500,  513.7250,  537.5000,  561.2750, &
+        585.0500,  608.8250,  632.6000,  656.3750,  680.1500,  703.9250, &
+        727.7000,  751.4750,  775.2500,  799.0250,  822.8000,  846.5750, &
+        870.3500,  894.1250,  917.9000,  941.6750,  965.4500,  989.2250, &
+       1013.0000/
+!
+      data (ozone(i,5),i=1,np)/ &
+        0.1993E-06,  0.2521E-06,  0.3051E-06,  0.3585E-06,  0.4121E-06, &
+        0.4661E-06,  0.5203E-06,  0.5748E-06,  0.6296E-06,  0.6847E-06, &
+        0.7402E-06,  0.7959E-06,  0.8519E-06,  0.9096E-06,  0.1125E-05, &
+        0.1450E-05,  0.1794E-05,  0.2156E-05,  0.2538E-05,  0.2939E-05, &
+        0.3362E-05,  0.3785E-05,  0.4753E-05,  0.6005E-05,  0.7804E-05, &
+        0.9635E-05,  0.1023E-04,  0.1067E-04,  0.1177E-04,  0.1290E-04, &
+        0.1134E-04,  0.9223E-05,  0.6667E-05,  0.3644E-05,  0.1545E-05, &
+        0.5355E-06,  0.2523E-06,  0.2062E-06,  0.1734E-06,  0.1548E-06, &
+        0.1360E-06,  0.1204E-06,  0.1074E-06,  0.9707E-07,  0.8960E-07, &
+        0.8419E-07,  0.7962E-07,  0.7542E-07,  0.7290E-07,  0.7109E-07, &
+        0.6940E-07,  0.6786E-07,  0.6635E-07,  0.6500E-07,  0.6370E-07, &
+        0.6244E-07,  0.6132E-07,  0.6022E-07,  0.5914E-07,  0.5884E-07, &
+        0.5855E-07,  0.5823E-07,  0.5772E-07,  0.5703E-07,  0.5635E-07, &
+        0.5570E-07,  0.5492E-07,  0.5412E-07,  0.5335E-07,  0.5260E-07, &
+        0.5167E-07,  0.5063E-07,  0.4961E-07,  0.4860E-07,  0.4761E-07/
+
+!--------------------------------------------------------------------------------
+
+#ifdef AER_RA_FEEDBACK   
+   IF ( .NOT. &
+      ( PRESENT(tauaer300) .AND. &
+        PRESENT(tauaer400) .AND. &
+        PRESENT(tauaer600) .AND. &
+        PRESENT(tauaer999) .AND. &
+        PRESENT(gaer300) .AND. &
+        PRESENT(gaer400) .AND. &
+        PRESENT(gaer600) .AND. &
+        PRESENT(gaer999) .AND. &
+        PRESENT(waer300) .AND. &
+        PRESENT(waer400) .AND. &
+        PRESENT(waer600) .AND. &
+        PRESENT(waer999) ) ) THEN
+      CALL wrf_error_fatal ( 'Warning: missing fields required for aerosol radiation' )
+   ENDIF
+#endif
+   cldwater = .true.
+   overcast = .false.
+
+   mix=ite-its+1 
+   mkx=kte-kts+1 
+
+   is_summer=80
+   ie_summer=265
+
+! testing, need to change iprof, which is function of lat and julian day
+!  iprof = 1  :  mid-latitude summer profile
+!        = 2  :  mid-latitude winter profile
+!        = 3  :  sub-arctic   summer profile
+!        = 4  :  sub-arctic   winter profile
+!        = 5  :  tropical profile
+
+   IF (abs(center_lat) .le. 30. ) THEN ! tropic
+      iprof = 5
+   ELSE
+      IF (center_lat .gt.  0.) THEN
+         IF (center_lat .gt. 60. ) THEN !  arctic
+            IF (JULDAY .gt. is_summer .and. JULDAY .lt. ie_summer ) THEN
+               ! arctic summer
+               iprof = 3
+            ELSE
+               ! arctic winter
+               iprof = 4
+            ENDIF
+         ELSE        ! midlatitude
+            IF (JULDAY .gt. is_summer .and. JULDAY .lt. ie_summer ) THEN
+               ! north midlatitude summer
+               iprof = 1
+            ELSE
+               ! north midlatitude winter
+               iprof = 2
+            ENDIF
+         ENDIF
+
+      ELSE
+         IF (center_lat .lt. -60. ) THEN !  antarctic
+            IF (JULDAY .lt. is_summer .or. JULDAY .gt. ie_summer ) THEN
+               ! antarctic summer
+               iprof = 3
+            ELSE
+               ! antarctic winter
+               iprof = 4
+            ENDIF
+         ELSE        ! midlatitude
+            IF (JULDAY .lt. is_summer .or. JULDAY .gt. ie_summer ) THEN
+               ! south midlatitude summer
+               iprof = 1
+            ELSE
+               ! south midlatitude winter
+               iprof = 2
+            ENDIF
+         ENDIF
+
+      ENDIF
+   ENDIF
+
+
+   j_loop: DO J=jts,jte
+
+      DO K=kts,kte          
+      DO I=its,ite          
+         cwc(i,k,1) = 0.
+         cwc(i,k,2) = 0.
+      ENDDO
+      ENDDO
+
+      DO K=1,np
+         p(k)=pres(k,iprof)
+      ENDDO
+
+      do k = kts,kte+1
+      do i = its,ite
+      if(k.eq.kts)then
+        phyd(i,k)=p8w3d(i,kts,j)
+      else
+        phyd(i,k)=phyd(i,k-1) - g*rho_phy(i,k-1,j)*dz8w(i,k-1,j)
+        phydmid(i,k-1)=0.5*(phyd(i,k-1)+phyd(i,k))
+      endif
+      enddo
+      enddo
+
+! reverse vars 
+!
+      DO K=kts,kte+1
+      DO I=its,ite
+         NK=kme-K+kms
+         P8W2D(I,K)=phyd(I,NK)*0.01   ! P8w2D is in mb
+      ENDDO
+      ENDDO
+
+      DO I=its,ite
+         P8W2D(I,0)=.0
+      ENDDO
+!
+      DO K=kts,kte
+      DO I=its,ite
+         NK=kme-1-K+kms
+         TTEN2D(I,K)=0.
+         T2D(I,K)=T3D(I,NK,J)
+
+! SH2D specific humidity
+         SH2D(I,K)=QV3D(I,NK,J)/(1.+QV3D(I,NK,J))
+         SH2D(I,K)=max(0.,SH2D(I,K))
+         cwc(I,K,2)=QC3D(I,NK,J)
+         cwc(I,K,2)=max(0.,cwc(I,K,2))
+
+         P2D(I,K)=phydmid(I,NK)*0.01      ! P2D is in mb
+         fcld2D(I,K)=CLDFRA3D(I,NK,J)
+      ENDDO
+      ENDDO
+
+! This logic is tortured because cannot test F_QI unless
+! it is present, and order of evaluation of expressions
+! is not specified in Fortran
+
+      IF ( PRESENT ( F_QI ) ) THEN
+	predicate = F_QI
+      ELSE
+        predicate = .FALSE.
+      ENDIF
+
+      IF (.NOT. warm_rain .AND. .NOT. predicate ) THEN
+         DO K=kts,kte
+         DO I=its,ite
+            IF (T2D(I,K) .lt. 273.15) THEN
+               cwc(I,K,1)=cwc(I,K,2)
+               cwc(I,K,2)=0.
+            ENDIF
+         ENDDO
+         ENDDO
+      ENDIF
+
+      DO I=its,ite
+         TTEN2D(I,0)=0.
+         T2D(I,0)=T2D(I,1)
+! SH2D specific humidity
+         SH2D(I,0)=0.5*SH2D(i,1)
+         cwc(I,0,2)=0.
+         cwc(I,0,1)=0.
+         P2D(I,0)=0.5*(P8W2D(I,0)+P8W2D(I,1))
+         fcld2D(I,0)=0.
+      ENDDO
+!
+      IF ( PRESENT( F_QI ) .AND. PRESENT( qi3d)  ) THEN
+	 IF ( (F_QI) ) THEN
+            DO K=kts,kte          
+            DO I=its,ite          
+               NK=kme-1-K+kms
+               cwc(I,K,1)=QI3D(I,NK,J)
+               cwc(I,K,1)=max(0.,cwc(I,K,1))
+            ENDDO
+            ENDDO
+         ENDIF
+      ENDIF
+!
+! ... Vertical profiles for ozone
+!
+      call o3prof (np, p, ozone(1,iprof), its, ite, kts-1, kte, P2D, O3)
+
+! ... Vertical profiles for effective particle size
+!
+      do k = kts-1, kte
+      do i = its, ite
+         reff(i,k,2) = 10.
+         reff(i,k,1) = 80.
+      end do
+      end do
+!
+! ... Level indices separating high, middle and low clouds
+!
+      do i = its, ite
+         p400(i) = 1.e5
+         p700(i) = 1.e5
+      enddo
+
+      do k = kts-1,kte+1
+         do i = its, ite
+            if (abs(P8W2D(i,k) - 400.) .lt. p400(i)) then
+               p400(i) = abs(P8W2D(i,k) - 400.)
+               ict(i) = k
+            endif
+            if (abs(P8W2D(i,k) - 700.) .lt. p700(i)) then
+               p700(i) = abs(P8W2D(i,k) - 700.)
+               icb(i) = k
+            endif
+        end do
+      end do
+
+!wig beg
+! ... Aerosol effects. Added aerosol feedbacks with MOSAIC, Dec. 2005.
+!
+      do ib = 1, 11
+      do k = kts-1,kte
+      do i = its,ite
+         taual(i,k,ib) = 0.
+         ssaal(i,k,ib) = 0.
+         asyal(i,k,ib) = 0.
+      end do
+      end do
+      end do
+
+#ifdef AER_RA_FEEDBACK
+!wig end
+      do ib = 1, 11
+      do k = kts-1,kte-1      !wig
+      do i = its,ite
+
+!        taual(i,kte-k,ib) = 0.
+!        ssaal(i,kte-k,ib) = 0.
+!        asyal(i,kte-k,ib) = 0.
+
+!jcb beg
+! convert optical properties at 300,400,600, and 999 to conform to the band wavelengths
+! these are: 200,235,270,287.5,302.5,305,362.5,550,1920,1745,6135; why the emphasis on the UV?
+! taual - use angstrom exponent
+        if(tauaer300(i,k+1,j).gt.thresh .and. tauaer999(i,k+1,j).gt.thresh) then
+           ang=log(tauaer300(i,k+1,j)/tauaer999(i,k+1,j))/log(999./300.)
+!       write(6,*)i,k,ang,tauaer300(i,k+1,j),tauaer999(i,k+1,j)
+           taual(i,kte-k,ib)=tauaer400(i,k+1,j)*(0.4/midbands(ib))**ang ! notice reserved variable
+!       write(6,10001)i,k,ang,tauaer300(i,k+1,j),tauaer999(i,k+1,j),midbands(ib),taual(i,k,ib)
+!10001      format(i3,i3,5f12.6)
+
+! ssa - linear interpolation; extrapolation
+           slope=(waer600(i,k+1,j)-waer400(i,k+1,j))/.2
+           ssaal(i,kte-k,ib) = slope*(midbands(ib)-.6)+waer600(i,k+1,j) ! notice reversed variables
+           if(ssaal(i,kte-k,ib).lt.0.4) ssaal(i,kte-k,ib)=0.4
+           if(ssaal(i,kte-k,ib).ge.0.9) ssaal(i,kte-k,ib)=0.9
+
+! g - linear interpolation;extrapolation
+           slope=(gaer600(i,k+1,j)-gaer400(i,k+1,j))/.2
+           asyal(i,kte-k,ib) = slope*(midbands(ib)-.6)+gaer600(i,k+1,j) ! notice reversed varaibles
+           if(asyal(i,kte-k,ib).lt.0.5) asyal(i,kte-k,ib)=0.5
+           if(asyal(i,kte-k,ib).ge.1.0) asyal(i,kte-k,ib)=1.0
+        endif
+!jcb end
+      end do
+      end do
+      end do
+
+!wig beg
+      do ib = 1, 11
+      do i = its,ite
+         slope = 0.  !use slope as a sum holder
+         do k = kts-1,kte
+            slope = slope + taual(i,k,ib)
+         end do
+         if( slope < 0. ) then
+            write(msg,'("ERROR: Negative total optical depth of ",f8.2," at point i,j,ib=",3i5)') slope,i,j,ib
+            call wrf_error_fatal(msg)
+         else if( slope > 5. ) then
+            call wrf_message("-------------------------")
+            write(msg,'("WARNING: Large total optical depth of ",f8.2," at point i,j,ib=",3i5)') slope,i,j,ib
+            call wrf_message(msg)
+
+            call wrf_message("Diagnostics 1: k, tauaer300, tauaer400, tauaer600, tauaer999")
+            do k=kts,kte
+               write(msg,'(i4,4f8.2)') k, tauaer300(i,k,j), tauaer400(i,k,j), &
+                    tauaer600(i,k,j), tauaer999(i,k,j)
+               call wrf_message(msg)
+            end do
+
+            call wrf_message("Diagnostics 2: k, gaer300, gaer400, gaer600, gaer999")
+            do k=kts,kte
+               write(msg,'(i4,4f8.2)') k, gaer300(i,k,j), gaer400(i,k,j), &
+                    gaer600(i,k,j), gaer999(i,k,j)
+               call wrf_message(msg)
+            end do
+
+            call wrf_message("Diagnostics 3: k, waer300, waer400, waer600, waer999")
+            do k=kts,kte
+               write(msg,'(i4,4f8.2)') k, waer300(i,k,j), waer400(i,k,j), &
+                    waer600(i,k,j), waer999(i,k,j)
+               call wrf_message(msg)
+            end do
+
+            call wrf_message("Diagnostics 4: k, ssaal, asyal, taual")
+            do k=kts-1,kte
+               write(msg,'(i4,3f8.2)') k, ssaal(i,k,ib), asyal(i,k,ib), taual(i,k,ib)
+               call wrf_message(msg)
+            end do
+            call wrf_message("-------------------------")
+         end if
+      end do
+      end do
+!wig end
+#endif
+!
+! ... Initialize output arrays
+!
+      do ib = 1, 2
+      do k = kts-1, kte
+      do i = its, ite
+         taucld(i,k,ib) = 0.
+      end do
+      end do
+      end do
+!
+      do k = kts-1,kte+1
+      do i = its,ite
+         flx(i,k)   = 0.
+         flxd(i,k)  = 0.
+      end do
+      end do
+!
+! ... Solar zenith angle
+!
+      do i = its,ite
+        xt24 = mod(xtime + radfrq * 0.5, 1440.)
+        tloctm = GMT + xt24 / 60. + XLONG(i,j) / 15.
+        hrang = 15. * (tloctm - 12.) * degrad
+        xxlat = XLAT(i,j) * degrad
+        cosz(i) = sin(xxlat) * sin(declin) + &
+                  cos(xxlat) * cos(declin) * cos(hrang)
+!urban
+       if(present(COSZ_URB2D)) COSZ_URB2D(i,j)=cosz(i)  !urban
+       if(present(OMG_URB2D)) OMG_URB2D(i,j)=hrang     !urban
+        rsuvbm(i) = ALB(i,j)
+        rsuvdf(i) = ALB(i,j)
+        rsirbm(i) = ALB(i,j)
+        rsirdf(i) = ALB(i,j)
+      end do
+                                  
+      call sorad (mix,1,1,mkx+1,p8w2D,t2D,sh2D,o3,                 &
+                  overcast,cldwater,cwc,taucld,reff,fcld2D,ict,icb,&
+                  taual,ssaal,asyal,                               &
+                  cosz,rsuvbm,rsuvdf,rsirbm,rsirdf,                &
+                  flx,flxd)
+!
+! ... Convert the units of flx and flc from fraction to w/m^2
+!
+      do k = kts, kte
+      do i = its, ite
+         nk=kme-1-k+kms
+         taucldc(i,nk,j)=taucld(i,k,2)
+         taucldi(i,nk,j)=taucld(i,k,1)
+      enddo
+      enddo
+ 
+      do k = kts, kte+1
+        do i = its, ite
+          if (cosz(i) .lt. thresh) then
+            flx(i,k) = 0.
+          else
+            flx(i,k) = flx(i,k) * SOLCON * cosz(i)
+          endif
+        end do
+      end do
+!
+! ... Calculate heating rate (deg/sec)
+!
+      fac = .01 * g / Cp
+      do k = kts, kte
+      do i = its, ite
+         if (cosz(i) .gt. thresh) then
+             TTEN2D(i,k) = - fac * (flx(i,k) - flx(i,k+1))/ &
+                           (p8w2d(i,k)-p8w2d(i,k+1))
+         endif
+      end do
+      end do
+
+!
+! ... Absorbed part in surface energy budget
+!
+      do i = its, ite
+        if (cosz(i) .le. thresh) then
+          GSW(i,j) = 0.
+        else
+          GSW(i,j) = (1. - rsuvbm(i)) * flxd(i,kte+1) * SOLCON * cosz(i)
+        endif
+      end do
+
+      DO K=kts,kte          
+         NK=kme-1-K+kms
+         DO I=its,ite
+            RTHRATEN(I,K,J)=RTHRATEN(I,K,J)+TTEN2D(I,NK)/pi3D(I,K,J)
+         ENDDO
+      ENDDO
+!
+   ENDDO j_loop                                          
+
+   END SUBROUTINE GSFCSWRAD
+
+!*********************   Version Solar-6 (May 8, 1997)  *****************
+
+      subroutine sorad (m,n,ndim,np,pl,ta,wa,oa,                        &
+                        overcast,cldwater,cwc,taucld,reff,fcld,ict,icb, &
+                        taual,ssaal,asyal,                              &
+                        cosz,rsuvbm,rsuvdf,rsirbm,rsirdf,               &
+                        flx,flxd)
+
+!************************************************************************
+!
+!                        Version Solar-6 (May 8, 1997)
+!
+!  New feature of this version is:
+!   (1) An option is added for scaling the cloud optical thickness. If
+!       the fractional cloud cover, fcld, in an atmospheric model is alway 
+!       either 1 or 0 (i.e. partly cloudy sky is not allowed), it does
+!       not require the scaling of cloud optical thickness, and the
+!       option "overcast" can be set to .true.  Computation is faster
+!       with this option than with overcast=.false.
+!
+!**********************************************************************
+!
+!                        Version Solar-5 (April 1997)
+!
+!  New features of this version are:
+!   (1) Cloud optical properties can be computed from cloud water/ice
+!       amount and the effective particle size.
+!   (2) Aerosol optical properties are functions of height and band.
+!   (3) A maximum-random cloud overlapping approximation is applied.
+!
+!*********************************************************************
+!  
+! This routine computes solar fluxes due to the absoption by water
+!  vapor, ozone, co2, o2, clouds, and aerosols and due to the
+!  scattering by clouds, aerosols, and gases.
+!
+! The solar spectrum is divided into one UV+visible band and three IR
+!  bands separated by the wavelength 0.7 micron.  The UV+visible band
+!  is further divided into eight sub-bands.
+!
+! This is a vectorized code. It computes fluxes simultaneously for
+!  (m x n) soundings, which is a subset of (m x ndim) soundings.
+!  In a global climate model, m and ndim correspond to the numbers of
+!  grid boxes in the zonal and meridional directions, respectively.
+!
+! Ice and liquid cloud particles are allowed to co-exist in a layer. 
+!
+! There is an option of providing either cloud ice/water mixing ratio 
+!  (cwc) or thickness (taucld).  If the former is provided, set
+!  cldwater=.true., and taucld will be computed from cwc and reff as a
+!  function of spectra band. Otherwise, set cldwater=.false., and
+!  specify taucld, independent of spectral band.
+!
+! If no information is available for reff, a default value of
+!  10 micron for liquid water and 75 micron for ice can be used.
+!  For a clear layer, reff can be set to any values except zero.
+!
+! The maximum-random assumption is applied for treating cloud
+!  overlapping.
+
+! Clouds are grouped into high, middle, and low clouds separated by
+!  the level indices ict and icb.  For detail, see subroutine cldscale.
+!
+! In a high spatial-resolution atmospheric model, fractional cloud cover
+!  might be computed to be either 0 or 1.  In such a case, scaling of the
+!  cloud optical thickness is not necessary, and the computation can be
+!  made faster by setting overcast=.true.  The option overcast=.false.
+!  can be applied to any values of the fractional cloud cover, but the
+!  computation is slower.
+!
+! Aerosol optical thickness, single-scattering albaedo, and asymmtry
+!  factor can be specified as functions of height and spectral band.
+!
+!----- Input parameters:                           
+!                                                   units      size
+!  number of soundings in zonal direction (m)       n/d        1
+!  number of soundings in meridional direction (n)  n/d        1
+!  maximum number of soundings in                   n/d        1
+!         meridional direction (ndim>=n)
+!  number of atmospheric layers (np)                n/d        1
+!  level pressure (pl)                              mb     m*ndim*(np+1)
+!  layer temperature (ta)                           k        m*ndim*np
+!  layer specific humidity (wa)                     gm/gm    m*ndim*np
+!  layer ozone concentration (oa)                   gm/gm    m*ndim*np
+!  co2 mixing ratio by volumn (co2)                 pppv       1
+!  option for scaling cloud optical thickness       n/d        1
+!        overcast="true" if scaling is NOT required
+!        overcast="fasle" if scaling is required
+!  option for cloud optical thickness               n/d        1
+!        cldwater="true" if cwc is provided
+!        cldwater="false" if taucld is provided
+!  cloud water mixing ratio (cwc)                  gm/gm     m*ndim*np*2
+!        index 1 for ice particles
+!        index 2 for liquid drops
+!  cloud optical thickness (taucld)                 n/d      m*ndim*np*2
+!        index 1 for ice particles
+!        index 2 for liquid drops
+!  effective cloud-particle size (reff)          micrometer m*ndim*np*2
+!        index 1 for ice particles
+!        index 2 for liquid drops
+!  cloud amount (fcld)                            fraction   m*ndim*np
+!  level index separating high and middle           n/d        1
+!        clouds (ict)
+!  level index separating middle and low            n/d        1
+!          clouds (icb)
+!  aerosol optical thickness (taual)                n/d    m*ndim*np*11
+!  aerosol single-scattering albedo (ssaal)         n/d    m*ndim*np*11
+!  aerosol asymmetry factor (asyal)                 n/d    m*ndim*np*11
+!        in the uv region :
+!           index  1 for the 0.175-0.225 micron band
+!           index  2 for the 0.225-0.245; 0.260-0.280 micron band
+!           index  3 for the 0.245-0.260 micron band
+!           index  4 for the 0.280-0.295 micron band
+!           index  5 for the 0.295-0.310 micron band
+!           index  6 for the 0.310-0.320 micron band
+!           index  7 for the 0.325-0.400 micron band
+!        in the par region :
+!           index  8 for the 0.400-0.700 micron band
+!        in the infrared region :
+!           index  9 for the 0.700-1.220 micron band
+!           index 10 for the 1.220-2.270 micron band
+!           index 11 for the 2.270-10.00 micron band
+!   cosine of solar zenith angle (cosz)              n/d      m*ndim
+!   uv+visible sfc albedo for beam radiation
+!        for wavelengths<0.7 micron (rsuvbm)    fraction   m*ndim
+!   uv+visible sfc albedo for diffuse radiation
+!        for wavelengths<0.7 micron (rsuvdf)    fraction   m*ndim
+!   ir sfc albedo for beam radiation
+!        for wavelengths>0.7 micron  (rsirbm)   fraction   m*ndim
+!   ir sfc albedo for diffuse radiation (rsirdf)   fraction   m*ndim
+!
+!----- Output parameters
+!
+!   all-sky flux (downward minus upward) (flx)    fraction m*ndim*(np+1)
+!   clear-sky flux (downward minus upward) (flc)  fraction m*ndim*(np+1)
+!   all-sky direct downward uv (0.175-0.4 micron)
+!                flux at the surface (fdiruv)      fraction   m*ndim
+!   all-sky diffuse downward uv flux at
+!                the surface (fdifuv)              fraction   m*ndim
+!   all-sky direct downward par (0.4-0.7 micron)
+!                flux at the surface (fdirpar)     fraction   m*ndim
+!   all-sky diffuse downward par flux at
+!                the surface (fdifpar)             fraction   m*ndim
+!   all-sky direct downward ir (0.7-10 micron)
+!                flux at the surface (fdirir)      fraction   m*ndim
+!   all-sky diffuse downward ir flux at
+!                the surface (fdifir)              fraction   m*ndim
+!
+!----- Notes:
+!
+!    (1) The unit of "flux" is fraction of the incoming solar radiation
+!        at the top of the atmosphere.  Therefore, fluxes should
+!        be equal to "flux" multiplied by the extra-terrestrial solar
+!        flux and the cosine of solar zenith angle.
+!    (2) pl(i,j,1) is the pressure at the top of the model, and
+!        pl(i,j,np+1) is the surface pressure.
+!    (3) the pressure levels ict and icb correspond approximately
+!        to 400 and 700 mb.
+!    (4) if overcast='true', the clear-sky flux, flc, is not computed.
+!        
+!**************************************************************************
+      implicit none
+!**************************************************************************
+
+!-----input parameters
+
+      integer m,n,ndim,np
+      integer ict(m,ndim),icb(m,ndim)
+      real pl(m,ndim,np+1),ta(m,ndim,np),wa(m,ndim,np),oa(m,ndim,np)
+      real cwc(m,ndim,np,2),taucld(m,ndim,np,2),reff(m,ndim,np,2), &
+             fcld(m,ndim,np)
+      real taual(m,ndim,np,11),ssaal(m,ndim,np,11),asyal(m,ndim,np,11)
+      real cosz(m,ndim),rsuvbm(m,ndim),rsuvdf(m,ndim), &
+             rsirbm(m,ndim),rsirdf(m,ndim)           
+      logical overcast,cldwater
+
+!-----output parameters
+
+      real flx(m,ndim,np+1),flc(m,ndim,np+1)
+      real flxu(m,ndim,np+1),flxd(m,ndim,np+1)
+      real fdiruv (m,ndim),fdifuv (m,ndim)
+      real fdirpar(m,ndim),fdifpar(m,ndim)
+      real fdirir (m,ndim),fdifir (m,ndim)
+
+!-----temporary array
+ 
+      integer i,j,k
+      real cwp(m,n,np,2)
+      real dp(m,n,np),wh(m,n,np),oh(m,n,np),scal(m,n,np)
+      real swh(m,n,np+1),so2(m,n,np+1),df(m,n,np+1)
+      real sdf(m,n),sclr(m,n),csm(m,n),x
+ 
+      do j= 1, n 
+       do i= 1, m 
+          if (pl(i,j,1) .eq. 0.0) then
+              pl(i,j,1)=1.0e-4
+          endif
+       enddo
+      enddo
+
+      do j= 1, n 
+       do i= 1, m 
+
+         swh(i,j,1)=0. 
+         so2(i,j,1)=0. 
+
+!-----csm is the effective secant of the solar zenith angle
+!     see equation (12) of Lacis and Hansen (1974, JAS)    
+ 
+         csm(i,j)=35./sqrt(1224.*cosz(i,j)*cosz(i,j)+1.)
+
+       enddo 
+      enddo
+
+      do k= 1, np
+       do j= 1, n
+         do i= 1, m
+
+!-----compute layer thickness and pressure-scaling function. 
+!     indices for the surface level and surface layer
+!     are np+1 and np, respectively.
+ 
+          dp(i,j,k)=pl(i,j,k+1)-pl(i,j,k)
+          scal(i,j,k)=dp(i,j,k)*(.5*(pl(i,j,k)+pl(i,j,k+1))/300.)**.8
+ 
+!-----compute scaled water vapor amount, unit is g/cm**2
+!     note: the sign prior to the constant 0.00135 was incorrectly 
+!           set to negative in the previous version
+
+          wh(i,j,k)=1.02*wa(i,j,k)*scal(i,j,k)* &
+                    (1.+0.00135*(ta(i,j,k)-240.)) +1.e-11
+          swh(i,j,k+1)=swh(i,j,k)+wh(i,j,k)
+
+!-----compute ozone amount, unit is (cm-atm)stp
+!     the number 466.7 is a conversion factor from g/cm**2 to (cm-atm)stp
+ 
+          oh(i,j,k)=1.02*oa(i,j,k)*dp(i,j,k)*466.7 +1.e-11
+
+!-----compute layer cloud water amount (gm/m**2)
+!     the index is 1 for ice crystals and 2 for liquid drops
+
+          cwp(i,j,k,1)=1.02*10000.*cwc(i,j,k,1)*dp(i,j,k)
+          cwp(i,j,k,2)=1.02*10000.*cwc(i,j,k,2)*dp(i,j,k)
+
+        enddo
+       enddo
+      enddo
+
+!-----initialize fluxes for all-sky (flx), clear-sky (flc), and
+!     flux reduction (df)
+
+      do k=1, np+1
+       do j=1, n
+        do i=1, m
+          flx(i,j,k)=0.
+          flc(i,j,k)=0.
+          flxu(i,j,k)=0.
+          flxd(i,j,k)=0.
+          df(i,j,k)=0.
+        enddo
+       enddo
+      enddo
+
+!-----compute solar uv and par fluxes
+
+      call soluv (m,n,ndim,np,oh,dp,overcast,cldwater,  &
+                  cwp,taucld,reff,ict,icb,fcld,cosz,    &
+                  taual,ssaal,asyal,csm,rsuvbm,rsuvdf,  &
+                  flx,flc,flxu,flxd,fdiruv,fdifuv,fdirpar,fdifpar)
+
+!-----compute and update solar ir fluxes
+
+      call solir (m,n,ndim,np,wh,overcast,cldwater,     &
+                  cwp,taucld,reff,ict,icb,fcld,cosz,    &
+                  taual,ssaal,asyal,csm,rsirbm,rsirdf,  &
+                  flx,flc,flxu,flxd,fdirir,fdifir)
+
+!-----compute scaled o2 amount, unit is (cm-atm)stp.
+
+      do k= 1, np
+       do j= 1, n
+        do i= 1, m
+          so2(i,j,k+1)=so2(i,j,k)+165.22*scal(i,j,k)
+        enddo
+       enddo
+      enddo
+
+!-----compute flux reduction due to oxygen following
+!      chou (J. climate, 1990). The fraction 0.0287 is the
+!      extraterrestrial solar flux in the o2 bands.
+
+       do k= 2, np+1
+        do j= 1, n
+         do i= 1, m
+           x=so2(i,j,k)*csm(i,j)
+           df(i,j,k)=df(i,j,k)+0.0287*(1.-exp(-0.00027*sqrt(x)))
+         enddo
+        enddo
+       enddo          
+
+!-----compute scaled co2 amounts. unit is (cm-atm)stp.
+
+      do k= 1, np
+       do j= 1, n
+        do i= 1, m
+         so2(i,j,k+1)=so2(i,j,k)+co2*789.*scal(i,j,k)+1.e-11
+        enddo
+       enddo
+      enddo
+
+!-----compute and update flux reduction due to co2 following
+!     chou (J. Climate, 1990)
+
+      call flxco2(m,n,np,so2,swh,csm,df)
+
+!-----adjust for the effect of o2 cnd co2 on clear-sky fluxes.
+
+      do k= 2, np+1
+       do j= 1, n
+        do i= 1, m
+          flc(i,j,k)=flc(i,j,k)-df(i,j,k)
+        enddo
+       enddo
+      enddo
+
+!-----adjust for the all-sky fluxes due to o2 and co2.  It is
+!     assumed that o2 and co2 have no effects on solar radiation
+!     below clouds.
+
+      do j=1,n
+       do i=1,m
+        sdf(i,j)=0.0
+        sclr(i,j)=1.0
+       enddo
+      enddo
+
+      do k=1,np
+       do j=1,n
+        do i=1,m
+
+!-----sclr is the fraction of clear sky.
+!     sdf is the flux reduction below clouds.
+
+         if(fcld(i,j,k).gt.0.01) then
+          sdf(i,j)=sdf(i,j)+df(i,j,k)*sclr(i,j)*fcld(i,j,k)
+          sclr(i,j)=sclr(i,j)*(1.-fcld(i,j,k))
+         endif
+          flx(i,j,k+1)=flx(i,j,k+1)-sdf(i,j)-df(i,j,k+1)*sclr(i,j)
+          flxu(i,j,k+1)=flxu(i,j,k+1)-sdf(i,j)-df(i,j,k+1)*sclr(i,j)
+          flxd(i,j,k+1)=flxd(i,j,k+1)-sdf(i,j)-df(i,j,k+1)*sclr(i,j)
+
+        enddo
+       enddo
+      enddo
+
+!-----adjustment for the direct downward ir flux.
+
+      do j= 1, n
+       do i= 1, m
+        flc(i,j,np+1)=flc(i,j,np+1)+df(i,j,np+1)*rsirbm(i,j)
+        flx(i,j,np+1)=flx(i,j,np+1)+(sdf(i,j)+ &
+                         df(i,j,np+1)*sclr(i,j))*rsirbm(i,j)
+        flxu(i,j,np+1)=flxu(i,j,np+1)+(sdf(i,j)+ &
+                         df(i,j,np+1)*sclr(i,j))*rsirbm(i,j)
+        flxd(i,j,np+1)=flxd(i,j,np+1)+(sdf(i,j)+ &
+                         df(i,j,np+1)*sclr(i,j))*rsirbm(i,j)
+        fdirir(i,j)=fdirir(i,j)-(sdf(i,j)+df(i,j,np+1)*sclr(i,j))
+       enddo
+      enddo
+
+      end subroutine sorad 
+
+!************************************************************************
+
+      subroutine soluv (m,n,ndim,np,oh,dp,overcast,cldwater,            &
+                cwp,taucld,reff,ict,icb,fcld,cosz,                      &
+                taual,ssaal,asyal,csm,rsuvbm,rsuvdf,                    &
+                flx,flc,flxu,flxd,fdiruv,fdifuv,fdirpar,fdifpar)
+
+!************************************************************************
+!  compute solar fluxes in the uv+par region. the spectrum is
+!  grouped into 8 bands:
+!  
+!              Band     Micrometer
+!
+!       UV-C    1.     .175 - .225
+!               2.     .225 - .245
+!                      .260 - .280
+!               3.     .245 - .260
+!
+!       UV-B    4.     .280 - .295
+!               5.     .295 - .310
+!               6.     .310 - .320
+!      
+!       UV-A    7.     .320 - .400
+!      
+!       PAR     8.     .400 - .700
+!
+!----- Input parameters:                            units      size
+!
+!  number of soundings in zonal direction (m)       n/d        1
+!  number of soundings in meridional direction (n)  n/d        1
+!  maximum number of soundings in                   n/d        1
+!        meridional direction (ndim)
+!  number of atmospheric layers (np)                n/d        1
+!  layer ozone content (oh)                      (cm-atm)stp m*n*np
+!  layer pressure thickness (dp)                    mb       m*n*np
+!  option for scaling cloud optical thickness       n/d        1
+!        overcast="true" if scaling is NOT required
+!        overcast="fasle" if scaling is required
+!  input option for cloud optical thickness         n/d        1
+!        cldwater="true" if taucld is provided
+!        cldwater="false" if cwp is provided
+!  cloud water amount (cwp)                        gm/m**2   m*n*np*2
+!        index 1 for ice particles
+!        index 2 for liquid drops
+!  cloud optical thickness (taucld)                 n/d     m*ndim*np*2
+!       index 1 for ice paticles
+!       index 2 for liquid particles
+!  effective cloud-particle size (reff)          micrometer m*ndim*np*2
+!       index 1 for ice paticles
+!       index 2 for liquid particles
+!  level indiex separating high and                 n/d      m*n
+!       middle clouds (ict)
+!  level indiex separating middle and               n/d      m*n
+!       low clouds (icb)
+!  cloud amount (fcld)                            fraction   m*ndim*np
+!  cosine of solar zenith angle (cosz)              n/d      m*ndim
+!  aerosol optical thickness (taual)                n/d    m*ndim*np*11
+!  aerosol single-scattering albedo (ssaal)         n/d    m*ndim*np*11
+!  aerosol asymmetry factor (asyal)                 n/d    m*ndim*np*11
+!  cosecant of the solar zenith angle (csm)         n/d      m*n
+!  uv+par surface albedo for beam                 fraction   m*ndim
+!       radiation (rsuvbm)
+!  uv+par surface albedo for diffuse              fraction   m*ndim
+!       radiation (rsuvdf)
+!
+!---- temporary array
+!
+!  scaled cloud optical thickness                   n/d      m*n*np
+!       for beam radiation (tauclb)
+!  scaled cloud optical thickness                   n/d      m*n*np
+!       for diffuse radiation  (tauclf)     
+!
+!----- output (updated) parameters:
+!
+!  all-sky net downward flux (flx)               fraction  m*ndim*(np+1)
+!  clear-sky net downward flux (flc)             fraction  m*ndim*(np+1)
+!  all-sky direct downward uv flux at
+!       the surface (fdiruv)                     fraction    m*ndim
+!  all-sky diffuse downward uv flux at
+!       the surface (fdifuv)                     fraction    m*ndim
+!  all-sky direct downward par flux at
+!       the surface (fdirpar)                    fraction    m*ndim
+!  all-sky diffuse downward par flux at
+!       the surface (fdifpar)                    fraction    m*ndim
+!
+!***********************************************************************
+      implicit none
+!***********************************************************************
+
+!-----input parameters
+
+      integer m,n,ndim,np
+      integer ict(m,ndim),icb(m,ndim)
+      real taucld(m,ndim,np,2),reff(m,ndim,np,2),fcld(m,ndim,np)
+      real cc(m,n,3),cosz(m,ndim)
+      real cwp(m,n,np,2),oh(m,n,np),dp(m,n,np)
+      real taual(m,ndim,np,11),ssaal(m,ndim,np,11),asyal(m,ndim,np,11)
+      real rsuvbm(m,ndim),rsuvdf(m,ndim),csm(m,n)
+      logical overcast,cldwater
+
+!-----output (updated) parameter
+
+      real flx(m,ndim,np+1),flc(m,ndim,np+1)
+      real flxu(m,ndim,np+1),flxd(m,ndim,np+1)
+      real fdiruv (m,ndim),fdifuv (m,ndim)
+      real fdirpar(m,ndim),fdifpar(m,ndim)
+
+!-----static parameters
+
+      integer nband
+      parameter (nband=8)
+      real hk(nband),xk(nband),ry(nband)
+      real aig(3),awg(3)
+
+!-----temporary array
+
+      integer i,j,k,ib
+      real tauclb(m,n,np),tauclf(m,n,np),asycl(m,n,np)
+      real taurs,tauoz,tausto,ssatau,asysto,tauto,ssato,asyto
+      real taux,reff1,reff2,g1,g2
+      real td(m,n,np+1,2),rr(m,n,np+1,2),tt(m,n,np+1,2), &
+             rs(m,n,np+1,2),ts(m,n,np+1,2)
+      real fall(m,n,np+1),fclr(m,n,np+1),fsdir(m,n),fsdif(m,n)
+      real fallu(m,n,np+1),falld(m,n,np+1)
+      real asyclt(m,n)
+      real rr1t(m,n),tt1t(m,n),td1t(m,n),rs1t(m,n),ts1t(m,n)
+      real rr2t(m,n),tt2t(m,n),td2t(m,n),rs2t(m,n),ts2t(m,n)
+
+!-----hk is the fractional extra-terrestrial solar flux in each
+!     of the 8 bands.  the sum of hk is 0.47074.
+
+      data hk/.00057, .00367, .00083, .00417,  &
+              .00600, .00556, .05913, .39081/
+
+!-----xk is the ozone absorption coefficient. unit: /(cm-atm)stp
+
+      data xk /30.47, 187.2,  301.9,   42.83, &
+               7.09,  1.25,   0.0345,  0.0539/
+
+!-----ry is the extinction coefficient for Rayleigh scattering.
+!     unit: /mb.
+
+      data ry /.00604, .00170, .00222, .00132, &
+               .00107, .00091, .00055, .00012/
+
+!-----coefficients for computing the asymmetry factor of ice clouds
+!     from asycl=aig(*,1)+aig(*,2)*reff+aig(*,3)*reff**2, independent
+!     of spectral band.
+
+      data aig/.74625000,.00105410,-.00000264/
+
+!-----coefficients for computing the asymmetry factor of liquid
+!     clouds from asycl=awg(*,1)+awg(*,2)*reff+awg(*,3)*reff**2,
+!     independent of spectral band.
+
+      data awg/.82562000,.00529000,-.00014866/
+
+!-----initialize fdiruv, fdifuv, surface reflectances and transmittances.
+!     cc is the maximum cloud cover in each of the three cloud groups.
+            
+      do j= 1, n
+       do i= 1, m                    
+         fdiruv(i,j)=0.0
+         fdifuv(i,j)=0.0
+         rr(i,j,np+1,1)=rsuvbm(i,j)
+         rr(i,j,np+1,2)=rsuvbm(i,j)
+         rs(i,j,np+1,1)=rsuvdf(i,j)
+         rs(i,j,np+1,2)=rsuvdf(i,j)
+         td(i,j,np+1,1)=0.0
+         td(i,j,np+1,2)=0.0
+         tt(i,j,np+1,1)=0.0
+         tt(i,j,np+1,2)=0.0
+         ts(i,j,np+1,1)=0.0
+         ts(i,j,np+1,2)=0.0
+         cc(i,j,1)=0.0
+         cc(i,j,2)=0.0
+         cc(i,j,3)=0.0
+       enddo
+      enddo
+
+
+!-----compute cloud optical thickness
+
+      if (cldwater) then
+
+       do k= 1, np
+        do j= 1, n
+         do i= 1, m
+          taucld(i,j,k,1)=cwp(i,j,k,1)*( 3.33e-4+2.52/reff(i,j,k,1))
+          taucld(i,j,k,2)=cwp(i,j,k,2)*(-6.59e-3+1.65/reff(i,j,k,2))
+         enddo
+        enddo
+       enddo
+
+      endif
+
+!-----options for scaling cloud optical thickness
+
+      if (overcast) then
+
+       do k= 1, np
+        do j= 1, n
+         do i= 1, m
+          tauclb(i,j,k)=taucld(i,j,k,1)+taucld(i,j,k,2)
+          tauclf(i,j,k)=tauclb(i,j,k)
+         enddo
+        enddo
+       enddo
+
+       do k= 1, 3
+        do j= 1, n
+         do i= 1, m
+           cc(i,j,k)=1.0
+         enddo
+        enddo
+       enddo
+
+      else
+
+!-----scale cloud optical thickness in each layer from taucld (with
+!     cloud amount fcld) to tauclb and tauclf (with cloud amount cc).
+!     tauclb is the scaled optical thickness for beam radiation and
+!     tauclf is for diffuse radiation.
+
+       call cldscale(m,n,ndim,np,cosz,fcld,taucld,ict,icb,  &
+                    cc,tauclb,tauclf)
+
+      endif
+
+!-----compute cloud asymmetry factor for a mixture of
+!     liquid and ice particles.  unit of reff is micrometers.
+
+      do k= 1, np
+
+       do j= 1, n
+        do i= 1, m
+
+           asyclt(i,j)=1.0
+
+           taux=taucld(i,j,k,1)+taucld(i,j,k,2)
+          if (taux.gt.0.05 .and. fcld(i,j,k).gt.0.01) then
+
+           reff1=min(reff(i,j,k,1),130.)
+           reff2=min(reff(i,j,k,2),20.0)
+
+           g1=(aig(1)+(aig(2)+aig(3)*reff1)*reff1)*taucld(i,j,k,1)
+           g2=(awg(1)+(awg(2)+awg(3)*reff2)*reff2)*taucld(i,j,k,2)
+           asyclt(i,j)=(g1+g2)/taux
+
+          endif
+
+        enddo
+       enddo
+
+       do j=1,n
+        do i=1,m
+           asycl(i,j,k)=asyclt(i,j)
+        enddo
+       enddo
+
+      enddo
+
+!-----integration over spectral bands
+
+      do 100 ib=1,nband
+
+       do 300 k= 1, np
+
+        do j= 1, n
+         do i= 1, m
+
+!-----compute ozone and rayleigh optical thicknesses
+
+          taurs=ry(ib)*dp(i,j,k)
+          tauoz=xk(ib)*oh(i,j,k)
+ 
+!-----compute clear-sky optical thickness, single scattering albedo,
+!     and asymmetry factor
+
+          tausto=taurs+tauoz+taual(i,j,k,ib)+1.0e-8
+          ssatau=ssaal(i,j,k,ib)*taual(i,j,k,ib)+taurs
+          asysto=asyal(i,j,k,ib)*ssaal(i,j,k,ib)*taual(i,j,k,ib)
+
+          tauto=tausto
+          ssato=ssatau/tauto+1.0e-8
+          ssato=min(ssato,0.999999)
+          asyto=asysto/(ssato*tauto)
+
+!-----compute reflectance and transmittance for cloudless layers
+
+!-                 for direct incident radiation
+
+          call deledd (tauto,ssato,asyto,csm(i,j),  &
+                       rr1t(i,j),tt1t(i,j),td1t(i,j))
+
+!-                 for diffuse incident radiation
+
+          call sagpol (tauto,ssato,asyto,rs1t(i,j),ts1t(i,j))
+
+!-----compute reflectance and transmittance for cloud layers
+
+         if (tauclb(i,j,k).lt.0.01 .or. fcld(i,j,k).lt.0.01) then
+
+          rr2t(i,j)=rr1t(i,j)
+          tt2t(i,j)=tt1t(i,j)
+          td2t(i,j)=td1t(i,j)
+          rs2t(i,j)=rs1t(i,j)
+          ts2t(i,j)=ts1t(i,j)
+
+         else
+
+!--                for direct incident radiation
+
+          tauto=tausto+tauclb(i,j,k)
+          ssato=(ssatau+tauclb(i,j,k))/tauto+1.0e-8
+          ssato=min(ssato,0.999999)
+          asyto=(asysto+asycl(i,j,k)*tauclb(i,j,k))/(ssato*tauto)
+
+          call deledd (tauto,ssato,asyto,csm(i,j),  &
+                       rr2t(i,j),tt2t(i,j),td2t(i,j))
+
+!--                for diffuse incident radiation
+
+          tauto=tausto+tauclf(i,j,k)
+          ssato=(ssatau+tauclf(i,j,k))/tauto+1.0e-8
+          ssato=min(ssato,0.999999)
+          asyto=(asysto+asycl(i,j,k)*tauclf(i,j,k))/(ssato*tauto)
+
+          call sagpol (tauto,ssato,asyto,rs2t(i,j),ts2t(i,j))
+
+         endif
+
+        enddo
+       enddo
+
+        do j=1,n
+         do i=1,m
+            rr(i,j,k,1)=rr1t(i,j)
+         enddo
+        enddo
+        do j=1,n
+         do i=1,m
+            tt(i,j,k,1)=tt1t(i,j)
+         enddo
+        enddo
+        do j=1,n
+         do i=1,m
+            td(i,j,k,1)=td1t(i,j)
+         enddo
+        enddo
+        do j=1,n
+         do i=1,m
+            rs(i,j,k,1)=rs1t(i,j)
+         enddo
+        enddo
+        do j=1,n
+         do i=1,m
+            ts(i,j,k,1)=ts1t(i,j)
+         enddo
+        enddo
+
+        do j=1,n
+         do i=1,m
+            rr(i,j,k,2)=rr2t(i,j)
+         enddo
+        enddo
+        do j=1,n
+         do i=1,m
+            tt(i,j,k,2)=tt2t(i,j)
+         enddo
+        enddo
+        do j=1,n
+         do i=1,m
+            td(i,j,k,2)=td2t(i,j)
+         enddo
+        enddo
+        do j=1,n
+         do i=1,m
+            rs(i,j,k,2)=rs2t(i,j)
+         enddo
+        enddo
+        do j=1,n
+         do i=1,m
+            ts(i,j,k,2)=ts2t(i,j)
+         enddo
+        enddo
+
+ 300  continue
+
+!-----flux calculations
+ 
+        call cldflx (m,n,np,ict,icb,overcast,cc,rr,tt,td,rs,ts, &
+                     fclr,fall,fallu,falld,fsdir,fsdif)
+
+       do k= 1, np+1
+        do j= 1, n
+         do i= 1, m
+          flx(i,j,k)=flx(i,j,k)+fall(i,j,k)*hk(ib)
+          flxu(i,j,k)=flxu(i,j,k)+fallu(i,j,k)*hk(ib)
+          flxd(i,j,k)=flxd(i,j,k)+falld(i,j,k)*hk(ib)
+         enddo
+        enddo
+        do j= 1, n
+         do i= 1, m
+          flc(i,j,k)=flc(i,j,k)+fclr(i,j,k)*hk(ib)
+         enddo
+        enddo
+       enddo
+
+!-----compute downward surface fluxes in the UV and par regions
+
+       if(ib.lt.8) then
+         do j=1,n
+          do i=1,m
+           fdiruv(i,j)=fdiruv(i,j)+fsdir(i,j)*hk(ib)
+           fdifuv(i,j)=fdifuv(i,j)+fsdif(i,j)*hk(ib)
+         enddo
+        enddo
+       else
+         do j=1,n
+          do i=1,m
+           fdirpar(i,j)=fsdir(i,j)*hk(ib)
+           fdifpar(i,j)=fsdif(i,j)*hk(ib)
+         enddo
+        enddo
+       endif
+
+ 100  continue
+
+      end subroutine soluv
+
+!************************************************************************
+
+      subroutine solir (m,n,ndim,np,wh,overcast,cldwater,               &
+                        cwp,taucld,reff,ict,icb,fcld,cosz,              &
+                        taual,ssaal,asyal,csm,rsirbm,rsirdf,            &
+                        flx,flc,flxu,flxd,fdirir,fdifir)
+
+!************************************************************************
+!  compute solar flux in the infrared region. The spectrum is divided
+!   into three bands:
+!
+!          band   wavenumber(/cm)  wavelength (micron)
+!          1( 9)    14300-8200         0.70-1.22
+!          2(10)     8200-4400         1.22-2.27
+!          3(11)     4400-1000         2.27-10.0
+!
+!----- Input parameters:                            units      size
+!
+!  number of soundings in zonal direction (m)       n/d        1
+!  number of soundings in meridional direction (n)  n/d        1
+!  maximum number of soundings in                   n/d        1
+!         meridional direction (ndim)
+!  number of atmospheric layers (np)                n/d        1
+!  layer scaled-water vapor content (wh)          gm/cm^2    m*n*np
+!  option for scaling cloud optical thickness       n/d        1
+!        overcast="true" if scaling is NOT required
+!        overcast="fasle" if scaling is required
+!  input option for cloud optical thickness         n/d        1
+!        cldwater="true" if taucld is provided
+!        cldwater="false" if cwp is provided
+!  cloud water concentration (cwp)                gm/m**2    m*n*np*2
+!        index 1 for ice particles
+!        index 2 for liquid drops
+!  cloud optical thickness (taucld)                 n/d      m*ndim*np*2
+!        index 1 for ice paticles
+!  effective cloud-particle size (reff)           micrometer m*ndim*np*2
+!        index 1 for ice paticles
+!        index 2 for liquid particles
+!  level index separating high and                  n/d      m*n
+!        middle clouds (ict)
+!  level index separating middle and                n/d      m*n
+!        low clouds (icb)
+!  cloud amount (fcld)                            fraction   m*ndim*np
+!  aerosol optical thickness (taual)                n/d      m*ndim*np*11
+!  aerosol single-scattering albedo (ssaal)         n/d      m*ndim*np*11
+!  aerosol asymmetry factor (asyal)                 n/d      m*ndim*np*11 
+!  cosecant of the solar zenith angle (csm)         n/d      m*n
+!  near ir surface albedo for beam                fraction   m*ndim
+!        radiation (rsirbm)
+!  near ir surface albedo for diffuse             fraction   m*ndim
+!        radiation (rsirdf)
+!
+!---- temporary array
+!
+!  scaled cloud optical thickness                   n/d      m*n*np
+!          for beam radiation (tauclb)
+!  scaled cloud optical thickness                   n/d      m*n*np
+!          for diffuse radiation  (tauclf)     
+!
+!----- output (updated) parameters:
+!
+!  all-sky flux (downward-upward) (flx)           fraction   m*ndim*(np+1)
+!  clear-sky flux (downward-upward) (flc)         fraction   m*ndim*(np+1)
+!  all-sky direct downward ir flux at
+!          the surface (fdirir)                    fraction   m*ndim
+!  all-sky diffuse downward ir flux at
+!          the surface (fdifir)                    fraction   m*ndim
+!
+!**********************************************************************
+      implicit none
+!**********************************************************************
+
+!-----input parameters
+
+      integer m,n,ndim,np
+      integer ict(m,ndim),icb(m,ndim)
+      real cwp(m,n,np,2),taucld(m,ndim,np,2),reff(m,ndim,np,2)
+      real fcld(m,ndim,np),cc(m,n,3),cosz(m,ndim)
+      real rsirbm(m,ndim),rsirdf(m,ndim)
+      real taual(m,ndim,np,11),ssaal(m,ndim,np,11),asyal(m,ndim,np,11)
+      real wh(m,n,np),csm(m,n)
+      logical overcast,cldwater
+
+!-----output (updated) parameters
+
+      real flx(m,ndim,np+1),flc(m,ndim,np+1)
+      real flxu(m,ndim,np+1),flxd(m,ndim,np+1)
+      real fdirir(m,ndim),fdifir(m,ndim)
+
+!-----static parameters
+
+      integer nk,nband
+      parameter (nk=10,nband=3)
+      real xk(nk),hk(nband,nk),aib(nband,2),awb(nband,2)
+      real aia(nband,3),awa(nband,3),aig(nband,3),awg(nband,3)
+
+!-----temporary array
+
+      integer ib,iv,ik,i,j,k
+      real tauclb(m,n,np),tauclf(m,n,np)
+      real ssacl(m,n,np),asycl(m,n,np)
+      real rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2), &
+             rs(m,n,np+1,2),ts(m,n,np+1,2)
+      real fall(m,n,np+1),fclr(m,n,np+1)
+      real fallu(m,n,np+1),falld(m,n,np+1)
+      real fsdir(m,n),fsdif(m,n)
+
+      real tauwv,tausto,ssatau,asysto,tauto,ssato,asyto
+      real taux,reff1,reff2,w1,w2,g1,g2
+      real ssaclt(m,n),asyclt(m,n)
+      real rr1t(m,n),tt1t(m,n),td1t(m,n),rs1t(m,n),ts1t(m,n)
+      real rr2t(m,n),tt2t(m,n),td2t(m,n),rs2t(m,n),ts2t(m,n)
+
+!-----water vapor absorption coefficient for 10 k-intervals.
+!     unit: cm^2/gm
+
+      data xk/  &
+        0.0010, 0.0133, 0.0422, 0.1334, 0.4217, &
+        1.334,  5.623,  31.62,  177.8,  1000.0/  
+
+!-----water vapor k-distribution function,
+!     the sum of hk is 0.52926. unit: fraction
+
+      data hk/  &
+       .20673,.08236,.01074,  .03497,.01157,.00360, &
+       .03011,.01133,.00411,  .02260,.01143,.00421, &
+       .01336,.01240,.00389,  .00696,.01258,.00326, &
+       .00441,.01381,.00499,  .00115,.00650,.00465, &
+       .00026,.00244,.00245,  .00000,.00094,.00145/
+
+!-----coefficients for computing the extinction coefficient of
+!     ice clouds from b=aib(*,1)+aib(*,2)/reff
+
+      data aib/ &
+        .000333, .000333, .000333, &
+           2.52,    2.52,    2.52/
+
+!-----coefficients for computing the extinction coefficient of
+!     water clouds from b=awb(*,1)+awb(*,2)/reff
+
+      data awb/ &
+        -0.0101, -0.0166, -0.0339, &
+           1.72,    1.85,    2.16/
+
+
+!-----coefficients for computing the single scattering albedo of
+!     ice clouds from ssa=1-(aia(*,1)+aia(*,2)*reff+aia(*,3)*reff**2)
+
+      data aia/ &
+       -.00000260, .00215346, .08938331, &
+        .00000746, .00073709, .00299387, &
+        .00000000,-.00000134,-.00001038/
+
+!-----coefficients for computing the single scattering albedo of
+!     liquid clouds from ssa=1-(awa(*,1)+awa(*,2)*reff+awa(*,3)*reff**2)
+
+      data awa/ &
+        .00000007,-.00019934, .01209318, &
+        .00000845, .00088757, .01784739, &
+       -.00000004,-.00000650,-.00036910/
+
+!-----coefficients for computing the asymmetry factor of ice clouds
+!     from asycl=aig(*,1)+aig(*,2)*reff+aig(*,3)*reff**2
+
+      data aig/ &
+        .74935228, .76098937, .84090400, &
+        .00119715, .00141864, .00126222, &
+       -.00000367,-.00000396,-.00000385/
+
+!-----coefficients for computing the asymmetry factor of liquid clouds
+!     from asycl=awg(*,1)+awg(*,2)*reff+awg(*,3)*reff**2
+
+      data awg/ &
+        .79375035, .74513197, .83530748, &
+        .00832441, .01370071, .00257181, &
+       -.00023263,-.00038203, .00005519/
+
+!-----initialize surface fluxes, reflectances, and transmittances.
+!     cc is the maximum cloud cover in each of the three cloud groups.
+
+      do j= 1, n
+       do i= 1, m
+         fdirir(i,j)=0.0
+         fdifir(i,j)=0.0
+         rr(i,j,np+1,1)=rsirbm(i,j)
+         rr(i,j,np+1,2)=rsirbm(i,j)
+         rs(i,j,np+1,1)=rsirdf(i,j)
+         rs(i,j,np+1,2)=rsirdf(i,j)
+         td(i,j,np+1,1)=0.0
+         td(i,j,np+1,2)=0.0
+         tt(i,j,np+1,1)=0.0
+         tt(i,j,np+1,2)=0.0
+         ts(i,j,np+1,1)=0.0
+         ts(i,j,np+1,2)=0.0
+         cc(i,j,1)=0.0
+         cc(i,j,2)=0.0
+         cc(i,j,3)=0.0
+       enddo
+      enddo
+
+!-----integration over spectral bands
+
+      do 100 ib=1,nband
+
+       iv=ib+8
+
+!-----compute cloud optical thickness
+
+      if (cldwater) then
+
+       do k= 1, np
+        do j= 1, n
+         do i= 1, m
+          taucld(i,j,k,1)=cwp(i,j,k,1)*(aib(ib,1) &
+                          +aib(ib,2)/reff(i,j,k,1))
+          taucld(i,j,k,2)=cwp(i,j,k,2)*(awb(ib,1) &
+                          +awb(ib,2)/reff(i,j,k,2))
+         enddo
+        enddo
+       enddo
+
+      endif
+
+!-----options for scaling cloud optical thickness
+
+      if (overcast) then
+
+       do k= 1, np
+        do j= 1, n
+         do i= 1, m
+          tauclb(i,j,k)=taucld(i,j,k,1)+taucld(i,j,k,2)
+          tauclf(i,j,k)=tauclb(i,j,k)
+         enddo
+        enddo
+       enddo
+
+       do k= 1, 3
+        do j= 1, n
+         do i= 1, m
+           cc(i,j,k)=1.0
+         enddo
+        enddo
+       enddo
+
+      else
+
+!-----scale cloud optical thickness in each layer from taucld (with
+!     cloud amount fcld) to tauclb and tauclf (with cloud amount cc).
+!     tauclb is the scaled optical thickness for beam radiation and
+!     tauclf is for diffuse radiation.
+
+       call cldscale(m,n,ndim,np,cosz,fcld,taucld,ict,icb, &
+                    cc,tauclb,tauclf)
+
+      endif
+
+!-----compute cloud single scattering albedo and asymmetry factor
+!     for a mixture of ice and liquid particles.
+
+       do k= 1, np
+
+        do j= 1, n
+         do i= 1, m
+
+           ssaclt(i,j)=1.0
+           asyclt(i,j)=1.0
+
+           taux=taucld(i,j,k,1)+taucld(i,j,k,2)
+          if (taux.gt.0.05 .and. fcld(i,j,k).gt.0.01) then
+
+           reff1=min(reff(i,j,k,1),130.)
+           reff2=min(reff(i,j,k,2),20.0)
+
+           w1=(1.-(aia(ib,1)+(aia(ib,2)+ &
+               aia(ib,3)*reff1)*reff1))*taucld(i,j,k,1)
+           w2=(1.-(awa(ib,1)+(awa(ib,2)+ &
+               awa(ib,3)*reff2)*reff2))*taucld(i,j,k,2)
+           ssaclt(i,j)=(w1+w2)/taux
+
+           g1=(aig(ib,1)+(aig(ib,2)+aig(ib,3)*reff1)*reff1)*w1
+           g2=(awg(ib,1)+(awg(ib,2)+awg(ib,3)*reff2)*reff2)*w2
+           asyclt(i,j)=(g1+g2)/(w1+w2)
+
+          endif
+
+         enddo
+        enddo
+
+        do j=1,n
+         do i=1,m
+            ssacl(i,j,k)=ssaclt(i,j)
+         enddo
+        enddo
+        do j=1,n
+         do i=1,m
+            asycl(i,j,k)=asyclt(i,j)
+         enddo
+        enddo
+
+       enddo
+
+!-----integration over the k-distribution function
+
+         do 200 ik=1,nk
+
+          do 300 k= 1, np
+
+           do j= 1, n
+            do i= 1, m
+
+             tauwv=xk(ik)*wh(i,j,k)
+ 
+!-----compute clear-sky optical thickness, single scattering albedo,
+!     and asymmetry factor.
+ 
+             tausto=tauwv+taual(i,j,k,iv)+1.0e-8
+             ssatau=ssaal(i,j,k,iv)*taual(i,j,k,iv)
+             asysto=asyal(i,j,k,iv)*ssaal(i,j,k,iv)*taual(i,j,k,iv)
+ 
+!-----compute reflectance and transmittance for cloudless layers
+
+             tauto=tausto
+             ssato=ssatau/tauto+1.0e-8
+
+            if (ssato .gt. 0.001) then
+
+             ssato=min(ssato,0.999999)
+             asyto=asysto/(ssato*tauto)
+
+!-                 for direct incident radiation
+
+             call deledd (tauto,ssato,asyto,csm(i,j),  &
+                          rr1t(i,j),tt1t(i,j),td1t(i,j))
+
+!-                 for diffuse incident radiation
+
+             call sagpol (tauto,ssato,asyto,rs1t(i,j),ts1t(i,j))
+
+            else
+
+             td1t(i,j)=exp(-tauto*csm(i,j))
+             ts1t(i,j)=exp(-1.66*tauto)
+             tt1t(i,j)=0.0
+             rr1t(i,j)=0.0
+             rs1t(i,j)=0.0
+
+            endif
+
+!-----compute reflectance and transmittance for cloud layers
+
+            if (tauclb(i,j,k).lt.0.01 .or. fcld(i,j,k).lt.0.01) then
+
+             rr2t(i,j)=rr1t(i,j)
+             tt2t(i,j)=tt1t(i,j)
+             td2t(i,j)=td1t(i,j)
+             rs2t(i,j)=rs1t(i,j)
+             ts2t(i,j)=ts1t(i,j)
+
+            else
+
+!-                 for direct incident radiation
+
+             tauto=tausto+tauclb(i,j,k)
+             ssato=(ssatau+ssacl(i,j,k)*tauclb(i,j,k))/tauto+1.0e-8
+             ssato=min(ssato,0.999999)
+             asyto=(asysto+asycl(i,j,k)*ssacl(i,j,k)*tauclb(i,j,k))/ &
+                   (ssato*tauto)
+
+             call deledd (tauto,ssato,asyto,csm(i,j),  &
+                          rr2t(i,j),tt2t(i,j),td2t(i,j))
+
+!-                 for diffuse incident radiation
+
+             tauto=tausto+tauclf(i,j,k)
+             ssato=(ssatau+ssacl(i,j,k)*tauclf(i,j,k))/tauto+1.0e-8
+             ssato=min(ssato,0.999999)
+             asyto=(asysto+asycl(i,j,k)*ssacl(i,j,k)*tauclf(i,j,k))/ &
+                   (ssato*tauto)
+
+             call sagpol (tauto,ssato,asyto,rs2t(i,j),ts2t(i,j))
+
+            endif
+
+           enddo
+          enddo
+
+           do j=1,n
+            do i=1,m
+               rr(i,j,k,1)=rr1t(i,j)
+            enddo
+           enddo
+           do j=1,n
+            do i=1,m
+               tt(i,j,k,1)=tt1t(i,j)
+            enddo
+           enddo
+           do j=1,n
+            do i=1,m
+               td(i,j,k,1)=td1t(i,j)
+            enddo
+           enddo
+           do j=1,n
+            do i=1,m
+               rs(i,j,k,1)=rs1t(i,j)
+            enddo
+           enddo
+           do j=1,n
+            do i=1,m
+               ts(i,j,k,1)=ts1t(i,j)
+            enddo
+           enddo
+ 
+           do j=1,n
+            do i=1,m
+               rr(i,j,k,2)=rr2t(i,j)
+            enddo
+           enddo
+           do j=1,n
+            do i=1,m
+               tt(i,j,k,2)=tt2t(i,j)
+            enddo
+           enddo
+           do j=1,n
+            do i=1,m
+               td(i,j,k,2)=td2t(i,j)
+            enddo
+           enddo
+           do j=1,n
+            do i=1,m
+               rs(i,j,k,2)=rs2t(i,j)
+            enddo
+           enddo
+           do j=1,n
+            do i=1,m
+               ts(i,j,k,2)=ts2t(i,j)
+            enddo
+           enddo
+
+ 300  continue
+
+!-----flux calculations
+
+        call cldflx (m,n,np,ict,icb,overcast,cc,rr,tt,td,rs,ts, &
+                     fclr,fall,fallu,falld,fsdir,fsdif)
+
+       do k= 1, np+1
+        do j= 1, n
+         do i= 1, m
+          flx(i,j,k) = flx(i,j,k)+fall(i,j,k)*hk(ib,ik)
+          flxu(i,j,k) = flxu(i,j,k)+fallu(i,j,k)*hk(ib,ik)
+          flxd(i,j,k) = flxd(i,j,k)+falld(i,j,k)*hk(ib,ik)
+         enddo
+        enddo
+        do j= 1, n
+         do i= 1, m
+          flc(i,j,k) = flc(i,j,k)+fclr(i,j,k)*hk(ib,ik)
+         enddo
+        enddo
+       enddo
+
+!-----compute downward surface fluxes in the ir region
+
+       do j= 1, n
+        do i= 1, m
+          fdirir(i,j) = fdirir(i,j)+fsdir(i,j)*hk(ib,ik)
+          fdifir(i,j) = fdifir(i,j)+fsdif(i,j)*hk(ib,ik)
+        enddo
+       enddo
+
+  200 continue
+  100 continue
+ 
+      end subroutine solir 
+
+!********************************************************************
+
+      subroutine cldscale (m,n,ndim,np,cosz,fcld,taucld,ict,icb,    &
+                           cc,tauclb,tauclf)
+
+!********************************************************************
+!
+!   This subroutine computes the high, middle, and
+!    low cloud amounts and scales the cloud optical thickness.
+!
+!   To simplify calculations in a cloudy atmosphere, clouds are
+!    grouped into high, middle and low clouds separated by the levels
+!    ict and icb (level 1 is the top of the model atmosphere).
+!
+!   Within each of the three groups, clouds are assumed maximally
+!    overlapped, and the cloud cover (cc) of a group is the maximum
+!    cloud cover of all the layers in the group.  The optical thickness
+!    (taucld) of a given layer is then scaled to new values (tauclb and
+!    tauclf) so that the layer reflectance corresponding to the cloud
+!    cover cc is the same as the original reflectance with optical
+!    thickness taucld and cloud cover fcld.
+!
+!---input parameters
+!
+!    number of grid intervals in zonal direction (m)
+!    number of grid intervals in meridional direction (n)
+!    maximum number of grid intervals in meridional direction (ndim)
+!    number of atmospheric layers (np)
+!    cosine of the solar zenith angle (cosz)
+!    fractional cloud cover (fcld)
+!    cloud optical thickness (taucld)
+!    index separating high and middle clouds (ict)
+!    index separating middle and low clouds (icb)
+!
+!---output parameters
+!
+!    fractional cover of high, middle, and low clouds (cc)
+!    scaled cloud optical thickness for beam radiation (tauclb)
+!    scaled cloud optical thickness for diffuse radiation (tauclf)
+!
+!********************************************************************
+      implicit none
+!********************************************************************
+
+!-----input parameters
+
+      integer m,n,ndim,np
+      integer ict(m,ndim),icb(m,ndim)
+      real cosz(m,ndim),fcld(m,ndim,np),taucld(m,ndim,np,2)
+
+!-----output parameters
+
+      real cc(m,n,3),tauclb(m,n,np),tauclf(m,n,np)
+
+!-----temporary variables
+
+      integer i,j,k,im,it,ia,kk
+      real  fm,ft,fa,xai,taux
+
+!-----pre-computed table
+
+      integer   nm,nt,na
+      parameter (nm=11,nt=9,na=11) 
+      real  dm,dt,da,t1,caib(nm,nt,na),caif(nt,na)
+      parameter (dm=0.1,dt=0.30103,da=0.1,t1=-0.9031)
+
+!-----include the pre-computed table of mcai for scaling the cloud optical
+!     thickness under the assumption that clouds are maximally overlapped
+!
+!     caib is for scaling the cloud optical thickness for direct radiation
+!     caif is for scaling the cloud optical thickness for diffuse radiation
+
+
+      data ((caib(1,i,j),j=1,11),i=1,9)/  &
+       .000,0.068,0.140,0.216,0.298,0.385,0.481,0.586,0.705,0.840,1.000, &
+       .000,0.052,0.106,0.166,0.230,0.302,0.383,0.478,0.595,0.752,1.000, &
+       .000,0.038,0.078,0.120,0.166,0.218,0.276,0.346,0.438,0.582,1.000, &
+       .000,0.030,0.060,0.092,0.126,0.164,0.206,0.255,0.322,0.442,1.000, &
+       .000,0.025,0.051,0.078,0.106,0.136,0.170,0.209,0.266,0.462,1.000, &
+       .000,0.023,0.046,0.070,0.095,0.122,0.150,0.187,0.278,0.577,1.000, &
+       .000,0.022,0.043,0.066,0.089,0.114,0.141,0.187,0.354,0.603,1.000, &
+       .000,0.021,0.042,0.063,0.086,0.108,0.135,0.214,0.349,0.565,1.000, &
+       .000,0.021,0.041,0.062,0.083,0.105,0.134,0.202,0.302,0.479,1.000/
+      data ((caib(2,i,j),j=1,11),i=1,9)/ &
+       .000,0.088,0.179,0.272,0.367,0.465,0.566,0.669,0.776,0.886,1.000, &
+       .000,0.079,0.161,0.247,0.337,0.431,0.531,0.637,0.749,0.870,1.000, &
+       .000,0.065,0.134,0.207,0.286,0.372,0.466,0.572,0.692,0.831,1.000, &
+       .000,0.049,0.102,0.158,0.221,0.290,0.370,0.465,0.583,0.745,1.000, &
+       .000,0.037,0.076,0.118,0.165,0.217,0.278,0.354,0.459,0.638,1.000, &
+       .000,0.030,0.061,0.094,0.130,0.171,0.221,0.286,0.398,0.631,1.000, &
+       .000,0.026,0.052,0.081,0.111,0.146,0.189,0.259,0.407,0.643,1.000, &
+       .000,0.023,0.047,0.072,0.098,0.129,0.170,0.250,0.387,0.598,1.000, &
+       .000,0.022,0.044,0.066,0.090,0.118,0.156,0.224,0.328,0.508,1.000/
+      data ((caib(3,i,j),j=1,11),i=1,9)/ &
+       .000,0.094,0.189,0.285,0.383,0.482,0.582,0.685,0.788,0.894,1.000, &
+       .000,0.088,0.178,0.271,0.366,0.465,0.565,0.669,0.776,0.886,1.000, &
+       .000,0.079,0.161,0.247,0.337,0.431,0.531,0.637,0.750,0.870,1.000, &
+       .000,0.066,0.134,0.209,0.289,0.375,0.470,0.577,0.697,0.835,1.000, &
+       .000,0.050,0.104,0.163,0.227,0.300,0.383,0.483,0.606,0.770,1.000, &
+       .000,0.038,0.080,0.125,0.175,0.233,0.302,0.391,0.518,0.710,1.000, &
+       .000,0.031,0.064,0.100,0.141,0.188,0.249,0.336,0.476,0.689,1.000, &
+       .000,0.026,0.054,0.084,0.118,0.158,0.213,0.298,0.433,0.638,1.000, &
+       .000,0.023,0.048,0.074,0.102,0.136,0.182,0.254,0.360,0.542,1.000/
+      data ((caib(4,i,j),j=1,11),i=1,9)/ &
+       .000,0.096,0.193,0.290,0.389,0.488,0.589,0.690,0.792,0.896,1.000, &
+       .000,0.092,0.186,0.281,0.378,0.477,0.578,0.680,0.785,0.891,1.000, &
+       .000,0.086,0.174,0.264,0.358,0.455,0.556,0.660,0.769,0.882,1.000, &
+       .000,0.074,0.153,0.235,0.323,0.416,0.514,0.622,0.737,0.862,1.000, &
+       .000,0.061,0.126,0.195,0.271,0.355,0.449,0.555,0.678,0.823,1.000, &
+       .000,0.047,0.098,0.153,0.215,0.286,0.370,0.471,0.600,0.770,1.000, &
+       .000,0.037,0.077,0.120,0.170,0.230,0.303,0.401,0.537,0.729,1.000, &
+       .000,0.030,0.062,0.098,0.138,0.187,0.252,0.343,0.476,0.673,1.000, &
+       .000,0.026,0.053,0.082,0.114,0.154,0.207,0.282,0.391,0.574,1.000/
+      data ((caib(5,i,j),j=1,11),i=1,9)/ &
+       .000,0.097,0.194,0.293,0.392,0.492,0.592,0.693,0.794,0.897,1.000, &
+       .000,0.094,0.190,0.286,0.384,0.483,0.584,0.686,0.789,0.894,1.000, &
+       .000,0.090,0.181,0.274,0.370,0.468,0.569,0.672,0.778,0.887,1.000, &
+       .000,0.081,0.165,0.252,0.343,0.439,0.539,0.645,0.757,0.874,1.000, &
+       .000,0.069,0.142,0.218,0.302,0.392,0.490,0.598,0.717,0.850,1.000, &
+       .000,0.054,0.114,0.178,0.250,0.330,0.422,0.529,0.656,0.810,1.000, &
+       .000,0.042,0.090,0.141,0.200,0.269,0.351,0.455,0.589,0.764,1.000, &
+       .000,0.034,0.070,0.112,0.159,0.217,0.289,0.384,0.515,0.703,1.000, &
+       .000,0.028,0.058,0.090,0.128,0.174,0.231,0.309,0.420,0.602,1.000/
+      data ((caib(6,i,j),j=1,11),i=1,9)/ &
+       .000,0.098,0.196,0.295,0.394,0.494,0.594,0.695,0.796,0.898,1.000, &
+       .000,0.096,0.193,0.290,0.389,0.488,0.588,0.690,0.792,0.895,1.000, &
+       .000,0.092,0.186,0.281,0.378,0.477,0.577,0.680,0.784,0.891,1.000, &
+       .000,0.086,0.174,0.264,0.358,0.455,0.556,0.661,0.769,0.882,1.000, &
+       .000,0.075,0.154,0.237,0.325,0.419,0.518,0.626,0.741,0.865,1.000, &
+       .000,0.062,0.129,0.201,0.279,0.366,0.462,0.571,0.694,0.836,1.000, &
+       .000,0.049,0.102,0.162,0.229,0.305,0.394,0.501,0.631,0.793,1.000, &
+       .000,0.038,0.080,0.127,0.182,0.245,0.323,0.422,0.550,0.730,1.000, &
+       .000,0.030,0.064,0.100,0.142,0.192,0.254,0.334,0.448,0.627,1.000/
+      data ((caib(7,i,j),j=1,11),i=1,9)/ &
+       .000,0.098,0.198,0.296,0.396,0.496,0.596,0.696,0.797,0.898,1.000, &
+       .000,0.097,0.194,0.293,0.392,0.491,0.591,0.693,0.794,0.897,1.000, &
+       .000,0.094,0.190,0.286,0.384,0.483,0.583,0.686,0.789,0.894,1.000, &
+       .000,0.089,0.180,0.274,0.369,0.467,0.568,0.672,0.778,0.887,1.000, &
+       .000,0.081,0.165,0.252,0.344,0.440,0.541,0.646,0.758,0.875,1.000, &
+       .000,0.069,0.142,0.221,0.306,0.397,0.496,0.604,0.722,0.854,1.000, &
+       .000,0.056,0.116,0.182,0.256,0.338,0.432,0.540,0.666,0.816,1.000, &
+       .000,0.043,0.090,0.143,0.203,0.273,0.355,0.455,0.583,0.754,1.000, &
+       .000,0.034,0.070,0.111,0.157,0.210,0.276,0.359,0.474,0.650,1.000/
+      data ((caib(8,i,j),j=1,11),i=1,9)/ &
+       .000,0.099,0.198,0.298,0.398,0.497,0.598,0.698,0.798,0.899,1.000, &
+       .000,0.098,0.196,0.295,0.394,0.494,0.594,0.695,0.796,0.898,1.000, &
+       .000,0.096,0.193,0.290,0.390,0.489,0.589,0.690,0.793,0.896,1.000, &
+       .000,0.093,0.186,0.282,0.379,0.478,0.578,0.681,0.786,0.892,1.000, &
+       .000,0.086,0.175,0.266,0.361,0.458,0.558,0.663,0.771,0.883,1.000, &
+       .000,0.076,0.156,0.240,0.330,0.423,0.523,0.630,0.744,0.867,1.000, &
+       .000,0.063,0.130,0.203,0.282,0.369,0.465,0.572,0.694,0.834,1.000, &
+       .000,0.049,0.102,0.161,0.226,0.299,0.385,0.486,0.611,0.774,1.000, &
+       .000,0.038,0.078,0.122,0.172,0.229,0.297,0.382,0.498,0.672,1.000/
+      data ((caib(9,i,j),j=1,11),i=1,9)/ &
+       .000,0.099,0.199,0.298,0.398,0.498,0.598,0.699,0.799,0.899,1.000, &
+       .000,0.099,0.198,0.298,0.398,0.497,0.598,0.698,0.798,0.899,1.000, &
+       .000,0.098,0.196,0.295,0.394,0.494,0.594,0.695,0.796,0.898,1.000, &
+       .000,0.096,0.193,0.290,0.389,0.488,0.588,0.690,0.792,0.895,1.000, &
+       .000,0.092,0.185,0.280,0.376,0.474,0.575,0.678,0.782,0.890,1.000, &
+       .000,0.084,0.170,0.259,0.351,0.447,0.547,0.652,0.762,0.878,1.000, &
+       .000,0.071,0.146,0.224,0.308,0.398,0.494,0.601,0.718,0.850,1.000, &
+       .000,0.056,0.114,0.178,0.248,0.325,0.412,0.514,0.638,0.793,1.000, &
+       .000,0.042,0.086,0.134,0.186,0.246,0.318,0.405,0.521,0.691,1.000/
+      data ((caib(10,i,j),j=1,11),i=1,9)/ &
+       .000,0.100,0.200,0.300,0.400,0.500,0.600,0.700,0.800,0.900,1.000, &
+       .000,0.100,0.200,0.300,0.400,0.500,0.600,0.700,0.800,0.900,1.000, &
+       .000,0.100,0.200,0.300,0.400,0.500,0.600,0.700,0.800,0.900,1.000, &
+       .000,0.100,0.199,0.298,0.398,0.498,0.598,0.698,0.798,0.899,1.000, &
+       .000,0.098,0.196,0.294,0.392,0.491,0.590,0.691,0.793,0.896,1.000, &
+       .000,0.092,0.185,0.278,0.374,0.470,0.570,0.671,0.777,0.886,1.000, &
+       .000,0.081,0.162,0.246,0.333,0.424,0.521,0.625,0.738,0.862,1.000, &
+       .000,0.063,0.128,0.196,0.270,0.349,0.438,0.540,0.661,0.809,1.000, &
+       .000,0.046,0.094,0.146,0.202,0.264,0.337,0.426,0.542,0.710,1.000/ 
+      data ((caib(11,i,j),j=1,11),i=1,9)/ &
+       .000,0.101,0.202,0.302,0.402,0.502,0.602,0.702,0.802,0.901,1.000, &
+       .000,0.102,0.202,0.303,0.404,0.504,0.604,0.703,0.802,0.902,1.000, &
+       .000,0.102,0.205,0.306,0.406,0.506,0.606,0.706,0.804,0.902,1.000, &
+       .000,0.104,0.207,0.309,0.410,0.510,0.609,0.707,0.805,0.902,1.000, &
+       .000,0.106,0.208,0.309,0.409,0.508,0.606,0.705,0.803,0.902,1.000, &
+       .000,0.102,0.202,0.298,0.395,0.493,0.590,0.690,0.790,0.894,1.000, &
+       .000,0.091,0.179,0.267,0.357,0.449,0.545,0.647,0.755,0.872,1.000, &
+       .000,0.073,0.142,0.214,0.290,0.372,0.462,0.563,0.681,0.822,1.000, &
+       .000,0.053,0.104,0.158,0.217,0.281,0.356,0.446,0.562,0.726,1.000/
+      data ((caif(i,j),j=1,11),i=1,9)/ &
+       .000,0.099,0.198,0.297,0.397,0.496,0.597,0.697,0.798,0.899,1.000, &
+       .000,0.098,0.196,0.294,0.394,0.494,0.594,0.694,0.796,0.898,1.000, &
+       .000,0.096,0.192,0.290,0.388,0.487,0.587,0.689,0.792,0.895,1.000, &
+       .000,0.092,0.185,0.280,0.376,0.476,0.576,0.678,0.783,0.890,1.000, &
+       .000,0.085,0.173,0.263,0.357,0.454,0.555,0.659,0.768,0.881,1.000, &
+       .000,0.076,0.154,0.237,0.324,0.418,0.517,0.624,0.738,0.864,1.000, &
+       .000,0.063,0.131,0.203,0.281,0.366,0.461,0.567,0.688,0.830,1.000, &
+       .000,0.052,0.107,0.166,0.232,0.305,0.389,0.488,0.610,0.770,1.000, &
+       .000,0.043,0.088,0.136,0.189,0.248,0.317,0.400,0.510,0.675,1.000/
+
+!-----clouds within each of the high, middle, and low clouds are assumed
+!     to be maximally overlapped, and the cloud cover (cc) for a group
+!     (high, middle, or low) is the maximum cloud cover of all the layers
+!     within a group
+
+      do j=1,n
+       do i=1,m
+         cc(i,j,1)=0.0
+         cc(i,j,2)=0.0
+         cc(i,j,3)=0.0
+       enddo
+      enddo
+      do j=1,n
+       do i=1,m
+        do k=1,ict(i,j)-1
+          cc(i,j,1)=max(cc(i,j,1),fcld(i,j,k))
+        enddo
+       enddo
+      enddo
+
+      do j=1,n
+       do i=1,m
+        do k=ict(i,j),icb(i,j)-1
+          cc(i,j,2)=max(cc(i,j,2),fcld(i,j,k))
+        enddo
+       enddo
+      enddo
+
+      do j=1,n
+       do i=1,m
+        do k=icb(i,j),np
+          cc(i,j,3)=max(cc(i,j,3),fcld(i,j,k))
+        enddo
+       enddo
+      enddo
+
+!-----scale the cloud optical thickness.
+!     taucld(i,j,k,1) is the optical thickness for ice particles, and
+!     taucld(i,j,k,2) is the optical thickness for liquid particles.
+      
+      do j=1,n
+       do i=1,m
+
+        do k=1,np
+
+         if(k.lt.ict(i,j)) then
+            kk=1
+         elseif(k.ge.ict(i,j) .and. k.lt.icb(i,j)) then
+            kk=2
+         else
+            kk=3
+         endif
+
+         tauclb(i,j,k) = 0.0
+         tauclf(i,j,k) = 0.0
+
+         taux=taucld(i,j,k,1)+taucld(i,j,k,2)
+         if (taux.gt.0.05 .and. fcld(i,j,k).gt.0.01) then
+
+!-----normalize cloud cover
+
+           fa=fcld(i,j,k)/cc(i,j,kk)
+
+!-----table look-up
+
+           taux=min(taux,32.)
+
+           fm=cosz(i,j)/dm
+           ft=(log10(taux)-t1)/dt
+           fa=fa/da
+ 
+           im=int(fm+1.5)
+           it=int(ft+1.5)
+           ia=int(fa+1.5)
+  
+           im=max(im,2)
+           it=max(it,2)
+           ia=max(ia,2)
+     
+           im=min(im,nm-1)
+           it=min(it,nt-1)
+           ia=min(ia,na-1)
+
+           fm=fm-float(im-1)
+           ft=ft-float(it-1)
+           fa=fa-float(ia-1)
+
+!-----scale cloud optical thickness for beam radiation.
+!     the scaling factor, xai, is a function of the solar zenith
+!     angle, optical thickness, and cloud cover.
+ 
+           xai=    (-caib(im-1,it,ia)*(1.-fm)+ &
+            caib(im+1,it,ia)*(1.+fm))*fm*.5+caib(im,it,ia)*(1.-fm*fm)
+         
+           xai=xai+(-caib(im,it-1,ia)*(1.-ft)+ &
+            caib(im,it+1,ia)*(1.+ft))*ft*.5+caib(im,it,ia)*(1.-ft*ft)
+
+           xai=xai+(-caib(im,it,ia-1)*(1.-fa)+ &
+           caib(im,it,ia+1)*(1.+fa))*fa*.5+caib(im,it,ia)*(1.-fa*fa)
+
+           xai= xai-2.*caib(im,it,ia)
+           xai=max(xai,0.0)
+     
+           tauclb(i,j,k) = taux*xai
+
+!-----scale cloud optical thickness for diffuse radiation.
+!     the scaling factor, xai, is a function of the cloud optical
+!     thickness and cover but not the solar zenith angle.
+
+           xai=    (-caif(it-1,ia)*(1.-ft)+ &
+            caif(it+1,ia)*(1.+ft))*ft*.5+caif(it,ia)*(1.-ft*ft)
+
+           xai=xai+(-caif(it,ia-1)*(1.-fa)+ &
+            caif(it,ia+1)*(1.+fa))*fa*.5+caif(it,ia)*(1.-fa*fa)
+
+           xai= xai-caif(it,ia)
+           xai=max(xai,0.0)
+     
+           tauclf(i,j,k) = taux*xai
+
+         endif
+
+        enddo
+       enddo
+      enddo
+
+      end subroutine cldscale
+
+!*********************************************************************
+
+      subroutine deledd(tau,ssc,g0,csm,rr,tt,td)
+
+!*********************************************************************
+!
+!-----uses the delta-eddington approximation to compute the
+!     bulk scattering properties of a single layer
+!     coded following King and Harshvardhan (JAS, 1986)
+!
+!  inputs:
+!
+!     tau: the effective optical thickness
+!     ssc: the effective single scattering albedo
+!     g0:  the effective asymmetry factor
+!     csm: the effective secant of the zenith angle
+!
+!  outputs:
+!
+!     rr: the layer reflection of the direct beam
+!     tt: the layer diffuse transmission of the direct beam
+!     td: the layer direct transmission of the direct beam
+!
+!*********************************************************************
+      implicit none
+!*********************************************************************
+
+      real zero,one,two,three,four,fourth,seven,thresh
+      parameter (one =1., three=3.)
+      parameter (two =2., seven=7.)
+      parameter (four=4., fourth=.25)
+      parameter (zero=0., thresh=1.e-8)
+
+!-----input parameters
+      real tau,ssc,g0,csm
+
+!-----output parameters
+      real rr,tt,td
+
+!-----temporary parameters
+
+      real zth,ff,xx,taup,sscp,gp,gm1,gm2,gm3,akk,alf1,alf2, &
+           all,bll,st7,st8,cll,dll,fll,ell,st1,st2,st3,st4
+ 
+!---------------------------------------------------------------------
+
+                zth = one / csm
+ 
+!  delta-eddington scaling of single scattering albedo,
+!  optical thickness, and asymmetry factor,
+!  K & H eqs(27-29)
+
+                ff  = g0*g0
+                xx  = one-ff*ssc
+                taup= tau*xx
+                sscp= ssc*(one-ff)/xx
+                gp  = g0/(one+g0)
+ 
+!  gamma1, gamma2, and gamma3. see table 2 and eq(26) K & H
+!  ssc and gp are the d-s single scattering
+!  albedo and asymmetry factor.
+
+                xx  =  three*gp 
+                gm1 =  (seven - sscp*(four+xx))*fourth
+                gm2 = -(one   - sscp*(four-xx))*fourth
+ 
+!  akk is k as defined in eq(25) of K & H
+ 
+                akk = sqrt((gm1+gm2)*(gm1-gm2))
+ 
+                xx  = akk * zth
+                st7 = one - xx
+                st8 = one + xx
+                st3 = st7 * st8
+
+                if (abs(st3) .lt. thresh) then
+                    zth = zth + 0.001
+                    xx  = akk * zth
+                    st7 = one - xx
+                    st8 = one + xx
+                    st3 = st7 * st8
+                endif
+
+!  extinction of the direct beam transmission
+ 
+                td  = exp(-taup/zth)
+
+!  alf1 and alf2 are alpha1 and alpha2 from eqs (23) & (24) of K & H
+ 
+                gm3  = (two - zth*three*gp)*fourth
+                xx   = gm1 - gm2
+                alf1 = gm1 - gm3 * xx
+                alf2 = gm2 + gm3 * xx
+ 
+!  all is last term in eq(21) of K & H
+!  bll is last term in eq(22) of K & H
+ 
+                xx  = akk * two
+                all = (gm3 - alf2 * zth    )*xx*td
+                bll = (one - gm3 + alf1*zth)*xx
+ 
+                xx  = akk * gm3
+                cll = (alf2 + xx) * st7
+                dll = (alf2 - xx) * st8
+ 
+                xx  = akk * (one-gm3)
+                fll = (alf1 + xx) * st8
+                ell = (alf1 - xx) * st7
+  
+                st2 = exp(-akk*taup)
+                st4 = st2 * st2
+ 
+                st1 =  sscp / ((akk+gm1 + (akk-gm1)*st4) * st3)
+ 
+!  rr is r-hat of eq(21) of K & H
+!  tt is diffuse part of t-hat of eq(22) of K & H
+ 
+                rr =   ( cll-dll*st4    -all*st2)*st1
+                tt = - ((fll-ell*st4)*td-bll*st2)*st1
+ 
+                rr = max(rr,zero)
+                tt = max(tt,zero)
+
+      end subroutine deledd
+
+!*********************************************************************
+
+      subroutine sagpol(tau,ssc,g0,rll,tll)
+
+!*********************************************************************
+!-----transmittance (tll) and reflectance (rll) of diffuse radiation
+!     follows Sagan and Pollock (JGR, 1967).
+!     also, eq.(31) of Lacis and Hansen (JAS, 1974).
+!
+!-----input parameters:
+!
+!      tau: the effective optical thickness
+!      ssc: the effective single scattering albedo
+!      g0:  the effective asymmetry factor
+!
+!-----output parameters:
+!
+!      rll: the layer reflection of diffuse radiation
+!      tll: the layer transmission of diffuse radiation
+!
+!*********************************************************************
+      implicit none
+!*********************************************************************
+
+      real one,three,four
+      parameter (one=1., three=3., four=4.)
+
+!-----output parameters:
+
+      real tau,ssc,g0
+
+!-----output parameters:
+
+      real rll,tll
+
+!-----temporary arrays
+
+      real xx,uuu,ttt,emt,up1,um1,st1
+
+             xx  = one-ssc*g0
+             uuu = sqrt( xx/(one-ssc))
+             ttt = sqrt( xx*(one-ssc)*three )*tau
+             emt = exp(-ttt)
+             up1 = uuu + one
+             um1 = uuu - one
+             xx  = um1*emt
+             st1 = one / ((up1+xx) * (up1-xx))
+             rll = up1*um1*(one-emt*emt)*st1
+             tll = uuu*four*emt         *st1
+
+      end subroutine sagpol
+
+!*******************************************************************
+
+      subroutine cldflx (m,n,np,ict,icb,overcast,cc,rr,tt,td,rs,ts,&
+                 fclr,fall,fallu,falld,fsdir,fsdif)
+
+!*******************************************************************
+!  compute upward and downward fluxes using a two-stream adding method
+!  following equations (3)-(5) of Chou (1992, JAS).
+!
+!  clouds are grouped into high, middle, and low clouds which are 
+!  assumed randomly overlapped. It involves eight sets of calculations.
+!  In each set of calculations, each atmospheric layer is homogeneous,
+!  either totally filled with clouds or without clouds.
+
+!  input parameters:
+!
+!     m:   number of soundings in zonal direction
+!     n:   number of soundings in meridional direction
+!     np:  number of atmospheric layers
+!     ict: the level separating high and middle clouds
+!     icb: the level separating middle and low clouds
+!     cc:  effective cloud covers for high, middle and low clouds
+!     tt:  diffuse transmission of a layer illuminated by beam radiation
+!     td:  direct beam tranmssion
+!     ts:  transmission of a layer illuminated by diffuse radiation
+!     rr:  reflection of a layer illuminated by beam radiation
+!     rs:  reflection of a layer illuminated by diffuse radiation
+!
+!  output parameters:
+!
+!     fclr:  clear-sky flux (downward minus upward)
+!     fall:  all-sky flux (downward minus upward)
+!     fsdir: surface direct downward flux
+!     fsdif: surface diffuse downward flux
+!
+!*********************************************************************c
+      implicit none
+!*********************************************************************c
+
+!-----input parameters
+
+      integer m,n,np
+      integer ict(m,n),icb(m,n)
+
+      real rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2)
+      real rs(m,n,np+1,2),ts(m,n,np+1,2)
+      real cc(m,n,3)
+      logical overcast
+
+!-----temporary array
+
+      integer i,j,k,ih,im,is,itm
+      real rra(m,n,np+1,2,2),tta(m,n,np+1,2,2),tda(m,n,np+1,2,2)
+      real rsa(m,n,np+1,2,2),rxa(m,n,np+1,2,2)
+      real ch(m,n),cm(m,n),ct(m,n),flxdn(m,n,np+1)
+      real flxdnu(m,n,np+1),flxdnd(m,n,np+1)
+      real fdndir(m,n),fdndif(m,n),fupdif
+      real denm,xx
+
+!-----output parameters
+
+      real fclr(m,n,np+1),fall(m,n,np+1)
+      real fallu(m,n,np+1),falld(m,n,np+1)
+      real fsdir(m,n),fsdif(m,n)
+
+!-----initialize all-sky flux (fall) and surface downward fluxes
+
+      do k=1,np+1
+       do j=1,n
+        do i=1,m
+           fclr(i,j,k)=0.0
+           fall(i,j,k)=0.0
+           fallu(i,j,k)=0.0
+           falld(i,j,k)=0.0
+        enddo
+       enddo
+      enddo
+
+       do j=1,n
+        do i=1,m
+           fsdir(i,j)=0.0
+           fsdif(i,j)=0.0
+        enddo
+       enddo
+
+!-----compute transmittances and reflectances for a composite of
+!     layers. layers are added one at a time, going down from the top.
+!     tda is the composite transmittance illuminated by beam radiation
+!     tta is the composite diffuse transmittance illuminated by
+!         beam radiation
+!     rsa is the composite reflectance illuminated from below
+!         by diffuse radiation
+!     tta and rsa are computed from eqs. (4b) and (3b) of Chou
+
+      itm=1
+
+!-----if overcas.=.true., set itm=2, and only one set of fluxes is computed
+
+      if (overcast) itm=2
+
+!-----for high clouds. indices 1 and 2 denote clear and cloudy
+!     situations, respectively.
+
+      do 10 ih=itm,2
+
+       do j= 1, n
+        do i= 1, m
+          tda(i,j,1,ih,1)=td(i,j,1,ih)
+          tta(i,j,1,ih,1)=tt(i,j,1,ih)
+          rsa(i,j,1,ih,1)=rs(i,j,1,ih)
+          tda(i,j,1,ih,2)=td(i,j,1,ih)
+          tta(i,j,1,ih,2)=tt(i,j,1,ih)
+          rsa(i,j,1,ih,2)=rs(i,j,1,ih)
+        enddo
+       enddo
+
+       do j= 1, n
+        do i= 1, m
+         do k= 2, ict(i,j)-1
+          denm = ts(i,j,k,ih)/( 1.-rsa(i,j,k-1,ih,1)*rs(i,j,k,ih))
+          tda(i,j,k,ih,1)= tda(i,j,k-1,ih,1)*td(i,j,k,ih)
+          tta(i,j,k,ih,1)= tda(i,j,k-1,ih,1)*tt(i,j,k,ih) &
+                        +(tda(i,j,k-1,ih,1)*rr(i,j,k,ih)  &
+                        *rsa(i,j,k-1,ih,1)+tta(i,j,k-1,ih,1))*denm
+          rsa(i,j,k,ih,1)= rs(i,j,k,ih)+ts(i,j,k,ih) &
+                        *rsa(i,j,k-1,ih,1)*denm
+          tda(i,j,k,ih,2)= tda(i,j,k,ih,1)
+          tta(i,j,k,ih,2)= tta(i,j,k,ih,1)
+          rsa(i,j,k,ih,2)= rsa(i,j,k,ih,1)
+         enddo
+        enddo
+       enddo
+
+!-----for middle clouds
+
+      do 10 im=itm,2
+
+      do j= 1, n
+       do i= 1, m
+        do k= ict(i,j), icb(i,j)-1
+          denm = ts(i,j,k,im)/( 1.-rsa(i,j,k-1,ih,im)*rs(i,j,k,im))
+          tda(i,j,k,ih,im)= tda(i,j,k-1,ih,im)*td(i,j,k,im)
+          tta(i,j,k,ih,im)= tda(i,j,k-1,ih,im)*tt(i,j,k,im) &
+                        +(tda(i,j,k-1,ih,im)*rr(i,j,k,im)   &
+                        *rsa(i,j,k-1,ih,im)+tta(i,j,k-1,ih,im))*denm
+          rsa(i,j,k,ih,im)= rs(i,j,k,im)+ts(i,j,k,im)  &
+                        *rsa(i,j,k-1,ih,im)*denm
+         enddo
+        enddo
+       enddo
+
+  10  continue
+
+!-----layers are added one at a time, going up from the surface.
+!     rra is the composite reflectance illuminated by beam radiation
+!     rxa is the composite reflectance illuminated from above
+!         by diffuse radiation
+!     rra and rxa are computed from eqs. (4a) and (3a) of Chou
+ 
+!-----for the low clouds
+
+      do 20 is=itm,2
+
+       do j= 1, n
+        do i= 1, m
+         rra(i,j,np+1,1,is)=rr(i,j,np+1,is)
+         rxa(i,j,np+1,1,is)=rs(i,j,np+1,is)
+         rra(i,j,np+1,2,is)=rr(i,j,np+1,is)
+         rxa(i,j,np+1,2,is)=rs(i,j,np+1,is)
+        enddo
+       enddo
+
+       do j= 1, n
+        do i= 1, m
+         do k=np,icb(i,j),-1
+          denm=ts(i,j,k,is)/( 1.-rs(i,j,k,is)*rxa(i,j,k+1,1,is) )
+          rra(i,j,k,1,is)=rr(i,j,k,is)+(td(i,j,k,is) &
+              *rra(i,j,k+1,1,is)+tt(i,j,k,is)*rxa(i,j,k+1,1,is))*denm
+          rxa(i,j,k,1,is)= rs(i,j,k,is)+ts(i,j,k,is) &
+              *rxa(i,j,k+1,1,is)*denm
+          rra(i,j,k,2,is)=rra(i,j,k,1,is)
+          rxa(i,j,k,2,is)=rxa(i,j,k,1,is)
+         enddo
+        enddo
+       enddo
+
+!-----for middle clouds
+
+      do 20 im=itm,2
+
+       do j= 1, n
+        do i= 1, m
+         do k= icb(i,j)-1,ict(i,j),-1
+          denm=ts(i,j,k,im)/( 1.-rs(i,j,k,im)*rxa(i,j,k+1,im,is) )
+          rra(i,j,k,im,is)= rr(i,j,k,im)+(td(i,j,k,im)  &
+              *rra(i,j,k+1,im,is)+tt(i,j,k,im)*rxa(i,j,k+1,im,is))*denm
+          rxa(i,j,k,im,is)= rs(i,j,k,im)+ts(i,j,k,im)   &
+              *rxa(i,j,k+1,im,is)*denm
+         enddo
+        enddo
+       enddo
+
+  20  continue
+
+!-----integration over eight sky situations.
+!     ih, im, is denotes high, middle and low cloud groups.
+
+      do 100 ih=itm,2
+
+!-----clear portion 
+
+         if(ih.eq.1) then
+           do j=1,n
+            do i=1,m
+             ch(i,j)=1.0-cc(i,j,1)
+            enddo
+           enddo
+
+          else
+
+!-----cloudy portion
+
+           do j=1,n
+            do i=1,m
+             ch(i,j)=cc(i,j,1)
+            enddo
+           enddo
+
+          endif
+
+      do 100 im=itm,2
+
+!-----clear portion
+
+         if(im.eq.1) then
+
+           do j=1,n
+            do i=1,m
+              cm(i,j)=ch(i,j)*(1.0-cc(i,j,2))
+            enddo
+           enddo
+
+         else
+
+!-----cloudy portion
+
+           do j=1,n
+            do i=1,m
+              cm(i,j)=ch(i,j)*cc(i,j,2) 
+            enddo
+           enddo
+
+         endif
+
+      do 100 is=itm,2
+
+!-----clear portion
+
+         if(is.eq.1) then
+
+           do j=1,n
+            do i=1,m
+             ct(i,j)=cm(i,j)*(1.0-cc(i,j,3)) 
+            enddo
+           enddo
+
+         else
+
+!-----cloudy portion
+
+           do j=1,n
+            do i=1,m
+             ct(i,j)=cm(i,j)*cc(i,j,3)
+            enddo
+           enddo
+
+         endif
+
+!-----add one layer at a time, going down.
+
+       do j= 1, n
+        do i= 1, m
+         do k= icb(i,j), np
+          denm = ts(i,j,k,is)/( 1.-rsa(i,j,k-1,ih,im)*rs(i,j,k,is) )
+          tda(i,j,k,ih,im)= tda(i,j,k-1,ih,im)*td(i,j,k,is)
+          tta(i,j,k,ih,im)=  tda(i,j,k-1,ih,im)*tt(i,j,k,is) &
+               +(tda(i,j,k-1,ih,im)*rr(i,j,k,is) &
+               *rsa(i,j,k-1,ih,im)+tta(i,j,k-1,ih,im))*denm
+          rsa(i,j,k,ih,im)= rs(i,j,k,is)+ts(i,j,k,is) &
+               *rsa(i,j,k-1,ih,im)*denm
+         enddo
+        enddo
+       enddo
+
+!-----add one layer at a time, going up.
+
+       do j= 1, n
+        do i= 1, m
+         do k= ict(i,j)-1,1,-1
+          denm =ts(i,j,k,ih)/(1.-rs(i,j,k,ih)*rxa(i,j,k+1,im,is))
+          rra(i,j,k,im,is)= rr(i,j,k,ih)+(td(i,j,k,ih)  &
+              *rra(i,j,k+1,im,is)+tt(i,j,k,ih)*rxa(i,j,k+1,im,is))*denm
+          rxa(i,j,k,im,is)= rs(i,j,k,ih)+ts(i,j,k,ih)   &
+              *rxa(i,j,k+1,im,is)*denm
+         enddo
+        enddo
+       enddo
+
+!-----compute fluxes following eq (5) of Chou (1992)
+ 
+!     fdndir is the direct  downward flux
+!     fdndif is the diffuse downward flux
+!     fupdif is the diffuse upward flux
+
+      do k=2,np+1
+       do j=1, n
+        do i=1, m
+         denm= 1./(1.- rxa(i,j,k,im,is)*rsa(i,j,k-1,ih,im))
+         fdndir(i,j)= tda(i,j,k-1,ih,im)
+         xx = tda(i,j,k-1,ih,im)*rra(i,j,k,im,is)
+         fdndif(i,j)= (xx*rsa(i,j,k-1,ih,im)+tta(i,j,k-1,ih,im))*denm
+         fupdif= (xx+tta(i,j,k-1,ih,im)*rxa(i,j,k,im,is))*denm
+         flxdn(i,j,k)=fdndir(i,j)+fdndif(i,j)-fupdif
+         flxdnu(i,j,k)=-fupdif
+         flxdnd(i,j,k)=fdndir(i,j)+fdndif(i,j)
+        enddo
+       enddo
+      enddo
+
+       do j=1, n
+        do i=1, m
+         flxdn(i,j,1)=1.0-rra(i,j,1,im,is)
+         flxdnu(i,j,1)=-rra(i,j,1,im,is)
+         flxdnd(i,j,1)=1.0
+        enddo
+       enddo
+
+!-----summation of fluxes over all (eight) sky situations.
+
+       do k=1,np+1
+        do j=1,n
+         do i=1,m
+           if(ih.eq.1 .and. im.eq.1 .and. is.eq.1) then
+             fclr(i,j,k)=flxdn(i,j,k)
+           endif
+             fall(i,j,k)=fall(i,j,k)+flxdn(i,j,k)*ct(i,j)
+             fallu(i,j,k)=fallu(i,j,k)+flxdnu(i,j,k)*ct(i,j)
+             falld(i,j,k)=falld(i,j,k)+flxdnd(i,j,k)*ct(i,j)
+         enddo
+        enddo
+       enddo
+
+        do j=1,n
+         do i=1,m
+            fsdir(i,j)=fsdir(i,j)+fdndir(i,j)*ct(i,j)
+            fsdif(i,j)=fsdif(i,j)+fdndif(i,j)*ct(i,j)
+         enddo
+        enddo
+
+  100 continue
+
+      end subroutine cldflx
+
+!*****************************************************************
+
+      subroutine flxco2(m,n,np,swc,swh,csm,df)
+
+!*****************************************************************
+
+!-----compute the reduction of clear-sky downward solar flux
+!     due to co2 absorption.
+
+      implicit none
+
+!-----input parameters
+
+      integer m,n,np
+      real csm(m,n),swc(m,n,np+1),swh(m,n,np+1),cah(22,19)
+
+!-----output (undated) parameter
+
+      real df(m,n,np+1)
+
+!-----temporary array
+
+      integer i,j,k,ic,iw 
+      real xx,clog,wlog,dc,dw,x1,x2,y2
+
+!********************************************************************
+!-----include co2 look-up table
+
+      data ((cah(i,j),i=1,22),j= 1, 5)/ &                                     
+       0.9923, 0.9922, 0.9921, 0.9920, 0.9916, 0.9910, 0.9899, 0.9882, &      
+       0.9856, 0.9818, 0.9761, 0.9678, 0.9558, 0.9395, 0.9188, 0.8945, &      
+       0.8675, 0.8376, 0.8029, 0.7621, 0.7154, 0.6647, 0.9876, 0.9876, &      
+       0.9875, 0.9873, 0.9870, 0.9864, 0.9854, 0.9837, 0.9811, 0.9773, &      
+       0.9718, 0.9636, 0.9518, 0.9358, 0.9153, 0.8913, 0.8647, 0.8350, &      
+       0.8005, 0.7599, 0.7133, 0.6627, 0.9808, 0.9807, 0.9806, 0.9805, &      
+       0.9802, 0.9796, 0.9786, 0.9769, 0.9744, 0.9707, 0.9653, 0.9573, &      
+       0.9459, 0.9302, 0.9102, 0.8866, 0.8604, 0.8311, 0.7969, 0.7565, &      
+       0.7101, 0.6596, 0.9708, 0.9708, 0.9707, 0.9705, 0.9702, 0.9697, &      
+       0.9687, 0.9671, 0.9647, 0.9612, 0.9560, 0.9483, 0.9372, 0.9221, &      
+       0.9027, 0.8798, 0.8542, 0.8253, 0.7916, 0.7515, 0.7054, 0.6551, &      
+       0.9568, 0.9568, 0.9567, 0.9565, 0.9562, 0.9557, 0.9548, 0.9533, &      
+       0.9510, 0.9477, 0.9428, 0.9355, 0.9250, 0.9106, 0.8921, 0.8700, &      
+       0.8452, 0.8171, 0.7839, 0.7443, 0.6986, 0.6486/                        
+ 
+      data ((cah(i,j),i=1,22),j= 6,10)/  &                                    
+       0.9377, 0.9377, 0.9376, 0.9375, 0.9372, 0.9367, 0.9359, 0.9345, &      
+       0.9324, 0.9294, 0.9248, 0.9181, 0.9083, 0.8948, 0.8774, 0.8565, &      
+       0.8328, 0.8055, 0.7731, 0.7342, 0.6890, 0.6395, 0.9126, 0.9126, &      
+       0.9125, 0.9124, 0.9121, 0.9117, 0.9110, 0.9098, 0.9079, 0.9052, &      
+       0.9012, 0.8951, 0.8862, 0.8739, 0.8579, 0.8385, 0.8161, 0.7900, &      
+       0.7585, 0.7205, 0.6760, 0.6270, 0.8809, 0.8809, 0.8808, 0.8807, &      
+       0.8805, 0.8802, 0.8796, 0.8786, 0.8770, 0.8747, 0.8712, 0.8659, &      
+       0.8582, 0.8473, 0.8329, 0.8153, 0.7945, 0.7697, 0.7394, 0.7024, &      
+       0.6588, 0.6105, 0.8427, 0.8427, 0.8427, 0.8426, 0.8424, 0.8422, &      
+       0.8417, 0.8409, 0.8397, 0.8378, 0.8350, 0.8306, 0.8241, 0.8148, &      
+       0.8023, 0.7866, 0.7676, 0.7444, 0.7154, 0.6796, 0.6370, 0.5897, &      
+       0.7990, 0.7990, 0.7990, 0.7989, 0.7988, 0.7987, 0.7983, 0.7978, &      
+       0.7969, 0.7955, 0.7933, 0.7899, 0.7846, 0.7769, 0.7664, 0.7528, &      
+       0.7357, 0.7141, 0.6866, 0.6520, 0.6108, 0.5646/                        
+ 
+      data ((cah(i,j),i=1,22),j=11,15)/  &                                    
+       0.7515, 0.7515, 0.7515, 0.7515, 0.7514, 0.7513, 0.7511, 0.7507, &      
+       0.7501, 0.7491, 0.7476, 0.7450, 0.7409, 0.7347, 0.7261, 0.7144, &      
+       0.6992, 0.6793, 0.6533, 0.6203, 0.5805, 0.5357, 0.7020, 0.7020, &      
+       0.7020, 0.7019, 0.7019, 0.7018, 0.7017, 0.7015, 0.7011, 0.7005, &      
+       0.6993, 0.6974, 0.6943, 0.6894, 0.6823, 0.6723, 0.6588, 0.6406, &      
+       0.6161, 0.5847, 0.5466, 0.5034, 0.6518, 0.6518, 0.6518, 0.6518, &      
+       0.6518, 0.6517, 0.6517, 0.6515, 0.6513, 0.6508, 0.6500, 0.6485, &      
+       0.6459, 0.6419, 0.6359, 0.6273, 0.6151, 0.5983, 0.5755, 0.5458, &      
+       0.5095, 0.4681, 0.6017, 0.6017, 0.6017, 0.6017, 0.6016, 0.6016, &      
+       0.6016, 0.6015, 0.6013, 0.6009, 0.6002, 0.5989, 0.5967, 0.5932, &      
+       0.5879, 0.5801, 0.5691, 0.5535, 0.5322, 0.5043, 0.4700, 0.4308, &      
+       0.5518, 0.5518, 0.5518, 0.5518, 0.5518, 0.5518, 0.5517, 0.5516, &      
+       0.5514, 0.5511, 0.5505, 0.5493, 0.5473, 0.5441, 0.5393, 0.5322, &      
+       0.5220, 0.5076, 0.4878, 0.4617, 0.4297, 0.3929/                        
+ 
+      data ((cah(i,j),i=1,22),j=16,19)/ &                                     
+       0.5031, 0.5031, 0.5031, 0.5031, 0.5031, 0.5030, 0.5030, 0.5029, &      
+       0.5028, 0.5025, 0.5019, 0.5008, 0.4990, 0.4960, 0.4916, 0.4850, &      
+       0.4757, 0.4624, 0.4441, 0.4201, 0.3904, 0.3564, 0.4565, 0.4565, &      
+       0.4565, 0.4564, 0.4564, 0.4564, 0.4564, 0.4563, 0.4562, 0.4559, &      
+       0.4553, 0.4544, 0.4527, 0.4500, 0.4460, 0.4400, 0.4315, 0.4194, &      
+       0.4028, 0.3809, 0.3538, 0.3227, 0.4122, 0.4122, 0.4122, 0.4122, &      
+       0.4122, 0.4122, 0.4122, 0.4121, 0.4120, 0.4117, 0.4112, 0.4104, &      
+       0.4089, 0.4065, 0.4029, 0.3976, 0.3900, 0.3792, 0.3643, 0.3447, &      
+       0.3203, 0.2923, 0.3696, 0.3696, 0.3696, 0.3696, 0.3696, 0.3696, &      
+       0.3695, 0.3695, 0.3694, 0.3691, 0.3687, 0.3680, 0.3667, 0.3647, &      
+       0.3615, 0.3570, 0.3504, 0.3409, 0.3279, 0.3106, 0.2892, 0.2642/        
+
+!********************************************************************
+!-----table look-up for the reduction of clear-sky solar
+!     radiation due to co2. The fraction 0.0343 is the
+!     extraterrestrial solar flux in the co2 bands.
+
+      do k= 2, np+1
+       do j= 1, n
+        do i= 1, m
+          xx=1./.3
+          clog=log10(swc(i,j,k)*csm(i,j))
+          wlog=log10(swh(i,j,k)*csm(i,j))
+          ic=int( (clog+3.15)*xx+1.)
+          iw=int( (wlog+4.15)*xx+1.)
+          if(ic.lt.2)ic=2
+          if(iw.lt.2)iw=2
+          if(ic.gt.22)ic=22
+          if(iw.gt.19)iw=19     
+          dc=clog-float(ic-2)*.3+3.
+          dw=wlog-float(iw-2)*.3+4.   
+          x1=cah(1,iw-1)+(cah(1,iw)-cah(1,iw-1))*xx*dw
+          x2=cah(ic-1,iw-1)+(cah(ic-1,iw)-cah(ic-1,iw-1))*xx*dw
+          y2=x2+(cah(ic,iw-1)-cah(ic-1,iw-1))*xx*dc
+          if (x1.lt.y2) x1=y2
+          df(i,j,k)=df(i,j,k)+0.0343*(x1-y2)
+        enddo     
+       enddo      
+      enddo      
+
+      end subroutine flxco2
+
+!*****************************************************************
+
+      subroutine o3prof (np, pres, ozone, its, ite, kts, kte, p, o3)
+
+!*****************************************************************
+      implicit none
+!*****************************************************************
+!
+      integer iprof,m,np,its,ite,kts,kte
+      integer i,k,ko,kk
+      real pres(np),ozone(np)
+      real p(its:ite,kts:kte),o3(its:ite,kts:kte)
+ 
+!     Statement function 
+ 
+      real Linear, x1, y1, x2, y2, x
+      Linear(x1, y1, x2, y2, x) =  &
+            (y1 * (x2 - x) + y2 * (x - x1)) / (x2 - x1)
+!
+      do k = 1,np
+        pres(k) = alog(pres(k))
+      enddo
+      do k = kts,kte
+        do i = its, ite
+          p(i,k) = alog(p(i,k))
+        end do
+      end do
+
+! assume the pressure at model top is greater than pres(1)
+! if it is not, this part needs to change
+
+      do i = its, ite
+        ko = 1
+        do k = kts+1, kte
+          do while (ko .lt. np .and. p(i,k) .gt. pres(ko))
+            ko = ko + 1
+          end do
+          o3(i,k) =  Linear (pres(ko),   ozone(ko),    &
+                             pres(ko-1), ozone(ko-1),  &
+                             p(i,k))
+          ko = ko - 1
+        end do
+      end do
+
+! calculate top lay O3
+
+      do i = its, ite
+        ko = 1
+        k = kts
+        do while (ko .le. np .and. p(i,k) .gt. pres(ko))
+           ko = ko + 1
+        end do
+        IF (ko-1 .le. 1) then
+           O3(i,k)=ozone(k)
+        ELSE
+           O3(i,k)=0.
+           do kk=ko-2,1,-1
+              O3(i,k)=O3(i,k)+ozone(kk)*(pres(kk+1)-pres(kk))
+           enddo
+           O3(i,k)=O3(i,k)/(pres(ko-1)-pres(1))
+        ENDIF
+!       print*,'O3=',i,k,ko,O3(i,k),p(i,k),ko,pres(ko),pres(ko-1)
+      end do
+      
+      end subroutine o3prof
+
+!-----------------------------------------
+    SUBROUTINE gsfc_swinit(cen_lat, allowed_to_read)
+
+    REAL, INTENT(IN    )      ::        cen_lat
+    LOGICAL, INTENT(IN    )   ::       allowed_to_read
+
+        center_lat=cen_lat
+
+    END SUBROUTINE gsfc_swinit
+
+
+END MODULE module_ra_gsfcsw
Index: trunk/WRF.COMMON/WRFV2/phys/module_ra_rrtm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_ra_rrtm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_ra_rrtm.F	(revision 2744)
@@ -0,0 +1,7403 @@
+
+MODULE module_ra_rrtm
+
+! Parameters
+
+      INTEGER, PRIVATE :: IDATA
+      INTEGER, PARAMETER :: MG=16 
+      INTEGER, PARAMETER :: NBANDS=16
+      INTEGER, PARAMETER :: NGPT=140
+      INTEGER, PARAMETER :: NG1=8
+      INTEGER, PARAMETER :: NG2=14
+      INTEGER, PARAMETER :: NG3=16
+      INTEGER, PARAMETER :: NG4=14
+      INTEGER, PARAMETER :: NG5=16 
+      INTEGER, PARAMETER :: NG6=8
+      INTEGER, PARAMETER :: NG7=12
+      INTEGER, PARAMETER :: NG8=8
+      INTEGER, PARAMETER :: NG9=12
+      INTEGER, PARAMETER :: NG10=6 
+      INTEGER, PARAMETER :: NG11=8
+      INTEGER, PARAMETER :: NG12=8
+      INTEGER, PARAMETER :: NG13=4
+      INTEGER, PARAMETER :: NG14=2
+      INTEGER, PARAMETER :: NG15=2
+      INTEGER, PARAMETER :: NG16=2
+      INTEGER, PARAMETER :: MAXINPX=35
+      INTEGER, PARAMETER :: MAXXSEC=4
+
+      INTEGER, PARAMETER :: NMOL = 6
+      REAL, PARAMETER :: ONEMINUS = 1. - 1.E-6
+
+! var
+
+      REAL    , SAVE    :: FLUXFAC
+      INTEGER , SAVE    :: NLAYERS
+!
+! data 1
+!
+      REAL,SAVE ::  abscoefL1(5,13,MG),    abscoefH1(5,13:59,MG),   &
+                    SELFREF1(10,MG)
+      REAL,SAVE ::  abscoefL2(5,13,MG),    abscoefH2(5,13:59,MG),   &
+                    SELFREF2(10,MG)
+      REAL,SAVE ::  abscoefL3(10,5,13,MG), abscoefH3(5,5,13:59,MG), &
+                    SELFREF3(10,MG)
+      REAL,SAVE ::  abscoefL4(9,5,13,MG),  abscoefH4(6,5,13:59,MG), &
+                    SELFREF4(10,MG)
+      REAL,SAVE ::  abscoefL5(9,5,13,MG),  abscoefH5(5,5,13:59,MG), &
+                    SELFREF5(10,MG)
+      REAL,SAVE ::  abscoefL6(5,13,MG),    SELFREF6(10,MG)
+      REAL,SAVE ::  abscoefL7(9,5,13,MG),  abscoefH7(5,13:59,MG),   &
+                    SELFREF7(10,MG)
+      REAL,SAVE ::  abscoefL8(5,7,MG),     abscoefH8(5,7:59,MG),    &
+                    SELFREF8(10,MG)
+      REAL,SAVE ::  abscoefL9(11,5,13,MG), abscoefH9(5,13:59,MG),   &
+                    SELFREF9(10,MG)
+      REAL,SAVE ::  abscoefL10(5,13,MG),   abscoefH10(5,13:59,MG)  
+      REAL,SAVE ::  abscoefL11(5,13,MG),   abscoefH11(5,13:59,MG),  &
+                    SELFREF11(10,MG)
+      REAL,SAVE ::  abscoefL12(9,5,13,MG), SELFREF12(10,MG)
+      REAL,SAVE ::  abscoefL13(9,5,13,MG), SELFREF13(10,MG)
+      REAL,SAVE ::  abscoefL14(5,13,MG),   abscoefH14(5,13:59,MG),  &
+                    SELFREF14(10,MG)
+      REAL,SAVE ::  abscoefL15(9,5,13,MG), SELFREF15(10,MG)
+      REAL,SAVE ::  abscoefL16(9,5,13,MG), SELFREF16(10,MG)
+
+!
+! data 2
+!
+      INTEGER,SAVE ::  NGM(MG*NBANDS), NGC(NBANDS), NGS(NBANDS),       &
+                    NGN(NGPT), NGB(NGPT)
+      REAL,SAVE ::  WT(MG)
+!
+! data 3
+!
+      REAL,SAVE ::  FRACREFA1(MG), FRACREFB1(MG), FORREF1(MG)   
+      REAL,SAVE ::  FRACREFA2(MG,13), FRACREFB2(MG), FORREF2(MG)
+      REAL,SAVE ::  FRACREFA3(MG,10), FRACREFB3(MG,5)        
+      REAL,SAVE ::  FORREF3(MG), ABSN2OA3(MG), ABSN2OB3(MG)   
+      REAL,SAVE ::  FRACREFA4(MG,9), FRACREFB4(MG,6)        
+      REAL,SAVE ::  FRACREFA5(MG,9), FRACREFB5(MG,5), CCL45(MG) 
+      REAL,SAVE ::  FRACREFA6(MG), ABSCO26(MG), CFC11ADJ6(MG), CFC126(MG)    
+      REAL,SAVE ::  FRACREFA7(MG,9), FRACREFB7(MG), ABSCO27(MG)        
+      REAL,SAVE ::  FRACREFA8(MG), FRACREFB8(MG), ABSCO2A8(MG), ABSCO2B8(MG)
+      REAL,SAVE ::  ABSN2OA8(MG), ABSN2OB8(MG), CFC128(MG), CFC22ADJ8(MG)  
+      REAL,SAVE ::  FRACREFA9(MG,9), FRACREFB9(MG), ABSN2O9(3*MG)
+      REAL,SAVE ::  FRACREFA10(MG), FRACREFB10(MG)        
+      REAL,SAVE ::  FRACREFA11(MG), FRACREFB11(MG)        
+      REAL,SAVE ::  FRACREFA12(MG,9)        
+      REAL,SAVE ::  FRACREFA13(MG,9)        
+      REAL,SAVE ::  FRACREFA14(MG), FRACREFB14(MG)
+      REAL,SAVE ::  FRACREFA15(MG,9)
+      REAL,SAVE ::  FRACREFA16(MG,9)
+!
+! data 4
+!
+      INTEGER,SAVE :: NXMOL, IXINDX(MAXINPX)
+
+! data 5 
+
+      REAL,SAVE    :: WAVENUM1(NBANDS),WAVENUM2(NBANDS),DELWAVE(NBANDS)
+
+! data 6
+
+      INTEGER,SAVE :: NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS)
+      REAL,   SAVE :: HEATFAC
+      REAL,   SAVE :: PREF(59),PREFLOG(59),TREF(59)
+
+! data 7 
+
+      REAL,   SAVE :: TOTPLNK(181,NBANDS), TOTPLK16(181)
+
+! data
+
+      REAL,    SAVE :: TAU(0:5000),TF(0:5000),TRANS(0:5000)
+!
+      REAL,    SAVE :: ABSA1(5*13,NG1), ABSB1(5*(59-13+1),NG1),         &
+                       SELFREFC1(10,NG1), FORREFC1(NG1)
+      REAL,    SAVE :: ABSA2(5*13,NG2), ABSB2(5*(59-13+1),NG2),         &
+                       SELFREFC2(10,NG2), FORREFC2(NG2)
+      REAL,    SAVE :: ABSA3(10*5*13,NG3), ABSB3(5*5*(59-13+1),NG3),    &     
+                       SELFREFC3(10,NG3), FORREFC3(NG3),                &
+                       ABSN2OAC3(NG3), ABSN2OBC3(NG3)        
+      REAL,    SAVE :: ABSA4(9*5*13,NG4), ABSB4(6*5*(59-13+1),NG4),     &
+                       SELFREFC4(10,NG4)        
+      REAL,    SAVE :: ABSA5(9*5*13,NG5), ABSB5(5*5*(59-13+1),NG5),     &
+                       SELFREFC5(10,NG5), CCL4C5(NG5)        
+      REAL,    SAVE :: ABSA6(5*13,NG6), SELFREFC6(10,NG6),              &        
+                       ABSCO2C6(NG6), CFC11ADJC6(NG6), CFC12C6(NG6)  
+      REAL,    SAVE :: ABSA7(9*5*13,NG7), ABSB7(5*(59-13+1),NG7),       &  
+                       SELFREFC7(10,NG7), ABSCO2C7(NG7)        
+      REAL,    SAVE :: ABSA8(5*7,NG8), ABSB8(5*(59-7+1),NG8),           &
+                       SELFREFC8(10,NG8),                               &
+                       ABSCO2AC8(NG8), ABSCO2BC8(NG8),                  &
+                       ABSN2OAC8(NG8), ABSN2OBC8(NG8),                  &       
+                       CFC12C8(NG8), CFC22ADJC8(NG8)      
+      REAL,    SAVE :: ABSA9(11*5*13,NG9), ABSB9(5*(59-13+1),NG9),      &
+                       SELFREFC9(10,NG9), ABSN2OC9(3*NG9)
+      REAL,    SAVE :: ABSA10(5*13,NG10), ABSB10(5*(59-13+1),NG10)
+      REAL,    SAVE :: ABSA11(5*13,NG11), ABSB11(5*(59-13+1),NG11),     &
+                       SELFREFC11(10,NG11)
+      REAL,    SAVE :: ABSA12(9*5*13,NG12), SELFREFC12(10,NG12)
+      REAL,    SAVE :: ABSA13(9*5*13,NG13), SELFREFC13(10,NG13)
+      REAL,    SAVE :: ABSA14(5*13,NG14), ABSB14(5*(59-13+1),NG14),    &
+                       SELFREFC14(10,NG14)
+      REAL,    SAVE :: ABSA15(9*5*13,NG15), SELFREFC15(10,NG15)
+      REAL,    SAVE :: ABSA16(9*5*13,NG16), SELFREFC16(10,NG16)
+
+      REAL,    SAVE :: FRACREFAC1(NG1), FRACREFBC1(NG1)
+      REAL,    SAVE :: FRACREFAC2(NG2,13), FRACREFBC2(NG2)
+      REAL,    SAVE :: FRACREFAC3(NG3,10), FRACREFBC3(NG3,5)
+      REAL,    SAVE :: FRACREFAC4(NG4,9), FRACREFBC4(NG4,6)
+      REAL,    SAVE :: FRACREFAC5(NG5,9), FRACREFBC5(NG5,5)      
+      REAL,    SAVE :: FRACREFAC6(NG6)                              
+      REAL,    SAVE :: FRACREFAC7(NG7,9), FRACREFBC7(NG7)    
+      REAL,    SAVE :: FRACREFAC8(NG8), FRACREFBC8(NG8)  
+      REAL,    SAVE :: FRACREFAC9(NG9,9), FRACREFBC9(NG9)      
+      REAL,    SAVE :: FRACREFAC10(NG10), FRACREFBC10(NG10)       
+      REAL,    SAVE :: FRACREFAC11(NG11), FRACREFBC11(NG11)  
+      REAL,    SAVE :: FRACREFAC12(NG12,9)                     
+      REAL,    SAVE :: FRACREFAC13(NG13,9)           
+      REAL,    SAVE :: FRACREFAC14(NG14), FRACREFBC14(NG14)    
+      REAL,    SAVE :: FRACREFAC15(NG15,9)                      
+      REAL,    SAVE :: FRACREFAC16(NG16,9)                 
+      
+      REAL,    SAVE :: CORR1(0:200),CORR2(0:200)
+      REAL,    SAVE :: BPADE
+      REAL,    SAVE :: RWGT(MG*NBANDS)
+
+!----------------------------------------------------------------------------
+!
+! start data 2
+                                                                                 
+!     Arrays for the g-point reduction from 256 to 140 for the 16 LW bands:      
+!     This mapping from 256 to 140 points has been carefully selected to         
+!     minimize the effect on the resulting fluxes and cooling rates, and         
+!     caution should be used if the mapping is modified.                         
+!                                                                                
+!     NGPT    The total number of new g-points                                   
+!     NGC     The number of new g-points in each band                            
+!     NGM     The index of each new g-point relative to the original             
+!             16 g-points for each band.                                         
+!     NGN     The number of original g-points that are combined to make          
+!             each new g-point in each band.                                     
+!     NGB     The band index for each new g-point.                               
+!     WT      RRTM weights for 16 g-points.                                      
+                                                                                 
+! Data Statements                                                                
+      DATA NGC  /8,14,16,14,16,8,12,8,12,6,8,8,4,2,2,2/                          
+      DATA NGS  /8,22,38,52,68,76,88,96,108,114,122,130,134,136,138,140/         
+      DATA NGM  /1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &             ! Band 1            
+                 1,2,3,4,5,6,7,8,9,10,11,12,13,13,14,14, &      ! Band 2            
+                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &      ! Band 3            
+                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,14,14, &      ! Band 4            
+                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &      ! Band 5            
+                 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &             ! Band 6            
+                 1,1,2,2,3,4,5,6,7,8,9,10,11,11,12,12, &        ! Band 7            
+                 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &             ! Band 8            
+                 1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, &       ! Band 9            
+                 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, &             ! Band 10           
+                 1,2,3,3,4,4,5,5,6,6,7,7,7,8,8,8, &             ! Band 11           
+                 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, &             ! Band 12           
+                 1,1,1,2,2,2,3,3,3,3,4,4,4,4,4,4, &             ! Band 13           
+                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &             ! Band 14           
+                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &             ! Band 15           
+                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2/               ! Band 16           
+      DATA NGN  /2,2,2,2,2,2,2,2, &                             ! Band 1            
+                 1,1,1,1,1,1,1,1,1,1,1,1,2,2, &                 ! Band 2            
+                 16*1, &                                        ! Band 3            
+                 1,1,1,1,1,1,1,1,1,1,1,1,1,3, &                 ! Band 4            
+                 16*1, &                                        ! Band 5            
+                 2,2,2,2,2,2,2,2, &                             ! Band 6            
+                 2,2,1,1,1,1,1,1,1,1,2,2, &                     ! Band 7            
+                 2,2,2,2,2,2,2,2, &                             ! Band 8            
+                 1,1,1,1,1,1,1,1,2,2,2,2, &                     ! Band 9            
+                 2,2,2,2,4,4, &                                 ! Band 10           
+                 1,1,2,2,2,2,3,3, &                             ! Band 11           
+                 1,1,1,1,2,2,4,4, &                             ! Band 12           
+                 3,3,4,6, &                                     ! Band 13           
+                 8,8, &                                         ! Band 14           
+                 8,8, &                                         ! Band 15           
+                 8,8/                                           ! Band 16           
+      DATA NGB  /8*1, &                                         ! Band 1            
+                 14*2, &                                        ! Band 2            
+                 16*3, &                                        ! Band 3            
+                 14*4, &                                        ! Band 4            
+                 16*5, &                                        ! Band 5            
+                 8*6, &                                         ! Band 6            
+                 12*7, &                                        ! Band 7            
+                 8*8, &                                         ! Band 8            
+                 12*9, &                                        ! Band 9            
+                 6*10, &                                        ! Band 10           
+                 8*11, &                                        ! Band 11           
+                 8*12, &                                        ! Band 12           
+                 4*13, &                                        ! Band 13           
+                 2*14, &                                        ! Band 14           
+                 2*15, &                                        ! Band 15           
+                 2*16/                                       ! Band 16           
+      DATA WT/ &                                                                  
+           0.1527534276,0.1491729617,0.1420961469,0.1316886544, &                   
+           0.1181945205,0.1019300893,0.0832767040,0.0626720116, &                   
+           0.0424925,0.0046269894,0.0038279891,0.0030260086, &                      
+           0.0022199750,0.0014140010,0.000533,0.000075/                          
+
+!
+! end of data 2
+!
+!-----------------------------------------------------------------------
+
+! start data 3
+
+                                                                                 
+! Data
+
+      DATA FRACREFA1/ &                                                            
+          0.08452097,0.17952873,0.16214369,0.13602182, &                            
+          0.12760490,0.10302561,0.08392423,0.06337652, &                            
+          0.04206551,0.00487497,0.00410743,0.00344421, &                            
+          0.00285731,0.00157327,0.00080648,0.00012406/                           
+      DATA FRACREFB1/ &                                                            
+          0.15492001,0.17384727,0.15165100,0.12675308, &                            
+          0.10986247,0.09006091,0.07584465,0.05990077, &                            
+          0.04113461,0.00438638,0.00374754,0.00313924, &                            
+          0.00234381,0.00167167,0.00062744,0.00010889/                           
+                                                                                 
+      DATA FORREF1/   &                                                            
+         -4.50470E-02,-1.18908E-01,-7.21730E-02,-2.83862E-02, &                     
+         -3.01961E-02,-1.56877E-02,-1.53684E-02,-1.29135E-02, &                     
+         -1.27963E-02,-1.81742E-03, 4.40008E-05, 1.05260E-02, &                     
+          2.17290E-02, 1.65571E-02, 7.60751E-02, 1.47405E-01/                    
+
+                                                                                 
+! Data                                                                           
+                                                                                 
+!     The ith set of reference fractions are from the ith reference              
+!     pressure level.                                                            
+
+      DATA FRACREFA2/ &
+          0.18068060,0.16803175,0.15140158,0.12221480, 0.10240850,0.09330297,0.07518960,0.05611294, &
+          0.03781487,0.00387192,0.00321285,0.00244440, 0.00179546,0.00107704,0.00038798,0.00005060, &
+          0.17927621,0.16731168,0.15129538,0.12328085, 0.10243484,0.09354796,0.07538418,0.05633071, &
+          0.03810832,0.00398347,0.00320262,0.00250029, 0.00178666,0.00111127,0.00039438,0.00005169, &
+          0.17762886,0.16638555,0.15115446,0.12470623, 0.10253213,0.09383459,0.07560240,0.05646568, &
+          0.03844077,0.00409142,0.00322521,0.00254918, 0.00179296,0.00113652,0.00040169,0.00005259, &
+          0.17566043,0.16539773,0.15092199,0.12571971, 0.10340609,0.09426189,0.07559051,0.05678188, &
+          0.03881499,0.00414102,0.00328551,0.00258795, 0.00181648,0.00115145,0.00040969,0.00005357, &
+          0.17335825,0.16442548,0.15070701,0.12667464, 0.10452303,0.09450833,0.07599410,0.05706393, &
+          0.03910370,0.00417880,0.00335256,0.00261708, 0.00185491,0.00116627,0.00041759,0.00005464, &
+          0.17082544,0.16321516,0.15044247,0.12797612, 0.10574646,0.09470057,0.07647423,0.05738756, &
+          0.03935621,0.00423789,0.00342651,0.00264549, 0.00190188,0.00118281,0.00042592,0.00005583, &
+          0.16809277,0.16193336,0.15013184,0.12937409, 0.10720784,0.09485368,0.07692636,0.05771774, &
+          0.03966988,0.00427754,0.00349696,0.00268946, 0.00193536,0.00120222,0.00043462,0.00005712, &
+          0.16517997,0.16059248,0.14984852,0.13079269, 0.10865030,0.09492947,0.07759736,0.05812201, &
+          0.03997169,0.00432356,0.00355308,0.00274031, 0.00197243,0.00122401,0.00044359,0.00005849, &
+          0.16209179,0.15912023,0.14938223,0.13198245, 0.11077233,0.09487948,0.07831636,0.05863440, &
+          0.04028239,0.00436804,0.00360407,0.00279885, 0.00200364,0.00124861,0.00045521,0.00005996, &
+          0.15962425,0.15789343,0.14898103,0.13275230, 0.11253940,0.09503502,0.07884382,0.05908009, &
+          0.04053524,0.00439971,0.00364269,0.00284965, 0.00202758,0.00127076,0.00046408,0.00006114, &
+          0.15926200,0.15770932,0.14891729,0.13283882, 0.11276010,0.09507311,0.07892222,0.05919230, &
+          0.04054824,0.00440833,0.00365575,0.00286459, 0.00203786,0.00128405,0.00046504,0.00006146, &
+          0.15926351,0.15770483,0.14891177,0.13279966, 0.11268171,0.09515216,0.07890341,0.05924807, &
+          0.04052851,0.00440870,0.00365425,0.00286878, 0.00205747,0.00128916,0.00046589,0.00006221, &
+          0.15937765,0.15775780,0.14892603,0.13273248, 0.11252731,0.09521657,0.07885858,0.05927679, &
+          0.04050184,0.00440285,0.00365748,0.00286791, 0.00207507,0.00129193,0.00046679,0.00006308/
+!     From P = 0.432 mb.                                                         
+      DATA FRACREFB2/ &                                                             
+          0.17444289,0.16467269,0.15021490,0.12460902, &                         
+          0.10400643,0.09481928,0.07590704,0.05752856, &                         
+          0.03931715,0.00428572,0.00349352,0.00278938, &                         
+          0.00203448,0.00130037,0.00051560,0.00006255/                           
+                                                                                 
+      DATA FORREF2/ &                                                               
+         -2.34550E-03,-8.42698E-03,-2.01816E-02,-5.66701E-02, &                  
+         -8.93189E-02,-6.37487E-02,-4.56455E-02,-4.41417E-02, &                  
+         -4.48605E-02,-4.74696E-02,-5.16648E-02,-5.63099E-02, &                  
+         -4.74781E-02,-3.84704E-02,-2.49905E-02, 2.02114E-03/                    
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA3/ &                                                             
+!     From P = 1053.6 mb.                                                        
+          0.15116400,0.14875700,0.14232300,0.13234501, 0.11881600,0.10224100,0.08345580,0.06267490, &                         
+          0.04250650,0.00462650,0.00382259,0.00302600, 0.00222004,0.00141397,0.00053379,0.00007421, &                         
+          0.15266000,0.14888400,0.14195900,0.13179500, 0.11842700,0.10209000,0.08336130,0.06264370, &                         
+          0.04247660,0.00461946,0.00381536,0.00302601, 0.00222004,0.00141397,0.00053302,0.00007498, &                         
+          0.15282799,0.14903000,0.14192399,0.13174300, 0.11835300,0.10202700,0.08329830,0.06264830, &                         
+          0.04246910,0.00460242,0.00381904,0.00301573, 0.00222004,0.00141397,0.00053379,0.00007421, &                         
+          0.15298399,0.14902800,0.14193401,0.13173500, 0.11833300,0.10195800,0.08324730,0.06264770, &                         
+          0.04246490,0.00460489,0.00381123,0.00301893, 0.00221093,0.00141397,0.00053379,0.00007421, &                         
+          0.15307599,0.14907201,0.14198899,0.13169800, 0.11827300,0.10192300,0.08321600,0.06263490, &                         
+          0.04245600,0.00460846,0.00380836,0.00301663, 0.00221402,0.00141167,0.00052807,0.00007376, &                         
+          0.15311401,0.14915401,0.14207301,0.13167299, 0.11819300,0.10188900,0.08318760,0.06261960, &                         
+          0.04243890,0.00461584,0.00380929,0.00300815, 0.00221736,0.00140588,0.00052776,0.00007376, &                         
+          0.15316001,0.14925499,0.14213000,0.13170999, 0.11807700,0.10181400,0.08317400,0.06260300, &                         
+          0.04242720,0.00461520,0.00381381,0.00301285, 0.00220275,0.00140371,0.00052776,0.00007376, &                         
+          0.15321200,0.14940999,0.14222500,0.13164200, 0.11798200,0.10174500,0.08317500,0.06253640, &                         
+          0.04243130,0.00461724,0.00381534,0.00300320, 0.00220091,0.00140364,0.00052852,0.00007300, &                         
+          0.15312800,0.14973100,0.14234400,0.13168900, 0.11795200,0.10156100,0.08302990,0.06252240, &                         
+          0.04240980,0.00461035,0.00381381,0.00300176, 0.00220160,0.00140284,0.00052774,0.00007376, &                         
+          0.15292500,0.14978001,0.14242400,0.13172600, 0.11798800,0.10156400,0.08303050,0.06251670, &                         
+          0.04240970,0.00461302,0.00381452,0.00300250, 0.00220126,0.00140324,0.00052850,0.00007300/                           
+      DATA FRACREFB3/ &                                                             
+!     From P = 64.1 mb.                                                          
+          0.16340201,0.15607700,0.14601400,0.13182700, &                         
+          0.11524700,0.09666570,0.07825360,0.05849780, &                         
+          0.03949650,0.00427980,0.00353719,0.00279303, &                         
+          0.00204788,0.00130139,0.00049055,0.00006904, &                         
+          0.15762900,0.15494700,0.14659800,0.13267800, &                         
+          0.11562700,0.09838360,0.07930420,0.05962700, &                         
+          0.04036360,0.00438053,0.00361463,0.00285723, &                         
+          0.00208345,0.00132135,0.00050528,0.00008003, &                         
+          0.15641500,0.15394500,0.14633600,0.13180400, &                         
+          0.11617100,0.09924170,0.08000510,0.06021420, &                         
+          0.04082730,0.00441694,0.00365364,0.00287723, &                         
+          0.00210914,0.00135784,0.00054651,0.00008003, &                         
+          0.15482700,0.15286300,0.14392500,0.13244100, &                         
+          0.11712000,0.09994920,0.08119200,0.06104360, &                         
+          0.04135600,0.00446685,0.00368377,0.00290767, &                         
+          0.00215445,0.00142865,0.00056142,0.00008003, &                         
+          0.15975100,0.15653500,0.14214399,0.12892200, &                         
+          0.11508400,0.09906020,0.08087940,0.06078190, &                         
+          0.04140530,0.00452724,0.00374558,0.00295328, &                         
+          0.00218509,0.00138644,0.00056018,0.00008003/                           
+                                                                                 
+      DATA ABSN2OA3/ &                                                              
+          1.50387E-01,2.91407E-01,6.28803E-01,9.65619E-01, &                     
+          1.15054E-00,2.23424E-00,1.83392E-00,1.39033E-00, &                     
+          4.28457E-01,2.73502E-01,1.84307E-01,1.61325E-01, &                     
+          7.66314E-02,1.33862E-01,6.71196E-07,1.59293E-06/                       
+      DATA ABSN2OB3/ &                                                              
+          9.37044E-05,1.23318E-03,7.91720E-03,5.33005E-02, &                     
+          1.72343E-01,4.29571E-01,1.01288E+00,3.83863E+00, &                     
+          1.15312E+01,1.08383E+00,2.24847E+00,1.51268E+00, &                     
+          3.33177E-01,7.82102E-01,3.44631E-01,1.61039E-03/                       
+      DATA FORREF3/ &                                                               
+          1.76842E-04, 1.77913E-04, 1.25186E-04, 1.07912E-04, &                  
+          1.05217E-04, 7.48726E-05, 1.11701E-04, 7.68921E-05, &                  
+          9.87242E-05, 9.85711E-05, 6.16557E-05,-1.61291E-05, &                  
+         -1.26794E-04,-1.19011E-04,-2.67814E-04, 6.95005E-05/                    
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA4/ &                                                             
+!     From P =                                                                   
+          0.15579100,0.14918099,0.14113800,0.13127001, &                         
+          0.11796300,0.10174300,0.08282370,0.06238150, &                         
+          0.04213440,0.00458968,0.00377949,0.00298736, &                         
+          0.00220743,0.00140644,0.00053024,0.00007459, &                         
+          0.15292799,0.15004000,0.14211500,0.13176700, &                         
+          0.11821100,0.10186300,0.08288040,0.06241390, &                         
+          0.04220720,0.00459006,0.00377919,0.00298743, &                         
+          0.00220743,0.00140644,0.00053024,0.00007459, &                         
+          0.14386199,0.15125300,0.14650001,0.13377000, &                         
+          0.11895900,0.10229400,0.08312110,0.06239520, &                         
+          0.04225560,0.00459428,0.00378865,0.00298860, &                         
+          0.00220743,0.00140644,0.00053024,0.00007459, &                         
+          0.14359100,0.14561599,0.14479300,0.13740200, &                         
+          0.12150100,0.10315400,0.08355480,0.06247240, &                         
+          0.04230980,0.00459916,0.00378373,0.00300063, &                         
+          0.00221111,0.00140644,0.00053024,0.00007459, &                         
+          0.14337599,0.14451601,0.14238000,0.13520500, &                         
+          0.12354200,0.10581200,0.08451810,0.06262440, &                         
+          0.04239590,0.00460297,0.00378701,0.00300466, &                         
+          0.00221899,0.00141020,0.00053024,0.00007459, &                         
+          0.14322001,0.14397401,0.14117201,0.13401900, &                         
+          0.12255500,0.10774100,0.08617650,0.06296420, &                         
+          0.04249590,0.00463406,0.00378241,0.00302037, &                         
+          0.00221583,0.00141103,0.00053814,0.00007991, &                         
+          0.14309500,0.14364301,0.14043900,0.13348100, &                         
+          0.12211600,0.10684700,0.08820590,0.06374610, &                         
+          0.04264730,0.00464231,0.00384022,0.00303427, &                         
+          0.00221825,0.00140943,0.00055564,0.00007991, &                         
+          0.15579100,0.14918099,0.14113800,0.13127001, &                         
+          0.11796300,0.10174300,0.08282370,0.06238150, &                         
+          0.04213440,0.00458968,0.00377949,0.00298736, &                         
+          0.00220743,0.00140644,0.00053024,0.00007459, &                         
+          0.15937001,0.15159500,0.14242800,0.13078900, &                         
+          0.11671300,0.10035700,0.08143450,0.06093850, &                         
+          0.04105320,0.00446233,0.00369844,0.00293784, &                         
+          0.00216425,0.00143403,0.00054571,0.00007991/                           
+      DATA FRACREFB4/ &                                                             
+!     From P = 1.17 mb.                                                          
+          0.15558299,0.14930600,0.14104301,0.13124099, &                         
+          0.11792900,0.10159200,0.08314130,0.06240450, &                         
+          0.04217020,0.00459313,0.00379798,0.00299835, &                         
+          0.00218950,0.00140615,0.00053010,0.00007457, &                         
+          0.15592700,0.14918999,0.14095700,0.13115700, &                         
+          0.11788900,0.10158000,0.08313780,0.06240240, &                         
+          0.04217000,0.00459313,0.00379798,0.00299835, &                         
+          0.00218950,0.00140615,0.00053010,0.00007457, &                         
+          0.15949000,0.15014900,0.14162201,0.13080800, &                         
+          0.11713500,0.10057100,0.08170080,0.06128110, &                         
+          0.04165600,0.00459202,0.00379835,0.00299717, &                         
+          0.00218958,0.00140616,0.00053010,0.00007457, &                         
+          0.15967900,0.15038200,0.14196999,0.13074800, &                         
+          0.11701700,0.10053000,0.08160790,0.06122690, &                         
+          0.04128310,0.00456598,0.00379486,0.00299457, &                         
+          0.00219016,0.00140619,0.00053011,0.00007456, &                         
+          0.15989800,0.15057300,0.14207700,0.13068600, &                         
+          0.11682900,0.10053900,0.08163610,0.06121870, &                         
+          0.04121690,0.00449061,0.00371235,0.00294207, &                         
+          0.00217778,0.00139877,0.00053011,0.00007455, &                         
+          0.15950100,0.15112500,0.14199100,0.13071300, &                         
+          0.11680800,0.10054600,0.08179050,0.06120910, &                         
+          0.04126050,0.00444324,0.00366843,0.00289369, &                         
+          0.00211550,0.00134746,0.00050874,0.00007863/                           
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA5/ &                                                             
+!     From P = 387.6 mb.                                                         
+          0.13966499,0.14138900,0.13763399,0.13076700, &                         
+          0.12299100,0.10747700,0.08942000,0.06769200, &                         
+          0.04587610,0.00501173,0.00415809,0.00328398, &                         
+          0.00240015,0.00156222,0.00059104,0.00008323, &                         
+          0.13958199,0.14332899,0.13785399,0.13205400, &                         
+          0.12199700,0.10679600,0.08861080,0.06712320, &                         
+          0.04556030,0.00500863,0.00416315,0.00328629, &                         
+          0.00240023,0.00156220,0.00059104,0.00008323, &                         
+          0.13907100,0.14250501,0.13889600,0.13297300, &                         
+          0.12218700,0.10683800,0.08839260,0.06677310, &                         
+          0.04538570,0.00495402,0.00409863,0.00328219, &                         
+          0.00240805,0.00156266,0.00059104,0.00008323, &                         
+          0.13867700,0.14190100,0.13932300,0.13327099, &                         
+          0.12280800,0.10692500,0.08844510,0.06658510, &                         
+          0.04519340,0.00492276,0.00408832,0.00323856, &                         
+          0.00239289,0.00155698,0.00059104,0.00008323, &                         
+          0.13845000,0.14158800,0.13929300,0.13295600, &                         
+          0.12348300,0.10736700,0.08859480,0.06650610, &                         
+          0.04498230,0.00491335,0.00406968,0.00322901, &                         
+          0.00234666,0.00155235,0.00058813,0.00008323, &                         
+          0.13837101,0.14113200,0.13930500,0.13283101, &                         
+          0.12349200,0.10796400,0.08890490,0.06646480, &                         
+          0.04485990,0.00489554,0.00405264,0.00320313, &                         
+          0.00234742,0.00151159,0.00058438,0.00008253, &                         
+          0.13834500,0.14093500,0.13896500,0.13262001, &                         
+          0.12326900,0.10828900,0.08950050,0.06674610, &                         
+          0.04476560,0.00489624,0.00400962,0.00317423, &                         
+          0.00233479,0.00148249,0.00058590,0.00008253, &                         
+          0.13831300,0.14069000,0.13871400,0.13247600, &                         
+          0.12251400,0.10831300,0.08977090,0.06776920, &                         
+          0.04498390,0.00484111,0.00398948,0.00316069, &                         
+          0.00229741,0.00150104,0.00058608,0.00008253, &                         
+          0.14027201,0.14420401,0.14215700,0.13446601, &                         
+          0.12303700,0.10596100,0.08650370,0.06409570, &                         
+          0.04312310,0.00471110,0.00393954,0.00310850, &                         
+          0.00229588,0.00146366,0.00058194,0.00008253/                           
+      DATA FRACREFB5/ &                                                             
+!     From P = 1.17 mb.                                                          
+          0.14339100,0.14358699,0.13935301,0.13306700, &                         
+          0.12135700,0.10590600,0.08688240,0.06553220, &                         
+          0.04446740,0.00483580,0.00399413,0.00316225, &                         
+          0.00233007,0.00149135,0.00056246,0.00008059, &                         
+          0.14330500,0.14430299,0.14053699,0.13355300, &                         
+          0.12151200,0.10529100,0.08627630,0.06505230, &                         
+          0.04385850,0.00476555,0.00395010,0.00313878, &                         
+          0.00232273,0.00149354,0.00056246,0.00008059, &                         
+          0.14328399,0.14442700,0.14078601,0.13390100, &                         
+          0.12132600,0.10510600,0.08613660,0.06494630, &                         
+          0.04381310,0.00475378,0.00394166,0.00313076, &                         
+          0.00231235,0.00149159,0.00056301,0.00008059, &                         
+          0.14326900,0.14453100,0.14114200,0.13397101, &                         
+          0.12127200,0.10493400,0.08601380,0.06483360, &                         
+          0.04378900,0.00474655,0.00393549,0.00312583, &                         
+          0.00230686,0.00148433,0.00056502,0.00008059, &                         
+          0.14328900,0.14532700,0.14179000,0.13384600, &                         
+          0.12093700,0.10461500,0.08573010,0.06461340, &                         
+          0.04366570,0.00473087,0.00392539,0.00311238, &                         
+          0.00229865,0.00147572,0.00056517,0.00007939/                           
+                                                                                 
+      DATA CCL45/ &                                                                 
+           26.1407,  53.9776,  63.8085,  36.1701, &                              
+           15.4099, 10.23116,  4.82948,  5.03836, &                              
+           1.75558,0.,0.,0., &                                                   
+           0.,0.,0.,0./                                                          
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA6/ &                                                             
+!     From P = 706 mb.                                                           
+          0.13739009,0.14259538,0.14033118,0.13547136, &                         
+          0.12569460,0.11028396,0.08626066,0.06245148, &                         
+          0.04309394,0.00473551,0.00403920,0.00321695, &                         
+          0.00232470,0.00147662,0.00056095,0.00007373/                           
+                                                                                 
+      DATA CFC11ADJ6/ &                                                             
+           0.,  0., 36.7627,  150.757,   &                                      
+           81.4109, 74.9112, 56.9325, 49.3226, &                                 
+           57.1074, 66.1202, 109.557, 89.0562, &                                 
+           149.865, 196.140, 258.393, 80.9923/                                   
+      DATA CFC126/ &                                                                
+           62.8368, 43.2626, 26.7549, 22.2487, &                                 
+           23.5029, 34.8323, 26.2335, 23.2306, &                                 
+           18.4062, 13.9534, 22.6268, 24.2604, &                                 
+           30.0088, 26.3634, 15.8237, 57.5050/                                   
+      DATA ABSCO26/ &                                                               
+           7.44852E-05, 6.29208E-05, 7.34031E-05, 6.65218E-05, &                 
+           7.87511E-05, 1.22489E-04, 3.39785E-04, 9.33040E-04, &                 
+           1.54323E-03, 4.07220E-04, 4.34332E-04, 8.76418E-05, &                 
+           9.80381E-05, 3.51680E-05, 5.31766E-05, 1.01542E-05/                   
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA7/ &                                                             
+          0.16461779, 0.14889984, 0.14233345, 0.13156526, &                      
+          0.11679733, 0.09988949, 0.08078653, 0.06006384, &                      
+          0.04028391, 0.00435899, 0.00359173, 0.00281707, &                      
+          0.00206767, 0.00135012, 0.00050720, 0.00007146, &                      
+          0.16442357, 0.14944240, 0.14245804, 0.13111183, &                      
+          0.11688625, 0.09983791, 0.08085148, 0.05993948, &                      
+          0.04028057, 0.00435939, 0.00358708, 0.00284036, &                      
+          0.00208869, 0.00133256, 0.00049260, 0.00006931, &                      
+          0.16368519, 0.15018989, 0.14262174, 0.13084342, &                      
+          0.11682195, 0.09996257, 0.08074036, 0.05985692, &                      
+          0.04045362, 0.00436208, 0.00358257, 0.00287122, &                      
+          0.00211004, 0.00133804, 0.00049260, 0.00006931, &                      
+          0.16274056, 0.15133780, 0.14228874, 0.13081114, &                      
+          0.11688486, 0.09979610, 0.08073687, 0.05996741, &                      
+          0.04040616, 0.00439869, 0.00368910, 0.00293041, &                      
+          0.00211604, 0.00133536, 0.00049260, 0.00006931, &                      
+          0.16176532, 0.15207882, 0.14226955, 0.13079646, &                      
+          0.11688191, 0.09966998, 0.08066384, 0.06020275, &                      
+          0.04047901, 0.00446696, 0.00377456, 0.00294410, &                      
+          0.00211082, 0.00133536, 0.00049260, 0.00006931, &                      
+          0.15993737, 0.15305527, 0.14259829, 0.13078023, &                      
+          0.11686983, 0.09980131, 0.08058286, 0.06031430, &                      
+          0.04082833, 0.00450509, 0.00377574, 0.00294823, &                      
+          0.00210977, 0.00133302, 0.00049260, 0.00006931, &                      
+          0.15371189, 0.15592396, 0.14430280, 0.13076764, &                      
+          0.11720382, 0.10023471, 0.08066396, 0.06073554, &                      
+          0.04121581, 0.00451202, 0.00377832, 0.00294609, &                      
+          0.00210943, 0.00133336, 0.00049260, 0.00006931, &                      
+          0.14262275, 0.14572631, 0.14560597, 0.13736825, &                      
+          0.12271351, 0.10419556, 0.08294533, 0.06199794, &                      
+          0.04157615, 0.00452842, 0.00377704, 0.00293852, &                      
+          0.00211034, 0.00133278, 0.00049259, 0.00006931, &                      
+          0.14500433, 0.14590444, 0.14430299, 0.13770708, &                      
+          0.12288283, 0.10350952, 0.08269450, 0.06130579, &                      
+          0.04144571, 0.00452096, 0.00377382, 0.00294532, &                      
+          0.00210943, 0.00133228, 0.00049260, 0.00006931/                        
+      DATA FRACREFB7/ &                                                             
+          0.15355594,0.15310939,0.14274909,0.13129812, &                         
+          0.11736792,0.10118213,0.08215259,0.06165591, &                         
+          0.04164486,0.00451141,0.00372837,0.00294095, &                         
+          0.00215259,0.00136792,0.00051233,0.00007075/                           
+                                                                                 
+      DATA ABSCO27/ &                                                               
+          9.30038E-05, 1.74061E-04, 2.09293E-04, 2.52360E-04, &                  
+          3.13404E-04, 4.16619E-04, 6.27394E-04, 1.29386E-03, &                  
+          4.05192E-03, 3.97050E-03, 7.00634E-04, 6.06617E-04, &                  
+          7.66978E-04, 6.70661E-04, 7.89971E-04, 7.55709E-04/                    
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA8/ &                                                             
+!     From P = 1053.6 mb.                                                        
+          0.15309700,0.15450300,0.14458799,0.13098200, &                         
+          0.11817900,0.09953490,0.08132080,0.06139960, &                         
+          0.04132010,0.00446788,0.00372533,0.00294053, &                         
+          0.00211371,0.00128122,0.00048050,0.00006759/                           
+      DATA FRACREFB8/ &                                                             
+!     From P = 28.9 mb.                                                          
+          0.14105400,0.14728899,0.14264800,0.13331699, &                         
+          0.12034100,0.10467000,0.08574980,0.06469390, &                         
+          0.04394640,0.00481284,0.00397375,0.00315006, &                         
+          0.00228636,0.00144606,0.00054604,0.00007697/                           
+                                                                                 
+      DATA CFC128/ &                                                                
+           85.4027, 89.4696, 74.0959, 67.7480, &                                 
+           61.2444, 59.9073, 60.8296, 63.0998, &                                 
+           59.6110, 64.0735, 57.2622, 58.9721, &                                 
+           43.5505, 26.1192, 32.7023, 32.8667/                                   
+      DATA CFC22ADJ8/ &                                                             
+!     Original CFC22 is multiplied by 1.485 to account for the 780-850 cm-1      
+!     and 1290-1335 cm-1 bands.                                                  
+           135.335, 89.6642, 76.2375, 65.9748, &                                 
+           63.1164, 60.2935, 64.0299, 75.4264, &                                 
+           51.3018, 7.07911, 5.86928, 0.398693, &                                
+           2.82885, 9.12751, 6.28271, 0./                                        
+      DATA ABSCO2A8/ &                                                              
+           1.11233E-05, 3.92400E-05, 6.62059E-05, 8.51687E-05, &                 
+           7.79035E-05, 1.34058E-04, 2.82553E-04, 5.41741E-04, &                 
+           1.47029E-05, 2.34982E-05, 6.91094E-08, 8.48917E-08, &                 
+           6.58783E-08, 4.64849E-08, 3.62742E-08, 3.62742E-08/                   
+      DATA ABSCO2B8/ &                                                              
+           4.10977E-09, 5.65200E-08, 1.70800E-07, 4.16840E-07, &                 
+           9.53684E-07, 2.36468E-06, 7.29502E-06, 4.93883E-05, &                 
+           5.10440E-04, 9.75248E-04, 1.36495E-03, 2.40451E-03, &                 
+           4.50277E-03, 2.24486E-02, 4.06756E-02, 2.17447E-10/                   
+      DATA ABSN2OA8/ &                                                              
+           1.28527E-02,5.28651E-02,1.01668E-01,1.57224E-01, &                    
+           2.76947E-01,4.93048E-01,6.71387E-01,3.48809E-01, &                    
+           4.19840E-01,3.13558E-01,2.44432E-01,2.05108E-01, &                    
+           1.21423E-01,1.22158E-01,1.49702E-01,1.47799E-01/                      
+      DATA ABSN2OB8/ &                                                              
+           3.15864E-03,4.87347E-03,8.63235E-03,2.16053E-02, &                    
+           3.63699E-02,7.89149E-02,3.53807E-01,1.27140E-00, &                    
+           2.31464E-00,7.75834E-02,5.15063E-02,4.07059E-02, &                    
+           5.91947E-02,5.83546E-02,3.12716E-01,1.47456E-01/                      
+                                                                                 
+!  Data                                                                          
+                                                                                 
+      DATA FRACREFA9/ &                                                             
+!     From P = 1053.6 mb.                                                        
+          0.16898900,0.15898301,0.13575301,0.12600900, &                         
+          0.11545800,0.09879170,0.08106830,0.06063440, &                         
+          0.03988780,0.00421760,0.00346635,0.00278779, &                         
+          0.00206225,0.00132324,0.00050033,0.00007038, &                         
+          0.18209399,0.15315101,0.13571000,0.12504999, &                         
+          0.11379100,0.09680810,0.08008570,0.05970280, &                         
+          0.03942860,0.00413383,0.00343186,0.00275558, &                         
+          0.00204657,0.00130219,0.00045454,0.00005664, &                         
+          0.18459500,0.15512000,0.13395500,0.12576801, &                         
+          0.11276800,0.09645190,0.07956650,0.05903340, &                         
+          0.03887050,0.00412226,0.00339453,0.00273518, &                         
+          0.00196922,0.00119411,0.00040263,0.00005664, &                         
+          0.18458800,0.15859900,0.13278100,0.12589300, &                         
+          0.11272700,0.09599660,0.07903030,0.05843600, &                         
+          0.03843400,0.00405181,0.00337980,0.00263818, &                         
+          0.00186869,0.00111807,0.00040263,0.00005664, &                         
+          0.18459301,0.16176100,0.13235000,0.12528200, &                         
+          0.11237100,0.09618840,0.07833760,0.05800770, &                         
+          0.03787610,0.00408253,0.00330363,0.00250445, &                         
+          0.00176725,0.00111753,0.00040263,0.00005664, &                         
+          0.18454400,0.16505300,0.13221300,0.12476600, &                         
+          0.11158300,0.09618120,0.07797340,0.05740380, &                         
+          0.03742820,0.00392691,0.00312208,0.00246306, &                         
+          0.00176735,0.00111721,0.00040263,0.00005664, &                         
+          0.18452001,0.16697501,0.13445500,0.12391300, &                         
+          0.11059100,0.09596890,0.07761050,0.05643200, &                         
+          0.03686520,0.00377086,0.00309351,0.00246297, &                         
+          0.00176765,0.00111700,0.00040263,0.00005664, &                         
+          0.18460999,0.16854499,0.13922299,0.12266400, &                         
+          0.10962200,0.09452030,0.07653800,0.05551340, &                         
+          0.03609660,0.00377043,0.00309367,0.00246304, &                         
+          0.00176749,0.00111689,0.00040263,0.00005664, &                         
+          0.18312500,0.16787501,0.14720701,0.12766500, &                         
+          0.10890900,0.08935530,0.07310870,0.05443140, &                         
+          0.03566380,0.00376446,0.00309521,0.00246510, &                         
+          0.00176139,0.00111543,0.00040263,0.00005664/                           
+      DATA FRACREFB9/ &                                                             
+!     From P = 0.071 mb.                                                         
+          0.20148601,0.15252700,0.13376500,0.12184600, &                         
+          0.10767800,0.09307410,0.07674570,0.05876940, &                         
+          0.04001480,0.00424612,0.00346896,0.00269954, &                         
+          0.00196864,0.00122562,0.00043628,0.00004892/                           
+                                                                                 
+      DATA ABSN2O9/ &                                                               
+!     From P = 952 mb.                                                           
+           3.26267E-01,2.42869E-00,1.15455E+01,7.39478E-00, &                    
+           5.16550E-00,2.54474E-00,3.53082E-00,3.82278E-00, &                    
+           1.81297E-00,6.65313E-01,1.23652E-01,1.83895E-03, &                    
+           1.70592E-03,2.68434E-09,0.,0., &                                      
+!     From P = 620 mb.                                                           
+           2.08632E-01,1.11865E+00,4.95975E+00,8.10907E+00, &                    
+           1.10408E+01,5.45460E+00,4.18611E+00,3.53422E+00, &                    
+           2.54164E+00,3.65093E-01,5.84480E-01,2.26918E-01, &                    
+           1.36230E-03,5.54400E-10,6.83703E-10,0., &                             
+!     From P = 313 mb.                                                           
+           6.20022E-02,2.69521E-01,9.81928E-01,1.65004E-00, &                    
+           3.08089E-00,5.38696E-00,1.14600E+01,2.41211E+01, &                    
+           1.69655E+01,1.37556E-00,5.43254E-01,3.52079E-01, &                    
+           4.31888E-01,4.82523E-06,5.74747E-11,0./                               
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA10/ &                                                             
+!     From P = 473 mb.                                                           
+          0.16271301,0.15141940,0.14065412,0.12899506, &                         
+          0.11607002,0.10142808,0.08116794,0.06104711, &                         
+          0.04146209,0.00447386,0.00372902,0.00287258, &                         
+          0.00206028,0.00134634,0.00049232,0.00006927/                           
+      DATA FRACREFB10/ &                                                             
+!     From P = 1.17 mb.                                                          
+          0.16571465,0.15262246,0.14036226,0.12620729, &                         
+          0.11477834,0.09967982,0.08155201,0.06159503, &                         
+          0.04196607,0.00453940,0.00376881,0.00300437, &                         
+          0.00223034,0.00139432,0.00051516,0.00007095/                           
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA11/ &                                                             
+!     From P = 473 mb.                                                           
+          0.14152819,0.13811260,0.14312185,0.13705885, &                         
+          0.11944738,0.10570189,0.08866373,0.06565409, &                         
+          0.04428961,0.00481540,0.00387058,0.00329187, &                         
+          0.00238294,0.00150971,0.00049287,0.00005980/                           
+      DATA FRACREFB11/ &                                                             
+!     From P = 1.17 mb.                                                          
+          0.10874039,0.15164889,0.15149839,0.14515044, &                         
+          0.12486220,0.10725017,0.08715712,0.06463144, &                         
+          0.04332319,0.00441193,0.00393819,0.00305960, &                         
+          0.00224221,0.00145100,0.00055586,0.00007934/                           
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA12/ &                                                             
+!     From P = 706.3 mb.                                                         
+          0.21245100,0.15164700,0.14486700,0.13075501, &                         
+          0.11629600,0.09266050,0.06579930,0.04524000, &                         
+          0.03072870,0.00284297,0.00234660,0.00185208, &                         
+          0.00133978,0.00082214,0.00031016,0.00004363, &                         
+          0.14703900,0.16937999,0.15605700,0.14159000, &                         
+          0.12088500,0.10058500,0.06809110,0.05131470, &                         
+          0.03487040,0.00327281,0.00250183,0.00190024, &                         
+          0.00133978,0.00082214,0.00031016,0.00004363, &                         
+          0.13689300,0.16610400,0.15723500,0.14299500, &                         
+          0.12399400,0.09907820,0.07169690,0.05367370, &                         
+          0.03671630,0.00378148,0.00290510,0.00221076, &                         
+          0.00142810,0.00093527,0.00031016,0.00004363, &                         
+          0.13054299,0.16273800,0.15874299,0.14279599, &                         
+          0.12674300,0.09664900,0.07462200,0.05620080, &                         
+          0.03789090,0.00411690,0.00322920,0.00245036, &                         
+          0.00178303,0.00098595,0.00040802,0.00010150, &                         
+          0.12828299,0.15824600,0.15688400,0.14449100, &                         
+          0.12787800,0.09517830,0.07679350,0.05890820, &                         
+          0.03883570,0.00442304,0.00346796,0.00255333, &                         
+          0.00212519,0.00116168,0.00067065,0.00010150, &                         
+          0.12649800,0.15195100,0.15646499,0.14569700, &                         
+          0.12669300,0.09653520,0.07887920,0.06106920, &                         
+          0.04043910,0.00430390,0.00364453,0.00314360, &                         
+          0.00203206,0.00187787,0.00067075,0.00010150, &                         
+          0.12500300,0.14460599,0.15672199,0.14724600, &                         
+          0.11978900,0.10190200,0.08196710,0.06315770, &                         
+          0.04240100,0.00433645,0.00404097,0.00329466, &                         
+          0.00288491,0.00187803,0.00067093,0.00010150, &                         
+          0.12317200,0.14118700,0.15242000,0.13794300, &                         
+          0.12119200,0.10655400,0.08808350,0.06521370, &                         
+          0.04505680,0.00485949,0.00477105,0.00401468, &                         
+          0.00288491,0.00187786,0.00067110,0.00010150, &                         
+          0.10193600,0.11693000,0.13236099,0.14053200, &                         
+          0.13749801,0.12193100,0.10221000,0.07448910, &                         
+          0.05205320,0.00572312,0.00476882,0.00403380, &                         
+          0.00288871,0.00187396,0.00067218,0.00010150/                           
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA13/ &                                                             
+!     From P = 706.3 mb.                                                         
+          0.17683899,0.17319500,0.15712699,0.13604601, &                         
+          0.10776200,0.08750010,0.06808820,0.04905150, &                         
+          0.03280360,0.00350836,0.00281864,0.00219862, &                         
+          0.00160943,0.00101885,0.00038147,0.00005348, &                         
+          0.17535400,0.16999300,0.15610200,0.13589200, &                         
+          0.10842100,0.08988550,0.06943920,0.04974900, &                         
+          0.03323400,0.00352752,0.00289402,0.00231003, &                         
+          0.00174659,0.00101884,0.00038147,0.00005348, &                         
+          0.17409500,0.16846400,0.15641899,0.13503000, &                         
+          0.10838600,0.08985800,0.07092720,0.05075710, &                         
+          0.03364180,0.00354241,0.00303507,0.00243391, &                         
+          0.00177502,0.00114638,0.00043585,0.00005348, &                         
+          0.17248300,0.16778600,0.15543500,0.13496999, &                         
+          0.10826300,0.09028740,0.07156720,0.05187120, &                         
+          0.03424890,0.00363933,0.00324715,0.00255030, &                         
+          0.00187380,0.00116978,0.00051229,0.00009768, &                         
+          0.17061099,0.16715799,0.15405200,0.13471501, &                         
+          0.10896400,0.09069460,0.07229760,0.05218280, &                         
+          0.03555340,0.00379576,0.00330240,0.00274693, &                         
+          0.00201587,0.00119598,0.00061885,0.00009768, &                         
+          0.16789700,0.16629100,0.15270300,0.13360199, &                         
+          0.11047200,0.09151080,0.07325000,0.05261450, &                         
+          0.03657990,0.00450092,0.00349537,0.00283321, &                         
+          0.00208396,0.00140354,0.00066587,0.00009768, &                         
+          0.16412200,0.16387400,0.15211500,0.13062200, &                         
+          0.11325100,0.09348130,0.07381380,0.05434740, &                         
+          0.03803160,0.00481346,0.00393592,0.00296633, &                         
+          0.00222532,0.00163762,0.00066648,0.00009768, &                         
+          0.15513401,0.15768200,0.14850400,0.13330200, &                         
+          0.11446500,0.09868230,0.07642050,0.05624170, &                         
+          0.04197810,0.00502288,0.00429452,0.00315347, &                         
+          0.00263559,0.00171772,0.00066860,0.00009768, &                         
+          0.15732600,0.15223300,0.14271900,0.13563600, &                         
+          0.11859600,0.10274200,0.07934560,0.05763410, &                         
+          0.03921740,0.00437741,0.00337921,0.00280212, &                         
+          0.00200156,0.00124812,0.00064664,0.00009768/                           
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA14/ &                                                             
+!     From P = 1053.6 mb.                                                        
+          0.18446200,0.16795200,0.14949700,0.12036000, &                         
+          0.10440100,0.09024280,0.07435880,0.05629380, &                         
+          0.03825420,0.00417276,0.00345278,0.00272949, &                         
+          0.00200378,0.00127404,0.00050721,0.00004141/                           
+      DATA FRACREFB14/ &                                                             
+!     From P = 0.64 mb.                                                          
+          0.19128500,0.16495700,0.14146100,0.11904500, &                         
+          0.10350200,0.09151190,0.07604270,0.05806020, &                         
+          0.03979950,0.00423959,0.00357439,0.00287559, &                         
+          0.00198860,0.00116529,0.00043616,0.00005987/                           
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA15/ &                                                             
+!     From P = 1053.6 mb.                                                        
+          0.11287100,0.12070200,0.12729000,0.12858100, &                         
+          0.12743001,0.11961800,0.10290400,0.07888980, &                         
+          0.05900120,0.00667979,0.00552926,0.00436993, &                         
+          0.00320611,0.00204765,0.00077371,0.00010894, &                         
+          0.13918801,0.16353001,0.16155800,0.14090499, &                         
+          0.11322300,0.08757720,0.07225720,0.05173390, &                         
+          0.04731360,0.00667979,0.00552926,0.00436993, &                         
+          0.00320611,0.00204765,0.00077371,0.00010894, &                         
+          0.14687300,0.17853101,0.15664500,0.13351700, &                         
+          0.10791200,0.08684320,0.07158090,0.05198410, &                         
+          0.04340110,0.00667979,0.00552926,0.00436993, &                         
+          0.00320611,0.00204765,0.00077371,0.00010894, &                         
+          0.15760700,0.17759100,0.15158001,0.13193300, &                         
+          0.10742800,0.08693760,0.07159490,0.05196250, &                         
+          0.04065270,0.00667979,0.00552926,0.00436993, &                         
+          0.00320611,0.00204765,0.00077371,0.00010894, &                         
+          0.16646700,0.17299300,0.15018500,0.13138700, &                         
+          0.10735900,0.08713110,0.07130330,0.05279420, &                         
+          0.03766730,0.00667979,0.00552926,0.00436993, &                         
+          0.00320611,0.00204765,0.00077371,0.00010894, &                         
+          0.17546000,0.16666500,0.14969499,0.13105400, &                         
+          0.10782500,0.08718610,0.07156770,0.05308320, &                         
+          0.03753960,0.00432465,0.00509623,0.00436993, &                         
+          0.00320611,0.00204765,0.00077371,0.00010894, &                         
+          0.18378501,0.16064601,0.14940400,0.13146400, &                         
+          0.10810300,0.08775740,0.07115360,0.05400040, &                         
+          0.03689970,0.00388333,0.00323610,0.00353414, &                         
+          0.00320611,0.00204765,0.00077371,0.00010894, &                         
+          0.18966800,0.15744300,0.14993000,0.13152599, &                         
+          0.10899200,0.08858690,0.07142920,0.05399600, &                         
+          0.03433460,0.00374886,0.00302066,0.00240653, &                         
+          0.00199205,0.00204765,0.00077371,0.00010894, &                         
+          0.11887100,0.12479600,0.12569501,0.12839900, &                         
+          0.12473500,0.12012800,0.11086700,0.08493590, &                         
+          0.05063770,0.00328723,0.00266849,0.00210232, &                         
+          0.00152114,0.00095635,0.00035374,0.00004980/                           
+                                                                                 
+! Data                                                                           
+                                                                                 
+      DATA FRACREFA16/ &                                                             
+!     From P = 862.6 mb.                                                         
+          0.17356300,0.18880001,0.17704099,0.13661300, &                         
+          0.10691600,0.08222480,0.05939860,0.04230810, &                         
+          0.02526330,0.00244532,0.00193541,0.00150415, &                         
+          0.00103528,0.00067068,0.00024951,0.00003348, &                         
+          0.17779499,0.19837400,0.16557600,0.13470000, &                         
+          0.11013600,0.08342720,0.05987030,0.03938700, &                         
+          0.02293650,0.00238849,0.00192400,0.00149921, &                         
+          0.00103539,0.00067150,0.00024822,0.00003348, &                         
+          0.18535601,0.19407199,0.16053200,0.13300700, &                         
+          0.10779000,0.08408500,0.06480450,0.04070160, &                         
+          0.02203590,0.00227779,0.00189074,0.00146888, &                         
+          0.00103147,0.00066770,0.00024751,0.00003348, &                         
+          0.19139200,0.18917400,0.15748601,0.13240699, &                         
+          0.10557300,0.08383260,0.06724060,0.04364450, &                         
+          0.02175820,0.00225436,0.00184421,0.00143153, &                         
+          0.00103027,0.00066066,0.00024222,0.00003148, &                         
+          0.19547801,0.18539500,0.15442000,0.13114899, &                         
+          0.10515600,0.08350350,0.06909780,0.04671630, &                         
+          0.02168820,0.00224400,0.00182009,0.00139098, &                         
+          0.00102582,0.00065367,0.00023202,0.00003148, &                         
+          0.19757500,0.18266800,0.15208900,0.12897800, &                         
+          0.10637200,0.08391220,0.06989830,0.04964120, &                         
+          0.02155800,0.00224310,0.00177358,0.00138184, &                         
+          0.00101538,0.00063370,0.00023227,0.00003148, &                         
+          0.20145500,0.17692900,0.14940600,0.12690400, &                         
+          0.10828800,0.08553720,0.07004940,0.05153430, &                         
+          0.02268740,0.00216943,0.00178603,0.00137754, &                         
+          0.00098344,0.00063165,0.00023218,0.00003148, &                         
+          0.20383500,0.17047501,0.14570600,0.12679300, &                         
+          0.11043100,0.08719150,0.07045440,0.05345420, &                         
+          0.02448340,0.00215839,0.00175893,0.00138296, &                         
+          0.00098318,0.00063188,0.00023199,0.00003148, &                         
+          0.18680701,0.15961801,0.15092900,0.13049100, &                         
+          0.11418400,0.09380540,0.07093450,0.05664280, &                         
+          0.02938410,0.00217751,0.00176766,0.00138275, &                         
+          0.00098377,0.00063181,0.00023193,0.00003148/                           
+               
+
+!
+! end of data 3
+!
+
+!-----------------------------------------------------------------------
+
+! start data 4
+
+      DATA NXMOL  /2/
+      DATA IXINDX /0,2,3,0,31*0/
+                                                                  
+!
+! end of data 4
+!
+!-----------------------------------------------------------------------
+
+! start data 5
+                                                                  
+!     
+!  Longwave spectral band data                                                   
+
+      DATA WAVENUM1(1) /10./, WAVENUM2(1) /250./, DELWAVE(1) /240./              
+      DATA WAVENUM1(2) /250./, WAVENUM2(2) /500./, DELWAVE(2) /250./             
+      DATA WAVENUM1(3) /500./, WAVENUM2(3) /630./, DELWAVE(3) /130./             
+      DATA WAVENUM1(4) /630./, WAVENUM2(4) /700./, DELWAVE(4) /70./              
+      DATA WAVENUM1(5) /700./, WAVENUM2(5) /820./, DELWAVE(5) /120./             
+      DATA WAVENUM1(6) /820./, WAVENUM2(6) /980./, DELWAVE(6) /160./             
+      DATA WAVENUM1(7) /980./, WAVENUM2(7) /1080./, DELWAVE(7) /100./            
+      DATA WAVENUM1(8) /1080./, WAVENUM2(8) /1180./, DELWAVE(8) /100./           
+      DATA WAVENUM1(9) /1180./, WAVENUM2(9) /1390./, DELWAVE(9) /210./           
+      DATA WAVENUM1(10) /1390./,WAVENUM2(10) /1480./,DELWAVE(10) /90./           
+      DATA WAVENUM1(11) /1480./,WAVENUM2(11) /1800./,DELWAVE(11) /320./          
+      DATA WAVENUM1(12) /1800./,WAVENUM2(12) /2080./,DELWAVE(12) /280./          
+      DATA WAVENUM1(13) /2080./,WAVENUM2(13) /2250./,DELWAVE(13) /170./          
+      DATA WAVENUM1(14) /2250./,WAVENUM2(14) /2380./,DELWAVE(14) /130./          
+      DATA WAVENUM1(15) /2380./,WAVENUM2(15) /2600./,DELWAVE(15) /220./          
+      DATA WAVENUM1(16) /2600./,WAVENUM2(16) /3000./,DELWAVE(16) /400./          
+                                                                                 
+!
+! end of data 5
+!
+!-----------------------------------------------------------------------
+
+! start data 6
+
+              
+      DATA NG  /16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16/                 
+      DATA NSPA /1, 1,10, 9, 9, 1, 9, 1,11, 1, 1, 9, 9, 1, 9, 9/                 
+      DATA NSPB /1, 1, 5, 6, 5, 0, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0/                 
+                                                                                 
+!     HEATFAC is the factor by which one must multiply delta-flux/               
+!     delta-pressure, with flux in w/m-2 and pressure in mbar, to get            
+!     the heating rate in units of degrees/day.  It is equal to                  
+!           (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)             
+!        =  (9.8066)(3600)(1e-5)/(1.004)                                         
+
+      DATA HEATFAC /8.4391/                                                      
+                                                                           
+!     These pressures are chosen such that the ln of the first pressure          
+!     has only a few non-zero digits (i.e. ln(PREF(1)) = 6.96000) and            
+!     each subsequent ln(pressure) differs from the previous one by 0.2.         
+
+      DATA PREF / &                                                                 
+          1.05363E+03,8.62642E+02,7.06272E+02,5.78246E+02,4.73428E+02, & 
+          3.87610E+02,3.17348E+02,2.59823E+02,2.12725E+02,1.74164E+02, & 
+          1.42594E+02,1.16746E+02,9.55835E+01,7.82571E+01,6.40715E+01, & 
+          5.24573E+01,4.29484E+01,3.51632E+01,2.87892E+01,2.35706E+01, & 
+          1.92980E+01,1.57998E+01,1.29358E+01,1.05910E+01,8.67114E+00, & 
+          7.09933E+00,5.81244E+00,4.75882E+00,3.89619E+00,3.18993E+00, & 
+          2.61170E+00,2.13828E+00,1.75067E+00,1.43333E+00,1.17351E+00, & 
+          9.60789E-01,7.86628E-01,6.44036E-01,5.27292E-01,4.31710E-01, & 
+          3.53455E-01,2.89384E-01,2.36928E-01,1.93980E-01,1.58817E-01, & 
+          1.30029E-01,1.06458E-01,8.71608E-02,7.13612E-02,5.84256E-02, & 
+          4.78349E-02,3.91639E-02,3.20647E-02,2.62523E-02,2.14936E-02, & 
+          1.75975E-02,1.44076E-02,1.17959E-02,9.65769E-03/                       
+      DATA PREFLOG / &                                                              
+           6.9600E+00, 6.7600E+00, 6.5600E+00, 6.3600E+00, 6.1600E+00, & 
+           5.9600E+00, 5.7600E+00, 5.5600E+00, 5.3600E+00, 5.1600E+00, & 
+           4.9600E+00, 4.7600E+00, 4.5600E+00, 4.3600E+00, 4.1600E+00, & 
+           3.9600E+00, 3.7600E+00, 3.5600E+00, 3.3600E+00, 3.1600E+00, & 
+           2.9600E+00, 2.7600E+00, 2.5600E+00, 2.3600E+00, 2.1600E+00, & 
+           1.9600E+00, 1.7600E+00, 1.5600E+00, 1.3600E+00, 1.1600E+00, & 
+           9.6000E-01, 7.6000E-01, 5.6000E-01, 3.6000E-01, 1.6000E-01, & 
+          -4.0000E-02,-2.4000E-01,-4.4000E-01,-6.4000E-01,-8.4000E-01, & 
+          -1.0400E+00,-1.2400E+00,-1.4400E+00,-1.6400E+00,-1.8400E+00, & 
+          -2.0400E+00,-2.2400E+00,-2.4400E+00,-2.6400E+00,-2.8400E+00, & 
+          -3.0400E+00,-3.2400E+00,-3.4400E+00,-3.6400E+00,-3.8400E+00, & 
+          -4.0400E+00,-4.2400E+00,-4.4400E+00,-4.6400E+00/                       
+!     These are the temperatures associated with the respective                  
+!     pressures for the MLS standard atmosphere.                                 
+      DATA TREF / &                                                                 
+           2.9420E+02, 2.8799E+02, 2.7894E+02, 2.6925E+02, 2.5983E+02, & 
+           2.5017E+02, 2.4077E+02, 2.3179E+02, 2.2306E+02, 2.1578E+02, & 
+           2.1570E+02, 2.1570E+02, 2.1570E+02, 2.1706E+02, 2.1858E+02, & 
+           2.2018E+02, 2.2174E+02, 2.2328E+02, 2.2479E+02, 2.2655E+02, & 
+           2.2834E+02, 2.3113E+02, 2.3401E+02, 2.3703E+02, 2.4022E+02, & 
+           2.4371E+02, 2.4726E+02, 2.5085E+02, 2.5457E+02, 2.5832E+02, & 
+           2.6216E+02, 2.6606E+02, 2.6999E+02, 2.7340E+02, 2.7536E+02, & 
+           2.7568E+02, 2.7372E+02, 2.7163E+02, 2.6955E+02, 2.6593E+02, & 
+           2.6211E+02, 2.5828E+02, 2.5360E+02, 2.4854E+02, 2.4348E+02, & 
+           2.3809E+02, 2.3206E+02, 2.2603E+02, 2.2000E+02, 2.1435E+02, & 
+           2.0887E+02, 2.0340E+02, 1.9792E+02, 1.9290E+02, 1.8809E+02, & 
+           1.8329E+02, 1.7849E+02, 1.7394E+02, 1.7212E+02/                       
+                                                                                 
+!
+! end of data 6
+!
+!-----------------------------------------------------------------------
+
+! start data 7
+
+      DATA (TOTPLNK(IDATA, 1),IDATA=1,50)/ &                                                
+      1.13735E-06,1.15150E-06,1.16569E-06,1.17992E-06,1.19419E-06, & 
+      1.20850E-06,1.22285E-06,1.23723E-06,1.25164E-06,1.26610E-06, & 
+      1.28059E-06,1.29511E-06,1.30967E-06,1.32426E-06,1.33889E-06, & 
+      1.35355E-06,1.36824E-06,1.38296E-06,1.39772E-06,1.41250E-06, & 
+      1.42732E-06,1.44217E-06,1.45704E-06,1.47195E-06,1.48689E-06, & 
+      1.50185E-06,1.51684E-06,1.53186E-06,1.54691E-06,1.56198E-06, & 
+      1.57709E-06,1.59222E-06,1.60737E-06,1.62255E-06,1.63776E-06, & 
+      1.65299E-06,1.66825E-06,1.68352E-06,1.69883E-06,1.71416E-06, & 
+      1.72951E-06,1.74488E-06,1.76028E-06,1.77570E-06,1.79114E-06, & 
+      1.80661E-06,1.82210E-06,1.83760E-06,1.85313E-06,1.86868E-06/               
+      DATA (TOTPLNK(IDATA, 1),IDATA=51,100)/ &                                              
+      1.88425E-06,1.89985E-06,1.91546E-06,1.93109E-06,1.94674E-06, & 
+      1.96241E-06,1.97811E-06,1.99381E-06,2.00954E-06,2.02529E-06, & 
+      2.04105E-06,2.05684E-06,2.07264E-06,2.08846E-06,2.10429E-06, & 
+      2.12015E-06,2.13602E-06,2.15190E-06,2.16781E-06,2.18373E-06, & 
+      2.19966E-06,2.21562E-06,2.23159E-06,2.24758E-06,2.26358E-06, & 
+      2.27959E-06,2.29562E-06,2.31167E-06,2.32773E-06,2.34381E-06, & 
+      2.35990E-06,2.37601E-06,2.39212E-06,2.40825E-06,2.42440E-06, & 
+      2.44056E-06,2.45673E-06,2.47292E-06,2.48912E-06,2.50533E-06, & 
+      2.52157E-06,2.53781E-06,2.55406E-06,2.57032E-06,2.58660E-06, & 
+      2.60289E-06,2.61919E-06,2.63550E-06,2.65183E-06,2.66817E-06/               
+      DATA (TOTPLNK(IDATA, 1),IDATA=101,150)/ &                                             
+      2.68452E-06,2.70088E-06,2.71726E-06,2.73364E-06,2.75003E-06, & 
+      2.76644E-06,2.78286E-06,2.79929E-06,2.81572E-06,2.83218E-06, & 
+      2.84864E-06,2.86510E-06,2.88159E-06,2.89807E-06,2.91458E-06, & 
+      2.93109E-06,2.94762E-06,2.96415E-06,2.98068E-06,2.99724E-06, & 
+      3.01379E-06,3.03036E-06,3.04693E-06,3.06353E-06,3.08013E-06, & 
+      3.09674E-06,3.11335E-06,3.12998E-06,3.14661E-06,3.16324E-06, & 
+      3.17989E-06,3.19656E-06,3.21323E-06,3.22991E-06,3.24658E-06, & 
+      3.26328E-06,3.27998E-06,3.29669E-06,3.31341E-06,3.33013E-06, & 
+      3.34686E-06,3.36360E-06,3.38034E-06,3.39709E-06,3.41387E-06, & 
+      3.43063E-06,3.44742E-06,3.46420E-06,3.48099E-06,3.49779E-06/               
+      DATA (TOTPLNK(IDATA, 1),IDATA=151,181)/ &                                             
+      3.51461E-06,3.53141E-06,3.54824E-06,3.56506E-06,3.58191E-06, & 
+      3.59875E-06,3.61559E-06,3.63244E-06,3.64931E-06,3.66617E-06, & 
+      3.68305E-06,3.69992E-06,3.71682E-06,3.73372E-06,3.75061E-06, & 
+      3.76753E-06,3.78443E-06,3.80136E-06,3.81829E-06,3.83522E-06, & 
+      3.85215E-06,3.86910E-06,3.88605E-06,3.90301E-06,3.91997E-06, & 
+      3.93694E-06,3.95390E-06,3.97087E-06,3.98788E-06,4.00485E-06, & 
+      4.02187E-06/                                                               
+      DATA (TOTPLNK(IDATA, 2),IDATA=1,50)/ &                                                
+      2.13441E-06,2.18076E-06,2.22758E-06,2.27489E-06,2.32268E-06, & 
+      2.37093E-06,2.41966E-06,2.46886E-06,2.51852E-06,2.56864E-06, & 
+      2.61922E-06,2.67026E-06,2.72175E-06,2.77370E-06,2.82609E-06, & 
+      2.87893E-06,2.93221E-06,2.98593E-06,3.04008E-06,3.09468E-06, & 
+      3.14970E-06,3.20515E-06,3.26103E-06,3.31732E-06,3.37404E-06, & 
+      3.43118E-06,3.48873E-06,3.54669E-06,3.60506E-06,3.66383E-06, & 
+      3.72301E-06,3.78259E-06,3.84256E-06,3.90293E-06,3.96368E-06, & 
+      4.02483E-06,4.08636E-06,4.14828E-06,4.21057E-06,4.27324E-06, & 
+      4.33629E-06,4.39971E-06,4.46350E-06,4.52765E-06,4.59217E-06, & 
+      4.65705E-06,4.72228E-06,4.78787E-06,4.85382E-06,4.92011E-06/               
+      DATA (TOTPLNK(IDATA, 2),IDATA=51,100)/ &                                              
+      4.98675E-06,5.05374E-06,5.12106E-06,5.18873E-06,5.25674E-06, & 
+      5.32507E-06,5.39374E-06,5.46274E-06,5.53207E-06,5.60172E-06, & 
+      5.67169E-06,5.74198E-06,5.81259E-06,5.88352E-06,5.95475E-06, & 
+      6.02629E-06,6.09815E-06,6.17030E-06,6.24276E-06,6.31552E-06, & 
+      6.38858E-06,6.46192E-06,6.53557E-06,6.60950E-06,6.68373E-06, & 
+      6.75824E-06,6.83303E-06,6.90810E-06,6.98346E-06,7.05909E-06, & 
+      7.13500E-06,7.21117E-06,7.28763E-06,7.36435E-06,7.44134E-06, & 
+      7.51859E-06,7.59611E-06,7.67388E-06,7.75192E-06,7.83021E-06, & 
+      7.90875E-06,7.98755E-06,8.06660E-06,8.14589E-06,8.22544E-06, & 
+      8.30522E-06,8.38526E-06,8.46553E-06,8.54604E-06,8.62679E-06/               
+      DATA (TOTPLNK(IDATA, 2),IDATA=101,150)/ &                                             
+      8.70777E-06,8.78899E-06,8.87043E-06,8.95211E-06,9.03402E-06, & 
+      9.11616E-06,9.19852E-06,9.28109E-06,9.36390E-06,9.44692E-06, & 
+      9.53015E-06,9.61361E-06,9.69729E-06,9.78117E-06,9.86526E-06, & 
+      9.94957E-06,1.00341E-05,1.01188E-05,1.02037E-05,1.02888E-05, & 
+      1.03742E-05,1.04597E-05,1.05454E-05,1.06313E-05,1.07175E-05, & 
+      1.08038E-05,1.08903E-05,1.09770E-05,1.10639E-05,1.11509E-05, & 
+      1.12382E-05,1.13257E-05,1.14133E-05,1.15011E-05,1.15891E-05, & 
+      1.16773E-05,1.17656E-05,1.18542E-05,1.19429E-05,1.20317E-05, & 
+      1.21208E-05,1.22100E-05,1.22994E-05,1.23890E-05,1.24787E-05, & 
+      1.25686E-05,1.26587E-05,1.27489E-05,1.28393E-05,1.29299E-05/               
+      DATA (TOTPLNK(IDATA, 2),IDATA=151,181)/ &                                             
+      1.30206E-05,1.31115E-05,1.32025E-05,1.32937E-05,1.33850E-05, & 
+      1.34765E-05,1.35682E-05,1.36600E-05,1.37520E-05,1.38441E-05, & 
+      1.39364E-05,1.40288E-05,1.41213E-05,1.42140E-05,1.43069E-05, & 
+      1.43999E-05,1.44930E-05,1.45863E-05,1.46797E-05,1.47733E-05, & 
+      1.48670E-05,1.49608E-05,1.50548E-05,1.51489E-05,1.52431E-05, & 
+      1.53375E-05,1.54320E-05,1.55267E-05,1.56214E-05,1.57164E-05, & 
+      1.58114E-05/                                                               
+      DATA (TOTPLNK(IDATA, 3),IDATA=1,50)/ &                                                
+      1.34822E-06,1.39134E-06,1.43530E-06,1.48010E-06,1.52574E-06, & 
+      1.57222E-06,1.61956E-06,1.66774E-06,1.71678E-06,1.76666E-06, & 
+      1.81741E-06,1.86901E-06,1.92147E-06,1.97479E-06,2.02898E-06, & 
+      2.08402E-06,2.13993E-06,2.19671E-06,2.25435E-06,2.31285E-06, & 
+      2.37222E-06,2.43246E-06,2.49356E-06,2.55553E-06,2.61837E-06, & 
+      2.68207E-06,2.74664E-06,2.81207E-06,2.87837E-06,2.94554E-06, & 
+      3.01356E-06,3.08245E-06,3.15221E-06,3.22282E-06,3.29429E-06, & 
+      3.36662E-06,3.43982E-06,3.51386E-06,3.58876E-06,3.66451E-06, & 
+      3.74112E-06,3.81857E-06,3.89688E-06,3.97602E-06,4.05601E-06, & 
+      4.13685E-06,4.21852E-06,4.30104E-06,4.38438E-06,4.46857E-06/               
+      DATA (TOTPLNK(IDATA, 3),IDATA=51,100)/ &                                              
+      4.55358E-06,4.63943E-06,4.72610E-06,4.81359E-06,4.90191E-06, & 
+      4.99105E-06,5.08100E-06,5.17176E-06,5.26335E-06,5.35573E-06, & 
+      5.44892E-06,5.54292E-06,5.63772E-06,5.73331E-06,5.82970E-06, & 
+      5.92688E-06,6.02485E-06,6.12360E-06,6.22314E-06,6.32346E-06, & 
+      6.42455E-06,6.52641E-06,6.62906E-06,6.73247E-06,6.83664E-06, & 
+      6.94156E-06,7.04725E-06,7.15370E-06,7.26089E-06,7.36883E-06, & 
+      7.47752E-06,7.58695E-06,7.69712E-06,7.80801E-06,7.91965E-06, & 
+      8.03201E-06,8.14510E-06,8.25891E-06,8.37343E-06,8.48867E-06, & 
+      8.60463E-06,8.72128E-06,8.83865E-06,8.95672E-06,9.07548E-06, & 
+      9.19495E-06,9.31510E-06,9.43594E-06,9.55745E-06,9.67966E-06/               
+      DATA (TOTPLNK(IDATA, 3),IDATA=101,150)/ &                                             
+      9.80254E-06,9.92609E-06,1.00503E-05,1.01752E-05,1.03008E-05, & 
+      1.04270E-05,1.05539E-05,1.06814E-05,1.08096E-05,1.09384E-05, & 
+      1.10679E-05,1.11980E-05,1.13288E-05,1.14601E-05,1.15922E-05, & 
+      1.17248E-05,1.18581E-05,1.19920E-05,1.21265E-05,1.22616E-05, & 
+      1.23973E-05,1.25337E-05,1.26706E-05,1.28081E-05,1.29463E-05, & 
+      1.30850E-05,1.32243E-05,1.33642E-05,1.35047E-05,1.36458E-05, & 
+      1.37875E-05,1.39297E-05,1.40725E-05,1.42159E-05,1.43598E-05, & 
+      1.45044E-05,1.46494E-05,1.47950E-05,1.49412E-05,1.50879E-05, & 
+      1.52352E-05,1.53830E-05,1.55314E-05,1.56803E-05,1.58297E-05, & 
+      1.59797E-05,1.61302E-05,1.62812E-05,1.64327E-05,1.65848E-05/               
+      DATA (TOTPLNK(IDATA, 3),IDATA=151,181)/ &                                             
+      1.67374E-05,1.68904E-05,1.70441E-05,1.71982E-05,1.73528E-05, & 
+      1.75079E-05,1.76635E-05,1.78197E-05,1.79763E-05,1.81334E-05, & 
+      1.82910E-05,1.84491E-05,1.86076E-05,1.87667E-05,1.89262E-05, & 
+      1.90862E-05,1.92467E-05,1.94076E-05,1.95690E-05,1.97309E-05, & 
+      1.98932E-05,2.00560E-05,2.02193E-05,2.03830E-05,2.05472E-05, & 
+      2.07118E-05,2.08768E-05,2.10423E-05,2.12083E-05,2.13747E-05, & 
+      2.15414E-05/                                                               
+      DATA (TOTPLNK(IDATA, 4),IDATA=1,50)/ &                                                
+      8.90528E-07,9.24222E-07,9.58757E-07,9.94141E-07,1.03038E-06, & 
+      1.06748E-06,1.10545E-06,1.14430E-06,1.18403E-06,1.22465E-06, & 
+      1.26618E-06,1.30860E-06,1.35193E-06,1.39619E-06,1.44136E-06, & 
+      1.48746E-06,1.53449E-06,1.58246E-06,1.63138E-06,1.68124E-06, & 
+      1.73206E-06,1.78383E-06,1.83657E-06,1.89028E-06,1.94495E-06, & 
+      2.00060E-06,2.05724E-06,2.11485E-06,2.17344E-06,2.23303E-06, & 
+      2.29361E-06,2.35519E-06,2.41777E-06,2.48134E-06,2.54592E-06, & 
+      2.61151E-06,2.67810E-06,2.74571E-06,2.81433E-06,2.88396E-06, & 
+      2.95461E-06,3.02628E-06,3.09896E-06,3.17267E-06,3.24741E-06, & 
+      3.32316E-06,3.39994E-06,3.47774E-06,3.55657E-06,3.63642E-06/               
+      DATA (TOTPLNK(IDATA, 4),IDATA=51,100)/ &                                              
+      3.71731E-06,3.79922E-06,3.88216E-06,3.96612E-06,4.05112E-06, & 
+      4.13714E-06,4.22419E-06,4.31227E-06,4.40137E-06,4.49151E-06, & 
+      4.58266E-06,4.67485E-06,4.76806E-06,4.86229E-06,4.95754E-06, & 
+      5.05383E-06,5.15113E-06,5.24946E-06,5.34879E-06,5.44916E-06, & 
+      5.55053E-06,5.65292E-06,5.75632E-06,5.86073E-06,5.96616E-06, & 
+      6.07260E-06,6.18003E-06,6.28848E-06,6.39794E-06,6.50838E-06, & 
+      6.61983E-06,6.73229E-06,6.84573E-06,6.96016E-06,7.07559E-06, & 
+      7.19200E-06,7.30940E-06,7.42779E-06,7.54715E-06,7.66749E-06, & 
+      7.78882E-06,7.91110E-06,8.03436E-06,8.15859E-06,8.28379E-06, & 
+      8.40994E-06,8.53706E-06,8.66515E-06,8.79418E-06,8.92416E-06/               
+      DATA (TOTPLNK(IDATA, 4),IDATA=101,150)/ &                                             
+      9.05510E-06,9.18697E-06,9.31979E-06,9.45356E-06,9.58826E-06, & 
+      9.72389E-06,9.86046E-06,9.99793E-06,1.01364E-05,1.02757E-05, & 
+      1.04159E-05,1.05571E-05,1.06992E-05,1.08422E-05,1.09861E-05, & 
+      1.11309E-05,1.12766E-05,1.14232E-05,1.15707E-05,1.17190E-05, & 
+      1.18683E-05,1.20184E-05,1.21695E-05,1.23214E-05,1.24741E-05, & 
+      1.26277E-05,1.27822E-05,1.29376E-05,1.30939E-05,1.32509E-05, & 
+      1.34088E-05,1.35676E-05,1.37273E-05,1.38877E-05,1.40490E-05, & 
+      1.42112E-05,1.43742E-05,1.45380E-05,1.47026E-05,1.48680E-05, & 
+      1.50343E-05,1.52014E-05,1.53692E-05,1.55379E-05,1.57074E-05, & 
+      1.58778E-05,1.60488E-05,1.62207E-05,1.63934E-05,1.65669E-05/               
+      DATA (TOTPLNK(IDATA, 4),IDATA=151,181)/ &                                             
+      1.67411E-05,1.69162E-05,1.70920E-05,1.72685E-05,1.74459E-05, & 
+      1.76240E-05,1.78029E-05,1.79825E-05,1.81629E-05,1.83440E-05, & 
+      1.85259E-05,1.87086E-05,1.88919E-05,1.90760E-05,1.92609E-05, & 
+      1.94465E-05,1.96327E-05,1.98199E-05,2.00076E-05,2.01961E-05, & 
+      2.03853E-05,2.05752E-05,2.07658E-05,2.09571E-05,2.11491E-05, & 
+      2.13418E-05,2.15352E-05,2.17294E-05,2.19241E-05,2.21196E-05, & 
+      2.23158E-05/                                                               
+      DATA (TOTPLNK(IDATA, 5),IDATA=1,50)/ &                                                
+      5.70230E-07,5.94788E-07,6.20085E-07,6.46130E-07,6.72936E-07, & 
+      7.00512E-07,7.28869E-07,7.58019E-07,7.87971E-07,8.18734E-07, & 
+      8.50320E-07,8.82738E-07,9.15999E-07,9.50110E-07,9.85084E-07, & 
+      1.02093E-06,1.05765E-06,1.09527E-06,1.13378E-06,1.17320E-06, & 
+      1.21353E-06,1.25479E-06,1.29698E-06,1.34011E-06,1.38419E-06, & 
+      1.42923E-06,1.47523E-06,1.52221E-06,1.57016E-06,1.61910E-06, & 
+      1.66904E-06,1.71997E-06,1.77192E-06,1.82488E-06,1.87886E-06, & 
+      1.93387E-06,1.98991E-06,2.04699E-06,2.10512E-06,2.16430E-06, & 
+      2.22454E-06,2.28584E-06,2.34821E-06,2.41166E-06,2.47618E-06, & 
+      2.54178E-06,2.60847E-06,2.67626E-06,2.74514E-06,2.81512E-06/               
+      DATA (TOTPLNK(IDATA, 5),IDATA=51,100)/ &                                              
+      2.88621E-06,2.95841E-06,3.03172E-06,3.10615E-06,3.18170E-06, & 
+      3.25838E-06,3.33618E-06,3.41511E-06,3.49518E-06,3.57639E-06, & 
+      3.65873E-06,3.74221E-06,3.82684E-06,3.91262E-06,3.99955E-06, & 
+      4.08763E-06,4.17686E-06,4.26725E-06,4.35880E-06,4.45150E-06, & 
+      4.54537E-06,4.64039E-06,4.73659E-06,4.83394E-06,4.93246E-06, & 
+      5.03215E-06,5.13301E-06,5.23504E-06,5.33823E-06,5.44260E-06, & 
+      5.54814E-06,5.65484E-06,5.76272E-06,5.87177E-06,5.98199E-06, & 
+      6.09339E-06,6.20596E-06,6.31969E-06,6.43460E-06,6.55068E-06, & 
+      6.66793E-06,6.78636E-06,6.90595E-06,7.02670E-06,7.14863E-06, & 
+      7.27173E-06,7.39599E-06,7.52142E-06,7.64802E-06,7.77577E-06/               
+      DATA (TOTPLNK(IDATA, 5),IDATA=101,150)/ &                                             
+      7.90469E-06,8.03477E-06,8.16601E-06,8.29841E-06,8.43198E-06, & 
+      8.56669E-06,8.70256E-06,8.83957E-06,8.97775E-06,9.11706E-06, & 
+      9.25753E-06,9.39915E-06,9.54190E-06,9.68580E-06,9.83085E-06, & 
+      9.97704E-06,1.01243E-05,1.02728E-05,1.04224E-05,1.05731E-05, & 
+      1.07249E-05,1.08779E-05,1.10320E-05,1.11872E-05,1.13435E-05, & 
+      1.15009E-05,1.16595E-05,1.18191E-05,1.19799E-05,1.21418E-05, & 
+      1.23048E-05,1.24688E-05,1.26340E-05,1.28003E-05,1.29676E-05, & 
+      1.31361E-05,1.33056E-05,1.34762E-05,1.36479E-05,1.38207E-05, & 
+      1.39945E-05,1.41694E-05,1.43454E-05,1.45225E-05,1.47006E-05, & 
+      1.48797E-05,1.50600E-05,1.52413E-05,1.54236E-05,1.56070E-05/               
+      DATA (TOTPLNK(IDATA, 5),IDATA=151,181)/ &                                             
+      1.57914E-05,1.59768E-05,1.61633E-05,1.63509E-05,1.65394E-05, & 
+      1.67290E-05,1.69197E-05,1.71113E-05,1.73040E-05,1.74976E-05, & 
+      1.76923E-05,1.78880E-05,1.80847E-05,1.82824E-05,1.84811E-05, & 
+      1.86808E-05,1.88814E-05,1.90831E-05,1.92857E-05,1.94894E-05, & 
+      1.96940E-05,1.98996E-05,2.01061E-05,2.03136E-05,2.05221E-05, & 
+      2.07316E-05,2.09420E-05,2.11533E-05,2.13657E-05,2.15789E-05, & 
+      2.17931E-05/                                                               
+      DATA (TOTPLNK(IDATA, 6),IDATA=1,50)/ &                                                
+      2.73493E-07,2.87408E-07,3.01848E-07,3.16825E-07,3.32352E-07, & 
+      3.48439E-07,3.65100E-07,3.82346E-07,4.00189E-07,4.18641E-07, & 
+      4.37715E-07,4.57422E-07,4.77774E-07,4.98784E-07,5.20464E-07, & 
+      5.42824E-07,5.65879E-07,5.89638E-07,6.14115E-07,6.39320E-07, & 
+      6.65266E-07,6.91965E-07,7.19427E-07,7.47666E-07,7.76691E-07, & 
+      8.06516E-07,8.37151E-07,8.68607E-07,9.00896E-07,9.34029E-07, & 
+      9.68018E-07,1.00287E-06,1.03860E-06,1.07522E-06,1.11274E-06, & 
+      1.15117E-06,1.19052E-06,1.23079E-06,1.27201E-06,1.31418E-06, & 
+      1.35731E-06,1.40141E-06,1.44650E-06,1.49257E-06,1.53965E-06, & 
+      1.58773E-06,1.63684E-06,1.68697E-06,1.73815E-06,1.79037E-06/               
+      DATA (TOTPLNK(IDATA, 6),IDATA=51,100)/ &                                              
+      1.84365E-06,1.89799E-06,1.95341E-06,2.00991E-06,2.06750E-06, & 
+      2.12619E-06,2.18599E-06,2.24691E-06,2.30895E-06,2.37212E-06, & 
+      2.43643E-06,2.50189E-06,2.56851E-06,2.63628E-06,2.70523E-06, & 
+      2.77536E-06,2.84666E-06,2.91916E-06,2.99286E-06,3.06776E-06, & 
+      3.14387E-06,3.22120E-06,3.29975E-06,3.37953E-06,3.46054E-06, & 
+      3.54280E-06,3.62630E-06,3.71105E-06,3.79707E-06,3.88434E-06, & 
+      3.97288E-06,4.06270E-06,4.15380E-06,4.24617E-06,4.33984E-06, & 
+      4.43479E-06,4.53104E-06,4.62860E-06,4.72746E-06,4.82763E-06, & 
+      4.92911E-06,5.03191E-06,5.13603E-06,5.24147E-06,5.34824E-06, & 
+      5.45634E-06,5.56578E-06,5.67656E-06,5.78867E-06,5.90213E-06/               
+      DATA (TOTPLNK(IDATA, 6),IDATA=101,150)/ &                                             
+      6.01694E-06,6.13309E-06,6.25060E-06,6.36947E-06,6.48968E-06, & 
+      6.61126E-06,6.73420E-06,6.85850E-06,6.98417E-06,7.11120E-06, & 
+      7.23961E-06,7.36938E-06,7.50053E-06,7.63305E-06,7.76694E-06, & 
+      7.90221E-06,8.03887E-06,8.17690E-06,8.31632E-06,8.45710E-06, & 
+      8.59928E-06,8.74282E-06,8.88776E-06,9.03409E-06,9.18179E-06, & 
+      9.33088E-06,9.48136E-06,9.63323E-06,9.78648E-06,9.94111E-06, & 
+      1.00971E-05,1.02545E-05,1.04133E-05,1.05735E-05,1.07351E-05, & 
+      1.08980E-05,1.10624E-05,1.12281E-05,1.13952E-05,1.15637E-05, & 
+      1.17335E-05,1.19048E-05,1.20774E-05,1.22514E-05,1.24268E-05, & 
+      1.26036E-05,1.27817E-05,1.29612E-05,1.31421E-05,1.33244E-05/               
+      DATA (TOTPLNK(IDATA, 6),IDATA=151,181)/ &                                             
+      1.35080E-05,1.36930E-05,1.38794E-05,1.40672E-05,1.42563E-05, & 
+      1.44468E-05,1.46386E-05,1.48318E-05,1.50264E-05,1.52223E-05, & 
+      1.54196E-05,1.56182E-05,1.58182E-05,1.60196E-05,1.62223E-05, & 
+      1.64263E-05,1.66317E-05,1.68384E-05,1.70465E-05,1.72559E-05, & 
+      1.74666E-05,1.76787E-05,1.78921E-05,1.81069E-05,1.83230E-05, & 
+      1.85404E-05,1.87591E-05,1.89791E-05,1.92005E-05,1.94232E-05, & 
+      1.96471E-05/                                                               
+      DATA (TOTPLNK(IDATA, 7),IDATA=1,50)/ &                                                
+      1.25349E-07,1.32735E-07,1.40458E-07,1.48527E-07,1.56954E-07, & 
+      1.65748E-07,1.74920E-07,1.84481E-07,1.94443E-07,2.04814E-07, & 
+      2.15608E-07,2.26835E-07,2.38507E-07,2.50634E-07,2.63229E-07, & 
+      2.76301E-07,2.89864E-07,3.03930E-07,3.18508E-07,3.33612E-07, & 
+      3.49253E-07,3.65443E-07,3.82195E-07,3.99519E-07,4.17428E-07, & 
+      4.35934E-07,4.55050E-07,4.74785E-07,4.95155E-07,5.16170E-07, & 
+      5.37844E-07,5.60186E-07,5.83211E-07,6.06929E-07,6.31355E-07, & 
+      6.56498E-07,6.82373E-07,7.08990E-07,7.36362E-07,7.64501E-07, & 
+      7.93420E-07,8.23130E-07,8.53643E-07,8.84971E-07,9.17128E-07, & 
+      9.50123E-07,9.83969E-07,1.01868E-06,1.05426E-06,1.09073E-06/               
+      DATA (TOTPLNK(IDATA, 7),IDATA=51,100)/ &                                              
+      1.12810E-06,1.16638E-06,1.20558E-06,1.24572E-06,1.28680E-06, & 
+      1.32883E-06,1.37183E-06,1.41581E-06,1.46078E-06,1.50675E-06, & 
+      1.55374E-06,1.60174E-06,1.65078E-06,1.70087E-06,1.75200E-06, & 
+      1.80421E-06,1.85749E-06,1.91186E-06,1.96732E-06,2.02389E-06, & 
+      2.08159E-06,2.14040E-06,2.20035E-06,2.26146E-06,2.32372E-06, & 
+      2.38714E-06,2.45174E-06,2.51753E-06,2.58451E-06,2.65270E-06, & 
+      2.72210E-06,2.79272E-06,2.86457E-06,2.93767E-06,3.01201E-06, & 
+      3.08761E-06,3.16448E-06,3.24261E-06,3.32204E-06,3.40275E-06, & 
+      3.48476E-06,3.56808E-06,3.65271E-06,3.73866E-06,3.82595E-06, & 
+      3.91456E-06,4.00453E-06,4.09584E-06,4.18851E-06,4.28254E-06/               
+      DATA (TOTPLNK(IDATA, 7),IDATA=101,150)/ &                                             
+      4.37796E-06,4.47475E-06,4.57293E-06,4.67249E-06,4.77346E-06, & 
+      4.87583E-06,4.97961E-06,5.08481E-06,5.19143E-06,5.29948E-06, & 
+      5.40896E-06,5.51989E-06,5.63226E-06,5.74608E-06,5.86136E-06, & 
+      5.97810E-06,6.09631E-06,6.21597E-06,6.33713E-06,6.45976E-06, & 
+      6.58388E-06,6.70950E-06,6.83661E-06,6.96521E-06,7.09531E-06, & 
+      7.22692E-06,7.36005E-06,7.49468E-06,7.63084E-06,7.76851E-06, & 
+      7.90773E-06,8.04846E-06,8.19072E-06,8.33452E-06,8.47985E-06, & 
+      8.62674E-06,8.77517E-06,8.92514E-06,9.07666E-06,9.22975E-06, & 
+      9.38437E-06,9.54057E-06,9.69832E-06,9.85762E-06,1.00185E-05, & 
+      1.01810E-05,1.03450E-05,1.05106E-05,1.06777E-05,1.08465E-05/               
+      DATA (TOTPLNK(IDATA, 7),IDATA=151,181)/ &                                             
+      1.10168E-05,1.11887E-05,1.13621E-05,1.15372E-05,1.17138E-05, & 
+      1.18920E-05,1.20718E-05,1.22532E-05,1.24362E-05,1.26207E-05, & 
+      1.28069E-05,1.29946E-05,1.31839E-05,1.33749E-05,1.35674E-05, & 
+      1.37615E-05,1.39572E-05,1.41544E-05,1.43533E-05,1.45538E-05, & 
+      1.47558E-05,1.49595E-05,1.51647E-05,1.53716E-05,1.55800E-05, & 
+      1.57900E-05,1.60017E-05,1.62149E-05,1.64296E-05,1.66460E-05, & 
+      1.68640E-05/                                                               
+      DATA (TOTPLNK(IDATA, 8),IDATA=1,50)/ &                                                
+      6.74445E-08,7.18176E-08,7.64153E-08,8.12456E-08,8.63170E-08, & 
+      9.16378E-08,9.72168E-08,1.03063E-07,1.09184E-07,1.15591E-07, & 
+      1.22292E-07,1.29296E-07,1.36613E-07,1.44253E-07,1.52226E-07, & 
+      1.60540E-07,1.69207E-07,1.78236E-07,1.87637E-07,1.97421E-07, & 
+      2.07599E-07,2.18181E-07,2.29177E-07,2.40598E-07,2.52456E-07, & 
+      2.64761E-07,2.77523E-07,2.90755E-07,3.04468E-07,3.18673E-07, & 
+      3.33381E-07,3.48603E-07,3.64352E-07,3.80638E-07,3.97474E-07, & 
+      4.14871E-07,4.32841E-07,4.51395E-07,4.70547E-07,4.90306E-07, & 
+      5.10687E-07,5.31699E-07,5.53357E-07,5.75670E-07,5.98652E-07, & 
+      6.22315E-07,6.46672E-07,6.71731E-07,6.97511E-07,7.24018E-07/               
+      DATA (TOTPLNK(IDATA, 8),IDATA=51,100)/ &                                              
+      7.51266E-07,7.79269E-07,8.08038E-07,8.37584E-07,8.67922E-07, & 
+      8.99061E-07,9.31016E-07,9.63797E-07,9.97417E-07,1.03189E-06, & 
+      1.06722E-06,1.10343E-06,1.14053E-06,1.17853E-06,1.21743E-06, & 
+      1.25726E-06,1.29803E-06,1.33974E-06,1.38241E-06,1.42606E-06, & 
+      1.47068E-06,1.51630E-06,1.56293E-06,1.61056E-06,1.65924E-06, & 
+      1.70894E-06,1.75971E-06,1.81153E-06,1.86443E-06,1.91841E-06, & 
+      1.97350E-06,2.02968E-06,2.08699E-06,2.14543E-06,2.20500E-06, & 
+      2.26573E-06,2.32762E-06,2.39068E-06,2.45492E-06,2.52036E-06, & 
+      2.58700E-06,2.65485E-06,2.72393E-06,2.79424E-06,2.86580E-06, & 
+      2.93861E-06,3.01269E-06,3.08803E-06,3.16467E-06,3.24259E-06/               
+      DATA (TOTPLNK(IDATA, 8),IDATA=101,150)/ &                                             
+      3.32181E-06,3.40235E-06,3.48420E-06,3.56739E-06,3.65192E-06, & 
+      3.73779E-06,3.82502E-06,3.91362E-06,4.00359E-06,4.09494E-06, & 
+      4.18768E-06,4.28182E-06,4.37737E-06,4.47434E-06,4.57273E-06, & 
+      4.67254E-06,4.77380E-06,4.87651E-06,4.98067E-06,5.08630E-06, & 
+      5.19339E-06,5.30196E-06,5.41201E-06,5.52356E-06,5.63660E-06, & 
+      5.75116E-06,5.86722E-06,5.98479E-06,6.10390E-06,6.22453E-06, & 
+      6.34669E-06,6.47042E-06,6.59569E-06,6.72252E-06,6.85090E-06, & 
+      6.98085E-06,7.11238E-06,7.24549E-06,7.38019E-06,7.51646E-06, & 
+      7.65434E-06,7.79382E-06,7.93490E-06,8.07760E-06,8.22192E-06, & 
+      8.36784E-06,8.51540E-06,8.66459E-06,8.81542E-06,8.96786E-06/               
+      DATA (TOTPLNK(IDATA, 8),IDATA=151,181)/ &                                             
+      9.12197E-06,9.27772E-06,9.43513E-06,9.59419E-06,9.75490E-06, & 
+      9.91728E-06,1.00813E-05,1.02471E-05,1.04144E-05,1.05835E-05, & 
+      1.07543E-05,1.09267E-05,1.11008E-05,1.12766E-05,1.14541E-05, & 
+      1.16333E-05,1.18142E-05,1.19969E-05,1.21812E-05,1.23672E-05, & 
+      1.25549E-05,1.27443E-05,1.29355E-05,1.31284E-05,1.33229E-05, & 
+      1.35193E-05,1.37173E-05,1.39170E-05,1.41185E-05,1.43217E-05, & 
+      1.45267E-05/                                                               
+      DATA (TOTPLNK(IDATA, 9),IDATA=1,50)/ &                                                
+      2.61522E-08,2.80613E-08,3.00838E-08,3.22250E-08,3.44899E-08, & 
+      3.68841E-08,3.94129E-08,4.20820E-08,4.48973E-08,4.78646E-08, & 
+      5.09901E-08,5.42799E-08,5.77405E-08,6.13784E-08,6.52001E-08, & 
+      6.92126E-08,7.34227E-08,7.78375E-08,8.24643E-08,8.73103E-08, & 
+      9.23832E-08,9.76905E-08,1.03240E-07,1.09039E-07,1.15097E-07, & 
+      1.21421E-07,1.28020E-07,1.34902E-07,1.42075E-07,1.49548E-07, & 
+      1.57331E-07,1.65432E-07,1.73860E-07,1.82624E-07,1.91734E-07, & 
+      2.01198E-07,2.11028E-07,2.21231E-07,2.31818E-07,2.42799E-07, & 
+      2.54184E-07,2.65983E-07,2.78205E-07,2.90862E-07,3.03963E-07, & 
+      3.17519E-07,3.31541E-07,3.46039E-07,3.61024E-07,3.76507E-07/               
+      DATA (TOTPLNK(IDATA, 9),IDATA=51,100)/ &                                              
+      3.92498E-07,4.09008E-07,4.26050E-07,4.43633E-07,4.61769E-07, & 
+      4.80469E-07,4.99744E-07,5.19606E-07,5.40067E-07,5.61136E-07, & 
+      5.82828E-07,6.05152E-07,6.28120E-07,6.51745E-07,6.76038E-07, & 
+      7.01010E-07,7.26674E-07,7.53041E-07,7.80124E-07,8.07933E-07, & 
+      8.36482E-07,8.65781E-07,8.95845E-07,9.26683E-07,9.58308E-07, & 
+      9.90732E-07,1.02397E-06,1.05803E-06,1.09292E-06,1.12866E-06, & 
+      1.16526E-06,1.20274E-06,1.24109E-06,1.28034E-06,1.32050E-06, & 
+      1.36158E-06,1.40359E-06,1.44655E-06,1.49046E-06,1.53534E-06, & 
+      1.58120E-06,1.62805E-06,1.67591E-06,1.72478E-06,1.77468E-06, & 
+      1.82561E-06,1.87760E-06,1.93066E-06,1.98479E-06,2.04000E-06/               
+      DATA (TOTPLNK(IDATA, 9),IDATA=101,150)/ &                                             
+      2.09631E-06,2.15373E-06,2.21228E-06,2.27196E-06,2.33278E-06, & 
+      2.39475E-06,2.45790E-06,2.52222E-06,2.58773E-06,2.65445E-06, & 
+      2.72238E-06,2.79152E-06,2.86191E-06,2.93354E-06,3.00643E-06, & 
+      3.08058E-06,3.15601E-06,3.23273E-06,3.31075E-06,3.39009E-06, & 
+      3.47074E-06,3.55272E-06,3.63605E-06,3.72072E-06,3.80676E-06, & 
+      3.89417E-06,3.98297E-06,4.07315E-06,4.16474E-06,4.25774E-06, & 
+      4.35217E-06,4.44802E-06,4.54532E-06,4.64406E-06,4.74428E-06, & 
+      4.84595E-06,4.94911E-06,5.05376E-06,5.15990E-06,5.26755E-06, & 
+      5.37671E-06,5.48741E-06,5.59963E-06,5.71340E-06,5.82871E-06, & 
+      5.94559E-06,6.06403E-06,6.18404E-06,6.30565E-06,6.42885E-06/               
+      DATA (TOTPLNK(IDATA, 9),IDATA=151,181)/ &                                             
+      6.55364E-06,6.68004E-06,6.80806E-06,6.93771E-06,7.06898E-06, & 
+      7.20190E-06,7.33646E-06,7.47267E-06,7.61056E-06,7.75010E-06, & 
+      7.89133E-06,8.03423E-06,8.17884E-06,8.32514E-06,8.47314E-06, & 
+      8.62284E-06,8.77427E-06,8.92743E-06,9.08231E-06,9.23893E-06, & 
+      9.39729E-06,9.55741E-06,9.71927E-06,9.88291E-06,1.00483E-05, & 
+      1.02155E-05,1.03844E-05,1.05552E-05,1.07277E-05,1.09020E-05, & 
+      1.10781E-05/                                                               
+      DATA (TOTPLNK(IDATA,10),IDATA=1,50)/ &                                                
+      8.89300E-09,9.63263E-09,1.04235E-08,1.12685E-08,1.21703E-08, & 
+      1.31321E-08,1.41570E-08,1.52482E-08,1.64090E-08,1.76428E-08, & 
+      1.89533E-08,2.03441E-08,2.18190E-08,2.33820E-08,2.50370E-08, & 
+      2.67884E-08,2.86402E-08,3.05969E-08,3.26632E-08,3.48436E-08, & 
+      3.71429E-08,3.95660E-08,4.21179E-08,4.48040E-08,4.76294E-08, & 
+      5.05996E-08,5.37201E-08,5.69966E-08,6.04349E-08,6.40411E-08, & 
+      6.78211E-08,7.17812E-08,7.59276E-08,8.02670E-08,8.48059E-08, & 
+      8.95508E-08,9.45090E-08,9.96873E-08,1.05093E-07,1.10733E-07, & 
+      1.16614E-07,1.22745E-07,1.29133E-07,1.35786E-07,1.42711E-07, & 
+      1.49916E-07,1.57410E-07,1.65202E-07,1.73298E-07,1.81709E-07/               
+      DATA (TOTPLNK(IDATA,10),IDATA=51,100)/ &                                              
+      1.90441E-07,1.99505E-07,2.08908E-07,2.18660E-07,2.28770E-07, & 
+      2.39247E-07,2.50101E-07,2.61340E-07,2.72974E-07,2.85013E-07, & 
+      2.97467E-07,3.10345E-07,3.23657E-07,3.37413E-07,3.51623E-07, & 
+      3.66298E-07,3.81448E-07,3.97082E-07,4.13212E-07,4.29848E-07, & 
+      4.47000E-07,4.64680E-07,4.82898E-07,5.01664E-07,5.20991E-07, & 
+      5.40888E-07,5.61369E-07,5.82440E-07,6.04118E-07,6.26410E-07, & 
+      6.49329E-07,6.72887E-07,6.97095E-07,7.21964E-07,7.47506E-07, & 
+      7.73732E-07,8.00655E-07,8.28287E-07,8.56635E-07,8.85717E-07, & 
+      9.15542E-07,9.46122E-07,9.77469E-07,1.00960E-06,1.04251E-06, & 
+      1.07623E-06,1.11077E-06,1.14613E-06,1.18233E-06,1.21939E-06/               
+      DATA (TOTPLNK(IDATA,10),IDATA=101,150)/ &                                             
+      1.25730E-06,1.29610E-06,1.33578E-06,1.37636E-06,1.41785E-06, & 
+      1.46027E-06,1.50362E-06,1.54792E-06,1.59319E-06,1.63942E-06, & 
+      1.68665E-06,1.73487E-06,1.78410E-06,1.83435E-06,1.88564E-06, & 
+      1.93797E-06,1.99136E-06,2.04582E-06,2.10137E-06,2.15801E-06, & 
+      2.21576E-06,2.27463E-06,2.33462E-06,2.39577E-06,2.45806E-06, & 
+      2.52153E-06,2.58617E-06,2.65201E-06,2.71905E-06,2.78730E-06, & 
+      2.85678E-06,2.92749E-06,2.99946E-06,3.07269E-06,3.14720E-06, & 
+      3.22299E-06,3.30007E-06,3.37847E-06,3.45818E-06,3.53923E-06, & 
+      3.62161E-06,3.70535E-06,3.79046E-06,3.87695E-06,3.96481E-06, & 
+      4.05409E-06,4.14477E-06,4.23687E-06,4.33040E-06,4.42538E-06/               
+      DATA (TOTPLNK(IDATA,10),IDATA=151,181)/ &                                             
+      4.52180E-06,4.61969E-06,4.71905E-06,4.81991E-06,4.92226E-06, & 
+      5.02611E-06,5.13148E-06,5.23839E-06,5.34681E-06,5.45681E-06, & 
+      5.56835E-06,5.68146E-06,5.79614E-06,5.91242E-06,6.03030E-06, & 
+      6.14978E-06,6.27088E-06,6.39360E-06,6.51798E-06,6.64398E-06, & 
+      6.77165E-06,6.90099E-06,7.03198E-06,7.16468E-06,7.29906E-06, & 
+      7.43514E-06,7.57294E-06,7.71244E-06,7.85369E-06,7.99666E-06, & 
+      8.14138E-06/                                                               
+      DATA (TOTPLNK(IDATA,11),IDATA=1,50)/ &                                                
+      2.53767E-09,2.77242E-09,3.02564E-09,3.29851E-09,3.59228E-09, & 
+      3.90825E-09,4.24777E-09,4.61227E-09,5.00322E-09,5.42219E-09, & 
+      5.87080E-09,6.35072E-09,6.86370E-09,7.41159E-09,7.99628E-09, & 
+      8.61974E-09,9.28404E-09,9.99130E-09,1.07437E-08,1.15436E-08, & 
+      1.23933E-08,1.32953E-08,1.42522E-08,1.52665E-08,1.63410E-08, & 
+      1.74786E-08,1.86820E-08,1.99542E-08,2.12985E-08,2.27179E-08, & 
+      2.42158E-08,2.57954E-08,2.74604E-08,2.92141E-08,3.10604E-08, & 
+      3.30029E-08,3.50457E-08,3.71925E-08,3.94476E-08,4.18149E-08, & 
+      4.42991E-08,4.69043E-08,4.96352E-08,5.24961E-08,5.54921E-08, & 
+      5.86277E-08,6.19081E-08,6.53381E-08,6.89231E-08,7.26681E-08/               
+      DATA (TOTPLNK(IDATA,11),IDATA=51,100)/ &                                              
+      7.65788E-08,8.06604E-08,8.49187E-08,8.93591E-08,9.39879E-08, & 
+      9.88106E-08,1.03834E-07,1.09063E-07,1.14504E-07,1.20165E-07, & 
+      1.26051E-07,1.32169E-07,1.38525E-07,1.45128E-07,1.51982E-07, & 
+      1.59096E-07,1.66477E-07,1.74132E-07,1.82068E-07,1.90292E-07, & 
+      1.98813E-07,2.07638E-07,2.16775E-07,2.26231E-07,2.36015E-07, & 
+      2.46135E-07,2.56599E-07,2.67415E-07,2.78592E-07,2.90137E-07, & 
+      3.02061E-07,3.14371E-07,3.27077E-07,3.40186E-07,3.53710E-07, & 
+      3.67655E-07,3.82031E-07,3.96848E-07,4.12116E-07,4.27842E-07, & 
+      4.44039E-07,4.60713E-07,4.77876E-07,4.95537E-07,5.13706E-07, & 
+      5.32392E-07,5.51608E-07,5.71360E-07,5.91662E-07,6.12521E-07/               
+      DATA (TOTPLNK(IDATA,11),IDATA=101,150)/ &                                             
+      6.33950E-07,6.55958E-07,6.78556E-07,7.01753E-07,7.25562E-07, & 
+      7.49992E-07,7.75055E-07,8.00760E-07,8.27120E-07,8.54145E-07, & 
+      8.81845E-07,9.10233E-07,9.39318E-07,9.69113E-07,9.99627E-07, & 
+      1.03087E-06,1.06286E-06,1.09561E-06,1.12912E-06,1.16340E-06, & 
+      1.19848E-06,1.23435E-06,1.27104E-06,1.30855E-06,1.34690E-06, & 
+      1.38609E-06,1.42614E-06,1.46706E-06,1.50886E-06,1.55155E-06, & 
+      1.59515E-06,1.63967E-06,1.68512E-06,1.73150E-06,1.77884E-06, & 
+      1.82715E-06,1.87643E-06,1.92670E-06,1.97797E-06,2.03026E-06, & 
+      2.08356E-06,2.13791E-06,2.19330E-06,2.24975E-06,2.30728E-06, & 
+      2.36589E-06,2.42560E-06,2.48641E-06,2.54835E-06,2.61142E-06/               
+      DATA (TOTPLNK(IDATA,11),IDATA=151,181)/ &                                             
+      2.67563E-06,2.74100E-06,2.80754E-06,2.87526E-06,2.94417E-06, & 
+      3.01429E-06,3.08562E-06,3.15819E-06,3.23199E-06,3.30704E-06, & 
+      3.38336E-06,3.46096E-06,3.53984E-06,3.62002E-06,3.70151E-06, & 
+      3.78433E-06,3.86848E-06,3.95399E-06,4.04084E-06,4.12907E-06, & 
+      4.21868E-06,4.30968E-06,4.40209E-06,4.49592E-06,4.59117E-06, & 
+      4.68786E-06,4.78600E-06,4.88561E-06,4.98669E-06,5.08926E-06, & 
+      5.19332E-06/                                                               
+      DATA (TOTPLNK(IDATA,12),IDATA=1,50)/ &                                                
+      2.73921E-10,3.04500E-10,3.38056E-10,3.74835E-10,4.15099E-10, & 
+      4.59126E-10,5.07214E-10,5.59679E-10,6.16857E-10,6.79103E-10, & 
+      7.46796E-10,8.20335E-10,9.00144E-10,9.86671E-10,1.08039E-09, & 
+      1.18180E-09,1.29142E-09,1.40982E-09,1.53757E-09,1.67529E-09, & 
+      1.82363E-09,1.98327E-09,2.15492E-09,2.33932E-09,2.53726E-09, & 
+      2.74957E-09,2.97710E-09,3.22075E-09,3.48145E-09,3.76020E-09, & 
+      4.05801E-09,4.37595E-09,4.71513E-09,5.07672E-09,5.46193E-09, & 
+      5.87201E-09,6.30827E-09,6.77205E-09,7.26480E-09,7.78794E-09, & 
+      8.34304E-09,8.93163E-09,9.55537E-09,1.02159E-08,1.09151E-08, & 
+      1.16547E-08,1.24365E-08,1.32625E-08,1.41348E-08,1.50554E-08/               
+      DATA (TOTPLNK(IDATA,12),IDATA=51,100)/ &                                              
+      1.60264E-08,1.70500E-08,1.81285E-08,1.92642E-08,2.04596E-08, & 
+      2.17171E-08,2.30394E-08,2.44289E-08,2.58885E-08,2.74209E-08, & 
+      2.90290E-08,3.07157E-08,3.24841E-08,3.43371E-08,3.62782E-08, & 
+      3.83103E-08,4.04371E-08,4.26617E-08,4.49878E-08,4.74190E-08, & 
+      4.99589E-08,5.26113E-08,5.53801E-08,5.82692E-08,6.12826E-08, & 
+      6.44245E-08,6.76991E-08,7.11105E-08,7.46634E-08,7.83621E-08, & 
+      8.22112E-08,8.62154E-08,9.03795E-08,9.47081E-08,9.92066E-08, & 
+      1.03879E-07,1.08732E-07,1.13770E-07,1.18998E-07,1.24422E-07, & 
+      1.30048E-07,1.35880E-07,1.41924E-07,1.48187E-07,1.54675E-07, & 
+      1.61392E-07,1.68346E-07,1.75543E-07,1.82988E-07,1.90688E-07/               
+      DATA (TOTPLNK(IDATA,12),IDATA=101,150)/ &                                             
+      1.98650E-07,2.06880E-07,2.15385E-07,2.24172E-07,2.33247E-07, & 
+      2.42617E-07,2.52289E-07,2.62272E-07,2.72571E-07,2.83193E-07, & 
+      2.94147E-07,3.05440E-07,3.17080E-07,3.29074E-07,3.41430E-07, & 
+      3.54155E-07,3.67259E-07,3.80747E-07,3.94631E-07,4.08916E-07, & 
+      4.23611E-07,4.38725E-07,4.54267E-07,4.70245E-07,4.86666E-07, & 
+      5.03541E-07,5.20879E-07,5.38687E-07,5.56975E-07,5.75751E-07, & 
+      5.95026E-07,6.14808E-07,6.35107E-07,6.55932E-07,6.77293E-07, & 
+      6.99197E-07,7.21656E-07,7.44681E-07,7.68278E-07,7.92460E-07, & 
+      8.17235E-07,8.42614E-07,8.68606E-07,8.95223E-07,9.22473E-07, & 
+      9.50366E-07,9.78915E-07,1.00813E-06,1.03802E-06,1.06859E-06/               
+      DATA (TOTPLNK(IDATA,12),IDATA=151,181)/ &                                             
+      1.09986E-06,1.13184E-06,1.16453E-06,1.19796E-06,1.23212E-06, & 
+      1.26703E-06,1.30270E-06,1.33915E-06,1.37637E-06,1.41440E-06, & 
+      1.45322E-06,1.49286E-06,1.53333E-06,1.57464E-06,1.61679E-06, & 
+      1.65981E-06,1.70370E-06,1.74847E-06,1.79414E-06,1.84071E-06, & 
+      1.88821E-06,1.93663E-06,1.98599E-06,2.03631E-06,2.08759E-06, & 
+      2.13985E-06,2.19310E-06,2.24734E-06,2.30260E-06,2.35888E-06, & 
+      2.41619E-06/                                                               
+      DATA (TOTPLNK(IDATA,13),IDATA=1,50)/ &                                                
+      4.53634E-11,5.11435E-11,5.75754E-11,6.47222E-11,7.26531E-11, & 
+      8.14420E-11,9.11690E-11,1.01921E-10,1.13790E-10,1.26877E-10, & 
+      1.41288E-10,1.57140E-10,1.74555E-10,1.93665E-10,2.14613E-10, & 
+      2.37548E-10,2.62633E-10,2.90039E-10,3.19948E-10,3.52558E-10, & 
+      3.88073E-10,4.26716E-10,4.68719E-10,5.14331E-10,5.63815E-10, & 
+      6.17448E-10,6.75526E-10,7.38358E-10,8.06277E-10,8.79625E-10, & 
+      9.58770E-10,1.04410E-09,1.13602E-09,1.23495E-09,1.34135E-09, & 
+      1.45568E-09,1.57845E-09,1.71017E-09,1.85139E-09,2.00268E-09, & 
+      2.16464E-09,2.33789E-09,2.52309E-09,2.72093E-09,2.93212E-09, & 
+      3.15740E-09,3.39757E-09,3.65341E-09,3.92579E-09,4.21559E-09/               
+      DATA (TOTPLNK(IDATA,13),IDATA=51,100)/ &                                              
+      4.52372E-09,4.85115E-09,5.19886E-09,5.56788E-09,5.95928E-09, & 
+      6.37419E-09,6.81375E-09,7.27917E-09,7.77168E-09,8.29256E-09, & 
+      8.84317E-09,9.42487E-09,1.00391E-08,1.06873E-08,1.13710E-08, & 
+      1.20919E-08,1.28515E-08,1.36514E-08,1.44935E-08,1.53796E-08, & 
+      1.63114E-08,1.72909E-08,1.83201E-08,1.94008E-08,2.05354E-08, & 
+      2.17258E-08,2.29742E-08,2.42830E-08,2.56545E-08,2.70910E-08, & 
+      2.85950E-08,3.01689E-08,3.18155E-08,3.35373E-08,3.53372E-08, & 
+      3.72177E-08,3.91818E-08,4.12325E-08,4.33727E-08,4.56056E-08, & 
+      4.79342E-08,5.03617E-08,5.28915E-08,5.55270E-08,5.82715E-08, & 
+      6.11286E-08,6.41019E-08,6.71951E-08,7.04119E-08,7.37560E-08/               
+      DATA (TOTPLNK(IDATA,13),IDATA=101,150)/ &                                             
+      7.72315E-08,8.08424E-08,8.45927E-08,8.84866E-08,9.25281E-08, & 
+      9.67218E-08,1.01072E-07,1.05583E-07,1.10260E-07,1.15107E-07, & 
+      1.20128E-07,1.25330E-07,1.30716E-07,1.36291E-07,1.42061E-07, & 
+      1.48031E-07,1.54206E-07,1.60592E-07,1.67192E-07,1.74015E-07, & 
+      1.81064E-07,1.88345E-07,1.95865E-07,2.03628E-07,2.11643E-07, & 
+      2.19912E-07,2.28443E-07,2.37244E-07,2.46318E-07,2.55673E-07, & 
+      2.65316E-07,2.75252E-07,2.85489E-07,2.96033E-07,3.06891E-07, & 
+      3.18070E-07,3.29576E-07,3.41417E-07,3.53600E-07,3.66133E-07, & 
+      3.79021E-07,3.92274E-07,4.05897E-07,4.19899E-07,4.34288E-07, & 
+      4.49071E-07,4.64255E-07,4.79850E-07,4.95863E-07,5.12300E-07/               
+      DATA (TOTPLNK(IDATA,13),IDATA=151,181)/ &                                             
+      5.29172E-07,5.46486E-07,5.64250E-07,5.82473E-07,6.01164E-07, & 
+      6.20329E-07,6.39979E-07,6.60122E-07,6.80767E-07,7.01922E-07, & 
+      7.23596E-07,7.45800E-07,7.68539E-07,7.91826E-07,8.15669E-07, & 
+      8.40076E-07,8.65058E-07,8.90623E-07,9.16783E-07,9.43544E-07, & 
+      9.70917E-07,9.98912E-07,1.02754E-06,1.05681E-06,1.08673E-06, & 
+      1.11731E-06,1.14856E-06,1.18050E-06,1.21312E-06,1.24645E-06, & 
+      1.28049E-06/                                                               
+      DATA (TOTPLNK(IDATA,14),IDATA=1,50)/ &                                                
+      1.40113E-11,1.59358E-11,1.80960E-11,2.05171E-11,2.32266E-11, & 
+      2.62546E-11,2.96335E-11,3.33990E-11,3.75896E-11,4.22469E-11, & 
+      4.74164E-11,5.31466E-11,5.94905E-11,6.65054E-11,7.42522E-11, & 
+      8.27975E-11,9.22122E-11,1.02573E-10,1.13961E-10,1.26466E-10, & 
+      1.40181E-10,1.55206E-10,1.71651E-10,1.89630E-10,2.09265E-10, & 
+      2.30689E-10,2.54040E-10,2.79467E-10,3.07128E-10,3.37190E-10, & 
+      3.69833E-10,4.05243E-10,4.43623E-10,4.85183E-10,5.30149E-10, & 
+      5.78755E-10,6.31255E-10,6.87910E-10,7.49002E-10,8.14824E-10, & 
+      8.85687E-10,9.61914E-10,1.04385E-09,1.13186E-09,1.22631E-09, & 
+      1.32761E-09,1.43617E-09,1.55243E-09,1.67686E-09,1.80992E-09/               
+      DATA (TOTPLNK(IDATA,14),IDATA=51,100)/ &                                              
+      1.95212E-09,2.10399E-09,2.26607E-09,2.43895E-09,2.62321E-09, & 
+      2.81949E-09,3.02844E-09,3.25073E-09,3.48707E-09,3.73820E-09, & 
+      4.00490E-09,4.28794E-09,4.58819E-09,4.90647E-09,5.24371E-09, & 
+      5.60081E-09,5.97875E-09,6.37854E-09,6.80120E-09,7.24782E-09, & 
+      7.71950E-09,8.21740E-09,8.74271E-09,9.29666E-09,9.88054E-09, & 
+      1.04956E-08,1.11434E-08,1.18251E-08,1.25422E-08,1.32964E-08, & 
+      1.40890E-08,1.49217E-08,1.57961E-08,1.67140E-08,1.76771E-08, & 
+      1.86870E-08,1.97458E-08,2.08553E-08,2.20175E-08,2.32342E-08, & 
+      2.45077E-08,2.58401E-08,2.72334E-08,2.86900E-08,3.02122E-08, & 
+      3.18021E-08,3.34624E-08,3.51954E-08,3.70037E-08,3.88899E-08/               
+      DATA (TOTPLNK(IDATA,14),IDATA=101,150)/ &                                             
+      4.08568E-08,4.29068E-08,4.50429E-08,4.72678E-08,4.95847E-08, & 
+      5.19963E-08,5.45058E-08,5.71161E-08,5.98309E-08,6.26529E-08, & 
+      6.55857E-08,6.86327E-08,7.17971E-08,7.50829E-08,7.84933E-08, & 
+      8.20323E-08,8.57035E-08,8.95105E-08,9.34579E-08,9.75488E-08, & 
+      1.01788E-07,1.06179E-07,1.10727E-07,1.15434E-07,1.20307E-07, & 
+      1.25350E-07,1.30566E-07,1.35961E-07,1.41539E-07,1.47304E-07, & 
+      1.53263E-07,1.59419E-07,1.65778E-07,1.72345E-07,1.79124E-07, & 
+      1.86122E-07,1.93343E-07,2.00792E-07,2.08476E-07,2.16400E-07, & 
+      2.24568E-07,2.32988E-07,2.41666E-07,2.50605E-07,2.59813E-07, & 
+      2.69297E-07,2.79060E-07,2.89111E-07,2.99455E-07,3.10099E-07/               
+      DATA (TOTPLNK(IDATA,14),IDATA=151,181)/ &                                             
+      3.21049E-07,3.32311E-07,3.43893E-07,3.55801E-07,3.68041E-07, & 
+      3.80621E-07,3.93547E-07,4.06826E-07,4.20465E-07,4.34473E-07, & 
+      4.48856E-07,4.63620E-07,4.78774E-07,4.94325E-07,5.10280E-07, & 
+      5.26648E-07,5.43436E-07,5.60652E-07,5.78302E-07,5.96397E-07, & 
+      6.14943E-07,6.33949E-07,6.53421E-07,6.73370E-07,6.93803E-07, & 
+      7.14731E-07,7.36157E-07,7.58095E-07,7.80549E-07,8.03533E-07, & 
+      8.27050E-07/                                                               
+      DATA (TOTPLNK(IDATA,15),IDATA=1,50)/ &                                                
+      3.90483E-12,4.47999E-12,5.13122E-12,5.86739E-12,6.69829E-12, & 
+      7.63467E-12,8.68833E-12,9.87221E-12,1.12005E-11,1.26885E-11, & 
+      1.43534E-11,1.62134E-11,1.82888E-11,2.06012E-11,2.31745E-11, & 
+      2.60343E-11,2.92087E-11,3.27277E-11,3.66242E-11,4.09334E-11, & 
+      4.56935E-11,5.09455E-11,5.67338E-11,6.31057E-11,7.01127E-11, & 
+      7.78096E-11,8.62554E-11,9.55130E-11,1.05651E-10,1.16740E-10, & 
+      1.28858E-10,1.42089E-10,1.56519E-10,1.72243E-10,1.89361E-10, & 
+      2.07978E-10,2.28209E-10,2.50173E-10,2.73999E-10,2.99820E-10, & 
+      3.27782E-10,3.58034E-10,3.90739E-10,4.26067E-10,4.64196E-10, & 
+      5.05317E-10,5.49631E-10,5.97347E-10,6.48689E-10,7.03891E-10/               
+      DATA (TOTPLNK(IDATA,15),IDATA=51,100)/ &                                              
+      7.63201E-10,8.26876E-10,8.95192E-10,9.68430E-10,1.04690E-09, & 
+      1.13091E-09,1.22079E-09,1.31689E-09,1.41957E-09,1.52922E-09, & 
+      1.64623E-09,1.77101E-09,1.90401E-09,2.04567E-09,2.19647E-09, & 
+      2.35690E-09,2.52749E-09,2.70875E-09,2.90127E-09,3.10560E-09, & 
+      3.32238E-09,3.55222E-09,3.79578E-09,4.05375E-09,4.32682E-09, & 
+      4.61574E-09,4.92128E-09,5.24420E-09,5.58536E-09,5.94558E-09, & 
+      6.32575E-09,6.72678E-09,7.14964E-09,7.59526E-09,8.06470E-09, & 
+      8.55897E-09,9.07916E-09,9.62638E-09,1.02018E-08,1.08066E-08, & 
+      1.14420E-08,1.21092E-08,1.28097E-08,1.35446E-08,1.43155E-08, & 
+      1.51237E-08,1.59708E-08,1.68581E-08,1.77873E-08,1.87599E-08/               
+      DATA (TOTPLNK(IDATA,15),IDATA=101,150)/ &                                             
+      1.97777E-08,2.08423E-08,2.19555E-08,2.31190E-08,2.43348E-08, & 
+      2.56045E-08,2.69302E-08,2.83140E-08,2.97578E-08,3.12636E-08, & 
+      3.28337E-08,3.44702E-08,3.61755E-08,3.79516E-08,3.98012E-08, & 
+      4.17265E-08,4.37300E-08,4.58143E-08,4.79819E-08,5.02355E-08, & 
+      5.25777E-08,5.50114E-08,5.75393E-08,6.01644E-08,6.28896E-08, & 
+      6.57177E-08,6.86521E-08,7.16959E-08,7.48520E-08,7.81239E-08, & 
+      8.15148E-08,8.50282E-08,8.86675E-08,9.24362E-08,9.63380E-08, & 
+      1.00376E-07,1.04555E-07,1.08878E-07,1.13349E-07,1.17972E-07, & 
+      1.22751E-07,1.27690E-07,1.32793E-07,1.38064E-07,1.43508E-07, & 
+      1.49129E-07,1.54931E-07,1.60920E-07,1.67099E-07,1.73473E-07/               
+      DATA (TOTPLNK(IDATA,15),IDATA=151,181)/ &                                             
+      1.80046E-07,1.86825E-07,1.93812E-07,2.01014E-07,2.08436E-07, & 
+      2.16082E-07,2.23957E-07,2.32067E-07,2.40418E-07,2.49013E-07, & 
+      2.57860E-07,2.66963E-07,2.76328E-07,2.85961E-07,2.95868E-07, & 
+      3.06053E-07,3.16524E-07,3.27286E-07,3.38345E-07,3.49707E-07, & 
+      3.61379E-07,3.73367E-07,3.85676E-07,3.98315E-07,4.11287E-07, & 
+      4.24602E-07,4.38265E-07,4.52283E-07,4.66662E-07,4.81410E-07, & 
+      4.96535E-07/                                                               
+      DATA (TOTPLNK(IDATA,16),IDATA=1,50)/ &                                                
+      4.65378E-13,5.41927E-13,6.29913E-13,7.30869E-13,8.46510E-13, & 
+      9.78750E-13,1.12972E-12,1.30181E-12,1.49764E-12,1.72016E-12, & 
+      1.97260E-12,2.25858E-12,2.58206E-12,2.94744E-12,3.35955E-12, & 
+      3.82372E-12,4.34581E-12,4.93225E-12,5.59010E-12,6.32711E-12, & 
+      7.15171E-12,8.07317E-12,9.10159E-12,1.02480E-11,1.15244E-11, & 
+      1.29438E-11,1.45204E-11,1.62697E-11,1.82084E-11,2.03545E-11, & 
+      2.27278E-11,2.53494E-11,2.82424E-11,3.14313E-11,3.49431E-11, & 
+      3.88064E-11,4.30522E-11,4.77139E-11,5.28273E-11,5.84308E-11, & 
+      6.45658E-11,7.12764E-11,7.86103E-11,8.66176E-11,9.53534E-11, & 
+      1.04875E-10,1.15245E-10,1.26528E-10,1.38796E-10,1.52123E-10/               
+      DATA (TOTPLNK(IDATA,16),IDATA=51,100)/ &                                              
+      1.66590E-10,1.82281E-10,1.99287E-10,2.17704E-10,2.37632E-10, & 
+      2.59182E-10,2.82468E-10,3.07610E-10,3.34738E-10,3.63988E-10, & 
+      3.95504E-10,4.29438E-10,4.65951E-10,5.05212E-10,5.47402E-10, & 
+      5.92707E-10,6.41329E-10,6.93477E-10,7.49371E-10,8.09242E-10, & 
+      8.73338E-10,9.41911E-10,1.01524E-09,1.09359E-09,1.17728E-09, & 
+      1.26660E-09,1.36190E-09,1.46350E-09,1.57177E-09,1.68709E-09, & 
+      1.80984E-09,1.94044E-09,2.07932E-09,2.22693E-09,2.38373E-09, & 
+      2.55021E-09,2.72689E-09,2.91429E-09,3.11298E-09,3.32353E-09, & 
+      3.54655E-09,3.78265E-09,4.03251E-09,4.29679E-09,4.57620E-09, & 
+      4.87148E-09,5.18341E-09,5.51276E-09,5.86037E-09,6.22708E-09/               
+      DATA (TOTPLNK(IDATA,16),IDATA=101,150)/ &                                             
+      6.61381E-09,7.02145E-09,7.45097E-09,7.90336E-09,8.37967E-09, & 
+      8.88092E-09,9.40827E-09,9.96280E-09,1.05457E-08,1.11583E-08, & 
+      1.18017E-08,1.24773E-08,1.31865E-08,1.39306E-08,1.47111E-08, & 
+      1.55295E-08,1.63872E-08,1.72860E-08,1.82274E-08,1.92132E-08, & 
+      2.02450E-08,2.13247E-08,2.24541E-08,2.36352E-08,2.48699E-08, & 
+      2.61602E-08,2.75082E-08,2.89161E-08,3.03860E-08,3.19203E-08, & 
+      3.35213E-08,3.51913E-08,3.69330E-08,3.87486E-08,4.06411E-08, & 
+      4.26129E-08,4.46668E-08,4.68058E-08,4.90325E-08,5.13502E-08, & 
+      5.37617E-08,5.62703E-08,5.88791E-08,6.15915E-08,6.44107E-08, & 
+      6.73404E-08,7.03841E-08,7.35453E-08,7.68278E-08,8.02355E-08/               
+      DATA (TOTPLNK(IDATA,16),IDATA=151,181)/ &                                             
+      8.37721E-08,8.74419E-08,9.12486E-08,9.51968E-08,9.92905E-08, & 
+      1.03534E-07,1.07932E-07,1.12490E-07,1.17211E-07,1.22100E-07, & 
+      1.27163E-07,1.32404E-07,1.37829E-07,1.43443E-07,1.49250E-07, & 
+      1.55257E-07,1.61470E-07,1.67893E-07,1.74532E-07,1.81394E-07, & 
+      1.88485E-07,1.95810E-07,2.03375E-07,2.11189E-07,2.19256E-07, & 
+      2.27583E-07,2.36177E-07,2.45046E-07,2.54196E-07,2.63634E-07, & 
+      2.73367E-07/                                                               
+                                                                                 
+      DATA (TOTPLK16(IDATA),IDATA=1,50)/ &                                                  
+      4.46128E-13,5.19008E-13,6.02681E-13,6.98580E-13,8.08302E-13, & 
+      9.33629E-13,1.07654E-12,1.23925E-12,1.42419E-12,1.63407E-12, & 
+      1.87190E-12,2.14099E-12,2.44498E-12,2.78793E-12,3.17424E-12, & 
+      3.60881E-12,4.09698E-12,4.64461E-12,5.25813E-12,5.94456E-12, & 
+      6.71156E-12,7.56752E-12,8.52154E-12,9.58357E-12,1.07644E-11, & 
+      1.20758E-11,1.35304E-11,1.51420E-11,1.69256E-11,1.88973E-11, & 
+      2.10746E-11,2.34762E-11,2.61227E-11,2.90356E-11,3.22388E-11, & 
+      3.57574E-11,3.96187E-11,4.38519E-11,4.84883E-11,5.35616E-11, & 
+      5.91075E-11,6.51647E-11,7.17743E-11,7.89797E-11,8.68284E-11, & 
+      9.53697E-11,1.04658E-10,1.14748E-10,1.25701E-10,1.37582E-10/               
+      DATA (TOTPLK16(IDATA),IDATA=51,100)/ &                                                
+      1.50457E-10,1.64400E-10,1.79487E-10,1.95799E-10,2.13422E-10, & 
+      2.32446E-10,2.52970E-10,2.75094E-10,2.98925E-10,3.24578E-10, & 
+      3.52172E-10,3.81833E-10,4.13695E-10,4.47897E-10,4.84588E-10, & 
+      5.23922E-10,5.66063E-10,6.11182E-10,6.59459E-10,7.11081E-10, & 
+      7.66251E-10,8.25172E-10,8.88065E-10,9.55155E-10,1.02668E-09, & 
+      1.10290E-09,1.18406E-09,1.27044E-09,1.36233E-09,1.46002E-09, & 
+      1.56382E-09,1.67406E-09,1.79108E-09,1.91522E-09,2.04686E-09, & 
+      2.18637E-09,2.33416E-09,2.49063E-09,2.65622E-09,2.83136E-09, & 
+      3.01653E-09,3.21221E-09,3.41890E-09,3.63712E-09,3.86740E-09, & 
+      4.11030E-09,4.36641E-09,4.63631E-09,4.92064E-09,5.22003E-09/               
+      DATA (TOTPLK16(IDATA),IDATA=101,150)/ &                                               
+      5.53516E-09,5.86670E-09,6.21538E-09,6.58191E-09,6.96708E-09, & 
+      7.37165E-09,7.79645E-09,8.24229E-09,8.71007E-09,9.20066E-09, & 
+      9.71498E-09,1.02540E-08,1.08186E-08,1.14100E-08,1.20290E-08, & 
+      1.26767E-08,1.33544E-08,1.40630E-08,1.48038E-08,1.55780E-08, & 
+      1.63867E-08,1.72313E-08,1.81130E-08,1.90332E-08,1.99932E-08, & 
+      2.09945E-08,2.20385E-08,2.31267E-08,2.42605E-08,2.54416E-08, & 
+      2.66716E-08,2.79520E-08,2.92846E-08,3.06711E-08,3.21133E-08, & 
+      3.36128E-08,3.51717E-08,3.67918E-08,3.84749E-08,4.02232E-08, & 
+      4.20386E-08,4.39231E-08,4.58790E-08,4.79083E-08,5.00132E-08, & 
+      5.21961E-08,5.44592E-08,5.68049E-08,5.92356E-08,6.17537E-08/               
+      DATA (TOTPLK16(IDATA),IDATA=151,181)/ &                                               
+      6.43617E-08,6.70622E-08,6.98578E-08,7.27511E-08,7.57449E-08, & 
+      7.88419E-08,8.20449E-08,8.53568E-08,8.87805E-08,9.23190E-08, & 
+      9.59753E-08,9.97526E-08,1.03654E-07,1.07682E-07,1.11841E-07, & 
+      1.16134E-07,1.20564E-07,1.25135E-07,1.29850E-07,1.34712E-07, & 
+      1.39726E-07,1.44894E-07,1.50221E-07,1.55711E-07,1.61367E-07, & 
+      1.67193E-07,1.73193E-07,1.79371E-07,1.85732E-07,1.92279E-07, & 
+      1.99016E-07/                                                               
+
+                                                            
+                
+
+CONTAINS
+
+!------------------------------------------------------------------
+   SUBROUTINE RRTMLWRAD(rthraten,glw,emiss                        &
+                       ,p8w,p3d,pi3d                              &
+                       ,dz8w,t3d,t8w,rho3d,r,g                    &
+                       ,icloud, warm_rain                         &
+                       ,ids,ide, jds,jde, kds,kde                 & 
+                       ,ims,ime, jms,jme, kms,kme                 &
+                       ,its,ite, jts,jte, kts,kte                 &
+                       ,qv3d,qc3d,qr3d                            &
+                       ,qi3d,qs3d,qg3d,cldfra3d                   &
+                       ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg             &
+                                                                  )
+!------------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------------
+   LOGICAL, INTENT(IN )      ::        warm_rain
+!
+   INTEGER, INTENT(IN )      ::        ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte
+
+   INTEGER, INTENT(IN )      ::        ICLOUD
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
+         INTENT(IN   ) ::                                   dz8w, &
+                                                             T3D, &
+                                                             t8w, &
+                                                             p8w, &
+                                                             P3D, &
+                                                            pi3D, &
+                                                           rho3D
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
+         INTENT(INOUT)  ::                              RTHRATEN
+!
+   REAL, DIMENSION( ims:ime, jms:jme )                          , &
+         INTENT(IN   )  ::                                 EMISS
+!
+   REAL, DIMENSION( ims:ime, jms:jme )                          , &
+         INTENT(INOUT)  ::                                   GLW
+!
+   REAL, INTENT(IN  )   ::                                   R,G
+!
+! Optional
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
+         OPTIONAL                                               , &
+         INTENT(IN   ) ::                                         &
+                                                        CLDFRA3D, &
+                                                            QV3D, &
+                                                            QC3D, &
+                                                            QR3D, &
+                                                            QI3D, &
+                                                            QS3D, &
+                                                            QG3D
+
+   LOGICAL, OPTIONAL, INTENT(IN )      ::        F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
+
+!  LOCAL VARS
+ 
+   REAL, DIMENSION( kts:kte+1 ) ::                          Pw1D, &
+                                                            Tw1D, &
+                                                            PHYD
+
+   REAL, DIMENSION( kts:kte ) ::                          TTEN1D, &
+                                                        CLDFRA1D, &
+                                                            DZ1D, &
+                                                             P1D, &
+                                                         PHYDMID, &
+                                                             T1D, &
+                                                            QV1D, &
+                                                            QC1D, &
+                                                            QR1D, &
+                                                            QI1D, &
+                                                            QS1D, &
+                                                            QG1D
+!
+    REAL   ::                                   TSFC,GLW0,EMISS0,FP
+!
+    INTEGER:: i,j,K,NK
+    LOGICAL :: predicate
+
+!------------------------------------------------------------------
+
+!-----CALCULATE LONG WAVE RADIATION
+!                                                              
+   j_loop: DO J=jts,jte
+   i_loop: DO I=its,ite
+
+! reverse vars 
+! p1D pw1D are in mb
+
+! NEED HYDROSTATIC PRESSURE HERE (MONOTONIC CHANGE WITH HEIGHT)
+! PHYD REPLACES P8W, PHYDMID REPLACES P3D
+         PHYD(kts) = p8w(I,kts,J)
+! first guess
+         DO K = KTS,KTE
+            PHYD(K+1) = PHYD(K) - G*RHO3D(I,K,J)*DZ8W(I,K,J)
+         ENDDO
+! correction factor FP to match p8w(I,kts,J)-p8w(I,kte,J)
+         FP = (p8w(I,kts,J)-p8w(I,kte,J))/(PHYD(KTS)-PHYD(KTE))
+! final pass
+         DO K = KTS,KTE
+            PHYD(K+1) = PHYD(K) - G*RHO3D(I,K,J)*DZ8W(I,K,J)*FP
+            PHYDMID(K)= 0.5*(PHYD(K)+PHYD(K+1))
+         ENDDO
+
+         do k=kts,kte+1
+            NK=kme-k+kms
+!           Pw1D(K) = p8w(I,NK,J)/100.
+            Pw1D(K) = PHYD(NK)/100.
+            Tw1D(K) = t8w(I,NK,J)
+         enddo
+
+         DO K=kts,kte
+            QV1D(K)=0.
+            QC1D(K)=0.
+            QR1D(K)=0.
+            QI1D(K)=0.
+            QS1D(K)=0.
+            CLDFRA1D(k)=0.
+         ENDDO
+
+         DO K=kts,kte
+            NK=kme-1-K+kms
+            QV1D(K)=QV3D(I,NK,J)
+            QV1D(K)=max(0.,QV1D(K))
+         ENDDO
+
+         DO K=kts,kte
+            NK=kme-1-K+kms
+            TTEN1D(K)=0.
+            T1D(K)=T3D(I,NK,J)
+!           P1D(K)=P3D(I,NK,J)/100.
+            P1D(K)=PHYDMID(NK)/100.
+            DZ1D(K)=dz8w(I,NK,J)
+         ENDDO
+
+         IF (ICLOUD .ne. 0) THEN
+            IF ( PRESENT( CLDFRA3D ) ) THEN
+              DO K=kts,kte
+                 NK=kme-1-K+kms
+                 CLDFRA1D(k)=CLDFRA3D(I,NK,J)
+              ENDDO
+            ENDIF
+
+            IF (PRESENT(F_QC) .AND. PRESENT(QC3D)) THEN
+              IF ( F_QC) THEN
+                 DO K=kts,kte
+                    NK=kme-1-K+kms
+                    QC1D(K)=QC3D(I,NK,J)
+                    QC1D(K)=max(0.,QC1D(K))
+                 ENDDO
+              ENDIF
+            ENDIF
+
+            IF (PRESENT(F_QR) .AND. PRESENT(QR3D)) THEN
+              IF ( F_QR) THEN
+                 DO K=kts,kte
+                    NK=kme-1-K+kms
+                    QR1D(K)=QR3D(I,NK,J)
+                    QR1D(K)=max(0.,QR1D(K))
+                 ENDDO
+              ENDIF
+            ENDIF
+
+! This logic is tortured because cannot test F_QI unless
+! it is present, and order of evaluation of expressions
+! is not specified in Fortran
+
+            IF ( PRESENT ( F_QI ) ) THEN
+              predicate = F_QI
+            ELSE
+              predicate = .FALSE.
+            ENDIF
+
+            IF (.NOT. predicate .and. .not. warm_rain) THEN
+               DO K=kts,kte
+                  IF (T1D(K) .lt. 273.15) THEN
+                  QI1D(K)=QC1D(K)
+                  QS1D(K)=QR1D(K)
+                  QC1D(K)=0.
+                  QR1D(K)=0.
+                  ENDIF
+               ENDDO
+            ENDIF
+
+            IF (PRESENT(F_QI) .AND. PRESENT(QI3D)) THEN
+               DO K=kts,kte
+                  NK=kme-1-K+kms
+                  QI1D(K)=QI3D(I,NK,J)
+                  QI1D(K)=max(0.,QI1D(K))
+               ENDDO
+            ENDIF
+
+            IF (PRESENT(F_QS) .AND. PRESENT(QS3D)) THEN
+               IF (F_QS) THEN
+                  DO K=kts,kte
+                     NK=kme-1-K+kms
+                     QS1D(K)=QS3D(I,NK,J)
+                     QS1D(K)=max(0.,QS1D(K))
+                  ENDDO
+               ENDIF
+            ENDIF
+
+            IF (PRESENT(F_QG) .AND. PRESENT(QG3D)) THEN
+               IF (F_QG) THEN
+                  DO K=kts,kte
+                     NK=kme-1-K+kms
+                     QG1D(K)=QG3D(I,NK,J)
+                     QG1D(K)=max(0.,QG1D(K))
+                  ENDDO
+               ENDIF
+            ENDIF
+
+         ENDIF
+
+         EMISS0=EMISS(I,J)
+         GLW0=0. 
+         TSFC=Tw1D(kme)
+
+         CALL RRTM(tten1d,glw0,tsfc,cldfra1d,t1d,tw1d,qv1d,qc1d,   &
+                   qr1d,qi1d,qs1d,qg1d,p1d,pW1d,dz1d,              &
+                   emiss0,r,g,                                     &
+                   kts,kte                                         )
+ 
+         GLW(I,J)=GLW0
+
+         DO K=kts,kte
+            nk=kme-1-k+kms
+            rthraten(i,k,j)=rthraten(i,k,j)+tten1d(nk)/pi3d(i,k,j)
+         ENDDO
+
+      END DO i_loop
+   END DO j_loop                                           
+
+!-------------------------------------------------------------------
+
+   END SUBROUTINE RRTMLWRAD
+
+
+!****************************************************************************    
+!*                                                                          *    
+!*                               RRTM                                       *    
+!*                                                                          *    
+!*                                                                          *    
+!*                                                                          *    
+!*                   RAPID RADIATIVE TRANSFER MODEL                         *    
+!*                                                                          *    
+!*                                                                          *    
+!*            ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC.                  *    
+!*                        840 MEMORIAL DRIVE                                *    
+!*                        CAMBRIDGE, MA 02139                               *    
+!*                                                                          *    
+!*                                                                          *    
+!*                           ELI J. MLAWER                                  *    
+!*                         STEVEN J. TAUBMAN~                               *    
+!*                         SHEPARD A. CLOUGH                                *    
+!*                                                                          *    
+!*                                                                          *    
+!*                         ~currently at GFDL                               *    
+!*                                                                          *    
+!*                                                                          *    
+!*                                                                          *    
+!*                       email:  mlawer@aer.com                             *    
+!*                                                                          *    
+!*        The authors wish to acknowledge the contributions of the          *    
+!*        following people:  Patrick D. Brown, Michael J. Iacono,           *    
+!*        Ronald E. Farren, Luke Chen, Robert Bergstrom.                    *    
+!*                                                                          *    
+!****************************************************************************    
+                                                                                 
+! *** This version of RRTM has been altered to interface with the                
+! *** NCAR MM5 mesoscale model for the calculation of longwave radiative         
+! *** transfer (based on a code for interface with CCM model by M. J. Iacono)    
+! *** J. Dudhia ; March, 1999                                                    
+!---------------------------------------------------------------------
+   SUBROUTINE RRTM(TTEN,GLW,TSFC,CLDFRA,T,Tw,QV,QC,                  &
+                   QR,QI,QS,QG,P,Pw,DZ,                              &
+                   EMISS,R,G,                                        &
+                   kts,kte                                           )
+!---------------------------------------------------------------------
+! *** This program is the driver for RRTM, the AER LW radiation model.           
+!     This routine:                                                              
+!     Calls MM5ATM to provide atmosphere in column and boundary values           
+!     a) calls GASABS to calculate gaseous optical depths                        
+!     b) calls SETCOEF to calculate various quantities needed for                
+!        the radiative transfer algorithm                                        
+!     c) calls RTRN (for both clear and cloudy columns) to do the                
+!        radiative transfer calculation                                          
+!     d) passes the necessary flux and cooling rate back to MM5                  
+!---------------------------------------------------------------------
+      IMPLICIT NONE
+!---------------------------------------------------------------------
+
+      INTEGER, INTENT(IN ) ::      kts, kte
+!
+      REAL, DIMENSION( kts:kte+1 ), INTENT(IN   ) ::             Pw, &
+                                                                 Tw
+
+      REAL, DIMENSION( kts:kte ), INTENT(IN   ) ::           CLDFRA, &
+                                                                  T, &
+                                                                  P, &
+                                                                 DZ
+!
+      REAL, DIMENSION( kts:kte ), INTENT(INOUT) ::                   &
+                                                                 QV
+      REAL, DIMENSION( kts:kte ), INTENT(IN   ) ::                   &
+                                                                 QC, &
+                                                                 QR, &
+                                                                 QI, &
+                                                                 QS, &
+                                                                 QG
+!
+      REAL, DIMENSION( kts:kte ), INTENT(INOUT)::              TTEN
+!   
+      REAL, INTENT(IN  )   ::                           R, G, EMISS
+!
+      REAL, INTENT(INOUT)  ::                              TSFC,GLW
+
+! LOCAL VAR
+
+      INTEGER, DIMENSION( NGPT,kts:kte+1 ) ::                   ITR
+
+      REAL,    DIMENSION( NGPT,kts:kte+1 ) ::                  PFRAC, &
+                                                               TAUG
+
+      REAL,    DIMENSION( 35,kts:kte+1 )       ::               WKL
+
+      REAL,    DIMENSION( MAXXSEC,kts:kte+1 )  ::                WX
+
+      REAL, DIMENSION( kts:kte )  ::                         O3PROF
+
+      REAL, DIMENSION( kts:kte+1 )  ::                        PAVEL, &
+                                                              TAVEL, &
+                                                            CLDFRAC, &
+                                                           TAUCLOUD, &   
+                                                             COLDRY, & 
+                                                             COLH2O, &
+                                                             COLCO2, &
+                                                              COLO3, &
+                                                             COLN2O, &
+                                                             COLCH4, &
+                                                              COLO2, &
+                                                            CO2MULT, &
+                                                              FAC00, &
+                                                              FAC01, &
+                                                              FAC10, &
+                                                              FAC11, &
+                                                             FORFAC, &
+                                                            SELFFAC, &
+                                                           SELFFRAC
+                                                
+!                       
+      INTEGER, DIMENSION( kts:kte+1 ) ::                    ICLDLYR, &
+                                                                 JP, &
+                                                                 JT, &
+                                                                JT1, &
+                                                            INDSELF
+
+      REAL, DIMENSION(   0:kte+1 )  ::                           PZ, &
+                                                                 TZ, &
+                                                           TOTDFLUX, &
+                                                                HTR
+!     
+      INTEGER ::  I,K,ktep1
+      INTEGER ::  LAYTROP,LAYSWTCH,LAYLOW
+      REAL    ::  TBOUND
+      REAL, DIMENSION(NBANDS) ::  SEMISS
+
+
+!---------------------------------------------------------------------------
+! RRTM Definitions                                                               
+!    NGPT                         ! Total number of g-point subintervals         
+!    MXLAY                        ! Maximum number of model layers               
+!    NBANDS                       ! Number of longwave spectral bands            
+!    PI                           ! Geometric constant                           
+!    FLUXFAC                      ! Radiance to flux conversion factor           
+!    HEATFAC                      ! Heating rate conversion factor               
+!    NG(NBANDS)                   ! Number of g-points per band for input        
+!                                   absorption coefficient data                  
+!    NSPA(NBANDS),NSPB(NBANDS)    ! Number of reference atmospheres per band     
+!    WAVENUM1(NBANDS)             ! Longwave band lower limit (wavenumbers)      
+!    WAVENUM2(NBANDS)             ! Longwave band upper limit (wavenumbers)      
+!    DELWAVE                      ! Longwave band width (wavenumbers)            
+!    NLAYERS                      ! Number of model layers (mkx+1)               
+!    PAVEL(MXLAY)                 ! Layer pressures (mb)                         
+!    PZ(0:MXLAY)                  ! Level (interface) pressures (mb)             
+!    TAVEL(MXLAY)                 ! Layer temperatures (K)                       
+!    TZ(0:MXLAY)                  ! Level (interface) temperatures(mb)           
+!    TBOUND                       ! Surface temperature (K)                      
+!    CLDFRAC(MXLAY)               ! Layer cloud fraction                         
+!    TAUCLOUD(MXLAY)              ! Layer cloud optical depth                    
+!    ITR(NGPT,MXLAY)              ! Integer look-up table index                  
+!    PFRAC(NGPT,MXLAY)            ! Planck fractions                             
+!    ICLDLYR(MXLAY)               ! Flag for cloudy layers                       
+!    TOTUFLUX(0:MXLAY)            ! Upward longwave flux (W/m2)                  
+!    TOTDFLUX(0:MXLAY)            ! Downward longwave flux (W/m2)                
+!    FNET(0:MXLAY)                ! Net longwave flux (W/m2)                     
+!    HTR(0:MXLAY)                 ! Longwave heating rate (K/day)                
+!    CLRNTTOA                     ! Clear-sky TOA outgoing flux (W/m2)           
+!    CLRNTSRF                     ! Clear-sky net surface flux (W/m2)            
+!    TOTUCLFL(0:MXLAY)            ! Clear-sky upward longwave flux (W/m2)        
+!    TOTDCLFL(0:MXLAY)            ! Clear-sky downward longwave flux (W/m2)      
+!    FNETC(0:MXLAY)               ! Clear-sky net longwave flux (W/m2)           
+!    HTRC(0:MXLAY)                ! Clear-sky longwave heating rate (K/day)      
+!                                                                                
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+!---------------------------------------------------------------------------
+
+     ktep1=kte+1
+!
+!    CLOUD EMISSIVITIES (M^2/G)                                                  
+!    THESE ARE CONSISTENT WITH LWRAD (ABCW=0.5*(ABUP+ABDOWN))                    
+!     
+!     ONEMINUS = 1. - 1.E-6                                                      
+!     PI   = 2.*ASIN(1.)                                                           
+!     FLUXFAC = PI   * 2.D4                     
+!
+      CALL INIRAD (O3PROF,Pw,kts,kte)
+                                                                              
+!  Prepare atmospheric profile from CCM for use in RRTM, and define              
+!  other RRTM input parameters.  Arrays are passed back through the              
+!  existing RRTM commons and arrays.                                             
+         
+         CALL MM5ATM(CLDFRA,O3PROF,T,Tw,TSFC,QV,QC,QR,QI,QS,QG,    &
+                     P,Pw,DZ,EMISS,R,G,                            &
+                     PAVEL,TAVEL,PZ,TZ,CLDFRAC,TAUCLOUD,COLDRY,    &
+                     WKL,WX,TBOUND,SEMISS,                         &
+                     kts,kte                                       )
+
+!  Calculate information needed by the radiative transfer routine                
+!  that is specific to this atmosphere, especially some of the                   
+!  coefficients and indices needed to compute the optical depths                 
+!  by interpolating data from stored reference atmospheres.                      
+                                                                                 
+         CALL SETCOEF(kts,ktep1,                                   &
+                      PAVEL,TAVEL,COLDRY,COLH2O,COLCO2,COLO3,      &
+                      COLN2O,COLCH4,COLO2,CO2MULT,                 &
+                      FAC00,FAC01,FAC10,FAC11,                     &
+                      FORFAC,SELFFAC,SELFFRAC,                     &
+                      JP,JT,JT1,INDSELF,WKL,LAYTROP,LAYSWTCH,LAYLOW)
+
+         CALL GASABS(kts,ktep1,                                 &
+                     COLDRY,COLH2O,COLCO2,COLO3,COLN2O,COLCH4,  &
+                     COLO2,CO2MULT,                             &
+                     FAC00,FAC01,FAC10,FAC11,                   &
+                     FORFAC,SELFFAC,SELFFRAC,                   &
+                     JP,JT,JT1,INDSELF,ITR,WX,PFRAC,TAUG,       &
+                     LAYTROP,LAYSWTCH,LAYLOW                    )
+
+!  Check for cloud in column.  Use original CCM LW threshold: if total           
+!  clear sky fraction < 0.999, then column is cloudy, otherwise consider         
+!  it clear.  Also, set up flag array, icldlyr, for use in radiative             
+!  transfer.  Set icldlyr to one for each layer with cloud.  If tclrsf           
+!  is not available, icldlyr can be set from cldfrac alone.                      
+                                                                                 
+        do 1500 k = 1, nlayers                                                   
+           if (cldfrac(k).gt.0.) then                                            
+              icldlyr(k) = 1                                                     
+           else                                                                  
+              icldlyr(k) = 0                                                     
+           endif                                                                 
+ 1500   continue                                                                 
+                                                                                 
+!  Call the radiative transfer routine.                                          
+                                                                                 
+           CALL RTRN(kts,ktep1,                                  &
+                     TAVEL, PZ, TZ, CLDFRAC, TAUCLOUD, TOTDFLUX, &
+                     HTR, ICLDLYR, ITR, PFRAC, TBOUND,SEMISS     )
+                                                                                 
+!  Pass total sky up and down flux profiles to CCM output arrays and             
+!  convert from mks to cgs units for CCM.  Pass clear sky TOA and surface        
+!  net fluxes to CCM fields for diagnostics.  Pass total sky heating rate        
+!  profile to CCM output arrays and convert units to K/sec.  The vertical        
+!  array index (bottom to top in RRTM) is reversed for CCM fields.               
+                                                                                 
+!          flntc(iiplon) = CLRNTTOA*1.e3                                         
+!          flnsc(iiplon) = CLRNTSRF*1.e3                                         
+!           do 2400 k = 0, NLAYERS-1                                             
+!              fulc(k+1) = TOTUCLFL(NLAYERS-1-k)*1.e3                            
+!              fdlc(k+1) = TOTDCLFL(NLAYERS-1-k)*1.e3                            
+!              ful(k+1) = TOTUFLUX(NLAYERS-1-k)*1.e3                             
+!              fdl(k+1) = TOTDFLUX(NLAYERS-1-k)*1.e3                             
+! 2400      continue                                                             
+           do 2450 k = 1, NLAYERS-1                                              
+!              qrlc(k) = HTRC(NLAYERS-1-k)/86400.                                
+!              qrl(k) = HTR(NLAYERS-1-k)/86400.                                  
+              TTEN(K)=HTR(NLAYERS-1-k)/86400. 
+ 2450      continue                                                              
+           GLW = TOTDFLUX(0)
+
+   END SUBROUTINE RRTM
+
+
+!***************************************************************************     
+   SUBROUTINE CMBGB1(abscoefL, abscoefH, SELFREF,                       &
+                     FRACREFA, FRACREFB, FORREF,                        &
+                     SELFREFC, FORREFC, FRACREFAC, FRACREFBC            )
+!***************************************************************************     
+!                                                                                
+!  Original version:       Michael J. Iacono; July, 1998                         
+!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
+!                                                                                
+!  The subroutines CMBGB1->CMBGB16 input the absorption coefficient              
+!  data for each band, which are defined for 16 g-points and 16 spectral         
+!  bands. The data are combined with appropriate weighting following the         
+!  g-point mapping arrays specified in RRTMINIT.  Plank fraction data            
+!  in arrays FRACREFA and FRACREFB are combined without weighting.  All          
+!  g-point reduced data are put into new arrays for use in RRTM.                 
+!                                                                                
+!  BAND 1:  10-250 cm-1 (low - H2O; high - H2O)                                  
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
+      REAL SELFREF(10,MG)              
+      REAL FRACREFA(MG), FRACREFB(MG), FORREF(MG)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG1), FORREFC(NG1)
+      REAL FRACREFAC(NG1), FRACREFBC(NG1)
+                                                                                 
+      DO 2000 JTJT = 1,5                                                           
+         DO 2200 JPJP = 1,13                                                       
+            IPRSM = 0                                                            
+            DO 2400 IGC = 1,NGC(1)                                               
+               SUMK = 0.                                                         
+               DO 2600 IPR = 1, NGN(IGC)                                         
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM)               
+ 2600          CONTINUE                                                          
+               ABSA1(JTJT+(JPJP-1)*5,IGC) = SUMK
+ 2400       CONTINUE                                                             
+ 2200    CONTINUE                                                                
+         DO 3200 JPJP = 13,59                                                      
+            IPRSM = 0                                                            
+            DO 3400 IGC = 1,NGC(1)                                               
+               SUMK = 0.                                                         
+               DO 3600 IPR = 1, NGN(IGC)                                         
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM)
+ 3600          CONTINUE                                                          
+               ABSB1(JTJT+(JPJP-13)*5,IGC) = SUMK                                             
+ 3400       CONTINUE                                                             
+ 3200    CONTINUE                                                                
+ 2000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(1)                                                  
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(IGC)                                            
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 5400 IGC = 1,NGC(1)                                                     
+         SUMK = 0.                                                               
+         SUMF1 = 0.                                                              
+         SUMF2 = 0.                                                              
+         DO 5600 IPR = 1, NGN(IGC)                                               
+            IPRSM = IPRSM + 1                                                    
+            SUMK = SUMK + FORREF(IPRSM)*RWGT(IPRSM)                              
+            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
+            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
+ 5600    CONTINUE                                                                
+         FORREFC(IGC) = SUMK                                                     
+         FRACREFAC(IGC) = SUMF1                                                  
+         FRACREFBC(IGC) = SUMF2                                                  
+ 5400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB1
+
+!***************************************************************************
+  SUBROUTINE CMBGB2(abscoefL, abscoefH, SELFREF,                       &
+                    FRACREFA, FRACREFB, FORREF,                        &
+                    SELFREFC, FORREFC, FRACREFAC, FRACREFBC            )
+!***************************************************************************     
+!                                                                                
+!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)                              
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
+      REAL SELFREF(10,MG)            
+      REAL FRACREFA(MG,13), FRACREFB(MG), FORREF(MG)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG2), FORREFC(NG2)
+      REAL FRACREFAC(NG2,13), FRACREFBC(NG2)
+                                                                                 
+      DO 2000 JTJT = 1,5                                                           
+         DO 2200 JPJP = 1,13                                                       
+            IPRSM = 0                                                            
+            DO 2400 IGC = 1,NGC(2)                                               
+               SUMK = 0.                                                         
+               DO 2600 IPR = 1, NGN(NGS(1)+IGC)                                  
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+16)
+ 2600          CONTINUE                                                          
+               ABSA2(JTJT+(JPJP-1)*5,IGC) = SUMK  
+ 2400       CONTINUE                                                             
+ 2200    CONTINUE                                                                
+         DO 3200 JPJP = 13,59                                                      
+            IPRSM = 0                                                            
+            DO 3400 IGC = 1,NGC(2)                                               
+               SUMK = 0.                                                         
+               DO 3600 IPR = 1, NGN(NGS(1)+IGC)                                  
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+16)
+ 3600          CONTINUE                                                          
+               ABSB2(JTJT+(JPJP-13)*5,IGC) = SUMK
+ 3400       CONTINUE                                                             
+ 3200    CONTINUE                                                                
+ 2000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(2)                                                  
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(1)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+16)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 5000 JPJP = 1,13                                                          
+         IPRSM = 0                                                               
+         DO 5400 IGC = 1,NGC(2)                                                  
+            SUMF = 0.                                                            
+            DO 5600 IPR = 1, NGN(NGS(1)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
+ 5600       CONTINUE                                                             
+            FRACREFAC(IGC,JPJP) = SUMF                                             
+ 5400    CONTINUE                                                                
+ 5000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 6400 IGC = 1,NGC(2)                                                     
+         SUMK = 0.                                                               
+         SUMF = 0.                                                               
+         DO 6600 IPR = 1, NGN(NGS(1)+IGC)                                        
+            IPRSM = IPRSM + 1                                                    
+            SUMK = SUMK + FORREF(IPRSM)*RWGT(IPRSM+16)                           
+            SUMF = SUMF + FRACREFB(IPRSM)                                        
+ 6600    CONTINUE                                                                
+         FORREFC(IGC) = SUMK                                                     
+         FRACREFBC(IGC) = SUMF                                                   
+ 6400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB2
+
+!***************************************************************************
+   SUBROUTINE CMBGB3(abscoefL, abscoefH, SELFREF,                       &
+                     FRACREFA, FRACREFB, FORREF, ABSN2OA, ABSN2OB,      &
+                     SELFREFC, FORREFC,                                 &
+                     ABSN2OAC, ABSN2OBC, FRACREFAC, FRACREFBC           )
+!***************************************************************************     
+!                                                                                
+!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)                      
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(10,5,13,MG),abscoefH(5,5,13:59,MG)
+      REAL SELFREF(10,MG)   
+      REAL FRACREFA(MG,10), FRACREFB(MG,5)
+      REAL FORREF(MG), ABSN2OA(MG), ABSN2OB(MG)     
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG3), FORREFC(NG3),  &
+           ABSN2OAC(NG3), ABSN2OBC(NG3) 
+      REAL FRACREFAC(NG3,10), FRACREFBC(NG3,5) 
+                                                                                 
+      DO 2000 JN = 1,10                                                          
+         DO 2000 JTJT = 1,5                                                        
+            DO 2200 JPJP = 1,13                                                    
+               IPRSM = 0                                                         
+               DO 2400 IGC = 1,NGC(3)                                            
+                 SUMK = 0.                                                       
+                  DO 2600 IPR = 1, NGN(NGS(2)+IGC)                               
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)* RWGT(IPRSM+32)
+ 2600             CONTINUE                                                       
+                  ABSA3(JN+(JTJT-1)*10+(JPJP-1)*50,IGC) = SUMK  
+ 2400          CONTINUE                                                          
+ 2200       CONTINUE                                                             
+ 2000 CONTINUE                                                                   
+      DO 3000 JN = 1,5                                                           
+         DO 3000 JTJT = 1,5                                                        
+            DO 3200 JPJP = 13,59                                                   
+               IPRSM = 0                                                         
+               DO 3400 IGC = 1,NGC(3)                                            
+                  SUMK = 0.                                                      
+                  DO 3600 IPR = 1, NGN(NGS(2)+IGC)                               
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefH(JN,JTJT,JPJP,IPRSM)* RWGT(IPRSM+32)
+ 3600             CONTINUE                                                       
+                  ABSB3(JN+(JTJT-1)*5+(JPJP-13)*25,IGC) = SUMK
+ 3400          CONTINUE                                                          
+ 3200       CONTINUE                                                             
+ 3000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(3)                                                  
+            SUMK = 0.                                                            
+            SUMF = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(2)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)* RWGT(IPRSM+32)
+               SUMF = SUMF + FRACREFA(IPRSM,JTJT)                                  
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+            FRACREFAC(IGC,JTJT) = SUMF                                             
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 5000 JPJP = 1,5                                                           
+         IPRSM = 0                                                               
+         DO 5400 IGC = 1,NGC(3)                                                  
+            SUMF = 0.                                                            
+            DO 5600 IPR = 1, NGN(NGS(2)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFB(IPRSM,JPJP)                                  
+ 5600       CONTINUE                                                             
+            FRACREFBC(IGC,JPJP) = SUMF                                             
+ 5400    CONTINUE                                                                
+ 5000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 6400 IGC = 1,NGC(3)                                                     
+         SUMK1= 0.                                                               
+         SUMK2= 0.                                                               
+         SUMK3= 0.                                                               
+         DO 6600 IPR = 1, NGN(NGS(2)+IGC)                                        
+            IPRSM = IPRSM + 1                                                    
+            SUMK1= SUMK1+ FORREF(IPRSM)*RWGT(IPRSM+32)                           
+            SUMK2= SUMK2+ ABSN2OA(IPRSM)*RWGT(IPRSM+32)                          
+            SUMK3= SUMK3+ ABSN2OB(IPRSM)*RWGT(IPRSM+32)                          
+ 6600    CONTINUE                                                                
+         FORREFC(IGC) = SUMK1                                                    
+         ABSN2OAC(IGC) = SUMK2                                                   
+         ABSN2OBC(IGC) = SUMK3                                                   
+ 6400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB3
+
+!***************************************************************************
+   SUBROUTINE CMBGB4(abscoefL, abscoefH, SELFREF,                       &
+                     FRACREFA, FRACREFB,                                &
+                     SELFREFC, FRACREFAC, FRACREFBC                     )
+!***************************************************************************     
+!                                                                                
+!     BAND 4:  630-700 cm-1 (low - H2O,CO2; high - O3,CO2)                       
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(9,5,13,MG),abscoefH(6,5,13:59,MG)
+      REAL SELFREF(10,MG)            
+      REAL FRACREFA(MG,9), FRACREFB(MG,6)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG4)
+      REAL FRACREFAC(NG4,9), FRACREFBC(NG4,6)
+                                                                                 
+      DO 2000 JN = 1,9                                                           
+         DO 2000 JTJT = 1,5                                                        
+            DO 2200 JPJP = 1,13                                                    
+               IPRSM = 0                                                         
+               DO 2400 IGC = 1,NGC(4)                                            
+                 SUMK = 0.                                                       
+                  DO 2600 IPR = 1, NGN(NGS(3)+IGC)                               
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+48)
+ 2600             CONTINUE                                                       
+                  ABSA4(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK                                       
+ 2400          CONTINUE                                                          
+ 2200       CONTINUE                                                             
+ 2000 CONTINUE                                                                   
+      DO 3000 JN = 1,6                                                           
+         DO 3000 JTJT = 1,5                                                        
+            DO 3200 JPJP = 13,59                                                   
+               IPRSM = 0                                                         
+               DO 3400 IGC = 1,NGC(4)                                            
+                  SUMK = 0.                                                      
+                  DO 3600 IPR = 1, NGN(NGS(3)+IGC)                               
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefH(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+48)
+ 3600             CONTINUE                                                       
+                  ABSB4(JN+(JTJT-1)*6+(JPJP-13)*30,IGC) = SUMK
+ 3400          CONTINUE                                                          
+ 3200       CONTINUE                                                             
+ 3000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(4)                                                  
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(3)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+48)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 5000 JPJP = 1,9                                                           
+         IPRSM = 0                                                               
+         DO 5400 IGC = 1,NGC(4)                                                  
+            SUMF = 0.                                                            
+            DO 5600 IPR = 1, NGN(NGS(3)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
+ 5600       CONTINUE                                                             
+            FRACREFAC(IGC,JPJP) = SUMF                                             
+ 5400    CONTINUE                                                                
+ 5000 CONTINUE                                                                   
+                                                                                 
+      DO 6000 JPJP = 1,6                                                           
+         IPRSM = 0                                                               
+         DO 6400 IGC = 1,NGC(4)                                                  
+            SUMF = 0.                                                            
+            DO 6600 IPR = 1, NGN(NGS(3)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFB(IPRSM,JPJP)                                  
+ 6600       CONTINUE                                                             
+            FRACREFBC(IGC,JPJP) = SUMF                                             
+ 6400    CONTINUE                                                                
+ 6000 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB4
+
+!***************************************************************************
+   SUBROUTINE CMBGB5(abscoefL, abscoefH, SELFREF,                      &
+                     FRACREFA, FRACREFB, CCL4,                         &
+                     SELFREFC, CCL4C, FRACREFAC, FRACREFBC             )
+!***************************************************************************     
+!                                                                                
+!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)                       
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(9,5,13,MG),abscoefH(5,5,13:59,MG)
+      REAL SELFREF(10,MG)            
+      REAL FRACREFA(MG,9), FRACREFB(MG,5), CCL4(MG)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG5), CCL4C(NG5) 
+      REAL FRACREFAC(NG5,9), FRACREFBC(NG5,5)               
+                                                         
+      DO 2000 JN = 1,9                                                           
+         DO 2000 JTJT = 1,5                                                        
+            DO 2200 JPJP = 1,13                                                    
+               IPRSM = 0                                                         
+               DO 2400 IGC = 1,NGC(5)                                            
+                 SUMK = 0.                                                       
+                  DO 2600 IPR = 1, NGN(NGS(4)+IGC)                               
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+64)
+ 2600             CONTINUE                                                       
+                  ABSA5(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK                                       
+ 2400          CONTINUE                                                          
+ 2200       CONTINUE                                                             
+ 2000 CONTINUE                                                                   
+      DO 3000 JN = 1,5                                                           
+         DO 3000 JTJT = 1,5                                                        
+            DO 3200 JPJP = 13,59                                                   
+               IPRSM = 0                                                         
+               DO 3400 IGC = 1,NGC(5)                                            
+                  SUMK = 0.                                                      
+                  DO 3600 IPR = 1, NGN(NGS(4)+IGC)                               
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefH(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+64)
+ 3600             CONTINUE                                                       
+                  ABSB5(JN+(JTJT-1)*5+(JPJP-13)*25,IGC) = SUMK
+ 3400          CONTINUE                                                          
+ 3200       CONTINUE                                                             
+ 3000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(5)                                                  
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(4)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+64)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 5000 JPJP = 1,9                                                           
+         IPRSM = 0                                                               
+         DO 5400 IGC = 1,NGC(5)                                                  
+            SUMF = 0.                                                            
+            DO 5600 IPR = 1, NGN(NGS(4)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
+ 5600       CONTINUE                                                             
+            FRACREFAC(IGC,JPJP) = SUMF                                             
+ 5400    CONTINUE                                                                
+ 5000 CONTINUE                                                                   
+                                                                                 
+      DO 6000 JPJP = 1,5                                                           
+         IPRSM = 0                                                               
+         DO 6400 IGC = 1,NGC(5)                                                  
+            SUMF = 0.                                                            
+            DO 6600 IPR = 1, NGN(NGS(4)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFB(IPRSM,JPJP)                                  
+ 6600       CONTINUE                                                             
+            FRACREFBC(IGC,JPJP) = SUMF                                             
+ 6400    CONTINUE                                                                
+ 6000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 7400 IGC = 1,NGC(5)                                                     
+         SUMK = 0.                                                               
+         DO 7600 IPR = 1, NGN(NGS(4)+IGC)                                        
+            IPRSM = IPRSM + 1                                                    
+            SUMK = SUMK + CCL4(IPRSM)*RWGT(IPRSM+64)                             
+ 7600    CONTINUE                                                                
+         CCL4C(IGC) = SUMK                                                       
+ 7400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB5
+
+!***************************************************************************
+   SUBROUTINE CMBGB6(abscoefL, SELFREF,                                &
+                     FRACREFA, ABSCO2, CFC11ADJ, CFC12,                &
+                     SELFREFC, ABSCO2C, CFC11ADJC, CFC12C,             &
+                     FRACREFAC                                         )
+!***************************************************************************     
+!                                                                                
+!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)                          
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(5,13,MG)                                                           
+      REAL SELFREF(10,MG)  
+      REAL FRACREFA(MG), ABSCO2(MG), CFC11ADJ(MG), CFC12(MG)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG6),  &
+           ABSCO2C(NG6), CFC11ADJC(NG6), CFC12C(NG6) 
+      REAL FRACREFAC(NG6)
+                                                                                 
+      DO 2000 JTJT = 1,5                                                           
+         DO 2200 JPJP = 1,13                                                       
+            IPRSM = 0                                                            
+            DO 2400 IGC = 1,NGC(6)                                               
+               SUMK = 0.                                                         
+               DO 2600 IPR = 1, NGN(NGS(5)+IGC)                                  
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+80)
+ 2600          CONTINUE                                                          
+               ABSA6(JTJT+(JPJP-1)*5,IGC) = SUMK                                             
+ 2400       CONTINUE                                                             
+ 2200    CONTINUE                                                                
+ 2000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(6)                                                  
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(5)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+80) 
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 7400 IGC = 1,NGC(6)                                                     
+         SUMF = 0.                                                               
+         SUMK1= 0.                                                               
+         SUMK2= 0.                                                               
+         SUMK3= 0.                                                               
+         DO 7600 IPR = 1, NGN(NGS(5)+IGC)                                        
+            IPRSM = IPRSM + 1                                                    
+            SUMF = SUMF + FRACREFA(IPRSM)                                        
+            SUMK1= SUMK1+ ABSCO2(IPRSM)*RWGT(IPRSM+80)                           
+            SUMK2= SUMK2+ CFC11ADJ(IPRSM)*RWGT(IPRSM+80)                         
+            SUMK3= SUMK3+ CFC12(IPRSM)*RWGT(IPRSM+80)                            
+ 7600    CONTINUE                                                                
+         FRACREFAC(IGC) = SUMF                                                   
+         ABSCO2C(IGC) = SUMK1                                                    
+         CFC11ADJC(IGC) = SUMK2                                                  
+         CFC12C(IGC) = SUMK3                                                     
+ 7400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB6
+
+!***************************************************************************
+   SUBROUTINE CMBGB7(abscoefL, abscoefH, SELFREF,                      &
+                     FRACREFA, FRACREFB, ABSCO2,                       &
+                     SELFREFC, ABSCO2C, FRACREFAC, FRACREFBC           )
+!***************************************************************************     
+!                                                                                
+!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)                           
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(9,5,13,MG),abscoefH(5,13:59,MG)
+      REAL SELFREF(10,MG)          
+      REAL FRACREFA(MG,9), FRACREFB(MG), ABSCO2(MG)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG7), ABSCO2C(NG7)
+      REAL FRACREFAC(NG7,9), FRACREFBC(NG7)  
+                                                                                 
+      DO 2000 JN = 1,9                                                           
+         DO 2000 JTJT = 1,5                                                        
+            DO 2200 JPJP = 1,13                                                    
+               IPRSM = 0                                                         
+               DO 2400 IGC = 1,NGC(7)                                            
+                 SUMK = 0.                                                       
+                  DO 2600 IPR = 1, NGN(NGS(6)+IGC)                               
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+96)
+ 2600             CONTINUE                                                       
+                  ABSA7(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK                                       
+ 2400          CONTINUE                                                          
+ 2200       CONTINUE                                                             
+ 2000 CONTINUE                                                                   
+      DO 3000 JTJT = 1,5                                                           
+         DO 3200 JPJP = 13,59                                                      
+            IPRSM = 0                                                            
+            DO 3400 IGC = 1,NGC(7)                                               
+               SUMK = 0.                                                         
+               DO 3600 IPR = 1, NGN(NGS(6)+IGC)                                  
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+96)
+ 3600          CONTINUE                                                          
+               ABSB7(JTJT+(JPJP-13)*5,IGC) = SUMK 
+ 3400       CONTINUE                                                             
+ 3200    CONTINUE                                                                
+ 3000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(7)                                                  
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(6)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+96)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 5000 JPJP = 1,9                                                           
+         IPRSM = 0                                                               
+         DO 5400 IGC = 1,NGC(7)                                                  
+            SUMF = 0.                                                            
+            DO 5600 IPR = 1, NGN(NGS(6)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
+ 5600       CONTINUE                                                             
+            FRACREFAC(IGC,JPJP) = SUMF                                             
+ 5400    CONTINUE                                                                
+ 5000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 7400 IGC = 1,NGC(7)                                                     
+         SUMF = 0.                                                               
+         SUMK = 0.                                                               
+         DO 7600 IPR = 1, NGN(NGS(6)+IGC)                                        
+            IPRSM = IPRSM + 1                                                    
+            SUMF = SUMF + FRACREFB(IPRSM)                                        
+            SUMK = SUMK + ABSCO2(IPRSM)*RWGT(IPRSM+96)                           
+ 7600    CONTINUE                                                                
+         FRACREFBC(IGC) = SUMF                                                   
+         ABSCO2C(IGC) = SUMK                                                     
+ 7400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB7
+
+!***************************************************************************
+   SUBROUTINE CMBGB8(abscoefL, abscoefH, SELFREF,                     &
+                     FRACREFA, FRACREFB, ABSCO2A, ABSCO2B,            &
+                     ABSN2OA,  ABSN2OB,  CFC12,   CFC22ADJ,           &
+                     SELFREFC, ABSCO2AC, ABSCO2BC,                    &
+                     ABSN2OAC, ABSN2OBC, CFC12C, CFC22ADJC,           &
+                     FRACREFAC, FRACREFBC                             )
+!***************************************************************************     
+!                                                                                
+!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)               
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(5,7,MG),abscoefH(5,7:59,MG), SELFREF(10,MG)
+      REAL FRACREFA(MG), FRACREFB(MG), ABSCO2A(MG), ABSCO2B(MG)
+      REAL ABSN2OA(MG), ABSN2OB(MG), CFC12(MG), CFC22ADJ(MG) 
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG8),               &
+           ABSCO2AC(NG8), ABSCO2BC(NG8),   &
+           ABSN2OAC(NG8), ABSN2OBC(NG8),   &
+           CFC12C(NG8), CFC22ADJC(NG8)
+      REAL FRACREFAC(NG8), FRACREFBC(NG8)
+                                                                                 
+      DO 2000 JTJT = 1,5                                                           
+         DO 2200 JPJP = 1,7                                                        
+            IPRSM = 0                                                            
+            DO 2400 IGC = 1,NGC(8)                                               
+              SUMK = 0.                                                          
+               DO 2600 IPR = 1, NGN(NGS(7)+IGC)                                  
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+112)
+ 2600          CONTINUE                                                          
+               ABSA8(JTJT+(JPJP-1)*5,IGC) = SUMK                                             
+ 2400       CONTINUE                                                             
+ 2200    CONTINUE                                                                
+ 2000 CONTINUE                                                                   
+      DO 3000 JTJT = 1,5                                                           
+         DO 3200 JPJP = 7,59                                                       
+            IPRSM = 0                                                            
+            DO 3400 IGC = 1,NGC(8)                                               
+               SUMK = 0.                                                         
+               DO 3600 IPR = 1, NGN(NGS(7)+IGC)                                  
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+112)
+ 3600          CONTINUE                                                          
+               ABSB8(JTJT+(JPJP-7)*5,IGC) = SUMK 
+ 3400       CONTINUE                                                             
+ 3200    CONTINUE                                                                
+ 3000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(8)                                                  
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(7)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+112) 
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 7400 IGC = 1,NGC(8)                                                     
+         SUMF1= 0.                                                               
+         SUMF2= 0.                                                               
+         SUMK1= 0.                                                               
+         SUMK2= 0.                                                               
+         SUMK3= 0.                                                               
+         SUMK4= 0.                                                               
+         SUMK5= 0.                                                               
+         SUMK6= 0.                                                               
+         DO 7600 IPR = 1, NGN(NGS(7)+IGC)                                        
+            IPRSM = IPRSM + 1                                                    
+            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
+            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
+            SUMK1= SUMK1+ ABSCO2A(IPRSM)*RWGT(IPRSM+112)                         
+            SUMK2= SUMK2+ ABSCO2B(IPRSM)*RWGT(IPRSM+112)                         
+            SUMK3= SUMK3+ ABSN2OA(IPRSM)*RWGT(IPRSM+112)                         
+            SUMK4= SUMK4+ ABSN2OB(IPRSM)*RWGT(IPRSM+112)                         
+            SUMK5= SUMK5+ CFC12(IPRSM)*RWGT(IPRSM+112)                           
+            SUMK6= SUMK6+ CFC22ADJ(IPRSM)*RWGT(IPRSM+112)                        
+ 7600    CONTINUE                                                                
+         FRACREFAC(IGC) = SUMF1                                                  
+         FRACREFBC(IGC) = SUMF2                                                  
+         ABSCO2AC(IGC) = SUMK1                                                   
+         ABSCO2BC(IGC) = SUMK2                                                   
+         ABSN2OAC(IGC) = SUMK3                                                   
+         ABSN2OBC(IGC) = SUMK4                                                   
+         CFC12C(IGC) = SUMK5                                                     
+         CFC22ADJC(IGC) = SUMK6                                                  
+ 7400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB8
+
+!***************************************************************************
+   SUBROUTINE CMBGB9(abscoefL, abscoefH, SELFREF,                      &
+                     FRACREFA, FRACREFB, ABSN2O,                       &
+                     SELFREFC, ABSN2OC, FRACREFAC, FRACREFBC           )
+!***************************************************************************     
+!                                                                                
+!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)                        
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(11,5,13,MG), abscoefH(5,13:59,MG)
+      REAL SELFREF(10,MG)   
+      REAL FRACREFA(MG,9), FRACREFB(MG), ABSN2O(3*MG)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG9), ABSN2OC(3*NG9)
+      REAL FRACREFAC(NG9,9), FRACREFBC(NG9)
+                                                                                 
+      DO 2000 JN = 1,11                                                          
+         DO 2000 JTJT = 1,5                                                        
+            DO 2200 JPJP = 1,13                                                    
+               IPRSM = 0                                                         
+               DO 2400 IGC = 1,NGC(9)                                            
+                  SUMK = 0.                                                      
+                  DO 2600 IPR = 1, NGN(NGS(8)+IGC)                               
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+128)
+ 2600             CONTINUE                                                       
+                  ABSA9(JN+(JTJT-1)*11+(JPJP-1)*55,IGC) = SUMK                                       
+ 2400          CONTINUE                                                          
+ 2200       CONTINUE                                                             
+ 2000 CONTINUE                                                                   
+                                                                                 
+      DO 3000 JTJT = 1,5                                                           
+         DO 3200 JPJP = 13,59                                                      
+            IPRSM = 0                                                            
+            DO 3400 IGC = 1,NGC(9)                                               
+               SUMK = 0.                                                         
+               DO 3600 IPR = 1, NGN(NGS(8)+IGC)                                  
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+128)
+ 3600          CONTINUE                                                          
+               ABSB9(JTJT+(JPJP-13)*5,IGC) = SUMK
+ 3400       CONTINUE                                                             
+ 3200    CONTINUE                                                                
+ 3000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(9)                                                  
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(8)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+128)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 5000 JN = 1,3                                                           
+         IPRSM = 0                                                               
+         DO 5400 IGC = 1,NGC(9)                                                  
+            SUMK = 0.                                                            
+            DO 5600 IPR = 1, NGN(NGS(8)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               JND = (JN-1)*16                                                   
+               SUMK = SUMK + ABSN2O(JND+IPRSM)*RWGT(IPRSM+128)                   
+ 5600       CONTINUE                                                             
+            JNDC = (JN-1)*NGC(9)                                                 
+            ABSN2OC(JNDC+IGC) = SUMK                                             
+ 5400    CONTINUE                                                                
+ 5000 CONTINUE                                                                   
+                                                                                 
+      DO 6000 JPJP = 1,9                                                           
+         IPRSM = 0                                                               
+         DO 6400 IGC = 1,NGC(9)                                                  
+            SUMF = 0.                                                            
+            DO 6600 IPR = 1, NGN(NGS(8)+IGC)                                     
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
+ 6600       CONTINUE                                                             
+            FRACREFAC(IGC,JPJP) = SUMF                                             
+ 6400    CONTINUE                                                                
+ 6000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 7400 IGC = 1,NGC(9)                                                     
+         SUMF = 0.                                                               
+         DO 7600 IPR = 1, NGN(NGS(8)+IGC)                                        
+            IPRSM = IPRSM + 1                                                    
+            SUMF = SUMF + FRACREFB(IPRSM)                                        
+ 7600    CONTINUE                                                                
+         FRACREFBC(IGC) = SUMF                                                   
+ 7400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB9
+
+!***************************************************************************
+   SUBROUTINE CMBGB10(abscoefL, abscoefH,                               &
+                      FRACREFA, FRACREFB,                               &
+                      FRACREFAC, FRACREFBC                              )
+!***************************************************************************     
+!                                                                                
+!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)                           
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)            
+      REAL FRACREFA(MG), FRACREFB(MG)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL FRACREFAC(NG10), FRACREFBC(NG10)
+                                                                                 
+      DO 2000 JTJT = 1,5                                                           
+         DO 2200 JPJP = 1,13                                                       
+            IPRSM = 0                                                            
+            DO 2400 IGC = 1,NGC(10)                                              
+               SUMK = 0.                                                         
+               DO 2600 IPR = 1, NGN(NGS(9)+IGC)                                  
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+144)
+ 2600          CONTINUE                                                          
+               ABSA10(JTJT+(JPJP-1)*5,IGC) = SUMK                                             
+ 2400       CONTINUE                                                             
+ 2200    CONTINUE                                                                
+ 2000 CONTINUE                                                                   
+      DO 3000 JTJT = 1,5                                                           
+         DO 3200 JPJP = 13,59                                                      
+            IPRSM = 0                                                            
+            DO 3400 IGC = 1,NGC(10)                                              
+               SUMK = 0.                                                         
+               DO 3600 IPR = 1, NGN(NGS(9)+IGC)                                  
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+144)
+ 3600          CONTINUE                                                          
+               ABSB10(JTJT+(JPJP-13)*5,IGC) = SUMK
+ 3400       CONTINUE                                                             
+ 3200    CONTINUE                                                                
+ 3000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 7400 IGC = 1,NGC(10)                                                    
+         SUMF1= 0.                                                               
+         SUMF2= 0.                                                               
+         DO 7600 IPR = 1, NGN(NGS(9)+IGC)                                        
+            IPRSM = IPRSM + 1                                                    
+            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
+            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
+ 7600    CONTINUE                                                                
+         FRACREFAC(IGC) = SUMF1                                                  
+         FRACREFBC(IGC) = SUMF2                                                  
+ 7400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB10
+
+!***************************************************************************
+   SUBROUTINE CMBGB11(abscoefL, abscoefH, SELFREF,                   &
+                      FRACREFA, FRACREFB,                            &
+                      SELFREFC,                                      &
+                      FRACREFAC, FRACREFBC                           )
+!***************************************************************************     
+!                                                                                
+!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)                           
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
+      REAL SELFREF(10,MG)      
+      REAL FRACREFA(MG), FRACREFB(MG)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG11)
+      REAL FRACREFAC(NG11), FRACREFBC(NG11)
+                                                                                 
+      DO 2000 JTJT = 1,5                                                           
+         DO 2200 JPJP = 1,13                                                       
+            IPRSM = 0                                                            
+            DO 2400 IGC = 1,NGC(11)                                              
+               SUMK = 0.                                                         
+               DO 2600 IPR = 1, NGN(NGS(10)+IGC)                                 
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+160)
+ 2600          CONTINUE                                                          
+               ABSA11(JTJT+(JPJP-1)*5,IGC) = SUMK                                             
+ 2400       CONTINUE                                                             
+ 2200    CONTINUE                                                                
+ 2000 CONTINUE                                                                   
+      DO 3000 JTJT = 1,5                                                           
+         DO 3200 JPJP = 13,59                                                      
+            IPRSM = 0                                                            
+            DO 3400 IGC = 1,NGC(11)                                              
+               SUMK = 0.                                                         
+               DO 3600 IPR = 1, NGN(NGS(10)+IGC)                                 
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+160) 
+ 3600          CONTINUE                                                          
+               ABSB11(JTJT+(JPJP-13)*5,IGC) = SUMK
+ 3400       CONTINUE                                                             
+ 3200    CONTINUE                                                                
+ 3000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(11)                                                 
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(10)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+160) 
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 7400 IGC = 1,NGC(11)                                                    
+         SUMF1= 0.                                                               
+         SUMF2= 0.                                                               
+         DO 7600 IPR = 1, NGN(NGS(10)+IGC)                                       
+            IPRSM = IPRSM + 1                                                    
+            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
+            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
+ 7600    CONTINUE                                                                
+         FRACREFAC(IGC) = SUMF1                                                  
+         FRACREFBC(IGC) = SUMF2                                                  
+ 7400 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB11
+
+
+!***************************************************************************
+   SUBROUTINE CMBGB12(abscoefL, SELFREF,                          &
+                      FRACREFA,                                   &
+                      SELFREFC, FRACREFAC                         )
+!***************************************************************************     
+!                                                                                
+!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)                   
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(9,5,13,MG)  
+      REAL SELFREF(10,MG)              
+      REAL FRACREFA(MG,9)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG12) 
+      REAL FRACREFAC(NG12,9)
+                                                                                 
+      DO 2000 JN = 1,9                                                           
+         DO 2000 JTJT = 1,5                                                        
+            DO 2200 JPJP = 1,13                                                    
+               IPRSM = 0                                                         
+               DO 2400 IGC = 1,NGC(12)                                           
+                  SUMK = 0.                                                      
+                  DO 2600 IPR = 1, NGN(NGS(11)+IGC)                              
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+176)
+ 2600             CONTINUE                                                       
+                  ABSA12(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK                                       
+ 2400          CONTINUE                                                          
+ 2200       CONTINUE                                                             
+ 2000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(12)                                                 
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(11)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+176)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 7000 JPJP = 1,9                                                           
+         IPRSM = 0                                                               
+         DO 7400 IGC = 1,NGC(12)                                                 
+            SUMF = 0.                                                            
+            DO 7600 IPR = 1, NGN(NGS(11)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
+ 7600       CONTINUE                                                             
+            FRACREFAC(IGC,JPJP) = SUMF                                             
+ 7400    CONTINUE                                                                
+ 7000 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB12
+
+!***************************************************************************
+   SUBROUTINE CMBGB13(abscoefL, SELFREF, FRACREFA,               &
+                      SELFREFC, FRACREFAC                        )
+!***************************************************************************     
+!                                                                                
+!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)                   
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(9,5,13,MG) 
+      REAL SELFREF(10,MG)   
+      REAL FRACREFA(MG,9)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG13) 
+      REAL FRACREFAC(NG13,9)
+                                                                                 
+      DO 2000 JN = 1,9                                                           
+         DO 2000 JTJT = 1,5                                                        
+            DO 2200 JPJP = 1,13                                                    
+               IPRSM = 0                                                         
+               DO 2400 IGC = 1,NGC(13)                                           
+                  SUMK = 0.                                                      
+                  DO 2600 IPR = 1, NGN(NGS(12)+IGC)                              
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+192)
+ 2600             CONTINUE                                                       
+                  ABSA13(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK 
+ 2400          CONTINUE                                                          
+ 2200       CONTINUE                                                             
+ 2000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(13)                                                 
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(12)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+192)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 7000 JPJP = 1,9                                                           
+         IPRSM = 0                                                               
+         DO 7400 IGC = 1,NGC(13)                                                 
+            SUMF = 0.                                                            
+            DO 7600 IPR = 1, NGN(NGS(12)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
+ 7600       CONTINUE                                                             
+            FRACREFAC(IGC,JPJP) = SUMF                                             
+ 7400    CONTINUE                                                                
+ 7000 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB13
+
+!***************************************************************************
+   SUBROUTINE CMBGB14(abscoefL, abscoefH, SELFREF,                     &
+                      FRACREFA, FRACREFB,                              &
+                      SELFREFC, FRACREFAC, FRACREFBC                   )
+!***************************************************************************     
+!                                                                                
+!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)                           
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
+      REAL SELFREF(10,MG)  
+      REAL FRACREFA(MG), FRACREFB(MG)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG14)                              
+      REAL FRACREFAC(NG14), FRACREFBC(NG14) 
+                                                                                 
+      DO 2000 JTJT = 1,5                                                           
+         DO 2200 JPJP = 1,13                                                       
+            IPRSM = 0                                                            
+            DO 2400 IGC = 1,NGC(14)                                              
+               SUMK = 0.                                                         
+               DO 2600 IPR = 1, NGN(NGS(13)+IGC)                                 
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+208)
+ 2600          CONTINUE                                                          
+               ABSA14(JTJT+(JPJP-1)*5,IGC) = SUMK
+ 2400       CONTINUE                                                             
+ 2200    CONTINUE                                                                
+ 2000 CONTINUE                                                                   
+                                                                                 
+      DO 3000 JTJT = 1,5                                                           
+         DO 3200 JPJP = 13,59                                                      
+            IPRSM = 0                                                            
+            DO 3400 IGC = 1,NGC(14)                                              
+               SUMK = 0.                                                         
+               DO 3600 IPR = 1, NGN(NGS(13)+IGC)                                 
+                  IPRSM = IPRSM + 1                                              
+                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+208)
+ 3600          CONTINUE                                                          
+               ABSB14(JTJT+(JPJP-13)*5,IGC) = SUMK
+ 3400       CONTINUE                                                             
+ 3200    CONTINUE                                                                
+ 3000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(14)                                                 
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(13)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+208)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      IPRSM = 0                                                                  
+      DO 7400 IGC = 1,NGC(14)                                                    
+         SUMF1= 0.                                                               
+         SUMF2= 0.                                                               
+         DO 7600 IPR = 1, NGN(NGS(13)+IGC)                                       
+            IPRSM = IPRSM + 1                                                    
+            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
+            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
+ 7600    CONTINUE                                                                
+         FRACREFAC(IGC) = SUMF1                                                  
+         FRACREFBC(IGC) = SUMF2                                                  
+ 7400 CONTINUE                                                                   
+                                                                                 
+            
+   END SUBROUTINE CMBGB14
+
+!***************************************************************************
+   SUBROUTINE CMBGB15(abscoefL, SELFREF, FRACREFA,                &
+                      SELFREFC, FRACREFAC                         )
+!***************************************************************************
+!                                                                                
+!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)                   
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(9,5,13,MG)                                                         
+      REAL SELFREF(10,MG)  
+      REAL FRACREFA(MG,9)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG15)
+      REAL FRACREFAC(NG15,9) 
+                                                                                 
+      DO 2000 JN = 1,9                                                           
+         DO 2000 JTJT = 1,5                                                        
+            DO 2200 JPJP = 1,13                                                    
+               IPRSM = 0                                                         
+               DO 2400 IGC = 1,NGC(15)                                           
+                  SUMK = 0.                                                      
+                  DO 2600 IPR = 1, NGN(NGS(14)+IGC)                              
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+224)
+ 2600             CONTINUE                                                       
+                  ABSA15(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK 
+ 2400          CONTINUE                                                          
+ 2200       CONTINUE                                                             
+ 2000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(15)                                                 
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(14)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+224)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 7000 JPJP = 1,9                                                           
+         IPRSM = 0                                                               
+         DO 7400 IGC = 1,NGC(15)                                                 
+            SUMF = 0.                                                            
+            DO 7600 IPR = 1, NGN(NGS(14)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
+ 7600       CONTINUE                                                             
+            FRACREFAC(IGC,JPJP) = SUMF                                             
+ 7400    CONTINUE                                                                
+ 7000 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB15
+
+!***************************************************************************
+   SUBROUTINE CMBGB16(abscoefL, SELFREF, FRACREFA,               &
+                      SELFREFC, FRACREFAC                        )
+!***************************************************************************     
+!                                                                                
+!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)                   
+!***************************************************************************     
+                                                                                 
+! Input                                                                          
+      REAL abscoefL(9,5,13,MG)                                                         
+      REAL SELFREF(10,MG)     
+      REAL FRACREFA(MG,9)
+!     REAL RWGT(MG*NBANDS) 
+! Output                                                                         
+      REAL SELFREFC(10,NG16)
+      REAL FRACREFAC(NG16,9)
+                                                                                 
+      DO 2000 JN = 1,9                                                           
+         DO 2000 JTJT = 1,5                                                        
+            DO 2200 JPJP = 1,13                                                    
+               IPRSM = 0                                                         
+               DO 2400 IGC = 1,NGC(16)                                           
+                  SUMK = 0.                                                      
+                  DO 2600 IPR = 1, NGN(NGS(15)+IGC)                              
+                     IPRSM = IPRSM + 1                                           
+                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+240)
+ 2600             CONTINUE                                                       
+                  ABSA16(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK
+ 2400          CONTINUE                                                          
+ 2200       CONTINUE                                                             
+ 2000 CONTINUE                                                                   
+                                                                                 
+      DO 4000 JTJT = 1,10                                                          
+         IPRSM = 0                                                               
+         DO 4400 IGC = 1,NGC(16)                                                 
+            SUMK = 0.                                                            
+            DO 4600 IPR = 1, NGN(NGS(15)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+240)
+ 4600       CONTINUE                                                             
+            SELFREFC(JTJT,IGC) = SUMK                                              
+ 4400    CONTINUE                                                                
+ 4000 CONTINUE                                                                   
+                                                                                 
+      DO 7000 JPJP = 1,9                                                           
+         IPRSM = 0                                                               
+         DO 7400 IGC = 1,NGC(16)                                                 
+            SUMF = 0.                                                            
+            DO 7600 IPR = 1, NGN(NGS(15)+IGC)                                    
+               IPRSM = IPRSM + 1                                                 
+               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
+ 7600       CONTINUE                                                             
+            FRACREFAC(IGC,JPJP) = SUMF                                             
+ 7400    CONTINUE                                                                
+ 7000 CONTINUE                                                                   
+                                                                                 
+   END SUBROUTINE CMBGB16
+ 
+!-------------------------------------------------------------------------
+   SUBROUTINE INIRAD (O3PROF,Pw, kts, kte)
+!-------------------------------------------------------------------------
+      IMPLICIT NONE
+!-------------------------------------------------------------------------
+   INTEGER, INTENT(IN   )                        ::    kts,kte
+
+   REAL, DIMENSION( kts:kte ),INTENT(INOUT)      ::    O3PROF
+
+   REAL, DIMENSION( kts:kte+1 ),INTENT(IN   )    ::        Pw
+
+! LOCAL VAR
+  
+   REAL, DIMENSION( kts:kte+1 ) :: PAVEL, TAVEL 
+   REAL, DIMENSION(   0:kte+1 ) :: PZ, TZ
+
+   INTEGER :: k
+
+
+!                                                                                
+!  COMPUTE OZONE MIXING RATIO DISTRIBUTION                                       
+!                                                                                
+   DO K=kts,kte
+      O3PROF(K)=0.                                                       
+   ENDDO
+                                                                                 
+   CALL O3DATA(O3PROF, Pw, kts, kte)
+!                                                                                
+   END SUBROUTINE INIRAD
+                                                                                 
+!-------------------------------------------------------------------------
+   SUBROUTINE O3DATA (O3PROF, Pw, kts, kte)
+!-------------------------------------------------------------------------
+   IMPLICIT NONE
+!-------------------------------------------------------------------------
+!
+   INTEGER, INTENT(IN   )   ::       kts, kte
+!
+   REAL, DIMENSION( kts:kte ),INTENT(INOUT)      ::    O3PROF
+
+   REAL, DIMENSION( kts:kte+1 ),INTENT(IN   )    ::        Pw
+
+! LOCAL VAR
+   INTEGER :: K, JJ, NK
+
+   REAL    ::  PRLEVH(kts:kte+1),PPWRKH(32),                       &
+               O3WRK(31),PPWRK(31),O3SUM(31),PPSUM(31),          &
+               O3WIN(31),PPWIN(31),O3ANN(31),PPANN(31)                                                       
+
+   REAL    ::  PB1, PB2, PT1, PT2
+
+   DATA O3SUM  /5.297E-8,5.852E-8,6.579E-8,7.505E-8,             &                    
+        8.577E-8,9.895E-8,1.175E-7,1.399E-7,1.677E-7,2.003E-7,   &                 
+        2.571E-7,3.325E-7,4.438E-7,6.255E-7,8.168E-7,1.036E-6,   &                 
+        1.366E-6,1.855E-6,2.514E-6,3.240E-6,4.033E-6,4.854E-6,   &                 
+        5.517E-6,6.089E-6,6.689E-6,1.106E-5,1.462E-5,1.321E-5,   &                 
+        9.856E-6,5.960E-6,5.960E-6/                                              
+
+   DATA PPSUM  /955.890,850.532,754.599,667.742,589.841,         &  
+        519.421,455.480,398.085,347.171,301.735,261.310,225.360, &               
+        193.419,165.490,141.032,120.125,102.689, 87.829, 75.123, &            
+         64.306, 55.086, 47.209, 40.535, 34.795, 29.865, 19.122, &               
+          9.277,  4.660,  2.421,  1.294,  0.647/                                 
+!                                                                                
+   DATA O3WIN  /4.629E-8,4.686E-8,5.017E-8,5.613E-8,             &
+        6.871E-8,8.751E-8,1.138E-7,1.516E-7,2.161E-7,3.264E-7,   &               
+        4.968E-7,7.338E-7,1.017E-6,1.308E-6,1.625E-6,2.011E-6,   &               
+        2.516E-6,3.130E-6,3.840E-6,4.703E-6,5.486E-6,6.289E-6,   &               
+        6.993E-6,7.494E-6,8.197E-6,9.632E-6,1.113E-5,1.146E-5,   &               
+        9.389E-6,6.135E-6,6.135E-6/                                              
+
+   DATA PPWIN  /955.747,841.783,740.199,649.538,568.404,         &
+        495.815,431.069,373.464,322.354,277.190,237.635,203.433, &               
+        174.070,148.949,127.408,108.915, 93.114, 79.551, 67.940, &               
+         58.072, 49.593, 42.318, 36.138, 30.907, 26.362, 16.423, &               
+          7.583,  3.620,  1.807,  0.938,  0.469/                                 
+!                                                                                
+
+   DO K=1,31                                                              
+     PPANN(K)=PPSUM(K)                                                        
+   ENDDO
+!
+   O3ANN(1)=0.5*(O3SUM(1)+O3WIN(1))                                           
+!                                                                                
+   DO K=2,31                                                              
+      O3ANN(K)=O3WIN(K-1)+(O3WIN(K)-O3WIN(K-1))/(PPWIN(K)-PPWIN(K-1))* & 
+               (PPSUM(K)-PPWIN(K-1))                                           
+   ENDDO
+!
+   DO K=2,31                                                              
+      O3ANN(K)=0.5*(O3ANN(K)+O3SUM(K))                                         
+   ENDDO
+!
+   DO K=1,31                                                                
+      O3WRK(K)=O3ANN(K)                                                        
+      PPWRK(K)=PPANN(K)                                                        
+   ENDDO
+!                                                                                
+!  CALCULATE HALF PRESSURE LEVELS FOR MODEL AND DATA LEVELS                     
+!                                                                                
+
+! Pw is total P at w level
+! Pw is in mb
+
+   DO K=kts,kte+1
+      NK=kte+1-K+1
+      PRLEVH(K)=Pw(NK)
+   ENDDO
+!                                                                                
+   PPWRKH(1)=1100.                                                        
+   DO K=2,31                                                           
+      PPWRKH(K)=(PPWRK(K)+PPWRK(K-1))/2.                                   
+   ENDDO
+   PPWRKH(32)=0.                                                          
+   DO K=kts,kte
+      DO 25 JJ=1,31                                                        
+         IF((-(PRLEVH(K)-PPWRKH(JJ))).GE.0.)THEN                            
+           PB1=0.                                                           
+         ELSE                                                               
+           PB1=PRLEVH(K)-PPWRKH(JJ)                                         
+         ENDIF                                                              
+         IF((-(PRLEVH(K)-PPWRKH(JJ+1))).GE.0.)THEN                          
+           PB2=0.                                                           
+         ELSE                                                               
+           PB2=PRLEVH(K)-PPWRKH(JJ+1)                                       
+         ENDIF                                                              
+         IF((-(PRLEVH(K+1)-PPWRKH(JJ))).GE.0.)THEN                          
+           PT1=0.                                                           
+         ELSE                                                               
+           PT1=PRLEVH(K+1)-PPWRKH(JJ)                                       
+         ENDIF                                                              
+         IF((-(PRLEVH(K+1)-PPWRKH(JJ+1))).GE.0.)THEN                        
+           PT2=0.                                                           
+         ELSE                                                               
+           PT2=PRLEVH(K+1)-PPWRKH(JJ+1)                                     
+         ENDIF                                                              
+         O3PROF(K)=O3PROF(K)+(PB2-PB1-PT2+PT1)*O3WRK(JJ)                
+  25  CONTINUE                                                             
+      O3PROF(K)=O3PROF(K)/(PRLEVH(K)-PRLEVH(K+1))                      
+
+   ENDDO
+!                                                                                
+   END SUBROUTINE O3DATA
+
+!---------------------------------------------------------------------------
+   SUBROUTINE MM5ATM(CLDFRA,O3PROF,T,Tw,TSFC,QV,QC,QR,QI,QS,QG,    &
+                     P,Pw,DELZ,EMISS,R,G,                          &
+                     PAVEL,TAVEL,PZ,TZ,CLDFRAC,TAUCLOUD,COLDRY,    &
+                     WKL,WX,TBOUND,SEMISS,                         &
+                     kts,kte                                       )
+!---------------------------------------------------------------------------
+!  RRTM Longwave Radiative Transfer Model                                        
+!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
+!                                                                                
+!  Revision for NCAR MM5:  J. Dudhia (converted from CCM code)                   
+!                                                                                
+!  Input atmospheric profile from NCAR MM5, and prepare it for use in RRTM.      
+!  Set other RRTM input parameters.  Values are passed back through existing     
+!  RRTM arrays and commons.                                                      
+!---------------------------------------------------------------------------
+! RRTM Definitions                                                               
+!    MXLAY = kte+1                ! Maximum number of model layers               
+!    MAXXSEC                      ! Maximum number of cross sections             
+!    NLAYERS                      ! Number of model layers (kte+1)               
+!    PAVEL(MXLAY)                 ! Layer pressures (mb)                         
+!    PZ(0:MXLAY)                  ! Level (interface) pressures (mb)             
+!    TAVEL(MXLAY)                 ! Layer temperatures (K)                       
+!    TZ(0:MXLAY)                  ! Level (interface) temperatures(mb)           
+!    TBOUND                       ! Surface temperature (K)                      
+!    COLDRY(MXLAY)                ! Dry air column (molecules/cm2)               
+!    WKL(35,MXLAY)                ! Molecular amounts (molecules/cm2)            
+!    WBRODL(MXLAY)                ! Inactive in this version                     
+!    WX(MAXXSEC)                  ! Cross-section amounts (molecules/cm2)        
+!    CLDFRAC(MXLAY)               ! Layer cloud fraction                         
+!    TAUCLOUD(MXLAY)              ! Layer cloud optical depth                    
+!    AMD                          ! Atomic weight of dry air                     
+!    AMW                          ! Atomic weight of water                       
+!    AMO                          ! Atomic weight of ozone                       
+!    AMCH4                        ! Atomic weight of methane                     
+!    AMN2O                        ! Atomic weight of nitrous oxide               
+!    AMC11                        ! Atomic weight of CFC-11                      
+!    AMC12                        ! Atomic weight of CFC-12                      
+!    NXMOL                        ! Number of cross-section molecules            
+!    IXINDX                       ! Cross-section molecule index (see below)     
+!    IXSECT                       ! On/off flag for cross-sections (inactive)    
+!    IXMAX                        ! Maximum number of cross-sections (inactive)  
+!                                                                                
+!-----------------------------------------------------------------------------
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+!----------------------------------------------------------------------------
+!     Activate cross section molecules:                                             
+!     NXMOL     - number of cross-sections input by user                         
+!     IXINDX(I) - index of cross-section molecule corresponding to Ith           
+!                 cross-section specified by user                                
+!                 = 0 -- not allowed in RRTM                                     
+!                 = 1 -- CCL4                                                    
+!                 = 2 -- CFC11                                                   
+!                 = 3 -- CFC12                                                   
+!                 = 4 -- CFC22                                                   
+!     DATA NXMOL  /2/                                                            
+!     DATA IXINDX /0,2,3,0,31*0/                                                 
+!                                                                                 
+!    CLOUD EMISSIVITIES (M^2/G)                                                  
+!    THESE ARE CONSISTENT WITH LWRAD (ABCW=0.5*(ABUP+ABDOWN))                    
+!----------------------------------------------------------------------------
+
+                                                                                 
+      INTEGER, INTENT(IN ) ::  kts, kte
+!
+      REAL, DIMENSION( 35,kts:kte+1 ),                    &
+            INTENT(INOUT)        ::                  WKL
+
+      REAL, DIMENSION( MAXXSEC,kts:kte+1 ),               &
+            INTENT(INOUT)        ::                   WX
+
+      REAL, INTENT(INOUT)        ::               TBOUND
+      REAL, DIMENSION(NBANDS), INTENT(INOUT) ::   SEMISS
+
+      REAL, DIMENSION( kts:kte+1 ), INTENT(IN   ) ::      &
+                                                      Tw, &
+                                                      Pw
+      REAL, DIMENSION( kts:kte ), INTENT(IN   ) ::        &
+                                                  CLDFRA, &
+                                                  O3PROF, &
+                                                    DELZ, &
+                                                       T, &
+                                                       P
+
+      REAL, DIMENSION( kts:kte ), INTENT(INOUT) ::        &
+                                                      QV
+
+      REAL, DIMENSION( kts:kte ), INTENT(IN   ) ::        &
+                                                      QC, &
+                                                      QR, &
+                                                      QI, &
+                                                      QS, &
+                                                      QG
+
+      REAL, DIMENSION( kts:kte+1 ), INTENT(INOUT) ::      &
+                                                   PAVEL, &
+                                                   TAVEL, &
+                                                 CLDFRAC, &    
+                                                TAUCLOUD, &
+                                                  COLDRY 
+
+      REAL, DIMENSION(   0:kte+1 ), INTENT(INOUT) ::      &
+                                                      PZ, &
+                                                      TZ
+
+      REAL, INTENT(IN   ) ::   R,G,EMISS,TSFC
+
+      REAL    :: GRAVIT
+ 
+!
+! LOCAL
+
+      REAL, DIMENSION( kts:kte ) ::                 CLDFRC, &
+                                                      PINT, &
+                                                      TINT, &
+                                                        O3, &
+                                                       N2O, &
+                                                       CH4, &
+                                                      CLWP, &
+                                                      CIWP, &
+                                                      PLWP, &
+                                                      PIWP
+                           
+      real :: amd       ! Effective molecular weight of dry air (g/mol)  
+      real :: amw       ! Molecular weight of water vapor (g/mol)        
+      real :: amo       ! Molecular weight of ozone (g/mol)              
+      real :: amch4     ! Molecular weight of methane (g/mol)            
+      real :: amn2o     ! Molecular weight of nitrous oxide (g/mol)      
+      real :: amc11     ! Molecular weight of CFC11 (g/mol) - CFCL3      
+      real :: amc12     ! Molecular weight of CFC12 (g/mol) - CF2CL2     
+      real :: avgdro    ! Avogadro's number (molecules/mole)             
+                                                                                 
+! Atomic weights for conversion from mass to volume mixing ratios                
+
+      data amd   /  28.9644   /                                                  
+      data amw   /  18.0154   /                                                  
+      data amo   /  47.9998   /                                                  
+      data amch4 /  16.0430   /                                                  
+      data amn2o /  44.0128   /                                                  
+      data amc11 / 137.3684   /                                                  
+      data amc12 / 120.9138   /                                                  
+      data avgdro/ 6.022E23   /                                                  
+                                                                                 
+!     Set molecular weight ratios                                                    
+
+      real :: amdw,  &  ! Molecular weight of dry air / water vapor      
+              amdc,  &  ! Molecular weight of dry air / methane          
+              amdn,  &  ! Molecular weight of dry air / nitrous oxide    
+              amdc1, &  ! Molecular weight of dry air / CFC11            
+              amdc2     ! Molecular weight of dry air / CFC12            
+
+      data amdw /  1.607758 /                                                    
+      data amdc /  1.805423 /                                                    
+      data amdn /  0.658090 /                                                    
+      data amdc1/  0.210852 /                                                    
+      data amdc2/  0.239546 /                                                    
+
+!     Put in CO2 volume mixing ratio here (330 ppmv)                                
+
+      real :: co2vmr
+      data co2vmr / 330.e-6 /                                                    
+                                                                                 
+      REAL :: ABCW,ABICE,ABRN,ABSN
+
+      DATA ABCW /0.144/                                                          
+      DATA ABICE /0.0735/                                                        
+      DATA ABRN /0.330E-3/                                                       
+      DATA ABSN /2.34E-3/                                                        
+
+      GRAVIT = G*100.
+
+!                                                                                
+!  MID-LAYER VALUES                                                              
+      DO K=kts,kte
+          RO=P(K)/(R*T(K))*100.                                                  
+          DZ=DELZ(K)
+          QV(K)=AMAX1(QV(K),1.E-12) 
+  
+          CLDFRC(K)=CLDFRA(K)                                                   
+                                                                                 
+!  PATHS IN G/M^2                                                                
+
+! QI=0 if no ice phase
+! QS=0 if no ice phase
+
+            CLWP(K)=RO*QC(K)*DZ*1000.                                            
+            CIWP(K)=RO*QI(K)*DZ*1000.                                            
+            PLWP(K)=(RO*QR(K))**0.75*DZ*1000.                                    
+            PIWP(K)=(RO*QS(K))**0.75*DZ*1000.                                   
+                                                                                 
+          O3(K)=O3PROF(K)                                                      
+          N2O(K)=0.                                                              
+          CH4(K)=0.                                                              
+                                                                                 
+      ENDDO                                                                      
+                                                                                 
+!  Initialize all molecular amounts to zero here, then pass MM5 amounts          
+!  into RRTM arrays WKL and WX below.                                            
+                                                                                 
+      DO 1000 ILAY = kts,kte+1
+         DO 1100 ISP = 1,35                                                      
+ 1100       WKL(ISP,ILAY) = 0.0                                                  
+         DO 1200 ISP = 1,MAXXSEC                                                 
+ 1200       WX(ISP,ILAY) = 0.0                                                   
+ 1000 CONTINUE                                                                   
+                                                                                 
+!  Set parameters needed for RRTM execution:                                     
+
+      IXSECT = 1                                                                 
+      IXMAX = 4                                                                  
+                                                                                 
+!  Set surface temperature.  The longwave upward surface flux is                 
+!  computed in the Land Surface Model based on the surface                       
+!  temperature and the emissivity of the surface type for each                   
+!  grid point.  The bottom interface temperature, tint(kte+1), is                 
+!  ground temperature consistent with this LW upward flux, and                   
+!  TBOUND is set to this temperature here.                                       
+                                                                                 
+!     TBOUND = TINT(kte+1)                                                        
+      TBOUND = Tw(kte+1)                                                        
+!     TBOUND = TSFC
+                                                                                 
+!  Install MM5 profiles into RRTM arrays for pressure, temperature,              
+!  and molecular amounts.  Pressures are converted from cb                       
+!  (CCM) to mb (RRTM).  H2O and trace gas amounts are converted from             
+!  mass mixing ratio to volume mixing ratio.  CO2 vmr is constant at all         
+!  levels.  The dry air column COLDRY (in molec/cm2) is calculated               
+!  from the level pressures PZ (in mb) based on the hydrostatic equation         
+!  and includes a correction to account for H2O in the layer.  The               
+!  molecular weight of moist air (amm) is calculated for each layer.             
+                                                                                 
+!  RRTM is executed for an additional layer (L=kte+1), which extends              
+!  from the model top (ptop) to 0 mb, to calculate the downward                  
+!  flux at the model top interface.  H2O, CO2, and O3 vmrs for this              
+!  extra layer are set to the values in the model's top layer, though            
+!  the O3 value is reduced by a fraction (0.6) based on the US Std Atm.          
+!  For GCMs with a model top near 0 mb, this extra layer is not needed, and      
+!  NLAYERS should be set to the number of model layers (kte in this case).       
+!  Note: RRTM levels count from bottom to top, while MM5 levels count            
+!  from the top down and must be reversed here.                                  
+                                                                                 
+!     NMOL = 6                                                                   
+!     PZ(0) = pint(kte+1)                                                         
+!     TZ(0) = tint(kte+1)                                                         
+
+      PZ(0) = Pw(kte+1)                                                         
+      TZ(0) = Tw(kte+1)                                                         
+      DO 2000 L = 1, NLAYERS-1                                                   
+         PAVEL(L) = p(kte+1-L)                                                   
+         TAVEL(L) = t(kte+1-L)                                                   
+!        PZ(L) = pint(kte+1-L)                                                    
+!        TZ(L) = tint(kte+1-L)                                                    
+         PZ(L) = Pw(kte+1-L)                                                    
+         TZ(L) = Tw(kte+1-L)                                                    
+         WKL(1,L) = qv(kte+1-L)*amdw                                             
+         WKL(2,L) = co2vmr                                                       
+         WKL(3,L) = o3(kte+1-L)                                                  
+         WKL(4,L) = n2o(kte+1-L)*amdn                                            
+         WKL(6,L) = ch4(kte+1-L)*amdc                                            
+         amm = (1-WKL(1,L))*amd + WKL(1,L)*amw                                   
+         COLDRY(L) = (PZ(L-1)-PZ(L))*1.E3*avgdro/    & 
+                               (gravit*amm*(1+WKL(1,L)))                         
+ 2000    CONTINUE                                                                
+                                                                                 
+!  Set cross section molecule amounts from CCM; convert to vmr                   
+      DO 2100 L=1, NLAYERS-1                                                     
+!        WX(2,L) = c11mmr(kte+1-L)*amdc1                                         
+!        WX(3,L) = c12mmr(kte+1-L)*amdc2                                         
+         WX(2,L) = 0.                                                            
+         WX(3,L) = 0.                                                            
+ 2100 CONTINUE                                                                   
+                                                                                 
+!  *****                                                                         
+!  Set up values for extra layer at top of the atmosphere.                       
+!  The top layer temperature for all gridpoints is set to the top layer-1        
+!  temperature plus a constant (0 K) that represents an isothermal layer         
+!  above ptop.  Top layer interface temperatures are                             
+!  linearly interpolated from the layer temperatures.                            
+!  Note: The top layer temperature and ozone amount are based on a 0-3mb         
+!  top layer and must be modified if the layering is changed.                    
+!  This section should be commented if the extra layer is not needed.            
+                                                                                 
+      PAVEL(NLAYERS) = 0.5*PZ(NLAYERS-1)                                         
+      TAVEL(NLAYERS) = TAVEL(NLAYERS-1) + 0.0                                    
+      PZ(NLAYERS) = 0.00                                                         
+      TZ(NLAYERS-1) = 0.5*(TAVEL(NLAYERS)+TAVEL(NLAYERS-1))                      
+      TZ(NLAYERS) = TZ(NLAYERS-1)+0.0                                            
+      WKL(1,NLAYERS) = WKL(1,NLAYERS-1)                                          
+      WKL(2,NLAYERS) = co2vmr                                                    
+      WKL(3,NLAYERS) = 0.6*WKL(3,NLAYERS-1)                                      
+      WKL(4,NLAYERS) = WKL(4,NLAYERS-1)                                          
+      WKL(6,NLAYERS) = WKL(6,NLAYERS-1)                                          
+      amm = (1-WKL(1,NLAYERS-1))*amd + WKL(1,NLAYERS-1)*amw                      
+!     COLDRY(NLAYERS) = (PZ(NLAYERS-1))*1.E3*avgdro/       & 
+      COLDRY(NLAYERS) = ((PZ(NLAYERS-1)-PZ(NLAYERS)))*1.E3*avgdro/       & 
+                               (gravit*amm*(1+WKL(1,NLAYERS-1)))                 
+      WX(2,NLAYERS) = WX(2,NLAYERS-1)                                            
+      WX(3,NLAYERS) = WX(3,NLAYERS-1)                                            
+!  *****                                                                         
+                                                                                 
+!  Here, all molecules in WKL and WX are in volume mixing ratio; convert to      
+!  molec/cm2 based on COLDRY for use in RRTM                                     
+                                                                                 
+      DO 5000 L = 1, NLAYERS                                                     
+         DO 4200 IMOL = 1, NMOL                                                  
+            WKL(IMOL,L) = COLDRY(L) * WKL(IMOL,L)                                
+ 4200    CONTINUE                                                                
+         DO 4400 IX = 1,MAXXSEC                                                  
+            IF (IXINDX(IX) .NE. 0) THEN                                          
+               WX(IXINDX(IX),L) = COLDRY(L) * WX(IX,L) * 1.E-20                  
+            ENDIF                                                                
+ 4400    CONTINUE                                                                
+ 5000 CONTINUE                                                                   
+                                                                                 
+!  Set spectral surface emissivity for each longwave band.  The default value    
+!  is set here to emiss(i,j) based on land-use (taken to be constant across band 
+!  Comment: if land-surface uses skin temperature, emissivity must match that    
+!   used in its calculation (e.g. 1.0)                                           
+      DO 5500 N=1,NBANDS                                                         
+         SEMISS(N) = EMISS
+ 5500 CONTINUE                                                                   
+                                                                                 
+!  Transfer cloud fraction to RRTM array; compute cloud optical depth, TAUCLOUD, 
+!  as the product of clwp and cloud mass absorption coefficient in MM5, which is 
+!  a  combination of liquid and ice absorption coefficients.                     
+!  Note: RRTM levels count from bottom to top, while CCM levels count from the   
+!  top down and must be reversed here.  Values for the extra RRTM level (above   
+!  the model top) are set to zero.                                               
+                                                                                 
+      DO 7000 L = 1, NLAYERS-1                                                   
+         TAUCLOUD(L) = ABCW*CLWP(kte+1-L)+ABICE*CIWP(kte+1-L) & 
+                      +ABRN*PLWP(kte+1-L)+ABSN*PIWP(kte+1-L)                       
+         IF(TAUCLOUD(L).GT.0.01)CLDFRC(kte+1-L)=1.                                
+         CLDFRAC(L) = cldfrc(kte+1-L)                                             
+ 7000 CONTINUE                                                                   
+      CLDFRAC(NLAYERS) = 0.0                                                     
+      TAUCLOUD(NLAYERS) = 0.0                                                    
+
+   END SUBROUTINE MM5ATM
+
+!---------------------------------------------------------------------------
+      SUBROUTINE SETCOEF(kts,ktep1,                                        &
+                         PAVEL,TAVEL,COLDRY,COLH2O,COLCO2,COLO3,           &
+                         COLN2O,COLCH4,COLO2,CO2MULT,                      &
+                         FAC00,FAC01,FAC10,FAC11,                          &
+                         FORFAC,SELFFAC,SELFFRAC,                          &
+                         JP,JT,JT1,INDSELF,WKL,LAYTROP,LAYSWTCH,LAYLOW     )
+!---------------------------------------------------------------------------
+      IMPLICIT NONE
+!---------------------------------------------------------------------------
+!  RRTM Longwave Radiative Transfer Model                                        
+!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
+!                                                                                
+!  Original version:       E. J. Mlawer, et al.                                  
+!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
+!                                                                                
+!  For a given atmosphere, calculate the indices and fractions related to the    
+!  pressure and temperature interpolations.  Also calculate the values of the    
+!  integrated Planck functions for each band at the level and layer              
+!  temperatures.                                                                 
+!---------------------------------------------------------------------------
+
+      INTEGER, INTENT(IN   ) ::          kts, ktep1
+
+      REAL, DIMENSION( 35,kts:ktep1),                    &
+            INTENT(IN   )        ::                  WKL
+
+      INTEGER, INTENT(INOUT) ::  LAYTROP,LAYSWTCH,LAYLOW
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::      &
+                                                   PAVEL, &
+                                                   TAVEL, &
+                                                  COLDRY
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(INOUT) ::      &
+                                                  COLH2O, &
+                                                  COLCO2, &
+                                                   COLO3, &
+                                                  COLN2O, &
+                                                  COLCH4, &
+                                                   COLO2, &
+                                                 CO2MULT, &
+                                                   FAC00, &
+                                                   FAC01, &
+                                                   FAC10, &
+                                                   FAC11, &
+                                                  FORFAC, &
+                                                 SELFFAC, &
+                                                SELFFRAC
+
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(INOUT) ::   &
+                                                      JP, &
+                                                      JT, &
+                                                     JT1, &
+                                                 INDSELF
+! LOCAL 
+     
+      INTEGER ::   LAY, JP1 
+      REAL    ::   STPFAC, PLOG, FP, FT, FT1, WATERS, WATER, &
+                   CALEFAC, FACTOR, CO2REG, COMPFP, SCALEFAC 
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      STPFAC = 296./1013.                                                        
+      
+      LAYTROP = 0                                                                
+      LAYSWTCH = 0                                                               
+      LAYLOW = 0                                                                 
+      DO 7000 LAY = 1, NLAYERS                                                   
+!        Find the two reference pressures on either side of the                  
+!        layer pressure.  Store them in JP and JP1.  Store in FP the             
+!        fraction of the difference (in ln(pressure)) between these              
+!        two values that the layer pressure lies.                                
+         PLOG = LOG(PAVEL(LAY))                                                  
+         JP(LAY) = INT(36. - 5*(PLOG+0.04))                                      
+         IF (JP(LAY) .LT. 1) THEN                                                
+            JP(LAY) = 1                                                          
+         ELSEIF (JP(LAY) .GT. 58) THEN                                           
+            JP(LAY) = 58                                                         
+         ENDIF                                                                   
+         JP1 = JP(LAY) + 1                                                       
+         FP = 5. * (PREFLOG(JP(LAY)) - PLOG)                                     
+                                                                                 
+!        Determine, for each reference pressure (JP and JP1), which              
+!        reference temperature (these are different for each                     
+!        reference pressure) is nearest the layer temperature but does           
+!        not exceed it.  Store these indices in JT and JT1, resp.                
+!        Store in FT (resp. FT1) the fraction of the way between JT              
+!        (JT1) and the next highest reference temperature that the               
+!        layer temperature falls.                                                
+         JT(LAY) = INT(3. + (TAVEL(LAY)-TREF(JP(LAY)))/15.)                      
+         IF (JT(LAY) .LT. 1) THEN                                                
+            JT(LAY) = 1                                                          
+         ELSEIF (JT(LAY) .GT. 4) THEN                                            
+            JT(LAY) = 4                                                          
+         ENDIF                                                                   
+         FT = ((TAVEL(LAY)-TREF(JP(LAY)))/15.) - FLOAT(JT(LAY)-3)                
+         JT1(LAY) = INT(3. + (TAVEL(LAY)-TREF(JP1))/15.)                         
+         IF (JT1(LAY) .LT. 1) THEN                                               
+            JT1(LAY) = 1                                                         
+         ELSEIF (JT1(LAY) .GT. 4) THEN                                           
+            JT1(LAY) = 4                                                         
+         ENDIF                                                                   
+         FT1 = ((TAVEL(LAY)-TREF(JP1))/15.) - FLOAT(JT1(LAY)-3)                  
+                                                                                 
+         WATER = WKL(1,LAY)/COLDRY(LAY)                                          
+         SCALEFAC = PAVEL(LAY) * STPFAC / TAVEL(LAY)                             
+                                                                                 
+!        If the pressure is less than ~100mb, perform a different                
+!        set of species interpolations.                                          
+         IF (PLOG .LE. 4.56) GO TO 5300                                          
+         LAYTROP =  LAYTROP + 1                                                  
+!        For one band, the "switch" occurs at ~300 mb.                           
+! JD: changed from (PLOG .GE. 5.76) to avoid out-of-range                        
+         IF (PLOG .Gt. 5.76) LAYSWTCH = LAYSWTCH + 1                             
+         IF (PLOG .GE. 6.62) LAYLOW = LAYLOW + 1                                 
+!                                                                                
+         FORFAC(LAY) = SCALEFAC / (1.+WATER)                                     
+!        Set up factors needed to separately include the water vapor             
+!        self-continuum in the calculation of absorption coefficient.            
+         SELFFAC(LAY) = WATER * FORFAC(LAY)                                      
+         FACTOR = (TAVEL(LAY)-188.0)/7.2                                         
+         INDSELF(LAY) = MIN(9, MAX(1, INT(FACTOR)-7))                            
+         SELFFRAC(LAY) = FACTOR - FLOAT(INDSELF(LAY) + 7)                        
+                                                                                 
+!        Calculate needed column amounts.                                        
+         COLH2O(LAY) = 1.E-20 * WKL(1,LAY)                                       
+         COLCO2(LAY) = 1.E-20 * WKL(2,LAY)                                       
+         COLO3(LAY) = 1.E-20 * WKL(3,LAY)                                        
+         COLN2O(LAY) = 1.E-20 * WKL(4,LAY)                                       
+         COLCH4(LAY) = 1.E-20 * WKL(6,LAY)                                       
+         COLO2(LAY) = 1.E-20 * WKL(7,LAY)                                        
+         IF (COLCO2(LAY) .EQ. 0.) COLCO2(LAY) = 1.E-32 * COLDRY(LAY)             
+         IF (COLN2O(LAY) .EQ. 0.) COLN2O(LAY) = 1.E-32 * COLDRY(LAY)             
+         IF (COLCH4(LAY) .EQ. 0.) COLCH4(LAY) = 1.E-32 * COLDRY(LAY)             
+!        Using E = 1334.2 cm-1.                                                  
+         CO2REG = 3.55E-24 * COLDRY(LAY)                                         
+         CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) *    & 
+              272.63*EXP(-1919.4/TAVEL(LAY))/(8.7604E-4*TAVEL(LAY))              
+         GO TO 5400                                                              
+                                                                                 
+!        Above LAYTROP.                                                          
+ 5300    CONTINUE                                                                
+                                                                                 
+         FORFAC(LAY) = SCALEFAC / (1.+WATER)                                     
+!        Calculate needed column amounts.                                        
+         COLH2O(LAY) = 1.E-20 * WKL(1,LAY)                                       
+         COLCO2(LAY) = 1.E-20 * WKL(2,LAY)                                       
+         COLO3(LAY) = 1.E-20 * WKL(3,LAY)                                        
+         COLN2O(LAY) = 1.E-20 * WKL(4,LAY)                                       
+         COLCH4(LAY) = 1.E-20 * WKL(6,LAY)                                       
+         COLO2(LAY) = 1.E-20 * WKL(7,LAY)                                        
+         IF (COLCO2(LAY) .EQ. 0.) COLCO2(LAY) = 1.E-32 * COLDRY(LAY)             
+         IF (COLN2O(LAY) .EQ. 0.) COLN2O(LAY) = 1.E-32 * COLDRY(LAY)             
+         IF (COLCH4(LAY) .EQ. 0.) COLCH4(LAY) = 1.E-32 * COLDRY(LAY)             
+         CO2REG = 3.55E-24 * COLDRY(LAY)                                         
+         CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) *   & 
+              272.63*EXP(-1919.4/TAVEL(LAY))/(8.7604E-4*TAVEL(LAY))              
+ 5400    CONTINUE                                                                
+                                                                                 
+!        We have now isolated the layer ln pressure and temperature,             
+!        between two reference pressures and two reference temperatures          
+!        (for each reference pressure).  We multiply the pressure                
+!        fraction FP with the appropriate temperature fractions to get           
+!        the factors that will be needed for the interpolation that yields       
+!        the optical depths (performed in routines TAUGBn for band n).           
+                                                                                 
+         COMPFP = 1. - FP                                                        
+         FAC10(LAY) = COMPFP * FT                                                
+         FAC00(LAY) = COMPFP * (1. - FT)                                         
+         FAC11(LAY) = FP * FT1                                                   
+         FAC01(LAY) = FP * (1. - FT1)                                            
+                                                                                 
+ 7000 CONTINUE                                                                   
+                                                                                 
+!        Set LAYLOW for profiles with surface pressure less than 750mb.          
+         IF (LAYLOW.EQ.0) LAYLOW=1                                               
+!        Sometimes round-off gives wrong LAYSWTCH therefore check here (JD)
+         IF (JP(LAYSWTCH+1).LE.6) THEN
+           LAYSWTCH=LAYSWTCH+1
+         ENDIF
+
+   END SUBROUTINE SETCOEF
+
+!-------------------------------------------------------------------------------
+!*                                                                             * 
+!*                  Optical depths developed for the                           * 
+!*                                                                             * 
+!*                RAPID RADIATIVE TRANSFER MODEL (RRTM)                        * 
+!*                                                                             * 
+!*                                                                             * 
+!*            ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC.                     * 
+!*                        840 MEMORIAL DRIVE                                   * 
+!*                        CAMBRIDGE, MA 02139                                  * 
+!*                                                                             * 
+!*                                                                             * 
+!*                           ELI J. MLAWER                                     * 
+!*                         STEVEN J. TAUBMAN                                   * 
+!*                         SHEPARD A. CLOUGH                                   * 
+!*                                                                             * 
+!*                                                                             * 
+!*                                                                             * 
+!*                                                                             * 
+!*                       email:  mlawer@aer.com                                * 
+!*                                                                             * 
+!*        The authors wish to acknowledge the contributions of the             * 
+!*        following people:  Patrick D. Brown, Michael J. Iacono,              * 
+!*        Ronald E. Farren, Luke Chen, Robert Bergstrom.                       * 
+!*                                                                             * 
+!-------------------------------------------------------------------------------
+!*                                                                             * 
+!*  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                 * 
+!*                                                                             * 
+!*     TAUMOL                                                                  * 
+!*                                                                             * 
+!*     This file contains the subroutines TAUGBn (where n goes from            * 
+!*     1 to 16).  TAUGBn calculates the optical depths and Planck fractions    * 
+!*     per g-value and layer for band n.                                       * 
+!*                                                                             * 
+!*  Output:  optical depths (unitless)                                         * 
+!*           fractions needed to compute Planck functions at every layer       * 
+!*               and g-value                                                   * 
+!*                                                                             * 
+!*     COMMON /TAUGCOM/  TAUG(MXLAY,MG)                                        * 
+!*     COMMON /PLANKG/   FRACS(MXLAY,MG)                                       * 
+!*                                                                             * 
+!*  Input                                                                      * 
+!*                                                                             * 
+!*     COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS)                  * 
+!*     COMMON /PRECISE/  ONEMINUS                                              * 
+!*     COMMON /PROFILE/  NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY),                    * 
+!*    &                  PZ(0:MXLAY),TZ(0:MXLAY)                               * 
+!*     COMMON /PROFDATA/ LAYTROP,LAYSWTCH,LAYLOW,                              * 
+!*    &                  COLH2O(MXLAY),COLCO2(MXLAY),                          * 
+!*    &                  COLO3(MXLAY),COLN2O(MXLAY),COLCH4(MXLAY),             * 
+!*    &                  COLO2(MXLAY),CO2MULT(MXLAY)                           * 
+!*     COMMON /INTFAC/   FAC00(MXLAY),FAC01(MXLAY),                            * 
+!*    &                  FAC10(MXLAY),FAC11(MXLAY)                             * 
+!*     COMMON /INTIND/   JP(MXLAY),JT(MXLAY),JT1(MXLAY)                        * 
+!*     COMMON /SELF/     SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY)       * 
+!*                                                                             * 
+!*     Description:                                                            * 
+!*     NG(IBAND) - number of g-values in band IBAND                            * 
+!*     NSPA(IBAND) - for the lower atmosphere, the number of reference         * 
+!*                   atmospheres that are stored for band IBAND per            * 
+!*                   pressure level and temperature.  Each of these            * 
+!*                   atmospheres has different relative amounts of the         * 
+!*                   key species for the band (i.e. different binary           * 
+!*                   species parameters).                                      * 
+!*     NSPB(IBAND) - same for upper atmosphere                                 * 
+!*     ONEMINUS - since problems are caused in some cases by interpolation     * 
+!*                parameters equal to or greater than 1, for these cases       * 
+!*                these parameters are set to this value, slightly < 1.        * 
+!*     PAVEL - layer pressures (mb)                                            * 
+!*     TAVEL - layer temperatures (degrees K)                                  * 
+!*     PZ - level pressures (mb)                                               * 
+!*     TZ - level temperatures (degrees K)                                     * 
+!*     LAYTROP - layer at which switch is made from one combination of         * 
+!*               key species to another                                        * 
+!*     COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water         * 
+!*               vapor,carbon dioxide, ozone, nitrous ozide, methane,          * 
+!*               respectively (molecules/cm**2)                                * 
+!*     CO2MULT - for bands in which carbon dioxide is implemented as a         * 
+!*               trace species, this is the factor used to multiply the        * 
+!*               band's average CO2 absorption coefficient to get the added    * 
+!*               contribution to the optical depth relative to 355 ppm.        * 
+!*     FACij(LAY) - for layer LAY, these are factors that are needed to        * 
+!*                  compute the interpolation factors that multiply the        * 
+!*                  appropriate reference k-values.  A value of 0 (1) for      * 
+!*                  i,j indicates that the corresponding factor multiplies     * 
+!*                  reference k-value for the lower (higher) of the two        * 
+!*                  appropriate temperatures, and altitudes, respectively.     * 
+!*     JP - the index of the lower (in altitude) of the two appropriate        * 
+!*          reference pressure levels needed for interpolation                 * 
+!*     JT, JT1 - the indices of the lower of the two appropriate reference     * 
+!*               temperatures needed for interpolation (for pressure           * 
+!*               levels JP and JP+1, respectively)                             * 
+!*     SELFFAC - scale factor needed to water vapor self-continuum, equals     * 
+!*               (water vapor density)/(atmospheric density at 296K and        * 
+!*               1013 mb)                                                      * 
+!*     SELFFRAC - factor needed for temperature interpolation of reference     * 
+!*                water vapor self-continuum data                              * 
+!*     INDSELF - index of the lower of the two appropriate reference           * 
+!*               temperatures needed for the self-continuum interpolation      * 
+!*                                                                             * 
+!*  Data input                                                                 * 
+!*     COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG) * 
+!*        (note:  n is the band number)                                        * 
+!*                                                                             * 
+!*     Description:                                                            * 
+!*     KA - k-values for low reference atmospheres (no water vapor             * 
+!*          self-continuum) (units: cm**2/molecule)                            * 
+!*     KB - k-values for high reference atmospheres (all sources)              * 
+!*          (units: cm**2/molecule)                                            * 
+!*     SELFREF - k-values for water vapor self-continuum for reference         * 
+!*               atmospheres (used below LAYTROP)                              * 
+!*               (units: cm**2/molecule)                                       * 
+!*                                                                             * 
+!*     DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG)                     * 
+!*     EQUIVALENCE (KA,ABSA),(KB,ABSB)                                         * 
+!*                                                                             * 
+!******************************************************************************* 
+                                                                                 
+!---------------------------------------------------------------------------    
+      SUBROUTINE TAUGB1(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,          &
+                        FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,         &
+                        PFRAC,TAUG,LAYTROP                                 )
+!---------------------------------------------------------------------------    
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                    FORFAC, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.            
+!     Revised by Michael J. Iacono, Atmospheric & Environmental Research.        
+                                                                                 
+!     BAND 1:  10-250 cm-1 (low - H2O; high - H2O)                               
+                                                                                 
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure) and             
+!     temperature.  Below LAYTROP, the water vapor self-continuum                
+!     is interpolated (in temperature) separately.                               
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(1) + 1                          
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(1) + 1                             
+         INDS = INDSELF(LAY)                                                     
+         DO 2000 IG = 1, NG1                                                     
+            TAUG(IG,LAY) = COLH2O(LAY) *                       & 
+                (FAC00(LAY) * ABSA1(IND0,IG) +                  &                 
+                 FAC10(LAY) * ABSA1(IND0+1,IG) +                &                 
+                 FAC01(LAY) * ABSA1(IND1,IG) +                  &                 
+                 FAC11(LAY) * ABSA1(IND1+1,IG) +                &                 
+                 SELFFAC(LAY) * (SELFREFC1(INDS,IG) +            &                 
+                 SELFFRAC(LAY) *                               &                 
+                 (SELFREFC1(INDS+1,IG) - SELFREFC1(INDS,IG))) +    &                 
+                 FORFAC(LAY) * FORREFC1(IG))                                       
+            PFRAC(IG,LAY) = FRACREFAC1(IG)                                         
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(1) + 1                         
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(1) + 1                        
+         DO 3000 IG = 1, NG1                                                     
+            TAUG(IG,LAY) = COLH2O(LAY) *                      &
+                (FAC00(LAY) * ABSB1(IND0,IG) +                 &                  
+                 FAC10(LAY) * ABSB1(IND0+1,IG) +               &                  
+                 FAC01(LAY) * ABSB1(IND1,IG) +                 &                  
+                 FAC11(LAY) * ABSB1(IND1+1,IG) +               &                  
+                 FORFAC(LAY) * FORREFC1(IG))                                       
+            PFRAC(IG,LAY) = FRACREFBC1(IG)                                         
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+     
+      END SUBROUTINE TAUGB1                        
+                                                                                 
+!----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB2(kts,ktep1,COLDRY,COLH2O,FAC00,FAC01,FAC10,FAC11,    &
+                        FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,          &
+                        PFRAC,TAUG,LAYTROP                                  )
+!----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)                              
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, PARAMETER :: NGS1=8                                       
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLDRY, &   
+                                                    COLH2O, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                    FORFAC, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      DIMENSION FC00(kts:ktep1),FC01(kts:ktep1),FC10(kts:ktep1),FC11(kts:ktep1)                  
+      DIMENSION REFPARAM(13)                                                     
+                                                                                 
+!     These are the mixing ratios for H2O for a MLS atmosphere at the            
+!     13 RRTM reference pressure levels:  1.8759999E-02, 1.2223309E-02,          
+!     5.8908667E-03, 2.7675382E-03, 1.4065107E-03, 7.5969833E-04,                
+!     3.8875898E-04, 1.6542293E-04, 3.7189537E-05, 7.4764857E-06,                
+!     4.3081886E-06, 3.3319423E-06, 3.2039343E-06/                               
+                                                                                 
+!     The following are parameters related to the reference water vapor          
+!     mixing ratios by REFPARAM(I) = REFH2O(I) / (.002+REFH2O(I)).               
+!     These parameters are used for the Planck function interpolation.           
+      DATA REFPARAM/  &                                                          
+        0.903661, 0.859386, 0.746542, 0.580496, 0.412889, 0.275283, & 
+        0.162745, 7.63929E-02, 1.82553E-02, 3.72432E-03,            &            
+        2.14946E-03, 1.66320E-03, 1.59940E-03/                                   
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure) and             
+!     temperature.  Below LAYTROP, the water vapor self-continuum is             
+!     interpolated (in temperature) separately.                                  
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         WATER = 1.E20 * COLH2O(LAY) / COLDRY(LAY)                               
+         H2OPARAM = WATER/(WATER +.002)                                          
+         DO 1800 IFRAC = 2, 12                                                   
+            IF (H2OPARAM .GE. REFPARAM(IFRAC)) GO TO 1900                        
+ 1800    CONTINUE                                                                
+ 1900    CONTINUE                                                                
+         FRACINT = (H2OPARAM-REFPARAM(IFRAC))/    & 
+              (REFPARAM(IFRAC-1)-REFPARAM(IFRAC))                                
+                                                                                 
+         FP = FAC11(LAY) + FAC01(LAY)                                            
+         IFP = 2.E2*FP+0.5                                                       
+         IF (IFP.LE.0) IFP = 0                                                   
+         FC00(LAY) = FAC00(LAY) * CORR2(IFP)                                     
+         FC10(LAY) = FAC10(LAY) * CORR2(IFP)                                     
+         FC01(LAY) = FAC01(LAY) * CORR1(IFP)                                     
+         FC11(LAY) = FAC11(LAY) * CORR1(IFP)                                     
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(2) + 1                          
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(2) + 1                             
+         INDS = INDSELF(LAY)                                                     
+         DO 2000 IG = 1, NG2                                                     
+            TAUG(NGS1+IG,LAY) = COLH2O(LAY) *                   &                
+                (FC00(LAY) * ABSA2(IND0,IG) +                    &                
+                 FC10(LAY) * ABSA2(IND0+1,IG) +                  &                
+                 FC01(LAY) * ABSA2(IND1,IG) +                    &                
+                 FC11(LAY) * ABSA2(IND1+1,IG) +                  &                
+                 SELFFAC(LAY) * (SELFREFC2(INDS,IG) +             &                
+                 SELFFRAC(LAY) *                                &                
+                 (SELFREFC2(INDS+1,IG) - SELFREFC2(INDS,IG))) +     &                
+                 FORFAC(LAY) * FORREFC2(IG))                                       
+            PFRAC(NGS1+IG,LAY) = FRACREFAC2(IG,IFRAC) + FRACINT * &
+                 (FRACREFAC2(IG,IFRAC-1)-FRACREFAC2(IG,IFRAC))                       
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         FP = FAC11(LAY) + FAC01(LAY)                                            
+         IFP = 2.E2*FP+0.5                                                       
+         IF (IFP.LE.0) IFP = 0                                                   
+         FC00(LAY) = FAC00(LAY) * CORR2(IFP)                                     
+         FC10(LAY) = FAC10(LAY) * CORR2(IFP)                                     
+         FC01(LAY) = FAC01(LAY) * CORR1(IFP)                                     
+         FC11(LAY) = FAC11(LAY) * CORR1(IFP)                                     
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(2) + 1                         
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(2) + 1                        
+         DO 3000 IG = 1, NG2                                                     
+            TAUG(NGS1+IG,LAY) = COLH2O(LAY) *                  & 
+                (FC00(LAY) * ABSB2(IND0,IG) +                   &                  
+                 FC10(LAY) * ABSB2(IND0+1,IG) +                 &                  
+                 FC01(LAY) * ABSB2(IND1,IG) +                   &                  
+                 FC11(LAY) * ABSB2(IND1+1,IG) +                 &                  
+                 FORFAC(LAY) * FORREFC2(IG))                                       
+            PFRAC(NGS1+IG,LAY) = FRACREFBC2(IG)                                    
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB2
+                                                                                 
+!-----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB3(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,    &
+                        FAC11,FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,     &
+                        PFRAC,TAUG,LAYTROP                                   )
+!-----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)                      
+                                                                                 
+      INTEGER, PARAMETER :: NGS2=22                                      
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                    COLCO2, &
+                                                    COLN2O, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                    FORFAC, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      DIMENSION H2OREF(59),CO2REF(59), ETAREF(10)                                
+      REAL N2OMULT,N2OREF(59)                                              
+                                                                                 
+      DATA ETAREF/  &                                                             
+           0.,0.125,0.25,0.375,0.5,0.625,0.75,0.875,0.9875,1.0/                  
+      DATA H2OREF/  &                                                             
+           1.87599E-02,1.22233E-02,5.89086E-03,2.76753E-03,1.40651E-03, &
+           7.59698E-04,3.88758E-04,1.65422E-04,3.71895E-05,7.47648E-06, &        
+           4.30818E-06,3.33194E-06,3.20393E-06,3.16186E-06,3.25235E-06, &        
+           3.42258E-06,3.62884E-06,3.91482E-06,4.14875E-06,4.30810E-06, &        
+           4.44204E-06,4.57783E-06,4.70865E-06,4.79432E-06,4.86971E-06, &        
+           4.92603E-06,4.96688E-06,4.99628E-06,5.05266E-06,5.12658E-06, &        
+           5.25028E-06,5.35708E-06,5.45085E-06,5.48304E-06,5.50000E-06, &        
+           5.50000E-06,5.45359E-06,5.40468E-06,5.35576E-06,5.25327E-06, &        
+           5.14362E-06,5.03396E-06,4.87662E-06,4.69787E-06,4.51911E-06, &        
+           4.33600E-06,4.14416E-06,3.95232E-06,3.76048E-06,3.57217E-06, &        
+           3.38549E-06,3.19881E-06,3.01212E-06,2.82621E-06,2.64068E-06, &        
+           2.45515E-06,2.26962E-06,2.08659E-06,1.93029E-06/                      
+      DATA N2OREF/  & 
+           3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07, &
+           3.19652E-07,3.15324E-07,3.03830E-07,2.94221E-07,2.84953E-07, &        
+           2.76714E-07,2.64709E-07,2.42847E-07,2.09547E-07,1.71945E-07, &        
+           1.37491E-07,1.13319E-07,1.00354E-07,9.12812E-08,8.54633E-08, &        
+           8.03631E-08,7.33718E-08,6.59754E-08,5.60386E-08,4.70901E-08, &        
+           3.99774E-08,3.29786E-08,2.60642E-08,2.10663E-08,1.65918E-08, &        
+           1.30167E-08,1.00900E-08,7.62490E-09,6.11592E-09,4.66725E-09, &        
+           3.28574E-09,2.84838E-09,2.46198E-09,2.07557E-09,1.85507E-09, &        
+           1.65675E-09,1.45843E-09,1.31948E-09,1.20716E-09,1.09485E-09, &        
+           9.97803E-10,9.31260E-10,8.64721E-10,7.98181E-10,7.51380E-10, &        
+           7.13670E-10,6.75960E-10,6.38250E-10,6.09811E-10,5.85998E-10, &        
+           5.62185E-10,5.38371E-10,5.15183E-10,4.98660E-10/                      
+      DATA CO2REF/ &                                                             
+           53*3.55E-04, 3.5470873E-04, 3.5427220E-04, 3.5383567E-04,    &
+           3.5339911E-04, 3.5282588E-04, 3.5079606E-04/                          
+                        
+      STRRAT = 1.19268                                                           
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure),                
+!     temperature, and appropriate species.  Below LAYTROP, the water            
+!     vapor self-continuum is interpolated (in temperature) separately.          
+
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         SPECCOMB = COLH2O(LAY) + STRRAT*COLCO2(LAY)                             
+         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 8.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         IF (JS .EQ. 8) THEN                                                     
+            IF (FS .GE. 0.9) THEN                                                
+               JS = 9                                                            
+               FS = 10. * (FS - 0.9)                                             
+            ELSE                                                                 
+               FS = FS/0.9                                                       
+            ENDIF                                                                
+         ENDIF                                                                   
+         NS = JS + INT(FS + 0.5)                                                 
+         FP = FAC01(LAY) + FAC11(LAY)                                            
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(3) + JS                         
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(3) + JS                            
+         INDS = INDSELF(LAY)                                                     
+         COLREF1 = N2OREF(JP(LAY))                                               
+         COLREF2 = N2OREF(JP(LAY)+1)                                             
+         IF (NS .EQ. 10) THEN                                                    
+            WCOMB1 = H2OREF(JP(LAY))                                             
+            WCOMB2 = H2OREF(JP(LAY)+1)                                           
+         ELSE                                                                    
+            WCOMB1 = STRRAT * CO2REF(JP(LAY))/(1.-ETAREF(NS))                    
+            WCOMB2 = STRRAT * CO2REF(JP(LAY)+1)/(1.-ETAREF(NS))                  
+         ENDIF                                                                   
+         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
+         CURRN2O = SPECCOMB * RATIO                                              
+         N2OMULT = COLN2O(LAY) - CURRN2O                                         
+!!DIR$ VECTOR                                                                     
+         DO 2000 IG = 1, NG3                                                     
+            TAUG(NGS2+IG,LAY) = SPECCOMB *                     & 
+                (FAC000 * ABSA3(IND0,IG) +                      &                 
+                 FAC100 * ABSA3(IND0+1,IG) +                    &                 
+                 FAC010 * ABSA3(IND0+10,IG) +                   &                 
+                 FAC110 * ABSA3(IND0+11,IG) +                   &                 
+                 FAC001 * ABSA3(IND1,IG) +                      &                 
+                 FAC101 * ABSA3(IND1+1,IG) +                    &                 
+                 FAC011 * ABSA3(IND1+10,IG) +                   &                 
+                 FAC111 * ABSA3(IND1+11,IG)) +                  &                 
+                 COLH2O(LAY) *                                 &                 
+                 (SELFFAC(LAY) * (SELFREFC3(INDS,IG) +           &                 
+                 SELFFRAC(LAY) *                               &                 
+                 (SELFREFC3(INDS+1,IG) - SELFREFC3(INDS,IG))) +    &                 
+                 FORFAC(LAY) * FORREFC3(IG))                     &                 
+                 + N2OMULT * ABSN2OAC3(IG)                                         
+            PFRAC(NGS2+IG,LAY) = FRACREFAC3(IG,JS) + FS *        & 
+                 (FRACREFAC3(IG,JS+1) - FRACREFAC3(IG,JS))                           
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!!DIR$ NOVECTOR                                                                   
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         SPECCOMB = COLH2O(LAY) + STRRAT*COLCO2(LAY)                             
+         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 4.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         NS = JS + INT(FS + 0.5)                                                 
+         FP = FAC01(LAY) + FAC11(LAY)                                            
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(3) + JS                        
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(3) + JS                       
+         COLREF1 = N2OREF(JP(LAY))                                               
+         COLREF2 = N2OREF(JP(LAY)+1)                                             
+         IF (NS .EQ. 5) THEN                                                     
+            WCOMB1 = H2OREF(JP(LAY))                                             
+            WCOMB2 = H2OREF(JP(LAY)+1)                                           
+         ELSE                                                                    
+            WCOMB1 = STRRAT * CO2REF(JP(LAY))/(1.-ETAREF(NS))                    
+            WCOMB2 = STRRAT * CO2REF(JP(LAY)+1)/(1.-ETAREF(NS))                  
+         ENDIF                                                                   
+         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
+         CURRN2O = SPECCOMB * RATIO                                              
+         N2OMULT = COLN2O(LAY) - CURRN2O                                         
+!!DIR$ VECTOR                                                                     
+         DO 3000 IG = 1, NG3                                                     
+            TAUG(NGS2+IG,LAY) = SPECCOMB *                 &
+                (FAC000 * ABSB3(IND0,IG) +                  &                     
+                 FAC100 * ABSB3(IND0+1,IG) +                &                     
+                 FAC010 * ABSB3(IND0+5,IG) +                &                     
+                 FAC110 * ABSB3(IND0+6,IG) +                &                     
+                 FAC001 * ABSB3(IND1,IG) +                  &                     
+                 FAC101 * ABSB3(IND1+1,IG) +                &                     
+                 FAC011 * ABSB3(IND1+5,IG) +                &                     
+                 FAC111 * ABSB3(IND1+6,IG)) +               &                     
+                 COLH2O(LAY) * FORFAC(LAY) * FORREFC3(IG)    &                     
+                 + N2OMULT * ABSN2OBC3(IG)                                         
+            PFRAC(NGS2+IG,LAY) = FRACREFBC3(IG,JS) + FS *    & 
+                 (FRACREFBC3(IG,JS+1) - FRACREFBC3(IG,JS))                           
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB3
+                                                                                 
+!----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB4(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,    &
+                        FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,           &
+                        PFRAC,TAUG,LAYTROP                                  )
+!----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 4:  630-700 cm-1 (low - H2O,CO2; high - O3,CO2)                       
+                                                                                 
+      INTEGER, PARAMETER :: NGS3=38                                      
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                    COLCO2, &
+                                                     COLO3, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      STRRAT1 = 850.577                                                          
+      STRRAT2 = 35.7416                                                          
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure),                
+!     temperature, and appropriate species.  Below LAYTROP, the water            
+!     vapor self-continuum is interpolated (in temperature) separately.          
+!!DIR$ NOVECTOR                                                                   
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         SPECCOMB = COLH2O(LAY) + STRRAT1*COLCO2(LAY)                            
+         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 8.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(4) + JS                         
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(4) + JS                            
+         INDS = INDSELF(LAY)                                                     
+!!DIR$ VECTOR                                                                     
+         DO 2000 IG = 1, NG4                                                     
+            TAUG(NGS3+IG,LAY) = SPECCOMB *                    &
+                (FAC000 * ABSA4(IND0,IG) +                     &                  
+                 FAC100 * ABSA4(IND0+1,IG) +                   &                  
+                 FAC010 * ABSA4(IND0+9,IG) +                   &                  
+                 FAC110 * ABSA4(IND0+10,IG) +                  &                  
+                 FAC001 * ABSA4(IND1,IG) +                     &                  
+                 FAC101 * ABSA4(IND1+1,IG) +                   &                  
+                 FAC011 * ABSA4(IND1+9,IG) +                   &                  
+                 FAC111 * ABSA4(IND1+10,IG)) +                 &                  
+                 COLH2O(LAY) *                                &                  
+                 SELFFAC(LAY) * (SELFREFC4(INDS,IG) +           &                  
+                 SELFFRAC(LAY) *                              &                  
+                 (SELFREFC4(INDS+1,IG) - SELFREFC4(INDS,IG)))                        
+            PFRAC(NGS3+IG,LAY) = FRACREFAC4(IG,JS) + FS *       &                  
+                 (FRACREFAC4(IG,JS+1) - FRACREFAC4(IG,JS))                           
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!!DIR$ NOVECTOR                                                                   
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         SPECCOMB = COLO3(LAY) + STRRAT2*COLCO2(LAY)                             
+         SPECPARM = COLO3(LAY)/SPECCOMB                                          
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 4.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         IF (JS .GT. 1) THEN                                                     
+            JS = JS + 1                                                          
+         ELSEIF (FS .GE. 0.0024) THEN                                            
+            JS = 2                                                               
+            FS = (FS - 0.0024)/0.9976                                            
+         ELSE                                                                    
+            JS = 1                                                               
+            FS = FS/0.0024                                                       
+         ENDIF                                                                   
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(4) + JS                        
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(4) + JS                       
+!!DIR$ VECTOR                                                                     
+         DO 3000 IG = 1, NG4                                                     
+            TAUG(NGS3+IG,LAY) = SPECCOMB *              &                        
+                (FAC000 * ABSB4(IND0,IG) +               &                        
+                 FAC100 * ABSB4(IND0+1,IG) +             &                        
+                 FAC010 * ABSB4(IND0+6,IG) +             &                        
+                 FAC110 * ABSB4(IND0+7,IG) +             &                        
+                 FAC001 * ABSB4(IND1,IG) +               &                        
+                 FAC101 * ABSB4(IND1+1,IG) +             &                        
+                 FAC011 * ABSB4(IND1+6,IG) +             &                        
+                 FAC111 * ABSB4(IND1+7,IG))                                       
+            PFRAC(NGS3+IG,LAY) = FRACREFBC4(IG,JS) + FS * &
+                 (FRACREFBC4(IG,JS+1) - FRACREFBC4(IG,JS))                           
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB4
+                                                                                 
+!----------------------------------------------------------------------------   
+      SUBROUTINE TAUGB5(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,    &
+                        FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,        &
+                        PFRAC,TAUG,LAYTROP                                  )
+!----------------------------------------------------------------------------   
+                                                                                 
+!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)                       
+                                                                                 
+      INTEGER, PARAMETER :: NGS4=52                                      
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( MAXXSEC,kts:ktep1 ),                 &
+            INTENT(IN   )        ::                     WX
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                    COLCO2, &
+                                                     COLO3, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      STRRAT1 = 90.4894                                                          
+      STRRAT2 = 0.900502                                                         
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure),                
+!     temperature, and appropriate species.  Below LAYTROP, the water            
+!     vapor self-continuum is interpolated (in temperature) separately.          
+!!DIR$ NOVECTOR                                                                   
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         SPECCOMB = COLH2O(LAY) + STRRAT1*COLCO2(LAY)                            
+         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 8.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(5) + JS                         
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(5) + JS                            
+         INDS = INDSELF(LAY)                                                     
+!!DIR$ VECTOR                                                                     
+         DO 2000 IG = 1, NG5                                                     
+            TAUG(NGS4+IG,LAY) = SPECCOMB *                    &
+                (FAC000 * ABSA5(IND0,IG) +                     &                  
+                 FAC100 * ABSA5(IND0+1,IG) +                   &                  
+                 FAC010 * ABSA5(IND0+9,IG) +                   &                  
+                 FAC110 * ABSA5(IND0+10,IG) +                  &                  
+                 FAC001 * ABSA5(IND1,IG) +                     &                  
+                 FAC101 * ABSA5(IND1+1,IG) +                   &                  
+                 FAC011 * ABSA5(IND1+9,IG) +                   &                  
+                 FAC111 * ABSA5(IND1+10,IG)) +                 &                  
+                 COLH2O(LAY) *                                &                  
+                 SELFFAC(LAY) * (SELFREFC5(INDS,IG) +           &                  
+                 SELFFRAC(LAY) *                              &                  
+                 (SELFREFC5(INDS+1,IG) - SELFREFC5(INDS,IG)))     &                  
+                 + WX(1,LAY) * CCL4C5(IG)                                          
+            PFRAC(NGS4+IG,LAY) = FRACREFAC5(IG,JS) + FS *       &                  
+                 (FRACREFAC5(IG,JS+1) - FRACREFAC5(IG,JS))                           
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!!DIR$ NOVECTOR                                                                   
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         SPECCOMB = COLO3(LAY) + STRRAT2*COLCO2(LAY)                             
+         SPECPARM = COLO3(LAY)/SPECCOMB                                          
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 4.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(5) + JS                        
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(5) + JS                       
+!!DIR$ VECTOR                                                                     
+         DO 3000 IG = 1, NG5                                                     
+            TAUG(NGS4+IG,LAY) = SPECCOMB *          &
+                (FAC000 * ABSB5(IND0,IG) +           &                            
+                 FAC100 * ABSB5(IND0+1,IG) +         &                            
+                 FAC010 * ABSB5(IND0+5,IG) +         &                            
+                 FAC110 * ABSB5(IND0+6,IG) +         &                            
+                 FAC001 * ABSB5(IND1,IG) +           &                            
+                 FAC101 * ABSB5(IND1+1,IG) +         &                            
+                 FAC011 * ABSB5(IND1+5,IG) +         &                            
+                 FAC111 * ABSB5(IND1+6,IG))          &                            
+                 + WX(1,LAY) * CCL4C5(IG)                                          
+            PFRAC(NGS4+IG,LAY) = FRACREFBC5(IG,JS) + FS *  &                       
+                 (FRACREFBC5(IG,JS+1) - FRACREFBC5(IG,JS))                           
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB5
+                                                                                 
+!-----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB6(kts,ktep1,COLH2O,CO2MULT,FAC00,FAC01,FAC10,FAC11,    &
+                        SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,    &
+                        LAYTROP                                              )
+!-----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)                          
+                                                                                 
+      INTEGER, PARAMETER :: NGS5=68                                       
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( MAXXSEC,kts:ktep1 ),                 &
+            INTENT(IN   )        ::                     WX
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                   CO2MULT, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure) and             
+!     temperature. The water vapor self-continuum is interpolated                
+!     (in temperature) separately.                                               
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(6) + 1                          
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(6) + 1                             
+         INDS = INDSELF(LAY)                                                     
+         DO 2000 IG = 1, NG6                                                     
+            TAUG(NGS5+IG,LAY) = COLH2O(LAY) *              & 
+                (FAC00(LAY) * ABSA6(IND0,IG) +              &                     
+                 FAC10(LAY) * ABSA6(IND0+1,IG) +            &                     
+                 FAC01(LAY) * ABSA6(IND1,IG) +              &                     
+                 FAC11(LAY) * ABSA6(IND1+1,IG) +            &                     
+                 SELFFAC(LAY) * (SELFREFC6(INDS,IG) +        &                     
+                 SELFFRAC(LAY)*                            &                     
+                 (SELFREFC6(INDS+1,IG)-SELFREFC6(INDS,IG))))   &                     
+                 + WX(2,LAY) * CFC11ADJC6(IG)                &                     
+                 + WX(3,LAY) * CFC12C6(IG)                   &                     
+                 + CO2MULT(LAY) * ABSCO2C6(IG)                                     
+            PFRAC(NGS5+IG,LAY) = FRACREFAC6(IG)                                    
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!     Nothing important goes on above LAYTROP in this band.                      
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         DO 3000 IG = 1, NG6                                                     
+            TAUG(NGS5+IG,LAY) = 0.0                        & 
+                 + WX(2,LAY) * CFC11ADJC6(IG)                &                     
+                 + WX(3,LAY) * CFC12C6(IG)                                         
+            PFRAC(NGS5+IG,LAY) = FRACREFAC6(IG)                                    
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB6
+                                                                                 
+!-----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB7(kts,ktep1,COLH2O,COLO3,CO2MULT,FAC00,FAC01,FAC10,    &   
+                        FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,            &
+                        PFRAC,TAUG,LAYTROP                                   )
+!-----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)                           
+                                                                                 
+      INTEGER, PARAMETER :: NGS6=76                                      
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                     COLO3, &
+                                                   CO2MULT, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      STRRAT1 = 8.21104E4                                                        
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure),                
+!     temperature, and appropriate species.  Below LAYTROP, the water            
+!     vapor self-continuum is interpolated (in temperature) separately.          
+!!DIR$ NOVECTOR                                                                   
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         SPECCOMB = COLH2O(LAY) + STRRAT1*COLO3(LAY)                             
+         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 8.*SPECPARM                                                  
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(7) + JS                         
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(7) + JS                            
+         INDS = INDSELF(LAY)                                                     
+!!DIR$ VECTOR                                                                     
+         DO 2000 IG = 1, NG7                                                     
+            TAUG(NGS6+IG,LAY) = SPECCOMB *                   & 
+                (FAC000 * ABSA7(IND0,IG) +                   &                    
+                 FAC100 * ABSA7(IND0+1,IG) +                 &                    
+                 FAC010 * ABSA7(IND0+9,IG) +                 &                    
+                 FAC110 * ABSA7(IND0+10,IG) +                &                    
+                 FAC001 * ABSA7(IND1,IG) +                   &                    
+                 FAC101 * ABSA7(IND1+1,IG) +                 &                    
+                 FAC011 * ABSA7(IND1+9,IG) +                 &                    
+                 FAC111 * ABSA7(IND1+10,IG)) +               &                    
+                 COLH2O(LAY) *                               &                    
+                 SELFFAC(LAY) * (SELFREFC7(INDS,IG) +        &                    
+                 SELFFRAC(LAY) *                             &                    
+                 (SELFREFC7(INDS+1,IG) - SELFREFC7(INDS,IG)))&
+                 + CO2MULT(LAY) * ABSCO2C7(IG)                                     
+         PFRAC(NGS6+IG,LAY) = FRACREFAC7(IG,JS) + FS *        &                    
+                 (FRACREFAC7(IG,JS+1) - FRACREFAC7(IG,JS))                           
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(7) + 1                         
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(7) + 1                        
+         DO 3000 IG = 1, NG7                                                     
+            TAUG(NGS6+IG,LAY) = COLO3(LAY) *                & 
+                (FAC00(LAY) * ABSB7(IND0,IG) +               &                    
+                 FAC10(LAY) * ABSB7(IND0+1,IG) +             &                    
+                 FAC01(LAY) * ABSB7(IND1,IG) +               &                    
+                 FAC11(LAY) * ABSB7(IND1+1,IG))              &                    
+                 + CO2MULT(LAY) * ABSCO2C7(IG)                                     
+            PFRAC(NGS6+IG,LAY) = FRACREFBC7(IG)                                    
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB7
+                                                                                 
+!----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB8(kts,ktep1,COLH2O,COLO3,COLN2O,CO2MULT,              &
+                        FAC00,FAC01,FAC10,FAC11,SELFFAC,SELFFRAC,           &
+                        JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,LAYSWTCH            )
+!----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)               
+                                                                                 
+      INTEGER, PARAMETER :: NGS7=88                                       
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      :: LAYSWTCH
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( MAXXSEC,kts:ktep1 ),                 &
+            INTENT(IN   )        ::                     WX
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                     COLO3, &
+                                                    COLN2O, &
+                                                   CO2MULT, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      DIMENSION H2OREF(59),O3REF(59)                                             
+      REAL N2OMULT,N2OREF(59)                                              
+                                                                                 
+      DATA H2OREF/ &                                                             
+           1.87599E-02,1.22233E-02,5.89086E-03,2.76753E-03,1.40651E-03, &        
+           7.59698E-04,3.88758E-04,1.65422E-04,3.71895E-05,7.47648E-06, &        
+           4.30818E-06,3.33194E-06,3.20393E-06,3.16186E-06,3.25235E-06, &        
+           3.42258E-06,3.62884E-06,3.91482E-06,4.14875E-06,4.30810E-06, &        
+           4.44204E-06,4.57783E-06,4.70865E-06,4.79432E-06,4.86971E-06, &        
+           4.92603E-06,4.96688E-06,4.99628E-06,5.05266E-06,5.12658E-06, &        
+           5.25028E-06,5.35708E-06,5.45085E-06,5.48304E-06,5.50000E-06, &        
+           5.50000E-06,5.45359E-06,5.40468E-06,5.35576E-06,5.25327E-06, &        
+           5.14362E-06,5.03396E-06,4.87662E-06,4.69787E-06,4.51911E-06, &        
+           4.33600E-06,4.14416E-06,3.95232E-06,3.76048E-06,3.57217E-06, &        
+           3.38549E-06,3.19881E-06,3.01212E-06,2.82621E-06,2.64068E-06, &        
+           2.45515E-06,2.26962E-06,2.08659E-06,1.93029E-06/                      
+      DATA N2OREF/ &                                                             
+           3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07, &        
+           3.19652E-07,3.15324E-07,3.03830E-07,2.94221E-07,2.84953E-07, &        
+           2.76714E-07,2.64709E-07,2.42847E-07,2.09547E-07,1.71945E-07, &        
+           1.37491E-07,1.13319E-07,1.00354E-07,9.12812E-08,8.54633E-08, &        
+           8.03631E-08,7.33718E-08,6.59754E-08,5.60386E-08,4.70901E-08, &        
+           3.99774E-08,3.29786E-08,2.60642E-08,2.10663E-08,1.65918E-08, &        
+           1.30167E-08,1.00900E-08,7.62490E-09,6.11592E-09,4.66725E-09, &        
+           3.28574E-09,2.84838E-09,2.46198E-09,2.07557E-09,1.85507E-09, &        
+           1.65675E-09,1.45843E-09,1.31948E-09,1.20716E-09,1.09485E-09, &        
+           9.97803E-10,9.31260E-10,8.64721E-10,7.98181E-10,7.51380E-10, &        
+           7.13670E-10,6.75960E-10,6.38250E-10,6.09811E-10,5.85998E-10, &        
+           5.62185E-10,5.38371E-10,5.15183E-10,4.98660E-10/                      
+      DATA O3REF/  &                                                             
+           3.01700E-08,3.47254E-08,4.24769E-08,5.27592E-08,6.69439E-08, &        
+           8.71295E-08,1.13911E-07,1.56771E-07,2.17878E-07,3.24430E-07, &        
+           4.65942E-07,5.68057E-07,6.96065E-07,1.11863E-06,1.76175E-06, &        
+           2.32689E-06,2.95769E-06,3.65930E-06,4.59503E-06,5.31891E-06, &        
+           5.96179E-06,6.51133E-06,7.06350E-06,7.69169E-06,8.25771E-06, &        
+           8.70824E-06,8.83245E-06,8.71486E-06,8.09434E-06,7.33071E-06, &        
+           6.31014E-06,5.36717E-06,4.48289E-06,3.83913E-06,3.28270E-06, &        
+           2.82351E-06,2.49061E-06,2.16453E-06,1.83845E-06,1.66182E-06, &        
+           1.50517E-06,1.34852E-06,1.19718E-06,1.04822E-06,8.99264E-07, &        
+           7.63432E-07,6.53806E-07,5.44186E-07,4.34564E-07,3.64210E-07, &        
+           3.11938E-07,2.59667E-07,2.07395E-07,1.91456E-07,1.93639E-07, &        
+           1.95821E-07,1.98004E-07,2.06442E-07,2.81546E-07/                      
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure) and             
+!     temperature.                                                               
+!cdir novector
+      DO 2500 LAY = 1, LAYSWTCH                                                  
+         FP = FAC01(LAY) + FAC11(LAY)                                            
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(8) + 1                          
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(8) + 1                             
+         INDS = INDSELF(LAY)                                                     
+         COLREF1 = N2OREF(JP(LAY))                                               
+         COLREF2 = N2OREF(JP(LAY)+1)                                             
+         WCOMB1 = H2OREF(JP(LAY))                                                
+         WCOMB2 = H2OREF(JP(LAY)+1)                                              
+         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
+         CURRN2O = COLH2O(LAY) * RATIO                                           
+         N2OMULT = COLN2O(LAY) - CURRN2O                                         
+         DO 2000 IG = 1, NG8                                                     
+            TAUG(NGS7+IG,LAY) = COLH2O(LAY) *                 &
+                (FAC00(LAY) * ABSA8(IND0,IG) +                &                   
+                 FAC10(LAY) * ABSA8(IND0+1,IG) +              &                   
+                 FAC01(LAY) * ABSA8(IND1,IG) +                &                   
+                 FAC11(LAY) * ABSA8(IND1+1,IG) +              &                   
+                 SELFFAC(LAY) * (SELFREFC8(INDS,IG) +         &                   
+                 SELFFRAC(LAY) *                              &                   
+                 (SELFREFC8(INDS+1,IG) - SELFREFC8(INDS,IG))))&                   
+                 + WX(3,LAY) * CFC12C8(IG)                    &                   
+                 + WX(4,LAY) * CFC22ADJC8(IG)                 &                   
+                 + CO2MULT(LAY) * ABSCO2AC8(IG)               &                   
+                 + N2OMULT * ABSN2OAC8(IG)        
+            PFRAC(NGS7+IG,LAY) = FRACREFAC8(IG)                                    
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!cdir novector
+      DO 3500 LAY = LAYSWTCH+1, NLAYERS                                          
+         FP = FAC01(LAY) + FAC11(LAY)                                            
+         IND0 = ((JP(LAY)-7)*5+(JT(LAY)-1))*NSPB(8) + 1                          
+         IND1 = ((JP(LAY)-6)*5+(JT1(LAY)-1))*NSPB(8) + 1                         
+         COLREF1 = N2OREF(JP(LAY))                                               
+         COLREF2 = N2OREF(JP(LAY)+1)                                             
+         WCOMB1 = O3REF(JP(LAY))                                                 
+         WCOMB2 = O3REF(JP(LAY)+1)                                               
+         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
+         CURRN2O = COLO3(LAY) * RATIO                                            
+         N2OMULT = COLN2O(LAY) - CURRN2O                                         
+         DO 3000 IG = 1, NG8                                                     
+            TAUG(NGS7+IG,LAY) = COLO3(LAY) *        &
+                (FAC00(LAY) * ABSB8(IND0,IG) +       &                            
+                 FAC10(LAY) * ABSB8(IND0+1,IG) +     &                            
+                 FAC01(LAY) * ABSB8(IND1,IG) +       &                            
+                 FAC11(LAY) * ABSB8(IND1+1,IG))      &                            
+                 + WX(3,LAY) * CFC12C8(IG)            &                            
+                 + WX(4,LAY) * CFC22ADJC8(IG)         &                            
+                 + CO2MULT(LAY) * ABSCO2BC8(IG)       &                            
+                 + N2OMULT * ABSN2OBC8(IG)                                         
+            PFRAC(NGS7+IG,LAY) = FRACREFBC8(IG)                                    
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB8
+                                                                                 
+!-----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB9(kts,ktep1,COLH2O,COLN2O,COLCH4,FAC00,FAC01,FAC10,    &
+                        FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,            &
+                        PFRAC,TAUG,LAYTROP,LAYSWTCH,LAYLOW                   )
+!-----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)                        
+                                                                                 
+      INTEGER, PARAMETER :: NGS8=96                                      
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )   ::  LAYTROP,LAYSWTCH,LAYLOW
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                    COLN2O, &
+                                                    COLCH4, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      DIMENSION H2OREF(13),CH4REF(13),ETAREF(11)                                 
+      REAL N2OMULT,N2OREF(13)                                              
+                                                                                 
+      DATA N2OREF/  &                                                            
+           3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,  &
+           3.19652E-07,3.15324E-07,3.03830E-07,2.94221E-07,2.84953E-07,  &       
+           2.76714E-07,2.64709E-07,2.42847E-07/                                  
+      DATA H2OREF/  &                                                            
+           1.8759999E-02, 1.2223309E-02, 5.8908667E-03, 2.7675382E-03,   &       
+           1.4065107E-03, 7.5969833E-04, 3.8875898E-04, 1.6542293E-04,   &       
+           3.7189537E-05, 7.4764857E-06, 4.3081886E-06, 3.3319423E-06,   &       
+           3.2039343E-06/                                                        
+      DATA CH4REF/  &                                                            
+           1.7000001E-06, 1.7000001E-06, 1.6998713E-06, 1.6904165E-06,   &       
+           1.6671424E-06, 1.6350652E-06, 1.6097551E-06, 1.5590465E-06,   &       
+           1.5119849E-06, 1.4741138E-06, 1.4384609E-06, 1.4002215E-06,   &       
+           1.3573376E-06/                                                        
+      DATA ETAREF/  &                                                            
+           0.,0.125,0.25,0.375,0.5,0.625,0.75,0.875,0.96,0.99,1.0/               
+                                                                                 
+      STRRAT = 21.6282                                                           
+      IOFF = 0                                                                   
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure),                
+!     temperature, and appropriate species.  Below LAYTROP, the water            
+!     vapor self-continuum is interpolated (in temperature) separately.          
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         SPECCOMB = COLH2O(LAY) + STRRAT*COLCH4(LAY)                             
+         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 8.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         JFRAC = JS                                                              
+         FS = MOD(SPECMULT,1.0)                                                 
+         FFRAC = FS                                                              
+         IF (JS .EQ. 8) THEN                                                     
+            IF (FS .LE. 0.68) THEN                                               
+               FS = FS/0.68                                                      
+            ELSEIF (FS .LE. 0.92) THEN                                           
+               JS = JS + 1                                                       
+               FS = (FS-0.68)/0.24                                               
+            ELSE                                                                 
+               JS = JS + 2                                                       
+               FS = (FS-0.92)/0.08                                               
+            ENDIF                                                                
+         ELSEIF (JS .EQ.9) THEN                                                  
+            JS = 10                                                              
+            FS = 1.                                                              
+            JFRAC = 8                                                            
+            FFRAC = 1.                                                           
+         ENDIF                                                                   
+         FP = FAC01(LAY) + FAC11(LAY)                                            
+         NS = JS + INT(FS + 0.5)                                                 
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(9) + JS                         
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(9) + JS                            
+         INDS = INDSELF(LAY)                                                     
+         IF (LAY .EQ. LAYLOW) IOFF = NG9                                         
+         IF (LAY .EQ. LAYSWTCH) IOFF = 2*NG9                                     
+         COLREF1 = N2OREF(JP(LAY))                                               
+         COLREF2 = N2OREF(JP(LAY)+1)                                             
+         IF (NS .EQ. 11) THEN                                                    
+            WCOMB1 = H2OREF(JP(LAY))                                             
+            WCOMB2 = H2OREF(JP(LAY)+1)                                           
+         ELSE                                                                    
+            WCOMB1 = STRRAT * CH4REF(JP(LAY))/(1.-ETAREF(NS))                    
+            WCOMB2 = STRRAT * CH4REF(JP(LAY)+1)/(1.-ETAREF(NS))                  
+         ENDIF                                                                   
+         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
+         CURRN2O = SPECCOMB * RATIO                                              
+         N2OMULT = COLN2O(LAY) - CURRN2O                                         
+         DO 2000 IG = 1, NG9                                                     
+            TAUG(NGS8+IG,LAY) = SPECCOMB *                      &
+                (FAC000 * ABSA9(IND0,IG) +                      &                 
+                 FAC100 * ABSA9(IND0+1,IG) +                    &                 
+                 FAC010 * ABSA9(IND0+11,IG) +                   &                 
+                 FAC110 * ABSA9(IND0+12,IG) +                   &                 
+                 FAC001 * ABSA9(IND1,IG) +                      &                 
+                 FAC101 * ABSA9(IND1+1,IG) +                    &                 
+                 FAC011 * ABSA9(IND1+11,IG) +                   &                 
+                 FAC111 * ABSA9(IND1+12,IG)) +                  &                 
+                 COLH2O(LAY) *                                  &                 
+                 SELFFAC(LAY) * (SELFREFC9(INDS,IG) +           &                 
+                 SELFFRAC(LAY) *                                &                 
+                 (SELFREFC9(INDS+1,IG) - SELFREFC9(INDS,IG)))   & 
+                 + N2OMULT * ABSN2OC9(IG+IOFF)                                     
+            PFRAC(NGS8+IG,LAY) = FRACREFAC9(IG,JFRAC) + FFRAC *  &                 
+                 (FRACREFAC9(IG,JFRAC+1) - FRACREFAC9(IG,JFRAC))                     
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(9) + 1                         
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(9) + 1                        
+         DO 3000 IG = 1, NG9                                                     
+            TAUG(NGS8+IG,LAY) = COLCH4(LAY) *                  &                 
+                (FAC00(LAY) * ABSB9(IND0,IG) +                  &                 
+                 FAC10(LAY) * ABSB9(IND0+1,IG) +                &                 
+                 FAC01(LAY) * ABSB9(IND1,IG) +                  &                 
+                 FAC11(LAY) * ABSB9(IND1+1,IG))                                   
+            PFRAC(NGS8+IG,LAY) = FRACREFBC9(IG)                                    
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB9
+                                                                                 
+!--------------------------------------------------------------------------------    
+      SUBROUTINE TAUGB10(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,    &
+                         PFRAC,TAUG,LAYTROP                                     )
+!--------------------------------------------------------------------------------    
+                                                                                 
+!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)                           
+                                                                                 
+      INTEGER, PARAMETER :: NGS9=108                                     
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure) and             
+!     temperature.                                                               
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(10) + 1                         
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(10) + 1                            
+         DO 2000 IG = 1, NG10                                                    
+            TAUG(NGS9+IG,LAY) = COLH2O(LAY) *          &
+                (FAC00(LAY) * ABSA10(IND0,IG) +        &                           
+                 FAC10(LAY) * ABSA10(IND0+1,IG) +      &                           
+                 FAC01(LAY) * ABSA10(IND1,IG) +        &                           
+                 FAC11(LAY) * ABSA10(IND1+1,IG))                                   
+            PFRAC(NGS9+IG,LAY) = FRACREFAC10(IG)                                    
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(10) + 1                        
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(10) + 1                       
+         DO 3000 IG = 1, NG10                                                    
+            TAUG(NGS9+IG,LAY) = COLH2O(LAY) *        &
+                (FAC00(LAY) * ABSB10(IND0,IG) +        &                           
+                 FAC10(LAY) * ABSB10(IND0+1,IG) +      &                           
+                 FAC01(LAY) * ABSB10(IND1,IG) +        &                           
+                 FAC11(LAY) * ABSB10(IND1+1,IG))                                   
+            PFRAC(NGS9+IG,LAY) = FRACREFBC10(IG)                                    
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB10
+                                                                                 
+!--------------------------------------------------------------------------    
+      SUBROUTINE TAUGB11(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,        &
+                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,   &
+                         LAYTROP                                          )
+!--------------------------------------------------------------------------    
+                                                                                 
+!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)                           
+                                                                                 
+      INTEGER, PARAMETER :: NGS10=114                                    
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+
+!     Compute the optical depth by interpolating in ln(pressure) and             
+!     temperature.  Below LAYTROP, the water vapor self-continuum                
+!     is interpolated (in temperature) separately.                               
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(11) + 1                         
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(11) + 1                            
+         INDS = INDSELF(LAY)                                                     
+         DO 2000 IG = 1, NG11                                                    
+            TAUG(NGS10+IG,LAY) = COLH2O(LAY) *                 &                   
+                (FAC00(LAY) * ABSA11(IND0,IG) +                &                   
+                 FAC10(LAY) * ABSA11(IND0+1,IG) +              &                   
+                 FAC01(LAY) * ABSA11(IND1,IG) +                &                   
+                 FAC11(LAY) * ABSA11(IND1+1,IG) +              &                   
+                 SELFFAC(LAY) * (SELFREFC11(INDS,IG) +         & 
+                 SELFFRAC(LAY) *                               &                   
+                 (SELFREFC11(INDS+1,IG) - SELFREFC11(INDS,IG))))                       
+            PFRAC(NGS10+IG,LAY) = FRACREFAC11(IG)                                   
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(11) + 1                        
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(11) + 1                       
+         DO 3000 IG = 1, NG11                                                    
+            TAUG(NGS10+IG,LAY) = COLH2O(LAY) *               &                   
+                (FAC00(LAY) * ABSB11(IND0,IG) +                &                   
+                 FAC10(LAY) * ABSB11(IND0+1,IG) +              &                   
+                 FAC01(LAY) * ABSB11(IND1,IG) +                &                   
+                 FAC11(LAY) * ABSB11(IND1+1,IG))                                   
+            PFRAC(NGS10+IG,LAY) = FRACREFBC11(IG)                                   
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB11
+                                                                                 
+!-----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB12(kts,ktep1,COLH2O,COLCO2,FAC00,FAC01,FAC10,FAC11,    &
+                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,      &
+                         LAYTROP                                             )
+!-----------------------------------------------------------------------------   
+                                                                                 
+!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)                   
+                                                                                 
+      INTEGER, PARAMETER :: NGS11=122                                    
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                    COLCO2, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      STRRAT1 = 0.009736757                                                      
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure),                
+!     temperature, and appropriate species.  Below LAYTROP, the water            
+!     vapor self-continuum is interpolated (in temperature) separately.          
+!!DIR$ NOVECTOR                                                                   
+!cdir novector
+      DO 2500 LAY = 1, LAYTROP                                                   
+         SPECCOMB = COLH2O(LAY) + STRRAT1*COLCO2(LAY)                            
+         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 8.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(12) + JS                        
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(12) + JS                           
+         INDS = INDSELF(LAY)                                                     
+!!DIR$ VECTOR                                                                     
+         DO 2000 IG = 1, NG12                                                    
+            TAUG(NGS11+IG,LAY) = SPECCOMB *             & 
+                (FAC000 * ABSA12(IND0,IG) +             &                          
+                 FAC100 * ABSA12(IND0+1,IG) +           &                          
+                 FAC010 * ABSA12(IND0+9,IG) +           &                          
+                 FAC110 * ABSA12(IND0+10,IG) +          &                          
+                 FAC001 * ABSA12(IND1,IG) +             &                          
+                 FAC101 * ABSA12(IND1+1,IG) +           &                          
+                 FAC011 * ABSA12(IND1+9,IG) +           &                          
+                 FAC111 * ABSA12(IND1+10,IG)) +         &                          
+                 COLH2O(LAY) *                          &                          
+                 SELFFAC(LAY) * (SELFREFC12(INDS,IG) +  &                          
+                 SELFFRAC(LAY) *                        &                          
+                 (SELFREFC12(INDS+1,IG) - SELFREFC12(INDS,IG)))                        
+            PFRAC(NGS11+IG,LAY) = FRACREFAC12(IG,JS) + FS *  & 
+                 (FRACREFAC12(IG,JS+1) - FRACREFAC12(IG,JS))                           
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+!cdir novector
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         DO 3000 IG = 1, NG12                                                    
+            TAUG(NGS11+IG,LAY) = 0.0                                             
+            PFRAC(NGS11+IG,LAY) = 0.0                                            
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB12
+                                                                                 
+!-----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB13(kts,ktep1,COLH2O,COLN2O,FAC00,FAC01,FAC10,FAC11,    &
+                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,      &
+                         LAYTROP                                             )
+!-----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)                   
+                                                                                 
+      INTEGER, PARAMETER :: NGS12=130                                    
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                    COLN2O, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      STRRAT1 = 16658.87                                                         
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure),                
+!     temperature, and appropriate species.  Below LAYTROP, the water            
+!     vapor self-continuum is interpolated (in temperature) separately.          
+      DO 2500 LAY = 1, LAYTROP                                                   
+         SPECCOMB = COLH2O(LAY) + STRRAT1*COLN2O(LAY)                            
+         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 8.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(13) + JS                        
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(13) + JS                           
+         INDS = INDSELF(LAY)                                                     
+         DO 2000 IG = 1, NG13                                                    
+            TAUG(NGS12+IG,LAY) = SPECCOMB *                &                       
+                (FAC000 * ABSA13(IND0,IG) +                &                       
+                 FAC100 * ABSA13(IND0+1,IG) +              &                       
+                 FAC010 * ABSA13(IND0+9,IG) +              &                       
+                 FAC110 * ABSA13(IND0+10,IG) +             &                       
+                 FAC001 * ABSA13(IND1,IG) +                &                       
+                 FAC101 * ABSA13(IND1+1,IG) +              &                       
+                 FAC011 * ABSA13(IND1+9,IG) +              &                       
+                 FAC111 * ABSA13(IND1+10,IG)) +            &                       
+                 COLH2O(LAY) *                           &                       
+                 SELFFAC(LAY) * (SELFREFC13(INDS,IG) +      &                       
+                 SELFFRAC(LAY) *                         &                       
+                 (SELFREFC13(INDS+1,IG) - SELFREFC13(INDS,IG)))                        
+            PFRAC(NGS12+IG,LAY) = FRACREFAC13(IG,JS) + FS * &                       
+                 (FRACREFAC13(IG,JS+1) - FRACREFAC13(IG,JS))                           
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         DO 3000 IG = 1, NG13                                                    
+            TAUG(NGS12+IG,LAY) = 0.0                                             
+            PFRAC(NGS12+IG,LAY) = 0.0                                            
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+
+      END SUBROUTINE TAUGB13
+                                                                                 
+!----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB14(kts,ktep1,COLCO2,FAC00,FAC01,FAC10,FAC11,          &
+                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,     &
+                         LAYTROP                                            )
+!----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)                           
+                                                                                 
+      INTEGER, PARAMETER :: NGS13=134                                    
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLCO2, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure) and             
+!     temperature.  Below LAYTROP, the water vapor self-continuum                
+!     is interpolated (in temperature) separately.                               
+      DO 2500 LAY = 1, LAYTROP                                                   
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(14) + 1                         
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(14) + 1                            
+         INDS = INDSELF(LAY)                                                     
+         DO 2000 IG = 1, NG14                                                    
+            TAUG(NGS13+IG,LAY) = COLCO2(LAY) *           &
+                (FAC00(LAY) * ABSA14(IND0,IG) +          &                         
+                 FAC10(LAY) * ABSA14(IND0+1,IG) +        &                         
+                 FAC01(LAY) * ABSA14(IND1,IG) +          &                         
+                 FAC11(LAY) * ABSA14(IND1+1,IG) +        &                         
+                 SELFFAC(LAY) * (SELFREFC14(INDS,IG) +   &                         
+                 SELFFRAC(LAY) *                         &                         
+                 (SELFREFC14(INDS+1,IG) - SELFREFC14(INDS,IG))))                       
+            PFRAC(NGS13+IG,LAY) = FRACREFAC14(IG)                                   
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(14) + 1                        
+         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(14) + 1                       
+         DO 3000 IG = 1, NG14                                                    
+            TAUG(NGS13+IG,LAY) = COLCO2(LAY) *       &                           
+                (FAC00(LAY) * ABSB14(IND0,IG) +        &                           
+                 FAC10(LAY) * ABSB14(IND0+1,IG) +      &                           
+                 FAC01(LAY) * ABSB14(IND1,IG) +        &                           
+                 FAC11(LAY) * ABSB14(IND1+1,IG))                                   
+            PFRAC(NGS13+IG,LAY) = FRACREFBC14(IG)                                   
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB14
+                                                                                 
+!------------------------------------------------------------------------------    
+      SUBROUTINE TAUGB15(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,    &
+                         FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,            &
+                         PFRAC,TAUG,LAYTROP                                   )
+!------------------------------------------------------------------------------    
+                                                                                 
+!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)                   
+                                                                                 
+      INTEGER, PARAMETER :: NGS14=136                                    
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                    COLCO2, &
+                                                    COLN2O, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      STRRAT1 = 0.2883201                                                        
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure),                
+!     temperature, and appropriate species.  Below LAYTROP, the water            
+!     vapor self-continuum is interpolated (in temperature) separately.          
+      DO 2500 LAY = 1, LAYTROP                                                   
+         SPECCOMB = COLN2O(LAY) + STRRAT1*COLCO2(LAY)                            
+         SPECPARM = COLN2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 8.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(15) + JS                        
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(15) + JS                           
+         INDS = INDSELF(LAY)                                                     
+         DO 2000 IG = 1, NG15                                                    
+            TAUG(NGS14+IG,LAY) = SPECCOMB *                     &                  
+                (FAC000 * ABSA15(IND0,IG) +                     &                  
+                 FAC100 * ABSA15(IND0+1,IG) +                   &                  
+                 FAC010 * ABSA15(IND0+9,IG) +                   &                  
+                 FAC110 * ABSA15(IND0+10,IG) +                  &                  
+                 FAC001 * ABSA15(IND1,IG) +                     &                  
+                 FAC101 * ABSA15(IND1+1,IG) +                   &                  
+                 FAC011 * ABSA15(IND1+9,IG) +                   &                  
+                 FAC111 * ABSA15(IND1+10,IG)) +                 &                  
+                 COLH2O(LAY) *                                &                  
+                 SELFFAC(LAY) * (SELFREFC15(INDS,IG) +           &                  
+                 SELFFRAC(LAY) *                              &                  
+                 (SELFREFC15(INDS+1,IG) - SELFREFC15(INDS,IG)))                        
+            PFRAC(NGS14+IG,LAY) = FRACREFAC15(IG,JS) + FS *      &                  
+                 (FRACREFAC15(IG,JS+1) - FRACREFAC15(IG,JS))                           
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         DO 3000 IG = 1, NG15                                                    
+            TAUG(NGS14+IG,LAY) = 0.0                                             
+            PFRAC(NGS14+IG,LAY) = 0.0                                            
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB15
+                                                                                 
+!-----------------------------------------------------------------------------    
+      SUBROUTINE TAUGB16(kts,ktep1,COLH2O,COLCH4,FAC00,FAC01,FAC10,FAC11,    &
+                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,      &
+                         LAYTROP                                             )
+!-----------------------------------------------------------------------------    
+                                                                                 
+!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)                   
+                                                                                 
+      INTEGER, PARAMETER :: NGS15=138                                    
+                                                                                 
+      INTEGER, INTENT(IN )                      :: kts,ktep1
+
+      INTEGER, INTENT(IN )                      ::  LAYTROP
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
+            INTENT(INOUT)        ::                  PFRAC, &
+                                                      TAUG
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
+                                                    COLH2O, &
+                                                    COLCH4, &
+                                                     FAC00, &
+                                                     FAC01, &
+                                                     FAC10, &
+                                                     FAC11, &
+                                                   SELFFAC, &
+                                                  SELFFRAC 
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
+                                                        JP, &
+                                                        JT, &
+                                                       JT1, &
+                                                   INDSELF
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+      STRRAT1 = 830.411                                                          
+                                                                                 
+!     Compute the optical depth by interpolating in ln(pressure),                
+!     temperature, and appropriate species.  Below LAYTROP, the water            
+!     vapor self-continuum is interpolated (in temperature) separately.          
+      DO 2500 LAY = 1, LAYTROP                                                   
+         SPECCOMB = COLH2O(LAY) + STRRAT1*COLCH4(LAY)                            
+         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
+         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
+         SPECMULT = 8.*(SPECPARM)                                                
+         JS = 1 + INT(SPECMULT)                                                  
+         FS = MOD(SPECMULT,1.0)                                                 
+         FAC000 = (1. - FS) * FAC00(LAY)                                         
+         FAC010 = (1. - FS) * FAC10(LAY)                                         
+         FAC100 = FS * FAC00(LAY)                                                
+         FAC110 = FS * FAC10(LAY)                                                
+         FAC001 = (1. - FS) * FAC01(LAY)                                         
+         FAC011 = (1. - FS) * FAC11(LAY)                                         
+         FAC101 = FS * FAC01(LAY)                                                
+         FAC111 = FS * FAC11(LAY)                                                
+         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(16) + JS                        
+         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(16) + JS                           
+         INDS = INDSELF(LAY)                                                     
+         DO 2000 IG = 1, NG16                                                    
+            TAUG(NGS15+IG,LAY) = SPECCOMB *                 &
+                (FAC000 * ABSA16(IND0,IG) +                 &                      
+                 FAC100 * ABSA16(IND0+1,IG) +               &                      
+                 FAC010 * ABSA16(IND0+9,IG) +               &                      
+                 FAC110 * ABSA16(IND0+10,IG) +              &                      
+                 FAC001 * ABSA16(IND1,IG) +                 &                      
+                 FAC101 * ABSA16(IND1+1,IG) +               &                      
+                 FAC011 * ABSA16(IND1+9,IG) +               &                      
+                 FAC111 * ABSA16(IND1+10,IG)) +             &                      
+                 COLH2O(LAY) *                            &                      
+                 SELFFAC(LAY) * (SELFREFC16(INDS,IG) +       &                      
+                 SELFFRAC(LAY) *                          &                      
+                 (SELFREFC16(INDS+1,IG) - SELFREFC16(INDS,IG)))                        
+            PFRAC(NGS15+IG,LAY) = FRACREFAC16(IG,JS) + FS *  &                      
+                 (FRACREFAC16(IG,JS+1) - FRACREFAC16(IG,JS))                           
+ 2000    CONTINUE                                                                
+ 2500 CONTINUE                                                                   
+                                                                                 
+      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
+         DO 3000 IG = 1, NG16                                                    
+            TAUG(NGS15+IG,LAY) = 0.0                                             
+            PFRAC(NGS15+IG,LAY) = 0.0                                            
+ 3000    CONTINUE                                                                
+ 3500 CONTINUE                                                                   
+                                                                                 
+      END SUBROUTINE TAUGB16
+                                                                                 
+
+!-------------------------------------------------------------------------
+      SUBROUTINE RTRN(kts,ktep1,                                         &
+                      TAVEL, PZ, TZ, CLDFRAC, TAUCLOUD, TOTDFLUX,        &
+                      HTR, ICLDLYR, ITR, PFRAC, TBOUND,SEMISS            )
+!-------------------------------------------------------------------------
+!  RRTM Longwave Radiative Transfer Model                                        
+!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
+!                                                                                
+!  Original version:       E. J. Mlawer, et al.                                  
+!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
+!                                                                                
+!  This program calculates the upward fluxes, downward fluxes, and               
+!  heating rates for an arbitrary clear or cloudy atmosphere.  The input         
+!  to this program is the atmospheric profile, all Planck function               
+!  information, and the cloud fraction by layer.  The diffusivity angle          
+!  (SECANG=1.66) is used for the angle integration for consistency with          
+!  the NCAR CCM; the Gaussian weight appropriate to this angle (WTNUM=0.5)       
+!  is applied here.  Note that use of the emissivity angle for the flux          
+!  integration can cause errors of 1 to 4 W/m2 within cloudy layers.             
+!-------------------------------------------------------------------------
+                                                                                 
+      INTEGER, INTENT(IN )    ::      kts,ktep1
+ 
+      INTEGER, DIMENSION( NGPT,kts:ktep1 ),               &
+               INTENT(IN   )  ::                     ITR
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                  &
+            INTENT(IN   )     ::                   PFRAC
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::      &
+                                                   TAVEL
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::      &
+                                                 CLDFRAC, &
+                                                TAUCLOUD
+
+      REAL, DIMENSION(   0:ktep1 ),INTENT(INOUT)::        &
+                                                TOTDFLUX
+
+      REAL, DIMENSION(   0:ktep1 ), INTENT(INOUT) ::        &
+                                                     HTR  
+
+      REAL, DIMENSION(   0:ktep1 ), INTENT(IN   ) ::      &
+                                                      PZ, &
+                                                      TZ
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::   &
+                                                 ICLDLYR
+
+      REAL, INTENT(IN   )        ::               TBOUND
+      REAL, DIMENSION(NBANDS), INTENT(IN   ) ::   SEMISS
+
+! LOCAL VAR
+
+      REAL, DIMENSION(   0:ktep1 )              ::        &
+                                                TOTUCLFL, &
+                                                TOTDCLFL, &
+                                                TOTUFLUX
+
+      REAL, DIMENSION(   0:ktep1 )              ::        &
+                                                    FNET, &
+                                                   FNETC, &
+                                                    HTRC
+
+      INTEGER :: kk
+     
+      REAL    :: CLRNTTOA,CLRNTSRF 
+
+! Parameters                                                                     
+
+!     INTEGER, PARAMETER :: MXLAY=101                                                      
+      REAL, PARAMETER :: SECANG=1.66                                                    
+      REAL, PARAMETER :: WTNUM=0.5                                                      
+                                                                                 
+! RRTM Definitions                                                               
+! Input                                                                          
+!    MXLAY                        ! Maximum number of model layers               
+!    NGPT                         ! Total number of g-point subintervals         
+!    NBANDS                       ! Number of longwave spectral bands            
+!    SECANG                       ! Diffusivity angle                            
+!    WTNUM                        ! Weight for radiance to flux conversion       
+!    NLAYERS                      ! Number of model layers (plev+1)              
+!    PAVEL(MXLAY)                 ! Layer pressures (mb)                         
+!    PZ(0:MXLAY)                  ! Level (interface) pressures (mb)             
+!    TAVEL(MXLAY)                 ! Layer temperatures (K)                       
+!    TZ(0:MXLAY)                  ! Level (interface) temperatures(mb)           
+!    TBOUND                       ! Surface temperature (K)                      
+!    CLDFRAC(MXLAY)               ! Layer cloud fraction                         
+!    TAUCLOUD(MXLAY)              ! Layer cloud optical depth                    
+!    ITR(NGPT,MXLAY)              ! Integer look-up table index                  
+!    PFRAC(NGPT,MXLAY)               ! Planck fractions                             
+!    ICLDLYR(MXLAY)               ! Flag for cloudy layers                       
+!    ICLD                         ! Flag for cloudy in column                    
+!    SEMISS(NBANDS)               ! Surface emissivities for each band           
+!    BPADE                        ! Pade constant                                
+!    TAU                          ! Clear sky optical depth look-up table        
+!    TF                           ! Tau transition function look-up table        
+!    TRANS                        ! Clear sky transmittance look-up table        
+! Local                                                                          
+!    ABSS(NGPT*MXLAY)             ! Gaseous absorptivity                         
+!    ABSCLD(MXLAY)                ! Cloud absorptivity                           
+!    ATOT(NGPT*MXLAY)             ! Combined gaseous and cloud absorptivity      
+!    ODCLR(NGPT,MXLAY)            ! Clear sky (gaseous) optical depth            
+!    ODCLD(MXLAY)                 ! Cloud optical depth                          
+!    EFCLFRAC(MXLAY)              ! Effective cloud fraction                     
+!    RADLU(NGPT)                  ! Upward radiance                              
+!    URAD                         ! Spectrally summed upward radiance            
+!    RADCLRU(NGPT)                ! Clear sky upward radiance                    
+!    CLRURAD                      ! Spectrally summed clear sky upward radiance  
+!    RADLD(NGPT)                  ! Downward radiance                            
+!    DRAD                         ! Spectrally summed downward radiance          
+!    RADCLRD(NGPT)                ! Clear sky downward radiance                  
+!    CLRDRAD                      ! Spectrally summed clear sky downward radianc 
+! Output                                                                         
+!    TOTUFLUX(0:MXLAY)            ! Upward longwave flux (W/m2)                  
+!    TOTDFLUX(0:MXLAY)            ! Downward longwave flux (W/m2)                
+!    FNET(0:MXLAY)                ! Net longwave flux (W/m2)                     
+!    HTR(0:MXLAY)                 ! Longwave heating rate (K/day)                
+!    CLRNTTOA                     ! Clear sky TOA outgoing flux (W/m2)           
+!    CLRNTSFC                     ! Clear sky net surface flux (W/m2)            
+!    TOTUCLFL(0:MXLAY)            ! Clear sky upward longwave flux (W/m2)        
+!    TOTDCLFL(0:MXLAY)            ! Clear sky downward longwave flux (W/m2)      
+!    FNETC(0:MXLAY)               ! Clear sky net longwave flux (W/m2)           
+!    HTRC(0:MXLAY)                ! Clear sky longwave heating rate (K/day)      
+!                                                                                
+                                                                                 
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+
+      DIMENSION BBU(NGPT*(ktep1-kts+1)),BBUTOT(NGPT*(ktep1-kts)),BGLEV(NGPT)                   
+      DIMENSION PLANKBND(NBANDS),PLNKEMIT(NBANDS)                                
+      DIMENSION PLVL(NBANDS,0:ktep1),PLAY(NBANDS,kts:ktep1)                          
+      DIMENSION INDLAY(kts:ktep1),INDLEV(0:ktep1)                                    
+      DIMENSION TLAYFRAC(kts:ktep1),TLEVFRAC(0:ktep1)                                
+      DIMENSION ABSS(NGPT*(ktep1-kts+1)),ABSCLD(kts:ktep1-1),ATOT(NGPT*(ktep1-kts)) 
+      DIMENSION ODCLR(NGPT,kts:ktep1-1),ODCLD(kts:ktep1-1),EFCLFRAC(kts:ktep1-1)
+      DIMENSION RADLU(NGPT),RADLD(NGPT)                                          
+      DIMENSION RADCLRU(NGPT),RADCLRD(NGPT)                                      
+      DIMENSION SEMIS(NGPT),RADUEMIT(NGPT)                                       
+                                                                                 
+      INDBOUND = TBOUND - 159.                                                   
+      TBNDFRAC = TBOUND - INT(TBOUND)                                            
+                                                                                 
+      DO 200 LAY = 0, NLAYERS                                                    
+         TOTUFLUX(LAY) = 0.0                                                     
+         TOTDFLUX(LAY) = 0.0                                                     
+         TOTUCLFL(LAY) = 0.0                                                     
+         TOTDCLFL(LAY) = 0.0                                                     
+         INDLEV(LAY) = TZ(LAY) - 159.                                            
+         TLEVFRAC(LAY) = TZ(LAY) - INT(TZ(LAY))                                  
+ 200  CONTINUE                                                                   
+                                                                                 
+      DO 220 LEV = 1, NLAYERS                                                    
+                                                                                 
+         IF (ICLDLYR(LEV).EQ.1) THEN                                             
+            INDLAY(LEV) = TAVEL(LEV) - 159.                                      
+            TLAYFRAC(LEV) = TAVEL(LEV) - INT(TAVEL(LEV))                         
+!  Cloudy sky optical depth and absorptivity.                                    
+            ODCLD(LEV) = SECANG * TAUCLOUD(LEV)                                  
+            TRANSCLD = EXP(-ODCLD(LEV))                                          
+            ABSCLD(LEV) = 1. - TRANSCLD                                          
+            EFCLFRAC(LEV) = ABSCLD(LEV) * CLDFRAC(LEV)                           
+!  Get clear sky optical depth from TAU lookup table                             
+            DO 250 IPR = 1, NGPT                                                 
+               IND = ITR(IPR,LEV)                                                
+               ODCLR(IPR,LEV) = TAU(IND)                                         
+ 250        CONTINUE                                                             
+         ELSE                                                                    
+            INDLAY(LEV) = TAVEL(LEV) - 159.                                      
+            TLAYFRAC(LEV) = TAVEL(LEV) - INT(TAVEL(LEV))                         
+         ENDIF                                                                   
+                                                                                 
+ 220  CONTINUE                                                                   
+                                                                                 
+!      SUMPL   = 0.0                                                             
+!      SUMPLEM = 0.0                                                             
+! *** Loop over frequency bands.                                                 
+      DO 600 IBAND = 1, NBANDS                                                   
+         DBDTLEV = TOTPLNK(INDBOUND+1,IBAND)-TOTPLNK(INDBOUND,IBAND)             
+         PLANKBND(IBAND) = DELWAVE(IBAND) * (TOTPLNK(INDBOUND,IBAND) +  &
+              TBNDFRAC * DBDTLEV)                                                
+         DBDTLEV = TOTPLNK(INDLEV(0)+1,IBAND) -                         &        
+              TOTPLNK(INDLEV(0),IBAND)                                           
+         PLVL(IBAND,0) = DELWAVE(IBAND) * (TOTPLNK(INDLEV(0),IBAND) +   &        
+              TLEVFRAC(0)*DBDTLEV)                                               
+                                                                                 
+         PLNKEMIT(IBAND) = SEMISS(IBAND) * PLANKBND(IBAND)                       
+!         SUMPLEM  = SUMPLEM + PLNKEMIT(IBAND)                                   
+!         SUMPL    = SUMPL   + PLANKBND(IBAND)                                   
+                                                                                 
+         DO 300 LEV = 1, NLAYERS                                                 
+!     Calculate the integrated Planck functions at the level and                 
+!     layer temperatures.                                                        
+            DBDTLEV = TOTPLNK(INDLEV(LEV)+1,IBAND) -          &
+                 TOTPLNK(INDLEV(LEV),IBAND)                                      
+            DBDTLAY = TOTPLNK(INDLAY(LEV)+1,IBAND) -          &                  
+                 TOTPLNK(INDLAY(LEV),IBAND)                                      
+            PLAY(IBAND,LEV) = DELWAVE(IBAND) *                &                  
+                 (TOTPLNK(INDLAY(LEV),IBAND) + TLAYFRAC(LEV) * DBDTLAY)          
+            PLVL(IBAND,LEV) = DELWAVE(IBAND) *                &                  
+                 (TOTPLNK(INDLEV(LEV),IBAND) + TLEVFRAC(LEV) * DBDTLEV)          
+ 300     CONTINUE                                                                
+ 600  CONTINUE                                                                   
+                                                                                 
+!      SEMISLW = SUMPLEM / SUMPL                                                 
+                                                                                 
+! *** Initialize for radiative transfer.                                         
+      DO 500 IPR = 1, NGPT                                                       
+         RADCLRD(IPR) = 0.                                                       
+         RADLD(IPR) = 0.                                                         
+         SEMIS(IPR) = SEMISS(NGB(IPR))                                           
+         RADUEMIT(IPR) = PFRAC(IPR,1) * PLNKEMIT(NGB(IPR))                          
+         BGLEV(IPR) = PFRAC(IPR,NLAYERS) * PLVL(NGB(IPR),NLAYERS)                   
+ 500  CONTINUE                                                                   
+                                                                                 
+                                                                                 
+! *** DOWNWARD RADIATIVE TRANSFER                                                
+! *** DRAD holds summed radiance for total sky stream                            
+! *** CLRDRAD holds summed radiance for clear sky stream                         
+                                                                                 
+      ICLDDN = 0                                                                 
+      DO 3000 LEV = NLAYERS, 1, -1                                               
+         DRAD = 0.0                                                              
+         CLRDRAD = 0.0                                                           
+                                                                                 
+         IF (ICLDLYR(LEV).EQ.1) THEN                                             
+                                                                                 
+! *** Cloudy layer                                                               
+         ICLDDN = 1                                                              
+         IENT = NGPT * (LEV-1)                                                   
+         DO 2000 IPR = 1, NGPT                                                   
+            INDEX = IENT + IPR                                                   
+!     Get lookup table index                                                     
+            IND = ITR(IPR,LEV)                                                   
+!     Add clear sky and cloud optical depths                                     
+            ODSM = ODCLR(IPR,LEV) + ODCLD(LEV)                                   
+            FACTOT = ODSM / (BPADE + ODSM)                                       
+            BGLAY = PFRAC(IPR,LEV) * PLAY(NGB(IPR),LEV)                             
+            DELBGUP = BGLEV(IPR) - BGLAY                                         
+!     Get TF from lookup table                                                   
+            TAUF = TF(IND)                                                       
+            BBU(INDEX) = BGLAY + TAUF * DELBGUP                                  
+            BBUTOT(INDEX) = BGLAY + FACTOT * DELBGUP                             
+            BGLEV(IPR) = PFRAC(IPR,LEV) * PLVL(NGB(IPR),LEV-1)                      
+            DELBGDN = BGLEV(IPR) - BGLAY                                         
+            BBD = BGLAY + TAUF * DELBGDN                                         
+            BBDLEVD = BGLAY + FACTOT * DELBGDN                                   
+!     Get clear sky transmittance from lookup table                              
+            ABSS(INDEX) = 1. - TRANS(IND)                                        
+            ATOT(INDEX) = ABSS(INDEX) + ABSCLD(LEV) -      &
+                ABSS(INDEX) * ABSCLD(LEV)                                        
+            GASSRC = BBD * ABSS(INDEX)                                           
+!     Total sky radiance                                                         
+            RADLD(IPR) = RADLD(IPR) - RADLD(IPR) * (ABSS(INDEX) +  &             
+               EFCLFRAC(LEV) * (1.-ABSS(INDEX))) + GASSRC +        &             
+               CLDFRAC(LEV) * (BBDLEVD * ATOT(INDEX) - GASSRC)                   
+            DRAD = DRAD + RADLD(IPR)                                             
+!     Clear sky radiance                                                         
+            RADCLRD(IPR) = RADCLRD(IPR) + (BBD - RADCLRD(IPR))     & 
+                         * ABSS(INDEX)                                           
+            CLRDRAD = CLRDRAD + RADCLRD(IPR)                                     
+ 2000    CONTINUE                                                                
+                                                                                 
+         ELSE                                                                    
+                                                                                 
+! *** Clear layer                                                                
+         IENT = NGPT * (LEV-1)                                                   
+         DO 2100 IPR = 1, NGPT                                                   
+            INDEX = IENT + IPR                                                   
+            IND = ITR(IPR,LEV)                                                   
+            BGLAY = PFRAC(IPR,LEV) * PLAY(NGB(IPR),LEV)                             
+            DELBGUP = BGLEV(IPR) - BGLAY                                         
+!     Get TF from lookup table                                                   
+            TAUF = TF(IND)                                                       
+            BBU(INDEX) = BGLAY + TAUF * DELBGUP                                  
+            BGLEV(IPR) = PFRAC(IPR,LEV) * PLVL(NGB(IPR),LEV-1)                      
+            DELBGDN = BGLEV(IPR) - BGLAY                                         
+            BBD = BGLAY + TAUF * DELBGDN                                         
+!     Get clear sky transmittance from lookup table                              
+            ABSS(INDEX) = 1. - TRANS(IND)                                        
+!     Total sky radiance                                                         
+            RADLD(IPR) = RADLD(IPR) + (BBD - RADLD(IPR)) *     & 
+                         ABSS(INDEX)                                             
+            DRAD = DRAD + RADLD(IPR)                                             
+ 2100    CONTINUE                                                                
+!     Set clear sky stream to total sky stream as long as layers                 
+!     remain clear.  Streams diverge when a cloud is reached.                    
+            IF (ICLDDN.EQ.1) THEN                                                
+         DO 2200 IPR = 1, NGPT                                                   
+               RADCLRD(IPR) = RADCLRD(IPR) + (BBD - RADCLRD(IPR)) *   & 
+                              ABSS(INDEX)                                        
+               CLRDRAD = CLRDRAD + RADCLRD(IPR)                                  
+ 2200    CONTINUE                                                                
+            ELSE                                                                 
+         DO 2300 IPR = 1, NGPT                                                   
+               RADCLRD(IPR) = RADLD(IPR)                                         
+               CLRDRAD = DRAD                                                    
+ 2300    CONTINUE                                                                
+            ENDIF                                                                
+                                                                                 
+! 2100    CONTINUE                                                               
+                                                                                 
+         ENDIF                                                                   
+                                                                                 
+         TOTDFLUX(LEV-1) = DRAD * WTNUM                                          
+         TOTDCLFL(LEV-1) = CLRDRAD * WTNUM                                       
+                                                                                 
+ 3000 CONTINUE                                                                   
+                                                                                 
+                                                                                 
+! SPECTRAL EMISSIVITY & REFLECTANCE                                              
+! Include the contribution of spectrally varying longwave emissivity and         
+! reflection from the surface to the upward radiative transfer.                  
+! Note: Spectral and Lambertian reflection are identical for the one angle       
+! flux integration used here.                                                    
+                                                                                 
+      URAD = 0.0                                                                 
+      CLRURAD = 0.0                                                              
+      DO 3500 IPR = 1, NGPT                                                      
+!     Total sky radiance                                                         
+         RADLU(IPR) = RADUEMIT(IPR) + (1. - SEMIS(IPR)) * RADLD(IPR)             
+         URAD = URAD + RADLU(IPR)                                                
+!     Clear sky radiance                                                         
+         RADCLRU(IPR) = RADUEMIT(IPR) + (1. - SEMIS(IPR))  & 
+                        * RADCLRD(IPR)                                           
+         CLRURAD = CLRURAD + RADCLRU(IPR)                                        
+ 3500 CONTINUE                                                                   
+      TOTUFLUX(0) = URAD * WTNUM                                                 
+      TOTUCLFL(0) = CLRURAD * WTNUM                                              
+                                                                                 
+                                                                                 
+! *** UPWARD RADIATIVE TRANSFER                                                  
+! *** URAD holds the summed radiance for total sky stream                        
+! *** CLRURAD holds the summed radiance for clear sky stream                     
+                                                                                 
+      DO 5000 LEV = 1, NLAYERS                                                   
+         URAD = 0.0                                                              
+         CLRURAD = 0.0                                                           
+                                                                                 
+! Check flag for cloud in current layer                                          
+                                                                                 
+         IF (ICLDLYR(LEV).EQ.1) THEN                                             
+                                                                                 
+! *** Cloudy layers                                                              
+         IENT = NGPT * (LEV-1)                                                   
+         DO 4000 IPR = 1, NGPT                                                   
+            INDEX = IENT + IPR                                                   
+            GASSRC = BBU(INDEX) * ABSS(INDEX)                                    
+!     Total sky radiance                                                         
+            RADLU(IPR) = RADLU(IPR) - RADLU(IPR) * (ABSS(INDEX) +    &           
+               EFCLFRAC(LEV) * (1.-ABSS(INDEX))) + GASSRC +          &
+               CLDFRAC(LEV) * (BBUTOT(INDEX) * ATOT(INDEX) - GASSRC)             
+            URAD = URAD + RADLU(IPR)                                             
+!     Clear sky radiance                                                         
+            RADCLRU(IPR) = RADCLRU(IPR) + (BBU(INDEX) - RADCLRU(IPR)) * &        
+                           ABSS(INDEX)                                           
+            CLRURAD = CLRURAD + RADCLRU(IPR)                                     
+ 4000    CONTINUE                                                                
+                                                                                 
+         ELSE                                                                    
+                                                                                 
+! *** Clear layer                                                                
+         IENT = NGPT * (LEV-1)                                                   
+         DO 4100 IPR = 1, NGPT                                                   
+            INDEX = IENT + IPR                                                   
+!     Total sky radiance                                                         
+            RADLU(IPR) = RADLU(IPR) + (BBU(INDEX)-RADLU(IPR)) *  & 
+                         ABSS(INDEX)                                             
+            URAD = URAD + RADLU(IPR)                                             
+!     Clear sky radiance                                                         
+!     Upward clear and total sky streams must remain separate because surface    
+!     reflectance is different for each.                                         
+            RADCLRU(IPR) = RADCLRU(IPR) + (BBU(INDEX) - RADCLRU(IPR))   &         
+                           * ABSS(INDEX)                                         
+            CLRURAD = CLRURAD + RADCLRU(IPR)                                     
+ 4100    CONTINUE                                                                
+                                                                                 
+         ENDIF                                                                   
+                                                                                 
+         TOTUFLUX(LEV) = URAD * WTNUM                                            
+         TOTUCLFL(LEV) = CLRURAD * WTNUM                                         
+                                                                                 
+ 5000 CONTINUE                                                                   
+                                                                                 
+                                                                                 
+! *** Convert radiances to fluxes and heating rates for total sky.  Calculates   
+!     clear sky surface and TOA values.  To compute clear sky profiles, uncommen 
+!     relevant lines below.                                                      
+      TOTUFLUX(0) = TOTUFLUX(0) * FLUXFAC                                        
+      TOTDFLUX(0) = TOTDFLUX(0) * FLUXFAC                                        
+      FNET(0) = TOTUFLUX(0) - TOTDFLUX(0)                                        
+      TOTUCLFL(0) = TOTUCLFL(0) * FLUXFAC                                        
+      TOTDCLFL(0) = TOTDCLFL(0) * FLUXFAC                                        
+      FNETC(0) = TOTUCLFL(0) - TOTDCLFL(0)                                       
+      CLRNTTOA = TOTUCLFL(NLAYERS)                                               
+      CLRNTSRF = TOTUFLUX(0) - TOTDCLFL(0)                                       
+                                                                                 
+      DO 7000 LEV = 1, NLAYERS                                                   
+         TOTUFLUX(LEV) = TOTUFLUX(LEV) * FLUXFAC                                 
+         TOTDFLUX(LEV) = TOTDFLUX(LEV) * FLUXFAC                                 
+         FNET(LEV) = TOTUFLUX(LEV) - TOTDFLUX(LEV)                               
+         TOTUCLFL(LEV) = TOTUCLFL(LEV) * FLUXFAC                                 
+         TOTDCLFL(LEV) = TOTDCLFL(LEV) * FLUXFAC                                 
+         FNETC(LEV) = TOTUCLFL(LEV) - TOTDCLFL(LEV)                              
+         L = LEV - 1                                                             
+!     Calculate Heating Rates.                                                   
+         HTR(L) = HEATFAC * (FNET(L) - FNET(LEV)) / (PZ(L) - PZ(LEV))            
+         HTRC(L) = HEATFAC * (FNETC(L) - FNETC(LEV)) / (PZ(L) - PZ(LEV))         
+ 7000 CONTINUE                                                                   
+      HTR(NLAYERS) = 0.0                                                         
+      HTRC(NLAYERS) = 0.0                                                        
+                                                                                 
+
+      END  SUBROUTINE RTRN
+
+!---------------------------------------------------------------------------
+      SUBROUTINE GASABS(kts,ktep1,                                         &
+                        COLDRY,COLH2O,COLCO2,COLO3,COLN2O,COLCH4,          &
+                        COLO2,CO2MULT,                                     &
+                        FAC00,FAC01,FAC10,FAC11,                           &
+                        FORFAC,SELFFAC,SELFFRAC,                           &
+                        JP,JT,JT1,INDSELF,ITR,WX,PFRAC,TAUG,               &
+                        LAYTROP,LAYSWTCH,LAYLOW                            )
+!---------------------------------------------------------------------------
+!  RRTM Longwave Radiative Transfer Model                                        
+!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
+!                                                                                
+!  Original version:       E. J. Mlawer, et al.                                  
+!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
+!                                                                                
+!  This routine calculates the gaseous optical depths for all 16 longwave        
+!  spectral bands.  The optical depths are used to define the Pade               
+!  approximation to the function of tau transition from tranparancy to           
+!  opacity.  This function, which varies from 0 to 1, is converted to an         
+!  integer that will serve as an index for the lookup tables of tau              
+!  transition function and transmittance used in the radiative transfer.         
+!  These lookup tables are created on initialization in routine RRTMINIT.        
+!---------------------------------------------------------------------------
+!                                                                                
+! Definitions                                                                    
+!    NGPT                         ! Total number of g-point subintervals         
+!    MXLAY                        ! Maximum number of model layers               
+!    SECANG                       ! Diffusivity angle for flux computation       
+!    TAU(NGPT,MXLAY)              ! Gaseous optical depths                       
+!    NLAYERS                      ! Number of model layers used in RRTM          
+!    PAVEL(MXLAY)                 ! Model layer pressures (mb)                   
+!    PZ(0:MXLAY)                  ! Model level (interface) pressures (mb)       
+!    TAVEL(MXLAY)                 ! Model layer temperatures (K)                 
+!    TZ(0:MXLAY)                  ! Model level (interface) temperatures (K)     
+!    TBOUND                       ! Surface temperature (K)                      
+!    BPADE                        ! Pade approximation constant (=1./0.278)      
+!    ITR(NGPT,MXLAY)              ! Integer lookup table index                   
+!                                                                                
+! Parameters                              
+
+      IMPLICIT NONE
+                                       
+      REAL, PARAMETER :: SECANG=1.66                                                    
+
+      INTEGER, INTENT(IN )   ::  kts,ktep1
+      INTEGER, INTENT(IN )   ::  LAYTROP,LAYSWTCH,LAYLOW
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                  &
+            INTENT(INOUT)        ::                PFRAC
+
+      REAL, DIMENSION( NGPT,kts:ktep1 ),                  &
+            INTENT(INOUT)        ::                 TAUG
+
+      REAL, DIMENSION( MAXXSEC,kts:ktep1 ),               &
+            INTENT(IN   )        ::                   WX
+
+      INTEGER, DIMENSION( NGPT,kts:ktep1 ),               &
+               INTENT(INOUT)  ::                     ITR
+
+      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::      &
+                                                  COLDRY, &  
+                                                  COLH2O, &
+                                                  COLCO2, &
+                                                   COLO3, &
+                                                  COLN2O, &
+                                                  COLCH4, &
+                                                   COLO2, &
+                                                 CO2MULT, &
+                                                   FAC00, &
+                                                   FAC01, &
+                                                   FAC10, &
+                                                   FAC11, &
+                                                  FORFAC, &
+                                                 SELFFAC, &
+                                                SELFFRAC
+ 
+      INTEGER, DIMENSION( kts:ktep1 ), INTENT(INOUT) ::   &
+                                                      JP, &
+                                                      JT, &
+                                                     JT1, &
+                                                 INDSELF
+
+      INTEGER :: lay,ipr
+      REAL    :: odepth,tff
+
+! This compiler directive was added to insure private common block storage       
+! in multi-tasked mode on a CRAY or SGI for all commons except those that        
+! carry constants.                                                               
+                                                                                 
+! **************************************************************************     
+
+!  Calculate optical depth for each band                                         
+     
+      CALL TAUGB1(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,              &
+                  FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,  &
+                  LAYTROP)
+      CALL TAUGB2(kts,ktep1,COLDRY,COLH2O,FAC00,FAC01,FAC10,FAC11,       &
+                  FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,  &
+                  LAYTROP)
+      CALL TAUGB3(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,FAC11,&
+                  FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,  &
+                  LAYTROP)
+      CALL TAUGB4(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,FAC11, &
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
+                  LAYTROP)
+      CALL TAUGB5(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,FAC11, &
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,      &
+                  LAYTROP)
+      CALL TAUGB6(kts,ktep1,COLH2O,CO2MULT,FAC00,FAC01,FAC10,FAC11,      &
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,      &
+                  LAYTROP)
+      CALL TAUGB7(kts,ktep1,COLH2O,COLO3,CO2MULT,FAC00,FAC01,FAC10,FAC11,&
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
+                  LAYTROP)
+      CALL TAUGB8(kts,ktep1,COLH2O,COLO3,COLN2O,CO2MULT,FAC00,FAC01,FAC10,&
+                  FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,&
+                  LAYSWTCH)
+      CALL TAUGB9(kts,ktep1,COLH2O,COLN2O,COLCH4,FAC00,FAC01,FAC10,FAC11,&
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
+                  LAYTROP,LAYSWTCH,LAYLOW)
+      CALL TAUGB10(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
+                  PFRAC,TAUG,LAYTROP)
+      CALL TAUGB11(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,             &
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
+                  LAYTROP)
+      CALL TAUGB12(kts,ktep1,COLH2O,COLCO2,FAC00,FAC01,FAC10,FAC11,      &
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
+                  LAYTROP)
+      CALL TAUGB13(kts,ktep1,COLH2O,COLN2O,FAC00,FAC01,FAC10,FAC11,      &
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
+                  LAYTROP)
+      CALL TAUGB14(kts,ktep1,COLCO2,FAC00,FAC01,FAC10,FAC11,             &
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
+                  LAYTROP)
+      CALL TAUGB15(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,FAC11,&
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
+                  LAYTROP)
+      CALL TAUGB16(kts,ktep1,COLH2O,COLCH4,FAC00,FAC01,FAC10,FAC11,      &
+                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
+                  LAYTROP)
+                                                                                 
+!  Compute the lookup table index from the Pade approximation of the             
+!  tau transition function, which is derived from the optical depth.             
+                                                                                 
+      DO 6000 LAY = 1, NLAYERS                                                   
+         DO 5000 IPR = 1, NGPT                                                   
+            ODEPTH = SECANG * TAUG(IPR,LAY)                                       
+            TFF = ODEPTH/(BPADE+ODEPTH)                                           
+            IF (ODEPTH.LE.0.) TFF=0.                                              
+            ITR(IPR,LAY) = INT(5.E3*TFF+0.5)
+ 5000    CONTINUE                                                                
+ 6000 CONTINUE                                                                   
+      
+   END SUBROUTINE GASABS
+
+!====================================================================
+   SUBROUTINE rrtminit(                                             &
+                       allowed_to_read ,                            &
+                       ids, ide, jds, jde, kds, kde,                &
+                       ims, ime, jms, jme, kms, kme,                &
+                       its, ite, jts, jte, kts, kte                 )
+!--------------------------------------------------------------------
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+
+   LOGICAL , INTENT(IN)           :: allowed_to_read
+   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,  &
+                                     ims, ime, jms, jme, kms, kme,  &
+                                     its, ite, jts, jte, kts, kte
+
+   REAL :: pi
+
+   PI = 2.*ASIN(1.) 
+   FLUXFAC  = PI   * 2.D4                     
+   NLAYERS = kme
+
+   IF ( allowed_to_read ) THEN
+     CALL rrtm_lookuptable
+   ENDIF
+
+   END SUBROUTINE rrtminit
+
+
+! **************************************************************************     
+      SUBROUTINE rrtm_lookuptable
+! **************************************************************************     
+
+USE module_wrf_error
+USE module_dm
+IMPLICIT NONE
+
+!  RRTM Longwave Radiative Transfer Model                                        
+!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
+!                                                                                
+!  Original version:       Michael J. Iacono; July, 1998                         
+!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
+!                                                                                
+!  This subroutine performs calculations necessary for the initialization        
+!  of the LW model, RRTM.  Lookup tables are computed for use in the LW          
+!  radiative transfer, and input absorption coefficient data for each            
+!  spectral band are reduced from 256 g-points to 140 for use in RRTM.           
+! **************************************************************************     
+                                                                                 
+! Definitions                                                                    
+!     Arrays for 5000-point look-up tables:                                      
+!     TAU     Clear-sky optical depth (used in cloudy radiative transfer)        
+!     TF      Tau transition function; i.e. the transition of the Planck         
+!             function from that for the mean layer temperature to that for      
+!             the layer boundary temperature as a function of optical depth.     
+!             The "linear in tau" method is used to make the table.              
+!     TRANS   Transmittance                                                      
+!     BPADE   Inverse of the Pade approximation constant (= 1./0.278)            
+
+! Local                                    
+      INTEGER :: i,itre,igcsm,ibnd,igc,ind,ig,ipr,iprsm
+      REAL :: tfn,fp,rtfp,wtsum                                        
+      LOGICAL                 :: opened
+      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+
+      REAL :: WTSM(MG)                       
+      CHARACTER*80 errmess
+      INTEGER rrtm_unit
+
+      IF ( wrf_dm_on_monitor() ) THEN
+        DO i = 10,99
+          INQUIRE ( i , OPENED = opened )
+          IF ( .NOT. opened ) THEN
+            rrtm_unit = i
+            GOTO 2010
+          ENDIF
+        ENDDO
+        rrtm_unit = -1
+ 2010   CONTINUE
+      ENDIF
+      CALL wrf_dm_bcast_bytes ( rrtm_unit , IWORDSIZE )
+      IF ( rrtm_unit < 0 ) THEN
+        CALL wrf_error_fatal ( 'module_ra_rrtm: rrtm_lookuptable: Can not '// &
+                               'find unused fortran unit to read in lookup table.' )
+      ENDIF
+
+! start data 1
+
+! **************************************************************************     
+!  RRTM Longwave Radiative Transfer Model                                        
+!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
+!                                                                                
+!  Original version:       E. J. Mlawer, et al.                                  
+!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
+!                                                                                
+!  This routine contains 16 READ statements that include the                
+!  absorption coefficients and other data for each of the 16 longwave            
+!  spectral bands used in RRTM.  Here, the data are defined for 16               
+!  g-points, or sub-intervals, per band.  These data are combined and            
+!  weighted using a mapping procedure in routine RRTMINIT to reduce              
+!  the total number of g-points from 256 to 140 for use in the CCM.              
+! **************************************************************************     
+#ifdef G95
+! JRB hardwire unit to 98 to ensure it is read big endian by g95
+      rrtm_unit=98
+#endif
+        IF ( wrf_dm_on_monitor() ) THEN
+          OPEN(rrtm_unit,FILE='RRTM_DATA',                  &
+               FORM='UNFORMATTED',STATUS='OLD',ERR=9009)
+        ENDIF
+                                                                                 
+!     The array abscoefL1 contains absorption coefs at the 16 chosen g-values   
+!     for a range of pressure levels > ~100mb and temperatures.  The first       
+!     index in the array, JT, which runs from 1 to 5, corresponds to     
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the corresponding TREF for this  pressure level,              
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30,            
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
+!     index, JP, runs from 1 to 13 and refers to the corresponding               
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
+!     The third index, IG, goes from 1 to 16, and tells us which                 
+!     g-interval the absorption coefficients are for.                            
+
+
+                                                                                 
+!     The array abscoefH1 contains absorption coefs at the 16 chosen g-values           
+!     for a range of pressure levels < ~100mb and temperatures. The first        
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the reference temperature TREF for this pressure              
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
+!     The second index, JP, runs from 13 to 59 and refers to the JPth            
+!     reference pressure level (see taumol.f for the value of these              
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
+!     and tells us which g-interval the absorption coefficients are for.         
+
+                                                                                 
+!     The array SELFREF1 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL1, abscoefH1, SELFREF1
+         DM_BCAST_MACRO(abscoefL1)
+         DM_BCAST_MACRO(abscoefH1)
+         DM_BCAST_MACRO(SELFREF1)
+
+! **************************************************************************     
+!     The array abscoefL2 contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first       
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the corresponding TREF for this  pressure level, &           
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
+!     index, JP, runs from 1 to 13 and refers to the corresponding               
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
+!     The third index, IG, goes from 1 to 16, and tells us which                 
+!     g-interval the absorption coefficients are for.                            
+
+                                                                                 
+!     The array abscoefH2 contains absorption coefs at the 16 chosen g-values           
+!     for a range of pressure levels < ~100mb and temperatures. The first        
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the reference temperature TREF for this pressure              
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
+!     The second index, JP, runs from 13 to 59 and refers to the JPth            
+!     reference pressure level (see taumol.f for the value of these              
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
+!     and tells us which g-interval the absorption coefficients are for.         
+
+                                                                                 
+!     The array SELFREF2 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL2, abscoefH2, SELFREF2
+         DM_BCAST_MACRO(abscoefL2)
+         DM_BCAST_MACRO(abscoefH2)
+         DM_BCAST_MACRO(SELFREF2)
+                                                                                 
+! **************************************************************************     
+
+!     The array abscoefL3 contains absorption coefs for each of the 16 g-intervals   
+!     for a range of pressure levels > ~100mb, temperatures, and ratios          
+!     of water vapor to CO2.  The first index in the array, JS, runs             
+!     from 1 to 10, and corresponds to different water vapor to CO2 ratios, &   
+!     as expressed through the binary species parameter eta, defined as          
+!     eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated    
+!     line strength in the band of co2 to that of h2o.  For instance, &         
+!     JS=1 refers to dry air (eta = 0), JS = 10 corresponds to eta = 1.0.        
+!     The 2nd index in the array, JT, which runs from 1 to 5, corresponds        
+!     to different temperatures.  More specifically, JT = 3 means that the       
+!     data are for the reference temperature TREF for this  pressure             
+!     level, JT = 2 refers to the temperature                                    
+!     TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5          
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
+!     to the reference pressure level (e.g. JP = 1 is for a                      
+!     pressure of 1053.63 mb).  The fourth index, IG, goes from 1 to 16, &      
+!     and tells us which g-interval the absorption coefficients are for.         
+
+                                                                                 
+!     The array abscoefH3 contains absorption coefs for each of the 16 g-intervals      
+!     for a range of pressure levels  < ~100mb, temperatures, and ratios         
+!     of H2O to CO2.  The first index in the array, JS, runs from 1 to 5, &     
+!     and corresponds to different H2O to CO2 ratios, as expressed through       
+!     the binary species parameter eta, defined as eta = H2O/(H2O+RAT*CO2), &   
+!     where RAT is the ratio of the integrated line strength in the band         
+!     of CO2 to that of H2O.  For instance, JS=1 refers to no H2O, &            
+!     JS = 2 corresponds to eta = 0.25, etc.  The second index, JT, which        
+!     runs from 1 to 5, corresponds to different temperatures.  More             
+!     specifically, JT = 3 means that the data are for the corresponding         
+!     reference temperature TREF for this  pressure level, JT = 2 refers         
+!     to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and          
+!     JT = 5 is for TREF+30.  The third index, JP, runs from 13 to 59 and        
+!     refers to the corresponding pressure level in PREF (e.g. JP = 13 is        
+!     for a pressure of 95.5835 mb).  The fourth index, IG, goes from 1 to       
+!     16, and tells us which g-interval the absorption coefficients are for.     
+
+                                                                                 
+!     The array SELFREF3 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL3, abscoefH3, SELFREF3
+         DM_BCAST_MACRO(abscoefL3)
+         DM_BCAST_MACRO(abscoefH3)
+         DM_BCAST_MACRO(SELFREF3)
+                                                                                 
+! **************************************************************************     
+                                                                                 
+!     The array abscoefL4 contains absorption coefs for each of the 16 g-intervals      
+!     for a range of pressure levels > ~100mb, temperatures, and ratios          
+!     of water vapor to CO2.  The first index in the array, JS, runs             
+!     from 1 to 9 and corresponds to different water vapor to CO2 ratios, &     
+!     as expressed through the binary species parameter eta, defined as          
+!     eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated    
+!     line strength in the band of co2 to that of h2o.  For instance, &         
+!     JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0.         
+!     The 2nd index in the array, JT, which runs from 1 to 5, corresponds        
+!     to different temperatures.  More specifically, JT = 3 means that the       
+!     data are for the reference temperature TREF for this pressure              
+!     level, JT = 2 refers to the temperature TREF-15, &                        
+!     JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5                   
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
+!     to the reference pressure level (e.g. JP = 1 is for a                      
+!     pressure of 1053.63 mb).  The fourth index, IG, goes from 1 to 16, &      
+!     and tells us which g-interval the absorption coefficients are for.         
+
+                                                                                 
+!     The array abscoefH4 contains absorption coefs for each of the 16 g-intervals      
+!     for a range of pressure levels  < ~100mb, temperatures, and ratios         
+!     of O3 to CO2.  The first index in the array, JS, runs from 1 to 6, &      
+!     and corresponds to different O3 to CO2 ratios, as expressed through        
+!     the binary species parameter eta, defined as eta = O3/(O3+RAT*H2O), &     
+!     where RAT is the ratio of the integrated line strength in the band         
+!     of CO2 to that of O3.  For instance, JS=1 refers to no O3 (eta = 0)        
+!     and JS = 5 corresponds to eta = 1.0.  The second index, JT, which          
+!     runs from 1 to 5, corresponds to different temperatures.  More             
+!     specifically, JT = 3 means that the data are for the corresponding         
+!     reference temperature TREF for this  pressure level, JT = 2 refers         
+!     to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and          
+!     JT = 5 is for TREF+30.  The third index, JP, runs from 13 to 59 and        
+!     refers to the corresponding pressure level in PREF (e.g. JP = 13 is        
+!     for a pressure of 95.5835 mb).  The fourth index, IG, goes from 1 to       
+!     16, and tells us which g-interval the absorption coefficients are for.     
+
+                                                                                 
+!     The array SELFREF4 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL4, abscoefH4, SELFREF4
+         DM_BCAST_MACRO(abscoefL4)
+         DM_BCAST_MACRO(abscoefH4)
+         DM_BCAST_MACRO(SELFREF4)
+                                                                                 
+! **************************************************************************     
+                                                                                 
+!     The array abscoefL5 contains absorption coefs for each of the 16 g-intervals
+!     for a range of pressure levels > ~100mb, temperatures, and ratios          
+!     of water vapor to CO2.  The first index in the array, JS, runs             
+!     from 1 to 9 and corresponds to different water vapor to CO2 ratios, &     
+!     as expressed through the binary species parameter eta, defined as          
+!     eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated    
+!     line strength in the band of co2 to that of h2o.  For instance, &         
+!     JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0.         
+!     The 2nd index in the array, JT, which runs from 1 to 5, corresponds        
+!     to different temperatures.  More specifically, JT = 3 means that the       
+!     data are for the reference temperature TREF for this  pressure             
+!     level, JT = 2 refers to the temperature TREF-15, &                        
+!     JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5                   
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
+!     to the reference pressure level (e.g. JP = 1 is for a                      
+!     pressure of 1053.63 mb).  The fourth index, IG, goes from 1 to 16, &      
+!     and tells us which g-interval the absorption coefficients are for.         
+
+                                                                                 
+!     The array abscoefH5 contains absorption coefs for each of the 16 g-intervals      
+!     for a range of pressure levels  < ~100mb, temperatures, and ratios         
+!     of O3 to CO2.  The first index in the array, JS, runs from 1 to 5, &      
+!     and corresponds to different O3 to CO2 ratios, as expressed through        
+!     the binary species parameter eta, defined as eta = O3/(O3+RAT*CO2), &     
+!     where RAT is the ratio of the integrated line strength in the band         
+!     of co2 to that of O3.  For instance, JS=1 refers to no O3 (eta = 0)        
+!     and JS = 5 corresponds to eta = 1.0.  The second index, JT, which          
+!     runs from 1 to 5, corresponds to different temperatures.  More             
+!     specifically, JT = 3 means that the data are for the corresponding         
+!     reference temperature TREF for this  pressure level, JT = 2 refers         
+!     to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and          
+!     JT = 5 is for TREF+30.  The third index, JP, runs from 13 to 59 and        
+!     refers to the corresponding pressure level in PREF (e.g. JP = 13 is        
+!     for a pressure of 95.5835 mb).  The fourth index, IG, goes from 1 to       
+!     16, and tells us which g-interval the absorption coefficients are for.     
+
+                                                                                 
+!     The array SELFREF5 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL5, abscoefH5, SELFREF5
+         DM_BCAST_MACRO(abscoefL5)
+         DM_BCAST_MACRO(abscoefH5)
+         DM_BCAST_MACRO(SELFREF5)
+                                                                                 
+! **************************************************************************     
+                                                                                 
+!     The array abscoefL6 contains absorption coefs at the 16 chosen g-values    
+!     for a range of pressure levels > ~100mb and temperatures.  The first       
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the corresponding TREF for this  pressure level, &           
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
+!     index, JP, runs from 1 to 13 and refers to the corresponding               
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
+!     The third index, IG, goes from 1 to 16, and tells us which                 
+!     g-interval the absorption coefficients are for.                            
+
+                                                                                 
+!     The array SELFREF6 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL6, SELFREF6
+         DM_BCAST_MACRO(abscoefL6)
+         DM_BCAST_MACRO(SELFREF6)
+                                                                                 
+! **************************************************************************     
+                                                                                 
+!     The array abscoefL7 contains absorption coefs at the 16 chosen g-values           
+!     for a range of pressure levels> ~100mb, temperatures, and binary           
+!     species parameters (see taumol.f for definition).  The first               
+!     index in the array, JS, runs from 1 to 9, and corresponds to               
+!     different values of the binary species parameter.  For instance, &        
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
+!     in the array, JT, which runs from 1 to 5, corresponds to different         
+!     temperatures.  More specifically, JT = 3 means that the data are for       
+!     the reference temperature TREF for this  pressure level, JT = 2 refers     
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
+!     to the JPth reference pressure level (see taumol.f for these levels        
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
+!     which g-interval the absorption coefficients are for.                      
+
+                                                                                 
+!     The array abscoefH7 contains absorption coefs at the 16 chosen g-values           
+!     for a range of pressure levels < ~100mb and temperatures. The first        
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the reference temperature TREF for this pressure              
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
+!     The second index, JP, runs from 13 to 59 and refers to the JPth            
+!     reference pressure level (see taumol.f for the value of these              
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
+!     and tells us which g-interval the absorption coefficients are for.         
+
+                                                                                 
+!     The array SELFREF7 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL7, abscoefH7, SELFREF7
+         DM_BCAST_MACRO(abscoefL7)
+         DM_BCAST_MACRO(abscoefH7)
+         DM_BCAST_MACRO(SELFREF7)
+                                                                                 
+! **************************************************************************
+                                                                                 
+!     The array abscoefL8 contains absorption coefs at the 16 chosen g-values    
+!     for a range of pressure levels > ~100mb and temperatures.  The first       
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the corresponding TREF for this  pressure level, &           
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
+!     index, JP, runs from 1 to 13 and refers to the corresponding               
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
+!     The third index, IG, goes from 1 to 16, and tells us which                 
+!     g-interval the absorption coefficients are for.                            
+!     The array abscoefL8 contains absorption coef5s at the 16 chosen g-values          
+!     for a range of pressure levels > ~100mb and temperatures.  The first       
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the cooresponding TREF for this  pressure level, &           
+!     JT = 2 refers to the temperature                                           
+!     TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5          
+!     is for TREF+30.  The second index, JP, runs from 1 to 13 and refers        
+!     to the corresponding pressure level in PREF (e.g. JP = 1 is for a          
+!     pressure of 1053.63 mb).  The third index, IG, goes from 1 to 16, &       
+!     and tells us which "g-channel" the absorption coefficients are for.        
+
+                                                                                 
+!     The array abscoefH8 contains absorption coefs at the 16 chosen g-values           
+!     for a range of pressure levels < ~100mb and temperatures. The first        
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the reference temperature TREF for this pressure              
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
+!     The second index, JP, runs from 13 to 59 and refers to the JPth            
+!     reference pressure level (see taumol.f for the value of these              
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
+!     and tells us which g-interval the absorption coefficients are for.         
+
+!                                                                                
+!       SELFREF8 is the array for the self-continuum.                                   
+!                                                                                
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL8, abscoefH8, SELFREF8
+         DM_BCAST_MACRO(abscoefL8)
+         DM_BCAST_MACRO(abscoefH8)
+         DM_BCAST_MACRO(SELFREF8)
+                                                                                 
+! **************************************************************************
+                                                                                 
+!     The array abscoefL9 contains absorption coefs at the 16 chosen g-values    
+!     for a range of pressure levels> ~100mb, temperatures, and binary           
+!     species parameters (see taumol.f for definition).  The first               
+!     index in the array, JS, runs from 1 to 11, and corresponds to              
+!     different values of the binary species parameter.  For instance, &        
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
+!     in the array, JT, which runs from 1 to 5, corresponds to different         
+!     temperatures.  More specifically, JT = 3 means that the data are for       
+!     the reference temperature TREF for this  pressure level, JT = 2 refers     
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
+!     to the JPth reference pressure level (see taumol.f for these levels        
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
+!     which g-interval the absorption coefficients are for.                      
+
+                                                                                 
+!     The array abscoefH9 contains absorption coefs at the 16 chosen g-values           
+!     for a range of pressure levels < ~100mb and temperatures. The first        
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the reference temperature TREF for this pressure              
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
+!     The second index, JP, runs from 13 to 59 and refers to the JPth            
+!     reference pressure level (see taumol.f for the value of these              
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
+!     and tells us which g-interval the absorption coefficients are for.         
+
+                                                                                 
+!     The array SELFREF9 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL9, abscoefH9, SELFREF9
+         DM_BCAST_MACRO(abscoefL9)
+         DM_BCAST_MACRO(abscoefH9)
+         DM_BCAST_MACRO(SELFREF9)
+                                                                                 
+! **************************************************************************
+                                                                                 
+!     The array abscoefL10 contains absorption coefs at the 16 chosen g-values   
+!     for a range of pressure levels > ~100mb and temperatures.  The first       
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the corresponding TREF for this  pressure level, &           
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
+!     index, JP, runs from 1 to 13 and refers to the corresponding               
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
+!     The third index, IG, goes from 1 to 16, and tells us which                 
+!     g-interval the absorption coefficients are for.                            
+
+                                                                                 
+!     The array abscoefH10 contains absorption coefs at the 16 chosen g-values           
+!     for a range of pressure levels < ~100mb and temperatures. The first        
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the reference temperature TREF for this pressure              
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
+!     The second index, JP, runs from 13 to 59 and refers to the JPth            
+!     reference pressure level (see taumol.f for the value of these              
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
+!     and tells us which g-interval the absorption coefficients are for.         
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL10, abscoefH10
+         DM_BCAST_MACRO(abscoefL10)
+         DM_BCAST_MACRO(abscoefH10)
+                                                                                 
+! **************************************************************************
+                                                                                 
+!     The array abscoefL11 contains absorption coefs at the 16 chosen g-values   
+!     for a range of pressure levels > ~100mb and temperatures.  The first       
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the corresponding TREF for this  pressure level, &           
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
+!     index, JP, runs from 1 to 13 and refers to the corresponding               
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
+!     The third index, IG, goes from 1 to 16, and tells us which                 
+!     g-interval the absorption coefficients are for.                            
+
+                                                                                 
+!     The array abscoefH11 contains absorption coefs at the 16 chosen g-values           
+!     for a range of pressure levels < ~100mb and temperatures. The first        
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the reference temperature TREF for this pressure              
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
+!     The second index, JP, runs from 13 to 59 and refers to the JPth            
+!     reference pressure level (see taumol.f for the value of these              
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
+!     and tells us which g-interval the absorption coefficients are for.         
+
+                                                                                 
+!     The array SELFREF11 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL11, abscoefH11, SELFREF11
+         DM_BCAST_MACRO(abscoefL11)
+         DM_BCAST_MACRO(abscoefH11)
+         DM_BCAST_MACRO(SELFREF11)
+                                                                                        
+! **************************************************************************
+                                                                                 
+!     The array abscoefL12 contains absorption coefs at the 16 chosen g-values   
+!     for a range of pressure levels> ~100mb, temperatures, and binary           
+!     species parameters (see taumol.f for definition).  The first               
+!     index in the array, JS, runs from 1 to 9, and corresponds to               
+!     different values of the binary species parameter.  For instance, &        
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
+!     in the array, JT, which runs from 1 to 5, corresponds to different         
+!     temperatures.  More specifically, JT = 3 means that the data are for       
+!     the reference temperature TREF for this  pressure level, JT = 2 refers     
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
+!     to the JPth reference pressure level (see taumol.f for these levels        
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
+!     which g-interval the absorption coefficients are for.                      
+
+                                                                                 
+!     The array SELFREF12 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL12, SELFREF12
+         DM_BCAST_MACRO(abscoefL12)
+         DM_BCAST_MACRO(SELFREF12)
+                                                                                 
+! **************************************************************************
+                                                                                 
+!     The array abscoefL13 contains absorption coefs at the 16 chosen g-values   
+!     for a range of pressure levels> ~100mb, temperatures, and binary           
+!     species parameters (see taumol.f for definition).  The first               
+!     index in the array, JS, runs from 1 to 9, and corresponds to               
+!     different values of the binary species parameter.  For instance, &        
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
+!     in the array, JT, which runs from 1 to 5, corresponds to different         
+!     temperatures.  More specifically, JT = 3 means that the data are for       
+!     the reference temperature TREF for this  pressure level, JT = 2 refers     
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
+!     to the JPth reference pressure level (see taumol.f for these levels        
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
+!     which g-interval the absorption coefficients are for.                      
+
+                                                                                 
+!     The array SELFREF13 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL13, SELFREF13
+         DM_BCAST_MACRO(abscoefL13)
+         DM_BCAST_MACRO(SELFREF13)
+                                                                                 
+! **************************************************************************
+                                                                                 
+!     The array abscoefL14 contains absorption coefs at the 16 chosen g-values   
+!     for a range of pressure levels > ~100mb and temperatures.  The first       
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the corresponding TREF for this  pressure level, &           
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
+!     index, JP, runs from 1 to 13 and refers to the corresponding               
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
+!     The third index, IG, goes from 1 to 16, and tells us which                 
+!     g-interval the absorption coefficients are for.                            
+
+                                                                                 
+!     The array abscoefH14 contains absorption coefs at the 16 chosen g-values           
+!     for a range of pressure levels < ~100mb and temperatures. The first        
+!     index in the array, JT, which runs from 1 to 5, corresponds to             
+!     different temperatures.  More specifically, JT = 3 means that the          
+!     data are for the reference temperature TREF for this pressure              
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
+!     The second index, JP, runs from 13 to 59 and refers to the JPth            
+!     reference pressure level (see taumol.f for the value of these              
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
+!     and tells us which g-interval the absorption coefficients are for.         
+
+                                                                                 
+!     The array SELFREF14 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL14, abscoefH14, SELFREF14
+         DM_BCAST_MACRO(abscoefL14)
+         DM_BCAST_MACRO(abscoefH14)
+         DM_BCAST_MACRO(SELFREF14)
+                                                                                        
+! **************************************************************************
+                                                                                 
+!     The array abscoefL15 contains absorption coefs at the 16 chosen g-values   
+!     for a range of pressure levels> ~100mb, temperatures, and binary           
+!     species parameters (see taumol.f for definition).  The first               
+!     index in the array, JS, runs from 1 to 9, and corresponds to               
+!     different values of the binary species parameter.  For instance, &        
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
+!     in the array, JT, which runs from 1 to 5, corresponds to different         
+!     temperatures.  More specifically, JT = 3 means that the data are for       
+!     the reference temperature TREF for this  pressure level, JT = 2 refers     
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
+!     to the JPth reference pressure level (see taumol.f for these levels        
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
+!     which g-interval the absorption coefficients are for.                      
+
+                                                                                 
+!     The array SELFREF15 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL15, SELFREF15
+         DM_BCAST_MACRO(abscoefL15)
+         DM_BCAST_MACRO(SELFREF15)
+                                                                                 
+! **************************************************************************
+                                                                                 
+!     The array abscoefL16 contains absorption coefs at the 16 chosen g-values  
+!     for a range of pressure levels> ~100mb, temperatures, and binary           
+!     species parameters (see taumol.f for definition).  The first               
+!     index in the array, JS, runs from 1 to 9, and corresponds to               
+!     different values of the binary species parameter.  For instance, &        
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
+!     in the array, JT, which runs from 1 to 5, corresponds to different         
+!     temperatures.  More specifically, JT = 3 means that the data are for       
+!     the reference temperature TREF for this  pressure level, JT = 2 refers     
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
+!     to the JPth reference pressure level (see taumol.f for these levels        
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
+!     which g-interval the absorption coefficients are for.                      
+
+                                                                                 
+!     The array SELFREF16 contains the coefficient of the water vapor              
+!     self-continuum (including the energy term).  The first index               
+!     refers to temperature in 7.2 degree increments.  For instance, &          
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
+!     etc.  The second index runs over the g-channel (1 to 16).                  
+
+         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL16, SELFREF16
+         DM_BCAST_MACRO(abscoefL16)
+         DM_BCAST_MACRO(SELFREF16)
+
+         IF ( wrf_dm_on_monitor() ) CLOSE (rrtm_unit)
+                                                                                 
+!-----------------------------------------------------------------------
+                                                            
+                
+                                                                           
+!  Compute lookup tables for transmittance, tau transition function,             
+!  and clear sky tau (for the cloudy sky radiative transfer).  Tau is            
+!  computed as a function of the tau transition function, transmittance          
+!  is calculated as a function of tau, and the tau transition function           
+!  is calculated using the linear in tau formulation at values of tau            
+!  above 0.01.  TF is approximated as tau/6 for tau < 0.01.  All tables          
+!  are computed at intervals of 0.001.  The inverse of the constant used         
+!  in the Pade approximation to the tau transition function is set to b.         
+                                                                                 
+      TAU(0) = 0.0                                                               
+      TAU(5000) = 1.E10                                                          
+      TRANS(0) = 1.0                                                             
+      TRANS(5000) = 0.0                                                          
+      TF(0) = 0.0                                                                
+      TF(5000) = 1.0                                                             
+      BPADE=1./0.278                                                             
+      DO 1000 ITRE = 1,4999                                                       
+         TFN = ITRE/5.E3                                                          
+         TAU(ITRE) = BPADE*TFN/(1.-TFN)                                           
+         TRANS(ITRE) = EXP(-TAU(ITRE))                                             
+         IF (TAU(ITRE).LT.0.1) THEN                                               
+            TF(ITRE) = TAU(ITRE)/6.                                                
+         ELSE                                                                    
+            TF(ITRE) = 1.-2.*((1./TAU(ITRE))-(TRANS(ITRE)/(1.-TRANS(ITRE))))         
+         ENDIF                                                                   
+ 1000 CONTINUE                                                                   
+!  Calculate lookup tables for functions needed in routine TAUMOL (TAUGB2)       
+      CORR1(0) = 1.                                                              
+      CORR1(200) = 1.                                                            
+      CORR2(0) = 1.                                                              
+      CORR2(200) = 1.                                                            
+      DO 1200 I = 1,199                                                          
+         FP = 0.005*FLOAT(I)                                                     
+         RTFP = SQRT(FP)                                                         
+         CORR1(I) = RTFP/FP                                                      
+         CORR2(I) = (1.-RTFP)/(1.-FP)                                            
+ 1200 CONTINUE                                                                   
+                                                                                 
+!  Perform g-point reduction from 16 per band (256 total points) to              
+!  a band dependant number (140 total points) for all absorption                 
+!  coefficient input data and Planck fraction input data.                        
+!  Compute relative weighting for new g-point combinations.                      
+                                                                                 
+      IGCSM = 0                                                                  
+      DO 500 IBND = 1,NBANDS                                                     
+         IPRSM = 0                                                               
+         IF (NGC(IBND).LT.16) THEN                                               
+            DO 450 IGC = 1,NGC(IBND)                                             
+               IGCSM = IGCSM + 1                                                 
+               WTSUM = 0.                                                        
+               DO 420 IPR = 1, NGN(IGCSM)                                        
+                  IPRSM = IPRSM + 1                                              
+                  WTSUM = WTSUM + WT(IPRSM)                                      
+ 420           CONTINUE                                                          
+               WTSM(IGC) = WTSUM                                                 
+ 450        CONTINUE                                                             
+            DO 400 IG = 1,NG(IBND)                                               
+               IND = (IBND-1)*16 + IG                                            
+               RWGT(IND) = WT(IG)/WTSM(NGM(IND))                                 
+ 400        CONTINUE                                                             
+         ELSE                                                                    
+            DO 300 IG = 1,NG(IBND)                                               
+               IGCSM = IGCSM + 1                                                 
+               IND = (IBND-1)*16 + IG                                            
+               RWGT(IND) = 1.0                                                   
+ 300        CONTINUE                                                             
+         ENDIF                                                                   
+ 500  CONTINUE                                                                   
+                                                                                 
+!  Reduce g-points for relevant data in each LW spectral band.                   
+                                                                                 
+      CALL CMBGB1 (abscoefL1,   abscoefH1,  SELFREF1,                   &
+                   FRACREFA1,   FRACREFB1,  FORREF1,                    &
+                   SELFREFC1,  FORREFC1, FRACREFAC1,                    &
+                   FRACREFBC1   &
+                  )
+      CALL CMBGB2 (abscoefL2,   abscoefH2,  SELFREF2,                   &
+                   FRACREFA2,   FRACREFB2,  FORREF2,                    &
+                   SELFREFC2,  FORREFC2, FRACREFAC2,                    &
+                   FRACREFBC2   &
+                  )
+      CALL CMBGB3 (abscoefL3,   abscoefH3,  SELFREF3,                   &
+                   FRACREFA3,   FRACREFB3,                              &
+                   FORREF3,     ABSN2OA3,   ABSN2OB3,                   &
+                   SELFREFC3,  FORREFC3,                                &
+                   ABSN2OAC3,   ABSN2OBC3,  FRACREFAC3, FRACREFBC3      &
+                  )
+      CALL CMBGB4 (abscoefL4,   abscoefH4,  SELFREF4,                   &
+                   FRACREFA4,   FRACREFB4,                              &
+                   SELFREFC4,  FRACREFAC4, FRACREFBC4                   &
+                  )
+      CALL CMBGB5 (abscoefL5,   abscoefH5,  SELFREF5,                   &
+                   FRACREFA5,   FRACREFB5,  CCL45,                      &
+                   SELFREFC5,  CCL4C5, FRACREFAC5,                      &
+                   FRACREFBC5   &
+                  )
+      CALL CMBGB6 (abscoefL6,               SELFREF6,                   &
+                   FRACREFA6,   ABSCO26,    CFC11ADJ6, CFC126,          &
+                   SELFREFC6, ABSCO2C6, CFC11ADJC6, CFC12C6,            &
+                   FRACREFAC6   &
+                  )
+      CALL CMBGB7 (abscoefL7,   abscoefH7,  SELFREF7,                   &
+                   FRACREFA7,   FRACREFB7,  ABSCO27,                    &
+                   SELFREFC7,  ABSCO2C7, FRACREFAC7,                    &
+                   FRACREFBC7   &
+                  )
+      CALL CMBGB8 (abscoefL8,   abscoefH8,  SELFREF8,                   &
+                   FRACREFA8,   FRACREFB8,  ABSCO2A8, ABSCO2B8,         &
+                   ABSN2OA8,    ABSN2OB8,   CFC128,   CFC22ADJ8,        &
+                   SELFREFC8,  ABSCO2AC8, ABSCO2BC8,                    &
+                   ABSN2OAC8,   ABSN2OBC8,  CFC12C8,   CFC22ADJC8,      &
+                   FRACREFAC8, FRACREFBC8                               &
+                  )
+      CALL CMBGB9 (abscoefL9,   abscoefH9,  SELFREF9,                   &
+                   FRACREFA9,   FRACREFB9,  ABSN2O9,                    &
+                   SELFREFC9,  ABSN2OC9, FRACREFAC9,                    &
+                   FRACREFBC9                                           &
+                  )  
+      CALL CMBGB10(abscoefL10, abscoefH10,                              &
+                   FRACREFA10, FRACREFB10,                              &
+                   FRACREFAC10, FRACREFBC10                             &
+                  )
+      CALL CMBGB11(abscoefL11, abscoefH11, SELFREF11,                   &
+                   FRACREFA11, FRACREFB11,                              &
+                   SELFREFC11,  FRACREFAC11,                            &
+                   FRACREFBC11  &
+                  )
+      CALL CMBGB12(abscoefL12,             SELFREF12,                   &
+                   FRACREFA12,                                          &
+                   SELFREFC12, FRACREFAC12                              &
+                  )
+      CALL CMBGB13(abscoefL13,             SELFREF13,                   &
+                   FRACREFA13,                                          &
+                   SELFREFC13, FRACREFAC13                              &
+                  )
+      CALL CMBGB14(abscoefL14, abscoefH14, SELFREF14,                   &
+                   FRACREFA14, FRACREFB14,                              &
+                   SELFREFC14, FRACREFAC14,                             &
+                   FRACREFBC14 &
+                  )
+      CALL CMBGB15(abscoefL15,             SELFREF15,                   &
+                   FRACREFA15,                                          &
+                   SELFREFC15, FRACREFAC15                              &
+                  )
+      CALL CMBGB16(abscoefL16,             SELFREF16,                   &
+                   FRACREFA16,                                          &
+                   SELFREFC16, FRACREFAC16                              &
+                  )
+      RETURN
+9009 CONTINUE
+     WRITE( errmess , '(A,I4)' ) 'module_ra_rrtm: error opening RRTM_DATA on unit ',rrtm_unit
+     CALL wrf_error_fatal(errmess)
+     RETURN
+9010 CONTINUE
+     WRITE( errmess , '(A,I4)' ) 'module_ra_rrtm: error reading RRTM_DATA on unit ',rrtm_unit
+     CALL wrf_error_fatal(errmess)
+      END SUBROUTINE rrtm_lookuptable
+
+!------------------------------------------------------------------
+
+END MODULE module_ra_rrtm
Index: trunk/WRF.COMMON/WRFV2/phys/module_ra_sw.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_ra_sw.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_ra_sw.F	(revision 2744)
@@ -0,0 +1,488 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+MODULE module_ra_sw
+
+      REAL,PRIVATE,SAVE :: CSSCA
+
+CONTAINS
+
+!------------------------------------------------------------------
+   SUBROUTINE SWRAD(dt,RTHRATEN,GSW,XLAT,XLONG,ALBEDO,            &
+                    rho_phy,T3D,QV3D,QC3D,QR3D,                   &
+                    QI3D,QS3D,QG3D,P3D,pi3D,dz8w,GMT,             &
+                    R,CP,G,JULDAY,                                &
+                    XTIME,DECLIN,SOLCON,                          &
+                    F_QV,F_QC,F_QR,F_QI,F_QS,F_QG,                &
+                    pm2_5_dry,pm2_5_water,pm2_5_dry_ec,           &
+                    RADFRQ,ICLOUD,DEGRAD,warm_rain,               &
+                    ids,ide, jds,jde, kds,kde,                    & 
+                    ims,ime, jms,jme, kms,kme,                    &
+                    its,ite, jts,jte, kts,kte,                    &
+                    cosz_urb2d,omg_urb2d                          & !Optional urban
+                    )
+!------------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------------
+   INTEGER,    INTENT(IN   ) ::        ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte
+
+   LOGICAL,    INTENT(IN   ) ::        warm_rain
+   INTEGER,    INTENT(IN   ) ::        icloud
+
+   REAL, INTENT(IN    )      ::        RADFRQ,DEGRAD,             &
+                                       XTIME,DECLIN,SOLCON
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(IN    ) ::                                   P3D, &
+                                                            pi3D, &
+                                                         rho_phy, &
+                                                            dz8w, &
+                                                             T3D
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL ,       &
+         INTENT(IN    ) ::                             pm2_5_dry, &
+                                                     pm2_5_water, &
+                                                    pm2_5_dry_ec
+
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(INOUT)  ::                              RTHRATEN
+!
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(IN   )  ::                                  XLAT, &
+                                                           XLONG, &
+                                                          ALBEDO
+!
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(INOUT)  ::                                   GSW
+!
+   REAL, INTENT(IN   )   ::                        GMT,R,CP,G,dt
+!
+   INTEGER, INTENT(IN  ) ::                               JULDAY  
+!
+! Optional
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         OPTIONAL,                                                &
+         INTENT(IN    ) ::                                        &
+                                                            QV3D, &
+                                                            QC3D, &
+                                                            QR3D, &
+                                                            QI3D, &
+                                                            QS3D, &
+                                                            QG3D
+
+   LOGICAL, OPTIONAL, INTENT(IN )      ::        F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
+ 
+! LOCAL VARS
+ 
+   REAL, DIMENSION( kts:kte ) ::                                  &
+                                                          TTEN1D, &
+                                                          RHO01D, &
+                                                             P1D, &
+                                                              DZ, &
+                                                             T1D, &
+                                                            QV1D, &
+                                                            QC1D, &
+                                                            QR1D, &
+                                                            QI1D, &
+                                                            QS1D, &
+                                                            QG1D
+!
+   REAL::      XLAT0,XLONG0,ALB0,GSW0
+
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme), INTENT(OUT) :: COSZ_URB2D, OMG_URB2D !Optional urban
+   REAL :: COSZ, OMG   !urban
+!
+   INTEGER :: i,j,K,NK
+   LOGICAL :: predicate
+   real :: aer_dry1(kts:kte),aer_water1(kts:kte)
+
+!------------------------------------------------------------------
+   j_loop: DO J=jts,jte
+   i_loop: DO I=its,ite
+
+! reverse vars 
+         DO K=kts,kte
+            QV1D(K)=0.
+            QC1D(K)=0.
+            QR1D(K)=0.
+            QI1D(K)=0.
+            QS1D(K)=0.
+            QG1D(K)=0.
+         ENDDO
+
+         DO K=kts,kte
+            NK=kme-1-K+kms
+            TTEN1D(K)=0.
+
+            T1D(K)=T3D(I,NK,J)
+            P1D(K)=P3D(I,NK,J)
+            RHO01D(K)=rho_phy(I,NK,J)
+            DZ(K)=dz8w(I,NK,J)
+         ENDDO
+
+         IF( PRESENT(pm2_5_dry) .AND. PRESENT(pm2_5_water) )THEN
+            DO K=kts,kte
+               NK=kme-1-K+kms
+               aer_dry1(k)   = pm2_5_dry(i,nk,j)
+               aer_water1(k) = pm2_5_water(i,nk,j)
+            ENDDO
+         ELSE
+            DO K=kts,kte
+               aer_dry1(k)   = 0.
+               aer_water1(k) = 0.
+            ENDDO
+         ENDIF
+
+         IF (PRESENT(F_QV) .AND. PRESENT(QV3D)) THEN
+            IF (F_QV) THEN
+               DO K=kts,kte
+                  NK=kme-1-K+kms
+                  QV1D(K)=QV3D(I,NK,J)
+                  QV1D(K)=max(0.,QV1D(K))
+               ENDDO
+            ENDIF
+         ENDIF
+
+         IF (PRESENT(F_QC) .AND. PRESENT(QC3D)) THEN
+            IF (F_QC) THEN
+               DO K=kts,kte
+                  NK=kme-1-K+kms
+                  QC1D(K)=QC3D(I,NK,J)
+                  QC1D(K)=max(0.,QC1D(K))
+               ENDDO
+            ENDIF
+         ENDIF
+
+         IF (PRESENT(F_QR) .AND. PRESENT(QR3D)) THEN
+            IF (F_QR) THEN
+               DO K=kts,kte
+                  NK=kme-1-K+kms
+                  QR1D(K)=QR3D(I,NK,J)
+                  QR1D(K)=max(0.,QR1D(K))
+               ENDDO
+            ENDIF
+         ENDIF
+
+!
+         IF ( PRESENT( F_QI ) ) THEN
+            predicate = F_QI
+         ELSE
+            predicate = .FALSE.
+         ENDIF
+
+         IF ( predicate .AND. PRESENT( QI3D ) ) THEN
+            DO K=kts,kte
+               NK=kme-1-K+kms
+               QI1D(K)=QI3D(I,NK,J)
+               QI1D(K)=max(0.,QI1D(K))
+            ENDDO
+         ELSE
+            IF (.not. warm_rain) THEN
+               DO K=kts,kte
+               IF(T1D(K) .lt. 273.15) THEN
+                  QI1D(K)=QC1D(K)
+                  QC1D(K)=0.
+                  QS1D(K)=QR1D(K)
+                  QR1D(K)=0.
+               ENDIF
+               ENDDO
+            ENDIF
+         ENDIF
+
+         IF (PRESENT(F_QS) .AND. PRESENT(QS3D)) THEN
+            IF (F_QS) THEN
+               DO K=kts,kte          
+                  NK=kme-1-K+kms
+                  QS1D(K)=QS3D(I,NK,J)
+                  QS1D(K)=max(0.,QS1D(K))
+               ENDDO
+            ENDIF
+         ENDIF
+
+         IF (PRESENT(F_QG) .AND. PRESENT(QG3D)) THEN
+            IF (F_QG) THEN
+               DO K=kts,kte          
+                  NK=kme-1-K+kms
+                  QG1D(K)=QG3D(I,NK,J)
+                  QG1D(K)=max(0.,QG1D(K))
+               ENDDO
+            ENDIF
+         ENDIF
+
+         XLAT0=XLAT(I,J)
+         XLONG0=XLONG(I,J)
+         ALB0=ALBEDO(I,J)
+
+         CALL SWPARA(TTEN1D,GSW0,XLAT0,XLONG0,ALB0,              &
+                     T1D,QV1D,QC1D,QR1D,QI1D,QS1D,QG1D,P1D,      &
+                     XTIME,GMT,RHO01D,DZ,                        &
+                     R,CP,G,DECLIN,SOLCON,                       &
+                     COSZ, OMG,                                  & !urban
+                     RADFRQ,ICLOUD,DEGRAD,aer_dry1,aer_water1,   &
+                     kts,kte                                     )
+
+       IF (PRESENT(COSZ_URB2D) .AND.  PRESENT(OMG_URB2D)) THEN   
+         COSZ_URB2D(I,J)=COSZ !urban
+         OMG_URB2D(I,J)=OMG !urban
+       ENDIF
+
+         GSW(I,J)=GSW0
+         DO K=kts,kte          
+            NK=kme-1-K+kms
+            RTHRATEN(I,K,J)=RTHRATEN(I,K,J)+TTEN1D(NK)/pi3D(I,K,J)
+         ENDDO
+!
+   ENDDO i_loop
+   ENDDO j_loop                                          
+
+   END SUBROUTINE SWRAD
+
+!------------------------------------------------------------------
+   SUBROUTINE SWPARA(TTEN,GSW,XLAT,XLONG,ALBEDO,                  &
+                     T,QV,QC,QR,QI,QS,QG,P,            		  &
+                     XTIME, GMT, RHO0, DZ,             		  &
+                     R,CP,G,DECLIN,SOLCON,             		  &
+                     COSZ, OMG,                                   & !urban
+                     RADFRQ,ICLOUD,DEGRAD,aer_dry1,aer_water1,    &
+                     kts,kte                            	  )
+!------------------------------------------------------------------
+!     TO CALCULATE SHORT-WAVE ABSORPTION AND SCATTERING IN CLEAR
+!     AIR AND REFLECTION AND ABSORPTION IN CLOUD LAYERS (STEPHENS,
+!     1984)
+!     CHANGES:
+!       REDUCE EFFECTS OF ICE CLOUDS AND PRECIP ON LIQUID WATER PATH
+!       ADD EFFECT OF GRAUPEL
+!------------------------------------------------------------------
+
+  IMPLICIT NONE
+
+  INTEGER, INTENT(IN ) ::                 kts,kte
+!
+  REAL, DIMENSION( kts:kte ), INTENT(IN   )  ::                   &
+                                                            RHO0, &
+                                                               T, &
+                                                               P, &
+                                                              DZ, &
+                                                              QV, &
+                                                              QC, &
+                                                              QR, &
+                                                              QI, &
+                                                              QS, &
+                                                              QG
+
+   REAL, DIMENSION( kts:kte ), INTENT(INOUT)::              TTEN
+!
+   REAL, INTENT(IN  )   ::               XTIME,GMT,R,CP,G,DECLIN, &
+                                        SOLCON,XLAT,XLONG,ALBEDO, &
+                                                  RADFRQ, DEGRAD
+!
+   INTEGER, INTENT(IN) :: icloud
+   REAL, INTENT(INOUT)  ::                                   GSW
+!
+! LOCAL VARS
+!
+   REAL, DIMENSION( kts:kte+1 ) ::                         SDOWN
+
+   REAL, DIMENSION( kts:kte )   ::                          XLWP, &
+						            XATP, &
+						            XWVP, &
+                                             aer_dry1,aer_water1, &
+						              RO
+!
+   REAL, DIMENSION( 4, 5 ) ::                             ALBTAB, &
+                                                          ABSTAB
+
+   REAL, DIMENSION( 4    ) ::                             XMUVAL
+
+   REAL, INTENT(OUT)    ::                                  COSZ   !urban
+   REAL, INTENT(OUT)    ::                                  OMG    !urban
+
+   REAL :: beta
+
+!------------------------------------------------------------------
+
+      DATA ALBTAB/0.,0.,0.,0., &
+           69.,58.,40.,15.,    &
+           90.,80.,70.,60.,    &
+           94.,90.,82.,78.,    &
+           96.,92.,85.,80./
+
+      DATA ABSTAB/0.,0.,0.,0., &
+           0.,2.5,4.,5.,       &
+           0.,2.6,7.,10.,      &
+           0.,3.3,10.,14.,     &
+           0.,3.7,10.,15./
+
+      DATA XMUVAL/0.,0.2,0.5,1.0/
+
+      REAL :: bext340, absc, alba, alw, csza,dabsa,dsca,dabs
+      REAL :: bexth2o, dscld, hrang,ff,oldalb,oldabs,oldabc
+      REAL :: soltop, totabs, tloctm, ugcm, uv,xabs,xabsa,wv
+      REAL :: wgm, xalb, xi, xsca, xt24,xmu,xabsc,trans0,yj
+      REAL :: xxlat,ww
+      INTEGER :: iil,ii,jjl,ju,k,iu
+
+      GSW=0.0
+      bext340=5.E-6
+      bexth2o=5.E-6
+      SOLTOP=SOLCON
+      XT24=MOD(XTIME+RADFRQ*0.5,1440.)
+      TLOCTM=GMT+XT24/60.+XLONG/15.
+      HRANG=15.*(TLOCTM-12.)*DEGRAD
+      XXLAT=XLAT*DEGRAD
+      CSZA=SIN(XXLAT)*SIN(DECLIN)+COS(XXLAT)*COS(DECLIN)*COS(HRANG)
+
+      COSZ = CSZA  !urban
+      OMG  = HRANG !urban
+
+!     RETURN IF NIGHT
+      IF(CSZA.LE.1.E-9)GOTO 7
+!
+      DO K=kts, kte
+
+! P in the unit of 10mb
+         RO(K)=P(K)/(R*T(K))
+         XWVP(K)=RO(K)*QV(K)*DZ(K)*1000.
+! KG/M**2
+          XATP(K)=RO(K)*DZ(K)
+      ENDDO
+!
+!     G/M**2
+!     REDUCE WEIGHT OF LIQUID AND ICE IN SHORT-WAVE SCHEME
+!     ADD GRAUPEL EFFECT (ASSUMED SAME AS RAIN)
+!
+      IF (ICLOUD.EQ.0)THEN
+         DO K=kts, kte
+            XLWP(K)=0.
+         ENDDO
+      ELSE
+         DO K=kts, kte
+            XLWP(K)=RO(K)*1000.*DZ(K)*(QC(K)+0.1*QI(K)+0.05* &
+                    QR(K)+0.02*QS(K)+0.05*QG(K))
+         ENDDO
+      ENDIF
+!
+      XMU=CSZA
+      SDOWN(1)=SOLTOP*XMU
+!     SET WW (G/M**2) LIQUID WATER PATH INTEGRATED DOWN
+!     SET UV (G/M**2) WATER VAPOR PATH INTEGRATED DOWN
+      WW=0.
+      UV=0.
+      OLDALB=0.
+      OLDABC=0.
+      TOTABS=0.
+!     CONTRIBUTIONS DUE TO CLEAR AIR AND CLOUD
+      DSCA=0.
+      DABS=0.
+      DSCLD=0.
+!
+! CONTRIBUTION DUE TO AEROSOLS (FOR CHEMISTRY)
+      DABSA=0.
+!
+      DO 200 K=kts,kte
+         WW=WW+XLWP(K)
+         UV=UV+XWVP(K)
+!     WGM IS WW/COS(THETA) (G/M**2)
+!     UGCM IS UV/COS(THETA) (G/CM**2)
+         WGM=WW/XMU
+         UGCM=UV*0.0001/XMU
+!
+         OLDABS=TOTABS
+!     WATER VAPOR ABSORPTION AS IN LACIS AND HANSEN (1974)
+         TOTABS=2.9*UGCM/((1.+141.5*UGCM)**0.635+5.925*UGCM)
+!     APPROXIMATE RAYLEIGH + AEROSOL SCATTERING
+!        XSCA=1.E-5*XATP(K)/XMU
+!          XSCA=(1.E-5*XATP(K)+aer_dry1(K)*bext340+aer_water1(K)*bexth2o)/XMU
+         beta=0.4*(1.0-XMU)+0.1
+!     CSSCA - CLEAR-SKY SCATTERING SET FROM NAMELIST SWRAD_SCAT
+         XSCA=(cssca*XATP(K)+beta*aer_dry1(K)*bext340*DZ(K) &
+              +beta*aer_water1(K)*bexth2o*DZ(K))/XMU   
+
+!     LAYER VAPOR ABSORPTION DONE FIRST
+         XABS=(TOTABS-OLDABS)*(SDOWN(1)-DSCLD-DSCA-DABSA)/SDOWN(K)
+!rs   AEROSOL ABSORB (would be elemental carbon). So far XABSA = 0.
+         XABSA=0.
+         IF(XABS.LT.0.)XABS=0.
+!
+         ALW=ALOG10(WGM+1.)
+         IF(ALW.GT.3.999)ALW=3.999
+!
+         DO II=1,3
+            IF(XMU.GT.XMUVAL(II))THEN
+              IIL=II
+              IU=II+1
+              XI=(XMU-XMUVAL(II))/(XMUVAL(II+1)-XMUVAL(II))+FLOAT(IIL)
+            ENDIF
+         ENDDO
+!
+         JJL=IFIX(ALW)+1
+         JU=JJL+1
+         YJ=ALW+1.
+!     CLOUD ALBEDO
+         ALBA=(ALBTAB(IU,JU)*(XI-IIL)*(YJ-JJL)   &
+              +ALBTAB(IIL,JU)*(IU-XI)*(YJ-JJL)   &
+              +ALBTAB(IU,JJL)*(XI-IIL)*(JU-YJ)   &
+              +ALBTAB(IIL,JJL)*(IU-XI)*(JU-YJ))  &
+             /((IU-IIL)*(JU-JJL))
+!     CLOUD ABSORPTION
+         ABSC=(ABSTAB(IU,JU)*(XI-IIL)*(YJ-JJL)   &
+              +ABSTAB(IIL,JU)*(IU-XI)*(YJ-JJL)   &
+              +ABSTAB(IU,JJL)*(XI-IIL)*(JU-YJ)   &
+              +ABSTAB(IIL,JJL)*(IU-XI)*(JU-YJ))  &
+             /((IU-IIL)*(JU-JJL))
+!     LAYER ALBEDO AND ABSORPTION
+         XALB=(ALBA-OLDALB)*(SDOWN(1)-DSCA-DABS)/SDOWN(K)
+         XABSC=(ABSC-OLDABC)*(SDOWN(1)-DSCA-DABS)/SDOWN(K)
+         IF(XALB.LT.0.)XALB=0.
+         IF(XABSC.LT.0.)XABSC=0.
+         DSCLD=DSCLD+(XALB+XABSC)*SDOWN(K)*0.01
+         DSCA=DSCA+XSCA*SDOWN(K)
+         DABS=DABS+XABS*SDOWN(K)
+         DABSA=DABSA+XABSA*SDOWN(K)
+         OLDALB=ALBA
+         OLDABC=ABSC
+!     LAYER TRANSMISSIVITY
+         TRANS0=100.-XALB-XABSC-XABS*100.-XSCA*100.
+         IF(TRANS0.LT.1.)THEN
+           FF=99./(XALB+XABSC+XABS*100.+XSCA*100.)
+           XALB=XALB*FF
+           XABSC=XABSC*FF
+           XABS=XABS*FF
+           XSCA=XSCA*FF
+           TRANS0=1.
+         ENDIF
+         SDOWN(K+1)=AMAX1(1.E-9,SDOWN(K)*TRANS0*0.01)
+         TTEN(K)=SDOWN(K)*(XABSC+XABS*100.+XABSA*100.)*0.01/( &
+                 RO(K)*CP*DZ(K))
+  200   CONTINUE
+!
+        GSW=(1.-ALBEDO)*SDOWN(kte+1)
+
+    7 CONTINUE
+!
+   END SUBROUTINE SWPARA
+
+!====================================================================
+   SUBROUTINE swinit(swrad_scat,                                    &
+                     allowed_to_read ,                              &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte                   )
+!--------------------------------------------------------------------
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+   LOGICAL , INTENT(IN)           :: allowed_to_read 
+   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,  &
+                                     ims, ime, jms, jme, kms, kme,  &
+                                     its, ite, jts, jte, kts, kte
+
+   REAL , INTENT(IN)              :: swrad_scat
+
+!     CSSCA - CLEAR-SKY SCATTERING SET FROM NAMELIST SWRAD_SCAT
+   cssca = swrad_scat * 1.e-5
+
+   END SUBROUTINE swinit
+
+END MODULE module_ra_sw
Index: trunk/WRF.COMMON/WRFV2/phys/module_radiation_driver.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_radiation_driver.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_radiation_driver.F	(revision 2744)
@@ -0,0 +1,1270 @@
+!WRF:MEDIATION_LAYER:PHYSICS
+!
+MODULE module_radiation_driver
+CONTAINS
+!BOP
+! !IROUTINE: radiation_driver - interface to radiation physics options
+
+! !INTERFACE:
+   SUBROUTINE radiation_driver (                                          &
+               itimestep,dt ,lw_physics,sw_physics ,NPHS                  &
+              ,RTHRATENLW ,RTHRATENSW ,RTHRATEN                           &
+              ,ACSWUPT,ACSWUPTC,ACSWDNT,ACSWDNTC                          & ! Optional
+              ,ACSWUPB,ACSWUPBC,ACSWDNB,ACSWDNBC                          & ! Optional
+              ,ACLWUPT,ACLWUPTC,ACLWDNT,ACLWDNTC                          & ! Optional
+              ,ACLWUPB,ACLWUPBC,ACLWDNB,ACLWDNBC                          & ! Optional
+              ,  SWUPT,  SWUPTC,  SWDNT,  SWDNTC                          & ! Optional
+              ,  SWUPB,  SWUPBC,  SWDNB,  SWDNBC                          & ! Optional
+              ,  LWUPT,  LWUPTC,  LWDNT,  LWDNTC                          & ! Optional
+              ,  LWUPB,  LWUPBC,  LWDNB,  LWDNBC                          & ! Optional
+              ,LWCF,SWCF,OLR                                              & ! Optional
+              ,GLW, GSW, SWDOWN, XLAT, XLONG, ALBEDO                      &
+              ,EMISS, rho, p8w, p , pi , dz8w ,t, t8w, GMT                &
+              ,XLAND, XICE, TSK, HTOP,HBOT,HTOPR,HBOTR, CUPPT, VEGFRA, SNOW     &
+              ,julyr, JULDAY, julian, xtime, RADT, STEPRA, ICLOUD, warm_rain     &
+              ,declin_urb,COSZ_URB2D, omg_urb2d                           & !Optional urban
+              ,ra_call_offset,RSWTOA,RLWTOA, CZMEAN                       &
+              ,CFRACL, CFRACM, CFRACH                                     &
+              ,ACFRST,NCFRST,ACFRCV,NCFRCV,SWDOWNC                        &
+              ,z                                                          &
+              ,levsiz, n_ozmixm, n_aerosolc, paerlev                      &
+              ,cam_abs_dim1, cam_abs_dim2, cam_abs_freq_s                 &
+              ,ozmixm,pin                                                 & ! Optional
+              ,m_ps_1,m_ps_2,aerosolc_1,aerosolc_2,m_hybi0                & ! Optional
+              ,abstot, absnxt, emstot                                     & ! Optional
+              ,taucldi, taucldc                                           & ! Optional
+              ,ids, ide, jds, jde, kds, kde                               &
+              ,ims, ime, jms, jme, kms, kme                               &
+              ,i_start, i_end                                             &
+              ,j_start, j_end                                             &
+              ,kts, kte                                                   &
+              ,num_tiles                                                  &
+              ,qv,qc,qr,qi,qs,qg                                          &
+              ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg                              &
+              ,CLDFRA ,Pb                                                 &
+              ,f_ice_phy,f_rain_phy                                       &
+              ,pm2_5_dry, pm2_5_water, pm2_5_dry_ec                       &
+              ,tauaer300, tauaer400, tauaer600, tauaer999                 & ! jcb
+              ,gaer300, gaer400, gaer600, gaer999                         & ! jcb
+              ,waer300, waer400, waer600, waer999                         & ! jcb
+              ,qc_adjust ,qi_adjust                                       & ! jm
+              ,cu_rad_feedback                                            & ! jm
+
+                                                                          )
+
+!-------------------------------------------------------------------------
+
+! !USES:
+   USE module_state_description, ONLY : RRTMSCHEME, GFDLLWSCHEME        &
+                                       ,SWRADSCHEME, GSFCSWSCHEME       &
+                                       ,GFDLSWSCHEME, CAMLWSCHEME, CAMSWSCHEME
+   USE module_model_constants
+   USE module_wrf_error
+
+! *** add new modules of schemes here
+
+   USE module_ra_sw
+   USE module_ra_gsfcsw
+   USE module_ra_rrtm
+   USE module_ra_cam
+   USE module_ra_gfdleta
+
+   !  This driver calls subroutines for the radiation parameterizations.
+   !
+   !  short wave radiation choices:
+   !  1. swrad (19??)
+   !
+   !  long wave radiation choices:
+   !  1. rrtmlwrad
+   !
+!----------------------------------------------------------------------
+   IMPLICIT NONE
+!<DESCRIPTION>
+!
+! Radiation_driver is the WRF mediation layer routine that provides the interface to
+! to radiation physics packages in the WRF model layer. The radiation
+! physics packages to call are chosen by setting the namelist variable
+! (Rconfig entry in Registry) to the integer value assigned to the 
+! particular package (package entry in Registry). For example, if the
+! namelist variable ra_lw_physics is set to 1, this corresponds to the
+! Registry Package entry for swradscheme.  Note that the Package
+! names in the Registry are defined constants (frame/module_state_description.F)
+! in the CASE statements in this routine.
+!
+! Among the arguments is moist, a four-dimensional scalar array storing
+! a variable number of moisture tracers, depending on the physics 
+! configuration for the WRF run, as determined in the namelist.  The
+! highest numbered index of active moisture tracers the integer argument
+! n_moist (note: the number of tracers at run time is the quantity
+! <tt>n_moist - PARAM_FIRST_SCALAR + 1</tt> , not n_moist. Individual tracers
+! may be indexed from moist by the Registry name of the tracer prepended
+! with P_; for example P_QC is the index of cloud water. An index 
+! represents a valid, active field only if the index is greater than
+! or equal to PARAM_FIRST_SCALAR.  PARAM_FIRST_SCALAR and the individual
+! indices for each tracer is defined in module_state_description and
+! set in <a href=set_scalar_indices_from_config.html>set_scalar_indices_from_config</a> defined in frame/module_configure.F.
+!
+! Physics drivers in WRF 2.0 and higher, originally model-layer 
+! routines, have been promoted to mediation layer routines and they
+! contain OpenMP threaded loops over tiles.  Thus, physics drivers
+! are called from single-threaded regions in the solver. The physics
+! routines that are called from the physics drivers are model-layer
+! routines and fully tile-callable and thread-safe.
+!</DESCRIPTION>
+! 
+!======================================================================
+! Grid structure in physics part of WRF
+!----------------------------------------------------------------------
+! The horizontal velocities used in the physics are unstaggered
+! relative to temperature/moisture variables. All predicted
+! variables are carried at half levels except w, which is at full
+! levels. Some arrays with names (*8w) are at w (full) levels.
+!
+!----------------------------------------------------------------------
+! In WRF, kms (smallest number) is the bottom level and kme (largest
+! number) is the top level.  In your scheme, if 1 is at the top level,
+! then you have to reverse the order in the k direction.
+!
+!         kme      -   half level (no data at this level)
+!         kme    ----- full level
+!         kme-1    -   half level
+!         kme-1  ----- full level
+!         .
+!         .
+!         .
+!         kms+2    -   half level
+!         kms+2  ----- full level
+!         kms+1    -   half level
+!         kms+1  ----- full level
+!         kms      -   half level
+!         kms    ----- full level
+!
+!======================================================================
+! Grid structure in physics part of WRF
+! 
+!-------------------------------------
+! The horizontal velocities used in the physics are unstaggered 
+! relative to temperature/moisture variables. All predicted 
+! variables are carried at half levels except w, which is at full 
+! levels. Some arrays with names (*8w) are at w (full) levels.
+!
+!==================================================================
+! Definitions
+!-----------
+! Theta      potential temperature (K)
+! Qv         water vapor mixing ratio (kg/kg)
+! Qc         cloud water mixing ratio (kg/kg)
+! Qr         rain water mixing ratio (kg/kg)
+! Qi         cloud ice mixing ratio (kg/kg)
+! Qs         snow mixing ratio (kg/kg)
+!-----------------------------------------------------------------
+!-- PM2_5_DRY     Dry PM2.5 aerosol mass for all species (ug m^-3)
+!-- PM2_5_WATER   PM2.5 water mass (ug m^-3)
+!-- PM2_5_DRY_EC  Dry PM2.5 elemental carbon aersol mass (ug m^-3)
+!-- RTHRATEN      Theta tendency 
+!                 due to radiation (K/s)
+!-- RTHRATENLW    Theta tendency 
+!                 due to long wave radiation (K/s)
+!-- RTHRATENSW    Theta temperature tendency 
+!                 due to short wave radiation (K/s)
+!-- dt            time step (s)
+!-- itimestep     number of time steps
+!-- GLW           downward long wave flux at ground surface (W/m^2)
+!-- GSW           net short wave flux at ground surface (W/m^2)
+!-- SWDOWN        downward short wave flux at ground surface (W/m^2)
+!-- SWDOWNC       clear-sky downward short wave flux at ground surface (W/m^2; optional; for AQ)
+!-- XLAT          latitude, south is negative (degree)
+!-- XLONG         longitude, west is negative (degree)
+!-- ALBEDO                albedo (between 0 and 1)
+!-- CLDFRA        cloud fraction (between 0 and 1)
+!-- EMISS         surface emissivity (between 0 and 1)
+!-- rho_phy       density (kg/m^3)
+!-- rr            dry air density (kg/m^3)
+!-- moist         moisture array (4D - last index is species) (kg/kg)
+!-- n_moist       number of moisture species
+!-- p8w           pressure at full levels (Pa)
+!-- p_phy         pressure (Pa)
+!-- Pb            base-state pressure (Pa)
+!-- pi_phy        exner function (dimensionless)
+!-- dz8w          dz between full levels (m)
+!-- t_phy         temperature (K)
+!-- t8w           temperature at full levels (K)
+!-- GMT           Greenwich Mean Time Hour of model start (hour)
+!-- JULDAY        the initial day (Julian day)
+!-- RADT          time for calling radiation (min)
+!-- ra_call_offset -1 (old) means usually just before output, 0 after
+!-- DEGRAD        conversion factor for 
+!                 degrees to radians (pi/180.) (rad/deg)
+!-- DPD           degrees per day for earth's 
+!                 orbital position (deg/day)
+!-- R_d           gas constant for dry air (J/kg/K)
+!-- CP            heat capacity at constant pressure for dry air (J/kg/K)
+!-- G             acceleration due to gravity (m/s^2)
+!-- rvovrd        R_v divided by R_d (dimensionless)
+!-- XTIME         time since simulation start (min)
+!-- DECLIN        solar declination angle (rad)
+!-- SOLCON        solar constant (W/m^2)
+!-- ids           start index for i in domain
+!-- ide           end index for i in domain
+!-- jds           start index for j in domain
+!-- jde           end index for j in domain
+!-- kds           start index for k in domain
+!-- kde           end index for k in domain
+!-- ims           start index for i in memory
+!-- ime           end index for i in memory
+!-- jms           start index for j in memory
+!-- jme           end index for j in memory
+!-- kms           start index for k in memory
+!-- kme           end index for k in memory
+!-- i_start       start indices for i in tile
+!-- i_end         end indices for i in tile
+!-- j_start       start indices for j in tile
+!-- j_end         end indices for j in tile
+!-- kts           start index for k in tile
+!-- kte           end index for k in tile
+!-- num_tiles     number of tiles
+!
+!==================================================================
+!
+   INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                                         kts,kte, &
+                                       num_tiles
+
+   INTEGER, INTENT(IN)            :: lw_physics, sw_physics
+
+   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
+     &           i_start,i_end,j_start,j_end
+
+   INTEGER,      INTENT(IN   )    ::   STEPRA,ICLOUD,ra_call_offset
+   INTEGER,      INTENT(IN   )    ::   levsiz, n_ozmixm
+   INTEGER,      INTENT(IN   )    ::   paerlev, n_aerosolc, cam_abs_dim1, cam_abs_dim2
+   REAL,      INTENT(IN   )       ::   cam_abs_freq_s
+
+   LOGICAL,      INTENT(IN   )    ::   warm_rain
+
+   REAL,      INTENT(IN   )       ::   RADT
+
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(IN   )  ::                                 XLAND, &
+                                                            XICE, &
+                                                             TSK, &
+                                                          VEGFRA, &
+                                                            SNOW 
+   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ),  OPTIONAL,    &
+          INTENT(IN   ) ::                                  OZMIXM
+
+   REAL,  DIMENSION(levsiz), OPTIONAL, INTENT(IN )  ::     PIN
+
+   REAL,  DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(IN )  ::      m_ps_1,m_ps_2
+   REAL,  DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, &
+          INTENT(IN   ) ::                       aerosolc_1, aerosolc_2
+   REAL,  DIMENSION(paerlev), OPTIONAL, &
+          INTENT(IN   ) ::                           m_hybi0
+
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(INOUT)  ::                                  HTOP, &
+                                                            HBOT, &
+                                                           HTOPR, &
+                                                           HBOTR, &
+                                                           CUPPT
+
+   INTEGER, INTENT(IN   )  ::   julyr
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(IN ) ::                                     dz8w, &
+                                                               z, &
+                                                             p8w, &
+                                                               p, &
+                                                              pi, &
+                                                               t, &
+                                                             t8w, &
+                                                             rho
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL ,       &
+         INTENT(IN ) ::  tauaer300,tauaer400,tauaer600,tauaer999, & ! jcb
+                                 gaer300,gaer400,gaer600,gaer999, & ! jcb
+                                 waer300,waer400,waer600,waer999, & ! jcb
+                                 qc_adjust, qi_adjust
+
+   LOGICAL, OPTIONAL :: cu_rad_feedback
+
+!
+! variables for aerosols (only if running with chemistry)
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL ,       &
+         INTENT(IN ) ::                                pm2_5_dry, &
+                                                     pm2_5_water, &
+                                                    pm2_5_dry_ec
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(INOUT)  ::                              RTHRATEN, &
+                                                      RTHRATENLW, &
+                                                      RTHRATENSW
+
+!  REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL ,       &
+!        INTENT(INOUT)  ::                                  SWUP, &
+!                                                           SWDN, &
+!                                                      SWUPCLEAR, &
+!                                                      SWDNCLEAR, &
+!                                                           LWUP, &
+!                                                           LWDN, &
+!                                                      LWUPCLEAR, &
+!                                                      LWDNCLEAR
+
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::&
+                      ACSWUPT,ACSWUPTC,ACSWDNT,ACSWDNTC,          &
+                      ACSWUPB,ACSWUPBC,ACSWDNB,ACSWDNBC,          &
+                      ACLWUPT,ACLWUPTC,ACLWDNT,ACLWDNTC,          &
+                      ACLWUPB,ACLWUPBC,ACLWDNB,ACLWDNBC
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::&
+                        SWUPT,  SWUPTC,  SWDNT,  SWDNTC,          &
+                        SWUPB,  SWUPBC,  SWDNB,  SWDNBC,          &
+                        LWUPT,  LWUPTC,  LWDNT,  LWDNTC,          &
+                        LWUPB,  LWUPBC,  LWDNB,  LWDNBC
+
+   REAL, DIMENSION( ims:ime, jms:jme ),          OPTIONAL ,       &
+         INTENT(INOUT)  ::                                  SWCF, &
+                                                            LWCF, &
+                                                             OLR
+
+
+!
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(IN   )  ::                                  XLAT, &
+                                                           XLONG, &
+                                                          ALBEDO, &
+                                                           EMISS
+!
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(INOUT)  ::                                   GSW, &
+                                                             GLW
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)  ::   SWDOWN
+!
+   REAL, INTENT(IN  )   ::                                GMT,dt, &
+                                                   julian, xtime
+!
+   INTEGER, INTENT(IN  ) ::                    JULDAY, itimestep
+
+   INTEGER,INTENT(IN)                                       :: NPHS
+   REAL, DIMENSION( ims:ime, jms:jme ),INTENT(OUT)          ::    &
+                                                      CFRACH,     & !Added
+                                                      CFRACL,     & !Added
+                                                      CFRACM,     & !Added
+                                                      CZMEAN        !Added
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         INTENT(INOUT)  ::                                        &
+                                                      RLWTOA,     & !Added
+                                                      RSWTOA,     & !Added
+                                                      ACFRST,     & !Added
+                                                      ACFRCV        !Added
+
+   INTEGER,DIMENSION( ims:ime, jms:jme ),INTENT(INOUT)        ::  &
+                                                          NCFRST, &  !Added
+                                                          NCFRCV     !Added
+! Optional (only used by CAM lw scheme)
+
+   REAL, DIMENSION( ims:ime, kms:kme, cam_abs_dim2, jms:jme ), OPTIONAL ,&
+         INTENT(INOUT)  ::                                  abstot
+   REAL, DIMENSION( ims:ime, kms:kme, cam_abs_dim1, jms:jme ), OPTIONAL ,&
+         INTENT(INOUT)  ::                                  absnxt
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),               OPTIONAL ,&
+         INTENT(INOUT)  ::                                  emstot
+
+!
+! Optional 
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         OPTIONAL,                                                &
+         INTENT(INOUT) ::                                 CLDFRA
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                     &
+         OPTIONAL,                                                   &
+         INTENT(IN   ) ::                                            &
+                                                          F_ICE_PHY, &
+                                                         F_RAIN_PHY
+
+   REAL, DIMENSION( ims:ime, jms:jme ),                           &
+         OPTIONAL,                                                &
+         INTENT(OUT) ::                                   SWDOWNC
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         OPTIONAL,                                                &
+         INTENT(INOUT ) ::                                        &
+                                                               pb &
+                                               ,qv,qc,qr,qi,qs,qg
+
+   LOGICAL, OPTIONAL ::             f_qv,f_qc,f_qr,f_qi,f_qs,f_qg
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         OPTIONAL,                                                &
+         INTENT(INOUT)  ::                       taucldi,taucldc
+ 
+! LOCAL  VAR
+
+   REAL, DIMENSION( ims:ime, jms:jme ) ::             GLAT,GLON
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::    CEMISS
+   REAL, DIMENSION( ims:ime, jms:jme ) ::             coszr
+
+   REAL    ::    DECLIN,SOLCON 
+   INTEGER ::    i,j,k,its,ite,jts,jte,ij
+   INTEGER ::    STEPABS
+   LOGICAL ::    gfdl_lw,gfdl_sw
+   LOGICAL ::    doabsems
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+   REAL    ::    OBECL,SINOB,SXLONG,ARG,DECDEG,                  &
+                 DJUL,RJUL,ECCFAC
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: qi_temp,qc_temp
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: qi_save,qc_save
+
+!------------------------------------------------------------------
+! urban related variables are added to declaration
+!-------------------------------------------------
+   REAL, OPTIONAL, INTENT(OUT) :: DECLIN_URB  !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme), INTENT(OUT) :: COSZ_URB2D  !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme), INTENT(OUT) :: omg_urb2d   !urban
+!------------------------------------------------------------------
+
+   if (lw_physics .eq. 0 .and. sw_physics .eq. 0)         return
+
+! ra_call_offset = -1 gives old method where radiation may be called just before output
+! ra_call_offset =  0 gives new method where radiation may be called just after output
+!                     and is also consistent with removal of offset in new XTIME
+   Radiation_step: IF (itimestep .eq. 1 .or. mod(itimestep,STEPRA) .eq. 1 + ra_call_offset) THEN
+
+! CAM-specific additional radiation frequency - cam_abs_freq_s (=21600s by default)
+     STEPABS = nint(cam_abs_freq_s/(dt*STEPRA))*STEPRA
+     IF (itimestep .eq. 1 .or. mod(itimestep,STEPABS) .eq. 1 + ra_call_offset) THEN
+       doabsems = .true.
+     ELSE
+       doabsems = .false.
+     ENDIF
+
+   gfdl_lw = .false.
+   gfdl_sw = .false.
+
+!---------------
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij ,i,j,k,its,ite,jts,jte)
+
+   DO ij = 1 , num_tiles
+     its = i_start(ij)
+     ite = i_end(ij)
+     jts = j_start(ij)
+     jte = j_end(ij)
+
+! initialize data
+
+     DO j=jts,jte
+     DO i=its,ite
+        GSW(I,J)=0.
+        GLW(I,J)=0.
+        SWDOWN(I,J)=0.
+        GLAT(I,J)=XLAT(I,J)*DEGRAD
+        GLON(I,J)=XLONG(I,J)*DEGRAD
+     ENDDO
+     ENDDO
+
+     DO j=jts,jte
+     DO k=kts,kte+1
+     DO i=its,ite
+        RTHRATEN(I,K,J)=0.
+!        SWUP(I,K,J) = 0.0
+!        SWDN(I,K,J) = 0.0
+!        SWUPCLEAR(I,K,J) = 0.0
+!        SWDNCLEAR(I,K,J) = 0.0
+!        LWUP(I,K,J) = 0.0
+!        LWDN(I,K,J) = 0.0
+!        LWUPCLEAR(I,K,J) = 0.0
+!        LWDNCLEAR(I,K,J) = 0.0
+        CEMISS(I,K,J)=0.0
+     ENDDO
+     ENDDO
+     ENDDO
+
+! temporarily modify hydrometeors (currently only done for GD scheme and WRF-Chem)
+!
+     IF ( PRESENT( cu_rad_feedback ) ) THEN
+       IF ( PRESENT( qc ) .AND. PRESENT( qc_adjust ) .AND. cu_rad_feedback ) THEN
+          DO j=jts,jte
+          DO k=kts,kte
+          DO i=its,ite
+            qc_save(i,k,j) = qc(i,k,j)
+            qc(i,k,j) = qc(i,k,j) + qc_adjust(i,k,j)
+          ENDDO
+          ENDDO
+          ENDDO
+       ENDIF
+       IF ( PRESENT( qi ) .AND. PRESENT( qi_adjust ) .AND. cu_rad_feedback ) THEN
+          DO j=jts,jte
+          DO k=kts,kte
+          DO i=its,ite
+            qi_save(i,k,j) = qi(i,k,j)
+            qi(i,k,j) = qi(i,k,j) + qi_adjust(i,k,j)
+          ENDDO
+          ENDDO
+          ENDDO
+       ENDIF
+     ENDIF
+
+
+! Fill temporary water variable depending on micro package (tgs 25 Apr 2006)
+     if(PRESENT(qc) .and. PRESENT(F_QC)) then
+        DO j=jts,jte
+        DO k=kts,kte
+        DO i=its,ite
+           qc_temp(I,K,J)=qc(I,K,J)
+        ENDDO
+        ENDDO
+        ENDDO
+     else
+        DO j=jts,jte
+        DO k=kts,kte
+        DO i=its,ite
+           qc_temp(I,K,J)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+     endif
+     if(PRESENT(qr) .and. PRESENT(F_QR)) then
+        DO j=jts,jte
+        DO k=kts,kte
+        DO i=its,ite
+           qc_temp(I,K,J) = qc_temp(I,K,J) + qr(I,K,J)
+        ENDDO
+        ENDDO
+        ENDDO
+     endif
+
+!---------------
+! Calculate constant for short wave radiation
+
+     CALL radconst(XTIME,DECLIN,SOLCON,JULIAN,               &
+                   DEGRAD,DPD                                )
+
+     if(present(DECLIN_URB))DECLIN_URB=DECLIN  ! urban
+
+     lwrad_cldfra_select: SELECT CASE(lw_physics)
+
+        CASE (GFDLLWSCHEME)
+
+!-- Do nothing, since cloud fractions (with partial cloudiness effects) 
+!-- are defined in GFDL LW/SW schemes and do not need to be initialized.
+
+        CASE (CAMLWSCHEME)
+
+     IF ( PRESENT ( CLDFRA ) .AND.                           &
+          PRESENT(F_QC) .AND. PRESENT ( F_QI ) ) THEN
+! Call to cloud fraction routine based on Randall 1994 (Hong Pan 1998)
+
+   CALL cal_cldfra2(CLDFRA,qv,qc,qi,qs,                     &
+                   F_QV,F_QC,F_QI,F_QS,t,p,                &
+                   F_ICE_PHY,F_RAIN_PHY,                   &
+                   ids,ide, jds,jde, kds,kde,              &
+                   ims,ime, jms,jme, kms,kme,              &
+                   its,ite, jts,jte, kts,kte               )
+     ENDIF
+ 
+        CASE DEFAULT
+
+     IF ( PRESENT ( CLDFRA ) .AND.                           &
+          PRESENT(F_QC) .AND. PRESENT ( F_QI ) ) THEN
+       CALL cal_cldfra(CLDFRA,qc,qi,F_QC,F_QI,               &
+                       ids,ide, jds,jde, kds,kde,            &
+                       ims,ime, jms,jme, kms,kme,            &
+                       its,ite, jts,jte, kts,kte             )
+     ENDIF
+
+     END SELECT lwrad_cldfra_select    
+
+!pjj/cray  Cray X1 cannot print from threaded region
+#ifndef crayx1
+     WRITE(wrf_err_message,*)'SOLCON=',SOLCON,DECLIN,XTIME
+     CALL wrf_debug(50,wrf_err_message)
+#endif
+
+     lwrad_select: SELECT CASE(lw_physics)
+
+        CASE (RRTMSCHEME)
+             CALL wrf_debug (100, 'CALL rrtm')
+
+             CALL RRTMLWRAD(                                        &
+                  RTHRATEN=RTHRATEN,GLW=GLW,EMISS=EMISS             &
+                 ,QV3D=QV                                           &
+                 ,QC3D=QC                                           &
+                 ,QR3D=QR                                           &
+                 ,QI3D=QI                                           &
+                 ,QS3D=QS                                           &
+                 ,QG3D=QG                                           &
+                 ,P8W=p8w,P3D=p,PI3D=pi,DZ8W=dz8w,T3D=t             &
+                 ,T8W=t8w,RHO3D=rho, CLDFRA3D=CLDFRA,R=R_d,G=G      &
+                 ,F_QV=F_QV,F_QC=F_QC,F_QR=F_QR                     &
+                 ,F_QI=F_QI,F_QS=F_QS,F_QG=F_QG                     &
+                 ,ICLOUD=icloud,WARM_RAIN=warm_rain                 &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &     
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+
+        CASE (GFDLLWSCHEME)
+
+             CALL wrf_debug (100, 'CALL gfdllw')
+
+             IF ( PRESENT(F_QV) .AND. PRESENT(F_QC) .AND.                     &
+                  PRESENT(F_QS) .AND. PRESENT(qs)   .AND.                     &
+                  PRESENT(qv)   .AND. PRESENT(qc)   ) THEN
+               IF ( F_QV .AND. F_QC .AND. F_QS) THEN
+                 gfdl_lw  = .true.
+                 CALL ETARA(                                        &
+                  DT=dt,XLAND=xland                                 &
+                 ,P8W=p8w,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,T=t         &
+                 ,QV=qv,QW=qc_temp,QI=qi,QS=qs                      &
+                 ,TSK2D=tsk,GLW=GLW,RSWIN=SWDOWN,GSW=GSW            &
+                 ,RSWINC=SWDOWNC,CLDFRA=CLDFRA,PI3D=pi              &
+                 ,GLAT=glat,GLON=glon,HTOP=htop,HBOT=hbot           &
+                 ,HBOTR=hbotr, HTOPR=htopr                          &
+                 ,ALBEDO=albedo,CUPPT=cuppt                         &
+                 ,VEGFRA=vegfra,SNOW=snow,G=g,GMT=gmt               &
+                 ,NSTEPRA=stepra,NPHS=nphs,ITIMESTEP=itimestep      &
+                 ,XTIME=xtime,JULIAN=julian                         &
+                 ,COSZ_URB2D=COSZ_URB2D  ,OMG_URB2D=omg_urb2d       &
+                 ,JULYR=julyr,JULDAY=julday                         &
+                 ,GFDL_LW=gfdl_lw,GFDL_SW=gfdl_sw                   &
+                 ,CFRACL=cfracl,CFRACM=cfracm,CFRACH=cfrach         &
+                 ,ACFRST=acfrst,NCFRST=ncfrst                       &
+                 ,ACFRCV=acfrcv,NCFRCV=ncfrcv                       &
+                 ,RSWTOA=rswtoa,RLWTOA=rlwtoa,CZMEAN=czmean         &
+                 ,THRATEN=rthraten,THRATENLW=rthratenlw             &
+                 ,THRATENSW=rthratensw                              &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &     
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+               ELSE
+                 CALL wrf_error_fatal('Can not call ETARA (1a). Missing moisture fields.')
+               ENDIF
+             ELSE
+               CALL wrf_error_fatal('Can not call ETARA (1b). Missing moisture fields.')
+             ENDIF
+        CASE (CAMLWSCHEME)
+             CALL wrf_debug(100, 'CALL camrad lw')
+             IF(cam_abs_dim1 .ne. 4 .or. cam_abs_dim2 .ne. kde .or.  &
+                paerlev .ne. 29 .or. levsiz .ne. 59 )THEN
+               WRITE( wrf_err_message , * ) &
+'set paerlev=29, levsiz=59, cam_abs_dim1=4, and cam_abs_dim2=number of levels (e_vert) in physics namelist for CAM radiation'
+               CALL wrf_error_fatal ( wrf_err_message )
+             ENDIF
+             IF ( PRESENT( OZMIXM ) .AND. PRESENT( PIN ) .AND. &
+                  PRESENT(M_PS_1) .AND. PRESENT(M_PS_2) .AND.  &
+                  PRESENT(M_HYBI0) .AND. PRESENT(AEROSOLC_1)    &
+                  .AND. PRESENT(AEROSOLC_2) ) THEN
+             CALL CAMRAD(RTHRATENLW=RTHRATEN,RTHRATENSW=RTHRATENSW,    &
+                     SWUPT=SWUPT,SWUPTC=SWUPTC,                        &
+                     SWDNT=SWDNT,SWDNTC=SWDNTC,                        &
+                     LWUPT=LWUPT,LWUPTC=LWUPTC,                        &
+                     LWDNT=LWDNT,LWDNTC=LWDNTC,                        &
+                     SWUPB=SWUPB,SWUPBC=SWUPBC,                        &
+                     SWDNB=SWDNB,SWDNBC=SWDNBC,                        &
+                     LWUPB=LWUPB,LWUPBC=LWUPBC,                        &
+                     LWDNB=LWDNB,LWDNBC=LWDNBC,                        &
+                     SWCF=SWCF,LWCF=LWCF,OLR=OLR,CEMISS=CEMISS,        &
+                     TAUCLDC=TAUCLDC,TAUCLDI=TAUCLDI,COSZR=COSZR,      &
+                     GSW=GSW,GLW=GLW,XLAT=XLAT,XLONG=XLONG,            &
+                     ALBEDO=ALBEDO,t_phy=t,TSK=TSK,EMISS=EMISS         &
+                    ,QV3D=qv                                           &
+                    ,QC3D=qc                                           &
+                    ,QR3D=qr                                           &
+                    ,QI3D=qi                                           &
+                    ,QS3D=qs                                           &
+                    ,QG3D=qg                                           &
+                    ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                     &
+                    ,F_QI=f_qi,F_QS=f_qs,F_QG=f_qg                     &
+                    ,f_ice_phy=f_ice_phy,f_rain_phy=f_rain_phy         &
+                    ,p_phy=p,p8w=p8w,z=z,pi_phy=pi,rho_phy=rho,        &
+                     dz8w=dz8w,                                        &
+                     CLDFRA=CLDFRA,XLAND=XLAND,XICE=XICE,SNOW=SNOW,    &
+                     ozmixm=ozmixm,pin0=pin,levsiz=levsiz,             &
+                     num_months=n_ozmixm,                              &
+                     m_psp=m_ps_1,m_psn=m_ps_2,aerosolcp=aerosolc_1,   &
+                     aerosolcn=aerosolc_2,m_hybi0=m_hybi0,             &
+                     paerlev=paerlev, naer_c=n_aerosolc,               &
+                     cam_abs_dim1=cam_abs_dim1, cam_abs_dim2=cam_abs_dim2, &
+                     GMT=GMT,JULDAY=JULDAY,JULIAN=JULIAN,DT=DT,XTIME=XTIME,DECLIN=DECLIN,  &
+                     SOLCON=SOLCON,RADT=RADT,DEGRAD=DEGRAD,n_cldadv=3  &
+                   ,abstot_3d=abstot,absnxt_3d=absnxt,emstot_3d=emstot &
+                   ,doabsems=doabsems                               &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &     
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+             ELSE
+                CALL wrf_error_fatal ( 'arguments not present for calling cam radiation' )
+             ENDIF
+        CASE DEFAULT
+  
+             WRITE( wrf_err_message , * ) 'The longwave option does not exist: lw_physics = ', lw_physics
+             CALL wrf_error_fatal ( wrf_err_message )
+           
+     END SELECT lwrad_select    
+
+     IF (lw_physics .gt. 0 .and. .not.gfdl_lw) THEN
+        DO j=jts,jte
+        DO k=kts,kte
+        DO i=its,ite
+           RTHRATENLW(I,K,J)=RTHRATEN(I,K,J)
+        ENDDO
+        ENDDO
+        ENDDO
+     ENDIF
+!
+
+     swrad_select: SELECT CASE(sw_physics)
+
+        CASE (SWRADSCHEME)
+             CALL wrf_debug(100, 'CALL swrad')
+             CALL SWRAD(                                               &
+                     DT=dt,RTHRATEN=rthraten,GSW=gsw                   &
+                    ,XLAT=xlat,XLONG=xlong,ALBEDO=albedo               &
+#ifdef WRF_CHEM
+                    ,PM2_5_DRY=pm2_5_dry,PM2_5_WATER=pm2_5_water       &
+                    ,PM2_5_DRY_EC=pm2_5_dry_ec                         &
+#endif
+                    ,RHO_PHY=rho,T3D=t                                 &
+                    ,P3D=p,PI3D=pi,DZ8W=dz8w,GMT=gmt                   &
+                    ,R=r_d,CP=cp,G=g,JULDAY=julday                     &
+                    ,XTIME=xtime,DECLIN=declin,SOLCON=solcon           &
+!                    ,COSZ_URB2D=COSZ_URB2D ,OMG_URB2D=omg_urb2d            & !urban
+                    ,RADFRQ=radt,ICLOUD=icloud,DEGRAD=degrad           &
+                    ,warm_rain=warm_rain                               &
+                    ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &     
+                    ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                    ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                    ,COSZ_URB2D=COSZ_URB2D ,OMG_URB2D=omg_urb2d        & !urban
+                    ,QV3D=qv                                           &
+                    ,QC3D=qc                                           &
+                    ,QR3D=qr                                           &
+                    ,QI3D=qi                                           &
+                    ,QS3D=qs                                           &
+                    ,QG3D=qg                                           &
+                    ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                     &
+                    ,F_QI=f_qi,F_QS=f_qs,F_QG=f_qg                     &
+                                                                       )
+
+        CASE (GSFCSWSCHEME)
+             CALL wrf_debug(100, 'CALL gsfcswrad')
+             CALL GSFCSWRAD(                                           &
+                     RTHRATEN=rthraten,GSW=gsw,XLAT=xlat,XLONG=xlong   &
+                    ,ALB=albedo,T3D=t,P3D=p,P8W3D=p8w,pi3D=pi          &
+                    ,DZ8W=dz8w,RHO_PHY=rho                             &
+                    ,CLDFRA3D=cldfra                                   &
+                    ,GMT=gmt,CP=cp,G=g                                 &
+!                    ,COSZ_URB2D=COSZ_URB2D ,OMG_URB2D=omg_urb2d            & !urban
+                    ,JULDAY=julday,XTIME=xtime                         &
+                    ,DECLIN=declin,SOLCON=solcon                       &
+                    ,RADFRQ=radt,DEGRAD=degrad                         &
+                    ,TAUCLDI=taucldi,TAUCLDC=taucldc                   &
+                    ,WARM_RAIN=warm_rain                               &
+#ifdef WRF_CHEM
+                    ,TAUAER300=tauaer300,TAUAER400=tauaer400           & ! jcb
+                    ,TAUAER600=tauaer600,TAUAER999=tauaer999           & ! jcb
+                    ,GAER300=gaer300,GAER400=gaer400                   & ! jcb
+                    ,GAER600=gaer600,GAER999=gaer999                   & ! jcb
+                    ,WAER300=waer300,WAER400=waer400                   & ! jcb
+                    ,WAER600=waer600,WAER999=waer999                   & ! jcb
+#endif
+                    ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &     
+                    ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                    ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                    ,COSZ_URB2D=COSZ_URB2D ,OMG_URB2D=omg_urb2d        & !urban
+                    ,QV3D=qv                                           &
+                    ,QC3D=qc                                           &
+                    ,QR3D=qr                                           &
+                    ,QI3D=qi                                           &
+                    ,QS3D=qs                                           &
+                    ,QG3D=qg                                           &
+                    ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                     &
+                    ,F_QI=f_qi,F_QS=f_qs,F_QG=f_qg                     &
+                                                                       )
+        CASE (CAMSWSCHEME)
+! Temporarily lw switch already calculates sw CAM tendency, so inactive here
+
+      DO j=jts,jte
+      DO k=kts,kte
+      DO i=its,ite
+         RTHRATEN(I,K,J)=RTHRATEN(I,K,J)+RTHRATENSW(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+        CASE (GFDLSWSCHEME)
+
+             CALL wrf_debug (100, 'CALL gfdlsw')
+
+             IF ( PRESENT(F_QV) .AND. PRESENT(F_QC) .AND.                     &
+                  PRESENT(F_QS) .AND. PRESENT(qs)   .AND.                     &
+                  PRESENT(qv)   .AND. PRESENT(qc) ) THEN
+               IF ( F_QV .AND. F_QC .AND. F_QS ) THEN
+                 gfdl_sw = .true.
+                 CALL ETARA(                                        &
+                  DT=dt,XLAND=xland                                 &
+                 ,P8W=p8w,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,T=t         &
+                 ,QV=qv,QW=qc_temp,QI=qi,QS=qs                      &
+                 ,TSK2D=tsk,GLW=GLW,RSWIN=SWDOWN,GSW=GSW            &
+                 ,RSWINC=SWDOWNC,CLDFRA=CLDFRA,PI3D=pi              &
+                 ,GLAT=glat,GLON=glon,HTOP=htop,HBOT=hbot           &
+                 ,HBOTR=hbotr, HTOPR=htopr                          &
+                 ,ALBEDO=albedo,CUPPT=cuppt                         &
+                 ,VEGFRA=vegfra,SNOW=snow,G=g,GMT=gmt               &
+                 ,NSTEPRA=stepra,NPHS=nphs,ITIMESTEP=itimestep      &
+                 ,XTIME=xtime,JULIAN=julian                         &
+                 ,COSZ_URB2D=COSZ_URB2D ,OMG_URB2D=omg_urb2d        &
+                 ,JULYR=julyr,JULDAY=julday                         &
+                 ,GFDL_LW=gfdl_lw,GFDL_SW=gfdl_sw                   &
+                 ,CFRACL=cfracl,CFRACM=cfracm,CFRACH=cfrach         &
+                 ,ACFRST=acfrst,NCFRST=ncfrst                       &
+                 ,ACFRCV=acfrcv,NCFRCV=ncfrcv                       &
+                 ,RSWTOA=rswtoa,RLWTOA=rlwtoa,CZMEAN=czmean         &
+                 ,THRATEN=rthraten,THRATENLW=rthratenlw             &
+                 ,THRATENSW=rthratensw                              &
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &     
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                                                                    )
+               ELSE
+                 CALL wrf_error_fatal('Can not call ETARA (2a). Missing moisture fields.')
+               ENDIF
+             ELSE
+               CALL wrf_error_fatal('Can not call ETARA (2b). Missing moisture fields.')
+             ENDIF
+
+        CASE DEFAULT
+
+             WRITE( wrf_err_message , * ) 'The shortwave option does not exist: sw_physics = ', sw_physics
+             CALL wrf_error_fatal ( wrf_err_message )
+
+     END SELECT swrad_select    
+
+     IF (sw_physics .gt. 0 .and. .not.gfdl_sw) THEN
+        DO j=jts,jte
+        DO k=kts,kte
+        DO i=its,ite
+           RTHRATENSW(I,K,J)=RTHRATEN(I,K,J)-RTHRATENLW(I,K,J)
+        ENDDO
+        ENDDO
+        ENDDO
+
+        DO j=jts,jte
+        DO i=its,ite
+           SWDOWN(I,J)=GSW(I,J)/(1.-ALBEDO(I,J))
+        ENDDO
+        ENDDO
+
+     ENDIF
+
+   ENDDO
+   !$OMP END PARALLEL DO
+
+   ENDIF Radiation_step
+
+     accumulate_lw_select: SELECT CASE(lw_physics)
+
+     CASE (CAMLWSCHEME)
+   IF(PRESENT(LWUPTC))THEN
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij ,i,j,k,its,ite,jts,jte)
+
+   DO ij = 1 , num_tiles
+     its = i_start(ij)
+     ite = i_end(ij)
+     jts = j_start(ij)
+     jte = j_end(ij)
+
+        DO j=jts,jte
+        DO i=its,ite
+           ACLWUPT(I,J) = ACLWUPT(I,J) + LWUPT(I,J)*DT
+           ACLWUPTC(I,J) = ACLWUPTC(I,J) + LWUPTC(I,J)*DT
+           ACLWDNT(I,J) = ACLWDNT(I,J) + LWDNT(I,J)*DT
+           ACLWDNTC(I,J) = ACLWDNTC(I,J) + LWDNTC(I,J)*DT
+           ACLWUPB(I,J) = ACLWUPB(I,J) + LWUPB(I,J)*DT
+           ACLWUPBC(I,J) = ACLWUPBC(I,J) + LWUPBC(I,J)*DT
+           ACLWDNB(I,J) = ACLWDNB(I,J) + LWDNB(I,J)*DT
+           ACLWDNBC(I,J) = ACLWDNBC(I,J) + LWDNBC(I,J)*DT
+        ENDDO
+        ENDDO
+   ENDDO
+   !$OMP END PARALLEL DO
+   ENDIF
+     CASE DEFAULT
+     END SELECT accumulate_lw_select
+
+     accumulate_sw_select: SELECT CASE(sw_physics)
+
+     CASE (CAMSWSCHEME)
+   IF(PRESENT(SWUPTC))THEN
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij ,i,j,k,its,ite,jts,jte)
+
+   DO ij = 1 , num_tiles
+     its = i_start(ij)
+     ite = i_end(ij)
+     jts = j_start(ij)
+     jte = j_end(ij)
+
+        DO j=jts,jte
+        DO i=its,ite
+           ACSWUPT(I,J) = ACSWUPT(I,J) + SWUPT(I,J)*DT
+           ACSWUPTC(I,J) = ACSWUPTC(I,J) + SWUPTC(I,J)*DT
+           ACSWDNT(I,J) = ACSWDNT(I,J) + SWDNT(I,J)*DT
+           ACSWDNTC(I,J) = ACSWDNTC(I,J) + SWDNTC(I,J)*DT
+           ACSWUPB(I,J) = ACSWUPB(I,J) + SWUPB(I,J)*DT
+           ACSWUPBC(I,J) = ACSWUPBC(I,J) + SWUPBC(I,J)*DT
+           ACSWDNB(I,J) = ACSWDNB(I,J) + SWDNB(I,J)*DT
+           ACSWDNBC(I,J) = ACSWDNBC(I,J) + SWDNBC(I,J)*DT
+        ENDDO
+        ENDDO
+   ENDDO
+   !$OMP END PARALLEL DO
+   ENDIF
+     CASE DEFAULT
+     END SELECT accumulate_sw_select
+!
+!*** Restore the saved values of the input Q arrays before exiting
+
+     IF ( PRESENT( cu_rad_feedback ) ) THEN
+       IF ( PRESENT( qc  ) .AND. PRESENT( qc_adjust ) .AND. cu_rad_feedback ) THEN
+          DO j=jts,jte
+          DO k=kts,kte
+          DO i=its,ite
+            qc(i,k,j) = qc_save(i,k,j)
+          ENDDO
+          ENDDO
+          ENDDO
+       ENDIF
+       IF ( PRESENT( qi  ) .AND. PRESENT( qi_adjust ) .AND. cu_rad_feedback ) THEN
+          DO j=jts,jte
+          DO k=kts,kte
+          DO i=its,ite
+            qi(i,k,j) = qi_save(i,k,j)
+          ENDDO
+          ENDDO
+          ENDDO
+       ENDIF
+     ENDIF
+
+   END SUBROUTINE radiation_driver
+
+!---------------------------------------------------------------------
+!BOP
+! !IROUTINE: radconst - compute radiation terms
+! !INTERFAC:
+   SUBROUTINE radconst(XTIME,DECLIN,SOLCON,JULIAN,                   &
+                       DEGRAD,DPD                                    )
+!---------------------------------------------------------------------
+   USE module_wrf_error
+   IMPLICIT NONE
+!---------------------------------------------------------------------
+
+! !ARGUMENTS:
+   REAL, INTENT(IN   )      ::       DEGRAD,DPD,XTIME,JULIAN
+   REAL, INTENT(OUT  )      ::       DECLIN,SOLCON
+   REAL                     ::       OBECL,SINOB,SXLONG,ARG,  &
+                                     DECDEG,DJUL,RJUL,ECCFAC
+!
+! !DESCRIPTION:
+! Compute terms used in radiation physics 
+!EOP
+
+! for short wave radiation
+
+   DECLIN=0.
+   SOLCON=0.
+
+!-----OBECL : OBLIQUITY = 23.5 DEGREE.
+        
+   OBECL=23.5*DEGRAD
+   SINOB=SIN(OBECL)
+        
+!-----CALCULATE LONGITUDE OF THE SUN FROM VERNAL EQUINOX:
+        
+   IF(JULIAN.GE.80.)SXLONG=DPD*(JULIAN-80.)
+   IF(JULIAN.LT.80.)SXLONG=DPD*(JULIAN+285.)
+   SXLONG=SXLONG*DEGRAD
+   ARG=SINOB*SIN(SXLONG)
+   DECLIN=ASIN(ARG)
+   DECDEG=DECLIN/DEGRAD
+!----SOLAR CONSTANT ECCENTRICITY FACTOR (PALTRIDGE AND PLATT 1976)
+   DJUL=JULIAN*360./365.
+   RJUL=DJUL*DEGRAD
+   ECCFAC=1.000110+0.034221*COS(RJUL)+0.001280*SIN(RJUL)+0.000719*  &
+          COS(2*RJUL)+0.000077*SIN(2*RJUL)
+   SOLCON=1370.*ECCFAC
+   
+!pjj/cray  Cray X1 cannot print from threaded region
+#ifndef crayx1
+   write(wrf_err_message,10)DECDEG,SOLCON
+10 FORMAT(1X,'*** SOLAR DECLINATION ANGLE = ',F6.2,' DEGREES.',     &
+        ' SOLAR CONSTANT = ',F8.2,' W/M**2 ***')
+   CALL wrf_debug (50, wrf_err_message)
+#endif
+
+   END SUBROUTINE radconst
+
+!---------------------------------------------------------------------
+!BOP
+! !IROUTINE: cal_cldfra - Compute cloud fraction
+! !INTERFACE:
+   SUBROUTINE cal_cldfra(CLDFRA,QC,QI,F_QC,F_QI,                     &
+          ids,ide, jds,jde, kds,kde,                                 &
+          ims,ime, jms,jme, kms,kme,                                 &
+          its,ite, jts,jte, kts,kte                                  )
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!---------------------------------------------------------------------
+   INTEGER,  INTENT(IN   )   ::           ids,ide, jds,jde, kds,kde, &
+                                          ims,ime, jms,jme, kms,kme, &
+                                          its,ite, jts,jte, kts,kte
+
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(OUT  ) ::    &
+                                                             CLDFRA
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN   ) ::    &
+                                                                 QI, &
+                                                                 QC
+
+   LOGICAL,INTENT(IN) :: F_QC,F_QI
+
+   REAL thresh
+   INTEGER:: i,j,k
+! !DESCRIPTION:
+! Compute cloud fraction from input ice and cloud water fields
+! if provided.
+!
+! Whether QI or QC is active or not is determined from the indices of
+! the fields into the 4D scalar arrays in WRF. These indices are
+! P_QI and P_QC, respectively, and they are passed in to the routine
+! to enable testing to see if QI and QC represent active fields in
+! the moisture 4D scalar array carried by WRF.
+!
+! If a field is active its index will have a value greater than or
+! equal to PARAM_FIRST_SCALAR, which is also an input argument to
+! this routine.
+!EOP
+!---------------------------------------------------------------------
+     thresh=1.0e-6
+
+     IF ( f_qi .AND. f_qc ) THEN
+        DO j = jts,jte
+        DO k = kts,kte
+        DO i = its,ite
+           IF ( QC(i,k,j)+QI(I,k,j) .gt. thresh) THEN
+              CLDFRA(i,k,j)=1.
+           ELSE
+              CLDFRA(i,k,j)=0.
+           ENDIF
+        ENDDO
+        ENDDO
+        ENDDO
+     ELSE IF ( f_qc ) THEN
+        DO j = jts,jte
+        DO k = kts,kte
+        DO i = its,ite
+           IF ( QC(i,k,j) .gt. thresh) THEN
+              CLDFRA(i,k,j)=1.
+           ELSE
+              CLDFRA(i,k,j)=0.
+           ENDIF
+        ENDDO
+        ENDDO
+        ENDDO
+     ELSE
+        DO j = jts,jte
+        DO k = kts,kte
+        DO i = its,ite
+           CLDFRA(i,k,j)=0.
+        ENDDO
+        ENDDO
+        ENDDO
+     ENDIF
+
+   END SUBROUTINE cal_cldfra
+
+!BOP
+! !IROUTINE: cal_cldfra2 - Compute cloud fraction
+! !INTERFACE:
+! cal_cldfra_xr - Compute cloud fraction.
+! Code adapted from that in module_ra_gfdleta.F in WRF_v2.0.3 by James Done
+!!
+!!---  Cloud fraction parameterization follows Randall, 1994
+!!     (see Hong et al., 1998)
+!!     (modified by Ferrier, Feb '02)
+!
+   SUBROUTINE cal_cldfra2(CLDFRA, QV, QC, QI, QS,                     &
+                         F_QV, F_QC, F_QI, F_QS, t_phy, p_phy,       &
+                         F_ICE_PHY,F_RAIN_PHY,                       &
+          ids,ide, jds,jde, kds,kde,                                 &
+          ims,ime, jms,jme, kms,kme,                                 &
+          its,ite, jts,jte, kts,kte                                  )
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!---------------------------------------------------------------------
+   INTEGER,  INTENT(IN   )   ::           ids,ide, jds,jde, kds,kde, &
+                                          ims,ime, jms,jme, kms,kme, &
+                                          its,ite, jts,jte, kts,kte
+
+!
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(OUT  ) ::    &
+                                                             CLDFRA
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN   ) ::    &
+                                                                 QV, &
+                                                                 QI, &
+                                                                 QC, &
+                                                                 QS, &
+                                                              t_phy, &
+                                                              p_phy, &
+                                                          F_ICE_PHY, &
+                                                         F_RAIN_PHY
+
+   LOGICAL,INTENT(IN) :: F_QC,F_QI,F_QV,F_QS
+
+!  REAL thresh
+   INTEGER:: i,j,k
+   REAL    :: RHUM, tc, esw, esi, weight, qvsw, qvsi, qvs_weight, QIMID, QWMID, QCLD, DENOM, ARG, SUBSAT
+
+   REAL    ,PARAMETER :: ALPHA0=100., GAMMA=0.49, QCLDMIN=1.E-12,    &
+                                        PEXP=0.25, RHGRID=1.0
+   REAL    , PARAMETER ::  SVP1=0.61078
+   REAL    , PARAMETER ::  SVP2=17.2693882
+   REAL    , PARAMETER ::  SVPI2=21.8745584
+   REAL    , PARAMETER ::  SVP3=35.86
+   REAL    , PARAMETER ::  SVPI3=7.66
+   REAL    , PARAMETER ::  SVPT0=273.15
+   REAL    , PARAMETER ::  r_d = 287.
+   REAL    , PARAMETER ::  r_v = 461.6
+   REAL    , PARAMETER ::  ep_2=r_d/r_v
+! !DESCRIPTION:
+! Compute cloud fraction from input ice and cloud water fields
+! if provided.
+!
+! Whether QI or QC is active or not is determined from the indices of
+! the fields into the 4D scalar arrays in WRF. These indices are 
+! P_QI and P_QC, respectively, and they are passed in to the routine
+! to enable testing to see if QI and QC represent active fields in
+! the moisture 4D scalar array carried by WRF.
+! 
+! If a field is active its index will have a value greater than or
+! equal to PARAM_FIRST_SCALAR, which is also an input argument to 
+! this routine.
+!EOP
+
+
+!-----------------------------------------------------------------------
+!---  COMPUTE GRID-SCALE CLOUD COVER FOR RADIATION
+!     (modified by Ferrier, Feb '02)
+!
+!---  Cloud fraction parameterization follows Randall, 1994
+!     (see Hong et al., 1998)
+!-----------------------------------------------------------------------
+! Note: ep_2=287./461.6 Rd/Rv
+! Note: R_D=287.
+
+! Alternative calculation for critical RH for grid saturation
+!     RHGRID=0.90+.08*((100.-DX)/95.)**.5
+
+! Calculate saturation mixing ratio weighted according to the fractions of
+! water and ice.
+! Following:
+! Murray, F.W. 1966. ``On the computation of Saturation Vapor Pressure''  J. Appl. Meteor.  6 p.204
+!    es (in mb) = 6.1078 . exp[ a . (T-273.16)/ (T-b) ]
+!
+!       over ice        over water
+! a =   21.8745584      17.2693882
+! b =   7.66            35.86
+
+!---------------------------------------------------------------------
+
+    DO j = jts,jte
+    DO k = kts,kte
+    DO i = its,ite
+      tc         = t_phy(i,k,j) - SVPT0
+      esw     = 1000.0 * SVP1 * EXP( SVP2  * tc / ( t_phy(i,k,j) - SVP3  ) )
+      esi     = 1000.0 * SVP1 * EXP( SVPI2 * tc / ( t_phy(i,k,j) - SVPI3 ) )
+      QVSW = EP_2 * esw / ( p_phy(i,k,j) - esw )
+      QVSI = EP_2 * esi / ( p_phy(i,k,j) - esi )
+
+      IF ( F_QI .and. F_QC .and. F_QS) THEN
+        QCLD=QI(i,k,j)+QC(i,k,j)+QS(I,k,j)
+        IF (QCLD .LT. QCLDMIN) THEN
+          weight = 0.
+        ELSE
+          weight = (QI(i,k,j)+QS(I,k,j)) / QCLD
+        ENDIF
+      ELSE IF ( F_QC ) THEN
+
+! Mixing ratios of cloud water & total ice (cloud ice + snow).
+! Mixing ratios of rain are not considered in this scheme.
+! F_ICE is fraction of ice
+! F_RAIN is fraction of rain
+
+      QIMID=QC(i,k,j)*F_ICE_PHY(i,k,j)
+      QWMID=(QC(i,k,j)-QIMID)*(1.-F_RAIN_PHY(i,k,j))
+
+
+!
+!--- Total "cloud" mixing ratio, QCLD.  Rain is not part of cloud,
+!    only cloud water + cloud ice + snow
+!
+      QCLD=QWMID+QIMID
+        IF (QCLD .LT. QCLDMIN) THEN
+          weight = 0.
+        ELSE
+          weight = F_ICE_PHY(i,k,j)
+        ENDIF
+
+      ELSE
+        CLDFRA(i,k,j)=0.
+      ENDIF !  IF ( F_QI .and. F_QC )
+
+
+      QVS_WEIGHT = (1-weight)*QVSW + weight*QVSI
+      RHUM=QV(i,k,j)/QVS_WEIGHT   !--- Relative humidity
+!
+!--- Determine cloud fraction (modified from original algorithm)
+!
+      IF (QCLD .LT. QCLDMIN) THEN
+!
+!--- Assume zero cloud fraction if there is no cloud mixing ratio
+!
+        CLDFRA(i,k,j)=0.
+      ELSEIF(RHUM.GE.RHGRID)THEN
+!
+!--- Assume cloud fraction of unity if near saturation and the cloud
+!    mixing ratio is at or above the minimum threshold
+!
+        CLDFRA(i,k,j)=1.
+      ELSE
+!
+!--- Adaptation of original algorithm (Randall, 1994; Zhao, 1995)
+!    modified based on assumed grid-scale saturation at RH=RHgrid.
+!
+        SUBSAT=MAX(1.E-10,RHGRID*QVS_WEIGHT-QV(i,k,j))
+        DENOM=(SUBSAT)**GAMMA
+        ARG=MAX(-6.9, -ALPHA0*QCLD/DENOM)    ! <-- EXP(-6.9)=.001
+! prevent negative values  (new)
+        RHUM=MAX(1.E-10, RHUM)
+        CLDFRA(i,k,j)=(RHUM/RHGRID)**PEXP*(1.-EXP(ARG))
+!!              ARG=-1000*QCLD/(RHUM-RHGRID)
+!!              ARG=MAX(ARG, ARGMIN)
+!!              CLDFRA(i,k,j)=(RHUM/RHGRID)*(1.-EXP(ARG))
+        IF (CLDFRA(i,k,j) .LT. .01) CLDFRA(i,k,j)=0.
+      ENDIF          !--- End IF (QCLD .LT. QCLDMIN) ...
+    ENDDO          !--- End DO i
+    ENDDO          !--- End DO k
+    ENDDO          !--- End DO j
+
+   END SUBROUTINE cal_cldfra2
+
+END MODULE module_radiation_driver
Index: trunk/WRF.COMMON/WRFV2/phys/module_sf_gfs.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_sf_gfs.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_sf_gfs.F	(revision 2744)
@@ -0,0 +1,1767 @@
+!!WRF:MODEL_LAYER:PHYSICS
+!
+MODULE module_sf_gfs
+
+
+CONTAINS
+
+!-------------------------------------------------------------------
+   SUBROUTINE SF_GFS(U3D,V3D,T3D,QV3D,P3D,                              &
+		 CP,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,             &
+                     ZNT,UST,PSIM,PSIH,                                 &
+		 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,                    &
+                     QGH,QSFC,U10,V10,                                  &
+                     GZ1OZ0,WSPD,BR,ISFFLX,                             &
+                     EP1,EP2,KARMAN,itimestep,                          &
+                     ids,ide, jds,jde, kds,kde,                         &
+                     ims,ime, jms,jme, kms,kme,                         &
+                     its,ite, jts,jte, kts,kte                     )
+!-------------------------------------------------------------------
+      USE MODULE_GFS_MACHINE, ONLY : kind_phys
+      USE MODULE_GFS_FUNCPHYS , ONLY : gfuncphys,fpvs
+!-------------------------------------------------------------------
+      IMPLICIT NONE
+!-------------------------------------------------------------------
+!-- U3D    	3D u-velocity interpolated to theta points (m/s)
+!-- V3D    	3D v-velocity interpolated to theta points (m/s)
+!-- T3D     	temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!-- P3D         3D pressure (Pa)
+!-- CP		heat capacity at constant pressure for dry air (J/kg/K)
+!-- ROVCP       R/CP
+!-- R           gas constant for dry air (J/kg/K)
+!-- XLV         latent heat of vaporization for water (J/kg)
+!-- PSFC	surface pressure (Pa)
+!-- ZNT		roughness length (m)
+!-- UST		u* in similarity theory (m/s)
+!-- PSIM        similarity stability function for momentum
+!-- PSIH        similarity stability function for heat
+!-- XLAND	land mask (1 for land, 2 for water)
+!-- HFX		upward heat flux at the surface (W/m^2)
+!-- QFX   	upward moisture flux at the surface (kg/m^2/s)
+!-- LH          net upward latent heat flux at surface (W/m^2)
+!-- TSK		surface temperature (K)
+!-- FLHC        exchange coefficient for heat (m/s)
+!-- FLQC        exchange coefficient for moisture (m/s)
+!-- QGH         lowest-level saturated mixing ratio
+!-- U10         diagnostic 10m u wind
+!-- V10         diagnostic 10m v wind
+!-- GZ1OZ0      log(z/z0) where z0 is roughness length
+!-- WSPD        wind speed at lowest model level (m/s)
+!-- BR          bulk Richardson number in surface layer
+!-- ISFFLX      isfflx=1 for surface heat and moisture fluxes
+!-- EP1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
+!-- KARMAN      Von Karman constant
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!-------------------------------------------------------------------
+
+      INTEGER, INTENT(IN) ::            ids,ide, jds,jde, kds,kde,      &
+                                        ims,ime, jms,jme, kms,kme,      &
+                                        its,ite, jts,jte, kts,kte,      &
+                                        ISFFLX,itimestep
+
+      REAL,    INTENT(IN) ::                                            &
+                                        CP,                             &
+                                        EP1,                            &
+                                        EP2,                            &
+                                        KARMAN,                         &
+                                        R,                              & 
+                                        ROVCP,                          &
+                                        XLV 
+
+      REAL,    DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) ::      & 
+                                        P3D,                            &
+                                        QV3D,                           &
+                                        T3D,                            &
+                                        U3D,                            &
+                                        V3D
+
+      REAL,    DIMENSION(ims:ime, jms:jme), INTENT(IN) ::               &
+                                        TSK,                            &
+                                        PSFC,                           &
+                                        XLAND
+ 
+      REAL,    DIMENSION(ims:ime, jms:jme), INTENT(INOUT) ::            & 
+                                        BR,                             &
+                                        CHS,                            &
+                                        CHS2,                           &
+                                        CPM,                            &
+                                        CQS2,                           &
+                                        FLHC,                           &
+                                        FLQC,                           &
+                                        GZ1OZ0,                         &
+                                        HFX,                            &
+                                        LH,                             &
+                                        PSIM,                           &
+                                        PSIH,                           &
+                                        QFX,                            &
+                                        QGH,                            &
+                                        QSFC,                           &
+                                        UST,                            &
+                                        ZNT,                            &
+                                        WSPD
+
+      REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) ::                 &
+                                        U10,                            &
+                                        V10 
+
+
+!--------------------------- LOCAL VARS ------------------------------
+
+      REAL ::                           ESAT
+
+      REAL     (kind=kind_phys) ::                                      &
+                                        RHOX
+
+      REAL     (kind=kind_phys), DIMENSION(its:ite) ::                  &
+                                        CH,                             &
+                                        CM,                             &
+                                        DDVEL,                          &
+                                        DRAIN,                          &
+                                        EP,                             &
+                                        EVAP,                           &
+                                        FH,                             &
+                                        FH2,                            &
+                                        FM,                             &
+                                        HFLX,                           &
+                                        PH,                             &
+                                        PM,                             &
+                                        PRSL1,                          &
+                                        PRSLKI,                         &
+                                        PS,                             &
+                                        Q1,                             &
+                                        Q2M,                            &
+                                        QSS,                            &
+                                        QSURF,                          &
+                                        RB,                             &
+                                        RCL,                            &
+                                        RHO1,                           &
+                                        SLIMSK,                         &
+                                        STRESS,                         &
+                                        T1,                             &
+                                        T2M,                            &
+                                        THGB,                           &
+                                        THX,                            &
+                                        TSKIN,                          &
+                                        SHELEG,                         &
+                                        U1,                             &
+                                        U10M,                           &
+                                        USTAR,                          &
+                                        V1,                             &
+                                        V10M,                           & 
+                                        WIND,                           &
+                                        Z0RL,                           &
+                                        Z1                              
+
+
+      INTEGER ::                                                        &
+                                        I,                              &
+                                        IM,                             &
+                                        J,                              &
+                                        K,                              &
+                                        KM
+
+
+   if(itimestep.eq.0) then
+     CALL GFUNCPHYS
+   endif
+
+   IM=ITE-ITS+1
+   KM=KTE-KTS+1
+
+   DO J=jts,jte
+
+      DO i=its,ite
+        DDVEL(I)=0.
+        RCL(i)=1.
+        PRSL1(i)=P3D(i,kts,j)*.001
+        PS(i)=PSFC(i,j)*.001
+        Q1(I) = QV3D(i,kts,j)
+!        QSURF(I)=QSFC(I,J)
+        QSURF(I)=0.
+        SHELEG(I)=0.
+        SLIMSK(i)=ABS(XLAND(i,j)-2.)
+        TSKIN(i)=TSK(i,j)
+        T1(I) = T3D(i,kts,j)
+        U1(I) = U3D(i,kts,j)
+        USTAR(I) = UST(i,j)
+        V1(I) = V3D(i,kts,j)
+        Z0RL(I) = ZNT(i,j)*100.
+      ENDDO
+
+      DO i=its,ite
+         PRSLKI(i)=(PS(I)/PRSL1(I))**ROVCP
+         THGB(I)=TSKIN(i)*(100./PS(I))**ROVCP
+         THX(I)=T1(i)*(100./PRSL1(I))**ROVCP
+         RHO1(I)=PRSL1(I)*1000./(R*T1(I)*(1.+EP1*Q1(I)))
+         Q1(I)=Q1(I)/(1.+Q1(I))
+      ENDDO
+
+
+      CALL PROGTM(IM,KM,PS,U1,V1,T1,Q1,                                 &
+                  SHELEG,TSKIN,QSURF,                                   &
+!WRF              SMC,STC,DM,SOILTYP,SIGMAF,VEGTYPE,CANOPY,DLWFLX,      &
+!WRF              SLRAD,SNOWMT,DELT,                                    &
+                  Z0RL,                                                 &
+!WRF              TG3,GFLUX,F10M,                                       &
+                  U10M,V10M,T2M,Q2M,                                    &
+!WRF              ZSOIL,                                                &
+                  CM,CH,RB,                                             &
+!WRF              RHSCNPY,RHSMC,AIM,BIM,CIM,                            &
+                  RCL,PRSL1,PRSLKI,SLIMSK,                              &
+                  DRAIN,EVAP,HFLX,STRESS,EP,                            &
+                  FM,FH,USTAR,WIND,DDVEL,                               &
+                  PM,PH,FH2,QSS,Z1                                      )
+
+
+      DO i=its,ite
+        U10(i,j)=U10M(i)
+        V10(i,j)=V10M(i)
+        BR(i,j)=RB(i)
+        CHS(I,J)=CH(I)*WIND(I)
+        CHS2(I,J)=USTAR(I)*KARMAN/FH2(I)
+        CPM(I,J)=CP*(1.+0.8*QV3D(i,kts,j))
+        esat = fpvs(t1(i))
+        QGH(I,J)=ep2*esat/(1000.*ps(i)-esat)
+        QSFC(I,J)=qss(i)
+        PSIH(i,j)=PH(i)
+        PSIM(i,j)=PM(i)
+        UST(i,j)=ustar(i)
+        WSPD(i,j)=WIND(i)
+        ZNT(i,j)=Z0RL(i)*.01
+      ENDDO
+
+      DO i=its,ite
+        FLHC(i,j)=CPM(I,J)*RHO1(I)*CHS(I,J)
+        FLQC(i,j)=RHO1(I)*CHS(I,J)
+        GZ1OZ0(i,j)=LOG(Z1(I)/(Z0RL(I)*.01))
+        CQS2(i,j)=CHS2(I,J)
+      ENDDO
+
+      IF (ISFFLX.EQ.0) THEN
+        DO i=its,ite
+          HFX(i,j)=0.
+          LH(i,j)=0.
+          QFX(i,j)=0.
+        ENDDO
+      ELSE
+        DO i=its,ite
+          IF(XLAND(I,J)-1.5.GT.0.)THEN
+            HFX(I,J)=FLHC(I,J)*(THGB(I)-THX(I))
+          ELSEIF(XLAND(I,J)-1.5.LT.0.)THEN
+            HFX(I,J)=FLHC(I,J)*(THGB(I)-THX(I))
+            HFX(I,J)=AMAX1(HFX(I,J),-250.)
+          ENDIF
+          QFX(I,J)=FLQC(I,J)*(QSFC(I,J)-Q1(I))
+          QFX(I,J)=AMAX1(QFX(I,J),0.)
+          LH(I,J)=XLV*QFX(I,J)
+        ENDDO
+      ENDIF
+
+
+    ENDDO
+
+
+   END SUBROUTINE SF_GFS
+
+
+!-------------------------------------------------------------------
+
+      SUBROUTINE PROGTM(IM,KM,PS,U1,V1,T1,Q1,                           &
+     &                  SHELEG,TSKIN,QSURF,                             &
+!WRF     &                  SMC,STC,DM,SOILTYP,SIGMAF,VEGTYPE,CANOPY,   &
+!WRF     &                  DLWFLX,SLRAD,SNOWMT,DELT,                   &
+     &                  Z0RL,                                           &
+!WRF     &                  TG3,GFLUX,F10M,                             &
+     &                  U10M,V10M,T2M,Q2M,                              &
+!WRF     &                  ZSOIL,                                      &
+     &                  CM, CH, RB,                                     &
+!WRF     &                  RHSCNPY,RHSMC,AIM,BIM,CIM,                  &
+     &                  RCL,PRSL1,PRSLKI,SLIMSK,                        &
+     &                  DRAIN,EVAP,HFLX,STRESS,EP,                      &
+     &                  FM,FH,USTAR,WIND,DDVEL,                         &
+     &                  PM,PH,FH2,QSS,Z1                                )
+!
+
+      USE MODULE_GFS_MACHINE, ONLY : kind_phys
+      USE MODULE_GFS_FUNCPHYS, ONLY : fpvs
+      USE MODULE_GFS_PHYSCONS, grav => con_g, SBC => con_sbc, HVAP => con_HVAP &
+     &,             CP => con_CP, HFUS => con_HFUS, JCAL => con_JCAL    &
+     &,             EPS => con_eps, EPSM1 => con_epsm1, t0c => con_t0c  &
+     &,             RVRDM1 => con_FVirt, RD => con_RD
+      implicit none
+!
+!     include 'constant.h'
+!
+      integer              IM, km
+!
+      real(kind=kind_phys), parameter :: cpinv=1.0/cp, HVAPI=1.0/HVAP
+      real(kind=kind_phys) DELT
+      INTEGER              SOILTYP(IM),  VEGTYPE(IM)
+      real(kind=kind_phys) PS(IM),       U1(IM),      V1(IM),           &
+     &                     T1(IM),       Q1(IM),      SHELEG(IM),       &
+     &                     TSKIN(IM),    QSURF(IM),   SMC(IM,KM),       &
+     &                     STC(IM,KM),   DM(IM),      SIGMAF(IM),       &
+     &                     CANOPY(IM),   DLWFLX(IM),  SLRAD(IM),        & 
+     &                     SNOWMT(IM),   Z0RL(IM),    TG3(IM),          &
+     &                     GFLUX(IM),    F10M(IM),    U10M(IM),         &
+     &                     V10M(IM),     T2M(IM),     Q2M(IM),          &
+     &                     ZSOIL(IM,KM), CM(IM),      CH(IM),           & 
+     &                     RB(IM),       RHSCNPY(IM), RHSMC(IM,KM),     &
+     &                     AIM(IM,KM),   BIM(IM,KM),  CIM(IM,KM),       &
+     &                     RCL(IM),      PRSL1(IM),   PRSLKI(IM),       &
+     &                     SLIMSK(IM),   DRAIN(IM),   EVAP(IM),         &
+     &                     HFLX(IM),     RNET(IM),    EP(IM),           &
+     &                     FM(IM),       FH(IM),      USTAR(IM),        &
+     &                     WIND(IM),     DDVEL(IM),   STRESS(IM)
+!
+!     Locals
+!
+      integer              k,i
+!
+      real(kind=kind_phys) CANFAC(IM),                                  &
+     &                     DDZ(IM),     DDZ2(IM),    DELTA(IM),         &
+     &                     DEW(IM),     DF1(IM),     DFT0(IM),          &
+     &                     DFT2(IM),    DFT1(IM),                       &
+     &                     DMDZ(IM),    DMDZ2(IM),   DTDZ1(IM),         &
+     &                     DTDZ2(IM),   DTV(IM),     EC(IM),            &
+     &                     EDIR(IM),    ETPFAC(IM),                     &
+     &                     FACTSNW(IM), FH2(IM),     FM10(IM),          &
+     &                     FX(IM),      GX(IM),                         &
+     &                     HCPCT(IM),   HL1(IM),     HL12(IM),          &
+     &                     HLINF(IM),   PARTLND(IM), PH(IM),            &
+     &                     PH2(IM),     PM(IM),      PM10(IM),          &
+     &                     PSURF(IM),   Q0(IM),      QS1(IM),           &
+     &                     QSS(IM),     RAT(IM),     RCAP(IM),          &
+     &                     RCH(IM),     RHO(IM),     RS(IM),            &
+     &                     RSMALL(IM),  SLWD(IM),    SMCZ(IM),          &
+     &                     SNET(IM),    SNOEVP(IM),  SNOWD(IM),         &
+     &                     T1O(IM),     T2MO(IM),    TERM1(IM),         &
+     &                     TERM2(IM),   THETA1(IM),  THV1(IM),          &
+     &                     TREF(IM),    TSURF(IM),   TV1(IM),           &
+     &                     TVS(IM),     TSURFO(IM),  TWILT(IM),         &
+     &                     XX(IM),      XRCL(IM),    YY(IM),            &
+     &                     Z0(IM),      Z0MAX(IM),   Z1(IM),            &
+     &                     ZTMAX(IM),   ZZ(IM),      PS1(IM)
+!
+      real(kind=kind_phys) a0,    a0p,      a1,    a1p,     aa,  aa0,   &
+     &                     aa1,   adtv,     alpha, arnu,    b1,  b1p,   &
+     &                     b2,    b2p,      bb,    bb0,     bb1, bb2,   &
+     &                     bfact, ca,       cc,    cc1,    cc2, cfactr, &
+     &                     ch2o,  charnock, cice,  convrad, cq,  csoil, &
+     &                     ctfil1,ctfil2,   delt2, df2,     dfsnow,     &
+     &                     elocp, eth,      ff,  FMS,                   &
+!WRF     &                     fhs,   funcdf,   funckt,g,      hl0, hl0inf, &
+     &                     fhs,   g,        hl0,    hl0inf,             &
+     &                     hl110, hlt,      hltinf,OLINF,   rcq, rcs,   &
+     &                     rct,   restar,   rhoh2o,rnu,     RSI,        &
+     &                     rss,   scanop,   sig2k, sigma,   smcdry,     &
+     &                     t12,   t14,      tflx,  tgice,   topt,       &
+     &                     val,   vis,      zbot,  snomin,  tem
+!
+!
+
+      PARAMETER (CHARNOCK=.014,CA=.4)!C CA IS THE VON KARMAN CONSTANT
+      PARAMETER (G=grav,sigma=sbc)
+
+      PARAMETER (ALPHA=5.,A0=-3.975,A1=12.32,B1=-7.755,B2=6.041)
+      PARAMETER (A0P=-7.941,A1P=24.75,B1P=-8.705,B2P=7.899,VIS=1.4E-5)
+      PARAMETER (AA1=-1.076,BB1=.7045,CC1=-.05808)
+      PARAMETER (BB2=-.1954,CC2=.009999)
+      PARAMETER (ELOCP=HVAP/CP,DFSNOW=.31,CH2O=4.2E6,CSOIL=1.26E6)
+      PARAMETER (SCANOP=.5,CFACTR=.5,ZBOT=-3.,TGICE=271.2)
+      PARAMETER (CICE=1880.*917.,topt=298.)
+      PARAMETER (RHOH2O=1000.,CONVRAD=JCAL*1.E4/60.)
+      PARAMETER (CTFIL1=.5,CTFIL2=1.-CTFIL1)
+      PARAMETER (RNU=1.51E-5,ARNU=.135*RNU)
+      parameter (snomin=1.0e-9)
+!
+      LOGICAL FLAG(IM), FLAGSNW(IM)
+!WRF      real(kind=kind_phys) KT1(IM),       KT2(IM),      KTSOIL,         &
+      real(kind=kind_phys) KT1(IM),       KT2(IM),                      &
+     &                     ET(IM,KM),                                   &
+     &                     STSOIL(IM,KM), AI(IM,KM),    BI(IM,KM),      &
+     &                     CI(IM,KM),     RHSTC(IM,KM)
+      real(kind=kind_phys) rsmax(13), rgl(13),  rsmin(13), hs(13),      &
+     &                     smmax(9),  smdry(9), smref(9),  smwlt(9)
+
+!
+!  the 13 vegetation types are:
+!
+!  1  ...  broadleave-evergreen trees (tropical forest)
+!  2  ...  broadleave-deciduous trees
+!  3  ...  broadleave and needle leave trees (mixed forest)
+!  4  ...  needleleave-evergreen trees
+!  5  ...  needleleave-deciduous trees (larch)
+!  6  ...  broadleave trees with groundcover (savanna)
+!  7  ...  groundcover only (perenial)
+!  8  ...  broadleave shrubs with perenial groundcover
+!  9  ...  broadleave shrubs with bare soil
+! 10  ...  dwarf trees and shrubs with ground cover (trunda)
+! 11  ...  bare soil
+! 12  ...  cultivations (use parameters from type 7)
+! 13  ...  glacial
+!
+      data rsmax/13*5000./
+      data rsmin/150.,100.,125.,150.,100.,70.,40.,                      &
+     &           300.,400.,150.,999.,40.,999./
+      data rgl/5*30.,65.,4*100.,999.,100.,999./
+      data hs/41.69,54.53,51.93,47.35,47.35,54.53,36.35,                &
+     &        3*42.00,999.,36.35,999./
+      data smmax/.421,.464,.468,.434,.406,.465,.404,.439,.421/
+      data smdry/.07,.14,.22,.08,.18,.16,.12,.10,.07/
+      data smref/.283,.387,.412,.312,.338,.382,.315,.329,.283/
+      data smwlt/.029,.119,.139,.047,.010,.103,.069,.066,.029/
+!
+!!!   save rsmax, rsmin, rgl, hs, smmax, smdry, smref, smwlt
+!
+
+!WRF      DELT2 = DELT * 2.
+!
+!     ESTIMATE SIGMA ** K AT 2 M
+!
+      SIG2K = 1. - 4. * G * 2. / (CP * 280.)
+!
+!  INITIALIZE VARIABLES. ALL UNITS ARE SUPPOSEDLY M.K.S. UNLESS SPECIFIE
+!  PSURF IS IN PASCALS
+!  WIND IS WIND SPEED, THETA1 IS ADIABATIC SURFACE TEMP FROM LEVEL 1
+!  RHO IS DENSITY, QS1 IS SAT. HUM. AT LEVEL1 AND QSS IS SAT. HUM. AT
+!  SURFACE
+!  CONVERT SLRAD TO THE CIVILIZED UNIT FROM LANGLEY MINUTE-1 K-4
+!  SURFACE ROUGHNESS LENGTH IS CONVERTED TO M FROM CM
+!
+!!
+!     qs1 = fpvs(t1)
+!     qss = fpvs(tskin)
+      DO I=1,IM
+        XRCL(I)  = SQRT(RCL(I))
+        PSURF(I) = 1000. * PS(I)
+        PS1(I)   = 1000. * PRSL1(I)
+!       SLWD(I)  = SLRAD(I) * CONVRAD
+!WRF        SLWD(I)  = SLRAD(I)
+!
+!  DLWFLX has been given a negative sign for downward longwave
+!  snet is the net shortwave flux
+!
+!WRF        SNET(I) = -SLWD(I) - DLWFLX(I)
+        WIND(I) = XRCL(I) * SQRT(U1(I) * U1(I) + V1(I) * V1(I))         &
+     &              + MAX(0.0_kind_phys, MIN(DDVEL(I), 30.0_kind_phys))
+        WIND(I) = MAX(WIND(I),1._kind_phys)
+        Q0(I) = MAX(Q1(I),1.E-8_kind_phys)
+        TSURF(I) = TSKIN(I)
+        THETA1(I) = T1(I) * PRSLKI(I)
+        TV1(I) = T1(I) * (1. + RVRDM1 * Q0(I))
+        THV1(I) = THETA1(I) * (1. + RVRDM1 * Q0(I))
+        TVS(I) = TSURF(I) * (1. + RVRDM1 * Q0(I))
+        RHO(I) = PS1(I) / (RD * TV1(I))
+!jfe    QS1(I) = 1000. * FPVS(T1(I))
+        qs1(i) = fpvs(t1(i))
+        QS1(I) = EPS * QS1(I) / (PS1(I) + EPSM1 * QS1(I))
+        QS1(I) = MAX(QS1(I), 1.E-8_kind_phys)
+        Q0(I) = min(QS1(I),Q0(I))
+!jfe    QSS(I) = 1000. * FPVS(TSURF(I))
+        qss(i) = fpvs(tskin(i))
+        QSS(I) = EPS * QSS(I) / (PSURF(I) + EPSM1 * QSS(I))
+!       RS = PLANTR
+        RS(I) = 0.
+!WRF        if(VEGTYPE(I).gt.0.) RS(I) = rsmin(VEGTYPE(I))
+        Z0(I) = .01 * Z0RL(i)
+!WRF        CANOPY(I)= MAX(CANOPY(I),0._kind_phys)
+        DM(I) = 1.
+!WRF
+      GOTO 1111
+!WRF
+        FACTSNW(I) = 10.
+        IF(SLIMSK(I).EQ.2.) FACTSNW(I) = 3.
+!
+!  SNOW DEPTH IN WATER EQUIVALENT IS CONVERTED FROM MM TO M UNIT
+!
+        SNOWD(I) = SHELEG(I) / 1000.
+        FLAGSNW(I) = .FALSE.
+!
+!  WHEN SNOW DEPTH IS LESS THAN 1 MM, A PATCHY SNOW IS ASSUMED AND
+!  SOIL IS ALLOWED TO INTERACT WITH THE ATMOSPHERE.
+!  WE SHOULD EVENTUALLY MOVE TO A LINEAR COMBINATION OF SOIL AND
+!  SNOW UNDER THE CONDITION OF PATCHY SNOW.
+!
+        IF(SNOWD(I).GT..001.OR.SLIMSK(I).EQ.2.) RS(I) = 0.
+        IF(SNOWD(I).GT..001) FLAGSNW(I) = .TRUE.
+!##DG  IF(LAT.EQ.LATD) THEN
+!##DG    PRINT *, ' WIND,TV1,TVS,Q1,QS1,SNOW,SLIMSK=',
+!##DG&   WIND,TV1,TVS,Q1,QS1,SNOWD,SLIMSK
+!##DG    PRINT *, ' SNET, SLWD =', SNET, SLWD(I)
+!##DG  ENDIF
+        IF(SLIMSK(I).EQ.0.) THEN
+          ZSOIL(I,1) = 0.
+        ELSEIF(SLIMSK(I).EQ.1.) THEN
+          ZSOIL(I,1) = -.10
+        ELSE
+          ZSOIL(I,1) = -3. / KM
+        ENDIF
+!WRF
+1111  CONTINUE
+!WRF
+      ENDDO
+
+!!
+!WRF
+      GOTO 2222
+!WRF
+      DO K = 2, KM
+        DO I=1,IM
+          IF(SLIMSK(I).EQ.0.) THEN
+            ZSOIL(I,K) = 0.
+          ELSEIF(SLIMSK(I).EQ.1.) THEN
+            ZSOIL(I,K) = ZSOIL(I,K-1)                                   &
+     &                   + (-2. - ZSOIL(I,1)) / (KM - 1)
+          ELSE
+            ZSOIL(I,K) = - 3. * FLOAT(K) / FLOAT(KM)
+          ENDIF
+        ENDDO
+      ENDDO
+!WRF
+2222  CONTINUE
+!WRF
+!!
+      DO I=1,IM
+        Z1(I) = -RD * TV1(I) * LOG(PS1(I)/PSURF(I)) / G
+        DRAIN(I) = 0.
+      ENDDO
+
+!!
+      DO K = 1, KM
+        DO I=1,IM
+          ET(I,K) = 0.
+          RHSMC(I,K) = 0.
+          AIM(I,K) = 0.
+          BIM(I,K) = 1.
+          CIM(I,K) = 0.
+          STSOIL(I,K) = STC(I,K)
+        ENDDO
+      ENDDO
+
+      DO I=1,IM
+        EDIR(I) = 0.
+        EC(I) = 0.
+        EVAP(I) = 0.
+        EP(I) = 0.
+        SNOWMT(I) = 0.
+        GFLUX(I) = 0.
+        RHSCNPY(I) = 0.
+        FX(I) = 0.
+        ETPFAC(I) = 0.
+        CANFAC(I) = 0.
+      ENDDO
+!
+!  COMPUTE STABILITY DEPENDENT EXCHANGE COEFFICIENTS
+!
+!  THIS PORTION OF THE CODE IS PRESENTLY SUPPRESSED
+!
+      DO I=1,IM
+        IF(SLIMSK(I).EQ.0.) THEN
+          USTAR(I) = SQRT(G * Z0(I) / CHARNOCK)
+        ENDIF
+!
+!  COMPUTE STABILITY INDICES (RB AND HLINF)
+!
+
+        Z0MAX(I) = MIN(Z0(I),0.1 * Z1(I))
+        ZTMAX(I) = Z0MAX(I)
+        IF(SLIMSK(I).EQ.0.) THEN
+          RESTAR = USTAR(I) * Z0MAX(I) / VIS
+          RESTAR = MAX(RESTAR,.000001_kind_phys)
+!         RESTAR = ALOG(RESTAR)
+!         RESTAR = MIN(RESTAR,5.)
+!         RESTAR = MAX(RESTAR,-5.)
+!         RAT(I) = AA1 + BB1 * RESTAR + CC1 * RESTAR ** 2
+!         RAT(I) = RAT(I) / (1. + BB2 * RESTAR
+!    &                       + CC2 * RESTAR ** 2)
+!  Rat taken from Zeng, Zhao and Dickinson 1997
+          RAT(I) = 2.67 * restar ** .25 - 2.57
+          RAT(I) = min(RAT(I),7._kind_phys)
+          ZTMAX(I) = Z0MAX(I) * EXP(-RAT(I))
+        ENDIF
+      ENDDO
+
+!##DG  IF(LAT.EQ.LATD) THEN
+!##DG    PRINT *, ' z0max, ztmax, restar, RAT(I) =', 
+!##DG &   z0max, ztmax, restar, RAT(I)
+!##DG  ENDIF
+      DO I = 1, IM
+        DTV(I) = THV1(I) - TVS(I)
+        ADTV = ABS(DTV(I))
+        ADTV = MAX(ADTV,.001_kind_phys)
+        DTV(I) = SIGN(1._kind_phys,DTV(I)) * ADTV
+        RB(I) = G * DTV(I) * Z1(I) / (.5 * (THV1(I) + TVS(I))           &
+     &          * WIND(I) * WIND(I))
+        RB(I) = MAX(RB(I),-5000._kind_phys)
+!        FM(I) = LOG((Z0MAX(I)+Z1(I)) / Z0MAX(I))
+!        FH(I) = LOG((ZTMAX(I)+Z1(I)) / ZTMAX(I))
+        FM(I) = LOG((Z1(I)) / Z0MAX(I))
+        FH(I) = LOG((Z1(I)) / ZTMAX(I))
+        HLINF(I) = RB(I) * FM(I) * FM(I) / FH(I)
+        FM10(I) = LOG((Z0MAX(I)+10.) / Z0MAX(I))
+        FH2(I) = LOG((ZTMAX(I)+2.) / ZTMAX(I))
+      ENDDO
+!##DG  IF(LAT.EQ.LATD) THEN
+!##DG    PRINT *, ' DTV, RB(I), FM(I), FH(I), HLINF =',
+!##DG &   dtv, rb, FM(I), FH(I), hlinf
+!##DG  ENDIF
+!
+!  STABLE CASE
+!
+      DO I = 1, IM
+        IF(DTV(I).GE.0.) THEN
+          HL1(I) = HLINF(I)
+        ENDIF
+        IF(DTV(I).GE.0..AND.HLINF(I).GT..25) THEN
+          HL0INF = Z0MAX(I) * HLINF(I) / Z1(I)
+          HLTINF = ZTMAX(I) * HLINF(I) / Z1(I)
+          AA = SQRT(1. + 4. * ALPHA * HLINF(I))
+          AA0 = SQRT(1. + 4. * ALPHA * HL0INF)
+          BB = AA
+          BB0 = SQRT(1. + 4. * ALPHA * HLTINF)
+          PM(I) = AA0 - AA + LOG((AA + 1.) / (AA0 + 1.))
+          PH(I) = BB0 - BB + LOG((BB + 1.) / (BB0 + 1.))
+          FMS = FM(I) - PM(I)
+          FHS = FH(I) - PH(I)
+          HL1(I) = FMS * FMS * RB(I) / FHS
+        ENDIF
+      ENDDO
+!
+!  SECOND ITERATION
+!
+      DO I = 1, IM
+        IF(DTV(I).GE.0.) THEN
+          HL0 = Z0MAX(I) * HL1(I) / Z1(I)
+          HLT = ZTMAX(I) * HL1(I) / Z1(I)
+          AA = SQRT(1. + 4. * ALPHA * HL1(I))
+          AA0 = SQRT(1. + 4. * ALPHA * HL0)
+          BB = AA
+          BB0 = SQRT(1. + 4. * ALPHA * HLT)
+          PM(I) = AA0 - AA + LOG((AA + 1.) / (AA0 + 1.))
+          PH(I) = BB0 - BB + LOG((BB + 1.) / (BB0 + 1.))
+          HL110 = HL1(I) * 10. / Z1(I)
+          AA = SQRT(1. + 4. * ALPHA * HL110)
+          PM10(I) = AA0 - AA + LOG((AA + 1.) / (AA0 + 1.))
+          HL12(I) = HL1(I) * 2. / Z1(I)
+!         AA = SQRT(1. + 4. * ALPHA * HL12(I))
+          BB = SQRT(1. + 4. * ALPHA * HL12(I))
+          PH2(I) = BB0 - BB + LOG((BB + 1.) / (BB0 + 1.))
+        ENDIF
+      ENDDO
+!!
+!##DG  IF(LAT.EQ.LATD) THEN
+!##DG    PRINT *, ' HL1(I), PM, PH =',
+!##DG &   HL1(I),  pm, ph
+!##DG  ENDIF
+!
+!  UNSTABLE CASE
+!
+!
+!  CHECK FOR UNPHYSICAL OBUKHOV LENGTH
+!
+      DO I=1,IM
+        IF(DTV(I).LT.0.) THEN
+          OLINF = Z1(I) / HLINF(I)
+          IF(ABS(OLINF).LE.50. * Z0MAX(I)) THEN
+            HLINF(I) = -Z1(I) / (50. * Z0MAX(I))
+          ENDIF
+        ENDIF
+      ENDDO
+!
+!  GET PM AND PH
+!
+      DO I = 1, IM
+        IF(DTV(I).LT.0..AND.HLINF(I).GE.-.5) THEN
+          HL1(I) = HLINF(I)
+          PM(I) = (A0 + A1 * HL1(I)) * HL1(I)                           &
+     &            / (1. + B1 * HL1(I) + B2 * HL1(I) * HL1(I))
+          PH(I) = (A0P + A1P * HL1(I)) * HL1(I)                         &
+     &            / (1. + B1P * HL1(I) + B2P * HL1(I) * HL1(I))
+          HL110 = HL1(I) * 10. / Z1(I)
+          PM10(I) = (A0 + A1 * HL110) * HL110                           &
+     &            / (1. + B1 * HL110 + B2 * HL110 * HL110)
+          HL12(I) = HL1(I) * 2. / Z1(I)
+          PH2(I) = (A0P + A1P * HL12(I)) * HL12(I)                      &
+     &            / (1. + B1P * HL12(I) + B2P * HL12(I) * HL12(I))
+        ENDIF
+        IF(DTV(I).LT.0.AND.HLINF(I).LT.-.5) THEN
+          HL1(I) = -HLINF(I)
+          PM(I) = LOG(HL1(I)) + 2. * HL1(I) ** (-.25) - .8776
+          PH(I) = LOG(HL1(I)) + .5 * HL1(I) ** (-.5) + 1.386
+          HL110 = HL1(I) * 10. / Z1(I)
+          PM10(I) = LOG(HL110) + 2. * HL110 ** (-.25) - .8776
+          HL12(I) = HL1(I) * 2. / Z1(I)
+          PH2(I) = LOG(HL12(I)) + .5 * HL12(I) ** (-.5) + 1.386
+        ENDIF
+      ENDDO
+!
+!  FINISH THE EXCHANGE COEFFICIENT COMPUTATION TO PROVIDE FM AND FH
+!
+      DO I = 1, IM
+
+        FM(I) = FM(I) - PM(I)
+        FH(I) = FH(I) - PH(I)
+        FM10(I) = FM10(I) - PM10(I)
+        FH2(I) = FH2(I) - PH2(I)
+        CM(I) = CA * CA / (FM(I) * FM(I))
+        CH(I) = CA * CA / (FM(I) * FH(I))
+        CQ = CH(I)
+        STRESS(I) = CM(I) * WIND(I) * WIND(I)
+        USTAR(I)  = SQRT(STRESS(I))
+!       USTAR(I) = SQRT(CM(I) * WIND(I) * WIND(I))
+      ENDDO
+!##DG  IF(LAT.EQ.LATD) THEN
+!##DG    PRINT *, ' FM, FH, CM, CH(I), USTAR =',
+!##DG &   FM, FH, CM, ch, USTAR
+!##DG  ENDIF
+!
+!  UPDATE Z0 OVER OCEAN
+!
+      DO I = 1, IM
+        IF(SLIMSK(I).EQ.0.) THEN
+          Z0(I) = (CHARNOCK / G) * USTAR(I) ** 2
+!  NEW IMPLEMENTATION OF Z0
+!         CC = USTAR(I) * Z0 / RNU
+!         PP = CC / (1. + CC)
+!         FF = G * ARNU / (CHARNOCK * USTAR(I) ** 3)
+!         Z0 = ARNU / (USTAR(I) * FF ** PP)
+          Z0(I) = MIN(Z0(I),.1_kind_phys)
+          Z0(I) = MAX(Z0(I),1.E-7_kind_phys)
+          Z0RL(I) = 100. * Z0(I)
+        ENDIF
+      ENDDO
+
+	  GOTO 5555
+!
+!  RCP = RHO CP CH V
+!
+      DO I = 1, IM
+        RCH(I) = RHO(I) * CP * CH(I) * WIND(I)
+      ENDDO
+
+
+!
+!  SENSIBLE AND LATENT HEAT FLUX OVER OPEN WATER
+!
+      DO I = 1, IM
+        IF(SLIMSK(I).EQ.0.) THEN
+          EVAP(I) = ELOCP * RCH(I) * (QSS(I) - Q1(I))
+          DM(I) = 1.
+          QSURF(I) = QSS(I)
+        ENDIF
+      ENDDO
+
+        !
+        !  COMPUTE SOIL/SNOW/ICE HEAT FLUX IN PREPARATION FOR SURFACE ENERGY
+        !  BALANCE CALCULATION
+        !
+	    DO I = 1, IM
+	      GFLUX(I) = 0.
+	      IF(SLIMSK(I).EQ.1.) THEN
+	        SMCZ(I) = .5 * (SMC(I,1) + .20)
+	        DFT0(I) = KTSOIL(SMCZ(I),SOILTYP(I))
+	      ELSEIF(SLIMSK(I).EQ.2.) THEN
+        !  DF FOR ICE IS TAKEN FROM MAYKUT AND UNTERSTEINER
+        !  DF IS IN SI UNIT OF W K-1 M-1
+	        DFT0(I) = 2.2
+	      ENDIF
+	    ENDDO
+        !!
+	    DO I=1,IM
+	      IF(SLIMSK(I).NE.0.) THEN
+        !         IF(SNOWD(I).GT..001) THEN
+	        IF(FLAGSNW(I)) THEN
+        !
+        !  WHEN SNOW COVERED, GROUND HEAT FLUX COMES FROM SNOW
+        !
+		TFLX = MIN(T1(I), TSURF(I))
+		GFLUX(I) = -DFSNOW * (TFLX - STSOIL(I,1))                   &
+	   &                 / (FACTSNW(I) * MAX(SNOWD(I),.001_kind_phys))
+	        ELSE
+		GFLUX(I) = DFT0(I) * (STSOIL(I,1) - TSURF(I))               &
+	   &                 / (-.5 * ZSOIL(I,1))
+	        ENDIF
+	        GFLUX(I) = MAX(GFLUX(I),-200._kind_phys)
+	        GFLUX(I) = MIN(GFLUX(I),+200._kind_phys)
+	      ENDIF
+	    ENDDO
+	    DO I = 1, IM
+	      FLAG(I) = SLIMSK(I).NE.0.
+	      PARTLND(I) = 1.
+	      IF(SNOWD(I).GT.0..AND.SNOWD(I).LE..001) THEN
+	        PARTLND(I) = 1. - SNOWD(I) / .001
+	      ENDIF
+	    ENDDO
+	    DO I = 1, IM
+	      SNOEVP(I) = 0.
+	      if(SNOWD(I).gt..001) PARTLND(I) = 0.
+	    ENDDO
+        !
+        !  COMPUTE POTENTIAL EVAPORATION FOR LAND AND SEA ICE
+        !
+	    DO I = 1, IM
+	      IF(FLAG(I)) THEN
+	        T12 = T1(I) * T1(I)
+	        T14 = T12 * T12
+        !
+        !  RCAP = FNET - SIGMA T**4 + GFLX - RHO CP CH V (T1-THETA1)
+        !
+	        RCAP(I) = -SLWD(I) - SIGMA * T14 + GFLUX(I)                   &
+	   &              - RCH(I) * (T1(I) - THETA1(I))
+        !
+        !  RSMALL = 4 SIGMA T**3 / RCH(I) + 1
+        !
+	        RSMALL(I) = 4. * SIGMA * T1(I) * T12 / RCH(I) + 1.
+        !
+        !  DELTA = L / CP * DQS/DT
+        !
+	        DELTA(I) = ELOCP * EPS * HVAP * QS1(I) / (RD * T12)
+        !
+        !  POTENTIAL EVAPOTRANSPIRATION ( WATTS / M**2 ) AND
+        !  POTENTIAL EVAPORATION
+        !
+	        TERM1(I) = ELOCP * RSMALL(I) * RCH(I)*(QS1(I)-Q0(I))
+	        TERM2(I) = RCAP(I) * DELTA(I)
+	        EP(I) = (ELOCP * RSMALL(I) * RCH(I) * (QS1(I) - Q0(I))        &
+	   &              + RCAP(I) * DELTA(I))
+	        EP(I) = EP(I) / (RSMALL(I) + DELTA(I))
+	      ENDIF
+	    ENDDO
+        !
+        !  ACTUAL EVAPORATION OVER LAND IN THREE PARTS : EDIR, ET, AND EC
+        !
+        !  DIRECT EVAPORATION FROM SOIL, THE UNIT GOES FROM M S-1 TO KG M-2 S-1
+        !
+	    DO I = 1, IM
+	      FLAG(I) = SLIMSK(I).EQ.1..AND.EP(I).GT.0.
+	    ENDDO
+	    DO I = 1, IM
+	      IF(FLAG(I)) THEN
+	        DF1(I) = FUNCDF(SMC(I,1),SOILTYP(I))
+	        KT1(I) = FUNCKT(SMC(I,1),SOILTYP(I))
+	      endif
+	      if(FLAG(I).and.STC(I,1).lt.t0c) then
+	        DF1(I) = 0.
+	        KT1(I) = 0.
+	      endif
+	      IF(FLAG(I)) THEN
+        !         TREF = .75 * THSAT(SOILTYP(I))
+	        TREF(I) = smref(SOILTYP(I))
+        !         TWILT = TWLT(SOILTYP(I))
+	        TWILT(I) = smwlt(SOILTYP(I))
+	        smcdry = smdry(SOILTYP(I))
+        !         FX(I) = -2. * DF1(I) * (SMC(I,1) - .23) / ZSOIL(I,1)
+        !    &            - KT1(I)
+	        FX(I) = -2. * DF1(I) * (SMC(I,1) - smcdry) / ZSOIL(I,1)       &
+	   &            - KT1(I)
+	        FX(I) = MIN(FX(I), EP(I)/HVAP)
+	        FX(I) = MAX(FX(I),0._kind_phys)
+        !
+        !  SIGMAF IS THE FRACTION OF AREA COVERED BY VEGETATION
+        !
+	        EDIR(I) = FX(I) * (1. - SIGMAF(I)) * PARTLND(I)
+	      ENDIF
+	    ENDDO
+        !
+        !  calculate stomatal resistance
+        !
+	    DO I = 1, IM
+	      if(FLAG(I)) then
+        !
+        !  resistance due to PAR. We use net solar flux as proxy at the present time
+        !
+	        ff = .55 * 2. * SNET(I) / rgl(VEGTYPE(I))
+	        rcs = (ff + RS(I)/rsmax(VEGTYPE(I))) / (1. + ff)
+	        rcs = max(rcs,.0001_kind_phys)
+	        rct = 1.
+	        rcq = 1.
+        !
+        !  resistance due to thermal effect
+        !
+        !         rct = 1. - .0016 * (topt - theta1) ** 2
+        !         rct = max(rct,.0001)
+        !
+        !  resistance due to humidity
+        !
+        !         rcq = 1. / (1. + hs(VEGTYPE(I)) * (QS1(I) - Q0(I)))
+        !         rcq = max(rcq,.0001)
+        !
+        !  compute resistance without the effect of soil moisture
+        !
+	        RS(I) = RS(I) / (rcs * rct * rcq)
+	      endif
+	    ENDDO
+        !
+        !  TRANSPIRATION FROM ALL LEVELS OF THE SOIL
+        !
+	    DO I = 1, IM
+	      IF(FLAG(I)) THEN
+	        CANFAC(I) = (CANOPY(I) / SCANOP) ** CFACTR
+	      endif
+	      IF(FLAG(I)) THEN
+	        ETPFAC(I) = SIGMAF(I)                                         &
+	   &           * (1. - CANFAC(I)) / HVAP
+	        GX(I) = (SMC(I,1) - TWILT(I)) / (TREF(I) - TWILT(I))
+	        GX(I) = MAX(GX(I),0._kind_phys)
+	        GX(I) = MIN(GX(I),1._kind_phys)
+        !
+        !  resistance due to soil moisture deficit
+        !
+	        rss = GX(I) * (ZSOIL(I,1) / ZSOIL(I,km))
+	        rss = max(rss,.0001_kind_phys)
+	        RSI = RS(I) / rss
+        !
+        !  transpiration a la Monteith
+        !
+	        eth = (TERM1(I) + TERM2(I)) /                                 &
+	   &          (DELTA(I) + RSMALL(I) * (1. + RSI * CH(I) * WIND(I)))
+	        ET(I,1) = ETPFAC(I) * eth                                     &
+	   &            * PARTLND(I)
+	      ENDIF
+	    ENDDO
+        !!
+	    DO K = 2, KM
+	      DO I=1,IM
+	        IF(FLAG(I)) THEN
+		GX(I) = (SMC(I,K) - TWILT(I)) / (TREF(I) - TWILT(I))
+		GX(I) = MAX(GX(I),0._kind_phys)
+		GX(I) = MIN(GX(I),1._kind_phys)
+        !
+        !  resistance due to soil moisture deficit
+        !
+	        rss = GX(I) * ((ZSOIL(I,k) - ZSOIL(I,k-1))/ZSOIL(I,km))
+	        rss = max(rss,1.e-6_kind_phys)
+	        RSI = RS(I) / rss
+        !
+        !  transpiration a la Monteith
+        !
+	        eth = (TERM1(I) + TERM2(I)) /                                 &
+	   &          (DELTA(I) + RSMALL(I) * (1. + RSI * CH(I) * WIND(I)))
+		ET(I,K) = eth                                               & 
+	   &               * ETPFAC(I) * PARTLND(I)
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !!
+         400  CONTINUE
+        !
+        !  CANOPY RE-EVAPORATION
+        !
+	    DO I=1,IM
+	      IF(FLAG(I)) THEN
+	        EC(I) = SIGMAF(I) * CANFAC(I) * EP(I) / HVAP
+	        EC(I) = EC(I) * PARTLND(I)
+	        EC(I) = min(EC(I),CANOPY(I)/delt)
+	      ENDIF
+	    ENDDO
+        !
+        !  SUM UP TOTAL EVAPORATION
+        !
+	    DO I = 1, IM
+	      IF(FLAG(I)) THEN
+	       EVAP(I) = EDIR(I) + EC(I)
+	      ENDIF
+	    ENDDO
+        !!
+	    DO K = 1, KM
+	      DO I=1,IM
+	        IF(FLAG(I)) THEN
+		EVAP(I) = EVAP(I) + ET(I,K)
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !!
+        !
+        !  RETURN EVAP UNIT FROM KG M-2 S-1 TO WATTS M-2
+        !
+	    DO I=1,IM
+	      IF(FLAG(I)) THEN
+	        EVAP(I) = MIN(EVAP(I)*HVAP,EP(I))
+	      ENDIF
+	    ENDDO
+        !##DG  IF(LAT.EQ.LATD) THEN
+        !##DG    PRINT *, 'FX(I), SIGMAF, EDIR(I), ETPFAC=', FX(I)*HVAP,SIGMAF,
+        !##DG&          EDIR(I)*HVAP,ETPFAC*HVAP
+        !##DG    PRINT *, ' ET =', (ET(K)*HVAP,K=1,KM)
+        !##DG    PRINT *, ' CANFAC(I), EC(I), EVAP', CANFAC(I),EC(I)*HVAP,EVAP
+        !##DG  ENDIF
+        !
+        !  EVAPORATION OVER BARE SEA ICE
+        !
+	    DO I = 1, IM
+        !       IF(SLIMSK(I).EQ.2.AND.SNOWD(I).LE..001) THEN
+	      IF(SLIMSK(I).EQ.2.) THEN
+	        EVAP(I) = PARTLND(I) * EP(I)
+	      ENDIF
+	    ENDDO
+        !
+        !  TREAT DOWNWARD MOISTURE FLUX SITUATION
+        !  (EVAP WAS PRESET TO ZERO SO NO UPDATE NEEDED)
+        !  DEW IS CONVERTED FROM KG M-2 TO M TO CONFORM TO PRECIP UNIT
+        !
+	    DO I = 1, IM
+	      FLAG(I) = SLIMSK(I).NE.0..AND.EP(I).LE.0.
+	      DEW(I) = 0.
+	    ENDDO
+	    DO I = 1, IM
+	      IF(FLAG(I)) THEN
+	        DEW(I) = -EP(I) * DELT / (HVAP * RHOH2O)
+	        EVAP(I) = EP(I)
+	        DEW(I) = DEW(I) * PARTLND(I)
+	        EVAP(I) = EVAP(I) * PARTLND(I)
+	        DM(I) = 1.
+	      ENDIF
+	    ENDDO
+        !
+        !  SNOW COVERED LAND AND SEA ICE
+        !
+	    DO I = 1, IM
+	      FLAG(I) = SLIMSK(I).NE.0..AND.SNOWD(I).GT.0.
+	    ENDDO
+        !
+        !  CHANGE OF SNOW DEPTH DUE TO EVAPORATION OR SUBLIMATION
+        !
+        !  CONVERT EVAP FROM KG M-2 S-1 TO M S-1 TO DETERMINE THE REDUCTION OF S
+        !
+	    DO I = 1, IM
+	      IF(FLAG(I)) THEN
+	        BFACT = SNOWD(I) / (DELT * EP(I) / (HVAP * RHOH2O))
+	        BFACT = MIN(BFACT,1._kind_phys)
+        !
+        !  THE EVAPORATION OF SNOW
+        !
+	        IF(EP(I).LE.0.) BFACT = 1.
+	        IF(SNOWD(I).LE..001) THEN
+        !           EVAP = (SNOWD(I)/.001)*BFACT*EP(I) + EVAP
+        !           SNOEVP(I) = bfact * EP(I) * (1. - PARTLND(I))
+        !           EVAP = EVAP + SNOEVP(I)
+		SNOEVP(I) = bfact * EP(I)
+        !           EVAP   = EVAP + SNOEVP(I) * (1. - PARTLND(I))
+		EVAP(I)=EVAP(I)+SNOEVP(I)*(1.-PARTLND(I))
+	        ELSE
+        !           EVAP(I) = BFACT * EP(I)
+		SNOEVP(I) = bfact * EP(I)
+		EVAP(I) = SNOEVP(I)
+	        ENDIF
+	        TSURF(I) = T1(I) +                                            &
+	   &          (RCAP(I) - GFLUX(I) - DFSNOW * (T1(I) - STSOIL(I,1))    &
+	   &           /(FACTSNW(I) * MAX(SNOWD(I),.001_kind_phys))           &
+        !    &           + THETA1 - T1                                          &
+        !    &           - BFACT * EP(I)) / (RSMALL(I) * RCH(I)                 &
+	   &           - SNOEVP(I)) / (RSMALL(I) * RCH(I)                     &
+	   &           + DFSNOW / (FACTSNW(I)* MAX(SNOWD(I),.001_kind_phys)))
+        !         SNOWD(I) = SNOWD(I) - BFACT * EP(I) * DELT / (RHOH2O * HVAP)
+	        SNOWD(I) = SNOWD(I) - SNOEVP(I) * delt / (rhoh2o * hvap)
+	        SNOWD(I) = MAX(SNOWD(I),0._kind_phys)
+	      ENDIF
+	    ENDDO
+        !
+        !  SNOW MELT (M)
+        !
+         500  CONTINUE
+	    DO I = 1, IM
+	      FLAG(I) = SLIMSK(I).NE.0.                                       &
+	   &            .AND.SNOWD(I).GT..0
+	    ENDDO
+	    DO I = 1, IM
+	      IF(FLAG(I).AND.TSURF(I).GT.T0C) THEN
+	        SNOWMT(I) = RCH(I) * RSMALL(I) * DELT                         &
+	   &              * (TSURF(I) - T0C) / (RHOH2O * HFUS)
+	        SNOWMT(I) = min(SNOWMT(I),SNOWD(I))
+	        SNOWD(I) = SNOWD(I) - SNOWMT(I)
+	        SNOWD(I) = MAX(SNOWD(I),0._kind_phys)
+	        TSURF(I) = MAX(T0C,TSURF(I)                                   &
+	   &             -HFUS*SNOWMT(I)*RHOH2O/(RCH(I)*RSMALL(I)*DELT))
+	      ENDIF
+	    ENDDO
+        !
+        !  We need to re-evaluate evaporation because of snow melt
+        !    the skin temperature is now bounded to 0 deg C
+        !
+        !     qss = fpvs(tsurf)
+	    DO I = 1, IM
+        !       IF (SNOWD(I) .GT. 0.0) THEN
+	      IF (SNOWD(I) .GT. snomin) THEN
+        !jfe      QSS(I) = 1000. * FPVS(TSURF(I))
+	        qss(i) = fpvs(tsurf(i))
+	        QSS(I) = EPS * QSS(I) / (PSURF(I) + EPSM1 * QSS(I))
+	        EVAP(I) = elocp * RCH(I) * (QSS(I) - Q0(I))
+	      ENDIF
+	    ENDDO
+        !
+        !  PREPARE TENDENCY TERMS FOR THE SOIL MOISTURE FIELD WITHOUT PRECIPITAT
+        !  THE UNIT OF MOISTURE FLUX NEEDS TO BECOME M S-1 FOR SOIL MOISTURE
+        !   HENCE THE FACTOR OF RHOH2O
+        !
+	    DO I = 1, IM
+	      FLAG(I) = SLIMSK(I).EQ.1.
+	      if(FLAG(I)) then
+	        DF1(I) = FUNCDF(SMCZ(I),SOILTYP(I))
+	        KT1(I) = FUNCKT(SMCZ(I),SOILTYP(I))
+	      endif
+	      if(FLAG(I).and.STC(I,1).lt.t0c) then
+	        DF1(I) = 0.
+	        KT1(I) = 0.
+	      endif
+	      IF(FLAG(I)) THEN
+	        RHSCNPY(I) = -EC(I) + SIGMAF(I) * RHOH2O * DEW(I) / DELT
+	        SMCZ(I) = MAX(SMC(I,1), SMC(I,2))
+	        DMDZ(I) = (SMC(I,1) - SMC(I,2)) / (-.5 * ZSOIL(I,2))
+	        RHSMC(I,1) = (DF1(I) * DMDZ(I) + KT1(I)                       &
+	   &        + (EDIR(I) + ET(I,1))) / (ZSOIL(I,1) * RHOH2O)
+	        RHSMC(I,1) = RHSMC(I,1) - (1. - SIGMAF(I)) * DEW(I) /         &
+	   &                 ( ZSOIL(I,1) * delt)
+	        DDZ(I) = 1. / (-.5 * ZSOIL(I,2))
+        !
+        !  AIM, BIM, AND CIM ARE THE ELEMENTS OF THE TRIDIAGONAL MATRIX FOR THE
+        !  IMPLICIT UPDATE OF THE SOIL MOISTURE
+        !
+	        AIM(I,1) = 0.
+	        BIM(I,1) = DF1(I) * DDZ(I) / (-ZSOIL(I,1) * RHOH2O)
+	        CIM(I,1) = -BIM(I,1)
+	      ENDIF
+	    ENDDO
+        !!
+	    DO K = 2, KM
+	      IF(K.LT.KM) THEN
+	        DO I=1,IM
+		IF(FLAG(I)) THEN
+		  DF2 = FUNCDF(SMCZ(I),SOILTYP(I))
+		  KT2(I) = FUNCKT(SMCZ(I),SOILTYP(I))
+		ENDIF
+		IF(FLAG(I).and.STC(I,k).lt.t0c) THEN
+		  df2 = 0.
+		  KT2(I) = 0.
+		ENDIF
+		IF(FLAG(I)) THEN
+		  DMDZ2(I) = (SMC(I,K) - SMC(I,K+1))                        &
+	   &                   / (.5 * (ZSOIL(I,K-1) - ZSOIL(I,K+1)))
+		  SMCZ(I) = MAX(SMC(I,K), SMC(I,K+1))
+		  RHSMC(I,K) = (DF2 * DMDZ2(I) + KT2(I)                     &
+	   &             - DF1(I) * DMDZ(I) - KT1(I) + ET(I,K))               &
+	   &                     / (RHOH2O*(ZSOIL(I,K) - ZSOIL(I,K-1)))
+		  DDZ2(I) = 2. / (ZSOIL(I,K-1) - ZSOIL(I,K+1))
+		  CIM(I,K) = -DF2 * DDZ2(I)                                 &
+	   &                / ((ZSOIL(I,K-1) - ZSOIL(I,K))*RHOH2O)
+		ENDIF
+	        ENDDO
+	      ELSE
+	        DO I = 1, IM
+		IF(FLAG(I)) THEN
+		  KT2(I) = FUNCKT(SMC(I,K),SOILTYP(I))
+		ENDIF
+		if(FLAG(I).and.STC(I,k).lt.t0c) KT2(I) = 0.
+		IF(FLAG(I)) THEN
+		  RHSMC(I,K) = (KT2(I)                                      &
+	   &             - DF1(I) * DMDZ(I) - KT1(I) + ET(I,K))               &
+	   &                     / (RHOH2O*(ZSOIL(I,K) - ZSOIL(I,K-1)))
+		  DRAIN(I) = KT2(I)
+		  CIM(I,K) = 0.
+		ENDIF
+	        ENDDO
+	      ENDIF
+	      DO I = 1, IM
+	        IF(FLAG(I)) THEN
+		AIM(I,K) = -DF1(I) * DDZ(I)                                 &
+	   &                / ((ZSOIL(I,K-1) - ZSOIL(I,K))*RHOH2O)
+		BIM(I,K) = -(AIM(I,K) + CIM(I,K))
+		DF1(I) = DF2
+		KT1(I) = KT2(I)
+		DMDZ(I) = DMDZ2(I)
+		DDZ(I) = DDZ2(I)
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !!
+         600  CONTINUE
+        !
+        !  UPDATE SOIL TEMPERATURE AND SEA ICE TEMPERATURE
+        !
+	    DO I=1,IM
+	      FLAG(I) = SLIMSK(I).NE.0.
+	    ENDDO
+        !
+        !  SURFACE TEMPERATURE IS PART OF THE UPDATE WHEN SNOW IS ABSENT
+        !
+	    DO I=1,IM
+        !       IF(FLAG(I).AND.SNOWD(I).LE..001) THEN
+	      IF(FLAG(I).AND..NOT.FLAGSNW(I)) THEN
+	        YY(I) = T1(I) +                                               &
+        !    &          (RCAP(I)-GFLUX(I) + THETA1 - T1(I)                      &
+	   &          (RCAP(I)-GFLUX(I)                                       &
+	   &           - EVAP(I)) / (RSMALL(I) * RCH(I))
+	        ZZ(I) = 1. + DFT0(I) / (-.5 * ZSOIL(I,1) * RCH(I) * RSMALL(I))
+	        XX(I) = DFT0(I) * (STSOIL(I,1) - YY(I)) /                     &
+	   &            (.5 * ZSOIL(I,1) * ZZ(I))
+	      ENDIF
+        !       IF(FLAG(I).AND.SNOWD(I).GT..001) THEN
+	      IF(FLAG(I).AND.FLAGSNW(I)) THEN
+	        YY(I) = STSOIL(I,1)
+        !
+        !  HEAT FLUX FROM SNOW IS EXPLICIT IN TIME
+        !
+	        ZZ(I) = 1.
+	        XX(I) = DFSNOW * (STSOIL(I,1) - TSURF(I))                     &
+	   &            / (-FACTSNW(I) * MAX(SNOWD(I),.001_kind_phys))
+	      ENDIF
+	    ENDDO
+        !
+        !  COMPUTE THE FORCING AND THE IMPLICIT MATRIX ELEMENTS FOR UPDATE
+        !
+        !  CH2O IS THE HEAT CAPACITY OF WATER AND CSOIL IS THE HEAT CAPACITY OF
+        !
+	    DO I = 1, IM
+	      IF(FLAG(I)) THEN
+	        SMCZ(I) = MAX(SMC(I,1), SMC(I,2))
+	        DTDZ1(I) = (STSOIL(I,1) - STSOIL(I,2)) / (-.5 * ZSOIL(I,2))
+	        IF(SLIMSK(I).EQ.1.) THEN
+		DFT1(I) = KTSOIL(SMCZ(I),SOILTYP(I))
+		HCPCT(I) = SMC(I,1) * CH2O + (1. - SMC(I,1)) * CSOIL
+	        ELSE
+		DFT1(I) = DFT0(I)
+		HCPCT(I) = CICE
+	        ENDIF
+	        DFT2(I) = DFT1(I)
+	        DDZ(I) = 1. / (-.5 * ZSOIL(I,2))
+        !
+        !  AI, BI, AND CI ARE THE ELEMENTS OF THE TRIDIAGONAL MATRIX FOR THE
+        !  IMPLICIT UPDATE OF THE SOIL TEMPERATURE
+        !
+	        AI(I,1) = 0.
+	        BI(I,1) = DFT1(I) * DDZ(I) / (-ZSOIL(I,1) * HCPCT(I))
+	        CI(I,1) = -BI(I,1)
+	        BI(I,1) = BI(I,1)                                             &
+	   &            + DFT0(I) / (.5 * ZSOIL(I,1) **2 * HCPCT(I) * ZZ(I))  
+        !         SS = DFT0(I) * (STSOIL(I,1) - YY(I))                          &
+        !    &         / (.5 * ZSOIL(I,1) * ZZ(I))
+        !         RHSTC(1) = (DFT1(I) * DTDZ1(I) - SS)
+	        RHSTC(I,1) = (DFT1(I) * DTDZ1(I) - XX(I))                     &
+	   &                 / (ZSOIL(I,1) * HCPCT(I))
+	      ENDIF
+	    ENDDO
+        !!
+	    DO K = 2, KM
+	      DO I=1,IM
+	        IF(SLIMSK(I).EQ.1.) THEN
+		HCPCT(I) = SMC(I,K) * CH2O + (1. - SMC(I,K)) * CSOIL
+	        ELSEIF(SLIMSK(I).EQ.2.) THEN
+		HCPCT(I) = CICE
+	        ENDIF
+	      ENDDO
+	      IF(K.LT.KM) THEN
+	        DO I = 1, IM
+		IF(FLAG(I)) THEN
+		  DTDZ2(I) = (STSOIL(I,K) - STSOIL(I,K+1))                  &
+	   &                   / (.5 * (ZSOIL(I,K-1) - ZSOIL(I,K+1)))
+		  SMCZ(I) = MAX(SMC(I,K), SMC(I,K+1))
+		  IF(SLIMSK(I).EQ.1.) THEN
+		    DFT2(I) = KTSOIL(SMCZ(I),SOILTYP(I))
+		  ENDIF
+		  DDZ2(I) = 2. / (ZSOIL(I,K-1) - ZSOIL(I,K+1))
+		  CI(I,K) = -DFT2(I) * DDZ2(I)                              &
+	   &                / ((ZSOIL(I,K-1) - ZSOIL(I,K)) * HCPCT(I))
+		ENDIF
+	        ENDDO
+	      ELSE
+        !
+        !  AT THE BOTTOM, CLIMATOLOGY IS ASSUMED AT 2M DEPTH FOR LAND AND
+        !  FREEZING TEMPERATURE IS ASSUMED FOR SEA ICE AT Z(KM)
+	        DO I = 1, IM
+		IF(SLIMSK(I).EQ.1.) THEN
+		  DTDZ2(I) = (STSOIL(I,K) - TG3(I))                         &
+	   &              / (.5 * (ZSOIL(I,K-1) + ZSOIL(I,K)) - ZBOT)
+		  DFT2(I) = KTSOIL(SMC(I,K),SOILTYP(I))
+		  CI(I,K) = 0.
+		ENDIF
+		IF(SLIMSK(I).EQ.2.) THEN
+		  DTDZ2(I) = (STSOIL(I,K) - TGICE)                          &
+	   &                   / (.5 * ZSOIL(I,K-1) - .5 * ZSOIL(I,K))
+		  DFT2(I) = DFT1(I)
+		  CI(I,K) = 0.
+		ENDIF
+	        ENDDO
+	      ENDIF
+	      DO I = 1, IM
+	        IF(FLAG(I)) THEN
+		RHSTC(I,K) = (DFT2(I) * DTDZ2(I) - DFT1(I) * DTDZ1(I))      &
+	   &                 / ((ZSOIL(I,K) - ZSOIL(I,K-1)) * HCPCT(I))
+		AI(I,K) = -DFT1(I) * DDZ(I)                                 & 
+	   &                / ((ZSOIL(I,K-1) - ZSOIL(I,K)) * HCPCT(I))
+		BI(I,K) = -(AI(I,K) + CI(I,K))
+		DFT1(I) = DFT2(I)
+		DTDZ1(I) = DTDZ2(I)
+		DDZ(I) = DDZ2(I)
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !!
+         700  CONTINUE
+        !
+        !  SOLVE THE TRI-DIAGONAL MATRIX
+        !
+	    DO K = 1, KM
+	      DO I=1,IM
+	        IF(FLAG(I))  THEN
+		RHSTC(I,K) = RHSTC(I,K) * DELT2
+		AI(I,K) = AI(I,K) * DELT2
+		BI(I,K) = 1. + BI(I,K) * DELT2
+		CI(I,K) = CI(I,K) * DELT2
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !  FORWARD ELIMINATION
+	    DO I=1,IM
+	      IF(FLAG(I)) THEN
+	        CI(I,1) = -CI(I,1) / BI(I,1)
+	        RHSTC(I,1) = RHSTC(I,1) / BI(I,1)
+	      ENDIF
+	    ENDDO
+        !!
+	    DO K = 2, KM
+	      DO I=1,IM
+	        IF(FLAG(I)) THEN
+		CC = 1. / (BI(I,K) + AI(I,K) * CI(I,K-1))
+		CI(I,K) = -CI(I,K) * CC
+		RHSTC(I,K) = (RHSTC(I,K) - AI(I,K) * RHSTC(I,K-1)) * CC
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !!
+        !  BACKWARD SUBSTITUTTION
+	    DO I=1,IM
+	      IF(FLAG(I)) THEN
+	        CI(I,KM) = RHSTC(I,KM)
+	      ENDIF
+	    ENDDO
+        !!
+	    DO K = KM-1, 1
+	      DO I=1,IM
+	        IF(FLAG(I)) THEN
+		CI(I,K) = CI(I,K) * CI(I,K+1) + RHSTC(I,K)
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !
+        !  UPDATE SOIL AND ICE TEMPERATURE
+        !
+	    DO K = 1, KM
+	      DO I=1,IM
+	        IF(FLAG(I)) THEN
+		STSOIL(I,K) = STSOIL(I,K) + CI(I,K)
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !
+        !  UPDATE SURFACE TEMPERATURE FOR SNOW FREE SURFACES
+        !
+	    DO I=1,IM
+        !       IF(SLIMSK(I).NE.0..AND.SNOWD(I).LE..001) THEN
+	      IF(SLIMSK(I).NE.0..AND..NOT.FLAGSNW(I)) THEN
+	        TSURF(I) = (YY(I) + (ZZ(I) - 1.) * STSOIL(I,1)) / ZZ(I)
+	      ENDIF
+        !       IF(SLIMSK(I).EQ.2..AND.SNOWD(I).LE..001) THEN
+	      IF(SLIMSK(I).EQ.2..AND..NOT.FLAGSNW(I)) THEN
+	        TSURF(I) = MIN(TSURF(I),T0C)
+	      ENDIF
+	    ENDDO
+        !!
+	    DO K = 1, KM
+	      DO I=1,IM
+	        IF(SLIMSK(I).EQ.2) THEN
+		STSOIL(I,K) = MIN(STSOIL(I,K),T0C)
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !
+        !  TIME FILTER FOR SOIL AND SKIN TEMPERATURE
+        !
+	    DO I=1,IM
+	      IF(SLIMSK(I).NE.0.) THEN
+	        TSKIN(I) = CTFIL1 * TSURF(I) + CTFIL2 * TSKIN(I)
+	      ENDIF
+	    ENDDO
+	    DO K = 1, KM
+	      DO I=1,IM
+	        IF(SLIMSK(I).NE.0.) THEN
+		STC(I,K) = CTFIL1 * STSOIL(I,K) + CTFIL2 * STC(I,K)
+	        ENDIF
+	      ENDDO
+	    ENDDO
+        !
+        !  GFLUX CALCULATION
+        !
+	    DO I=1,IM
+	      FLAG(I) = SLIMSK(I).NE.0.                                       &
+        !    &            .AND.SNOWD(I).GT..001                                 &
+	   &            .AND.FLAGSNW(I)
+	    ENDDO
+	    DO I = 1, IM
+	      IF(FLAG(I)) THEN
+	        GFLUX(I) = -DFSNOW * (TSKIN(I) - STC(I,1))                    &
+	   &               / (FACTSNW(I) * MAX(SNOWD(I),.001_kind_phys))
+	      ENDIF
+	    ENDDO
+	    DO I = 1, IM
+        !       IF(SLIMSK(I).NE.0..AND.SNOWD(I).LE..001) THEN
+	      IF( SLIMSK(I).NE.0..AND..NOT.FLAGSNW(I)) THEN
+	        GFLUX(I) = DFT0(I) * (STC(I,1) - TSKIN(I))                    &
+	   &               / (-.5 * ZSOIL(I,1))
+	      ENDIF
+	    ENDDO
+
+
+5555  CONTINUE
+
+        !
+        !  CALCULATE SENSIBLE HEAT FLUX
+        !
+!WRF	    DO I = 1, IM
+!WRF      HFLX(I) = RCH(I) * (TSKIN(I) - THETA1(I))
+!WRF	    ENDDO
+        !
+        !  THE REST OF THE OUTPUT
+        !
+!WRF	    DO I = 1, IM
+!WRF	      QSURF(I) = Q1(I) + EVAP(I) / (ELOCP * RCH(I))
+!WRF	      DM(I) = 1.
+        !
+        !  CONVERT SNOW DEPTH BACK TO MM OF WATER EQUIVALENT
+        !
+!WRF	      SHELEG(I) = SNOWD(I) * 1000.
+!WRF	    ENDDO
+        !
+
+      DO I = 1, IM
+        F10M(I) = FM10(I) / FM(I)
+        F10M(I) = min(F10M(I),1._kind_phys)
+        U10M(I) = F10M(I) * XRCL(I) * U1(I)
+        V10M(I) = F10M(I) * XRCL(I) * V1(I)
+!WRF         T2M(I) = TSKIN(I) * (1. - FH2(I) / FH(I))                      &
+!WRF     &          + THETA1(I) * FH2(I) / FH(I)
+!WRF         T2M(I) = T2M(I) * SIG2K
+!        Q2M(I) = QSURF(I) * (1. - FH2(I) / FH(I))                      &
+!    &         + Q1(I) * FH2(I) / FH(I)
+!       T2M(I) = T1
+!       Q2M(I) = Q1
+!WRF        IF(EVAP(I).GE.0.) THEN
+!
+!  IN CASE OF EVAPORATION, USE THE INFERRED QSURF TO DEDUCE Q2M
+!
+!WRF          Q2M(I) = QSURF(I) * (1. - FH2(I) / FH(I))                     &
+!WRF     &         + Q1(I) * FH2(I) / FH(I)
+!WRF        ELSE
+!
+!  FOR DEW FORMATION SITUATION, USE SATURATED Q AT TSKIN
+!
+!jfe      QSS(I) = 1000. * FPVS(TSKIN(I))
+!WRF          qss(I) = fpvs(tskin(I))
+!WRF          QSS(I) = EPS * QSS(I) / (PSURF(I) + EPSM1 * QSS(I))
+!WRF          Q2M(I) = QSS(I) * (1. - FH2(I) / FH(I))                       &
+!WRF     &         + Q1(I) * FH2(I) / FH(I)
+!WRF        ENDIF
+!jfe    QSS(I) = 1000. * FPVS(T2M(I))
+!WRF        QSS(I) = fpvs(t2m(I))
+!       QSS(I) = 1000. * T2MO(I)
+!WRF        QSS(I) = EPS * QSS(I) / (PSURF(I) + EPSM1 * QSS(I))
+!WRF        Q2M(I) = MIN(Q2M(I),QSS(I))
+      ENDDO
+!!
+!     DO I = 1, IM
+!       RNET(I) = -SLWD(I) - SIGMA * TSKIN(I) **4
+!     ENDDO
+!!
+!
+!WRF      do i=1,im
+!WRF        tem     = 1.0 / rho(i)
+!WRF        hflx(i) = hflx(i) * tem * cpinv
+!WRF        evap(i) = evap(i) * tem * hvapi
+!WRF      enddo
+
+
+!
+!##DG  IF(LAT.EQ.LATD) THEN
+!C       RBAL = -SLWD-SIGMA*TSKIN**4+GFLUX
+!C    &         -EVAP - HFLX
+!##DG    PRINT 6000,HFLX,EVAP,GFLUX,
+!##DG&             STC(1), STC(2),TSKIN,RNET,SLWD
+!##DG    PRINT *, ' T1 =', T1
+ 6000 FORMAT(8(F8.2,','))
+!C     PRINT *, ' EP, ETP,T2M(I) =', EP, ETP,T2M(I)
+!C     PRINT *, ' FH, FH2 =', FH, FH2
+!C     PRINT *, ' PH, PH2 =', PH, PH2
+!C     PRINT *, ' CH, RCH =', CH, RCH
+!C     PRINT *, ' TERM1, TERM2 =', TERM1, TERM2
+!C     PRINT *, ' RS(I), PLANTR =', RS(I), PLANTR
+!##DG  ENDIF
+
+      RETURN
+      END SUBROUTINE PROGTM
+!
+!  PROGT2 IS THE SECOND PART OF THE SOIL MODEL THAT IS EXECUTED
+!  AFTER PRECIPITATION FOR THE TIME STEP HAS BEEN CALCULATED
+!
+!FPP$ NOCONCUR R
+!FPP$ EXPAND(FUNCDF,FUNCKT,THSAT)
+      SUBROUTINE PROGT2(IM,KM,RHSCNPY,                                  &
+     &                  RHSMC,AI,BI,CI,SMC,SLIMSK,                      &
+     &                  CANOPY,PRECIP,RUNOFF,SNOWMT,                    &
+     &                  ZSOIL,SOILTYP,SIGMAF,DELT,me)
+!c
+      USE MODULE_GFS_MACHINE     , ONLY : kind_phys
+      implicit none
+      integer              km, IM, me
+      real(kind=kind_phys) delt
+      real(kind=kind_phys) RHSCNPY(IM),  RHSMC(IM,KM), AI(IM,KM),       &
+     &                     BI(IM,KM),    CI(IM,KM),    SMC(IM,KM),      &
+     &                     SLIMSK(IM),   CANOPY(IM),   PRECIP(IM),      &
+     &                     RUNOFF(IM),   SNOWMT(IM),   ZSOIL(IM,KM),    &
+     &                     SIGMAF(IM)
+      INTEGER SOILTYP(IM)
+!
+      integer              k, lond, i
+      real(kind=kind_phys) CNPY(IM), PRCP(IM),   TSAT(IM),              &
+     &                     INF(IM),  INFMAX(IM), SMSOIL(IM,KM)
+!
+      real(kind=kind_phys) cc,    ctfil1, ctfil2, delt2,                &
+     &                     drip,  rffact, rhoh2o,                       &
+!WRF     &                     rzero, scanop, tdif, thsat, KSAT
+     &                     rzero, scanop, tdif, KSAT
+!
+      LOGICAL FLAG(IM)
+!c
+      PARAMETER (SCANOP=.5, RHOH2O=1000.)
+      PARAMETER (CTFIL1=.5, CTFIL2=1.-CTFIL1)
+!     PARAMETER (CTFIL1=1., CTFIL2=1.-CTFIL1)
+      PARAMETER (RFFACT=.15)
+!
+!##DG LATD = 44
+      LOND = 353
+      DELT2 = DELT * 2.
+!
+!  PRECIPITATION RATE IS NEEDED IN UNIT OF KG M-2 S-1
+!
+      DO I=1,IM
+        PRCP(I) = RHOH2O * (PRECIP(I)+SNOWMT(I)) / DELT
+        RUNOFF(I) = 0.
+        CNPY(I) = CANOPY(I)
+      ENDDO
+!##DG  IF(LAT.EQ.LATD) THEN
+!##DG    PRINT *, ' BEFORE RUNOFF CAL, RHSMC =', RHSMC(1)
+!##DG  ENDIF
+!
+!  UPDATE CANOPY WATER CONTENT
+!
+      DO I=1,IM
+        IF(SLIMSK(I).EQ.1.) THEN
+          RHSCNPY(I) = RHSCNPY(I) + SIGMAF(I) * PRCP(I)
+          CANOPY(I) = CANOPY(I) + DELT * RHSCNPY(I)
+          CANOPY(I) = MAX(CANOPY(I),0._kind_phys)
+          PRCP(I) = PRCP(I) * (1. - SIGMAF(I))
+          IF(CANOPY(I).GT.SCANOP) THEN
+            DRIP = CANOPY(I) - SCANOP
+            CANOPY(I) = SCANOP
+            PRCP(I) = PRCP(I) + DRIP / DELT
+          ENDIF
+!
+!  CALCULATE INFILTRATION RATE
+!
+          INF(I) = PRCP(I)
+          TSAT(I) = THSAT(SOILTYP(I))
+!         DSAT = FUNCDF(TSAT(I),SOILTYP(I))
+!         KSAT = FUNCKT(TSAT(I),SOILTYP(I))
+!         INFMAX(I) = -DSAT * (TSAT(I) - SMC(I,1))
+!    &                / (.5 * ZSOIL(I,1))                               &
+!    &                + KSAT 
+          INFMAX(I) = (-ZSOIL(I,1)) *                                   &
+     &                ((TSAT(I) - SMC(I,1)) / DELT - RHSMC(I,1))        &
+     &                * RHOH2O
+          INFMAX(I) = MAX(RFFACT*INFMAX(I),0._kind_phys)
+!         IF(SMC(I,1).GE.TSAT(I)) INFMAX(I) = KSAT
+!         IF(SMC(I,1).GE.TSAT(I)) INFMAX(I) = ZSOIL(I,1) * RHSMC(I,1)
+          IF(INF(I).GT.INFMAX(I)) THEN
+            RUNOFF(I) = INF(I) - INFMAX(I)
+            INF(I) = INFMAX(I)
+          ENDIF
+          INF(I) = INF(I) / RHOH2O
+          RHSMC(I,1) = RHSMC(I,1) - INF(I) / ZSOIL(I,1)
+        ENDIF
+      ENDDO
+!!
+!##DG  IF(LAT.EQ.LATD) THEN
+!##DG    PRINT *, ' PRCP(I), INFMAX(I), RUNOFF =', PRCP(I),INFMAX(I),RUNOFF
+!##DG    PRINT *, ' SMSOIL =', SMC(1), SMC(2)
+!##DG    PRINT *, ' RHSMC =', RHSMC(1)
+!##DG  ENDIF
+!
+!  WE CURRENTLY IGNORE THE EFFECT OF RAIN ON SEA ICE
+!
+      DO I=1,IM
+        FLAG(I) = SLIMSK(I).EQ.1.
+      ENDDO
+!!
+!
+!  SOLVE THE TRI-DIAGONAL MATRIX
+!
+      DO K = 1, KM
+        DO I=1,IM
+          IF(FLAG(I))  THEN
+            RHSMC(I,K) = RHSMC(I,K) * DELT2
+            AI(I,K) = AI(I,K) * DELT2
+            BI(I,K) = 1. + BI(I,K) * DELT2
+            CI(I,K) = CI(I,K) * DELT2
+          ENDIF
+        ENDDO
+      ENDDO
+!  FORWARD ELIMINATION
+      DO I=1,IM
+        IF(FLAG(I)) THEN
+          CI(I,1) = -CI(I,1) / BI(I,1)
+          RHSMC(I,1) = RHSMC(I,1) / BI(I,1)
+        ENDIF
+      ENDDO
+      DO K = 2, KM
+        DO I=1,IM
+          IF(FLAG(I)) THEN
+            CC = 1. / (BI(I,K) + AI(I,K) * CI(I,K-1))
+            CI(I,K) = -CI(I,K) * CC
+            RHSMC(I,K)=(RHSMC(I,K)-AI(I,K)*RHSMC(I,K-1))*CC
+          ENDIF
+        ENDDO
+      ENDDO
+!  BACKWARD SUBSTITUTTION
+      DO I=1,IM
+        IF(FLAG(I)) THEN
+          CI(I,KM) = RHSMC(I,KM)
+        ENDIF
+      ENDDO
+!!
+      DO K = KM-1, 1
+        DO I=1,IM
+          IF(FLAG(I)) THEN
+            CI(I,K) = CI(I,K) * CI(I,K+1) + RHSMC(I,K)
+          ENDIF
+        ENDDO
+      ENDDO
+ 100  CONTINUE
+!
+!  UPDATE SOIL MOISTURE
+!
+      DO K = 1, KM
+        DO I=1,IM
+          IF(FLAG(I)) THEN
+            SMSOIL(I,K) = SMC(I,K) + CI(I,K)
+            SMSOIL(I,K) = MAX(SMSOIL(I,K),0._kind_phys)
+            TDIF = MAX(SMSOIL(I,K) - TSAT(I),0._kind_phys)
+            RUNOFF(I) = RUNOFF(I) -                                     &
+     &                RHOH2O * TDIF * ZSOIL(I,K) / DELT
+            SMSOIL(I,K) = SMSOIL(I,K) - TDIF
+          ENDIF
+        ENDDO
+      ENDDO
+      DO K = 1, KM
+        DO I=1,IM
+          IF(FLAG(I)) THEN
+            SMC(I,K) = CTFIL1 * SMSOIL(I,K) + CTFIL2 * SMC(I,K)
+          ENDIF
+        ENDDO
+      ENDDO
+!       IF(FLAG(I)) THEN
+!         CANOPY(I) = CTFIL1 * CANOPY(I) + CTFIL2 * CNPY(I)
+!       ENDIF
+!     I = 1
+!     PRINT *, ' SMC'
+!     PRINT 6000, SMC(1), SMC(2)
+!6000 FORMAT(2(F8.5,','))
+      RETURN
+      END SUBROUTINE PROGT2
+      FUNCTION KTSOIL(THETA,KTYPE)
+!
+      USE MODULE_GFS_MACHINE     , ONLY : kind_phys
+      USE module_progtm , ONLY : TSAT, DFKT
+      implicit none
+      integer              ktype,kw
+      real(kind=kind_phys) ktsoil, theta, w
+!
+      W = (THETA / TSAT(KTYPE)) * 20. + 1.
+      KW = W
+      KW = MIN(KW,21)
+      KW = MAX(KW,1)
+      KTSOIL = DFKT(KW,KTYPE)                                           &
+     &         + (W - KW) * (DFKT(KW+1,KTYPE) - DFKT(KW,KTYPE))
+      RETURN
+      END FUNCTION KTSOIL
+      FUNCTION FUNCDF(THETA,KTYPE)
+!
+      USE MODULE_GFS_MACHINE     , ONLY : kind_phys
+      USE module_progtm , ONLY : TSAT, DFK
+      implicit none
+      integer              ktype,kw
+      real(kind=kind_phys) funcdf,theta,w
+!
+      W = (THETA / TSAT(KTYPE)) * 20. + 1.
+      KW = W
+      KW = MIN(KW,21)
+      KW = MAX(KW,1)
+      FUNCDF = DFK(KW,KTYPE)                                            &
+     &         + (W - KW) * (DFK(KW+1,KTYPE) - DFK(KW,KTYPE))
+      RETURN
+      END FUNCTION FUNCDF
+      FUNCTION FUNCKT(THETA,KTYPE)
+!
+      USE MODULE_GFS_MACHINE     , ONLY : kind_phys
+      USE module_progtm , ONLY : TSAT, KTK
+      implicit none
+      integer             ktype,kw
+      real(kind=kind_phys) funckt,theta,w
+!
+      W = (THETA / TSAT(KTYPE)) * 20. + 1.
+      KW = W
+      KW = MIN(KW,21)
+      KW = MAX(KW,1)
+      FUNCKT = KTK(KW,KTYPE)                                            &
+     &         + (W - KW) * (KTK(KW+1,KTYPE) - KTK(KW,KTYPE))
+      RETURN
+      END FUNCTION FUNCKT
+      FUNCTION THSAT(KTYPE)
+!
+      USE MODULE_GFS_MACHINE     , ONLY : kind_phys
+      USE module_progtm , ONLY : TSAT
+      implicit none
+      integer             ktype
+      real(kind=kind_phys) thsat
+!
+      THSAT = TSAT(KTYPE)
+      RETURN
+      END FUNCTION THSAT
+      FUNCTION TWLT(KTYPE)
+
+      USE MODULE_GFS_MACHINE     , ONLY : kind_phys
+!     USE module_progtm
+      implicit none
+      integer              ktype
+      real(kind=kind_phys) twlt
+!
+      TWLT = .1
+      RETURN
+      END FUNCTION TWLT
+
+ END MODULE module_sf_gfs
Index: trunk/WRF.COMMON/WRFV2/phys/module_sf_lsm_nmm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_sf_lsm_nmm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_sf_lsm_nmm.F	(revision 2744)
@@ -0,0 +1,5615 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+MODULE MODULE_SF_LSM_NMM
+
+USE MODULE_MPP
+USE MODULE_MODEL_CONSTANTS
+
+  REAL, SAVE    :: SCFX(30)
+
+  INTEGER, SAVE :: ISEASON
+  CHARACTER*256 :: errmess
+ 
+CONTAINS
+
+!-----------------------------------------------------------------------
+      SUBROUTINE NMMLSM(DZ8W,QV3D,P8W3D,RHO3D,                          &
+     &               T3D,TH3D,TSK,CHS,                                  &
+     &               HFX,QFX,QGH,GSW,GLW,ELFLX,RMOL,                    & ! added for WRF CHEM
+     &               SMSTAV,SMSTOT,SFCRUNOFF,                           &
+     &               UDRUNOFF,IVGTYP,ISLTYP,VEGFRA,SFCEVP,POTEVP,       &
+     &               GRDFLX,SFCEXC,ACSNOW,ACSNOM,SNOPCX,                &
+     &               ALBSF,TMN,XLAND,XICE,QZ0,                          &
+     &               TH2,Q2,SNOWC,CHS2,QSFC,TBOT,CHKLOWQ,RAINBL,        &
+     &               NUM_SOIL_LAYERS,DT,DZS,ITIMESTEP,                  &
+     &               SMOIS,TSLB,SNOW,CANWAT,CPM,ROVCP,SR,               & 
+     &               ALB,SNOALB,SMLIQ,SNOWH,                            &
+     &               IDS,IDE, JDS,JDE, KDS,KDE,                         &
+     &               IMS,IME, JMS,JME, KMS,KME,                         &
+     &               ITS,ITE, JTS,JTE, KTS,KTE                     )
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+    IMPLICIT NONE
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!-- DZ8W        thickness of layers (m)
+!-- T3D         temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!-- P8W3D       3D pressure on layer interfaces (Pa)
+!-- FLHC        exchange coefficient for heat (m/s)
+!-- FLQC        exchange coefficient for moisture (m/s)
+!-- PSFC        surface pressure (Pa)
+!-- XLAND       land mask (1 for land, 2 for water)
+!-- TMN         soil temperature at lower boundary (K)
+!-- HFX         upward heat flux at the surface (W/m^2)
+!-- QFX         upward moisture flux at the surface (kg/m^2/s)
+!-- TSK         surface temperature (K)
+!-- GSW         NET downward short wave flux at ground surface (W/m^2)
+!-- GLW         downward long wave flux at ground surface (W/m^2)
+!-- ELFLX       actual latent heat flux (w m-2: positive, if up from surface)
+!-- SFCEVP      accumulated surface evaporation (W/m^2)
+!-- POTEVP      accumulated potential evaporation (W/m^2)
+!-- CAPG        heat capacity for soil (J/K/m^3)
+!-- THC         thermal inertia (Cal/cm/K/s^0.5)
+!-- TBOT        bottom soil temperature (local yearly-mean sfc air temperature)
+!-- SNOWC       flag indicating snow coverage (1 for snow cover)
+!-- EMISS       surface emissivity (between 0 and 1)
+!-- DELTSM      time step (second)
+!-- ROVCP       R/CP
+!-- SR          fraction of frozen precip (0.0 to 1.0)
+!-- XLV         latent heat of melting (J/kg)
+!-- DTMIN       time step (minute)
+!-- IFSNOW      ifsnow=1 for snow-cover effects
+!-- SVP1        constant for saturation vapor pressure (kPa)
+!-- SVP2        constant for saturation vapor pressure (dimensionless)
+!-- SVP3        constant for saturation vapor pressure (K)
+!-- SVPT0       constant for saturation vapor pressure (K)
+!-- EP1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
+!-- EP2         constant for specific humidity calculation
+!               (R_d/R_v) (dimensionless)
+!-- KARMAN      Von Karman constant
+!-- EOMEG       angular velocity of earth's rotation (rad/s)
+!-- STBOLT      Stefan-Boltzmann constant (W/m^2/K^4)
+!-- STEM        soil temperature in 5-layer model
+!-- ZS          depths of centers of soil layers
+!-- DZS         thicknesses of soil layers
+!-- num_soil_layers   the number of soil layers
+!-- ACSNOW      accumulated snowfall (water equivalent) (mm)
+!-- ACSNOM      accumulated snowmelt (water equivalent) (mm)
+!-- SNOPCX      snow phase change heat flux (W/m^2)
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!-----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE,                    &
+     &                      IMS,IME,JMS,JME,KMS,KME,                    &
+     &                      ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: NUM_SOIL_LAYERS,ITIMESTEP
+!
+      REAL,INTENT(IN) :: DT,ROVCP
+!
+      REAL,DIMENSION(IMS:IME,1:NUM_SOIL_LAYERS,JMS:JME),                &
+     &     INTENT(INOUT) ::                                      SMOIS, & ! new
+					                         SMLIQ, & ! new
+                                                                 TSLB     ! 
+
+      REAL,DIMENSION(1:NUM_SOIL_LAYERS),INTENT(IN) :: DZS
+!
+      REAL,DIMENSION(ims:ime,jms:jme),INTENT(INOUT) ::                  &
+     &                                                             TSK, & !was TGB (temperature)
+     &                                                             HFX, &     
+     &                                                             QFX, &     
+     &                                                             QSFC,&     
+     &                                                            SNOW, & !new
+     &                                                           SNOWH, & !new
+     &                                                             ALB, &
+     &                                                          SNOALB, &
+     &                                                           ALBSF, &
+     &                                                           SNOWC, & 
+     &                                                          CANWAT, & ! new
+     &                                                          SMSTAV, &
+     &                                                          SMSTOT, &
+     &                                                       SFCRUNOFF, &
+     &                                                        UDRUNOFF, &
+     &                                                          SFCEVP, &
+     &                                                          POTEVP, &
+     &                                                          GRDFLX, &
+     &                                                          ACSNOW, &
+     &                                                          ACSNOM, &
+     &                                                          SNOPCX, &
+     &                                                              Q2, &
+     &                                                             TH2, &
+     &                                                          SFCEXC
+
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) ::          IVGTYP, &
+                                                                ISLTYP
+
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) ::                TMN, &
+                                                                 XLAND, &
+                                                                  XICE, &
+                                                                VEGFRA, &
+                                                                   GSW, &
+                                                                   GLW, &     
+                                                                   QZ0, &
+                                                                    SR    
+
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) ::       QV3D, &
+                                                                 P8W3D, &
+                                                                 RHO3D, &
+                                                                  TH3D, &
+                                                                   T3D, &
+                                                                  DZ8W
+
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) ::             RAINBL
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) ::               CHS2, &
+                                                                   CHS, &
+                                                                   QGH, &
+                                                                   CPM
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) ::              TBOT
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) ::           CHKLOWQ, &
+                                                                 ELFLX
+! added for WRF-CHEM, 20041205, JM -- not used in this routine as yet
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) ::            RMOL
+
+! LOCAL VARS
+
+      REAL,DIMENSION(ITS:ITE) ::                                  QV1D, &
+     &                                                             T1D, &
+     &                                                            TH1D, &
+     &                                                            ZA1D, &
+     &                                                           P8W1D, &
+     &                                                          PSFC1D, &
+     &                                                           RHO1D, &
+     &                                                          PREC1D
+                                                                           
+      INTEGER :: I,J
+      REAL :: RATIOMX
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+
+      DO J=JTS,JTE
+
+        DO I=ITS,ITE
+          T1D(I)    = T3D(I,1,J)
+          TH1D(I)   = TH3D(I,1,J)
+!!!       QV1D(I)   = QV3D(I,1,J)
+          RATIOMX   = QV3D(I,1,J)
+          QV1D(I)   = RATIOMX/(1.+RATIOMX)
+          P8W1D(I)  = (P8W3D(I,KTS+1,j)+P8W3D(i,KTS,j))*0.5
+          PSFC1D(I) = P8W3D(I,1,J)
+          ZA1D(I)   = 0.5*DZ8W(I,1,J) 
+          RHO1D(I)  = RHO3D(I,1,J)
+          PREC1D(I) = RAINBL(I,J)/DT
+        ENDDO
+
+!FLHC = SFCEXC
+    
+!-----------------------------------------------------------------------
+        CALL SURFCE(J,ZA1D,QV1D,P8W1D,PSFC1D,RHO1D,T1D,TH1D,TSK,        &
+                    CHS(IMS,J),PREC1D,HFX,QFX,QGH(IMS,J),GSW,GLW,       &
+                    SMSTAV,SMSTOT,SFCRUNOFF,                            &
+                    UDRUNOFF,IVGTYP,ISLTYP,VEGFRA,SFCEVP,POTEVP,GRDFLX, &
+                    ELFLX,SFCEXC,ACSNOW,ACSNOM,SNOPCX,                  &
+                    ALBSF,TMN,XLAND,XICE,QZ0,                           &
+                    TH2,Q2,SNOWC,CHS2(IMS,J),QSFC,TBOT,CHKLOWQ,         &
+                    NUM_SOIL_LAYERS,DT,DZS,ITIMESTEP,                   &
+                    SMOIS,TSLB,SNOW,CANWAT,CPM(IMS,J),ROVCP,SR,         & 
+                    ALB,SNOALB,SMLIQ,SNOWH,                             &
+                    IMS,IME,JMS,JME,KMS,KME,                            &
+                    ITS,ITE,JTS,JTE,KTS,KTE                            ) 
+!
+      ENDDO
+
+   END SUBROUTINE NMMLSM
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+   SUBROUTINE SURFCE(J,ZA,QV,P8W,PSFC,RHO,T,TH,TSK,CHS,PREC,HFX,QFX,   &
+                     QGH,GSW,GLW,SMSTAV,SMSTOT,SFCRUNOFF,UDRUNOFF,     &
+                     IVGTYP,ISLTYP,VEGFRA,SFCEVP,POTEVP,GRDFLX,        &
+                     ELFLX,SFCEXC,ACSNOW,ACSNOM,SNOPCX,                &
+                     ALBSF,TMN,XLAND,XICE,QZ0,                         &
+                     TH2,Q2,SNOWC,CHS2,QSFC,TBOT,CHKLOWQ,              &
+                     NUM_SOIL_LAYERS,DT,DZS,ITIMESTEP,                 &
+                     SMOIS,TSLB,SNOW,CANWAT,CPM,ROVCP,SR,              & 
+                     ALB,SNOALB,SMLIQ,SNOWH,                           &
+                     IMS,IME,JMS,JME,KMS,KME,                          &
+                     ITS,ITE,JTS,JTE,KTS,KTE                           ) 
+!------------------------------------------------------------------------     
+      IMPLICIT NONE                                                     
+!------------------------------------------------------------------------     
+!$$$  SUBPROGRAM DOCUMENTATION BLOCK                                    
+!                .      .    .                                          
+! SUBPROGRAM:    SURFCE      CALCULATE SURFACE CONDITIONS               
+!   PRGRMMR: F. CHEN         DATE: 97-12-06                             
+!                                                                       
+! ABSTRACT:                                                             
+!   THIS ROUTINE IS THE DRIVER FOR COMPUTATION OF GROUND CONDITIONS     
+!   BY USING A LAND SURFACE MODEL (LSM).                                
+!                                                                       
+! PROGRAM HISTORY LOG:                                                  
+!   97-12-06  CHEN - ORIGINATOR                                         
+!                                                                       
+! REFERENCES:                                                           
+!   PAN AND MAHRT (1987) BOUN. LAYER METEOR.                            
+!   CHEN ET AL. (1996)  J. GEOPHYS. RES.                                
+!   CHEN ET AL. (1997)  BOUN. LAYER METEOR.                             
+!   CHEN and Dudhia (2000)  Mon. Wea. Rev. 
+!                                                                       
+!   SUBPROGRAMS CALLED:                                                 
+!     SFLX                                                              
+!                                                                       
+!     SET LOCAL PARAMETERS.                                             
+!----------------------------------------------------------------------
+   INTEGER,  INTENT(IN   )   ::           IMS,IME, JMS,JME, KMS,KME,  &
+                                          ITS,ITE, JTS,JTE, KTS,KTE,  &
+                                          J,ITIMESTEP      
+
+   INTEGER , INTENT(IN)      ::           NUM_SOIL_LAYERS
+
+   REAL,     INTENT(IN   )   ::           DT,ROVCP
+
+   REAL,     DIMENSION(1:num_soil_layers), INTENT(IN)::DZS
+
+                                                 
+   REAL, PARAMETER  :: PQ0=379.90516
+   REAL, PARAMETER  :: TRESH=.95E0,A2=17.2693882,A3=273.16,A4=35.86,  &
+                       T0=273.16E0,T1=274.16E0,ROW=1.E3,              &
+                       ELWV=2.50E6,ELIV=XLS,ELIW=XLF,                 &
+                       A23M4=A2*(A3-A4), RLIVWV=ELIV/ELWV,            &
+                       ROWLIW=ROW*ELIW,ROWLIV=ROW*ELIV,CAPA=R_D/CP
+
+   INTEGER,  PARAMETER  :: NROOT=3
+!                                                                       
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ),       &
+             INTENT(INOUT)   ::                          SMOIS,       & ! new
+						         SMLIQ,       & ! new
+                                                         TSLB           ! new  !STEMP
+
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                           , &
+            INTENT(INOUT)    ::                                  TSK, & !was TGB (temperature)
+						                 HFX, & !new
+						                 QFX, & !new
+						                 QSFC,& !new
+						                SNOW, & !new
+						               SNOWH, & !new
+						 	         ALB, &
+						 	      SNOALB, &
+						 	       ALBSF, &
+                                                               SNOWC, & 
+                                                              CANWAT, & ! new
+                                                              SMSTAV, &
+                                                              SMSTOT, &
+                                                           SFCRUNOFF, &
+                                                            UDRUNOFF, &
+                                                              SFCEVP, &
+                                                              POTEVP, &
+                                                              GRDFLX, &
+                                                              ACSNOW, &
+                                                              ACSNOM, &
+                                                              SNOPCX
+
+   INTEGER, DIMENSION( ims:ime, jms:jme )                           , &
+            INTENT(IN   )    ::                               IVGTYP, &
+                                                              ISLTYP
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                           , &
+            INTENT(IN   )    ::                                  TMN, &
+                                                               XLAND, &
+                                                                XICE, &
+                                                              VEGFRA, &
+                                                                 GSW, &
+                                                                 GLW, &
+                                                                 QZ0, &
+                                                                  SR
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                           , &
+            INTENT(INOUT)    ::                                   Q2, &
+							         TH2, &
+                                                              SFCEXC
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                           , &
+            INTENT(OUT)    ::                                   TBOT
+
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                           , &
+            INTENT(OUT)    ::                                CHKLOWQ, &
+                                                               ELFLX
+
+   REAL,    DIMENSION( ims:ime )                                    , &
+            INTENT(IN   )    ::                                  QGH, &
+                                                                 CHS, &
+                                                                 CPM, &
+                                                                CHS2
+
+! MODULE-LOCAL VARIABLES, DEFINED IN  SUBROUTINE LSM
+   REAL,    DIMENSION( its:ite )                                    , &
+            INTENT(IN   )    ::                                   ZA, &
+                                                                  TH, &
+                                                                  QV, &
+                                                                   T, &
+                                                                 p8w, &
+                                                                PSFC, &
+                                                                 rho, &
+                                                                PREC    ! one time step in mm
+
+   REAL,    DIMENSION( its:ite )   ::                          TGDSA 
+
+! LOCAL VARS
+
+    REAL, DIMENSION(1:num_soil_layers) :: SMLIQ1D,SMOIS1D,STEMP1D
+
+!---------------------------------------------------------------------- 
+!***  DECLARATIONS FOR IMPLICIT NONE                                    
+ 
+    REAL :: APELM,APES,FDTLIW,FDTW,Q2SAT,Z,FK,SOLDN,SFCTMP,SFCTH2,    &
+            SFCPRS,PRCP,Q2K,DQSDTK,SATFLG,TBOTK,CHK,VGFRCK,T1K,LWDN,  &
+            CMCK,Q2M,SNODPK,PLFLX,HFLX,GFLX,RNOF1K,                   &
+            RNOF2K,Q1K,SMELTK,SOILQW,SOILQM,T2K,PRESK,CHFF,STIMESTEP, &
+            ALB1D,SNOALB1D,SNOWH1D,ALBSF1D,SOLNET,FFROZP,             &
+            DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7
+
+    INTEGER :: I,K,NS,ICE,IVGTPK,ISLTPK,ISPTPK,NOOUT,NSOIL,LZ
+
+!---------------------------------------------------------------------- 
+!***********************************************************************
+!                         START SURFCE HERE                             
+!***                                                                    
+!***  SET CONSTANTS CALCULATED HERE FOR CLARITY.                        
+!***                                                                    
+      FDTLIW=DT/ROWLIW                                              
+!      FDTLIV=DT/ROWLIV                                             
+      FDTW=DT/(XLV*RHOWATER)
+!***                                                                    
+!***  SET LSM CONSTANTS AND TIME INDEPENDENT VARIABLES                  
+!***  INITIALIZE LSM HISTORICAL VARIABLES                               
+!***                                                                    
+!-----------------------------------------------------------------------
+
+      NSOIL=num_soil_layers
+
+      IF(ITIMESTEP.EQ.1)THEN                                                 
+        DO 50 I=its,ite
+!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS                   
+          IF((XLAND(I,J)-1.5).GE.0.)THEN                                
+! check sea-ice point                                                   
+            IF(XICE(I,J).EQ.1.)PRINT*,' sea-ice at water point, I=',I,  &
+              'J=',J
+!***   Open Water Case                                                  
+            SMSTAV(I,J)=1.0                                             
+            SMSTOT(I,J)=1.0                                             
+            DO NS=1,NSOIL                                               
+              SMOIS(I,NS,J)=1.0                                          
+              TSLB(I,NS,J)=273.16                                          !STEMP
+            ENDDO                                                       
+          ELSE                                                          
+            IF(XICE(I,J).EQ.1.)THEN                                     
+!***        SEA-ICE CASE                                                
+              SMSTAV(I,J)=1.0                                           
+              SMSTOT(I,J)=1.0                                           
+              DO NS=1,NSOIL                                             
+                SMOIS(I,NS,J)=1.0                                        
+              ENDDO                                                     
+            ENDIF                                                       
+          ENDIF                                                         
+!                                                                       
+   50   CONTINUE                                                        
+      ENDIF                                                             
+!-----------------------------------------------------------------------
+      DO 100 I=its,ite                                                    
+!       SFCPRS=(A(KL)*PSB(I,J)+PTOP+PP3D(I,J,KL)*0.001)*1.E3          
+        SFCPRS=p8w(I)  !Pressure in middle of lowest layer
+        Q2SAT=QGH(I)                                                  
+!       CHKLOWQ(I,J)=1.
+        CHFF=CHS(I)*RHO(I)*CPM(I)
+!CHK*RHO*CP                                                             
+! TGDSA: potential T
+        TGDSA(I)=TSK(I,J)*(1.E5/SFCPRS)**ROVCP 
+!
+!***  CHECK FOR SATURATION AT THE LOWEST MODEL LEVEL                    
+!
+        Q2K=QV(I)
+        APES=(1.E5/PSFC(I))**CAPA
+!
+        IF((Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN                                  
+          SATFLG=0.                                                   
+          CHKLOWQ(I,J)=0.
+        ELSE                                                          
+          SATFLG=1.0                                                  
+          CHKLOWQ(I,J)=1.
+        ENDIF                                                         
+!
+        TBOT(I,J)=273.16
+!***                                                                    
+!***  LOADING AND UNLOADING MM5/LSM LAND SOIL VARIABLES                 
+!***                                                                    
+        IF((XLAND(I,J)-1.5).GE.0.)THEN                                  
+!*** Water                                                              
+          HFX(I,J)=HFX(I,J)/APES
+          QFX(I,J)=QFX(I,J)*SATFLG
+          SFCEVP(I,J)=SFCEVP(I,J)+QFX(I,J)*DT                       
+        ELSE                                                            
+!*** LAND OR SEA-ICE                                                    
+!ATEC          ICE=INT(XICE(I,J)+0.3)                                   
+          IF (XICE(I,J) .GT. 0.5) THEN                                  
+             ICE=1                                                      
+          ELSE                                                          
+             ICE=0                                                      
+          ENDIF                                                         
+!
+          Q2K=MIN(QV(I),Q2SAT)
+          Z=ZA(I)                                                    
+!          FK=GSW(I,J)+GLW(I,J)                                          
+          LWDN=GLW(I,J)
+!
+!***  GSW is net downward shortwave
+!
+!          SOLNET=GSW(I,J)
+!
+!***  GSW is total downward shortwave
+!
+          SOLDN=GSW(I,J)
+!
+!***  Simple use of albedo to determine total incoming solar shortwave SOLDN
+!***  (no solar zenith angle correction)
+!
+!          SOLDN=SOLNET/(1.-ALB(I,J))                                  
+          SOLNET=SOLDN*(1.-ALB(I,J))
+!
+          ALBSF1D=ALBSF(I,J)
+          SNOALB1D=SNOALB(I,J)
+          SFCTMP=T(I)                                               
+!!!       SFCTH2=SFCTMP+(0.0097545*Z)                                   
+          APELM=(1.E5/SFCPRS)**CAPA
+          SFCTH2=SFCTMP*APELM
+          SFCTH2=SFCTH2/APES
+          PRCP=PREC(I)
+!!!       Q2K=QV(I)                                                  
+!!!       Q2SAT=PQ0/SFCPRS*EXP(A2*(SFCTMP-A3)/(SFCTMP-A4))              
+          DQSDTK=Q2SAT*A23M4/(SFCTMP-A4)**2                             
+          IF(ICE.EQ.0)THEN                                              
+            TBOTK=TMN(I,J)                                              
+          ELSE                                                          
+            TBOTK=271.16                                                
+          ENDIF                                                         
+          CHK=CHS(I)                                                    
+          IVGTPK=IVGTYP(I,J)                                            
+          IF(IVGTPK.EQ.0)IVGTPK=13
+          ISLTPK=ISLTYP(I,J)                                            
+          IF(ISLTPK.EQ.0)ISLTPK=9
+! hardwire slope type (ISPTPK)=1
+          ISPTPK=1
+          VGFRCK=VEGFRA(I,J)/100.                                       
+          IF(IVGTPK.EQ.25) VGFRCK=0.0001
+          IF(ISLTPK.EQ.14.AND.XICE(I,J).EQ.0.)THEN                      
+         PRINT*,' SOIL TYPE FOUND TO BE WATER AT A LAND-POINT'          
+         PRINT*,i,j,'RESET SOIL in surfce.F'                      
+!           ISLTYP(I,J)=7                                               
+            ISLTPK=7                                                    
+          ENDIF                                                         
+          T1K=TSK(I,J)
+          CMCK=CANWAT(I,J)                                                
+!*** convert snow depth from mm to meter                                
+          SNODPK=SNOW(I,J)*0.001                                        
+          SNOWH1D=SNOWH(I,J)*0.001                                        
+!                                                                       
+!*** fraction of frozen precip
+!                                                                       
+          FFROZP=SR(I,J)
+!
+          DO 70 NS=1,NSOIL                                              
+            SMOIS1D(NS)=SMOIS(I,NS,J)                                       
+            SMLIQ1D(NS)=SMLIQ(I,NS,J)                                       
+            STEMP1D(NS)=TSLB(I,NS,J)                                          !STEMP
+   70     CONTINUE                                                      
+
+!                                                                       
+!        print*,'BF SFLX','ISLTPK',ISLTPK,'IVGTPK=',IVGTPK,'SMOIS1D',&
+!              SMOIS1D,'STEMP1',STEMP1D,'VGFRCK',VGFRCK
+!-----------------------------------------------------------------------
+! old WRF call to SFLX
+!         CALL SFLX(ICE,SATFLG,DT,Z,NSOIL,NROOT,DZS,FK,SOLDN,SFCPRS,    &
+!              PRCP,SFCTMP,SFCTH2,Q2K,Q2SAT,DQSDTK,TBOTK,CHK,CHFF,      &
+!              IVGTPK,ISLTPK,VGFRCK,PLFLX,ELFLX,HFLX,GFLX,RNOF1K,RNOF2K,&
+!              Q1K,SMELTK,T1K,CMCK,SMOIS1D,STEMP1D,SNODPK,SOILQW,SOILQM)      
+!-----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! Ek 12 June 2002 - NEW CALL SFLX
+! ops Eta call to SFLX ...'tailor' this to WRF
+!        CALL SFLX
+!     I    (ICE,DTK,Z,NSOIL,SLDPTH,
+!     I    LWDN,SOLDN,SFCPRS,PRCP,SFCTMP,SFCTH2,Q2K,SFCSPD,Q2SAT,DQSDTK,
+!     I    IVGTPK,ISLTPK,ISPTPK,
+!     I    VGFRCK,PTU,TBOT,ALB,SNOALB,
+!     2    CMCK,T1K,STCK,SMCK,SH2OK,SNOWH,SNODPK,ALB2D,CHK,CMK,
+!     O    PLFLX,ELFLX,HFLX,GFLX,RNOF1K,RNOF2K,Q1K,SMELTK,
+!     O    SOILQW,SOILQM,DUM1,DUM2,DUM3,DUM4)
+!-----------------------------------------------------------------------
+        CALL SFLX                                                       &
+          (FFROZP,ICE,DT,Z,NSOIL,DZS,                                   &
+          LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,SFCTH2,Q2K,DUM5,Q2SAT,   &
+          DQSDTK,IVGTPK,ISLTPK,ISPTPK,                                  &
+          VGFRCK,DUM6,TBOTK,ALBSF1D,SNOALB1D,                           &
+          CMCK,T1K,STEMP1D,SMOIS1D,SMLIQ1D,SNOWH1D,SNODPK,ALB1D,CHK,DUM7, &
+          PLFLX,ELFLX(I,J),HFLX,GFLX,RNOF1K,RNOF2K,Q1K,SMELTK,          &
+          SOILQW,SOILQM,DUM1,DUM2,DUM3,DUM4,I,J)
+!-----------------------------------------------------------------------
+!***  DIAGNOSTICS                                                       
+!        Convert the water unit into mm                                 
+          SFCRUNOFF(I,J)=SFCRUNOFF(I,J)+RNOF1K*DT*1000.0                  
+          UDRUNOFF(I,J)=UDRUNOFF(I,J)+RNOF2K*DT*1000.0                  
+          SMSTAV(I,J)=SOILQW                                            
+
+!mp
+	if (abs(SMSTAV(I,J)) .lt. 3.5) then
+	else
+	write(errmess,*) 'bad SMSTAV: ', I,J,SMSTAV(I,J)
+        CALL wrf_message( errmess )
+	endif
+!mp	
+
+          SMSTOT(I,J)=SOILQM*1000.                                      
+          SFCEXC(I,J)=CHK                                               
+!       IF(SNOB(I,J).GT.0..OR.SICE(I,J).GT.0.)THEN                      
+!         QFC1(I,J)=QFC1(I,J)*RLIVWV                                    
+!       ENDIF                                                           
+          IF(FFROZP.GT.0.5)THEN
+            ACSNOW(I,J)=ACSNOW(I,J)+PREC(I)*DT                     
+          ENDIF                                                         
+          IF(SNOW(I,J).GT.0.)THEN                                       
+            ACSNOM(I,J)=ACSNOM(I,J)+SMELTK*1000.                    
+            SNOPCX(I,J)=SNOPCX(I,J)-SMELTK/FDTLIW                       
+          ENDIF                                                         
+        POTEVP(I,J)=POTEVP(I,J)+PLFLX*FDTW                              
+!       POTFLX(I,J)=POTFLX(I,J)-PLFLX                                   
+!***  WRF LOWER BOUNDARY CONDITIONS                                     
+          GRDFLX(I,J)=GFLX                                              
+          HFX(I,J)=HFLX                                                 
+          QFX(I,J)=ELFLX(I,J)/ELWV                                           
+          SFCEVP(I,J)=SFCEVP(I,J)+QFX(I,J)*DT                       
+          TSK(I,J)=T1K
+          T2K=T1K-HFX(I,J)/(RHO(I)*CPM(I)*CHS2(I))
+          TH2(I,J)=T2K*(1.E5/SFCPRS)**ROVCP                                  
+          Q2M=Q1K-QFX(I,J)/(RHO(I)*CHS2(I))                            
+!!!!!!    Q2(I,J)=Q2M
+!!!!!!    Q2(I,J)=Q2K
+!        t2k=th2k/(1.E5/SFCPRS)**ROVCP                                  
+!        QS(I,J)=Q1K                                                    
+!!!      QSFC(I,J)=Q1K                                                    
+!***  UPDATE STATE VARIABLES 
+          SNOW(I,J)=SNODPK*1000.0                                       
+          SNOWH(I,J)=SNOWH1D*1000.0                                       
+          CANWAT(I,J)=CMCK                                                
+          IF(SNOW(I,J).GT.1.0)THEN                                      
+!           ALB(I,J)=0.01*ALBD(IVGTPK,ISEASON)*(1.+SCFX(IVGTPK))            
+            SNOWC(I,J)=1.0                                              
+          ELSE                                                          
+!           ALB(I,J)=0.01*ALBD(IVGTPK,ISEASON)                              
+            SNOWC(I,J)=0.0                                              
+          ENDIF                                                         
+! update albedo
+          ALB(I,J)=ALB1D
+! update bottom soil temperature
+          TBOT(I,J)=TBOTK
+
+          DO 80 NS=1,NSOIL                                              
+           SMOIS(I,NS,J)=SMOIS1D(NS)                                       
+           SMLIQ(I,NS,J)=SMLIQ1D(NS)                                       
+           TSLB(I,NS,J)=STEMP1D(NS)                                        !  STEMP
+   80     CONTINUE                                                      
+        ENDIF                                                           
+#if 0
+        NOOUT=0                                                         
+
+        IF((ITIMESTEP.EQ.1.OR.MOD(ITIMESTEP,1).EQ.0)  &
+            .AND. I .EQ.29.AND.J.EQ.23) THEN                                             
+!         print*, 'GLW',GLW(I,J),'GSW',GSW(I,J)
+          print*, 'T2K',T2K,'T1K',T1K,'HFX',HFX(I,J),'RHO',RHO(I),'CPM',CPM(I), &
+                'CHS2',CHS2(I),'soil T',STEMP1D,'soil m', SMOIS1D
+!          print*,'Q2M',Q2M,'Q1K',Q1K,'QFX',QFX(I,J),'RHO',RHO(I),'CHS2',CHS2(I),'latent',ELFLX
+        ENDIF
+
+        IF(NOOUT.EQ.1)GOTO 100                                          
+!     write output to 29                                                
+        IF(ITIMESTEP.EQ.1.AND.I.EQ.1.AND.J.EQ.1) &
+                                                            WRITE (29,*)&
+          'itimestep ','   FK     ','  SOLDN   ','  SFCPR   ',          &
+          '  SFCTMP  ','    Q2K   ','   TBOTK  ',          &
+          '   CHK    ','  ELFLX   ','   HFLX   ','   GFLX   ',          &
+          ' RNOF1K   ',' RNOF2K   ','    T1K   ','   CMCK   ',          &
+          '  SMCK1   ','  SMCK2   ','  SMCK3   ','  SMCK4   ',          &
+          '  STCK1   ','  STCK2   ','  STCK3   ','  STCK4   ',          &
+          ' SNODPK   ','      T2   ',                                   &
+          '     Q2   ',' SMSTOT   ',' SFCEVP   ', ' RAIN'                        
+        IF((ITIMESTEP.EQ.1.OR.MOD(ITIMESTEP,1).EQ.0)  &
+            .AND. I .EQ.29.AND.J.EQ.23) THEN                                             
+        print *,'outputting at itimestep =', itimestep
+          STIMESTEP=FLOAT(itimestep)
+          WRITE (29,1029)STIMESTEP,FK,SOLDN,SFCPRS/100.,SFCTMP,1000.*       &
+                         Q2K,TBOTK,1000.*CHK,ELFLX(i,j),HFLX,GFLX,SFCRUNOFF(I,J)&
+                         ,UDRUNOFF(I,J),T1K,CMCK,SMOIS1D,STEMP1D,SNODPK,        &
+!                       ,UDRUNOFF(I,J),T1K,CMCK,SMOIS1D(3),SMOIS1D(7),SMOIS1D(11),&
+!                        SMOIS1D(14),STEMP1D(3), STEMP1D(7),STEMP1D(11), &
+!                        STEMP1D(14), SNODPK,        &
+                         T2K,1000.*Q2M,SMSTOT(I,J),SFCEVP(I,J),PRCP
+ 1029     FORMAT (29F10.4)                                              
+!         IF(ITIMESTEP.EQ.0)WRITE (39,*)'   P      ','   T      ',      &
+!           '   TH     ','   Q      ','   U      ','   V      ',        &
+!           '   QC     '                                                
+!         WRITE (39,1039)itimestep
+!         DO K=kts,kte
+!           WRITE (39,1039)PRESK,TX(I,K),THX(I,K),1000.*QX(I,K),UX(I,K),&
+!                          VX(I,K),1000.*QCX(I,K)                       
+ 1039       FORMAT (7F10.5)                                             
+!         ENDDO                                                         
+        ENDIF                                                           
+!                                                                       
+#endif
+  100 CONTINUE                                                          
+!                                                                       
+!-----------------------------------------------------------------------
+  END SUBROUTINE SURFCE
+!-----------------------------------------------------------------------
+
+      SUBROUTINE SFLX (                                                 &
+       FFROZP,ICE,DT,ZLVL,NSOIL,SLDPTH,                                 &
+       LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,TH2,Q2,SFCSPD,Q2SAT,        &
+       DQSDT2,VEGTYP,SOILTYP,SLOPETYP,                                  &
+       SHDFAC,PTU,TBOT,ALB,SNOALB,                                      &
+       CMC,T1,STC,SMC,SH2O,SNOWH,SNEQV,ALBEDO,CH,CM,                    &
+       ETP,ETA,SHEAT,SSOIL,RUNOFF1,RUNOFF2,Q1,SNOMLT,                   &
+       SOILW,SOILM,SMCWLT,SMCDRY,SMCREF,SMCMAX,I,J)
+! ----------------------------------------------------------------------
+!     &  ETA,SHEAT,                                                      &
+! ----------------------------------------------------------------------
+! OUTPUTS, DIAGNOSTICS, PARAMETERS BELOW GENERALLY NOT NECESSARY WHEN
+! COUPLED WITH E.G. A NWP MODEL (SUCH AS THE NOAA/NWS/NCEP MESOSCALE ETA
+! MODEL).  OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES. 
+! ----------------------------------------------------------------------
+!     &  EC,EDIR,ET,ETT,ESNOW,DRIP,DEW,                                  &
+!     &  BETA,ETP,SSOIL,                                                 &
+!     &  FLX1,FLX2,FLX3,                                                 &
+!     &  SNOMLT,SNCOVR,                                                  &
+!     &  RUNOFF1,RUNOFF2,RUNOFF3,                                        &
+!     &  RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL,                            &
+!     &  SOILW,SOILM,                                                    &
+!     &  SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT,I,J)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SFLX - VERSION 2.7 - June 2nd 2003
+! ----------------------------------------------------------------------
+! SUB-DRIVER FOR "NOAH/OSU LSM" FAMILY OF PHYSICS SUBROUTINES FOR A
+! SOIL/VEG/SNOWPACK LAND-SURFACE MODEL TO UPDATE SOIL MOISTURE, SOIL
+! ICE, SOIL TEMPERATURE, SKIN TEMPERATURE, SNOWPACK WATER CONTENT,
+! SNOWDEPTH, AND ALL TERMS OF THE SURFACE ENERGY BALANCE AND SURFACE
+! WATER BALANCE (EXCLUDING INPUT ATMOSPHERIC FORCINGS OF DOWNWARD
+! RADIATION AND PRECIP)
+! ----------------------------------------------------------------------
+! SFLX ARGUMENT LIST KEY:
+! ----------------------------------------------------------------------
+!  C  CONFIGURATION INFORMATION
+!  F  FORCING DATA
+!  I  OTHER (INPUT) FORCING DATA
+!  S  SURFACE CHARACTERISTICS
+!  H  HISTORY (STATE) VARIABLES
+!  O  OUTPUT VARIABLES
+!  D  DIAGNOSTIC OUTPUT
+! ----------------------------------------------------------------------
+! 1. CONFIGURATION INFORMATION (C):
+! ----------------------------------------------------------------------
+!   ICE	       SEA-ICE FLAG  (=1: SEA-ICE, =0: LAND)
+!   DT	       TIMESTEP (SEC) (DT SHOULD NOT EXCEED 3600 SECS, RECOMMEND
+!                1800 SECS OR LESS)
+!   ZLVL       HEIGHT (M) ABOVE GROUND OF ATMOSPHERIC FORCING VARIABLES
+!   NSOIL      NUMBER OF SOIL LAYERS (AT LEAST 2, AND NOT GREATER THAN
+!                PARAMETER NSOLD SET BELOW)
+!   SLDPTH     THE THICKNESS OF EACH SOIL LAYER (M)
+! ----------------------------------------------------------------------
+! 2. FORCING DATA (F):
+! ----------------------------------------------------------------------
+!   LWDN       LW DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET LONGWAVE)
+!   SOLDN      SOLAR DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET SOLAR)
+!   SFCPRS     PRESSURE AT HEIGHT ZLVL ABOVE GROUND (PASCALS)
+!   PRCP       PRECIP RATE (KG M-2 S-1) (NOTE, THIS IS A RATE)
+!   SFCTMP     AIR TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND
+!   TH2        AIR POTENTIAL TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND
+!   Q2         MIXING RATIO AT HEIGHT ZLVL ABOVE GROUND (KG KG-1)
+! ----------------------------------------------------------------------
+! 3. OTHER FORCING (INPUT) DATA (I):
+! ----------------------------------------------------------------------
+!   SFCSPD     WIND SPEED (M S-1) AT HEIGHT ZLVL ABOVE GROUND
+!   Q2SAT      SAT MIXING RATIO AT HEIGHT ZLVL ABOVE GROUND (KG KG-1)
+!   DQSDT2     SLOPE OF SAT SPECIFIC HUMIDITY CURVE AT T=SFCTMP
+!                (KG KG-1 K-1)
+! ----------------------------------------------------------------------
+! 4. CANOPY/SOIL CHARACTERISTICS (S):
+! ----------------------------------------------------------------------
+!   VEGTYP     VEGETATION TYPE (INTEGER INDEX)
+!   SOILTYP    SOIL TYPE (INTEGER INDEX)
+!   SLOPETYP   CLASS OF SFC SLOPE (INTEGER INDEX)
+!   SHDFAC     AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION
+!                (FRACTION= 0.0-1.0)
+!   SHDMIN     MINIMUM AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION
+!                (FRACTION= 0.0-1.0) <= SHDFAC
+!   PTU        PHOTO THERMAL UNIT (PLANT PHENOLOGY FOR ANNUALS/CROPS)
+!                (NOT YET USED, BUT PASSED TO REDPRM FOR FUTURE USE IN
+!                VEG PARMS)
+!   ALB        BACKROUND SNOW-FREE SURFACE ALBEDO (FRACTION), FOR JULIAN
+!                DAY OF YEAR (USUALLY FROM TEMPORAL INTERPOLATION OF
+!                MONTHLY MEAN VALUES' CALLING PROG MAY OR MAY NOT
+!                INCLUDE DIURNAL SUN ANGLE EFFECT)
+!   SNOALB     UPPER BOUND ON MAXIMUM ALBEDO OVER DEEP SNOW (E.G. FROM
+!                ROBINSON AND KUKLA, 1985, J. CLIM. & APPL. METEOR.)
+!   TBOT       BOTTOM SOIL TEMPERATURE (LOCAL YEARLY-MEAN SFC AIR
+!                TEMPERATURE)
+! ----------------------------------------------------------------------
+! 5. HISTORY (STATE) VARIABLES (H):
+! ----------------------------------------------------------------------
+!  CMC         CANOPY MOISTURE CONTENT (M)
+!  T1          GROUND/CANOPY/SNOWPACK) EFFECTIVE SKIN TEMPERATURE (K)
+!  STC(NSOIL)  SOIL TEMP (K)
+!  SMC(NSOIL)  TOTAL SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION)
+!  SH2O(NSOIL) UNFROZEN SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION)
+!                NOTE: FROZEN SOIL MOISTURE = SMC - SH2O
+!  SNOWH       ACTUAL SNOW DEPTH (M)
+!  SNEQV       LIQUID WATER-EQUIVALENT SNOW DEPTH (M)
+!                NOTE: SNOW DENSITY = SNEQV/SNOWH
+!  ALBEDO      SURFACE ALBEDO INCLUDING SNOW EFFECT (UNITLESS FRACTION)
+!                =SNOW-FREE ALBEDO (ALB) WHEN SNEQV=0, OR
+!                =FCT(MSNOALB,ALB,VEGTYP,SHDFAC,SHDMIN) WHEN SNEQV>0
+!  CH          SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE
+!                (M S-1); NOTE: CH IS TECHNICALLY A CONDUCTANCE SINCE
+!                IT HAS BEEN MULTIPLIED BY WIND SPEED.
+!  CM          SURFACE EXCHANGE COEFFICIENT FOR MOMENTUM (M S-1); NOTE:
+!                CM IS TECHNICALLY A CONDUCTANCE SINCE IT HAS BEEN
+!                MULTIPLIED BY WIND SPEED.  CM IS NOT NEEDED IN SFLX
+! ----------------------------------------------------------------------
+! 6. OUTPUT (O):
+! ----------------------------------------------------------------------
+! OUTPUT VARIABLES NECESSARY FOR A COUPLED NUMERICAL WEATHER PREDICTION
+! MODEL, E.G. NOAA/NWS/NCEP MESOSCALE ETA MODEL.  FOR THIS APPLICATION,
+! THE REMAINING OUTPUT/DIAGNOSTIC/PARAMETER BLOCKS BELOW ARE NOT
+! NECESSARY.  OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES.
+!   ETA        ACTUAL LATENT HEAT FLUX (W M-2: NEGATIVE, IF UP FROM
+!	         SURFACE)
+!   SHEAT      SENSIBLE HEAT FLUX (W M-2: NEGATIVE, IF UPWARD FROM
+!	         SURFACE)
+! ----------------------------------------------------------------------
+!   EC         CANOPY WATER EVAPORATION (W M-2)
+!   EDIR       DIRECT SOIL EVAPORATION (W M-2)
+!   ET(NSOIL)  PLANT TRANSPIRATION FROM A PARTICULAR ROOT (SOIL) LAYER
+!                 (W M-2)
+!   ETT        TOTAL PLANT TRANSPIRATION (W M-2)
+!   ESNOW      SUBLIMATION FROM SNOWPACK (W M-2)
+!   DRIP       THROUGH-FALL OF PRECIP AND/OR DEW IN EXCESS OF CANOPY
+!                WATER-HOLDING CAPACITY (M)
+!   DEW        DEWFALL (OR FROSTFALL FOR T<273.15) (M)
+! ----------------------------------------------------------------------
+!   BETA       RATIO OF ACTUAL/POTENTIAL EVAP (DIMENSIONLESS)
+!   ETP        POTENTIAL EVAPORATION (W M-2)
+!   SSOIL      SOIL HEAT FLUX (W M-2: NEGATIVE IF DOWNWARD FROM SURFACE)
+! ----------------------------------------------------------------------
+!   FLX1       PRECIP-SNOW SFC (W M-2)
+!   FLX2       FREEZING RAIN LATENT HEAT FLUX (W M-2)
+!   FLX3       PHASE-CHANGE HEAT FLUX FROM SNOWMELT (W M-2)
+! ----------------------------------------------------------------------
+!   SNOMLT     SNOW MELT (M) (WATER EQUIVALENT)
+!   SNCOVR     FRACTIONAL SNOW COVER (UNITLESS FRACTION, 0-1)
+! ----------------------------------------------------------------------
+!   RUNOFF1    SURFACE RUNOFF (M S-1), NOT INFILTRATING THE SURFACE
+!   RUNOFF2    SUBSURFACE RUNOFF (M S-1), DRAINAGE OUT BOTTOM OF LAST
+!                SOIL LAYER
+!   RUNOFF3    NUMERICAL TRUNCTATION IN EXCESS OF POROSITY (SMCMAX)
+!                FOR A GIVEN SOIL LAYER AT THE END OF A TIME STEP
+! ----------------------------------------------------------------------
+!   RC         CANOPY RESISTANCE (S M-1)
+!   PC         PLANT COEFFICIENT (UNITLESS FRACTION, 0-1) WHERE PC*ETP
+!                = ACTUAL TRANSPIRATION
+!   XLAI       LEAF AREA INDEX (DIMENSIONLESS)
+!   RSMIN      MINIMUM CANOPY RESISTANCE (S M-1)
+!   RCS        INCOMING SOLAR RC FACTOR (DIMENSIONLESS)
+!   RCT        AIR TEMPERATURE RC FACTOR (DIMENSIONLESS)
+!   RCQ        ATMOS VAPOR PRESSURE DEFICIT RC FACTOR (DIMENSIONLESS)
+!   RCSOIL     SOIL MOISTURE RC FACTOR (DIMENSIONLESS)
+! ----------------------------------------------------------------------
+! 7. DIAGNOSTIC OUTPUT (D):
+! ----------------------------------------------------------------------
+!   SOILW      AVAILABLE SOIL MOISTURE IN ROOT ZONE (UNITLESS FRACTION
+!	         BETWEEN SMCWLT AND SMCMAX)
+!   SOILM      TOTAL SOIL COLUMN MOISTURE CONTENT (FROZEN+UNFROZEN) (M) 
+! ----------------------------------------------------------------------
+! 8. PARAMETERS (P):
+! ----------------------------------------------------------------------
+!   SMCWLT     WILTING POINT (VOLUMETRIC)
+!   SMCDRY     DRY SOIL MOISTURE THRESHOLD WHERE DIRECT EVAP FRM TOP
+!                LAYER ENDS (VOLUMETRIC)
+!   SMCREF     SOIL MOISTURE THRESHOLD WHERE TRANSPIRATION BEGINS TO
+!                STRESS (VOLUMETRIC)
+!   SMCMAX     POROSITY, I.E. SATURATED VALUE OF SOIL MOISTURE
+!                (VOLUMETRIC)
+!   NROOT      NUMBER OF ROOT LAYERS, A FUNCTION OF VEG TYPE, DETERMINED
+!              IN SUBROUTINE REDPRM.
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+! ----------------------------------------------------------------------
+! DECLARATIONS - LOGICAL
+! ----------------------------------------------------------------------
+      LOGICAL FRZGRA
+      LOGICAL SATURATED
+      LOGICAL SNOWNG
+
+! ----------------------------------------------------------------------
+! DECLARATIONS - INTEGER
+! ----------------------------------------------------------------------
+      INTEGER ICE
+      INTEGER K
+      INTEGER KZ
+      INTEGER NSOIL
+      INTEGER NROOT
+      INTEGER SLOPETYP
+      INTEGER SOILTYP
+      INTEGER VEGTYP
+      INTEGER I
+      INTEGER J
+
+! ----------------------------------------------------------------------
+! DECLARATIONS - REAL
+! ----------------------------------------------------------------------
+      REAL ALBEDO
+      REAL ALB
+      REAL BEXP
+      REAL BETA
+      REAL CFACTR
+      REAL CH
+      REAL CM
+      REAL CMC
+      REAL CMCMAX
+      REAL CP
+!      REAL CSNOW
+      REAL CSOIL
+      REAL CZIL
+      REAL DEW
+      REAL DF1
+      REAL DF1H
+      REAL DF1A
+      REAL DKSAT
+      REAL DT
+      REAL DWSAT
+      REAL DQSDT2
+      REAL DSOIL
+      REAL DTOT
+      REAL DRIP
+      REAL EC
+      REAL EDIR
+      REAL ESNOW
+      REAL ET(NSOIL)
+      REAL ETT
+      REAL FRCSNO
+      REAL FRCSOI
+      REAL EPSCA
+      REAL ETA
+      REAL ETP
+      REAL FDOWN
+      REAL F1
+      REAL FLX1
+      REAL FLX2
+      REAL FLX3
+      REAL FXEXP
+      REAL FRZX
+      REAL SHEAT
+      REAL HS
+      REAL KDT
+      REAL LWDN
+      REAL LVH2O
+      REAL PC
+      REAL PRCP
+      REAL PTU
+      REAL PRCP1
+      REAL PSISAT
+      REAL Q2
+      REAL Q2SAT
+      REAL QUARTZ
+      REAL R
+      REAL RCH
+      REAL REFKDT
+      REAL RR
+      REAL RTDIS(NSOLD)
+      REAL RUNOFF1
+      REAL RUNOFF2
+      REAL RGL
+      REAL RUNOFF3
+      REAL RSMAX
+      REAL RC
+      REAL RSMIN
+      REAL RCQ
+      REAL RCS
+      REAL RCSOIL
+      REAL RCT
+      REAL RSNOW
+      REAL SNDENS
+      REAL SNCOND 
+      REAL SSOIL
+      REAL SBETA
+      REAL SFCPRS
+      REAL SFCSPD
+      REAL SFCTMP
+      REAL SHDFAC
+      REAL SHDMIN
+      REAL SH2O(NSOIL)
+      REAL SLDPTH(NSOIL)
+      REAL SMCDRY
+      REAL SMCMAX
+      REAL SMCREF
+      REAL SMCWLT
+      REAL SMC(NSOIL)
+      REAL SNEQV
+      REAL SNCOVR
+      REAL SNOWH
+      REAL SN_NEW
+      REAL SLOPE
+      REAL SNUP
+      REAL SALP
+      REAL SNOALB
+      REAL STC(NSOIL)
+      REAL SNOMLT
+      REAL SOLDN
+      REAL SOILM
+      REAL SOILW
+      REAL SOILWM
+      REAL SOILWW
+      REAL T1
+      REAL T1V
+      REAL T24
+      REAL T2V
+      REAL TBOT
+      REAL TH2
+      REAL TH2V
+      REAL TOPT
+      REAL TFREEZ
+      REAL TSNOW
+      REAL XLAI
+      REAL ZLVL
+      REAL ZBOT
+      REAL Z0
+      REAL ZSOIL(NSOLD)
+
+      REAL FFROZP
+      REAL SOLNET
+      REAL LSUBS
+
+      REAL Q1
+
+! ----------------------------------------------------------------------
+! DECLARATIONS - PARAMETERS
+! ----------------------------------------------------------------------
+      PARAMETER(TFREEZ = 273.15)
+      PARAMETER(LVH2O = 2.501E+6)
+      PARAMETER(LSUBS = 2.83E+6)
+      PARAMETER(R = 287.04)
+      PARAMETER(CP = 1004.5)
+
+! ----------------------------------------------------------------------
+!   INITIALIZATION
+! ----------------------------------------------------------------------
+      RUNOFF1 = 0.0
+      RUNOFF2 = 0.0
+      RUNOFF3 = 0.0
+      SNOMLT = 0.0
+
+! ----------------------------------------------------------------------
+!  THE VARIABLE "ICE" IS A FLAG DENOTING SEA-ICE CASE 
+! ----------------------------------------------------------------------
+      IF (ICE .EQ. 1) THEN
+
+! ----------------------------------------------------------------------
+! SEA-ICE LAYERS ARE EQUAL THICKNESS AND SUM TO 3 METERS
+! ----------------------------------------------------------------------
+        DO KZ = 1,NSOIL
+          ZSOIL(KZ) = -3.*FLOAT(KZ)/FLOAT(NSOIL)
+        END DO
+
+      ELSE
+
+! ----------------------------------------------------------------------
+! CALCULATE DEPTH (NEGATIVE) BELOW GROUND FROM TOP SKIN SFC TO BOTTOM OF
+!   EACH SOIL LAYER.  NOTE:  SIGN OF ZSOIL IS NEGATIVE (DENOTING BELOW
+!   GROUND)
+! ----------------------------------------------------------------------
+        ZSOIL(1) = -SLDPTH(1)
+        DO KZ = 2,NSOIL
+          ZSOIL(KZ) = -SLDPTH(KZ)+ZSOIL(KZ-1)
+        END DO
+
+      ENDIF
+         
+! ----------------------------------------------------------------------
+! NEXT IS CRUCIAL CALL TO SET THE LAND-SURFACE PARAMETERS, INCLUDING
+! SOIL-TYPE AND VEG-TYPE DEPENDENT PARAMETERS.
+! ----------------------------------------------------------------------
+      CALL REDPRM (VEGTYP,SOILTYP,SLOPETYP,                             &
+     &      	   CFACTR,CMCMAX,RSMAX,TOPT,REFKDT,KDT,SBETA,           &
+     &      	   SHDFAC,RSMIN,RGL,HS,ZBOT,FRZX,PSISAT,SLOPE,          &
+     &      	   SNUP,SALP,BEXP,DKSAT,DWSAT,SMCMAX,SMCWLT,SMCREF,     &
+     &      	   SMCDRY,F1,QUARTZ,FXEXP,RTDIS,SLDPTH,ZSOIL,           &
+     &      	   NROOT,NSOIL,Z0,CZIL,XLAI,CSOIL,PTU)
+
+! ----------------------------------------------------------------------
+!  INITIALIZE PRECIPITATION LOGICALS.
+! ----------------------------------------------------------------------
+      SNOWNG = .FALSE.
+      FRZGRA = .FALSE.
+
+! ----------------------------------------------------------------------
+! IF SEA-ICE CASE, ASSIGN DEFAULT WATER-EQUIV SNOW ON TOP
+! ----------------------------------------------------------------------
+      IF (ICE .EQ. 1) THEN
+        SNEQV = 0.01
+        SNOWH = 0.05
+        SNDENS = SNEQV/SNOWH
+      ENDIF
+
+! ----------------------------------------------------------------------
+! IF INPUT SNOWPACK IS NONZERO, THEN COMPUTE SNOW DENSITY "SNDENS" AND
+!   SNOW THERMAL CONDUCTIVITY "SNCOND" (NOTE THAT CSNOW IS A FUNCTION
+!   SUBROUTINE)
+! ----------------------------------------------------------------------
+      IF (SNEQV .EQ. 0.0) THEN
+        SNDENS = 0.0
+        SNOWH = 0.0
+        SNCOND = 1.0
+      ELSE
+        SNDENS = SNEQV/SNOWH
+        SNCOND = CSNOW(SNDENS) 
+      ENDIF
+
+! ----------------------------------------------------------------------
+! DETERMINE IF IT'S PRECIPITATING AND WHAT KIND OF PRECIP IT IS.
+! IF IT'S PRCPING AND THE AIR TEMP IS COLDER THAN 0 C, IT'S SNOWING!
+! IF IT'S PRCPING AND THE AIR TEMP IS WARMER THAN 0 C, BUT THE GRND
+! TEMP IS COLDER THAN 0 C, FREEZING RAIN IS PRESUMED TO BE FALLING.
+! ----------------------------------------------------------------------
+      IF (PRCP .GT. 0.0) THEN
+!        IF (SFCTMP .LE. TFREEZ) THEN
+        IF (FFROZP .GT. 0.5) THEN
+          SNOWNG = .TRUE.
+        ELSE
+          IF (T1 .LE. TFREEZ) FRZGRA = .TRUE.
+        ENDIF
+      ENDIF
+
+! ----------------------------------------------------------------------
+! IF EITHER PRCP FLAG IS SET, DETERMINE NEW SNOWFALL (CONVERTING PRCP
+! RATE FROM KG M-2 S-1 TO A LIQUID EQUIV SNOW DEPTH IN METERS) AND ADD
+! IT TO THE EXISTING SNOWPACK.
+! NOTE THAT SINCE ALL PRECIP IS ADDED TO SNOWPACK, NO PRECIP INFILTRATES
+! INTO THE SOIL SO THAT PRCP1 IS SET TO ZERO.
+! ----------------------------------------------------------------------
+      IF ( (SNOWNG) .OR. (FRZGRA) ) THEN
+        SN_NEW = PRCP * DT * 0.001
+        SNEQV = SNEQV + SN_NEW
+        PRCP1 = 0.0
+
+! ----------------------------------------------------------------------
+! UPDATE SNOW DENSITY BASED ON NEW SNOWFALL, USING OLD AND NEW SNOW.
+! UPDATE SNOW THERMAL CONDUCTIVITY
+! ----------------------------------------------------------------------
+        CALL SNOW_NEW (SFCTMP,SN_NEW,SNOWH,SNDENS)
+        SNCOND = CSNOW (SNDENS) 
+      ELSE
+
+! ----------------------------------------------------------------------
+! PRECIP IS LIQUID (RAIN), HENCE SAVE IN THE PRECIP VARIABLE THAT
+! LATER CAN WHOLELY OR PARTIALLY INFILTRATE THE SOIL (ALONG WITH 
+! ANY CANOPY "DRIP" ADDED TO THIS LATER)
+! ----------------------------------------------------------------------
+        PRCP1 = PRCP
+
+      ENDIF
+
+! ----------------------------------------------------------------------
+! DETERMINE SNOWCOVER AND ALBEDO OVER LAND.
+! ----------------------------------------------------------------------
+      IF (ICE .EQ. 0) THEN
+
+! ----------------------------------------------------------------------
+! IF SNOW DEPTH=0, SET SNOW FRACTION=0, ALBEDO=SNOW FREE ALBEDO.
+! ----------------------------------------------------------------------
+        IF (SNEQV .EQ. 0.0) THEN
+          SNCOVR = 0.0
+          ALBEDO = ALB
+
+        ELSE
+! ----------------------------------------------------------------------
+! DETERMINE SNOW FRACTIONAL COVERAGE.
+! DETERMINE SURFACE ALBEDO MODIFICATION DUE TO SNOWDEPTH STATE.
+! ----------------------------------------------------------------------
+          CALL SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR)
+! MEK JAN 2006, LIMIT SNOW COVER TO A MAXIMUM FRACTION OF 0.98
+          SNCOVR = MIN(SNCOVR,0.98)
+          CALL ALCALC (ALB,SNOALB,SHDFAC,SHDMIN,SNCOVR,TSNOW,ALBEDO)
+        ENDIF
+
+      ELSE
+! ----------------------------------------------------------------------
+! SNOW COVER, ALBEDO OVER SEA-ICE
+! ----------------------------------------------------------------------
+        SNCOVR = 1.0
+!   changed in version 2.6 on June 2nd 2003
+!        ALBEDO = 0.60
+        ALBEDO = 0.65
+      ENDIF
+
+! ----------------------------------------------------------------------
+! THERMAL CONDUCTIVITY FOR SEA-ICE CASE
+! ----------------------------------------------------------------------
+      IF (ICE .EQ. 1) THEN
+        DF1 = 2.2
+
+      ELSE
+
+! ----------------------------------------------------------------------
+! NEXT CALCULATE THE SUBSURFACE HEAT FLUX, WHICH FIRST REQUIRES
+! CALCULATION OF THE THERMAL DIFFUSIVITY.  TREATMENT OF THE
+! LATTER FOLLOWS THAT ON PAGES 148-149 FROM "HEAT TRANSFER IN 
+! COLD CLIMATES", BY V. J. LUNARDINI (PUBLISHED IN 1981 
+! BY VAN NOSTRAND REINHOLD CO.) I.E. TREATMENT OF TWO CONTIGUOUS 
+! "PLANE PARALLEL" MEDIUMS (NAMELY HERE THE FIRST SOIL LAYER 
+! AND THE SNOWPACK LAYER, IF ANY). THIS DIFFUSIVITY TREATMENT 
+! BEHAVES WELL FOR BOTH ZERO AND NONZERO SNOWPACK, INCLUDING THE 
+! LIMIT OF VERY THIN SNOWPACK.  THIS TREATMENT ALSO ELIMINATES
+! THE NEED TO IMPOSE AN ARBITRARY UPPER BOUND ON SUBSURFACE 
+! HEAT FLUX WHEN THE SNOWPACK BECOMES EXTREMELY THIN.
+! ----------------------------------------------------------------------
+! FIRST CALCULATE THERMAL DIFFUSIVITY OF TOP SOIL LAYER, USING
+! BOTH THE FROZEN AND LIQUID SOIL MOISTURE, FOLLOWING THE 
+! SOIL THERMAL DIFFUSIVITY FUNCTION OF PETERS-LIDARD ET AL.
+! (1998,JAS, VOL 55, 1209-1224), WHICH REQUIRES THE SPECIFYING
+! THE QUARTZ CONTENT OF THE GIVEN SOIL CLASS (SEE ROUTINE REDPRM)
+! ----------------------------------------------------------------------
+        CALL TDFCND (DF1,SMC(1),QUARTZ,SMCMAX,SH2O(1))
+
+! ----------------------------------------------------------------------
+! NEXT ADD SUBSURFACE HEAT FLUX REDUCTION EFFECT FROM THE 
+! OVERLYING GREEN CANOPY, ADAPTED FROM SECTION 2.1.2 OF 
+! PETERS-LIDARD ET AL. (1997, JGR, VOL 102(D4))
+! ----------------------------------------------------------------------
+        DF1 = DF1 * EXP(SBETA*SHDFAC)
+      ENDIF
+
+! ----------------------------------------------------------------------
+! FINALLY "PLANE PARALLEL" SNOWPACK EFFECT FOLLOWING 
+! V.J. LINARDINI REFERENCE CITED ABOVE. NOTE THAT DTOT IS
+! COMBINED DEPTH OF SNOWDEPTH AND THICKNESS OF FIRST SOIL LAYER
+! ----------------------------------------------------------------------
+      DSOIL = -(0.5 * ZSOIL(1))
+
+      IF (SNEQV .EQ. 0.) THEN
+        SSOIL = DF1 * (T1 - STC(1) ) / DSOIL
+      ELSE
+        DTOT = SNOWH + DSOIL
+        FRCSNO = SNOWH/DTOT
+        FRCSOI = DSOIL/DTOT
+!
+! 1. HARMONIC MEAN (SERIES FLOW)
+!        DF1 = (SNCOND*DF1)/(FRCSOI*SNCOND+FRCSNO*DF1)
+        DF1H = (SNCOND*DF1)/(FRCSOI*SNCOND+FRCSNO*DF1)
+! 2. ARITHMETIC MEAN (PARALLEL FLOW)
+!        DF1 = FRCSNO*SNCOND + FRCSOI*DF1
+        DF1A = FRCSNO*SNCOND + FRCSOI*DF1
+!
+! 3. GEOMETRIC MEAN (INTERMEDIATE BETWEEN HARMONIC AND ARITHMETIC MEAN)
+!        DF1 = (SNCOND**FRCSNO)*(DF1**FRCSOI)
+! TEST - MBEK, 10 Jan 2002
+! weigh DF by snow fraction
+!        DF1 = DF1H*SNCOVR + DF1A*(1.0-SNCOVR)
+!        DF1 = DF1H*SNCOVR + DF1*(1.0-SNCOVR)
+        DF1 = DF1A*SNCOVR + DF1*(1.0-SNCOVR)
+
+! ----------------------------------------------------------------------
+! CALCULATE SUBSURFACE HEAT FLUX, SSOIL, FROM FINAL THERMAL DIFFUSIVITY
+! OF SURFACE MEDIUMS, DF1 ABOVE, AND SKIN TEMPERATURE AND TOP 
+! MID-LAYER SOIL TEMPERATURE
+! ----------------------------------------------------------------------
+        SSOIL = DF1 * (T1 - STC(1) ) / DTOT
+      ENDIF
+
+! MEK -- DEBUG -- AUG 2005
+!      WRITE(*,*) 'T1,STC(1),DSOIL=',T1,STC(1),DSOIL
+!      WRITE(*,*) 'DF1,SBETA,SHDFAC=',DF1,SBETA,SHDFAC
+!      WRITE(*,*) 'SSOIL=',SSOIL
+
+! ----------------------------------------------------------------------
+! DETERMINE SURFACE ROUGHNESS OVER SNOWPACK USING SNOW CONDITION FROM
+! THE PREVIOUS TIMESTEP.
+! ----------------------------------------------------------------------
+      IF (SNCOVR .GT. 0.) THEN
+        CALL SNOWZ0 (SNCOVR,Z0)
+      ENDIF
+
+! ----------------------------------------------------------------------
+! NEXT CALL ROUTINE SFCDIF TO CALCULATE THE SFC EXCHANGE COEF (CH) FOR
+! HEAT AND MOISTURE.
+!
+! NOTE !!!
+! COMMENT OUT CALL SFCDIF, IF SFCDIF ALREADY CALLED IN CALLING PROGRAM
+! (SUCH AS IN COUPLED ATMOSPHERIC MODEL).
+!
+! NOTE !!!
+! DO NOT CALL SFCDIF UNTIL AFTER ABOVE CALL TO REDPRM, IN CASE
+! ALTERNATIVE VALUES OF ROUGHNESS LENGTH (Z0) AND ZILINTINKEVICH COEF
+! (CZIL) ARE SET THERE VIA NAMELIST I/O.
+!
+! NOTE !!!
+! ROUTINE SFCDIF RETURNS A CH THAT REPRESENTS THE WIND SPD TIMES THE
+! "ORIGINAL" NONDIMENSIONAL "Ch" TYPICAL IN LITERATURE.  HENCE THE CH
+! RETURNED FROM SFCDIF HAS UNITS OF M/S.  THE IMPORTANT COMPANION
+! COEFFICIENT OF CH, CARRIED HERE AS "RCH", IS THE CH FROM SFCDIF TIMES
+! AIR DENSITY AND PARAMETER "CP".  "RCH" IS COMPUTED IN "CALL PENMAN".
+! RCH RATHER THAN CH IS THE COEFF USUALLY INVOKED LATER IN EQNS.
+!
+! NOTE !!!
+! SFCDIF ALSO RETURNS THE SURFACE EXCHANGE COEFFICIENT FOR MOMENTUM, CM,
+! ALSO KNOWN AS THE SURFACE DRAGE COEFFICIENT, BUT CM IS NOT USED HERE.
+! ----------------------------------------------------------------------
+! CALC VIRTUAL TEMPS AND VIRTUAL POTENTIAL TEMPS NEEDED BY SUBROUTINES
+! SFCDIF AND PENMAN.
+! ----------------------------------------------------------------------
+      T2V = SFCTMP * (1.0 + 0.61 * Q2 )
+! ----------------------------------------------------------------------
+! COMMENT OUT BELOW 2 LINES IF CALL SFCDIF IS COMMENTED OUT, I.E. IN THE
+! COUPLED MODEL.
+! ----------------------------------------------------------------------
+!      T1V = T1 * (1.0 + 0.61 * Q2)
+!      TH2V = TH2 * (1.0 + 0.61 * Q2)
+!
+!      CALL SFCDIF (ZLVL,Z0,T1V,TH2V,SFCSPD,CZIL,CM,CH)
+
+! ----------------------------------------------------------------------
+! CALCULATE TOTAL DOWNWARD RADIATION (SOLAR PLUS LONGWAVE) NEEDED IN
+! PENMAN EP SUBROUTINE THAT FOLLOWS
+! ----------------------------------------------------------------------
+!      FDOWN = SOLDN*(1.0-ALBEDO) + LWDN
+      FDOWN = SOLNET + LWDN
+
+! ----------------------------------------------------------------------
+! CALL PENMAN SUBROUTINE TO CALCULATE POTENTIAL EVAPORATION (ETP), AND
+! OTHER PARTIAL PRODUCTS AND SUMS SAVE IN COMMON/RITE FOR LATER
+! CALCULATIONS.
+! ----------------------------------------------------------------------
+       CALL PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL,      &
+     &              Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA,            &
+     &              DQSDT2,FLX2)
+
+! ----------------------------------------------------------------------
+! CALL CANRES TO CALCULATE THE CANOPY RESISTANCE AND CONVERT IT INTO PC
+! IF NONZERO GREENNESS FRACTION
+! ----------------------------------------------------------------------
+      IF (SHDFAC .GT. 0.) THEN
+      
+! ----------------------------------------------------------------------
+!  FROZEN GROUND EXTENSION: TOTAL SOIL WATER "SMC" WAS REPLACED 
+!  BY UNFROZEN SOIL WATER "SH2O" IN CALL TO CANRES BELOW
+! ----------------------------------------------------------------------
+        CALL CANRES (SOLDN,CH,SFCTMP,Q2,SFCPRS,SH2O,ZSOIL,NSOIL,        &
+     &               SMCWLT,SMCREF,RSMIN,RC,PC,NROOT,Q2SAT,DQSDT2,      &
+     &               TOPT,RSMAX,RGL,HS,XLAI,                            &
+     &               RCS,RCT,RCQ,RCSOIL)
+
+      ENDIF
+
+! ----------------------------------------------------------------------
+! NOW DECIDE MAJOR PATHWAY BRANCH TO TAKE DEPENDING ON WHETHER SNOWPACK
+! EXISTS OR NOT:
+! ----------------------------------------------------------------------
+      ESNOW = 0.0
+      IF (SNEQV .EQ. 0.0) THEN
+        CALL NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                     &
+     &     	    SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,SHDFAC,           &
+     &     	    SBETA,Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,          &
+     &     	    STC,EPSCA,BEXP,PC,RCH,RR,CFACTR,                    &
+     &     	    SH2O,SLOPE,KDT,FRZX,PSISAT,ZSOIL,                   &
+     &     	    DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2,              &
+     &     	    RUNOFF3,EDIR,EC,ET,ETT,NROOT,ICE,RTDIS,             &
+     &     	    QUARTZ,FXEXP,CSOIL,                                 &
+     &     	    BETA,DRIP,DEW,FLX1,FLX2,FLX3)
+      ELSE
+        CALL SNOPAC (ETP,ETA,PRCP,PRCP1,SNOWNG,SMC,SMCMAX,SMCWLT,       &
+     &               SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,                 &
+     &               SBETA,DF1,                                         &
+     &               Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,STC,EPSCA,     &
+     &               SFCPRS,BEXP,PC,RCH,RR,CFACTR,SNCOVR,SNEQV,SNDENS,  &
+     &               SNOWH,SH2O,SLOPE,KDT,FRZX,PSISAT,SNUP,             &
+     &               ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1,        &
+     &               RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT,       &
+     &               ICE,RTDIS,QUARTZ,FXEXP,CSOIL,                      &
+     &               BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW)
+!        ESNOW = ETA
+      ENDIF
+
+! ----------------------------------------------------------------------
+!   PREPARE SENSIBLE HEAT (H) FOR RETURN TO PARENT MODEL
+! ----------------------------------------------------------------------
+      SHEAT = -(CH * CP * SFCPRS)/(R * T2V) * ( TH2 - T1 )
+          
+! ----------------------------------------------------------------------
+!  CONVERT UNITS AND/OR SIGN OF TOTAL EVAP (ETA), POTENTIAL EVAP (ETP),
+!  SUBSURFACE HEAT FLUX (S), AND RUNOFFS FOR WHAT PARENT MODEL EXPECTS
+!  CONVERT ETA FROM KG M-2 S-1 TO W M-2
+! ----------------------------------------------------------------------
+!      ETA = ETA*LVH2O
+!      ETP = ETP*LVH2O
+
+! ----------------------------------------------------------------------
+      EDIR = EDIR * LVH2O
+      EC = EC * LVH2O
+      DO K=1,4
+        ET(K) = ET(K) * LVH2O
+      ENDDO
+      ETT = ETT * LVH2O
+      ESNOW = ESNOW * LSUBS
+      ETP = ETP*((1.-SNCOVR)*LVH2O + SNCOVR*LSUBS)
+      IF (ETP .GT. 0.) THEN
+        ETA = EDIR + EC + ETT + ESNOW
+      ELSE
+        ETA = ETP
+      ENDIF
+      BETA = ETA/ETP
+! ----------------------------------------------------------------------
+
+! ----------------------------------------------------------------------
+! CONVERT THE SIGN OF SOIL HEAT FLUX SO THAT:
+!   SSOIL>0: WARM THE SURFACE  (NIGHT TIME)
+!   SSOIL<0: COOL THE SURFACE  (DAY TIME)
+! ----------------------------------------------------------------------
+      SSOIL = -1.0*SSOIL      
+
+! ----------------------------------------------------------------------
+!  CONVERT RUNOFF3 (INTERNAL LAYER RUNOFF FROM SUPERSAT) FROM M TO M S-1
+!  AND ADD TO SUBSURFACE RUNOFF/DRAINAGE/BASEFLOW
+! ----------------------------------------------------------------------
+      RUNOFF3 = RUNOFF3/DT
+      RUNOFF2 = RUNOFF2+RUNOFF3
+
+! ----------------------------------------------------------------------
+! TOTAL COLUMN SOIL MOISTURE IN METERS (SOILM) AND ROOT-ZONE 
+! SOIL MOISTURE AVAILABILITY (FRACTION) RELATIVE TO POROSITY/SATURATION
+! ----------------------------------------------------------------------
+      SOILM = -1.0*SMC(1)*ZSOIL(1)
+      DO K = 2,NSOIL
+        SOILM = SOILM+SMC(K)*(ZSOIL(K-1)-ZSOIL(K))
+      END DO
+      SOILWM = -1.0*(SMCMAX-SMCWLT)*ZSOIL(1)
+      SOILWW = -1.0*(SMC(1)-SMCWLT)*ZSOIL(1)
+      DO K = 2,NROOT
+        SOILWM = SOILWM+(SMCMAX-SMCWLT)*(ZSOIL(K-1)-ZSOIL(K))
+        SOILWW = SOILWW+(SMC(K)-SMCWLT)*(ZSOIL(K-1)-ZSOIL(K))
+      END DO
+      SOILW = SOILWW/SOILWM
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE SFLX
+! ----------------------------------------------------------------------
+      END SUBROUTINE SFLX
+
+      SUBROUTINE ALCALC (ALB,SNOALB,SHDFAC,SHDMIN,SNCOVR,TSNOW,ALBEDO)
+
+      IMPLICIT NONE
+      
+! ----------------------------------------------------------------------
+! CALCULATE ALBEDO INCLUDING SNOW EFFECT (0 -> 1)
+!   ALB     SNOWFREE ALBEDO
+!   SNOALB  MAXIMUM (DEEP) SNOW ALBEDO
+!   SHDFAC    AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION
+!   SHDMIN    MINIMUM AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION
+!   SNCOVR  FRACTIONAL SNOW COVER
+!   ALBEDO  SURFACE ALBEDO INCLUDING SNOW EFFECT
+!   TSNOW   SNOW SURFACE TEMPERATURE (K)
+! ----------------------------------------------------------------------
+      REAL ALB, SNOALB, SHDFAC, SHDMIN, SNCOVR, ALBEDO, TSNOW
+      
+! ----------------------------------------------------------------------
+! SNOALB IS ARGUMENT REPRESENTING MAXIMUM ALBEDO OVER DEEP SNOW,
+! AS PASSED INTO SFLX, AND ADAPTED FROM THE SATELLITE-BASED MAXIMUM 
+! SNOW ALBEDO FIELDS PROVIDED BY D. ROBINSON AND G. KUKLA 
+! (1985, JCAM, VOL 24, 402-411)
+! ----------------------------------------------------------------------
+!         changed in version 2.6 on June 2nd 2003
+!          ALBEDO = ALB + (1.0-(SHDFAC-SHDMIN))*SNCOVR*(SNOALB-ALB) 
+          ALBEDO = ALB + SNCOVR*(SNOALB-ALB)
+          IF (ALBEDO .GT. SNOALB) ALBEDO=SNOALB
+
+!     BASE FORMULATION (DICKINSON ET AL., 1986, COGLEY ET AL., 1990)
+!          IF (TSNOW.LE.263.16) THEN
+!            ALBEDO=SNOALB
+!          ELSE
+!            IF (TSNOW.LT.273.16) THEN
+!              TM=0.1*(TSNOW-263.16)
+!              ALBEDO=0.5*((0.9-0.2*(TM**3))+(0.8-0.16*(TM**3)))
+!            ELSE
+!              ALBEDO=0.67
+!            ENDIF
+!          ENDIF
+
+!     ISBA FORMULATION (VERSEGHY, 1991; BAKER ET AL., 1990)
+!          IF (TSNOW.LT.273.16) THEN
+!            ALBEDO=SNOALB-0.008*DT/86400
+!          ELSE
+!            ALBEDO=(SNOALB-0.5)*EXP(-0.24*DT/86400)+0.5
+!          ENDIF
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE ALCALC
+! ----------------------------------------------------------------------
+      END SUBROUTINE ALCALC
+
+      SUBROUTINE CANRES (SOLAR,CH,SFCTMP,Q2,SFCPRS,SMC,ZSOIL,NSOIL,     &
+     &                   SMCWLT,SMCREF,RSMIN,RC,PC,NROOT,Q2SAT,DQSDT2,  &
+     &                   TOPT,RSMAX,RGL,HS,XLAI,                        &
+     &                   RCS,RCT,RCQ,RCSOIL)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE CANRES                    
+! ----------------------------------------------------------------------
+! CALCULATE CANOPY RESISTANCE WHICH DEPENDS ON INCOMING SOLAR RADIATION,
+! AIR TEMPERATURE, ATMOSPHERIC WATER VAPOR PRESSURE DEFICIT AT THE
+! LOWEST MODEL LEVEL, AND SOIL MOISTURE (PREFERABLY UNFROZEN SOIL
+! MOISTURE RATHER THAN TOTAL)
+! ----------------------------------------------------------------------
+! SOURCE:  JARVIS (1976), NOILHAN AND PLANTON (1989, MWR), JACQUEMIN AND
+! NOILHAN (1990, BLM)
+! SEE ALSO:  CHEN ET AL (1996, JGR, VOL 101(D3), 7251-7268), EQNS 12-14
+! AND TABLE 2 OF SEC. 3.1.2         
+! ----------------------------------------------------------------------
+! INPUT:
+!   SOLAR   INCOMING SOLAR RADIATION
+!   CH      SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE
+!   SFCTMP  AIR TEMPERATURE AT 1ST LEVEL ABOVE GROUND
+!   Q2      AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND
+!   Q2SAT   SATURATION AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND
+!   DQSDT2  SLOPE OF SATURATION HUMIDITY FUNCTION WRT TEMP
+!   SFCPRS  SURFACE PRESSURE
+!   SMC     VOLUMETRIC SOIL MOISTURE 
+!   ZSOIL   SOIL DEPTH (NEGATIVE SIGN, AS IT IS BELOW GROUND)
+!   NSOIL   NO. OF SOIL LAYERS
+!   NROOT   NO. OF SOIL LAYERS IN ROOT ZONE (1.LE.NROOT.LE.NSOIL)
+!   XLAI    LEAF AREA INDEX
+!   SMCWLT  WILTING POINT
+!   SMCREF  REFERENCE SOIL MOISTURE (WHERE SOIL WATER DEFICIT STRESS
+!             SETS IN)
+! RSMIN, RSMAX, TOPT, RGL, HS ARE CANOPY STRESS PARAMETERS SET IN
+!   SURBOUTINE REDPRM
+! OUTPUT:
+!   PC  PLANT COEFFICIENT
+!   RC  CANOPY RESISTANCE
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+      INTEGER K
+      INTEGER NROOT
+      INTEGER NSOIL
+
+      REAL CH
+      REAL CP
+      REAL DELTA
+      REAL DQSDT2
+      REAL FF
+      REAL GX
+      REAL HS
+      REAL P
+      REAL PART(NSOLD) 
+      REAL PC
+      REAL Q2
+      REAL Q2SAT
+      REAL RC
+      REAL RSMIN
+      REAL RCQ
+      REAL RCS
+      REAL RCSOIL
+      REAL RCT
+      REAL RD
+      REAL RGL
+      REAL RR
+      REAL RSMAX
+      REAL SFCPRS
+      REAL SFCTMP
+      REAL SIGMA
+      REAL SLV
+      REAL SMC(NSOIL)
+      REAL SMCREF
+      REAL SMCWLT
+      REAL SOLAR
+      REAL TOPT
+      REAL SLVCP
+      REAL ST1
+      REAL TAIR4
+      REAL XLAI
+      REAL ZSOIL(NSOIL)
+
+      PARAMETER(CP = 1004.5)
+      PARAMETER(RD = 287.04)
+      PARAMETER(SIGMA = 5.67E-8)
+      PARAMETER(SLV = 2.501000E6)
+
+! ----------------------------------------------------------------------
+! INITIALIZE CANOPY RESISTANCE MULTIPLIER TERMS.
+! ----------------------------------------------------------------------
+      RCS = 0.0
+      RCT = 0.0
+      RCQ = 0.0
+      RCSOIL = 0.0
+      RC = 0.0
+
+! ----------------------------------------------------------------------
+! CONTRIBUTION DUE TO INCOMING SOLAR RADIATION
+! ----------------------------------------------------------------------
+      FF = 0.55*2.0*SOLAR/(RGL*XLAI)
+      RCS = (FF + RSMIN/RSMAX) / (1.0 + FF)
+      RCS = MAX(RCS,0.0001)
+
+! ----------------------------------------------------------------------
+! CONTRIBUTION DUE TO AIR TEMPERATURE AT FIRST MODEL LEVEL ABOVE GROUND
+! RCT EXPRESSION FROM NOILHAN AND PLANTON (1989, MWR).
+! ----------------------------------------------------------------------
+      RCT = 1.0 - 0.0016*((TOPT-SFCTMP)**2.0)
+      RCT = MAX(RCT,0.0001)
+
+! ----------------------------------------------------------------------
+! CONTRIBUTION DUE TO VAPOR PRESSURE DEFICIT AT FIRST MODEL LEVEL.
+! RCQ EXPRESSION FROM SSIB 
+! ----------------------------------------------------------------------
+      RCQ = 1.0/(1.0+HS*(Q2SAT-Q2))
+      RCQ = MAX(RCQ,0.01)
+
+! ----------------------------------------------------------------------
+! CONTRIBUTION DUE TO SOIL MOISTURE AVAILABILITY.
+! DETERMINE CONTRIBUTION FROM EACH SOIL LAYER, THEN ADD THEM UP.
+! ----------------------------------------------------------------------
+      GX = (SMC(1) - SMCWLT) / (SMCREF - SMCWLT)
+      IF (GX .GT. 1.) GX = 1.
+      IF (GX .LT. 0.) GX = 0.
+
+! ----------------------------------------------------------------------
+! USE SOIL DEPTH AS WEIGHTING FACTOR
+! ----------------------------------------------------------------------
+      PART(1) = (ZSOIL(1)/ZSOIL(NROOT)) * GX
+! ----------------------------------------------------------------------
+! USE ROOT DISTRIBUTION AS WEIGHTING FACTOR
+!      PART(1) = RTDIS(1) * GX
+! ----------------------------------------------------------------------
+      IF (NROOT .GT. 1) THEN
+        DO K = 2,NROOT
+          GX = (SMC(K) - SMCWLT) / (SMCREF - SMCWLT)
+          IF (GX .GT. 1.) GX = 1.
+          IF (GX .LT. 0.) GX = 0.
+! ----------------------------------------------------------------------
+! USE SOIL DEPTH AS WEIGHTING FACTOR        
+! ----------------------------------------------------------------------
+          PART(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT)) * GX
+! ----------------------------------------------------------------------
+! USE ROOT DISTRIBUTION AS WEIGHTING FACTOR
+!        PART(K) = RTDIS(K) * GX 
+! ----------------------------------------------------------------------
+        END DO
+      ENDIF
+
+      DO K = 1,NROOT
+        RCSOIL = RCSOIL+PART(K)
+      END DO
+      RCSOIL = MAX(RCSOIL,0.0001)
+
+! ----------------------------------------------------------------------
+! DETERMINE CANOPY RESISTANCE DUE TO ALL FACTORS.  CONVERT CANOPY
+! RESISTANCE (RC) TO PLANT COEFFICIENT (PC) TO BE USED WITH POTENTIAL
+! EVAP IN DETERMINING ACTUAL EVAP.  PC IS DETERMINED BY:
+!   PC * LINERIZED PENMAN POTENTIAL EVAP =
+!   PENMAN-MONTEITH ACTUAL EVAPORATION (CONTAINING RC TERM).
+! ----------------------------------------------------------------------
+      RC = RSMIN/(XLAI*RCS*RCT*RCQ*RCSOIL)
+
+!      TAIR4 = SFCTMP**4.
+!      ST1 = (4.*SIGMA*RD)/CP
+!      SLVCP = SLV/CP
+!      RR = ST1*TAIR4/(SFCPRS*CH) + 1.0
+      RR = (4.*SIGMA*RD/CP)*(SFCTMP**4.)/(SFCPRS*CH) + 1.0
+      DELTA = (SLV/CP)*DQSDT2
+
+      PC = (RR+DELTA)/(RR*(1.+RC*CH)+DELTA)
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE CANRES
+! ----------------------------------------------------------------------
+      END SUBROUTINE CANRES
+
+      SUBROUTINE DEVAP (EDIR1,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP,        &
+     &                DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE DEVAP
+! ----------------------------------------------------------------------
+! CALCULATE DIRECT SOIL EVAPORATION
+! ----------------------------------------------------------------------
+      REAL BEXP
+!      REAL DEVAP
+      REAL EDIR1
+      REAL DKSAT
+      REAL DWSAT
+      REAL ETP1
+      REAL FX
+      REAL FXEXP
+      REAL SHDFAC
+      REAL SMC
+      REAL SMCDRY
+      REAL SMCMAX
+      REAL ZSOIL
+      REAL SMCREF
+      REAL SMCWLT
+      REAL SRATIO
+
+! ----------------------------------------------------------------------
+! DIRECT EVAP A FUNCTION OF RELATIVE SOIL MOISTURE AVAILABILITY, LINEAR
+! WHEN FXEXP=1.
+! FX > 1 REPRESENTS DEMAND CONTROL
+! FX < 1 REPRESENTS FLUX CONTROL
+! ----------------------------------------------------------------------
+      SRATIO = (SMC - SMCDRY) / (SMCMAX - SMCDRY)
+      IF (SRATIO .GT. 0.) THEN
+        FX = SRATIO**FXEXP
+        FX = MAX ( MIN ( FX, 1. ) ,0. )
+      ELSE
+        FX = 0.
+      ENDIF
+
+! ----------------------------------------------------------------------
+! ALLOW FOR THE DIRECT-EVAP-REDUCING EFFECT OF SHADE
+! ----------------------------------------------------------------------
+!      DEVAP = FX * ( 1.0 - SHDFAC ) * ETP1
+      EDIR1 = FX * ( 1.0 - SHDFAC ) * ETP1
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE DEVAP
+! ----------------------------------------------------------------------
+      END SUBROUTINE DEVAP
+
+      SUBROUTINE EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,               &
+     &                  SH2O,                                           &
+     &                  SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,              &
+     &                  SMCREF,SHDFAC,CMCMAX,                           &
+     &                  SMCDRY,CFACTR,                                  &
+     &                  EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE EVAPO
+! ----------------------------------------------------------------------
+! CALCULATE SOIL MOISTURE FLUX.  THE SOIL MOISTURE CONTENT (SMC - A PER
+! UNIT VOLUME MEASUREMENT) IS A DEPENDENT VARIABLE THAT IS UPDATED WITH
+! PROGNOSTIC EQNS. THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED.
+! FROZEN GROUND VERSION:  NEW STATES ADDED: SH2O, AND FROZEN GROUND
+! CORRECTION FACTOR, FRZFACT AND PARAMETER SLOPE.
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+      INTEGER I
+      INTEGER K
+      INTEGER NSOIL
+      INTEGER NROOT
+
+      REAL BEXP
+      REAL CFACTR
+      REAL CMC
+      REAL CMC2MS
+      REAL CMCMAX
+!      REAL DEVAP
+      REAL DKSAT
+      REAL DT
+      REAL DWSAT
+      REAL EC1
+      REAL EDIR1
+      REAL ET1(NSOIL)
+      REAL ETA1
+      REAL ETP1
+      REAL ETT1
+      REAL FXEXP
+      REAL PC
+      REAL Q2
+      REAL RTDIS(NSOIL)
+      REAL SFCTMP
+      REAL SHDFAC
+      REAL SMC(NSOIL)
+      REAL SH2O(NSOIL)
+      REAL SMCDRY
+      REAL SMCMAX
+      REAL SMCREF
+      REAL SMCWLT
+      REAL ZSOIL(NSOIL)
+
+! ----------------------------------------------------------------------
+! EXECUTABLE CODE BEGINS HERE IF THE POTENTIAL EVAPOTRANSPIRATION IS
+! GREATER THAN ZERO.
+! ----------------------------------------------------------------------
+      EDIR1 = 0.
+      EC1 = 0.
+      DO K = 1,NSOIL
+        ET1(K) = 0.
+      END DO
+      ETT1 = 0.
+
+      IF (ETP1 .GT. 0.0) THEN
+
+! ----------------------------------------------------------------------
+! RETRIEVE DIRECT EVAPORATION FROM SOIL SURFACE.  CALL THIS FUNCTION
+! ONLY IF VEG COVER NOT COMPLETE.
+! FROZEN GROUND VERSION:  SH2O STATES REPLACE SMC STATES.
+! ----------------------------------------------------------------------
+        IF (SHDFAC .LT. 1.) THEN
+        CALL DEVAP (EDIR1,ETP1,SH2O(1),ZSOIL(1),SHDFAC,SMCMAX,          &
+!          EDIR = DEVAP(ETP1,SH2O(1),ZSOIL(1),SHDFAC,SMCMAX,             &
+     &                 BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP)
+        ENDIF
+
+! ----------------------------------------------------------------------
+! INITIALIZE PLANT TOTAL TRANSPIRATION, RETRIEVE PLANT TRANSPIRATION,
+! AND ACCUMULATE IT FOR ALL SOIL LAYERS.
+! ----------------------------------------------------------------------
+        IF (SHDFAC.GT.0.0) THEN
+
+          CALL TRANSP (ET1,NSOIL,ETP1,SH2O,CMC,ZSOIL,SHDFAC,SMCWLT,     &
+     &                 CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT,RTDIS)
+
+          DO K = 1,NSOIL
+            ETT1 = ETT1 + ET1(K)
+          END DO
+
+! ----------------------------------------------------------------------
+! CALCULATE CANOPY EVAPORATION.
+! IF STATEMENTS TO AVOID TANGENT LINEAR PROBLEMS NEAR CMC=0.0.
+! ----------------------------------------------------------------------
+          IF (CMC .GT. 0.0) THEN
+            EC1 = SHDFAC * ( ( CMC / CMCMAX ) ** CFACTR ) * ETP1
+          ELSE
+            EC1 = 0.0
+          ENDIF
+
+! ----------------------------------------------------------------------
+! EC SHOULD BE LIMITED BY THE TOTAL AMOUNT OF AVAILABLE WATER ON THE
+! CANOPY.  -F.CHEN, 18-OCT-1994
+! ----------------------------------------------------------------------
+          CMC2MS = CMC / DT
+          EC1 = MIN ( CMC2MS, EC1 )
+        ENDIF
+      ENDIF
+
+! ----------------------------------------------------------------------
+! TOTAL UP EVAP AND TRANSP TYPES TO OBTAIN ACTUAL EVAPOTRANSP
+! ----------------------------------------------------------------------
+      ETA1 = EDIR1 + ETT1 + EC1
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE EVAPO
+! ----------------------------------------------------------------------
+      END SUBROUTINE EVAPO
+
+      SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &
+     &                TBOT,ZBOT,PSISAT,SH2O,DT,BEXP,                    &
+     &                F1,DF1,QUARTZ,CSOIL,AI,BI,CI)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE HRT
+! ----------------------------------------------------------------------
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL
+! THERMAL DIFFUSION EQUATION.  ALSO TO COMPUTE ( PREPARE ) THE MATRIX
+! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME.
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+      LOGICAL ITAVG
+
+      INTEGER I
+      INTEGER K
+      INTEGER NSOIL
+
+! ----------------------------------------------------------------------
+! DECLARE WORK ARRAYS NEEDED IN TRI-DIAGONAL IMPLICIT SOLVER
+! ----------------------------------------------------------------------
+      REAL AI(NSOLD)
+      REAL BI(NSOLD)
+      REAL CI(NSOLD)
+
+! ----------------------------------------------------------------------
+! DECLARATIONS
+! ----------------------------------------------------------------------
+      REAL BEXP
+      REAL CAIR
+      REAL CH2O
+      REAL CICE
+      REAL CSOIL
+      REAL DDZ
+      REAL DDZ2
+      REAL DENOM
+      REAL DF1
+      REAL DF1N
+      REAL DF1K
+      REAL DT
+      REAL DTSDZ
+      REAL DTSDZ2
+      REAL F1
+      REAL HCPCT
+      REAL PSISAT
+      REAL QUARTZ
+      REAL QTOT
+      REAL RHSTS(NSOIL)
+      REAL SSOIL
+      REAL SICE
+      REAL SMC(NSOIL)
+      REAL SH2O(NSOIL)
+      REAL SMCMAX
+!      REAL SNKSRC
+      REAL STC(NSOIL)
+      REAL T0
+      REAL TAVG
+      REAL TBK
+      REAL TBK1
+      REAL TBOT
+      REAL ZBOT
+      REAL TSNSR
+      REAL TSURF
+      REAL YY
+      REAL ZSOIL(NSOIL)
+      REAL ZZ1
+
+      PARAMETER(T0 = 273.15)
+
+! ----------------------------------------------------------------------
+! SET SPECIFIC HEAT CAPACITIES OF AIR, WATER, ICE, SOIL MINERAL       
+! ----------------------------------------------------------------------
+      PARAMETER(CAIR = 1004.0)
+      PARAMETER(CH2O = 4.2E6)
+      PARAMETER(CICE = 2.106E6)
+! NOTE: CSOIL NOW SET IN ROUTINE REDPRM AND PASSED IN
+!      PARAMETER(CSOIL = 1.26E6)
+
+! ----------------------------------------------------------------------
+! INITIALIZE LOGICAL FOR SOIL LAYER TEMPERATURE AVERAGING.
+! ----------------------------------------------------------------------
+      ITAVG = .TRUE.
+!      ITAVG = .FALSE.
+
+! ----------------------------------------------------------------------
+! BEGIN SECTION FOR TOP SOIL LAYER
+! ----------------------------------------------------------------------
+! CALC THE HEAT CAPACITY OF THE TOP SOIL LAYER
+! ----------------------------------------------------------------------
+      HCPCT = SH2O(1)*CH2O + (1.0-SMCMAX)*CSOIL + (SMCMAX-SMC(1))*CAIR  &
+     &        + ( SMC(1) - SH2O(1) )*CICE
+
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER
+! ----------------------------------------------------------------------
+      DDZ = 1.0 / ( -0.5 * ZSOIL(2) )
+      AI(1) = 0.0
+      CI(1) = (DF1 * DDZ) / (ZSOIL(1) * HCPCT)
+      BI(1) = -CI(1) + DF1 / (0.5 * ZSOIL(1) * ZSOIL(1)*HCPCT*ZZ1)
+
+! ----------------------------------------------------------------------
+! CALCULATE THE VERTICAL SOIL TEMP GRADIENT BTWN THE 1ST AND 2ND SOIL
+! LAYERS.  THEN CALCULATE THE SUBSURFACE HEAT FLUX. USE THE TEMP
+! GRADIENT AND SUBSFC HEAT FLUX TO CALC "RIGHT-HAND SIDE TENDENCY
+! TERMS", OR "RHSTS", FOR TOP SOIL LAYER.
+! ----------------------------------------------------------------------
+      DTSDZ = (STC(1) - STC(2)) / (-0.5 * ZSOIL(2))
+      SSOIL = DF1 * (STC(1) - YY) / (0.5 * ZSOIL(1) * ZZ1)
+      RHSTS(1) = (DF1 * DTSDZ - SSOIL) / (ZSOIL(1) * HCPCT)
+
+! ----------------------------------------------------------------------
+! NEXT CAPTURE THE VERTICAL DIFFERENCE OF THE HEAT FLUX AT TOP AND
+! BOTTOM OF FIRST SOIL LAYER FOR USE IN HEAT FLUX CONSTRAINT APPLIED TO
+! POTENTIAL SOIL FREEZING/THAWING IN ROUTINE SNKSRC.
+! ----------------------------------------------------------------------
+      QTOT = SSOIL - DF1*DTSDZ
+
+! ----------------------------------------------------------------------
+! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP):
+! SET TEMP "TSURF" AT TOP OF SOIL COLUMN (FOR USE IN FREEZING SOIL
+! PHYSICS LATER IN FUNCTION SUBROUTINE SNKSRC).  IF SNOWPACK CONTENT IS
+! ZERO, THEN TSURF EXPRESSION BELOW GIVES TSURF = SKIN TEMP.  IF
+! SNOWPACK IS NONZERO (HENCE ARGUMENT ZZ1=1), THEN TSURF EXPRESSION
+! BELOW YIELDS SOIL COLUMN TOP TEMPERATURE UNDER SNOWPACK.  THEN
+! CALCULATE TEMPERATURE AT BOTTOM INTERFACE OF 1ST SOIL LAYER FOR USE
+! LATER IN FUNCTION SUBROUTINE SNKSRC
+! ----------------------------------------------------------------------
+      IF (ITAVG) THEN 
+        TSURF = (YY + (ZZ1-1) * STC(1)) / ZZ1
+        CALL TBND (STC(1),STC(2),ZSOIL,ZBOT,1,NSOIL,TBK)
+      ENDIF
+
+! ----------------------------------------------------------------------
+! CALCULATE FROZEN WATER CONTENT IN 1ST SOIL LAYER. 
+! ----------------------------------------------------------------------
+      SICE = SMC(1) - SH2O(1)
+
+! ----------------------------------------------------------------------
+! IF FROZEN WATER PRESENT OR ANY OF LAYER-1 MID-POINT OR BOUNDING
+! INTERFACE TEMPERATURES BELOW FREEZING, THEN CALL SNKSRC TO
+! COMPUTE HEAT SOURCE/SINK (AND CHANGE IN FROZEN WATER CONTENT)
+! DUE TO POSSIBLE SOIL WATER PHASE CHANGE
+! ----------------------------------------------------------------------
+      IF ( (SICE   .GT. 0.) .OR. (TSURF .LT. T0) .OR.                   &
+     &     (STC(1) .LT. T0) .OR. (TBK   .LT. T0) ) THEN
+
+        IF (ITAVG) THEN 
+          CALL TMPAVG(TAVG,TSURF,STC(1),TBK,ZSOIL,NSOIL,1)
+        ELSE
+          TAVG = STC(1)
+        ENDIF
+        TSNSR = SNKSRC (TAVG,SMC(1),SH2O(1),                            &
+     &    ZSOIL,NSOIL,SMCMAX,PSISAT,BEXP,DT,1,QTOT)
+
+        RHSTS(1) = RHSTS(1) - TSNSR / ( ZSOIL(1) * HCPCT )
+      ENDIF
+ 
+! ----------------------------------------------------------------------
+! THIS ENDS SECTION FOR TOP SOIL LAYER.
+! ----------------------------------------------------------------------
+! INITIALIZE DDZ2
+! ----------------------------------------------------------------------
+      DDZ2 = 0.0
+
+! ----------------------------------------------------------------------
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS
+! (EXCEPT SUBSFC OR "GROUND" HEAT FLUX NOT REPEATED IN LOWER LAYERS)
+! ----------------------------------------------------------------------
+      DF1K = DF1
+      DO K = 2,NSOIL
+
+! ----------------------------------------------------------------------
+! CALCULATE HEAT CAPACITY FOR THIS SOIL LAYER.
+! ----------------------------------------------------------------------
+        HCPCT = SH2O(K)*CH2O +(1.0-SMCMAX)*CSOIL +(SMCMAX-SMC(K))*CAIR  &
+     &        + ( SMC(K) - SH2O(K) )*CICE
+
+        IF (K .NE. NSOIL) THEN
+! ----------------------------------------------------------------------
+! THIS SECTION FOR LAYER 2 OR GREATER, BUT NOT LAST LAYER.
+! ----------------------------------------------------------------------
+! CALCULATE THERMAL DIFFUSIVITY FOR THIS LAYER.
+! ----------------------------------------------------------------------
+          CALL TDFCND (DF1N,SMC(K),QUARTZ,SMCMAX,SH2O(K))
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER
+! ----------------------------------------------------------------------
+          DENOM = 0.5 * ( ZSOIL(K-1) - ZSOIL(K+1) )
+          DTSDZ2 = ( STC(K) - STC(K+1) ) / DENOM
+
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT
+! ----------------------------------------------------------------------
+          DDZ2 = 2. / (ZSOIL(K-1) - ZSOIL(K+1))
+          CI(K) = -DF1N * DDZ2 / ((ZSOIL(K-1) - ZSOIL(K)) * HCPCT)
+
+! ----------------------------------------------------------------------
+! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP):  CALCULATE
+! TEMP AT BOTTOM OF LAYER.
+! ----------------------------------------------------------------------
+          IF (ITAVG) THEN 
+            CALL TBND (STC(K),STC(K+1),ZSOIL,ZBOT,K,NSOIL,TBK1)
+          ENDIF
+        ELSE
+
+! ----------------------------------------------------------------------
+! SPECIAL CASE OF BOTTOM SOIL LAYER:  CALCULATE THERMAL DIFFUSIVITY FOR
+! BOTTOM LAYER.
+! ----------------------------------------------------------------------
+          CALL TDFCND (DF1N,SMC(K),QUARTZ,SMCMAX,SH2O(K))
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU BOTTOM LAYER.
+! ----------------------------------------------------------------------
+          DENOM = .5 * (ZSOIL(K-1) + ZSOIL(K)) - ZBOT
+          DTSDZ2 = (STC(K)-TBOT) / DENOM
+
+! ----------------------------------------------------------------------
+! SET MATRIX COEF, CI TO ZERO IF BOTTOM LAYER.
+! ----------------------------------------------------------------------
+          CI(K) = 0.
+
+! ----------------------------------------------------------------------
+! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP):  CALCULATE
+! TEMP AT BOTTOM OF LAST LAYER.
+! ----------------------------------------------------------------------
+          IF (ITAVG) THEN 
+            CALL TBND (STC(K),TBOT,ZSOIL,ZBOT,K,NSOIL,TBK1)
+          ENDIF 
+
+        ENDIF
+! ----------------------------------------------------------------------
+! THIS ENDS SPECIAL LOOP FOR BOTTOM LAYER.
+! ----------------------------------------------------------------------
+! CALCULATE RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT.
+! ----------------------------------------------------------------------
+        DENOM = ( ZSOIL(K) - ZSOIL(K-1) ) * HCPCT
+        RHSTS(K) = ( DF1N * DTSDZ2 - DF1K * DTSDZ ) / DENOM
+        QTOT = -1.0*DENOM*RHSTS(K)
+        SICE = SMC(K) - SH2O(K)
+
+        IF ( (SICE .GT. 0.) .OR. (TBK .LT. T0) .OR.                     &
+     &     (STC(K) .LT. T0) .OR. (TBK1 .LT. T0) ) THEN
+
+          IF (ITAVG) THEN 
+            CALL TMPAVG(TAVG,TBK,STC(K),TBK1,ZSOIL,NSOIL,K)
+          ELSE
+            TAVG = STC(K)
+          ENDIF
+          TSNSR = SNKSRC(TAVG,SMC(K),SH2O(K),ZSOIL,NSOIL,               &
+     &                   SMCMAX,PSISAT,BEXP,DT,K,QTOT)
+          RHSTS(K) = RHSTS(K) - TSNSR / DENOM
+        ENDIF 
+
+! ----------------------------------------------------------------------
+! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER.
+! ----------------------------------------------------------------------
+        AI(K) = - DF1 * DDZ / ((ZSOIL(K-1) - ZSOIL(K)) * HCPCT)
+        BI(K) = -(AI(K) + CI(K))
+
+! ----------------------------------------------------------------------
+! RESET VALUES OF DF1, DTSDZ, DDZ, AND TBK FOR LOOP TO NEXT SOIL LAYER.
+! ----------------------------------------------------------------------
+        TBK   = TBK1
+        DF1K  = DF1N
+        DTSDZ = DTSDZ2
+        DDZ   = DDZ2
+      END DO
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE HRT
+! ----------------------------------------------------------------------
+      END SUBROUTINE HRT
+
+      SUBROUTINE HRTICE (RHSTS,STC,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE HRTICE
+! ----------------------------------------------------------------------
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL
+! THERMAL DIFFUSION EQUATION IN THE CASE OF SEA-ICE PACK.  ALSO TO
+! COMPUTE (PREPARE) THE MATRIX COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX
+! OF THE IMPLICIT TIME SCHEME.
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+      INTEGER K
+      INTEGER NSOIL
+
+      REAL AI(NSOLD)
+      REAL BI(NSOLD)
+      REAL CI(NSOLD)
+
+      REAL DDZ
+      REAL DDZ2
+      REAL DENOM
+      REAL DF1
+      REAL DTSDZ
+      REAL DTSDZ2
+      REAL HCPCT
+      REAL RHSTS(NSOIL)
+      REAL SSOIL
+      REAL STC(NSOIL)
+      REAL TBOT
+      REAL YY
+      REAL ZBOT
+      REAL ZSOIL(NSOIL)
+      REAL ZZ1
+
+      DATA TBOT /271.16/
+
+! ----------------------------------------------------------------------
+! SET A NOMINAL UNIVERSAL VALUE OF THE SEA-ICE SPECIFIC HEAT CAPACITY,
+! HCPCT = 1880.0*917.0.
+! ----------------------------------------------------------------------
+      PARAMETER(HCPCT = 1.72396E+6)
+
+! ----------------------------------------------------------------------
+! THE INPUT ARGUMENT DF1 IS A UNIVERSALLY CONSTANT VALUE OF SEA-ICE
+! THERMAL DIFFUSIVITY, SET IN ROUTINE SNOPAC AS DF1 = 2.2.
+! ----------------------------------------------------------------------
+! SET ICE PACK DEPTH.  USE TBOT AS ICE PACK LOWER BOUNDARY TEMPERATURE
+! (THAT OF UNFROZEN SEA WATER AT BOTTOM OF SEA ICE PACK).  ASSUME ICE
+! PACK IS OF N=NSOIL LAYERS SPANNING A UNIFORM CONSTANT ICE PACK
+! THICKNESS AS DEFINED BY ZSOIL(NSOIL) IN ROUTINE SFLX.
+! ----------------------------------------------------------------------
+      ZBOT = ZSOIL(NSOIL)
+
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER
+! ----------------------------------------------------------------------
+      DDZ = 1.0 / ( -0.5 * ZSOIL(2) )
+      AI(1) = 0.0
+      CI(1) = (DF1 * DDZ) / (ZSOIL(1) * HCPCT)
+      BI(1) = -CI(1) + DF1/(0.5 * ZSOIL(1) * ZSOIL(1) * HCPCT * ZZ1)
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT BTWN THE TOP AND 2ND SOIL LAYERS.
+! RECALC/ADJUST THE SOIL HEAT FLUX.  USE THE GRADIENT AND FLUX TO CALC
+! RHSTS FOR THE TOP SOIL LAYER.
+! ----------------------------------------------------------------------
+      DTSDZ = ( STC(1) - STC(2) ) / ( -0.5 * ZSOIL(2) )
+      SSOIL = DF1 * ( STC(1) - YY ) / ( 0.5 * ZSOIL(1) * ZZ1 )
+      RHSTS(1) = ( DF1 * DTSDZ - SSOIL ) / ( ZSOIL(1) * HCPCT )
+
+! ----------------------------------------------------------------------
+! INITIALIZE DDZ2
+! ----------------------------------------------------------------------
+      DDZ2 = 0.0
+
+! ----------------------------------------------------------------------
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS
+! ----------------------------------------------------------------------
+      DO K = 2,NSOIL
+        IF (K .NE. NSOIL) THEN
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER.
+! ----------------------------------------------------------------------
+          DENOM = 0.5 * ( ZSOIL(K-1) - ZSOIL(K+1) )
+          DTSDZ2 = ( STC(K) - STC(K+1) ) / DENOM
+
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT.
+! ----------------------------------------------------------------------
+          DDZ2 = 2. / (ZSOIL(K-1) - ZSOIL(K+1))
+          CI(K) = -DF1 * DDZ2 / ((ZSOIL(K-1) - ZSOIL(K)) * HCPCT)
+        ELSE
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THE LOWEST LAYER.
+! ----------------------------------------------------------------------
+          DTSDZ2 = (STC(K)-TBOT)/(.5 * (ZSOIL(K-1) + ZSOIL(K))-ZBOT)
+
+! ----------------------------------------------------------------------
+! SET MATRIX COEF, CI TO ZERO.
+! ----------------------------------------------------------------------
+          CI(K) = 0.
+        ENDIF
+
+! ----------------------------------------------------------------------
+! CALC RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT.
+! ----------------------------------------------------------------------
+        DENOM = ( ZSOIL(K) - ZSOIL(K-1) ) * HCPCT
+        RHSTS(K) = ( DF1 * DTSDZ2 - DF1 * DTSDZ ) / DENOM
+
+! ----------------------------------------------------------------------
+! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER.
+! ----------------------------------------------------------------------
+        AI(K) = - DF1 * DDZ / ((ZSOIL(K-1) - ZSOIL(K)) * HCPCT)
+        BI(K) = -(AI(K) + CI(K))
+
+! ----------------------------------------------------------------------
+! RESET VALUES OF DTSDZ AND DDZ FOR LOOP TO NEXT SOIL LYR.
+! ----------------------------------------------------------------------
+        DTSDZ = DTSDZ2
+        DDZ   = DDZ2
+
+      END DO
+! ----------------------------------------------------------------------
+! END SUBROUTINE HRTICE
+! ----------------------------------------------------------------------
+      END SUBROUTINE HRTICE
+
+      SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE HSTEP
+! ----------------------------------------------------------------------
+! CALCULATE/UPDATE THE SOIL TEMPERATURE FIELD.
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+      INTEGER K
+      INTEGER NSOIL
+
+      REAL AI(NSOLD)
+      REAL BI(NSOLD)
+      REAL CI(NSOLD)
+      REAL CIin(NSOLD)
+      REAL DT
+      REAL RHSTS(NSOIL)
+      REAL RHSTSin(NSOIL)
+      REAL STCIN(NSOIL)
+      REAL STCOUT(NSOIL)
+
+! ----------------------------------------------------------------------
+! CREATE FINITE DIFFERENCE VALUES FOR USE IN ROSR12 ROUTINE
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL
+        RHSTS(K) = RHSTS(K) * DT
+        AI(K) = AI(K) * DT
+        BI(K) = 1. + BI(K) * DT
+        CI(K) = CI(K) * DT
+      END DO
+
+! ----------------------------------------------------------------------
+! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL
+         RHSTSin(K) = RHSTS(K)
+      END DO
+      DO K = 1,NSOIL
+        CIin(K) = CI(K)
+      END DO
+
+! ----------------------------------------------------------------------
+! SOLVE THE TRI-DIAGONAL MATRIX EQUATION
+! ----------------------------------------------------------------------
+      CALL ROSR12(CI,AI,BI,CIin,RHSTSin,RHSTS,NSOIL)
+
+! ----------------------------------------------------------------------
+! CALC/UPDATE THE SOIL TEMPS USING MATRIX SOLUTION
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL
+        STCOUT(K) = STCIN(K) + CI(K)
+      END DO
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE HSTEP
+! ----------------------------------------------------------------------
+      END SUBROUTINE HSTEP
+
+      SUBROUTINE NOPAC(ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                  &
+     &                 SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,SHDFAC,        &
+     &                 SBETA,Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,       &
+     &                 STC,EPSCA,BEXP,PC,RCH,RR,CFACTR,                 &
+     &                 SH2O,SLOPE,KDT,FRZFACT,PSISAT,ZSOIL,             &
+     &                 DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2,           &
+     &                 RUNOFF3,EDIR,EC,ET,ETT,NROOT,ICE,RTDIS,          &
+     &                 QUARTZ,FXEXP,CSOIL,                              &
+     &                 BETA,DRIP,DEW,FLX1,FLX2,FLX3)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE NOPAC
+! ----------------------------------------------------------------------
+! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES AND UPDATE SOIL MOISTURE
+! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN NO SNOW PACK IS
+! PRESENT.
+! ----------------------------------------------------------------------
+      INTEGER ICE
+      INTEGER NROOT
+      INTEGER NSOIL
+
+      REAL BEXP
+      REAL BETA
+      REAL CFACTR
+      REAL CMC
+      REAL CMCMAX
+      REAL CP
+      REAL CSOIL
+      REAL DEW
+      REAL DF1
+      REAL DKSAT
+      REAL DRIP
+      REAL DT
+      REAL DWSAT
+      REAL EC
+      REAL EDIR
+      REAL EPSCA
+      REAL ETA
+      REAL ETA1
+      REAL ETP
+      REAL ETP1
+      REAL ET(NSOIL)
+      REAL ETT
+      REAL FDOWN
+      REAL F1
+      REAL FXEXP
+      REAL FLX1
+      REAL FLX2
+      REAL FLX3
+      REAL FRZFACT
+      REAL KDT
+      REAL PC
+      REAL PRCP
+      REAL PRCP1
+      REAL PSISAT
+      REAL Q2
+      REAL QUARTZ
+      REAL RCH
+      REAL RR
+      REAL RTDIS(NSOIL)
+      REAL RUNOFF1
+      REAL RUNOFF2
+      REAL RUNOFF3
+      REAL SSOIL
+      REAL SBETA
+      REAL SFCTMP
+      REAL SHDFAC
+      REAL SH2O(NSOIL)
+      REAL SIGMA
+      REAL SLOPE
+      REAL SMC(NSOIL)
+      REAL SMCDRY
+      REAL SMCMAX
+      REAL SMCREF
+      REAL SMCWLT
+      REAL STC(NSOIL)
+      REAL T1
+      REAL T24
+      REAL TBOT
+      REAL TH2
+      REAL YY
+      REAL YYNUM
+      REAL ZBOT
+      REAL ZSOIL(NSOIL)
+      REAL ZZ1
+
+      REAL EC1
+      REAL EDIR1
+      REAL ET1(NSOIL)
+      REAL ETT1
+
+      INTEGER K
+
+      PARAMETER(CP = 1004.5)
+      PARAMETER(SIGMA = 5.67E-8)
+
+! ----------------------------------------------------------------------
+! EXECUTABLE CODE BEGINS HERE:
+! CONVERT ETP FROM KG M-2 S-1 TO MS-1 AND INITIALIZE DEW.
+! ----------------------------------------------------------------------
+      PRCP1 = PRCP * 0.001
+      ETP1 = ETP * 0.001
+      DEW = 0.0
+
+      EDIR = 0.
+      EDIR1 = 0.
+      EC = 0.
+      EC1 = 0.
+      DO K = 1,NSOIL
+        ET(K) = 0.
+        ET1(K) = 0.
+      END DO
+      ETT = 0.
+      ETT1 = 0.
+
+      IF (ETP .GT. 0.0) THEN
+
+! ----------------------------------------------------------------------
+! CONVERT PRCP FROM 'KG M-2 S-1' TO 'M S-1'.
+! ----------------------------------------------------------------------
+           CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,                &
+     &                 SH2O,SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,          &
+     &                 SMCREF,SHDFAC,CMCMAX,                            &
+     &                 SMCDRY,CFACTR,                                   &
+     &                 EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP)
+           CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                    &
+     &                 SH2O,SLOPE,KDT,FRZFACT,                          &
+     &                 SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                  &
+     &                 SHDFAC,CMCMAX,                                   &
+     &                 RUNOFF1,RUNOFF2,RUNOFF3,                         &
+     &                 EDIR1,EC1,ET1,                                   &
+     &                 DRIP)
+
+! ----------------------------------------------------------------------
+!       CONVERT MODELED EVAPOTRANSPIRATION FM  M S-1  TO  KG M-2 S-1
+! ----------------------------------------------------------------------
+!        ETA = ETA1 * 1000.0
+
+! ----------------------------------------------------------------------
+!        EDIR = EDIR1 * 1000.0
+!        EC = EC1 * 1000.0
+!        ETT = ETT1 * 1000.0
+!        ET(1) = ET1(1) * 1000.0
+!        ET(2) = ET1(2) * 1000.0
+!        ET(3) = ET1(3) * 1000.0
+!        ET(4) = ET1(4) * 1000.0
+! ----------------------------------------------------------------------
+
+      ELSE
+
+! ----------------------------------------------------------------------
+! IF ETP < 0, ASSUME DEW FORMS (TRANSFORM ETP1 INTO DEW AND REINITIALIZE
+! ETP1 TO ZERO).
+! ----------------------------------------------------------------------
+        DEW = -ETP1
+!        ETP1 = 0.0
+
+! ----------------------------------------------------------------------
+! CONVERT PRCP FROM 'KG M-2 S-1' TO 'M S-1' AND ADD DEW AMOUNT.
+! ----------------------------------------------------------------------
+        PRCP1 = PRCP1 + DEW
+!
+!      CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,
+!     &            SH2O,SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,
+!     &            SMCREF,SHDFAC,CMCMAX,
+!     &            SMCDRY,CFACTR, 
+!     &            EDIR1,EC1,ET1,ETT,SFCTMP,Q2,NROOT,RTDIS,FXEXP)
+      CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                         &
+     &            SH2O,SLOPE,KDT,FRZFACT,                               &
+     &            SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                       &
+     &            SHDFAC,CMCMAX,                                        &
+     &            RUNOFF1,RUNOFF2,RUNOFF3,                              &
+     &            EDIR1,EC1,ET1,                                        &
+     &            DRIP)
+
+! ----------------------------------------------------------------------
+! CONVERT MODELED EVAPOTRANSPIRATION FROM 'M S-1' TO 'KG M-2 S-1'.
+! ----------------------------------------------------------------------
+!        ETA = ETA1 * 1000.0
+
+! ----------------------------------------------------------------------
+!        EDIR = EDIR1 * 1000.0
+!        EC = EC1 * 1000.0
+!        ETT = ETT1 * 1000.0
+!        ET(1) = ET1(1) * 1000.0
+!        ET(2) = ET1(2) * 1000.0
+!        ET(3) = ET1(3) * 1000.0
+!        ET(4) = ET1(4) * 1000.0
+! ----------------------------------------------------------------------
+
+      ENDIF
+
+! ----------------------------------------------------------------------
+!       CONVERT MODELED EVAPOTRANSPIRATION FM  M S-1  TO  KG M-2 S-1
+! ----------------------------------------------------------------------
+        ETA = ETA1 * 1000.0
+
+! ----------------------------------------------------------------------
+      EDIR = EDIR1 * 1000.0
+      EC = EC1 * 1000.0
+      DO K = 1,NSOIL
+        ET(K) = ET1(K) * 1000.0
+!        ET(1) = ET1(1) * 1000.0
+!        ET(2) = ET1(2) * 1000.0
+!        ET(3) = ET1(3) * 1000.0
+!        ET(4) = ET1(4) * 1000.0
+      ENDDO
+      ETT = ETT1 * 1000.0
+! ----------------------------------------------------------------------
+
+! ----------------------------------------------------------------------
+! BASED ON ETP AND E VALUES, DETERMINE BETA
+! ----------------------------------------------------------------------
+      IF ( ETP .LE. 0.0 ) THEN
+        BETA = 0.0
+        IF ( ETP .LT. 0.0 ) THEN
+          BETA = 1.0
+!          ETA = ETP
+        ENDIF
+      ELSE
+        BETA = ETA / ETP
+      ENDIF
+
+! ----------------------------------------------------------------------
+! GET SOIL THERMAL DIFFUXIVITY/CONDUCTIVITY FOR TOP SOIL LYR,
+! CALC. ADJUSTED TOP LYR SOIL TEMP AND ADJUSTED SOIL FLUX, THEN
+! CALL SHFLX TO COMPUTE/UPDATE SOIL HEAT FLUX AND SOIL TEMPS.
+! ----------------------------------------------------------------------
+      CALL TDFCND (DF1,SMC(1),QUARTZ,SMCMAX,SH2O(1))
+
+! ----------------------------------------------------------------------
+! VEGETATION GREENNESS FRACTION REDUCTION IN SUBSURFACE HEAT FLUX 
+! VIA REDUCTION FACTOR, WHICH IS CONVENIENT TO APPLY HERE TO THERMAL 
+! DIFFUSIVITY THAT IS LATER USED IN HRT TO COMPUTE SUB SFC HEAT FLUX
+! (SEE ADDITIONAL COMMENTS ON VEG EFFECT SUB-SFC HEAT FLX IN 
+! ROUTINE SFLX)
+! ----------------------------------------------------------------------
+      DF1 = DF1 * EXP(SBETA*SHDFAC)
+
+! ----------------------------------------------------------------------
+! COMPUTE INTERMEDIATE TERMS PASSED TO ROUTINE HRT (VIA ROUTINE 
+! SHFLX BELOW) FOR USE IN COMPUTING SUBSURFACE HEAT FLUX IN HRT
+! ----------------------------------------------------------------------
+      YYNUM = FDOWN - SIGMA * T24
+      YY = SFCTMP + (YYNUM/RCH+TH2-SFCTMP-BETA*EPSCA) / RR
+      ZZ1 = DF1 / ( -0.5 * ZSOIL(1) * RCH * RR ) + 1.0
+
+      CALL SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,        &
+     &            TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,ICE,         &
+     &            QUARTZ,CSOIL)
+
+! ----------------------------------------------------------------------
+! SET FLX1 AND FLX3 (SNOPACK PHASE CHANGE HEAT FLUXES) TO ZERO SINCE
+! THEY ARE NOT USED HERE IN SNOPAC.  FLX2 (FREEZING RAIN HEAT FLUX) WAS
+! SIMILARLY INITIALIZED IN THE PENMAN ROUTINE.
+! ----------------------------------------------------------------------
+      FLX1 = 0.0
+      FLX3 = 0.0
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE NOPAC
+! ----------------------------------------------------------------------
+      END SUBROUTINE NOPAC
+
+      SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, &
+     &                   Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA,       &
+     &                   DQSDT2,FLX2)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE PENMAN
+! ----------------------------------------------------------------------
+! CALCULATE POTENTIAL EVAPORATION FOR THE CURRENT POINT.  VARIOUS
+! PARTIAL SUMS/PRODUCTS ARE ALSO CALCULATED AND PASSED BACK TO THE
+! CALLING ROUTINE FOR LATER USE.
+! ----------------------------------------------------------------------
+      LOGICAL SNOWNG
+      LOGICAL FRZGRA
+
+      REAL A
+      REAL BETA
+      REAL CH
+      REAL CP
+      REAL CPH2O
+      REAL CPICE
+      REAL DELTA
+      REAL DQSDT2
+      REAL ELCP
+      REAL EPSCA
+      REAL ETP
+      REAL FDOWN
+      REAL FLX2
+      REAL FNET
+      REAL LSUBC
+      REAL LSUBF
+      REAL PRCP
+      REAL Q2
+      REAL Q2SAT
+      REAL R
+      REAL RAD
+      REAL RCH
+      REAL RHO
+      REAL RR
+      REAL SSOIL
+      REAL SFCPRS
+      REAL SFCTMP
+      REAL SIGMA
+      REAL T24
+      REAL T2V
+      REAL TH2
+
+      PARAMETER(CP = 1004.6)
+      PARAMETER(CPH2O = 4.218E+3)
+      PARAMETER(CPICE = 2.106E+3)
+      PARAMETER(R = 287.04)
+      PARAMETER(ELCP = 2.4888E+3)
+      PARAMETER(LSUBF = 3.335E+5)
+      PARAMETER(LSUBC = 2.501000E+6)
+      PARAMETER(SIGMA = 5.67E-8)
+
+! ----------------------------------------------------------------------
+! EXECUTABLE CODE BEGINS HERE:
+! ----------------------------------------------------------------------
+      FLX2 = 0.0
+
+! ----------------------------------------------------------------------
+! PREPARE PARTIAL QUANTITIES FOR PENMAN EQUATION.
+! ----------------------------------------------------------------------
+      DELTA = ELCP * DQSDT2
+      T24 = SFCTMP * SFCTMP * SFCTMP * SFCTMP
+      RR = T24 * 6.48E-8 /(SFCPRS * CH) + 1.0
+      RHO = SFCPRS / (R * T2V)
+      RCH = RHO * CP * CH
+
+! ----------------------------------------------------------------------
+! ADJUST THE PARTIAL SUMS / PRODUCTS WITH THE LATENT HEAT
+! EFFECTS CAUSED BY FALLING PRECIPITATION.
+! ----------------------------------------------------------------------
+      IF (.NOT. SNOWNG) THEN
+        IF (PRCP .GT. 0.0) RR = RR + CPH2O*PRCP/RCH
+      ELSE
+        RR = RR + CPICE*PRCP/RCH
+      ENDIF
+
+      FNET = FDOWN - SIGMA*T24 - SSOIL
+
+! ----------------------------------------------------------------------
+! INCLUDE THE LATENT HEAT EFFECTS OF FRZNG RAIN CONVERTING TO ICE ON
+! IMPACT IN THE CALCULATION OF FLX2 AND FNET.
+! ----------------------------------------------------------------------
+      IF (FRZGRA) THEN
+        FLX2 = -LSUBF * PRCP
+        FNET = FNET - FLX2
+      ENDIF
+
+! ----------------------------------------------------------------------
+! FINISH PENMAN EQUATION CALCULATIONS.
+! ----------------------------------------------------------------------
+      RAD = FNET/RCH + TH2 - SFCTMP
+      A = ELCP * (Q2SAT - Q2)
+      EPSCA = (A*RR + RAD*DELTA) / (DELTA + RR)
+      ETP = EPSCA * RCH / LSUBC
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE PENMAN
+! ----------------------------------------------------------------------
+      END SUBROUTINE PENMAN
+
+      SUBROUTINE REDPRM (                                               &
+     &                   VEGTYP,SOILTYP,SLOPETYP,                       &
+     &                   CFACTR,CMCMAX,RSMAX,TOPT,REFKDT,KDT,SBETA,     &
+     &                   SHDFAC,RSMIN,RGL,HS,ZBOT,FRZX,PSISAT,SLOPE,    &
+     &                   SNUP,SALP,BEXP,DKSAT,DWSAT,                    &
+     &                   SMCMAX,SMCWLT,SMCREF,                          &
+     &                   SMCDRY,F1,QUARTZ,FXEXP,RTDIS,SLDPTH,ZSOIL,     &
+     &                   NROOT,NSOIL,Z0,CZIL,LAI,CSOIL,PTU)
+
+      IMPLICIT NONE
+! ----------------------------------------------------------------------
+! SUBROUTINE REDPRM
+! ----------------------------------------------------------------------
+! INTERNALLY SET (DEFAULT VALUESS), OR OPTIONALLY READ-IN VIA NAMELIST
+! I/O, ALL SOIL AND VEGETATION PARAMETERS REQUIRED FOR THE EXECUSION OF
+! THE NOAH LSM.
+!
+! OPTIONAL NON-DEFAULT PARAMETERS CAN BE READ IN, ACCOMMODATING UP TO 30
+! SOIL, VEG, OR SLOPE CLASSES, IF THE DEFAULT MAX NUMBER OF SOIL, VEG,
+! AND/OR SLOPE TYPES IS RESET.
+!
+! FUTURE UPGRADES OF ROUTINE REDPRM MUST EXPAND TO INCORPORATE SOME OF
+! THE EMPIRICAL PARAMETERS OF THE FROZEN SOIL AND SNOWPACK PHYSICS (SUCH
+! AS IN ROUTINES FRH2O, SNOWPACK, AND SNOW_NEW) NOT YET SET IN THIS
+! REDPRM ROUTINE, BUT RATHER SET IN LOWER LEVEL SUBROUTINES.
+!
+! SET MAXIMUM NUMBER OF SOIL-, VEG-, AND SLOPETYP IN DATA STATEMENT.
+! ----------------------------------------------------------------------
+      INTEGER MAX_SLOPETYP
+      INTEGER MAX_SOILTYP
+      INTEGER MAX_VEGTYP
+
+      PARAMETER(MAX_SLOPETYP = 30)
+      PARAMETER(MAX_SOILTYP = 30)
+      PARAMETER(MAX_VEGTYP = 30)
+
+! ----------------------------------------------------------------------
+! NUMBER OF DEFINED SOIL-, VEG-, AND SLOPETYPS USED.
+! ----------------------------------------------------------------------
+      INTEGER DEFINED_VEG
+      INTEGER DEFINED_SOIL
+      INTEGER DEFINED_SLOPE
+
+      DATA DEFINED_VEG/27/
+      DATA DEFINED_SOIL/19/
+      DATA DEFINED_SLOPE/9/
+
+! ----------------------------------------------------------------------
+!  SET-UP SOIL PARAMETERS FOR GIVEN SOIL TYPE
+!  INPUT: SOLTYP: SOIL TYPE (INTEGER INDEX)
+!  OUTPUT: SOIL PARAMETERS:
+!    MAXSMC: MAX SOIL MOISTURE CONTENT (POROSITY)
+!    REFSMC: REFERENCE SOIL MOISTURE (ONSET OF SOIL MOISTURE
+!            STRESS IN TRANSPIRATION)
+!    WLTSMC: WILTING PT SOIL MOISTURE CONTENTS
+!    DRYSMC: AIR DRY SOIL MOIST CONTENT LIMITS
+!    SATPSI: SATURATED SOIL POTENTIAL
+!    SATDK:  SATURATED SOIL HYDRAULIC CONDUCTIVITY
+!    BB:     THE 'B' PARAMETER
+!    SATDW:  SATURATED SOIL DIFFUSIVITY
+!    F11:    USED TO COMPUTE SOIL DIFFUSIVITY/CONDUCTIVITY
+!    QUARTZ:  SOIL QUARTZ CONTENT
+! ----------------------------------------------------------------------
+! SOIL  STATSGO
+! TYPE  CLASS
+! ----  -------
+!   1   SAND
+!   2   LOAMY SAND
+!   3   SANDY LOAM
+!   4   SILT LOAM
+!   5   SILT
+!   6   LOAM
+!   7   SANDY CLAY LOAM
+!   8   SILTY CLAY LOAM
+!   9   CLAY LOAM
+!  10   SANDY CLAY
+!  11   SILTY CLAY
+!  12   CLAY
+!  13   ORGANIC MATERIAL
+!  14   WATER
+!  15   BEDROCK
+!  16   OTHER(land-ice)
+!  17   PLAYA
+!  18   LAVA
+!  19   WHITE SAND
+! ----------------------------------------------------------------------
+
+      REAL BB(MAX_SOILTYP)
+      REAL DRYSMC(MAX_SOILTYP)
+      REAL F11(MAX_SOILTYP)
+      REAL MAXSMC(MAX_SOILTYP)
+      REAL REFSMC(MAX_SOILTYP)
+      REAL SATPSI(MAX_SOILTYP)
+      REAL SATDK(MAX_SOILTYP)
+      REAL SATDW(MAX_SOILTYP)
+      REAL WLTSMC(MAX_SOILTYP)
+      REAL QTZ(MAX_SOILTYP)
+
+      REAL BEXP
+      REAL DKSAT
+      REAL DWSAT
+      REAL F1
+      REAL PTU
+      REAL QUARTZ
+      REAL REFSMC1
+      REAL SMCDRY
+      REAL SMCMAX
+      REAL SMCREF
+      REAL SMCWLT
+      REAL WLTSMC1
+
+! ----------------------------------------------------------------------
+! SOIL TEXTURE-RELATED ARRAYS.
+! ----------------------------------------------------------------------
+      DATA MAXSMC/0.395, 0.421, 0.434, 0.476, 0.476, 0.439,             &
+     &            0.404, 0.464, 0.465, 0.406, 0.468, 0.457,             &
+     &            0.464, 0.464, 0.200, 0.421, 0.457, 0.200,             &
+     &            0.395, 0.000, 0.000, 0.000, 0.000, 0.000,             &
+     &            0.000, 0.000, 0.000, 0.000, 0.000, 0.000/
+! ----------------------------------------------------------------------
+      DATA SATPSI/0.0350, 0.0363, 0.1413, 0.7586, 0.7586, 0.3548,       &
+     &            0.1349, 0.6166, 0.2630, 0.0977, 0.3236, 0.4677,       &
+     &            0.3548, 0.3548, 0.0350, 0.0363, 0.4677, 0.0350,       &
+     &            0.0350, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000,       &
+     &            0.000,  0.0000, 0.0000, 0.0000, 0.0000, 0.0000/
+! ----------------------------------------------------------------------
+      DATA SATDK /1.7600E-4, 1.4078E-5, 5.2304E-6, 2.8089E-6, 2.8089E-6,&
+     &            3.3770E-6, 4.4518E-6, 2.0348E-6, 2.4464E-6, 7.2199E-6,&
+     &            1.3444E-6, 9.7394E-7, 3.3770E-6, 3.3770E-6, 1.4078E-5,&
+     &            1.4078E-5, 9.7394E-7, 1.4078E-5, 1.7600E-4,       0.0,&
+     &                  0.0,       0.0,       0.0,       0.0,       0.0,&
+     &                  0.0,       0.0,       0.0,       0.0,       0.0/
+! ----------------------------------------------------------------------
+      DATA BB    /4.05,  4.26,  4.74,  5.33,  5.33,  5.25,              &
+     &            6.77,  8.72,  8.17, 10.73, 10.39, 11.55,              &
+     &            5.25,  5.25,  4.05,  4.26, 11.55,  4.05,              &
+     &            4.05,  0.00,  0.00,  0.00,  0.00,  0.00,              &
+     &            0.00,  0.00,  0.00,  0.00,  0.00,  0.00/
+! ----------------------------------------------------------------------
+      DATA QTZ   /0.92, 0.82, 0.60, 0.25, 0.10, 0.40,                   &
+     &            0.60, 0.10, 0.35, 0.52, 0.10, 0.25,                   &
+     &            0.05, 0.05, 0.07, 0.25, 0.60, 0.52,                   &
+     &            0.92, 0.00, 0.00, 0.00, 0.00, 0.00,                   &
+     &            0.00, 0.00, 0.00, 0.00, 0.00, 0.00/
+
+! ----------------------------------------------------------------------
+! THE FOLLOWING 5 PARAMETERS ARE DERIVED LATER IN REDPRM.F FROM THE SOIL
+! DATA, AND ARE JUST GIVEN HERE FOR REFERENCE AND TO FORCE STATIC
+! STORAGE ALLOCATION. -DAG LOHMANN, FEB. 2001
+! ----------------------------------------------------------------------
+! !!!!!!!!!!!!!! The following values in the table are NOT used
+! !!!!!!!!!!!!!! and are just given for reference
+      DATA REFSMC/0.196, 0.248, 0.282, 0.332, 0.332, 0.301,             &
+     &            0.293, 0.368, 0.361, 0.320, 0.388, 0.389,             &
+     &            0.319, 0.000, 0.116, 0.248, 0.389, 0.116,             &
+     &            0.196, 0.000, 0.000, 0.000, 0.000, 0.000,             &
+     &            0.000, 0.000, 0.000, 0.000, 0.000, 0.000/
+! !!!!!!!!!!!!!! The following values in the table are NOT used
+! !!!!!!!!!!!!!! and are just given for reference
+      DATA WLTSMC/0.023, 0.028, 0.047, 0.084, 0.084, 0.066,             &
+     &            0.069, 0.120, 0.103, 0.100, 0.126, 0.135,             &
+     &            0.069, 0.000, 0.012, 0.028, 0.135, 0.012,             &
+     &            0.023, 0.000, 0.000, 0.000, 0.000, 0.000,             &
+     &            0.000, 0.000, 0.000, 0.000, 0.000, 0.000/
+! !!!!!!!!!!!!!! The following values in the table are NOT used
+! !!!!!!!!!!!!!! and are just given for reference
+      DATA DRYSMC/0.023, 0.028, 0.047, 0.084, 0.084, 0.066,             &
+     &            0.069, 0.120, 0.103, 0.100, 0.126, 0.135,             &
+     &            0.069, 0.000, 0.012, 0.028, 0.135, 0.012,             &
+     &            0.023, 0.000, 0.000, 0.000, 0.000, 0.000,             &
+     &            0.000, 0.000, 0.000, 0.000, 0.000, 0.000/
+
+! !!!!!!!!!!!!!! The following values in the table are NOT used
+! !!!!!!!!!!!!!! and are just given for reference
+      DATA SATDW /0.632E-4, 0.517E-5, 0.807E-5, 0.239E-4, 0.239E-4,     &
+     &            0.143E-4, 0.101E-4, 0.236E-4, 0.113E-4, 0.186E-4,     &
+     &            0.966E-5, 0.115E-4, 0.136E-4,      0.0, 0.998E-5,     &
+     &            0.517E-5, 0.115E-4, 0.998E-5, 0.632E-4,      0.0,     &
+     &                 0.0,      0.0,      0.0,      0.0,      0.0,     &
+     &                 0.0,      0.0,      0.0,      0.0,      0.0/
+! !!!!!!!!!!!!!! The following values in the table are NOT used
+! !!!!!!!!!!!!!! and are just given for reference
+      DATA F11  /-1.090, -1.041, -0.568,  0.162,  0.162, -0.327,        &
+     &           -1.535, -1.118, -1.297, -3.211, -1.916, -2.258,        &
+     &           -0.201,  0.000, -2.287, -1.041, -2.258, -2.287,        &
+     &           -1.090,  0.000,  0.000,  0.000,  0.000,  0.000,        &
+     &            0.000,  0.000,  0.000,  0.000,  0.000,  0.000/
+
+! ----------------------------------------------------------------------
+! SET-UP VEGETATION PARAMETERS FOR A GIVEN VEGETAION TYPE:
+! INPUT: VEGTYP = VEGETATION TYPE (INTEGER INDEX)
+! OUPUT: VEGETATION PARAMETERS
+!   SHDFAC: VEGETATION GREENNESS FRACTION
+!   RSMIN:  MIMIMUM STOMATAL RESISTANCE
+!   RGL:    PARAMETER USED IN SOLAR RAD TERM OF
+!           CANOPY RESISTANCE FUNCTION
+!   HS:     PARAMETER USED IN VAPOR PRESSURE DEFICIT TERM OF
+!           CANOPY RESISTANCE FUNCTION
+!   SNUP:   THRESHOLD SNOW DEPTH (IN WATER EQUIVALENT M) THAT
+!           IMPLIES 100% SNOW COVER
+! ----------------------------------------------------------------------
+! CLASS USGS-WRF VEGETATION/SURFACE TYPE
+!   1   Urban and Built-Up Land
+!   2   Dryland Cropland and Pasture
+!   3   Irrigated Cropland and Pasture
+!   4   Mixed Dryland/Irrigated Cropland and Pasture
+!   5   Cropland/Grassland Mosaic
+!   6   Cropland/Woodland Mosaic
+!   7   Grassland
+!   8   Shrubland
+!   9   Mixed Shrubland/Grassland
+!  10   Savanna
+!  11   Deciduous Broadleaf Forest
+!  12   Deciduous Needleleaf Forest
+!  13   Evergreen Broadleaf Forest
+!  14   Evergreen Needleleaf Forest
+!  15   Mixed Forest
+!  16   Water Bodies
+!  17   Herbaceous Wetland
+!  18   Wooded Wetland
+!  19   Barren or Sparsely Vegetated
+!  20   Herbaceous Tundra
+!  21   Wooded Tundra
+!  22   Mixed Tundra
+!  23   Bare Ground Tundra
+!  24   Snow or Ice
+!  25   Playa
+!  26   Lava
+!  27   White Sand
+! ----------------------------------------------------------------------
+
+      INTEGER NROOT
+      INTEGER NROOT_DATA(MAX_VEGTYP)
+
+      REAL FRZFACT
+      REAL HS
+      REAL HSTBL(MAX_VEGTYP)
+      REAL LAI
+      REAL LAI_DATA(MAX_VEGTYP)
+      REAL PSISAT
+      REAL RSMIN
+      REAL RGL
+      REAL RGLTBL(MAX_VEGTYP)
+      REAL RSMTBL(MAX_VEGTYP)
+      REAL SHDFAC
+      REAL SNUP
+      REAL SNUPX(MAX_VEGTYP)
+      REAL Z0
+      REAL Z0_DATA(MAX_VEGTYP)
+
+! ----------------------------------------------------------------------
+! VEGETATION CLASS-RELATED ARRAYS
+! ----------------------------------------------------------------------
+!      DATA NROOT_DATA /2,3,3,3,3,3,3,3,3,3,
+!     &                 4,4,4,4,4,2,2,2,2,3,
+!     &                 3,3,2,2,2,2,2,0,0,0/
+      DATA NROOT_DATA /1,3,3,3,3,3,3,3,3,3,                             &
+     &  	       4,4,4,4,4,0,2,2,1,3,                             &
+     &  	       3,3,2,1,1,1,1,0,0,0/
+      DATA RSMTBL /200.0,  70.0,  70.0,  70.0,  70.0,  70.0,            &
+     &              70.0, 300.0, 170.0,  70.0, 100.0, 150.0,            &
+     &             150.0, 125.0, 125.0, 100.0,  40.0, 100.0,            &
+     &             300.0, 150.0, 150.0, 150.0, 200.0, 200.0,            &
+     &              40.0, 100.0, 300.0,   0.0,   0.0,   0.0/
+      DATA RGLTBL /100.0, 100.0, 100.0, 100.0, 100.0,  65.0,            &
+     &             100.0, 100.0, 100.0,  65.0,  30.0,  30.0,            &
+     &              30.0,  30.0,  30.0,  30.0, 100.0,  30.0,            &
+     &             100.0, 100.0, 100.0, 100.0, 100.0, 100.0,            &
+     &             100.0, 100.0, 100.0,   0.0,   0.0,   0.0/
+      DATA HSTBL /42.00, 36.25, 36.25, 36.25, 36.25, 44.14,             &
+     &            36.35, 42.00, 39.18, 54.53, 54.53, 47.35,             &
+     &            41.69, 47.35, 51.93, 51.75, 60.00, 51.93,             &
+     &            42.00, 42.00, 42.00, 42.00, 42.00, 42.00,             &
+     &            36.25, 42.00, 42.00,  0.00,  0.00,  0.00/
+      DATA SNUPX /0.020, 0.020, 0.020, 0.020, 0.020, 0.020,             &
+     &            0.020, 0.020, 0.020, 0.040, 0.040, 0.040,             &
+     &            0.040, 0.040, 0.040, 0.010, 0.013, 0.020,             &
+     &            0.013, 0.020, 0.020, 0.020, 0.020, 0.013,             &
+     &            0.013, 0.013, 0.013, 0.000, 0.000, 0.000/
+      DATA Z0_DATA / 1.00,  0.07,  0.07,  0.07,  0.07,  0.15,           &
+     &               0.08,  0.03,  0.05,  0.86,  0.80,  0.85,           &
+     &               2.65,  1.09,  0.80, 0.001,  0.04,  0.05,           &
+     &               0.01,  0.04,  0.06,  0.05,  0.03, 0.001,           &
+     &               0.01,  0.15,  0.01,  0.00,  0.00,  0.00/
+      DATA LAI_DATA /4.0, 4.0, 4.0, 4.0, 4.0, 4.0,                      &
+     &               4.0, 4.0, 4.0, 4.0, 4.0, 4.0,                      &
+     &               4.0, 4.0, 4.0, 4.0, 4.0, 4.0,                      &
+     &               4.0, 4.0, 4.0, 4.0, 4.0, 4.0,                      &
+     &               4.0, 4.0, 4.0, 0.0, 0.0, 0.0/
+
+! ----------------------------------------------------------------------
+! CLASS PARAMETER 'SLOPETYP' WAS INCLUDED TO ESTIMATE LINEAR RESERVOIR
+! COEFFICIENT 'SLOPE' TO THE BASEFLOW RUNOFF OUT OF THE BOTTOM LAYER.
+! LOWEST CLASS (SLOPETYP=0) MEANS HIGHEST SLOPE PARAMETER = 1.
+! DEFINITION OF SLOPETYP FROM 'ZOBLER' SLOPE TYPE:
+! SLOPE CLASS  PERCENT SLOPE
+! 1            0-8
+! 2            8-30
+! 3            > 30
+! 4            0-30
+! 5            0-8 & > 30
+! 6            8-30 & > 30
+! 7            0-8, 8-30, > 30
+! 9            GLACIAL ICE
+! BLANK        OCEAN/SEA
+! ----------------------------------------------------------------------
+! NOTE:
+! CLASS 9 FROM 'ZOBLER' FILE SHOULD BE REPLACED BY 8 AND 'BLANK' 9
+! ----------------------------------------------------------------------
+      REAL SLOPE
+      REAL SLOPE_DATA(MAX_SLOPETYP)
+
+      DATA SLOPE_DATA /0.1,  0.6, 1.0, 0.35, 0.55, 0.8,                 &
+     &                 0.63, 0.0, 0.0, 0.0,  0.0,  0.0,                 &
+     &                 0.0 , 0.0, 0.0, 0.0,  0.0,  0.0,                 &
+     &                 0.0 , 0.0, 0.0, 0.0,  0.0,  0.0,                 &
+     &                 0.0 , 0.0, 0.0, 0.0,  0.0,  0.0/
+
+! ----------------------------------------------------------------------
+! SET NAMELIST FILE NAME
+! ----------------------------------------------------------------------
+      CHARACTER*50 NAMELIST_NAME
+
+! ----------------------------------------------------------------------
+! SET UNIVERSAL PARAMETERS (NOT DEPENDENT ON SOIL, VEG, SLOPE TYPE)
+! ----------------------------------------------------------------------
+      INTEGER I
+      INTEGER NSOIL
+      INTEGER SLOPETYP
+      INTEGER SOILTYP
+      INTEGER VEGTYP
+
+      INTEGER BARE
+!      DATA BARE /11/
+      DATA BARE /19/
+
+      LOGICAL LPARAM
+      DATA LPARAM /.TRUE./
+
+      LOGICAL LFIRST
+      DATA LFIRST /.TRUE./
+
+! ----------------------------------------------------------------------
+! PARAMETER USED TO CALCULATE ROUGHNESS LENGTH OF HEAT.
+! ----------------------------------------------------------------------
+      REAL CZIL
+      REAL CZIL_DATA
+!   changed in version 2.6 June 2nd 2003
+!      DATA CZIL_DATA /0.2/
+      DATA CZIL_DATA /0.1/
+
+! ----------------------------------------------------------------------
+! PARAMETER USED TO CALUCULATE VEGETATION EFFECT ON SOIL HEAT FLUX.
+! ----------------------------------------------------------------------
+      REAL SBETA
+      REAL SBETA_DATA
+      DATA SBETA_DATA /-2.0/
+
+! ----------------------------------------------------------------------
+! BARE SOIL EVAPORATION EXPONENT USED IN DEVAP.
+! ----------------------------------------------------------------------
+      REAL FXEXP
+      REAL FXEXP_DATA
+      DATA FXEXP_DATA /2.0/
+
+! ----------------------------------------------------------------------
+! SOIL HEAT CAPACITY [J M-3 K-1]
+! ----------------------------------------------------------------------
+      REAL CSOIL
+      REAL CSOIL_DATA
+!      DATA CSOIL_DATA /1.26E+6/
+      DATA CSOIL_DATA /2.00E+6/
+
+! ----------------------------------------------------------------------
+! SPECIFY SNOW DISTRIBUTION SHAPE PARAMETER SALP - SHAPE PARAMETER OF
+! DISTRIBUTION FUNCTION OF SNOW COVER. FROM ANDERSON'S DATA (HYDRO-17)
+! BEST FIT IS WHEN SALP = 2.6
+! ----------------------------------------------------------------------
+      REAL SALP
+      REAL SALP_DATA
+!     changed for version 2.6 June 2nd 2003
+!      DATA SALP_DATA /2.6/
+      DATA SALP_DATA /4.0/
+
+! ----------------------------------------------------------------------
+! KDT IS DEFINED BY REFERENCE REFKDT AND DKSAT; REFDK=2.E-6 IS THE SAT.
+! DK. VALUE FOR THE SOIL TYPE 2
+! ----------------------------------------------------------------------
+      REAL REFDK
+      REAL REFDK_DATA
+      DATA REFDK_DATA /2.0E-6/
+
+      REAL REFKDT
+      REAL REFKDT_DATA
+      DATA REFKDT_DATA /3.0/
+
+      REAL FRZX
+      REAL KDT
+
+! ----------------------------------------------------------------------
+! FROZEN GROUND PARAMETER, FRZK, DEFINITION: ICE CONTENT THRESHOLD ABOVE
+! WHICH FROZEN SOIL IS IMPERMEABLE REFERENCE VALUE OF THIS PARAMETER FOR
+! THE LIGHT CLAY SOIL (TYPE=3) FRZK = 0.15 M.
+! ----------------------------------------------------------------------
+      REAL FRZK
+      REAL FRZK_DATA
+      DATA FRZK_DATA /0.15/
+
+      REAL RTDIS(NSOIL)
+      REAL SLDPTH(NSOIL)
+      REAL ZSOIL(NSOIL)
+
+! ----------------------------------------------------------------------
+! SET TWO CANOPY WATER PARAMETERS.
+! ----------------------------------------------------------------------
+      REAL CFACTR
+      REAL CFACTR_DATA
+      DATA CFACTR_DATA /0.5/
+
+      REAL CMCMAX
+      REAL CMCMAX_DATA
+      DATA CMCMAX_DATA /0.5E-3/
+
+! ----------------------------------------------------------------------
+! SET MAX. STOMATAL RESISTANCE.
+! ----------------------------------------------------------------------
+      REAL RSMAX
+      REAL RSMAX_DATA
+      DATA RSMAX_DATA /5000.0/
+
+! ----------------------------------------------------------------------
+! SET OPTIMUM TRANSPIRATION AIR TEMPERATURE.
+! ----------------------------------------------------------------------
+      REAL TOPT
+      REAL TOPT_DATA
+      DATA TOPT_DATA /298.0/
+
+! ----------------------------------------------------------------------
+! SPECIFY DEPTH[M] OF LOWER BOUNDARY SOIL TEMPERATURE.
+! ----------------------------------------------------------------------
+      REAL ZBOT
+      REAL ZBOT_DATA
+!     changed for version 2.5.2
+!      DATA ZBOT_DATA /-3.0/
+      DATA ZBOT_DATA /-8.0/
+
+! ----------------------------------------------------------------------
+! SET TWO SOIL MOISTURE WILT, SOIL MOISTURE REFERENCE PARAMETERS
+! ----------------------------------------------------------------------
+      REAL SMLOW
+      REAL SMLOW_DATA
+      DATA SMLOW_DATA /0.5/
+
+      REAL SMHIGH
+      REAL SMHIGH_DATA
+!     changed in 2.6 from 3 to 6 on June 2nd 2003
+      DATA SMHIGH_DATA /3.0/
+!     DATA SMHIGH_DATA /6.0/
+
+! ----------------------------------------------------------------------
+! NAMELIST DEFINITION:
+! ----------------------------------------------------------------------
+      NAMELIST /SOIL_VEG/ SLOPE_DATA, RSMTBL, RGLTBL, HSTBL, SNUPX,     &
+     &  BB, DRYSMC, F11, MAXSMC, REFSMC, SATPSI, SATDK, SATDW,          &
+     &  WLTSMC, QTZ, LPARAM, ZBOT_DATA, SALP_DATA, CFACTR_DATA,         &
+     &  CMCMAX_DATA, SBETA_DATA, RSMAX_DATA, TOPT_DATA,                 &
+     &  REFDK_DATA, FRZK_DATA, BARE, DEFINED_VEG, DEFINED_SOIL,         &
+     &  DEFINED_SLOPE, FXEXP_DATA, NROOT_DATA, REFKDT_DATA, Z0_DATA,    &
+     &  CZIL_DATA, LAI_DATA, CSOIL_DATA
+
+! ----------------------------------------------------------------------
+! READ NAMELIST FILE TO OVERRIDE DEFAULT PARAMETERS ONLY ONCE.
+! NAMELIST_NAME must be 50 characters or less.
+! ----------------------------------------------------------------------
+      IF (LFIRST) THEN
+!        WRITE(*,*) 'READ NAMELIST'
+!        OPEN(58, FILE = 'namelist_filename.txt')
+!         READ(58,'(A)') NAMELIST_NAME
+!         CLOSE(58)
+!         WRITE(*,*) 'Namelist Filename is ', NAMELIST_NAME
+!         OPEN(59, FILE = NAMELIST_NAME)
+! 50      CONTINUE
+!         READ(59, SOIL_VEG, END=100)
+!         IF (LPARAM) GOTO 50
+! 100     CONTINUE
+!         CLOSE(59)
+!         WRITE(*,NML=SOIL_VEG)
+         LFIRST = .FALSE.
+         IF (DEFINED_SOIL .GT. MAX_SOILTYP) THEN
+            WRITE(*,*) 'Warning: DEFINED_SOIL too large in namelist'
+            STOP 222
+         ENDIF
+         IF (DEFINED_VEG .GT. MAX_VEGTYP) THEN
+            WRITE(*,*) 'Warning: DEFINED_VEG too large in namelist'
+            STOP 222
+         ENDIF
+         IF (DEFINED_SLOPE .GT. MAX_SLOPETYP) THEN
+            WRITE(*,*) 'Warning: DEFINED_SLOPE too large in namelist'
+            STOP 222
+         ENDIF
+         
+         SMLOW = SMLOW_DATA
+         SMHIGH = SMHIGH_DATA
+         
+         DO I = 1,DEFINED_SOIL
+            SATDW(I)  = BB(I)*SATDK(I)*(SATPSI(I)/MAXSMC(I))
+            F11(I) = ALOG10(SATPSI(I)) + BB(I)*ALOG10(MAXSMC(I)) + 2.0
+            REFSMC1 = MAXSMC(I)*(5.79E-9/SATDK(I))                      &
+     &           **(1.0/(2.0*BB(I)+3.0))
+            REFSMC(I) = REFSMC1 + (MAXSMC(I)-REFSMC1) / SMHIGH
+            WLTSMC1 = MAXSMC(I) * (200.0/SATPSI(I))**(-1.0/BB(I))
+            WLTSMC(I) = WLTSMC1 - SMLOW * WLTSMC1
+            
+! ----------------------------------------------------------------------
+! CURRENT VERSION DRYSMC VALUES THAT EQUATE TO WLTSMC.
+! FUTURE VERSION COULD LET DRYSMC BE INDEPENDENTLY SET VIA NAMELIST.
+! ----------------------------------------------------------------------
+            DRYSMC(I) = WLTSMC(I)
+         END DO
+         
+! ----------------------------------------------------------------------
+! END LFIRST BLOCK
+! ----------------------------------------------------------------------
+      ENDIF
+      
+      IF (SOILTYP .GT. DEFINED_SOIL) THEN
+        WRITE(*,*) 'Warning: too many soil types'
+        STOP 333
+      ENDIF
+      IF (VEGTYP .GT. DEFINED_VEG) THEN
+        WRITE(*,*) 'Warning: too many veg types'
+        STOP 333
+      ENDIF
+      IF (SLOPETYP .GT. DEFINED_SLOPE) THEN
+        WRITE(*,*) 'Warning: too many slope types'
+        STOP 333
+      ENDIF
+
+! ----------------------------------------------------------------------
+! SET-UP UNIVERSAL PARAMETERS (NOT DEPENDENT ON SOILTYP, VEGTYP OR
+! SLOPETYP)
+! ----------------------------------------------------------------------
+      ZBOT = ZBOT_DATA
+      SALP = SALP_DATA
+      CFACTR = CFACTR_DATA
+      CMCMAX = CMCMAX_DATA
+      SBETA = SBETA_DATA
+      RSMAX = RSMAX_DATA
+      TOPT = TOPT_DATA
+      REFDK = REFDK_DATA
+      FRZK = FRZK_DATA
+      FXEXP = FXEXP_DATA
+      REFKDT = REFKDT_DATA
+      CZIL = CZIL_DATA
+      CSOIL = CSOIL_DATA
+
+! ----------------------------------------------------------------------
+!  SET-UP SOIL PARAMETERS
+! ----------------------------------------------------------------------
+      BEXP = BB(SOILTYP)
+      DKSAT = SATDK(SOILTYP)
+      DWSAT = SATDW(SOILTYP)
+      F1 = F11(SOILTYP)
+      KDT = REFKDT * DKSAT/REFDK
+      PSISAT = SATPSI(SOILTYP)
+      QUARTZ = QTZ(SOILTYP)
+      SMCDRY = DRYSMC(SOILTYP)
+      SMCMAX = MAXSMC(SOILTYP)
+      SMCREF = REFSMC(SOILTYP)
+      SMCWLT = WLTSMC(SOILTYP)
+      FRZFACT = (SMCMAX / SMCREF) * (0.412 / 0.468)
+
+! ----------------------------------------------------------------------
+! TO ADJUST FRZK PARAMETER TO ACTUAL SOIL TYPE: FRZK * FRZFACT
+! ----------------------------------------------------------------------
+      FRZX = FRZK * FRZFACT
+
+! ----------------------------------------------------------------------
+! SET-UP VEGETATION PARAMETERS
+! ----------------------------------------------------------------------
+      NROOT = NROOT_DATA(VEGTYP)
+      SNUP = SNUPX(VEGTYP)
+      RSMIN = RSMTBL(VEGTYP)
+      RGL = RGLTBL(VEGTYP)
+      HS = HSTBL(VEGTYP)
+      Z0 = Z0_DATA(VEGTYP)
+      LAI = LAI_DATA(VEGTYP)
+      IF (VEGTYP .EQ. BARE) SHDFAC = 0.0
+
+      IF (NROOT .GT. NSOIL) THEN
+        WRITE(*,*) 'Warning: too many root layers'
+        STOP 333
+      ENDIF
+
+! ----------------------------------------------------------------------
+! CALCULATE ROOT DISTRIBUTION.  PRESENT VERSION ASSUMES UNIFORM
+! DISTRIBUTION BASED ON SOIL LAYER DEPTHS.
+! ----------------------------------------------------------------------
+      DO I = 1,NROOT
+        RTDIS(I) = -SLDPTH(I)/ZSOIL(NROOT)
+      END DO
+
+! ----------------------------------------------------------------------
+!  SET-UP SLOPE PARAMETER
+! ----------------------------------------------------------------------
+      SLOPE = SLOPE_DATA(SLOPETYP)
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE REDPRM
+! ----------------------------------------------------------------------
+      END SUBROUTINE REDPRM
+
+      SUBROUTINE ROSR12 (P,A,B,C,D,DELTA,NSOIL)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE ROSR12
+! ----------------------------------------------------------------------
+! INVERT (SOLVE) THE TRI-DIAGONAL MATRIX PROBLEM SHOWN BELOW:
+! ###                                            ### ###  ###   ###  ###
+! #B(1), C(1),  0  ,  0  ,  0  ,   . . .  ,    0   # #      #   #      #
+! #A(2), B(2), C(2),  0  ,  0  ,   . . .  ,    0   # #      #   #      #
+! # 0  , A(3), B(3), C(3),  0  ,   . . .  ,    0   # #      #   # D(3) #
+! # 0  ,  0  , A(4), B(4), C(4),   . . .  ,    0   # # P(4) #   # D(4) #
+! # 0  ,  0  ,  0  , A(5), B(5),   . . .  ,    0   # # P(5) #   # D(5) #
+! # .                                          .   # #  .   # = #   .  #
+! # .                                          .   # #  .   #   #   .  #
+! # .                                          .   # #  .   #   #   .  #
+! # 0  , . . . , 0 , A(M-2), B(M-2), C(M-2),   0   # #P(M-2)#   #D(M-2)#
+! # 0  , . . . , 0 ,   0   , A(M-1), B(M-1), C(M-1)# #P(M-1)#   #D(M-1)#
+! # 0  , . . . , 0 ,   0   ,   0   ,  A(M) ,  B(M) # # P(M) #   # D(M) #
+! ###                                            ### ###  ###   ###  ###
+! ----------------------------------------------------------------------
+      INTEGER K
+      INTEGER KK
+      INTEGER NSOIL
+      
+      REAL A(NSOIL)
+      REAL B(NSOIL)
+      REAL C(NSOIL)
+      REAL D(NSOIL)
+      REAL DELTA(NSOIL)
+      REAL P(NSOIL)
+      
+! ----------------------------------------------------------------------
+! INITIALIZE EQN COEF C FOR THE LOWEST SOIL LAYER
+! ----------------------------------------------------------------------
+      C(NSOIL) = 0.0
+
+! ----------------------------------------------------------------------
+! SOLVE THE COEFS FOR THE 1ST SOIL LAYER
+! ----------------------------------------------------------------------
+      P(1) = -C(1) / B(1)
+      DELTA(1) = D(1) / B(1)
+
+! ----------------------------------------------------------------------
+! SOLVE THE COEFS FOR SOIL LAYERS 2 THRU NSOIL
+! ----------------------------------------------------------------------
+      DO K = 2,NSOIL
+        P(K) = -C(K) * ( 1.0 / (B(K) + A (K) * P(K-1)) )
+        DELTA(K) = (D(K)-A(K)*DELTA(K-1))*(1.0/(B(K)+A(K)*P(K-1)))
+      END DO
+
+! ----------------------------------------------------------------------
+! SET P TO DELTA FOR LOWEST SOIL LAYER
+! ----------------------------------------------------------------------
+      P(NSOIL) = DELTA(NSOIL)
+
+! ----------------------------------------------------------------------
+! ADJUST P FOR SOIL LAYERS 2 THRU NSOIL
+! ----------------------------------------------------------------------
+      DO K = 2,NSOIL
+         KK = NSOIL - K + 1
+         P(KK) = P(KK) * P(KK+1) + DELTA(KK)
+      END DO
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE ROSR12
+! ----------------------------------------------------------------------
+      END SUBROUTINE ROSR12
+
+      SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,  &
+     &                  TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,ICE,   &
+     &                  QUARTZ,CSOIL)
+      
+      IMPLICIT NONE
+      
+! ----------------------------------------------------------------------
+! SUBROUTINE SHFLX
+! ----------------------------------------------------------------------
+! UPDATE THE TEMPERATURE STATE OF THE SOIL COLUMN BASED ON THE THERMAL
+! DIFFUSION EQUATION AND UPDATE THE FROZEN SOIL MOISTURE CONTENT BASED
+! ON THE TEMPERATURE.
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+      INTEGER I
+      INTEGER ICE
+      INTEGER IFRZ
+      INTEGER NSOIL
+
+      REAL AI(NSOLD)
+      REAL BI(NSOLD)
+      REAL CI(NSOLD)
+
+      REAL BEXP
+      REAL CSOIL
+      REAL DF1
+      REAL DT
+      REAL F1
+      REAL PSISAT
+      REAL QUARTZ
+      REAL RHSTS(NSOLD)
+      REAL SSOIL
+      REAL SH2O(NSOIL)
+      REAL SMC(NSOIL)
+      REAL SMCMAX
+      REAL SMCWLT
+      REAL STC(NSOIL)
+      REAL STCF(NSOLD)
+      REAL T0
+      REAL T1
+      REAL TBOT
+      REAL YY
+      REAL ZBOT
+      REAL ZSOIL(NSOIL)
+      REAL ZZ1
+
+      PARAMETER(T0 = 273.15)
+
+! ----------------------------------------------------------------------
+! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN
+! ----------------------------------------------------------------------
+      IF (ICE.EQ.1) THEN
+
+! ----------------------------------------------------------------------
+! SEA-ICE CASE
+! ----------------------------------------------------------------------
+         CALL HRTICE (RHSTS,STC,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)
+
+         CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)
+         
+      ELSE
+
+! ----------------------------------------------------------------------
+! LAND-MASS CASE
+! ----------------------------------------------------------------------
+         CALL HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,TBOT,        &
+     &             ZBOT,PSISAT,SH2O,DT,                                 &
+     &             BEXP,F1,DF1,QUARTZ,CSOIL,AI,BI,CI)
+         
+         CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)
+
+      ENDIF
+
+      DO I = 1,NSOIL
+         STC(I) = STCF(I)
+      END DO
+      
+! ----------------------------------------------------------------------
+! IN THE NO SNOWPACK CASE (VIA ROUTINE NOPAC BRANCH,) UPDATE THE GRND
+! (SKIN) TEMPERATURE HERE IN RESPONSE TO THE UPDATED SOIL TEMPERATURE 
+! PROFILE ABOVE.  (NOTE: INSPECTION OF ROUTINE SNOPAC SHOWS THAT T1
+! BELOW IS A DUMMY VARIABLE ONLY, AS SKIN TEMPERATURE IS UPDATED
+! DIFFERENTLY IN ROUTINE SNOPAC) 
+! ----------------------------------------------------------------------
+      T1 = (YY + (ZZ1 - 1.0) * STC(1)) / ZZ1
+
+! ----------------------------------------------------------------------
+! CALCULATE SURFACE SOIL HEAT FLUX
+! ----------------------------------------------------------------------
+      SSOIL = DF1 * (STC(1) - T1) / (0.5 * ZSOIL(1))
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE SHFLX
+! ----------------------------------------------------------------------
+      END SUBROUTINE SHFLX
+
+      SUBROUTINE SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                   &
+     &                  SH2O,SLOPE,KDT,FRZFACT,                         &
+     &                  SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                 &
+     &                  SHDFAC,CMCMAX,                                  &
+     &                  RUNOFF1,RUNOFF2,RUNOFF3,                        &
+     &                  EDIR1,EC1,ET1,                                  &
+     &                  DRIP)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SMFLX
+! ----------------------------------------------------------------------
+! CALCULATE SOIL MOISTURE FLUX.  THE SOIL MOISTURE CONTENT (SMC - A PER
+! UNIT VOLUME MEASUREMENT) IS A DEPENDENT VARIABLE THAT IS UPDATED WITH
+! PROGNOSTIC EQNS. THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED.
+! FROZEN GROUND VERSION:  NEW STATES ADDED: SH2O, AND FROZEN GROUND
+! CORRECTION FACTOR, FRZFACT AND PARAMETER SLOPE.
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+      INTEGER I
+      INTEGER K
+      INTEGER NSOIL
+
+      REAL AI(NSOLD)
+      REAL BI(NSOLD)
+      REAL CI(NSOLD)
+
+      REAL BEXP
+      REAL CMC
+      REAL CMCMAX
+      REAL DKSAT
+      REAL DRIP
+      REAL DT
+      REAL DUMMY
+      REAL DWSAT
+      REAL EC1
+      REAL EDIR1
+      REAL ET1(NSOIL)
+      REAL EXCESS
+      REAL FRZFACT
+      REAL KDT
+      REAL PCPDRP
+      REAL PRCP1
+      REAL RHSCT
+      REAL RHSTT(NSOLD)
+      REAL RUNOFF1
+      REAL RUNOFF2
+      REAL RUNOFF3
+      REAL SHDFAC
+      REAL SMC(NSOIL)
+      REAL SH2O(NSOIL)
+      REAL SICE(NSOLD)
+      REAL SH2OA(NSOLD)
+      REAL SH2OFG(NSOLD)
+      REAL SLOPE
+      REAL SMCMAX
+      REAL SMCWLT
+      REAL TRHSCT
+      REAL ZSOIL(NSOIL)
+
+! ----------------------------------------------------------------------
+! EXECUTABLE CODE BEGINS HERE.
+! ----------------------------------------------------------------------
+      DUMMY = 0.
+
+! ----------------------------------------------------------------------
+! COMPUTE THE RIGHT HAND SIDE OF THE CANOPY EQN TERM ( RHSCT )
+! ----------------------------------------------------------------------
+      RHSCT = SHDFAC * PRCP1 - EC1
+
+! ----------------------------------------------------------------------
+! CONVERT RHSCT (A RATE) TO TRHSCT (AN AMOUNT) AND ADD IT TO EXISTING
+! CMC.  IF RESULTING AMT EXCEEDS MAX CAPACITY, IT BECOMES DRIP AND WILL
+! FALL TO THE GRND.
+! ----------------------------------------------------------------------
+      DRIP = 0.
+      TRHSCT = DT * RHSCT
+      EXCESS = CMC + TRHSCT
+      IF (EXCESS .GT. CMCMAX) DRIP = EXCESS - CMCMAX
+
+! ----------------------------------------------------------------------
+! PCPDRP IS THE COMBINED PRCP1 AND DRIP (FROM CMC) THAT GOES INTO THE
+! SOIL
+! ----------------------------------------------------------------------
+      PCPDRP = (1. - SHDFAC) * PRCP1 + DRIP / DT
+
+! ----------------------------------------------------------------------
+! STORE ICE CONTENT AT EACH SOIL LAYER BEFORE CALLING SRT & SSTEP
+! ----------------------------------------------------------------------
+      DO I = 1,NSOIL
+        SICE(I) = SMC(I) - SH2O(I)
+      END DO
+            
+! ----------------------------------------------------------------------
+! CALL SUBROUTINES SRT AND SSTEP TO SOLVE THE SOIL MOISTURE
+! TENDENCY EQUATIONS. 
+!
+! IF THE INFILTRATING PRECIP RATE IS NONTRIVIAL,
+!   (WE CONSIDER NONTRIVIAL TO BE A PRECIP TOTAL OVER THE TIME STEP 
+!    EXCEEDING ONE ONE-THOUSANDTH OF THE WATER HOLDING CAPACITY OF 
+!    THE FIRST SOIL LAYER)
+! THEN CALL THE SRT/SSTEP SUBROUTINE PAIR TWICE IN THE MANNER OF 
+!   TIME SCHEME "F" (IMPLICIT STATE, AVERAGED COEFFICIENT)
+!   OF SECTION 2 OF KALNAY AND KANAMITSU (1988, MWR, VOL 116, 
+!   PAGES 1945-1958)TO MINIMIZE 2-DELTA-T OSCILLATIONS IN THE 
+!   SOIL MOISTURE VALUE OF THE TOP SOIL LAYER THAT CAN ARISE BECAUSE
+!   OF THE EXTREME NONLINEAR DEPENDENCE OF THE SOIL HYDRAULIC 
+!   DIFFUSIVITY COEFFICIENT AND THE HYDRAULIC CONDUCTIVITY ON THE
+!   SOIL MOISTURE STATE
+! OTHERWISE CALL THE SRT/SSTEP SUBROUTINE PAIR ONCE IN THE MANNER OF
+!   TIME SCHEME "D" (IMPLICIT STATE, EXPLICIT COEFFICIENT) 
+!   OF SECTION 2 OF KALNAY AND KANAMITSU
+! PCPDRP IS UNITS OF KG/M**2/S OR MM/S, ZSOIL IS NEGATIVE DEPTH IN M 
+! ----------------------------------------------------------------------
+!      IF ( PCPDRP .GT. 0.0 ) THEN
+      IF ( (PCPDRP*DT) .GT. (0.001*1000.0*(-ZSOIL(1))*SMCMAX) ) THEN
+
+! ----------------------------------------------------------------------
+! FROZEN GROUND VERSION:
+! SMC STATES REPLACED BY SH2O STATES IN SRT SUBR.  SH2O & SICE STATES
+! INCLUDED IN SSTEP SUBR.  FROZEN GROUND CORRECTION FACTOR, FRZFACT
+! ADDED.  ALL WATER BALANCE CALCULATIONS USING UNFROZEN WATER
+! ----------------------------------------------------------------------
+        CALL SRT (RHSTT,EDIR1,ET1,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL,         &
+     &            DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,                      &
+     &            RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI)
+         
+        CALL SSTEP (SH2OFG,SH2O,DUMMY,RHSTT,RHSCT,DT,NSOIL,SMCMAX,      &
+     &              CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI)
+         
+        DO K = 1,NSOIL
+          SH2OA(K) = (SH2O(K) + SH2OFG(K)) * 0.5
+        END DO
+        
+        CALL SRT (RHSTT,EDIR1,ET1,SH2O,SH2OA,NSOIL,PCPDRP,ZSOIL,        &
+     &            DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,                      &
+     &            RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI)
+         
+        CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX,          &
+     &              CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI)
+         
+      ELSE
+         
+        CALL SRT (RHSTT,EDIR1,ET1,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL,         &
+     &            DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,                      &
+     &            RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI)
+
+        CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX,          &
+     &              CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI)
+         
+      ENDIF
+      
+!      RUNOF = RUNOFF
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE SMFLX
+! ----------------------------------------------------------------------
+      END SUBROUTINE SMFLX
+
+      SUBROUTINE SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR)
+
+      IMPLICIT NONE
+      
+! ----------------------------------------------------------------------
+! SUBROUTINE SNFRAC
+! ----------------------------------------------------------------------
+! CALCULATE SNOW FRACTION (0 -> 1)
+! SNEQV   SNOW WATER EQUIVALENT (M)
+! SNUP    THRESHOLD SNEQV DEPTH ABOVE WHICH SNCOVR=1
+! SALP    TUNING PARAMETER
+! SNCOVR  FRACTIONAL SNOW COVER
+! ----------------------------------------------------------------------
+      REAL SNEQV, SNUP, SALP, SNCOVR, RSNOW, Z0N, SNOWH
+      
+! ----------------------------------------------------------------------
+! SNUP IS VEG-CLASS DEPENDENT SNOWDEPTH THRESHHOLD (SET IN ROUTINE
+! REDPRM) ABOVE WHICH SNOCVR=1.
+! ----------------------------------------------------------------------
+          IF (SNEQV .LT. SNUP) THEN
+            RSNOW = SNEQV/SNUP
+            SNCOVR = 1. - ( EXP(-SALP*RSNOW) - RSNOW*EXP(-SALP))
+          ELSE
+            SNCOVR = 1.0
+          ENDIF
+
+          Z0N=0.035 
+!     FORMULATION OF DICKINSON ET AL. 1986
+
+!        SNCOVR=SNOWH/(SNOWH + 5*Z0N)
+
+!     FORMULATION OF MARSHALL ET AL. 1994
+!        SNCOVR=SNEQV/(SNEQV + 2*Z0N)
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE SNFRAC
+! ----------------------------------------------------------------------
+      END SUBROUTINE SNFRAC
+
+      SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCP1,SNOWNG,SMC,SMCMAX,SMCWLT,   &
+     &                   SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,             &
+     &                   SBETA,DF1,                                     &
+     &                   Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,STC,EPSCA, &
+     &                   SFCPRS,BEXP,PC,RCH,RR,CFACTR,SNCOVR,ESD,SNDENS,&
+     &                   SNOWH,SH2O,SLOPE,KDT,FRZFACT,PSISAT,SNUP,      &
+     &                   ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1,    &
+     &                   RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT,   &
+     &                   ICE,RTDIS,QUARTZ,FXEXP,CSOIL,                  &
+     &                   BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SNOPAC
+! ----------------------------------------------------------------------
+! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES & UPDATE SOIL MOISTURE
+! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN A SNOW PACK IS
+! PRESENT.
+! ----------------------------------------------------------------------
+      INTEGER ICE
+      INTEGER NROOT
+      INTEGER NSOIL
+
+      LOGICAL SNOWNG
+
+      REAL BEXP
+      REAL BETA
+      REAL CFACTR
+      REAL CMC
+      REAL CMCMAX
+      REAL CP
+      REAL CPH2O
+      REAL CPICE
+      REAL CSOIL
+      REAL DENOM
+      REAL DEW
+      REAL DF1
+      REAL DKSAT
+      REAL DRIP
+      REAL DSOIL
+      REAL DTOT
+      REAL DT
+      REAL DWSAT
+      REAL EC
+      REAL EDIR
+      REAL EPSCA
+      REAL ESD
+      REAL ESDMIN
+      REAL EXPSNO
+      REAL EXPSOI
+      REAL ETA
+      REAL ETA1
+      REAL ETP
+      REAL ETP1
+      REAL ETP2
+      REAL ET(NSOIL)
+      REAL ETT
+      REAL EX
+      REAL EXPFAC
+      REAL FDOWN
+      REAL FXEXP
+      REAL FLX1
+      REAL FLX2
+      REAL FLX3
+      REAL F1
+      REAL KDT
+      REAL LSUBF
+      REAL LSUBC
+      REAL LSUBS
+      REAL PC
+      REAL PRCP
+      REAL PRCP1
+      REAL Q2
+      REAL RCH
+      REAL RR
+      REAL RTDIS(NSOIL)
+      REAL SSOIL
+      REAL SBETA
+      REAL SSOIL1
+      REAL SFCTMP
+      REAL SHDFAC
+      REAL SIGMA
+      REAL SMC(NSOIL)
+      REAL SH2O(NSOIL)
+      REAL SMCDRY
+      REAL SMCMAX
+      REAL SMCREF
+      REAL SMCWLT
+      REAL SNOMLT
+      REAL SNOWH
+      REAL STC(NSOIL)
+      REAL T1
+      REAL T11
+      REAL T12
+      REAL T12A
+      REAL T12B
+      REAL T24
+      REAL TBOT
+      REAL ZBOT
+      REAL TH2
+      REAL YY
+      REAL ZSOIL(NSOIL)
+      REAL ZZ1
+      REAL TFREEZ
+      REAL SALP
+      REAL SFCPRS
+      REAL SLOPE
+      REAL FRZFACT
+      REAL PSISAT
+      REAL SNUP
+      REAL RUNOFF1
+      REAL RUNOFF2
+      REAL RUNOFF3
+      REAL QUARTZ
+      REAL SNDENS
+      REAL SNCOND
+      REAL RSNOW
+      REAL SNCOVR
+      REAL QSAT
+      REAL ETP3
+      REAL SEH
+      REAL T14
+!      REAL CSNOW
+
+      REAL EC1
+      REAL EDIR1
+      REAL ET1(NSOIL)
+      REAL ETT1
+
+      REAL ETNS
+      REAL ETNS1
+      REAL ESNOW
+      REAL ESNOW1
+      REAL ESNOW2
+      REAL ETANRG
+
+      INTEGER K
+
+      REAL SNOEXP
+
+      PARAMETER(CP = 1004.5)
+      PARAMETER(CPH2O = 4.218E+3)
+      PARAMETER(CPICE = 2.106E+3)
+      PARAMETER(ESDMIN = 1.E-6)
+      PARAMETER(LSUBF = 3.335E+5)
+      PARAMETER(LSUBC = 2.501000E+6)
+      PARAMETER(LSUBS = 2.83E+6)
+      PARAMETER(SIGMA = 5.67E-8)
+      PARAMETER(TFREEZ = 273.15)
+
+!      DATA SNOEXP /1.0/
+      DATA SNOEXP /2.0/
+
+! ----------------------------------------------------------------------
+! EXECUTABLE CODE BEGINS HERE:
+! CONVERT POTENTIAL EVAP (ETP) FROM KG M-2 S-1 TO M S-1 AND THEN TO AN
+! AMOUNT (M) GIVEN TIMESTEP (DT) AND CALL IT AN EFFECTIVE SNOWPACK
+! REDUCTION AMOUNT, ETP2 (M).  THIS IS THE AMOUNT THE SNOWPACK WOULD BE
+! REDUCED DUE TO EVAPORATION FROM THE SNOW SFC DURING THE TIMESTEP.
+! EVAPORATION WILL PROCEED AT THE POTENTIAL RATE UNLESS THE SNOW DEPTH
+! IS LESS THAN THE EXPECTED SNOWPACK REDUCTION.
+! IF SEAICE (ICE=1), BETA REMAINS=1.
+! ----------------------------------------------------------------------
+      PRCP1 = PRCP1*0.001
+
+!      ETP2 = ETP * 0.001 * DT
+      BETA = 1.0
+      IF (ICE .NE. 1) THEN
+        IF (ESD .LT. ETP2) THEN
+!          BETA = ESD / ETP2
+        ENDIF
+      ENDIF
+
+! ----------------------------------------------------------------------
+      EDIR = 0.0
+      EDIR1 = 0.0
+      EC = 0.0
+      EC1 = 0.0
+      DO K = 1,NSOIL
+        ET(K) = 0.0
+        ET1(K) = 0.0
+      ENDDO
+      ETT = 0.0
+      ETT1 = 0.0
+      ETNS = 0.0
+      ETNS1 = 0.0
+      ESNOW = 0.0
+      ESNOW1 = 0.0
+      ESNOW2 = 0.0
+! ----------------------------------------------------------------------
+
+! ----------------------------------------------------------------------
+! IF ETP<0 (DOWNWARD) THEN DEWFALL (=FROSTFALL IN THIS CASE).
+! ----------------------------------------------------------------------
+      DEW = 0.0
+      ETP1 = ETP*0.001
+      IF (ETP .LT. 0.0) THEN
+!        DEW = -ETP * 0.001
+        DEW = -ETP1
+!        ESNOW2 = ETP * 0.001 * DT
+        ESNOW2 = ETP1 * DT
+        ETANRG = ETP*((1.-SNCOVR)*LSUBC + SNCOVR*LSUBS)
+!      ENDIF
+      ELSE
+! ----------------------------------------------------------------------
+!      ETP1 = 0.0
+!        ETP1 = ETP*0.001
+        IF (ICE .NE. 1) THEN
+          IF (SNCOVR .LT. 1.) THEN
+!          CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,
+            CALL EVAPO (ETNS1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,              &
+     &                  SH2O,SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,         &
+     &                  SMCREF,SHDFAC,CMCMAX,                           &
+     &                  SMCDRY,CFACTR,                                  &
+     &                  EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP)
+!        ENDIF
+! ----------------------------------------------------------------------
+            EDIR1 = EDIR1*(1.-SNCOVR)
+            EC1 = EC1*(1.-SNCOVR)
+            DO K = 1,NSOIL
+              ET1(K) = ET1(K)*(1.-SNCOVR)
+            END DO
+            ETT1 = ETT1*(1.-SNCOVR)
+            ETNS1 = ETNS1*(1.-SNCOVR)
+! ----------------------------------------------------------------------
+            EDIR = EDIR1 * 1000.0
+            EC = EC1 * 1000.0
+            DO K = 1,NSOIL
+              ET(K) = ET1(K) * 1000.0
+            END DO
+            ETT = ETT1 * 1000.0
+            ETNS = ETNS1 * 1000.0
+! ----------------------------------------------------------------------
+          ENDIF
+          ESNOW = ETP*SNCOVR
+!          ESNOW1 = ETP*0.001
+          ESNOW1 = ESNOW*0.001
+          ESNOW2 = ESNOW1*DT
+          ETANRG = ESNOW*LSUBS + ETNS*LSUBC
+        ENDIF
+      ENDIF
+   
+! ----------------------------------------------------------------------
+! IF PRECIP IS FALLING, CALCULATE HEAT FLUX FROM SNOW SFC TO NEWLY
+! ACCUMULATING PRECIP.  NOTE THAT THIS REFLECTS THE FLUX APPROPRIATE FOR
+! THE NOT-YET-UPDATED SKIN TEMPERATURE (T1).  ASSUMES TEMPERATURE OF THE
+! SNOWFALL STRIKING THE GOUND IS =SFCTMP (LOWEST MODEL LEVEL AIR TEMP).
+! ----------------------------------------------------------------------
+      FLX1 = 0.0
+      IF (SNOWNG) THEN
+        FLX1 = CPICE * PRCP * (T1 - SFCTMP)
+      ELSE
+        IF (PRCP .GT. 0.0) FLX1 = CPH2O * PRCP * (T1 - SFCTMP)
+      ENDIF
+
+! ----------------------------------------------------------------------
+! CALCULATE AN 'EFFECTIVE SNOW-GRND SFC TEMP' (T12) BASED ON HEAT FLUXES
+! BETWEEN THE SNOW PACK AND THE SOIL AND ON NET RADIATION.
+! INCLUDE FLX1 (PRECIP-SNOW SFC) AND FLX2 (FREEZING RAIN LATENT HEAT)
+! FLUXES.
+! FLX2 REFLECTS FREEZING RAIN LATENT HEAT FLUX USING T1 CALCULATED IN
+! PENMAN.
+! ----------------------------------------------------------------------
+      DSOIL = -(0.5 * ZSOIL(1))
+      DTOT = SNOWH + DSOIL
+      DENOM = 1.0 + DF1 / (DTOT * RR * RCH)
+!      T12A = ( (FDOWN-FLX1-FLX2-SIGMA*T24)/RCH
+!     &       + TH2 - SFCTMP - BETA*EPSCA ) / RR
+!      T12A = ( (FDOWN-FLX1-FLX2-SIGMA*T24)/RCH
+! M.Ek, 24Nov04, add snow emissivity
+      T12A = ((FDOWN-FLX1-FLX2                                          &
+     &       -(0.95*SNCOVR+(1.0-SNCOVR))*SIGMA*T24)/RCH                 &
+     &       + TH2 - SFCTMP - ETANRG/RCH ) / RR
+      T12B = DF1 * STC(1) / (DTOT * RR * RCH)
+      T12 = (SFCTMP + T12A + T12B) / DENOM      
+
+! ----------------------------------------------------------------------
+! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS AT OR BELOW FREEZING, NO SNOW
+! MELT WILL OCCUR.  SET THE SKIN TEMP TO THIS EFFECTIVE TEMP.  REDUCE
+! (BY SUBLIMINATION ) OR INCREASE (BY FROST) THE DEPTH OF THE SNOWPACK,
+! DEPENDING ON SIGN OF ETP.
+! UPDATE SOIL HEAT FLUX (SSOIL) USING NEW SKIN TEMPERATURE (T1)
+! SINCE NO SNOWMELT, SET ACCUMULATED SNOWMELT TO ZERO, SET 'EFFECTIVE'
+! PRECIP FROM SNOWMELT TO ZERO, SET PHASE-CHANGE HEAT FLUX FROM SNOWMELT
+! TO ZERO.
+! ----------------------------------------------------------------------
+      IF (T12 .LE. TFREEZ) THEN
+        T1 = T12
+        SSOIL = DF1 * (T1 - STC(1)) / DTOT
+!        ESD = MAX(0.0, ESD-ETP2)
+        ESD = MAX(0.0, ESD-ESNOW2)
+        FLX3 = 0.0
+        EX = 0.0
+        SNOMLT = 0.0
+
+      ELSE
+! ----------------------------------------------------------------------
+! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS ABOVE FREEZING, SNOW MELT
+! WILL OCCUR.  CALL THE SNOW MELT RATE,EX AND AMT, SNOMLT.  REVISE THE
+! EFFECTIVE SNOW DEPTH.  REVISE THE SKIN TEMP BECAUSE IT WOULD HAVE CHGD
+! DUE TO THE LATENT HEAT RELEASED BY THE MELTING. CALC THE LATENT HEAT
+! RELEASED, FLX3. SET THE EFFECTIVE PRECIP, PRCP1 TO THE SNOW MELT RATE,
+! EX FOR USE IN SMFLX.  ADJUSTMENT TO T1 TO ACCOUNT FOR SNOW PATCHES.
+! CALCULATE QSAT VALID AT FREEZING POINT.  NOTE THAT ESAT (SATURATION
+! VAPOR PRESSURE) VALUE OF 6.11E+2 USED HERE IS THAT VALID AT FRZZING
+! POINT.  NOTE THAT ETP FROM CALL PENMAN IN SFLX IS IGNORED HERE IN
+! FAVOR OF BULK ETP OVER 'OPEN WATER' AT FREEZING TEMP.
+! UPDATE SOIL HEAT FLUX (S) USING NEW SKIN TEMPERATURE (T1)
+! ----------------------------------------------------------------------
+!        T1 = TFREEZ * SNCOVR + T12 * (1.0 - SNCOVR)
+! mek Feb2004
+! non-linear weighting of snow vs non-snow covered portions of gridbox
+! so with SNOEXP = 2.0 (>1), surface skin temperature is higher than for
+! the linear case (SNOEXP = 1).
+        T1 = TFREEZ * SNCOVR**SNOEXP + T12 * (1.0 - SNCOVR**SNOEXP)
+!        QSAT = (0.622*6.11E2)/(SFCPRS-0.378*6.11E2)
+!        ETP = RCH*(QSAT-Q2)/CP
+!        ETP2 = ETP*0.001*DT
+        BETA = 1.0
+        SSOIL = DF1 * (T1 - STC(1)) / DTOT
+	
+! ----------------------------------------------------------------------
+! IF POTENTIAL EVAP (SUBLIMATION) GREATER THAN DEPTH OF SNOWPACK.
+! BETA<1
+! SNOWPACK HAS SUBLIMATED AWAY, SET DEPTH TO ZERO.
+! ----------------------------------------------------------------------
+!        IF (ESD .LE. ETP2) THEN
+!        IF (ESD .LE. ESNOW2) THEN
+        IF (ESD-ESNOW2 .LE. ESDMIN) THEN
+!          BETA = ESD / ETP2
+          ESD = 0.0
+          EX = 0.0
+          SNOMLT = 0.0
+
+        ELSE
+! ----------------------------------------------------------------------
+! POTENTIAL EVAP (SUBLIMATION) LESS THAN DEPTH OF SNOWPACK, RETAIN
+!   BETA=1.
+! SNOWPACK (ESD) REDUCED BY POTENTIAL EVAP RATE
+! ETP3 (CONVERT TO FLUX)
+! ----------------------------------------------------------------------
+!          ESD = ESD-ETP2
+          ESD = ESD-ESNOW2
+!          ETP3 = ETP*LSUBC
+          SEH = RCH*(T1-TH2)
+          T14 = T1*T1
+          T14 = T14*T14
+!          FLX3 = FDOWN - FLX1 - FLX2 - SIGMA*T14 - SSOIL - SEH - ETP3
+!          FLX3 = FDOWN - FLX1 - FLX2 - SIGMA*T14 - SSOIL - SEH - ETANRG
+! M.Ek, 24Nov04, add snow emissivity
+          FLX3 = FDOWN - FLX1 - FLX2 -                                  &
+     &       (0.95*SNCOVR+(1.0-SNCOVR))*SIGMA*T14 - SSOIL - SEH - ETANRG
+          IF (FLX3 .LE. 0.0) FLX3 = 0.0
+          EX = FLX3*0.001/LSUBF
+
+! ----------------------------------------------------------------------
+! SNOWMELT REDUCTION DEPENDING ON SNOW COVER
+! IF SNOW COVER LESS THAN 5% NO SNOWMELT REDUCTION
+! ***NOTE:  DOES 'IF' BELOW FAIL TO MATCH THE MELT WATER WITH THE MELT
+!           ENERGY?
+! ----------------------------------------------------------------------
+!          IF (SNCOVR .GT. 0.05) EX = EX * SNCOVR
+          SNOMLT = EX * DT
+
+! ----------------------------------------------------------------------
+! ESDMIN REPRESENTS A SNOWPACK DEPTH THRESHOLD VALUE BELOW WHICH WE
+! CHOOSE NOT TO RETAIN ANY SNOWPACK, AND INSTEAD INCLUDE IT IN SNOWMELT.
+! ----------------------------------------------------------------------
+          IF (ESD-SNOMLT .GE. ESDMIN) THEN
+            ESD = ESD - SNOMLT
+
+          ELSE
+! ----------------------------------------------------------------------
+! SNOWMELT EXCEEDS SNOW DEPTH
+! ----------------------------------------------------------------------
+            EX = ESD/DT
+            FLX3 = EX*1000.0*LSUBF
+            SNOMLT = ESD
+            ESD = 0.0
+
+          ENDIF
+! ----------------------------------------------------------------------
+! END OF 'ESD .LE. ETP2' IF-BLOCK
+! ----------------------------------------------------------------------
+        ENDIF
+
+        PRCP1 = PRCP1 + EX
+
+! ----------------------------------------------------------------------
+! END OF 'T12 .LE. TFREEZ' IF-BLOCK
+! ----------------------------------------------------------------------
+      ENDIF
+         
+! ----------------------------------------------------------------------
+! FINAL BETA NOW IN HAND, SO COMPUTE EVAPORATION.  EVAP EQUALS ETP
+! UNLESS BETA<1.
+! ----------------------------------------------------------------------
+!      ETA = BETA*ETP
+
+! ----------------------------------------------------------------------
+! SET THE EFFECTIVE POTNL EVAPOTRANSP (ETP1) TO ZERO SINCE THIS IS SNOW
+! CASE, SO SURFACE EVAP NOT CALCULATED FROM EDIR, EC, OR ETT IN SMFLX
+! (BELOW).
+! IF SEAICE (ICE=1) SKIP CALL TO SMFLX.
+! SMFLX RETURNS UPDATED SOIL MOISTURE VALUES.  IN THIS, THE SNOW PACK
+! CASE, ETA1 IS NOT USED IN CALCULATION OF EVAP.
+! ----------------------------------------------------------------------
+!      ETP1 = 0.0
+      IF (ICE .NE. 1) THEN
+!        CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,
+!     &              SH2O,SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,
+!     &              SMCREF,SHDFAC,CMCMAX,
+!     &              SMCDRY,CFACTR,
+!     &              EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP)
+        CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                       &
+     &              SH2O,SLOPE,KDT,FRZFACT,                             &
+     &              SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                     &
+     &              SHDFAC,CMCMAX,                                      &
+     &              RUNOFF1,RUNOFF2,RUNOFF3,                            &
+     &              EDIR1,EC1,ET1,                                      &
+     &              DRIP)
+
+      ENDIF
+
+! ----------------------------------------------------------------------
+!        EDIR = EDIR1 * 1000.0
+!        EC = EC1 * 1000.0
+!        ETT = ETT1 * 1000.0
+!        ET(1) = ET1(1) * 1000.0
+!        ET(2) = ET1(2) * 1000.0
+!        ET(3) = ET1(3) * 1000.0
+!        ET(4) = ET1(4) * 1000.0
+! ----------------------------------------------------------------------
+
+! ----------------------------------------------------------------------
+! BEFORE CALL SHFLX IN THIS SNOWPACK CASE, SET ZZ1 AND YY ARGUMENTS TO
+! SPECIAL VALUES THAT ENSURE THAT GROUND HEAT FLUX CALCULATED IN SHFLX
+! MATCHES THAT ALREADY COMPUTER FOR BELOW THE SNOWPACK, THUS THE SFC
+! HEAT FLUX TO BE COMPUTED IN SHFLX WILL EFFECTIVELY BE THE FLUX AT THE
+! SNOW TOP SURFACE.  T11 IS A DUMMY ARGUEMENT SO WE WILL NOT USE THE
+! SKIN TEMP VALUE AS REVISED BY SHFLX.
+! ----------------------------------------------------------------------
+      ZZ1 = 1.0
+      YY = STC(1)-0.5*SSOIL*ZSOIL(1)*ZZ1/DF1
+      T11 = T1
+
+! ----------------------------------------------------------------------
+! SHFLX WILL CALC/UPDATE THE SOIL TEMPS.  NOTE:  THE SUB-SFC HEAT FLUX 
+! (SSOIL1) AND THE SKIN TEMP (T11) OUTPUT FROM THIS SHFLX CALL ARE NOT
+! USED  IN ANY SUBSEQUENT CALCULATIONS. RATHER, THEY ARE DUMMY VARIABLES
+! HERE IN THE SNOPAC CASE, SINCE THE SKIN TEMP AND SUB-SFC HEAT FLUX ARE
+! UPDATED INSTEAD NEAR THE BEGINNING OF THE CALL TO SNOPAC.
+! ----------------------------------------------------------------------
+      CALL SHFLX (SSOIL1,STC,SMC,SMCMAX,NSOIL,T11,DT,YY,ZZ1,ZSOIL,      &
+     &            TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,ICE,         &
+     &            QUARTZ,CSOIL)
+      
+! ----------------------------------------------------------------------
+! SNOW DEPTH AND DENSITY ADJUSTMENT BASED ON SNOW COMPACTION.  YY IS
+! ASSUMED TO BE THE SOIL TEMPERTURE AT THE TOP OF THE SOIL COLUMN.
+! ----------------------------------------------------------------------
+      IF (ESD .GT. 0.) THEN
+        CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY)
+      ELSE
+        ESD = 0.
+        SNOWH = 0.
+        SNDENS = 0.
+        SNCOND = 1.
+        SNCOVR = 0.
+      ENDIF
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE SNOPAC
+! ----------------------------------------------------------------------
+      END SUBROUTINE SNOPAC
+
+      SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SNOWPACK
+! ----------------------------------------------------------------------
+! CALCULATE COMPACTION OF SNOWPACK UNDER CONDITIONS OF INCREASING SNOW
+! DENSITY, AS OBTAINED FROM AN APPROXIMATE SOLUTION OF E. ANDERSON'S
+! DIFFERENTIAL EQUATION (3.29), NOAA TECHNICAL REPORT NWS 19, BY VICTOR
+! KOREN, 03/25/95.
+! ----------------------------------------------------------------------
+! ESD     WATER EQUIVALENT OF SNOW (M)
+! DTSEC   TIME STEP (SEC)
+! SNOWH   SNOW DEPTH (M)
+! SNDENS  SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY)
+! TSNOW   SNOW SURFACE TEMPERATURE (K)
+! TSOIL   SOIL SURFACE TEMPERATURE (K)
+!
+! SUBROUTINE WILL RETURN NEW VALUES OF SNOWH AND SNDENS
+! ----------------------------------------------------------------------
+      INTEGER IPOL, J
+
+      REAL BFAC,C1,C2,SNDENS,DSX,DTHR,DTSEC,DW,SNOWHC,SNOWH,PEXP,TAVGC, &
+     &     TSNOW,TSNOWC,TSOIL,TSOILC,ESD,ESDC,ESDCX,G,KN
+
+      PARAMETER(C1 = 0.01, C2=21.0, G=9.81, KN=4000.0)
+
+! ----------------------------------------------------------------------
+! CONVERSION INTO SIMULATION UNITS
+! ----------------------------------------------------------------------
+      SNOWHC = SNOWH*100.
+      ESDC = ESD*100.
+      DTHR = DTSEC/3600.
+      TSNOWC = TSNOW-273.15
+      TSOILC = TSOIL-273.15
+
+! ----------------------------------------------------------------------
+! CALCULATING OF AVERAGE TEMPERATURE OF SNOW PACK
+! ----------------------------------------------------------------------
+      TAVGC = 0.5*(TSNOWC+TSOILC)                                    
+
+! ----------------------------------------------------------------------
+! CALCULATING OF SNOW DEPTH AND DENSITY AS A RESULT OF COMPACTION
+!  SNDENS=DS0*(EXP(BFAC*ESD)-1.)/(BFAC*ESD)
+!  BFAC=DTHR*C1*EXP(0.08*TAVGC-C2*DS0)
+! NOTE: BFAC*ESD IN SNDENS EQN ABOVE HAS TO BE CAREFULLY TREATED
+! NUMERICALLY BELOW:
+!   C1 IS THE FRACTIONAL INCREASE IN DENSITY (1/(CM*HR)) 
+!   C2 IS A CONSTANT (CM3/G) KOJIMA ESTIMATED AS 21 CMS/G
+! ----------------------------------------------------------------------
+      IF (ESDC .GT. 1.E-2) THEN
+        ESDCX = ESDC
+      ELSE
+        ESDCX = 1.E-2
+      ENDIF
+      BFAC = DTHR*C1*EXP(0.08*TAVGC-C2*SNDENS)
+
+!      DSX = SNDENS*((DEXP(BFAC*ESDC)-1.)/(BFAC*ESDC))
+! ----------------------------------------------------------------------
+! THE FUNCTION OF THE FORM (e**x-1)/x IMBEDDED IN ABOVE EXPRESSION
+! FOR DSX WAS CAUSING NUMERICAL DIFFICULTIES WHEN THE DENOMINATOR "x"
+! (I.E. BFAC*ESDC) BECAME ZERO OR APPROACHED ZERO (DESPITE THE FACT THAT
+! THE ANALYTICAL FUNCTION (e**x-1)/x HAS A WELL DEFINED LIMIT AS 
+! "x" APPROACHES ZERO), HENCE BELOW WE REPLACE THE (e**x-1)/x 
+! EXPRESSION WITH AN EQUIVALENT, NUMERICALLY WELL-BEHAVED 
+! POLYNOMIAL EXPANSION.
+!
+! NUMBER OF TERMS OF POLYNOMIAL EXPANSION, AND HENCE ITS ACCURACY, 
+! IS GOVERNED BY ITERATION LIMIT "IPOL".
+!      IPOL GREATER THAN 9 ONLY MAKES A DIFFERENCE ON DOUBLE
+!            PRECISION (RELATIVE ERRORS GIVEN IN PERCENT %).
+!       IPOL=9, FOR REL.ERROR <~ 1.6 E-6 % (8 SIGNIFICANT DIGITS)
+!       IPOL=8, FOR REL.ERROR <~ 1.8 E-5 % (7 SIGNIFICANT DIGITS)
+!       IPOL=7, FOR REL.ERROR <~ 1.8 E-4 % ...
+! ----------------------------------------------------------------------
+      IPOL = 4
+      PEXP = 0.
+      DO J = IPOL,1,-1
+!        PEXP = (1. + PEXP)*BFAC*ESDC/REAL(J+1) 
+        PEXP = (1. + PEXP)*BFAC*ESDCX/REAL(J+1) 
+      END DO
+      PEXP = PEXP + 1.
+
+      DSX = SNDENS*(PEXP)
+! ----------------------------------------------------------------------
+! ABOVE LINE ENDS POLYNOMIAL SUBSTITUTION
+! ----------------------------------------------------------------------
+!     END OF KOREAN FORMULATION
+
+!     BASE FORMULATION (COGLEY ET AL., 1990)
+!     CONVERT DENSITY FROM G/CM3 TO KG/M3
+!       DSM=SNDENS*1000.0
+ 
+!       DSX=DSM+DTSEC*0.5*DSM*G*ESD/
+!    &      (1E7*EXP(-0.02*DSM+KN/(TAVGC+273.16)-14.643))
+ 
+!     CONVERT DENSITY FROM KG/M3 TO G/CM3
+!       DSX=DSX/1000.0
+
+!     END OF COGLEY ET AL. FORMULATION 
+
+! ----------------------------------------------------------------------
+! SET UPPER/LOWER LIMIT ON SNOW DENSITY
+! ----------------------------------------------------------------------
+      IF (DSX .GT. 0.40) DSX = 0.40
+      IF (DSX .LT. 0.05) DSX = 0.05
+      SNDENS = DSX
+! ----------------------------------------------------------------------
+! UPDATE OF SNOW DEPTH AND DENSITY DEPENDING ON LIQUID WATER DURING
+! SNOWMELT.  ASSUMED THAT 13% OF LIQUID WATER CAN BE STORED IN SNOW PER
+! DAY DURING SNOWMELT TILL SNOW DENSITY 0.40.
+! ----------------------------------------------------------------------
+      IF (TSNOWC .GE. 0.) THEN
+        DW = 0.13*DTHR/24.
+        SNDENS = SNDENS*(1.-DW)+DW
+        IF (SNDENS .GT. 0.40) SNDENS = 0.40
+      ENDIF
+
+! ----------------------------------------------------------------------
+! CALCULATE SNOW DEPTH (CM) FROM SNOW WATER EQUIVALENT AND SNOW DENSITY.
+! CHANGE SNOW DEPTH UNITS TO METERS
+! ----------------------------------------------------------------------
+      SNOWHC = ESDC/SNDENS
+      SNOWH = SNOWHC*0.01
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE SNOWPACK
+! ----------------------------------------------------------------------
+      END SUBROUTINE SNOWPACK
+
+      SUBROUTINE SNOWZ0 (SNCOVR,Z0)
+
+      IMPLICIT NONE
+      
+! ----------------------------------------------------------------------
+! SUBROUTINE SNOWZ0
+! ----------------------------------------------------------------------
+! CALCULATE TOTAL ROUGHNESS LENGTH OVER SNOW
+! SNCOVR  FRACTIONAL SNOW COVER
+! Z0      ROUGHNESS LENGTH (m)
+! Z0S     SNOW ROUGHNESS LENGTH:=0.001 (m)
+! ----------------------------------------------------------------------
+      REAL SNCOVR, Z0, Z0S
+!      PARAMETER (Z0S=0.001)
+      
+! CURRENT NOAH LSM CONDITION - MBEK, 09-OCT-2001
+      Z0S = Z0
+!
+      Z0 = (1-SNCOVR)*Z0 + SNCOVR*Z0S
+! ----------------------------------------------------------------------
+! END SUBROUTINE SNOWZ0
+! ----------------------------------------------------------------------
+      END SUBROUTINE SNOWZ0
+
+      SUBROUTINE SNOW_NEW (TEMP,NEWSN,SNOWH,SNDENS)
+
+      IMPLICIT NONE
+      
+! ----------------------------------------------------------------------
+! SUBROUTINE SNOW_NEW
+! ----------------------------------------------------------------------
+! CALCULATE SNOW DEPTH AND DENSITITY TO ACCOUNT FOR THE NEW SNOWFALL.
+! NEW VALUES OF SNOW DEPTH & DENSITY RETURNED.
+!
+! TEMP    AIR TEMPERATURE (K)
+! NEWSN   NEW SNOWFALL (M)
+! SNOWH   SNOW DEPTH (M)
+! SNDENS  SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY)
+! ----------------------------------------------------------------------
+      REAL SNDENS
+      REAL DSNEW
+      REAL SNOWHC
+      REAL HNEWC
+      REAL SNOWH
+      REAL NEWSN
+      REAL NEWSNC
+      REAL TEMP 
+      REAL TEMPC
+      
+! ----------------------------------------------------------------------
+! CONVERSION INTO SIMULATION UNITS      
+! ----------------------------------------------------------------------
+      SNOWHC = SNOWH*100.
+      NEWSNC = NEWSN*100.
+      TEMPC = TEMP-273.15
+      
+! ----------------------------------------------------------------------
+! CALCULATING NEW SNOWFALL DENSITY DEPENDING ON TEMPERATURE
+! EQUATION FROM GOTTLIB L. 'A GENERAL RUNOFF MODEL FOR SNOWCOVERED
+! AND GLACIERIZED BASIN', 6TH NORDIC HYDROLOGICAL CONFERENCE,
+! VEMADOLEN, SWEDEN, 1980, 172-177PP.
+!-----------------------------------------------------------------------
+      IF (TEMPC .LE. -15.) THEN
+        DSNEW = 0.05
+      ELSE                                                      
+        DSNEW = 0.05+0.0017*(TEMPC+15.)**1.5
+      ENDIF
+      
+! ----------------------------------------------------------------------
+! ADJUSTMENT OF SNOW DENSITY DEPENDING ON NEW SNOWFALL      
+! ----------------------------------------------------------------------
+      HNEWC = NEWSNC/DSNEW
+      SNDENS = (SNOWHC*SNDENS+HNEWC*DSNEW)/(SNOWHC+HNEWC)
+      SNOWHC = SNOWHC+HNEWC
+      SNOWH = SNOWHC*0.01
+      
+! ----------------------------------------------------------------------
+! END SUBROUTINE SNOW_NEW
+! ----------------------------------------------------------------------
+      END SUBROUTINE SNOW_NEW
+
+      SUBROUTINE SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,            &
+     &                ZSOIL,DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,            &
+     &                RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZX,SICE,AI,BI,CI)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SRT
+! ----------------------------------------------------------------------
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL
+! WATER DIFFUSION EQUATION.  ALSO TO COMPUTE ( PREPARE ) THE MATRIX
+! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME.
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+      INTEGER CVFRZ      
+      INTEGER IALP1
+      INTEGER IOHINF
+      INTEGER J
+      INTEGER JJ      
+      INTEGER K
+      INTEGER KS
+      INTEGER NSOIL
+
+      REAL ACRT
+      REAL AI(NSOLD)
+      REAL BEXP
+      REAL BI(NSOLD)
+      REAL CI(NSOLD)
+      REAL DD
+      REAL DDT
+      REAL DDZ
+      REAL DDZ2
+      REAL DENOM
+      REAL DENOM2
+      REAL DICE
+      REAL DKSAT
+      REAL DMAX(NSOLD)
+      REAL DSMDZ
+      REAL DSMDZ2
+      REAL DT
+      REAL DT1
+      REAL DWSAT
+      REAL EDIR
+      REAL ET(NSOIL)
+      REAL FCR
+      REAL FRZX
+      REAL INFMAX
+      REAL KDT
+      REAL MXSMC
+      REAL MXSMC2
+      REAL NUMER
+      REAL PCPDRP
+      REAL PDDUM
+      REAL PX
+      REAL RHSTT(NSOIL)
+      REAL RUNOFF1
+      REAL RUNOFF2
+      REAL SH2O(NSOIL)
+      REAL SH2OA(NSOIL)
+      REAL SICE(NSOIL)
+      REAL SICEMAX
+      REAL SLOPE
+      REAL SLOPX
+      REAL SMCAV
+      REAL SMCMAX
+      REAL SMCWLT
+      REAL SSTT
+      REAL SUM
+      REAL VAL
+      REAL WCND
+      REAL WCND2
+      REAL WDF
+      REAL WDF2
+      REAL ZSOIL(NSOIL)
+
+! ----------------------------------------------------------------------
+! FROZEN GROUND VERSION:
+! REFERENCE FROZEN GROUND PARAMETER, CVFRZ, IS A SHAPE PARAMETER OF
+! AREAL DISTRIBUTION FUNCTION OF SOIL ICE CONTENT WHICH EQUALS 1/CV.
+! CV IS A COEFFICIENT OF SPATIAL VARIATION OF SOIL ICE CONTENT.  BASED
+! ON FIELD DATA CV DEPENDS ON AREAL MEAN OF FROZEN DEPTH, AND IT CLOSE
+! TO CONSTANT = 0.6 IF AREAL MEAN FROZEN DEPTH IS ABOVE 20 CM.  THAT IS
+! WHY PARAMETER CVFRZ = 3 (INT{1/0.6*0.6}).
+! CURRENT LOGIC DOESN'T ALLOW CVFRZ BE BIGGER THAN 3
+! ----------------------------------------------------------------------
+        PARAMETER(CVFRZ = 3)
+        
+! ----------------------------------------------------------------------
+! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF.  INCLUDE THE
+! INFILTRATION FORMULE FROM SCHAAKE AND KOREN MODEL.
+! MODIFIED BY Q DUAN
+! ----------------------------------------------------------------------
+      IOHINF=1
+
+! ----------------------------------------------------------------------
+! LET SICEMAX BE THE GREATEST, IF ANY, FROZEN WATER CONTENT WITHIN SOIL
+! LAYERS.
+! ----------------------------------------------------------------------
+      SICEMAX = 0.0
+      DO KS=1,NSOIL
+       IF (SICE(KS) .GT. SICEMAX) SICEMAX = SICE(KS)
+      END DO
+
+! ----------------------------------------------------------------------
+! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF
+! ----------------------------------------------------------------------
+      PDDUM = PCPDRP
+      RUNOFF1 = 0.0
+      IF (PCPDRP .NE. 0.0) THEN
+
+! ----------------------------------------------------------------------
+! MODIFIED BY Q. DUAN, 5/16/94
+! ----------------------------------------------------------------------
+!        IF (IOHINF .EQ. 1) THEN
+
+        DT1 = DT/86400.
+        SMCAV = SMCMAX - SMCWLT
+        DMAX(1)=-ZSOIL(1)*SMCAV
+
+! ----------------------------------------------------------------------
+! FROZEN GROUND VERSION:
+! ----------------------------------------------------------------------
+        DICE = -ZSOIL(1) * SICE(1)
+          
+        DMAX(1)=DMAX(1)*(1.0 - (SH2OA(1)+SICE(1)-SMCWLT)/SMCAV)
+        DD=DMAX(1)
+
+        DO KS=2,NSOIL
+          
+! ----------------------------------------------------------------------
+! FROZEN GROUND VERSION:
+! ----------------------------------------------------------------------
+          DICE = DICE + ( ZSOIL(KS-1) - ZSOIL(KS) ) * SICE(KS)
+         
+          DMAX(KS) = (ZSOIL(KS-1)-ZSOIL(KS))*SMCAV
+          DMAX(KS) = DMAX(KS)*(1.0 - (SH2OA(KS)+SICE(KS)-SMCWLT)/SMCAV)
+          DD = DD+DMAX(KS)
+        END DO
+
+! ----------------------------------------------------------------------
+! VAL = (1.-EXP(-KDT*SQRT(DT1)))
+! IN BELOW, REMOVE THE SQRT IN ABOVE
+! ----------------------------------------------------------------------
+        VAL = (1.-EXP(-KDT*DT1))
+        DDT = DD*VAL
+        PX = PCPDRP*DT  
+        IF (PX .LT. 0.0) PX = 0.0
+        INFMAX = (PX*(DDT/(PX+DDT)))/DT
+          
+! ----------------------------------------------------------------------
+! FROZEN GROUND VERSION:
+! REDUCTION OF INFILTRATION BASED ON FROZEN GROUND PARAMETERS
+! ----------------------------------------------------------------------
+        FCR = 1. 
+        IF (DICE .GT. 1.E-2) THEN 
+          ACRT = CVFRZ * FRZX / DICE 
+          SUM = 1.
+          IALP1 = CVFRZ - 1 
+          DO J = 1,IALP1
+            K = 1
+            DO JJ = J+1,IALP1
+              K = K * JJ
+            END DO
+            SUM = SUM + (ACRT ** ( CVFRZ-J)) / FLOAT (K) 
+          END DO
+          FCR = 1. - EXP(-ACRT) * SUM 
+        ENDIF 
+        INFMAX = INFMAX * FCR
+
+! ----------------------------------------------------------------------
+! CORRECTION OF INFILTRATION LIMITATION:
+! IF INFMAX .LE. HYDROLIC CONDUCTIVITY ASSIGN INFMAX THE VALUE OF
+! HYDROLIC CONDUCTIVITY
+! ----------------------------------------------------------------------
+!         MXSMC = MAX ( SH2OA(1), SH2OA(2) ) 
+        MXSMC = SH2OA(1)
+
+        CALL WDFCND (WDF,WCND,MXSMC,SMCMAX,BEXP,DKSAT,DWSAT,            &
+     &               SICEMAX)
+
+        INFMAX = MAX(INFMAX,WCND)
+        INFMAX = MIN(INFMAX,PX)
+
+        IF (PCPDRP .GT. INFMAX) THEN
+          RUNOFF1 = PCPDRP - INFMAX
+          PDDUM = INFMAX
+        ENDIF
+
+      ENDIF
+
+! ----------------------------------------------------------------------
+! TO AVOID SPURIOUS DRAINAGE BEHAVIOR, 'UPSTREAM DIFFERENCING' IN LINE
+! BELOW REPLACED WITH NEW APPROACH IN 2ND LINE:
+! 'MXSMC = MAX(SH2OA(1), SH2OA(2))'
+! ----------------------------------------------------------------------
+      MXSMC = SH2OA(1)
+
+      CALL WDFCND (WDF,WCND,MXSMC,SMCMAX,BEXP,DKSAT,DWSAT,              &
+     &             SICEMAX)
+ 
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER
+! ----------------------------------------------------------------------
+      DDZ = 1. / ( -.5 * ZSOIL(2) )
+      AI(1) = 0.0
+      BI(1) = WDF * DDZ / ( -ZSOIL(1) )
+      CI(1) = -BI(1)
+
+! ----------------------------------------------------------------------
+! CALC RHSTT FOR THE TOP LAYER AFTER CALC'NG THE VERTICAL SOIL MOISTURE
+! GRADIENT BTWN THE TOP AND NEXT TO TOP LAYERS.
+! ----------------------------------------------------------------------
+      DSMDZ = ( SH2O(1) - SH2O(2) ) / ( -.5 * ZSOIL(2) )
+      RHSTT(1) = (WDF * DSMDZ + WCND - PDDUM + EDIR + ET(1))/ZSOIL(1)
+      SSTT = WDF * DSMDZ + WCND + EDIR + ET(1)
+
+! ----------------------------------------------------------------------
+! INITIALIZE DDZ2
+! ----------------------------------------------------------------------
+      DDZ2 = 0.0
+
+! ----------------------------------------------------------------------
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABV PROCESS
+! ----------------------------------------------------------------------
+      DO K = 2,NSOIL
+        DENOM2 = (ZSOIL(K-1) - ZSOIL(K))
+        IF (K .NE. NSOIL) THEN
+          SLOPX = 1.
+
+! ----------------------------------------------------------------------
+! AGAIN, TO AVOID SPURIOUS DRAINAGE BEHAVIOR, 'UPSTREAM DIFFERENCING' IN
+! LINE BELOW REPLACED WITH NEW APPROACH IN 2ND LINE:
+! 'MXSMC2 = MAX (SH2OA(K), SH2OA(K+1))'
+! ----------------------------------------------------------------------
+          MXSMC2 = SH2OA(K)
+
+          CALL WDFCND (WDF2,WCND2,MXSMC2,SMCMAX,BEXP,DKSAT,DWSAT,       &
+     &                 SICEMAX)
+
+! ----------------------------------------------------------------------
+! CALC SOME PARTIAL PRODUCTS FOR LATER USE IN CALC'NG RHSTT
+! ----------------------------------------------------------------------
+          DENOM = (ZSOIL(K-1) - ZSOIL(K+1))
+          DSMDZ2 = (SH2O(K) - SH2O(K+1)) / (DENOM * 0.5)
+
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT
+! ----------------------------------------------------------------------
+          DDZ2 = 2.0 / DENOM
+          CI(K) = -WDF2 * DDZ2 / DENOM2
+        ELSE
+
+! ----------------------------------------------------------------------
+! SLOPE OF BOTTOM LAYER IS INTRODUCED
+! ----------------------------------------------------------------------
+          SLOPX = SLOPE
+
+! ----------------------------------------------------------------------
+! RETRIEVE THE SOIL WATER DIFFUSIVITY AND HYDRAULIC CONDUCTIVITY FOR
+! THIS LAYER
+! ----------------------------------------------------------------------
+          CALL WDFCND (WDF2,WCND2,SH2OA(NSOIL),SMCMAX,BEXP,DKSAT,DWSAT, &
+     &                 SICEMAX)
+
+! ----------------------------------------------------------------------
+! CALC A PARTIAL PRODUCT FOR LATER USE IN CALC'NG RHSTT
+! ----------------------------------------------------------------------
+          DSMDZ2 = 0.0
+
+! ----------------------------------------------------------------------
+! SET MATRIX COEF CI TO ZERO
+! ----------------------------------------------------------------------
+          CI(K) = 0.0
+        ENDIF
+
+! ----------------------------------------------------------------------
+! CALC RHSTT FOR THIS LAYER AFTER CALC'NG ITS NUMERATOR
+! ----------------------------------------------------------------------
+        NUMER = (WDF2 * DSMDZ2) + SLOPX * WCND2 - (WDF * DSMDZ)         &
+     &    - WCND + ET(K)
+        RHSTT(K) = NUMER / (-DENOM2)
+
+! ----------------------------------------------------------------------
+! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER
+! ----------------------------------------------------------------------
+        AI(K) = -WDF * DDZ / DENOM2
+        BI(K) = -( AI(K) + CI(K) )
+
+! ----------------------------------------------------------------------
+! RESET VALUES OF WDF, WCND, DSMDZ, AND DDZ FOR LOOP TO NEXT LYR
+! RUNOFF2:  SUB-SURFACE OR BASEFLOW RUNOFF
+! ----------------------------------------------------------------------
+        IF (K .EQ. NSOIL) THEN
+          RUNOFF2 = SLOPX * WCND2
+        ENDIF
+
+        IF (K .NE. NSOIL) THEN
+          WDF = WDF2
+          WCND = WCND2
+          DSMDZ = DSMDZ2
+          DDZ = DDZ2
+        ENDIF
+      END DO
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE SRT
+! ----------------------------------------------------------------------
+      END SUBROUTINE SRT
+
+      SUBROUTINE SSTEP (SH2OOUT,SH2OIN,CMC,RHSTT,RHSCT,DT,              &
+     &                  NSOIL,SMCMAX,CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,     &
+     &                  AI,BI,CI)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SSTEP
+! ----------------------------------------------------------------------
+! CALCULATE/UPDATE SOIL MOISTURE CONTENT VALUES AND CANOPY MOISTURE
+! CONTENT VALUES.
+! ----------------------------------------------------------------------
+      INTEGER NSOLD
+      PARAMETER(NSOLD = 20)
+
+      INTEGER I
+      INTEGER K 
+      INTEGER KK11
+      INTEGER NSOIL
+
+      REAL AI(NSOLD)
+      REAL BI(NSOLD)
+      REAL CI(NSOLD)
+      REAL CIin(NSOLD)
+      REAL CMC
+      REAL CMCMAX
+      REAL DDZ
+      REAL DT
+      REAL RHSCT
+      REAL RHSTT(NSOIL)
+      REAL RHSTTin(NSOIL)
+      REAL RUNOFF3
+      REAL SH2OIN(NSOIL)
+      REAL SH2OOUT(NSOIL)
+      REAL SICE(NSOIL)
+      REAL SMC(NSOIL)
+      REAL SMCMAX
+      REAL STOT
+      REAL WPLUS
+      REAL ZSOIL(NSOIL)
+
+! ----------------------------------------------------------------------
+! CREATE 'AMOUNT' VALUES OF VARIABLES TO BE INPUT TO THE
+! TRI-DIAGONAL MATRIX ROUTINE.
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL
+        RHSTT(K) = RHSTT(K) * DT
+        AI(K) = AI(K) * DT
+        BI(K) = 1. + BI(K) * DT
+        CI(K) = CI(K) * DT
+      END DO
+
+! ----------------------------------------------------------------------
+! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL
+        RHSTTin(K) = RHSTT(K)
+      END DO
+      DO K = 1,NSOIL
+        CIin(K) = CI(K)
+      END DO
+
+! ----------------------------------------------------------------------
+! CALL ROSR12 TO SOLVE THE TRI-DIAGONAL MATRIX
+! ----------------------------------------------------------------------
+      CALL ROSR12 (CI,AI,BI,CIin,RHSTTin,RHSTT,NSOIL)
+
+! ----------------------------------------------------------------------
+! SUM THE PREVIOUS SMC VALUE AND THE MATRIX SOLUTION TO GET A
+! NEW VALUE.  MIN ALLOWABLE VALUE OF SMC WILL BE 0.02.
+! RUNOFF3: RUNOFF WITHIN SOIL LAYERS
+! ----------------------------------------------------------------------
+      WPLUS = 0.0
+      RUNOFF3 = 0.
+      DDZ = -ZSOIL(1)
+      
+      DO K = 1,NSOIL
+        IF (K .NE. 1) DDZ = ZSOIL(K - 1) - ZSOIL(K)
+        SH2OOUT(K) = SH2OIN(K) + CI(K) + WPLUS / DDZ
+
+        STOT = SH2OOUT(K) + SICE(K)
+        IF (STOT .GT. SMCMAX) THEN
+          IF (K .EQ. 1) THEN
+            DDZ = -ZSOIL(1)
+          ELSE
+            KK11 = K - 1
+            DDZ = -ZSOIL(K) + ZSOIL(KK11)
+          ENDIF
+          WPLUS = (STOT-SMCMAX) * DDZ
+        ELSE
+          WPLUS = 0.
+        ENDIF
+        SMC(K) = MAX ( MIN(STOT,SMCMAX),0.02 )
+        SH2OOUT(K) = MAX((SMC(K)-SICE(K)),0.0)
+      END DO
+
+      RUNOFF3 = WPLUS
+
+! ----------------------------------------------------------------------
+! UPDATE CANOPY WATER CONTENT/INTERCEPTION (CMC).  CONVERT RHSCT TO 
+! AN 'AMOUNT' VALUE AND ADD TO PREVIOUS CMC VALUE TO GET NEW CMC.
+! ----------------------------------------------------------------------
+      CMC = CMC + DT * RHSCT
+      IF (CMC .LT. 1.E-20) CMC=0.0
+      CMC = MIN(CMC,CMCMAX)
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE SSTEP
+! ----------------------------------------------------------------------
+      END SUBROUTINE SSTEP
+
+      SUBROUTINE TBND (TU,TB,ZSOIL,ZBOT,K,NSOIL,TBND1)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE TBND
+! ----------------------------------------------------------------------
+! CALCULATE TEMPERATURE ON THE BOUNDARY OF THE LAYER BY INTERPOLATION OF
+! THE MIDDLE LAYER TEMPERATURES
+! ----------------------------------------------------------------------
+      INTEGER NSOIL
+      INTEGER K
+
+      REAL TBND1
+      REAL T0
+      REAL TU
+      REAL TB
+      REAL ZB
+      REAL ZBOT
+      REAL ZUP
+      REAL ZSOIL (NSOIL)
+
+      PARAMETER(T0 = 273.15)
+
+! ----------------------------------------------------------------------
+! USE SURFACE TEMPERATURE ON THE TOP OF THE FIRST LAYER
+! ----------------------------------------------------------------------
+      IF (K .EQ. 1) THEN
+        ZUP = 0.
+      ELSE
+        ZUP = ZSOIL(K-1)
+      ENDIF
+
+! ----------------------------------------------------------------------
+! USE DEPTH OF THE CONSTANT BOTTOM TEMPERATURE WHEN INTERPOLATE
+! TEMPERATURE INTO THE LAST LAYER BOUNDARY
+! ----------------------------------------------------------------------
+      IF (K .EQ. NSOIL) THEN
+        ZB = 2.*ZBOT-ZSOIL(K)
+      ELSE
+        ZB = ZSOIL(K+1)
+      ENDIF
+
+! ----------------------------------------------------------------------
+! LINEAR INTERPOLATION BETWEEN THE AVERAGE LAYER TEMPERATURES
+! ----------------------------------------------------------------------
+      TBND1 = TU+(TB-TU)*(ZUP-ZSOIL(K))/(ZUP-ZB)
+      
+! ----------------------------------------------------------------------
+! END SUBROUTINE TBND
+! ----------------------------------------------------------------------
+      END SUBROUTINE TBND
+
+      SUBROUTINE TDFCND ( DF, SMC, QZ,  SMCMAX, SH2O)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE TDFCND
+! ----------------------------------------------------------------------
+! CALCULATE THERMAL DIFFUSIVITY AND CONDUCTIVITY OF THE SOIL FOR A GIVEN
+! POINT AND TIME.
+! ----------------------------------------------------------------------
+! PETERS-LIDARD APPROACH (PETERS-LIDARD et al., 1998)
+! June 2001 CHANGES: FROZEN SOIL CONDITION.
+! ----------------------------------------------------------------------
+       REAL DF
+       REAL GAMMD
+       REAL THKDRY
+       REAL AKE
+       REAL THKICE
+       REAL THKO
+       REAL THKQTZ
+       REAL THKSAT
+       REAL THKS
+       REAL THKW
+       REAL QZ
+       REAL SATRATIO
+       REAL SH2O
+       REAL SMC
+       REAL SMCMAX
+       REAL XU
+       REAL XUNFROZ
+
+! ----------------------------------------------------------------------
+! WE NOW GET QUARTZ AS AN INPUT ARGUMENT (SET IN ROUTINE REDPRM):
+!      DATA QUARTZ /0.82, 0.10, 0.25, 0.60, 0.52, 
+!     &             0.35, 0.60, 0.40, 0.82/
+! ----------------------------------------------------------------------
+! IF THE SOIL HAS ANY MOISTURE CONTENT COMPUTE A PARTIAL SUM/PRODUCT
+! OTHERWISE USE A CONSTANT VALUE WHICH WORKS WELL WITH MOST SOILS
+! ----------------------------------------------------------------------
+!  THKW ......WATER THERMAL CONDUCTIVITY
+!  THKQTZ ....THERMAL CONDUCTIVITY FOR QUARTZ
+!  THKO ......THERMAL CONDUCTIVITY FOR OTHER SOIL COMPONENTS
+!  THKS ......THERMAL CONDUCTIVITY FOR THE SOLIDS COMBINED(QUARTZ+OTHER)
+!  THKICE ....ICE THERMAL CONDUCTIVITY
+!  SMCMAX ....POROSITY (= SMCMAX)
+!  QZ .........QUARTZ CONTENT (SOIL TYPE DEPENDENT)
+! ----------------------------------------------------------------------
+! USE AS IN PETERS-LIDARD, 1998 (MODIF. FROM JOHANSEN, 1975).
+!
+!                                  PABLO GRUNMANN, 08/17/98
+! REFS.:
+!      FAROUKI, O.T.,1986: THERMAL PROPERTIES OF SOILS. SERIES ON ROCK 
+!              AND SOIL MECHANICS, VOL. 11, TRANS TECH, 136 PP.
+!      JOHANSEN, O., 1975: THERMAL CONDUCTIVITY OF SOILS. PH.D. THESIS,
+!              UNIVERSITY OF TRONDHEIM,
+!      PETERS-LIDARD, C. D., ET AL., 1998: THE EFFECT OF SOIL THERMAL 
+!              CONDUCTIVITY PARAMETERIZATION ON SURFACE ENERGY FLUXES
+!              AND TEMPERATURES. JOURNAL OF THE ATMOSPHERIC SCIENCES,
+!              VOL. 55, PP. 1209-1224.
+! ----------------------------------------------------------------------
+! NEEDS PARAMETERS
+! POROSITY(SOIL TYPE):
+!      POROS = SMCMAX
+! SATURATION RATIO:
+      SATRATIO = SMC/SMCMAX
+
+! PARAMETERS  W/(M.K)
+      THKICE = 2.2
+      THKW = 0.57
+      THKO = 2.0
+!      IF (QZ .LE. 0.2) THKO = 3.0
+      THKQTZ = 7.7
+! SOLIDS' CONDUCTIVITY      
+      THKS = (THKQTZ**QZ)*(THKO**(1.- QZ))
+
+! UNFROZEN FRACTION (FROM 1., i.e., 100%LIQUID, TO 0. (100% FROZEN))
+      XUNFROZ = (SH2O + 1.E-9) / (SMC + 1.E-9)
+
+! UNFROZEN VOLUME FOR SATURATION (POROSITY*XUNFROZ)
+      XU=XUNFROZ*SMCMAX 
+! SATURATED THERMAL CONDUCTIVITY
+      THKSAT = THKS**(1.-SMCMAX)*THKICE**(SMCMAX-XU)*THKW**(XU)
+
+! DRY DENSITY IN KG/M3
+      GAMMD = (1. - SMCMAX)*2700.
+
+! DRY THERMAL CONDUCTIVITY IN W.M-1.K-1
+      THKDRY = (0.135*GAMMD + 64.7)/(2700. - 0.947*GAMMD)
+
+      IF ( (SH2O + 0.0005) .LT. SMC ) THEN
+! FROZEN
+              AKE = SATRATIO
+      ELSE
+! UNFROZEN
+! RANGE OF VALIDITY FOR THE KERSTEN NUMBER (AKE)
+          IF ( SATRATIO .GT. 0.1 ) THEN
+
+! KERSTEN NUMBER (USING "FINE" FORMULA, VALID FOR SOILS CONTAINING AT 
+! LEAST 5% OF PARTICLES WITH DIAMETER LESS THAN 2.E-6 METERS.)
+! (FOR "COARSE" FORMULA, SEE PETERS-LIDARD ET AL., 1998).
+
+              AKE = LOG10(SATRATIO) + 1.0
+
+          ELSE
+
+! USE K = KDRY
+              AKE = 0.0
+
+          ENDIF
+      ENDIF
+
+!  THERMAL CONDUCTIVITY
+
+       DF = AKE*(THKSAT - THKDRY) + THKDRY
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE TDFCND
+! ----------------------------------------------------------------------
+      END SUBROUTINE TDFCND
+
+      SUBROUTINE TMPAVG (TAVG,TUP,TM,TDN,ZSOIL,NSOIL,K) 
+      
+      IMPLICIT NONE
+      
+! ----------------------------------------------------------------------
+! SUBROUTINE TMPAVG
+! ----------------------------------------------------------------------
+! CALCULATE SOIL LAYER AVERAGE TEMPERATURE (TAVG) IN FREEZING/THAWING
+! LAYER USING UP, DOWN, AND MIDDLE LAYER TEMPERATURES (TUP, TDN, TM),
+! WHERE TUP IS AT TOP BOUNDARY OF LAYER, TDN IS AT BOTTOM BOUNDARY OF
+! LAYER.  TM IS LAYER PROGNOSTIC STATE TEMPERATURE.
+! ----------------------------------------------------------------------
+      INTEGER K
+      INTEGER NSOIL
+
+      REAL DZ
+      REAL DZH
+      REAL T0
+      REAL TAVG
+      REAL TDN
+      REAL TM
+      REAL TUP
+      REAL X0
+      REAL XDN
+      REAL XUP
+      REAL ZSOIL (NSOIL)
+
+      PARAMETER(T0 = 2.7315E2)
+
+! ----------------------------------------------------------------------
+      IF (K .EQ. 1) THEN
+        DZ = -ZSOIL(1)
+      ELSE
+        DZ = ZSOIL(K-1)-ZSOIL(K)
+      ENDIF
+
+      DZH=DZ*0.5
+
+      IF (TUP .LT. T0) THEN
+        IF (TM .LT. T0) THEN
+          IF (TDN .LT. T0) THEN
+! ----------------------------------------------------------------------
+! TUP, TM, TDN < T0
+! ----------------------------------------------------------------------
+            TAVG = (TUP + 2.0*TM + TDN)/ 4.0            
+          ELSE
+! ----------------------------------------------------------------------
+! TUP & TM < T0,  TDN >= T0
+! ----------------------------------------------------------------------
+            X0 = (T0 - TM) * DZH / (TDN - TM)
+            TAVG = 0.5 * (TUP*DZH+TM*(DZH+X0)+T0*(2.*DZH-X0)) / DZ
+          ENDIF      
+        ELSE
+          IF (TDN .LT. T0) THEN
+! ----------------------------------------------------------------------
+! TUP < T0, TM >= T0, TDN < T0
+! ----------------------------------------------------------------------
+            XUP  = (T0-TUP) * DZH / (TM-TUP)
+            XDN  = DZH - (T0-TM) * DZH / (TDN-TM)
+            TAVG = 0.5 * (TUP*XUP+T0*(2.*DZ-XUP-XDN)+TDN*XDN) / DZ
+          ELSE
+! ----------------------------------------------------------------------
+! TUP < T0, TM >= T0, TDN >= T0
+! ----------------------------------------------------------------------
+            XUP  = (T0-TUP) * DZH / (TM-TUP)
+            TAVG = 0.5 * (TUP*XUP+T0*(2.*DZ-XUP)) / DZ
+          ENDIF   
+        ENDIF
+      ELSE
+        IF (TM .LT. T0) THEN
+          IF (TDN .LT. T0) THEN
+! ----------------------------------------------------------------------
+! TUP >= T0, TM < T0, TDN < T0
+! ----------------------------------------------------------------------
+            XUP  = DZH - (T0-TUP) * DZH / (TM-TUP)
+            TAVG = 0.5 * (T0*(DZ-XUP)+TM*(DZH+XUP)+TDN*DZH) / DZ
+          ELSE
+! ----------------------------------------------------------------------
+! TUP >= T0, TM < T0, TDN >= T0
+! ----------------------------------------------------------------------
+            XUP  = DZH - (T0-TUP) * DZH / (TM-TUP)
+            XDN  = (T0-TM) * DZH / (TDN-TM)
+            TAVG = 0.5 * (T0*(2.*DZ-XUP-XDN)+TM*(XUP+XDN)) / DZ
+          ENDIF   
+        ELSE
+          IF (TDN .LT. T0) THEN
+! ----------------------------------------------------------------------
+! TUP >= T0, TM >= T0, TDN < T0
+! ----------------------------------------------------------------------
+            XDN  = DZH - (T0-TM) * DZH / (TDN-TM)
+            TAVG = (T0*(DZ-XDN)+0.5*(T0+TDN)*XDN) / DZ                 
+          ELSE
+! ----------------------------------------------------------------------
+! TUP >= T0, TM >= T0, TDN >= T0
+! ----------------------------------------------------------------------
+            TAVG = (TUP + 2.0*TM + TDN) / 4.0
+          ENDIF
+        ENDIF
+      ENDIF
+! ----------------------------------------------------------------------
+! END SUBROUTINE TMPAVG
+! ----------------------------------------------------------------------
+      END SUBROUTINE TMPAVG
+
+      SUBROUTINE TRANSP (ET1,NSOIL,ETP1,SMC,CMC,ZSOIL,SHDFAC,SMCWLT,    &
+     &                   CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT,RTDIS)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE TRANSP
+! ----------------------------------------------------------------------
+! CALCULATE TRANSPIRATION FOR THE VEG CLASS.
+! ----------------------------------------------------------------------
+      INTEGER I
+      INTEGER K
+      INTEGER NSOIL
+      INTEGER NROOT
+
+      REAL CFACTR
+      REAL CMC
+      REAL CMCMAX
+      REAL DENOM
+      REAL ET1(NSOIL)
+      REAL ETP1
+      REAL ETP1A
+      REAL GX (7)
+!.....REAL PART(NSOIL)
+      REAL PC
+      REAL Q2
+      REAL RTDIS(NSOIL)
+      REAL RTX
+      REAL SFCTMP
+      REAL SGX
+      REAL SHDFAC
+      REAL SMC(NSOIL)
+      REAL SMCREF
+      REAL SMCWLT
+      REAL ZSOIL(NSOIL)
+
+! ----------------------------------------------------------------------
+! INITIALIZE PLANT TRANSP TO ZERO FOR ALL SOIL LAYERS.
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL
+        ET1(K) = 0.
+      END DO
+
+! ----------------------------------------------------------------------
+! CALCULATE AN 'ADJUSTED' POTENTIAL TRANSPIRATION
+! IF STATEMENT BELOW TO AVOID TANGENT LINEAR PROBLEMS NEAR ZERO
+! NOTE: GX AND OTHER TERMS BELOW REDISTRIBUTE TRANSPIRATION BY LAYER,
+! ET(K), AS A FUNCTION OF SOIL MOISTURE AVAILABILITY, WHILE PRESERVING
+! TOTAL ETP1A.
+! ----------------------------------------------------------------------
+      IF (CMC .NE. 0.0) THEN
+        ETP1A = SHDFAC * PC * ETP1 * (1.0 - (CMC /CMCMAX) ** CFACTR)
+      ELSE
+        ETP1A = SHDFAC * PC * ETP1
+      ENDIF
+      
+      SGX = 0.0
+      DO I = 1,NROOT
+        GX(I) = ( SMC(I) - SMCWLT ) / ( SMCREF - SMCWLT )
+        GX(I) = MAX ( MIN ( GX(I), 1. ), 0. )
+        SGX = SGX + GX (I)
+      END DO
+      SGX = SGX / NROOT
+      
+      DENOM = 0.
+      DO I = 1,NROOT
+        RTX = RTDIS(I) + GX(I) - SGX
+        GX(I) = GX(I) * MAX ( RTX, 0. )
+        DENOM = DENOM + GX(I)
+      END DO
+      IF (DENOM .LE. 0.0) DENOM = 1.
+
+      DO I = 1,NROOT
+        ET1(I) = ETP1A * GX(I) / DENOM
+      END DO
+
+! ----------------------------------------------------------------------
+! ABOVE CODE ASSUMES A VERTICALLY UNIFORM ROOT DISTRIBUTION
+! CODE BELOW TESTS A VARIABLE ROOT DISTRIBUTION
+! ----------------------------------------------------------------------
+!      ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * GX * ETP1A
+!      ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * ETP1A
+! ----------------------------------------------------------------------
+! USING ROOT DISTRIBUTION AS WEIGHTING FACTOR
+! ----------------------------------------------------------------------
+!      ET(1) = RTDIS(1) * ETP1A
+!      ET(1) = ETP1A * PART(1)
+! ----------------------------------------------------------------------
+! LOOP DOWN THRU THE SOIL LAYERS REPEATING THE OPERATION ABOVE,
+! BUT USING THE THICKNESS OF THE SOIL LAYER (RATHER THAN THE
+! ABSOLUTE DEPTH OF EACH LAYER) IN THE FINAL CALCULATION.
+! ----------------------------------------------------------------------
+!      DO K = 2,NROOT
+!        GX = ( SMC(K) - SMCWLT ) / ( SMCREF - SMCWLT )
+!        GX = MAX ( MIN ( GX, 1. ), 0. )
+! TEST CANOPY RESISTANCE
+!        GX = 1.0
+!        ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*GX*ETP1A
+!        ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*ETP1A
+! ----------------------------------------------------------------------
+! USING ROOT DISTRIBUTION AS WEIGHTING FACTOR
+! ----------------------------------------------------------------------
+!        ET(K) = RTDIS(K) * ETP1A
+!        ET(K) = ETP1A*PART(K)
+!      END DO      
+! ----------------------------------------------------------------------
+! END SUBROUTINE TRANSP
+! ----------------------------------------------------------------------
+      END SUBROUTINE TRANSP
+
+      SUBROUTINE WDFCND (WDF,WCND,SMC,SMCMAX,BEXP,DKSAT,DWSAT,          &
+     &                   SICEMAX)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SUBROUTINE WDFCND
+! ----------------------------------------------------------------------
+! CALCULATE SOIL WATER DIFFUSIVITY AND SOIL HYDRAULIC CONDUCTIVITY.
+! ----------------------------------------------------------------------
+      REAL BEXP
+      REAL DKSAT
+      REAL DWSAT
+      REAL EXPON
+      REAL FACTR1
+      REAL FACTR2
+      REAL SICEMAX
+      REAL SMC
+      REAL SMCMAX
+      REAL VKwgt
+      REAL WCND
+      REAL WDF
+
+! ----------------------------------------------------------------------
+!     CALC THE RATIO OF THE ACTUAL TO THE MAX PSBL SOIL H2O CONTENT
+! ----------------------------------------------------------------------
+      SMC = SMC
+      SMCMAX = SMCMAX
+      FACTR1 = 0.2 / SMCMAX
+      FACTR2 = SMC / SMCMAX
+
+! ----------------------------------------------------------------------
+! PREP AN EXPNTL COEF AND CALC THE SOIL WATER DIFFUSIVITY
+! ----------------------------------------------------------------------
+      EXPON = BEXP + 2.0
+      WDF = DWSAT * FACTR2 ** EXPON
+
+! ----------------------------------------------------------------------
+! FROZEN SOIL HYDRAULIC DIFFUSIVITY.  VERY SENSITIVE TO THE VERTICAL
+! GRADIENT OF UNFROZEN WATER. THE LATTER GRADIENT CAN BECOME VERY
+! EXTREME IN FREEZING/THAWING SITUATIONS, AND GIVEN THE RELATIVELY 
+! FEW AND THICK SOIL LAYERS, THIS GRADIENT SUFFERES SERIOUS 
+! TRUNCTION ERRORS YIELDING ERRONEOUSLY HIGH VERTICAL TRANSPORTS OF
+! UNFROZEN WATER IN BOTH DIRECTIONS FROM HUGE HYDRAULIC DIFFUSIVITY.  
+! THEREFORE, WE FOUND WE HAD TO ARBITRARILY CONSTRAIN WDF 
+! --
+! VERSION D_10CM: ........  FACTR1 = 0.2/SMCMAX
+! WEIGHTED APPROACH...................... PABLO GRUNMANN, 28_SEP_1999.
+! ----------------------------------------------------------------------
+      IF (SICEMAX .GT. 0.0)  THEN
+        VKWGT = 1./(1.+(500.*SICEMAX)**3.)
+        WDF = VKWGT*WDF + (1.- VKWGT)*DWSAT*FACTR1**EXPON
+      ENDIF
+
+! ----------------------------------------------------------------------
+! RESET THE EXPNTL COEF AND CALC THE HYDRAULIC CONDUCTIVITY
+! ----------------------------------------------------------------------
+      EXPON = (2.0 * BEXP) + 3.0
+      WCND = DKSAT * FACTR2 ** EXPON
+
+! ----------------------------------------------------------------------
+! END SUBROUTINE WDFCND
+! ----------------------------------------------------------------------
+      END SUBROUTINE WDFCND
+
+  SUBROUTINE nmmlsminit(isn,XICE,VEGFRA,SNOW,SNOWC,CANWAT,SMSTAV,       &
+                        SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW,       &
+                        ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,DZS,SFCEVP,     & !  STEMP
+                        TMN,                                            &
+                        num_soil_layers,                                &
+                        allowed_to_read,                                &
+                        ids,ide, jds,jde, kds,kde,                      &
+                        ims,ime, jms,jme, kms,kme,                      &
+                        its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE 
+
+! Arguments
+   INTEGER,  INTENT(IN   )   ::     ids,ide, jds,jde, kds,kde,  &
+                                    ims,ime, jms,jme, kms,kme,  &
+                                    its,ite, jts,jte, kts,kte
+
+   INTEGER, INTENT(IN)       ::     num_soil_layers
+
+   REAL,    DIMENSION( num_soil_layers), INTENT(IN) :: DZS
+
+   REAL,    DIMENSION( ims:ime, num_soil_layers, jms:jme )    , &
+            INTENT(INOUT)    ::                          SMOIS, & 
+                                                         TSLB      !STEMP
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                           SNOW, & 
+                                                         SNOWC, & 
+                                                        CANWAT, &
+                                                        SMSTAV, &
+                                                        SMSTOT, &
+                                                     SFCRUNOFF, &
+                                                      UDRUNOFF, &
+                                                        SFCEVP, &
+                                                        GRDFLX, &
+                                                        ACSNOW, &
+                                                          XICE, &
+                                                        VEGFRA, &
+                                                        TMN, &
+                                                        ACSNOM
+
+   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                         IVGTYP, &
+                                                        ISLTYP
+
+!
+
+  INTEGER, INTENT(IN) :: isn
+  LOGICAL, INTENT(IN) :: allowed_to_read
+! Local
+  INTEGER             :: iseason
+  INTEGER :: icm,jcm,itf,jtf
+  INTEGER ::  I,J,L
+
+
+   itf=min0(ite,ide-1)
+   jtf=min0(jte,jde-1)
+
+   icm = ide/2
+   jcm = jde/2
+
+   iseason=isn
+
+   DO J=jts,jtf
+       DO I=its,itf
+!      SNOW(i,j)=0.
+       SNOWC(i,j)=0.
+!      SMSTAV(i,j)=
+!      SMSTOT(i,j)=
+!      SFCRUNOFF(i,j)=
+!      UDRUNOFF(i,j)=
+!      GRDFLX(i,j)=
+!      ACSNOW(i,j)=
+!      ACSNOM(i,j)=
+    ENDDO
+   ENDDO
+
+  END SUBROUTINE nmmlsminit
+
+      FUNCTION CSNOW (DSNOW)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! FUNCTION CSNOW
+! ----------------------------------------------------------------------
+! CALCULATE SNOW TERMAL CONDUCTIVITY
+! ----------------------------------------------------------------------
+      REAL C
+      REAL DSNOW
+      REAL CSNOW
+      REAL UNIT
+
+      PARAMETER(UNIT = 0.11631) 
+                                         
+! ----------------------------------------------------------------------
+! CSNOW IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C)
+! BASIC VERSION IS DYACHKOVA EQUATION (1960), FOR RANGE 0.1-0.4
+! ----------------------------------------------------------------------
+      C=0.328*10**(2.25*DSNOW)
+!      CSNOW=UNIT*C
+! MEK JAN 2006, DOUBLE SNOW THERMAL CONDUCTIVITY
+      CSNOW=2.0*UNIT*C
+
+! ----------------------------------------------------------------------
+! DE VAUX EQUATION (1933), IN RANGE 0.1-0.6
+! ----------------------------------------------------------------------
+!      CSNOW=0.0293*(1.+100.*DSNOW**2)
+      
+! ----------------------------------------------------------------------
+! E. ANDERSEN FROM FLERCHINGER
+! ----------------------------------------------------------------------
+!      CSNOW=0.021+2.51*DSNOW**2        
+      
+! ----------------------------------------------------------------------
+! END FUNCTION CSNOW
+! ----------------------------------------------------------------------
+      END FUNCTION CSNOW
+
+      FUNCTION FRH2O (TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS)
+
+      IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! FUNCTION FRH2O
+! ----------------------------------------------------------------------
+! CALCULATE AMOUNT OF SUPERCOOLED LIQUID SOIL WATER CONTENT IF
+! TEMPERATURE IS BELOW 273.15K (T0).  REQUIRES NEWTON-TYPE ITERATION TO
+! SOLVE THE NONLINEAR IMPLICIT EQUATION GIVEN IN EQN 17 OF KOREN ET AL
+! (1999, JGR, VOL 104(D16), 19569-19585).
+! ----------------------------------------------------------------------
+! NEW VERSION (JUNE 2001): MUCH FASTER AND MORE ACCURATE NEWTON
+! ITERATION ACHIEVED BY FIRST TAKING LOG OF EQN CITED ABOVE -- LESS THAN
+! 4 (TYPICALLY 1 OR 2) ITERATIONS ACHIEVES CONVERGENCE.  ALSO, EXPLICIT
+! 1-STEP SOLUTION OPTION FOR SPECIAL CASE OF PARAMETER CK=0, WHICH
+! REDUCES THE ORIGINAL IMPLICIT EQUATION TO A SIMPLER EXPLICIT FORM,
+! KNOWN AS THE "FLERCHINGER EQN". IMPROVED HANDLING OF SOLUTION IN THE
+! LIMIT OF FREEZING POINT TEMPERATURE T0.
+! ----------------------------------------------------------------------
+! INPUT:
+!
+!   TKELV.........TEMPERATURE (Kelvin)
+!   SMC...........TOTAL SOIL MOISTURE CONTENT (VOLUMETRIC)
+!   SH2O..........LIQUID SOIL MOISTURE CONTENT (VOLUMETRIC)
+!   SMCMAX........SATURATION SOIL MOISTURE CONTENT (FROM REDPRM)
+!   B.............SOIL TYPE "B" PARAMETER (FROM REDPRM)
+!   PSIS..........SATURATED SOIL MATRIC POTENTIAL (FROM REDPRM)
+!
+! OUTPUT:
+!   FRH2O.........SUPERCOOLED LIQUID WATER CONTENT
+! ----------------------------------------------------------------------
+      REAL BEXP
+      REAL BLIM
+      REAL BX
+      REAL CK
+      REAL DENOM
+      REAL DF
+      REAL DH2O
+      REAL DICE
+      REAL DSWL
+      REAL ERROR
+      REAL FK
+      REAL FRH2O
+      REAL GS
+      REAL HLICE
+      REAL PSIS
+      REAL SH2O
+      REAL SMC
+      REAL SMCMAX
+      REAL SWL
+      REAL SWLK
+      REAL TKELV
+      REAL T0
+
+      INTEGER NLOG
+      INTEGER KCOUNT
+
+      PARAMETER(CK = 8.0)
+!      PARAMETER(CK = 0.0)
+      PARAMETER(BLIM = 5.5)
+      PARAMETER(ERROR = 0.005)
+
+      PARAMETER(HLICE = 3.335E5)
+      PARAMETER(GS = 9.81)
+      PARAMETER(DICE = 920.0)
+      PARAMETER(DH2O = 1000.0)
+      PARAMETER(T0 = 273.15)
+
+! ----------------------------------------------------------------------
+! LIMITS ON PARAMETER B: B < 5.5  (use parameter BLIM)
+! SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT IS
+! NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES.
+! ----------------------------------------------------------------------
+      BX = BEXP
+      IF (BEXP .GT. BLIM) BX = BLIM
+
+! ----------------------------------------------------------------------
+! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG.
+! ----------------------------------------------------------------------
+      NLOG=0
+      KCOUNT=0
+
+! ----------------------------------------------------------------------
+!  IF TEMPERATURE NOT SIGNIFICANTLY BELOW FREEZING (T0), SH2O = SMC
+! ----------------------------------------------------------------------
+      IF (TKELV .GT. (T0 - 1.E-3)) THEN
+ 	FRH2O = SMC
+      ELSE
+        IF (CK .NE. 0.0) THEN
+
+! ----------------------------------------------------------------------
+! OPTION 1: ITERATED SOLUTION FOR NONZERO CK
+! IN KOREN ET AL, JGR, 1999, EQN 17
+! ----------------------------------------------------------------------
+! INITIAL GUESS FOR SWL (frozen content)
+! ----------------------------------------------------------------------
+          SWL = SMC-SH2O
+
+! ----------------------------------------------------------------------
+! KEEP WITHIN BOUNDS.
+! ----------------------------------------------------------------------
+          IF (SWL .GT. (SMC-0.02)) SWL = SMC-0.02
+          IF (SWL .LT. 0.) SWL = 0.
+
+! ----------------------------------------------------------------------
+!  START OF ITERATIONS
+! ----------------------------------------------------------------------
+          DO WHILE ( (NLOG .LT. 10) .AND. (KCOUNT .EQ. 0) )
+            NLOG = NLOG+1
+            DF = ALOG(( PSIS*GS/HLICE ) * ( ( 1.+CK*SWL )**2. ) *       &
+     &        ( SMCMAX/(SMC-SWL) )**BX) - ALOG(-(TKELV-T0)/TKELV)
+            DENOM = 2. * CK / ( 1.+CK*SWL ) + BX / ( SMC - SWL )
+            SWLK = SWL - DF/DENOM
+! ----------------------------------------------------------------------
+! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION.
+! ----------------------------------------------------------------------
+            IF (SWLK .GT. (SMC-0.02)) SWLK = SMC - 0.02
+            IF (SWLK .LT. 0.) SWLK = 0.
+
+! ----------------------------------------------------------------------
+! MATHEMATICAL SOLUTION BOUNDS APPLIED.
+! ----------------------------------------------------------------------
+            DSWL = ABS(SWLK-SWL)
+            SWL = SWLK
+
+! ----------------------------------------------------------------------
+! IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.)
+! WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED.
+! ----------------------------------------------------------------------
+            IF ( DSWL .LE. ERROR )  THEN
+ 	      KCOUNT = KCOUNT+1
+            ENDIF
+          END DO
+
+! ----------------------------------------------------------------------
+!  END OF ITERATIONS
+! ----------------------------------------------------------------------
+! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION.
+! ----------------------------------------------------------------------
+          FRH2O = SMC - SWL
+
+! ----------------------------------------------------------------------
+! END OPTION 1
+! ----------------------------------------------------------------------
+        ENDIF
+
+! ----------------------------------------------------------------------
+! OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0
+! IN KOREN ET AL., JGR, 1999, EQN 17
+! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION
+! ----------------------------------------------------------------------
+        IF (KCOUNT .EQ. 0) THEN
+          Print*,'Flerchinger used in NEW version. Iterations=',NLOG
+ 	  FK = (((HLICE/(GS*(-PSIS)))*                                  &
+     &      ((TKELV-T0)/TKELV))**(-1/BX))*SMCMAX
+ 	  IF (FK .LT. 0.02) FK = 0.02
+ 	  FRH2O = MIN (FK, SMC)
+! ----------------------------------------------------------------------
+! END OPTION 2
+! ----------------------------------------------------------------------
+        ENDIF
+
+      ENDIF
+
+! ----------------------------------------------------------------------
+! END FUNCTION FRH2O
+! ----------------------------------------------------------------------
+      END FUNCTION FRH2O
+
+      FUNCTION SNKSRC (TAVG,SMC,SH2O,ZSOIL,NSOIL,                       &
+     &                 SMCMAX,PSISAT,BEXP,DT,K,QTOT) 
+      
+      IMPLICIT NONE
+      
+! ----------------------------------------------------------------------
+! FUNCTION SNKSRC
+! ----------------------------------------------------------------------
+! CALCULATE SINK/SOURCE TERM OF THE TERMAL DIFFUSION EQUATION. (SH2O) IS
+! AVAILABLE LIQUED WATER.
+! ----------------------------------------------------------------------
+      INTEGER K
+      INTEGER NSOIL
+      
+      REAL BEXP
+      REAL DF
+      REAL DH2O
+      REAL DT
+      REAL DZ
+      REAL DZH
+      REAL FREE
+!      REAL FRH2O
+      REAL HLICE
+      REAL PSISAT
+      REAL QTOT
+      REAL SH2O
+      REAL SMC
+      REAL SMCMAX
+      REAL SNKSRC
+      REAL T0
+      REAL TAVG
+      REAL TDN
+      REAL TM
+      REAL TUP
+      REAL TZ
+      REAL X0
+      REAL XDN
+      REAL XH2O
+      REAL XUP
+      REAL ZSOIL (NSOIL)
+
+      PARAMETER(DH2O = 1.0000E3)
+      PARAMETER(HLICE = 3.3350E5)
+      PARAMETER(T0 = 2.7315E2)
+      
+      IF (K .EQ. 1) THEN
+        DZ = -ZSOIL(1)
+      ELSE
+        DZ = ZSOIL(K-1)-ZSOIL(K)
+      ENDIF
+
+! ----------------------------------------------------------------------
+! VIA FUNCTION FRH2O, COMPUTE POTENTIAL OR 'EQUILIBRIUM' UNFROZEN
+! SUPERCOOLED FREE WATER FOR GIVEN SOIL TYPE AND SOIL LAYER TEMPERATURE.
+! FUNCTION FRH20 INVOKES EQN (17) FROM V. KOREN ET AL (1999, JGR, VOL.
+! 104, PG 19573).  (ASIDE:  LATTER EQN IN JOURNAL IN CENTIGRADE UNITS.
+! ROUTINE FRH2O USE FORM OF EQN IN KELVIN UNITS.)
+! ----------------------------------------------------------------------
+      FREE = FRH2O(TAVG,SMC,SH2O,SMCMAX,BEXP,PSISAT)
+
+! ----------------------------------------------------------------------
+! IN NEXT BLOCK OF CODE, INVOKE EQN 18 OF V. KOREN ET AL (1999, JGR,
+! VOL. 104, PG 19573.)  THAT IS, FIRST ESTIMATE THE NEW AMOUNTOF LIQUID
+! WATER, 'XH2O', IMPLIED BY THE SUM OF (1) THE LIQUID WATER AT THE BEGIN
+! OF CURRENT TIME STEP, AND (2) THE FREEZE OF THAW CHANGE IN LIQUID
+! WATER IMPLIED BY THE HEAT FLUX 'QTOT' PASSED IN FROM ROUTINE HRT.
+! SECOND, DETERMINE IF XH2O NEEDS TO BE BOUNDED BY 'FREE' (EQUIL AMT) OR
+! IF 'FREE' NEEDS TO BE BOUNDED BY XH2O.
+! ----------------------------------------------------------------------
+      XH2O = SH2O + QTOT*DT/(DH2O*HLICE*DZ)
+
+! ----------------------------------------------------------------------
+! FIRST, IF FREEZING AND REMAINING LIQUID LESS THAN LOWER BOUND, THEN
+! REDUCE EXTENT OF FREEZING, THEREBY LETTING SOME OR ALL OF HEAT FLUX
+! QTOT COOL THE SOIL TEMP LATER IN ROUTINE HRT.
+! ----------------------------------------------------------------------
+      IF ( XH2O .LT. SH2O .AND. XH2O .LT. FREE) THEN 
+        IF ( FREE .GT. SH2O ) THEN
+          XH2O = SH2O
+        ELSE
+          XH2O = FREE
+        ENDIF
+      ENDIF
+              
+! ----------------------------------------------------------------------
+! SECOND, IF THAWING AND THE INCREASE IN LIQUID WATER GREATER THAN UPPER
+! BOUND, THEN REDUCE EXTENT OF THAW, THEREBY LETTING SOME OR ALL OF HEAT
+! FLUX QTOT WARM THE SOIL TEMP LATER IN ROUTINE HRT.
+! ----------------------------------------------------------------------
+      IF ( XH2O .GT. SH2O .AND. XH2O .GT. FREE )  THEN
+        IF ( FREE .LT. SH2O ) THEN
+          XH2O = SH2O
+        ELSE
+          XH2O = FREE
+        ENDIF
+      ENDIF 
+
+      IF (XH2O .LT. 0.) XH2O = 0.
+      IF (XH2O .GT. SMC) XH2O = SMC
+
+! ----------------------------------------------------------------------
+! CALCULATE PHASE-CHANGE HEAT SOURCE/SINK TERM FOR USE IN ROUTINE HRT
+! AND UPDATE LIQUID WATER TO REFLCET FINAL FREEZE/THAW INCREMENT.
+! ----------------------------------------------------------------------
+      SNKSRC = -DH2O*HLICE*DZ*(XH2O-SH2O)/DT
+      SH2O = XH2O
+      
+! ----------------------------------------------------------------------
+! END FUNCTION SNKSRC
+! ----------------------------------------------------------------------
+      END FUNCTION SNKSRC
+
+END MODULE module_sf_lsm_nmm
+
Index: trunk/WRF.COMMON/WRFV2/phys/module_sf_myjsfc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_sf_myjsfc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_sf_myjsfc.F	(revision 2744)
@@ -0,0 +1,1231 @@
+!----------------------------------------------------------------------
+!
+      MODULE MODULE_SF_MYJSFC
+!
+!----------------------------------------------------------------------
+!
+      USE MODULE_MODEL_CONSTANTS
+      USE MODULE_DM, ONLY : WRF_DM_MAXVAL
+!
+!----------------------------------------------------------------------
+!
+! REFERENCES:  Janjic (2002), NCEP Office Note 437
+!
+! ABSTRACT:
+!     MYJSFC GENERATES THE SURFACE EXCHANGE COEFFICIENTS FOR VERTICAL
+!     TURBULENT EXCHANGE BASED UPON MONIN_OBUKHOV THEORY WITH
+!     VARIOUS REFINEMENTS.
+!
+!----------------------------------------------------------------------
+!
+      INTEGER :: ITRMX=5 ! Iteration count for sfc layer computations
+!
+      REAL,PARAMETER :: VKARMAN=0.4
+      REAL,PARAMETER :: CAPA=R_D/CP,ELOCP=2.72E6/CP,RCAP=1./CAPA
+      REAL,PARAMETER :: GOCP02=G/CP*2.,GOCP10=G/CP*10.
+!      REAL,PARAMETER :: EPSU2=1.E-4,EPSUST=0.07,EPSZT=1.E-5
+!	ECMWF sets lower limit on ln(Z0h)=-20 --> EPSZT=2.e-9
+      REAL,PARAMETER :: EPSU2=1.E-6,EPSUST=1.e-9,EPSZT=1.E-28
+      REAL,PARAMETER :: A2S=17.2693882,A3S=273.16,A4S=35.86
+      REAL,PARAMETER :: SEAFC=0.98,PQ0SEA=PQ0*SEAFC
+      REAL,PARAMETER :: BETA=1./273.,CZIL=0.1,EXCML=0.0001,EXCMS=0.0001  &
+!old      REAL,PARAMETER :: BETA=1./273.,CZIL=0.1,EXCML=0.001,EXCMS=0.001  &
+     &                 ,GLKBR=10.,GLKBS=30.,PI=3.1415926               &
+     &                 ,QVISC=2.1E-5,RIC=0.505,SMALL=0.35              &
+     &                 ,SQPR=0.84,SQSC=0.84,SQVISC=258.2,TVISC=2.1E-5  &
+     &                 ,USTC=0.7,USTR=0.225,VISC=1.5E-5,FH=1.01        &
+     &                 ,WWST=1.2,ZTFC=1.,TOPOFAC=9.0e-6
+!
+      REAL,PARAMETER :: BTG=BETA*G,CZIV=SMALL*GLKBS                    &
+     &                 ,GRRS=GLKBR/GLKBS                               &
+     &                 ,RTVISC=1./TVISC,RVISC=1./VISC                  &
+     &                 ,ZQRZT=SQSC/SQPR                                &
+     &                 ,FZQ1=RTVISC*QVISC*ZQRZT                        &
+     &                 ,FZQ2=RTVISC*QVISC*ZQRZT                        &
+     &                 ,FZT1=RVISC *TVISC*SQPR                         &
+     &                 ,FZT2=CZIV*GRRS*TVISC*SQPR                      &
+     &                 ,FZU1=CZIV*VISC                                 &
+     &                 ,PIHF=0.5*PI                                    &
+     &                 ,RQVISC=1./QVISC                                &
+     &                 ,USTFC=0.018/G                                  &
+     &                 ,WWST2=WWST*WWST                                &
+     &                 ,ZILFC=-CZIL*VKARMAN*SQVISC
+!
+!----------------------------------------------------------------------
+      INTEGER, PARAMETER :: KZTM=10001,KZTM2=KZTM-2
+!
+      REAL :: DZETA1,DZETA2,FH01,FH02,ZTMAX1,ZTMAX2,ZTMIN1,ZTMIN2
+!
+      REAL,DIMENSION(KZTM) :: PSIH1,PSIH2,PSIM1,PSIM2
+!
+!----------------------------------------------------------------------
+!
+CONTAINS
+!
+!----------------------------------------------------------------------
+      SUBROUTINE MYJSFC(ITIMESTEP,HT,DZ                                & 
+     &                 ,PMID,PINT,TH,T,QV,QC,U,V,Q2                    &
+     &                 ,TSK,QSFC,THZ0,QZ0,UZ0,VZ0                      &
+     &                 ,LOWLYR,XLAND                                   &
+     &                 ,USTAR,ZNT,Z0BASE,PBLH,MAVAIL,RMOL              &
+     &                 ,AKHS,AKMS                                      &
+     &                 ,CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC         &
+     &                 ,QGH,CPM,CT                                     &
+     &                 ,U10,V10,T02,TH02,TSHLTR,TH10,Q02,QSHLTR,Q10,PSHLTR          &
+     &                 ,IDS,IDE,JDS,JDE,KDS,KDE                        &
+     &                 ,IMS,IME,JMS,JME,KMS,KME                        &
+     &                 ,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,INTENT(IN) :: ITIMESTEP
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LOWLYR
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HT,MAVAIL,TSK      &
+     &                                             ,XLAND,Z0BASE
+!
+      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DZ         &
+     &                                                     ,PMID,PINT  &
+     &                                                     ,Q2,QC,QV   &
+     &                                                     ,T,TH       &
+     &                                                     ,U,V   
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: FLX_LH,HFX,PSHLTR &
+     &                                              ,QFX,Q10,QSHLTR    &
+     &                                              ,TH10,TSHLTR,T02       &
+     &                                              ,U10,V10,TH02,Q02
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: AKHS,AKMS       &
+     &                                                ,PBLH,QSFC
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: QZ0,RMOL,THZ0   &
+     &                                                ,USTAR,UZ0,VZ0   &
+     &                                                ,ZNT
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CHS,CHS2,CQS2     &
+     &                                              ,CPM,CT,FLHC,FLQC  &
+     &                                              ,QGH 
+!----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      INTEGER :: I,J,K,KFLIP,LMH,LPBL,NTSD
+!
+      REAL :: A,APESFC,B,BTGX,CWMLOW                                   &
+     &       ,DQDT,DTDIF,DTDT,DUDT,DVDT                                &
+     &       ,FIS                                                      &
+     &       ,P02P,P10P,PLOW,PSFC,PTOP,QLOW,QS02,QS10                  &
+     &       ,RAPA,RAPA02,RAPA10,RATIOMX,RDZ,SEAMASK,SM                &
+     &       ,T02P,T10P,TEM,TH02P,TH10P,THLOW,THELOW,THM               &
+     &       ,TLOW,TZ0,ULOW,VLOW,ZSL
+!
+      REAL,DIMENSION(KTS:KTE) :: CWMK,PK,Q2K,QK,THEK,THK,TK,UK,VK
+!
+      REAL,DIMENSION(KTS:KTE-1) :: EL,ELM
+!
+      REAL,DIMENSION(KTS:KTE+1) :: ZHK
+!
+      REAL,DIMENSION(ITS:ITE,JTS:JTE) :: THSK
+!
+      REAL,DIMENSION(ITS:ITE,KTS:KTE+1,JTS:JTE) :: ZINT
+!
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+!
+!***  MAKE PREPARATIONS
+!
+!----------------------------------------------------------------------
+      DO J=JTS,JTE
+      DO K=KTS,KTE+1
+      DO I=ITS,ITE
+        ZINT(I,K,J)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      DO J=JTS,JTE
+      DO I=ITS,ITE
+        ZINT(I,KTE+1,J)=HT(I,J)     ! Z at bottom of lowest sigma layer
+        PBLH(I,J)=-1.
+!
+!!!!!!!!!
+!!!!!! UNCOMMENT THESE LINES IF USING ETA COORDINATES
+!!!!!!!!!
+!!!!!!  ZINT(I,KTE+1,J)=1.E-4       ! Z of bottom of lowest eta layer
+!!!!!!  ZHK(KTE+1)=1.E-4            ! Z of bottom of lowest eta layer
+!
+      ENDDO
+      ENDDO
+!
+      DO J=JTS,JTE
+      DO K=KTE,KTS,-1
+        KFLIP=KTE+1-K
+        DO I=ITS,ITE
+          ZINT(I,K,J)=ZINT(I,K+1,J)+DZ(I,KFLIP,J)
+        ENDDO
+      ENDDO
+      ENDDO
+!
+      NTSD=ITIMESTEP
+!
+#if ( NMM_CORE == 1 )
+     if(NTSD+1.eq.1) then
+#else
+     IF(NTSD==1)THEN
+#endif
+!tgs       IF(NTSD==1)THEN
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          USTAR(I,J)=0.1
+          FIS=HT(I,J)*G
+          SM=XLAND(I,J)-1.
+!!!       Z0(I,J)=SM*Z0SEA+(1.-SM)*(Z0(I,J)*Z0MAX+FIS*FCM+Z0LAND)
+!!!       ZNT(I,J)=SM*Z0SEA+(1.-SM)*(ZNT(I,J)*Z0MAX+FIS*FCM+Z0LAND)
+        ENDDO
+        ENDDO
+      ENDIF
+!
+!!!!  IF(NTSD==1)THEN
+        DO J=JTS,JTE
+        DO I=ITS,ITE
+          CT(I,J)=0.
+        ENDDO
+        ENDDO
+!!!!  ENDIF
+!
+!----------------------------------------------------------------------
+        setup_integration:  DO J=JTS,JTE
+!----------------------------------------------------------------------
+!
+        DO I=ITS,ITE
+!
+!***  LOWEST LAYER ABOVE GROUND MUST BE FLIPPED
+!
+          LMH=KTE-LOWLYR(I,J)+1
+!
+          PTOP=PINT(I,KTE+1,J)      ! KTE+1=KME
+          PSFC=PINT(I,LOWLYR(I,J),J)
+! Define THSK here (for first timestep mostly)
+          THSK(I,J)=TSK(I,J)/(PSFC*1.E-5)**CAPA
+!
+!***  CONVERT LAND MASK (1 FOR SEA; 0 FOR LAND)
+!
+          SEAMASK=XLAND(I,J)-1.
+!
+!***  FILL 1-D VERTICAL ARRAYS
+!***  AND FLIP DIRECTION SINCE MYJ SCHEME
+!***  COUNTS DOWNWARD FROM THE DOMAIN'S TOP
+!
+          DO K=KTE,KTS,-1
+            KFLIP=KTE+1-K
+            THK(K)=TH(I,KFLIP,J)
+            TK(K)=T(I,KFLIP,J)
+            RATIOMX=QV(I,KFLIP,J)
+            QK(K)=RATIOMX/(1.+RATIOMX)
+            PK(K)=PMID(I,KFLIP,J)
+            CWMK(K)=QC(I,KFLIP,J)
+            THEK(K)=(CWMK(K)*(-ELOCP/TK(K))+1.)*THK(K)
+            Q2K(K)=2.*Q2(I,KFLIP,J)
+!
+!
+!***  COMPUTE THE HEIGHTS OF THE LAYER INTERFACES
+!
+            ZHK(K)=ZINT(I,K,J)
+!
+          ENDDO
+          ZHK(KTE+1)=HT(I,J)          ! Z at bottom of lowest sigma layer
+!
+          DO K=KTE,KTS,-1
+            KFLIP=KTE+1-K
+            UK(K)=U(I,KFLIP,J)
+            VK(K)=V(I,KFLIP,J)
+          ENDDO
+!
+!***  FIND THE HEIGHT OF THE PBL
+!
+          LPBL=LMH
+          DO K=LMH-1,1,-1
+            IF(Q2K(K)<=EPSQ2*FH) THEN
+              LPBL=K
+              GO TO 110
+            ENDIF
+          ENDDO
+!
+          LPBL=1
+!
+!-----------------------------------------------------------------------
+!--------------THE HEIGHT OF THE PBL------------------------------------
+!-----------------------------------------------------------------------
+!
+ 110      PBLH(I,J)=ZHK(LPBL)-ZHK(LMH+1)
+!
+!----------------------------------------------------------------------
+!***
+!***  FIND THE SURFACE EXCHANGE COEFFICIENTS
+!***
+!----------------------------------------------------------------------
+          PLOW=PK(LMH)
+          TLOW=TK(LMH)
+          THLOW=THK(LMH)
+          THELOW=THEK(LMH)
+          QLOW=QK(LMH)
+          CWMLOW=CWMK(LMH)
+          ULOW=UK(LMH)
+          VLOW=VK(LMH)
+          ZSL=(ZHK(LMH)-ZHK(LMH+1))*0.5
+          APESFC=(PSFC*1.E-5)**CAPA
+!tgs - in ARW THZ0 is not initialized when MYJSFC is called first time
+#if ( NMM_CORE == 1 )
+     if(NTSD+1.eq.1) then
+#else
+     IF(NTSD==1)THEN
+#endif
+!       if(itimestep.le.1) then
+          TZ0=TSK(I,J)
+       else
+          TZ0=THZ0(I,J)*APESFC
+       endif
+!
+          CALL SFCDIF(NTSD,SEAMASK,THSK(I,J),QSFC(I,J),PSFC            &
+     &               ,UZ0(I,J),VZ0(I,J),TZ0,THZ0(I,J),QZ0(I,J)         &
+     &               ,USTAR(I,J),ZNT(I,J),Z0BASE(I,J),CT(I,J),RMOL(I,J) &
+     &               ,AKMS(I,J),AKHS(I,J),PBLH(I,J),MAVAIL(I,J)        &
+     &               ,CHS(I,J),CHS2(I,J),CQS2(I,J)                     &
+     &               ,HFX(I,J),QFX(I,J),FLX_LH(I,J)                    &
+     &               ,FLHC(I,J),FLQC(I,J),QGH(I,J),CPM(I,J)            &
+     &               ,ULOW,VLOW,TLOW,THLOW,THELOW,QLOW,CWMLOW          &
+     &               ,ZSL,PLOW                                         &
+     &               ,U10(I,J),V10(I,J),TSHLTR(I,J),TH10(I,J)          &
+     &               ,QSHLTR(I,J),Q10(I,J),PSHLTR(I,J)                 &
+     &               ,IDS,IDE,JDS,JDE,KDS,KDE                          &
+     &               ,IMS,IME,JMS,JME,KMS,KME                          &
+     &               ,ITS,ITE,JTS,JTE,KTS,KTE,i,j,ZHK(LMH+1))
+!
+!***  REMOVE SUPERATURATION AT 2M AND 10M
+!
+          RAPA=APESFC
+          TH02P=TSHLTR(I,J)
+          TH10P=TH10(I,J)
+          TH02(I,J)=TSHLTR(I,J)
+!
+          RAPA02=RAPA-GOCP02/TH02P
+          RAPA10=RAPA-GOCP10/TH10P
+!
+          T02P=TH02P*RAPA02
+          T10P=TH10P*RAPA10
+! 1 may 06 tgs         T02(I,J) = T02P
+          T02(I,J) = TH02(I,J)*APESFC
+!
+          P02P=(RAPA02**RCAP)*1.E5
+          P10P=(RAPA10**RCAP)*1.E5
+!
+          QS02=PQ0/P02P*EXP(A2*(T02P-A3)/(T02P-A4))
+          QS10=PQ0/P10P*EXP(A2*(T10P-A3)/(T10P-A4))
+!
+          IF(QSHLTR(I,J)>QS02)QSHLTR(I,J)=QS02
+          IF(Q10   (I,J)>QS10)Q10   (I,J)=QS10
+          Q02(I,J)=QSHLTR(I,J)/(1.-QSHLTR(I,J))
+!----------------------------------------------------------------------
+!
+        ENDDO
+!
+!----------------------------------------------------------------------
+      ENDDO setup_integration
+!----------------------------------------------------------------------
+ 
+      END SUBROUTINE MYJSFC
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!----------------------------------------------------------------------
+      SUBROUTINE SFCDIF(NTSD,SEAMASK,THS,QS,PSFC                       &
+     &                 ,UZ0,VZ0,TZ0,THZ0,QZ0                           &
+     &                 ,USTAR,Z0,Z0BASE,CT,RLMO,AKMS,AKHS,PBLH,WETM    &
+     &                 ,CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC,QGH,CPM &
+     &                 ,ULOW,VLOW,TLOW,THLOW,THELOW,QLOW,CWMLOW        &
+     &                 ,ZSL,PLOW                                       &
+     &                 ,U10,V10,TH02,TH10,Q02,Q10,PSHLTR               &
+     &                 ,IDS,IDE,JDS,JDE,KDS,KDE                        &
+     &                 ,IMS,IME,JMS,JME,KMS,KME                        &
+     &                 ,ITS,ITE,JTS,JTE,KTS,KTE,i,j,ZSFC)
+!     ****************************************************************
+!     *                                                              *
+!     *                       SURFACE LAYER                          *
+!     *                                                              *
+!     ****************************************************************
+!----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!----------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE,i,j
+!
+      INTEGER,INTENT(IN) :: NTSD
+!
+      REAL,INTENT(IN) :: CWMLOW,PBLH,PLOW,QLOW,PSFC,SEAMASK,ZSFC       &
+     &                  ,THELOW,THLOW,THS,TLOW,TZ0,ULOW,VLOW,WETM,ZSL  &
+     &                  ,Z0BASE
+!
+      REAL,INTENT(OUT) :: CHS,CHS2,CPM,CQS2,CT,FLHC,FLQC,FLX_LH,HFX    &
+     &                   ,PSHLTR,Q02,Q10,QFX,QGH,RLMO,TH02,TH10,U10,V10
+!
+      REAL,INTENT(INOUT) :: AKHS,AKMS,QZ0,THZ0,USTAR,UZ0,VZ0,Z0,QS
+!----------------------------------------------------------------------
+!***
+!***  LOCAL VARIABLES
+!***
+      INTEGER :: ITR,K
+!
+      REAL :: A,B,BTGH,BTGX,CXCHL,CXCHS,DTHV,DU2,ELFC,FCT              &
+     &       ,HLFLX,HSFLX,HV,PSH02,PSH10,PSHZ,PSHZL,PSM10,PSMZ,PSMZL   &
+     &       ,RDZ,RDZT,RIB,RLMA,RLMN,RLMP                              &
+     &       ,RLOGT,RLOGU,RWGH,RZ,RZST,RZSU,SIMH,SIMM,TEM,THM          &
+     &       ,UMFLX,USTARK,VMFLX,WGHT,WGHTT,WGHTQ,WSTAR2               &
+     &       ,X,XLT,XLT4,XLU,XLU4,XT,XT4,XU,XU4,ZETALT,ZETALU          &
+     &       ,ZETAT,ZETAU,ZQ,ZSLT,ZSLU,ZT,ZU,TOPOTERM,ZZIL
+!
+!***  DIAGNOSTICS
+!
+      REAL :: AKHS02,AKHS10,AKMS02,AKMS10,EKMS10,QSAT10,QSAT2          &
+     &       ,RLNT02,RLNT10,RLNU10,SIMH02,SIMH10,SIMM10,T02,T10        &
+     &       ,TERM1,RLOW,U10E,V10E,WSTAR,XLT02,XLT024,XLT10            &
+     &       ,XLT104,XLU10,XLU104,XU10,XU104,ZT02,ZT10,ZTAT02,ZTAT10   &
+     &       ,ZTAU,ZTAU10,ZU10,ZUUZ
+!----------------------------------------------------------------------
+!**********************************************************************
+!----------------------------------------------------------------------
+      RDZ=1./ZSL
+      CXCHL=EXCML*RDZ
+      CXCHS=EXCMS*RDZ
+!
+      BTGX=G/THLOW
+      ELFC=VKARMAN*BTGX
+!
+      IF(PBLH>1000.)THEN
+        BTGH=BTGX*PBLH
+      ELSE
+        BTGH=BTGX*1000.
+      ENDIF
+!
+!----------------------------------------------------------------------
+!
+!***  SEA POINTS
+!
+!----------------------------------------------------------------------
+!
+      IF(SEAMASK>0.5)THEN 
+!
+!----------------------------------------------------------------------
+        DO ITR=1,ITRMX
+!----------------------------------------------------------------------
+          Z0=MAX(USTFC*USTAR*USTAR,1.59E-5)
+!
+!***  VISCOUS SUBLAYER, JANJIC MWR 1994
+!
+!----------------------------------------------------------------------
+          IF(USTAR<USTC)THEN
+!----------------------------------------------------------------------
+!
+            IF(USTAR<USTR)THEN
+!
+#if ( NMM_CORE == 1 )
+     if(NTSD+1.eq.1) then
+#else
+     IF(NTSD==1)THEN
+#endif
+!tgs              IF(NTSD==1)THEN
+                AKMS=CXCHS
+                AKHS=CXCHS
+                QS=QLOW
+              ENDIF
+!
+              ZU=FZU1*SQRT(SQRT(Z0*USTAR*RVISC))/USTAR
+              WGHT=AKMS*ZU*RVISC
+              RWGH=WGHT/(WGHT+1.)
+              UZ0=(ULOW*RWGH+UZ0)*0.5
+              VZ0=(VLOW*RWGH+VZ0)*0.5
+!
+              ZT=FZT1*ZU
+              ZQ=FZQ1*ZT
+              WGHTT=AKHS*ZT*RTVISC
+              WGHTQ=AKHS*ZQ*RQVISC
+!
+#if ( NMM_CORE == 1 )
+     if(NTSD+1>1) then
+#else
+     IF(NTSD>1)THEN
+#endif
+!tgs              IF(NTSD>1)THEN
+                THZ0=((WGHTT*THLOW+THS)/(WGHTT+1.)+THZ0)*0.5
+                QZ0=((WGHTQ*QLOW+QS)/(WGHTQ+1.)+QZ0)*0.5
+              ELSE
+                THZ0=(WGHTT*THLOW+THS)/(WGHTT+1.)
+                QZ0=(WGHTQ*QLOW+QS)/(WGHTQ+1.)
+              ENDIF
+!
+            ENDIF
+!
+            IF(USTAR>=USTR.AND.USTAR<USTC)THEN
+              ZU=Z0
+              UZ0=0.
+              VZ0=0.
+!
+              ZT=FZT2*SQRT(SQRT(Z0*USTAR*RVISC))/USTAR
+              ZQ=FZQ2*ZT
+              WGHTT=AKHS*ZT*RTVISC
+              WGHTQ=AKHS*ZQ*RQVISC
+!
+#if ( NMM_CORE == 1 )
+     if(NTSD+1>1) then
+#else
+     IF(NTSD>1)THEN
+#endif
+
+!tgs              IF(NTSD>1)THEN
+                THZ0=((WGHTT*THLOW+THS)/(WGHTT+1.)+THZ0)*0.5
+                QZ0=((WGHTQ*QLOW+QS)/(WGHTQ+1.)+QZ0)*0.5
+              ELSE
+                THZ0=(WGHTT*THLOW+THS)/(WGHTT+1.)
+                QZ0=(WGHTQ*QLOW+QS)/(WGHTQ+1.)
+              ENDIF
+!
+            ENDIF
+!----------------------------------------------------------------------
+          ELSE
+!----------------------------------------------------------------------
+            ZU=Z0
+            UZ0=0.
+            VZ0=0.
+!
+            ZT=Z0
+            THZ0=THS
+!
+            ZQ=Z0
+            QZ0=QS
+!----------------------------------------------------------------------
+          ENDIF
+!----------------------------------------------------------------------
+          TEM=(TLOW+TZ0)*0.5
+          THM=(THELOW+THZ0)*0.5
+!
+          A=THM*P608
+          B=(ELOCP/TEM-1.-P608)*THM
+!
+          DTHV=((THELOW-THZ0)*((QLOW+QZ0+CWMLOW)*(0.5*P608)+1.)        &
+     &        +(QLOW-QZ0+CWMLOW)*A+CWMLOW*B) 
+!
+          DU2=MAX((ULOW-UZ0)**2+(VLOW-VZ0)**2,EPSU2)
+          RIB=BTGX*DTHV*ZSL/DU2
+!----------------------------------------------------------------------
+!         IF(RIB>=RIC)THEN
+!----------------------------------------------------------------------
+!           AKMS=MAX( VISC*RDZ,CXCHS)
+!           AKHS=MAX(TVISC*RDZ,CXCHS)
+!----------------------------------------------------------------------
+!         ELSE  !  turbulent branch
+!----------------------------------------------------------------------
+            ZSLU=ZSL+ZU
+            ZSLT=ZSL+ZT
+!
+            RZSU=ZSLU/ZU
+            RZST=ZSLT/ZT
+!
+            RLOGU=LOG(RZSU)
+            RLOGT=LOG(RZST)
+!
+!----------------------------------------------------------------------
+!***  1./MONIN-OBUKHOV LENGTH
+!----------------------------------------------------------------------
+!
+            RLMO=ELFC*AKHS*DTHV/USTAR**3
+!
+            ZETALU=ZSLU*RLMO
+            ZETALT=ZSLT*RLMO
+            ZETAU=ZU*RLMO
+            ZETAT=ZT*RLMO
+!
+            ZETALU=MIN(MAX(ZETALU,ZTMIN1),ZTMAX1)
+            ZETALT=MIN(MAX(ZETALT,ZTMIN1),ZTMAX1)
+            ZETAU=MIN(MAX(ZETAU,ZTMIN1/RZSU),ZTMAX1/RZSU)
+            ZETAT=MIN(MAX(ZETAT,ZTMIN1/RZST),ZTMAX1/RZST)
+!
+!----------------------------------------------------------------------
+!***   WATER FUNCTIONS
+!----------------------------------------------------------------------
+!
+            RZ=(ZETAU-ZTMIN1)/DZETA1
+            K=INT(RZ)
+            RDZT=RZ-REAL(K)
+            K=MIN(K,KZTM2)
+            K=MAX(K,0)
+            PSMZ=(PSIM1(K+2)-PSIM1(K+1))*RDZT+PSIM1(K+1)
+!
+            RZ=(ZETALU-ZTMIN1)/DZETA1
+            K=INT(RZ)
+            RDZT=RZ-REAL(K)
+            K=MIN(K,KZTM2)
+            K=MAX(K,0)
+            PSMZL=(PSIM1(K+2)-PSIM1(K+1))*RDZT+PSIM1(K+1)
+!
+            SIMM=PSMZL-PSMZ+RLOGU
+!
+            RZ=(ZETAT-ZTMIN1)/DZETA1
+            K=INT(RZ)
+            RDZT=RZ-REAL(K)
+            K=MIN(K,KZTM2)
+            K=MAX(K,0)
+            PSHZ=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1)
+!
+            RZ=(ZETALT-ZTMIN1)/DZETA1
+            K=INT(RZ)
+            RDZT=RZ-REAL(K)
+            K=MIN(K,KZTM2)
+            K=MAX(K,0)
+            PSHZL=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1)
+!
+            SIMH=(PSHZL-PSHZ+RLOGT)*FH01
+!----------------------------------------------------------------------
+            USTARK=USTAR*VKARMAN
+            AKMS=MAX(USTARK/SIMM,CXCHS)
+            AKHS=MAX(USTARK/SIMH,CXCHS)
+!
+!----------------------------------------------------------------------
+!***  BELJAARS CORRECTION FOR USTAR
+!----------------------------------------------------------------------
+!
+            IF(DTHV<=0.)THEN                                           !zj
+              WSTAR2=WWST2*ABS(BTGH*AKHS*DTHV)**(2./3.)                !zj
+            ELSE                                                       !zj
+              WSTAR2=0.                                                !zj
+            ENDIF                                                      !zj
+            USTAR=MAX(SQRT(AKMS*SQRT(DU2+WSTAR2)),EPSUST)
+!
+!----------------------------------------------------------------------
+!         ENDIF  !  End of turbulent branch
+!----------------------------------------------------------------------
+!
+        ENDDO  !  End of the iteration loop over sea points
+!
+!----------------------------------------------------------------------
+!
+!***  LAND POINTS
+!
+!----------------------------------------------------------------------
+!
+      ELSE  
+!
+!----------------------------------------------------------------------
+        IF(NTSD==1)THEN
+          QS=QLOW
+        ENDIF
+!
+        ZU=Z0
+        UZ0=0.
+        VZ0=0.
+!
+        ZT=ZU*ZTFC
+        THZ0=THS
+!
+        ZQ=ZT
+        QZ0=QS
+!----------------------------------------------------------------------
+        TEM=(TLOW+TZ0)*0.5
+        THM=(THELOW+THZ0)*0.5
+!
+        A=THM*P608
+        B=(ELOCP/TEM-1.-P608)*THM
+!
+        DTHV=((THELOW-THZ0)*((QLOW+QZ0+CWMLOW)*(0.5*P608)+1.)          &
+     &        +(QLOW-QZ0+CWMLOW)*A+CWMLOW*B) 
+!
+        DU2=MAX((ULOW-UZ0)**2+(VLOW-VZ0)**2,EPSU2)
+        RIB=BTGX*DTHV*ZSL/DU2
+!----------------------------------------------------------------------
+!       IF(RIB>=RIC)THEN
+!         AKMS=MAX( VISC*RDZ,CXCHL)
+!         AKHS=MAX(TVISC*RDZ,CXCHL)
+!----------------------------------------------------------------------
+!       ELSE  !  Turbulent branch
+!----------------------------------------------------------------------
+          ZSLU=ZSL+ZU
+!
+          RZSU=ZSLU/ZU
+!
+          RLOGU=LOG(RZSU)
+
+          ZSLT=ZSL+ZU ! u,v and t are at the same level
+!----------------------------------------------------------------------
+!
+!mp   Topo modification of ZILFC term
+!	
+          TOPOTERM=TOPOFAC*ZSFC**2.
+          TOPOTERM=MAX(TOPOTERM,3.0)
+!
+          IF(DTHV>0.)THEN
+            ZZIL=ZILFC*TOPOTERM
+          ELSE
+            ZZIL=ZILFC
+          ENDIF
+!
+!----------------------------------------------------------------------
+!
+          land_point_iteration: DO ITR=1,ITRMX
+!
+!----------------------------------------------------------------------
+!***  ZILITINKEVITCH FIX FOR ZT
+!----------------------------------------------------------------------
+!
+! oldform   ZT=MAX(EXP(ZZIL*SQRT(USTAR*ZU))*ZU,EPSZT)
+            ZT=MAX(EXP(ZZIL*SQRT(USTAR*Z0BASE))*Z0BASE,EPSZT)
+!
+            RZST=ZSLT/ZT
+            RLOGT=LOG(RZST)
+!
+!----------------------------------------------------------------------
+!***  1./MONIN-OBUKHOV LENGTH-SCALE
+!----------------------------------------------------------------------
+!
+            RLMO=ELFC*AKHS*DTHV/USTAR**3
+            ZETALU=ZSLU*RLMO
+            ZETALT=ZSLT*RLMO
+            ZETAU=ZU*RLMO
+            ZETAT=ZT*RLMO
+!
+            ZETALU=MIN(MAX(ZETALU,ZTMIN2),ZTMAX2)
+            ZETALT=MIN(MAX(ZETALT,ZTMIN2),ZTMAX2)
+            ZETAU=MIN(MAX(ZETAU,ZTMIN2/RZSU),ZTMAX2/RZSU)
+            ZETAT=MIN(MAX(ZETAT,ZTMIN2/RZST),ZTMAX2/RZST)
+!
+!----------------------------------------------------------------------
+!***  LAND FUNCTIONS
+!----------------------------------------------------------------------
+!
+            RZ=(ZETAU-ZTMIN2)/DZETA2
+            K=INT(RZ)
+            RDZT=RZ-REAL(K)
+            K=MIN(K,KZTM2)
+            K=MAX(K,0)
+            PSMZ=(PSIM2(K+2)-PSIM2(K+1))*RDZT+PSIM2(K+1)
+!
+            RZ=(ZETALU-ZTMIN2)/DZETA2
+            K=INT(RZ)
+            RDZT=RZ-REAL(K)
+            K=MIN(K,KZTM2)
+            K=MAX(K,0)
+            PSMZL=(PSIM2(K+2)-PSIM2(K+1))*RDZT+PSIM2(K+1)
+!
+            SIMM=PSMZL-PSMZ+RLOGU
+!
+            RZ=(ZETAT-ZTMIN2)/DZETA2
+            K=INT(RZ)
+            RDZT=RZ-REAL(K)
+            K=MIN(K,KZTM2)
+            K=MAX(K,0)
+            PSHZ=(PSIH2(K+2)-PSIH2(K+1))*RDZT+PSIH2(K+1)
+!
+            RZ=(ZETALT-ZTMIN2)/DZETA2
+            K=INT(RZ)
+            RDZT=RZ-REAL(K)
+            K=MIN(K,KZTM2)
+            K=MAX(K,0)
+            PSHZL=(PSIH2(K+2)-PSIH2(K+1))*RDZT+PSIH2(K+1)
+!
+            SIMH=(PSHZL-PSHZ+RLOGT)*FH02
+!----------------------------------------------------------------------
+            USTARK=USTAR*VKARMAN
+            AKMS=MAX(USTARK/SIMM,CXCHL)
+            AKHS=MAX(USTARK/SIMH,CXCHL)
+!
+!----------------------------------------------------------------------
+!***  BELJAARS CORRECTION FOR USTAR
+!----------------------------------------------------------------------
+!
+            IF(DTHV<=0.)THEN                                           !zj
+              WSTAR2=WWST2*ABS(BTGH*AKHS*DTHV)**(2./3.)                !zj
+            ELSE                                                       !zj
+              WSTAR2=0.                                                !zj
+            ENDIF                                                      !zj
+!
+            USTAR=MAX(SQRT(AKMS*SQRT(DU2+WSTAR2)),EPSUST)
+!
+!----------------------------------------------------------------------
+          ENDDO land_point_iteration
+!----------------------------------------------------------------------
+!
+!       ENDIF  !  End of turbulant branch over land
+!
+!----------------------------------------------------------------------
+!
+      ENDIF  !  End of land/sea branch
+!
+!----------------------------------------------------------------------
+!***  COUNTERGRADIENT FIX
+!----------------------------------------------------------------------
+!
+!     HV=-AKHS*DTHV
+!     IF(HV>0.)THEN
+!       FCT=-10.*(BTGX)**(-1./3.)
+!       CT=FCT*(HV/(PBLH*PBLH))**(2./3.)
+!     ELSE
+       CT=0.
+!     ENDIF
+!
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!***  THE FOLLOWING DIAGNOSTIC BLOCK PRODUCES 2-m and 10-m VALUES
+!***  FOR TEMPERATURE, MOISTURE, AND WINDS.  IT IS DONE HERE SINCE
+!***  THE VARIOUS QUANTITIES NEEDED FOR THE COMPUTATION ARE LOST
+!***  UPON EXIT FROM THE ROTUINE.
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!
+      WSTAR=SQRT(WSTAR2)/WWST
+!
+      UMFLX=AKMS*(ULOW -UZ0 )
+      VMFLX=AKMS*(VLOW -VZ0 )
+      HSFLX=AKHS*(THLOW-THZ0)
+      HLFLX=AKHS*(QLOW -QZ0 )
+!----------------------------------------------------------------------
+!     IF(RIB>=RIC)THEN
+!----------------------------------------------------------------------
+!       IF(SEAMASK>0.5)THEN
+!         AKMS10=MAX( VISC/10.,CXCHS)
+!         AKHS02=MAX(TVISC/02.,CXCHS)
+!         AKHS10=MAX(TVISC/10.,CXCHS)
+!       ELSE
+!         AKMS10=MAX( VISC/10.,CXCHL)
+!         AKHS02=MAX(TVISC/02.,CXCHL)
+!         AKHS10=MAX(TVISC/10.,CXCHL)
+!       ENDIF
+!----------------------------------------------------------------------
+!     ELSE
+!----------------------------------------------------------------------
+        ZU10=ZU+10.
+        ZT02=ZT+02.
+        ZT10=ZT+10.
+!
+        RLNU10=LOG(ZU10/ZU)
+        RLNT02=LOG(ZT02/ZT)
+        RLNT10=LOG(ZT10/ZT)
+!
+        ZTAU10=ZU10*RLMO
+        ZTAT02=ZT02*RLMO
+        ZTAT10=ZT10*RLMO
+!
+!----------------------------------------------------------------------
+!***  SEA
+!----------------------------------------------------------------------
+!
+        IF(SEAMASK>0.5)THEN
+!
+!----------------------------------------------------------------------
+          ZTAU10=MIN(MAX(ZTAU10,ZTMIN1),ZTMAX1)
+          ZTAT02=MIN(MAX(ZTAT02,ZTMIN1),ZTMAX1)
+          ZTAT10=MIN(MAX(ZTAT10,ZTMIN1),ZTMAX1)
+!----------------------------------------------------------------------
+          RZ=(ZTAU10-ZTMIN1)/DZETA1
+          K=INT(RZ)
+          RDZT=RZ-REAL(K)
+          K=MIN(K,KZTM2)
+          K=MAX(K,0)
+          PSM10=(PSIM1(K+2)-PSIM1(K+1))*RDZT+PSIM1(K+1)
+!
+          SIMM10=PSM10-PSMZ+RLNU10
+!
+          RZ=(ZTAT02-ZTMIN1)/DZETA1
+          K=INT(RZ)
+          RDZT=RZ-REAL(K)
+          K=MIN(K,KZTM2)
+          K=MAX(K,0)
+          PSH02=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1)
+!
+          SIMH02=(PSH02-PSHZ+RLNT02)*FH01
+!
+          RZ=(ZTAT10-ZTMIN1)/DZETA1
+          K=INT(RZ)
+          RDZT=RZ-REAL(K)
+          K=MIN(K,KZTM2)
+          K=MAX(K,0)
+          PSH10=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1)
+!
+          SIMH10=(PSH10-PSHZ+RLNT10)*FH01
+!
+          AKMS10=MAX(USTARK/SIMM10,CXCHS)
+          AKHS02=MAX(USTARK/SIMH02,CXCHS)
+          AKHS10=MAX(USTARK/SIMH10,CXCHS)
+!
+!----------------------------------------------------------------------
+!***  LAND
+!----------------------------------------------------------------------
+!
+        ELSE
+!
+!----------------------------------------------------------------------
+          ZTAU10=MIN(MAX(ZTAU10,ZTMIN2),ZTMAX2)
+          ZTAT02=MIN(MAX(ZTAT02,ZTMIN2),ZTMAX2)
+          ZTAT10=MIN(MAX(ZTAT10,ZTMIN2),ZTMAX2)
+!----------------------------------------------------------------------
+          RZ=(ZTAU10-ZTMIN2)/DZETA2
+          K=INT(RZ)
+          RDZT=RZ-REAL(K)
+          K=MIN(K,KZTM2)
+          K=MAX(K,0)
+          PSM10=(PSIM2(K+2)-PSIM2(K+1))*RDZT+PSIM2(K+1)
+!
+          SIMM10=PSM10-PSMZ+RLNU10
+!
+          RZ=(ZTAT02-ZTMIN2)/DZETA2
+          K=INT(RZ)
+          RDZT=RZ-REAL(K)
+          K=MIN(K,KZTM2)
+          K=MAX(K,0)
+          PSH02=(PSIH2(K+2)-PSIH2(K+1))*RDZT+PSIH2(K+1)
+!
+          SIMH02=(PSH02-PSHZ+RLNT02)*FH02
+!
+          RZ=(ZTAT10-ZTMIN2)/DZETA2
+          K=INT(RZ)
+          RDZT=RZ-REAL(K)
+          K=MIN(K,KZTM2)
+          K=MAX(K,0)
+          PSH10=(PSIH2(K+2)-PSIH2(K+1))*RDZT+PSIH2(K+1)
+!
+          SIMH10=(PSH10-PSHZ+RLNT10)*FH02
+!
+          AKMS10=MAX(USTARK/SIMM10,CXCHL)
+          AKHS02=MAX(USTARK/SIMH02,CXCHL)
+          AKHS10=MAX(USTARK/SIMH10,CXCHL)
+!----------------------------------------------------------------------
+        ENDIF
+!----------------------------------------------------------------------
+!     ENDIF
+!----------------------------------------------------------------------
+      U10 =UMFLX/AKMS10+UZ0
+      V10 =VMFLX/AKMS10+VZ0
+      TH02=HSFLX/AKHS02+THZ0
+      TH10=HSFLX/AKHS10+THZ0
+      Q02 =HLFLX/AKHS02+QZ0
+      Q10 =HLFLX/AKHS10+QZ0
+      TERM1=-0.068283/TLOW
+      PSHLTR=PSFC*EXP(TERM1)
+!
+!----------------------------------------------------------------------
+!***  COMPUTE "EQUIVALENT" Z0 TO APPROXIMATE LOCAL SHELTER READINGS.
+!----------------------------------------------------------------------
+!
+      U10E=U10
+      V10E=V10
+!
+      IF(SEAMASK<0.5)THEN
+
+!1st        ZUUZ=MIN(0.5*ZU,0.1)
+!1st        ZU=MAX(0.1*ZU,ZUUZ)
+!tst        ZUUZ=amin1(ZU*0.50,0.3)
+!tst        ZU=amax1(ZU*0.3,ZUUZ)
+
+        ZUUZ=AMIN1(ZU*0.50,0.18)
+        ZU=AMAX1(ZU*0.35,ZUUZ)
+!
+        ZU10=ZU+10.
+        RZSU=ZU10/ZU
+        RLNU10=LOG(RZSU)
+
+        ZETAU=ZU*RLMO
+        ZTAU10=ZU10*RLMO
+
+        ZTAU10=MIN(MAX(ZTAU10,ZTMIN2),ZTMAX2)
+        ZETAU=MIN(MAX(ZETAU,ZTMIN2/RZSU),ZTMAX2/RZSU)
+
+        RZ=(ZTAU10-ZTMIN2)/DZETA2
+        K=INT(RZ)
+        RDZT=RZ-REAL(K)
+        K=MIN(K,KZTM2)
+        K=MAX(K,0)
+        PSM10=(PSIM2(K+2)-PSIM2(K+1))*RDZT+PSIM2(K+1)
+        SIMM10=PSM10-PSMZ+RLNU10
+        EKMS10=MAX(USTARK/SIMM10,CXCHL)
+
+        U10E=UMFLX/EKMS10+UZ0
+        V10E=VMFLX/EKMS10+VZ0
+
+      ENDIF
+!
+      U10=U10E
+      V10=V10E
+!
+!----------------------------------------------------------------------
+!***  SET OTHER WRF DRIVER ARRAYS
+!----------------------------------------------------------------------
+!
+      RLOW=PLOW/(R_D*TLOW)
+      CHS=AKHS
+      CHS2=AKHS02
+      CQS2=AKHS02
+      HFX=-RLOW*CP*HSFLX
+      QFX=-RLOW*HLFLX*WETM
+      FLX_LH=XLV*QFX
+      FLHC=RLOW*CP*AKHS
+      FLQC=RLOW*AKHS*WETM
+!!!   QGH=PQ0/PSHLTR*EXP(A2S*(TSK-A3S)/(TSK-A4S))
+      QGH=((1.-SEAMASK)*PQ0+SEAMASK*PQ0SEA)                            &
+     &     /PLOW*EXP(A2S*(TLOW-A3S)/(TLOW-A4S))
+      QGH=QGH/(1.-QGH)    !Convert to mixing ratio
+      CPM=CP*(1.+0.8*QLOW)
+!
+!***  DO NOT COMPUTE QS OVER LAND POINTS HERE SINCE IT IS
+!***  A PROGNOSTIC VARIABLE THERE.  IT IS OKAY TO USE IT 
+!***  AS A DIAGNOSTIC OVER WATER SINCE IT WILL CAUSE NO
+!***  INTERFERENCE BEFORE BEING RECOMPUTED IN MYJPBL.
+!
+      IF(SEAMASK>0.5)THEN
+        QS=QLOW+QFX/(RLOW*AKHS)
+        QS=QS/(1.-QS)
+      ENDIF
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE SFCDIF
+!
+!----------------------------------------------------------------------
+      SUBROUTINE MYJSFCINIT(LOWLYR,USTAR,Z0                            &
+     &                     ,SEAMASK,XICE,IVGTYP,RESTART                &
+     &                     ,ALLOWED_TO_READ                            &
+     &                     ,IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE)
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+!----------------------------------------------------------------------
+      LOGICAL,INTENT(IN) :: RESTART,ALLOWED_TO_READ
+!
+      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
+     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
+     &                     ,ITS,ITE,JTS,JTE,KTS,KTE
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IVGTYP
+!
+      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: LOWLYR
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: SEAMASK,XICE
+!
+      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: USTAR,Z0
+!
+      REAL,DIMENSION(0:30) :: VZ0TBL
+      REAL,DIMENSION(0:30) :: VZ0TBL_24
+!
+      INTEGER :: I,IDUM,IRECV,J,JDUM,K,ITF,JTF,KTF,MAXGBL_IVGTYP       &
+     &,          MAXLOC_IVGTYP,MPI_COMM_COMP
+!
+!     INTEGER :: MPI_INTEGER,MPI_MAX
+!
+      REAL :: SM,X,ZETA1,ZETA2,ZRNG1,ZRNG2
+!
+      REAL :: PIHF=3.1415926/2.,EPS=1.E-6
+!----------------------------------------------------------------------
+      VZ0TBL=                                                          &
+     &  (/0.,                                                          &
+     &    2.653,0.826,0.563,1.089,0.854,0.856,0.035,0.238,0.065,0.076  &
+     &   ,0.011,0.035,0.011,0.000,0.000,0.000,0.000,0.000,0.000,0.000  &
+     &   ,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000/)
+
+      VZ0TBL_24= (/0.,                                                 &
+     &            1.00,  0.07,  0.07,  0.07,  0.07,  0.15,             &
+     &            0.08,  0.03,  0.05,  0.86,  0.80,  0.85,             &
+     &            2.65,  1.09,  0.80,  0.001, 0.04,  0.05,             &
+     &            0.01,  0.04,  0.06,  0.05,  0.03,  0.001,            &
+     &            0.000, 0.000, 0.000, 0.000, 0.000, 0.000 /)
+
+!----------------------------------------------------------------------
+!
+      JTF=MIN0(JTE,JDE-1)
+      KTF=MIN0(KTE,KDE-1)
+      ITF=MIN0(ITE,IDE-1)
+!
+!
+!***  FOR NOW, ASSUME SIGMA MODE FOR LOWEST MODEL LAYER
+!
+      DO J=JTS,JTF
+      DO I=ITS,ITF
+        LOWLYR(I,J)=1
+!       USTAR(I,J)=EPSUST
+      ENDDO
+      ENDDO
+!----------------------------------------------------------------------
+#if (NMM_CORE == 1)
+!
+      IF(.NOT.RESTART)THEN
+!       CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
+!       MAXLOC_IVGTYP=MAXVAL(IVGTYP)
+!       CALL MPI_ALLREDUCE(MAXLOC_IVGTYP,MAXGBL_IVGTYP,1,MPI_INTEGER   &
+!    &,                    MPI_MAX,MPI_COMM_COMP,IRECV)
+        MAXGBL_IVGTYP=MAXVAL(IVGTYP)
+        CALL WRF_DM_MAXVAL(MAXGBL_IVGTYP,IDUM,JDUM)
+!
+        IF (MAXGBL_IVGTYP<13) THEN
+          DO J=JTS,JTE
+          DO I=ITS,ITE
+            SM=SEAMASK(I,J)-1.
+            IF(SM+XICE(I,J)<0.5)THEN
+              Z0(I,J)=VZ0TBL(IVGTYP(I,J))
+            ENDIF
+          ENDDO
+          ENDDO
+!
+        ELSE
+!
+          DO J=JTS,JTE
+          DO I=ITS,ITE
+            SM=SEAMASK(I,J)-1.
+            IF(SM+XICE(I,J)<0.5)THEN
+              Z0(I,J)=VZ0TBL_24(IVGTYP(I,J))
+            ENDIF
+          ENDDO
+          ENDDO
+!
+        ENDIF ! Vegtype check
+!
+      ENDIF ! Restart check
+
+#endif
+!----------------------------------------------------------------------
+      IF(.NOT.RESTART)THEN
+        DO J=JTS,JTE
+        DO I=ITS,ITF
+          USTAR(I,J)=0.1
+        ENDDO
+        ENDDO
+      ENDIF
+!----------------------------------------------------------------------
+!
+!***  COMPUTE SURFACE LAYER INTEGRAL FUNCTIONS
+!
+!----------------------------------------------------------------------
+      FH01=1.
+      FH02=1.
+!
+!      ZTMIN1=-10.0
+!      ZTMAX1=2.0
+!      ZTMIN2=-10.0
+!      ZTMAX2=2.0
+      ZTMIN1=-5.0
+      ZTMAX1=1.0
+      ZTMIN2=-5.0
+      ZTMAX2=1.0
+!
+      ZRNG1=ZTMAX1-ZTMIN1
+      ZRNG2=ZTMAX2-ZTMIN2
+!
+      DZETA1=ZRNG1/(KZTM-1)
+      DZETA2=ZRNG2/(KZTM-1)
+!
+!----------------------------------------------------------------------
+!***  FUNCTION DEFINITION LOOP
+!----------------------------------------------------------------------
+!
+      ZETA1=ZTMIN1
+      ZETA2=ZTMIN2
+!
+      DO K=1,KZTM
+!
+!----------------------------------------------------------------------
+!***  UNSTABLE RANGE
+!----------------------------------------------------------------------
+!
+        IF(ZETA1<0.)THEN
+!
+!----------------------------------------------------------------------
+!***  PAULSON 1970 FUNCTIONS
+!----------------------------------------------------------------------
+          X=SQRT(SQRT(1.-16.*ZETA1))
+!
+          PSIM1(K)=-2.*LOG((X+1.)/2.)-LOG((X*X+1.)/2.)+2.*ATAN(X)-PIHF
+          PSIH1(K)=-2.*LOG((X*X+1.)/2.)
+!
+!----------------------------------------------------------------------
+!***  STABLE RANGE
+!----------------------------------------------------------------------
+!
+        ELSE
+!
+!----------------------------------------------------------------------
+!***  PAULSON 1970 FUNCTIONS
+!----------------------------------------------------------------------
+!
+!         PSIM1(K)=5.*ZETA1
+!         PSIH1(K)=5.*ZETA1
+!----------------------------------------------------------------------
+!***   HOLTSLAG AND DE BRUIN 1988
+!----------------------------------------------------------------------
+!
+          PSIM1(K)=0.7*ZETA1+0.75*ZETA1*(6.-0.35*ZETA1)*EXP(-0.35*ZETA1)
+          PSIH1(K)=0.7*ZETA1+0.75*ZETA1*(6.-0.35*ZETA1)*EXP(-0.35*ZETA1)
+!----------------------------------------------------------------------
+!
+        ENDIF
+!
+!----------------------------------------------------------------------
+!***  UNSTABLE RANGE
+!----------------------------------------------------------------------
+!
+        IF(ZETA2<0.)THEN
+!
+!----------------------------------------------------------------------
+!***  PAULSON 1970 FUNCTIONS
+!----------------------------------------------------------------------
+!
+          X=SQRT(SQRT(1.-16.*ZETA2))
+!
+          PSIM2(K)=-2.*LOG((X+1.)/2.)-LOG((X*X+1.)/2.)+2.*ATAN(X)-PIHF
+          PSIH2(K)=-2.*LOG((X*X+1.)/2.)
+!----------------------------------------------------------------------
+!***  STABLE RANGE
+!----------------------------------------------------------------------
+!
+        ELSE
+!
+!----------------------------------------------------------------------
+!***  PAULSON 1970 FUNCTIONS
+!----------------------------------------------------------------------
+!
+!         PSIM2(K)=5.*ZETA2
+!         PSIH2(K)=5.*ZETA2
+!
+!----------------------------------------------------------------------
+!***  HOLTSLAG AND DE BRUIN 1988
+!----------------------------------------------------------------------
+!
+          PSIM2(K)=0.7*ZETA2+0.75*ZETA2*(6.-0.35*ZETA2)*EXP(-0.35*ZETA2)
+          PSIH2(K)=0.7*ZETA2+0.75*ZETA2*(6.-0.35*ZETA2)*EXP(-0.35*ZETA2)
+!----------------------------------------------------------------------
+!
+        ENDIF
+!
+!----------------------------------------------------------------------
+        IF(K==KZTM)THEN
+          ZTMAX1=ZETA1
+          ZTMAX2=ZETA2
+        ENDIF
+!
+        ZETA1=ZETA1+DZETA1
+        ZETA2=ZETA2+DZETA2
+!----------------------------------------------------------------------
+      ENDDO
+!----------------------------------------------------------------------
+      ZTMAX1=ZTMAX1-EPS
+      ZTMAX2=ZTMAX2-EPS
+!----------------------------------------------------------------------
+!
+      END SUBROUTINE MYJSFCINIT
+!
+!----------------------------------------------------------------------
+!
+      END MODULE MODULE_SF_MYJSFC
+!
+!----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/phys/module_sf_noahlsm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_sf_noahlsm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_sf_noahlsm.F	(revision 2744)
@@ -0,0 +1,5366 @@
+MODULE module_sf_noahlsm
+ 
+  USE module_model_constants
+
+!-------------------------------
+  USE module_sf_urban
+!-------------------------------
+
+!   REAL, PARAMETER    :: CP = 1004.5
+  REAL, PARAMETER      :: RD = 287.04, SIGMA = 5.67E-8,                 &
+                          CPH2O = 4.218E+3,CPICE = 2.106E+3,            &
+                          LSUBF = 3.335E+5
+ 
+! VEGETATION PARAMETERS
+        INTEGER :: LUCATS , BARE
+        integer, PARAMETER :: NLUS=50
+        CHARACTER*4 LUTYPE
+        INTEGER, DIMENSION(1:NLUS) :: NROTBL
+        real, dimension(1:NLUS) ::  SNUPTBL, RSTBL, RGLTBL, HSTBL, LAITBL,        &
+                                    ALBTBL, Z0TBL, SHDTBL, MAXALB
+        REAL ::   TOPT_DATA,CMCMAX_DATA,CFACTR_DATA,RSMAX_DATA 
+
+! SOIL PARAMETERS
+        INTEGER :: SLCATS
+        INTEGER, PARAMETER :: NSLTYPE=30
+        CHARACTER*4 SLTYPE
+        REAL, DIMENSION (1:NSLTYPE) :: BB,DRYSMC,F11,                           &
+        MAXSMC, REFSMC,SATPSI,SATDK,SATDW, WLTSMC,QTZ
+
+! LSM GENERAL PARAMETERS
+        INTEGER :: SLPCATS
+        INTEGER, PARAMETER :: NSLOPE=30
+        REAL, DIMENSION (1:NSLOPE) :: SLOPE_DATA 
+        REAL ::  SBETA_DATA,FXEXP_DATA,CSOIL_DATA,SALP_DATA,REFDK_DATA,           &
+                 REFKDT_DATA,FRZK_DATA,ZBOT_DATA,  SMLOW_DATA,SMHIGH_DATA,        &
+                        CZIL_DATA
+
+        CHARACTER*256  :: err_message
+
+!
+CONTAINS
+!
+!----------------------------------------------------------------
+! Urban related variable are added to arguments - urban
+!----------------------------------------------------------------
+   SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
+                  HFX,QFX,LH,GRDFLX, QGH,GSW,GLW,SMSTAV,SMSTOT, &
+                  SFCRUNOFF, UDRUNOFF,IVGTYP,ISLTYP,VEGFRA,     &          
+                  ALBEDO,ALBBCK,ZNT,Z0,TMN,XLAND,XICE, EMISS,   & 
+                  SNOWC,QSFC,RAINBL,                            &
+                  num_soil_layers,DT,DZS,ITIMESTEP,             &
+                  SMOIS,TSLB,SNOW,CANWAT,                       &
+                  CHS,CHS2,CQS2,CPM,ROVCP,                      & !H   
+                  SH2O,SNOWH,                                   & !H 
+                  U_PHY,V_PHY,                                  & !I
+                  SNOALB,SHDMIN,SHDMAX,                         & !I
+                  ACSNOM,ACSNOW,                                & !O  
+                  ids,ide, jds,jde, kds,kde,                    &
+                  ims,ime, jms,jme, kms,kme,                    &
+                  its,ite, jts,jte, kts,kte,                    &
+                  ucmcall,                                      &
+!Optional Urban
+                  TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !H urban
+                  UC_URB2D,                                     & !H urban
+                  XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,  & !H urban
+                  TRL_URB3D,TBL_URB3D,TGL_URB3D,                & !H urban
+                  SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D,TS_URB2D,  & !H urban
+                  PSIM_URB2D,PSIH_URB2D,U10_URB2D,V10_URB2D,    & !O urban
+                  GZ1OZ0_URB2D,  AKMS_URB2D,                    & !O urban
+                  TH2_URB2D,Q2_URB2D, UST_URB2D,                & !O urban
+                  DECLIN_URB,COSZ_URB2D,OMG_URB2D,              & !I urban
+                  XLAT_URB2D,                                   & !I urban
+                  num_roof_layers, num_wall_layers,             & !I urban
+                  num_road_layers, DZR, DZB, DZG,               & !I urban
+                  FRC_URB2D,UTYPE_URB2D)                          !O
+!----------------------------------------------------------------
+    IMPLICIT NONE
+!----------------------------------------------------------------              
+!----------------------------------------------------------------
+! --- atmospheric (WRF generic) variables
+!-- DT          time step (seconds)
+!-- DZ8W        thickness of layers (m)
+!-- T3D         temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!-- P3D         3D pressure (Pa)
+!-- FLHC        exchange coefficient for heat (m/s)
+!-- FLQC        exchange coefficient for moisture (m/s)
+!-- PSFC        surface pressure (Pa)
+!-- XLAND       land mask (1 for land, 2 for water)
+!-- QGH         saturated mixing ratio at 2 meter
+!-- GSW         downward short wave flux at ground surface (W/m^2)
+!-- GLW         downward long wave flux at ground surface (W/m^2)
+!-- History variables 
+!-- CANWAT      canopy moisture content (mm)
+!-- TSK         surface temperature (K)
+!-- TSLB        soil temp (k)
+!-- SMOIS       total soil moisture content (volumetric fraction)
+!-- SH2O        unfrozen soil moisture content (volumetric fraction)
+!                note: frozen soil moisture (i.e., soil ice) = SMOIS - SH2O
+!-- SNOWH       actual snow depth (m)
+!-- SNOW        liquid water-equivalent snow depth (m)
+!-- ALBEDO      time-varying surface albedo including snow effect (unitless fraction)
+!-- ALBBCK      background surface albedo (unitless fraction)
+!-- CHS          surface exchange coefficient for heat and moisture (m s-1);
+!-- CHS2        2m surface exchange coefficient for heat  (m s-1);
+!-- CQS2        2m surface exchange coefficient for moisture (m s-1);
+! --- soil variables
+!-- num_soil_layers   the number of soil layers
+!-- ZS          depths of centers of soil layers   (m)
+!-- DZS         thicknesses of soil layers (m)
+!-- SLDPTH      thickness of each soil layer (m, same as DZS)
+!-- TMN         soil temperature at lower boundary (K)
+!-- SMCWLT      wilting point (volumetric)
+!-- SMCDRY      dry soil moisture threshold where direct evap from 
+!               top soil layer ends (volumetric)
+!-- SMCREF      soil moisture threshold below which transpiration begins to
+!                   stress (volumetric)
+!-- SMCMAX      porosity, i.e. saturated value of soil moisture (volumetric)
+!-- NROOT       number of root layers, a function of veg type, determined
+!               in subroutine redprm.
+!-- SMSTAV      Soil moisture availability for evapotranspiration ( 
+!                   fraction between SMCWLT and SMCMXA)
+!-- SMSTOT      Total soil moisture content frozen+unfrozen) in the soil column (mm)
+! --- snow variables
+!-- SNOWC       fraction snow coverage (0-1.0)
+! --- vegetation variables
+!-- SNOALB      upper bound on maximum albedo over deep snow 
+!-- SHDMIN      minimum areal fractional coverage of annual green vegetation
+!-- SHDMAX      maximum areal fractional coverage of annual green vegetation
+!-- XLAI        leaf area index (dimensionless)
+!-- Z0BRD       Background fixed roughness length (M)
+!-- Z0          Background vroughness length (M) as function
+!-- ZNT         Time varying roughness length (M) as function
+!-- ALBD(IVGTPK,ISN) background albedo reading from a table
+! --- LSM output
+!-- HFX         upward heat flux at the surface (W/m^2)
+!-- QFX         upward moisture flux at the surface (kg/m^2/s)
+!-- LH          upward moisture flux at the surface (W m-2)
+!-- GRDFLX(I,J) ground heat flux (W m-2)
+!-- FDOWN       radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN
+!----------------------------------------------------------------------------
+!-- EC          canopy water evaporation ((W m-2)
+!-- EDIR        direct soil evaporation (W m-2)
+!-- ET          plant transpiration from a particular root layer (W m-2)
+!-- ETT         total plant transpiration (W m-2)
+!-- ESNOW       sublimation from (or deposition to if <0) snowpack (W m-2)
+!-- DRIP        through-fall of precip and/or dew in excess of canopy
+!                 water-holding capacity (m)
+!-- DEW         dewfall (or frostfall for t<273.15) (M)
+! ----------------------------------------------------------------------
+!-- BETA        ratio of actual/potential evap (dimensionless)
+!-- ETP         potential evaporation (W m-2)
+! ----------------------------------------------------------------------
+!-- FLX1        precip-snow sfc (W m-2)
+!-- FLX2        freezing rain latent heat flux (W m-2)
+!-- FLX3        phase-change heat flux from snowmelt (W m-2)
+! ----------------------------------------------------------------------
+!-- ACSNOM      snow melt (mm) (water equivalent)
+!-- ACSNOW      accumulated snow fall (mm) (water equivalent)
+! ----------------------------------------------------------------------
+!-- RUNOFF1     surface runoff (m s-1), not infiltrating the surface
+!-- RUNOFF2     subsurface runoff (m s-1), drainage out bottom of last
+!                  soil layer (baseflow)
+!  important note: here RUNOFF2 is actually the sum of RUNOFF2 and RUNOFF3
+!-- RUNOFF3     numerical trunctation in excess of porosity (smcmax)
+!                  for a given soil layer at the end of a time step (m s-1).
+! ----------------------------------------------------------------------
+!-- RC          canopy resistance (s m-1)
+!-- PC          plant coefficient (unitless fraction, 0-1) where PC*ETP = actual transp
+!-- RSMIN       minimum canopy resistance (s m-1)
+!-- RCS         incoming solar rc factor (dimensionless)
+!-- RCT         air temperature rc factor (dimensionless)
+!-- RCQ         atmos vapor pressure deficit rc factor (dimensionless)
+!-- RCSOIL      soil moisture rc factor (dimensionless)
+
+!-- EMISS       surface emissivity (between 0 and 1)
+
+!-- ROVCP       R/CP
+!               (R_d/R_v) (dimensionless)
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!----------------------------------------------------------------
+
+! IN only
+
+   INTEGER,  INTENT(IN   )   ::     ids,ide, jds,jde, kds,kde,  &
+                                    ims,ime, jms,jme, kms,kme,  &
+                                    its,ite, jts,jte, kts,kte
+
+   INTEGER,  INTENT(IN   )   ::  ucmcall                        !urban
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(IN   )    ::                            TMN, &
+                                                         XLAND, &
+                                                          XICE, &
+                                                        VEGFRA, &
+                                                        SHDMIN, &
+                                                        SHDMAX, &
+                                                        SNOALB, &
+                                                           GSW, &
+                                                           GLW, &
+                                                            Z0, &
+                                                        ALBBCK, &
+                                                        RAINBL, &
+                                                        EMISS    
+
+   REAL,    DIMENSION( ims:ime, kms:kme, jms:jme )            , &
+            INTENT(IN   )    ::                           QV3D, &
+                                                         p8w3D, &
+                                                          DZ8W, &
+                                                          T3D
+   REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+             INTENT(IN   )               ::               QGH,  &
+                                                          CHS,   &
+                                                          CPM
+
+   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(IN   )    ::                         IVGTYP, &
+                                                        ISLTYP
+
+   INTEGER, INTENT(IN)       ::     num_soil_layers,ITIMESTEP
+
+   REAL,     INTENT(IN   )   ::     DT,ROVCP
+
+   REAL,     DIMENSION(1:num_soil_layers), INTENT(IN)::DZS
+
+! IN and OUT
+
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
+             INTENT(INOUT)   ::                          SMOIS, & ! total soil moisture
+                                                         SH2O,  & ! new soil liquid
+                                                         TSLB     ! TSLB     STEMP
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                            TSK, & !was TGB (temperature)
+                                                           HFX, &     
+                                                           QFX, &     
+                                                            LH, &
+                                                        GRDFLX, &
+                                                          QSFC,&     
+                                                          CQS2,&
+                                                          CHS2,&
+                                                          SNOW, & 
+                                                         SNOWC, & 
+                                                         SNOWH, & !new
+                                                        CANWAT, & 
+                                                        SMSTAV, &
+                                                        SMSTOT, &
+                                                     SFCRUNOFF, &
+                                                      UDRUNOFF, &
+                                                        ACSNOM, &
+                                                        ACSNOW, &
+                                                        ALBEDO, &
+                                                           ZNT
+
+
+! Local variables (moved here from driver to make routine thread safe, 20031007 jm)
+
+      REAL, DIMENSION(1:num_soil_layers) ::  ET
+
+      REAL  ::  BETA, ETP, SSOIL,EC, EDIR, ESNOW, ETT,        &
+                FLX1,FLX2,FLX3, DRIP,DEW,FDOWN,RC,PC,RSMIN,XLAI,  &
+                RCS,RCT,RCQ,RCSOIL
+                                                                           
+ 
+! DECLARATIONS - LOGICAL
+! ----------------------------------------------------------------------
+      LOGICAL, PARAMETER :: LOCAL=.false.
+      LOGICAL :: FRZGRA, SNOWNG
+
+      LOGICAL :: IPRINT
+ 
+! ----------------------------------------------------------------------
+! DECLARATIONS - INTEGER
+! ----------------------------------------------------------------------
+      INTEGER :: I,J, ICE,NSOIL,SLOPETYP,SOILTYP,VEGTYP
+      INTEGER :: NROOT
+      INTEGER :: KZ ,K
+      INTEGER :: NS 
+! ----------------------------------------------------------------------
+! DECLARATIONS - REAL
+! ----------------------------------------------------------------------
+
+      REAL  :: SHMIN,SHMAX,DQSDT2,LWDN,PRCP,PRCPRAIN,           &
+               Q2SAT,SFCPRS,SFCSPD,SFCTMP,SHDFAC,SNOALB1,             &
+               SOLDN,TBOT,ZLVL, Q2K,ALBBRD, ALBEDOK, ETA, ETA_KINEMATIC,      &
+               Z0K,RUNOFF1,RUNOFF2,RUNOFF3,SHEAT       
+
+      REAL  :: EMISSI
+
+      REAL  :: SNCOVR,SNEQV,SNOWHK,CMC, CHK,TH2
+
+      REAL  :: SMCDRY,SMCMAX,SMCREF,SMCWLT,SNOMLT,SOILM,SOILW,Q1,T1 
+
+      REAL  :: DUMMY,Z0BRD
+!
+      REAL  :: COSZ, SOLARDIRECT
+!
+      REAL, DIMENSION(1:num_soil_layers)::  SLDPTH, STC,SMC,SWC
+!
+      REAL, DIMENSION(1:num_soil_layers) ::     ZSOIL, RTDIS   
+      REAL, PARAMETER  :: TRESH=.95E0, A2=17.67,A3=273.15,A4=29.65,   &
+                          T0=273.16E0, ELWV=2.50E6,  A23M4=A2*(A3-A4)
+
+! ----------------------------------------------------------------------
+! DECLARATIONS START - urban
+! ----------------------------------------------------------------------
+
+! input variables surface_driver --> lsm
+     INTEGER, INTENT(IN) :: num_roof_layers
+     INTEGER, INTENT(IN) :: num_wall_layers
+     INTEGER, INTENT(IN) :: num_road_layers
+     REAL, OPTIONAL, DIMENSION(1:num_roof_layers), INTENT(IN) :: DZR
+     REAL, OPTIONAL, DIMENSION(1:num_wall_layers), INTENT(IN) :: DZB
+     REAL, OPTIONAL, DIMENSION(1:num_road_layers), INTENT(IN) :: DZG
+     REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: U_PHY
+     REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: V_PHY
+
+! input variables lsm --> urban
+     INTEGER :: UTYPE_URB ! urban type [urban=1, suburban=2, rural=3]
+     REAL :: TA_URB       ! potential temp at 1st atmospheric level [K]
+     REAL :: QA_URB       ! mixing ratio at 1st atmospheric level  [kg/kg]
+     REAL :: UA_URB       ! wind speed at 1st atmospheric level    [m/s]
+     REAL :: U1_URB       ! u at 1st atmospheric level             [m/s]
+     REAL :: V1_URB       ! v at 1st atmospheric level             [m/s]
+     REAL :: SSG_URB      ! downward total short wave radiation    [W/m/m]
+     REAL :: LLG_URB      ! downward long wave radiation           [W/m/m]
+     REAL :: RAIN_URB     ! precipitation                          [mm/h]
+     REAL :: RHOO_URB     ! air density                            [kg/m^3]
+     REAL :: ZA_URB       ! first atmospheric level                [m]
+     REAL :: DELT_URB     ! time step                              [s]
+     REAL :: SSGD_URB     ! downward direct short wave radiation   [W/m/m]
+     REAL :: SSGQ_URB     ! downward diffuse short wave radiation  [W/m/m]
+     REAL :: XLAT_URB     ! latitude                               [deg]
+     REAL :: COSZ_URB     ! cosz
+     REAL :: OMG_URB      ! hour angle
+     REAL :: ZNT_URB      ! roughness length                       [m]
+     REAL :: TR_URB
+     REAL :: TB_URB
+     REAL :: TG_URB
+     REAL :: TC_URB
+     REAL :: QC_URB
+     REAL :: UC_URB
+     REAL :: XXXR_URB
+     REAL :: XXXB_URB
+     REAL :: XXXG_URB
+     REAL :: XXXC_URB
+     REAL, DIMENSION(1:num_roof_layers) :: TRL_URB  ! roof layer temp [K]
+     REAL, DIMENSION(1:num_wall_layers) :: TBL_URB  ! wall layer temp [K]
+     REAL, DIMENSION(1:num_road_layers) :: TGL_URB  ! road layer temp [K]
+     LOGICAL  :: LSOLAR_URB
+! state variable surface_driver <--> lsm <--> urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UC_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D
+!
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D
+
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D
+
+! output variable lsm --> surface_driver
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIM_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIH_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: GZ1OZ0_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: U10_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: V10_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: TH2_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: Q2_URB2D
+!
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: AKMS_URB2D
+!
+     REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: UST_URB2D
+     REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FRC_URB2D
+     INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: UTYPE_URB2D
+
+
+! output variables urban --> lsm
+     REAL :: TS_URB     ! surface radiative temperature    [K]
+     REAL :: QS_URB     ! surface humidity                 [-]
+     REAL :: SH_URB     ! sensible heat flux               [W/m/m]
+     REAL :: LH_URB     ! latent heat flux                 [W/m/m]
+     REAL :: LH_KINEMATIC_URB ! latent heat flux, kinetic  [kg/m/m/s]
+     REAL :: SW_URB     ! upward short wave radiation flux [W/m/m]
+     REAL :: ALB_URB    ! time-varying albedo            [fraction]
+     REAL :: LW_URB     ! upward long wave radiation flux  [W/m/m]
+     REAL :: G_URB      ! heat flux into the ground        [W/m/m]
+     REAL :: RN_URB     ! net radiation                    [W/m/m]
+     REAL :: PSIM_URB   ! shear f for momentum             [-]
+     REAL :: PSIH_URB   ! shear f for heat                 [-]
+     REAL :: GZ1OZ0_URB   ! shear f for heat                 [-]
+     REAL :: U10_URB    ! wind u component at 10 m         [m/s]
+     REAL :: V10_URB    ! wind v component at 10 m         [m/s]
+     REAL :: TH2_URB    ! potential temperature at 2 m     [K]
+     REAL :: Q2_URB     ! humidity at 2 m                  [-]
+     REAL :: CHS_URB
+     REAL :: CHS2_URB
+     REAL :: UST_URB
+
+! ----------------------------------------------------------------------
+! DECLARATIONS END - urban
+! ----------------------------------------------------------------------
+
+! debug printout
+         IPRINT=.false.
+
+      SLOPETYP=2
+!      SHDMIN=0.00           
+
+
+      NSOIL=num_soil_layers
+
+     DO NS=1,NSOIL
+     SLDPTH(NS)=DZS(NS)
+     ENDDO
+
+   DO J=jts,jte
+
+      IF(ITIMESTEP.EQ.1)THEN                                                 
+        DO 50 I=its,ite
+!*** initialize soil conditions for IHOP 31 May case
+!         IF((XLAND(I,J)-1.5) < 0.)THEN                                
+!            if (I==108.and.j==85) then
+!                  DO NS=1,NSOIL
+!                      SMOIS(I,NS,J)=0.10
+!                      SH2O(I,NS,J)=0.10
+!                  enddo
+!             endif
+!         ENDIF
+
+!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS                   
+          IF((XLAND(I,J)-1.5).GE.0.)THEN                                
+! check sea-ice point                                                   
+            IF(XICE(I,J).EQ.1..and.IPRINT)PRINT*,' sea-ice at water point, I=',I,  &
+              'J=',J
+!***   Open Water Case                                                  
+            SMSTAV(I,J)=1.0                                             
+            SMSTOT(I,J)=1.0                                             
+            DO NS=1,NSOIL                                               
+              SMOIS(I,NS,J)=1.0                                          
+              TSLB(I,NS,J)=273.16                                          !STEMP
+            ENDDO                                                       
+          ELSE                                                          
+            IF(XICE(I,J).EQ.1.)THEN                                     
+!***        SEA-ICE CASE                                                
+              SMSTAV(I,J)=1.0                                           
+              SMSTOT(I,J)=1.0                                           
+              DO NS=1,NSOIL                                             
+                SMOIS(I,NS,J)=1.0                                        
+              ENDDO                                                     
+            ENDIF                                                       
+          ENDIF                                                         
+!                                                                       
+   50   CONTINUE                                                        
+      ENDIF                                                               ! end of initialization over ocean
+
+!-----------------------------------------------------------------------
+      DO 100 I=its,ite                                                    
+        SFCPRS=P8w3D(i,1,j)
+        Q2K=QV3D(i,1,j)
+        Q2SAT=QGH(I,j)                                                  
+        SFCTMP=T3D(i,1,j)
+        ZLVL=0.5*DZ8W(i,1,j)
+        TH2=SFCTMP+(0.0097545*ZLVL)
+        EMISSI = EMISS(I,J)
+        LWDN=GLW(I,J)*EMISSI
+        SOLDN=GSW(I,J)/(1.0-albedo(i,j))
+        PRCP=RAINBL(i,j)/DT 
+        VEGTYP=IVGTYP(I,J)                                            
+        SOILTYP=ISLTYP(I,J)                                            
+        SHDFAC=VEGFRA(I,J)/100.                                       
+        T1=TSK(I,J)
+        CHK=CHS(I,J) 
+        SHMIN=SHDMIN(I,J)/100. !NEW 
+        SHMAX=SHDMAX(I,J)/100. !NEW
+        SNOALB1=SNOALB(I,J)     !NEW
+! convert snow depth from mm to meter
+        SNEQV=SNOW(I,J)*0.001
+!        SNOWHK=SNOWH(I,J)*0.001     ! check the unit of snowh which is assumed to be mm for now
+        SNOWHK=SNOWH(I,J)     ! check the unit of snowh which is assumed to be m for now
+        
+
+!***                                                                    
+        IF((XLAND(I,J)-1.5).GE.0.)THEN                                  ! begining of land/sea if block
+! Open water points
+!CC     Q2SAT=PQ0/SFCPRS*EXP(A2*(TGDSA(I)-A3)/(TGDSA(I)-A4))
+!          HFX(I,J)=CHFF*(TGDSA(I)-TH(I))
+!          QFX(I,J)=RHO(I)*CHS(I)*(Q2SAT-QV(I))
+!          SFCEVP(I,J)=SFCEVP(I,J)+QFX(I,J)*DT
+
+        ELSE
+! Land or sea-ice case
+
+          IF (XICE(I,J) .GT. 0.5) THEN                                  
+             ICE=1                                                      
+          ELSE                                                          
+             ICE=0                                                      
+          ENDIF                                                         
+          DQSDT2=Q2SAT*A23M4/(SFCTMP-A4)**2                             
+
+          IF(ICE.EQ.0)THEN                                              
+            TBOT=TMN(I,J)                                              
+          ELSE                                                          
+            TBOT=271.16                                                
+          ENDIF                                                         
+          IF(VEGTYP.EQ.25) SHDFAC=0.0000
+          IF(VEGTYP.EQ.26) SHDFAC=0.0000
+          IF(VEGTYP.EQ.27) SHDFAC=0.0000
+          IF(SOILTYP.EQ.14.AND.XICE(I,J).EQ.0.)THEN                      
+         IF(IPRINT)PRINT*,' SOIL TYPE FOUND TO BE WATER AT A LAND-POINT'          
+         IF(IPRINT)PRINT*,i,j,'RESET SOIL in surfce.F'                      
+            SOILTYP=7                                                    
+          ENDIF                                                         
+          CMC=CANWAT(I,J)                                                
+
+!-------------------------------------------
+!*** convert snow depth from mm to meter                                
+!                                                                       
+!          IF(RDMAXALB) THEN
+!           SNOALB=ALBMAX(I,J)*0.01
+!         ELSE
+!           SNOALB=MAXALB(IVGTPK)*0.01
+!         ENDIF
+!         IF(RDBRDALB) THEN
+!           ALBBRD=ALBEDO(I,J)*0.01
+!         ELSE
+!           ALBBRD=ALBD(IVGTPK,ISN)*0.01
+!         ENDIF
+
+!        SNOALB1=0.80
+!        SHMIN=0.00
+        ALBBRD=ALBBCK(I,J)                  
+        Z0BRD=Z0(I,J)
+!FEI: temporaray arrays above need to be changed later by using SI
+      
+          DO 70 NS=1,NSOIL                                              
+            SMC(NS)=SMOIS(I,NS,J)                                       
+            STC(NS)=TSLB(I,NS,J)                                          !STEMP
+            SWC(NS)=SH2O(I,NS,J)
+   70     CONTINUE                                                      
+!
+          if ( (SNEQV.ne.0..AND.SNOWHK.eq.0.).or.(SNOWHK.le.SNEQV) )THEN
+            SNOWHK= 5.*SNEQV
+          endif
+!
+
+!Fei: urban. for urban surface, if calling UCM, redefine urban as 5: Cropland/Grassland Mosaic
+	 
+	   IF(UCMCALL == 1 ) THEN
+                IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &
+                  IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN
+		 VEGTYP = 5
+                 SHDFAC = 0.8 
+                 ALBEDOK =0.2
+                 ALBBRD  =0.2
+		 IF ( FRC_URB2D(I,J) < 0.99 ) THEN
+           T1= ( TSK(I,J) -FRC_URB2D(I,J) * TS_URB2D (I,J) )/ (1-FRC_URB2D(I,J))
+	         ELSE
+		 T1 = TSK(I,J)
+                 ENDIF
+                ENDIF
+           ELSE
+                 IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &
+                  IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN
+                  VEGTYP = 1 
+           	 ENDIF
+           ENDIF
+
+          IF(IPRINT) THEN 
+!                                                                       
+       print*, 'BEFORE SFLX, in Noahlsm_driver'
+       print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL,   &
+       'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
+        LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN,      &
+        'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K,   &
+         'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
+         'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
+         'SHMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB1',SNOALB1,'TBOT',&
+          TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
+          STC, 'SMC',SMC, 'SWC',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
+          'ALBEDO',ALBEDO,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT,      &
+          'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC,   &
+          'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
+          'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
+          'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
+          'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
+          'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS,  &
+          'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW,     &
+          'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
+          'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
+           endif
+
+
+       CALL SFLX (ICE,DT,ZLVL,NSOIL,SLDPTH,                       &    !C
+                 LOCAL,                                           &    !L
+                 LUTYPE, SLTYPE,                                  &    !CL
+                 LWDN,SOLDN,SFCPRS,PRCP,SFCTMP,Q2K,DUMMY,         &    !F
+                 DUMMY,DUMMY, DUMMY,                              &    !F PRCPRAIN not used
+                 TH2,Q2SAT,DQSDT2,                                &    !I
+                 VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHMIN,DUMMY,      &    !I   
+                 ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI,        &    !S 
+                 CMC,T1,STC,SMC,SWC,SNOWHK,SNEQV,ALBEDOK,CHK,dummy,&    !H
+                 ETA,SHEAT, ETA_KINEMATIC,FDOWN,                  &    !O
+                 EC,EDIR,ET,ETT,ESNOW,DRIP,DEW,                   &    !O
+                 BETA,ETP,SSOIL,                                  &    !O
+                 FLX1,FLX2,FLX3,                                  &    !O
+                 SNOMLT,SNCOVR,                                   &    !O
+                 RUNOFF1,RUNOFF2,RUNOFF3,                         &    !O
+                 RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL,             &    !O
+                 SOILW,SOILM,Q1,                                  &    !D
+                 SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT)
+
+
+          IF(IPRINT) THEN 
+
+       print*, 'AFTER SFLX, in Noahlsm_driver'
+       print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL,   &
+       'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
+        LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN,      &
+        'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K,   &
+         'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
+          'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
+         'SHDMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB',SNOALB1,'TBOT',&
+          TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
+          STC, 'SMC',SMC, 'SWc',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
+          'ALBEDO',ALBEDOK,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT,      &
+          'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC,   &
+          'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
+          'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
+          'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
+          'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
+          'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS,  &
+          'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW,     &
+          'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
+          'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
+           endif
+ 
+!***  UPDATE STATE VARIABLES 
+          CANWAT(I,J)=CMC                                                
+          SNOW(I,J)=SNEQV*1000.
+!          SNOWH(I,J)=SNOWHK*1000.
+          SNOWH(I,J)=SNOWHK                   ! SNOWHK is assumed in meters
+          ALBEDO(I,J)=ALBEDOK
+          ZNT(I,J)=Z0K
+          TSK(I,J)=T1
+          HFX(I,J)=SHEAT 
+          QFX(I,J)=ETA_KINEMATIC
+          LH(I,J)=ETA
+          GRDFLX(I,J)=SSOIL
+          SNOWC(I,J)=SNCOVR
+          CHS2(I,J)=CQS2(I,J)
+!      prevent diagnostic ground q (q1) from being greater than qsat(tsk)
+!      as happens over snow cover where the cqs2 value also becomes irrelevant
+!      by setting cqs2=chs in this situation the 2m q should become just qv(k=1)
+          IF (Q1 .GT. QSFC(I,J)) THEN
+            CQS2(I,J) = CHS(I,J)
+          ENDIF
+          QSFC(I,J)=Q1
+!                                                                       
+          DO 80 NS=1,NSOIL                                              
+           SMOIS(I,NS,J)=SMC(NS)                                       
+           TSLB(I,NS,J)=STC(NS)                                        !  STEMP
+           SH2O(I,NS,J)=SWC(NS)
+   80     CONTINUE                                                      
+!       ENDIF                                                           
+
+        IF (UCMCALL == 1 ) THEN                                              ! Beginning of UCM CALL if block
+!--------------------------------------
+! URBAN CANOPY MODEL START - urban
+!--------------------------------------
+! Input variables lsm --> urban
+
+
+          IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &
+              IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN
+
+! Call urban
+
+!
+            UTYPE_URB = UTYPE_URB2D(I,J) !urban type (low, high or industrial) 
+
+            TA_URB    = SFCTMP           ! [K]
+            QA_URB    = Q2K              ! [kg/kg]
+            UA_URB    = SQRT(U_PHY(I,1,J)**2.+V_PHY(I,1,J)**2.)
+            U1_URB    = U_PHY(I,1,J)
+            V1_URB    = V_PHY(I,1,J)
+            IF(UA_URB < 1.) UA_URB=1.    ! [m/s]
+            SSG_URB   = SOLDN            ! [W/m/m]
+            SSGD_URB  = 0.8*SOLDN        ! [W/m/m]
+            SSGQ_URB  = SSG_URB-SSGD_URB ! [W/m/m]
+            LLG_URB   = LWDN             ! [W/m/m]
+            RAIN_URB  = RAINBL(I,J)      ! [mm]
+            RHOO_URB  = SFCPRS / (287.04 * SFCTMP * (1.0+ 0.61 * Q2K)) ![kg/m/m/m]
+            ZA_URB    = ZLVL             ! [m]
+            DELT_URB  = DT               ! [sec]
+            XLAT_URB  = XLAT_URB2D(I,J)  ! [deg]
+            COSZ_URB  = COSZ_URB2D(I,J)  !
+            OMG_URB   = OMG_URB2D(I,J)   !
+            ZNT_URB   = ZNT(I,J)
+
+            LSOLAR_URB = .FALSE.
+
+            TR_URB = TR_URB2D(I,J)
+            TB_URB = TB_URB2D(I,J)
+            TG_URB = TG_URB2D(I,J)
+            TC_URB = TC_URB2D(I,J)
+            QC_URB = QC_URB2D(I,J)
+            UC_URB = UC_URB2D(I,J)
+
+            DO K = 1,num_roof_layers
+              TRL_URB(K) = TRL_URB3D(I,K,J)
+            END DO
+            DO K = 1,num_wall_layers
+              TBL_URB(K) = TBL_URB3D(I,K,J)
+            END DO
+            DO K = 1,num_road_layers
+              TGL_URB(K) = TGL_URB3D(I,K,J)
+            END DO
+
+            XXXR_URB = XXXR_URB2D(I,J)
+            XXXB_URB = XXXB_URB2D(I,J)
+            XXXG_URB = XXXG_URB2D(I,J)
+            XXXC_URB = XXXC_URB2D(I,J)
+!
+            CHS_URB  = CHS(I,J)
+            CHS2_URB = CHS2(I,J)
+!
+           
+! Call urban
+
+
+            CALL urban(LSOLAR_URB,                                      & ! I
+                       num_roof_layers,num_wall_layers,num_road_layers, & ! C
+                       DZR,DZB,DZG,                                     & ! C
+                       UTYPE_URB,TA_URB,QA_URB,UA_URB,U1_URB,V1_URB,SSG_URB, & ! I
+                       SSGD_URB,SSGQ_URB,LLG_URB,RAIN_URB,RHOO_URB,     & ! I
+                       ZA_URB,DECLIN_URB,COSZ_URB,OMG_URB,              & ! I
+                       XLAT_URB,DELT_URB,ZNT_URB,                       & ! I
+                       CHS_URB, CHS2_URB,                               & ! I
+                       TR_URB, TB_URB, TG_URB, TC_URB, QC_URB,UC_URB,   & ! H
+                       TRL_URB,TBL_URB,TGL_URB,                         & ! H
+                       XXXR_URB, XXXB_URB, XXXG_URB, XXXC_URB,          & ! H
+                       TS_URB,QS_URB,SH_URB,LH_URB,LH_KINEMATIC_URB,    & ! O
+                       SW_URB,ALB_URB,LW_URB,G_URB,RN_URB,PSIM_URB,PSIH_URB, & ! O
+                       GZ1OZ0_URB,                                      & !O
+                       U10_URB, V10_URB, TH2_URB, Q2_URB,               & ! O
+                       UST_URB)                                           !O
+
+
+          IF(IPRINT) THEN
+
+       print*, 'AFTER CALL URBAN'
+       print*,'num_roof_layers',num_roof_layers, 'num_wall_layers',  &
+        num_wall_layers,                                             &
+       'DZR',DZR,'DZB',DZB,'DZG',DZG,'UTYPE_URB',UTYPE_URB,'TA_URB', &
+        TA_URB,                                                      &
+        'QA_URB',QA_URB,'UA_URB',UA_URB,'U1_URB',U1_URB,'V1_URB',    &
+         V1_URB,                                                     &
+         'SSG_URB',SSG_URB,'SSGD_URB',SSGD_URB,'SSGQ_URB',SSGQ_URB,  &
+        'LLG_URB',LLG_URB,'RAIN_URB',RAIN_URB,'RHOO_URB',RHOO_URB,   &
+        'ZA_URB',ZA_URB, 'DECLIN_URB',DECLIN_URB,'COSZ_URB',COSZ_URB,&
+        'OMG_URB',OMG_URB,'XLAT_URB',XLAT_URB,'DELT_URB',DELT_URB,   &
+         'ZNT_URB',ZNT_URB,'TR_URB',TR_URB, 'TB_URB',TB_URB,'TG_URB',&
+         TG_URB,'TC_URB',TC_URB,'QC_URB',QC_URB,'TRL_URB',TRL_URB,   &
+          'TBL_URB',TBL_URB,'TGL_URB',TGL_URB,'XXXR_URB',XXXR_URB,   &
+         'XXXB_URB',XXXB_URB,'XXXG_URB',XXXG_URB,'XXXC_URB',XXXC_URB,&
+         'TS_URB',TS_URB,'QS_URB',QS_URB,'SH_URB',SH_URB,'LH_URB',   &
+         LH_URB, 'LH_KINEMATIC_URB',LH_KINEMATIC_URB,'SW_URB',SW_URB,&
+         'ALB_URB',ALB_URB,'LW_URB',LW_URB,'G_URB',G_URB,'RN_URB',   &
+          RN_URB, 'PSIM_URB',PSIM_URB,'PSIH_URB',PSIH_URB,          &
+         'U10_URB',U10_URB,'V10_URB',V10_URB,'TH2_URB',TH2_URB,      &
+          'Q2_URB',Q2_URB,'CHS_URB',CHS_URB,'CHS2_URB',CHS2_URB
+           endif
+
+            TS_URB2D(I,J) = TS_URB
+             
+            ALBEDO(I,J) = FRC_URB2D(I,J)*ALB_URB+(1-FRC_URB2D(I,J))*ALBEDOK   ![-]
+            HFX(I,J) = FRC_URB2D(I,J)*SH_URB+(1-FRC_URB2D(I,J))*SHEAT         ![W/m/m]
+            QFX(I,J) = FRC_URB2D(I,J)*LH_KINEMATIC_URB &
+                     + (1-FRC_URB2D(I,J))*ETA_KINEMATIC                ![kg/m/m/s]
+            LH(I,J) = FRC_URB2D(I,J)*LH_URB+(1-FRC_URB2D(I,J))*ETA            ![W/m/m]
+            GRDFLX(I,J) = FRC_URB2D(I,J)*G_URB+(1-FRC_URB2D(I,J))*SSOIL       ![W/m/m]
+            TSK(I,J) = FRC_URB2D(I,J)*TS_URB+(1-FRC_URB2D(I,J))*T1            ![K]
+            QSFC(I,J)= FRC_URB2D(I,J)*QS_URB+(1-FRC_URB2D(I,J))*Q1            ![-]
+
+    IF(IPRINT)THEN
+
+    print*, ' FRC_URB2D', FRC_URB2D,                        &
+    'ALB_URB',ALB_URB, 'ALBEDOK',ALBEDOK, &
+    'ALBEDO(I,J)',  ALBEDO(I,J),                  &
+    'SH_URB',SH_URB,'SHEAT',SHEAT, 'HFX(I,J)',HFX(I,J),  &
+    'LH_KINEMATIC_URB',LH_KINEMATIC_URB,'ETA_KINEMATIC',  &
+     ETA_KINEMATIC, 'QFX(I,J)',QFX(I,J),                  &
+    'LH_URB',LH_URB, 'ETA',ETA, 'LH(I,J)',LH(I,J),        &
+    'G_URB',G_URB,'SSOIL',SSOIL,'GRDFLX(I,J)', GRDFLX(I,J),&
+    'TS_URB',TS_URB,'T1',T1,'TSK(I,J)',TSK(I,J),          &
+    'QS_URB',QS_URB,'Q1',Q1,'QSFC(I,J)',QSFC(I,J) 
+     endif
+       
+
+    
+
+! Renew Urban State Varialbes
+
+            TR_URB2D(I,J) = TR_URB
+            TB_URB2D(I,J) = TB_URB
+            TG_URB2D(I,J) = TG_URB
+            TC_URB2D(I,J) = TC_URB
+            QC_URB2D(I,J) = QC_URB
+            UC_URB2D(I,J) = UC_URB
+
+            DO K = 1,num_roof_layers
+              TRL_URB3D(I,K,J) = TRL_URB(K)
+            END DO
+            DO K = 1,num_wall_layers
+              TBL_URB3D(I,K,J) = TBL_URB(K)
+            END DO
+            DO K = 1,num_road_layers
+              TGL_URB3D(I,K,J) = TGL_URB(K)
+            END DO
+            XXXR_URB2D(I,J) = XXXR_URB
+            XXXB_URB2D(I,J) = XXXB_URB
+            XXXG_URB2D(I,J) = XXXG_URB
+            XXXC_URB2D(I,J) = XXXC_URB
+
+            SH_URB2D(I,J)    = SH_URB
+            LH_URB2D(I,J)    = LH_URB
+            G_URB2D(I,J)     = G_URB
+            RN_URB2D(I,J)    = RN_URB
+            PSIM_URB2D(I,J)  = PSIM_URB
+            PSIH_URB2D(I,J)  = PSIH_URB
+            GZ1OZ0_URB2D(I,J)= GZ1OZ0_URB
+            U10_URB2D(I,J)   = U10_URB
+            V10_URB2D(I,J)   = V10_URB
+            TH2_URB2D(I,J)   = TH2_URB
+            Q2_URB2D(I,J)    = Q2_URB
+            UST_URB2D(I,J)   = UST_URB
+            AKMS_URB2D(I,J)  = KARMAN * UST_URB2D(I,J)/(GZ1OZ0_URB2D(I,J)-PSIM_URB2D(I,J)) 
+
+          END IF
+
+         ENDIF                                   ! end of UCM CALL if block
+!--------------------------------------
+! Urban Part End - urban
+!--------------------------------------
+
+!***  DIAGNOSTICS                                                       
+          SMSTAV(I,J)=SOILW                                            
+          SMSTOT(I,J)=SOILM*1000.                                      
+!         Convert the water unit into mm
+          SFCRUNOFF(I,J)=SFCRUNOFF(I,J)+RUNOFF1*DT*1000.0
+          UDRUNOFF(I,J)=UDRUNOFF(I,J)+(RUNOFF2+RUNOFF3)*DT*1000.0
+          IF(SFCTMP<=T0)THEN
+!            ACSNOW(I,J)=ACSNOW(I,J)+PREC(I)*DT
+            ACSNOW(I,J)=ACSNOW(I,J)+PRCP*DT
+          ENDIF
+          IF(SNOW(I,J).GT.0.)THEN
+            ACSNOM(I,J)=ACSNOM(I,J)+SNOMLT*1000.
+          ENDIF
+
+        ENDIF                                                           ! endif of land-sea test 
+
+  100 CONTINUE                                                          ! of I loop
+
+   ENDDO                                                                ! of J loop
+!------------------------------------------------------
+   END SUBROUTINE lsm
+!------------------------------------------------------
+ 
+  SUBROUTINE LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,    &
+                     SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,        &
+                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, & 
+                     FNDSOILW, FNDSNOWH,                       &
+                     num_soil_layers, restart,                 &
+                     allowed_to_read ,                         &
+                     ids,ide, jds,jde, kds,kde,                &
+                     ims,ime, jms,jme, kms,kme,                &
+                     its,ite, jts,jte, kts,kte                 )
+
+   INTEGER,  INTENT(IN   )   ::     ids,ide, jds,jde, kds,kde,  &
+                                    ims,ime, jms,jme, kms,kme,  &
+                                    its,ite, jts,jte, kts,kte
+
+   INTEGER, INTENT(IN)       ::     num_soil_layers
+
+   LOGICAL , INTENT(IN) :: restart , allowed_to_read
+
+   REAL,    DIMENSION( num_soil_layers), INTENT(INOUT) :: ZS, DZS
+
+   REAL,    DIMENSION( ims:ime, num_soil_layers, jms:jme )    , &
+            INTENT(INOUT)    ::                          SMOIS, &  !Total soil moisture
+                                                         SH2O,  &  !liquid soil moisture
+                                                         TSLB      !STEMP
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                           SNOW, & 
+                                                         SNOWH, &
+                                                         SNOWC, & 
+                                                        CANWAT, &
+                                                        SMSTAV, &
+                                                        SMSTOT, &
+                                                     SFCRUNOFF, &
+                                                      UDRUNOFF, &
+                                                        ACSNOW, &
+                                                        VEGFRA, &
+                                                        ACSNOM
+
+   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(IN)       ::                         IVGTYP, &
+                                                        ISLTYP
+
+   LOGICAL, INTENT(IN)       ::                      FNDSOILW , &
+                                                     FNDSNOWH
+
+   INTEGER                   :: L
+   REAL                      :: BX, SMCMAX, PSISAT, FREE
+   REAL, PARAMETER           :: BLIM = 5.5, HLICE = 3.335E5,    &
+                                GRAV = 9.81, T0 = 273.15
+   INTEGER                   :: errflag
+
+!
+
+
+! initialize three Noah LSM related tables
+   IF ( allowed_to_read ) THEN
+     CALL wrf_message( 'INITIALIZE THREE Noah LSM RELATED TABLES' )
+     CALL  LSM_PARM_INIT
+   ENDIF
+   
+   IF(.not.restart)THEN
+
+   itf=min0(ite,ide-1)
+   jtf=min0(jte,jde-1)
+
+   errflag = 0
+   DO j = jts,jtf
+     DO i = its,itf
+       IF ( ISLTYP( i,j ) .LT. 1 ) THEN
+         errflag = 1
+         WRITE(err_message,*)"module_sf_noahlsm.F: lsminit: out of range ISLTYP ",i,j,ISLTYP( i,j )
+         CALL wrf_message(err_message)
+       ENDIF
+     ENDDO
+   ENDDO
+   IF ( errflag .EQ. 1 ) THEN
+      CALL wrf_error_fatal( "module_sf_noahlsm.F: lsminit: out of range value "// &
+                            "of ISLTYP. Is this field in the input?" )
+   ENDIF
+
+! initialize soil liquid water content SH2O
+
+!  IF(.NOT.FNDSOILW) THEN
+
+! If no SWC, do the following
+!         PRINT *,'SOIL WATER NOT FOUND - VALUE SET IN LSMINIT'
+        DO J = jts,jtf
+        DO I = its,itf
+          BX = BB(ISLTYP(I,J))
+          SMCMAX = MAXSMC(ISLTYP(I,J))
+          PSISAT = SATPSI(ISLTYP(I,J))
+         if ((bx > 0.0).and.(smcmax > 0.0).and.(psisat > 0.0)) then
+          DO NS=1, num_soil_layers
+! ----------------------------------------------------------------------
+!SH2O  <= SMOIS for T < 273.149K (-0.001C)
+             IF (TSLB(I,NS,J) < 273.149) THEN
+! ----------------------------------------------------------------------
+! first guess following explicit solution for Flerchinger Eqn from Koren
+! et al, JGR, 1999, Eqn 17 (KCOUNT=0 in FUNCTION FRH2O).
+! ISLTPK is soil type
+              BX = BB(ISLTYP(I,J))
+              SMCMAX = MAXSMC(ISLTYP(I,J))
+              PSISAT = SATPSI(ISLTYP(I,J))
+              IF ( BX >  BLIM ) BX = BLIM
+              FK=(( (HLICE/(GRAV*(-PSISAT))) *                              &
+                 ((TSLB(I,NS,J)-T0)/TSLB(I,NS,J)) )**(-1/BX) )*SMCMAX
+              IF (FK < 0.02) FK = 0.02
+              SH2O(I,NS,J) = MIN( FK, SMOIS(I,NS,J) )
+! ----------------------------------------------------------------------
+! now use iterative solution for liquid soil water content using
+! FUNCTION FRH2O with the initial guess for SH2O from above explicit
+! first guess.
+              CALL FRH2O (FREE,TSLB(I,NS,J),SMOIS(I,NS,J),SH2O(I,NS,J),    &
+                 SMCMAX,BX,PSISAT)
+              SH2O(I,NS,J) = FREE
+             ELSE             ! of IF (TSLB(I,NS,J) 
+! ----------------------------------------------------------------------
+! SH2O = SMOIS ( for T => 273.149K (-0.001C)
+              SH2O(I,NS,J)=SMOIS(I,NS,J)
+! ----------------------------------------------------------------------
+             ENDIF            ! of IF (TSLB(I,NS,J)
+          END DO              ! of DO NS=1, num_soil_layers 
+         else                 ! of if ((bx > 0.0)
+          DO NS=1, num_soil_layers
+           SH2O(I,NS,J)=SMOIS(I,NS,J)
+          END DO
+         endif                ! of if ((bx > 0.0) 
+        ENDDO                 ! DO I = its,itf
+        ENDDO                 ! DO J = jts,jtf
+!  ENDIF                       ! of IF(.NOT.FNDSOILW)THEN 
+
+! initialize physical snow height SNOWH
+
+        IF(.NOT.FNDSNOWH)THEN
+! If no SNOWH do the following
+          CALL wrf_message( 'SNOW HEIGHT NOT FOUND - VALUE DEFINED IN LSMINIT' ) 
+          DO J = jts,jtf
+          DO I = its,itf
+            SNOWH(I,J)=SNOW(I,J)*0.005               ! SNOW in mm and SNOWH in m
+          ENDDO
+          ENDDO
+        ENDIF
+
+! initialize canopy water to ZERO
+
+!          GO TO 110
+!         print*,'Note that canopy water content (CANWAT) is set to ZERO in LSMINIT' 
+          DO J = jts,jtf
+          DO I = its,itf
+            CANWAT(I,J)=0.0
+          ENDDO
+          ENDDO
+ 110      CONTINUE
+   
+   ENDIF
+!------------------------------------------------------------------------------
+  END SUBROUTINE lsminit
+!------------------------------------------------------------------------------
+
+
+
+!
+!-----------------------------------------------------------------
+        SUBROUTINE LSM_PARM_INIT
+!-----------------------------------------------------------------
+
+        character*4 :: MMINLU, MMINSL 
+
+        MMINLU='USGS'
+        MMINSL='STAS'
+        call SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
+
+!-----------------------------------------------------------------
+        END SUBROUTINE LSM_PARM_INIT 
+!-----------------------------------------------------------------
+
+!-----------------------------------------------------------------
+        SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
+!-----------------------------------------------------------------
+
+        IMPLICIT NONE                                                        
+
+        integer :: LUMATCH, IINDEX, LC, NUM_SLOPE 
+        integer :: ierr
+        INTEGER , PARAMETER :: OPEN_OK = 0
+
+        character*4 :: MMINLU, MMINSL
+        character*128 :: mess , message
+        logical, external :: wrf_dm_on_monitor
+ 
+
+!-----SPECIFY VEGETATION RELATED CHARACTERISTICS :
+!             ALBBCK: SFC albedo (in percentage)
+!                 Z0: Roughness length (m)
+!             SHDFAC: Green vegetation fraction (in percentage)
+!  Note: The ALBEDO, Z0, and SHDFAC values read from the following table
+!          ALBEDO, amd Z0 are specified in LAND-USE TABLE; and SHDFAC is
+!          the monthly green vegetation data
+!             CMXTBL: MAX CNPY Capacity (m)
+!             NROTBL: Rooting depth (layer)
+!              RSMIN: Mimimum stomatal resistance (s m-1)
+!              RSMAX: Max. stomatal resistance (s m-1)
+!                RGL: Parameters used in radiation stress function
+!                 HS: Parameter used in vapor pressure deficit functio
+!               TOPT: Optimum transpiration air temperature. (K)
+!             CMCMAX: Maximum canopy water capacity
+!             CFACTR: Parameter used in the canopy inteception calculati
+!               SNUP: Threshold snow depth (in water equivalent m) that
+!                     implies 100% snow cover
+!                LAI: Leaf area index (dimensionless)
+!             MAXALB: Upper bound on maximum albedo over deep snow
+!
+!-----READ IN VEGETAION PROPERTIES FROM VEGPARM.TBL 
+!                                                                       
+
+       IF ( wrf_dm_on_monitor() ) THEN
+
+        OPEN(19, FILE='VEGPARM.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)  
+        IF(ierr .NE. OPEN_OK ) THEN
+          WRITE(message,FMT='(A)') &
+          'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening VEGPARM.TBL'
+          CALL wrf_error_fatal ( message ) 
+        END IF
+
+        WRITE ( mess, * ) 'INPUT LANDUSE = ',MMINLU                                 
+        CALL wrf_message( mess )
+
+        LUMATCH=0                                                       
+
+        READ (19,*)
+        READ (19,2000,END=2002)LUTYPE                                   
+        READ (19,*)LUCATS,IINDEX                                        
+ 2000   FORMAT (A4) 
+
+        IF(LUTYPE.EQ.MMINLU)THEN                                        
+          WRITE( mess , * ) 'LANDUSE TYPE = ',LUTYPE,' FOUND',           &                 
+                  LUCATS,' CATEGORIES'
+          CALL wrf_message( mess )
+          LUMATCH=1                                                     
+        ENDIF                                                           
+
+            IF(LUTYPE.EQ.MMINLU)THEN                                    
+          DO LC=1,LUCATS                                                
+              READ (19,*)IINDEX,ALBTBL(LC),Z0TBL(LC),SHDTBL(LC),   &  
+                        NROTBL(LC),RSTBL(LC),RGLTBL(LC),HSTBL(LC), & 
+                        SNUPTBL(LC),LAITBL(LC),MAXALB(LC)
+          ENDDO
+!
+          READ (19,*)
+          READ (19,*)TOPT_DATA
+          READ (19,*)
+          READ (19,*)CMCMAX_DATA
+          READ (19,*)
+          READ (19,*)CFACTR_DATA
+          READ (19,*)
+          READ (19,*)RSMAX_DATA
+          READ (19,*)
+          READ (19,*)BARE
+           ENDIF
+!
+ 2002   CONTINUE                                                        
+
+        CLOSE (19)                                                        
+      ENDIF
+
+      CALL wrf_dm_bcast_string  ( LUTYPE  , 4 )
+      CALL wrf_dm_bcast_integer ( LUCATS  , 1 )
+      CALL wrf_dm_bcast_integer ( IINDEX  , 1 )
+      CALL wrf_dm_bcast_integer ( LUMATCH , 1 )
+      CALL wrf_dm_bcast_real    ( ALBTBL  , NLUS )
+      CALL wrf_dm_bcast_real    ( Z0TBL   , NLUS )
+      CALL wrf_dm_bcast_real    ( SHDTBL  , NLUS )
+      CALL wrf_dm_bcast_real    ( NROTBL  , NLUS )
+      CALL wrf_dm_bcast_real    ( RSTBL   , NLUS )
+      CALL wrf_dm_bcast_real    ( RGLTBL  , NLUS )
+      CALL wrf_dm_bcast_real    ( HSTBL   , NLUS )
+      CALL wrf_dm_bcast_real    ( SNUPTBL , NLUS )
+      CALL wrf_dm_bcast_real    ( LAITBL  , NLUS )
+      CALL wrf_dm_bcast_real    ( MAXALB  , NLUS )
+      CALL wrf_dm_bcast_real    ( TOPT_DATA    , 1 )
+      CALL wrf_dm_bcast_real    ( CMCMAX_DATA  , 1 )
+      CALL wrf_dm_bcast_real    ( CFACTR_DATA  , 1 )
+      CALL wrf_dm_bcast_real    ( RSMAX_DATA  , 1 )
+      CALL wrf_dm_bcast_integer ( BARE    , 1 )
+
+!                                                                       
+!-----READ IN SOIL PROPERTIES FROM SOILPARM.TBL
+!                                                                       
+      IF ( wrf_dm_on_monitor() ) THEN
+        OPEN(19, FILE='SOILPARM.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr) 
+        IF(ierr .NE. OPEN_OK ) THEN
+          WRITE(message,FMT='(A)') &
+          'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening SOILPARM.TBL'
+          CALL wrf_error_fatal ( message ) 
+        END IF
+
+        MMINSL='STAS'                       !oct2
+        WRITE(mess,*) 'INPUT SOIL TEXTURE CLASSIFICAION = ',MMINSL
+        CALL wrf_message( mess )
+
+        LUMATCH=0                                                       
+
+        READ (19,*)
+        READ (19,2000,END=2003)SLTYPE
+        READ (19,*)SLCATS,IINDEX                                        
+        IF(SLTYPE.EQ.MMINSL)THEN                                        
+            WRITE( mess , * ) 'SOIL TEXTURE CLASSIFICATION = ',SLTYPE,' FOUND', &                 
+                  SLCATS,' CATEGORIES'
+            CALL wrf_message ( mess )
+          LUMATCH=1                                                     
+        ENDIF                                                           
+            IF(SLTYPE.EQ.MMINSL)THEN                                    
+          DO LC=1,SLCATS                                                
+              READ (19,*) IINDEX,BB(LC),DRYSMC(LC),F11(LC),MAXSMC(LC),&
+                        REFSMC(LC),SATPSI(LC),SATDK(LC), SATDW(LC),   &
+                        WLTSMC(LC), QTZ(LC)
+          ENDDO
+           ENDIF
+
+ 2003   CONTINUE                                                        
+
+        CLOSE (19)                                                        
+      ENDIF
+
+      CALL wrf_dm_bcast_integer ( LUMATCH , 1 )
+      CALL wrf_dm_bcast_string  ( SLTYPE  , 4 )
+      CALL wrf_dm_bcast_string  ( MMINSL  , 4 )  ! since this is reset above, see oct2 ^
+      CALL wrf_dm_bcast_integer ( SLCATS  , 1 )
+      CALL wrf_dm_bcast_integer ( IINDEX  , 1 )
+      CALL wrf_dm_bcast_real    ( BB      , NSLTYPE )
+      CALL wrf_dm_bcast_real    ( DRYSMC  , NSLTYPE )
+      CALL wrf_dm_bcast_real    ( F11     , NSLTYPE )
+      CALL wrf_dm_bcast_real    ( MAXSMC  , NSLTYPE )
+      CALL wrf_dm_bcast_real    ( REFSMC  , NSLTYPE )
+      CALL wrf_dm_bcast_real    ( SATPSI  , NSLTYPE )
+      CALL wrf_dm_bcast_real    ( SATDK   , NSLTYPE )
+      CALL wrf_dm_bcast_real    ( SATDW   , NSLTYPE )
+      CALL wrf_dm_bcast_real    ( WLTSMC  , NSLTYPE )
+      CALL wrf_dm_bcast_real    ( QTZ     , NSLTYPE )
+
+      IF(LUMATCH.EQ.0)THEN                                            
+          CALL wrf_message( 'SOIl TEXTURE IN INPUT FILE DOES NOT ' )
+          CALL wrf_message( 'MATCH SOILPARM TABLE'                 )
+          CALL wrf_error_fatal ( 'INCONSISTENT OR MISSING SOILPARM FILE' )
+      ENDIF                                                           
+
+!
+!-----READ IN GENERAL PARAMETERS FROM GENPARM.TBL 
+!                                                                       
+      IF ( wrf_dm_on_monitor() ) THEN
+        OPEN(19, FILE='GENPARM.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr) 
+        IF(ierr .NE. OPEN_OK ) THEN
+          WRITE(message,FMT='(A)') &
+          'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening GENPARM.TBL'
+          CALL wrf_error_fatal ( message ) 
+        END IF
+
+        READ (19,*)
+        READ (19,*)
+        READ (19,*) NUM_SLOPE
+
+          SLPCATS=NUM_SLOPE
+
+          DO LC=1,SLPCATS                                                
+              READ (19,*)SLOPE_DATA(LC)
+          ENDDO
+
+          READ (19,*)
+          READ (19,*)SBETA_DATA
+          READ (19,*)
+          READ (19,*)FXEXP_DATA
+          READ (19,*)
+          READ (19,*)CSOIL_DATA
+          READ (19,*)
+          READ (19,*)SALP_DATA
+          READ (19,*)
+          READ (19,*)REFDK_DATA
+          READ (19,*)
+          READ (19,*)REFKDT_DATA
+          READ (19,*)
+          READ (19,*)FRZK_DATA
+          READ (19,*)
+          READ (19,*)ZBOT_DATA
+          READ (19,*)
+          READ (19,*)CZIL_DATA
+          READ (19,*)
+          READ (19,*)SMLOW_DATA
+          READ (19,*)
+          READ (19,*)SMHIGH_DATA
+        CLOSE (19)                                                        
+      ENDIF
+      
+      CALL wrf_dm_bcast_integer ( NUM_SLOPE    ,  1 )
+      CALL wrf_dm_bcast_integer ( SLPCATS      ,  1 )
+      CALL wrf_dm_bcast_real    ( SLOPE_DATA   ,  NSLOPE )
+      CALL wrf_dm_bcast_real    ( SBETA_DATA   ,  1 )
+      CALL wrf_dm_bcast_real    ( FXEXP_DATA   ,  1 )
+      CALL wrf_dm_bcast_real    ( CSOIL_DATA   ,  1 )
+      CALL wrf_dm_bcast_real    ( SALP_DATA    ,  1 )
+      CALL wrf_dm_bcast_real    ( REFDK_DATA   ,  1 )
+      CALL wrf_dm_bcast_real    ( REFKDT_DATA  ,  1 )
+      CALL wrf_dm_bcast_real    ( FRZK_DATA    ,  1 )
+      CALL wrf_dm_bcast_real    ( ZBOT_DATA    ,  1 )
+      CALL wrf_dm_bcast_real    ( CZIL_DATA    ,  1 )
+      CALL wrf_dm_bcast_real    ( SMLOW_DATA   ,  1 )
+      CALL wrf_dm_bcast_real    ( SMHIGH_DATA  ,  1 )
+
+
+!-----------------------------------------------------------------
+      END SUBROUTINE SOIL_VEG_GEN_PARM
+!-----------------------------------------------------------------
+
+      SUBROUTINE SFLX (ICE,DT,ZLVL,NSOIL,SLDPTH,                        &    !C  
+                       LOCAL,                                           &    !L  
+                       LLANDUSE, LSOIL,                                 &    !CL 
+                       LWDN,SOLDN,SFCPRS,PRCP,SFCTMP,Q2,SFCSPD,         &    !F  
+                       COSZ,PRCPRAIN, SOLARDIRECT,                      &    !F  
+                       TH2,Q2SAT,DQSDT2,                                &    !I  
+                       VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHDMIN,SHDMAX,    &    !I  
+                       ALB, SNOALB,TBOT, Z0BRD, Z0, EMISSI,             &    !S   
+                       CMC,T1,STC,SMC,SH2O,SNOWH,SNEQV,ALBEDO,CH,CM,    &    !H  
+! ----------------------------------------------------------------------         
+! OUTPUTS, DIAGNOSTICS, PARAMETERS BELOW GENERALLY NOT NECESSARY WHEN            
+! COUPLED WITH E.G. A NWP MODEL (SUCH AS THE NOAA/NWS/NCEP MESOSCALE ETA         
+! MODEL).  OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES.            
+! ----------------------------------------------------------------------         
+                       ETA,SHEAT, ETA_KINEMATIC,FDOWN,                  &    !O  
+                       EC,EDIR,ET,ETT,ESNOW,DRIP,DEW,                   &    !O  
+                       BETA,ETP,SSOIL,                                  &    !O  
+                       FLX1,FLX2,FLX3,                                  &    !O  
+                       SNOMLT,SNCOVR,                                   &    !O  
+                       RUNOFF1,RUNOFF2,RUNOFF3,                         &    !O  
+                       RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL,             &    !O  
+                       SOILW,SOILM,Q1,                                  &    !D  
+                       SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT)                    !P  
+! ----------------------------------------------------------------------         
+! SUBROUTINE SFLX - VERSION 3.X - October 2002                                   
+! ----------------------------------------------------------------------         
+! SUB-DRIVER FOR "Noah LSM" FAMILY OF PHYSICS SUBROUTINES FOR A                  
+! SOIL/VEG/SNOWPACK LAND-SURFACE MODEL TO UPDATE SOIL MOISTURE, SOIL             
+! ICE, SOIL TEMPERATURE, SKIN TEMPERATURE, SNOWPACK WATER CONTENT,               
+! SNOWDEPTH, AND ALL TERMS OF THE SURFACE ENERGY BALANCE AND SURFACE             
+! WATER BALANCE (EXCLUDING INPUT ATMOSPHERIC FORCINGS OF DOWNWARD                
+! RADIATION AND PRECIP)                                                          
+! ----------------------------------------------------------------------         
+! SFLX ARGUMENT LIST KEY:                                                        
+! ----------------------------------------------------------------------         
+!  C  CONFIGURATION INFORMATION                                                  
+!  L  LOGICAL                                                                    
+! CL  4-string character bearing logical meaning                                 
+!  F  FORCING DATA                                                               
+!  I  OTHER (INPUT) FORCING DATA                                                 
+!  S  SURFACE CHARACTERISTICS                                                    
+!  H  HISTORY (STATE) VARIABLES                                                  
+!  O  OUTPUT VARIABLES                                                           
+!  D  DIAGNOSTIC OUTPUT                                                          
+!  P  Parameters                                                                 
+!  Msic Miscellaneous terms passed from gridded driver
+! ----------------------------------------------------------------------         
+! 1. CONFIGURATION INFORMATION (C):                                              
+! ----------------------------------------------------------------------         
+!   ICE        SEA-ICE FLAG  (=1: SEA-ICE, =0: LAND)                             
+!   DT         TIMESTEP (SEC) (DT SHOULD NOT EXCEED 3600 SECS, RECOMMEND         
+!                1800 SECS OR LESS)                                              
+!   ZLVL       HEIGHT (M) ABOVE GROUND OF ATMOSPHERIC FORCING VARIABLES          
+!   NSOIL      NUMBER OF SOIL LAYERS (AT LEAST 2, AND NOT GREATER THAN           
+!                PARAMETER NSOLD SET BELOW)                                      
+!   SLDPTH     THE THICKNESS OF EACH SOIL LAYER (M)                              
+! ----------------------------------------------------------------------         
+! 2. LOGICAL:                                                                    
+! ----------------------------------------------------------------------         
+!   LCH       Exchange coefficient (Ch) calculation flag (false: using           
+!                ch-routine SFCDIF; true: Ch is brought in)                      
+!   LOCAL      Flag for local-site simulation (where there is no
+!              maps for albedo, veg fraction, and roughness 
+!             true:  all LSM parameters (inluding albedo, veg fraction and 
+!                    roughness length) will be defined by three tables          
+!   LLANDUSE  (=USGS, using USGS landuse classification)                         
+!   LSOIL     (=STAS, using FAO/STATSGO soil texture classification)             
+! ----------------------------------------------------------------------         
+! 3. FORCING DATA (F):                                                           
+! ----------------------------------------------------------------------         
+!   LWDN       LW DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET LONGWAVE)         
+!   SOLDN      SOLAR DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET SOLAR)         
+!   SFCPRS     PRESSURE AT HEIGHT ZLVL ABOVE GROUND (PASCALS)                    
+!   PRCP       PRECIP RATE (KG M-2 S-1) (NOTE, THIS IS A RATE)                   
+!   SFCTMP     AIR TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND                   
+!   TH2        AIR POTENTIAL TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND         
+!   Q2         MIXING RATIO AT HEIGHT ZLVL ABOVE GROUND (KG KG-1)                
+!   COSZ       Solar zenith angle (not used for now)                             
+!   PRCPRAIN   Liquid-precipitation rate (KG M-2 S-1) (not used)                 
+! SOLARDIRECT  Direct component of downward solar radiation (W M-2) (not used)   
+! ----------------------------------------------------------------------         
+! 4. OTHER FORCING (INPUT) DATA (I):                                             
+! ----------------------------------------------------------------------         
+!   SFCSPD     WIND SPEED (M S-1) AT HEIGHT ZLVL ABOVE GROUND                    
+!   Q2SAT      SAT MIXING RATIO AT HEIGHT ZLVL ABOVE GROUND (KG KG-1)            
+!   DQSDT2     SLOPE OF SAT SPECIFIC HUMIDITY CURVE AT T=SFCTMP                  
+!                (KG KG-1 K-1)                                                   
+! ----------------------------------------------------------------------         
+! 5. CANOPY/SOIL CHARACTERISTICS (S):                                            
+! ----------------------------------------------------------------------         
+!   VEGTYP     VEGETATION TYPE (INTEGER INDEX)                                   
+!   SOILTYP    SOIL TYPE (INTEGER INDEX)                                         
+!   SLOPETYP   CLASS OF SFC SLOPE (INTEGER INDEX)                                
+!   SHDFAC     AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION                     
+!                (FRACTION= 0.0-1.0)                                             
+!   SHDMIN     MINIMUM AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION             
+!                (FRACTION= 0.0-1.0) <= SHDFAC                                   
+!   PTU        PHOTO THERMAL UNIT (PLANT PHENOLOGY FOR ANNUALS/CROPS)            
+!                (NOT YET USED, BUT PASSED TO REDPRM FOR FUTURE USE IN           
+!                VEG PARMS)                                                      
+!   ALB        BACKROUND SNOW-FREE SURFACE ALBEDO (FRACTION), FOR JULIAN         
+!                DAY OF YEAR (USUALLY FROM TEMPORAL INTERPOLATION OF             
+!                MONTHLY MEAN VALUES' CALLING PROG MAY OR MAY NOT                
+!                INCLUDE DIURNAL SUN ANGLE EFFECT)                               
+!   SNOALB     UPPER BOUND ON MAXIMUM ALBEDO OVER DEEP SNOW (E.G. FROM           
+!                ROBINSON AND KUKLA, 1985, J. CLIM. & APPL. METEOR.)             
+!   TBOT       BOTTOM SOIL TEMPERATURE (LOCAL YEARLY-MEAN SFC AIR                
+!                TEMPERATURE)                                                    
+!   Z0BRD      Background fixed roughness length (M)                             
+!   Z0         Time varying roughness length (M) as function of snow depth       
+! ----------------------------------------------------------------------         
+! 6. HISTORY (STATE) VARIABLES (H):                                              
+! ----------------------------------------------------------------------         
+!  CMC         CANOPY MOISTURE CONTENT (M)                                       
+!  T1          GROUND/CANOPY/SNOWPACK) EFFECTIVE SKIN TEMPERATURE (K)            
+!  STC(NSOIL)  SOIL TEMP (K)                                                     
+!  SMC(NSOIL)  TOTAL SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION)                 
+!  SH2O(NSOIL) UNFROZEN SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION)              
+!                NOTE: FROZEN SOIL MOISTURE = SMC - SH2O                         
+!  SNOWH       ACTUAL SNOW DEPTH (M)                                             
+!  SNEQV       LIQUID WATER-EQUIVALENT SNOW DEPTH (M)                            
+!                NOTE: SNOW DENSITY = SNEQV/SNOWH                                
+!  ALBEDO      SURFACE ALBEDO INCLUDING SNOW EFFECT (UNITLESS FRACTION)          
+!                =SNOW-FREE ALBEDO (ALB) WHEN SNEQV=0, OR                        
+!                =FCT(MSNOALB,ALB,VEGTYP,SHDFAC,SHDMIN) WHEN SNEQV>0             
+!  CH          SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE                
+!                (M S-1); NOTE: CH IS TECHNICALLY A CONDUCTANCE SINCE            
+!                IT HAS BEEN MULTIPLIED BY WIND SPEED.                           
+!  CM          SURFACE EXCHANGE COEFFICIENT FOR MOMENTUM (M S-1); NOTE:          
+!                CM IS TECHNICALLY A CONDUCTANCE SINCE IT HAS BEEN               
+!                MULTIPLIED BY WIND SPEED.                                       
+! ----------------------------------------------------------------------         
+! 7. OUTPUT (O):                                                                 
+! ----------------------------------------------------------------------         
+! OUTPUT VARIABLES NECESSARY FOR A COUPLED NUMERICAL WEATHER PREDICTION          
+! MODEL, E.G. NOAA/NWS/NCEP MESOSCALE ETA MODEL.  FOR THIS APPLICATION,          
+! THE REMAINING OUTPUT/DIAGNOSTIC/PARAMETER BLOCKS BELOW ARE NOT                 
+! NECESSARY.  OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES.         
+!   ETA        ACTUAL LATENT HEAT FLUX (W m-2: NEGATIVE, IF UP FROM              
+!              SURFACE)                                                          
+!  ETA_KINEMATIC atctual latent heat flux in Kg m-2 s-1                            
+!   SHEAT      SENSIBLE HEAT FLUX (W M-2: NEGATIVE, IF UPWARD FROM               
+!              SURFACE)                                                          
+!   FDOWN      Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN     
+! ----------------------------------------------------------------------         
+!   EC         CANOPY WATER EVAPORATION (W m-2)                                  
+!   EDIR       DIRECT SOIL EVAPORATION (W m-2)                                   
+!   ET(NSOIL)  PLANT TRANSPIRATION FROM A PARTICULAR ROOT (SOIL) LAYER           
+!                 (W m-2)                                                        
+!   ETT        TOTAL PLANT TRANSPIRATION (W m-2)                                 
+!   ESNOW      SUBLIMATION FROM (OR DEPOSITION TO IF <0) SNOWPACK                
+!                (W m-2)                                                         
+!   DRIP       THROUGH-FALL OF PRECIP AND/OR DEW IN EXCESS OF CANOPY             
+!                WATER-HOLDING CAPACITY (M)                                      
+!   DEW        DEWFALL (OR FROSTFALL FOR T<273.15) (M)                           
+! ----------------------------------------------------------------------         
+!   BETA       RATIO OF ACTUAL/POTENTIAL EVAP (DIMENSIONLESS)                    
+!   ETP        POTENTIAL EVAPORATION (W m-2)
+!   SSOIL      SOIL HEAT FLUX (W M-2: NEGATIVE IF DOWNWARD FROM SURFACE)         
+! ----------------------------------------------------------------------         
+!   FLX1       PRECIP-SNOW SFC (W M-2)                                           
+!   FLX2       FREEZING RAIN LATENT HEAT FLUX (W M-2)                            
+!   FLX3       PHASE-CHANGE HEAT FLUX FROM SNOWMELT (W M-2)                      
+! ----------------------------------------------------------------------         
+!   SNOMLT     SNOW MELT (M) (WATER EQUIVALENT)                                  
+!   SNCOVR     FRACTIONAL SNOW COVER (UNITLESS FRACTION, 0-1)                    
+! ----------------------------------------------------------------------         
+!   RUNOFF1    SURFACE RUNOFF (M S-1), NOT INFILTRATING THE SURFACE              
+!   RUNOFF2    SUBSURFACE RUNOFF (M S-1), DRAINAGE OUT BOTTOM OF LAST            
+!                SOIL LAYER (BASEFLOW)                                           
+!   RUNOFF3    NUMERICAL TRUNCTATION IN EXCESS OF POROSITY (SMCMAX)              
+!                FOR A GIVEN SOIL LAYER AT THE END OF A TIME STEP (M S-1).       
+! Note: the above RUNOFF2 is actually the sum of RUNOFF2 and RUNOFF3             
+! ----------------------------------------------------------------------         
+!   RC         CANOPY RESISTANCE (S M-1)                                         
+!   PC         PLANT COEFFICIENT (UNITLESS FRACTION, 0-1) WHERE PC*ETP           
+!                = ACTUAL TRANSP                                                 
+!   XLAI       LEAF AREA INDEX (DIMENSIONLESS)                                   
+!   RSMIN      MINIMUM CANOPY RESISTANCE (S M-1)                                 
+!   RCS        INCOMING SOLAR RC FACTOR (DIMENSIONLESS)                          
+!   RCT        AIR TEMPERATURE RC FACTOR (DIMENSIONLESS)                         
+!   RCQ        ATMOS VAPOR PRESSURE DEFICIT RC FACTOR (DIMENSIONLESS)            
+!   RCSOIL     SOIL MOISTURE RC FACTOR (DIMENSIONLESS)                           
+! ----------------------------------------------------------------------         
+! 8. DIAGNOSTIC OUTPUT (D):                                                      
+! ----------------------------------------------------------------------         
+!   SOILW      AVAILABLE SOIL MOISTURE IN ROOT ZONE (UNITLESS FRACTION           
+!              BETWEEN SMCWLT AND SMCMAX)                                        
+!   SOILM      TOTAL SOIL COLUMN MOISTURE CONTENT (FROZEN+UNFROZEN) (M)          
+!   Q1         Effective mixing ratio at surface (kg kg-1), used for             
+!              diagnosing the mixing ratio at 2 meter for coupled model          
+! ----------------------------------------------------------------------         
+! 9. PARAMETERS (P):                                                             
+! ----------------------------------------------------------------------         
+!   SMCWLT     WILTING POINT (VOLUMETRIC)                                        
+!   SMCDRY     DRY SOIL MOISTURE THRESHOLD WHERE DIRECT EVAP FRM TOP             
+!                LAYER ENDS (VOLUMETRIC)                                         
+!   SMCREF     SOIL MOISTURE THRESHOLD WHERE TRANSPIRATION BEGINS TO             
+!                STRESS (VOLUMETRIC)                                             
+!   SMCMAX     POROSITY, I.E. SATURATED VALUE OF SOIL MOISTURE                   
+!                (VOLUMETRIC)                                                    
+!   NROOT      NUMBER OF ROOT LAYERS, A FUNCTION OF VEG TYPE, DETERMINED         
+!              IN SUBROUTINE REDPRM. 
+! ----------------------------------------------------------------------           
+
+
+      IMPLICIT NONE                                                              
+! ----------------------------------------------------------------------         
+
+! DECLARATIONS - LOGICAL AND CHARACTERS                                                        
+! ----------------------------------------------------------------------         
+      LOGICAL, INTENT(IN)::  LOCAL                                              
+      LOGICAL            ::  FRZGRA, SNOWNG                                                    
+      CHARACTER (LEN=4), INTENT(IN)::  LLANDUSE, LSOIL
+                                                                                 
+! ----------------------------------------------------------------------         
+! DECLARATIONS - INTEGER                                                         
+! ----------------------------------------------------------------------         
+      INTEGER,INTENT(IN) ::  ICE,NSOIL,SLOPETYP,SOILTYP,VEGTYP                                 
+      INTEGER,INTENT(OUT)::  NROOT                                                             
+      INTEGER  KZ, K, iout                                                             
+                                                                                 
+! ----------------------------------------------------------------------         
+! DECLARATIONS - REAL                                                            
+! ----------------------------------------------------------------------         
+      REAL, INTENT(IN)   :: SHDMIN,SHDMAX,DT,DQSDT2,LWDN,PRCP,PRCPRAIN,     & 
+                            Q2,Q2SAT,SFCPRS,SFCSPD,SFCTMP, SNOALB,          & 
+                            SOLDN,TBOT,TH2,ZLVL,                            &
+                            EMISSI                                         
+      REAL, INTENT(INOUT):: COSZ, SOLARDIRECT,ALBEDO,CH,CM,                 &  
+                            CMC,SNEQV,SNCOVR,SNOWH,T1,XLAI,SHDFAC,Z0BRD,ALB
+      REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SLDPTH      
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: ET          
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT) ::  SH2O, SMC, STC
+      REAL,DIMENSION(1:NSOIL)::   RTDIS, ZSOIL                                     
+
+      REAL,INTENT(OUT)   :: ETA_KINEMATIC,BETA,DEW,DRIP,EC,EDIR,ESNOW,ETA,  & 
+                            ETP,FLX1,FLX2,FLX3,SHEAT,PC,RUNOFF1,RUNOFF2,    & 
+                            RUNOFF3,RC,RSMIN,RCQ,RCS,RCSOIL,RCT,SSOIL,      & 
+                            SMCDRY,SMCMAX,SMCREF,SMCWLT,SNOMLT, SOILM,      & 
+                            SOILW,FDOWN,Q1                                       
+      REAL :: BEXP,CFACTR,CMCMAX,CSOIL,CZIL,DF1,DF1H,DF1A,DKSAT,DWSAT,      & 
+              DSOIL,DTOT,ETT,FRCSNO,FRCSOI,EPSCA,F1,FXEXP,FRZX,HS,          & 
+              KDT,LVH2O,PRCP1,PSISAT,QUARTZ,R,RCH,REFKDT,RR,RGL,            & 
+              RSMAX,                                                        & 
+              RSNOW,SNDENS,SNCOND,SBETA,SN_NEW,SLOPE,SNUP,SALP,SOILWM,      & 
+              SOILWW,T1V,T24,T2V,TH2V,TOPT,TFREEZ,TSNOW,ZBOT,Z0,PRCPF,      & 
+              ETNS,PTU,LSUBS               
+
+! ----------------------------------------------------------------------         
+! DECLARATIONS - PARAMETERS                                                      
+! ----------------------------------------------------------------------         
+      PARAMETER (TFREEZ = 273.15)                                                
+      PARAMETER (LVH2O = 2.501E+6)                                               
+      PARAMETER (LSUBS = 2.83E+6)                                                
+      PARAMETER (R = 287.04)                                                     
+! ----------------------------------------------------------------------         
+!   INITIALIZATION                                                               
+! ----------------------------------------------------------------------         
+         RUNOFF1 = 0.0                                                           
+         RUNOFF2 = 0.0                                                           
+         RUNOFF3 = 0.0                                                           
+         SNOMLT = 0.0                                                            
+                                                                                 
+! ----------------------------------------------------------------------         
+!  THE VARIABLE "ICE" IS A FLAG DENOTING SEA-ICE CASE                            
+! ----------------------------------------------------------------------         
+! SEA-ICE LAYERS ARE EQUAL THICKNESS AND SUM TO 3 METERS                         
+! ----------------------------------------------------------------------         
+         IF (ICE == 1) THEN                                                    
+            DO KZ = 1,NSOIL                                                      
+               ZSOIL (KZ) = -3.* FLOAT (KZ)/ FLOAT (NSOIL)                       
+            END DO                                                               
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE DEPTH (NEGATIVE) BELOW GROUND FROM TOP SKIN SFC TO BOTTOM OF         
+!   EACH SOIL LAYER.  NOTE:  SIGN OF ZSOIL IS NEGATIVE (DENOTING BELOW           
+!   GROUND)                                                                      
+! ----------------------------------------------------------------------         
+         ELSE                                                                    
+            ZSOIL (1) = - SLDPTH (1)                                             
+            DO KZ = 2,NSOIL                                                      
+               ZSOIL (KZ) = - SLDPTH (KZ) + ZSOIL (KZ -1)                        
+            END DO                                                               
+! ----------------------------------------------------------------------         
+! NEXT IS CRUCIAL CALL TO SET THE LAND-SURFACE PARAMETERS, INCLUDING             
+! SOIL-TYPE AND VEG-TYPE DEPENDENT PARAMETERS.                                   
+! ----------------------------------------------------------------------         
+          CALL REDPRM (VEGTYP,SOILTYP,SLOPETYP,CFACTR,CMCMAX,RSMAX,TOPT,   &     
+                       REFKDT,KDT,SBETA, SHDFAC,RSMIN,RGL,HS,ZBOT,FRZX,    &     
+                         PSISAT,SLOPE,SNUP,SALP,BEXP,DKSAT,DWSAT,          &     
+                         SMCMAX,SMCWLT,SMCREF,SMCDRY,F1,QUARTZ,FXEXP,      &     
+                         RTDIS,SLDPTH,ZSOIL,NROOT,NSOIL,Z0BRD,CZIL,XLAI,   &     
+                         CSOIL,ALB,PTU,LLANDUSE,LSOIL,LOCAL)                   
+         END IF                                                                  
+
+!urban change
+         IF(VEGTYP==1)THEN
+              SHDFAC=0.05
+              RSMIN=400.0
+              SMCMAX = 0.45
+              SMCREF = 0.42
+              SMCWLT = 0.40
+         ENDIF
+                                                                                 
+! ----------------------------------------------------------------------         
+!  INITIALIZE PRECIPITATION LOGICALS.                                            
+! ----------------------------------------------------------------------         
+         SNOWNG = .FALSE.                                                        
+         FRZGRA = .FALSE.                                                        
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF SEA-ICE CASE, ASSIGN DEFAULT WATER-EQUIV SNOW ON TOP                        
+! ----------------------------------------------------------------------         
+         IF (ICE == 1) THEN                                                    
+            SNEQV = 0.01                                                         
+            SNOWH = 0.05                                                         
+! ----------------------------------------------------------------------         
+! IF INPUT SNOWPACK IS NONZERO, THEN COMPUTE SNOW DENSITY "SNDENS" AND           
+!   SNOW THERMAL CONDUCTIVITY "SNCOND" (NOTE THAT CSNOW IS A FUNCTION            
+!   SUBROUTINE)                                                                  
+! ----------------------------------------------------------------------         
+         END IF                                                                  
+         IF (SNEQV == 0.0) THEN                                                
+            SNDENS = 0.0                                                         
+            SNOWH = 0.0                                                          
+            SNCOND = 1.0                                                         
+         ELSE                                                                    
+            SNDENS = SNEQV / SNOWH                                               
+            IF(SNDENS > 1.0) THEN                                               
+             CALL wrf_error_fatal ( 'Physical snow depth is less than snow water equiv.' )
+            ENDIF                                                                
+            CALL CSNOW (SNCOND,SNDENS)                                           
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! DETERMINE IF IT'S PRECIPITATING AND WHAT KIND OF PRECIP IT IS.                 
+! IF IT'S PRCPING AND THE AIR TEMP IS COLDER THAN 0 C, IT'S SNOWING!             
+! IF IT'S PRCPING AND THE AIR TEMP IS WARMER THAN 0 C, BUT THE GRND              
+! TEMP IS COLDER THAN 0 C, FREEZING RAIN IS PRESUMED TO BE FALLING.              
+! ----------------------------------------------------------------------         
+         IF (PRCP > 0.0) THEN                                                 
+            IF (SFCTMP <=  TFREEZ) THEN                                         
+               SNOWNG = .TRUE.                                                   
+            ELSE                                                                 
+               IF (T1 <= TFREEZ) FRZGRA = .TRUE.                               
+            END IF                                                               
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! IF EITHER PRCP FLAG IS SET, DETERMINE NEW SNOWFALL (CONVERTING PRCP            
+! RATE FROM KG M-2 S-1 TO A LIQUID EQUIV SNOW DEPTH IN METERS) AND ADD           
+! IT TO THE EXISTING SNOWPACK.                                                   
+! NOTE THAT SINCE ALL PRECIP IS ADDED TO SNOWPACK, NO PRECIP INFILTRATES         
+! INTO THE SOIL SO THAT PRCP1 IS SET TO ZERO.                                    
+! ----------------------------------------------------------------------         
+         IF ( (SNOWNG) .OR. (FRZGRA) ) THEN                                      
+            SN_NEW = PRCP * DT * 0.001                                           
+!        PRCP1 = 0.0                                                             
+! change name of PRCP1 to PRCPF                                                  
+            SNEQV = SNEQV + SN_NEW                                               
+            PRCPF = 0.0                                                          
+                                                                                 
+! ----------------------------------------------------------------------         
+! UPDATE SNOW DENSITY BASED ON NEW SNOWFALL, USING OLD AND NEW SNOW.             
+! UPDATE SNOW THERMAL CONDUCTIVITY                                               
+! ----------------------------------------------------------------------         
+            CALL SNOW_NEW (SFCTMP,SN_NEW,SNOWH,SNDENS)                           
+            CALL CSNOW (SNCOND,SNDENS)                                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! PRECIP IS LIQUID (RAIN), HENCE SAVE IN THE PRECIP VARIABLE THAT                
+! LATER CAN WHOLELY OR PARTIALLY INFILTRATE THE SOIL (ALONG WITH                 
+! ANY CANOPY "DRIP" ADDED TO THIS LATER)                                         
+! ----------------------------------------------------------------------         
+!        PRCP1 = PRCP                                                            
+         ELSE                                                                    
+! change name of PRCP1 to PRCPF                                                  
+                                                                                 
+            PRCPF = PRCP                                                         
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! DETERMINE SNOWCOVER AND ALBEDO OVER LAND.                                      
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! IF SNOW DEPTH=0, SET SNOW FRACTION=0, ALBEDO=SNOW FREE ALBEDO.                 
+! ----------------------------------------------------------------------         
+         IF (ICE == 0) THEN                                                    
+            IF (SNEQV  == 0.0) THEN                                             
+               SNCOVR = 0.0                                                      
+               ALBEDO = ALB                                                      
+            ELSE                                                                 
+! ----------------------------------------------------------------------         
+! DETERMINE SNOW FRACTIONAL COVERAGE.                                            
+! DETERMINE SURFACE ALBEDO MODIFICATION DUE TO SNOWDEPTH STATE.                  
+! ----------------------------------------------------------------------         
+              CALL SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR)                         
+              CALL ALCALC (ALB,SNOALB,SHDFAC,SHDMIN,SNCOVR,TSNOW,ALBEDO)         
+            END IF                                                               
+! ----------------------------------------------------------------------         
+! SNOW COVER, ALBEDO OVER SEA-ICE                                                
+! ----------------------------------------------------------------------         
+         ELSE                                                                    
+            SNCOVR = 1.0                                                         
+            ALBEDO = 0.60                                                        
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! THERMAL CONDUCTIVITY FOR SEA-ICE CASE                                          
+! ----------------------------------------------------------------------         
+         IF (ICE == 1) THEN                                                    
+            DF1 = 2.2                                                            
+         ELSE                                                                    
+! ----------------------------------------------------------------------         
+! NEXT CALCULATE THE SUBSURFACE HEAT FLUX, WHICH FIRST REQUIRES                  
+! CALCULATION OF THE THERMAL DIFFUSIVITY.  TREATMENT OF THE                      
+! LATTER FOLLOWS THAT ON PAGES 148-149 FROM "HEAT TRANSFER IN                    
+! COLD CLIMATES", BY V. J. LUNARDINI (PUBLISHED IN 1981                          
+! BY VAN NOSTRAND REINHOLD CO.) I.E. TREATMENT OF TWO CONTIGUOUS                 
+! "PLANE PARALLEL" MEDIUMS (NAMELY HERE THE FIRST SOIL LAYER                     
+! AND THE SNOWPACK LAYER, IF ANY). THIS DIFFUSIVITY TREATMENT                    
+! BEHAVES WELL FOR BOTH ZERO AND NONZERO SNOWPACK, INCLUDING THE                 
+! LIMIT OF VERY THIN SNOWPACK.  THIS TREATMENT ALSO ELIMINATES                   
+! THE NEED TO IMPOSE AN ARBITRARY UPPER BOUND ON SUBSURFACE                      
+! HEAT FLUX WHEN THE SNOWPACK BECOMES EXTREMELY THIN.                            
+! ----------------------------------------------------------------------         
+! FIRST CALCULATE THERMAL DIFFUSIVITY OF TOP SOIL LAYER, USING                   
+! BOTH THE FROZEN AND LIQUID SOIL MOISTURE, FOLLOWING THE                        
+! SOIL THERMAL DIFFUSIVITY FUNCTION OF PETERS-LIDARD ET AL.                      
+! (1998,JAS, VOL 55, 1209-1224), WHICH REQUIRES THE SPECIFYING                   
+! THE QUARTZ CONTENT OF THE GIVEN SOIL CLASS (SEE ROUTINE REDPRM)                
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! NEXT ADD SUBSURFACE HEAT FLUX REDUCTION EFFECT FROM THE                        
+! OVERLYING GREEN CANOPY, ADAPTED FROM SECTION 2.1.2 OF                          
+! PETERS-LIDARD ET AL. (1997, JGR, VOL 102(D4))                                  
+! ----------------------------------------------------------------------         
+            CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1))                     
+
+!urban change
+            IF (VEGTYP==1) DF1=3.24
+
+            DF1 = DF1 * EXP (SBETA * SHDFAC)                                     
+! ----------------------------------------------------------------------         
+! FINALLY "PLANE PARALLEL" SNOWPACK EFFECT FOLLOWING                             
+! V.J. LINARDINI REFERENCE CITED ABOVE. NOTE THAT DTOT IS                        
+! COMBINED DEPTH OF SNOWDEPTH AND THICKNESS OF FIRST SOIL LAYER                  
+! ----------------------------------------------------------------------         
+         END IF                                                                  
+                                                                                 
+         DSOIL = - (0.5 * ZSOIL (1))                                             
+         IF (SNEQV == 0.) THEN                                                 
+            SSOIL = DF1 * (T1- STC (1) ) / DSOIL                                 
+         ELSE                                                                    
+            DTOT = SNOWH + DSOIL                                                 
+            FRCSNO = SNOWH / DTOT                                                
+                                                                                 
+! 1. HARMONIC MEAN (SERIES FLOW)                                                 
+!        DF1 = (SNCOND*DF1)/(FRCSOI*SNCOND+FRCSNO*DF1)                           
+            FRCSOI = DSOIL / DTOT                                                
+! 2. ARITHMETIC MEAN (PARALLEL FLOW)                                             
+!        DF1 = FRCSNO*SNCOND + FRCSOI*DF1                                        
+            DF1H = (SNCOND * DF1)/ (FRCSOI * SNCOND+ FRCSNO * DF1)               
+                                                                                 
+! 3. GEOMETRIC MEAN (INTERMEDIATE BETWEEN HARMONIC AND ARITHMETIC MEAN)          
+!        DF1 = (SNCOND**FRCSNO)*(DF1**FRCSOI)                                    
+! TEST - MBEK, 10 Jan 2002                                                       
+! weigh DF by snow fraction                                                      
+!        DF1 = DF1H*SNCOVR + DF1A*(1.0-SNCOVR)                                   
+!        DF1 = DF1H*SNCOVR + DF1*(1.0-SNCOVR)                                    
+            DF1A = FRCSNO * SNCOND+ FRCSOI * DF1                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE SUBSURFACE HEAT FLUX, SSOIL, FROM FINAL THERMAL DIFFUSIVITY          
+! OF SURFACE MEDIUMS, DF1 ABOVE, AND SKIN TEMPERATURE AND TOP                    
+! MID-LAYER SOIL TEMPERATURE                                                     
+! ----------------------------------------------------------------------         
+            DF1 = DF1A * SNCOVR + DF1* (1.0- SNCOVR)                             
+            SSOIL = DF1 * (T1- STC (1) ) / DTOT                                  
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! DETERMINE SURFACE ROUGHNESS OVER SNOWPACK USING SNOW CONDITION FROM            
+! THE PREVIOUS TIMESTEP.                                                         
+! ----------------------------------------------------------------------         
+         IF (SNCOVR  > 0. ) THEN                                               
+            CALL SNOWZ0 (SNCOVR,Z0,Z0BRD)                                        
+         ELSE
+            Z0=Z0BRD
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! NEXT CALL ROUTINE SFCDIF TO CALCULATE THE SFC EXCHANGE COEF (CH) FOR           
+! HEAT AND MOISTURE.                                                             
+                                                                                 
+! NOTE !!!                                                                       
+! DO NOT CALL SFCDIF UNTIL AFTER ABOVE CALL TO REDPRM, IN CASE                   
+! ALTERNATIVE VALUES OF ROUGHNESS LENGTH (Z0) AND ZILINTINKEVICH COEF            
+! (CZIL) ARE SET THERE VIA NAMELIST I/O.                                         
+                                                                                 
+! NOTE !!!                                                                       
+! ROUTINE SFCDIF RETURNS A CH THAT REPRESENTS THE WIND SPD TIMES THE             
+! "ORIGINAL" NONDIMENSIONAL "Ch" TYPICAL IN LITERATURE.  HENCE THE CH            
+! RETURNED FROM SFCDIF HAS UNITS OF M/S.  THE IMPORTANT COMPANION                
+! COEFFICIENT OF CH, CARRIED HERE AS "RCH", IS THE CH FROM SFCDIF TIMES          
+! AIR DENSITY AND PARAMETER "CP".  "RCH" IS COMPUTED IN "CALL PENMAN".           
+! RCH RATHER THAN CH IS THE COEFF USUALLY INVOKED LATER IN EQNS.                 
+                                                                                 
+! NOTE !!!                                                                       
+! ----------------------------------------------------------------------         
+! SFCDIF ALSO RETURNS THE SURFACE EXCHANGE COEFFICIENT FOR MOMENTUM, CM,         
+! ALSO KNOWN AS THE SURFACE DRAGE COEFFICIENT. Needed as a state variable        
+! for iterative/implicit solution of CH in SFCDIF                                
+! ----------------------------------------------------------------------         
+!        IF(.NOT.LCH) THEN                                                       
+!          T1V = T1 * (1.0+ 0.61 * Q2)                                           
+!          TH2V = TH2 * (1.0+ 0.61 * Q2)                                         
+!          CALL SFCDIF_off (ZLVL,Z0,T1V,TH2V,SFCSPD,CZIL,CM,CH)                  
+!        ENDIF                                                                   
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALL PENMAN SUBROUTINE TO CALCULATE POTENTIAL EVAPORATION (ETP), AND           
+! OTHER PARTIAL PRODUCTS AND SUMS SAVE IN COMMON/RITE FOR LATER                  
+! CALCULATIONS.                                                                  
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! CALCULATE TOTAL DOWNWARD RADIATION (SOLAR PLUS LONGWAVE) NEEDED IN             
+! PENMAN EP SUBROUTINE THAT FOLLOWS                                              
+! ----------------------------------------------------------------------         
+         FDOWN = SOLDN * (1.0- ALBEDO) + LWDN                                    
+! ----------------------------------------------------------------------         
+! CALC VIRTUAL TEMPS AND VIRTUAL POTENTIAL TEMPS NEEDED BY SUBROUTINES           
+! PENMAN.                                                                        
+         T2V = SFCTMP * (1.0+ 0.61 * Q2 )                                        
+                                                                                 
+         iout=0                                                                  
+         if(iout.eq.1) then                                                      
+         print*,'before penman'                                                  
+         print*,' SFCTMP',SFCTMP,'SFCPRS',SFCPRS,'CH',CH,'T2V',T2V,      & 
+       'TH2',TH2,'PRCP',PRCP,'FDOWN',FDOWN,'T24',T24,'SSOIL',SSOIL,      &         
+        'Q2',Q2,'Q2SAT',Q2SAT,'ETP',ETP,'RCH',RCH,                       &        
+        'EPSCA',EPSCA,'RR',RR  ,'SNOWNG',SNOWNG,'FRZGRA',FRZGRA,           &       
+        'DQSDT2',DQSDT2,'FLX2',FLX2,'SNOWH',SNOWH,'SNEQV',SNEQV,         &      
+        ' DSOIL',DSOIL,' FRCSNO',FRCSNO,' SNCOVR',SNCOVR,' DTOT',DTOT,   &     
+       ' ZSOIL (1)',ZSOIL(1),' DF1',DF1,'T1',T1,' STC1',STC(1),          &       
+        'ALBEDO',ALBEDO,'SMC',SMC,'STC',STC,'SH2O',SH2O                          
+         endif                                                                   
+                                                                                 
+         CALL PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL,     &        
+                       Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA,          &
+                         DQSDT2,FLX2,EMISSI)                                            
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALL CANRES TO CALCULATE THE CANOPY RESISTANCE AND CONVERT IT INTO PC          
+! IF NONZERO GREENNESS FRACTION                                                  
+! ----------------------------------------------------------------------         
+                                                                                 
+!       print*,'after penman ETP',ETP                                            
+! ----------------------------------------------------------------------         
+!  FROZEN GROUND EXTENSION: TOTAL SOIL WATER "SMC" WAS REPLACED                  
+!  BY UNFROZEN SOIL WATER "SH2O" IN CALL TO CANRES BELOW                         
+! ----------------------------------------------------------------------         
+         IF (SHDFAC > 0.) THEN                                                
+            CALL CANRES (SOLDN,CH,SFCTMP,Q2,SFCPRS,SH2O,ZSOIL,NSOIL,     &        
+                          SMCWLT,SMCREF,RSMIN,RC,PC,NROOT,Q2SAT,DQSDT2,  &
+                          TOPT,RSMAX,RGL,HS,XLAI,                        &
+                          RCS,RCT,RCQ,RCSOIL,EMISSI)                      
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! NOW DECIDE MAJOR PATHWAY BRANCH TO TAKE DEPENDING ON WHETHER SNOWPACK          
+! EXISTS OR NOT:                                                                 
+! ----------------------------------------------------------------------         
+         ESNOW = 0.0                                                             
+         IF (SNEQV  == 0.0) THEN                                                
+            CALL NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                  &  
+                            SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,           &  
+                            SHDFAC,                                      &  
+                            SBETA,Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,EMISSI,  &
+                            SSOIL,                                       &  
+                            STC,EPSCA,BEXP,PC,RCH,RR,CFACTR,             &  
+                            SH2O,SLOPE,KDT,FRZX,PSISAT,ZSOIL,            &  
+                            DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2,       &  
+                            RUNOFF3,EDIR,EC,ET,ETT,NROOT,ICE,RTDIS,      &  
+                            QUARTZ,FXEXP,CSOIL,                          &  
+                            BETA,DRIP,DEW,FLX1,FLX3,VEGTYP)                  
+            ETA_KINEMATIC = ETA                                                  
+            ETA = ETA * LVH2O                                                    
+            ETP = ETP*LVH2O                                                      
+!            BETA = ETA/ETP                                                      
+         ELSE                                                                    
+            CALL SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,    & 
+                         SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,              & 
+                         SBETA,DF1,                                      & 
+                         Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,STC,EPSCA,  & 
+                         SFCPRS,BEXP,PC,RCH,RR,CFACTR,SNCOVR,SNEQV,SNDENS,& 
+                         SNOWH,SH2O,SLOPE,KDT,FRZX,PSISAT,               & 
+                         ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1,     & 
+                         RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT,    & 
+                         ICE,RTDIS,QUARTZ,FXEXP,CSOIL,                   & 
+                         BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW,ETNS,EMISSI, &               
+                         VEGTYP)                                          
+            ETA_KINEMATIC =  ESNOW + ETNS                                        
+            ESNOW = ESNOW * LSUBS                                                
+!           ETA = ESNOW * LSUBS + ETNS * LVH2O                                   
+            ETA = ESNOW + ETNS * LVH2O                                           
+            ETP = ETP*LSUBS                                                      
+!           ETP = ETP* ( (SNCOVR*LSUBS+(1.-SNCOVR)*LVH2O ) 
+!           BETA = ETA/ETP                                                       
+         END IF                                                                  
+                                                                                 
+!     Calculate effective mixing ratio at grnd level (skin)                      
+!                                                                                
+!     Q1=Q2+ETA*CP/RCH                                                           
+     Q1=Q2+ETA_KINEMATIC*CP/RCH                                                 
+!                                                                                
+! ----------------------------------------------------------------------         
+!   PREPARE SENSIBLE HEAT (H) FOR RETURN TO PARENT MODEL                         
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+!  CONVERT UNITS AND/OR SIGN OF TOTAL EVAP (ETA), POTENTIAL EVAP (ETP),          
+!  SUBSURFACE HEAT FLUX (S), AND RUNOFFS FOR WHAT PARENT MODEL EXPECTS           
+!  CONVERT ETA FROM KG M-2 S-1 TO W M-2                                          
+! ----------------------------------------------------------------------         
+!ek      ETA = ETA*LVH2O                                                         
+         SHEAT = - (CH * CP * SFCPRS)/ (R * T2V) * ( TH2- T1 )                   
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONVERT OTHER EVAP TERMS FROM M S-1 TO KG M-2 S-1, THEN TO W M-2               
+! ----------------------------------------------------------------------         
+!      EDIR = EDIR*1000.                                                         
+!      EC = EC*1000.                                                             
+!      DO K = 1,NSOIL                                                            
+!       ET(K) = ET(K)*1000.                                                      
+!      END DO                                                                    
+!      ETT = ETT*1000.                                                           
+                                                                                 
+!        ETP = ETP * LVH2O                                                       
+         EC = EC * LVH2O                                                         
+         EDIR = EDIR * LVH2O                                                     
+         DO K = 1,NSOIL                                                          
+            ET (K) = ET (K)* LVH2O                                               
+         END DO                                                                  
+         ETT = ETT * LVH2O                                                       
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONVERT THE SIGN OF SOIL HEAT FLUX SO THAT:                                    
+!   SSOIL>0: WARM THE SURFACE  (NIGHT TIME)                                      
+!   SSOIL<0: COOL THE SURFACE  (DAY TIME)                                        
+! ----------------------------------------------------------------------         
+!        ESNOW = ESNOW * LVH2O                                                   
+                                                                                 
+! ----------------------------------------------------------------------         
+!  CONVERT RUNOFF3 (INTERNAL LAYER RUNOFF FROM SUPERSAT) FROM M TO M S-1         
+!  AND ADD TO SUBSURFACE RUNOFF/DRAINAGE/BASEFLOW                                
+! ----------------------------------------------------------------------         
+         SSOIL = -1.0* SSOIL                                                     
+         RUNOFF3 = RUNOFF3/ DT                                                   
+                                                                                 
+! ----------------------------------------------------------------------         
+! TOTAL COLUMN SOIL MOISTURE IN METERS (SOILM) AND ROOT-ZONE                     
+! SOIL MOISTURE AVAILABILITY (FRACTION) RELATIVE TO POROSITY/SATURATION          
+! ----------------------------------------------------------------------         
+         RUNOFF2 = RUNOFF2+ RUNOFF3                                              
+         IF (ICE == 0) THEN                                                    
+            SOILM = -1.0* SMC (1)* ZSOIL (1)                                        
+            DO K = 2,NSOIL                                                          
+              SOILM = SOILM + SMC (K)* (ZSOIL (K -1) - ZSOIL (K))                  
+            END DO                                                                  
+            SOILWM = -1.0* (SMCMAX - SMCWLT)* ZSOIL (1)                             
+            SOILWW = -1.0* (SMC (1) - SMCWLT)* ZSOIL (1)                            
+                                                                                 
+            IF (NROOT >= 2) THEN                                                  
+              DO K = 2,NROOT                                                        
+               SOILWM = SOILWM + (SMCMAX - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K))          
+               SOILWW = SOILWW + (SMC(K) - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K))          
+              END DO                                                                
+            END IF                                                                  
+            IF (SOILWM .LT. 1.E-6) THEN                                             
+              SOILWM = 0.0                                                          
+              SOILW  = 0.0                                                          
+              SOILM  = 0.0                                                          
+            ELSE                                                                    
+              SOILW = SOILWW / SOILWM                                               
+            END IF                                                                  
+         ELSE                                                                    
+           SOILWM = 0.0                                                          
+           SOILW  = 0.0                                                          
+           SOILM  = 0.0                                                          
+         END IF                                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SFLX                                                            
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE ALCALC (ALB,SNOALB,SHDFAC,SHDMIN,SNCOVR,TSNOW,ALBEDO)           
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE ALBEDO INCLUDING SNOW EFFECT (0 -> 1)                                
+!   ALB     SNOWFREE ALBEDO                                                      
+!   SNOALB  MAXIMUM (DEEP) SNOW ALBEDO                                           
+!   SHDFAC    AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION                      
+!   SHDMIN    MINIMUM AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION              
+!   SNCOVR  FRACTIONAL SNOW COVER                                                
+!   ALBEDO  SURFACE ALBEDO INCLUDING SNOW EFFECT                                 
+!   TSNOW   SNOW SURFACE TEMPERATURE (K)                                         
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+                                                                                 
+! ----------------------------------------------------------------------         
+! SNOALB IS ARGUMENT REPRESENTING MAXIMUM ALBEDO OVER DEEP SNOW,                 
+! AS PASSED INTO SFLX, AND ADAPTED FROM THE SATELLITE-BASED MAXIMUM              
+! SNOW ALBEDO FIELDS PROVIDED BY D. ROBINSON AND G. KUKLA                        
+! (1985, JCAM, VOL 24, 402-411)                                                  
+! ----------------------------------------------------------------------         
+      REAL, INTENT(IN)  ::  ALB, SNOALB, SHDFAC, SHDMIN, SNCOVR, TSNOW                
+      REAL, INTENT(OUT) ::  ALBEDO
+      ALBEDO = ALB + (1.0- (SHDFAC - SHDMIN))* SNCOVR * (SNOALB - ALB)           
+                                                                                 
+!     BASE FORMULATION (DICKINSON ET AL., 1986, COGLEY ET AL., 1990)             
+!          IF (TSNOW.LE.263.16) THEN                                             
+!            ALBEDO=SNOALB                                                       
+!          ELSE                                                                  
+!            IF (TSNOW.LT.273.16) THEN                                           
+!              TM=0.1*(TSNOW-263.16)                                             
+!              ALBEDO=0.5*((0.9-0.2*(TM**3))+(0.8-0.16*(TM**3)))                 
+!            ELSE                                                                
+!              ALBEDO=0.67                                                       
+!            ENDIF                                                               
+!          ENDIF                                                                 
+                                                                                 
+!     ISBA FORMULATION (VERSEGHY, 1991; BAKER ET AL., 1990)                      
+!          IF (TSNOW.LT.273.16) THEN                                             
+!            ALBEDO=SNOALB-0.008*DT/86400                                        
+!          ELSE                                                                  
+!            ALBEDO=(SNOALB-0.5)*EXP(-0.24*DT/86400)+0.5                         
+!          ENDIF                                                                 
+
+      IF (ALBEDO > SNOALB) ALBEDO = SNOALB                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE ALCALC                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE CANRES (SOLAR,CH,SFCTMP,Q2,SFCPRS,SMC,ZSOIL,NSOIL,       &     
+                         SMCWLT,SMCREF,RSMIN,RC,PC,NROOT,Q2SAT,DQSDT2,    &     
+                         TOPT,RSMAX,RGL,HS,XLAI,                          &     
+                         RCS,RCT,RCQ,RCSOIL,EMISSI)                                    
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE CANRES                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE CANOPY RESISTANCE WHICH DEPENDS ON INCOMING SOLAR RADIATION,         
+! AIR TEMPERATURE, ATMOSPHERIC WATER VAPOR PRESSURE DEFICIT AT THE               
+! LOWEST MODEL LEVEL, AND SOIL MOISTURE (PREFERABLY UNFROZEN SOIL                
+! MOISTURE RATHER THAN TOTAL)                                                    
+! ----------------------------------------------------------------------         
+! SOURCE:  JARVIS (1976), NOILHAN AND PLANTON (1989, MWR), JACQUEMIN AND         
+! NOILHAN (1990, BLM)                                                            
+! SEE ALSO:  CHEN ET AL (1996, JGR, VOL 101(D3), 7251-7268), EQNS 12-14          
+! AND TABLE 2 OF SEC. 3.1.2                                                      
+! ----------------------------------------------------------------------         
+! INPUT:                                                                         
+!   SOLAR   INCOMING SOLAR RADIATION                                             
+!   CH      SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE                   
+!   SFCTMP  AIR TEMPERATURE AT 1ST LEVEL ABOVE GROUND                            
+!   Q2      AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND                               
+!   Q2SAT   SATURATION AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND                    
+!   DQSDT2  SLOPE OF SATURATION HUMIDITY FUNCTION WRT TEMP                       
+!   SFCPRS  SURFACE PRESSURE                                                     
+!   SMC     VOLUMETRIC SOIL MOISTURE                                             
+!   ZSOIL   SOIL DEPTH (NEGATIVE SIGN, AS IT IS BELOW GROUND)                    
+!   NSOIL   NO. OF SOIL LAYERS                                                   
+!   NROOT   NO. OF SOIL LAYERS IN ROOT ZONE (1.LE.NROOT.LE.NSOIL)                
+!   XLAI    LEAF AREA INDEX                                                      
+!   SMCWLT  WILTING POINT                                                        
+!   SMCREF  REFERENCE SOIL MOISTURE (WHERE SOIL WATER DEFICIT STRESS             
+!             SETS IN)                                                           
+! RSMIN, RSMAX, TOPT, RGL, HS ARE CANOPY STRESS PARAMETERS SET IN                
+!   SURBOUTINE REDPRM                                                            
+! OUTPUT:                                                                        
+!   PC  PLANT COEFFICIENT                                                        
+!   RC  CANOPY RESISTANCE                                                        
+! ----------------------------------------------------------------------         
+
+      IMPLICIT NONE                                                              
+      INTEGER, INTENT(IN) :: NROOT,NSOIL
+      INTEGER  K                                                                 
+      REAL,    INTENT(IN) :: CH,DQSDT2,HS,Q2,Q2SAT,RSMIN,RGL,RSMAX,        &
+                             SFCPRS,SFCTMP,SMCREF,SMCWLT, SOLAR,TOPT,XLAI, &
+                             EMISSI                                        
+      REAL,DIMENSION(1:NSOIL), INTENT(IN) :: SMC,ZSOIL
+      REAL,    INTENT(OUT):: PC,RC,RCQ,RCS,RCSOIL,RCT
+      REAL                :: DELTA,FF,GX,P,RR
+      REAL, DIMENSION(1:NSOIL) ::  PART
+      REAL, PARAMETER     :: SLV = 2.501000E6
+
+                                                                                 
+! ----------------------------------------------------------------------         
+! INITIALIZE CANOPY RESISTANCE MULTIPLIER TERMS.                                 
+! ----------------------------------------------------------------------         
+      RCS = 0.0                                                                  
+      RCT = 0.0                                                                  
+      RCQ = 0.0                                                                  
+      RCSOIL = 0.0                                                               
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONTRIBUTION DUE TO INCOMING SOLAR RADIATION                                   
+! ----------------------------------------------------------------------         
+      RC = 0.0                                                                   
+      FF = 0.55*2.0* SOLAR / (RGL * XLAI)                                        
+      RCS = (FF + RSMIN / RSMAX) / (1.0+ FF)                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONTRIBUTION DUE TO AIR TEMPERATURE AT FIRST MODEL LEVEL ABOVE GROUND          
+! RCT EXPRESSION FROM NOILHAN AND PLANTON (1989, MWR).                           
+! ----------------------------------------------------------------------         
+      RCS = MAX (RCS,0.0001)                                                     
+      RCT = 1.0- 0.0016* ( (TOPT - SFCTMP)**2.0)                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONTRIBUTION DUE TO VAPOR PRESSURE DEFICIT AT FIRST MODEL LEVEL.               
+! RCQ EXPRESSION FROM SSIB                                                       
+! ----------------------------------------------------------------------         
+      RCT = MAX (RCT,0.0001)                                                     
+      RCQ = 1.0/ (1.0+ HS * (Q2SAT - Q2))                                        
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONTRIBUTION DUE TO SOIL MOISTURE AVAILABILITY.                                
+! DETERMINE CONTRIBUTION FROM EACH SOIL LAYER, THEN ADD THEM UP.                 
+! ----------------------------------------------------------------------         
+      RCQ = MAX (RCQ,0.01)                                                       
+      GX = (SMC (1) - SMCWLT) / (SMCREF - SMCWLT)                                
+      IF (GX  >  1.) GX = 1.                                                    
+      IF (GX  <  0.) GX = 0.                                                    
+                                                                                 
+! ----------------------------------------------------------------------         
+! USE SOIL DEPTH AS WEIGHTING FACTOR                                             
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! USE ROOT DISTRIBUTION AS WEIGHTING FACTOR                                      
+!      PART(1) = RTDIS(1) * GX                                                   
+! ----------------------------------------------------------------------         
+      PART (1) = (ZSOIL (1)/ ZSOIL (NROOT)) * GX                                 
+      DO K = 2,NROOT                                                             
+         GX = (SMC (K) - SMCWLT) / (SMCREF - SMCWLT)                             
+         IF (GX >  1.) GX = 1.                                                 
+         IF (GX <  0.) GX = 0.                                                 
+! ----------------------------------------------------------------------         
+! USE SOIL DEPTH AS WEIGHTING FACTOR                                             
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! USE ROOT DISTRIBUTION AS WEIGHTING FACTOR                                      
+!        PART(K) = RTDIS(K) * GX                                                 
+! ----------------------------------------------------------------------         
+         PART (K) = ( (ZSOIL (K) - ZSOIL (K -1))/ ZSOIL (NROOT)) * GX            
+      END DO                                                                     
+      DO K = 1,NROOT                                                             
+         RCSOIL = RCSOIL + PART (K)                                              
+      END DO                                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! DETERMINE CANOPY RESISTANCE DUE TO ALL FACTORS.  CONVERT CANOPY                
+! RESISTANCE (RC) TO PLANT COEFFICIENT (PC) TO BE USED WITH POTENTIAL            
+! EVAP IN DETERMINING ACTUAL EVAP.  PC IS DETERMINED BY:                         
+!   PC * LINERIZED PENMAN POTENTIAL EVAP =                                       
+!   PENMAN-MONTEITH ACTUAL EVAPORATION (CONTAINING RC TERM).                     
+! ----------------------------------------------------------------------         
+      RCSOIL = MAX (RCSOIL,0.0001)                                               
+                                                                                 
+      RC = RSMIN / (XLAI * RCS * RCT * RCQ * RCSOIL)                             
+!      RR = (4.* SIGMA * RD / CP)* (SFCTMP **4.)/ (SFCPRS * CH) + 1.0
+      RR = (4.* EMISSI *SIGMA * RD / CP)* (SFCTMP **4.)/ (SFCPRS * CH) &
+             + 1.0             
+                                                                                 
+      DELTA = (SLV / CP)* DQSDT2                                                 
+                                                                                 
+      PC = (RR + DELTA)/ (RR * (1. + RC * CH) + DELTA)                           
+
+! ----------------------------------------------------------------------         
+  END SUBROUTINE CANRES                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE CSNOW (SNCOND,DSNOW)                                            
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE CSNOW                                                               
+! FUNCTION CSNOW                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE SNOW TERMAL CONDUCTIVITY                                             
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      REAL, INTENT(IN) :: DSNOW
+      REAL, INTENT(OUT):: SNCOND
+      REAL             :: C                                                                 
+      REAL, PARAMETER  :: UNIT = 0.11631
+                                                                                 
+! ----------------------------------------------------------------------         
+! SNCOND IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C)                          
+! CSNOW IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C)                           
+! BASIC VERSION IS DYACHKOVA EQUATION (1960), FOR RANGE 0.1-0.4                  
+! ----------------------------------------------------------------------         
+      C = 0.328*10** (2.25* DSNOW)                                               
+!      CSNOW=UNIT*C                                                              
+                                                                                 
+! ----------------------------------------------------------------------         
+! DE VAUX EQUATION (1933), IN RANGE 0.1-0.6                                      
+! ----------------------------------------------------------------------         
+!      SNCOND=0.0293*(1.+100.*DSNOW**2)                                          
+!      CSNOW=0.0293*(1.+100.*DSNOW**2)                                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! E. ANDERSEN FROM FLERCHINGER                                                   
+! ----------------------------------------------------------------------         
+!      SNCOND=0.021+2.51*DSNOW**2                                                
+!      CSNOW=0.021+2.51*DSNOW**2                                                 
+                                                                                 
+      SNCOND = UNIT * C                                                          
+
+! ----------------------------------------------------------------------         
+  END SUBROUTINE CSNOW                                                           
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE DEVAP (EDIR,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP,         &        
+                        DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP)               
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE DEVAP                                                               
+! FUNCTION DEVAP                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE DIRECT SOIL EVAPORATION                                              
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      REAL, INTENT(IN) :: ETP1,SMC,BEXP,DKSAT,DWSAT,FXEXP,              &
+                          SHDFAC,SMCDRY,SMCMAX,ZSOIL,SMCREF,SMCWLT
+      REAL, INTENT(OUT):: EDIR
+      REAL             :: FX, SRATIO
+
+                                                                                 
+! ----------------------------------------------------------------------         
+! DIRECT EVAP A FUNCTION OF RELATIVE SOIL MOISTURE AVAILABILITY, LINEAR          
+! WHEN FXEXP=1.                                                                  
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! FX > 1 REPRESENTS DEMAND CONTROL                                               
+! FX < 1 REPRESENTS FLUX CONTROL                                                 
+! ----------------------------------------------------------------------         
+
+      SRATIO = (SMC - SMCDRY) / (SMCMAX - SMCDRY)                                
+      IF (SRATIO > 0.) THEN                                                   
+        FX = SRATIO**FXEXP                                                       
+        FX = MAX ( MIN ( FX, 1. ) ,0. )                                          
+      ELSE                                                                       
+        FX = 0.                                                                  
+      ENDIF                                                                      
+                                                                                 
+! ----------------------------------------------------------------------         
+! ALLOW FOR THE DIRECT-EVAP-REDUCING EFFECT OF SHADE                             
+! ----------------------------------------------------------------------         
+      EDIR = FX * ( 1.0- SHDFAC ) * ETP1                                         
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE DEVAP                                                           
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,               &        
+                         SH2O,                                          &        
+                         SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,             &        
+                         SMCREF,SHDFAC,CMCMAX,                          &        
+                         SMCDRY,CFACTR,                                 &        
+                         EDIR,EC,ET,ETT,SFCTMP,Q2,NROOT,RTDIS,FXEXP)             
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE EVAPO                                                               
+! ----------------------------------------------------------------------         
+! CALCULATE SOIL MOISTURE FLUX.  THE SOIL MOISTURE CONTENT (SMC - A PER          
+! UNIT VOLUME MEASUREMENT) IS A DEPENDENT VARIABLE THAT IS UPDATED WITH          
+! PROGNOSTIC EQNS. THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED.            
+! FROZEN GROUND VERSION:  NEW STATES ADDED: SH2O, AND FROZEN GROUND              
+! CORRECTION FACTOR, FRZFACT AND PARAMETER SLOPE.                                
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      INTEGER, INTENT(IN)   :: NSOIL, NROOT
+      INTEGER               :: I,K
+      REAL,    INTENT(IN)   :: BEXP, CFACTR,CMC,CMCMAX,DKSAT,           &
+                                 DT,DWSAT,ETP1,FXEXP,PC,Q2,SFCTMP,      &
+                                 SHDFAC,SMCDRY,SMCMAX,SMCREF,SMCWLT
+      REAL,    INTENT(OUT)  :: EC,EDIR,ETA1,ETT
+      REAL                  :: CMC2MS
+      REAL,DIMENSION(1:NSOIL), INTENT(IN) :: RTDIS, SMC, SH2O, ZSOIL
+      REAL,DIMENSION(1:NSOIL), INTENT(OUT) :: ET
+                                                                                
+! ----------------------------------------------------------------------         
+! EXECUTABLE CODE BEGINS HERE IF THE POTENTIAL EVAPOTRANSPIRATION IS             
+! GREATER THAN ZERO.                                                             
+! ----------------------------------------------------------------------         
+      EDIR = 0.                                                                  
+      EC = 0.                                                                    
+      ETT = 0.                                                                   
+      DO K = 1,NSOIL                                                             
+         ET (K) = 0.                                                             
+      END DO                                                                     
+                                                                                 
+!      print*,'SHDFAC',SHDFAC,'SMCMAX', SMCMAX,'BEXP',BEXP,                      
+!    & 'DKSAT',DKSAT,'DWSAT',DWSAT,'DRY',SMCDRY,'REF',SMCREF,                    
+!    & 'WLT',SMCWLT,'FXEX',FXEXP,'SMC',SMC                                       
+! ----------------------------------------------------------------------         
+! RETRIEVE DIRECT EVAPORATION FROM SOIL SURFACE.  CALL THIS FUNCTION             
+! ONLY IF VEG COVER NOT COMPLETE.                                                
+! FROZEN GROUND VERSION:  SH2O STATES REPLACE SMC STATES.                        
+! ----------------------------------------------------------------------         
+      IF (ETP1 > 0.0) THEN                                                    
+         IF (SHDFAC <  1.) THEN                                                
+!            CALL DEVAP (EDIR,ETP1,SH2O (1),ZSOIL (1),SHDFAC,SMCMAX,             
+             CALL DEVAP (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX,      &       
+                         BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP)            
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! INITIALIZE PLANT TOTAL TRANSPIRATION, RETRIEVE PLANT TRANSPIRATION,            
+! AND ACCUMULATE IT FOR ALL SOIL LAYERS.                                         
+! ----------------------------------------------------------------------         
+                                                                                 
+         IF (SHDFAC > 0.0) THEN                                               
+            CALL TRANSP (ET,NSOIL,ETP1,SH2O,CMC,ZSOIL,SHDFAC,SMCWLT,     &       
+                          CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT,RTDIS)         
+            DO K = 1,NSOIL                                                       
+               ETT = ETT + ET ( K )                                              
+            END DO                                                               
+! ----------------------------------------------------------------------         
+! CALCULATE CANOPY EVAPORATION.                                                  
+! IF STATEMENTS TO AVOID TANGENT LINEAR PROBLEMS NEAR CMC=0.0.                   
+! ----------------------------------------------------------------------         
+            IF (CMC > 0.0) THEN                                               
+               EC = SHDFAC * ( ( CMC / CMCMAX ) ** CFACTR ) * ETP1               
+            ELSE                                                                 
+               EC = 0.0                                                          
+            END IF                                                               
+! ----------------------------------------------------------------------         
+! EC SHOULD BE LIMITED BY THE TOTAL AMOUNT OF AVAILABLE WATER ON THE             
+! CANOPY.  -F.CHEN, 18-OCT-1994                                                  
+! ----------------------------------------------------------------------         
+            CMC2MS = CMC / DT                                                    
+            EC = MIN ( CMC2MS, EC )                                              
+         END IF                                                                  
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+! TOTAL UP EVAP AND TRANSP TYPES TO OBTAIN ACTUAL EVAPOTRANSP                    
+! ----------------------------------------------------------------------         
+      ETA1 = EDIR + ETT + EC                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE EVAPO                                                           
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE FRH2O (FREE,TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS)                    
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE FRH2O                                                               
+! ----------------------------------------------------------------------         
+! CALCULATE AMOUNT OF SUPERCOOLED LIQUID SOIL WATER CONTENT IF                   
+! TEMPERATURE IS BELOW 273.15K (T0).  REQUIRES NEWTON-TYPE ITERATION TO          
+! SOLVE THE NONLINEAR IMPLICIT EQUATION GIVEN IN EQN 17 OF KOREN ET AL           
+! (1999, JGR, VOL 104(D16), 19569-19585).                                        
+! ----------------------------------------------------------------------         
+! NEW VERSION (JUNE 2001): MUCH FASTER AND MORE ACCURATE NEWTON                  
+! ITERATION ACHIEVED BY FIRST TAKING LOG OF EQN CITED ABOVE -- LESS THAN         
+! 4 (TYPICALLY 1 OR 2) ITERATIONS ACHIEVES CONVERGENCE.  ALSO, EXPLICIT          
+! 1-STEP SOLUTION OPTION FOR SPECIAL CASE OF PARAMETER CK=0, WHICH               
+! REDUCES THE ORIGINAL IMPLICIT EQUATION TO A SIMPLER EXPLICIT FORM,             
+! KNOWN AS THE "FLERCHINGER EQN". IMPROVED HANDLING OF SOLUTION IN THE           
+! LIMIT OF FREEZING POINT TEMPERATURE T0.                                        
+! ----------------------------------------------------------------------         
+! INPUT:                                                                         
+                                                                                 
+!   TKELV.........TEMPERATURE (Kelvin)                                           
+!   SMC...........TOTAL SOIL MOISTURE CONTENT (VOLUMETRIC)                       
+!   SH2O..........LIQUID SOIL MOISTURE CONTENT (VOLUMETRIC)                      
+!   SMCMAX........SATURATION SOIL MOISTURE CONTENT (FROM REDPRM)                 
+!   B.............SOIL TYPE "B" PARAMETER (FROM REDPRM)                          
+!   PSIS..........SATURATED SOIL MATRIC POTENTIAL (FROM REDPRM)                  
+                                                                                 
+! OUTPUT:                                                                        
+!   FRH2O.........SUPERCOOLED LIQUID WATER CONTENT                               
+!   FREE..........SUPERCOOLED LIQUID WATER CONTENT                               
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      REAL, INTENT(IN)     :: BEXP,PSIS,SH2O,SMC,SMCMAX,TKELV
+      REAL, INTENT(OUT)    :: FREE
+      REAL                 :: BX,DENOM,DF,DSWL,FK,SWL,SWLK
+      INTEGER              :: NLOG,KCOUNT
+!      PARAMETER(CK = 0.0)                                                       
+      REAL, PARAMETER      :: CK = 8.0, BLIM = 5.5, ERROR = 0.005,       &
+                              HLICE = 3.335E5, GS = 9.81,DICE = 920.0,   &
+                              DH2O = 1000.0, T0 = 273.15
+                                                                                 
+! ----------------------------------------------------------------------         
+! LIMITS ON PARAMETER B: B < 5.5  (use parameter BLIM)                           
+! SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT IS                        
+! NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES.                               
+! ----------------------------------------------------------------------         
+      BX = BEXP                                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG.                   
+! ----------------------------------------------------------------------         
+      IF (BEXP >  BLIM) BX = BLIM                                              
+      NLOG = 0                                                                   
+                                                                                 
+! ----------------------------------------------------------------------         
+!  IF TEMPERATURE NOT SIGNIFICANTLY BELOW FREEZING (T0), SH2O = SMC              
+! ----------------------------------------------------------------------         
+      KCOUNT = 0                                                                 
+!      FRH2O = SMC                                                               
+      IF (TKELV > (T0- 1.E-3)) THEN                                           
+          FREE = SMC                                                             
+      ELSE                                                                       
+                                                                                 
+! ----------------------------------------------------------------------         
+! OPTION 1: ITERATED SOLUTION FOR NONZERO CK                                     
+! IN KOREN ET AL, JGR, 1999, EQN 17                                              
+! ----------------------------------------------------------------------         
+! INITIAL GUESS FOR SWL (frozen content)                                         
+! ----------------------------------------------------------------------         
+         IF (CK /= 0.0) THEN                                                   
+            SWL = SMC - SH2O                                                     
+! ----------------------------------------------------------------------         
+! KEEP WITHIN BOUNDS.                                                            
+! ----------------------------------------------------------------------         
+            IF (SWL > (SMC -0.02)) SWL = SMC -0.02                            
+                                                                                 
+! ----------------------------------------------------------------------         
+!  START OF ITERATIONS                                                           
+! ----------------------------------------------------------------------         
+            IF (SWL < 0.) SWL = 0.                                            
+ 1001       Continue                                                             
+              IF (.NOT.( (NLOG < 10) .AND. (KCOUNT == 0)))   goto 1002
+              NLOG = NLOG +1                                                    
+              DF = ALOG ( ( PSIS * GS / HLICE ) * ( ( 1. + CK * SWL )**2.) * &        
+                   ( SMCMAX / (SMC - SWL) )** BX) - ALOG ( - (               &        
+                   TKELV - T0)/ TKELV)                                         
+              DENOM = 2. * CK / ( 1. + CK * SWL ) + BX / ( SMC - SWL )          
+              SWLK = SWL - DF / DENOM                                           
+! ----------------------------------------------------------------------         
+! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION.                                       
+! ----------------------------------------------------------------------         
+              IF (SWLK > (SMC -0.02)) SWLK = SMC - 0.02                      
+              IF (SWLK < 0.) SWLK = 0.                                       
+                                                                                 
+! ----------------------------------------------------------------------         
+! MATHEMATICAL SOLUTION BOUNDS APPLIED.                                          
+! ----------------------------------------------------------------------         
+              DSWL = ABS (SWLK - SWL)                                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.)                 
+! WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED.                      
+! ----------------------------------------------------------------------         
+              SWL = SWLK                                                        
+              IF ( DSWL <= ERROR ) THEN                                       
+                    KCOUNT = KCOUNT +1                                           
+              END IF                                                            
+! ----------------------------------------------------------------------         
+!  END OF ITERATIONS                                                             
+! ----------------------------------------------------------------------         
+! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION.                
+! ----------------------------------------------------------------------         
+!          FRH2O = SMC - SWL                                                     
+           goto 1001                                                                
+ 1002   continue                                                                 
+           FREE = SMC - SWL                                                     
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! END OPTION 1                                                                   
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0                      
+! IN KOREN ET AL., JGR, 1999, EQN 17                                             
+! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION                                  
+! ----------------------------------------------------------------------         
+         IF (KCOUNT == 0) THEN                                                 
+             PRINT *,'Flerchinger USEd in NEW version. Iterations=',NLOG         
+                  FK = ( ( (HLICE / (GS * ( - PSIS)))*                    &       
+                       ( (TKELV - T0)/ TKELV))** ( -1/ BX))* SMCMAX              
+!            FRH2O = MIN (FK, SMC)                                               
+             IF (FK < 0.02) FK = 0.02                                         
+             FREE = MIN (FK, SMC)                                                
+! ----------------------------------------------------------------------         
+! END OPTION 2                                                                   
+! ----------------------------------------------------------------------         
+         END IF                                                                  
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE FRH2O                                                           
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &        
+                       TBOT,ZBOT,PSISAT,SH2O,DT,BEXP,                   &        
+                       F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP)                             
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE HRT                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL            
+! THERMAL DIFFUSION EQUATION.  ALSO TO COMPUTE ( PREPARE ) THE MATRIX            
+! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME.          
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      LOGICAL              :: ITAVG 
+      INTEGER, INTENT(IN)  :: NSOIL, VEGTYP                              
+      INTEGER              :: I, K
+
+      REAL, INTENT(IN)     :: BEXP, CSOIL, DF1, DT,F1,PSISAT,QUARTZ,     &
+                              SMCMAX ,TBOT,YY,ZZ1, ZBOT
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: SMC,STC,ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: SH2O
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: RHSTS
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: AI, BI,CI
+      REAL                 :: DDZ, DDZ2, DENOM, DF1N, DF1K, DTSDZ,       &
+                              DTSDZ2,HCPCT,QTOT,SSOIL,SICE,TAVG,TBK,     &
+                              TBK1,TSNSR,TSURF,CSOIL_LOC
+      REAL, PARAMETER      :: T0 = 273.15, CAIR = 1004.0, CICE = 2.106E6,&
+                              CH2O = 4.2E6
+                                                                                 
+
+!urban
+        IF(VEGTYP==1) then
+            CSOIL_LOC=3.0E6
+        ELSE
+            CSOIL_LOC=CSOIL
+        ENDIF
+
+! ----------------------------------------------------------------------         
+! INITIALIZE LOGICAL FOR SOIL LAYER TEMPERATURE AVERAGING.                       
+! ----------------------------------------------------------------------         
+       ITAVG = .TRUE.                                                            
+! ----------------------------------------------------------------------         
+! BEGIN SECTION FOR TOP SOIL LAYER                                               
+! ----------------------------------------------------------------------         
+! CALC THE HEAT CAPACITY OF THE TOP SOIL LAYER                                   
+! ----------------------------------------------------------------------         
+      HCPCT = SH2O (1)* CH2O + (1.0- SMCMAX)* CSOIL_LOC + (SMCMAX - SMC (1))&        
+       * CAIR                                                           &        
+              + ( SMC (1) - SH2O (1) )* CICE                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER                  
+! ----------------------------------------------------------------------         
+      DDZ = 1.0 / ( -0.5 * ZSOIL (2) )                                           
+      AI (1) = 0.0                                                               
+      CI (1) = (DF1 * DDZ) / (ZSOIL (1) * HCPCT)                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE THE VERTICAL SOIL TEMP GRADIENT BTWN THE 1ST AND 2ND SOIL            
+! LAYERS.  THEN CALCULATE THE SUBSURFACE HEAT FLUX. USE THE TEMP                 
+! GRADIENT AND SUBSFC HEAT FLUX TO CALC "RIGHT-HAND SIDE TENDENCY                
+! TERMS", OR "RHSTS", FOR TOP SOIL LAYER.                                        
+! ----------------------------------------------------------------------         
+      BI (1) = - CI (1) + DF1 / (0.5 * ZSOIL (1) * ZSOIL (1)* HCPCT *    &       
+       ZZ1)                                                                      
+      DTSDZ = (STC (1) - STC (2)) / ( -0.5 * ZSOIL (2))                          
+      SSOIL = DF1 * (STC (1) - YY) / (0.5 * ZSOIL (1) * ZZ1)                     
+!      RHSTS(1) = (DF1 * DTSDZ - SSOIL) / (ZSOIL(1) * HCPCT)                     
+      DENOM = (ZSOIL (1) * HCPCT)                                                
+                                                                                 
+! ----------------------------------------------------------------------         
+! NEXT CAPTURE THE VERTICAL DIFFERENCE OF THE HEAT FLUX AT TOP AND               
+! BOTTOM OF FIRST SOIL LAYER FOR USE IN HEAT FLUX CONSTRAINT APPLIED TO          
+! POTENTIAL SOIL FREEZING/THAWING IN ROUTINE SNKSRC.                             
+! ----------------------------------------------------------------------         
+!      QTOT = SSOIL - DF1*DTSDZ                                                  
+      RHSTS (1) = (DF1 * DTSDZ - SSOIL) / DENOM                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE FROZEN WATER CONTENT IN 1ST SOIL LAYER.                              
+! ----------------------------------------------------------------------         
+      QTOT = -1.0* RHSTS (1)* DENOM                                              
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP):                      
+! SET TEMP "TSURF" AT TOP OF SOIL COLUMN (FOR USE IN FREEZING SOIL               
+! PHYSICS LATER IN FUNCTION SUBROUTINE SNKSRC).  IF SNOWPACK CONTENT IS          
+! ZERO, THEN TSURF EXPRESSION BELOW GIVES TSURF = SKIN TEMP.  IF                 
+! SNOWPACK IS NONZERO (HENCE ARGUMENT ZZ1=1), THEN TSURF EXPRESSION              
+! BELOW YIELDS SOIL COLUMN TOP TEMPERATURE UNDER SNOWPACK.  THEN                 
+! CALCULATE TEMPERATURE AT BOTTOM INTERFACE OF 1ST SOIL LAYER FOR USE            
+! LATER IN FUNCTION SUBROUTINE SNKSRC                                            
+! ----------------------------------------------------------------------         
+      SICE = SMC (1) - SH2O (1)                                                  
+      IF (ITAVG) THEN                                                            
+         TSURF = (YY + (ZZ1-1) * STC (1)) / ZZ1                                  
+! ----------------------------------------------------------------------         
+! IF FROZEN WATER PRESENT OR ANY OF LAYER-1 MID-POINT OR BOUNDING                
+! INTERFACE TEMPERATURES BELOW FREEZING, THEN CALL SNKSRC TO                     
+! COMPUTE HEAT SOURCE/SINK (AND CHANGE IN FROZEN WATER CONTENT)                  
+! DUE TO POSSIBLE SOIL WATER PHASE CHANGE                                        
+! ----------------------------------------------------------------------         
+         CALL TBND (STC (1),STC (2),ZSOIL,ZBOT,1,NSOIL,TBK)                      
+         IF ( (SICE > 0.) .OR. (STC (1) < T0) .OR.                         &  
+            (TSURF < T0) .OR. (TBK < T0) ) THEN                            
+!          TSNSR = SNKSRC (TAVG,SMC(1),SH2O(1),                                  
+            CALL TMPAVG (TAVG,TSURF,STC (1),TBK,ZSOIL,NSOIL,1)                   
+            CALL SNKSRC (TSNSR,TAVG,SMC (1),SH2O (1),                      &  
+                          ZSOIL,NSOIL,SMCMAX,PSISAT,BEXP,DT,1,QTOT)              
+!          RHSTS(1) = RHSTS(1) - TSNSR / ( ZSOIL(1) * HCPCT )                    
+            RHSTS (1) = RHSTS (1) - TSNSR / DENOM                                
+         END IF                                                                  
+      ELSE                                                                       
+!          TSNSR = SNKSRC (STC(1),SMC(1),SH2O(1),                                
+         IF ( (SICE > 0.) .OR. (STC (1) < T0) ) THEN                       
+            CALL SNKSRC (TSNSR,STC (1),SMC (1),SH2O (1),                   &  
+                          ZSOIL,NSOIL,SMCMAX,PSISAT,BEXP,DT,1,QTOT)              
+!          RHSTS(1) = RHSTS(1) - TSNSR / ( ZSOIL(1) * HCPCT )                    
+            RHSTS (1) = RHSTS (1) - TSNSR / DENOM                                
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! THIS ENDS SECTION FOR TOP SOIL LAYER.                                          
+! ----------------------------------------------------------------------         
+      END IF                                                                     
+
+! INITIALIZE DDZ2                                                                
+! ----------------------------------------------------------------------         
+                                                                                 
+      DDZ2 = 0.0                                                                 
+      DF1K = DF1                                                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS               
+! (EXCEPT SUBSFC OR "GROUND" HEAT FLUX NOT REPEATED IN LOWER LAYERS)             
+! ----------------------------------------------------------------------         
+! CALCULATE HEAT CAPACITY FOR THIS SOIL LAYER.                                   
+! ----------------------------------------------------------------------         
+      DO K = 2,NSOIL                                                             
+         HCPCT = SH2O (K)* CH2O + (1.0- SMCMAX)* CSOIL_LOC + (SMCMAX - SMC (  &        
+                K))* CAIR + ( SMC (K) - SH2O (K) )* CICE                                
+! ----------------------------------------------------------------------         
+! THIS SECTION FOR LAYER 2 OR GREATER, BUT NOT LAST LAYER.                       
+! ----------------------------------------------------------------------         
+! CALCULATE THERMAL DIFFUSIVITY FOR THIS LAYER.                                  
+! ----------------------------------------------------------------------         
+         IF (K /= NSOIL) THEN                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER                           
+! ----------------------------------------------------------------------         
+            CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K))                    
+
+!urban
+       IF(VEGTYP==1) DF1N = 3.24
+
+            DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) )                        
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT                    
+! ----------------------------------------------------------------------         
+            DTSDZ2 = ( STC (K) - STC (K +1) ) / DENOM                            
+            DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1))                            
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP):  CALCULATE           
+! TEMP AT BOTTOM OF LAYER.                                                       
+! ----------------------------------------------------------------------         
+            CI (K) = - DF1N * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K)) *      &       
+       HCPCT)                                                                    
+            IF (ITAVG) THEN                                                      
+               CALL TBND (STC (K),STC (K +1),ZSOIL,ZBOT,K,NSOIL,TBK1)            
+            END IF                                                               
+
+         ELSE                                                                    
+! ----------------------------------------------------------------------         
+! SPECIAL CASE OF BOTTOM SOIL LAYER:  CALCULATE THERMAL DIFFUSIVITY FOR          
+! BOTTOM LAYER.                                                                  
+! ----------------------------------------------------------------------         
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU BOTTOM LAYER.                        
+! ----------------------------------------------------------------------         
+            CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K))                    
+
+
+!urban
+       IF(VEGTYP==1) DF1N = 3.24
+
+            DENOM = .5 * (ZSOIL (K -1) + ZSOIL (K)) - ZBOT                       
+                                                                                 
+! ----------------------------------------------------------------------         
+! SET MATRIX COEF, CI TO ZERO IF BOTTOM LAYER.                                   
+! ----------------------------------------------------------------------         
+            DTSDZ2 = (STC (K) - TBOT) / DENOM                                    
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP):  CALCULATE           
+! TEMP AT BOTTOM OF LAST LAYER.                                                  
+! ----------------------------------------------------------------------         
+            CI (K) = 0.                                                          
+            IF (ITAVG) THEN                                                      
+               CALL TBND (STC (K),TBOT,ZSOIL,ZBOT,K,NSOIL,TBK1)                  
+            END IF                                                               
+! ----------------------------------------------------------------------         
+! THIS ENDS SPECIAL LOOP FOR BOTTOM LAYER.                                       
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! CALCULATE RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT.                
+! ----------------------------------------------------------------------         
+         DENOM = ( ZSOIL (K) - ZSOIL (K -1) ) * HCPCT                            
+         RHSTS (K) = ( DF1N * DTSDZ2- DF1K * DTSDZ ) / DENOM                     
+         QTOT = -1.0* DENOM * RHSTS (K)                                          
+                                                                                 
+         SICE = SMC (K) - SH2O (K)                                               
+         IF (ITAVG) THEN                                                         
+            CALL TMPAVG (TAVG,TBK,STC (K),TBK1,ZSOIL,NSOIL,K)                    
+!            TSNSR = SNKSRC(TAVG,SMC(K),SH2O(K),ZSOIL,NSOIL,                     
+            IF ( (SICE > 0.) .OR. (STC (K) < T0) .OR.                   &  
+               (TBK .lt. T0) .OR. (TBK1 .lt. T0) ) THEN                          
+               CALL SNKSRC (TSNSR,TAVG,SMC (K),SH2O (K),ZSOIL,NSOIL,    &        
+                             SMCMAX,PSISAT,BEXP,DT,K,QTOT)                       
+               RHSTS (K) = RHSTS (K) - TSNSR / DENOM                             
+            END IF                                                               
+         ELSE                                                                    
+!            TSNSR = SNKSRC(STC(K),SMC(K),SH2O(K),ZSOIL,NSOIL,                   
+            IF ( (SICE > 0.) .OR. (STC (K) < T0) ) THEN                    
+               CALL SNKSRC (TSNSR,STC (K),SMC (K),SH2O (K),ZSOIL,NSOIL, &        
+                             SMCMAX,PSISAT,BEXP,DT,K,QTOT)                       
+               RHSTS (K) = RHSTS (K) - TSNSR / DENOM                             
+            END IF                                                               
+         END IF                                                                  
+
+! ----------------------------------------------------------------------         
+! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER.                                  
+! ----------------------------------------------------------------------         
+         AI (K) = - DF1 * DDZ / ( (ZSOIL (K -1) - ZSOIL (K)) * HCPCT)            
+                                                                                 
+! ----------------------------------------------------------------------         
+! RESET VALUES OF DF1, DTSDZ, DDZ, AND TBK FOR LOOP TO NEXT SOIL LAYER.          
+! ----------------------------------------------------------------------         
+         BI (K) = - (AI (K) + CI (K))                                            
+         TBK = TBK1                                                              
+         DF1K = DF1N                                                             
+         DTSDZ = DTSDZ2                                                          
+         DDZ = DDZ2                                                              
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE HRT                                                             
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE HRTICE (RHSTS,STC,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)              
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE HRTICE                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL            
+! THERMAL DIFFUSION EQUATION IN THE CASE OF SEA-ICE PACK.  ALSO TO               
+! COMPUTE (PREPARE) THE MATRIX COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX          
+! OF THE IMPLICIT TIME SCHEME.                                                   
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+
+
+      INTEGER, INTENT(IN)    :: NSOIL
+      INTEGER                :: K
+
+      REAL,    INTENT(IN)    :: DF1,YY,ZZ1
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: AI, BI,CI
+      REAL, DIMENSION(1:NSOIL), INTENT(IN) :: STC, ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: RHSTS
+      REAL                   :: DDZ,DDZ2,DENOM,DTSDZ,DTSDZ2,SSOIL,       &
+                                ZBOT,TBOT
+      REAL, PARAMETER        :: HCPCT = 1.72396E+6
+                                                                                 
+! ----------------------------------------------------------------------         
+! SET A NOMINAL UNIVERSAL VALUE OF THE SEA-ICE SPECIFIC HEAT CAPACITY,           
+! HCPCT = 1880.0*917.0.                                                          
+! ----------------------------------------------------------------------         
+      DATA TBOT /271.16/                                                         
+                                                                                 
+! ----------------------------------------------------------------------         
+! THE INPUT ARGUMENT DF1 IS A UNIVERSALLY CONSTANT VALUE OF SEA-ICE              
+! THERMAL DIFFUSIVITY, SET IN ROUTINE SNOPAC AS DF1 = 2.2.                       
+! ----------------------------------------------------------------------         
+! SET ICE PACK DEPTH.  USE TBOT AS ICE PACK LOWER BOUNDARY TEMPERATURE           
+! (THAT OF UNFROZEN SEA WATER AT BOTTOM OF SEA ICE PACK).  ASSUME ICE            
+! PACK IS OF N=NSOIL LAYERS SPANNING A UNIFORM CONSTANT ICE PACK                 
+! THICKNESS AS DEFINED BY ZSOIL(NSOIL) IN ROUTINE SFLX.                          
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER                  
+! ----------------------------------------------------------------------         
+      ZBOT = ZSOIL (NSOIL)                                                       
+      DDZ = 1.0 / ( -0.5 * ZSOIL (2) )                                           
+      AI (1) = 0.0                                                               
+      CI (1) = (DF1 * DDZ) / (ZSOIL (1) * HCPCT)                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC THE VERTICAL SOIL TEMP GRADIENT BTWN THE TOP AND 2ND SOIL LAYERS.         
+! RECALC/ADJUST THE SOIL HEAT FLUX.  USE THE GRADIENT AND FLUX TO CALC           
+! RHSTS FOR THE TOP SOIL LAYER.                                                  
+! ----------------------------------------------------------------------         
+      BI (1) = - CI (1) + DF1/ (0.5 * ZSOIL (1) * ZSOIL (1) * HCPCT *    &       
+       ZZ1)                                                                      
+      DTSDZ = ( STC (1) - STC (2) ) / ( -0.5 * ZSOIL (2) )                       
+      SSOIL = DF1 * ( STC (1) - YY ) / ( 0.5 * ZSOIL (1) * ZZ1 )                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! INITIALIZE DDZ2                                                                
+! ----------------------------------------------------------------------         
+      RHSTS (1) = ( DF1 * DTSDZ - SSOIL ) / ( ZSOIL (1) * HCPCT )                
+                                                                                 
+! ----------------------------------------------------------------------         
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS               
+! ----------------------------------------------------------------------         
+      DDZ2 = 0.0                                                                 
+      DO K = 2,NSOIL                                                             
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER.                          
+! ----------------------------------------------------------------------         
+         IF (K /= NSOIL) THEN                                                  
+            DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) )                        
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT.                   
+! ----------------------------------------------------------------------         
+            DTSDZ2 = ( STC (K) - STC (K +1) ) / DENOM                            
+            DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1))                            
+            CI (K) = - DF1 * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K))*HCPCT)          
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THE LOWEST LAYER.                    
+! ----------------------------------------------------------------------         
+         ELSE                                                                    
+                                                                                 
+! ----------------------------------------------------------------------         
+! SET MATRIX COEF, CI TO ZERO.                                                   
+! ----------------------------------------------------------------------         
+            DTSDZ2 = (STC (K) - TBOT)/ (.5 * (ZSOIL (K -1) + ZSOIL (K)) &        
+                     - ZBOT)                                                     
+            CI (K) = 0.                                                          
+! ----------------------------------------------------------------------         
+! CALC RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT.                     
+! ----------------------------------------------------------------------         
+         END IF                                                                  
+         DENOM = ( ZSOIL (K) - ZSOIL (K -1) ) * HCPCT                            
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER.                                  
+! ----------------------------------------------------------------------         
+         RHSTS (K) = ( DF1 * DTSDZ2- DF1 * DTSDZ ) / DENOM                       
+         AI (K) = - DF1 * DDZ / ( (ZSOIL (K -1) - ZSOIL (K)) * HCPCT)            
+                                                                                 
+! ----------------------------------------------------------------------         
+! RESET VALUES OF DTSDZ AND DDZ FOR LOOP TO NEXT SOIL LYR.                       
+! ----------------------------------------------------------------------         
+         BI (K) = - (AI (K) + CI (K))                                            
+         DTSDZ = DTSDZ2                                                          
+         DDZ = DDZ2                                                              
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE HRTICE                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI)                    
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE HSTEP                                                               
+! ----------------------------------------------------------------------         
+! CALCULATE/UPDATE THE SOIL TEMPERATURE FIELD.                                   
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      INTEGER, INTENT(IN)  :: NSOIL
+      INTEGER              :: K
+                                                                                 
+      REAL, DIMENSION(1:NSOIL), INTENT(IN):: STCIN
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: STCOUT
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: RHSTS
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: AI,BI,CI
+      REAL, DIMENSION(1:NSOIL) :: RHSTSin
+      REAL, DIMENSION(1:NSOIL) :: CIin
+      REAL                 :: DT
+                                                                                 
+! ----------------------------------------------------------------------         
+! CREATE FINITE DIFFERENCE VALUES FOR USE IN ROSR12 ROUTINE                      
+! ----------------------------------------------------------------------         
+      DO K = 1,NSOIL                                                             
+         RHSTS (K) = RHSTS (K) * DT                                              
+         AI (K) = AI (K) * DT                                                    
+         BI (K) = 1. + BI (K) * DT                                               
+         CI (K) = CI (K) * DT                                                    
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12                          
+! ----------------------------------------------------------------------         
+      DO K = 1,NSOIL                                                             
+         RHSTSin (K) = RHSTS (K)                                                 
+      END DO                                                                     
+      DO K = 1,NSOIL                                                             
+         CIin (K) = CI (K)                                                       
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+! SOLVE THE TRI-DIAGONAL MATRIX EQUATION                                         
+! ----------------------------------------------------------------------         
+      CALL ROSR12 (CI,AI,BI,CIin,RHSTSin,RHSTS,NSOIL)                            
+! ----------------------------------------------------------------------         
+! CALC/UPDATE THE SOIL TEMPS USING MATRIX SOLUTION                               
+! ----------------------------------------------------------------------         
+      DO K = 1,NSOIL                                                             
+         STCOUT (K) = STCIN (K) + CI (K)                                         
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE HSTEP                                                           
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                 &        
+                         SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,SHDFAC,      &
+                         SBETA,Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,EMISSI,    & 
+                         SSOIL,                                         &                    
+                         STC,EPSCA,BEXP,PC,RCH,RR,CFACTR,               &        
+                         SH2O,SLOPE,KDT,FRZFACT,PSISAT,ZSOIL,           &        
+                         DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2,         &        
+                         RUNOFF3,EDIR,EC,ET,ETT,NROOT,ICE,RTDIS,        &        
+                         QUARTZ,FXEXP,CSOIL,                            &        
+                         BETA,DRIP,DEW,FLX1,FLX3,VEGTYP)                          
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE NOPAC                                                               
+! ----------------------------------------------------------------------         
+! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES AND UPDATE SOIL MOISTURE          
+! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN NO SNOW PACK IS         
+! PRESENT.                                                                       
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+
+      INTEGER, INTENT(IN)  :: ICE, NROOT,NSOIL,VEGTYP                   
+      INTEGER              :: K
+
+      REAL, INTENT(IN)     :: BEXP,CFACTR, CMCMAX,CSOIL,DKSAT,DT,DWSAT, &
+                              EPSCA,ETP,FDOWN,F1,FXEXP,FRZFACT,KDT,PC,  &
+                              PRCP,PSISAT,Q2,QUARTZ,RCH,RR,SBETA,SFCTMP,&
+                              SHDFAC,SLOPE,SMCDRY,SMCMAX,SMCREF,SMCWLT, &
+                              T24,TBOT,TH2,ZBOT,EMISSI                  
+      REAL, INTENT(INOUT)  :: CMC,BETA,T1
+      REAL, INTENT(OUT)    :: DEW,DRIP,EC,EDIR,ETA,ETT,FLX1,FLX3,       &
+                              RUNOFF1,RUNOFF2,RUNOFF3,SSOIL
+      REAL, DIMENSION(1:NSOIL),INTENT(IN)     :: RTDIS,ZSOIL
+      REAL, DIMENSION(1:NSOIL),INTENT(OUT)    :: ET
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC,SH2O,STC
+      REAL, DIMENSION(1:NSOIL) :: ET1
+      REAL                 :: EC1,EDIR1,ETT1,DF1,ETA1,ETP1,PRCP1,YY,    &
+                              YYNUM,ZZ1
+                                                                                 
+! ----------------------------------------------------------------------         
+! EXECUTABLE CODE BEGINS HERE:                                                   
+! CONVERT ETP Fnd PRCP FROM KG M-2 S-1 TO M S-1 AND INITIALIZE DEW.              
+! ----------------------------------------------------------------------         
+      PRCP1 = PRCP * 0.001                                                       
+      ETP1 = ETP * 0.001                                                         
+      DEW = 0.0                                                                  
+! ----------------------------------------------------------------------         
+! INITIALIZE EVAP TERMS.                                                         
+! ----------------------------------------------------------------------         
+      EDIR = 0.                                                                  
+      EDIR1 = 0.                                                                 
+      EC1 = 0.                                                                   
+      EC = 0.                                                                    
+      DO K = 1,NSOIL                                                             
+        ET(K) = 0.                                                               
+        ET1(K) = 0.                                                              
+      END DO                                                                     
+      ETT = 0.                                                                   
+      ETT1 = 0.                                                                  
+                                                                                 
+      IF (ETP > 0.0) THEN                                                     
+         CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,                  &        
+                      SH2O,                                             &        
+                      SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,                &        
+                      SMCREF,SHDFAC,CMCMAX,                             &        
+                      SMCDRY,CFACTR,                                    &        
+                       EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP)           
+         CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                      &        
+                      SH2O,SLOPE,KDT,FRZFACT,                           &        
+                      SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                   &        
+                      SHDFAC,CMCMAX,                                    &        
+                      RUNOFF1,RUNOFF2,RUNOFF3,                          &        
+                      EDIR1,EC1,ET1,                                    &        
+                      DRIP)                                                      
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONVERT MODELED EVAPOTRANSPIRATION FROM  M S-1  TO  KG M-2 S-1.                
+! ----------------------------------------------------------------------         
+                                                                                 
+         ETA = ETA1 * 1000.0                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF ETP < 0, ASSUME DEW FORMS (TRANSFORM ETP1 INTO DEW AND REINITIALIZE         
+! ETP1 TO ZERO).                                                                 
+! ----------------------------------------------------------------------         
+      ELSE                                                                       
+         DEW = - ETP1                                                            
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONVERT PRCP FROM 'KG M-2 S-1' TO 'M S-1' AND ADD DEW AMOUNT.                  
+! ----------------------------------------------------------------------         
+         ETP1 = 0.0                                                              
+                                                                                 
+         PRCP1 = PRCP1+ DEW                                                      
+         CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,                  &        
+                      SH2O,                                             &        
+                      SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,                &        
+                      SMCREF,SHDFAC,CMCMAX,                             &        
+                      SMCDRY,CFACTR,                                    &        
+                      EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP)            
+         CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                      &        
+                      SH2O,SLOPE,KDT,FRZFACT,                           &        
+                      SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                   &        
+                      SHDFAC,CMCMAX,                                    &        
+                      RUNOFF1,RUNOFF2,RUNOFF3,                          &        
+                      EDIR1,EC1,ET1,                                    &        
+                      DRIP)                                                      
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONVERT MODELED EVAPOTRANSPIRATION FROM 'M S-1' TO 'KG M-2 S-1'.               
+! ----------------------------------------------------------------------         
+         ETA = ETA1 * 1000.0                                                     
+      END IF                                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! BASED ON ETP AND E VALUES, DETERMINE BETA                                      
+! ----------------------------------------------------------------------         
+                                                                                 
+      IF ( ETP <= 0.0 ) THEN                                                   
+         BETA = 0.0                                                              
+         IF ( ETP < 0.0 ) THEN                                                
+            BETA = 1.0                                                           
+            ETA = ETP                                                            
+         END IF                                                                  
+      ELSE                                                                       
+         BETA = ETA / ETP                                                        
+      END IF                                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONVERT MODELED EVAPOTRANSPIRATION COMPONENTS 'M S-1' TO 'KG M-2 S-1'.         
+! ----------------------------------------------------------------------         
+      EDIR = EDIR1*1000.                                                         
+      EC = EC1*1000.                                                             
+      DO K = 1,NSOIL                                                             
+        ET(K) = ET1(K)*1000.                                                     
+      END DO                                                                     
+      ETT = ETT1*1000.                                                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! GET SOIL THERMAL DIFFUXIVITY/CONDUCTIVITY FOR TOP SOIL LYR,                    
+! CALC. ADJUSTED TOP LYR SOIL TEMP AND ADJUSTED SOIL FLUX, THEN                  
+! CALL SHFLX TO COMPUTE/UPDATE SOIL HEAT FLUX AND SOIL TEMPS.                    
+! ----------------------------------------------------------------------         
+                                                                                 
+      CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1))                           
+
+!urban
+      IF (VEGTYP==1) DF1=3.24
+!
+                                                                                 
+! ----------------------------------------------------------------------         
+! VEGETATION GREENNESS FRACTION REDUCTION IN SUBSURFACE HEAT FLUX                
+! VIA REDUCTION FACTOR, WHICH IS CONVENIENT TO APPLY HERE TO THERMAL             
+! DIFFUSIVITY THAT IS LATER USED IN HRT TO COMPUTE SUB SFC HEAT FLUX             
+! (SEE ADDITIONAL COMMENTS ON VEG EFFECT SUB-SFC HEAT FLX IN                     
+! ROUTINE SFLX)                                                                  
+! ----------------------------------------------------------------------         
+      DF1 = DF1 * EXP (SBETA * SHDFAC)                                           
+! ----------------------------------------------------------------------         
+! COMPUTE INTERMEDIATE TERMS PASSED TO ROUTINE HRT (VIA ROUTINE                  
+! SHFLX BELOW) FOR USE IN COMPUTING SUBSURFACE HEAT FLUX IN HRT                  
+! ----------------------------------------------------------------------         
+!      YYNUM = FDOWN - SIGMA * T24                                                
+      YYNUM = FDOWN - EMISSI*SIGMA * T24
+      YY = SFCTMP + (YYNUM / RCH + TH2- SFCTMP - BETA * EPSCA) / RR              
+                                                                                 
+      ZZ1 = DF1 / ( -0.5 * ZSOIL (1) * RCH * RR ) + 1.0                          
+
+!urban
+      CALL SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,        &
+                  TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,ICE,         &
+                  QUARTZ,CSOIL,VEGTYP)                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! SET FLX1 AND FLX3 (SNOPACK PHASE CHANGE HEAT FLUXES) TO ZERO SINCE             
+! THEY ARE NOT USED HERE IN SNOPAC.  FLX2 (FREEZING RAIN HEAT FLUX) WAS          
+! SIMILARLY INITIALIZED IN THE PENMAN ROUTINE.                                   
+! ----------------------------------------------------------------------         
+      FLX1 = 0.0                                                                 
+      FLX3 = 0.0                                                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE NOPAC                                                           
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, &        
+     &                   Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA,       &        
+     &                   DQSDT2,FLX2,EMISSI)                                                             
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE PENMAN                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE POTENTIAL EVAPORATION FOR THE CURRENT POINT.  VARIOUS                
+! PARTIAL SUMS/PRODUCTS ARE ALSO CALCULATED AND PASSED BACK TO THE               
+! CALLING ROUTINE FOR LATER USE.                                                 
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      LOGICAL, INTENT(IN)     :: SNOWNG, FRZGRA
+      REAL, INTENT(IN)        :: CH, DQSDT2,FDOWN,PRCP,                 &
+                                 Q2, Q2SAT,SSOIL, SFCPRS, SFCTMP,       &
+                                 T2V, TH2,EMISSI                        
+      REAL, INTENT(OUT)       :: EPSCA,ETP,FLX2,RCH,RR,T24
+      REAL                    :: A, DELTA, FNET,RAD,RHO
+
+      REAL, PARAMETER      :: ELCP = 2.4888E+3, LSUBC = 2.501000E+6,CP = 1004.6
+                                                                                 
+! ----------------------------------------------------------------------         
+! EXECUTABLE CODE BEGINS HERE:                                                   
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! PREPARE PARTIAL QUANTITIES FOR PENMAN EQUATION.                                
+! ----------------------------------------------------------------------         
+      FLX2 = 0.0                                                                 
+      DELTA = ELCP * DQSDT2                                                      
+      T24 = SFCTMP * SFCTMP * SFCTMP * SFCTMP                                    
+!      RR = T24 * 6.48E-8 / (SFCPRS * CH) + 1.0                                   
+      RR = EMISSI*T24 * 6.48E-8 / (SFCPRS * CH) + 1.0
+      RHO = SFCPRS / (RD * T2V)                                                   
+                                                                                 
+! ----------------------------------------------------------------------         
+! ADJUST THE PARTIAL SUMS / PRODUCTS WITH THE LATENT HEAT                        
+! EFFECTS CAUSED BY FALLING PRECIPITATION.                                       
+! ----------------------------------------------------------------------         
+      RCH = RHO * CP * CH                                                        
+      IF (.NOT. SNOWNG) THEN                                                     
+         IF (PRCP >  0.0) RR = RR + CPH2O * PRCP / RCH                         
+      ELSE                                                                       
+         RR = RR + CPICE * PRCP / RCH                                            
+      END IF                                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! INCLUDE THE LATENT HEAT EFFECTS OF FRZNG RAIN CONVERTING TO ICE ON             
+! IMPACT IN THE CALCULATION OF FLX2 AND FNET.                                    
+! ----------------------------------------------------------------------         
+!      FNET = FDOWN - SIGMA * T24- SSOIL                                          
+      FNET = FDOWN -  EMISSI*SIGMA * T24- SSOIL
+      IF (FRZGRA) THEN                                                           
+         FLX2 = - LSUBF * PRCP                                                   
+         FNET = FNET - FLX2                                                      
+! ----------------------------------------------------------------------         
+! FINISH PENMAN EQUATION CALCULATIONS.                                           
+! ----------------------------------------------------------------------         
+      END IF                                                                     
+      RAD = FNET / RCH + TH2- SFCTMP                                             
+      A = ELCP * (Q2SAT - Q2)                                                    
+      EPSCA = (A * RR + RAD * DELTA) / (DELTA + RR)                              
+      ETP = EPSCA * RCH / LSUBC                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE PENMAN                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE REDPRM (VEGTYP,SOILTYP,SLOPETYP,CFACTR,CMCMAX,RSMAX,      &     
+                         TOPT,                                             &     
+                         REFKDT,KDT,SBETA, SHDFAC,RSMIN,RGL,HS,ZBOT,FRZX,  &     
+                         PSISAT,SLOPE,SNUP,SALP,BEXP,DKSAT,DWSAT,          &     
+                         SMCMAX,SMCWLT,SMCREF,SMCDRY,F1,QUARTZ,FXEXP,      &     
+                         RTDIS,SLDPTH,ZSOIL, NROOT,NSOIL,Z0BRD,CZIL,LAI,   &     
+                         CSOIL,ALBBRD,PTU,LLANDUSE,LSOIL,LOCAL)                
+                                                                                 
+      IMPLICIT NONE                                                              
+! ----------------------------------------------------------------------         
+! Internally set (default valuess)                                               
+! all soil and vegetation parameters required for the execusion oF               
+! the Noah lsm are defined in VEGPARM.TBL, SOILPARM.TB, and GENPARM.TBL.         
+! ----------------------------------------------------------------------         
+!     Vegetation parameters:                                                     
+!             ALBBRD: SFC background snow-free albedo                            
+!             CMXTBL: MAX CNPY Capacity                                          
+!              Z0BRD: Background roughness length                                
+!             SHDFAC: Green vegetation fraction                                  
+!              NROOT: Rooting depth                                              
+!              RSMIN: Mimimum stomatal resistance                                
+!              RSMAX: Max. stomatal resistance                                   
+!                RGL: Parameters used in radiation stress function               
+!                 HS: Parameter used in vapor pressure deficit functio           
+!               TOPT: Optimum transpiration air temperature.                     
+!             CMCMAX: Maximum canopy water capacity                              
+!             CFACTR: Parameter used in the canopy inteception calculation       
+!               SNUP: Threshold snow depth (in water equivalent m) that          
+!                     implies 100 percent snow cover                             
+!                LAI: Leaf area index                                            
+!                                                                                
+! ----------------------------------------------------------------------         
+!      Soil parameters:                                                          
+!        SMCMAX: MAX soil moisture content (porosity)                            
+!        SMCREF: Reference soil moisture  (field capacity)                       
+!        SMCWLT: Wilting point soil moisture                                     
+!        SMCWLT: Air dry soil moist content limits                               
+!       SSATPSI: SAT (saturation) soil potential                                 
+!         DKSAT: SAT soil conductivity                                           
+!          BEXP: B parameter                                                     
+!        SSATDW: SAT soil diffusivity                                            
+!           F1: Soil thermal diffusivity/conductivity coef.                      
+!        QUARTZ: Soil quartz content                                             
+!  Modified by F. Chen (12/22/97)  to use the STATSGO soil map                   
+!  Modified By F. Chen (01/22/00)  to include PLaya, Lava, and White San         
+!  Modified By F. Chen (08/05/02)  to include additional parameters for the Noah 
+! NOTE: SATDW = BB*SATDK*(SATPSI/MAXSMC)                                         
+!         F11 = ALOG10(SATPSI) + BB*ALOG10(MAXSMC) + 2.0                         
+!       REFSMC1=MAXSMC*(5.79E-9/SATDK)**(1/(2*BB+3)) 5.79E-9 m/s= 0.5 mm         
+!       REFSMC=REFSMC1+1./3.(MAXSMC-REFSMC1)                                     
+!       WLTSMC1=MAXSMC*(200./SATPSI)**(-1./BB)    (Wetzel and Chang, 198         
+!       WLTSMC=WLTSMC1-0.5*WLTSMC1                                               
+! Note: the values for playa is set for it to have a thermal conductivit         
+! as sand and to have a hydrulic conductivity as clay                            
+!                                                                                
+! ----------------------------------------------------------------------         
+! Class parameter 'SLOPETYP' was included to estimate linear reservoir           
+! coefficient 'SLOPE' to the baseflow runoff out of the bottom layer.            
+! lowest class (slopetyp=0) means highest slope parameter = 1.                   
+! definition of slopetyp from 'zobler' slope type:                               
+! slope class  percent slope                                                     
+! 1            0-8                                                               
+! 2            8-30                                                              
+! 3            > 30                                                              
+! 4            0-30                                                              
+! 5            0-8 & > 30                                                        
+! 6            8-30 & > 30                                                       
+! 7            0-8, 8-30, > 30                                                   
+! 9            GLACIAL ICE                                                       
+! BLANK        OCEAN/SEA                                                         
+!       SLOPE_DATA: linear reservoir coefficient                                 
+!       SBETA_DATA: parameter used to caluculate vegetation effect on soil heat  
+!       FXEXP_DAT:  soil evaporation exponent used in DEVAP                      
+!       CSOIL_DATA: soil heat capacity [J M-3 K-1]                               
+!       SALP_DATA: shape parameter of  distribution function of snow cover       
+!       REFDK_DATA and REFKDT_DATA: parameters in the surface runoff parameteriz 
+!       FRZK_DATA: frozen ground parameter                                       
+!       ZBOT_DATA: depth[M] of lower boundary soil temperature                   
+!       CZIL_DATA: calculate roughness length of heat                            
+!       SMLOW_DATA and MHIGH_DATA: two soil moisture wilt, soil moisture referen 
+!                 parameters                                                     
+! Set maximum number of soil-, veg-, and slopetyp in data statement.             
+! ----------------------------------------------------------------------         
+      INTEGER, PARAMETER     :: MAX_SLOPETYP=30,MAX_SOILTYP=30,MAX_VEGTYP=30
+      LOGICAL                :: LOCAL
+      CHARACTER (LEN=4), INTENT(IN)::  LLANDUSE, LSOIL
+
+! Veg parameters                                                                 
+      INTEGER, INTENT(IN)    :: VEGTYP
+      INTEGER, INTENT(OUT)   :: NROOT
+      REAL, INTENT(OUT)      :: HS,LAI,RSMIN,RGL,SHDFAC,SNUP,Z0BRD,         &
+                                CMCMAX,RSMAX,TOPT,ALBBRD
+! Soil parameters                                                                
+      INTEGER, INTENT(IN)    :: SOILTYP                                                           
+      REAL, INTENT(OUT)      :: BEXP,DKSAT,DWSAT,F1,QUARTZ,SMCDRY,          &
+                                SMCMAX,SMCREF,SMCWLT,PSISAT
+! General parameters                                                             
+      INTEGER, INTENT(IN)    :: SLOPETYP,NSOIL
+      INTEGER                :: I                                                  
+      
+      REAL,    INTENT(OUT)   :: SLOPE,CZIL,SBETA,FXEXP,                     &
+                                CSOIL,SALP,FRZX,KDT,CFACTR,      &
+                                ZBOT,REFKDT,PTU
+      REAL,DIMENSION(1:NSOIL),INTENT(IN) :: SLDPTH,ZSOIL
+      REAL,DIMENSION(1:NSOIL),INTENT(OUT):: RTDIS                           
+      REAL                   :: FRZFACT,FRZK,REFDK
+                                                                                 
+!      SAVE                                                                       
+! ----------------------------------------------------------------------         
+!                                                                                
+               IF (SOILTYP .gt. SLCATS) THEN                                     
+                        CALL wrf_error_fatal ( 'Warning: too many input soil types' )
+               END IF                                                            
+               IF (VEGTYP .gt. LUCATS) THEN                                      
+                     CALL wrf_error_fatal ( 'Warning: too many input landuse types' )
+               END IF                                                            
+               IF (SLOPETYP .gt. SLPCATS) THEN                                   
+                     CALL wrf_error_fatal ( 'Warning: too many input slope types' )
+               END IF                                                            
+                                                                                 
+! ----------------------------------------------------------------------         
+!  SET-UP SOIL PARAMETERS                                                        
+! ----------------------------------------------------------------------         
+      CSOIL = CSOIL_DATA                                                         
+      BEXP = BB (SOILTYP)                                                        
+      DKSAT = SATDK (SOILTYP)                                                    
+      DWSAT = SATDW (SOILTYP)                                                    
+      F1 = F11 (SOILTYP)                                                         
+      PSISAT = SATPSI (SOILTYP)                                                  
+      QUARTZ = QTZ (SOILTYP)                                                     
+      SMCDRY = DRYSMC (SOILTYP)                                                  
+      SMCMAX = MAXSMC (SOILTYP)                                                  
+      SMCREF = REFSMC (SOILTYP)                                                  
+      SMCWLT = WLTSMC (SOILTYP)                                                  
+! ----------------------------------------------------------------------         
+! Set-up universal parameters (not dependent on SOILTYP, VEGTYP or               
+! SLOPETYP)                                                                      
+! ----------------------------------------------------------------------         
+      ZBOT = ZBOT_DATA                                                           
+      SALP = SALP_DATA                                                           
+      SBETA = SBETA_DATA                                                         
+      REFDK = REFDK_DATA                                                         
+      FRZK = FRZK_DATA                                                           
+      FXEXP = FXEXP_DATA                                                         
+      REFKDT = REFKDT_DATA                                                       
+      PTU = 0.    ! (not used yet) to satisify intent(out)
+      KDT = REFKDT * DKSAT / REFDK                                               
+      CZIL = CZIL_DATA                                                           
+      SLOPE = SLOPE_DATA (SLOPETYP)                                              
+                                                                                 
+! ----------------------------------------------------------------------         
+! TO ADJUST FRZK PARAMETER TO ACTUAL SOIL TYPE: FRZK * FRZFACT                   
+! ----------------------------------------------------------------------         
+      FRZFACT = (SMCMAX / SMCREF) * (0.412 / 0.468)                              
+      FRZX = FRZK * FRZFACT                                                      
+                                                                                 
+! ----------------------------------------------------------------------         
+! SET-UP VEGETATION PARAMETERS                                                   
+! ----------------------------------------------------------------------         
+      TOPT = TOPT_DATA                                                           
+      CMCMAX = CMCMAX_DATA                                                       
+      CFACTR = CFACTR_DATA                                                       
+      RSMAX = RSMAX_DATA                                                         
+      NROOT = NROTBL (VEGTYP)                                                    
+      SNUP = SNUPTBL (VEGTYP)                                                    
+      RSMIN = RSTBL (VEGTYP)                                                     
+      RGL = RGLTBL (VEGTYP)                                                      
+      HS = HSTBL (VEGTYP)                                                        
+      LAI = LAITBL (VEGTYP)                                                      
+               IF(LOCAL) THEN                                                  
+                 ALBBRD = ALBTBL(VEGTYP)                                         
+                 Z0BRD = Z0TBL(VEGTYP)                                           
+                 SHDFAC = SHDTBL(VEGTYP)                                         
+               ENDIF                                                             
+                                                                                 
+               IF (VEGTYP .eq. BARE) SHDFAC = 0.0
+               IF (NROOT .gt. NSOIL) THEN
+                  WRITE (err_message,*) 'Error: too many root layers ',  &
+                                                 NSOIL,NROOT
+                  CALL wrf_error_fatal ( err_message )
+! ----------------------------------------------------------------------         
+! CALCULATE ROOT DISTRIBUTION.  PRESENT VERSION ASSUMES UNIFORM                  
+! DISTRIBUTION BASED ON SOIL LAYER DEPTHS.                                       
+! ----------------------------------------------------------------------         
+               END IF                                                            
+               DO I = 1,NROOT                                                    
+                  RTDIS (I) = - SLDPTH (I)/ ZSOIL (NROOT)                        
+! ----------------------------------------------------------------------         
+!  SET-UP SLOPE PARAMETER                                                        
+! ----------------------------------------------------------------------         
+               END DO                                                            
+                                                                                 
+!        print*,'end of PRMRED'                                                  
+!       print*,'VEGTYP',VEGTYP,'SOILTYP',SOILTYP,'SLOPETYP',SLOPETYP,    &       
+!    & 'CFACTR',CFACTR,'CMCMAX',CMCMAX,'RSMAX',RSMAX,'TOPT',TOPT,        &       
+!    & 'REFKDT',REFKDT,'KDT',KDT,'SBETA',SBETA, 'SHDFAC',SHDFAC,         &       
+!    &  'RSMIN',RSMIN,'RGL',RGL,'HS',HS,'ZBOT',ZBOT,'FRZX',FRZX,         &       
+!    &  'PSISAT',PSISAT,'SLOPE',SLOPE,'SNUP',SNUP,'SALP',SALP,'BEXP',    &       
+!    &   BEXP,                                                           &       
+!    &  'DKSAT',DKSAT,'DWSAT',DWSAT,                                     &       
+!    &  'SMCMAX',SMCMAX,'SMCWLT',SMCWLT,'SMCREF',SMCREF,'SMCDRY',SMCDRY, &       
+!    &  'F1',F1,'QUARTZ',QUARTZ,'FXEXP',FXEXP,                           &       
+!    &  'RTDIS',RTDIS,'SLDPTH',SLDPTH,'ZSOIL',ZSOIL, 'NROOT',NROOT,      &       
+!    &  'NSOIL',NSOIL,'Z0',Z0,'CZIL',CZIL,'LAI',LAI,                     &       
+!    &  'CSOIL',CSOIL,'PTU',PTU,                                         &       
+!    &  'LOCAL', LOCAL                                                       
+                                                                                 
+      END  SUBROUTINE REDPRM
+                                                                                 
+      SUBROUTINE ROSR12 (P,A,B,C,D,DELTA,NSOIL)                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE ROSR12                                                              
+! ----------------------------------------------------------------------         
+! INVERT (SOLVE) THE TRI-DIAGONAL MATRIX PROBLEM SHOWN BELOW:                    
+! ###                                            ### ###  ###   ###  ###         
+! #B(1), C(1),  0  ,  0  ,  0  ,   . . .  ,    0   # #      #   #      #         
+! #A(2), B(2), C(2),  0  ,  0  ,   . . .  ,    0   # #      #   #      #         
+! # 0  , A(3), B(3), C(3),  0  ,   . . .  ,    0   # #      #   # D(3) #         
+! # 0  ,  0  , A(4), B(4), C(4),   . . .  ,    0   # # P(4) #   # D(4) #         
+! # 0  ,  0  ,  0  , A(5), B(5),   . . .  ,    0   # # P(5) #   # D(5) #         
+! # .                                          .   # #  .   # = #   .  #         
+! # .                                          .   # #  .   #   #   .  #         
+! # .                                          .   # #  .   #   #   .  #         
+! # 0  , . . . , 0 , A(M-2), B(M-2), C(M-2),   0   # #P(M-2)#   #D(M-2)#         
+! # 0  , . . . , 0 ,   0   , A(M-1), B(M-1), C(M-1)# #P(M-1)#   #D(M-1)#         
+! # 0  , . . . , 0 ,   0   ,   0   ,  A(M) ,  B(M) # # P(M) #   # D(M) #         
+! ###                                            ### ###  ###   ###  ###         
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+
+      INTEGER, INTENT(IN)   :: NSOIL
+      INTEGER               :: K, KK
+
+      REAL, DIMENSION(1:NSOIL), INTENT(IN):: A, B, D 
+      REAL, DIMENSION(1:NSOIL),INTENT(INOUT):: C,P,DELTA
+                                                                                 
+! ----------------------------------------------------------------------         
+! INITIALIZE EQN COEF C FOR THE LOWEST SOIL LAYER                                
+! ----------------------------------------------------------------------         
+      C (NSOIL) = 0.0                                                            
+      P (1) = - C (1) / B (1)                                                    
+! ----------------------------------------------------------------------         
+! SOLVE THE COEFS FOR THE 1ST SOIL LAYER                                         
+! ----------------------------------------------------------------------         
+                                                                                 
+! ----------------------------------------------------------------------         
+! SOLVE THE COEFS FOR SOIL LAYERS 2 THRU NSOIL                                   
+! ----------------------------------------------------------------------         
+      DELTA (1) = D (1) / B (1)                                                  
+      DO K = 2,NSOIL                                                             
+         P (K) = - C (K) * ( 1.0 / (B (K) + A (K) * P (K -1)) )                  
+         DELTA (K) = (D (K) - A (K)* DELTA (K -1))* (1.0/ (B (K) + A (K)&        
+                    * P (K -1)))                                                 
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+! SET P TO DELTA FOR LOWEST SOIL LAYER                                           
+! ----------------------------------------------------------------------         
+      P (NSOIL) = DELTA (NSOIL)                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! ADJUST P FOR SOIL LAYERS 2 THRU NSOIL                                          
+! ----------------------------------------------------------------------         
+      DO K = 2,NSOIL                                                             
+         KK = NSOIL - K + 1                                                      
+         P (KK) = P (KK) * P (KK +1) + DELTA (KK)                                
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE ROSR12                                                          
+! ----------------------------------------------------------------------         
+
+                                                                                 
+      SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,  &        
+                         TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,ICE,  &        
+                         QUARTZ,CSOIL,VEGTYP)                                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SHFLX                                                               
+! ----------------------------------------------------------------------         
+! UPDATE THE TEMPERATURE STATE OF THE SOIL COLUMN BASED ON THE THERMAL           
+! DIFFUSION EQUATION AND UPDATE THE FROZEN SOIL MOISTURE CONTENT BASED           
+! ON THE TEMPERATURE.                                                            
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+
+      INTEGER, INTENT(IN)   :: ICE, NSOIL, VEGTYP                      
+      INTEGER               :: I
+
+      REAL, INTENT(IN)      :: BEXP,CSOIL,DF1,DT,F1,PSISAT,QUARTZ,     & 
+                               SMCMAX, SMCWLT, TBOT,YY, ZBOT,ZZ1
+      REAL, INTENT(INOUT)   :: T1 
+      REAL, INTENT(OUT)     :: SSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)    :: SMC,ZSOIL 
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SH2O 
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC 
+      REAL, DIMENSION(1:NSOIL)             :: AI, BI, CI, STCF,RHSTS
+      REAL, PARAMETER       :: T0 = 273.15
+                                                                                 
+! ----------------------------------------------------------------------         
+! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN                 
+! ----------------------------------------------------------------------         
+                                                                                 
+! ----------------------------------------------------------------------         
+! SEA-ICE CASE                                                                   
+! ----------------------------------------------------------------------         
+      IF (ICE == 1) THEN                                                       
+                                                                                 
+         CALL HRTICE (RHSTS,STC,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)                 
+                                                                                 
+         CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! LAND-MASS CASE                                                                 
+! ----------------------------------------------------------------------         
+      ELSE                                                                       
+         CALL HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,TBOT,        &        
+                    ZBOT,PSISAT,SH2O,DT,                                &        
+                    BEXP,F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP)                           
+                                                                                 
+         CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)                           
+      END IF                                                                     
+      DO I = 1,NSOIL                                                             
+         STC (I) = STCF (I)                                                      
+      END DO                                                                     
+
+! ----------------------------------------------------------------------         
+! IN THE NO SNOWPACK CASE (VIA ROUTINE NOPAC BRANCH,) UPDATE THE GRND            
+! (SKIN) TEMPERATURE HERE IN RESPONSE TO THE UPDATED SOIL TEMPERATURE            
+! PROFILE ABOVE.  (NOTE: INSPECTION OF ROUTINE SNOPAC SHOWS THAT T1              
+! BELOW IS A DUMMY VARIABLE ONLY, AS SKIN TEMPERATURE IS UPDATED                 
+! DIFFERENTLY IN ROUTINE SNOPAC)                                                 
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! CALCULATE SURFACE SOIL HEAT FLUX                                               
+! ----------------------------------------------------------------------         
+      T1 = (YY + (ZZ1- 1.0) * STC (1)) / ZZ1                                     
+      SSOIL = DF1 * (STC (1) - T1) / (0.5 * ZSOIL (1))                           
+
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SHFLX                                                           
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                   &        
+     &                   SH2O,SLOPE,KDT,FRZFACT,                        &        
+     &                   SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                &        
+     &                   SHDFAC,CMCMAX,                                 &        
+     &                   RUNOFF1,RUNOFF2,RUNOFF3,                       &        
+     &                   EDIR,EC,ET,                                    &        
+     &                   DRIP)                                                   
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SMFLX                                                               
+! ----------------------------------------------------------------------         
+! CALCULATE SOIL MOISTURE FLUX.  THE SOIL MOISTURE CONTENT (SMC - A PER          
+! UNIT VOLUME MEASUREMENT) IS A DEPENDENT VARIABLE THAT IS UPDATED WITH          
+! PROGNOSTIC EQNS. THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED.            
+! FROZEN GROUND VERSION:  NEW STATES ADDED: SH2O, AND FROZEN GROUND              
+! CORRECTION FACTOR, FRZFACT AND PARAMETER SLOPE.                                
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+ 
+      INTEGER, INTENT(IN)   :: NSOIL
+      INTEGER               :: I,K 
+     
+      REAL, INTENT(IN)      :: BEXP, CMCMAX, DKSAT,DWSAT, DT, EC, EDIR,  &
+                               KDT, PRCP1, SHDFAC, SLOPE, SMCMAX, SMCWLT  
+      REAL, INTENT(OUT)                      :: DRIP, RUNOFF1, RUNOFF2, RUNOFF3
+      REAL, INTENT(INOUT)   :: CMC
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: ET,ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: SMC, SH2O
+      REAL, DIMENSION(1:NSOIL)             :: AI, BI, CI, STCF,RHSTS, RHSTT, &
+                                              SICE, SH2OA, SH2OFG
+      REAL                  :: DUMMY, EXCESS,FRZFACT,PCPDRP,RHSCT,TRHSCT
+                                                                                 
+! ----------------------------------------------------------------------         
+! EXECUTABLE CODE BEGINS HERE.                                                   
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! COMPUTE THE RIGHT HAND SIDE OF THE CANOPY EQN TERM ( RHSCT )                   
+! ----------------------------------------------------------------------         
+      DUMMY = 0.                                                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! CONVERT RHSCT (A RATE) TO TRHSCT (AN AMOUNT) AND ADD IT TO EXISTING            
+! CMC.  IF RESULTING AMT EXCEEDS MAX CAPACITY, IT BECOMES DRIP AND WILL          
+! FALL TO THE GRND.                                                              
+! ----------------------------------------------------------------------         
+      RHSCT = SHDFAC * PRCP1- EC                                                 
+      DRIP = 0.                                                                  
+      TRHSCT = DT * RHSCT                                                        
+      EXCESS = CMC + TRHSCT                                                      
+                                                                                 
+! ----------------------------------------------------------------------         
+! PCPDRP IS THE COMBINED PRCP1 AND DRIP (FROM CMC) THAT GOES INTO THE            
+! SOIL                                                                           
+! ----------------------------------------------------------------------         
+      IF (EXCESS > CMCMAX) DRIP = EXCESS - CMCMAX                             
+      PCPDRP = (1. - SHDFAC) * PRCP1+ DRIP / DT                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! STORE ICE CONTENT AT EACH SOIL LAYER BEFORE CALLING SRT and SSTEP                
+!
+      DO I = 1,NSOIL                                                             
+         SICE (I) = SMC (I) - SH2O (I)                                           
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+! CALL SUBROUTINES SRT AND SSTEP TO SOLVE THE SOIL MOISTURE                      
+! TENDENCY EQUATIONS.                                                            
+! IF THE INFILTRATING PRECIP RATE IS NONTRIVIAL,                                 
+!   (WE CONSIDER NONTRIVIAL TO BE A PRECIP TOTAL OVER THE TIME STEP              
+!    EXCEEDING ONE ONE-THOUSANDTH OF THE WATER HOLDING CAPACITY OF               
+!    THE FIRST SOIL LAYER)                                                       
+! THEN CALL THE SRT/SSTEP SUBROUTINE PAIR TWICE IN THE MANNER OF                 
+!   TIME SCHEME "F" (IMPLICIT STATE, AVERAGED COEFFICIENT)                       
+!   OF SECTION 2 OF KALNAY AND KANAMITSU (1988, MWR, VOL 116,                    
+!   PAGES 1945-1958)TO MINIMIZE 2-DELTA-T OSCILLATIONS IN THE                    
+!   SOIL MOISTURE VALUE OF THE TOP SOIL LAYER THAT CAN ARISE BECAUSE             
+!   OF THE EXTREME NONLINEAR DEPENDENCE OF THE SOIL HYDRAULIC                    
+!   DIFFUSIVITY COEFFICIENT AND THE HYDRAULIC CONDUCTIVITY ON THE                
+!   SOIL MOISTURE STATE                                                          
+! OTHERWISE CALL THE SRT/SSTEP SUBROUTINE PAIR ONCE IN THE MANNER OF             
+!   TIME SCHEME "D" (IMPLICIT STATE, EXPLICIT COEFFICIENT)                       
+!   OF SECTION 2 OF KALNAY AND KANAMITSU                                         
+! PCPDRP IS UNITS OF KG/M**2/S OR MM/S, ZSOIL IS NEGATIVE DEPTH IN M             
+! ----------------------------------------------------------------------         
+!      IF ( PCPDRP .GT. 0.0 ) THEN                                               
+                                                                                 
+! ----------------------------------------------------------------------         
+! FROZEN GROUND VERSION:                                                         
+! SMC STATES REPLACED BY SH2O STATES IN SRT SUBR.  SH2O & SICE STATES            
+! INC&UDED IN SSTEP SUBR.  FROZEN GROUND CORRECTION FACTOR, FRZFACT              
+! ADDED.  ALL WATER BALANCE CALCULATIONS USING UNFROZEN WATER                    
+! ----------------------------------------------------------------------         
+      IF ( (PCPDRP * DT) > (0.001*1000.0* (- ZSOIL (1))* SMCMAX) ) THEN
+         CALL SRT (RHSTT,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL,          &        
+                    DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,                    &        
+                    RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI)           
+         CALL SSTEP (SH2OFG,SH2O,DUMMY,RHSTT,RHSCT,DT,NSOIL,SMCMAX,     &        
+                        CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI)                  
+         DO K = 1,NSOIL                                                          
+            SH2OA (K) = (SH2O (K) + SH2OFG (K)) * 0.5                            
+         END DO                                                                  
+         CALL SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,ZSOIL,         &        
+                    DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,                    &        
+                    RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI)           
+         CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX,         &        
+                        CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI)                  
+                                                                                 
+      ELSE                                                                       
+         CALL SRT (RHSTT,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL,          &        
+                    DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,                    &        
+                      RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI)         
+         CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX,         &        
+                        CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI)                  
+!      RUNOF = RUNOFF                                                            
+                                                                                 
+      END IF                                                                     
+
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SMFLX                                                           
+! ----------------------------------------------------------------------         
+                                                                                 
+                                                                                 
+      SUBROUTINE SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR)                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SNFRAC                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE SNOW FRACTION (0 -> 1)                                               
+! SNEQV   SNOW WATER EQUIVALENT (M)                                              
+! SNUP    THRESHOLD SNEQV DEPTH ABOVE WHICH SNCOVR=1                             
+! SALP    TUNING PARAMETER                                                       
+! SNCOVR  FRACTIONAL SNOW COVER                                                  
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+
+      REAL, INTENT(IN)     :: SNEQV,SNUP,SALP,SNOWH
+      REAL, INTENT(OUT)    :: SNCOVR
+      REAL                 :: RSNOW, Z0N
+                                                                                 
+! ----------------------------------------------------------------------         
+! SNUP IS VEG-CLASS DEPENDENT SNOWDEPTH THRESHHOLD (SET IN ROUTINE               
+! REDPRM) ABOVE WHICH SNOCVR=1.                                                  
+! ----------------------------------------------------------------------         
+      IF (SNEQV < SNUP) THEN                                                  
+         RSNOW = SNEQV / SNUP                                                    
+         SNCOVR = 1. - ( EXP ( - SALP * RSNOW) - RSNOW * EXP ( - SALP))          
+      ELSE                                                                       
+         SNCOVR = 1.0                                                            
+      END IF                                                                     
+
+!     FORMULATION OF DICKINSON ET AL. 1986                                       
+!     Z0N = 0.035                                                                
+                                                                                 
+!        SNCOVR=SNOWH/(SNOWH + 5*Z0N)                                            
+                                                                                 
+!     FORMULATION OF MARSHALL ET AL. 1994                                        
+!        SNCOVR=SNEQV/(SNEQV + 2*Z0N)                                            
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SNFRAC                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE SNKSRC (TSNSR,TAVG,SMC,SH2O,ZSOIL,NSOIL,               &        
+     &                      SMCMAX,PSISAT,BEXP,DT,K,QTOT)                        
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SNKSRC                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE SINK/SOURCE TERM OF THE TERMAL DIFFUSION EQUATION. (SH2O) IS         
+! AVAILABLE LIQUED WATER.                                                        
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+
+      INTEGER, INTENT(IN)   :: K,NSOIL
+                                                                                
+      REAL, INTENT(IN)      :: BEXP, DT, PSISAT, QTOT, SMC, SMCMAX,    &
+                               TAVG
+      REAL, INTENT(INOUT)   :: SH2O
+
+      REAL, DIMENSION(1:NSOIL), INTENT(IN):: ZSOIL
+
+      REAL                  :: DF, DZ, DZH, FREE, TSNSR,               &
+                               TDN, TM, TUP, TZ, X0, XDN, XH2O, XUP 
+                                                                                 
+      REAL, PARAMETER       :: DH2O = 1.0000E3, HLICE = 3.3350E5,      &
+                               T0 = 2.7315E2
+
+      IF (K == 1) THEN                                                         
+         DZ = - ZSOIL (1)                                                        
+      ELSE                                                                       
+         DZ = ZSOIL (K -1) - ZSOIL (K)                                           
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+! VIA FUNCTION FRH2O, COMPUTE POTENTIAL OR 'EQUILIBRIUM' UNFROZEN                
+! SUPERCOOLED FREE WATER FOR GIVEN SOIL TYPE AND SOIL LAYER TEMPERATURE.         
+! FUNCTION FRH20 INVOKES EQN (17) FROM V. KOREN ET AL (1999, JGR, VOL.           
+! 104, PG 19573).  (ASIDE:  LATTER EQN IN JOURNAL IN CENTIGRADE UNITS.           
+! ROUTINE FRH2O USE FORM OF EQN IN KELVIN UNITS.)                                
+! ----------------------------------------------------------------------         
+!      FREE = FRH2O(TAVG,SMC,SH2O,SMCMAX,BEXP,PSISAT)                            
+                                                                                 
+! ----------------------------------------------------------------------         
+! IN NEXT BLOCK OF CODE, INVOKE EQN 18 OF V. KOREN ET AL (1999, JGR,             
+! VOL. 104, PG 19573.)  THAT IS, FIRST ESTIMATE THE NEW AMOUNTOF LIQUID          
+! WATER, 'XH2O', IMPLIED BY THE SUM OF (1) THE LIQUID WATER AT THE BEGIN         
+! OF CURRENT TIME STEP, AND (2) THE FREEZE OF THAW CHANGE IN LIQUID              
+! WATER IMPLIED BY THE HEAT FLUX 'QTOT' PASSED IN FROM ROUTINE HRT.              
+! SECOND, DETERMINE IF XH2O NEEDS TO BE BOUNDED BY 'FREE' (EQUIL AMT) OR         
+! IF 'FREE' NEEDS TO BE BOUNDED BY XH2O.                                         
+! ----------------------------------------------------------------------         
+      CALL FRH2O (FREE,TAVG,SMC,SH2O,SMCMAX,BEXP,PSISAT)                         
+                                                                                 
+! ----------------------------------------------------------------------         
+! FIRST, IF FREEZING AND REMAINING LIQUID LESS THAN LOWER BOUND, THEN            
+! REDUCE EXTENT OF FREEZING, THEREBY LETTING SOME OR ALL OF HEAT FLUX            
+! QTOT COOL THE SOIL TEMP LATER IN ROUTINE HRT.                                  
+! ----------------------------------------------------------------------         
+      XH2O = SH2O + QTOT * DT / (DH2O * HLICE * DZ)                              
+      IF ( XH2O < SH2O .AND. XH2O < FREE) THEN                             
+         IF ( FREE > SH2O ) THEN                                              
+            XH2O = SH2O                                                          
+         ELSE                                                                    
+            XH2O = FREE                                                          
+         END IF                                                                  
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+! SECOND, IF THAWING AND THE INCREASE IN LIQUID WATER GREATER THAN UPPER         
+! BOUND, THEN REDUCE EXTENT OF THAW, THEREBY LETTING SOME OR ALL OF HEAT         
+! FLUX QTOT WARM THE SOIL TEMP LATER IN ROUTINE HRT.                             
+! ----------------------------------------------------------------------         
+      IF ( XH2O > SH2O .AND. XH2O > FREE ) THEN                            
+         IF ( FREE < SH2O ) THEN                                              
+            XH2O = SH2O                                                          
+         ELSE                                                                    
+            XH2O = FREE                                                          
+         END IF                                                                  
+      END IF                                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE PHASE-CHANGE HEAT SOURCE/SINK TERM FOR USE IN ROUTINE HRT            
+! AND UPDATE LIQUID WATER TO REFLCET FINAL FREEZE/THAW INCREMENT.                
+! ----------------------------------------------------------------------         
+!      SNKSRC = -DH2O*HLICE*DZ*(XH2O-SH2O)/DT                                    
+      IF (XH2O < 0.) XH2O = 0.                                                
+      IF (XH2O > SMC) XH2O = SMC                                              
+      TSNSR = - DH2O * HLICE * DZ * (XH2O - SH2O)/ DT                            
+      SH2O = XH2O                                                                
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SNKSRC                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &        
+                          SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,            &        
+                          SBETA,DF1,                                    &        
+                          Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,STC,EPSCA,&        
+                         SFCPRS,BEXP,PC,RCH,RR,CFACTR,SNCOVR,ESD,SNDENS,&        
+                          SNOWH,SH2O,SLOPE,KDT,FRZFACT,PSISAT,          &        
+                          ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1,   &        
+                          RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT,  &        
+                          ICE,RTDIS,QUARTZ,FXEXP,CSOIL,                 &        
+                          BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW,ETNS,EMISSI,&             
+                          VEGTYP)                                       
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SNOPAC                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES & UPDATE SOIL MOISTURE            
+! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN A SNOW PACK IS          
+! PRESENT.                                                                       
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+
+      INTEGER, INTENT(IN)   :: ICE, NROOT, NSOIL,VEGTYP                 
+      INTEGER               :: K
+      LOGICAL, INTENT(IN)   :: SNOWNG
+      REAL, INTENT(IN)      :: BEXP,CFACTR, CMCMAX,CSOIL,DF1,DKSAT,     &
+                               DT,DWSAT, EPSCA,ETP,FDOWN,F1,FXEXP,      &
+                               FRZFACT,KDT,PC, PRCP,PSISAT,Q2,QUARTZ,   &
+                               RCH,RR,SBETA,SFCPRS, SFCTMP, SHDFAC,     &
+                               SLOPE,SMCDRY,SMCMAX,SMCREF,SMCWLT, T24,  &
+                               TBOT,TH2,ZBOT,EMISSI                      
+      REAL, INTENT(INOUT)   :: CMC, BETA, ESD,FLX2,PRCPF,SNOWH,SNCOVR,  &
+                               SNDENS, T1  
+      REAL, INTENT(OUT)     :: DEW,DRIP,EC,EDIR, ETNS, ESNOW,ETT,       &
+                               FLX1,FLX3, RUNOFF1,RUNOFF2,RUNOFF3,      &
+                               SSOIL,SNOMLT
+      REAL, DIMENSION(1:NSOIL),INTENT(IN)     :: RTDIS,ZSOIL
+      REAL, DIMENSION(1:NSOIL),INTENT(OUT)    :: ET
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC,SH2O,STC
+      REAL, DIMENSION(1:NSOIL) :: ET1
+      REAL                  :: DENOM,DSOIL,DTOT,EC1,EDIR1,ESDFLX,ETA,   &
+                               ETT1, ESNOW1, ESNOW2, ETA1,ETP1,ETP2,    &
+                               ETP3, ETNS1, ETANRG, ETAX, EX, FLX3X,    &
+                               FRCSNO,FRCSOI, PRCP1, QSAT,RSNOW, SEH,   &
+                               SNCOND,SSOIL1, T11,T12, T12A, T12AX,     &
+                               T12B, T14, YY, ZZ1, EMISSI_S
+                                                                                
+      REAL, PARAMETER       :: ESDMIN = 1.E-6, LSUBC = 2.501000E+6,     &
+                               LSUBS = 2.83E+6, TFREEZ = 273.15,        &
+                               SNOEXP = 1.0 
+                                                                                 
+! ----------------------------------------------------------------------         
+! EXECUTABLE CODE BEGINS HERE:                                                   
+! INITIALIZE EVAP TERMS.                                                         
+! ----------------------------------------------------------------------         
+! conversions:                                                                   
+! ESNOW [KG M-2 S-1]                                                             
+! ESDFLX [KG M-2 S-1] .le. ESNOW                                                 
+! ESNOW1 [M S-1]                                                                 
+! ESNOW2 [M]                                                                     
+! ETP [KG M-2 S-1]                                                               
+! ETP1 [M S-1]                                                                   
+! ETP2 [M]                                                                       
+! ----------------------------------------------------------------------         
+      EDIR = 0.                                                                  
+      EDIR1 = 0.                                                                 
+      EC1 = 0.                                                                   
+      EC = 0.                                                                    
+      EMISSI_S=0.9     ! For snow
+      DO K = 1,NSOIL                                                             
+         ET (K) = 0.                                                             
+         ET1 (K) = 0.                                                            
+      END DO                                                                     
+      ETT = 0.                                                                   
+      ETT1 = 0.                                                                  
+      ETNS = 0.                                                                  
+      ETNS1 = 0.                                                                 
+      ESNOW = 0.                                                                 
+      ESNOW1 = 0.                                                                
+      ESNOW2 = 0.                                                                
+                                                                                 
+! CONVERT POTENTIAL EVAP (ETP) FROM KG M-2 S-1 TO M S-1 AND THEN TO AN           
+! AMOUNT (M) GIVEN TIMESTEP (DT) AND CALL IT AN EFFECTIVE SNOWPACK               
+! REDUCTION AMOUNT, ETP2 (M).  THIS IS THE AMOUNT THE SNOWPACK WOULD BE          
+! REDUCED DUE TO EVAPORATION FROM THE SNOW SFC DURING THE TIMESTEP.              
+! EVAPORATION WILL PROCEED AT THE POTENTIAL RATE UNLESS THE SNOW DEPTH           
+! IS LESS THAN THE EXPECTED SNOWPACK REDUCTION.                                  
+! IF SEAICE (ICE=1), BETA REMAINS=1.                                             
+! ----------------------------------------------------------------------         
+!      PRCP1 = PRCP1*0.001                                                       
+! change name of PRCP1 to PRCPF                                                  
+      DEW = 0.                                                                   
+                                                                                 
+      PRCP1 = PRCPF *0.001                                                       
+      ETP1 = ETP * 0.001                                                         
+      ESNOW = ETP * SNCOVR                                                       
+!      write(*,*) 'ESNOW,ESDFLX=',ESNOW,ESDFLX                                   
+!     ESDFLX = ESD *1000./ DT                                                    
+!     IF (ESDFLX .lt. ESNOW) THEN                                                
+!ek        ESD = 0.                                                              
+!        ESNOW = ESDFLX                                                          
+!        ESD = 0.                                                                
+!     ELSE                                                                       
+         ESNOW1 = ESNOW * 0.001                                                  
+!ek        ESD = ESD - ESNOW2                                                    
+         ESNOW2 = ESNOW1 * DT                                                    
+!        ESD = ESD- ESNOW2                                                       
+!     END IF                                                                     
+!     ETP2 = ETP * 0.001 * DT                                                    
+!      IF (ICE .NE. 1) THEN                                                      
+!        IF (ESD .LT. ETP2) THEN                                                 
+!          BETA = ESD / ETP2                                                     
+!        ENDIF                                                                   
+!      ENDIF                                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF ETP<0 (DOWNWARD) THEN DEWFALL (=FROSTFALL IN THIS CASE).                    
+! ----------------------------------------------------------------------         
+      BETA = 1.0                                                                 
+      IF (ETP <= 0.0) THEN                                                     
+        IF(ETP == 0.) BETA = 0.0                                                 
+         DEW = - ETP * 0.001                                                     
+!        ETP1 = 0.0                                                              
+      ELSE                                                                       
+         IF (ICE /=  1) THEN                                                    
+!            write(*,*) 'ETP1=',ETP1                                             
+             IF (SNCOVR <  1.) THEN                                            
+               CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,            &        
+                            SH2O,                                       &        
+                            SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,          &        
+                            SMCREF,SHDFAC,CMCMAX,                       &        
+                            SMCDRY,CFACTR,                              &        
+                            EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,   &        
+                            FXEXP)                                               
+               EDIR1 = EDIR1* (1. - SNCOVR)                                      
+               EC1 = EC1* (1. - SNCOVR)                                          
+               DO K = 1,NSOIL                                                    
+                  ET1 (K) = ET1 (K)* (1. - SNCOVR)                               
+               END DO                                                            
+               ETT1 = ETT1*(1.-SNCOVR)                                           
+               ETNS1 = EDIR1+ EC1+ ETT1                                          
+               EDIR = EDIR1*1000.                                                
+               EC = EC1*1000.                                                    
+               DO K = 1,NSOIL                                                    
+                  ET (K) = ET1 (K)*1000.                                         
+               END DO                                                            
+               ETT = ETT1*1000.                                                  
+               ETNS = ETNS1*1000.                                                
+!            write(*,*) EDIR*2.5E+9,                                             
+!     &                 EC*2.5E+9,                                               
+!     &                 ET(1)*2.5E+9,                                            
+!     &                 ET(2)*2.5E+9,                                            
+!     &                 ET(3)*2.5E+9,                                            
+!     &                 ET(4)*2.5E+9,                                            
+!     &                 ETT*2.5E+9                                               
+!            write(*,*) 'SNCOVR=',SNCOVR                                         
+               ETNS = ETNS1*1000.                                                
+!            write(*,*) 'ESNOW[W/M2],ETNS[W/M2]=',                               
+!     &                  ESNOW*LSUBS,ETNS*LSUBC                                  
+!            write(*,*) 'ETP[W/M2],ETANRG=',                                     
+!     &                  ETP*LSUBS,ETANRG                                        
+! ----------------------------------------------------------------------         
+                                                                                 
+!   end IF (SNCOVR .lt. 1.)                                                      
+            END IF                                                               
+                                                                                 
+!   end IF (ICE .ne. 1)                                                          
+         END IF                                                                  
+                                                                                 
+!   end IF (ETP .le. 0.0)                                                        
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+! COMPUTE TOTAL EVAPORATION, SNOW AND NON-SNOW                                   
+! also compute energy units (ETANRG) needed later below                          
+! ----------------------------------------------------------------------         
+                                                                                 
+!      write(*,*)'ESNOW*LSUBS,ETNS*LSUBC,ETANRG=',                               
+!     &           ESNOW*LSUBS,ETNS*LSUBC,ETANRG                                  
+      ETANRG = ESNOW * LSUBS + ETNS * LSUBC                                      
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF PRECIP IS FALLING, CALCULATE HEAT FLUX FROM SNOW SFC TO NEWLY               
+! ACCUMULATING PRECIP.  NOTE THAT THIS REFLECTS THE FLUX APPROPRIATE FOR         
+! THE NOT-YET-UPDATED SKIN TEMPERATURE (T1).  ASSUMES TEMPERATURE OF THE         
+! SNOWFALL STRIKING THE GROUND IS =SFCTMP (LOWEST MODEL LEVEL AIR TEMP).         
+! ----------------------------------------------------------------------         
+      FLX1 = 0.0                                                                 
+      IF (SNOWNG) THEN                                                           
+         FLX1 = CPICE * PRCP * (T1- SFCTMP)                                      
+      ELSE                                                                       
+         IF (PRCP >  0.0) FLX1 = CPH2O * PRCP * (T1- SFCTMP)                   
+! ----------------------------------------------------------------------         
+! CALCULATE AN 'EFFECTIVE SNOW-GRND SFC TEMP' (T12) BASED ON HEAT FLUXES         
+! BETWEEN THE SNOW PACK AND THE SOIL AND ON NET RADIATION.                       
+! INCLUDE FLX1 (PRECIP-SNOW SFC) AND FLX2 (FREEZING RAIN LATENT HEAT)            
+! FLUXES.  FLX1 FROM ABOVE, FLX2 BROUGHT IN VIA COMMOM BLOCK RITE.               
+! FLX2 REFLECTS FREEZING RAIN LATENT HEAT FLUX USING T1 CALCULATED IN            
+! PENMAN.                                                                        
+! ----------------------------------------------------------------------         
+      END IF                                                                     
+      DSOIL = - (0.5 * ZSOIL (1))                                                
+      DTOT = SNOWH + DSOIL                                                       
+!ek      T12A = ( (FDOWN-FLX1-FLX2-SIGMA*T24)/RCH                                
+!ek     &       + TH2 - SFCTMP - BETA*EPSCA ) / RR                               
+!ek      T12AX = ( (FDOWN-FLX1-FLX2-SIGMA*T24)/RCH                               
+!ek     &       + TH2 - SFCTMP - ETANRG/RCH ) / RR                               
+      DENOM = 1.0+ DF1 / (DTOT * RR * RCH)                                       
+!      write(*,*) 'T12A,T12AX=',T12A,T12AX                                       
+!Place for emiss, snow emiss=0.90
+!      T12A = ( (FDOWN - FLX1- FLX2- SIGMA * T24)/ RCH                   &        
+      T12A = ( (FDOWN - FLX1- FLX2- EMISSI_S*SIGMA * T24)/ RCH            &
+     &       + TH2- SFCTMP - ETANRG / RCH ) / RR                                 
+      T12B = DF1 * STC (1) / (DTOT * RR * RCH)                                   
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS AT OR BELOW FREEZING, NO SNOW         
+! MELT WILL OCCUR.  SET THE SKIN TEMP TO THIS EFFECTIVE TEMP.  REDUCE            
+! (BY SUBLIMINATION ) OR INCREASE (BY FROST) THE DEPTH OF THE SNOWPACK,          
+! DEPENDING ON SIGN OF ETP.                                                      
+! UPDATE SOIL HEAT FLUX (SSOIL) USING NEW SKIN TEMPERATURE (T1)                  
+! SINCE NO SNOWMELT, SET ACCUMULATED SNOWMELT TO ZERO, SET 'EFFECTIVE'           
+! PRECIP FROM SNOWMELT TO ZERO, SET PHASE-CHANGE HEAT FLUX FROM SNOWMELT         
+! TO ZERO.                                                                       
+! ----------------------------------------------------------------------         
+! SUB-FREEZING BLOCK                                                             
+! ----------------------------------------------------------------------         
+      T12 = (SFCTMP + T12A + T12B) / DENOM                                       
+      IF (T12 <=  TFREEZ) THEN                                                  
+         T1 = T12                                                                
+         SSOIL = DF1 * (T1- STC (1)) / DTOT                                      
+!        ESD = MAX (0.0, ESD- ETP2)                                              
+         ESD = MAX(0.0, ESD-ESNOW2)                                              
+         FLX3 = 0.0                                                              
+         EX = 0.0                                                                
+                                                                                 
+         SNOMLT = 0.0                                                            
+! ----------------------------------------------------------------------         
+! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS ABOVE FREEZING, SNOW MELT             
+! WILL OCCUR.  CALL THE SNOW MELT RATE,EX AND AMT, SNOMLT.  REVISE THE           
+! EFFECTIVE SNOW DEPTH.  REVISE THE SKIN TEMP BECAUSE IT WOULD HAVE CHGD         
+! DUE TO THE LATENT HEAT RELEASED BY THE MELTING. CALC THE LATENT HEAT           
+! RELEASED, FLX3. SET THE EFFECTIVE PRECIP, PRCP1 TO THE SNOW MELT RATE,         
+! EX FOR USE IN SMFLX.  ADJUSTMENT TO T1 TO ACCOUNT FOR SNOW PATCHES.            
+! CALCULATE QSAT VALID AT FREEZING POINT.  NOTE THAT ESAT (SATURATION            
+! VAPOR PRESSURE) VALUE OF 6.11E+2 USED HERE IS THAT VALID AT FRZZING            
+! POINT.  NOTE THAT ETP FROM CALL PENMAN IN SFLX IS IGNORED HERE IN              
+! FAVOR OF BULK ETP OVER 'OPEN WATER' AT FREEZING TEMP.                          
+! UPDATE SOIL HEAT FLUX (S) USING NEW SKIN TEMPERATURE (T1)                      
+! ----------------------------------------------------------------------         
+! ABOVE FREEZING BLOCK                                                           
+! ----------------------------------------------------------------------         
+!ek2        T1 = TFREEZ * SNCOVR + T12 * (1.0 - SNCOVR)                          
+      ELSE                                                                       
+!ek        QSAT = (0.622*6.11E2)/(SFCPRS-0.378*6.11E2)                           
+!ek        ETP = RCH*(QSAT-Q2)/CP                                                
+!ek        ETP2 = ETP*0.001*DT                                                   
+         T1 = TFREEZ * SNCOVR ** SNOEXP + T12 * (1.0- SNCOVR ** SNOEXP)          
+         BETA = 1.0                                                              
+                                                                                 
+! ----------------------------------------------------------------------         
+! IF POTENTIAL EVAP (SUBLIMATION) GREATER THAN DEPTH OF SNOWPACK.                
+! BETA<1                                                                         
+! SNOWPACK HAS SUBLIMATED AWAY, SET DEPTH TO ZERO.                               
+! ----------------------------------------------------------------------         
+         SSOIL = DF1 * (T1- STC (1)) / DTOT                                      
+!        IF (ESD .le. ETP2) THEN                                                 
+!           BETA = ESD / ETP2                                                    
+         IF (ESD <=  ESNOW2) THEN                                               
+            ESD = 0.0                                                            
+            EX = 0.0                                                             
+            SNOMLT = 0.0                                                         
+! ----------------------------------------------------------------------         
+! POTENTIAL EVAP (SUBLIMATION) LESS THAN DEPTH OF SNOWPACK, RETAIN               
+!   BETA=1.                                                                      
+! SNOWPACK (ESD) REDUCED BY POTENTIAL EVAP RATE                                  
+! ETP3 (CONVERT TO FLUX)                                                         
+! ----------------------------------------------------------------------         
+         ELSE                                                                    
+!           ESD = ESD- ETP2                                                      
+            ESD = ESD-ESNOW2                                                     
+            ETP3 = ETP * LSUBC                                                   
+!         WRITE (*,*) 'SNCOVR=',SNCOVR                                           
+!         WRITE (*,*) 'ETP3,ETANRG=',ETP3,ETANRG,'ETP',ETP,'LSUBC',LSUBC         
+            SEH = RCH * (T1- TH2)                                                
+            T14 = T1* T1                                                         
+!ek          FLX3 = FDOWN - FLX1 - FLX2 - SIGMA*T14 - SSOIL - SEH - ETP3         
+!ek          FLX3X = FDOWN - FLX1 - FLX2 - SIGMA*T14 - SSOIL - SEH - ETANRG      
+            T14 = T14* T14                                                       
+!            FLX3 = FDOWN - FLX1- FLX2- SIGMA * T14- SSOIL - SEH - ETANRG         
+           FLX3 = FDOWN - FLX1- FLX2- EMISSI_S*SIGMA * T14- SSOIL- SEH-     &
+     &            ETANRG
+!            WRITE (*,*) 'FLX3,FLX3X=',FLX3,FLX3X                                
+            IF (FLX3 <= 0.0) FLX3 = 0.0                                         
+! ----------------------------------------------------------------------         
+! SNOWMELT REDUCTION DEPENDING ON SNOW COVER                                     
+! IF SNOW COVER LESS THAN 5% NO SNOWMELT REDUCTION                               
+! ***NOTE:  DOES 'IF' BELOW FAIL TO MATCH THE MELT WATER WITH THE MELT           
+!           ENERGY?                                                              
+! ----------------------------------------------------------------------         
+            EX = FLX3*0.001/ LSUBF                                               
+!           IF (SNCOVR .gt. 0.05) EX = EX * SNCOVR                               
+                                                                                 
+! ----------------------------------------------------------------------         
+! ESDMIN REPRESENTS A SNOWPACK DEPTH THRESHOLD VALUE BELOW WHICH WE              
+! CHOOSE NOT TO RETAIN ANY SNOWPACK, AND INSTEAD INCLUDE IT IN SNOWMELT.         
+! ----------------------------------------------------------------------         
+            SNOMLT = EX * DT                                                     
+            IF (ESD- SNOMLT >=  ESDMIN) THEN                                    
+               ESD = ESD- SNOMLT                                                 
+! ----------------------------------------------------------------------         
+! SNOWMELT EXCEEDS SNOW DEPTH                                                    
+! ----------------------------------------------------------------------         
+            ELSE                                                                 
+               EX = ESD / DT                                                     
+               FLX3 = EX *1000.0* LSUBF                                          
+               SNOMLT = ESD                                                      
+                                                                                 
+               ESD = 0.0                                                         
+! ----------------------------------------------------------------------         
+! END OF 'ESD .LE. ETP2' IF-BLOCK                                                
+! ----------------------------------------------------------------------         
+            END IF                                                               
+         END IF                                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! END OF 'T12 .LE. TFREEZ' IF-BLOCK                                              
+! ----------------------------------------------------------------------         
+         PRCP1 = PRCP1+ EX                                                       
+! ----------------------------------------------------------------------         
+! FINAL BETA NOW IN HAND, SO COMPUTE EVAPORATION.  EVAP EQUALS ETP               
+! UNLESS BETA<1.                                                                 
+! ----------------------------------------------------------------------         
+!ek      ETA = BETA*ETP                                                          
+!      write(*,*) 'ETA,ETAX,ETAX/ETA=',ETA,ETAX,ETAX/ETA                         
+!      IF (ETAX/ETA .GE. 1.0) THEN                                               
+!        write(*,*) '*********************'                                      
+!        write(*,*) '*********************'                                      
+!        write(*,*) '*********************'                                      
+!        write(*,*) 'ETAX/ETA .GE. 1.0 !!!'                                      
+!        write(*,*) '*********************'                                      
+!        write(*,*) '*********************'                                      
+!        write(*,*) '*********************'                                      
+!      ENDIF                                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! SET THE EFFECTIVE POTNL EVAPOTRANSP (ETP1) TO ZERO SINCE THIS IS SNOW          
+! CASE, SO SURFACE EVAP NOT CALCULATED FROM EDIR, EC, OR ETT IN SMFLX            
+! (BELOW).                                                                       
+! IF SEAICE (ICE=1) SKIP CALL TO SMFLX.                                          
+! SMFLX RETURNS UPDATED SOIL MOISTURE VALUES.  IN THIS, THE SNOW PACK            
+! CASE, ETA1 IS NOT USED IN CALCULATION OF EVAP.                                 
+! ----------------------------------------------------------------------         
+!      ETP1 = 0.0                                                                
+      END IF                                                                     
+      IF (ICE /=  1) THEN                                                       
+         CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                      &        
+                      SH2O,SLOPE,KDT,FRZFACT,                           &        
+                      SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                   &        
+                      SHDFAC,CMCMAX,                                    &        
+                      RUNOFF1,RUNOFF2,RUNOFF3,                          &        
+                      EDIR1,EC1,ET1,                                    &        
+                      DRIP)                                                      
+! ----------------------------------------------------------------------         
+! BEFORE CALL SHFLX IN THIS SNOWPACK CASE, SET ZZ1 AND YY ARGUMENTS TO           
+! SPECIAL VALUES THAT ENSURE THAT GROUND HEAT FLUX CALCULATED IN SHFLX           
+! MATCHES THAT ALREADY COMPUTER FOR BELOW THE SNOWPACK, THUS THE SFC             
+! HEAT FLUX TO BE COMPUTED IN SHFLX WILL EFFECTIVELY BE THE FLUX AT THE          
+! SNOW TOP SURFACE.  T11 IS A DUMMY ARGUEMENT SO WE WILL NOT USE THE             
+! SKIN TEMP VALUE AS REVISED BY SHFLX.                                           
+! ----------------------------------------------------------------------         
+      END IF                                                                     
+      ZZ1 = 1.0                                                                  
+      YY = STC (1) -0.5* SSOIL * ZSOIL (1)* ZZ1/ DF1                             
+                                                                                 
+! ----------------------------------------------------------------------         
+! SHFLX WILL CALC/UPDATE THE SOIL TEMPS.  NOTE:  THE SUB-SFC HEAT FLUX           
+! (SSOIL1) AND THE SKIN TEMP (T11) OUTPUT FROM THIS SHFLX CALL ARE NOT           
+! USED  IN ANY SUBSEQUENT CALCULATIONS. RATHER, THEY ARE DUMMY VARIABLES         
+! HERE IN THE SNOPAC CASE, SINCE THE SKIN TEMP AND SUB-SFC HEAT FLUX ARE         
+! UPDATED INSTEAD NEAR THE BEGINNING OF THE CALL TO SNOPAC.                      
+! ----------------------------------------------------------------------         
+      T11 = T1                                                                   
+      CALL SHFLX (SSOIL1,STC,SMC,SMCMAX,NSOIL,T11,DT,YY,ZZ1,ZSOIL,      &        
+                   TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,ICE,        &        
+                   QUARTZ,CSOIL,VEGTYP)                                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! SNOW DEPTH AND DENSITY ADJUSTMENT BASED ON SNOW COMPACTION.  YY IS             
+! ASSUMED TO BE THE SOIL TEMPERTURE AT THE TOP OF THE SOIL COLUMN.               
+! ----------------------------------------------------------------------         
+      IF (ESD >  0.) THEN                                                      
+         CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY)                               
+      ELSE                                                                       
+         ESD = 0.                                                                
+         SNOWH = 0.                                                              
+         SNDENS = 0.                                                             
+         SNCOND = 1.                                                             
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SNOPAC                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+                                                                                 
+      SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL)                   
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SNOWPACK                                                            
+! ----------------------------------------------------------------------         
+! CALCULATE COMPACTION OF SNOWPACK UNDER CONDITIONS OF INCREASING SNOW           
+! DENSITY, AS OBTAINED FROM AN APPROXIMATE SOLUTION OF E. ANDERSON'S             
+! DIFFERENTIAL EQUATION (3.29), NOAA TECHNICAL REPORT NWS 19, BY VICTOR          
+! KOREN, 03/25/95.                                                               
+! ----------------------------------------------------------------------         
+! ESD     WATER EQUIVALENT OF SNOW (M)                                           
+! DTSEC   TIME STEP (SEC)                                                        
+! SNOWH   SNOW DEPTH (M)                                                         
+! SNDENS  SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY)             
+! TSNOW   SNOW SURFACE TEMPERATURE (K)                                           
+! TSOIL   SOIL SURFACE TEMPERATURE (K)                                           
+                                                                                 
+! SUBROUTINE WILL RETURN NEW VALUES OF SNOWH AND SNDENS                          
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+                                                                                 
+      INTEGER                :: IPOL, J                                                           
+      REAL, INTENT(IN)       :: ESD, DTSEC,TSNOW,TSOIL
+      REAL, INTENT(INOUT)    :: SNOWH, SNDENS
+      REAL                   :: BFAC,DSX,DTHR,DW,SNOWHC,PEXP,           &      
+                                TAVGC,TSNOWC,TSOILC,ESDC,ESDCX                 
+      REAL, PARAMETER        :: C1 = 0.01, C2 = 21.0, G = 9.81,         &
+                                KN = 4000.0                    
+! ----------------------------------------------------------------------         
+! CONVERSION INTO SIMULATION UNITS                                               
+! ----------------------------------------------------------------------         
+      SNOWHC = SNOWH *100.                                                       
+      ESDC = ESD *100.                                                           
+      DTHR = DTSEC /3600.                                                        
+      TSNOWC = TSNOW -273.15                                                     
+      TSOILC = TSOIL -273.15                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATING OF AVERAGE TEMPERATURE OF SNOW PACK                                
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! CALCULATING OF SNOW DEPTH AND DENSITY AS A RESULT OF COMPACTION                
+!  SNDENS=DS0*(EXP(BFAC*ESD)-1.)/(BFAC*ESD)                                      
+!  BFAC=DTHR*C1*EXP(0.08*TAVGC-C2*DS0)                                           
+! NOTE: BFAC*ESD IN SNDENS EQN ABOVE HAS TO BE CAREFULLY TREATED                 
+! NUMERICALLY BELOW:                                                             
+!   C1 IS THE FRACTIONAL INCREASE IN DENSITY (1/(CM*HR))                         
+!   C2 IS A CONSTANT (CM3/G) KOJIMA ESTIMATED AS 21 CMS/G                        
+! ----------------------------------------------------------------------         
+      TAVGC = 0.5* (TSNOWC + TSOILC)                                             
+      IF (ESDC >  1.E-2) THEN                                                  
+         ESDCX = ESDC                                                            
+      ELSE                                                                       
+         ESDCX = 1.E-2                                                           
+      END IF                                                                     
+                                                                                 
+!      DSX = SNDENS*((DEXP(BFAC*ESDC)-1.)/(BFAC*ESDC))                           
+! ----------------------------------------------------------------------         
+! THE FUNCTION OF THE FORM (e**x-1)/x IMBEDDED IN ABOVE EXPRESSION               
+! FOR DSX WAS CAUSING NUMERICAL DIFFICULTIES WHEN THE DENOMINATOR "x"            
+! (I.E. BFAC*ESDC) BECAME ZERO OR APPROACHED ZERO (DESPITE THE FACT THAT         
+! THE ANALYTICAL FUNCTION (e**x-1)/x HAS A WELL DEFINED LIMIT AS                 
+! "x" APPROACHES ZERO), HENCE BELOW WE REPLACE THE (e**x-1)/x                    
+! EXPRESSION WITH AN EQUIVALENT, NUMERICALLY WELL-BEHAVED                        
+! POLYNOMIAL EXPANSION.                                                          
+                                                                                 
+! NUMBER OF TERMS OF POLYNOMIAL EXPANSION, AND HENCE ITS ACCURACY,               
+! IS GOVERNED BY ITERATION LIMIT "IPOL".                                         
+!      IPOL GREATER THAN 9 ONLY MAKES A DIFFERENCE ON DOUBLE                     
+!            PRECISION (RELATIVE ERRORS GIVEN IN PERCENT %).                     
+!       IPOL=9, FOR REL.ERROR <~ 1.6 E-6 % (8 SIGNIFICANT DIGITS)                
+!       IPOL=8, FOR REL.ERROR <~ 1.8 E-5 % (7 SIGNIFICANT DIGITS)                
+!       IPOL=7, FOR REL.ERROR <~ 1.8 E-4 % ...                                   
+! ----------------------------------------------------------------------         
+      BFAC = DTHR * C1* EXP (0.08* TAVGC - C2* SNDENS)                           
+      IPOL = 4                                                                   
+      PEXP = 0.                                                                  
+!        PEXP = (1. + PEXP)*BFAC*ESDC/REAL(J+1)                                  
+      DO J = IPOL,1, -1                                                          
+         PEXP = (1. + PEXP)* BFAC * ESDCX / REAL (J +1)                          
+      END DO                                                                     
+                                                                                 
+      PEXP = PEXP + 1.                                                           
+! ----------------------------------------------------------------------         
+! ABOVE LINE ENDS POLYNOMIAL SUBSTITUTION                                        
+! ----------------------------------------------------------------------         
+!     END OF KOREAN FORMULATION                                                  
+                                                                                 
+!     BASE FORMULATION (COGLEY ET AL., 1990)                                     
+!     CONVERT DENSITY FROM G/CM3 TO KG/M3                                        
+!       DSM=SNDENS*1000.0                                                        
+                                                                                 
+!       DSX=DSM+DTSEC*0.5*DSM*G*ESD/                                             
+!    &      (1E7*EXP(-0.02*DSM+KN/(TAVGC+273.16)-14.643))                        
+                                                                                 
+!  &   CONVERT DENSITY FROM KG/M3 TO G/CM3                                       
+!       DSX=DSX/1000.0                                                           
+                                                                                 
+!     END OF COGLEY ET AL. FORMULATION                                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! SET UPPER/LOWER LIMIT ON SNOW DENSITY                                          
+! ----------------------------------------------------------------------         
+      DSX = SNDENS * (PEXP)                                                      
+      IF (DSX > 0.40) DSX = 0.40                                              
+      IF (DSX < 0.05) DSX = 0.05                                              
+! ----------------------------------------------------------------------         
+! UPDATE OF SNOW DEPTH AND DENSITY DEPENDING ON LIQUID WATER DURING              
+! SNOWMELT.  ASSUMED THAT 13% OF LIQUID WATER CAN BE STORED IN SNOW PER          
+! DAY DURING SNOWMELT TILL SNOW DENSITY 0.40.                                    
+! ----------------------------------------------------------------------         
+      SNDENS = DSX                                                               
+      IF (TSNOWC >=  0.) THEN                                                   
+         DW = 0.13* DTHR /24.                                                    
+         SNDENS = SNDENS * (1. - DW) + DW                                        
+         IF (SNDENS >=  0.40) SNDENS = 0.40                                     
+! ----------------------------------------------------------------------         
+! CALCULATE SNOW DEPTH (CM) FROM SNOW WATER EQUIVALENT AND SNOW DENSITY.         
+! CHANGE SNOW DEPTH UNITS TO METERS                                              
+! ----------------------------------------------------------------------         
+      END IF                                                                     
+      SNOWHC = ESDC / SNDENS                                                     
+      SNOWH = SNOWHC *0.01                                                       
+
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SNOWPACK                                                        
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE SNOWZ0 (SNCOVR,Z0, Z0BRD)                                       
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SNOWZ0                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE TOTAL ROUGHNESS LENGTH OVER SNOW                                     
+! SNCOVR  FRACTIONAL SNOW COVER                                                  
+! Z0      ROUGHNESS LENGTH (m)                                                   
+! Z0S     SNOW ROUGHNESS LENGTH:=0.001 (m)                                       
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      REAL, INTENT(IN)        :: SNCOVR, Z0BRD                                              
+      REAL, INTENT(OUT)       :: Z0                                              
+      REAL, PARAMETER         :: Z0S=0.001                                                      
+                                                                                 
+! CURRENT NOAH LSM CONDITION - MBEK, 09-OCT-2001                                 
+!     Z0S = Z0BRD                                                                
+      Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0S                                    
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SNOWZ0                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+                                                                                 
+      SUBROUTINE SNOW_NEW (TEMP,NEWSN,SNOWH,SNDENS)                              
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SNOW_NEW                                                            
+! ----------------------------------------------------------------------         
+! CALCULATE SNOW DEPTH AND DENSITITY TO ACCOUNT FOR THE NEW SNOWFALL.            
+! NEW VALUES OF SNOW DEPTH & DENSITY RETURNED.                                   
+                                                                                 
+! TEMP    AIR TEMPERATURE (K)                                                    
+! NEWSN   NEW SNOWFALL (M)                                                       
+! SNOWH   SNOW DEPTH (M)                                                         
+! SNDENS  SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY)             
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      REAL, INTENT(IN)        :: NEWSN, TEMP 
+      REAL, INTENT(INOUT)     :: SNDENS, SNOWH
+      REAL                    :: DSNEW, HNEWC, SNOWHC,NEWSNC,TEMPC
+                                                                                
+! ----------------------------------------------------------------------         
+! CONVERSION INTO SIMULATION UNITS                                               
+! ----------------------------------------------------------------------         
+      SNOWHC = SNOWH *100.                                                       
+      NEWSNC = NEWSN *100.                                                       
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATING NEW SNOWFALL DENSITY DEPENDING ON TEMPERATURE                      
+! EQUATION FROM GOTTLIB L. 'A GENERAL RUNOFF MODEL FOR SNOWCOVERED               
+! AND GLACIERIZED BASIN', 6TH NORDIC HYDROLOGICAL CONFERENCE,                    
+! VEMADOLEN, SWEDEN, 1980, 172-177PP.                                            
+!-----------------------------------------------------------------------         
+      TEMPC = TEMP -273.15                                                       
+      IF (TEMPC <=  -15.) THEN                                                  
+         DSNEW = 0.05                                                            
+      ELSE                                                                       
+         DSNEW = 0.05+0.0017* (TEMPC +15.)**1.5                                  
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+! ADJUSTMENT OF SNOW DENSITY DEPENDING ON NEW SNOWFALL                           
+! ----------------------------------------------------------------------         
+      HNEWC = NEWSNC / DSNEW                                                     
+      IF (SNOWHC + HNEWC .LT. 1.0E-3) THEN
+         SNDENS = MAX(DSNEW,SNDENS)
+      ELSE
+         SNDENS = (SNOWHC * SNDENS + HNEWC * DSNEW)/ (SNOWHC + HNEWC)               
+      ENDIF
+      SNOWHC = SNOWHC + HNEWC                                                    
+      SNOWH = SNOWHC *0.01                                                       
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SNOW_NEW                                                        
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,            &        
+                       ZSOIL,DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,           &        
+                       RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZX,SICE,AI,BI,CI)           
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SRT                                                                 
+! ----------------------------------------------------------------------         
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL            
+! WATER DIFFUSION EQUATION.  ALSO TO COMPUTE ( PREPARE ) THE MATRIX              
+! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME.          
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      INTEGER, INTENT(IN)       :: NSOIL
+      INTEGER                   :: IALP1, IOHINF, J, JJ,  K, KS
+      REAL, INTENT(IN)          :: BEXP, DKSAT, DT, DWSAT, EDIR, FRZX,  &
+                                   KDT, PCPDRP, SLOPE, SMCMAX, SMCWLT
+      REAL, INTENT(OUT)         :: RUNOFF1, RUNOFF2
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: ET, SH2O, SH2OA, SICE,  &
+                                                ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: RHSTT
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: AI, BI, CI
+      REAL, DIMENSION(1:NSOIL)  :: DMAX
+      REAL                      :: ACRT, DD, DDT, DDZ, DDZ2, DENOM,     &
+                                   DENOM2,DICE, DSMDZ, DSMDZ2, DT1,     &
+                                   FCR,INFMAX,MXSMC,MXSMC2,NUMER,PDDUM, &
+                                   PX, SICEMAX,SLOPX, SMCAV, SSTT,      &
+                                   SUM, VAL, WCND, WCND2, WDF, WDF2
+      INTEGER, PARAMETER        :: CVFRZ = 3 
+
+! ----------------------------------------------------------------------         
+! FROZEN GROUND VERSION:                                                         
+! REFERENCE FROZEN GROUND PARAMETER, CVFRZ, IS A SHAPE PARAMETER OF              
+! AREAL DISTRIBUTION FUNCTION OF SOIL ICE CONTENT WHICH EQUALS 1/CV.             
+! CV IS A COEFFICIENT OF SPATIAL VARIATION OF SOIL ICE CONTENT.  BASED           
+! ON FIELD DATA CV DEPENDS ON AREAL MEAN OF FROZEN DEPTH, AND IT CLOSE           
+! TO CONSTANT = 0.6 IF AREAL MEAN FROZEN DEPTH IS ABOVE 20 CM.  THAT IS          
+! WHY PARAMETER CVFRZ = 3 (INT{1/0.6*0.6}).                                      
+! CURRENT LOGIC DOESN'T ALLOW CVFRZ BE BIGGER THAN 3                             
+! ----------------------------------------------------------------------         
+                                                                                 
+! ----------------------------------------------------------------------         
+! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF.  INCLUDE THE                  
+! INFILTRATION FORMULE FROM SCHAAKE AND KOREN MODEL.                             
+! MODIFIED BY Q DUAN                                                             
+! ----------------------------------------------------------------------         
+! ----------------------------------------------------------------------         
+! LET SICEMAX BE THE GREATEST, IF ANY, FROZEN WATER CONTENT WITHIN SOIL          
+! LAYERS.                                                                        
+! ----------------------------------------------------------------------         
+      IOHINF = 1                                                                 
+      SICEMAX = 0.0                                                              
+      DO KS = 1,NSOIL                                                            
+         IF (SICE (KS) >  SICEMAX) SICEMAX = SICE (KS)                         
+! ----------------------------------------------------------------------         
+! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF                                
+! ----------------------------------------------------------------------         
+      END DO                                                                     
+      PDDUM = PCPDRP                                                             
+      RUNOFF1 = 0.0                                                              
+                                                                                 
+! ----------------------------------------------------------------------         
+! MODIFIED BY Q. DUAN, 5/16/94                                                   
+! ----------------------------------------------------------------------         
+!        IF (IOHINF == 1) THEN                                                 
+                                                                                 
+      IF (PCPDRP /=  0.0) THEN                                                  
+         DT1 = DT /86400.                                                        
+         SMCAV = SMCMAX - SMCWLT                                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! FROZEN GROUND VERSION:                                                         
+! ----------------------------------------------------------------------         
+         DMAX (1)= - ZSOIL (1)* SMCAV                                            
+                                                                                 
+         DICE = - ZSOIL (1) * SICE (1)                                           
+         DMAX (1)= DMAX (1)* (1.0- (SH2OA (1) + SICE (1) - SMCWLT)/      &       
+                    SMCAV)                                                       
+                                                                                 
+         DD = DMAX (1)                                                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! FROZEN GROUND VERSION:                                                         
+! ----------------------------------------------------------------------         
+         DO KS = 2,NSOIL                                                         
+                                                                                 
+            DICE = DICE+ ( ZSOIL (KS -1) - ZSOIL (KS) ) * SICE (KS)              
+            DMAX (KS) = (ZSOIL (KS -1) - ZSOIL (KS))* SMCAV                      
+            DMAX (KS) = DMAX (KS)* (1.0- (SH2OA (KS) + SICE (KS)        &        
+                        - SMCWLT)/ SMCAV)                                        
+            DD = DD+ DMAX (KS)                                                   
+! ----------------------------------------------------------------------         
+! VAL = (1.-EXP(-KDT*SQRT(DT1)))                                                 
+! IN BELOW, REMOVE THE SQRT IN ABOVE                                             
+! ----------------------------------------------------------------------         
+         END DO                                                                  
+         VAL = (1. - EXP ( - KDT * DT1))                                         
+         DDT = DD * VAL                                                          
+         PX = PCPDRP * DT                                                        
+         IF (PX <  0.0) PX = 0.0                                               
+                                                                                 
+! ----------------------------------------------------------------------         
+! FROZEN GROUND VERSION:                                                         
+! REDUCTION OF INFILTRATION BASED ON FROZEN GROUND PARAMETERS                    
+! ----------------------------------------------------------------------         
+         INFMAX = (PX * (DDT / (PX + DDT)))/ DT                                  
+         FCR = 1.                                                                
+         IF (DICE >  1.E-2) THEN                                               
+            ACRT = CVFRZ * FRZX / DICE                                           
+            SUM = 1.                                                             
+            IALP1 = CVFRZ - 1                                                    
+            DO J = 1,IALP1                                                       
+               K = 1                                                             
+               DO JJ = J +1,IALP1                                                
+                  K = K * JJ                                                     
+               END DO                                                            
+               SUM = SUM + (ACRT ** ( CVFRZ - J)) / FLOAT (K)                    
+            END DO                                                               
+            FCR = 1. - EXP ( - ACRT) * SUM                                       
+         END IF                                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! CORRECTION OF INFILTRATION LIMITATION:                                         
+! IF INFMAX .LE. HYDROLIC CONDUCTIVITY ASSIGN INFMAX THE VALUE OF                
+! HYDROLIC CONDUCTIVITY                                                          
+! ----------------------------------------------------------------------         
+!         MXSMC = MAX ( SH2OA(1), SH2OA(2) )                                     
+         INFMAX = INFMAX * FCR                                                   
+                                                                                 
+         MXSMC = SH2OA (1)                                                       
+         CALL WDFCND (WDF,WCND,MXSMC,SMCMAX,BEXP,DKSAT,DWSAT,           &        
+                         SICEMAX)                                                
+         INFMAX = MAX (INFMAX,WCND)                                              
+                                                                                 
+         INFMAX = MIN (INFMAX,PX)                                                
+         IF (PCPDRP >  INFMAX) THEN                                            
+            RUNOFF1 = PCPDRP - INFMAX                                            
+            PDDUM = INFMAX                                                       
+         END IF                                                                  
+! ----------------------------------------------------------------------         
+! TO AVOID SPURIOUS DRAINAGE BEHAVIOR, 'UPSTREAM DIFFERENCING' IN LINE           
+! BELOW REPLACED WITH NEW APPROACH IN 2ND LINE:                                  
+! 'MXSMC = MAX(SH2OA(1), SH2OA(2))'                                              
+! ----------------------------------------------------------------------         
+      END IF                                                                     
+                                                                                 
+      MXSMC = SH2OA (1)                                                          
+      CALL WDFCND (WDF,WCND,MXSMC,SMCMAX,BEXP,DKSAT,DWSAT,              &        
+                    SICEMAX)                                                     
+! ----------------------------------------------------------------------         
+! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER                  
+! ----------------------------------------------------------------------         
+      DDZ = 1. / ( - .5 * ZSOIL (2) )                                            
+      AI (1) = 0.0                                                               
+      BI (1) = WDF * DDZ / ( - ZSOIL (1) )                                       
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC RHSTT FOR THE TOP LAYER AFTER CALC'NG THE VERTICAL SOIL MOISTURE          
+! GRADIENT BTWN THE TOP AND NEXT TO TOP LAYERS.                                  
+! ----------------------------------------------------------------------         
+      CI (1) = - BI (1)                                                          
+      DSMDZ = ( SH2O (1) - SH2O (2) ) / ( - .5 * ZSOIL (2) )                     
+      RHSTT (1) = (WDF * DSMDZ + WCND- PDDUM + EDIR + ET (1))/ ZSOIL (1)         
+                                                                                 
+! ----------------------------------------------------------------------         
+! INITIALIZE DDZ2                                                                
+! ----------------------------------------------------------------------         
+      SSTT = WDF * DSMDZ + WCND+ EDIR + ET (1)                                   
+                                                                                 
+! ----------------------------------------------------------------------         
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABV PROCESS                 
+! ----------------------------------------------------------------------         
+      DDZ2 = 0.0                                                                 
+      DO K = 2,NSOIL                                                             
+         DENOM2 = (ZSOIL (K -1) - ZSOIL (K))                                     
+         IF (K /= NSOIL) THEN                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! AGAIN, TO AVOID SPURIOUS DRAINAGE BEHAVIOR, 'UPSTREAM DIFFERENCING' IN         
+! LINE BELOW REPLACED WITH NEW APPROACH IN 2ND LINE:                             
+! 'MXSMC2 = MAX (SH2OA(K), SH2OA(K+1))'                                          
+! ----------------------------------------------------------------------         
+            SLOPX = 1.                                                           
+                                                                                 
+            MXSMC2 = SH2OA (K)                                                   
+            CALL WDFCND (WDF2,WCND2,MXSMC2,SMCMAX,BEXP,DKSAT,DWSAT,     &        
+                          SICEMAX)                                               
+! -----------------------------------------------------------------------        
+! CALC SOME PARTIAL PRODUCTS FOR LATER USE IN CALC'NG RHSTT                      
+! ----------------------------------------------------------------------         
+            DENOM = (ZSOIL (K -1) - ZSOIL (K +1))                                
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT                    
+! ----------------------------------------------------------------------         
+            DSMDZ2 = (SH2O (K) - SH2O (K +1)) / (DENOM * 0.5)                    
+            DDZ2 = 2.0 / DENOM                                                   
+            CI (K) = - WDF2 * DDZ2 / DENOM2                                      
+                                                                                 
+         ELSE                                                                    
+! ----------------------------------------------------------------------         
+! SLOPE OF BOTTOM LAYER IS INTRODUCED                                            
+! ----------------------------------------------------------------------         
+                                                                                 
+! ----------------------------------------------------------------------         
+! RETRIEVE THE SOIL WATER DIFFUSIVITY AND HYDRAULIC CONDUCTIVITY FOR             
+! THIS LAYER                                                                     
+! ----------------------------------------------------------------------         
+            SLOPX = SLOPE                                                        
+          CALL WDFCND (WDF2,WCND2,SH2OA (NSOIL),SMCMAX,BEXP,DKSAT,DWSAT,     &   
+                            SICEMAX)                                             
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC A PARTIAL PRODUCT FOR LATER USE IN CALC'NG RHSTT                          
+! ----------------------------------------------------------------------         
+                                                                                 
+! ----------------------------------------------------------------------         
+! SET MATRIX COEF CI TO ZERO                                                     
+! ----------------------------------------------------------------------         
+            DSMDZ2 = 0.0                                                         
+            CI (K) = 0.0                                                         
+! ----------------------------------------------------------------------         
+! CALC RHSTT FOR THIS LAYER AFTER CALC'NG ITS NUMERATOR                          
+! ----------------------------------------------------------------------         
+         END IF                                                                  
+         NUMER = (WDF2 * DSMDZ2) + SLOPX * WCND2- (WDF * DSMDZ)         &        
+                 - WCND+ ET (K)                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER                                   
+! ----------------------------------------------------------------------         
+         RHSTT (K) = NUMER / ( - DENOM2)                                         
+         AI (K) = - WDF * DDZ / DENOM2                                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! RESET VALUES OF WDF, WCND, DSMDZ, AND DDZ FOR LOOP TO NEXT LYR                 
+! RUNOFF2:  SUB-SURFACE OR BASEFLOW RUNOFF                                       
+! ----------------------------------------------------------------------         
+         BI (K) = - ( AI (K) + CI (K) )                                          
+         IF (K .eq. NSOIL) THEN                                                  
+            RUNOFF2 = SLOPX * WCND2                                              
+         END IF                                                                  
+         IF (K .ne. NSOIL) THEN                                                  
+            WDF = WDF2                                                           
+            WCND = WCND2                                                         
+            DSMDZ = DSMDZ2                                                       
+            DDZ = DDZ2                                                           
+         END IF                                                                  
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SRT                                                             
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE SSTEP (SH2OOUT,SH2OIN,CMC,RHSTT,RHSCT,DT,              &        
+                        NSOIL,SMCMAX,CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,     &        
+                        AI,BI,CI)                                             
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SSTEP                                                               
+! ----------------------------------------------------------------------         
+! CALCULATE/UPDATE SOIL MOISTURE CONTENT VALUES AND CANOPY MOISTURE              
+! CONTENT VALUES.                                                                
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      INTEGER, INTENT(IN)       :: NSOIL
+      INTEGER                   :: I, K, KK11
+                                                                                 
+      REAL, INTENT(IN)          :: CMCMAX, DT, SMCMAX
+      REAL, INTENT(OUT)         :: RUNOFF3
+      REAL, INTENT(INOUT)       :: CMC
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)     :: SH2OIN, SICE, ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)    :: SH2OOUT
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: RHSTT, SMC
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: AI, BI, CI
+      REAL, DIMENSION(1:NSOIL)  :: RHSTTin
+      REAL, DIMENSION(1:NSOIL)  :: CIin
+      REAL                      :: DDZ, RHSCT, STOT, WPLUS
+
+! ----------------------------------------------------------------------         
+! CREATE 'AMOUNT' VALUES OF VARIABLES TO BE INPUT TO THE                         
+! TRI-DIAGONAL MATRIX ROUTINE.                                                   
+! ----------------------------------------------------------------------         
+      DO K = 1,NSOIL                                                             
+         RHSTT (K) = RHSTT (K) * DT                                              
+         AI (K) = AI (K) * DT                                                    
+         BI (K) = 1. + BI (K) * DT                                               
+         CI (K) = CI (K) * DT                                                    
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12                          
+! ----------------------------------------------------------------------         
+      DO K = 1,NSOIL                                                             
+         RHSTTin (K) = RHSTT (K)                                                 
+      END DO                                                                     
+      DO K = 1,NSOIL                                                             
+         CIin (K) = CI (K)                                                       
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+! CALL ROSR12 TO SOLVE THE TRI-DIAGONAL MATRIX                                   
+! ----------------------------------------------------------------------         
+      CALL ROSR12 (CI,AI,BI,CIin,RHSTTin,RHSTT,NSOIL)                            
+! ----------------------------------------------------------------------         
+! SUM THE PREVIOUS SMC VALUE AND THE MATRIX SOLUTION TO GET A                    
+! NEW VALUE.  MIN ALLOWABLE VALUE OF SMC WILL BE 0.02.                           
+! RUNOFF3: RUNOFF WITHIN SOIL LAYERS                                             
+! ----------------------------------------------------------------------         
+      WPLUS = 0.0                                                                
+      RUNOFF3 = 0.                                                               
+                                                                                 
+      DDZ = - ZSOIL (1)                                                          
+      DO K = 1,NSOIL                                                             
+         IF (K /= 1) DDZ = ZSOIL (K - 1) - ZSOIL (K) 
+         SH2OOUT (K) = SH2OIN (K) + CI (K) + WPLUS / DDZ
+         STOT = SH2OOUT (K) + SICE (K)                                           
+         IF (STOT > SMCMAX) THEN                                              
+            IF (K .eq. 1) THEN                                                   
+               DDZ = - ZSOIL (1)                                                 
+            ELSE                                                                 
+               KK11 = K - 1                                                      
+               DDZ = - ZSOIL (K) + ZSOIL (KK11)                                  
+            END IF                                                               
+            WPLUS = (STOT - SMCMAX) * DDZ                                        
+         ELSE                                                                    
+            WPLUS = 0.                                                           
+         END IF                                                                  
+         SMC (K) = MAX ( MIN (STOT,SMCMAX),0.02 )                                
+         SH2OOUT (K) = MAX ( (SMC (K) - SICE (K)),0.0)                           
+      END DO                                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! UPDATE CANOPY WATER CONTENT/INTERCEPTION (CMC).  CONVERT RHSCT TO              
+! AN 'AMOUNT' VALUE AND ADD TO PREVIOUS CMC VALUE TO GET NEW CMC.                
+! ----------------------------------------------------------------------         
+      RUNOFF3 = WPLUS                                                            
+      CMC = CMC + DT * RHSCT                                                     
+      IF (CMC < 1.E-20) CMC = 0.0                                             
+      CMC = MIN (CMC,CMCMAX)                                                     
+
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SSTEP                                                           
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE TBND (TU,TB,ZSOIL,ZBOT,K,NSOIL,TBND1)                           
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE TBND                                                                
+! ----------------------------------------------------------------------         
+! CALCULATE TEMPERATURE ON THE BOUNDARY OF THE LAYER BY INTERPOLATION OF         
+! THE MIDDLE LAYER TEMPERATURES                                                  
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      INTEGER, INTENT(IN)       :: NSOIL
+      INTEGER                   :: K
+      REAL, INTENT(IN)          :: TB, TU, ZBOT
+      REAL, INTENT(OUT)         :: TBND1
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: ZSOIL
+      REAL                      :: ZB, ZUP
+      REAL, PARAMETER           :: T0 = 273.15                                                    
+                                                                                 
+! ----------------------------------------------------------------------         
+! USE SURFACE TEMPERATURE ON THE TOP OF THE FIRST LAYER                          
+! ----------------------------------------------------------------------         
+     IF (K == 1) THEN                                                         
+         ZUP = 0.                                                                
+      ELSE                                                                       
+         ZUP = ZSOIL (K -1)                                                      
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+! USE DEPTH OF THE CONSTANT BOTTOM TEMPERATURE WHEN INTERPOLATE                  
+! TEMPERATURE INTO THE LAST LAYER BOUNDARY                                       
+! ----------------------------------------------------------------------         
+      IF (K ==  NSOIL) THEN                                                     
+         ZB = 2.* ZBOT - ZSOIL (K)                                               
+      ELSE                                                                       
+         ZB = ZSOIL (K +1)                                                       
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+! LINEAR INTERPOLATION BETWEEN THE AVERAGE LAYER TEMPERATURES                    
+! ----------------------------------------------------------------------         
+                                                                                 
+      TBND1 = TU + (TB - TU)* (ZUP - ZSOIL (K))/ (ZUP - ZB)                      
+! ----------------------------------------------------------------------         
+  END SUBROUTINE TBND                                                            
+! ----------------------------------------------------------------------         
+                                                                                 
+                                                                                 
+      SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O)                             
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE TDFCND                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE THERMAL DIFFUSIVITY AND CONDUCTIVITY OF THE SOIL FOR A GIVEN         
+! POINT AND TIME.                                                                
+! ----------------------------------------------------------------------         
+! PETERS-LIDARD APPROACH (PETERS-LIDARD et al., 1998)                            
+! June 2001 CHANGES: FROZEN SOIL CONDITION.                                      
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      REAL, INTENT(IN)          :: QZ,  SMC, SMCMAX, SH2O
+      REAL, INTENT(OUT)         :: DF
+      REAL                      :: AKE, GAMMD, THKDRY, THKICE, THKO,    &
+                                   THKQTZ,THKSAT,THKS,THKW,SATRATIO,XU, &
+                                   XUNFROZ
+                                    
+! ----------------------------------------------------------------------         
+! WE NOW GET QUARTZ AS AN INPUT ARGUMENT (SET IN ROUTINE REDPRM):                
+!      DATA QUARTZ /0.82, 0.10, 0.25, 0.60, 0.52,                                
+!     &             0.35, 0.60, 0.40, 0.82/                                      
+! ----------------------------------------------------------------------         
+! IF THE SOIL HAS ANY MOISTURE CONTENT COMPUTE A PARTIAL SUM/PRODUCT             
+! OTHERWISE USE A CONSTANT VALUE WHICH WORKS WELL WITH MOST SOILS                
+! ----------------------------------------------------------------------         
+!  THKW ......WATER THERMAL CONDUCTIVITY                                         
+!  THKQTZ ....THERMAL CONDUCTIVITY FOR QUARTZ                                    
+!  THKO ......THERMAL CONDUCTIVITY FOR OTHER SOIL COMPONENTS                     
+!  THKS ......THERMAL CONDUCTIVITY FOR THE SOLIDS COMBINED(QUARTZ+OTHER)         
+!  THKICE ....ICE THERMAL CONDUCTIVITY                                           
+!  SMCMAX ....POROSITY (= SMCMAX)                                                
+!  QZ .........QUARTZ CONTENT (SOIL TYPE DEPENDENT)                              
+! ----------------------------------------------------------------------         
+! USE AS IN PETERS-LIDARD, 1998 (MODIF. FROM JOHANSEN, 1975).                    
+                                                                                 
+!                                  PABLO GRUNMANN, 08/17/98                      
+! REFS.:                                                                         
+!      FAROUKI, O.T.,1986: THERMAL PROPERTIES OF SOILS. SERIES ON ROCK           
+!              AND SOIL MECHANICS, VOL. 11, TRANS TECH, 136 PP.                  
+!      JOHANSEN, O., 1975: THERMAL CONDUCTIVITY OF SOILS. PH.D. THESIS,          
+!              UNIVERSITY OF TRONDHEIM,                                          
+!      PETERS-LIDARD, C. D., ET AL., 1998: THE EFFECT OF SOIL THERMAL            
+!              CONDUCTIVITY PARAMETERIZATION ON SURFACE ENERGY FLUXES            
+!              AND TEMPERATURES. JOURNAL OF THE ATMOSPHERIC SCIENCES,            
+!              VOL. 55, PP. 1209-1224.                                           
+! ----------------------------------------------------------------------         
+! NEEDS PARAMETERS                                                               
+! POROSITY(SOIL TYPE):                                                           
+!      POROS = SMCMAX                                                            
+! SATURATION RATIO:                                                              
+! PARAMETERS  W/(M.K)                                                            
+      SATRATIO = SMC / SMCMAX                                                    
+      THKICE = 2.2                                                               
+      THKW = 0.57                                                                
+!      IF (QZ .LE. 0.2) THKO = 3.0                                               
+      THKO = 2.0                                                                 
+! SOLIDS' CONDUCTIVITY                                                           
+! QUARTZ' CONDUCTIVITY                                                           
+      THKQTZ = 7.7                                                               
+                                                                                 
+! UNFROZEN FRACTION (FROM 1., i.e., 100%LIQUID, TO 0. (100% FROZEN))             
+      THKS = (THKQTZ ** QZ)* (THKO ** (1. - QZ))                                 
+                                                                                 
+! UNFROZEN VOLUME FOR SATURATION (POROSITY*XUNFROZ)                              
+      XUNFROZ = SH2O / SMC                                                       
+! SATURATED THERMAL CONDUCTIVITY                                                 
+      XU = XUNFROZ * SMCMAX                                                      
+                                                                                 
+! DRY DENSITY IN KG/M3                                                           
+      THKSAT = THKS ** (1. - SMCMAX)* THKICE ** (SMCMAX - XU)* THKW **   &       
+         (XU)                                                                    
+                                                                                 
+! DRY THERMAL CONDUCTIVITY IN W.M-1.K-1                                          
+      GAMMD = (1. - SMCMAX)*2700.                                                
+                                                                                 
+      THKDRY = (0.135* GAMMD+ 64.7)/ (2700. - 0.947* GAMMD)                      
+! FROZEN                                                                         
+      IF ( (SH2O + 0.0005) <  SMC ) THEN                                       
+         AKE = SATRATIO                                                          
+! UNFROZEN                                                                       
+! RANGE OF VALIDITY FOR THE KERSTEN NUMBER (AKE)                                 
+      ELSE                                                                       
+                                                                                 
+! KERSTEN NUMBER (USING "FINE" FORMULA, VALID FOR SOILS CONTAINING AT            
+! LEAST 5% OF PARTICLES WITH DIAMETER LESS THAN 2.E-6 METERS.)                   
+! (FOR "COARSE" FORMULA, SEE PETERS-LIDARD ET AL., 1998).                        
+                                                                                 
+         IF ( SATRATIO >  0.1 ) THEN                                           
+                                                                                 
+            AKE = LOG10 (SATRATIO) + 1.0                                         
+                                                                                 
+! USE K = KDRY                                                                   
+         ELSE                                                                    
+                                                                                 
+            AKE = 0.0                                                            
+         END IF                                                                  
+!  THERMAL CONDUCTIVITY                                                          
+                                                                                 
+      END IF                                                                     
+                                                                                 
+      DF = AKE * (THKSAT - THKDRY) + THKDRY                                      
+! ----------------------------------------------------------------------         
+  END SUBROUTINE TDFCND                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE TMPAVG (TAVG,TUP,TM,TDN,ZSOIL,NSOIL,K)                          
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE TMPAVG                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE SOIL LAYER AVERAGE TEMPERATURE (TAVG) IN FREEZING/THAWING            
+! LAYER USING UP, DOWN, AND MIDDLE LAYER TEMPERATURES (TUP, TDN, TM),            
+! WHERE TUP IS AT TOP BOUNDARY OF LAYER, TDN IS AT BOTTOM BOUNDARY OF            
+! LAYER.  TM IS LAYER PROGNOSTIC STATE TEMPERATURE.                              
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      INTEGER  K                                                                 
+                                                                                 
+      INTEGER  NSOIL                                                             
+      REAL     DZ                                                                
+      REAL     DZH                                                               
+      REAL     T0                                                                
+      REAL     TAVG                                                              
+      REAL     TDN                                                               
+      REAL     TM                                                                
+      REAL     TUP                                                               
+      REAL     X0                                                                
+      REAL     XDN                                                               
+      REAL     XUP                                                               
+                                                                                 
+      REAL     ZSOIL (NSOIL)                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+      PARAMETER (T0 = 2.7315E2)                                                  
+      IF (K .eq. 1) THEN                                                         
+         DZ = - ZSOIL (1)                                                        
+      ELSE                                                                       
+         DZ = ZSOIL (K -1) - ZSOIL (K)                                           
+      END IF                                                                     
+                                                                                 
+      DZH = DZ *0.5                                                              
+      IF (TUP .lt. T0) THEN                                                      
+         IF (TM .lt. T0) THEN                                                    
+! ----------------------------------------------------------------------         
+! TUP, TM, TDN < T0                                                              
+! ----------------------------------------------------------------------         
+            IF (TDN .lt. T0) THEN                                                
+               TAVG = (TUP + 2.0* TM + TDN)/ 4.0                                 
+! ----------------------------------------------------------------------         
+! TUP & TM < T0,  TDN .ge. T0                                                    
+! ----------------------------------------------------------------------         
+            ELSE                                                                 
+               X0 = (T0- TM) * DZH / (TDN - TM)                                  
+               TAVG = 0.5 * (TUP * DZH + TM * (DZH + X0) + T0* (        &        
+     &               2.* DZH - X0)) / DZ                                         
+            END IF                                                               
+         ELSE                                                                    
+! ----------------------------------------------------------------------         
+! TUP < T0, TM .ge. T0, TDN < T0                                                 
+! ----------------------------------------------------------------------         
+            IF (TDN .lt. T0) THEN                                                
+               XUP = (T0- TUP) * DZH / (TM - TUP)                                
+               XDN = DZH - (T0- TM) * DZH / (TDN - TM)                           
+               TAVG = 0.5 * (TUP * XUP + T0* (2.* DZ - XUP - XDN)       &        
+     &                + TDN * XDN) / DZ                                          
+! ----------------------------------------------------------------------         
+! TUP < T0, TM .ge. T0, TDN .ge. T0                                              
+! ----------------------------------------------------------------------         
+            ELSE                                                                 
+               XUP = (T0- TUP) * DZH / (TM - TUP)                                
+               TAVG = 0.5 * (TUP * XUP + T0* (2.* DZ - XUP)) / DZ                
+            END IF                                                               
+         END IF                                                                  
+      ELSE                                                                       
+         IF (TM .lt. T0) THEN                                                    
+! ----------------------------------------------------------------------         
+! TUP .ge. T0, TM < T0, TDN < T0                                                 
+! ----------------------------------------------------------------------         
+            IF (TDN .lt. T0) THEN                                                
+               XUP = DZH - (T0- TUP) * DZH / (TM - TUP)                          
+               TAVG = 0.5 * (T0* (DZ - XUP) + TM * (DZH + XUP)          &        
+     &                + TDN * DZH) / DZ                                          
+! ----------------------------------------------------------------------         
+! TUP .ge. T0, TM < T0, TDN .ge. T0                                              
+! ----------------------------------------------------------------------         
+            ELSE                                                                 
+               XUP = DZH - (T0- TUP) * DZH / (TM - TUP)                          
+               XDN = (T0- TM) * DZH / (TDN - TM)                                 
+               TAVG = 0.5 * (T0* (2.* DZ - XUP - XDN) + TM *            &        
+     & (XUP + XDN)) / DZ                                                         
+            END IF                                                               
+         ELSE                                                                    
+! ----------------------------------------------------------------------         
+! TUP .ge. T0, TM .ge. T0, TDN < T0                                              
+! ----------------------------------------------------------------------         
+            IF (TDN .lt. T0) THEN                                                
+               XDN = DZH - (T0- TM) * DZH / (TDN - TM)                           
+               TAVG = (T0* (DZ - XDN) +0.5* (T0+ TDN)* XDN) / DZ                 
+! ----------------------------------------------------------------------         
+! TUP .ge. T0, TM .ge. T0, TDN .ge. T0                                           
+! ----------------------------------------------------------------------         
+            ELSE                                                                 
+               TAVG = (TUP + 2.0* TM + TDN) / 4.0                                
+            END IF                                                               
+         END IF                                                                  
+      END IF                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE TMPAVG                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE TRANSP (ET,NSOIL,ETP1,SMC,CMC,ZSOIL,SHDFAC,SMCWLT,     &        
+     &                      CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT,    &        
+     &                      RTDIS)                                               
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE TRANSP                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE TRANSPIRATION FOR THE VEG CLASS.                                     
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      INTEGER  I                                                                 
+      INTEGER  K                                                                 
+      INTEGER  NSOIL                                                             
+                                                                                 
+      INTEGER  NROOT                                                             
+      REAL     CFACTR                                                            
+      REAL     CMC                                                               
+      REAL     CMCMAX                                                            
+      REAL     DENOM                                                             
+      REAL     ET (NSOIL)                                                        
+      REAL     ETP1                                                              
+      REAL     ETP1A                                                             
+!.....REAL PART(NSOIL)                                                           
+      REAL     GX (7)                                                            
+      REAL     PC                                                                
+      REAL     Q2                                                                
+      REAL     RTDIS (NSOIL)                                                     
+      REAL     RTX                                                               
+      REAL     SFCTMP                                                            
+      REAL     SGX                                                               
+      REAL     SHDFAC                                                            
+      REAL     SMC (NSOIL)                                                       
+      REAL     SMCREF                                                            
+      REAL     SMCWLT                                                            
+                                                                                 
+! ----------------------------------------------------------------------         
+! INITIALIZE PLANT TRANSP TO ZERO FOR ALL SOIL LAYERS.                           
+! ----------------------------------------------------------------------         
+      REAL     ZSOIL (NSOIL)                                                     
+      DO K = 1,NSOIL                                                             
+         ET (K) = 0.                                                             
+! ----------------------------------------------------------------------         
+! CALCULATE AN 'ADJUSTED' POTENTIAL TRANSPIRATION                                
+! IF STATEMENT BELOW TO AVOID TANGENT LINEAR PROBLEMS NEAR ZERO                  
+! NOTE: GX AND OTHER TERMS BELOW REDISTRIBUTE TRANSPIRATION BY LAYER,            
+! ET(K), AS A FUNCTION OF SOIL MOISTURE AVAILABILITY, WHILE PRESERVING           
+! TOTAL ETP1A.                                                                   
+! ----------------------------------------------------------------------         
+      END DO                                                                     
+      IF (CMC .ne. 0.0) THEN                                                     
+         ETP1A = SHDFAC * PC * ETP1 * (1.0- (CMC / CMCMAX) ** CFACTR)            
+      ELSE                                                                       
+         ETP1A = SHDFAC * PC * ETP1                                              
+      END IF                                                                     
+      SGX = 0.0                                                                  
+      DO I = 1,NROOT                                                             
+         GX (I) = ( SMC (I) - SMCWLT ) / ( SMCREF - SMCWLT )                     
+         GX (I) = MAX ( MIN ( GX (I), 1. ), 0. )                                 
+         SGX = SGX + GX (I)                                                      
+      END DO                                                                     
+                                                                                 
+      SGX = SGX / NROOT                                                          
+      DENOM = 0.                                                                 
+      DO I = 1,NROOT                                                             
+         RTX = RTDIS (I) + GX (I) - SGX                                          
+         GX (I) = GX (I) * MAX ( RTX, 0. )                                       
+         DENOM = DENOM + GX (I)                                                  
+      END DO                                                                     
+                                                                                 
+      IF (DENOM .le. 0.0) DENOM = 1.                                             
+      DO I = 1,NROOT                                                             
+         ET (I) = ETP1A * GX (I) / DENOM                                         
+! ----------------------------------------------------------------------         
+! ABOVE CODE ASSUMES A VERTICALLY UNIFORM ROOT DISTRIBUTION                      
+! CODE BELOW TESTS A VARIABLE ROOT DISTRIBUTION                                  
+! ----------------------------------------------------------------------         
+!      ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * GX * ETP1A                          
+!      ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * ETP1A                               
+! ----------------------------------------------------------------------         
+! USING ROOT DISTRIBUTION AS WEIGHTING FACTOR                                    
+! ----------------------------------------------------------------------         
+!      ET(1) = RTDIS(1) * ETP1A                                                  
+!      ET(1) = ETP1A * PART(1)                                                   
+! ----------------------------------------------------------------------         
+! LOOP DOWN THRU THE SOIL LAYERS REPEATING THE OPERATION ABOVE,                  
+! BUT USING THE THICKNESS OF THE SOIL LAYER (RATHER THAN THE                     
+! ABSOLUTE DEPTH OF EACH LAYER) IN THE FINAL CALCULATION.                        
+! ----------------------------------------------------------------------         
+!      DO K = 2,NROOT                                                            
+!        GX = ( SMC(K) - SMCWLT ) / ( SMCREF - SMCWLT )                          
+!        GX = MAX ( MIN ( GX, 1. ), 0. )                                         
+! TEST CANOPY RESISTANCE                                                         
+!        GX = 1.0                                                                
+!        ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*GX*ETP1A                   
+!        ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*ETP1A                      
+! ----------------------------------------------------------------------         
+! USING ROOT DISTRIBUTION AS WEIGHTING FACTOR                                    
+! ----------------------------------------------------------------------         
+!        ET(K) = RTDIS(K) * ETP1A                                                
+!        ET(K) = ETP1A*PART(K)                                                   
+!      END DO                                                                    
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE TRANSP                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE WDFCND (WDF,WCND,SMC,SMCMAX,BEXP,DKSAT,DWSAT,          &        
+     &                      SICEMAX)                                             
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE WDFCND                                                              
+! ----------------------------------------------------------------------         
+! CALCULATE SOIL WATER DIFFUSIVITY AND SOIL HYDRAULIC CONDUCTIVITY.              
+! ----------------------------------------------------------------------         
+      IMPLICIT NONE                                                              
+      REAL     BEXP                                                              
+      REAL     DKSAT                                                             
+      REAL     DWSAT                                                             
+      REAL     EXPON                                                             
+      REAL     FACTR1                                                            
+      REAL     FACTR2                                                            
+      REAL     SICEMAX                                                           
+      REAL     SMC                                                               
+      REAL     SMCMAX                                                            
+      REAL     VKwgt                                                             
+      REAL     WCND                                                              
+                                                                                 
+! ----------------------------------------------------------------------         
+!     CALC THE RATIO OF THE ACTUAL TO THE MAX PSBL SOIL H2O CONTENT              
+! ----------------------------------------------------------------------         
+      REAL     WDF                                                               
+      FACTR1 = 0.2 / SMCMAX                                                      
+                                                                                 
+! ----------------------------------------------------------------------         
+! PREP AN EXPNTL COEF AND CALC THE SOIL WATER DIFFUSIVITY                        
+! ----------------------------------------------------------------------         
+      FACTR2 = SMC / SMCMAX                                                      
+      EXPON = BEXP + 2.0                                                         
+                                                                                 
+! ----------------------------------------------------------------------         
+! FROZEN SOIL HYDRAULIC DIFFUSIVITY.  VERY SENSITIVE TO THE VERTICAL             
+! GRADIENT OF UNFROZEN WATER. THE LATTER GRADIENT CAN BECOME VERY                
+! EXTREME IN FREEZING/THAWING SITUATIONS, AND GIVEN THE RELATIVELY               
+! FEW AND THICK SOIL LAYERS, THIS GRADIENT SUFFERES SERIOUS                      
+! TRUNCTION ERRORS YIELDING ERRONEOUSLY HIGH VERTICAL TRANSPORTS OF              
+! UNFROZEN WATER IN BOTH DIRECTIONS FROM HUGE HYDRAULIC DIFFUSIVITY.             
+! THEREFORE, WE FOUND WE HAD TO ARBITRARILY CONSTRAIN WDF                        
+! --                                                                             
+! VERSION D_10CM: ........  FACTR1 = 0.2/SMCMAX                                  
+! WEIGHTED APPROACH...................... PABLO GRUNMANN, 28_SEP_1999.           
+! ----------------------------------------------------------------------         
+      WDF = DWSAT * FACTR2 ** EXPON                                              
+      IF (SICEMAX .gt. 0.0) THEN                                                 
+         VKWGT = 1./ (1. + (500.* SICEMAX)**3.)                                  
+         WDF = VKWGT * WDF + (1. - VKWGT)* DWSAT * FACTR1** EXPON                
+! ----------------------------------------------------------------------         
+! RESET THE EXPNTL COEF AND CALC THE HYDRAULIC CONDUCTIVITY                      
+! ----------------------------------------------------------------------         
+      END IF                                                                     
+      EXPON = (2.0 * BEXP) + 3.0                                                 
+      WCND = DKSAT * FACTR2 ** EXPON                                             
+                                                                                 
+! ----------------------------------------------------------------------         
+  END SUBROUTINE WDFCND                                                          
+! ----------------------------------------------------------------------         
+                                                                                 
+      SUBROUTINE SFCDIF_off (ZLM,Z0,THZ0,THLM,SFCSPD,CZIL,AKMS,AKHS)             
+                                                                                 
+! ----------------------------------------------------------------------         
+! SUBROUTINE SFCDIF (renamed SFCDIF_off to avoid clash with Eta PBL)             
+! ----------------------------------------------------------------------         
+! CALCULATE SURFACE LAYER EXCHANGE COEFFICIENTS VIA ITERATIVE PROCESS.           
+! SEE CHEN ET AL (1997, BLM)                                                     
+! ----------------------------------------------------------------------         
+                                                                                 
+      IMPLICIT NONE                                                              
+      REAL     WWST, WWST2, G, VKRM, EXCM, BETA, BTG, ELFC, WOLD, WNEW           
+      REAL     PIHF, EPSU2, EPSUST, EPSIT, EPSA, ZTMIN, ZTMAX, HPBL,     &       
+     & SQVISC                                                                    
+      REAL     RIC, RRIC, FHNEU, RFC, RFAC, ZZ, PSLMU, PSLMS, PSLHU,     &       
+     & PSLHS                                                                     
+      REAL     XX, PSPMU, YY, PSPMS, PSPHU, PSPHS, ZLM, Z0, THZ0, THLM           
+      REAL     SFCSPD, CZIL, AKMS, AKHS, ZILFC, ZU, ZT, RDZ, CXCH                
+      REAL     DTHV, DU2, BTGH, WSTAR2, USTAR, ZSLU, ZSLT, RLOGU, RLOGT          
+      REAL     RLMO, ZETALT, ZETALU, ZETAU, ZETAT, XLU4, XLT4, XU4, XT4          
+!CC   ......REAL ZTFC                                                            
+                                                                                 
+      REAL     XLU, XLT, XU, XT, PSMZ, SIMM, PSHZ, SIMH, USTARK, RLMN,  &        
+     &         RLMA                                                              
+                                                                                 
+      INTEGER  ITRMX, ILECH, ITR                                                 
+      PARAMETER                                                         &        
+     &        (WWST = 1.2,WWST2 = WWST * WWST,G = 9.8,VKRM = 0.40,      &        
+     &         EXCM = 0.001                                             &        
+     &        ,BETA = 1./270.,BTG = BETA * G,ELFC = VKRM * BTG          &        
+     &                  ,WOLD =.15,WNEW = 1. - WOLD,ITRMX = 05,         &        
+     &                   PIHF = 3.14159265/2.)                                   
+      PARAMETER                                                         &        
+     &         (EPSU2 = 1.E-4,EPSUST = 0.07,EPSIT = 1.E-4,EPSA = 1.E-8  &        
+     &         ,ZTMIN = -5.,ZTMAX = 1.,HPBL = 1000.0                    &        
+     &          ,SQVISC = 258.2)                                                 
+      PARAMETER                                                         &        
+     &       (RIC = 0.183,RRIC = 1.0/ RIC,FHNEU = 0.8,RFC = 0.191       &        
+     &        ,RFAC = RIC / (FHNEU * RFC * RFC))                                 
+                                                                                 
+! ----------------------------------------------------------------------         
+! NOTE: THE TWO CODE BLOCKS BELOW DEFINE FUNCTIONS                               
+! ----------------------------------------------------------------------         
+! LECH'S SURFACE FUNCTIONS                                                       
+! ----------------------------------------------------------------------         
+      PSLMU (ZZ)= -0.96* log (1.0-4.5* ZZ)                                       
+      PSLMS (ZZ)= ZZ * RRIC -2.076* (1. -1./ (ZZ +1.))                           
+      PSLHU (ZZ)= -0.96* log (1.0-4.5* ZZ)                                       
+                                                                                 
+! ----------------------------------------------------------------------         
+! PAULSON'S SURFACE FUNCTIONS                                                    
+! ----------------------------------------------------------------------         
+      PSLHS (ZZ)= ZZ * RFAC -2.076* (1. -1./ (ZZ +1.))                           
+      PSPMU (XX)= -2.* log ( (XX +1.)*0.5) - log ( (XX * XX +1.)*0.5)   &        
+     &        +2.* ATAN (XX)                                            &        
+     &- PIHF                                                                     
+      PSPMS (YY)= 5.* YY                                                         
+      PSPHU (XX)= -2.* log ( (XX * XX +1.)*0.5)                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! THIS ROUTINE SFCDIF CAN HANDLE BOTH OVER OPEN WATER (SEA, OCEAN) AND           
+! OVER SOLID SURFACE (LAND, SEA-ICE).                                            
+! ----------------------------------------------------------------------         
+      PSPHS (YY)= 5.* YY                                                         
+                                                                                 
+! ----------------------------------------------------------------------         
+!     ZTFC: RATIO OF ZOH/ZOM  LESS OR EQUAL THAN 1                               
+!     C......ZTFC=0.1                                                            
+!     CZIL: CONSTANT C IN Zilitinkevich, S. S.1995,:NOTE ABOUT ZT                
+! ----------------------------------------------------------------------         
+      ILECH = 0                                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+      ZILFC = - CZIL * VKRM * SQVISC                                             
+!     C.......ZT=Z0*ZTFC                                                         
+      ZU = Z0                                                                    
+      RDZ = 1./ ZLM                                                              
+      CXCH = EXCM * RDZ                                                          
+      DTHV = THLM - THZ0                                                         
+                                                                                 
+! ----------------------------------------------------------------------         
+! BELJARS CORRECTION OF USTAR                                                    
+! ----------------------------------------------------------------------         
+      DU2 = MAX (SFCSPD * SFCSPD,EPSU2)                                          
+!cc   If statements to avoid TANGENT LINEAR problems near zero                   
+      BTGH = BTG * HPBL                                                          
+      IF (BTGH * AKHS * DTHV .ne. 0.0) THEN                                      
+         WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2./3.)                      
+      ELSE                                                                       
+         WSTAR2 = 0.0                                                            
+      END IF                                                                     
+                                                                                 
+! ----------------------------------------------------------------------         
+! ZILITINKEVITCH APPROACH FOR ZT                                                 
+! ----------------------------------------------------------------------         
+      USTAR = MAX (SQRT (AKMS * SQRT (DU2+ WSTAR2)),EPSUST)                      
+                                                                                 
+! ----------------------------------------------------------------------         
+      ZT = EXP (ZILFC * SQRT (USTAR * Z0))* Z0                                   
+      ZSLU = ZLM + ZU                                                            
+!     PRINT*,'ZSLT=',ZSLT                                                        
+!     PRINT*,'ZLM=',ZLM                                                          
+!     PRINT*,'ZT=',ZT                                                            
+                                                                                 
+      ZSLT = ZLM + ZT                                                            
+      RLOGU = log (ZSLU / ZU)                                                    
+                                                                                 
+      RLOGT = log (ZSLT / ZT)                                                    
+!     PRINT*,'RLMO=',RLMO                                                        
+!     PRINT*,'ELFC=',ELFC                                                        
+!     PRINT*,'AKHS=',AKHS                                                        
+!     PRINT*,'DTHV=',DTHV                                                        
+!     PRINT*,'USTAR=',USTAR                                                      
+                                                                                 
+      RLMO = ELFC * AKHS * DTHV / USTAR **3                                      
+! ----------------------------------------------------------------------         
+! 1./MONIN-OBUKKHOV LENGTH-SCALE                                                 
+! ----------------------------------------------------------------------         
+      DO ITR = 1,ITRMX                                                           
+         ZETALT = MAX (ZSLT * RLMO,ZTMIN)                                        
+         RLMO = ZETALT / ZSLT                                                    
+         ZETALU = ZSLU * RLMO                                                    
+         ZETAU = ZU * RLMO                                                       
+                                                                                 
+         ZETAT = ZT * RLMO                                                       
+         IF (ILECH .eq. 0) THEN                                                  
+            IF (RLMO .lt. 0.)THEN                                                
+               XLU4 = 1. -16.* ZETALU                                            
+               XLT4 = 1. -16.* ZETALT                                            
+               XU4 = 1. -16.* ZETAU                                              
+                                                                                 
+               XT4 = 1. -16.* ZETAT                                              
+               XLU = SQRT (SQRT (XLU4))                                          
+               XLT = SQRT (SQRT (XLT4))                                          
+               XU = SQRT (SQRT (XU4))                                            
+                                                                                 
+               XT = SQRT (SQRT (XT4))                                            
+!     PRINT*,'-----------1------------'                                          
+!     PRINT*,'PSMZ=',PSMZ                                                        
+!     PRINT*,'PSPMU(ZETAU)=',PSPMU(ZETAU)                                        
+!     PRINT*,'XU=',XU                                                            
+!     PRINT*,'------------------------'                                          
+               PSMZ = PSPMU (XU)                                                 
+               SIMM = PSPMU (XLU) - PSMZ + RLOGU                                 
+               PSHZ = PSPHU (XT)                                                 
+               SIMH = PSPHU (XLT) - PSHZ + RLOGT                                 
+            ELSE                                                                 
+               ZETALU = MIN (ZETALU,ZTMAX)                                       
+               ZETALT = MIN (ZETALT,ZTMAX)                                       
+!     PRINT*,'-----------2------------'                                          
+!     PRINT*,'PSMZ=',PSMZ                                                        
+!     PRINT*,'PSPMS(ZETAU)=',PSPMS(ZETAU)                                        
+!     PRINT*,'ZETAU=',ZETAU                                                      
+!     PRINT*,'------------------------'                                          
+               PSMZ = PSPMS (ZETAU)                                              
+               SIMM = PSPMS (ZETALU) - PSMZ + RLOGU                              
+               PSHZ = PSPHS (ZETAT)                                              
+               SIMH = PSPHS (ZETALT) - PSHZ + RLOGT                              
+            END IF                                                               
+! ----------------------------------------------------------------------         
+! LECH'S FUNCTIONS                                                               
+! ----------------------------------------------------------------------         
+         ELSE                                                                    
+            IF (RLMO .lt. 0.)THEN                                                
+!     PRINT*,'-----------3------------'                                          
+!     PRINT*,'PSMZ=',PSMZ                                                        
+!     PRINT*,'PSLMU(ZETAU)=',PSLMU(ZETAU)                                        
+!     PRINT*,'ZETAU=',ZETAU                                                      
+!     PRINT*,'------------------------'                                          
+               PSMZ = PSLMU (ZETAU)                                              
+               SIMM = PSLMU (ZETALU) - PSMZ + RLOGU                              
+               PSHZ = PSLHU (ZETAT)                                              
+               SIMH = PSLHU (ZETALT) - PSHZ + RLOGT                              
+            ELSE                                                                 
+               ZETALU = MIN (ZETALU,ZTMAX)                                       
+                                                                                 
+               ZETALT = MIN (ZETALT,ZTMAX)                                       
+!     PRINT*,'-----------4------------'                                          
+!     PRINT*,'PSMZ=',PSMZ                                                        
+!     PRINT*,'PSLMS(ZETAU)=',PSLMS(ZETAU)                                        
+!     PRINT*,'ZETAU=',ZETAU                                                      
+!     PRINT*,'------------------------'                                          
+               PSMZ = PSLMS (ZETAU)                                              
+               SIMM = PSLMS (ZETALU) - PSMZ + RLOGU                              
+               PSHZ = PSLHS (ZETAT)                                              
+               SIMH = PSLHS (ZETALT) - PSHZ + RLOGT                              
+            END IF                                                               
+! ----------------------------------------------------------------------         
+! BELJAARS CORRECTION FOR USTAR                                                  
+! ----------------------------------------------------------------------         
+         END IF                                                                  
+                                                                                 
+! ----------------------------------------------------------------------         
+! ZILITINKEVITCH FIX FOR ZT                                                      
+! ----------------------------------------------------------------------         
+         USTAR = MAX (SQRT (AKMS * SQRT (DU2+ WSTAR2)),EPSUST)                   
+                                                                                 
+         ZT = EXP (ZILFC * SQRT (USTAR * Z0))* Z0                                
+         ZSLT = ZLM + ZT                                                         
+!-----------------------------------------------------------------------         
+         RLOGT = log (ZSLT / ZT)                                                 
+         USTARK = USTAR * VKRM                                                   
+         AKMS = MAX (USTARK / SIMM,CXCH)                                         
+!-----------------------------------------------------------------------         
+! IF STATEMENTS TO AVOID TANGENT LINEAR PROBLEMS NEAR ZERO                       
+!-----------------------------------------------------------------------         
+         AKHS = MAX (USTARK / SIMH,CXCH)                                         
+         IF (BTGH * AKHS * DTHV .ne. 0.0) THEN                                   
+            WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2./3.)                   
+         ELSE                                                                    
+            WSTAR2 = 0.0                                                         
+         END IF                                                                  
+!-----------------------------------------------------------------------         
+         RLMN = ELFC * AKHS * DTHV / USTAR **3                                   
+!-----------------------------------------------------------------------         
+!     IF(ABS((RLMN-RLMO)/RLMA).LT.EPSIT)    GO TO 110                            
+!-----------------------------------------------------------------------         
+         RLMA = RLMO * WOLD+ RLMN * WNEW                                         
+!-----------------------------------------------------------------------         
+         RLMO = RLMA                                                             
+!     PRINT*,'----------------------------'                                      
+!     PRINT*,'SFCDIF OUTPUT !  ! ! ! ! ! ! ! !  !   !    !'                      
+                                                                                 
+!     PRINT*,'ZLM=',ZLM                                                          
+!     PRINT*,'Z0=',Z0                                                            
+!     PRINT*,'THZ0=',THZ0                                                        
+!     PRINT*,'THLM=',THLM                                                        
+!     PRINT*,'SFCSPD=',SFCSPD                                                    
+!     PRINT*,'CZIL=',CZIL                                                        
+!     PRINT*,'AKMS=',AKMS                                                        
+!     PRINT*,'AKHS=',AKHS                                                        
+!     PRINT*,'----------------------------'                                      
+                                                                                 
+      END DO                                                                     
+! ----------------------------------------------------------------------         
+  END SUBROUTINE SFCDIF_off
+! ----------------------------------------------------------------------         
+
+END MODULE module_sf_noahlsm
Index: trunk/WRF.COMMON/WRFV2/phys/module_sf_ruclsm.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_sf_ruclsm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_sf_ruclsm.F	(revision 2744)
@@ -0,0 +1,4371 @@
+#define LSMRUC_DBG_LVL 3000
+!WRF:MODEL_LAYER:PHYSICS
+!
+MODULE module_sf_ruclsm
+   USE module_wrf_error
+
+CONTAINS
+
+!-----------------------------------------------------------------
+    SUBROUTINE LSMRUC(                                           &
+                   DT,KTAU,NSL,ZS,                               &
+                   RAINBL,SNOW,SNOWH,SNOWC,FRZFRAC,frpcpn,       &
+                   Z3D,P8W,T3D,QV3D,QC3D,RHO3D,                  & !p8W in [PA]
+                   GLW,GSW,EMISS,CHKLOWQ,                        & 
+                   FLQC,FLHC,MAVAIL,CANWAT,VEGFRA,ALB,ZNT,       &
+                   QSFC,QSG,QVG,QCG,SOILT1,TSNAV,                &
+                   TBOT,IVGTYP,ISLTYP,XLAND,XICE,                &
+                   CP,G0,LV,STBOLT,                              &
+                   SOILMOIS,SMAVAIL,SMMAX,                       &
+                   TSO,SOILT,HFX,QFX,LH,                         &
+                   SFCRUNOFF,UDRUNOFF,SFCEXC,                    &
+                   SFCEVP,GRDFLX,ACSNOW,                         &
+                   SMFR3D,KEEPFR3DFLAG,                          &
+                   myj,                                          &
+                   ids,ide, jds,jde, kds,kde,                    &
+                   ims,ime, jms,jme, kms,kme,                    &
+                   its,ite, jts,jte, kts,kte                     )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+!
+!-- DT            time step (second)
+!        ktau - number of time step
+!        NSL  - number of soil layers
+!        NZS  - number of levels in soil
+!        ZS   - depth of soil levels (m)
+!-- RAINBL    - accumulated rain in [mm] between the PBL calls
+!-- RAINNCV         one time step grid scale precipitation (mm/step)
+!        SNOW - snow water equivalent [mm]
+!        FRAZFRAC - fraction of frozen precipitation
+!-- SNOWC       flag indicating snow coverage (1 for snow cover)
+!-- Z3D         heights (m)
+!-- P8W         3D pressure (Pa)
+!-- T3D         temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!        QC3D - 3D cloud water mixing ratio (Kg/Kg)
+!       RHO3D - 3D air density (kg/m^3)
+!-- GLW         downward long wave flux at ground surface (W/m^2)
+!-- GSW         absorbed short wave flux at ground surface (W/m^2)
+!-- EMISS       surface emissivity (between 0 and 1)
+!        FLQC - surface exchange coefficient for moisture (kg/m^2/s)
+!        FLHC - surface exchange coefficient for heat [W/m^2/s/degreeK]     
+!      SFCEXC - surface exchange coefficient for heat [m/s]
+!      CANWAT - CANOPY MOISTURE CONTENT (mm)
+!      VEGFRA - vegetation fraction (between 0 and 1)
+!         ALB - surface albedo (between 0 and 1)
+!         ZNT - roughness length [m]
+!-- TBOT        soil temperature at lower boundary (K)
+!      IVGTYP - USGS vegetation type (24 classes)
+!      ISLTYP - STASGO soil type (16 classes)
+!-- XLAND       land mask (1 for land, 2 for water)
+!-- CP          heat capacity at constant pressure for dry air (J/kg/K)
+!-- G0          acceleration due to gravity (m/s^2)
+!-- LV          latent heat of melting (J/kg)
+!-- STBOLT      Stefan-Boltzmann constant (W/m^2/K^4)
+!    SOILMOIS - soil moisture content (volumetric fraction)
+!         TSO - soil temp (K)
+!-- SOILT       surface temperature (K)
+!-- HFX         upward heat flux at the surface (W/m^2)
+!-- QFX         upward moisture flux at the surface (kg/m^2/s)
+!-- LH          upward latent heat flux (W/m^2)
+!   SFCRUNOFF - ground surface runoff [mm]
+!    UDRUNOFF - underground runoff
+!      SFCEVP - total evaporation in [kg/m^2]
+!      GRDFLX - soil heat flux (W/m^2: negative, if downward from surface)
+!      ACSNOW - accumulation of snow water [m]   
+!-- CHKLOWQ - is either 0 or 1 (so far set equal to 1).
+!--           used only in MYJPBL. 
+!-- ims           start index for i in memory
+!-- ime           end index for i in memory
+!-- jms           start index for j in memory
+!-- jme           end index for j in memory
+!-- kms           start index for k in memory
+!-- kme           end index for k in memory
+!-------------------------------------------------------------------------
+!   INTEGER,     PARAMETER            ::     nzss=5
+!   INTEGER,     PARAMETER            ::     nddzs=2*(nzss-2)
+
+   INTEGER,     PARAMETER            ::     nvegclas=24
+
+   REAL,       INTENT(IN   )    ::     DT
+   LOGICAL,    INTENT(IN   )    ::     myj,frpcpn
+   INTEGER,    INTENT(IN   )    ::     ktau, nsl,                 &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       ids,ide, jds,jde, kds,kde, &
+                                       its,ite, jts,jte, kts,kte
+
+   REAL,    DIMENSION( ims:ime, kms:kme, jms:jme )            , &
+            INTENT(IN   )    ::                           QV3D, &
+                                                          QC3D, &
+                                                           p8w, &
+                                                         rho3D, &
+                                                           T3D, &
+                                                           z3D
+
+   REAL,       DIMENSION( ims:ime , jms:jme ),                   &
+               INTENT(IN   )    ::                       RAINBL, &
+                                                            GLW, &
+                                                            GSW, &
+                                                           FLHC, &
+                                                           FLQC, &
+                                                          EMISS, &
+!                                                         MAVAIL, &
+                                                           XICE, &
+                                                          XLAND, &
+                                                         VEGFRA, &
+                                                           TBOT
+
+   REAL,       DIMENSION( 1:nsl), INTENT(IN   )      ::      ZS
+
+   REAL,       DIMENSION( ims:ime , jms:jme ),                   &
+               INTENT(INOUT)    ::                               &
+                                                           SNOW, & !new
+                                                          SNOWH, &
+                                                          SNOWC, &
+                                                         CANWAT, & ! new
+                                                            ALB, &
+                                                         MAVAIL, & 
+                                                         SFCEXC, &
+                                                            ZNT
+
+   REAL,       DIMENSION( ims:ime , jms:jme ),                   &
+               INTENT(IN   )    ::                               &
+                                                        FRZFRAC
+
+   INTEGER,    DIMENSION( ims:ime , jms:jme ),                   &
+               INTENT(IN   )    ::                       IVGTYP, &
+                                                         ISLTYP
+
+   REAL, INTENT(IN   )          ::              CP,G0,LV,STBOLT
+ 
+   REAL,       DIMENSION( ims:ime , 1:nsl, jms:jme )           , &
+               INTENT(INOUT)    ::                 SOILMOIS,TSO
+
+   REAL,       DIMENSION( ims:ime, jms:jme )                   , &
+               INTENT(INOUT)    ::                        SOILT, &
+                                                            HFX, &
+                                                            QFX, &
+                                                             LH, &
+                                                         SFCEVP, &
+                                                      SFCRUNOFF, &
+                                                       UDRUNOFF, &
+                                                         GRDFLX, &
+                                                         ACSNOW, &
+                                                            QVG, &
+                                                            QCG, &
+                                                           QSFC, &
+                                                            QSG, &
+                                                        CHKLOWQ, &
+                                                         SOILT1, &
+                                                          TSNAV
+
+   REAL,       DIMENSION( ims:ime, jms:jme )                   , & 
+               INTENT(INOUT)    ::                      SMAVAIL, &
+                                                          SMMAX
+
+   REAL,       DIMENSION( its:ite, jts:jte )    ::          DEW, &
+                                                             PC, &
+                                                        RUNOFF1, &
+                                                        RUNOFF2, &
+                                                         EMISSL, &
+                                                           ZNTL, &
+                                                        LMAVAIL, &
+                                                          SMELT, &
+                                                           SNOH, &
+                                                          SNFLX, &
+                                                           SNOM, &
+                                                           EDIR, &
+                                                             EC, &
+                                                            ETT, &
+                                                         SUBLIM, &
+                                                          EVAPL, &
+                                                          PRCPL, &
+                                                          XICED, &
+                                                        INFILTR
+
+!--- soil/snow properties
+   REAL,       DIMENSION( ims:ime, 1:nsl, jms:jme)               &
+                                             ::    KEEPFR3DFLAG, &
+                                                         SMFR3D
+
+   REAL                                                          &
+                             ::                           RHOCS, &
+                                                          RHOSN, &
+                                                           BCLH, &
+                                                            DQM, &
+                                                           KSAT, &
+                                                           PSIS, &
+                                                           QMIN, &
+                                                          QWRTZ, &
+                                                            REF, &
+                                                           WILT, &
+                                                        CANWATR, &
+                                                          SNHEI, &
+                                                           SNWE
+
+   REAL                                      ::              CN, &
+                                                         SAT,CW, &
+                                                           C1SN, &
+                                                           C2SN, &
+                                                         KQWRTZ, &
+                                                           KICE, &
+                                                            KWT
+
+
+   REAL,     DIMENSION(1:NSL)                ::          ZSMAIN, &
+                                                         ZSHALF, &
+                                                         DTDZS2
+
+   REAL,     DIMENSION(1:2*(nsl-2))          ::           DTDZS
+
+   REAL,     DIMENSION(1:4001)               ::             TBQ
+
+
+   REAL,     DIMENSION( 1:nsl )              ::         SOILM1D, & 
+                                                          TSO1D, &
+                                                        SOILICE, &
+                                                        SOILIQW, &
+                                                       SMFRKEEP
+
+   REAL,     DIMENSION( 1:nsl )              ::          KEEPFR
+                                                
+
+   REAL                           ::                        RSM, &
+                                                      SNWEPRINT, &
+                                                     SNHEIPRINT
+
+   REAL                           ::                     PRCPMS, &
+                                                        NEWSNMS, &
+                                                           PATM, &
+                                                           TABS, &
+                                                          QVATM, &
+                                                          QCATM, &
+                                                          Q2SAT, &
+                                                         SATFLG, &
+                                                         CONFLX, &
+                                                            RHO, &
+                                                           QKMS, &
+                                                           TKMS, &
+                                                       INFILTRP
+   REAL      ::  cq,r61,r273,arp,brp,x,evs,eis
+
+   INTEGER   ::  NROOT
+   INTEGER   ::  ILAND,ISOIL
+ 
+   INTEGER, DIMENSION ( 1:nvegclas )          ::        IFOREST
+
+   INTEGER   ::  I,J,K,NZS,NZS1,NDDZS
+   INTEGER   ::  k1,l,k2,kp,km
+
+
+!-----------------------------------------------------------------
+
+         NZS=NSL
+         NDDZS=2*(nzs-2)
+
+!---- table TBQ is for resolution of balance equation in VILKA
+        CQ=173.15-.05
+        R273=1./273.15
+        R61=6.1153*0.62198
+        ARP=77455.*41.9/461.525
+        BRP=64.*41.9/461.525
+
+        DO K=1,4001
+          CQ=CQ+.05
+!          TBQ(K)=R61*EXP(ARP*(R273-1./CQ)-BRP*LOG(CQ*R273))
+        EVS=EXP(17.67*(CQ-273.15)/(CQ-29.65))
+        EIS=EXP(22.514-6.15E3/CQ)
+        if(CQ.ge.273.15) then
+! tbq is in mb
+        tbq(k) = R61*evs
+        else
+        tbq(k) = R61*eis
+        endif
+
+        END DO
+
+!--- Initialize soil/vegetation parameters
+!--- This is temporary until SI is added to mass coordinate ---!!!!!
+
+#if ( NMM_CORE == 1 )
+     if(ktau+1.eq.1) then
+#else
+     if(ktau.eq.1) then
+#endif
+     DO J=jts,jte
+         DO i=its,ite
+            do k=1,nsl
+!       smfr3d  (i,k,j)=soilmois(i,k,j)/900.*1.e3
+       keepfr3dflag(i,k,j)=0.
+            enddo
+!--- initializing of snow temp
+           soilt1(i,j)=soilt(i,j)
+           tsnav(i,j) =0.5*(soilt(i,j)+tso(i,1,j))-273.
+           qcg  (i,j) =0.
+           patm=P8w(i,kms,j)*1.e-2
+           QSG  (i,j) = QSN(SOILT(i,j),TBQ)/PATM
+           qvg  (i,j) = QSG(i,j)*mavail(i,j)
+!           qvg  (i,j) =qv3d(i,kms,j)
+           qsfc(i,j) = qsg(i,j)/(1.+qsg(i,j))
+           SMELT(i,j) = 0.
+           SNOM (i,j) = 0.
+           SNFLX(i,j) = 0.
+           DEW  (i,j) = 0.
+           PC   (i,j) = 0.
+           zntl (i,j) = 0.
+           RUNOFF1(i,j) = 0.
+           RUNOFF2(i,j) = 0.
+           emissl (i,j) = 0.
+! Temporarily!!!
+!            canwat(i,j)=0.
+
+! For RUC LSM CHKLOWQ needed for MYJPBL should 
+! 1 because is actual specific humidity at the surface, and
+! not the saturation value
+           chklowq(i,j) = 1.
+           infiltr(i,j) = 0.
+           snoh  (i,j) = 0.
+           edir  (i,j) = 0.
+           ec    (i,j) = 0.
+           ett   (i,j) = 0.
+           sublim(i,j) = 0.
+           evapl (i,j) = 0.
+           prcpl (i,j) = 0.
+         ENDDO
+     ENDDO
+
+        do k=1,nsl
+           soilice(k)=0.
+           soiliqw(k)=0.
+        enddo
+     endif
+
+!-----------------------------------------------------------------
+
+        PRCPMS = 0.
+!        NROOT  = 4
+
+
+   DO J=jts,jte
+
+      DO i=its,ite
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+      print *,' IN LSMRUC ','ims,ime,jms,jme,its,ite,jts,jte,nzs', &
+                ims,ime,jms,jme,its,ite,jts,jte,nzs
+      print *,' IVGTYP, ISLTYP ', ivgtyp(i,j),isltyp(i,j)
+      print *,' MAVAIL ', mavail(i,j)
+      print *,' SOILT,QVG,P8w',soilt(i,j),qvg(i,j),p8w(i,1,j)
+      print *, 'LSMRUC, I,J,xland, QFX,HFX from SFCLAY',i,j,xland(i,j), &
+                  qfx(i,j),hfx(i,j)
+      print *, ' GSW, GLW =',gsw(i,j),glw(i,j)
+      print *, 'SOILT, TSO start of time step =',soilt(i,j),(tso(i,k,j),k=1,nsl)
+      print *, 'SOILMOIS start of time step =',(soilmois(i,k,j),k=1,nsl)
+      print *, 'SMFROZEN start of time step =',(smfr3d(i,k,j),k=1,nsl)
+      print *, ' I,J=, after SFCLAY FLQC,FLHC ',i,j,flqc(i,j),flhc(i,j)
+      print *, 'LSMRUC, IVGTYP,ISLTYP,ZNT,ALB = ', ivgtyp(i,j),isltyp(i,j),znt(i,j),alb(i,j),i,j
+      print *, 'LSMRUC  I,J,DT,RAINBL =',I,J,dt,RAINBL(i,j)
+      print *, 'XLAND ---->, ivgtype,isoiltyp,i,j',xland(i,j),ivgtyp(i,j),isltyp(i,j),i,j
+    ENDIF
+
+
+         ILAND     = IVGTYP(i,j)
+         ISOIL     = ISLTYP(I,J)
+         TABS      = T3D(i,kms,j)
+         QVATM     = QV3D(i,kms,j)
+         QCATM     = QC3D(i,kms,j)
+         PATM      = P8w(i,kms,j)*1.e-5
+!---- what height is the first level?---- check!!!!!
+!-- need to de-stagger from w levels to P levels
+         CONFLX    = Z3D(i,kms,j)
+!         CONFLX    = 0.5*Z3D(i,kms,j)
+!         CONFLX    = 5.
+         RHO       = RHO3D(I,kms,J)
+!--- 1*e-3 is to convert from mm/s to m/s
+       IF(FRPCPN) THEN
+         PRCPMS    = (RAINBL(i,j)/DT*1.e-3)*(1-FRZFRAC(I,J))
+         NEWSNMS  = (RAINBL(i,j)/DT*1.e-3)*FRZFRAC(I,J)
+       ELSE
+          if (tabs.le.273.15) then
+         PRCPMS    = 0.
+         NEWSNMS   = RAINBL(i,j)/DT*1.e-3
+          else
+         PRCPMS    = RAINBL(i,j)/DT*1.e-3
+         NEWSNMS   = 0.
+          endif
+       ENDIF
+!--- rooting depth is 5 levels for forests
+!        if(iforest(ivgtyp(i,j)).eq.1) nroot=5
+!--- convert exchange coeff to [m/s]
+         QKMS=FLQC(I,J)/RHO/MAVAIL(I,J)
+         TKMS=FLHC(I,J)/RHO/CP
+!--- convert incoming snow and canwat from mm to m
+         SNWE=SNOW(I,J)*1.E-3
+         SNHEI=SNOWH(I,J)
+         CANWATR=CANWAT(I,J)*1.E-3
+
+!-----
+             zsmain(1)=0.
+             zshalf(1)=0.
+          do k=2,nzs
+             zsmain(k)= zs(k)
+             zshalf(k)=0.5*(zsmain(k-1) + zsmain(k))
+          enddo
+
+!-- definition of number of soil levels in the rooting zone
+     IF(iforest(ivgtyp(i,j)).ne.1) THEN
+!---- non forests
+         do k=2,nzs
+         if(zsmain(k).ge.0.4) then
+            NROOT=K
+            goto  111
+         endif
+         enddo
+
+     ELSE
+!---- forests
+         do k=2,nzs
+         if(zsmain(k).ge.1.1) then
+            NROOT=K
+            goto  111
+         endif
+         enddo
+     ENDIF
+ 111   continue
+
+!-----
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+         print *,' ZS, ZSMAIN, ZSHALF, CONFLX --->', zs,zsmain,zshalf,conflx
+         print *,'NROOT, iforest, ivgtyp, i,j ', nroot,iforest(ivgtyp(i,j)),ivgtyp(I,J),I,J
+    ENDIF
+
+!------------------------------------------------------------
+!-----  DDZS and DSDZ1 are for implicit soilution of soil eqns.
+!-------------------------------------------------------------
+        NZS1=NZS-1
+!-----
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+         print *,' DT,NZS1, ZSMAIN, ZSHALF --->', dt,nzs1,zsmain,zshalf
+    ENDIF
+
+        DO  K=2,NZS1
+          K1=2*K-3
+          K2=K1+1
+          X=DT/2./(ZSHALF(K+1)-ZSHALF(K))
+          DTDZS(K1)=X/(ZSMAIN(K)-ZSMAIN(K-1))
+          DTDZS2(K-1)=X
+          DTDZS(K2)=X/(ZSMAIN(K+1)-ZSMAIN(K))
+        END DO
+
+
+        CN=0.5     ! exponent
+        SAT=0.0005   ! canopy water saturated
+
+        CW =4.183E6
+
+
+!--- Constants used in Johansen soil thermal
+!--- conductivity method
+
+        KQWRTZ=7.7
+        KICE=2.2
+        KWT=0.57
+
+!***********************************************************************
+!--- Constants for snow density calculations C1SN and C2SN
+
+        c1sn=0.01
+        c2sn=21.
+
+!***********************************************************************
+
+        NROOT= 4
+!           ! rooting depth
+
+       if(SNOWH(i,j).gt.0.) then
+        RHOSN = SNOW(i,j)/SNOWH(i,j)
+       else
+        RHOSN = 200.
+       endif
+
+!--- initializing soil and surface properties
+     CALL SOILVEGIN  ( ILAND,ISOIL,MYJ,IFOREST,                     &
+                     EMISSL(I,J),PC(i,j),ZNT(I,J),QWRTZ,       &
+!                     EMISSL(I,J),PC(i,j),ZNTL(I,J),QWRTZ,       &
+                     RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT     )
+
+!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
+
+
+        IF((XLAND(I,J)-1.5).GE.0.)THEN
+!-- Water point
+           SMAVAIL(I,J)=1.0
+             SMMAX(I,J)=1.0
+!              SNOW(I,J)=0.0
+           LMAVAIL(I,J)=1.0
+
+           ILAND=16
+           ISOIL=14
+
+           patm=P8w(i,kms,j)*1.e-2
+           qvg  (i,j) = QSN(SOILT(i,j),TBQ)/PATM
+           qsfc(i,j) = qvg(i,j)/(1.+qvg(i,j))
+           CHKLOWQ(I,J)=1.
+           Q2SAT=QSN(TABS,TBQ)/PATM
+
+            DO K=1,NZS
+              SOILMOIS(I,K,J)=1.0
+              TSO(I,K,J)= SOILT(I,J)
+            ENDDO
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+              PRINT*,'  water point, I=',I,                      &
+              'J=',J, 'SOILT=', SOILT(i,j)
+    ENDIF
+!--- decide if this water point is ice:
+!       if(tabs.le.271.) then
+       if(xice(i,j).gt.0.5) then
+!       if(soilt(i,j).le.271.or.xice(i,j).eq.1.) then
+!       if(tabs.le.271.or.xice(i,j).eq.1.) then
+           XICED(i,j)=1.
+       else
+           XICED(i,j)=0.
+       endif
+
+         IF(XICED(I,J).NE.1.)  SNOW(I,J)=0.
+         IF(XICED(I,J).GT.0.5)THEN
+!-- Sea-ice case
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+              PRINT*,' sea-ice at water point, I=',I,            &
+              'J=',J
+    ENDIF
+            ILAND = 24
+            ISOIL = 16
+
+            SMAVAIL(I,J)=1.0
+            SMMAX(I,J)=1.0
+            LMAVAIL(I,J)=1.0
+!            SOILT(I,J) = MIN(273.15,SOILT(I,J))
+
+            DO K=1,NZS
+              SOILMOIS(I,K,J)=1.0
+              TSO(I,K,J)= MIN(273.15,SOILT(I,J))
+            ENDDO
+          ENDIF
+
+! for MYJ surface and PBL scheme
+      if (myj) then
+        IF((QVATM.GE.Q2SAT*0.95).AND.QVATM.LT.qvg(I,J))THEN
+!        IF((QVATM.GE.Q2SAT*0.95).AND.QVATM.LT.qsg(I,J))THEN
+          SATFLG=0.
+        ELSE
+          SATFLG=1.0
+        ENDIF
+      else
+          SATFLG=1.0
+      endif
+          QFX(I,J)=QFX(I,J)*SATFLG
+
+
+           ELSE
+
+!-- Land point
+!  Attention!!!!  RUC LSM uses soil moisture content minus residual (minimum
+!     soil moisture content for a given soil type) as a state variable.
+!     If the WRF model is initialized from the RUC background model, then the 
+!     soil moisture variable is consistent with the RUC LSM.
+!     If the WRF model is initialized from another background model (ETA, GFS...)
+!     then the residual value should be subtracted when the 1-d array of soil
+!     moisture is initialized before the call to SFCTMP, and after SFCTMP qmin
+!     should be added back in.
+!
+!              soilm1d (k) = min(max(0.,soilmois(i,k,j)-qmin(i,j)),dqm(i,j))
+
+
+           DO k=1,nzs
+! soilm1d - soil moisture content minus residual [m**3/m**3]
+              soilm1d (k) = min(max(0.,soilmois(i,k,j)),dqm)
+              tso1d   (k) = tso(i,k,j)
+           ENDDO 
+
+           do k=1,nzs
+              smfrkeep(k) = smfr3d(i,k,j)
+              keepfr  (k) = keepfr3dflag(i,k,j)
+           enddo
+
+!              LMAVAIL(I,J)=max(0.00001,min(1.,soilmois(i,1,j)/(REF-QMIN)))
+              LMAVAIL(I,J)=max(0.00001,min(1.,soilmois(i,1,j)/dqm))
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+   print *,'LAND, i,j,tso1d,soilm1d,PATM,TABS,QVATM,QCATM,RHO',  &
+                  i,j,tso1d,soilm1d,PATM,TABS,QVATM,QCATM,RHO
+   print *,'CONFLX =',CONFLX 
+   print *,'SMFRKEEP,KEEPFR   ',SMFRKEEP,KEEPFR
+    ENDIF
+
+!-----------------------------------------------------------------
+         CALL SFCTMP (dt,ktau,conflx,i,j,                        &
+!--- input variables
+                nzs,nddzs,nroot,                                 &
+                iland,isoil,xland(i,j),ivgtyp(i,j),              &  
+                PRCPMS,NEWSNMS,SNWE,SNHEI,RHOSN,                 &
+                PATM,TABS,QVATM,QCATM,RHO,                       &
+                GLW(I,J),GSW(I,J),EMISSL(I,J),                   &
+                QKMS,TKMS,PC(I,J),LMAVAIL(I,J),                  &
+                canwatr,vegfra(I,J),alb(I,J),znt(I,J),           &
+                myj,                                             &
+!--- soil fixed fields
+                QWRTZ,                                           &
+                rhocs,dqm,qmin,ref,                              &
+                wilt,psis,bclh,ksat,                             &
+                sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq,           &
+!--- constants
+                cp,g0,lv,stbolt,cw,c1sn,c2sn,                    &
+                KQWRTZ,KICE,KWT,                                 &
+!--- output variables
+                snweprint,snheiprint,rsm,                        &
+                soilm1d,tso1d,smfrkeep,keepfr,                   &
+                soilt(I,J),soilt1(i,j),tsnav(i,j),dew(I,J),      &
+                qvg(I,J),qsg(I,J),qcg(I,J),SMELT(I,J),           &
+                SNOH(I,J),SNFLX(I,J),SNOM(I,J),ACSNOW(I,J),      &
+                edir(I,J),ec(I,J),ett(I,J),sfcevp(I,J),          &
+                lh(I,J),hfx(I,J),grdflx(I,J),sublim(I,J),       &
+                evapl(I,J),prcpl(I,J),runoff1(I,J),              &
+                runoff2(I,J),soilice,soiliqw,infiltrp)
+!-----------------------------------------------------------------
+
+!***  DIAGNOSTICS
+!--- available and maximum soil moisture content in the soil
+!--- domain
+        smavail(i,j) = 0.
+        smmax (i,j)  = 0.  
+
+      do k=1,nzs-1
+        smavail(i,j)=smavail(i,j)+(qmin+soilm1d(k))*             &
+                    (zshalf(k+1)-zshalf(k))
+        smmax (i,j) =smmax (i,j)+(qmin+dqm)*                     &
+                    (zshalf(k+1)-zshalf(k))
+      enddo
+
+        smavail(i,j)=smavail(i,j)+(qmin+soilm1d(nzs))*           &
+                    (zsmain(nzs)-zshalf(nzs))
+        smmax (i,j) =smmax (i,j)+(qmin+dqm)*                     &
+                    (zsmain(nzs)-zshalf(nzs))
+
+!--- Convert the water unit into mm
+        SFCRUNOFF(I,J) = SFCRUNOFF(I,J)+RUNOFF1(I,J)*DT*1000.0
+        UDRUNOFF (I,J) = UDRUNOFF(I,J)+RUNOFF2(I,J)*1000.0
+        SMAVAIL  (I,J) = SMAVAIL(I,J) * 1000.
+        SMMAX    (I,J) = SMMAX(I,J) * 1000.
+        SFCEXC   (I,J) = TKMS
+! MYJSFC expects QSFC as saturation specific humidity at surface
+        QSFC(I,J) = QSG(I,J)/(1.+QSG(I,J))
+        Q2SAT=QSN(TABS,TBQ)/PATM
+! for MYJ surface and PBL scheme
+      if (myj) then
+        IF((QVATM.GE.Q2SAT*0.95).AND.QVATM.LT.qvg(I,J))THEN
+          CHKLOWQ(I,J)=0.
+        ELSE
+          CHKLOWQ(I,J)=1.
+        ENDIF
+      else
+          CHKLOWQ(I,J)=1.
+      endif
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+      if(CHKLOWQ(I,J).eq.0.) then
+   print *,'i,j,CHKLOWQ',  &
+                  i,j,CHKLOWQ(I,J)
+      endif
+    ENDIF
+
+        MAVAIL (i,j) = LMAVAIL(I,J)  
+! SNOW is in [mm], SNWE is in [m]; CANWAT is in mm, CANWATR is in m
+        SNOW   (i,j) = SNWE*1000.
+        SNOWH  (I,J) = SNHEI 
+        CANWAT (I,J) = CANWATR*1000.
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+       print *,' LAND, I=,J=, QFX, HFX after SFCTMP', i,j,lh(i,j),hfx(i,j)
+    ENDIF
+        QFX    (I,J) = LH(I,J)/LV
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+       print *,' QFX after change, LH ', i,j, QFX(i,j),LH(I,J)
+    ENDIF
+!--- SNOWC snow cover flag
+        IF(SNOWH(I,J).GT.0.02)THEN
+            SNOWC(I,J)=1.0
+        ELSE
+            SNOWC(I,J)=0.0
+        ENDIF
+
+        INFILTR(I,J) = INFILTRP
+
+!--- get 3d soil fields
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+   print *,'LAND, i,j,tso1d,soilm1d - end of time step',         &
+                  i,j,tso1d,soilm1d
+    ENDIF
+
+        do k=1,nzs
+
+             soilmois(i,k,j) = soilm1d(k)
+! If not initialized from the RUC model then add qmion back.
+!             soilmois(i,k,j) = (soilm1d(k)+qmin(i,j))
+                  tso(i,k,j) = tso1d(k)
+        enddo
+
+        do k=1,nzs
+             smfr3d(i,k,j) = smfrkeep(k) 
+           keepfr3dflag(i,k,j) = keepfr (k)
+        enddo
+
+        ENDIF
+
+      ENDDO
+
+   ENDDO
+
+!-----------------------------------------------------------------
+   END SUBROUTINE LSMRUC
+!-----------------------------------------------------------------
+
+
+
+   SUBROUTINE SFCTMP (delt,ktau,conflx,i,j,                      &
+!--- input variables
+                nzs,nddzs,nroot,                                 &
+                ILAND,ISOIL,XLAND,IVGTYP,                        &
+                PRCPMS,NEWSNMS,SNWE,SNHEI,RHOSN,                 &
+                PATM,TABS,QVATM,QCATM,rho,                       &
+                GLW,GSW,EMISS,QKMS,TKMS,PC,                      &
+                MAVAIL,CST,VEGFRA,ALB,ZNT,                       &
+                MYJ,                                             &
+!--- soil fixed fields
+                QWRTZ,rhocs,dqm,qmin,ref,wilt,psis,bclh,ksat,    &
+                sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq,           &
+!--- constants
+                cp,g0,lv,stbolt,cw,c1sn,c2sn,                    &
+                KQWRTZ,KICE,KWT,                                 &
+!--- output variables
+                snweprint,snheiprint,rsm,                        &
+                soilm1d,ts1d,smfrkeep,keepfr,soilt,soilt1,       &
+                tsnav,dew,qvg,qsg,qcg,                           &
+                SMELT,SNOH,SNFLX,SNOM,ACSNOW,                    &
+                edir1,ec1,ett1,eeta,qfx,hfx,s,sublim,            &
+                evapl,prcpl,runoff1,runoff2,soilice,             &
+                soiliqw,infiltr)
+!-----------------------------------------------------------------
+       IMPLICIT NONE
+!-----------------------------------------------------------------
+
+!--- input variables
+
+   INTEGER,  INTENT(IN   )   ::  i,j,nroot,ktau,nzs            , &
+                                 nddzs                             !nddzs=2*(nzs-2)
+
+   REAL,     INTENT(IN   )   ::  DELT,CONFLX
+   REAL,     INTENT(IN   )   ::  C1SN,C2SN
+   LOGICAL,    INTENT(IN   )    ::     myj
+!--- 3-D Atmospheric variables
+   REAL                                                        , &
+            INTENT(IN   )    ::                            PATM, &
+                                                           TABS, &
+                                                          QVATM, &
+                                                          QCATM
+   REAL                                                        , &
+            INTENT(IN   )    ::                             GLW, &
+                                                            GSW, &
+                                                             PC, &
+                                                         VEGFRA, &
+                                                          XLAND, &
+                                                            RHO, &
+                                                           QKMS, &
+                                                           TKMS
+                                                             
+   INTEGER,   INTENT(IN   )  ::                          IVGTYP
+!--- 2-D variables
+   REAL                                                        , &
+            INTENT(INOUT)    ::                           EMISS, &
+                                                         MAVAIL, &
+                                                            ALB, &
+                                                            CST
+
+!--- soil properties
+   REAL                      ::                                  &
+                                                          RHOCS, &
+                                                           BCLH, &
+                                                            DQM, &
+                                                           KSAT, &
+                                                           PSIS, &
+                                                           QMIN, &
+                                                          QWRTZ, &
+                                                            REF, &
+                                                            SAT, &
+                                                           WILT
+
+   REAL,     INTENT(IN   )   ::                              CN, &
+                                                             CW, &
+                                                             CP, &
+                                                             G0, &
+                                                             LV, &
+                                                         STBOLT, &
+                                                         KQWRTZ, &
+                                                           KICE, &
+                                                            KWT
+
+   REAL,     DIMENSION(1:NZS), INTENT(IN)  ::            ZSMAIN, &
+                                                         ZSHALF, &
+                                                         DTDZS2 
+
+   REAL,     DIMENSION(1:NDDZS), INTENT(IN)  ::           DTDZS
+
+   REAL,     DIMENSION(1:4001), INTENT(IN)  ::              TBQ
+
+
+!--- input/output variables
+!-------- 3-d soil moisture and temperature
+   REAL,     DIMENSION( 1:nzs )                                , &
+             INTENT(INOUT)   ::                            TS1D, & 
+                                                        SOILM1D, &
+                                                       SMFRKEEP
+   REAL,  DIMENSION( 1:nzs )                                   , &
+             INTENT(INOUT)   ::                          KEEPFR
+          
+
+   INTEGER, INTENT(INOUT)    ::                     ILAND,ISOIL
+
+!-------- 2-d variables
+   REAL                                                        , &
+             INTENT(INOUT)   ::                             DEW, &
+                                                          EDIR1, &
+                                                            EC1, &
+                                                           ETT1, &
+                                                           EETA, &
+                                                          EVAPL, &
+                                                        INFILTR, &
+                                                          RHOSN, & 
+                                                         SUBLIM, &
+                                                          PRCPL, &
+                                                            QVG, &
+                                                            QSG, &
+                                                            QCG, &
+                                                            QFX, &
+                                                            HFX, &
+                                                              S, &  
+                                                        RUNOFF1, &
+                                                        RUNOFF2, &
+                                                         ACSNOW, &
+                                                           SNWE, &
+                                                          SNHEI, &
+                                                          SMELT, &
+                                                           SNOM, &
+                                                           SNOH, &
+                                                          SNFLX, &
+                                                          SOILT, &
+                                                         SOILT1, &
+                                                          TSNAV, &
+                                                            ZNT
+
+!-------- 1-d variables
+   REAL,     DIMENSION(1:NZS), INTENT(OUT)  ::          SOILICE, &
+                                                        SOILIQW
+
+   REAL,     INTENT(OUT)                    ::              RSM, &  
+                                                      SNWEPRINT, &
+                                                     SNHEIPRINT
+!--- Local variables
+
+   INTEGER ::  K,ILNB
+
+   REAL    ::  BSN, XSN, RHONEWSN                              , &
+               RAINF, SNTH, NEWSN, PRCPMS, NEWSNMS             , &
+               T3, UPFLUX, XINET
+   REAL    ::  alb_snow,alb_snow_free,snhei_crit               , &
+               keep_snow_albedo
+
+   REAL    ::  RNET,GSWNEW,EMISSN,ALBSN,ZNTSN
+   REAL    ::  VEGFRAC
+
+!-----------------------------------------------------------------
+        integer,   parameter      ::      ilsnow=99 
+        
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+        print *,' in SFCTMP',i,j,nzs,nddzs,nroot,                 &
+                 SNWE,RHOSN,SNOM,SMELT,TS1D
+    ENDIF
+!       print *,' in SFCTMP',i,j,nzs,nddzs,nroot,                 &
+!                IVGTYP,ISOIL,ILAND,                              &
+!                PRCPMS,SNWE,RHOSN,                               &
+!                PATM,TABS,QVATM,QCATM,rho
+!                GLW,GSW,EMISS,QKMS,TKMS,PC,                      &
+!                cst,vegfrac,alb,znt,                             &
+!--- soil fixed fields
+!                QWRTZ,rhocs,dqm,qmin,ref,wilt,psis,bclh,ksat,    &
+!                sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq,           &
+!--- constants
+!                cp,g0,lv,stbolt,cw,c1sn,c2sn,                    & 
+!                KQWRTZ,KICE,KWT                            
+
+        NEWSN=0.
+        RAINF = 0.
+        RSM=0.
+        INFILTR=0.
+        VEGFRAC=0.01*VEGFRA
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+        print *,'I,J,KTAU,QKMS,TKMS', i,j,ktau,qkms,tkms
+        print *,'GSW, GLW, SOILT, STBOLT, EMISS',           &
+                 GSW, GLW, SOILT, STBOLT, EMISS
+    ENDIF
+
+
+         SNHEI   = SNWE * 1000. / RHOSN
+!--------------
+         T3      = STBOLT*SOILT*SOILT*SOILT
+         UPFLUX  = T3 *SOILT
+         XINET   = EMISS*(GLW-UPFLUX)
+         RNET    = GSW + XINET
+
+!Calculate the amount (m) of fresh snow
+
+	      if(snhei.gt.0.0081*1.e3/rhosn) then
+!*** Correct snow density for current temperature (Koren et al. 1999)
+        BSN=delt/3600.*c1sn*exp(0.08*tsnav-c2sn*rhosn*1.e-3)
+       if(bsn*snwe*100..lt.1.e-4) goto 777
+        XSN=rhosn*(exp(bsn*snwe*100.)-1.)/(bsn*snwe*100.)
+        rhosn=MIN(MAX(50.,XSN),400.)
+ 777   continue
+
+      else
+        rhosn     =200.
+        rhonewsn  =100.
+      endif
+
+!         IF(TABS.LE.273.15)THEN
+
+           newsn=newsnms*delt
+!--- consider for now that all  PRCPMS went into snow
+!           prcpms = 0.
+!---- ACSNOW - accumulation of snow water [m]
+           acsnow=acsnow+newsn
+
+       IF(NEWSN.GE.1.E-8) THEN
+!*** Calculate fresh snow density (t > -15C, else MIN value)
+!*** Eq. 10 from Koren et al. (1999)
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+      print *, 'THERE IS NEW SNOW, newsn', newsn
+    ENDIF
+        if(tabs.lt.258.15) then
+          rhonewsn=50.
+!          rhonewsn=100.
+
+        else
+          rhonewsn=1.e3*max((0.05+0.0017*(Tabs-273.15+15.)**1.5) &
+                                 , 0.05)
+          rhonewsn=MIN(rhonewsn,400.)
+!          rhonewsn=100.
+        endif
+
+
+!*** Define average snow density of the snow pack considering
+!*** the amount of fresh snow (eq. 9 in Koren et al.(1999) 
+!*** without snow melt )
+         xsn=(rhosn*snwe+rhonewsn*newsn)/                         &
+             (snwe+newsn)
+         rhosn=MIN(MAX(50.,XSN),400.)
+
+         snwe=snwe+newsn
+         snhei=snwe*1.E3/rhosn
+         NEWSN=NEWSN*1.E3/rhosn
+        endif
+
+!         ELSE
+!--- TABS is above freezing. Needed precip rates from microphysics
+!--- to do a better job with mixed phase precip.
+
+!        NEWSN = 0.
+!
+!         ENDIF
+
+       IF(PRCPMS.NE.0.) THEN
+
+! PRCPMS is liquid precipitation rate
+! RAINF is a flag used for calculation of rain water
+! heat content contribution into heat budget equation. Rain's temperature
+! is set equal to air temperature at the first atmospheric
+! level.  
+
+           RAINF=1.
+       ENDIF
+
+!      IF((XLAND-1.5).GE.0.)THEN
+!      IF(ILAND.EQ.16) THEN
+!         SNHEI=0.
+!         SNWE=0.
+!      ELSE
+
+        IF(SNHEI.GT.0.02) THEN
+!--- Set of surface parameters should be changed to snow values for grid
+!--- points where the snow cover exceeds snow threshold of 2 cm
+!              ALB    = 0.75
+
+!         ALB    = 0.7
+         EMISS = 0.91
+
+!         GSWNEW = GSW
+! The following lines compute albedo depending on snow
+! depth. For now commented out.
+         alb_snow_free=0.2
+         alb_snow=0.70
+         SNHEI_CRIT=0.05
+         KEEP_SNOW_ALBEDO = 0.
+      IF (NEWSN.GT.0.) KEEP_SNOW_ALBEDO = 1.
+
+!---  GSW in-coming solar
+         gswnew=gsw/(1.-alb)
+
+       ALB   = MAX(keep_snow_albedo*alb_snow,                   &
+            MIN((alb_snow_free +                                &
+           (alb_snow - alb_snow_free) *                         &
+           (snhei/SNHEI_CRIT)), alb_snow))
+!--- recompute absorbed solar radiation and net radiation
+!--- for new value of albedo
+         gswnew=gswnew*(1.-alb)
+        RNET    = GSWnew + XINET
+
+         CALL SNOWSOIL (                                        & !--- input variables
+            i,j,isoil,delt,ktau,conflx,nzs,nddzs,nroot,         &
+            ILAND,PRCPMS,RAINF,NEWSN,snhei,SNWE,                &
+            RHOSN,PATM,QVATM,QCATM,                             &
+            GLW,GSWnew,EMISS,RNET,IVGTYP,                       &
+            QKMS,TKMS,PC,CST,                                   &
+            RHO,VEGFRAC,ALB,ZNT,                                &
+            MYJ,                                                &
+!--- soil fixed fields
+            QWRTZ,rhocs,dqm,qmin,ref,wilt,psis,bclh,ksat,       &
+            sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq,              & 
+!--- constants
+            lv,CP,G0,cw,stbolt,tabs,                            &
+            KQWRTZ,KICE,KWT,                                    &
+!--- output variables
+            ilnb,snweprint,snheiprint,rsm,                      &
+            soilm1d,ts1d,smfrkeep,keepfr,                       &
+            dew,soilt,soilt1,tsnav,qvg,qsg,qcg,                 &
+            SMELT,SNOH,SNFLX,SNOM,edir1,ec1,ett1,eeta,          &
+            qfx,hfx,s,sublim,prcpl,runoff1,runoff2,             &
+            mavail,soilice,soiliqw,infiltr                      )
+
+         if(snhei.le.2.e-2) then
+!--- all snow is melted
+!           gswnew=gswnew/(1.-alb)
+           alb=alb_snow_free
+!           gswnew=gswnew*(1.-alb)
+         endif
+
+        ELSE
+
+           snheiprint=0.
+           snweprint=0.
+
+         CALL SOIL(                                             &
+!--- input variables
+            i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot,   &
+            PRCPMS,RAINF,PATM,QVATM,QCATM,GLW,GSW,              &
+            EMISS,RNET,QKMS,TKMS,PC,cst,rho,vegfrac,            &
+!--- soil fixed fields 
+            QWRTZ,rhocs,dqm,qmin,ref,wilt,                      &
+            psis,bclh,ksat,sat,cn,                              &
+            zsmain,zshalf,DTDZS,DTDZS2,tbq,                     &
+!--- constants
+            lv,CP,G0,cw,stbolt,tabs,                            &
+            KQWRTZ,KICE,KWT,                                    &
+!--- output variables
+            soilm1d,ts1d,smfrkeep,keepfr,                       &
+            dew,soilt,qvg,qsg,qcg,edir1,ec1,                    &
+            ett1,eeta,qfx,hfx,s,evapl,prcpl,runoff1,            &
+            runoff2,mavail,soilice,soiliqw,                     &
+            infiltr)
+
+        ENDIF
+!      ENDIF
+
+!
+
+!      RETURN
+!       END
+!---------------------------------------------------------------
+   END SUBROUTINE SFCTMP
+!---------------------------------------------------------------
+
+
+       FUNCTION QSN(TN,T)
+!****************************************************************
+   REAL,     DIMENSION(1:4001),  INTENT(IN   )   ::  T
+   REAL,     INTENT(IN  )   ::  TN
+
+      REAL    QSN, R,R1,R2
+      INTEGER I
+
+       R=(TN-173.15)/.05+1.
+       I=INT(R)
+       IF(I.GE.1) goto 10
+       I=1
+       R=1.
+  10   IF(I.LE.4000) GOTO 20
+       I=4000
+       R=4001.
+  20   R1=T(I)
+       R2=R-I
+       QSN=(T(I+1)-R1)*R2 + R1
+!       print *,' in QSN, I,R,R1,R2,T(I+1),TN, QSN', I,R,r1,r2,t(i+1),tn,QSN
+!       RETURN
+!       END
+!-----------------------------------------------------------------------
+  END FUNCTION QSN
+!------------------------------------------------------------------------
+
+
+        SUBROUTINE SOIL (                                    &
+!--- input variables
+            i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot,&
+            PRCPMS,RAINF,PATM,QVATM,QCATM,                   &
+            GLW,GSW,EMISS,RNET,                              &
+            QKMS,TKMS,PC,cst,rho,vegfrac,                    &
+!--- soil fixed fields
+            QWRTZ,rhocs,dqm,qmin,ref,wilt,psis,bclh,ksat,    &
+            sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq,           &
+!--- constants
+            xlv,CP,G0_P,cw,stbolt,TABS,                      &
+            KQWRTZ,KICE,KWT,                                 &
+!--- output variables
+            soilmois,tso,smfrkeep,keepfr,                    &
+            dew,soilt,qvg,qsg,qcg,                           &
+            edir1,ec1,ett1,eeta,qfx,hfx,s,evapl,             &
+            prcpl,runoff1,runoff2,mavail,soilice,            &
+            soiliqw,infiltrp)
+
+!*************************************************************
+!   Energy and moisture budget for vegetated surfaces 
+!   without snow, heat diffusion amf Richards eqns. in
+!   soil
+!
+!     DELT - time step
+!     ktau - numver of time step
+!     CONFLX - depth of constant flux layer (m)
+!     J,I - the location of grid point
+!     IME, JME, KME, NZS - dimensions of the domain
+!     NROOT - number of levels within the root zone
+!     PRCPMS - precipitation rate in m/s
+!     PATM - pressure [bar]
+!     QVATM,QCATM - cloud and water vapor mixing ratio
+!                   at the first atm. level
+!     GLW, GSW - incoming longwave and absorbed shortwave
+!                radiation at the surface 
+!     EMISS,RNET - emissivity of the ground surface and net
+!                  radiation at the surface
+!     QKMS - exchange coefficient for water vapor in the
+!              surface layer (m/s)
+!     TKMS - exchange coefficient for heat in the surface
+!              layer (m/s)
+!     PC - plant coefficient (resistance)
+!     RHO - density of atmosphere near sueface
+!     VEGFRAC - greeness fraction
+!     RHOCS - volumetric heat capacity of dry soil
+!     DQM, QMIN - porosity minus residual soil moisture QMIN
+!     REF, WILT - field capacity soil moisture and the 
+!                 wilting point
+!     PSIS - matrix potential at saturation
+!     BCLH - exponent for Clapp-Hornberger parameterization
+!     KSAT - saturated hydraulic conductivity
+!     SAT - maximum value of water intercepted by canopy
+!     CN - exponent for calculation of canopy water
+!     ZSMAIN - main levels in soil
+!     ZSHALF - middle of the soil layers
+!     DTDZS,DTDZS2 - dt/(2.*dzshalf*dzmain) and dt/dzshalf in soil
+!     TBQ - table to define saturated mixing ration
+!           of water vapor for given temperature and pressure
+!     SOILMOIS,TSO - soil moisture and temperature
+!     DEW -  dew in kg/m^2s
+!     SOILT - skin temperature
+!     QSG,QVG,QCG - saturated mixing ratio, mixing ratio of
+!                   water vapor and cloud at the ground
+!                   surface, respectively
+!     EDIR1, EC1, ETT1, EETA - direct evaporation, evaporation of
+!            canopy water, transpiration in kg m-2 s-1 and total
+!            evaporation in m s-1.
+!     QFX, HFX - latent and sensible heat fluxes
+!     S - soil heat flux in the top layer 
+!     RUNOFF - surface runoff (m/s)
+!     RUNOFF2 - underground runoff (m)
+!     MAVAIL - moisture availability in the top soil layer
+!     INFILTRP - infiltration flux from the top of soil domain
+!
+!*****************************************************************
+        IMPLICIT NONE
+!-----------------------------------------------------------------
+
+!--- input variables
+
+   INTEGER,  INTENT(IN   )   ::  nroot,ktau,nzs                , &
+                                 nddzs                    !nddzs=2*(nzs-2)
+   INTEGER,  INTENT(IN   )   ::  i,j,iland,isoil
+   REAL,     INTENT(IN   )   ::  DELT,CONFLX
+!--- 3-D Atmospheric variables
+   REAL,                                                         &
+            INTENT(IN   )    ::                            PATM, &
+                                                          QVATM, &
+                                                          QCATM
+!--- 2-D variables
+   REAL,                                                         &
+            INTENT(IN   )    ::                             GLW, &
+                                                            GSW, &
+                                                          EMISS, &
+                                                            RHO, &
+                                                             PC, &
+                                                        VEGFRAC, &
+                                                           QKMS, &
+                                                           TKMS
+
+!--- soil properties
+   REAL,                                                         &
+            INTENT(IN   )    ::                           RHOCS, &
+                                                           BCLH, &
+                                                            DQM, &
+                                                           KSAT, &
+                                                           PSIS, &
+                                                           QMIN, &
+                                                          QWRTZ, &
+                                                            REF, &
+                                                           WILT
+
+   REAL,     INTENT(IN   )   ::                              CN, &
+                                                             CW, &
+                                                         KQWRTZ, &
+                                                           KICE, &
+                                                            KWT, &
+                                                            XLV, &
+                                                            g0_p
+
+
+   REAL,     DIMENSION(1:NZS), INTENT(IN)  ::            ZSMAIN, &
+                                                         ZSHALF, &
+                                                         DTDZS2
+
+   REAL,     DIMENSION(1:NDDZS), INTENT(IN)  ::           DTDZS
+
+   REAL,     DIMENSION(1:4001), INTENT(IN)  ::              TBQ
+
+
+!--- input/output variables
+!-------- 3-d soil moisture and temperature
+   REAL,     DIMENSION( 1:nzs )                                , &
+             INTENT(INOUT)   ::                             TSO, &
+                                                       SOILMOIS, &
+                                                       SMFRKEEP
+
+   REAL,     DIMENSION( 1:nzs )                                , &
+             INTENT(INOUT)   ::                          KEEPFR
+
+!-------- 2-d variables
+   REAL,                                                         &
+             INTENT(INOUT)   ::                             DEW, &
+                                                            CST, &
+                                                          EDIR1, &
+                                                            EC1, &
+                                                           ETT1, &
+                                                           EETA, &
+                                                          EVAPL, &
+                                                          PRCPL, &
+                                                         MAVAIL, &
+                                                            QVG, &
+                                                            QSG, &
+                                                            QCG, &
+                                                           RNET, &
+                                                            QFX, &
+                                                            HFX, &
+                                                              S, &
+                                                            SAT, &
+                                                        RUNOFF1, &
+                                                        RUNOFF2, &
+                                                          SOILT
+
+!-------- 1-d variables
+   REAL,     DIMENSION(1:NZS), INTENT(OUT)  ::          SOILICE, &
+                                                        SOILIQW
+
+!--- Local variables
+
+   REAL    ::  INFILTRP, transum                               , &
+               RAINF,  PRCPMS                                  , &
+               TABS, T3, UPFLUX, XINET
+   REAL    ::  CP,G0,LV,STBOLT,xlmelt,dzstop                   , &
+               can,epot,fac,fltot,ft,fq,hft                    , &
+               q1,ras,rhoice,sph                               , &
+               trans,zn,ci,cvw,tln,tavln,pi                    , &
+               DD1,CMC2MS,DRYCAN,WETCAN                        , &
+               INFMAX,RIW
+   REAL,     DIMENSION(1:NZS)  ::  transp,cap,diffu,hydro      , &
+                                   thdif,tranf,tav,soilmoism   , &
+                                   soilicem,soiliqwm,detal     , &
+                                   fwsat,lwsat,told,smold
+
+   REAL                        ::  drip
+
+   INTEGER ::  nzs1,nzs2,k
+
+!-----------------------------------------------------------------
+
+!-- define constants
+!        STBOLT=5.670151E-8
+        RHOICE=900.
+        CI=RHOICE*2100.
+        XLMELT=3.335E+5
+        cvw=cw
+
+        SAT=0.0004
+        prcpl=prcpms
+
+!--- Initializing local arrays
+        DO K=1,NZS
+          TRANSP   (K)=0.
+          soilmoism(k)=0.
+          soilice  (k)=0.
+          soiliqw  (k)=0.
+          soilicem (k)=0.
+          soiliqwm (k)=0.
+          lwsat    (k)=0.
+          fwsat    (k)=0.
+          tav      (k)=0.
+          cap      (k)=0.
+          thdif    (k)=0.
+          diffu    (k)=0.
+          hydro    (k)=0.   
+          tranf    (k)=0.
+          detal    (k)=0.
+          told     (k)=0.
+          smold    (k)=0.
+        ENDDO
+
+          NZS1=NZS-1
+          NZS2=NZS-2
+        dzstop=1./(zsmain(2)-zsmain(1))
+        RAS=RHO*1.E-3
+        RIW=rhoice*1.e-3
+
+!--- Computation of volumetric content of ice in soil 
+
+         DO K=1,NZS
+!- main levels
+         tln=log(tso(k)/273.15)
+         if(tln.lt.0.) then
+           soiliqw(k)=(dqm+qmin)*(XLMELT*                        &
+         (tso(k)-273.15)/tso(k)/9.81/psis)                       &
+          **(-1./bclh)-qmin
+           soiliqw(k)=max(0.,soiliqw(k))
+           soiliqw(k)=min(soiliqw(k),soilmois(k))
+           soilice(k)=(soilmois(k)-soiliqw(k))/RIW
+
+!---- melting and freezing is balanced, soil ice cannot increase
+       if(keepfr(k).eq.1.) then
+           soilice(k)=min(soilice(k),smfrkeep(k))
+           soiliqw(k)=max(0.,soilmois(k)-soilice(k)*riw)
+       endif
+
+         else
+           soilice(k)=0.
+           soiliqw(k)=soilmois(k)
+         endif
+
+          ENDDO
+
+          DO K=1,NZS1
+!- middle of soil layers
+         tav(k)=0.5*(tso(k)+tso(k+1))
+         soilmoism(k)=0.5*(soilmois(k)+soilmois(k+1))
+         tavln=log(tav(k)/273.15)
+
+         if(tavln.lt.0.) then
+           soiliqwm(k)=(dqm+qmin)*(XLMELT*                       &
+         (tav(k)-273.15)/tav(k)/9.81/psis)                       &
+          **(-1./bclh)-qmin
+           fwsat(k)=dqm-soiliqwm(k)
+           lwsat(k)=soiliqwm(k)+qmin
+           soiliqwm(k)=max(0.,soiliqwm(k))
+           soiliqwm(k)=min(soiliqwm(k), soilmoism(k))
+           soilicem(k)=(soilmoism(k)-soiliqwm(k))/riw
+!---- melting and freezing is balanced, soil ice cannot increase
+       if(keepfr(k).eq.1.) then
+           soilicem(k)=min(soilicem(k),                          &
+                   0.5*(smfrkeep(k)+smfrkeep(k+1)))
+           soiliqwm(k)=max(0.,soilmoism(k)-soilicem(k)*riw)
+           fwsat(k)=dqm-soiliqwm(k)
+           lwsat(k)=soiliqwm(k)+qmin
+       endif
+
+         else
+           soilicem(k)=0.
+           soiliqwm(k)=soilmoism(k)
+           lwsat(k)=dqm+qmin
+           fwsat(k)=0.
+         endif
+
+          ENDDO
+
+          do k=1,nzs
+           if(soilice(k).gt.0.) then
+             smfrkeep(k)=soilice(k)
+           else
+             smfrkeep(k)=soilmois(k)/riw
+           endif
+          enddo
+
+!******************************************************************
+! SOILPROP computes thermal diffusivity, and diffusional and
+!          hydraulic condeuctivities
+!******************************************************************
+          CALL SOILPROP(                                          &
+!--- input variables
+               nzs,fwsat,lwsat,tav,keepfr,                        &
+               soilmois,soiliqw,soilice,                          &
+               soilmoism,soiliqwm,soilicem,                       &
+!--- soil fixed fields
+               QWRTZ,rhocs,dqm,qmin,psis,bclh,ksat,               &
+!--- constants
+               riw,xlmelt,CP,G0_P,cvw,ci,                         &
+               kqwrtz,kice,kwt,                                   &
+!--- output variables
+               thdif,diffu,hydro,cap)
+
+!********************************************************************
+!--- CALCULATION OF CANOPY WATER (EQ.16) AND DEW 
+ 
+        DRIP=0.
+        DD1=0.
+
+        FQ=QKMS
+
+        DEW=0.
+        IF(QVATM.GE.QSG)THEN
+          DEW=FQ*(QVATM-QSG)
+        ENDIF
+        IF(DEW.NE.0.)THEN
+          DD1=CST+DELT*(PRCPMS +DEW*RAS)*vegfrac
+        ELSE
+          DD1=CST+                                                 &
+            DELT*(PRCPMS+RAS*FQ*(QVATM-QSG)                        &
+           *(CST/SAT)**CN)*vegfrac
+        ENDIF
+
+        IF(DD1.LT.0.) DD1=0.
+        if(vegfrac.eq.0.)then
+          cst=0.
+          drip=0.
+        endif
+        IF (vegfrac.GT.0.) THEN
+          CST=DD1
+        IF(CST.GT.SAT) THEN
+          CST=SAT
+          DRIP=DD1-SAT
+        ENDIF
+        ENDIF
+
+!--- WETCAN is the fraction of vegetated area covered by canopy
+!--- water, and DRYCAN is the fraction of vegetated area where
+!--- transpiration may take place.
+
+          WETCAN=(CST/SAT)**CN
+          DRYCAN=1.-WETCAN
+
+!       print *,'CST,DRIP',cst,drip
+
+!**************************************************************
+!  TRANSF computes transpiration function
+!**************************************************************
+           CALL TRANSF(                                       &
+!--- input variables
+              nzs,nroot,soiliqw,                              &
+!--- soil fixed fields
+              dqm,qmin,ref,wilt,zshalf,                       &
+!--- output variables
+              tranf,transum)
+
+
+!--- Save soil temp and moisture from the beginning of time step
+          do k=1,nzs
+           told(k)=tso(k)
+           smold(k)=soilmois(k)
+          enddo
+
+!**************************************************************
+!  SOILTEMP soilves heat budget and diffusion eqn. in soil
+!**************************************************************
+
+        CALL SOILTEMP(                                        &
+!--- input variables
+             i,j,iland,isoil,                                 &
+             delt,ktau,conflx,nzs,nddzs,nroot,                &
+             PRCPMS,RAINF,                                    &
+             PATM,TABS,QVATM,QCATM,EMISS,RNET,                &
+             QKMS,TKMS,PC,rho,vegfrac,                        &
+             thdif,cap,drycan,wetcan,                         & 
+             transum,dew,mavail,                              &
+!--- soil fixed fields
+             dqm,qmin,bclh,zsmain,zshalf,DTDZS,tbq,           &
+!--- constants
+             xlv,CP,G0_P,cvw,stbolt,                          &
+!--- output variables
+             tso,soilt,qvg,qsg,qcg)
+
+!************************************************************************
+
+!--- CALCULATION OF DEW USING NEW VALUE OF QSG OR TRANSP IF NO DEW
+        ETT1=0.
+        DEW=0.
+
+        IF(QVATM.GE.QSG)THEN
+          DEW=QKMS*(QVATM-QSG)
+          DO K=1,NZS
+            TRANSP(K)=0.
+          ENDDO
+        ELSE
+          DO K=1,NROOT
+            TRANSP(K)=VEGFRAC*RAS*QKMS*                       &
+                    (QVATM-QSG)*                              &
+                     PC*TRANF(K)*DRYCAN/ZSHALF(NROOT+1)
+               IF(TRANSP(K).GT.0.) TRANSP(K)=0.
+            ETT1=ETT1-TRANSP(K)
+          ENDDO
+          DO k=nroot+1,nzs
+            transp(k)=0.
+          enddo
+        ENDIF
+
+!-- Recalculating of volumetric content of frozen water in soil
+         DO K=1,NZS
+!- main levels
+           tln=log(tso(k)/273.15)
+         if(tln.lt.0.) then
+           soiliqw(k)=(dqm+qmin)*(XLMELT*                     &
+          (tso(k)-273.15)/tso(k)/9.81/psis)                   & 
+           **(-1./bclh)-qmin
+           soiliqw(k)=max(0.,soiliqw(k))
+           soiliqw(k)=min(soiliqw(k),soilmois(k))
+           soilice(k)=(soilmois(k)-soiliqw(k))/riw
+!---- melting and freezing is balanced, soil ice cannot increase
+       if(keepfr(k).eq.1.) then
+           soilice(k)=min(soilice(k),smfrkeep(k))
+           soiliqw(k)=max(0.,soilmois(k)-soilice(k)*riw)
+       endif
+
+         else
+           soilice(k)=0.
+           soiliqw(k)=soilmois(k)
+         endif
+         ENDDO
+
+       INFMAX=999.
+!--- The threshold when the infiltration stops is:
+!--- volumetric content of unfrozen pores  < 0.12
+       if((dqm+qmin-riw*soilicem(1)).lt.0.12)                 &
+               INFMAX=0.
+
+!*************************************************************************
+! SOILMOIST solves moisture budget (EQ.22,28) and Richards eqn.
+!*************************************************************************
+          CALL SOILMOIST (                                     &
+!-- input
+               delt,nzs,nddzs,DTDZS,DTDZS2,                    &
+               zsmain,zshalf,diffu,hydro,                      &
+               QSG,QVG,QCG,QCATM,QVATM,-PRCPMS,                &
+               QKMS,TRANSP,DRIP,DEW,0.,SOILICE,VEGFRAC,        &
+!-- soil properties
+               DQM,QMIN,REF,KSAT,RAS,INFMAX,                   &
+!-- output
+               SOILMOIS,MAVAIL,RUNOFF1,                        &
+               RUNOFF2,INFILTRP)
+        
+!--- KEEPFR is 1 when the temperature and moisture in soil
+!--- are both increasing. In this case soil ice should not
+!--- be increasing according to the freezing curve.
+!--- Some part of ice is melted, but additional water is
+!--- getting frozen. Thus, only structure of frozen soil is
+!--- changed, and phase changes are not affecting the heat
+!--- transfer. This situation may happen when it rains on the
+!--- frozen soil.
+ 
+        do k=1,nzs
+       if (soilice(k).gt.0.) then
+          if(tso(k).gt.told(k).and.soilmois(k).gt.smold(k)) then
+              keepfr(k)=1.
+          else
+              keepfr(k)=0.
+          endif
+       endif
+        enddo
+!--- THE DIAGNOSTICS OF SURFACE FLUXES 
+
+          T3      = STBOLT*SOILT*SOILT*SOILT
+          UPFLUX  = T3 *SOILT
+          XINET   = EMISS*(GLW-UPFLUX)
+          RNET    = GSW + XINET
+          HFT=-TKMS*CP*RHO*(TABS-SOILT)
+          Q1=-QKMS*RAS*(QVATM - QSG)
+          EDIR1 =-(1.-vegfrac)*QKMS*RAS*                       &
+                       (QVATM-QVG)
+        IF (Q1.LE.0.) THEN
+! ---  condensation
+          EC1=0.
+          EDIR1=0.
+          ETT1=0.
+          EETA=0.
+          QFX=- XLV*RHO*DEW
+        ELSE
+! ---  evaporation
+          EC1 = Q1 * WETCAN
+          CMC2MS=CST/DELT
+         if(EC1.gt.CMC2MS) cst=0.
+          EC1=MIN(CMC2MS,EC1)*vegfrac
+          EETA = (EDIR1 + EC1 + ETT1)*1.E3
+! to convert from kg m-2 s-1 to m s-1: 1/rho water=1.e-3************
+          QFX= XLV * EETA
+        ENDIF
+          EVAPL=QFX/XLV
+          S=THDIF(1)*CAP(1)*DZSTOP*(TSO(1)-TSO(2))
+          HFX=HFT
+          FLTOT=RNET-HFT-QFX-S
+
+ 222    CONTINUE
+
+ 1123    FORMAT(I5,8F12.3)
+ 1133    FORMAT(I7,8E12.4)
+  123   format(i6,f6.2,7f8.1)
+  122   FORMAT(1X,2I3,6F8.1,F8.3,F8.2)
+
+
+!      RETURN                                                                 
+!      END                                                                    
+!-------------------------------------------------------------------
+   END SUBROUTINE SOIL
+!-------------------------------------------------------------------
+
+
+        SUBROUTINE SNOWSOIL (                                  &
+!--- input variables
+             i,j,isoil,delt,ktau,conflx,nzs,nddzs,nroot,       &
+             ILAND,PRCPMS,RAINF,NEWSNOW,snhei,SNWE,RHOSN,      &
+             PATM,QVATM,QCATM,                                 &
+             GLW,GSW,EMISS,RNET,IVGTYP,                        &
+             QKMS,TKMS,PC,cst,rho,vegfrac,alb,znt,             & 
+             MYJ,                                              &
+!--- soil fixed fields
+             QWRTZ,rhocs,dqm,qmin,ref,wilt,psis,bclh,ksat,     &
+             sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq,            &
+!--- constants
+             xlv,CP,G0_P,cw,stbolt,TABS,                       &
+             KQWRTZ,KICE,KWT,                                  &
+!--- output variables
+             ilnb,snweprint,snheiprint,rsm,                    &
+             soilmois,tso,smfrkeep,keepfr,                     &
+             dew,soilt,soilt1,tsnav,                           &
+             qvg,qsg,qcg,SMELT,SNOH,SNFLX,SNOM,                &
+             edir1,ec1,ett1,eeta,qfx,hfx,s,sublim,             &
+             prcpl,runoff1,runoff2,mavail,soilice,             &
+             soiliqw,infiltrp                                  )
+
+!***************************************************************
+!   Energy and moisture budget for snow, heat diffusion eqns.
+!   in snow and soil, Richards eqn. for soil covered with snow
+!
+!     DELT - time step
+!     ktau - numver of time step
+!     CONFLX - depth of constant flux layer (m)
+!     J,I - the location of grid point
+!     IME, JME,  NZS - dimensions of the domain
+!     NROOT - number of levels within the root zone
+!     PRCPMS - precipitation rate in m/s
+!     NEWSNOW - pcpn in soilid form (m)
+!     SNHEI, SNWE - snow height and snow water equivalent (m)
+!     RHOSN - snow density
+!     PATM - pressure [bar]
+!     QVATM,QCATM - cloud and water vapor mixing ratio
+!                   at the first atm. level
+!     GLW, GSW - incoming longwave and absorbed shortwave
+!                radiation at the surface
+!     EMISS,RNET - emissivity of the ground surface and net
+!                  radiation at the surface
+!     QKMS - exchange coefficient for water vapor in the
+!              surface layer (m/s)
+!     TKMS - exchange coefficient for heat in the surface
+!              layer (m/s)
+!     PC - plant coefficient (resistance)
+!     RHO - density of atmosphere near sueface
+!     VEGFRAC - greeness fraction
+!     RHOCS - volumetric heat capacity of dry soil
+!     DQM, QMIN - porosity minus residual soil moisture QMIN
+!     REF, WILT - field capacity soil moisture and the
+!                 wilting point
+!     PSIS - matrix potential at saturation
+!     BCLH - exponent for Clapp-Hornberger parameterization
+!     KSAT - saturated hydraulic conductivity
+!     SAT - maximum value of water intercepted by canopy
+!     CN - exponent for calculation of canopy water
+!     ZSMAIN - main levels in soil
+!     ZSHALF - middle of the soil layers
+!     DTDZS,DTDZS2 - dt/(2.*dzshalf*dzmain) and dt/dzshalf in soil
+!     TBQ - table to define saturated mixing ration
+!           of water vapor for given temperature and pressure
+!     ilnb - number of layers in snow
+!     rsm - liquid water inside snow pack (m)
+!     SOILMOIS,TSO - soil moisture and temperature
+!     DEW -  dew in kg/m^2s
+!     SOILT - skin temperature (K)
+!     SOILT1 - snow temperature at 7.5 cm depth (K)
+!     TSNAV - average temperature of snow pack (C)
+!     QSG,QVG,QCG - saturated mixing ratio, mixing ratio of
+!                   water vapor and cloud at the ground
+!                   surface, respectively
+!     EDIR1, EC1, ETT1, EETA - direct evaporation, evaporation of
+!            canopy water, transpiration in kg m-2 s-1 and total
+!            evaporation in m s-1.
+!     QFX, HFX - latent and sensible heat fluxes
+!     S - soil heat flux in the top layer
+!     SUBLIM - snow sublimation
+!     RUNOFF1 - surface runoff (m/s)
+!     RUNOFF2 - underground runoff (m)
+!     MAVAIL - moisture availability in the top soil layer
+!     SOILICE - content of soil ice in soil layers
+!     SOILIQW - lliquid water in soil layers
+!     INFILTRP - infiltration flux from the top of soil domain
+!     XINET - net long-wave radiation
+!
+!*******************************************************************
+
+        IMPLICIT NONE
+!-------------------------------------------------------------------
+!--- input variables
+
+   INTEGER,  INTENT(IN   )   ::  nroot,ktau,nzs                , &
+                                 nddzs                         !nddzs=2*(nzs-2)
+   INTEGER,  INTENT(IN   )   ::  i,j,isoil
+
+   REAL,     INTENT(IN   )   ::  DELT,CONFLX,PRCPMS            , &
+                                 RAINF,NEWSNOW
+
+   LOGICAL,    INTENT(IN   )    ::     myj
+
+!--- 3-D Atmospheric variables
+   REAL,                                                         &
+            INTENT(IN   )    ::                            PATM, &
+                                                          QVATM, &
+                                                          QCATM
+!--- 2-D variables
+   REAL                                                        , &
+            INTENT(IN   )    ::                             GLW, &
+                                                            GSW, &
+                                                            RHO, &
+                                                             PC, &
+                                                        VEGFRAC, &
+                                                           QKMS, &
+                                                           TKMS
+
+   INTEGER,  INTENT(IN   )   ::                          IVGTYP
+!--- soil properties
+   REAL                                                        , &
+            INTENT(IN   )    ::                           RHOCS, &
+                                                           BCLH, &
+                                                            DQM, &
+                                                           KSAT, &
+                                                           PSIS, &
+                                                           QMIN, &
+                                                          QWRTZ, &
+                                                            REF, &
+                                                            SAT, &
+                                                           WILT
+
+   REAL,     INTENT(IN   )   ::                              CN, &
+                                                             CW, &
+                                                            XLV, &
+                                                           G0_P, & 
+                                                         KQWRTZ, &
+                                                           KICE, &
+                                                            KWT 
+
+
+   REAL,     DIMENSION(1:NZS), INTENT(IN)  ::            ZSMAIN, &
+                                                         ZSHALF, &
+                                                         DTDZS2
+
+   REAL,     DIMENSION(1:NDDZS), INTENT(IN)  ::           DTDZS
+
+   REAL,     DIMENSION(1:4001), INTENT(IN)  ::              TBQ
+
+
+!--- input/output variables
+!-------- 3-d soil moisture and temperature
+   REAL,     DIMENSION(  1:nzs )                               , &
+             INTENT(INOUT)   ::                             TSO, &
+                                                       SOILMOIS, &
+                                                       SMFRKEEP
+
+   REAL,  DIMENSION( 1:nzs )                                   , &
+             INTENT(INOUT)   ::                          KEEPFR
+
+
+   INTEGER,  INTENT(INOUT)    ::                           ILAND
+
+
+!-------- 2-d variables
+   REAL                                                        , &
+             INTENT(INOUT)   ::                             DEW, &
+                                                            CST, &
+                                                          EDIR1, &
+                                                            EC1, &
+                                                           ETT1, &
+                                                           EETA, &
+                                                          RHOSN, &
+                                                         SUBLIM, &
+                                                          PRCPL, &
+                                                            ALB, &
+                                                          EMISS, &
+                                                            ZNT, &
+                                                         MAVAIL, &
+                                                            QVG, &
+                                                            QSG, &
+                                                            QCG, &
+                                                            QFX, &
+                                                            HFX, &
+                                                              S, &
+                                                        RUNOFF1, &
+                                                        RUNOFF2, &
+                                                           SNWE, &
+                                                          SNHEI, &
+                                                          SMELT, &
+                                                           SNOM, &
+                                                           SNOH, &
+                                                          SNFLX, &
+                                                          SOILT, &
+                                                         SOILT1, &
+                                                          TSNAV
+
+   INTEGER, INTENT(INOUT)    ::                            ILNB
+
+!-------- 1-d variables
+   REAL,     DIMENSION(1:NZS), INTENT(OUT)  ::          SOILICE, &
+                                                        SOILIQW
+
+   REAL,     INTENT(OUT)                    ::              RSM, &
+                                                      SNWEPRINT, &
+                                                     SNHEIPRINT
+!--- Local variables
+
+
+   INTEGER ::  nzs1,nzs2,k
+
+   REAL    ::  INFILTRP, RHONEWSN,TRANSUM                      , &
+               SNTH, NEWSN                                     , &
+               TABS, T3, UPFLUX, XINET                         , &
+               BETA, SNWEPR,EPDT,PP
+   REAL    ::  CP,G0,LV,xlvm,STBOLT,xlmelt,dzstop              , &
+               can,epot,fac,fltot,ft,fq,hft                    , &
+               q1,ras,rhoice,sph                               , &
+               trans,zn,ci,cvw,tln,tavln,pi                    , &
+               DD1,CMC2MS,DRYCAN,WETCAN                        , &
+               INFMAX,RIW,DELTSN,H,UMVEG
+
+   REAL,     DIMENSION(1:NZS)  ::  transp,cap,diffu,hydro      , &
+                                   thdif,tranf,tav,soilmoism   , &
+                                   soilicem,soiliqwm,detal     , &
+                                   fwsat,lwsat,told,smold
+   REAL                                     ::             drip
+
+   REAL                                     ::             RNET
+
+!-----------------------------------------------------------------
+
+        cvw=cw
+        XLMELT=3.335E+5
+!-- the next line calculates heat of sublimation of water vapor
+        XLVm=XLV+XLMELT
+!        STBOLT=5.670151E-8
+
+!--- SNOW flag -- 99
+         ILAND=99
+
+!--- DELTSN - is the threshold for splitting the snow layer into 2 layers.
+!--- With snow density 400 kg/m^3, this threshold is equal to 7.5 cm,
+!--- equivalent to 0.03 m SNWE. For other snow densities the threshold is
+!--- computed using SNWE=0.03 m and current snow density.
+!--- SNTH - the threshold below which the snow layer is combined with
+!--- the top soil layer. SNTH is computed using snwe=0.016 m, and
+!--- equals 4 cm for snow density 400 kg/m^3.
+
+           DELTSN=0.0301*1.e3/rhosn
+           snth=0.01601*1.e3/rhosn
+
+        RHOICE=900.
+        CI=RHOICE*2100.
+        RAS=RHO*1.E-3
+        RIW=rhoice*1.e-3
+        MAVAIL=1.
+        RSM=0.
+
+        DO K=1,NZS
+          TRANSP     (K)=0.
+          soilmoism  (k)=0.
+          soiliqwm   (k)=0.
+          soilice    (k)=0.
+          soilicem   (k)=0.
+          lwsat      (k)=0.
+          fwsat      (k)=0.
+          tav        (k)=0.
+          cap        (k)=0.
+          diffu      (k)=0.
+          hydro      (k)=0.
+          thdif      (k)=0.  
+          tranf      (k)=0.
+          detal      (k)=0.
+          told       (k)=0.
+          smold      (k)=0. 
+        ENDDO
+
+        snweprint=0.
+        snheiprint=0.
+        prcpl=prcpms
+
+!*** DELTSN is the depth of the top layer of snow where
+!*** there is a temperature gradient, the rest of the snow layer
+!*** is considered to have constant temperature
+
+
+          NZS1=NZS-1
+          NZS2=NZS-2
+        DZSTOP=1./(zsmain(2)-zsmain(1))
+
+!----- THE CALCULATION OF THERMAL DIFFUSIVITY, DIFFUSIONAL AND ---
+!----- HYDRAULIC CONDUCTIVITY (SMIRNOVA ET AL. 1996? EQ.2,5,6) ---
+!tgs - the following loop is added to define the amount of frozen
+!tgs - water in soil if ther is any
+         DO K=1,NZS
+
+         tln=log(tso(k)/273.15)
+         if(tln.lt.0.) then
+           soiliqw(k)=(dqm+qmin)*(XLMELT*                          &
+         (tso(k)-273.15)/tso(k)/9.81/psis)                         &
+          **(-1./bclh)-qmin
+           soiliqw(k)=max(0.,soiliqw(k))
+           soiliqw(k)=min(soiliqw(k),soilmois(k))
+           soilice(k)=(soilmois(k)-soiliqw(k))/riw
+
+!---- melting and freezing is balanced, soil ice cannot increase
+       if(keepfr(k).eq.1.) then
+           soilice(k)=min(soilice(k),smfrkeep(k))
+           soiliqw(k)=max(0.,soilmois(k)-soilice(k)*rhoice*1.e-3)
+       endif
+
+         else
+           soilice(k)=0.
+           soiliqw(k)=soilmois(k)
+         endif
+
+          ENDDO
+
+          DO K=1,NZS1
+
+         tav(k)=0.5*(tso(k)+tso(k+1))
+         soilmoism(k)=0.5*(soilmois(k)+soilmois(k+1))
+         tavln=log(tav(k)/273.15)
+
+         if(tavln.lt.0.) then
+           soiliqwm(k)=(dqm+qmin)*(XLMELT*                         &
+         (tav(k)-273.15)/tav(k)/9.81/psis)                         &
+          **(-1./bclh)-qmin
+           fwsat(k)=dqm-soiliqwm(k)
+           lwsat(k)=soiliqwm(k)+qmin
+           soiliqwm(k)=max(0.,soiliqwm(k))
+           soiliqwm(k)=min(soiliqwm(k), soilmoism(k))
+           soilicem(k)=(soilmoism(k)-soiliqwm(k))/riw
+!---- melting and freezing is balanced, soil ice cannot increase
+       if(keepfr(k).eq.1.) then
+           soilicem(k)=min(soilicem(k),                            &
+                    0.5*(smfrkeep(k)+smfrkeep(k+1)))
+           soiliqwm(k)=max(0.,soilmoism(k)-soilicem(k)*riw)
+           fwsat(k)=dqm-soiliqwm(k)
+           lwsat(k)=soiliqwm(k)+qmin
+       endif
+
+         else
+           soilicem(k)=0.
+           soiliqwm(k)=soilmoism(k)
+           lwsat(k)=dqm+qmin
+           fwsat(k)=0.
+
+         endif
+          ENDDO
+
+          do k=1,nzs
+           if(soilice(k).gt.0.) then
+             smfrkeep(k)=soilice(k)
+           else
+             smfrkeep(k)=soilmois(k)/riw
+           endif
+          enddo
+
+
+!         print *,'etaf,etal,etamf,etaml,lwsat,fwsat',
+!     1      soilice,soiliqw,soilicem,soiliqwm,lwsat,fwsat
+
+!******************************************************************
+! SOILPROP computes thermal diffusivity, and diffusional and
+!          hydraulic condeuctivities
+!******************************************************************
+          CALL SOILPROP(                                         &
+!--- input variables
+               nzs,fwsat,lwsat,tav,keepfr,                       &
+               soilmois,soiliqw,soilice,                         &
+               soilmoism,soiliqwm,soilicem,                      &
+!--- soil fixed fields
+               QWRTZ,rhocs,dqm,qmin,psis,bclh,ksat,              & 
+!--- constants
+               riw,xlmelt,CP,G0_P,cvw,ci,                        &
+               kqwrtz,kice,kwt,                                  &
+!--- output variables
+               thdif,diffu,hydro,cap)
+
+!******************************************************************** 
+!--- CALCULATION OF CANOPY WATER (EQ.16) AND DEW 
+ 
+        DRIP=0.
+        SMELT=0.
+        DD1=0.
+        H=1.
+
+        FQ=QKMS
+
+
+!--- If vegfrac.ne.0. then part of falling snow can be
+!--- intercepted by the canopy. 
+
+        DEW=0.
+        UMVEG=1.-vegfrac
+        EPOT = -FQ*(QVATM-QSG) 
+
+      IF(vegfrac.EQ.0.) then
+           cst=0.
+           drip=0.
+      ELSE
+       IF(EPOT.GE.0.) THEN
+! Evaporation
+         DD1=CST+(NEWSNOW*RHOSN*1.E-3                            &
+              -DELT*(-PRCPMS+RAS*EPOT                            &
+              *(CST/SAT)**CN)) *vegfrac
+        ELSE
+! Sublimation
+         DEW = - EPOT
+         DD1=CST+(NEWSNOW*RHOSN*1.E-3+delt*(PRCPMS               &
+                     +DEW*RAS)) *vegfrac
+       ENDIF
+
+        IF(DD1.LT.0.) DD1=0.
+      IF (vegfrac.GT.0.) THEN
+          CST=DD1
+        IF(CST.GT.SAT) THEN
+          CST=SAT
+          DRIP=DD1-SAT
+        ENDIF
+      ENDIF
+
+
+!--- In SFCTMP NEWSNOW is added to SNHEI as if there is no vegetation
+!--- With vegetation part of NEWSNOW can be intercepted by canopy until
+!--- the saturation is reached. After the canopy saturation is reached
+!--- DRIP in the solid form will be added to SNOW cover.
+
+   SNWE=(SNHEI-vegfrac*NEWSNOW)*RHOSN*1.E-3                      &
+                  + DRIP
+
+       ENDIF
+ 
+        DRIP=0.
+        SNHEI=SNWE*1.e3/RHOSN
+          SNWEPR=SNWE
+
+!  check if all snow can evaporate during DT
+         BETA=1.
+         EPDT = EPOT * RAS *DELT*UMVEG
+         IF(SNWEPR.LE.EPDT) THEN 
+            BETA=SNWEPR/max(1.e-8,EPDT)
+            SNWE=0.
+            SNHEI=0.
+         ENDIF
+
+          WETCAN=(CST/SAT)**CN
+          DRYCAN=1.-WETCAN
+
+!**************************************************************
+!  TRANSF computes transpiration function
+!**************************************************************
+           CALL TRANSF(                                       &
+!--- input variables
+              nzs,nroot,soiliqw,                              &
+!--- soil fixed fields
+              dqm,qmin,ref,wilt,zshalf,                       & 
+!--- output variables
+              tranf,transum)
+
+!--- Save soil temp and moisture from the beginning of time step
+          do k=1,nzs
+           told(k)=tso(k)
+           smold(k)=soilmois(k)
+          enddo
+
+!**************************************************************
+! SOILTEMP soilves heat budget and diffusion eqn. in soil
+!**************************************************************
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+print *, 'TSO before calling SNOWTEMP: ', tso
+    ENDIF
+        CALL SNOWTEMP(                                        &
+!--- input variables
+             i,j,iland,isoil,                                 &
+             delt,ktau,conflx,nzs,nddzs,nroot,                &
+             snwe,snwepr,snhei,newsnow,                       &
+             beta,deltsn,snth,rhosn,                          &
+             PRCPMS,RAINF,                                    &
+             PATM,TABS,QVATM,QCATM,                           &
+             GLW,GSW,EMISS,RNET,                              &
+             QKMS,TKMS,PC,rho,vegfrac,                        &
+             thdif,cap,drycan,wetcan,cst,                     &
+             tranf,transum,dew,mavail,                        &
+!--- soil fixed fields
+             dqm,qmin,psis,bclh,                              &
+             zsmain,zshalf,DTDZS,tbq,                         &
+!--- constants
+             xlvm,CP,G0_P,cvw,stbolt,                         &
+!--- output variables
+             snweprint,snheiprint,rsm,                        &
+             tso,soilt,soilt1,tsnav,qvg,qsg,qcg,              &
+             smelt,snoh,snflx,ilnb)
+
+!************************************************************************
+!--- RECALCULATION OF DEW USING NEW VALUE OF QSG OR TRANSP IF NO DEW
+         DEW=0.
+         ETT1=0.
+         PP=PATM*1.E3
+         QSG= QSN(SOILT,TBQ)/PP
+         EPOT = -FQ*(QVATM-QSG)
+       IF(EPOT.GE.0.) THEN
+! Evaporation
+          DO K=1,NROOT
+            TRANSP(K)=vegfrac*RAS*FQ*(QVATM-QSG)              &
+                     *PC*tranf(K)*DRYCAN/zshalf(NROOT+1)
+           IF(TRANSP(K).GT.0.) TRANSP(K)=0.
+            ETT1=ETT1-TRANSP(K)
+          ENDDO
+          DO k=nroot+1,nzs
+            transp(k)=0.
+          enddo
+
+        ELSE
+! Sublimation
+          DEW=-EPOT
+          DO K=1,NZS
+            TRANSP(K)=0.
+          ENDDO
+        ETT1=0.
+        ENDIF
+
+!-- recalculating of frozen water in soil
+         DO K=1,NZS
+         tln=log(tso(k)/273.15)
+         if(tln.lt.0.) then
+           soiliqw(k)=(dqm+qmin)*(XLMELT*                    &
+         (tso(k)-273.15)/tso(k)/9.81/psis)                   &
+          **(-1./bclh)-qmin
+           soiliqw(k)=max(0.,soiliqw(k))
+           soiliqw(k)=min(soiliqw(k),soilmois(k))
+           soilice(k)=(soilmois(k)-soiliqw(k))/riw
+!---- melting and freezing is balanced, soil ice cannot increase
+       if(keepfr(k).eq.1.) then
+           soilice(k)=min(soilice(k),smfrkeep(k))
+           soiliqw(k)=max(0.,soilmois(k)-soilice(k)*riw)
+       endif
+
+         else
+           soilice(k)=0.
+           soiliqw(k)=soilmois(k)
+         endif
+         ENDDO
+
+       INFMAX=999.
+!--- The threshold when the infiltration stops is:
+!--- volumetric content of unfrozen pores  < 0.12
+        soilicem(1)=0.5*(soilice(1)+soilice(2))
+       if((dqm+qmin-riw*soilicem(1)).lt.0.12)                &
+               INFMAX=0.
+
+!*************************************************************************
+!--- TQCAN FOR SOLUTION OF MOISTURE BALANCE EQ.22,28 AND TSO,ETA PROFILES
+!*************************************************************************
+                CALL SOILMOIST (                                   &
+!-- input
+               delt,nzs,nddzs,DTDZS,DTDZS2,                        &
+               zsmain,zshalf,diffu,hydro,                          &
+               QSG,QVG,QCG,QCATM,QVATM,-PRCPMS,                    &
+               0.,TRANSP,0.,                                       &
+               0.,SMELT,soilice,vegfrac,                           &
+!-- soil properties
+               DQM,QMIN,REF,KSAT,RAS,INFMAX,                       &
+!-- output
+               soilmois,MAVAIL,RUNOFF1,                            &
+               RUNOFF2,infiltrp) 
+ 
+!-- Restore land-use parameters if snow is less than threshold
+         IF(SNHEI.LE.2.E-2)  then
+          tsnav=soilt-273.15
+          CALL SNOWFREE(ivgtyp,myj,emiss,                          & 
+                        znt,iland)
+          smelt=smelt+snwe/delt
+!          snwe=0.
+         ENDIF
+
+        SNOM=SNOM+SMELT*DELT
+
+!--- KEEPFR is 1 when the temperature and moisture in soil
+!--- are both increasing. In this case soil ice should not
+!--- be increasing according to the freezing curve.
+!--- Some part of ice is melted, but additional water is
+!--- getting frozen. Thus, only structure of frozen soil is
+!--- changed, and phase changes are not affecting the heat
+!--- transfer. This situation may happen when it rains on the
+!--- frozen soil.
+
+        do k=1,nzs
+       if (soilice(k).gt.0.) then
+          if(tso(k).gt.told(k).and.soilmois(k).gt.smold(k)) then
+              keepfr(k)=1.
+          else
+              keepfr(k)=0.
+          endif
+       endif
+        enddo
+!--- THE DIAGNOSTICS OF SURFACE FLUXES
+
+        T3      = STBOLT*SOILT*SOILT*SOILT
+        UPFLUX  = T3 *SOILT
+        XINET   = EMISS*(GLW-UPFLUX)   
+        RNET    = GSW + XINET
+        HFT=- TKMS*CP*RHO*(TABS-SOILT)
+        Q1 = - FQ*RAS* (QVATM - QSG)
+        EDIR1 = Q1*UMVEG *BETA
+
+        IF (Q1.LT.0.) THEN
+! ---  condensation
+         EC1=0.
+         EDIR1=0.
+         ETT1=0.
+         EETA=0.
+         DEW=FQ*(QVATM-QSG)
+        QFX= -XLVm*RHO*DEW
+        sublim=QFX/XLVm
+       ELSE
+! ---  evaporation
+        EC1 = Q1 * WETCAN 
+        CMC2MS=CST/DELT 
+        if(EC1.gt.CMC2MS) cst=0.
+        EC1=MIN(CMC2MS,EC1)*vegfrac
+        EETA = (EDIR1 + EC1 + ETT1)*1.E3
+! to convert from kg m-2 s-1 to m s-1: 1/rho water=1.e-3************
+        QFX= XLVm * EETA
+        sublim=(EDIR1 + EC1)*1.E3
+       ENDIF
+        s=THDIF(1)*CAP(1)*dzstop*(tso(1)-tso(2))
+        HFX=HFT
+        FLTOT=RNET-HFT-QFX-S
+
+ 222     CONTINUE
+
+ 1123    FORMAT(I5,8F12.3)
+ 1133    FORMAT(I7,8E12.4)
+  123   format(i6,f6.2,7f8.1)
+ 122    FORMAT(1X,2I3,6F8.1,F8.3,F8.2)
+
+
+!      RETURN                                                                 
+!      END                                                                    
+!-------------------------------------------------------------------
+   END SUBROUTINE SNOWSOIL
+!-------------------------------------------------------------------
+
+
+           SUBROUTINE SOILTEMP(                             &
+!--- input variables
+           i,j,iland,isoil,                                 &
+           delt,ktau,conflx,nzs,nddzs,nroot,                &
+           PRCPMS,RAINF,PATM,TABS,QVATM,QCATM,              &
+           EMISS,RNET,                                      &
+           QKMS,TKMS,PC,RHO,VEGFRAC,                        &
+           THDIF,CAP,DRYCAN,WETCAN,                         &
+           TRANSUM,DEW,MAVAIL,                              &
+!--- soil fixed fields
+           DQM,QMIN,BCLH,                                   &
+           ZSMAIN,ZSHALF,DTDZS,TBQ,                         &
+!--- constants
+           XLV,CP,G0_P,CVW,STBOLT,                          &
+!--- output variables
+           TSO,SOILT,QVG,QSG,QCG)
+
+!*************************************************************
+!   Energy budget equation and heat diffusion eqn are 
+!   solved here and
+!
+!     DELT - time step
+!     ktau - numver of time step
+!     CONFLX - depth of constant flux layer (m)
+!     IME, JME, KME, NZS - dimensions of the domain 
+!     NROOT - number of levels within the root zone
+!     PRCPMS - precipitation rate in m/s
+!     COTSO, RHTSO - coefficients for implicit solution of
+!                     heat diffusion equation
+!     THDIF - thermal diffusivity
+!     QSG,QVG,QCG - saturated mixing ratio, mixing ratio of
+!                   water vapor and cloud at the ground
+!                   surface, respectively
+!     PATM -  pressure [baa]
+!     QC3D,QV3D - cloud and water vapor mixing ratio
+!                   at the first atm. level
+!     EMISS,RNET - emissivity of the ground surface and net
+!                  radiation at the surface
+!     QKMS - exchange coefficient for water vapor in the
+!              surface layer (m/s)
+!     TKMS - exchange coefficient for heat in the surface
+!              layer (m/s)
+!     PC - plant coefficient (resistance)
+!     RHO - density of atmosphere near sueface 
+!     VEGFRAC - greeness fraction
+!     CAP - volumetric heat capacity 
+!     DRYCAN - dry fraction of vegetated area where
+!              transpiration may take place
+!     WETCAN - fraction of vegetated area covered by canopy
+!              water
+!     TRANSUM - transpiration function integrated over the 
+!               rooting zone
+!     DEW -  dew in kg/m^2s
+!     MAVAIL - fraction of maximum soil moisture in the top
+!               layer
+!     ZSMAIN - main levels in soil
+!     ZSHALF - middle of the soil layers
+!     DTDZS - dt/(2.*dzshalf*dzmain)
+!     TBQ - table to define saturated mixing ration
+!           of water vapor for given temperature and pressure
+!     TSO - soil temperature
+!     SOILT - skin temperature
+!
+!****************************************************************
+
+        IMPLICIT NONE
+!-----------------------------------------------------------------
+
+!--- input variables
+
+   INTEGER,  INTENT(IN   )   ::  nroot,ktau,nzs                , &
+                                 nddzs                         !nddzs=2*(nzs-2)
+   INTEGER,  INTENT(IN   )   ::  i,j,iland,isoil
+   REAL,     INTENT(IN   )   ::  DELT,CONFLX,PRCPMS, RAINF
+   REAL,     INTENT(INOUT)   ::  DRYCAN,WETCAN,TRANSUM
+!--- 3-D Atmospheric variables
+   REAL,                                                         &
+            INTENT(IN   )    ::                            PATM, &
+                                                          QVATM, &
+                                                          QCATM
+!--- 2-D variables
+   REAL                                                        , &
+            INTENT(IN   )    ::                                  &
+                                                          EMISS, &
+                                                            RHO, &
+                                                           RNET, &  
+                                                             PC, &
+                                                        VEGFRAC, &
+                                                            DEW, & 
+                                                           QKMS, &
+                                                           TKMS
+
+!--- soil properties
+   REAL                                                        , &
+            INTENT(IN   )    ::                                  &
+                                                           BCLH, &
+                                                            DQM, &
+                                                           QMIN
+
+   REAL,     INTENT(IN   )   ::                              CP, &
+                                                            CVW, &
+                                                            XLV, &
+                                                         STBOLT, &
+                                                           TABS, &
+                                                           G0_P
+
+
+   REAL,     DIMENSION(1:NZS), INTENT(IN)  ::            ZSMAIN, &
+                                                         ZSHALF, &
+                                                          THDIF, &
+                                                            CAP
+
+   REAL,     DIMENSION(1:NDDZS), INTENT(IN)  ::           DTDZS
+
+   REAL,     DIMENSION(1:4001), INTENT(IN)  ::              TBQ
+
+
+!--- input/output variables
+!-------- 3-d soil moisture and temperature
+   REAL,     DIMENSION( 1:nzs )                                , &
+             INTENT(INOUT)   ::                             TSO
+
+!-------- 2-d variables
+   REAL                                                        , &
+             INTENT(INOUT)   ::                                  &
+                                                         MAVAIL, &
+                                                            QVG, &
+                                                            QSG, &
+                                                            QCG, &
+                                                          SOILT
+
+
+!--- Local variables
+
+   REAL    ::  x,x1,x2,x4,dzstop,can,ft,sph                    , &
+               tn,trans,umveg,denom
+
+   REAL    ::  FKT,D1,D2,D9,D10,DID,R211,R21,R22,R6,R7,D11     , &
+               PI,H,FKQ,R210,AA,BB,PP,Q1,QS1,TS1,TQ2,TX2       , &
+               TDENOM
+
+   REAL    ::  C,CC,AA1,RHCS,H1
+
+   REAL,     DIMENSION(1:NZS)  ::                   cotso,rhtso
+
+   INTEGER ::  nzs1,nzs2,k,k1,kn,kk
+
+!-----------------------------------------------------------------
+
+
+          NZS1=NZS-1
+          NZS2=NZS-2
+        dzstop=1./(ZSMAIN(2)-ZSMAIN(1))
+
+        do k=1,nzs
+           cotso(k)=0.
+           rhtso(k)=0.
+        enddo
+!******************************************************************************
+!       COEFFICIENTS FOR THOMAS ALGORITHM FOR TSO
+!******************************************************************************
+!         did=2.*(ZSMAIN(nzs)-ZSHALF(nzs))
+!         h1=DTDZS(8)*THDIF(nzs-1)*(ZSHALF(nzs)-ZSHALF(nzs-1))/did
+!         cotso(1)=h1/(1.+h1)
+!         rhtso(1)=(tso(nzs)+h1*(tso(nzs-1)-tso(nzs)))/
+!     1         (1.+h1)
+        cotso(1)=0.
+        rhtso(1)=TSO(NZS)
+        DO 33 K=1,NZS2
+          KN=NZS-K
+          K1=2*KN-3
+          X1=DTDZS(K1)*THDIF(KN-1)
+          X2=DTDZS(K1+1)*THDIF(KN)
+          FT=TSO(KN)+X1*(TSO(KN-1)-TSO(KN))                             &
+             -X2*(TSO(KN)-TSO(KN+1))
+          DENOM=1.+X1+X2-X2*cotso(K)
+          cotso(K+1)=X1/DENOM
+          rhtso(K+1)=(FT+X2*rhtso(K))/DENOM
+   33  CONTINUE
+
+!************************************************************************
+!--- THE HEAT BALANCE EQUATION (EQ. 21,26)
+
+        RHCS=CAP(1)
+        H=MAVAIL
+        IF(DEW.NE.0.)THEN
+          DRYCAN=0.
+          WETCAN=1.
+        ENDIf
+        TRANS=PC*TRANSUM*DRYCAN/ZSHALF(NROOT+1)
+        CAN=WETCAN+TRANS
+        UMVEG=1.-VEGFRAC
+        FKT=TKMS
+        D1=cotso(NZS1)
+        D2=rhtso(NZS1)
+        TN=SOILT
+        D9=THDIF(1)*RHCS*dzstop
+        D10=TKMS*CP*RHO
+        R211=.5*CONFLX/DELT
+        R21=R211*CP*RHO
+        R22=.5/(THDIF(1)*DELT*dzstop**2)
+        R6=EMISS *STBOLT*.5*TN**4
+        R7=R6/TN
+        D11=RNET+R6
+        TDENOM=D9*(1.-D1+R22)+D10+R21+R7                              &
+              +RAINF*CVW*PRCPMS
+        FKQ=QKMS*RHO
+        R210=R211*RHO
+        C=VEGFRAC*FKQ*CAN
+        CC=C*XLV/TDENOM
+        AA=XLV*(FKQ*UMVEG+R210)/TDENOM
+        BB=(D10*TABS+R21*TN+XLV*(QVATM*                               &
+        (FKQ*UMVEG+C)                                                 & 
+        +R210*QVG)+D11+D9*(D2+R22*TN)                                 &
+        +RAINF*CVW*PRCPMS*TABS                                        &
+         )/TDENOM
+        AA1=AA+CC
+        PP=PATM*1.E3
+        AA1=AA1/PP
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+        PRINT *,' VILKA-1'
+        print *,'D10,TABS,R21,TN,QVATM,FKQ,UMVEG,VEGFRAC,CAN',        &
+                 D10,TABS,R21,TN,QVATM,FKQ,UMVEG,VEGFRAC,CAN
+        print *,'RNET, EMISS, STBOLT, SOILT',RNET, EMISS, STBOLT, SOILT
+        print *,'R210,QVG,D11,D9,D2,R22,RAINF,CVW,PRCPMS,TDENOM',     &
+                 R210,QVG,D11,D9,D2,R22,RAINF,CVW,PRCPMS,TDENOM
+        print *,'tn,aa1,bb,pp,umveg,fkq,r210,vegfrac',                &
+                 tn,aa1,bb,pp,umveg,fkq,r210,vegfrac
+    ENDIF
+        CALL VILKA(TN,AA1,BB,PP,QS1,TS1,TBQ,KTAU,i,j,iland,isoil)
+        TQ2=QVATM+QCATM
+        TX2=TQ2*(1.-H)
+        Q1=TX2+H*QS1
+        IF(Q1.LT.QS1) GOTO 100
+!--- if no saturation - goto 100
+!--- if saturation - goto 90
+   90   QVG=QS1
+        QSG=QS1
+        TSO(1)=TS1
+        QCG=Q1-QS1
+        GOTO 200
+  100   BB=BB-AA*TX2
+        AA=(AA*H+CC)/PP
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+        PRINT *,' VILKA-2'
+        print *,'D10,TABS,R21,TN,QVATM,FKQ,UMVEG,VEGFRAC,CAN',        &
+                 D10,TABS,R21,TN,QVATM,FKQ,UMVEG,VEGFRAC,CAN
+        print *,'R210,QVG,D11,D9,D2,R22,RAINF,CVW,PRCPMS,TDENOM',     &
+                 R210,QVG,D11,D9,D2,R22,RAINF,CVW,PRCPMS,TDENOM
+
+        print *,'tn,aa1,bb,pp,umveg,fkq,r210,vegfrac',                &
+                 tn,aa1,bb,pp,umveg,fkq,r210,vegfrac
+    ENDIF
+
+        CALL VILKA(TN,AA,BB,PP,QS1,TS1,TBQ,KTAU,i,j,iland,isoil)
+        Q1=TX2+H*QS1
+        IF(Q1.GT.QS1) GOTO 90
+        QSG=QS1
+        QVG=Q1
+        TSO(1)=TS1
+        QCG=0.
+  200   CONTINUE
+
+!--- SOILT - skin temperature
+          SOILT=TS1
+
+!---- Final solution for soil temperature - TSO
+          DO K=2,NZS
+            KK=NZS-K+1
+            TSO(K)=rhtso(KK)+cotso(KK)*TSO(K-1)
+          END DO
+
+!        return
+!        end
+!--------------------------------------------------------------------
+   END SUBROUTINE SOILTEMP
+!--------------------------------------------------------------------
+
+
+           SUBROUTINE SNOWTEMP(                                    & 
+!--- input variables
+           i,j,iland,isoil,                                        &
+           delt,ktau,conflx,nzs,nddzs,nroot,                       &
+           snwe,snwepr,snhei,newsnow,                              &
+           beta,deltsn,snth,rhosn,                                 &
+           PRCPMS,RAINF,                                           &
+           PATM,TABS,QVATM,QCATM,                                  &
+           GLW,GSW,EMISS,RNET,                                     &
+           QKMS,TKMS,PC,RHO,VEGFRAC,                               &
+           THDIF,CAP,DRYCAN,WETCAN,CST,                            &
+           TRANF,TRANSUM,DEW,MAVAIL,                               &
+!--- soil fixed fields
+           DQM,QMIN,PSIS,BCLH,                                     &
+           ZSMAIN,ZSHALF,DTDZS,TBQ,                                &
+!--- constants
+           XLVM,CP,G0_P,CVW,STBOLT,                                &
+!--- output variables
+           SNWEPRINT,SNHEIPRINT,RSM,                               &
+           TSO,SOILT,SOILT1,TSNAV,QVG,QSG,QCG,                     &
+           SMELT,SNOH,SNFLX,ILNB)
+
+!********************************************************************
+!   Energy budget equation and heat diffusion eqn are 
+!   solved here to obtain snow and soil temperatures
+!
+!     DELT - time step
+!     ktau - numver of time step
+!     CONFLX - depth of constant flux layer (m)
+!     IME, JME, KME, NZS - dimensions of the domain 
+!     NROOT - number of levels within the root zone
+!     PRCPMS - precipitation rate in m/s
+!     COTSO, RHTSO - coefficients for implicit solution of
+!                     heat diffusion equation
+!     THDIF - thermal diffusivity
+!     QSG,QVG,QCG - saturated mixing ratio, mixing ratio of
+!                   water vapor and cloud at the ground
+!                   surface, respectively
+!     PATM - pressure [bar]
+!     QCATM,QVATM - cloud and water vapor mixing ratio
+!                   at the first atm. level
+!     EMISS,RNET - emissivity of the ground surface and net
+!                  radiation at the surface
+!     QKMS - exchange coefficient for water vapor in the
+!              surface layer (m/s)
+!     TKMS - exchange coefficient for heat in the surface
+!              layer (m/s)
+!     PC - plant coefficient (resistance)
+!     RHO - density of atmosphere near sueface 
+!     VEGFRAC - greeness fraction
+!     CAP - volumetric heat capacity 
+!     DRYCAN - dry fraction of vegetated area where
+!              transpiration may take place
+!     WETCAN - fraction of vegetated area covered by canopy
+!              water
+!     TRANSUM - transpiration function integrated over the 
+!               rooting zone
+!     DEW -  dew in kg/m^2s
+!     MAVAIL - fraction of maximum soil moisture in the top
+!               layer
+!     ZSMAIN - main levels in soil
+!     ZSHALF - middle of the soil layers
+!     DTDZS - dt/(2.*dzshalf*dzmain)
+!     TBQ - table to define saturated mixing ration
+!           of water vapor for given temperature and pressure
+!     TSO - soil temperature
+!     SOILT - skin temperature
+!
+!*********************************************************************
+
+        IMPLICIT NONE
+!---------------------------------------------------------------------
+!--- input variables
+
+   INTEGER,  INTENT(IN   )   ::  nroot,ktau,nzs                , &
+                                 nddzs                             !nddzs=2*(nzs-2)
+
+   INTEGER,  INTENT(IN   )   ::  i,j,iland,isoil
+   REAL,     INTENT(IN   )   ::  DELT,CONFLX,PRCPMS            , &
+                                 RAINF,NEWSNOW,DELTSN,SNTH     , &
+                                 TABS,TRANSUM,SNWEPR
+
+!--- 3-D Atmospheric variables
+   REAL,                                                         &
+            INTENT(IN   )    ::                            PATM, &
+                                                          QVATM, &
+                                                          QCATM
+!--- 2-D variables
+   REAL                                                        , &
+            INTENT(IN   )    ::                             GLW, &
+                                                            GSW, &
+                                                            RHO, &
+                                                             PC, &
+                                                        VEGFRAC, &
+                                                           QKMS, &
+                                                           TKMS
+
+!--- soil properties
+   REAL                                                        , &
+            INTENT(IN   )    ::                                  &
+                                                           BCLH, &
+                                                            DQM, &
+                                                           PSIS, &
+                                                           QMIN
+
+   REAL,     INTENT(IN   )   ::                              CP, &
+                                                            CVW, &
+                                                         STBOLT, &
+                                                           XLVM, &
+                                                            G0_P
+
+
+   REAL,     DIMENSION(1:NZS), INTENT(IN)  ::            ZSMAIN, &
+                                                         ZSHALF, &
+                                                          THDIF, &
+                                                            CAP, &
+                                                          TRANF 
+
+   REAL,     DIMENSION(1:NDDZS), INTENT(IN)  ::           DTDZS
+
+   REAL,     DIMENSION(1:4001), INTENT(IN)  ::              TBQ
+
+
+!--- input/output variables
+!-------- 3-d soil moisture and temperature
+   REAL,     DIMENSION(  1:nzs )                               , &
+             INTENT(INOUT)   ::                             TSO
+
+
+!-------- 2-d variables
+   REAL                                                        , &
+             INTENT(INOUT)   ::                             DEW, &
+                                                            CST, &
+                                                          RHOSN, &
+                                                          EMISS, &
+                                                         MAVAIL, &
+                                                            QVG, &
+                                                            QSG, &
+                                                            QCG, &
+                                                           SNWE, &
+                                                          SNHEI, &
+                                                          SMELT, &
+                                                           SNOH, &
+                                                          SNFLX, &
+                                                          SOILT, &
+                                                         SOILT1, &
+                                                          TSNAV
+
+   REAL,     INTENT(INOUT)                  ::   DRYCAN, WETCAN           
+
+   REAL,     INTENT(OUT)                    ::              RSM, &
+                                                      SNWEPRINT, &
+                                                     SNHEIPRINT
+   INTEGER,  INTENT(OUT)                    ::             ilnb
+!--- Local variables
+
+
+   INTEGER ::  nzs1,nzs2,k,k1,kn,kk
+
+   REAL    ::  x,x1,x2,x4,dzstop,can,ft,sph,                     &
+               tn,trans,umveg,denom
+
+   REAL    ::  cotsn,rhtsn,xsn1,ddzsn1,x1sn1,ftsnow,denomsn
+
+   REAL    ::  t3,upflux,xinet,ras,                              &
+               xlmelt,rhocsn,thdifsn,                            &
+               beta,epot,xsn,ddzsn,x1sn,d1sn,d2sn,d9sn,r22sn
+
+   REAL    ::  fso,fsn,                                          &
+               FKT,D1,D2,D9,D10,DID,R211,R21,R22,R6,R7,D11,      &
+               PI,H,FKQ,R210,AA,BB,PP,Q1,QS1,TS1,TQ2,TX2,        &
+               TDENOM,C,CC,AA1,RHCS,H1,                          &
+               tsob, snprim, sh1, sh2,                           &
+               smeltg,snohg,snodif,soh,                          &
+               CMC2MS,TNOLD,QGOLD,SNOHGNEW                            
+
+   REAL,     DIMENSION(1:NZS)  ::  transp,cotso,rhtso
+   REAL                        ::                         edir1, &
+                                                            ec1, &
+                                                           ett1, &
+                                                           eeta, &
+                                                              s, &
+                                                            qfx, &
+                                                            hfx
+
+   REAL                        ::                          RNET
+
+!-----------------------------------------------------------------
+
+       do k=1,nzs
+          transp   (k)=0.
+          cotso    (k)=0.
+          rhtso    (k)=0.
+       enddo
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+print *, 'SNOWTEMP: SNHEI,SNTH,SOILT1: ',SNHEI,SNTH,SOILT1,soilt 
+    ENDIF
+        XLMELT=3.335E+5
+        RHOCSN=2090.* RHOSN
+        THDIFSN = 0.265/RHOCSN
+        RAS=RHO*1.E-3
+
+        SMELT=0.
+        SOH=0.
+        SMELTG=0.
+        SNOHG=0.
+        SNODIF=0.
+        RSM = 0.
+        fsn=0.
+        fso=1.
+
+          NZS1=NZS-1
+          NZS2=NZS-2
+
+        QGOLD=QVG
+        TNOLD=SOILT
+        DZSTOP=1./(ZSMAIN(2)-ZSMAIN(1))
+
+!******************************************************************************
+!       COEFFICIENTS FOR THOMAS ALGORITHM FOR TSO
+!******************************************************************************
+!         did=2.*(ZSMAIN(nzs)-ZSHALF(nzs))
+!         h1=DTDZS(8)*THDIF(nzs-1)*(ZSHALF(nzs)-ZSHALF(nzs-1))/did
+!         cotso(1)=h1/(1.+h1)
+!         rhtso(1)=(tso(nzs)+h1*(tso(nzs-1)-tso(nzs)))/
+!     1         (1.+h1)
+
+        cotso(1)=0.
+        rhtso(1)=TSO(NZS)
+        DO 33 K=1,NZS2
+          KN=NZS-K
+          K1=2*KN-3
+          X1=DTDZS(K1)*THDIF(KN-1)
+          X2=DTDZS(K1+1)*THDIF(KN)
+          FT=TSO(KN)+X1*(TSO(KN-1)-TSO(KN))                           &
+             -X2*(TSO(KN)-TSO(KN+1))
+          DENOM=1.+X1+X2-X2*cotso(K)
+          cotso(K+1)=X1/DENOM
+          rhtso(K+1)=(FT+X2*rhtso(K))/DENOM
+   33  CONTINUE
+!--- THE NZS element in COTSO and RHTSO will be for snow
+!--- There will be 2 layers in snow if it is deeper than DELTSN+SNTH
+       IF(SNHEI.GE.SNTH) then
+!        if(snhei.le.DELTSN+DELTSN) then
+        if(snhei.le.DELTSN+SNTH) then
+!-- 1-layer snow model
+         ilnb=1
+         snprim=snhei
+         soilt1=tso(1)
+         tsob=tso(1)
+         XSN = DELT/2./(zshalf(2)+0.5*SNPRIM)
+         DDZSN = XSN / SNPRIM
+         X1SN = DDZSN * thdifsn
+         X2 = DTDZS(1)*THDIF(1)
+         FT = TSO(1)+X1SN*(SOILT-TSO(1))                              &
+              -X2*(TSO(1)-TSO(2))
+         DENOM = 1. + X1SN + X2 -X2*cotso(NZS1)
+         cotso(NZS)=X1SN/DENOM
+         rhtso(NZS)=(FT+X2*rhtso(NZS1))/DENOM
+         cotsn=cotso(NZS)
+         rhtsn=rhtso(NZS)
+!*** Average temperature of snow pack (C)
+         tsnav=0.5*(soilt+tso(1))                                     &
+                     -273.15
+
+        else
+!-- 2 layers in snow, SOILT1 is temperasture at DELTSN depth
+         ilnb=2
+         snprim=deltsn
+         tsob=soilt1
+         XSN = DELT/2./(0.5*SNHEI)
+         XSN1= DELT/2./(zshalf(2)+0.5*(SNHEI-DELTSN))
+         DDZSN = XSN / DELTSN
+         DDZSN1 = XSN1 / (SNHEI-DELTSN)
+         X1SN = DDZSN * thdifsn
+         X1SN1 = DDZSN1 * thdifsn
+         X2 = DTDZS(1)*THDIF(1)
+         FT = TSO(1)+X1SN1*(SOILT1-TSO(1))                            &
+              -X2*(TSO(1)-TSO(2))
+         DENOM = 1. + X1SN1 + X2 - X2*cotso(NZS1)
+         cotso(nzs)=x1sn1/denom
+         rhtso(nzs)=(ft+x2*rhtso(nzs1))/denom
+         ftsnow = soilt1+x1sn*(soilt-soilt1)                          &
+               -x1sn1*(soilt1-tso(1))
+         denomsn = 1. + X1SN + X1SN1 - X1SN1*cotso(NZS)
+         cotsn=x1sn/denomsn
+         rhtsn=(ftsnow+X1SN1*rhtso(NZS))/denomsn
+!*** Average temperature of snow pack (C)
+         tsnav=0.5/snhei*((soilt+soilt1)*deltsn                       &
+                     +(soilt1+tso(1))*(SNHEI-DELTSN))                 &
+                     -273.15
+        endif
+       ENDIF
+
+       IF(SNHEI.LT.SNTH.AND.SNHEI.GT.0.) then
+!--- snow is too thin to be treated separately, therefore it
+!--- is combined with the first soil layer.
+         fsn=SNHEI/(SNHEI+zsmain(2))
+         fso=1.-fsn
+         soilt1=tso(1)
+         tsob=tso(2)
+         snprim=SNHEI+zsmain(2)
+         XSN = DELT/2./((zshalf(3)-zsmain(2))+0.5*snprim)
+         DDZSN = XSN /snprim
+         X1SN = DDZSN * (fsn*thdifsn+fso*thdif(1))
+         X2=DTDZS(2)*THDIF(2)
+         FT=TSO(2)+X1SN*(SOILT-TSO(2))-                              &
+                       X2*(TSO(2)-TSO(3))
+         denom = 1. + x1sn + x2 - x2*cotso(nzs-2)
+         cotso(nzs1) = x1sn/denom
+         rhtso(nzs1)=(FT+X2*rhtso(NZS-2))/denom
+         tsnav=0.5*(soilt+tso(1))                                    &
+                     -273.15
+       ENDIF
+
+!************************************************************************
+!--- THE HEAT BALANCE EQUATION (EQ. 21,26)
+
+        ETT1=0.
+        EPOT=-QKMS*(QVATM-QSG)
+        RHCS=CAP(1)
+        H=MAVAIL
+        IF(DEW.NE.0.)THEN
+          DRYCAN=0.
+          WETCAN=1.
+        ENDIF
+        TRANS=PC*TRANSUM*DRYCAN/ZSHALF(NROOT+1)
+        CAN=WETCAN+TRANS
+        UMVEG=1.-VEGFRAC
+        FKT=TKMS
+        D1=cotso(NZS1)
+        D2=rhtso(NZS1)
+        TN=SOILT
+        D9=THDIF(1)*RHCS*dzstop
+        D10=TKMS*CP*RHO
+        R211=.5*CONFLX/DELT
+        R21=R211*CP*RHO
+        R22=.5/(THDIF(1)*DELT*dzstop**2)
+        R6=EMISS *STBOLT*.5*TN**4
+        R7=R6/TN
+        D11=RNET+R6
+
+      IF(SNHEI.GE.SNTH) THEN
+!        if(snhei.le.DELTSN+DELTSN) then
+        if(snhei.le.DELTSN+SNTH) then
+!--- 1-layer snow
+          D1SN = cotso(NZS)
+          D2SN = rhtso(NZS)
+        else
+!--- 2-layer snow
+          D1SN = cotsn
+          D2SN = rhtsn
+        endif
+        D9SN= THDIFSN*RHOCSN / SNPRIM
+        R22SN = SNPRIM*SNPRIM*0.5/(THDIFSN*DELT)
+      ENDIF
+
+       IF(SNHEI.LT.SNTH.AND.SNHEI.GT.0.) then
+!--- thin snow is combined with soil
+         D1SN = D1
+         D2SN = D2
+         D9SN = (fsn*THDIFSN*RHOCSN+fso*THDIF(1)*RHCS)/              &
+                 snprim
+         R22SN = snprim*snprim*0.5                                   &
+                 /((fsn*THDIFSN+fso*THDIF(1))*delt)
+      ENDIF
+
+      IF(SNHEI.eq.0.)then
+!--- all snow is sublimated
+        D9SN = D9
+        R22SN = R22
+        D1SN = D1
+        D2SN = D2
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+        print *,' SNHEI = 0, D9SN,R22SN,D1SN,D2SN: ',D9SN,R22SN,D1SN,D2SN
+    ENDIF
+      ENDIF
+
+!---- TDENOM for snow
+
+        TDENOM = D9SN*(1.-D1SN +R22SN)+D10+R21+R7                    &
+              +RAINF*CVW*PRCPMS                                      &
+              +RHOCSN*NEWSNOW/DELT
+
+        FKQ=QKMS*RHO
+        R210=R211*RHO
+        C=VEGFRAC*FKQ*CAN
+        CC=C*XLVM/TDENOM
+        AA=XLVM*(BETA*FKQ*UMVEG+R210)/TDENOM
+        BB=(D10*TABS+R21*TN+XLVM*(QVATM*                             &
+        (BETA*FKQ*UMVEG+C)                                           &
+        +R210*QVG)+D11+D9SN*(D2SN+R22SN*TN)                          &
+        +RAINF*CVW*PRCPMS*TABS                                       &
+        + RHOCSN*NEWSNOW/DELT*TABS                                   &
+         )/TDENOM
+        AA1=AA+CC
+        PP=PATM*1.E3
+        AA1=AA1/PP
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+        print *,'VILKA-SNOW'
+        print *,'tn,aa1,bb,pp,umveg,fkq,r210,vegfrac',               &
+                 tn,aa1,bb,pp,umveg,fkq,r210,vegfrac
+    ENDIF
+
+        CALL VILKA(TN,AA1,BB,PP,QS1,TS1,TBQ,KTAU,i,j,iland,isoil)
+        TQ2=QVATM+QCATM
+        TX2=TQ2*(1.-H)
+        Q1=TX2+H*QS1
+!--- it is saturation over snow 
+   90   QVG=QS1
+        QSG=QS1
+        QCG=Q1-QS1
+
+!--- SOILT - skin temperature
+        SOILT=TS1
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+        print *,' AFTER VILKA-SNOW'
+        print *,' TS1,QS1: ', ts1,qs1
+    ENDIF
+
+! Solution for temperature at 7.5 cm depth and snow-soil interface
+       IF(SNHEI.GE.SNTH) THEN
+!        if(snhei.gt.DELTSN+DELTSN) then
+        if(snhei.gt.DELTSN+SNTH) then
+!-- 2-layer snow model
+          SOILT1=rhtsn+cotsn*SOILT
+          TSO(1)=rhtso(NZS)+cotso(NZS)*SOILT1
+          tsob=soilt1
+        else
+!-- 1 layer in snow
+          TSO(1)=rhtso(NZS)+cotso(NZS)*SOILT
+          SOILT1=TSO(1)
+          tsob=tso(1)
+        endif
+       ELSE
+!-- all snow is evaporated
+         TSO(1)=SOILT
+         SOILT1=SOILT
+         tsob=SOILT
+       ENDIF
+
+!---- Final solution for TSO
+          DO K=2,NZS
+            KK=NZS-K+1
+            TSO(K)=rhtso(KK)+cotso(KK)*TSO(K-1)
+          END DO
+!--- For thin snow layer combined with the top soil layer
+!--- TSO is computed by linear inmterpolation between SOILT
+!--- and TSO(2)
+
+       if(SNHEI.LT.SNTH.AND.SNHEI.GT.0.)then
+          tso(1)=tso(2)+(soilt-tso(2))*fso
+          SOILT1=TSO(1)
+          tsob=tso(1)
+       endif
+
+!--- IF SOILT > 273.15 F then melting of snow can happen
+   IF(SOILT.GE.273.15.AND.SNHEI.GT.0.) THEN
+         SOILT=273.15
+         QSG= QSN(273.15,TBQ)/PP
+         QVG=QSG
+        T3      = STBOLT*SOILT*SOILT*SOILT
+        UPFLUX  = T3 * SOILT
+        XINET   = EMISS*(GLW-UPFLUX)
+        RNET = GSW + XINET
+         EPOT = -QKMS*(QVATM-QSG)
+         Q1=EPOT*RAS
+
+        IF (Q1.LE.0.) THEN
+! ---  condensation
+          DEW=-EPOT
+          DO K=1,NZS
+            TRANSP(K)=0.
+          ENDDO
+
+        QFX= XLVM*RHO*DEW
+       ELSE
+! ---  evaporation
+          DO K=1,NROOT
+            TRANSP(K)=-VEGFRAC*q1                                     &
+                      *PC*TRANF(K)*DRYCAN/zshalf(NROOT+1)
+           IF(TRANSP(K).GT.0.) TRANSP(K)=0.
+            ETT1=ETT1-TRANSP(K)
+          ENDDO
+          DO k=nroot+1,nzs
+            transp(k)=0.
+          enddo
+
+        EDIR1 = Q1*UMVEG * BETA
+        EC1 = Q1 * WETCAN *VEGFRAC
+        CMC2MS=CST/DELT
+        EC1=MIN(CMC2MS,EC1)
+        EETA = (EDIR1 + EC1 + ETT1)*1.E3
+! to convert from kg m-2 s-1 to m s-1: 1/rho water=1.e-3************ 
+        QFX= - XLVM * EETA
+       ENDIF
+
+         HFX=D10*(TABS-273.15)
+
+       IF(SNHEI.GE.SNTH)then
+         SOH=thdifsn*RHOCSN*(273.15-TSOB)/SNPRIM
+       ELSE
+         SOH=(fsn*thdifsn*rhocsn+fso*thdif(1)*rhcs)*                  &
+              (273.15-TSOB)/snprim
+       ENDIF
+
+         X= (R21+D9SN*R22SN)*(273.15-TNOLD) +                         &
+            XLVM*R210*(QSG-QGOLD)
+!-- SNOH is energy flux of snow phase change
+        SNOH=AMAX1(0.,RNET+QFX                                        &
+                      +HFX                                            & 
+                  +RHOCSN*NEWSNOW/DELT*(TABS-273.15)                  &
+                  -SOH-X+RAINF*CVW*PRCPMS*                            &
+                  (TABS-273.15)) 
+!-- SMELT is speed of melting in M/S
+        SMELT= SNOH /XLMELT*1.E-3
+!        SMELT=AMIN1(SMELT,SNWEPR/DELT-BETA*EPOT*RAS)
+        SMELT=AMIN1(SMELT,SNWEPR/DELT-BETA*EPOT*RAS*UMVEG)
+
+        SNOHGNEW=SMELT*XLMELT*1.E3
+        SNODIF=AMAX1(0.,SNOH-SNOHGNEW)
+
+        SNOH=SNOHGNEW
+!       SNOHSMELT*XLMELT*1.E3
+
+!*** From Koren et al. (1999) 13% of snow melt stays in the snow pack
+        rsm=0.13*smelt*delt
+
+        SMELT=SMELT-rsm/delt
+
+!-- correction of liquid equivalent of snow depth
+!-- due to evaporation and snow melt
+        SNWE = AMAX1(0.,SNWEPR-                                      &
+!     1              (SMELT+BETA*EPOT*RAS)*DELT
+                    (SMELT+BETA*EPOT*RAS*UMVEG)*DELT                 &
+                                          )
+
+!--- If all snow melts, then 13% of snow melt we kept in the
+!--- snow pack should be added back to snow melt and infiltrate
+!--- into soil.
+        if(snwe.le.rsm) then
+           smelt=smelt+rsm/delt
+           snwe=0.
+           rsm=0.
+           SOILT=SNODIF*DELT/RHCS*ZSHALF(2)                          &  
+                   +273.15
+        else
+!*** Correct snow density on effect of snow melt, melted
+!*** from the top of the snow. 13% of melted water
+!*** remains in the pack and changes its density.
+!*** Eq. 9 (with my correction) in Koren et al. (1999)
+           
+          if(snwe.gt.snth*rhosn*1.e-3) then
+         xsn=(rhosn*(snwe-rsm)+1.e3*rsm)/                            &
+             snwe
+         rhosn=MIN(XSN,400.)
+
+        RHOCSN=2090.* RHOSN
+        thdifsn = 0.265/RHOCSN
+          endif  
+
+        endif
+
+!--- If there is no snow melting then just evaporation
+!--- or condensation cxhanges SNWE
+      ELSE
+               SNWE = AMAX1(0.,SNWEPR-                               &
+                    BETA*EPOT*RAS*UMVEG*DELT)
+
+      ENDIF
+!*** Correct snow density on effect of snow melt, melted
+!*** from the top of the snow. 13% of melted water
+!*** remains in the pack and changes its density.
+!*** Eq. 9 (with my correction) in Koren et al. (1999)
+
+        SNHEI=SNWE *1.E3 / RHOSN
+
+!--  Snow melt from the top is done. But if ground surface temperature
+!--  is above freezing snow can melt from the bottom. The following
+!--  piece of code will check if bottom melting is possible.
+
+        IF(TSO(1).GE.273.15.AND.SNHEI.GT.0.) THEN
+        SNOHG=(TSO(1)-273.15)*(RHCS*zshalf(2)+                       &
+               RHOCSN*0.5*SNHEI) / DELT
+        SNODIF=0. 
+          TSO(1)=273.15
+        SMELTG=SNOHG/XLMELT*1.E-3
+        SMELTG=AMIN1(SMELTG,SNWE/DELT)
+        SNOHGNEW=SMELTG*XLMELT*1.e3
+        SNODIF=AMAX1(0.,SNOHG-SNOHGNEW)
+        SNWE = AMAX1(0.,SNWE-SMELTG*DELT)
+         if(snwe.eq.0.)then
+        TSO(1)=SNODIF*DELT/RHCS*zshalf(2) + 273.15
+          endif
+
+        SMELT=SMELT+SMELTG
+        SNOH=SNOH+SNOHGNEW
+
+       ENDIF
+
+        SNHEI=SNWE *1.E3 / RHOSN
+
+        snweprint=snwe                                              &
+!--- if VEGFRAC.ne.0. then some snow stays on the canopy
+!--- and should be added to SNWE for water conservation
+                    +VEGFRAC*cst
+        snheiprint=snweprint*1.E3 / RHOSN
+
+    IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
+print *, 'snweprint : ',snweprint
+print *, 'D9SN,SOILT,TSOB : ', D9SN,SOILT,TSOB
+    ENDIF
+!--- Compute flux in the top snow layer
+      SNFLX=D9SN*(SOILT-TSOB)
+
+!        return
+!        end
+!------------------------------------------------------------------------
+   END SUBROUTINE SNOWTEMP
+!------------------------------------------------------------------------
+
+
+        SUBROUTINE SOILMOIST (                                  &
+!--input parameters
+              DELT,NZS,NDDZS,DTDZS,DTDZS2,                      &
+              ZSMAIN,ZSHALF,DIFFU,HYDRO,                        &
+              QSG,QVG,QCG,QCATM,QVATM,PRCP,                     &
+              QKMS,TRANSP,DRIP,                                 &
+              DEW,SMELT,SOILICE,VEGFRAC,                        &
+!--soil properties
+              DQM,QMIN,REF,KSAT,RAS,INFMAX,                     &
+!--output
+              SOILMOIS,MAVAIL,RUNOFF,RUNOFF2,INFILTRP)
+!*************************************************************************
+!   moisture balance equation and Richards eqn.
+!   are solved here 
+!   
+!     DELT - time step
+!     IME,JME,NZS - dimensions of soil domain
+!     ZSMAIN - main levels in soil
+!     ZSHALF - middle of the soil layers
+!     DTDZS -  dt/(2.*dzshalf*dzmain)
+!     DTDZS2 - dt/(2.*dzshalf)
+!     DIFFU - diffusional conductivity
+!     HYDRO - hydraulic conductivity
+!     QSG,QVG,QCG - saturated mixing ratio, mixing ratio of
+!                   water vapor and cloud at the ground
+!                   surface, respectively
+!     QCATM,QVATM - cloud and water vapor mixing ratio
+!                   at the first atm. level
+!     PRCP - precipitation rate in m/s
+!     QKMS - exchange coefficient for water vapor in the
+!              surface layer (m/s)
+!     TRANSP - transpiration from the soil layers
+!     DRIP - liquid water dripping from the canopy to soil
+!     DEW -  dew in kg/m^2s
+!     SMELT - melting rate in m/s
+!     SOILICE - volumetric content of ice in soil
+!     VEGFRAC - greeness fraction
+!     RAS - ration of air density to soil density
+!     INFMAX - maximum infiltration rate
+!    
+!     SOILMOIS - volumetric soil moisture, 6 levels
+!     MAVAIL - fraction of maximum soil moisture in the top
+!               layer
+!     RUNOFF - surface runoff (m/s)
+!     RUNOFF2 - underground runoff (m)
+!     INFILTRP - point infiltration flux into soil (m/s)
+!            /(snow bottom runoff) (mm/s)
+!
+!     COSMC, RHSMC - coefficients for implicit solution of
+!                     Richards equation
+!******************************************************************
+        IMPLICIT NONE
+!------------------------------------------------------------------
+!--- input variables
+   REAL,     INTENT(IN   )   ::  DELT
+   INTEGER,  INTENT(IN   )   ::  NZS,NDDZS
+
+! input variables
+
+   REAL,     DIMENSION(1:NZS), INTENT(IN   )  ::         ZSMAIN, &
+                                                         ZSHALF, &
+                                                          DIFFU, &
+                                                          HYDRO, &
+                                                         TRANSP, &
+                                                        SOILICE, &
+                                                         DTDZS2
+
+   REAL,     DIMENSION(1:NDDZS), INTENT(IN)  ::           DTDZS
+
+   REAL,     INTENT(IN   )   ::    QSG,QVG,QCG,QCATM,QVATM     , &
+                                   QKMS,VEGFRAC,DRIP,PRCP      , &
+                                   DEW,SMELT                   , &
+                                   DQM,QMIN,REF,KSAT,RAS
+                         
+! output
+
+   REAL,     DIMENSION(  1:nzs )                               , &
+
+             INTENT(INOUT)   ::                        SOILMOIS     
+                                                  
+   REAL,     INTENT(INOUT)   ::  MAVAIL,RUNOFF,RUNOFF2,INFILTRP, &
+                                                        INFMAX
+
+! local variables
+
+   REAL,     DIMENSION( 1:nzs )  ::  COSMC,RHSMC
+
+   REAL    ::  DZS,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10
+   REAL    ::  REFKDT,REFDK,DELT1,F1MAX,F2MAX
+   REAL    ::  F1,F2,FD,KDT,VAL,DDT,PX
+   REAL    ::  QQ,UMVEG,INFMAX1,TRANS
+   REAL    ::  TOTLIQ,FLX,FLXSAT,QTOT
+   REAL    ::  DID,X1,X2,X4,DENOM,Q2,Q4
+   REAL    ::  dice,fcr,acrt,frzx,sum,cvfrz
+
+   INTEGER ::  NZS1,NZS2,K,KK,K1,KN,ialp1,jj,jk
+
+!******************************************************************************
+!       COEFFICIENTS FOR THOMAS ALGORITHM FOR SOILMOIS
+!******************************************************************************
+          NZS1=NZS-1                                                            
+          NZS2=NZS-2
+
+ 118      format(6(10Pf23.19))
+
+           do k=1,nzs
+            cosmc(k)=0.
+            rhsmc(k)=0.
+           enddo
+ 
+        DID=(ZSMAIN(NZS)-ZSHALF(NZS))*2.
+        X1=ZSMAIN(NZS)-ZSMAIN(NZS1)
+!        DENOM=DID/DELT+DIFFU(NZS1)/X1
+!        COSMC(1)=DIFFU(NZS1)/X1/DENOM
+!        RHSMC(1)=(SOILMOIS(NZS)*DID/DELT
+!     1   +TRANSP(NZS)-(HYDRO(NZS)*SOILMOIS(NZS)
+!     1   -HYDRO(NZS1)*SOILMOIS(NZS1))*DID
+!     1   /X1) /DENOM
+
+        DENOM=(1.+DIFFU(nzs1)/X1/DID*DELT+HYDRO(NZS)/(2.*DID)*DELT)
+        COSMC(1)=DELT*(DIFFU(nzs1)/DID/X1                                 &
+                    +HYDRO(NZS1)/2./DID)/DENOM
+        RHSMC(1)=(SOILMOIS(NZS)+TRANSP(NZS)*DELT/                         &
+               DID)/DENOM
+
+        DO 330 K=1,NZS2
+          KN=NZS-K
+          K1=2*KN-3
+          X4=2.*DTDZS(K1)*DIFFU(KN-1)
+          X2=2.*DTDZS(K1+1)*DIFFU(KN)
+          Q4=X4+HYDRO(KN-1)*DTDZS2(KN-1)
+          Q2=X2-HYDRO(KN+1)*DTDZS2(KN-1)
+          DENOM=1.+X2+X4-Q2*COSMC(K)
+          COSMC(K+1)=Q4/DENOM
+ 330      RHSMC(K+1)=(SOILMOIS(KN)+Q2*RHSMC(K)                            &
+                   +TRANSP(KN)                                            &
+                   /(ZSHALF(KN+1)-ZSHALF(KN))                             &
+                   *DELT)/DENOM
+
+! --- MOISTURE BALANCE BEGINS HERE
+
+          TRANS=TRANSP(1)
+          UMVEG=1.-VEGFRAC
+
+          RUNOFF=0.
+          RUNOFF2=0.
+          DZS=ZSMAIN(2)
+          R1=COSMC(NZS1)
+          R2= RHSMC(NZS1)
+          R3=DIFFU(1)/DZS
+          R4=R3+HYDRO(1)*.5          
+          R5=R3-HYDRO(2)*.5
+          R6=QKMS*RAS
+!-- Total liquid water available on the top of soil domain
+!-- Without snow - 3 sources of water: precipitation,
+!--         water dripping from the canopy and dew 
+!-- With snow - only one source of water - snow melt
+
+!        print *,'PRCP,DRIP,DEW,umveg,ras,smelt',
+!     1       PRCP,DRIP,DEW,umveg,ras,smelt
+!        if (drip.ne.0.) then
+!          print *,'DRIP non-zero'
+!          write(6,191) drip
+!          write (6,191)soilmois(1)
+!         write (6,191)soilmois(2)
+!        endif
+  191   format (f23.19)
+
+        TOTLIQ=UMVEG*PRCP-DRIP/DELT-UMVEG*DEW*RAS-SMELT
+
+
+        FLX=TOTLIQ
+        INFILTRP=TOTLIQ
+
+! -----------     FROZEN GROUND VERSION    -------------------------
+!   REFERENCE FROZEN GROUND PARAMETER, CVFRZ, IS A SHAPE PARAMETER OF
+!   AREAL DISTRIBUTION FUNCTION OF SOIL ICE CONTENT WHICH EQUALS 1/CV.
+!   CV IS A COEFFICIENT OF SPATIAL VARIATION OF SOIL ICE CONTENT.
+!   BASED ON FIELD DATA CV DEPENDS ON AREAL MEAN OF FROZEN DEPTH, AND IT
+!   CLOSE TO CONSTANT = 0.6 IF AREAL MEAN FROZEN DEPTH IS ABOVE 20 CM.
+!   THAT IS WHY PARAMETER CVFRZ = 3 (INT{1/0.6*0.6})
+!
+!   Current logic doesn't allow CVFRZ be bigger than 3
+         CVFRZ = 3.
+
+!-- SCHAAKE/KOREN EXPRESSION for calculation of max infiltration
+         REFKDT=3.
+         REFDK=3.4341E-6
+         DELT1=DELT/86400.
+         F1MAX=DQM*ZSHALF(2)
+         F2MAX=DQM*(ZSHALF(3)-ZSHALF(2))
+         F1=F1MAX*(1.-SOILMOIS(1)/DQM)
+         F2=F2MAX*(1.-SOILMOIS(2)/DQM)
+         FD=F1+F2
+         KDT=REFKDT*KSAT/REFDK
+         VAL=(1.-EXP(-KDT*DELT1))
+         DDT = FD*VAL
+         PX= - TOTLIQ * DELT
+         IF(PX.LT.0.0) PX = 0.0
+       if(ddt.eq.0.) then
+         infmax1=ksat
+        else
+         INFMAX1 = (PX*(DDT/(PX+DDT)))/DELT
+         INFMAX1 = MIN(INFMAX1, KSAT)
+        endif
+!         print *,'INFMAX1=,ksat',infmax1,ksat,f1,f2,kdt,val,ddt,px
+! -----------     FROZEN GROUND VERSION    --------------------------
+!    REDUCTION OF INFILTRATION BASED ON FROZEN GROUND PARAMETERS
+!
+! ------------------------------------------------------------------
+
+          DICE = soilice(1)*zshalf(2)
+      DO K=2,NZS1
+          DICE = DICE + ( ZSHALF(K+1) - ZSHALF(K) ) * soilice(k)
+      ENDDO
+         FRZX= 0.28*((dqm+qmin)/ref) * (0.400 / 0.482)
+         FCR = 1.
+         IF ( DICE .GT. 1.E-2) THEN
+           ACRT = CVFRZ * FRZX / DICE
+           SUM = 1.
+           IALP1 = CVFRZ - 1
+           DO JK = 1,IALP1
+              K = 1
+              DO JJ = JK+1, IALP1
+                K = K * JJ
+              END DO
+              SUM = SUM + (ACRT ** ( CVFRZ-JK)) / FLOAT (K)
+           END DO
+           FCR = 1. - EXP(-ACRT) * SUM
+         END IF
+!          print *,'FCR--------',fcr
+         INFMAX1 = INFMAX1* FCR
+         INFMAX1 = MIN(INFMAX1, KSAT)
+! -------------------------------------------------------------------
+
+         INFMAX = MIN(INFMAX,INFMAX1)
+!----
+          IF (-TOTLIQ.GE.INFMAX)THEN
+            RUNOFF=-TOTLIQ-INFMAX
+            FLX=-INFMAX
+          ENDIF
+! INFILTRP is total infiltration flux in M/S
+          INFILTRP=FLX
+!           print *,'PRCIP',infiltrp,flx,infmax
+! Solution of moisture budget
+          R7=.5*DZS/DELT
+          R4=R4+R7
+          FLX=FLX-SOILMOIS(1)*R7
+          R8=UMVEG*R6
+          QTOT=QVATM+QCATM
+          R9=TRANS
+          R10=QTOT-QSG
+!-- evaporation regime
+          IF(R10.LE.0.) THEN
+            QQ=(R5*R2-FLX+R9)/(R4-R5*R1-R10*R8/(REF-QMIN))
+            FLXSAT=-DQM*(R4-R5*R1-R10*R8/(REF-QMIN))                &
+                   +R5*R2+R9
+          ELSE
+!-- dew formation regime
+            QQ=(R2*R5-FLX+R8*(QTOT-QCG-QVG)+R9)/(R4-R1*R5)
+            FLXSAT=-DQM*(R4-R1*R5)+R2*R5+R8*(QTOT-QVG-QCG)+R9
+          END IF
+
+          IF(QQ.LT.0.) THEN
+            SOILMOIS(1)=0.
+
+          ELSE IF(QQ.GT.DQM) THEN
+!-- saturation
+            SOILMOIS(1)=DQM
+            RUNOFF2=runoff2+(FLXSAT-FLX)*DELT
+            RUNOFF=RUNOFF+(FLXSAT-FLX)
+          ELSE
+            SOILMOIS(1)=max(1.e-8,QQ)
+          END IF
+
+!--- FINAL SOLUTION FOR SOILMOIS 
+          DO K=2,NZS
+            KK=NZS-K+1
+            QQ=COSMC(KK)*SOILMOIS(K-1)+RHSMC(KK)
+
+           IF (QQ.LT.0.) THEN
+            SOILMOIS(K)=0.
+
+           ELSE IF(QQ.GT.DQM) THEN
+!-- saturation
+            SOILMOIS(K)=DQM
+             IF(K.EQ.NZS)THEN
+               RUNOFF2=RUNOFF2+(QQ-DQM)*(ZSMAIN(K)-ZSHALF(K))
+             ELSE
+               RUNOFF2=RUNOFF2+(QQ-DQM)*(ZSMAIN(K+1)-ZSHALF(K))
+             ENDIF
+           ELSE
+            SOILMOIS(K)=max(1.e-8,QQ)
+           END IF
+          END DO
+
+!           MAVAIL=min(1.,SOILMOIS(1)/(REF-QMIN))
+           MAVAIL=min(1.,SOILMOIS(1)/DQM)
+          if (MAVAIL.EQ.0.) MAVAIL=.00001
+
+!        RETURN
+!        END
+!-------------------------------------------------------------------
+    END SUBROUTINE SOILMOIST
+!-------------------------------------------------------------------
+
+
+            SUBROUTINE SOILPROP(                                  &
+!--- input variables
+         nzs,fwsat,lwsat,tav,keepfr,                              &
+         soilmois,soiliqw,soilice,                                &
+         soilmoism,soiliqwm,soilicem,                             &
+!--- soil fixed fields
+         QWRTZ,rhocs,dqm,qmin,psis,bclh,ksat,                     &
+!--- constants
+         riw,xlmelt,CP,G0_P,cvw,ci,                               & 
+         kqwrtz,kice,kwt,                                         &
+!--- output variables
+         thdif,diffu,hydro,cap)
+
+!******************************************************************
+! SOILPROP computes thermal diffusivity, and diffusional and
+!          hydraulic condeuctivities
+!******************************************************************
+! NX,NY,NZS - dimensions of soil domain
+! FWSAT, LWSAT - volumetric content of frozen and liquid water
+!                for saturated condition at given temperatures
+! TAV - temperature averaged for soil layers
+! SOILMOIS - volumetric soil moisture at the main soil levels
+! SOILMOISM - volumetric soil moisture averaged for layers
+! SOILIQWM - volumetric liquid soil moisture averaged for layers
+! SOILICEM - volumetric content of soil ice averaged for layers
+! THDIF - thermal diffusivity for soil layers
+! DIFFU - diffusional conductivity 
+! HYDRO - hydraulic conductivity
+! CAP - volumetric heat capacity
+!
+!******************************************************************
+
+        IMPLICIT NONE
+!-----------------------------------------------------------------
+
+!--- soil properties
+   INTEGER, INTENT(IN   )    ::                            NZS
+   REAL                                                        , &
+            INTENT(IN   )    ::                           RHOCS, &
+                                                           BCLH, &
+                                                            DQM, &
+                                                           KSAT, &
+                                                           PSIS, &
+                                                          QWRTZ, &  
+                                                           QMIN
+
+   REAL,    DIMENSION(  1:nzs )                                , &
+            INTENT(IN   )    ::                        SOILMOIS, &
+                                                         keepfr
+
+
+   REAL,     INTENT(IN   )   ::                              CP, &
+                                                            CVW, &
+                                                            RIW, &  
+                                                         kqwrtz, &
+                                                           kice, &
+                                                            kwt, &
+                                                         XLMELT, &
+                                                            G0_P
+
+
+
+!--- output variables
+   REAL,     DIMENSION(1:NZS)                                  , &
+            INTENT(INOUT)  ::      cap,diffu,hydro             , &
+                                   thdif,tav                   , &
+                                   soilmoism                   , &
+                                   soiliqw,soilice             , &
+                                   soilicem,soiliqwm           , &
+                                   fwsat,lwsat
+
+!--- local variables
+   REAL,     DIMENSION(1:NZS)  ::  hk,detal,kasat,kjpl
+
+   REAL    ::  x,x1,x2,x4,ws,wd,fact,fach,facd,psif,ci
+   REAL    ::  tln,tavln,tn,pf,a,am,ame,h
+   INTEGER ::  nzs1,k
+
+!-- for Johansen thermal conductivity
+   REAL    ::  kzero,gamd,kdry,kas,x5,sr,ke       
+               
+
+         nzs1=nzs-1
+
+!-- Constants for Johansen (1975) thermal conductivity
+         kzero =2.       ! if qwrtz > 0.2
+
+
+         do k=1,nzs
+            detal (k)=0.
+            kasat (k)=0.
+            kjpl  (k)=0.
+            hk    (k)=0.
+         enddo
+
+           ws=dqm+qmin
+           x1=xlmelt/(g0_p*psis)
+           x2=x1/bclh*ws
+           x4=(bclh+1.)/bclh
+!--- Next 3 lines are for Johansen thermal conduct.
+           gamd=(1.-ws)*2700.
+           kdry=(0.135*gamd+64.7)/(2700.-0.947*gamd)
+           kas=kqwrtz**qwrtz*kzero**(1.-qwrtz)
+
+         DO K=1,NZS1
+           tn=tav(k) - 273.15
+           wd=ws - riw*soilicem(k)
+           psif=psis*100.*(wd/(soiliqwm(k)+qmin))**bclh            &
+                * (ws/wd)**3.
+!--- PSIF should be in [CM] to compute PF
+           pf=log10(abs(psif))
+           fact=1.+riw*soilicem(k)
+!--- HK is for McCumber thermal conductivity
+         IF(PF.LE.5.2) THEN
+           HK(K)=420.*EXP(-(PF+2.7))*fact
+         ELSE
+           HK(K)=.1744*fact
+         END IF
+
+           IF(soilicem(k).NE.0.AND.TN.LT.0.) then
+!--- DETAL is taking care of energy spent on freezing or released from 
+!          melting of soil water
+
+              DETAL(K)=273.15*X2/(TAV(K)*TAV(K))*                  &
+                     (TAV(K)/(X1*TN))**X4
+
+              if(keepfr(k).eq.1.) then
+                 detal(k)=0.
+              endif
+
+           ENDIF
+
+!--- Next 10 lines calculate Johansen thermal conductivity KJPL
+           kasat(k)=kas**(1.-ws)*kice**fwsat(k)                    &
+                    *kwt**lwsat(k)
+
+           X5=(soilmoism(k)+qmin)/ws
+         if(soilicem(k).eq.0.) then
+           sr=max(0.101,x5)
+           ke=log10(sr)+1.
+!--- next 2 lines - for coarse soils
+!           sr=max(0.0501,x5)
+!           ke=0.7*log10(sr)+1.
+         else
+           ke=x5
+         endif
+
+           kjpl(k)=ke*(kasat(k)-kdry)+kdry
+
+!--- CAP -volumetric heat capacity
+            CAP(K)=(1.-WS)*RHOCS                                    &
+                  + (soiliqwm(K)+qmin)*CVW                          &
+                  + soilicem(K)*CI                                  &
+                  + (dqm-soilmoism(k))*CP*1.2                       &
+            - DETAL(K)*1.e3*xlmelt
+
+           a=RIW*soilicem(K)
+
+        if((ws-a).lt.0.12)then
+           diffu(K)=0.
+        else
+           H=max(0.,(soilmoism(K)-a)/(max(1.e-8,(dqm-a))))
+           facd=1.
+        if(a.ne.0.)facd=1.-a/max(1.e-8,soilmoism(K))
+          ame=max(1.e-8,dqm-riw*soilicem(K))
+!--- DIFFU is diffusional conductivity of soil water
+          diffu(K)=-BCLH*KSAT*PSIS/ame*                             &
+                  (dqm/ame)**3.                                     &
+                  *H**(BCLH+2.)*facd
+         endif
+
+!          diffu(K)=-BCLH*KSAT*PSIS/dqm                              &
+!                 *H**(BCLH+2.)
+
+
+!--- thdif - thermal diffusivity
+!           thdif(K)=HK(K)/CAP(K)
+!--- Use thermal conductivity from Johansen (1975)
+            thdif(K)=KJPL(K)/CAP(K)
+
+         END DO
+
+         DO K=1,NZS
+
+         if((ws-riw*soilice(k)).lt.0.12)then
+            hydro(k)=0.
+         else
+            fach=1.
+          if(soilice(k).ne.0.)                                     &
+             fach=1.-riw*soilice(k)/max(1.e-8,soilmois(k))
+         am=max(1.e-8,dqm-riw*soilice(k))
+!--- HYDRO is hydraulic conductivity of soil water
+          hydro(K)=KSAT/am*                                        & 
+                  (soiliqw(K)/am)                                  &
+                  **(2.*BCLH+2.)                                   &
+                  * fach
+         endif
+
+       ENDDO
+
+!       RETURN
+!       END
+
+!-----------------------------------------------------------------------
+   END SUBROUTINE SOILPROP
+!-----------------------------------------------------------------------
+
+
+           SUBROUTINE TRANSF(                                    &
+!--- input variables
+              nzs,nroot,soiliqw,                                 &
+!--- soil fixed fields
+              dqm,qmin,ref,wilt,zshalf,                          &
+!--- output variables
+              tranf,transum)
+
+!-------------------------------------------------------------------
+!--- TRANF(K) - THE TRANSPIRATION FUNCTION (EQ. 18,19)
+!*******************************************************************
+! NX,NY,NZS - dimensions of soil domain
+! SOILIQW - volumetric liquid soil moisture at the main levels
+! TRANF - the transpiration function at levels
+! TRANSUM - transpiration function integrated over the rooting zone
+!
+!*******************************************************************
+        IMPLICIT NONE
+!-------------------------------------------------------------------
+
+!--- input variables
+
+   INTEGER,  INTENT(IN   )   ::  nroot,nzs
+
+!--- soil properties
+   REAL                                                        , &
+            INTENT(IN   )    ::                             DQM, &
+                                                           QMIN, &
+                                                            REF, &
+                                                           WILT
+
+   REAL,     DIMENSION(1:NZS), INTENT(IN)  ::           soiliqw, &
+                                                         ZSHALF
+
+!-- output 
+   REAL,     DIMENSION(1:NZS), INTENT(OUT)  ::            TRANF
+   REAL,     INTENT(OUT)  ::                            TRANSUM  
+
+!-- local variables
+   REAL    ::  totliq, did
+   INTEGER ::  k
+
+!-- for non-linear root distribution
+   REAL    ::  gx,sm1,sm2,sm3,sm4,ap0,ap1,ap2,ap3,ap4
+   REAL,     DIMENSION(1:NZS)   ::           PART
+!--------------------------------------------------------------------
+
+        do k=1,nzs
+           part(k)=0.
+        enddo
+
+        transum=0.
+        totliq=soiliqw(1)+qmin
+           sm1=totliq
+           sm2=sm1*sm1
+           sm3=sm2*sm1
+           sm4=sm3*sm1
+           ap0=0.299
+           ap1=-8.152
+           ap2=61.653
+           ap3=-115.876
+           ap4=59.656
+           gx=ap0+ap1*sm1+ap2*sm2+ap3*sm3+ap4*sm4
+          if(totliq.ge.ref) gx=1.
+          if(totliq.le.0.) gx=0.
+          if(gx.gt.1.) gx=1.
+          if(gx.lt.0.) gx=0.
+        DID=zshalf(2)
+          part(1)=DID*gx
+        IF(TOTLIQ.GT.REF) THEN
+          TRANF(1)=DID
+        ELSE IF(TOTLIQ.LE.WILT) THEN
+          TRANF(1)=0.
+        ELSE
+          TRANF(1)=(TOTLIQ-WILT)/(REF-WILT)*DID
+        ENDIF 
+!-- uncomment next line for non-linear root distribution
+!cc           TRANF(1)=part(1)
+        DO K=2,NROOT
+        totliq=soiliqw(k)+qmin
+           sm1=totliq
+           sm2=sm1*sm1
+           sm3=sm2*sm1
+           sm4=sm3*sm1
+           gx=ap0+ap1*sm1+ap2*sm2+ap3*sm3+ap4*sm4
+          if(totliq.ge.ref) gx=1.
+          if(totliq.le.0.) gx=0.
+          if(gx.gt.1.) gx=1.
+          if(gx.lt.0.) gx=0.
+          DID=zshalf(K+1)-zshalf(K)
+          part(k)=did*gx
+        IF(totliq.GE.REF) THEN
+          TRANF(K)=DID
+        ELSE IF(totliq.LE.WILT) THEN
+          TRANF(K)=0.
+        ELSE
+          TRANF(K)=(totliq-WILT)                                &
+                /(REF-WILT)*DID
+        ENDIF
+!-- uncomment next line for non-linear root distribution
+!cc          TRANF(k)=part(k)
+        END DO
+
+!-- TRANSUM - total for the rooting zone
+          transum=0.
+        DO K=1,NROOT
+          transum=transum+tranf(k)
+        END DO
+
+!        RETURN
+!        END
+!-----------------------------------------------------------------
+   END SUBROUTINE TRANSF
+!-----------------------------------------------------------------
+
+
+       SUBROUTINE VILKA(TN,D1,D2,PP,QS,TS,TT,NSTEP,ii,j,iland,isoil)
+!--------------------------------------------------------------
+!--- VILKA finds the solution of energy budget at the surface
+!--- using table T,QS computed from Clausius-Klapeiron
+!--------------------------------------------------------------
+   REAL,     DIMENSION(1:4001),  INTENT(IN   )   ::  TT
+   REAL,     INTENT(IN  )   ::  TN,D1,D2,PP
+   INTEGER,  INTENT(IN  )   ::  NSTEP,ii,j,iland,isoil
+
+   REAL,     INTENT(OUT  )  ::  QS, TS
+
+   REAL    ::  F1,T1,T2,RN
+   INTEGER ::  I,I1
+     
+       I=(TN-1.7315E2)/.05+1
+       T1=173.1+FLOAT(I)*.05
+       F1=T1+D1*TT(I)-D2
+       I1=I-F1/(.05+D1*(TT(I+1)-TT(I)))
+       I=I1
+       IF(I.GT.4000.OR.I.LT.1) GOTO 1
+  10   I1=I
+       T1=173.1+FLOAT(I)*.05
+       F1=T1+D1*TT(I)-D2
+       RN=F1/(.05+D1*(TT(I+1)-TT(I)))
+       I=I-INT(RN)                      
+       IF(I.GT.4000.OR.I.LT.1) GOTO 1
+       IF(I1.NE.I) GOTO 10
+       TS=T1-.05*RN
+       QS=(TT(I)+(TT(I)-TT(I+1))*RN)/PP
+       GOTO 20
+   1   PRINT *,'     AVOST IN VILKA      '
+!       WRITE(12,*)'AVOST',TN,D1,D2,PP,NSTEP
+       PRINT *,TN,D1,D2,PP,NSTEP,I,TT(i),ii,j,iland,isoil
+       CALL wrf_error_fatal ('     AVOST IN VILKA      ' )
+   20  CONTINUE
+!       RETURN
+!       END
+!-----------------------------------------------------------------------
+   END SUBROUTINE VILKA
+!-----------------------------------------------------------------------
+
+
+     SUBROUTINE SOILVEGIN  ( IVGTYP,ISLTYP,MYJ,                         &
+                     IFOREST,EMISS,PC,ZNT,QWRTZ,                        &
+                     RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT        )
+
+!************************************************************************
+!  Set-up soil and vegetation Parameters in the case when
+!  snow disappears during the forecast and snow parameters
+!  shold be replaced by surface parameters according to
+!  soil and vegetation types in this point.
+!
+!        Output:
+!
+!
+!             Soil parameters:
+!               DQM: MAX soil moisture content - MIN
+!               REF:        Reference soil moisture
+!               WILT: Wilting PT soil moisture contents
+!               QMIN: Air dry soil moist content limits
+!               PSIS: SAT soil potential coefs.
+!               KSAT:  SAT soil diffusivity/conductivity coefs.
+!               BCLH: Soil diffusivity/conductivity exponent.
+!
+! ************************************************************************
+   IMPLICIT NONE
+!---------------------------------------------------------------------------
+      integer,   parameter      ::      nsoilclas=19
+      integer,   parameter      ::      nvegclas=24
+      integer,   parameter      ::      iwater=16
+      integer,   parameter      ::      ilsnow=99
+
+
+!---    soiltyp classification according to STATSGO(nclasses=16)
+!
+!             1          SAND                  SAND
+!             2          LOAMY SAND            LOAMY SAND
+!             3          SANDY LOAM            SANDY LOAM
+!             4          SILT LOAM             SILTY LOAM
+!             5          SILT                  SILTY LOAM
+!             6          LOAM                  LOAM
+!             7          SANDY CLAY LOAM       SANDY CLAY LOAM
+!             8          SILTY CLAY LOAM       SILTY CLAY LOAM
+!             9          CLAY LOAM             CLAY LOAM
+!            10          SANDY CLAY            SANDY CLAY
+!            11          SILTY CLAY            SILTY CLAY
+!            12          CLAY                  LIGHT CLAY
+!            13          ORGANIC MATERIALS     LOAM
+!            14          WATER
+!            15          BEDROCK
+!                        Bedrock is reclassified as class 14
+!            16          OTHER (land-ice)
+!            17          Playa
+!            18          Lava
+!            19          White Sand
+!
+!----------------------------------------------------------------------
+         REAL  LQMA(nsoilclas),LRHC(nsoilclas),                       &
+               LPSI(nsoilclas),LQMI(nsoilclas),                       &
+               LBCL(nsoilclas),LKAS(nsoilclas),                       &
+               LWIL(nsoilclas),LREF(nsoilclas),                       &
+               DATQTZ(nsoilclas)
+!-- LQMA Rawls et al.[1982]
+!        DATA LQMA /0.417, 0.437, 0.453, 0.501, 0.486, 0.463, 0.398,
+!     &  0.471, 0.464, 0.430, 0.479, 0.475, 0.439, 1.0, 0.20, 0.401/
+!---
+!-- Clapp et al. [1978]
+     DATA LQMA /0.395, 0.410, 0.435, 0.485, 0.485, 0.451, 0.420,      &
+                0.477, 0.476, 0.426, 0.492, 0.482, 0.451, 1.0,        &
+                0.20,  0.435, 0.468, 0.200, 0.339/
+
+!-- LREF Rawls et al.[1982]
+!        DATA LREF /0.091, 0.125, 0.207, 0.330, 0.360, 0.270, 0.255,
+!     &  0.366, 0.318, 0.339, 0.387, 0.396, 0.329, 1.0, 0.108, 0.283/
+
+!-- Clapp et al. [1978]
+        DATA LREF /0.174, 0.179, 0.249, 0.369, 0.369, 0.314, 0.299,   &
+                   0.357, 0.391, 0.316, 0.409, 0.400, 0.314, 1.,      &
+                   0.1,   0.249, 0.454, 0.17,  0.236/
+
+!-- LWIL Rawls et al.[1982]
+!        DATA LWIL/0.033, 0.055, 0.095, 0.133, 0.133, 0.117, 0.148,
+!     &  0.208, 0.197, 0.239, 0.250, 0.272, 0.066, 0.0, 0.006, 0.029/
+
+!-- Clapp et al. [1978]
+        DATA LWIL/0.068, 0.075, 0.114, 0.179, 0.179, 0.155, 0.175,    &
+                  0.218, 0.250, 0.219, 0.283, 0.286, 0.155, 0.0,      &
+                  0.006, 0.114, 0.030, 0.006, 0.01/
+
+!        DATA LQMI/0.010, 0.028, 0.047, 0.084, 0.084, 0.066, 0.067,
+!     &  0.120, 0.103, 0.100, 0.126, 0.138, 0.066, 0.0, 0.006, 0.028/
+
+!-- Carsel and Parrish [1988]
+        DATA LQMI/0.045, 0.057, 0.065, 0.067, 0.034, 0.078, 0.10,     &
+                  0.089, 0.095, 0.10,  0.070, 0.068, 0.078, 0.0,      &
+                  0.004, 0.065, 0.020, 0.004, 0.008/
+
+!-- LPSI Cosby et al[1984]
+!        DATA LPSI/0.060, 0.036, 0.141, 0.759, 0.759, 0.355, 0.135,
+!     &  0.617, 0.263, 0.098, 0.324, 0.468, 0.355, 0.0, 0.069, 0.036/
+!     &  0.617, 0.263, 0.098, 0.324, 0.468, 0.355, 0.0, 0.069, 0.036/
+
+!-- Clapp et al. [1978]
+       DATA LPSI/0.121, 0.090, 0.218, 0.786, 0.786, 0.478, 0.299,     &
+                 0.356, 0.630, 0.153, 0.490, 0.405, 0.478, 0.0,       &
+                 0.121, 0.218, 0.468, 0.069, 0.069/
+
+!-- LKAS Rawls et al.[1982]
+!        DATA LKAS/5.83E-5, 1.70E-5, 7.19E-6, 1.89E-6, 1.89E-6,
+!     &  3.67E-6, 1.19E-6, 4.17E-7, 6.39E-7, 3.33E-7, 2.50E-7,
+!     &  1.67E-7, 3.38E-6, 0.0, 1.41E-4, 1.41E-5/
+
+!-- Clapp et al. [1978]
+        DATA LKAS/1.76E-4, 1.56E-4, 3.47E-5, 7.20E-6, 7.20E-6,         &
+                  6.95E-6, 6.30E-6, 1.70E-6, 2.45E-6, 2.17E-6,         &
+                  1.03E-6, 1.28E-6, 6.95E-6, 0.0,     1.41E-4,         &
+                  3.47E-5, 1.28E-6, 1.41E-4, 1.76E-4/
+
+!-- LBCL Cosby et al [1984]
+!        DATA LBCL/2.79,  4.26,  4.74,  5.33,  5.33,  5.25,  6.66,
+!     &  8.72,  8.17,  10.73, 10.39, 11.55, 5.25,  0.0, 2.79,  4.26/
+
+!-- Clapp et al. [1978]
+        DATA LBCL/4.05,  4.38,  4.90,  5.30,  5.30,  5.39,  7.12,      &
+                  7.75,  8.52, 10.40, 10.40, 11.40,  5.39,  0.0,       &
+                  4.05,  4.90, 11.55,  2.79,  2.79/
+
+        DATA LRHC /1.47,1.41,1.34,1.27,1.27,1.21,1.18,1.32,1.23,       &
+                   1.18,1.15,1.09,1.21,4.18,2.03,2.10,1.09,2.03,1.47/
+
+        DATA DATQTZ/0.92,0.82,0.60,0.25,0.10,0.40,0.60,0.10,0.35,      &
+                    0.52,0.10,0.25,0.00,0.,0.60,0.0,0.25,0.60,0.92/
+
+!--------------------------------------------------------------------------
+!
+!     USGS Vegetation Types
+!
+!    1:   Urban and Built-Up Land
+!    2:   Dryland Cropland and Pasture
+!    3:   Irrigated Cropland and Pasture
+!    4:   Mixed Dryland/Irrigated Cropland and Pasture
+!    5:   Cropland/Grassland Mosaic
+!    6:   Cropland/Woodland Mosaic
+!    7:   Grassland
+!    8:   Shrubland
+!    9:   Mixed Shrubland/Grassland
+!   10:   Savanna
+!   11:   Deciduous Broadleaf Forest
+!   12:   Deciduous Needleleaf Forest
+!   13:   Evergreen Broadleaf Forest
+!   14:   Evergreen Needleleaf Fores
+!   15:   Mixed Forest
+!   16:   Water Bodies
+!   17:   Herbaceous Wetland
+!   18:   Wooded Wetland
+!   19:   Barren or Sparsely Vegetated
+!   20:   Herbaceous Tundra
+!   21:   Wooded Tundra
+!   22:   Mixed Tundra
+!   23:   Bare Ground Tundra
+!   24:   Snow or Ice
+
+!----  Below are the arrays for the vegetation parameters
+         REAL LALB(nvegclas),LMOI(nvegclas),LEMI(nvegclas),            &
+              LROU(nvegclas),LTHI(nvegclas),LSIG(nvegclas),            &
+              LPC(nvegclas), NROTBL(nvegclas)
+
+!************************************************************************
+!----     vegetation parameters
+!
+!-- USGS model
+!
+        DATA  LALB/.18,.17,.18,.18,.18,.16,.19,.22,.20,.20,.16,.14,     &
+                   .12,.12,.13,.08,.14,.14,.25,.15,.15,.15,.25,.55/
+        DATA LEMI/.88,4*.92,.93,.92,.88,.9,.92,.93,.94,                 &
+                  .95,.95,.94,.98,.95,.95,.85,.92,.93,.92,.85,.95/
+!-- Roughness length is changed for forests and some others
+!        DATA LROU/.5,.06,.075,.065,.05,.2,.075,.1,.11,.15,.8,.85,       &
+!                  2.0,1.0,.563,.0001,.2,.4,.05,.1,.15,.1,.065,.05/
+         DATA LROU/.5,.06,.075,.065,.05,.2,.075,.1,.11,.15,.5,.5,           & 
+                   .5,.5,.5,.0001,.2,.4,.05,.1,.15,.1,.065,.05/
+
+        DATA LMOI/.1,.3,.5,.25,.25,.35,.15,.1,.15,.15,.3,.3,            &
+                  .5,.3,.3,1.,.6,.35,.02,.5,.5,.5,.02,.95/
+!
+!---- still needs to be corrected
+!
+!       DATA LPC/ 15*.8,0.,.8,.8,.5,.5,.5,.5,.5,.0/
+       DATA LPC /0.6,6*0.8,0.7,0.75,6*0.8,0.,0.8,0.8,                   &
+                 0.5,0.7,0.6,0.7,0.5,0./
+
+
+!***************************************************************************
+
+
+   INTEGER      ::                &
+                                                         IVGTYP, &
+                                                         ISLTYP
+
+   LOGICAL,    INTENT(IN   )    ::     myj
+
+   REAL                                                        , &
+            INTENT (  OUT)            ::                     pc
+
+   REAL                                                        , &
+            INTENT (INOUT   )         ::                  emiss, &
+                                                            znt
+!--- soil properties
+   REAL                                                        , &
+            INTENT(  OUT)    ::                           RHOCS, &
+                                                           BCLH, &
+                                                            DQM, &
+                                                           KSAT, &
+                                                           PSIS, &
+                                                           QMIN, &
+                                                          QWRTZ, &
+                                                            REF, &
+                                                           WILT
+
+   INTEGER, DIMENSION( 1:nvegclas )                            , &
+            INTENT (  OUT)            ::                iforest
+
+
+
+   INTEGER, DIMENSION( 1:nvegclas )   ::   if1
+   INTEGER   ::   kstart, kfin, lstart, lfin
+   INTEGER   ::   i,j,k
+
+!***********************************************************************
+!        DATA ZS1/0.0,0.05,0.20,0.40,1.6,3.0/   ! o -  levels in soil
+!        DATA ZS2/0.0,0.025,0.125,0.30,1.,2.3/   ! x - levels in soil
+        DATA IF1/12*0,1,1,1,9*0/
+
+          do k=1,nvegclas
+             iforest(k)=if1(k)
+          enddo
+
+
+        EMISS = LEMI(IVGTYP)
+! When MYJ sfc scheme is used - better use recommended in MYJSFCINIT
+! values of roughness length, and not redefine it here.
+! The table in this routine is the one we use in RUC with RUC LSM.
+
+        if (.not. myj) then
+        ZNT   = LROU(IVGTYP)
+        endif
+
+        PC     = LPC (IVGTYP)
+
+          RHOCS  = LRHC(ISLTYP)*1.E6
+          BCLH   = LBCL(ISLTYP)
+          DQM    = LQMA(ISLTYP)-                               &
+                   LQMI(ISLTYP)
+          KSAT   = LKAS(ISLTYP)
+          PSIS   = - LPSI(ISLTYP)
+          QMIN   = LQMI(ISLTYP)
+          REF    = LREF(ISLTYP)
+          WILT   = LWIL(ISLTYP)
+          QWRTZ  = DATQTZ(ISLTYP)
+
+!--------------------------------------------------------------------------
+   END SUBROUTINE SOILVEGIN
+!--------------------------------------------------------------------------
+
+
+      SUBROUTINE SNOWFREE (ivgtyp,myj,emiss,znt,iland)
+!************************************************************************
+!  Set-up soil and vegetation Parameters in the case when
+!  snow disappears during the forecast and snow parameters
+!  shold be replaced by surface parameters according to
+!  soil and vegetation types in this point.
+!
+!***************************************************************************
+   IMPLICIT NONE
+!---------------------------------------------------------------------------
+   integer,   parameter      ::      nvegclas=24
+
+
+   INTEGER                   ::      IVGTYP
+
+   LOGICAL,    INTENT(IN   )    ::     myj
+
+   REAL,     INTENT(INOUT)   ::                                 &
+                                                         emiss, &
+                                                           znt  
+   INTEGER,  INTENT(INOUT)   ::      ILAND
+ 
+!----  Below are the arrays for the vegetation parameters 
+   REAL,    DIMENSION( 1:nvegclas )   ::                  LALB, &
+                                                          LEMI, &
+                                                       LROU_MYJ,&
+                                                          LROU
+
+!************************************************************************
+!-- USGS model
+!
+        DATA  LALB/.18,.17,.18,.18,.18,.16,.19,.22,.20,.20,.16,.14,     &
+                   .12,.12,.13,.08,.14,.14,.25,.15,.15,.15,.25,.55/
+        DATA LEMI/.88,4*.92,.93,.92,.88,.9,.92,.93,.94,                 &
+                  .95,.95,.94,.98,.95,.95,.85,.92,.93,.92,.85,.95/
+!-- Roughness length is changed for forests and some others
+! next 2 lines - table from RUC
+        DATA LROU/.5,.06,.075,.065,.05,.2,.075,.1,.11,.15,.8,.85,       &
+                  2.0,1.0,.563,.0001,.2,.4,.05,.1,.15,.1,.065,.05/
+
+!         DATA LROU/.5,.06,.075,.065,.05,.2,.075,.1,.11,.15,.5,.5,           &
+!                   .5,.5,.5,.0001,.2,.4,.05,.1,.15,.1,.065,.05/
+
+! With MYJSFC better use the table from MYJSFCINIT
+        DATA LROU_MYJ/1.0,.07,.07,.07,.07,.15,.08,.03,.05,.86,.8,.85,       &
+                  2.65,1.09,.8,.001,.04,.05,.01,.04,.06,.05,.03,.001/
+
+
+
+!--------------------------------------------------------------------------
+
+        EMISS  = LEMI(IVGTYP)
+       if(myj) then
+        ZNT    = LROU_MYJ(IVGTYP)
+       else
+        ZNT    = LROU(IVGTYP)
+       endif
+        ILAND  =      IVGTYP
+! --- 
+
+!        RETURN
+!        END
+!--------------------------------------------------------------------------
+   END SUBROUTINE SNOWFREE
+
+  SUBROUTINE LSMRUCINIT( SMFR3D,TSLB,SMOIS,ISLTYP,mavail,          &
+                     nzs, restart,                                 &
+                     allowed_to_read ,                             &
+                     ids,ide, jds,jde, kds,kde,                    &
+                     ims,ime, jms,jme, kms,kme,                    &
+                     its,ite, jts,jte, kts,kte                     )
+
+   IMPLICIT NONE
+
+
+   INTEGER,  INTENT(IN   )   ::     ids,ide, jds,jde, kds,kde,  &
+                                    ims,ime, jms,jme, kms,kme,  &
+                                    its,ite, jts,jte, kts,kte,  &
+                                    nzs
+
+   REAL, DIMENSION( ims:ime, 1:nzs, jms:jme )                    , &
+            INTENT(IN)    ::                                 TSLB, &
+                                                            SMOIS
+
+   INTEGER, DIMENSION( ims:ime, jms:jme )                        , &
+            INTENT(INOUT)    ::                            ISLTYP
+
+   REAL, DIMENSION( ims:ime, 1:nzs, jms:jme )                    , &
+            INTENT(INOUT)    ::                            SMFR3D
+
+   REAL, DIMENSION( ims:ime, jms:jme )                           , &
+            INTENT(INOUT)    ::                            MAVAIL
+
+   REAL, DIMENSION ( 1:nzs )  ::                           SOILIQW
+
+   LOGICAL , INTENT(IN) :: restart, allowed_to_read 
+
+!
+  INTEGER ::  I,J,L,itf,jtf
+  REAL    ::  RIW,XLMELT,TLN,DQM,REF,PSIS,QMIN,BCLH
+
+   itf=min0(ite,ide-1)
+   jtf=min0(jte,jde-1)
+
+
+        RIW=900.*1.e-3
+        XLMELT=3.335E+5
+
+   DO J=jts,jtf
+       DO I=its,itf
+
+     CALL SOILIN     ( ISLTYP(I,J), DQM, REF, PSIS, QMIN, BCLH )
+
+
+!--- Computation of volumetric content of ice in soil
+!--- and initialize MAVAIL
+
+     IF (.not.restart) THEN
+    if(isltyp(i,j).ne.14) then
+           mavail(i,j) = max(0.00001,min(1.,smois(i,1,j)/dqm))
+!           mavail(i,j) = max(0.00001,min(1.,smois(i,1,j)/(ref-qmin)))
+    else
+           mavail(i,j) = 1.
+    endif
+         DO L=1,NZS
+    if(isltyp(i,j).ne.14) then
+!-- for land points initialize soil ice
+         tln=log(TSLB(i,l,j)/273.15)
+
+         if(tln.lt.0.) then
+           soiliqw(l)=(dqm+qmin)*(XLMELT*                        &
+         (tslb(i,l,j)-273.15)/tslb(i,l,j)/9.81/psis)             &
+          **(-1./bclh)-qmin
+           soiliqw(l)=max(0.,soiliqw(l))
+           soiliqw(l)=min(soiliqw(l),smois(i,l,j))
+           smfr3d(i,l,j)=(smois(i,l,j)-soiliqw(l))/RIW
+
+         else
+           smfr3d(i,l,j)=0.
+         endif
+    else
+!-- for water points
+       smfr3d(i,l,j)=0.
+    endif
+
+          ENDDO
+     ENDIF
+
+    ENDDO
+   ENDDO
+
+  END SUBROUTINE lsmrucinit
+
+  SUBROUTINE SOILIN (ISLTYP, DQM, REF, PSIS, QMIN, BCLH )
+
+!---    soiltyp classification according to STATSGO(nclasses=16)
+!
+!             1          SAND                  SAND
+!             2          LOAMY SAND            LOAMY SAND
+!             3          SANDY LOAM            SANDY LOAM
+!             4          SILT LOAM             SILTY LOAM
+!             5          SILT                  SILTY LOAM
+!             6          LOAM                  LOAM
+!             7          SANDY CLAY LOAM       SANDY CLAY LOAM
+!             8          SILTY CLAY LOAM       SILTY CLAY LOAM
+!             9          CLAY LOAM             CLAY LOAM
+!            10          SANDY CLAY            SANDY CLAY
+!            11          SILTY CLAY            SILTY CLAY
+!            12          CLAY                  LIGHT CLAY
+!            13          ORGANIC MATERIALS     LOAM
+!            14          WATER
+!            15          BEDROCK
+!                        Bedrock is reclassified as class 14
+!            16          OTHER (land-ice)
+! extra classes from Fei Chen
+!            17          Playa
+!            18          Lava
+!            19          White Sand
+!
+!----------------------------------------------------------------------
+         integer,   parameter      ::      nsoilclas=19
+
+         integer, intent ( in)  ::                          isltyp
+         real,    intent ( out) ::               dqm,ref,qmin,psis
+
+         REAL  LQMA(nsoilclas),LREF(nsoilclas),LBCL(nsoilclas),       &
+               LPSI(nsoilclas),LQMI(nsoilclas)
+
+!-- LQMA Rawls et al.[1982]
+!        DATA LQMA /0.417, 0.437, 0.453, 0.501, 0.486, 0.463, 0.398,
+!     &  0.471, 0.464, 0.430, 0.479, 0.475, 0.439, 1.0, 0.20, 0.401/
+!---
+!-- Clapp et al. [1978]
+     DATA LQMA /0.395, 0.410, 0.435, 0.485, 0.485, 0.451, 0.420,      &
+                0.477, 0.476, 0.426, 0.492, 0.482, 0.451, 1.0,        &
+                0.20,  0.435, 0.468, 0.200, 0.339/
+
+!-- Clapp et al. [1978]
+        DATA LREF /0.174, 0.179, 0.249, 0.369, 0.369, 0.314, 0.299,   &
+                   0.357, 0.391, 0.316, 0.409, 0.400, 0.314, 1.,      &
+                   0.1,   0.249, 0.454, 0.17,  0.236/
+
+!-- Carsel and Parrish [1988]
+        DATA LQMI/0.045, 0.057, 0.065, 0.067, 0.034, 0.078, 0.10,     &
+                  0.089, 0.095, 0.10,  0.070, 0.068, 0.078, 0.0,      &
+                  0.004, 0.065, 0.020, 0.004, 0.008/
+
+!-- Clapp et al. [1978]
+       DATA LPSI/0.121, 0.090, 0.218, 0.786, 0.786, 0.478, 0.299,     &
+                 0.356, 0.630, 0.153, 0.490, 0.405, 0.478, 0.0,       &
+                 0.121, 0.218, 0.468, 0.069, 0.069/
+
+!-- Clapp et al. [1978]
+        DATA LBCL/4.05,  4.38,  4.90,  5.30,  5.30,  5.39,  7.12,      &
+                  7.75,  8.52, 10.40, 10.40, 11.40,  5.39,  0.0,       &
+                  4.05,  4.90, 11.55,  2.79,  2.79/
+
+
+          DQM    = LQMA(ISLTYP)-                               &
+                   LQMI(ISLTYP)
+          REF    = LREF(ISLTYP)
+          PSIS   = - LPSI(ISLTYP)
+          QMIN   = LQMI(ISLTYP)
+          BCLH   = LBCL(ISLTYP)
+
+  END SUBROUTINE SOILIN
+
+END MODULE module_sf_ruclsm
Index: trunk/WRF.COMMON/WRFV2/phys/module_sf_sfcdiags.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_sf_sfcdiags.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_sf_sfcdiags.F	(revision 2744)
@@ -0,0 +1,47 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+MODULE module_sf_sfcdiags
+
+CONTAINS
+
+   SUBROUTINE SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2,       &
+                     PSFC,CP,R_d,ROVCP,                            &
+                     ids,ide, jds,jde, kds,kde,                    &
+                     ims,ime, jms,jme, kms,kme,                    &
+                     its,ite, jts,jte, kts,kte                     )
+!-------------------------------------------------------------------
+      IMPLICIT NONE
+!-------------------------------------------------------------------
+      INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(IN)                  ::                HFX, &
+                                                              QFX, &
+                                                              TSK, &
+                                                             QSFC
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(INOUT)               ::                Q2, &
+                                                             TH2, &
+                                                              T2
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(IN)                  ::               PSFC, &
+                                                             CHS2, &
+                                                             CQS2
+      REAL,     INTENT(IN   )               ::       CP,R_d,ROVCP
+! LOCAL VARS
+      INTEGER ::  I,J
+      REAL    ::  RHO
+
+      DO J=jts,jte
+        DO I=its,ite
+          RHO = PSFC(I,J)/(R_d * TSK(I,J))
+          Q2(I,J) = QSFC(I,J) - QFX(I,J)/(RHO*CQS2(I,J))
+          T2(I,J) = TSK(I,J) - HFX(I,J)/(RHO*CP*CHS2(I,J))
+          TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**ROVCP
+        ENDDO
+      ENDDO
+
+  END SUBROUTINE SFCDIAGS
+
+END MODULE module_sf_sfcdiags
Index: trunk/WRF.COMMON/WRFV2/phys/module_sf_sfclay.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_sf_sfclay.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_sf_sfclay.F	(revision 2744)
@@ -0,0 +1,783 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+MODULE module_sf_sfclay
+
+ REAL    , PARAMETER ::  VCONVC=1.
+ REAL    , PARAMETER ::  CZO=0.0185
+ REAL    , PARAMETER ::  OZO=1.59E-5
+
+ REAL,   DIMENSION(0:1000 ),SAVE          :: PSIMTB,PSIHTB
+
+CONTAINS
+
+!-------------------------------------------------------------------
+   SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w,                    &
+                     CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,      &
+                     ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
+                     XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
+                     uratx,vratx,tratx,                            &
+                     U10,V10,TH2,T2,Q2,                            &
+                     GZ1OZ0,WSPD,BR,ISFFLX,DX,                     &
+                     SVP1,SVP2,SVP3,SVPT0,EP1,EP2,                 &
+                     KARMAN,EOMEG,STBOLT,                          &
+                     ids,ide, jds,jde, kds,kde,                    &
+                     ims,ime, jms,jme, kms,kme,                    &
+                     its,ite, jts,jte, kts,kte                     )
+!-------------------------------------------------------------------
+      IMPLICIT NONE
+!-------------------------------------------------------------------
+!-- U3D         3D u-velocity interpolated to theta points (m/s)
+!-- V3D         3D v-velocity interpolated to theta points (m/s)
+!-- T3D         temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!-- P3D         3D pressure (Pa)
+!-- dz8w        dz between full levels (m)
+!-- CP          heat capacity at constant pressure for dry air (J/kg/K)
+!-- G           acceleration due to gravity (m/s^2)
+!-- ROVCP       R/CP
+!-- R           gas constant for dry air (J/kg/K)
+!-- XLV         latent heat of vaporization for water (J/kg)
+!-- PSFC        surface pressure (Pa)
+!-- ZNT         roughness length (m)
+!-- UST         u* in similarity theory (m/s)
+!-- PBLH        PBL height from previous time (m)
+!-- MAVAIL      surface moisture availability (between 0 and 1)
+!-- ZOL         z/L height over Monin-Obukhov length
+!-- MOL         T* (similarity theory) (K)
+!-- REGIME      flag indicating PBL regime (stable, unstable, etc.)
+!-- PSIM        similarity stability function for momentum
+!-- PSIH        similarity stability function for heat
+!-- XLAND       land mask (1 for land, 2 for water)
+!-- HFX         upward heat flux at the surface (W/m^2)
+!-- QFX         upward moisture flux at the surface (kg/m^2/s)
+!-- LH          net upward latent heat flux at surface (W/m^2)
+!-- TSK         surface temperature (K)
+!-- FLHC        exchange coefficient for heat (m/s)
+!-- FLQC        exchange coefficient for moisture (m/s)
+!-- QGH         lowest-level saturated mixing ratio
+!-- uratx       ratio of surface U to U10
+!-- vratx       ratio of surface V to V10
+!-- tratx       ratio of surface T to TH2
+!-- U10         diagnostic 10m u wind
+!-- V10         diagnostic 10m v wind
+!-- TH2         diagnostic 2m theta (K)
+!-- T2          diagnostic 2m temperature (K)
+!-- Q2          diagnostic 2m mixing ratio (kg/kg)
+!-- GZ1OZ0      log(z/z0) where z0 is roughness length
+!-- WSPD        wind speed at lowest model level (m/s)
+!-- BR          bulk Richardson number in surface layer
+!-- ISFFLX      isfflx=1 for surface heat and moisture fluxes
+!-- DX          horizontal grid size (m)
+!-- SVP1        constant for saturation vapor pressure (kPa)
+!-- SVP2        constant for saturation vapor pressure (dimensionless)
+!-- SVP3        constant for saturation vapor pressure (K)
+!-- SVPT0       constant for saturation vapor pressure (K)
+!-- EP1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
+!-- EP2         constant for specific humidity calculation 
+!               (R_d/R_v) (dimensionless)
+!-- KARMAN      Von Karman constant
+!-- EOMEG       angular velocity of earth's rotation (rad/s)
+!-- STBOLT      Stefan-Boltzmann constant (W/m^2/K^4)
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!-------------------------------------------------------------------
+      INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+!                                                               
+      INTEGER,  INTENT(IN )   ::        ISFFLX
+      REAL,     INTENT(IN )   ::        SVP1,SVP2,SVP3,SVPT0
+      REAL,     INTENT(IN )   ::        EP1,EP2,KARMAN,EOMEG,STBOLT
+!
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
+                INTENT(IN   )   ::                           dz8w
+                                        
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
+                INTENT(IN   )   ::                           QV3D, &
+                                                              P3D, &
+                                                              T3D
+
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(IN   )               ::             MAVAIL, &
+                                                             PBLH, &
+                                                            XLAND, &
+                                                              TSK
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(OUT  )               ::                U10, &
+                                                              V10, &
+                                                              TH2, &
+                                                               T2, &
+                                                               Q2, &
+                                                             QSFC
+
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(OUT)     ::              uratx,vratx,tratx
+!
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(INOUT)               ::             REGIME, &
+                                                              HFX, &
+                                                              QFX, &
+                                                               LH, &
+                                                          MOL,RMOL
+!m the following 5 are change to memory size
+!
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(INOUT)   ::                 GZ1OZ0,WSPD,BR, &
+                                                        PSIM,PSIH
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
+                INTENT(IN   )   ::                            U3D, &
+                                                              V3D
+                                        
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(IN   )               ::               PSFC
+
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(INOUT)   ::                            ZNT, &
+                                                              ZOL, &
+                                                              UST, &
+                                                              CPM, &
+                                                             CHS2, &
+                                                             CQS2, &
+                                                              CHS
+
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(INOUT)   ::                      FLHC,FLQC
+
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(INOUT)   ::                                 &
+                                                              QGH
+
+
+                                    
+      REAL,     INTENT(IN   )               ::   CP,G,ROVCP,R,XLV,DX
+ 
+! LOCAL VARS
+
+      REAL,     DIMENSION( its:ite ) ::                       U1D, &
+                                                              V1D, &
+                                                             QV1D, &
+                                                              P1D, &
+                                                              T1D
+
+      REAL,     DIMENSION( its:ite ) ::                    dz8w1d
+
+      INTEGER ::  I,J
+
+      DO J=jts,jte
+        DO i=its,ite
+          dz8w1d(I) = dz8w(i,1,j)
+        ENDDO
+   
+        DO i=its,ite
+           U1D(i) =U3D(i,1,j)
+           V1D(i) =V3D(i,1,j)
+           QV1D(i)=QV3D(i,1,j)
+           P1D(i) =P3D(i,1,j)
+           T1D(i) =T3D(i,1,j)
+        ENDDO
+
+        CALL SFCLAY1D(J,U1D,V1D,T1D,QV1D,P1D,dz8w1d,               &
+                CP,G,ROVCP,R,XLV,PSFC(ims,j),CHS(ims,j),CHS2(ims,j),&
+                CQS2(ims,j),CPM(ims,j),PBLH(ims,j), RMOL(ims,j),   &
+                ZNT(ims,j),UST(ims,j),MAVAIL(ims,j),ZOL(ims,j),    &
+                MOL(ims,j),REGIME(ims,j),PSIM(ims,j),PSIH(ims,j),  &
+                XLAND(ims,j),HFX(ims,j),QFX(ims,j),TSK(ims,j),     &
+                uratx(ims,j),vratx(ims,j),tratx(ims,j),            &
+                U10(ims,j),V10(ims,j),TH2(ims,j),T2(ims,j),        &
+                Q2(ims,j),FLHC(ims,j),FLQC(ims,j),QGH(ims,j),      &
+                QSFC(ims,j),LH(ims,j),                             &
+                GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),ISFFLX,DX,     &
+                SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT,  &
+                ids,ide, jds,jde, kds,kde,                         &
+                ims,ime, jms,jme, kms,kme,                         &
+                its,ite, jts,jte, kts,kte                          )
+      ENDDO
+
+
+   END SUBROUTINE SFCLAY
+
+
+!-------------------------------------------------------------------
+   SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d,                &
+                     CP,G,ROVCP,R,XLV,PSFCPA,CHS,CHS2,CQS2,CPM,PBLH,RMOL, &
+                     ZNT,UST,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH,      &
+                     XLAND,HFX,QFX,TSK,                            &
+                     uratx,vratx,tratx,                            &
+                     U10,V10,TH2,T2,Q2,FLHC,FLQC,QGH,              &
+                     QSFC,LH,GZ1OZ0,WSPD,BR,ISFFLX,DX,             &
+                     SVP1,SVP2,SVP3,SVPT0,EP1,EP2,                 &
+                     KARMAN,EOMEG,STBOLT,                          &
+                     ids,ide, jds,jde, kds,kde,                    &
+                     ims,ime, jms,jme, kms,kme,                    &
+                     its,ite, jts,jte, kts,kte                     )
+!-------------------------------------------------------------------
+      IMPLICIT NONE
+!-------------------------------------------------------------------
+      REAL,     PARAMETER     ::        XKA=2.4E-5
+      REAL,     PARAMETER     ::        PRT=1.
+
+      INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte, &
+                                        J
+!                                                               
+      INTEGER,  INTENT(IN )   ::        ISFFLX
+      REAL,     INTENT(IN )   ::        SVP1,SVP2,SVP3,SVPT0
+      REAL,     INTENT(IN )   ::        EP1,EP2,KARMAN,EOMEG,STBOLT
+
+!
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(IN   )               ::             MAVAIL, &
+                                                             PBLH, &
+                                                            XLAND, &
+                                                              TSK
+!
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(IN   )               ::             PSFCPA
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(INOUT)               ::             REGIME, &
+                                                              HFX, &
+                                                              QFX, &
+                                                         MOL,RMOL
+!m the following 5 are changed to memory size---
+!
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(INOUT)   ::                 GZ1OZ0,WSPD,BR, &
+                                                        PSIM,PSIH
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(INOUT)   ::                            ZNT, &
+                                                              ZOL, &
+                                                              UST, &
+                                                              CPM, &
+                                                             CHS2, &
+                                                             CQS2, &
+                                                              CHS
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(INOUT)   ::                      FLHC,FLQC
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(INOUT)   ::                                 &
+                                                              QGH
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(OUT)     ::                        U10,V10, &
+                                                TH2,T2,Q2,QSFC,LH
+
+      REAL,     DIMENSION( ims:ime )                             , &
+                INTENT(OUT)     ::              uratx,vratx,tratx
+                                    
+      REAL,     INTENT(IN   )               ::   CP,G,ROVCP,R,XLV,DX
+
+! MODULE-LOCAL VARIABLES, DEFINED IN SUBROUTINE SFCLAY
+      REAL,     DIMENSION( its:ite ),  INTENT(IN   )   ::  dz8w1d
+
+      REAL,     DIMENSION( its:ite ),  INTENT(IN   )   ::      UX, &
+                                                               VX, &
+                                                             QV1D, &
+                                                              P1D, &
+                                                              T1D
+ 
+! LOCAL VARS
+
+      REAL,     DIMENSION( its:ite )        ::                 ZA, &
+                                                        THVX,ZQKL, &
+                                                           ZQKLP1, &
+                                                           THX,QX, &
+                                                            PSIH2, &
+                                                            PSIM2, &
+                                                            PSIH10, &
+                                                            PSIM10, &
+                                                           GZ2OZ0, &
+                                                           GZ10OZ0
+!
+      REAL,     DIMENSION( its:ite )        ::                     &
+                                                      RHOX,GOVRTH, &
+                                                            TGDSA
+!
+      REAL,     DIMENSION( its:ite)         ::          SCR3,SCR4
+      REAL,     DIMENSION( its:ite )        ::         THGB, PSFC
+!
+      INTEGER                               ::                 KL
+
+      INTEGER ::  N,I,K,KK,L,NZOL,NK,NZOL2,NZOL10
+
+      REAL    ::  PL,THCON,TVCON,E1
+      REAL    ::  ZL,TSKV,DTHVDZ,DTHVM,VCONV,RZOL,RZOL2,RZOL10,ZOL2,ZOL10
+      REAL    ::  DTG,PSIX,USTM,DTTHX,PSIX10,PSIT,PSIT2,PSIQ,PSIQ2
+      REAL    ::  FLUXC,VSGD
+!-------------------------------------------------------------------
+      KL=kte
+
+      DO i=its,ite
+! PSFC cmb
+         PSFC(I)=PSFCPA(I)/1000.
+      ENDDO
+!                                                      
+!----CONVERT GROUND TEMPERATURE TO POTENTIAL TEMPERATURE:  
+!                                                            
+      DO 5 I=its,ite                                   
+        TGDSA(I)=TSK(I)                                    
+! PSFC cmb
+        THGB(I)=TSK(I)*(100./PSFC(I))**ROVCP                
+    5 CONTINUE                                               
+!                                                            
+!-----DECOUPLE FLUX-FORM VARIABLES TO GIVE U,V,T,THETA,THETA-VIR.,
+!     T-VIR., QV, AND QC AT CROSS POINTS AND AT KTAU-1.  
+!                                                                 
+!     *** NOTE ***                                           
+!         THE BOUNDARY WINDS MAY NOT BE ADEQUATELY AFFECTED BY FRICTION,         
+!         SO USE ONLY INTERIOR VALUES OF UX AND VX TO CALCULATE 
+!         TENDENCIES.                             
+!                                                           
+   10 CONTINUE                                                     
+
+!     DO 24 I=its,ite
+!        UX(I)=U1D(I)
+!        VX(I)=V1D(I)
+!  24 CONTINUE                                             
+                                                             
+   26 CONTINUE                                               
+                                                   
+!.....SCR3(I,K) STORE TEMPERATURE,                           
+!     SCR4(I,K) STORE VIRTUAL TEMPERATURE.                                       
+                                                                                 
+      DO 30 I=its,ite
+! PL cmb
+         PL=P1D(I)/1000.
+         SCR3(I)=T1D(I)                                                   
+         THCON=(100./PL)**ROVCP                                                 
+         THX(I)=SCR3(I)*THCON                                               
+         SCR4(I)=SCR3(I)                                                    
+         THVX(I)=THX(I)                                                     
+         QX(I)=0.                                                             
+   30 CONTINUE                                                                 
+!                                                                                
+      DO I=its,ite
+         QGH(I)=0.                                                                
+         FLHC(I)=0.                                                               
+         FLQC(I)=0.                                                               
+         CPM(I)=CP                                                                
+      ENDDO
+!                                                                                
+!     IF(IDRY.EQ.1)GOTO 80                                                   
+      DO 50 I=its,ite
+         QX(I)=QV1D(I)                                                    
+         TVCON=(1.+EP1*QX(I))                                      
+         THVX(I)=THX(I)*TVCON                                               
+         SCR4(I)=SCR3(I)*TVCON                                              
+   50 CONTINUE                                                                 
+!                                                                                
+      DO 60 I=its,ite
+        E1=SVP1*EXP(SVP2*(TGDSA(I)-SVPT0)/(TGDSA(I)-SVP3))                       
+        QSFC(I)=EP2*E1/(PSFC(I)-E1)                                                 
+! QGH CHANGED TO USE LOWEST-LEVEL AIR TEMP CONSISTENT WITH MYJSFC CHANGE
+! Q2SAT = QGH IN LSM
+        E1=SVP1*EXP(SVP2*(T1D(I)-SVPT0)/(T1D(I)-SVP3))                       
+        QGH(I)=EP2*E1/(PSFC(I)-E1)                                                 
+        CPM(I)=CP*(1.+0.8*QX(I))                                   
+   60 CONTINUE                                                                   
+   80 CONTINUE
+                                                                                 
+!-----COMPUTE THE HEIGHT OF FULL- AND HALF-SIGMA LEVELS ABOVE GROUND             
+!     LEVEL, AND THE LAYER THICKNESSES.                                          
+                                                                                 
+      DO 90 I=its,ite
+        ZQKLP1(I)=0.
+        RHOX(I)=PSFC(I)*1000./(R*SCR4(I))                                       
+   90 CONTINUE                                                                   
+!                                                                                
+      DO 110 I=its,ite                                                   
+           ZQKL(I)=dz8w1d(I)+ZQKLP1(I)
+  110 CONTINUE                                                                 
+!                                                                                
+      DO 120 I=its,ite
+         ZA(I)=0.5*(ZQKL(I)+ZQKLP1(I))                                        
+  120 CONTINUE                                                                 
+!                                                                                
+      DO 160 I=its,ite
+        GOVRTH(I)=G/THX(I)                                                    
+  160 CONTINUE                                                                   
+                                                                                 
+!-----CALCULATE BULK RICHARDSON NO. OF SURFACE LAYER, ACCORDING TO               
+!     AKB(1976), EQ(12).                                                         
+                   
+      DO 260 I=its,ite
+        GZ1OZ0(I)=ALOG(ZA(I)/ZNT(I))                                        
+        GZ2OZ0(I)=ALOG(2./ZNT(I))                                        
+        GZ10OZ0(I)=ALOG(10./ZNT(I))                                        
+        IF((XLAND(I)-1.5).GE.0)THEN                                            
+          ZL=ZNT(I)                                                            
+        ELSE                                                                     
+          ZL=0.01                                                                
+        ENDIF                                                                    
+        WSPD(I)=SQRT(UX(I)*UX(I)+VX(I)*VX(I))                        
+
+        TSKV=THGB(I)*(1.+EP1*QSFC(I)*MAVAIL(I))                     
+        DTHVDZ=(THVX(I)-TSKV)                                                 
+!  Convective velocity scale Vc and subgrid-scale velocity Vsg
+!  following Beljaars (1995, QJRMS) and Mahrt and Sun (1995, MWR)
+!                                ... HONG Aug. 2001
+!
+!       VCONV = 0.25*sqrt(g/tskv*pblh(i)*dthvm)
+        fluxc = max(hfx(i)/rhox(i)/cp                    &
+              + ep1*tskv*qfx(i)/rhox(i),0.)
+        VCONV = vconvc*(g/tgdsa(i)*pblh(i)*fluxc)**.33
+!       IF(-DTHVDZ.GE.0)THEN
+!         DTHVM=-DTHVDZ
+!       ELSE
+!         DTHVM=0.
+!       ENDIF
+!       VCONV = max(vconv,VCONVC*SQRT(DTHVM))
+! VCONV comes from Beljaars only
+        VSGD = 0.32 * (max(dx/5000.-1.,0.))**.33
+        WSPD(I)=SQRT(WSPD(I)*WSPD(I)+VCONV*VCONV+vsgd*vsgd)
+        WSPD(I)=AMAX1(WSPD(I),0.1)
+        BR(I)=GOVRTH(I)*ZA(I)*DTHVDZ/(WSPD(I)*WSPD(I))                        
+!  IF PREVIOUSLY UNSTABLE, DO NOT LET INTO REGIMES 1 AND 2
+        IF(MOL(I).LT.0.)BR(I)=AMIN1(BR(I),0.0)
+!jdf
+        RMOL(I)=-GOVRTH(I)*DTHVDZ*ZA(I)*KARMAN
+!jdf
+
+  260 CONTINUE                                                                   
+
+!                                                                                
+!-----DIAGNOSE BASIC PARAMETERS FOR THE APPROPRIATED STABILITY CLASS:            
+!                                                                                
+!                                                                                
+!     THE STABILITY CLASSES ARE DETERMINED BY BR (BULK RICHARDSON NO.)           
+!     AND HOL (HEIGHT OF PBL/MONIN-OBUKHOV LENGTH).                              
+!                                                                                
+!     CRITERIA FOR THE CLASSES ARE AS FOLLOWS:                                   
+!                                                                                
+!        1. BR .GE. 0.2;                                                         
+!               REPRESENTS NIGHTTIME STABLE CONDITIONS (REGIME=1),               
+!                                                                                
+!        2. BR .LT. 0.2 .AND. BR .GT. 0.0;                                       
+!               REPRESENTS DAMPED MECHANICAL TURBULENT CONDITIONS                
+!               (REGIME=2),                                                      
+!                                                                                
+!        3. BR .EQ. 0.0                                                          
+!               REPRESENTS FORCED CONVECTION CONDITIONS (REGIME=3),              
+!                                                                                
+!        4. BR .LT. 0.0                                                          
+!               REPRESENTS FREE CONVECTION CONDITIONS (REGIME=4).                
+!                                                                                
+!CCCCC                                                                           
+
+      DO 320 I=its,ite
+!CCCCC                                                                           
+!CC     REMOVE REGIME 3 DEPENDENCE ON PBL HEIGHT                                 
+!CC          IF(BR(I).LT.0..AND.HOL(I,J).GT.1.5)GOTO 310                         
+        IF(BR(I).LT.0.)GOTO 310                                                  
+!                                                                                
+!-----CLASS 1; STABLE (NIGHTTIME) CONDITIONS:                                    
+!                                                                                
+        IF(BR(I).LT.0.2)GOTO 270                                                 
+        REGIME(I)=1.                                                           
+        PSIM(I)=-10.*GZ1OZ0(I)                                                   
+!    LOWER LIMIT ON PSI IN STABLE CONDITIONS                                     
+        PSIM(I)=AMAX1(PSIM(I),-10.)                                              
+        PSIH(I)=PSIM(I)                                                          
+        PSIM10(I)=10./ZA(I)*PSIM(I)
+        PSIM10(I)=AMAX1(PSIM10(I),-10.)                               
+        PSIH10(I)=PSIM10(I)                                          
+        PSIM2(I)=2./ZA(I)*PSIM(I)
+        PSIM2(I)=AMAX1(PSIM2(I),-10.)                              
+        PSIH2(I)=PSIM2(I)                                         
+
+!       1.0 over Monin-Obukhov length
+        IF(UST(I).LT.0.01)THEN
+           RMOL(I)=BR(I)*GZ1OZ0(I) !ZA/L
+        ELSE
+           RMOL(I)=KARMAN*GOVRTH(I)*ZA(I)*MOL(I)/(UST(I)*UST(I)) !ZA/L
+        ENDIF
+        RMOL(I)=AMIN1(RMOL(I),9.999) ! ZA/L
+        RMOL(I) = RMOL(I)/ZA(I) !1.0/L
+
+        GOTO 320                                                                 
+!                                                                                
+!-----CLASS 2; DAMPED MECHANICAL TURBULENCE:                                     
+!                                                                                
+  270   IF(BR(I).EQ.0.0)GOTO 280                                                 
+        REGIME(I)=2.                                                           
+        PSIM(I)=-5.0*BR(I)*GZ1OZ0(I)/(1.1-5.0*BR(I))                             
+!    LOWER LIMIT ON PSI IN STABLE CONDITIONS                                     
+        PSIM(I)=AMAX1(PSIM(I),-10.)                                              
+!.....AKB(1976), EQ(16).                                                         
+        PSIH(I)=PSIM(I)                                                          
+        PSIM10(I)=10./ZA(I)*PSIM(I)
+        PSIM10(I)=AMAX1(PSIM10(I),-10.)                               
+        PSIH10(I)=PSIM10(I)                                          
+        PSIM2(I)=2./ZA(I)*PSIM(I)
+        PSIM2(I)=AMAX1(PSIM2(I),-10.)                              
+        PSIH2(I)=PSIM2(I)                                         
+
+        ! Linear form: PSIM = -0.5*ZA/L; e.g, see eqn 16 of
+        ! Blackadar, Modeling the nocturnal boundary layer, Preprints,
+        ! Third Symposium on Atmospheric Turbulence Diffusion and Air Quality,
+        ! Raleigh, NC, 1976
+        ZOL(I) = BR(I)*GZ1OZ0(I)/(1.00001-5.0*BR(I))
+
+        if ( ZOL(I) .GT. 0.5 ) then ! linear form ok
+           ! Holtslag and de Bruin, J. App. Meteor 27, 689-704, 1988;
+           ! see also, Launiainen, Boundary-Layer Meteor 76,165-179, 1995
+           ! Eqn (8) of Launiainen, 1995
+           ZOL(I) = ( 1.89*GZ1OZ0(I) + 44.2 ) * BR(I)*BR(I)    &
+                + ( 1.18*GZ1OZ0(I) - 1.37 ) * BR(I)
+           ZOL(I)=AMIN1(ZOL(I),9.999)
+        end if
+
+        ! 1.0 over Monin-Obukhov length
+        RMOL(I)= ZOL(I)/ZA(I)
+
+        GOTO 320                                                                 
+!                                                                                
+!-----CLASS 3; FORCED CONVECTION:                                                
+!                                                                                
+  280   REGIME(I)=3.                                                           
+        PSIM(I)=0.0                                                              
+        PSIH(I)=PSIM(I)                                                          
+        PSIM10(I)=0.                                                   
+        PSIH10(I)=PSIM10(I)                                           
+        PSIM2(I)=0.                                                  
+        PSIH2(I)=PSIM2(I)                                           
+
+                                                                                 
+        IF(UST(I).LT.0.01)THEN                                                 
+          ZOL(I)=BR(I)*GZ1OZ0(I)                                               
+        ELSE                                                                     
+          ZOL(I)=KARMAN*GOVRTH(I)*ZA(I)*MOL(I)/(UST(I)*UST(I)) 
+        ENDIF                                                                    
+
+        RMOL(I) = ZOL(I)/ZA(I)  
+
+        GOTO 320                                                                 
+!                                                                                
+!-----CLASS 4; FREE CONVECTION:                                                  
+!                                                                                
+  310   CONTINUE                                                                 
+        REGIME(I)=4.                                                           
+        IF(UST(I).LT.0.01)THEN                                                 
+          ZOL(I)=BR(I)*GZ1OZ0(I)                                               
+        ELSE                                                                     
+          ZOL(I)=KARMAN*GOVRTH(I)*ZA(I)*MOL(I)/(UST(I)*UST(I))
+        ENDIF                                                                    
+        ZOL10=10./ZA(I)*ZOL(I)                                    
+        ZOL2=2./ZA(I)*ZOL(I)                                     
+        ZOL(I)=AMIN1(ZOL(I),0.)                                              
+        ZOL(I)=AMAX1(ZOL(I),-9.9999)                                         
+        ZOL10=AMIN1(ZOL10,0.)                                          
+        ZOL10=AMAX1(ZOL10,-9.9999)                                    
+        ZOL2=AMIN1(ZOL2,0.)                                          
+        ZOL2=AMAX1(ZOL2,-9.9999)                                    
+        NZOL=INT(-ZOL(I)*100.)                                                 
+        RZOL=-ZOL(I)*100.-NZOL                                                 
+        NZOL10=INT(-ZOL10*100.)                                        
+        RZOL10=-ZOL10*100.-NZOL10                                     
+        NZOL2=INT(-ZOL2*100.)                                        
+        RZOL2=-ZOL2*100.-NZOL2                                      
+        PSIM(I)=PSIMTB(NZOL)+RZOL*(PSIMTB(NZOL+1)-PSIMTB(NZOL))                  
+        PSIH(I)=PSIHTB(NZOL)+RZOL*(PSIHTB(NZOL+1)-PSIHTB(NZOL))                  
+        PSIM10(I)=PSIMTB(NZOL10)+RZOL10*(PSIMTB(NZOL10+1)-PSIMTB(NZOL10))                                                    
+        PSIH10(I)=PSIHTB(NZOL10)+RZOL10*(PSIHTB(NZOL10+1)-PSIHTB(NZOL10))
+        PSIM2(I)=PSIMTB(NZOL2)+RZOL2*(PSIMTB(NZOL2+1)-PSIMTB(NZOL2))    
+        PSIH2(I)=PSIHTB(NZOL2)+RZOL2*(PSIHTB(NZOL2+1)-PSIHTB(NZOL2))   
+
+!---LIMIT PSIH AND PSIM IN THE CASE OF THIN LAYERS AND HIGH ROUGHNESS            
+!---  THIS PREVENTS DENOMINATOR IN FLUXES FROM GETTING TOO SMALL                 
+!       PSIH(I)=AMIN1(PSIH(I),0.9*GZ1OZ0(I))                                     
+!       PSIM(I)=AMIN1(PSIM(I),0.9*GZ1OZ0(I))                                     
+        PSIH(I)=AMIN1(PSIH(I),0.9*GZ1OZ0(I))
+        PSIM(I)=AMIN1(PSIM(I),0.9*GZ1OZ0(I))
+        PSIH2(I)=AMIN1(PSIH2(I),0.9*GZ2OZ0(I))
+        PSIM10(I)=AMIN1(PSIM10(I),0.9*GZ10OZ0(I))
+
+        RMOL(I) = ZOL(I)/ZA(I)  
+
+  320 CONTINUE                                                                   
+!                                                                                
+!-----COMPUTE THE FRICTIONAL VELOCITY:                                           
+!     ZA(1982) EQS(2.60),(2.61).                                                 
+!                                                                                
+      DO 330 I=its,ite
+        DTG=THX(I)-THGB(I)                                                   
+        PSIX=GZ1OZ0(I)-PSIM(I)                                                   
+        PSIX10=GZ10OZ0(I)-PSIM10(I)
+!     LOWER LIMIT ADDED TO PREVENT LARGE FLHC IN SOIL MODEL
+!     ACTIVATES IN UNSTABLE CONDITIONS WITH THIN LAYERS OR HIGH Z0
+        PSIT=AMAX1(GZ1OZ0(I)-PSIH(I),2.)
+
+        IF((XLAND(I)-1.5).GE.0)THEN                                            
+          ZL=ZNT(I)                                                            
+        ELSE                                                                     
+          ZL=0.01                                                                
+        ENDIF                                                                    
+        PSIQ=ALOG(KARMAN*UST(I)*ZA(I)/XKA+ZA(I)/ZL)-PSIH(I)   
+        PSIT2=GZ2OZ0(I)-PSIH2(I)                                     
+        PSIQ2=ALOG(KARMAN*UST(I)*2./XKA+2./ZL)-PSIH2(I)                                   
+! TO PREVENT OSCILLATIONS AVERAGE WITH OLD VALUE 
+        UST(I)=0.5*UST(I)+0.5*KARMAN*WSPD(I)/PSIX                                             
+        U10(I)=UX(I)*PSIX10/PSIX                                    
+        V10(I)=VX(I)*PSIX10/PSIX                                   
+        TH2(I)=THGB(I)+DTG*PSIT2/PSIT                                
+        Q2(I)=QSFC(I)+(QX(I)-QSFC(I))*PSIQ2/PSIQ                   
+        T2(I) = TH2(I)*(PSFC(I)/100.)**ROVCP                     
+!       LATER Q2 WILL BE OVERWRITTEN FOR LAND POINTS IN SURFCE     
+!       QA2(I,J) = Q2(I)                                         
+!       UA10(I,J) = U10(I)                                      
+!       VA10(I,J) = V10(I)                                     
+!       write(*,1002)UST(I),KARMAN*WSPD(I),PSIX,KARMAN*WSPD(I)/PSIX
+!                                                                                
+        IF(ABS(U10(I)) .GT. 1.E-10) THEN
+           uratx(I) = UX(I)/U10(I)
+        ELSE
+           uratx(I) = 1.2
+        END IF
+        IF(ABS(V10(I)) .GT. 1.E-10) THEN
+           vratx(I) = VX(I)/V10(I)
+        ELSE
+           vratx(I) = 1.2 
+        END IF
+        tratx(I) = THX(I)/TH2(I)
+
+        USTM=AMAX1(UST(I),0.1)                                                 
+        IF((XLAND(I)-1.5).GE.0)THEN                                            
+          UST(I)=UST(I)                                                      
+        ELSE                                                                     
+          UST(I)=USTM                                                          
+        ENDIF                                                                    
+!       write(*,1002)UST(I),USTM,I,J
+ 1002   format(f15.12,2x,f15.12,2x,f15.12,2x,f15.12,2x,f15.12)
+        MOL(I)=KARMAN*DTG/PSIT/PRT                              
+  330 CONTINUE                                                                   
+!                                                                                
+  335 CONTINUE                                                                   
+                                                                                  
+!-----COMPUTE THE SURFACE SENSIBLE AND LATENT HEAT FLUXES:                       
+                                                                                 
+      DO i=its,ite
+        QFX(i)=0.                                                              
+        HFX(i)=0.                                                              
+      ENDDO
+
+      IF (ISFFLX.EQ.0) GOTO 410                                                
+                                                                                 
+!-----OVER WATER, ALTER ROUGHNESS LENGTH (ZNT) ACCORDING TO WIND (UST).          
+                                                                                 
+      DO 360 I=its,ite
+        IF((XLAND(I)-1.5).GE.0)THEN                                            
+          ZNT(I)=CZO*UST(I)*UST(I)/G+OZO                                   
+        ENDIF                                                                    
+        IF((XLAND(I)-1.5).GE.0)THEN                                            
+          ZL=ZNT(I)                                                            
+        ELSE                                                                     
+          ZL=0.01                                                                
+        ENDIF                                                                    
+        FLQC(I)=RHOX(I)*MAVAIL(I)*UST(I)*KARMAN/(   & 
+                ALOG(KARMAN*UST(I)*ZA(I)/XKA+ZA(I)/ZL)-PSIH(I))          
+        DTTHX=ABS(THX(I)-THGB(I))                                            
+        IF(DTTHX.GT.1.E-5)THEN                                                   
+          FLHC(I)=CPM(I)*RHOX(I)*UST(I)*MOL(I)/(THX(I)-THGB(I))          
+!         write(*,1001)FLHC(I),CPM(I),RHOX(I),UST(I),MOL(I),THX(I),THGB(I),I
+ 1001   format(f8.5,2x,f12.7,2x,f12.10,2x,f12.10,2x,f13.10,2x,f12.8,f12.8,2x,i3)
+        ELSE                                                                     
+          FLHC(I)=0.                                                             
+        ENDIF                                                                    
+  360 CONTINUE                                                                   
+
+!                                                                                
+!-----COMPUTE SURFACE MOIST FLUX:                                                
+!                                                                                
+!     IF(IDRY.EQ.1)GOTO 390                                                
+!                                                                                
+      DO 370 I=its,ite
+        QFX(I)=FLQC(I)*(QSFC(I)-QX(I))                                     
+        QFX(I)=AMAX1(QFX(I),0.)                                            
+        LH(I)=XLV*QFX(I)
+  370 CONTINUE                                                                 
+                                                                                
+!-----COMPUTE SURFACE HEAT FLUX:                                                 
+!                                                                                
+  390 CONTINUE                                                                 
+      DO 400 I=its,ite
+        IF(XLAND(I)-1.5.GT.0.)THEN                                           
+          HFX(I)=FLHC(I)*(THGB(I)-THX(I))                                
+        ELSEIF(XLAND(I)-1.5.LT.0.)THEN                                       
+          HFX(I)=FLHC(I)*(THGB(I)-THX(I))                                
+          HFX(I)=AMAX1(HFX(I),-250.)                                       
+        ENDIF                                                                  
+  400 CONTINUE                                                                 
+         
+      DO I=its,ite
+         IF((XLAND(I)-1.5).GE.0)THEN
+           ZL=ZNT(I)
+         ELSE
+           ZL=0.01
+         ENDIF
+         CHS(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*ZA(I) &
+                /XKA+ZA(I)/ZL)-PSIH(I))
+!        GZ2OZ0(I)=ALOG(2./ZNT(I))
+!        PSIM2(I)=-10.*GZ2OZ0(I)
+!        PSIM2(I)=AMAX1(PSIM2(I),-10.)
+!        PSIH2(I)=PSIM2(I)
+         CQS2(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*2.0  &
+               /XKA+2.0/ZL)-PSIH2(I))
+         CHS2(I)=UST(I)*KARMAN/(GZ2OZ0(I)-PSIH2(I))
+      ENDDO
+                                                                        
+  410 CONTINUE                                                                   
+!jdf
+!     DO I=its,ite
+!       IF(UST(I).GE.0.1) THEN
+!         RMOL(I)=RMOL(I)*(-FLHC(I))/(UST(I)*UST(I)*UST(I))
+!       ELSE
+!         RMOL(I)=RMOL(I)*(-FLHC(I))/(0.1*0.1*0.1)
+!       ENDIF
+!     ENDDO
+!jdf
+
+!                                                                                
+   END SUBROUTINE SFCLAY1D
+
+!====================================================================
+   SUBROUTINE sfclayinit( allowed_to_read )         
+
+   LOGICAL , INTENT(IN)      ::      allowed_to_read
+   INTEGER                   ::      N
+   REAL                      ::      ZOLN,X,Y
+
+   DO N=0,1000
+      ZOLN=-FLOAT(N)*0.01
+      X=(1-16.*ZOLN)**0.25
+      PSIMTB(N)=2*ALOG(0.5*(1+X))+ALOG(0.5*(1+X*X))- &
+                2.*ATAN(X)+2.*ATAN(1.)
+      Y=(1-16*ZOLN)**0.5
+      PSIHTB(N)=2*ALOG(0.5*(1+Y))
+   ENDDO
+
+   END SUBROUTINE sfclayinit
+
+!-------------------------------------------------------------------          
+
+END MODULE module_sf_sfclay
Index: trunk/WRF.COMMON/WRFV2/phys/module_sf_slab.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_sf_slab.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_sf_slab.F	(revision 2744)
@@ -0,0 +1,538 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+MODULE module_sf_slab
+
+   !---SPECIFY CONSTANTS AND LAYERS FOR SOIL MODEL
+   !---SOIL DIFFUSION CONSTANT SET (M^2/S)
+
+   REAL, PARAMETER :: DIFSL=5.e-7
+
+   !---FACTOR TO MAKE SOIL STEP MORE CONSERVATIVE
+
+   REAL , PARAMETER :: SOILFAC=1.25
+
+CONTAINS
+
+!----------------------------------------------------------------
+   SUBROUTINE SLAB(T3D,QV3D,P3D,FLHC,FLQC,                      &
+                   PSFC,XLAND,TMN,HFX,QFX,LH,TSK,QSFC,CHKLOWQ,  &
+                   GSW,GLW,CAPG,THC,SNOWC,EMISS,MAVAIL,         &
+                   DELTSM,ROVCP,XLV,DTMIN,IFSNOW,               &
+                   SVP1,SVP2,SVP3,SVPT0,EP2,                    &
+                   KARMAN,EOMEG,STBOLT,                         &
+                   TSLB,ZS,DZS,num_soil_layers,radiation,       &
+                   ids,ide, jds,jde, kds,kde,                   &
+                   ims,ime, jms,jme, kms,kme,                   &
+                   its,ite, jts,jte, kts,kte                    )
+!----------------------------------------------------------------
+    IMPLICIT NONE
+!----------------------------------------------------------------
+!                                                                        
+!     SUBROUTINE SLAB CALCULATES THE GROUND TEMPERATURE TENDENCY 
+!     ACCORDING TO THE RESIDUAL OF THE SURFACE ENERGY BUDGET           
+!     (BLACKADAR, 1978B).                                              
+!                                                                      
+!     CHANGES:                                                         
+!          FOR SOIL SUB-TIMESTEPS UPDATE SURFACE HFX AND QFX AS TG     
+!          CHANGES TO PREVENT POSSIBLE INSTABILITY FOR LONG MODEL      
+!          STEPS (DT > ~200 SEC).                                      
+!                                                                      
+!          PUT SNOW COVER CHECK ON SOIL SUB-TIMESTEPS                  
+!                                                                      
+!          MAKE UPPER LIMIT ON SOIL SUB-STEP LENGTH MORE CONSERVATIVE  
+!                                                                      
+!----------------------------------------------------------------          
+!-- T3D         temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!-- P3D         3D pressure (Pa)
+!-- FLHC        exchange coefficient for heat (m/s)
+!-- FLQC        exchange coefficient for moisture (m/s)
+!-- PSFC        surface pressure (Pa)
+!-- XLAND       land mask (1 for land, 2 for water)
+!-- TMN         soil temperature at lower boundary (K)
+!-- HFX         upward heat flux at the surface (W/m^2)
+!-- QFX         upward moisture flux at the surface (kg/m^2/s)
+!-- LH          latent heat flux at the surface (W/m^2)
+!-- TSK         surface temperature (K)
+!-- GSW         downward short wave flux at ground surface (W/m^2)      
+!-- GLW         downward long wave flux at ground surface (W/m^2)
+!-- CAPG        heat capacity for soil (J/K/m^3)
+!-- THC         thermal inertia (Cal/cm/K/s^0.5)
+!-- SNOWC       flag indicating snow coverage (1 for snow cover)
+!-- EMISS       surface emissivity (between 0 and 1)
+!-- DELTSM      time step (second)
+!-- ROVCP       R/CP
+!-- XLV         latent heat of melting (J/kg)
+!-- DTMIN       time step (minute)
+!-- IFSNOW      ifsnow=1 for snow-cover effects
+!-- SVP1        constant for saturation vapor pressure (kPa)
+!-- SVP2        constant for saturation vapor pressure (dimensionless)
+!-- SVP3        constant for saturation vapor pressure (K)
+!-- SVPT0       constant for saturation vapor pressure (K)
+!-- EP1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
+!-- EP2         constant for specific humidity calculation 
+!               (R_d/R_v) (dimensionless)
+!-- KARMAN      Von Karman constant
+!-- EOMEG       angular velocity of earth's rotation (rad/s)
+!-- STBOLT      Stefan-Boltzmann constant (W/m^2/K^4)
+!-- TSLB        soil temperature in 5-layer model
+!-- ZS          depths of centers of soil layers
+!-- DZS         thicknesses of soil layers
+!-- num_soil_layers   the number of soil layers
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!----------------------------------------------------------------
+   INTEGER,  INTENT(IN   )   ::     ids,ide, jds,jde, kds,kde,  &
+                                    ims,ime, jms,jme, kms,kme,  &
+                                    its,ite, jts,jte, kts,kte
+
+   INTEGER, INTENT(IN)       ::     num_soil_layers
+   LOGICAL, INTENT(IN)       ::     radiation
+
+   INTEGER,  INTENT(IN   )   ::     IFSNOW
+
+!
+   REAL,     INTENT(IN   )   ::     DTMIN,XLV,ROVCP,DELTSM
+
+   REAL,     INTENT(IN )     ::     SVP1,SVP2,SVP3,SVPT0
+   REAL,     INTENT(IN )     ::     EP2,KARMAN,EOMEG,STBOLT
+
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
+             INTENT(INOUT)   :: TSLB
+
+   REAL,     DIMENSION(1:num_soil_layers), INTENT(IN)::ZS,DZS
+
+   REAL,    DIMENSION( ims:ime, kms:kme, jms:jme )            , &
+            INTENT(IN   )    ::                           QV3D, &
+                                                           P3D, &
+                                                           T3D
+!
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(IN   )    ::                          SNOWC, &
+                                                         XLAND, &
+                                                         EMISS, &
+                                                        MAVAIL, &
+                                                           TMN, &
+                                                           GSW, &
+                                                           GLW, &
+                                                           THC
+
+!CHKLOWQ is declared as memory size
+!
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                            HFX, &
+                                                           QFX, &
+                                                            LH, &
+                                                          CAPG, &
+                                                           TSK, &
+                                                          QSFC, &
+                                                       CHKLOWQ
+
+   REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+             INTENT(IN   )               ::               PSFC
+!
+   REAL,    DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) ::     &
+                                                          FLHC, &
+                                                          FLQC
+
+! LOCAL VARS
+
+   REAL,     DIMENSION( its:ite ) ::                      QV1D, &
+                                                           P1D, &
+                                                           T1D
+   INTEGER ::  I,J
+
+   DO J=jts,jte
+
+      DO i=its,ite
+         T1D(i) =T3D(i,1,j)
+         QV1D(i)=QV3D(i,1,j)
+         P1D(i) =P3D(i,1,j)
+      ENDDO
+
+! the indices to the PSFC argument in the following call look
+! wrong; however, it is correct to call with its (and not ims)
+! because of the way PSFC is defined in SLAB1D. Whether *that*
+! is a good idea or not, this commenter cannot comment. JM
+
+      CALL SLAB1D(J,T1D,QV1D,P1D,FLHC(ims,j),FLQC(ims,j),       &
+           PSFC(its,j),XLAND(ims,j),TMN(ims,j),HFX(ims,j),      &
+           QFX(ims,j),TSK(ims,j),QSFC(ims,j),CHKLOWQ(ims,j),    &
+           LH(ims,j),GSW(ims,j),GLW(ims,j),                     &
+           CAPG(ims,j),THC(ims,j),SNOWC(ims,j),EMISS(ims,j),    &
+           MAVAIL(ims,j),DELTSM,ROVCP,XLV,DTMIN,IFSNOW,         &
+           SVP1,SVP2,SVP3,SVPT0,EP2,KARMAN,EOMEG,STBOLT,        &
+           TSLB(ims,1,j),ZS,DZS,num_soil_layers,radiation,      &
+           ids,ide, jds,jde, kds,kde,                           &
+           ims,ime, jms,jme, kms,kme,                           &
+           its,ite, jts,jte, kts,kte                            )
+
+   ENDDO
+
+   END SUBROUTINE SLAB
+
+!----------------------------------------------------------------
+   SUBROUTINE SLAB1D(J,T1D,QV1D,P1D,FLHC,FLQC,                  &
+                   PSFCPA,XLAND,TMN,HFX,QFX,TSK,QSFC,CHKLOWQ,   &
+                   LH,GSW,GLW,CAPG,THC,SNOWC,EMISS,MAVAIL,      &
+                   DELTSM,ROVCP,XLV,DTMIN,IFSNOW,               &
+                   SVP1,SVP2,SVP3,SVPT0,EP2,                    &
+                   KARMAN,EOMEG,STBOLT,                         &
+                   TSLB2D,ZS,DZS,num_soil_layers,radiation,     &
+                   ids,ide, jds,jde, kds,kde,                   &
+                   ims,ime, jms,jme, kms,kme,                   &
+                   its,ite, jts,jte, kts,kte                    )
+!----------------------------------------------------------------
+    IMPLICIT NONE
+!----------------------------------------------------------------
+!                                                                        
+!     SUBROUTINE SLAB CALCULATES THE GROUND TEMPERATURE TENDENCY 
+!     ACCORDING TO THE RESIDUAL OF THE SURFACE ENERGY BUDGET           
+!     (BLACKADAR, 1978B).                                              
+!                                                                      
+!     CHANGES:                                                         
+!          FOR SOIL SUB-TIMESTEPS UPDATE SURFACE HFX AND QFX AS TG     
+!          CHANGES TO PREVENT POSSIBLE INSTABILITY FOR LONG MODEL      
+!          STEPS (DT > ~200 SEC).                                      
+!                                                                      
+!          PUT SNOW COVER CHECK ON SOIL SUB-TIMESTEPS                  
+!                                                                      
+!          MAKE UPPER LIMIT ON SOIL SUB-STEP LENGTH MORE CONSERVATIVE  
+!                                                                      
+!----------------------------------------------------------------          
+
+   INTEGER,  INTENT(IN   )   ::     ids,ide, jds,jde, kds,kde,  &
+                                    ims,ime, jms,jme, kms,kme,  &
+                                    its,ite, jts,jte, kts,kte,J 
+
+   INTEGER , INTENT(IN)      ::     num_soil_layers
+   LOGICAL,  INTENT(IN   )   ::     radiation
+
+   INTEGER,  INTENT(IN   )   ::     IFSNOW
+!
+   REAL,     INTENT(IN   )   ::     DTMIN,XLV,ROVCP,DELTSM
+
+   REAL,     INTENT(IN )     ::     SVP1,SVP2,SVP3,SVPT0
+   REAL,     INTENT(IN )     ::     EP2,KARMAN,EOMEG,STBOLT
+
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers ),          &
+             INTENT(INOUT)   :: TSLB2D
+
+   REAL,     DIMENSION(1:num_soil_layers), INTENT(IN)::ZS,DZS
+
+!
+   REAL,    DIMENSION( ims:ime )                              , &
+            INTENT(INOUT)    ::                            HFX, &
+                                                           QFX, &
+                                                            LH, &
+                                                          CAPG, &
+                                                           TSK, &
+                                                          QSFC, &
+                                                       CHKLOWQ
+!
+   REAL,    DIMENSION( ims:ime )                              , &
+            INTENT(IN   )    ::                          SNOWC, &
+                                                         XLAND, &
+                                                         EMISS, &
+                                                        MAVAIL, &
+                                                           TMN, &
+                                                           GSW, &
+                                                           GLW, &
+                                                           THC
+!
+   REAL,    DIMENSION( its:ite )                              , &
+            INTENT(IN   )    ::                           QV1D, &
+                                                           P1D, &
+                                                           T1D
+!
+   REAL,     DIMENSION( its:ite )                             , &
+             INTENT(IN   )               ::             PSFCPA
+
+!
+   REAL,    DIMENSION( ims:ime ), INTENT(INOUT) ::              &
+                                                          FLHC, &
+                                                          FLQC
+! LOCAL VARS
+
+   REAL,    DIMENSION( its:ite )          ::              PSFC
+
+   REAL,    DIMENSION( its:ite )          ::                    &
+                                                           THX, &
+                                                            QX, &
+                                                          SCR3 
+
+   REAL,    DIMENSION( its:ite )          ::            DTHGDT, &
+                                                           TG0, &
+                                                         THTMN, &
+                                                          XLD1, &
+                                                         TSCVN, &
+                                                          OLTG, &
+                                                        UPFLUX, &
+                                                            HM, &
+                                                          RNET, &
+                                                         XINET, &
+                                                            QS, &
+                                                         DTSDT
+!
+   REAL, DIMENSION( its:ite, num_soil_layers )        :: FLUX
+!
+   INTEGER :: I,K,NSOIL,ITSOIL,L,NK,RADSWTCH
+   REAL    :: PS,PS1,XLDCOL,TSKX,RNSOIL,RHOG1,RHOG2,RHOG3,LAMDAG
+   REAL    :: THG,ESG,QSG,HFXT,QFXT,CS,CSW,LAMG(4),THCON,PL
+ 
+!----------------------------------------------------------------------          
+!-----DETERMINE IF ANY POINTS IN COLUMN ARE LAND (RATHER THAN OCEAN)             
+!       POINTS.  IF NOT, SKIP DOWN TO THE PRINT STATEMENTS SINCE OCEAN           
+!       SURFACE TEMPERATURES ARE NOT ALLOWED TO CHANGE.                          
+!                                                                                
+! from sfcrad   
+!----------------------------------------------------------------------
+   DATA CSW/4.183E6/
+   DATA LAMG/1.407E-8, -1.455E-5, 6.290E-3, 0.16857/
+
+   DO i=its,ite
+! in cmb
+      PSFC(I)=PSFCPA(I)/1000.
+   ENDDO
+
+
+      DO I=its,ite
+! PL cmb
+         PL=P1D(I)/1000.
+         SCR3(I)=T1D(I)
+         THCON=(100./PL)**ROVCP
+         THX(I)=SCR3(I)*THCON
+         QX(I)=0.
+      ENDDO
+
+!     IF(IDRY.EQ.1) GOTO 81
+      DO I=its,ite
+         QX(I)=QV1D(I)
+      ENDDO
+   81 CONTINUE
+
+!
+!-----THE SLAB THERMAL CAPACITY CAPG(I) ARE DEPENDENT ON:
+!     THC(I) - SOIL THERMAL INERTIAL, ONLY.
+!
+      DO I=its,ite
+         CAPG(I)=3.298E6*THC(I)
+         IF(num_soil_layers .gt. 1)THEN
+
+! CAPG REPRESENTS SOIL HEAT CAPACITY (J/K/M^3) WHEN DIFSL=5.E-7 (M^2/S)
+! TO GIVE A CORRECT THERMAL INERTIA (=CAPG*DIFSL^0.5)
+
+            CAPG(I)=5.9114E7*THC(I)
+         ENDIF
+      ENDDO
+!        
+      XLDCOL=2.0                                                                 
+      DO 10 I=its,ite
+        XLDCOL=AMIN1(XLDCOL,XLAND(I))                                          
+   10 CONTINUE                                                                   
+!                                                                                
+      IF(XLDCOL.GT.1.5)GOTO 90                                                   
+!                                                                                
+!                                                                                
+!-----CONVERT SLAB TEMPERATURE TO POTENTIAL TEMPERATURE AND                      
+!     SET XLD1(I) = 0. FOR OCEAN POINTS:                                         
+!                                                                                
+!                                                                                
+      DO 20 I=its,ite
+        IF((XLAND(I)-1.5).GE.0)THEN                                            
+          XLD1(I)=0.                                                             
+        ELSE                                                                     
+          XLD1(I)=1.                                                             
+        ENDIF                                                                    
+   20 CONTINUE                                                                   
+!                                                                                
+!-----CONVERT 'TSK(THETAG)' TO 'TG' FOR 'IUP' CALCULATION ....                   
+!       IF WE ARE USING THE BLACKADAR MULTI-LEVEL (HIGH-RESOLUTION)              
+!       PBL MODEL                                                                
+!                                                                                
+      DO 50 I=its,ite
+        IF(XLD1(I).LT.0.5)GOTO 50                                                
+
+! PS cmb
+        PS=PSFC(I)
+
+! TSK is Temperature at gound sfc
+!       TG0(I)=TSK(I)*(PS*0.01)**ROVCP                                         
+        TG0(I)=TSK(I)
+   50 CONTINUE                                                                   
+!                                                                                
+!-----COMPUTE THE SURFACE ENERGY BUDGET:                                         
+!                                                                                
+!     IF(ISOIL.EQ.1)NSOIL=1                                                      
+      IF(num_soil_layers .gt. 1)NSOIL=1                                                      
+
+
+      IF (radiation) then
+        RADSWTCH=1
+      ELSE
+        RADSWTCH=0
+      ENDIF
+
+      DO 70 I=its,ite
+        IF(XLD1(I).LT.0.5)GOTO 70
+        OLTG(I)=TSK(I)*(100./PSFC(I))**ROVCP
+        UPFLUX(I)=RADSWTCH*STBOLT*TG0(I)**4                            
+        XINET(I)=EMISS(I)*(GLW(I)-UPFLUX(I))    
+        RNET(I)=GSW(I)+XINET(I)                                                
+        HM(I)=1.18*EOMEG*(TG0(I)-TMN(I))                                       
+!       MOISTURE FLUX CALCULATED HERE (OVERWRITES SFC LAYER VALUE FOR LAND)
+                ESG=SVP1*EXP(SVP2*(TG0(I)-SVPT0)/(TG0(I)-SVP3))
+                QSG=EP2*ESG/(PSFC(I)-ESG)
+                QFX(I)=FLQC(I)*(QSG-QX(I))
+                LH(I)=QFX(I)*XLV
+        QS(I)=HFX(I)+QFX(I)*XLV                                
+!       IF(ISOIL.EQ.0)THEN                                                       
+        IF(num_soil_layers .EQ. 1)THEN                                                       
+          DTHGDT(I)=(RNET(I)-QS(I))/CAPG(I)-HM(I)                              
+        ELSE
+          DTHGDT(I)=0.                                                           
+        ENDIF                                                                    
+   70 CONTINUE                                                                   
+!     IF(ISOIL.EQ.1)THEN                                                         
+      IF(num_soil_layers .gt. 1)THEN                                                         
+        NSOIL=1+IFIX(SOILFAC*4*DIFSL/DZS(1)*DELTSM/DZS(1))   
+        RNSOIL=1./FLOAT(NSOIL)                                                   
+!                                                                                
+!     SOIL SUB-TIMESTEP                                                          
+!                                                                                
+        DO ITSOIL=1,NSOIL                                                        
+          DO I=its,ite
+             DO L=1,num_soil_layers-1
+              IF(XLD1(I).LT.0.5)GOTO 75                                          
+              IF(L.EQ.1.AND.ITSOIL.GT.1)THEN                                     
+                PS1=(PSFC(I)*0.01)**ROVCP    
+
+! for rk scheme A and B are the same
+                PS=PSFC(I)
+                THG=TSLB2D(I,1)/PS1                                              
+                ESG=SVP1*EXP(SVP2*(TSLB2D(I,1)-SVPT0)/(TSLB2D(I,1) & 
+                    -SVP3))                                                      
+                QSG=EP2*ESG/(PS-ESG)                                             
+!     UPDATE FLUXES FOR NEW GROUND TEMPERATURE                                   
+                HFXT=FLHC(I)*(THG-THX(I))                                     
+                QFXT=FLQC(I)*(QSG-QX(I))
+                QS(I)=HFXT+QFXT*XLV                                
+!     SUM HFX AND QFX OVER SOIL TIMESTEPS                                        
+                HFX(I)=HFX(I)+HFXT                                           
+                QFX(I)=QFX(I)+QFXT                                           
+              ENDIF                                                              
+              FLUX(I,1)=RNET(I)-QS(I)                                            
+              FLUX(I,L+1)=-DIFSL*CAPG(I)*(TSLB2D(I,L+1)-TSLB2D(I,L))/( & 
+                          ZS(L+1)-ZS(L))                                         
+              DTSDT(I)=-(FLUX(I,L+1)-FLUX(I,L))/(DZS(L)*CAPG(I))               
+              TSLB2D(I,L)=TSLB2D(I,L)+DTSDT(I)*DELTSM*RNSOIL                     
+              IF(IFSNOW.EQ.1.AND.L.EQ.1)THEN                              
+                IF((SNOWC(I).GT.0..AND.TSLB2D(I,1).GT.273.16))THEN             
+                  TSLB2D(I,1)=273.16                                             
+                ENDIF                                                            
+              ENDIF                                                              
+              IF(L.EQ.1)DTHGDT(I)=DTHGDT(I)+RNSOIL*DTSDT(I)                      
+              IF(ITSOIL.EQ.NSOIL.AND.L.EQ.1)THEN                                 
+!     AVERAGE HFX AND QFX OVER SOIL TIMESTEPS FOR OUTPUT TO PBL                  
+                HFX(I)=HFX(I)*RNSOIL                                         
+                QFX(I)=QFX(I)*RNSOIL                                         
+                LH(I)=QFX(I)*XLV
+              ENDIF                                                              
+   75         CONTINUE                                                           
+            ENDDO                                                                
+          ENDDO                                                                  
+        ENDDO                                                                    
+      ENDIF                                                                      
+!                                                                                
+      DO 80 I=its,ite
+        IF(XLD1(I).LT.0.5) GOTO 80                                                
+        TSKX=TG0(I)+DELTSM*DTHGDT(I)                                             
+
+! TSK is temperature
+!       TSK(I)=TSKX*(100./PS1)**ROVCP                                          
+        TSK(I)=TSKX
+   80 CONTINUE                                                                   
+
+!                                                                                
+!-----MODIFY THE THE GROUND TEMPERATURE IF THE SNOW COVER EFFECTS ARE            
+!     CONSIDERED: LIMIT THE GROUND TEMPERATURE UNDER 0 C.                        
+!                                                                                
+      IF(IFSNOW.EQ.0)GOTO 90                                              
+      DO 85 I=its,ite
+        IF(XLD1(I).LT.0.5)GOTO 85                                                
+!       PS1=(PSFC(I)*0.01)**ROVCP             
+!       TSCVN(I)=TSK(I)*PS1                                            
+        TSCVN(I)=TSK(I)
+        IF((SNOWC(I).GT.0..AND.TSCVN(I).GT.273.16))THEN                        
+          TSCVN(I)=273.16                                                        
+        ELSE                                                                     
+          TSCVN(I)=TSCVN(I)                                                      
+        ENDIF                                                                    
+!       TSK(I)=TSCVN(I)/PS1                                                    
+        TSK(I)=TSCVN(I)
+   85 CONTINUE                                                                   
+!                                                                                
+   90 CONTINUE                                                                   
+      DO I=its,ite
+! QSFC and CHKLOWQ needed by Eta PBL
+        QSFC(I)=QX(I)+QFX(I)/FLQC(I)
+        CHKLOWQ(I)=MAVAIL(I)
+      ENDDO
+!                                                                                
+  140 CONTINUE                                                                   
+
+   END SUBROUTINE SLAB1D
+
+!================================================================
+   SUBROUTINE slabinit(TSK,TMN,                                 &
+                       TSLB,ZS,DZS,num_soil_layers,             &
+                       restart, allowed_to_read,                &
+                       ids,ide, jds,jde, kds,kde,               &
+                       ims,ime, jms,jme, kms,kme,               &
+                       its,ite, jts,jte, kts,kte                )
+!----------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------
+   LOGICAL , INTENT(IN)      ::      restart, allowed_to_read
+   INTEGER, INTENT(IN   )    ::      ids,ide, jds,jde, kds,kde, &
+                                     ims,ime, jms,jme, kms,kme, &
+                                     its,ite, jts,jte, kts,kte
+
+   INTEGER, INTENT(IN   )    ::      num_soil_layers
+!   
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), INTENT(INOUT) :: TSLB
+
+   REAL,     DIMENSION(1:num_soil_layers), INTENT(IN)  ::  ZS,DZS
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(IN)    ::                            TSK, &
+                                                           TMN
+!  LOCAR VAR
+
+   INTEGER                   ::      L,J,I,itf,jtf
+!----------------------------------------------------------------
+ 
+   itf=min0(ite,ide-1)
+   jtf=min0(jte,jde-1)
+
+   END SUBROUTINE slabinit
+
+!-------------------------------------------------------------------          
+
+END MODULE module_sf_slab
Index: trunk/WRF.COMMON/WRFV2/phys/module_sf_urban.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_sf_urban.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_sf_urban.F	(revision 2744)
@@ -0,0 +1,1695 @@
+MODULE module_sf_urban
+
+!===============================================================================
+!     Single-Layer Urban Canopy Model for WRF Noah-LSM
+!     Original Version: 2002/11/06 by Hiroyuki Kusaka
+!     Last Update:      2006/08/24 by Fei Chen and Mukul Tewari (NCAR/RAL)  
+!===============================================================================
+
+   CHARACTER(LEN=4)                :: LU_DATA_TYPE
+
+   INTEGER                         :: ICATE
+
+   REAL, ALLOCATABLE, DIMENSION(:) :: ZR_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: Z0C_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: Z0HC_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: ZDC_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: SVF_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: R_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: RW_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: HGT_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: CDS_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: AS_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: AH_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: BETR_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: BETB_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: BETG_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: FRC_URB_TBL
+
+   REAL                            :: CAPR_DATA, CAPB_DATA, CAPG_DATA
+   REAL                            :: AKSR_DATA, AKSB_DATA, AKSG_DATA
+   REAL                            :: ALBR_DATA, ALBB_DATA, ALBG_DATA
+   REAL                            :: EPSR_DATA, EPSB_DATA, EPSG_DATA
+   REAL                            :: Z0R_DATA,  Z0B_DATA,  Z0G_DATA
+   REAL                            :: Z0HR_DATA, Z0HB_DATA, Z0HG_DATA
+   REAL                            :: TRLEND_DATA, TBLEND_DATA, TGLEND_DATA
+
+   INTEGER                         :: BOUNDR_DATA,BOUNDB_DATA,BOUNDG_DATA
+   INTEGER                         :: CH_SCHEME_DATA, TS_SCHEME_DATA
+
+   INTEGER                         :: allocate_status 
+
+!   INTEGER                         :: num_roof_layers
+!   INTEGER                         :: num_wall_layers
+!   INTEGER                         :: num_road_layers
+
+   CONTAINS
+
+!===============================================================================
+!
+! Author:
+!      Hiroyuki KUSAKA, PhD
+!      University of Tsukuba, JAPAN
+!      (CRIEPI, NCAR/MMM visiting scientist, 2002-2004)
+!      kusaka@ccs.tsukuba.ac.jp
+!
+! Co-Researchers:
+!     Fei CHEN, PhD
+!      NCAR/RAP feichen@ucar.edu
+!     Mukul TEWARI, PhD
+!      NCAR/RAP mukul@ucar.edu
+!
+! Purpose:
+!     Calculate surface temeprature, fluxes, canopy air temperature, and canopy wind
+!
+! Subroutines:
+!     module_sf_urban
+!       |- urban
+!            |- read_param
+!            |- mos or jurges
+!            |- multi_layer or force_restore
+!       |- urban_param_init <-- urban_param.tbl
+!       |- urban_var_init
+!
+! Input Data from WRF [MKS unit]:
+!
+!     UTYPE  [-]     : Urban type. 1=urban, 2=suburban, 3=rural 
+!     TA     [K]     : Potential temperature at 1st wrf level (absolute temp)
+!     QA     [kg/kg] : Mixing ratio at 1st atmospheric level
+!     UA     [m/s]   : Wind speed at 1st atmospheric level
+!     SSG    [W/m/m] : Short wave downward radiation at a flat surface
+!                      Note this is the total of direct and diffusive solar
+!                      downward radiation. If without two components, the
+!                      single solar downward can be used instead.
+!                      SSG = SSGD + SSGQ
+!     LSOLAR [-]     : Indicating the input type of solar downward radiation
+!                      True: both direct and diffusive solar radiation 
+!                      are available
+!                      False: only total downward ridiation is available.
+!     SSGD   [W/m/m] : Direct solar radiation at a flat surface
+!                      if SSGD is not available, one can assume a ratio SRATIO
+!                      (e.g., 0.7), so that SSGD = SRATIO*SSG 
+!     SSGQ   [W/m/m] : Diffuse solar radiation at a flat surface
+!                      If SSGQ is not available, SSGQ = SSG - SSGD
+!     LLG    [W/m/m] : Long wave downward radiation at a flat surface 
+!     RAIN   [mm/h]  : Precipitation
+!     RHOO   [kg/m/m/m] : Air density
+!     ZA     [m]     : First atmospheric level
+!                      as a lowest boundary condition
+!     DECLIN [rad]   : solar declination
+!     COSZ           : = sin(fai)*sin(del)+cos(fai)*cos(del)*cos(omg)
+!     OMG    [rad]   : solar hour angle
+!     XLAT   [deg]   : latitude
+!     DELT   [sec]   : Time step
+!     ZNT    [m]     : Roughnes length
+!
+! Output Data to WRF [MKS unit]:
+!
+!     TS  [K]            : Surface potential temperature (absolute temp)
+!     QS  [-]            : Surface humidity
+!
+!     SH  [W/m/m/]       : Sensible heat flux, = FLXTH*RHOO*CPP
+!     LH  [W/m/m]        : Latent heat flux, = FLXHUM*RHOO*ELL
+!     LH_INEMATIC [kg/m/m/sec]: Moisture Kinematic flux, = FLXHUM*RHOO
+!     SW  [W/m/m]        : Upward shortwave radiation flux, 
+!                          = SSG-SNET*697.7*60. (697.7*60.=100.*100.*4.186)
+!     ALB [-]            : Time-varying albedo
+!     LW  [W/m/m]        : Upward longwave radiation flux, 
+!                          = LNET*697.7*60.-LLG
+!     G   [W/m/m]        : Heat Flux into the Ground
+!     RN  [W/m/m]        : Net radiation
+!
+!     PSIM  [-]          : Diagnostic similarity stability function for momentum
+!     PSIH  [-]          : Diagnostic similarity stability function for heat
+!
+!     TC  [K]            : Diagnostic canopy air temperature
+!     QC  [-]            : Diagnostic canopy humidity
+!
+!     TH2 [K]            : Diagnostic potential temperature at 2 m
+!     Q2  [-]            : Diagnostic humidity at 2 m
+!     U10 [m/s]          : Diagnostic u wind component at 10 m
+!     V10 [m/s]          : Diagnostic v wind component at 10 m
+!
+!     CHS, CHS2 [m/s]    : CH*U at ZA, CH*U at 2 m (not used)
+!
+! Important parameters:
+! Following parameter are assigned in run/urban_param.tbl
+!
+!  ZR  [m]             : roof level (building height)
+!  Z0C [m]             : Roughness length above canyon for momentum (1/10 of ZR)
+!  Z0HC [m]            : Roughness length above canyon for heat (1/10 of Z0C)
+!  ZDC [m]             : Zero plane displacement height (1/5 of ZR)
+!  SVF [-]             : sky view factor. Calculated again in urban_param_init
+!  R   [-]             : building coverage ratio
+!  RW  [-]             : = 1 - R
+!  HGT [-]             : normalized building height
+!  CDS [-]             : drag coefficient by buildings
+!  AS  [1/m]           : buildings volumetric parameter
+!  AH  [cal/cm/cm]     : anthropogenic heat
+!  BETR [-]            : minimum moisture availability of roof
+!  BETB [-]            : minimum moisture availability of building wall
+!  BETG [-]            : minimum moisture availability of road
+!  CAPR[cal/cm/cm/cm/degC]: heat capacity of roof
+!  CAPB[cal/cm/cm/cm/degC]: heat capacity of building wall
+!  CAPG[cal/cm/cm/cm/degC]: heat capacity of road
+!  AKSR [cal/cm/sec/degC] : thermal conductivity of roof
+!  AKSB [cal/cm/sec/degC] : thermal conductivity of building wall
+!  AKSG [cal/cm/sec/degC] : thermal conductivity of road
+!  ALBR [-]               : surface albedo of roof
+!  ALBB [-]               : surface albedo of building wall
+!  ALBG [-]               : surface albedo of road
+!  EPSR [-]               : surface emissivity of roof
+!  EPSB [-]               : surface emissivity of building wall
+!  EPSG [-]               : surface emissivity of road
+!  Z0R [m]                : roughness length for momentum of roof
+!  Z0B [m]                : roughness length for momentum of building wall (only for CH_SCHEME = 1)
+!  Z0G [m]                : roughness length for momentum of road (only for CH_SCHEME = 1)
+!  Z0HR [m]               : roughness length for heat of roof
+!  Z0HB [m]               : roughness length for heat of building wall (only for CH_SCHEME = 1)
+!  Z0HG [m]               : roughness length for heat of roof
+!  num_roof_layers        : number of layers within roof
+!  num_wall_layers        : number of layers within building walls
+!  num_road_layers        : number of layers within below road surface
+!   NOTE: for now, these layers are defined as same as the number of soil layers in namelist.input
+!  DZR [cm]               : thickness of each roof layer
+!  DZB [cm]               : thickness of each building wall layer
+!  DZG [cm]               : thickness of each ground layer
+!  BOUNDR [integer 1 or 2] : Boundary Condition for Roof Layer Temp [1: Zero-Flux, 2: T = Constant]
+!  BOUNDB [integer 1 or 2] : Boundary Condition for Building Wall Layer Temp [1: Zero-Flux, 2: T = Constant]
+!  BOUNDG [integer 1 or 2] : Boundary Condition for Road Layer Temp [1: Zero-Flux, 2: T = Constant]
+!  TRLEND [K]             : lower boundary condition of roof temperature
+!  TBLEND [K]             : lower boundary condition of building temperature
+!  TGLEND [K]             : lower boundary condition of gound temperature
+!  CH_SCHEME [integer 1 or 2] : Sfc exchange scheme used for building wall and road
+!                         [1: M-O Similarity Theory,  2: Empirical Form (recommend)]
+!  TS_SCHEME [integer 1 or 2] : Scheme for computing surface temperature (for roof, wall, and road)
+!                         [1: 4-layer model,  2: Force-Restore method]
+!
+!
+! References:
+!     Kusaka and Kimura (2004) J.Appl.Meteor., vol.43, p1899-1910
+!     Kusaka and Kimura (2004) J.Meteor.Soc.Japan, vol.82, p45-65
+!     Kusaka et al. (2001) Bound.-Layer Meteor., vol.101, p329-358
+!
+! History:
+!     2006/06          modified by H. Kusaka (Univ. Tsukuba), M. Tewari 
+!     2005/10/26,      modified by Fei Chen, Mukul Tewari
+!     2003/07/21 WRF , modified  by H. Kusaka of CRIEPI (NCAR/MMM)
+!     2001/08/26 PhD , modified  by H. Kusaka of CRIEPI (Univ.Tsukuba)
+!     1999/08/25 LCM , developed by H. Kusaka of CRIEPI (Univ.Tsukuba)
+!
+!===============================================================================
+!
+!  subroutine urban:
+!
+!===============================================================================
+
+   SUBROUTINE urban(LSOLAR,                                           & ! L
+                    num_roof_layers,num_wall_layers,num_road_layers,  & ! I
+                    DZR,DZB,DZG,                                      & ! I
+                    UTYPE,TA,QA,UA,U1,V1,SSG,SSGD,SSGQ,LLG,RAIN,RHOO, & ! I
+                    ZA,DECLIN,COSZ,OMG,XLAT,DELT,ZNT,                 & ! I
+                    CHS, CHS2,                                        & ! I
+                    TR, TB, TG, TC, QC, UC,                           & ! H
+                    TRL,TBL,TGL,                                      & ! H
+                    XXXR, XXXB, XXXG, XXXC,                           & ! H
+                    TS,QS,SH,LH,LH_KINEMATIC,                         & ! O
+                    SW,ALB,LW,G,RN,PSIM,PSIH,                         & ! O
+                    GZ1OZ0,                                           & ! O
+                    U10,V10,TH2,Q2,UST                                & ! O
+                    )
+
+   IMPLICIT NONE
+
+   REAL, PARAMETER    :: CP=0.24          ! heat capacity of dry air  [cgs unit]
+   REAL, PARAMETER    :: EL=583.          ! latent heat of vaporation [cgs unit]
+   REAL, PARAMETER    :: SIG=8.17E-11     ! stefun bolzman constant   [cgs unit]
+   REAL, PARAMETER    :: SIG_SI=5.67E-8   !                           [MKS unit]
+   REAL, PARAMETER    :: AK=0.4           ! kalman const.                [-]
+   REAL, PARAMETER    :: PI=3.14159       ! pi                           [-]
+   REAL, PARAMETER    :: TETENA=7.5       ! const. of Tetens Equation    [-]
+   REAL, PARAMETER    :: TETENB=237.3     ! const. of Tetens Equation    [-]
+   REAL, PARAMETER    :: SRATIO=0.75      ! ratio between direct/total solar [-]
+
+   REAL, PARAMETER    :: CPP=1004.5       ! heat capacity of dry air    [J/K/kg]
+   REAL, PARAMETER    :: ELL=2.442E+06    ! latent heat of vaporization [J/kg]
+   REAL, PARAMETER    :: XKA=2.4E-5
+
+!-------------------------------------------------------------------------------
+! C: configuration variables
+!-------------------------------------------------------------------------------
+
+   LOGICAL, INTENT(IN) :: LSOLAR  ! logical    [true=both, false=SSG only]
+
+!  The following variables are also model configuration variables, but are 
+!  defined in the URBAN.TBL and in the contains statement in the top of 
+!  the module_urban_init, so we should not declare them here.
+
+  INTEGER, INTENT(IN) :: num_roof_layers
+  INTEGER, INTENT(IN) :: num_wall_layers
+  INTEGER, INTENT(IN) :: num_road_layers
+
+
+  REAL, INTENT(IN), DIMENSION(1:num_roof_layers) :: DZR ! grid interval of roof layers [cm]
+  REAL, INTENT(IN), DIMENSION(1:num_wall_layers) :: DZB ! grid interval of wall layers [cm]
+  REAL, INTENT(IN), DIMENSION(1:num_road_layers) :: DZG ! grid interval of road layers [cm]
+
+!-------------------------------------------------------------------------------
+! I: input variables from LSM to Urban
+!-------------------------------------------------------------------------------
+
+   INTEGER, INTENT(IN) :: UTYPE ! urban type [urban=1, suburban=2, rural=3]
+
+   REAL, INTENT(IN)    :: TA   ! potential temp at 1st atmospheric level [K]
+   REAL, INTENT(IN)    :: QA   ! mixing ratio at 1st atmospheric level  [kg/kg]
+   REAL, INTENT(IN)    :: UA   ! wind speed at 1st atmospheric level    [m/s]
+   REAL, INTENT(IN)    :: U1   ! u at 1st atmospheric level             [m/s]
+   REAL, INTENT(IN)    :: V1   ! v at 1st atmospheric level             [m/s]
+   REAL, INTENT(IN)    :: SSG  ! downward total short wave radiation    [W/m/m]
+   REAL, INTENT(IN)    :: LLG  ! downward long wave radiation           [W/m/m]
+   REAL, INTENT(IN)    :: RAIN ! precipitation                          [mm/h]
+   REAL, INTENT(IN)    :: RHOO ! air density                            [kg/m^3]
+   REAL, INTENT(IN)    :: ZA   ! first atmospheric level                [m]
+   REAL, INTENT(IN)    :: DECLIN ! solar declination                    [rad]
+   REAL, INTENT(IN)    :: COSZ ! sin(fai)*sin(del)+cos(fai)*cos(del)*cos(omg)
+   REAL, INTENT(IN)    :: OMG  ! solar hour angle                       [rad]
+
+   REAL, INTENT(IN)    :: XLAT ! latitude                               [deg]
+   REAL, INTENT(IN)    :: DELT ! time step                              [s]
+   REAL, INTENT(IN)    :: ZNT  ! roughness length                       [m]
+   REAL, INTENT(IN)    :: CHS,CHS2 ! CH*U at za and 2 m             [m/s]
+
+   REAL, INTENT(INOUT) :: SSGD ! downward direct short wave radiation   [W/m/m]
+   REAL, INTENT(INOUT) :: SSGQ ! downward diffuse short wave radiation  [W/m/m]
+
+!-------------------------------------------------------------------------------
+! O: output variables from Urban to LSM 
+!-------------------------------------------------------------------------------
+
+   REAL, INTENT(OUT) :: TS     ! surface potential temperature    [K]
+   REAL, INTENT(OUT) :: QS     ! surface humidity                 [K]
+   REAL, INTENT(OUT) :: SH     ! sensible heat flux               [W/m/m]
+   REAL, INTENT(OUT) :: LH     ! latent heat flux                 [W/m/m]
+   REAL, INTENT(OUT) :: LH_KINEMATIC ! latent heat, kinetic     [kg/m/m/s]
+   REAL, INTENT(OUT) :: SW     ! upward short wave radiation flux [W/m/m]
+   REAL, INTENT(OUT) :: ALB    ! time-varying albedo            [fraction]
+   REAL, INTENT(OUT) :: LW     ! upward long wave radiation flux  [W/m/m]
+   REAL, INTENT(OUT) :: G      ! heat flux into the ground        [W/m/m]
+   REAL, INTENT(OUT) :: RN     ! net radition                     [W/m/m]
+   REAL, INTENT(OUT) :: PSIM   ! similality stability shear function for momentum
+   REAL, INTENT(OUT) :: PSIH   ! similality stability shear function for heat
+   REAL, INTENT(OUT) :: GZ1OZ0   
+   REAL, INTENT(OUT) :: U10    ! u at 10m                         [m/s]
+   REAL, INTENT(OUT) :: V10    ! u at 10m                         [m/s]
+   REAL, INTENT(OUT) :: TH2    ! potential temperature at 2 m     [K]
+   REAL, INTENT(OUT) :: Q2     ! humidity at 2 m                  [-]
+!m   REAL, INTENT(OUT) :: CHS,CHS2 ! CH*U at za and 2 m             [m/s]
+   REAL, INTENT(OUT) :: UST    ! friction velocity                [m/s]
+
+
+!-------------------------------------------------------------------------------
+! H: Historical (state) variables of Urban : LSM <--> Urban
+!-------------------------------------------------------------------------------
+
+! TR: roof temperature              [K];      TRP: at previous time step [K]
+! TB: building wall temperature     [K];      TBP: at previous time step [K]
+! TG: road temperature              [K];      TGP: at previous time step [K]
+! TC: urban-canopy air temperature  [K];      TCP: at previous time step [K]
+!                                                  (absolute temperature)
+! QC: urban-canopy air mixing ratio [kg/kg];  QCP: at previous time step [kg/kg]
+!
+! XXXR: Monin-Obkhov length for roof          [dimensionless]
+! XXXB: Monin-Obkhov length for building wall [dimensionless]
+! XXXG: Monin-Obkhov length for road          [dimensionless]
+! XXXC: Monin-Obkhov length for urban-canopy  [dimensionless]
+!
+! TRL, TBL, TGL: layer temperature [K] (absolute temperature)
+
+   REAL, INTENT(INOUT):: TR, TB, TG, TC, QC, UC
+   REAL, INTENT(INOUT):: XXXR, XXXB, XXXG, XXXC
+
+   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: TRL
+   REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: TBL
+   REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: TGL
+
+!-------------------------------------------------------------------------------
+! L:  Local variables from read_param
+!-------------------------------------------------------------------------------
+
+   REAL :: ZR, Z0C, Z0HC, ZDC, SVF, R, RW, HGT, CDS, AS, AH
+   REAL :: CAPR, CAPB, CAPG, AKSR, AKSB, AKSG, ALBR, ALBB, ALBG 
+   REAL :: EPSR, EPSB, EPSG, Z0R,  Z0B,  Z0G,  Z0HR, Z0HB, Z0HG
+   REAL :: TRLEND,TBLEND,TGLEND
+   
+   REAL :: TH2X                                                !m
+   
+   INTEGER :: BOUNDR, BOUNDB, BOUNDG
+   INTEGER :: CH_SCHEME, TS_SCHEME
+
+   LOGICAL :: SHADOW  ! [true=consider svf and shadow effects, false=consider svf effect only]
+
+!-------------------------------------------------------------------------------
+! L: Local variables
+!-------------------------------------------------------------------------------
+
+   REAL :: BETR, BETB, BETG
+   REAL :: SX, SD, SQ, RX
+   REAL :: UR, ZC, XLB, BB
+   REAL :: Z, RIBR, RIBB, RIBG, RIBC, BHR, BHB, BHG, BHC
+   REAL :: TSC, LNET, SNET, FLXUV, THG, FLXTH, FLXHUM, FLXG
+   REAL :: W, VFGS, VFGW, VFWG, VFWS, VFWW
+   REAL :: HOUI1, HOUI2, HOUI3, HOUI4, HOUI5, HOUI6, HOUI7, HOUI8
+   REAL :: SLX, SLX1, SLX2, SLX3, SLX4, SLX5, SLX6, SLX7, SLX8
+   REAL :: FLXTHR, FLXTHB, FLXTHG, FLXHUMR, FLXHUMB, FLXHUMG
+   REAL :: SR, SB, SG, RR, RB, RG
+   REAL :: SR1, SR2, SB1, SB2, SG1, SG2, RR1, RR2, RB1, RB2, RG1, RG2
+   REAL :: HR, HB, HG, ELER, ELEB, ELEG, G0R, G0B, G0G
+   REAL :: ALPHAC, ALPHAR, ALPHAB, ALPHAG
+   REAL :: CHC, CHR, CHB, CHG, CDC, CDR, CDB, CDG
+   REAL :: C1R, C1B, C1G, TE, TC1, TC2, QC1, QC2, QS0R, QS0B, QS0G,RHO,ES
+
+   REAL :: DESDT
+   REAL :: F
+   REAL :: DQS0RDTR
+   REAL :: DRRDTR, DHRDTR, DELERDTR, DG0RDTR
+   REAL :: DTR, DFDT
+   REAL :: FX, FY, GF, GX, GY
+   REAL :: DTCDTB, DTCDTG
+   REAL :: DQCDTB, DQCDTG
+   REAL :: DRBDTB1,  DRBDTG1,  DRBDTB2,  DRBDTG2
+   REAL :: DRGDTB1,  DRGDTG1,  DRGDTB2,  DRGDTG2
+   REAL :: DRBDTB,   DRBDTG,   DRGDTB,   DRGDTG
+   REAL :: DHBDTB,   DHBDTG,   DHGDTB,   DHGDTG
+   REAL :: DELEBDTB, DELEBDTG, DELEGDTG, DELEGDTB
+   REAL :: DG0BDTB,  DG0BDTG,  DG0GDTG,  DG0GDTB
+   REAL :: DQS0BDTB, DQS0GDTG
+   REAL :: DTB, DTG, DTC
+
+   REAL :: THEATAZ    ! Solar Zenith Angle [rad]
+   REAL :: THEATAS    ! = PI/2. - THETAZ
+   REAL :: FAI        ! Latitude [rad]
+   REAL :: CNT,SNT
+   REAL :: PS         ! Surface Pressure [hPa]
+   REAL :: TAV        ! Vertial Temperature [K] 
+
+   REAL :: XXX, X, Z0, Z0H, CD, CH
+   REAL :: XXX2, PSIM2, PSIH2, XXX10, PSIM10, PSIH10
+   REAL :: PSIX, PSIT, PSIX2, PSIT2, PSIX10, PSIT10
+
+   REAL :: TRP, TBP, TGP, TCP, QCP, TST, QST
+
+   INTEGER :: iteration, K 
+
+!-------------------------------------------------------------------------------
+! Set parameters
+!-------------------------------------------------------------------------------
+
+   CALL read_param(UTYPE,ZR,Z0C,Z0HC,ZDC,SVF,R,RW,HGT,CDS,AS,AH,  &
+                   CAPR,CAPB,CAPG,AKSR,AKSB,AKSG,ALBR,ALBB,ALBG,  &
+                   EPSR,EPSB,EPSG,Z0R,Z0B,Z0G,Z0HR,Z0HB,Z0HG,     &
+                   BETR,BETB,BETG,TRLEND,TBLEND,TGLEND,           &
+                   BOUNDR,BOUNDB,BOUNDG,CH_SCHEME,TS_SCHEME)
+
+   IF( ZDC+Z0C+2. >= ZA) THEN
+    PRINT *, 'ZDC + Z0C + 2m is larger than the 1st WRF level' 
+    PRINT *, 'Stop in the subroutine urban - change ZDC and Z0C'
+    STOP
+   END IF
+
+   IF(.NOT.LSOLAR) THEN
+     SSGD = SRATIO*SSG
+     SSGQ = SSG - SSGD
+   ENDIF
+   SSGD = SRATIO*SSG   ! No radiation scheme has SSGD and SSGQ.
+   SSGQ = SSG - SSGD
+
+   W=2.*1.*HGT
+   VFGS=SVF
+   VFGW=1.-SVF
+   VFWG=(1.-SVF)*(1.-R)/W
+   VFWS=VFWG
+   VFWW=1.-2.*VFWG
+
+!-------------------------------------------------------------------------------
+! Convert unit from MKS to cgs
+! Renew surface and layer temperatures
+!-------------------------------------------------------------------------------
+
+   SX=(SSGD+SSGQ)/697.7/60.  ! downward short wave radition [ly/min]
+   SD=SSGD/697.7/60.         ! downward direct short wave radiation
+   SQ=SSGQ/697.7/60.         ! downward diffiusion short wave radiation
+   RX=LLG/697.7/60.          ! downward long wave radiation
+   RHO=RHOO*0.001            ! air density at first atmospheric level
+
+   TRP=TR
+   TBP=TB
+   TGP=TG
+   TCP=TC
+   QCP=QC
+
+   TAV=TA*(1.+0.61*QA)
+   PS=RHOO*287.*TAV/100. ![hPa]
+
+!-------------------------------------------------------------------------------
+! Canopy wind
+!-------------------------------------------------------------------------------
+
+   IF ( ZR + 2. < ZA ) THEN
+     UR=UA*LOG((ZR-ZDC)/Z0C)/LOG((ZA-ZDC)/Z0C)
+     ZC=0.7*ZR
+!     ZC=0.5*ZR
+     XLB=0.4*(ZR-ZDC)
+     BB=ZR*(CDS*AS/(2.*XLB**2.))**(1./3.)
+     UC=UR*EXP(-BB*(1.-ZC/ZR))
+   ELSE
+     print *,'ZR=',ZR, 'ZA=',ZA
+     PRINT *, 'Warning ZR + 2m  is larger than the 1st WRF level' 
+     ZC=ZA/2.
+     UC=UA/2.
+   END IF
+
+!-------------------------------------------------------------------------------
+! Net Short Wave Radiation at roof, wall, and road
+!-------------------------------------------------------------------------------
+
+   SHADOW = .false.
+!   SHADOW = .true.
+
+   IF (SSG > 0.0) THEN
+
+     IF(.NOT.SHADOW) THEN              ! no shadow effects model
+
+       SR1=SX*(1.-ALBR)
+       SG1=SX*VFGS*(1.-ALBG)
+       SB1=SX*VFWS*(1.-ALBB)
+       SG2=SB1*ALBB/(1.-ALBB)*VFGW*(1.-ALBG)
+       SB2=SG1*ALBG/(1.-ALBG)*VFWG*(1.-ALBB)
+
+     ELSE                              ! shadow effects model
+
+       FAI=XLAT*PI/180.
+
+       THEATAS=ABS(ASIN(COSZ))
+       THEATAZ=ABS(ACOS(COSZ))
+
+       SNT=COS(DECLIN)*SIN(OMG)/COS(THEATAS)
+       CNT=(COSZ*SIN(FAI)-SIN(DECLIN))/COS(THEATAS)/COS(FAI)
+
+       HOUI1=(SNT*COS(PI/8.)    -CNT*SIN(PI/8.))
+       HOUI2=(SNT*COS(2.*PI/8.) -CNT*SIN(2.*PI/8.))
+       HOUI3=(SNT*COS(3.*PI/8.) -CNT*SIN(3.*PI/8.))
+       HOUI4=(SNT*COS(4.*PI/8.) -CNT*SIN(4.*PI/8.))
+       HOUI5=(SNT*COS(5.*PI/8.) -CNT*SIN(5.*PI/8.))
+       HOUI6=(SNT*COS(6.*PI/8.) -CNT*SIN(6.*PI/8.))
+       HOUI7=(SNT*COS(7.*PI/8.) -CNT*SIN(7.*PI/8.))
+       HOUI8=(SNT*COS(8.*PI/8.) -CNT*SIN(8.*PI/8.))
+
+       SLX1=HGT*ABS(TAN(THEATAZ))*ABS(HOUI1)
+       SLX2=HGT*ABS(TAN(THEATAZ))*ABS(HOUI2)
+       SLX3=HGT*ABS(TAN(THEATAZ))*ABS(HOUI3)
+       SLX4=HGT*ABS(TAN(THEATAZ))*ABS(HOUI4)
+       SLX5=HGT*ABS(TAN(THEATAZ))*ABS(HOUI5)
+       SLX6=HGT*ABS(TAN(THEATAZ))*ABS(HOUI6)
+       SLX7=HGT*ABS(TAN(THEATAZ))*ABS(HOUI7)
+       SLX8=HGT*ABS(TAN(THEATAZ))*ABS(HOUI8)
+
+       IF(SLX1 > RW) SLX1=RW
+       IF(SLX2 > RW) SLX2=RW
+       IF(SLX3 > RW) SLX3=RW
+       IF(SLX4 > RW) SLX4=RW
+       IF(SLX5 > RW) SLX5=RW
+       IF(SLX6 > RW) SLX6=RW
+       IF(SLX7 > RW) SLX7=RW
+       IF(SLX8 > RW) SLX8=RW
+
+       SLX=(SLX1+SLX2+SLX3+SLX4+SLX5+SLX6+SLX7+SLX8)/8.
+
+     END IF
+
+     SR=SR1
+     SG=SG1+SG2
+     SB=SB1+SB2
+
+     SNET=R*SR+W*SB+RW*SG
+
+   ELSE
+
+     SR=0.
+     SG=0.
+     SB=0.
+     SNET=0.
+
+   END IF
+
+!-------------------------------------------------------------------------------
+! Roof
+!-------------------------------------------------------------------------------
+
+!-------------------------------------------------------------------------------
+! CHR, CDR, BETR
+!-------------------------------------------------------------------------------
+
+   Z=ZA-ZDC
+   BHR=LOG(Z0R/Z0HR)/0.4
+   RIBR=(9.8*2./(TA+TRP))*(TA-TRP)*(Z+Z0R)/(UA*UA)
+
+   CALL mos(XXXR,ALPHAR,CDR,BHR,RIBR,Z,Z0R,UA,TA,TRP,RHO)
+
+   CHR=ALPHAR/RHO/CP/UA
+
+   IF(RAIN > 1.) BETR=0.7  
+
+   IF (TS_SCHEME == 1) THEN 
+
+!-------------------------------------------------------------------------------
+! TR  Solving Non-Linear Equation by Newton-Rapson
+! TRL Solving Heat Equation by Tri Diagonal Matrix Algorithm  
+!-------------------------------------------------------------------------------
+!      TSC=TRP-273.15                          
+!      ES=EXP(19.482-4303.4/(TSC+243.5))        ! WMO
+!      ES=6.11*10.**(TETENA*TSC/(TETENB+TSC))   ! Tetens
+!      DESDT=( 6.1078*(2500.-2.4*TSC)/ &        ! Tetens
+!            (0.46151*(TSC+273.15)**2.) )*10.**(7.5*TSC/(237.3+TSC)) 
+!      ES=6.11*EXP((2.5*10.**6./461.51)*(TRP-273.15)/(273.15*TRP) ) ! Clausius-Clapeyron 
+!      DESDT=(2.5*10.**6./461.51)*ES/(TRP**2.)                      ! Clausius-Clapeyron
+!      QS0R=0.622*ES/(PS-0.378*ES) 
+!      DQS0RDTR = DESDT*0.622*PS/((PS-0.378*ES)**2.) 
+!      DQS0RDTR = 17.269*(273.15-35.86)/((TRP-35.86)**2.)*QS0R
+
+!    TRP=350.
+
+     DO ITERATION=1,20
+
+       ES=6.11*EXP( (2.5*10.**6./461.51)*(TRP-273.15)/(273.15*TRP) )
+       DESDT=(2.5*10.**6./461.51)*ES/(TRP**2.)
+       QS0R=0.622*ES/(PS-0.378*ES) 
+       DQS0RDTR = DESDT*0.622*PS/((PS-0.378*ES)**2.) 
+
+       RR=EPSR*(RX-SIG*(TRP**4.)/60.)
+       HR=RHO*CP*CHR*UA*(TRP-TA)*100.
+       ELER=RHO*EL*CHR*UA*BETR*(QS0R-QA)*100.
+       G0R=AKSR*(TRP-TRL(1))/(DZR(1)/2.)
+
+       F = SR + RR - HR - ELER - G0R
+
+       DRRDTR = (-4.*EPSR*SIG*TRP**3.)/60.
+       DHRDTR = RHO*CP*CHR*UA*100.
+       DELERDTR = RHO*EL*CHR*UA*BETR*DQS0RDTR*100.
+       DG0RDTR =  2.*AKSR/DZR(1)
+
+       DFDT = DRRDTR - DHRDTR - DELERDTR - DG0RDTR 
+       DTR = F/DFDT
+
+       TR = TRP - DTR
+       TRP = TR
+
+       IF( ABS(F) < 0.000001 .AND. ABS(DTR) < 0.000001 ) EXIT
+
+     END DO
+
+! multi-layer heat equation model
+
+     CALL multi_layer(num_roof_layers,BOUNDR,G0R,CAPR,AKSR,TRL,DZR,DELT,TRLEND)
+
+   ELSE
+
+     ES=6.11*EXP( (2.5*10.**6./461.51)*(TRP-273.15)/(273.15*TRP) )
+     QS0R=0.622*ES/(PS-0.378*ES)        
+
+     RR=EPSR*(RX-SIG*(TRP**4.)/60.)
+     HR=RHO*CP*CHR*UA*(TRP-TA)*100.
+     ELER=RHO*EL*CHR*UA*BETR*(QS0R-QA)*100.
+     G0R=SR+RR-HR-ELER
+
+     CALL force_restore(CAPR,AKSR,DELT,SR,RR,HR,ELER,TRLEND,TRP,TR)
+
+     TRP=TR
+
+   END IF
+
+   FLXTHR=HR/RHO/CP/100.
+   FLXHUMR=ELER/RHO/EL/100.
+
+!-------------------------------------------------------------------------------
+!  Wall and Road 
+!-------------------------------------------------------------------------------
+
+!-------------------------------------------------------------------------------
+!  CHC, CHB, CDB, BETB, CHG, CDG, BETG
+!-------------------------------------------------------------------------------
+
+   Z=ZA-ZDC
+   BHC=LOG(Z0C/Z0HC)/0.4
+   RIBC=(9.8*2./(TA+TCP))*(TA-TCP)*(Z+Z0C)/(UA*UA)
+
+   CALL mos(XXXC,ALPHAC,CDC,BHC,RIBC,Z,Z0C,UA,TA,TCP,RHO)
+
+   IF (CH_SCHEME == 1) THEN 
+
+     Z=ZDC
+     BHB=LOG(Z0B/Z0HB)/0.4
+     BHG=LOG(Z0G/Z0HG)/0.4
+     RIBB=(9.8*2./(TCP+TBP))*(TCP-TBP)*(Z+Z0B)/(UC*UC)
+     RIBG=(9.8*2./(TCP+TGP))*(TCP-TGP)*(Z+Z0G)/(UC*UC)
+
+     CALL mos(XXXB,ALPHAB,CDB,BHB,RIBB,Z,Z0B,UC,TCP,TBP,RHO)
+     CALL mos(XXXG,ALPHAG,CDG,BHG,RIBG,Z,Z0G,UC,TCP,TGP,RHO)
+
+   ELSE
+
+     ALPHAB=RHO*CP*(6.15+4.18*UC)/1200.
+     IF(UC > 5.) ALPHAB=RHO*CP*(7.51*UC**0.78)/1200.
+     ALPHAG=RHO*CP*(6.15+4.18*UC)/1200.
+     IF(UC > 5.) ALPHAG=RHO*CP*(7.51*UC**0.78)/1200.
+
+   END IF
+
+   CHC=ALPHAC/RHO/CP/UA
+   CHB=ALPHAB/RHO/CP/UC
+   CHG=ALPHAG/RHO/CP/UC
+
+   BETB=0.0
+   IF(RAIN > 1.) BETG=0.7
+
+   IF (TS_SCHEME == 1) THEN
+
+!-------------------------------------------------------------------------------
+!  TB, TG  Solving Non-Linear Simultaneous Equation by Newton-Rapson
+!  TBL,TGL Solving Heat Equation by Tri Diagonal Matrix Algorithm  
+!-------------------------------------------------------------------------------
+
+!    TBP=350.
+!    TGP=350.
+
+     DO ITERATION=1,20
+
+       ES=6.11*EXP( (2.5*10.**6./461.51)*(TBP-273.15)/(273.15*TBP) ) 
+       DESDT=(2.5*10.**6./461.51)*ES/(TBP**2.)
+       QS0B=0.622*ES/(PS-0.378*ES) 
+       DQS0BDTB=DESDT*0.622*PS/((PS-0.378*ES)**2.)
+
+       ES=6.11*EXP( (2.5*10.**6./461.51)*(TGP-273.15)/(273.15*TGP) ) 
+       DESDT=(2.5*10.**6./461.51)*ES/(TGP**2.)
+       QS0G=0.622*ES/(PS-0.378*ES)        
+       DQS0GDTG=DESDT*0.22*PS/((PS-0.378*ES)**2.) 
+
+       RG1=EPSG*( RX*VFGS          &
+       +EPSB*VFGW*SIG*TBP**4./60.  &
+       -SIG*TGP**4./60. )
+
+       RB1=EPSB*( RX*VFWS         &
+       +EPSG*VFWG*SIG*TGP**4./60. &
+       +EPSB*VFWW*SIG*TBP**4./60. &
+       -SIG*TBP**4./60. )
+
+       RG2=EPSG*( (1.-EPSB)*(1.-SVF)*VFWS*RX                  &
+       +(1.-EPSB)*(1.-SVF)*VFWG*EPSG*SIG*TGP**4./60.          &
+       +EPSB*(1.-EPSB)*(1.-SVF)*(1.-2.*VFWS)*SIG*TBP**4./60. )
+
+       RB2=EPSB*( (1.-EPSG)*VFWG*VFGS*RX                          &
+       +(1.-EPSG)*EPSB*VFGW*VFWG*SIG*(TBP**4.)/60.                &
+       +(1.-EPSB)*VFWS*(1.-2.*VFWS)*RX                            &
+       +(1.-EPSB)*VFWG*(1.-2.*VFWS)*EPSG*SIG*EPSG*TGP**4./60.     &
+       +EPSB*(1.-EPSB)*(1.-2.*VFWS)*(1.-2.*VFWS)*SIG*TBP**4./60. )
+
+       RG=RG1+RG2
+       RB=RB1+RB2
+
+       DRBDTB1=EPSB*(4.*EPSB*SIG*TB**3.*VFWW-4.*SIG*TB**3.)/60.
+       DRBDTG1=EPSB*(4.*EPSG*SIG*TG**3.*VFWG)/60.
+       DRBDTB2=EPSB*(4.*(1.-EPSG)*EPSB*SIG*TB**3.*VFGW*VFWG &
+               +4.*EPSB*(1.-EPSB)*SIG*TB**3.*VFWW*VFWW)/60.
+       DRBDTG2=EPSB*(4.*(1.-EPSB)*EPSG*SIG*TG**3.*VFWG*VFWW)/60.
+
+       DRGDTB1=EPSG*(4.*EPSB*SIG*TB**3.*VFGW)/60.
+       DRGDTG1=EPSG*(-4.*SIG*TG**3.)/60.
+       DRGDTB2=EPSG*(4.*EPSB*(1.-EPSB)*SIG*TB**3.*VFWW*VFGW)/60.
+       DRGDTG2=EPSG*(4.*(1.-EPSB)*EPSG*SIG*TG**3.*VFWG*VFGW)/60.
+
+       DRBDTB=DRBDTB1+DRBDTB2
+       DRBDTG=DRBDTG1+DRBDTG2
+       DRGDTB=DRGDTB1+DRGDTB2
+       DRGDTG=DRGDTG1+DRGDTG2
+
+       HB=RHO*CP*CHB*UC*(TBP-TCP)*100.
+       HG=RHO*CP*CHG*UC*(TGP-TCP)*100.
+
+       DTCDTB=W*ALPHAB/(RW*ALPHAC+RW*ALPHAG+W*ALPHAB)
+       DTCDTG=RW*ALPHAG/(RW*ALPHAC+RW*ALPHAG+W*ALPHAB)
+
+       DHBDTB=RHO*CP*CHB*UC*(1.-DTCDTB)*100.
+       DHBDTG=RHO*CP*CHB*UC*(0.-DTCDTG)*100.
+       DHGDTG=RHO*CP*CHG*UC*(1.-DTCDTG)*100.
+       DHGDTB=RHO*CP*CHG*UC*(0.-DTCDTB)*100.
+
+       ELEB=RHO*EL*CHB*UC*BETB*(QS0B-QCP)*100.
+       ELEG=RHO*EL*CHG*UC*BETG*(QS0G-QCP)*100.
+
+       DQCDTB=W*ALPHAB*BETB*DQS0BDTB/(RW*ALPHAC+RW*ALPHAG*BETG+W*ALPHAB*BETB)
+       DQCDTG=RW*ALPHAG*BETG*DQS0GDTG/(RW*ALPHAC+RW*ALPHAG*BETG+W*ALPHAB*BETB)
+
+       DELEBDTB=RHO*EL*CHB*UC*BETB*(DQS0BDTB-DQCDTB)*100.
+       DELEBDTG=RHO*EL*CHB*UC*BETB*(0.-DQCDTG)*100.
+       DELEGDTG=RHO*EL*CHG*UC*BETG*(DQS0GDTG-DQCDTG)*100.
+       DELEGDTB=RHO*EL*CHG*UC*BETG*(0.-DQCDTB)*100.
+
+       G0B=AKSB*(TBP-TBL(1))/(DZB(1)/2.)
+       G0G=AKSG*(TGP-TGL(1))/(DZG(1)/2.)
+
+       DG0BDTB=2.*AKSB/DZB(1)
+       DG0BDTG=0.
+       DG0GDTG=2.*AKSG/DZG(1)
+       DG0GDTB=0.
+
+       F = SB + RB - HB - ELEB - G0B
+       FX = DRBDTB - DHBDTB - DELEBDTB - DG0BDTB 
+       FY = DRBDTG - DHBDTG - DELEBDTG - DG0BDTG
+
+       GF = SG + RG - HG - ELEG - G0G
+       GX = DRGDTB - DHGDTB - DELEGDTB - DG0GDTB
+       GY = DRGDTG - DHGDTG - DELEGDTG - DG0GDTG 
+
+       DTB =  (GF*FY-F*GY)/(FX*GY-GX*FY)
+       DTG = -(GF+GX*DTB)/GY
+
+       TB = TBP + DTB
+       TG = TGP + DTG
+
+       TBP = TB
+       TGP = TG
+
+       TC1=RW*ALPHAC+RW*ALPHAG+W*ALPHAB
+       TC2=RW*ALPHAC*TA+RW*ALPHAG*TGP+W*ALPHAB*TBP
+       TC=TC2/TC1
+
+       QC1=RW*ALPHAC+RW*ALPHAG*BETG+W*ALPHAB*BETB
+       QC2=RW*ALPHAC*QA+RW*ALPHAG*BETG*QS0G+W*ALPHAB*BETB*QS0B
+       QC=QC2/QC1
+
+       DTC=TCP - TC
+       TCP=TC
+       QCP=QC
+
+       IF( ABS(F) < 0.000001 .AND. ABS(DTB) < 0.000001 &
+        .AND. ABS(GF) < 0.000001 .AND. ABS(DTG) < 0.000001 &
+        .AND. ABS(DTC) < 0.000001) EXIT
+
+     END DO
+
+     CALL multi_layer(num_wall_layers,BOUNDB,G0B,CAPB,AKSB,TBL,DZB,DELT,TBLEND)
+
+     CALL multi_layer(num_road_layers,BOUNDG,G0G,CAPG,AKSG,TGL,DZG,DELT,TGLEND)
+
+   ELSE
+
+!-------------------------------------------------------------------------------
+!  TB, TG  by Force-Restore Method 
+!-------------------------------------------------------------------------------
+
+       ES=6.11*EXP((2.5*10.**6./461.51)*(TBP-273.15)/(273.15*TBP) )
+       QS0B=0.622*ES/(PS-0.378*ES)       
+
+       ES=6.11*EXP((2.5*10.**6./461.51)*(TGP-273.15)/(273.15*TGP) )
+       QS0G=0.622*ES/(PS-0.378*ES)        
+
+       RG1=EPSG*( RX*VFGS             &
+       +EPSB*VFGW*SIG*TBP**4./60.     &
+       -SIG*TGP**4./60. )
+
+       RB1=EPSB*( RX*VFWS &
+       +EPSG*VFWG*SIG*TGP**4./60. &
+       +EPSB*VFWW*SIG*TBP**4./60. &
+       -SIG*TBP**4./60. )
+
+       RG2=EPSG*( (1.-EPSB)*(1.-SVF)*VFWS*RX                   &
+       +(1.-EPSB)*(1.-SVF)*VFWG*EPSG*SIG*TGP**4./60.           &
+       +EPSB*(1.-EPSB)*(1.-SVF)*(1.-2.*VFWS)*SIG*TBP**4./60. )
+
+       RB2=EPSB*( (1.-EPSG)*VFWG*VFGS*RX                          &
+       +(1.-EPSG)*EPSB*VFGW*VFWG*SIG*(TBP**4.)/60.                &
+       +(1.-EPSB)*VFWS*(1.-2.*VFWS)*RX                            &
+       +(1.-EPSB)*VFWG*(1.-2.*VFWS)*EPSG*SIG*EPSG*TGP**4./60.     &
+       +EPSB*(1.-EPSB)*(1.-2.*VFWS)*(1.-2.*VFWS)*SIG*TBP**4./60. )
+
+       RG=RG1+RG2
+       RB=RB1+RB2
+
+       HB=RHO*CP*CHB*UC*(TBP-TCP)*100.
+       ELEB=RHO*EL*CHB*UC*BETB*(QS0B-QCP)*100.
+       G0B=SB+RB-HB-ELEB
+
+       HG=RHO*CP*CHG*UC*(TGP-TCP)*100.
+       ELEG=RHO*EL*CHG*UC*BETG*(QS0G-QCP)*100.
+       G0G=SG+RG-HG-ELEG
+
+       CALL force_restore(CAPB,AKSB,DELT,SB,RB,HB,ELEB,TBLEND,TBP,TB)
+       CALL force_restore(CAPG,AKSG,DELT,SG,RG,HG,ELEG,TGLEND,TGP,TG)
+
+       TBP=TB
+       TGP=TG
+
+       TC1=RW*ALPHAC+RW*ALPHAG+W*ALPHAB
+       TC2=RW*ALPHAC*TA+RW*ALPHAG*TGP+W*ALPHAB*TBP
+       TC=TC2/TC1
+
+       QC1=RW*ALPHAC+RW*ALPHAG*BETG+W*ALPHAB*BETB
+       QC2=RW*ALPHAC*QA+RW*ALPHAG*BETG*QS0G+W*ALPHAB*BETB*QS0B
+       QC=QC2/QC1
+
+       TCP=TC
+       QCP=QC
+
+   END IF
+
+   FLXTHB=HB/RHO/CP/100.
+   FLXHUMB=ELEB/RHO/EL/100.
+   FLXTHG=HG/RHO/CP/100.
+   FLXHUMG=ELEG/RHO/EL/100.
+
+!-------------------------------------------------------------------------------
+! Total Fulxes from Urban Canopy
+!-------------------------------------------------------------------------------
+
+   FLXUV  = ( R*CDR + RW*CDC )*UA*UA
+   FLXTH  = ( R*FLXTHR  + W*FLXTHB  + RW*FLXTHG )
+   FLXHUM = ( R*FLXHUMR + W*FLXHUMB + RW*FLXHUMG )
+   FLXG =   ( R*G0R + W*G0B + RW*G0G )
+   LNET =     R*RR + W*RB + RW*RG
+
+!----------------------------------------------------------------------------
+! Convert Unit: FLUXES and u* T* q*  --> WRF
+!----------------------------------------------------------------------------
+
+   SH    = FLXTH  * RHOO * CPP    ! Sensible heat flux          [W/m/m]
+   LH    = FLXHUM * RHOO * ELL    ! Latent heat flux            [W/m/m]
+   LH_KINEMATIC = FLXHUM * RHOO   ! Latent heat, Kinematic      [kg/m/m/s]
+   LW    = LLG - (LNET*697.7*60.) ! Upward longwave radiation   [W/m/m]
+   SW    = SSG - (SNET*697.7*60.) ! Upward shortwave radiation  [W/m/m]
+   ALB   = 0.
+   IF( ABS(SSG) > 0.0001) ALB = SW/SSG ! Effective albedo [-] 
+   G = -FLXG*697.7*60.            ! [W/m/m]
+   RN = (SNET+LNET)*697.7*60.     ! Net radiation [W/m/m]
+
+   UST = SQRT(FLXUV)              ! u* [m/s]
+   TST = -FLXTH/UST               ! T* [K]
+   QST = -FLXHUM/UST              ! q* [-]
+
+!------------------------------------------------------
+!  diagnostic GRID AVERAGED  PSIM  PSIH  TS QS --> WRF
+!------------------------------------------------------
+
+   Z0 = Z0C 
+   Z0H = Z0HC
+   Z = ZA - ZDC
+
+   XXX = 0.4*9.81*Z*TST/TA/UST/UST
+
+   IF ( XXX >= 1. ) XXX = 1.
+   IF ( XXX <= -5. ) XXX = -5.
+
+   IF ( XXX > 0 ) THEN
+     PSIM = -5. * XXX
+     PSIH = -5. * XXX
+   ELSE
+     X = (1.-16.*XXX)**0.25
+     PSIM = 2.*ALOG((1.+X)/2.) + ALOG((1.+X*X)/2.) - 2.*ATAN(X) + PI/2.
+     PSIH = 2.*ALOG((1.+X*X)/2.)
+   END IF
+
+   GZ1OZ0 = ALOG(Z/Z0)
+   CD = 0.4**2./(ALOG(Z/Z0)-PSIM)**2.
+!
+!m   CH = 0.4**2./(ALOG(Z/Z0)-PSIM)/(ALOG(Z/Z0H)-PSIH)
+!m   CHS = 0.4*UST/(ALOG(Z/Z0H)-PSIH)
+!m   TS = TA + FLXTH/CH/UA    ! surface potential temp (flux temp)
+!m   QS = QA + FLXHUM/CH/UA   ! surface humidity
+!
+   TS = TA + FLXTH/CHS    ! surface potential temp (flux temp)
+   QS = QA + FLXHUM/CHS   ! surface humidity
+
+!-------------------------------------------------------
+!  diagnostic  GRID AVERAGED  U10  V10  TH2  Q2 --> WRF
+!-------------------------------------------------------
+
+   XXX2 = (2./Z)*XXX
+   IF ( XXX2 >= 1. ) XXX2 = 1.
+   IF ( XXX2 <= -5. ) XXX2 = -5.
+
+   IF ( XXX2 > 0 ) THEN
+      PSIM2 = -5. * XXX2
+      PSIH2 = -5. * XXX2
+   ELSE
+      X = (1.-16.*XXX2)**0.25
+      PSIM2 = 2.*ALOG((1.+X)/2.) + ALOG((1.+X*X)/2.) - 2.*ATAN(X) + 2.*ATAN(1.)
+      PSIH2 = 2.*ALOG((1.+X*X)/2.)
+   END IF
+!
+!m   CHS2 = 0.4*UST/(ALOG(2./Z0H)-PSIH2)
+!
+
+   XXX10 = (10./Z)*XXX
+   IF ( XXX10 >= 1. ) XXX10 = 1.
+   IF ( XXX10 <= -5. ) XXX10 = -5.
+
+   IF ( XXX10 > 0 ) THEN
+      PSIM10 = -5. * XXX10
+      PSIH10 = -5. * XXX10
+   ELSE
+      X = (1.-16.*XXX10)**0.25
+      PSIM10 = 2.*ALOG((1.+X)/2.) + ALOG((1.+X*X)/2.) - 2.*ATAN(X) + 2.*ATAN(1.)
+      PSIH10 = 2.*ALOG((1.+X*X)/2.)
+   END IF
+
+   PSIX = ALOG(Z/Z0) - PSIM
+   PSIT = ALOG(Z/Z0H) - PSIH
+
+   PSIX2 = ALOG(2./Z0) - PSIM2
+   PSIT2 = ALOG(2./Z0H) - PSIH2
+
+   PSIX10 = ALOG(10./Z0) - PSIM10
+   PSIT10 = ALOG(10./Z0H) - PSIH10
+
+   U10 = U1 * (PSIX10/PSIX)       ! u at 10 m [m/s]
+   V10 = V1 * (PSIX10/PSIX)       ! v at 10 m [m/s]
+
+!   TH2 = TS + (TA-TS)*(PSIT2/PSIT)   ! potential temp at 2 m [K]
+!  TH2 = TS + (TA-TS)*(PSIT2/PSIT)   ! Fei: this seems to be temp (not potential) at 2 m [K]
+!Fei: consistant with M-O theory
+   TH2 = TS + (TA-TS) *(CHS/CHS2) 
+
+   Q2 = QS + (QA-QS)*(PSIT2/PSIT)    ! humidity at 2 m       [-]
+
+!   TS = (LW/SIG_SI/0.88)**0.25       ! Radiative temperature [K]
+
+   RETURN
+
+   END SUBROUTINE urban
+!===============================================================================
+!
+!  mos
+!
+!===============================================================================
+   SUBROUTINE mos(XXX,ALPHA,CD,B1,RIB,Z,Z0,UA,TA,TSF,RHO)
+
+!  XXX:   z/L (requires iteration by Newton-Rapson method)
+!  B1:    Stanton number
+!  PSIM:  = PSIX of LSM
+!  PSIH:  = PSIT of LSM
+
+   IMPLICIT NONE
+
+   REAL, PARAMETER     :: CP=0.24
+   REAL, INTENT(IN)    :: B1, Z, Z0, UA, TA, TSF, RHO
+   REAL, INTENT(OUT)   :: ALPHA, CD
+   REAL, INTENT(INOUT) :: XXX, RIB
+   REAL                :: XXX0, X, X0, FAIH, DPSIM, DPSIH
+   REAL                :: F, DF, XXXP, US, TS, AL, XKB, DD, PSIM, PSIH
+   INTEGER             :: NEWT
+   INTEGER, PARAMETER  :: NEWT_END=10
+
+   IF(RIB <= -15.) RIB=-15. 
+
+   IF(RIB < 0.) THEN
+
+      DO NEWT=1,NEWT_END
+
+        IF(XXX >= 0.) XXX=-1.E-3
+
+        XXX0=XXX*Z0/(Z+Z0)
+
+        X=(1.-16.*XXX)**0.25
+        X0=(1.-16.*XXX0)**0.25
+
+        PSIM=ALOG((Z+Z0)/Z0) &
+            -ALOG((X+1.)**2.*(X**2.+1.)) &
+            +2.*ATAN(X) &
+            +ALOG((X+1.)**2.*(X0**2.+1.)) &
+            -2.*ATAN(X0)
+        FAIH=1./SQRT(1.-16.*XXX)
+        PSIH=ALOG((Z+Z0)/Z0)+0.4*B1 &
+            -2.*ALOG(SQRT(1.-16.*XXX)+1.) &
+            +2.*ALOG(SQRT(1.-16.*XXX0)+1.)
+
+        DPSIM=(1.-16.*XXX)**(-0.25)/XXX &
+             -(1.-16.*XXX0)**(-0.25)/XXX
+        DPSIH=1./SQRT(1.-16.*XXX)/XXX &
+             -1./SQRT(1.-16.*XXX0)/XXX
+
+        F=RIB*PSIM**2./PSIH-XXX
+
+        DF=RIB*(2.*DPSIM*PSIM*PSIH-DPSIH*PSIM**2.) &
+          /PSIH**2.-1.
+
+        XXXP=XXX
+        XXX=XXXP-F/DF
+        IF(XXX <= -10.) XXX=-10.
+
+      END DO
+
+   ELSE IF(RIB >= 0.142857) THEN
+
+      XXX=0.714
+      PSIM=ALOG((Z+Z0)/Z0)+7.*XXX
+      PSIH=PSIM+0.4*B1
+
+   ELSE
+
+      AL=ALOG((Z+Z0)/Z0)
+      XKB=0.4*B1
+      DD=-4.*RIB*7.*XKB*AL+(AL+XKB)**2.
+      IF(DD <= 0.) DD=0.
+      XXX=(AL+XKB-2.*RIB*7.*AL-SQRT(DD))/(2.*(RIB*7.**2-7.))
+      PSIM=ALOG((Z+Z0)/Z0)+7.*MIN(XXX,0.714)
+      PSIH=PSIM+0.4*B1
+
+   END IF
+
+   US=0.4*UA/PSIM             ! u*
+   IF(US <= 0.01) US=0.01
+   TS=0.4*(TA-TSF)/PSIH       ! T*
+
+   CD=US*US/UA**2.            ! CD
+   ALPHA=RHO*CP*0.4*US/PSIH   ! RHO*CP*CH*U
+
+   RETURN 
+   END SUBROUTINE mos
+!===============================================================================
+!
+!  louis79
+!
+!===============================================================================
+   SUBROUTINE louis79(ALPHA,CD,RIB,Z,Z0,UA,RHO)
+
+   IMPLICIT NONE
+
+   REAL, PARAMETER     :: CP=0.24
+   REAL, INTENT(IN)    :: Z, Z0, UA, RHO
+   REAL, INTENT(OUT)   :: ALPHA, CD
+   REAL, INTENT(INOUT) :: RIB
+   REAL                :: A2, XX, CH, CMB, CHB
+
+   A2=(0.4/ALOG(Z/Z0))**2.
+
+   IF(RIB <= -15.) RIB=-15.
+
+   IF(RIB >= 0.0) THEN
+      IF(RIB >= 0.142857) THEN 
+         XX=0.714
+      ELSE 
+         XX=RIB*LOG(Z/Z0)/(1.-7.*RIB)
+      END IF 
+      CH=0.16/0.74/(LOG(Z/Z0)+7.*MIN(XX,0.714))**2.
+      CD=0.16/(LOG(Z/Z0)+7.*MIN(XX,0.714))**2.
+   ELSE 
+      CMB=7.4*A2*9.4*SQRT(Z/Z0)
+      CHB=5.3*A2*9.4*SQRT(Z/Z0)
+      CH=A2/0.74*(1.-9.4*RIB/(1.+CHB*SQRT(-RIB)))
+      CD=A2*(1.-9.4*RIB/(1.+CHB*SQRT(-RIB)))
+   END IF
+
+   ALPHA=RHO*CP*CH*UA
+
+   RETURN 
+   END SUBROUTINE louis79
+!===============================================================================
+!
+!  louis82
+!
+!===============================================================================
+   SUBROUTINE louis82(ALPHA,CD,RIB,Z,Z0,UA,RHO)
+
+   IMPLICIT NONE
+
+   REAL, PARAMETER     :: CP=0.24
+   REAL, INTENT(IN)    :: Z, Z0, UA, RHO
+   REAL, INTENT(OUT)   :: ALPHA, CD
+   REAL, INTENT(INOUT) :: RIB 
+   REAL                :: A2, FM, FH, CH, CHH 
+
+   A2=(0.4/ALOG(Z/Z0))**2.
+
+   IF(RIB <= -15.) RIB=-15.
+
+   IF(RIB >= 0.0) THEN 
+      FM=1./((1.+(2.*5.*RIB)/SQRT(1.+5.*RIB)))
+      FH=1./(1.+(3.*5.*RIB)*SQRT(1.+5.*RIB))
+      CH=A2*FH
+      CD=A2*FM
+   ELSE 
+      CHH=5.*3.*5.*A2*SQRT(Z/Z0)
+      FM=1.-(2.*5.*RIB)/(1.+3.*5.*5.*A2*SQRT(Z/Z0+1.)*(-RIB))
+      FH=1.-(3.*5.*RIB)/(1.+CHH*SQRT(-RIB))
+      CH=A2*FH
+      CD=A2*FM
+   END IF
+
+   ALPHA=RHO*CP*CH*UA
+
+   RETURN
+   END SUBROUTINE louis82
+!===============================================================================
+!
+!  multi_layer
+!
+!===============================================================================
+   SUBROUTINE multi_layer(KM,BOUND,G0,CAP,AKS,TSL,DZ,DELT,TSLEND)
+
+   IMPLICIT NONE
+
+   REAL, INTENT(IN)                   :: G0, CAP, AKS, DELT,TSLEND
+
+   INTEGER, INTENT(IN)                :: KM, BOUND
+
+   REAL, DIMENSION(KM), INTENT(IN)    :: DZ
+
+   REAL, DIMENSION(KM), INTENT(INOUT) :: TSL
+
+   REAL, DIMENSION(KM)                :: A, B, C, D, X, P, Q
+
+   REAL                               :: DZEND
+
+   INTEGER                            :: K
+
+   DZEND=DZ(KM)
+
+   A(1) = 0.0
+
+   B(1) = CAP*DZ(1)/DELT &
+          +2.*AKS/(DZ(1)+DZ(2))
+   C(1) = -2.*AKS/(DZ(1)+DZ(2))
+   D(1) = CAP*DZ(1)/DELT*TSL(1) + G0
+
+   DO K=2,KM-1
+      A(K) = -2.*AKS/(DZ(K-1)+DZ(K))
+      B(K) = CAP*DZ(K)/DELT + 2.*AKS/(DZ(K-1)+DZ(K)) + 2.*AKS/(DZ(K)+DZ(K+1)) 
+      C(K) = -2.*AKS/(DZ(K)+DZ(K+1))
+      D(K) = CAP*DZ(K)/DELT*TSL(K)
+   END DO 
+
+   IF(BOUND == 1) THEN                  ! Flux=0
+      A(KM) = -2.*AKS/(DZ(KM-1)+DZ(KM))
+      B(KM) = CAP*DZ(KM)/DELT + 2.*AKS/(DZ(KM-1)+DZ(KM))  
+      C(KM) = 0.0
+      D(KM) = CAP*DZ(KM)/DELT*TSL(KM)
+   ELSE                                 ! T=constant
+      A(KM) = -2.*AKS/(DZ(KM-1)+DZ(KM))
+      B(KM) = CAP*DZ(KM)/DELT + 2.*AKS/(DZ(KM-1)+DZ(KM)) + 2.*AKS/(DZ(KM)+DZEND) 
+      C(KM) = 0.0
+      D(KM) = CAP*DZ(KM)/DELT*TSL(KM) + 2.*AKS*TSLEND/(DZ(KM)+DZEND)
+   END IF 
+
+   P(1) = -C(1)/B(1)
+   Q(1) =  D(1)/B(1)
+
+   DO K=2,KM
+      P(K) = -C(K)/(A(K)*P(K-1)+B(K))
+      Q(K) = (-A(K)*Q(K-1)+D(K))/(A(K)*P(K-1)+B(K))
+   END DO 
+
+   X(KM) = Q(KM)
+
+   DO K=KM-1,1,-1
+      X(K) = P(K)*X(K+1)+Q(K)
+   END DO 
+
+   DO K=1,KM
+      TSL(K) = X(K)
+   END DO 
+
+   RETURN 
+   END SUBROUTINE multi_layer
+!===============================================================================
+!
+!  subroutine read_param
+!
+!===============================================================================
+   SUBROUTINE read_param(UTYPE,                                        & ! in
+                         ZR,Z0C,Z0HC,ZDC,SVF,R,RW,HGT,CDS,AS,AH,       & ! out
+                         CAPR,CAPB,CAPG,AKSR,AKSB,AKSG,ALBR,ALBB,ALBG, & ! out
+                         EPSR,EPSB,EPSG,Z0R,Z0B,Z0G,Z0HR,Z0HB,Z0HG,    & ! out
+                         BETR,BETB,BETG,TRLEND,TBLEND,TGLEND,          & ! out
+                         BOUNDR,BOUNDB,BOUNDG,CH_SCHEME,TS_SCHEME)       ! out
+
+   INTEGER, INTENT(IN)  :: UTYPE 
+
+   REAL, INTENT(OUT)    :: ZR,Z0C,Z0HC,ZDC,SVF,R,RW,HGT,CDS,AS,AH,       &
+                           CAPR,CAPB,CAPG,AKSR,AKSB,AKSG,ALBR,ALBB,ALBG, &
+                           EPSR,EPSB,EPSG,Z0R,Z0B,Z0G,Z0HR,Z0HB,Z0HG,    &
+                           BETR,BETB,BETG,TRLEND,TBLEND,TGLEND
+
+   INTEGER, INTENT(OUT) :: BOUNDR,BOUNDB,BOUNDG,CH_SCHEME,TS_SCHEME
+
+   ZR =     ZR_TBL(UTYPE)
+   Z0C=     Z0C_TBL(UTYPE)
+   Z0HC=    Z0HC_TBL(UTYPE)
+   ZDC=     ZDC_TBL(UTYPE)
+   SVF=     SVF_TBL(UTYPE)
+   R=       R_TBL(UTYPE)
+   RW=      RW_TBL(UTYPE)
+   HGT=     HGT_TBL(UTYPE)
+   CDS=     CDS_TBL(UTYPE)
+   AS=      AS_TBL(UTYPE)
+   AH=      AH_TBL(UTYPE)
+   BETR=    BETR_TBL(UTYPE)
+   BETB=    BETB_TBL(UTYPE)
+   BETG=    BETG_TBL(UTYPE)
+
+!m   FRC_URB= FRC_URB_TBL(UTYPE)
+
+   CAPR=    CAPR_DATA
+   CAPB=    CAPB_DATA
+   CAPG=    CAPG_DATA
+   AKSR=    AKSR_DATA
+   AKSB=    AKSB_DATA
+   AKSG=    AKSG_DATA
+   ALBR=    ALBR_DATA
+   ALBB=    ALBB_DATA
+   ALBG=    ALBG_DATA
+   EPSR=    EPSR_DATA
+   EPSB=    EPSB_DATA
+   EPSG=    EPSG_DATA
+   Z0R=     Z0R_DATA
+   Z0B=     Z0B_DATA
+   Z0G=     Z0G_DATA
+   Z0HR=    Z0HR_DATA
+   Z0HB=    Z0HB_DATA
+   Z0HG=    Z0HG_DATA
+   TRLEND=  TRLEND_DATA
+   TBLEND=  TBLEND_DATA
+   TGLEND=  TGLEND_DATA
+   BOUNDR=  BOUNDR_DATA
+   BOUNDB=  BOUNDB_DATA
+   BOUNDG=  BOUNDG_DATA
+   CH_SCHEME = CH_SCHEME_DATA
+   TS_SCHEME = TS_SCHEME_DATA
+
+   RETURN
+   END SUBROUTINE read_param
+!===============================================================================
+!
+! subroutine urban_param_init: Read parameters from urban_param.tbl
+!
+!===============================================================================
+   SUBROUTINE urban_param_init(DZR,DZB,DZG,num_soil_layers &
+                               )
+!                              num_roof_layers,num_wall_layers,num_road_layers)
+
+   IMPLICIT NONE
+
+   INTEGER, INTENT(IN) :: num_soil_layers
+
+!   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR
+!   REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB
+!   REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG
+   REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR
+   REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB
+   REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG
+
+   INTEGER :: INDEX, LC, K
+   INTEGER :: IOSTATUS, ALLOCATE_STATUS
+   INTEGER :: num_roof_layers
+   INTEGER :: num_wall_layers
+   INTEGER :: num_road_layers
+   INTEGER :: dummy 
+   REAL    :: DHGT, HGT, VFWS, VFGS
+
+   OPEN (UNIT=11,                &
+         FILE='urban_param.tbl', &
+         ACCESS='SEQUENTIAL',    &
+         STATUS='OLD',           &
+         ACTION='READ',          &
+         POSITION='REWIND',      &
+         IOSTAT=IOSTATUS)
+
+   IF (IOSTATUS > 0) STOP 'ERROR OPEN urban_param.tbl'
+
+   READ(11,*)
+   READ(11,'(A4)') LU_DATA_TYPE
+
+   READ(11,*) ICATE
+   ALLOCATE( ZR_TBL(ICATE), stat=allocate_status )
+   if(allocate_status == 0) THEN
+   ALLOCATE( Z0C_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate Z0C_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( Z0HC_TBL ) ) &
+   ALLOCATE( Z0HC_TBL(ICATE), stat=allocate_status ) 
+    if(allocate_status /= 0) stop 'error allocate Z0HC_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( ZDC_TBL ) ) &
+   ALLOCATE( ZDC_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate ZDC_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( SVF_TBL ) ) &
+   ALLOCATE( SVF_TBL(ICATE), stat=allocate_status ) 
+    if(allocate_status /= 0) stop 'error allocate SVF_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( R_TBL ) ) &
+   ALLOCATE( R_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate R_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( RW_TBL ) ) &
+   ALLOCATE( RW_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate RW_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( HGT_TBL ) ) &
+   ALLOCATE( HGT_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate HGT_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( CDS_TBL ) ) &
+   ALLOCATE( CDS_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate CDS_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( AS_TBL ) ) &
+   ALLOCATE( AS_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate AS_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( AH_TBL ) ) &
+   ALLOCATE( AH_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate AH_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( BETR_TBL ) ) &
+   ALLOCATE( BETR_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate BETR_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( BETB_TBL ) ) &
+   ALLOCATE( BETB_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate BETB_TBL in urban_param_init'
+   IF( .NOT. ALLOCATED( BETG_TBL ) ) &
+   ALLOCATE( BETG_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate BETG_TBL in urban_param_init'
+   ALLOCATE( FRC_URB_TBL(ICATE), stat=allocate_status )
+    if(allocate_status /= 0) stop 'error allocate FRC_URB_TBL in urban_param_init'
+
+ENDIF
+
+   DO LC = 1, ICATE
+      READ(11,*) INDEX,        &
+                 ZR_TBL(LC),   &
+                 Z0C_TBL(LC),  &
+                 Z0HC_TBL(LC), &
+                 ZDC_TBL(LC),  &
+                 SVF_TBL(LC),  &
+                 R_TBL(LC),    &
+                 RW_TBL(LC),   &
+                 HGT_TBL(LC),  &
+                 CDS_TBL(LC),  &
+                 AS_TBL(LC),   &
+                 AH_TBL(LC),   &
+                 BETR_TBL(LC), &
+                 BETB_TBL(LC), &
+                 BETG_TBL(LC), &
+                 FRC_URB_TBL(LC)  
+   END DO
+
+   READ(11,*)
+   READ(11,*) CAPR_DATA
+   READ(11,*)
+   READ(11,*) CAPB_DATA
+   READ(11,*)
+   READ(11,*) CAPG_DATA
+   READ(11,*)
+   READ(11,*) AKSR_DATA
+   READ(11,*)
+   READ(11,*) AKSB_DATA
+   READ(11,*)
+   READ(11,*) AKSG_DATA
+   READ(11,*)
+   READ(11,*) ALBR_DATA
+   READ(11,*)
+   READ(11,*) ALBB_DATA
+   READ(11,*)
+   READ(11,*) ALBG_DATA
+   READ(11,*)
+   READ(11,*) EPSR_DATA
+   READ(11,*)
+   READ(11,*) EPSB_DATA
+   READ(11,*)
+   READ(11,*) EPSG_DATA
+   READ(11,*)
+   READ(11,*) Z0R_DATA
+   READ(11,*)
+   READ(11,*) Z0B_DATA
+   READ(11,*)
+   READ(11,*) Z0G_DATA
+   READ(11,*)
+   READ(11,*) Z0HR_DATA
+   READ(11,*)
+   READ(11,*) Z0HB_DATA
+   READ(11,*)
+   READ(11,*) Z0HG_DATA
+   READ(11,*)
+!   READ(11,*) num_roof_layers
+   READ(11,*) dummy 
+   READ(11,*)
+!   READ(11,*) num_wall_layers
+   READ(11,*) dummy 
+   READ(11,*)
+!   READ(11,*) num_road_layers
+   READ(11,*) dummy 
+
+   num_roof_layers = num_soil_layers
+   num_wall_layers = num_soil_layers
+   num_road_layers = num_soil_layers
+
+   DO K=1,num_roof_layers
+      READ(11,*)
+      READ(11,*) DZR(K)
+   END DO
+
+   DO K=1,num_wall_layers
+      READ(11,*)
+      READ(11,*) DZB(K)
+   END DO
+
+   DO K=1,num_road_layers
+      READ(11,*)
+      READ(11,*) DZG(K)
+   END DO
+
+   READ(11,*)
+   READ(11,*) BOUNDR_DATA
+   READ(11,*)
+   READ(11,*) BOUNDB_DATA
+   READ(11,*)
+   READ(11,*) BOUNDG_DATA
+   READ(11,*)
+   READ(11,*) TRLEND_DATA
+   READ(11,*)
+   READ(11,*) TBLEND_DATA
+   READ(11,*)
+   READ(11,*) TGLEND_DATA
+   READ(11,*)
+   READ(11,*) CH_SCHEME_DATA
+   READ(11,*)
+   READ(11,*) TS_SCHEME_DATA
+
+   CLOSE(11)
+
+! Calculate Sky View Factor
+
+   DO LC = 1, ICATE
+      DHGT=HGT_TBL(LC)/100.
+      HGT=0.
+      VFWS=0.
+      HGT=HGT_TBL(LC)-DHGT/2.
+      do k=1,99
+         HGT=HGT-DHGT
+         VFWS=VFWS+0.25*(1.-HGT/SQRT(HGT**2.+RW_TBL(LC)**2.))
+      end do
+
+     VFWS=VFWS/99.
+     VFWS=VFWS*2.
+
+     VFGS=1.-2.*VFWS*HGT_TBL(LC)/RW_TBL(LC)
+     SVF_TBL(LC)=VFGS
+   END DO
+
+   END SUBROUTINE urban_param_init
+!===========================================================================
+!
+! subroutine urban_var_init: initialization of urban state variables
+!
+!===========================================================================
+   SUBROUTINE urban_var_init(TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,     & ! in
+                             ims,ime,jms,jme,num_soil_layers,                 & ! in
+!                             num_roof_layers,num_wall_layers,num_road_layers, & ! in
+                             XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,  & ! inout
+                             TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & ! inout
+                             TRL_URB3D,TBL_URB3D,TGL_URB3D,                & ! inout
+                             SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D,           & ! inout
+                             TS_URB2D, FRC_URB2D, UTYPE_URB2D)               ! inout
+   IMPLICIT NONE
+
+   INTEGER, INTENT(IN) :: ims,ime,jms,jme,num_soil_layers
+!   INTEGER, INTENT(IN) :: num_roof_layers, num_wall_layers, num_road_layers
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)                    :: TSURFACE0_URB
+   REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(IN) :: TLAYER0_URB
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)                    :: TDEEP0_URB
+   INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN)                 :: IVGTYP
+ 
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D
+
+!   REAL, DIMENSION(ims:ime, 1:num_roof_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D
+!   REAL, DIMENSION(ims:ime, 1:num_wall_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D
+!   REAL, DIMENSION(ims:ime, 1:num_road_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D
+   REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D
+   REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D
+   REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D
+!
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D
+   INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D
+   INTEGER                                            :: UTYPE_URB
+
+   INTEGER :: I,J,K
+
+   DO I=ims,ime
+    DO J=jms,jme
+
+      XXXR_URB2D(I,J)=0.
+      XXXB_URB2D(I,J)=0.
+      XXXG_URB2D(I,J)=0.
+      XXXC_URB2D(I,J)=0.
+
+      SH_URB2D(I,J)=0.
+      LH_URB2D(I,J)=0.
+      G_URB2D(I,J)=0.
+      RN_URB2D(I,J)=0.
+!m
+      FRC_URB2D(I,J)=0.
+      UTYPE_URB2D(I,J)=0.
+
+            IF( IVGTYP(I,J) == 1)  THEN
+               UTYPE_URB2D(I,J) = 2  ! for default. high-density
+               UTYPE_URB = UTYPE_URB2D(I,J)  ! for default. high-density
+               FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB)
+            ENDIF
+            IF( IVGTYP(I,J) == 31) THEN
+               UTYPE_URB2D(I,J) = 3  ! low-density residential
+               UTYPE_URB = UTYPE_URB2D(I,J)  ! low-density residential
+               FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB) 
+            ENDIF
+            IF( IVGTYP(I,J) == 32) THEN
+               UTYPE_URB2D(I,J) = 2  ! high-density
+               UTYPE_URB = UTYPE_URB2D(I,J)  ! high-density
+               FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB) 
+            ENDIF
+            IF( IVGTYP(I,J) == 33) THEN
+               UTYPE_URB2D(I,J) = 1  !  Commercial/Industrial/Transportation
+               UTYPE_URB = UTYPE_URB2D(I,J)  !  Commercial/Industrial/Transportation
+               FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB) 
+            ENDIF
+
+
+      QC_URB2D(I,J)=0.01
+
+      TC_URB2D(I,J)=TSURFACE0_URB(I,J)+0.
+      TR_URB2D(I,J)=TSURFACE0_URB(I,J)+0.
+      TB_URB2D(I,J)=TSURFACE0_URB(I,J)+0.
+      TG_URB2D(I,J)=TSURFACE0_URB(I,J)+0.
+!
+      TS_URB2D(I,J)=TSURFACE0_URB(I,J)+0.
+
+!      DO K=1,num_roof_layers
+!     DO K=1,num_soil_layers
+!         TRL_URB3D(I,1,J)=TLAYER0_URB(I,1,J)+0.
+!         TRL_URB3D(I,2,J)=TLAYER0_URB(I,2,J)+0.
+!         TRL_URB3D(I,3,J)=TLAYER0_URB(I,3,J)+0.
+!         TRL_URB3D(I,4,J)=TLAYER0_URB(I,4,J)+0.
+
+          TRL_URB3D(I,1,J)=TLAYER0_URB(I,1,J)+0.
+          TRL_URB3D(I,2,J)=0.5*(TLAYER0_URB(I,1,J)+TLAYER0_URB(I,2,J))
+          TRL_URB3D(I,3,J)=TLAYER0_URB(I,2,J)+0.
+          TRL_URB3D(I,4,J)=TLAYER0_URB(I,2,J)+(TLAYER0_URB(I,3,J)-TLAYER0_URB(I,2,J))*0.29
+!     END DO
+
+!      DO K=1,num_wall_layers
+!      DO K=1,num_soil_layers
+!m        TBL_URB3D(I,1,J)=TLAYER0_URB(I,1,J)+0.
+!m        TBL_URB3D(I,2,J)=TLAYER0_URB(I,2,J)+0.
+!m        TBL_URB3D(I,3,J)=TLAYER0_URB(I,3,J)+0.
+!m        TBL_URB3D(I,4,J)=TLAYER0_URB(I,4,J)+0.
+
+        TBL_URB3D(I,1,J)=TLAYER0_URB(I,1,J)+0.
+        TBL_URB3D(I,2,J)=0.5*(TLAYER0_URB(I,1,J)+TLAYER0_URB(I,2,J))
+        TBL_URB3D(I,3,J)=TLAYER0_URB(I,2,J)+0.
+        TBL_URB3D(I,4,J)=TLAYER0_URB(I,2,J)+(TLAYER0_URB(I,3,J)-TLAYER0_URB(I,2,J))*0.29
+!      END DO
+
+!      DO K=1,num_road_layers
+      DO K=1,num_soil_layers
+        TGL_URB3D(I,K,J)=TLAYER0_URB(I,K,J)+0.
+      END DO
+
+    END DO
+   END DO
+
+   RETURN
+   END SUBROUTINE urban_var_init
+!===========================================================================
+!
+!  force_restore
+!
+!===========================================================================
+   SUBROUTINE force_restore(CAP,AKS,DELT,S,R,H,LE,TSLEND,TSP,TS)
+
+     REAL, INTENT(IN)  :: CAP,AKS,DELT,S,R,H,LE,TSLEND,TSP
+     REAL, INTENT(OUT) :: TS
+     REAL              :: C1,C2
+
+     C2=24.*3600./2./3.14159
+     C1=SQRT(0.5*C2*CAP*AKS)
+
+     TS = TSP + DELT*( (S+R-H-LE)/C1 -(TSP-TSLEND)/C2 )
+
+   END SUBROUTINE force_restore
+!===========================================================================
+!
+!  bisection (not used)
+!
+!============================================================================== 
+   SUBROUTINE bisection(TSP,PS,S,EPS,RX,SIG,RHO,CP,CH,UA,QA,TA,EL,BET,AKS,TSL,DZ,TS) 
+
+     REAL, INTENT(IN) :: TSP,PS,S,EPS,RX,SIG,RHO,CP,CH,UA,QA,TA,EL,BET,AKS,TSL,DZ
+     REAL, INTENT(OUT) :: TS
+     REAL :: ES,QS0,R,H,ELE,G0,F1,F
+
+     TS1 = TSP - 5.
+     TS2 = TSP + 5.
+
+     DO ITERATION = 1,22
+
+       ES=6.11*EXP( (2.5*10.**6./461.51)*(TS1-273.15)/(273.15*TS1) )
+       QS0=0.622*ES/(PS-0.378*ES)
+       R=EPS*(RX-SIG*(TS1**4.)/60.)
+       H=RHO*CP*CH*UA*(TS1-TA)*100.
+       ELE=RHO*EL*CH*UA*BET*(QS0-QA)*100.
+       G0=AKS*(TS1-TSL)/(DZ/2.)
+       F1= S + R - H - ELE - G0
+
+       TS=0.5*(TS1+TS2)
+
+       ES=6.11*EXP( (2.5*10.**6./461.51)*(TS-273.15)/(273.15*TS) )
+       QS0=0.622*ES/(PS-0.378*ES) 
+       R=EPS*(RX-SIG*(TS**4.)/60.)
+       H=RHO*CP*CH*UA*(TS-TA)*100.
+       ELE=RHO*EL*CH*UA*BET*(QS0-QA)*100.
+       G0=AKS*(TS-TSL)/(DZ/2.)
+       F = S + R - H - ELE - G0
+
+       IF (F1*F > 0.0) THEN
+         TS1=TS
+        ELSE
+         TS2=TS
+       END IF
+
+     END DO
+
+     RETURN
+END SUBROUTINE bisection
+!===========================================================================
+END MODULE module_sf_urban
Index: trunk/WRF.COMMON/WRFV2/phys/module_surface_driver.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys/module_surface_driver.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys/module_surface_driver.F	(revision 2744)
@@ -0,0 +1,881 @@
+!WRF:MEDIATION_LAYER:PHYSICS
+!
+MODULE module_surface_driver
+CONTAINS
+
+   SUBROUTINE surface_driver(                                         &
+     &           acsnom,acsnow,akhs,akms,albedo,br,canwat             &
+     &          ,chklowq,dt,dx,dz8w,dzs,glw                           &
+     &          ,grdflx,gsw,swdown,gz1oz0,hfx,ht,ifsnow,isfflx        &
+     &          ,isltyp,itimestep,ivgtyp,lowlyr,mavail,rmol           &
+     &          ,num_soil_layers,p8w,pblh,pi_phy,pshltr,psih          &
+     &          ,psim,p_phy,q10,q2,qfx,qsfc,qshltr,qz0                &
+     &          ,raincv,rho,sfcevp,sfcexc,sfcrunoff                   &
+     &          ,smois,smstav,smstot,snoalb,snow,snowc,snowh,stepbl   &
+     &          ,th10,th2,thz0,th_phy,tmn,tshltr,tsk,tslb             &
+     &          ,t_phy,u10,udrunoff,ust,uz0,u_frame,u_phy,v10,vegfra  &
+     &          ,vz0,v_frame,v_phy,warm_rain,wspd,xice,xland,z,znt,zs &
+     &          ,ct,tke_myj                                           &
+     &          ,albbck,lh,sh2o,shdmax,shdmin,z0                      &
+     &          ,flqc,flhc,psfc,sst,sst_update,t2,emiss                        &
+     &          ,sf_sfclay_physics,sf_surface_physics,ra_lw_physics   &
+            !  Optional urban 
+     &          ,declin_urb,cosz_urb2d,omg_urb2d,xlat_urb2d           & !I urban
+     &          ,num_roof_layers, num_wall_layers                     & !I urban
+     &          ,num_road_layers, dzr, dzb, dzg                       & !I urban
+     &          ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d         & !H urban
+     &          ,uc_urb2d                                             & !H urban
+     &          ,xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d          & !H urban
+     &          ,trl_urb3d,tbl_urb3d,tgl_urb3d                        & !H urban
+     &          ,sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d          & !H urban
+     &          ,frc_urb2d, utype_urb2d                               & !H urban
+     &          ,ucmcall                                              & ! urban
+     &          , ids,ide,jds,jde,kds,kde                             &
+     &          , ims,ime,jms,jme,kms,kme                             &
+     &          , i_start,i_end,j_start,j_end,kts,kte,num_tiles       &
+             !  Optional moisture tracers
+     &           ,qv_curr, qc_curr, qr_curr                           &
+     &           ,qi_curr, qs_curr, qg_curr                           &
+             !  Optional moisture tracer flags
+     &           ,f_qv,f_qc,f_qr                                      &
+     &           ,f_qi,f_qs,f_qg                                      &
+             !  Other optionals (more or less em specific)
+     &          ,capg,hol,mol                                   &
+     &          ,rainncv,rainbl,regime,thc                         &
+     &          ,qsg,qvg,qcg,soilt1,tsnav                             &
+     &          ,smfr3d,keepfr3dflag                                  &
+             !  Other optionals (more or less nmm specific)
+     &          ,potevp,snopcx,soiltb,sr                              &
+             !  Optional observation nudging
+     &          ,uratx,vratx,tratx                                    &
+                                                                      )
+
+#if ( ! NMM_CORE == 1 )
+   USE module_state_description, ONLY : SFCLAYSCHEME              &
+                                       ,MYJSFCSCHEME              &
+                                       ,GFSSFCSCHEME              &
+                                       ,SLABSCHEME                &
+                                       ,LSMSCHEME                 &
+                                       ,RUCLSMSCHEME
+#else
+   USE module_state_description, ONLY : SFCLAYSCHEME              &
+                                       ,MYJSFCSCHEME              &
+                                       ,GFSSFCSCHEME              &
+                                       ,SLABSCHEME                &
+                                       ,NMMLSMSCHEME              &
+                                       ,LSMSCHEME                 &
+                                       ,RUCLSMSCHEME
+#endif
+   USE module_model_constants
+! *** add new modules of schemes here
+
+   USE module_sf_sfclay
+   USE module_sf_myjsfc
+   USE module_sf_gfs
+   USE module_sf_noahlsm
+   USE module_sf_ruclsm
+#if ( NMM_CORE == 1 )
+   USE module_sf_lsm_nmm
+#endif
+
+   USE module_sf_slab
+!
+   USE module_sf_sfcdiags
+!
+
+   !  This driver calls subroutines for the surface parameterizations.
+   !
+   !  surface layer: (between surface and pbl)
+   !      1. sfclay
+   !      2. myjsfc
+   !  surface: ground temp/lsm scheme:
+   !      1. slab
+   !      2. Noah LSM
+   !      99. NMM LSM (NMM core only)
+!------------------------------------------------------------------
+   IMPLICIT NONE
+!======================================================================
+! Grid structure in physics part of WRF
+!----------------------------------------------------------------------
+! The horizontal velocities used in the physics are unstaggered
+! relative to temperature/moisture variables. All predicted
+! variables are carried at half levels except w, which is at full
+! levels. Some arrays with names (*8w) are at w (full) levels.
+!
+!----------------------------------------------------------------------
+! In WRF, kms (smallest number) is the bottom level and kme (largest
+! number) is the top level.  In your scheme, if 1 is at the top level,
+! then you have to reverse the order in the k direction.
+!
+!         kme      -   half level (no data at this level)
+!         kme    ----- full level
+!         kme-1    -   half level
+!         kme-1  ----- full level
+!         .
+!         kms+2    -   half level
+!         kms+2  ----- full level
+!         kms+1    -   half level
+!         kms+1  ----- full level
+!         kms      -   half level
+!         kms    ----- full level
+!
+!======================================================================
+! Definitions
+!-----------
+! Theta      potential temperature (K)
+! Qv         water vapor mixing ratio (kg/kg)
+! Qc         cloud water mixing ratio (kg/kg)
+! Qr         rain water mixing ratio (kg/kg)
+! Qi         cloud ice mixing ratio (kg/kg)
+! Qs         snow mixing ratio (kg/kg)
+!-----------------------------------------------------------------
+!-- itimestep     number of time steps
+!-- GLW           downward long wave flux at ground surface (W/m^2)
+!-- GSW           net short wave flux at ground surface (W/m^2)
+!-- SWDOWN        downward short wave flux at ground surface (W/m^2)
+!-- EMISS         surface emissivity (between 0 and 1)
+!-- TSK           surface temperature (K)
+!-- TMN           soil temperature at lower boundary (K)
+!-- XLAND         land mask (1 for land, 2 for water)
+!-- ZNT           time-varying roughness length (m)
+!-- Z0            background roughness length (m)
+!-- MAVAIL        surface moisture availability (between 0 and 1)
+!-- UST           u* in similarity theory (m/s)
+!-- MOL           T* (similarity theory) (K)
+!-- HOL           PBL height over Monin-Obukhov length
+!-- PBLH          PBL height (m)
+!-- CAPG          heat capacity for soil (J/K/m^3)
+!-- THC           thermal inertia (Cal/cm/K/s^0.5)
+!-- SNOWC         flag indicating snow coverage (1 for snow cover)
+!-- HFX           net upward heat flux at the surface (W/m^2)
+!-- QFX           net upward moisture flux at the surface (kg/m^2/s)
+!-- LH            net upward latent heat flux at surface (W/m^2)
+!-- REGIME        flag indicating PBL regime (stable, unstable, etc.)
+!-- tke_myj       turbulence kinetic energy from Mellor-Yamada-Janjic (MYJ) (m^2/s^2)
+!-- akhs          sfc exchange coefficient of heat/moisture from MYJ
+!-- akms          sfc exchange coefficient of momentum from MYJ
+!-- thz0          potential temperature at roughness length (K)
+!-- uz0           u wind component at roughness length (m/s)
+!-- vz0           v wind component at roughness length (m/s)
+!-- qsfc          specific humidity at lower boundary (kg/kg)
+!-- uratx         ratio of u over u10 (Added for obs-nudging)
+!-- vratx         ratio of v over v10 (Added for obs-nudging)
+!-- tratx         ratio of t over th2 (Added for obs-nudging)
+!-- u10           diagnostic 10-m u component from surface layer
+!-- v10           diagnostic 10-m v component from surface layer
+!-- th2           diagnostic 2-m theta from surface layer and lsm
+!-- t2            diagnostic 2-m temperature from surface layer and lsm
+!-- q2            diagnostic 2-m mixing ratio from surface layer and lsm
+!-- tshltr        diagnostic 2-m theta from MYJ
+!-- th10          diagnostic 10-m theta from MYJ
+!-- qshltr        diagnostic 2-m specific humidity from MYJ
+!-- q10           diagnostic 10-m specific humidity from MYJ
+!-- lowlyr        index of lowest model layer above ground
+!-- rr            dry air density (kg/m^3)
+!-- u_phy         u-velocity interpolated to theta points (m/s)
+!-- v_phy         v-velocity interpolated to theta points (m/s)
+!-- th_phy        potential temperature (K)
+!-- moist         moisture array (4D - last index is species) (kg/kg)
+!-- p_phy         pressure (Pa)
+!-- pi_phy        exner function (dimensionless)
+!-- pshltr        diagnostic shelter (2m) pressure from MYJ (Pa)
+!-- p8w           pressure at full levels (Pa)
+!-- t_phy         temperature (K)
+!-- dz8w          dz between full levels (m)
+!-- z             height above sea level (m)
+!-- DX            horizontal space interval (m)
+!-- DT            time step (second)
+!-- PSFC          pressure at the surface (Pa)
+!-- SST           sea-surface temperature (K)
+!-- TSLB          
+!-- ZS
+!-- DZS
+!-- num_soil_layers number of soil layer
+!-- IFSNOW      ifsnow=1 for snow-cover effects
+!
+!-- ids           start index for i in domain
+!-- ide           end index for i in domain
+!-- jds           start index for j in domain
+!-- jde           end index for j in domain
+!-- kds           start index for k in domain
+!-- kde           end index for k in domain
+!-- ims           start index for i in memory
+!-- ime           end index for i in memory
+!-- jms           start index for j in memory
+!-- jme           end index for j in memory
+!-- kms           start index for k in memory
+!-- kme           end index for k in memory
+!-- its           start index for i in tile
+!-- ite           end index for i in tile
+!-- jts           start index for j in tile
+!-- jte           end index for j in tile
+!-- kts           start index for k in tile
+!-- kte           end index for k in tile
+!
+!******************************************************************
+!------------------------------------------------------------------ 
+
+   INTEGER, INTENT(IN) ::                                             &
+     &           ids,ide,jds,jde,kds,kde                              &
+     &          ,ims,ime,jms,jme,kms,kme                              &
+     &          ,kts,kte,num_tiles
+
+   INTEGER, INTENT(IN) :: sf_sfclay_physics,sf_surface_physics,ra_lw_physics,sst_update
+
+   INTEGER, INTENT(IN) :: ucmcall                                     !urban
+
+   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
+     &           i_start,i_end,j_start,j_end
+
+   INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   ISLTYP
+   INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   IVGTYP
+   INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   LOWLYR
+   INTEGER, INTENT(IN )::   IFSNOW
+   INTEGER, INTENT(IN )::   ISFFLX
+   INTEGER, INTENT(IN )::   ITIMESTEP
+   INTEGER, INTENT(IN )::   NUM_SOIL_LAYERS
+   INTEGER, INTENT(IN )::   STEPBL
+   LOGICAL, INTENT(IN )::   WARM_RAIN
+   REAL , INTENT(IN )::   U_FRAME
+   REAL , INTENT(IN )::   V_FRAME
+   REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   SMOIS
+   REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   TSLB
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   GLW
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   GSW,SWDOWN
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   HT
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   RAINCV
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SST
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   TMN
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   VEGFRA
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   XICE
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   XLAND
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   MAVAIL
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   SNOALB
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ACSNOW
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   AKHS
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   AKMS
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ALBEDO
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   CANWAT
+
+
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   GRDFLX
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   HFX
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   RMOL
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   PBLH
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   Q2
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QFX
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QSFC
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QZ0
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SFCRUNOFF
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SMSTAV
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SMSTOT
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOW
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOWC
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOWH
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   TH2
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   THZ0
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   TSK
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UDRUNOFF
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UST
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UZ0
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   VZ0
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   WSPD
+   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ZNT
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   BR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   CHKLOWQ
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   GZ1OZ0
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSHLTR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSIH
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSIM
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   Q10
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   QSHLTR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   TH10
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   TSHLTR
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   U10
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   V10
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSFC
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   ACSNOM
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   SFCEVP
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   SFCEXC
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   FLHC
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   FLQC
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) ::   CT
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   DZ8W
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   P8W
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   PI_PHY
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   P_PHY
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   RHO
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   TH_PHY
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   T_PHY
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   U_PHY
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   V_PHY
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   Z
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::   TKE_MYJ
+   REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::   DZS
+   REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::   ZS
+   REAL, INTENT(IN )::   DT
+   REAL, INTENT(IN )::   DX
+
+!  arguments for NCAR surface physics
+
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   ALBBCK  ! INOUT needed for NMM
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   LH
+   REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   SH2O
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SHDMAX
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SHDMIN
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   Z0
+
+!
+! Optional
+!
+
+!
+!  Observation nudging
+!
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   uratx  !Added for obs-nudging
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   vratx  !Added for obs-nudging
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   tratx  !Added for obs-nudging
+!
+! Flags relating to the optional tendency arrays declared above
+! Models that carry the optional tendencies will provdide the
+! optional arguments at compile time; these flags all the model
+! to determine at run-time whether a particular tracer is in
+! use or not.
+!
+   LOGICAL, INTENT(IN), OPTIONAL ::                             &
+                                                      f_qv      &
+                                                     ,f_qc      &
+                                                     ,f_qr      &
+                                                     ,f_qi      &
+                                                     ,f_qs      &
+                                                     ,f_qg
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         OPTIONAL, INTENT(INOUT) ::                              &
+                      ! optional moisture tracers
+                      ! 2 time levels; if only one then use CURR
+                      qv_curr, qc_curr, qr_curr                  &
+                     ,qi_curr, qs_curr, qg_curr
+
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   capg
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   emiss
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   hol
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   mol
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   regime
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN )::     rainncv
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   RAINBL
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   t2
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN )::     thc
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qsg
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qvg
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qcg
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   soilt1
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   tsnav
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   potevp ! NMM LSM
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   snopcx ! NMM LSM
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   soiltb ! NMM LSM
+   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   sr ! NMM and RUC LSM
+   REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT)::   smfr3d
+   REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT)::   keepfr3dflag
+
+!  LOCAL  VAR
+
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
+   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
+
+   REAL,       DIMENSION( ims:ime, jms:jme )          ::  ZOL
+
+   REAL,       DIMENSION( ims:ime, jms:jme )          ::          &
+                                                             QGH, &
+                                                             CHS, &
+                                                             CPM, &
+                                                            CHS2, &
+                                                            CQS2
+
+   REAL    :: DTMIN,DTBL
+!
+   INTEGER :: i,J,K,NK,jj,ij
+   LOGICAL :: radiation, myj, frpcpn
+!-------------------------------------------------
+! urban related variables are added to declaration
+!-------------------------------------------------
+     REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB                                 !urban
+     REAL, OPTIONAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D  !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D   !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D  !urban
+     INTEGER,  OPTIONAL, INTENT(IN) :: num_roof_layers                         !urban
+     INTEGER,  OPTIONAL, INTENT(IN) :: num_wall_layers                         !urban
+     INTEGER,  OPTIONAL, INTENT(IN) :: num_road_layers                         !urban
+     REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZR          !urban
+     REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZB          !urban
+     REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZG          !urban
+
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TR_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TB_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TG_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TC_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: QC_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: UC_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXR_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXB_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXG_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXC_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
+           INTENT(INOUT)  :: TRL_URB3D                                 !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
+           INTENT(INOUT)  :: TBL_URB3D                                 !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
+           INTENT(INOUT)  :: TGL_URB3D                                 !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: SH_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: LH_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: G_URB2D  !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: RN_URB2D !urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TS_URB2D !urban
+!
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: FRC_URB2D  !urban 
+     INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: UTYPE_URB2D  !urban 
+
+     REAL,  DIMENSION( ims:ime, jms:jme )  :: PSIM_URB2D  !urban local var
+     REAL,  DIMENSION( ims:ime, jms:jme )  :: PSIH_URB2D  !urban local var
+     REAL,  DIMENSION( ims:ime, jms:jme )  :: GZ1OZ0_URB2D  !urban local var
+!m     REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_URB2D  !urban local var
+     REAL,  DIMENSION( ims:ime, jms:jme )  :: AKMS_URB2D  !urban local var
+     REAL,  DIMENSION( ims:ime, jms:jme )  :: U10_URB2D   !urban local var
+     REAL,  DIMENSION( ims:ime, jms:jme )  :: V10_URB2D   !urban local var
+     REAL,  DIMENSION( ims:ime, jms:jme )  :: TH2_URB2D   !urban local var
+     REAL,  DIMENSION( ims:ime, jms:jme )  :: Q2_URB2D    !urban local var
+     REAL,  DIMENSION( ims:ime, jms:jme )  :: UST_URB2D  !urban local var
+
+!------------------------------------------------------------------
+   CHARACTER*256 :: message
+!------------------------------------------------------------------
+!
+
+  if (sf_sfclay_physics .eq. 0) return
+
+  v_phytmp = 0.
+  u_phytmp = 0.
+  ZOL = 0.
+  QGH = 0.
+  CHS = 0.
+  CPM = 0.
+  CHS2 = 0.
+  DTMIN = 0.
+  DTBL = 0.
+
+! RAINBL in mm (Accumulation between PBL calls)
+
+  IF ( PRESENT( rainncv ) .AND. PRESENT( rainbl ) ) THEN
+    !$OMP PARALLEL DO   &
+    !$OMP PRIVATE ( ij, i, j, k )
+    DO ij = 1 , num_tiles
+      DO j=j_start(ij),j_end(ij)
+      DO i=i_start(ij),i_end(ij)
+         RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j) 
+         RAINBL(i,j) = MAX (RAINBL(i,j), 0.0) 
+      ENDDO
+      ENDDO
+    ENDDO
+    !$OMP END PARALLEL DO
+  ELSE IF ( PRESENT( rainbl ) ) THEN
+    !$OMP PARALLEL DO   &
+    !$OMP PRIVATE ( ij, i, j, k )
+    DO ij = 1 , num_tiles
+      DO j=j_start(ij),j_end(ij)
+      DO i=i_start(ij),i_end(ij)
+         RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j)
+         RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
+      ENDDO
+      ENDDO
+    ENDDO
+    !$OMP END PARALLEL DO
+  ENDIF
+! Update SST
+  IF (sst_update .EQ. 1) THEN
+    !$OMP PARALLEL DO   &
+    !$OMP PRIVATE ( ij, i, j, k )
+    DO ij = 1 , num_tiles
+      DO j=j_start(ij),j_end(ij)
+      DO i=i_start(ij),i_end(ij)
+        IF(XLAND(i,j) .GT. 1.5)TSK(i,j)=SST(i,j)
+      ENDDO
+      ENDDO
+    ENDDO
+    !$OMP END PARALLEL DO
+  ENDIF
+
+  IF (itimestep .eq. 1 .or. mod(itimestep,STEPBL) .eq. 0) THEN
+
+  radiation = .false.
+  myj = .false.
+  frpcpn = .false.
+
+  IF (ra_lw_physics .gt. 0) radiation = .true.
+
+!---- 
+! CALCULATE CONSTANT
+ 
+     DTMIN=DT/60.
+! Surface schemes need PBL time step for updates and accumulations
+! Assume these schemes provide no tendencies
+     DTBL=DT*STEPBL
+
+! SAVE OLD VALUES
+
+
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij, i, j, k )
+     DO ij = 1 , num_tiles
+       DO j=j_start(ij),j_end(ij)
+       DO i=i_start(ij),i_end(ij)
+! PSFC : in Pa
+          PSFC(I,J)=p8w(I,kts,J)
+! REVERSE ORDER IN THE VERTICAL DIRECTION
+          DO k=kts,kte
+            v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
+            u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
+          ENDDO
+       ENDDO
+       ENDDO
+     ENDDO
+     !$OMP END PARALLEL DO
+
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij, i, j, k )
+     DO ij = 1 , num_tiles
+     sfclay_select: SELECT CASE(sf_sfclay_physics)
+
+     CASE (SFCLAYSCHEME)
+#if (NMM_CORE != 1)
+! DX varies spatially in NMM, therefore, SFCLAY cannot be called
+! because it takes a scalar DX. NMM passes in a dummy value for this
+! scalar.  NEEDS FURTHER ATTENTION. JM 20050215
+       IF (PRESENT(qv_curr)                            .AND.    &
+           PRESENT(mol)        .AND.  PRESENT(regime)  .AND.    &
+                                                      .TRUE. ) THEN
+         CALL wrf_debug( 100, 'in SFCLAY' )
+         CALL SFCLAY(u_phytmp,v_phytmp,t_phy,qv_curr,&
+               p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
+               znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
+               xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
+               uratx,vratx,tratx,                                  &
+               u10,v10,th2,t2,q2,                                  &
+               gz1oz0,wspd,br,isfflx,dx,                           &
+               svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
+               ids,ide, jds,jde, kds,kde,                          &
+               ims,ime, jms,jme, kms,kme,                          &
+               i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
+       ELSE
+         CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
+       ENDIF
+
+#else
+       CALL wrf_error_fatal('SFCLAY cannot be used with NMM')
+#endif
+      CASE (MYJSFCSCHEME)
+       IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
+                                                      .TRUE. ) THEN
+
+        myj =.true.
+
+            CALL wrf_debug(100,'in MYJSFC')
+            CALL MYJSFC(itimestep,ht,dz8w,                         &
+              p_phy,p8w,th_phy,t_phy,                              &
+              qv_curr,qc_curr,                                      &
+              u_phy,v_phy,tke_myj,                                 &
+              tsk,qsfc,thz0,qz0,uz0,vz0,                           &
+              lowlyr,                                              &
+              xland,                                               &
+              ust,znt,z0,pblh,mavail,rmol,                         &
+              akhs,akms,                                           &
+              chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct,       &
+              u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr,               &
+              ids,ide, jds,jde, kds,kde,                           &
+              ims,ime, jms,jme, kms,kme,                           &
+              i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
+       ELSE
+         CALL wrf_error_fatal('Lacking arguments for MYJSFC in surface driver')
+       ENDIF
+
+     CASE (GFSSFCSCHEME)
+       IF (PRESENT(qv_curr) .AND. .TRUE. ) THEN
+       CALL wrf_debug( 100, 'in GFSSFC' )
+         CALL SF_GFS(u_phytmp,v_phytmp,t_phy,qv_curr,              &
+               p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM,        &
+               ZNT,UST,PSIM,PSIH,                                  &
+               XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,                     &
+               QGH,QSFC,U10,V10,                                   &
+               GZ1OZ0,WSPD,BR,ISFFLX,                              &
+               EP_1,EP_2,KARMAN,itimestep,                         &
+               ids,ide, jds,jde, kds,kde,                          &
+               ims,ime, jms,jme, kms,kme,                          &
+               i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
+        CALL wrf_debug(100,'in SFCDIAGS')
+       ELSE
+         CALL wrf_error_fatal('Lacking arguments for SF_GFS in surface driver')
+       ENDIF
+
+     CASE DEFAULT
+        
+       WRITE( message , * )                                &
+   'The sfclay option does not exist: sf_sfclay_physics = ', sf_sfclay_physics
+       CALL wrf_error_fatal ( message )
+
+     END SELECT sfclay_select
+     ENDDO
+     !$OMP END PARALLEL DO
+
+     IF (ISFFLX.EQ.0 ) GOTO 430
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij, i, j, k )
+     DO ij = 1 , num_tiles
+
+     sfc_select: SELECT CASE(sf_surface_physics)
+
+     CASE (SLABSCHEME)
+
+       IF (PRESENT(qv_curr)                            .AND.    &
+           PRESENT(capg)        .AND.    &
+                                                      .TRUE. ) THEN
+           DO j=j_start(ij),j_end(ij)
+           DO i=i_start(ij),i_end(ij)
+!          CQS2 ACCOUNTS FOR MAVAIL FOR SFCDIAGS 2M Q
+              CQS2(I,J)= CQS2(I,J)*MAVAIL(I,J)
+           ENDDO
+           ENDDO
+
+        CALL wrf_debug(100,'in SLAB')
+          CALL SLAB(t_phy,qv_curr,p_phy,flhc,flqc,  &
+             psfc,xland,tmn,hfx,qfx,lh,tsk,qsfc,chklowq,          &
+             gsw,glw,capg,thc,snowc,emiss,mavail,                 &
+             dtbl,rcp,xlv,dtmin,ifsnow,                           &
+             svp1,svp2,svp3,svpt0,ep_2,karman,eomeg,stbolt,       &
+             tslb,zs,dzs,num_soil_layers,radiation,               &
+             ids,ide, jds,jde, kds,kde,                           &
+             ims,ime, jms,jme, kms,kme,                           &
+             i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
+
+           DO j=j_start(ij),j_end(ij)
+           DO i=i_start(ij),i_end(ij)
+              SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
+           ENDDO
+           ENDDO
+
+        CALL wrf_debug(100,'in SFCDIAGS')
+          CALL SFCDIAGS(hfx,qfx,tsk,qsfc,chs2,cqs2,t2,th2,q2,      &
+                     psfc,cp,r_d,rcp,                              &
+                     ids,ide, jds,jde, kds,kde,                    &
+                     ims,ime, jms,jme, kms,kme,                    &
+             i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
+
+       ELSE
+         CALL wrf_error_fatal('Lacking arguments for SLAB in surface driver')
+       ENDIF
+
+#if ( NMM_CORE == 1 )
+     CASE (NMMLSMSCHEME)
+       IF (PRESENT(qv_curr)    .AND.  PRESENT(rainbl)  .AND.    &
+           PRESENT(potevp)     .AND.  PRESENT(snopcx)  .AND.    &
+           PRESENT(soiltb)     .AND.  PRESENT(sr)      .AND.    &
+                                                      .TRUE. ) THEN
+           CALL wrf_debug(100,'in NMM LSM')
+           CALL nmmlsm(dz8w,qv_curr,p8w,rho,                    &
+                t_phy,th_phy,tsk,chs,                           &
+                hfx,qfx,qgh,swdown,glw,lh,rmol,                 &
+                smstav,smstot,sfcrunoff,                        &
+                udrunoff,ivgtyp,isltyp,vegfra,sfcevp,potevp,    &
+                grdflx,sfcexc,acsnow,acsnom,snopcx,             &
+                albbck,tmn,xland,xice,qz0,                      &
+                th2,q2,snowc,cqs2,qsfc,soiltb,chklowq,rainbl,   &
+                num_soil_layers,dtbl,dzs,itimestep,             &
+                smois,tslb,snow,canwat,cpm,rcp,sr,              &    !tslb
+                albedo,snoalb,sh2o,snowh,                       &
+                ids,ide, jds,jde, kds,kde,                      &
+                ims,ime, jms,jme, kms,kme,                      &
+                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
+          CALL wrf_debug(100,'back from NMM LSM')
+       ELSE
+         CALL wrf_error_fatal('Lacking arguments for NMMLSM in surface driver')
+       ENDIF
+#endif
+
+     CASE (LSMSCHEME)
+
+       IF (PRESENT(qv_curr)    .AND.  PRESENT(rainbl)        .AND.    &
+!          PRESENT(emiss)      .AND.  PRESENT(t2)            .AND.    &
+!          PRESENT(declin_urb) .AND.  PRESENT(cosz_urb2d)    .AND.    &
+!          PRESENT(omg_urb2d)  .AND. PRESENT( xlat_urb2d)    .AND.    &       
+!          PRESENT(dzr)       .AND.    & 
+!          PRESENT( dzb)            .AND. PRESENT(dzg)       .AND.    &
+!          PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d)         .AND.    &
+!          PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND.            &
+!          PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND.            & 
+!          PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND.        & 
+!          PRESENT(xxxg_urb2d) .AND.                                  &
+!          PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND.         &
+!          PRESENT(tbl_urb3d)   .AND. PRESENT(tgl_urb3d)  .AND.       &         
+!          PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d)  .AND.           &
+!          PRESENT(g_urb2d)   .AND. PRESENT(rn_urb2d) .AND.           &
+!          PRESENT(ts_urb2d)                          .AND.           & 
+!          PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d)   .AND.      &          
+                                                      .TRUE. ) THEN
+!------------------------------------------------------------------
+         CALL wrf_debug(100,'in NOAH LSM')
+           CALL lsm(dz8w,qv_curr,p8w,t_phy,tsk,                 &
+                hfx,qfx,lh,grdflx,qgh,gsw,glw,smstav,smstot,    &
+                sfcrunoff,udrunoff,ivgtyp,isltyp,vegfra,        &
+                albedo,albbck,znt,z0, tmn,xland,xice, emiss,    &
+                snowc,qsfc,rainbl,                              & 
+                num_soil_layers,dtbl,dzs,itimestep,             &
+                smois,tslb,snow,canwat,                         &
+                chs, chs2, cqs2, cpm,rcp,                       &    
+                sh2o,snowh,                                     & !h  
+                u_phy,v_phy,                                    & !I
+                snoalb,shdmin,shdmax,                           & !i
+                acsnom,acsnow,                                  & !o 
+                ids,ide, jds,jde, kds,kde,                      &
+                ims,ime, jms,jme, kms,kme,                      &
+                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,    &
+                ucmcall                                         &
+!Optional urban
+                ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d,  & !H urban
+                uc_urb2d,                                       & !H urban
+                xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d,    & !H urban
+                trl_urb3d,tbl_urb3d,tgl_urb3d,                  & !H urban
+                sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d,    & !H urban
+                psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d,      & !O urban
+                GZ1OZ0_urb2d, AKMS_URB2D,                       & !O urban
+                th2_urb2d,q2_urb2d,ust_urb2d,                   & !O urban
+                declin_urb,cosz_urb2d,omg_urb2d,                & !I urban
+                xlat_urb2d,                                     & !I urban
+                num_roof_layers, num_wall_layers,               & !I urban
+                num_road_layers, DZR, DZB, DZG,                 & !I urban
+                FRC_URB2D, UTYPE_URB2D                          & ! urban
+                )
+
+
+           DO j=j_start(ij),j_end(ij)
+           DO i=i_start(ij),i_end(ij)
+              CHKLOWQ(I,J)= 1.0
+              SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
+           ENDDO
+           ENDDO
+         
+          CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2,      &
+                     PSFC,CP,R_d,RCP,                              &
+                     ids,ide, jds,jde, kds,kde,                    &
+                     ims,ime, jms,jme, kms,kme,                    &
+             i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
+
+!urban
+     IF(UCMCALL.eq.1) THEN
+       DO j=j_start(ij),j_end(ij)                             !urban
+         DO i=i_start(ij),i_end(ij)                           !urban
+          IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &  !urban
+              IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
+!             TH2(I,J)  = TH2_URB2D(I,J)                       !urban
+!             T2(I,J)   = TH2_URB2D(I,J)/(1.E5/PSFC(I,J))**RCP !urban
+!m             T2(I,J)   = TH2_URB2D(I,J)                       !urban
+             T2(I,J)   = FRC_URB2D(i,j)*TH2_URB2D(I,J) + (1-FRC_URB2D(i,j))*T2(I,J) !urban
+             TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**RCP                               !urban
+!m             Q2(I,J)   = Q2_URB2D(I,J)                                            !urban
+             Q2(I,J)   = FRC_URB2D(i,j)*Q2_URB2D(I,J) +(1-FRC_URB2D(i,j))* Q2(I,J)  !urban
+             U10(I,J)  = U10_URB2D(I,J)                       !urban
+             V10(I,J)  = V10_URB2D(I,J)                       !urban
+             PSIM(I,J) = PSIM_URB2D(I,J)                      !urban
+             PSIH(I,J) = PSIH_URB2D(I,J)                      !urban
+             GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J)                  !urban
+!m             AKHS(I,J) = AKHS_URB2D(I,J)                    !urban
+             AKHS(I,J) = CHS(I,J)                             !urban
+             AKMS(I,J) = AKMS_URB2D(I,J)                      !urban
+           END IF                                             !urban
+         ENDDO                                                !urban
+       ENDDO                                                  !urban
+     ENDIF
+!------------------------------------------------------------------
+
+       ELSE
+         CALL wrf_error_fatal('Lacking arguments for LSM in surface driver')
+       ENDIF
+
+     CASE (RUCLSMSCHEME)
+       IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
+!           PRESENT(emiss)      .AND.  PRESENT(t2)      .AND.    &
+           PRESENT(qsg)        .AND.  PRESENT(qvg)     .AND.    &
+           PRESENT(qcg)        .AND.  PRESENT(soilt1)  .AND.    &
+           PRESENT(tsnav)      .AND.  PRESENT(smfr3d)  .AND.    &
+           PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND.    &
+                                                      .TRUE. ) THEN
+
+           IF( PRESENT(sr) ) THEN
+               frpcpn=.true.
+           ELSE
+               SR = 1.
+           ENDIF
+
+           CALL wrf_debug(100,'in RUC LSM')
+           CALL LSMRUC(dtbl,itimestep,num_soil_layers,          &
+                zs,rainbl,snow,snowh,snowc,sr,frpcpn,           &
+                dz8w,p8w,t_phy,qv_curr,qc_curr,rho,             & !p8w in [pa]
+                glw,gsw,emiss,chklowq,                          &
+                flqc,flhc,mavail,canwat,vegfra,albedo,znt,      &
+                qsfc,qsg,qvg,qcg,soilt1,tsnav,                  &
+                tmn,ivgtyp,isltyp,xland,xice,                   &
+                cp,g,xlv,stbolt,                                &
+                smois,smstav,smstot,tslb,tsk,hfx,qfx,lh,        &
+                sfcrunoff,udrunoff,sfcexc,                      &
+                sfcevp,grdflx,acsnow,                           &
+                smfr3d,keepfr3dflag,                            &
+                myj,                                            &
+                ids,ide, jds,jde, kds,kde,                      &
+                ims,ime, jms,jme, kms,kme,                      &
+                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
+
+         IF(.not. MYJ) then
+
+          CALL SFCDIAGS(HFX,QFX,TSK,QVG,CHS2,CQS2,T2,TH2,Q2,      &
+                     PSFC,CP,R_d,RCP,                              &
+                     ids,ide, jds,jde, kds,kde,                    &
+                     ims,ime, jms,jme, kms,kme,                    &
+             i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
+         ENDIF
+ 
+
+       ELSE
+         CALL wrf_error_fatal('Lacking arguments for RUCLSM in surface driver')
+       ENDIF
+
+     CASE DEFAULT
+
+       WRITE( message , * ) &
+        'The surface option does not exist: sf_surface_physics = ', sf_surface_physics
+       CALL wrf_error_fatal ( message )
+
+     END SELECT sfc_select
+     ENDDO
+     !$OMP END PARALLEL DO
+
+ 430 CONTINUE
+
+
+! Reset RAINBL in mm (Accumulation between PBL calls)
+
+     IF ( PRESENT( rainbl ) ) THEN
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij, i, j, k )
+       DO ij = 1 , num_tiles
+         DO j=j_start(ij),j_end(ij)
+         DO i=i_start(ij),i_end(ij)
+            RAINBL(i,j) = 0.
+         ENDDO
+         ENDDO
+       ENDDO
+       !$OMP END PARALLEL DO
+     ENDIF
+
+   ENDIF
+
+   END SUBROUTINE surface_driver
+
+END MODULE module_surface_driver
+
Index: trunk/WRF.COMMON/WRFV2/phys_save
===================================================================
--- trunk/WRF.COMMON/WRFV2/phys_save	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/phys_save	(revision 2744)
@@ -0,0 +1,8 @@
+mkdir save/phys
+cp -rf phys/diff_module_physics_init save/phys
+cp -rf phys/Makefile save/phys
+cp -rf phys/module_physics_init.F save/phys
+cp -rf phys/module_lmd_driver.F save/phys
+cp -rf phys/diff_module_physics_addtendc save/phys
+cp -rf phys/diff_Makefile save/phys
+cp -rf phys/module_physics_addtendc.F save/phys
Index: trunk/WRF.COMMON/WRFV2/physics.sed
===================================================================
--- trunk/WRF.COMMON/WRFV2/physics.sed	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/physics.sed	(revision 2744)
@@ -0,0 +1,3 @@
+s+ *../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time+& -L../YORGLYORGL/libo -llmd+g
+s+ *../frame/pack_utils.o+& -L../YORGLYORGL/libo -llmd+g
+
Index: trunk/WRF.COMMON/WRFV2/run/GENPARM.TBL
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/GENPARM.TBL	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/GENPARM.TBL	(revision 2744)
@@ -0,0 +1,34 @@
+General Parameters
+SLOPE_DATA
+9
+0.1 
+0.6
+1.0
+0.35
+0.55
+0.8
+0.63
+0.0
+0.0
+SBETA_DATA
+-2.0
+FXEXP_DATA
+2.0
+CSOIL_DATA
+2.00E+6
+SALP_DATA
+2.6
+REFDK_DATA
+2.0E-6
+REFKDT_DATA
+3.0
+FRZK_DATA
+0.15
+ZBOT_DATA
+-8.0
+CZIL_DATA
+0.1
+SMLOW_DATA
+0.5
+SMHIGH_DATA
+3.0
Index: trunk/WRF.COMMON/WRFV2/run/LANDUSE.TBL
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/LANDUSE.TBL	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/LANDUSE.TBL	(revision 2744)
@@ -0,0 +1,142 @@
+OLD
+13,2, 'ALBD   SLMO   SFEM   SFZ0 THERIN   SCFX   SFHC   '
+SUMMER
+1,      18.,   .05,   .88,   50.,    3.,  1.22, 18.9e5,'Urban land'
+2,      17.,   .30,   .92,   15.,    4.,  2.76, 25.0e5,'Agriculture'
+3,      19.,   .15,   .92,   12.,    3.,  2.37, 20.8e5,'Range-grassland'
+4,      16.,   .30,   .93,   50.,    4.,  2.63, 25.0e5,'Deciduous forest'
+5,      12.,   .30,   .95,   50.,    4.,  3.33, 29.2e5,'Coniferous forest'
+6,      14.,   .35,   .95,   40.,    5.,  2.21, 41.8e5,'Mixed forest and wet land'
+7,       8.,   1.0,   .98,  0.01,    6.,    0., 9.0e25,'Water'
+8,      14.,   .50,   .95,   20.,    6.,  1.36, 29.2e5,'Marsh or wet land'
+9,      25.,   .02,   .85,   10.,    2.,  1.76, 12.0e5,'Desert'
+10,     15.,   .50,   .92,   10.,    5.,  3.67, 9.0e25,'Tundra'
+11,     55.,   .95,   .95,    5.,    5.,    0., 9.0e25,'Permanent ice'
+12,     12.,   .50,   .95,   50.,    5.,  1.66, 29.2e5,'Tropical or subtropical forest'
+13,     20.,   .15,   .92,   15.,    3.,  2.00, 25.0e5,'Savannah'
+WINTER
+1,      18.,   .10,   .88,   50.,    3.,  1.22, 18.9e5,'Urban land'
+2,      23.,   .60,   .92,    5.,    4.,  1.78, 25.0e5,'Agriculture'
+3,      23.,   .30,   .92,   10.,    4.,  1.78, 20.8e5,'Range-grassland'
+4,      17.,   .60,   .93,   50.,    5.,  2.40, 25.0e5,'Deciduous forest'
+5,      12.,   .60,   .95,   50.,    5.,  3.33, 29.2e5,'Coniferous forest'
+6,      14.,   .70,   .95,   40.,    6.,  2.21, 41.8e5,'Mixed forest and wet land'
+7,       8.,   1.0,   .98,  0.01,    6.,    0., 9.0e25,'Water'
+8,      14.,   .75,   .95,   20.,    6.,  1.40, 29.2e5,'Marsh or wet land'
+9,      25.,   .05,   .85,   10.,    2.,  1.76, 12.0e5,'Desert'
+10,     15.,   .90,   .92,   10.,    5.,  3.67, 9.0e25,'Tundra'
+11,     70.,   .95,   .95,    5.,    5.,    0., 9.0e25,'Permanent ice'
+12,     12.,   .50,   .95,   50.,    5.,  1.66, 29.2e5,'Tropical or subtropical forest'
+13,     20.,   .15,   .92,   15.,    3.,  2.00, 25.0e5,'Savannah'
+USGS
+33,2, 'ALBD   SLMO   SFEM   SFZ0 THERIN   SCFX   SFHC   '
+SUMMER
+1,      15.,   .10,   .88,   80.,    3.,  1.67, 18.9e5,'Urban and Built-Up Land'
+2,      17.,   .30,  .985,   15.,    4.,  2.71, 25.0e5,'Dryland Cropland and Pasture'
+3,      18.,   .50,  .985,   10.,    4.,  2.20, 25.0e5,'Irrigated Cropland and Pasture'
+4,      18.,   .25,  .985,   15.,    4.,  2.56, 25.0e5,'Mixed Dryland/Irrigated Cropland and Pasture'
+5,      18.,   .25,   .98,   14.,    4.,  2.56, 25.0e5,'Cropland/Grassland Mosaic'
+6,      16.,   .35,  .985,   20.,    4.,  3.19, 25.0e5,'Cropland/Woodland Mosaic'
+7,      19.,   .15,   .96,   12.,    3.,  2.37, 20.8e5,'Grassland'
+8,      22.,   .10,   .93,    5.,    3.,  1.56, 20.8e5,'Shrubland'
+9,      20.,   .15,   .95,    6.,    3.,  2.14, 20.8e5,'Mixed Shrubland/Grassland'
+10,     20.,   .15,   .92,   15.,    3.,  2.00, 25.0e5,'Savanna'
+11,     16.,   .30,   .93,   50.,    4.,  2.63, 25.0e5,'Deciduous Broadleaf Forest'
+12,     14.,   .30,   .94,   50.,    4.,  2.86, 25.0e5,'Deciduous Needleleaf Forest'
+13,     12.,   .50,   .95,   50.,    5.,  1.67, 29.2e5,'Evergreen Broadleaf Forest'
+14,     12.,   .30,   .95,   50.,    4.,  3.33, 29.2e5,'Evergreen Needleleaf Forest'
+15,     13.,   .30,   .97,   50.,    4.,  2.11, 41.8e5,'Mixed Forest'
+16,      8.,   1.0,   .98,  0.01,    6.,    0., 9.0e25,'Water Bodies'
+17,     14.,   .60,   .95,   20.,    6.,  1.50, 29.2e5,'Herbaceous Wetland'
+18,     14.,   .35,   .95,   40.,    5.,  1.14, 41.8e5,'Wooded Wetland'
+19,     25.,   .02,   .90,    1.,    2.,  0.81, 12.0e5,'Barren or Sparsely Vegetated'
+20,     15.,   .50,   .92,   10.,    5.,  2.87, 9.0e25,'Herbaceous Tundra'
+21,     15.,   .50,   .93,   30.,    5.,  2.67, 9.0e25,'Wooded Tundra'
+22,     15.,   .50,   .92,   15.,    5.,  2.67, 9.0e25,'Mixed Tundra'
+23,     25.,   .02,   .90,   10.,    2.,  1.60, 12.0e5,'Bare Ground Tundra'
+24,     55.,   .95,   .95,    5.,    5.,    0., 9.0e25,'Snow or Ice'
+25,     30.,   .40,   .90,    1.,    5.,   .62, 12.0E5,'Playa'
+26,     18.,   .50,   .95,   15.,    6.,   .62, 12.0E5,'Lava'
+27,     70.,   .40,   .90,    1.,    5.,    0., 12.0E5,'White Sand'
+28,     15.,   .02,   .88,   80.,    3.,  1.67, 18.9e5,'Unassigned'
+29,     15.,   .02,   .88,   80.,    3.,  1.67, 18.9e5,'Unassigned'
+30,     15.,   .10,   .88,   80.,    3.,  1.67, 18.9e5,'Unassigned'
+31,     10.,   .10,   .97,   80.,    3.,  1.67, 18.9e5,'Low Intensity Residential '
+32,     10.,   .10,   .97,   80.,    3.,  1.67, 18.9e5,'High Intensity Residential'
+33,     10.,   .10,   .97,   80.,    3.,  1.67, 18.9e5,'Industrial or Commercial'
+WINTER
+1,      15.,   .10,   .88,   80.,    3.,  1.67, 18.9e5,'Urban and Built-Up Land'
+2,      20.,   .60,   .92,    5.,    4.,  2.00, 25.0e5,'Dryland Cropland and Pasture'
+3,      20.,   .50,   .93,    2.,    4.,  1.76, 25.0e5,'Irrigated Cropland and Pasture'
+4,      20.,   .50,   .92,    5.,    4.,  2.00, 25.0e5,'Mixed Dryland/Irrigated Cropland and Pasture'
+5,      20.,   .40,   .92,    5.,    4.,  2.00, 25.0e5,'Cropland/Grassland Mosaic'
+6,      20.,   .60,   .93,   20.,    4.,  2.00, 25.0e5,'Cropland/Woodland Mosaic'
+7,      23.,   .30,   .92,   10.,    4.,  2.00, 20.8e5,'Grassland'
+8,      22.,   .20,   .93,    1.,    4.,  1.30, 20.8e5,'Shrubland'
+9,      22.,   .25,   .93,    1.,    4.,  1.24, 20.8e5,'Mixed Shrubland/Grassland'
+10,     20.,   .15,   .92,   15.,    3.,  2.00, 25.0e5,'Savanna'
+11,     17.,   .60,   .93,   50.,    5.,  2.40, 25.0e5,'Deciduous Broadleaf Forest'
+12,     15.,   .60,   .93,   50.,    5.,  2.60, 25.0e5,'Deciduous Needleleaf Forest'
+13,     12.,   .50,   .95,   50.,    5.,  1.67, 29.2e5,'Evergreen Broadleaf Forest'
+14,     12.,   .60,   .95,   50.,    5.,  3.00, 29.2e5,'Evergreen Needleleaf Forest'
+15,     14.,   .60,   .93,   20.,    6.,  1.12, 41.8e5,'Mixed Forest'
+16,      8.,   1.0,   .98,  0.01,    6.,    0., 9.0e25,'Water Bodies'
+17,     14.,   .75,   .95,   20.,    6.,  1.50, 29.2e5,'Herbaceous Wetland'
+18,     14.,   .70,   .95,   40.,    6.,  1.14, 41.8e5,'Wooded Wetland'
+19,     23.,   .05,   .90,    1.,    2.,  0.81, 12.0e5,'Barren or Sparsely Vegetated'
+20,     15.,   .60,   .92,   10.,    5.,  2.00, 9.0e25,'Herbaceous Tundra'
+21,     15.,   .60,   .93,   30.,    5.,  1.75, 9.0e25,'Wooded Tundra'
+22,     15.,   .60,   .92,   15.,    5.,  1.75, 9.0e25,'Mixed Tundra'
+23,     25.,   .05,   .90,    5.,    5.,  1.80, 12.0e5,'Bare Ground Tundra'
+24,     70.,   .95,   .95,    5.,    5.,    0., 9.0e25,'Snow or Ice'
+25,     40.,   .40,   .90,    1.,    5.,   .62, 12.0E5,'Playa'
+26,     18.,   .40,   .95,   15.,    5.,   .62, 12.0E5,'Lava'
+27,     70.,   .40,   .90,    1.,    5.,    0., 12.0E5,'White Sand'
+28,     15.,   .02,   .88,   80.,    3.,  1.67, 18.9e5,'Unassigned'
+29,     15.,   .02,   .88,   80.,    3.,  1.67, 18.9e5,'Unassigned'
+30,     15.,   .10,   .88,   80.,    3.,  1.67, 18.9e5,'Unassigned'
+31,     10.,   .10,   .97,   80.,    3.,  1.67, 18.9e5,'Low Intensity Residential '
+32,     10.,   .10,   .97,   80.,    3.,  1.67, 18.9e5,'High Intensity Residential'
+33,     10.,   .10,   .97,   80.,    3.,  1.67, 18.9e5,'Industrial or Commercial'
+SiB
+16,2, 'ALBD   SLMO   SFEM   SFZ0 THERIN   SCFX   SFHC   '
+SUMMER
+1,      12.,   .50,   .95,   50.,    5.,  1.67, 29.2e5,'Evergreen Broadleaf Trees'
+2,      16.,   .30,   .93,   50.,    4.,  2.63, 25.0e5,'Broadleaf Deciduous Trees'
+3,      14.,   .35,   .95,   40.,    5.,  3.00, 41.8e5,'Deciduous and Evergreen Trees'
+4,      12.,   .30,   .95,   50.,    4.,  3.33, 29.2e5,'Evergreen Needleleaf Trees'
+5,      16.,   .30,   .93,   50.,    4.,  2.38, 25.0e5,'Deciduous Needleleaf Trees'
+6,      20.,   .15,   .92,   15.,    3.,  1.80, 25.0e5,'Ground Cover with Trees and Shrubs'
+7,      19.,   .15,   .92,   12.,    3.,  2.16, 20.8e5,'Groundcover Only'
+8,      19.,   .15,   .92,   12.,    3.,  2.53, 20.8e5,'Broadleaf Shrubs with Perennial Ground Cover'
+9,      19.,   .15,   .92,   12.,    3.,  2.63, 20.8e5,'Broadleaf Shrubs with Bare Soil'
+10,     15.,   .50,   .92,   10.,    5.,  2.73, 9.0e25,'Groundcover with Dwarf Trees and Shrubs'
+11,     25.,   .02,   .85,   10.,    2.,  1.76, 12.0e5,'Bare Soil'
+12,     17.,   .30,   .92,   15.,    4.,  2.76, 25.0e5,'Agriculture or C3 Grassland'
+13,     14.,   .50,   .95,   20.,    6.,  1.36, 29.2e5,'Persistent Wetland'
+14,     19.,   .15,   .92,   12.,    3.,  2.16, 20.8e5,'Dry Coastal Complexes'
+15,      8.,   1.0,   .98,  0.01,    6.,    0., 9.0e25,'Water'
+16,     55.,   .95,   .95,    5.,    5.,    0., 9.0e25,'Ice Cap and Glacier'
+WINTER
+1,      12.,   .50,   .95,   50.,    5.,  1.67, 29.2e5,'Evergreen Broadleaf Trees'
+2,      17.,   .60,   .93,   50.,    5.,  2.41, 25.0e5,'Broadleaf Deciduous Trees'
+3,      14.,   .70,   .95,   40.,    6.,  2.79, 41.8e5,'Deciduous and Evergreen Trees'
+4,      12.,   .60,   .95,   50.,    5.,  3.33, 29.2e5,'Evergreen Needleleaf Trees'
+5,      17.,   .60,   .93,   50.,    5.,  2.16, 25.0e5,'Deciduous Needleleaf Trees'
+6,      20.,   .15,   .92,   15.,    3.,  1.80, 25.0e5,'Ground Cover with Trees and Shrubs'
+7,      23.,   .30,   .92,   10.,    4.,  2.00, 20.8e5,'Groundcover Only'
+8,      23.,   .30,   .92,   10.,    4.,  1.91, 20.8e5,'Broadleaf Shrubs with Perennial Ground Cover'
+9,      23.,   .30,   .92,   10.,    4.,  1.91, 20.8e5,'Broadleaf Shrubs with Bare Soil'
+10,     20.,   .90,   .92,   10.,    5.,  1.80, 9.0e25,'Groundcover with Dwarf Trees and Shrubs'
+11,     25.,   .05,   .85,   10.,    2.,  1.76, 12.0e5,'Bare Soil'
+12,     23.,   .60,   .92,    5.,    4.,  1.78, 25.0e5,'Agriculture or C3 Grassland'
+13,     14.,   .75,   .95,   20.,    6.,  1.50, 29.2e5,'Persistent Wetland'
+14,     23.,   .30,   .92,   10.,    4.,  1.61, 20.8e5,'Dry Coastal Complexes'
+15,      8.,   1.0,   .98,  0.01,    6.,    0., 9.0e25,'Water'
+16,     70.,   .95,   .95,    5.,    5.,    0., 9.0e25,'Ice Cap and Glacier'
+LW12 
+3,1, 'ALBD   SLMO   SFEM   SFZ0 THERIN   SCFX   SFHC   '
+ALL-SEASON
+1,      20.,   0.3,   .85,   10.,    4.,  2.00, 20.8e5,'Land'
+2,       8.,   1.0,   .98,  0.01,    6.,    0., 9.0e25,'Water'
+3,      70.,   .95,   .95,    5.,    5.,    0., 9.0e25,'Snow or Ice'
Index: trunk/WRF.COMMON/WRFV2/run/README.namelist
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/README.namelist	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/README.namelist	(revision 2744)
@@ -0,0 +1,519 @@
+Description of namelist variables
+---------------------------------
+ 
+For WRF-NMM users, please see Chapter 5 of the WRF-NMM User's Guide for 
+information on NMM specific settings (http://www.dtcenter.org/wrf-nmm/users)
+
+
+ Note: variables followed by (max_dom) indicate that this variable needs to
+       be defined for the nests when max_dom > 1.
+
+ &time_control
+ run_days                            = 1,	; run time in days
+ run_hours                           = 0,	; run time in hours
+                                                  Note: if it is more than 1 day, one may use both run_days and run_hours
+                                                  or just run_hours. e.g. if the total run length is 36 hrs, you may
+                                                  set run_days = 1, and run_hours = 12, or run_days = 0, and run_hours = 36
+ run_minutes                         = 0,	; run time in minutes
+ run_seconds                         = 0,	; run time in seconds
+ start_year (max_dom)                = 2001,	; four digit year of starting time
+ start_month (max_dom)               = 06,	; two digit month of starting time
+ start_day (max_dom)                 = 11,	; two digit day of starting time
+ start_hour (max_dom)                = 12,	; two digit hour of starting time
+ start_minute (max_dom)              = 00,	; two digit minute of starting time
+ start_second (max_dom)              = 00,	; two digit second of starting time
+                                                  Note: the start time is used to name the first wrfout file.
+                                                  It also controls the start time for nest domains, and the time to restart
+ tstart (max_dom)                    = 00,	; FOR NMM: starting hour of the forecast
+ end_year (max_dom)                  = 2001,	; four digit year of ending time
+ end_month (max_dom)                 = 06,	; two digit month of ending time
+ end_day (max_dom)                   = 12,	; two digit day of ending time
+ end_hour (max_dom)                  = 12,	; two digit hour of ending time
+ end_minute (max_dom)                = 00,	; two digit minute of ending time
+ end_second (max_dom)                = 00,	; two digit second of ending time
+                                                  It also controls when the nest domain integrations end
+                                                  All start and end times are used by real.exe.
+
+                                                  Note that one may use either run_days/run_hours etc. or 
+                                                  end_year/month/day/hour etc. to control the length of 
+                                                  model integration. But run_days/run_hours
+                                                  takes precedence over the end times. 
+                                                  Program real.exe uses start and end times only.
+
+ interval_seconds                    = 10800,	; time interval between incoming real data, which will be the interval
+                                                  between the lateral boundary condition file
+ input_from_file (max_dom)           = T,       ; whether nested run will have input files for domains other than 1
+ fine_input_stream (max_dom)         = 0,       ; field selection from nest input for its initialization
+                                                  0: all fields are used; 2: only static and time-varying, masked land 
+                                                  surface fields are used.
+ history_interval (max_dom)          = 60,  	; history output file interval in minutes
+ frames_per_outfile (max_dom)        = 1, 	; output times per history output file, used to split output files 
+                                                  into smaller pieces
+ restart                             = F,	; whether this run is a restart run
+ restart_interval		     = 1440,	; restart output file interval in minutes
+ io_form_history                     = 2,       ; 2 = netCDF 
+ io_form_restart                     = 2,       ; 2 = netCDF 
+ io_form_input                       = 2,       ; 2 = netCDF
+ io_form_boundary                    = 2,       ; netCDF format
+                                     = 4,       ; PHD5 format
+                                     = 5,       ; GRIB1 format
+ frames_per_emissfile                = 12,  ; Number of times in each chemistry emission file.
+ io_style_emiss                      = 1,   ; Style to use for the chemistry emission files.
+                                                ; 0 = Do not read emissions from files.
+                                                ; 1 = Cycle between two 12 hour files (set frames_per_emissfile=12)
+                                                ; 2 = Dated files with length set by frames_per_emissfile
+ debug_level                         = 0, 	; 50,100,200,300 values give increasing prints
+
+To choose between SI and WPS input to real:
+ auxinput1_inname                    = "met_em.d<domain>.<date>"             ; Input to real from WPS
+                                     = "wrf_real_input_em.d<domain>.<date>"  ; Input to real from SI
+
+Other output options:
+
+ auxhist2_outname                    = "rainfall" ; file name for extra output; if not specified,
+                                                  auxhist2_d<domain>_<date> will be used
+                                                  also note that to write variables in output other
+                                                  than the history file requires Registry.EM file change
+ auxhist2_interval (max_dom)         = 10,      ; interval in minutes
+ io_form_auxhist2                    = 2,       ; output in netCDF
+
+Additional ones when running 3DVAR:
+
+ write_input                         = t,       ; write input-formatted data as output
+ inputout_interval                   = 180,     ; interval in minutes when writing input-formatted data 
+ input_outname                       = 'wrf_3dvar_input_d<domain>_<date>' ; you may change the output file name
+ inputout_begin_y                    = 0
+ inputout_begin_mo                   = 0
+ inputout_begin_d                    = 0
+ inputout_begin_h                    = 3
+ inputout_begin_m                    = 0
+ inputout_begin_s                    = 0
+ inputout_end_y                      = 0
+ inputout_end_mo                     = 0
+ inputout_end_d                      = 0
+ inputout_end_h                      = 12
+ inputout_end_m                      = 0
+ inputout_end_s                      = 0        ; the above shows that the input-formatted data are output
+                                                  starting from hour 3 to hour 12 in 180 min interval.
+
+ &domains
+ time_step                           = 60,	; time step for integration in integer seconds
+                                                  recommend 6*dx (in km) for typical real-data cases
+ time_step_fract_num                 = 0,	; numerator for fractional time step 
+ time_step_fract_den                 = 1,	; denominator for fractional time step 
+                                                  Example, if you want to use 60.3 sec as your time step,
+                                                  set time_step = 60, time_step_fract_num = 3, and 
+                                                  time_step_fract_den = 10
+ max_dom                             = 1,	; number of domains - set it to > 1 if it is a nested run
+ s_we (max_dom)                      = 1,	; start index in x (west-east) direction (leave as is)
+ e_we (max_dom)                      = 91,	; end index in x (west-east) direction (staggered dimension)
+ s_sn (max_dom)                      = 1,	; start index in y (south-north) direction (leave as is)
+ e_sn (max_dom)                      = 82,	; end index in y (south-north) direction (staggered dimension)
+ s_vert (max_dom)                    = 1,	; start index in z (vertical) direction (leave as is)
+ e_vert (max_dom)                    = 28,	; end index in z (vertical) direction (staggered dimension)
+                                                  Note: this refers to full levels including surface and top
+                                                  vertical dimensions need to be the same for all nests
+                                                  Note: most variables are unstaggered (= staggered dim - 1)
+ dx (max_dom)                        = 10000,	; grid length in x direction, unit in meters
+ dy (max_dom)                        = 10000,	; grid length in y direction, unit in meters
+ ztop (max_dom)                      = 19000.	; used in mass model for idealized cases
+ grid_id (max_dom)                   = 1,	; domain identifier
+ parent_id (max_dom)                 = 0,       ; id of the parent domain
+ i_parent_start (max_dom)            = 0,       ; starting LLC I-indices from the parent domain
+ j_parent_start (max_dom)            = 0,       ; starting LLC J-indices from the parent domain
+ parent_grid_ratio (max_dom)         = 1,       ; parent-to-nest domain grid size ratio: for real-data cases
+                                                  the ratio has to be odd; for idealized cases,
+                                                  the ratio can be even if feedback is set to 0.
+ parent_time_step_ratio (max_dom)    = 1,       ; parent-to-nest time step ratio; it can be different
+                                                  from the parent_grid_ratio
+ feedback                            = 1,       ; feedback from nest to its parent domain; 0 = no feedback
+ smooth_option                       = 0        ; smoothing option for parent domain, used only with feedback
+                                                  option on. 0: no smoothing; 1: 1-2-1 smoothing; 2: smoothing-desmoothing
+
+Namelist variables specifically for the WPS input for real:
+
+ num_metgrid_levels                  = 27       ; number of vertical levels of 3d meteorological fields coming 
+                                                ; from WPS metgrid program
+ interp_type                         = 1        ; vertical interpolation
+                                                ; 1 = linear in pressure
+                                                ; 2 = linear in log(pressure)
+ lagrange_order                      = 1        ; vertical interpolation order
+                                                ; 1 = linear
+                                                ; 2 = quadratic
+ zap_close_levels                    = 500      ; ignore isobaric level above surface if delta p (Pa) < zap_close_levels
+ lowest_lev_from_sfc                 = .false.  ; place the surface value into the lowest eta location
+                                                ; T = use surface value as lowest eta (u,v,t,q)
+                                                ; F = use traditional interpolation
+ force_sfc_in_vinterp                = 1        ; use the surface level as the lower boundary when interpolating
+                                                ; through this many eta levels
+                                                ; 0 = perform traditional trapping interpolation
+                                                ; n = first n eta levels directly use surface level
+ p_top_requested                     = 5000     ; p_top (Pa) to use in the model
+
+Users may explicitly define full eta levels.  Given are two distributions for 28 and 35 levels.  The number
+of levels must agree with the number of eta surfaces allocated (e_vert).  Users may alternatively request 
+only the number of levels (with e_vert), and the real program will compute values.  The computation assumes
+a known first several layers, then generates equi-height spaced levels up to the top of the model.
+
+ eta_levels                          = 1.000, 0.990, 0.978, 0.964, 0.946,
+                                       0.922, 0.894, 0.860, 0.817, 0.766,
+                                       0.707, 0.644, 0.576, 0.507, 0.444,
+                                       0.380, 0.324, 0.273, 0.228, 0.188,
+                                       0.152, 0.121, 0.093, 0.069, 0.048,
+                                       0.029, 0.014, 0.000,
+ eta_levels                          = 1.000, 0.993, 0.983, 0.970, 0.954,
+                                       0.934, 0.909, 0.880, 0.845, 0.807,
+                                       0.765, 0.719, 0.672, 0.622, 0.571,
+                                       0.520, 0.468, 0.420, 0.376, 0.335,
+                                       0.298, 0.263, 0.231, 0.202, 0.175,
+                                       0.150, 0.127, 0.106, 0.088, 0.070,
+                                       0.055, 0.040, 0.026, 0.013, 0.000
+
+Namelist variables for controling the specified moving nest: 
+                   Note that this moving nest option needs to be activated at the compile time by adding -DMOVE_NESTS
+                   to the ARCHFLAGS. The maximum number of moves, max_moves, is set to 50 
+                   but can be modified in source code file frame/module_driver_constants.F.
+ num_moves                           = 4        ; total number of moves
+ move_id                             = 2,2,2,2, ; a list of nest domain id's, one per move
+ move_interval                       = 60,120,150,180,   ; time in minutes since the start of this domain
+ move_cd_x                           = 1,1,0,-1,; the number of parent domain grid cells to move in i direction
+ move_cd_y                           = 1,0,-1,1,; the number of parent domain grid cells to move in j direction
+                                                  positive is to move in increasing i and j direction, and 
+                                                  negative is to move in decreasing i and j direction.
+                                                  0 means no move. The limitation now is to move only 1 grid cell
+                                                  at each move.
+
+Namelist variables for controling the automatic moving nest: 
+                   Note that this moving nest option needs to be activated at the compile time by adding -DMOVE_NESTS
+                   and -DVORTEX_CENTER to the ARCHFLAGS. This option uses an mid-level vortex following algorthm to
+                   determine the nest move. This option is experimental.
+ vortex_interval                     = 15       ; how often the new vortex position is computed
+ max_vortex_speed                    = 40       ; used to compute the search radius for the new vortex position
+ corral_dist                         = 8        ; how many coarse grid cells the moving nest is allowed to get
+                                                  near the mother domain boundary
+
+ &physics
+
+ Note: even the physics options can be different in different nest domains, 
+       caution must be used as what options are sensible to use
+
+ chem_opt                            = 0,       ; chemistry option - not yet available
+ mp_physics (max_dom)                microphysics option
+                                     = 0, no microphysics
+                                     = 1, Kessler scheme
+                                     = 2, Lin et al. scheme
+                                     = 3, WSM 3-class simple ice scheme
+                                     = 4, WSM 5-class scheme
+                                     = 5, Ferrier (new Eta) microphysics
+                                     = 6, WSM 6-class graupel scheme
+                                     = 8, Thompson et al. scheme
+                                     = 98, NCEP 3-class simple ice scheme (to be removed)
+                                     = 99, NCEP 5-class scheme (to be removed)
+
+ For non-zero mp_physics options, to keep Qv .GE. 0, and to set the other moisture
+ fields .LT. a critcal value to zero
+
+ mp_zero_out                         = 0,      ; no action taken, no adjustment to any moist field
+                                     = 1,      ; except for Qv, all other moist arrays are set to zero
+                                               ; if they fall below a critical value
+                                     = 2,      ; Qv is .GE. 0, all other moist arrays are set to zero
+                                               ; if they fall below a critical value
+ mp_zero_out_thresh                  = 1.e-8   ; critical value for moist array threshold, below which
+                                               ; moist arrays (except for Qv) are set to zero (kg/kg)
+
+ ra_lw_physics (max_dom)             longwave radiation option
+                                     = 0, no longwave radiation
+                                     = 1, rrtm scheme
+                                     = 3, cam scheme
+                                          also must set levsiz, paerlev, cam_abs_dim1/2 (see below)
+                                     = 99, GFDL (Eta) longwave (semi-supported)
+                                          also must use co2tf = 1 for ARW
+
+ ra_sw_physics (max_dom)             shortwave radiation option
+                                     = 0, no shortwave radiation
+                                     = 1, Dudhia scheme
+                                     = 2, Goddard short wave
+                                     = 3, cam scheme
+                                          also must set levsiz, paerlev, cam_abs_dim1/2 (see below)
+                                     = 99, GFDL (Eta) longwave (semi-supported)
+                                          also must use co2tf = 1 for ARW
+
+ radt (max_dom)                      = 30,	; minutes between radiation physics calls
+                                           recommend 1 min per km of dx (e.g. 10 for 10 km)
+
+ nrads (max_dom)                     = FOR NMM: number of fundamental timesteps between 
+                                                calls to shortwave radiation; the value
+                                                is set in Registry.NMM but is overridden
+                                                by namelist value; radt will be computed
+                                                from this.
+
+ nradl (max_dom)                     = FOR NMM: number of fundamental timesteps between 
+                                                calls to longwave radiation; the value
+                                                is set in Registry.NMM but is overridden
+                                                by namelist value.
+
+ co2tf                               CO2 transmission function flag only for GFDL radiation
+                                     = 0, read CO2 function data from pre-generated file
+                                     = 1, generate CO2 functions internally in the forecast
+
+ ra_call_offset                      radiation call offset
+                                     = 0 (no offset), =-1 (old offset)
+
+ cam_abs_freq_s                      = 21600 CAM clearsky longwave absorption calculation frequency
+                                            (recommended minimum value to speed scheme up)
+ levsiz                              = 59 for CAM radiation input ozone levels
+ paerlev                             = 29 for CAM radiation input aerosol levels
+ cam_abs_dim1                        = 4 for CAM absorption save array
+ cam_abs_dim2                        = e_vert for CAM 2nd absorption save array
+
+ sf_sfclay_physics (max_dom)         surface-layer option (old bl_sfclay_physics option)
+                                     = 0, no surface-layer
+                                     = 1, Monin-Obukhov scheme
+                                     = 2, Monin-Obukhov (Janjic) scheme
+                                     = 3, NCEP Global Forecast System scheme
+
+ sf_surface_physics (max_dom)        land-surface option (old bl_surface_physics option)
+                                     = 0, no surface temp prediction
+                                     = 1, thermal diffusion scheme
+                                     = 2, Noah land-surface model
+                                     = 3, RUC land-surface model
+
+ bl_pbl_physics (max_dom)            boundary-layer option
+                                     = 0, no boundary-layer 
+                                     = 1, YSU scheme
+                                     = 2, Mellor-Yamada-Janjic TKE scheme
+                                     = 3, NCEP Global Forecast System scheme
+                                     = 99, MRF scheme (to be removed)
+
+ bldt (max_dom)                      = 0,       ; minutes between boundary-layer physics calls
+
+ nphs (max_dom)                      = FOR NMM: number of fundamental timesteps between
+                                                calls to turbulence and microphysics;
+                                                the value is set in Registry.NMM but is
+                                                overridden by namelist value; bldt will
+                                                be computed from this.
+
+ cu_physics (max_dom)                cumulus option
+                                     = 0, no cumulus
+                                     = 1, Kain-Fritsch (new Eta) scheme
+                                     = 2, Betts-Miller-Janjic scheme
+                                     = 3, Grell-Devenyi ensemble scheme
+                                     = 4, Simplified Arakawa-Schubert scheme
+                                     = 99, previous Kain-Fritsch scheme
+
+ cudt                                = 0,       ; minutes between cumulus physics calls
+
+ ncnvc (max_dom)                     = FOR NMM: number of fundamental timesteps between
+                                                calls to convection; the value is set in Registry.NMM
+                                                but is overridden by namelist value; cudt will be
+                                                computed from this.
+
+ tprec (max_dom)                     = FOR NMM: number of hours in precipitation bucket
+ theat (max_dom)                     = FOR NMM: number of hours in latent heating bucket
+ tclod (max_dom)                     = FOR NMM: number of hours in cloud fraction average
+ trdsw (max_dom)                     = FOR NMM: number of hours in short wave buckets
+ trdlw (max_dom)                     = FOR NMM: number of hours in long wave buckets
+ tsrfc (max_dom)                     = FOR NMM: number of hours in surface flux buckets
+ pcpflg (max_dom)                    = FOR NMM: logical switch for precipitation assimilation
+
+ isfflx                              = 1,	; heat and moisture fluxes from the surface
+                                                  (only works for sf_sfclay_physics = 1)
+                                                  1 = with fluxes from the surface
+                                                  0 = no flux from the surface
+ ifsnow                              = 0,	; snow-cover effects
+                                                  (only works for sf_surface_physics = 1)
+                                                  1 = with snow-cover effect
+                                                  0 = without snow-cover effect
+ icloud                              = 1,	; cloud effect to the optical depth in radiation
+                                                  (only works for ra_sw_physics = 1 and ra_lw_physics = 1)
+                                                  1 = with cloud effect
+                                                  0 = without cloud effect
+ swrad_scat                          = 1.       ; scattering tuning parameter (default 1. is 1.e-5 m2/kg)
+ surface_input_source                = 1,	; where landuse and soil category data come from:
+                                                  1 = SI/gridgen
+                                                  2 = GRIB data from another model (only possible
+                                                      (VEGCAT/SOILCAT are in wrf_real_input_em files from SI)
+ num_soil_layers                     = 5,	; number of soil layers in land surface model
+                                                  = 5: thermal diffusion scheme
+                                                  = 4: Noah landsurface model
+                                                  = 6: RUC landsurface model
+ ucmcall                             = 0,       ; activate urban canopy model (in Noah LSM only) (0=no, 1=yes)
+
+ maxiens                             = 1,       ; Grell-Devenyi only
+ maxens                              = 3,       ; G-D only
+ maxens2                             = 3,       ; G-D only
+ maxens3                             = 16       ; G-D only
+ ensdim                              = 144      ; G-D only
+                                                  These are recommended numbers. If you would like to use
+                                                  any other number, consult the code, know what you are doing.
+ seaice_threshold                    = 271      ; tsk < seaice_threshold, if water point and 5-layer slab
+                                                ; scheme, set to land point and permanent ice; if water point
+                                                ; and Noah scheme, set to land point, permanent ice, set temps
+                                                ; from 3 m to surface, and set smois and sh2o
+ sst_update                          = 0        ; time-varying sea-surface temp (0=no, 1=yes). If selected real 
+                                                ; puts SST and VEGFRA in wrflowinp_d01 file, and wrf updates these from it
+                                                ; at same interval as boundary file. To read this, the time-control
+                                                ; namelist must include  auxinput5_interval,  auxinput5_end_h, and
+                                                ; auxinput5_inname = "wrflowinp_d<domain>"
+
+ &fdda
+ grid_fdda (max_dom)                 = 1        ; grid-nudging fdda on (=0 off) for each domain
+ gfdda_inname                        = "wrffdda_d<domain>" ; defined name in real
+ gfdda_interval_m (max_dom)          = 360      ; time interval (min) between analysis times
+ gfdda_end_h (max_dom)               = 6        ; time (h) to stop nudging after start of forecast
+ io_form_gfdda                       = 2        ; analysis data io format (2 = netCDF)
+ fgdt (max_dom)                      = 0        ; calculation frequency (minutes) for grid-nudging (0=every step)
+ if_no_pbl_nudging_uv (max_dom)      = 0        ; 0= no nudging of u and v in the pbl, 1=nudging in the pbl
+ if_no_pbl_nudging_t (max_dom)       = 0        ; 0= no nudging of temp in the pbl, 1=nudging in the pbl
+ if_no_pbl_nudging_q (max_dom)       = 0        ; 0= no nudging of qvapor in the pbl, 1=nudging in the pbl
+ if_zfac_uv (max_dom)                = 0        ; 0= nudge u and v all layers, 1= limit nudging to levels above k_zfac_uv
+  k_zfac_uv (max_dom)                = 10       ; 10=model level below which nudging is switched off for u and v
+ if_zfac_t (max_dom)                 = 0        ; 0= nudge temp all layers, 1= limit nudging to levels above k_zfac_t
+  k_zfac_t (max_dom)                 = 10       ; 10=model level below which nudging is switched off for temp
+ if_zfac_q (max_dom)                 = 0        ; 0= nudge qvapor all layers, 1= limit nudging to levels above k_zfac_q
+  k_zfac_q (max_dom)                 = 10       ; 10=model level below which nudging is switched off for qvapor
+ guv (max_dom)                       = 0.0003   ; nudging coefficient for u and v (sec-1)
+ gt (max_dom)                        = 0.0003   ; nudging coefficient for temp (sec-1)
+ gq (max_dom)                        = 0.0003   ; nudging coefficient for qvapor (sec-1)
+ if_ramping                          = 0        ; 0= nudging ends as a step function, 1= ramping nudging down at end of period
+ dtramp_min                          = 60.0     ; time (min) for ramping function, 60.0=ramping starts at last analysis time, 
+                                                                                  -60.0=ramping ends at last analysis time
+
+The following are for observation nudging:
+ obs_nudge_opt (max_dom)             = 1        ; obs-nudging fdda on (=0 off) for each domain
+                                                  also need to set auxinput11_interval and auxinput11_end_h
+                                                  in time_control namelist
+ max_obs                             = 150000   ; max number of observations used on a domain during any 
+                                                  given time window
+ fdda_start                          = 0        ; obs nudging start time in minutes
+ fdda_end                            = 180      ; obs nudging end time in minutes
+ obs_nudge_wind (max_dom)            = 1        ; whether to nudge wind: (=0 off)
+ obs_coef_wind                       = 6.E-4,   ; nudging coefficient for wind, unit: s-1
+ obs_nudge_temp                      = 1        ; whether to nudge temperature: (=0 off)
+ obs_coef_temp                       = 6.E-4,   ; nudging coefficient for temperature, unit: s-1
+ obs_nudge_mois                      = 1        ; whether to nudge water vapor mixing ratio: (=0 off)
+ obs_coef_mois                       = 6.E-4,   ; nudging coefficient for water vapor mixing ratio, unit: s-1
+ obs_nudge_pstr                      = 0        ; whether to nudge surface pressure (not used)
+ obs_coef_pstr                       = 0.       ; nudging coefficient for surface pressure, unit: s-1 (not used)
+ obs_rinxy                           = 200.,    ; horizonal radius of influence in km
+ obs_rinsig                          = 0.1,     ; vertical radius of influence in eta
+ obs_twindo                          = 40,      ; half-period time window over which an observation 
+                                                  will be used for nudging
+ obs_npfi                            = 10,      ; freq in coarse grid timesteps for diag prints
+ obs_ionf                            = 2        ; freq in coarse grid timesteps for obs input and err calc
+ obs_idynin                          = 0        ; for dynamic initialization using a ramp-down function to gradually
+                                                  turn off the FDDA before the pure forecast (=1 on)
+ obs_dtramp                          = 40       ; time period in minutes over which the nudging is ramped down 
+                                                  from one to zero.
+ obs_ipf_in4dob                      = .true.   ; print obs input diagnostics (=.false. off)
+ obs_ipf_errob                       = .true.   ; print obs error diagnostics (=.false. off)
+ obs_ipf_nudob                       = .true.   ; print obs nudge diagnostics (=.false. off)
+ /
+
+
+ &dynamics
+ dyn_opt                             = 2,	; dynamical core option: advanced research WRF core (Eulerian mass)
+ rk_ord                              = 3,	; time-integration scheme option:
+                                                  2 = Runge-Kutta 2nd order
+                                                  3 = Runge-Kutta 3rd order
+ diff_opt                            = 0,	; turbulence and mixing option:
+                                                  0 = no turbulence or explicit
+                                                      spatial numerical filters (km_opt IS IGNORED).
+                                                  1 = evaluates 2nd order
+                                                      diffusion term on coordinate surfaces.
+                                                      uses kvdif for vertical diff unless PBL option
+                                                      is used. may be used with km_opt = 1 and 4.
+                                                      (= 1, recommended for real-data case when grid distance < 10 km)
+                                                  2 = evaluates mixing terms in
+                                                      physical space (stress form) (x,y,z).
+                                                      turbulence parameterization is chosen
+                                                      by specifying km_opt.
+ km_opt                              = 1,	; eddy coefficient option
+                                                  1 = constant (use khdif kvdif)
+                                                  2 = 1.5 order TKE closure (3D)
+                                                  3 = Smagorinsky first order closure (3D)
+                                                      Note: option 2 and 3 are not recommended for DX > 2 km
+                                                  4 = horizontal Smagorinsky first order closure
+                                                      (recommended for real-data case when grid distance < 10 km)
+ damp_opt                            = 0,	; upper level damping flag 
+                                                  0 = without damping
+                                                  1 = with diffusive damping, maybe used for real-data cases 
+                                                      (dampcoef nondimensional ~0.01-0.1)
+                                                  2 = with Rayleigh  damping (dampcoef inverse time scale [1/s] e.g. .003; 
+                                                      not for real-data cases)
+ diff_6th_opt                        = 0,       ; 6th-order numerical diffusion
+                                                  0 = no 6th-order diffusion (default)
+                                                  1 = 6th-order numerical diffusion
+                                                  2 = 6th-order numerical diffusion but prohibit up-gradient diffusion
+ diff_6th_factor                     = 0.12,    ; 6th-order numerical diffusion non-dimensional rate (max value 1.0
+                                                      corresponds to complete removal of 2dx wave in one timestep)
+ dampcoef (max_dom)                  = 0.,	; damping coefficient (see above)
+ zdamp (max_dom)                     = 5000.,	; damping depth (m) from model top
+ w_damping                           = 0,       ; vertical velocity damping flag (for operational use)
+                                                  0 = without damping
+                                                  1 = with    damping
+ base_temp                           = 290.,    ; real-data, em ONLY, base sea-level temp (K)
+ base_pres                           = 10^5     ; real-data, em ONLY, base sea-level pres (Pa), DO NOT CHANGE
+ base_lapse                          = 50.,     ; real-data, em ONLY, lapse rate (K), DO NOT CHANGE
+ khdif (max_dom)                     = 0,	; horizontal diffusion constant (m^2/s)
+ kvdif (max_dom)                     = 0,	; vertical diffusion constant (m^2/s)
+ smdiv (max_dom)                     = 0.1,	; divergence damping (0.1 is typical)
+ emdiv (max_dom)                     = 0.01,	; external-mode filter coef for mass coordinate model
+                                                  (0.01 is typical for real-data cases)
+ epssm (max_dom)                     = .1,	; time off-centering for vertical sound waves
+ non_hydrostatic (max_dom)           = .true.,	; whether running the model in hydrostatic or non-hydro mode
+ pert_coriolis (max_dom)             = .false.,	; Coriolis only acts on wind perturbation (idealized)
+ mix_full_fields(max_dom)            = .true.,  ; used with diff_opt = 2; value of ".true." is recommended, except for
+                                                  highly idealized numerical tests; damp_opt must not be 1 if ".true."
+                                                  is chosen. .false. means subtract 1-d base-state profile before mixing
+ tke_drag_coefficient(max_dom)       = 0.,      ; surface drag coefficient (Cd, dimensionless) for diff_opt=2 only
+ tke_heat_flux(max_dom)              = 0.,      ; surface thermal flux (H/(rho*cp), K m/s) for diff_opt=2 only
+ h_mom_adv_order (max_dom)           = 5,       ; horizontal momentum advection order (5=5th, etc.)
+ v_mom_adv_order (max_dom)           = 3,       ; vertical momentum advection order
+ h_sca_adv_order (max_dom)           = 5,       ; horizontal scalar advection order
+ v_sca_adv_order (max_dom)           = 3,       ; vertical scalar advection order
+ pd_moist                            = F        ; positive definite advection of moisture
+ pd_scalar                           = F        ; positive definite advection of scalars
+ pd_chem                             = F        ; positive definite advection of chem variables
+ pd_tke                              = F        ; positive definite advection of tke
+ time_step_sound (max_dom)           = 4 /	; number of sound steps per time-step (0=set automatically)
+                                                  (if using a time_step much larger than 6*dx (in km),
+                                                  proportionally increase number of sound steps - also
+                                                  best to use even numbers)
+
+
+ &bdy_control
+ spec_bdy_width                      = 5,       ; total number of rows for specified boundary value nudging
+ spec_zone                           = 1,       ; number of points in specified zone (spec b.c. option)
+ relax_zone                          = 4,       ; number of points in relaxation zone (spec b.c. option)
+ specified (max_dom)                 = .false., ; specified boundary conditions (only for domain 1)
+                                                  the above 4 are used for real-data runs
+
+ periodic_x (max_dom)                = .false., ; periodic boundary conditions in x direction
+ symmetric_xs (max_dom)              = .false., ; symmetric boundary conditions at x start (west)
+ symmetric_xe (max_dom)              = .false., ; symmetric boundary conditions at x end (east)
+ open_xs (max_dom)                   = .false., ; open boundary conditions at x start (west)
+ open_xe (max_dom)                   = .false., ; open boundary conditions at x end (east)
+ periodic_y (max_dom)                = .false., ; periodic boundary conditions in y direction
+ symmetric_ys (max_dom)              = .false., ; symmetric boundary conditions at y start (south)
+ symmetric_ye (max_dom)              = .false., ; symmetric boundary conditions at y end (north)
+ open_ys (max_dom)                   = .false., ; open boundary conditions at y start (south)
+ open_ye (max_dom)                   = .false., ; open boundary conditions at y end (north)
+ nested (max_dom)                    = .false., ; nested boundary conditions (inactive)
+
+
+ &namelist_quilt    This namelist record controls asynchronized I/O for MPI applications. 
+
+ nio_tasks_per_group                 = 0,        default value is 0: no quilting; > 0 quilting I/O
+ nio_groups                          = 1,        default 1, don't change
+
+
+ miscelleneous in &domains:
+ tile_sz_x                           = 0,	; number of points in tile x direction
+ tile_sz_y                           = 0,	; number of points in tile y direction
+						  can be determined automatically
+ numtiles                            = 1,	; number of tiles per patch (alternative to above two items)
+ nproc_x                             = -1,      ; number of processors in x for decomposition
+ nproc_y                             = -1,      ; number of processors in y for decomposition
+                                                  -1: code will do automatic decomposition
+                                                  >1: for both: will be used for decomposition
Index: trunk/WRF.COMMON/WRFV2/run/SOILPARM.TBL
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/SOILPARM.TBL	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/SOILPARM.TBL	(revision 2744)
@@ -0,0 +1,22 @@
+Soil Parameters
+STAS
+19,1   'BB      DRYSMC      F11     MAXSMC   REFSMC   SATPSI  SATDK       SATDW     WLTSMC  QTZ    '
+1,     2.79,    0.010,    -0.472,   0.339,   0.236,   0.069,  1.07E-6,  0.608E-6,   0.010,  0.92, 'SAND'
+2,     4.26,    0.028,    -1.044,   0.421,   0.383,   0.036,  1.41E-5,  0.514E-5,   0.028,  0.82, 'LOAMY SAND'
+3,     4.74,    0.047,    -0.569,   0.434,   0.383,   0.141,  5.23E-6,  0.805E-5,   0.047,  0.60, 'SANDY LOAM'
+4,     5.33,    0.084,     0.162,   0.476,   0.360,   0.759,  2.81E-6,  0.239E-4,   0.084,  0.25, 'SILT LOAM'
+5,     5.33,    0.084,     0.162,   0.476,   0.383,   0.759,  2.81E-6,  0.239E-4,   0.084,  0.10, 'SILT'
+6,     5.25,    0.066,    -0.327,   0.439,   0.329,   0.355,  3.38E-6,  0.143E-4,   0.066,  0.40, 'LOAM'
+7,     6.66,    0.067,    -1.491,   0.404,   0.314,   0.135,  4.45E-6,  0.990E-5,   0.067,  0.60, 'SANDY CLAY LOAM'
+8,     8.72,    0.120,    -1.118,   0.464,   0.387,   0.617,  2.04E-6,  0.237E-4,   0.120,  0.10, 'SILTY CLAY LOAM'
+9,     8.17,    0.103,    -1.297,   0.465,   0.382,   0.263,  2.45E-6,  0.113E-4,   0.103,  0.35, 'CLAY LOAM'
+10,   10.73,    0.100,    -3.209,   0.406,   0.338,   0.098,  7.22E-6,  0.187E-4,   0.100,  0.52, 'SANDY CLAY'
+11,   10.39,    0.126,    -1.916,   0.468,   0.404,   0.324,  1.34E-6,  0.964E-5,   0.126,  0.10, 'SILTY CLAY'
+12,   11.55,    0.138,    -2.138,   0.468,   0.412,   0.468,  9.74E-7,  0.112E-4,   0.138,  0.25, 'CLAY'
+13,    5.25,    0.066,    -0.327,   0.439,   0.329,   0.355,  3.38E-6,  0.143E-4,   0.066,  0.05, 'ORGANIC MATERIAL'
+14,     0.0,      0.0,       0.0,     1.0,     0.0,     0.0,      0.0,       0.0,     0.0,  0.60, 'WATER'
+15,    2.79,    0.006,    -1.111,    0.20,    0.17,   0.069,  1.41E-4,  0.136E-3,   0.006,  0.07, 'BEDROCK'
+16,    4.26,    0.028,    -1.044,   0.421,   0.283,   0.036,  1.41E-5,  0.514E-5,   0.028,  0.25, 'OTHER(land-ice)'
+17,   11.55,    0.030,   -10.472,   0.468,   0.454,   0.468,  9.74E-7,  0.112E-4,   0.030,  0.60, 'PLAYA'
+18,    2.79,    0.006,    -0.472,   0.200,    0.17,   0.069,  1.41E-4,  0.136E-3,   0.006,  0.52, 'LAVA'
+19,    2.79,     0.01,    -0.472,   0.339,   0.236,   0.069,  1.07E-6,  0.608E-6,    0.01,  0.92, 'WHITE SAND'
Index: trunk/WRF.COMMON/WRFV2/run/VEGPARM.TBL
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/VEGPARM.TBL	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/VEGPARM.TBL	(revision 2744)
@@ -0,0 +1,40 @@
+Vegetation Parameters
+USGS
+27,1, 'ALBEDO    Z0   SHDFAC NROOT   RS      RGL      HS      SNUP    LAI   MAXALB'
+1,     .15,    1.00,   .10,   1,    200.,   999.,   999.0,   0.04,   4.0,     40.,    'Urban and Built-Up Land'  
+2,     .19,     .07,   .80,   3,     40.,   100.,   36.25,   0.04,   4.0,     64.,    'Dryland Cropland and Pasture' 
+3,     .15,     .07,   .80,   3,     40.,   100.,   36.25,   0.04,   4.0,     64.,    'Irrigated Cropland and Pasture' 
+4,     .17,     .07,   .80,   3,     40.,   100.,   36.25,   0.04,   4.0,     64.,    'Mixed Dryland/Irrigated Cropland and Pasture' 
+5,     .19,     .07,   .80,   3,     40.,   100.,   36.25,   0.04,   4.0,     64.,    'Cropland/Grassland Mosaic'
+6,     .19,     .15,   .80,   3,     70.,    65.,   44.14,   0.04,   4.0,     60.,    'Cropland/Woodland Mosaic' 
+7,     .19,     .08,   .80,   3,     40.,   100.,   36.35,   0.04,   4.0,     64.,    'Grassland' 
+8,     .25,     .03,   .70,   3,    300.,   100.,   42.00,   0.03,   4.0,     69.,    'Shrubland' 
+9,     .23,     .05,   .70,   3,    170.,   100.,   39.18,  0.035,   4.0,     67.,    'Mixed Shrubland/Grassland' 
+10,    .20,     .86,   .50,   3,     70.,    65.,   54.53,   0.04,   4.0,     45.,    'Savanna' 
+11,    .12,     .80,   .80,   4,    100.,    30.,   54.53,   0.08,   4.0,     58.,    'Deciduous Broadleaf Forest' 
+12,    .11,     .85,   .70,   4,    150.,    30.,   47.35,   0.08,   4.0,     54.,    'Deciduous Needleleaf Forest' 
+13,    .11,    2.65,   .95,   4,    150.,    30.,   41.69,   0.08,   4.0,     32.,    'Evergreen Broadleaf Forest'
+14,    .10,    1.09,   .70,   4,    125.,    30.,   47.35,   0.08,   4.0,     52.,    'Evergreen Needleleaf Forest'  
+15,    .12,     .80,   .80,   4,    125.,    30.,   51.93,   0.08,   4.0,     53.,    'Mixed Forest' 
+16,    .19,    .001,   .00,   0,    100.,    30.,   51.75,   0.01,   4.0,     70.,    'Water Bodies' 
+17,    .12,     .04,   .60,   2,     40.,   100.,   60.00,   0.01,   4.0,     35.,    'Herbaceous Wetland' 
+18,    .12,     .05,   .60,   2,    100.,    30.,   51.93,   0.02,   4.0,     30.,    'Wooded Wetland' 
+19,    .12,     .01,   .01,   1,    999.,   999.,   999.0,   0.02,   4.0,     69.,    'Barren or Sparsely Vegetated' 
+20,    .16,     .04,   .60,   3,    150.,   100.,   42.00,  0.025,   4.0,     58.,    'Herbaceous Tundra' 
+21,    .16,     .06,   .60,   3,    150.,   100.,   42.00,  0.025,   4.0,     55.,    'Wooded Tundra' 
+22,    .16,     .05,   .60,   3,    150.,   100.,   42.00,  0.025,   4.0,     55.,    'Mixed Tundra' 
+23,    .17,     .03,   .30,   2,    200.,   100.,   42.00,   0.02,   4.0,     65.,    'Bare Ground Tundra' 
+24,    .70,    .001,   .00,   1,    999.,   999.,   999.0,   0.02,   4.0,     75.,    'Snow or Ice' 
+25,    .30,     .01,   .50,   1,     40.,   100.,   36.25,   0.02,   4.0,     69.,    'Playa' 
+26,    .16,     .15,   .00,   0,    999.,   999.,   999.0,   0.02,   4.0,     69.,    'Lava'   
+27,    .60,     .01,   .00,   0,    999.,   999.,   999.0,   0.02,   4.0,     69.,    'White Sand' 
+TOPT_DATA
+298.0
+CMCMAX_DATA
+0.5E-3
+CFACTR_DATA
+0.5
+RSMAX_DATA
+5000.0
+BARE
+19
Index: trunk/WRF.COMMON/WRFV2/run/grib2map.tbl
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/grib2map.tbl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/grib2map.tbl	(revision 2744)
@@ -0,0 +1,344 @@
+# Header section that describes the following GRIB 2 table(s)
+#
+# Ind | center | subcenter | Master Tbl Version | Local Tbl Version |
+#-----+--------+-----------+--------------------+-------------------+
+  -1  |    255 |       255 |                  1 |                 1 |
+#
+# The table itself
+#
+# The precision is controlled by the decimal and binary scale factors.  
+#
+# The decimal scale factor is the number of digits after the decimal point 
+#   that are retained.  If negative, precision is reduced by 10**dec (i.e.,
+#   -1 would reduce the precision to the nearest factor of 10).
+#
+# When the decimal scale factor is 0, the binary scale factor indicates the
+#   precision of the data in bits.
+#
+# The grib2 docuementation, available from http://, describes the decimal
+#   and binary scale factors in more detail.
+# 
+#   
+#
+#Dis|Cat|Prm|           |                                          |Dec |Bin |
+#cip|gor|Num| WRF Id(s) | Description                              |Fctr|Fctr|
+#---+---+---+-----------+------------------------------------------+----+----+
+  0 | 0 | 0 | T2,TSK    | Temperature                              |  2 |  0 |
+  0 | 0 | 2 | TH2,THZ0,T| Potential Temperature                    |  1 |  0 |
+  0 | 0 |192| T_INIT    | Initial Potential Temperature            |  3 |  0 |
+  0 | 0 |193| RTHFTEN   | Temp. Tendency in Grell Cumulus [K/s]    |  6 |  0 |
+  0 | 0 |194| T_BASE    | Base State T in Idealized Cases [K]      |  2 |  0 |
+  0 | 0 |195| T_1       | Restart Parameter                        |  4 |  0 |
+  0 | 0 |196| T_2       | Restart Parameter                        |  4 |  0 |
+  0 | 0 |197| H_DIABATIC| Previous Timestep Condensational heating |  7 |  0 |
+  0 | 0 |198| RTHCUTEN  | Coupled theta tend(cumulus sch)[Pa K s-1]|  3 |  0 |
+  0 | 0 |199| RTHRATEN  | Coupled theta tend due to radia [Pa K/s] |  3 |  0 |
+  0 | 0 |200| RTHRATLW  | Coupled theta tend due to lw rad [Pa K/s]|  3 |  0 |
+  0 | 0 |201| RTHRATSW  | Coupled theta tend due to sw rad [Pa K/s]|  3 |  0 |
+  0 | 0 |202| MOL       | TStar in Similarity theory [K]           |  3 |  0 |
+  0 | 0 |203| THC       | Thermal Inertia [Cal /(cm K s^.5)]       |  3 |  0 |
+  0 | 0 |204| RTHBLTEN  | Coupled theta tend due to PBL [Pa K/s]   |  4 |  0 |
+  0 | 1 | 0 | QSFC      | Specific Humidity [kg/kg]                |  5 |  0 |
+  0 | 1 | 2 |QVAPOR,Q2,QVG|Humidity Mixing Ratio [kg/kg]           |  5 |  0 |
+  0 | 1 | 6 |SFCEVP     | Evaporation [kg/m^2]                     |  3 |  0 |
+  0 | 1 | 9 | RAINNC    | Large-scale precip (non-conv)[Kg/m^2]    |  2 |  0 |
+  0 | 1 | 10| RAINC     | Convective precipitation [kg/m^2]        |  2 |  0 |
+  0 | 1 | 13| WEASD,SNOW| Water equivalent of snow depth [kg/m^2]  |  2 |  0 |
+  0 | 1 | 11|SNOWH,SNOWCU,ACSNOW|Snow depth [m]                    |  4 |  0 |
+  0 | 1 | 22| QCLOUD,QCG| Cloud water mixing ratio [kg/kg]         |  6 |  0 |
+  0 | 1 | 23| QICE      | Ice water mixing ratio [kg/kg]           |  5 |  0 |
+  0 | 1 | 24| QRAIN     | Rain water mixing ratio [kg/kg]          |  5 |  0 |
+  0 | 1 | 25| QSNOW     | Snow water mixing ratio [kg/kg]          |  5 |  0 |
+  0 | 1 | 32| QGRAUP    | Graupel mixing ratio [kg/kg]             |  5 |  0 |
+  0 | 1 |192| LH        | Latent heat flux [W/m^2]                 |  2 |  0 |
+  0 | 1 |193| ACSNOM    | Accumulated melted snow [cm]             |  2 |  0 |
+  0 | 1 |194| RAINNCV   | Large-scale precip rate [kg/m^2/s]       |  7 |  0 |
+  0 | 1 |195| RAINCV    | Convective precip rate [kg/m^2/s]        |  7 |  0 |
+  0 | 1 |196| QFX       | Upward moisture flux [kg/m^s]            |  6 |  0 |
+  0 | 1 |197| HFX       | Upward heat flux at the surface [W/m^2]  |  1 |  0 |
+  0 | 1 |198| QNI       | Ice crystal number concentration         |  0 |  0 |
+  0 | 1 |199| QV_BASE   | Base State QV in Idealized Cases         |  5 |  0 |
+  0 | 1 |200| CT        | Countergradient term [K]                 |  5 |  0 |
+  0 | 1 |201| QZ0       | Specific humidity at rough length [kg/kg]|  5 |  0 |
+  0 | 1 |202| CUPPT     | Acc cnv rain since last call to rad      |  4 |  0 |
+  0 | 1 |203| F_ICE_PHY | Fraction of Ice (eta mp state variable)  |  2 |  0 |
+  0 | 1 |204| F_RAIN_PHY| Fraction of Rain (eta mp state variable) |  2 |  0 |
+  0 | 1 |205|F_RIMEF_PHY| Mass Ratio of Rimed Ice(eta mp variable) |  2 |  0 |
+  0 | 1 |206| RQVCUTEN  | Coupled QV tend(cum sch)[Pa kg kg-1 s-1] |  6 |  0 |
+  0 | 1 |207| RQRCUTEN  | Coupled QR tend(cum sch)[Pa kg kg-1 s-1] |  6 |  0 |
+  0 | 1 |208| RQCCUTEN  | Coupled QC tend(cum sch)[Pa kg kg-1 s-1] |  6 |  0 |
+  0 | 1 |209| RQSCUTEN  | Coupled QS tend(cum sch)[Pa kg kg-1 s-1] |  6 |  0 |
+  0 | 1 |210| RQICUTEN  | Coupled QI tend(cum sch)[Pa kg kg-1 s-1] |  6 |  0 |
+  0 | 1 |211| RAINBL    | Acc pcp over BL time step [kg/m^2]       |  2 |  0 |
+  0 | 1 |212| NCA       | Counter of cloud relax in KF             |  2 |  0 |
+  0 | 1 |213| APR_GR    | Precip from closure (old grell) [mm/hr]  |  4 |  0 |
+  0 | 1 |214| APR_W     | Precip from closure W [mm/hr]            |  4 |  0 |
+  0 | 1 |215| APR_MC    | Precip from closure Krish MV    [mm/hr]  |  4 |  0 |
+  0 | 1 |216| APR_ST    | Precip from closure Stability   [mm/hr]  |  4 |  0 |
+  0 | 1 |217| APR_AS    | Precip from closure AS-Type     [mm/hr]  |  4 |  0 |
+  0 | 1 |218| APR_CAPMA | Precip from max CAP             [mm/hr]  |  4 |  0 |
+  0 | 1 |219| APR_CAPME | Precip from mean CAP            [mm/hr]  |  4 |  0 |
+  0 | 1 |220| APR_CAPMI | Precip from min CAP             [mm/hr]  |  4 |  0 |
+  0 | 1 |221| PR_ENS    | Precip rate in Grell                     |  4 |  0 |
+  0 | 1 |222| RQVFTEN   | Moisture tendency in Grell [kg/s]        |  6 |  0 |
+  0 | 1 |223| CLDEFI    | Precipitation efficiency in BMJ          |  4 |  0 |
+  0 | 1 |224| RQVBLTEN  | Coupled QV tend due to PBL [Pa kg/(kg s)]|  0 | 24 |
+  0 | 1 |225| RQCBLTEN  | Coupled QC tend due to PBL [Pa kg/(kg s)]|  0 | 24 |
+  0 | 1 |226| RQIBLTEN  | Coupled QI tend due to PBL [Pa kg/(kg s)]|  0 | 24 |
+  0 | 1 |227| FLQC      | Surface exchange coefficient for moisture|  6 |  0 |
+  0 | 1 |228| QSG       | Surface saturation wv mixing ratio[kg/kg]|  6 |  0 |
+  0 | 1 |229| MAVAIL    | Surface moisture availability            |  4 |  0 |
+  0 | 2 | 2 | U,U10,UZ0 | U-component of wind [m/s]                |  2 |  0 |
+  0 | 2 | 3 | V,V10,VZ0 | V-component of wind [m/s]                |  2 |  0 |
+  0 | 2 | 7 | WW        | Sigma coordinate vertical velocity [s^-1]|  3 |  0 |
+  0 | 2 | 9 | W         | Geometric vertical velocity [m/s]        |  4 |  0 |
+  0 | 2 |192| U_BASE    | Base State X Wind in Idealized Cases     |  3 |  0 |
+  0 | 2 |193| V_BASE    | Base State Y Wind in Idealized Cases     |  3 |  0 |
+  0 | 2 |194| U_1       | Restart Parameter                        |  4 |  0 |
+  0 | 2 |195| U_2       | Restart Parameter                        |  4 |  0 |
+  0 | 2 |196| V_1       | Restart Parameter                        |  4 |  0 |
+  0 | 2 |197| V_2       | Restart Parameter                        |  4 |  0 |
+  0 | 2 |198| W_1       | Restart Parameter                        |  0 | 24 |
+  0 | 2 |199| W_2       | Restart Parameter                        |  0 | 24 |
+  0 | 2 |200| SFCEXC    | Exchange coefficient [m/s]               |  5 |  0 |
+  0 | 2 |201| AKHS      | Sfc exchange coefficient for heat [m/s]  |  5 |  0 |
+  0 | 2 |202| AKMS      | Sfc exch coefficient for momentum [m/s]  |  3 |  0 |
+  0 | 2 |203| W0AVG     | Average VV for KF Cum Scheme [m/s]       |  6 |  0 |
+  0 | 2 |204| MASS_FLUX | Downdraft mass flux in grell [mb/hr]     |  4 |  0 |
+  0 | 2 |205| RUBLTEN   | Coupled X-wind tend due to PBL [Pa m/s^2]|  2 |  0 |
+  0 | 2 |206| RVBLTEN   | Coupled X-wind tend due to PBL [Pa m/s^2]|  2 |  0 |
+  0 | 2 |207| UST       | UStar in Similarity theory [m/s]         |  4 |  0 |
+  0 | 2 |208| FLHC      | Surface exchange coefficient for heat    |  3 |  0 |
+  0 | 3 | 0 | P,PSFC    | Pressure [Pa]                            |  1 |  0 |
+  0 | 3 | 1 | PMSL      | Pressure reduced to MSL [Pa]             |  1 |  0 |
+  0 | 3 | 4 | PHP       | Geopotential [m^2/s^2]                   |  3 |  0 |
+  0 | 3 |192| PHB       | Base-state geopotential [m^2/s^2]        |  0 |  0 |
+  0 | 3 |193| PH        | Perturbation geopotential [m^2/s^2]      |  1 |  0 |
+  0 | 3 |194| MUB       | Base-state dry air mass in column [Pa]   |  1 |  0 |
+  0 | 3 |195| MU        | Perturbation dry air mass in column [Pa] |  1 |  0 |
+  0 | 3 |196| MU0       | Initial dry air mass in column [Pa]      |  0 |  0 |
+  0 | 3 |197| PB        | Base-state pressure [Pa]                 |  0 |  0 |
+  0 | 3 |198| GRDFLX    | Ground heat flux [W/m^2]                 |  1 |  0 |
+  0 | 3 |199| Z_BASE    | Base State Height in Idealized Cases     |  5 |  0 |
+  0 | 3 |200| PH_1      | Restart Parameter                        |  3 |  0 |
+  0 | 3 |201| PH_2      | Restart Parameter                        |  3 |  0 |
+  0 | 3 |202| PH0       | Initial geopotential                     |  1 |  0 |
+  0 | 3 |203| MU_1      | Restart Parameter                        |  3 |  0 |
+  0 | 3 |204| MU_2      | Restart Parameter                        |  3 |  0 |
+  0 | 3 |205| AL        | Inverse perturbation density [m3 kg-1]   |  5 |  0 |
+  0 | 3 |206| ALT       | Inverse density [m3 kg-1]                |  4 |  0 |
+  0 | 3 |207| XF_ENS    | Mass flux PDF in GRELL                   |  4 |  0 |
+  0 | 4 | 0 | GSW       | Net short wave flux [W/m^2]              |  3 |  0 |
+  0 | 4 |192| SWDOWN    | Downward short wave flux [W/m^2]         |  1 |  0 |
+  0 | 4 |193| TOTSWDN   | Radiation State Variable                 |  2 |  0 |
+  0 | 4 |194| RSWTOA    | Radiation State Variable                 |  4 |  0 |
+  0 | 4 |195| RLWTOA    | Radiation State Variable                 |  4 |  0 |
+  0 | 4 |196| CZMEAN    | Radiation State Variable                 |  4 |  0 |
+  0 | 4 |197| CFRACL    | Radiation State Variable                 |  4 |  0 |
+  0 | 4 |198| CFRACM    | Radiation State Variable                 |  4 |  0 |
+  0 | 4 |199| CFRACH    | Radiation State Variable                 |  4 |  0 |
+  0 | 4 |200| ACFRST    | Radiation State Variable                 |  4 |  0 |
+  0 | 4 |201| NCFRST    | Radiation State Variable                 |  4 |  0 |
+  0 | 4 |202| ACFRCV    | Radiation State Variable                 |  4 |  0 |
+  0 | 4 |203| NCFRCV    | Radiation State Variable                 |  4 |  0 |
+  0 | 5 | 0 | GLW       | Net long wave flux [W/m^2]               |  2 |  0 |
+  0 | 5 |193| TOTLWDN   | Radiation State Variable                 |  4 |  0 |
+  0 | 6 | 1 | CLDFRA    | Total Cloud Cover [%]                    |  2 |  0 |
+  0 | 6 |192| TAUCLDI   | Cloud optical thickness for ice          |  2 |  0 |
+  0 | 6 |193| TAUCLDC   | Cloud optical thickness for water        |  2 |  0 |
+  0 | 13|192|MASS_AER_WATER| aerosol liquid water content          |  6 |  0 |
+  0 | 13|193|MASS_AER_DRY| dry aerosol mass                        |  6 |  0 |
+  0 | 19|  1| ALBEDO    | Albedo [%]                               |  2 |  0 |
+  0 | 19| 11|TKE,TKE_MYJ| Turbulent Kinetic Energy [J/kg]          |  3 |  0 |
+  0 | 19|192| ALBBCK    | Background Albedo [%]                    |  4 |  0 |
+  0 | 19|193| TKE_1     | Restart Parameter                        |  3 |  0 |
+  0 | 19|194| TKE_2     | Restart Parameter                        |  3 |  0 |
+  0 |191|192| CFN       | CFN from WRF [?]                         |  3 |  0 |
+  0 |191|193| CFN1      | CFN1 from WRF [?]                        |  3 |  0 |
+  0 |191|194| ZNU       | Eta values on half (mass) levels         |  6 |  0 |
+  0 |191|195| ZNW       | Eta values on full (w) levels            |  6 |  0 |
+  0 |191|196| DN        | DN values [dimensionless]                |  4 |  0 |
+  0 |191|197| DNW       | DNW values [dimensionless]               |  4 |  0 |
+  0 |191|198| RDN       | Inverse DN values [dimensionless]        |  3 |  0 |
+  0 |191|199| RDNW      | Inverse d(eta) values for full (w) levels|  3 |  0 |
+  0 |191|200| FNP       | Lower weight for vertical strection [dim]|  5 |  0 |
+  0 |191|201| FNM       | Upper weight for vertical strection [dim]|  5 |  0 |
+  0 |191|202| MAPFAC_M  | Map Scale Factor [dimensionless]         |  4 |  0 |
+  0 |191|203| MAPFAC_U  | Map Scale Factor [dimensionless]         |  4 |  0 |
+  0 |191|204| MAPFAC_V  | Map Scale Factor [dimensionless]         |  4 |  0 |
+  0 |191|205| F         | Coriolis sine latitude term              |  6 |  0 |
+  0 |191|206| E         | Coriolis cosine latitude term            |  6 |  0 |
+  0 |191|207| PBLH      | Planetary boundary layer height [m]      |  0 |  0 |
+  0 |191|208| ZS        | Depths of centers of soil layers [m]     |  3 |  0 |
+  0 |191|209| DZS       | Thicknesses of soil layers [m]           |  3 |  0 |
+  0 |191|210| XLAT      | Latitude [deg]                           |  4 |  0 |
+  0 |191|211| XLONG     | Longitude [deg]                          |  4 |  0 |
+  0 |191|212| COSALPHA  | Local cosine of map rotation             |  6 |  0 |
+  0 |191|213| SINALPHA  | Local sine of map rotation               |  6 |  0 |
+  0 |191|214| NEST_POS  | Nest Position                            |  0 |  0 |
+  0 |191|215| ALB       | Restart Parameter (??)                   |  4 |  0 |
+  0 |191|216| EXCH_H    | Exchange coefficients                    |  3 |  0 |
+  0 |191|217| KPBL      | Level of PBL top [m]                     |  1 |  0 |
+  0 |191|218| HTOP      | Top of convection level                  |  1 |  0 |
+  0 |191|219| HBOT      | Bottom of convection level               |  1 |  0 |
+  0 |191|220| TKESFCF   | TKE at the surface [m^/s^2]              |  3 |  0 |
+  0 |191|253|WRF_SCALAR | Scalar Output data in local section      |  0 |  0 |
+  0 |191|254|WRF_GLOBAL | Global Output data in local section      |  0 |  0 |
+  0 |192| 1 | U_BXS     |                                          |  0 |  0 |
+  0 |192| 2 | U_BXE     |                                          |  0 |  0 |
+  0 |192| 3 | U_BYS     |                                          |  0 |  0 |
+  0 |192| 4 | U_BYE     |                                          |  0 |  0 |
+  0 |192| 5 | U_BTXS    |                                          |  2 |  0 |
+  0 |192| 6 | U_BTXE    |                                          |  2 |  0 |
+  0 |192| 7 | U_BTYS    |                                          |  2 |  0 |
+  0 |192| 8 | U_BTYE    |                                          |  2 |  0 |
+  0 |192| 9 | V_BXS     |                                          |  0 |  0 |
+  0 |192| 10| V_BXE     |                                          |  0 |  0 |
+  0 |192| 11| V_BYS     |                                          |  0 |  0 |
+  0 |192| 12| V_BYE     |                                          |  0 |  0 |
+  0 |192| 13| V_BTXS    |                                          |  2 |  0 |
+  0 |192| 14| V_BTXE    |                                          |  2 |  0 |
+  0 |192| 15| V_BTYS    |                                          |  2 |  0 |
+  0 |192| 16| V_BTYE    |                                          |  2 |  0 |
+  0 |192| 17| W_BXS     |                                          |  4 |  0 |
+  0 |192| 18| W_BXE     |                                          |  4 |  0 |
+  0 |192| 19| W_BYS     |                                          |  4 |  0 |
+  0 |192| 20| W_BYE     |                                          |  4 |  0 |
+  0 |192| 21| W_BTXS    |                                          |  5 |  0 |
+  0 |192| 22| W_BTXE    |                                          |  5 |  0 |
+  0 |192| 23| W_BTYS    |                                          |  5 |  0 |
+  0 |192| 24| W_BTYE    |                                          |  5 |  0 |
+  0 |192| 25| PH_BXS    |                                          | -2 |  0 |
+  0 |192| 26| PH_BXE    |                                          | -2 |  0 |
+  0 |192| 27| PH_BYS    |                                          | -2 |  0 |
+  0 |192| 28| PH_BYE    |                                          | -2 |  0 |
+  0 |192| 29| PH_BTXS   |                                          |  0 |  0 |
+  0 |192| 30| PH_BTXE   |                                          |  0 |  0 |
+  0 |192| 31| PH_BTYS   |                                          |  0 |  0 |
+  0 |192| 32| PH_BTYE   |                                          |  0 |  0 |
+  0 |192| 33| T_BXS     |                                          | -1 |  0 |
+  0 |192| 34| T_BXE     |                                          | -1 |  0 |
+  0 |192| 35| T_BYS     |                                          | -1 |  0 |
+  0 |192| 36| T_BYE     |                                          | -1 |  0 |
+  0 |192| 37| T_BTXS    |                                          |  2 |  0 |
+  0 |192| 38| T_BTXE    |                                          |  2 |  0 |
+  0 |192| 39| T_BTYS    |                                          |  2 |  0 |
+  0 |192| 40| T_BTYE    |                                          |  2 |  0 |
+  0 |192| 41| MU_BXS    |                                          |  2 |  0 |
+  0 |192| 42| MU_BXE    |                                          |  2 |  0 |
+  0 |192| 43| MU_BYS    |                                          |  2 |  0 |
+  0 |192| 44| MU_BYE    |                                          |  4 |  0 |
+  0 |192| 45| MU_BTXS   |                                          |  4 |  0 |
+  0 |192| 46| MU_BTXE   |                                          |  4 |  0 |
+  0 |192| 47| MU_BTYS   |                                          |  4 |  0 |
+  0 |192| 48| MU_BTYE   |                                          |  4 |  0 |
+  0 |192| 49| QVAPOR_BXS|                                          |  1 |  0 |
+  0 |192| 50| QVAPOR_BXE|                                          |  1 |  0 |
+  0 |192| 51| QVAPOR_BYS|                                          |  1 |  0 |
+  0 |192| 52| QVAPOR_BYE|                                          |  1 |  0 |
+  0 |192| 53|QVAPOR_BTXS|                                          |  6 |  0 |
+  0 |192| 54|QVAPOR_BTXE|                                          |  6 |  0 |
+  0 |192| 55|QVAPOR_BTYS|                                          |  6 |  0 |
+  0 |192| 56|QVAPOR_BTYE|                                          |  6 |  0 |
+  0 |192| 57| QCLOUD_BXS|                                          |  1 |  0 |
+  0 |192| 58| QCLOUD_BXE|                                          |  1 |  0 |
+  0 |192| 59| QCLOUD_BYS|                                          |  1 |  0 |
+  0 |192| 60| QCLOUD_BYE|                                          |  1 |  0 |
+  0 |192| 61|QCLOUD_BTXS|                                          |  7 |  0 |
+  0 |192| 62|QCLOUD_BTXE|                                          |  7 |  0 |
+  0 |192| 63|QCLOUD_BTYS|                                          |  7 |  0 |
+  0 |192| 64|QCLOUD_BTYE|                                          |  7 |  0 |
+  0 |192| 65| QRAIN_BXS |                                          |  1 |  0 |
+  0 |192| 66| QRAIN_BXE |                                          |  1 |  0 |
+  0 |192| 67| QRAIN_BYS |                                          |  1 |  0 |
+  0 |192| 68| QRAIN_BYE |                                          |  1 |  0 |
+  0 |192| 69| QRAIN_BTXS|                                          |  7 |  0 |
+  0 |192| 70| QRAIN_BTXE|                                          |  7 |  0 |
+  0 |192| 71| QRAIN_BTYS|                                          |  7 |  0 |
+  0 |192| 72| QRAIN_BTYE|                                          |  7 |  0 |
+  0 |192| 73| QICE_BXS  |                                          |  2 |  0 |
+  0 |192| 74| QICE_BXE  |                                          |  2 |  0 |
+  0 |192| 75| QICE_BYS  |                                          |  2 |  0 |
+  0 |192| 76| QICE_BYE  |                                          |  2 |  0 |
+  0 |192| 77| QICE_BTXS |                                          |  7 |  0 |
+  0 |192| 78| QICE_BTXE |                                          |  7 |  0 |
+  0 |192| 79| QICE_BTYS |                                          |  7 |  0 |
+  0 |192| 80| QICE_BTYE |                                          |  7 |  0 |
+  0 |192| 81| QSNOW_BXS |                                          |  2 |  0 |
+  0 |192| 82| QSNOW_BXE |                                          |  2 |  0 |
+  0 |192| 83| QSNOW_BYS |                                          |  2 |  0 |
+  0 |192| 84| QSNOW_BYE |                                          |  2 |  0 |
+  0 |192| 85| QSNOW_BTXS|                                          |  7 |  0 |
+  0 |192| 86| QSNOW_BTXE|                                          |  7 |  0 |
+  0 |192| 87| QSNOW_BTYS|                                          |  7 |  0 |
+  0 |192| 88| QSNOW_BTYE|                                          |  7 |  0 |
+  0 |192| 89| QGRAUP_BXS|                                          |  2 |  0 |
+  0 |192| 90| QGRAUP_BXE|                                          |  2 |  0 |
+  0 |192| 91| QGRAUP_BYS|                                          |  2 |  0 |
+  0 |192| 92| QGRAUP_BYE|                                          |  2 |  0 |
+  0 |192| 93|QGRAUP_BTXS|                                          |  7 |  0 |
+  0 |192| 94|QGRAUP_BTXE|                                          |  7 |  0 |
+  0 |192| 95|QGRAUP_BTYS|                                          |  7 |  0 |
+  0 |192| 96|QGRAUP_BTYE|                                          |  7 |  0 |
+  0 |192| 97| QNICE_BXS |                                          |  4 |  0 |
+  0 |192| 98| QNICE_BXE |                                          |  4 |  0 |
+  0 |192| 99| QNICE_BYS |                                          |  4 |  0 |
+  0 |192|100| QNICE_BYE |                                          |  4 |  0 |
+  0 |192|101| QNICE_BTXS|                                          |  7 |  0 |
+  0 |192|102| QNICE_BTXE|                                          |  7 |  0 |
+  0 |192|103| QNICE_BTYS|                                          |  7 |  0 |
+  0 |192|104| QNICE_BTYE|                                          |  7 |  0 |
+  0 |193|192| FCX       | Relaxation term for boundary zone        |  4 |  0 |
+  0 |193|193| GCX       | 2nd Relaxation term for boundary zone    |  4 |  0 |
+  0 |193|194|MP_RESTART_STATE|state vect for microphysics restarts |  4 |  0 |
+  0 |193|195|TBPVS_STATE| state for etampnew microphysics          |  4 |  0 |
+  0 |193|196|TBPVS0_STATE| state for etampnew microphysics         |  4 |  0 |
+  1 | 0 | 1 | SFROFF    | Storm surface runoff [kg/m^2]            |  4 |  0 |
+  1 | 0 |192| SOILT1    | Temperature inside snow                  |  2 |  0 |
+  1 | 0 |193| TSNAV     | Average snow temperature                 |  2 |  0 |
+  1 | 0 |194| UDROFF    | Baseflow-groundwater runoff [kg/m^2]     |  4 |  0 |
+  2 | 0 | 0 | LANDMASK  | Land Cover (1=land,2=sea)                |  1 |  0 |
+  2 | 0 | 1 | ZNT       | Time Varying Roughness length [m]        |  6 |  0 |
+  2 | 0 | 4 | VEGFRA    | Vegetation [%]                           |  1 |  0 |
+  2 | 0 | 7 |HGT,SOILHGT,DIST| Terrain Height [m]                  |  2 |  0 |
+  2 | 0 |192| LU_INDEX  | Land Use Index [Cat]                     |  1 |  0 |
+  2 | 0 |193| CANWAT    | Plant Canopy Surface Water [kg/m^2]      |  4 |  0 |
+  2 | 0 |194| SNOWC     | Snow cover [%]                           |  1 |  0 |
+  2 | 0 |195| XLAND     | Land cover (land=1; sea=0) [fraction]    |  1 |  0 |
+  2 | 0 |196| TOPOSTDV  | Standard Deviation of topography         |  3 |  0 |
+  2 | 0 |197| TOPOSLPX  | Sub-gridscale mean topographic slope     |  6 |  0 |
+  2 | 0 |198| TOPOSLPY  | Sub-gridscale mean topographic slope     |  6 |  0 |
+  2 | 0 |199| SLOPECAT  | Topographical Categorical Slope          |  1 |  0 |
+  2 | 0 |200| LANDUSEF  | Land use categorical fraction on mass gr |  3 |  0 |
+  2 | 0 |201| SOILCTOP  | Top layer soil type as a categ. fraction |  3 |  0 |
+  2 | 0 |202| SOILCBOT  | Bot layer soil type as a categ. fraction |  3 |  0 |
+  2 | 0 |203| RMOL      | 1./Monin Ob. Length [dimensionless]      |  2 |  0 |
+  2 | 0 |204| SHDMAX    | Annual MAX veg fraction                  |  3 |  0 |
+  2 | 0 |205| SHDMIN    | Annual MIN veg fraction                  |  3 |  0 |
+  2 | 0 |206| Z0        | Background Roughness length [m]          |  6 |  0 |
+  2 | 0 |207| EMISS     | Surface Emissivity                       |  4 |  0 |
+  2 | 3 | 0 | ISLTYP    | Soil Type                                |  1 |  0 |
+  2 | 3 | 1 |TSLB,ST000010,ST010040,ST040100,ST100200|Soil Temperature|1|  0 |
+  2 | 3 | 2 | SMSTOT    | Soil Moisture content [kg/m^2]           |  3 |  0 |
+  2 | 3 | 4 | TMN       | Ground Reservoir Temperature             |  1 |  0 |
+  2 | 3 |192| SOILW     | Volumetric soil moisture [fraction]      |  4 |  0 |
+  2 | 3 |193| SOILL     | Liquid volumetric soil moisture[fraction]|  4 |  0 |
+  2 | 3 |194| SMSTAV    | Moisture availability [%]                |  4 |  0 |
+  2 | 3 |195| IVGTYP    | Vegetation type                          |  1 |  0 |
+  2 | 3 |196| SOILCAT   | Soil Category                            |  1 |  0 |
+  2 | 3 |197| VEGCAT    | Vegetation Category                      |  1 |  0 |
+  2 | 3 |198| SH2O      | Soil liquid water [m^3/m^3]              |  3 |  0 |
+  2 | 3 |199| SMOIS     | Soil moisture     [m^3/m^3]              |  3 |  0 |
+  2 | 3 |200| SNOALB    | Annual MAX snow albedor in fraction      |  4 |  0 |
+  2 | 3 |201| SMFR3D    | Soil Ice                                 |  2 |  0 |
+  2 | 3 |202|KEEPFR3DFLAG| Flag - 1. Forzen Soil Yes, 0 - NO       |  1 |  0 |
+  2 | 3 |203| CAPG      | Heat capacity for soil [j /(K m^3)]      |  0 |  0 |
+ 10 | 2 | 0 | XICE      | Ice Concentration [fraction]             |  1 |  0 |
+ 10 | 3 | 0 | SST       | Temperature                              |  2 |  0 |
+#
+# Ind | center | subcenter | Master Tbl Version | Local Tbl Version |
+#-----+--------+-----------+--------------------+-------------------+
+  -1  |    252 |       255 |                  1 |                 1 |
+#
+# Another table could go here.
+#
Index: trunk/WRF.COMMON/WRFV2/run/gribmap.txt
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/gribmap.txt	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/gribmap.txt	(revision 2744)
@@ -0,0 +1,1799 @@
+-1:255:255:2
+0:var0:undefined::
+1:PRES:Pressure [Pa]:P,PSFC:2
+2:PRMSL:Pressure reduced to MSL [Pa]:PMSL:2
+3:PTEND:Pressure tendency [Pa/s]::
+4:PVORT:Pot. vorticity [km^2/kg/s]::
+5:ICAHT:ICAO Standard Atmosphere Reference Height [M]::
+6:GP:Geopotential [m^2/s^2]:PHP:3
+7:HGT:Geopotential height [gpm]:SOILHGT:2
+8:DIST:Geometric height [m]:HGT:4
+9:HSTDV:Std dev of height [m]::
+10:TOZNE:Total ozone [Dobson]::
+11:TMP:Temp. [K]:T2,TSK,SKINTEMP:2
+12:VTMP:Virtual temp. [K]::
+13:POT:Potential temp. [K]:TH2,THZ0,T:4
+14:EPOT:Pseudo-adiabatic pot. temp. [K]::
+15:TMAX:Max. temp. [K]::
+16:TMIN:Min. temp. [K]::
+17:DPT:Dew point temp. [K]::
+18:DEPR:Dew point depression [K]::
+19:LAPR:Lapse rate [K/m]::
+20:VIS:Visibility [m]::
+21:RDSP1:Radar spectra (1) [non-dim]::
+22:RDSP2:Radar spectra (2) [non-dim]::
+23:RDSP3:Radar spectra (3) [non-dim]::
+24:PLI:Parcel lifted index (to 500 hPa) [K]::
+25:TMPA:Temp. anomaly [K]::
+26:PRESA:Pressure anomaly [Pa]::
+27:GPA:Geopotential height anomaly [gpm]::
+28:WVSP1:Wave spectra (1) [non-dim]::
+29:WVSP2:Wave spectra (2) [non-dim]::
+30:WVSP3:Wave spectra (3) [non-dim]::
+31:WDIR:Wind direction [deg]::
+32:WIND:Wind speed [m/s]::
+33:UGRD:u wind [m/s]:U,U10,UZ0:3
+34:VGRD:v wind [m/s]:V,V10,VZ0:3
+35:STRM:Stream function [m^2/s]::
+36:VPOT:Velocity potential [m^2/s]::
+37:MNTSF:Montgomery stream function [m^2/s^2]::
+38:SGCVV:Sigma coord. vertical velocity [/s]:WW:5
+39:VVEL:Pressure vertical velocity [Pa/s]::
+40:DZDT:Geometric vertical velocity [m/s]:W:5
+41:ABSV:Absolute vorticity [/s]::
+42:ABSD:Absolute divergence [/s]::
+43:RELV:Relative vorticity [/s]::
+44:RELD:Relative divergence [/s]::
+45:VUCSH:Vertical u shear [/s]::
+46:VVCSH:Vertical v shear [/s]::
+47:DIRC:Direction of current [deg]::
+48:SPC:Speed of current [m/s]::
+49:UOGRD:u of current [m/s]::
+50:VOGRD:v of current [m/s]::
+51:SPFH:Specific humidity [kg/kg]:QSFC:5
+52:RH:Relative humidity [%]::
+53:MIXR:Humidity mixing ratio [kg/kg]:QVAPOR,Q2,QVG:6
+54:PWAT:Precipitable water [kg/m^2]::
+55:VAPP:Vapor pressure [Pa]::
+56:SATD:Saturation deficit [Pa]::
+57:EVP:Evaporation [kg/m^2]:SFCEVP:3
+58:CICE:Cloud Ice [kg/m^2]::
+59:PRATE:Precipitation rate [kg/m^2/s]::
+60:TSTM:Thunderstorm probability [%]::
+61:APCP:Total precipitation [kg/m^2]::
+62:NCPCP:Large scale precipitation [kg/m^2]:NCPCP:2
+63:ACPCP:Convective precipitation [kg/m^2]:ACPCP:2
+64:SRWEQ:Snowfall rate water equiv. [kg/m^2/s]::
+65:WEASD:Accum. snow [kg/m^2]:WEASD:2
+66:SNOD:Snow depth [m]:SNOWH:4
+67:MIXHT:Mixed layer depth [m]::
+68:TTHDP:Transient thermocline depth [m]::
+69:MTHD:Main thermocline depth [m]::
+70:MTHA:Main thermocline anomaly [m]::
+71:TCDC:Total cloud cover [%]:CLDFRA:2
+72:CDCON:Convective cloud cover [%]::
+73:LCDC:Low level cloud cover [%]::
+74:MCDC:Mid level cloud cover [%]::
+75:HCDC:High level cloud cover [%]::
+76:CWAT:Cloud water [kg/m^2]::
+77:BLI:Best lifted index (to 500 hPa) [K]::
+78:SNOC:Convective snow [kg/m^2]::
+79:SNOL:Large scale snow [kg/m^2]::
+80:WTMP:Water temp. [K]:SST:2
+81:LAND:Land cover (land=1;sea=0) [fraction]:LANDMASK:1
+82:DSLM:Deviation of sea level from mean [m]::
+83:SFCR:Surface roughness [m]:ZNT:6
+84:ALBDO:Albedo [%]:ALBEDO:2
+85:TSOIL:Soil temp. [K]:TSLB:2
+86:SOILM:Soil moisture content [kg/m^2]:SMSTOT:2
+87:VEG:Vegetation [%]:VEGFRA:2
+88:SALTY:Salinity [kg/kg]::
+89:DEN:Density [kg/m^3]::
+90:WATR:Water runoff [kg/m^2]::
+91:ICEC:Ice concentration (ice=1;no ice=0) [fraction]:XICE:1
+92:ICETK:Ice thickness [m]::
+93:DICED:Direction of ice drift [deg]::
+94:SICED:Speed of ice drift [m/s]::
+95:UICE:u of ice drift [m/s]::
+96:VICE:v of ice drift [m/s]::
+97:ICEG:Ice growth rate [m/s]::
+98:ICED:Ice divergence [/s]::
+99:SNOM:Snow melt [kg/m^2]::
+100:HTSGW:Sig height of wind waves and swell [m]::
+101:WVDIR:Direction of wind waves [deg]::
+102:WVHGT:Sig height of wind waves [m]::
+103:WVPER:Mean period of wind waves [s]::
+104:SWDIR:Direction of swell waves [deg]::
+105:SWELL:Sig height of swell waves [m]::
+106:SWPER:Mean period of swell waves [s]::
+107:DIRPW:Primary wave direction [deg]::
+108:PERPW:Primary wave mean period [s]::
+109:DIRSW:Secondary wave direction [deg]::
+110:PERSW:Secondary wave mean period [s]::
+111:NSWRS:Net short wave (surface) [W/m^2]::
+112:NLWRS:Net long wave (surface) [W/m^2]::
+113:NSWRT:Net short wave (top) [W/m^2]::
+114:NLWRT:Net long wave (top) [W/m^2]::
+115:LWAVR:Long wave [W/m^2]::
+116:SWAVR:Short wave [W/m^2]::
+117:GRAD:Global radiation [W/m^2]::
+118:BRTMP:Brightness temperature [K]::
+119:LWRAD:Radiance with respect to wave no. [W/m/sr]::
+120:SWRAD:Radiance with respect ot wave len. [W/m^3/sr]::
+121:LHTFL:Latent heat flux [W/m^2]:LH:4
+122:SHTFL:Sensible heat flux [W/m^2]::
+123:BLYDP:Boundary layer dissipation [W/m^2]::
+124:UFLX:Zonal momentum flux [N/m^2]::
+125:VFLX:Meridional momentum flux [N/m^2]::
+126:WMIXE:Wind mixing energy [J]::
+127:IMGD:Image data []::
+128:MSLSA:Mean sea level pressure (Std Atm) [Pa]::
+129:MSLMA:Mean sea level pressure (MAPS) [Pa]::
+130:LU_INDEX:Land Use Category:LU_INDEX:1
+131:DN:DNW values [dimensionless]:DNW:4
+132:SOILW:Volumetric soil moisture [fraction]:SMOIS:4
+133:XLAND:Land cover (land=1;sea=0) [fraction]:XLAND:1
+134:ZNW:Eta values [dimensionless]:ZNW:4
+135:GP_BASE:Base-state geopotential [m^2/s^2]:PHB:3
+136:GP_PERT:Perturbation geopotential [m^2/s^2]:PH:4
+137:CFN:CFN from WRF [?]:CFN:3
+138:CFN:CFN1 from WRF [?]:CFN1:3
+139:MU_BASE:Base-state dry air mass in column [Pa]:MUB:2
+140:MU_PERT:Perturbation dry air mass in column [Pa]:MU:2
+141:MU_INIT:Initial dry air mass in column [Pa]:MU0:2
+142:P_BASE:Base-state pressure [Pa]:PB:2
+143:DN:DN values [dimensionless]:DN:4
+144:SOILW:Volumetric soil moisture [fraction]:SMOIS:4
+145:RDNW:Inverse DNW values [dimensionless]:RDNW:3
+146:RDN:Inverse DN values [dimensionless]:RDN:3
+147:FNP:Lower weight for vertical stretching [dimensionless]:FNP:3
+148:FNM:Upper weight for vertical stretching [dimensionless]:FNM:3
+149:ZNU:Eta values [dimensionless]:ZNU:4
+150:ZETATOP:ZETA at model top [dimensionless]:ZETATOP:3
+151:PTOP:Pressure at model top [Pa]:P_TOP:3
+152:TIMESTEP:Timestep number:ITIMESTEP:3
+153:CLWMR:Cloud water [kg/kg]:QCLOUD,QCG:8
+154:var154:undefined::
+155:GFLUX:Ground heat flux [W/m^2]:HFX:4
+156:RAINBL:Acc. precip. over Boundary Layer time step [kg/m^2]:RAINBL:2
+157:var157:undefined::
+158:TKE:Turbulent kinetic energy [J/kg]:TKE:3
+159:TKE_MYJ:MYJ Turbulent kinetic energy [J/kg]:TKE_MYJ:3
+160:SOILL:Liquid volumetric soil moisture (non-frozen) [fraction]:SH2O:6
+161:var157:undefined::
+162:var157:undefined::
+163:var157:undefined::
+164:var157:undefined::
+165:var157:undefined::
+166:var157:undefined::
+167:var157:undefined::
+168:var157:undefined::
+169:var157:undefined::
+170:RWMR:Rain water mixing ratio [kg/kg]:QRAIN:5
+171:SNMR:Snow mixing ratio [kg/kg]:QSNOW:5
+172:RESM:Time weight constant for small steps:RESM:3
+173:RDX:Inverse X Grid Length [1/km]:RDX:9
+174:RDY:Inverse Y Grid Length [1/km]:RDY:9
+175:MLYNO:Model layer number (from bottom up) [non-dim]:NEST_POS:
+176:NLAT:Latitude (-90 to +90) [deg]:XLAT:4
+177:ELON:East longitude (0-360) [deg]:XLONG:4
+178:ICMR:Ice mixing ratio [kg/kg]:QICE:5
+179:GRMR:Graupel mixing ratio:QGRAUP:5
+180:QNI:Ice Crystal Number Concentration:QNI:0
+181:ZS:Depth of soil layer (midpoint) [m]:ZS:3
+182:DZS:Thickness of soil layer [m]:DZS:3
+183:SINALPHA:Local sine of map rotation:SINALPHA:4
+184:COSALPHA:Local cosine of map rotation:COSALPHA:4
+185:TURB:Turbulence SIGMET/AIRMET [non-dim]::
+186:EPSTS:EPSTS in WRF [?]:EPSTS:3
+187:var187:undefined::
+188:AKMS:Surface Exchange for Momentum [m/s]:AKMS:3
+189:MAPFAC_M:Map Scale Factor [dimensionless]:MAPFAC_M:7
+190:MAPFAC_U:Map Scale Factor [dimensionless]:MAPFAC_U:7
+191:MAPFAC_V:Map Scale Factor [dimensionless]:MAPFAC_V:7
+192:GRDFLX:Ground Heat Flux [W m-2]:GRDFLX:3
+193:RMOL:Reciprical of Monin-Ohukhov length:RMOL:4
+194:var194:undefined::
+195:var195:undefined::
+196:var196:undefined::
+197:var197:undefined::
+198:var198:undefined::
+199:var199:undefined::
+200:var200:undefined::
+201:var201:undefined::
+202:SNOWCU:Cumulative Snow [cm]:SNOWCU,ACSNOW:2
+203:ACSNOM:Accumulated Melted Snow [cm]:ACSNOM:2
+204:DSWRF:Downward short wave flux [W/m^2]:SWDOWN:3
+205:DLWRF:Downward long wave flux [W/m^2]:GLW:3
+206:GSW:Net short wave flux [w/m^2]:GSW:3
+207:MSTAV:Moisture availability [%]:SMSTAV:4
+208:SFEXC:Exchange coefficient [m/s]:SFCEXC:5
+209:AKHS:Exchange coefficient for heat [m/s]:AKHS:5
+210:SOILCAT:Soil Category:SOILCAT:1
+211:VEGCAT:Vegetation Categore:VEGCAT:1
+212:TOPOSTDV:Standard Deviation of Topography:TOPOSTDV:3
+213:TOPOSLPX:Sub-gridscale mean topographic slope in x-direction:TOPOSLPX:6
+214:TOPOSLPY:Sub-gridscale mean topographic slope in y-direction:TOPOSLPY:6
+215:SLOPECAT:Topographical Categorical Slope:SLOPECAT:1
+216:LANDUSEF:Land use categorical fraction on mass grid:LANDUSEF:3
+217:SOILCTOP:Top layer soil type as a categorical fraction:SOILCTOP:3
+218:SOILCBOT:Top layer soil type as a categorical fraction:SOILCBOT:3
+219:var219:undefined::
+220:var220:undefined::
+221:HPBL:Planetary boundary layer height [m]:PBLH:2
+222:var222:undefined::
+223:CNWAT:Plant canopy surface water [kg/m^2]:CANWAT:8
+224:SOTYP:Soil type (Zobler) [0..9]:ISLTYP:0
+225:VGTYP:Vegetation type (as in SiB) [0..13]:IVGTYP:1
+226:var226:undefined::
+227:CSLAT:Coriolis sine latitude term:F:6
+228:CCLAT:Coriolis cosine latitude term:E:6
+229:CF1:Second-order extrapolation constant 1:CF1:5
+230:CF2:Second-order extrapolation constant 2:CF2:5
+231:CF3:Second-order extrapolation constant 3:CF3:5
+232:var232:undefined::
+233:var233:undefined::
+234:BGRUN:Baseflow-groundwater runoff [kg/m^2]:UDROFF:4
+235:SSRUN:Storm surface runoff [kg/m^2]:SFROFF:4
+236:SNOW:Snow Water Equivalent [kg/m^2]:SNOW:2
+237:var237:undefined::
+238:SNOWC:Snow cover [%]:SNOWC:1
+239:var239:undefined::
+240:QFX:Upward moisture flux [kg/(m^s)]:QFX:8
+241:var241:undefined::
+242:var242:undefined::
+243:var243:undefined::
+244:var244:undefined::
+245:var245:undefined::
+246:var246:undefined::
+247:NPRATE:Non-convective Precip Rate[kg/m^2/s]:RAINNCV:7
+248:CPRATE:Convective Precip Rate[kg/m^2/s]:RAINCV:7 
+249:TMN:Ground Reservoir Temperature [K]:TMN:3
+250:var250:undefined::
+251:var251:undefined::
+252:var252:undefined::
+253:TNCPCP:Cumulative Large scale precipitation [kg/m^2]:RAINNC:3
+254:TACPCP:Cumulative Convective precipitation [kg/m^2]:RAINC:3
+255:var255:undefined::
+-1:255:255:3
+0:var0:undefined::
+1:PRES:Pressure [Pa]::
+2:PRMSL:Pressure reduced to MSL [Pa]::
+3:PTEND:Pressure tendency [Pa/s]::
+4:PVORT:Pot. vorticity [km^2/kg/s]::
+5:ICAHT:ICAO Standard Atmosphere Reference Height [M]::
+6:GP:Geopotential [m^2/s^2]::
+7:HGT:Geopotential height [gpm]::
+8:DIST:Geometric height [m]::
+9:HSTDV:Std dev of height [m]::
+10:TOZNE:Total ozone [Dobson]::
+11:TMP:Temp. [K]::
+12:VTMP:Virtual temp. [K]::
+13:POT:Potential temp. [K]::
+14:EPOT:Pseudo-adiabatic pot. temp. [K]::
+15:TMAX:Max. temp. [K]::
+16:TMIN:Min. temp. [K]::
+17:DPT:Dew point temp. [K]::
+18:DEPR:Dew point depression [K]::
+19:LAPR:Lapse rate [K/m]::
+20:VIS:Visibility [m]::
+21:RDSP1:Radar spectra (1) [non-dim]::
+22:RDSP2:Radar spectra (2) [non-dim]::
+23:RDSP3:Radar spectra (3) [non-dim]::
+24:PLI:Parcel lifted index (to 500 hPa) [K]::
+25:TMPA:Temp. anomaly [K]::
+26:PRESA:Pressure anomaly [Pa]::
+27:GPA:Geopotential height anomaly [gpm]::
+28:WVSP1:Wave spectra (1) [non-dim]::
+29:WVSP2:Wave spectra (2) [non-dim]::
+30:WVSP3:Wave spectra (3) [non-dim]::
+31:WDIR:Wind direction [deg]::
+32:WIND:Wind speed [m/s]::
+33:UGRD:u wind [m/s]::
+34:VGRD:v wind [m/s]::
+35:STRM:Stream function [m^2/s]::
+36:VPOT:Velocity potential [m^2/s]::
+37:MNTSF:Montgomery stream function [m^2/s^2]::
+38:SGCVV:Sigma coord. vertical velocity [/s]::
+39:VVEL:Pressure vertical velocity [Pa/s]::
+40:DZDT:Geometric vertical velocity [m/s]::
+41:ABSV:Absolute vorticity [/s]::
+42:ABSD:Absolute divergence [/s]::
+43:RELV:Relative vorticity [/s]::
+44:RELD:Relative divergence [/s]::
+45:VUCSH:Vertical u shear [/s]::
+46:VVCSH:Vertical v shear [/s]::
+47:DIRC:Direction of current [deg]::
+48:SPC:Speed of current [m/s]::
+49:UOGRD:u of current [m/s]::
+50:VOGRD:v of current [m/s]::
+51:SPFH:Specific humidity [kg/kg]::
+52:RH:Relative humidity [%]::
+53:MIXR:Humidity mixing ratio [kg/kg]::
+54:PWAT:Precipitable water [kg/m^2]::
+55:VAPP:Vapor pressure [Pa]::
+56:SATD:Saturation deficit [Pa]::
+57:EVP:Evaporation [kg/m^2]::
+58:CICE:Cloud Ice [kg/m^2]::
+59:PRATE:Precipitation rate [kg/m^2/s]::
+60:TSTM:Thunderstorm probability [%]::
+61:APCP:Total precipitation [kg/m^2]::
+62:NCPCP:Large scale precipitation [kg/m^2]::
+63:ACPCP:Convective precipitation [kg/m^2]::
+64:SRWEQ:Snowfall rate water equiv. [kg/m^2/s]::
+65:WEASD:Accum. snow [kg/m^2]::
+66:SNOD:Snow depth [m]::
+67:MIXHT:Mixed layer depth [m]::
+68:TTHDP:Transient thermocline depth [m]::
+69:MTHD:Main thermocline depth [m]::
+70:MTHA:Main thermocline anomaly [m]::
+71:TCDC:Total cloud cover [%]::
+72:CDCON:Convective cloud cover [%]::
+73:LCDC:Low level cloud cover [%]::
+74:MCDC:Mid level cloud cover [%]::
+75:HCDC:High level cloud cover [%]::
+76:CWAT:Cloud water [kg/m^2]::
+77:BLI:Best lifted index (to 500 hPa) [K]::
+78:SNOC:Convective snow [kg/m^2]::
+79:SNOL:Large scale snow [kg/m^2]::
+80:WTMP:Water temp. [K]::
+81:LAND:Land cover (land=1;sea=0) [fraction]::
+82:DSLM:Deviation of sea level from mean [m]::
+83:SFCR:Surface roughness [m]::
+84:ALBDO:Albedo [%]::
+85:TSOIL:Soil temp. [K]::
+86:SOILM:Soil moisture content [kg/m^2]::
+87:VEG:Vegetation [%]::
+88:SALTY:Salinity [kg/kg]::
+89:DEN:Density [kg/m^3]::
+90:WATR:Water runoff [kg/m^2]::
+91:ICEC:Ice concentration (ice=1;no ice=0) [fraction]::
+92:ICETK:Ice thickness [m]::
+93:DICED:Direction of ice drift [deg]::
+94:SICED:Speed of ice drift [m/s]::
+95:UICE:u of ice drift [m/s]::
+96:VICE:v of ice drift [m/s]::
+97:ICEG:Ice growth rate [m/s]::
+98:ICED:Ice divergence [/s]::
+99:SNOM:Snow melt [kg/m^2]::
+100:HTSGW:Sig height of wind waves and swell [m]::
+101:WVDIR:Direction of wind waves [deg]::
+102:WVHGT:Sig height of wind waves [m]::
+103:WVPER:Mean period of wind waves [s]::
+104:SWDIR:Direction of swell waves [deg]::
+105:SWELL:Sig height of swell waves [m]::
+106:SWPER:Mean period of swell waves [s]::
+107:DIRPW:Primary wave direction [deg]::
+108:PERPW:Primary wave mean period [s]::
+109:DIRSW:Secondary wave direction [deg]::
+110:PERSW:Secondary wave mean period [s]::
+111:NSWRS:Net short wave (surface) [W/m^2]::
+112:NLWRS:Net long wave (surface) [W/m^2]::
+113:NSWRT:Net short wave (top) [W/m^2]::
+114:NLWRT:Net long wave (top) [W/m^2]::
+115:LWAVR:Long wave [W/m^2]::
+116:SWAVR:Short wave [W/m^2]::
+117:GRAD:Global radiation [W/m^2]::
+118:BRTMP:Brightness temperature [K]::
+119:LWRAD:Radiance with respect to wave no. [W/m/sr]::
+120:SWRAD:Radiance with respect ot wave len. [W/m^3/sr]::
+121:LHTFL:Latent heat flux [W/m^2]::
+122:SHTFL:Sensible heat flux [W/m^2]::
+123:BLYDP:Boundary layer dissipation [W/m^2]::
+124:UFLX:Zonal momentum flux [N/m^2]::
+125:VFLX:Meridional momentum flux [N/m^2]::
+126:WMIXE:Wind mixing energy [J]::
+127:IMGD:Image data []::
+128:STEP_NUMBER::STEP_NUMBER:1
+129:DTS:Small Timestep:DTS:1
+130:DTSEPS:Time Weight Constant for Small Steps:DTSEPS:1
+131:FCX:Relaxation Term for Boundary Zone:FCX:5
+132:GCX:Second relaxation term for boundary Zone:GCX:5
+133:DTBC:Time since boundary read:DTBC:1
+134:SHDMAX:Annual MAX veg fraction:SHDMAX:4
+135:SHDMIN:Annual MIN veg fraction:SHDMIN:4
+136:SNOALB:Annual MAX snow albedor in fraction:SNOALB:4
+137:FNDSNOWH::FNDSNOWH:1
+138:TOTSWDN:Radiation State Variable:TOTSWDN:4
+139:TOTLWDN:Radiation State Variable:TOTLWDN:4
+140:RSWTOA:Radiation State Variable:RSWTOA:4
+141:RLWTOA:Radiation State Variable:RLWTOA:4
+142:CZMEAN:Radiation State Variable:CZMEAN:4
+143:CFRACL:Radiation State Variable:CFRACL:4
+144:CFRACM:Radiation State Variable:CFRACM:4
+145:CFRACH:Radiation State Variable:CFRACH:4
+146:ACFRST:Radiation State Variable:ACFRST:4
+147:NCFRST:Radiation State Variable:NCFRST:4
+148:ACFRCV:Radiation State Variable:ACFRCV:4
+149:NCFRCV:Radiation State Variable:NCFRCV:4
+150:FNDSOILW::FNDSOILW:1
+151:U_FRAME:FRAME X WIND [m/s]:U_FRAME:4
+152:V_FRAME:FRAME Y WIND [m/s]:V_FRAME:4
+153:ALBBCK:Background Albedo:ALBBCK:4
+154:U_BASE:Base State X Wind in Idealized Cases:U_BASE:3
+155:V_BASE:Base State Y Wind in Idealized Cases:V_BASE:3
+156:QV_BASE:Base State QV in Idealized Cases:QV_BASE:5
+157:Z_BASE:Base State Height in Idealized Cases:Z_BASE:5
+158:T_BASE:Base State T in Idealized Cases:T_BASE:2
+159:var159:undefined::
+160:TSOIL1:Soil temp. 0-10 cm [K]:ST000010:2
+161:TSOIL2:Soil temp. 10-40 cm [K]:ST010040:2
+162:TSOIL3:Soil temp. 40-100 cm [K]:ST040100:2
+163:TSOIL4:Soil temp. 100-200 cm [K]:ST100200:2
+164:SOILM1:Soil moisture content 0-10 cm [kg/m^2]:SM000010:2
+165:SOILM2:Soil moisture content 10-40 cm [kg/m^2]:SM010040:2
+166:SOILM3:Soil moisture content 40-100 cm [kg/m^2]:SM040100:2
+167:SOILM4:Soil moisture content 100-200 cm [kg/m^2]:SM100200:2
+168:var168:undefined::
+169:var169:undefined::
+170:var170:undefined::
+171:var171:undefined::
+172:var172:undefined::
+173:var173:undefined::
+174:var174:undefined::
+175:var175:undefined::
+176:var176:undefined::
+177:var177:undefined::
+178:var178:undefined::
+179:var179:undefined::
+180:var180:undefined::
+181:var181:undefined::
+182:var182:undefined::
+183:var183:undefined::
+184:var184:undefined::
+185:var185:undefined::
+186:var186:undefined::
+187:var187:undefined::
+188:var188:undefined::
+189:var189:undefined::
+190:var190:undefined::
+191:var191:undefined::
+192:var192:undefined::
+193:var193:undefined::
+194:var194:undefined::
+195:var195:undefined::
+196:var196:undefined::
+197:var197:undefined::
+198:var198:undefined::
+199:var199:undefined::
+200:var200:undefined::
+201:var201:undefined::
+202:var202:undefined::
+203:var203:undefined::
+204:var204:undefined::
+205:var205:undefined::
+206:var206:undefined::
+207:var207:undefined::
+208:var208:undefined::
+209:var209:undefined::
+210:var210:undefined::
+211:var211:undefined::
+212:var212:undefined::
+213:var213:undefined::
+214:var214:undefined::
+215:var215:undefined::
+216:var216:undefined::
+217:var217:undefined::
+218:var218:undefined::
+219:var219:undefined::
+220:var220:undefined::
+221:var221:undefined::
+222:var222:undefined::
+223:LAT_LL_T:Lower Left Latitude of temp point [deg]:LAT_LL_T:4
+224:LAT_UL_T:Lower Left Latitude of temp point [deg]:LAT_UL_T:4
+225:LAT_UR_T:Lower Left Latitude of temp point [deg]:LAT_UR_T:4
+226:LAT_LR_T:Lower Left Latitude of temp point [deg]:LAT_LR_T:4
+227:LAT_LL_U:Lower Left Latitude of u point [deg]:LAT_LL_U:4
+228:LAT_UL_U:Lower Left Latitude of u point [deg]:LAT_UL_U:4
+229:LAT_UR_U:Lower Left Latitude of u point [deg]:LAT_UR_U:4
+230:LAT_LR_U:Lower Left Latitude of u point [deg]:LAT_LR_U:4
+231:LAT_LL_V:Lower Left Latitude of v point [deg]:LAT_LL_V:4
+232:LAT_UL_V:Lower Left Latitude of v point [deg]:LAT_UL_V:4
+233:LAT_UR_V:Lower Left Latitude of v point [deg]:LAT_UR_V:4
+234:LAT_LR_V:Lower Left Latitude of v point [deg]:LAT_LR_V:4
+235:LAT_LL_D:Lower Left Latitude of massless point [deg]:LAT_LL_D:4
+236:LAT_UL_D:Lower Left Latitude of massless point [deg]:LAT_UL_D:4
+237:LAT_UR_D:Lower Left Latitude of massless point [deg]:LAT_UR_D:4
+238:LAT_LR_D:Lower Left Latitude of massless point [deg]:LAT_LR_D:4
+239:LON_LL_T:Lower Left Longitude of temp point [deg]:LON_LL_T:4
+240:LON_UL_T:Lower Left Longitude of temp point [deg]:LON_UL_T:4
+241:LON_UR_T:Lower Left Longitude of temp point [deg]:LON_UR_T:4
+242:LON_LR_T:Lower Left Longitude of temp point [deg]:LON_LR_T:4
+243:LON_LL_U:Lower Left Longitude of u point [deg]:LON_LL_U:4
+244:LON_UL_U:Lower Left Longitude of u point [deg]:LON_UL_U:4
+245:LON_UR_U:Lower Left Longitude of u point [deg]:LON_UR_U:4
+246:LON_LR_U:Lower Left Longitude of u point [deg]:LON_LR_U:4
+247:LON_LL_V:Lower Left Longitude of v point [deg]:LON_LL_V:4
+248:LON_UL_V:Lower Left Longitude of v point [deg]:LON_UL_V:4
+249:LON_UR_V:Lower Left Longitude of v point [deg]:LON_UR_V:4
+250:LON_LR_V:Lower Left Longitude of v point [deg]:LON_LR_V:4
+251:LON_LL_D:Lower Left Longitude of massless point [deg]:LON_LL_D:4
+252:LON_UL_D:Lower Left Longitude of massless point [deg]:LON_UL_D:4
+253:LON_UR_D:Lower Left Longitude of massless point [deg]:LON_UR_D:4
+254:LON_LR_D:Lower Left Longitude of massless point [deg]:LON_LR_D:4
+255:var255:undefined::
+-1:255:255:4
+0:var0:undefined::
+1:PRES:Pressure [Pa]::
+2:PRMSL:Pressure reduced to MSL [Pa]::
+3:PTEND:Pressure tendency [Pa/s]::
+4:PVORT:Pot. vorticity [km^2/kg/s]::
+5:ICAHT:ICAO Standard Atmosphere Reference Height [M]::
+6:GP:Geopotential [m^2/s^2]::
+7:HGT:Geopotential height [gpm]::
+8:DIST:Geometric height [m]::
+9:HSTDV:Std dev of height [m]::
+10:TOZNE:Total ozone [Dobson]::
+11:TMP:Temp. [K]::
+12:VTMP:Virtual temp. [K]::
+13:POT:Potential temp. [K]::
+14:EPOT:Pseudo-adiabatic pot. temp. [K]::
+15:TMAX:Max. temp. [K]::
+16:TMIN:Min. temp. [K]::
+17:DPT:Dew point temp. [K]::
+18:DEPR:Dew point depression [K]::
+19:LAPR:Lapse rate [K/m]::
+20:VIS:Visibility [m]::
+21:RDSP1:Radar spectra (1) [non-dim]::
+22:RDSP2:Radar spectra (2) [non-dim]::
+23:RDSP3:Radar spectra (3) [non-dim]::
+24:PLI:Parcel lifted index (to 500 hPa) [K]::
+25:TMPA:Temp. anomaly [K]::
+26:PRESA:Pressure anomaly [Pa]::
+27:GPA:Geopotential height anomaly [gpm]::
+28:WVSP1:Wave spectra (1) [non-dim]::
+29:WVSP2:Wave spectra (2) [non-dim]::
+30:WVSP3:Wave spectra (3) [non-dim]::
+31:WDIR:Wind direction [deg]::
+32:WIND:Wind speed [m/s]::
+33:UGRD:u wind [m/s]::
+34:VGRD:v wind [m/s]::
+35:STRM:Stream function [m^2/s]::
+36:VPOT:Velocity potential [m^2/s]::
+37:MNTSF:Montgomery stream function [m^2/s^2]::
+38:SGCVV:Sigma coord. vertical velocity [/s]::
+39:VVEL:Pressure vertical velocity [Pa/s]::
+40:DZDT:Geometric vertical velocity [m/s]::
+41:ABSV:Absolute vorticity [/s]::
+42:ABSD:Absolute divergence [/s]::
+43:RELV:Relative vorticity [/s]::
+44:RELD:Relative divergence [/s]::
+45:VUCSH:Vertical u shear [/s]::
+46:VVCSH:Vertical v shear [/s]::
+47:DIRC:Direction of current [deg]::
+48:SPC:Speed of current [m/s]::
+49:UOGRD:u of current [m/s]::
+50:VOGRD:v of current [m/s]::
+51:SPFH:Specific humidity [kg/kg]::
+52:RH:Relative humidity [%]::
+53:MIXR:Humidity mixing ratio [kg/kg]::
+54:PWAT:Precipitable water [kg/m^2]::
+55:VAPP:Vapor pressure [Pa]::
+56:SATD:Saturation deficit [Pa]::
+57:EVP:Evaporation [kg/m^2]::
+58:CICE:Cloud Ice [kg/m^2]::
+59:PRATE:Precipitation rate [kg/m^2/s]::
+60:TSTM:Thunderstorm probability [%]::
+61:APCP:Total precipitation [kg/m^2]::
+62:NCPCP:Large scale precipitation [kg/m^2]::
+63:ACPCP:Convective precipitation [kg/m^2]::
+64:SRWEQ:Snowfall rate water equiv. [kg/m^2/s]::
+65:WEASD:Accum. snow [kg/m^2]::
+66:SNOD:Snow depth [m]::
+67:MIXHT:Mixed layer depth [m]::
+68:TTHDP:Transient thermocline depth [m]::
+69:MTHD:Main thermocline depth [m]::
+70:MTHA:Main thermocline anomaly [m]::
+71:TCDC:Total cloud cover [%]::
+72:CDCON:Convective cloud cover [%]::
+73:LCDC:Low level cloud cover [%]::
+74:MCDC:Mid level cloud cover [%]::
+75:HCDC:High level cloud cover [%]::
+76:CWAT:Cloud water [kg/m^2]::
+77:BLI:Best lifted index (to 500 hPa) [K]::
+78:SNOC:Convective snow [kg/m^2]::
+79:SNOL:Large scale snow [kg/m^2]::
+80:WTMP:Water temp. [K]::
+81:LAND:Land cover (land=1;sea=0) [fraction]::
+82:DSLM:Deviation of sea level from mean [m]::
+83:SFCR:Surface roughness [m]::
+84:ALBDO:Albedo [%]::
+85:TSOIL:Soil temp. [K]::
+86:SOILM:Soil moisture content [kg/m^2]::
+87:VEG:Vegetation [%]::
+88:SALTY:Salinity [kg/kg]::
+89:DEN:Density [kg/m^3]::
+90:WATR:Water runoff [kg/m^2]::
+91:ICEC:Ice concentration (ice=1;no ice=0) [fraction]::
+92:ICETK:Ice thickness [m]::
+93:DICED:Direction of ice drift [deg]::
+94:SICED:Speed of ice drift [m/s]::
+95:UICE:u of ice drift [m/s]::
+96:VICE:v of ice drift [m/s]::
+97:ICEG:Ice growth rate [m/s]::
+98:ICED:Ice divergence [/s]::
+99:SNOM:Snow melt [kg/m^2]::
+100:HTSGW:Sig height of wind waves and swell [m]::
+101:WVDIR:Direction of wind waves [deg]::
+102:WVHGT:Sig height of wind waves [m]::
+103:WVPER:Mean period of wind waves [s]::
+104:SWDIR:Direction of swell waves [deg]::
+105:SWELL:Sig height of swell waves [m]::
+106:SWPER:Mean period of swell waves [s]::
+107:DIRPW:Primary wave direction [deg]::
+108:PERPW:Primary wave mean period [s]::
+109:DIRSW:Secondary wave direction [deg]::
+110:PERSW:Secondary wave mean period [s]::
+111:NSWRS:Net short wave (surface) [W/m^2]::
+112:NLWRS:Net long wave (surface) [W/m^2]::
+113:NSWRT:Net short wave (top) [W/m^2]::
+114:NLWRT:Net long wave (top) [W/m^2]::
+115:LWAVR:Long wave [W/m^2]::
+116:SWAVR:Short wave [W/m^2]::
+117:GRAD:Global radiation [W/m^2]::
+118:BRTMP:Brightness temperature [K]::
+119:LWRAD:Radiance with respect to wave no. [W/m/sr]::
+120:SWRAD:Radiance with respect ot wave len. [W/m^3/sr]::
+121:LHTFL:Latent heat flux [W/m^2]::
+122:SHTFL:Sensible heat flux [W/m^2]::
+123:BLYDP:Boundary layer dissipation [W/m^2]::
+124:UFLX:Zonal momentum flux [N/m^2]::
+125:VFLX:Meridional momentum flux [N/m^2]::
+126:WMIXE:Wind mixing energy [J]::
+127:IMGD:Image data []::
+128:RU_BXS::RU_BXS:1
+129:RU_BXE::RU_BXE:1
+130:RU_BYS::RU_BYS:1
+131:RU_BYE::RU_BYE:1
+132:RU_BTXS::RU_BTXS:6
+133:RU_BTXE::RU_BTXE:6
+134:RU_BTYS::RU_BTYS:6
+135:RU_BTYE::RU_BTYE:6
+136:RV_BXS::RV_BXS:1
+137:RV_BXE::RV_BXE:1
+138:RV_BYS::RV_BYS:1
+139:RV_BYE::RV_BYE:1
+140:RV_BTXS::RV_BTXS:6
+141:RV_BTXE::RV_BTXE:6
+142:RV_BTYS::RV_BTYS:6
+143:RV_BTYE::RV_BTYE:6
+144:RW_BXS::RW_BXS:1
+145:RW_BXE::RW_BXE:1
+146:RW_BYS::RW_BYS:1
+147:RW_BYE::RW_BYE:1
+148:RW_BTXS::RW_BTXS:6
+149:RW_BTXE::RW_BTXE:6
+150:RW_BTYS::RW_BTYS:6
+151:RW_BTYE::RW_BTYE:6
+152:PH_BXS::PH_BXS:-1
+153:PH_BXE::PH_BXE:-1
+154:PH_BYS::PH_BYS:-1
+155:PH_BYE::PH_BYE:-1
+156:PH_BTXS::PH_BTXS:4
+157:PH_BTXE::PH_BTXE:4
+158:PH_BTYS::PH_BTYS:4
+159:PH_BTYE::PH_BTYE:4
+160:T_BXS::T_BXS:1
+161:T_BXE::T_BXE:1
+162:T_BYS::T_BYS:1
+163:T_BYE::T_BYE:1
+164:T_BTXS::T_BTXS:6
+165:T_BTXE::T_BTXE:6
+166:T_BTYS::T_BTYS:6
+167:T_BTYE::T_BTYE:6
+168:MU_BXS::MU_BXS:4
+169:MU_BXE::MU_BXE:4
+170:MU_BYS::MU_BYS:4
+171:MU_BYE::MU_BYE:4
+172:MU_BTXS::MU_BTXS:9
+173:MU_BTXE::MU_BTXE:9
+174:MU_BTYS::MU_BTYS:9
+175:MU_BTYE::MU_BTYE:9
+176:RQV_BXS::RQV_BXS:4
+177:RQV_BXE::RQV_BXE:4
+178:RQV_BYS::RQV_BYS:4
+179:RQV_BYE::RQV_BYE:4
+180:RQV_BTXS::RQV_BTXS:10
+181:RQV_BTXE::RQV_BTXE:10
+182:RQV_BTYS::RQV_BTYS:10
+183:RQV_BTYE::RQV_BTYE:10
+184:RQC_BXS::RQC_BXS:4
+185:RQC_BXE::RQC_BXE:4
+186:RQC_BYS::RQC_BYS:4
+187:RQC_BYE::RQC_BYE:4
+188:RQC_BTXS::RQC_BTXS:10
+189:RQC_BTXE::RQC_BTXE:10
+190:RQC_BTYS::RQC_BTYS:10
+191:RQC_BTYE::RQC_BTYE:10
+192:RQR_BXS::RQR_BXS:4
+193:RQR_BXE::RQR_BXE:4
+194:RQR_BYS::RQR_BYS:4
+195:RQR_BYE::RQR_BYE:4
+196:RQR_BTXS::RQR_BTXS:10
+197:RQR_BTXE::RQR_BTXE:10
+198:RQR_BTYS::RQR_BTYS:10
+199:RQR_BTYE::RQR_BTYE:10
+200:RQI_BXS::RQI_BXS:4
+201:RQI_BXE::RQI_BXE:4
+202:RQI_BYS::RQI_BYS:4
+203:RQI_BYE::RQI_BYE:4
+204:RQI_BTXS::RQI_BTXS:10
+205:RQI_BTXE::RQI_BTXE:10
+206:RQI_BTYS::RQI_BTYS:10
+207:RQI_BTYE::RQI_BTYE:10
+208:RQS_BXS::RQS_BXS:4
+209:RQS_BXE::RQS_BXE:4
+210:RQS_BYS::RQS_BYS:4
+211:RQS_BYE::RQS_BYE:4
+212:RQS_BTXS::RQS_BTXS:10
+213:RQS_BTXE::RQS_BTXE:10
+214:RQS_BTYS::RQS_BTYS:10
+215:RQS_BTYE::RQS_BTYE:10
+216:RQG_BXS::RQG_BXS:4
+217:RQG_BXE::RQG_BXE:4
+218:RQG_BYS::RQG_BYS:4
+219:RQG_BYE::RQG_BYE:4
+220:RQG_BTXS::RQG_BTXS:10
+221:RQG_BTXE::RQG_BTXE:10
+222:RQG_BTYS::RQG_BTYS:10
+223:RQG_BTYE::RQG_BTYE:10
+224:QICE_BXS::QICE_BXS:10
+225:QICE_BXE::QICE_BXE:10
+226:QICE_BYS::QICE_BYS:10
+227:QICE_BYE::QICE_BYE:10
+228:QICE_BTXS::QICE_BTXS:4
+229:QICE_BTXE::QICE_BTXE:4
+230:QICE_BTYS::QICE_BTYS:4
+231:QICE_BTYE::QICE_BTYE:4
+232:QSNOW_BTYE::QSNOW_BTYE:2
+233:QSNOW_BXS::QSNOW_BXS:10
+234:QSNOW_BXE::QSNOW_BXE:10
+235:QSNOW_BYS::QSNOW_BYS:10
+236:QSNOW_BYE::QSNOW_BYE:10
+237:QSNOW_BTXS::QSNOW_BTXS:4
+238:QSNOW_BTXE::QSNOW_BTXE:4
+239:QSNOW_BTYS::QSNOW_BTYS:4
+240:QSNOW_BTYE::QSNOW_BTYE:4
+241:QGRAUP_BXS::QGRAUP_BXS:10
+242:QGRAUP_BXE::QGRAUP_BXE:10
+243:QGRAUP_BYS::QGRAUP_BYS:10
+244:QGRAUP_BYE::QGRAUP_BYE:10
+245:QGRAUP_BTXS::QGRAUP_BTXS:4
+246:QGRAUP_BTXE::QGRAUP_BTXE:4
+247:QGRAUP_BTYS::QGRAUP_BTYS:4
+248:QGRAUP_BTYE::QGRAUP_BTYE:4
+249:var249:undefined::
+250:var250:undefined::
+251:var251:undefined::
+252:var252:undefined::
+253:var253:undefined::
+254:var254:undefined::
+255:var255:undefined::
+-1:255:255:5
+0:var0:undefined::
+1:PRES:Pressure [Pa]::
+2:PRMSL:Pressure reduced to MSL [Pa]::
+3:PTEND:Pressure tendency [Pa/s]::
+4:PVORT:Pot. vorticity [km^2/kg/s]::
+5:ICAHT:ICAO Standard Atmosphere Reference Height [M]::
+6:GP:Geopotential [m^2/s^2]::
+7:HGT:Geopotential height [gpm]::
+8:DIST:Geometric height [m]::
+9:HSTDV:Std dev of height [m]::
+10:TOZNE:Total ozone [Dobson]::
+11:TMP:Temp. [K]::
+12:VTMP:Virtual temp. [K]::
+13:POT:Potential temp. [K]::
+14:EPOT:Pseudo-adiabatic pot. temp. [K]::
+15:TMAX:Max. temp. [K]::
+16:TMIN:Min. temp. [K]::
+17:DPT:Dew point temp. [K]::
+18:DEPR:Dew point depression [K]::
+19:LAPR:Lapse rate [K/m]::
+20:VIS:Visibility [m]::
+21:RDSP1:Radar spectra (1) [non-dim]::
+22:RDSP2:Radar spectra (2) [non-dim]::
+23:RDSP3:Radar spectra (3) [non-dim]::
+24:PLI:Parcel lifted index (to 500 hPa) [K]::
+25:TMPA:Temp. anomaly [K]::
+26:PRESA:Pressure anomaly [Pa]::
+27:GPA:Geopotential height anomaly [gpm]::
+28:WVSP1:Wave spectra (1) [non-dim]::
+29:WVSP2:Wave spectra (2) [non-dim]::
+30:WVSP3:Wave spectra (3) [non-dim]::
+31:WDIR:Wind direction [deg]::
+32:WIND:Wind speed [m/s]::
+33:UGRD:u wind [m/s]::
+34:VGRD:v wind [m/s]::
+35:STRM:Stream function [m^2/s]::
+36:VPOT:Velocity potential [m^2/s]::
+37:MNTSF:Montgomery stream function [m^2/s^2]::
+38:SGCVV:Sigma coord. vertical velocity [/s]::
+39:VVEL:Pressure vertical velocity [Pa/s]::
+40:DZDT:Geometric vertical velocity [m/s]::
+41:ABSV:Absolute vorticity [/s]::
+42:ABSD:Absolute divergence [/s]::
+43:RELV:Relative vorticity [/s]::
+44:RELD:Relative divergence [/s]::
+45:VUCSH:Vertical u shear [/s]::
+46:VVCSH:Vertical v shear [/s]::
+47:DIRC:Direction of current [deg]::
+48:SPC:Speed of current [m/s]::
+49:UOGRD:u of current [m/s]::
+50:VOGRD:v of current [m/s]::
+51:SPFH:Specific humidity [kg/kg]::
+52:RH:Relative humidity [%]::
+53:MIXR:Humidity mixing ratio [kg/kg]::
+54:PWAT:Precipitable water [kg/m^2]::
+55:VAPP:Vapor pressure [Pa]::
+56:SATD:Saturation deficit [Pa]::
+57:EVP:Evaporation [kg/m^2]::
+58:CICE:Cloud Ice [kg/m^2]::
+59:PRATE:Precipitation rate [kg/m^2/s]::
+60:TSTM:Thunderstorm probability [%]::
+61:APCP:Total precipitation [kg/m^2]::
+62:NCPCP:Large scale precipitation [kg/m^2]::
+63:ACPCP:Convective precipitation [kg/m^2]::
+64:SRWEQ:Snowfall rate water equiv. [kg/m^2/s]::
+65:WEASD:Accum. snow [kg/m^2]::
+66:SNOD:Snow depth [m]::
+67:MIXHT:Mixed layer depth [m]::
+68:TTHDP:Transient thermocline depth [m]::
+69:MTHD:Main thermocline depth [m]::
+70:MTHA:Main thermocline anomaly [m]::
+71:TCDC:Total cloud cover [%]::
+72:CDCON:Convective cloud cover [%]::
+73:LCDC:Low level cloud cover [%]::
+74:MCDC:Mid level cloud cover [%]::
+75:HCDC:High level cloud cover [%]::
+76:CWAT:Cloud water [kg/m^2]::
+77:BLI:Best lifted index (to 500 hPa) [K]::
+78:SNOC:Convective snow [kg/m^2]::
+79:SNOL:Large scale snow [kg/m^2]::
+80:WTMP:Water temp. [K]::
+81:LAND:Land cover (land=1;sea=0) [fraction]::
+82:DSLM:Deviation of sea level from mean [m]::
+83:SFCR:Surface roughness [m]::
+84:ALBDO:Albedo [%]::
+85:TSOIL:Soil temp. [K]::
+86:SOILM:Soil moisture content [kg/m^2]::
+87:VEG:Vegetation [%]::
+88:SALTY:Salinity [kg/kg]::
+89:DEN:Density [kg/m^3]::
+90:WATR:Water runoff [kg/m^2]::
+91:ICEC:Ice concentration (ice=1;no ice=0) [fraction]::
+92:ICETK:Ice thickness [m]::
+93:DICED:Direction of ice drift [deg]::
+94:SICED:Speed of ice drift [m/s]::
+95:UICE:u of ice drift [m/s]::
+96:VICE:v of ice drift [m/s]::
+97:ICEG:Ice growth rate [m/s]::
+98:ICED:Ice divergence [/s]::
+99:SNOM:Snow melt [kg/m^2]::
+100:HTSGW:Sig height of wind waves and swell [m]::
+101:WVDIR:Direction of wind waves [deg]::
+102:WVHGT:Sig height of wind waves [m]::
+103:WVPER:Mean period of wind waves [s]::
+104:SWDIR:Direction of swell waves [deg]::
+105:SWELL:Sig height of swell waves [m]::
+106:SWPER:Mean period of swell waves [s]::
+107:DIRPW:Primary wave direction [deg]::
+108:PERPW:Primary wave mean period [s]::
+109:DIRSW:Secondary wave direction [deg]::
+110:PERSW:Secondary wave mean period [s]::
+111:NSWRS:Net short wave (surface) [W/m^2]::
+112:NLWRS:Net long wave (surface) [W/m^2]::
+113:NSWRT:Net short wave (top) [W/m^2]::
+114:NLWRT:Net long wave (top) [W/m^2]::
+115:LWAVR:Long wave [W/m^2]::
+116:SWAVR:Short wave [W/m^2]::
+117:GRAD:Global radiation [W/m^2]::
+118:BRTMP:Brightness temperature [K]::
+119:LWRAD:Radiance with respect to wave no. [W/m/sr]::
+120:SWRAD:Radiance with respect ot wave len. [W/m^3/sr]::
+121:LHTFL:Latent heat flux [W/m^2]::
+122:SHTFL:Sensible heat flux [W/m^2]::
+123:BLYDP:Boundary layer dissipation [W/m^2]::
+124:UFLX:Zonal momentum flux [N/m^2]::
+125:VFLX:Meridional momentum flux [N/m^2]::
+126:WMIXE:Wind mixing energy [J]::
+127:IMGD:Image data []::
+128:U_BXS::U_BXS:1
+129:U_BXE::U_BXE:1
+130:U_BYS::U_BYS:1
+131:U_BYE::U_BYE:1
+132:U_BTXS::U_BTXS:5
+133:U_BTXE::U_BTXE:5
+134:U_BTYS::U_BTYS:5
+135:U_BTYE::U_BTYE:5
+136:V_BXS::V_BXS:1
+137:V_BXE::V_BXE:1
+138:V_BYS::V_BYS:1
+139:V_BYE::V_BYE:1
+140:V_BTXS::V_BTXS:5
+141:V_BTXE::V_BTXE:5
+142:V_BTYS::V_BTYS:5
+143:V_BTYE::V_BTYE:5
+144:W_BXS::W_BXS:4
+145:W_BXE::W_BXE:4
+146:W_BYS::W_BYS:4
+147:W_BYE::W_BYE:4
+148:W_BTXS::W_BTXS:8
+149:W_BTXE::W_BTXE:8
+150:W_BTYS::W_BTYS:8
+151:W_BTYE::W_BTYE:8
+152:QVAPOR_BXS::QVAPOR_BXS:4
+153:QVAPOR_BXE::QVAPOR_BXE:4
+154:QVAPOR_BYS::QVAPOR_BYS:4
+155:QVAPOR_BYE::QVAPOR_BYE:4
+156:QVAPOR_BTXS::QVAPOR_BTXS:6
+157:QVAPOR_BTXE::QVAPOR_BTXE:6
+158:QVAPOR_BTYS::QVAPOR_BTYS:6
+159:QVAPOR_BTYE::QVAPOR_BTYE:6
+160:QCLOUD_BXS::QCLOUD_BXS:6
+161:QCLOUD_BXE::QCLOUD_BXE:6
+162:QCLOUD_BYS::QCLOUD_BYS:6
+163:QCLOUD_BYE::QCLOUD_BYE:6
+164:QCLOUD_BTXS::QCLOUD_BTXS:9
+165:QCLOUD_BTXE::QCLOUD_BTXE:9
+166:QCLOUD_BTYS::QCLOUD_BTYS:9
+167:QCLOUD_BTYE::QCLOUD_BTYE:9
+168:QRAIN_BXS::QRAIN_BXS:6
+169:QRAIN_BXE::QRAIN_BXE:6
+170:QRAIN_BYS::QRAIN_BYS:6
+171:QRAIN_BYE::QRAIN_BYE:6
+172:QRAIN_BTXS::QRAIN_BTXS:9
+173:QRAIN_BTXE::QRAIN_BTXE:9
+174:QRAIN_BTYS::QRAIN_BTYS:9
+175:QRAIN_BTYE::QRAIN_BTYE:9
+176:QNICE_BXS::QNICE_BXS:6
+177:QNICE_BXE::QNICE_BXE:6
+178:QNICE_BYS::QNICE_BYS:6
+179:QNICE_BYE::QNICE_BYE:6
+180:QNICE_BTXS::QNICE_BTXS:9
+181:QNICE_BTXE::QNICE_BTXE:9
+182:QNICE_BTYS::QNICE_BTYS:9
+183:QNICE_BTYE::QNICE_BTYE:9
+184:var184:undefined::
+185:var185:undefined::
+186:var186:undefined::
+187:var187:undefined::
+188:var188:undefined::
+189:var189:undefined::
+190:var190:undefined::
+191:var191:undefined::
+192:var192:undefined::
+193:var193:undefined::
+194:var194:undefined::
+195:var195:undefined::
+196:var196:undefined::
+197:var197:undefined::
+198:var198:undefined::
+199:var199:undefined::
+200:var200:undefined::
+201:var201:undefined::
+202:var202:undefined::
+203:var203:undefined::
+204:var204:undefined::
+205:var205:undefined::
+206:var206:undefined::
+207:var207:undefined::
+208:var208:undefined::
+209:var209:undefined::
+210:var210:undefined::
+211:var211:undefined::
+212:var212:undefined::
+213:var213:undefined::
+214:var214:undefined::
+215:var215:undefined::
+216:var216:undefined::
+217:var217:undefined::
+218:var218:undefined::
+219:var219:undefined::
+220:var220:undefined::
+221:var221:undefined::
+222:var222:undefined::
+223:var223:undefined::
+224:var224:undefined::
+225:var225:undefined::
+226:var226:undefined::
+227:var227:undefined::
+228:var228:undefined::
+229:var229:undefined::
+230:var230:undefined::
+231:var231:undefined::
+232:var232:undefined::
+233:var233:undefined::
+234:var234:undefined::
+235:var235:undefined::
+236:var236:undefined::
+237:var237:undefined::
+238:var238:undefined::
+239:var239:undefined::
+240:var240:undefined::
+241:var241:undefined::
+242:var242:undefined::
+243:var243:undefined::
+244:var244:undefined::
+245:var245:undefined::
+246:var246:undefined::
+247:var247:undefined::
+248:var248:undefined::
+249:var249:undefined::
+250:var250:undefined::
+251:var251:undefined::
+252:var252:undefined::
+253:var253:undefined::
+254:var254:undefined::
+255:var255:undefined::
+-1:255:255:6
+0:var0:undefined::
+1:PRES:Pressure [Pa]::
+2:PRMSL:Pressure reduced to MSL [Pa]::
+3:PTEND:Pressure tendency [Pa/s]::
+4:PVORT:Pot. vorticity [km^2/kg/s]::
+5:ICAHT:ICAO Standard Atmosphere Reference Height [M]::
+6:GP:Geopotential [m^2/s^2]::
+7:HGT:Geopotential height [gpm]::
+8:DIST:Geometric height [m]::
+9:HSTDV:Std dev of height [m]::
+10:TOZNE:Total ozone [Dobson]::
+11:TMP:Temp. [K]::
+12:VTMP:Virtual temp. [K]::
+13:POT:Potential temp. [K]::
+14:EPOT:Pseudo-adiabatic pot. temp. [K]::
+15:TMAX:Max. temp. [K]::
+16:TMIN:Min. temp. [K]::
+17:DPT:Dew point temp. [K]::
+18:DEPR:Dew point depression [K]::
+19:LAPR:Lapse rate [K/m]::
+20:VIS:Visibility [m]::
+21:RDSP1:Radar spectra (1) [non-dim]::
+22:RDSP2:Radar spectra (2) [non-dim]::
+23:RDSP3:Radar spectra (3) [non-dim]::
+24:PLI:Parcel lifted index (to 500 hPa) [K]::
+25:TMPA:Temp. anomaly [K]::
+26:PRESA:Pressure anomaly [Pa]::
+27:GPA:Geopotential height anomaly [gpm]::
+28:WVSP1:Wave spectra (1) [non-dim]::
+29:WVSP2:Wave spectra (2) [non-dim]::
+30:WVSP3:Wave spectra (3) [non-dim]::
+31:WDIR:Wind direction [deg]::
+32:WIND:Wind speed [m/s]::
+33:UGRD:u wind [m/s]::
+34:VGRD:v wind [m/s]::
+35:STRM:Stream function [m^2/s]::
+36:VPOT:Velocity potential [m^2/s]::
+37:MNTSF:Montgomery stream function [m^2/s^2]::
+38:SGCVV:Sigma coord. vertical velocity [/s]::
+39:VVEL:Pressure vertical velocity [Pa/s]::
+40:DZDT:Geometric vertical velocity [m/s]::
+41:ABSV:Absolute vorticity [/s]::
+42:ABSD:Absolute divergence [/s]::
+43:RELV:Relative vorticity [/s]::
+44:RELD:Relative divergence [/s]::
+45:VUCSH:Vertical u shear [/s]::
+46:VVCSH:Vertical v shear [/s]::
+47:DIRC:Direction of current [deg]::
+48:SPC:Speed of current [m/s]::
+49:UOGRD:u of current [m/s]::
+50:VOGRD:v of current [m/s]::
+51:SPFH:Specific humidity [kg/kg]::
+52:RH:Relative humidity [%]::
+53:MIXR:Humidity mixing ratio [kg/kg]::
+54:PWAT:Precipitable water [kg/m^2]::
+55:VAPP:Vapor pressure [Pa]::
+56:SATD:Saturation deficit [Pa]::
+57:EVP:Evaporation [kg/m^2]::
+58:CICE:Cloud Ice [kg/m^2]::
+59:PRATE:Precipitation rate [kg/m^2/s]::
+60:TSTM:Thunderstorm probability [%]::
+61:APCP:Total precipitation [kg/m^2]::
+62:NCPCP:Large scale precipitation [kg/m^2]::
+63:ACPCP:Convective precipitation [kg/m^2]::
+64:SRWEQ:Snowfall rate water equiv. [kg/m^2/s]::
+65:WEASD:Accum. snow [kg/m^2]::
+66:SNOD:Snow depth [m]::
+67:MIXHT:Mixed layer depth [m]::
+68:TTHDP:Transient thermocline depth [m]::
+69:MTHD:Main thermocline depth [m]::
+70:MTHA:Main thermocline anomaly [m]::
+71:TCDC:Total cloud cover [%]::
+72:CDCON:Convective cloud cover [%]::
+73:LCDC:Low level cloud cover [%]::
+74:MCDC:Mid level cloud cover [%]::
+75:HCDC:High level cloud cover [%]::
+76:CWAT:Cloud water [kg/m^2]::
+77:BLI:Best lifted index (to 500 hPa) [K]::
+78:SNOC:Convective snow [kg/m^2]::
+79:SNOL:Large scale snow [kg/m^2]::
+80:WTMP:Water temp. [K]::
+81:LAND:Land cover (land=1;sea=0) [fraction]::
+82:DSLM:Deviation of sea level from mean [m]::
+83:SFCR:Surface roughness [m]::
+84:ALBDO:Albedo [%]::
+85:TSOIL:Soil temp. [K]::
+86:SOILM:Soil moisture content [kg/m^2]::
+87:VEG:Vegetation [%]::
+88:SALTY:Salinity [kg/kg]::
+89:DEN:Density [kg/m^3]::
+90:WATR:Water runoff [kg/m^2]::
+91:ICEC:Ice concentration (ice=1;no ice=0) [fraction]::
+92:ICETK:Ice thickness [m]::
+93:DICED:Direction of ice drift [deg]::
+94:SICED:Speed of ice drift [m/s]::
+95:UICE:u of ice drift [m/s]::
+96:VICE:v of ice drift [m/s]::
+97:ICEG:Ice growth rate [m/s]::
+98:ICED:Ice divergence [/s]::
+99:SNOM:Snow melt [kg/m^2]::
+100:HTSGW:Sig height of wind waves and swell [m]::
+101:WVDIR:Direction of wind waves [deg]::
+102:WVHGT:Sig height of wind waves [m]::
+103:WVPER:Mean period of wind waves [s]::
+104:SWDIR:Direction of swell waves [deg]::
+105:SWELL:Sig height of swell waves [m]::
+106:SWPER:Mean period of swell waves [s]::
+107:DIRPW:Primary wave direction [deg]::
+108:PERPW:Primary wave mean period [s]::
+109:DIRSW:Secondary wave direction [deg]::
+110:PERSW:Secondary wave mean period [s]::
+111:NSWRS:Net short wave (surface) [W/m^2]::
+112:NLWRS:Net long wave (surface) [W/m^2]::
+113:NSWRT:Net short wave (top) [W/m^2]::
+114:NLWRT:Net long wave (top) [W/m^2]::
+115:LWAVR:Long wave [W/m^2]::
+116:SWAVR:Short wave [W/m^2]::
+117:GRAD:Global radiation [W/m^2]::
+118:BRTMP:Brightness temperature [K]::
+119:LWRAD:Radiance with respect to wave no. [W/m/sr]::
+120:SWRAD:Radiance with respect ot wave len. [W/m^3/sr]::
+121:LHTFL:Latent heat flux [W/m^2]::
+122:SHTFL:Sensible heat flux [W/m^2]::
+123:BLYDP:Boundary layer dissipation [W/m^2]::
+124:UFLX:Zonal momentum flux [N/m^2]::
+125:VFLX:Meridional momentum flux [N/m^2]::
+126:WMIXE:Wind mixing energy [J]::
+127:IMGD:Image data []::
+128:var128:undefined::
+129:PH0:Initial geopotential:PH0:1
+130:T_INIT:initial potential temperature:T_INIT:2
+131:AL:inverse perturbation density [m3 kg-1]:AL:4
+132:ALT:inverse density [m3 kg-1]:ALT:4
+133:SMFR3D:soil ice:SMFR3D:2
+134:KEEPFR3DFLAG:Flag - 1. Frozen Soil Yes, 0 - NO:KEEPFR3DFLAG:1
+135:CT:COUNTERGRADIENT TERM [K]:CT:2
+136:Z0:Background Roughness Length [m]:Z0:6
+137:KPBL:Level of PBL TOP:KPBL:1
+138:HTOP:Top of convection level:HTOP:1
+139:HBOT:Bottom of Convection Level:HBOT:1
+140:CUPPT:Accmulated Convective Rain Since Last Call to the Radiation:CUPPT:4
+141:F_ICE_PHY:Fraction of Ice:F_ICE_PHY:2
+142:F_RAIN_PHY:Fraction of Rain:F_RAIN_PHY:2
+143:F_RIMEF_PHY:Mass Ratio of Rimed Ice:F_RIMEF_PHY:2
+144:H_DIABATIC:Previous Timestep Condensational Heating:H_DIABATIC:9
+145:RTHCUTEN:COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME [Pa K s-1]:RTHCUTEN:4
+146:RQVCUTEN:COUPLED Q_V TEND DUE TO CUMULUS SCHEME [Pa kg kg-1 s-1]:RQVCUTEN:4
+147:RQRCUTEN:COUPLED Q_R TEND DUE TO CUMULUS SCHEME [Pa kg kg-1 s-1]:RQRCUTEN:4
+148:RQCCUTEN:COUPLED Q_C TEND DUE TO CUMULUS SCHEME [Pa kg kg-1 s-1]:RQCCUTEN:4
+149:RQSCUTEN:COUPLED Q_S TEND DUE TO CUMULUS SCHEME [Pa kg kg-1 s-1]:RQSCUTEN:4
+150:RQICUTEN:COUPLED Q_I TEND DUE TO CUMULUS SCHEME [Pa kg kg-1 s-1]:RQICUTEN:4
+151:W0AVG:AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME [m s-1]:W0AVG:6
+152:NCA:COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME:NCA:0
+153:MASS_FLUX:DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME [mb/hr]:MASS_FLUX:4
+154:APR_GR:PRECIP FROM CLOSURE OLD_GRELL [mm/hr]:APR_GR:4
+155:APR_W:PRECIP FROM CLOSURE W:APR_W:4
+156:APR_MC:PRECIP FROM CLOSURE KRISH MV [mm/hr]:APR_MC:4
+157:APR_ST:PRECIP FROM CLOSURE STABILITY [mm/hr]:APR_ST:4
+158:APR_AS:PRECIP FROM CLOSURE AS-TYPE [mm/hr]:APR_AS:4
+159:var159:undefined::
+160:APR_CAPMA:PRECIP FROM MAX CAP [mm/hr]:APR_CAPMA:4
+161:APR_CAPME:PRECIP FROM MEAN CAP [mm/hr]:APR_CAPME:4
+162:APR_CAPMI:PRECIP FROM MIN CAP [mm/hr]:APR_CAPMI:4
+163:XF_ENS:MASS FLUX PDF IN GRELL CUMULUS SCHEME[mb/hr]:XF_ENS:4
+164:PR_ENS:PRECIP RATE PDF IN GRELL CUMULUS SCHEME [mb/hr]:PR_ENS:4
+165:STEPCU:NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS:STEPCU:1
+166:RTHRATEN:COUPLED THETA TENDENCY DUE TO RADIATION [Pa K s-1]:RTHRATEN:4
+167:RTHRATLW:COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION [Pa K s-1]:RTHRATLW:7
+168:RTHRATSW:COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION [Pa K s-1]:RTHRATSW:7
+169:CLDFRA:CLOUD FRACTION:CLDFRA:2
+170:RUBLTEN:COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION [Pa m s-2]:RUBLTEN:4
+171:RVBLTEN:COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION [Pa m s-2]:RVBLTEN:4
+172:RTHBLTEN:COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION [Pa K s-1]:RTHBLTEN:4
+173:RQVBLTEN:COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION [Pa kg kg-1 s-1]:RQVBLTEN:6
+174:RQCBLTEN:COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION [Pa kg kg-1 s-1]:RQCBLTEN:6
+175:RQIBLTEN:COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION [Pa kg kg-1 s-1]:RQIBLTEN:6
+176:UST:U* IN SIMILARITY THEORY [m s-1]:UST:4
+177:CAPG:HEAT CAPACITY FOR SOIL [j K-1 m-3]:CAPG:3
+178:THC:THERMAL INERTIA [Cal cm-1 K-1 s-0.5]:THC:3
+179:FLHC:SURFACE EXCHANGE COEFFICIENT FOR HEAT:FLHC:3
+180:FLQC:SURFACE EXCHANGE COEFFICIENT FOR MOISTURE:FLQC:6
+181:QSG:SURFACE SATURATION WATER VAPOR MIXING RATIO [kg kg-1]:QSG:6
+182:SOILT1:TEMPERATURE INSIDE SNOW [K]:SOILT1:2
+183:TSNAV:AVERAGE SNOW TEMPERATURE [C]:TSNAV:2
+184:MAVAIL:SURFACE MOISTURE AVAILABLITY:MAVAIL:4
+185:TKESFCF:TKE AT THE SURFACE [m2/s2]:TKESFCF:3
+186:STEPBL:NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS:STEPBL:1
+187:TAUCLDI:CLOUD OPTICAL THICKNESS FOR ICE:TAUCLDI:2
+188:TAUCLDC:CLOUD OPTICAL THICKNESS FOR WATER:TAUCLDC:2
+189:RTHFTEN:TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME [K/s]:RTHFTEN:6
+190:RQVFTEN:MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME [kg/s]:RQVFTEN:6
+191:EMISS:SURFACE EMISSIVITY:EMISS:4
+192:CLDEFI:Precipitation efficiency in BMJ Scheme:CLDEFI:4
+193:STEPRA:NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS:STEPRA:1
+194:MOL:T* in Similarity Theory [K]:MOL:3
+195:ALB:??:ALB:4
+196:U_1:Restart Parm:U_1:3
+197:U_2:Restart Parm:U_2:3
+198:V_1:Restart Parm:V_1:3
+199:V_2:Restart Parm:V_2:3
+200:W_1:Restart Parm:W_1:5
+201:W_2:Restart Parm:W_2:5
+202:PH_1:Restart Parm:PH_1:4
+203:PH_2:Restart Parm:PH_2:4
+204:T_1:Restart Parm:T_1:3
+205:T_2:Restart Parm:T_2:3
+206:MU_1:Restart Parm:MU_1:2
+207:MU_2:Restart Parm:MU_2:2
+208:TKE_1:Restart Parm:TKE_1:3
+209:TKE_2:Restart Parm:TKE_2:3
+210:QVAPOR_1:Restart Parm:QVAPOR_1:6
+211:QVAPOR_2:Restart Parm:QVAPOR_2:6
+212:QCLOUD_1:Restart Parm:QCLOUD_1:6
+213:QCLOUD_2:Restart Parm:QCLOUD_2:6
+214:QRAIN_1:Restart Parm:QRAIN_1:6
+215:QRAIN_2:Restart Parm:QRAIN_2:6
+216:QICE_1:Restart Parm:QICE_1:6
+217:QICE_2:Restart Parm:QICE_2:6
+218:QSNOW_1:Restart Parm:QSNOW_1:6
+219:QSNOW_2:Restart Parm:QSNOW_2:6
+220:QGRAUP_1:Restart Parm:QGRAUP_1:6
+221:QGRAUP_2:Restart Parm:QGRAUP_2:6
+222:QZ0:Specific humidity at roughness length [kg/kg]:QZ0:5
+223:TBPVS_STATE:STATE FOR ETAMPNEW MICROPHYSICS:TBPVS_STATE:3
+224:TBPVS0_STATE:STATE FOR ETAMPNEW MICROPHYSICS:TBPVS0_STATE:3
+225:MP_RESTART_STATE:STATE VECTOR FOR MICROPHYSICS RESTARTS:MP_RESTART_STATE:3
+226:IMICROGRAM:flag 0/1 0=mixratio, 1=mcrograms/m3":IMICROGRAM:1
+227:MASS_AER_WATER:aerosol liquid water content:MASS_AER_WATER:6
+228:MASS_AER_DRY:dry aerosol mass:MASS_AER_DRY:6
+229:EXCH_H:EXCHANGE COEFFICIENTS:EXCH_H:3
+230:var230:undefined::
+231:var231:undefined::
+232:var232:undefined::
+233:var233:undefined::
+234:var234:undefined::
+235:var235:undefined::
+236:var236:undefined::
+237:var237:undefined::
+238:var238:undefined::
+239:var239:undefined::
+240:var240:undefined::
+241:var241:undefined::
+242:var242:undefined::
+243:var243:undefined::
+244:var244:undefined::
+245:var245:undefined::
+246:var246:undefined::
+247:var247:undefined::
+248:var248:undefined::
+249:var249:undefined::
+250:var250:undefined::
+251:var251:undefined::
+252:var252:undefined::
+253:var253:undefined::
+254:var254:undefined::
+255:var255:undefined::
+-1:7:-1:129
+0:var0:undefined
+1:PRES:Pressure [Pa]
+2:PRMSL:Pressure reduced to MSL [Pa]
+3:PTEND:Pressure tendency [Pa/s]
+4:PVORT:Pot. vorticity [km^2/kg/s]
+5:ICAHT:ICAO Standard Atmosphere Reference Height [M]
+6:GP:Geopotential [m^2/s^2]
+7:HGT:Geopotential height [gpm]
+8:DIST:Geometric height [m]
+9:HSTDV:Std dev of height [m]
+10:TOZNE:Total ozone [Dobson]
+11:TMP:Temp. [K]
+12:VTMP:Virtual temp. [K]
+13:POT:Potential temp. [K]
+14:EPOT:Pseudo-adiabatic pot. temp. [K]
+15:TMAX:Max. temp. [K]
+16:TMIN:Min. temp. [K]
+17:DPT:Dew point temp. [K]
+18:DEPR:Dew point depression [K]
+19:LAPR:Lapse rate [K/m]
+20:VIS:Visibility [m]
+21:RDSP1:Radar spectra (1) [non-dim]
+22:RDSP2:Radar spectra (2) [non-dim]
+23:RDSP3:Radar spectra (3) [non-dim]
+24:PLI:Parcel lifted index (to 500 hPa) [K]
+25:TMPA:Temp. anomaly [K]
+26:PRESA:Pressure anomaly [Pa]
+27:GPA:Geopotential height anomaly [gpm]
+28:WVSP1:Wave spectra (1) [non-dim]
+29:WVSP2:Wave spectra (2) [non-dim]
+30:WVSP3:Wave spectra (3) [non-dim]
+31:WDIR:Wind direction [deg]
+32:WIND:Wind speed [m/s]
+33:UGRD:u wind [m/s]
+34:VGRD:v wind [m/s]
+35:STRM:Stream function [m^2/s]
+36:VPOT:Velocity potential [m^2/s]
+37:MNTSF:Montgomery stream function [m^2/s^2]
+38:SGCVV:Sigma coord. vertical velocity [/s]
+39:VVEL:Pressure vertical velocity [Pa/s]
+40:DZDT:Geometric vertical velocity [m/s]
+41:ABSV:Absolute vorticity [/s]
+42:ABSD:Absolute divergence [/s]
+43:RELV:Relative vorticity [/s]
+44:RELD:Relative divergence [/s]
+45:VUCSH:Vertical u shear [/s]
+46:VVCSH:Vertical v shear [/s]
+47:DIRC:Direction of current [deg]
+48:SPC:Speed of current [m/s]
+49:UOGRD:u of current [m/s]
+50:VOGRD:v of current [m/s]
+51:SPFH:Specific humidity [kg/kg]
+52:RH:Relative humidity [%]
+53:MIXR:Humidity mixing ratio [kg/kg]
+54:PWAT:Precipitable water [kg/m^2]
+55:VAPP:Vapor pressure [Pa]
+56:SATD:Saturation deficit [Pa]
+57:EVP:Evaporation [kg/m^2]
+58:CICE:Cloud Ice [kg/m^2]
+59:PRATE:Precipitation rate [kg/m^2/s]
+60:TSTM:Thunderstorm probability [%]
+61:APCP:Total precipitation [kg/m^2]
+62:NCPCP:Large scale precipitation [kg/m^2]
+63:ACPCP:Convective precipitation [kg/m^2]
+64:SRWEQ:Snowfall rate water equiv. [kg/m^2/s]
+65:WEASD:Accum. snow [kg/m^2]
+66:SNOD:Snow depth [m]
+67:MIXHT:Mixed layer depth [m]
+68:TTHDP:Transient thermocline depth [m]
+69:MTHD:Main thermocline depth [m]
+70:MTHA:Main thermocline anomaly [m]
+71:TCDC:Total cloud cover [%]
+72:CDCON:Convective cloud cover [%]
+73:LCDC:Low level cloud cover [%]
+74:MCDC:Mid level cloud cover [%]
+75:HCDC:High level cloud cover [%]
+76:CWAT:Cloud water [kg/m^2]
+77:BLI:Best lifted index (to 500 hPa) [K]
+78:SNOC:Convective snow [kg/m^2]
+79:SNOL:Large scale snow [kg/m^2]
+80:WTMP:Water temp. [K]
+81:LAND:Land cover (land=1;sea=0) [fraction]
+82:DSLM:Deviation of sea level from mean [m]
+83:SFCR:Surface roughness [m]
+84:ALBDO:Albedo [%]
+85:TSOIL:Soil temp. [K]
+86:SOILM:Soil moisture content [kg/m^2]
+87:VEG:Vegetation [%]
+88:SALTY:Salinity [kg/kg]
+89:DEN:Density [kg/m^3]
+90:WATR:Water runoff [kg/m^2]
+91:ICEC:Ice concentration (ice=1;no ice=0) [fraction]
+92:ICETK:Ice thickness [m]
+93:DICED:Direction of ice drift [deg]
+94:SICED:Speed of ice drift [m/s]
+95:UICE:u of ice drift [m/s]
+96:VICE:v of ice drift [m/s]
+97:ICEG:Ice growth rate [m/s]
+98:ICED:Ice divergence [/s]
+99:SNOM:Snow melt [kg/m^2]
+100:HTSGW:Sig height of wind waves and swell [m]
+101:WVDIR:Direction of wind waves [deg]
+102:WVHGT:Sig height of wind waves [m]
+103:WVPER:Mean period of wind waves [s]
+104:SWDIR:Direction of swell waves [deg]
+105:SWELL:Sig height of swell waves [m]
+106:SWPER:Mean period of swell waves [s]
+107:DIRPW:Primary wave direction [deg]
+108:PERPW:Primary wave mean period [s]
+109:DIRSW:Secondary wave direction [deg]
+110:PERSW:Secondary wave mean period [s]
+111:NSWRS:Net short wave (surface) [W/m^2]
+112:NLWRS:Net long wave (surface) [W/m^2]
+113:NSWRT:Net short wave (top) [W/m^2]
+114:NLWRT:Net long wave (top) [W/m^2]
+115:LWAVR:Long wave [W/m^2]
+116:SWAVR:Short wave [W/m^2]
+117:GRAD:Global radiation [W/m^2]
+118:BRTMP:Brightness temperature [K]
+119:LWRAD:Radiance with respect to wave no. [W/m/sr]
+120:SWRAD:Radiance with respect ot wave len. [W/m^3/sr]
+121:LHTFL:Latent heat flux [W/m^2]
+122:SHTFL:Sensible heat flux [W/m^2]
+123:BLYDP:Boundary layer dissipation [W/m^2]
+124:UFLX:Zonal momentum flux [N/m^2]
+125:VFLX:Meridional momentum flux [N/m^2]
+126:WMIXE:Wind mixing energy [J]
+127:IMGD:Image data []
+128:PAOT:Probability anomaly of temp [%]
+129:PAOP:Probability anomaly of precip [%]
+130:var130:undefined
+131:FRAIN:Rain fraction of total liquid water []
+132:FICE:Ice fraction of total condensate []
+133:FRIME:Rime factor []
+134:CUEFI:Convective cloud efficiency []
+135:TCOND:Total condensate [kg/kg]
+136:TCOLW:Total column cloud water [kg/m/m]
+137:TCOLI:Total column cloud ice [kg/m/m]
+138:TCOLR:Total column rain [kg/m/m]
+139:TCOLS:Total column snow [kg/m/m]
+140:TCOLC:Total column condensate [kg/m/m]
+141:PLPL:Pressure of level from which parcel was lifted [Pa]
+142:HLPL:Height of level from which parcel was lifted [Pa]
+143:var143:undefined
+144:var144:undefined
+145:var145:undefined
+146:var146:undefined
+147:var147:undefined
+148:var148:undefined
+149:var149:undefined
+150:var150:undefined
+151:var151:undefined
+152:var152:undefined
+153:var153:undefined
+154:var154:undefined
+155:var155:undefined
+156:var156:undefined
+157:var157:undefined
+158:var158:undefined
+159:var159:undefined
+160:var160:undefined
+161:var161:undefined
+162:var162:undefined
+163:var163:undefined
+164:var164:undefined
+165:var165:undefined
+166:var166:undefined
+167:var167:undefined
+168:var168:undefined
+169:var169:undefined
+170:ELRDI:Ellrod Index
+171:TSEC:Seconds prior to initial reference time [sec]
+172:var172:undefined
+173:var173:undefined
+174:var174:undefined
+175:var175:undefined
+176:var176:undefined
+177:var177:undefined
+178:var178:undefined
+179:var179:undefined
+180:OZCON:Ozone concentration [ppb]
+181:OZCAT:Categorical ozone concentration [?]
+182:KH:vertical heat eddy diffusivity [m^2/s]
+183:var183:undefined
+184:var184:undefined
+185:var185:undefined
+186:var186:undefined
+187:var187:undefined
+188:var188:undefined
+189:var189:undefined
+190:var190:undefined
+191:var191:undefined
+192:var192:undefined
+193:var193:undefined
+194:var194:undefined
+195:var195:undefined
+196:var196:undefined
+197:var197:undefined
+198:var198:undefined
+199:var199:undefined
+200:var200:undefined
+201:var201:undefined
+202:var202:undefined
+203:var203:undefined
+204:var204:undefined
+205:var205:undefined
+206:var206:undefined
+207:var207:undefined
+208:var208:undefined
+209:var209:undefined
+210:var210:undefined
+211:var211:undefined
+212:var212:undefined
+213:var213:undefined
+214:var214:undefined
+215:var215:undefined
+216:var216:undefined
+217:var217:undefined
+218:var218:undefined
+219:var219:undefined
+220:var220:undefined
+221:var221:undefined
+222:var222:undefined
+223:var223:undefined
+224:var224:undefined
+225:var225:undefined
+226:var226:undefined
+227:var227:undefined
+228:var228:undefined
+229:var229:undefined
+230:var230:undefined
+231:var231:undefined
+232:var232:undefined
+233:var233:undefined
+234:var234:undefined
+235:var235:undefined
+236:var236:undefined
+237:var237:undefined
+238:var238:undefined
+239:var239:undefined
+240:var240:undefined
+241:var241:undefined
+242:var242:undefined
+243:var243:undefined
+244:var244:undefined
+245:var245:undefined
+246:var246:undefined
+247:var247:undefined
+248:var248:undefined
+249:var249:undefined
+250:var250:undefined
+251:var251:undefined
+252:var252:undefined
+253:var253:undefined
+254:var254:undefined
+255:var255:undefined
+-1:7:-1:130
+0:var0:undefined
+1:PRES:Pressure [Pa]
+2:PRMSL:Pressure reduced to MSL [Pa]
+3:PTEND:Pressure tendency [Pa/s]
+4:PVORT:Pot. vorticity [km^2/kg/s]
+5:ICAHT:ICAO Standard Atmosphere Reference Height [M]
+6:GP:Geopotential [m^2/s^2]
+7:HGT:Geopotential height [gpm]
+8:DIST:Geometric height [m]
+9:HSTDV:Std dev of height [m]
+10:TOZNE:Total ozone [Dobson]
+11:TMP:Temp. [K]
+12:VTMP:Virtual temp. [K]
+13:POT:Potential temp. [K]
+14:EPOT:Pseudo-adiabatic pot. temp. [K]
+15:TMAX:Max. temp. [K]
+16:TMIN:Min. temp. [K]
+17:DPT:Dew point temp. [K]
+18:DEPR:Dew point depression [K]
+19:LAPR:Lapse rate [K/m]
+20:VIS:Visibility [m]
+21:RDSP1:Radar spectra (1) [non-dim]
+22:RDSP2:Radar spectra (2) [non-dim]
+23:RDSP3:Radar spectra (3) [non-dim]
+24:PLI:Parcel lifted index (to 500 hPa) [K]
+25:TMPA:Temp. anomaly [K]
+26:PRESA:Pressure anomaly [Pa]
+27:GPA:Geopotential height anomaly [gpm]
+28:WVSP1:Wave spectra (1) [non-dim]
+29:WVSP2:Wave spectra (2) [non-dim]
+30:WVSP3:Wave spectra (3) [non-dim]
+31:WDIR:Wind direction [deg]
+32:WIND:Wind speed [m/s]
+33:UGRD:u wind [m/s]
+34:VGRD:v wind [m/s]
+35:STRM:Stream function [m^2/s]
+36:VPOT:Velocity potential [m^2/s]
+37:MNTSF:Montgomery stream function [m^2/s^2]
+38:SGCVV:Sigma coord. vertical velocity [/s]
+39:VVEL:Pressure vertical velocity [Pa/s]
+40:DZDT:Geometric vertical velocity [m/s]
+41:ABSV:Absolute vorticity [/s]
+42:ABSD:Absolute divergence [/s]
+43:RELV:Relative vorticity [/s]
+44:RELD:Relative divergence [/s]
+45:VUCSH:Vertical u shear [/s]
+46:VVCSH:Vertical v shear [/s]
+47:DIRC:Direction of current [deg]
+48:SPC:Speed of current [m/s]
+49:UOGRD:u of current [m/s]
+50:VOGRD:v of current [m/s]
+51:SPFH:Specific humidity [kg/kg]
+52:RH:Relative humidity [%]
+53:MIXR:Humidity mixing ratio [kg/kg]
+54:PWAT:Precipitable water [kg/m^2]
+55:VAPP:Vapor pressure [Pa]
+56:SATD:Saturation deficit [Pa]
+57:EVP:Evaporation [kg/m^2]
+58:CICE:Cloud Ice [kg/m^2]
+59:PRATE:Precipitation rate [kg/m^2/s]
+60:TSTM:Thunderstorm probability [%]
+61:APCP:Total precipitation [kg/m^2]
+62:NCPCP:Large scale precipitation [kg/m^2]
+63:ACPCP:Convective precipitation [kg/m^2]
+64:SRWEQ:Snowfall rate water equiv. [kg/m^2/s]
+65:WEASD:Accum. snow [kg/m^2]
+66:SNOD:Snow depth [m]
+67:MIXHT:Mixed layer depth [m]
+68:TTHDP:Transient thermocline depth [m]
+69:MTHD:Main thermocline depth [m]
+70:MTHA:Main thermocline anomaly [m]
+71:TCDC:Total cloud cover [%]
+72:CDCON:Convective cloud cover [%]
+73:LCDC:Low level cloud cover [%]
+74:MCDC:Mid level cloud cover [%]
+75:HCDC:High level cloud cover [%]
+76:CWAT:Cloud water [kg/m^2]
+77:BLI:Best lifted index (to 500 hPa) [K]
+78:SNOC:Convective snow [kg/m^2]
+79:SNOL:Large scale snow [kg/m^2]
+80:WTMP:Water temp. [K]
+81:LAND:Land cover (land=1;sea=0) [fraction]
+82:DSLM:Deviation of sea level from mean [m]
+83:SFCR:Surface roughness [m]
+84:ALBDO:Albedo [%]
+85:TSOIL:Soil temp. [K]
+86:SOILM:Soil moisture content [kg/m^2]
+87:VEG:Vegetation [%]
+88:SALTY:Salinity [kg/kg]
+89:DEN:Density [kg/m^3]
+90:WATR:Water runoff [kg/m^2]
+91:ICEC:Ice concentration (ice=1;no ice=0) [fraction]
+92:ICETK:Ice thickness [m]
+93:DICED:Direction of ice drift [deg]
+94:SICED:Speed of ice drift [m/s]
+95:UICE:u of ice drift [m/s]
+96:VICE:v of ice drift [m/s]
+97:ICEG:Ice growth rate [m/s]
+98:ICED:Ice divergence [/s]
+99:SNOM:Snow melt [kg/m^2]
+100:HTSGW:Sig height of wind waves and swell [m]
+101:WVDIR:Direction of wind waves [deg]
+102:WVHGT:Sig height of wind waves [m]
+103:WVPER:Mean period of wind waves [s]
+104:SWDIR:Direction of swell waves [deg]
+105:SWELL:Sig height of swell waves [m]
+106:SWPER:Mean period of swell waves [s]
+107:DIRPW:Primary wave direction [deg]
+108:PERPW:Primary wave mean period [s]
+109:DIRSW:Secondary wave direction [deg]
+110:PERSW:Secondary wave mean period [s]
+111:NSWRS:Net short wave (surface) [W/m^2]
+112:NLWRS:Net long wave (surface) [W/m^2]
+113:NSWRT:Net short wave (top) [W/m^2]
+114:NLWRT:Net long wave (top) [W/m^2]
+115:LWAVR:Long wave [W/m^2]
+116:SWAVR:Short wave [W/m^2]
+117:GRAD:Global radiation [W/m^2]
+118:BRTMP:Brightness temperature [K]
+119:LWRAD:Radiance with respect to wave no. [W/m/sr]
+120:SWRAD:Radiance with respect ot wave len. [W/m^3/sr]
+121:LHTFL:Latent heat flux [W/m^2]
+122:SHTFL:Sensible heat flux [W/m^2]
+123:BLYDP:Boundary layer dissipation [W/m^2]
+124:UFLX:Zonal momentum flux [N/m^2]
+125:VFLX:Meridional momentum flux [N/m^2]
+126:WMIXE:Wind mixing energy [J]
+127:IMGD:Image data []
+128:var128:undefined
+129:var129:undefined
+130:var130:undefined
+131:var131:undefined
+132:var132:undefined
+133:var133:undefined
+134:var134:undefined
+135:var135:undefined
+136:var136:undefined
+137:var137:undefined
+138:var138:undefined
+139:var139:undefined
+140:var140:undefined
+141:var141:undefined
+142:var142:undefined
+143:CSNOW:Categorical snow [yes=1;no=0]
+144:SOILW:Volumetric soil moisture (frozen + liquid) [fraction]
+145:PEVPR:Potential evaporation rate [W/m^2]
+146:VEGT:Vegetation canopy temperature [K]
+147:BARET:Bare soil surface skin temperature [K]
+148:AVSFT:Average surface skin temperature [K]
+149:RADT:Effective radiative skin temperature [K]
+150:SSTOR:Surface water storage [Kg/m^2]
+151:LSOIL:Liquid soil moisture content (non-frozen) [Kg/m^2]
+152:EWATR:Open water evaporation (standing water) [W/m^2]
+153:var153:undefined
+154:var154:undefined
+155:GFLUX:Ground Heat Flux [W/m^2]
+156:CIN:Convective inhibition [J/Kg]
+157:CAPE:Convective available potential energy [J/Kg]
+158:TKE:Turbulent Kinetic Energy [J/Kg]
+159:MXSALB:Maximum snow albedo [%]
+160:SOILL:Liquid volumetric soil moisture (non-frozen) [fraction]
+161:ASNOW:Frozen precipitation (e.g. snowfall) [Kg/m^2]
+162:ARAIN:Liquid precipitation (rainfall) [Kg/m^2]
+163:GWREC:Groundwater recharge [Kg/m^2]
+164:QREC:Flood plain recharge [Kg/m^2]
+165:SNOWT:Snow temperature, depth-avg [K]
+166:VBDSF:Visible beam downward solar flux [W/m^2]
+167:VDDSF:Visible diffuse downward solar flux [W/m^2]
+168:NBDSF:Near IR beam downward solar flux [W/m^2]
+169:NDDSF:Near IR diffuse downward solar flux [W/m^2]
+170:SNFALB:Snow-free albedo [%]
+171:RLYRS:Number of soil layers in root zone [non-dim]
+172:MFLX:Momentum flux [N/m^2]
+173:var173:undefined
+174:var174:undefined
+175:var175:undefined
+176:NLAT:Latitude (-90 to +90) [deg]
+177:ELON:East longitude (0-360) [deg]
+178:var178:undefined
+179:ACOND:Aerodynamic conductance [m/s]
+180:SNOAG:Snow age [s]
+181:CCOND:Canopy conductance [m/s]
+182:LAI:Leaf area index (0-9) [non-dim]
+183:SFCRH:Roughness length for heat [m]
+184:SALBD:Snow albedo (over snow cover area only) [%]
+185:var185:undefined
+186:var186:undefined
+187:NDVI:Normalized Difference Vegetation Index []
+188:DRIP:Canopy drip [Kg/m^2]
+189:var189:undefined
+190:var190:undefined
+191:var191:undefined
+192:var192:undefined
+193:var193:undefined
+194:var194:undefined
+195:var195:undefined
+196:var196:undefined
+197:var197:undefined
+198:SBSNO:Sublimation (evaporation from snow) [W/m^2]
+199:EVBS:Direct evaporation from bare soil [W/m^2]
+200:EVCW:Canopy water evaporation [W/m^2]
+201:var201:undefined
+202:var202:undefined
+203:RSMIN:Minimal stomatal resistance [s/m]
+204:DSWRF:Downward shortwave radiation flux [W/m^2]
+205:DLWRF:Downward longwave radiation flux [W/m^2]
+206:var206:undefined
+207:MSTAV:Moisture availability [%]
+208:SFEXC:Exchange coefficient [(Kg/m^3)(m/s)]
+209:var209:undefined
+210:TRANS:Transpiration [W/m^2]
+211:USWRF:Upward short wave radiation flux [W/m^2]
+212:ULWRF:Upward long wave radiation flux [W/m^2]
+213:var213:undefined
+214:var214:undefined
+215:var215:undefined
+216:var216:undefined
+217:var217:undefined
+218:var218:undefined
+219:WILT:Wilting point [fraction]
+220:FLDCP:Field Capacity [fraction]
+221:var221:undefined
+222:SLTYP:Surface slope type [Index]
+223:CNWAT:Plant canopy surface water [Kg/m^2]
+224:SOTYP:Soil type [Index]
+225:VGTYP:Vegetation type [Index]
+226:BMIXL:Blackadars mixing length scale [m]
+227:AMIXL:Asymptotic mixing length scale [m]
+228:PEVAP:Potential evaporation [Kg/m^2]
+229:SNOHF:Snow phase-change heat flux [W/m^2]
+230:SMREF:Transpiration stress-onset (soil moisture) [fraction]
+231:SMDRY:Direct evaporation cease (soil moisture) [fraction]
+232:var232:undefined
+233:var233:undefined
+234:BGRUN:Subsurface runoff (baseflow) [Kg/m^2]
+235:SSRUN:Surface runoff (non-infiltrating) [Kg/m^2]
+236:var236:undefined
+237:var237:undefined
+238:SNOWC:Snow cover [%]
+239:SNOT:Snow temperature [K]
+240:POROS:Soil porosity [fraction]
+241:var241:undefined
+242:var242:undefined
+243:var243:undefined
+244:var244:undefined
+245:var245:undefined
+246:RCS:Solar parameter in canopy conductance [fraction]
+247:RCT:Temperature parameter in canopy conductance [fraction]
+248:RCQ:Humidity parameter in canopy conductance [fraction]
+249:RCSOL:Soil moisture parameter in canopy conductance [fraction]
+250:var250:undefined
+251:var251:undefined
+252:CD:Surface drag coefficient [non-dim]
+253:FRICV:Surface friction velocity [m/s]
+254:RI:Richardson number [non-dim]
+255:var255:undefined
Index: trunk/WRF.COMMON/WRFV2/run/ozone_lat.formatted
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/ozone_lat.formatted	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/ozone_lat.formatted	(revision 2744)
@@ -0,0 +1,64 @@
+-87.8638
+-85.0965
+-82.3129
+-79.5256
+-76.7369
+-73.9475
+-71.1577
+-68.3678
+-65.5776
+-62.7873
+-59.997
+-57.2066
+-54.4162
+-51.6257
+-48.8352
+-46.0447
+-43.2542
+-40.4636
+-37.6731
+-34.8825
+-32.0919
+-29.3014
+-26.5108
+-23.7202
+-20.9296
+-18.1390
+-15.3484
+-12.5578
+-9.76709
+-6.9765
+-4.1859
+-1.3953
+1.3953
+4.1859
+6.9765
+9.7671
+12.5578
+15.3484
+18.1390
+20.9296
+23.7202
+26.5108
+29.3014
+32.0919
+34.8825
+37.6731
+40.4636
+43.2542
+46.0447
+48.8352
+51.6257
+54.4162
+57.2066
+59.9970
+62.7873
+65.5776
+68.3678
+71.1577
+73.9475
+76.7369
+79.5256
+82.3129
+85.0965
+87.8638
Index: trunk/WRF.COMMON/WRFV2/run/ozone_plev.formatted
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/ozone_plev.formatted	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/ozone_plev.formatted	(revision 2744)
@@ -0,0 +1,59 @@
+     0.2842
+     0.3254
+     0.3719
+     0.4246
+     0.4842
+     0.5514
+     0.6275
+     0.7135
+     0.8110
+     0.9217
+     1.0476
+     1.1911
+     1.3551
+     1.5431
+     1.7589
+     2.0074
+     2.2940
+     2.6253
+     3.0088
+     3.4537
+     3.9705
+     4.5719
+     5.2728
+     6.0907
+     7.0464
+     8.1637
+     9.4708
+    11.0000
+    12.7894
+    14.8832
+    17.3342
+    20.2039
+    23.5659
+    27.5066
+    32.1283
+    37.5509
+    43.9150
+    51.3840
+    60.1483
+    70.4289
+    82.4830
+    96.6096
+   113.1550
+   132.5140
+   155.1220
+   181.4450
+   211.9470
+   247.0790
+   287.2730
+   332.9560
+   384.5730
+   442.6100
+   507.6010
+   580.1320
+   660.8370
+   750.3930
+   849.5210
+   958.9810
+  1003.6900
Index: trunk/WRF.COMMON/WRFV2/run/urban_param.tbl
===================================================================
--- trunk/WRF.COMMON/WRFV2/run/urban_param.tbl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/run/urban_param.tbl	(revision 2744)
@@ -0,0 +1,89 @@
+Urban Parameters depending on Urban type 
+USGS 
+3, 'ZR[m] Z0C[m] Z0HC[m] ZDC[m] SVF    R      RW     HGT    CDS   AS    AH    BETR  BETB  BETG  FRC_URB  UrbanType' 
+1,  10.,  1.0,   1.0,    2.0,   0.48,  0.50,  0.50,  0.50,  0.1,  0.4,  0.0,  0.0,  0.0,  0.0   0.95    'Commercial' 
+2,  7.5,  0.75,  0.75,   1.5,   0.56,  0.50,  0.50,  0.40,  0.1,  0.3,  0.0,  0.0,  0.0,  0.0   0.9     'High Intensity Res' 
+3,  5.,   0.5,   0.5,    1.0,   0.62,  0.50,  0.50,  0.30,  0.1,  0.2,  0.0,  0.0,  0.0,  0.0   0.5     'Low Intensity Res' 
+CAPR [cal/cm/cm/cm/degC] 
+0.50 
+CAPB [cal/cm/cm/cm/degC] 
+0.50 
+CAPG [cal/cm/cm/cm/degC] 
+0.50 
+AKSR [cal/cm/sec/degC] 
+0.004 
+AKSB [cal/cm/sec/degC] 
+0.004 
+AKSG [cal/cm/sec/degC] 
+0.004 
+ALBR [-] 
+0.10 
+ALBB [-] 
+0.10 
+ALBG [-] 
+0.10 
+EPSR [-] 
+0.97 
+EPSB [-] 
+0.97 
+EPSG [-] 
+0.97 
+Z0R [m] 
+0.1 
+Z0B [m] 
+0.1 
+Z0G [m] 
+0.1 
+Z0HR [m] 
+0.1 
+Z0HB [m] 
+0.1 
+Z0HG [m] 
+0.1 
+Num_Roof_Layers [-] 
+4 
+Num_Wall_Layers [-] 
+4 
+Num_Road_Layers [-] 
+4 
+DDZR(1) [cm] 
+5. 
+DDZR(2) [cm] 
+5. 
+DDZR(3) [cm] 
+5. 
+DDZR(4) [cm] 
+5. 
+DDZB(1) [cm] 
+5. 
+DDZB(2) [cm] 
+5. 
+DDZB(3) [cm] 
+5. 
+DDZB(4) [cm] 
+5. 
+DDZG(1) [cm] 
+5. 
+DDZG(2) [cm] 
+25. 
+DDZG(3) [cm] 
+50. 
+DDZG(4) [cm] 
+75. 
+Lower Boundary Condition for Roof Layer Temp [1: Zero-Flux,  2: T = Constant] 
+1 
+Lower Boundary Condition for Wall Layer Temp [1: Zero-Flux,  2: T = Constant] 
+1 
+Lower Boundary Condition for Road Layer Temp [1: Zero-Flux,  2: T = Constant] 
+1 
+TRLEND [K] 
+300.15 
+TBLEND [K] 
+300.15 
+TGLEND [K] 
+300.15 
+Ch of Wall and Road [1: M-O Similarity Theory,  2: Empirical Form (recommend)] 
+2 
+Surface and Layer Temperatures [1: 4-layer model,  2: Force-Restore method] 
+1 
+ 
Index: trunk/WRF.COMMON/WRFV2/save_changes
===================================================================
--- trunk/WRF.COMMON/WRFV2/save_changes	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/save_changes	(revision 2744)
@@ -0,0 +1,42 @@
+#! /bin/bash
+
+\rm saved 2> /dev/null
+\rm -r save 2> /dev/null
+mkdir save
+
+cp configure.wrf* save/
+cp wash_away save/
+#cp makemeso save/
+cp save_changes save/
+cp *_save save/
+cp meso_*.h* save/
+cp mars.sed save/
+cp configure.defaults.* save/
+cp *.inc save/
+
+./dyn_em_save
+./external_save
+./mars_lmd_save
+./phys_save
+./Registry_save
+./share_save
+
+mkdir save/main
+cp -rf main/real_em.F save/main
+
+mkdir save/frame
+cp -rf frame/module_domain.F save/frame
+
+echo 'BACKUP info:' > saved
+echo '--------------' >> saved
+whoami >> saved
+date >> saved
+echo '--------------' >> saved
+
+tar -cvf sources_Mars.tar save >> saved
+ls -lh sources_Mars.tar
+
+gzip sources_Mars.tar
+ls -lh sources_Mars.tar.gz
+
+rm -rf save
Index: trunk/WRF.COMMON/WRFV2/share/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/Makefile	(revision 2744)
@@ -0,0 +1,317 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+MODULES =                       \
+	module_bc.o	        \
+	module_bc_time_utilities.o	\
+	module_io_wrf.o	        \
+	module_date_time.o	\
+	module_get_file_names.o	\
+	module_io_domain.o	\
+	module_model_constants.o \
+	module_MPP.o \
+	module_wrf_top.o \
+	module_optional_si_input.o	\
+	module_compute_geop.o           \
+	module_soil_pre.o 
+
+OBJS    = 		\
+	mediation_integrate.o		\
+	mediation_interp_domain.o	\
+	mediation_force_domain.o	\
+	mediation_feedback_domain.o	\
+        mediation_nest_move.o           \
+	mediation_wrfmain.o		\
+	solve_interface.o               \
+        start_domain.o                  \
+        init_modules.o                  \
+        set_timekeeping.o               \
+        interp_fcn.o sint.o             \
+        input_wrf.o                     \
+        output_wrf.o                    \
+        wrf_ext_write_field.o           \
+        wrf_ext_read_field.o            \
+        wrf_inputout.o        		\
+        wrf_auxinput1out.o		\
+        wrf_auxinput2out.o		\
+        wrf_auxinput3out.o		\
+        wrf_auxinput4out.o		\
+        wrf_auxinput5out.o		\
+        wrf_auxinput6out.o		\
+        wrf_auxinput7out.o		\
+        wrf_auxinput8out.o		\
+        wrf_auxinput9out.o		\
+        wrf_auxinput10out.o		\
+        wrf_auxinput11out.o		\
+        wrf_histout.o			\
+        wrf_auxhist1out.o		\
+        wrf_auxhist2out.o		\
+        wrf_auxhist3out.o		\
+        wrf_auxhist4out.o		\
+        wrf_auxhist5out.o		\
+        wrf_auxhist6out.o		\
+        wrf_auxhist7out.o		\
+        wrf_auxhist8out.o		\
+        wrf_auxhist9out.o		\
+        wrf_auxhist10out.o		\
+        wrf_auxhist11out.o		\
+        wrf_restartout.o		\
+        wrf_bdyout.o			\
+        wrf_inputin.o         	  	\
+        wrf_auxhist1in.o                \
+        wrf_auxhist2in.o                \
+        wrf_auxhist3in.o                \
+        wrf_auxhist4in.o                \
+        wrf_auxhist5in.o                \
+        wrf_auxhist6in.o                \
+        wrf_auxhist7in.o                \
+        wrf_auxhist8in.o                \
+        wrf_auxhist9in.o                \
+        wrf_auxhist10in.o                \
+        wrf_auxhist11in.o                \
+        wrf_auxinput1in.o               \
+        wrf_auxinput2in.o               \
+        wrf_auxinput3in.o               \
+        wrf_auxinput4in.o               \
+        wrf_auxinput5in.o               \
+        wrf_auxinput6in.o               \
+        wrf_auxinput7in.o               \
+        wrf_auxinput8in.o               \
+        wrf_auxinput9in.o               \
+        wrf_auxinput10in.o               \
+        wrf_auxinput11in.o               \
+	wrf_fddaobs_in.o		\
+        wrf_bdyin.o             	\
+        wrf_histin.o            	\
+        wrf_restartin.o                 \
+        landread.o
+
+
+NMM_MODULES = 
+
+
+LIBTARGET    =  shared
+TARGETDIR    =  ./
+$(LIBTARGET) :  $(MODULES) $(OBJS)
+		if [ $(WRF_NMM_CORE) -eq 1 ] ; then \
+                  $(MAKE) nmm_contrib                                      ; \
+                  $(AR) ../main/libwrflib.a $(MODULES) $(OBJS) $(NMM_OBJS) $(NMM_MODULES) ; \
+                  else                                                         \
+                  $(AR) ../main/libwrflib.a $(MODULES) $(OBJS)             ; \
+                fi
+
+include ../configure.wrf
+
+nmm_contrib : $(NMM_OBJS) $(NMM_MODULES)
+
+clean:
+	@ echo 'use the clean script'
+
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+solve_interface.o: solve_em.int ../frame/module_domain.o ../frame/module_configure.o \
+		../frame/module_timing.o ../frame/module_driver_constants.o \
+		../frame/module_wrf_error.o
+
+start_domain.o: start_domain_em.int ../frame/module_domain.o ../frame/module_configure.o
+
+module_bc.o: ../frame/module_configure.o ../frame/module_state_description.o \
+		../frame/module_wrf_error.o
+
+module_bc_time_utilities.o: $(ESMF_MOD_DEPENDENCE)
+
+module_get_file_names.o: 
+
+module_io_domain.o: module_io_wrf.o module_date_time.o ../frame/module_io.o  \
+		../frame/module_domain.o ../frame/module_configure.o \
+		../frame/module_state_description.o
+
+module_io_wrf.o: module_date_time.o module_bc_time_utilities.o \
+		../frame/module_wrf_error.o ../frame/module_domain.o \
+		../frame/module_state_description.o ../frame/module_configure.o \
+		../frame/module_io.o ../frame/module_timing.o \
+		$(ESMF_MOD_DEPENDENCE)
+
+output_wrf.o:   ../frame/module_io.o ../frame/module_wrf_error.o \
+                ../frame/module_domain.o ../frame/module_state_description.o \
+                ../frame/module_configure.o module_io_wrf.o  \
+		$(ESMF_MOD_DEPENDENCE)
+
+input_wrf.o:    ../frame/module_io.o ../frame/module_wrf_error.o \
+                ../frame/module_domain.o ../frame/module_state_description.o \
+                ../frame/module_configure.o module_io_wrf.o  \
+		$(ESMF_MOD_DEPENDENCE)
+
+wrf_ext_write_field.o : ../frame/module_io.o ../frame/module_wrf_error.o \
+                ../frame/module_domain.o ../frame/module_timing.o
+
+wrf_ext_read_field.o : ../frame/module_io.o ../frame/module_wrf_error.o \
+                ../frame/module_domain.o ../frame/module_timing.o
+
+module_date_time.o: ../frame/module_wrf_error.o ../frame/module_configure.o
+
+module_soil_pre.o: module_date_time.o ../frame/module_state_description.o
+
+module_optional_si_input.o: module_io_wrf.o module_io_domain.o \
+		../frame/module_domain.o ../frame/module_configure.o
+
+mediation_wrfmain.o: ../frame/module_domain.o ../frame/module_configure.o \
+		../frame/module_timing.o $(ESMF_MOD_DEPENDENCE) \
+		module_bc_time_utilities.o module_io_domain.o
+
+init_modules.o: ../frame/module_configure.o ../frame/module_driver_constants.o \
+		../frame/module_domain.o ../frame/module_machine.o \
+		../frame/module_nesting.o ../frame/module_timing.o \
+		../frame/module_tiles.o ../frame/module_io.o \
+		../frame/module_io_quilt.o ../frame/module_dm.o \
+		../external/io_int/io_int.o \
+		 module_io_wrf.o module_bc.o module_model_constants.o 
+
+interp_fcn.o: ../frame/module_timing.o ../frame/module_state_description.o ../frame/module_configure.o \
+		../frame/module_wrf_error.o
+
+mediation_feedback_domain.o: ../frame/module_domain.o ../frame/module_configure.o
+
+mediation_force_domain.o: ../frame/module_domain.o ../frame/module_configure.o
+
+mediation_integrate.o: ../frame/module_domain.o ../frame/module_configure.o \
+			../frame/module_timing.o \
+			$(ESMF_MOD_DEPENDENCE) \
+			module_date_time.o module_bc_time_utilities.o \
+			module_compute_geop.o                         \
+			module_io_domain.o
+
+
+mediation_interp_domain.o: ../frame/module_domain.o ../frame/module_configure.o \
+			../frame/module_timing.o
+
+mediation_nest_move.o: ../frame/module_domain.o ../frame/module_configure.o ../frame/module_state_description.o
+
+#mediation_conv_emissions.o: ../frame/module_domain.o ../frame/module_configure.o \
+#			../external/esmf_time_f90/ESMF_Mod.o \
+#			module_date_time.o module_bc_time_utilities.o \
+#			module_io_domain.o
+
+set_timekeeping.o: ../frame/module_domain.o ../frame/module_configure.o \
+                   $(ESMF_MOD_DEPENDENCE)
+
+module_wrf_top.o: ../frame/module_machine.o \
+                  ../frame/module_domain.o \
+                  ../frame/module_integrate.o \
+                  ../frame/module_driver_constants.o \
+                  ../frame/module_configure.o \
+                  ../frame/module_timing.o \
+                  ../frame/module_wrf_error.o \
+                  $(ESMF_MOD_DEPENDENCE)
+
+wrf_inputout.o                  : ../frame/module_domain.o \
+				../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o 
+wrf_auxinput1out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput2out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput3out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput4out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput5out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput6out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput7out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput8out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput9out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput10out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput11out.o              : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_histout.o                   : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist1out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist2out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist3out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist4out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist5out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist6out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist7out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist8out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist9out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist10out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist11out.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_restartout.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_bdyout.o                    : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_inputin.o                   : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist1in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist2in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist3in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist4in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist5in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist6in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist7in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist8in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist9in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist10in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxhist11in.o                : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput1in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput2in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput3in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput4in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput5in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput6in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput7in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput8in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput9in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput10in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_auxinput11in.o               : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_bdyin.o                     : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_histin.o                    : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+wrf_restartin.o                 : ../frame/module_domain.o \
+                                ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o
+
+
+# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV2/share/diff_mediation_integrate
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/diff_mediation_integrate	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/diff_mediation_integrate	(revision 2744)
@@ -0,0 +1,12 @@
+1955c1955
+<          tupdate = mod( time, (12. * 3600.) )
+---
+>          tupdate = mod( time, (12. * 3700.) )
+1997c1997
+<          WRITE( message, '(A,2F10.1)' ) ' HOURLY EMISSIONS UPDATE TIME ',time,mod(time,3600.)
+---
+>          WRITE( message, '(A,2F10.1)' ) ' HOURLY EMISSIONS UPDATE TIME ',time,mod(time,3700.)
+2001c2001
+<          IF ( ( mod( time, 3600. ) .LT. 0.001   ) .AND. &
+---
+>          IF ( ( mod( time, 3700. ) .LT. 0.001   ) .AND. &
Index: trunk/WRF.COMMON/WRFV2/share/diff_module_date_time
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/diff_module_date_time	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/diff_module_date_time	(revision 2744)
@@ -0,0 +1,424 @@
+24a25,53
+>     SUBROUTINE get_julgmt(date_str,julyr,julday,gmt)
+>       IMPLICIT NONE
+>  ! Arguments
+>       CHARACTER (LEN=24) , INTENT(IN) :: date_str
+>       INTEGER, INTENT(OUT  ) :: julyr
+>       INTEGER, INTENT(OUT  ) :: julday
+>       REAL   , INTENT(OUT  ) :: gmt
+>  ! Local
+>       INTEGER :: ny , nm , nd , nh , ni , ns , nt
+>       INTEGER :: my1, my2, my3, monss
+> !      INTEGER, DIMENSION(7) :: mmd
+> !      DATA MMD/99,99,99,99,99,99,75/
+>       INTEGER, DIMENSION(12) :: mmd
+>       DATA MMD/61,66,66,65,60,54,50,46,47,47,51,56/  !NB: like the GCM
+> !      DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
+>       CALL split_date_char ( date_str , ny , nm , nd , nh , ni , ns , nt )
+>       GMT=nh+FLOAT(ni)/37.+FLOAT(ns)/3700.
+> 
+> !      MY1=MOD(ny,4)
+> !      MY2=MOD(ny,100)
+> !      MY3=MOD(ny,400)
+> !      IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
+>       JULDAY=nd
+>       JULYR=ny
+>       DO MONSS=1,nm-1
+>         JULDAY=JULDAY+MMD(MONSS)
+>       ENDDO
+> ! on Mars, Julday is the number of elapsed sols (between 1 and 669)
+>     END SUBROUTINE get_julgmt
+26,49d54
+<    SUBROUTINE get_julgmt(date_str,julyr,julday,gmt)
+<      IMPLICIT NONE
+< ! Arguments
+<      CHARACTER (LEN=24) , INTENT(IN) :: date_str
+<      INTEGER, INTENT(OUT  ) :: julyr
+<      INTEGER, INTENT(OUT  ) :: julday
+<      REAL   , INTENT(OUT  ) :: gmt
+< ! Local
+<      INTEGER :: ny , nm , nd , nh , ni , ns , nt
+<      INTEGER :: my1, my2, my3, monss
+<      INTEGER, DIMENSION(12) :: mmd
+<      DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
+<      CALL split_date_char ( date_str , ny , nm , nd , nh , ni , ns , nt )
+<      GMT=nh+FLOAT(ni)/60.+FLOAT(ns)/3600.
+<      MY1=MOD(ny,4)
+<      MY2=MOD(ny,100)
+<      MY3=MOD(ny,400)
+<      IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
+<      JULDAY=nd
+<      JULYR=ny
+<      DO MONSS=1,nm-1
+<        JULDAY=JULDAY+MMD(MONSS)
+<      ENDDO
+<    END SUBROUTINE get_julgmt
+61,62c66,72
+<      INTEGER, DIMENSION(12) :: mmd
+<      DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
+---
+> !     INTEGER, DIMENSION(7) :: mmd
+> !!     DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
+> !     DATA MMD/99,99,99,99,99,99,75/
+>       INTEGER, DIMENSION(12) :: mmd
+> !****MARS
+>       DATA MMD/61,66,66,65,60,54,50,46,47,47,51,56/  
+> !****MARS
+64,68c74,82
+<      GMT=nh+FLOAT(ni)/60.+FLOAT(ns)/3600.
+<      MY1=MOD(ny,4)
+<      MY2=MOD(ny,100)
+<      MY3=MOD(ny,400)
+<      IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
+---
+>      GMT=nh+FLOAT(ni)/37.+FLOAT(ns)/3700.
+> !****MARS
+> !****MARS: heure + minutes/heure + secondes/heure
+> !****MARS
+> 
+> !     MY1=MOD(ny,4)
+> !     MY2=MOD(ny,100)
+> !     MY3=MOD(ny,400)
+> !     IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
+73a88
+> ! on Mars, Julday is the number of elapsed sols (between 1 and 669)
+88,89c103,107
+< 
+<     xtime = time/60.
+---
+> !****MARS
+>     xtime = time/100.   ! "Martian minutes ..."
+> !****MARS
+>     
+> ! get from the namelist ?
+93,94c111,114
+<     idt        = 86400*(julday-1)+nint(3600*gmt)
+<     write (mess,*) 'calc_current_date called: time = ',time,' idt = ',idt
+---
+> !****MARS
+> ! Martian version
+>     idt        = 88800*(julday-1)+nint(3700*gmt)
+>     write (mess,*) 'MARS calc_current_date called: time = ',time,' idt = ',idt
+96c116
+<     write (mess,*) 'calc_current_date called: gmt  = ',gmt
+---
+>     write (mess,*) 'MARS calc_current_date called: gmt  = ',gmt
+98c118
+<     write (mess,*) 'calc_current_date called: julyr  = ',julyr
+---
+>     write (mess,*) 'MARS calc_current_date called: julyr  = ',julyr
+100c120
+<     write (mess,*) 'calc_current_date called: julday = ',julday
+---
+>     write (mess,*) 'MARS calc_current_date called: julday = ',julday
+102c122,123
+<     base_date  = '0000-01-01_00:00:00.0000'
+---
+> !****MARS
+>     base_date  = '2000-01-01_00:00:00.0000'    !utilité ??
+164,176c185,199
+<       
+<       mday( 1) = 31
+<       mday( 2) = 28
+<       mday( 3) = 31
+<       mday( 4) = 30
+<       mday( 5) = 31
+<       mday( 6) = 30
+<       mday( 7) = 31
+<       mday( 8) = 31
+<       mday( 9) = 30
+<       mday(10) = 31
+<       mday(11) = 30
+<       mday(12) = 31
+---
+> 
+> ! months as defined in Martian ESMF routines
+>  
+>       mday( 1) = 61
+>       mday( 2) = 66
+>       mday( 3) = 66
+>       mday( 4) = 65
+>       mday( 5) = 60
+>       mday( 6) = 54
+>       mday( 7) = 50
+>       mday( 8) = 46
+>       mday( 9) = 47
+>       mday(10) = 47
+>       mday(11) = 51
+>       mday(12) = 56
+239c262
+<       IF (monew.ne.2) THEN
+---
+> !      IF (monew.ne.2) THEN
+245,251c268,274
+<       ELSE IF (monew.eq.2) THEN
+<       ! ...... For February
+<          IF ((dynew.GT.nfeb(yrnew)).OR.(dynew.LT.1)) THEN
+<             PRINT*, 'GETH_IDTS:  Day of NDATE = ', dynew
+<             npass = .false.
+<          END IF
+<       END IF
+---
+> !      ELSE IF (monew.eq.2) THEN
+> !      ! ...... For February
+> !         IF ((dynew.GT.nfeb(yrnew)).OR.(dynew.LT.1)) THEN
+> !            PRINT*, 'GETH_IDTS:  Day of NDATE = ', dynew
+> !            npass = .false.
+> !         END IF
+> !      END IF
+255c278
+<       IF (moold.ne.2) THEN
+---
+> !      IF (moold.ne.2) THEN
+261,267c284,290
+<       ELSE IF (moold.eq.2) THEN
+<       ! ....... For February
+<          IF ((dyold.GT.nfeb(yrold)).or.(dyold.LT.1)) THEN
+<             PRINT*, 'GETH_IDTS:  Day of ODATE = ', dyold
+<             opass = .false.
+<          END IF
+<       END IF
+---
+> !      ELSE IF (moold.eq.2) THEN
+> !      ! ....... For February
+> !         IF ((dyold.GT.nfeb(yrold)).or.(dyold.LT.1)) THEN
+> !            PRINT*, 'GETH_IDTS:  Day of ODATE = ', dyold
+> !            opass = .false.
+> !         END IF
+> !      END IF
+285c308
+<       IF ((minew.GT.59).or.(minew.LT.0)) THEN
+---
+>       IF ((minew.GT.36).or.(minew.LT.0)) THEN
+292c315
+<       IF ((miold.GT.59).or.(miold.LT.0)) THEN
+---
+>       IF ((miold.GT.36).or.(miold.LT.0)) THEN
+299c322
+<       IF ((scnew.GT.59).or.(scnew.LT.0)) THEN
+---
+>       IF ((scnew.GT.99).or.(scnew.LT.0)) THEN
+306c329
+<       IF ((scold.GT.59).or.(scold.LT.0)) THEN
+---
+>       IF ((scold.GT.99).or.(scold.LT.0)) THEN
+329c352,354
+<          newdys = newdys + (365 + (nfeb(i)-28))
+---
+> !         newdys = newdys + (365 + (nfeb(i)-28))
+> ! so cool to deal with a planet without any february month :)
+>          newdys = newdys + 669
+333c358
+<          mday(2) = nfeb(yrnew)
+---
+> !         mday(2) = nfeb(yrnew)
+337c362
+<          mday(2) = 28
+---
+> !         mday(2) = 28
+348c373
+<          mday(2) = nfeb(yrold)
+---
+> !         mday(2) = nfeb(yrold)
+352c377
+<          mday(2) = 28
+---
+> !         mday(2) = 28
+359,361c384,386
+<       idts = (newdys - olddys) * 86400
+<       idts = idts + (hrnew - hrold) * 3600
+<       idts = idts + (minew - miold) * 60
+---
+>       idts = (newdys - olddys) * 88800    !martian sols
+>       idts = idts + (hrnew - hrold) * 3700  !hours
+>       idts = idts + (minew - miold) * 100  !minutes
+426c451
+<       ! INTEGER, EXTERNAL :: nfeb  ! in the same module now
+---
+> !      INTEGER, EXTERNAL :: nfeb  ! in the same module now
+429,441c454,466
+<       
+<       mday( 1) = 31
+<       mday( 2) = 28
+<       mday( 3) = 31
+<       mday( 4) = 30
+<       mday( 5) = 31
+<       mday( 6) = 30
+<       mday( 7) = 31
+<       mday( 8) = 31
+<       mday( 9) = 30
+<       mday(10) = 31
+<       mday(11) = 30
+<       mday(12) = 31
+---
+> 
+>       mday( 1) = 61
+>       mday( 2) = 66
+>       mday( 3) = 66
+>       mday( 4) = 65
+>       mday( 5) = 60
+>       mday( 6) = 54
+>       mday( 7) = 50
+>       mday( 8) = 46
+>       mday( 9) = 47
+>       mday(10) = 47
+>       mday(11) = 51
+>       mday(12) = 56
+475c500
+<       !  Set the number of days in February for that year.
+---
+> !      !  Set the number of days in February for that year.
+477c502
+<       mday(2) = nfeb(yrold)
+---
+> !      mday(2) = nfeb(yrold)
+506c531
+<       IF ((miold.GT.59).or.(miold.LT.0)) THEN
+---
+>       IF ((miold.GT.36).or.(miold.LT.0)) THEN
+513c538
+<       IF ((scold.GT.59).or.(scold.LT.0)) THEN
+---
+>       IF ((scold.GT.99).or.(scold.LT.0)) THEN
+534,537c559,562
+<          nday   = ABS(idt)/(86400*ifrc)
+<          nhour  = MOD(ABS(idt),86400*ifrc)/(3600*ifrc)
+<          nmin   = MOD(ABS(idt),3600*ifrc)/(60*ifrc)
+<          nsec   = MOD(ABS(idt),60*ifrc)/(ifrc)
+---
+>          nday   = ABS(idt)/(88800*ifrc)
+>          nhour  = MOD(ABS(idt),88800*ifrc)/(3700*ifrc)
+>          nmin   = MOD(ABS(idt),3700*ifrc)/(100*ifrc)
+>          nsec   = MOD(ABS(idt),100*ifrc)/(ifrc)
+541,544c566,569
+<          nday   = ABS(idt)/86400 ! Integer number of days in delta-time
+<          nhour  = MOD(ABS(idt),86400)/3600
+<          nmin   = MOD(ABS(idt),3600)/60
+<          nsec   = MOD(ABS(idt),60)
+---
+>          nday   = ABS(idt)/88800 ! Integer number of days in delta-time
+>          nhour  = MOD(ABS(idt),88800)/3700
+>          nmin   = MOD(ABS(idt),3700)/100
+>          nsec   = MOD(ABS(idt),100)
+548,550c573,575
+<          nday   = ABS(idt)/1440 ! Integer number of days in delta-time
+<          nhour  = MOD(ABS(idt),1440)/60
+<          nmin   = MOD(ABS(idt),60)
+---
+>          nday   = ABS(idt)/2400 ! Integer number of days in delta-time
+>          nhour  = MOD(ABS(idt),2400)/100
+>          nmin   = MOD(ABS(idt),100)
+581,582c606,607
+<          IF (scnew .GE. 60) THEN
+<             scnew = scnew - 60
+---
+>          IF (scnew .GE. 100) THEN
+>             scnew = scnew - 100
+587,588c612,613
+<          IF (minew .GE. 60) THEN
+<             minew = minew - 60
+---
+>          IF (minew .GE. 37) THEN
+>             minew = minew - 37
+606c631
+<                IF (monew .GT. 12) THEN
+---
+>                IF (monew .GT. 7) THEN
+609,610c634,635
+<                   ! If the year changes, recompute the number of days in February
+<                   mday(2) = nfeb(yrnew)
+---
+>                   !! If the year changes, recompute the number of days in February
+>                   !mday(2) = nfeb(yrnew)
+625c650
+<             scnew = scnew + 60
+---
+>             scnew = scnew + 100
+631c656
+<             minew = minew + 60
+---
+>             minew = minew + 37
+651,652c676,677
+<                   ! If the year changes, recompute the number of days in February
+<                   mday(2) = nfeb(yrnew)
+---
+>                   !! If the year changes, recompute the number of days in February
+>                   !mday(2) = nfeb(yrnew)
+693,713c718,742
+<    FUNCTION nfeb ( year ) RESULT (num_days)
+<    
+<       ! Compute the number of days in February for the given year
+<    
+<       IMPLICIT NONE
+<    
+<       INTEGER :: year
+<       INTEGER :: num_days
+<    
+<       num_days = 28 ! By default, February has 28 days ...
+<       IF (MOD(year,4).eq.0) THEN  
+<          num_days = 29  ! But every four years, it has 29 days ...
+<          IF (MOD(year,100).eq.0) THEN
+<             num_days = 28  ! Except every 100 years, when it has 28 days ...
+<             IF (MOD(year,400).eq.0) THEN
+<                num_days = 29  ! Except every 400 years, when it has 29 days.
+<             END IF
+<          END IF
+<       END IF
+<    
+<    END FUNCTION nfeb
+---
+> !   FUNCTION nfeb ( year ) RESULT (num_days)
+> !   
+> !      ! Compute the number of days in February for the given year
+> !   
+> !      IMPLICIT NONE
+> !   
+> !      INTEGER :: year
+> !      INTEGER :: num_days
+> ! 
+> !        num_days = 99999
+> !        PRINT *, 'WARNING !'  
+> !! normally never called ...        
+> !  
+> !!      num_days = 28 ! By default, February has 28 days ...
+> !!      IF (MOD(year,4).eq.0) THEN  
+> !!         num_days = 29  ! But every four years, it has 29 days ...
+> !!         IF (MOD(year,100).eq.0) THEN
+> !!            num_days = 28  ! Except every 100 years, when it has 28 days ...
+> !!            IF (MOD(year,400).eq.0) THEN
+> !!               num_days = 29  ! Except every 400 years, when it has 29 days.
+> !!            END IF
+> !!         END IF
+> !!      END IF
+> !   
+> !   END FUNCTION nfeb
+795c824
+<       INTEGER strlen, rc
+---
+>       INTEGER strlen,rc
+797,801c826,830
+<       ! Assertion
+<       IF ( LEN(str) < 19 ) THEN
+<         CALL wrf_error_fatal( 'wrf_timetoa:  str is too short' )
+<       ENDIF
+<       tmpstr = ''
+---
+>        ! Assertion
+>        IF ( LEN(str) < 19 ) THEN
+>          CALL wrf_error_fatal( 'wrf_timetoa:  str is too short' )
+>        ENDIF
+>        tmpstr = ''
+807c836
+<       ! change ISO 8601 'T' to WRF '_' and hack off fraction if str is not 
+---
+>       ! change ISO 8601 'T' to WRF '_' and hack off fraction if str is not
+820c849
+<    ! Converts an WRFU_TimeInterval object into a time-interval string.  
+---
+>    ! Converts an WRFU_TimeInterval object into a time-interval string.
+838a868
+> 
+864c894
+<         CALL wrf_timeinttoa( timeStep, timeStep_str )
+---
+> 	CALL wrf_timeinttoa( timeStep, timeStep_str )
Index: trunk/WRF.COMMON/WRFV2/share/diff_module_model_constants
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/diff_module_model_constants	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/diff_module_model_constants	(revision 2744)
@@ -0,0 +1,100 @@
+2a3
+> !PLANET MARS
+17c18
+<    REAL    , PARAMETER :: g = 9.81  ! acceleration due to gravity (m {s}^-2)
+---
+>    REAL    , PARAMETER :: g = 3.72  ! acceleration due to gravity (m {s}^-2)
+20,21c21,22
+<    REAL    , PARAMETER :: r_d          = 287.04
+<    REAL    , PARAMETER :: cp           = 1004.6
+---
+>    REAL    , PARAMETER :: r_d          = 192.  ! gas constant m2 s-2 K-1
+>    REAL    , PARAMETER :: cp           = 844.6   ! r= 8.314511E+0 *1000.E+0/mugaz
+23,24c24,25
+<    REAL    , PARAMETER :: r_d          = 287.
+<    REAL    , PARAMETER :: cp           = 7.*r_d/2.
+---
+>    REAL    , PARAMETER :: r_d          = 192.
+>    REAL    , PARAMETER :: cp           = 844.6
+27c28
+<    REAL    , PARAMETER :: r_v          = 461.6
+---
+>    REAL    , PARAMETER :: r_v          = 461.6  ! gas constant for water vapor
+29c30
+<    REAL    , PARAMETER :: cpv          = 4.*r_v
+---
+>    REAL    , PARAMETER :: cpv          = 4.4*r_v  ! cp / R = 4.4 ?? ! rcp = r/cp  ~0.256793
+40,42c41,43
+<    REAL    , PARAMETER :: p1000mb      = 100000.
+<    REAL    , PARAMETER :: t0           = 300.
+<    REAL    , PARAMETER :: p0           = p1000mb
+---
+>    REAL    , PARAMETER :: p1000mb      = 610.
+>    REAL    , PARAMETER :: t0           = 220. ! earth : 300 ... à remplacer par 220 ?
+>    REAL    , PARAMETER :: p0           = 610.
+47c48
+<    REAL    , PARAMETER :: reradius     = 1./6370.0e03 
+---
+>    REAL    , PARAMETER :: reradius     = 1./3397200	! Rayon de mars (m)  ~3397200 m
+49,50c50,78
+<    REAL    , PARAMETER :: asselin      = .025
+< !   REAL    , PARAMETER :: asselin      = .0
+---
+> !-------------------------------
+> !****MARS
+> ! here some LMD stuff
+> ! >> TODO: possible modification with startfi.nc values ?
+>    REAL    , PARAMETER :: wdaysec       = 88800.     ! duree du sol (s)  ~88775 s
+>    REAL    , PARAMETER :: wmugaz        = 43.49      ! Masse molaire de l'atm (g.mol-1) ~43.49
+>    REAL    , PARAMETER :: womeg         = 7.0721E-5  ! omega (rad.s-1)
+>    REAL    , PARAMETER :: wyear_day     = 669        ! Duree de l'annee (sols) ~668.6
+>    REAL    , PARAMETER :: wperiheli     = 206.66     ! Dist.min. soleil-mars (Mkm) ~206.66      
+>    REAL    , PARAMETER :: waphelie      = 249.22     ! Dist.max. soleil-mars (Mkm) ~249.22
+>    REAL    , PARAMETER :: wperi_day     = 485.       ! Date du perihelie (sols depuis printemps)
+>    REAL    , PARAMETER :: wobliquit     = 25.2       ! Obliquite de la planete (deg) ~25.2
+>    REAL    , PARAMETER :: wz0           = 1.e-2      ! surface roughness (m) ~0.01
+>    REAL    , PARAMETER :: wlmixmin      = 30         ! longueur de melange ~100
+>    REAL    , PARAMETER :: wemin_turb    = 1.e-6      ! energie minimale ~1.e-8 
+>    REAL    , PARAMETER :: wemissiv      = 0.95       ! Emissivite du sol martien ~.95
+>    REAL    , PARAMETER :: wemissiceN    = 0.95       ! Emissivite calotte nord
+>    REAL    , PARAMETER :: wemissiceS    = 0.95       ! Emissivite calotte sud
+>    REAL    , PARAMETER :: walbediceN    = 0.65        ! Albedo calotte nord !0.5
+>    REAL    , PARAMETER :: walbediceS    = 0.65        ! Albedo calotte sud  !0.5
+>    REAL    , PARAMETER :: wiceradiusN   = 100.e-6    ! mean scat radius of CO2 snow (north)
+>    REAL    , PARAMETER :: wiceradiusS   = 100.e-6    ! mean scat radius of CO2 snow (south)
+>    REAL    , PARAMETER :: wdtemisiceN   = 0.4  ! time scale for snow metamorphism (north) !2  
+>    REAL    , PARAMETER :: wdtemisiceS   = 0.4  ! time scale for snow metamorphism (south) !2 
+> !
+> !-------------------------------
+> 
+> !   REAL    , PARAMETER :: asselin      = .025
+>    REAL    , PARAMETER :: asselin      = .0
+64,65c92,93
+<    REAL    , PARAMETER :: rhoair0      = 1.28
+< 
+---
+>    REAL    , PARAMETER :: rhoair0      = 0.02   !Earth Surface density: 1.217 kg/m3
+>                                                 !Mars Surface density: 0.020 kg/m3
+67c95
+<    REAL    , PARAMETER :: DPD          = 360./365.
+---
+>    REAL    , PARAMETER :: DPD          = 360./669. ! longitude solaire d'un jour?
+75,77c103,105
+<    REAL    , PARAMETER ::  KARMAN=0.4
+<    REAL    , PARAMETER ::  EOMEG=7.2921E-5
+<    REAL    , PARAMETER ::  STBOLT=5.67051E-8
+---
+>    REAL    , PARAMETER ::  KARMAN=0.4  ! von karman constant 
+>    REAL    , PARAMETER ::  EOMEG=7.0721E-5 ! angular rotation rate (rad.s-1)
+>    REAL    , PARAMETER ::  STBOLT=5.67051E-8 ! stefan-boltzmann constant
+89c117,118
+< !      REAL , PARAMETER ::  epsq2=0.02
+---
+> !try both ?
+> !       REAL , PARAMETER ::  epsq2=0.02
+106a136
+> !       REAL , PARAMETER ::  fcm=0.003
+107a138
+> !       REAL , PARAMETER ::  fcm=0.0
+127a159
+> !       REAL , PARAMETER ::  z0max=0.01
Index: trunk/WRF.COMMON/WRFV2/share/init_modules.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/init_modules.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/init_modules.F	(revision 2744)
@@ -0,0 +1,90 @@
+!WRF:MEDIATION_LAYER
+!
+SUBROUTINE init_modules( phase )
+ USE module_bc
+ USE module_configure
+ USE module_driver_constants
+ USE module_model_constants
+ USE module_domain
+ USE module_machine
+ USE module_nesting
+ USE module_timing
+ USE module_tiles
+ USE module_io_wrf
+ USE module_io
+#ifdef DM_PARALLEL
+ USE module_wrf_quilt
+ USE module_dm
+#endif
+#ifdef INTIO
+ USE module_ext_internal
+#endif
+
+! <DESCRIPTION>
+! This routine USES the modules in WRF and then calls the init routines
+! they provide to perform module specific initializations at the
+! beginning of a run.  Note, this is only once per run, not once per
+! domain; domain specific initializations should be handled elsewhere,
+! such as in <a href=start_domain.html>start_domain</a>.
+! 
+! Certain framework specific module initializations in this file are
+! dependent on order they are called. For example, since the quilt module
+! relies on internal I/O, the init routine for internal I/O must be
+! called first.  In the case of DM_PARALLEL compiles, the quilt module
+! calls MPI_INIT as part of setting up and dividing communicators between
+! compute and I/O server tasks.  Therefore, it must be called prior to
+! module_dm, which will <em>also</em> try to call MPI_INIT if it sees
+! that MPI has not be initialized yet (implementations of module_dm
+! should in fact behave this way by first calling MPI_INITIALIZED before
+! they try to call MPI_INIT).  If MPI is already initialized before the
+! the quilting module is called, quilting will not work.
+! 
+! The phase argument is used to allow other superstructures like ESMF to 
+! place their initialization calls following the WRF initialization call 
+! that calls MPI_INIT().  When used with ESMF, ESMF will call wrf_init() 
+! which in turn will call phase 2 of this routine.  Phase 1 will be called 
+! earlier.  
+!
+! </DESCRIPTION>
+
+ INTEGER, INTENT(IN) :: phase    ! phase==1 means return after MPI_INIT()
+                                 ! phase==2 means resume after MPI_INIT()
+
+IF ( phase == 1 ) THEN
+ CALL init_module_bc
+ CALL init_module_configure
+ CALL init_module_driver_constants
+ CALL init_module_model_constants
+ CALL init_module_domain
+ CALL init_module_machine
+
+#ifdef INTIO
+ CALL init_module_ext_internal  !! must be called before quilt
+#endif
+#ifdef DM_PARALLEL
+ CALL init_module_wrf_quilt    !! this *must* be called before init_module_dm
+ CALL init_module_dm
+#endif
+ELSE
+ CALL init_module_nesting
+ CALL init_module_timing
+ CALL init_module_tiles
+ CALL init_module_io_wrf
+ CALL init_module_io
+
+! core specific initializations -- add new cores here
+#if (EM_CORE == 1)
+#  if ( DA_CORE != 1)
+ CALL init_modules_em
+#  endif
+#endif
+#if (NMM_CORE == 1)
+ CALL init_modules_nmm
+#endif
+#if (COAMPS_CORE == 1)
+ CALL init_modules_coamps
+#endif
+ENDIF
+ 
+END SUBROUTINE init_modules
+
Index: trunk/WRF.COMMON/WRFV2/share/input_wrf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/input_wrf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/input_wrf.F	(revision 2744)
@@ -0,0 +1,555 @@
+!WRF:MEDIATION:IO
+!  ---principal wrf input routine (called from routines in module_io_domain ) 
+
+  SUBROUTINE input_wrf ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess, currtimestr
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    Type(WRFU_Time) time, currtime
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    CHARACTER*80  fname
+    LOGICAL dryrun
+    INTEGER idt
+    INTEGER itmp
+    INTEGER dyn_opt_tmp, dyn_opt, filestate, ierr3
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    REAL , DIMENSION(16) :: lats16 , lons16
+    CHARACTER (len=19) simulation_start_date
+    INTEGER simulation_start_year   , &
+            simulation_start_month  , &
+            simulation_start_day    , &
+            simulation_start_hour   , &
+            simulation_start_minute , &
+            simulation_start_second
+    REAL dx_compare , dy_compare , dum
+
+!<DESCRIPTION>
+!
+! Core wrf input routine for all input data streams. Part of mediation layer.
+! 
+! Note that WRF IOAPI routines wrf_get_dom_ti_*() do not return values during 
+! training reads (dryrun).  
+! 
+!</DESCRIPTION>
+
+    WRITE(wrf_err_message,*)'input_wrf: begin, fid = ',fid
+    CALL wrf_debug( 300 , wrf_err_message )
+
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+! simulation start time is a Singleton maintained by head_grid
+    IF ( ( switch .EQ.     model_input_only  ) .OR. &
+         ( switch .EQ.          restart_only ) ) THEN
+      CALL wrf_get_dom_ti_char ( fid , 'SIMULATION_START_DATE' , simulation_start_date , ierr )
+      IF ( ierr .EQ. 0 ) THEN
+        ! Overwrite simulation start date with metadata.  
+        READ ( simulation_start_date , fmt = '(I4,1x,I2,1x,I2,1x,I2,1x,I2,1x,I2)' ) &
+               simulation_start_year,   simulation_start_month,                     &
+               simulation_start_day,    simulation_start_hour,                      &
+               simulation_start_minute, simulation_start_second
+        CALL nl_set_simulation_start_year   ( 1 , simulation_start_year   )
+        CALL nl_set_simulation_start_month  ( 1 , simulation_start_month  )
+        CALL nl_set_simulation_start_day    ( 1 , simulation_start_day    )
+        CALL nl_set_simulation_start_hour   ( 1 , simulation_start_hour   )
+        CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
+        CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
+        IF ( switch .EQ. model_input_only  ) THEN
+          WRITE(wrf_err_message,*)fid,' input_wrf, model_input_only:  SIMULATION_START_DATE = ', &
+                                  simulation_start_date(1:19)
+          CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
+        ELSE IF ( switch .EQ. restart_only  ) THEN
+          WRITE(wrf_err_message,*)fid,' input_wrf, restart_only:  SIMULATION_START_DATE = ', &
+                                  simulation_start_date(1:19)
+          CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
+        ENDIF
+      ELSE
+        CALL nl_get_start_year   ( 1 , simulation_start_year   )
+        CALL nl_get_start_month  ( 1 , simulation_start_month  )
+        CALL nl_get_start_day    ( 1 , simulation_start_day    )
+        CALL nl_get_start_hour   ( 1 , simulation_start_hour   )
+        CALL nl_get_start_minute ( 1 , simulation_start_minute )
+        CALL nl_get_start_second ( 1 , simulation_start_second )
+        CALL nl_set_simulation_start_year   ( 1 , simulation_start_year   )
+        CALL nl_set_simulation_start_month  ( 1 , simulation_start_month  )
+        CALL nl_set_simulation_start_day    ( 1 , simulation_start_day    )
+        CALL nl_set_simulation_start_hour   ( 1 , simulation_start_hour   )
+        CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
+        CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
+        CALL wrf_message('input_wrf: SIMULATION_START_DATE not available in input')
+        CALL wrf_message('will use head_grid start time from namelist') 
+      ENDIF
+      ! Initialize derived time quantity in grid%xtime.  
+      ! Note that this call is also made in setup_timekeeping().  
+      ! Ugh, what a hack.  Simplify all this later...  
+      CALL domain_clock_get( grid, minutesSinceSimulationStart=grid%xtime )
+      ! Note that it is NOT necessary to reset grid%julian here.  
+      WRITE(wrf_err_message,*) 'input_wrf:  set xtime to ',grid%xtime
+      CALL wrf_debug ( 100, TRIM(wrf_err_message) )
+    ENDIF
+
+#if (EM_CORE == 1)
+
+    !  Test to make sure that the input data is the right size.  Do this for input from real/ideal into
+    !  WRF, and from the standard initialization into real.
+
+    IF ( ( switch .EQ.     model_input_only  ) .OR. &
+         ( switch .EQ. aux_model_input1_only ) ) THEN
+       ierr = 0
+       CALL wrf_get_dom_ti_integer ( fid , 'WEST-EAST_GRID_DIMENSION' ,    ide_compare , 1 , icnt , ierr3 ) 
+       ierr = max( ierr, ierr3 )
+       CALL wrf_get_dom_ti_integer ( fid , 'SOUTH-NORTH_GRID_DIMENSION' ,  jde_compare , 1 , icnt , ierr3 ) 
+       ierr = max( ierr, ierr3 )
+       CALL wrf_get_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMENSION' ,   kde_compare , 1 , icnt , ierr3 ) 
+       ierr = max( ierr, ierr3 )
+!      IF ( ierr3 .NE. 0 ) CALL wrf_error_fatal( 'wrf_get_dom_ti_integer getting dimension information from dataset' )
+       IF ( ierr3 .NE. 0 ) CALL wrf_debug( 'wrf_get_dom_ti_integer getting dimension information from dataset' )
+   
+       !  Test to make sure that the grid distances are the right size.
+   
+       CALL wrf_get_dom_ti_real ( fid , 'DX' ,  dx_compare , 1 , icnt , ierr )
+       CALL wrf_get_dom_ti_real ( fid , 'DY' ,  dy_compare , 1 , icnt , ierr )
+       IF ( ( ABS ( dx_compare - config_flags%dx ) .GT. 1.E-5 * dx_compare ) .OR. &
+            ( ABS ( dy_compare - config_flags%dy ) .GT. 1.E-5 * dy_compare ) ) THEN
+print *,'dx_compare,dy_compare = ',dx_compare,dy_compare
+          CALL wrf_error_fatal( 'DX and DY do not match from the namelist and the input file' )
+       END IF
+    END IF
+
+    ! do the check later (see check_if_dryrun below)
+
+#endif
+
+
+    CALL nl_get_dyn_opt( 1, dyn_opt )
+    CALL wrf_get_dom_ti_integer ( fid, 'DYN_OPT', dyn_opt_tmp, 1, icnt, ierr )
+
+    !  We do not want the CEN_LAT LON values from the boundary file.  For 1-way nests
+    !  with ndown, this ends up being the data from the previous coarse domain.
+
+    IF ( switch .NE. boundary_only ) THEN
+       CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' ,  config_flags%cen_lat , 1 , icnt , ierr )
+       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',config_flags%cen_lat
+       CALL wrf_debug ( 300 , wrf_err_message )
+       CALL nl_set_cen_lat ( grid%id , config_flags%cen_lat )
+
+       CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' ,  config_flags%cen_lon , 1 , icnt , ierr )
+       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',config_flags%cen_lon
+       CALL wrf_debug ( 300 , wrf_err_message )
+       CALL nl_set_cen_lon ( grid%id , config_flags%cen_lon )
+    ELSE
+       CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' ,  dum , 1 , icnt , ierr )
+       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',dum
+       CALL wrf_debug ( 300 , wrf_err_message )
+
+       CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' ,  dum , 1 , icnt , ierr )
+       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',dum
+       CALL wrf_debug ( 300 , wrf_err_message )
+    END IF
+
+    CALL wrf_get_dom_ti_real ( fid , 'TRUELAT1' ,  config_flags%truelat1 , 1 , icnt , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT1 returns ',config_flags%truelat1
+    CALL wrf_debug ( 300 , wrf_err_message )
+    CALL nl_set_truelat1 ( grid%id , config_flags%truelat1 )
+
+    CALL wrf_get_dom_ti_real ( fid , 'TRUELAT2' ,  config_flags%truelat2 , 1 , icnt , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT2 returns ',config_flags%truelat2
+    CALL wrf_debug ( 300 , wrf_err_message )
+    CALL nl_set_truelat2 ( grid%id , config_flags%truelat2 )
+
+    CALL wrf_get_dom_ti_real ( fid , 'MOAD_CEN_LAT' ,  config_flags%moad_cen_lat , 1 , icnt , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for MOAD_CEN_LAT returns ',config_flags%moad_cen_lat
+    CALL wrf_debug ( 300 , wrf_err_message )
+    CALL nl_set_moad_cen_lat ( grid%id , config_flags%moad_cen_lat )
+
+    CALL wrf_get_dom_ti_real ( fid , 'STAND_LON' ,  config_flags%stand_lon , 1 , icnt , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for STAND_LON returns ',config_flags%stand_lon
+    CALL wrf_debug ( 300 , wrf_err_message )
+    CALL nl_set_stand_lon ( grid%id , config_flags%stand_lon )
+
+#if ( NMM_CORE != 1 )
+    IF ( program_name(1:7) .EQ. "REAL_EM" ) THEN
+    CALL wrf_get_dom_ti_real ( fid , 'corner_lats' ,  lats16 , 16 , icnt , ierr )
+    WRITE(wrf_err_message,FMT='(A,16f6.1)')'input_wrf: wrf_get_dom_ti_real for CORNER_LATS returns ',lats16
+    CALL wrf_debug ( 300 , wrf_err_message )
+    grid%em_lat_ll_t = lats16( 1)
+    grid%em_lat_ul_t = lats16( 2)
+    grid%em_lat_ur_t = lats16( 3)
+    grid%em_lat_lr_t = lats16( 4)
+    grid%em_lat_ll_u = lats16( 5)
+    grid%em_lat_ul_u = lats16( 6)
+    grid%em_lat_ur_u = lats16( 7)
+    grid%em_lat_lr_u = lats16( 8)
+    grid%em_lat_ll_v = lats16( 9)
+    grid%em_lat_ul_v = lats16(10)
+    grid%em_lat_ur_v = lats16(11)
+    grid%em_lat_lr_v = lats16(12)
+    grid%em_lat_ll_d = lats16(13)
+    grid%em_lat_ul_d = lats16(14)
+    grid%em_lat_ur_d = lats16(15)
+    grid%em_lat_lr_d = lats16(16)
+
+    CALL wrf_get_dom_ti_real ( fid , 'corner_lons' ,  lons16 , 16 , icnt , ierr )
+    WRITE(wrf_err_message,FMT='(A,16f6.1)')'input_wrf: wrf_get_dom_ti_real for CORNER_LONS returns ',lons16
+    CALL wrf_debug ( 300 , wrf_err_message )
+    grid%em_lon_ll_t = lons16( 1)
+    grid%em_lon_ul_t = lons16( 2)
+    grid%em_lon_ur_t = lons16( 3)
+    grid%em_lon_lr_t = lons16( 4)
+    grid%em_lon_ll_u = lons16( 5)
+    grid%em_lon_ul_u = lons16( 6)
+    grid%em_lon_ur_u = lons16( 7)
+    grid%em_lon_lr_u = lons16( 8)
+    grid%em_lon_ll_v = lons16( 9)
+    grid%em_lon_ul_v = lons16(10)
+    grid%em_lon_ur_v = lons16(11)
+    grid%em_lon_lr_v = lons16(12)
+    grid%em_lon_ll_d = lons16(13)
+    grid%em_lon_ul_d = lons16(14)
+    grid%em_lon_ur_d = lons16(15)
+    grid%em_lon_lr_d = lons16(16)
+    ENDIF
+#endif
+
+#if ( NMM_CORE != 1 )
+! program_name is defined in module_domain and set in the main program for whatever application
+! is using subroutine input_wrf (that is, the subroutine you are looking at here). Data files
+! written by SI have P_TOP as a metadata item; the real program and wrf model have it as a 
+! state variable. This test is to supress non-fatal but confusing messages from the model complaining
+! that P_TOP cannot be read from the metadata for this dataset.  JM 20040905
+!
+! Note, P_TOP is not defined in the NMM core.
+
+    IF ( program_name(1:7) .EQ. "REAL_EM" ) THEN
+      CALL wrf_get_dom_ti_real ( fid , 'P_TOP' ,  grid%p_top , 1 , icnt , ierr )
+      WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for P_TOP returns ',grid%p_top
+      CALL wrf_debug ( 300 , wrf_err_message )
+    ENDIF
+#endif
+
+    IF ( switch .NE. boundary_only ) THEN
+      CALL wrf_get_dom_ti_real ( fid , 'GMT' ,  config_flags%gmt , 1 , icnt , ierr )
+      WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for GMT returns ',config_flags%gmt
+      CALL wrf_debug ( 300 , wrf_err_message )
+      CALL nl_set_gmt ( grid%id , config_flags%gmt )
+
+      CALL wrf_get_dom_ti_integer ( fid , 'JULYR' ,  config_flags%julyr , 1 , icnt , ierr )
+      WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULYR returns ',config_flags%julyr
+      CALL wrf_debug ( 300 , wrf_err_message )
+      CALL nl_set_julyr ( grid%id , config_flags%julyr )
+
+      CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' ,  config_flags%julday , 1 , icnt , ierr )
+      WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULDAY returns ',config_flags%julday
+      CALL wrf_debug ( 300 , wrf_err_message )
+      CALL nl_set_julday ( grid%id , config_flags%julday )
+    ENDIF
+
+    CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' ,  config_flags%map_proj , 1 , icnt , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for MAP_PROJ returns ',config_flags%map_proj
+    CALL wrf_debug ( 300 , wrf_err_message )
+    CALL nl_set_map_proj ( grid%id , config_flags%map_proj )
+
+    CALL wrf_get_dom_ti_char ( fid , 'MMINLU', mminlu , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_char for MMINLU returns ',mminlu(1:4)
+    CALL wrf_debug ( 300 , wrf_err_message )
+    CALL nl_set_mminlu ( 1, mminlu(1:4) )
+
+    CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' ,  config_flags%iswater , 1 , icnt , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISWATER returns ',config_flags%iswater
+    CALL wrf_debug ( 300 , wrf_err_message )
+    IF ( ierr .NE. 0 ) THEN
+         IF (mminlu == 'UMD') THEN
+              config_flags%iswater = 14
+         ELSE 
+              config_flags%iswater = 16 
+         ENDIF
+    ENDIF
+    CALL nl_set_iswater ( grid%id , config_flags%iswater )
+
+    CALL wrf_get_dom_ti_integer ( fid , 'ISICE' ,  config_flags%isice , 1 , icnt , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISICE returns ',config_flags%isice
+    CALL wrf_debug ( 300 , wrf_err_message )
+    IF ( ierr .NE.  0 ) THEN
+         IF (mminlu == 'UMD') THEN
+              config_flags%isice = 14
+         ELSE
+              config_flags%isice = 24
+         ENDIF
+    ENDIF
+    CALL nl_set_isice ( grid%id , config_flags%isice )
+
+    CALL wrf_get_dom_ti_integer ( fid , 'ISURBAN' ,  config_flags%isurban , 1 , icnt , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISURBAN returns ',config_flags%isurban
+    CALL wrf_debug ( 300 , wrf_err_message )
+    IF ( ierr .NE. 0 ) THEN
+         IF (mminlu == 'UMD') THEN
+              config_flags%isurban = 13
+         ELSE
+              config_flags%isurban = 1
+         ENDIF
+    ENDIF
+    CALL nl_set_isurban ( grid%id , config_flags%isurban )
+
+    CALL wrf_get_dom_ti_integer ( fid , 'ISOILWATER' ,  config_flags%isoilwater , 1 , icnt , ierr )
+    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISOILWATER returns ',config_flags%isoilwater
+    CALL wrf_debug ( 300 , wrf_err_message )
+    IF ( ierr .NE. 0 ) THEN
+         config_flags%isoilwater = 14
+    ENDIF
+    CALL nl_set_isoilwater ( grid%id , config_flags%isoilwater )
+
+#ifdef MOVE_NESTS
+! Added these fields for restarting of moving nests, JM
+! DANGER and TODO
+! It is very important that these be set correctly if they are set at all in here.
+! Garbage values will produce unpredictable results, possibly segfaults, in the nesting
+! code. Need some integrity checking here or elsewhere in the code to at least check to
+! make sure that the istart and jstart values make sense with respect to the nest dimensions
+! and the position in the parent domain.
+    CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' ,  itmp  , 1 , icnt, ierr )
+    IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
+      config_flags%i_parent_start = itmp
+      CALL nl_set_i_parent_start ( grid%id , config_flags%i_parent_start )
+    ENDIF
+    CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' ,  itmp  , 1 , icnt, ierr )
+    IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
+      config_flags%j_parent_start = itmp
+      CALL nl_set_j_parent_start ( grid%id , config_flags%j_parent_start )
+    ENDIF
+#endif
+
+! If this was not a training read (dry run) check for erroneous values.  
+    CALL wrf_inquire_filename ( fid , fname , filestate , ierr )
+    IF ( ierr /= 0 ) THEN
+      WRITE(wrf_err_message,*)'module_io_wrf: input_wrf: wrf_inquire_filename Status = ',ierr
+      CALL wrf_error_fatal( wrf_err_message )
+    ENDIF
+
+    WRITE(wrf_err_message,*)'input_wrf: fid,filestate = ',fid,filestate
+    CALL wrf_debug( 300 , wrf_err_message )
+
+    dryrun        = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+
+    WRITE(wrf_err_message,*)'input_wrf: dryrun = ',dryrun
+    CALL wrf_debug( 300 , wrf_err_message )
+
+    check_if_dryrun : IF ( .NOT. dryrun ) THEN
+
+#if (EM_CORE == 1)
+
+!KLUDGE - is there a more elegant way to determine "old si" input
+    IF      ( ( switch .EQ.     model_input_only  ) .OR. &
+            ( ( switch .EQ. aux_model_input1_only ) .AND. &
+              ( config_flags%auxinput1_inname(1:8) .EQ. 'wrf_real' ) ) ) THEN
+
+       !  Test to make sure that the input data is the right size.
+
+       IF ( ( ide .NE. ide_compare    ) .OR. &
+            ( kde .NE. kde_compare    ) .OR. &
+            ( jde .NE. jde_compare    ) ) THEN
+! a hack for sure
+#ifndef ESMFIO
+          WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  namelist ide,jde,kde=',ide,jde,kde,&
+                                  '; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
+          CALL wrf_error_fatal( wrf_err_message )
+#else
+          WRITE(wrf_err_message,*)'DEBUG input_wrf.F switch = ',switch, &
+                                  ': namelist ide,jde,kde=',ide,jde,kde,&
+                                  '; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
+          CALL wrf_debug( 100, wrf_err_message )
+#endif
+       ENDIF
+
+    ELSE IF ( switch .EQ. aux_model_input1_only ) THEN
+
+       !  Test to make sure that the input data is the right size.
+       
+       IF ( ( ide                             .NE. ide_compare ) .OR. &
+            ( config_flags%num_metgrid_levels .NE. kde_compare ) .OR. &
+            ( jde                             .NE. jde_compare ) ) THEN
+         WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  ',&
+                                 'namelist ide,jde,num_metgrid_levels=',ide,jde,config_flags%num_metgrid_levels,&
+                                 '; input data ide,jde,num_metgrid_levels=',ide_compare , jde_compare , kde_compare
+         CALL wrf_error_fatal( wrf_err_message )
+       ENDIF
+    ENDIF
+
+#endif
+
+    IF ( dyn_opt_tmp .NE. dyn_opt .AND. switch .EQ. model_input_only ) THEN
+      WRITE(wrf_err_message,*)'input_wrf: dyn_opt in file ',dyn_opt_tmp,' NE namelist ',dyn_opt
+      CALL wrf_error_fatal( wrf_err_message )
+    ENDIF
+
+    ENDIF check_if_dryrun 
+
+!
+! This call to wrf_get_next_time will position the dataset over the next time-frame
+! in the file and return the current_date, which is used as an argument to the
+! read_field routines in the blocks of code included below.  Note that we read the
+! next time *after* all the meta data has been read. This is only important for the
+! WRF internal I/O format because it is order-dependent. Other formats shouldn't care
+! about this.
+!
+
+    3003 continue
+
+    CALL wrf_get_next_time(fid, current_date , ierr)
+    WRITE(wrf_err_message,*)fid,' input_wrf: wrf_get_next_time current_date: ',current_date(1:19),' Status = ',ierr
+    CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
+    IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ ) THEN 
+      CALL wrf_message ( TRIM(wrf_err_message ) )
+      IF ( switch .EQ. boundary_only ) THEN
+        WRITE(wrf_err_message,*) ' ... May have run out of valid boundary conditions in file ',TRIM(fname)
+        CALL wrf_error_fatal( TRIM(wrf_err_message) )
+      ELSE
+#if ( NMM_CORE != 1 )
+        WRITE(wrf_err_message,*) '... Could not find matching time in input file ',TRIM(fname)
+        CALL wrf_error_fatal( TRIM(wrf_err_message) )
+#endif
+      ENDIF
+    ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ) THEN 
+!
+! check input time against domain time (which will be start time at beginning, see share/set_timekeeping.F)
+! JM 20040511
+!
+      SELECT CASE ( switch )
+        CASE ( model_input_only, aux_model_input1_only, aux_model_input2_only,       &
+               aux_model_input3_only, aux_model_input4_only, aux_model_input5_only )
+            CALL wrf_atotime( current_date(1:19), time )
+            CALL domain_clock_get( grid, current_time=currtime, &
+                                         current_timestr=currtimestr )
+            CALL domain_clockprint(150, grid, &
+                   'DEBUG input_wrf():  get CurrTime from clock,')
+            IF ( time .NE. currtime ) THEN
+                WRITE( wrf_err_message , * )'Time in file: ',trim( current_date(1:19) )
+                CALL wrf_message ( trim(wrf_err_message) )
+                WRITE( wrf_err_message , * )'Time on domain: ',trim( currtimestr )
+                CALL wrf_message ( trim(wrf_err_message) )
+                CALL wrf_message( "**WARNING** Time in input file not equal to time on domain **WARNING**" )
+                WRITE(wrf_err_message,*) "**WARNING** Trying next time in file ",TRIM(fname)," ..."
+                CALL wrf_message( TRIM(wrf_err_message) )
+                GOTO 3003
+            ENDIF
+        CASE DEFAULT
+      END SELECT
+    ENDIF
+
+! set the lbc time interval fields in the domain data structure
+! these time values are checked as stopping condition for the while loop in 
+! latbound_in() defined in share/medation_integrate.F, which is used to
+! iterate forward to the correct interval in the input LBC file
+! 
+    IF ( switch .EQ. boundary_only ) THEN
+        CALL wrf_get_dom_td_char ( fid , 'THISBDYTIME' ,  current_date(1:19), this_datestr , ierr )
+        CALL wrf_atotime( this_datestr(1:19), grid%this_bdy_time )
+        CALL wrf_get_dom_td_char ( fid , 'NEXTBDYTIME' ,  current_date(1:19), next_datestr , ierr )
+        CALL wrf_atotime( next_datestr(1:19), grid%next_bdy_time )
+    ENDIF
+
+#if 1
+    IF      ( switch .EQ. model_input_only ) THEN
+      CALL wrf_inputin( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. history_only ) THEN
+      CALL wrf_histin( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input1_only ) THEN
+      CALL wrf_auxinput1in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input2_only ) THEN
+      CALL wrf_auxinput2in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input3_only ) THEN
+      CALL wrf_auxinput3in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input4_only ) THEN
+      CALL wrf_auxinput4in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input5_only ) THEN
+      CALL wrf_auxinput5in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input6_only ) THEN
+      CALL wrf_auxinput6in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input7_only ) THEN
+      CALL wrf_auxinput7in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input8_only ) THEN
+      CALL wrf_auxinput8in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input9_only ) THEN
+      CALL wrf_auxinput9in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input10_only ) THEN
+      CALL wrf_auxinput10in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_model_input11_only ) THEN
+      CALL wrf_auxinput11in( fid , grid , config_flags , switch , ierr )
+
+
+    ELSE IF ( switch .EQ. aux_hist1_only ) THEN
+      CALL wrf_auxhist1in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist2_only ) THEN
+      CALL wrf_auxhist2in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist3_only ) THEN
+      CALL wrf_auxhist3in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist4_only ) THEN
+      CALL wrf_auxhist4in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist5_only ) THEN
+      CALL wrf_auxhist5in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist6_only ) THEN
+      CALL wrf_auxhist6in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist7_only ) THEN
+      CALL wrf_auxhist7in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist8_only ) THEN
+      CALL wrf_auxhist8in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist9_only ) THEN
+      CALL wrf_auxhist9in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist10_only ) THEN
+      CALL wrf_auxhist10in( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. aux_hist11_only ) THEN
+      CALL wrf_auxhist11in( fid , grid , config_flags , switch , ierr )
+
+    ELSE IF ( switch .EQ. restart_only ) THEN
+      CALL wrf_restartin( fid , grid , config_flags , switch , ierr )
+    ELSE IF ( switch .EQ. boundary_only ) THEN
+      CALL wrf_bdyin( fid , grid , config_flags , switch , ierr )
+    ENDIF
+#else
+    CALL wrf_message ( "ALL I/O DISABLED IN share/module_io_wrf.F")
+#endif
+
+    WRITE(wrf_err_message,*)'input_wrf: end, fid = ',fid
+    CALL wrf_debug( 300 , wrf_err_message )
+
+    RETURN
+  END SUBROUTINE input_wrf
Index: trunk/WRF.COMMON/WRFV2/share/interp_fcn.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/interp_fcn.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/interp_fcn.F	(revision 2744)
@@ -0,0 +1,5189 @@
+!WRF:MEDIATION_LAYER:INTERPOLATIONFUNCTION
+!
+
+#define MM5_SINT
+!#define DUMBCOPY
+
+#if ( NMM_CORE == 1 )
+!=======================================================================================
+!  E grid interpolation for mass with addition of terrain adjustments. First routine
+!  pertains to initial conditions and the next one corresponds to boundary conditions 
+!  This is gopal's doing
+!=======================================================================================
+
+ SUBROUTINE interp_mass_nmm (cfld,                                 &  ! CD field
+                             cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nfld,                                 &  ! ND field
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             shw,                                  &  ! stencil half width for interp
+                             imask,                                &  ! interpolation mask
+                             xstag, ystag,                         &  ! staggering of field
+                             ipos, jpos,                           &  ! Position of lower left of nest in CD
+                             nri, nrj,                             &  ! nest ratios                         
+                             CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! south-western grid locs and weights 
+                             CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                             CBWGT4, HBWGT4,                       &  ! dummys for weights
+                             CZ3d, Z3d,                            &  ! Z3d interpolated from CZ3d
+                             CFIS,FIS,                             &  ! CFIS dummy on fine domain
+                             CSM,SM,                               &  ! CSM is dummy
+                             CPDTOP,PDTOP,                         &
+                             CPTOP,PTOP,                           &
+                             CPSTD,PSTD,                           &
+                             CKZMAX,KZMAX                          ) 
+
+   USE MODULE_MODEL_CONSTANTS
+   USE module_timing
+   IMPLICIT NONE
+
+   LOGICAL,INTENT(IN) :: xstag, ystag
+   INTEGER,INTENT(IN) :: ckzmax,kzmax 
+   INTEGER,INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                         cims, cime, ckms, ckme, cjms, cjme,   &
+                         cits, cite, ckts, ckte, cjts, cjte,   &
+                         nids, nide, nkds, nkde, njds, njde,   &
+                         nims, nime, nkms, nkme, njms, njme,   &
+                         nits, nite, nkts, nkte, njts, njte,   &
+                         shw,ipos,jpos,nri,nrj               
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),          INTENT(IN)           :: IMASK
+
+!  parent domain
+
+   INTEGER,DIMENSION(cims:cime,cjms:cjme),          INTENT(IN)           :: CII,CJJ     ! dummy
+   REAL,DIMENSION(cims:cime,cjms:cjme),             INTENT(IN)           :: CBWGT1,CBWGT2,CBWGT3
+   REAL,DIMENSION(cims:cime,cjms:cjme),             INTENT(IN)           :: CBWGT4,CFIS,CSM
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme),   INTENT(IN)           :: CFLD
+   REAL,DIMENSION(cims:cime,1:KZMAX,cjms:cjme ),INTENT(IN)               :: CZ3d
+   REAL,DIMENSION(1:KZMAX),                     INTENT(IN)               :: CPSTD
+   REAL,INTENT(IN)                                                       :: CPDTOP,CPTOP
+
+!  nested domain
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),          INTENT(IN)           :: IIH,JJH
+   REAL,DIMENSION(nims:nime,njms:njme),             INTENT(IN)           :: HBWGT1,HBWGT2,HBWGT3
+   REAL,DIMENSION(nims:nime,njms:njme),             INTENT(IN)           :: HBWGT4
+   REAL,DIMENSION(nims:nime,njms:njme),             INTENT(IN)           :: FIS,SM
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme),   INTENT(INOUT)        :: NFLD
+   REAL,DIMENSION(1:KZMAX),                                   INTENT(IN) :: PSTD
+   REAL,DIMENSION(nims:nime,1:KZMAX,njms:njme ),INTENT(OUT)              :: Z3d
+   REAL,INTENT(IN)                                                       :: PDTOP,PTOP
+
+!  local
+
+   INTEGER,PARAMETER                                          :: JTB=134
+   REAL, PARAMETER                                            :: LAPSR=6.5E-3,GI=1./G, D608=0.608
+   REAL, PARAMETER                                            :: COEF3=R_D*GI*LAPSR
+   INTEGER                                                    :: I,J,K,IDUM
+   REAL                                                       :: dlnpdz,tvout,pmo
+   REAL,DIMENSION(nims:nime,njms:njme)                        :: ZS,DUM2d 
+   REAL,DIMENSION(JTB)                                        :: PIN,ZIN,Y2,PIO,ZOUT,DUM1,DUM2 
+!-----------------------------------------------------------------------------------------------------
+!
+!*** CHECK DOMAIN BOUNDS BEFORE INTERPOLATION
+!
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+     DO I=NITS,MIN(NITE,NIDE-1)
+       IF(IIH(i,j).LT.(CIDS-shw) .OR. IIH(i,j).GT.(CIDE+shw)) &
+           CALL wrf_error_fatal ('mass points:check domain bounds along x' )
+       IF(JJH(i,j).LT.(CJDS-shw) .OR. JJH(i,j).GT.(CJDE+shw)) &
+           CALL wrf_error_fatal ('mass points:check domain bounds along y' )
+     ENDDO
+    ENDDO
+
+    IF(KZMAX .GT. (JTB-10)) &
+        CALL wrf_error_fatal ('mass points: increase JTB in interp_mass_nmm')
+
+!    WRITE(21,*)'------------- MED NEST INITIAL 1 ----------------'
+!    DO J=NJTS,MIN(NJTE,NJDE-1)
+!      DO I=NITS,MIN(NITE,NIDE-1)
+!         WRITE(21,*)I,J,IMASK(I,J),NFLD(I,1,J)
+!      ENDDO
+!    ENDDO
+!    WRITE(21,*)
+
+!
+!*** DEFINE LOCAL TOPOGRAPHY ON THE BASIS OF FIS. ALSO CHECK IF SM IS LAND (SM=0) OVER TOPO
+!*** YOU DON'T WANT MOUNTAINS INSIDE WATER BODIES! 
+!
+
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+      DO I=NITS,MIN(NITE,NIDE-1)
+         ZS(I,J)=FIS(I,J)/G
+      ENDDO
+    ENDDO
+
+!
+!*** Interpolate GPMs DERIVED FROM STANDARD ATMOSPHERIC LAPSE RATE FROM THE PARENT TO
+!*** THE NESTED DOMAIN
+!
+!*** INDEX CONVENTIONS
+!***                     HBWGT4
+!***                      4
+!***
+!***
+!***
+!***                   h
+!***             1                 2
+!***            HBWGT1             HBWGT2
+!***
+!***
+!***                      3
+!***                     HBWGT3
+
+    Z3d=0.0
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+      DO K=NKTS,KZMAX                ! Please note that we are still in isobaric surfaces 
+        DO I=NITS,MIN(NITE,NIDE-1)
+!
+           IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+               Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                          + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                          + HBWGT3(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                          + HBWGT4(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)+1)
+           ELSE
+               Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                          + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                          + HBWGT3(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                          + HBWGT4(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+           ENDIF  
+!
+        ENDDO
+      ENDDO
+    ENDDO
+
+!  RECONSTRUCT PDs ON THE BASIS OF TOPOGRAPHY AND THE INTERPOLATED HEIGHTS
+
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+      DO I=NITS,MIN(NITE,NIDE-1)
+!
+          IF (ZS(I,J) .LT. Z3d(I,1,J)) THEN
+            dlnpdz     = (log(PSTD(1))-log(PSTD(2)) )/(Z3d(i,1,j)-Z3d(i,2,j))
+            dum2d(i,j) = exp(log(PSTD(1)) + dlnpdz*(ZS(I,J) - Z3d(i,1,j)))
+            dum2d(i,j) = dum2d(i,j) - PDTOP -PTOP
+            IF(J==10)WRITE(0,*)I,J,K,ZS(I,J),Z3d(I,K,J),Z3d(I,K+1,J),dum2d(i,j),PDTOP,PTOP
+          ELSE                                           ! target level bounded by input levels
+            DO K =NKTS,KZMAX-1                           ! still in the isobaric surfaces
+             IF(ZS(I,J) .GE. Z3d(I,K,J) .AND. ZS(I,J) .LT. Z3d(i,K+1,j))THEN
+               dlnpdz     = (log(PSTD(K))-log(PSTD(K+1)) ) /(Z3d(i,K,j)-Z3d(i,K+1,j))
+               dum2d(i,j) = exp(log(PSTD(K)) + dlnpdz*(ZS(I,J)- Z3d(i,K,j)))
+               dum2d(i,j) = dum2d(i,j) - PDTOP -PTOP
+!              IF(I==1)WRITE(0,*)I,J,K,ZS(I,J),Z3d(I,K,J),Z3d(I,K+1,J),dum2d(i,j),PDTOP,PTOP
+             ENDIF
+            ENDDO
+          ENDIF
+          IF(ZS(I,J) .GE. Z3d(I,KZMAX,J))THEN
+             WRITE(0,*)'I=',I,'J=',J,'K=',KZMAX,'TERRAIN HEIGHT',ZS(I,J),'Z3d',Z3d(I,KZMAX,J)
+             CALL wrf_error_fatal3 ( "interp_fcn.b" , 176 , "MOUNTAIN TOO HIGH TO FIT THE MODEL DEPTH")
+          ENDIF
+!       
+      ENDDO
+    ENDDO
+
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+      DO K=NKDS,NKDE                       ! NKTE is 1, nevertheless let us pretend religious 
+       DO I=NITS,MIN(NITE,NIDE-1)
+         IF(IMASK(I,J) .NE. 1)THEN
+           NFLD(I,K,J)= dum2d(i,j)         ! PD defined in the nested domain
+         ENDIF
+       ENDDO
+      ENDDO
+    ENDDO
+
+!
+  END SUBROUTINE interp_mass_nmm 
+!
+!--------------------------------------------------------------------------------------
+
+ SUBROUTINE nmm_bdymass_hinterp ( cfld,                              &  ! CD field
+                               cids, cide, ckds, ckde, cjds, cjde,   &
+                               cims, cime, ckms, ckme, cjms, cjme,   &
+                               cits, cite, ckts, ckte, cjts, cjte,   &
+                               nfld,                                 &  ! ND field
+                               nids, nide, nkds, nkde, njds, njde,   &
+                               nims, nime, nkms, nkme, njms, njme,   &
+                               nits, nite, nkts, nkte, njts, njte,   &
+                               shw,                                  &  ! stencil half width
+                               imask,                                &  ! interpolation mask
+                               xstag, ystag,                         &  ! staggering of field
+                               ipos, jpos,                           &  ! Position of lower left of nest in CD
+                               nri, nrj,                             &  ! nest ratios
+                               cbdy, nbdy,                           &
+                               cbdy_t, nbdy_t,                       &
+                               cdt, ndt,                             &
+                               CTEMP_B,NTEMP_B,                      &  ! These temp arrays should be removed
+                               CTEMP_BT,NTEMP_BT,                    &  ! later on
+                               CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! south-western grid locs and weights
+                               CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                               CBWGT4, HBWGT4,                       &  ! dummys
+                               CZ3d, Z3d,                            &  ! Z3d dummy on nested domain
+                               CFIS,FIS,                             &  ! CFIS dummy on fine domain
+                               CSM,SM,                               &  ! CSM is dummy
+                               CPDTOP,PDTOP,                         &
+                               CPTOP,PTOP,                           &
+                               CPSTD,PSTD,                           &
+                               CKZMAX,KZMAX                          ) 
+
+
+     USE module_configure
+     USE module_wrf_error
+
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: ckzmax,kzmax
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+
+
+   REAL, INTENT(INOUT)                                                :: cdt, ndt
+
+   REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: ctemp_b,ctemp_bt
+   REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(OUT) :: ntemp_b,ntemp_bt
+   LOGICAL, INTENT(IN) :: xstag, ystag
+   REAL,  DIMENSION( * ), INTENT(INOUT) :: cbdy, cbdy_t, nbdy, nbdy_t
+
+!  parent domain
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),          INTENT(IN)           :: IMASK
+   INTEGER,DIMENSION(cims:cime,cjms:cjme),          INTENT(IN)           :: CII,CJJ     ! dummy
+   REAL,DIMENSION(cims:cime,cjms:cjme),             INTENT(IN)           :: CBWGT1,CBWGT2,CBWGT3
+   REAL,DIMENSION(cims:cime,cjms:cjme),             INTENT(IN)           :: CBWGT4,CFIS,CSM
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme),   INTENT(IN)           :: CFLD
+   REAL,DIMENSION(cims:cime,1:KZMAX,cjms:cjme ),    INTENT(IN)           :: CZ3d
+   REAL,DIMENSION(1:KZMAX),                         INTENT(IN)           :: CPSTD
+   REAL,INTENT(IN)                                                       :: CPDTOP,CPTOP
+
+!  nested domain
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),          INTENT(IN)           :: IIH,JJH
+   REAL,DIMENSION(nims:nime,njms:njme),             INTENT(IN)           :: HBWGT1,HBWGT2,HBWGT3
+   REAL,DIMENSION(nims:nime,njms:njme),             INTENT(IN)           :: HBWGT4
+   REAL,DIMENSION(nims:nime,njms:njme),             INTENT(IN)           :: FIS,SM
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme),   INTENT(INOUT)        :: NFLD
+   REAL,DIMENSION(1:KZMAX),                         INTENT(IN)           :: PSTD
+   REAL,DIMENSION(nims:nime,1:KZMAX,njms:njme ),INTENT(OUT)              :: Z3d
+   REAL,INTENT(IN)                                                       :: PDTOP,PTOP
+
+! Local
+
+     INTEGER                                     :: nijds, nijde, spec_bdy_width,i,j,k
+     REAL                                        :: dlnpdz,dum2d
+     REAL,DIMENSION(nims:nime,njms:njme)         :: zs
+
+     nijds = min(nids, njds)
+     nijde = max(nide, njde)
+     CALL nl_get_spec_bdy_width( 1, spec_bdy_width )
+
+
+     CALL nmm_bdymass_interp1( cfld,                             &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nijds, nijde , spec_bdy_width ,       &  
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw, imask,                           &
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &
+                           cdt, ndt,                             &
+                           CTEMP_B,NTEMP_B,                      &  ! These temp arrays should be removed
+                           CTEMP_BT,NTEMP_BT,                    &  ! later on
+                           CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! south-western grid locs and weights
+                           CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                           CBWGT4, HBWGT4,                       &  ! dummys
+                           CZ3d, Z3d,                            &  ! Z3d dummy on nested domain
+                           CFIS,FIS,                             &  ! CFIS dummy on fine domain
+                           CSM,SM,                               &  ! CSM is dummy
+                           CPDTOP,PDTOP,                         &
+                           CPTOP,PTOP,                           &
+                           CPSTD,PSTD,                           &
+                           CKZMAX,KZMAX                          ) 
+
+    RETURN
+
+   END SUBROUTINE nmm_bdymass_hinterp 
+!
+!---------------------------------------------------------------------
+!
+   SUBROUTINE nmm_bdymass_interp1( cfld,                                 &  ! CD field 
+                                   cids, cide, ckds, ckde, cjds, cjde,   &
+                                   cims, cime, ckms, ckme, cjms, cjme,   &
+                                   cits, cite, ckts, ckte, cjts, cjte,   &
+                                   nfld,                                 &  ! ND field
+                                   nijds, nijde, spec_bdy_width ,        &
+                                   nids, nide, nkds, nkde, njds, njde,   &
+                                   nims, nime, nkms, nkme, njms, njme,   &
+                                   nits, nite, nkts, nkte, njts, njte,   &
+                                   shw1,                                 &
+                                   imask,                                & ! interpolation mask
+                                   xstag, ystag,                         & ! staggering of field
+                                   ipos, jpos,                           & ! lower left of nest in CD
+                                   nri, nrj,                             &
+                                   cdt, ndt,                             &
+                                   CTEMP_B,NTEMP_B,                      &  ! to be removed 
+                                   CTEMP_BT,NTEMP_BT,                    &  ! later on
+                                   CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! SW grid locs and weights
+                                   CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones 
+                                   CBWGT4, HBWGT4,                       &  ! are just  dummys
+                                   CZ3d, Z3d,                            &  ! Z3d dummy on nested domain
+                                   CFIS,FIS,                             &  ! CFIS dummy on fine domain
+                                   CSM,SM,                               &  ! CSM is dummy
+                                   CPDTOP,PDTOP,                         &
+                                   CPTOP,PTOP,                           &
+                                   CPSTD,PSTD,                           & 
+                                   CKZMAX,KZMAX                          )                       
+
+   USE MODULE_MODEL_CONSTANTS
+   use module_state_description
+   IMPLICIT NONE
+
+   INTEGER, INTENT(IN) :: ckzmax,kzmax
+   INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                          cims, cime, ckms, ckme, cjms, cjme,   &
+                          cits, cite, ckts, ckte, cjts, cjte,   &
+                          nids, nide, nkds, nkde, njds, njde,   &
+                          nims, nime, nkms, nkme, njms, njme,   &
+                          nits, nite, nkts, nkte, njts, njte,   &
+                          shw1, ipos, jpos, nri, nrj
+
+   INTEGER, INTENT(IN) :: nijds, nijde, spec_bdy_width
+   LOGICAL, INTENT(IN) :: xstag, ystag
+
+   REAL, INTENT(INOUT)                                                :: cdt, ndt
+   REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: ctemp_b,ctemp_bt
+   REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(OUT) :: ntemp_b,ntemp_bt
+
+!  parent domain
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),          INTENT(IN)           :: IMASK
+   INTEGER,DIMENSION(cims:cime,cjms:cjme),          INTENT(IN)           :: CII,CJJ     ! dummy
+   REAL,DIMENSION(cims:cime,cjms:cjme),             INTENT(IN)           :: CBWGT1,CBWGT2,CBWGT3
+   REAL,DIMENSION(cims:cime,cjms:cjme),             INTENT(IN)           :: CBWGT4,CFIS,CSM
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme),   INTENT(IN)           :: CFLD
+   REAL,DIMENSION(cims:cime,1:KZMAX,cjms:cjme ),INTENT(IN)               :: CZ3d
+   REAL,DIMENSION(1:KZMAX),                     INTENT(IN)               :: CPSTD
+   REAL,INTENT(IN)                                                       :: CPDTOP,CPTOP
+
+!  nested domain
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),          INTENT(IN)           :: IIH,JJH
+   REAL,DIMENSION(nims:nime,njms:njme),             INTENT(IN)           :: HBWGT1,HBWGT2,HBWGT3
+   REAL,DIMENSION(nims:nime,njms:njme),             INTENT(IN)           :: HBWGT4
+   REAL,DIMENSION(nims:nime,njms:njme),             INTENT(IN)           :: FIS,SM
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme),   INTENT(INOUT)        :: NFLD
+   REAL,DIMENSION(1:KZMAX),                         INTENT(IN)           :: PSTD
+   REAL,DIMENSION(nims:nime,1:KZMAX,njms:njme ),INTENT(OUT)              :: Z3d
+   REAL,INTENT(IN)                                                       :: PDTOP,PTOP
+
+! local
+
+  INTEGER,PARAMETER                                                :: JTB=134
+  INTEGER                                                          :: i,j,k,ii,jj
+  REAL                                                             :: dlnpdz,dum2d
+  REAL, DIMENSION (nims:nime,njms:njme)                            :: zs
+  REAL, DIMENSION (nims:nime,njms:njme)                            :: CWK1,CWK2,CWK3,CWK4 
+
+!
+!*** DEFINE LOCAL TOPOGRAPHY ON THE BASIS OF FIS. ASLO CHECK IF SM IS LAND (SM=0) OVER TOPO
+!*** YOU DON'T WANT MOUNTAINS INSIDE WATER BODIES!
+!
+
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+      DO I=NITS,MIN(NITE,NIDE-1)
+         ZS(I,J)=FIS(I,J)/G
+      ENDDO
+    ENDDO
+
+!    X start boundary
+
+       NMM_XS: IF(NITS .EQ. NIDS)THEN
+!      WRITE(0,*)'ENTERING X1 START BOUNDARY AT MASS POINTS',NJTS,MIN(NJTE,NJDE-1)
+        I = NIDS
+
+        DO J = NJTS,MIN(NJTE,NJDE-1)
+          DO K=NKTS,KZMAX
+            IF(MOD(JJH(I,J),2) .NE. 0)THEN      ! 1,3,5,7 of the parent domain
+              Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                         + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                         + HBWGT3(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                         + HBWGT4(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)+1)
+            ELSE
+              Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                         + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                         + HBWGT3(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                         + HBWGT4(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+!
+!            IF(J==13 .AND. K==1)WRITE(0,*)IIH(I,J),IIH(I,J)+1,JJH(I,J)-1,JJH(I,J),JJH(I,J)+1
+!            IF(J==13 .AND. K==1)WRITE(0,*)HBWGT1(I,J),HBWGT2(I,J),HBWGT3(I,J),HBWGT4(I,J),  &
+!                                CZ3d(IIH(I,J),  K,  JJH(I,J)  ),                   &
+!                                CZ3d(IIH(I,J)+1,K,  JJH(I,J)  ),                   &
+!                                CZ3d(IIH(I,J),  K,  JJH(I,J)-1),                   &
+!                                CZ3d(IIH(I,J),  K,  JJH(I,J)+1)
+!
+            ENDIF
+          END DO
+        END DO
+
+        DO J = NJTS,MIN(NJTE,NJDE-1)
+          IF(MOD(J,2) .NE. 0)THEN
+            IF (ZS(I,J) .LT. Z3d(I,2,J)) THEN              ! level 2 has to be changed
+               dlnpdz     = (log(PSTD(1))-log(PSTD(2)) )/(Z3d(i,1,j)-Z3d(i,2,j))
+               dum2d      = exp(log(PSTD(1)) + dlnpdz*(ZS(I,J) - Z3d(i,1,j)))
+               CWK1(I,J)  = dum2d -PDTOP -PTOP
+!               WRITE(0,*)I,J,ZS(I,J),Z3d(i,1,j),Z3d(i,2,j),CWK1(I,J)
+            ELSE ! target level bounded by input levels
+              DO K =NKTS,KZMAX-1
+               IF(ZS(I,J) .GE. Z3d(i,K,j) .AND. ZS(I,J) .LT. Z3d(i,K+1,j))THEN
+                 dlnpdz     = (log(PSTD(K))-log(PSTD(K+1)) ) /(Z3d(i,K,j)-Z3d(i,K+1,j))
+                 dum2d      = exp(log(PSTD(K)) + dlnpdz*(ZS(I,J)- Z3d(i,K,j)))
+                 CWK1(I,J)  = dum2d -PDTOP -PTOP
+!                 WRITE(0,*)I,J,ZS(I,J),Z3d(i,K,j),Z3d(i,K+1,j),CWK1(I,J)
+               ENDIF
+              ENDDO
+            ENDIF
+            IF(ZS(I,J) .GE. Z3d(I,KZMAX,J))THEN
+               WRITE(0,*)'I=',I,'J=',J,'K=',K,'TERRAIN HEIGHT',ZS(I,J),'Z3d',Z3d(I,KZMAX,J) 
+               CALL wrf_error_fatal("BC:MOUNTAIN TOO HIGH TO FIT THE MODEL DEPTH")
+            ENDIF           
+          ELSE
+           CWK1(I,J)=0.
+          ENDIF
+        ENDDO
+
+        DO J = NJTS,MIN(NJTE,NJDE-1)
+         DO K = NKDS,NKDE
+           ntemp_b(i,k,j)     = CWK1(I,J) 
+           ntemp_bt(i,k,j)    = 0.0
+!          bdy(J,K,I,P_XSB)   = CWK1(I,J)         ! This will not work for NMM since 
+!          bdy_t(J,K,I,P_XSB) = 0.0               ! NMM requires BC halo exchanges
+         END DO
+        END DO
+       ENDIF NMM_XS
+
+!    X end boundary
+
+       NMM_XE: IF(NITE-1 .EQ. NIDE-1)THEN
+!       WRITE(0,*)'ENTERING X END BOUNDARY AT MASS POINTS',NJTS,MIN(NJTE,NJDE-1)
+       I = NIDE-1
+       II = NIDE - I
+
+       DO J=NJTS,MIN(NJTE,NJDE-1)
+         DO K=NKTS,KZMAX
+             IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+                 Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                            + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                            + HBWGT3(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                            + HBWGT4(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)+1)
+
+!                IF(J==151)WRITE(0,*)'CRASH1',K,HBWGT1(I,J),HBWGT2(I,J),HBWGT3(I,J),HBWGT4(I,J)
+!                IF(J==151)WRITE(0,*)'CRASH2',K,Z3d(I,K,J),CZ3d(IIH(I,J),  K,  JJH(I,J)  ),  &
+!                                     CZ3d(IIH(I,J)+1,K,  JJH(I,J)  ),                      &
+!                                     CZ3d(IIH(I,J),  K,  JJH(I,J)-1),                      &
+!                                     CZ3d(IIH(I,J),  K,  JJH(I,J)+1)
+             ELSE
+                 Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                            + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                            + HBWGT3(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                            + HBWGT4(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+!                 IF(J==151)WRITE(0,*)'CRASH3',K,HBWGT1(I,J),HBWGT2(I,J),HBWGT3(I,J),HBWGT4(I,J)
+!                 IF(J==151)WRITE(0,*)'CRASH4',K,Z3d(I,K,J),CZ3d(IIH(I,J),  K,  JJH(I,J)  ), &
+!                           CZ3d(IIH(I,J)+1,K,  JJH(I,J)  ), CZ3d(IIH(I,J)+1,K,  JJH(I,J)-1), &
+!                           CZ3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+             ENDIF
+         ENDDO
+       ENDDO
+
+        DO J = NJTS,MIN(NJTE,NJDE-1)
+          IF(MOD(J,2) .NE.0)THEN                ! 1,3,5,7 of nested domain
+            IF (ZS(I,J) .LT. Z3d(I,2,J)) THEN              ! level 2 has to be changed
+               dlnpdz     = (log(PSTD(1))-log(PSTD(2)) )/(Z3d(i,1,j)-Z3d(i,2,j))
+               dum2d      = exp(log(PSTD(1)) + dlnpdz*(ZS(I,J) - Z3d(i,1,j)))
+               CWK2(I,J)  = dum2d -PDTOP -PTOP
+!               WRITE(0,*)I,J,ZS(I,J),Z3d(i,1,j),Z3d(i,2,j),CWK2(I,J)
+            ELSE ! target level bounded by input levels
+              DO K =NKTS,KZMAX-1
+               IF(ZS(I,J) .GE. Z3d(i,K,j) .AND. ZS(I,J) .LT. Z3d(i,K+1,j))THEN
+                 dlnpdz     = (log(PSTD(K))-log(PSTD(K+1)) ) /(Z3d(i,K,j)-Z3d(i,K+1,j))
+                 dum2d      = exp(log(PSTD(K)) + dlnpdz*(ZS(I,J)- Z3d(i,K,j)))
+                 CWK2(I,J)  = dum2d -PDTOP -PTOP
+!                 WRITE(0,*)I,J,ZS(I,J),Z3d(i,K,j),Z3d(i,K+1,j),CWK2(I,J)
+               ENDIF
+              ENDDO
+            ENDIF
+            IF(ZS(I,J) .GE. Z3d(I,KZMAX,J))THEN
+               WRITE(0,*)'I=',I,'J=',J,'K=',K,'TERRAIN HEIGHT',ZS(I,J),'Z3d',Z3d(I,KZMAX,J)
+               CALL wrf_error_fatal("BC:MOUNTAIN TOO HIGH TO FIT THE MODEL DEPTH")
+            ENDIF
+          ELSE
+              CWK2(I,J) = 0.0
+          ENDIF
+        ENDDO
+
+        DO J = NJTS,MIN(NJTE,NJDE-1)
+         DO K = NKDS,NKDE
+           ntemp_b(i,k,j)     = CWK2(I,J)
+           ntemp_bt(i,k,j)    = 0.0
+!          bdy(J,K,II,P_XEB)  = CWK2(I,J)      ! This will not work for NMM since
+!          bdy_t(J,K,II,P_XEB)= 0.0            ! NMM core requires BC halo exchanges 
+         END DO
+        END DO
+       ENDIF NMM_XE
+
+!  Y start boundary
+
+       NMM_YS: IF(NJTS .EQ. NJDS)THEN
+!       WRITE(20,*)'ENTERING Y START BOUNDARY AT MASS POINTS',NITS,MIN(NITE,NIDE-1)
+        J = NJDS
+        DO K=NKTS,KZMAX
+         DO I = NITS,MIN(NITE,NIDE-1)
+            IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+                Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                           + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                           + HBWGT3(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                           + HBWGT4(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)+1)
+            ELSE
+                Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                           + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                           + HBWGT3(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                           + HBWGT4(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+            ENDIF
+         END DO
+        END DO
+
+        DO I = NITS,MIN(NITE,NIDE-1)
+          IF (ZS(I,J) .LT. Z3d(I,2,J)) THEN              ! level 2 has to be changed
+               dlnpdz     = (log(PSTD(1))-log(PSTD(2)) )/(Z3d(i,1,j)-Z3d(i,2,j))
+               dum2d      = exp(log(PSTD(1)) + dlnpdz*(ZS(I,J) - Z3d(i,1,j)))
+               CWK3(I,J)  = dum2d -PDTOP -PTOP
+!               WRITE(20,*)I,J,ZS(I,J),Z3d(i,1,j),Z3d(i,2,j),CWK3(I,J)
+          ELSE ! target level bounded by input levels
+              DO K =NKTS,KZMAX-1
+               IF(ZS(I,J) .GE. Z3d(i,K,j) .AND. ZS(I,J) .LT. Z3d(i,K+1,j))THEN
+                 dlnpdz     = (log(PSTD(K))-log(PSTD(K+1)) ) /(Z3d(i,K,j)-Z3d(i,K+1,j))
+                 dum2d      = exp(log(PSTD(K)) + dlnpdz*(ZS(I,J)- Z3d(i,K,j)))
+                 CWK3(I,J)  = dum2d -PDTOP -PTOP
+!                 WRITE(20,*)I,J,ZS(I,J),Z3d(i,K,j),Z3d(i,K+1,j),CWK3(I,J)
+               ENDIF
+              ENDDO
+          ENDIF
+          IF(ZS(I,J) .GE. Z3d(I,KZMAX,J))THEN
+             WRITE(0,*)'I=',I,'J=',J,'K=',K,'TERRAIN HEIGHT',ZS(I,J),'Z3d',Z3d(I,KZMAX,J)
+             CALL wrf_error_fatal("BC:MOUNTAIN TOO HIGH TO FIT THE MODEL DEPTH")
+          ENDIF
+        ENDDO
+
+        DO K = NKDS, NKDE
+         DO I = NITS,MIN(NITE,NIDE-1)
+           ntemp_b(i,k,j)     = CWK3(I,J)
+           ntemp_bt(i,k,j)    = 0.0
+!          bdy(I,K,J,P_YSB)   = CWK3(I,J)      ! This will not work for the NMM core
+!          bdy_t(I,K,J,P_YSB) = 0.0            ! since NMM core requires BC halo exchanges
+         END DO
+        END DO
+       END IF NMM_YS
+
+! Y end boundary
+
+       NMM_YE: IF(NJTE-1 .EQ. NJDE-1)THEN
+!        WRITE(20,*)'ENTERING Y END BOUNDARY AT MASS POINTS',NITS,MIN(NITE,NIDE-1)
+        J = NJDE-1
+        JJ = NJDE - J
+        DO K=NKTS,KZMAX
+         DO I = NITS,MIN(NITE,NIDE-1)
+             IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+                 Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                            + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                            + HBWGT3(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                            + HBWGT4(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)+1)
+             ELSE
+                 Z3d(I,K,J) = HBWGT1(I,J)*CZ3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                            + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                            + HBWGT3(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                            + HBWGT4(I,J)*CZ3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+             ENDIF
+         END DO
+        END DO
+
+        DO I = NITS,MIN(NITE,NIDE-1)
+          IF (ZS(I,J) .LT. Z3d(I,2,J)) THEN              ! level 2 has to be changed
+               dlnpdz     = (log(PSTD(1))-log(PSTD(2)) )/(Z3d(i,1,j)-Z3d(i,2,j))
+               dum2d      = exp(log(PSTD(1)) + dlnpdz*(ZS(I,J) - Z3d(i,1,j)))
+               CWK4(I,J)  = dum2d -PDTOP -PTOP
+!               WRITE(20,*)I,J,ZS(I,J),Z3d(i,1,j),Z3d(i,2,j),CWK4(I,J)
+          ELSE ! target level bounded by input levels
+              DO K =NKTS,KZMAX-1
+               IF(ZS(I,J) .GE. Z3d(i,K,j) .AND. ZS(I,J) .LT. Z3d(i,K+1,j))THEN
+                 dlnpdz     = (log(PSTD(K))-log(PSTD(K+1)) ) /(Z3d(i,K,j)-Z3d(i,K+1,j))
+                 dum2d      = exp(log(PSTD(K)) + dlnpdz*(ZS(I,J)- Z3d(i,K,j)))
+                 CWK4(I,J)  = dum2d -PDTOP -PTOP
+!                 WRITE(20,*)I,J,ZS(I,J),Z3d(i,K,j),Z3d(i,K+1,j),CWK4(I,J)
+               ENDIF
+              ENDDO
+          ENDIF
+          IF(ZS(I,J) .GE. Z3d(I,KZMAX,J))THEN
+             WRITE(0,*)'I=',I,'J=',J,'K=',K,'TERRAIN HEIGHT',ZS(I,J),'Z3d',Z3d(I,KZMAX,J)
+             CALL wrf_error_fatal("BC:MOUNTAIN TOO HIGH TO FIT THE MODEL DEPTH")
+          ENDIF
+        ENDDO
+
+        DO K = NKDS,NKDE
+         DO I = NITS,MIN(NITE,NIDE-1)
+              ntemp_b(i,k,j)     = CWK4(I,J)
+              ntemp_bt(i,k,j)    = 0.0
+!             bdy(I,K,JJ,P_YEB) = CWK4(I,J)     ! This will not work for the NMM core
+!             bdy_t(I,K,JJ,P_YEB) = 0.0         ! since NMM core requires BC halo exchanges
+         END DO
+        END DO
+       END IF NMM_YE
+
+     RETURN
+
+   END SUBROUTINE nmm_bdymass_interp1
+!
+!==========================================================================================
+!  E grid vertical interpolation: Heights (Z3d) originally obtained on the mother domains 
+!  on isobaric levels are first horizontally interpolated in interp_mass_nmm on to the 
+!  the nested domain. Now heights on isobaric surfaces must be interpolated on to the
+!  new hybrid surfaces that include the high resolution topography. After obtaining 
+!  heights in the modified hybrid surfaces, we use the hyposmetric equation to recover 
+!  the temperature fields. The following routine returns the temperature fields in the
+!  nested domain. First routine pertains to initial conditions and the next one
+!  corresponds to boundary conditions.
+!=======================================================================================
+!
+ SUBROUTINE interp_p2hyb_nmm (cfld,                               &  ! CD field
+                              cids,cide,ckds,ckde,cjds,cjde,      &
+                              cims,cime,ckms,ckme,cjms,cjme,      &
+                              cits,cite,ckts,ckte,cjts,cjte,      &
+                              nfld,                               &  ! ND field
+                              nids,nide,nkds,nkde,njds,njde,      &
+                              nims,nime,nkms,nkme,njms,njme,      &
+                              nits,nite,nkts,nkte,njts,njte,      &
+                              shw,                                &  ! stencil half width for interp
+                              imask,                              &  ! interpolation mask
+                              xstag,ystag,                        &  ! staggering of field
+                              ipos,jpos,                          &  ! Position of lower left of nest in CD
+                              nri,nrj,                            &  ! nest ratios                         
+                              CII, IIH, CJJ, JJH, CBWGT1, HBWGT1, &  ! south-western grid locs and weights
+                              CBWGT2, HBWGT2, CBWGT3, HBWGT3,     &  ! note that "C"ourse grid ones are
+                              CBWGT4, HBWGT4,                     &  ! dummys for weights
+                              CZ3d,Z3d,                           &  ! Z3d interpolated from CZ3d
+                              CQ,Q,                               &  ! CQ not used 
+                              CFIS,FIS,                           &  ! CFIS dummy on fine domain
+                              CPD,PD,                             &
+                              CPSTD,PSTD,                         &
+                              CPDTOP,PDTOP,                       &
+                              CPTOP,PTOP,                         &
+                              CETA1,ETA1,CETA2,ETA2,              &
+                              CDETA1,DETA1,CDETA2,DETA2           ) 
+
+   USE MODULE_MODEL_CONSTANTS
+   USE module_timing
+   IMPLICIT NONE
+
+   LOGICAL,INTENT(IN) :: xstag, ystag
+   INTEGER,INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                         cims, cime, ckms, ckme, cjms, cjme,   &
+                         cits, cite, ckts, ckte, cjts, cjte,   &
+                         nids, nide, nkds, nkde, njds, njde,   &
+                         nims, nime, nkms, nkme, njms, njme,   &
+                         nits, nite, nkts, nkte, njts, njte,   &
+                         shw,ipos,jpos,nri,nrj               
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),        INTENT(IN) :: IMASK
+
+!  parent domain
+
+   INTEGER,DIMENSION(cims:cime,cjms:cjme),        INTENT(IN) :: CII,CJJ   ! dummy
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CBWGT1,CBWGT2
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CBWGT3,CBWGT4
+
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme), INTENT(IN) :: CFLD
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme), INTENT(IN) :: CZ3d,CQ
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CFIS,CPD
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CPSTD
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CETA1,CETA2
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CDETA1,CDETA2
+   REAL,                                          INTENT(IN) :: CPDTOP,CPTOP
+
+!  nested domain
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),        INTENT(IN) :: IIH,JJH
+   REAL,DIMENSION(nims:nime,njms:njme),           INTENT(IN) :: HBWGT1,HBWGT2
+   REAL,DIMENSION(nims:nime,njms:njme),           INTENT(IN) :: HBWGT3,HBWGT4
+
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme), INTENT(OUT):: NFLD  ! This is T, here
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme), INTENT(IN) :: Z3d,Q
+   REAL,DIMENSION(nims:nime,njms:njme ),          INTENT(IN) :: FIS,PD
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: PSTD
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: ETA1,ETA2
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: DETA1,DETA2
+   REAL,INTENT(IN)                                           :: PDTOP,PTOP
+
+!  local
+
+   INTEGER,PARAMETER                                         :: JTB=134
+   REAL, PARAMETER                                           :: LAPSR=6.5E-3,GI=1./G, D608=0.608
+   REAL, PARAMETER                                           :: TRG=2.0*R_D*GI,COEF3=R_D*GI*LAPSR
+   INTEGER                                                   :: I,J,K
+   REAL                                                      :: TVOUT,PMO
+   REAL,DIMENSION(nims:nime,njms:njme)                       :: ZS
+   REAL,DIMENSION(JTB)                                       :: PIN,ZIN,Y2,PIO,ZOUT,DUM1,DUM2
+!  REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme)             :: TOUT
+!-----------------------------------------------------------------------------------------------------
+!
+!
+!   *** CHECK VERTICAL BOUNDS BEFORE USING SPLINE INTERPOLATION 
+!
+    IF(nkme .GT. (JTB-10) .OR. NKDE .GT. (JTB-10)) &
+      CALL wrf_error_fatal ('mass points: increase JTB in interp_mass_nmm')
+
+
+!    WRITE(22,*)'------------- MED NEST INITIAL 2 ----------------'
+!    DO J=NJTS,MIN(NJTE,NJDE-1)
+!      DO I=NITS,MIN(NITE,NIDE-1)
+!         WRITE(22,*)I,J,IMASK(I,J),NFLD(I,1,J)
+!      ENDDO
+!    ENDDO
+!    WRITE(22,*)
+
+!
+!    direct horizontal interpolation may work in the absence of terrain especially at
+!    the boundaries
+!
+!     DO J=NJTS,MIN(NJTE,NJDE-1)
+!       DO K=NKDS,NKDE
+!        DO I=NITS,MIN(NITE,NIDE-1)
+!          IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+!             NFLD(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )    &
+!                         + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )    &
+!                         + HBWGT3(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)-1)    &
+!                         + HBWGT4(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)+1)
+!          ELSE
+!             NFLD(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )  &
+!                         + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )  &
+!                         + HBWGT3(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+!                         + HBWGT4(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)+1)
+!          ENDIF
+!        ENDDO
+!       ENDDO
+!     ENDDO
+
+!
+!   Interpolate Z3d to the new pressure levels, determine Temperature in the nested domain
+!   from hydrostatic equation. This is important for terrain adjustments in nested domains 
+!
+
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+     DO I=NITS,MIN(NITE,NIDE-1)
+        IF(IMASK(I,J) .NE. 1)THEN
+         ZS(I,J)=FIS(I,J)*GI
+        ENDIF
+     ENDDO
+    ENDDO
+
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+     DO I=NITS,MIN(NITE,NIDE-1)
+      IF(IMASK(I,J) .NE. 1)THEN
+!
+!        clean local array before use of spline
+
+         ZIN=0.;PIN=0.;Y2=0;PIO=0.;ZOUT=0.;DUM1=0.;DUM2=0.
+!     
+         DO K=NKDS,NKDE                    ! inputs at standard interface levels
+           PIN(K) = PSTD(NKDE-K+1)         ! please don't remove this from IJ loop;redefined later   
+           ZIN(K) = Z3d(I,NKDE-K+1,J)
+         ENDDO
+!
+         Y2(1   )=0.
+         Y2(NKDE)=0.
+!
+         DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+           PIO(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP   
+         ENDDO
+!
+         IF(PIO(1) .GE. PSTD(1))THEN            ! if lower boundary is higher than 1000. mb
+           PIN(NKDE) = PIO(1)                   ! re-set lower boundary to be consistent with target
+           ZIN(NKDE) = ZS(I,J)
+         ENDIF
+
+         CALL SPLINE2(I,J,JTB,NKDE,PIN,ZIN,Y2,NKDE,PIO,ZOUT,DUM1,DUM2)  ! interpolate 
+
+         DO K=NKDS,NKDE-1
+           PMO   = (PIO(K+1)+PIO(K))/(DETA1(K)*PDTOP+DETA2(K)*PD(I,J))
+           TVOUT = (ZOUT(K+1)-ZOUT(K))*PMO/TRG 
+           NFLD(I,K,J)= TVOUT/(1.0+Q(I,K,J)*P608)  ! temperature in the nested domain
+!           IF(I==2 .and. J==3)WRITE(0,*)K,PIN(K),Z3d(I,K,J),PIO(K),ZOUT(K),TVOUT,Q(I,K,J),NFLD(I,K,J)
+         ENDDO
+!
+      ENDIF
+     ENDDO
+    ENDDO
+
+!
+  END SUBROUTINE interp_p2hyb_nmm 
+!
+!===================================================================================================
+!
+ SUBROUTINE  nmm_bdy_p2hyb   (cfld,                               &  ! CD field
+                              cids,cide,ckds,ckde,cjds,cjde,      &
+                              cims,cime,ckms,ckme,cjms,cjme,      &
+                              cits,cite,ckts,ckte,cjts,cjte,      &
+                              nfld,                               &  ! ND field
+                              nids,nide,nkds,nkde,njds,njde,      &
+                              nims,nime,nkms,nkme,njms,njme,      &
+                              nits,nite,nkts,nkte,njts,njte,      &
+                              shw,                                &  ! stencil half width for interp
+                              imask,                              &  ! interpolation mask
+                              xstag,ystag,                        &  ! staggering of field
+                              ipos,jpos,                          &  ! Position of lower left of nest in CD
+                              nri,nrj,                            &  ! nest ratios
+                              cbdy, nbdy,                         &
+                              cbdy_t, nbdy_t,                     &
+                              cdt, ndt,                           &
+                              CTEMP_B,NTEMP_B,                    &  ! to be removed
+                              CTEMP_BT,NTEMP_BT,                  &
+                              CZ3d,Z3d,                           &  ! Z3d interpolated from CZ3d
+                              CQ,Q,                               &  ! CQ not used 
+                              CFIS,FIS,                           &  ! CFIS dummy on fine domain
+                              CPD,PD,                             &
+                              CPSTD,PSTD,                         &
+                              CPDTOP,PDTOP,                       &
+                              CPTOP,PTOP,                         &
+                              CETA1,ETA1,CETA2,ETA2,              &
+                              CDETA1,DETA1,CDETA2,DETA2           )
+
+   USE MODULE_MODEL_CONSTANTS
+   USE module_timing
+   IMPLICIT NONE
+
+   LOGICAL,INTENT(IN)                                               :: xstag, ystag
+   REAL, INTENT(INOUT)                                              :: cdt, ndt
+   INTEGER,INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                         cims, cime, ckms, ckme, cjms, cjme,   &
+                         cits, cite, ckts, ckte, cjts, cjte,   &
+                         nids, nide, nkds, nkde, njds, njde,   &
+                         nims, nime, nkms, nkme, njms, njme,   &
+                         nits, nite, nkts, nkte, njts, njte,   &
+                         shw,ipos,jpos,nri,nrj               
+   REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: ctemp_b,ctemp_bt
+   REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(OUT) :: ntemp_b,ntemp_bt
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),        INTENT(IN) :: IMASK
+   REAL,  DIMENSION( * ), INTENT(INOUT) :: cbdy, cbdy_t, nbdy, nbdy_t
+
+!  parent domain
+
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme), INTENT(IN) :: CFLD
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme), INTENT(IN) :: CZ3d,CQ
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CFIS,CPD
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CPSTD
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CETA1,CETA2
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CDETA1,CDETA2
+   REAL,                                          INTENT(IN) :: CPDTOP,CPTOP
+
+!  nested domain
+
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme), INTENT(OUT):: NFLD  ! This is T, here
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme), INTENT(IN) :: Z3d,Q
+   REAL,DIMENSION(nims:nime,njms:njme ),          INTENT(IN) :: FIS,PD
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: PSTD
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: ETA1,ETA2
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: DETA1,DETA2
+   REAL,INTENT(IN)                                           :: PDTOP,PTOP
+
+!  local
+
+   INTEGER,PARAMETER                                         :: JTB=134
+   REAL, PARAMETER                                           :: LAPSR=6.5E-3,GI=1./G, D608=0.608
+   REAL, PARAMETER                                           :: TRG=2.0*R_D*GI,COEF3=R_D*GI*LAPSR
+   INTEGER                                                   :: I,J,K,II,JJ
+   REAL                                                      :: TVOUT,PMO
+   REAL,DIMENSION(nims:nime,njms:njme)                       :: ZS
+   REAL,DIMENSION(JTB)                                       :: PIN,ZIN,Y2,PIO,ZOUT,DUM1,DUM2
+   REAL, DIMENSION (nims:nime,nkms:nkme,njms:njme)           :: CWK1,CWK2,CWK3,CWK4
+!-----------------------------------------------------------------------------------------------------
+!
+
+!
+!   *** CHECK VERTICAL BOUNDS BEFORE USING SPLINE INTERPOLATION 
+!
+    IF(nkme .GT. (JTB-10) .OR. NKDE .GT. (JTB-10)) &
+      CALL wrf_error_fatal ('mass points: increase JTB in interp_mass_nmm')
+
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+     DO I=NITS,MIN(NITE,NIDE-1)
+        ZS(I,J)=FIS(I,J)*GI
+     ENDDO
+    ENDDO
+
+
+!   X start boundary
+
+    NMM_XS: IF(NITS .EQ. NIDS)THEN
+!     WRITE(0,*)'ENTERING X1 START BOUNDARY AT T POINTS',NJTS,MIN(NJTE,NJDE-1)
+      I = NIDS
+      DO J=NJTS,MIN(NJTE,NJDE-1)
+       IF(MOD(J,2) .NE. 0)THEN
+        ZIN=0.;Y2=0;PIO=0.;ZOUT=0.;DUM1=0.;DUM2=0. !     clean local array before use of spline
+!     
+        DO K=NKTS,NKDE                    ! inputs at standard interface levels
+          PIN(K) = PSTD(NKDE-K+1)         ! please don't remove this from IJ loop; redifined later   
+          ZIN(K) = Z3d(I,NKDE-K+1,J)
+        ENDDO
+!
+        Y2(1   )=0.
+        Y2(NKDE)=0.
+!
+        DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+          PIO(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP   
+        ENDDO
+!
+        IF(PIO(1) .GE. PSTD(1))THEN            ! if lower boundary is higher than 1000. mb
+          PIN(NKDE) = PIO(1)                   ! re-set lower boundary to be consistent with target
+          ZIN(NKDE) = ZS(I,J)
+        ENDIF
+
+        CALL SPLINE2(I,J,JTB,NKDE,PIN,ZIN,Y2,NKDE,PIO,ZOUT,DUM1,DUM2)  ! interpolate 
+
+        DO K=NKDS,NKDE-1
+         PMO   = (PIO(K+1)+PIO(K))/(DETA1(K)*PDTOP+DETA2(K)*PD(I,J))
+         TVOUT = (ZOUT(K+1)-ZOUT(K))*PMO/TRG
+         CWK1(I,K,J)= TVOUT/(1.0+Q(I,K,J)*P608)  ! temperature defined in the nested domain
+        ENDDO
+
+       ELSE
+         DO K=NKDS,NKDE-1
+          CWK1(I,K,J)=0.0
+         ENDDO
+       ENDIF
+      ENDDO
+
+      DO J = NJTS,MIN(NJTE,NJDE-1)
+       DO K = NKDS,NKDE-1
+         ntemp_b(i,k,j)     = CWK1(I,K,J)
+         ntemp_bt(i,k,j)    = 0.0
+!        bdy(J,K,I,P_XSB)   = CWK1(I,K,J)         ! This will not work for NMM since
+!        bdy_t(J,K,I,P_XSB) = 0.0                 ! NMM requires BC halo exchanges
+       END DO
+      END DO
+
+    ENDIF NMM_XS
+
+
+!    X end boundary
+
+
+    NMM_XE: IF(NITE-1 .EQ. NIDE-1)THEN
+!    WRITE(0,*)'ENTERING X END BOUNDARY AT T POINTS',NJTS,MIN(NJTE,NJDE-1)
+     I = NIDE-1
+     II = NIDE - I
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+      IF(MOD(J,2) .NE. 0)THEN
+       ZIN=0.;Y2=0;PIO=0.;ZOUT=0.;DUM1=0.;DUM2=0. !     clean local array before use of spline
+!
+        DO K=NKTS,NKDE                    ! inputs at standard interface levels;redifined later
+          PIN(K) = PSTD(NKDE-K+1)         ! please don't remove this from IJ loop
+          ZIN(K) = Z3d(I,NKDE-K+1,J)
+        ENDDO
+!
+        Y2(1   )=0.
+        Y2(NKDE)=0.
+!
+        DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+          PIO(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP
+        ENDDO
+!
+        IF(PIO(1) .GE. PSTD(1))THEN            ! if lower boundary is higher than 1000. mb
+          PIN(NKDE) = PIO(1)                   ! re-set lower boundary to be consistent with target
+          ZIN(NKDE) = ZS(I,J)
+        ENDIF
+ 
+        CALL SPLINE2(I,J,JTB,NKDE,PIN,ZIN,Y2,NKDE,PIO,ZOUT,DUM1,DUM2)  ! interpolate
+ 
+        DO K=NKDS,NKDE-1
+          PMO   = (PIO(K+1)+PIO(K))/(DETA1(K)*PDTOP+DETA2(K)*PD(I,J))
+          TVOUT = (ZOUT(K+1)-ZOUT(K))*PMO/TRG
+          CWK2(I,K,J)= TVOUT/(1.0+Q(I,K,J)*P608)  ! temperature defined in the nested domain
+        ENDDO
+      
+      ELSE
+           DO K=NKDS,NKDE-1
+            CWK2(I,K,J)=0.0
+           ENDDO 
+      ENDIF
+     ENDDO
+
+       DO J = NJTS,MIN(NJTE,NJDE-1)
+        DO K = NKDS,NKDE-1
+          ntemp_b(i,k,j)     = CWK2(I,K,J)
+          ntemp_bt(i,k,j)    = 0.0
+!         bdy(J,K,I,P_XSB)   = CWK2(I,K,J)         ! This will not work for NMM since
+!         bdy_t(J,K,I,P_XSB) = 0.0                 ! NMM requires BC halo exchanges
+!          if(k==1)WRITE(0,*)J,ntemp_b(i,k,j)
+        END DO
+       END DO
+
+    ENDIF NMM_XE
+
+!  Y start boundary
+
+    NMM_YS: IF(NJTS .EQ. NJDS)THEN
+!    WRITE(0,*)'ENTERING Y START BOUNDARY AT T POINTS',NITS,MIN(NITE,NIDE-1)
+     J = NJDS
+     DO I=NITS,MIN(NITE,NIDE-1)
+      ZIN=0.;Y2=0;PIO=0.;ZOUT=0.;DUM1=0.;DUM2=0.  !     clean local array before use of spline
+!
+       DO K=NKDS,NKDE                    ! inputs at standard interface levels;redifined later
+         PIN(K) = PSTD(NKDE-K+1)         ! please don't remove this from IJ loop
+         ZIN(K) = Z3d(I,NKDE-K+1,J)
+       ENDDO
+!
+       Y2(1   )=0.
+       Y2(NKDE)=0.
+!
+       DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+         PIO(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP
+       ENDDO
+!
+       IF(PIO(1) .GE. PSTD(1))THEN            ! if lower boundary is higher than 1000. mb
+         PIN(NKDE) = PIO(1)                   ! re-set lower boundary to be consistent with target
+         ZIN(NKDE) = ZS(I,J)
+       ENDIF
+
+       CALL SPLINE2(I,J,JTB,NKDE,PIN,ZIN,Y2,NKDE,PIO,ZOUT,DUM1,DUM2)  ! interpolate
+
+       DO K=NKDS,NKDE-1
+         PMO   = (PIO(K+1)+PIO(K))/(DETA1(K)*PDTOP+DETA2(K)*PD(I,J))
+         TVOUT = (ZOUT(K+1)-ZOUT(K))*PMO/TRG 
+         CWK3(I,K,J)= TVOUT/(1.0+Q(I,K,J)*P608)  ! temperature defined in the nested domain
+       ENDDO
+
+     ENDDO
+
+     DO K = NKDS,NKDE-1
+      DO I = NITS,MIN(NITE,NIDE-1)
+        ntemp_b(i,k,j)     = CWK3(I,K,J)
+        ntemp_bt(i,k,j)    = 0.0
+!       bdy(J,K,I,P_XSB)   = CWK3(I,K,J)         ! This will not work for NMM since
+!       bdy_t(J,K,I,P_XSB) = 0.0                 ! NMM requires BC halo exchanges
+!        if(k==1)WRITE(0,*)I,ntemp_b(i,k,j)
+      END DO
+      END DO
+
+    ENDIF NMM_YS
+
+! Y end boundary
+
+    NMM_YE: IF(NJTE-1 .EQ. NJDE-1)THEN
+!    WRITE(0,*)'ENTERING Y END BOUNDARY AT T POINTS',NITS,MIN(NITE,NIDE-1)
+     J = NJDE-1
+     JJ = NJDE - J
+     DO I=NITS,MIN(NITE,NIDE-1)
+      ZIN=0.;Y2=0;PIO=0.;ZOUT=0.;DUM1=0.;DUM2=0.  !     clean local array before use of spline
+!
+       DO K=NKDS,NKDE                    ! inputs at standard interface levels;redifined later
+         PIN(K) = PSTD(NKDE-K+1)         ! please don't remove this from IJ loop
+         ZIN(K) = Z3d(I,NKDE-K+1,J)
+       ENDDO
+!
+       Y2(1   )=0.
+       Y2(NKDE)=0.
+!
+       DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+         PIO(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP
+       ENDDO
+!
+       IF(PIO(1) .GE. PSTD(1))THEN            ! if lower boundary is higher than 1000. mb
+         PIN(NKDE) = PIO(1)                   ! re-set lower boundary to be consistent with target
+         ZIN(NKDE) = ZS(I,J)
+       ENDIF
+
+       CALL SPLINE2(I,J,JTB,NKDE,PIN,ZIN,Y2,NKDE,PIO,ZOUT,DUM1,DUM2)  ! interpolate
+
+       DO K=NKDS,NKDE-1
+         PMO   = (PIO(K+1)+PIO(K))/(DETA1(K)*PDTOP+DETA2(K)*PD(I,J))
+         TVOUT = (ZOUT(K+1)-ZOUT(K))*PMO/TRG
+         CWK4(I,K,J)= TVOUT/(1.0+Q(I,K,J)*P608)  ! temperature defined in the nested domain
+       ENDDO
+
+     ENDDO
+
+     DO K = NKDS,NKDE-1
+      DO I = NITS,MIN(NITE,NIDE-1)
+        ntemp_b(i,k,j)     = CWK4(I,K,J)
+        ntemp_bt(i,k,j)    = 0.0
+!       bdy(J,K,I,P_XSB)   = CWK4(I,K,J)         ! This will not work for NMM since
+!       bdy_t(J,K,I,P_XSB) = 0.0                 ! NMM requires BC halo exchanges
+!        if(k==1)WRITE(0,*)I,ntemp_b(i,k,j)
+      END DO
+      END DO
+
+    ENDIF NMM_YE
+!
+  END SUBROUTINE nmm_bdy_p2hyb 
+
+!=======================================================================================
+!
+!  ADDED FOR INCLUDING MOISTURE AND THERMODYNAMIC ENERGY BALANCE
+!
+!=======================================================================================
+
+ SUBROUTINE interp_scalar_nmm (cfld,                               &  ! CD field
+                               cids,cide,ckds,ckde,cjds,cjde,      &
+                               cims,cime,ckms,ckme,cjms,cjme,      &
+                               cits,cite,ckts,ckte,cjts,cjte,      &
+                               nfld,                               &  ! ND field
+                               nids,nide,nkds,nkde,njds,njde,      &
+                               nims,nime,nkms,nkme,njms,njme,      &
+                               nits,nite,nkts,nkte,njts,njte,      &
+                               shw,                                &  ! stencil half width for interp
+                               imask,                              &  ! interpolation mask
+                               xstag,ystag,                        &  ! staggering of field
+                               ipos,jpos,                          &  ! Position of lower left of nest in CD
+                               nri,nrj,                            &  ! nest ratios
+                               CII, IIH, CJJ, JJH, CBWGT1, HBWGT1, &  ! south-western grid locs and weights
+                               CBWGT2, HBWGT2, CBWGT3, HBWGT3,     &  ! note that "C"ourse grid ones are
+                               CBWGT4, HBWGT4,                     &  ! dummys for weights
+                               CC3d,C3d,                           &  
+                               CPD,PD,                             &
+                               CPSTD,PSTD,                         &
+                               CPDTOP,PDTOP,                       &
+                               CPTOP,PTOP,                         &
+                               CETA1,ETA1,CETA2,ETA2               )
+
+   USE MODULE_MODEL_CONSTANTS
+   USE module_timing
+   IMPLICIT NONE
+
+   LOGICAL,INTENT(IN) :: xstag, ystag
+   INTEGER,INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                         cims, cime, ckms, ckme, cjms, cjme,   &
+                         cits, cite, ckts, ckte, cjts, cjte,   &
+                         nids, nide, nkds, nkde, njds, njde,   &
+                         nims, nime, nkms, nkme, njms, njme,   &
+                         nits, nite, nkts, nkte, njts, njte,   &
+                         shw,ipos,jpos,nri,nrj
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),   INTENT(IN)      :: IMASK
+
+!  parent domain
+
+   INTEGER,DIMENSION(cims:cime,cjms:cjme),        INTENT(IN) :: CII,CJJ   ! dummy
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CBWGT1,CBWGT2
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CBWGT3,CBWGT4
+
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme), INTENT(IN) :: CFLD
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme), INTENT(IN) :: CC3d  ! scalar input on constant pressure levels
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CPSTD
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CPD
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CETA1,CETA2
+   REAL,                                          INTENT(IN) :: CPDTOP,CPTOP 
+
+!  nested domain
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),        INTENT(IN) :: IIH,JJH
+   REAL,DIMENSION(nims:nime,njms:njme),           INTENT(IN) :: HBWGT1,HBWGT2
+   REAL,DIMENSION(nims:nime,njms:njme),           INTENT(IN) :: HBWGT3,HBWGT4
+
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme), INTENT(OUT):: NFLD  ! This is scalar on hybrid levels
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme), INTENT(OUT):: C3d   ! Scalar on constant pressure levels
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: PSTD
+   REAL,DIMENSION(nims:nime,njms:njme ),          INTENT(IN) :: PD
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: ETA1,ETA2
+   REAL,INTENT(IN)                                           :: PDTOP,PTOP
+
+!  local
+
+   INTEGER,PARAMETER                                         :: JTB=134
+   INTEGER                                                   :: I,J,K
+   REAL,DIMENSION(JTB)                                       :: PIN,CIN,Y2,PIO,PTMP,COUT,DUM1,DUM2
+
+!-----------------------------------------------------------------------------------------------------
+!
+!
+!   *** CHECK VERTICAL BOUNDS BEFORE USING SPLINE OR LINEAR INTERPOLATION
+!
+    IF(nkme .GT. (JTB-10) .OR. NKDE .GT. (JTB-10)) &
+      CALL wrf_error_fatal ('mass points: increase JTB in interp_mass_nmm')
+
+!
+!   FIRST, HORIZONTALLY INTERPOLATE MOISTURE NOW AVAILABLE ON CONSTANT PRESSURE SURFACE (LEVELS) FROM THE
+!   PARENT TO THE NESTED DOMAIN
+!
+!*** INDEX CONVENTIONS
+!***                     HBWGT4
+!***                      4
+!***
+!***
+!***
+!***                   h
+!***             1                 2
+!***            HBWGT1             HBWGT2
+!***
+!***
+!***                      3
+!***                     HBWGT3
+
+    C3d=0.0
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+      DO K=NKDS,NKDE-1                ! Please note that we are still in isobaric surfaces
+        DO I=NITS,MIN(NITE,NIDE-1)
+         IF(IMASK(I,J) .NE. 1)THEN
+           IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+               C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                          + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                          + HBWGT3(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                          + HBWGT4(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)+1)
+
+           ELSE
+               C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                          + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                          + HBWGT3(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                          + HBWGT4(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+           ENDIF
+         ENDIF
+        ENDDO
+      ENDDO
+    ENDDO
+
+!
+!   RECOVER THE SCALARS FROM CONSTANT PRESSURE SURFACES (LEVELS) ON TO HYBRID SURFACES
+!
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+     DO I=NITS,MIN(NITE,NIDE-1)
+      IF(IMASK(I,J) .NE. 1)THEN
+!
+!        clean local array before use of spline or linear interpolation
+
+         CIN=0.;PIN=0.;Y2=0;PIO=0.;PTMP=0.;COUT=0.;DUM1=0.;DUM2=0.
+!    
+         DO K=NKDS+1,NKDE                    ! inputs at standard  levels
+           PIN(K-1) = EXP((ALOG(PSTD(NKDE-K+1))+ALOG(PSTD(NKDE-K+2)))*0.5)
+           CIN(K-1) = C3d(I,NKDE-K+1,J)
+         ENDDO
+!
+         Y2(1   )=0.
+         Y2(NKDE-1)=0.
+!
+         DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+           PTMP(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP
+         ENDDO
+
+         DO K=NKDS,NKDE-1                        ! target points in model levels
+           PIO(K) = EXP((ALOG(PTMP(K))+ALOG(PTMP(K+1)))*0.5)
+         ENDDO
+!
+
+         IF(PTMP(1) .GE. PSTD(1))THEN           ! if lower boundary is higher than PMSL(1) re-set lower boundary
+           PIN(NKDE-1) = PIO(1)                 ! be consistent with target. This may not happen at all
+           WRITE(0,*)'WARNING: NESTED DOMAIN PRESSURE AT LOWEST LEVEL HIGHER THAN PSTD'
+           WRITE(0,*)'I,J,PIO(1),PSTD(1)',I,J,PIO(1),PSTD(1)
+         ENDIF
+
+         CALL SPLINE2(I,J,JTB,NKDE-1,PIN,CIN,Y2,NKDE-1,PIO,COUT,DUM1,DUM2)  ! interpolate
+
+         DO K=1,NKDE-1
+           NFLD(I,K,J)= COUT(K)  ! scalar in the nested domain
+         ENDDO
+
+!         IF(I==1 .AND. J==1)THEN
+!          WRITE(0,*)
+!          WRITE(0,*)'IPOS=',IPOS,'JPOS=',JPOS
+!          DO K=NKTS,NKDE-1
+!           WRITE(0,*)'T and Q AFTER BALANCING',K,CFLD(IPOS,K,JPOS),NFLD(I,K,J), &
+!                                               CFLD(IPOS,K,JPOS)-NFLD(I,K,J)
+!          ENDDO
+!         ENDIF
+!
+      ENDIF
+     ENDDO
+    ENDDO
+
+ END SUBROUTINE interp_scalar_nmm
+!
+!===========================================================================================
+!
+ SUBROUTINE  nmm_bdy_scalar (cfld,                               &  ! CD field
+                             cids,cide,ckds,ckde,cjds,cjde,      &
+                             cims,cime,ckms,ckme,cjms,cjme,      &
+                             cits,cite,ckts,ckte,cjts,cjte,      &
+                             nfld,                               &  ! ND field
+                             nids,nide,nkds,nkde,njds,njde,      &
+                             nims,nime,nkms,nkme,njms,njme,      &
+                             nits,nite,nkts,nkte,njts,njte,      &
+                             shw,                                &  ! stencil half width for interp
+                             imask,                              &  ! interpolation mask
+                             xstag,ystag,                        &  ! staggering of field
+                             ipos,jpos,                          &  ! Position of lower left of nest in CD
+                             nri,nrj,                            &  ! nest ratios
+                             cbdy, nbdy,                         &
+                             cbdy_t, nbdy_t,                     &
+                             cdt, ndt,                           &
+                             CTEMP_B,NTEMP_B,                    &  ! to be removed
+                             CTEMP_BT,NTEMP_BT,                  &
+                             CII, IIH, CJJ, JJH, CBWGT1, HBWGT1, &  ! south-western grid locs and weights
+                             CBWGT2, HBWGT2, CBWGT3, HBWGT3,     &  ! note that "C"ourse grid ones are
+                             CBWGT4, HBWGT4,                     &  ! dummys for weights
+                             CC3d,C3d,                           &
+                             CPD,PD,                             &
+                             CPSTD,PSTD,                         &
+                             CPDTOP,PDTOP,                       &
+                             CPTOP,PTOP,                         &
+                             CETA1,ETA1,CETA2,ETA2               )
+   USE MODULE_MODEL_CONSTANTS
+   USE module_timing
+   IMPLICIT NONE
+
+   LOGICAL,INTENT(IN)                                               :: xstag, ystag
+   REAL, INTENT(INOUT)                                              :: cdt, ndt
+   INTEGER,INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                         cims, cime, ckms, ckme, cjms, cjme,   &
+                         cits, cite, ckts, ckte, cjts, cjte,   &
+                         nids, nide, nkds, nkde, njds, njde,   &
+                         nims, nime, nkms, nkme, njms, njme,   &
+                         nits, nite, nkts, nkte, njts, njte,   &
+                         shw,ipos,jpos,nri,nrj               
+   REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: ctemp_b,ctemp_bt
+   REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(OUT) :: ntemp_b,ntemp_bt
+   REAL,  DIMENSION( * ), INTENT(INOUT) :: cbdy, cbdy_t, nbdy, nbdy_t
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),        INTENT(IN) :: IMASK
+
+!  parent domain
+
+   INTEGER,DIMENSION(cims:cime,cjms:cjme),        INTENT(IN) :: CII,CJJ   ! dummy
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CBWGT1,CBWGT2
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CBWGT3,CBWGT4
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme), INTENT(IN) :: CFLD
+   REAL,DIMENSION(cims:cime,ckms:ckme,cjms:cjme), INTENT(IN) :: CC3d ! scalar input on constant pressure levels
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CPSTD
+   REAL,DIMENSION(cims:cime,cjms:cjme),           INTENT(IN) :: CPD
+   REAL,DIMENSION(ckms:ckme),                     INTENT(IN) :: CETA1,CETA2
+   REAL,                                          INTENT(IN) :: CPDTOP,CPTOP
+
+!  nested domain
+
+   INTEGER,DIMENSION(nims:nime,njms:njme),        INTENT(IN) :: IIH,JJH
+   REAL,DIMENSION(nims:nime,njms:njme),           INTENT(IN) :: HBWGT1,HBWGT2
+   REAL,DIMENSION(nims:nime,njms:njme),           INTENT(IN) :: HBWGT3,HBWGT4
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme), INTENT(OUT):: NFLD 
+   REAL,DIMENSION(nims:nime,nkms:nkme,njms:njme), INTENT(OUT):: C3d   !Scalar on constant pressure levels
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: PSTD
+   REAL,DIMENSION(nims:nime,njms:njme ),          INTENT(IN) :: PD
+   REAL,DIMENSION(nkms:nkme),                     INTENT(IN) :: ETA1,ETA2
+   REAL,INTENT(IN)                                           :: PDTOP,PTOP
+
+!  local
+
+   INTEGER,PARAMETER                                       :: JTB=134
+   INTEGER                                                 :: I,J,K,II,JJ
+   REAL,DIMENSION(JTB)                                     :: PIN,CIN,Y2,PIO,PTMP,COUT,DUM1,DUM2
+   REAL, DIMENSION (nims:nime,nkms:nkme,njms:njme)         :: CWK1,CWK2,CWK3,CWK4
+!-----------------------------------------------------------------------------------------------------
+!
+!
+!   *** CHECK VERTICAL BOUNDS BEFORE USING SPLINE INTERPOLATION 
+!
+    IF(nkme .GT. (JTB-10) .OR. NKDE .GT. (JTB-10)) &
+      CALL wrf_error_fatal ('mass points: increase JTB in interp_mass_nmm')
+
+!   X start boundary
+
+    NMM_XS: IF(NITS .EQ. NIDS)THEN
+!     WRITE(0,*)'ENTERING X1 START BOUNDARY AT T POINTS',NJTS,MIN(NJTE,NJDE-1)
+      I = NIDS
+      DO J = NJTS,MIN(NJTE,NJDE-1)
+         DO K=NKDS,NKDE-1                ! Please note that we are still in isobaric surfaces
+          IF(MOD(JJH(I,J),2) .NE. 0)THEN      ! 1,3,5,7 of the parent domain
+            C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                       + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                       + HBWGT3(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                       + HBWGT4(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)+1)
+          ELSE
+            C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                       + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                       + HBWGT3(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                       + HBWGT4(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+          ENDIF
+        ENDDO
+      ENDDO
+!
+      DO J=NJTS,MIN(NJTE,NJDE-1)
+       IF(MOD(J,2) .NE. 0)THEN
+         CIN=0.;PIN=0.;Y2=0;PIO=0.;PTMP=0.;COUT=0.;DUM1=0.;DUM2=0. ! clean up local array
+         DO K=NKDS+1,NKDE                    ! inputs at standard  levels
+           PIN(K-1) = EXP((ALOG(PSTD(NKDE-K+1))+ALOG(PSTD(NKDE-K+2)))*0.5)
+           CIN(K-1) = C3d(I,NKDE-K+1,J)
+         ENDDO
+         Y2(1   )=0.
+         Y2(NKDE-1)=0.
+         DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+           PTMP(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP
+         ENDDO
+         DO K=NKDS,NKDE-1                        ! target points in model levels
+           PIO(K) = EXP((ALOG(PTMP(K))+ALOG(PTMP(K+1)))*0.5)
+         ENDDO
+         IF(PTMP(1) .GE. PSTD(1))THEN           ! if lower boundary is higher than PMSL(1) re-set lower boundary
+           PIN(NKDE-1) = PIO(1)                 ! be consistent with target. This may not happen at all
+           WRITE(0,*)'WARNING: NESTED DOMAIN PRESSURE AT LOWEST LEVEL HIGHER THAN PSTD'
+           WRITE(0,*)'I,J,PIO(1),PSTD(1)',I,J,PIO(1),PSTD(1)
+         ENDIF
+
+         CALL SPLINE2(I,J,JTB,NKDE-1,PIN,CIN,Y2,NKDE-1,PIO,COUT,DUM1,DUM2)  ! interpolate
+
+         DO K=1,NKDE-1
+           CWK1(I,K,J)= COUT(K)  ! scalar in the nested domain
+         ENDDO
+       ELSE
+         DO K=NKDS,NKDE-1
+          CWK1(I,K,J)=0.0
+         ENDDO
+       ENDIF
+      ENDDO
+
+      DO J = NJTS,MIN(NJTE,NJDE-1)
+       DO K = NKDS,NKDE-1
+         ntemp_b(i,k,j)     = CWK1(I,K,J)
+         ntemp_bt(i,k,j)    = 0.0
+!        bdy(J,K,I,P_XSB)   = CWK1(I,K,J)         ! This will not work for NMM since
+!        bdy_t(J,K,I,P_XSB) = 0.0                 ! NMM requires BC halo exchanges
+       END DO
+      END DO
+
+    ENDIF NMM_XS
+
+
+!   X end boundary
+
+    NMM_XE: IF(NITE-1 .EQ. NIDE-1)THEN
+!    WRITE(0,*)'ENTERING X END BOUNDARY AT T POINTS',NJTS,MIN(NJTE,NJDE-1)
+     I = NIDE-1
+      DO J = NJTS,MIN(NJTE,NJDE-1)
+         DO K=NKDS,NKDE-1                ! Please note that we are still in isobaric surfaces
+          IF(MOD(JJH(I,J),2) .NE. 0)THEN      ! 1,3,5,7 of the parent domain
+            C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                       + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                       + HBWGT3(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                       + HBWGT4(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)+1)
+          ELSE
+            C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                       + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                       + HBWGT3(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                       + HBWGT4(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+          ENDIF
+        ENDDO
+      ENDDO
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+      IF(MOD(J,2) .NE. 0)THEN
+         CIN=0.;PIN=0.;Y2=0;PIO=0.;PTMP=0.;COUT=0.;DUM1=0.;DUM2=0. ! clean up local array
+         DO K=NKDS+1,NKDE                    ! inputs at standard  levels
+           PIN(K-1) = EXP((ALOG(PSTD(NKDE-K+1))+ALOG(PSTD(NKDE-K+2)))*0.5)
+           CIN(K-1) = C3d(I,NKDE-K+1,J)
+         ENDDO
+         Y2(1   )=0.
+         Y2(NKDE-1)=0.
+         DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+           PTMP(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP
+         ENDDO
+         DO K=NKDS,NKDE-1                        ! target points in model levels
+           PIO(K) = EXP((ALOG(PTMP(K))+ALOG(PTMP(K+1)))*0.5)
+         ENDDO
+         IF(PTMP(1) .GE. PSTD(1))THEN           ! if lower boundary is higher than PMSL(1) re-set lower boundary
+           PIN(NKDE-1) = PIO(1)                 ! be consistent with target. This may not happen at all
+           WRITE(0,*)'WARNING: NESTED DOMAIN PRESSURE AT LOWEST LEVEL HIGHER THAN PSTD'
+           WRITE(0,*)'I,J,PIO(1),PSTD(1)',I,J,PIO(1),PSTD(1)
+         ENDIF
+
+         CALL SPLINE2(I,J,JTB,NKDE-1,PIN,CIN,Y2,NKDE-1,PIO,COUT,DUM1,DUM2)  ! interpolate
+
+         DO K=1,NKDE-1
+           CWK2(I,K,J)= COUT(K)  ! scalar in the nested domain
+         ENDDO      
+      ELSE
+         DO K=NKDS,NKDE-1
+           CWK2(I,K,J)=0.0
+         ENDDO 
+      ENDIF
+     ENDDO
+
+       DO J = NJTS,MIN(NJTE,NJDE-1)
+        DO K = NKDS,MIN(NKTE,NKDE-1)
+          ntemp_b(i,k,j)     = CWK2(I,K,J)
+          ntemp_bt(i,k,j)    = 0.0
+!         bdy(J,K,I,P_XSB)   = CWK2(I,K,J)         ! This will not work for NMM since
+!         bdy_t(J,K,I,P_XSB) = 0.0                 ! NMM requires BC halo exchanges
+!          if(k==1)WRITE(0,*)J,ntemp_b(i,k,j)
+        END DO
+       END DO
+
+    ENDIF NMM_XE
+
+!  Y start boundary
+
+    NMM_YS: IF(NJTS .EQ. NJDS)THEN
+!    WRITE(0,*)'ENTERING Y START BOUNDARY AT T POINTS',NITS,MIN(NITE,NIDE-1)
+     J = NJDS
+      DO K=NKDS,NKDE-1
+       DO I = NITS,MIN(NITE,NIDE-1)       
+          IF(MOD(JJH(I,J),2) .NE. 0)THEN      ! 1,3,5,7 of the parent domain
+            C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                       + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                       + HBWGT3(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                       + HBWGT4(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)+1)
+          ELSE
+            C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                       + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                       + HBWGT3(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                       + HBWGT4(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+          ENDIF
+        ENDDO
+      ENDDO
+!
+     DO I=NITS,MIN(NITE,NIDE-1)
+         CIN=0.;PIN=0.;Y2=0;PIO=0.;PTMP=0.;COUT=0.;DUM1=0.;DUM2=0. ! clean up local array
+         DO K=NKDS+1,NKDE                    ! inputs at standard  levels
+           PIN(K-1) = EXP((ALOG(PSTD(NKDE-K+1))+ALOG(PSTD(NKDE-K+2)))*0.5)
+           CIN(K-1) = C3d(I,NKDE-K+1,J)
+         ENDDO
+         Y2(1   )=0.
+         Y2(NKDE-1)=0.
+         DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+           PTMP(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP
+         ENDDO
+         DO K=NKDS,NKDE-1                        ! target points in model levels
+           PIO(K) = EXP((ALOG(PTMP(K))+ALOG(PTMP(K+1)))*0.5)
+         ENDDO
+         IF(PTMP(1) .GE. PSTD(1))THEN           ! if lower boundary is higher than PMSL(1) re-set lower boundary
+           PIN(NKDE-1) = PIO(1)                 ! be consistent with target. This may not happen at all
+           WRITE(0,*)'WARNING: NESTED DOMAIN PRESSURE AT LOWEST LEVEL HIGHER THAN PSTD'
+           WRITE(0,*)'I,J,PIO(1),PSTD(1)',I,J,PIO(1),PSTD(1)
+         ENDIF
+
+         CALL SPLINE2(I,J,JTB,NKDE-1,PIN,CIN,Y2,NKDE-1,PIO,COUT,DUM1,DUM2)  ! interpolate
+
+         DO K=1,NKDE-1
+           CWK3(I,K,J)= COUT(K)  ! scalar in the nested domain
+         ENDDO
+     ENDDO
+
+     DO K = NKDS,NKDE-1
+      DO I = NITS,MIN(NITE,NIDE-1)
+        ntemp_b(i,k,j)     = CWK3(I,K,J)
+        ntemp_bt(i,k,j)    = 0.0
+!       bdy(J,K,I,P_XSB)   = CWK3(I,K,J)         ! This will not work for NMM since
+!       bdy_t(J,K,I,P_XSB) = 0.0                 ! NMM requires BC halo exchanges
+      ENDDO
+      ENDDO
+
+
+    ENDIF NMM_YS
+
+! Y end boundary
+
+    NMM_YE: IF(NJTE-1 .EQ. NJDE-1)THEN
+!    WRITE(0,*)'ENTERING Y END BOUNDARY AT T POINTS',NITS,MIN(NITE,NIDE-1)
+     J = NJDE-1
+      DO K=NKDS,NKDE-1
+        DO I = NITS,MIN(NITE,NIDE-1)
+          IF(MOD(JJH(I,J),2) .NE. 0)THEN      ! 1,3,5,7 of the parent domain
+            C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )    &
+                       + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                       + HBWGT3(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)-1)    &
+                       + HBWGT4(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)+1)
+          ELSE
+            C3d(I,K,J) = HBWGT1(I,J)*CC3d(IIH(I,J),  K,  JJH(I,J)  )  &
+                       + HBWGT2(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                       + HBWGT3(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                       + HBWGT4(I,J)*CC3d(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+          ENDIF
+        ENDDO
+      ENDDO
+
+     DO I=NITS,MIN(NITE,NIDE-1)
+         CIN=0.;PIN=0.;Y2=0;PIO=0.;PTMP=0.;COUT=0.;DUM1=0.;DUM2=0. ! clean up local array
+         DO K=NKDS+1,NKDE                    ! inputs at standard  levels
+           PIN(K-1) = EXP((ALOG(PSTD(NKDE-K+1))+ALOG(PSTD(NKDE-K+2)))*0.5)
+           CIN(K-1) = C3d(I,NKDE-K+1,J)
+         ENDDO
+         Y2(1   )=0.
+         Y2(NKDE-1)=0.
+         DO K=NKDS,NKDE                         ! target points in model interface levels (pint)
+           PTMP(K) = ETA1(K)*PDTOP + ETA2(K)*PD(I,J) + PTOP
+         ENDDO
+         DO K=NKDS,NKDE-1                        ! target points in model levels
+           PIO(K) = EXP((ALOG(PTMP(K))+ALOG(PTMP(K+1)))*0.5)
+         ENDDO
+         IF(PTMP(1) .GE. PSTD(1))THEN           ! if lower boundary is higher than PMSL(1) re-set lower boundary
+           PIN(NKDE-1) = PIO(1)                 ! be consistent with target. This may not happen at all
+           WRITE(0,*)'WARNING: NESTED DOMAIN PRESSURE AT LOWEST LEVEL HIGHER THAN PSTD'
+           WRITE(0,*)'I,J,PIO(1),PSTD(1)',I,J,PIO(1),PSTD(1)
+         ENDIF
+
+         CALL SPLINE2(I,J,JTB,NKDE-1,PIN,CIN,Y2,NKDE-1,PIO,COUT,DUM1,DUM2)  ! interpolate
+
+         DO K=1,NKDE-1
+           CWK4(I,K,J)= COUT(K)  ! scalar in the nested domain
+         ENDDO
+     ENDDO
+
+     DO K = NKDS,NKDE-1
+      DO I = NITS,MIN(NITE,NIDE-1)
+        ntemp_b(i,k,j)     = CWK4(I,K,J)
+        ntemp_bt(i,k,j)    = 0.0
+!       bdy(J,K,I,P_XSB)   = CWK4(I,K,J)         ! This will not work for NMM since
+!       bdy_t(J,K,I,P_XSB) = 0.0                 ! NMM requires BC halo exchanges
+!        if(k==1)WRITE(0,*)I,ntemp_b(i,k,j)
+      END DO
+      END DO
+
+    ENDIF NMM_YE
+
+!
+  END SUBROUTINE nmm_bdy_scalar
+!
+!
+!=======================================================================================
+ SUBROUTINE SPLINE2(I,J,JTBX,NOLD,XOLD,YOLD,Y2,NNEW,XNEW,YNEW,P,Q)
+!
+!   ******************************************************************
+!   *                                                                *
+!   *  THIS IS A ONE-DIMENSIONAL CUBIC SPLINE FITTING ROUTINE        *
+!   *  PROGRAMED FOR A SMALL SCALAR MACHINE.                         *
+!   *                                                                *
+!   *  PROGRAMER Z. JANJIC                                           *
+!   *                                                                *
+!   *  NOLD - NUMBER OF GIVEN VALUES OF THE FUNCTION.  MUST BE GE 3. *
+!   *  XOLD - LOCATIONS OF THE POINTS AT WHICH THE VALUES OF THE     *
+!   *         FUNCTION ARE GIVEN.  MUST BE IN ASCENDING ORDER.       *
+!   *  YOLD - THE GIVEN VALUES OF THE FUNCTION AT THE POINTS XOLD.   *
+!   *  Y2   - THE SECOND DERIVATIVES AT THE POINTS XOLD.  IF NATURAL *
+!   *         SPLINE IS FITTED Y2(1)=0. AND Y2(NOLD)=0. MUST BE      *
+!   *         SPECIFIED.                                             *
+!   *  NNEW - NUMBER OF VALUES OF THE FUNCTION TO BE CALCULATED.     *
+!   *  XNEW - LOCATIONS OF THE POINTS AT WHICH THE VALUES OF THE     *
+!   *         FUNCTION ARE CALCULATED.  XNEW(K) MUST BE GE XOLD(1)   *
+!   *         AND LE XOLD(NOLD).                                     *
+!   *  YNEW - THE VALUES OF THE FUNCTION TO BE CALCULATED.           *
+!   *  P, Q - AUXILIARY VECTORS OF THE LENGTH NOLD-2.                *
+!   *                                                                *
+!   ******************************************************************
+!---------------------------------------------------------------------
+      IMPLICIT NONE
+!---------------------------------------------------------------------
+      INTEGER,INTENT(IN) :: I,J,JTBX,NNEW,NOLD
+      REAL,DIMENSION(JTBX),INTENT(IN) :: XNEW,XOLD,YOLD
+      REAL,DIMENSION(JTBX),INTENT(INOUT) :: P,Q,Y2
+      REAL,DIMENSION(JTBX),INTENT(OUT) :: YNEW
+!
+      INTEGER :: II,JJ,K,K1,K2,KOLD,NOLDM1
+      REAL :: AK,BK,CK,DEN,DX,DXC,DXL,DXR,DYDXL,DYDXR                 &
+             ,RDX,RTDXC,X,XK,XSQ,Y2K,Y2KP1
+!---------------------------------------------------------------------
+
+!     debug
+
+      II=9999
+      JJ=9999
+      IF(I.eq.II.and.J.eq.JJ)THEN
+        WRITE(0,*)'DEBUG in SPLINE2: I,J',I,J
+        WRITE(0,*)'DEBUG in SPLINE2:HSO= ',xnew(1:nold)
+        DO K=1,NOLD
+         WRITE(0,*)'DEBUG in SPLINE2:L,ZETAI,PINTI= ' &
+                        ,K,YOLD(K),XOLD(K)
+        ENDDO 
+      ENDIF 
+
+!
+      NOLDM1=NOLD-1
+!
+      DXL=XOLD(2)-XOLD(1)
+      DXR=XOLD(3)-XOLD(2)
+      DYDXL=(YOLD(2)-YOLD(1))/DXL
+      DYDXR=(YOLD(3)-YOLD(2))/DXR
+      RTDXC=0.5/(DXL+DXR)
+!
+      P(1)= RTDXC*(6.*(DYDXR-DYDXL)-DXL*Y2(1))
+      Q(1)=-RTDXC*DXR
+!
+      IF(NOLD.EQ.3)GO TO 150
+!---------------------------------------------------------------------
+      K=3
+!
+  100 DXL=DXR
+      DYDXL=DYDXR
+      DXR=XOLD(K+1)-XOLD(K)
+      DYDXR=(YOLD(K+1)-YOLD(K))/DXR
+      DXC=DXL+DXR
+      DEN=1./(DXL*Q(K-2)+DXC+DXC)
+!
+      P(K-1)= DEN*(6.*(DYDXR-DYDXL)-DXL*P(K-2))
+      Q(K-1)=-DEN*DXR
+!
+      K=K+1
+      IF(K.LT.NOLD)GO TO 100
+!-----------------------------------------------------------------------
+  150 K=NOLDM1
+!
+  200 Y2(K)=P(K-1)+Q(K-1)*Y2(K+1)
+!
+      K=K-1
+      IF(K.GT.1)GO TO 200
+!-----------------------------------------------------------------------
+      K1=1
+!
+  300 XK=XNEW(K1)
+!
+      DO 400 K2=2,NOLD
+!
+      IF(XOLD(K2).GT.XK)THEN
+        KOLD=K2-1
+        GO TO 450
+      ENDIF
+!
+  400 CONTINUE
+!
+      YNEW(K1)=YOLD(NOLD)
+      GO TO 600
+!
+  450 IF(K1.EQ.1)GO TO 500
+      IF(K.EQ.KOLD)GO TO 550
+!
+  500 K=KOLD
+!
+      Y2K=Y2(K)
+      Y2KP1=Y2(K+1)
+      DX=XOLD(K+1)-XOLD(K)
+      RDX=1./DX
+!
+      AK=.1666667*RDX*(Y2KP1-Y2K)
+      BK=0.5*Y2K
+      CK=RDX*(YOLD(K+1)-YOLD(K))-.1666667*DX*(Y2KP1+Y2K+Y2K)
+!
+  550 X=XK-XOLD(K)
+      XSQ=X*X
+!
+      YNEW(K1)=AK*XSQ*X+BK*XSQ+CK*X+YOLD(K)
+
+!  debug
+
+      IF(I.eq.II.and.J.eq.JJ)THEN
+        WRITE(0,*) 'DEBUG:: k1,xnew(k1),ynew(k1): ', K1,XNEW(k1),YNEW(k1)
+      ENDIF 
+
+!
+  600 K1=K1+1
+      IF(K1.LE.NNEW)GO TO 300
+
+      RETURN
+
+      END SUBROUTINE SPLINE2
+
+!=======================================================================================
+!  E grid interpolation for H and V points 
+!=======================================================================================
+
+  SUBROUTINE interp_h_nmm (cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &  ! nest ratios                           
+                           CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! south-western grid locs and weights 
+                           CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                           CBWGT4, HBWGT4                        )  ! dummys for weights
+     USE module_timing
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIH,JJH
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+
+!    local
+     INTEGER i,j,k
+!
+!*** CHECK DOMAIN BOUNDS BEFORE INTERPOLATION
+!
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+     DO I=NITS,MIN(NITE,NIDE-1)
+       IF(IIH(i,j).LT.(CIDS-shw) .OR. IIH(i,j).GT.(CIDE+shw)) &
+           CALL wrf_error_fatal ('hpoints:check domain bounds along x' )
+       IF(JJH(i,j).LT.(CJDS-shw) .OR. JJH(i,j).GT.(CJDE+shw)) &
+           CALL wrf_error_fatal ('hpoints:check domain bounds along y' )
+     ENDDO
+    ENDDO
+
+!    WRITE(23,*)'------------- MED NEST INITIAL 3 ----------------'
+!    DO J=NJTS,MIN(NJTE,NJDE-1)
+!      DO I=NITS,MIN(NITE,NIDE-1)
+!         WRITE(23,*)I,J,IMASK(I,J),NFLD(I,1,J)
+!      ENDDO
+!    ENDDO
+!    WRITE(23,*)
+
+!
+!*** INDEX CONVENTIONS
+!***                     HBWGT4
+!***                      4
+!***
+!***
+!***
+!***                   h
+!***             1                 2
+!***            HBWGT1             HBWGT2
+!***
+!***
+!***                      3
+!***                     HBWGT3
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+       DO K=NKDS,NKDE
+        DO I=NITS,MIN(NITE,NIDE-1)
+         IF(IMASK(I,J) .NE. 1)THEN
+!
+           IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7 
+               NFLD(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )    & 
+                           + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                           + HBWGT3(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)-1)    &  
+                           + HBWGT4(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)+1)
+           ELSE
+               NFLD(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )  &
+                           + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                           + HBWGT3(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                           + HBWGT4(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)+1)
+           ENDIF
+!     
+         ENDIF
+        ENDDO
+       ENDDO
+     ENDDO
+
+  END SUBROUTINE interp_h_nmm 
+!
+  SUBROUTINE interp_v_nmm (cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &  ! nest ratios
+                           CII, IIV, CJJ, JJV, CBWGT1, VBWGT1,   &  ! south-western grid locs and weights
+                           CBWGT2, VBWGT2, CBWGT3, VBWGT3,       &  ! note that "C"ourse grid ones are
+                           CBWGT4, VBWGT4                        )  ! dummys
+     USE module_timing
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: VBWGT1,VBWGT2,VBWGT3,VBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIV,JJV
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+
+!    local
+     INTEGER i,j,k
+
+
+!
+!*** CHECK DOMAIN BOUNDS BEFORE INTERPOLATION
+!
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+     DO I=NITS,MIN(NITE,NIDE-1)
+       IF(IIV(i,j).LT.(CIDS-shw) .OR. IIV(i,j).GT.(CIDE+shw)) &
+           CALL wrf_error_fatal ('vpoints:check domain bounds along x' )
+       IF(JJV(i,j).LT.(CJDS-shw) .OR. JJV(i,j).GT.(CJDE+shw)) &
+           CALL wrf_error_fatal ('vpoints:check domain bounds along y' ) 
+     ENDDO
+    ENDDO
+
+!    WRITE(24,*)'------------- MED NEST INITIAL 4 ----------------'
+!    DO J=NJTS,MIN(NJTE,NJDE-1)
+!      DO I=NITS,MIN(NITE,NIDE-1)
+!         WRITE(24,*)I,J,IMASK(I,J),NFLD(I,1,J)
+!      ENDDO
+!    ENDDO
+!    WRITE(24,*)
+
+!
+!*** INDEX CONVENTIONS
+!***                     VBWGT4
+!***                      4
+!***
+!***
+!***
+!***                   h
+!***             1                 2
+!***            VBWGT1             VBWGT2
+!***
+!***
+!***                      3
+!***                     VBWGT3
+
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+       DO K=NKDS,NKDE
+        DO I=NITS,MIN(NITE,NIDE-1)
+         IF(IMASK(I,J) .NE. 1)THEN 
+!
+            IF(MOD(JJV(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+                NFLD(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,  JJV(I,J)  )    &
+                           + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)  )    &
+                           + VBWGT3(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)-1)    &
+                           + VBWGT4(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)+1)
+            ELSE
+                NFLD(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)  )      &
+                            + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,JJV(I,J)  )      &
+                            + VBWGT3(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)-1)      & 
+                            + VBWGT4(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)+1) 
+            ENDIF
+!
+         ENDIF     
+        ENDDO
+       ENDDO
+     ENDDO
+
+  END SUBROUTINE interp_v_nmm
+!
+!=======================================================================================
+!  E grid nearest neighbour interpolation for H points
+!=======================================================================================
+!
+  SUBROUTINE interp_hnear_nmm (cfld,                                 &  ! CD field
+                               cids, cide, ckds, ckde, cjds, cjde,   &
+                               cims, cime, ckms, ckme, cjms, cjme,   &
+                               cits, cite, ckts, ckte, cjts, cjte,   &
+                               nfld,                                 &  ! ND field
+                               nids, nide, nkds, nkde, njds, njde,   &
+                               nims, nime, nkms, nkme, njms, njme,   &
+                               nits, nite, nkts, nkte, njts, njte,   &
+                               shw,                                  &  ! stencil half width for interp
+                               imask,                                &  ! interpolation mask
+                               xstag, ystag,                         &  ! staggering of field
+                               ipos, jpos,                           &  ! Position of lower left of nest in CD
+                               nri, nrj,                             &  ! nest ratios                         
+                               CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! south-western grid locs and weights 
+                               CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                               CBWGT4, HBWGT4                        )  ! just dummys
+     USE module_timing
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIH,JJH
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+
+!    local
+
+     LOGICAL  FLIP 
+     INTEGER  i,j,k,n
+     REAL     SUM,AMAXVAL
+     REAL,    DIMENSION (4, nims:nime, njms:njme ) :: NBWGT
+
+
+!    WRITE(25,*)'------------- MED NEST INITIAL 5 ----------------'
+!    DO J=NJTS,MIN(NJTE,NJDE-1)
+!      DO I=NITS,MIN(NITE,NIDE-1)
+!         WRITE(25,*)I,J,IMASK(I,J),NFLD(I,1,J)
+!      ENDDO
+!    ENDDO
+!    WRITE(25,*)
+
+!
+!*** INDEX CONVENTIONS
+!***                     NBWGT4=0
+!***                      4
+!***
+!***
+!***
+!***                   h
+!***             1                 2
+!***            NBWGT1=1           NBWGT2=0
+!***
+!***
+!***                      3
+!***                     NBWGT3=0
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+      DO I=NITS,MIN(NITE,NIDE-1)
+       IF(IMASK(I,J) .NE. 1)THEN
+         NBWGT(1,I,J)=HBWGT1(I,J)
+         NBWGT(2,I,J)=HBWGT2(I,J)
+         NBWGT(3,I,J)=HBWGT3(I,J)
+         NBWGT(4,I,J)=HBWGT4(I,J)
+       ENDIF
+      ENDDO
+     ENDDO
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+      DO I=NITS,MIN(NITE,NIDE-1)
+       IF(IMASK(I,J) .NE. 1)THEN    
+!
+          AMAXVAL=0.
+          DO N=1,4
+            AMAXVAL=amax1(NBWGT(N,I,J),AMAXVAL) 
+          ENDDO
+!
+          FLIP=.TRUE.
+          SUM=0.0
+          DO N=1,4
+             IF(AMAXVAL .EQ. NBWGT(N,I,J) .AND. FLIP)THEN
+               NBWGT(N,I,J)=1.0
+               FLIP=.FALSE.
+             ELSE
+               NBWGT(N,I,J)=0.0
+             ENDIF
+             SUM=SUM+NBWGT(N,I,J)
+             IF(SUM .GT. 1.0)CALL wrf_error_fatal ( "horizontal interp error - interp_hnear_nmm" )
+          ENDDO
+! 
+       ENDIF
+      ENDDO
+     ENDDO
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+       DO K=NKDS,NKDE
+        DO I=NITS,MIN(NITE,NIDE-1)
+         IF(IMASK(I,J) .NE. 1)THEN 
+            IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7 
+                NFLD(I,K,J) = NBWGT(1,I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )    & 
+                            + NBWGT(2,I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                            + NBWGT(3,I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)-1)    &  
+                            + NBWGT(4,I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)+1) 
+            ELSE
+                NFLD(I,K,J) = NBWGT(1,I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )  &
+                            + NBWGT(2,I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                            + NBWGT(3,I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                            + NBWGT(4,I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+            ENDIF      
+!
+         ENDIF 
+        ENDDO
+       ENDDO
+     ENDDO
+
+  END SUBROUTINE interp_hnear_nmm 
+!
+!=======================================================================================
+!  E grid nearest neighbour interpolation for integer H points
+!=======================================================================================
+!
+  SUBROUTINE interp_int_hnear_nmm (cfld,                                 &  ! CD field; integers
+                                   cids, cide, ckds, ckde, cjds, cjde,   &
+                                   cims, cime, ckms, ckme, cjms, cjme,   &
+                                   cits, cite, ckts, ckte, cjts, cjte,   &
+                                   nfld,                                 &  ! ND field; integers
+                                   nids, nide, nkds, nkde, njds, njde,   &
+                                   nims, nime, nkms, nkme, njms, njme,   &
+                                   nits, nite, nkts, nkte, njts, njte,   &
+                                   shw,                                  &  ! stencil half width for interp
+                                   imask,                                &  ! interpolation mask
+                                   xstag, ystag,                         &  ! staggering of field
+                                   ipos, jpos,                           &  ! lower left of nest in CD
+                                   nri, nrj,                             &  ! nest ratios                      
+                                   CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! s-w grid locs and weights 
+                                   CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                                   CBWGT4, HBWGT4                        )  ! just dummys
+     USE module_timing
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     INTEGER, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     INTEGER, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIH,JJH
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+
+!    local
+
+     LOGICAL  FLIP 
+     INTEGER  i,j,k,n
+     REAL     SUM,AMAXVAL
+     REAL,    DIMENSION (4, nims:nime, njms:njme ) :: NBWGT
+
+
+
+!    WRITE(26,*)'------------- MED NEST INITIAL 6 ----------------'
+!    DO J=NJTS,MIN(NJTE,NJDE-1)
+!      DO I=NITS,MIN(NITE,NIDE-1)
+!         WRITE(26,*)I,J,IMASK(I,J),NFLD(I,1,J)
+!      ENDDO
+!    ENDDO
+!    WRITE(26,*)
+
+!
+!*** INDEX CONVENTIONS
+!***                     NBWGT4=0
+!***                      4
+!***
+!***
+!***
+!***                   h
+!***             1                 2
+!***            NBWGT1=1           NBWGT2=0
+!***
+!***
+!***                      3
+!***                     NBWGT3=0
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+       DO I=NITS,MIN(NITE,NIDE-1)
+        IF(IMASK(I,J) .NE. 1)THEN
+          NBWGT(1,I,J)=HBWGT1(I,J)
+          NBWGT(2,I,J)=HBWGT2(I,J)
+          NBWGT(3,I,J)=HBWGT3(I,J)
+          NBWGT(4,I,J)=HBWGT4(I,J)
+        ENDIF
+       ENDDO
+     ENDDO
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+      DO I=NITS,MIN(NITE,NIDE-1)
+       IF(IMASK(I,J) .NE. 1)THEN
+!
+          AMAXVAL=0.
+          DO N=1,4
+            AMAXVAL=amax1(NBWGT(N,I,J),AMAXVAL) 
+          ENDDO
+!
+          FLIP=.TRUE.
+          SUM=0.0
+          DO N=1,4
+             IF(AMAXVAL .EQ. NBWGT(N,I,J) .AND. FLIP)THEN
+               NBWGT(N,I,J)=1.0
+               FLIP=.FALSE.
+             ELSE
+               NBWGT(N,I,J)=0.0
+             ENDIF
+             SUM=SUM+NBWGT(N,I,J)
+             IF(SUM .GT. 1.0)CALL wrf_error_fatal ( "horizontal interp error - interp_hnear_nmm" )
+          ENDDO
+! 
+       ENDIF
+      ENDDO
+     ENDDO
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+       DO K=NKTS,NKTS
+        DO I=NITS,MIN(NITE,NIDE-1)
+!
+         IF(IMASK(I,J) .NE. 1)THEN  
+           IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7 
+               NFLD(I,K,J) = NBWGT(1,I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )    & 
+                           + NBWGT(2,I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                           + NBWGT(3,I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)-1)    &  
+                           + NBWGT(4,I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)+1) 
+           ELSE
+               NFLD(I,K,J) = NBWGT(1,I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )  &
+                           + NBWGT(2,I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                           + NBWGT(3,I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                           + NBWGT(4,I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+           ENDIF     
+!
+         ENDIF 
+        ENDDO
+       ENDDO
+     ENDDO
+
+  END SUBROUTINE interp_int_hnear_nmm 
+!
+!--------------------------------------------------------------------------------------
+
+   SUBROUTINE nmm_bdy_hinterp (cfld,                                 &  ! CD field
+                               cids, cide, ckds, ckde, cjds, cjde,   &
+                               cims, cime, ckms, ckme, cjms, cjme,   &
+                               cits, cite, ckts, ckte, cjts, cjte,   &
+                               nfld,                                 &  ! ND field
+                               nids, nide, nkds, nkde, njds, njde,   &
+                               nims, nime, nkms, nkme, njms, njme,   &
+                               nits, nite, nkts, nkte, njts, njte,   &
+                               shw,                                  &  ! stencil half width
+                               imask,                                &  ! interpolation mask
+                               xstag, ystag,                         &  ! staggering of field
+                               ipos, jpos,                           &  ! Position of lower left of nest in CD
+                               nri, nrj,                             &  ! nest ratios
+                               cbdy, nbdy,                           &
+                               cbdy_t, nbdy_t,                       &
+                               cdt, ndt,                             &
+                               CTEMP_B,NTEMP_B,                      &  ! These temp arrays should be removed
+                               CTEMP_BT,NTEMP_BT,                    &  ! later on
+                               CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! south-western grid locs and weights
+                               CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                               CBWGT4, HBWGT4                        )  ! dummys
+
+     USE module_configure
+     USE module_wrf_error
+
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+!
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: ctemp_b,ctemp_bt
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: ntemp_b,ntemp_bt
+!
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+     REAL,  DIMENSION( * ), INTENT(INOUT) :: cbdy, cbdy_t, nbdy, nbdy_t
+     REAL cdt, ndt
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIH,JJH
+! Local
+
+     INTEGER nijds, nijde, spec_bdy_width,i,j,k
+
+     nijds = min(nids, njds)
+     nijde = max(nide, njde)
+     CALL nl_get_spec_bdy_width( 1, spec_bdy_width )
+
+
+     CALL nmm_bdy_interp1( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nijds, nijde , spec_bdy_width ,       &
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw, imask,                           &
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &
+                           cdt, ndt,                             &
+                           CTEMP_B,NTEMP_B,                      &  ! These temp arrays should be removed
+                           CTEMP_BT,NTEMP_BT,                    &  ! later on
+                           CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! south-western grid locs and weights
+                           CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                           CBWGT4, HBWGT4                        )  ! dummys
+
+    RETURN
+
+   END SUBROUTINE nmm_bdy_hinterp
+
+!----------------------------------------------------------------------------------------------------
+   SUBROUTINE nmm_bdy_interp1( cfld,                             &  ! CD field 
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nijds, nijde, spec_bdy_width ,        &
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw1,                                 &
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &
+                           cdt, ndt,                             &
+                           CTEMP_B,NTEMP_B,                      &  ! These temp arrays should be removed
+                           CTEMP_BT,NTEMP_BT,                    &  ! later on
+                           CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! south-western grid locs and weights
+                           CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                           CBWGT4, HBWGT4                        )  ! dummys
+
+     use module_state_description
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw1,                                 &  ! ignore
+                            ipos, jpos,                           &
+                            nri, nrj
+     INTEGER, INTENT(IN) :: nijds, nijde, spec_bdy_width
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(INOUT) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(INOUT) :: nfld
+!
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(INOUT) :: ctemp_b,ctemp_bt
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(INOUT) :: ntemp_b,ntemp_bt
+!
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+     REAL                                 :: cdt, ndt
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIH,JJH
+
+!    local
+
+     INTEGER :: i,j,k,ii,jj
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme )    :: cwk1,cwk2,cwk3,cwk4
+
+!    X start boundary
+
+       NMM_XS: IF(NITS .EQ. NIDS)THEN
+!        WRITE(0,*)'ENTERING X1 START BOUNDARY AT MASS POINTS',NJTS,MIN(NJTE,NJDE-1)
+        I = NIDS
+        DO J = NJTS,MIN(NJTE,NJDE-1)
+         DO K = NKDS,NKDE
+              IF(MOD(J,2) .NE.0)THEN                ! 1,3,5,7 of nested domain
+                IF(MOD(JJH(I,J),2) .NE. 0)THEN      ! 1,3,5,7 of the parent domain
+                   CWK1(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )    &
+                               + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                               + HBWGT3(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)-1)    &
+                               + HBWGT4(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)+1)
+
+
+                ELSE
+                   CWK1(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )  &
+                               + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                               + HBWGT3(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                               + HBWGT4(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)+1)
+                ENDIF
+              ELSE
+                CWK1(I,K,J) = 0.0      ! even rows at mass points of the nested domain
+              ENDIF
+              ntemp_b(i,k,j)     = CWK1(I,K,J)
+              ntemp_bt(i,k,j)    = 0.0
+!             bdy(J,K,I,P_XSB)   = CWK1(I,K,J)    ! This will not work for NMM core
+!             bdy_t(J,K,I,P_XSB) = 0.0            ! since NMM requires BC halos
+         END DO
+        END DO
+       ENDIF NMM_XS
+
+!    X end boundary
+
+       NMM_XE: IF(NITE-1 .EQ. NIDE-1)THEN
+!       WRITE(0,*)'ENTERING X END BOUNDARY AT MASS POINTS',NJTS,MIN(NJTE,NJDE-1)
+        I = NIDE-1
+        DO J = NJTS,MIN(NJTE,NJDE-1)
+         DO K = NKDS,NKDE
+              IF(MOD(J,2) .NE.0)THEN                ! 1,3,5,7 of the nested domain 
+                IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7 of the parent domain
+                   CWK2(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )    &
+                               + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                               + HBWGT3(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)-1)    &
+                               + HBWGT4(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)+1)
+                ELSE
+                   CWK2(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )  &
+                               + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                               + HBWGT3(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                               + HBWGT4(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+                ENDIF
+              ELSE
+                CWK2(I,K,J) = 0.0      ! even rows at mass points
+              ENDIF
+              II = NIDE - I
+              ntemp_b(i,k,j)     = CWK2(I,K,J)
+              ntemp_bt(i,k,j)    = 0.0
+!              bdy(J,K,II,P_XEB)  = CWK2(I,K,J)
+!              bdy_t(J,K,II,P_XEB)= 0.0
+         END DO
+        END DO
+       ENDIF NMM_XE
+
+!  Y start boundary
+
+       NMM_YS: IF(NJTS .EQ. NJDS)THEN
+!        WRITE(0,*)'ENTERING Y START BOUNDARY AT MASS POINTS',NITS,MIN(NITE,NIDE-1)
+        J = NJDS
+        DO K = NKDS, NKDE 
+         DO I = NITS,MIN(NITE,NIDE-1)
+              IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+                 CWK3(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )    &
+                             + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                             + HBWGT3(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)-1)    &
+                             + HBWGT4(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)+1)
+              ELSE
+                 CWK3(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )  &
+                             + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                             + HBWGT3(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                             + HBWGT4(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+              ENDIF
+              ntemp_b(i,k,j)     = CWK3(I,K,J)
+              ntemp_bt(i,k,j)    = 0.0
+!             bdy(I,K,J,P_YSB)   = CWK3(I,K,J)
+!             bdy_t(I,K,J,P_YSB) = 0.0
+         END DO
+        END DO
+       END IF NMM_YS 
+
+! Y end boundary
+
+       NMM_YE: IF(NJTE-1 .EQ. NJDE-1)THEN
+!        WRITE(0,*)'ENTERING Y END BOUNDARY AT MASS POINTS',NITS,MIN(NITE,NIDE-1)
+        J = NJDE-1
+        DO K = NKDS,NKDE 
+         DO I = NITS,MIN(NITE,NIDE-1)
+              IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+                 CWK4(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )    &
+                             + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                             + HBWGT3(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)-1)    &
+                             + HBWGT4(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)+1)
+              ELSE
+                 CWK4(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )  &
+                             + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                             + HBWGT3(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                             + HBWGT4(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)+1)
+
+              ENDIF
+              JJ = NJDE - J 
+              ntemp_b(i,k,j)     = CWK4(I,K,J)
+              ntemp_bt(i,k,j)    = 0.0
+!             bdy(I,K,JJ,P_YEB) = CWK4(I,K,J)
+!             bdy_t(I,K,JJ,P_YEB) = 0.0
+         END DO
+        END DO
+       END IF NMM_YE 
+
+     RETURN
+
+   END SUBROUTINE nmm_bdy_interp1
+
+!--------------------------------------------------------------------------------------
+
+   SUBROUTINE nmm_bdy_vinterp ( cfld,                                 &  ! CD field
+                               cids, cide, ckds, ckde, cjds, cjde,   &
+                               cims, cime, ckms, ckme, cjms, cjme,   &
+                               cits, cite, ckts, ckte, cjts, cjte,   &
+                               nfld,                                 &  ! ND field
+                               nids, nide, nkds, nkde, njds, njde,   &
+                               nims, nime, nkms, nkme, njms, njme,   &
+                               nits, nite, nkts, nkte, njts, njte,   &
+                               shw,                                  &  ! stencil half width
+                               imask,                                &  ! interpolation mask
+                               xstag, ystag,                         &  ! staggering of field
+                               ipos, jpos,                           &  ! Position of lower left of nest in CD
+                               nri, nrj,                             &  ! nest ratios
+                               cbdy, nbdy,                           &
+                               cbdy_t, nbdy_t,                       &
+                               cdt, ndt,                             &
+                               CTEMP_B,NTEMP_B,                      &  ! These temp arrays should be removed
+                               CTEMP_BT,NTEMP_BT,                    &  ! later on
+                               CII, IIV, CJJ, JJV, CBWGT1, VBWGT1,   &  ! south-western grid locs and weights
+                               CBWGT2, VBWGT2, CBWGT3, VBWGT3,       &  ! note that "C"ourse grid ones are
+                               CBWGT4, VBWGT4                        )  ! dummys
+
+     USE module_configure
+     USE module_wrf_error
+
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+!
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: ctemp_b,ctemp_bt
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: ntemp_b,ntemp_bt
+!
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+     REAL,  DIMENSION( * ), INTENT(INOUT) :: cbdy, cbdy_t, nbdy, nbdy_t
+     REAL cdt, ndt
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: VBWGT1,VBWGT2,VBWGT3,VBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIV,JJV
+
+! Local
+
+     INTEGER nijds, nijde, spec_bdy_width
+
+     nijds = min(nids, njds)
+     nijde = max(nide, njde)
+     CALL nl_get_spec_bdy_width( 1, spec_bdy_width )
+
+     CALL nmm_bdy_interp2( cfld,                                     &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nijds, nijde , spec_bdy_width ,       &  
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw, imask,                           &
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &
+                           cdt, ndt,                             &
+                           CTEMP_B,NTEMP_B,                      &  ! These temp arrays should be removed
+                           CTEMP_BT,NTEMP_BT,                    &  ! later on
+                           CII, IIV, CJJ, JJV, CBWGT1, VBWGT1,   &  ! south-western grid locs and weights
+                           CBWGT2, VBWGT2, CBWGT3, VBWGT3,       &  ! note that "C"ourse grid ones are
+                           CBWGT4, VBWGT4                        )  ! dummys
+    RETURN
+
+   END SUBROUTINE nmm_bdy_vinterp 
+
+!----------------------------------------------------------------------------------------------------
+   SUBROUTINE nmm_bdy_interp2( cfld,                             &  ! CD field 
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nijds, nijde, spec_bdy_width ,        &
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw1,                                 &
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &
+                           cdt, ndt,                             &
+                           CTEMP_B,NTEMP_B,                      &  ! These temp arrays should be removed
+                           CTEMP_BT,NTEMP_BT,                    &  ! later on
+                           CII, IIV, CJJ, JJV, CBWGT1, VBWGT1,   &  ! south-western grid locs and weights
+                           CBWGT2, VBWGT2, CBWGT3, VBWGT3,       &  ! note that "C"ourse grid ones are
+                           CBWGT4, VBWGT4                        )
+
+     use module_state_description
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw1,                                 &  ! ignore
+                            ipos, jpos,                           &
+                            nri, nrj
+     INTEGER, INTENT(IN) :: nijds, nijde, spec_bdy_width
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(INOUT) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(INOUT) :: nfld
+!
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(INOUT) :: ctemp_b,ctemp_bt
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(INOUT) :: ntemp_b,ntemp_bt
+!
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+     REAL                                 :: cdt, ndt
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: VBWGT1,VBWGT2,VBWGT3,VBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIV,JJV
+
+!    local
+
+     INTEGER :: i,j,k,ii,jj
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme )    :: cwk1,cwk2,cwk3,cwk4
+
+!    X start boundary
+
+       NMM_XS: IF(NITS .EQ. NIDS)THEN
+!      WRITE(0,*)'ENTERING X START BOUNDARY AT VELOCITY POINTS',NITS,NIDS,NJTS,MIN(NJTE,NJDE-1)
+        I = NIDS
+        DO J = NJTS,MIN(NJTE,NJDE-1)
+         DO K = NKDS,NKDE
+              IF(MOD(J,2) .EQ.0)THEN                ! 1,3,5,7 of nested domain
+                IF(MOD(JJV(I,J),2) .NE. 0)THEN      ! 1,3,5,7 of the parent domain
+                      CWK1(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,  JJV(I,J)  )    &
+                                  + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)  )    &
+                                  + VBWGT3(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)-1)    &
+                                  + VBWGT4(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)+1)
+                ELSE
+                      CWK1(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)  )      &
+                                  + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,JJV(I,J)  )      &
+                                  + VBWGT3(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)-1)      &
+                                  + VBWGT4(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)+1)
+                ENDIF
+              ELSE
+                CWK1(I,K,J) = 0.0 ! odd rows along J, at mass points have zero velocity  
+              ENDIF
+              ntemp_b(i,k,j)     = CWK1(I,K,J)
+              ntemp_bt(i,k,j)    = 0.0
+!             bdy(J,K,I,P_XSB)   = CWK1(I,K,J)
+!             bdy_t(J,K,I,P_XSB) = 0.0
+!             IF(k==1)WRITE(0,*)IIV(I,J),JJV(I,J),i,j,VBWGT1(I,J),VBWGT2(I,J),VBWGT3(I,J),VBWGT4(I,J)
+!             IF(k==1)WRITE(0,*)i,j,ntemp_b(i,k,j)
+         END DO
+        END DO
+       ENDIF NMM_XS
+
+!    X end boundary
+
+       NMM_XE: IF(NITE-1 .EQ. NIDE-1)THEN
+!        WRITE(0,*)'ENTERING X END BOUNDARY AT VELOCITY POINTS',NITE-1,NIDE-1,NJTS,MIN(NJTE,NJDE-1)
+        I = NIDE-1
+        DO J = NJTS,MIN(NJTE,NJDE-1)
+         DO K = NKDS,NKDE
+              IF(MOD(J,2) .EQ.0)THEN                ! 1,3,5,7 of the nested domain
+                IF(MOD(JJV(I,J),2) .NE. 0)THEN      ! 1,3,5,7 of the parent domain
+                   CWK2(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,  JJV(I,J)  )    &
+                               + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)  )    &
+                               + VBWGT3(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)-1)    &
+                               + VBWGT4(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)+1)
+                ELSE
+                   CWK2(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)  )      &
+                               + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,JJV(I,J)  )      &
+                               + VBWGT3(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)-1)      &
+                               + VBWGT4(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)+1)
+                ENDIF
+              ELSE
+                CWK2(I,K,J) = 0.0      ! odd rows at mass points
+              ENDIF
+              II = NIDE - I
+              ntemp_b(i,k,j)     = CWK2(I,K,J)
+              ntemp_bt(i,k,j)    = 0.0
+!             bdy(J,K,II,P_XEB)  = CWK2(I,K,J)
+!             bdy_t(J,K,II,P_XEB)= 0.0
+!             IF(k==1)WRITE(0,*)IIV(I,J),JJV(I,J),i,j,VBWGT1(I,J),VBWGT2(I,J),VBWGT3(I,J),VBWGT4(I,J)
+!             IF(k==1)WRITE(0,*)i,j,ntemp_b(i,k,j)
+         END DO
+        END DO
+       ENDIF NMM_XE
+
+!  Y start boundary
+
+       NMM_YS: IF(NJTS .EQ. NJDS)THEN
+!        WRITE(0,*)'ENTERING Y START BOUNDARY AT VELOCITY POINTS',NJTS,NJDS,NITS,MIN(NITE,NIDE-1)
+        J = NJDS
+        DO K = NKDS, NKDE
+         DO I = NITS,MIN(NITE,NIDE-2)     ! NIDE-1 SHOULD NOT MATTER IF WE FILL UP PHANTOM CELL 
+              IF(MOD(JJV(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+                 CWK3(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,  JJV(I,J)  )    &
+                             + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)  )    &
+                             + VBWGT3(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)-1)    &
+                             + VBWGT4(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)+1)
+              ELSE
+                 CWK3(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)  )      &
+                             + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,JJV(I,J)  )      &
+                             + VBWGT3(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)-1)      &
+                             + VBWGT4(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)+1)
+              ENDIF
+              ntemp_b(i,k,j)     = CWK3(I,K,J)
+              ntemp_bt(i,k,j)    = 0.0
+!             bdy(I,K,J,P_YSB)   = CWK3(I,K,J)
+!             bdy_t(I,K,J,P_YSB) = 0.0
+!             IF(k==1)WRITE(0,*)IIV(I,J),JJV(I,J),i,j,VBWGT1(I,J),VBWGT2(I,J),VBWGT3(I,J),VBWGT4(I,J)
+         END DO
+        END DO
+       END IF NMM_YS
+
+! Y end boundary
+
+       NMM_YE: IF(NJTE-1 .EQ. NJDE-1)THEN
+!       WRITE(0,*)'ENTERING Y END BOUNDARY AT VELOCITY POINTS',NJTE-1,NJDE-1,NITS,MIN(NITE,NIDE-1)
+        J = NJDE-1
+        DO K = NKDS,NKDE
+         DO I = NITS,MIN(NITE,NIDE-2)   ! NIDE-1 SHOULD NOT MATTER IF WE FILL UP PHANTOM CELL
+              IF(MOD(JJV(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+                 CWK4(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,  JJV(I,J)  )    &
+                             + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)  )    &
+                             + VBWGT3(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)-1)    &
+                             + VBWGT4(I,J)*CFLD(IIV(I,J)+1,K,  JJV(I,J)+1)
+              ELSE
+                 CWK4(I,K,J) = VBWGT1(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)  )      &
+                             + VBWGT2(I,J)*CFLD(IIV(I,J)+1,K,JJV(I,J)  )      &
+                             + VBWGT3(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)-1)      &
+                             + VBWGT4(I,J)*CFLD(IIV(I,J),  K,JJV(I,J)+1)
+              ENDIF
+              JJ = NJDE - J
+              ntemp_b(i,k,j)     = CWK4(I,K,J)
+              ntemp_bt(i,k,j)    = 0.0
+!             bdy(I,K,JJ,P_YEB) = CWK4(I,K,J)
+!             bdy_t(I,K,JJ,P_YEB) = 0.0
+!             IF(k==1)WRITE(0,*)IIV(I,J),JJV(I,J),i,j,VBWGT1(I,J),VBWGT2(I,J),VBWGT3(I,J),VBWGT4(I,J)
+         END DO
+        END DO
+       END IF NMM_YE
+
+     RETURN
+
+   END SUBROUTINE nmm_bdy_interp2
+
+!
+!=======================================================================================
+! E grid interpolation: simple copy from parent to mother domain
+!=======================================================================================
+!
+!--------------------------------------------------------------------------------------
+!
+!
+   SUBROUTINE nmm_copy      ( cfld,                                 &  ! CD field
+                              cids, cide, ckds, ckde, cjds, cjde,   &
+                              cims, cime, ckms, ckme, cjms, cjme,   &
+                              cits, cite, ckts, ckte, cjts, cjte,   &
+                              nfld,                                 &  ! ND field
+                              nids, nide, nkds, nkde, njds, njde,   &
+                              nims, nime, nkms, nkme, njms, njme,   &
+                              nits, nite, nkts, nkte, njts, njte,   &
+                              shw,                                  &  ! stencil half width
+                              imask,                                &  ! interpolation mask
+                              xstag, ystag,                         &  ! staggering of field
+                              ipos, jpos,                           &  ! Position of lower left of nest in CD
+                              nri, nrj,                             &  ! nest ratios
+                              CII, IIH, CJJ, JJH                    )  
+
+     USE module_timing
+     IMPLICIT NONE
+
+     LOGICAL, INTENT(IN) :: xstag, ystag
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(IN)    :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(INOUT) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: imask
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIH,JJH
+
+!    local
+     INTEGER i,j,k
+
+
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+       DO K=NKTS,NKTE
+        DO I=NITS,MIN(NITE,NIDE-1)
+           NFLD(I,K,J) = CFLD(IIH(I,J),K,JJH(I,J))
+        ENDDO
+       ENDDO
+     ENDDO
+
+  RETURN
+
+  END SUBROUTINE nmm_copy
+!
+!=======================================================================================
+!  E grid interpolation for terrain: In order to be consistent with the quasi-hydrostatic  
+!  balance at the boundaries, a four point average of the terrain is done at the second 
+!  and the penaltimate rows and columns around the boundaries.
+!=======================================================================================
+!
+  SUBROUTINE interp_topo_nmm (cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &  ! nest ratios                           
+                           CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   &  ! south-western grid locs and weights 
+                           CBWGT2, HBWGT2, CBWGT3, HBWGT3,       &  ! note that "C"ourse grid ones are
+                           CBWGT4, HBWGT4                        )  ! dummys for weights
+     USE module_timing
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIH,JJH
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+
+!    local
+     INTEGER i,j,k
+!
+!*** CHECK DOMAIN BOUNDS BEFORE INTERPOLATION
+!
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+     DO I=NITS,MIN(NITE,NIDE-1)
+       IF(IIH(i,j).LT.(CIDS-shw) .OR. IIH(i,j).GT.(CIDE+shw)) &
+           CALL wrf_error_fatal ('hpoints:check domain bounds along x' )
+       IF(JJH(i,j).LT.(CJDS-shw) .OR. JJH(i,j).GT.(CJDE+shw)) &
+           CALL wrf_error_fatal ('hpoints:check domain bounds along y' )
+     ENDDO
+    ENDDO
+
+
+!
+!*** INDEX CONVENTIONS
+!***                     HBWGT4
+!***                      4
+!***
+!***
+!***
+!***                   h
+!***             1                 2
+!***            HBWGT1             HBWGT2
+!***
+!***
+!***                      3
+!***                     HBWGT3
+
+     WRITE(0,*)'HALO WEIGHTS: interp_fcn.F','NITS to MIN(NITE,NIDE-1)=',NITS,MIN(NITE,NIDE-1)
+     WRITE(0,*)'HALO WEIGHTS: interp_fcn.F','NJTS to MIN(NJTE,NJDE-1)=',NJTS,MIN(NJTE,NJDE-1)
+
+     DO J=MAX(NJTS-1,NJDS),MIN(NJTE+1,NJDE-1)
+      DO K=NKDS,NKDE
+       DO I=MAX(NITS-1,NIDS),MIN(NITE+1,NIDE-1)
+        IF(IMASK(I,J) .NE. 1)THEN
+!
+           IF(I==1 .AND. K==1)WRITE(0,*)'HALO WEIGHTS: interp_fcn.F', I,J, &
+                              HBWGT1(I,J)+HBWGT2(I,J)+HBWGT3(I,J)+HBWGT4(I,J), &
+                              IIH(I,J),JJH(I,J)
+
+           IF(MOD(JJH(I,J),2) .NE. 0)THEN    ! 1,3,5,7
+               NFLD(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )    &
+                           + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )    &
+                           + HBWGT3(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)-1)    &
+                           + HBWGT4(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)+1)
+           ELSE
+               NFLD(I,K,J) = HBWGT1(I,J)*CFLD(IIH(I,J),  K,  JJH(I,J)  )  &
+                           + HBWGT2(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)  )  &
+                           + HBWGT3(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)-1)  &
+                           + HBWGT4(I,J)*CFLD(IIH(I,J)+1,K,  JJH(I,J)+1)
+          ENDIF
+!
+        ENDIF
+       ENDDO
+      ENDDO
+     ENDDO
+
+
+  END SUBROUTINE interp_topo_nmm 
+!
+!=======================================================================================
+!  E grid test for mass point coincidence
+!=======================================================================================
+!
+  SUBROUTINE test_nmm (cfld,                                 &  ! CD field
+                       cids, cide, ckds, ckde, cjds, cjde,   &
+                       cims, cime, ckms, ckme, cjms, cjme,   &
+                       cits, cite, ckts, ckte, cjts, cjte,   &
+                       nfld,                                 &  ! ND field
+                       nids, nide, nkds, nkde, njds, njde,   &
+                       nims, nime, nkms, nkme, njms, njme,   &
+                       nits, nite, nkts, nkte, njts, njte,   &
+                       shw,                                  & ! stencil half width for interp
+                       imask,                                & ! interpolation mask
+                       xstag, ystag,                         & ! staggering of field
+                       ipos, jpos,                           & ! Position of lower left of nest in CD
+                       nri, nrj,                             & ! nest ratios                        
+                       CII, IIH, CJJ, JJH, CBWGT1, HBWGT1,   & ! south-western grid locs and weights 
+                       CBWGT2, HBWGT2, CBWGT3, HBWGT3,       & ! note that "C"ourse grid ones are
+                       CBWGT4, HBWGT4                        ) ! dummys for weights
+     USE module_timing
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     REAL,    DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3,CBWGT4    ! dummy
+     REAL,    DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+     INTEGER, DIMENSION ( cims:cime, cjms:cjme ), INTENT(IN) :: CII,CJJ                        ! dummy
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: IIH,JJH
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+
+!    local
+     INTEGER i,j,k
+     REAL,PARAMETER                                :: error=0.0001,error1=1.0 
+     REAL                                          :: diff   
+!
+!*** CHECK DOMAIN BOUNDS BEFORE INTERPOLATION
+!
+    DO J=NJTS,MIN(NJTE,NJDE-1)
+     DO I=NITS,MIN(NITE,NIDE-1)
+       IF(IIH(i,j).LT.(CIDS-shw) .OR. IIH(i,j).GT.(CIDE+shw)) &
+           CALL wrf_error_fatal ('hpoints:check domain bounds along x' )
+       IF(JJH(i,j).LT.(CJDS-shw) .OR. JJH(i,j).GT.(CJDE+shw)) &
+           CALL wrf_error_fatal ('hpoints:check domain bounds along y' )
+     ENDDO
+    ENDDO
+
+!
+!*** INDEX CONVENTIONS
+!***                     HBWGT4
+!***                      4
+!***
+!***
+!***
+!***                   h
+!***             1                 2
+!***            HBWGT1             HBWGT2
+!***
+!***
+!***                      3
+!***                     HBWGT3
+
+
+!    WRITE(0,*)NITS,MIN(NITE,NIDE-1),CITS,CITE
+     DO J=NJTS,MIN(NJTE,NJDE-1)
+       DO K=NKDS,NKDE
+        DO I=NITS,MIN(NITE,NIDE-1)
+          IF(ABS(1.0-HBWGT1(I,J)) .LE. ERROR)THEN
+             DIFF=ABS(NFLD(I,K,J)-CFLD(IIH(I,J),K,JJH(I,J)))
+             IF(DIFF .GT. ERROR)THEN
+              CALL wrf_debug(1,"dyn_nmm: NON-COINCIDENT, NESTED MASS POINT") 
+              WRITE(0,*)I,IIH(I,J),J,JJH(I,J),HBWGT1(I,J),NFLD(I,K,J),CFLD(IIH(I,J),K,JJH(I,J)),DIFF 
+             ENDIF
+             IF(DIFF .GT. ERROR1)THEN
+              WRITE(0,*)I,IIH(I,J),J,JJH(I,J),HBWGT1(I,J),NFLD(I,K,J),CFLD(IIH(I,J),K,JJH(I,J)),DIFF
+              CALL wrf_error_fatal ('dyn_nmm: NON-COINCIDENT, NESTED MASS POINT')
+             ENDIF
+          ENDIF     
+        ENDDO
+       ENDDO
+     ENDDO
+
+  END SUBROUTINE test_nmm 
+
+!==================================
+! this is the default function used in nmm feedback at mass points.
+
+   SUBROUTINE nmm_feedback ( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &  ! nest ratios 
+                           CII, IIH, CJJ, JJH,                   &
+                           CBWGT1, HBWGT1, CBWGT2, HBWGT2,       &
+                           CBWGT3, HBWGT3, CBWGT4, HBWGT4        ) 
+     USE module_configure
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     INTEGER,DIMENSION(cims:cime,cjms:cjme),  INTENT(IN)    :: CII,CJJ     ! dummy
+     INTEGER,DIMENSION(nims:nime,njms:njme),  INTENT(IN)    :: IIH,JJH
+     REAL,DIMENSION(cims:cime,cjms:cjme),     INTENT(IN)    :: CBWGT1,CBWGT2,CBWGT3,CBWGT4
+     REAL,DIMENSION(nims:nime,njms:njme),     INTENT(IN)    :: HBWGT1,HBWGT2,HBWGT3,HBWGT4
+     LOGICAL, INTENT(IN)                                    :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(IN)  :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ),INTENT(IN)           :: imask
+
+     ! Local
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp, ioff, joff, ioffa, joffa
+     INTEGER :: icmin,icmax,jcmin,jcmax
+     INTEGER :: is, ipoints,jpoints,ijpoints
+     INTEGER , PARAMETER :: passes = 2
+     REAL    :: AVGH
+
+!=====================================================================================
+!
+
+   IF(nri .ne. 3 .OR. nrj .ne. 3)               & 
+    CALL wrf_error_fatal ('Feedback works for only 1:3 ratios, currently. Modify the namelist' )
+
+!  WRITE(0,*)'SIMPLE FEED BACK IS SWITCHED ON FOR MASS'
+
+   CFLD = 9999.0
+
+   DO cj = MAX(jpos+1,cjts),MIN(jpos+(njde-njds)/nrj-1,cjte)  ! exclude top and bottom BCs
+    nj = (cj-jpos)*nrj + 1
+    if(mod(cj,2) .eq. 0)THEN   
+     is=0 ! even rows for mass points (2,4,6,8)
+    else
+     is=1 ! odd rows for mass points  (1,3,5,7)
+    endif
+    DO ck = ckts, ckte
+     nk = ck
+     DO ci = MAX(ipos+is,cits),MIN(ipos+(nide-nids)/nri-1,cite) ! excludes LBCs
+       ni = (ci-ipos)*nri + 2 -is
+         IF(IS==0)THEN    ! (2,4,6,8)
+          AVGH = NFLD(NI,NK,NJ+1)  + NFLD(NI,NK,NJ-1)  + NFLD(NI+1,NK,NJ+1)+ NFLD(NI+1,NK,NJ-1)  &
+               + NFLD(NI+1,NK,NJ)  + NFLD(NI-1,NK,NJ)  + NFLD(NI,NK,NJ+2)  + NFLD(NI,NK,NJ-2)    &
+               + NFLD(NI+1,NK,NJ+2)+ NFLD(NI-1,NK,NJ+2)+ NFLD(NI+1,NK,NJ-2)+ NFLD(NI-1,NK,NJ-2)
+         ELSE
+          AVGH = NFLD(NI,NK,NJ+1)  + NFLD(NI,NK,NJ-1)  + NFLD(NI-1,NK,NJ+1)+ NFLD(NI-1,NK,NJ-1)  &
+               + NFLD(NI+1,NK,NJ)  + NFLD(NI-1,NK,NJ)  + NFLD(NI,NK,NJ+2)  + NFLD(NI,NK,NJ-2)    &
+               + NFLD(NI+1,NK,NJ+2)+ NFLD(NI-1,NK,NJ+2)+ NFLD(NI+1,NK,NJ-2)+ NFLD(NI-1,NK,NJ-2)
+         ENDIF
+!dusan         CFLD(CI,CK,CJ) = 0.5*CFLD(CI,CK,CJ) + 0.5*(NFLD(NI,NK,NJ)+AVGH)/13.0
+         CFLD(CI,CK,CJ) = (NFLD(NI,NK,NJ)+AVGH)/13.0
+     ENDDO
+    ENDDO
+   ENDDO
+ 
+   END SUBROUTINE nmm_feedback 
+
+!===========================================================================================
+
+   SUBROUTINE nmm_vfeedback ( cfld,                              &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &  ! nest ratios 
+                           CII, IIV, CJJ, JJV,                   &
+                           CBWGT1, VBWGT1, CBWGT2, VBWGT2,       &
+                           CBWGT3, VBWGT3, CBWGT4, VBWGT4        ) 
+     USE module_configure
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     INTEGER,DIMENSION(cims:cime,cjms:cjme),  INTENT(IN)    :: CII,CJJ     ! dummy
+     INTEGER,DIMENSION(nims:nime,njms:njme),  INTENT(IN)    :: IIV,JJV
+     REAL,DIMENSION(cims:cime,cjms:cjme),     INTENT(IN)    :: CBWGT1,CBWGT2,CBWGT3,CBWGT4
+     REAL,DIMENSION(nims:nime,njms:njme),     INTENT(IN)    :: VBWGT1,VBWGT2,VBWGT3,VBWGT4
+     LOGICAL, INTENT(IN)                                    :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(IN)  :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ),INTENT(IN)           :: imask
+
+     ! Local
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp, ioff, joff, ioffa, joffa
+     INTEGER :: icmin,icmax,jcmin,jcmax
+     INTEGER :: is, ipoints,jpoints,ijpoints
+     INTEGER , PARAMETER :: passes = 2
+     REAL :: AVGV
+
+!=====================================================================================
+!
+
+    IF(nri .ne. 3 .OR. nrj .ne. 3)               &
+      CALL wrf_error_fatal ('Feedback works for only 1:3 ratios, currently. Modify the namelist')
+
+!   WRITE(0,*)'SIMPLE FEED BACK IS SWITCHED ON FOR VELOCITY'
+
+   CFLD = 9999.0
+
+   DO cj = MAX(jpos+1,cjts),MIN(jpos+(njde-njds)/nrj-1,cjte)  ! exclude top and bottom BCs
+    nj = (cj-jpos)*nrj + 1
+    if(mod(cj,2) .eq. 0)THEN
+     is=1 ! even rows for velocity points (2,4,6,8) 
+    else
+     is=0 ! odd rows for velocity points (1,3,5,7) 
+    endif
+    DO ck = ckts, ckte
+     nk = ck
+     DO ci = MAX(ipos+is,cits),MIN(ipos+(nide-nids)/nri-1,cite) ! excludes LBCs
+       ni = (ci-ipos)*nri + 2 -is
+         IF(IS==0)THEN    ! (1,3,5,7)
+          AVGV = NFLD(NI,NK,NJ+1)  + NFLD(NI,NK,NJ-1)  + NFLD(NI+1,NK,NJ+1)+ NFLD(NI+1,NK,NJ-1)  &
+               + NFLD(NI+1,NK,NJ)  + NFLD(NI-1,NK,NJ)  + NFLD(NI,NK,NJ+2)  + NFLD(NI,NK,NJ-2)    &
+               + NFLD(NI+1,NK,NJ+2)+ NFLD(NI-1,NK,NJ+2)+ NFLD(NI+1,NK,NJ-2)+ NFLD(NI-1,NK,NJ-2)
+         ELSE
+          AVGV = NFLD(NI,NK,NJ+1)  + NFLD(NI,NK,NJ-1)  + NFLD(NI-1,NK,NJ+1)+ NFLD(NI-1,NK,NJ-1)  &
+               + NFLD(NI+1,NK,NJ)  + NFLD(NI-1,NK,NJ)  + NFLD(NI,NK,NJ+2)  + NFLD(NI,NK,NJ-2)    &
+               + NFLD(NI+1,NK,NJ+2)+ NFLD(NI-1,NK,NJ+2)+ NFLD(NI+1,NK,NJ-2)+ NFLD(NI-1,NK,NJ-2)
+         ENDIF
+!dusan         CFLD(CI,CK,CJ) = 0.5*CFLD(CI,CK,CJ) + 0.5*(NFLD(NI,NK,NJ)+AVGV)/13.0
+         CFLD(CI,CK,CJ) = (NFLD(NI,NK,NJ)+AVGV)/13.0
+     ENDDO
+    ENDDO
+   ENDDO
+
+   END SUBROUTINE nmm_vfeedback 
+
+
+   SUBROUTINE nmm_smoother ( cfld , &
+                             cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             xstag, ystag,                         &
+                             ipos, jpos,                           &
+                             nri, nrj                              &
+                             )
+
+      USE module_configure
+      IMPLICIT NONE
+
+      INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             nri, nrj,                             &
+                             ipos, jpos
+      REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(INOUT) :: cfld
+      LOGICAL, INTENT(IN) :: xstag, ystag
+
+
+      ! Local
+
+      INTEGER             :: feedback
+      INTEGER, PARAMETER  :: smooth_passes = 5
+
+      REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfldnew
+      INTEGER :: ci, cj, ck
+      INTEGER :: is, npass
+      REAL    :: AVGH
+
+      RETURN
+      !  If there is no feedback, there can be no smoothing.
+
+      CALL nl_get_feedback       ( 1, feedback  )
+      IF ( feedback == 0 ) RETURN
+
+      WRITE(0,*)'SIMPLE SMOOTHER IS SWITCHED ON FOR HEIGHT'
+
+      DO npass = 1, smooth_passes
+
+      DO cj = MAX(jpos+1,cjts),MIN(jpos+(njde-njds)/nrj-1,cjte)  ! exclude top and bottom BCs
+       if(mod(cj,2) .eq. 0)THEN
+        is=0 ! even rows for mass points (2,4,6,8)
+       else
+        is=1 ! odd rows for mass points  (1,3,5,7)
+       endif
+       DO ck = ckts, ckte
+        DO ci = MAX(ipos+is,cits),MIN(ipos+(nide-nids)/nri-1,cite) ! excludes LBCs
+            IF(IS==0)THEN    ! (2,4,6,8)
+             AVGH = CFLD(CI,CK,CJ+1) + CFLD(CI,CK,CJ-1) + CFLD(CI+1,CK,CJ+1) + CFLD(CI+1,CK,CJ-1)
+            ELSE
+             AVGH = CFLD(CI,CK,CJ+1) + CFLD(CI,CK,CJ-1) + CFLD(CI-1,CK,CJ+1) + CFLD(CI-1,CK,CJ-1)
+            ENDIF
+            CFLDNEW(CI,CK,CJ) = (AVGH + 4*CFLD(CI,CK,CJ)) / 8.0
+        ENDDO
+       ENDDO
+      ENDDO
+
+      DO cj = MAX(jpos+1,cjts),MIN(jpos+(njde-njds)/nrj-1,cjte)  ! exclude top and bottom BCs
+       if(mod(cj,2) .eq. 0)THEN
+        is=0 ! even rows for mass points (2,4,6,8)
+       else
+        is=1 ! odd rows for mass points  (1,3,5,7)
+       endif
+       DO ck = ckts, ckte
+        DO ci = MAX(ipos+is,cits),MIN(ipos+(nide-nids)/nri-1,cite) ! excludes LBCs
+           CFLD(CI,CK,CJ) = CFLDNEW(CI,CK,CJ)
+        ENDDO
+       ENDDO
+      ENDDO
+
+      ENDDO   ! do npass
+
+   END SUBROUTINE nmm_smoother
+
+
+   SUBROUTINE nmm_vsmoother ( cfld , &
+                             cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             xstag, ystag,                         &
+                             ipos, jpos,                           &
+                             nri, nrj                              &
+                             )
+
+      USE module_configure
+      IMPLICIT NONE
+
+      INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             nri, nrj,                             &
+                             ipos, jpos
+      REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(INOUT) :: cfld
+      LOGICAL, INTENT(IN) :: xstag, ystag
+
+
+      ! Local
+
+      INTEGER             :: feedback
+      INTEGER, PARAMETER  :: smooth_passes = 5
+
+      REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfldnew
+      INTEGER :: ci, cj, ck
+      INTEGER :: is, npass
+      REAL    :: AVGV
+
+      RETURN
+      !  If there is no feedback, there can be no smoothing.
+
+      CALL nl_get_feedback       ( 1, feedback  )
+      IF ( feedback == 0 ) RETURN
+
+      WRITE(0,*)'SIMPLE SMOOTHER IS SWITCHED ON FOR VELOCITY'
+
+      DO npass = 1, smooth_passes
+
+      DO cj = MAX(jpos+1,cjts),MIN(jpos+(njde-njds)/nrj-1,cjte)  ! exclude top and bottom BCs
+       if(mod(cj,2) .eq. 0)THEN
+        is=1 ! even rows for mass points (2,4,6,8)
+       else
+        is=0 ! odd rows for mass points  (1,3,5,7)
+       endif
+       DO ck = ckts, ckte
+        DO ci = MAX(ipos+is,cits),MIN(ipos+(nide-nids)/nri-1,cite) ! excludes LBCs
+            IF(IS==0)THEN    ! (2,4,6,8)
+             AVGV = CFLD(CI,CK,CJ+1) + CFLD(CI,CK,CJ-1) + CFLD(CI+1,CK,CJ+1) + CFLD(CI+1,CK,CJ-1)
+            ELSE
+             AVGV = CFLD(CI,CK,CJ+1) + CFLD(CI,CK,CJ-1) + CFLD(CI-1,CK,CJ+1) + CFLD(CI-1,CK,CJ-1)
+            ENDIF
+            CFLDNEW(CI,CK,CJ) = (AVGV + 4*CFLD(CI,CK,CJ)) / 8.0
+        ENDDO
+       ENDDO
+      ENDDO
+
+      DO cj = MAX(jpos+1,cjts),MIN(jpos+(njde-njds)/nrj-1,cjte)  ! exclude top and bottom BCs
+       if(mod(cj,2) .eq. 0)THEN
+        is=1 ! even rows for mass points (2,4,6,8)
+       else
+        is=0 ! odd rows for mass points  (1,3,5,7)
+       endif
+       DO ck = ckts, ckte
+        DO ci = MAX(ipos+is,cits),MIN(ipos+(nide-nids)/nri-1,cite) ! excludes LBCs
+           CFLD(CI,CK,CJ) = CFLDNEW(CI,CK,CJ)
+        ENDDO
+       ENDDO
+      ENDDO
+
+      ENDDO
+
+   END SUBROUTINE nmm_vsmoother
+!======================================================================================
+!   End of gopal's doing
+!======================================================================================
+#endif
+
+   SUBROUTINE interp_fcn ( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj                             )   ! nest ratios
+     USE module_timing
+     USE module_configure
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+
+     ! Local
+
+!logical first
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp, ioff, joff, nioff, njoff
+#ifdef MM5_SINT
+     INTEGER nfx, ior
+     PARAMETER (ior=2)
+     INTEGER nf
+     REAL psca(cims:cime,cjms:cjme,nri*nrj)
+     LOGICAL icmask( cims:cime, cjms:cjme )
+     INTEGER i,j,k
+#endif
+
+     ! Iterate over the ND tile and compute the values
+     ! from the CD tile. 
+
+#ifdef MM5_SINT
+
+     ioff  = 0 ; joff  = 0
+     nioff = 0 ; njoff = 0
+     IF ( xstag ) THEN 
+       ioff = (nri-1)/2
+       nioff = nri 
+     ENDIF
+     IF ( ystag ) THEN
+       joff = (nrj-1)/2
+       njoff = nrj
+     ENDIF
+
+     nfx = nri * nrj
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( i,j,k,ni,nj,ci,cj,ip,jp,nk,ck,nf,icmask,psca )
+     DO k = ckts, ckte
+        icmask = .FALSE.
+        DO nf = 1,nfx
+           DO j = cjms,cjme
+              nj = (j-jpos) * nrj + ( nrj / 2 + 1 )  ! j point on nest
+              DO i = cims,cime
+                ni = (i-ipos) * nri + ( nri / 2 + 1 )    ! i point on nest
+                if ( ni .ge. nits-nioff-1 .and. ni .le. nite+nioff+1 .and. nj .ge. njts-njoff-1 .and. nj .le. njte+njoff+1 ) then
+                  if ( imask(ni,nj) .eq. 1 .or. imask(ni-nioff,nj-njoff) .eq. 1 ) then
+                    icmask( i, j ) = .TRUE.
+                  endif
+                endif
+                psca(i,j,nf) = cfld(i,k,j)
+              ENDDO
+           ENDDO
+        ENDDO
+
+! tile dims in this call to sint are 1-over to account for the fact
+! that the number of cells on the nest local subdomain is not 
+! necessarily a multiple of the nest ratio in a given dim.
+! this could be a little less ham-handed.
+
+!call start_timing
+
+        CALL sint( psca,                     &
+                   cims, cime, cjms, cjme, icmask,   &
+                   cits-1, cite+1, cjts-1, cjte+1, nrj*nri, xstag, ystag )
+
+!call end_timing( ' sint ' )
+
+        DO nj = njts, njte+joff
+           cj = jpos + (nj-1) / nrj ! j coord of CD point 
+           jp = mod ( nj-1 , nrj )  ! coord of ND w/i CD point
+           nk = k
+           ck = nk
+           DO ni = nits, nite+ioff
+               ci = ipos + (ni-1) / nri      ! i coord of CD point 
+               ip = mod ( ni-1 , nri )  ! coord of ND w/i CD point
+               if ( imask ( ni, nj ) .eq. 1 .or. imask ( ni-ioff, nj-joff ) .eq. 1  ) then
+                 nfld( ni-ioff, nk, nj-joff ) = psca( ci , cj, ip+1 + (jp)*nri )
+               endif
+           ENDDO
+        ENDDO
+     ENDDO
+   !$OMP END PARALLEL DO
+#endif
+
+#ifdef DUMBCOPY
+!write(0,'(") cims:cime, ckms:ckme, cjms:cjme ",6i4)')cims,cime, ckms,ckme, cjms,cjme
+!write(0,'(") nims:nime, nkms:nkme, njms:njme ",6i4)')nims,nime, nkms,nkme, njms,njme
+!write(0,'(") cits:cite, ckts:ckte, cjts:cjte ",6i4)')cits,cite, ckts,ckte, cjts,cjte
+!write(0,'(") nits:nite, nkts:nkte, njts:njte ",6i4)')nits,nite, nkts,nkte, njts,njte
+
+     DO nj = njts, njte
+        cj = jpos + (nj-1) / nrj     ! j coord of CD point 
+        jp = mod ( nj , nrj )  ! coord of ND w/i CD point
+        DO nk = nkts, nkte
+           ck = nk
+           DO ni = nits, nite
+              ci = ipos + (ni-1) / nri      ! j coord of CD point 
+              ip = mod ( ni , nri )  ! coord of ND w/i CD point
+              ! This is a trivial implementation of the interp_fcn; just copies
+              ! the values from the CD into the ND
+              if ( imask ( ni, nj ) .eq. 1 ) then
+                nfld( ni, nk, nj ) = cfld( ci , ck , cj )
+              endif
+           ENDDO
+        ENDDO
+     ENDDO
+#endif
+
+     RETURN
+
+   END SUBROUTINE interp_fcn
+
+!==================================
+! this is the default function used in feedback.
+
+   SUBROUTINE copy_fcn ( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj                             )   ! nest ratios
+     USE module_configure
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ),INTENT(IN)  :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ),INTENT(IN)  :: imask
+
+     ! Local
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp, ioff, joff, ioffa, joffa
+     INTEGER :: icmin,icmax,jcmin,jcmax
+     INTEGER :: istag,jstag, ipoints,jpoints,ijpoints
+     INTEGER , PARAMETER :: passes = 2
+     INTEGER spec_zone
+
+     !  Loop over the coarse grid in the area of the fine mesh.  Do not
+     !  process the coarse grid values that are along the lateral BC
+     !  provided to the fine grid.  Since that is in the specified zone
+     !  for the fine grid, it should not be used in any feedback to the
+     !  coarse grid as it should not have changed.
+
+     !  Due to peculiarities of staggering, it is simpler to handle the feedback
+     !  for the staggerings based upon whether it is a even ratio (2::1, 4::1, etc.) or
+     !  an odd staggering ratio (3::1, 5::1, etc.). 
+
+     !  Though there are separate grid ratios for the i and j directions, this code
+     !  is not general enough to handle aspect ratios .NE. 1 for the fine grid cell.
+ 
+     !  These are local integer increments in the looping.  Basically, istag=1 means
+     !  that we will assume one less point in the i direction.  Note that ci and cj
+     !  have a maximum value that is decreased by istag and jstag, respectively.  
+
+     !  Horizontal momentum feedback is along the face, not within the cell.  For a
+     !  3::1 ratio, temperature would use 9 pts for feedback, while u and v use
+     !  only 3 points for feedback from the nest to the parent.
+
+     CALL nl_get_spec_zone( 1 , spec_zone )
+     istag = 1 ; jstag = 1
+     IF ( xstag ) istag = 0
+     IF ( ystag ) jstag = 0
+
+     IF( MOD(nrj,2) .NE. 0) THEN  ! odd refinement ratio
+
+        IF      ( ( .NOT. xstag ) .AND. ( .NOT. ystag ) ) THEN
+           DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+              nj = (cj-jpos)*nrj + jstag + 1
+              DO ck = ckts, ckte
+                 nk = ck
+                 DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                    ni = (ci-ipos)*nri + istag + 1
+                    cfld( ci, ck, cj ) = 0.
+                    DO ijpoints = 1 , nri * nrj
+                       ipoints = MOD((ijpoints-1),nri) + 1 - nri/2 - 1
+                       jpoints = (ijpoints-1)/nri + 1 - nrj/2 - 1
+                       cfld( ci, ck, cj ) =  cfld( ci, ck, cj ) + &
+                                             1./REAL(nri*nrj) * nfld( ni+ipoints , nk , nj+jpoints )
+                    END DO
+!                   cfld( ci, ck, cj ) =  1./9. * &
+!                                         ( nfld( ni-1, nk , nj-1) + &
+!                                           nfld( ni  , nk , nj-1) + &
+!                                           nfld( ni+1, nk , nj-1) + &
+!                                           nfld( ni-1, nk , nj  ) + &
+!                                           nfld( ni  , nk , nj  ) + &
+!                                           nfld( ni+1, nk , nj  ) + &
+!                                           nfld( ni-1, nk , nj+1) + &
+!                                           nfld( ni  , nk , nj+1) + &
+!                                           nfld( ni+1, nk , nj+1) )
+                 ENDDO
+              ENDDO
+           ENDDO
+
+        ELSE IF ( (       xstag ) .AND. ( .NOT. ystag ) ) THEN
+           DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+              nj = (cj-jpos)*nrj + jstag + 1
+              DO ck = ckts, ckte
+                 nk = ck
+                 DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                    ni = (ci-ipos)*nri + istag + 1
+                    cfld( ci, ck, cj ) = 0.
+                    DO ijpoints = (nri+1)/2 , (nri+1)/2 + nri*(nri-1) , nri
+                       ipoints = MOD((ijpoints-1),nri) + 1 - nri/2 - 1
+                       jpoints = (ijpoints-1)/nri + 1 - nrj/2 - 1
+                       cfld( ci, ck, cj ) =  cfld( ci, ck, cj ) + &
+                                             1./REAL(nri    ) * nfld( ni+ipoints , nk , nj+jpoints )
+                    END DO
+!                   cfld( ci, ck, cj ) =  1./3. * &
+!                                         ( nfld( ni  , nk , nj-1) + &
+!                                           nfld( ni  , nk , nj  ) + &
+!                                           nfld( ni  , nk , nj+1) )
+                 ENDDO
+              ENDDO
+           ENDDO
+
+        ELSE IF ( ( .NOT. xstag ) .AND. (       ystag ) ) THEN
+           DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+              nj = (cj-jpos)*nrj + jstag + 1
+              DO ck = ckts, ckte
+                 nk = ck
+                 DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                    ni = (ci-ipos)*nri + istag + 1
+                    cfld( ci, ck, cj ) = 0.
+                    DO ijpoints = ( nrj*nrj +1 )/2 - nrj/2 , ( nrj*nrj +1 )/2 - nrj/2 + nrj-1
+                       ipoints = MOD((ijpoints-1),nri) + 1 - nri/2 - 1
+                       jpoints = (ijpoints-1)/nri + 1 - nrj/2 - 1
+                       cfld( ci, ck, cj ) =  cfld( ci, ck, cj ) + &
+                                             1./REAL(    nrj) * nfld( ni+ipoints , nk , nj+jpoints )
+                    END DO
+!                   cfld( ci, ck, cj ) =  1./3. * &
+!                                         ( nfld( ni-1, nk , nj  ) + &
+!                                           nfld( ni  , nk , nj  ) + &
+!                                           nfld( ni+1, nk , nj  ) )
+                 ENDDO
+              ENDDO
+           ENDDO
+
+        END IF
+
+     !  Even refinement ratio
+
+     ELSE IF ( MOD(nrj,2) .EQ. 0) THEN
+        IF ( ( .NOT. xstag ) .AND. ( .NOT. ystag ) ) THEN
+
+        !  This is a simple schematic of the feedback indexing used in the even
+        !  ratio nests.  For simplicity, a 2::1 ratio is depicted.  Only the 
+        !  mass variable staggering is shown. 
+        !                                                                  Each of
+        !  the boxes with a "T" and four small "t" represents a coarse grid (CG)
+        !  cell, that is composed of four (2::1 ratio) fine grid (FG) cells.
+   
+        !  Shown below is the area of the CG that is in the area of the FG.   The
+        !  first grid point of the depicted CG is the starting location of the nest
+        !  in the parent domain (ipos,jpos - i_parent_start and j_parent_start from
+        !  the namelist).  
+   
+        !  For each of the CG points, the feedback loop is over each of the FG points
+        !  within the CG cell.  For a 2::1 ratio, there are four total points (this is 
+        !  the ijpoints loop).  The feedback value to the CG is the arithmetic mean of 
+        !  all of the FG values within each CG cell.
+
+!              |-------------||-------------|                          |-------------||-------------|
+!              |  t      t   ||  t      t   |                          |  t      t   ||  t      t   |
+! jpos+        |             ||             |                          |             ||             |
+! (njde-njds)- |      T      ||      T      |                          |      T      ||      T      |
+! jstag        |             ||             |                          |             ||             |
+!              |  t      t   ||  t      t   |                          |  t      t   ||  t      t   |
+!              |-------------||-------------|                          |-------------||-------------|
+!              |-------------||-------------|                          |-------------||-------------|
+!              |  t      t   ||  t      t   |                          |  t      t   ||  t      t   |
+!              |             ||             |                          |             ||             |
+!              |      T      ||      T      |                          |      T      ||      T      |
+!              |             ||             |                          |             ||             |
+!              |  t      t   ||  t      t   |                          |  t      t   ||  t      t   |
+!              |-------------||-------------|                          |-------------||-------------|
+!
+!                   ...
+!                   ...
+!                   ...
+!                   ...
+!                   ...
+
+!              |-------------||-------------|                          |-------------||-------------|
+! jpoints = 1  |  t      t   ||  t      t   |                          |  t      t   ||  t      t   |
+!              |             ||             |                          |             ||             |
+!              |      T      ||      T      |                          |      T      ||      T      |
+!              |             ||             |                          |             ||             |
+! jpoints = 0, |  t      t   ||  t      t   |                          |  t      t   ||  t      t   |
+!  nj=3        |-------------||-------------|                          |-------------||-------------|
+!              |-------------||-------------|                          |-------------||-------------|
+! jpoints = 1  |  t      t   ||  t      t   |                          |  t      t   ||  t      t   |
+!              |             ||             |                          |             ||             |
+!    jpos      |      T      ||      T      |          ...             |      T      ||      T      |
+!              |             ||             |          ...             |             ||             |
+! jpoints = 0, |  t      t   ||  t      t   |          ...             |  t      t   ||  t      t   |
+!  nj=1        |-------------||-------------|                          |-------------||-------------|
+!                     ^                                                                      ^
+!                     |                                                                      |
+!                     |                                                                      |
+!                   ipos                                                                   ipos+
+!     ni =        1              3                                                         (nide-nids)/nri
+! ipoints=        0      1       0      1                                                  -istag
+!
+
+           !  For performance benefits, users can comment out the inner most loop (and cfld=0) and
+           !  hardcode the loop feedback.  For example, it is set up to run a 2::1 ratio
+           !  if uncommented.  This lacks generality, but is likely to gain timing benefits
+           !  with compilers unable to unroll inner loops that do not have parameterized sizes.
+   
+           !  The extra +1 ---------/ and the extra -1 ----\  (both for ci and cj) 
+           !                       /                        \   keeps the feedback out of the 
+           !                      /                          \  outer row/col, since that CG data
+           !                     /                            \ specified the nest boundary originally
+           !                    /                              \   This
+           !                   /                                \    is just
+           !                  /                                  \   a sentence to not end a line
+           !                 /                                    \   with a stupid backslash
+           DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+              nj = (cj-jpos)*nrj + jstag
+              DO ck = ckts, ckte
+                 nk = ck
+                 DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                    ni = (ci-ipos)*nri + istag
+                    cfld( ci, ck, cj ) = 0.
+                    DO ijpoints = 1 , nri * nrj
+                       ipoints = MOD((ijpoints-1),nri)
+                       jpoints = (ijpoints-1)/nri
+                       cfld( ci, ck, cj ) =  cfld( ci, ck, cj ) + &
+                                             1./REAL(nri*nrj) * nfld( ni+ipoints , nk , nj+jpoints )
+                    END DO
+!                   cfld( ci, ck, cj ) =  1./4. * &
+!                                         ( nfld( ni  , nk , nj  ) + &
+!                                           nfld( ni+1, nk , nj  ) + &
+!                                           nfld( ni  , nk , nj+1) + &
+!                                           nfld( ni+1, nk , nj+1) )
+                 END DO
+              END DO
+           END DO
+
+        !  U
+
+        ELSE IF ( (       xstag ) .AND. ( .NOT. ystag ) ) THEN
+!              |---------------|
+!              |               |
+! jpoints = 1  u       u       |
+!              |               |
+!              U               |
+!              |               |
+! jpoints = 0, u       u       |
+!  nj=3        |               |
+!              |---------------|
+!              |---------------|
+!              |               |
+! jpoints = 1  u       u       |
+!              |               |
+!    jpos      U               |
+!              |               |
+! jpoints = 0, u       u       |
+! nj=1         |               |
+!              |---------------|
+! 
+!              ^               
+!              |              
+!              |             
+!            ipos           
+!     ni =     1               3
+! ipoints=     0       1       0 
+!
+
+           DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+              nj = (cj-jpos)*nrj + 1
+              DO ck = ckts, ckte
+                 nk = ck
+                 DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                    ni = (ci-ipos)*nri + 1
+                    cfld( ci, ck, cj ) = 0.
+                    DO ijpoints = 1 , nri*nrj , nri
+                       ipoints = MOD((ijpoints-1),nri)
+                       jpoints = (ijpoints-1)/nri
+                       cfld( ci, ck, cj ) =  cfld( ci, ck, cj ) + &
+                                             1./REAL(nri    ) * nfld( ni+ipoints , nk , nj+jpoints )
+                    END DO
+!                cfld( ci, ck, cj ) =  1./2. * &
+!                                      ( nfld( ni  , nk , nj  ) + &
+!                                        nfld( ni  , nk , nj+1) )
+                 ENDDO
+              ENDDO
+           ENDDO
+
+        !  V 
+
+        ELSE IF ( ( .NOT. xstag ) .AND. (       ystag ) ) THEN
+           DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+              nj = (cj-jpos)*nrj + 1
+              DO ck = ckts, ckte
+                 nk = ck
+                 DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                    ni = (ci-ipos)*nri + 1
+                    cfld( ci, ck, cj ) = 0.
+                    DO ijpoints = 1 , nri
+                       ipoints = MOD((ijpoints-1),nri)
+                       jpoints = (ijpoints-1)/nri
+                       cfld( ci, ck, cj ) =  cfld( ci, ck, cj ) + &
+                                             1./REAL(nri    ) * nfld( ni+ipoints , nk , nj+jpoints )
+                    END DO
+!                cfld( ci, ck, cj ) =  1./2. * &
+!                                      ( nfld( ni  , nk , nj  ) + &
+!                                        nfld( ni+1, nk , nj  ) )
+                 ENDDO
+              ENDDO
+           ENDDO
+        END IF
+     END IF
+
+     RETURN
+
+   END SUBROUTINE copy_fcn
+
+!==================================
+! this is the 1pt function used in feedback.
+
+   SUBROUTINE copy_fcnm (  cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj                             )   ! nest ratios
+     USE module_configure
+     USE module_wrf_error
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(IN) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: imask
+
+     ! Local
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp, ioff, joff, ioffa, joffa
+     INTEGER :: icmin,icmax,jcmin,jcmax
+     INTEGER :: istag,jstag, ipoints,jpoints,ijpoints
+     INTEGER , PARAMETER :: passes = 2
+     INTEGER spec_zone
+
+     CALL nl_get_spec_zone( 1, spec_zone ) 
+     istag = 1 ; jstag = 1
+     IF ( xstag ) istag = 0
+     IF ( ystag ) jstag = 0
+
+     IF( MOD(nrj,2) .NE. 0) THEN  ! odd refinement ratio
+
+        DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+           nj = (cj-jpos)*nrj + jstag + 1
+           DO ck = ckts, ckte
+              nk = ck
+              DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                 ni = (ci-ipos)*nri + istag + 1
+                 cfld( ci, ck, cj ) =  nfld( ni  , nk , nj  )
+              ENDDO
+           ENDDO
+        ENDDO
+
+     ELSE  ! even refinement ratio, pick nearest neighbor on SW corner
+        DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+           nj = (cj-jpos)*nrj + 1
+           DO ck = ckts, ckte
+              nk = ck
+              DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                 ni = (ci-ipos)*nri + 1
+                 ipoints = nri/2 -1
+                 jpoints = nrj/2 -1
+                 cfld( ci, ck, cj ) =  nfld( ni+ipoints , nk , nj+jpoints )
+              END DO
+           END DO
+        END DO
+
+     END IF
+
+     RETURN
+
+   END SUBROUTINE copy_fcnm
+
+!==================================
+! this is the 1pt function used in feedback for integers
+
+   SUBROUTINE copy_fcni ( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj                             )   ! nest ratios
+     USE module_configure
+     USE module_wrf_error
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     INTEGER, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: cfld
+     INTEGER, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(IN) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN)  :: imask
+
+     ! Local
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp, ioff, joff, ioffa, joffa
+     INTEGER :: icmin,icmax,jcmin,jcmax
+     INTEGER :: istag,jstag, ipoints,jpoints,ijpoints
+     INTEGER , PARAMETER :: passes = 2
+     INTEGER spec_zone
+
+     CALL nl_get_spec_zone( 1, spec_zone ) 
+     istag = 1 ; jstag = 1
+     IF ( xstag ) istag = 0
+     IF ( ystag ) jstag = 0
+
+     IF( MOD(nrj,2) .NE. 0) THEN  ! odd refinement ratio
+
+        DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+           nj = (cj-jpos)*nrj + jstag + 1
+           DO ck = ckts, ckte
+              nk = ck
+              DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                 ni = (ci-ipos)*nri + istag + 1
+                 cfld( ci, ck, cj ) =  nfld( ni  , nk , nj  )
+              ENDDO
+           ENDDO
+        ENDDO
+
+     ELSE  ! even refinement ratio
+        DO cj = MAX(jpos+spec_zone,cjts),MIN(jpos+(njde-njds)/nrj-jstag-spec_zone,cjte)
+           nj = (cj-jpos)*nrj + 1
+           DO ck = ckts, ckte
+              nk = ck
+              DO ci = MAX(ipos+spec_zone,cits),MIN(ipos+(nide-nids)/nri-istag-spec_zone,cite)
+                 ni = (ci-ipos)*nri + 1
+                 ipoints = nri/2 -1
+                 jpoints = nrj/2 -1
+                 cfld( ci, ck, cj ) =  nfld( ni+ipoints , nk , nj+jpoints )
+              END DO
+           END DO
+        END DO
+
+     END IF
+
+     RETURN
+
+   END SUBROUTINE copy_fcni
+
+!==================================
+
+   SUBROUTINE bdy_interp ( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &  ! nest ratios
+                           cbdy, nbdy,                           &
+                           cbdy_t, nbdy_t,                       &
+                           cdt, ndt                              &
+                           )   ! boundary arrays
+     USE module_configure
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+     REAL,  DIMENSION( * ), INTENT(INOUT) :: cbdy, cbdy_t, nbdy, nbdy_t
+     REAL cdt, ndt
+
+     ! Local
+
+     INTEGER nijds, nijde, spec_bdy_width
+
+     nijds = min(nids, njds)
+     nijde = max(nide, njde)
+     CALL nl_get_spec_bdy_width( 1, spec_bdy_width )
+
+     CALL bdy_interp1( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nijds, nijde , spec_bdy_width ,       &  
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw, imask,                           &
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &
+                           cbdy, nbdy,                           &
+                           cbdy_t, nbdy_t,                       &
+                           cdt, ndt                              &
+                                        )
+
+     RETURN
+
+   END SUBROUTINE bdy_interp
+
+   SUBROUTINE bdy_interp1( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nijds, nijde, spec_bdy_width ,          &
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw1,                                 &
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &
+                           cbdy, bdy,                            &
+                           cbdy_t, bdy_t,                        &
+                           cdt, ndt                              &
+                                        )
+
+     USE module_configure
+     use module_state_description
+     IMPLICIT NONE
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw1,                                 &  ! ignore
+                            ipos, jpos,                           &
+                            nri, nrj
+     INTEGER, INTENT(IN) :: nijds, nijde, spec_bdy_width
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(INOUT) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(INOUT) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+     REAL, DIMENSION ( * ), INTENT(INOUT) :: cbdy, cbdy_t   ! not used
+     REAL                                 :: cdt, ndt
+     REAL, DIMENSION ( nijds:nijde, nkms:nkme, spec_bdy_width, 4 ), INTENT(INOUT) :: bdy, bdy_t
+
+     ! Local
+
+     REAL*8 rdt
+     INTEGER ci, cj, ck, ni, nj, nk, ni1, nj1, nk1, ip, jp, ioff, joff
+#ifdef MM5_SINT
+     INTEGER nfx, ior
+     PARAMETER (ior=2)
+     INTEGER nf
+     REAL psca1(cims:cime,cjms:cjme,nri*nrj)
+     REAL psca(cims:cime,cjms:cjme,nri*nrj)
+     LOGICAL icmask( cims:cime, cjms:cjme )
+     INTEGER i,j,k
+#endif
+     INTEGER shw
+     INTEGER spec_zone 
+     INTEGER relax_zone
+     INTEGER sz
+     INTEGER n2ci,n
+     INTEGER n2cj
+
+! statement functions for converting a nest index to coarse
+     n2ci(n) = (n+ipos*nri-1)/nri
+     n2cj(n) = (n+jpos*nrj-1)/nrj
+
+     rdt = 1.D0/cdt
+
+     shw = 0
+
+     ioff = 0 ; joff = 0
+     IF ( xstag ) ioff = (nri-1)/2
+     IF ( ystag ) joff = (nrj-1)/2
+
+     ! Iterate over the ND tile and compute the values
+     ! from the CD tile. 
+
+#ifdef MM5_SINT
+     CALL nl_get_spec_zone( 1, spec_zone )
+     CALL nl_get_relax_zone( 1, relax_zone )
+     sz = MIN(MAX( spec_zone, relax_zone + 1 ),spec_bdy_width)
+
+     nfx = nri * nrj
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( i,j,k,ni,nj,ni1,nj1,ci,cj,ip,jp,nk,ck,nf,icmask,psca,psca1 )
+     DO k = ckts, ckte
+
+        DO nf = 1,nfx
+           DO j = cjms,cjme
+              nj = (j-jpos) * nrj + ( nrj / 2 + 1 )  ! j point on nest
+              DO i = cims,cime
+                ni = (i-ipos) * nri + ( nri / 2 + 1 )   ! i point on nest
+                psca1(i,j,nf) = cfld(i,k,j)
+              ENDDO
+           ENDDO
+        ENDDO
+! hopefully less ham handed but still correct and more efficient
+! sintb ignores icmask so it does not matter that icmask is not set
+!
+! SOUTH BDY
+               IF   ( njts .ge. njds .and. njts .le. njds + sz + joff  ) THEN
+        CALL sintb( psca1, psca,                     &
+          cims, cime, cjms, cjme, icmask,  &
+          n2ci(nits)-1, n2ci(nite)+1, n2cj(MAX(njts,njds)), n2cj(MIN(njte,njds+sz+joff)), nrj*nri, xstag, ystag )
+               ENDIF
+! NORTH BDY
+               IF   ( njte .le. njde .and. njte .ge. njde - sz - joff ) THEN
+        CALL sintb( psca1, psca,                     &
+          cims, cime, cjms, cjme, icmask,  &
+          n2ci(nits)-1, n2ci(nite)+1, n2cj(MAX(njts,njde-sz-joff)), n2cj(MIN(njte,njde-1+joff)), nrj*nri, xstag, ystag )
+               ENDIF
+! WEST BDY
+               IF   ( nits .ge. nids .and. nits .le. nids + sz + ioff  ) THEN
+        CALL sintb( psca1, psca,                     &
+          cims, cime, cjms, cjme, icmask,  &
+          n2ci(MAX(nits,nids)), n2ci(MIN(nite,nids+sz+ioff)), n2cj(njts)-1, n2cj(njte)+1, nrj*nri, xstag, ystag )
+               ENDIF
+! EAST BDY
+               IF   ( nite .le. nide .and. nite .ge. nide - sz - ioff ) THEN
+        CALL sintb( psca1, psca,                     &
+          cims, cime, cjms, cjme, icmask,  &
+          n2ci(MAX(nits,nide-sz-ioff)), n2ci(MIN(nite,nide-1+ioff)), n2cj(njts)-1, n2cj(njte)+1, nrj*nri, xstag, ystag )
+               ENDIF
+
+        DO nj1 = MAX(njds,njts-1), MIN(njde+joff,njte+joff+1) 
+           cj = jpos + (nj1-1) / nrj     ! j coord of CD point 
+           jp = mod ( nj1-1 , nrj )  ! coord of ND w/i CD point
+           nk = k
+           ck = nk
+           DO ni1 = MAX(nids,nits-1), MIN(nide+ioff,nite+ioff+1)
+               ci = ipos + (ni1-1) / nri      ! j coord of CD point 
+               ip = mod ( ni1-1 , nri )  ! coord of ND w/i CD point
+
+               ni = ni1-ioff
+               nj = nj1-joff
+
+               IF ( ( ni.LT.nids) .OR. (nj.LT.njds) ) THEN
+                  CYCLE
+               END IF
+
+!bdy contains the value at t-dt. psca contains the value at t
+!compute dv/dt and store in bdy_t
+!afterwards store the new value of v at t into bdy
+        ! WEST
+               IF   ( ni .ge. nids .and. ni .lt. nids + sz ) THEN
+                 bdy_t( nj,k,ni, P_XSB ) = rdt*(psca(ci+shw,cj+shw,ip+1+(jp)*nri)-nfld(ni,k,nj))
+                 bdy( nj,k,ni, P_XSB ) = psca(ci+shw,cj+shw,ip+1+(jp)*nri )
+               ENDIF
+
+        ! SOUTH
+               IF   ( nj .ge. njds .and. nj .lt. njds + sz ) THEN
+                 bdy_t( ni,k,nj, P_YSB ) = rdt*(psca(ci+shw,cj+shw,ip+1+(jp)*nri)-nfld(ni,k,nj))
+                 bdy( ni,k,nj, P_YSB ) = psca(ci+shw,cj+shw,ip+1+(jp)*nri )
+               ENDIF
+
+        ! EAST
+               IF ( xstag ) THEN
+                 IF   ( ni .ge. nide - sz + 1 .AND. ni .le. nide ) THEN
+                   bdy_t( nj,k,nide-ni+1, P_XEB ) = rdt*(psca(ci+shw,cj+shw,ip+1+(jp)*nri)-nfld(ni,k,nj))
+                   bdy( nj,k,nide-ni+1, P_XEB ) = psca(ci+shw,cj+shw,ip+1+(jp)*nri )
+                 ENDIF
+               ELSE
+                 IF   ( ni .ge. nide - sz .AND. ni .le. nide-1 ) THEN
+                   bdy_t( nj,k,nide-ni, P_XEB ) = rdt*(psca(ci+shw,cj+shw,ip+1+(jp)*nri)-nfld(ni,k,nj))
+                   bdy( nj,k,nide-ni, P_XEB ) = psca(ci+shw,cj+shw,ip+1+(jp)*nri )
+                 ENDIF
+               ENDIF
+
+        ! NORTH
+               IF ( ystag ) THEN
+                 IF   ( nj .ge. njde - sz + 1 .AND. nj .le. njde  ) THEN
+                   bdy_t( ni,k,njde-nj+1,P_YEB ) = rdt*(psca(ci+shw,cj+shw,ip+1+(jp)*nri)-nfld(ni,k,nj))
+                   bdy( ni,k,njde-nj+1,P_YEB ) = psca(ci+shw,cj+shw,ip+1+(jp)*nri )
+                 ENDIF
+               ELSE
+                 IF   (  nj .ge. njde - sz .AND. nj .le. njde-1 ) THEN
+                   bdy_t(ni,k,njde-nj,P_YEB ) = rdt*(psca(ci+shw,cj+shw,ip+1+(jp)*nri)-nfld(ni,k,nj))
+                   bdy( ni,k,njde-nj,P_YEB ) = psca(ci+shw,cj+shw,ip+1+(jp)*nri )
+                 ENDIF
+               ENDIF
+
+           ENDDO
+        ENDDO
+     ENDDO
+   !$OMP END PARALLEL DO
+#endif
+
+#ifdef DUMBCOPY
+!write(0,'("cims:cime, ckms:ckme, cjms:cjme ",6i4)')cims,cime, ckms,ckme, cjms,cjme
+!write(0,'("nims:nime, nkms:nkme, njms:njme ",6i4)')nims,nime, nkms,nkme, njms,njme
+!write(0,'("cits:cite, ckts:ckte, cjts:cjte ",6i4)')cits,cite, ckts,ckte, cjts,cjte
+!write(0,'("nits:nite, nkts:nkte, njts:njte ",6i4)')nits,nite, nkts,nkte, njts,njte
+
+     DO nj = njts, njte
+        cj = jpos + (nj-1) / nrj     ! j coord of CD point 
+        jp = mod ( nj , nrj )  ! coord of ND w/i CD point
+        DO nk = nkts, nkte
+           ck = nk
+           DO ni = nits, nite
+              ci = ipos + (ni-1) / nri      ! j coord of CD point 
+              ip = mod ( ni , nri )  ! coord of ND w/i CD point
+              ! This is a trivial implementation of the interp_fcn; just copies
+              ! the values from the CD into the ND
+              nfld( ni, nk, nj ) = cfld( ci , ck , cj )
+           ENDDO
+        ENDDO
+     ENDDO
+#endif
+
+     RETURN
+
+   END SUBROUTINE bdy_interp1
+
+
+
+   SUBROUTINE interp_fcni( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj                             )   ! nest ratios
+     USE module_configure
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     INTEGER, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     INTEGER, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+
+     ! Local
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp
+
+     ! Iterate over the ND tile and compute the values
+     ! from the CD tile. 
+
+!write(0,'("cits:cite, ckts:ckte, cjts:cjte ",6i4)')cits,cite, ckts,ckte, cjts,cjte
+!write(0,'("nits:nite, nkts:nkte, njts:njte ",6i4)')nits,nite, nkts,nkte, njts,njte
+
+     DO nj = njts, njte
+        cj = jpos + (nj-1) / nrj     ! j coord of CD point 
+        jp = mod ( nj , nrj )  ! coord of ND w/i CD point
+        DO nk = nkts, nkte
+           ck = nk
+           DO ni = nits, nite
+              ci = ipos + (ni-1) / nri      ! j coord of CD point 
+              ip = mod ( ni , nri )  ! coord of ND w/i CD point
+              ! This is a trivial implementation of the interp_fcn; just copies
+              ! the values from the CD into the ND
+              nfld( ni, nk, nj ) = cfld( ci , ck , cj )
+           ENDDO
+        ENDDO
+     ENDDO
+
+     RETURN
+
+   END SUBROUTINE interp_fcni
+
+   SUBROUTINE interp_fcnm( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj                             )   ! nest ratios
+     USE module_configure
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+
+     ! Local
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp
+
+     ! Iterate over the ND tile and compute the values
+     ! from the CD tile. 
+
+!write(0,'("mask cits:cite, ckts:ckte, cjts:cjte ",6i4)')cits,cite, ckts,ckte, cjts,cjte
+!write(0,'("mask nits:nite, nkts:nkte, njts:njte ",6i4)')nits,nite, nkts,nkte, njts,njte
+
+     DO nj = njts, njte
+        cj = jpos + (nj-1) / nrj     ! j coord of CD point 
+        jp = mod ( nj , nrj )  ! coord of ND w/i CD point
+        DO nk = nkts, nkte
+           ck = nk
+           DO ni = nits, nite
+              ci = ipos + (ni-1) / nri      ! j coord of CD point 
+              ip = mod ( ni , nri )  ! coord of ND w/i CD point
+              ! This is a trivial implementation of the interp_fcn; just copies
+              ! the values from the CD into the ND
+              nfld( ni, nk, nj ) = cfld( ci , ck , cj )
+           ENDDO
+        ENDDO
+     ENDDO
+
+     RETURN
+
+   END SUBROUTINE interp_fcnm
+
+   SUBROUTINE interp_mask_land_field ( cfld,                     &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &  ! nest ratios
+                           clu, nlu                              )
+
+      USE module_configure
+      USE module_wrf_error
+
+      IMPLICIT NONE
+   
+   
+      INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             shw,                                  &
+                             ipos, jpos,                           &
+                             nri, nrj
+      LOGICAL, INTENT(IN) :: xstag, ystag
+   
+      REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+      REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+   
+      REAL, DIMENSION ( cims:cime, cjms:cjme ) :: clu
+      REAL, DIMENSION ( nims:nime, njms:njme ) :: nlu
+   
+      ! Local
+   
+      INTEGER ci, cj, ck, ni, nj, nk, ip, jp
+      INTEGER :: icount , ii , jj , ist , ien , jst , jen , iswater
+      REAL :: avg , sum , dx , dy
+      INTEGER , PARAMETER :: max_search = 5
+      CHARACTER*120 message
+   
+      !  Find out what the water value is.
+   
+      CALL nl_get_iswater(1,iswater)
+
+      !  Right now, only mass point locations permitted.
+   
+      IF ( ( .NOT. xstag) .AND. ( .NOT. ystag ) ) THEN
+
+         !  Loop over each i,k,j in the nested domain.
+
+         DO nj = njts, njte
+            IF ( MOD ( nrj , 2 ) .EQ. 0 ) THEN
+               cj = ( nj + (nrj/2)-1 ) / nrj + jpos -1 ! first coarse position equal to or below nest point
+            ELSE
+               cj = ( nj + (nrj-1)/2 ) / nrj + jpos -1 ! first coarse position equal to or below nest point
+            END IF
+            DO nk = nkts, nkte
+               ck = nk
+               DO ni = nits, nite
+                  IF ( MOD ( nri , 2 ) .EQ. 0 ) THEN
+                     ci = ( ni + (nri/2)-1 ) / nri + ipos -1 ! first coarse position equal to or to the left of nest point
+                  ELSE
+                     ci = ( ni + (nri-1)/2 ) / nri + ipos -1 ! first coarse position equal to or to the left of nest point
+                  END IF
+   
+
+
+
+                  !
+                  !                    (ci,cj+1)     (ci+1,cj+1)
+                  !               -        -------------
+                  !         1-dy  |        |           |
+                  !               |        |           |
+                  !               -        |  *        |
+                  !          dy   |        | (ni,nj)   |
+                  !               |        |           |
+                  !               -        -------------
+                  !                    (ci,cj)       (ci+1,cj)  
+                  !
+                  !                        |--|--------|
+                  !                         dx  1-dx         
+
+
+                  !  For odd ratios, at (nri+1)/2, we are on the coarse grid point, so dx = 0
+
+                  IF ( MOD ( nri , 2 ) .EQ. 0 ) THEN
+                     dx = ( REAL ( MOD ( ni+(nri-1)/2 , nri ) ) + 0.5 ) / REAL ( nri ) 
+                  ELSE 
+                     dx =   REAL ( MOD ( ni+(nri-1)/2 , nri ) )         / REAL ( nri ) 
+                  END IF
+                  IF ( MOD ( nrj , 2 ) .EQ. 0 ) THEN
+                     dy = ( REAL ( MOD ( nj+(nrj-1)/2 , nrj ) ) + 0.5 ) / REAL ( nrj ) 
+                  ELSE 
+                     dy =   REAL ( MOD ( nj+(nrj-1)/2 , nrj ) )         / REAL ( nrj ) 
+                  END IF
+   
+                  !  This is a "land only" field.  If this is a water point, no operations required.
+
+                  IF      ( ( NINT(nlu(ni  ,nj  )) .EQ. iswater ) ) THEN
+                     ! noop
+!                    nfld(ni,nk,nj) =  1.e20
+                     nfld(ni,nk,nj) =  -1
+
+                  !  If this is a nested land point, and the surrounding coarse values are all land points,
+                  !  then this is a simple 4-pt interpolation.
+
+                  ELSE IF ( ( NINT(nlu(ni  ,nj  )) .NE. iswater ) .AND. &
+                            ( NINT(clu(ci  ,cj  )) .NE. iswater ) .AND. &
+                            ( NINT(clu(ci+1,cj  )) .NE. iswater ) .AND. &
+                            ( NINT(clu(ci  ,cj+1)) .NE. iswater ) .AND. &
+                            ( NINT(clu(ci+1,cj+1)) .NE. iswater ) ) THEN
+                     nfld(ni,nk,nj) = ( 1. - dx ) * ( ( 1. - dy ) * cfld(ci  ,ck,cj  )   + &
+                                                             dy   * cfld(ci  ,ck,cj+1) ) + &
+                                             dx   * ( ( 1. - dy ) * cfld(ci+1,ck,cj  )   + &
+                                                             dy   * cfld(ci+1,ck,cj+1) )
+
+                  !  If this is a nested land point and there are NO coarse land values surrounding,
+                  !  we temporarily punt.
+
+                  ELSE IF ( ( NINT(nlu(ni  ,nj  )) .NE. iswater ) .AND. &
+                            ( NINT(clu(ci  ,cj  )) .EQ. iswater ) .AND. &
+                            ( NINT(clu(ci+1,cj  )) .EQ. iswater ) .AND. &
+                            ( NINT(clu(ci  ,cj+1)) .EQ. iswater ) .AND. &
+                            ( NINT(clu(ci+1,cj+1)) .EQ. iswater ) ) THEN
+!                    nfld(ni,nk,nj) = -1.e20
+                     nfld(ni,nk,nj) = -1
+
+                  !  If there are some water points and some land points, take an average. 
+                  
+                  ELSE IF ( NINT(nlu(ni  ,nj  )) .NE. iswater ) THEN
+                     icount = 0
+                     sum = 0
+                     IF ( NINT(clu(ci  ,cj  )) .NE. iswater ) THEN
+                        icount = icount + 1
+                        sum = sum + cfld(ci  ,ck,cj  )
+                     END IF
+                     IF ( NINT(clu(ci+1,cj  )) .NE. iswater ) THEN
+                        icount = icount + 1
+                        sum = sum + cfld(ci+1,ck,cj  )
+                     END IF
+                     IF ( NINT(clu(ci  ,cj+1)) .NE. iswater ) THEN
+                        icount = icount + 1
+                        sum = sum + cfld(ci  ,ck,cj+1)
+                     END IF
+                     IF ( NINT(clu(ci+1,cj+1)) .NE. iswater ) THEN
+                        icount = icount + 1
+                        sum = sum + cfld(ci+1,ck,cj+1)
+                     END IF
+                     nfld(ni,nk,nj) = sum / REAL ( icount ) 
+                  END IF
+               END DO
+            END DO
+         END DO
+
+         !  Get an average of the whole domain for problem locations.
+
+         sum = 0
+         icount = 0 
+         DO nj = njts, njte
+            DO nk = nkts, nkte
+               DO ni = nits, nite
+                  IF ( ( nfld(ni,nk,nj) .GT. -1.e19 ) .AND. (  nfld(ni,nk,nj) .LT. 1.e19 ) ) THEN
+                     icount = icount + 1
+                     sum = sum + nfld(ni,nk,nj)
+                  END IF
+               END DO
+            END DO
+         END DO
+         CALL wrf_dm_bcast_real( sum, 1 )
+         IF ( icount .GT. 0 ) THEN
+           avg = sum / REAL ( icount ) 
+
+         !  OK, if there were any of those island situations, we try to search a bit broader
+         !  of an area in the coarse grid.
+
+           DO nj = njts, njte
+              DO nk = nkts, nkte
+                 DO ni = nits, nite
+                    IF ( nfld(ni,nk,nj) .LT. -1.e19 ) THEN
+                       IF ( MOD ( nrj , 2 ) .EQ. 0 ) THEN
+                          cj = ( nj + (nrj/2)-1 ) / nrj + jpos -1 ! first coarse position equal to or below nest point
+                       ELSE
+                          cj = ( nj + (nrj-1)/2 ) / nrj + jpos -1 ! first coarse position equal to or below nest point
+                       END IF
+                       IF ( MOD ( nri , 2 ) .EQ. 0 ) THEN
+                          ci = ( ni + (nri/2)-1 ) / nri + ipos -1 ! first coarse position equal to or to the left of nest point
+                       ELSE
+                          ci = ( ni + (nri-1)/2 ) / nri + ipos -1 ! first coarse position equal to or to the left of nest point
+                       END IF
+                       ist = MAX (ci-max_search,cits)
+                       ien = MIN (ci+max_search,cite,cide-1)
+                       jst = MAX (cj-max_search,cjts)
+                       jen = MIN (cj+max_search,cjte,cjde-1)
+                       icount = 0 
+                       sum = 0
+                       DO jj = jst,jen
+                          DO ii = ist,ien
+                             IF ( NINT(clu(ii,jj)) .NE. iswater ) THEN
+                                icount = icount + 1
+                                sum = sum + cfld(ii,nk,jj)
+                             END IF
+                          END DO
+                       END DO
+                       IF ( icount .GT. 0 ) THEN
+                          nfld(ni,nk,nj) = sum / REAL ( icount ) 
+                       ELSE
+!                         CALL wrf_error_fatal ( "horizontal interp error - island" )
+                          write(message,*) 'horizontal interp error - island, using average ', avg
+                          CALL wrf_message ( message )
+                          nfld(ni,nk,nj) = avg
+                       END IF        
+                    END IF
+                 END DO
+              END DO
+           END DO
+         ENDIF
+      ELSE
+         CALL wrf_error_fatal ( "only unstaggered fields right now" )
+      END IF
+
+   END SUBROUTINE interp_mask_land_field
+
+   SUBROUTINE interp_mask_water_field ( cfld,                    &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj,                             &  ! nest ratios
+                           clu, nlu                              )
+
+      USE module_configure
+      USE module_wrf_error
+
+      IMPLICIT NONE
+   
+   
+      INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             shw,                                  &
+                             ipos, jpos,                           &
+                             nri, nrj
+      LOGICAL, INTENT(IN) :: xstag, ystag
+   
+      REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+      REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ) :: imask
+   
+      REAL, DIMENSION ( cims:cime, cjms:cjme ) :: clu
+      REAL, DIMENSION ( nims:nime, njms:njme ) :: nlu
+   
+      ! Local
+   
+      INTEGER ci, cj, ck, ni, nj, nk, ip, jp
+      INTEGER :: icount , ii , jj , ist , ien , jst , jen , iswater
+      REAL :: avg , sum , dx , dy
+      INTEGER , PARAMETER :: max_search = 5
+   
+      !  Find out what the water value is.
+   
+      CALL nl_get_iswater(1,iswater)
+
+      !  Right now, only mass point locations permitted.
+   
+      IF ( ( .NOT. xstag) .AND. ( .NOT. ystag ) ) THEN
+
+         !  Loop over each i,k,j in the nested domain.
+
+         DO nj = njts, njte
+            IF ( MOD ( nrj , 2 ) .EQ. 0 ) THEN
+               cj = ( nj + (nrj/2)-1 ) / nrj + jpos -1 ! first coarse position equal to or below nest point
+            ELSE
+               cj = ( nj + (nrj-1)/2 ) / nrj + jpos -1 ! first coarse position equal to or below nest point
+            END IF
+            DO nk = nkts, nkte
+               ck = nk
+               DO ni = nits, nite
+                  IF ( MOD ( nri , 2 ) .EQ. 0 ) THEN
+                     ci = ( ni + (nri/2)-1 ) / nri + ipos -1 ! first coarse position equal to or to the left of nest point
+                  ELSE
+                     ci = ( ni + (nri-1)/2 ) / nri + ipos -1 ! first coarse position equal to or to the left of nest point
+                  END IF
+   
+
+
+
+                  !
+                  !                    (ci,cj+1)     (ci+1,cj+1)
+                  !               -        -------------
+                  !         1-dy  |        |           |
+                  !               |        |           |
+                  !               -        |  *        |
+                  !          dy   |        | (ni,nj)   |
+                  !               |        |           |
+                  !               -        -------------
+                  !                    (ci,cj)       (ci+1,cj)  
+                  !
+                  !                        |--|--------|
+                  !                         dx  1-dx         
+
+
+                  !  At ni=2, we are on the coarse grid point, so dx = 0
+
+                  IF ( MOD ( nri , 2 ) .EQ. 0 ) THEN
+                     dx = ( REAL ( MOD ( ni+(nri-1)/2 , nri ) ) + 0.5 ) / REAL ( nri ) 
+                  ELSE 
+                     dx =   REAL ( MOD ( ni+(nri-1)/2 , nri ) )         / REAL ( nri ) 
+                  END IF
+                  IF ( MOD ( nrj , 2 ) .EQ. 0 ) THEN
+                     dy = ( REAL ( MOD ( nj+(nrj-1)/2 , nrj ) ) + 0.5 ) / REAL ( nrj ) 
+                  ELSE 
+                     dy =   REAL ( MOD ( nj+(nrj-1)/2 , nrj ) )         / REAL ( nrj ) 
+                  END IF
+   
+                  !  This is a "water only" field.  If this is a land point, no operations required.
+
+                  IF      ( ( NINT(nlu(ni  ,nj  )) .NE. iswater ) ) THEN
+                     ! noop
+!                    nfld(ni,nk,nj) =  1.e20
+                     nfld(ni,nk,nj) = -1
+
+                  !  If this is a nested water point, and the surrounding coarse values are all water points,
+                  !  then this is a simple 4-pt interpolation.
+
+                  ELSE IF ( ( NINT(nlu(ni  ,nj  )) .EQ. iswater ) .AND. &
+                            ( NINT(clu(ci  ,cj  )) .EQ. iswater ) .AND. &
+                            ( NINT(clu(ci+1,cj  )) .EQ. iswater ) .AND. &
+                            ( NINT(clu(ci  ,cj+1)) .EQ. iswater ) .AND. &
+                            ( NINT(clu(ci+1,cj+1)) .EQ. iswater ) ) THEN
+                     nfld(ni,nk,nj) = ( 1. - dx ) * ( ( 1. - dy ) * cfld(ci  ,ck,cj  )   + &
+                                                             dy   * cfld(ci  ,ck,cj+1) ) + &
+                                             dx   * ( ( 1. - dy ) * cfld(ci+1,ck,cj  )   + &
+                                                             dy   * cfld(ci+1,ck,cj+1) )
+
+                  !  If this is a nested water point and there are NO coarse water values surrounding,
+                  !  we temporarily punt.
+
+                  ELSE IF ( ( NINT(nlu(ni  ,nj  )) .EQ. iswater ) .AND. &
+                            ( NINT(clu(ci  ,cj  )) .NE. iswater ) .AND. &
+                            ( NINT(clu(ci+1,cj  )) .NE. iswater ) .AND. &
+                            ( NINT(clu(ci  ,cj+1)) .NE. iswater ) .AND. &
+                            ( NINT(clu(ci+1,cj+1)) .NE. iswater ) ) THEN
+!                    nfld(ni,nk,nj) = -1.e20
+                     nfld(ni,nk,nj) = -1
+
+                  !  If there are some land points and some water points, take an average. 
+                  
+                  ELSE IF ( NINT(nlu(ni  ,nj  )) .EQ. iswater ) THEN
+                     icount = 0
+                     sum = 0
+                     IF ( NINT(clu(ci  ,cj  )) .EQ. iswater ) THEN
+                        icount = icount + 1
+                        sum = sum + cfld(ci  ,ck,cj  )
+                     END IF
+                     IF ( NINT(clu(ci+1,cj  )) .EQ. iswater ) THEN
+                        icount = icount + 1
+                        sum = sum + cfld(ci+1,ck,cj  )
+                     END IF
+                     IF ( NINT(clu(ci  ,cj+1)) .EQ. iswater ) THEN
+                        icount = icount + 1
+                        sum = sum + cfld(ci  ,ck,cj+1)
+                     END IF
+                     IF ( NINT(clu(ci+1,cj+1)) .EQ. iswater ) THEN
+                        icount = icount + 1
+                        sum = sum + cfld(ci+1,ck,cj+1)
+                     END IF
+                     nfld(ni,nk,nj) = sum / REAL ( icount ) 
+                  END IF
+               END DO
+            END DO
+         END DO
+
+         !  Get an average of the whole domain for problem locations.
+
+         sum = 0
+         icount = 0 
+         DO nj = njts, njte
+            DO nk = nkts, nkte
+               DO ni = nits, nite
+                  IF ( ( nfld(ni,nk,nj) .GT. -1.e19 ) .AND. (  nfld(ni,nk,nj) .LT. 1.e19 ) ) THEN
+                     icount = icount + 1
+                     sum = sum + nfld(ni,nk,nj)
+                  END IF
+               END DO
+            END DO
+         END DO
+         avg = sum / REAL ( icount ) 
+
+
+         !  OK, if there were any of those lake situations, we try to search a bit broader
+         !  of an area in the coarse grid.
+
+         DO nj = njts, njte
+            DO nk = nkts, nkte
+               DO ni = nits, nite
+                  IF ( nfld(ni,nk,nj) .LT. -1.e19 ) THEN
+                     IF ( MOD ( nrj , 2 ) .EQ. 0 ) THEN
+                        cj = ( nj + (nrj/2)-1 ) / nrj + jpos -1 ! first coarse position equal to or below nest point
+                     ELSE
+                        cj = ( nj + (nrj-1)/2 ) / nrj + jpos -1 ! first coarse position equal to or below nest point
+                     END IF
+                     IF ( MOD ( nri , 2 ) .EQ. 0 ) THEN
+                        ci = ( ni + (nri/2)-1 ) / nri + ipos -1 ! first coarse position equal to or to the left of nest point
+                     ELSE
+                        ci = ( ni + (nri-1)/2 ) / nri + ipos -1 ! first coarse position equal to or to the left of nest point
+                     END IF
+                     ist = MAX (ci-max_search,cits)
+                     ien = MIN (ci+max_search,cite,cide-1)
+                     jst = MAX (cj-max_search,cjts)
+                     jen = MIN (cj+max_search,cjte,cjde-1)
+                     icount = 0 
+                     sum = 0
+                     DO jj = jst,jen
+                        DO ii = ist,ien
+                           IF ( NINT(clu(ii,jj)) .EQ. iswater ) THEN
+                              icount = icount + 1
+                              sum = sum + cfld(ii,nk,jj)
+                           END IF
+                        END DO
+                     END DO
+                     IF ( icount .GT. 0 ) THEN
+                        nfld(ni,nk,nj) = sum / REAL ( icount ) 
+                     ELSE
+!                       CALL wrf_error_fatal ( "horizontal interp error - lake" )
+                        print *,'horizontal interp error - lake, using average ',avg
+                        nfld(ni,nk,nj) = avg
+                     END IF        
+                  END IF
+               END DO
+            END DO
+         END DO
+      ELSE
+         CALL wrf_error_fatal ( "only unstaggered fields right now" )
+      END IF
+
+   END SUBROUTINE interp_mask_water_field
+
+   SUBROUTINE none
+   END SUBROUTINE none
+
+   SUBROUTINE smoother ( cfld , &
+                      cids, cide, ckds, ckde, cjds, cjde,   &
+                      cims, cime, ckms, ckme, cjms, cjme,   &
+                      cits, cite, ckts, ckte, cjts, cjte,   &
+                      nids, nide, nkds, nkde, njds, njde,   &
+                      nims, nime, nkms, nkme, njms, njme,   &
+                      nits, nite, nkts, nkte, njts, njte,   &
+                      xstag, ystag,                         &  ! staggering of field
+                      ipos, jpos,                           &  ! Position of lower left of nest in
+                      nri, nrj                              &
+                      )
+ 
+      USE module_configure
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             nri, nrj,                             &  
+                             ipos, jpos
+      LOGICAL, INTENT(IN) :: xstag, ystag
+      INTEGER             :: smooth_option, feedback , spec_zone
+   
+      REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+
+      !  If there is no feedback, there can be no smoothing.
+
+      CALL nl_get_feedback       ( 1, feedback  )
+      IF ( feedback == 0 ) RETURN
+      CALL nl_get_spec_zone ( 1, spec_zone )
+
+      !  These are the 2d smoothers used on the fedback data.  These filters
+      !  are run on the coarse grid data (after the nested info has been
+      !  fedback).  Only the area of the nest in the coarse grid is filtered.
+
+      CALL nl_get_smooth_option  ( 1, smooth_option  )
+
+      IF      ( smooth_option == 0 ) THEN
+! no op
+      ELSE IF ( smooth_option == 1 ) THEN
+         CALL sm121 ( cfld , &
+                      cids, cide, ckds, ckde, cjds, cjde,   &
+                      cims, cime, ckms, ckme, cjms, cjme,   &
+                      cits, cite, ckts, ckte, cjts, cjte,   &
+                      xstag, ystag,                         &  ! staggering of field
+                      nids, nide, nkds, nkde, njds, njde,   &
+                      nims, nime, nkms, nkme, njms, njme,   &
+                      nits, nite, nkts, nkte, njts, njte,   &
+                      nri, nrj,                             &  
+                      ipos, jpos                            &  ! Position of lower left of nest in 
+                      )
+      ELSE IF ( smooth_option == 2 ) THEN
+         CALL smdsm ( cfld , &
+                      cids, cide, ckds, ckde, cjds, cjde,   &
+                      cims, cime, ckms, ckme, cjms, cjme,   &
+                      cits, cite, ckts, ckte, cjts, cjte,   &
+                      xstag, ystag,                         &  ! staggering of field
+                      nids, nide, nkds, nkde, njds, njde,   &
+                      nims, nime, nkms, nkme, njms, njme,   &
+                      nits, nite, nkts, nkte, njts, njte,   &
+                      nri, nrj,                             &  
+                      ipos, jpos                            &  ! Position of lower left of nest in 
+                      )
+      END IF
+
+   END SUBROUTINE smoother 
+
+   SUBROUTINE sm121 ( cfld , &
+                      cids, cide, ckds, ckde, cjds, cjde,   &
+                      cims, cime, ckms, ckme, cjms, cjme,   &
+                      cits, cite, ckts, ckte, cjts, cjte,   &
+                      xstag, ystag,                         &  ! staggering of field
+                      nids, nide, nkds, nkde, njds, njde,   &
+                      nims, nime, nkms, nkme, njms, njme,   &
+                      nits, nite, nkts, nkte, njts, njte,   &
+                      nri, nrj,                             &  
+                      ipos, jpos                            &  ! Position of lower left of nest in 
+                      )
+   
+      USE module_configure
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             nri, nrj,                             &  
+                             ipos, jpos
+      LOGICAL, INTENT(IN) :: xstag, ystag
+   
+      REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+      REAL, DIMENSION ( cims:cime,            cjms:cjme ) :: cfldnew
+   
+      INTEGER                        :: i , j , k , loop
+      INTEGER :: istag,jstag
+
+      INTEGER, PARAMETER  :: smooth_passes = 1 ! More passes requires a larger stencil (currently 48 pt)
+
+      istag = 1 ; jstag = 1
+      IF ( xstag ) istag = 0
+      IF ( ystag ) jstag = 0
+   
+      !  Simple 1-2-1 smoother.
+   
+      smoothing_passes : DO loop = 1 , smooth_passes
+   
+         DO k = ckts , ckte
+   
+            !  Initialize dummy cfldnew
+
+            DO i = MAX(ipos,cits-3) , MIN(ipos+(nide-nids)/nri,cite+3)
+               DO j = MAX(jpos,cjts-3) , MIN(jpos+(njde-njds)/nrj,cjte+3)
+                  cfldnew(i,j) = cfld(i,k,j) 
+               END DO
+            END DO
+
+            !  1-2-1 smoothing in the j direction first, 
+   
+            DO i = MAX(ipos+1,cits-2) , MIN(ipos+(nide-nids)/nri-1-istag,cite+2)
+            DO j = MAX(jpos+1,cjts-2) , MIN(jpos+(njde-njds)/nrj-1-jstag,cjte+2)
+                  cfldnew(i,j) = 0.25 * ( cfld(i,k,j+1) + 2.*cfld(i,k,j) + cfld(i,k,j-1) )
+               END DO
+            END DO
+
+            !  then 1-2-1 smoothing in the i direction last
+       
+            DO j = MAX(jpos+1,cjts-2) , MIN(jpos+(njde-njds)/nrj-1-jstag,cjte+2)
+            DO i = MAX(ipos+1,cits-2) , MIN(ipos+(nide-nids)/nri-1-istag,cite+2)
+                  cfld(i,k,j) =  0.25 * ( cfldnew(i+1,j) + 2.*cfldnew(i,j) + cfldnew(i-1,j) )
+               END DO
+            END DO
+       
+         END DO
+    
+      END DO smoothing_passes
+   
+   END SUBROUTINE sm121
+
+   SUBROUTINE smdsm ( cfld , &
+                      cids, cide, ckds, ckde, cjds, cjde,   &
+                      cims, cime, ckms, ckme, cjms, cjme,   &
+                      cits, cite, ckts, ckte, cjts, cjte,   &
+                      xstag, ystag,                         &  ! staggering of field
+                      nids, nide, nkds, nkde, njds, njde,   &
+                      nims, nime, nkms, nkme, njms, njme,   &
+                      nits, nite, nkts, nkte, njts, njte,   &
+                      nri, nrj,                             &  
+                      ipos, jpos                            &  ! Position of lower left of nest in 
+                      )
+   
+      USE module_configure
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                             cims, cime, ckms, ckme, cjms, cjme,   &
+                             cits, cite, ckts, ckte, cjts, cjte,   &
+                             nids, nide, nkds, nkde, njds, njde,   &
+                             nims, nime, nkms, nkme, njms, njme,   &
+                             nits, nite, nkts, nkte, njts, njte,   &
+                             nri, nrj,                             &  
+                             ipos, jpos
+      LOGICAL, INTENT(IN) :: xstag, ystag
+   
+      REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+      REAL, DIMENSION ( cims:cime,            cjms:cjme ) :: cfldnew
+   
+      REAL , DIMENSION ( 2 )         :: xnu
+      INTEGER                        :: i , j , k , loop , n 
+      INTEGER :: istag,jstag
+
+      INTEGER, PARAMETER  :: smooth_passes = 1 ! More passes requires a larger stencil (currently 48 pt)
+
+      xnu  =  (/ 0.50 , -0.52 /)
+    
+      istag = 1 ; jstag = 1
+      IF ( xstag ) istag = 0
+      IF ( ystag ) jstag = 0
+   
+      !  The odd number passes of this are the "smoother", the even
+      !  number passes are the "de-smoother" (note the different signs on xnu).
+   
+      smoothing_passes : DO loop = 1 , smooth_passes * 2
+   
+         n  =  2 - MOD ( loop , 2 )
+    
+         DO k = ckts , ckte
+   
+            DO i = MAX(ipos+1,cits-2) , MIN(ipos+(nide-nids)/nri-1-istag,cite+2)
+               DO j = MAX(jpos+1,cjts-2) , MIN(jpos+(njde-njds)/nrj-1-jstag,cjte+2)
+                  cfldnew(i,j) = cfld(i,k,j) + xnu(n) * ((cfld(i,k,j+1) + cfld(i,k,j-1)) * 0.5-cfld(i,k,j))
+               END DO
+            END DO
+       
+            DO i = MAX(ipos+1,cits-2) , MIN(ipos+(nide-nids)/nri-1-istag,cite+2)
+               DO j = MAX(jpos+1,cjts-2) , MIN(jpos+(njde-njds)/nrj-1-jstag,cjte+2)
+                  cfld(i,k,j) = cfldnew(i,j)
+               END DO
+            END DO
+       
+            DO j = MAX(jpos+1,cjts-2) , MIN(jpos+(njde-njds)/nrj-1-jstag,cjte+2)
+               DO i = MAX(ipos+1,cits-2) , MIN(ipos+(nide-nids)/nri-1-istag,cite+2)
+                  cfldnew(i,j) = cfld(i,k,j) + xnu(n) * ((cfld(i+1,k,j) + cfld(i-1,k,j)) * 0.5-cfld(i,k,j))
+               END DO
+            END DO
+       
+            DO j = MAX(jpos+1,cjts-2) , MIN(jpos+(njde-njds)/nrj-1-jstag,cjte+2)
+               DO i = MAX(ipos+1,cits-2) , MIN(ipos+(nide-nids)/nri-1-istag,cite+2)
+                  cfld(i,k,j) = cfldnew(i,j)
+               END DO
+            END DO
+   
+         END DO
+    
+      END DO smoothing_passes
+   
+   END SUBROUTINE smdsm
+
+!==================================
+! this is used to modify a field over the nest so we can see where the nest is
+
+   SUBROUTINE mark_domain (  cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           shw,                                  &  ! stencil half width for interp
+                           imask,                                &  ! interpolation mask
+                           xstag, ystag,                         &  ! staggering of field
+                           ipos, jpos,                           &  ! Position of lower left of nest in CD
+                           nri, nrj                             )   ! nest ratios
+     USE module_configure
+     USE module_wrf_error
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            shw,                                  &
+                            ipos, jpos,                           &
+                            nri, nrj
+     LOGICAL, INTENT(IN) :: xstag, ystag
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ), INTENT(OUT) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ), INTENT(IN) :: nfld
+     INTEGER, DIMENSION ( nims:nime, njms:njme ), INTENT(IN) :: imask
+
+     ! Local
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp, ioff, joff, ioffa, joffa
+     INTEGER :: icmin,icmax,jcmin,jcmax
+     INTEGER :: istag,jstag, ipoints,jpoints,ijpoints
+
+     istag = 1 ; jstag = 1
+     IF ( xstag ) istag = 0
+     IF ( ystag ) jstag = 0
+
+     DO cj = MAX(jpos+1,cjts),MIN(jpos+(njde-njds)/nrj-jstag-1,cjte)
+        nj = (cj-jpos)*nrj + jstag + 1
+        DO ck = ckts, ckte
+           nk = ck
+           DO ci = MAX(ipos+1,cits),MIN(ipos+(nide-nids)/nri-istag-1,cite)
+              ni = (ci-ipos)*nri + istag + 1
+              cfld( ci, ck, cj ) =  9021000.  !magic number: Beverly Hills * 100.
+           ENDDO
+        ENDDO
+     ENDDO
+
+   END SUBROUTINE mark_domain
+
Index: trunk/WRF.COMMON/WRFV2/share/landread.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/landread.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/landread.c	(revision 2744)
@@ -0,0 +1,31 @@
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define GET_TERRAIN get_terrain
+# else
+#   ifdef F2CSTYLE
+#      define GET_TERRAIN get_terrain__
+#   else
+#      define GET_TERRAIN get_terrain_
+#   endif
+# endif
+#endif
+#include <stdio.h>
+
+int GET_TERRAIN (        float *adx,
+                         float *xlat,
+                         float *xlon,
+                         float       *terrain,
+                         int   *mix,
+                         int   *mjx,
+                         int   *iyyn,
+                         int   *jxxn,
+                         int   *ipath , int * ipathlen)  /* integer coded ASCII string from Funtran and len */
+
+{
+ fprintf(stderr, "***************************************************************\n" ) ;
+ fprintf(stderr, "Access to RSMAS Topo Ingest Code is by Special Arrangement Only\n" ) ;
+ fprintf(stderr, "in WRF 2.1 .  Please contact wrfhelp@ucar.edu .                \n" ) ;
+ fprintf(stderr, "***************************************************************\n" ) ;
+ return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/share/landread.c.dist
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/landread.c.dist	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/landread.c.dist	(revision 2744)
@@ -0,0 +1,31 @@
+#ifndef CRAY
+# ifdef NOUNDERSCORE
+#      define GET_TERRAIN get_terrain
+# else
+#   ifdef F2CSTYLE
+#      define GET_TERRAIN get_terrain__
+#   else
+#      define GET_TERRAIN get_terrain_
+#   endif
+# endif
+#endif
+#include <stdio.h>
+
+int GET_TERRAIN (        float *adx,
+                         float *xlat,
+                         float *xlon,
+                         float       *terrain,
+                         int   *mix,
+                         int   *mjx,
+                         int   *iyyn,
+                         int   *jxxn,
+                         int   *ipath , int * ipathlen)  /* integer coded ASCII string from Funtran and len */
+
+{
+ fprintf(stderr, "***************************************************************\n" ) ;
+ fprintf(stderr, "Access to RSMAS Topo Ingest Code is by Special Arrangement Only\n" ) ;
+ fprintf(stderr, "in WRF 2.1 .  Please contact wrfhelp@ucar.edu .                \n" ) ;
+ fprintf(stderr, "***************************************************************\n" ) ;
+ return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/share/landread.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/landread.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/landread.h	(revision 2744)
@@ -0,0 +1,29 @@
+#ifndef LANDREAD_H
+#define LANDREAD_H
+
+int GET_TERRAIN (        float *adx,
+                         float *xlat,
+                         float *xlon,
+                         float       *terrain,
+                         int   *mix,
+                         int   *mjx,
+                         int   *iyyn,
+                         int   *jxxn,
+                         int   *ipath , int * ipathlen) ;
+
+/* int    nint(const double x); */
+double aint(const double x);
+double anint(const double x);
+float  tsGetValue(const double aix, const double aiy);
+float  tsGetValueInt(const int aix, const int aiy);
+float  tsGetValueInterp(const double ix, const double iy);
+float  tsGetValueLatLon(const double lat, const double lon);
+int    tsCloseTileSet(void);
+int    tsInitTileSet(const char *fn);
+int    tsPrintTileSetInto(void);
+int    tsLatLonToGridpoint(const double  lat,
+			   const double  lon,
+			   double       *ix,
+			   double       *iy);
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/share/mediation_feedback_domain.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/mediation_feedback_domain.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/mediation_feedback_domain.F	(revision 2744)
@@ -0,0 +1,220 @@
+!
+!WRF:MEDIATION_LAYER:NESTING
+!
+SUBROUTINE med_feedback_domain ( parent_grid , nested_grid )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain), POINTER :: parent_grid , nested_grid
+   TYPE(domain), POINTER :: grid
+   INTEGER nlev, msize
+#if !defined(MAC_KLUDGE)
+   TYPE (grid_config_rec_type)            :: config_flags
+#endif
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+! ----------------------------------------------------------
+! ------------------------------------------------------
+! Interface blocks
+! ------------------------------------------------------
+   INTERFACE
+! ------------------------------------------------------
+!    Interface definitions for EM CORE
+! ------------------------------------------------------
+#if (EM_CORE == 1)
+#if !defined(MAC_KLUDGE)
+! ------------------------------------------------------
+!    These routines are supplied by module_dm.F from the
+!    external communication package (e.g. external/RSL)
+! ------------------------------------------------------
+      SUBROUTINE feedback_domain_em_part1 ( grid, nested_grid, config_flags   &
+!
+#          include "em_dummy_new_args.inc"
+!
+                                          )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: nested_grid
+         TYPE (grid_config_rec_type)            :: config_flags
+#        include <em_dummy_new_decl.inc>
+      END SUBROUTINE feedback_domain_em_part1
+      SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid , nested_grid, config_flags   &
+!
+#          include "em_dummy_new_args.inc"
+!
+                                          )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: intermediate_grid
+         TYPE(domain), POINTER :: nested_grid
+         TYPE (grid_config_rec_type)            :: config_flags
+#        include <em_dummy_decl.inc>
+      END SUBROUTINE feedback_domain_em_part2
+      SUBROUTINE update_after_feedback_em ( grid  &
+!
+#          include "em_dummy_new_args.inc"
+!
+                                          )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), TARGET :: grid          ! name of the grid being dereferenced (must be "grid")
+#        include <em_dummy_new_decl.inc>
+      END SUBROUTINE update_after_feedback_em
+#endif
+#endif
+! ----------------------------------------------------------
+!    Interface definitions for NMM (placeholder)
+! ----------------------------------------------------------
+#if (NMM_CORE == 1 && NMM_NEST == 1)
+! ------------------------------------------------------
+!    These routines are supplied by module_dm.F from the
+!    external communication package (e.g. external/RSL)
+!    This is gopal's extension for the NMM core
+! ------------------------------------------------------
+      SUBROUTINE feedback_domain_nmm_part1 ( grid, nested_grid, config_flags   &
+!
+#          include "nmm_dummy_args.inc"
+!
+                                          )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: nested_grid
+         TYPE (grid_config_rec_type)            :: config_flags
+#        include <nmm_dummy_decl.inc>
+      END SUBROUTINE feedback_domain_nmm_part1
+!
+      SUBROUTINE feedback_domain_nmm_part2 ( grid, intermediate_grid , nested_grid, config_flags   &
+!
+#          include "nmm_dummy_args.inc"
+!
+                                          )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: intermediate_grid
+         TYPE(domain), POINTER :: nested_grid
+         TYPE (grid_config_rec_type)            :: config_flags
+#        include <nmm_dummy_decl.inc>
+
+      END SUBROUTINE feedback_domain_nmm_part2
+#endif
+! ----------------------------------------------------------
+!    Interface definitions for COAMPS (placeholder)
+! ----------------------------------------------------------
+#if (COAMPS_CORE == 1 )
+#endif
+   END INTERFACE
+! ----------------------------------------------------------
+! End of Interface blocks
+! ----------------------------------------------------------
+! ----------------------------------------------------------
+! ----------------------------------------------------------
+! Executable code
+! ----------------------------------------------------------
+! ----------------------------------------------------------
+!    Feedback calls for EM CORE.
+! ----------------------------------------------------------
+#if (EM_CORE == 1 && defined( DM_PARALLEL ))
+#if !defined(MAC_KLUDGE)
+   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+   IF ( config_flags%dyn_opt == DYN_EM ) THEN
+     parent_grid%ht_coarse = parent_grid%ht
+     grid => nested_grid%intermediate_grid
+     CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. ,     &
+                              grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
+                              grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
+                              grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
+                              grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
+       )
+     grid => nested_grid%intermediate_grid
+#    include "deref_kludge.h"
+     CALL feedback_domain_em_part1 ( grid, nested_grid, config_flags   &
+!
+#      include "em_actual_new_args.inc"
+!
+                                   )
+     grid => parent_grid
+#    include "deref_kludge.h"
+
+     grid%nest_mask = 0.
+     CALL feedback_domain_em_part2 ( grid , nested_grid%intermediate_grid, nested_grid , config_flags   &
+!
+#      include "em_actual_new_args.inc"
+
+                                   )
+     WHERE   ( grid%nest_pos .NE. 9021000.  ) grid%ht = grid%ht_coarse
+     CALL update_after_feedback_em ( grid  &
+!
+#      include "em_actual_new_args.inc"
+!
+                                   )
+     grid => nested_grid%intermediate_grid
+     CALL dealloc_space_field ( grid )
+   ENDIF
+#endif
+#endif
+! ------------------------------------------------------
+!    End of Feedback calls for EM CORE.
+! ------------------------------------------------------
+! ------------------------------------------------------
+! ------------------------------------------------------
+!    Feedback calls for NMM. (Placeholder)
+! ------------------------------------------------------
+#if (NMM_CORE == 1 && NMM_NEST == 1)
+! ------------------------------------------------------
+!    This is gopal's extension for the NMM core
+! ------------------------------------------------------
+
+   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+   IF ( config_flags%dyn_opt == DYN_NMM ) THEN
+
+     grid => nested_grid%intermediate_grid
+!dusan orig     CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. ,     &
+     CALL alloc_space_field ( grid, grid%id , 1 , 3 , .FALSE. ,     &
+                              grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
+                              grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
+                              grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
+                              grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
+       )
+
+     grid => nested_grid%intermediate_grid
+#    include "deref_kludge.h"
+     CALL feedback_domain_nmm_part1 ( grid, nested_grid, config_flags    &
+!
+#      include "nmm_actual_args.inc"
+!
+                                   )
+     grid => parent_grid
+#    include "deref_kludge.h"
+
+!
+     CALL feedback_domain_nmm_part2 ( grid , nested_grid%intermediate_grid, nested_grid , config_flags    &
+!
+#      include "nmm_actual_args.inc"
+!
+                                   )
+     grid => nested_grid%intermediate_grid
+     CALL dealloc_space_field ( grid )
+   ENDIF
+#endif
+! ------------------------------------------------------
+!    End of Feedback calls for NMM.
+! ------------------------------------------------------
+! ------------------------------------------------------
+! ------------------------------------------------------
+!    Feedback calls for COAMPS. (Placeholder)
+! ------------------------------------------------------
+#if (COAMPS_CORE == 1)
+#endif
+! ------------------------------------------------------
+!    End of Feedback calls for COAMPS.
+! ------------------------------------------------------
+   RETURN
+END SUBROUTINE med_feedback_domain
+
+
Index: trunk/WRF.COMMON/WRFV2/share/mediation_force_domain.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/mediation_force_domain.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/mediation_force_domain.F	(revision 2744)
@@ -0,0 +1,300 @@
+!
+!WRF:MEDIATION_LAYER:NESTING
+!
+SUBROUTINE med_force_domain ( parent_grid , nested_grid )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain), POINTER :: parent_grid , nested_grid
+   TYPE(domain), POINTER :: grid
+   INTEGER nlev, msize
+#if !defined(MAC_KLUDGE)
+   TYPE (grid_config_rec_type)            :: config_flags
+#endif
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+
+! ----------------------------------------------------------
+! ------------------------------------------------------
+! Interface blocks
+! ------------------------------------------------------
+   INTERFACE
+! ------------------------------------------------------
+!    Interface definitions for EM CORE
+! ------------------------------------------------------
+#if (EM_CORE == 1)
+#if !defined(MAC_KLUDGE)
+! ------------------------------------------------------
+!    These routines are supplied by module_dm.F from the
+!    external communication package (e.g. external/RSL)
+! ------------------------------------------------------
+      SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags   &
+!
+#        include "em_dummy_new_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: intermediate_grid
+         TYPE(domain), POINTER :: ngrid
+         TYPE (grid_config_rec_type)            :: config_flags
+#        include <em_dummy_new_decl.inc>
+      END SUBROUTINE interp_domain_em_part1
+
+      SUBROUTINE force_domain_em_part2 ( grid, nested_grid, config_flags   &
+!
+#        include "em_dummy_new_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: nested_grid
+         TYPE (grid_config_rec_type)            :: config_flags
+#        include <em_dummy_new_decl.inc>
+      END SUBROUTINE force_domain_em_part2
+
+! ----------------------------------------------------------
+!    This routine is supplied by dyn_em/couple_or_uncouple_em.F
+! ----------------------------------------------------------
+      SUBROUTINE couple_or_uncouple_em ( grid, config_flags , couple  &
+!
+#        include "em_dummy_new_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), INTENT(INOUT)            :: grid
+         TYPE (grid_config_rec_type)            :: config_flags
+         LOGICAL, INTENT(   IN) :: couple
+#        include <em_dummy_new_decl.inc>
+      END SUBROUTINE couple_or_uncouple_em
+#endif
+#endif
+! ----------------------------------------------------------
+!    Interface definitions for NMM (placeholder)
+! ----------------------------------------------------------
+#if (NMM_CORE == 1 && NMM_NEST ==1)
+!=======================================================================
+!  Added for the NMM core. This is gopal's doing.
+!=======================================================================
+
+      SUBROUTINE interp_domain_nmm_part1 ( grid, intermediate_grid, ngrid, config_flags    &
+!
+# include "nmm_dummy_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: intermediate_grid
+         TYPE(domain), POINTER :: ngrid
+         TYPE (grid_config_rec_type)            :: config_flags
+# include <nmm_dummy_decl.inc>
+      END SUBROUTINE interp_domain_nmm_part1
+
+      SUBROUTINE force_domain_nmm_part2 ( grid, nested_grid, config_flags    &
+!
+# include "nmm_dummy_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: nested_grid
+         TYPE (grid_config_rec_type)            :: config_flags
+
+# include <nmm_dummy_decl.inc>
+      END SUBROUTINE force_domain_nmm_part2
+!=======================================================================
+!  End of gopal's doing.
+!=======================================================================
+#endif
+! ----------------------------------------------------------
+!    Interface definitions for COAMPS (placeholder)
+! ----------------------------------------------------------
+#if (COAMPS_CORE == 1)
+#endif
+   END INTERFACE
+! ----------------------------------------------------------
+! End of Interface blocks
+! ----------------------------------------------------------
+
+! ----------------------------------------------------------
+! ----------------------------------------------------------
+! Executable code
+! ----------------------------------------------------------
+! ----------------------------------------------------------
+!    Forcing calls for EM CORE.
+! ----------------------------------------------------------
+#if (EM_CORE == 1 && defined( DM_PARALLEL ))
+#if !defined(MAC_KLUDGE)
+   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+   IF ( config_flags%dyn_opt == DYN_EM ) THEN
+
+    grid => nested_grid%intermediate_grid
+    CALL alloc_space_field ( grid, grid%id , 1 , 2 ,  .TRUE. ,    &
+                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
+                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
+                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
+                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
+      )
+
+     ! couple parent domain
+     grid => parent_grid
+     ! swich config_flags to point to parent rconfig info
+     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+     CALL couple_or_uncouple_em ( grid , config_flags ,  .true. &
+!
+#         include "em_actual_new_args.inc"
+!
+                                )
+     ! couple nested domain
+     grid => nested_grid
+     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+     CALL couple_or_uncouple_em ( grid , config_flags ,  .true. &
+!
+#         include "em_actual_new_args.inc"
+!
+                                   )
+     ! perform first part: transfer data from parent to intermediate domain
+     ! at the same resolution but on the same decomposition as the nest
+     ! note that this will involve communication on multiple DM procs
+     grid => parent_grid
+     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+     CALL interp_domain_em_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags   &
+!
+#         include "em_actual_new_args.inc"
+!
+                                    )
+     grid => nested_grid%intermediate_grid
+        ! perform 2nd part: run interpolation on the intermediate domain
+        ! and compute the values for the nest boundaries
+        ! note that this is all local (no communication)
+     CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+     CALL force_domain_em_part2 ( grid, nested_grid, config_flags   &
+!
+#          include "em_actual_new_args.inc"
+!
+                                   )
+     ! uncouple the nest
+     grid => nested_grid
+     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+     CALL couple_or_uncouple_em ( grid , config_flags ,  .false.  &
+!
+#          include "em_actual_new_args.inc"
+!
+                                   )
+     ! uncouple the parent
+     grid => parent_grid
+     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+     CALL couple_or_uncouple_em ( grid , config_flags ,  .false.  &
+!
+#          include "em_actual_new_args.inc"
+!
+                                )
+     IF ( nested_grid%first_force ) THEN
+        nested_grid%first_force = .FALSE.
+     ENDIF
+     nested_grid%dtbc = 0.
+!
+     grid => nested_grid%intermediate_grid
+     CALL dealloc_space_field ( grid )
+   ENDIF
+#endif
+#endif
+! ------------------------------------------------------
+!    End of Forcing calls for EM CORE.
+! ------------------------------------------------------
+! ------------------------------------------------------
+! ------------------------------------------------------
+!    Forcing calls for NMM. (Placeholder)
+! ------------------------------------------------------
+# if (NMM_CORE == 1 && NMM_NEST == 1)
+!=======================================================================
+!  Added for the NMM core. This is gopal's doing.
+!=======================================================================
+
+   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+   IF ( config_flags%dyn_opt == DYN_NMM ) THEN
+
+    grid => nested_grid%intermediate_grid
+!dusan orig    CALL alloc_space_field ( grid, grid%id , 1 , 2 ,  .TRUE. ,    &
+    CALL alloc_space_field ( grid, grid%id , 1 , 3 ,  .FALSE. ,    &
+                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
+                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
+                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
+                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
+      )
+
+     ! couple parent domain
+     grid => parent_grid
+     ! swich config_flags to point to parent rconfig info
+     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+#    include "deref_kludge.h"
+
+     ! on restart do not force the nest the first time since it has already been forced
+     ! prior to the writing of the restart file
+     IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
+        ! couple nested domain
+        grid => nested_grid
+        CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+#       include "deref_kludge.h"
+        ! perform first part: transfer data from parent to intermediate domain
+        ! at the same resolution but on the same decomposition as the nest
+        ! note that this will involve communication on multiple DM procs
+        grid => parent_grid
+        CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+#       include "deref_kludge.h"
+        CALL interp_domain_nmm_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags    &
+!
+#         include "nmm_actual_args.inc"
+!
+                                     )
+     ENDIF ! not restart and first force
+
+     grid => nested_grid%intermediate_grid
+     IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
+        ! perform 2nd part: run interpolation on the intermediate domain
+        ! and compute the values for the nest boundaries
+        ! note that this is all local (no communication)
+        CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+#       include "deref_kludge.h"
+        CALL force_domain_nmm_part2 ( grid, nested_grid, config_flags    &
+!
+#         include "nmm_actual_args.inc"
+!
+                                    )
+     ENDIF ! not restart and first_force
+
+     IF ( nested_grid%first_force ) THEN
+        nested_grid%first_force = .FALSE.
+     ENDIF
+     nested_grid%dtbc = 0.
+!
+     grid => nested_grid%intermediate_grid
+     CALL dealloc_space_field ( grid )
+   ENDIF
+!=======================================================================
+!  End of gopal's doing.
+!=======================================================================
+# endif
+! ------------------------------------------------------
+!    End of Forcing calls for NMM.
+! ------------------------------------------------------
+! ------------------------------------------------------
+! ------------------------------------------------------
+!    Forcing calls for COAMPS. (Placeholder)
+! ------------------------------------------------------
+# if (COAMPS_CORE == 1)
+# endif
+! ------------------------------------------------------
+!    End of Forcing calls for COAMPS.
+! ------------------------------------------------------
+   RETURN
+END SUBROUTINE med_force_domain
+
+
Index: trunk/WRF.COMMON/WRFV2/share/mediation_integrate.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/mediation_integrate.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/mediation_integrate.F	(revision 2744)
@@ -0,0 +1,2135 @@
+!
+!WRF:MEDIATION_LAYER:IO
+!
+
+SUBROUTINE med_calc_model_time ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_configure
+  ! Model layer
+   USE module_date_time
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+
+  ! Local data
+   REAL                                       :: time 
+
+! this is now handled by with calls to time manager
+!   time = head_grid%dt * head_grid%total_time_steps
+!   CALL calc_current_date (grid%id, time)
+
+
+END SUBROUTINE med_calc_model_time
+
+SUBROUTINE med_before_solve_io ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_configure
+  ! Model layer
+   USE module_utility
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+  ! Local
+   INTEGER                                    :: rc
+
+ ! Note that when grid%return_after_training_io == .TRUE. this routine 
+ ! will return after the training phase for all auxiliary I/O streams.  
+ ! Nothing else will be done.  This ugly hack is only needed for ESMF 
+ ! coupling.  grid%return_after_training_io == .FALSE. in all other cases.  
+ IF ( .NOT. grid%return_after_training_io ) THEN
+   IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 0, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( HISTORY_ALARM ), rc=rc )
+   ENDIF
+
+   IF( WRFU_AlarmIsRinging( grid%alarms( INPUTOUT_ALARM ), rc=rc ) ) THEN
+     CALL med_filter_out  ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( INPUTOUT_ALARM ), rc=rc )
+   ENDIF
+ ENDIF
+
+! - AUX HISTORY OUTPUT 
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST1_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 1, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST1_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST2_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 2, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST2_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST3_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 3,  config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST3_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST4_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 4, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST4_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST5_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 5, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST5_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST6_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 6, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST6_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST7_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 7, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST7_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST8_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 8, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST8_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST9_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 9, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST9_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST10_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 10, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST10_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST11_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 12, config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST11_ALARM ), rc=rc )
+   ENDIF
+
+! - AUX INPUT INPUT
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT1_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput1_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT1_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT2_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput2_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT2_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT3_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput3_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT3_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT4_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput4_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT4_ALARM ), rc=rc )
+   ENDIF
+
+! this needs to be looked at again so we can get rid of the special
+! handling of AUXINPUT5 but for now...
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! add for wrf_chem emiss input
+! - Get chemistry data
+  IF( config_flags%chem_opt > 0 ) THEN
+#ifdef WRF_CHEM
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT5_ALARM ), rc=rc ) ) THEN
+    call wrf_debug(15,' CALL med_read_wrf_chem_emiss ')
+     CALL med_read_wrf_chem_emiss ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT5_ALARM ), rc=rc )
+    call wrf_debug(15,' Back from CALL med_read_wrf_chem_emiss ')
+
+   ENDIF
+! end for wrf chem emiss input
+#endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  ELSE
+#ifndef WRF_CHEM
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT5_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput5_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT5_ALARM ), rc=rc )
+   ENDIF
+#endif
+  ENDIF
+
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT6_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput6_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT6_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT7_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput7_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT7_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT8_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput8_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT8_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT9_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput9_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT9_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT10_ALARM ), rc=rc ) ) THEN
+     CALL med_auxinput10_in ( grid , config_flags )
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT10_ALARM ), rc=rc )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT11_ALARM ), rc=rc ) ) THEN
+#if ( EM_CORE == 1 )
+     IF( config_flags%obs_nudge_opt .EQ. 1) THEN
+        CALL med_fddaobs_in ( grid , config_flags )
+     ENDIF
+#else
+     CALL med_auxinput11_in ( grid , config_flags )
+#endif
+     CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT11_ALARM ), rc=rc )
+   ENDIF
+
+ IF ( .NOT. grid%return_after_training_io ) THEN
+! - RESTART OUTPUT
+   IF( WRFU_AlarmIsRinging( grid%alarms( RESTART_ALARM ), rc=rc ) ) THEN
+     IF ( grid%id .EQ. 1 ) THEN
+       ! Only the parent initiates the restart writing. Otherwise, different
+       ! domains may be written out at different times and with different 
+       ! time stamps in the file names.
+       CALL med_restart_out ( grid , config_flags )
+     ENDIF
+     CALL WRFU_AlarmRingerOff( grid%alarms( RESTART_ALARM ), rc=rc )
+   ENDIF
+
+! - Look for boundary data after writing out history and restart files
+   CALL med_latbound_in ( grid , config_flags )
+ ELSE
+   CALL wrf_debug ( 1 , 'DEBUG:  med_before_solve_io():  returned after training aux I/O' )
+ ENDIF
+
+   RETURN
+END SUBROUTINE med_before_solve_io
+
+SUBROUTINE med_after_solve_io ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_timing
+   USE module_configure
+  ! Model layer
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+
+   RETURN
+END SUBROUTINE med_after_solve_io
+
+SUBROUTINE med_pre_nest_initial ( parent , newid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_timing
+   USE module_io_domain
+   USE module_configure
+  ! Model layer
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain) , POINTER                      :: parent
+   INTEGER, INTENT(IN)                         :: newid
+   TYPE (grid_config_rec_type) , INTENT(INOUT) :: config_flags
+   TYPE (grid_config_rec_type)                 :: nest_config_flags
+
+  ! Local
+   INTEGER                :: itmp, fid, ierr, icnt
+   CHARACTER*256          :: rstname, message, timestr
+
+#ifdef MOVE_NESTS
+
+   CALL domain_clock_get( parent, current_timestr=timestr )
+   CALL construct_filename2a ( rstname , config_flags%rst_inname , newid , 2 , timestr )
+
+   IF ( config_flags%restart ) THEN
+     WRITE(message,*)'RESTART: nest, opening ',TRIM(rstname),' for reading header information only'
+     CALL wrf_message ( message )
+  ! note that the parent pointer is not strictly correct, but nest is not allocated yet and
+  ! only the i/o communicator fields are used from "parent" (and those are dummies in current
+  ! implementation.
+     CALL open_r_dataset ( fid , TRIM(rstname) , parent , config_flags , "DATASET=RESTART", ierr )
+     IF ( ierr .NE. 0 ) THEN
+       WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
+       CALL WRF_ERROR_FATAL ( message )
+     ENDIF
+
+  ! update the values of parent_start that were read in from the namelist (nest may have moved)
+     CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' ,  itmp  , 1 , icnt, ierr )
+     IF ( ierr .EQ. 0 ) THEN
+       config_flags%i_parent_start = itmp
+       CALL nl_set_i_parent_start ( newid , config_flags%i_parent_start )
+     ENDIF
+     CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' ,  itmp  , 1 , icnt, ierr )
+     IF ( ierr .EQ. 0 ) THEN
+       config_flags%j_parent_start = itmp
+       CALL nl_set_j_parent_start ( newid , config_flags%j_parent_start )
+     ENDIF
+
+     CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
+   ENDIF
+#endif
+
+END SUBROUTINE med_pre_nest_initial
+
+
+SUBROUTINE med_nest_initial ( parent , nest , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_timing
+   USE module_io_domain
+   USE module_configure
+   USE module_utility
+  ! Model layer
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain) , POINTER                     :: parent, nest
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   TYPE (grid_config_rec_type)                :: nest_config_flags
+
+#if (EM_CORE == 1)
+  ! Local
+#ifdef MOVE_NESTS
+   TYPE (WRFU_TimeInterval) :: interval, TimeSinceStart
+   INTEGER :: vortex_interval , n
+#endif
+   INTEGER                                    :: idum1 , idum2 , fid, ierr
+   INTEGER                                    :: i , j, rc
+   INTEGER                                    :: ids , ide , jds , jde , kds , kde , &
+                                                 ims , ime , jms , jme , kms , kme , &
+                                                 ips , ipe , jps , jpe , kps , kpe
+   CHARACTER * 80         :: rstname , timestr
+   CHARACTER * 256        :: message
+   INTEGER                :: save_itimestep ! This is a kludge, correct fix will 
+                                            ! involve integrating the time-step
+                                            ! counting into the time manager.
+                                            ! JM 20040604
+   REAL, ALLOCATABLE, DIMENSION(:,:) ::   save_acsnow             &
+                                         ,save_acsnom             &
+                                         ,save_cuppt              &
+                                         ,save_rainc              &
+                                         ,save_rainnc             &
+                                         ,save_sfcevp             &
+                                         ,save_sfcrunoff          &
+                                         ,save_udrunoff
+
+   INTERFACE
+     SUBROUTINE med_interp_domain ( parent , nest )
+        USE module_domain
+        TYPE(domain) , POINTER                 :: parent , nest
+     END SUBROUTINE med_interp_domain
+
+     SUBROUTINE med_initialdata_input_ptr( nest , config_flags )
+        USE module_domain
+        USE module_configure
+        TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
+        TYPE(domain) , POINTER :: nest
+     END SUBROUTINE med_initialdata_input_ptr
+
+     SUBROUTINE med_nest_feedback ( parent , nest , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain), POINTER ::  nest , parent
+       TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
+     END SUBROUTINE med_nest_feedback
+
+     SUBROUTINE start_domain ( grid , allowed_to_move )
+        USE module_domain
+        TYPE(domain) :: grid
+        LOGICAL, INTENT(IN) :: allowed_to_move
+     END SUBROUTINE start_domain
+
+     SUBROUTINE  blend_terrain ( ter_interpolated , ter_input , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           ips , ipe , jps , jpe , kps , kpe )
+       INTEGER                           :: ids , ide , jds , jde , kds , kde , &
+                                            ims , ime , jms , jme , kms , kme , &
+                                            ips , ipe , jps , jpe , kps , kpe
+       REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
+       REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
+     END SUBROUTINE blend_terrain
+
+     SUBROUTINE  store_terrain ( ter_interpolated , ter_input , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           ips , ipe , jps , jpe , kps , kpe )
+       INTEGER                           :: ids , ide , jds , jde , kds , kde , &
+                                            ims , ime , jms , jme , kms , kme , &
+                                            ips , ipe , jps , jpe , kps , kpe
+       REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
+       REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
+     END SUBROUTINE store_terrain
+
+     SUBROUTINE  input_terrain_rsmas ( grid ,                  &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           ips , ipe , jps , jpe , kps , kpe )
+       USE module_domain
+       TYPE ( domain ) :: grid
+       INTEGER                           :: ids , ide , jds , jde , kds , kde , &
+                                            ims , ime , jms , jme , kms , kme , &
+                                            ips , ipe , jps , jpe , kps , kpe
+     END SUBROUTINE input_terrain_rsmas
+
+   END INTERFACE
+
+   IF ( .not. config_flags%restart ) THEN
+     nest%first_force = .true.
+
+! initialize nest with interpolated data from the parent
+     nest%imask_nostag = 1
+     nest%imask_xstag = 1
+     nest%imask_ystag = 1
+     nest%imask_xystag = 1
+
+#ifdef MOVE_NESTS
+     parent%nest_pos = parent%ht
+     where ( parent%nest_pos .gt. 0. ) parent%nest_pos = parent%nest_pos + 500.  ! make a cliff
+#endif
+
+     CALL med_interp_domain( parent, nest )
+
+!  De-reference dimension information stored in the grid data structure.
+     CALL get_ijk_from_grid (  nest ,                   &
+                               ids, ide, jds, jde, kds, kde,    &
+                               ims, ime, jms, jme, kms, kme,    &
+                               ips, ipe, jps, jpe, kps, kpe    )
+  
+! initialize some other constants (and 1d arrays in z)
+     CALL init_domain_constants ( parent, nest )
+
+! get the nest config flags
+     CALL model_to_grid_config_rec ( nest%id , model_config_rec , nest_config_flags )
+
+     IF ( nest_config_flags%input_from_file .OR. nest_config_flags%input_from_hires ) THEN
+
+       WRITE(message,FMT='(A,I2,A)') '*** Initializing nest domain #',nest%id,&
+                                      ' from an input file. ***'
+       CALL wrf_debug ( 0 , message )
+
+! store horizontally interpolated terrain in temp location
+       CALL  store_terrain ( nest%ht_fine , nest%ht , &
+                             ids , ide , jds , jde , 1   , 1   , &
+                             ims , ime , jms , jme , 1   , 1   , &
+                             ips , ipe , jps , jpe , 1   , 1   )
+       CALL  store_terrain ( nest%em_mub_fine , nest%em_mub , &
+                             ids , ide , jds , jde , 1   , 1   , &
+                             ims , ime , jms , jme , 1   , 1   , &
+                             ips , ipe , jps , jpe , 1   , 1   )
+       CALL  store_terrain ( nest%em_phb_fine , nest%em_phb , &
+                             ids , ide , jds , jde , kds , kde , &
+                             ims , ime , jms , jme , kms , kme , &
+                             ips , ipe , jps , jpe , kps , kpe )
+
+       IF ( nest_config_flags%input_from_file ) THEN
+! read input from dataset
+          CALL med_initialdata_input_ptr( nest , nest_config_flags )
+       ELSE IF ( nest_config_flags%input_from_hires ) THEN
+! read in high res topography
+          CALL  input_terrain_rsmas ( nest,                               &
+                                      ids , ide , jds , jde , 1   , 1   , &
+                                      ims , ime , jms , jme , 1   , 1   , &
+                                      ips , ipe , jps , jpe , 1   , 1   )
+       ENDIF
+
+! blend parent and nest fields: terrain, mub, and phb.  THe mub and phb are used in start_domain.
+       CALL  blend_terrain ( nest%ht_fine , nest%ht , &
+                             ids , ide , jds , jde , 1   , 1   , &
+                             ims , ime , jms , jme , 1   , 1   , &
+                             ips , ipe , jps , jpe , 1   , 1   )
+       CALL  blend_terrain ( nest%em_mub_fine , nest%em_mub , &
+                             ids , ide , jds , jde , 1   , 1   , &
+                             ims , ime , jms , jme , 1   , 1   , &
+                             ips , ipe , jps , jpe , 1   , 1   )
+       CALL  blend_terrain ( nest%em_phb_fine , nest%em_phb , &
+                             ids , ide , jds , jde , kds , kde , &
+                             ims , ime , jms , jme , kms , kme , &
+                             ips , ipe , jps , jpe , kps , kpe )
+
+     ELSE
+       WRITE(message,FMT='(A,I2,A,I2,A)') '*** Initializing nest domain #',nest%id,&
+                                     ' by horizontally interpolating parent domain #' ,parent%id, &
+                                     '. ***'
+       CALL wrf_debug ( 0 , message )
+     END IF
+
+
+! feedback, mostly for this new terrain, but it is the safe thing to do
+     parent%ht_coarse = parent%ht
+
+     CALL med_nest_feedback ( parent , nest , config_flags )
+
+! set some other initial fields, fill out halos, base fields; re-do parent due
+! to new terrain elevation from feedback
+     nest%imask_nostag = 1
+     nest%imask_xstag = 1
+     nest%imask_ystag = 1
+     nest%imask_xystag = 1
+     CALL start_domain ( nest , .TRUE. )
+! kludge: 20040604
+     CALL get_ijk_from_grid (  parent ,                   &
+                               ids, ide, jds, jde, kds, kde,    &
+                               ims, ime, jms, jme, kms, kme,    &
+                               ips, ipe, jps, jpe, kps, kpe    )
+  
+     ALLOCATE( save_acsnow(ims:ime,jms:jme) )
+     ALLOCATE( save_acsnom(ims:ime,jms:jme) )
+     ALLOCATE( save_cuppt(ims:ime,jms:jme) )
+     ALLOCATE( save_rainc(ims:ime,jms:jme) )
+     ALLOCATE( save_rainnc(ims:ime,jms:jme) )
+     ALLOCATE( save_sfcevp(ims:ime,jms:jme) )
+     ALLOCATE( save_sfcrunoff(ims:ime,jms:jme) )
+     ALLOCATE( save_udrunoff(ims:ime,jms:jme) )
+     save_acsnow       = parent%acsnow
+     save_acsnom       = parent%acsnom
+     save_cuppt        = parent%cuppt
+     save_rainc        = parent%rainc
+     save_rainnc       = parent%rainnc
+     save_sfcevp       = parent%sfcevp
+     save_sfcrunoff    = parent%sfcrunoff
+     save_udrunoff     = parent%udrunoff
+     save_itimestep    = parent%itimestep
+     parent%imask_nostag = 1
+     parent%imask_xstag = 1
+     parent%imask_ystag = 1
+     parent%imask_xystag = 1
+
+     CALL start_domain ( parent , .TRUE. )
+
+     parent%acsnow     = save_acsnow
+     parent%acsnom     = save_acsnom
+     parent%cuppt      = save_cuppt
+     parent%rainc      = save_rainc
+     parent%rainnc     = save_rainnc
+     parent%sfcevp     = save_sfcevp
+     parent%sfcrunoff  = save_sfcrunoff
+     parent%udrunoff   = save_udrunoff
+     parent%itimestep  = save_itimestep
+     DEALLOCATE( save_acsnow )
+     DEALLOCATE( save_acsnom )
+     DEALLOCATE( save_cuppt )
+     DEALLOCATE( save_rainc )
+     DEALLOCATE( save_rainnc )
+     DEALLOCATE( save_sfcevp )
+     DEALLOCATE( save_sfcrunoff )
+     DEALLOCATE( save_udrunoff )
+! end of kludge: 20040604
+
+
+  ELSE  ! restart
+
+     CALL domain_clock_get( nest, current_timestr=timestr )
+     CALL construct_filename2a ( rstname , config_flags%rst_inname , nest%id , 2 , timestr )
+
+     WRITE(message,*)'RESTART: nest, opening ',TRIM(rstname),' for reading'
+     CALL wrf_message ( message )
+     CALL model_to_grid_config_rec ( nest%id , model_config_rec , nest_config_flags )
+     CALL open_r_dataset ( fid , TRIM(rstname) , nest , nest_config_flags , "DATASET=RESTART", ierr )
+     IF ( ierr .NE. 0 ) THEN
+       WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
+       CALL WRF_ERROR_FATAL ( message )
+     ENDIF
+     CALL input_restart ( fid,   nest , nest_config_flags , ierr )
+     CALL close_dataset ( fid , nest_config_flags , "DATASET=RESTART" )
+
+     nest%imask_nostag = 1
+     nest%imask_xstag = 1
+     nest%imask_ystag = 1
+     nest%imask_xystag = 1
+     CALL start_domain ( nest , .TRUE. )
+#ifndef MOVE_NESTS
+! this doesn't need to be done for moving nests, since ht_coarse is part of the restart
+     parent%ht_coarse = parent%ht
+#else
+#  if 1
+! In case of a restart, assume that the movement has already occurred in the previous
+! run and turn off the alarm for the starting time. We must impose a requirement that the
+! run be restarted on-interval.  Test for that and print a warning if it isn't.
+! Note, simulation_start, etc. should be available as metadata in the restart file, and
+! these will have gotten, set, and retrievable as rconfig data been set in share/input_wrf.F
+! using the nl_get routines below.  JM 20060314
+
+     CALL nl_get_vortex_interval ( nest%id , vortex_interval )
+     CALL WRFU_TimeIntervalSet( interval, M=vortex_interval, rc=rc )
+
+     CALL domain_clock_get( nest, timeSinceSimulationStart=TimeSinceStart )
+     n = WRFU_TimeIntervalDIVQuot( TimeSinceStart , interval )
+     IF ( ( interval * n ) .NE. TimeSinceStart ) THEN
+       CALL wrf_message('WARNING: Restart is not on a vortex_interval time boundary.')
+       CALL wrf_message('The code will work but results will not agree exactly with a ')
+       CALL wrf_message('a run that was done straight-through, without a restart.') 
+     ENDIF
+!! In case of a restart, assume that the movement has already occurred in the previous
+!! run and turn off the alarm for the starting time. We must impose a requirement that the
+!! run be restarted on-interval.  Test for that and print a warning if it isn't.
+!! Note, simulation_start, etc. should be available as metadata in the restart file, and
+!! these will have gotten, set, and retrievable as rconfig data been set in share/input_wrf.F
+!! using the nl_get routines below.  JM 20060314
+!     CALL WRFU_AlarmRingerOff( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
+
+#  else
+! this code, currently commented out, is an attempt to have the
+! vortex centering interval be set according to simulation start
+! time (rather than run start time) in case of a restart. But
+! there are other problems (the WRF clock is currently using
+! run-start as it's start time) so the alarm still would not fire
+! right if the model were started off-interval.  Leave it here and
+! enable when the clock is changed to use sim-start for start time.
+! JM 20060314
+     CALL nl_get_vortex_interval ( nest%id , vortex_interval )
+     CALL WRFU_TimeIntervalSet( interval, M=vortex_interval, rc=rc )
+
+     CALL domain_clock_get( nest, timeSinceSimulationStart=TimeSinceStart )
+
+     CALL domain_alarm_create( nest,  COMPUTE_VORTEX_CENTER_ALARM, interval  )
+     CALL WRFU_AlarmEnable( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
+     n = WRFU_TimeIntervalDIVQuot( TimeSinceStart , interval )
+     IF ( ( interval * n ) .EQ. TimeSinceStart ) THEN
+       CALL WRFU_AlarmRingerOn( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
+     ELSE 
+       CALL WRFU_AlarmRingerOff( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
+     ENDIF
+#  endif
+#endif
+
+  ENDIF
+
+#endif
+
+#if (NMM_CORE == 1 && NMM_NEST == 1)
+!===================================================================================
+!  Added for the NMM core. This is gopal's doing.
+!===================================================================================
+  ! Local
+   INTEGER                  :: i,j,k,idum1 , idum2 , fid, ierr
+   INTEGER                  :: IDS,IDE,JDS,JDE,KDS,KDE   ! gopal
+   INTEGER                  :: IMS,IME,JMS,JME,KMS,KME
+   INTEGER                  :: ITS,ITE,JTS,JTE,KTS,KTE
+
+   INTERFACE
+
+     SUBROUTINE med_nest_egrid_configure ( parent , nest )
+        USE module_domain
+        TYPE(domain) , POINTER                 :: parent , nest
+     END SUBROUTINE med_nest_egrid_configure 
+
+     SUBROUTINE med_construct_egrid_weights ( parent , nest )
+        USE module_domain
+        TYPE(domain) , POINTER                 :: parent , nest
+     END SUBROUTINE med_construct_egrid_weights
+
+     SUBROUTINE BASE_STATE_PARENT ( Z3d,Q3d,T3d,PSTD,        &
+                                    PINT,T,Q,CWM,            &
+                                    FIS,QSH,PD,PDTOP,PTOP,   &
+                                    ETA1,ETA2,               &
+                                    DETA1,DETA2,             &
+                                    IDS,IDE,JDS,JDE,KDS,KDE, &
+                                    IMS,IME,JMS,JME,KMS,KME, &
+                                    ITS,ITE,JTS,JTE,KTS,KTE  )
+!
+
+         USE MODULE_MODEL_CONSTANTS
+         IMPLICIT NONE
+         INTEGER,    INTENT(IN   )                            :: IDS,IDE,JDS,JDE,KDS,KDE
+         INTEGER,    INTENT(IN   )                            :: IMS,IME,JMS,JME,KMS,KME
+         INTEGER,    INTENT(IN   )                            :: ITS,ITE,JTS,JTE,KTS,KTE
+         REAL,       INTENT(IN   )                            :: PDTOP,PTOP
+         REAL, DIMENSION(KMS:KME),                 INTENT(IN) :: ETA1,ETA2,DETA1,DETA2
+         REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(IN) :: FIS,PD,QSH
+         REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(IN) :: PINT,T,Q,CWM
+         REAL, DIMENSION(KMS:KME)                , INTENT(OUT):: PSTD
+         REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(OUT):: Z3d,Q3d,T3d
+
+     END SUBROUTINE BASE_STATE_PARENT
+
+     SUBROUTINE NEST_TERRAIN ( nest )
+       USE module_domain
+       TYPE(domain) , POINTER                        :: nest
+     END SUBROUTINE NEST_TERRAIN
+
+    SUBROUTINE med_interp_domain ( parent , nest )
+        USE module_domain
+        TYPE(domain) , POINTER                 :: parent , nest
+    END SUBROUTINE med_interp_domain
+
+    SUBROUTINE med_init_domain_constants_nmm ( parent, nest )
+        USE module_domain
+        TYPE(domain) , POINTER                    :: parent , nest
+    END SUBROUTINE med_init_domain_constants_nmm
+
+    SUBROUTINE start_domain ( grid , allowed_to_move )
+        USE module_domain
+        TYPE(domain) :: grid
+        LOGICAL, INTENT(IN) :: allowed_to_move
+    END SUBROUTINE start_domain
+
+   END INTERFACE
+
+!----------------------------------------------------------------------------
+!  initialize nested domain configurations including setting up wbd,sbd, etc 
+!----------------------------------------------------------------------------
+
+   CALL med_nest_egrid_configure ( parent , nest )
+
+!-------------------------------------------------------------------------
+!  initialize lat-lons and determine weights 
+!-------------------------------------------------------------------------
+
+    CALL med_construct_egrid_weights ( parent, nest )
+!
+!
+!  De-reference dimension information stored in the grid data structure.
+!
+!  From the hybrid, construct the GPMs on isobaric surfaces and then interpolate those
+!  values on to the nested domain. 23 standard prssure levels are assumed here. For
+!  levels below ground, lapse rate atmosphere is assumed before the use of vertical
+!  spline interpolation 
+!
+
+
+    IDS = parent%sd31
+    IDE = parent%ed31
+    KDS = parent%sd32
+    KDE = parent%ed32
+    JDS = parent%sd33
+    JDE = parent%ed33
+
+    IMS = parent%sm31
+    IME = parent%em31
+    KMS = parent%sm32
+    KME = parent%em32
+    JMS = parent%sm33
+    JME = parent%em33
+
+    ITS = parent%sp31
+    ITE = parent%ep31
+    KTS = parent%sp32
+    KTE = parent%ep32
+    JTS = parent%sp33
+    JTE = parent%ep33
+
+    CALL BASE_STATE_PARENT ( parent%nmm_Z3d,parent%nmm_Q3d,parent%nmm_T3d,parent%nmm_PSTD,  &
+                             parent%nmm_PINT,parent%nmm_T,parent%nmm_Q,parent%nmm_CWM,      &
+                             parent%nmm_FIS,parent%nmm_QSH,parent%nmm_PD,parent%nmm_pdtop,parent%nmm_pt,   &
+                             parent%nmm_ETA1,parent%nmm_ETA2,                               &
+                             parent%nmm_DETA1,parent%nmm_DETA2,                             &
+                             IDS,IDE,JDS,JDE,KDS,KDE,                                       &
+                             IMS,IME,JMS,JME,KMS,KME,                                       &
+                             ITS,ITE,JTS,JTE,KTS,KTE                                        )
+
+!  
+!   Set new terrain. Since some terrain adjustment is done within the interpolation calls
+!   at the next step, the new terrain over the nested domain has to be called here.
+!
+    IDS = nest%sd31
+    IDE = nest%ed31
+    KDS = nest%sd32
+    KDE = nest%ed32
+    JDS = nest%sd33
+    JDE = nest%ed33
+
+    IMS = nest%sm31
+    IME = nest%em31
+    KMS = nest%sm32
+    KME = nest%em32
+    JMS = nest%sm33
+    JME = nest%em33
+
+    ITS = nest%sp31
+    ITE = nest%ep31
+    KTS = nest%sp32
+    KTE = nest%ep32
+    JTS = nest%sp33
+    JTE = nest%ep33
+
+
+    CALL NEST_TERRAIN ( nest )
+
+!   Initialize some more constants required especially for terrain adjustment processes
+
+    nest%nmm_PSTD=parent%nmm_PSTD
+    nest%nmm_KZMAX=KME
+    parent%nmm_KZMAX=KME  ! just for safety
+
+    DO J = JTS, MIN(JTE,JDE-1)
+      DO I = ITS, MIN(ITE,IDE-1)
+       nest%nmm_fis(I,J)=nest%nmm_hres_fis(I,J)
+     ENDDO
+    ENDDO
+
+!--------------------------------------------------------------------------
+!  interpolation call
+!--------------------------------------------------------------------------
+
+! initialize nest with interpolated data from the parent
+
+    nest%imask_nostag = 0 
+    nest%imask_xstag  = 0 
+    nest%imask_ystag  = 0 
+    nest%imask_xystag = 0 
+
+   CALL med_interp_domain( parent, nest )
+
+!------------------------------------------------------------------------------
+!  set up constants (module_initialize_real.F for nested nmm domain)
+!-----------------------------------------------------------------------------
+
+    CALL med_init_domain_constants_nmm ( parent, nest )    
+
+!--------------------------------------------------------------------------------------
+! set some other initial fields, fill out halos, etc. 
+!--------------------------------------------------------------------------------------
+
+    CALL start_domain ( nest, .TRUE.)
+
+!===================================================================================
+!  Added for the NMM core. End of gopal's doing.
+!===================================================================================
+#endif
+  RETURN
+END SUBROUTINE med_nest_initial
+
+SUBROUTINE init_domain_constants ( parent , nest )
+   USE module_domain
+   IMPLICIT NONE
+   TYPE(domain) :: parent , nest
+#if (EM_CORE == 1)
+   CALL init_domain_constants_em ( parent, nest )
+#endif
+END SUBROUTINE init_domain_constants
+
+
+SUBROUTINE med_nest_force ( parent , nest )
+  ! Driver layer
+   USE module_domain
+   USE module_timing
+   USE module_configure
+  ! Model layer
+  ! External
+   USE module_utility
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain) , POINTER                     :: parent, nest
+  ! Local
+   INTEGER                                    :: idum1 , idum2 , fid, rc
+
+#if (NMM_CORE == 1 && NMM_NEST == 1)
+   INTEGER                  :: IDS,IDE,JDS,JDE,KDS,KDE     ! gopal
+   INTEGER                  :: IMS,IME,JMS,JME,KMS,KME
+   INTEGER                  :: ITS,ITE,JTS,JTE,KTS,KTE
+#endif
+
+   INTERFACE
+     SUBROUTINE med_force_domain ( parent , nest )
+        USE module_domain
+        TYPE(domain) , POINTER                 :: parent , nest
+     END SUBROUTINE med_force_domain
+     SUBROUTINE med_interp_domain ( parent , nest )
+        USE module_domain
+        TYPE(domain) , POINTER                 :: parent , nest
+     END SUBROUTINE med_interp_domain
+#if (NMM_CORE == 1 && NMM_NEST == 1)
+!===================================================================================
+!  Added for the NMM core. This is gopal's doing.
+!===================================================================================
+
+     SUBROUTINE BASE_STATE_PARENT ( Z3d,Q3d,T3d,PSTD,        &
+                                    PINT,T,Q,CWM,            &
+                                    FIS,QSH,PD,PDTOP,PTOP,   &
+                                    ETA1,ETA2,               &
+                                    DETA1,DETA2,             &
+                                    IDS,IDE,JDS,JDE,KDS,KDE, &
+                                    IMS,IME,JMS,JME,KMS,KME, &
+                                    ITS,ITE,JTS,JTE,KTS,KTE  )
+!
+
+         USE MODULE_MODEL_CONSTANTS
+         IMPLICIT NONE
+         INTEGER,    INTENT(IN   )                            :: IDS,IDE,JDS,JDE,KDS,KDE
+         INTEGER,    INTENT(IN   )                            :: IMS,IME,JMS,JME,KMS,KME
+         INTEGER,    INTENT(IN   )                            :: ITS,ITE,JTS,JTE,KTS,KTE
+         REAL,       INTENT(IN   )                            :: PDTOP,PTOP
+         REAL, DIMENSION(KMS:KME),                 INTENT(IN) :: ETA1,ETA2,DETA1,DETA2
+         REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(IN) :: FIS,PD,QSH
+         REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(IN) :: PINT,T,Q,CWM
+         REAL, DIMENSION(KMS:KME)                , INTENT(OUT):: PSTD
+         REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(OUT):: Z3d,Q3d,T3d
+
+     END SUBROUTINE BASE_STATE_PARENT
+
+#endif
+   END INTERFACE
+
+#if (NMM_CORE == 1 && NMM_NEST == 1)
+
+!  De-reference dimension information stored in the grid data structure.
+
+    IDS = parent%sd31
+    IDE = parent%ed31
+    KDS = parent%sd32
+    KDE = parent%ed32
+    JDS = parent%sd33
+    JDE = parent%ed33
+
+    IMS = parent%sm31
+    IME = parent%em31
+    KMS = parent%sm32
+    KME = parent%em32
+    JMS = parent%sm33
+    JME = parent%em33
+
+    ITS = parent%sp31
+    ITE = parent%ep31
+    KTS = parent%sp32
+    KTE = parent%ep32
+    JTS = parent%sp33
+    JTE = parent%ep33
+
+
+    CALL BASE_STATE_PARENT ( parent%nmm_Z3d,parent%nmm_Q3d,parent%nmm_T3d,parent%nmm_PSTD, &
+                             parent%nmm_PINT,parent%nmm_T,parent%nmm_Q,parent%nmm_CWM,     &
+                             parent%nmm_FIS,parent%nmm_QSH,parent%nmm_PD,parent%nmm_pdtop,parent%nmm_pt,  &
+                             parent%nmm_ETA1,parent%nmm_ETA2,                              &
+                             parent%nmm_DETA1,parent%nmm_DETA2,                            &
+                             IDS,IDE,JDS,JDE,KDS,KDE,                                      &
+                             IMS,IME,JMS,JME,KMS,KME,                                      &
+                             ITS,ITE,JTS,JTE,KTS,KTE                                       )
+
+#endif
+
+   IF ( .NOT. WRFU_ClockIsStopTime(nest%domain_clock ,rc=rc) ) THEN
+! initialize nest with interpolated data from the parent
+     nest%imask_nostag = 1
+     nest%imask_xstag = 1
+     nest%imask_ystag = 1
+     nest%imask_xystag = 1
+     CALL med_force_domain( parent, nest )
+   ENDIF
+
+! might also have calls here to do input from a file into the nest
+
+   RETURN
+END SUBROUTINE med_nest_force
+
+SUBROUTINE med_nest_feedback ( parent , nest , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_timing
+   USE module_configure
+  ! Model layer
+  ! External
+   USE module_utility
+   IMPLICIT NONE
+
+
+  ! Arguments
+   TYPE(domain) , POINTER                     :: parent, nest
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+  ! Local
+   INTEGER                                    :: idum1 , idum2 , fid, rc
+   INTEGER                         :: ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      ips , ipe , jps , jpe , kps , kpe
+   INTEGER i,j
+
+   INTERFACE
+     SUBROUTINE med_feedback_domain ( parent , nest )
+        USE module_domain
+        TYPE(domain) , POINTER                 :: parent , nest
+     END SUBROUTINE med_feedback_domain
+   END INTERFACE
+
+! feedback nest to the parent
+    IF ( .NOT. WRFU_ClockIsStopTime(nest%domain_clock ,rc=rc) .AND. &
+         config_flags%feedback .NE. 0 ) THEN
+      CALL med_feedback_domain( parent, nest )
+#ifdef MOVE_NESTS
+      CALL get_ijk_from_grid (  parent ,                         &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+! gopal's change- added ifdef
+#if ( EM_CORE == 1 )
+      DO j = jps, MIN(jpe,jde-1)
+      DO i = ips, MIN(ipe,ide-1)
+        IF      ( parent%nest_pos(i,j) .EQ. 9021000. ) THEN
+          parent%nest_pos(i,j) = parent%ht(i,j)*1.5 + 1000.
+        ELSE IF ( parent%ht(i,j) .NE. 0. ) THEN
+          parent%nest_pos(i,j) = parent%ht(i,j) + 500.
+        ELSE 
+          parent%nest_pos(i,j) = 0.
+        ENDIF
+      ENDDO
+      ENDDO
+#endif
+#endif
+    END IF
+
+   RETURN
+END SUBROUTINE med_nest_feedback
+
+SUBROUTINE med_last_solve_io ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_configure
+  ! Model layer
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+  ! Local
+   INTEGER                                    :: rc
+
+   IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 0 , config_flags )
+   ENDIF
+
+   IF( WRFU_AlarmIsRinging( grid%alarms( INPUTOUT_ALARM ), rc=rc ) ) THEN
+     CALL med_filter_out  ( grid , config_flags )
+   ENDIF
+
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST1_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 1 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST2_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 2 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST3_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 3 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST4_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 4 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST5_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 5 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST6_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 6 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST7_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 7 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST8_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 8 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST9_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 9 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST10_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 10 , config_flags )
+   ENDIF
+   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST11_ALARM ), rc=rc ) ) THEN
+     CALL med_hist_out ( grid , 11 , config_flags )
+   ENDIF
+
+! - RESTART OUTPUT
+   IF( WRFU_AlarmIsRinging( grid%alarms( RESTART_ALARM ), rc=rc ) ) THEN
+     IF ( grid%id .EQ. 1 ) THEN
+       CALL med_restart_out ( grid , config_flags )
+     ENDIF
+   ENDIF
+
+   RETURN
+END SUBROUTINE med_last_solve_io
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+RECURSIVE SUBROUTINE med_restart_out ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+   USE module_timing
+   USE module_configure
+  ! Model layer
+   USE module_bc_time_utilities
+   USE module_utility
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+
+  ! Local
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+   CHARACTER*80                           :: rstname , outname
+   INTEGER                                :: fid , rid, kid
+   CHARACTER (LEN=256)                    :: message
+   INTEGER                                :: ierr
+   INTEGER                                :: myproc
+   CHARACTER*80                           :: timestr
+   TYPE (grid_config_rec_type)            :: kid_config_flags
+
+   IF ( wrf_dm_on_monitor() ) THEN
+     CALL start_timing
+   END IF
+
+   ! write out this domains restart file first
+
+   CALL domain_clock_get( grid, current_timestr=timestr )
+   CALL construct_filename2a ( rstname , config_flags%rst_outname , grid%id , 2 , timestr )
+
+   WRITE( message , '("med_restart_out: opening ",A," for writing")' ) TRIM ( rstname )
+   CALL wrf_debug( 1 , message )
+   CALL open_w_dataset ( rid, TRIM(rstname), grid , &
+                         config_flags , output_restart , "DATASET=RESTART", ierr )
+
+   IF ( ierr .NE. 0 ) THEN
+     CALL WRF_message( message )
+   ENDIF
+   CALL output_restart ( rid, grid , config_flags , ierr )
+   IF ( wrf_dm_on_monitor() ) THEN
+     WRITE ( message , FMT = '("Writing restart for domain ",I8)' ) grid%id
+     CALL end_timing ( TRIM(message) )
+   END IF
+   CALL close_dataset ( rid , config_flags , "DATASET=RESTART" )
+
+   ! call recursively for children, (if any)
+   DO kid = 1, max_nests
+      IF ( ASSOCIATED( grid%nests(kid)%ptr ) ) THEN
+        CALL model_to_grid_config_rec ( grid%nests(kid)%ptr%id , model_config_rec , kid_config_flags )
+        CALL med_restart_out ( grid%nests(kid)%ptr , kid_config_flags ) 
+      ENDIF
+   ENDDO
+
+   RETURN
+END SUBROUTINE med_restart_out
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE med_hist_out ( grid , stream, config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_timing
+   USE module_io_domain
+   USE module_configure
+   USE module_bc_time_utilities
+   USE module_utility
+
+   IMPLICIT NONE
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   INTEGER , INTENT(IN)                       :: stream
+  ! Local
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+   CHARACTER*80                           :: fname, n1, n2
+   INTEGER                                :: fid , rid
+   CHARACTER (LEN=256)                    :: message
+   INTEGER                                :: ierr
+   INTEGER                                :: myproc
+   CHARACTER*80                           :: timestr
+   TYPE(WRFU_Time)                        :: ST,CT
+   INTEGER                                :: n
+   LOGICAL                                :: adjust
+
+   IF ( wrf_dm_on_monitor() ) THEN
+     CALL start_timing
+   END IF
+
+   IF ( stream .LT. 0 .OR. stream .GT. 11 ) THEN
+     WRITE(message,*)'med_hist_out: invalid history stream ',stream
+     CALL wrf_error_fatal( message )
+   ENDIF
+   CALL nl_get_adjust_output_times( grid%id, adjust )
+   CALL domain_clock_get( grid, current_time=CT, start_time=ST, current_timestr=timestr )
+
+   SELECT CASE( stream )
+     CASE ( 0 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( HISTORY_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%history_outname , grid%id , 2 , timestr )
+     CASE ( 1 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST1_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist1_outname , grid%id , 2 , timestr )
+     CASE ( 2 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST2_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist2_outname , grid%id , 2 , timestr )
+     CASE ( 3 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST3_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist3_outname , grid%id , 2 , timestr )
+     CASE ( 4 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST4_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist4_outname , grid%id , 2 , timestr )
+     CASE ( 5 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST5_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist5_outname , grid%id , 2 , timestr )
+     CASE ( 6 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST6_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist6_outname , grid%id , 2 , timestr )
+     CASE ( 7 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST7_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist7_outname , grid%id , 2 , timestr )
+     CASE ( 8 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST8_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist8_outname , grid%id , 2 , timestr )
+     CASE ( 9 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST9_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist9_outname , grid%id , 2 , timestr )
+     CASE ( 10 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST10_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist10_outname , grid%id , 2 , timestr )
+     CASE ( 11 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST11_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( fname , config_flags%auxhist11_outname , grid%id , 2 , timestr )
+   END SELECT
+
+   IF (      ( stream .eq. 0 .and. grid%oid          .eq. 0 )    &
+        .or. ( stream .eq. 1 .and. grid%auxhist1_oid .eq. 0 )    &
+        .or. ( stream .eq. 2 .and. grid%auxhist2_oid .eq. 0 )    &
+        .or. ( stream .eq. 3 .and. grid%auxhist3_oid .eq. 0 )    &
+        .or. ( stream .eq. 4 .and. grid%auxhist4_oid .eq. 0 )    &
+        .or. ( stream .eq. 5 .and. grid%auxhist5_oid .eq. 0 )    &
+        .or. ( stream .eq. 6 .and. grid%auxhist6_oid .eq. 0 )    &
+        .or. ( stream .eq. 7 .and. grid%auxhist7_oid .eq. 0 )    &
+        .or. ( stream .eq. 8 .and. grid%auxhist8_oid .eq. 0 )    &
+        .or. ( stream .eq. 9 .and. grid%auxhist9_oid .eq. 0 )    &
+        .or. ( stream .eq. 10 .and. grid%auxhist10_oid .eq. 0 )    &
+        .or. ( stream .eq. 11 .and. grid%auxhist11_oid .eq. 0 )    &
+      ) THEN
+
+     IF ( stream .EQ. 10 ) THEN
+       WRITE(n2,'("DATASET=AUXHIST10")')
+     ELSE IF ( stream .EQ. 11 ) THEN
+       WRITE(n2,'("DATASET=AUXHIST11")')
+     ELSE
+       WRITE(n2,'("DATASET=AUXHIST",I1)')stream  ! may be overwritten, below, if stream is 0
+     ENDIF
+     WRITE ( message , '("med_hist_out : opening ",A," for writing. ")') TRIM ( fname )
+     CALL wrf_debug( 1, message )
+     SELECT CASE( stream )
+       CASE ( 0 )
+         CALL open_w_dataset ( grid%oid, TRIM(fname), grid ,  &
+                               config_flags , output_history , 'DATASET=HISTORY' , ierr )
+       CASE ( 1 )
+         CALL open_w_dataset ( grid%auxhist1_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist1 , n2, ierr )
+       CASE ( 2 )
+         CALL open_w_dataset ( grid%auxhist2_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist2 , n2, ierr )
+       CASE ( 3 )
+         CALL open_w_dataset ( grid%auxhist3_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist3 , n2, ierr )
+       CASE ( 4 )
+         CALL open_w_dataset ( grid%auxhist4_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist4 , n2, ierr )
+       CASE ( 5 )
+         CALL open_w_dataset ( grid%auxhist5_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist5 , n2, ierr )
+       CASE ( 6 )
+         CALL open_w_dataset ( grid%auxhist6_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist6 , n2, ierr )
+       CASE ( 7 )
+         CALL open_w_dataset ( grid%auxhist7_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist7 , n2, ierr )
+       CASE ( 8 )
+         CALL open_w_dataset ( grid%auxhist8_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist8 , n2, ierr )
+       CASE ( 9 )
+         CALL open_w_dataset ( grid%auxhist9_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist9 , n2, ierr )
+       CASE ( 10 )
+         CALL open_w_dataset ( grid%auxhist10_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist10 , n2, ierr )
+       CASE ( 11 )
+         CALL open_w_dataset ( grid%auxhist11_oid, TRIM(fname), grid ,  &
+                               config_flags , output_aux_hist11 , n2, ierr )
+     END SELECT
+     IF ( ierr .NE. 0 ) THEN
+       WRITE ( message , '("med_hist_out : error opening ",A," for writing. ",I3)') TRIM ( fname ), ierr
+       CALL wrf_message( message )
+     ENDIF
+   END IF
+
+   ! early return after training
+   IF ( .NOT. grid%return_after_training_io ) THEN
+     SELECT CASE( stream )
+       CASE ( 0 )
+         CALL output_history ( grid%oid, grid , config_flags , ierr )
+       CASE ( 1 )
+         CALL output_aux_hist1 ( grid%auxhist1_oid, grid , config_flags , ierr )
+       CASE ( 2 )
+         CALL output_aux_hist2 ( grid%auxhist2_oid, grid , config_flags , ierr )
+       CASE ( 3 )
+         CALL output_aux_hist3 ( grid%auxhist3_oid, grid , config_flags , ierr )
+       CASE ( 4 )
+         CALL output_aux_hist4 ( grid%auxhist4_oid, grid , config_flags , ierr )
+       CASE ( 5 )
+         CALL output_aux_hist5 ( grid%auxhist5_oid, grid , config_flags , ierr )
+       CASE ( 6 )
+         CALL output_aux_hist6 ( grid%auxhist6_oid, grid , config_flags , ierr )
+       CASE ( 7 )
+         CALL output_aux_hist7 ( grid%auxhist7_oid, grid , config_flags , ierr )
+       CASE ( 8 )
+         CALL output_aux_hist8 ( grid%auxhist8_oid, grid , config_flags , ierr )
+       CASE ( 9 )
+         CALL output_aux_hist9 ( grid%auxhist9_oid, grid , config_flags , ierr )
+       CASE ( 10 )
+         CALL output_aux_hist10 ( grid%auxhist10_oid, grid , config_flags , ierr )
+       CASE ( 11 )
+         CALL output_aux_hist11 ( grid%auxhist11_oid, grid , config_flags , ierr )
+     END SELECT
+
+     grid%nframes(stream) = grid%nframes(stream) + 1
+
+     SELECT CASE( stream )
+       CASE ( 0 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_outfile ) THEN
+           CALL close_dataset ( grid%oid , config_flags , "DATASET=HISTORY" ) 
+           grid%oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 1 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist1 ) THEN
+           CALL close_dataset ( grid%auxhist1_oid , config_flags , n2 ) 
+           grid%auxhist1_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 2 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist2 ) THEN
+           CALL close_dataset ( grid%auxhist2_oid , config_flags , n2 ) 
+           grid%auxhist2_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 3 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist3 ) THEN
+           CALL close_dataset ( grid%auxhist3_oid , config_flags , n2 ) 
+           grid%auxhist3_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 4 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist4 ) THEN
+           CALL close_dataset ( grid%auxhist4_oid , config_flags , n2 ) 
+           grid%auxhist4_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 5 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist5 ) THEN
+           CALL close_dataset ( grid%auxhist5_oid , config_flags , n2 ) 
+           grid%auxhist5_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 6 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist6 ) THEN
+           CALL close_dataset ( grid%auxhist6_oid , config_flags , n2 ) 
+           grid%auxhist6_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 7 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist7 ) THEN
+           CALL close_dataset ( grid%auxhist7_oid , config_flags , n2 ) 
+           grid%auxhist7_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 8 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist8 ) THEN
+           CALL close_dataset ( grid%auxhist8_oid , config_flags , n2 ) 
+           grid%auxhist8_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 9 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist9 ) THEN
+           CALL close_dataset ( grid%auxhist9_oid , config_flags , n2 ) 
+           grid%auxhist9_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 10 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist10 ) THEN
+           CALL close_dataset ( grid%auxhist10_oid , config_flags , n2 ) 
+           grid%auxhist10_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+       CASE ( 11 )
+         IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist11 ) THEN
+           CALL close_dataset ( grid%auxhist11_oid , config_flags , n2 ) 
+           grid%auxhist11_oid = 0
+           grid%nframes(stream) = 0
+         ENDIF
+     END SELECT
+     IF ( wrf_dm_on_monitor() ) THEN
+       WRITE ( message , FMT = '("Writing ",A30," for domain ",I8)' )TRIM(fname),grid%id
+       CALL end_timing ( TRIM(message) )
+     END IF
+   ELSE
+     CALL wrf_debug( 1, 'DEBUG:  med_hist_out() returned after training' )
+   ENDIF
+
+   RETURN
+END SUBROUTINE med_hist_out
+
+SUBROUTINE med_auxinput1_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 1 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput1_in
+
+SUBROUTINE med_auxinput2_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 2 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput2_in
+
+SUBROUTINE med_auxinput3_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 3 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput3_in
+
+SUBROUTINE med_auxinput4_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 4 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput4_in
+
+SUBROUTINE med_auxinput5_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 5 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput5_in
+
+SUBROUTINE med_auxinput6_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 6 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput6_in
+
+SUBROUTINE med_auxinput7_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 7 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput7_in
+
+SUBROUTINE med_auxinput8_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 8 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput8_in
+
+SUBROUTINE med_auxinput9_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 9 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput9_in
+
+SUBROUTINE med_auxinput10_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 10 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput10_in
+
+SUBROUTINE med_auxinput11_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL med_auxinput_in( grid , 11 , config_flags )
+   RETURN
+END SUBROUTINE med_auxinput11_in
+
+SUBROUTINE med_fddaobs_in ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   CALL wrf_fddaobs_in( grid, config_flags )
+   RETURN
+END SUBROUTINE med_fddaobs_in
+
+SUBROUTINE med_auxinput_in ( grid , stream, config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+  ! Model layer
+   USE module_configure
+   USE module_bc_time_utilities
+   USE module_utility
+
+   IMPLICIT NONE
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   INTEGER , INTENT(IN)                       :: stream
+  ! Local
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+   CHARACTER*80                           :: rstname , outname, auxname, n1, n2
+   INTEGER                                :: fid , rid
+   CHARACTER (LEN=256)                    :: message
+   INTEGER                                :: ierr
+   INTEGER                                :: myproc
+   CHARACTER*80                           :: timestr
+   TYPE(WRFU_Time)                        :: ST,CT
+   INTEGER                                :: n
+   LOGICAL                                :: adjust
+
+   CALL nl_get_adjust_input_times( grid%id, adjust )
+
+   IF ( stream .LT. 1 .OR. stream .GT. 11 ) THEN
+     WRITE(message,*)'med_auxinput_in: invalid input stream ',stream
+     CALL wrf_error_fatal( message )
+   ENDIF
+   CALL domain_clock_get( grid, current_time=CT, start_time=ST, current_timestr=timestr )
+   SELECT CASE( stream )
+     CASE ( 1 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT1_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput1_inname, grid%id , 2 , timestr )
+     CASE ( 2 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT2_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput2_inname , grid%id , 2 , timestr )
+     CASE ( 3 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT3_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput3_inname , grid%id , 2 , timestr )
+     CASE ( 4 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT4_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput4_inname , grid%id , 2 , timestr )
+     CASE ( 5 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT5_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput5_inname , grid%id , 2 , timestr )
+     CASE ( 6 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT6_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput6_inname , grid%id , 2 , timestr )
+     CASE ( 7 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT7_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput7_inname , grid%id , 2 , timestr )
+     CASE ( 8 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT8_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput8_inname , grid%id , 2 , timestr )
+     CASE ( 9 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT9_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput9_inname , grid%id , 2 , timestr )
+     CASE ( 10 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT10_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%gfdda_inname , grid%id , 2 , timestr )
+     CASE ( 11 )
+       IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXINPUT11_ALARM ), CT, ST, timestr )
+       CALL construct_filename2a ( auxname , config_flags%auxinput11_inname , grid%id , 2 , timestr )
+   END SELECT
+   IF (      ( stream .eq. 1 .and. grid%auxinput1_oid .eq. 0 )    &
+        .or. ( stream .eq. 2 .and. grid%auxinput2_oid .eq. 0 )    &
+        .or. ( stream .eq. 3 .and. grid%auxinput3_oid .eq. 0 )    &
+        .or. ( stream .eq. 4 .and. grid%auxinput4_oid .eq. 0 )    &
+        .or. ( stream .eq. 5 .and. grid%auxinput5_oid .eq. 0 )    &
+        .or. ( stream .eq. 6 .and. grid%auxinput6_oid .eq. 0 )    &
+        .or. ( stream .eq. 7 .and. grid%auxinput7_oid .eq. 0 )    &
+        .or. ( stream .eq. 8 .and. grid%auxinput8_oid .eq. 0 )    &
+        .or. ( stream .eq. 9 .and. grid%auxinput9_oid .eq. 0 )    &
+        .or. ( stream .eq. 10 .and. grid%auxinput10_oid .eq. 0 )    &
+        .or. ( stream .eq. 11 .and. grid%auxinput11_oid .eq. 0 )    &
+      ) THEN
+
+       IF      ( stream .EQ. 10 ) THEN
+         WRITE(n2,'("DATASET=AUXINPUT10")')
+       ELSE IF ( stream .EQ. 11 ) THEN
+         WRITE(n2,'("DATASET=AUXINPUT11")')
+       ELSE
+         WRITE(n2,'("DATASET=AUXINPUT",I1)')stream
+       ENDIF
+       WRITE ( message , '("med_auxinput_in : opening ",A," for reading. ",I3)') TRIM ( auxname ), ierr
+       CALL wrf_debug( 1, message )
+
+!<DESCRIPTION>
+!
+!Open_u_dataset is called rather than open_r_dataset to allow interfaces
+!that can do blending or masking to update an existing field. (MCEL IO does this).
+!No effect for other interfaces; open_u_dataset is equivalent to open_r_dataset 
+!in those cases.
+!
+!</DESCRIPTION>
+
+     SELECT CASE( stream )
+       CASE ( 1 )
+         CALL open_u_dataset ( grid%auxinput1_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input1 , n2, ierr )
+       CASE ( 2 )
+         CALL open_u_dataset ( grid%auxinput2_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input2 , n2, ierr )
+       CASE ( 3 )
+         CALL open_u_dataset ( grid%auxinput3_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input3 , n2, ierr )
+       CASE ( 4 )
+         CALL open_u_dataset ( grid%auxinput4_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input4 , n2, ierr )
+       CASE ( 5 )
+         CALL open_u_dataset ( grid%auxinput5_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input5 , n2, ierr )
+       CASE ( 6 )
+         CALL open_u_dataset ( grid%auxinput6_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input6 , n2, ierr )
+       CASE ( 7 )
+         CALL open_u_dataset ( grid%auxinput7_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input7 , n2, ierr )
+       CASE ( 8 )
+         CALL open_u_dataset ( grid%auxinput8_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input8 , n2, ierr )
+       CASE ( 9 )
+         CALL open_u_dataset ( grid%auxinput9_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input9 , n2, ierr )
+       CASE ( 10 )
+         CALL open_u_dataset ( grid%auxinput10_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input10 , n2, ierr )
+       CASE ( 11 )
+         CALL open_u_dataset ( grid%auxinput11_oid, TRIM(auxname), grid ,  &
+                               config_flags , input_aux_model_input11 , n2, ierr )
+     END SELECT
+     IF ( ierr .NE. 0 ) THEN
+       CALL wrf_message( message )
+     ENDIF
+   END IF
+   ! early return after training
+   IF ( .NOT. grid%return_after_training_io ) THEN
+     SELECT CASE( stream )
+       CASE ( 1 )
+         CALL input_aux_model_input1 ( grid%auxinput1_oid, grid , config_flags , ierr )
+       CASE ( 2 )
+         CALL input_aux_model_input2 ( grid%auxinput2_oid, grid , config_flags , ierr )
+       CASE ( 3 )
+         CALL input_aux_model_input3 ( grid%auxinput3_oid, grid , config_flags , ierr )
+       CASE ( 4 )
+         CALL input_aux_model_input4 ( grid%auxinput4_oid, grid , config_flags , ierr )
+       CASE ( 5 )
+         CALL input_aux_model_input5 ( grid%auxinput5_oid, grid , config_flags , ierr )
+       CASE ( 6 )
+         CALL input_aux_model_input6 ( grid%auxinput6_oid, grid , config_flags , ierr )
+       CASE ( 7 )
+         CALL input_aux_model_input7 ( grid%auxinput7_oid, grid , config_flags , ierr )
+       CASE ( 8 )
+         CALL input_aux_model_input8 ( grid%auxinput8_oid, grid , config_flags , ierr )
+       CASE ( 9 )
+         CALL input_aux_model_input9 ( grid%auxinput9_oid, grid , config_flags , ierr )
+       CASE ( 10 )
+         CALL input_aux_model_input10 ( grid%auxinput10_oid, grid , config_flags , ierr )
+       CASE ( 11 )
+         CALL input_aux_model_input11 ( grid%auxinput11_oid, grid , config_flags , ierr )
+     END SELECT
+   ELSE
+     CALL wrf_debug( 1, 'DEBUG:  med_auxinput_in() returned after training' )
+   ENDIF
+   RETURN
+END SUBROUTINE med_auxinput_in
+
+SUBROUTINE med_filter_out ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+   USE module_timing
+   USE module_configure
+  ! Model layer
+   USE module_bc_time_utilities
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+   CHARACTER*80                           :: rstname , outname
+   INTEGER                                :: fid , rid
+   CHARACTER (LEN=256)                    :: message
+   INTEGER                                :: ierr
+   INTEGER                                :: myproc
+   CHARACTER*80                           :: timestr
+
+   IF ( config_flags%write_input ) THEN
+
+   IF ( wrf_dm_on_monitor() ) THEN
+     CALL start_timing
+   END IF
+
+     CALL domain_clock_get( grid, current_timestr=timestr )
+     CALL construct_filename2a ( outname , config_flags%input_outname , grid%id , 2 , timestr )
+
+     WRITE ( message , '("med_filter_out 1: opening ",A," for writing. ",I3)') TRIM ( outname ), ierr
+     CALL wrf_debug( 1, message )
+
+     CALL open_w_dataset ( fid, TRIM(outname), grid ,  &
+                           config_flags , output_model_input , "DATASET=INPUT", ierr )
+     IF ( ierr .NE. 0 ) THEN
+       CALL wrf_error_fatal( message )
+     ENDIF
+
+     IF ( ierr .NE. 0 ) THEN
+       CALL wrf_error_fatal( message )
+     ENDIF
+
+   CALL output_model_input ( fid, grid , config_flags , ierr )
+   CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
+
+   IF ( wrf_dm_on_monitor() ) THEN
+     WRITE ( message , FMT = '("Writing filter output for domain ",I8)' ) grid%id
+     CALL end_timing ( TRIM(message) )
+   END IF
+   ENDIF
+
+   RETURN
+END SUBROUTINE med_filter_out
+
+SUBROUTINE med_latbound_in ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+   USE module_timing
+   USE module_configure
+  ! Model layer
+   USE module_bc_time_utilities
+   USE module_utility
+
+   IMPLICIT NONE
+
+#include <wrf_status_codes.h>
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+
+  ! Local data
+   LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
+   LOGICAL                                :: lbc_opened
+   INTEGER                                :: idum1 , idum2 , ierr , open_status , fid, rc
+   REAL                                   :: bfrq
+   CHARACTER (LEN=256)                    :: message
+   CHARACTER (LEN=80)                     :: bdyname
+   Type (WRFU_Time )                      :: startTime, stopTime, currentTime
+   Type (WRFU_TimeInterval )              :: stepTime
+
+#include <wrf_io_flags.h>
+
+   CALL wrf_debug ( 200 , 'in med_latbound_in' )
+
+   IF ( grid%id .EQ. 1 .AND. config_flags%specified .AND. config_flags%io_form_boundary .GT. 0 ) THEN
+
+     CALL domain_clock_get( grid, current_time=currentTime, &
+                                  start_time=startTime,     &
+                                  stop_time=stopTime,       &
+                                  time_step=stepTime )
+
+     IF ( ( lbc_read_time( currentTime ) ) .AND. &
+          ( currentTime + stepTime .GE. stopTime ) .AND. &
+          ( currentTime .NE. startTime ) ) THEN
+       CALL wrf_debug( 100 , 'med_latbound_in: Skipping attempt to read lateral boundary file during last time step ' )
+
+     ELSE IF ( WRFU_AlarmIsRinging( grid%alarms( BOUNDARY_ALARM ), rc=rc ) ) THEN
+       CALL wrf_debug ( 100 , 'in med_latbound_in preparing to read' )
+       CALL WRFU_AlarmRingerOff( grid%alarms( BOUNDARY_ALARM ), rc=rc )
+       IF ( wrf_dm_on_monitor() ) CALL start_timing
+
+! typically a <date> wouldn't be part of the bdy_inname, so just pass a dummy
+       CALL construct_filename2a ( bdyname , config_flags%bdy_inname , grid%id , 2 , 'dummydate' )
+
+       CALL wrf_inquire_opened(head_grid%lbc_fid , TRIM(bdyname) , open_status , ierr ) 
+       IF ( open_status .EQ. WRF_FILE_OPENED_FOR_READ ) THEN
+         lbc_opened = .TRUE.
+       ELSE
+         lbc_opened = .FALSE.
+       ENDIF
+       CALL wrf_dm_bcast_bytes ( lbc_opened , LWORDSIZE )
+       IF ( .NOT. lbc_opened ) THEN
+         CALL construct_filename1 ( bdyname , 'wrfbdy' , grid%id , 2 )
+         CALL open_r_dataset ( head_grid%lbc_fid, TRIM(bdyname) , grid , config_flags , "DATASET=BOUNDARY", ierr )
+          IF ( ierr .NE. 0 ) THEN
+            WRITE( message, * ) 'med_latbound_in: error opening ',TRIM(bdyname), ' for reading. IERR = ',ierr
+            CALL WRF_ERROR_FATAL( message )
+          ENDIF
+       ELSE
+         CALL wrf_debug( 100 , bdyname // 'already opened' )
+       ENDIF
+       CALL wrf_debug( 100 , 'med_latbound_in: calling input_boundary ' )
+       CALL input_boundary ( grid%lbc_fid, grid , config_flags , ierr )
+
+       CALL domain_clock_get( grid, current_time=currentTime )
+       DO WHILE (currentTime .GE. grid%next_bdy_time )         ! next_bdy_time is set by input_boundary from bdy file
+         CALL wrf_debug( 100 , 'med_latbound_in: calling input_boundary ' )
+         CALL input_boundary ( grid%lbc_fid, grid , config_flags , ierr )
+       ENDDO
+       CALL WRFU_AlarmSet( grid%alarms( BOUNDARY_ALARM ), RingTime=grid%next_bdy_time, rc=rc )
+
+       IF ( ierr .NE. 0 .and. ierr .NE. WRF_WARN_NETCDF ) THEN
+         WRITE( message, * ) 'med_latbound_in: error reading ',TRIM(bdyname), ' IERR = ',ierr
+         CALL WRF_ERROR_FATAL( message )
+       ENDIF
+       IF ( currentTime .EQ. grid%this_bdy_time ) grid%dtbc = 0.
+  
+       IF ( wrf_dm_on_monitor() ) THEN
+         WRITE ( message , FMT = '("processing lateral boundary for domain ",I8)' ) grid%id
+         CALL end_timing ( TRIM(message) )
+       ENDIF
+
+!#if 0
+     ENDIF
+!#endif
+   ENDIF
+   RETURN
+END SUBROUTINE med_latbound_in
+
+SUBROUTINE med_setup_step ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_configure
+  ! Model layer
+
+   IMPLICIT NONE
+!<DESCRIPTION>
+!
+!The driver layer routine integrate() calls this mediation layer routine
+!prior to initiating a time step on the domain specified by the argument
+!grid.  This provides the model-layer contributor an opportunity to make
+!any pre-time-step initializations that pertain to a particular model
+!domain.  In WRF, this routine is used to call
+!set_scalar_indices_from_config for the specified domain.
+!
+!</DESCRIPTION>
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+  ! Local
+   INTEGER                                    :: idum1 , idum2
+
+   CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
+
+   RETURN
+
+END SUBROUTINE med_setup_step
+
+SUBROUTINE med_endup_step ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_configure
+  ! Model layer
+
+   IMPLICIT NONE
+!<DESCRIPTION>
+!
+!The driver layer routine integrate() calls this mediation layer routine
+!prior to initiating a time step on the domain specified by the argument
+!grid.  This provides the model-layer contributor an opportunity to make
+!any pre-time-step initializations that pertain to a particular model
+!domain.  In WRF, this routine is used to call
+!set_scalar_indices_from_config for the specified domain.
+!
+!</DESCRIPTION>
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(OUT)   :: config_flags
+  ! Local
+   INTEGER                                    :: idum1 , idum2
+
+   IF ( grid%id .EQ. 1 ) THEN
+     ! turn off the restart flag after the first mother-domain step is finished
+     model_config_rec%restart = .FALSE.
+     config_flags%restart = .FALSE.
+     CALL nl_set_restart(1, .FALSE.)
+
+   ENDIF
+
+   RETURN
+
+END SUBROUTINE med_endup_step
+
+ 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+#ifdef WRF_CHEM
+!------------------------------------------------------------------------
+! Chemistry emissions input control. Three options are available and are
+! set via the namelist variable io_style_emissions:
+!
+!   0 = Emissions are not read in from a file. They will contain their
+!       default values, which can be set in the Registry.
+!       (Intended for debugging of chem code)
+!
+!   1 = Emissions are read in from two 12 hour files that are cycled.
+!       With this choice, emi_inname and emi_outname should be set to
+!       the value "wrfchemi_d<domain>". The value of frames_per_emissfile
+!       is ignored.
+!
+!   2 = Emissions are read in from files identified by date and that have
+!       a length defined by frames_per_emissfile (in hours). Both
+!       emi_inname and emi_outname should be set to 
+!       "wrfchemi_d<domain>_<date>".
+!------------------------------------------------------------------------
+SUBROUTINE med_read_wrf_chem_emiss ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+   USE module_timing
+   USE module_configure
+  ! Model layer
+   USE module_bc_time_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+   USE module_date_time
+   USE module_utility
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+
+!  TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   TYPE (grid_config_rec_type)            :: config_flags
+   Type (WRFU_Time )                      :: stopTime, currentTime
+   Type (WRFU_TimeInterval )              :: stepTime
+
+  ! Local data
+   LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
+
+   INTEGER                                :: ierr, efid
+   REAL                                   :: time, tupdate
+   real, allocatable :: dumc0(:,:,:)
+   CHARACTER (LEN=256)                    :: message, current_date_char, date_string
+   CHARACTER (LEN=80)                     :: inpname
+
+#include <wrf_io_flags.h>
+
+     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! This "if" should be commented out when using emission files for nested
+! domains. Also comment out the "ENDIF" line noted below.
+!    IF ( grid%id .EQ. 1 ) THEN  
+
+      CALL domain_clock_get( grid, current_time=currentTime,          &
+                                   current_timestr=current_date_char, &
+                                   stop_time=stopTime,                &
+                                   time_step=stepTime )
+
+      time = float(grid%itimestep) * grid%dt
+
+!---
+! io_style_emissions option 0: no emissions read in...
+!---
+      if( config_flags%io_style_emissions == 0 ) then
+         ! Do nothing.
+!---
+! io_style_emissions option 1: cycle through two 12 hour input files...
+!---
+      else if( config_flags%io_style_emissions == 1 ) then
+!!!****MARS
+         tupdate = mod( time, (12. * 3700.) )
+         IF( currentTime + stepTime .GE. stopTime .AND. &
+              grid%auxinput5_oid .NE. 0 ) THEN
+            CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
+            tupdate = 1.
+         ENDIF
+
+!        write(message,FMT='(A,F10.1,A)') ' EMISSIONS UPDATE TIME ',time,TRIM(current_date_char(12:13))
+!        CALL wrf_message( TRIM(message) )
+
+         IF ( tupdate .EQ. 0. .AND.  current_date_char(12:13) .EQ. '00' ) THEN
+            CALL construct_filename1 ( inpname , 'wrfchemi_00z' , grid%id , 2 )
+            WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
+            CALL wrf_message( TRIM(message) )
+
+            if( grid%auxinput5_oid .NE. 0 ) then
+               CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
+            endif
+
+            CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
+                 "DATASET=AUXINPUT5", ierr )
+            IF ( ierr .NE. 0 ) THEN
+               WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
+               CALL wrf_error_fatal( TRIM( message ) )
+            ENDIF
+         ELSE IF ( tupdate .EQ. 0. .AND. current_date_char(12:13) .EQ. '12' ) THEN
+            CALL construct_filename1 ( inpname , 'wrfchemi_12z' , grid%id , 2 )
+            WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
+            CALL wrf_message( TRIM(message) )
+
+            if( grid%auxinput5_oid .NE. 0 ) then
+               CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
+            endif
+
+            CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
+                 "DATASET=AUXINPUT5", ierr )
+            IF ( ierr .NE. 0 ) THEN
+               WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
+               CALL wrf_error_fatal( TRIM( message ) )
+            ENDIF
+         ENDIF
+!!!****MARS
+         WRITE( message, '(A,2F10.1)' ) ' HOURLY EMISSIONS UPDATE TIME ',time,mod(time,3700.)
+         CALL wrf_message( TRIM(message) )
+!
+! hourly updates to emissions
+!!!****MARS
+         IF ( ( mod( time, 3700. ) .LT. 0.001   ) .AND. &
+              ( currentTime + stepTime .LT. stopTime ) ) THEN
+!           IF ( wrf_dm_on_monitor() ) CALL start_timing
+
+            WRITE(message,'(A,A)')'mediation_integrate: med_read_wrf_chem_emissions: Read emissions for time ',TRIM(current_date_char)
+            CALL wrf_message( TRIM(message) )
+
+            CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input5' )
+            CALL input_aux_model_input5 ( grid%auxinput5_oid, grid , config_flags , ierr )
+         ELSE
+            CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_emissions: Do not read emissions' )
+         ENDIF
+
+
+!---
+! io_style_emissions option 2: use dated emission files whose length is
+!                             set via frames_per_emissfile...
+!---
+      else if( config_flags%io_style_emissions == 2 ) then
+         WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Read emissions for time ',TRIM(current_date_char)
+         CALL wrf_message( TRIM(message) )
+!
+! Code to read hourly emission files...
+!
+         if( grid%auxinput5_oid == 0 ) then
+            CALL construct_filename2a(inpname , grid%emi_inname, grid%id , 2, current_date_char)
+            WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
+            CALL wrf_message( TRIM(message) )
+            CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
+                 "DATASET=AUXINPUT5", ierr )
+            IF ( ierr .NE. 0 ) THEN
+               WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
+               CALL wrf_error_fatal( TRIM( message ) )
+            ENDIF
+         end if
+!
+! Read the emissions data.
+!
+         CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input5' )
+         CALL input_aux_model_input5 ( grid%auxinput5_oid, grid , config_flags , ierr )
+!
+! If reached the indicated number of frames in the emissions file, close it.
+!
+         grid%emissframes = grid%emissframes + 1
+         IF ( grid%emissframes >= config_flags%frames_per_emissfile ) THEN
+            CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
+            grid%emissframes = 0
+            grid%auxinput5_oid = 0
+         ENDIF
+
+!---
+! unknown io_style_emissions option...
+!---
+      else
+         call wrf_error_fatal("Unknown emission style selected via io_style_emissions.")
+      end if
+
+! The following line should be commented out when using emission files
+! for nested domains. Also comment out the "if" noted above.
+!   ENDIF
+
+   CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_emissions: exit' )
+
+END SUBROUTINE med_read_wrf_chem_emiss
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+   USE module_timing
+   USE module_configure
+  ! Model layer
+   USE module_bc_time_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+   USE module_date_time
+   USE module_utility
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+
+  ! Local data
+   LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
+
+   INTEGER                                :: ierr, efid
+   REAL                                   :: time, tupdate
+   real, allocatable :: dumc0(:,:,:)
+   CHARACTER (LEN=256)                    :: message, current_date_char, date_string
+   CHARACTER (LEN=80)                     :: inpname
+
+#include <wrf_io_flags.h>
+!   IF ( grid%id .EQ. 1 ) THEN
+
+      CALL domain_clock_get( grid, current_timestr=current_date_char )
+
+      CALL construct_filename1 ( inpname , 'wrfbiochemi' , grid%id , 2 )
+      WRITE(message,*)'mediation_integrate: med_read_wrf_chem_bioemissions: Open file ',TRIM(inpname)
+      CALL wrf_message( TRIM(message) )
+
+     if( grid%auxinput4_oid .NE. 0 ) then
+       CALL close_dataset ( grid%auxinput4_oid , config_flags , "DATASET=AUXINPUT4" )
+     endif
+
+      CALL open_r_dataset ( grid%auxinput4_oid, TRIM(inpname) , grid , config_flags, &
+                              "DATASET=AUXINPUT4", ierr )
+        IF ( ierr .NE. 0 ) THEN
+           WRITE( message , * ) 'med_read_wrf_chem_bioemissions: error opening ', TRIM( inpname )
+           CALL wrf_error_fatal( TRIM( message ) )
+        ENDIF
+
+         WRITE(message,*)'mediation_integrate: med_read_wrf_chem_bioemissions: Read biogenic emissions at time ',&
+         TRIM(current_date_char)
+         CALL wrf_message( TRIM(message) )
+
+         CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input4' )
+         CALL input_aux_model_input4 ( grid%auxinput4_oid, grid , config_flags , ierr )
+
+         CALL close_dataset ( grid%auxinput4_oid , config_flags , "DATASET=AUXINPUT4" )
+
+!  ENDIF
+   CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_bioemissions: exit' )
+
+END SUBROUTINE med_read_wrf_chem_bioemiss
+#endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/WRF.COMMON/WRFV2/share/mediation_interp_domain.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/mediation_interp_domain.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/mediation_interp_domain.F	(revision 2744)
@@ -0,0 +1,214 @@
+!
+!WRF:MEDIATION_LAYER:NESTING
+!
+SUBROUTINE med_interp_domain ( parent_grid , nested_grid )
+   USE module_domain
+   USE module_configure
+   USE module_timing
+   IMPLICIT NONE
+   TYPE(domain), POINTER :: parent_grid , nested_grid
+   TYPE(domain), POINTER :: grid
+   INTEGER nlev, msize
+   TYPE (grid_config_rec_type)            :: config_flags
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+
+! ----------------------------------------------------------
+! ----------------------------------------------------------
+! Interface blocks
+! ----------------------------------------------------------
+   INTERFACE
+! ----------------------------------------------------------
+!    Interface definitions for EM CORE
+! ----------------------------------------------------------
+#if (EM_CORE == 1)
+! ----------------------------------------------------------
+!    These routines are supplied by module_dm.F from the 
+!    external communication package (e.g. external/RSL)
+! ----------------------------------------------------------
+      SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags   &
+!
+#        include "em_dummy_new_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: intermediate_grid
+         TYPE(domain), POINTER :: ngrid
+         TYPE (grid_config_rec_type)            :: config_flags
+#        include <em_dummy_new_decl.inc>
+      END SUBROUTINE interp_domain_em_part1
+
+      SUBROUTINE interp_domain_em_part2 ( grid, nested_grid, config_flags   &
+!
+#        include "em_dummy_new_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: nested_grid
+         TYPE (grid_config_rec_type)            :: config_flags
+#        include <em_dummy_new_decl.inc>
+      END SUBROUTINE interp_domain_em_part2
+#endif
+! ----------------------------------------------------------
+!    Interface definitions for NMM (placeholder)
+! ----------------------------------------------------------
+#if (NMM_CORE == 1 && NMM_NEST == 1)
+!=======================================================================
+!  Added for the NMM core. This is gopal's doing.
+!=======================================================================
+
+      SUBROUTINE interp_domain_nmm_part1 ( grid, intermediate_grid, ngrid, config_flags    &
+!
+# include "nmm_dummy_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: intermediate_grid
+         TYPE(domain), POINTER :: ngrid
+         TYPE (grid_config_rec_type)            :: config_flags
+# include <nmm_dummy_decl.inc>
+      END SUBROUTINE interp_domain_nmm_part1
+
+      SUBROUTINE interp_domain_nmm_part2 ( grid, nested_grid, config_flags    &
+!
+# include "nmm_dummy_args.inc"
+!
+                 )
+         USE module_domain
+         USE module_configure
+         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+         TYPE(domain), POINTER :: nested_grid
+         TYPE (grid_config_rec_type)            :: config_flags
+# include <nmm_dummy_decl.inc>
+      END SUBROUTINE interp_domain_nmm_part2
+
+!=======================================================================
+!  End of gopal's doing.
+!=======================================================================
+#endif
+! ----------------------------------------------------------
+!    Interface definitions for COAMPS (placeholder)
+! ----------------------------------------------------------
+#if (COAMPS_CORE == 1)
+#endif
+   END INTERFACE
+! ----------------------------------------------------------
+! End of Interface blocks
+! ----------------------------------------------------------
+! ----------------------------------------------------------
+! ----------------------------------------------------------
+! Executable code
+! ----------------------------------------------------------
+! ----------------------------------------------------------
+!    Interpolation calls for EM CORE.  The called 
+!    routines below are supplied by module_dm.F
+!    from the external communications package (e.g. RSL)
+! ----------------------------------------------------------
+#if (EM_CORE == 1 && defined( DM_PARALLEL ))
+  CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+  IF ( config_flags%dyn_opt == DYN_EM ) THEN
+
+    grid => nested_grid%intermediate_grid
+    CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. ,   &
+                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
+                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
+                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
+                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
+      )
+
+    grid => parent_grid
+
+    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+    CALL interp_domain_em_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags   &
+!
+#     include "em_actual_new_args.inc"
+!
+                                )
+    grid => nested_grid%intermediate_grid
+    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+    CALL interp_domain_em_part2 ( grid, nested_grid, config_flags   &
+!
+#     include "em_actual_new_args.inc"
+!
+                                )
+
+    grid => nested_grid%intermediate_grid
+    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+    CALL dealloc_space_field ( grid )
+
+  ENDIF
+#endif
+! ------------------------------------------------------
+!    End of Interpolation calls for EM CORE.
+! ------------------------------------------------------
+! ------------------------------------------------------
+! ------------------------------------------------------
+!    Interpolation calls for NMM. (Placeholder)
+! ------------------------------------------------------
+#if (NMM_CORE == 1 && NMM_NEST == 1)
+!=======================================================================
+!  Added for the NMM core. This is gopal's doing.
+!=======================================================================
+!
+  CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
+  IF ( config_flags%dyn_opt == DYN_NMM) THEN
+
+    grid => nested_grid%intermediate_grid
+!    CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. ,   &
+    CALL alloc_space_field ( grid, grid%id , 1 , 3 , .FALSE. ,   &
+                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
+                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
+                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
+                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
+      )
+
+    grid => parent_grid
+
+#   include "deref_kludge.h"
+
+
+    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+    CALL interp_domain_nmm_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags    &
+!
+#     include "nmm_actual_args.inc"
+!
+                                )
+    grid => nested_grid%intermediate_grid
+    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+#   include "deref_kludge.h"
+
+    CALL interp_domain_nmm_part2 ( grid, nested_grid, config_flags    &
+!
+#     include "nmm_actual_args.inc"
+!
+                                )
+  ENDIF
+! ------------------------------------------------------------
+!    End of gopal's doing
+! ------------------------------------------------------------
+#endif
+! ------------------------------------------------------
+!    End of Interpolation calls for NMM.
+! ------------------------------------------------------
+! ------------------------------------------------------
+! ------------------------------------------------------
+!    Interpolation calls for COAMPS. (Placeholder)
+! ------------------------------------------------------
+#if (COAMPS_CORE == 1)
+#endif
+! ------------------------------------------------------
+!    End of Interpolation calls for COAMPS.
+! ------------------------------------------------------
+   RETURN
+END SUBROUTINE med_interp_domain
+
+
Index: trunk/WRF.COMMON/WRFV2/share/mediation_nest_move.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/mediation_nest_move.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/mediation_nest_move.F	(revision 2744)
@@ -0,0 +1,908 @@
+
+SUBROUTINE med_nest_move ( parent, nest )
+  ! Driver layer
+   USE module_domain
+   USE module_timing
+   USE module_configure
+   USE module_io_domain
+   USE module_dm
+   TYPE(domain) , POINTER                     :: parent, nest, grid
+   INTEGER dx, dy       ! number of parent domain points to move
+#ifdef MOVE_NESTS
+  ! Local 
+   CHARACTER*256 mess
+   INTEGER i, j, p, parent_grid_ratio, dyn_opt
+   INTEGER px, py       ! number and direction of nd points to move
+   INTEGER                         :: ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      ips , ipe , jps , jpe , kps , kpe
+   INTEGER ierr, fid
+   LOGICAL input_from_hires
+   LOGICAL saved_restart_value
+   TYPE (grid_config_rec_type)   :: config_flags
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+   LOGICAL, EXTERNAL :: should_not_move
+
+   INTERFACE
+     SUBROUTINE med_interp_domain ( parent , nest )
+        USE module_domain
+        TYPE(domain) , POINTER                 :: parent , nest
+     END SUBROUTINE med_interp_domain
+     SUBROUTINE start_domain ( grid , allowed_to_move )
+        USE module_domain
+        TYPE(domain) :: grid
+        LOGICAL, INTENT(IN) :: allowed_to_move
+     END SUBROUTINE start_domain
+#if ( EM_CORE == 1 )
+     SUBROUTINE shift_domain_em ( grid, disp_x, disp_y  &
+!
+# include <em_dummy_new_args.inc>
+!
+                           )
+        USE module_domain
+        USE module_configure
+        USE module_timing
+        IMPLICIT NONE
+        INTEGER disp_x, disp_y
+        TYPE(domain) , POINTER                 :: grid
+# include <em_dummy_new_decl.inc>
+     END SUBROUTINE shift_domain_em
+#endif
+#if ( NMM_CORE == 1 )
+#endif
+     LOGICAL FUNCTION time_for_move ( parent , nest , dx , dy )
+        USE module_domain
+        USE module_utility
+        TYPE(domain) , POINTER    :: parent , nest
+        INTEGER, INTENT(OUT)      :: dx , dy
+     END FUNCTION time_for_move
+     SUBROUTINE  input_terrain_rsmas ( grid ,                  &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           ips , ipe , jps , jpe , kps , kpe )
+       USE module_domain
+       TYPE ( domain ) :: grid
+       INTEGER                           :: ids , ide , jds , jde , kds , kde , &
+                                            ims , ime , jms , jme , kms , kme , &
+                                            ips , ipe , jps , jpe , kps , kpe
+     END SUBROUTINE input_terrain_rsmas
+     SUBROUTINE med_nest_feedback ( parent , nest , config_flags )
+       USE module_domain
+       USE module_configure
+       TYPE (domain), POINTER ::  nest , parent
+       TYPE (grid_config_rec_type) config_flags
+     END SUBROUTINE med_nest_feedback
+     SUBROUTINE  blend_terrain ( ter_interpolated , ter_input , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           ips , ipe , jps , jpe , kps , kpe )
+       INTEGER                           :: ids , ide , jds , jde , kds , kde , &
+                                            ims , ime , jms , jme , kms , kme , &
+                                            ips , ipe , jps , jpe , kps , kpe
+       REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
+       REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
+     END SUBROUTINE blend_terrain
+     SUBROUTINE  store_terrain ( ter_interpolated , ter_input , &
+                           ids , ide , jds , jde , kds , kde , &
+                           ims , ime , jms , jme , kms , kme , &
+                           ips , ipe , jps , jpe , kps , kpe )
+       INTEGER                           :: ids , ide , jds , jde , kds , kde , &
+                                            ims , ime , jms , jme , kms , kme , &
+                                            ips , ipe , jps , jpe , kps , kpe
+       REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
+       REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
+     END SUBROUTINE store_terrain
+   END INTERFACE
+
+  ! set grid pointer for code in deref_kludge (if used)
+   grid => nest
+
+   CALL nl_get_dyn_opt ( 1, dyn_opt )
+
+   IF ( should_not_move( nest%id ) ) THEN
+      CALL wrf_message( 'Nest movement is disabled because of namelist settings' )
+      RETURN
+   ENDIF
+
+! if the nest has stopped don't do all this
+   IF ( WRFU_ClockIsStopTime(nest%domain_clock ,rc=ierr) ) RETURN
+
+! mask should be defined in nest domain
+
+   check_for_move: IF ( time_for_move ( parent , nest , dx, dy ) ) THEN
+
+     IF ( (dx .gt. 1 .or. dx .lt. -1 ) .or.  &
+          (dy .gt. 1 .or. dy .lt. -1 ) ) THEN
+       WRITE(mess,*)' invalid move: dx, dy ', dx, dy
+       CALL wrf_error_fatal( mess )
+     ENDIF
+
+     WRITE(mess,*)' moving ',grid%id,dx,dy
+     CALL wrf_message(mess)
+
+     CALL get_ijk_from_grid (  grid ,                   &
+                               ids, ide, jds, jde, kds, kde,    &
+                               ims, ime, jms, jme, kms, kme,    &
+                               ips, ipe, jps, jpe, kps, kpe    )
+
+     CALL wrf_dm_move_nest ( parent, nest%intermediate_grid, dx, dy )
+
+     CALL adjust_domain_dims_for_move( nest%intermediate_grid , dx, dy )
+
+     CALL get_ijk_from_grid (  grid ,                   &
+                               ids, ide, jds, jde, kds, kde,    &
+                               ims, ime, jms, jme, kms, kme,    &
+                               ips, ipe, jps, jpe, kps, kpe    )
+
+     grid => nest 
+
+#if ( EM_CORE == 1 )
+     IF ( dyn_opt .EQ. DYN_EM ) THEN
+       CALL shift_domain_em( grid, dx, dy  &
+!
+# include <em_actual_new_args.inc>
+!
+                           )
+     ENDIF
+#endif
+#if ( WRF_NMM_CORE == 1 )
+     IF ( dyn_opt .EQ. DYN_NMM ) THEN
+     ENDIF
+#endif
+
+     px = grid%parent_grid_ratio*dx
+     py = grid%parent_grid_ratio*dy
+
+     grid%i_parent_start = grid%i_parent_start + px / grid%parent_grid_ratio 
+     CALL nl_set_i_parent_start( grid%id, grid%i_parent_start )
+     grid%j_parent_start = grid%j_parent_start + py / grid%parent_grid_ratio
+     CALL nl_set_j_parent_start( grid%id, grid%j_parent_start )
+
+     IF ( wrf_dm_on_monitor() ) THEN
+       write(mess,*)  &
+         'Grid ',grid%id,' New SW corner (in parent x and y):',grid%i_parent_start, grid%j_parent_start
+       CALL wrf_message(TRIM(mess))
+     ENDIF
+
+     CALL med_interp_domain( parent, nest )
+
+     CALL nl_get_input_from_hires( nest%id , input_from_hires ) 
+     IF ( input_from_hires ) THEN
+
+! store horizontally interpolated terrain in temp location
+       CALL  store_terrain ( nest%ht_fine , nest%ht , &
+                             ids , ide , jds , jde , 1   , 1   , &
+                             ims , ime , jms , jme , 1   , 1   , &
+                             ips , ipe , jps , jpe , 1   , 1   )
+       CALL  store_terrain ( nest%em_mub_fine , nest%em_mub , &
+                             ids , ide , jds , jde , 1   , 1   , &
+                             ims , ime , jms , jme , 1   , 1   , &
+                             ips , ipe , jps , jpe , 1   , 1   )
+       CALL  store_terrain ( nest%em_phb_fine , nest%em_phb , &
+                             ids , ide , jds , jde , kds , kde , &
+                             ims , ime , jms , jme , kms , kme , &
+                             ips , ipe , jps , jpe , kps , kpe )
+
+       CALL  input_terrain_rsmas ( nest,                               &
+                                   ids , ide , jds , jde , 1   , 1   , &
+                                   ims , ime , jms , jme , 1   , 1   , &
+                                   ips , ipe , jps , jpe , 1   , 1   )
+
+       CALL  blend_terrain ( nest%ht_fine , nest%ht , &
+                             ids , ide , jds , jde , 1   , 1   , &
+                             ims , ime , jms , jme , 1   , 1   , &
+                             ips , ipe , jps , jpe , 1   , 1   )
+       CALL  blend_terrain ( nest%em_mub_fine , nest%em_mub , &
+                             ids , ide , jds , jde , 1   , 1   , &
+                             ims , ime , jms , jme , 1   , 1   , &
+                             ips , ipe , jps , jpe , 1   , 1   )
+       CALL  blend_terrain ( nest%em_phb_fine , nest%em_phb , &
+                             ids , ide , jds , jde , kds , kde , &
+                             ims , ime , jms , jme , kms , kme , &
+                             ips , ipe , jps , jpe , kps , kpe )
+!
+       CALL model_to_grid_config_rec ( parent%id , model_config_rec , config_flags )
+
+       CALL med_nest_feedback ( parent , nest , config_flags )
+       parent%imask_nostag = 1
+       parent%imask_xstag = 1
+       parent%imask_ystag = 1
+       parent%imask_xystag = 1
+
+! start_domain will key off "restart". Even if this is a restart run
+! we don't want it to here. Save the value, set it to false, and restore afterwards
+       saved_restart_value = config_flags%restart
+       config_flags%restart = .FALSE.
+       grid%restart = .FALSE.
+       CALL nl_set_restart ( 1, .FALSE. )
+       CALL start_domain ( parent , .FALSE. )
+       config_flags%restart = saved_restart_value
+       grid%restart = saved_restart_value
+       CALL nl_set_restart ( 1,  saved_restart_value )
+
+     ENDIF
+
+!
+! masks associated with nest will have been set by shift_domain_em above
+     nest%moved = .true.
+! start_domain will key off "restart". Even if this is a restart run
+! we don't want it to here. Save the value, set it to false, and restore afterwards
+     saved_restart_value = config_flags%restart
+     config_flags%restart = .FALSE.
+     CALL nl_set_restart ( 1, .FALSE. )
+     grid%restart = .FALSE.
+     CALL start_domain ( nest , .FALSE. )
+     config_flags%restart = saved_restart_value
+     grid%restart = saved_restart_value
+     CALL nl_set_restart ( 1,  saved_restart_value )
+     nest%moved = .false.
+      
+!
+! copy time level 2 to time level 1 in new regions of multi-time level fields
+! this should be registry generated.
+!
+#if ( EM_CORE == 1 )
+     IF ( dyn_opt .EQ. DYN_EM ) THEN
+       do k = kms,kme
+         where ( nest%imask_xstag  .EQ. 1 ) nest%em_u_1(:,k,:)   = nest%em_u_2(:,k,:)
+         where ( nest%imask_ystag  .EQ. 1 ) nest%em_v_1(:,k,:)   = nest%em_v_2(:,k,:)
+         where ( nest%imask_nostag .EQ. 1 ) nest%em_t_1(:,k,:)   = nest%em_t_2(:,k,:)
+         where ( nest%imask_nostag .EQ. 1 ) nest%em_w_1(:,k,:)   = nest%em_w_2(:,k,:)
+         where ( nest%imask_nostag .EQ. 1 ) nest%em_ph_1(:,k,:)  = nest%em_ph_2(:,k,:)
+         where ( nest%imask_nostag .EQ. 1 ) nest%em_tp_1(:,k,:)  = nest%em_tp_2(:,k,:)
+         where ( nest%imask_nostag .EQ. 1 ) nest%em_tke_1(:,k,:) = nest%em_tke_2(:,k,:)
+       enddo
+       where ( nest%imask_nostag .EQ. 1 ) nest%em_mu_1(:,:)  = nest%em_mu_2(:,:)
+     ENDIF
+#endif
+#if ( WRF_NMM_CORE == 1 )
+     IF ( dyn_opt .EQ. DYN_NMM ) THEN
+     ENDIF
+#endif
+!
+   ENDIF check_for_move
+#endif
+END SUBROUTINE med_nest_move
+
+LOGICAL FUNCTION time_for_move2 ( parent , grid , move_cd_x, move_cd_y )
+  ! Driver layer
+   USE module_domain
+   USE module_configure
+   USE module_compute_geop
+   USE module_dm
+   USE module_utility
+   IMPLICIT NONE
+! Arguments
+   TYPE(domain) , POINTER    :: parent, grid
+   INTEGER, INTENT(OUT)      :: move_cd_x , move_cd_y
+#ifdef MOVE_NESTS
+! Local
+   INTEGER  num_moves, rc
+   INTEGER  move_interval , move_id
+   TYPE(WRFU_Time) :: ct, st
+   TYPE(WRFU_TimeInterval) :: ti
+   CHARACTER*256 mess, timestr
+   INTEGER     :: ids, ide, jds, jde, kds, kde, &
+                  ims, ime, jms, jme, kms, kme, &
+                  ips, ipe, jps, jpe, kps, kpe
+   INTEGER :: is, ie, js, je, ierr
+   REAL    :: ipbar, pbar, jpbar, fact
+   REAL    :: last_vc_i , last_vc_j
+
+   REAL, ALLOCATABLE, DIMENSION(:,:) :: height_l, height
+   REAL, ALLOCATABLE, DIMENSION(:,:) :: psfc, xlat, xlong, terrain
+   REAL :: minh, maxh
+   INTEGER :: mini, minj, maxi, maxj, i, j, pgr, irad
+   REAL :: disp_x, disp_y, lag, radius, center_i, center_j, dx
+   REAL :: dijsmooth, vmax, vmin, a, b
+   REAL :: dc_i, dc_j   ! domain center
+   REAL :: maxws, ws
+   REAL :: pmin
+   INTEGER imploc, jmploc 
+
+   INTEGER :: fje, fjs, fie, fis, fimloc, fjmloc, imloc, jmloc, dyn_opt
+   INTEGER :: i_parent_start, j_parent_start
+   INTEGER :: max_vortex_speed, vortex_interval  ! meters per second and seconds
+   REAL    :: rsmooth = 100.  ! kilometers?
+
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+character*256 message, message2
+
+!#define MOVING_DIAGS
+# ifdef VORTEX_CENTER
+
+
+   CALL nl_get_dyn_opt ( 1, dyn_opt )
+   CALL nl_get_parent_grid_ratio ( grid%id , pgr )
+   CALL nl_get_i_parent_start    ( grid%id , i_parent_start )
+   CALL nl_get_j_parent_start    ( grid%id , j_parent_start )
+
+   CALL get_ijk_from_grid (  grid ,                        &
+                             ids, ide, jds, jde, kds, kde, &
+                             ims, ime, jms, jme, kms, kme, &
+                             ips, ipe, jps, jpe, kps, kpe  )
+
+! If the alarm is ringing, recompute the Vortex Center (VC); otherwise
+! use the previous position of VC.  VC is not recomputed ever step to
+! save on cost for global collection of height field and broadcast
+! of new center.
+
+#  ifdef MOVING_DIAGS
+write(0,*)'Check to see if COMPUTE_VORTEX_CENTER_ALARM is ringing? '
+#  endif
+   CALL nl_get_parent_grid_ratio ( grid%id , pgr )
+   CALL nl_get_dx ( grid%id , dx )
+
+   IF ( WRFU_AlarmIsRinging( grid%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc ) ) THEN
+
+#  ifdef MOVING_DIAGS
+     write(0,*)'COMPUTE_VORTEX_CENTER_ALARM is ringing  '
+#  endif
+     CALL WRFU_AlarmRingerOff( grid%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
+     CALL domain_clock_get( grid, current_timestr=timestr )
+
+     last_vc_i = grid%vc_i
+     last_vc_j = grid%vc_j
+
+     ALLOCATE ( height_l ( ims:ime , jms:jme ), STAT=ierr )
+     IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating height_l in time_for_move2')
+     IF ( wrf_dm_on_monitor() ) THEN
+       ALLOCATE ( height   ( ids:ide , jds:jde ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating height in time_for_move2')
+       ALLOCATE ( psfc     ( ids:ide , jds:jde ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating psfc in time_for_move2')
+       ALLOCATE ( xlat     ( ids:ide , jds:jde ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating xlat in time_for_move2')
+       ALLOCATE ( xlong    ( ids:ide , jds:jde ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating xlong in time_for_move2')
+       ALLOCATE ( terrain  ( ids:ide , jds:jde ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating terrain in time_for_move2')
+     ELSE
+       ALLOCATE ( height   ( 1:1 , 1:1 ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating height in time_for_move2')
+       ALLOCATE ( psfc     ( 1:1 , 1:1 ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating psfc in time_for_move2')
+       ALLOCATE ( xlat     ( 1:1 , 1:1 ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating xlat in time_for_move2')
+       ALLOCATE ( xlong    ( 1:1 , 1:1 ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating xlong in time_for_move2')
+       ALLOCATE ( terrain  ( 1:1 , 1:1 ), STAT=ierr )
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating terrain in time_for_move2')
+     ENDIF
+
+#  if (EM_CORE == 1)
+     IF ( dyn_opt .EQ. DYN_EM ) THEN
+       CALL compute_500mb_height ( grid%em_ph_2 , grid%em_phb, grid%em_p, grid%em_pb, height_l , &
+                                   ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   ips, ipe, jps, jpe, kps, kpe  )
+     ENDIF
+#  endif
+#  if (WRF_NMM_CORE == 1)
+     IF ( dyn_opt .EQ. DYN_NMM ) THEN
+     ENDIF
+#  endif
+
+     CALL wrf_patch_to_global_real ( height_l , height , grid%domdesc, "z", "xy", &
+                                     ids, ide-1 , jds , jde-1 , 1 , 1 , &
+                                     ims, ime   , jms , jme   , 1 , 1 , &
+                                     ips, ipe   , jps , jpe   , 1 , 1   )
+     CALL wrf_patch_to_global_real ( grid%psfc , psfc , grid%domdesc, "z", "xy", &
+                                     ids, ide-1 , jds , jde-1 , 1 , 1 , &
+                                     ims, ime   , jms , jme   , 1 , 1 , &
+                                     ips, ipe   , jps , jpe   , 1 , 1   )
+     CALL wrf_patch_to_global_real ( grid%xlat , xlat , grid%domdesc, "z", "xy", &
+                                     ids, ide-1 , jds , jde-1 , 1 , 1 , &
+                                     ims, ime   , jms , jme   , 1 , 1 , &
+                                     ips, ipe   , jps , jpe   , 1 , 1   )
+     CALL wrf_patch_to_global_real ( grid%xlong , xlong , grid%domdesc, "z", "xy", &
+                                     ids, ide-1 , jds , jde-1 , 1 , 1 , &
+                                     ims, ime   , jms , jme   , 1 , 1 , &
+                                     ips, ipe   , jps , jpe   , 1 , 1   )
+     CALL wrf_patch_to_global_real ( grid%ht , terrain , grid%domdesc, "z", "xy", &
+                                     ids, ide-1 , jds , jde-1 , 1 , 1 , &
+                                     ims, ime   , jms , jme   , 1 , 1 , &
+                                     ips, ipe   , jps , jpe   , 1 , 1   )
+
+! calculate max wind speed
+     maxws = 0.
+     do j = jps, jpe
+       do i = ips, ipe
+         ws = grid%u10(i,j) * grid%u10(i,j) + grid%v10(i,j) * grid%v10(i,j)
+         if ( ws > maxws ) maxws = ws
+       enddo
+     enddo
+     maxws = sqrt ( maxws )
+     maxws = wrf_dm_max_real ( maxws )
+
+     monitor_only : IF ( wrf_dm_on_monitor() ) THEN
+
+!
+! This vortex center finding code adapted from the Hurricane version of MM5,
+! Courtesy:
+!
+!   Shuyi Chen et al., Rosenstiel School of Marine and Atmos. Sci., U. Miami.
+!   Spring, 2005
+!
+! Get the first guess vortex center about which we do our search
+! as mini and minh; minimum value is minh
+!
+
+       CALL nl_get_vortex_interval( grid%id , vortex_interval )
+       CALL nl_get_max_vortex_speed( grid%id , max_vortex_speed )
+
+       IF ( grid%vc_i < 0. .AND. grid%vc_j < 0. ) THEN
+          ! first time through
+          is = ids
+          ie = ide-1
+          js = jds
+          je = jde-1
+       ELSE
+          ! limit the search to an area around the vortex
+          ! that is limited by max_vortex_speed (default 40) meters per second from
+          ! previous location over vortex_interval (default 15 mins)
+
+          is = max( grid%vc_i - 60 * vortex_interval * max_vortex_speed / dx , 1.0 * ids )
+          js = max( grid%vc_j - 60 * vortex_interval * max_vortex_speed / dx , 1.0 * jds )
+          ie = min( grid%vc_i + 60 * vortex_interval * max_vortex_speed / dx , 1.0 * (ide-1) )
+          je = min( grid%vc_j + 60 * vortex_interval * max_vortex_speed / dx , 1.0 * (jde-1) )
+
+       ENDIF
+
+#  ifdef MOVING_DIAGS
+write(0,*)'search set around last position '
+write(0,*)'   is, ids-1,  ie,  ide-1 ', is, ids-1, ie, ide-1
+write(0,*)'   js, jds-1,  je,  jde-1 ', js, jds-1, je, jde-1
+#  endif
+
+       imploc = -1
+       jmploc = -1
+
+       ! find minimum psfc
+       pmin = 99999999.0     ! make this very large to be sure we find a minumum
+       DO j = js, je
+       DO i = is, ie
+         IF ( psfc(i,j) .LT. pmin ) THEN
+           pmin = psfc(i,j)
+           imploc = i
+           jmploc = j
+         ENDIF
+       ENDDO
+       ENDDO
+
+       IF ( imploc .EQ. -1 .OR. jmploc .EQ. -1 ) THEN  ! if we fail to find a min there is something seriously wrong
+         WRITE(mess,*)'i,j,is,ie,js,je,imploc,jmploc ',i,j,is,ie,js,je,imploc,jmploc
+         CALL wrf_message(mess)
+         CALL wrf_error_fatal('time_for_move2: Method failure searching for minimum psfc.')
+       ENDIF
+
+       imloc = -1
+       jmloc = -1
+       maxi = -1
+       maxj = -1
+
+       ! find local min, max
+       vmin =  99999999.0
+       vmax = -99999999.0
+       DO j = js, je
+       DO i = is, ie
+         IF ( height(i,j) .LT. vmin ) THEN
+           vmin = height(i,j)
+           imloc = i
+           jmloc = j
+         ENDIF
+         IF ( height(i,j) .GT. vmax ) THEN
+           vmax = height(i,j)
+           maxi = i
+           maxj = j
+         ENDIF
+       ENDDO
+       ENDDO
+
+       IF ( imloc .EQ. -1 .OR. jmloc .EQ. -1 .OR. maxi .EQ. -1 .OR. maxj .EQ. -1 ) THEN
+         WRITE(mess,*)'i,j,is,ie,js,je,imloc,jmloc,maxi,maxj ',i,j,is,ie,js,je,imloc,jmloc,maxi,maxj
+         CALL wrf_message(mess)
+         CALL wrf_error_fatal('time_for_move2: Method failure searching max/min of height.')
+       ENDIF
+
+       fimloc = imloc
+       fjmloc = jmloc
+
+       if ( grid%xi .EQ. -1. ) grid%xi = fimloc
+       if ( grid%xj .EQ. -1. ) grid%xj = fjmloc
+
+       dijsmooth = rsmooth / dx
+
+       fjs = max(fjmloc-dijsmooth,1.0)
+       fje = min(fjmloc+dijsmooth,jde-2.0)
+       fis = max(fimloc-dijsmooth,1.0)
+       fie = min(fimloc+dijsmooth,ide-2.0)
+       js = fjs
+       je = fje
+       is = fis
+       ie = fie
+
+       vmin =  1000000.0
+       vmax = -1000000.0
+       DO j = js, je
+       DO i = is, ie
+         IF ( height(i,j) .GT. vmax ) THEN
+           vmax = height(i,j)
+         ENDIF
+       ENDDO
+       ENDDO
+
+       pbar  = 0.0
+       ipbar = 0.0
+       jpbar = 0.0
+
+       do j=js,je
+          do i=is,ie
+             fact = vmax - height(i,j)
+             pbar  = pbar + fact
+             ipbar = ipbar + fact*(i-is)
+             jpbar = jpbar + fact*(j-js)
+          enddo
+       enddo
+
+      IF ( pbar .NE. 0. ) THEN
+
+!     Compute an adjusted, smoothed, vortex center location in cross
+!     point index space.
+!     Time average. A is coef for old information; B is new
+!     If pbar is zero then just skip this, leave xi and xj alone,
+!     result will be no movement.
+         a = 0.0
+         b = 1.0
+         grid%xi =  (a * grid%xi + b * (is + ipbar / pbar))  / ( a + b )
+         grid%xj =  (a * grid%xj + b * (js + jpbar / pbar))  / ( a + b )
+
+         grid%vc_i = grid%xi + .5
+         grid%vc_j = grid%xj + .5
+
+
+      ENDIF
+
+#  ifdef MOVING_DIAGS
+write(0,*)'computed grid%vc_i, grid%vc_j ',grid%vc_i, grid%vc_j
+i = grid%vc_i ; j = grid%vc_j ; height( i,j ) = height(i,j) * 1.2   !mark the center
+CALL domain_clock_get( grid, current_timestr=message2 )
+WRITE ( message , FMT = '(A," on domain ",I3)' ) TRIM(message2), grid%id
+#  endif
+
+! 
+        i = INT(grid%xi+.5)
+        j = INT(grid%xj+.5)
+        write(mess,'("ATCF"," ",A19," ",f8.2," ",f8.2," ",f6.1," ",f6.1)')                &
+                                       timestr(1:19),                               &
+                                       xlat(i,j),                                   &
+                                       xlong(i,j),                                  &
+                                       0.01*pmin+0.1138*terrain(imploc,jmploc),     &
+                                       maxws*1.94
+        CALL wrf_message(TRIM(mess))
+                            
+
+
+     ENDIF monitor_only
+
+     DEALLOCATE ( psfc )
+     DEALLOCATE ( xlat )
+     DEALLOCATE ( xlong )
+     DEALLOCATE ( terrain )
+     DEALLOCATE ( height )
+     DEALLOCATE ( height_l )
+
+     CALL wrf_dm_bcast_real( grid%vc_i , 1 )
+     CALL wrf_dm_bcast_real( grid%vc_j , 1 )
+
+     CALL wrf_dm_bcast_real( pmin , 1 )
+     CALL wrf_dm_bcast_integer( imploc , 1 )
+     CALL wrf_dm_bcast_integer( jmploc , 1 )
+
+#  ifdef MOVING_DIAGS
+write(0,*)'after bcast : grid%vc_i, grid%vc_j ',grid%vc_i, grid%vc_j
+#  endif
+
+
+   ENDIF   ! COMPUTE_VORTEX_CENTER_ALARM ringing
+
+#  ifdef MOVING_DIAGS
+write(0,*)'After ENDIF : grid%vc_i, grid%vc_j ',grid%vc_i, grid%vc_j
+#  endif
+
+   dc_i = (ide-ids+1)/2.    ! domain center
+   dc_j = (jde-jds+1)/2.
+
+   disp_x = grid%vc_i - dc_i * 1.0
+   disp_y = grid%vc_j - dc_j * 1.0
+
+#if 0
+! This appears to be an old, redundant, and perhaps even misnamed parameter. 
+! Remove it from the namelist and Registry and just hard code it to 
+! the default of 6. JM 20050721
+   CALL nl_get_vortex_search_radius( 1, irad )
+#else
+   irad = 6
+#endif
+
+   radius = irad
+
+   if ( disp_x .GT. 0 ) disp_x = min( disp_x , radius )
+   if ( disp_y .GT. 0 ) disp_y = min( disp_y , radius )
+
+   if ( disp_x .LT. 0 ) disp_x = max( disp_x , -radius )
+   if ( disp_y .LT. 0 ) disp_y = max( disp_y , -radius )
+
+   move_cd_x = int ( disp_x  / pgr )
+   move_cd_y = int ( disp_y  / pgr )
+
+   IF ( move_cd_x .GT. 0 ) move_cd_x = min ( move_cd_x , 1 )
+   IF ( move_cd_y .GT. 0 ) move_cd_y = min ( move_cd_y , 1 )
+   IF ( move_cd_x .LT. 0 ) move_cd_x = max ( move_cd_x , -1 )
+   IF ( move_cd_y .LT. 0 ) move_cd_y = max ( move_cd_y , -1 )
+
+   CALL domain_clock_get( grid, current_timestr=timestr )
+
+   WRITE(mess,*)timestr(1:19),' vortex center (in nest x and y): ',grid%vc_i, grid%vc_j
+   CALL wrf_message(TRIM(mess))
+   WRITE(mess,*)timestr(1:19),' grid   center (in nest x and y): ',     dc_i,      dc_j
+   CALL wrf_message(TRIM(mess))
+   WRITE(mess,*)timestr(1:19),' disp          : ',   disp_x,    disp_y
+   CALL wrf_message(TRIM(mess))
+   WRITE(mess,*)timestr(1:19),' move (rel cd) : ',move_cd_x, move_cd_y
+   CALL wrf_message(TRIM(mess))
+
+   grid%vc_i = grid%vc_i - move_cd_x * pgr
+   grid%vc_j = grid%vc_j - move_cd_y * pgr
+
+#  ifdef MOVING_DIAGS
+write(0,*)' changing grid%vc_i,  move_cd_x * pgr ', grid%vc_i, move_cd_x * pgr, move_cd_x, pgr
+#  endif
+
+   IF ( ( move_cd_x .NE. 0 ) .OR. ( move_cd_y .NE. 0 ) ) THEN
+     time_for_move2 = .TRUE.
+   ELSE
+     time_for_move2 = .FALSE.
+   ENDIF
+
+# else
+! from namelist
+   move_cd_x = 0
+   move_cd_y = 0
+   time_for_move2 = .FALSE.
+   CALL domain_clock_get( grid, current_time=ct, start_time=st )
+   CALL nl_get_num_moves( 1, num_moves )
+   IF ( num_moves .GT. max_moves ) THEN
+     WRITE(mess,*)'time_for_moves2: num_moves (',num_moves,') .GT. max_moves (',max_moves,')'
+     CALL wrf_error_fatal( TRIM(mess) )
+   ENDIF
+   DO i = 1, num_moves
+     CALL nl_get_move_id( i, move_id )
+     IF ( move_id .EQ. grid%id ) THEN
+       CALL nl_get_move_interval( i, move_interval )
+       IF ( move_interval .LT. 999999999 ) THEN
+         CALL WRFU_TimeIntervalSet ( ti, M=move_interval, rc=rc )
+         IF ( ct .GE. st + ti ) THEN
+           CALL nl_get_move_cd_x ( i, move_cd_x )
+           CALL nl_get_move_cd_y ( i, move_cd_y )
+           CALL nl_set_move_interval ( i, 999999999 )
+           time_for_move2 = .TRUE.
+           EXIT
+         ENDIF
+       ENDIF
+     ENDIF
+   ENDDO
+# endif
+   RETURN
+#endif
+END FUNCTION time_for_move2
+
+LOGICAL FUNCTION time_for_move ( parent , grid , move_cd_x, move_cd_y )
+   USE module_domain
+   USE module_configure
+   USE module_dm
+USE module_timing
+   USE module_utility
+   IMPLICIT NONE
+! arguments
+   TYPE(domain) , POINTER    :: parent, grid, par, nst
+   INTEGER, INTENT(OUT)      :: move_cd_x , move_cd_y
+#ifdef MOVE_NESTS
+! local
+   INTEGER     :: corral_dist, kid
+   INTEGER     :: dw, de, ds, dn, pgr
+   INTEGER     :: would_move_x, would_move_y
+   INTEGER     :: cids, cide, cjds, cjde, ckds, ckde, &
+                  cims, cime, cjms, cjme, ckms, ckme, &
+                  cips, cipe, cjps, cjpe, ckps, ckpe, &
+                  nids, nide, njds, njde, nkds, nkde, &
+                  nims, nime, njms, njme, nkms, nkme, &
+                  nips, nipe, njps, njpe, nkps, nkpe
+! interface
+   INTERFACE
+     LOGICAL FUNCTION time_for_move2 ( parent , nest , dx , dy )
+        USE module_domain
+        USE module_utility
+        TYPE(domain) , POINTER    :: parent , nest
+        INTEGER, INTENT(OUT)      :: dx , dy
+     END FUNCTION time_for_move2
+   END INTERFACE
+! executable
+! 
+! Simplifying assumption: domains in moving nest simulations have only 
+! one parent and only one child.
+
+   IF   ( grid%num_nests .GT. 1 ) THEN
+     CALL wrf_error_fatal ( 'domains in moving nest simulations can have only 1 nest' )
+   ENDIF
+   kid = 1
+!
+! find out if this is the innermost nest (will not have kids)
+   IF   ( grid%num_nests .EQ. 0 ) THEN
+     ! code that executes on innermost nest
+     time_for_move = time_for_move2 ( parent , grid , move_cd_x, move_cd_y )
+
+     ! Make sure the parent can move before allowing the nest to approach
+     ! its boundary
+     par => grid%parents(1)%ptr
+     nst => grid
+
+     would_move_x = move_cd_x 
+     would_move_y = move_cd_y
+
+     ! top of until loop
+100  CONTINUE
+       CALL nl_get_corral_dist ( nst%id , corral_dist )
+       CALL get_ijk_from_grid (  nst ,                               &
+                                 nids, nide, njds, njde, nkds, nkde, &
+                                 nims, nime, njms, njme, nkms, nkme, &
+                                 nips, nipe, njps, njpe, nkps, nkpe  )
+       CALL get_ijk_from_grid (  par ,                               &
+                                 cids, cide, cjds, cjde, ckds, ckde, &
+                                 cims, cime, cjms, cjme, ckms, ckme, &
+                                 cips, cipe, cjps, cjpe, ckps, ckpe  )
+       CALL nl_get_parent_grid_ratio ( nst%id , pgr )
+       ! perform measurements...
+       !  from western boundary
+       dw = nst%i_parent_start + would_move_x - cids
+       !  from southern boundary
+       ds = nst%j_parent_start + would_move_y - cjds
+       !  from eastern boundary
+       de = cide - ( nst%i_parent_start + (nide-nids+1)/pgr + would_move_x )
+       !  from northern boundary
+       dn = cjde - ( nst%j_parent_start + (njde-njds+1)/pgr + would_move_y )
+
+       ! would this generate a move on the parent?
+       would_move_x = 0
+       would_move_y = 0
+       if ( dw .LE. corral_dist ) would_move_x = would_move_x - 1
+       if ( de .LE. corral_dist ) would_move_x = would_move_x + 1
+       if ( ds .LE. corral_dist ) would_move_y = would_move_y - 1
+       if ( dn .LE. corral_dist ) would_move_y = would_move_y + 1
+
+     IF ( par%id .EQ. 1 ) THEN
+         IF ( would_move_x .NE. 0 .AND. move_cd_x .NE. 0 ) THEN
+           CALL wrf_message('MOAD can not move. Cancelling nest move in X')
+           if ( grid%num_nests .eq. 0 ) grid%vc_i = grid%vc_i + move_cd_x * pgr  ! cancel effect of move
+           move_cd_x = 0
+         ENDIF
+         IF ( would_move_y .NE. 0 .AND. move_cd_y .NE. 0 ) THEN
+           CALL wrf_message('MOAD can not move. Cancelling nest move in Y')
+           if ( grid%num_nests .eq. 0 ) grid%vc_j = grid%vc_j + move_cd_y * pgr  ! cancel effect of move
+           move_cd_y = 0
+         ENDIF
+     ELSE
+         nst => par
+         par => nst%parents(1)%ptr
+         GOTO 100
+     ENDIF
+
+! bottom of until loop
+     time_for_move = ( move_cd_x .NE. 0 ) .OR. ( move_cd_y .NE. 0 )
+
+   ELSE
+     ! code that executes on parent to see if parent needs to move
+     ! get closest number of cells we'll allow nest edge to approach parent bdy
+     CALL nl_get_corral_dist ( grid%nests(kid)%ptr%id , corral_dist )
+     ! get dims
+     CALL get_ijk_from_grid (  grid%nests(kid)%ptr ,               &
+                               nids, nide, njds, njde, nkds, nkde, &
+                               nims, nime, njms, njme, nkms, nkme, &
+                               nips, nipe, njps, njpe, nkps, nkpe  )
+     CALL get_ijk_from_grid (  grid ,                              &
+                               cids, cide, cjds, cjde, ckds, ckde, &
+                               cims, cime, cjms, cjme, ckms, ckme, &
+                               cips, cipe, cjps, cjpe, ckps, ckpe  )
+     CALL nl_get_parent_grid_ratio ( grid%nests(kid)%ptr%id , pgr )
+     ! perform measurements...
+     !  from western boundary
+     dw = grid%nests(kid)%ptr%i_parent_start - 1
+     !  from southern boundary
+     ds = grid%nests(kid)%ptr%j_parent_start - 1
+     !  from eastern boundary
+     de = cide - ( grid%nests(kid)%ptr%i_parent_start + (nide-nids+1)/pgr )
+     !  from northern boundary
+     dn = cjde - ( grid%nests(kid)%ptr%j_parent_start + (njde-njds+1)/pgr )
+
+     ! move this domain (the parent containing the moving nest)
+     ! in a direction that reestablishes the distance from 
+     ! the boundary.
+     move_cd_x = 0
+     move_cd_y = 0
+     if ( dw .LE. corral_dist ) move_cd_x = move_cd_x - 1
+     if ( de .LE. corral_dist ) move_cd_x = move_cd_x + 1
+     if ( ds .LE. corral_dist ) move_cd_y = move_cd_y - 1
+     if ( dn .LE. corral_dist ) move_cd_y = move_cd_y + 1
+
+     time_for_move = ( move_cd_x .NE. 0 ) .OR. ( move_cd_y .NE. 0 )
+
+     IF ( time_for_move ) THEN
+       IF ( grid%id .EQ. 1 ) THEN
+
+         CALL wrf_message( 'DANGER: Nest has moved too close to boundary of outermost domain.' )
+         time_for_move = .FALSE.
+
+       ELSE
+         ! need to adjust the intermediate domain of the nest in relation to this
+         ! domain since we're moving
+
+         CALL wrf_dm_move_nest ( grid , grid%nests(kid)%ptr%intermediate_grid , -move_cd_x*pgr, -move_cd_y*pgr )
+         CALL adjust_domain_dims_for_move( grid%nests(kid)%ptr%intermediate_grid , -move_cd_x*pgr, -move_cd_y*pgr )
+         grid%nests(kid)%ptr%i_parent_start = grid%nests(kid)%ptr%i_parent_start - move_cd_x*pgr
+         CALL nl_set_i_parent_start( grid%nests(kid)%ptr%id, grid%nests(kid)%ptr%i_parent_start )
+         grid%nests(kid)%ptr%j_parent_start = grid%nests(kid)%ptr%j_parent_start - move_cd_y*pgr
+         CALL nl_set_j_parent_start( grid%nests(kid)%ptr%id, grid%nests(kid)%ptr%j_parent_start )
+
+       ENDIF
+     ENDIF 
+
+   ENDIF
+
+   RETURN
+#endif
+END FUNCTION time_for_move
+
+! Put any tests for non-moving options or conditions in here
+LOGICAL FUNCTION should_not_move ( id )
+  USE module_state_description
+  USE module_configure
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: id
+ ! Local
+  LOGICAL retval
+  INTEGER cu_physics, ra_sw_physics, ra_lw_physics, ucmcall, obs_nudge_opt
+
+  retval = .FALSE.
+! check for GD ensemble cumulus, which can not move
+  CALL nl_get_cu_physics( id , cu_physics )
+  IF ( cu_physics .EQ. GDSCHEME ) THEN
+    CALL wrf_message('Grell cumulus can not be specified with moving nests. Movement disabled.')
+    retval = .TRUE.
+  ENDIF
+! check for CAM radiation scheme , which can not move
+  CALL nl_get_ra_sw_physics( id , ra_sw_physics )
+  IF ( ra_sw_physics .EQ. CAMSWSCHEME ) THEN
+    CALL wrf_message('CAM SW radiation can not be specified with moving nests. Movement disabled.')
+    retval = .TRUE.
+  ENDIF
+  CALL nl_get_ra_lw_physics( id , ra_lw_physics )
+  IF ( ra_lw_physics .EQ. CAMLWSCHEME ) THEN
+    CALL wrf_message('CAM LW radiation can not be specified with moving nests. Movement disabled.')
+    retval = .TRUE.
+  ENDIF
+! check for urban canopy Noah LSM, which can not move
+  CALL nl_get_ucmcall( id , ucmcall )
+  IF ( ucmcall .EQ. 1 ) THEN
+    CALL wrf_message('UCM Noah LSM can not be specified with moving nests. Movement disabled.')
+    retval = .TRUE.
+  ENDIF
+! check for observation nudging, which can not move
+  CALL nl_get_obs_nudge_opt( id , obs_nudge_opt )
+  IF ( obs_nudge_opt .EQ. 1 ) THEN
+    CALL wrf_message('Observation nudging can not be specified with moving nests. Movement disabled.')
+    retval = .TRUE.
+  ENDIF
+  should_not_move = retval
+END FUNCTION
+
Index: trunk/WRF.COMMON/WRFV2/share/mediation_wrfmain.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/mediation_wrfmain.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/mediation_wrfmain.F	(revision 2744)
@@ -0,0 +1,189 @@
+!WRF:MEDIATION_LAYER:
+!
+
+SUBROUTINE med_initialdata_input_ptr ( grid , config_flags )
+   USE module_domain
+   USE module_configure
+   IMPLICIT NONE
+   TYPE (domain) , POINTER :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+   INTERFACE 
+      SUBROUTINE med_initialdata_input ( grid , config_flags )
+         USE module_domain
+         USE module_configure
+         TYPE (domain) :: grid
+         TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
+      END SUBROUTINE med_initialdata_input
+   END INTERFACE
+   CALL  med_initialdata_input ( grid , config_flags )
+
+
+END SUBROUTINE med_initialdata_input_ptr
+
+SUBROUTINE med_initialdata_input ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+   USE module_timing
+  ! Model layer
+   USE module_configure
+   USE module_bc_time_utilities
+   USE module_utility
+
+   IMPLICIT NONE
+
+
+  ! Interface 
+   INTERFACE
+     SUBROUTINE start_domain ( grid , allowed_to_read )  ! comes from module_start in appropriate dyn_ directory
+       USE module_domain
+       TYPE (domain) grid
+       LOGICAL, INTENT(IN) :: allowed_to_read 
+     END SUBROUTINE start_domain
+   END INTERFACE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+  ! Local
+   INTEGER                :: fid , ierr , myproc
+   CHARACTER (LEN=80)     :: inpname , rstname, timestr
+   CHARACTER (LEN=80)     :: message
+   LOGICAL                :: restart
+
+
+   CALL nl_get_restart( 1, restart )
+   IF ( .NOT. restart ) THEN
+     !  Initialize the mother domain.
+     grid%input_from_file = .true.
+     IF ( grid%input_from_file ) THEN
+
+        CALL       wrf_debug ( 1 , 'wrf main: calling open_r_dataset for wrfinput' )
+
+! typically <date> will not be part of input_inname but allow for it
+        CALL domain_clock_get( grid, current_timestr=timestr )
+        CALL construct_filename2a ( inpname , config_flags%input_inname , grid%id , 2 , timestr )
+
+        CALL open_r_dataset ( fid, TRIM(inpname) , grid , config_flags , "DATASET=INPUT", ierr )
+        IF ( ierr .NE. 0 ) THEN
+          WRITE( wrf_err_message , * ) 'program wrf: error opening ',TRIM(inpname),' for reading ierr=',ierr
+          CALL WRF_ERROR_FATAL ( wrf_err_message )
+        ENDIF
+        IF      ( ( grid%id .EQ. 1 ) .OR. ( config_flags%fine_input_stream .EQ. 0 ) ) THEN
+           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_model_input' )
+           CALL input_model_input      ( fid ,  grid , config_flags , ierr )
+           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_model_input' )
+        ELSE IF   ( config_flags%fine_input_stream .EQ. 1 ) THEN
+           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input1' )
+           CALL input_aux_model_input1 ( fid ,   grid , config_flags , ierr )
+           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input1' )
+        ELSE IF   ( config_flags%fine_input_stream .EQ. 2 ) THEN
+           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input2' )
+           CALL input_aux_model_input2 ( fid ,   grid , config_flags , ierr )
+           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input2' )
+        ELSE IF   ( config_flags%fine_input_stream .EQ. 3 ) THEN
+           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input3' )
+           CALL input_aux_model_input3 ( fid ,   grid , config_flags , ierr )
+           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input3' )
+        ELSE IF   ( config_flags%fine_input_stream .EQ. 4 ) THEN
+           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input4' )
+           CALL input_aux_model_input4 ( fid ,   grid , config_flags , ierr )
+           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input4' )
+        ELSE IF   ( config_flags%fine_input_stream .EQ. 5 ) THEN
+           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input5' )
+           CALL input_aux_model_input5 ( fid ,   grid , config_flags , ierr )
+           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input5' )
+        END IF
+        CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
+#ifdef MOVE_NESTS
+        grid%nest_pos = grid%ht
+        where ( grid%nest_pos .gt. 0 ) grid%nest_pos = grid%nest_pos + 500.  ! make a cliff
+#endif
+     ENDIF
+     grid%imask_nostag = 1
+     grid%imask_xstag = 1
+     grid%imask_ystag = 1
+     grid%imask_xystag = 1
+     CALL start_domain ( grid , .TRUE. )
+   ELSE
+     CALL domain_clock_get( grid, current_timestr=timestr )
+     CALL construct_filename2a ( rstname , config_flags%rst_inname , grid%id , 2 , timestr )
+
+     WRITE(message,*)'RESTART run: opening ',TRIM(rstname),' for reading'
+     CALL wrf_message (  message )
+     CALL open_r_dataset ( fid , TRIM(rstname) , grid , config_flags , "DATASET=RESTART", ierr )
+     IF ( ierr .NE. 0 ) THEN
+       WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
+       CALL WRF_ERROR_FATAL ( message )
+     ENDIF
+     CALL input_restart ( fid,   grid , config_flags , ierr )
+     CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
+     grid%imask_nostag = 1
+     grid%imask_xstag = 1
+     grid%imask_ystag = 1
+     grid%imask_xystag = 1
+     CALL start_domain ( grid , .TRUE. )
+   ENDIF
+
+   RETURN
+END SUBROUTINE med_initialdata_input
+
+SUBROUTINE med_shutdown_io ( grid , config_flags )
+  ! Driver layer
+   USE module_domain
+   USE module_io_domain
+  ! Model layer
+   USE module_configure
+
+   IMPLICIT NONE
+
+  ! Arguments
+   TYPE(domain)                               :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
+  ! Local
+   CHARACTER (LEN=80)      :: message
+   INTEGER                 :: ierr
+
+   IF ( grid%oid > 0 ) CALL close_dataset ( grid%oid , config_flags , "DATASET=HISTORY" )
+   IF ( grid%auxhist1_oid > 0 ) CALL close_dataset ( grid%auxhist1_oid , config_flags , "DATASET=AUXHIST1" )
+   IF ( grid%auxhist2_oid > 0 ) CALL close_dataset ( grid%auxhist2_oid , config_flags , "DATASET=AUXHIST2" )
+   IF ( grid%auxhist3_oid > 0 ) CALL close_dataset ( grid%auxhist3_oid , config_flags , "DATASET=AUXHIST3" )
+   IF ( grid%auxhist4_oid > 0 ) CALL close_dataset ( grid%auxhist4_oid , config_flags , "DATASET=AUXHIST4" )
+   IF ( grid%auxhist5_oid > 0 ) CALL close_dataset ( grid%auxhist5_oid , config_flags , "DATASET=AUXHIST5" )
+#if 0
+   IF ( grid%auxhist6_oid > 0 ) CALL close_dataset ( grid%auxhist6_oid , config_flags , "DATASET=AUXHIST6" )
+   IF ( grid%auxhist7_oid > 0 ) CALL close_dataset ( grid%auxhist7_oid , config_flags , "DATASET=AUXHIST7" )
+   IF ( grid%auxhist8_oid > 0 ) CALL close_dataset ( grid%auxhist8_oid , config_flags , "DATASET=AUXHIST8" )
+   IF ( grid%auxhist9_oid > 0 ) CALL close_dataset ( grid%auxhist9_oid , config_flags , "DATASET=AUXHIST9" )
+   IF ( grid%auxhist10_oid > 0 ) CALL close_dataset ( grid%auxhist10_oid , config_flags , "DATASET=AUXHIST10" )
+   IF ( grid%auxhist11_oid > 0 ) CALL close_dataset ( grid%auxhist11_oid , config_flags , "DATASET=AUXHIST11" )
+#endif
+
+   IF ( grid%lbc_fid > 0 ) CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
+
+   CALL wrf_ioexit( ierr )    ! shut down the quilt I/O
+
+   RETURN
+
+END SUBROUTINE med_shutdown_io
+
+SUBROUTINE med_add_config_info_to_grid ( grid )
+
+   USE module_domain
+   USE module_configure
+ 
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(domain) , TARGET          :: grid
+
+#define SOURCE_RECORD model_config_rec %
+#define SOURCE_REC_DEX (grid%id)
+#define DEST_RECORD   grid %
+#include <config_assigns.inc>
+
+   RETURN
+
+END SUBROUTINE med_add_config_info_to_grid
+
Index: trunk/WRF.COMMON/WRFV2/share/module_MPP.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_MPP.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_MPP.F	(revision 2744)
@@ -0,0 +1,61 @@
+!
+      MODULE MODULE_MPP
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!
+!***  THE RANK OF THIS TASK
+!
+      INTEGER :: MYPE
+!----------------------------------------------------------------------
+!
+!***  NUMBER OF TASKS
+!
+      INTEGER :: INPES,JNPES,NPES
+!
+!***  FUNDAMENTAL GLOBAL AND LOCAL ARRAY EXTENTS ON EACH TASK
+!
+      INTEGER :: MY_IS_GLB,MY_IE_GLB,MY_JS_GLB,MY_JE_GLB               &
+                ,MY_IS_LOC,MY_IE_LOC,MY_JS_LOC,MY_JE_LOC
+!----------------------------------------------------------------------
+!
+!***  SUB-DOMAIN LOOP LIMITS THAT PENETRATE HALOES
+!
+      INTEGER :: MYIS,MYIE,MYJS,MYJE                                   &
+                ,MYIS1,MYIS2,MYIS3,MYIS4,MYIS5                         &
+                ,MYIE1,MYIE2,MYIE3,MYIE4,MYIE5                         &
+                ,MYIS_P1,MYIS_P2,MYIS_P3,MYIS_P4,MYIS_P5               &
+                ,MYIS1_P1,MYIS1_P2,MYIS1_P3,MYIS1_P4,MYIS1_P5          &
+                ,MYIS2_P1,MYIS2_P2,MYIS2_P3,MYIS2_P4,MYIS2_P5          &
+                ,MYIS3_P1,MYIS3_P2,MYIS3_P3,MYIS3_P4,MYIS3_P5          &
+                ,MYIS4_P1,MYIS4_P2,MYIS4_P3,MYIS4_P4,MYIS4_P5          &
+                ,MYIS5_P1,MYIS5_P2,MYIS5_P3,MYIS5_P4,MYIS5_P5          &
+                ,MYIE_P1,MYIE_P2,MYIE_P3,MYIE_P4,MYIE_P5               &
+                ,MYIE1_P1,MYIE1_P2,MYIE1_P3,MYIE1_P4,MYIE1_P5          &
+                ,MYIE2_P1,MYIE2_P2,MYIE2_P3,MYIE2_P4,MYIE2_P5          &
+                ,MYIE3_P1,MYIE3_P2,MYIE3_P3,MYIE3_P4,MYIE3_P5          &
+                ,MYIE4_P1,MYIE4_P2,MYIE4_P3,MYIE4_P4,MYIE4_P5          &
+                ,MYIE5_P1,MYIE5_P2,MYIE5_P3,MYIE5_P4,MYIE5_P5          &
+                ,MYJS1,MYJS2,MYJS3,MYJS4,MYJS5                         &
+                ,MYJE1,MYJE2,MYJE3,MYJE4,MYJE5                         &
+                ,MYJS_P1,MYJS_P2,MYJS_P3,MYJS_P4,MYJS_P5               &
+                ,MYJS1_P1,MYJS1_P2,MYJS1_P3,MYJS1_P4,MYJS1_P5          &
+                ,MYJS2_P1,MYJS2_P2,MYJS2_P3,MYJS2_P4,MYJS2_P5          &
+                ,MYJS3_P1,MYJS3_P2,MYJS3_P3,MYJS3_P4,MYJS3_P5          &
+                ,MYJS4_P1,MYJS4_P2,MYJS4_P3,MYJS4_P4,MYJS4_P5          &
+                ,MYJS5_P1,MYJS5_P2,MYJS5_P3,MYJS5_P4,MYJS5_P5          &
+                ,MYJE_P1,MYJE_P2,MYJE_P3,MYJE_P4,MYJE_P5               &
+                ,MYJE1_P1,MYJE1_P2,MYJE1_P3,MYJE1_P4,MYJE1_P5          &
+                ,MYJE2_P1,MYJE2_P2,MYJE2_P3,MYJE2_P4,MYJE2_P5          &
+                ,MYJE3_P1,MYJE3_P2,MYJE3_P3,MYJE3_P4,MYJE3_P5          &
+                ,MYJE4_P1,MYJE4_P2,MYJE4_P3,MYJE4_P4,MYJE4_P5          &
+                ,MYJE5_P1,MYJE5_P2,MYJE5_P3,MYJE5_P4,MYJE5_P5
+
+!
+!----------------------------------------------------------------------
+!
+!***  MPI_COMM_COMP IS THE INTRACOMMUNICATOR FOR ALL TASKS.
+!
+      INTEGER :: MPI_COMM_COMP
+
+!----------------------------------------------------------------------
+      END MODULE MODULE_MPP
Index: trunk/WRF.COMMON/WRFV2/share/module_bc.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_bc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_bc.F	(revision 2744)
@@ -0,0 +1,2217 @@
+!WRF:MODEL_LAYER:BOUNDARY
+!
+MODULE module_bc
+
+   USE module_configure
+   USE module_wrf_error
+   IMPLICIT NONE
+
+!   TYPE bcs
+!
+!     LOGICAL                     :: periodic_x
+!     LOGICAL                     :: symmetric_xs
+!     LOGICAL                     :: symmetric_xe
+!     LOGICAL                     :: open_xs
+!     LOGICAL                     :: open_xe
+!     LOGICAL                     :: periodic_y
+!     LOGICAL                     :: symmetric_ys
+!     LOGICAL                     :: symmetric_ye
+!     LOGICAL                     :: open_ys
+!     LOGICAL                     :: open_ye
+!     LOGICAL                     :: nested
+!     LOGICAL                     :: specified
+!     LOGICAL                     :: top_radiation
+!
+!   END TYPE bcs
+
+!  set the bdyzone.  We are hardwiring this here and we'll
+!  decide later where it should be set and stored
+
+   INTEGER, PARAMETER            :: bdyzone = 4
+   INTEGER, PARAMETER            :: bdyzone_x = bdyzone
+   INTEGER, PARAMETER            :: bdyzone_y = bdyzone
+
+CONTAINS
+
+  SUBROUTINE boundary_condition_check ( config_flags, bzone, error, gn )
+
+!  this routine checks the boundary condition logicals 
+!  to make sure that the boundary conditions are not over
+!  or under specified.  The routine also checks that the
+!  boundary zone is sufficiently sized for the specified
+!  boundary conditions
+
+  IMPLICIT NONE
+
+  TYPE( grid_config_rec_type ) config_flags
+
+  INTEGER, INTENT(IN   ) :: bzone, gn
+  INTEGER, INTENT(INOUT) :: error
+
+! local variables
+
+  INTEGER :: xs_bc, xe_bc, ys_bc, ye_bc, bzone_min
+  INTEGER :: nprocx, nprocy
+
+  CALL wrf_debug( 100 , ' checking boundary conditions for grid ' )
+
+  error = 0
+  xs_bc = 0
+  xe_bc = 0
+  ys_bc = 0
+  ye_bc = 0
+
+!  sum the number of conditions specified for each lateral boundary.
+!  obviously, this number should be 1
+
+  IF( config_flags%periodic_x ) THEN
+    xs_bc = xs_bc+1
+    xe_bc = xe_bc+1
+  ENDIF
+
+  IF( config_flags%periodic_y ) THEN
+    ys_bc = ys_bc+1
+    ye_bc = ye_bc+1
+  ENDIF
+
+  IF( config_flags%symmetric_xs ) xs_bc = xs_bc + 1
+  IF( config_flags%symmetric_xe ) xe_bc = xe_bc + 1
+  IF( config_flags%open_xs )      xs_bc = xs_bc + 1
+  IF( config_flags%open_xe )      xe_bc = xe_bc + 1
+
+
+  IF( config_flags%symmetric_ys ) ys_bc = ys_bc + 1
+  IF( config_flags%symmetric_ye ) ye_bc = ye_bc + 1
+  IF( config_flags%open_ys )      ys_bc = ys_bc + 1
+  IF( config_flags%open_ye )      ye_bc = ye_bc + 1
+
+  IF( config_flags%nested ) THEN
+     xs_bc = xs_bc + 1
+     xe_bc = xe_bc + 1
+     ys_bc = ys_bc + 1
+     ye_bc = ye_bc + 1
+   ENDIF
+
+  IF( config_flags%specified ) THEN
+     IF( .NOT. config_flags%periodic_x)xs_bc = xs_bc + 1
+     IF( .NOT. config_flags%periodic_x)xe_bc = xe_bc + 1
+     ys_bc = ys_bc + 1
+     ye_bc = ye_bc + 1
+   ENDIF
+
+!  check the number of conditions for each boundary
+
+   IF( (xs_bc /= 1) .or. &
+       (xe_bc /= 1) .or. &
+       (ys_bc /= 1) .or. &
+       (ye_bc /= 1)         ) THEN
+
+     error = 1
+
+     write( wrf_err_message ,*) ' *** Error in boundary condition specification '
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' boundary conditions at xs ', xs_bc
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' boundary conditions at xe ', xe_bc
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' boundary conditions at ys ', ys_bc
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' boundary conditions at ye ', ye_bc
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' boundary conditions logicals are '
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' periodic_x   ',config_flags%periodic_x
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' periodic_y   ',config_flags%periodic_y
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' symmetric_xs ',config_flags%symmetric_xs
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' symmetric_xe ',config_flags%symmetric_xe
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' symmetric_ys ',config_flags%symmetric_ys
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' symmetric_ye ',config_flags%symmetric_ye
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' open_xs      ',config_flags%open_xs
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' open_xe      ',config_flags%open_xe
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' open_ys      ',config_flags%open_ys
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' open_ye      ',config_flags%open_ye
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' nested       ',config_flags%nested
+     CALL wrf_message ( wrf_err_message )
+     write( wrf_err_message ,*) ' specified    ',config_flags%specified
+     CALL wrf_error_fatal( ' *** Error in boundary condition specification ' )
+
+   ENDIF
+
+!  now check to see if boundary zone size is sufficient.
+!  we could have the necessary boundary zone size be returned
+!  to the calling routine.
+
+   IF( config_flags%periodic_x   .or. &
+       config_flags%periodic_y   .or. &
+       config_flags%symmetric_xs .or. &
+       config_flags%symmetric_xe .or. &
+       config_flags%symmetric_ys .or. &
+       config_flags%symmetric_ye        )  THEN
+
+       bzone_min = MAX( 1,                                  &
+                        (config_flags%h_mom_adv_order+1)/2, &
+                        (config_flags%h_sca_adv_order+1)/2 )
+
+       IF( bzone < bzone_min) THEN  
+
+         error = 2
+         WRITE ( wrf_err_message , * ) ' boundary zone not large enough '
+         CALL wrf_message ( wrf_err_message )
+         WRITE ( wrf_err_message , * ) ' boundary zone specified      ',bzone
+         CALL wrf_message ( wrf_err_message )
+         WRITE ( wrf_err_message , * ) ' minimum boundary zone needed ',bzone_min
+         CALL wrf_error_fatal ( wrf_err_message )
+
+       ENDIF
+   ENDIF
+
+#ifdef RSL_LITE
+! add a check so that people do not try to specify peridic boundaries
+! if they have compiled with RSL_LITE. It does not support periodic bcs
+   CALL wrf_get_nprocx( nprocx )
+#if 0
+   IF ( nprocx .GT. 1 .AND. config_flags%periodic_x ) THEN
+     WRITE ( wrf_err_message , * ) 'RSL_LITE does not support periodic boundaries for decomposed X-dimension'
+     CALL wrf_message ( TRIM( wrf_err_message ) )
+   ENDIF
+#endif
+   CALL wrf_get_nprocy( nprocy )
+   IF ( nprocy .GT. 1 .AND. config_flags%periodic_y ) THEN
+     WRITE ( wrf_err_message , * ) 'RSL_LITE does not support periodic boundaries for decomposed Y-dimension'
+     CALL wrf_message ( TRIM( wrf_err_message ) )
+   ENDIF
+#if 0
+   IF ( (nprocy .GT. 1 .AND. config_flags%periodic_y) .OR. (nprocx .GT. 1 .AND. config_flags%periodic_x) ) THEN
+     CALL wrf_error_fatal ( 'Inappropriate selection of periodic bcs detected in boundary_condition_check' )
+   ENDIF
+#endif
+#endif
+
+   CALL wrf_debug ( 100 , ' boundary conditions OK for grid ' )
+
+   END subroutine boundary_condition_check
+
+!--------------------------------------------------------------------------
+   SUBROUTINE set_physical_bc2d( data, variable_in,  &
+                                 config_flags,           & 
+                                 ids,ide, jds,jde,   & ! domain dims
+                                 ims,ime, jms,jme,   & ! memory dims
+                                 ips,ipe, jps,jpe,   & ! patch  dims
+                                 its,ite, jts,jte   )      
+
+!  This subroutine sets the data in the boundary region, by direct
+!  assignment if possible, for periodic and symmetric (wall)
+!  boundary conditions.  Currently, we are only doing 1 variable
+!  at a time - lots of overhead, so maybe this routine can be easily 
+!  inlined later or we could pass multiple variables -
+!  would probably want a largestep and smallstep version.
+
+!  15 Jan 99, Dave
+!  Modified the incoming its,ite,jts,jte to truly be the tile size.
+!  This required modifying the loop limits when the "istag" or "jstag"
+!  is used, as this is only required at the end of the domain.
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte
+      CHARACTER,    INTENT(IN   )    :: variable_in
+
+      CHARACTER                      :: variable
+
+      REAL,  DIMENSION( ims:ime , jms:jme ) :: data
+      TYPE( grid_config_rec_type ) config_flags
+
+      INTEGER  :: i, j, istag, jstag, itime
+
+      LOGICAL  :: debug, open_bc_copy
+
+!------------
+
+      debug = .false.
+
+      open_bc_copy = .false.
+
+      variable = variable_in
+      IF ( variable_in .ge. 'A' .and. variable_in .le. 'Z' ) THEN
+        variable = CHAR( ICHAR(variable_in) - ICHAR('A') + ICHAR('a') )
+      ENDIF
+      IF ((variable == 'u') .or. (variable == 'v') .or.  &
+          (variable == 'w') .or. (variable == 't') .or.  &
+          (variable == 'x') .or. (variable == 'y') .or.  &
+          (variable == 'r') .or. (variable == 'p') ) open_bc_copy = .true.
+
+!  begin, first set a staggering variable
+
+      istag = -1
+      jstag = -1
+
+      IF ((variable == 'u') .or. (variable == 'x')) istag = 0
+      IF ((variable == 'v') .or. (variable == 'y')) jstag = 0
+
+      if(debug) then
+        write(6,*) ' in bc2d, var is ',variable, istag, jstag
+        write(6,*) ' b.cs are ',  &
+      config_flags%periodic_x,  &
+      config_flags%periodic_y
+      end if
+      
+
+
+!  periodic conditions.
+!  note, patch must cover full range in periodic dir, or else
+!  its intra-patch communication that is handled elsewheres.
+!  symmetry conditions can always be handled here, because no
+!  outside patch communication is needed
+
+      periodicity_x:  IF( ( config_flags%periodic_x ) ) THEN 
+        IF ( ( ids == ips ) .and.  ( ide == ipe ) ) THEN  ! test if east and west both on-processor 
+          IF ( its == ids ) THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+            DO i = 0,-(bdyzone-1),-1
+              data(ids+i-1,j) = data(ide+i-1,j)
+            ENDDO
+            ENDDO
+
+          ENDIF
+
+          IF ( ite == ide ) THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+!!          DO i = 1 , bdyzone
+            DO i = -istag , bdyzone
+              data(ide+i+istag,j) = data(ids+i+istag,j)
+            ENDDO
+            ENDDO
+
+          ENDIF
+        ENDIF
+
+      ELSE 
+
+        symmetry_xs: IF( ( config_flags%symmetric_xs ) .and.  &
+                         ( its == ids )                  )  THEN
+
+          IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+            DO i = 1, bdyzone
+              data(ids-i,j) = data(ids+i-1,j) !  here, data(0) = data(1), etc
+            ENDDO                             !  symmetry about data(0.5) (u=0 pt)
+            ENDDO
+
+          ELSE
+
+            IF( variable == 'u' ) THEN
+
+              DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              DO i = 0, bdyzone-1
+                data(ids-i,j) = - data(ids+i,j) ! here, u(0) = - u(2), etc
+              ENDDO                             !  normal b.c symmetry at u(1)
+              ENDDO
+
+            ELSE
+
+              DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              DO i = 0, bdyzone-1
+                data(ids-i,j) =   data(ids+i,j) ! here, phi(0) = phi(2), etc
+              ENDDO                             !  normal b.c symmetry at phi(1)
+              ENDDO
+
+            END IF
+
+          ENDIF
+
+        ENDIF symmetry_xs
+
+
+!  now the symmetry boundary at xe
+
+        symmetry_xe: IF( ( config_flags%symmetric_xe ) .and.  &
+                         ( ite == ide )                  )  THEN
+
+          IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+            DO i = 1, bdyzone
+              data(ide+i-1,j) = data(ide-i,j)  !  sym. about data(ide-0.5)
+            ENDDO
+            ENDDO
+
+          ELSE
+
+            IF (variable == 'u' ) THEN
+
+              DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              DO i = 0, bdyzone-1
+                data(ide+i,j) = - data(ide-i,j)  ! u(ide+1) = - u(ide-1), etc.
+              ENDDO
+              ENDDO
+
+
+            ELSE
+
+              DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              DO i = 0, bdyzone-1
+                data(ide+i,j) = data(ide-i,j)  !  phi(ide+1) = phi(ide-1), etc.
+              ENDDO
+              ENDDO
+
+            END IF
+
+          END IF 
+
+        END IF symmetry_xe
+
+
+!  set open b.c in X copy into boundary zone here.  WCS, 19 March 2000
+
+        open_xs: IF( ( config_flags%open_xs   .or. &
+                       config_flags%specified .or. &
+                       config_flags%nested            ) .and.  &
+                         ( its == ids ) .and. open_bc_copy  )  THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              data(ids-1,j) = data(ids,j) !  here, data(0) = data(1)
+              data(ids-2,j) = data(ids,j)
+              data(ids-3,j) = data(ids,j)
+            ENDDO
+
+        ENDIF open_xs
+
+
+!  now the open boundary copy at xe
+
+        open_xe: IF( ( config_flags%open_xe   .or. &
+                       config_flags%specified .or. &
+                       config_flags%nested            ) .and.  &
+                          ( ite == ide ) .and. open_bc_copy  )  THEN
+
+          IF ( variable /= 'u' .and. variable /= 'x') THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              data(ide  ,j) = data(ide-1,j) 
+              data(ide+1,j) = data(ide-1,j) 
+              data(ide+2,j) = data(ide-1,j) 
+            ENDDO
+
+          ELSE
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              data(ide+1,j) = data(ide,j)
+              data(ide+2,j) = data(ide,j)
+              data(ide+3,j) = data(ide,j)
+            ENDDO
+
+          END IF 
+
+        END IF open_xe
+
+!  end open b.c in X copy into boundary zone addition.  WCS, 19 March 2000
+
+      END IF periodicity_x
+
+!  same procedure in y
+
+      periodicity_y:  IF( ( config_flags%periodic_y ) ) THEN
+        IF ( ( jds == jps ) .and. ( jde == jpe ) )  THEN    ! test of both north and south on processor
+
+          IF( jts == jds ) then
+
+            DO j = 0, -(bdyzone-1), -1
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,jds+j-1) = data(i,jde+j-1)
+            ENDDO
+            ENDDO
+
+          END IF
+
+          IF( jte == jde ) then
+
+            DO j = -jstag, bdyzone
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,jde+j+jstag) = data(i,jds+j+jstag)
+            ENDDO
+            ENDDO
+
+          END IF
+
+        END IF
+
+      ELSE
+
+        symmetry_ys: IF( ( config_flags%symmetric_ys ) .and.  &
+                         ( jts == jds)                   )  THEN
+
+          IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
+
+            DO j = 1, bdyzone
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,jds-j) = data(i,jds+j-1) 
+            ENDDO
+            ENDDO
+
+          ELSE
+
+            IF (variable == 'v') THEN
+
+              DO j = 1, bdyzone
+              DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+                data(i,jds-j) = - data(i,jds+j) 
+              ENDDO              
+              ENDDO
+
+            ELSE
+
+              DO j = 1, bdyzone
+              DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+                data(i,jds-j) = data(i,jds+j) 
+              ENDDO              
+              ENDDO
+
+            END IF
+
+          ENDIF
+
+        ENDIF symmetry_ys
+
+!  now the symmetry boundary at ye
+
+        symmetry_ye: IF( ( config_flags%symmetric_ye ) .and.  &
+                         ( jte == jde )                  )  THEN
+
+          IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
+
+            DO j = 1, bdyzone
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,jde+j-1) = data(i,jde-j) 
+            ENDDO                               
+            ENDDO
+
+          ELSE
+
+            IF (variable == 'v' ) THEN
+
+              DO j = 1, bdyzone
+              DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+                data(i,jde+j) = - data(i,jde-j)    ! bugfix: changed jds on rhs to jde , JM 20020410
+              ENDDO                               
+              ENDDO
+
+            ELSE
+
+              DO j = 1, bdyzone
+              DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+                data(i,jde+j) = data(i,jde-j)
+              ENDDO                               
+              ENDDO
+
+            END IF
+
+          ENDIF
+
+        END IF symmetry_ye
+
+!  set open b.c in Y copy into boundary zone here.  WCS, 19 March 2000
+
+        open_ys: IF( ( config_flags%open_ys   .or. &
+                       config_flags%specified .or. &
+                       config_flags%nested            ) .and.  &
+                         ( jts == jds) .and. open_bc_copy )  THEN
+
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,jds-1) = data(i,jds) 
+              data(i,jds-2) = data(i,jds) 
+              data(i,jds-3) = data(i,jds) 
+            ENDDO
+
+        ENDIF open_ys
+
+!  now the open boundary copy at ye
+
+        open_ye: IF( ( config_flags%open_ye   .or. &
+                       config_flags%specified .or. &
+                       config_flags%nested            ) .and.  &
+                         ( jte == jde ) .and. open_bc_copy )  THEN
+
+          IF  (variable /= 'v' .and. variable /= 'y' ) THEN
+
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,jde  ) = data(i,jde-1) 
+              data(i,jde+1) = data(i,jde-1) 
+              data(i,jde+2) = data(i,jde-1) 
+            ENDDO                               
+
+          ELSE
+
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,jde+1) = data(i,jde) 
+              data(i,jde+2) = data(i,jde) 
+              data(i,jde+3) = data(i,jde) 
+            ENDDO                               
+
+          ENDIF
+
+        END IF open_ye
+      
+!  end open b.c in Y copy into boundary zone addition.  WCS, 19 March 2000
+
+      END IF periodicity_y
+
+!  fix corners for doubly periodic domains
+
+      IF ( config_flags%periodic_x .and. config_flags%periodic_y &
+           .and. (ids == ips) .and. (ide == ipe)                 &
+           .and. (jds == jps) .and. (jde == jpe)                   ) THEN
+
+         IF ( (its == ids) .and. (jts == jds) ) THEN  ! lower left corner fill
+           DO j = 0, -(bdyzone-1), -1
+           DO i = 0, -(bdyzone-1), -1
+             data(ids+i-1,jds+j-1) = data(ide+i-1,jde+j-1)
+           ENDDO
+           ENDDO
+         END IF
+
+         IF ( (ite == ide) .and. (jts == jds) ) THEN  ! lower right corner fill
+           DO j = 0, -(bdyzone-1), -1
+           DO i = 1, bdyzone
+             data(ide+i+istag,jds+j-1) = data(ids+i+istag,jde+j-1)
+           ENDDO
+           ENDDO
+         END IF
+
+         IF ( (ite == ide) .and. (jte == jde) ) THEN  ! upper right corner fill
+           DO j = 1, bdyzone
+           DO i = 1, bdyzone
+             data(ide+i+istag,jde+j+jstag) = data(ids+i+istag,jds+j+jstag)
+           ENDDO
+           ENDDO
+         END IF
+
+         IF ( (its == ids) .and. (jte == jde) ) THEN  ! upper left corner fill
+           DO j = 1, bdyzone
+           DO i = 0, -(bdyzone-1), -1
+             data(ids+i-1,jde+j+jstag) = data(ide+i-1,jds+j+jstag)
+           ENDDO
+           ENDDO
+         END IF
+
+       END IF
+
+   END SUBROUTINE set_physical_bc2d
+
+!-----------------------------------
+
+   SUBROUTINE set_physical_bc3d( data, variable_in,        &
+                               config_flags,                   & 
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+!  This subroutine sets the data in the boundary region, by direct
+!  assignment if possible, for periodic and symmetric (wall)
+!  boundary conditions.  Currently, we are only doing 1 variable
+!  at a time - lots of overhead, so maybe this routine can be easily 
+!  inlined later or we could pass multiple variables -
+!  would probably want a largestep and smallstep version.
+
+!  15 Jan 99, Dave
+!  Modified the incoming its,ite,jts,jte to truly be the tile size.
+!  This required modifying the loop limits when the "istag" or "jstag"
+!  is used, as this is only required at the end of the domain.
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+      CHARACTER,    INTENT(IN   )    :: variable_in
+
+      CHARACTER                      :: variable
+
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ) :: data
+      TYPE( grid_config_rec_type ) config_flags
+
+      INTEGER  :: i, j, k, istag, jstag, itime, k_end
+
+      LOGICAL  :: debug, open_bc_copy
+
+!------------
+
+      debug = .false.
+
+      open_bc_copy = .false.
+
+      variable = variable_in
+      IF ( variable_in .ge. 'A' .and. variable_in .le. 'Z' ) THEN
+        variable = CHAR( ICHAR(variable_in) - ICHAR('A') + ICHAR('a') )
+      ENDIF
+
+      IF ((variable == 'u') .or. (variable == 'v') .or.     &
+          (variable == 'w') .or. (variable == 't') .or.     &
+          (variable == 'd') .or. (variable == 'e') .or. &
+          (variable == 'x') .or. (variable == 'y') .or. &
+          (variable == 'f') .or. (variable == 'r') .or. &
+          (variable == 'p')                        ) open_bc_copy = .true.
+
+!  begin, first set a staggering variable
+
+      istag = -1
+      jstag = -1
+      k_end = max(1,min(kde-1,kte))
+
+
+      IF ((variable == 'u') .or. (variable == 'x')) istag = 0
+      IF ((variable == 'v') .or. (variable == 'y')) jstag = 0
+      IF ((variable == 'd') .or. (variable == 'xy')) then
+         istag = 0
+         jstag = 0
+      ENDIF
+      IF ((variable == 'e') ) then
+         istag = 0
+         k_end = min(kde,kte)
+      ENDIF
+
+      IF ((variable == 'f') ) then
+         jstag = 0
+         k_end = min(kde,kte)
+      ENDIF
+
+      IF ( variable == 'w')  k_end = min(kde,kte)
+
+!      k_end = kte
+
+      if(debug) then
+        write(6,*) ' in bc, var is ',variable, istag, jstag, kte, k_end
+        write(6,*) ' b.cs are ',  &
+      config_flags%periodic_x,  &
+      config_flags%periodic_y
+      end if
+      
+
+
+!  periodic conditions.
+!  note, patch must cover full range in periodic dir, or else
+!  its intra-patch communication that is handled elsewheres.
+!  symmetry conditions can always be handled here, because no
+!  outside patch communication is needed
+
+      periodicity_x:  IF( ( config_flags%periodic_x ) ) THEN
+
+        IF ( ( ids == ips ) .and. ( ide == ipe ) ) THEN  ! test if both east and west on-processor
+          IF ( its == ids ) THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+            DO k = kts, k_end
+            DO i = 0,-(bdyzone-1),-1
+              data(ids+i-1,k,j) = data(ide+i-1,k,j)
+            ENDDO
+            ENDDO
+            ENDDO
+
+          ENDIF
+
+
+          IF ( ite == ide ) THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+            DO k = kts, k_end
+            DO i = -istag , bdyzone
+              data(ide+i+istag,k,j) = data(ids+i+istag,k,j)
+            ENDDO
+            ENDDO
+            ENDDO
+
+          ENDIF
+
+        ENDIF
+
+      ELSE 
+
+        symmetry_xs: IF( ( config_flags%symmetric_xs ) .and.  &
+                         ( its == ids )                  )  THEN
+
+          IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+            DO k = kts, k_end
+            DO i = 1, bdyzone
+              data(ids-i,k,j) = data(ids+i-1,k,j) !  here, data(0) = data(1), etc
+            ENDDO                                 !  symmetry about data(0.5) (u = 0 pt)
+            ENDDO
+            ENDDO
+
+          ELSE
+
+            IF ( variable == 'u' ) THEN
+
+              DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              DO k = kts, k_end
+              DO i = 1, bdyzone
+                data(ids-i,k,j) = - data(ids+i,k,j) ! here, u(0) = - u(2), etc
+              ENDDO                                 !  normal b.c symmetry at u(1)
+              ENDDO
+              ENDDO
+
+            ELSE
+
+              DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              DO k = kts, k_end
+              DO i = 1, bdyzone
+                data(ids-i,k,j) = data(ids+i,k,j) ! here, phi(0) = phi(2), etc
+              ENDDO                               !  normal b.c symmetry at phi(1)
+              ENDDO
+              ENDDO
+
+            END IF
+
+          ENDIF
+
+        ENDIF symmetry_xs
+
+
+!  now the symmetry boundary at xe
+
+        symmetry_xe: IF( ( config_flags%symmetric_xe ) .and.  &
+                         ( ite == ide )                  )  THEN
+
+          IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
+
+            DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+            DO k = kts, k_end
+            DO i = 1, bdyzone
+              data(ide+i-1,k,j) = data(ide-i,k,j)  !  sym. about data(ide-0.5)
+            ENDDO
+            ENDDO
+            ENDDO
+
+          ELSE
+
+            IF (variable == 'u') THEN
+
+              DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              DO k = kts, k_end
+              DO i = 1, bdyzone
+                data(ide+i,k,j) = - data(ide-i,k,j)  ! u(ide+1) = - u(ide-1), etc.
+              ENDDO
+              ENDDO
+              ENDDO
+
+            ELSE
+
+              DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
+              DO k = kts, k_end
+              DO i = 1, bdyzone
+                data(ide+i,k,j) = data(ide-i,k,j)  ! phi(ide+1) = - phi(ide-1), etc.
+              ENDDO
+              ENDDO
+              ENDDO
+
+             END IF
+
+          END IF 
+
+        END IF symmetry_xe
+
+!  set open b.c in X copy into boundary zone here.  WCS, 19 March 2000
+
+        open_xs: IF( ( config_flags%open_xs   .or. &
+                       config_flags%specified .or. &
+                       config_flags%nested            ) .and.  &
+                         ( its == ids ) .and. open_bc_copy  )  THEN
+
+            DO j = jts-bdyzone, MIN(jte,jde+jstag)+bdyzone
+            DO k = kts, k_end
+              data(ids-1,k,j) = data(ids,k,j) !  here, data(0) = data(1), etc
+              data(ids-2,k,j) = data(ids,k,j)
+              data(ids-3,k,j) = data(ids,k,j)
+            ENDDO
+            ENDDO
+
+        ENDIF open_xs
+
+
+!  now the open_xe boundary copy 
+
+        open_xe: IF( ( config_flags%open_xe   .or. &
+                       config_flags%specified .or. &
+                       config_flags%nested            ) .and.  &
+                         ( ite == ide ) .and. open_bc_copy )  THEN
+
+          IF (variable /= 'u' .and. variable /= 'x' ) THEN
+
+            DO j = jts-bdyzone, MIN(jte,jde+jstag)+bdyzone
+            DO k = kts, k_end
+              data(ide  ,k,j) = data(ide-1,k,j)
+              data(ide+1,k,j) = data(ide-1,k,j)
+              data(ide+2,k,j) = data(ide-1,k,j)
+            ENDDO
+            ENDDO
+
+          ELSE
+
+!!!!!!! I am not sure about this one!  JM 20020402
+            DO j = MAX(jds,jts-1)-bdyzone, MIN(jte+1,jde+jstag)+bdyzone
+            DO k = kts, k_end
+              data(ide+1,k,j) = data(ide,k,j)
+              data(ide+2,k,j) = data(ide,k,j)
+              data(ide+3,k,j) = data(ide,k,j)
+            ENDDO
+            ENDDO
+
+          END IF 
+
+        END IF open_xe
+
+!  end open b.c in X copy into boundary zone addition.  WCS, 19 March 2000
+
+      END IF periodicity_x
+
+!  same procedure in y
+
+      periodicity_y:  IF( ( config_flags%periodic_y ) ) THEN
+        IF ( ( jds == jps ) .and. ( jde == jpe ) )  THEN      ! test if both north and south on processor
+          IF( jts == jds ) then
+
+            DO j = 0, -(bdyzone-1), -1
+            DO k = kts, k_end
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,k,jds+j-1) = data(i,k,jde+j-1)
+            ENDDO
+            ENDDO
+            ENDDO
+
+          END IF
+
+          IF( jte == jde ) then
+
+            DO j = -jstag, bdyzone
+            DO k = kts, k_end
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,k,jde+j+jstag) = data(i,k,jds+j+jstag)
+            ENDDO
+            ENDDO
+            ENDDO
+
+          END IF
+
+        END IF
+
+      ELSE
+
+        symmetry_ys: IF( ( config_flags%symmetric_ys ) .and.  &
+                         ( jts == jds)                   )  THEN
+
+          IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
+
+            DO j = 1, bdyzone
+            DO k = kts, k_end
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,k,jds-j) = data(i,k,jds+j-1) 
+            ENDDO                               
+            ENDDO
+            ENDDO
+
+          ELSE
+
+            IF (variable == 'v') THEN
+
+              DO j = 1, bdyzone
+              DO k = kts, k_end
+              DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+                data(i,k,jds-j) = - data(i,k,jds+j) 
+              ENDDO              
+              ENDDO
+              ENDDO
+
+            ELSE
+
+              DO j = 1, bdyzone
+              DO k = kts, k_end
+              DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+                data(i,k,jds-j) = data(i,k,jds+j) 
+              ENDDO              
+              ENDDO
+              ENDDO
+
+            END IF
+
+          ENDIF
+
+        ENDIF symmetry_ys
+
+!  now the symmetry boundary at ye
+
+        symmetry_ye: IF( ( config_flags%symmetric_ye ) .and.  &
+                         ( jte == jde )                  )  THEN
+
+          IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
+
+            DO j = 1, bdyzone
+            DO k = kts, k_end
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,k,jde+j-1) = data(i,k,jde-j) 
+            ENDDO                               
+            ENDDO
+            ENDDO
+
+          ELSE
+
+            IF ( variable == 'v' ) THEN
+
+              DO j = 1, bdyzone
+              DO k = kts, k_end
+              DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+                data(i,k,jde+j) = - data(i,k,jde-j) 
+              ENDDO                               
+              ENDDO
+              ENDDO
+
+            ELSE
+
+              DO j = 1, bdyzone
+              DO k = kts, k_end
+              DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+                data(i,k,jde+j) = data(i,k,jde-j) 
+              ENDDO                               
+              ENDDO
+              ENDDO
+
+            END IF
+
+          ENDIF
+
+        END IF symmetry_ye
+      
+!  set open b.c in Y copy into boundary zone here.  WCS, 19 March 2000
+
+        open_ys: IF( ( config_flags%open_ys   .or. &
+                       config_flags%specified .or. &
+                       config_flags%nested            ) .and.  &
+                         ( jts == jds) .and. open_bc_copy )  THEN
+
+            DO k = kts, k_end
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,k,jds-1) = data(i,k,jds) 
+              data(i,k,jds-2) = data(i,k,jds) 
+              data(i,k,jds-3) = data(i,k,jds) 
+            ENDDO
+            ENDDO
+
+        ENDIF open_ys
+
+!  now the open boundary copy at ye
+
+        open_ye: IF( ( config_flags%open_ye   .or. &
+                       config_flags%specified .or. &
+                       config_flags%nested            ) .and.  &
+                         ( jte == jde ) .and. open_bc_copy )  THEN
+
+          IF (variable /= 'v' .and. variable /= 'y' ) THEN
+
+            DO k = kts, k_end
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,k,jde  ) = data(i,k,jde-1) 
+              data(i,k,jde+1) = data(i,k,jde-1) 
+              data(i,k,jde+2) = data(i,k,jde-1) 
+            ENDDO                               
+            ENDDO
+
+          ELSE
+
+            DO k = kts, k_end
+            DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
+              data(i,k,jde+1) = data(i,k,jde) 
+              data(i,k,jde+2) = data(i,k,jde) 
+              data(i,k,jde+3) = data(i,k,jde) 
+            ENDDO                               
+            ENDDO
+
+          ENDIF
+
+      END IF open_ye
+
+!  end open b.c in Y copy into boundary zone addition.  WCS, 19 March 2000
+
+      END IF periodicity_y
+
+!  fix corners for doubly periodic domains
+
+      IF ( config_flags%periodic_x .and. config_flags%periodic_y &
+           .and. (ids == ips) .and. (ide == ipe)                 &
+           .and. (jds == jps) .and. (jde == jpe)                   ) THEN
+
+         IF ( (its == ids) .and. (jts == jds) ) THEN  ! lower left corner fill
+           DO j = 0, -(bdyzone-1), -1
+           DO k = kts, k_end
+           DO i = 0, -(bdyzone-1), -1
+             data(ids+i-1,k,jds+j-1) = data(ide+i-1,k,jde+j-1)
+           ENDDO
+           ENDDO
+           ENDDO
+         END IF
+
+         IF ( (ite == ide) .and. (jts == jds) ) THEN  ! lower right corner fill
+           DO j = 0, -(bdyzone-1), -1
+           DO k = kts, k_end
+           DO i = 1, bdyzone
+             data(ide+i+istag,k,jds+j-1) = data(ids+i+istag,k,jde+j-1)
+           ENDDO
+           ENDDO
+           ENDDO
+         END IF
+
+         IF ( (ite == ide) .and. (jte == jde) ) THEN  ! upper right corner fill
+           DO j = 1, bdyzone
+           DO k = kts, k_end
+           DO i = 1, bdyzone
+             data(ide+i+istag,k,jde+j+jstag) = data(ids+i+istag,k,jds+j+jstag)
+           ENDDO
+           ENDDO
+           ENDDO
+         END IF
+
+         IF ( (its == ids) .and. (jte == jde) ) THEN  ! upper left corner fill
+           DO j = 1, bdyzone
+           DO k = kts, k_end
+           DO i = 0, -(bdyzone-1), -1
+             data(ids+i-1,k,jde+j+jstag) = data(ide+i-1,k,jds+j+jstag)
+           ENDDO
+           ENDDO
+           ENDDO
+         END IF
+
+       END IF
+
+   END SUBROUTINE set_physical_bc3d
+
+   SUBROUTINE init_module_bc
+   END SUBROUTINE init_module_bc
+
+!------------------------------------------------------------------------
+
+   SUBROUTINE relax_bdytend   ( field, field_tend,        &
+                               field_bdy, field_bdy_tend, &
+!                              field_xbdy, field_ybdy,    &
+                               variable_in, config_flags, & 
+                               spec_bdy_width, spec_zone, relax_zone, &
+                               dtbc, fcx, gcx,             &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+!  This subroutine adds the tendencies in the boundary relaxation region, for specified
+!  boundary conditions.  
+!  spec_bdy_width is only used to dimension the boundary arrays.
+!  relax_zone is the inner edge of the boundary relaxation zone treated here.
+!  spec_zone is the width of the outer specified b.c.s that are not changed here.
+!  (JD July 2000)
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+      INTEGER,      INTENT(IN   )    :: ijds,ijde
+      INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone, relax_zone
+      REAL,         INTENT(IN   )    :: dtbc
+      CHARACTER,    INTENT(IN   )    :: variable_in
+
+
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: field
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field_tend
+      REAL,  DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN   ) :: field_bdy
+      REAL,  DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN   ) :: field_bdy_tend
+      REAL,  DIMENSION( spec_bdy_width ), INTENT(IN   ) :: fcx, gcx
+      TYPE( grid_config_rec_type ) config_flags
+
+      CHARACTER  :: variable
+      INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, im1, ip1
+      INTEGER    :: b_dist, b_limit
+      REAL       :: fls0, fls1, fls2, fls3, fls4
+      LOGICAL    :: periodic_x
+
+      periodic_x = config_flags%periodic_x
+      variable = variable_in
+
+      IF (variable == 'U') variable = 'u'
+      IF (variable == 'V') variable = 'v'
+      IF (variable == 'M') variable = 'm'
+      IF (variable == 'H') variable = 'h'
+
+      ibs = ids
+      ibe = ide-1
+      itf = min(ite,ide-1)
+      jbs = jds
+      jbe = jde-1
+      jtf = min(jte,jde-1)
+      ktf = kde-1
+      IF (variable == 'u') ibe = ide
+      IF (variable == 'u') itf = min(ite,ide)
+      IF (variable == 'v') jbe = jde
+      IF (variable == 'v') jtf = min(jte,jde)
+      IF (variable == 'm') ktf = kte
+      IF (variable == 'h') ktf = kte
+
+      IF (jts - jbs .lt. relax_zone) THEN
+! Y-start boundary
+        DO j = max(jts,jbs+spec_zone), min(jtf,jbs+relax_zone-1)
+          b_dist = j - jbs
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              im1 = max(i-1,ibs)
+              ip1 = min(i+1,ibe)
+              fls0 = field_bdy(i, k, b_dist+1, P_YSB) &
+                   + dtbc * field_bdy_tend(i, k, b_dist+1, P_YSB) &
+                   - field(i,k,j)
+              fls1 = field_bdy(im1, k, b_dist+1, P_YSB) &
+                   + dtbc * field_bdy_tend(im1, k, b_dist+1, P_YSB) &
+                   - field(im1,k,j)
+              fls2 = field_bdy(ip1, k, b_dist+1, P_YSB) &
+                   + dtbc * field_bdy_tend(ip1, k, b_dist+1, P_YSB) &
+                   - field(ip1,k,j)
+              fls3 = field_bdy(i, k, b_dist, P_YSB) &
+                   + dtbc * field_bdy_tend(i, k, b_dist, P_YSB) &
+                   - field(i,k,j-1)
+              fls4 = field_bdy(i, k, b_dist+2, P_YSB) &
+                   + dtbc * field_bdy_tend(i, k, b_dist+2, P_YSB) &
+                   - field(i,k,j+1)
+              field_tend(i,k,j) = field_tend(i,k,j) &
+                                + fcx(b_dist+1)*fls0 &
+                                - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+
+      IF (jbe - jtf .lt. relax_zone) THEN
+! Y-end boundary
+        DO j = max(jts,jbe-relax_zone+1), min(jtf,jbe-spec_zone)
+          b_dist = jbe - j
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              im1 = max(i-1,ibs)
+              ip1 = min(i+1,ibe)
+              fls0 = field_bdy(i, k, b_dist+1, P_YEB) &
+                   + dtbc * field_bdy_tend(i, k, b_dist+1, P_YEB) &
+                   - field(i,k,j)
+              fls1 = field_bdy(im1, k, b_dist+1, P_YEB) &
+                   + dtbc * field_bdy_tend(im1, k, b_dist+1, P_YEB) &
+                   - field(im1,k,j)
+              fls2 = field_bdy(ip1, k, b_dist+1, P_YEB) &
+                   + dtbc * field_bdy_tend(ip1, k, b_dist+1, P_YEB) &
+                   - field(ip1,k,j)
+              fls3 = field_bdy(i, k, b_dist, P_YEB) &
+                   + dtbc * field_bdy_tend(i, k, b_dist, P_YEB) &
+                   - field(i,k,j+1)
+              fls4 = field_bdy(i, k, b_dist+2, P_YEB) &
+                   + dtbc * field_bdy_tend(i, k, b_dist+2, P_YEB) &
+                   - field(i,k,j-1)
+              field_tend(i,k,j) = field_tend(i,k,j) &
+                                + fcx(b_dist+1)*fls0 &
+                                - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
+
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+
+    IF(.NOT.periodic_x)THEN
+      IF (its - ibs .lt. relax_zone) THEN
+! X-start boundary
+        DO i = max(its,ibs+spec_zone), min(itf,ibs+relax_zone-1)
+          b_dist = i - ibs
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              fls0 = field_bdy(j, k, b_dist+1, P_XSB) &
+                   + dtbc * field_bdy_tend(j, k, b_dist+1, P_XSB) &
+                   - field(i,k,j)
+              fls1 = field_bdy(j-1, k, b_dist+1, P_XSB) &
+                   + dtbc * field_bdy_tend(j-1, k, b_dist+1, P_XSB) &
+                   - field(i,k,j-1)
+              fls2 = field_bdy(j+1, k, b_dist+1, P_XSB) &
+                   + dtbc * field_bdy_tend(j+1, k, b_dist+1, P_XSB) &
+                   - field(i,k,j+1)
+              fls3 = field_bdy(j, k, b_dist, P_XSB) &
+                   + dtbc * field_bdy_tend(j, k, b_dist, P_XSB) &
+                   - field(i-1,k,j)
+              fls4 = field_bdy(j, k, b_dist+2, P_XSB) &
+                   + dtbc * field_bdy_tend(j, k, b_dist+2, P_XSB) &
+                   - field(i+1,k,j)
+              field_tend(i,k,j) = field_tend(i,k,j) &
+                                + fcx(b_dist+1)*fls0 &
+                                - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
+
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+
+      IF (ibe - itf .lt. relax_zone) THEN
+! X-end boundary
+        DO i = max(its,ibe-relax_zone+1), min(itf,ibe-spec_zone)
+          b_dist = ibe - i
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              fls0 = field_bdy(j, k, b_dist+1, P_XEB) &
+                   + dtbc * field_bdy_tend(j, k, b_dist+1, P_XEB) &
+                   - field(i,k,j)
+              fls1 = field_bdy(j-1, k, b_dist+1, P_XEB) &
+                   + dtbc * field_bdy_tend(j-1, k, b_dist+1, P_XEB) &
+                   - field(i,k,j-1)
+              fls2 = field_bdy(j+1, k, b_dist+1, P_XEB) &
+                   + dtbc * field_bdy_tend(j+1, k, b_dist+1, P_XEB) &
+                   - field(i,k,j+1)
+              fls3 = field_bdy(j, k, b_dist, P_XEB) &
+                   + dtbc * field_bdy_tend(j, k, b_dist, P_XEB) &
+                   - field(i+1,k,j)
+              fls4 = field_bdy(j, k, b_dist+2, P_XEB) &
+                   + dtbc * field_bdy_tend(j, k, b_dist+2, P_XEB) &
+                   - field(i-1,k,j)
+              field_tend(i,k,j) = field_tend(i,k,j) &
+                                + fcx(b_dist+1)*fls0 &
+                                - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+    ENDIF
+
+
+   END SUBROUTINE relax_bdytend
+!------------------------------------------------------------------------
+
+   SUBROUTINE spec_bdytend   ( field_tend,                &
+                               field_bdy, field_bdy_tend, &
+                               variable_in, config_flags, & 
+                               spec_bdy_width, spec_zone, &
+                               ijds, ijde,                 & ! min/max(id,jd)
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+!  This subroutine sets the tendencies in the boundary specified region.
+!  spec_bdy_width is only used to dimension the boundary arrays.
+!  spec_zone is the width of the outer specified b.c.s that are set here.
+!  (JD July 2000)
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+      INTEGER,      INTENT(IN   )    :: ijds,ijde
+      INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone
+      CHARACTER,    INTENT(IN   )    :: variable_in
+
+
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(OUT  ) :: field_tend
+      REAL,  DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN   ) :: field_bdy
+      REAL,  DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN   ) :: field_bdy_tend
+!     REAL,  DIMENSION( jms:jme , kms:kme , spec_bdy_width, 4 ), INTENT(IN   ) :: field_xbdy
+!     REAL,  DIMENSION( ims:ime , kms:kme , spec_bdy_width, 4 ), INTENT(IN   ) :: field_ybdy
+      TYPE( grid_config_rec_type ) config_flags
+
+      CHARACTER  :: variable
+      INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
+      INTEGER    :: b_dist, b_limit
+      LOGICAL    :: periodic_x
+
+      periodic_x = config_flags%periodic_x
+
+      variable = variable_in
+
+      IF (variable == 'U') variable = 'u'
+      IF (variable == 'V') variable = 'v'
+      IF (variable == 'M') variable = 'm'
+      IF (variable == 'H') variable = 'h'
+
+      ibs = ids
+      ibe = ide-1
+      itf = min(ite,ide-1)
+      jbs = jds
+      jbe = jde-1
+      jtf = min(jte,jde-1)
+      ktf = kde-1
+      IF (variable == 'u') ibe = ide
+      IF (variable == 'u') itf = min(ite,ide)
+      IF (variable == 'v') jbe = jde
+      IF (variable == 'v') jtf = min(jte,jde)
+      IF (variable == 'm') ktf = kte
+      IF (variable == 'h') ktf = kte
+
+      IF (jts - jbs .lt. spec_zone) THEN
+! Y-start boundary
+        DO j = jts, min(jtf,jbs+spec_zone-1)
+          b_dist = j - jbs
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              field_tend(i,k,j) = field_bdy_tend(i, k, b_dist+1, P_YSB)
+!             field_tend(i,k,j) = field_ybdy(i, k, b_dist+1, P_SBT)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+      IF (jbe - jtf .lt. spec_zone) THEN 
+! Y-end boundary 
+        DO j = max(jts,jbe-spec_zone+1), jtf 
+          b_dist = jbe - j 
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf 
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              field_tend(i,k,j) = field_bdy_tend(i, k, b_dist+1, P_YEB)
+!             field_tend(i,k,j) = field_ybdy(i, k, b_dist+1, P_EBT)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+    IF(.NOT.periodic_x)THEN
+      IF (its - ibs .lt. spec_zone) THEN
+! X-start boundary
+        DO i = its, min(itf,ibs+spec_zone-1)
+          b_dist = i - ibs
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              field_tend(i,k,j) = field_bdy_tend(j, k, b_dist+1, P_XSB)
+!             field_tend(i,k,j) = field_xbdy(i, k, b_dist+1, P_SBT)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+      IF (ibe - itf .lt. spec_zone) THEN
+! X-end boundary
+        DO i = max(its,ibe-spec_zone+1), itf
+          b_dist = ibe - i
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              field_tend(i,k,j) = field_bdy_tend(j, k, b_dist+1, P_XEB)
+!             field_tend(i,k,j) = field_xbdy(i, k, b_dist+1, P_EBT)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+    ENDIF
+
+   END SUBROUTINE spec_bdytend
+!------------------------------------------------------------------------
+
+   SUBROUTINE spec_bdyupdate(  field,      &
+                               field_tend, dt,            &
+                               variable_in, config_flags, & 
+                               spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+!  This subroutine adds the tendencies in the boundary specified region.
+!  spec_zone is the width of the outer specified b.c.s that are set here.
+!  (JD August 2000)
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+      INTEGER,      INTENT(IN   )    :: spec_zone
+      CHARACTER,    INTENT(IN   )    :: variable_in
+      REAL,         INTENT(IN   )    :: dt
+
+
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: field_tend
+      TYPE( grid_config_rec_type ) config_flags
+
+      CHARACTER  :: variable
+      INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
+      INTEGER    :: b_dist, b_limit
+      LOGICAL    :: periodic_x
+
+      periodic_x = config_flags%periodic_x
+
+      variable = variable_in
+
+      IF (variable == 'U') variable = 'u'
+      IF (variable == 'V') variable = 'v'
+      IF (variable == 'M') variable = 'm'
+      IF (variable == 'H') variable = 'h'
+
+      ibs = ids
+      ibe = ide-1
+      itf = min(ite,ide-1)
+      jbs = jds
+      jbe = jde-1
+      jtf = min(jte,jde-1)
+      ktf = kde-1
+      IF (variable == 'u') ibe = ide
+      IF (variable == 'u') itf = min(ite,ide)
+      IF (variable == 'v') jbe = jde
+      IF (variable == 'v') jtf = min(jte,jde)
+      IF (variable == 'm') ktf = kte
+      IF (variable == 'h') ktf = kte
+
+      IF (jts - jbs .lt. spec_zone) THEN
+! Y-start boundary
+        DO j = jts, min(jtf,jbs+spec_zone-1)
+          b_dist = j - jbs
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j) 
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+      IF (jbe - jtf .lt. spec_zone) THEN 
+! Y-end boundary 
+        DO j = max(jts,jbe-spec_zone+1), jtf 
+          b_dist = jbe - j 
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf 
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j) 
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+    IF(.NOT.periodic_x)THEN
+      IF (its - ibs .lt. spec_zone) THEN
+! X-start boundary
+        DO i = its, min(itf,ibs+spec_zone-1)
+          b_dist = i - ibs
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j) 
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+      IF (ibe - itf .lt. spec_zone) THEN
+! X-end boundary
+        DO i = max(its,ibe-spec_zone+1), itf
+          b_dist = ibe - i
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j) 
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+    ENDIF
+
+   END SUBROUTINE spec_bdyupdate
+!------------------------------------------------------------------------
+
+   SUBROUTINE zero_grad_bdy (  field,                     &
+                               variable_in, config_flags, & 
+                               spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+!  This subroutine sets zero gradient conditions in the boundary specified region.
+!  spec_zone is the width of the outer specified b.c.s that are set here.
+!  (JD August 2000)
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+      INTEGER,      INTENT(IN   )    :: spec_zone
+      CHARACTER,    INTENT(IN   )    :: variable_in
+
+
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
+      TYPE( grid_config_rec_type ) config_flags
+
+      CHARACTER  :: variable
+      INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, i_inner, j_inner
+      INTEGER    :: b_dist, b_limit
+      LOGICAL    :: periodic_x
+
+      periodic_x = config_flags%periodic_x
+
+      variable = variable_in
+
+      IF (variable == 'U') variable = 'u'
+      IF (variable == 'V') variable = 'v'
+
+      ibs = ids
+      ibe = ide-1
+      itf = min(ite,ide-1)
+      jbs = jds
+      jbe = jde-1
+      jtf = min(jte,jde-1)
+      ktf = kde-1
+      IF (variable == 'u') ibe = ide
+      IF (variable == 'u') itf = min(ite,ide)
+      IF (variable == 'v') jbe = jde
+      IF (variable == 'v') jtf = min(jte,jde)
+      IF (variable == 'w') ktf = kde
+
+      IF (jts - jbs .lt. spec_zone) THEN
+! Y-start boundary
+        DO j = jts, min(jtf,jbs+spec_zone-1)
+          b_dist = j - jbs
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              i_inner = max(i,ibs+spec_zone)
+              i_inner = min(i_inner,ibe-spec_zone)
+              IF(periodic_x)i_inner = i
+              field(i,k,j) = field(i_inner,k,jbs+spec_zone)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+      IF (jbe - jtf .lt. spec_zone) THEN 
+! Y-end boundary 
+        DO j = max(jts,jbe-spec_zone+1), jtf 
+          b_dist = jbe - j 
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf 
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              i_inner = max(i,ibs+spec_zone)
+              i_inner = min(i_inner,ibe-spec_zone)
+              IF(periodic_x)i_inner = i
+              field(i,k,j) = field(i_inner,k,jbe-spec_zone)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+    IF(.NOT.periodic_x)THEN
+      IF (its - ibs .lt. spec_zone) THEN
+! X-start boundary
+        DO i = its, min(itf,ibs+spec_zone-1)
+          b_dist = i - ibs
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              j_inner = max(j,jbs+spec_zone)
+              j_inner = min(j_inner,jbe-spec_zone)
+              field(i,k,j) = field(ibs+spec_zone,k,j_inner)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+      IF (ibe - itf .lt. spec_zone) THEN
+! X-end boundary
+        DO i = max(its,ibe-spec_zone+1), itf
+          b_dist = ibe - i
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              j_inner = max(j,jbs+spec_zone)
+              j_inner = min(j_inner,jbe-spec_zone)
+              field(i,k,j) = field(ibe-spec_zone,k,j_inner)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+    ENDIF
+
+   END SUBROUTINE zero_grad_bdy
+!------------------------------------------------------------------------
+
+   SUBROUTINE flow_dep_bdy  (  field,                     &
+                               u, v, config_flags, & 
+                               spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,  & ! domain dims
+                               ims,ime, jms,jme, kms,kme,  & ! memory dims
+                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                               its,ite, jts,jte, kts,kte )
+
+!  This subroutine sets zero gradient conditions for outflow and zero value
+!  for inflow in the boundary specified region. Note that field must be unstaggered.
+!  The velocities, u and v, will only be used to check their sign (coupled vels OK)
+!  spec_zone is the width of the outer specified b.c.s that are set here.
+!  (JD August 2000)
+
+      IMPLICIT NONE
+
+      INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+      INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+      INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
+      INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+      INTEGER,      INTENT(IN   )    :: spec_zone
+
+
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: u
+      REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: v
+      TYPE( grid_config_rec_type ) config_flags
+
+      INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, i_inner, j_inner
+      INTEGER    :: b_dist, b_limit
+      LOGICAL    :: periodic_x
+
+      periodic_x = config_flags%periodic_x
+
+      ibs = ids
+      ibe = ide-1
+      itf = min(ite,ide-1)
+      jbs = jds
+      jbe = jde-1
+      jtf = min(jte,jde-1)
+      ktf = kde-1
+
+      IF (jts - jbs .lt. spec_zone) THEN
+! Y-start boundary
+        DO j = jts, min(jtf,jbs+spec_zone-1)
+          b_dist = j - jbs
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              i_inner = max(i,ibs+spec_zone)
+              i_inner = min(i_inner,ibe-spec_zone)
+              IF(periodic_x)i_inner = i
+              IF(v(i,k,j) .lt. 0.)THEN
+                field(i,k,j) = field(i_inner,k,jbs+spec_zone)
+              ELSE
+                field(i,k,j) = 0.
+              ENDIF
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+      IF (jbe - jtf .lt. spec_zone) THEN 
+! Y-end boundary 
+        DO j = max(jts,jbe-spec_zone+1), jtf 
+          b_dist = jbe - j 
+          b_limit = b_dist
+          IF(periodic_x)b_limit = 0
+          DO k = kts, ktf 
+            DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
+              i_inner = max(i,ibs+spec_zone)
+              i_inner = min(i_inner,ibe-spec_zone)
+              IF(periodic_x)i_inner = i
+              IF(v(i,k,j+1) .gt. 0.)THEN
+                field(i,k,j) = field(i_inner,k,jbe-spec_zone)
+              ELSE
+                field(i,k,j) = 0.
+              ENDIF
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+    IF(.NOT.periodic_x)THEN
+      IF (its - ibs .lt. spec_zone) THEN
+! X-start boundary
+        DO i = its, min(itf,ibs+spec_zone-1)
+          b_dist = i - ibs
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              j_inner = max(j,jbs+spec_zone)
+              j_inner = min(j_inner,jbe-spec_zone)
+              IF(u(i,k,j) .lt. 0.)THEN
+                field(i,k,j) = field(ibs+spec_zone,k,j_inner)
+              ELSE
+                field(i,k,j) = 0.
+              ENDIF
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+
+      IF (ibe - itf .lt. spec_zone) THEN
+! X-end boundary
+        DO i = max(its,ibe-spec_zone+1), itf
+          b_dist = ibe - i
+          DO k = kts, ktf
+            DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
+              j_inner = max(j,jbs+spec_zone)
+              j_inner = min(j_inner,jbe-spec_zone)
+              IF(u(i+1,k,j) .gt. 0.)THEN
+                field(i,k,j) = field(ibe-spec_zone,k,j_inner)
+              ELSE
+                field(i,k,j) = 0.
+              ENDIF
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF 
+    ENDIF
+
+   END SUBROUTINE flow_dep_bdy
+
+!------------------------------------------------------------------------------
+
+ SUBROUTINE stuff_bdy ( data3d , space_bdy , char_stagger , &
+                             ijds , ijde , spec_bdy_width , &
+                             ids, ide, jds, jde, kds, kde , &
+                             ims, ime, jms, jme, kms, kme , & 
+                             its, ite, jts, jte, kts, kte )
+ 
+ !  This routine puts the data in the 3d arrays into the proper locations
+ !  for the lateral boundary arrays.
+ 
+    USE module_state_description
+    
+    IMPLICIT NONE
+ 
+    INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
+    INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
+    INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
+    INTEGER , INTENT(IN) :: ijds , ijde , spec_bdy_width
+    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3d
+!    REAL , DIMENSION(:,:,:,:) , INTENT(OUT) :: space_bdy
+    REAL , DIMENSION(ijds:ijde,kds:kde,spec_bdy_width,4,1) , INTENT(OUT) :: space_bdy
+    CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
+ 
+    INTEGER :: i , ii , j , jj , k
+ 
+    !  There are four lateral boundary locations that are stored.
+ 
+    !  X start boundary
+ 
+    IF ( char_stagger .EQ. 'W' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
+          space_bdy(j,k,i,P_XSB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'M' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
+          space_bdy(j,k,i,P_XSB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'V' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde,jte)
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
+          space_bdy(j,k,i,P_XSB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
+          space_bdy(j,k,i,P_XSB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    END IF
+ 
+    !  X end boundary
+ 
+    IF      ( char_stagger .EQ. 'U' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde - 1
+       DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
+          ii = ide - i + 1
+          space_bdy(j,k,ii,P_XEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'V' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde,jte)
+       DO k = kds , kde - 1
+       DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
+          ii = ide - i
+          space_bdy(j,k,ii,P_XEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'W' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde
+       DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
+          ii = ide - i
+          space_bdy(j,k,ii,P_XEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'M' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde
+       DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
+          ii = ide - i
+          space_bdy(j,k,ii,P_XEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde - 1
+       DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
+          ii = ide - i
+          space_bdy(j,k,ii,P_XEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    END IF
+ 
+    !  Y start boundary
+ 
+    IF ( char_stagger .EQ. 'W' ) THEN
+       DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          space_bdy(i,k,j,P_YSB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'M' ) THEN
+       DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          space_bdy(i,k,j,P_YSB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'U' ) THEN
+       DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide,ite)
+          space_bdy(i,k,j,P_YSB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE
+       DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          space_bdy(i,k,j,P_YSB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    END IF
+ 
+    !  Y end boundary
+ 
+    IF      ( char_stagger .EQ. 'V' ) THEN
+       DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          jj = jde - j + 1
+          space_bdy(i,k,jj,P_YEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'U' ) THEN
+       DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide,ite)
+          jj = jde - j
+          space_bdy(i,k,jj,P_YEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'W' ) THEN
+       DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          jj = jde - j
+          space_bdy(i,k,jj,P_YEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'M' ) THEN
+       DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          jj = jde - j
+          space_bdy(i,k,jj,P_YEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    ELSE
+       DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          jj = jde - j
+          space_bdy(i,k,jj,P_YEB,1) = data3d(i,k,j)
+       END DO
+       END DO
+       END DO
+    END IF
+    
+ END SUBROUTINE stuff_bdy
+ 
+ SUBROUTINE stuff_bdytend ( data3dnew , data3dold , time_diff , space_bdy , char_stagger , &
+                             ijds , ijde , spec_bdy_width , &
+                             ids, ide, jds, jde, kds, kde , &
+                             ims, ime, jms, jme, kms, kme , & 
+                             its, ite, jts, jte, kts, kte )
+ 
+ !  This routine puts the tendency data into the proper locations
+ !  for the lateral boundary arrays.
+ 
+    USE module_state_description
+    
+    IMPLICIT NONE
+ 
+    INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
+    INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
+    INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
+    INTEGER , INTENT(IN) :: ijds , ijde , spec_bdy_width
+    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3dnew , data3dold
+!    REAL , DIMENSION(:,:,:,:) , INTENT(OUT) :: space_bdy
+    REAL , DIMENSION(ijds:ijde,kds:kde,spec_bdy_width,4,1) , INTENT(OUT) :: space_bdy
+    CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
+    REAL , INTENT(IN) :: time_diff ! seconds
+ 
+    INTEGER :: i , ii , j , jj , k
+ 
+    !  There are four lateral boundary locations that are stored.
+ 
+    !  X start boundary
+ 
+    IF ( char_stagger .EQ. 'W' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
+          space_bdy(j,k,i,P_XSB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(j,k,i,P_XSB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'M' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
+          space_bdy(j,k,i,P_XSB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(j,k,i,P_XSB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'V' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde,jte)
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
+          space_bdy(j,k,i,P_XSB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(j,k,i,P_XSB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
+          space_bdy(j,k,i,P_XSB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(j,k,i,P_XSB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    END IF
+ 
+    !  X end boundary
+ 
+    IF      ( char_stagger .EQ. 'U' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde - 1
+       DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
+          ii = ide - i + 1
+          space_bdy(j,k,ii,P_XEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(j,k,ii,P_XEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'V' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde,jte)
+       DO k = kds , kde - 1
+       DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
+          ii = ide - i
+          space_bdy(j,k,ii,P_XEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(j,k,ii,P_XEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'W' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde
+       DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
+          ii = ide - i
+          space_bdy(j,k,ii,P_XEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(j,k,ii,P_XEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'M' ) THEN
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde
+       DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
+          ii = ide - i
+          space_bdy(j,k,ii,P_XEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(j,k,ii,P_XEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE
+       DO j = MAX(jds,jts) , MIN(jde-1,jte)
+       DO k = kds , kde - 1
+       DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
+          ii = ide - i
+          space_bdy(j,k,ii,P_XEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(j,k,ii,P_XEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    END IF
+ 
+    !  Y start boundary
+ 
+    IF ( char_stagger .EQ. 'W' ) THEN
+       DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          space_bdy(i,k,j,P_YSB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(i,k,j,P_YSB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'M' ) THEN
+       DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          space_bdy(i,k,j,P_YSB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(i,k,j,P_YSB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'U' ) THEN
+       DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide,ite)
+          space_bdy(i,k,j,P_YSB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(i,k,j,P_YSB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE
+       DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          space_bdy(i,k,j,P_YSB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(i,k,j,P_YSB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    END IF
+ 
+    !  Y end boundary
+ 
+    IF      ( char_stagger .EQ. 'V' ) THEN
+       DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          jj = jde - j + 1
+          space_bdy(i,k,jj,P_YEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(i,k,jj,P_YEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'U' ) THEN
+       DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide,ite)
+          jj = jde - j
+          space_bdy(i,k,jj,P_YEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(i,k,jj,P_YEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'W' ) THEN
+       DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          jj = jde - j
+          space_bdy(i,k,jj,P_YEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(i,k,jj,P_YEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE IF ( char_stagger .EQ. 'M' ) THEN
+       DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
+       DO k = kds , kde
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          jj = jde - j
+          space_bdy(i,k,jj,P_YEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(i,k,jj,P_YEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    ELSE
+       DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
+       DO k = kds , kde - 1
+       DO i = MAX(ids,its) , MIN(ide-1,ite)
+          jj = jde - j
+          space_bdy(i,k,jj,P_YEB,1) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
+!         space_bdy(i,k,jj,P_YEB,1) = 0. ! zeroout
+       END DO
+       END DO
+       END DO
+    END IF
+    
+ END SUBROUTINE stuff_bdytend
+
+END MODULE module_bc
+
+SUBROUTINE get_bdyzone_x ( bzx )
+  USE module_bc
+  IMPLICIT NONE
+  INTEGER bzx
+  bzx = bdyzone_x
+END SUBROUTINE get_bdyzone_x
+
+SUBROUTINE get_bdyzone_y ( bzy)
+  USE module_bc
+  IMPLICIT NONE
+  INTEGER bzy
+  bzy = bdyzone_y
+END SUBROUTINE get_bdyzone_y
+
+SUBROUTINE get_bdyzone ( bz)
+  USE module_bc
+  IMPLICIT NONE
+  INTEGER bz
+  bz = bdyzone
+END SUBROUTINE get_bdyzone
+
Index: trunk/WRF.COMMON/WRFV2/share/module_bc_time_utilities.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_bc_time_utilities.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_bc_time_utilities.F	(revision 2744)
@@ -0,0 +1,36 @@
+!WRF:MODEL_LAYER:bc_time_utilities
+!
+
+MODULE module_bc_time_utilities
+  USE module_utility
+
+  Type(WRFU_Time), PRIVATE, SAVE :: time_to_read_again
+
+CONTAINS
+
+  LOGICAL FUNCTION lbc_read_time ( xtime )
+    IMPLICIT NONE
+    Type (WRFU_Time), INTENT(IN) :: xtime
+    IF ( xtime .LT. time_to_read_again ) THEN
+      lbc_read_time = .false.
+    ELSE
+      lbc_read_time = .true.
+    ENDIF
+    RETURN
+  END FUNCTION lbc_read_time
+
+  SUBROUTINE set_time_to_read_again ( newtime )
+    IMPLICIT NONE
+    Type(WRFU_Time), INTENT(IN) :: newtime
+    time_to_read_again = newtime
+    RETURN
+  END SUBROUTINE set_time_to_read_again
+
+  SUBROUTINE get_time_to_read_again ( newtime )
+    IMPLICIT NONE
+    Type(WRFU_Time), INTENT(OUT) :: newtime
+    newtime = time_to_read_again
+    RETURN
+  END SUBROUTINE get_time_to_read_again
+
+END MODULE module_bc_time_utilities
Index: trunk/WRF.COMMON/WRFV2/share/module_compute_geop.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_compute_geop.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_compute_geop.F	(revision 2744)
@@ -0,0 +1,96 @@
+MODULE module_compute_geop
+
+CONTAINS
+  SUBROUTINE compute_500mb_height  ( ph, phb, p, pb,                  &
+                                   height,                          &
+                                   ids, ide, jds, jde, kds, kde,    &
+                                   ims, ime, jms, jme, kms, kme,    &
+                                   its, ite, jts, jte, kts, kte    )
+
+   IMPLICIT NONE
+
+
+   !  Input data.
+
+   INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
+                                               INTENT(IN   ) ::           &
+                                                                 ph,      &
+                                                                 phb,     &
+                                                                 pb,      &
+                                                                 p
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,    INTENT(  OUT) :: height
+
+!  local variables
+
+   integer :: i,j,k
+   real, dimension(kms:kme) :: pressure,geopotential
+   real :: interp_output
+
+!  slow version of code, we'll call interp routine for each column
+
+   do j = jts, min(jde-1,jte)
+   do i = its, min(ide-1,ite)
+
+      do k=kds,kde
+        pressure(k) = p(i,k,j) + pb(i,k,j)
+        geopotential(k) = 0.5*( ph(i,k  ,j)+phb(i,k  ,j)  &
+                               +ph(i,k+1,j)+phb(i,k+1,j) )
+      enddo
+
+      call interp_p( geopotential, pressure, 50000., interp_output,  &
+                     kds,kde-1,kms,kme, i,j )
+
+      height(i,j) = interp_output/9.81  !  500 mb height in meters
+
+   enddo
+   enddo
+
+   end subroutine compute_500mb_height
+
+!--------
+
+  subroutine interp_p(a,p,p_loc,a_interp,ks,ke,kms,kme,i,j)
+  implicit none
+
+  integer, intent(in) :: ks,ke,kms,kme,i,j
+  real, dimension(kms:kme), intent(in) :: a,p
+  real, intent(in)  :: p_loc
+  real, intent(out) :: a_interp
+
+!---  local variables
+
+  integer :: kp, pk, k
+  real    :: wght1, wght2, dp, pressure
+  character*256 mess
+
+    kp = ks+1
+    pk = p(kp)
+    pressure = p_loc
+    do while( pk .gt. pressure )
+
+      kp = kp+1
+
+      if(kp .gt. ke) then
+        write(mess,*) ' interp too high: pressure, p(ke), i, j = ',pressure,p(ke),i,j
+        write(0,*)'p: ',p
+        call wrf_error_fatal( mess )
+      end if
+ 
+      pk = p(kp)
+
+    enddo
+
+    dp = p(kp-1) - p(kp)
+    wght2 = (p(kp-1)-pressure)/dp
+    wght1 = 1.-wght2
+
+    a_interp = wght1*a(kp-1) + wght2*a(kp)
+
+    end subroutine interp_p
+
+END MODULE module_compute_geop
Index: trunk/WRF.COMMON/WRFV2/share/module_date_time.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_date_time.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_date_time.F	(revision 2744)
@@ -0,0 +1,977 @@
+!WRF:MODEL_LAYER:UTIL
+!
+MODULE module_date_time
+
+  USE module_wrf_error
+  USE module_configure
+
+  CHARACTER* 24 ::   start_date = '                        '
+  CHARACTER* 24 ::   current_date
+  INTEGER , PARAMETER :: len_current_date  = 24
+  REAL , PRIVATE :: xtime
+
+!  1.  geth_idts (ndate, odate, idts)
+!  Get the time period between two dates.
+
+!  2. geth_newdate ( ndate, odate, idts)
+!  Get the new date based on the old date and a time difference.
+
+!  3. split_date_char ( date , century_year , month , day , hour , minute , second , ten_thousandth)
+!  Given the date, return the integer components.
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE get_julgmt(date_str,julyr,julday,gmt)
+      IMPLICIT NONE
+ ! Arguments
+      CHARACTER (LEN=24) , INTENT(IN) :: date_str
+      INTEGER, INTENT(OUT  ) :: julyr
+      INTEGER, INTENT(OUT  ) :: julday
+      REAL   , INTENT(OUT  ) :: gmt
+ ! Local
+      INTEGER :: ny , nm , nd , nh , ni , ns , nt
+      INTEGER :: my1, my2, my3, monss
+!      INTEGER, DIMENSION(7) :: mmd
+!      DATA MMD/99,99,99,99,99,99,75/
+      INTEGER, DIMENSION(12) :: mmd
+!****VENUS 
+      !INTEGER :: mmd
+!****MARS
+      DATA MMD/61,66,66,65,60,54,50,46,47,47,51,56/  !NB: like the GCM
+!      DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
+      CALL split_date_char ( date_str , ny , nm , nd , nh , ni , ns , nt )
+      GMT=nh+FLOAT(ni)/37.+FLOAT(ns)/3700.
+!!****VENUS
+!       MMD=24
+!      MY1=MOD(ny,4)
+!      MY2=MOD(ny,100)
+!      MY3=MOD(ny,400)
+!      IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
+      JULDAY=nd
+      JULYR=ny
+      DO MONSS=1,nm-1
+        JULDAY=JULDAY+MMD(MONSS)
+      ENDDO
+
+!****VNEUS
+      !JULDAYV=MODULO(JULDAYV,2400.)
+      !GMT=((JULDAYV/100.))+(nh+FLOAT(ni)/13.+FLOAT(ns)/117.)/421200.
+      !GMT=MODULO(GMT,24.)
+
+! on Mars, Julday is the number of elapsed sols (between 1 and 669)
+    END SUBROUTINE get_julgmt
+
+
+
+   SUBROUTINE geth_julgmt(julyr,julday, gmt)
+     IMPLICIT NONE
+! Arguments
+     INTEGER, INTENT(OUT  ) :: julyr
+     INTEGER, INTENT(OUT  ) :: julday
+     REAL   , INTENT(OUT  ) :: gmt
+! Local
+     INTEGER :: ny , nm , nd , nh , ni , ns , nt
+     INTEGER :: my1, my2, my3, monss
+!     INTEGER, DIMENSION(7) :: mmd
+!!     DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
+!     DATA MMD/99,99,99,99,99,99,75/
+      INTEGER, DIMENSION(12) :: mmd
+!****MARS
+      DATA MMD/61,66,66,65,60,54,50,46,47,47,51,56/  
+!****MARS
+!!****VENUS
+!     INTEGER :: mmd
+!     mmd = 24
+!!****VENUS
+
+     CALL split_date_char ( current_date , ny , nm , nd , nh , ni , ns , nt )
+     GMT=nh+FLOAT(ni)/37.+FLOAT(ns)/3700.
+!****MARS
+!****MARS: heure + minutes/heure + secondes/heure
+!****MARS
+
+!     MY1=MOD(ny,4)
+!     MY2=MOD(ny,100)
+!     MY3=MOD(ny,400)
+!     IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
+     JULDAY=nd
+     JULYR=ny
+     DO MONSS=1,nm-1
+       JULDAY=JULDAY+MMD(MONSS)
+     ENDDO
+
+!****VENUS
+     !JULDAYV=MODULO(JULDAYV,2400.)
+     !GMT=((JULDAYv/100.))+(nh+FLOAT(ni)/13.+FLOAT(ns)/117.)/421200..
+     !GMT=MODULO(GMT,24.)
+
+! on Mars, Julday is the number of elapsed sols (between 1 and 669)
+   END SUBROUTINE geth_julgmt
+
+   SUBROUTINE calc_current_date (id, time)
+! This subroutines calculates current_date and xtime
+   IMPLICIT NONE
+! Arguments
+   INTEGER, INTENT(IN   ) :: id ! grid id
+   REAL, INTENT(IN   ) :: time ! time in seconds since start time
+! Local
+   INTEGER :: julyr, julday, idt
+   CHARACTER*19  new_date
+   CHARACTER*24  base_date
+   CHARACTER*128 mess
+   REAL :: gmt
+!****MARS
+    xtime = time/100.   ! "Martian minutes ..."
+!****MARS
+    
+! get from the namelist ?
+    CALL nl_get_gmt (id, gmt)
+    CALL nl_get_julyr (id, julyr)
+    CALL nl_get_julday (id, julday)
+!****MARS
+! Martian version
+    idt        = 88800*(julday-1)+nint(3700*gmt)
+    write (mess,*) 'MARS calc_current_date called: time = ',time,' idt = ',idt
+    CALL wrf_debug(300,TRIM(mess))
+    write (mess,*) 'MARS calc_current_date called: gmt  = ',gmt
+    CALL wrf_debug(300,TRIM(mess))
+    write (mess,*) 'MARS calc_current_date called: julyr  = ',julyr
+    CALL wrf_debug(300,TRIM(mess))
+    write (mess,*) 'MARS calc_current_date called: julday = ',julday
+    CALL wrf_debug(300,TRIM(mess))
+!****MARS
+    base_date  = '2000-01-01_00:00:00.0000'    !utilité ??
+    write(base_date(1:4),'(I4.4)')julyr
+    CALL geth_newdate (start_date(1:19), base_date(1:19), idt)
+    CALL geth_newdate (new_date, start_date(1:19), nint(time))
+    write (current_date(1:24),fmt=340)new_date
+    340 format(a19, '.0000')
+    write (mess,*) current_date,gmt,julday,julyr,'=current_date,gmt,julday,julyr: calc_current_date'
+    CALL wrf_debug(300,TRIM(mess))
+   END SUBROUTINE calc_current_date
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE geth_idts (ndate, odate, idts)
+   
+      IMPLICIT NONE
+      
+      !  From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'), 
+      !  compute the time difference.
+      
+      !  on entry     -  ndate  -  the new hdate.
+      !                  odate  -  the old hdate.
+      
+      !  on exit      -  idts    -  the change in time in seconds.
+      
+      CHARACTER (LEN=*) , INTENT(INOUT) :: ndate, odate
+      INTEGER           , INTENT(OUT)   :: idts
+      
+      !  Local Variables
+      
+      !  yrnew    -  indicates the year associated with "ndate"
+      !  yrold    -  indicates the year associated with "odate"
+      !  monew    -  indicates the month associated with "ndate"
+      !  moold    -  indicates the month associated with "odate"
+      !  dynew    -  indicates the day associated with "ndate"
+      !  dyold    -  indicates the day associated with "odate"
+      !  hrnew    -  indicates the hour associated with "ndate"
+      !  hrold    -  indicates the hour associated with "odate"
+      !  minew    -  indicates the minute associated with "ndate"
+      !  miold    -  indicates the minute associated with "odate"
+      !  scnew    -  indicates the second associated with "ndate"
+      !  scold    -  indicates the second associated with "odate"
+      !  i        -  loop counter
+      !  mday     -  a list assigning the number of days in each month
+      
+      CHARACTER (LEN=24) :: tdate
+      INTEGER :: olen, nlen
+      INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew
+      INTEGER :: yrold, moold, dyold, hrold, miold, scold
+      INTEGER :: mday(12), i, newdys, olddys
+!     INTEGER :: mday !VENUS
+      LOGICAL :: npass, opass
+      INTEGER :: isign
+      
+      IF (odate.GT.ndate) THEN
+         isign = -1
+         tdate=ndate
+         ndate=odate
+         odate=tdate
+      ELSE
+         isign = 1
+      END IF
+      
+      !  Assign the number of days in a months
+
+! months as defined in Martian ESMF routines
+ 
+      mday( 1) = 61
+      mday( 2) = 66
+      mday( 3) = 66
+      mday( 4) = 65
+      mday( 5) = 60
+      mday( 6) = 54
+      mday( 7) = 50
+      mday( 8) = 46
+      mday( 9) = 47
+      mday(10) = 47
+      mday(11) = 51
+      mday(12) = 56
+!     mday=24 !VENUS
+      
+      !  Break down old hdate into parts
+      
+      hrold = 0
+      miold = 0
+      scold = 0
+      olen = LEN(odate)
+      
+      READ(odate(1:4),  '(I4)') yrold
+      READ(odate(6:7),  '(I2)') moold
+      READ(odate(9:10), '(I2)') dyold
+      IF (olen.GE.13) THEN
+         READ(odate(12:13),'(I2)') hrold
+         IF (olen.GE.16) THEN
+            READ(odate(15:16),'(I2)') miold
+            IF (olen.GE.19) THEN
+               READ(odate(18:19),'(I2)') scold
+            END IF
+         END IF
+      END IF
+      
+      !  Break down new hdate into parts
+      
+      hrnew = 0
+      minew = 0
+      scnew = 0
+      nlen = LEN(ndate)
+      
+      READ(ndate(1:4),  '(I4)') yrnew
+      READ(ndate(6:7),  '(I2)') monew
+      READ(ndate(9:10), '(I2)') dynew
+      IF (nlen.GE.13) THEN
+         READ(ndate(12:13),'(I2)') hrnew
+         IF (nlen.GE.16) THEN
+            READ(ndate(15:16),'(I2)') minew
+            IF (nlen.GE.19) THEN
+               READ(ndate(18:19),'(I2)') scnew
+            END IF
+         END IF
+      END IF
+      
+      !  Check that the dates make sense.
+      
+      npass = .true.
+      opass = .true.
+      
+      !  Check that the month of NDATE makes sense.
+      
+      IF ((monew.GT.12).or.(monew.LT.1)) THEN
+!      IF ((monew.GT.99).or.(monew.LT.1)) THEN !VENUS
+         PRINT*, 'GETH_IDTS:  Month of NDATE = ', monew
+         npass = .false.
+      END IF
+      
+      !  Check that the month of ODATE makes sense.
+      
+      IF ((moold.GT.12).or.(moold.LT.1)) THEN
+!      IF ((moold.GT.99).or.(moold.LT.1)) THEN !VENUS
+         PRINT*, 'GETH_IDTS:  Month of ODATE = ', moold
+         opass = .false.
+      END IF
+      
+      !  Check that the day of NDATE makes sense.
+      
+!      IF (monew.ne.2) THEN
+      ! ...... For all months but February
+         IF ((dynew.GT.mday(monew)).or.(dynew.LT.1)) THEN
+!         IF ((dynew.GT.mday).or.(dynew.LT.1)) THEN !VENUS
+            PRINT*, 'GETH_IDTS:  Day of NDATE = ', dynew
+            npass = .false.
+         END IF
+!      ELSE IF (monew.eq.2) THEN
+!      ! ...... For February
+!         IF ((dynew.GT.nfeb(yrnew)).OR.(dynew.LT.1)) THEN
+!            PRINT*, 'GETH_IDTS:  Day of NDATE = ', dynew
+!            npass = .false.
+!         END IF
+!      END IF
+      
+      !  Check that the day of ODATE makes sense.
+      
+!      IF (moold.ne.2) THEN
+      ! ...... For all months but February
+         IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
+!         IF ((dyold.GT.mday).or.(dyold.LT.1)) THEN !VENUS
+            PRINT*, 'GETH_IDTS:  Day of ODATE = ', dyold
+            opass = .false.
+         END IF
+!      ELSE IF (moold.eq.2) THEN
+!      ! ....... For February
+!         IF ((dyold.GT.nfeb(yrold)).or.(dyold.LT.1)) THEN
+!            PRINT*, 'GETH_IDTS:  Day of ODATE = ', dyold
+!            opass = .false.
+!         END IF
+!      END IF
+      
+      !  Check that the hour of NDATE makes sense.
+      
+      IF ((hrnew.GT.23).or.(hrnew.LT.0)) THEN
+!      IF ((hrnew.GT.35).or.(hrnew.LT.0)) THEN! VENUS
+         PRINT*, 'GETH_IDTS:  Hour of NDATE = ', hrnew
+         npass = .false.
+      END IF
+      
+      !  Check that the hour of ODATE makes sense.
+      
+      IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
+!      IF ((hrold.GT.35).or.(hrold.LT.0)) THEN !VENUS
+         PRINT*, 'GETH_IDTS:  Hour of ODATE = ', hrold
+         opass = .false.
+      END IF
+      
+      !  Check that the minute of NDATE makes sense.
+      
+      IF ((minew.GT.36).or.(minew.LT.0)) THEN
+!      IF ((minew.GT.12).or.(minew.LT.0)) THEN !VENUS
+         PRINT*, 'GETH_IDTS:  Minute of NDATE = ', minew
+         npass = .false.
+      END IF
+      
+      !  Check that the minute of ODATE makes sense.
+      
+      IF ((miold.GT.36).or.(miold.LT.0)) THEN
+!      IF ((miold.GT.12).or.(miold.LT.0)) THEN !VENUS
+         PRINT*, 'GETH_IDTS:  Minute of ODATE = ', miold
+         opass = .false.
+      END IF
+      
+      !  Check that the second of NDATE makes sense.
+      
+      IF ((scnew.GT.99).or.(scnew.LT.0)) THEN
+!      IF ((scnew.GT.8).or.(scnew.LT.0)) THEN !VENUS
+         PRINT*, 'GETH_IDTS:  SECOND of NDATE = ', scnew
+         npass = .false.
+      END IF
+      
+      !  Check that the second of ODATE makes sense.
+      
+      IF ((scold.GT.99).or.(scold.LT.0)) THEN
+!      IF ((scold.GT.8).or.(scold.LT.0)) THEN !VENUS
+         PRINT*, 'GETH_IDTS:  Second of ODATE = ', scold
+         opass = .false.
+      END IF
+      
+      IF (.not. npass) THEN
+         WRITE( wrf_err_message , * ) 'module_date_time: geth_idts: Bad NDATE: ', ndate(1:nlen)
+         CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+      END IF
+      
+      IF (.not. opass) THEN
+         WRITE( wrf_err_message , * ) 'module_date_time: geth_idts: Bad ODATE: ', odate(1:olen)
+         CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+      END IF
+      
+      !  Date Checks are completed.  Continue.
+      
+      !  Compute number of days from 1 January ODATE, 00:00:00 until ndate
+      !  Compute number of hours from 1 January ODATE, 00:00:00 until ndate
+      !  Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
+      
+      newdys = 0
+      DO i = yrold, yrnew - 1
+!         newdys = newdys + (365 + (nfeb(i)-28))
+! so cool to deal with a planet without any february month :)
+         newdys = newdys + 669
+      END DO
+      
+      IF (monew .GT. 1) THEN
+!         mday(2) = nfeb(yrnew)
+         DO i = 1, monew - 1
+            newdys = newdys + mday(i)
+         END DO
+!         mday(2) = 28
+      END IF
+      
+      newdys = newdys + dynew-1
+      
+      !  Compute number of hours from 1 January ODATE, 00:00:00 until odate
+      !  Compute number of minutes from 1 January ODATE, 00:00:00 until odate
+      
+      olddys = 0
+      
+      IF (moold .GT. 1) THEN
+!         mday(2) = nfeb(yrold)
+         DO i = 1, moold - 1
+            olddys = olddys + mday(i)
+         END DO
+!         mday(2) = 28
+      END IF
+      
+      olddys = olddys + dyold-1
+      
+      !  Determine the time difference in seconds
+!****MARS      
+      idts = (newdys - olddys) * 88800    !martian sols
+      idts = idts + (hrnew - hrold) * 3700  !hours
+      idts = idts + (minew - miold) * 100  !minutes
+      idts = idts + (scnew - scold)
+!****VENUS
+!      idts = (newdys - olddys) * 4212    !martian sols
+!      idts = idts + (hrnew - hrold) * 117
+!      idts = idts + (minew - miold) * 9
+!      idts = idts + (scnew - scold)
+
+      
+      IF (isign .eq. -1) THEN
+         tdate=ndate
+         ndate=odate
+         odate=tdate
+         idts = idts * isign
+      END IF
+   
+   END SUBROUTINE geth_idts
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE geth_newdate (ndate, odate, idt)
+   
+      IMPLICIT NONE
+      
+      !  From old date ('YYYY-MM-DD HH:MM:SS.ffff') and 
+      !  delta-time, compute the new date.
+   
+      !  on entry     -  odate  -  the old hdate.
+      !                  idt    -  the change in time
+   
+      !  on exit      -  ndate  -  the new hdate.
+      
+      INTEGER , INTENT(IN)           :: idt
+      CHARACTER (LEN=*) , INTENT(OUT) :: ndate
+      CHARACTER (LEN=*) , INTENT(IN)  :: odate
+      
+       
+      !  Local Variables
+       
+      !  yrold    -  indicates the year associated with "odate"
+      !  moold    -  indicates the month associated with "odate"
+      !  dyold    -  indicates the day associated with "odate"
+      !  hrold    -  indicates the hour associated with "odate"
+      !  miold    -  indicates the minute associated with "odate"
+      !  scold    -  indicates the second associated with "odate"
+       
+      !  yrnew    -  indicates the year associated with "ndate"
+      !  monew    -  indicates the month associated with "ndate"
+      !  dynew    -  indicates the day associated with "ndate"
+      !  hrnew    -  indicates the hour associated with "ndate"
+      !  minew    -  indicates the minute associated with "ndate"
+      !  scnew    -  indicates the second associated with "ndate"
+       
+      !  mday     -  a list assigning the number of days in each month
+      
+      !  i        -  loop counter
+      !  nday     -  the integer number of days represented by "idt"
+      !  nhour    -  the integer number of hours in "idt" after taking out
+      !              all the whole days
+      !  nmin     -  the integer number of minutes in "idt" after taking out
+      !              all the whole days and whole hours.
+      !  nsec     -  the integer number of minutes in "idt" after taking out
+      !              all the whole days, whole hours, and whole minutes.
+       
+      INTEGER :: nlen, olen
+      INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
+      INTEGER :: yrold, moold, dyold, hrold, miold, scold, frold
+      INTEGER :: mday(12), nday, nhour, nmin, nsec, nfrac, i, ifrc
+!VENUS 
+!      INTEGER :: mday
+      LOGICAL :: opass
+      CHARACTER (LEN=10) :: hfrc
+      CHARACTER (LEN=1) :: sp
+!      INTEGER, EXTERNAL :: nfeb  ! in the same module now
+      
+      !  Assign the number of days in a months
+
+      mday( 1) = 61
+      mday( 2) = 66
+      mday( 3) = 66
+      mday( 4) = 65
+      mday( 5) = 60
+      mday( 6) = 54
+      mday( 7) = 50
+      mday( 8) = 46
+      mday( 9) = 47
+      mday(10) = 47
+      mday(11) = 51
+      mday(12) = 56
+!     mday = 24 !VENUS      
+      !  Break down old hdate into parts
+      
+      hrold = 0
+      miold = 0
+      scold = 0
+      frold = 0
+      olen = LEN(odate)
+      IF (olen.GE.11) THEN
+         sp = odate(11:11)
+      else
+         sp = ' '
+      END IF
+      
+      !  Use internal READ statements to convert the CHARACTER string
+      !  date into INTEGER components.
+   
+      READ(odate(1:4),  '(I4)') yrold
+      READ(odate(6:7),  '(I2)') moold
+      READ(odate(9:10), '(I2)') dyold
+      IF (olen.GE.13) THEN
+         READ(odate(12:13),'(I2)') hrold
+         IF (olen.GE.16) THEN
+            READ(odate(15:16),'(I2)') miold
+            IF (olen.GE.19) THEN
+               READ(odate(18:19),'(I2)') scold
+               IF (olen.GT.20) THEN
+                  READ(odate(21:olen),'(I2)') frold
+               END IF
+            END IF
+         END IF
+      END IF
+      
+!      !  Set the number of days in February for that year.
+      
+!      mday(2) = nfeb(yrold)
+      
+      !  Check that ODATE makes sense.
+      
+      opass = .TRUE.
+      
+      !  Check that the month of ODATE makes sense.
+      
+      IF ((moold.GT.12).or.(moold.LT.1)) THEN
+!      IF ((moold.GT.99).or.(moold.LT.1)) THEN !VENUS
+         WRITE(*,*) 'GETH_NEWDATE:  Month of ODATE = ', moold
+         opass = .FALSE.
+      END IF
+      
+      !  Check that the day of ODATE makes sense.
+      
+      IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
+!      IF ((dyold.GT.mday).or.(dyold.LT.1)) THEN !VENUS
+         WRITE(*,*) 'GETH_NEWDATE:  Day of ODATE = ', dyold
+         opass = .FALSE.
+      END IF
+      
+      !  Check that the hour of ODATE makes sense.
+      
+      IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
+!      IF ((hrold.GT.35).or.(hrold.LT.0)) THEN !VENUS
+         WRITE(*,*) 'GETH_NEWDATE:  Hour of ODATE = ', hrold
+         opass = .FALSE.
+      END IF
+      
+      !  Check that the minute of ODATE makes sense.
+      
+      IF ((miold.GT.36).or.(miold.LT.0)) THEN
+!      IF ((miold.GT.12).or.(miold.LT.0)) THEN !VENUS
+         WRITE(*,*) 'GETH_NEWDATE:  Minute of ODATE = ', miold
+         opass = .FALSE.
+      END IF
+      
+      !  Check that the second of ODATE makes sense.
+      
+      IF ((scold.GT.99).or.(scold.LT.0)) THEN
+!      IF ((scold.GT.8).or.(scold.LT.0)) THEN !VENUS
+         WRITE(*,*) 'GETH_NEWDATE:  Second of ODATE = ', scold
+         opass = .FALSE.
+      END IF
+      
+      !  Check that the fractional part  of ODATE makes sense.
+      
+      
+      IF (.not.opass) THEN
+         WRITE( wrf_err_message , * ) 'module_date_time: GETH_NEWDATE: Bad ODATE: ', odate(1:olen), olen
+         CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+      END IF
+      
+      !  Date Checks are completed.  Continue.
+      
+      
+      !  Compute the number of days, hours, minutes, and seconds in idt
+      
+      IF (olen.GT.20) THEN !idt should be in fractions of seconds
+         ifrc = olen-20
+         ifrc = 10**ifrc
+!****MARS
+         nday   = ABS(idt)/(88800*ifrc)
+         nhour  = MOD(ABS(idt),88800*ifrc)/(3700*ifrc)
+         nmin   = MOD(ABS(idt),3700*ifrc)/(100*ifrc)
+         nsec   = MOD(ABS(idt),100*ifrc)/(ifrc)
+!!****VENUS
+!         nday   = ABS(idt)/(4212*ifrc)
+!         nhour  = MOD(ABS(idt),4212*ifrc)/(117*ifrc)
+!         nmin   = MOD(ABS(idt),117*ifrc)/(9*ifrc)
+!         nsec   = MOD(ABS(idt),9*ifrc)/(ifrc)
+
+         nfrac = MOD(ABS(idt), ifrc)
+      ELSE IF (olen.eq.19) THEN  !idt should be in seconds
+         ifrc = 1
+!****MARS
+         nday   = ABS(idt)/88800 ! Integer number of days in delta-time
+         nhour  = MOD(ABS(idt),88800)/3700
+         nmin   = MOD(ABS(idt),3700)/100
+         nsec   = MOD(ABS(idt),100)
+!!****VENUS
+!         nday   = ABS(idt)/4212 ! Integer number of days in delta-time
+!         nhour  = MOD(ABS(idt),4212)/117
+!         nmin   = MOD(ABS(idt),117)/9
+!         nsec   = MOD(ABS(idt),9)
+
+         nfrac  = 0
+      ELSE IF (olen.eq.16) THEN !idt should be in minutes
+         ifrc = 1
+         nday   = ABS(idt)/2400 ! Integer number of days in delta-time
+         nhour  = MOD(ABS(idt),2400)/100
+         nmin   = MOD(ABS(idt),100)
+         nsec   = 0
+         nfrac  = 0
+      ELSE IF (olen.eq.13) THEN !idt should be in hours
+         ifrc = 1
+         nday   = ABS(idt)/24 ! Integer number of days in delta-time
+         nhour  = MOD(ABS(idt),24)
+         nmin   = 0
+         nsec   = 0
+         nfrac  = 0
+      ELSE IF (olen.eq.10) THEN !idt should be in days
+         ifrc = 1
+         nday   = ABS(idt)/24 ! Integer number of days in delta-time
+         nhour  = 0
+         nmin   = 0
+         nsec   = 0
+         nfrac  = 0
+      ELSE
+         WRITE( wrf_err_message , * ) 'module_date_time: GETH_NEWDATE: Strange length for ODATE: ',olen
+         CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+      END IF
+      
+      IF (idt.GE.0) THEN
+      
+         frnew = frold + nfrac
+         IF (frnew.GE.ifrc) THEN
+            frnew = frnew - ifrc
+            nsec = nsec + 1
+         END IF
+      
+         scnew = scold + nsec
+         IF (scnew .GE. 100) THEN
+            scnew = scnew - 100
+!         IF (scnew .GE. 9) THEN !VENUS
+!           scnew = scnew - 9
+            nmin  = nmin + 1
+         END IF
+      
+         minew = miold + nmin
+         IF (minew .GE. 37) THEN
+            minew = minew - 37
+!         IF (minew .GE. 13) THEN !VENUS
+!            minew = minew - 13
+            nhour  = nhour + 1
+         END IF
+      
+         hrnew = hrold + nhour
+         IF (hrnew .GE. 24) THEN
+            hrnew = hrnew - 24
+!         IF (hrnew .LT. 00) THEN !VENUS
+!            hrnew = hrnew + 36
+            nday  = nday + 1
+         END IF
+      
+         dynew = dyold
+         monew = moold
+         yrnew = yrold
+         DO i = 1, nday
+            dynew = dynew + 1
+            IF (dynew.GT.mday(monew)) THEN
+               dynew = dynew - mday(monew)
+               monew = monew + 1
+               IF (monew .GT. 12) THEN
+!               IF (monew .GT. 99) THEN
+                  monew = 1
+                  yrnew = yrnew + 1
+                  !! If the year changes, recompute the number of days in February
+                  !mday(2) = nfeb(yrnew)
+               END IF
+            END IF
+         END DO
+      
+      ELSE IF (idt.LT.0) THEN
+      
+         frnew = frold - nfrac
+         IF (frnew .LT. 0) THEN
+            frnew = frnew + ifrc
+            nsec = nsec - 1
+         END IF
+      
+         scnew = scold - nsec
+         IF (scnew .LT. 00) THEN
+            scnew = scnew + 100
+!            scnew = scnew + 9 !VENUS
+            nmin  = nmin + 1
+         END IF
+      
+         minew = miold - nmin
+         IF (minew .LT. 00) THEN
+            minew = minew + 37
+!            minew = minew + 13 !VENUS
+            nhour  = nhour + 1
+         END IF
+      
+         hrnew = hrold - nhour
+         IF (hrnew .LT. 00) THEN
+            hrnew = hrnew + 24
+!            hrnew = hrnew + 36 !VENUS
+            nday  = nday + 1
+         END IF
+      
+         dynew = dyold
+         monew = moold
+         yrnew = yrold
+         DO i = 1, nday
+            dynew = dynew - 1
+            IF (dynew.eq.0) THEN
+               monew = monew - 1
+               IF (monew.eq.0) THEN
+                  monew = 12
+!                  monew = 99 !VENUS
+                  yrnew = yrnew - 1
+                  !! If the year changes, recompute the number of days in February
+                  !mday(2) = nfeb(yrnew)
+               END IF
+               dynew = mday(monew)
+            END IF
+         END DO
+      END IF
+      
+      !  Now construct the new mdate
+      
+      nlen = LEN(ndate)
+      
+      IF (nlen.GT.20) THEN
+         WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
+         WRITE(hfrc,'(I10)') frnew+1000000000
+         ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
+      
+      ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
+         WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
+      19   format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)
+         IF (nlen.eq.20) ndate = ndate(1:19)//'.'
+      
+      ELSE IF (nlen.eq.16) THEN
+         WRITE(ndate,16) yrnew, monew, dynew, hrnew, minew
+      16   format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2)
+      
+      ELSE IF (nlen.eq.13) THEN
+         WRITE(ndate,13) yrnew, monew, dynew, hrnew
+      13   format(I4,'-',I2.2,'-',I2.2,'_',I2.2)
+      
+      ELSE IF (nlen.eq.10) THEN
+         WRITE(ndate,10) yrnew, monew, dynew
+      10   format(I4,'-',I2.2,'-',I2.2)
+      
+      END IF
+      
+      IF (olen.GE.11) ndate(11:11) = sp
+   
+   END SUBROUTINE geth_newdate
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!   FUNCTION nfeb ( year ) RESULT (num_days)
+!   
+!      ! Compute the number of days in February for the given year
+!   
+!      IMPLICIT NONE
+!   
+!      INTEGER :: year
+!      INTEGER :: num_days
+! 
+!        num_days = 99999
+!        PRINT *, 'WARNING !'  
+!! normally never called ...        
+!  
+!!      num_days = 28 ! By default, February has 28 days ...
+!!      IF (MOD(year,4).eq.0) THEN  
+!!         num_days = 29  ! But every four years, it has 29 days ...
+!!         IF (MOD(year,100).eq.0) THEN
+!!            num_days = 28  ! Except every 100 years, when it has 28 days ...
+!!            IF (MOD(year,400).eq.0) THEN
+!!               num_days = 29  ! Except every 400 years, when it has 29 days.
+!!            END IF
+!!         END IF
+!!      END IF
+!   
+!   END FUNCTION nfeb
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   SUBROUTINE split_date_char ( date , century_year , month , day , hour , minute , second , ten_thousandth)
+     
+      IMPLICIT NONE
+   
+      !  Input data.
+   
+      CHARACTER(LEN=24) , INTENT(IN) :: date 
+   
+      !  Output data.
+   
+      INTEGER , INTENT(OUT) :: century_year , month , day , hour , minute , second , ten_thousandth
+      
+      READ(date,FMT='(    I4)') century_year
+      READ(date,FMT='( 5X,I2)') month
+      READ(date,FMT='( 8X,I2)') day
+      READ(date,FMT='(11X,I2)') hour
+      READ(date,FMT='(14X,I2)') minute
+      READ(date,FMT='(17X,I2)') second
+      READ(date,FMT='(20X,I4)') ten_thousandth
+   
+   END SUBROUTINE split_date_char
+
+   SUBROUTINE init_module_date_time
+   END SUBROUTINE init_module_date_time
+
+END MODULE module_date_time
+
+
+   ! TBH:  NOTE:  
+   ! TBH:  Linkers whine if these routines are placed inside the module.  Not 
+   ! TBH:  sure if these should live here or inside an external package.  They 
+   ! TBH:  have dependencies both on WRF (for the format of the WRF date-time 
+   ! TBH:  strings) and on the time manager.  Currently, the format of the WRF 
+   ! TBH:  date-time strings is a slight variant on ISO 8601 (ISO is 
+   ! TBH:  "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss").  If we 
+   ! TBH:  change the WRF format to match the standard, then we remove the 
+   ! TBH:  WRF dependence...  
+
+   ! Converts WRF date-time string into an WRFU_Time object.  
+   ! The format of the WRF date-time strings is a slight variant on ISO 8601: 
+   ! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss".  
+   SUBROUTINE wrf_atotime ( str, time )
+      USE module_utility
+      CHARACTER (LEN=*), INTENT( IN) :: str
+      TYPE(WRFU_Time),   INTENT(OUT) :: time
+      INTEGER yr, mm, dd, h, m, s, ms
+      INTEGER rc
+      IF ( LEN( str ) .GE. 20 ) THEN
+        IF ( str(20:20) .EQ. '.' ) THEN
+          READ(str,34) yr,mm,dd,h,m,s,ms
+          !  last four digits are ten-thousandths of a sec, convert to ms
+          ms=nint(real(ms)/10)
+        ELSE
+          READ(str,33) yr,mm,dd,h,m,s
+          ms = 0
+        ENDIF
+      ELSE
+        READ(str,33) yr,mm,dd,h,m,s
+        ms = 0
+      ENDIF
+      CALL WRFU_TimeSet( time, YY=yr, MM=mm, DD=dd, H=h, M=m, S=s, MS=ms, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeSet() in wrf_atotime() FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+33 FORMAT (I4.4,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2)
+34 FORMAT (I4.4,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I4.4)
+      RETURN
+   END SUBROUTINE wrf_atotime
+
+
+
+   ! Converts an WRFU_Time object into a WRF date-time string.  
+   ! The format of the WRF date-time strings is a slight variant on ISO 8601: 
+   ! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss".  
+   SUBROUTINE wrf_timetoa ( time, str )
+      USE module_utility
+      TYPE(WRFU_Time),   INTENT( IN) :: time
+      CHARACTER (LEN=*), INTENT(OUT) :: str
+      INTEGER strlen,rc
+      CHARACTER (LEN=256) :: mess, tmpstr
+       ! Assertion
+       IF ( LEN(str) < 19 ) THEN
+         CALL wrf_error_fatal( 'wrf_timetoa:  str is too short' )
+       ENDIF
+       tmpstr = ''
+      CALL WRFU_TimeGet( time, timeString=tmpstr, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeGet() in wrf_timetoa() FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+      ! change ISO 8601 'T' to WRF '_' and hack off fraction if str is not
+      ! big enough to hold it
+      strlen = MIN( LEN(str), LEN_TRIM(tmpstr) )
+      str = ''
+      str(1:strlen) = tmpstr(1:strlen)
+      str(11:11) = '_'
+      WRITE (mess,*) 'DEBUG wrf_timetoa():  returning with str = [',TRIM(str),']'
+      CALL wrf_debug ( 150 , TRIM(mess) )
+      RETURN
+   END SUBROUTINE wrf_timetoa
+
+
+
+   ! Converts an WRFU_TimeInterval object into a time-interval string.
+   SUBROUTINE wrf_timeinttoa ( timeinterval, str )
+      USE module_utility
+      TYPE(WRFU_TimeInterval),   INTENT( IN) :: timeinterval
+      CHARACTER (LEN=*), INTENT(OUT) :: str
+      INTEGER rc
+      CHARACTER (LEN=256) :: mess
+      CALL WRFU_TimeIntervalGet( timeinterval, timeString=str, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalGet() in wrf_timeinttoa() FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+      WRITE (mess,*) 'DEBUG wrf_timeinttoa():  returning with str = [',TRIM(str),']'
+      CALL wrf_debug ( 150 , TRIM(mess) )
+      RETURN
+   END SUBROUTINE wrf_timeinttoa
+
+
+
+
+   ! Debug routine to print key clock information.  
+   ! Every printed line begins with pre_str.  
+   SUBROUTINE wrf_clockprint ( level, clock, pre_str )
+      USE module_utility
+      INTEGER,           INTENT( IN) :: level
+      TYPE(WRFU_Clock),  INTENT( IN) :: clock
+      CHARACTER (LEN=*), INTENT( IN) :: pre_str
+      INTEGER rc
+      INTEGER :: debug_level
+      TYPE(WRFU_Time) :: currTime, startTime, stopTime
+      TYPE(WRFU_TimeInterval) :: timeStep
+      CHARACTER (LEN=64) :: currTime_str, startTime_str, stopTime_str
+      CHARACTER (LEN=64) :: timeStep_str
+      CHARACTER (LEN=256) :: mess
+      CALL get_wrf_debug_level( debug_level )
+      IF ( level .LE. debug_level ) THEN
+        CALL WRFU_ClockGet( clock, CurrTime=currTime, StartTime=startTime, &
+                                   StopTime=stopTime, TimeStep=timeStep, rc=rc )
+        CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                              'wrf_clockprint:  WRFU_ClockGet() FAILED', &
+                              __FILE__ , &
+                              __LINE__  )
+        CALL wrf_timetoa( currTime, currTime_str )
+        CALL wrf_timetoa( startTime, startTime_str )
+        CALL wrf_timetoa( stopTime, stopTime_str )
+	CALL wrf_timeinttoa( timeStep, timeStep_str )
+        WRITE (mess,*) TRIM(pre_str),'  clock start time = ',TRIM(startTime_str)
+        CALL wrf_message(TRIM(mess))
+        WRITE (mess,*) TRIM(pre_str),'  clock current time = ',TRIM(currTime_str)
+        CALL wrf_message(TRIM(mess))
+        WRITE (mess,*) TRIM(pre_str),'  clock stop time = ',TRIM(stopTime_str)
+        CALL wrf_message(TRIM(mess))
+        WRITE (mess,*) TRIM(pre_str),'  clock time step = ',TRIM(timeStep_str)
+        CALL wrf_message(TRIM(mess))
+      ENDIF
+      RETURN
+   END SUBROUTINE wrf_clockprint
+
Index: trunk/WRF.COMMON/WRFV2/share/module_get_file_names.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_get_file_names.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_get_file_names.F	(revision 2744)
@@ -0,0 +1,192 @@
+MODULE module_get_file_names
+
+!  This module is used by the ndown program.  We can have multiple output
+!  files generated from the wrf program.  To remove the  what-are-the-
+!  files-to-input-to-ndown task from the user, we use a couple of UNIX
+!  commands.  These are activated from either the "system" command or 
+!  the "exec" command.  Neither is part of the Fortran standard.
+
+   INTEGER :: number_of_eligible_files
+   CHARACTER(LEN=132) , DIMENSION(:) , ALLOCATABLE :: eligible_file_name
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+#ifdef crayx1
+   SUBROUTINE system(cmd)
+      IMPLICIT NONE
+      CHARACTER (LEN=*) , INTENT(IN) :: cmd
+      integer :: ierr
+      call pxfsystem(cmd, len(cmd), ierr)
+   RETURN
+   END SUBROUTINE system
+#endif
+
+   SUBROUTINE unix_ls ( root , id )
+      USE module_dm
+
+      IMPLICIT NONE
+     
+      CHARACTER (LEN=*) , INTENT(IN) :: root
+      INTEGER , INTENT(IN) :: id
+
+      CHARACTER (LEN=132) :: command
+      INTEGER :: ierr , loop , loslen , strlen
+      LOGICAL :: unix_access_ok
+      LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+      CHARACTER*256 message
+
+      !  This is to make sure that we successfully use one of the available methods
+      !  for getting at a UNIX command.  This is an initialized flag.
+
+      unix_access_ok = .FALSE.
+
+      !  Build a UNIX command, and "ls", of all of the files mnatching the "root*" prefix.
+
+      monitor_only_code : IF ( wrf_dm_on_monitor() ) THEN
+
+         loslen = LEN ( command )
+         CALL all_spaces ( command , loslen ) 
+         WRITE ( command , FMT='("ls -1 ",A,"*d",I2.2,"* > .foo")' ) TRIM ( root ) , id
+         
+         !  We stuck all of the matching files in the ".foo" file.  Now we place the 
+         !  number of the those file (i.e. how many there are) in ".foo1".  Also, if we
+         !  do get inside one of these CPP ifdefs, then we set our access flag to true.
+
+#ifdef NONSTANDARD_SYSTEM 
+         CALL SYSTEM ( TRIM ( command ) ) 
+         CALL SYSTEM ( '( cat .foo | wc -l > .foo1 )' )
+         unix_access_ok = .TRUE.
+#endif
+#ifdef NONSTANDARD_EXEC
+         CALL SYSTEM ( TRIM ( command ) ) 
+         CALL SYSTEM ( '( cat .foo | wc -l > .foo1 )' )
+         unix_access_ok = .TRUE.
+#endif
+
+         !  Test to be sure that we did indeed hit one of the ifdefs.
+
+         IF ( .NOT. unix_access_ok ) THEN
+            PRINT *,'Oops, how can I access UNIX commands from Fortran?'
+            CALL wrf_error_fatal ( 'system_or_exec_only' )
+         END IF
+
+         !  Read the number of files.
+
+         OPEN (FILE   = '.foo1'       , &
+               UNIT   = 112           , &
+               STATUS = 'OLD'         , &
+               ACCESS = 'SEQUENTIAL'  , &
+               FORM   = 'FORMATTED'     )
+
+         READ ( 112 , * ) number_of_eligible_files
+         CLOSE ( 112 )
+
+         !  If there are zero files, we are toast.
+
+         IF ( number_of_eligible_files .LE. 0 ) THEN
+            PRINT *,'Oops, we need at least ONE input file (wrfout*) for the ndown program to read.'
+            CALL wrf_error_fatal ( 'need_wrfout_input_data' )
+         END IF
+
+      ENDIF monitor_only_code
+
+      !  On the monitor proc, we got the number of files.  We use that number to
+      !  allocate space on all of the procs.
+
+      CALL wrf_dm_bcast_integer ( number_of_eligible_files, 1 )
+
+      !  Allocate space for this many files.
+
+      ALLOCATE ( eligible_file_name(number_of_eligible_files) , STAT=ierr )
+
+      !  Did the allocate work OK?
+
+      IF ( ierr .NE. 0 ) THEN
+print *,'tried to allocate ',number_of_eligible_files,' eligible files, (look at ./foo)'
+         WRITE(message,*)'module_get_file_names: unix_ls: unable to allocate filename array Status = ',ierr
+         CALL wrf_error_fatal( message )
+      END IF
+
+      !  Initialize all of the file names to blank.
+
+      CALL init_module_get_file_names
+
+      !  Now we go back to a single monitor proc to read in the file names.
+
+      monitor_only_code2: IF ( wrf_dm_on_monitor() ) THEN
+
+         !  Open the file that has the list of filenames.
+
+         OPEN (FILE   = '.foo'        , &
+               UNIT   = 111           , &
+               STATUS = 'OLD'         , &
+               ACCESS = 'SEQUENTIAL'  , &
+               FORM   = 'FORMATTED'     )
+
+         !  Read all of the file names and store them.
+
+         DO loop = 1 , number_of_eligible_files
+            READ ( 111 , FMT='(A)' ) eligible_file_name(loop)
+print *,TRIM(eligible_file_name(loop))
+         END DO
+         CLOSE ( 111 )
+
+         !   We clean up our own messes.
+
+#ifdef NONSTANDARD_SYSTEM 
+         CALL SYSTEM ( '/bin/rm -f .foo'  )
+         CALL SYSTEM ( '/bin/rm -f .foo1' )
+#endif
+#ifdef NONSTANDARD_EXEC
+         CALL SYSTEM ( '/bin/rm -f .foo'  )
+         CALL SYSTEM ( '/bin/rm -f .foo1' )
+#endif
+
+      ENDIF monitor_only_code2
+
+      !  Broadcast the file names to everyone on all of the procs.
+
+      DO loop = 1 , number_of_eligible_files
+         strlen = LEN( TRIM( eligible_file_name(loop) ) )
+         CALL wrf_dm_bcast_string ( eligible_file_name(loop) , strlen  )
+      ENDDO
+
+   END SUBROUTINE unix_ls
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE all_spaces ( command , length_of_char ) 
+
+      IMPLICIT NONE
+
+      INTEGER :: length_of_char
+      CHARACTER (LEN=length_of_char) :: command
+      INTEGER :: loop
+
+      DO loop = 1 , length_of_char
+         command(loop:loop) = ' '
+      END DO
+
+   END SUBROUTINE all_spaces
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE init_module_get_file_names
+   
+      IMPLICIT NONE
+      eligible_file_name = '                                                  ' // &
+                           '                                                  ' // &
+                           '                                '
+
+   END SUBROUTINE init_module_get_file_names
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+END MODULE module_get_file_names
+
+!program foo
+!USE module_get_file_names
+!call init_module_get_file_names
+!call unix_ls ( 'wrf_real' , 1 )
+!end program foo
Index: trunk/WRF.COMMON/WRFV2/share/module_interp_fcn.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_interp_fcn.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_interp_fcn.F	(revision 2744)
@@ -0,0 +1,56 @@
+!WRF:MEDIATION_LAYER:INTERPOLATIONFUNCTION
+!
+
+   SUBROUTINE interp_fcn ( cfld,                                 &  ! CD field
+                           cids, cide, ckds, ckde, cjds, cjde,   &
+                           cims, cime, ckms, ckme, cjms, cjme,   &
+                           cits, cite, ckts, ckte, cjts, cjte,   &
+                           nfld,                                 &  ! ND field
+                           nids, nide, nkds, nkde, njds, njde,   &
+                           nims, nime, nkms, nkme, njms, njme,   &
+                           nits, nite, nkts, nkte, njts, njte,   &
+                           nri, nrj                             )   ! nest ratios
+     IMPLICIT NONE
+
+
+     INTEGER, INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde,   &
+                            cims, cime, ckms, ckme, cjms, cjme,   &
+                            cits, cite, ckts, ckte, cjts, cjte,   &
+                            nids, nide, nkds, nkde, njds, njde,   &
+                            nims, nime, nkms, nkme, njms, njme,   &
+                            nits, nite, nkts, nkte, njts, njte,   &
+                            nri, nrj
+
+     REAL, DIMENSION ( cims:cime, ckms:ckme, cjms:cjme ) :: cfld
+     REAL, DIMENSION ( nims:nime, nkms:nkme, njms:njme ) :: nfld
+
+     ! Local
+
+     INTEGER ci, cj, ck, ni, nj, nk, ip, jp
+
+     ! Iterate over the ND tile and comtute the values
+     ! from the CD tile. 
+
+     DO nj = njts, njte
+        cj = cjts + nj / nrj          ! coord of CD point
+        jp = cjts + mod ( nj , nrj )  ! coord of ND w/i CD point
+        DO nk = nkts, nkte
+           ck = nk
+           DO ni = nits, nite
+              ci = cits + ni / nri          ! coord of CD point
+              ip = cits + mod ( ni , nri )  ! coord of ND w/i CD point
+
+              ! This is a trivial implementation of the interp_fcn; just copies
+              ! the values from the CD into the ND
+
+              nfld( ni, nk, nj ) = cfld( ci , ck , cj )
+
+           ENDDO
+        ENDDO
+     ENDDO
+
+     RETURN
+
+   END SUBROUTINE interp_fcn
+
+
Index: trunk/WRF.COMMON/WRFV2/share/module_io_domain.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_io_domain.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_io_domain.F	(revision 2744)
@@ -0,0 +1,972 @@
+!WRF:MEDIATION_LAYER:IO
+!
+
+MODULE module_io_domain
+USE module_io
+USE module_io_wrf
+USE module_wrf_error
+USE module_date_time
+USE module_configure
+USE module_domain
+
+CONTAINS
+
+  SUBROUTINE open_r_dataset ( id , fname , grid , config_flags , sysdepinfo, ierr )
+   TYPE (domain)             :: grid
+   CHARACTER*(*) :: fname
+   CHARACTER*(*) :: sysdepinfo
+   INTEGER      , INTENT(INOUT) :: id , ierr
+   LOGICAL , EXTERNAL :: wrf_dm_on_monitor
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+   CHARACTER*128             :: DataSet
+   LOGICAL                   :: anyway
+   CALL wrf_open_for_read ( fname ,                     &
+                            grid%communicator ,         &
+                            grid%iocommunicator ,       &
+                            sysdepinfo ,                &
+                            id ,                        &
+                            ierr )
+   RETURN
+  END SUBROUTINE open_r_dataset
+
+  SUBROUTINE open_w_dataset ( id , fname , grid , config_flags , outsub , sysdepinfo, ierr )
+   TYPE (domain)             :: grid
+   CHARACTER*(*) :: fname
+   CHARACTER*(*) :: sysdepinfo
+   INTEGER      , INTENT(INOUT) :: id , ierr
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+   LOGICAL , EXTERNAL :: wrf_dm_on_monitor
+   EXTERNAL outsub
+   CHARACTER*128             :: DataSet
+   LOGICAL                   :: anyway
+   CALL wrf_debug ( 100 , 'calling wrf_open_for_write_begin in open_w_dataset' )
+   CALL wrf_open_for_write_begin ( fname ,     &
+                                   grid%communicator ,         &
+                                   grid%iocommunicator ,       &
+                                   sysdepinfo ,                &
+                                   id ,                        &
+                                   ierr )
+   IF ( ierr .LE. 0 ) THEN
+     CALL wrf_debug ( 100 , 'calling outsub in open_w_dataset' )
+     CALL outsub( id , grid , config_flags , ierr )
+     CALL wrf_debug ( 100 , 'back from outsub in open_w_dataset' )
+   ENDIF
+   IF ( ierr .LE. 0 ) THEN
+     CALL wrf_debug ( 100 , 'calling wrf_open_for_write_commit in open_w_dataset' )
+     CALL wrf_open_for_write_commit ( id ,                        &
+                                      ierr )
+     CALL wrf_debug ( 100 , 'back from wrf_open_for_write_commit in open_w_dataset' )
+   ENDIF
+  END SUBROUTINE open_w_dataset
+
+  SUBROUTINE open_u_dataset ( id , fname , grid , config_flags , insub , sysdepinfo, ierr )
+   TYPE (domain)             :: grid
+   CHARACTER*(*) :: fname
+   CHARACTER*(*) :: sysdepinfo
+   INTEGER      , INTENT(INOUT) :: id , ierr
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+   LOGICAL , EXTERNAL :: wrf_dm_on_monitor
+   EXTERNAL insub
+   CHARACTER*128             :: DataSet
+   LOGICAL                   :: anyway
+   CALL wrf_debug ( 100 , 'calling wrf_open_for_read_begin in open_u_dataset' )
+   CALL wrf_open_for_read_begin ( fname ,     &
+                                   grid%communicator ,         &
+                                   grid%iocommunicator ,       &
+                                   sysdepinfo ,                &
+                                   id ,                        &
+                                   ierr )
+   IF ( ierr .LE. 0 ) THEN
+     CALL wrf_debug ( 100 , 'calling insub in open_u_dataset' )
+     CALL insub( id , grid , config_flags , ierr )
+   ENDIF
+   IF ( ierr .LE. 0 ) THEN
+     CALL wrf_debug ( 100 , 'calling wrf_open_for_read_commit in open_u_dataset' )
+     CALL wrf_open_for_read_commit ( id ,                        &
+                                       ierr )
+     CALL wrf_debug ( 100 , 'back from wrf_open_for_read_commit in open_u_dataset' )
+   ENDIF
+  END SUBROUTINE open_u_dataset
+
+  SUBROUTINE close_dataset( id , config_flags, sysdepinfo ) 
+   IMPLICIT NONE
+   INTEGER id , ierr
+   LOGICAL , EXTERNAL :: wrf_dm_on_monitor
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+   CHARACTER*(*) :: sysdepinfo
+   CHARACTER*128             :: DataSet
+   LOGICAL                   :: anyway
+   CALL wrf_ioclose( id , ierr )
+  END SUBROUTINE close_dataset
+
+
+! ------------  Output model input data sets
+
+  SUBROUTINE output_model_input ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_input .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , model_input_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_model_input
+
+  SUBROUTINE output_aux_model_input1 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput1 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input1_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input1
+
+  SUBROUTINE output_aux_model_input2 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput2 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input2_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input2
+
+  SUBROUTINE output_aux_model_input3 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput3 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input3_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input3
+
+  SUBROUTINE output_aux_model_input4 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput4 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input4_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input4
+
+  SUBROUTINE output_aux_model_input5 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput5 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input5_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input5
+
+  SUBROUTINE output_aux_model_input6 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput6 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input6_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input6
+
+  SUBROUTINE output_aux_model_input7 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput7 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input7_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input7
+
+  SUBROUTINE output_aux_model_input8 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput8 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input8_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input8
+
+  SUBROUTINE output_aux_model_input9 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput9 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input9_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input9
+
+  SUBROUTINE output_aux_model_input10 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_gfdda .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input10_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input10
+
+  SUBROUTINE output_aux_model_input11 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput11 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_model_input11_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_model_input11
+
+!  ------------ Output model history data sets
+
+  SUBROUTINE output_history ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_history .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , history_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_history
+
+  SUBROUTINE output_aux_hist1 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist1 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist1_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist1
+
+  SUBROUTINE output_aux_hist2 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist2 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist2_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist2
+
+  SUBROUTINE output_aux_hist3 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist3 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist3_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist3
+
+  SUBROUTINE output_aux_hist4 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist4 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist4_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist4
+
+  SUBROUTINE output_aux_hist5 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist5 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist5_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist5
+
+  SUBROUTINE output_aux_hist6 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist6 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist5_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist6
+
+  SUBROUTINE output_aux_hist7 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist7 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist7_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist7
+
+  SUBROUTINE output_aux_hist8 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist8 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist8_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist8
+
+  SUBROUTINE output_aux_hist9 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist9 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist9_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist9
+
+  SUBROUTINE output_aux_hist10 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist10 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist10_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist10
+
+  SUBROUTINE output_aux_hist11 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist11 .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , aux_hist11_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_aux_hist11
+
+!  ------------ Output model restart data sets
+
+  SUBROUTINE output_restart ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr 
+    IF ( config_flags%io_form_restart .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , restart_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_restart
+
+!  ------------ Output model boundary data sets
+
+  SUBROUTINE output_boundary ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid 
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_boundary .GT. 0 ) THEN
+      CALL output_wrf ( fid , grid , config_flags , boundary_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE output_boundary
+
+!  ------------ Input model input data sets
+
+  SUBROUTINE input_model_input ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_input .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , model_input_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_model_input
+
+  SUBROUTINE input_aux_model_input1 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput1 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input1_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input1
+
+  SUBROUTINE input_aux_model_input2 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput2 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input2_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input2
+
+  SUBROUTINE input_aux_model_input3 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput3 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input3_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input3
+
+  SUBROUTINE input_aux_model_input4 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput4 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input4_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input4
+
+  SUBROUTINE input_aux_model_input5 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput5 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input5_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input5
+
+  SUBROUTINE input_aux_model_input6 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput6 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input6_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input6
+  SUBROUTINE input_aux_model_input7 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput7 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input7_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input7
+  SUBROUTINE input_aux_model_input8 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput8 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input8_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input8
+  SUBROUTINE input_aux_model_input9 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput9 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input9_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input9
+  SUBROUTINE input_aux_model_input10 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_gfdda .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input10_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input10
+  SUBROUTINE input_aux_model_input11 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxinput11 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_model_input11_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_model_input11
+
+!  ------------ Input model history data sets
+
+  SUBROUTINE input_history ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_history .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , history_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_history
+
+  SUBROUTINE input_aux_hist1 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist1 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist1_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist1
+
+  SUBROUTINE input_aux_hist2 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist2 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist2_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist2
+
+  SUBROUTINE input_aux_hist3 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist3 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist3_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist3
+
+  SUBROUTINE input_aux_hist4 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist4 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist4_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist4
+
+  SUBROUTINE input_aux_hist5 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist5 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist5_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist5
+
+  SUBROUTINE input_aux_hist6 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist6 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist6_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist6
+  SUBROUTINE input_aux_hist7 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist7 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist7_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist7
+  SUBROUTINE input_aux_hist8 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist8 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist8_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist8
+  SUBROUTINE input_aux_hist9 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist9 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist9_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist9
+  SUBROUTINE input_aux_hist10 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist10 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist10_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist10
+  SUBROUTINE input_aux_hist11 ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_auxhist11 .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , aux_hist11_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_aux_hist11
+
+!  ------------ Input model restart data sets
+
+  SUBROUTINE input_restart ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_restart .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , restart_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_restart
+
+!  ------------ Input model boundary data sets
+
+  SUBROUTINE input_boundary ( fid , grid , config_flags , ierr )
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(INOUT) :: ierr
+    IF ( config_flags%io_form_boundary .GT. 0 ) THEN
+      CALL input_wrf ( fid , grid , config_flags , boundary_only , ierr )
+    ENDIF
+    RETURN
+  END SUBROUTINE input_boundary
+
+END MODULE module_io_domain
+
+! move outside module so callable without USE of module
+SUBROUTINE construct_filename1( result , basename , fld1 , len1 )
+  IMPLICIT NONE
+  CHARACTER*(*) :: result
+  CHARACTER*(*) :: basename
+  INTEGER , INTENT(IN) :: fld1 , len1
+  CHARACTER*64         :: t1, zeros
+  
+  CALL zero_pad ( t1 , fld1 , len1 )
+  result = TRIM(basename) // "_d" // TRIM(t1)
+  CALL maybe_remove_colons(result)
+  RETURN
+END SUBROUTINE construct_filename1
+
+SUBROUTINE construct_filename2( result , basename , fld1 , len1 , date_char )
+  IMPLICIT NONE
+  CHARACTER*(*) :: result
+  CHARACTER*(*) :: basename
+  CHARACTER*(*) :: date_char
+
+  INTEGER , INTENT(IN) :: fld1 , len1
+  CHARACTER*64         :: t1, zeros
+  CALL zero_pad ( t1 , fld1 , len1 )
+  result = TRIM(basename) // ".d" // TRIM(t1) // "." // TRIM(date_char)
+  CALL maybe_remove_colons(result)
+  RETURN
+END SUBROUTINE construct_filename2
+
+! this version looks for <date> and <domain> in the basename and replaces with the arguments
+
+SUBROUTINE construct_filename2a( result , basename , fld1 , len1 , date_char )
+  IMPLICIT NONE
+  CHARACTER*(*) :: result
+  CHARACTER*(*) :: basename
+  CHARACTER*(*) :: date_char
+
+  INTEGER , INTENT(IN) :: fld1 , len1
+  CHARACTER*64         :: t1, zeros
+  INTEGER   i, j, l
+  result=basename
+  CALL zero_pad ( t1 , fld1 , len1 )
+  i = index( basename , '<domain>' )
+  l = len(trim(basename))
+  IF ( i .GT. 0 ) THEN
+    result = basename(1:i-1) // TRIM(t1) // basename(i+8:l)
+  ENDIF
+  i = index( result , '<date>' )
+  l = len(trim(result))
+  IF ( i .GT. 0 ) THEN
+    result = result(1:i-1) // TRIM(date_char) // result(i+6:l)
+  ENDIF
+  CALL maybe_remove_colons(result)
+  RETURN
+END SUBROUTINE construct_filename2a
+
+SUBROUTINE construct_filename ( result , basename , fld1 , len1 , fld2 , len2 )
+  IMPLICIT NONE
+  CHARACTER*(*) :: result
+  CHARACTER*(*) :: basename
+  INTEGER , INTENT(IN) :: fld1 , len1 , fld2 , len2
+  CHARACTER*64         :: t1, t2, zeros
+  
+  CALL zero_pad ( t1 , fld1 , len1 )
+  CALL zero_pad ( t2 , fld2 , len2 )
+  result = TRIM(basename) // "_d" // TRIM(t1) // "_" // TRIM(t2)
+  CALL maybe_remove_colons(result)
+  RETURN
+END SUBROUTINE construct_filename
+
+SUBROUTINE construct_filename3 ( result , basename , fld1 , len1 , fld2 , len2, fld3, len3 )
+  IMPLICIT NONE
+  CHARACTER*(*) :: result
+  CHARACTER*(*) :: basename
+  INTEGER , INTENT(IN) :: fld1 , len1 , fld2 , len2, fld3, len3
+  CHARACTER*64         :: t1, t2, t3, zeros
+
+  CALL zero_pad ( t1 , fld1 , len1 )
+  CALL zero_pad ( t2 , fld2 , len2 )
+  CALL zero_pad ( t3 , fld3 , len3 )
+  result = TRIM(basename) // "_d" // TRIM(t1) // "_" // TRIM(t2) // "_" // TRIM(t3)
+  CALL maybe_remove_colons(result)
+  RETURN
+END SUBROUTINE construct_filename3
+
+SUBROUTINE construct_filename4( result , basename , fld1 , len1 , date_char , io_form )
+  IMPLICIT NONE
+  CHARACTER*(*) :: result
+  CHARACTER*(*) :: basename
+  CHARACTER*(*) :: date_char
+
+  INTEGER , INTENT(IN) :: fld1 , len1 , io_form
+  CHARACTER*64         :: t1, zeros
+  CHARACTER*4          :: ext
+  CALL zero_pad ( t1 , fld1 , len1 )
+  IF      ( io_form .EQ. 1 ) THEN
+     ext = '.int'
+  ELSE IF ( io_form .EQ. 2 ) THEN
+     ext = '.nc '
+  ELSE IF ( io_form .EQ. 5 ) THEN
+     ext = '.gb '
+  ELSE
+     CALL wrf_error_fatal ('improper io_form')
+  END IF
+  result = TRIM(basename) // ".d" // TRIM(t1) // "." // TRIM(date_char) // TRIM(ext)
+  CALL maybe_remove_colons(result)
+  RETURN
+END SUBROUTINE construct_filename4
+
+! this version looks for <date> and <domain> in the basename and replaces with the arguments
+
+SUBROUTINE construct_filename4a( result , basename , fld1 , len1 , date_char , io_form )
+  IMPLICIT NONE
+  CHARACTER*(*) :: result
+  CHARACTER*(*) :: basename
+  CHARACTER*(*) :: date_char
+
+  INTEGER , INTENT(IN) :: fld1 , len1 , io_form
+  CHARACTER*64         :: t1, zeros
+  CHARACTER*4          :: ext
+  INTEGER   i, j, l
+  result=basename
+  CALL zero_pad ( t1 , fld1 , len1 )
+  IF      ( MOD(io_form,100) .EQ. 1 ) THEN
+     ext = '.int'
+  ELSE IF ( MOD(io_form,100) .EQ. 2 ) THEN
+     ext = '.nc '
+  ELSE IF ( MOD(io_form,100) .EQ. 5 ) THEN
+     ext = '.gb '
+  ELSE
+     CALL wrf_error_fatal ('improper io_form')
+  END IF
+  l = len(trim(basename))
+  result = basename(1:l) // TRIM(ext)
+  i = index( result , '<domain>' )
+  l = len(trim(result))
+  IF ( i .GT. 0 ) THEN
+    result = result(1:i-1) // TRIM(t1) // result(i+8:l)
+  ENDIF
+  i = index( result , '<date>' )
+  l = len(trim(result))
+  IF ( i .GT. 0 ) THEN
+    result = result(1:i-1) // TRIM(date_char) // result(i+6:l)
+  ENDIF
+  CALL maybe_remove_colons(result)
+  RETURN
+END SUBROUTINE construct_filename4a
+
+SUBROUTINE append_to_filename ( result , basename , fld1 , len1 )
+  IMPLICIT NONE
+  CHARACTER*(*) :: result
+  CHARACTER*(*) :: basename
+  INTEGER , INTENT(IN) :: fld1 , len1
+  CHARACTER*64         :: t1, zeros
+  
+  CALL zero_pad ( t1 , fld1 , len1 )
+  result = TRIM(basename) // "_" // TRIM(t1)
+  CALL maybe_remove_colons(result)
+  RETURN
+END SUBROUTINE append_to_filename
+
+SUBROUTINE zero_pad ( result , fld1 , len1 )
+  IMPLICIT NONE
+  CHARACTER*(*) :: result
+  INTEGER , INTENT (IN)      :: fld1 , len1
+  INTEGER                    :: d , x
+  CHARACTER*64         :: t2, zeros
+  x = fld1 ; d = 0
+  DO WHILE ( x > 0 )
+    x = x / 10
+    d = d + 1
+  END DO
+  write(t2,'(I9)')fld1
+  zeros = '0000000000000000000000000000000'
+  result = zeros(1:len1-d) // t2(9-d+1:9)
+  RETURN
+END SUBROUTINE zero_pad
+
+SUBROUTINE init_wrfio
+   USE module_io
+   IMPLICIT NONE
+   INTEGER ierr
+   CALL wrf_ioinit(ierr)
+END SUBROUTINE init_wrfio
+
+!<DESCRIPTION>
+! This routine figures out the nearest previous time instant 
+! that corresponds to a multiple of the input time interval.
+! Example use is to give the time instant that corresponds to 
+! an I/O interval, even when the current time is a little bit
+! past that time when, for example, the number of model time
+! steps does not evenly divide the I/O interval. JM 20051013
+!</DESCRIPTION>
+! 
+SUBROUTINE adjust_io_timestr ( TI, CT, ST, timestr )
+   USE module_io_domain
+   IMPLICIT NONE
+! Args
+   TYPE(WRFU_Time), INTENT(IN)            :: ST,CT    ! domain start and current time
+   TYPE(WRFU_TimeInterval), INTENT(IN)    :: TI       ! interval
+   CHARACTER*(*), INTENT(INOUT)           :: timestr  ! returned string
+! Local
+   TYPE(WRFU_Time)                        :: OT
+   TYPE(WRFU_TimeInterval)                :: IOI
+   INTEGER                                :: n
+
+   IOI = CT-ST                               ! length of time since starting
+   n = WRFU_TimeIntervalDIVQuot( IOI , TI )  ! number of whole time intervals
+   IOI = TI * n                              ! amount of time since starting in whole time intervals
+   OT = ST + IOI                             ! previous nearest time instant
+   CALL wrf_timetoa( OT, timestr )           ! generate string
+   RETURN
+END SUBROUTINE adjust_io_timestr
+
+! Modify the filename to remove things like ':' from the file name
+! unless it is a drive number. Convert to '_' instead.
+
+SUBROUTINE maybe_remove_colons( FileName )
+  USE module_configure
+  CHARACTER*(*) FileName
+  CHARACTER c, d
+  INTEGER i, l
+  LOGICAL nocolons
+  l = LEN(TRIM(FileName))
+! do not change first two characters (naive way of dealing with
+! possiblity of drive name in a microsoft path
+  CALL nl_get_nocolons(1,nocolons)
+  IF ( nocolons ) THEN
+    DO i = 3, l
+      IF ( FileName(i:i) .EQ. ':' ) THEN
+        FileName(i:i) = '_'
+      ENDIF
+    ENDDO
+  ENDIF
+  RETURN
+END
+
+
+
Index: trunk/WRF.COMMON/WRFV2/share/module_io_wrf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_io_wrf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_io_wrf.F	(revision 2744)
@@ -0,0 +1,61 @@
+!WRF:PACKAGE:IO
+!
+
+MODULE module_io_wrf
+
+  USE module_wrf_error
+  USE module_date_time
+
+! switch parameters
+  INTEGER, PARAMETER :: history_only=1
+  INTEGER, PARAMETER :: aux_hist1_only=2
+  INTEGER, PARAMETER :: aux_hist2_only=3
+  INTEGER, PARAMETER :: aux_hist3_only=4
+  INTEGER, PARAMETER :: aux_hist4_only=5
+  INTEGER, PARAMETER :: aux_hist5_only=6
+  INTEGER, PARAMETER :: aux_hist6_only=7
+  INTEGER, PARAMETER :: aux_hist7_only=8
+  INTEGER, PARAMETER :: aux_hist8_only=9
+  INTEGER, PARAMETER :: aux_hist9_only=10
+  INTEGER, PARAMETER :: aux_hist10_only=11
+  INTEGER, PARAMETER :: aux_hist11_only=12
+  INTEGER, PARAMETER :: model_input_only=13
+  INTEGER, PARAMETER :: aux_model_input1_only=14
+  INTEGER, PARAMETER :: aux_model_input2_only=15
+  INTEGER, PARAMETER :: aux_model_input3_only=16
+  INTEGER, PARAMETER :: aux_model_input4_only=17
+  INTEGER, PARAMETER :: aux_model_input5_only=18
+  INTEGER, PARAMETER :: aux_model_input6_only=19
+  INTEGER, PARAMETER :: aux_model_input7_only=20
+  INTEGER, PARAMETER :: aux_model_input8_only=21
+  INTEGER, PARAMETER :: aux_model_input9_only=22
+  INTEGER, PARAMETER :: aux_model_input10_only=23
+  INTEGER, PARAMETER :: aux_model_input11_only=24
+  INTEGER, PARAMETER :: restart_only=25
+  INTEGER, PARAMETER :: boundary_only=26
+
+CONTAINS
+  SUBROUTINE init_module_io_wrf
+  END SUBROUTINE init_module_io_wrf
+
+END MODULE module_io_wrf
+
+
+  SUBROUTINE debug_io_wrf ( msg , date, ds , de , ps , pe , ms , me )
+    USE module_wrf_error
+    IMPLICIT NONE
+    CHARACTER*(*)  :: msg , date
+    INTEGER , DIMENSION(3) , INTENT(IN) :: ds , de , ps , pe , ms , me
+    IF ( wrf_at_debug_level(300) ) THEN
+      CALL wrf_message ( msg )
+      WRITE(wrf_err_message,*)'date ',date  ; CALL wrf_message ( TRIM(wrf_err_message) )
+      WRITE(wrf_err_message,*)'ds ',ds  ; CALL wrf_message ( TRIM(wrf_err_message) )
+      WRITE(wrf_err_message,*)'de ',de  ; CALL wrf_message ( TRIM(wrf_err_message) )
+      WRITE(wrf_err_message,*)'ps ',ps  ; CALL wrf_message ( TRIM(wrf_err_message) )
+      WRITE(wrf_err_message,*)'pe ',pe  ; CALL wrf_message ( TRIM(wrf_err_message) )
+      WRITE(wrf_err_message,*)'ms ',ms  ; CALL wrf_message ( TRIM(wrf_err_message) )
+      WRITE(wrf_err_message,*)'me ',me  ; CALL wrf_message ( TRIM(wrf_err_message) )
+    ENDIF
+    RETURN
+  END SUBROUTINE debug_io_wrf
+
Index: trunk/WRF.COMMON/WRFV2/share/module_model_constants.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_model_constants.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_model_constants.F	(revision 2744)
@@ -0,0 +1,324 @@
+!WRF:MODEL_LAYER:CONSTANTS
+!
+!PLANET MARS
+
+ MODULE module_model_constants
+   USE module_configure
+   !  2. Following are constants for use in defining real number bounds.
+
+   !  A really small number.
+   character(len=15) :: planet
+   REAL    , PARAMETER :: epsilon         = 1.E-15
+
+   !  4. Following is information related to the physical constants.
+
+   !  These are the physical parameter used within the model.
+
+   !! added in WRFV3
+   real    , parameter :: mwdry        = 43.49 ! molecular weight of dry air (g/mole)
+!
+!-------------------------------
+
+   REAL    , PARAMETER :: asselin      = .025
+!   REAL    , PARAMETER :: asselin      = .0
+   REAL    , PARAMETER :: cb           = 25.
+
+   REAL    , PARAMETER :: XLV0         = 3.15E6
+   REAL    , PARAMETER :: XLV1         = 2370.
+   REAL    , PARAMETER :: XLS0         = 2.905E6
+   REAL    , PARAMETER :: XLS1         = 259.532
+
+   REAL    , PARAMETER :: XLS          = 2.85E6
+   REAL    , PARAMETER :: XLV          = 2.5E6
+   REAL    , PARAMETER :: XLF          = 3.50E5
+
+   REAL    , PARAMETER :: rhowater     = 1000.
+   REAL    , PARAMETER :: rhosnow      = 100.
+   REAL    , PARAMETER :: rhoair0      = 0.02   !Earth Surface density: 1.217 kg/m3
+                                                !Mars Surface density: 0.020 kg/m3
+   REAL    , PARAMETER :: DEGRAD       = 3.1415926/180.
+   REAL    , PARAMETER :: DPD          = 360./669. ! longitude solaire d'un jour?
+
+   REAL    , PARAMETER ::  SVP1=0.6112
+   REAL    , PARAMETER ::  SVP2=17.67
+   REAL    , PARAMETER ::  SVP3=29.65
+   REAL    , PARAMETER ::  SVPT0=273.15
+   REAL    , PARAMETER ::  KARMAN=0.4  ! von karman constant 
+   REAL    , PARAMETER ::  STBOLT=5.67051E-8 ! stefan-boltzmann constant
+
+   !! NB: c_s and c_k in WRFV2 moved to module_diffusion_em.F
+   !! NB: no need in WRFV3 because set in namelist
+   REAL    , PARAMETER ::  prandtl = 1./3.0
+                                         ! constants for w-damping option
+!   REAL    , PARAMETER ::  w_alpha = 0.3 ! strength m/s/s
+   REAL    , PARAMETER ::  w_alpha = 2.0 ! strength m/s/s
+!   REAL    , PARAMETER ::  w_beta  = 1.0 ! activation cfl number
+   REAL    , PARAMETER ::  w_beta  = 0.8 ! activation cfl number
+
+!! in WRFV3
+!   REAL    , PARAMETER ::  w_alpha = 0.3 ! strength m/s/s
+!   REAL    , PARAMETER ::  w_beta  = 1.0 ! activation cfl number
+!!
+       REAL , PARAMETER ::  pq0=379.90516
+       REAL , PARAMETER ::  epsq2=0.2
+!      REAL , PARAMETER ::  epsq2=0.02
+       REAL , PARAMETER ::  a2=17.2693882
+       REAL , PARAMETER ::  a3=273.16
+       REAL , PARAMETER ::  a4=35.86
+       REAL , PARAMETER ::  epsq=1.e-12
+!#if ( NMM_CORE == 1 )
+       REAL , PARAMETER ::  climit=1.e-20
+       REAL , PARAMETER ::  cm1=2937.4
+       REAL , PARAMETER ::  cm2=4.9283
+       REAL , PARAMETER ::  cm3=23.5518
+!       REAL , PARAMETER ::  defc=8.0
+!       REAL , PARAMETER ::  defm=32.0
+       REAL , PARAMETER ::  defc=0.0
+       REAL , PARAMETER ::  defm=99999.0
+       REAL , PARAMETER ::  epsfc=1./1.05
+       REAL , PARAMETER ::  epswet=0.0
+       REAL , PARAMETER ::  fcdif=1./3.
+!       REAL , PARAMETER ::  fcm=0.003
+       REAL , PARAMETER ::  fcm=0.00003
+!       REAL , PARAMETER ::  fcm=0.0
+       REAL , PARAMETER ::  p400=40000.0
+       REAL , PARAMETER ::  phitp=15000.0
+       REAL , PARAMETER ::  pi2=2.*3.1415926
+       REAL , PARAMETER ::  plbtm=105000.0
+       REAL , PARAMETER ::  plomd=64200.0
+       REAL , PARAMETER ::  pmdhi=35000.0
+       REAL , PARAMETER ::  q2ini=0.50
+       REAL , PARAMETER ::  rhcrit_land=0.75
+       REAL , PARAMETER ::  rhcrit_sea=0.80
+       REAL , PARAMETER ::  rlag=14.8125
+       REAL , PARAMETER ::  rlx=0.90
+       REAL , PARAMETER ::  scq2=50.0
+       REAL , PARAMETER ::  slopht=0.001
+       REAL , PARAMETER ::  tlc=2.*0.703972477
+       REAL , PARAMETER ::  wa=0.15
+       REAL , PARAMETER ::  wght=0.35
+       REAL , PARAMETER ::  wpc=0.075
+       REAL , PARAMETER ::  z0land=0.10
+!       REAL , PARAMETER ::  z0max=0.01
+       REAL , PARAMETER ::  z0max=0.008
+       REAL , PARAMETER ::  z0sea=0.001
+       REAL, PARAMETER :: r_v=461.6 ! gas constant for water vapor
+!#endif
+
+!!!! needed in WRFV3
+   !  Earth
+
+   !  The value for P2SI *must* be set to 1.0 for Earth
+   !  Although, now we may not need this declaration here (see above)
+   !REAL    , PARAMETER :: P2SI         = 1.0
+
+   !  Orbital constants:
+
+   INTEGER , PARAMETER :: PLANET_YEAR = 365
+   REAL , PARAMETER :: OBLIQUITY = 23.5
+   REAL , PARAMETER :: ECCENTRICITY = 0.014
+   REAL , PARAMETER :: SEMIMAJORAXIS = 1.0 ! In AU
+   ! Don't know the following values, so we'll fake them for now
+   REAL , PARAMETER :: zero_date = 0.0   ! Time of perihelion passage
+   !  Fraction into the year (from perhelion) of the
+   !  occurrence of the Northern Spring Equinox
+   REAL , PARAMETER :: EQUINOX_FRACTION= 0.0
+!!!! needed in WRFV3
+
+   !  These are the physical constants planet dependent used within the model.
+
+     real :: g
+     REAL :: r_d        
+     REAL :: cp         
+     !REAL :: cpp
+     REAL :: cv               
+     REAL :: cpv         
+     REAL :: cvv          
+     REAL :: cvpm        
+     REAL :: cliq        
+     REAL :: cice         
+     REAL :: psat         
+     REAL :: rcv          
+     REAL :: rcp       
+     REAL :: rovg        
+     REAL :: c2     
+     REAL :: EOMEG ! angular rotation rate (rad.s-1)  
+
+     REAL :: p1000mb     
+     REAL :: t0        
+     REAL :: p0          
+     REAL :: cpovcv       
+     REAL :: cvovcp      
+     REAL :: rvovrd     
+     REAL ::  gma
+     REAL ::  EP_1
+     REAL ::  EP_2
+     REAL ::  rfcp
+     REAL ::  p608
+     REAL :: rad
+     REAL :: reradius  
+     Real :: molmas !Molecular mass
+
+    REAL  :: wdaysec        ! duree du sol (s)  ~88775 s
+    REAL  :: wmugaz         ! Masse molaire de l'atm (g.mol-1) ~43.49
+    REAL  :: womeg          ! omega (rad.s-1)
+    REAL  :: wyear_day      ! Duree de l'annee (sols) ~668.6
+    REAL  :: wperiheli      ! Dist.min. soleil-mars (Mkm) ~206.66      
+    REAL  :: waphelie       ! Dist.max. soleil-mars (Mkm) ~249.22
+    REAL  :: wperi_day      ! Date du perihelie (sols depuis printemps)
+    REAL  :: wobliquit      ! Obliquite de la planete (deg) ~25.2
+    REAL  :: wz0            ! surface roughness (m) ~0.01
+    REAL  :: wlmixmin       ! longueur de melange ~100
+    REAL  :: wemin_turb     ! energie minimale ~1.e-8 
+    REAL  :: wemissiv       ! Emissivite du sol martien ~.95
+    REAL  :: wemissiceN     !  Emissivite calotte nord
+    REAL  :: wemissiceS     ! Emissivite calotte sud
+    REAL  :: walbediceN     ! Albedo calotte nord !0.5
+    REAL  :: walbediceS     ! Albedo calotte sud  !0.5
+    REAL  :: wiceradiusN    ! mean scat radius of CO2 snow (north)
+    REAL  :: wiceradiusS    ! mean scat radius of CO2 snow (south)
+    REAL  :: wdtemisiceN    ! time scale for snow metamorphism (north) !2  
+    REAL  :: wdtemisiceS    ! time scale for snow metamorphism (south) !2 
+    REAL  :: wvolcapa       ! volumetric capacity of soil (new soil model)
+    REAL  :: z_scale        ! scale height 
+
+    REAL :: TT00
+    REAL :: nu
+ CONTAINS
+  SUBROUTINE init_module_model_constants
+    IMPLICIT NONE
+    Call initial_config
+    planet=model_config_rec%planet
+    !write(*,*) "unknown planet type", planet
+    !stop
+    
+   !  These are the physical constants used within the model
+    
+    IF ( planet == "mars" ) then 
+! JM NOTE -- can we name this grav instead?
+     g = 3.72  ! acceleration due to gravity (m {s}^-2)
+
+!#if ( NMM_CORE == 1 )
+!    REAL :: r_d          = 192.  ! gas constant m2 s-2 K-1
+!    REAL :: cp           = 844.6   ! r= 8.314511E+0 *1000.E+0/mugaz
+!#else
+!    REAL :: r_d          = 192.
+!    REAL :: cp           = 844.6
+!#endif
+
+     r_d          = 191.
+     cp           = 744.5
+     cliq         = 4190.
+     cice         = 2106.
+     psat         = 610.78
+     t0           = 220. ! earth : 300 ... à remplacer par 220 ?
+     p0           = 610.
+     p1000mb      = 610.
+     reradius     = 1./3397200.	! Rayon de mars (m)  ~3397200 m
+     EOMEG        =7.0721E-5 ! angular rotation rate (rad.s-1)
+     wdaysec       = 88800.     ! duree du sol (s)  ~88775 s
+     wmugaz        = 43.49      ! Masse molaire de l'atm (g.mol-1) ~43.49
+     womeg         = 7.0721E-5  ! omega (rad.s-1)
+     wyear_day     = 669.       ! Duree de l'annee (sols) ~668.6
+     wperiheli     = 206.66     ! Dist.min. soleil-mars (Mkm) ~206.66      
+     waphelie      = 249.22     ! Dist.max. soleil-mars (Mkm) ~249.22
+     wperi_day     = 485.       ! Date du perihelie (sols depuis printemps)
+     wobliquit     = 25.2       ! Obliquite de la planete (deg) ~25.2
+     wz0           = 1.e-2      ! surface roughness (m) ~0.01
+     wlmixmin      = 30.        ! longueur de melange ~100
+     wemin_turb    = 1.e-6      ! energie minimale ~1.e-8 
+     wemissiv      = 0.95       ! Emissivite du sol martien ~.95
+     wemissiceN    = 0.95       ! Emissivite calotte nord
+     wemissiceS    = 0.95       ! Emissivite calotte sud
+     walbediceN    = 0.65        ! Albedo calotte nord !0.5
+     walbediceS    = 0.65        ! Albedo calotte sud  !0.5
+     wiceradiusN   = 100.e-6    ! mean scat radius of CO2 snow (north)
+     wiceradiusS   = 100.e-6    ! mean scat radius of CO2 snow (south)
+     wdtemisiceN   = 0.4  ! time scale for snow metamorphism (north) !2  
+     wdtemisiceS   = 0.4  ! time scale for snow metamorphism (south) !2 
+#ifdef NEWPHYS
+     wvolcapa      = 1.e6       ! volumetric capacity of soil (new soil model)
+#endif
+     TT00=0.
+     nu=0.
+!#endif
+    ELSE if ( planet == "venus") then 
+     g            = 8.87
+     r_d          = 191.84383904727036
+     !cpp          = 1000.
+     cp           = 1000.
+     cliq         = 4190.
+     psat         = 610.78
+     t0           = 735. ! earth : 300
+     p0           = 92.e5
+     p1000mb      = 92.e5
+     reradius     = 1./6051800.	! Rayon de mars (m)  ~6051800 m
+     rad          = 6051800.
+     wmugaz       = 43.49 
+     womeg        = 0.2992549E-06
+     wdaysec      = 0.1008707E08
+     TT00=460.
+     nu=0.35
+    ELSE if ( planet == "titan") then
+     g            = 1.35
+     r_d          = 290.6
+     !cpp          = 1000.
+     cp           = 1051.
+     cliq         = 4190.
+     psat         = 610.78
+     t0           = 94. ! earth : 300
+     p0           = 1.45e5
+     p1000mb      = 1.45e5
+     reradius     = 1./2575500.0 ! Rayon de mars (m)  ~6051800 m
+     rad          = 2575500.0
+     wmugaz       = 28.6
+     womeg        = 0.2992549E-06 !!!!!!!!!!!!!!!!!!!
+     wdaysec      = 1377665.28
+     TT00=0.
+     nu=0.
+    ELSE if (( planet == "prescribed").or.(planet == "generic")) then
+     open(17,file='planet_constant',form='formatted',status='old')
+     rewind(17)
+     read(17,*) g
+     read(17,*) cp
+     read(17,*) molmas
+     read(17,*) t0
+     read(17,*) p0
+     read(17,*) rad
+     close(17)
+     r_d=8.314/(molmas*1e-3)
+     p1000mb=p0
+     reradius=1./rad
+     TT00=0.
+     nu=0.
+    Else 
+     write(*,*) "unknown planet type:", planet
+     stop
+    endif
+     cv           = cp-r_d
+     cpv          = 3.9*r_v
+     cvv          = cpv-r_v
+     cvpm         = -cv/cp
+     rcv          = r_d/cv
+     rcp          = r_d/cp
+     rovg         = r_d/g
+     c2           = cp * rcv
+     cpovcv       = cp/(cp-r_d)
+     cvovcp       = 1./cpovcv
+     rvovrd       = r_v/r_d
+     gma          = -r_d*(1.-rcp)*0.5 
+     EP_1         = r_v/r_d-1.
+     EP_2         = r_d/r_v
+     rfcp         =0.25/cp
+     p608         =rvovrd-1.
+     z_scale      =(r_d*t0/g)*1e-3
+    write(*,*) "planet : ", planet
+    write(*,*) "g = ", g
+    write(*,*) "cp = ", cp
+    write(*,*) "r_d = ", r_d
+    write(*,*) "t0 = ", t0
+    write(*,*) "p0 = ", p0
+    write(*,*) "T0 = ", TT00
+    write(*,*) "nu = ", nu
+  END SUBROUTINE init_module_model_constants
+ END MODULE module_model_constants
Index: trunk/WRF.COMMON/WRFV2/share/module_model_constants.F_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_model_constants.F_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_model_constants.F_gcm	(revision 2744)
@@ -0,0 +1,178 @@
+!WRF:MODEL_LAYER:CONSTANTS
+!
+!PLANET MARS
+
+ MODULE module_model_constants
+
+   !  2. Following are constants for use in defining real number bounds.
+
+   !  A really small number.
+
+   REAL    , PARAMETER :: epsilon         = 1.E-15
+
+   !  4. Following is information related to the physical constants.
+
+   !  These are the physical constants used within the model.
+
+! JM NOTE -- can we name this grav instead?
+   REAL    , PARAMETER :: g = 3.72  ! acceleration due to gravity (m {s}^-2)
+
+!#if ( NMM_CORE == 1 )
+!   REAL    , PARAMETER :: r_d          = 192.  ! gas constant m2 s-2 K-1
+!   REAL    , PARAMETER :: cp           = 844.6   ! r= 8.314511E+0 *1000.E+0/mugaz
+!#else
+!   REAL    , PARAMETER :: r_d          = 192.
+!   REAL    , PARAMETER :: cp           = 844.6
+!#endif
+
+   REAL    , PARAMETER :: r_d          = 191.
+   REAL    , PARAMETER :: cp           = 744.5
+
+   REAL    , PARAMETER :: r_v          = 461.6  ! gas constant for water vapor
+   REAL    , PARAMETER :: cv           = cp-r_d
+!   REAL    , PARAMETER :: cpv          = 4.4*r_v  ! cp / R = 4.4 ?? ! rcp = r/cp  ~0.256793
+   REAL    , PARAMETER :: cpv          = 3.9*r_v
+   REAL    , PARAMETER :: cvv          = cpv-r_v
+   REAL    , PARAMETER :: cvpm         = -cv/cp
+   REAL    , PARAMETER :: cliq         = 4190.
+   REAL    , PARAMETER :: cice         = 2106.
+   REAL    , PARAMETER :: psat         = 610.78
+   REAL    , PARAMETER :: rcv          = r_d/cv
+   REAL    , PARAMETER :: rcp          = r_d/cp
+   REAL    , PARAMETER :: rovg         = r_d/g
+   REAL    , PARAMETER :: c2           = cp * rcv
+
+   REAL    , PARAMETER :: p1000mb      = 610.
+   REAL    , PARAMETER :: t0           = 220. ! earth : 300 ... à remplacer par 220 ?
+   REAL    , PARAMETER :: p0           = 610.
+   REAL    , PARAMETER :: cpovcv       = cp/(cp-r_d)
+   REAL    , PARAMETER :: cvovcp       = 1./cpovcv
+   REAL    , PARAMETER :: rvovrd       = r_v/r_d
+
+   REAL    , PARAMETER :: reradius     = 1./3397200.	! Rayon de mars (m)  ~3397200 m
+
+!-------------------------------
+!****MARS
+! here some LMD stuff
+! >> TODO: possible modification with startfi.nc values ?
+   REAL    , PARAMETER :: wdaysec       = 88800.     ! duree du sol (s)  ~88775 s
+   REAL    , PARAMETER :: wmugaz        = 43.49      ! Masse molaire de l'atm (g.mol-1) ~43.49
+   REAL    , PARAMETER :: womeg         = 7.0721E-5  ! omega (rad.s-1)
+   REAL    , PARAMETER :: wyear_day     = 669        ! Duree de l'annee (sols) ~668.6
+   REAL    , PARAMETER :: wperiheli     = 206.66     ! Dist.min. soleil-mars (Mkm) ~206.66      
+   REAL    , PARAMETER :: waphelie      = 249.22     ! Dist.max. soleil-mars (Mkm) ~249.22
+   REAL    , PARAMETER :: wperi_day     = 485.       ! Date du perihelie (sols depuis printemps)
+   REAL    , PARAMETER :: wobliquit     = 25.2       ! Obliquite de la planete (deg) ~25.2
+   REAL    , PARAMETER :: wz0           = 1.e-2      ! surface roughness (m) ~0.01
+   REAL    , PARAMETER :: wlmixmin      = 30         ! longueur de melange ~100
+   REAL    , PARAMETER :: wemin_turb    = 1.e-6      ! energie minimale ~1.e-8 
+   REAL    , PARAMETER :: wemissiv      = 0.95       ! Emissivite du sol martien ~.95
+   REAL    , PARAMETER :: wemissiceN    = 0.95       ! Emissivite calotte nord
+   REAL    , PARAMETER :: wemissiceS    = 0.95       ! Emissivite calotte sud
+   REAL    , PARAMETER :: walbediceN    = 0.65        ! Albedo calotte nord !0.5
+   REAL    , PARAMETER :: walbediceS    = 0.65        ! Albedo calotte sud  !0.5
+   REAL    , PARAMETER :: wiceradiusN   = 100.e-6    ! mean scat radius of CO2 snow (north)
+   REAL    , PARAMETER :: wiceradiusS   = 100.e-6    ! mean scat radius of CO2 snow (south)
+   REAL    , PARAMETER :: wdtemisiceN   = 0.4  ! time scale for snow metamorphism (north) !2  
+   REAL    , PARAMETER :: wdtemisiceS   = 0.4  ! time scale for snow metamorphism (south) !2 
+#ifdef NEWPHYS
+   REAL    , PARAMETER :: wvolcapa      = 1.e6       ! volumetric capacity of soil (new soil model)
+#endif
+!
+!-------------------------------
+
+!   REAL    , PARAMETER :: asselin      = .025
+   REAL    , PARAMETER :: asselin      = .0
+   REAL    , PARAMETER :: cb           = 25.
+
+   REAL    , PARAMETER :: XLV0         = 3.15E6
+   REAL    , PARAMETER :: XLV1         = 2370.
+   REAL    , PARAMETER :: XLS0         = 2.905E6
+   REAL    , PARAMETER :: XLS1         = 259.532
+
+   REAL    , PARAMETER :: XLS          = 2.85E6
+   REAL    , PARAMETER :: XLV          = 2.5E6
+   REAL    , PARAMETER :: XLF          = 3.50E5
+
+   REAL    , PARAMETER :: rhowater     = 1000.
+   REAL    , PARAMETER :: rhosnow      = 100.
+   REAL    , PARAMETER :: rhoair0      = 0.02   !Earth Surface density: 1.217 kg/m3
+                                                !Mars Surface density: 0.020 kg/m3
+   REAL    , PARAMETER :: DEGRAD       = 3.1415926/180.
+   REAL    , PARAMETER :: DPD          = 360./669. ! longitude solaire d'un jour?
+
+   REAL    , PARAMETER ::  SVP1=0.6112
+   REAL    , PARAMETER ::  SVP2=17.67
+   REAL    , PARAMETER ::  SVP3=29.65
+   REAL    , PARAMETER ::  SVPT0=273.15
+   REAL    , PARAMETER ::  EP_1=R_v/R_d-1.
+   REAL    , PARAMETER ::  EP_2=R_d/R_v
+   REAL    , PARAMETER ::  KARMAN=0.4  ! von karman constant 
+   REAL    , PARAMETER ::  EOMEG=7.0721E-5 ! angular rotation rate (rad.s-1)
+   REAL    , PARAMETER ::  STBOLT=5.67051E-8 ! stefan-boltzmann constant
+
+                                      ! proportionality constants for eddy viscosity coefficient calc
+   REAL    , PARAMETER ::  c_s = .25  ! turbulence parameterization constant, for smagorinsky
+!   REAL    , PARAMETER ::  c_s = .1  ! turbulence parameterization constant, for smagorinsky
+   REAL    , PARAMETER ::  c_k = .15  ! turbulence parameterization constant, for TKE
+   REAL    , PARAMETER ::  prandtl = 1./3.0
+                                         ! constants for w-damping option
+!   REAL    , PARAMETER ::  w_alpha = 0.3 ! strength m/s/s
+   REAL    , PARAMETER ::  w_alpha = 2.0 ! strength m/s/s
+!   REAL    , PARAMETER ::  w_beta  = 1.0 ! activation cfl number
+   REAL    , PARAMETER ::  w_beta  = 0.8 ! activation cfl number
+
+       REAL , PARAMETER ::  pq0=379.90516
+       REAL , PARAMETER ::  epsq2=0.2
+!try both ?
+!       REAL , PARAMETER ::  epsq2=0.02
+       REAL , PARAMETER ::  a2=17.2693882
+       REAL , PARAMETER ::  a3=273.16
+       REAL , PARAMETER ::  a4=35.86
+       REAL , PARAMETER ::  epsq=1.e-12
+       REAL , PARAMETER ::  p608=rvovrd-1.
+!#if ( NMM_CORE == 1 )
+       REAL , PARAMETER ::  climit=1.e-20
+       REAL , PARAMETER ::  cm1=2937.4
+       REAL , PARAMETER ::  cm2=4.9283
+       REAL , PARAMETER ::  cm3=23.5518
+!       REAL , PARAMETER ::  defc=8.0
+!       REAL , PARAMETER ::  defm=32.0
+       REAL , PARAMETER ::  defc=0.0
+       REAL , PARAMETER ::  defm=99999.0
+       REAL , PARAMETER ::  epsfc=1./1.05
+       REAL , PARAMETER ::  epswet=0.0
+       REAL , PARAMETER ::  fcdif=1./3.
+!       REAL , PARAMETER ::  fcm=0.003
+       REAL , PARAMETER ::  fcm=0.00003
+!       REAL , PARAMETER ::  fcm=0.0
+       REAL , PARAMETER ::  gma=-r_d*(1.-rcp)*0.5
+       REAL , PARAMETER ::  p400=40000.0
+       REAL , PARAMETER ::  phitp=15000.0
+       REAL , PARAMETER ::  pi2=2.*3.1415926
+       REAL , PARAMETER ::  plbtm=105000.0
+       REAL , PARAMETER ::  plomd=64200.0
+       REAL , PARAMETER ::  pmdhi=35000.0
+       REAL , PARAMETER ::  q2ini=0.50
+       REAL , PARAMETER ::  rfcp=0.25/cp
+       REAL , PARAMETER ::  rhcrit_land=0.75
+       REAL , PARAMETER ::  rhcrit_sea=0.80
+       REAL , PARAMETER ::  rlag=14.8125
+       REAL , PARAMETER ::  rlx=0.90
+       REAL , PARAMETER ::  scq2=50.0
+       REAL , PARAMETER ::  slopht=0.001
+       REAL , PARAMETER ::  tlc=2.*0.703972477
+       REAL , PARAMETER ::  wa=0.15
+       REAL , PARAMETER ::  wght=0.35
+       REAL , PARAMETER ::  wpc=0.075
+       REAL , PARAMETER ::  z0land=0.10
+!       REAL , PARAMETER ::  z0max=0.01
+       REAL , PARAMETER ::  z0max=0.008
+       REAL , PARAMETER ::  z0sea=0.001
+!#endif
+
+
+ CONTAINS
+   SUBROUTINE init_module_model_constants
+   END SUBROUTINE init_module_model_constants
+ END MODULE module_model_constants
Index: trunk/WRF.COMMON/WRFV2/share/module_model_constants.F_ref
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_model_constants.F_ref	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_model_constants.F_ref	(revision 2744)
@@ -0,0 +1,174 @@
+!WRF:MODEL_LAYER:CONSTANTS
+!
+!PLANET MARS
+
+ MODULE module_model_constants
+
+   !  2. Following are constants for use in defining real number bounds.
+
+   !  A really small number.
+
+   REAL    , PARAMETER :: epsilon         = 1.E-15
+
+   !  4. Following is information related to the physical constants.
+
+   !  These are the physical constants used within the model.
+
+! JM NOTE -- can we name this grav instead?
+   REAL    , PARAMETER :: g = 3.72  ! acceleration due to gravity (m {s}^-2)
+
+#if ( NMM_CORE == 1 )
+   REAL    , PARAMETER :: r_d          = 192.  ! gas constant m2 s-2 K-1
+   REAL    , PARAMETER :: cp           = 844.6   ! r= 8.314511E+0 *1000.E+0/mugaz
+#else
+   REAL    , PARAMETER :: r_d          = 192.
+   REAL    , PARAMETER :: cp           = 844.6
+#endif
+
+   REAL    , PARAMETER :: r_v          = 461.6  ! gas constant for water vapor
+   REAL    , PARAMETER :: cv           = cp-r_d
+   REAL    , PARAMETER :: cpv          = 4.4*r_v  ! cp / R = 4.4 ?? ! rcp = r/cp  ~0.256793
+   REAL    , PARAMETER :: cvv          = cpv-r_v
+   REAL    , PARAMETER :: cvpm         = -cv/cp
+   REAL    , PARAMETER :: cliq         = 4190.
+   REAL    , PARAMETER :: cice         = 2106.
+   REAL    , PARAMETER :: psat         = 610.78
+   REAL    , PARAMETER :: rcv          = r_d/cv
+   REAL    , PARAMETER :: rcp          = r_d/cp
+   REAL    , PARAMETER :: rovg         = r_d/g
+   REAL    , PARAMETER :: c2           = cp * rcv
+
+   REAL    , PARAMETER :: p1000mb      = 610.
+   REAL    , PARAMETER :: t0           = 220. ! earth : 300 ... à remplacer par 220 ?
+   REAL    , PARAMETER :: p0           = 610.
+   REAL    , PARAMETER :: cpovcv       = cp/(cp-r_d)
+   REAL    , PARAMETER :: cvovcp       = 1./cpovcv
+   REAL    , PARAMETER :: rvovrd       = r_v/r_d
+
+   REAL    , PARAMETER :: reradius     = 1./3397200.	! Rayon de mars (m)  ~3397200 m
+
+!-------------------------------
+!****MARS
+! here some LMD stuff
+! >> TODO: possible modification with startfi.nc values ?
+   REAL    , PARAMETER :: wdaysec       = 88800.     ! duree du sol (s)  ~88775 s
+   REAL    , PARAMETER :: wmugaz        = 43.49      ! Masse molaire de l'atm (g.mol-1) ~43.49
+   REAL    , PARAMETER :: womeg         = 7.0721E-5  ! omega (rad.s-1)
+   REAL    , PARAMETER :: wyear_day     = 669        ! Duree de l'annee (sols) ~668.6
+   REAL    , PARAMETER :: wperiheli     = 206.66     ! Dist.min. soleil-mars (Mkm) ~206.66      
+   REAL    , PARAMETER :: waphelie      = 249.22     ! Dist.max. soleil-mars (Mkm) ~249.22
+   REAL    , PARAMETER :: wperi_day     = 485.       ! Date du perihelie (sols depuis printemps)
+   REAL    , PARAMETER :: wobliquit     = 25.2       ! Obliquite de la planete (deg) ~25.2
+   REAL    , PARAMETER :: wz0           = 1.e-2      ! surface roughness (m) ~0.01
+   REAL    , PARAMETER :: wlmixmin      = 30         ! longueur de melange ~100
+   REAL    , PARAMETER :: wemin_turb    = 1.e-6      ! energie minimale ~1.e-8 
+   REAL    , PARAMETER :: wemissiv      = 0.95       ! Emissivite du sol martien ~.95
+   REAL    , PARAMETER :: wemissiceN    = 0.95       ! Emissivite calotte nord
+   REAL    , PARAMETER :: wemissiceS    = 0.95       ! Emissivite calotte sud
+   REAL    , PARAMETER :: walbediceN    = 0.65        ! Albedo calotte nord !0.5
+   REAL    , PARAMETER :: walbediceS    = 0.65        ! Albedo calotte sud  !0.5
+   REAL    , PARAMETER :: wiceradiusN   = 100.e-6    ! mean scat radius of CO2 snow (north)
+   REAL    , PARAMETER :: wiceradiusS   = 100.e-6    ! mean scat radius of CO2 snow (south)
+   REAL    , PARAMETER :: wdtemisiceN   = 0.4  ! time scale for snow metamorphism (north) !2  
+   REAL    , PARAMETER :: wdtemisiceS   = 0.4  ! time scale for snow metamorphism (south) !2 
+#ifdef NEWPHYS
+   REAL    , PARAMETER :: wvolcapa      = 1.e6       ! volumetric capacity of soil (new soil model)
+#endif
+!
+!-------------------------------
+
+!   REAL    , PARAMETER :: asselin      = .025
+   REAL    , PARAMETER :: asselin      = .0
+   REAL    , PARAMETER :: cb           = 25.
+
+   REAL    , PARAMETER :: XLV0         = 3.15E6
+   REAL    , PARAMETER :: XLV1         = 2370.
+   REAL    , PARAMETER :: XLS0         = 2.905E6
+   REAL    , PARAMETER :: XLS1         = 259.532
+
+   REAL    , PARAMETER :: XLS          = 2.85E6
+   REAL    , PARAMETER :: XLV          = 2.5E6
+   REAL    , PARAMETER :: XLF          = 3.50E5
+
+   REAL    , PARAMETER :: rhowater     = 1000.
+   REAL    , PARAMETER :: rhosnow      = 100.
+   REAL    , PARAMETER :: rhoair0      = 0.02   !Earth Surface density: 1.217 kg/m3
+                                                !Mars Surface density: 0.020 kg/m3
+   REAL    , PARAMETER :: DEGRAD       = 3.1415926/180.
+   REAL    , PARAMETER :: DPD          = 360./669. ! longitude solaire d'un jour?
+
+   REAL    , PARAMETER ::  SVP1=0.6112
+   REAL    , PARAMETER ::  SVP2=17.67
+   REAL    , PARAMETER ::  SVP3=29.65
+   REAL    , PARAMETER ::  SVPT0=273.15
+   REAL    , PARAMETER ::  EP_1=R_v/R_d-1.
+   REAL    , PARAMETER ::  EP_2=R_d/R_v
+   REAL    , PARAMETER ::  KARMAN=0.4  ! von karman constant 
+   REAL    , PARAMETER ::  EOMEG=7.0721E-5 ! angular rotation rate (rad.s-1)
+   REAL    , PARAMETER ::  STBOLT=5.67051E-8 ! stefan-boltzmann constant
+
+                                      ! proportionality constants for eddy viscosity coefficient calc
+   REAL    , PARAMETER ::  c_s = .25  ! turbulence parameterization constant, for smagorinsky
+!   REAL    , PARAMETER ::  c_s = .1  ! turbulence parameterization constant, for smagorinsky
+   REAL    , PARAMETER ::  c_k = .15  ! turbulence parameterization constant, for TKE
+   REAL    , PARAMETER ::  prandtl = 1./3.0
+                                         ! constants for w-damping option
+!   REAL    , PARAMETER ::  w_alpha = 0.3 ! strength m/s/s
+   REAL    , PARAMETER ::  w_alpha = 2.0 ! strength m/s/s
+!   REAL    , PARAMETER ::  w_beta  = 1.0 ! activation cfl number
+   REAL    , PARAMETER ::  w_beta  = 0.8 ! activation cfl number
+
+       REAL , PARAMETER ::  pq0=379.90516
+       REAL , PARAMETER ::  epsq2=0.2
+!try both ?
+!       REAL , PARAMETER ::  epsq2=0.02
+       REAL , PARAMETER ::  a2=17.2693882
+       REAL , PARAMETER ::  a3=273.16
+       REAL , PARAMETER ::  a4=35.86
+       REAL , PARAMETER ::  epsq=1.e-12
+       REAL , PARAMETER ::  p608=rvovrd-1.
+!#if ( NMM_CORE == 1 )
+       REAL , PARAMETER ::  climit=1.e-20
+       REAL , PARAMETER ::  cm1=2937.4
+       REAL , PARAMETER ::  cm2=4.9283
+       REAL , PARAMETER ::  cm3=23.5518
+!       REAL , PARAMETER ::  defc=8.0
+!       REAL , PARAMETER ::  defm=32.0
+       REAL , PARAMETER ::  defc=0.0
+       REAL , PARAMETER ::  defm=99999.0
+       REAL , PARAMETER ::  epsfc=1./1.05
+       REAL , PARAMETER ::  epswet=0.0
+       REAL , PARAMETER ::  fcdif=1./3.
+!       REAL , PARAMETER ::  fcm=0.003
+       REAL , PARAMETER ::  fcm=0.00003
+!       REAL , PARAMETER ::  fcm=0.0
+       REAL , PARAMETER ::  gma=-r_d*(1.-rcp)*0.5
+       REAL , PARAMETER ::  p400=40000.0
+       REAL , PARAMETER ::  phitp=15000.0
+       REAL , PARAMETER ::  pi2=2.*3.1415926
+       REAL , PARAMETER ::  plbtm=105000.0
+       REAL , PARAMETER ::  plomd=64200.0
+       REAL , PARAMETER ::  pmdhi=35000.0
+       REAL , PARAMETER ::  q2ini=0.50
+       REAL , PARAMETER ::  rfcp=0.25/cp
+       REAL , PARAMETER ::  rhcrit_land=0.75
+       REAL , PARAMETER ::  rhcrit_sea=0.80
+       REAL , PARAMETER ::  rlag=14.8125
+       REAL , PARAMETER ::  rlx=0.90
+       REAL , PARAMETER ::  scq2=50.0
+       REAL , PARAMETER ::  slopht=0.001
+       REAL , PARAMETER ::  tlc=2.*0.703972477
+       REAL , PARAMETER ::  wa=0.15
+       REAL , PARAMETER ::  wght=0.35
+       REAL , PARAMETER ::  wpc=0.075
+       REAL , PARAMETER ::  z0land=0.10
+!       REAL , PARAMETER ::  z0max=0.01
+       REAL , PARAMETER ::  z0max=0.008
+       REAL , PARAMETER ::  z0sea=0.001
+!#endif
+
+
+ CONTAINS
+   SUBROUTINE init_module_model_constants
+   END SUBROUTINE init_module_model_constants
+ END MODULE module_model_constants
Index: trunk/WRF.COMMON/WRFV2/share/module_optional_si_input.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_optional_si_input.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_optional_si_input.F	(revision 2744)
@@ -0,0 +1,1006 @@
+MODULE module_optional_si_input
+
+   INTEGER :: flag_metgrid  , flag_tavgsfc  , flag_psfc     , flag_soilhgt
+
+   INTEGER :: flag_qv       , flag_qc       , flag_qr       , flag_qi       , flag_qs       , flag_qg
+
+   INTEGER :: flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
+              flag_sm000010 , flag_sm010040 , flag_sm040100 , flag_sm100200 , flag_sm010200 , &
+              flag_sw000010 , flag_sw010040 , flag_sw040100 , flag_sw100200 , flag_sw010200
+
+   INTEGER :: flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
+              flag_sm000007 , flag_sm007028 , flag_sm028100 , flag_sm100255
+
+   INTEGER :: flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , flag_soilt160 , flag_soilt300 , &
+              flag_soilm000 , flag_soilm005 , flag_soilm020 , flag_soilm040 , flag_soilm160 , flag_soilm300 , &
+              flag_soilw000 , flag_soilw005 , flag_soilw020 , flag_soilw040 , flag_soilw160 , flag_soilw300
+
+   INTEGER :: flag_sst      , flag_toposoil , flag_snowh
+
+   INTEGER                  :: num_st_levels_input , num_sm_levels_input , num_sw_levels_input
+   INTEGER                  :: num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc
+   INTEGER , DIMENSION(100) ::     st_levels_input ,     sm_levels_input ,     sw_levels_input
+   REAL , ALLOCATABLE , DIMENSION(:,:,:) :: st_input , sm_input , sw_input
+
+   CHARACTER (LEN=8) , PRIVATE :: flag_name
+ 
+   LOGICAL :: already_been_here
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE init_module_optional_si_input ( grid , config_flags ) 
+
+      USE module_domain
+      USE module_configure
+
+      IMPLICIT NONE 
+
+      TYPE ( domain ) :: grid
+      TYPE (grid_config_rec_type) :: config_flags
+
+      INTEGER :: ids, ide, jds, jde, kds, kde, &
+                 ims, ime, jms, jme, kms, kme, &
+                 its, ite, jts, jte, kts, kte
+
+      !  Get the various indices, assume XZY ordering.
+
+      ids = grid%sd31 ; ide = grid%ed31 ;
+      kds = grid%sd32 ; kde = grid%ed32 ;
+      jds = grid%sd33 ; jde = grid%ed33 ;
+
+      ims = grid%sm31 ; ime = grid%em31 ;
+      kms = grid%sm32 ; kme = grid%em32 ;
+      jms = grid%sm33 ; jme = grid%em33 ;
+
+      its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+      kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+      jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+      IF ( .NOT. already_been_here ) THEN
+
+         num_st_levels_alloc = config_flags%num_soil_layers * 3 ! used to be 2
+         num_sm_levels_alloc = config_flags%num_soil_layers * 3
+         num_sw_levels_alloc = config_flags%num_soil_layers * 3
+
+         IF ( ALLOCATED ( st_input ) ) DEALLOCATE ( st_input )
+         IF ( ALLOCATED ( sm_input ) ) DEALLOCATE ( sm_input )
+         IF ( ALLOCATED ( sw_input ) ) DEALLOCATE ( sw_input )
+   
+         ALLOCATE ( st_input(ims:ime,num_st_levels_alloc,jms:jme) )
+         ALLOCATE ( sm_input(ims:ime,num_sm_levels_alloc,jms:jme) )
+         ALLOCATE ( sw_input(ims:ime,num_sw_levels_alloc,jms:jme) )
+
+      END IF
+
+      already_been_here = .TRUE.
+
+   END SUBROUTINE init_module_optional_si_input
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE optional_si_input ( grid , fid )
+
+      USE module_configure      
+      USE module_domain
+
+      IMPLICIT NONE 
+
+      TYPE ( domain ) :: grid
+      INTEGER , INTENT(IN) :: fid
+
+      INTEGER :: ids, ide, jds, jde, kds, kde, &
+                 ims, ime, jms, jme, kms, kme, &
+                 its, ite, jts, jte, kts, kte
+
+      !  Get the various indices, assume XZY ordering.
+
+      ids = grid%sd31 ; ide = grid%ed31 ;
+      kds = grid%sd32 ; kde = grid%ed32 ;
+      jds = grid%sd33 ; jde = grid%ed33 ;
+
+      ims = grid%sm31 ; ime = grid%em31 ;
+      kms = grid%sm32 ; kme = grid%em32 ;
+      jms = grid%sm33 ; jme = grid%em33 ;
+
+      its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+      kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+      jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+
+      CALL optional_tavgsfc    ( grid , fid , &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte  )
+
+      CALL optional_moist      ( grid , fid , &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte  )
+
+      CALL optional_metgrid    ( grid , fid , &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte  )
+
+      CALL optional_sst        ( grid , fid , &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte  )
+
+      CALL optional_snowh      ( grid , fid , &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte  )
+
+      IF (  ( model_config_rec%sf_surface_physics(grid%id) .EQ. 1 ) .OR. &
+            ( model_config_rec%sf_surface_physics(grid%id) .EQ. 2 ) .OR. &
+            ( model_config_rec%sf_surface_physics(grid%id) .EQ. 3 ) .OR. &
+            ( model_config_rec%sf_surface_physics(grid%id) .EQ. 99 ) ) THEN
+
+         CALL optional_lsm        ( grid , fid , &
+                                    ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte  )
+   
+         CALL optional_lsm_levels ( grid , fid , &
+                                    ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte  )
+      END IF
+     
+   END SUBROUTINE optional_si_input
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE optional_moist ( grid , fid , &
+                               ids, ide, jds, jde, kds, kde, &
+                               ims, ime, jms, jme, kms, kme, &
+                               its, ite, jts, jte, kts, kte  )
+
+      USE module_io_wrf
+      USE module_domain
+
+USE module_configure
+USE module_io_domain
+
+      IMPLICIT NONE 
+
+      TYPE ( domain ) :: grid
+      INTEGER , INTENT(IN) :: fid
+
+      INTEGER :: ids, ide, jds, jde, kds, kde, &
+                 ims, ime, jms, jme, kms, kme, &
+                 its, ite, jts, jte, kts, kte
+
+      INTEGER :: itmp , icnt , ierr
+
+      flag_qv       = 0
+      flag_qc       = 0
+      flag_qr       = 0
+      flag_qi       = 0
+      flag_qs       = 0
+      flag_qg       = 0
+
+      flag_name(1:8) = 'QV      '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_qv       = itmp
+      END IF
+      flag_name(1:8) = 'QC      '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_qc       = itmp
+      END IF
+      flag_name(1:8) = 'QR      '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_qr       = itmp
+      END IF
+      flag_name(1:8) = 'QI      '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_qi       = itmp
+      END IF
+      flag_name(1:8) = 'QS      '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_qs       = itmp
+      END IF
+      flag_name(1:8) = 'QG      '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_qg       = itmp
+      END IF
+    
+   END SUBROUTINE optional_moist
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE optional_metgrid ( grid , fid , &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte  )
+
+      USE module_io_wrf
+      USE module_domain
+USE module_configure
+USE module_io_domain
+
+      IMPLICIT NONE 
+
+      TYPE ( domain ) :: grid
+      INTEGER , INTENT(IN) :: fid
+
+      INTEGER :: ids, ide, jds, jde, kds, kde, &
+                 ims, ime, jms, jme, kms, kme, &
+                 its, ite, jts, jte, kts, kte
+
+      INTEGER :: itmp , icnt , ierr
+
+      flag_metgrid = 0 
+
+      flag_name(1:8) = 'METGRID '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_metgrid  = itmp
+      END IF
+    
+   END SUBROUTINE optional_metgrid
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE optional_sst ( grid , fid , &
+                             ids, ide, jds, jde, kds, kde, &
+                             ims, ime, jms, jme, kms, kme, &
+                             its, ite, jts, jte, kts, kte  )
+
+      USE module_io_wrf
+      USE module_domain
+USE module_configure
+USE module_io_domain
+
+      IMPLICIT NONE 
+
+      TYPE ( domain ) :: grid
+      INTEGER , INTENT(IN) :: fid
+
+      INTEGER :: ids, ide, jds, jde, kds, kde, &
+                 ims, ime, jms, jme, kms, kme, &
+                 its, ite, jts, jte, kts, kte
+
+      INTEGER :: itmp , icnt , ierr
+
+      flag_sst      = 0 
+
+      flag_name(1:8) = 'SST     '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sst      = itmp
+      END IF
+    
+   END SUBROUTINE optional_sst
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE optional_tavgsfc ( grid , fid , &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte  )
+
+      USE module_io_wrf
+      USE module_domain
+USE module_configure
+USE module_io_domain
+
+      IMPLICIT NONE 
+
+      TYPE ( domain ) :: grid
+      INTEGER , INTENT(IN) :: fid
+
+      INTEGER :: ids, ide, jds, jde, kds, kde, &
+                 ims, ime, jms, jme, kms, kme, &
+                 its, ite, jts, jte, kts, kte
+
+      INTEGER :: itmp , icnt , ierr
+
+      flag_tavgsfc  = 0 
+
+      flag_name(1:8) = 'TAVGSFC '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_tavgsfc  = itmp
+      END IF
+    
+   END SUBROUTINE optional_tavgsfc
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE optional_snowh ( grid , fid , &
+                               ids, ide, jds, jde, kds, kde, &
+                               ims, ime, jms, jme, kms, kme, &
+                               its, ite, jts, jte, kts, kte  )
+
+      USE module_io_wrf
+      USE module_domain
+USE module_configure
+USE module_io_domain
+
+      IMPLICIT NONE 
+
+      TYPE ( domain ) :: grid
+      INTEGER , INTENT(IN) :: fid
+
+      INTEGER :: ids, ide, jds, jde, kds, kde, &
+                 ims, ime, jms, jme, kms, kme, &
+                 its, ite, jts, jte, kts, kte
+
+      INTEGER :: itmp , icnt , ierr
+
+      flag_snowh    = 0 
+
+      flag_name(1:8) = 'SNOWH   '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_snowh    = itmp
+      END IF
+    
+   END SUBROUTINE optional_snowh
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE optional_lsm ( grid , fid , &
+                             ids, ide, jds, jde, kds, kde, &
+                             ims, ime, jms, jme, kms, kme, &
+                             its, ite, jts, jte, kts, kte  )
+
+      USE module_io_wrf
+      USE module_domain
+USE module_configure
+USE module_io_domain
+
+      IMPLICIT NONE 
+
+      TYPE ( domain ) :: grid
+      INTEGER , INTENT(IN) :: fid
+
+      INTEGER :: ids, ide, jds, jde, kds, kde, &
+                 ims, ime, jms, jme, kms, kme, &
+                 its, ite, jts, jte, kts, kte
+
+      INTEGER :: itmp , icnt , ierr
+
+      flag_psfc     = 0 
+      flag_soilhgt  = 0 
+      flag_toposoil = 0 
+
+      flag_name(1:8) = 'TOPOSOIL'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_toposoil = itmp
+      END IF
+
+      flag_name(1:8) = 'PSFC    '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_psfc     = itmp
+      END IF
+
+      flag_name(1:8) = 'SOILHGT '
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilhgt  = itmp
+      END IF
+    
+   END SUBROUTINE optional_lsm
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE optional_lsm_levels ( grid , fid , &
+                                    ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte  )
+
+      USE module_io_wrf
+      USE module_domain
+USE module_configure
+USE module_io_domain
+
+      IMPLICIT NONE 
+
+      TYPE ( domain ) :: grid
+      INTEGER , INTENT(IN) :: fid
+
+      INTEGER :: ids, ide, jds, jde, kds, kde, &
+                 ims, ime, jms, jme, kms, kme, &
+                 its, ite, jts, jte, kts, kte
+
+      INTEGER :: itmp , icnt , ierr , i , j
+    
+      !  Initialize the soil temp and moisture flags to "field not found".
+
+      flag_st000010 = 0 
+      flag_st010040 = 0
+      flag_st040100 = 0
+      flag_st100200 = 0
+      flag_st010200 = 0
+
+      flag_sm000010 = 0
+      flag_sm010040 = 0
+      flag_sm040100 = 0
+      flag_sm100200 = 0
+      flag_sm010200 = 0
+
+      flag_sw000010 = 0
+      flag_sw010040 = 0
+      flag_sw040100 = 0
+      flag_sw100200 = 0
+      flag_sw010200 = 0
+
+      flag_st000007 = 0 
+      flag_st007028 = 0
+      flag_st028100 = 0
+      flag_st100255 = 0
+
+      flag_sm000007 = 0
+      flag_sm007028 = 0
+      flag_sm028100 = 0
+      flag_sm100255 = 0
+
+      flag_soilt000 = 0 
+      flag_soilt005 = 0 
+      flag_soilt020 = 0 
+      flag_soilt040 = 0 
+      flag_soilt160 = 0 
+      flag_soilt300 = 0 
+
+      flag_soilm000 = 0 
+      flag_soilm005 = 0 
+      flag_soilm020 = 0 
+      flag_soilm040 = 0 
+      flag_soilm160 = 0 
+      flag_soilm300 = 0 
+
+      flag_soilw000 = 0 
+      flag_soilw005 = 0 
+      flag_soilw020 = 0 
+      flag_soilw040 = 0 
+      flag_soilw160 = 0 
+      flag_soilw300 = 0 
+
+      !  How many soil levels have we found?  Well, right now, none.
+
+      num_st_levels_input = 0
+      num_sm_levels_input = 0
+      num_sw_levels_input = 0
+      st_levels_input = -1
+      sm_levels_input = -1
+      sw_levels_input = -1
+
+      flag_name(1:8) = 'ST000010'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_st000010 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input + 1,j) = grid%st000010(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'ST010040'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_st010040 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input + 1,j) = grid%st010040(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'ST040100'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_st040100 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input + 1,j) = grid%st040100(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'ST100200'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_st100200 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input + 1,j) = grid%st100200(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'ST010200'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_st010200 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input + 1,j) = grid%st010200(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SM000010'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sm000010 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input + 1,j) = grid%sm000010(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SM010040'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sm010040 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input + 1,j) = grid%sm010040(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SM040100'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sm040100 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input + 1,j) = grid%sm040100(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SM100200'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sm100200 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input + 1,j) = grid%sm100200(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SM010200'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sm010200 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input + 1,j) = grid%sm010200(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SW000010'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sw000010 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input + 1,j) = grid%sw000010(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SW010040'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sw010040 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input + 1,j) = grid%sw010040(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SW040100'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sw040100 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input + 1,j) = grid%sw040100(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SW100200'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sw100200 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input + 1,j) = grid%sw100200(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SW010200'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sw010200 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input + 1,j) = grid%sw010200(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'ST000007'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_st000007 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input + 1,j) = grid%st000007(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'ST007028'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_st007028 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input + 1,j) = grid%st007028(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'ST028100'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_st028100 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input + 1,j) = grid%st028100(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'ST100255'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_st100255 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input + 1,j) = grid%st100255(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SM000007'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sm000007 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input + 1,j) = grid%sm000007(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SM007028'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sm007028 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input + 1,j) = grid%sm007028(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SM028100'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sm028100 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input + 1,j) = grid%sm028100(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SM100255'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_sm100255 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input + 1,j) = grid%sm100255(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILT000'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilt000 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input ,j) = grid%soilt000(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILT005'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilt005 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input ,j) = grid%soilt005(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILT020'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilt020 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input ,j) = grid%soilt020(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILT040'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilt040 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input ,j) = grid%soilt040(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILT160'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilt160 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input ,j) = grid%soilt160(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILT300'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilt300 = itmp
+         num_st_levels_input = num_st_levels_input + 1
+         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,num_st_levels_input ,j) = grid%soilt300(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILM000'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilm000 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input ,j) = grid%soilm000(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILM005'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilm005 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input ,j) = grid%soilm005(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILM020'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilm020 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input ,j) = grid%soilm020(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILM040'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilm040 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input ,j) = grid%soilm040(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILM160'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilm160 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input ,j) = grid%soilm160(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILM300'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilm300 = itmp
+         num_sm_levels_input = num_sm_levels_input + 1
+         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,num_sm_levels_input ,j) = grid%soilm300(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILW000'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilw000 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input ,j) = grid%soilw000(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILW005'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilw005 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input ,j) = grid%soilw005(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILW020'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilw020 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input ,j) = grid%soilw020(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILW040'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilw040 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input ,j) = grid%soilw040(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILW160'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilw160 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input ,j) = grid%soilw160(i,j)
+            END DO
+         END DO
+      END IF
+      flag_name(1:8) = 'SOILW300'
+      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr ) 
+      IF ( ierr .EQ. 0 ) THEN
+         flag_soilw300 = itmp
+         num_sw_levels_input = num_sw_levels_input + 1
+         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sw_input(i,num_sw_levels_input ,j) = grid%soilw300(i,j)
+            END DO
+         END DO
+      END IF
+
+      !  OK, let's do a quick sanity check.
+ 
+      IF ( ( num_st_levels_input .GT. num_st_levels_alloc ) .OR. &
+           ( num_sm_levels_input .GT. num_sm_levels_alloc ) .OR. &
+           ( num_sw_levels_input .GT. num_sw_levels_alloc ) ) THEN
+         print *,'pain and woe, the soil level allocation is too small'
+         CALL wrf_error_fatal ( 'soil_levels_too_few' )
+      END IF
+
+   END SUBROUTINE optional_lsm_levels
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   FUNCTION char2int1( string3 ) RESULT ( int1 )
+      CHARACTER (LEN=3) , INTENT(IN) :: string3
+      INTEGER :: i1 , int1
+      READ(string3,fmt='(I3)') i1
+      int1 = i1
+   END FUNCTION char2int1
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   FUNCTION char2int2( string6 ) RESULT ( int1 )
+      CHARACTER (LEN=6) , INTENT(IN) :: string6
+      INTEGER :: i2 , i1 , int1
+      READ(string6,fmt='(I3,I3)') i1,i2
+      int1 = ( i2 + i1 ) / 2
+   END FUNCTION char2int2
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+END MODULE module_optional_si_input
Index: trunk/WRF.COMMON/WRFV2/share/module_soil_pre.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_soil_pre.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_soil_pre.F	(revision 2744)
@@ -0,0 +1,2928 @@
+#if ( ! NMM_CORE == 1 )
+
+MODULE module_soil_pre
+
+   USE module_date_time
+   USE module_state_description
+
+CONTAINS
+
+   SUBROUTINE adjust_for_seaice_pre ( xice , landmask , tsk , ivgtyp , vegcat , lu_index , &
+                                      xland , landusef , isltyp , soilcat , soilctop , &
+                                      soilcbot , tmn , &
+                                      seaice_threshold , &
+                                      num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                      iswater , isice , &
+                                      scheme , &
+                                      ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              iswater , isice 
+      INTEGER , INTENT(IN) :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat , scheme
+
+      REAL , DIMENSION(ims:ime,1:num_veg_cat,jms:jme) , INTENT(INOUT):: landusef
+      REAL , DIMENSION(ims:ime,1:num_soil_top_cat,jms:jme) , INTENT(INOUT):: soilctop
+      REAL , DIMENSION(ims:ime,1:num_soil_bot_cat,jms:jme) , INTENT(INOUT):: soilcbot
+      INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: isltyp , ivgtyp
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: landmask , xice , tsk , lu_index , &
+                                                           vegcat, xland , soilcat , tmn
+      REAL , INTENT(IN) :: seaice_threshold
+
+      INTEGER :: i , j , num_seaice_changes , loop
+      CHARACTER (LEN=132) :: message
+      
+      num_seaice_changes = 0
+      fix_seaice : SELECT CASE ( scheme ) 
+ 
+         CASE ( SLABSCHEME ) 
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( xice(i,j) .GT. 200.0 ) THEN
+                     xice(i,j) = 0.
+                     num_seaice_changes = num_seaice_changes + 1
+                  END IF
+               END DO
+            END DO
+            IF ( num_seaice_changes .GT. 0 ) THEN
+               WRITE ( message , FMT='(A,I6)' ) &
+               'Total pre number of sea ice locations removed (due to FLAG values) = ', &
+               num_seaice_changes
+               CALL wrf_debug ( 0 , message )  
+            END IF
+            num_seaice_changes = 0
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( ( xice(i,j) .GE. 0.5 ) .OR. &
+                       ( ( landmask(i,j) .LT. 0.5 ) .AND. ( tsk(i,j) .LT. seaice_threshold ) ) ) THEN
+                     xice(i,j) = 1.
+                     num_seaice_changes = num_seaice_changes + 1
+                     if(landmask(i,j) .LT. 0.5 )tmn(i,j) = 271.4
+                     vegcat(i,j)=isice
+                     ivgtyp(i,j)=isice
+                     lu_index(i,j)=isice
+                     landmask(i,j)=1.
+                     xland(i,j)=1.
+                     DO loop=1,num_veg_cat
+                        landusef(i,loop,j)=0.
+                     END DO
+                     landusef(i,ivgtyp(i,j),j)=1.
+
+                     isltyp(i,j) = 16
+                     soilcat(i,j)=isltyp(i,j)
+                     DO loop=1,num_soil_top_cat
+                        soilctop(i,loop,j)=0
+                     END DO
+                     DO loop=1,num_soil_bot_cat
+                        soilcbot(i,loop,j)=0
+                     END DO
+                     soilctop(i,isltyp(i,j),j)=1.
+                     soilcbot(i,isltyp(i,j),j)=1.
+                  END IF
+               END DO
+            END DO
+            IF ( num_seaice_changes .GT. 0 ) THEN
+               WRITE ( message , FMT='(A,I6)' ) &
+               'Total pre number of sea ice location changes (water to land) = ', num_seaice_changes
+               CALL wrf_debug ( 0 , message )  
+            END IF
+
+         CASE ( LSMSCHEME , RUCLSMSCHEME ) 
+            num_seaice_changes = 0
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( landmask(i,j) .GT. 0.5 ) THEN
+                     if (xice(i,j).gt.0) num_seaice_changes = num_seaice_changes + 1
+                     xice(i,j) = 0.
+                  END IF
+               END DO
+            END DO
+            IF ( num_seaice_changes .GT. 0 ) THEN
+               WRITE ( message , FMT='(A,I6)' ) &
+               'Total pre number of land location changes (seaice set to zero) = ', num_seaice_changes
+               CALL wrf_debug ( 0 , message )
+            END IF
+
+      END SELECT fix_seaice
+
+   END SUBROUTINE adjust_for_seaice_pre
+
+   SUBROUTINE adjust_for_seaice_post ( xice , landmask , tsk_old , tsk , ivgtyp , vegcat , lu_index , &
+                                      xland , landusef , isltyp , soilcat , soilctop , &
+                                      soilcbot , tmn , vegfra , &
+                                      tslb , smois , sh2o , &
+                                      seaice_threshold , &
+                                      num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                      num_soil_layers , &
+                                      iswater , isice , &
+                                      scheme , &
+                                      ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              iswater , isice 
+      INTEGER , INTENT(IN) :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat , scheme
+      INTEGER , INTENT(IN) :: num_soil_layers
+
+      REAL , DIMENSION(ims:ime,1:num_veg_cat,jms:jme) , INTENT(INOUT):: landusef
+      REAL , DIMENSION(ims:ime,1:num_soil_top_cat,jms:jme) , INTENT(INOUT):: soilctop
+      REAL , DIMENSION(ims:ime,1:num_soil_bot_cat,jms:jme) , INTENT(INOUT):: soilcbot
+      REAL , DIMENSION(ims:ime,1:num_soil_layers,jms:jme) , INTENT(INOUT):: tslb , smois , sh2o
+      INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: isltyp , ivgtyp
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: landmask , xice , tsk , lu_index , &
+                                                           vegcat, xland , soilcat , tmn , &
+                                                           tsk_old , vegfra
+      REAL , INTENT(IN) :: seaice_threshold
+      REAL :: total_depth , mid_point_depth
+
+      INTEGER :: i , j , num_seaice_changes , loop
+      CHARACTER (LEN=132) :: message
+      
+      num_seaice_changes = 0
+      fix_seaice : SELECT CASE ( scheme ) 
+ 
+         CASE ( SLABSCHEME ) 
+
+         CASE ( LSMSCHEME , RUCLSMSCHEME ) 
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( xice(i,j) .GT. 200.0 ) THEN
+                     xice(i,j) = 0.
+                     num_seaice_changes = num_seaice_changes + 1
+                  END IF
+               END DO
+            END DO
+            IF ( num_seaice_changes .GT. 0 ) THEN
+               WRITE ( message , FMT='(A,I6)' ) &
+               'Total post number of sea ice locations removed (due to FLAG values) = ', &
+               num_seaice_changes
+               CALL wrf_debug ( 0 , message )  
+            END IF
+            num_seaice_changes = 0
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( ( ( tsk(i,j) .LT. 170 ) .OR. ( tsk(i,j) .GT. 400 ) ) .AND. &
+                       ( ( tsk_old(i,j) .GT. 170 ) .AND. ( tsk_old(i,j) .LT. 400 ) ) )THEN
+                     tsk(i,j) = tsk_old(i,j)
+                  END IF
+                  IF ( ( ( tsk(i,j) .LT. 170 ) .OR. ( tsk(i,j) .GT. 400 ) ) .AND. &
+                       ( ( tsk_old(i,j) .LT. 170 ) .OR. ( tsk_old(i,j) .GT. 400 ) ) )THEN
+                     print *,'TSK woes in seaice post, i,j=',i,j,'  tsk = ',tsk(i,j), tsk_old(i,j)
+                     CALL wrf_error_fatal ( 'TSK is unrealistic, problems for seaice post')
+                  ELSE IF ( ( xice(i,j) .GE. 0.5 ) .OR. &
+                       ( ( landmask(i,j) .LT. 0.5 ) .AND. ( tsk(i,j) .LT. seaice_threshold ) ) ) THEN
+                     xice(i,j) = 1.
+                     num_seaice_changes = num_seaice_changes + 1
+                     if(landmask(i,j) .LT. 0.5 )tmn(i,j) = 271.4
+                     vegcat(i,j)=isice
+                     ivgtyp(i,j)=isice
+                     lu_index(i,j)=isice
+                     landmask(i,j)=1.
+                     xland(i,j)=1.
+                     vegfra(i,j)=0.
+                     DO loop=1,num_veg_cat
+                        landusef(i,loop,j)=0.
+                     END DO
+                     landusef(i,ivgtyp(i,j),j)=1.
+
+                     tsk_old(i,j) = tsk(i,j)
+
+                     isltyp(i,j) = 16
+                     soilcat(i,j)=isltyp(i,j)
+                     DO loop=1,num_soil_top_cat
+                        soilctop(i,loop,j)=0
+                     END DO
+                     DO loop=1,num_soil_bot_cat
+                        soilcbot(i,loop,j)=0
+                     END DO
+                     soilctop(i,isltyp(i,j),j)=1.
+                     soilcbot(i,isltyp(i,j),j)=1.
+
+                     total_depth = 3. ! ice is 3 m deep, num_soil_layers equispaced layers
+                     DO loop = 1,num_soil_layers
+                        mid_point_depth=(total_depth/num_soil_layers)/2. + &
+                                        (loop-1)*(total_depth/num_soil_layers)
+                        tslb(i,loop,j) = ( (total_depth-mid_point_depth)*tsk(i,j) + &
+                                            mid_point_depth*tmn(i,j) ) / total_depth
+                     END DO
+
+                     DO loop=1,num_soil_layers
+                        smois(i,loop,j) = 1.0
+                        sh2o(i,loop,j)  = 0.0
+                     END DO
+                  ELSE IF ( xice(i,j) .LT. 0.5 ) THEN
+                     xice(i,j) = 0.
+                  END IF
+               END DO
+            END DO
+            IF ( num_seaice_changes .GT. 0 ) THEN
+               WRITE ( message , FMT='(A,I6)' ) &
+               'Total post number of sea ice location changes (water to land) = ', num_seaice_changes
+               CALL wrf_debug ( 0 , message )  
+            END IF
+
+      END SELECT fix_seaice
+
+   END SUBROUTINE adjust_for_seaice_post
+
+   SUBROUTINE process_percent_cat_new ( landmask ,  &
+                                landuse_frac , soil_top_cat , soil_bot_cat , &
+                                isltyp , ivgtyp , &
+                                num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                ids , ide , jds , jde , kds , kde , &
+                                ims , ime , jms , jme , kms , kme , &
+                                its , ite , jts , jte , kts , kte , &
+                                iswater )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              iswater
+      INTEGER , INTENT(IN) :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+      REAL , DIMENSION(ims:ime,1:num_veg_cat,jms:jme) , INTENT(INOUT):: landuse_frac
+      REAL , DIMENSION(ims:ime,1:num_soil_top_cat,jms:jme) , INTENT(IN):: soil_top_cat
+      REAL , DIMENSION(ims:ime,1:num_soil_bot_cat,jms:jme) , INTENT(IN):: soil_bot_cat
+      INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: isltyp , ivgtyp
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: landmask
+
+      INTEGER :: i , j , l , ll, dominant_index
+      REAL :: dominant_value
+
+#ifdef WRF_CHEM
+!      REAL :: lwthresh = .99
+      REAL :: lwthresh = .50
+#else
+      REAL :: lwthresh = .50
+#endif
+
+      INTEGER , PARAMETER :: iswater_soil = 14
+      INTEGER :: iforce
+      CHARACTER (LEN=132) :: message
+integer :: change_water , change_land
+change_water = 0 
+change_land = 0
+
+      !  Sanity check on the 50/50 points
+
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            dominant_value = landuse_frac(i,iswater,j)
+            IF ( dominant_value .EQ. lwthresh ) THEN
+               DO l = 1 , num_veg_cat
+                  IF ( l .EQ. iswater ) CYCLE
+                  IF ( ( landuse_frac(i,l,j) .EQ. lwthresh ) .AND. ( landmask(i,j) .LT. 0.5 ) ) THEN
+                     PRINT *,i,j,' water and category ',l,' both at 50%, landmask is ',landmask(i,j)
+                     landuse_frac(i,l,j) = lwthresh - .01
+                     landuse_frac(i,iswater,j) = lwthresh + 0.01
+                  ELSE IF ( ( landuse_frac(i,l,j) .EQ. lwthresh ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
+                     PRINT *,i,j,' water and category ',l,' both at 50%, landmask is ',landmask(i,j)
+                     landuse_frac(i,l,j) = lwthresh + .01
+                     landuse_frac(i,iswater,j) = lwthresh - 0.01
+                  END IF
+               END DO
+            END IF
+         END DO
+      END DO
+
+      !  Compute the dominant VEGETATION INDEX.
+
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            dominant_value = landuse_frac(i,1,j)
+            dominant_index = 1
+            DO l = 2 , num_veg_cat
+               IF        ( l .EQ. iswater ) THEN
+                  ! wait a bit
+               ELSE IF ( ( l .NE. iswater ) .AND. ( landuse_frac(i,l,j) .GT. dominant_value ) ) THEN
+                  dominant_value = landuse_frac(i,l,j)
+                  dominant_index = l
+               END IF
+            END DO
+            IF ( landuse_frac(i,iswater,j) .GT. lwthresh ) THEN
+               dominant_value = landuse_frac(i,iswater,j)
+               dominant_index = iswater
+            ELSE IF ( ( landuse_frac(i,iswater,j) .EQ. lwthresh) .AND. &
+                      ( landmask(i,j) .LT. 0.5) .AND. &
+                      ( dominant_value .EQ. lwthresh) ) THEN
+               dominant_value = landuse_frac(i,iswater,j)
+               dominant_index = iswater
+            ELSE IF ( ( landuse_frac(i,iswater,j) .EQ. lwthresh) .AND. &
+                      ( landmask(i,j) .GT. 0.5) .AND. &
+                      ( dominant_value .EQ. lwthresh) ) THEN
+               !no op
+            ELSE IF ( ( landuse_frac(i,iswater,j) .EQ. lwthresh ) .AND. &
+                      ( dominant_value .LT. lwthresh ) ) THEN
+               dominant_value = landuse_frac(i,iswater,j)
+               dominant_index = iswater
+            END IF
+            IF      ( dominant_index .EQ. iswater ) THEN
+if(landmask(i,j).gt.lwthresh) then
+!print *,'changing to water at point ',i,j
+!print '(24(i3,1x))',1, 2, 3, 4, 5, 6, 7, 8, 9, 10,11,12, 13, 14, 15, 16, 17,18,19,20,21, 22, 23,24
+!print '(24(i3,1x))',nint(landuse_frac(i,:,j)*100)
+change_water=change_water+1
+endif
+               landmask(i,j) = 0
+            ELSE IF ( dominant_index .NE. iswater ) THEN
+if(landmask(i,j).lt.lwthresh) then
+!print *,'changing to land at point ',i,j
+!print '(24(i3,1x))',1, 2, 3, 4, 5, 6, 7, 8, 9, 10,11,12, 13, 14, 15, 16, 17,18,19,20,21, 22, 23,24
+!print '(24(i3,1x))',nint(landuse_frac(i,:,j)*100)
+change_land=change_land+1
+endif
+               landmask(i,j) = 1
+            END IF
+            ivgtyp(i,j) = dominant_index
+         END DO
+      END DO
+
+      !  Compute the dominant SOIL TEXTURE INDEX, TOP.
+
+      iforce = 0
+      DO i = its , MIN(ide-1,ite)
+         DO j = jts , MIN(jde-1,jte)
+            dominant_value = soil_top_cat(i,1,j)
+            dominant_index = 1
+            IF ( landmask(i,j) .GT. lwthresh ) THEN
+               DO l = 2 , num_soil_top_cat
+                  IF ( ( l .NE. iswater_soil ) .AND. ( soil_top_cat(i,l,j) .GT. dominant_value ) ) THEN
+                     dominant_value = soil_top_cat(i,l,j)
+                     dominant_index = l
+                  END IF
+               END DO
+               IF ( dominant_value .LT. 0.01 ) THEN
+                  iforce = iforce + 1
+                  WRITE ( message , FMT = '(A,I4,I4)' ) &
+                  'based on landuse, changing soil to land at point ',i,j
+                  CALL wrf_debug(1,message)
+                  WRITE ( message , FMT = '(16(i3,1x))' ) &
+                  1, 2, 3, 4, 5, 6, 7, 8, 9, 10,11,12, 13, 14, 15, 16
+                  CALL wrf_debug(1,message)
+                  WRITE ( message , FMT = '(16(i3,1x))' ) &
+                  nint(soil_top_cat(i,:,j)*100)
+                  CALL wrf_debug(1,message)
+                  dominant_index = 8
+               END IF
+            ELSE
+               dominant_index = iswater_soil
+            END IF
+            isltyp(i,j) = dominant_index
+         END DO
+      END DO
+
+if(iforce.ne.0)then
+WRITE(message,FMT='(A,I4,A,I6)' ) &
+'forcing artificial silty clay loam at ',iforce,' points, out of ',&
+(MIN(ide-1,ite)-its+1)*(MIN(jde-1,jte)-jts+1)
+CALL wrf_debug(0,message)
+endif
+print *,'LAND  CHANGE = ',change_land
+print *,'WATER CHANGE = ',change_water
+
+   END SUBROUTINE process_percent_cat_new
+
+   SUBROUTINE process_soil_real ( tsk , tmn , &
+                                landmask , sst , &
+                                st_input , sm_input , sw_input , st_levels_input , sm_levels_input , sw_levels_input , &
+                                zs , dzs , tslb , smois , sh2o , &
+                                flag_sst , flag_soilt000, flag_soilm000, &
+                                ids , ide , jds , jde , kds , kde , &
+                                ims , ime , jms , jme , kms , kme , &
+                                its , ite , jts , jte , kts , kte , &
+                                sf_surface_physics , num_soil_layers , real_data_init_type , &
+                                num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+                                num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              sf_surface_physics , num_soil_layers , real_data_init_type , &
+                              num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+                              num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc 
+
+      INTEGER , INTENT(IN) :: flag_sst, flag_soilt000, flag_soilm000
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
+
+      INTEGER , DIMENSION(1:num_st_levels_input) , INTENT(INOUT) :: st_levels_input
+      INTEGER , DIMENSION(1:num_sm_levels_input) , INTENT(INOUT) :: sm_levels_input
+      INTEGER , DIMENSION(1:num_sw_levels_input) , INTENT(INOUT) :: sw_levels_input
+      REAL , DIMENSION(ims:ime,1:num_st_levels_alloc,jms:jme) , INTENT(INOUT) :: st_input
+      REAL , DIMENSION(ims:ime,1:num_sm_levels_alloc,jms:jme) , INTENT(INOUT) :: sm_input
+      REAL , DIMENSION(ims:ime,1:num_sw_levels_alloc,jms:jme) , INTENT(INOUT) :: sw_input
+
+      REAL, DIMENSION(1:num_soil_layers), INTENT(OUT)  ::  zs,dzs
+      REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb , smois , sh2o
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tmn 
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tsk
+
+      INTEGER :: i , j , l , dominant_index , num_soil_cat , num_veg_cat
+      REAL :: dominant_value
+
+      !  Initialize the soil depth, and the soil temperature and moisture.
+   
+      IF      ( ( sf_surface_physics .EQ. 1 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_1 ( zs , dzs , num_soil_layers )
+         CALL init_soil_1_real ( tsk , tmn , tslb , zs , dzs , num_soil_layers , real_data_init_type , &
+                                 landmask , sst , flag_sst , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      ELSE IF ( ( sf_surface_physics .EQ. 2 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_2 ( zs , dzs , num_soil_layers )
+         CALL init_soil_2_real ( tsk , tmn , smois , sh2o , tslb , &
+                                 st_input , sm_input , sw_input , landmask , sst , &
+                                 zs , dzs , &
+                                 st_levels_input , sm_levels_input , sw_levels_input , &
+                                 num_soil_layers , num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+                                 num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc , &
+                                 flag_sst , flag_soilt000 , flag_soilm000 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+!        CALL init_soil_old ( tsk , tmn , &
+!                             smois , tslb , zs , dzs , num_soil_layers , &
+!                             st000010_input , st010040_input , st040100_input , st100200_input , &
+!                             st010200_input , &
+!                             sm000010_input , sm010040_input , sm040100_input , sm100200_input , &
+!                             sm010200_input , &
+!                             landmask_input , sst_input , &
+!                             ids , ide , jds , jde , kds , kde , &
+!                             ims , ime , jms , jme , kms , kme , &
+!                             its , ite , jts , jte , kts , kte )
+      ELSE IF ( ( sf_surface_physics .EQ. 3 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_3 ( zs , dzs , num_soil_layers )
+         CALL init_soil_3_real ( tsk , tmn , smois , tslb , &
+                                 st_input , sm_input , landmask , sst , &
+                                 zs , dzs , &
+                                 st_levels_input , sm_levels_input , &
+                                 num_soil_layers , num_st_levels_input , num_sm_levels_input , &
+                                 num_st_levels_alloc , num_sm_levels_alloc , &
+                                 flag_sst , flag_soilt000 , flag_soilm000 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+      END IF
+
+   END SUBROUTINE process_soil_real
+
+   SUBROUTINE process_soil_ideal ( xland,xice,vegfra,snow,canwat,  &
+                                   ivgtyp,isltyp,tslb,smois, &
+                                   tsk,tmn,zs,dzs,           &
+                                   num_soil_layers,          &
+                                   sf_surface_physics ,      &
+                                   ids,ide, jds,jde, kds,kde,&
+                                   ims,ime, jms,jme, kms,kme,&
+                                   its,ite, jts,jte, kts,kte )
+
+      IMPLICIT NONE
+
+      INTEGER, INTENT(IN) ::ids,ide, jds,jde, kds,kde,  &
+                            ims,ime, jms,jme, kms,kme,  &
+                            its,ite, jts,jte, kts,kte
+  
+      INTEGER, INTENT(IN) :: num_soil_layers , sf_surface_physics
+
+      REAL, DIMENSION( ims:ime, num_soil_layers, jms:jme ) , INTENT(INOUT) :: smois, tslb
+
+      REAL, DIMENSION(num_soil_layers), INTENT(OUT) :: dzs,zs
+
+      REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT) :: tsk, tmn
+      REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT) :: xland, snow, canwat, xice, vegfra
+      INTEGER, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT) :: ivgtyp, isltyp
+
+      !  Local variables.
+
+      INTEGER :: itf,jtf
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+
+      IF      ( ( sf_surface_physics .EQ. 1 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_1 ( zs , dzs , num_soil_layers )
+         CALL init_soil_1_ideal(tsk,tmn,tslb,xland,                      &
+                                ivgtyp,zs,dzs,num_soil_layers,           &
+                                ids,ide, jds,jde, kds,kde,               &
+                                ims,ime, jms,jme, kms,kme,               &
+                                its,ite, jts,jte, kts,kte                )
+      ELSE IF ( ( sf_surface_physics .EQ. 2 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_2 ( zs , dzs , num_soil_layers )
+         CALL init_soil_2_ideal ( xland,xice,vegfra,snow,canwat,         &
+                                  ivgtyp,isltyp,tslb,smois,tmn,          &
+                                  num_soil_layers,                       &
+                                  ids,ide, jds,jde, kds,kde,             &
+                                  ims,ime, jms,jme, kms,kme,             &
+                                  its,ite, jts,jte, kts,kte              )
+      ELSE IF ( ( sf_surface_physics .EQ. 3 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_3 ( zs , dzs , num_soil_layers )
+
+      END IF
+
+   END SUBROUTINE process_soil_ideal
+
+   SUBROUTINE adjust_soil_temp_new ( tmn , sf_surface_physics , &
+                                 tsk , ter , toposoil , landmask , flag_toposoil , &
+                                      st000010 ,      st010040 ,      st040100 ,      st100200 ,      st010200 , &
+                                 flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , & 
+                                      st000007 ,      st007028 ,      st028100 ,      st100255 , &
+                                 flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
+                                      soilt000 ,      soilt005 ,      soilt020 ,      soilt040 ,      soilt160 ,      soilt300 , &
+                                 flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , flag_soilt160 , flag_soilt300 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+   
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte 
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN)    :: ter , toposoil , landmask
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tmn , tsk
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: st000010 , st010040 , st040100 , st100200 , st010200
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: st000007 , st007028 , st028100 , st100255
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: soilt000 , soilt005 , soilt020 , soilt040 , soilt160 , soilt300
+
+      INTEGER , INTENT(IN) :: flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200
+      INTEGER , INTENT(IN) :: flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255
+      INTEGER , INTENT(IN) :: flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , flag_soilt160 , flag_soilt300
+      INTEGER , INTENT(IN) :: sf_surface_physics , flag_toposoil
+ 
+      INTEGER :: i , j
+
+      REAL :: soil_elev_min_val ,  soil_elev_max_val , soil_elev_min_dif , soil_elev_max_dif
+
+      !  Do we have a soil field with which to modify soil temperatures?
+
+      IF ( flag_toposoil .EQ. 1 ) THEN
+
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+
+               !  Is the toposoil field OK, or is it a subversive soil elevation field.  We can tell
+               !  usually by looking at values.  Anything less than -1000 m (lower than the Dead Sea) is
+               !  bad.  Anything larger than 10 km (taller than Everest) is toast.  Also, anything where 
+               !  the difference between the soil elevation and the terrain is greater than 3 km means
+               !  that the soil data is either all zeros or that the data are inconsistent.  Any of these
+               !  three conditions is grievous enough to induce a WRF fatality.  However, if they are at
+               !  a water point, then we can safely ignore them.
+         
+               soil_elev_min_val = toposoil(i,j) 
+               soil_elev_max_val = toposoil(i,j) 
+               soil_elev_min_dif = ter(i,j) - toposoil(i,j)
+               soil_elev_max_dif = ter(i,j) - toposoil(i,j)
+         
+               IF      ( ( soil_elev_min_val .LT. -1000 ) .AND. ( landmask(i,j) .LT. 0.5 ) ) THEN
+                  CYCLE
+               ELSE IF ( ( soil_elev_min_val .LT. -1000 ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
+!print *,'no soil temperature elevation adjustment, soil height too small = ',toposoil(i,j)
+cycle
+!                 CALL wrf_error_fatal ( 'TOPOSOIL values have large negative values < -1000 m, unrealistic.' )
+               ENDIF
+         
+               IF      ( ( soil_elev_max_val .GT. 10000 ) .AND. ( landmask(i,j) .LT. 0.5 ) ) THEN
+                  CYCLE
+               ELSE IF ( ( soil_elev_max_val .GT. 10000 ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
+print *,'no soil temperature elevation adjustment, soil height too high = ',toposoil(i,j)
+cycle
+                  CALL wrf_error_fatal ( 'TOPOSOIL values have large positive values > 10,000 m , unrealistic.' )
+               ENDIF
+         
+               IF      ( ( ( soil_elev_min_dif .LT. -3000 ) .OR. ( soil_elev_max_dif .GT. 3000 ) ) .AND. &
+                           ( landmask(i,j) .LT. 0.5 ) ) THEN
+                  CYCLE
+               ELSE IF ( ( ( soil_elev_min_dif .LT. -3000 ) .OR. ( soil_elev_max_dif .GT. 3000 ) ) .AND. &
+                           ( landmask(i,j) .GT. 0.5 ) ) THEN
+print *,'no soil temperature elevation adjustment, diff of soil height and terrain = ',ter(i,j) - toposoil(i,j)
+cycle
+                  CALL wrf_error_fatal ( 'TOPOSOIL difference with terrain elevation differs by more than 3000 m, unrealistic' )
+               ENDIF
+
+               !  For each of the fields that we would like to modify, check to see if it came in from the SI.
+               !  If so, then use a -6.5 K/km lapse rate (based on the elevation diffs).  We only adjust when we
+               !  are not at a water point.
+
+               IF (landmask(i,j) .GT. 0.5 ) THEN
+   
+                  IF ( sf_surface_physics .EQ. 1 ) THEN
+                     tmn(i,j) = tmn(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  
+                  tsk(i,j) = tsk(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+      
+                  IF ( flag_st000010 .EQ. 1 ) THEN
+                     st000010(i,j) = st000010(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st010040 .EQ. 1 ) THEN
+                     st010040(i,j) = st010040(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st040100 .EQ. 1 ) THEN
+                     st040100(i,j) = st040100(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st100200 .EQ. 1 ) THEN
+                     st100200(i,j) = st100200(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st010200 .EQ. 1 ) THEN
+                     st010200(i,j) = st010200(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+
+                  IF ( flag_st000007 .EQ. 1 ) THEN
+                     st000007(i,j) = st000007(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st007028 .EQ. 1 ) THEN
+                     st007028(i,j) = st007028(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st028100 .EQ. 1 ) THEN
+                     st028100(i,j) = st028100(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st100255 .EQ. 1 ) THEN
+                     st100255(i,j) = st100255(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+      
+                  IF ( flag_soilt000 .EQ. 1 ) THEN
+                     soilt000(i,j) = soilt000(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt005 .EQ. 1 ) THEN
+                     soilt005(i,j) = soilt005(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt020 .EQ. 1 ) THEN
+                     soilt020(i,j) = soilt020(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt040 .EQ. 1 ) THEN
+                     soilt040(i,j) = soilt040(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt160 .EQ. 1 ) THEN
+                     soilt160(i,j) = soilt160(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt300 .EQ. 1 ) THEN
+                     soilt300(i,j) = soilt300(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+   
+               END IF
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE adjust_soil_temp_new
+
+
+   SUBROUTINE init_soil_depth_1 ( zs , dzs , num_soil_layers )
+
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN) :: num_soil_layers
+   
+      REAL, DIMENSION(1:num_soil_layers), INTENT(OUT)  ::  zs,dzs
+   
+      INTEGER                   ::      l
+
+      !  Define layers (top layer = 0.01 m).  Double the thicknesses at each step (dzs values).
+      !  The distance from the ground level to the midpoint of the layer is given by zs.
+
+      !    -------   Ground Level   ----------      ||      ||   ||  || 
+      !                                             ||      ||   ||  || zs(1) = 0.005 m
+      !    --  --  --  --  --  --  --  --  --       ||      ||   ||  \/
+      !                                             ||      ||   ||
+      !    -----------------------------------      ||  ||  ||   \/   dzs(1) = 0.01 m
+      !                                             ||  ||  || 
+      !                                             ||  ||  || zs(2) = 0.02
+      !    --  --  --  --  --  --  --  --  --       ||  ||  \/
+      !                                             ||  ||
+      !                                             ||  ||
+      !    -----------------------------------  ||  ||  \/   dzs(2) = 0.02 m
+      !                                         ||  || 
+      !                                         ||  ||
+      !                                         ||  || 
+      !                                         ||  || zs(3) = 0.05
+      !    --  --  --  --  --  --  --  --  --   ||  \/
+      !                                         ||
+      !                                         ||
+      !                                         ||
+      !                                         ||
+      !    -----------------------------------  \/   dzs(3) = 0.04 m
+
+      IF ( num_soil_layers .NE. 5 ) THEN
+         PRINT '(A)','Usually, the 5-layer diffusion uses 5 layers.  Change this in the namelist.'
+         CALL wrf_error_fatal ( '5-layer_diffusion_uses_5_layers' )
+      END IF
+   
+      dzs(1)=.01
+      zs(1)=.5*dzs(1)
+   
+      DO l=2,num_soil_layers
+         dzs(l)=2*dzs(l-1)
+         zs(l)=zs(l-1)+.5*dzs(l-1)+.5*dzs(l)
+      ENDDO
+
+   END SUBROUTINE init_soil_depth_1
+
+   SUBROUTINE init_soil_depth_2 ( zs , dzs , num_soil_layers )
+
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN) :: num_soil_layers
+   
+      REAL, DIMENSION(1:num_soil_layers), INTENT(OUT)  ::  zs,dzs
+   
+      INTEGER                   ::      l
+
+      dzs = (/ 0.1 , 0.3 , 0.6 , 1.0 /)
+
+      IF ( num_soil_layers .NE. 4 ) THEN
+         PRINT '(A)','Usually, the LSM uses 4 layers.  Change this in the namelist.'
+         CALL wrf_error_fatal ( 'LSM_uses_4_layers' )
+      END IF
+
+      zs(1)=.5*dzs(1)
+   
+      DO l=2,num_soil_layers
+         zs(l)=zs(l-1)+.5*dzs(l-1)+.5*dzs(l)
+      ENDDO
+
+   END SUBROUTINE init_soil_depth_2
+
+   SUBROUTINE init_soil_depth_3 ( zs , dzs , num_soil_layers )
+
+      IMPLICIT NONE
+
+      INTEGER, INTENT(IN) :: num_soil_layers
+
+      REAL, DIMENSION(1:num_soil_layers), INTENT(OUT)  ::  zs,dzs
+
+      INTEGER                   ::      l
+
+      CHARACTER (LEN=132) :: message
+
+! in RUC LSM ZS - soil levels, and DZS - soil layer thicknesses, not used
+! ZS is specified in the namelist: num_soil_layers = 6 or 9.
+! Other options with number of levels are possible, but
+! WRF users should change consistently the namelist entry with the
+!    ZS array in this subroutine.
+
+     IF ( num_soil_layers .EQ. 6) THEN
+      zs  = (/ 0.00 , 0.05 , 0.20 , 0.40 , 1.60 , 3.00 /)
+!      dzs = (/ 0.00 , 0.125, 0.175 , 0.70 , 1.30 , 1.40 /)
+     ELSEIF ( num_soil_layers .EQ. 9) THEN
+      zs  = (/ 0.00 , 0.05 , 0.20 , 0.40 , 0.60, 1.00, 1.60 , 2.20, 3.00 /)
+!      dzs = (/ 0.00 , 0.125, 0.175 , 0.70 , 1.30 , 1.40 /)
+     ENDIF
+
+      IF ( num_soil_layers .EQ. 4 .OR. num_soil_layers .EQ. 5 ) THEN
+         write (message, FMT='(A)') 'The RUC LSM uses 6, 9 or more levels.  Change this in the namelist.'
+         CALL wrf_error_fatal ( message )
+      END IF
+
+   END SUBROUTINE init_soil_depth_3
+
+   SUBROUTINE init_soil_1_real ( tsk , tmn , tslb , zs , dzs , &
+                                 num_soil_layers , real_data_init_type , &
+                                 landmask , sst , flag_sst , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: num_soil_layers , real_data_init_type , &
+                              ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte 
+
+      INTEGER , INTENT(IN) :: flag_sst
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tsk , tmn
+
+      REAL , DIMENSION(num_soil_layers) :: zs , dzs
+
+      REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb
+
+      INTEGER :: i , j , l
+
+      !  Soil temperature is linearly interpolated between the skin temperature (taken to be at a
+      !  depth of 0.5 cm) and the deep soil, annual temperature (taken to be at a depth of 23 cm).
+      !  The tslb(i,1,j) is the skin temperature, and the tslb(i,num_soil_layers,j) level is the 
+      !  annual mean temperature.
+
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            IF ( landmask(i,j) .GT. 0.5 ) THEN
+               DO l = 1 , num_soil_layers
+                  tslb(i,l,j)= ( tsk(i,j) * ( zs(num_soil_layers) - zs(l) )   + &
+                                 tmn(i,j) * ( zs(              l) - zs(1) ) ) / &
+                                            ( zs(num_soil_layers) - zs(1) )
+               END DO
+            ELSE
+               IF ( ( real_data_init_type .EQ. 1 ) .AND. ( flag_sst .EQ. 1 ) ) THEN
+                  DO l = 1 , num_soil_layers
+                     tslb(i,l,j)= sst(i,j)
+                  END DO
+               ELSE
+                  DO l = 1 , num_soil_layers
+                     tslb(i,l,j)= tsk(i,j)
+                  END DO
+               END IF
+            END IF
+         END DO
+      END DO
+
+   END SUBROUTINE init_soil_1_real
+
+   SUBROUTINE init_soil_1_ideal(tsk,tmn,tslb,xland,             &
+                       ivgtyp,ZS,DZS,num_soil_layers,           &
+                       ids,ide, jds,jde, kds,kde,               &
+                       ims,ime, jms,jme, kms,kme,               &
+                       its,ite, jts,jte, kts,kte                )
+
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN   )    ::      ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+   
+      INTEGER, INTENT(IN   )    ::      num_soil_layers
+   
+      REAL, DIMENSION( ims:ime , 1 , jms:jme ), INTENT(OUT) :: tslb
+      REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: xland
+      INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: ivgtyp
+   
+      REAL, DIMENSION(1:), INTENT(IN) :: dzs,zs
+   
+      REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(IN) :: tsk, tmn
+
+      !  Lcal variables.
+   
+      INTEGER :: l,j,i,itf,jtf
+   
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+   
+      IF (num_soil_layers.NE.1)THEN
+         DO j=jts,jtf
+            DO l=1,num_soil_layers
+               DO i=its,itf
+                 tslb(i,l,j)=( tsk(i,j)*(zs(num_soil_layers)-zs(l)) + tmn(i,j)*(zs(l)-zs(1)) ) / &
+                             ( zs(num_soil_layers)-zs(1) )
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+      DO j=jts,jtf
+         DO i=its,itf
+           xland(i,j)  = 2
+           ivgtyp(i,j) = 7
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE init_soil_1_ideal
+
+   SUBROUTINE init_soil_2_real ( tsk , tmn , smois , sh2o , tslb , &
+                                 st_input , sm_input , sw_input , landmask , sst , &
+                                 zs , dzs , &
+                                 st_levels_input , sm_levels_input , sw_levels_input , &
+                                 num_soil_layers , num_st_levels_input , num_sm_levels_input ,  num_sw_levels_input , &
+                                 num_st_levels_alloc , num_sm_levels_alloc ,  num_sw_levels_alloc , &
+                                 flag_sst , flag_soilt000 , flag_soilmt000 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: num_soil_layers , &
+                              num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+                              num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc , &
+                              ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte 
+
+      INTEGER , INTENT(IN) :: flag_sst, flag_soilt000, flag_soilmt000
+
+      INTEGER , DIMENSION(1:num_st_levels_input) , INTENT(INOUT) :: st_levels_input
+      INTEGER , DIMENSION(1:num_sm_levels_input) , INTENT(INOUT) :: sm_levels_input
+      INTEGER , DIMENSION(1:num_sw_levels_input) , INTENT(INOUT) :: sw_levels_input
+
+      REAL , DIMENSION(ims:ime,1:num_st_levels_alloc,jms:jme) , INTENT(INOUT) :: st_input
+      REAL , DIMENSION(ims:ime,1:num_sm_levels_alloc,jms:jme) , INTENT(INOUT) :: sm_input
+      REAL , DIMENSION(ims:ime,1:num_sw_levels_alloc,jms:jme) , INTENT(INOUT) :: sw_input
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tmn
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tsk
+      REAL , DIMENSION(num_soil_layers) :: zs , dzs
+
+      REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb , smois , sh2o
+
+      REAL , ALLOCATABLE , DIMENSION(:) :: zhave
+
+      INTEGER :: i , j , l , lout , lin , lwant , lhave , num
+      REAL :: temp
+      LOGICAL :: found_levels
+
+      !  Are there any soil temp and moisture levels - ya know, they are mandatory.
+
+      num = num_st_levels_input * num_sm_levels_input
+
+      IF ( num .GE. 1 ) THEN
+
+         !  Ordered levels that we have data for.
+
+         ALLOCATE ( zhave( MAX(num_st_levels_input,num_sm_levels_input,num_sw_levels_input) +2) )
+
+         !  Sort the levels for temperature.
+   
+         outert : DO lout = 1 , num_st_levels_input-1
+            innert : DO lin = lout+1 , num_st_levels_input
+               IF ( st_levels_input(lout) .GT. st_levels_input(lin) ) THEN
+                  temp = st_levels_input(lout) 
+                  st_levels_input(lout) = st_levels_input(lin)
+                  st_levels_input(lin) = NINT(temp)
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        temp = st_input(i,lout+1,j)
+                        st_input(i,lout+1,j) = st_input(i,lin+1,j)
+                        st_input(i,lin+1,j) = temp
+                     END DO
+                  END DO
+               END IF
+            END DO innert
+         END DO outert
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,1,j) = tsk(i,j)
+               st_input(i,num_st_levels_input+2,j) = tmn(i,j)
+            END DO
+         END DO
+   
+         !  Sort the levels for moisture.
+   
+         outerm: DO lout = 1 , num_sm_levels_input-1
+            innerm : DO lin = lout+1 , num_sm_levels_input
+               IF ( sm_levels_input(lout) .GT. sm_levels_input(lin) ) THEN
+                  temp = sm_levels_input(lout) 
+                  sm_levels_input(lout) = sm_levels_input(lin)
+                  sm_levels_input(lin) = NINT(temp)
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        temp = sm_input(i,lout+1,j)
+                        sm_input(i,lout+1,j) = sm_input(i,lin+1,j)
+                        sm_input(i,lin+1,j) = temp
+                     END DO
+                  END DO
+               END IF
+            END DO innerm
+         END DO outerm
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,1,j) = sm_input(i,2,j)
+               sm_input(i,num_sm_levels_input+2,j) = sm_input(i,num_sm_levels_input+1,j)
+            END DO
+         END DO
+   
+         !  Sort the levels for liquid moisture.
+   
+         outerw: DO lout = 1 , num_sw_levels_input-1
+            innerw : DO lin = lout+1 , num_sw_levels_input
+               IF ( sw_levels_input(lout) .GT. sw_levels_input(lin) ) THEN
+                  temp = sw_levels_input(lout) 
+                  sw_levels_input(lout) = sw_levels_input(lin)
+                  sw_levels_input(lin) = NINT(temp)
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        temp = sw_input(i,lout+1,j)
+                        sw_input(i,lout+1,j) = sw_input(i,lin+1,j)
+                        sw_input(i,lin+1,j) = temp
+                     END DO
+                  END DO
+               END IF
+            END DO innerw
+         END DO outerw
+         IF ( num_sw_levels_input .GT. 1 ) THEN
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  sw_input(i,1,j) = sw_input(i,2,j)
+                  sw_input(i,num_sw_levels_input+2,j) = sw_input(i,num_sw_levels_input+1,j)
+               END DO
+            END DO
+         END IF
+
+         found_levels = .TRUE.
+
+      ELSE IF ( ( num .LE. 0 ) .AND. (  start_date .NE. current_date ) ) THEN
+
+         found_levels = .FALSE.
+
+      ELSE
+         CALL wrf_error_fatal ( &
+         'No input soil level data (temperature, moisture or liquid, or all are missing). Required for LSM.' )
+      END IF
+
+      !  Is it OK to continue?
+
+      IF ( found_levels ) THEN
+
+         !  Here are the levels that we have from the input for temperature.  The input levels plus
+         !  two more: the skin temperature at 0 cm, and the annual mean temperature at 300 cm.
+
+         zhave(1) = 0.
+         DO l = 1 , num_st_levels_input
+            zhave(l+1) = st_levels_input(l) / 100.
+         END DO
+         zhave(num_st_levels_input+2) = 300. / 100.
+   
+         !  Interpolate between the layers we have (zhave) and those that we want (zs).
+   
+         z_wantt : DO lwant = 1 , num_soil_layers
+            z_havet : DO lhave = 1 , num_st_levels_input +2 -1
+               IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                    ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        tslb(i,lwant,j)= ( st_input(i,lhave  ,j) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                           st_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                   ( zhave(lhave+1) - zhave(lhave) )
+                     END DO
+                  END DO
+                  EXIT z_havet
+               END IF
+            END DO z_havet
+         END DO z_wantt
+
+         !  Here are the levels that we have from the input for moisture.  The input levels plus
+         !  two more: a value at 0 cm and one at 300 cm.  The 0 cm value is taken to be identical
+         !  to the most shallow layer's value.  Similarly, the 300 cm value is taken to be the same
+         !  as the most deep layer's value.
+   
+         zhave(1) = 0.
+         DO l = 1 , num_sm_levels_input
+            zhave(l+1) = sm_levels_input(l) / 100.
+         END DO
+         zhave(num_sm_levels_input+2) = 300. / 100.
+   
+         !  Interpolate between the layers we have (zhave) and those that we want (zs).
+   
+         z_wantm : DO lwant = 1 , num_soil_layers
+            z_havem : DO lhave = 1 , num_sm_levels_input +2 -1
+               IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                    ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        smois(i,lwant,j)= ( sm_input(i,lhave  ,j) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                            sm_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                    ( zhave(lhave+1) - zhave(lhave) )
+                     END DO
+                  END DO
+                  EXIT z_havem
+               END IF
+            END DO z_havem
+         END DO z_wantm
+   
+         !  Any liquid soil moisture to worry about?
+   
+         IF ( num_sw_levels_input .GT. 1 ) THEN
+   
+            zhave(1) = 0.
+            DO l = 1 , num_sw_levels_input
+               zhave(l+1) = sw_levels_input(l) / 100.
+            END DO
+            zhave(num_sw_levels_input+2) = 300. / 100.
+      
+            !  Interpolate between the layers we have (zhave) and those that we want (zs).
+      
+            z_wantw : DO lwant = 1 , num_soil_layers
+               z_havew : DO lhave = 1 , num_sw_levels_input +2 -1
+                  IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                       ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+                     DO j = jts , MIN(jde-1,jte)
+                        DO i = its , MIN(ide-1,ite)
+                           sh2o(i,lwant,j)= ( sw_input(i,lhave  ,j) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                               sw_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                       ( zhave(lhave+1) - zhave(lhave) )
+                        END DO
+                     END DO
+                     EXIT z_havew
+                  END IF
+               END DO z_havew
+            END DO z_wantw
+   
+         END IF
+   
+   
+         !  Over water, put in reasonable values for soil temperature and moisture.  These won't be
+         !  used, but they will make a more continuous plot.
+   
+         IF ( flag_sst .EQ. 1 ) THEN
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( landmask(i,j) .LT. 0.5 ) THEN
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)= sst(i,j)
+                        smois(i,l,j)= 1.0
+                        sh2o (i,l,j)= 1.0
+                     END DO
+                  END IF
+               END DO
+            END DO
+         ELSE
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( landmask(i,j) .LT. 0.5 ) THEN
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)= tsk(i,j)
+                        smois(i,l,j)= 1.0
+                        sh2o (i,l,j)= 1.0
+                     END DO
+                  END IF
+               END DO
+            END DO
+         END IF
+   
+         DEALLOCATE (zhave)
+
+      END IF
+
+   END SUBROUTINE init_soil_2_real
+
+   SUBROUTINE init_soil_2_ideal ( xland,xice,vegfra,snow,canwat,     &
+                     ivgtyp,isltyp,tslb,smois,tmn,                  &
+                     num_soil_layers,                               &
+                     ids,ide, jds,jde, kds,kde,                     &
+                     ims,ime, jms,jme, kms,kme,                     &
+                     its,ite, jts,jte, kts,kte                      )
+
+      IMPLICIT NONE 
+   
+      INTEGER, INTENT(IN) ::ids,ide, jds,jde, kds,kde,  &
+                            ims,ime, jms,jme, kms,kme,  &
+                            its,ite, jts,jte, kts,kte
+   
+      INTEGER, INTENT(IN) ::num_soil_layers
+   
+      REAL, DIMENSION( ims:ime, num_soil_layers, jms:jme ) , INTENT(OUT) :: smois, tslb 
+   
+      REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT)  :: xland, snow, canwat, xice, vegfra, tmn
+   
+      INTEGER, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT) :: ivgtyp, isltyp
+   
+      INTEGER :: icm,jcm,itf,jtf
+      INTEGER ::  i,j,l
+   
+      itf=min0(ite,ide-1)
+      jtf=min0(jte,jde-1)
+   
+      icm = ide/2
+      jcm = jde/2
+   
+      DO j=jts,jtf
+         DO l=1,num_soil_layers
+            DO i=its,itf
+   
+               smois(i,1,j)=0.10
+               smois(i,2,j)=0.10
+               smois(i,3,j)=0.10
+               smois(i,4,j)=0.10
+      
+               tslb(i,1,j)=295.           
+               tslb(i,2,j)=297.          
+               tslb(i,3,j)=293.         
+               tslb(i,4,j)=293. 
+
+            ENDDO
+         ENDDO
+      ENDDO                                 
+
+      DO j=jts,jtf
+         DO i=its,itf
+            xland(i,j)  =   2
+            tmn(i,j)    = 294. 
+            xice(i,j)   =   0.
+            vegfra(i,j) =   0. 
+            snow(i,j)   =   0.
+            canwat(i,j) =   0.
+            ivgtyp(i,j) =   7
+            isltyp(i,j) =   8
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE init_soil_2_ideal
+
+   SUBROUTINE init_soil_3_real ( tsk , tmn , smois , tslb , &
+                                 st_input , sm_input , landmask, sst, &
+                                 zs , dzs , &
+                                 st_levels_input , sm_levels_input , &
+                                 num_soil_layers , num_st_levels_input , num_sm_levels_input ,  &
+                                 num_st_levels_alloc , num_sm_levels_alloc , &
+                                 flag_sst , flag_soilt000 , flag_soilm000 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: num_soil_layers , &
+                              num_st_levels_input , num_sm_levels_input , &
+                              num_st_levels_alloc , num_sm_levels_alloc , &
+                              ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte
+
+      INTEGER , INTENT(IN) :: flag_sst, flag_soilt000, flag_soilm000
+
+      INTEGER , DIMENSION(1:num_st_levels_input) , INTENT(INOUT) :: st_levels_input
+      INTEGER , DIMENSION(1:num_sm_levels_input) , INTENT(INOUT) :: sm_levels_input
+
+      REAL , DIMENSION(ims:ime,1:num_st_levels_alloc,jms:jme) , INTENT(INOUT) :: st_input
+      REAL , DIMENSION(ims:ime,1:num_sm_levels_alloc,jms:jme) , INTENT(INOUT) :: sm_input
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tmn
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tsk
+      REAL , DIMENSION(num_soil_layers) :: zs , dzs
+
+      REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb , smois
+
+      REAL , ALLOCATABLE , DIMENSION(:) :: zhave
+
+      INTEGER :: i , j , l , lout , lin , lwant , lhave
+      REAL :: temp
+
+      CHARACTER (LEN=132) :: message
+
+      !  Allocate the soil layer array used for interpolating.
+
+      IF ( ( num_st_levels_input .LE. 0 ) .OR. & 
+           ( num_sm_levels_input .LE. 0 ) ) THEN
+         write (message, FMT='(A)')&
+'No input soil level data (either temperature or moisture, or both are missing).  Required for RUC LSM.' 
+         CALL wrf_error_fatal ( message )
+      ELSE
+         IF ( flag_soilt000 .eq. 1 ) THEN
+           write(message, FMT='(A)') ' Assume RUC LSM 6-level input'
+           CALL wrf_message ( message )
+           ALLOCATE ( zhave( MAX(num_st_levels_input,num_sm_levels_input)  ) )
+         ELSE
+           write(message, FMT='(A)') ' Assume non-RUC LSM input'
+           CALL wrf_message ( message )
+           ALLOCATE ( zhave( MAX(num_st_levels_input,num_soil_layers)  ) )
+         END IF
+      END IF
+
+      !  Sort the levels for temperature.
+
+      outert : DO lout = 1 , num_st_levels_input-1
+         innert : DO lin = lout+1 , num_st_levels_input
+            IF ( st_levels_input(lout) .GT. st_levels_input(lin) ) THEN
+               temp = st_levels_input(lout) 
+               st_levels_input(lout) = st_levels_input(lin)
+               st_levels_input(lin) = NINT(temp)
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     temp = st_input(i,lout,j)
+                     st_input(i,lout,j) = st_input(i,lin,j)
+                     st_input(i,lin,j) = temp
+                  END DO
+               END DO
+            END IF
+         END DO innert
+      END DO outert
+
+      IF ( flag_soilt000 .NE. 1 ) THEN
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            st_input(i,1,j) = tsk(i,j)
+            st_input(i,num_st_levels_input+2,j) = tmn(i,j)
+         END DO
+      END DO
+      END IF
+
+      !  Sort the levels for moisture.
+
+      outerm: DO lout = 1 , num_sm_levels_input-1
+         innerm : DO lin = lout+1 , num_sm_levels_input
+            IF ( sm_levels_input(lout) .GT. sm_levels_input(lin) ) THEN
+               temp = sm_levels_input(lout) 
+               sm_levels_input(lout) = sm_levels_input(lin)
+               sm_levels_input(lin) = NINT(temp)
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     temp = sm_input(i,lout,j)
+                     sm_input(i,lout,j) = sm_input(i,lin,j)
+                     sm_input(i,lin,j) = temp
+                  END DO
+               END DO
+            END IF
+         END DO innerm
+      END DO outerm
+
+      IF ( flag_soilm000 .NE. 1 ) THEN
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            sm_input(i,1,j) = sm_input(i,2,j)
+            sm_input(i,num_sm_levels_input+2,j) = sm_input(i,num_sm_levels_input+1,j)
+         END DO
+      END DO
+      END IF
+
+      !  Here are the levels that we have from the input for temperature.
+
+      IF ( flag_soilt000 .EQ. 1 ) THEN
+         DO l = 1 , num_st_levels_input
+            zhave(l) = st_levels_input(l) / 100.
+         END DO
+
+      !  Interpolate between the layers we have (zhave) and those that we want (zs).
+
+      z_wantt : DO lwant = 1 , num_soil_layers
+         z_havet : DO lhave = 1 , num_st_levels_input -1
+            IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     tslb(i,lwant,j)= ( st_input(i,lhave,j ) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                        st_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                ( zhave(lhave+1) - zhave(lhave) )
+                  END DO
+               END DO
+               EXIT z_havet
+            END IF
+         END DO z_havet
+      END DO z_wantt
+
+      ELSE
+
+         zhave(1) = 0.
+         DO l = 1 , num_st_levels_input
+            zhave(l+1) = st_levels_input(l) / 100.
+         END DO
+         zhave(num_st_levels_input+2) = 300. / 100.
+
+      !  Interpolate between the layers we have (zhave) and those that we want (zs).
+
+      z_wantt_2 : DO lwant = 1 , num_soil_layers
+         z_havet_2 : DO lhave = 1 , num_st_levels_input +2
+            IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     tslb(i,lwant,j)= ( st_input(i,lhave,j ) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                        st_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                ( zhave(lhave+1) - zhave(lhave) )
+                  END DO
+               END DO
+               EXIT z_havet_2
+            END IF
+         END DO z_havet_2
+      END DO z_wantt_2
+
+      END IF
+
+      !  Here are the levels that we have from the input for moisture.
+
+      IF ( flag_soilm000 .EQ. 1 ) THEN
+         DO l = 1 , num_sm_levels_input
+            zhave(l) = sm_levels_input(l) / 100.
+         END DO
+
+      !  Interpolate between the layers we have (zhave) and those that we want (zs).
+
+      z_wantm : DO lwant = 1 , num_soil_layers
+         z_havem : DO lhave = 1 , num_sm_levels_input -1
+            IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     smois(i,lwant,j)= ( sm_input(i,lhave,j ) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                         sm_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                 ( zhave(lhave+1) - zhave(lhave) )
+                  END DO
+               END DO
+               EXIT z_havem
+            END IF
+         END DO z_havem
+      END DO z_wantm
+
+      ELSE
+
+         zhave(1) = 0.
+         DO l = 1 , num_sm_levels_input
+            zhave(l+1) = sm_levels_input(l) / 100.
+         END DO
+         zhave(num_sm_levels_input+2) = 300. / 100.
+
+      z_wantm_2 : DO lwant = 1 , num_soil_layers
+         z_havem_2 : DO lhave = 1 , num_sm_levels_input +2
+            IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     smois(i,lwant,j)= ( sm_input(i,lhave,j ) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                         sm_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                 ( zhave(lhave+1) - zhave(lhave) )
+                  END DO
+               END DO
+               EXIT z_havem_2
+            END IF
+         END DO z_havem_2
+      END DO z_wantm_2
+
+      END IF
+      !  Over water, put in reasonable values for soil temperature and moisture.  These won't be
+      !  used, but they will make a more continuous plot.
+
+      IF ( flag_sst .EQ. 1 ) THEN
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF ( landmask(i,j) .LT. 0.5 ) THEN
+                  DO l = 1 , num_soil_layers
+                     tslb(i,l,j) = sst(i,j)
+                     tsk(i,j)    = sst(i,j)
+                     smois(i,l,j)= 1.0
+                  END DO
+               END IF
+            END DO
+         END DO
+      ELSE
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF ( landmask(i,j) .LT. 0.5 ) THEN
+                  DO l = 1 , num_soil_layers
+                     tslb(i,l,j)= tsk(i,j)
+                     smois(i,l,j)= 1.0
+                  END DO
+               END IF
+            END DO
+         END DO
+      END IF
+
+      DEALLOCATE (zhave)
+
+   END SUBROUTINE init_soil_3_real
+
+END MODULE module_soil_pre
+
+#else
+
+MODULE module_soil_pre
+
+   USE module_date_time
+   USE module_state_description
+
+CONTAINS
+
+   SUBROUTINE adjust_for_seaice_pre ( xice , landmask , tsk , ivgtyp , vegcat , lu_index , &
+                                      xland , landusef , isltyp , soilcat , soilctop , &
+                                      soilcbot , tmn , &
+                                      seaice_threshold , &
+                                      num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                      iswater , isice , &
+                                      scheme , &
+                                      ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              iswater , isice 
+      INTEGER , INTENT(IN) :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat , scheme
+
+      REAL , DIMENSION(ims:ime,1:num_veg_cat,jms:jme) , INTENT(INOUT):: landusef
+      REAL , DIMENSION(ims:ime,1:num_soil_top_cat,jms:jme) , INTENT(INOUT):: soilctop
+      REAL , DIMENSION(ims:ime,1:num_soil_bot_cat,jms:jme) , INTENT(INOUT):: soilcbot
+      INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: isltyp , ivgtyp
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: landmask , xice , tsk , lu_index , &
+                                                           vegcat, xland , soilcat , tmn
+      REAL , INTENT(IN) :: seaice_threshold
+
+      INTEGER :: i , j , num_seaice_changes , loop
+      CHARACTER (LEN=132) :: message
+      
+      fix_seaice : SELECT CASE ( scheme ) 
+ 
+         CASE ( SLABSCHEME ) 
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( xice(i,j) .GT. 200.0 ) THEN
+                     xice(i,j) = 0.
+                     num_seaice_changes = num_seaice_changes + 1
+                  END IF
+               END DO
+            END DO
+            IF ( num_seaice_changes .GT. 0 ) THEN
+               WRITE ( message , FMT='(A,I6)' ) &
+               'Total pre number of sea ice locations removed (due to FLAG values) = ', &
+               num_seaice_changes
+               CALL wrf_debug ( 0 , message )  
+            END IF
+            num_seaice_changes = 0
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( ( xice(i,j) .GE. 0.5 ) .OR. &
+                       ( ( landmask(i,j) .LT. 0.5 ) .AND. ( tsk(i,j) .LT. seaice_threshold ) ) ) THEN
+                     xice(i,j) = 1.
+                     num_seaice_changes = num_seaice_changes + 1
+                     tmn(i,j) = 271.4
+                     vegcat(i,j)=isice
+                     lu_index(i,j)=ivgtyp(i,j)
+                     landmask(i,j)=1.
+                     xland(i,j)=1.
+                     DO loop=1,num_veg_cat
+                        landusef(i,loop,j)=0.
+                     END DO
+                     landusef(i,ivgtyp(i,j),j)=1.
+
+                     isltyp(i,j) = 16
+                     soilcat(i,j)=isltyp(i,j)
+                     DO loop=1,num_soil_top_cat
+                        soilctop(i,loop,j)=0
+                     END DO
+                     DO loop=1,num_soil_bot_cat
+                        soilcbot(i,loop,j)=0
+                     END DO
+                     soilctop(i,isltyp(i,j),j)=1.
+                     soilcbot(i,isltyp(i,j),j)=1.
+                  END IF
+               END DO
+            END DO
+            IF ( num_seaice_changes .GT. 0 ) THEN
+               WRITE ( message , FMT='(A,I6)' ) &
+               'Total pre number of sea ice location changes (water to land) = ', num_seaice_changes
+               CALL wrf_debug ( 0 , message )  
+            END IF
+
+         CASE ( LSMSCHEME ) 
+         CASE ( RUCLSMSCHEME ) 
+
+      END SELECT fix_seaice
+
+   END SUBROUTINE adjust_for_seaice_pre
+
+   SUBROUTINE adjust_for_seaice_post ( xice , landmask , tsk , ivgtyp , vegcat , lu_index , &
+                                      xland , landusef , isltyp , soilcat , soilctop , &
+                                      soilcbot , tmn , &
+                                      tslb , smois , sh2o , &
+                                      seaice_threshold , &
+                                      num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                      num_soil_layers , &
+                                      iswater , isice , &
+                                      scheme , &
+                                      ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              iswater , isice 
+      INTEGER , INTENT(IN) :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat , scheme
+      INTEGER , INTENT(IN) :: num_soil_layers
+
+      REAL , DIMENSION(ims:ime,1:num_veg_cat,jms:jme) , INTENT(INOUT):: landusef
+      REAL , DIMENSION(ims:ime,1:num_soil_top_cat,jms:jme) , INTENT(INOUT):: soilctop
+      REAL , DIMENSION(ims:ime,1:num_soil_bot_cat,jms:jme) , INTENT(INOUT):: soilcbot
+      REAL , DIMENSION(ims:ime,1:num_soil_layers,jms:jme) , INTENT(INOUT):: tslb , smois , sh2o
+      INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: isltyp , ivgtyp
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: landmask , xice , tsk , lu_index , &
+                                                           vegcat, xland , soilcat , tmn
+      REAL , INTENT(IN) :: seaice_threshold
+      REAL :: total_depth , mid_point_depth
+
+      INTEGER :: i , j , num_seaice_changes , loop
+      CHARACTER (LEN=132) :: message
+      
+      fix_seaice : SELECT CASE ( scheme ) 
+ 
+         CASE ( SLABSCHEME ) 
+
+         CASE ( LSMSCHEME ) 
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( xice(i,j) .GT. 200.0 ) THEN
+                     xice(i,j) = 0.
+                     num_seaice_changes = num_seaice_changes + 1
+                  END IF
+               END DO
+            END DO
+            IF ( num_seaice_changes .GT. 0 ) THEN
+               WRITE ( message , FMT='(A,I6)' ) &
+               'Total post number of sea ice locations removed (due to FLAG values) = ', &
+               num_seaice_changes
+               CALL wrf_debug ( 0 , message )  
+            END IF
+            num_seaice_changes = 0
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( ( xice(i,j) .GE. 0.5 ) .OR. &
+                       ( ( landmask(i,j) .LT. 0.5 ) .AND. ( tsk(i,j) .LT. seaice_threshold ) ) ) THEN
+                     xice(i,j) = 1.
+                     num_seaice_changes = num_seaice_changes + 1
+                     tmn(i,j) = 271.16
+                     vegcat(i,j)=isice
+                     lu_index(i,j)=ivgtyp(i,j)
+                     landmask(i,j)=1.
+                     xland(i,j)=1.
+                     DO loop=1,num_veg_cat
+                        landusef(i,loop,j)=0.
+                     END DO
+                     landusef(i,ivgtyp(i,j),j)=1.
+
+                     isltyp(i,j) = 16
+                     soilcat(i,j)=isltyp(i,j)
+                     DO loop=1,num_soil_top_cat
+                        soilctop(i,loop,j)=0
+                     END DO
+                     DO loop=1,num_soil_bot_cat
+                        soilcbot(i,loop,j)=0
+                     END DO
+                     soilctop(i,isltyp(i,j),j)=1.
+                     soilcbot(i,isltyp(i,j),j)=1.
+
+                     total_depth = 3. ! ice is 3 m deep, num_soil_layers equispaced layers
+                     DO loop = 1,num_soil_layers
+                        mid_point_depth=(total_depth/num_soil_layers)/2. + &
+                                        (loop-1)*(total_depth/num_soil_layers)
+                        tslb(i,loop,j) = ( (total_depth-mid_point_depth)*tsk(i,j) + &
+                                            mid_point_depth*tmn(i,j) ) / total_depth
+                     END DO
+
+                     DO loop=1,num_soil_layers
+                        smois(i,loop,j) = 1.0
+                        sh2o(i,loop,j)  = 0.0
+                     END DO
+                  END IF
+               END DO
+            END DO
+            IF ( num_seaice_changes .GT. 0 ) THEN
+               WRITE ( message , FMT='(A,I6)' ) &
+               'Total post number of sea ice location changes (water to land) = ', num_seaice_changes
+               CALL wrf_debug ( 0 , message )  
+            END IF
+
+         CASE ( RUCLSMSCHEME ) 
+
+      END SELECT fix_seaice
+
+   END SUBROUTINE adjust_for_seaice_post
+
+   SUBROUTINE process_percent_cat_new ( landmask ,  &
+                                landuse_frac , soil_top_cat , soil_bot_cat , &
+                                isltyp , ivgtyp , &
+                                num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
+                                ids , ide , jds , jde , kds , kde , &
+                                ims , ime , jms , jme , kms , kme , &
+                                its , ite , jts , jte , kts , kte , &
+                                iswater )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              iswater
+      INTEGER , INTENT(IN) :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
+      REAL , DIMENSION(ims:ime,1:num_veg_cat,jms:jme) , INTENT(INOUT):: landuse_frac
+      REAL , DIMENSION(ims:ime,1:num_soil_top_cat,jms:jme) , INTENT(IN):: soil_top_cat
+      REAL , DIMENSION(ims:ime,1:num_soil_bot_cat,jms:jme) , INTENT(IN):: soil_bot_cat
+      INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: isltyp , ivgtyp
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: landmask
+
+      INTEGER :: i , j , l , ll, dominant_index
+      REAL :: dominant_value
+
+#ifdef WRF_CHEM
+!      REAL :: lwthresh = .99
+      REAL :: lwthresh = .50
+#else
+      REAL :: lwthresh = .50
+#endif
+
+      INTEGER , PARAMETER :: iswater_soil = 14
+      INTEGER :: iforce
+      CHARACTER (LEN=132) :: message
+
+      !  Sanity check on the 50/50 points
+
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            dominant_value = landuse_frac(i,iswater,j)
+            IF ( dominant_value .EQ. lwthresh ) THEN
+               DO l = 1 , num_veg_cat
+                  IF ( l .EQ. iswater ) CYCLE
+                  IF ( landuse_frac(i,l,j) .EQ. lwthresh ) THEN
+                write(message, FMT='(I4,I4,A,I4,A,I4)') i,j,' water and category ',l,' both at 50%, landmask is ',landmask(i,j)
+                call wrf_message ( message )
+                     landuse_frac(i,l,j) = lwthresh - .01
+                     landuse_frac(i,iswater,j) = 1. - (lwthresh + 0.01)
+                  END IF
+               END DO
+            END IF
+         END DO
+      END DO
+
+      !  Compute the dominant VEGETATION INDEX.
+
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            dominant_value = landuse_frac(i,1,j)
+            dominant_index = 1
+            DO l = 2 , num_veg_cat
+               IF        ( l .EQ. iswater ) THEN
+                  ! wait a bit
+               ELSE IF ( ( l .NE. iswater ) .AND. ( landuse_frac(i,l,j) .GT. dominant_value ) ) THEN
+                  dominant_value = landuse_frac(i,l,j)
+                  dominant_index = l
+               END IF
+            END DO
+            IF ( landuse_frac(i,iswater,j) .GT. lwthresh ) THEN
+               dominant_value = landuse_frac(i,iswater,j)
+               dominant_index = iswater
+#if 0
+si needs to beef up consistency checks before we can use this part
+            ELSE IF ( ( landuse_frac(i,iswater,j) .EQ. lwthresh) .AND. &
+                      ( dominant_value .EQ. lwthresh) ) THEN
+               ! no op
+#else
+ELSEIF((landuse_frac(i,iswater,j).EQ.lwthresh).AND.(dominant_value.EQ.lwthresh).and.(dominant_index.LT.iswater))THEN
+write(message,*)'temporary SI landmask fix'
+call wrf_message(trim(message))
+! no op
+ELSEIF((landuse_frac(i,iswater,j).EQ.lwthresh).AND.(dominant_value.EQ.lwthresh).and.(dominant_index.GT.iswater))THEN
+write(message,*)'temporary SI landmask fix'
+call wrf_message(trim(message))
+dominant_value = landuse_frac(i,iswater,j)
+dominant_index = iswater
+#endif
+            ELSE IF ( ( landuse_frac(i,iswater,j) .EQ. lwthresh ) .AND. &
+                      ( dominant_value .LT. lwthresh ) ) THEN
+               dominant_value = landuse_frac(i,iswater,j)
+               dominant_index = iswater
+            END IF
+            IF      ( dominant_index .EQ. iswater ) THEN
+if(landmask(i,j).gt.lwthresh) then
+write(message,*) 'changing to water at point ',i,j
+call wrf_message(trim(message))
+write(message,*)  nint(landuse_frac(i,:,j)*100)
+call wrf_message(trim(message))
+endif
+               landmask(i,j) = 0
+            ELSE IF ( dominant_index .NE. iswater ) THEN
+if(landmask(i,j).lt.lwthresh) then
+write(message,*) 'changing to land at point ',i,j
+call wrf_message(trim(message))
+write(message,*) nint(landuse_frac(i,:,j)*100)
+call wrf_message(trim(message))
+endif
+               landmask(i,j) = 1
+            END IF
+            ivgtyp(i,j) = dominant_index
+         END DO
+      END DO
+
+      !  Compute the dominant SOIL TEXTURE INDEX, TOP.
+
+      iforce = 0
+      DO i = its , MIN(ide-1,ite)
+         DO j = jts , MIN(jde-1,jte)
+            dominant_value = soil_top_cat(i,1,j)
+            dominant_index = 1
+            IF ( landmask(i,j) .GT. lwthresh ) THEN
+               DO l = 2 , num_soil_top_cat
+                  IF ( ( l .NE. iswater_soil ) .AND. ( soil_top_cat(i,l,j) .GT. dominant_value ) ) THEN
+                     dominant_value = soil_top_cat(i,l,j)
+                     dominant_index = l
+                  END IF
+               END DO
+               IF ( dominant_value .LT. 0.01 ) THEN
+                  iforce = iforce + 1
+                  WRITE ( message , FMT = '(A,I4,I4)' ) &
+                  'based on landuse, changing soil to land at point ',i,j
+                  CALL wrf_debug(1,message)
+                  WRITE ( message , FMT = '(16(i3,1x))' ) &
+                  1, 2, 3, 4, 5, 6, 7, 8, 9, 10,11,12, 13, 14, 15, 16
+                  CALL wrf_debug(1,message)
+                  WRITE ( message , FMT = '(16(i3,1x))' ) &
+                  nint(soil_top_cat(i,:,j)*100)
+                  CALL wrf_debug(1,message)
+                  dominant_index = 8
+               END IF
+            ELSE
+               dominant_index = iswater_soil
+            END IF
+            isltyp(i,j) = dominant_index
+         END DO
+      END DO
+
+if(iforce.ne.0)then
+WRITE(message,FMT='(A,I4,A,I6)' ) &
+'forcing artificial silty clay loam at ',iforce,' points, out of ',&
+(MIN(ide-1,ite)-its+1)*(MIN(jde-1,jte)-jts+1)
+CALL wrf_debug(0,message)
+endif
+
+   END SUBROUTINE process_percent_cat_new
+
+   SUBROUTINE process_soil_real ( tsk , tmn , &
+                                landmask , sst , &
+                                st_input , sm_input , sw_input , st_levels_input , sm_levels_input , sw_levels_input , &
+                                zs , dzs , tslb , smois , sh2o , &
+                                flag_sst , flag_soilt000, flag_soilm000, &
+                                ids , ide , jds , jde , kds , kde , &
+                                ims , ime , jms , jme , kms , kme , &
+                                its , ite , jts , jte , kts , kte , &
+                                sf_surface_physics , num_soil_layers , real_data_init_type , &
+                                num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+                                num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte , &
+                              sf_surface_physics , num_soil_layers , real_data_init_type , &
+                              num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+                              num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc 
+
+      INTEGER , INTENT(IN) :: flag_sst, flag_soilt000, flag_soilm000
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
+
+      INTEGER , DIMENSION(1:num_st_levels_input) , INTENT(INOUT) :: st_levels_input
+      INTEGER , DIMENSION(1:num_sm_levels_input) , INTENT(INOUT) :: sm_levels_input
+      INTEGER , DIMENSION(1:num_sw_levels_input) , INTENT(INOUT) :: sw_levels_input
+      REAL , DIMENSION(ims:ime,1:num_st_levels_alloc,jms:jme) , INTENT(INOUT) :: st_input
+      REAL , DIMENSION(ims:ime,1:num_sm_levels_alloc,jms:jme) , INTENT(INOUT) :: sm_input
+      REAL , DIMENSION(ims:ime,1:num_sw_levels_alloc,jms:jme) , INTENT(INOUT) :: sw_input
+
+      REAL, DIMENSION(1:num_soil_layers), INTENT(OUT)  ::  zs,dzs
+      REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb , smois , sh2o
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tmn 
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tsk
+
+      INTEGER :: i , j , l , dominant_index , num_soil_cat , num_veg_cat
+      REAL :: dominant_value
+
+      !  Initialize the soil depth, and the soil temperature and moisture.
+
+      IF      ( ( sf_surface_physics .EQ. 1 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_1 ( zs , dzs , num_soil_layers )
+         CALL init_soil_1_real ( tsk , tmn , tslb , zs , dzs , num_soil_layers , real_data_init_type , &
+                                 landmask , sst , flag_sst , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      ELSE IF ( ( sf_surface_physics .EQ. 2 .or. sf_surface_physics .EQ. 99 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_2 ( zs , dzs , num_soil_layers )
+         CALL init_soil_2_real ( tsk , tmn , smois , sh2o , tslb , &
+                                 st_input , sm_input , sw_input , landmask , sst , &
+                                 zs , dzs , &
+                                 st_levels_input , sm_levels_input , sw_levels_input , &
+                                 num_soil_layers , num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+                                 num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc , &
+                                 flag_sst , flag_soilt000 , flag_soilm000 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+!        CALL init_soil_old ( tsk , tmn , &
+!                             smois , tslb , zs , dzs , num_soil_layers , &
+!                             st000010_input , st010040_input , st040100_input , st100200_input , &
+!                             st010200_input , &
+!                             sm000010_input , sm010040_input , sm040100_input , sm100200_input , &
+!                             sm010200_input , &
+!                             landmask_input , sst_input , &
+!                             ids , ide , jds , jde , kds , kde , &
+!                             ims , ime , jms , jme , kms , kme , &
+!                             its , ite , jts , jte , kts , kte )
+      ELSE IF ( ( sf_surface_physics .EQ. 3 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_3 ( zs , dzs , num_soil_layers )
+         CALL init_soil_3_real ( tsk , tmn , smois , tslb , &
+                                 st_input , sm_input , landmask , sst , &
+                                 zs , dzs , &
+                                 st_levels_input , sm_levels_input , &
+                                 num_soil_layers , num_st_levels_input , num_sm_levels_input , &
+                                 num_st_levels_alloc , num_sm_levels_alloc , &
+                                 flag_sst , flag_soilt000 , flag_soilm000 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+      END IF
+
+   END SUBROUTINE process_soil_real
+
+   SUBROUTINE process_soil_ideal ( xland,xice,vegfra,snow,canwat,  &
+                                   ivgtyp,isltyp,tslb,smois, &
+                                   tsk,tmn,zs,dzs,           &
+                                   num_soil_layers,          &
+                                   sf_surface_physics ,      &
+                                   ids,ide, jds,jde, kds,kde,&
+                                   ims,ime, jms,jme, kms,kme,&
+                                   its,ite, jts,jte, kts,kte )
+
+      IMPLICIT NONE
+
+      INTEGER, INTENT(IN) ::ids,ide, jds,jde, kds,kde,  &
+                            ims,ime, jms,jme, kms,kme,  &
+                            its,ite, jts,jte, kts,kte
+  
+      INTEGER, INTENT(IN) :: num_soil_layers , sf_surface_physics
+
+      REAL, DIMENSION( ims:ime, num_soil_layers, jms:jme ) , INTENT(INOUT) :: smois, tslb
+
+      REAL, DIMENSION(num_soil_layers), INTENT(OUT) :: dzs,zs
+
+      REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT) :: tsk, tmn
+      REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT) :: xland, snow, canwat, xice, vegfra
+      INTEGER, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT) :: ivgtyp, isltyp
+
+      !  Local variables.
+
+      INTEGER :: itf,jtf
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+
+      IF      ( ( sf_surface_physics .EQ. 1 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_1 ( zs , dzs , num_soil_layers )
+         CALL init_soil_1_ideal(tsk,tmn,tslb,xland,                      &
+                                ivgtyp,zs,dzs,num_soil_layers,           &
+                                ids,ide, jds,jde, kds,kde,               &
+                                ims,ime, jms,jme, kms,kme,               &
+                                its,ite, jts,jte, kts,kte                )
+      ELSE IF ( ( sf_surface_physics .EQ. 2 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_2 ( zs , dzs , num_soil_layers )
+         CALL init_soil_2_ideal ( xland,xice,vegfra,snow,canwat,         &
+                                  ivgtyp,isltyp,tslb,smois,tmn,          &
+                                  num_soil_layers,                       &
+                                  ids,ide, jds,jde, kds,kde,             &
+                                  ims,ime, jms,jme, kms,kme,             &
+                                  its,ite, jts,jte, kts,kte              )
+      ELSE IF ( ( sf_surface_physics .EQ. 3 ) .AND. ( num_soil_layers .GT. 1 ) ) THEN
+         CALL init_soil_depth_3 ( zs , dzs , num_soil_layers )
+
+      END IF
+
+   END SUBROUTINE process_soil_ideal
+
+   SUBROUTINE adjust_soil_temp_new ( tmn , sf_surface_physics , &
+                                 tsk , ter , toposoil , landmask , flag_toposoil , &
+                                      st000010 ,      st010040 ,      st040100 ,      st100200 ,      st010200 , &
+                                 flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , & 
+                                      soilt000 ,      soilt005 ,      soilt020 ,      soilt040 ,      soilt160 ,      soilt300 , &
+                                 flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , flag_soilt160 , flag_soilt300 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+   
+      INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte 
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN)    :: ter , toposoil , landmask
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tmn , tsk
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: st000010 , st010040 , st040100 , st100200 , st010200
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: soilt000 , soilt005 , soilt020 , soilt040 , soilt160 , soilt300
+
+      INTEGER , INTENT(IN) :: flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200
+      INTEGER , INTENT(IN) :: flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , flag_soilt160 , flag_soilt300
+      INTEGER , INTENT(IN) :: sf_surface_physics , flag_toposoil
+ 
+      INTEGER :: i , j
+
+      REAL :: soil_elev_min_val ,  soil_elev_max_val , soil_elev_min_dif , soil_elev_max_dif
+
+      !  Do we have a soil field with which to modify soil temperatures?
+
+      IF ( flag_toposoil .EQ. 1 ) THEN
+
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+
+               !  Is the toposoil field OK, or is it a subversive soil elevation field.  We can tell
+               !  usually by looking at values.  Anything less than -1000 m (lower than the Dead Sea) is
+               !  bad.  Anything larger than 10 km (taller than Everest) is toast.  Also, anything where 
+               !  the difference between the soil elevation and the terrain is greater than 3 km means
+               !  that the soil data is either all zeros or that the data are inconsistent.  Any of these
+               !  three conditions is grievous enough to induce a WRF fatality.  However, if they are at
+               !  a water point, then we can safely ignore them.
+         
+               soil_elev_min_val = toposoil(i,j) 
+               soil_elev_max_val = toposoil(i,j) 
+               soil_elev_min_dif = ter(i,j) - toposoil(i,j)
+               soil_elev_max_dif = ter(i,j) - toposoil(i,j)
+         
+               IF      ( ( soil_elev_min_val .LT. -1000 ) .AND. ( landmask(i,j) .LT. 0.5 ) ) THEN
+                  CYCLE
+               ELSE IF ( ( soil_elev_min_val .LT. -1000 ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
+!print *,'no soil temperature elevation adjustment, soil height too small = ',toposoil(i,j)
+cycle
+!                 CALL wrf_error_fatal ( 'TOPOSOIL values have large negative values < -1000 m, unrealistic.' )
+               ENDIF
+         
+               IF      ( ( soil_elev_max_val .GT. 10000 ) .AND. ( landmask(i,j) .LT. 0.5 ) ) THEN
+                  CYCLE
+               ELSE IF ( ( soil_elev_max_val .GT. 10000 ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
+print *,'no soil temperature elevation adjustment, soil height too high = ',toposoil(i,j)
+cycle
+                  CALL wrf_error_fatal ( 'TOPOSOIL values have large positive values > 10,000 m , unrealistic.' )
+               ENDIF
+         
+               IF      ( ( ( soil_elev_min_dif .LT. -3000 ) .OR. ( soil_elev_max_dif .GT. 3000 ) ) .AND. &
+                           ( landmask(i,j) .LT. 0.5 ) ) THEN
+                  CYCLE
+               ELSE IF ( ( ( soil_elev_min_dif .LT. -3000 ) .OR. ( soil_elev_max_dif .GT. 3000 ) ) .AND. &
+                           ( landmask(i,j) .GT. 0.5 ) ) THEN
+print *,'no soil temperature elevation adjustment, diff of soil height and terrain = ',ter(i,j) - toposoil(i,j)
+cycle
+                  CALL wrf_error_fatal ( 'TOPOSOIL difference with terrain elevation differs by more than 3000 m, unrealistic' )
+               ENDIF
+
+               !  For each of the fields that we would like to modify, check to see if it came in from the SI.
+               !  If so, then use a -6.5 K/km lapse rate (based on the elevation diffs).  We only adjust when we
+               !  are not at a water point.
+
+               IF (landmask(i,j) .GT. 0.5 ) THEN
+   
+                  IF ( sf_surface_physics .EQ. 1 ) THEN
+                     tmn(i,j) = tmn(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  
+                  tsk(i,j) = tsk(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+      
+                  IF ( flag_st000010 .EQ. 1 ) THEN
+                     st000010(i,j) = st000010(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st010040 .EQ. 1 ) THEN
+                     st010040(i,j) = st010040(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st040100 .EQ. 1 ) THEN
+                     st040100(i,j) = st040100(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st100200 .EQ. 1 ) THEN
+                     st100200(i,j) = st100200(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_st010200 .EQ. 1 ) THEN
+                     st010200(i,j) = st010200(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+      
+                  IF ( flag_soilt000 .EQ. 1 ) THEN
+                     soilt000(i,j) = soilt000(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt005 .EQ. 1 ) THEN
+                     soilt005(i,j) = soilt005(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt020 .EQ. 1 ) THEN
+                     soilt020(i,j) = soilt020(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt040 .EQ. 1 ) THEN
+                     soilt040(i,j) = soilt040(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt160 .EQ. 1 ) THEN
+                     soilt160(i,j) = soilt160(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+                  IF ( flag_soilt300 .EQ. 1 ) THEN
+                     soilt300(i,j) = soilt300(i,j) - 0.0065 * ( ter(i,j) - toposoil(i,j) )
+                  END IF
+   
+               END IF
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE adjust_soil_temp_new
+
+
+   SUBROUTINE init_soil_depth_1 ( zs , dzs , num_soil_layers )
+
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN) :: num_soil_layers
+   
+      REAL, DIMENSION(1:num_soil_layers), INTENT(OUT)  ::  zs,dzs
+   
+      INTEGER                   ::      l
+
+      CHARACTER (LEN=132) :: message
+
+      !  Define layers (top layer = 0.01 m).  Double the thicknesses at each step (dzs values).
+      !  The distance from the ground level to the midpoint of the layer is given by zs.
+
+      !    -------   Ground Level   ----------      ||      ||   ||  || 
+      !                                             ||      ||   ||  || zs(1) = 0.005 m
+      !    --  --  --  --  --  --  --  --  --       ||      ||   ||  \/
+      !                                             ||      ||   ||
+      !    -----------------------------------      ||  ||  ||   \/   dzs(1) = 0.01 m
+      !                                             ||  ||  || 
+      !                                             ||  ||  || zs(2) = 0.02
+      !    --  --  --  --  --  --  --  --  --       ||  ||  \/
+      !                                             ||  ||
+      !                                             ||  ||
+      !    -----------------------------------  ||  ||  \/   dzs(2) = 0.02 m
+      !                                         ||  || 
+      !                                         ||  ||
+      !                                         ||  || 
+      !                                         ||  || zs(3) = 0.05
+      !    --  --  --  --  --  --  --  --  --   ||  \/
+      !                                         ||
+      !                                         ||
+      !                                         ||
+      !                                         ||
+      !    -----------------------------------  \/   dzs(3) = 0.04 m
+
+      IF ( num_soil_layers .NE. 5 ) THEN
+         write(message,FMT= '(A)') 'Usually, the 5-layer diffusion uses 5 layers.  Change this in the namelist.'
+         CALL wrf_error_fatal ( message )
+      END IF
+   
+      dzs(1)=.01
+      zs(1)=.5*dzs(1)
+   
+      DO l=2,num_soil_layers
+         dzs(l)=2*dzs(l-1)
+         zs(l)=zs(l-1)+.5*dzs(l-1)+.5*dzs(l)
+      ENDDO
+
+   END SUBROUTINE init_soil_depth_1
+
+   SUBROUTINE init_soil_depth_2 ( zs , dzs , num_soil_layers )
+
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN) :: num_soil_layers
+   
+      REAL, DIMENSION(1:num_soil_layers), INTENT(OUT)  ::  zs,dzs
+   
+      INTEGER                   ::      l
+
+      CHARACTER (LEN=132) :: message
+
+      dzs = (/ 0.1 , 0.3 , 0.6 , 1.0 /)
+
+      IF ( num_soil_layers .NE. 4 ) THEN
+         write(message,FMT='(A)') 'Usually, the LSM uses 4 layers.  Change this in the namelist.'
+         CALL wrf_error_fatal ( message )
+      END IF
+
+      zs(1)=.5*dzs(1)
+   
+      DO l=2,num_soil_layers
+         zs(l)=zs(l-1)+.5*dzs(l-1)+.5*dzs(l)
+      ENDDO
+
+   END SUBROUTINE init_soil_depth_2
+
+   SUBROUTINE init_soil_depth_3 ( zs , dzs , num_soil_layers )
+
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN) :: num_soil_layers
+   
+      REAL, DIMENSION(1:num_soil_layers), INTENT(OUT)  ::  zs,dzs
+   
+      INTEGER                   ::      l
+
+      CHARACTER (LEN=132) :: message
+
+! in RUC LSM ZS - soil levels, and DZS - soil layer thicknesses, not used
+! ZS is specified in the namelist: num_soil_layers = 6 or 9.
+! Other options with number of levels are possible, but
+! WRF users should change consistently the namelist entry with the
+!    ZS array in this subroutine.
+
+     IF ( num_soil_layers .EQ. 6) THEN
+      zs  = (/ 0.00 , 0.05 , 0.20 , 0.40 , 1.60 , 3.00 /)
+!      dzs = (/ 0.00 , 0.125, 0.175 , 0.70 , 1.30 , 1.40 /)
+     ELSEIF ( num_soil_layers .EQ. 9) THEN
+      zs  = (/ 0.00 , 0.05 , 0.20 , 0.40 , 0.60, 1.00, 1.60 , 2.20, 3.00 /)
+!      dzs = (/ 0.00 , 0.125, 0.175 , 0.70 , 1.30 , 1.40 /)
+     ENDIF
+
+      IF ( num_soil_layers .EQ. 4 .OR. num_soil_layers .EQ. 5 ) THEN
+         WRITE(message,FMT= '(A)')'Usually, the RUC LSM uses 6, 9 or more levels.  Change this in the namelist.'
+         CALL wrf_error_fatal ( message )
+      END IF
+
+   END SUBROUTINE init_soil_depth_3
+
+   SUBROUTINE init_soil_1_real ( tsk , tmn , tslb , zs , dzs , &
+                                 num_soil_layers , real_data_init_type , &
+                                 landmask , sst , flag_sst , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: num_soil_layers , real_data_init_type , &
+                              ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte 
+
+      INTEGER , INTENT(IN) :: flag_sst
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tsk , tmn
+
+      REAL , DIMENSION(num_soil_layers) :: zs , dzs
+
+      REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb
+
+      INTEGER :: i , j , l
+
+      !  Soil temperature is linearly interpolated between the skin temperature (taken to be at a
+      !  depth of 0.5 cm) and the deep soil, annual temperature (taken to be at a depth of 23 cm).
+      !  The tslb(i,1,j) is the skin temperature, and the tslb(i,num_soil_layers,j) level is the 
+      !  annual mean temperature.
+
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            IF ( landmask(i,j) .GT. 0.5 ) THEN
+               DO l = 1 , num_soil_layers
+                  tslb(i,l,j)= ( tsk(i,j) * ( zs(num_soil_layers) - zs(l) )   + &
+                                 tmn(i,j) * ( zs(              l) - zs(1) ) ) / &
+                                            ( zs(num_soil_layers) - zs(1) )
+               END DO
+            ELSE
+               IF ( ( real_data_init_type .EQ. 1 ) .AND. ( flag_sst .EQ. 1 ) ) THEN
+                  DO l = 1 , num_soil_layers
+                     tslb(i,l,j)= sst(i,j)
+                  END DO
+               ELSE
+                  DO l = 1 , num_soil_layers
+                     tslb(i,l,j)= tsk(i,j)
+                  END DO
+               END IF
+            END IF
+         END DO
+      END DO
+
+   END SUBROUTINE init_soil_1_real
+
+   SUBROUTINE init_soil_1_ideal(tsk,tmn,tslb,xland,             &
+                       ivgtyp,ZS,DZS,num_soil_layers,           &
+                       ids,ide, jds,jde, kds,kde,               &
+                       ims,ime, jms,jme, kms,kme,               &
+                       its,ite, jts,jte, kts,kte                )
+
+      IMPLICIT NONE
+   
+      INTEGER, INTENT(IN   )    ::      ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+   
+      INTEGER, INTENT(IN   )    ::      num_soil_layers
+   
+      REAL, DIMENSION( ims:ime , 1 , jms:jme ), INTENT(OUT) :: tslb
+      REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: xland
+      INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: ivgtyp
+   
+      REAL, DIMENSION(1:), INTENT(IN) :: dzs,zs
+   
+      REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(IN) :: tsk, tmn
+
+      !  Lcal variables.
+   
+      INTEGER :: l,j,i,itf,jtf
+   
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+   
+      IF (num_soil_layers.NE.1)THEN
+         DO j=jts,jtf
+            DO l=1,num_soil_layers
+               DO i=its,itf
+                 tslb(i,l,j)=( tsk(i,j)*(zs(num_soil_layers)-zs(l)) + tmn(i,j)*(zs(l)-zs(1)) ) / &
+                             ( zs(num_soil_layers)-zs(1) )
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+      DO j=jts,jtf
+         DO i=its,itf
+           xland(i,j)  = 2
+           ivgtyp(i,j) = 7
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE init_soil_1_ideal
+
+   SUBROUTINE init_soil_2_real ( tsk , tmn , smois , sh2o , tslb , &
+                                 st_input , sm_input , sw_input , landmask , sst , &
+                                 zs , dzs , &
+                                 st_levels_input , sm_levels_input , sw_levels_input , &
+                                 num_soil_layers , num_st_levels_input , num_sm_levels_input ,  num_sw_levels_input , &
+                                 num_st_levels_alloc , num_sm_levels_alloc ,  num_sw_levels_alloc , &
+                                 flag_sst , flag_soilt000 , flag_soilmt000 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: num_soil_layers , &
+                              num_st_levels_input , num_sm_levels_input , num_sw_levels_input , &
+                              num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc , &
+                              ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte 
+
+      INTEGER , INTENT(IN) :: flag_sst, flag_soilt000, flag_soilmt000
+
+      INTEGER , DIMENSION(1:num_st_levels_input) , INTENT(INOUT) :: st_levels_input
+      INTEGER , DIMENSION(1:num_sm_levels_input) , INTENT(INOUT) :: sm_levels_input
+      INTEGER , DIMENSION(1:num_sw_levels_input) , INTENT(INOUT) :: sw_levels_input
+
+      REAL , DIMENSION(ims:ime,1:num_st_levels_alloc,jms:jme) , INTENT(INOUT) :: st_input
+      REAL , DIMENSION(ims:ime,1:num_sm_levels_alloc,jms:jme) , INTENT(INOUT) :: sm_input
+      REAL , DIMENSION(ims:ime,1:num_sw_levels_alloc,jms:jme) , INTENT(INOUT) :: sw_input
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tmn
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tsk
+      REAL , DIMENSION(num_soil_layers) :: zs , dzs
+
+      REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb , smois , sh2o
+
+      REAL , ALLOCATABLE , DIMENSION(:) :: zhave
+
+      INTEGER :: i , j , l , lout , lin , lwant , lhave , num
+      REAL :: temp
+      LOGICAL :: found_levels
+
+      !  Are there any soil temp and moisture levels - ya know, they are mandatory.
+
+      num = num_st_levels_input * num_sm_levels_input
+
+      IF ( num .GE. 1 ) THEN
+
+         !  Ordered levels that we have data for.
+
+         ALLOCATE ( zhave( MAX(num_st_levels_input,num_sm_levels_input,num_sw_levels_input) +2) )
+
+         !  Sort the levels for temperature.
+   
+         outert : DO lout = 1 , num_st_levels_input-1
+            innert : DO lin = lout+1 , num_st_levels_input
+               IF ( st_levels_input(lout) .GT. st_levels_input(lin) ) THEN
+                  temp = st_levels_input(lout) 
+                  st_levels_input(lout) = st_levels_input(lin)
+                  st_levels_input(lin) = NINT(temp)
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        temp = st_input(i,lout+1,j)
+                        st_input(i,lout+1,j) = st_input(i,lin+1,j)
+                        st_input(i,lin+1,j) = temp
+                     END DO
+                  END DO
+               END IF
+            END DO innert
+         END DO outert
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               st_input(i,1,j) = tsk(i,j)
+               st_input(i,num_st_levels_input+2,j) = tmn(i,j)
+            END DO
+         END DO
+
+
+#if ( NMM_CORE == 1 )
+!new
+!       write(0,*) 'st_input(1) in init_soil_2_real'
+	DO J=MIN(jde-1,jte),JTS, -MIN(jde-1,jte)/15
+!       write(0,616) (st_input(I,1,J),I=its , MIN(ide-1,ite),MIN(ide-1,ite)/10)
+	ENDDO
+
+!       write(0,*) 'st_input(2) in init_soil_2_real'
+	DO J=MIN(jde-1,jte),JTS, -MIN(jde-1,jte)/15
+!       write(0,616) (st_input(I,2,J),I=its , MIN(ide-1,ite),MIN(ide-1,ite)/10)
+	ENDDO
+
+  616	format(20(f4.0,1x))
+#endif
+   
+         !  Sort the levels for moisture.
+   
+         outerm: DO lout = 1 , num_sm_levels_input-1
+            innerm : DO lin = lout+1 , num_sm_levels_input
+               IF ( sm_levels_input(lout) .GT. sm_levels_input(lin) ) THEN
+                  temp = sm_levels_input(lout) 
+                  sm_levels_input(lout) = sm_levels_input(lin)
+                  sm_levels_input(lin) = NINT(temp)
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        temp = sm_input(i,lout+1,j)
+                        sm_input(i,lout+1,j) = sm_input(i,lin+1,j)
+                        sm_input(i,lin+1,j) = temp
+                     END DO
+                  END DO
+               END IF
+            END DO innerm
+         END DO outerm
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               sm_input(i,1,j) = sm_input(i,2,j)
+               sm_input(i,num_sm_levels_input+2,j) = sm_input(i,num_sm_levels_input+1,j)
+            END DO
+         END DO
+   
+         !  Sort the levels for liquid moisture.
+   
+         outerw: DO lout = 1 , num_sw_levels_input-1
+            innerw : DO lin = lout+1 , num_sw_levels_input
+               IF ( sw_levels_input(lout) .GT. sw_levels_input(lin) ) THEN
+                  temp = sw_levels_input(lout) 
+                  sw_levels_input(lout) = sw_levels_input(lin)
+                  sw_levels_input(lin) = NINT(temp)
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        temp = sw_input(i,lout+1,j)
+                        sw_input(i,lout+1,j) = sw_input(i,lin+1,j)
+                        sw_input(i,lin+1,j) = temp
+                     END DO
+                  END DO
+               END IF
+            END DO innerw
+         END DO outerw
+         IF ( num_sw_levels_input .GT. 1 ) THEN
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  sw_input(i,1,j) = sw_input(i,2,j)
+                  sw_input(i,num_sw_levels_input+2,j) = sw_input(i,num_sw_levels_input+1,j)
+               END DO
+            END DO
+         END IF
+
+         found_levels = .TRUE.
+
+      ELSE IF ( ( num .LE. 0 ) .AND. (  start_date .NE. current_date ) ) THEN
+
+         found_levels = .FALSE.
+
+      ELSE
+         CALL wrf_error_fatal ( &
+         'No input soil level data (temperature, moisture or liquid, or all are missing). Required for LSM.' )
+      END IF
+
+      !  Is it OK to continue?
+
+      IF ( found_levels ) THEN
+
+         !  Here are the levels that we have from the input for temperature.  The input levels plus
+         !  two more: the skin temperature at 0 cm, and the annual mean temperature at 300 cm.
+
+         zhave(1) = 0.
+         DO l = 1 , num_st_levels_input
+            zhave(l+1) = st_levels_input(l) / 100.
+         END DO
+         zhave(num_st_levels_input+2) = 300. / 100.
+   
+         !  Interpolate between the layers we have (zhave) and those that we want (zs).
+   
+         z_wantt : DO lwant = 1 , num_soil_layers
+            z_havet : DO lhave = 1 , num_st_levels_input +2 -1
+               IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                    ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        tslb(i,lwant,j)= ( st_input(i,lhave  ,j) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                           st_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                   ( zhave(lhave+1) - zhave(lhave) )
+                     END DO
+                  END DO
+                  EXIT z_havet
+               END IF
+            END DO z_havet
+         END DO z_wantt
+
+         !  Here are the levels that we have from the input for moisture.  The input levels plus
+         !  two more: a value at 0 cm and one at 300 cm.  The 0 cm value is taken to be identical
+         !  to the most shallow layer's value.  Similarly, the 300 cm value is taken to be the same
+         !  as the most deep layer's value.
+   
+         zhave(1) = 0.
+         DO l = 1 , num_sm_levels_input
+            zhave(l+1) = sm_levels_input(l) / 100.
+         END DO
+         zhave(num_sm_levels_input+2) = 300. / 100.
+   
+         !  Interpolate between the layers we have (zhave) and those that we want (zs).
+   
+         z_wantm : DO lwant = 1 , num_soil_layers
+            z_havem : DO lhave = 1 , num_sm_levels_input +2 -1
+               IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                    ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+                  DO j = jts , MIN(jde-1,jte)
+                     DO i = its , MIN(ide-1,ite)
+                        smois(i,lwant,j)= ( sm_input(i,lhave  ,j) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                            sm_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                    ( zhave(lhave+1) - zhave(lhave) )
+                     END DO
+                  END DO
+                  EXIT z_havem
+               END IF
+            END DO z_havem
+         END DO z_wantm
+   
+         !  Any liquid soil moisture to worry about?
+   
+         IF ( num_sw_levels_input .GT. 1 ) THEN
+   
+            zhave(1) = 0.
+            DO l = 1 , num_sw_levels_input
+               zhave(l+1) = sw_levels_input(l) / 100.
+            END DO
+            zhave(num_sw_levels_input+2) = 300. / 100.
+      
+            !  Interpolate between the layers we have (zhave) and those that we want (zs).
+      
+            z_wantw : DO lwant = 1 , num_soil_layers
+               z_havew : DO lhave = 1 , num_sw_levels_input +2 -1
+                  IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                       ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+                     DO j = jts , MIN(jde-1,jte)
+                        DO i = its , MIN(ide-1,ite)
+                           sh2o(i,lwant,j)= ( sw_input(i,lhave  ,j) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                               sw_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                       ( zhave(lhave+1) - zhave(lhave) )
+                        END DO
+                     END DO
+                     EXIT z_havew
+                  END IF
+               END DO z_havew
+            END DO z_wantw
+   
+         END IF
+   
+   
+         !  Over water, put in reasonable values for soil temperature and moisture.  These won't be
+         !  used, but they will make a more continuous plot.
+   
+         IF ( flag_sst .EQ. 1 ) THEN
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( landmask(i,j) .LT. 0.5 ) THEN
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)= sst(i,j)
+                        smois(i,l,j)= 1.0
+                        sh2o (i,l,j)= 1.0
+                     END DO
+                  END IF
+               END DO
+            END DO
+         ELSE
+            DO j = jts , MIN(jde-1,jte)
+               DO i = its , MIN(ide-1,ite)
+                  IF ( landmask(i,j) .LT. 0.5 ) THEN
+                     DO l = 1 , num_soil_layers
+                        tslb(i,l,j)= tsk(i,j)
+                        smois(i,l,j)= 1.0
+                        sh2o (i,l,j)= 1.0
+                     END DO
+                  END IF
+               END DO
+            END DO
+         END IF
+   
+         DEALLOCATE (zhave)
+
+      END IF
+
+   END SUBROUTINE init_soil_2_real
+
+   SUBROUTINE init_soil_2_ideal ( xland,xice,vegfra,snow,canwat,     &
+                     ivgtyp,isltyp,tslb,smois,tmn,                  &
+                     num_soil_layers,                               &
+                     ids,ide, jds,jde, kds,kde,                     &
+                     ims,ime, jms,jme, kms,kme,                     &
+                     its,ite, jts,jte, kts,kte                      )
+
+      IMPLICIT NONE 
+   
+      INTEGER, INTENT(IN) ::ids,ide, jds,jde, kds,kde,  &
+                            ims,ime, jms,jme, kms,kme,  &
+                            its,ite, jts,jte, kts,kte
+   
+      INTEGER, INTENT(IN) ::num_soil_layers
+   
+      REAL, DIMENSION( ims:ime, num_soil_layers, jms:jme ) , INTENT(OUT) :: smois, tslb 
+   
+      REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT)  :: xland, snow, canwat, xice, vegfra, tmn
+   
+      INTEGER, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT) :: ivgtyp, isltyp
+   
+      INTEGER :: icm,jcm,itf,jtf
+      INTEGER ::  i,j,l
+   
+      itf=min0(ite,ide-1)
+      jtf=min0(jte,jde-1)
+   
+      icm = ide/2
+      jcm = jde/2
+   
+      DO j=jts,jtf
+         DO l=1,num_soil_layers
+            DO i=its,itf
+   
+               smois(i,1,j)=0.10
+               smois(i,2,j)=0.10
+               smois(i,3,j)=0.10
+               smois(i,4,j)=0.10
+      
+               tslb(i,1,j)=295.           
+               tslb(i,2,j)=297.          
+               tslb(i,3,j)=293.         
+               tslb(i,4,j)=293. 
+
+            ENDDO
+         ENDDO
+      ENDDO                                 
+
+      DO j=jts,jtf
+         DO i=its,itf
+            xland(i,j)  =   2
+            tmn(i,j)    = 294. 
+            xice(i,j)   =   0.
+            vegfra(i,j) =   0. 
+            snow(i,j)   =   0.
+            canwat(i,j) =   0.
+            ivgtyp(i,j) =   7
+            isltyp(i,j) =   8
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE init_soil_2_ideal
+
+   SUBROUTINE init_soil_3_real ( tsk , tmn , smois , tslb , &
+                                 st_input , sm_input , landmask, sst, &
+                                 zs , dzs , &
+                                 st_levels_input , sm_levels_input , &
+                                 num_soil_layers , num_st_levels_input , num_sm_levels_input ,  &
+                                 num_st_levels_alloc , num_sm_levels_alloc , &
+                                 flag_sst , flag_soilt000 , flag_soilm000 , &
+                                 ids , ide , jds , jde , kds , kde , &
+                                 ims , ime , jms , jme , kms , kme , &
+                                 its , ite , jts , jte , kts , kte )
+
+      IMPLICIT NONE
+
+      INTEGER , INTENT(IN) :: num_soil_layers , &
+                              num_st_levels_input , num_sm_levels_input , &
+                              num_st_levels_alloc , num_sm_levels_alloc , &
+                              ids , ide , jds , jde , kds , kde , &
+                              ims , ime , jms , jme , kms , kme , &
+                              its , ite , jts , jte , kts , kte
+
+      INTEGER , INTENT(IN) :: flag_sst, flag_soilt000, flag_soilm000
+
+      INTEGER , DIMENSION(1:num_st_levels_input) , INTENT(INOUT) :: st_levels_input
+      INTEGER , DIMENSION(1:num_sm_levels_input) , INTENT(INOUT) :: sm_levels_input
+
+      REAL , DIMENSION(ims:ime,1:num_st_levels_alloc,jms:jme) , INTENT(INOUT) :: st_input
+      REAL , DIMENSION(ims:ime,1:num_sm_levels_alloc,jms:jme) , INTENT(INOUT) :: sm_input
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
+
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tmn
+      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tsk
+      REAL , DIMENSION(num_soil_layers) :: zs , dzs
+
+      REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb , smois
+
+      REAL , ALLOCATABLE , DIMENSION(:) :: zhave
+
+      INTEGER :: i , j , l , lout , lin , lwant , lhave
+      REAL :: temp
+
+      !  Allocate the soil layer array used for interpolating.
+
+      IF ( ( num_st_levels_input .LE. 0 ) .OR. & 
+           ( num_sm_levels_input .LE. 0 ) ) THEN
+         PRINT '(A)','No input soil level data (either temperature or moisture, or both are missing).  Required for RUC LSM.'
+         CALL wrf_error_fatal ( 'no soil data' )
+      ELSE
+         IF ( flag_soilt000 .eq. 1 ) THEN
+           PRINT '(A)',' Assume RUC LSM 6-level input'
+           ALLOCATE ( zhave( MAX(num_st_levels_input,num_sm_levels_input)  ) )
+         ELSE
+           PRINT '(A)',' Assume non-RUC LSM input'
+           ALLOCATE ( zhave( MAX(num_st_levels_input,num_soil_layers)  ) )
+         END IF
+      END IF
+
+      !  Sort the levels for temperature.
+
+      outert : DO lout = 1 , num_st_levels_input-1
+         innert : DO lin = lout+1 , num_st_levels_input
+            IF ( st_levels_input(lout) .GT. st_levels_input(lin) ) THEN
+               temp = st_levels_input(lout) 
+               st_levels_input(lout) = st_levels_input(lin)
+               st_levels_input(lin) = NINT(temp)
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     temp = st_input(i,lout,j)
+                     st_input(i,lout,j) = st_input(i,lin,j)
+                     st_input(i,lin,j) = temp
+                  END DO
+               END DO
+            END IF
+         END DO innert
+      END DO outert
+
+      IF ( flag_soilt000 .NE. 1 ) THEN
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            st_input(i,1,j) = tsk(i,j)
+            st_input(i,num_st_levels_input+2,j) = tmn(i,j)
+         END DO
+      END DO
+      END IF
+
+      !  Sort the levels for moisture.
+
+      outerm: DO lout = 1 , num_sm_levels_input-1
+         innerm : DO lin = lout+1 , num_sm_levels_input
+            IF ( sm_levels_input(lout) .GT. sm_levels_input(lin) ) THEN
+               temp = sm_levels_input(lout) 
+               sm_levels_input(lout) = sm_levels_input(lin)
+               sm_levels_input(lin) = NINT(temp)
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     temp = sm_input(i,lout,j)
+                     sm_input(i,lout,j) = sm_input(i,lin,j)
+                     sm_input(i,lin,j) = temp
+                  END DO
+               END DO
+            END IF
+         END DO innerm
+      END DO outerm
+
+      IF ( flag_soilm000 .NE. 1 ) THEN
+      DO j = jts , MIN(jde-1,jte)
+         DO i = its , MIN(ide-1,ite)
+            sm_input(i,1,j) = sm_input(i,2,j)
+            sm_input(i,num_sm_levels_input+2,j) = sm_input(i,num_sm_levels_input+1,j)
+         END DO
+      END DO
+      END IF
+
+      !  Here are the levels that we have from the input for temperature.
+
+      IF ( flag_soilt000 .EQ. 1 ) THEN
+         DO l = 1 , num_st_levels_input
+            zhave(l) = st_levels_input(l) / 100.
+         END DO
+
+      !  Interpolate between the layers we have (zhave) and those that we want (zs).
+
+      z_wantt : DO lwant = 1 , num_soil_layers
+         z_havet : DO lhave = 1 , num_st_levels_input -1
+            IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     tslb(i,lwant,j)= ( st_input(i,lhave,j ) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                        st_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                ( zhave(lhave+1) - zhave(lhave) )
+                  END DO
+               END DO
+               EXIT z_havet
+            END IF
+         END DO z_havet
+      END DO z_wantt
+
+      ELSE
+
+         zhave(1) = 0.
+         DO l = 1 , num_st_levels_input
+            zhave(l+1) = st_levels_input(l) / 100.
+         END DO
+         zhave(num_st_levels_input+2) = 300. / 100.
+
+      !  Interpolate between the layers we have (zhave) and those that we want (zs).
+
+      z_wantt_2 : DO lwant = 1 , num_soil_layers
+         z_havet_2 : DO lhave = 1 , num_st_levels_input +2
+            IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     tslb(i,lwant,j)= ( st_input(i,lhave,j ) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                        st_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                ( zhave(lhave+1) - zhave(lhave) )
+                  END DO
+               END DO
+               EXIT z_havet_2
+            END IF
+         END DO z_havet_2
+      END DO z_wantt_2
+
+      END IF
+
+      !  Here are the levels that we have from the input for moisture.
+
+      IF ( flag_soilm000 .EQ. 1 ) THEN
+         DO l = 1 , num_sm_levels_input
+            zhave(l) = sm_levels_input(l) / 100.
+         END DO
+
+      !  Interpolate between the layers we have (zhave) and those that we want (zs).
+
+      z_wantm : DO lwant = 1 , num_soil_layers
+         z_havem : DO lhave = 1 , num_sm_levels_input -1
+            IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     smois(i,lwant,j)= ( sm_input(i,lhave,j ) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                         sm_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                 ( zhave(lhave+1) - zhave(lhave) )
+                  END DO
+               END DO
+               EXIT z_havem
+            END IF
+         END DO z_havem
+      END DO z_wantm
+
+      ELSE
+
+         zhave(1) = 0.
+         DO l = 1 , num_sm_levels_input
+            zhave(l+1) = sm_levels_input(l) / 100.
+         END DO
+         zhave(num_sm_levels_input+2) = 300. / 100.
+
+      z_wantm_2 : DO lwant = 1 , num_soil_layers
+         z_havem_2 : DO lhave = 1 , num_sm_levels_input +2
+            IF ( ( zs(lwant) .GE. zhave(lhave  ) ) .AND. &
+                 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
+               DO j = jts , MIN(jde-1,jte)
+                  DO i = its , MIN(ide-1,ite)
+                     smois(i,lwant,j)= ( sm_input(i,lhave,j ) * ( zhave(lhave+1) - zs   (lwant) ) + &
+                                         sm_input(i,lhave+1,j) * ( zs   (lwant  ) - zhave(lhave) ) ) / &
+                                                                 ( zhave(lhave+1) - zhave(lhave) )
+                  END DO
+               END DO
+               EXIT z_havem_2
+            END IF
+         END DO z_havem_2
+      END DO z_wantm_2
+
+      END IF
+      !  Over water, put in reasonable values for soil temperature and moisture.  These won't be
+      !  used, but they will make a more continuous plot.
+
+      IF ( flag_sst .EQ. 1 ) THEN
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF ( landmask(i,j) .LT. 0.5 ) THEN
+                  DO l = 1 , num_soil_layers
+                     tslb(i,l,j) = sst(i,j)
+                     tsk(i,j)    = sst(i,j)
+                     smois(i,l,j)= 1.0
+                  END DO
+               END IF
+            END DO
+         END DO
+      ELSE
+         DO j = jts , MIN(jde-1,jte)
+            DO i = its , MIN(ide-1,ite)
+               IF ( landmask(i,j) .LT. 0.5 ) THEN
+                  DO l = 1 , num_soil_layers
+                     tslb(i,l,j)= tsk(i,j)
+                     smois(i,l,j)= 1.0
+                  END DO
+               END IF
+            END DO
+         END DO
+      END IF
+
+      DEALLOCATE (zhave)
+
+   END SUBROUTINE init_soil_3_real
+
+END MODULE module_soil_pre
+
+#endif
+
Index: trunk/WRF.COMMON/WRFV2/share/module_wrf_top.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/module_wrf_top.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/module_wrf_top.F	(revision 2744)
@@ -0,0 +1,296 @@
+!WRF:DRIVER_LAYER:TOP
+!
+
+!TBH:  $$$  move this to ../frame?  
+
+MODULE module_wrf_top
+!<DESCRIPTION>
+! This module defines top-level wrf_init(), wrf_run(), and wrf_finalize() 
+! routines.  
+!</DESCRIPTION>
+
+   USE module_machine
+   USE module_domain
+   USE module_integrate
+   USE module_driver_constants
+   USE module_configure
+
+   USE module_timing
+   USE module_wrf_error
+
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+   IMPLICIT NONE
+
+   REAL    :: time
+
+   INTEGER :: loop , &
+              levels_to_process
+
+   TYPE (domain) , POINTER :: keep_grid, grid_ptr, null_domain
+   TYPE (grid_config_rec_type), SAVE :: config_flags
+   INTEGER                 :: number_at_same_level
+   INTEGER                 :: time_step_begin_restart
+
+   INTEGER :: max_dom , domain_id , fid , oid , idum1 , idum2 , ierr
+   INTEGER :: debug_level
+   LOGICAL :: input_from_file
+
+#ifdef DM_PARALLEL
+   INTEGER                 :: nbytes
+   INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
+   INTEGER                 :: configbuf( configbuflen )
+   LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+#endif
+
+   CHARACTER (LEN=80)      :: rstname
+   CHARACTER (LEN=80)      :: message
+
+   INTERFACE 
+     SUBROUTINE Setup_Timekeeping( grid )
+      USE module_domain
+      TYPE(domain), POINTER :: grid
+     END SUBROUTINE Setup_Timekeeping
+   END INTERFACE
+
+
+CONTAINS
+
+
+   SUBROUTINE wrf_init( no_init1 )
+!<DESCRIPTION>
+!     WRF initialization routine.
+!</DESCRIPTION>
+     LOGICAL, OPTIONAL, INTENT(IN) :: no_init1
+#include "version_decl"
+
+!<DESCRIPTION>
+! Program_name, a global variable defined in frame/module_domain.F, is
+! set, then a routine <a href=init_modules.html>init_modules</a> is
+! called. This calls all the init programs that are provided by the
+! modules that are linked into WRF.  These include initialization of
+! external I/O packages.   Also, some key initializations for
+! distributed-memory parallelism occur here if DM_PARALLEL is specified
+! in the compile: setting up I/O quilt processes to act as I/O servers
+! and dividing up MPI communicators among those as well as initializing
+! external communication packages such as RSL or RSL_LITE.
+!
+!</DESCRIPTION>
+
+   program_name = "WRF " // TRIM(release_version) // " MODEL"
+
+   ! Initialize WRF modules:  
+   ! Phase 1 returns after MPI_INIT() (if it is called)
+   IF ( .NOT. PRESENT( no_init1 ) ) THEN
+     CALL init_modules(1)
+     ! Initialize utilities (time manager, etc.)
+     CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN )
+   ENDIF
+   ! Phase 2 resumes after MPI_INIT() (if it is called)
+   CALL init_modules(2)
+
+!<DESCRIPTION>
+! The wrf namelist.input file is read and stored in the USE associated
+! structure model_config_rec, defined in frame/module_configure.F, by the
+! call to <a href=initial_config.html>initial_config</a>.  On distributed
+! memory parallel runs this is done only on one processor, and then
+! broadcast as a buffer.  For distributed-memory, the broadcast of the
+! configuration information is accomplished by first putting the
+! configuration information into a buffer (<a
+! href=get_config_as_buffer.html>get_config_as_buffer</a>), broadcasting
+! the buffer, then setting the configuration information (<a
+! href=set_config_as_buffer.html>set_config_as_buffer</a>).
+!
+!</DESCRIPTION>
+
+#ifdef DM_PARALLEL
+   IF ( wrf_dm_on_monitor() ) THEN
+     CALL initial_config
+   ENDIF
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+   CALL wrf_dm_initialize
+#else
+   CALL initial_config
+#endif
+
+!<DESCRIPTION>
+! Among the configuration variables read from the namelist is
+! debug_level. This is retrieved using nl_get_debug_level (Registry
+! generated and defined in frame/module_configure.F).  The value is then
+! used to set the debug-print information level for use by <a
+! href=wrf_debug.html>wrf_debug</a> throughout the code. Debug_level
+! of zero (the default) causes no information to be printed when the
+! model runs. The higher the number (up to 1000) the more information is
+! printed.
+! 
+!</DESCRIPTION>
+
+   CALL nl_get_debug_level ( 1, debug_level )
+   CALL set_wrf_debug_level ( debug_level )
+
+   ! allocated and configure the mother domain
+
+   NULLIFY( null_domain )
+
+!<DESCRIPTION>
+! RSL is required for WRF nesting options.
+! The non-MPI build that allows nesting is only supported on machines
+! with the -DSTUBMPI option.  Check to see if the WRF model is being asked 
+! for a for a multi-domain run (max_dom > 1, from the namelist).  If so,
+! then we check to make sure that we are under the parallel
+! run option or we are on an acceptable machine.
+!</DESCRIPTION>
+
+   CALL nl_get_max_dom( 1, max_dom )
+   IF ( max_dom > 1 ) THEN
+#if ( ! defined(DM_PARALLEL)  &&   ! defined(STUBMPI) )
+   CALL wrf_error_fatal( &
+     'nesting requires either an MPI build or use of the -DSTUBMPI option' ) 
+#endif
+   END IF
+
+!<DESCRIPTION>
+! The top-most domain in the simulation is then allocated and configured
+! by calling <a href=alloc_and_configure_domain.html>alloc_and_configure_domain</a>.
+! Here, in the case of this root domain, the routine is passed the
+! globally accessible pointer to TYPE(domain), head_grid, defined in
+! frame/module_domain.F.  The parent is null and the child index is given
+! as negative, signifying none.  Afterwards, because the call to
+! alloc_and_configure_domain may modify the model's configuration data
+! stored in model_config_rec, the configuration information is again
+! repacked into a buffer, broadcast, and unpacked on each task (for
+! DM_PARALLEL compiles). The call to <a
+! href=setup_timekeeping.html>setup_timekeeping</a> for head_grid relies
+! on this configuration information, and it must occur after the second
+! broadcast of the configuration information.
+! 
+!</DESCRIPTION>
+   CALL       wrf_message ( program_name )
+   CALL       wrf_debug ( 100 , 'wrf: calling alloc_and_configure_domain ' )
+   CALL alloc_and_configure_domain ( domain_id  = 1 ,                  &
+                                     grid       = head_grid ,          &
+                                     parent     = null_domain ,        &
+                                     kid        = -1                   )
+
+   CALL       wrf_debug ( 100 , 'wrf: calling model_to_grid_config_rec ' )
+   CALL model_to_grid_config_rec ( head_grid%id , model_config_rec , config_flags )
+   CALL       wrf_debug ( 100 , 'wrf: calling set_scalar_indices_from_config ' )
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+   CALL       wrf_debug ( 100 , 'wrf: calling init_wrfio' )
+   CALL init_wrfio
+
+#ifdef DM_PARALLEL
+   CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
+   CALL wrf_dm_bcast_bytes( configbuf, nbytes )
+   CALL set_config_as_buffer( configbuf, configbuflen )
+#endif
+
+   CALL Setup_Timekeeping (head_grid)
+
+!<DESCRIPTION>
+! The head grid is initialized with read-in data through the call to <a
+! href=med_initialdata_input.html>med_initialdata_input</a>, which is
+! passed the pointer head_grid and a locally declared configuration data
+! structure, config_flags, that is set by a call to <a
+! href=model_to_grid_config_rec.html>model_to_grid_config_rec</a>.  It is
+! also necessary that the indices into the 4d tracer arrays such as
+! moisture be set with a call to <a
+! href=set_scalar_indices_from_config.html>set_scalar_indices_from_config</a>
+! prior to the call to initialize the domain.  Both of these calls are
+! told which domain they are setting up for by passing in the integer id
+! of the head domain as <tt>head_grid%id</tt>, which is 1 for the
+! top-most domain.
+! 
+! In the case that write_restart_at_0h is set to true in the namelist,
+! the model simply generates a restart file using the just read-in data
+! and then shuts down. This is used for ensemble breeding, and is not
+! typically enabled.
+! 
+!</DESCRIPTION>
+
+   CALL med_initialdata_input( head_grid , config_flags )
+
+   IF ( config_flags%write_restart_at_0h ) THEN
+      CALL med_restart_out ( head_grid, config_flags )
+#ifndef AUTODOC_BUILD
+! prevent this from showing up before the call to integrate in the autogenerated call tree
+      CALL wrf_debug ( 0 , ' 0 h restart only wrf: SUCCESS COMPLETE WRF' )
+! TBH:  $$$ Unscramble this later...  
+! TBH:  $$$ Need to add state to avoid calling wrf_finalize() twice when ESMF 
+! TBH:  $$$ library is used.  Maybe just set clock stop_time=start_time and 
+! TBH:  $$$ do not call wrf_finalize here...  
+      CALL wrf_finalize( )
+#endif
+   END IF
+
+   ! set default values for subtimes
+   head_grid%start_subtime = domain_get_start_time ( head_grid )
+   head_grid%stop_subtime = domain_get_stop_time ( head_grid )
+
+   END SUBROUTINE wrf_init
+
+
+
+   SUBROUTINE wrf_run( )
+!<DESCRIPTION>
+!     WRF run routine.
+!</DESCRIPTION>
+
+!<DESCRIPTION>
+! Once the top-level domain has been allocated, configured, and
+! initialized, the model time integration is ready to proceed.  The start
+! and stop times for the domain are set to the start and stop time of the
+! model run, and then <a href=integrate.html>integrate</a> is called to
+! advance the domain forward through that specified time interval.  On
+! return, the simulation is completed.  A Mediation Layer-provided
+! subroutine, <a href=med_shutdown_io.html>med_shutdown_io</a> is called
+! to allow the the model to do any I/O specific cleanup and shutdown, and
+! then the WRF Driver Layer routine <a
+! href=wrf_shutdown.html>wrf_shutdown</a> (quilt servers would be
+! directed to shut down here) is called to properly end the run,
+! including shutting down the communications (for example, most comm
+! layers would call MPI_FINALIZE at this point if they're using MPI).
+! 
+!</DESCRIPTION>
+
+   !  The forecast integration for the most coarse grid is now started.  The
+   !  integration is from the first step (1) to the last step of the simulation.
+
+   CALL       wrf_debug ( 100 , 'wrf: calling integrate' )
+   CALL integrate ( head_grid )
+   CALL       wrf_debug ( 100 , 'wrf: back from integrate' )
+
+   END SUBROUTINE wrf_run
+
+
+
+   SUBROUTINE wrf_finalize( no_shutdown )
+!<DESCRIPTION>
+!     WRF finalize routine.
+!</DESCRIPTION>
+     LOGICAL, OPTIONAL, INTENT(IN) :: no_shutdown
+
+   ! shut down I/O
+   CALL med_shutdown_io ( head_grid , config_flags )
+   CALL       wrf_debug ( 100 , 'wrf: back from med_shutdown_io' )
+
+   CALL       wrf_debug (   0 , 'wrf: SUCCESS COMPLETE WRF' )
+
+   ! Call wrf_shutdown() (which calls MPI_FINALIZE() 
+   ! for DM parallel runs).  
+   IF ( .NOT. PRESENT( no_shutdown ) ) THEN
+     ! Finalize time manager
+     CALL WRFU_Finalize
+     CALL wrf_shutdown
+   ENDIF
+
+   END SUBROUTINE wrf_finalize
+
+
+END MODULE module_wrf_top
+
+
Index: trunk/WRF.COMMON/WRFV2/share/output_wrf.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/output_wrf.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/output_wrf.F	(revision 2744)
@@ -0,0 +1,600 @@
+!WRF:MEDIATION:IO
+!  ---principal wrf output routine (called from routines in module_io_domain ) 
+  SUBROUTINE output_wrf ( fid , grid , config_flags, switch , ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+!    USE module_date_time
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+      
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    INTEGER filestate
+    LOGICAL dryrun
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2 , moad_cen_lat , stand_lon
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif, swrad_scat
+    INTEGER ucmcall, w_damping, smooth_option, feedback, surface_input_source, sst_update
+#if (EM_CORE == 1)
+    INTEGER grid_id , parent_id , i_parent_start , j_parent_start , parent_grid_ratio
+    INTEGER diff_6th_opt
+    REAL    diff_6th_factor
+    INTEGER grid_fdda, gfdda_interval_m, gfdda_end_h, if_ramping, &
+            obs_nudge_opt, obs_nudge_wind, obs_nudge_temp, obs_nudge_mois, obs_nudge_pstr, obs_idynin, obs_ionf
+    REAL    fgdt, guv, gt, gq, dtramp_min, &
+            obs_coef_wind, obs_coef_temp, obs_coef_mois, obs_coef_pstr, obs_dtramp, fdda_end
+    LOGICAL pd_moist, pd_scalar, pd_tke
+#endif
+    CHARACTER (len=19) simulation_start_date
+    CHARACTER (len=len_current_date) current_date_save
+    INTEGER simulation_start_year   , &
+            simulation_start_month  , &
+            simulation_start_day    , &
+            simulation_start_hour   , &
+            simulation_start_minute , &
+            simulation_start_second
+    INTEGER rc
+    INTEGER :: io_form
+    LOGICAL, EXTERNAL :: multi_files
+    INTEGER, EXTERNAL :: use_package
+
+    CHARACTER*256 message
+    CHARACTER*80  fname
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    TYPE(WRFU_TimeInterval) :: bdy_increment
+    TYPE(WRFU_Time)         :: next_time, currentTime, startTime
+    CHARACTER*40            :: next_datestr
+    INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
+    LOGICAL :: adjust
+
+    WRITE(wrf_err_message,*)'output_wrf: begin, fid = ',fid
+    CALL wrf_debug( 300 , wrf_err_message )
+
+    CALL wrf_inquire_filename ( fid , fname , filestate , ierr )
+    IF ( ierr /= 0 ) THEN
+      WRITE(wrf_err_message,*)'module_io_wrf: output_wrf: wrf_inquire_filename Status = ',ierr
+      CALL wrf_error_fatal( wrf_err_message )
+    ENDIF
+
+    WRITE(wrf_err_message,*)'output_wrf: fid,filestate = ',fid,filestate
+    CALL wrf_debug( 300 , wrf_err_message )
+
+    ! io_form is used to determine if multi-file I/O is enabled and to 
+    ! control writing of format-specific time-independent metadata
+    IF ( switch .EQ. model_input_only ) THEN
+      CALL nl_get_io_form_input( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input1_only ) THEN
+      CALL nl_get_io_form_auxinput1( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input2_only ) THEN
+      CALL nl_get_io_form_auxinput2( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input3_only ) THEN
+      CALL nl_get_io_form_auxinput3( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input4_only ) THEN
+      CALL nl_get_io_form_auxinput4( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input5_only ) THEN
+      CALL nl_get_io_form_auxinput5( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input6_only ) THEN
+      CALL nl_get_io_form_auxinput6( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input7_only ) THEN
+      CALL nl_get_io_form_auxinput7( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input8_only ) THEN
+      CALL nl_get_io_form_auxinput8( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input9_only ) THEN
+      CALL nl_get_io_form_auxinput9( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input10_only ) THEN
+      CALL nl_get_io_form_gfdda( 1, io_form )
+    ELSE IF ( switch .EQ. aux_model_input11_only ) THEN
+      CALL nl_get_io_form_auxinput11( 1, io_form )
+
+    ELSE IF ( switch .EQ. history_only ) THEN
+      CALL nl_get_io_form_history( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist1_only ) THEN
+      CALL nl_get_io_form_auxhist1( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist2_only ) THEN
+      CALL nl_get_io_form_auxhist2( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist3_only ) THEN
+      CALL nl_get_io_form_auxhist3( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist4_only ) THEN
+      CALL nl_get_io_form_auxhist4( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist5_only ) THEN
+      CALL nl_get_io_form_auxhist5( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist6_only ) THEN
+      CALL nl_get_io_form_auxhist6( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist7_only ) THEN
+      CALL nl_get_io_form_auxhist7( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist8_only ) THEN
+      CALL nl_get_io_form_auxhist8( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist9_only ) THEN
+      CALL nl_get_io_form_auxhist9( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist10_only ) THEN
+      CALL nl_get_io_form_auxhist10( 1, io_form )
+    ELSE IF ( switch .EQ. aux_hist11_only ) THEN
+      CALL nl_get_io_form_auxhist11( 1, io_form )
+
+    ELSE IF ( switch .EQ. restart_only ) THEN
+      CALL nl_get_io_form_restart( 1, io_form )
+    ELSE IF ( switch .EQ. boundary_only ) THEN
+      CALL nl_get_io_form_boundary( 1, io_form )
+    ELSE  ! default:  use history
+      CALL nl_get_io_form_history( 1, io_form )
+    ENDIF
+
+    dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
+
+    WRITE(wrf_err_message,*)'output_wrf: dryrun = ',dryrun
+    CALL wrf_debug( 300 , wrf_err_message )
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt       ( 1, dyn_opt                       )
+    call nl_get_diff_opt      ( 1, diff_opt                      )
+    call nl_get_km_opt        ( 1, km_opt                        )
+    call nl_get_damp_opt      ( 1, damp_opt                      )
+    call nl_get_khdif         ( grid%id,  khdif               )
+    call nl_get_kvdif         ( grid%id,  kvdif               )
+    call nl_get_mp_physics    ( grid%id,  mp_physics          )
+    call nl_get_ra_lw_physics ( grid%id,  ra_lw_physics       )
+    call nl_get_ra_sw_physics ( grid%id,  ra_sw_physics           )
+    call nl_get_sf_sfclay_physics  ( grid%id,  sf_sfclay_physics  )
+    call nl_get_sf_surface_physics ( grid%id,  sf_surface_physics )
+    call nl_get_bl_pbl_physics     ( grid%id,  bl_pbl_physics     )
+    call nl_get_cu_physics         ( grid%id,  cu_physics         )
+
+! add nml variables in 2.2
+    call nl_get_surface_input_source ( 1      ,  surface_input_source )
+    call nl_get_sst_update           ( 1      ,  sst_update           )
+    call nl_get_feedback             ( 1      ,  feedback             )
+    call nl_get_smooth_option        ( 1      ,  smooth_option        )
+    call nl_get_swrad_scat           ( 1      ,  swrad_scat           )
+    call nl_get_ucmcall              ( 1      ,  ucmcall              )
+    call nl_get_w_damping            ( 1      ,  w_damping            )
+
+#if (EM_CORE == 1)
+    CALL nl_get_pd_moist  ( grid%id , pd_moist )
+    CALL nl_get_pd_scalar ( grid%id , pd_scalar )
+    CALL nl_get_pd_tke    ( grid%id , pd_tke )
+    CALL nl_get_diff_6th_opt  ( grid%id , diff_6th_opt )
+    CALL nl_get_diff_6th_factor ( grid%id , diff_6th_factor )
+    CALL nl_get_grid_fdda  ( grid%id , grid_fdda )
+    CALL nl_get_gfdda_end_h( grid%id , gfdda_end_h )
+    CALL nl_get_gfdda_interval_m ( grid%id , gfdda_interval_m )
+
+    IF ( grid_fdda == 1 ) THEN
+    CALL nl_get_fgdt       ( grid%id , fgdt )
+    CALL nl_get_guv        ( grid%id , guv )
+    CALL nl_get_gt         ( grid%id , gt )
+    CALL nl_get_gq         ( grid%id , gq )
+    CALL nl_get_if_ramping ( 1       , if_ramping )
+    CALL nl_get_dtramp_min ( 1       , dtramp_min )
+    ENDIF
+
+    CALL nl_get_obs_nudge_opt  ( grid%id , obs_nudge_opt )
+    IF ( obs_nudge_opt == 1 ) THEN
+    CALL nl_get_fdda_end       ( grid%id , fdda_end )
+    CALL nl_get_obs_nudge_wind ( grid%id , obs_nudge_wind )
+    CALL nl_get_obs_coef_wind  ( grid%id , obs_coef_wind )
+    CALL nl_get_obs_nudge_temp ( grid%id , obs_nudge_temp )
+    CALL nl_get_obs_coef_temp  ( grid%id , obs_coef_temp )
+    CALL nl_get_obs_nudge_mois ( grid%id , obs_nudge_mois )
+    CALL nl_get_obs_coef_mois  ( grid%id , obs_coef_mois )
+    CALL nl_get_obs_nudge_pstr ( grid%id , obs_nudge_pstr )
+    CALL nl_get_obs_coef_pstr  ( grid%id , obs_coef_pstr )
+    CALL nl_get_obs_ionf       ( 1       , obs_ionf )
+    CALL nl_get_obs_idynin     ( 1       , obs_idynin )
+    CALL nl_get_obs_dtramp     ( 1       , obs_dtramp )
+    ENDIF
+#endif
+
+! julday and gmt can be set in namelist_03 for ideal.exe run
+    CALL nl_get_gmt (grid%id, gmt)
+    CALL nl_get_julyr (grid%id, julyr)
+    CALL nl_get_julday (grid%id, julday)
+    CALL nl_get_mminlu ( 1, char_junk(1:4) )
+    CALL nl_get_iswater (grid%id, iswater )
+    CALL nl_get_cen_lat ( grid%id , cen_lat )
+    CALL nl_get_cen_lon ( grid%id , cen_lon )
+    CALL nl_get_truelat1 ( grid%id , truelat1 )
+    CALL nl_get_truelat2 ( grid%id , truelat2 )
+    CALL nl_get_moad_cen_lat ( grid%id , moad_cen_lat )
+    CALL nl_get_stand_lon ( grid%id , stand_lon )
+    CALL nl_get_map_proj ( grid%id , map_proj )
+
+#if (EM_CORE == 1)
+    CALL nl_get_parent_id ( grid%id , parent_id )
+    CALL nl_get_i_parent_start ( grid%id , i_parent_start )
+    CALL nl_get_j_parent_start ( grid%id , j_parent_start )
+    CALL nl_get_parent_grid_ratio ( grid%id , parent_grid_ratio )
+#endif
+
+    CALL domain_clockprint(150, grid, &
+           'DEBUG output_wrf():  before call to domain_clock_get,')
+    CALL domain_clock_get( grid, current_time=currentTime, &
+                                 start_time=startTime,     &
+                                 current_timestr=current_date )
+    WRITE ( wrf_err_message , * ) 'output_wrf: begin, current_date=',current_date
+    CALL wrf_debug ( 300 , wrf_err_message )
+
+    WRITE( message , * ) "OUTPUT FROM " , TRIM(program_name)
+    CALL wrf_put_dom_ti_char ( fid , 'TITLE' , TRIM(message) , ierr )
+    ! added grib-specific metadata:  Todd Hutchinson 8/21/2005
+    IF ( ( use_package( io_form ) == IO_GRIB1 ) .OR. &
+         ( use_package( io_form ) == IO_GRIB2 ) ) THEN
+      CALL wrf_put_dom_ti_char ( fid, 'PROGRAM_NAME', TRIM(program_name) , ierr )
+    ENDIF
+    CALL nl_get_start_year(grid%id,start_year)
+    CALL nl_get_start_month(grid%id,start_month)
+    CALL nl_get_start_day(grid%id,start_day)
+    CALL nl_get_start_hour(grid%id,start_hour)
+    CALL nl_get_start_minute(grid%id,start_minute)
+    CALL nl_get_start_second(grid%id,start_second)
+    WRITE ( start_date , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
+            start_year,start_month,start_day,start_hour,start_minute,start_second
+    CALL wrf_put_dom_ti_char ( fid , 'START_DATE', TRIM(start_date) , ierr )
+    IF ( switch .EQ. model_input_only) THEN
+       CALL wrf_put_dom_ti_char ( fid , 'SIMULATION_START_DATE', TRIM(start_date) , ierr )
+    ELSE IF ( ( switch .EQ. restart_only ) .OR. ( switch .EQ. history_only ) ) THEN
+       CALL nl_get_simulation_start_year   ( 1, simulation_start_year   )
+       CALL nl_get_simulation_start_month  ( 1, simulation_start_month  )
+       CALL nl_get_simulation_start_day    ( 1, simulation_start_day    )
+       CALL nl_get_simulation_start_hour   ( 1, simulation_start_hour   )
+       CALL nl_get_simulation_start_minute ( 1, simulation_start_minute )
+       CALL nl_get_simulation_start_second ( 1, simulation_start_second )
+       WRITE ( simulation_start_date , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
+               simulation_start_year,simulation_start_month,simulation_start_day,&
+               simulation_start_hour,simulation_start_minute,simulation_start_second
+       CALL wrf_put_dom_ti_char ( fid , 'SIMULATION_START_DATE', TRIM(simulation_start_date) , ierr )
+    END IF
+
+    ibuf(1) = config_flags%e_we - config_flags%s_we + 1
+    CALL wrf_put_dom_ti_integer ( fid , 'WEST-EAST_GRID_DIMENSION' ,  ibuf , 1 , ierr )
+
+    ibuf(1) = config_flags%e_sn - config_flags%s_sn + 1
+    CALL wrf_put_dom_ti_integer ( fid , 'SOUTH-NORTH_GRID_DIMENSION' , ibuf , 1 , ierr )
+
+    ibuf(1) = config_flags%e_vert - config_flags%s_vert + 1
+    CALL wrf_put_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMENSION' , ibuf , 1 , ierr )
+
+#if (EM_CORE == 1)
+    CALL wrf_put_dom_ti_real ( fid , 'DX' , config_flags%dx , 1 , ierr )
+    CALL wrf_put_dom_ti_real ( fid , 'DY' , config_flags%dy , 1 , ierr )
+#endif
+
+! added this metadatum for H. Chuan, NCEP, 030417, JM
+    SELECT CASE ( dyn_opt )
+#if (NMM_CORE == 1)
+        CASE ( dyn_nmm )
+          CALL wrf_put_dom_ti_char ( fid , 'GRIDTYPE',  'E' , ierr )
+#endif
+#if (EM_CORE == 1)
+        CASE ( dyn_em )
+          CALL wrf_put_dom_ti_char ( fid , 'GRIDTYPE',  'C' , ierr )
+#endif
+#if (COAMPS_CORE == 1 )
+        CASE ( dyn_coamps )
+          CALL wrf_put_dom_ti_char ( fid , 'GRIDTYPE',  'B' , ierr )
+#endif
+        CASE DEFAULT
+          ! we don't know; don't put anything in the file
+    END SELECT
+
+! added these fields for W. Skamarock, 020402, JM
+    ibuf(1) = dyn_opt
+    CALL wrf_put_dom_ti_integer ( fid , 'DYN_OPT' ,  ibuf , 1 , ierr )
+    ibuf(1) = diff_opt
+    CALL wrf_put_dom_ti_integer ( fid , 'DIFF_OPT' ,  ibuf , 1 , ierr )
+    ibuf(1) = km_opt
+    CALL wrf_put_dom_ti_integer ( fid , 'KM_OPT' ,  ibuf , 1 , ierr )
+    ibuf(1) = damp_opt
+    CALL wrf_put_dom_ti_integer ( fid , 'DAMP_OPT' ,  ibuf , 1 , ierr )
+    rbuf(1) = khdif
+    CALL wrf_put_dom_ti_real    ( fid , 'KHDIF' ,  rbuf , 1 , ierr )
+    rbuf(1) = kvdif
+    CALL wrf_put_dom_ti_real    ( fid , 'KVDIF' ,  rbuf , 1 , ierr )
+    ibuf(1) = mp_physics
+    CALL wrf_put_dom_ti_integer ( fid , 'MP_PHYSICS' ,  ibuf , 1 , ierr )
+    ibuf(1) = ra_lw_physics
+    CALL wrf_put_dom_ti_integer ( fid , 'RA_LW_PHYSICS' ,  ibuf , 1 , ierr )
+    ibuf(1) = ra_sw_physics
+    CALL wrf_put_dom_ti_integer ( fid , 'RA_SW_PHYSICS' ,  ibuf , 1 , ierr )
+    ibuf(1) = sf_sfclay_physics
+    CALL wrf_put_dom_ti_integer ( fid , 'SF_SFCLAY_PHYSICS' ,  ibuf , 1 , ierr )
+    ibuf(1) = sf_surface_physics
+    CALL wrf_put_dom_ti_integer ( fid , 'SF_SURFACE_PHYSICS' ,  ibuf , 1 , ierr )
+    ibuf(1) = bl_pbl_physics
+    CALL wrf_put_dom_ti_integer ( fid , 'BL_PBL_PHYSICS' ,  ibuf , 1 , ierr )
+    ibuf(1) = cu_physics
+    CALL wrf_put_dom_ti_integer ( fid , 'CU_PHYSICS' ,  ibuf , 1 , ierr )
+
+    ! added netcdf-specific metadata:
+    IF ( ( use_package( io_form ) == IO_NETCDF ) .OR. &
+         ( use_package( io_form ) == IO_PHDF5  ) .OR. &
+         ( use_package( io_form ) == IO_PNETCDF ) ) THEN
+      CALL wrf_put_dom_ti_integer ( fid, 'SURFACE_INPUT_SOURCE', surface_input_source , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid, 'SST_UPDATE', sst_update , 1 , ierr )
+#if (EM_CORE == 1)
+      CALL wrf_put_dom_ti_integer ( fid, 'GRID_FDDA', grid_fdda , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid, 'GFDDA_INTERVAL_M', gfdda_interval_m , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid, 'GFDDA_END_H', gfdda_end_h , 1 , ierr )
+#endif
+
+      IF ( switch .EQ. history_only ) THEN
+      CALL wrf_put_dom_ti_integer ( fid, 'UCMCALL', ucmcall , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid, 'FEEDBACK', feedback , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid, 'SMOOTH_OPTION', smooth_option , 1 , ierr )
+      CALL wrf_put_dom_ti_real    ( fid, 'SWRAD_SCAT', swrad_scat , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid, 'W_DAMPING', w_damping , 1 , ierr )
+
+#if (EM_CORE == 1)
+      CALL wrf_put_dom_ti_logical ( fid, 'PD_MOIST', pd_moist , 1 , ierr )
+      CALL wrf_put_dom_ti_logical ( fid, 'PD_SCALAR', pd_scalar , 1 , ierr )
+      CALL wrf_put_dom_ti_logical ( fid, 'PD_TKE', pd_tke , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid, 'DIFF_6TH_OPT', diff_6th_opt , 1 , ierr )
+      CALL wrf_put_dom_ti_real    ( fid, 'DIFF_6TH_FACTOR', diff_6th_factor , 1 , ierr )
+
+      IF ( grid_fdda == 1 ) THEN
+        CALL wrf_put_dom_ti_real    ( fid, 'FGDT', fgdt , 1 , ierr )
+        CALL wrf_put_dom_ti_real    ( fid, 'GUV', guv , 1 , ierr )
+        CALL wrf_put_dom_ti_real    ( fid, 'GT', gt , 1 , ierr )
+        CALL wrf_put_dom_ti_real    ( fid, 'GQ', gq , 1 , ierr )
+        CALL wrf_put_dom_ti_integer ( fid, 'IF_RAMPING', if_ramping , 1 , ierr )
+        CALL wrf_put_dom_ti_real    ( fid, 'DTRAMP_MIN', dtramp_min , 1 , ierr )
+      ENDIF
+
+      CALL wrf_put_dom_ti_integer ( fid, 'OBS_NUDGE_OPT', obs_nudge_opt , 1 , ierr )
+      IF ( obs_nudge_opt == 1 ) THEN
+        CALL wrf_put_dom_ti_real    ( fid, 'FDDA_END', fdda_end , 1 , ierr )
+        CALL wrf_put_dom_ti_integer ( fid, 'OBS_NUDGE_WIND', obs_nudge_wind , 1 , ierr )
+        CALL wrf_put_dom_ti_real    ( fid, 'OBS_COEF_WIND', obs_coef_wind , 1 , ierr )
+        CALL wrf_put_dom_ti_integer ( fid, 'OBS_NUDGE_TEMP', obs_nudge_temp , 1 , ierr )
+        CALL wrf_put_dom_ti_real    ( fid, 'OBS_COEF_TEMP', obs_coef_temp , 1 , ierr )
+        CALL wrf_put_dom_ti_integer ( fid, 'OBS_NUDGE_MOIS', obs_nudge_mois , 1 , ierr )
+        CALL wrf_put_dom_ti_real    ( fid, 'OBS_COEF_MOIS', obs_coef_mois , 1 , ierr )
+        CALL wrf_put_dom_ti_integer ( fid, 'OBS_NUDGE_PSTR', obs_nudge_pstr , 1 , ierr )
+        CALL wrf_put_dom_ti_real    ( fid, 'OBS_COEF_PSTR', obs_coef_pstr , 1 , ierr )
+        CALL wrf_put_dom_ti_integer ( fid, 'OBS_IONF', obs_ionf , 1 , ierr )
+        CALL wrf_put_dom_ti_integer ( fid, 'OBS_IDYNIN', obs_idynin , 1 , ierr )
+        CALL wrf_put_dom_ti_real    ( fid, 'OBS_DTRAMP', obs_dtramp , 1 , ierr )
+      ENDIF
+#endif
+      ENDIF ! history_only
+    ENDIF
+
+! added these fields for use by reassembly programs , 010831, JM
+! modified these fields so "patch" == "domain" when multi-file output 
+! formats are not used.  051018, TBH
+
+    ibuf(1) = MAX(ips,ids)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = ids
+    CALL wrf_put_dom_ti_integer ( fid , 'WEST-EAST_PATCH_START_UNSTAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MIN(ipe,ide-1)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = ide - 1
+    CALL wrf_put_dom_ti_integer ( fid , 'WEST-EAST_PATCH_END_UNSTAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MAX(ips,ids)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = ids
+    CALL wrf_put_dom_ti_integer ( fid , 'WEST-EAST_PATCH_START_STAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MIN(ipe,ide)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = ide
+    CALL wrf_put_dom_ti_integer ( fid , 'WEST-EAST_PATCH_END_STAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MAX(jps,jds)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = jds
+    CALL wrf_put_dom_ti_integer ( fid , 'SOUTH-NORTH_PATCH_START_UNSTAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MIN(jpe,jde-1)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = jde - 1
+    CALL wrf_put_dom_ti_integer ( fid , 'SOUTH-NORTH_PATCH_END_UNSTAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MAX(jps,jds)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = jds
+    CALL wrf_put_dom_ti_integer ( fid , 'SOUTH-NORTH_PATCH_START_STAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MIN(jpe,jde)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = jde
+    CALL wrf_put_dom_ti_integer ( fid , 'SOUTH-NORTH_PATCH_END_STAG' ,  ibuf , 1 , ierr )
+
+    ibuf(1) = MAX(kps,kds)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = kds
+    CALL wrf_put_dom_ti_integer ( fid , 'BOTTOM-TOP_PATCH_START_UNSTAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MIN(kpe,kde-1)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = kde - 1
+    CALL wrf_put_dom_ti_integer ( fid , 'BOTTOM-TOP_PATCH_END_UNSTAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MAX(kps,kds)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = kds
+    CALL wrf_put_dom_ti_integer ( fid , 'BOTTOM-TOP_PATCH_START_STAG' ,  ibuf , 1 , ierr )
+    ibuf(1) = MIN(kpe,kde)
+    IF ( .NOT. multi_files ( io_form ) ) ibuf(1) = kde
+    CALL wrf_put_dom_ti_integer ( fid , 'BOTTOM-TOP_PATCH_END_STAG' ,  ibuf , 1 , ierr )
+#if (EM_CORE == 1)
+    ibuf(1) = grid%id
+    CALL wrf_put_dom_ti_integer ( fid , 'GRID_ID' ,  ibuf , 1 , ierr )
+    ibuf(1) = parent_id
+    CALL wrf_put_dom_ti_integer ( fid , 'PARENT_ID' ,  ibuf , 1 , ierr )
+    ibuf(1) = i_parent_start
+    CALL wrf_put_dom_ti_integer ( fid , 'I_PARENT_START' ,  ibuf , 1 , ierr )
+    ibuf(1) = j_parent_start
+    CALL wrf_put_dom_ti_integer ( fid , 'J_PARENT_START' ,  ibuf , 1 , ierr )
+    ibuf(1) = parent_grid_ratio
+    CALL wrf_put_dom_ti_integer ( fid , 'PARENT_GRID_RATIO' ,  ibuf , 1 , ierr )
+#endif
+
+! end add 010831 JM
+
+#if (EM_CORE != 1)
+    CALL wrf_put_dom_ti_real ( fid , 'DX' ,  config_flags%dx , 1 , ierr )
+    CALL wrf_put_dom_ti_real ( fid , 'DY' ,  config_flags%dy , 1 , ierr )
+#endif
+    CALL wrf_put_dom_ti_real ( fid , 'DT' ,  config_flags%dt , 1 , ierr )
+    CALL wrf_put_dom_ti_real ( fid , 'CEN_LAT' ,  config_flags%cen_lat , 1 , ierr )
+    CALL wrf_put_dom_ti_real ( fid , 'CEN_LON' ,  config_flags%cen_lon , 1 , ierr )
+    CALL wrf_put_dom_ti_real ( fid , 'TRUELAT1',  config_flags%truelat1, 1 , ierr )
+    CALL wrf_put_dom_ti_real ( fid , 'TRUELAT2',  config_flags%truelat2, 1 , ierr )
+    CALL wrf_put_dom_ti_real ( fid , 'MOAD_CEN_LAT',  config_flags%moad_cen_lat, 1 , ierr )
+    CALL wrf_put_dom_ti_real ( fid , 'STAND_LON',  config_flags%stand_lon, 1 , ierr )
+    IF ( switch .NE. boundary_only ) THEN
+      CALL wrf_put_dom_ti_real ( fid , 'GMT' ,  config_flags%gmt , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid , 'JULYR' ,  config_flags%julyr , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid , 'JULDAY' ,  config_flags%julday , 1 , ierr )
+    ENDIF
+#if (NMM_CORE == 1)
+        write(0,*) 'MMINLU would be: ', MMINLU(1:4)
+        MMINLU(1:4)='USGS'
+        write(0,*) 'MMINLU now: ', MMINLU(1:4)
+#endif
+    CALL wrf_put_dom_ti_integer ( fid , 'MAP_PROJ' ,  config_flags%map_proj , 1 , ierr )
+    CALL wrf_put_dom_ti_char ( fid , 'MMINLU',  mminlu(1:4) , ierr )
+    CALL wrf_put_dom_ti_integer ( fid , 'ISWATER' ,  config_flags%iswater , 1 , ierr )
+    CALL wrf_put_dom_ti_integer ( fid , 'ISICE' ,  config_flags%isice , 1 , ierr )
+    CALL wrf_put_dom_ti_integer ( fid , 'ISURBAN' ,  config_flags%isurban , 1 , ierr )
+    CALL wrf_put_dom_ti_integer ( fid , 'ISOILWATER' ,  config_flags%isoilwater , 1 , ierr )
+! added these fields for restarting of moving nests, JM
+    CALL wrf_put_dom_ti_integer ( fid , 'I_PARENT_START' ,  config_flags%i_parent_start  , 1 , ierr )
+    CALL wrf_put_dom_ti_integer ( fid , 'J_PARENT_START' ,  config_flags%j_parent_start  , 1 , ierr )
+
+
+    IF ( switch .EQ. boundary_only ) THEN
+        CALL WRFU_TimeIntervalSet( bdy_increment, S=NINT(config_flags%bdyfrq),rc=rc)
+        next_time = currentTime + bdy_increment
+        CALL wrf_timetoa ( next_time, next_datestr )
+        CALL wrf_put_dom_td_char ( fid , 'THISBDYTIME' ,  current_date(1:19), current_date(1:19), ierr )
+        CALL wrf_put_dom_td_char ( fid , 'NEXTBDYTIME' ,  current_date(1:19), next_datestr(1:19), ierr )
+    ENDIF
+
+    ! added grib2-specific metadata:  Todd Hutchinson 8/21/2005
+    IF ( use_package( io_form ) == IO_GRIB2 ) THEN
+      CALL wrf_put_dom_ti_integer ( fid , 'BACKGROUND_PROC_ID' , config_flags%background_proc_id , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid , 'FORECAST_PROC_ID' , config_flags%forecast_proc_id , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid , 'PRODUCTION_STATUS' , config_flags%production_status , 1 , ierr )
+      CALL wrf_put_dom_ti_integer ( fid , 'COMPRESSION' , config_flags%compression , 1 , ierr )
+    ENDIF
+
+    CALL nl_get_adjust_output_times( grid%id, adjust ) 
+    current_date_save = current_date
+#if 1
+    IF ( switch .EQ. model_input_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_inputout.inc' )
+      CALL wrf_inputout( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input1_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput1out.inc' )
+      CALL wrf_auxinput1out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input2_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput2out.inc' )
+      CALL wrf_auxinput2out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input3_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput3out.inc' )
+      CALL wrf_auxinput3out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input4_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput4out.inc' )
+      CALL wrf_auxinput4out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input5_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput5out.inc' )
+      CALL wrf_auxinput5out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input6_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput6out.inc' )
+      CALL wrf_auxinput6out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input7_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput7out.inc' )
+      CALL wrf_auxinput7out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input8_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput8out.inc' )
+      CALL wrf_auxinput8out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input9_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput9out.inc' )
+      CALL wrf_auxinput9out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input10_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput10out.inc' )
+      CALL wrf_auxinput10out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_model_input11_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxinput11out.inc' )
+      CALL wrf_auxinput11out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. history_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_histout.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( HISTORY_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_histout( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist1_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist1out' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST1_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist1out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist2_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist2out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST2_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist2out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist3_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist3out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST3_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist3out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist4_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist4out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST4_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist4out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist5_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist5out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST5_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist5out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist6_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist6out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST6_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist6out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist7_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist7out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST7_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist7out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist8_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist8out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST8_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist8out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist9_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist9out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST9_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist9out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist10_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist10out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST10_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist10out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. aux_hist11_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_auxhist11out.inc' )
+      IF ( adjust ) CALL adjust_io_timestr( grid%io_intervals( AUXHIST11_ALARM ), currentTime, startTime, current_date )
+      CALL wrf_auxhist11out( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. restart_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_restartout.inc' )
+      CALL wrf_restartout( fid , grid , config_flags, switch, dryrun,  ierr )
+    ELSE IF ( switch .EQ. boundary_only ) THEN
+      CALL wrf_debug ( 300 , 'output_wrf: calling code in wrf_bdyout.inc' )
+      CALL wrf_bdyout( fid , grid , config_flags, switch, dryrun,  ierr )
+    ENDIF
+#else
+    CALL wrf_message ( "ALL I/O DISABLED IN share/module_io_wrf.F")
+#endif
+    current_date = current_date_save
+
+    IF ( .NOT. dryrun ) THEN
+       CALL wrf_debug ( 300 , 'output_wrf: calling wrf_iosync ' )
+       CALL wrf_iosync ( fid , ierr )
+       CALL wrf_debug ( 300 , 'output_wrf: back from wrf_iosync ' )
+    ENDIF
+
+    WRITE(wrf_err_message,*)'output_wrf: end, fid = ',fid
+    CALL wrf_debug( 300 , wrf_err_message )
+
+    RETURN
+  END SUBROUTINE output_wrf
Index: trunk/WRF.COMMON/WRFV2/share/set_timekeeping.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/set_timekeeping.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/set_timekeeping.F	(revision 2744)
@@ -0,0 +1,2058 @@
+SUBROUTINE Setup_Timekeeping ( grid )
+   USE module_domain
+   USE module_configure
+   USE module_utility
+   IMPLICIT NONE
+   TYPE(domain), POINTER :: grid
+! Local
+   TYPE(WRFU_TimeInterval) :: begin_time, end_time, zero_time, one_minute, one_hour, padding_interval
+   TYPE(WRFU_TimeInterval) :: interval, run_length
+   TYPE(WRFU_Time) :: startTime, stopTime
+   TYPE(WRFU_TimeInterval) :: stepTime
+   INTEGER :: start_year,start_month,start_day,start_hour,start_minute,start_second
+   INTEGER :: end_year,end_month,end_day,end_hour,end_minute,end_second
+#ifdef MOVE_NESTS
+   INTEGER :: vortex_interval
+#endif
+
+   INTEGER :: history_interval  , restart_interval  ,  &
+              history_interval_mo, restart_interval_mo,  &
+              history_interval_d, restart_interval_d,  &
+              history_interval_h, restart_interval_h,  &
+              history_interval_m, restart_interval_m,  &
+              history_interval_s, restart_interval_s
+
+   INTEGER :: auxhist1_interval  , auxhist2_interval  , auxhist3_interval  , &
+              auxhist1_interval_mo, auxhist2_interval_mo, auxhist3_interval_mo, &
+              auxhist1_interval_d, auxhist2_interval_d, auxhist3_interval_d, &
+              auxhist1_interval_h, auxhist2_interval_h, auxhist3_interval_h, &
+              auxhist1_interval_m, auxhist2_interval_m, auxhist3_interval_m, &
+              auxhist1_interval_s, auxhist2_interval_s, auxhist3_interval_s
+
+   INTEGER :: auxhist4_interval  , auxhist5_interval,   &
+              auxhist4_interval_mo, auxhist5_interval_mo, &
+              auxhist4_interval_d, auxhist5_interval_d, &
+              auxhist4_interval_h, auxhist5_interval_h, &
+              auxhist4_interval_m, auxhist5_interval_m, &
+              auxhist4_interval_s, auxhist5_interval_s
+
+   INTEGER :: auxhist6_interval  , auxhist7_interval  , auxhist8_interval  , &
+              auxhist6_interval_mo, auxhist7_interval_mo, auxhist8_interval_mo, &
+              auxhist6_interval_d, auxhist7_interval_d, auxhist8_interval_d, &
+              auxhist6_interval_h, auxhist7_interval_h, auxhist8_interval_h, &
+              auxhist6_interval_m, auxhist7_interval_m, auxhist8_interval_m, &
+              auxhist6_interval_s, auxhist7_interval_s, auxhist8_interval_s
+
+   INTEGER :: auxhist9_interval  , auxhist10_interval  , auxhist11_interval  , &
+              auxhist9_interval_mo, auxhist10_interval_mo, auxhist11_interval_mo, &
+              auxhist9_interval_d, auxhist10_interval_d, auxhist11_interval_d, &
+              auxhist9_interval_h, auxhist10_interval_h, auxhist11_interval_h, &
+              auxhist9_interval_m, auxhist10_interval_m, auxhist11_interval_m, &
+              auxhist9_interval_s, auxhist10_interval_s, auxhist11_interval_s
+
+   INTEGER :: auxinput1_interval  , auxinput2_interval  , auxinput3_interval  , &
+              auxinput1_interval_mo, auxinput2_interval_mo, auxinput3_interval_mo, &
+              auxinput1_interval_d, auxinput2_interval_d, auxinput3_interval_d, &
+              auxinput1_interval_h, auxinput2_interval_h, auxinput3_interval_h, &
+              auxinput1_interval_m, auxinput2_interval_m, auxinput3_interval_m, &
+              auxinput1_interval_s, auxinput2_interval_s, auxinput3_interval_s
+
+   INTEGER :: auxinput4_interval  , auxinput5_interval  , &
+              auxinput4_interval_mo, auxinput5_interval_mo, &
+              auxinput4_interval_d, auxinput5_interval_d, &
+              auxinput4_interval_h, auxinput5_interval_h, &
+              auxinput4_interval_m, auxinput5_interval_m, &
+              auxinput4_interval_s, auxinput5_interval_s
+
+   INTEGER :: auxinput6_interval  , auxinput7_interval  , auxinput8_interval  , &
+              auxinput6_interval_mo, auxinput7_interval_mo, auxinput8_interval_mo, &
+              auxinput6_interval_d, auxinput7_interval_d, auxinput8_interval_d, &
+              auxinput6_interval_h, auxinput7_interval_h, auxinput8_interval_h, &
+              auxinput6_interval_m, auxinput7_interval_m, auxinput8_interval_m, &
+              auxinput6_interval_s, auxinput7_interval_s, auxinput8_interval_s
+
+   INTEGER :: auxinput9_interval  , gfdda_interval  , auxinput11_interval  , &
+              auxinput9_interval_mo, gfdda_interval_mo, auxinput11_interval_mo, &
+              auxinput9_interval_d, gfdda_interval_d, auxinput11_interval_d, &
+              auxinput9_interval_h, gfdda_interval_h, auxinput11_interval_h, &
+              auxinput9_interval_m, gfdda_interval_m, auxinput11_interval_m, &
+              auxinput9_interval_s, gfdda_interval_s, auxinput11_interval_s
+
+   INTEGER :: history_begin  , restart_begin  ,  &
+              history_begin_y, restart_begin_y,  &
+              history_begin_mo, restart_begin_mo,  &
+              history_begin_d, restart_begin_d,  &
+              history_begin_h, restart_begin_h,  &
+              history_begin_m, restart_begin_m,  &
+              history_begin_s, restart_begin_s
+
+   INTEGER :: auxhist1_begin  , auxhist2_begin  , auxhist3_begin  , &
+              auxhist1_begin_y, auxhist2_begin_y, auxhist3_begin_y, &
+              auxhist1_begin_mo, auxhist2_begin_mo, auxhist3_begin_mo, &
+              auxhist1_begin_d, auxhist2_begin_d, auxhist3_begin_d, &
+              auxhist1_begin_h, auxhist2_begin_h, auxhist3_begin_h, &
+              auxhist1_begin_m, auxhist2_begin_m, auxhist3_begin_m, &
+              auxhist1_begin_s, auxhist2_begin_s, auxhist3_begin_s
+
+   INTEGER :: auxhist4_begin  , auxhist5_begin,   &
+              auxhist4_begin_y, auxhist5_begin_y, &
+              auxhist4_begin_mo, auxhist5_begin_mo, &
+              auxhist4_begin_d, auxhist5_begin_d, &
+              auxhist4_begin_h, auxhist5_begin_h, &
+              auxhist4_begin_m, auxhist5_begin_m, &
+              auxhist4_begin_s, auxhist5_begin_s
+
+   INTEGER :: auxhist6_begin  , auxhist7_begin  , auxhist8_begin  , &
+              auxhist6_begin_y, auxhist7_begin_y, auxhist8_begin_y, &
+              auxhist6_begin_mo, auxhist7_begin_mo, auxhist8_begin_mo, &
+              auxhist6_begin_d, auxhist7_begin_d, auxhist8_begin_d, &
+              auxhist6_begin_h, auxhist7_begin_h, auxhist8_begin_h, &
+              auxhist6_begin_m, auxhist7_begin_m, auxhist8_begin_m, &
+              auxhist6_begin_s, auxhist7_begin_s, auxhist8_begin_s
+
+   INTEGER :: auxhist9_begin  , auxhist10_begin  , auxhist11_begin  , &
+              auxhist9_begin_y, auxhist10_begin_y, auxhist11_begin_y, &
+              auxhist9_begin_mo, auxhist10_begin_mo, auxhist11_begin_mo, &
+              auxhist9_begin_d, auxhist10_begin_d, auxhist11_begin_d, &
+              auxhist9_begin_h, auxhist10_begin_h, auxhist11_begin_h, &
+              auxhist9_begin_m, auxhist10_begin_m, auxhist11_begin_m, &
+              auxhist9_begin_s, auxhist10_begin_s, auxhist11_begin_s
+
+   INTEGER :: inputout_begin  ,  inputout_end,    inputout_interval ,    &
+              inputout_begin_y,  inputout_end_y,  inputout_interval_y ,    &
+              inputout_begin_mo, inputout_end_mo, inputout_interval_mo ,   &
+              inputout_begin_d,  inputout_end_d,  inputout_interval_d ,    &
+              inputout_begin_h,  inputout_end_h,  inputout_interval_h ,    &
+              inputout_begin_m,  inputout_end_m,  inputout_interval_m ,    &
+              inputout_begin_s,  inputout_end_s,  inputout_interval_s
+
+   INTEGER :: auxinput1_begin  , auxinput2_begin  , auxinput3_begin  , &
+              auxinput1_begin_y, auxinput2_begin_y, auxinput3_begin_y, &
+              auxinput1_begin_mo, auxinput2_begin_mo, auxinput3_begin_mo, &
+              auxinput1_begin_d, auxinput2_begin_d, auxinput3_begin_d, &
+              auxinput1_begin_h, auxinput2_begin_h, auxinput3_begin_h, &
+              auxinput1_begin_m, auxinput2_begin_m, auxinput3_begin_m, &
+              auxinput1_begin_s, auxinput2_begin_s, auxinput3_begin_s
+
+   INTEGER :: auxinput4_begin  , auxinput5_begin  , &
+              auxinput4_begin_y, auxinput5_begin_y, &
+              auxinput4_begin_mo, auxinput5_begin_mo, &
+              auxinput4_begin_d, auxinput5_begin_d, &
+              auxinput4_begin_h, auxinput5_begin_h, &
+              auxinput4_begin_m, auxinput5_begin_m, &
+              auxinput4_begin_s, auxinput5_begin_s
+
+   INTEGER :: auxinput6_begin  , auxinput7_begin  , auxinput8_begin  , &
+              auxinput6_begin_y, auxinput7_begin_y, auxinput8_begin_y, &
+              auxinput6_begin_mo, auxinput7_begin_mo, auxinput8_begin_mo, &
+              auxinput6_begin_d, auxinput7_begin_d, auxinput8_begin_d, &
+              auxinput6_begin_h, auxinput7_begin_h, auxinput8_begin_h, &
+              auxinput6_begin_m, auxinput7_begin_m, auxinput8_begin_m, &
+              auxinput6_begin_s, auxinput7_begin_s, auxinput8_begin_s
+
+   INTEGER :: auxinput9_begin  , gfdda_begin  , auxinput11_begin  , &
+              auxinput9_begin_y, gfdda_begin_y, auxinput11_begin_y, &
+              auxinput9_begin_mo, gfdda_begin_mo, auxinput11_begin_mo, &
+              auxinput9_begin_d, gfdda_begin_d, auxinput11_begin_d, &
+              auxinput9_begin_h, gfdda_begin_h, auxinput11_begin_h, &
+              auxinput9_begin_m, gfdda_begin_m, auxinput11_begin_m, &
+              auxinput9_begin_s, gfdda_begin_s, auxinput11_begin_s
+
+   INTEGER :: history_end  , restart_end  ,  &
+              history_end_y, restart_end_y,  &
+              history_end_mo, restart_end_mo,  &
+              history_end_d, restart_end_d,  &
+              history_end_h, restart_end_h,  &
+              history_end_m, restart_end_m,  &
+              history_end_s, restart_end_s
+
+   INTEGER :: auxhist1_end  , auxhist2_end  , auxhist3_end  , &
+              auxhist1_end_y, auxhist2_end_y, auxhist3_end_y, &
+              auxhist1_end_mo, auxhist2_end_mo, auxhist3_end_mo, &
+              auxhist1_end_d, auxhist2_end_d, auxhist3_end_d, &
+              auxhist1_end_h, auxhist2_end_h, auxhist3_end_h, &
+              auxhist1_end_m, auxhist2_end_m, auxhist3_end_m, &
+              auxhist1_end_s, auxhist2_end_s, auxhist3_end_s
+
+   INTEGER :: auxhist4_end  , auxhist5_end,   &
+              auxhist4_end_y, auxhist5_end_y, &
+              auxhist4_end_mo, auxhist5_end_mo, &
+              auxhist4_end_d, auxhist5_end_d, &
+              auxhist4_end_h, auxhist5_end_h, &
+              auxhist4_end_m, auxhist5_end_m, &
+              auxhist4_end_s, auxhist5_end_s
+
+   INTEGER :: auxhist6_end  , auxhist7_end  , auxhist8_end  , &
+              auxhist6_end_y, auxhist7_end_y, auxhist8_end_y, &
+              auxhist6_end_mo, auxhist7_end_mo, auxhist8_end_mo, &
+              auxhist6_end_d, auxhist7_end_d, auxhist8_end_d, &
+              auxhist6_end_h, auxhist7_end_h, auxhist8_end_h, &
+              auxhist6_end_m, auxhist7_end_m, auxhist8_end_m, &
+              auxhist6_end_s, auxhist7_end_s, auxhist8_end_s
+
+   INTEGER :: auxhist9_end  , auxhist10_end  , auxhist11_end  , &
+              auxhist9_end_y, auxhist10_end_y, auxhist11_end_y, &
+              auxhist9_end_mo, auxhist10_end_mo, auxhist11_end_mo, &
+              auxhist9_end_d, auxhist10_end_d, auxhist11_end_d, &
+              auxhist9_end_h, auxhist10_end_h, auxhist11_end_h, &
+              auxhist9_end_m, auxhist10_end_m, auxhist11_end_m, &
+              auxhist9_end_s, auxhist10_end_s, auxhist11_end_s
+
+   INTEGER :: auxinput1_end  , auxinput2_end  , auxinput3_end  , &
+              auxinput1_end_y, auxinput2_end_y, auxinput3_end_y, &
+              auxinput1_end_mo, auxinput2_end_mo, auxinput3_end_mo, &
+              auxinput1_end_d, auxinput2_end_d, auxinput3_end_d, &
+              auxinput1_end_h, auxinput2_end_h, auxinput3_end_h, &
+              auxinput1_end_m, auxinput2_end_m, auxinput3_end_m, &
+              auxinput1_end_s, auxinput2_end_s, auxinput3_end_s
+
+   INTEGER :: auxinput4_end  , auxinput5_end  , &
+              auxinput4_end_y, auxinput5_end_y, &
+              auxinput4_end_mo, auxinput5_end_mo, &
+              auxinput4_end_d, auxinput5_end_d, &
+              auxinput4_end_h, auxinput5_end_h, &
+              auxinput4_end_m, auxinput5_end_m, &
+              auxinput4_end_s, auxinput5_end_s
+
+   INTEGER :: auxinput6_end  , auxinput7_end  , auxinput8_end  , &
+              auxinput6_end_y, auxinput7_end_y, auxinput8_end_y, &
+              auxinput6_end_mo, auxinput7_end_mo, auxinput8_end_mo, &
+              auxinput6_end_d, auxinput7_end_d, auxinput8_end_d, &
+              auxinput6_end_h, auxinput7_end_h, auxinput8_end_h, &
+              auxinput6_end_m, auxinput7_end_m, auxinput8_end_m, &
+              auxinput6_end_s, auxinput7_end_s, auxinput8_end_s
+
+   INTEGER :: auxinput9_end  , gfdda_end  , auxinput11_end  , &
+              auxinput9_end_y, gfdda_end_y, auxinput11_end_y, &
+              auxinput9_end_mo, gfdda_end_mo, auxinput11_end_mo, &
+              auxinput9_end_d, gfdda_end_d, auxinput11_end_d, &
+              auxinput9_end_h, gfdda_end_h, auxinput11_end_h, &
+              auxinput9_end_m, gfdda_end_m, auxinput11_end_m, &
+              auxinput9_end_s, gfdda_end_s, auxinput11_end_s
+
+   INTEGER :: grid_fdda
+
+   INTEGER :: run_days, run_hours, run_minutes, run_seconds
+   INTEGER :: time_step, time_step_fract_num, time_step_fract_den
+   INTEGER :: rc
+   REAL    :: dt
+
+   CALL WRFU_TimeIntervalSet ( zero_time, rc=rc )
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_TimeIntervalSet(zero_time) FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+   CALL WRFU_TimeIntervalSet ( one_minute, M=1, rc=rc )
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_TimeIntervalSet(one_minute) FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+   CALL WRFU_TimeIntervalSet ( one_hour, H=1, rc=rc )
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_TimeIntervalSet(one_hour) FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+
+   CALL nl_get_start_year(grid%id,start_year)
+   CALL nl_get_start_month(grid%id,start_month)
+   CALL nl_get_start_day(grid%id,start_day)
+   CALL nl_get_start_hour(grid%id,start_hour)
+   CALL nl_get_start_minute(grid%id,start_minute)
+   CALL nl_get_start_second(grid%id,start_second)
+   CALL WRFU_TimeSet(startTime, YY=start_year, MM=start_month, DD=start_day, &
+                                H=start_hour, M=start_minute, S=start_second,&
+                                      rc=rc)
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_TimeSet(startTime) FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+   CALL nl_get_run_days(1,run_days)
+   CALL nl_get_run_hours(1,run_hours)
+   CALL nl_get_run_minutes(1,run_minutes)
+   CALL nl_get_run_seconds(1,run_seconds)
+
+   IF ( grid%id .EQ. head_grid%id .AND. &
+        ( run_days .gt. 0 .or. run_hours .gt. 0 .or. run_minutes .gt. 0 .or. run_seconds .gt. 0 )) THEN
+     CALL WRFU_TimeIntervalSet ( run_length , D=run_days, H=run_hours, M=run_minutes, S=run_seconds, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(run_length) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+     stopTime = startTime + run_length
+   ELSE
+     CALL nl_get_end_year(grid%id,end_year)
+     CALL nl_get_end_month(grid%id,end_month)
+     CALL nl_get_end_day(grid%id,end_day)
+     CALL nl_get_end_hour(grid%id,end_hour)
+     CALL nl_get_end_minute(grid%id,end_minute)
+     CALL nl_get_end_second(grid%id,end_second)
+     CALL WRFU_TimeSet(stopTime, YY=end_year, MM=end_month, DD=end_day, &
+                                 H=end_hour, M=end_minute, S=end_second,&
+                                 rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeSet(stopTime) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+     run_length = stopTime - startTime
+   ENDIF
+   IF ( run_length .GT. zero_time ) THEN
+     padding_interval = one_hour
+   ELSE
+     padding_interval = zero_time - one_hour
+   ENDIF
+
+   IF ( grid%id .EQ. head_grid%id ) THEN
+      CALL nl_get_time_step ( 1, time_step )
+      CALL nl_get_time_step_fract_num( 1, time_step_fract_num )
+      CALL nl_get_time_step_fract_den( 1, time_step_fract_den )
+      dt = real(time_step) + real(time_step_fract_num) / real(time_step_fract_den)
+      CALL nl_set_dt( grid%id, dt )
+      grid%dt = dt
+      CALL WRFU_TimeIntervalSet(stepTime, S=time_step, Sn=time_step_fract_num, Sd=time_step_fract_den, rc=rc)
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(stepTime) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      stepTime = domain_get_time_step( grid%parents(1)%ptr ) / &
+                 grid%parent_time_step_ratio
+      grid%dt = grid%parents(1)%ptr%dt / grid%parent_time_step_ratio
+      CALL nl_set_dt( grid%id, grid%dt )
+   ENDIF
+
+   ! create grid%domain_clock and associated state
+   CALL domain_clock_create( grid, TimeStep= stepTime,  &
+                                   StartTime=startTime, &
+                                   StopTime= stopTime )
+   CALL domain_clockprint ( 150, grid, &
+          'DEBUG setup_timekeeping():  clock after creation,' )
+
+   ! Set default value for SIMULATION_START_DATE.  
+   ! This is overwritten later in input_wrf(), if needed.  
+   IF ( grid%id .EQ. head_grid%id ) THEN
+      CALL nl_set_simulation_start_year   ( 1 , start_year   )
+      CALL nl_set_simulation_start_month  ( 1 , start_month  )
+      CALL nl_set_simulation_start_day    ( 1 , start_day    )
+      CALL nl_set_simulation_start_hour   ( 1 , start_hour   )
+      CALL nl_set_simulation_start_minute ( 1 , start_minute )
+      CALL nl_set_simulation_start_second ( 1 , start_second )
+   ENDIF
+
+! HISTORY INTERVAL
+! history_interval is left there (and means minutes) for consistency, but 
+! history_interval_m will take precedence if specified
+
+   CALL nl_get_history_interval( grid%id, history_interval )   ! same as minutes
+   CALL nl_get_history_interval_mo( grid%id, history_interval_mo )
+   CALL nl_get_history_interval_d( grid%id, history_interval_d )
+   CALL nl_get_history_interval_h( grid%id, history_interval_h )
+   CALL nl_get_history_interval_m( grid%id, history_interval_m )
+   CALL nl_get_history_interval_s( grid%id, history_interval_s )
+   IF ( history_interval_m .EQ. 0 ) history_interval_m = history_interval
+
+   IF ( MAX( history_interval_mo, history_interval_d,   &
+             history_interval_h, history_interval_m , history_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=history_interval_mo, D=history_interval_d, &
+                                          H=history_interval_h, M=history_interval_m, S=history_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(history_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_history_begin_y( grid%id, history_begin_y )
+   CALL nl_get_history_begin_mo( grid%id, history_begin_mo )
+   CALL nl_get_history_begin_d( grid%id, history_begin_d )
+   CALL nl_get_history_begin_h( grid%id, history_begin_h )
+   CALL nl_get_history_begin_m( grid%id, history_begin_m )
+   CALL nl_get_history_begin_s( grid%id, history_begin_s )
+   IF ( MAX( history_begin_y, history_begin_mo, history_begin_d,   &
+             history_begin_h, history_begin_m , history_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=history_begin_mo, D=history_begin_d, &
+                                              H=history_begin_h, M=history_begin_m, S=history_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(history_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_history_end_y( grid%id, history_end_y )
+   CALL nl_get_history_end_mo( grid%id, history_end_mo )
+   CALL nl_get_history_end_d( grid%id, history_end_d )
+   CALL nl_get_history_end_h( grid%id, history_end_h )
+   CALL nl_get_history_end_m( grid%id, history_end_m )
+   CALL nl_get_history_end_s( grid%id, history_end_s )
+   IF ( MAX( history_end_y, history_end_mo, history_end_d,   &
+             history_end_h, history_end_m , history_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=history_end_mo, D=history_end_d, &
+                                     H=history_end_h, M=history_end_m, S=history_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(history_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, HISTORY_ALARM, interval, begin_time, end_time )
+
+   IF ( begin_time .EQ. zero_time ) THEN
+      CALL WRFU_AlarmRingerOn( grid%alarms( HISTORY_ALARM ),  rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_AlarmRingerOn(HISTORY_ALARM) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ENDIF
+
+
+! RESTART INTERVAL
+! restart_interval is left there (and means minutes) for consistency, but
+! restart_interval_m will take precedence if specified
+   CALL nl_get_restart_interval( 1, restart_interval )   ! same as minutes
+   CALL nl_get_restart_interval_mo( 1, restart_interval_mo )
+   CALL nl_get_restart_interval_d( 1, restart_interval_d )
+   CALL nl_get_restart_interval_h( 1, restart_interval_h )
+   CALL nl_get_restart_interval_m( 1, restart_interval_m )
+   CALL nl_get_restart_interval_s( 1, restart_interval_s )
+   IF ( restart_interval_m .EQ. 0 ) restart_interval_m = restart_interval
+   IF ( MAX( restart_interval_mo, restart_interval_d,   &
+             restart_interval_h, restart_interval_m , restart_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=restart_interval_mo, D=restart_interval_d, &
+                                        H=restart_interval_h, M=restart_interval_m, S=restart_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(restart_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+   CALL domain_alarm_create( grid, RESTART_ALARM, interval )
+
+! INPUTOUT INTERVAL
+   CALL nl_get_inputout_interval( grid%id, inputout_interval )   ! same as minutes
+   CALL nl_get_inputout_interval_mo( grid%id, inputout_interval_mo )
+   CALL nl_get_inputout_interval_d( grid%id, inputout_interval_d )
+   CALL nl_get_inputout_interval_h( grid%id, inputout_interval_h )
+   CALL nl_get_inputout_interval_m( grid%id, inputout_interval_m )
+   CALL nl_get_inputout_interval_s( grid%id, inputout_interval_s )
+   IF ( inputout_interval_m .EQ. 0 ) inputout_interval_m = inputout_interval
+
+   IF ( MAX( inputout_interval_mo, inputout_interval_d,   &
+             inputout_interval_h, inputout_interval_m , inputout_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=inputout_interval_mo, D=inputout_interval_d, &
+                                        H=inputout_interval_h, M=inputout_interval_m, S=inputout_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(inputout_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_inputout_begin_y( grid%id, inputout_begin_y )
+   CALL nl_get_inputout_begin_mo( grid%id, inputout_begin_mo )
+   CALL nl_get_inputout_begin_d( grid%id, inputout_begin_d )
+   CALL nl_get_inputout_begin_h( grid%id, inputout_begin_h )
+   CALL nl_get_inputout_begin_m( grid%id, inputout_begin_m )
+   CALL nl_get_inputout_begin_s( grid%id, inputout_begin_s )
+   IF ( MAX( inputout_begin_y, inputout_begin_mo, inputout_begin_d,   &
+             inputout_begin_h, inputout_begin_m , inputout_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=inputout_begin_mo, D=inputout_begin_d, &
+                                      H=inputout_begin_h, M=inputout_begin_m, S=inputout_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(inputout_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_inputout_end_y( grid%id, inputout_end_y )
+   CALL nl_get_inputout_end_mo( grid%id, inputout_end_mo )
+   CALL nl_get_inputout_end_d( grid%id, inputout_end_d )
+   CALL nl_get_inputout_end_h( grid%id, inputout_end_h )
+   CALL nl_get_inputout_end_m( grid%id, inputout_end_m )
+   CALL nl_get_inputout_end_s( grid%id, inputout_end_s )
+   IF ( MAX( inputout_end_y, inputout_end_mo, inputout_end_d,   &
+             inputout_end_h, inputout_end_m , inputout_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=inputout_end_mo, D=inputout_end_d, &
+                                     H=inputout_end_h, M=inputout_end_m, S=inputout_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(inputout_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, INPUTOUT_ALARM, interval, begin_time, end_time )
+
+! AUXHIST1 INTERVAL
+! auxhist1_interval is left there (and means minutes) for consistency, but
+! auxhist1_interval_m will take precedence if specified
+   CALL nl_get_auxhist1_interval( grid%id, auxhist1_interval )   ! same as minutes
+   CALL nl_get_auxhist1_interval_mo( grid%id, auxhist1_interval_mo )
+   CALL nl_get_auxhist1_interval_d( grid%id, auxhist1_interval_d )
+   CALL nl_get_auxhist1_interval_h( grid%id, auxhist1_interval_h )
+   CALL nl_get_auxhist1_interval_m( grid%id, auxhist1_interval_m )
+   CALL nl_get_auxhist1_interval_s( grid%id, auxhist1_interval_s )
+   IF ( auxhist1_interval_m .EQ. 0 ) auxhist1_interval_m = auxhist1_interval
+
+   IF ( MAX( auxhist1_interval_mo, auxhist1_interval_d,   &
+             auxhist1_interval_h, auxhist1_interval_m , auxhist1_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist1_interval_mo, D=auxhist1_interval_d, &
+                                        H=auxhist1_interval_h, M=auxhist1_interval_m, S=auxhist1_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist1_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist1_begin_y( grid%id, auxhist1_begin_y )
+   CALL nl_get_auxhist1_begin_mo( grid%id, auxhist1_begin_mo )
+   CALL nl_get_auxhist1_begin_d( grid%id, auxhist1_begin_d )
+   CALL nl_get_auxhist1_begin_h( grid%id, auxhist1_begin_h )
+   CALL nl_get_auxhist1_begin_m( grid%id, auxhist1_begin_m )
+   CALL nl_get_auxhist1_begin_s( grid%id, auxhist1_begin_s )
+   IF ( MAX( auxhist1_begin_y, auxhist1_begin_mo, auxhist1_begin_d,   &
+             auxhist1_begin_h, auxhist1_begin_m , auxhist1_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist1_begin_mo, D=auxhist1_begin_d, &
+                                      H=auxhist1_begin_h, M=auxhist1_begin_m, S=auxhist1_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist1_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist1_end_y( grid%id, auxhist1_end_y )
+   CALL nl_get_auxhist1_end_mo( grid%id, auxhist1_end_mo )
+   CALL nl_get_auxhist1_end_d( grid%id, auxhist1_end_d )
+   CALL nl_get_auxhist1_end_h( grid%id, auxhist1_end_h )
+   CALL nl_get_auxhist1_end_m( grid%id, auxhist1_end_m )
+   CALL nl_get_auxhist1_end_s( grid%id, auxhist1_end_s )
+   IF ( MAX( auxhist1_end_y, auxhist1_end_mo, auxhist1_end_d,   &
+             auxhist1_end_h, auxhist1_end_m , auxhist1_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist1_end_mo, D=auxhist1_end_d, &
+                                     H=auxhist1_end_h, M=auxhist1_end_m, S=auxhist1_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist1_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST1_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST1_ALARM ),  rc=rc )
+   ENDIF
+
+
+! AUXHIST2_ INTERVAL
+! auxhist2_interval is left there (and means minutes) for consistency, but
+! auxhist2_interval_m will take precedence if specified
+   CALL nl_get_auxhist2_interval( grid%id, auxhist2_interval )   ! same as minutes
+   CALL nl_get_auxhist2_interval_mo( grid%id, auxhist2_interval_mo )
+   CALL nl_get_auxhist2_interval_d( grid%id, auxhist2_interval_d )
+   CALL nl_get_auxhist2_interval_h( grid%id, auxhist2_interval_h )
+   CALL nl_get_auxhist2_interval_m( grid%id, auxhist2_interval_m )
+   CALL nl_get_auxhist2_interval_s( grid%id, auxhist2_interval_s )
+   IF ( auxhist2_interval_m .EQ. 0) auxhist2_interval_m = auxhist2_interval
+
+   IF ( MAX( auxhist2_interval_mo, auxhist2_interval_d,   &
+             auxhist2_interval_h, auxhist2_interval_m , auxhist2_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist2_interval_mo, D=auxhist2_interval_d, &
+                                        H=auxhist2_interval_h, M=auxhist2_interval_m, S=auxhist2_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist2_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist2_begin_y( grid%id, auxhist2_begin_y )
+   CALL nl_get_auxhist2_begin_mo( grid%id, auxhist2_begin_mo )
+   CALL nl_get_auxhist2_begin_d( grid%id, auxhist2_begin_d )
+   CALL nl_get_auxhist2_begin_h( grid%id, auxhist2_begin_h )
+   CALL nl_get_auxhist2_begin_m( grid%id, auxhist2_begin_m )
+   CALL nl_get_auxhist2_begin_s( grid%id, auxhist2_begin_s )
+   IF ( MAX( auxhist2_begin_y, auxhist2_begin_mo, auxhist2_begin_d,   &
+             auxhist2_begin_h, auxhist2_begin_m , auxhist2_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist2_begin_mo, D=auxhist2_begin_d, &
+                                      H=auxhist2_begin_h, M=auxhist2_begin_m, S=auxhist2_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist2_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist2_end_y( grid%id, auxhist2_end_y )
+   CALL nl_get_auxhist2_end_mo( grid%id, auxhist2_end_mo )
+   CALL nl_get_auxhist2_end_d( grid%id, auxhist2_end_d )
+   CALL nl_get_auxhist2_end_h( grid%id, auxhist2_end_h )
+   CALL nl_get_auxhist2_end_m( grid%id, auxhist2_end_m )
+   CALL nl_get_auxhist2_end_s( grid%id, auxhist2_end_s )
+   IF ( MAX( auxhist2_end_y, auxhist2_end_mo, auxhist2_end_d,   &
+             auxhist2_end_h, auxhist2_end_m , auxhist2_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist2_end_mo, D=auxhist2_end_d, &
+                                     H=auxhist2_end_h, M=auxhist2_end_m, S=auxhist2_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist2_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST2_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST2_ALARM ),  rc=rc )
+   ENDIF
+
+! AUXHIST3_ INTERVAL
+! auxhist3_interval is left there (and means minutes) for consistency, but
+! auxhist3_interval_m will take precedence if specified
+   CALL nl_get_auxhist3_interval( grid%id, auxhist3_interval )   ! same as minutes
+   CALL nl_get_auxhist3_interval_mo( grid%id, auxhist3_interval_mo )
+   CALL nl_get_auxhist3_interval_d( grid%id, auxhist3_interval_d )
+   CALL nl_get_auxhist3_interval_h( grid%id, auxhist3_interval_h )
+   CALL nl_get_auxhist3_interval_m( grid%id, auxhist3_interval_m )
+   CALL nl_get_auxhist3_interval_s( grid%id, auxhist3_interval_s )
+   IF ( auxhist3_interval_m .EQ. 0 ) auxhist3_interval_m = auxhist3_interval
+
+   IF ( MAX( auxhist3_interval_mo, auxhist3_interval_d,   &
+             auxhist3_interval_h, auxhist3_interval_m , auxhist3_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist3_interval_mo, D=auxhist3_interval_d, &
+                                        H=auxhist3_interval_h, M=auxhist3_interval_m, S=auxhist3_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist3_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist3_begin_y( grid%id, auxhist3_begin_y )
+   CALL nl_get_auxhist3_begin_mo( grid%id, auxhist3_begin_mo )
+   CALL nl_get_auxhist3_begin_d( grid%id, auxhist3_begin_d )
+   CALL nl_get_auxhist3_begin_h( grid%id, auxhist3_begin_h )
+   CALL nl_get_auxhist3_begin_m( grid%id, auxhist3_begin_m )
+   CALL nl_get_auxhist3_begin_s( grid%id, auxhist3_begin_s )
+   IF ( MAX( auxhist3_begin_y, auxhist3_begin_mo, auxhist3_begin_d,   &
+             auxhist3_begin_h, auxhist3_begin_m , auxhist3_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist3_begin_mo, D=auxhist3_begin_d, &
+                                      H=auxhist3_begin_h, M=auxhist3_begin_m, S=auxhist3_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist3_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist3_end_y( grid%id, auxhist3_end_y )
+   CALL nl_get_auxhist3_end_mo( grid%id, auxhist3_end_mo )
+   CALL nl_get_auxhist3_end_d( grid%id, auxhist3_end_d )
+   CALL nl_get_auxhist3_end_h( grid%id, auxhist3_end_h )
+   CALL nl_get_auxhist3_end_m( grid%id, auxhist3_end_m )
+   CALL nl_get_auxhist3_end_s( grid%id, auxhist3_end_s )
+   IF ( MAX( auxhist3_end_y, auxhist3_end_mo, auxhist3_end_d,   &
+             auxhist3_end_h, auxhist3_end_m , auxhist3_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist3_end_mo, D=auxhist3_end_d, &
+                                     H=auxhist3_end_h, M=auxhist3_end_m, S=auxhist3_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist3_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST3_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST3_ALARM ),  rc=rc )
+   ENDIF
+
+! AUXHIST4_ INTERVAL
+! auxhist4_interval is left there (and means minutes) for consistency, but
+! auxhist4_interval_m will take precedence if specified
+   CALL nl_get_auxhist4_interval( grid%id, auxhist4_interval )   ! same as minutes
+   CALL nl_get_auxhist4_interval_mo( grid%id, auxhist4_interval_mo )
+   CALL nl_get_auxhist4_interval_d( grid%id, auxhist4_interval_d )
+   CALL nl_get_auxhist4_interval_h( grid%id, auxhist4_interval_h )
+   CALL nl_get_auxhist4_interval_m( grid%id, auxhist4_interval_m )
+   CALL nl_get_auxhist4_interval_s( grid%id, auxhist4_interval_s )
+   IF ( auxhist4_interval_m .EQ. 0 ) auxhist4_interval_m = auxhist4_interval
+
+   IF ( MAX( auxhist4_interval_mo, auxhist4_interval_d,   &
+             auxhist4_interval_h, auxhist4_interval_m , auxhist4_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist4_interval_mo, D=auxhist4_interval_d, &
+                                        H=auxhist4_interval_h, M=auxhist4_interval_m, S=auxhist4_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist4_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist4_begin_y( grid%id, auxhist4_begin_y )
+   CALL nl_get_auxhist4_begin_mo( grid%id, auxhist4_begin_mo )
+   CALL nl_get_auxhist4_begin_d( grid%id, auxhist4_begin_d )
+   CALL nl_get_auxhist4_begin_h( grid%id, auxhist4_begin_h )
+   CALL nl_get_auxhist4_begin_m( grid%id, auxhist4_begin_m )
+   CALL nl_get_auxhist4_begin_s( grid%id, auxhist4_begin_s )
+   IF ( MAX( auxhist4_begin_y, auxhist4_begin_mo, auxhist4_begin_d,   &
+             auxhist4_begin_h, auxhist4_begin_m , auxhist4_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist4_begin_mo, D=auxhist4_begin_d, &
+                                      H=auxhist4_begin_h, M=auxhist4_begin_m, S=auxhist4_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist4_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist4_end_y( grid%id, auxhist4_end_y )
+   CALL nl_get_auxhist4_end_mo( grid%id, auxhist4_end_mo )
+   CALL nl_get_auxhist4_end_d( grid%id, auxhist4_end_d )
+   CALL nl_get_auxhist4_end_h( grid%id, auxhist4_end_h )
+   CALL nl_get_auxhist4_end_m( grid%id, auxhist4_end_m )
+   CALL nl_get_auxhist4_end_s( grid%id, auxhist4_end_s )
+   IF ( MAX( auxhist4_end_y, auxhist4_end_mo, auxhist4_end_d,   &
+             auxhist4_end_h, auxhist4_end_m , auxhist4_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist4_end_mo, D=auxhist4_end_d, &
+                                     H=auxhist4_end_h, M=auxhist4_end_m, S=auxhist4_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist4_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST4_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST4_ALARM ),  rc=rc )
+   ENDIF
+
+! AUXHIST5_ INTERVAL
+! auxhist5_interval is left there (and means minutes) for consistency, but
+! auxhist5_interval_m will take precedence if specified
+   CALL nl_get_auxhist5_interval( grid%id, auxhist5_interval )   ! same as minutes
+   CALL nl_get_auxhist5_interval_mo( grid%id, auxhist5_interval_mo )
+   CALL nl_get_auxhist5_interval_d( grid%id, auxhist5_interval_d )
+   CALL nl_get_auxhist5_interval_h( grid%id, auxhist5_interval_h )
+   CALL nl_get_auxhist5_interval_m( grid%id, auxhist5_interval_m )
+   CALL nl_get_auxhist5_interval_s( grid%id, auxhist5_interval_s )
+   IF ( auxhist5_interval_m .EQ. 0 ) auxhist5_interval_m = auxhist5_interval
+
+   IF ( MAX( auxhist5_interval_mo, auxhist5_interval_d,   &
+             auxhist5_interval_h, auxhist5_interval_m , auxhist5_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist5_interval_mo, D=auxhist5_interval_d, &
+                                        H=auxhist5_interval_h, M=auxhist5_interval_m, S=auxhist5_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist5_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist5_begin_y( grid%id, auxhist5_begin_y )
+   CALL nl_get_auxhist5_begin_mo( grid%id, auxhist5_begin_mo )
+   CALL nl_get_auxhist5_begin_d( grid%id, auxhist5_begin_d )
+   CALL nl_get_auxhist5_begin_h( grid%id, auxhist5_begin_h )
+   CALL nl_get_auxhist5_begin_m( grid%id, auxhist5_begin_m )
+   CALL nl_get_auxhist5_begin_s( grid%id, auxhist5_begin_s )
+   IF ( MAX( auxhist5_begin_y, auxhist5_begin_mo, auxhist5_begin_d,   &
+             auxhist5_begin_h, auxhist5_begin_m , auxhist5_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist5_begin_mo, D=auxhist5_begin_d, &
+                                      H=auxhist5_begin_h, M=auxhist5_begin_m, S=auxhist5_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist5_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist5_end_y( grid%id, auxhist5_end_y )
+   CALL nl_get_auxhist5_end_mo( grid%id, auxhist5_end_mo )
+   CALL nl_get_auxhist5_end_d( grid%id, auxhist5_end_d )
+   CALL nl_get_auxhist5_end_h( grid%id, auxhist5_end_h )
+   CALL nl_get_auxhist5_end_m( grid%id, auxhist5_end_m )
+   CALL nl_get_auxhist5_end_s( grid%id, auxhist5_end_s )
+   IF ( MAX( auxhist5_end_y, auxhist5_end_mo, auxhist5_end_d,   &
+             auxhist5_end_h, auxhist5_end_m , auxhist5_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist5_end_mo, D=auxhist5_end_d, &
+                                     H=auxhist5_end_h, M=auxhist5_end_m, S=auxhist5_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist5_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST5_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST5_ALARM ),  rc=rc )
+   ENDIF
+
+! AUXHIST6_ INTERVAL
+! auxhist6_interval is left there (and means minutes) for consistency, but
+! auxhist6_interval_m will take precedence if specified
+   CALL nl_get_auxhist6_interval( grid%id, auxhist6_interval )   ! same as minutes
+   CALL nl_get_auxhist6_interval_mo( grid%id, auxhist6_interval_mo )
+   CALL nl_get_auxhist6_interval_d( grid%id, auxhist6_interval_d )
+   CALL nl_get_auxhist6_interval_h( grid%id, auxhist6_interval_h )
+   CALL nl_get_auxhist6_interval_m( grid%id, auxhist6_interval_m )
+   CALL nl_get_auxhist6_interval_s( grid%id, auxhist6_interval_s )
+   IF ( auxhist6_interval_m .EQ. 0 ) auxhist6_interval_m = auxhist6_interval
+
+   IF ( MAX( auxhist6_interval_mo, auxhist6_interval_d,   &
+             auxhist6_interval_h, auxhist6_interval_m , auxhist6_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist6_interval_mo, D=auxhist6_interval_d, &
+                                        H=auxhist6_interval_h, M=auxhist6_interval_m, S=auxhist6_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist6_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist6_begin_y( grid%id, auxhist6_begin_y )
+   CALL nl_get_auxhist6_begin_mo( grid%id, auxhist6_begin_mo )
+   CALL nl_get_auxhist6_begin_d( grid%id, auxhist6_begin_d )
+   CALL nl_get_auxhist6_begin_h( grid%id, auxhist6_begin_h )
+   CALL nl_get_auxhist6_begin_m( grid%id, auxhist6_begin_m )
+   CALL nl_get_auxhist6_begin_s( grid%id, auxhist6_begin_s )
+   IF ( MAX( auxhist6_begin_y, auxhist6_begin_mo, auxhist6_begin_d,   &
+             auxhist6_begin_h, auxhist6_begin_m , auxhist6_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist6_begin_mo, D=auxhist6_begin_d, &
+                                      H=auxhist6_begin_h, M=auxhist6_begin_m, S=auxhist6_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist6_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist6_end_y( grid%id, auxhist6_end_y )
+   CALL nl_get_auxhist6_end_mo( grid%id, auxhist6_end_mo )
+   CALL nl_get_auxhist6_end_d( grid%id, auxhist6_end_d )
+   CALL nl_get_auxhist6_end_h( grid%id, auxhist6_end_h )
+   CALL nl_get_auxhist6_end_m( grid%id, auxhist6_end_m )
+   CALL nl_get_auxhist6_end_s( grid%id, auxhist6_end_s )
+   IF ( MAX( auxhist6_end_y, auxhist6_end_mo, auxhist6_end_d,   &
+             auxhist6_end_h, auxhist6_end_m , auxhist6_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist6_end_mo, D=auxhist6_end_d, &
+                                     H=auxhist6_end_h, M=auxhist6_end_m, S=auxhist6_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist6_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST6_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST6_ALARM ),  rc=rc )
+   ENDIF
+
+
+! AUXHIST7_ INTERVAL
+! auxhist7_interval is left there (and means minutes) for consistency, but
+! auxhist7_interval_m will take precedence if specified
+   CALL nl_get_auxhist7_interval( grid%id, auxhist7_interval )   ! same as minutes
+   CALL nl_get_auxhist7_interval_mo( grid%id, auxhist7_interval_mo )
+   CALL nl_get_auxhist7_interval_d( grid%id, auxhist7_interval_d )
+   CALL nl_get_auxhist7_interval_h( grid%id, auxhist7_interval_h )
+   CALL nl_get_auxhist7_interval_m( grid%id, auxhist7_interval_m )
+   CALL nl_get_auxhist7_interval_s( grid%id, auxhist7_interval_s )
+   IF ( auxhist7_interval_m .EQ. 0 ) auxhist7_interval_m = auxhist7_interval
+
+   IF ( MAX( auxhist7_interval_mo, auxhist7_interval_d,   &
+             auxhist7_interval_h, auxhist7_interval_m , auxhist7_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist7_interval_mo, D=auxhist7_interval_d, &
+                                        H=auxhist7_interval_h, M=auxhist7_interval_m, S=auxhist7_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist7_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist7_begin_y( grid%id, auxhist7_begin_y )
+   CALL nl_get_auxhist7_begin_mo( grid%id, auxhist7_begin_mo )
+   CALL nl_get_auxhist7_begin_d( grid%id, auxhist7_begin_d )
+   CALL nl_get_auxhist7_begin_h( grid%id, auxhist7_begin_h )
+   CALL nl_get_auxhist7_begin_m( grid%id, auxhist7_begin_m )
+   CALL nl_get_auxhist7_begin_s( grid%id, auxhist7_begin_s )
+   IF ( MAX( auxhist7_begin_y, auxhist7_begin_mo, auxhist7_begin_d,   &
+             auxhist7_begin_h, auxhist7_begin_m , auxhist7_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist7_begin_mo, D=auxhist7_begin_d, &
+                                      H=auxhist7_begin_h, M=auxhist7_begin_m, S=auxhist7_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist7_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist7_end_y( grid%id, auxhist7_end_y )
+   CALL nl_get_auxhist7_end_mo( grid%id, auxhist7_end_mo )
+   CALL nl_get_auxhist7_end_d( grid%id, auxhist7_end_d )
+   CALL nl_get_auxhist7_end_h( grid%id, auxhist7_end_h )
+   CALL nl_get_auxhist7_end_m( grid%id, auxhist7_end_m )
+   CALL nl_get_auxhist7_end_s( grid%id, auxhist7_end_s )
+   IF ( MAX( auxhist7_end_y, auxhist7_end_mo, auxhist7_end_d,   &
+             auxhist7_end_h, auxhist7_end_m , auxhist7_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist7_end_mo, D=auxhist7_end_d, &
+                                     H=auxhist7_end_h, M=auxhist7_end_m, S=auxhist7_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist7_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST7_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST7_ALARM ),  rc=rc )
+   ENDIF
+
+! AUXHIST8_ INTERVAL
+! auxhist8_interval is left there (and means minutes) for consistency, but
+! auxhist8_interval_m will take precedence if specified
+   CALL nl_get_auxhist8_interval( grid%id, auxhist8_interval )   ! same as minutes
+   CALL nl_get_auxhist8_interval_mo( grid%id, auxhist8_interval_mo )
+   CALL nl_get_auxhist8_interval_d( grid%id, auxhist8_interval_d )
+   CALL nl_get_auxhist8_interval_h( grid%id, auxhist8_interval_h )
+   CALL nl_get_auxhist8_interval_m( grid%id, auxhist8_interval_m )
+   CALL nl_get_auxhist8_interval_s( grid%id, auxhist8_interval_s )
+   IF ( auxhist8_interval_m .EQ. 0 ) auxhist8_interval_m = auxhist8_interval
+
+   IF ( MAX( auxhist8_interval_mo, auxhist8_interval_d,   &
+             auxhist8_interval_h, auxhist8_interval_m , auxhist8_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist8_interval_mo, D=auxhist8_interval_d, &
+                                        H=auxhist8_interval_h, M=auxhist8_interval_m, S=auxhist8_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist8_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist8_begin_y( grid%id, auxhist8_begin_y )
+   CALL nl_get_auxhist8_begin_mo( grid%id, auxhist8_begin_mo )
+   CALL nl_get_auxhist8_begin_d( grid%id, auxhist8_begin_d )
+   CALL nl_get_auxhist8_begin_h( grid%id, auxhist8_begin_h )
+   CALL nl_get_auxhist8_begin_m( grid%id, auxhist8_begin_m )
+   CALL nl_get_auxhist8_begin_s( grid%id, auxhist8_begin_s )
+   IF ( MAX( auxhist8_begin_y, auxhist8_begin_mo, auxhist8_begin_d,   &
+             auxhist8_begin_h, auxhist8_begin_m , auxhist8_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist8_begin_mo, D=auxhist8_begin_d, &
+                                      H=auxhist8_begin_h, M=auxhist8_begin_m, S=auxhist8_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist8_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist8_end_y( grid%id, auxhist8_end_y )
+   CALL nl_get_auxhist8_end_mo( grid%id, auxhist8_end_mo )
+   CALL nl_get_auxhist8_end_d( grid%id, auxhist8_end_d )
+   CALL nl_get_auxhist8_end_h( grid%id, auxhist8_end_h )
+   CALL nl_get_auxhist8_end_m( grid%id, auxhist8_end_m )
+   CALL nl_get_auxhist8_end_s( grid%id, auxhist8_end_s )
+   IF ( MAX( auxhist8_end_y, auxhist8_end_mo, auxhist8_end_d,   &
+             auxhist8_end_h, auxhist8_end_m , auxhist8_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist8_end_mo, D=auxhist8_end_d, &
+                                     H=auxhist8_end_h, M=auxhist8_end_m, S=auxhist8_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist8_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST8_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST8_ALARM ),  rc=rc )
+   ENDIF
+
+! AUXHIST9_ INTERVAL
+! auxhist9_interval is left there (and means minutes) for consistency, but
+! auxhist9_interval_m will take precedence if specified
+   CALL nl_get_auxhist9_interval( grid%id, auxhist9_interval )   ! same as minutes
+   CALL nl_get_auxhist9_interval_mo( grid%id, auxhist9_interval_mo )
+   CALL nl_get_auxhist9_interval_d( grid%id, auxhist9_interval_d )
+   CALL nl_get_auxhist9_interval_h( grid%id, auxhist9_interval_h )
+   CALL nl_get_auxhist9_interval_m( grid%id, auxhist9_interval_m )
+   CALL nl_get_auxhist9_interval_s( grid%id, auxhist9_interval_s )
+   IF ( auxhist9_interval_m .EQ. 0 ) auxhist9_interval_m = auxhist9_interval
+
+   IF ( MAX( auxhist9_interval_mo, auxhist9_interval_d,   &
+             auxhist9_interval_h, auxhist9_interval_m , auxhist9_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist9_interval_mo, D=auxhist9_interval_d, &
+                                        H=auxhist9_interval_h, M=auxhist9_interval_m, S=auxhist9_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist9_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist9_begin_y( grid%id, auxhist9_begin_y )
+   CALL nl_get_auxhist9_begin_mo( grid%id, auxhist9_begin_mo )
+   CALL nl_get_auxhist9_begin_d( grid%id, auxhist9_begin_d )
+   CALL nl_get_auxhist9_begin_h( grid%id, auxhist9_begin_h )
+   CALL nl_get_auxhist9_begin_m( grid%id, auxhist9_begin_m )
+   CALL nl_get_auxhist9_begin_s( grid%id, auxhist9_begin_s )
+   IF ( MAX( auxhist9_begin_y, auxhist9_begin_mo, auxhist9_begin_d,   &
+             auxhist9_begin_h, auxhist9_begin_m , auxhist9_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist9_begin_mo, D=auxhist9_begin_d, &
+                                      H=auxhist9_begin_h, M=auxhist9_begin_m, S=auxhist9_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist9_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist9_end_y( grid%id, auxhist9_end_y )
+   CALL nl_get_auxhist9_end_mo( grid%id, auxhist9_end_mo )
+   CALL nl_get_auxhist9_end_d( grid%id, auxhist9_end_d )
+   CALL nl_get_auxhist9_end_h( grid%id, auxhist9_end_h )
+   CALL nl_get_auxhist9_end_m( grid%id, auxhist9_end_m )
+   CALL nl_get_auxhist9_end_s( grid%id, auxhist9_end_s )
+   IF ( MAX( auxhist9_end_y, auxhist9_end_mo, auxhist9_end_d,   &
+             auxhist9_end_h, auxhist9_end_m , auxhist9_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist9_end_mo, D=auxhist9_end_d, &
+                                     H=auxhist9_end_h, M=auxhist9_end_m, S=auxhist9_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist9_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST9_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST9_ALARM ),  rc=rc )
+   ENDIF
+
+! AUXHIST10_ INTERVAL
+! auxhist10_interval is left there (and means minutes) for consistency, but
+! auxhist10_interval_m will take precedence if specified
+   CALL nl_get_auxhist10_interval( grid%id, auxhist10_interval )   ! same as minutes
+   CALL nl_get_auxhist10_interval_mo( grid%id, auxhist10_interval_mo )
+   CALL nl_get_auxhist10_interval_d( grid%id, auxhist10_interval_d )
+   CALL nl_get_auxhist10_interval_h( grid%id, auxhist10_interval_h )
+   CALL nl_get_auxhist10_interval_m( grid%id, auxhist10_interval_m )
+   CALL nl_get_auxhist10_interval_s( grid%id, auxhist10_interval_s )
+   IF ( auxhist10_interval_m .EQ. 0 ) auxhist10_interval_m = auxhist10_interval
+
+   IF ( MAX( auxhist10_interval_mo, auxhist10_interval_d,   &
+             auxhist10_interval_h, auxhist10_interval_m , auxhist10_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist10_interval_mo, D=auxhist10_interval_d, &
+                                        H=auxhist10_interval_h, M=auxhist10_interval_m, S=auxhist10_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist10_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist10_begin_y( grid%id, auxhist10_begin_y )
+   CALL nl_get_auxhist10_begin_mo( grid%id, auxhist10_begin_mo )
+   CALL nl_get_auxhist10_begin_d( grid%id, auxhist10_begin_d )
+   CALL nl_get_auxhist10_begin_h( grid%id, auxhist10_begin_h )
+   CALL nl_get_auxhist10_begin_m( grid%id, auxhist10_begin_m )
+   CALL nl_get_auxhist10_begin_s( grid%id, auxhist10_begin_s )
+   IF ( MAX( auxhist10_begin_y, auxhist10_begin_mo, auxhist10_begin_d,   &
+             auxhist10_begin_h, auxhist10_begin_m , auxhist10_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist10_begin_mo, D=auxhist10_begin_d, &
+                                      H=auxhist10_begin_h, M=auxhist10_begin_m, S=auxhist10_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist10_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist10_end_y( grid%id, auxhist10_end_y )
+   CALL nl_get_auxhist10_end_mo( grid%id, auxhist10_end_mo )
+   CALL nl_get_auxhist10_end_d( grid%id, auxhist10_end_d )
+   CALL nl_get_auxhist10_end_h( grid%id, auxhist10_end_h )
+   CALL nl_get_auxhist10_end_m( grid%id, auxhist10_end_m )
+   CALL nl_get_auxhist10_end_s( grid%id, auxhist10_end_s )
+   IF ( MAX( auxhist10_end_y, auxhist10_end_mo, auxhist10_end_d,   &
+             auxhist10_end_h, auxhist10_end_m , auxhist10_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist10_end_mo, D=auxhist10_end_d, &
+                                     H=auxhist10_end_h, M=auxhist10_end_m, S=auxhist10_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist10_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST10_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST10_ALARM ),  rc=rc )
+   ENDIF
+
+! AUXHIST11_ INTERVAL
+! auxhist11_interval is left there (and means minutes) for consistency, but
+! auxhist11_interval_m will take precedence if specified
+   CALL nl_get_auxhist11_interval( grid%id, auxhist11_interval )   ! same as minutes
+   CALL nl_get_auxhist11_interval_mo( grid%id, auxhist11_interval_mo )
+   CALL nl_get_auxhist11_interval_d( grid%id, auxhist11_interval_d )
+   CALL nl_get_auxhist11_interval_h( grid%id, auxhist11_interval_h )
+   CALL nl_get_auxhist11_interval_m( grid%id, auxhist11_interval_m )
+   CALL nl_get_auxhist11_interval_s( grid%id, auxhist11_interval_s )
+   IF ( auxhist11_interval_m .EQ. 0 ) auxhist11_interval_m = auxhist11_interval
+
+   IF ( MAX( auxhist11_interval_mo, auxhist11_interval_d,   &
+             auxhist11_interval_h, auxhist11_interval_m , auxhist11_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxhist11_interval_mo, D=auxhist11_interval_d, &
+                                        H=auxhist11_interval_h, M=auxhist11_interval_m, S=auxhist11_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxhist11_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxhist11_begin_y( grid%id, auxhist11_begin_y )
+   CALL nl_get_auxhist11_begin_mo( grid%id, auxhist11_begin_mo )
+   CALL nl_get_auxhist11_begin_d( grid%id, auxhist11_begin_d )
+   CALL nl_get_auxhist11_begin_h( grid%id, auxhist11_begin_h )
+   CALL nl_get_auxhist11_begin_m( grid%id, auxhist11_begin_m )
+   CALL nl_get_auxhist11_begin_s( grid%id, auxhist11_begin_s )
+   IF ( MAX( auxhist11_begin_y, auxhist11_begin_mo, auxhist11_begin_d,   &
+             auxhist11_begin_h, auxhist11_begin_m , auxhist11_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxhist11_begin_mo, D=auxhist11_begin_d, &
+                                      H=auxhist11_begin_h, M=auxhist11_begin_m, S=auxhist11_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist11_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxhist11_end_y( grid%id, auxhist11_end_y )
+   CALL nl_get_auxhist11_end_mo( grid%id, auxhist11_end_mo )
+   CALL nl_get_auxhist11_end_d( grid%id, auxhist11_end_d )
+   CALL nl_get_auxhist11_end_h( grid%id, auxhist11_end_h )
+   CALL nl_get_auxhist11_end_m( grid%id, auxhist11_end_m )
+   CALL nl_get_auxhist11_end_s( grid%id, auxhist11_end_s )
+   IF ( MAX( auxhist11_end_y, auxhist11_end_mo, auxhist11_end_d,   &
+             auxhist11_end_h, auxhist11_end_m , auxhist11_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxhist11_end_mo, D=auxhist11_end_d, &
+                                     H=auxhist11_end_h, M=auxhist11_end_m, S=auxhist11_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxhist11_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXHIST11_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXHIST11_ALARM ),  rc=rc )
+   ENDIF
+
+! AUXINPUT1_ INTERVAL
+! auxinput1_interval is left there (and means minutes) for consistency, but
+! auxinput1_interval_m will take precedence if specified
+   CALL nl_get_auxinput1_interval( grid%id, auxinput1_interval )   ! same as minutes
+   CALL nl_get_auxinput1_interval_mo( grid%id, auxinput1_interval_mo )
+   CALL nl_get_auxinput1_interval_d( grid%id, auxinput1_interval_d )
+   CALL nl_get_auxinput1_interval_h( grid%id, auxinput1_interval_h )
+   CALL nl_get_auxinput1_interval_m( grid%id, auxinput1_interval_m )
+   CALL nl_get_auxinput1_interval_s( grid%id, auxinput1_interval_s )
+   IF ( auxinput1_interval_m .EQ. 0 ) auxinput1_interval_m = auxinput1_interval
+
+   IF ( MAX( auxinput1_interval_mo, auxinput1_interval_d,   &
+             auxinput1_interval_h, auxinput1_interval_m , auxinput1_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput1_interval_mo, D=auxinput1_interval_d, &
+                                        H=auxinput1_interval_h, M=auxinput1_interval_m, S=auxinput1_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput1_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput1_begin_y( grid%id, auxinput1_begin_y )
+   CALL nl_get_auxinput1_begin_mo( grid%id, auxinput1_begin_mo )
+   CALL nl_get_auxinput1_begin_d( grid%id, auxinput1_begin_d )
+   CALL nl_get_auxinput1_begin_h( grid%id, auxinput1_begin_h )
+   CALL nl_get_auxinput1_begin_m( grid%id, auxinput1_begin_m )
+   CALL nl_get_auxinput1_begin_s( grid%id, auxinput1_begin_s )
+   IF ( MAX( auxinput1_begin_y, auxinput1_begin_mo, auxinput1_begin_d,   &
+             auxinput1_begin_h, auxinput1_begin_m , auxinput1_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput1_begin_mo, D=auxinput1_begin_d, &
+                                      H=auxinput1_begin_h, M=auxinput1_begin_m, S=auxinput1_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput1_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput1_end_y( grid%id, auxinput1_end_y )
+   CALL nl_get_auxinput1_end_mo( grid%id, auxinput1_end_mo )
+   CALL nl_get_auxinput1_end_d( grid%id, auxinput1_end_d )
+   CALL nl_get_auxinput1_end_h( grid%id, auxinput1_end_h )
+   CALL nl_get_auxinput1_end_m( grid%id, auxinput1_end_m )
+   CALL nl_get_auxinput1_end_s( grid%id, auxinput1_end_s )
+   IF ( MAX( auxinput1_end_y, auxinput1_end_mo, auxinput1_end_d,   &
+             auxinput1_end_h, auxinput1_end_m , auxinput1_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput1_end_mo, D=auxinput1_end_d, &
+                                     H=auxinput1_end_h, M=auxinput1_end_m, S=auxinput1_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput1_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT1_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT1_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT1_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+! AUXINPUT2_ INTERVAL
+! auxinput2_interval is left there (and means minutes) for consistency, but
+! auxinput2_interval_m will take precedence if specified
+   CALL nl_get_auxinput2_interval( grid%id, auxinput2_interval )   ! same as minutes
+   CALL nl_get_auxinput2_interval_mo( grid%id, auxinput2_interval_mo )
+   CALL nl_get_auxinput2_interval_d( grid%id, auxinput2_interval_d )
+   CALL nl_get_auxinput2_interval_h( grid%id, auxinput2_interval_h )
+   CALL nl_get_auxinput2_interval_m( grid%id, auxinput2_interval_m )
+   CALL nl_get_auxinput2_interval_s( grid%id, auxinput2_interval_s )
+   IF ( auxinput2_interval_m .EQ. 0 ) auxinput2_interval_m = auxinput2_interval
+
+   IF ( MAX( auxinput2_interval_mo, auxinput2_interval_d,   &
+             auxinput2_interval_h, auxinput2_interval_m , auxinput2_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput2_interval_mo, D=auxinput2_interval_d, &
+                                        H=auxinput2_interval_h, M=auxinput2_interval_m, S=auxinput2_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput2_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput2_begin_y( grid%id, auxinput2_begin_y )
+   CALL nl_get_auxinput2_begin_mo( grid%id, auxinput2_begin_mo )
+   CALL nl_get_auxinput2_begin_d( grid%id, auxinput2_begin_d )
+   CALL nl_get_auxinput2_begin_h( grid%id, auxinput2_begin_h )
+   CALL nl_get_auxinput2_begin_m( grid%id, auxinput2_begin_m )
+   CALL nl_get_auxinput2_begin_s( grid%id, auxinput2_begin_s )
+   IF ( MAX( auxinput2_begin_y, auxinput2_begin_mo, auxinput2_begin_d,   &
+             auxinput2_begin_h, auxinput2_begin_m , auxinput2_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput2_begin_mo, D=auxinput2_begin_d, &
+                                      H=auxinput2_begin_h, M=auxinput2_begin_m, S=auxinput2_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput2_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput2_end_y( grid%id, auxinput2_end_y )
+   CALL nl_get_auxinput2_end_mo( grid%id, auxinput2_end_mo )
+   CALL nl_get_auxinput2_end_d( grid%id, auxinput2_end_d )
+   CALL nl_get_auxinput2_end_h( grid%id, auxinput2_end_h )
+   CALL nl_get_auxinput2_end_m( grid%id, auxinput2_end_m )
+   CALL nl_get_auxinput2_end_s( grid%id, auxinput2_end_s )
+   IF ( MAX( auxinput2_end_y, auxinput2_end_mo, auxinput2_end_d,   &
+             auxinput2_end_h, auxinput2_end_m , auxinput2_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput2_end_mo, D=auxinput2_end_d, &
+                                     H=auxinput2_end_h, M=auxinput2_end_m, S=auxinput2_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput2_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT2_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT2_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT2_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+! AUXINPUT3_ INTERVAL
+! auxinput3_interval is left there (and means minutes) for consistency, but
+! auxinput3_interval_m will take precedence if specified
+   CALL nl_get_auxinput3_interval( grid%id, auxinput3_interval )   ! same as minutes
+   CALL nl_get_auxinput3_interval_mo( grid%id, auxinput3_interval_mo )
+   CALL nl_get_auxinput3_interval_d( grid%id, auxinput3_interval_d )
+   CALL nl_get_auxinput3_interval_h( grid%id, auxinput3_interval_h )
+   CALL nl_get_auxinput3_interval_m( grid%id, auxinput3_interval_m )
+   CALL nl_get_auxinput3_interval_s( grid%id, auxinput3_interval_s )
+   IF ( auxinput3_interval_m .EQ. 0 ) auxinput3_interval_m = auxinput3_interval
+
+   IF ( MAX( auxinput3_interval_mo, auxinput3_interval_d,   &
+             auxinput3_interval_h, auxinput3_interval_m , auxinput3_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput3_interval_mo, D=auxinput3_interval_d, &
+                                        H=auxinput3_interval_h, M=auxinput3_interval_m, S=auxinput3_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput3_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput3_begin_y( grid%id, auxinput3_begin_y )
+   CALL nl_get_auxinput3_begin_mo( grid%id, auxinput3_begin_mo )
+   CALL nl_get_auxinput3_begin_d( grid%id, auxinput3_begin_d )
+   CALL nl_get_auxinput3_begin_h( grid%id, auxinput3_begin_h )
+   CALL nl_get_auxinput3_begin_m( grid%id, auxinput3_begin_m )
+   CALL nl_get_auxinput3_begin_s( grid%id, auxinput3_begin_s )
+   IF ( MAX( auxinput3_begin_y, auxinput3_begin_mo, auxinput3_begin_d,   &
+             auxinput3_begin_h, auxinput3_begin_m , auxinput3_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput3_begin_mo, D=auxinput3_begin_d, &
+                                      H=auxinput3_begin_h, M=auxinput3_begin_m, S=auxinput3_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput3_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput3_end_y( grid%id, auxinput3_end_y )
+   CALL nl_get_auxinput3_end_mo( grid%id, auxinput3_end_mo )
+   CALL nl_get_auxinput3_end_d( grid%id, auxinput3_end_d )
+   CALL nl_get_auxinput3_end_h( grid%id, auxinput3_end_h )
+   CALL nl_get_auxinput3_end_m( grid%id, auxinput3_end_m )
+   CALL nl_get_auxinput3_end_s( grid%id, auxinput3_end_s )
+   IF ( MAX( auxinput3_end_y, auxinput3_end_mo, auxinput3_end_d,   &
+             auxinput3_end_h, auxinput3_end_m , auxinput3_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput3_end_mo, D=auxinput3_end_d, &
+                                     H=auxinput3_end_h, M=auxinput3_end_m, S=auxinput3_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput3_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT3_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT3_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT3_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+! AUXINPUT4_ INTERVAL
+! auxinput4_interval is left there (and means minutes) for consistency, but
+! auxinput4_interval_m will take precedence if specified
+   CALL nl_get_auxinput4_interval( grid%id, auxinput4_interval )   ! same as minutes
+   CALL nl_get_auxinput4_interval_mo( grid%id, auxinput4_interval_mo )
+   CALL nl_get_auxinput4_interval_d( grid%id, auxinput4_interval_d )
+   CALL nl_get_auxinput4_interval_h( grid%id, auxinput4_interval_h )
+   CALL nl_get_auxinput4_interval_m( grid%id, auxinput4_interval_m )
+   CALL nl_get_auxinput4_interval_s( grid%id, auxinput4_interval_s )
+   IF ( auxinput4_interval_m .EQ. 0 ) auxinput4_interval_m = auxinput4_interval
+
+   IF ( MAX( auxinput4_interval_mo, auxinput4_interval_d,   &
+             auxinput4_interval_h, auxinput4_interval_m , auxinput4_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput4_interval_mo, D=auxinput4_interval_d, &
+                                        H=auxinput4_interval_h, M=auxinput4_interval_m, S=auxinput4_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput4_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput4_begin_y( grid%id, auxinput4_begin_y )
+   CALL nl_get_auxinput4_begin_mo( grid%id, auxinput4_begin_mo )
+   CALL nl_get_auxinput4_begin_d( grid%id, auxinput4_begin_d )
+   CALL nl_get_auxinput4_begin_h( grid%id, auxinput4_begin_h )
+   CALL nl_get_auxinput4_begin_m( grid%id, auxinput4_begin_m )
+   CALL nl_get_auxinput4_begin_s( grid%id, auxinput4_begin_s )
+   IF ( MAX( auxinput4_begin_y, auxinput4_begin_mo, auxinput4_begin_d,   &
+             auxinput4_begin_h, auxinput4_begin_m , auxinput4_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput4_begin_mo, D=auxinput4_begin_d, &
+                                      H=auxinput4_begin_h, M=auxinput4_begin_m, S=auxinput4_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput4_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput4_end_y( grid%id, auxinput4_end_y )
+   CALL nl_get_auxinput4_end_mo( grid%id, auxinput4_end_mo )
+   CALL nl_get_auxinput4_end_d( grid%id, auxinput4_end_d )
+   CALL nl_get_auxinput4_end_h( grid%id, auxinput4_end_h )
+   CALL nl_get_auxinput4_end_m( grid%id, auxinput4_end_m )
+   CALL nl_get_auxinput4_end_s( grid%id, auxinput4_end_s )
+   IF ( MAX( auxinput4_end_y, auxinput4_end_mo, auxinput4_end_d,   &
+             auxinput4_end_h, auxinput4_end_m , auxinput4_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput4_end_mo, D=auxinput4_end_d, &
+                                     H=auxinput4_end_h, M=auxinput4_end_m, S=auxinput4_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput4_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT4_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT4_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT4_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+! AUXINPUT5_ INTERVAL
+! auxinput5_interval is left there (and means minutes) for consistency, but
+! auxinput5_interval_m will take precedence if specified
+   CALL nl_get_auxinput5_interval( grid%id, auxinput5_interval )   ! same as minutes
+   CALL nl_get_auxinput5_interval_mo( grid%id, auxinput5_interval_mo )
+   CALL nl_get_auxinput5_interval_d( grid%id, auxinput5_interval_d )
+   CALL nl_get_auxinput5_interval_h( grid%id, auxinput5_interval_h )
+   CALL nl_get_auxinput5_interval_m( grid%id, auxinput5_interval_m )
+   CALL nl_get_auxinput5_interval_s( grid%id, auxinput5_interval_s )
+   IF ( auxinput5_interval_m .EQ. 0 ) auxinput5_interval_m = auxinput5_interval
+
+   IF ( MAX( auxinput5_interval_mo, auxinput5_interval_d,   &
+             auxinput5_interval_h, auxinput5_interval_m , auxinput5_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput5_interval_mo, D=auxinput5_interval_d, &
+                                        H=auxinput5_interval_h, M=auxinput5_interval_m, S=auxinput5_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput5_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput5_begin_y( grid%id, auxinput5_begin_y )
+   CALL nl_get_auxinput5_begin_mo( grid%id, auxinput5_begin_mo )
+   CALL nl_get_auxinput5_begin_d( grid%id, auxinput5_begin_d )
+   CALL nl_get_auxinput5_begin_h( grid%id, auxinput5_begin_h )
+   CALL nl_get_auxinput5_begin_m( grid%id, auxinput5_begin_m )
+   CALL nl_get_auxinput5_begin_s( grid%id, auxinput5_begin_s )
+   IF ( MAX( auxinput5_begin_y, auxinput5_begin_mo, auxinput5_begin_d,   &
+             auxinput5_begin_h, auxinput5_begin_m , auxinput5_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput5_begin_mo, D=auxinput5_begin_d, &
+                                      H=auxinput5_begin_h, M=auxinput5_begin_m, S=auxinput5_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput5_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput5_end_y( grid%id, auxinput5_end_y )
+   CALL nl_get_auxinput5_end_mo( grid%id, auxinput5_end_mo )
+   CALL nl_get_auxinput5_end_d( grid%id, auxinput5_end_d )
+   CALL nl_get_auxinput5_end_h( grid%id, auxinput5_end_h )
+   CALL nl_get_auxinput5_end_m( grid%id, auxinput5_end_m )
+   CALL nl_get_auxinput5_end_s( grid%id, auxinput5_end_s )
+   IF ( MAX( auxinput5_end_y, auxinput5_end_mo, auxinput5_end_d,   &
+             auxinput5_end_h, auxinput5_end_m , auxinput5_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput5_end_mo, D=auxinput5_end_d, &
+                                     H=auxinput5_end_h, M=auxinput5_end_m, S=auxinput5_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput5_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT5_ALARM, interval, begin_time, end_time )
+
+!TBH:  Should be OK to remove the "#else" section and the code it contains 
+!TBH:  because later code overwrites grid%alarms( AUXINPUT5_ALARM )...  
+!TBH:  In fact, by setting namelist values for auxinput5 correctly, it ought 
+!TBH:  to be possible to get rid of all "#ifdef WRF_CHEM" bits in this file...  
+#ifndef WRF_CHEM
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT5_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT5_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+#else
+   CALL WRFU_AlarmEnable( grid%alarms( AUXINPUT5_ALARM ), rc=rc )
+   CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT5_ALARM ), rc=rc )
+#endif
+
+
+   CALL domain_alarm_create( grid, BOUNDARY_ALARM )
+
+   CALL WRFU_AlarmEnable( grid%alarms( BOUNDARY_ALARM ), rc=rc )
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_AlarmEnable(BOUNDARY_ALARM) FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+   CALL WRFU_AlarmRingerOn( grid%alarms( BOUNDARY_ALARM ), rc=rc )
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_AlarmRingerOn(BOUNDARY_ALARM) FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+
+#ifdef WRF_CHEM
+! TBH:  NOTE:  Proper setting of namelist variables for auxinput5 ought to 
+! TBH:         make this hard-coded bit unnecessary.  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! add for wrf_chem emiss input
+   CALL WRFU_AlarmEnable( grid%alarms( AUXINPUT5_ALARM ), rc=rc )
+   CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT5_ALARM ), rc=rc )
+! end for wrf chem emiss input
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+#endif
+
+! AUXINPUT6_ INTERVAL
+! auxinput6_interval is left there (and means minutes) for consistency, but
+! auxinput6_interval_m will take precedence if specified
+   CALL nl_get_auxinput6_interval( grid%id, auxinput6_interval )   ! same as minutes
+   CALL nl_get_auxinput6_interval_mo( grid%id, auxinput6_interval_mo )
+   CALL nl_get_auxinput6_interval_d( grid%id, auxinput6_interval_d )
+   CALL nl_get_auxinput6_interval_h( grid%id, auxinput6_interval_h )
+   CALL nl_get_auxinput6_interval_m( grid%id, auxinput6_interval_m )
+   CALL nl_get_auxinput6_interval_s( grid%id, auxinput6_interval_s )
+   IF ( auxinput6_interval_m .EQ. 0 ) auxinput6_interval_m = auxinput6_interval
+
+   IF ( MAX( auxinput6_interval_mo, auxinput6_interval_d,   &
+             auxinput6_interval_h, auxinput6_interval_m , auxinput6_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput6_interval_mo, D=auxinput6_interval_d, &
+                                        H=auxinput6_interval_h, M=auxinput6_interval_m, S=auxinput6_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput6_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput6_begin_y( grid%id, auxinput6_begin_y )
+   CALL nl_get_auxinput6_begin_mo( grid%id, auxinput6_begin_mo )
+   CALL nl_get_auxinput6_begin_d( grid%id, auxinput6_begin_d )
+   CALL nl_get_auxinput6_begin_h( grid%id, auxinput6_begin_h )
+   CALL nl_get_auxinput6_begin_m( grid%id, auxinput6_begin_m )
+   CALL nl_get_auxinput6_begin_s( grid%id, auxinput6_begin_s )
+   IF ( MAX( auxinput6_begin_y, auxinput6_begin_mo, auxinput6_begin_d,   &
+             auxinput6_begin_h, auxinput6_begin_m , auxinput6_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput6_begin_mo, D=auxinput6_begin_d, &
+                                      H=auxinput6_begin_h, M=auxinput6_begin_m, S=auxinput6_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput6_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput6_end_y( grid%id, auxinput6_end_y )
+   CALL nl_get_auxinput6_end_mo( grid%id, auxinput6_end_mo )
+   CALL nl_get_auxinput6_end_d( grid%id, auxinput6_end_d )
+   CALL nl_get_auxinput6_end_h( grid%id, auxinput6_end_h )
+   CALL nl_get_auxinput6_end_m( grid%id, auxinput6_end_m )
+   CALL nl_get_auxinput6_end_s( grid%id, auxinput6_end_s )
+   IF ( MAX( auxinput6_end_y, auxinput6_end_mo, auxinput6_end_d,   &
+             auxinput6_end_h, auxinput6_end_m , auxinput6_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput6_end_mo, D=auxinput6_end_d, &
+                                     H=auxinput6_end_h, M=auxinput6_end_m, S=auxinput6_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput6_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT6_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT6_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT6_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+
+! AUXINPUT7_ INTERVAL
+! auxinput7_interval is left there (and means minutes) for consistency, but
+! auxinput7_interval_m will take precedence if specified
+   CALL nl_get_auxinput7_interval( grid%id, auxinput7_interval )   ! same as minutes
+   CALL nl_get_auxinput7_interval_mo( grid%id, auxinput7_interval_mo )
+   CALL nl_get_auxinput7_interval_d( grid%id, auxinput7_interval_d )
+   CALL nl_get_auxinput7_interval_h( grid%id, auxinput7_interval_h )
+   CALL nl_get_auxinput7_interval_m( grid%id, auxinput7_interval_m )
+   CALL nl_get_auxinput7_interval_s( grid%id, auxinput7_interval_s )
+   IF ( auxinput7_interval_m .EQ. 0 ) auxinput7_interval_m = auxinput7_interval
+
+   IF ( MAX( auxinput7_interval_mo, auxinput7_interval_d,   &
+             auxinput7_interval_h, auxinput7_interval_m , auxinput7_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput7_interval_mo, D=auxinput7_interval_d, &
+                                        H=auxinput7_interval_h, M=auxinput7_interval_m, S=auxinput7_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput7_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput7_begin_y( grid%id, auxinput7_begin_y )
+   CALL nl_get_auxinput7_begin_mo( grid%id, auxinput7_begin_mo )
+   CALL nl_get_auxinput7_begin_d( grid%id, auxinput7_begin_d )
+   CALL nl_get_auxinput7_begin_h( grid%id, auxinput7_begin_h )
+   CALL nl_get_auxinput7_begin_m( grid%id, auxinput7_begin_m )
+   CALL nl_get_auxinput7_begin_s( grid%id, auxinput7_begin_s )
+   IF ( MAX( auxinput7_begin_y, auxinput7_begin_mo, auxinput7_begin_d,   &
+             auxinput7_begin_h, auxinput7_begin_m , auxinput7_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput7_begin_mo, D=auxinput7_begin_d, &
+                                      H=auxinput7_begin_h, M=auxinput7_begin_m, S=auxinput7_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput7_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput7_end_y( grid%id, auxinput7_end_y )
+   CALL nl_get_auxinput7_end_mo( grid%id, auxinput7_end_mo )
+   CALL nl_get_auxinput7_end_d( grid%id, auxinput7_end_d )
+   CALL nl_get_auxinput7_end_h( grid%id, auxinput7_end_h )
+   CALL nl_get_auxinput7_end_m( grid%id, auxinput7_end_m )
+   CALL nl_get_auxinput7_end_s( grid%id, auxinput7_end_s )
+   IF ( MAX( auxinput7_end_y, auxinput7_end_mo, auxinput7_end_d,   &
+             auxinput7_end_h, auxinput7_end_m , auxinput7_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput7_end_mo, D=auxinput7_end_d, &
+                                     H=auxinput7_end_h, M=auxinput7_end_m, S=auxinput7_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput7_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT7_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT7_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT7_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+
+
+! AUXINPUT8_ INTERVAL
+! auxinput8_interval is left there (and means minutes) for consistency, but
+! auxinput8_interval_m will take precedence if specified
+   CALL nl_get_auxinput8_interval( grid%id, auxinput8_interval )   ! same as minutes
+   CALL nl_get_auxinput8_interval_mo( grid%id, auxinput8_interval_mo )
+   CALL nl_get_auxinput8_interval_d( grid%id, auxinput8_interval_d )
+   CALL nl_get_auxinput8_interval_h( grid%id, auxinput8_interval_h )
+   CALL nl_get_auxinput8_interval_m( grid%id, auxinput8_interval_m )
+   CALL nl_get_auxinput8_interval_s( grid%id, auxinput8_interval_s )
+   IF ( auxinput8_interval_m .EQ. 0 ) auxinput8_interval_m = auxinput8_interval
+
+   IF ( MAX( auxinput8_interval_mo, auxinput8_interval_d,   &
+             auxinput8_interval_h, auxinput8_interval_m , auxinput8_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput8_interval_mo, D=auxinput8_interval_d, &
+                                        H=auxinput8_interval_h, M=auxinput8_interval_m, S=auxinput8_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput8_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput8_begin_y( grid%id, auxinput8_begin_y )
+   CALL nl_get_auxinput8_begin_mo( grid%id, auxinput8_begin_mo )
+   CALL nl_get_auxinput8_begin_d( grid%id, auxinput8_begin_d )
+   CALL nl_get_auxinput8_begin_h( grid%id, auxinput8_begin_h )
+   CALL nl_get_auxinput8_begin_m( grid%id, auxinput8_begin_m )
+   CALL nl_get_auxinput8_begin_s( grid%id, auxinput8_begin_s )
+   IF ( MAX( auxinput8_begin_y, auxinput8_begin_mo, auxinput8_begin_d,   &
+             auxinput8_begin_h, auxinput8_begin_m , auxinput8_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput8_begin_mo, D=auxinput8_begin_d, &
+                                      H=auxinput8_begin_h, M=auxinput8_begin_m, S=auxinput8_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput8_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput8_end_y( grid%id, auxinput8_end_y )
+   CALL nl_get_auxinput8_end_mo( grid%id, auxinput8_end_mo )
+   CALL nl_get_auxinput8_end_d( grid%id, auxinput8_end_d )
+   CALL nl_get_auxinput8_end_h( grid%id, auxinput8_end_h )
+   CALL nl_get_auxinput8_end_m( grid%id, auxinput8_end_m )
+   CALL nl_get_auxinput8_end_s( grid%id, auxinput8_end_s )
+   IF ( MAX( auxinput8_end_y, auxinput8_end_mo, auxinput8_end_d,   &
+             auxinput8_end_h, auxinput8_end_m , auxinput8_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput8_end_mo, D=auxinput8_end_d, &
+                                     H=auxinput8_end_h, M=auxinput8_end_m, S=auxinput8_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput8_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT8_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT8_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT8_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+! AUXINPUT9_ INTERVAL
+! auxinput9_interval is left there (and means minutes) for consistency, but
+! auxinput9_interval_m will take precedence if specified
+   CALL nl_get_auxinput9_interval( grid%id, auxinput9_interval )   ! same as minutes
+   CALL nl_get_auxinput9_interval_mo( grid%id, auxinput9_interval_mo )
+   CALL nl_get_auxinput9_interval_d( grid%id, auxinput9_interval_d )
+   CALL nl_get_auxinput9_interval_h( grid%id, auxinput9_interval_h )
+   CALL nl_get_auxinput9_interval_m( grid%id, auxinput9_interval_m )
+   CALL nl_get_auxinput9_interval_s( grid%id, auxinput9_interval_s )
+   IF ( auxinput9_interval_m .EQ. 0 ) auxinput9_interval_m = auxinput9_interval
+
+   IF ( MAX( auxinput9_interval_mo, auxinput9_interval_d,   &
+             auxinput9_interval_h, auxinput9_interval_m , auxinput9_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput9_interval_mo, D=auxinput9_interval_d, &
+                                        H=auxinput9_interval_h, M=auxinput9_interval_m, S=auxinput9_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput9_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput9_begin_y( grid%id, auxinput9_begin_y )
+   CALL nl_get_auxinput9_begin_mo( grid%id, auxinput9_begin_mo )
+   CALL nl_get_auxinput9_begin_d( grid%id, auxinput9_begin_d )
+   CALL nl_get_auxinput9_begin_h( grid%id, auxinput9_begin_h )
+   CALL nl_get_auxinput9_begin_m( grid%id, auxinput9_begin_m )
+   CALL nl_get_auxinput9_begin_s( grid%id, auxinput9_begin_s )
+   IF ( MAX( auxinput9_begin_y, auxinput9_begin_mo, auxinput9_begin_d,   &
+             auxinput9_begin_h, auxinput9_begin_m , auxinput9_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput9_begin_mo, D=auxinput9_begin_d, &
+                                      H=auxinput9_begin_h, M=auxinput9_begin_m, S=auxinput9_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput9_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput9_end_y( grid%id, auxinput9_end_y )
+   CALL nl_get_auxinput9_end_mo( grid%id, auxinput9_end_mo )
+   CALL nl_get_auxinput9_end_d( grid%id, auxinput9_end_d )
+   CALL nl_get_auxinput9_end_h( grid%id, auxinput9_end_h )
+   CALL nl_get_auxinput9_end_m( grid%id, auxinput9_end_m )
+   CALL nl_get_auxinput9_end_s( grid%id, auxinput9_end_s )
+   IF ( MAX( auxinput9_end_y, auxinput9_end_mo, auxinput9_end_d,   &
+             auxinput9_end_h, auxinput9_end_m , auxinput9_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput9_end_mo, D=auxinput9_end_d, &
+                                     H=auxinput9_end_h, M=auxinput9_end_m, S=auxinput9_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput9_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT9_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT9_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT9_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+#if (EM_CORE == 1)
+  CALL nl_get_grid_fdda( grid%id, grid_fdda )
+#endif
+
+! AUXINPUT10_ INTERVAL (GFDDA)
+! gfdda_interval is left there (and means minutes) for consistency, but
+! gfdda_interval_m will take precedence if specified
+   CALL nl_get_gfdda_interval( grid%id, gfdda_interval )   ! same as minutes
+   CALL nl_get_gfdda_interval_mo( grid%id, gfdda_interval_mo )
+   CALL nl_get_gfdda_interval_d( grid%id, gfdda_interval_d )
+   CALL nl_get_gfdda_interval_h( grid%id, gfdda_interval_h )
+   CALL nl_get_gfdda_interval_m( grid%id, gfdda_interval_m )
+   CALL nl_get_gfdda_interval_s( grid%id, gfdda_interval_s )
+   IF ( gfdda_interval_m .EQ. 0 ) gfdda_interval_m = gfdda_interval
+
+   IF ( MAX( gfdda_interval_mo, gfdda_interval_d,   &
+             gfdda_interval_h, gfdda_interval_m , gfdda_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=gfdda_interval_mo, D=gfdda_interval_d, &
+                                        H=gfdda_interval_h, M=gfdda_interval_m, S=gfdda_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(gfdda_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+#if (EM_CORE == 1)
+   IF( grid_fdda == 0 ) interval = run_length + padding_interval
+#endif
+
+   CALL nl_get_gfdda_begin_y( grid%id, gfdda_begin_y )
+   CALL nl_get_gfdda_begin_mo( grid%id, gfdda_begin_mo )
+   CALL nl_get_gfdda_begin_d( grid%id, gfdda_begin_d )
+   CALL nl_get_gfdda_begin_h( grid%id, gfdda_begin_h )
+   CALL nl_get_gfdda_begin_m( grid%id, gfdda_begin_m )
+   CALL nl_get_gfdda_begin_s( grid%id, gfdda_begin_s )
+   IF ( MAX( gfdda_begin_y, gfdda_begin_mo, gfdda_begin_d,   &
+             gfdda_begin_h, gfdda_begin_m , gfdda_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=gfdda_begin_mo, D=gfdda_begin_d, &
+                                      H=gfdda_begin_h, M=gfdda_begin_m, S=gfdda_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(gfdda_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_gfdda_end_y( grid%id, gfdda_end_y )
+   CALL nl_get_gfdda_end_mo( grid%id, gfdda_end_mo )
+   CALL nl_get_gfdda_end_d( grid%id, gfdda_end_d )
+   CALL nl_get_gfdda_end_h( grid%id, gfdda_end_h )
+#if (EM_CORE == 1)
+   IF( grid_fdda == 1 ) gfdda_end_h = gfdda_end_h - NINT( gfdda_interval_m/60.0 )
+#endif
+   CALL nl_get_gfdda_end_m( grid%id, gfdda_end_m )
+   CALL nl_get_gfdda_end_s( grid%id, gfdda_end_s )
+   IF ( MAX( gfdda_end_y, gfdda_end_mo, gfdda_end_d,   &
+             gfdda_end_h, gfdda_end_m , gfdda_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=gfdda_end_mo, D=gfdda_end_d, &
+                                     H=gfdda_end_h, M=gfdda_end_m, S=gfdda_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(gfdda_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+#if (EM_CORE == 1)
+   IF( grid_fdda == 0 ) end_time = run_length + padding_interval
+#endif
+
+   CALL domain_alarm_create( grid, AUXINPUT10_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT10_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT10_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+! AUXINPUT11_ INTERVAL
+! auxinput11_interval is left there (and means minutes) for consistency, but
+! auxinput11_interval_m will take precedence if specified
+   CALL nl_get_auxinput11_interval( grid%id, auxinput11_interval )   ! same as minutes
+   CALL nl_get_auxinput11_interval_mo( grid%id, auxinput11_interval_mo )
+   CALL nl_get_auxinput11_interval_d( grid%id, auxinput11_interval_d )
+   CALL nl_get_auxinput11_interval_h( grid%id, auxinput11_interval_h )
+   CALL nl_get_auxinput11_interval_m( grid%id, auxinput11_interval_m )
+   CALL nl_get_auxinput11_interval_s( grid%id, auxinput11_interval_s )
+   IF ( auxinput11_interval_m .EQ. 0 ) auxinput11_interval_m = auxinput11_interval
+
+   IF ( MAX( auxinput11_interval_mo, auxinput11_interval_d,   &
+             auxinput11_interval_h, auxinput11_interval_m , auxinput11_interval_s   ) .GT. 0 ) THEN
+     CALL WRFU_TimeIntervalSet( interval, MM=auxinput11_interval_mo, D=auxinput11_interval_d, &
+                                        H=auxinput11_interval_h, M=auxinput11_interval_m, S=auxinput11_interval_s, rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(auxinput11_interval) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ELSE
+     interval = run_length + padding_interval
+   ENDIF
+
+   CALL nl_get_auxinput11_begin_y( grid%id, auxinput11_begin_y )
+   CALL nl_get_auxinput11_begin_mo( grid%id, auxinput11_begin_mo )
+   CALL nl_get_auxinput11_begin_d( grid%id, auxinput11_begin_d )
+   CALL nl_get_auxinput11_begin_h( grid%id, auxinput11_begin_h )
+   CALL nl_get_auxinput11_begin_m( grid%id, auxinput11_begin_m )
+   CALL nl_get_auxinput11_begin_s( grid%id, auxinput11_begin_s )
+   IF ( MAX( auxinput11_begin_y, auxinput11_begin_mo, auxinput11_begin_d,   &
+             auxinput11_begin_h, auxinput11_begin_m , auxinput11_begin_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( begin_time , MM=auxinput11_begin_mo, D=auxinput11_begin_d, &
+                                      H=auxinput11_begin_h, M=auxinput11_begin_m, S=auxinput11_begin_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput11_begin) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      begin_time = zero_time
+   ENDIF
+
+   CALL nl_get_auxinput11_end_y( grid%id, auxinput11_end_y )
+   CALL nl_get_auxinput11_end_mo( grid%id, auxinput11_end_mo )
+   CALL nl_get_auxinput11_end_d( grid%id, auxinput11_end_d )
+   CALL nl_get_auxinput11_end_h( grid%id, auxinput11_end_h )
+   CALL nl_get_auxinput11_end_m( grid%id, auxinput11_end_m )
+   CALL nl_get_auxinput11_end_s( grid%id, auxinput11_end_s )
+   IF ( MAX( auxinput11_end_y, auxinput11_end_mo, auxinput11_end_d,   &
+             auxinput11_end_h, auxinput11_end_m , auxinput11_end_s   ) .GT. 0 ) THEN
+      CALL WRFU_TimeIntervalSet( end_time , MM=auxinput11_end_mo, D=auxinput11_end_d, &
+                                     H=auxinput11_end_h, M=auxinput11_end_m, S=auxinput11_end_s, rc=rc )
+      CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                            'WRFU_TimeIntervalSet(auxinput11_end) FAILED', &
+                            __FILE__ , &
+                            __LINE__  )
+   ELSE
+      end_time = run_length + padding_interval
+   ENDIF
+
+   CALL domain_alarm_create( grid, AUXINPUT11_ALARM, interval, begin_time, end_time )
+
+   IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN
+     CALL WRFU_AlarmRingerOn( grid%alarms( AUXINPUT11_ALARM ),  rc=rc )
+     CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_AlarmRingerOn(AUXINPUT11_ALARM) FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   ENDIF
+
+#ifdef MOVE_NESTS
+! This is the interval at which the code in time_for_move in share/mediation_integrate.F
+! will recompute the center of the Vortex.  Other times, it will use the last position.
+!
+   CALL nl_get_vortex_interval ( grid%id , vortex_interval ) 
+   CALL WRFU_TimeIntervalSet( interval, M=vortex_interval, rc=rc )
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                           'WRFU_TimeIntervalSet(interval) for computing vortex center FAILED', &
+                           __FILE__ , &
+                           __LINE__  )
+   CALL domain_alarm_create( grid,  COMPUTE_VORTEX_CENTER_ALARM, interval  )
+   CALL WRFU_AlarmEnable( grid%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_AlarmEnable(COMPUTE_VORTEX_CENTER_ALARM) FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+   CALL WRFU_AlarmRingerOn( grid%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
+   CALL wrf_check_error( WRFU_SUCCESS, rc, &
+                         'WRFU_AlarmRingerOn(COMPUTE_VORTEX_CENTER_ALARM) FAILED', &
+                         __FILE__ , &
+                         __LINE__  )
+#endif
+
+   grid%time_set = .TRUE.
+
+   ! Initialize derived time quantities in grid state.  
+   ! These are updated in domain_clockadvance().  
+   CALL domain_clock_get( grid, minutesSinceSimulationStart=grid%xtime )
+   CALL domain_clock_get( grid, currentDayOfYearReal=grid%julian )
+   WRITE(wrf_err_message,*) 'setup_timekeeping:  set xtime to ',grid%xtime
+   CALL wrf_debug ( 100, TRIM(wrf_err_message) )
+   WRITE(wrf_err_message,*) 'setup_timekeeping:  set julian to ',grid%julian
+   CALL wrf_debug ( 100, TRIM(wrf_err_message) )
+
+   CALL wrf_debug ( 100 , 'setup_timekeeping:  returning...' )
+
+END SUBROUTINE Setup_Timekeeping
+
+
Index: trunk/WRF.COMMON/WRFV2/share/sint.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/sint.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/sint.F	(revision 2744)
@@ -0,0 +1,418 @@
+
+      SUBROUTINE SINT(XF,                        &
+                   ims, ime, jms, jme, icmask ,  &
+                   its, ite, jts, jte, nf, xstag, ystag )
+      IMPLICIT NONE
+      INTEGER ims, ime, jms, jme, &
+              its, ite, jts, jte
+
+      LOGICAL icmask( ims:ime, jms:jme )
+      LOGICAL xstag, ystag
+
+      INTEGER nf, ior
+      REAL    one12, one24, ep
+      PARAMETER(one12=1./12.,one24=1./24.)                              
+      PARAMETER(ior=2)                        
+!                                                                       
+      REAL XF(ims:ime,jms:jme,NF)
+!                                                                       
+      REAL Y(ims:ime,jms:jme,-IOR:IOR),    &
+           Z(ims:ime,jms:jme,-IOR:IOR),    &
+           F(ims:ime,jms:jme,0:1)                                       
+!
+      INTEGER I,J,II,JJ,IIM
+      INTEGER N2STAR, N2END, N1STAR, N1END
+!                                                                       
+      DATA  EP/ 1.E-10/                                                 
+!                                                                       
+!      PARAMETER(NONOS=1)                                                
+!      PARAMETER(N1OS=N1*NONOS+1-NONOS,N2OS=N2*NONOS+1-NONOS)            
+!                                                                       
+      REAL W(ims:ime,jms:jme),OV(ims:ime,jms:jme),UN(ims:ime,jms:jme)                     
+      REAL MXM(ims:ime,jms:jme),MN(ims:ime,jms:jme)                                 
+      REAL FL(ims:ime,jms:jme,0:1)                                            
+      REAL XIG(81), XJG(81)  ! won't use but nine of these fellers.
+      INTEGER IFRST
+      integer rr
+      COMMON /DEPAR2/ XIG,XJG,IFRST
+      DATA IFRST /1/
+
+      REAL rioff, rjoff
+!                                                                       
+      REAL donor, y1, y2, a
+      DONOR(Y1,Y2,A)=(Y1*AMAX1(0.,SIGN(1.,A))-Y2*AMIN1(0.,SIGN(1.,A)))*A
+      REAL tr4, ym1, y0, yp1, yp2
+      TR4(YM1,Y0,YP1,YP2,A)=A*ONE12*(7.*(YP1+Y0)-(YP2+YM1))               &
+       -A*A*ONE24*(15.*(YP1-Y0)-(YP2-YM1))-A*A*A*ONE12*((YP1+Y0)          & 
+       -(YP2+YM1))+A*A*A*A*ONE24*(3.*(YP1-Y0)-(YP2-YM1))                
+      REAL pp, pn, x
+      PP(X)=AMAX1(0.,X)                                                 
+      PN(X)=AMIN1(0.,X)                                                 
+!!      XIG(I) = 1./3.-FLOAT(I-1)*1./3
+!!      XJG(J) = 1./3.-FLOAT(J-1)*1./3
+
+      rr = nint(sqrt(float(nf)))
+!!      write(6,*) ' nf, rr are ',nf,rr
+!!      IF ( IFRST .EQ. 1 ) THEN
+
+        rioff = 0
+        rjoff = 0
+        if(xstag .and. (mod(rr,2) .eq. 0)) rioff = 1.
+        if(ystag .and. (mod(rr,2) .eq. 0)) rjoff = 1.
+
+        DO I=1,rr
+          DO J=1,rr
+            XIG(J+(I-1)*rr)=(float(rr)-1.-rioff)/float(2*rr)-FLOAT(J-1)*1./float(rr)
+            XJG(J+(I-1)*rr)=(float(rr)-1.-rjoff)/float(2*rr)-FLOAT(I-1)*1./float(rr)   
+          ENDDO
+        ENDDO
+        IFRST = 0
+
+!!      ENDIF
+
+!      IF ( IFRST .EQ. 1 ) THEN
+!        DO I=1,3   
+!          DO J=1,3 
+!            XIG(J+(I-1)*3)=1./3.-FLOAT(J-1)*1./3.   
+!            XJG(J+(I-1)*3)=1./3.-FLOAT(I-1)*1./3.   
+!          ENDDO
+!        ENDDO
+!        IFRST = 0
+!      ENDIF
+!
+      N2STAR = jts
+      N2END  = jte
+      N1STAR = its
+      N1END  = ite
+
+      DO 2000 IIM=1,NF                                                  
+!                                                                       
+!  HERE STARTS RESIDUAL ADVECTION                                       
+!                                                                       
+        DO 9000 JJ=N2STAR,N2END                                         
+          DO 50 J=-IOR,IOR                                              
+
+            DO 51 I=-IOR,IOR                                            
+              DO 511 II=N1STAR,N1END                                    
+                IF ( icmask(II,JJ) ) Y(II,JJ,I)=XF(II+I,JJ+J,IIM)              
+  511         CONTINUE
+   51       CONTINUE                                                    
+
+            DO 811 II=N1STAR,N1END                                      
+              IF ( icmask(II,JJ) ) THEN
+                FL(II,JJ,0)=DONOR(Y(II,JJ,-1),Y(II,JJ,0),XIG(IIM))        
+                FL(II,JJ,1)=DONOR(Y(II,JJ,0),Y(II,JJ,1),XIG(IIM))           
+              ENDIF
+  811         CONTINUE
+            DO 812 II=N1STAR,N1END                                      
+              IF ( icmask(II,JJ) ) W(II,JJ)=Y(II,JJ,0)-(FL(II,JJ,1)-FL(II,JJ,0))               
+  812         CONTINUE
+            DO 813 II=N1STAR,N1END                                      
+              IF ( icmask(II,JJ) ) THEN
+                MXM(II,JJ)=                                             &
+                         AMAX1(Y(II,JJ,-1),Y(II,JJ,0),Y(II,JJ,1),       &
+                         W(II,JJ))                                      
+                MN(II,JJ)=AMIN1(Y(II,JJ,-1),Y(II,JJ,0),Y(II,JJ,1),W(II,JJ)) 
+              ENDIF
+  813         CONTINUE
+            DO 312 II=N1STAR,N1END                                      
+              IF ( icmask(II,JJ) ) THEN
+                F(II,JJ,0)=                                               &
+                           TR4(Y(II,JJ,-2),Y(II,JJ,-1),Y(II,JJ,0),        &
+                           Y(II,JJ,1),XIG(IIM))                           
+                F(II,JJ,1)=                                                 &
+                         TR4(Y(II,JJ,-1),Y(II,JJ,0),Y(II,JJ,1),Y(II,JJ,2),&
+                         XIG(IIM))                                        
+                ENDIF
+  312         CONTINUE
+            DO 822 II=N1STAR,N1END                                      
+              IF ( icmask(II,JJ) ) THEN
+                F(II,JJ,0)=F(II,JJ,0)-FL(II,JJ,0)                         
+                F(II,JJ,1)=F(II,JJ,1)-FL(II,JJ,1)                           
+              ENDIF
+  822         CONTINUE
+            DO 823 II=N1STAR,N1END                                      
+              IF ( icmask(II,JJ) ) THEN
+                OV(II,JJ)=(MXM(II,JJ)-W(II,JJ))/(-PN(F(II,JJ,1))+         &
+                        PP(F(II,JJ,0))+EP)                              
+                UN(II,JJ)=(W(II,JJ)-MN(II,JJ))/(PP(F(II,JJ,1))-             &
+                      PN(F(II,JJ,0))+EP)                                
+              ENDIF
+  823         CONTINUE
+            DO 824 II=N1STAR,N1END                                      
+              IF ( icmask(II,JJ) ) THEN
+                F(II,JJ,0)=PP(F(II,JJ,0))*AMIN1(1.,OV(II,JJ))+            &
+                           PN(F(II,JJ,0))*AMIN1(1.,UN(II,JJ))             
+                F(II,JJ,1)=PP(F(II,JJ,1))*AMIN1(1.,UN(II,JJ))+            &
+                           PN(F(II,JJ,1))*AMIN1(1.,OV(II,JJ))             
+              ENDIF                                                    
+  824         CONTINUE                                                    
+            DO 825 II=N1STAR,N1END                                      
+              IF ( icmask(II,JJ) ) THEN
+                Y(II,JJ,0)=W(II,JJ)-(F(II,JJ,1)-F(II,JJ,0))                 
+              ENDIF
+  825         CONTINUE
+            DO 361 II=N1STAR,N1END                                      
+              IF ( icmask(II,JJ) ) Z(II,JJ,J)=Y(II,JJ,0)                                       
+  361         CONTINUE
+!                                                                       
+!  END IF FIRST J LOOP                                                  
+!                                                                       
+ 8000       CONTINUE                                                    
+   50     CONTINUE                                                      
+
+          DO 911 II=N1STAR,N1END                                        
+            IF ( icmask(II,JJ) ) THEN
+              FL(II,JJ,0)=DONOR(Z(II,JJ,-1),Z(II,JJ,0),XJG(IIM))          
+              FL(II,JJ,1)=DONOR(Z(II,JJ,0),Z(II,JJ,1),XJG(IIM))             
+            ENDIF
+  911       CONTINUE
+          DO 912 II=N1STAR,N1END                                        
+            IF ( icmask(II,JJ) ) W(II,JJ)=Z(II,JJ,0)-(FL(II,JJ,1)-FL(II,JJ,0))                 
+  912       CONTINUE
+          DO 913 II=N1STAR,N1END                                        
+            IF ( icmask(II,JJ) ) THEN
+              MXM(II,JJ)=AMAX1(Z(II,JJ,-1),Z(II,JJ,0),Z(II,JJ,1),W(II,JJ))
+              MN(II,JJ)=AMIN1(Z(II,JJ,-1),Z(II,JJ,0),Z(II,JJ,1),W(II,JJ))   
+            ENDIF
+  913       CONTINUE
+          DO 412 II=N1STAR,N1END                                        
+            IF ( icmask(II,JJ) ) THEN
+              F(II,JJ,0)=                                                 &
+                         TR4(Z(II,JJ,-2),Z(II,JJ,-1),Z(II,JJ,0),Z(II,JJ,1)&
+                         ,XJG(IIM))                                       
+              F(II,JJ,1)=                                                   &
+                         TR4(Z(II,JJ,-1),Z(II,JJ,0),Z(II,JJ,1),Z(II,JJ,2),  &
+                         XJG(IIM))                                          
+            ENDIF
+  412       CONTINUE
+          DO 922 II=N1STAR,N1END                                        
+            IF ( icmask(II,JJ) ) THEN
+              F(II,JJ,0)=F(II,JJ,0)-FL(II,JJ,0)                           
+              F(II,JJ,1)=F(II,JJ,1)-FL(II,JJ,1)                             
+            ENDIF
+  922       CONTINUE
+          DO 923 II=N1STAR,N1END                                        
+            IF ( icmask(II,JJ) ) THEN
+              OV(II,JJ)=(MXM(II,JJ)-W(II,JJ))/(-PN(F(II,JJ,1))+           &
+                        PP(F(II,JJ,0))+EP)                                
+              UN(II,JJ)=(W(II,JJ)-MN(II,JJ))/(PP(F(II,JJ,1))-PN(F(II,JJ,0))+ &
+                      EP)                                                 
+            ENDIF
+  923       CONTINUE
+          DO 924 II=N1STAR,N1END                                        
+            IF ( icmask(II,JJ) ) THEN
+              F(II,JJ,0)=PP(F(II,JJ,0))*AMIN1(1.,OV(II,JJ))+PN(F(II,JJ,0))  &
+                         *AMIN1(1.,UN(II,JJ))                             
+              F(II,JJ,1)=PP(F(II,JJ,1))*AMIN1(1.,UN(II,JJ))+PN(F(II,JJ,1))  &
+                         *AMIN1(1.,OV(II,JJ))                             
+            ENDIF
+  924     CONTINUE                                                      
+ 9000   CONTINUE                                                        
+        DO 925 JJ=N2STAR,N2END                                          
+          DO 925 II=N1STAR,N1END                                        
+            IF ( icmask(II,JJ) ) XF(II,JJ,IIM)=W(II,JJ)-(F(II,JJ,1)-F(II,JJ,0))                
+  925     CONTINUE
+                                                                        
+!                                                                       
+ 2000 CONTINUE                                                          
+      RETURN                                                            
+      END                                                               
+                                                                        
+! Version of sint that replaces mask with detailed ranges for avoiding boundaries
+! may help performance by getting the conditionals out of innner loops
+
+      SUBROUTINE SINTB(XF1, XF ,                  &
+                   ims, ime, jms, jme, icmask ,  &
+                   its, ite, jts, jte, nf, xstag, ystag )
+      IMPLICIT NONE
+      INTEGER ims, ime, jms, jme, &
+              its, ite, jts, jte
+
+      LOGICAL icmask( ims:ime, jms:jme )
+      LOGICAL xstag, ystag
+
+      INTEGER nf, ior
+      REAL    one12, one24, ep
+      PARAMETER(one12=1./12.,one24=1./24.)                              
+      PARAMETER(ior=2)                        
+!                                                                       
+      REAL XF(ims:ime,jms:jme,NF)
+      REAL XF1(ims:ime,jms:jme,NF)
+!                                                                       
+      REAL Y(ims:ime,jms:jme,-IOR:IOR),    &
+           Z(ims:ime,jms:jme,-IOR:IOR),    &
+           F(ims:ime,jms:jme,0:1)                                       
+!
+      INTEGER I,J,II,JJ,IIM
+      INTEGER N2STAR, N2END, N1STAR, N1END
+!                                                                       
+      DATA  EP/ 1.E-10/                                                 
+!                                                                       
+!      PARAMETER(NONOS=1)                                                
+!      PARAMETER(N1OS=N1*NONOS+1-NONOS,N2OS=N2*NONOS+1-NONOS)            
+!                                                                       
+      REAL W(ims:ime,jms:jme),OV(ims:ime,jms:jme),UN(ims:ime,jms:jme)                     
+      REAL MXM(ims:ime,jms:jme),MN(ims:ime,jms:jme)                                 
+      REAL FL(ims:ime,jms:jme,0:1)                                            
+      REAL XIG(81), XJG(81)  ! won't use but nine of these fellers.
+      INTEGER IFRST
+      integer rr
+      COMMON /DEPAR2B/ XIG,XJG,IFRST
+      DATA IFRST /1/
+
+      REAL rioff, rjoff
+!                                                                       
+      REAL donor, y1, y2, a
+      DONOR(Y1,Y2,A)=(Y1*AMAX1(0.,SIGN(1.,A))-Y2*AMIN1(0.,SIGN(1.,A)))*A
+      REAL tr4, ym1, y0, yp1, yp2
+      TR4(YM1,Y0,YP1,YP2,A)=A*ONE12*(7.*(YP1+Y0)-(YP2+YM1))               &
+       -A*A*ONE24*(15.*(YP1-Y0)-(YP2-YM1))-A*A*A*ONE12*((YP1+Y0)          & 
+       -(YP2+YM1))+A*A*A*A*ONE24*(3.*(YP1-Y0)-(YP2-YM1))                
+      REAL pp, pn, x
+      PP(X)=AMAX1(0.,X)                                                 
+      PN(X)=AMIN1(0.,X)                                                 
+
+      rr = nint(sqrt(float(nf)))
+
+        rioff = 0
+        rjoff = 0
+        if(xstag .and. (mod(rr,2) .eq. 0)) rioff = 1.
+        if(ystag .and. (mod(rr,2) .eq. 0)) rjoff = 1.
+
+        DO I=1,rr
+          DO J=1,rr
+            XIG(J+(I-1)*rr)=(float(rr)-1.-rioff)/float(2*rr)-FLOAT(J-1)*1./float(rr)
+            XJG(J+(I-1)*rr)=(float(rr)-1.-rjoff)/float(2*rr)-FLOAT(I-1)*1./float(rr)   
+          ENDDO
+        ENDDO
+        IFRST = 0
+
+!!      ENDIF
+
+!      IF ( IFRST .EQ. 1 ) THEN
+!        DO I=1,3   
+!          DO J=1,3 
+!            XIG(J+(I-1)*3)=1./3.-FLOAT(J-1)*1./3.   
+!            XJG(J+(I-1)*3)=1./3.-FLOAT(I-1)*1./3.   
+!          ENDDO
+!        ENDDO
+!        IFRST = 0
+!      ENDIF
+!
+      N2STAR = jts
+      N2END  = jte
+      N1STAR = its
+      N1END  = ite
+
+      DO 2000 IIM=1,NF                                                  
+!                                                                       
+!  HERE STARTS RESIDUAL ADVECTION                                       
+!                                                                       
+        DO 9000 JJ=N2STAR,N2END                                         
+!cdir unroll=5
+          DO 50 J=-IOR,IOR                                              
+
+!cdir unroll=5
+            DO 51 I=-IOR,IOR                                            
+              DO 511 II=N1STAR,N1END                                    
+                Y(II,JJ,I)=XF1(II+I,JJ+J,IIM)              
+  511         CONTINUE
+   51       CONTINUE                                                    
+
+            DO 811 II=N1STAR,N1END                                      
+              FL(II,JJ,0)=DONOR(Y(II,JJ,-1),Y(II,JJ,0),XIG(IIM))        
+              FL(II,JJ,1)=DONOR(Y(II,JJ,0),Y(II,JJ,1),XIG(IIM))           
+  811         CONTINUE
+            DO 812 II=N1STAR,N1END                                      
+              W(II,JJ)=Y(II,JJ,0)-(FL(II,JJ,1)-FL(II,JJ,0))               
+  812         CONTINUE
+            DO 813 II=N1STAR,N1END                                      
+              MXM(II,JJ)=                                             &
+                       AMAX1(Y(II,JJ,-1),Y(II,JJ,0),Y(II,JJ,1),       &
+                       W(II,JJ))                                      
+              MN(II,JJ)=AMIN1(Y(II,JJ,-1),Y(II,JJ,0),Y(II,JJ,1),W(II,JJ)) 
+  813         CONTINUE
+            DO 312 II=N1STAR,N1END                                      
+              F(II,JJ,0)=                                               &
+                         TR4(Y(II,JJ,-2),Y(II,JJ,-1),Y(II,JJ,0),        &
+                         Y(II,JJ,1),XIG(IIM))                           
+              F(II,JJ,1)=                                                 &
+                       TR4(Y(II,JJ,-1),Y(II,JJ,0),Y(II,JJ,1),Y(II,JJ,2),&
+                       XIG(IIM))                                        
+  312         CONTINUE
+            DO 822 II=N1STAR,N1END                                      
+              F(II,JJ,0)=F(II,JJ,0)-FL(II,JJ,0)                         
+              F(II,JJ,1)=F(II,JJ,1)-FL(II,JJ,1)                           
+  822         CONTINUE
+            DO 823 II=N1STAR,N1END                                      
+              OV(II,JJ)=(MXM(II,JJ)-W(II,JJ))/(-PN(F(II,JJ,1))+         &
+                      PP(F(II,JJ,0))+EP)                              
+              UN(II,JJ)=(W(II,JJ)-MN(II,JJ))/(PP(F(II,JJ,1))-             &
+                    PN(F(II,JJ,0))+EP)                                
+  823         CONTINUE
+            DO 824 II=N1STAR,N1END                                      
+              F(II,JJ,0)=PP(F(II,JJ,0))*AMIN1(1.,OV(II,JJ))+            &
+                         PN(F(II,JJ,0))*AMIN1(1.,UN(II,JJ))             
+              F(II,JJ,1)=PP(F(II,JJ,1))*AMIN1(1.,UN(II,JJ))+            &
+                         PN(F(II,JJ,1))*AMIN1(1.,OV(II,JJ))             
+  824         CONTINUE                                                    
+            DO 825 II=N1STAR,N1END                                      
+              Y(II,JJ,0)=W(II,JJ)-(F(II,JJ,1)-F(II,JJ,0))                 
+  825         CONTINUE
+            DO 361 II=N1STAR,N1END                                      
+              Z(II,JJ,J)=Y(II,JJ,0)                                       
+  361         CONTINUE
+!                                                                       
+!  END IF FIRST J LOOP                                                  
+!                                                                       
+ 8000       CONTINUE                                                    
+   50     CONTINUE                                                      
+
+          DO 911 II=N1STAR,N1END                                        
+            FL(II,JJ,0)=DONOR(Z(II,JJ,-1),Z(II,JJ,0),XJG(IIM))          
+            FL(II,JJ,1)=DONOR(Z(II,JJ,0),Z(II,JJ,1),XJG(IIM))             
+  911       CONTINUE
+          DO 912 II=N1STAR,N1END                                        
+            W(II,JJ)=Z(II,JJ,0)-(FL(II,JJ,1)-FL(II,JJ,0))                 
+  912       CONTINUE
+          DO 913 II=N1STAR,N1END                                        
+            MXM(II,JJ)=AMAX1(Z(II,JJ,-1),Z(II,JJ,0),Z(II,JJ,1),W(II,JJ))
+            MN(II,JJ)=AMIN1(Z(II,JJ,-1),Z(II,JJ,0),Z(II,JJ,1),W(II,JJ))   
+  913       CONTINUE
+          DO 412 II=N1STAR,N1END                                        
+            F(II,JJ,0)=                                                 &
+                       TR4(Z(II,JJ,-2),Z(II,JJ,-1),Z(II,JJ,0),Z(II,JJ,1)&
+                       ,XJG(IIM))                                       
+            F(II,JJ,1)=                                                   &
+                       TR4(Z(II,JJ,-1),Z(II,JJ,0),Z(II,JJ,1),Z(II,JJ,2),  &
+                       XJG(IIM))                                          
+  412       CONTINUE
+          DO 922 II=N1STAR,N1END                                        
+            F(II,JJ,0)=F(II,JJ,0)-FL(II,JJ,0)                           
+            F(II,JJ,1)=F(II,JJ,1)-FL(II,JJ,1)                             
+  922       CONTINUE
+          DO 923 II=N1STAR,N1END                                        
+            OV(II,JJ)=(MXM(II,JJ)-W(II,JJ))/(-PN(F(II,JJ,1))+           &
+                      PP(F(II,JJ,0))+EP)                                
+            UN(II,JJ)=(W(II,JJ)-MN(II,JJ))/(PP(F(II,JJ,1))-PN(F(II,JJ,0))+ &
+                    EP)                                                 
+  923       CONTINUE
+          DO 924 II=N1STAR,N1END                                        
+            F(II,JJ,0)=PP(F(II,JJ,0))*AMIN1(1.,OV(II,JJ))+PN(F(II,JJ,0))  &
+                       *AMIN1(1.,UN(II,JJ))                             
+            F(II,JJ,1)=PP(F(II,JJ,1))*AMIN1(1.,UN(II,JJ))+PN(F(II,JJ,1))  &
+                       *AMIN1(1.,OV(II,JJ))                             
+  924     CONTINUE                                                      
+ 9000   CONTINUE                                                        
+        DO 925 JJ=N2STAR,N2END                                          
+          DO 925 II=N1STAR,N1END                                        
+            XF(II,JJ,IIM)=W(II,JJ)-(F(II,JJ,1)-F(II,JJ,0))                
+  925     CONTINUE
+                                                                        
+!                                                                       
+ 2000 CONTINUE                                                          
+      RETURN                                                            
+      END                                                               
+                                                                        
+
Index: trunk/WRF.COMMON/WRFV2/share/solve_em.int
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/solve_em.int	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/solve_em.int	(revision 2744)
@@ -0,0 +1,18 @@
+SUBROUTINE solve_em      ( grid , config_flags     &
+!
+#include <em_dummy_new_args.inc>
+!
+                 )
+
+   USE module_domain
+   USE module_configure
+   USE module_driver_constants
+
+   !  Input data.
+   TYPE(domain) , INTENT(INOUT)                  :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)      :: config_flags
+
+#include <em_dummy_new_decl.inc>
+
+END SUBROUTINE solve_em
+
Index: trunk/WRF.COMMON/WRFV2/share/solve_interface.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/solve_interface.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/solve_interface.F	(revision 2744)
@@ -0,0 +1,115 @@
+!WRF:MEDIATION_LAYER:ADT_BARRIER
+!
+
+SUBROUTINE solve_interface ( grid ) 
+
+   USE module_domain
+   USE module_timing
+   USE module_driver_constants
+   USE module_configure
+   USE module_wrf_error
+
+   IMPLICIT NONE
+
+   INTERFACE
+#if (EM_CORE == 1 && DA_CORE != 1)
+# include  <solve_em.int>
+#endif
+#if (NMM_CORE == 1)
+# include  <solve_nmm.int>
+#endif
+#if (COAMPS_CORE == 1)
+# include  <solve_coamps.int>
+#endif
+#if (EXP_CORE == 1)
+# include  <solve_exp.int>
+#endif
+   END INTERFACE
+
+   TYPE(domain) , INTENT(INOUT)  :: grid
+   TYPE (grid_config_rec_type)   :: config_flags
+
+   INTEGER     :: idum1, idum2
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+   CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
+
+#include "deref_kludge.h"
+
+   IF ( config_flags%dyn_opt == DYN_NODYN  ) THEN
+
+     CALL wrf_debug( 1 , "solve_interface: dynamics disabled\n" )
+
+#if (EM_CORE == 1 && DA_CORE != 1)
+   ELSE IF ( config_flags%dyn_opt == DYN_EM  ) THEN
+     CALL solve_em  ( grid , config_flags  &
+!
+# include <em_actual_new_args.inc>
+!
+               )
+
+# ifdef WRF_CHEM
+   IF ( config_flags%chem_opt > 0  ) THEN
+
+     CALL chem_driver  ( grid , config_flags  &
+!
+# include <em_actual_new_args.inc>
+!
+               )
+   ENDIF
+# endif
+#endif
+#if (NMM_CORE == 1)
+   ELSE IF ( config_flags%dyn_opt == DYN_NMM  ) THEN
+     CALL solve_nmm  ( grid , config_flags   &
+!
+# include <nmm_actual_args.inc>
+!
+               )
+# ifdef WRF_CHEM
+   IF ( config_flags%chem_opt > 0  ) THEN
+
+     CALL chem_driver  ( grid , config_flags  &
+!
+# include <nmm_actual_new_args.inc>
+!  
+               )
+   ENDIF
+# endif
+#endif
+#if (COAMPS_CORE == 1)
+   ELSE IF ( config_flags%dyn_opt == DYN_COAMPS  ) THEN
+     CALL solve_coamps  ( grid , config_flags   &
+!
+# include <coamps_actual_args.inc>
+!
+               )
+#endif
+
+! ###### 4. Edit share/solve_interface.F to add call to experimental core
+
+#if (EXP_CORE == 1)
+   ELSE IF ( config_flags%dyn_opt == DYN_EXP  ) THEN
+     CALL solve_exp  ( grid              &
+!
+# include <exp_actual_args.inc>
+!
+               )
+#endif
+
+   ELSE
+
+     WRITE( wrf_err_message , * ) 'Invalid dynamics option: dyn_opt = ',config_flags%dyn_opt
+     CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+     
+   END IF
+
+END SUBROUTINE solve_interface
+
Index: trunk/WRF.COMMON/WRFV2/share/solve_nmm.int
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/solve_nmm.int	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/solve_nmm.int	(revision 2744)
@@ -0,0 +1,19 @@
+
+SUBROUTINE solve_nmm      ( grid , config_flags     &
+!
+#include <nmm_dummy_args.inc>
+!
+                 )
+
+   USE module_domain
+   USE module_configure
+   USE module_driver_constants
+
+   !  Input data.
+   TYPE(domain) , INTENT(INOUT)                  :: grid
+   TYPE (grid_config_rec_type) , INTENT(IN)      :: config_flags
+
+#include <nmm_dummy_decl.inc>
+
+END SUBROUTINE solve_nmm
+
Index: trunk/WRF.COMMON/WRFV2/share/start_domain.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/start_domain.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/start_domain.F	(revision 2744)
@@ -0,0 +1,73 @@
+!WRF:MEDIATION_LAYER:ADT_BARRIER
+!
+
+SUBROUTINE start_domain ( grid , allowed_to_read )
+
+   USE module_domain
+   USE module_configure
+
+   IMPLICIT NONE
+
+   !  Input Arguments.
+   TYPE (domain)          :: grid
+   LOGICAL, INTENT(IN)    :: allowed_to_read
+   !  Local data.
+   INTEGER                :: dyn_opt
+   INTEGER :: idum1, idum2
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+#include "deref_kludge.h"
+
+   CALL nl_get_dyn_opt( 1, dyn_opt )
+  
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+   IF (      dyn_opt .eq. DYN_NODYN ) THEN
+
+#if ((EM_CORE == 1) && (DA_CORE != 1))
+   ELSE IF (      dyn_opt .eq. DYN_EM ) THEN
+
+     CALL start_domain_em( grid, allowed_to_read  &
+!
+# include <em_actual_new_args.inc>
+!
+                         )
+#endif
+#if (NMM_CORE == 1)
+   ELSE IF (      dyn_opt .eq. DYN_NMM ) THEN
+     CALL start_domain_nmm( grid, allowed_to_read   &
+!
+# include <nmm_actual_args.inc>
+!
+                         )
+#endif
+#if (COAMPS_CORE == 1)
+   ELSE IF (      dyn_opt .eq. DYN_COAMPS ) THEN
+     CALL start_domain_coamps( grid, allowed_to_read   &
+!
+# include <coamps_actual_args.inc>
+!
+                         )
+#endif
+
+!### 4a. edit share/start_domain.F to call domain inits for core if any
+
+#if (EXP_CORE == 1)
+   ELSE IF (      dyn_opt .eq. DYN_EXP ) THEN
+#endif
+
+   ELSE
+
+     WRITE(0,*)' start_domain: unknown or unimplemented dyn_opt = ',dyn_opt
+     CALL wrf_error_fatal ( ' start_domain: unknown or unimplemented dyn_opt ' ) 
+   ENDIF
+
+
+END SUBROUTINE start_domain
+
Index: trunk/WRF.COMMON/WRFV2/share/start_domain_em.int
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/start_domain_em.int	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/start_domain_em.int	(revision 2744)
@@ -0,0 +1,18 @@
+
+SUBROUTINE start_domain_em      ( grid      &
+!
+#include <em_dummy_args.inc>
+!
+                 )
+
+   USE module_domain
+   USE module_driver_constants
+
+   !  Input data.
+   TYPE(domain) , INTENT(INOUT)         :: grid
+
+#include <em_dummy_decl.inc>
+
+
+END SUBROUTINE start_domain_em
+
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist10in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist10in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist10in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist10in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist10in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist10out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist10out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist10out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist10out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist10out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist11in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist11in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist11in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist11in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist11in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist11out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist11out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist11out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist11out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist11out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist1in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist1in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist1in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist1in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt( 1, dyn_opt )
+
+#include <wrf_auxhist1in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist1out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist1out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist1out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist1out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist1out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist2in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist2in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist2in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist2in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist2in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist2out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist2out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist2out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist2out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist2out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist3in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist3in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist3in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist3in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist3in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist3out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist3out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist3out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist3out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist3out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist4in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist4in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist4in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist4in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist4in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist4out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist4out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist4out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist4out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist4out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist5in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist5in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist5in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist5in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist5in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist5out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist5out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist5out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist5out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist5out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist6in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist6in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist6in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist6in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist6in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist6out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist6out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist6out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist6out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist6out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist7in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist7in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist7in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist7in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist7in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist7out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist7out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist7out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist7out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist7out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist8in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist8in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist8in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist8in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist8in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist8out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist8out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist8out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist8out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist8out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist9in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist9in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist9in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxhist9in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxhist9in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxhist9out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxhist9out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxhist9out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxhist9out ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxhist9out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput10in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput10in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput10in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput10in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput10in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput10out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput10out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput10out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput10out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput10out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput11in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput11in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput11in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput11in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput11in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput11out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput11out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput11out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput11out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput11out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput1in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput1in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput1in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput1in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput1in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput1out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput1out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput1out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput1out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput1out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput2in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput2in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput2in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput2in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput2in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput2out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput2out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput2out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput2out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput2out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput3in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput3in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput3in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput3in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput3in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput3out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput3out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput3out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput3out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput3out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput4in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput4in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput4in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput4in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput4in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput4out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput4out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput4out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput4out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput4out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput5in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput5in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput5in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput5in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput5in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput5out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput5out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput5out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput5out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput5out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput6in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput6in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput6in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput6in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput6in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput6out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput6out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput6out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput6out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput6out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput7in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput7in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput7in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput7in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput7in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput7out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput7out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput7out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput7out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput7out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput8in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput8in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput8in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput8in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput8in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput8out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput8out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput8out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput8out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput8out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput9in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput9in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput9in.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_auxinput9in ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_auxinput9in.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_auxinput9out.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_auxinput9out.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_auxinput9out.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_auxinput9out ( fid , grid , config_flags, switch , &
+                                dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_auxinput9out.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_bdyin.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_bdyin.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_bdyin.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_bdyin ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_bdyin.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_bdyout.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_bdyout.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_bdyout.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_bdyout ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_bdyout.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_ext_read_field.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_ext_read_field.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_ext_read_field.F	(revision 2744)
@@ -0,0 +1,89 @@
+!WRF:MEDIATION:IO
+  SUBROUTINE wrf_ext_read_field( DataHandle,DateStr,Var,Field,FieldType,Comm,IOComm, &
+                                 DomainDesc, bdy_mask, MemoryOrder,Stagger,             &
+                                 debug_message ,                              &
+                                 ds1, de1, ds2, de2, ds3, de3,                &
+                                 ms1, me1, ms2, me2, ms3, me3,                &
+                                 ps1, pe1, ps2, pe2, ps3, pe3, Status          )
+    USE module_io
+    USE module_wrf_error
+    IMPLICIT NONE
+
+    integer                                      :: DataHandle
+    character*(*)                                :: DateStr
+    character*(*)                                :: Var
+    integer                                      :: Field(*)
+    integer                                      :: FieldType
+    integer                                      :: Comm
+    integer                                      :: IOComm
+    integer                                      :: DomainDesc
+    logical, dimension(4)                        :: bdy_mask
+    character*(*)                                :: MemoryOrder
+    character*(*)                                :: Stagger
+    character*(*)                                :: debug_message
+
+    INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
+                                     ms1, me1, ms2, me2, ms3, me3, &
+                                     ps1, pe1, ps2, pe2, ps3, pe3
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*80 , DIMENSION(3) :: dimnames
+
+    integer                       ,intent(inout)   :: Status
+
+    domain_start(1) = ds1 ; domain_end(1) = de1 ;
+    patch_start(1)  = ps1 ; patch_end(1)  = pe1 ;
+    memory_start(1) = ms1 ; memory_end(1) = me1 ;
+    domain_start(2) = ds2 ; domain_end(2) = de2 ;
+    patch_start(2)  = ps2 ; patch_end(2)  = pe2 ;
+    memory_start(2) = ms2 ; memory_end(2) = me2 ;
+    domain_start(3) = ds3 ; domain_end(3) = de3 ;
+    patch_start(3)  = ps3 ; patch_end(3)  = pe3 ;
+    memory_start(3) = ms3 ; memory_end(3) = me3 ;
+
+    CALL debug_io_wrf ( debug_message,DateStr,                          &
+                        domain_start,domain_end,patch_start,patch_end,  &
+                        memory_start,memory_end                          )
+
+    Status = 1
+    if ( de1 - ds1 < 0 ) return
+    if ( de2 - ds2 < 0 ) return
+    if ( de3 - ds3 < 0 ) return
+    if ( pe1 - ps1 < 0 ) return
+    if ( pe2 - ps2 < 0 ) return
+    if ( pe3 - ps3 < 0 ) return
+    if ( me1 - ms1 < 0 ) return
+    if ( me2 - ms2 < 0 ) return
+    if ( me3 - ms3 < 0 ) return
+    Status = 0
+
+    CALL wrf_read_field (   &
+                       DataHandle                 &  ! DataHandle
+                      ,DateStr                    &  ! DateStr
+                      ,Var                        &  ! Data Name
+                      ,Field                      &  ! Field
+                      ,FieldType                  &  ! FieldType
+                      ,Comm                       &  ! Comm
+                      ,IOComm                     &  ! IOComm
+                      ,DomainDesc                 &  ! DomainDesc
+                      ,bdy_mask                   &  ! bdy_mask
+                      ,MemoryOrder                &  ! MemoryOrder
+                      ,Stagger                    &  ! Stagger
+                      ,dimnames                   &  ! JMMOD 1109
+                      ,domain_start               &  ! DomainStart
+                      ,domain_end                 &  ! DomainEnd
+                      ,memory_start               &  ! MemoryStart
+                      ,memory_end                 &  ! MemoryEnd
+                      ,patch_start                &  ! PatchStart
+                      ,patch_end                  &  ! PatchEnd
+                      ,Status )
+    IF ( wrf_at_debug_level(300) ) THEN
+      WRITE(wrf_err_message,*) debug_message,' Status = ',Status
+      CALL wrf_message ( TRIM(wrf_err_message) )
+    ENDIF
+
+  END SUBROUTINE wrf_ext_read_field
+
Index: trunk/WRF.COMMON/WRFV2/share/wrf_ext_write_field.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_ext_write_field.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_ext_write_field.F	(revision 2744)
@@ -0,0 +1,190 @@
+!WRF:MEDIATION:IO
+  SUBROUTINE wrf_ext_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm,IOComm, &
+                                 DomainDesc,                      &
+                                 bdy_mask   ,                     &
+                                 dryrun        ,                  &
+                                 MemoryOrder,                     &
+                                 Stagger,                         &
+                                 Dimname1, Dimname2, Dimname3 ,   &
+                                 Desc, Units,                     &
+                                 debug_message ,                              &
+                                 ds1, de1, ds2, de2, ds3, de3,                &
+                                 ms1, me1, ms2, me2, ms3, me3,                &
+                                 ps1, pe1, ps2, pe2, ps3, pe3, Status          )
+    USE module_io
+    USE module_wrf_error
+    USE module_state_description
+    USE module_timing
+    IMPLICIT NONE
+
+    INTEGER       itrace
+    integer                                      :: DataHandle
+    character*(*)                                :: DateStr
+    character*(*)                                :: Var
+    integer                                      :: Field(*)
+    integer                                      :: FieldType
+    integer                                      :: Comm
+    integer                                      :: IOComm
+    integer                                      :: DomainDesc
+    logical                                      :: dryrun
+    character*(*)                                :: MemoryOrder
+    logical, dimension(4)                        :: bdy_mask
+    character*(*)                                :: Stagger
+    character*(*)                                :: Dimname1, Dimname2, Dimname3
+    character*(*)                                :: Desc, Units
+    character*(*)                                :: debug_message
+
+    INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
+                                     ms1, me1, ms2, me2, ms3, me3, &
+                                     ps1, pe1, ps2, pe2, ps3, pe3
+
+    
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*80 , DIMENSION(3) :: dimnames
+
+    integer                       ,intent(inout)   :: Status
+    LOGICAL for_out, horiz_stagger
+    INTEGER Hndl, io_form
+    LOGICAL, EXTERNAL :: has_char
+
+    IF ( wrf_at_debug_level( 500 ) ) THEN
+      call start_timing
+    ENDIF
+    domain_start(1) = ds1 ; domain_end(1) = de1 ;
+    patch_start(1)  = ps1 ; patch_end(1)  = pe1 ;
+    memory_start(1) = ms1 ; memory_end(1) = me1 ;
+    domain_start(2) = ds2 ; domain_end(2) = de2 ;
+    patch_start(2)  = ps2 ; patch_end(2)  = pe2 ;
+    memory_start(2) = ms2 ; memory_end(2) = me2 ;
+    domain_start(3) = ds3 ; domain_end(3) = de3 ;
+    patch_start(3)  = ps3 ; patch_end(3)  = pe3 ;
+    memory_start(3) = ms3 ; memory_end(3) = me3 ;
+
+    dimnames(1) = Dimname1
+    dimnames(2) = Dimname2
+    dimnames(3) = Dimname3
+
+    CALL debug_io_wrf ( debug_message,DateStr,                          &
+                        domain_start,domain_end,patch_start,patch_end,  &
+                        memory_start,memory_end                          )
+    Status = 1
+    if ( de1 - ds1 < 0 ) return
+    if ( de2 - ds2 < 0 ) return
+    if ( de3 - ds3 < 0 ) return
+    if ( pe1 - ps1 < 0 ) return
+    if ( pe2 - ps2 < 0 ) return
+    if ( pe3 - ps3 < 0 ) return
+    if ( me1 - ms1 < 0 ) return
+    if ( me2 - ms2 < 0 ) return
+    if ( me3 - ms3 < 0 ) return
+    Status = 0
+
+
+    CALL wrf_write_field (   &
+                       DataHandle                 &  ! DataHandle
+                      ,DateStr                    &  ! DateStr
+                      ,Var                        &  ! Data Name
+                      ,Field                      &  ! Field
+                      ,FieldType                  &  ! FieldType
+                      ,Comm                       &  ! Comm
+                      ,IOComm                     &  ! IOComm
+                      ,DomainDesc                 &  ! DomainDesc
+                      ,bdy_mask                   &  ! bdy_mask
+                      ,MemoryOrder                &  ! MemoryOrder
+                      ,Stagger                    &  ! JMMODS 010620
+                      ,dimnames                   &  ! JMMODS 001109
+                      ,domain_start               &  ! DomainStart
+                      ,domain_end                 &  ! DomainEnd
+                      ,memory_start               &  ! MemoryStart
+                      ,memory_end                 &  ! MemoryEnd
+                      ,patch_start                &  ! PatchStart
+                      ,patch_end                  &  ! PatchEnd
+                      ,Status )
+
+    CALL get_handle ( Hndl, io_form , for_out, DataHandle )
+
+    IF ( ( dryrun .AND. ( io_form .EQ. IO_NETCDF .OR. io_form .EQ. IO_PNETCDF ) ) .OR. &
+                        ( io_form .EQ. IO_PHDF5  )   ) THEN
+      CALL wrf_put_var_ti_char( &
+                       DataHandle                 &  ! DataHandle
+                      ,"description"              &  ! Element
+                      ,Var                        &  ! Data Name
+                      ,Desc                       &  ! Data
+                      ,Status )
+      CALL wrf_put_var_ti_char( &
+                       DataHandle                 &  ! DataHandle
+                      ,"units"                    &  ! Element
+                      ,Var                        &  ! Data Name
+                      ,Units                      &  ! Data
+                      ,Status )
+      CALL wrf_put_var_ti_char( &
+                       DataHandle                 &  ! DataHandle
+                      ,"stagger"                  &  ! Element
+                      ,Var                        &  ! Data Name
+                      ,Stagger                    &  ! Data
+                      ,Status )
+#if (EM_CORE == 1)
+! TBH:  Added "coordinates" metadata for GIS folks in RAL.  It is a step 
+! TBH:  towards CF.  This change was requested by Jennifer Boehnert based 
+! TBH:  upon a suggestion from Nawajish Noman.  
+! TBH:  TODO:  This code depends upon longitude and latitude arrays being 
+! TBH:         named "XLONG", "XLAT", "XLONG_U", "XLAT_U", "XLONG_V", and 
+! TBH:         "XLAT_V" for EM_CORE.  We need a more general way to handle 
+! TBH:         this, possibly via the Registry.  
+! TBH:  TODO:  Leave this on all the time or make it namelist-selectable?  
+! TBH:  TODO:  Use dimnames(*) == south_north || west_east instead of 
+! TBH:         MemoryOrder and Stagger?  It would also work for both ARW 
+! TBH:         and NMM and be easier to handle via Registry...  
+!      IF ( ( ( MemoryOrder(1:2) == 'XY' ) .OR. &
+!             ( MemoryOrder(1:3) == 'XZY' ) ) .AND. &
+!           ( Var(1:5) /= 'XLONG' ) .AND. &
+!           ( Var(1:4) /= 'XLAT'  ) ) THEN
+! JM used trim instead, to avoid spurious errors when bounds checking on
+      IF ( ( ( TRIM(MemoryOrder) == 'XY' ) .OR. &
+             ( TRIM(MemoryOrder) == 'XZY' ) ) .AND. &
+           ( TRIM(Var) /= 'XLONG' ) .AND. &
+           ( TRIM(Var) /= 'XLAT'  ) ) THEN
+        horiz_stagger = .FALSE.
+        IF ( LEN_TRIM(Stagger) == 1 ) THEN
+          IF ( has_char( Stagger, 'x' ) ) THEN
+            horiz_stagger = .TRUE.
+            CALL wrf_put_var_ti_char( &
+                             DataHandle                 &  ! DataHandle
+                            ,"coordinates"              &  ! Element
+                            ,Var                        &  ! Data Name
+                            ,"XLONG_U XLAT_U"           &  ! Data
+                            ,Status )
+          ELSE IF ( has_char( Stagger, 'y' ) ) THEN
+            horiz_stagger = .TRUE.
+            CALL wrf_put_var_ti_char( &
+                             DataHandle                 &  ! DataHandle
+                            ,"coordinates"              &  ! Element
+                            ,Var                        &  ! Data Name
+                            ,"XLONG_V XLAT_V"           &  ! Data
+                            ,Status )
+          ENDIF
+        ENDIF
+        IF ( .NOT. horiz_stagger ) THEN
+          CALL wrf_put_var_ti_char( &
+                           DataHandle                 &  ! DataHandle
+                          ,"coordinates"              &  ! Element
+                          ,Var                        &  ! Data Name
+                          ,"XLONG XLAT"               &  ! Data
+                          ,Status )
+        ENDIF
+      ENDIF
+#endif
+    ENDIF
+
+    IF ( wrf_at_debug_level(300) ) THEN
+      WRITE(wrf_err_message,*) debug_message,' Status = ',Status
+      CALL wrf_message ( TRIM(wrf_err_message) )
+    ENDIF
+
+    IF ( wrf_at_debug_level( 500 ) ) THEN
+      CALL end_timing('wrf_ext_write_field')
+    ENDIF
+
+  END SUBROUTINE wrf_ext_write_field
Index: trunk/WRF.COMMON/WRFV2/share/wrf_fddaobs_in.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_fddaobs_in.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_fddaobs_in.F	(revision 2744)
@@ -0,0 +1,1682 @@
+!WRF:MEDIATION_LAYER:IO
+!  ---
+
+! This obs-nudging FDDA module (RTFDDA) is developed by the 
+! NCAR/RAL/NSAP (National Security Application Programs), under the 
+! sponsorship of ATEC (Army Test and Evaluation Commands). ATEC is 
+! acknowledged for releasing this capability for WRF community 
+! research applications.
+!
+! The NCAR/RAL RTFDDA module was adapted, and significantly modified 
+! from the obs-nudging module in the standard MM5V3.1 which was originally 
+! developed by PSU (Stauffer and Seaman, 1994). 
+! 
+! Yubao Liu (NCAR/RAL): lead developer of the RTFDDA module 
+! Al Bourgeois (NCAR/RAL): lead engineer implementing RTFDDA into WRF-ARW
+! Nov. 2006
+! 
+! References:
+!   
+!   Liu, Y., A. Bourgeois, T. Warner, S. Swerdlin and J. Hacker, 2005: An
+!     implementation of obs-nudging-based FDDA into WRF for supporting 
+!     ATEC test operations. 2005 WRF user workshop. Paper 10.7.
+!
+!   Liu, Y., A. Bourgeois, T. Warner, S. Swerdlin and W. Yu, 2006: An update 
+!     on "obs-nudging"-based FDDA for WRF-ARW: Verification using OSSE 
+!     and performance of real-time forecasts. 2006 WRF user workshop. Paper 4.7. 
+
+!   
+!   Stauffer, D.R., and N.L. Seaman, 1994: Multi-scale four-dimensional data 
+!     assimilation. J. Appl. Meteor., 33, 416-434.
+!
+!   http://www.rap.ucar.edu/projects/armyrange/references.html
+!
+
+  SUBROUTINE wrf_fddaobs_in (grid ,config_flags)
+
+    USE module_domain
+    USE module_configure
+    USE module_model_constants        !rovg
+
+    IMPLICIT NONE
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(IN)    :: config_flags
+#if ( EM_CORE == 1 )
+
+! Local variables
+    integer            :: ktau            ! timestep index corresponding to xtime
+    integer            :: krest           ! restart timestep
+    integer            :: inest           ! nest level
+    integer            :: infreq          ! input frequency
+    integer            :: nstlev          ! nest level
+    real               :: dtmin           ! dt in minutes
+    real               :: xtime           ! forecast time in minutes
+    logical            :: iprt_in4dob     ! print flag
+
+
+!   Modified to also call in4dob intially, since subr in4dob is no
+!   longer called from subr fddaobs_init. Note that itimestep is now
+!   the model step BEFORE the model integration step, because this
+!   routine is now called by med_before_solve_io.
+    ktau   = grid%itimestep               ! ktau corresponds to xtime
+    krest  = grid%fdob%ktaur
+    inest  = grid%grid_id
+    nstlev = grid%fdob%levidn(inest) 
+    infreq = grid%obs_ionf*(grid%parent_grid_ratio**nstlev)
+    iprt_in4dob = grid%obs_ipf_in4dob
+
+    IF( (ktau.GT.krest.AND.MOD(ktau,infreq).EQ.0)                            &
+                                         .OR.(ktau.EQ.krest) ) then
+! Calculate forecast time.
+      dtmin = grid%dt/60.
+      xtime = dtmin*grid%itimestep
+
+      CALL in4dob(inest, xtime, ktau, krest, dtmin, grid%julday, grid%gmt,       &
+                  grid%obs_nudge_opt,  grid%obs_nudge_wind, grid%obs_nudge_temp, &
+                  grid%obs_nudge_mois, grid%obs_nudge_pstr, grid%obs_coef_wind,  & 
+                  grid%obs_coef_temp,  grid%obs_coef_mois,  grid%obs_coef_pstr,  &
+                  grid%obs_rinxy,      grid%obs_rinsig,     grid%obs_twindo,     &
+                  grid%obs_npfi,       grid%obs_ionf,       grid%obs_idynin,     &
+                  grid%obs_dtramp,     grid%fdob,           grid%fdob%varobs,    &
+                  grid%fdob%timeob,    grid%fdob%nlevs_ob,  grid%fdob%lev_in_ob, &
+                  grid%fdob%plfo,      grid%fdob%elevob,    grid%fdob%rio,       &
+                  grid%fdob%rjo,       grid%fdob%rko,                            & 
+                  model_config_rec%cen_lat(1),                                   &
+                  model_config_rec%cen_lon(1),                                   &
+                  config_flags%truelat1, config_flags%truelat2,                  &
+                  rovg, grid%fdob%xn, grid%fdob%ds_cg, t0,                       &
+                  grid%fdob%sn_maxcg, grid%fdob%we_maxcg, config_flags%map_proj, &
+                  model_config_rec%parent_grid_ratio,                            &
+                  model_config_rec%i_parent_start(inest),                        &
+                  model_config_rec%j_parent_start(inest),                        &
+                  model_config_rec%nobs_ndg_vars, grid%max_obs, iprt_in4dob)
+    ENDIF
+
+    RETURN
+#endif
+  END SUBROUTINE wrf_fddaobs_in
+#if ( EM_CORE == 1 )
+!------------------------------------------------------------------------------
+! Begin subroutine in4dob and its subroutines
+!------------------------------------------------------------------------------
+  SUBROUTINE in4dob(inest, xtime, ktau, ktaur, dtmin, julday, gmt,       &
+                    nudge_opt, iswind, istemp,                           &
+                    ismois, ispstr, giv,                                 &
+                    git, giq, gip,                                       &
+                    rinxy, rinsig, twindo,                               &
+                    npfi, ionf, idynin,                                  &
+                    dtramp, fdob, varobs,                                &
+                    timeob, nlevs_ob, lev_in_ob,                         &
+                    plfo, elevob, rio,                                   &
+                    rjo, rko,                                            &
+                    xlatc_cg,                                            &
+                    xlonc_cg,                                            &
+                    true_lat1, true_lat2,                                &
+                    rovg, xn, dscg, t0,                                  &
+                    sn_maxcg, we_maxcg, map_proj,                        &
+                    parent_grid_ratio,                                   &
+                    i_parent_start,                                      &
+                    j_parent_start,                                      &
+                    nndgv, niobf, iprt)
+
+  USE module_domain
+  USE module_model_constants, ONLY : rcp
+  IMPLICIT NONE
+
+! THIS IS SUBROUTINE READS AN OBSERVATION DATA FILE AND
+! SELECTS ONLY THOSE VALUES OBSERVED AT TIMES THAT FALL
+! WITHIN A TIME WINDOW (TWINDO) CENTERED ABOUT THE CURRENT
+! FORECAST TIME (XTIME).  THE INCOMING OBS FILES MUST BE
+! IN CHRONOLOGICAL ORDER.
+!
+! NOTE: This routine was originally designed for MM5, which uses
+!       a nonstandard (I,J) coordinate system. For WRF, I is the 
+!       east-west running coordinate, and J is the south-north
+!       running coordinate. So "J-slab" here is west-east in
+!       extent, not south-north as for MM5. RIO and RJO have
+!       the opposite orientation here as for MM5. -ajb 06/10/2004
+
+! NOTE - IN4DOB IS CALLED ONLY FOR THE COARSE MESH TIMES                         IN4DOB.10
+!      - VAROBS(IVAR,N) HOLDS THE OBSERVATIONS.                                  IN4DOB.11
+!        IVAR=1   UOBS                                                           IN4DOB.12
+!        IVAR=2   VOBS                                                           IN4DOB.13
+!        IVAR=3   TOBS                                                           IN4DOB.14
+!        IVAR=4   QOBS                                                           IN4DOB.15
+!        IVAR=5   PSOBS (CROSS)                                                  IN4DOB.16
+
+  INTEGER, intent(in) :: niobf          ! maximum number of observations
+  INTEGER, intent(in) :: nndgv          ! number of nudge variables
+  INTEGER, intent(in)  :: INEST         ! nest level
+  REAL, intent(in)     :: xtime         ! model time in minutes
+  INTEGER, intent(in)  :: KTAU          ! current timestep
+  INTEGER, intent(in)  :: KTAUR         ! restart timestep
+  REAL, intent(in)     :: dtmin         ! dt in minutes
+  INTEGER, intent(in)  :: julday        ! Julian day
+  REAL, intent(in)     :: gmt           ! Greenwich Mean Time
+  INTEGER, intent(in)  :: nudge_opt     ! obs-nudge flag for this nest
+  INTEGER, intent(in)  :: iswind        ! nudge flag for wind
+  INTEGER, intent(in)  :: istemp        ! nudge flag for temperature
+  INTEGER, intent(in)  :: ismois        ! nudge flag for moisture
+  INTEGER, intent(in)  :: ispstr        ! nudge flag for pressure
+  REAL, intent(in)     :: giv           ! coefficient for wind
+  REAL, intent(in)     :: git           ! coefficient for temperature
+  REAL, intent(in)     :: giq           ! coefficient for moisture
+  REAL, intent(in)     :: gip           ! coefficient for pressure
+  REAL, intent(in)     :: rinxy         ! horizontal radius of influence (km)
+  REAL, intent(in)     :: rinsig        ! vertical radius of influence (on sigma)
+  REAL, intent(in)     :: twindo        ! (time window)/2 (min) for nudging
+  INTEGER, intent(in)  :: npfi          ! coarse-grid time-step frequency for diagnostics
+  INTEGER, intent(in)  :: ionf          ! coarse-grid time-step frequency for obs-nudging calcs
+  INTEGER, intent(in)  :: idynin        ! for dynamic initialization using a ramp-down function
+  REAL, intent(in)     :: dtramp        ! time period in minutes for ramping
+  TYPE(fdob_type), intent(inout)  :: fdob     ! derived data type for obs data
+  REAL, intent(inout) :: varobs(nndgv,niobf)  ! observational values in each variable
+  REAL, intent(inout) :: timeob(niobf)        ! model times for each observation (hours)
+  REAL, intent(inout) :: nlevs_ob(niobf)      ! numbers of levels in sounding obs
+  REAL, intent(inout) :: lev_in_ob(niobf)     ! level in sounding-type obs
+  REAL, intent(inout) :: plfo(niobf)          ! index for type of obs-platform
+  REAL, intent(inout) :: elevob(niobf)        ! elevations of observations  (meters)
+  REAL, intent(inout) :: rio(niobf)           ! west-east grid coordinate
+  REAL, intent(inout) :: rjo(niobf)           ! south-north grid coordinate
+  REAL, intent(inout) :: rko(niobf)           ! vertical grid coordinate
+  REAL, intent(in) :: xlatc_cg                ! coarse grid center latitude 
+  REAL, intent(in) :: xlonc_cg                ! coarse grid center longiture
+  REAL, intent(in) :: true_lat1               ! truelat1 for Lambert map projection
+  REAL, intent(in) :: true_lat2               ! truelat2 for Lambert map projection
+  REAL, intent(in) :: rovg                    ! constant rho over g
+  REAL, intent(in) :: xn                      ! cone factor for Lambert projection
+  REAL, intent(in) :: dscg                    ! coarse grid size (km)
+  REAL, intent(in) :: t0                      ! background temperature
+  INTEGER, intent(in) :: sn_maxcg             ! maximum coarse grid south-north coordinate
+  INTEGER, intent(in) :: we_maxcg             ! maximum coarse grid west-east   coordinate
+  INTEGER, intent(in) :: map_proj             ! map projection index
+  INTEGER, intent(in) :: parent_grid_ratio    ! parent to nest grid ration
+  INTEGER, intent(in) :: i_parent_start       ! starting i coordinate in parent domain
+  INTEGER, intent(in) :: j_parent_start       ! starting j coordinate in parent domain
+  LOGICAL, intent(in) :: iprt                 ! print flag
+      
+!***  DECLARATIONS FOR IMPLICIT NONE                                    
+  integer :: n, nsta, ndum, nopen, nlast, nvol, idate, imm, iss
+  integer :: meas_count, imc, njend, njc, njcc, julob
+  real    :: hourob, rjulob
+  real    :: xhour, tback, tforwd, rjdate1, timanl1, rtimob
+  real    :: rj, ri, elevation, pressure_data
+  real    :: pressure_qc, height_data, height_qc, temperature_data
+  real    :: temperature_qc, u_met_data, u_met_qc, v_met_data
+  real    :: v_met_qc, rh_data, rh_qc, r_data, slp_data, slp_qc
+  real    :: ref_pres_data, ref_pres_qc, psfc_data, psfc_qc
+  real    :: precip_data, precip_qc, tbar, twdop
+  real*8  :: tempob
+
+! Local variables
+  character*14 date_char
+  character*40 platform,source,id,namef
+  character*2 fonc
+  real latitude,longitude
+  logical is_sound,bogus
+  LOGICAL OPENED,exist
+  integer :: ieof(5),ifon(5)
+  data ieof/0,0,0,0,0/
+  data ifon/0,0,0,0,0/
+  integer :: nmove, nvola
+  DATA NMOVE/0/,NVOLA/61/
+
+  if(ieof(inest).eq.2.and.fdob%nstat.eq.0)then
+    IF (iprt) print *,'returning from in4dob'
+    return
+  endif
+  IF (iprt) print *,'start in4dob ',inest,xtime
+  IF(nudge_opt.NE.1)RETURN
+
+! if start time, or restart time, set obs array to missing value
+  IF(KTAU.EQ.0.OR.KTAU.EQ.KTAUR) THEN
+    DO N=1,NIOBF
+      TIMEOB(N)=99999.
+    ENDDO
+  ENDIF
+! set number of obs=0 if at start or restart
+  IF(KTAU.EQ.KTAUR)fdob%NSTAT=0
+  NSTA=fdob%NSTAT
+  fdob%WINDOW=TWINDO
+  XHOUR=(XTIME-DTMIN)/60.
+  XHOUR=AMAX1(XHOUR,0.0)
+
+10 CONTINUE
+
+! DEFINE THE MAX LIMITS OF THE WINDOW
+  TBACK=XHOUR-fdob%WINDOW
+  TFORWD=XHOUR+fdob%WINDOW
+
+      if (iprt) write(6,*) 'TBACK = ',tback,' TFORWD = ',tforwd
+
+  IF(NSTA.NE.0) THEN
+    NDUM=0
+    t_window : DO N=1,NSTA+1
+      IF((TIMEOB(N)-TBACK).LT.0) THEN
+        TIMEOB(N)=99999.
+      ENDIF
+      IF(TIMEOB(N).LT.9.E4) EXIT t_window
+      NDUM=N
+    ENDDO t_window
+
+! REMOVE OLD OBS DENOTED BY 99999. AT THE FRONT OF TIMEOB ARRAY
+    IF (iprt) print *,'ndum at 20=',ndum
+    NDUM=ABS(NDUM)
+    NMOVE=NIOBF-NDUM
+    IF(NMOVE.GT.0 .AND. NDUM.NE.0 ) THEN  
+      DO N=1,NMOVE
+        VAROBS(1,N)=VAROBS(1,N+NDUM)
+        VAROBS(2,N)=VAROBS(2,N+NDUM)
+        VAROBS(3,N)=VAROBS(3,N+NDUM)
+        VAROBS(4,N)=VAROBS(4,N+NDUM)
+        VAROBS(5,N)=VAROBS(5,N+NDUM)
+! RIO is the west-east coordinate. RJO is south-north. (ajb)
+        RJO(N)=RJO(N+NDUM)
+        RIO(N)=RIO(N+NDUM)
+        RKO(N)=RKO(N+NDUM)
+        TIMEOB(N)=TIMEOB(N+NDUM)
+        nlevs_ob(n)=nlevs_ob(n+ndum)
+        lev_in_ob(n)=lev_in_ob(n+ndum)
+        plfo(n)=plfo(n+ndum)
+        elevob(n)=elevob(n+ndum) 
+      ENDDO
+    ENDIF
+    NOPEN=NMOVE+1
+    IF(NOPEN.LE.NIOBF) THEN
+      DO N=NOPEN,NIOBF
+        VAROBS(1,N)=99999.
+        VAROBS(2,N)=99999.
+        VAROBS(3,N)=99999.
+        VAROBS(4,N)=99999.
+        VAROBS(5,N)=99999.
+        RIO(N)=99999.
+        RJO(N)=99999.
+        RKO(N)=99999.
+        TIMEOB(N)=99999.
+        nlevs_ob(n)=99999.
+        lev_in_ob(n)=99999.
+        plfo(n)=99999.
+        elevob(n)=99999.
+      ENDDO
+    ENDIF
+  ENDIF
+
+! print *,'in4dob, after setting RIO, RJO: nsta = ',nsta
+
+! FIND THE LAST OBS IN THE LIST
+  NLAST=0
+  last_ob : DO N=1,NIOBF
+!   print *,'nlast,n,timeob(n)=',nlast,n,timeob(n)
+    IF(TIMEOB(N).GT.9.E4) EXIT last_ob
+    NLAST=N
+  ENDDO last_ob
+
+! print *,'in4dob, after 90 ',nlast,ktau,ktaur,nsta
+! open file if at beginning or restart
+  IF(KTAU.EQ.0.OR.KTAU.EQ.KTAUR) THEN
+    fdob%RTLAST=-999.
+    INQUIRE (NVOLA+INEST-1,OPENED=OPENED)
+    IF (.NOT. OPENED) THEN
+      ifon(inest)=1
+      write(fonc(1:2),'(i2)')ifon(inest)
+      if(fonc(1:1).eq.' ')fonc(1:1)='0'
+      INQUIRE (file='OBS_DOMAIN'//CHAR(INEST+ICHAR('0'))//fonc(1:2)  &
+              ,EXIST=exist)
+      if(exist)then
+        IF (iprt) THEN
+          print *,'opening first fdda obs file, fonc=',              &
+                   fonc,' inest=',inest
+          print *,'ifon=',ifon(inest)
+        ENDIF
+        OPEN(NVOLA+INEST-1,                                          &
+        FILE='OBS_DOMAIN'//CHAR(INEST+ICHAR('0'))//fonc(1:2),        &
+              FORM='FORMATTED',STATUS='OLD')
+      else
+! no first file to open
+        IF (iprt) print *,'there are no fdda obs files to open'
+        return
+      endif
+
+    ENDIF
+  ENDIF  !end if(KTAU.EQ.0.OR.KTAU.EQ.KTAUR)
+! print *,'at jc check1'
+ 
+!**********************************************************************
+!       --------------   BIG 100 LOOP OVER N  --------------
+!**********************************************************************
+! NOW CHECK TO SEE IF EXTRA DATA MUST BE READ IN FROM THE
+! DATA FILE.  CONTINUE READING UNTIL THE REACHING THE EOF
+! (DATA TIME IS NEGATIVE) OR FIRST TIME PAST TFORWD. THE
+! LAST OBS CURRENTLY AVAILABLE IS IN N=NMOVE.
+  N=NLAST
+  IF(N.EQ.0)GOTO 110
+
+ 1001 continue
+
+! ieof=2 means no more files
+! print *,'after 1001,n,timeob(n)=',n,timeob(n)
+
+    IF(IEOF(inest).GT.1) then
+      GOTO 130
+    endif
+
+100 IF(TIMEOB(N).GT.TFORWD.and.timeob(n).lt.99999.) THEN
+       GOTO 130
+    ENDIF
+ 
+! OBSFILE: no more data in the obsfile 
+    if(ieof(inest).eq.1 )then
+      ieof(inest)=2
+      goto 130
+    endif
+
+!**********************************************************************
+!       --------------   110 SUBLOOP OVER N  --------------
+!**********************************************************************
+! THE TIME OF THE MOST RECENTLY ACQUIRED OBS IS .LE. TFORWD,
+! SO CONTINUE READING
+  110 continue
+      IF(N.GT.NIOBF-1)GOTO 120
+! REPLACE NVOLA WITH LUN 70, AND USE NVOLA AS A FILE COUNTER
+      NVOL=NVOLA+INEST-1
+      IF(fdob%IEODI.EQ.1)GOTO 111
+      read(nvol,101,end=111,err=111)date_char
+ 101  FORMAT(1x,a14)
+
+      n=n+1
+
+      read(date_char(3:10),'(i8)')idate
+      read(date_char(11:12),'(i2)')imm
+      read(date_char(13:14),'(i2)')iss
+! output is rjdate (jjjhh.) and timanl (time in minutes since model start)
+      call julgmt(idate,rjdate1,timanl1,julday,gmt,0)
+      rtimob=rjdate1+real(imm)/60.+real(iss)/3600.
+      timeob(n)=rtimob
+      timeob(n) = int(timeob(n)*1000)/1000.0
+
+! CONVERT TIMEOB FROM JULIAN DATE AND GMT FORM TO FORECAST
+! TIME IN HOURS (EX. TIMEOB=13002.4 REPRESENTS JULDAY 130
+! AND GMT (HOUR) = 2.4)
+      JULOB=TIMEOB(N)/100.+0.000001
+      RJULOB=FLOAT(JULOB)*100.
+      tempob = (timeob(n)*1000.)
+      tempob = int(tempob)
+      tempob = tempob/1000.
+      timeob(n) = tempob
+      HOUROB=TIMEOB(N)-RJULOB
+      TIMEOB(N)=FLOAT(JULOB-JULDAY)*24.-GMT+HOUROB
+      rtimob=timeob(n)
+
+!     print *,'read in ob ',n,timeob(n),rtimob
+      IF(IDYNIN.EQ.1.AND.TIMEOB(N)*60..GT.fdob%DATEND) THEN
+        IF (iprt) THEN
+          PRINT*,' IN4DOB: FOR INEST = ',INEST,' AT XTIME = ',XTIME,    &
+          ' TIMEOB = ',TIMEOB(N)*60.,' AND DATEND = ',fdob%DATEND,' :'
+          PRINT*,'         END-OF-DATA FLAG SET FOR OBS-NUDGING',       &
+          ' DYNAMIC INITIALIZATION'
+        ENDIF
+        fdob%IEODI=1
+        TIMEOB(N)=99999.
+        rtimob=timeob(n)
+      ENDIF
+      read(nvol,102)latitude,longitude
+ 102  FORMAT(2x,2(f7.2,3x))
+
+!     if(ifon.eq.4)print *,'ifon=4',latitude,longitude
+! this works only for lc projection
+! yliu: add llxy for all 3 projection
+          
+!ajb Arguments ri and rj have been switched from MM5 orientation.
+!      call llxy (latitude,longitude,rj,ri,xlatc,xlonc,map_proj,
+      call llxy (latitude,longitude,ri,rj,xlatc_cg,xlonc_cg,map_proj, &
+                 true_lat1,true_lat2,dscg,xn,sn_maxcg,we_maxcg,       &
+                 1,1,1)
+
+!ajb  ri and rj are referenced to the non-staggered grid. (For MM5, they
+!     were referenced to the dot grid.)
+
+      rio(n)=ri
+      rjo(n)=rj
+
+      if (iprt) THEN
+         if(n.le.10) then
+                     write(6,'(/,a,i2,a,f5.2,a,f5.2,/)')        &
+                                            ' OBS N = ',n,      &
+                                            ' RIO = ',rio(n),   &
+                                            ' RJO = ',rjo(n)
+         endif
+      endif
+
+      read(nvol,1021)id,namef
+ 1021 FORMAT(2x,2(a40,3x))
+      read(nvol,103)platform,source,elevation,is_sound,bogus,meas_count
+ 103  FORMAT( 2x,2(a16,2x),f8.0,2x,2(l4,2x),i5)
+
+!     write(6,*) '----- OBS description ----- '
+!     write(6,*) 'platform,source,elevation,is_sound,bogus,meas_count:'
+!     write(6,*) platform,source,elevation,is_sound,bogus,meas_count
+
+! yliu 
+      elevob(n)=elevation
+! jc
+! change platform from synop to profiler when needed
+      if(namef(2:9).eq.'PROFILER')platform(7:14)='PROFILER'
+! yliu
+      if(namef(2:6).eq.'ACARS')platform(7:11)='ACARS'
+      if(namef(1:7).eq.'SATWNDS') platform(1:11)='SATWNDS    '
+      if(namef(1:8).eq.'CLASS DA')platform(7:10)='TEMP'
+! yliu end
+ 
+      rko(n)=-99.
+!yliu 20050706
+!     if((platform(7:11).eq.'METAR').or.(platform(7:11).eq.'SPECI').or.
+!    1   (platform(7:10).eq.'SHIP').or.(platform(7:11).eq.'SYNOP').or.
+!    1    (platform(1:4).eq.'SAMS'))
+!    1   rko(n)=1.0
+      if(.NOT. is_sound) rko(n)=1.0
+!yliu 20050706 end
+
+! plfo is inFORMATion on what platform. May use this later in adjusting weights
+      plfo(n)=99.
+      if(platform(7:11).eq.'METAR')plfo(n)=1.
+      if(platform(7:11).eq.'SPECI')plfo(n)=2.
+      if(platform(7:10).eq.'SHIP')plfo(n)=3.
+      if(platform(7:11).eq.'SYNOP')plfo(n)=4.
+      if(platform(7:10).eq.'TEMP')plfo(n)=5.
+      if(platform(7:11).eq.'PILOT')plfo(n)=6.
+      if(platform(1:7).eq.'SATWNDS')plfo(n)=7.
+      if(platform(1:4).eq.'SAMS')plfo(n)=8.
+      if(platform(7:14).eq.'PROFILER')plfo(n)=9.
+! yliu: ACARS->SATWINDS
+      if(platform(7:11).eq.'ACARS')plfo(n)=7.
+! yliu: end
+      if(plfo(n).eq.99.) then
+         IF (iprt) print *,'n=',n,' unknown ob of type',platform
+      endif
+
+!======================================================================
+!======================================================================
+! THIS PART READS SOUNDING INFO
+      IF(is_sound)THEN
+        nlevs_ob(n)=real(meas_count)
+        lev_in_ob(n)=1.
+        do imc=1,meas_count
+!             write(6,*) '0 inest = ',inest,' n = ',n
+! the sounding has one header, many levels. This part puts it into 
+! "individual" observations. There's no other way for nudob to deal
+! with it.
+          if(imc.gt.1)then                          ! sub-loop over N
+            n=n+1
+            if(n.gt.niobf)goto 120
+            nlevs_ob(n)=real(meas_count)
+            lev_in_ob(n)=real(imc)
+            timeob(n)=rtimob
+            rio(n)=ri
+            rjo(n)=rj
+            rko(n)=-99.
+            plfo(n)=plfo(n-imc+1)
+            elevob(n)=elevation
+          endif
+
+          read(nvol,104)pressure_data,pressure_qc,                  &
+                        height_data,height_qc,                      &
+                        temperature_data,temperature_qc,            &
+                        u_met_data,u_met_qc,                        &
+                        v_met_data,v_met_qc,                        &
+                        rh_data,rh_qc
+ 104      FORMAT( 1x,6(f11.3,1x,f11.3,1x))
+
+! yliu: Ensemble - add disturbance to upr obs
+!         if(plfo(n).eq.5.or.plfo(n).eq.6.or.plfo(n).eq.9) then                  FORE07E08
+!          if(imc.eq.1) then                                                     FORE07E08
+!     call srand(n)
+!     t_rand =- (rand(2)-0.5)*6
+!     call srand(n+100000)
+!     u_rand =- (rand(2)-0.5)*6
+!     call srand(n+200000)
+!     v_rand =- (rand(2)-0.5)*6
+!          endif                                                                 FORE07E08
+!     if(temperature_qc.ge.0..and.temperature_qc.lt.30000..and.
+!    &   temperature_data .gt. -88880.0 )
+!    & temperature_data = temperature_data  + t_rand
+!     if((u_met_qc.ge.0..and.u_met_qc.lt.30000.).and.
+!    &   (v_met_qc.ge.0..and.v_met_qc.lt.30000.).and.
+! make sure at least 1 of the components is .ne.0
+!    &   (u_met_data.ne.0..or.v_met_data.ne.0.) .and.
+!    &   (u_met_data.gt.-88880.0 .and. v_met_data.gt.-88880.0) )then
+!         u_met_data = u_met_data + u_rand
+!         v_met_data = v_met_data + v_rand
+!     endif
+!         endif                                                                  FORE07E08
+! yliu: Ens test - end
+
+ 
+! jc
+! hardwire to switch -777777. qc to 0. here temporarily
+! -777777. is a sounding level that no qc was done on.
+ 
+          if(temperature_qc.eq.-777777.)temperature_qc=0.
+          if(pressure_qc.eq.-777777.)pressure_qc=0.
+          if(height_qc.eq.-777777.)height_qc=0.
+          if(u_met_qc.eq.-777777.)u_met_qc=0.
+          if(v_met_qc.eq.-777777.)v_met_qc=0.
+          if(rh_qc.eq.-777777.)rh_qc=0.
+          if(temperature_data.eq.-888888.)temperature_qc=-888888.
+          if(pressure_data.eq.-888888.)pressure_qc=-888888.
+          if(height_data.eq.-888888.)height_qc=-888888.
+          if(u_met_data.eq.-888888.)u_met_qc=-888888.
+          if(v_met_data.eq.-888888.)v_met_qc=-888888.
+          if(rh_data.eq.-888888.)rh_qc=-888888.
+ 
+! jc
+! Hardwire so that only use winds in pilot obs (no winds from temp) and
+!    only use temperatures and rh in temp obs (no temps from pilot obs)
+! Do this because temp and pilot are treated as 2 platforms, but pilot 
+!    has most of the winds, and temp has most of the temps. If use both,
+!    the second will smooth the effect of the first. Usually temps come in after
+!    pilots. pilots usually don't have any temps, but temp obs do have some 
+!    winds usually.
+! plfo=5 is TEMP ob, range sounding is an exception
+!yliu start -- comment out to test with merged PILOT and TEMP and 
+!        do not use obs interpolated by little_r
+!       if(plfo(n).eq.5. .and. namef(1:8).ne.'CLASS DA')then
+!         u_met_data=-888888.
+!         v_met_data=-888888.
+!         u_met_qc=-888888.
+!         v_met_qc=-888888.
+!       endif
+          if(plfo(n).eq.5..and.(u_met_qc.eq.256..or.v_met_qc.eq.256.))then
+            u_met_data=-888888.
+            v_met_data=-888888.
+            u_met_qc=-888888.
+            v_met_qc=-888888.
+          endif
+!yliu end
+! plfo=6 is PILOT ob
+          if(plfo(n).eq.6.)then
+            temperature_data=-888888.
+            rh_data=-888888.
+            temperature_qc=-888888.
+            rh_qc=-888888.
+          endif
+
+!ajb Store potential temperature for WRF
+          if(temperature_qc.ge.0..and.temperature_qc.lt.30000.)then
+
+            if(pressure_qc.ge.0..and.pressure_qc.lt.30000.)then
+
+              varobs(3,n) =                                             &
+                  temperature_data*(100000./pressure_data)**RCP - t0
+
+!      write(6,*) 'reading data for N = ',n,' RCP = ',rcp
+!      write(6,*) 'temperature_data = ',temperature_data
+!      write(6,*) 'pressure_data = ',pressure_data
+!      write(6,*) 'varobs(3,n) = ',varobs(3,n)
+
+            else
+              varobs(3,n)=-888888.
+            endif
+
+          else
+            varobs(3,n)=-888888.
+          endif
+
+          if(pressure_qc.ge.0..and.pressure_qc.lt.30000.)then
+!           if(pressure_qc.ge.0.)then
+            varobs(5,n)=pressure_data
+          else
+            varobs(5,n)=-888888.
+            IF (iprt) THEN
+              print *,'********** PROBLEM *************'
+              print *,'sounding, p undefined',latitude,longitude
+            ENDIF
+          endif 
+          if(varobs(5,n).ge.0.)varobs(5,n)=varobs(5,n)*1.e-3
+! don't use data above 80 mb
+          if((varobs(5,n).gt.0.).and.(varobs(5,n).le.8.))then
+            u_met_data=-888888.
+            v_met_data=-888888.
+            u_met_qc=-888888.
+            v_met_qc=-888888.
+            temperature_data=-888888.
+            temperature_qc=-888888.
+            rh_data=-888888.
+            rh_qc=-888888.
+          endif
+
+! yliu: add special processing of NPN and Range profiler
+!       only little_r interpolated and QC-ed data is used
+          if(namef(2:9).eq."PROFILER") then               
+            if((u_met_qc.ge.0..and.u_met_qc.lt.30000.).and.  &
+              (v_met_qc.ge.0..and.v_met_qc.lt.30000.))then
+!!yliu little_r already rotated the winds
+!             call vect(longitude,u_met_data,v_met_data,xlonc,xlatc,xn)
+              varobs(1,n)=u_met_data
+              varobs(2,n)=v_met_data
+            else
+              varobs(1,n)=-888888.
+              varobs(2,n)=-888888.
+            endif
+          else
+            if((u_met_qc.ge.0..and.u_met_qc.lt.30000.).and.  &
+              (v_met_qc.ge.0..and.v_met_qc.lt.30000.))then
+!!yliu little_r already rotated the winds
+!             call vect(longitude,u_met_data,v_met_data,xlonc,xlatc,xn)
+              varobs(1,n)=u_met_data
+              varobs(2,n)=v_met_data
+            else
+              varobs(1,n)=-888888.
+              varobs(2,n)=-888888.
+            endif
+          endif
+          r_data=-888888.
+
+          if(rh_qc.ge.0..and.rh_qc.lt.30000.)then
+            if((pressure_qc.ge.0.).and.(temperature_qc.ge.0.).and.       &
+              (pressure_qc.lt.30000.).and.(temperature_qc.lt.30000.))then
+              call rh2r(rh_data,temperature_data,pressure_data*.01,      &
+                        r_data,0)            ! yliu, change last arg from 1 to 0
+            else
+!             print *,'rh, but no t or p to convert',temperature_qc,     &
+!             pressure_qc,n
+              r_data=-888888.
+            endif
+          endif
+          varobs(4,n)=r_data
+        enddo    ! end do imc=1,meas_count
+!       print *,'--- sdng n=',n,nlevs_ob(n),lev_in_ob(n),timeob(n)
+!       read in non-sounding obs
+
+      ELSEIF(.NOT.is_sound)THEN
+        nlevs_ob(n)=1.
+        lev_in_ob(n)=1.
+        read(nvol,105)slp_data,slp_qc,                                 &
+                      ref_pres_data,ref_pres_qc,                       &
+                      height_data,height_qc,                           &
+                      temperature_data,temperature_qc,                 &
+                      u_met_data,u_met_qc,                             &
+                      v_met_data,v_met_qc,                             &
+                      rh_data,rh_qc,                                   &
+                      psfc_data,psfc_qc,                               &
+                      precip_data,precip_qc
+ 105    FORMAT( 1x,9(f11.3,1x,f11.3,1x))
+
+! Ensemble: add disturbance to sfc obs
+!     call srand(n)
+!     t_rand =+ (rand(2)-0.5)*5
+!     call srand(n+100000)
+!     u_rand =+ (rand(2)-0.5)*5
+!     call srand(n+200000)
+!     v_rand =+ (rand(2)-0.5)*5
+!     if(temperature_qc.ge.0..and.temperature_qc.lt.30000.  .and.
+!    &   temperature_data .gt. -88880.0 )
+!    & temperature_data = temperature_data  + t_rand
+!     if((u_met_qc.ge.0..and.u_met_qc.lt.30000.).and.
+!    &   (v_met_qc.ge.0..and.v_met_qc.lt.30000.).and.
+! make sure at least 1 of the components is .ne.0
+!    &   (u_met_data.ne.0..or.v_met_data.ne.0.) .and.
+!    &   (u_met_data.gt.-88880.0 .and. v_met_data.gt.-88880.0) )then
+!         u_met_data = u_met_data + u_rand
+!         v_met_data = v_met_data + v_rand
+!      endif
+! yliu: Ens test - end
+
+!ajb Store potential temperature for WRF
+        if(temperature_qc.ge.0..and.temperature_qc.lt.30000.)then
+
+          if((psfc_qc.ge.0..and.psfc_qc.lt.30000.).and.          &
+             (psfc_data.gt.70000. .and.psfc_data.lt.105000.))then
+
+            varobs(3,n) =                                        &
+                  temperature_data*(100000./psfc_data)**RCP - t0
+          else
+            varobs(3,n)=-888888.
+          endif
+        else
+          varobs(3,n)=-888888.
+        endif
+
+        if((psfc_qc.ge.0..and.psfc_qc.lt.30000.).and.(psfc_data.gt.70000.  &
+        .and.psfc_data.lt.105000.))then
+          varobs(5,n)=psfc_data
+        else
+          varobs(5,n)=-888888.
+        endif
+        if(varobs(5,n).ge.0.)varobs(5,n)=varobs(5,n)*1.e-3
+
+        if((u_met_qc.ge.0..and.u_met_qc.lt.30000.).and.            &
+           (v_met_qc.ge.0..and.v_met_qc.lt.30000.).and.            &
+! make sure at least 1 of the components is .ne.0
+           (u_met_data.ne.0..or.v_met_data.ne.0.))then
+!!yliu little_r already rotated the winds
+!!yliu   call vect(longitude,u_met_data,v_met_data,xlonc,xlatc,xn)
+          varobs(1,n)=u_met_data
+          varobs(2,n)=v_met_data
+        else
+          varobs(1,n)=-888888.
+          varobs(2,n)=-888888.
+        endif
+! calculate psfc if slp is there
+        if((psfc_qc.lt.0.).and.(slp_qc.ge.0..and.slp_qc.lt.30000.).and.   &
+              (temperature_qc.ge.0..and.temperature_qc.lt.30000.).and.    &
+              (slp_data.gt.90000.))then
+          tbar=temperature_data+0.5*elevation*.0065
+          psfc_data=slp_data*exp(-elevation/(rovg*tbar))
+          varobs(5,n)=psfc_data*1.e-3
+          psfc_qc=0.
+        endif
+
+!c *No* **Very rough** estimate of psfc from sfc elevation if UUtah ob and elev>1000m
+! estimate psfc from temp and elevation
+!   Do not know sfc pressure in model at this point.
+!      if((psfc_qc.lt.0.).and.(elevation.gt.1000.).and.
+!     1   (temperature_qc.ge.0..and.temperature_qc.lt.30000.)
+!     1    .and.(platform(7:16).eq.'SYNOP PRET'))then
+        if((psfc_qc.lt.0.).and.                                          &
+          (temperature_qc.ge.0..and.temperature_qc.lt.30000.))then
+          tbar=temperature_data+0.5*elevation*.0065
+          psfc_data=100000.*exp(-elevation/(rovg*tbar))
+          varobs(5,n)=psfc_data*1.e-3
+          psfc_qc=0.
+        endif
+! jc
+! if a ship ob has rh<70%, then throw out
+        if(plfo(n).eq.3..and.rh_qc.ge.0..and.rh_data.lt.70.)then
+          rh_qc=-888888.
+          rh_data=-888888.
+        endif
+!
+        r_data=-888888.
+        if(rh_qc.ge.0..and.rh_qc.lt.30000.)then
+          if((psfc_qc.ge.0..and.psfc_qc.lt.30000.)                       &
+          .and.(temperature_qc.ge.0..and.temperature_qc.lt.30000.))then
+!           rh_data=amin1(rh_data,96.) ! yliu: do not allow surface to be saturated
+            call rh2r(rh_data,temperature_data,psfc_data*.01,            &
+                      r_data,0)            ! yliu, change last arg from 1 to 0
+          else
+!           print *,'rh, but no t or p',temperature_data,
+!    1 psfc_data,n
+            r_data=-888888.
+          endif
+        endif
+        varobs(4,n)=r_data
+      ELSE
+        IF (iprt) THEN
+           print *,' ======  '
+           print *,' NO Data Found '
+        ENDIF
+      ENDIF   !end if(is_sound)
+! END OF SFC OBS INPUT SECTION
+!======================================================================
+!======================================================================
+! check if ob time is too early (only applies to beginning)
+      IF(RTIMOB.LT.TBACK-fdob%WINDOW)then
+        IF (iprt) print *,'ob too early'
+        n=n-1
+        GOTO 110
+      ENDIF
+
+! check if this ob is a duplicate
+! this check has to be before other checks
+      njend=n-1
+      if(is_sound)njend=n-meas_count
+      do njc=1,njend
+! Check that time, lat, lon, and platform all match exactly.
+! Platforms 1-4 (surface obs) can match with each other. Otherwise,
+!   platforms have to match exactly. 
+        if( (timeob(n).eq.timeob(njc)) .and.                     &
+            (rio(n).eq.rio(njc))       .and.                     &
+            (rjo(n).eq.rjo(njc))       .and.                     &
+            (plfo(njc).ne.99.) ) then
+!yliu: if two sfc obs are departed less than 1km, consider they are redundant
+!              (abs(rio(n)-rio(njc))*dscg.gt.1000.)   &
+!         .or. (abs(rjo(n)-rjo(njc))*dscg.gt.1000.)   &
+!         .or. (plfo(njc).eq.99.) )goto 801
+!yliu end
+! If platforms different, and either > 4, jump out
+          if( ( (plfo(n).le.4.).and.(plfo(njc).le.4.) ) .or.     &
+                (plfo(n).eq.plfo(njc)) ) then
+
+! if not a sounding, and levels are the same then replace first occurrence 
+            if((.not.is_sound).and.(rko(njc).eq.rko(n))) then
+!             print *,'dup single ob-replace ',n,inest,
+!             plfo(n),plfo(njc)
+! this is the sfc ob replacement part
+              VAROBS(1,njc)=VAROBS(1,n)
+              VAROBS(2,njc)=VAROBS(2,n)
+              VAROBS(3,njc)=VAROBS(3,n)
+              VAROBS(4,njc)=VAROBS(4,n)
+              VAROBS(5,njc)=VAROBS(5,n)
+! don't need to switch these because they're the same
+!             RIO(njc)=RIO(n)
+!             RJO(njc)=RJO(n)
+!             RKO(njc)=RKO(n)
+!             TIMEOB(njc)=TIMEOB(n)
+!             nlevs_ob(njc)=nlevs_ob(n)
+!             lev_in_ob(njc)=lev_in_ob(n)
+!             plfo(njc)=plfo(n)
+! end sfc ob replacement part
+
+              n=n-1
+              goto 100
+! It's harder to fix the soundings, since the number of levels may be different
+! The easiest thing to do is to just set the first occurrence to all missing, and
+!    keep the second occurrence, or vice versa.
+! For temp or profiler keep the second, for pilot keep the one with more levs
+! This is for a temp or prof sounding, equal to same
+!  also if a pilot, but second one has more obs
+            elseif( (is_sound).and.(plfo(njc).eq.plfo(n)) .and.            &
+                    ( (plfo(njc).eq.5.).or.(plfo(njc).eq.9.).or.           &
+                    ( (plfo(njc).eq.6.).and.                               &
+                      (nlevs_ob(n).ge.nlevs_ob(njc)) ) ) )then
+              IF (iprt) THEN
+                print *,'duplicate sounding - eliminate first occurrence', &
+                                  n,inest,meas_count,nlevs_ob(njc),        &
+                                  latitude,longitude,plfo(njc)
+              ENDIF
+              if(lev_in_ob(njc).ne.1.) then
+                IF (iprt) THEN
+                  print *, 'problem ******* - dup sndg ',                  &
+                           lev_in_ob(njc),nlevs_ob(njc)
+                ENDIF
+              endif
+!             n=n-meas_count
+! set the first sounding ob to missing
+              do njcc=njc,njc+nint(nlevs_ob(njc))-1
+                VAROBS(1,njcc)=-888888.
+                VAROBS(2,njcc)=-888888.
+                VAROBS(3,njcc)=-888888.
+                VAROBS(4,njcc)=-888888.
+                VAROBS(5,njcc)=-888888.
+                plfo(njcc)=99.
+              enddo
+              goto 100
+!  if a pilot, but first one has more obs
+            elseif( (is_sound).and.(plfo(njc).eq.plfo(n)) .and.            &
+                    (plfo(njc).eq.6.).and.                                 &
+                    (nlevs_ob(n).lt.nlevs_ob(njc)) )then
+              IF (iprt) THEN
+                print *,                                                   &
+                 'duplicate pilot sounding - eliminate second occurrence', &
+                                 n,inest,meas_count,nlevs_ob(njc),         &
+                                 latitude,longitude,plfo(njc)
+              ENDIF
+              if(lev_in_ob(njc).ne.1.) then
+                IF (iprt) THEN
+                  print *, 'problem ******* - dup sndg ',                  &
+                           lev_in_ob(njc),nlevs_ob(njc)
+                ENDIF
+              endif
+              n=n-meas_count
+
+!ajb  Reset timeob for discarded indices.
+              do imc = n+1, n+meas_count
+                timeob(imc) = 99999.
+              enddo
+              goto 100
+! This is for a single-level satellite upper air ob - replace first
+            elseif( (is_sound).and.                                        &
+                    (nlevs_ob(njc).eq.1.).and.                             &
+                    (nlevs_ob(n).eq.1.).and.                               &
+                    (varobs(5,njc).eq.varobs(5,n)).and.                    &
+                    (plfo(njc).eq.7.).and.(plfo(n).eq.7.) ) then
+              IF (iprt) print *,                                        &
+                'duplicate single lev sat-wind ob - replace first',n,      &
+                                 inest,meas_count,varobs(5,n)
+! this is the single ua ob replacement part
+              VAROBS(1,njc)=VAROBS(1,n)
+              VAROBS(2,njc)=VAROBS(2,n)
+              VAROBS(3,njc)=VAROBS(3,n)
+              VAROBS(4,njc)=VAROBS(4,n)
+              VAROBS(5,njc)=VAROBS(5,n)
+! don't need to switch these because they're the same
+!           RIO(njc)=RIO(n)
+!           RJO(njc)=RJO(n)
+!           RKO(njc)=RKO(n)
+!           TIMEOB(njc)=TIMEOB(n)
+!           nlevs_ob(njc)=nlevs_ob(n)
+!           lev_in_ob(njc)=lev_in_ob(n)
+!           plfo(njc)=plfo(n)
+! end single ua ob replacement part
+              n=n-1
+              goto 100
+            else
+              IF (iprt) THEN
+                print *,'duplicate location, but no match otherwise',n,njc,  &
+                        plfo(n),varobs(5,n),nlevs_ob(n),lev_in_ob(n),        &
+                        plfo(njc),varobs(5,njc),nlevs_ob(njc),lev_in_ob(njc)
+              ENDIF
+            endif
+          endif
+        endif
+! end of njc do loop
+      enddo
+
+! check if ob is a sams ob that came in via UUtah - discard
+      if( plfo(n).eq.4..and.(platform(7:16).eq.'SYNOP PRET').and.          &
+          (id(7:15).eq.'METNET= 3') )then
+!       print *,'elim metnet=3',latitude,longitude,rtimob
+        n=n-1
+        goto 100
+      endif
+
+! check if ob is in coarse mesh domain  (061404 switched sn/we)
+      if( (ri.lt.2.).or.(ri.gt.real(we_maxcg-1)).or.(rj.lt.2.).or.         &
+          (rj.gt.real(sn_maxcg-1)) ) then
+
+!         if (iprt) write(6,*) 'Obs out of coarse mesh domain'
+!         write(6,*) 'we_maxcg-1 = ',real(we_maxcg-1)
+!         write(6,*) 'sn_maxcg-1 = ',real(sn_maxcg-1)
+
+!       n=n-1
+!       if(is_sound)n=n-meas_count+1
+
+        n=n-meas_count
+!ajb  Reset timeob for discarded indices.
+        do imc = n+1, n+meas_count
+          timeob(imc) = 99999.
+        enddo
+        goto 100
+      endif
+
+! check if an upper air ob is too high
+! the ptop here is hardwired
+! this check has to come after other checks - usually the last few
+!   upper air obs are too high
+!      if(is_sound)then
+!        njc=meas_count
+!        do jcj=meas_count,1,-1
+! 6. is 60 mb - hardwired
+!          if((varobs(5,n).lt.6.).and.(varobs(5,n).gt.0.))then
+!            print *,'obs too high - eliminate,n,p=',n,varobs(5,n)
+!            n=n-1
+!          else
+!            if(varobs(5,n).gt.0.)goto 100
+!          endif
+!        enddo
+!      endif
+!
+      IF(TIMEOB(N).LT.fdob%RTLAST) THEN
+        IF (iprt) THEN
+          PRINT *,'2 OBS ARE NOT IN CHRONOLOGICAL ORDER'
+          PRINT *,'NEW YEAR?'
+          print *,'timeob,rtlast,n=',timeob(n),fdob%rtlast,n
+        ENDIF
+        STOP 111
+      ELSE
+        fdob%RTLAST=TIMEOB(N)
+      ENDIF
+      GOTO 100
+  111 CONTINUE
+!**********************************************************************
+!       --------------   END BIG 100 LOOP OVER N  --------------
+!**********************************************************************
+      IF (iprt) write(6,5403) NVOL,XTIME
+      IEOF(inest)=1
+
+      close(NVOLA+INEST-1)
+      IF (iprt) print *,'closed fdda file for inest=',inest,nsta
+
+!     if(nsta.eq.1.and.timeob(1).gt.9.e4)nsta=0
+  goto 1001
+
+! THE OBSERVATION ARRAYS ARE FULL AND THE MOST RECENTLY
+! ACQUIRED OBS STILL HAS TIMEOB .LE. TFORWD.  SO START
+! DECREASING THE SIZE OF THE WINDOW
+! get here if too many obs
+120 CONTINUE
+  IF (iprt) THEN
+    write(6,121) N,NIOBF
+    write(6,122)
+  ENDIF
+  STOP 122
+  fdob%WINDOW=fdob%WINDOW-0.1*TWINDO
+  IF(TWINDO.LT.0)STOP 120
+! IF THE WINDOW BECOMES NEGATIVE, THE INCOMING DATA IS
+! PROBABLY GARBLED. STOP.
+  GOTO 10
+!
+! READ CYCLE IS COMPLETED. DETERMINE THE NUMBER OF OBS IN
+! THE CURRENT WINDOW
+!
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! BUT FIRST, WHEN KTAU.EQ.0 (OR IN GENERAL, KTAUR), DISCARD THE
+! "OLD" OBS FIRST...
+130 CONTINUE
+
+! get here if at end of file, or if obs time is beyond what we
+! need right now
+  IF(KTAU.EQ.KTAUR)THEN
+    NSTA=0
+    keep_obs : DO N=1,NIOBF
+
+! try to keep all obs, but just don't use yet
+!  (don't want to throw away last obs read in - especially if
+!  its a sounding, in which case it looks like many obs)
+      IF(TIMEOB(N).GT.9.e4) EXIT keep_obs
+      if(timeob(n).gt.tforwd) then
+        if(iprt) write(6,951)inest,n,timeob(n),tforwd
+ 951    FORMAT('saving ob beyond window,inest,n,timeob,tforwd=',   &
+               2i5,2f13.4) 
+      endif
+      NSTA=N
+    ENDDO keep_obs
+
+    NDUM=0
+! make time=99999. if ob is too old
+!   print *,'tback,nsta=',tback,nsta
+    old_obs : DO N=1,NSTA+1
+      IF((TIMEOB(N)-TBACK).LT.0)THEN
+        TIMEOB(N)=99999.
+      ENDIF
+!     print *,'n,ndum,timeob=',n,ndum,timeob(n)
+      IF(TIMEOB(N).LT.9.E4) EXIT old_obs
+      NDUM=N
+    ENDDO old_obs
+
+! REMOVE OLD OBS DENOTED BY 99999. AT THE FRONT OF TIMEOB ARRAY
+    IF (iprt) THEN
+      print *,'after 190 ndum=',ndum,nsta
+      print *,'timeob=',timeob(1),timeob(2)
+    ENDIF
+    NDUM=ABS(NDUM)
+    NMOVE=NIOBF-NDUM
+    IF( NMOVE.GT.0 .AND. NDUM.NE.0) THEN
+      DO N=1,NMOVE
+        VAROBS(1,N)=VAROBS(1,N+NDUM)
+        VAROBS(2,N)=VAROBS(2,N+NDUM)
+        VAROBS(3,N)=VAROBS(3,N+NDUM)
+        VAROBS(4,N)=VAROBS(4,N+NDUM)
+        VAROBS(5,N)=VAROBS(5,N+NDUM)
+        RJO(N)=RJO(N+NDUM)
+        RIO(N)=RIO(N+NDUM)
+        RKO(N)=RKO(N+NDUM)
+        TIMEOB(N)=TIMEOB(N+NDUM)
+        nlevs_ob(n)=nlevs_ob(n+ndum)
+        lev_in_ob(n)=lev_in_ob(n+ndum)
+        plfo(n)=plfo(n+ndum)
+      ENDDO
+    ENDIF
+! moved obs up. now fill remaining space with 99999.
+    NOPEN=NMOVE+1
+    IF(NOPEN.LE.NIOBF) THEN
+      DO N=NOPEN,NIOBF
+        VAROBS(1,N)=99999.
+        VAROBS(2,N)=99999.
+        VAROBS(3,N)=99999.
+        VAROBS(4,N)=99999.
+        VAROBS(5,N)=99999.
+        RIO(N)=99999.
+        RJO(N)=99999.
+        RKO(N)=99999.
+        TIMEOB(N)=99999.
+      ENDDO
+    ENDIF
+  ENDIF
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+  NSTA=0
+! print *,'nsta at restart setting is ',nsta
+! recalculate nsta after moving things around
+  recalc : DO N=1,NIOBF
+! try to save all obs - don't throw away latest read in
+    IF(TIMEOB(N).GT.9.e4) EXIT recalc
+    NSTA=N
+!   nsta=n-1         ! yliu test
+  ENDDO recalc
+ 
+  IF (iprt) write(6,160) KTAU,XTIME,NSTA
+  IF(KTAU.EQ.KTAUR)THEN
+    IF(nudge_opt.EQ.1)THEN
+      TWDOP=TWINDO*60.
+      IF (iprt) THEN
+        write(6,1449) INEST,RINXY,RINSIG,TWDOP
+        IF(ISWIND.EQ.1) write(6,1450) GIV
+        IF(ISTEMP.EQ.1) write(6,1451) GIT
+        IF(ISMOIS.EQ.1) write(6,1452) GIQ
+        IF(ISPSTR.EQ.1) write(6,1453) GIP
+      ENDIF
+    ENDIF
+  ENDIF
+  IF(KTAU.EQ.KTAUR)THEN
+    IF (iprt) THEN
+      write(6,553)
+      write(6,554)
+    ENDIF
+    IF(fdob%IWTSIG.NE.1)THEN
+      IF (iprt) THEN
+        write(6,555)
+        write(6,556) fdob%RINFMN*RINXY,fdob%RINFMX*RINXY,fdob%PFREE*10.
+      ENDIF
+      IF(fdob%RINFMN.GT.fdob%RINFMX)STOP 556
+! IS MINIMUM GREATER THAN MAXIMUM?
+      IF (iprt) write(6,557) fdob%DPSMX*10.,fdob%DCON
+      IF(fdob%DPSMX.GT.10.)STOP 557
+    ENDIF
+  ENDIF
+! IS DPSMX IN CB?
+ 
+  IF(KTAU.EQ.KTAUR)THEN
+    IF (iprt) write(6,601) INEST,IONF
+  ENDIF
+  fdob%NSTAT=NSTA
+
+555   FORMAT(1X,'   ABOVE THE SURFACE LAYER, OBS NUDGING IS PERFORMED',  &
+      ' ON PRESSURE LEVELS,')
+556   FORMAT(1X,'   WHERE RINXY VARIES LINEARLY FROM ',E11.3,' KM AT',   &
+      ' THE SURFACE TO ',E11.3,' KM AT ',F7.2,' MB AND ABOVE')
+557   FORMAT(1X,'   IN THE SURFACE LAYER, WXY IS A FUNCTION OF ',        &
+      'DPSMX = ',F7.2,' MB WITH DCON = ',E11.3,                          &
+      ' - SEE SUBROUTINE NUDOB')
+601   FORMAT('0','FOR EFFICIENCY, THE OBS NUDGING FREQUENCY ',           &
+        'FOR MESH #',I2,' IS ',1I2,' CGM TIMESTEPS ',/)
+121   FORMAT('0','  WARNING: NOBS  = ',I4,' IS GREATER THAN NIOBF = ',   &
+      I4,': INCREASE PARAMETER NIOBF')
+5403  FORMAT(1H0,'-------------EOF REACHED FOR NVOL = ',I3,              &
+       ' AND XTIME = ',F10.2,'-------------------')
+122   FORMAT(1X,'     ...OR THE CODE WILL REDUCE THE TIME WINDOW')
+160   FORMAT('0','****** CALL IN4DOB AT KTAU = ',I5,' AND XTIME = ',     &
+      F10.2,':  NSTA = ',I7,' ******')
+1449  FORMAT(1H0,'*****NUDGING INDIVIDUAL OBS ON MESH #',I2,             &
+       ' WITH RINXY = ',                                                 &
+      E11.3,' KM, RINSIG = ',E11.3,' AND TWINDO (HALF-PERIOD) = ',       &
+      E11.3,' MIN')
+1450  FORMAT(1X,'NUDGING IND. OBS WINDS WITH GIV = ',E11.3)
+1451  FORMAT(1X,'NUDGING IND. OBS TEMPERATURE WITH GIT = ',E11.3)
+1452  FORMAT(1X,'NUDGING IND. OBS MOISTURE WITH GIQ = ',E11.3)
+1453  FORMAT(1X,'NUDGING IND. OBS SURFACE PRESSURE WITH GIP = ,'E11.3)
+1469  FORMAT(1H0,'*****NUDGING INDIVIDUAL OBS ON FGM WITH RINXY = ',     &
+      E11.3,' KM, RINSIG = ',E11.3,' AND TWINDO (HALF-PERIOD) = ',       &
+      E11.3,' MIN')
+553   FORMAT(1X,'BY DEFAULT: OBS NUDGING OF TEMPERATURE AND MOISTURE ',  &
+      'IS RESTRICTED TO ABOVE THE BOUNDARY LAYER')
+554   FORMAT(1X,'...WHILE OBS NUDGING OF WIND IS INDEPENDENT OF THE ',   &
+      'BOUNDARY LAYER')
+
+  RETURN
+  END SUBROUTINE in4dob
+
+  SUBROUTINE julgmt(mdate,julgmtn,timanl,julday,gmt,ind)
+! CONVERT MDATE YYMMDDHH TO JULGMT (JULIAN DAY * 100. +GMT)
+! AND TO TIMANL (TIME IN MINUTES WITH RESPECT TO MODEL TIME)
+! IF IND=0  INPUT MDATE, OUTPUT JULGMTN AND TIMANL
+! IF IND=1  INPUT TIMANL, OUTPUT JULGMTN
+! IF IND=2  INPUT JULGMTN, OUTPUT TIMANL
+      INTEGER, intent(in) :: MDATE
+      REAL, intent(out) :: JULGMTN
+      REAL, intent(out) :: TIMANL
+      INTEGER, intent(in) :: JULDAY
+      REAL, intent(in) :: GMT
+      INTEGER, intent(in) :: IND 
+
+!***  DECLARATIONS FOR IMPLICIT NONE                                    
+      real :: MO(12), rjulanl, houranl, rhr
+
+      integer :: iyr, idate1, imo, idy, ihr, my1, my2, my3, ileap
+      integer :: juldayn, juldanl, idymax, mm
+      
+      
+      IF(IND.EQ.2)GOTO 150
+      IYR=INT(MDATE/1000000.+0.001)
+      IDATE1=MDATE-IYR*1000000
+      IMO=INT(IDATE1/10000.+0.001)
+      IDY=INT((IDATE1-IMO*10000.)/100.+0.001)
+      IHR=IDATE1-IMO*10000-IDY*100
+      MO(1)=31
+      MO(2)=28
+! IS THE YEAR A LEAP YEAR? (IN THIS CENTURY)
+      IYR=IYR+1900
+      MY1=MOD(IYR,4)
+      MY2=MOD(IYR,100)
+      MY3=MOD(IYR,400)
+      ILEAP=0
+! jc
+!      IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)THEN
+      IF(MY1.EQ.0)THEN
+        ILEAP=1
+        MO(2)=29
+      ENDIF
+      IF(IND.EQ.1)GOTO 200
+      MO(3)=31
+      MO(4)=30
+      MO(5)=31
+      MO(6)=30
+      MO(7)=31
+      MO(8)=31
+      MO(9)=30
+      MO(10)=31
+      MO(11)=30
+      MO(12)=31
+      JULDAYN=0
+      DO 100 MM=1,IMO-1
+        JULDAYN=JULDAYN+MO(MM)
+ 100     CONTINUE
+
+      IF(IHR.GE.24)THEN
+        IDY=IDY+1
+        IHR=IHR-24
+      ENDIF
+      JULGMTN=(JULDAYN+IDY)*100.+IHR
+! CONVERT JULGMT TO TIMANL WRT MODEL TIME IN MINUTES (XTIME)
+ 150   CONTINUE
+      JULDANL=INT(JULGMTN/100.+0.000001)
+      RJULANL=FLOAT(JULDANL)*100.
+      HOURANL=JULGMTN-RJULANL
+      TIMANL=(FLOAT(JULDANL-JULDAY)*24.-GMT+HOURANL)*60.
+      RETURN
+ 200   CONTINUE
+      RHR=GMT+TIMANL/60.+0.000001
+      IDY=JULDAY
+      IDYMAX=365+ILEAP
+ 300   IF(RHR.GE.24.0)THEN
+        RHR=RHR-24.0
+        IDY=IDY+1
+        GOTO 300
+      ENDIF
+      IF(IDY.GT.IDYMAX)IDY=IDY-IDYMAX
+      JULGMTN=FLOAT(IDY)*100.+RHR
+      RETURN
+  END SUBROUTINE julgmt
+
+  SUBROUTINE vect(xlon,e1,e2,xlonc,xlatc,xn)
+ 
+! THIS ROUTINE CONVERTS INCOMING U AND V COMPS INTO MAP U AND V COMPS.
+! iproj is projection (1=lamconf, 2=polarst, 3=mercator)
+! xlonc is center longitude
+! xn is cone factor (.716 for current lc)
+!
+      REAL, intent(in) :: XLON
+      REAL, intent(inout) :: E1
+      REAL, intent(inout) :: E2
+      REAL, intent(in) :: xlonc
+      REAL, intent(in) :: xlatc
+      REAL, intent(in) :: xn
+
+!***  DECLARATIONS FOR IMPLICIT NONE                                    
+      real :: pi, degran, u, v, xlonr, angle
+
+      pi=3.1415926535
+      DEGRAN=PI/180.
+!
+!
+         u=e1
+         v=e2
+         XLONR=XLONC-XLON
+         IF(XLONR.GT.180.) XLONR=XLONR-360.
+         IF(XLONR.LT.-180.) XLONR=XLONR+360.
+         ANGLE=XLONR*XN*DEGRAN
+         IF (xlatC.LT.0.0) ANGLE=-ANGLE
+         E1=V*SIN(ANGLE)+U*COS(ANGLE)
+         E2=V*COS(ANGLE)-U*SIN(ANGLE)
+      RETURN
+  END SUBROUTINE vect
+
+  SUBROUTINE rh2r(rh,t,p,r,iice)
+ 
+! convert rh to r
+! if iice=1, use saturation with respect to ice
+! rh is 0-100.
+! r is g/g
+! t is K
+! p is mb
+!
+      REAL, intent(in)  :: rh
+      REAL, intent(in)  :: t
+      REAL, intent(in)  :: p
+      REAL, intent(out) :: r
+      INTEGER, intent(in)  :: iice
+
+!***  DECLARATIONS FOR IMPLICIT NONE                                    
+      real eps, e0, eslcon1, eslcon2, esicon1, esicon2, t0, rh1
+      real esat, rsat
+
+      eps=0.62197
+      e0=6.1078
+      eslcon1=17.2693882
+      eslcon2=35.86
+      esicon1=21.8745584
+      esicon2=7.66
+      t0=260.
+ 
+!     print *,'rh2r input=',rh,t,p
+      rh1=rh*.01
+ 
+      if(iice.eq.1.and.t.le.t0)then
+        esat=e0*exp(esicon1*(t-273.16)/(t-esicon2))
+      else
+        esat=e0*exp(eslcon1*(t-273.16)/(t-eslcon2))
+      endif
+      rsat=eps*esat/(p-esat)
+!     print *,'rsat,esat=',rsat,esat
+      r=rh1*rsat
+ 
+!      print *,'rh2r rh,t,p,r=',rh1,t,p,r
+ 
+      return
+  END SUBROUTINE rh2r
+
+  SUBROUTINE rh2rb(rh,t,p,r,iice)
+ 
+! convert rh to r
+! if iice=1, use daturation with respect to ice
+! rh is 0-100.
+! r is g/g
+! t is K
+! p is mb
+ 
+      REAL, intent(in)  :: rh
+      REAL, intent(in)  :: t
+      REAL, intent(in)  :: p
+      REAL, intent(out) :: r
+      INTEGER, intent(in)  :: iice
+
+!***  DECLARATIONS FOR IMPLICIT NONE                                    
+      real eps, e0, eslcon1, eslcon2, esicon1, esicon2, t0, rh1
+      real esat, rsat
+
+      eps=0.622
+      e0=6.112
+      eslcon1=17.67
+      eslcon2=29.65
+      esicon1=22.514
+      esicon2=6.15e3
+      t0=273.15
+ 
+      print *,'rh2r input=',rh,t,p
+      rh1=rh*.01
+ 
+      if(iice.eq.1.and.t.le.t0)then
+        esat=e0*exp(esicon1-esicon2/t)
+      else
+        esat=e0*exp(eslcon1*(t-t0)/(t-eslcon2))
+      endif
+      rsat=eps*esat/(p-esat)
+!     print *,'rsat,esat=',rsat,esat
+      r=rh1*eps*rsat/(eps+rsat*(1.-rh1))
+ 
+      print *,'rh2r rh,t,p,r=',rh1,t,p,r
+ 
+      return
+END SUBROUTINE rh2rb
+
+SUBROUTINE llxy_lam (xlat,xlon,X,Y,xlatc, xlonc,xn,ds,       &
+           imax, jmax, true_lat1, true_lat2 )
+
+!***  DECLARATIONS FOR IMPLICIT NONE                                    
+      real :: pi, conv, a
+
+      PARAMETER(pi=3.14159,CONV=180./pi,a =6370.)
+
+      REAL  TRUE_LAT1 , PHI1 , POLE , XLATC , PHIC , XC , YC ,       &
+            XN , FLP , XLON , XLONC , PSX , XLAT , R , XX , YY ,     &
+            CENTRI , CENTRJ , X , DS , Y , TRUE_LAT2
+
+      INTEGER  IMAX , JMAX
+
+!  Calculate x and y given latitude and longitude for Lambert conformal projection
+
+      IF(ABS(true_lat1).GT.90) THEN
+        PHI1 = 90. - 30.
+      ELSE
+        PHI1 = 90. - true_lat1
+      END IF
+      POLE = 90.0
+      IF ( XLATC.LT.0.0 ) THEN
+        PHI1 = -PHI1
+        POLE = -POLE
+      END IF
+      PHIC = ( POLE - XLATC )/CONV
+      PHI1 = PHI1/CONV
+      XC = 0.0
+      YC = -A/XN*SIN(PHI1)*(TAN(PHIC/2.0)/TAN(PHI1/2.0))**XN
+
+!  CALCULATE X,Y COORDS. RELATIVE TO POLE
+
+      FLP = XN*( XLON - XLONC )/CONV
+      PSX = ( POLE - XLAT )/CONV
+      R = -A/XN*SIN(PHI1)*(TAN(PSX/2.0)/TAN(PHI1/2.0))**XN
+      IF ( XLATC.LT.0.0 ) THEN
+        XX = R*SIN(FLP)
+        YY = R*COS(FLP)
+      ELSE
+        XX = -R*SIN(FLP)
+        YY = R*COS(FLP)
+      END IF
+
+!  TRANSFORM (1,1) TO THE ORIGIN
+
+      CENTRI = FLOAT(IMAX + 1)/2.0
+      CENTRJ = FLOAT(JMAX + 1)/2.0
+      X = ( XX - XC )/DS + CENTRJ
+      Y = ( YY - YC )/DS + CENTRI
+
+      return
+  END SUBROUTINE llxy_lam
+
+  SUBROUTINE llxy(xlat,xlon,x,y,xlatc,xlonc,kproj,psi1,psi2,ds,    &
+                      xn,sn_max,we_max,parent_grid_ratio,        &
+                      i_parent_start,j_parent_start)
+ 
+      IMPLICIT NONE
+ 
+!     CALCULATE X AND Y GIVEN LATITUDE AND LONGITUDE.
+!     PETER HOWELLS, NCAR, 1984
+ 
+      REAL, intent(in)    :: xlat
+      REAL, intent(inout) :: xlon
+      REAL, intent(out)   :: x
+      REAL, intent(out)   :: y
+      REAL, intent(in)    :: xlatc
+      REAL, intent(in)    :: xlonc
+      INTEGER, intent(in) :: kproj 
+      REAL, intent(in)    :: psi1
+      REAL, intent(in)    :: psi2 
+      REAL, intent(in)    :: ds
+      REAL, intent(in)    :: xn
+      INTEGER, intent(in) :: sn_max
+      INTEGER, intent(in) :: we_max
+      INTEGER, intent(in) :: parent_grid_ratio
+      INTEGER, intent(in) :: i_parent_start
+      INTEGER, intent(in) :: j_parent_start
+
+!***  DECLARATIONS FOR IMPLICIT NONE                                    
+      real conv, a, phi1, pole, c2, xc, phicr, cell, yc, xlatr
+      real phic, xx, yy, centri, centrj, ylon, flp, psx, r
+      integer imax, jmax, imapst, jmapst
+
+!       write(6,*) 'enter llxy'
+!       write(6,*) 'enter llxy: xlatc = ',xlatc,' xlonc = ',xlonc
+!       write(6,*) 'xlat = ',xlat,' xlon = ',xlon
+!       write(6,*) 'psi1 = ',psi1,' psi2 = ',psi2
+!       write(6,*) 'xn = ',xn,' kproj = ',kproj,' ds = ',ds
+!       write(6,*) 'sn_max = ',sn_max,' we_max = ',we_max
+!       write(6,*) 'parent_grid_ratio = ',parent_grid_ratio
+!       write(6,*) 'i_parent_start = ',i_parent_start
+!       write(6,*) 'j_parent_start = ',j_parent_start
+
+      conv = 57.29578
+      a = 6370.0
+!      imax  = sn_max*parent_grid_ratio+1
+!      jmax  = we_max*parent_grid_ratio+1
+       imax  = sn_max*parent_grid_ratio       !ajb for WRF
+       jmax  = we_max*parent_grid_ratio       !ajb for WRF
+      imapst= (j_parent_start-1)*parent_grid_ratio+1
+      jmapst= (i_parent_start-1)*parent_grid_ratio+1
+      phi1 = 90.0-psi2
+      pole = 90.0
+
+      if ( xlatc.lt.0.0 ) then
+        phi1 = -90.0-psi2
+        pole = -pole
+      endif
+ 
+      if (kproj.eq.3) then
+! MERCATOR PROJECTION
+        C2     = A*COS(PSI1)
+        XC     = 0.0
+        PHICR  = XLATC/CONV
+        CELL   = COS(PHICR)/(1.0+SIN(PHICR))
+        YC     = - C2*ALOG(CELL)
+        IF (XLAT.NE.-90.) THEN
+           XLATR = XLAT/CONV
+           CELL = COS(XLATR)/(1.0+SIN(XLATR))
+           YY = -C2*ALOG(CELL)
+           IF (XLONC.LT.0.0) THEN
+             IF (XLON.GT.0.0) XLON=XLON-360.
+           ELSE
+             IF (XLON.LT.0.0) XLON=360.+XLON
+           ENDIF
+           XX = C2*(XLON-XLONC)/CONV
+        ENDIF
+ 
+      ELSE IF (KPROJ.EQ.1) THEN
+! LAMBERT-COMFORMAL or POLAR-STEREO PROJECTION
+      PHIC = ( POLE - XLATC )/CONV
+      PHI1 = PHI1/CONV
+      XC = 0.0
+      YC = -A/XN*SIN(PHI1)*(TAN(PHIC/2.0)/TAN(PHI1/2.0))**XN
+ 
+!     CALCULATE X,Y COORDS. RELATIVE TO POLE
+ 
+      YLON = XLON - XLONC
+      IF(YLON.GT.180) YLON = YLON - 360.
+      IF(YLON.LT.-180) YLON = YLON + 360.
+      FLP = XN*YLON/CONV
+      PSX = ( POLE - XLAT )/CONV
+      R = -A/XN*SIN(PHI1)*(TAN(PSX/2.0)/TAN(PHI1/2.0))**XN
+      IF ( XLATC.LT.0.0 ) THEN
+         XX = R*SIN(FLP)
+         YY = R*COS(FLP)
+      ELSE
+         XX = -R*SIN(FLP)
+         YY = R*COS(FLP)
+      END IF
+      END IF
+ 
+!  TRANSFORM (1,1) TO THE ORIGIN
+ 
+      CENTRI = FLOAT(IMAX + 1)/2.0
+      CENTRJ = FLOAT(JMAX + 1)/2.0
+      X = ( XX - XC )/DS + CENTRJ  - jmapst + 1      
+      Y = ( YY - YC )/DS + CENTRI  - imapst + 1
+
+      RETURN
+  END SUBROUTINE llxy
+
+  SUBROUTINE llxy_try(xlat,xlon,x,y,xlatc,xlonc,kproj,psi1a,psi2,ds,    &
+                    xn,sn_max,we_max,parent_grid_ratio,                   &
+                    i_parent_start,j_parent_start)
+ 
+      IMPLICIT NONE
+ 
+!     CALCULATE X AND Y GIVEN LATITUDE AND LONGITUDE.
+!     PETER HOWELLS, NCAR, 1984
+ 
+      REAL, intent(in)    :: xlat
+      REAL, intent(inout) :: xlon
+      REAL, intent(out)   :: x
+      REAL, intent(out)   :: y
+      REAL, intent(in)    :: xlatc
+      REAL, intent(in)    :: xlonc
+      INTEGER, intent(in) :: kproj 
+      REAL, intent(in)    :: psi1a
+      REAL, intent(in)    :: psi2 
+      REAL, intent(in)    :: ds
+      REAL, intent(in)    :: xn
+      INTEGER, intent(in) :: sn_max
+      INTEGER, intent(in) :: we_max
+      INTEGER, intent(in) :: parent_grid_ratio
+      INTEGER, intent(in) :: i_parent_start
+      INTEGER, intent(in) :: j_parent_start
+
+!***  DECLARATIONS FOR IMPLICIT NONE                                    
+      real conv, a, phi1, pole, c2, xc, phicr, cell, yc, xlatr
+      real phic, xx, yy, centri, centrj, ylon, flp, psx, r
+      integer imax, jmax, imapst, jmapst
+      integer jmxc,imxc,iratio
+      real ric0,rjc0,rs,yind,xind,rix,rjx,psi1
+
+!       write(6,*) 'enter llxy'
+!       write(6,*) 'enter llxy: xlatc = ',xlatc,' xlonc = ',xlonc
+!       write(6,*) 'psi1 = ',psi1a,' psi2 = ',psi2
+!       write(6,*) 'xn = ',xn,' kproj = ',kproj,' ds = ',ds
+!       write(6,*) 'sn_max = ',sn_max,' we_max = ',we_max
+!       write(6,*) 'parent_grid_ratio = ',parent_grid_ratio
+!       write(6,*) 'i_parent_start = ',i_parent_start
+!       write(6,*) 'j_parent_start = ',j_parent_start
+
+      conv = 57.29578
+      a = 6370.0
+      imax  = sn_max*parent_grid_ratio+1
+      jmax  = we_max*parent_grid_ratio+1
+      imapst= (j_parent_start-1)*parent_grid_ratio+1
+      jmapst= (i_parent_start-1)*parent_grid_ratio+1
+      iratio = parent_grid_ratio
+      imxc = imax
+      jmxc = jmax
+      rix=imapst
+      rjx=jmapst
+
+      phi1 = psi1a
+      if(xlatc .gt. 0.) then
+       psi1=90.-phi1
+      else
+       psi1=-90+abs(phi1)
+      endif
+
+      ric0=(imxc+1.)*0.5
+      rjc0=(jmxc+1.)*0.5
+
+!      if(kproj .eq. 1) then
+       if(kproj .le. 2) then
+       if(xlatc .gt. 0.) then
+        rs=a/xn*sin(psi1/conv)*(tan((90.-xlat)/conv/2.)           &
+            /tan(psi1/2./conv))**xn
+        yc=-a/xn*sin(psi1/conv)*(tan((90.-xlatc)/conv/2.)         &
+            /tan(psi1/2./conv))**xn
+       else
+        rs=a/xn*sin(psi1/conv)*(tan((-90.-xlat)/conv/2.)          &
+            /tan(psi1/2./conv))**xn
+        yc=-a/xn*sin(psi1/conv)*(tan((-90.-xlatc)/conv/2.)        &
+            /tan(psi1/2./conv))**xn
+       endif
+!     elseif(kproj .eq. 2) then
+!       if(xlatc .gt. 0.) then
+!        rs=a*sin((90.-xlat)/conv)*(1.+cos(psi1/conv))
+!     &     /(1.+cos((90.-xlat)/conv))
+!        yc=-a*sin((90.-xlatc)/conv)*(1.+cos(psi1/conv))
+!     &     /(1.+cos((90.-xlatc)/conv))
+!       else
+!        rs=a*sin((-90.-xlat)/conv)*(1.+cos(psi1/conv))
+!     &     /(1.+cos((-90.-xlat)/conv))
+!        yc=-a*sin((-90.-xlatc)/conv)*(1.+cos(psi1/conv))
+!     &     /(1.+cos((-90.-xlatc)/conv))
+!      endif
+      else
+       psi1 = 0           ! yliu added
+       c2=a*cos(psi1/conv)
+       yc=c2*alog((1.+sin(xlatc/conv))/cos(xlatc/conv))
+      endif
+
+      if(kproj .le. 2) then
+        y=(ric0-(yc/ds+rs/ds*cos(xn*(xlon-xlonc)/conv))-rix)      &
+             *iratio+1.0
+        if(xlatc .gt. 0.) then
+         x=(rjc0+rs/ds*sin(xn*(xlon-xlonc)/conv)-rjx)*iratio+1.0
+        else
+         x=(rjc0-rs/ds*sin(xn*(xlon-xlonc)/conv)-rjx)*iratio+1.0
+        endif
+      else
+       y=c2*alog((1.+sin(xlat/conv))/cos(xlat/conv))
+       x=c2*(xlon-xlonc)/conv
+       y=(ric0+(y-yc)/ds-rix)*iratio+1.0
+       x=(rjc0+x/ds-rjx)*iratio+1.0
+      endif
+        write(6,*) 'xj = ',x, 'yi = ',y,"xlat",xlat,"xlon",xlon
+
+      RETURN
+  END SUBROUTINE llxy_try
+
+#endif
+!-----------------------------------------------------------------------
+! End subroutines for in4dob
+!-----------------------------------------------------------------------
Index: trunk/WRF.COMMON/WRFV2/share/wrf_histin.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_histin.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_histin.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_histin ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_histin.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_histout.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_histout.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_histout.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_histout ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_histout.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_inputin.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_inputin.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_inputin.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_inputin ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_inputin.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_inputout.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_inputout.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_inputout.F	(revision 2744)
@@ -0,0 +1,56 @@
+  SUBROUTINE wrf_inputout ( fid , grid , config_flags, switch , &
+                            dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+! generated by the registry
+#include <wrf_inputout.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_restartin.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_restartin.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_restartin.F	(revision 2744)
@@ -0,0 +1,58 @@
+SUBROUTINE wrf_restartin ( fid , grid , config_flags , switch , ierr )
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_io
+    USE module_io_wrf
+    USE module_date_time
+    USE module_bc_time_utilities
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid
+    INTEGER, INTENT(IN) :: switch
+    INTEGER, INTENT(INOUT) :: ierr
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER       iname(9)
+    INTEGER       iordering(3)
+    INTEGER       icurrent_date(24)
+    INTEGER       i,j,k
+    INTEGER       icnt
+    INTEGER       ndim
+    INTEGER       ilen
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    CHARACTER*256 errmess
+    CHARACTER*40            :: this_datestr, next_datestr
+    CHARACTER*9   NAMESTR
+    INTEGER       IBDY, NAMELEN
+    LOGICAL wrf_dm_on_monitor
+    EXTERNAL wrf_dm_on_monitor
+    CHARACTER*19  new_date
+    CHARACTER*24  base_date
+    INTEGER idt
+    INTEGER itmp, dyn_opt
+    INTEGER :: ide_compare , jde_compare , kde_compare
+    ierr = 0
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    CALL nl_get_dyn_opt ( 1 , dyn_opt )
+
+#include <wrf_restartin.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share/wrf_restartout.F
===================================================================
--- trunk/WRF.COMMON/WRFV2/share/wrf_restartout.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share/wrf_restartout.F	(revision 2744)
@@ -0,0 +1,57 @@
+  SUBROUTINE wrf_restartout ( fid , grid , config_flags, switch , &
+                           dryrun, ierr )
+    USE module_io
+    USE module_wrf_error
+    USE module_io_wrf
+    USE module_domain
+    USE module_state_description
+    USE module_configure
+    USE module_utility
+    IMPLICIT NONE
+#include <wrf_io_flags.h>
+#include <wrf_status_codes.h>
+    TYPE(domain) :: grid
+    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
+    INTEGER, INTENT(IN) :: fid, switch
+    INTEGER, INTENT(INOUT) :: ierr
+    LOGICAL, INTENT(IN) :: dryrun
+
+    ! Local data
+    INTEGER ids , ide , jds , jde , kds , kde , &
+            ims , ime , jms , jme , kms , kme , &
+            ips , ipe , jps , jpe , kps , kpe
+
+    INTEGER       itrace
+    INTEGER , DIMENSION(3) :: domain_start , domain_end
+    INTEGER , DIMENSION(3) :: memory_start , memory_end
+    INTEGER , DIMENSION(3) :: patch_start , patch_end
+    INTEGER i,j
+    INTEGER julyr, julday, idt, iswater , map_proj
+    REAL    gmt, cen_lat, cen_lon, bdyfrq , truelat1 , truelat2
+    INTEGER dyn_opt, diff_opt, km_opt, damp_opt,  &
+            mp_physics, ra_lw_physics, ra_sw_physics, sf_sfclay_physics, &
+            sf_surface_physics, bl_pbl_physics, cu_physics
+    REAL    khdif, kvdif
+    INTEGER rc
+
+    CHARACTER*256 message
+    CHARACTER*80  char_junk
+    INTEGER    ibuf(1)
+    REAL       rbuf(1)
+    CHARACTER*40            :: next_datestr
+
+    CALL get_ijk_from_grid (  grid ,                        &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              ips, ipe, jps, jpe, kps, kpe    )
+
+    call nl_get_dyn_opt ( 1 , dyn_opt                       )
+
+    ! note that the string current_date comes in through use association
+    ! of module_io_wrf
+
+! generated by the registry
+#include <wrf_restartout.inc>
+
+    RETURN
+    END
Index: trunk/WRF.COMMON/WRFV2/share_save
===================================================================
--- trunk/WRF.COMMON/WRFV2/share_save	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/share_save	(revision 2744)
@@ -0,0 +1,7 @@
+mkdir save/share
+cp -rf share/module_date_time.F save/share
+cp -rf share/diff_module_model_constants save/share
+cp -rf share/module_model_constants.F* save/share
+cp -rf share/mediation_integrate.F save/share
+cp -rf share/diff_module_date_time save/share
+cp -rf share/diff_mediation_integrate save/share
Index: trunk/WRF.COMMON/WRFV2/test/em_b_wave/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_b_wave/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_b_wave/namelist.input	(revision 2744)
@@ -0,0 +1,114 @@
+ &time_control
+ run_days                            = 5,
+ run_hours                           = 0,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 0001, 0001, 0001,
+ start_month                         = 01,   01,   01,
+ start_day                           = 01,   01,   01,
+ start_hour                          = 00,   00,   00,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 0001, 0001, 0001,
+ end_month                           = 01,   01,   01,
+ end_day                             = 05,   05,   05,
+ end_hour                            = 00,   00,   00,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ history_interval                    = 360,  360,  360,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 3600,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 600,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 41,    41,    41,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 81,    81,    81,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 65,    65,    65,
+ dx                                  = 100000,20000, 4000,
+ dy                                  = 100000,20000, 4000,
+ ztop                                = 16000, 16000, 16000,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     17,    17,
+ j_parent_start                      = 0,     33,    33,
+ parent_grid_ratio                   = 1,     5,     5,
+ parent_time_step_ratio              = 1,     5,     5,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 0,     0,     0,
+ ra_lw_physics                       = 0,     0,     0,
+ ra_sw_physics                       = 0,     0,     0,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 0,     0,     0,
+ sf_surface_physics                  = 0,     0,     0,
+ bl_pbl_physics                      = 0,     0,     0,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 0,     0,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ num_soil_layers                     = 5,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 1,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+ zdamp                               = 4000.,  4000.,  4000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ smdiv                               = 0.1,    0.1,    0.1,
+ emdiv                               = 0.01,   0.01,   0.01,
+ epssm                               = 0.1,    0.1,    0.1
+ non_hydrostatic                     = .true., .true., .true.,
+ time_step_sound                     = 4,      4,      4,
+ h_mom_adv_order                     = 5,      5,      5,
+ v_mom_adv_order                     = 3,      3,      3,
+ h_sca_adv_order                     = 5,      5,      5,
+ v_sca_adv_order                     = 3,      3,      3,
+ /
+
+ &bdy_control
+ periodic_x                          = .true., .false.,.false.,
+ symmetric_xs                        = .false.,.false.,.false.,
+ symmetric_xe                        = .false.,.false.,.false.,
+ open_xs                             = .false.,.false.,.false.,
+ open_xe                             = .false.,.false.,.false.,
+ periodic_y                          = .false.,.false.,.false.,
+ symmetric_ys                        = .true., .false.,.false.,
+ symmetric_ye                        = .true., .false.,.false.,
+ open_ys                             = .false.,.false.,.false.,
+ open_ye                             = .false.,.false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_b_wave/namelist.input.backwards
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_b_wave/namelist.input.backwards	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_b_wave/namelist.input.backwards	(revision 2744)
@@ -0,0 +1,114 @@
+ &time_control
+ run_days                            = -5,
+ run_hours                           = 0,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 0001, 0001, 0001,
+ start_month                         = 01,   01,   01,
+ start_day                           = 01,   01,   01,
+ start_hour                          = 00,   00,   00,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 0000, 0001, 0001,
+ end_month                           = 12,   01,   01,
+ end_day                             = 27,   05,   05,
+ end_hour                            = 00,   00,   00,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ history_interval                    = 360,  360,  360,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 3600,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = -600,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 41,    41,    41,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 81,    81,    81,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 65,    65,    65,
+ dx                                  = 100000,20000, 4000,
+ dy                                  = 100000,20000, 4000,
+ ztop                                = 16000, 16000, 16000,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     17,    17,
+ j_parent_start                      = 0,     33,    33,
+ parent_grid_ratio                   = 1,     5,     5,
+ parent_time_step_ratio              = 1,     5,     5,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 0,     0,     0,
+ ra_lw_physics                       = 0,     0,     0,
+ ra_sw_physics                       = 0,     0,     0,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 0,     0,     0,
+ sf_surface_physics                  = 0,     0,     0,
+ bl_pbl_physics                      = 0,     0,     0,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 0,     0,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ num_soil_layers                     = 5,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 1,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+ zdamp                               = 4000.,  4000.,  4000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ smdiv                               = 0.1,    0.1,    0.1,
+ emdiv                               = 0.01,   0.01,   0.01,
+ epssm                               = 0.1,    0.1,    0.1
+ non_hydrostatic                     = .true., .true., .true.,
+ time_step_sound                     = 4,      4,      4,
+ h_mom_adv_order                     = 5,      5,      5,
+ v_mom_adv_order                     = 3,      3,      3,
+ h_sca_adv_order                     = 5,      5,      5,
+ v_sca_adv_order                     = 3,      3,      3,
+ /
+
+ &bdy_control
+ periodic_x                          = .true., .false.,.false.,
+ symmetric_xs                        = .false.,.false.,.false.,
+ symmetric_xe                        = .false.,.false.,.false.,
+ open_xs                             = .false.,.false.,.false.,
+ open_xe                             = .false.,.false.,.false.,
+ periodic_y                          = .false.,.false.,.false.,
+ symmetric_ys                        = .true., .false.,.false.,
+ symmetric_ye                        = .true., .false.,.false.,
+ open_ys                             = .false.,.false.,.false.,
+ open_ye                             = .false.,.false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_b_wave/run_me_first.csh
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_b_wave/run_me_first.csh	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_b_wave/run_me_first.csh	(revision 2744)
@@ -0,0 +1,8 @@
+#!/bin/csh
+
+echo Setting up b_wave case by linking data files into this directory
+
+echo linking to RRTM_DATA in ../../run directory
+ln -sf ../../run/RRTM_DATA .
+
+echo done
Index: trunk/WRF.COMMON/WRFV2/test/em_esmf_exp/README_WRF_CPL_SST.txt
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_esmf_exp/README_WRF_CPL_SST.txt	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_esmf_exp/README_WRF_CPL_SST.txt	(revision 2744)
@@ -0,0 +1,207 @@
+
+
+                  Summary of ESMF-Coupled WRF Experiment
+
+                              Tom Henderson
+                             John Michalakes
+                                NCAR/MMM
+                             12 October 2006
+
+INTRODUCTION
+
+This document describes ESMF-enablement and coupling of WRF through ESMF
+to another component that simulates coupling to an ocean model. As a
+prelude to availability of an ESMF-enabled implementation of the HYCOM
+model, WRF has been coupled through ESMF to a very simple "data-ocean"
+component named "SST" via a very simple coupler component named "CPL".
+The demonstration, conducted on kraken.navo.hpc.mil, a DoD HPC system
+at the NAVO MSRC, was supported by AFWA under UCAR contract FA4600-05-P-0162.  
+The demonstration was later repeated on NCAR's bluesky machine (IBM p690).  A 
+description of the bluesky experiment follows.  
+
+
+
+EXPERIMENT DETAILS
+
+  The "WRF+CPL+SST" experiment was conducted on bluesky on 12 October 2006 at 
+which time the following software was installed:  
+  xlfrte   8.1.1.6
+  bos.mp   5.1.0.58
+  xlC.rte   6.0.0.0
+  ESMF 2.2.0rp1
+WRF source code was installed in
+/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/.  
+
+(Note that this experiment was also attempted using an installation of 
+ESMF 3.0.0.  This experiment failed due to exhaustion of compiler resources 
+building real.exe.  The ESMF core team has been notified of this problem and 
+is working with IBM to resolve it.)  
+
+  Additional documentation that describes the SST component and provides 
+instructions for building WRF with ESMF can be found in 
+external/io_esmf/README.io_esmf.  Briefly, the 
+SST component simply reads SST data stored in a file (sstin_d01_000000), sends 
+it to WRF via CPL, receives SST data back from WRF via CPL, and verifies that 
+data received matches data sent.  Since ESMF coupling is implemented within 
+WRF via the WRF I/O and coupling API (WRF IOAPI), the experiment can be 
+repeated reading the SST data directly into WRF as a netCDF file simply by 
+changing the appropriate I/O format in the WRF "namelist.input" file.  This 
+feature is illustrated below.  
+
+  The following "recipe" can be used to reproduce the experiment, if desired.  
+All commands are csh.  
+
+
+1)  Set environment variables to build WRF with ESMF using 32-bit addressing.  
+The $ESMFLIB and $ESMFINC environment variables are used to tell the WRF build 
+automation where to find an installation of ESMF 2.2.0rp1.  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2 >> setenv OBJECT_MODE 32
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2 >> setenv ESMFLIB /home/bluesky/hender/esmf/lib/libO/AIX.default.32.default
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2 >> setenv ESMFINC /home/bluesky/hender/esmf/mod/modO/AIX.default.32.default
+
+
+
+2)  Set up WRF Registry for WRF+CPL+SST case:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/Registry >> mv -f Registry.EM Registry.EM_ORIG
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/Registry >> cp -f Registry.EM_SST Registry.EM
+
+
+
+3)  Build WRF from scratch with RSL for use with ESMF:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2 >> echo 4 | configure
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2 >> compile em_real >&! compile.em_real.4.out
+
+  Verify that executables exist:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2 >> ls -al main/*exe*
+-rwxr-xr-x   1 hender   ncar       12554240 Oct 12 15:32 main/ndown.exe
+-rwxr-xr-x   1 hender   ncar       11220419 Oct 12 15:33 main/nup.exe
+-rwxr-xr-x   1 hender   ncar       11595285 Oct 12 15:32 main/real.exe
+-rwxr-xr-x   1 hender   ncar       18018321 Oct 12 15:30 main/wrf.exe
+-rwxr-xr-x   1 hender   ncar       18486948 Oct 12 15:31 main/wrf_SST_ESMF.exe
+
+  Note that "wrf.exe" is the usual stand-alone WRF executable.  
+"wrf_SST_ESMF.exe" is the WRF+CPL+SST coupled application.  
+
+
+
+4)  Go to run directory, unpack the required SST data, namelists and run 
+scripts from WRF_CPL_SST.tar.gz, and verify that all required files are
+present:   
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> gunzip WRF_CPL_SST.tar.gz
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> tar xvf WRF_CPL_SST.tar
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> ls -l sstin_d01_000000 namelist.input.jan00.* *.csh
+-rwxr-xr-x   1 hender   ncar   6008 Oct 12 12:49 namelist.input.jan00.ESMFSST
+-rwxr-xr-x   1 hender   ncar   6008 Oct 12 12:49 namelist.input.jan00.NETCDFSST
+-rw-r--r--   1 hender   ncar   1271 Oct 12 12:49 real.csh
+-rw-r--r--   1 hender   ncar 458064 Oct 12 11:35 sstin_d01_000000
+-rw-r--r--   1 hender   ncar   1070 Oct 12 12:49 test4_0.csh
+-rw-r--r--   1 hender   ncar   1150 Oct 12 12:49 test4_0_ESMFSST.csh
+-rw-r--r--   1 hender   ncar   1186 Oct 12 12:49 test4_0_NETCDFSST_wrfexe.csh
+
+  "sstin_d01_000000" contains time-varying SST input data.  
+
+  "test4_0_ESMFSST.csh" is a LoadLeveler batch submission script that runs the 
+WRF+CPL+SST coupled system.  It copies "namelist.input.jan00.ESMFSST" to 
+"namelist.input" and runs "wrf_SST_ESMF.exe" on four CPUs.  
+
+  "test4_0_NETCDFSST.csh" is a LoadLeveler batch submission script that runs 
+WRF by itself, reading the SST data directly into WRF as a netCDF file.  It 
+copies "namelist.input.jan00.NETCDFSST" to "namelist.input" and runs "wrf.exe" 
+on four CPUs.  
+
+  Note that namelists namelist.input.jan00.ESMFSST and 
+namelist.input.jan00.NETCDFSST differ only in the I/O format used for the 
+I/O streams used to "read" and "write" SST data.  Vanilla netCDF I/O is used 
+when "io_form" == 2.  ESMFStates are used when "io_form" == 7.  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> diff namelist.input.jan00.ESMFSST namelist.input.jan00.NETCDFSST
+32c32
+<  io_form_auxinput5                   = 7,
+---
+>  io_form_auxinput5                   = 2,
+37c37
+<  io_form_auxhist5                    = 7,
+---
+>  io_form_auxhist5                    = 2,
+
+  (Also note that a script is provided to run WRF without SST forcing for 
+comparison purposes.  "test4_0.csh" is a LoadLeveler batch submission script 
+that runs WRF by itself without SST forcing.  It copies "namelist.input.jan00" 
+to "namelist.input" and runs "wrf.exe" on four CPUs.)  
+
+
+
+5)  Run the wrf real program using the "jan00" data set.  Script "real.csh" 
+can be modified to do this if desired.  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> llsubmit real.csh
+
+  Verify that real.exe produced the usual WRF input and boundary data files 
+"wrfbdy_d01" and "wrfinput_d01".  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real
+>> ls -al wrfbdy_d01 wrfinput_d01
+-rw-r--r--   1 hender   ncar        9355792 Oct 12 12:58 wrfbdy_d01
+-rw-r--r--   1 hender   ncar        6005368 Oct 12 12:58 wrfinput_d01
+
+Move all other files produced by the real.exe run into a new directory:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> mkdir real.out
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> mv PET?.ESMF* namelist.input rsl.*.* real.*.err real.*.out real.out
+
+
+
+6)  Run the WRF+CPL+SST test case:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> llsubmit test4_0_ESMFSST.csh
+
+
+
+7)  Verify that run completed successfully:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> tail -1 rsl.out.0000
+ d01 2000-01-25_00:00:00 wrf: SUCCESS COMPLETE WRF
+
+
+
+8)  Move all files produced by the WRF+CPL+SST run into a new directory:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> mkdir test4_0_ESMFSST.out
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> mv PET?.ESMF* namelist.input rsl.*.* test4_0_ESMFSST.*.* wrfout* test4_0_ESMFSST.out
+
+
+
+9)  Run the WRF stand-alone test case:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> llsubmit test4_0_NETCDFSST_wrfexe.csh
+
+
+
+10)  Verify that run completed successfully:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> tail -1 rsl.out.0000
+ d01 2000-01-25_00:00:00 wrf: SUCCESS COMPLETE WRF
+
+
+
+11)  Move all files produced by the WRF stand-alone run into a new directory:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> mkdir test4_0_NETCDFSST.out
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> mv PET?.ESMF* namelist.input rsl.*.* test4_0_NETCDFSST.*.* wrfout* sstout_d01_000000 test4_0_NETCDFSST.out
+
+
+
+12)  Verify that both tests produced bitwise-identical history output:  
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> ls -l test4_0_ESMFSST.out/wrfout_d01_2000-01-24_12:00:00 test4_0_NETCDFSST.out/wrfout_d01_2000-01-24_12:00:00
+-rw-r--r--   1 hender   ncar       32614704 Oct 12 15:48 test4_0_ESMFSST.out/wrfout_d01_2000-01-24_12:00:00
+-rw-r--r--   1 hender   ncar       32614704 Oct 12 15:52 test4_0_NETCDFSST.out/wrfout_d01_2000-01-24_12:00:00
+
+bluesky:/ptmp/hender/ESMF2.2.0rp1/WRFV2_20061005_1123_WORK/WRFV2/test/em_real >> cmp -l test4_0_ESMFSST.out/wrfout_d01_2000-01-24_12:00:00 test4_0_NETCDFSST.out/wrfout_d01_2000-01-24_12:00:00 | wc
+       0       0       0
+
Index: trunk/WRF.COMMON/WRFV2/test/em_esmf_exp/namelist.input.jan00.ESMFSST
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_esmf_exp/namelist.input.jan00.ESMFSST	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_esmf_exp/namelist.input.jan00.ESMFSST	(revision 2744)
@@ -0,0 +1,142 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2000, 2000, 2000,
+ start_month                         = 01,   01,   01,
+ start_day                           = 24,   24,   24,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2000, 2000, 2000,
+ end_month                           = 01,   01,   01,
+ end_day                             = 25,   25,   25,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 21600,
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ io_form_history                     = 2,
+ io_form_restart                     = 2,
+ io_form_input                       = 2,
+ io_form_boundary                    = 2,
+ debug_level                         = 0,
+ auxinput5_inname                    = 'sstin_d01_000000',
+ auxinput5_interval_h                = 1,
+ auxinput5_end_h                     = 13,
+ io_form_auxinput5                   = 7,
+ auxhist5_outname                    = 'sstout_d01_000000',
+ frames_per_auxhist5                 = 1000,
+ auxhist5_interval_h                 = 1,
+ auxhist5_end_h                      = 13,
+ io_form_auxhist5                    = 7,
+ /
+
+ &domains
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 30000, 10000,  3333,
+ dy                                  = 30000, 10000,  3333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    30,
+ j_parent_start                      = 0,     17,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 3,     3,     3,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 1,     1,     1,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 5,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ sst_update                          = 1,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ w_damping                           = 0,
+ diff_opt                            = 0,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+ base_temp                           = 290.
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ smdiv                               = 0.1,    0.1,    0.1,
+ emdiv                               = 0.01,   0.01,   0.01,
+ epssm                               = 0.1,    0.1,    0.1
+ non_hydrostatic                     = .true., .true., .true.,
+ time_step_sound                     = 4,      4,      4,
+ h_mom_adv_order                     = 5,      5,      5,
+ v_mom_adv_order                     = 3,      3,      3,
+ h_sca_adv_order                     = 5,      5,      5,
+ v_sca_adv_order                     = 3,      3,      3,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ periodic_x                          = .false.,.false.,.false.,
+ symmetric_xs                        = .false.,.false.,.false.,
+ symmetric_xe                        = .false.,.false.,.false.,
+ open_xs                             = .false.,.false.,.false.,
+ open_xe                             = .false.,.false.,.false.,
+ periodic_y                          = .false.,.false.,.false.,
+ symmetric_ys                        = .false.,.false.,.false.,
+ symmetric_ye                        = .false.,.false.,.false.,
+ open_ys                             = .false.,.false.,.false.,
+ open_ye                             = .false.,.false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_esmf_exp/namelist.input.jan00.NETCDFSST
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_esmf_exp/namelist.input.jan00.NETCDFSST	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_esmf_exp/namelist.input.jan00.NETCDFSST	(revision 2744)
@@ -0,0 +1,142 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2000, 2000, 2000,
+ start_month                         = 01,   01,   01,
+ start_day                           = 24,   24,   24,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2000, 2000, 2000,
+ end_month                           = 01,   01,   01,
+ end_day                             = 25,   25,   25,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 21600,
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ io_form_history                     = 2,
+ io_form_restart                     = 2,
+ io_form_input                       = 2,
+ io_form_boundary                    = 2,
+ debug_level                         = 0,
+ auxinput5_inname                    = 'sstin_d01_000000',
+ auxinput5_interval_h                = 1,
+ auxinput5_end_h                     = 13,
+ io_form_auxinput5                   = 2,
+ auxhist5_outname                    = 'sstout_d01_000000',
+ frames_per_auxhist5                 = 1000,
+ auxhist5_interval_h                 = 1,
+ auxhist5_end_h                      = 13,
+ io_form_auxhist5                    = 2,
+ /
+
+ &domains
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 30000, 10000,  3333,
+ dy                                  = 30000, 10000,  3333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    30,
+ j_parent_start                      = 0,     17,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 3,     3,     3,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 1,     1,     1,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 5,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ sst_update                          = 1,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ w_damping                           = 0,
+ diff_opt                            = 0,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+ base_temp                           = 290.
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ smdiv                               = 0.1,    0.1,    0.1,
+ emdiv                               = 0.01,   0.01,   0.01,
+ epssm                               = 0.1,    0.1,    0.1
+ non_hydrostatic                     = .true., .true., .true.,
+ time_step_sound                     = 4,      4,      4,
+ h_mom_adv_order                     = 5,      5,      5,
+ v_mom_adv_order                     = 3,      3,      3,
+ h_sca_adv_order                     = 5,      5,      5,
+ v_sca_adv_order                     = 3,      3,      3,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ periodic_x                          = .false.,.false.,.false.,
+ symmetric_xs                        = .false.,.false.,.false.,
+ symmetric_xe                        = .false.,.false.,.false.,
+ open_xs                             = .false.,.false.,.false.,
+ open_xe                             = .false.,.false.,.false.,
+ periodic_y                          = .false.,.false.,.false.,
+ symmetric_ys                        = .false.,.false.,.false.,
+ symmetric_ye                        = .false.,.false.,.false.,
+ open_ys                             = .false.,.false.,.false.,
+ open_ye                             = .false.,.false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/README.grav2d_x
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/README.grav2d_x	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/README.grav2d_x	(revision 2744)
@@ -0,0 +1,53 @@
+em_grav2d_x test case:
+
+The default version of this test case reproduces the
+100 m resolution 2D gravity current.  This test case
+was the focus of a workshop.  The results of this workshop
+are published in
+
+Straka et al, NUMERICAL-SOLUTIONS OF A NONLINEAR DENSITY-CURRENT - A
+BENCHMARK SOLUTION AND COMPARISONS, 
+INT J NUMER METH FL 17 (1): 1-22 JUL 15 1993
+ 
+This test is 2d (x,z) and uses a fixed physical viscosity, hence the
+solution converges.  It also uses a finite length domain with periodic
+conditions, so tests with non-zero horizontal translation are also
+appropriate.  The reference shows tests are several different
+resolutions and these are quite illuminating
+ 
+There are a number of interesting features in this very non-linear
+solution (eddy structure, mins and maxes of temperature and velocity,
+propagation of the gravity current, etc.)
+
+Solution results from the WRF-ARW core can be found on the web at
+http://www.mmm.ucar.edu/individual/skamarock/test_cases/test_cases.html
+
+A number of versions test cases can be run using namelist.input files
+and input_sounding files provided in the test directory.  
+
+Two input_sounding files are provided
+
+(1) input_sounding.um=0
+(2) input_sounding.um=20
+
+The first has no mean wind, the second has a constant horizontal
+environmental wind of 20 m/s.  The no-mean wind case produces a 
+symmetric gravity current, while the 20 m/s wind translates the
+current (see the web page for further details and examples).
+Copy the input_sounding.um=? into input_sounding to run the
+desired case.  The input_sounding file is an ascii file, so
+it can be edited to change the mean wind speed to other values
+if desired.
+
+Three namelist.input files are in this directory and they provide
+for three different resolutions (dx, dz = 100, 200 and 400 m).  
+Again, see the web page listed above for example solutions at
+the different resolutions.  As with the sounding file, copy the
+namelist.input.??? into namelist.input to run the desired case.
+
+The default case is 100 m resolution and um=0.
+
+
+
+
+ 
Index: trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/input_sounding
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/input_sounding	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/input_sounding	(revision 2744)
@@ -0,0 +1,12 @@
+   1000.000     300.00        0.00
+      0.00      300.00        0.00       00.00        0.00
+   1000.00      300.00        0.00       00.00        0.00
+   2000.00      300.00        0.00       00.00        0.00
+   3000.00      300.00        0.00       00.00        0.00
+   4000.00      300.00        0.00       00.00        0.00
+   5000.00      300.00        0.00       00.00        0.00
+   6000.00      300.00        0.00       00.00        0.00
+   7000.00      300.00        0.00       00.00        0.00
+   8000.00      300.00        0.00       00.00        0.00
+   9000.00      300.00        0.00       00.00        0.00
+  10000.00      300.00        0.00       00.00        0.00
Index: trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/input_sounding.um=0
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/input_sounding.um=0	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/input_sounding.um=0	(revision 2744)
@@ -0,0 +1,12 @@
+   1000.000     300.00        0.00
+      0.00      300.00        0.00       00.00        0.00
+   1000.00      300.00        0.00       00.00        0.00
+   2000.00      300.00        0.00       00.00        0.00
+   3000.00      300.00        0.00       00.00        0.00
+   4000.00      300.00        0.00       00.00        0.00
+   5000.00      300.00        0.00       00.00        0.00
+   6000.00      300.00        0.00       00.00        0.00
+   7000.00      300.00        0.00       00.00        0.00
+   8000.00      300.00        0.00       00.00        0.00
+   9000.00      300.00        0.00       00.00        0.00
+  10000.00      300.00        0.00       00.00        0.00
Index: trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/input_sounding.um=20
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/input_sounding.um=20	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/input_sounding.um=20	(revision 2744)
@@ -0,0 +1,12 @@
+   1000.000     300.00        0.00
+      0.00      300.00        0.00       20.00        0.00
+   1000.00      300.00        0.00       20.00        0.00
+   2000.00      300.00        0.00       20.00        0.00
+   3000.00      300.00        0.00       20.00        0.00
+   4000.00      300.00        0.00       20.00        0.00
+   5000.00      300.00        0.00       20.00        0.00
+   6000.00      300.00        0.00       20.00        0.00
+   7000.00      300.00        0.00       20.00        0.00
+   8000.00      300.00        0.00       20.00        0.00
+   9000.00      300.00        0.00       20.00        0.00
+  10000.00      300.00        0.00       20.00        0.00
Index: trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input	(revision 2744)
@@ -0,0 +1,105 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 0,
+ run_minutes                         = 15,
+ run_seconds                         = 0,
+ start_year                          = 0001,
+ start_month                         = 01,
+ start_day                           = 01,
+ start_hour                          = 00,
+ start_minute                        = 00,
+ start_second                        = 00,
+ end_year                            = 0001,
+ end_month                           = 01,
+ end_day                             = 01,
+ end_hour                            = 04,
+ end_minute                          = 00,
+ end_second                          = 00,
+ history_interval                    = 1,
+ frames_per_outfile                  = 1000,
+ restart                             = .false.,
+ restart_interval                    = 600,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 1,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,
+ e_we                                = 513,
+ s_sn                                = 1,
+ e_sn                                = 3,
+ s_vert                              = 1,
+ e_vert                              = 65,
+ dx                                  = 100,
+ dy                                  = 100,
+ ztop                                = 6409.,
+ /
+
+ &physics
+ mp_physics                          = 0,
+ ra_lw_physics                       = 0,
+ ra_sw_physics                       = 0,
+ radt                                = 0,
+ sf_sfclay_physics                   = 0,
+ sf_surface_physics                  = 0,
+ bl_pbl_physics                      = 0,
+ bldt                                = 0,
+ cu_physics                          = 0,
+ cudt                                = 0,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ num_soil_layers                     = 5,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 2,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+ zdamp                               = 15000.,
+ dampcoef                            = 0.025,
+ khdif                               = 75,
+ kvdif                               = 75,
+ smdiv                               = 0.1,
+ emdiv                               = 0.01,
+ epssm                               = 0.1,
+ non_hydrostatic                     = .true.,
+ time_step_sound                     = 6,
+ h_mom_adv_order                     = 5,
+ v_mom_adv_order                     = 3,
+ h_sca_adv_order                     = 5,
+ v_sca_adv_order                     = 3,
+ /
+
+ &bdy_control
+ periodic_x                          = .true.,
+ symmetric_xs                        = .false.,
+ symmetric_xe                        = .false.,
+ open_xs                             = .false., 
+ open_xe                             = .false.,
+ periodic_y                          = .true.,
+ symmetric_ys                        = .false.,
+ symmetric_ye                        = .false.,
+ open_ys                             = .false.,
+ open_ye                             = .false.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input.100m
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input.100m	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input.100m	(revision 2744)
@@ -0,0 +1,105 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 0,
+ run_minutes                         = 15,
+ run_seconds                         = 0,
+ start_year                          = 0001,
+ start_month                         = 01,
+ start_day                           = 01,
+ start_hour                          = 00,
+ start_minute                        = 00,
+ start_second                        = 00,
+ end_year                            = 0001,
+ end_month                           = 01,
+ end_day                             = 01,
+ end_hour                            = 04,
+ end_minute                          = 00,
+ end_second                          = 00,
+ history_interval                    = 1,
+ frames_per_outfile                  = 1000,
+ restart                             = .false.,
+ restart_interval                    = 600,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 1,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,
+ e_we                                = 513,
+ s_sn                                = 1,
+ e_sn                                = 3,
+ s_vert                              = 1,
+ e_vert                              = 65,
+ dx                                  = 100,
+ dy                                  = 100,
+ ztop                                = 6409.,
+ /
+
+ &physics
+ mp_physics                          = 0,
+ ra_lw_physics                       = 0,
+ ra_sw_physics                       = 0,
+ radt                                = 0,
+ sf_sfclay_physics                   = 0,
+ sf_surface_physics                  = 0,
+ bl_pbl_physics                      = 0,
+ bldt                                = 0,
+ cu_physics                          = 0,
+ cudt                                = 0,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ num_soil_layers                     = 5,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 2,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+ zdamp                               = 15000.,
+ dampcoef                            = 0.025,
+ khdif                               = 75,
+ kvdif                               = 75,
+ smdiv                               = 0.1,
+ emdiv                               = 0.01,
+ epssm                               = 0.1,
+ non_hydrostatic                     = .true.,
+ time_step_sound                     = 6,
+ h_mom_adv_order                     = 5,
+ v_mom_adv_order                     = 3,
+ h_sca_adv_order                     = 5,
+ v_sca_adv_order                     = 3,
+ /
+
+ &bdy_control
+ periodic_x                          = .true.,
+ symmetric_xs                        = .false.,
+ symmetric_xe                        = .false.,
+ open_xs                             = .false., 
+ open_xe                             = .false.,
+ periodic_y                          = .true.,
+ symmetric_ys                        = .false.,
+ symmetric_ye                        = .false.,
+ open_ys                             = .false.,
+ open_ye                             = .false.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input.200m
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input.200m	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input.200m	(revision 2744)
@@ -0,0 +1,105 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 0,
+ run_minutes                         = 15,
+ run_seconds                         = 0,
+ start_year                          = 0001,
+ start_month                         = 01,
+ start_day                           = 01,
+ start_hour                          = 00,
+ start_minute                        = 00,
+ start_second                        = 00,
+ end_year                            = 0001,
+ end_month                           = 01,
+ end_day                             = 01,
+ end_hour                            = 04,
+ end_minute                          = 00,
+ end_second                          = 00,
+ history_interval                    = 1,
+ frames_per_outfile                  = 1000,
+ restart                             = .false.,
+ restart_interval                    = 600,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 2,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,
+ e_we                                = 257,
+ s_sn                                = 1,
+ e_sn                                = 3,
+ s_vert                              = 1,
+ e_vert                              = 33,
+ dx                                  = 200,
+ dy                                  = 200,
+ ztop                                = 6409.,
+ /
+
+ &physics
+ mp_physics                          = 0,
+ ra_lw_physics                       = 0,
+ ra_sw_physics                       = 0,
+ radt                                = 0,
+ sf_sfclay_physics                   = 0,
+ sf_surface_physics                  = 0,
+ bl_pbl_physics                      = 0,
+ bldt                                = 0,
+ cu_physics                          = 0,
+ cudt                                = 0,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ num_soil_layers                     = 5,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 2,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+ zdamp                               = 15000.,
+ dampcoef                            = 0.025,
+ khdif                               = 75,
+ kvdif                               = 75,
+ smdiv                               = 0.1,
+ emdiv                               = 0.01,
+ epssm                               = 0.1,
+ non_hydrostatic                     = .true.,
+ time_step_sound                     = 6,
+ h_mom_adv_order                     = 5,
+ v_mom_adv_order                     = 3,
+ h_sca_adv_order                     = 5,
+ v_sca_adv_order                     = 3,
+ /
+
+ &bdy_control
+ periodic_x                          = .true.,
+ symmetric_xs                        = .false.,
+ symmetric_xe                        = .false.,
+ open_xs                             = .false., 
+ open_xe                             = .false.,
+ periodic_y                          = .true.,
+ symmetric_ys                        = .false.,
+ symmetric_ye                        = .false.,
+ open_ys                             = .false.,
+ open_ye                             = .false.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input.400m
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input.400m	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_grav2d_x/namelist.input.400m	(revision 2744)
@@ -0,0 +1,105 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 0,
+ run_minutes                         = 15,
+ run_seconds                         = 0,
+ start_year                          = 0001,
+ start_month                         = 01,
+ start_day                           = 01,
+ start_hour                          = 00,
+ start_minute                        = 00,
+ start_second                        = 00,
+ end_year                            = 0001,
+ end_month                           = 01,
+ end_day                             = 01,
+ end_hour                            = 04,
+ end_minute                          = 00,
+ end_second                          = 00,
+ history_interval                    = 1,
+ frames_per_outfile                  = 1000,
+ restart                             = .false.,
+ restart_interval                    = 600,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 4,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,
+ e_we                                = 129,
+ s_sn                                = 1,
+ e_sn                                = 3,
+ s_vert                              = 1,
+ e_vert                              = 17,
+ dx                                  = 400,
+ dy                                  = 400,
+ ztop                                = 6409.,
+ /
+
+ &physics
+ mp_physics                          = 0,
+ ra_lw_physics                       = 0,
+ ra_sw_physics                       = 0,
+ radt                                = 0,
+ sf_sfclay_physics                   = 0,
+ sf_surface_physics                  = 0,
+ bl_pbl_physics                      = 0,
+ bldt                                = 0,
+ cu_physics                          = 0,
+ cudt                                = 0,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ num_soil_layers                     = 5,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 2,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+ zdamp                               = 15000.,
+ dampcoef                            = 0.025,
+ khdif                               = 75,
+ kvdif                               = 75,
+ smdiv                               = 0.1,
+ emdiv                               = 0.01,
+ epssm                               = 0.1,
+ non_hydrostatic                     = .true.,
+ time_step_sound                     = 6,
+ h_mom_adv_order                     = 5,
+ v_mom_adv_order                     = 3,
+ h_sca_adv_order                     = 5,
+ v_sca_adv_order                     = 3,
+ /
+
+ &bdy_control
+ periodic_x                          = .true.,
+ symmetric_xs                        = .false.,
+ symmetric_xe                        = .false.,
+ open_xs                             = .false., 
+ open_xe                             = .false.,
+ periodic_y                          = .true.,
+ symmetric_ys                        = .false.,
+ symmetric_ye                        = .false.,
+ open_ys                             = .false.,
+ open_ye                             = .false.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_hill2d_x/input_sounding
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_hill2d_x/input_sounding	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_hill2d_x/input_sounding	(revision 2744)
@@ -0,0 +1,602 @@
+   1000.000     288.00        0.00
+      0.00      288.00        0.00       10.00        0.00
+     50.00      288.15        0.00       10.00        0.00
+    100.00      288.29        0.00       10.00        0.00
+    150.00      288.44        0.00       10.00        0.00
+    200.00      288.59        0.00       10.00        0.00
+    250.00      288.74        0.00       10.00        0.00
+    300.00      288.88        0.00       10.00        0.00
+    350.00      289.03        0.00       10.00        0.00
+    400.00      289.18        0.00       10.00        0.00
+    450.00      289.32        0.00       10.00        0.00
+    500.00      289.47        0.00       10.00        0.00
+    550.00      289.62        0.00       10.00        0.00
+    600.00      289.77        0.00       10.00        0.00
+    650.00      289.92        0.00       10.00        0.00
+    700.00      290.06        0.00       10.00        0.00
+    750.00      290.21        0.00       10.00        0.00
+    800.00      290.36        0.00       10.00        0.00
+    850.00      290.51        0.00       10.00        0.00
+    900.00      290.66        0.00       10.00        0.00
+    950.00      290.80        0.00       10.00        0.00
+   1000.00      290.95        0.00       10.00        0.00
+   1050.00      291.10        0.00       10.00        0.00
+   1100.00      291.25        0.00       10.00        0.00
+   1150.00      291.40        0.00       10.00        0.00
+   1200.00      291.55        0.00       10.00        0.00
+   1250.00      291.69        0.00       10.00        0.00
+   1300.00      291.84        0.00       10.00        0.00
+   1350.00      291.99        0.00       10.00        0.00
+   1400.00      292.14        0.00       10.00        0.00
+   1450.00      292.29        0.00       10.00        0.00
+   1500.00      292.44        0.00       10.00        0.00
+   1550.00      292.59        0.00       10.00        0.00
+   1600.00      292.74        0.00       10.00        0.00
+   1650.00      292.89        0.00       10.00        0.00
+   1700.00      293.04        0.00       10.00        0.00
+   1750.00      293.19        0.00       10.00        0.00
+   1800.00      293.34        0.00       10.00        0.00
+   1850.00      293.49        0.00       10.00        0.00
+   1900.00      293.63        0.00       10.00        0.00
+   1950.00      293.78        0.00       10.00        0.00
+   2000.00      293.93        0.00       10.00        0.00
+   2050.00      294.08        0.00       10.00        0.00
+   2100.00      294.23        0.00       10.00        0.00
+   2150.00      294.38        0.00       10.00        0.00
+   2200.00      294.53        0.00       10.00        0.00
+   2250.00      294.68        0.00       10.00        0.00
+   2300.00      294.84        0.00       10.00        0.00
+   2350.00      294.99        0.00       10.00        0.00
+   2400.00      295.14        0.00       10.00        0.00
+   2450.00      295.29        0.00       10.00        0.00
+   2500.00      295.44        0.00       10.00        0.00
+   2550.00      295.59        0.00       10.00        0.00
+   2600.00      295.74        0.00       10.00        0.00
+   2650.00      295.89        0.00       10.00        0.00
+   2700.00      296.04        0.00       10.00        0.00
+   2750.00      296.19        0.00       10.00        0.00
+   2800.00      296.34        0.00       10.00        0.00
+   2850.00      296.49        0.00       10.00        0.00
+   2900.00      296.64        0.00       10.00        0.00
+   2950.00      296.80        0.00       10.00        0.00
+   3000.00      296.95        0.00       10.00        0.00
+   3050.00      297.10        0.00       10.00        0.00
+   3100.00      297.25        0.00       10.00        0.00
+   3150.00      297.40        0.00       10.00        0.00
+   3200.00      297.55        0.00       10.00        0.00
+   3250.00      297.71        0.00       10.00        0.00
+   3300.00      297.86        0.00       10.00        0.00
+   3350.00      298.01        0.00       10.00        0.00
+   3400.00      298.16        0.00       10.00        0.00
+   3450.00      298.31        0.00       10.00        0.00
+   3500.00      298.47        0.00       10.00        0.00
+   3550.00      298.62        0.00       10.00        0.00
+   3600.00      298.77        0.00       10.00        0.00
+   3650.00      298.92        0.00       10.00        0.00
+   3700.00      299.07        0.00       10.00        0.00
+   3750.00      299.23        0.00       10.00        0.00
+   3800.00      299.38        0.00       10.00        0.00
+   3850.00      299.53        0.00       10.00        0.00
+   3900.00      299.69        0.00       10.00        0.00
+   3950.00      299.84        0.00       10.00        0.00
+   4000.00      299.99        0.00       10.00        0.00
+   4050.00      300.14        0.00       10.00        0.00
+   4100.00      300.30        0.00       10.00        0.00
+   4150.00      300.45        0.00       10.00        0.00
+   4200.00      300.60        0.00       10.00        0.00
+   4250.00      300.76        0.00       10.00        0.00
+   4300.00      300.91        0.00       10.00        0.00
+   4350.00      301.06        0.00       10.00        0.00
+   4400.00      301.22        0.00       10.00        0.00
+   4450.00      301.37        0.00       10.00        0.00
+   4500.00      301.53        0.00       10.00        0.00
+   4550.00      301.68        0.00       10.00        0.00
+   4600.00      301.83        0.00       10.00        0.00
+   4650.00      301.99        0.00       10.00        0.00
+   4700.00      302.14        0.00       10.00        0.00
+   4750.00      302.29        0.00       10.00        0.00
+   4800.00      302.45        0.00       10.00        0.00
+   4850.00      302.60        0.00       10.00        0.00
+   4900.00      302.76        0.00       10.00        0.00
+   4950.00      302.91        0.00       10.00        0.00
+   5000.00      303.07        0.00       10.00        0.00
+   5050.00      303.22        0.00       10.00        0.00
+   5100.00      303.38        0.00       10.00        0.00
+   5150.00      303.53        0.00       10.00        0.00
+   5200.00      303.69        0.00       10.00        0.00
+   5250.00      303.84        0.00       10.00        0.00
+   5300.00      304.00        0.00       10.00        0.00
+   5350.00      304.15        0.00       10.00        0.00
+   5400.00      304.31        0.00       10.00        0.00
+   5450.00      304.46        0.00       10.00        0.00
+   5500.00      304.62        0.00       10.00        0.00
+   5550.00      304.77        0.00       10.00        0.00
+   5600.00      304.93        0.00       10.00        0.00
+   5650.00      305.08        0.00       10.00        0.00
+   5700.00      305.24        0.00       10.00        0.00
+   5750.00      305.39        0.00       10.00        0.00
+   5800.00      305.55        0.00       10.00        0.00
+   5850.00      305.71        0.00       10.00        0.00
+   5900.00      305.86        0.00       10.00        0.00
+   5950.00      306.02        0.00       10.00        0.00
+   6000.00      306.17        0.00       10.00        0.00
+   6050.00      306.33        0.00       10.00        0.00
+   6100.00      306.49        0.00       10.00        0.00
+   6150.00      306.64        0.00       10.00        0.00
+   6200.00      306.80        0.00       10.00        0.00
+   6250.00      306.95        0.00       10.00        0.00
+   6300.00      307.11        0.00       10.00        0.00
+   6350.00      307.27        0.00       10.00        0.00
+   6400.00      307.42        0.00       10.00        0.00
+   6450.00      307.58        0.00       10.00        0.00
+   6500.00      307.74        0.00       10.00        0.00
+   6550.00      307.90        0.00       10.00        0.00
+   6600.00      308.05        0.00       10.00        0.00
+   6650.00      308.21        0.00       10.00        0.00
+   6700.00      308.37        0.00       10.00        0.00
+   6750.00      308.52        0.00       10.00        0.00
+   6800.00      308.68        0.00       10.00        0.00
+   6850.00      308.84        0.00       10.00        0.00
+   6900.00      309.00        0.00       10.00        0.00
+   6950.00      309.15        0.00       10.00        0.00
+   7000.00      309.31        0.00       10.00        0.00
+   7050.00      309.47        0.00       10.00        0.00
+   7100.00      309.63        0.00       10.00        0.00
+   7150.00      309.79        0.00       10.00        0.00
+   7200.00      309.94        0.00       10.00        0.00
+   7250.00      310.10        0.00       10.00        0.00
+   7300.00      310.26        0.00       10.00        0.00
+   7350.00      310.42        0.00       10.00        0.00
+   7400.00      310.58        0.00       10.00        0.00
+   7450.00      310.73        0.00       10.00        0.00
+   7500.00      310.89        0.00       10.00        0.00
+   7550.00      311.05        0.00       10.00        0.00
+   7600.00      311.21        0.00       10.00        0.00
+   7650.00      311.37        0.00       10.00        0.00
+   7700.00      311.53        0.00       10.00        0.00
+   7750.00      311.69        0.00       10.00        0.00
+   7800.00      311.85        0.00       10.00        0.00
+   7850.00      312.00        0.00       10.00        0.00
+   7900.00      312.16        0.00       10.00        0.00
+   7950.00      312.32        0.00       10.00        0.00
+   8000.00      312.48        0.00       10.00        0.00
+   8050.00      312.64        0.00       10.00        0.00
+   8100.00      312.80        0.00       10.00        0.00
+   8150.00      312.96        0.00       10.00        0.00
+   8200.00      313.12        0.00       10.00        0.00
+   8250.00      313.28        0.00       10.00        0.00
+   8300.00      313.44        0.00       10.00        0.00
+   8350.00      313.60        0.00       10.00        0.00
+   8400.00      313.76        0.00       10.00        0.00
+   8450.00      313.92        0.00       10.00        0.00
+   8500.00      314.08        0.00       10.00        0.00
+   8550.00      314.24        0.00       10.00        0.00
+   8600.00      314.40        0.00       10.00        0.00
+   8650.00      314.56        0.00       10.00        0.00
+   8700.00      314.72        0.00       10.00        0.00
+   8750.00      314.88        0.00       10.00        0.00
+   8800.00      315.04        0.00       10.00        0.00
+   8850.00      315.20        0.00       10.00        0.00
+   8900.00      315.36        0.00       10.00        0.00
+   8950.00      315.52        0.00       10.00        0.00
+   9000.00      315.69        0.00       10.00        0.00
+   9050.00      315.85        0.00       10.00        0.00
+   9100.00      316.01        0.00       10.00        0.00
+   9150.00      316.17        0.00       10.00        0.00
+   9200.00      316.33        0.00       10.00        0.00
+   9250.00      316.49        0.00       10.00        0.00
+   9300.00      316.65        0.00       10.00        0.00
+   9350.00      316.81        0.00       10.00        0.00
+   9400.00      316.98        0.00       10.00        0.00
+   9450.00      317.14        0.00       10.00        0.00
+   9500.00      317.30        0.00       10.00        0.00
+   9550.00      317.46        0.00       10.00        0.00
+   9600.00      317.62        0.00       10.00        0.00
+   9650.00      317.78        0.00       10.00        0.00
+   9700.00      317.95        0.00       10.00        0.00
+   9750.00      318.11        0.00       10.00        0.00
+   9800.00      318.27        0.00       10.00        0.00
+   9850.00      318.43        0.00       10.00        0.00
+   9900.00      318.60        0.00       10.00        0.00
+   9950.00      318.76        0.00       10.00        0.00
+  10000.00      318.92        0.00       10.00        0.00
+  10050.00      319.08        0.00       10.00        0.00
+  10100.00      319.25        0.00       10.00        0.00
+  10150.00      319.41        0.00       10.00        0.00
+  10200.00      319.57        0.00       10.00        0.00
+  10250.00      319.74        0.00       10.00        0.00
+  10300.00      319.90        0.00       10.00        0.00
+  10350.00      320.06        0.00       10.00        0.00
+  10400.00      320.22        0.00       10.00        0.00
+  10450.00      320.39        0.00       10.00        0.00
+  10500.00      320.55        0.00       10.00        0.00
+  10550.00      320.72        0.00       10.00        0.00
+  10600.00      320.88        0.00       10.00        0.00
+  10650.00      321.04        0.00       10.00        0.00
+  10700.00      321.21        0.00       10.00        0.00
+  10750.00      321.37        0.00       10.00        0.00
+  10800.00      321.53        0.00       10.00        0.00
+  10850.00      321.70        0.00       10.00        0.00
+  10900.00      321.86        0.00       10.00        0.00
+  10950.00      322.03        0.00       10.00        0.00
+  11000.00      322.19        0.00       10.00        0.00
+  11050.00      322.35        0.00       10.00        0.00
+  11100.00      322.52        0.00       10.00        0.00
+  11150.00      322.68        0.00       10.00        0.00
+  11200.00      322.85        0.00       10.00        0.00
+  11250.00      323.01        0.00       10.00        0.00
+  11300.00      323.18        0.00       10.00        0.00
+  11350.00      323.34        0.00       10.00        0.00
+  11400.00      323.51        0.00       10.00        0.00
+  11450.00      323.67        0.00       10.00        0.00
+  11500.00      323.84        0.00       10.00        0.00
+  11550.00      324.00        0.00       10.00        0.00
+  11600.00      324.17        0.00       10.00        0.00
+  11650.00      324.33        0.00       10.00        0.00
+  11700.00      324.50        0.00       10.00        0.00
+  11750.00      324.66        0.00       10.00        0.00
+  11800.00      324.83        0.00       10.00        0.00
+  11850.00      325.00        0.00       10.00        0.00
+  11900.00      325.16        0.00       10.00        0.00
+  11950.00      325.33        0.00       10.00        0.00
+  12000.00      325.49        0.00       10.00        0.00
+  12050.00      325.66        0.00       10.00        0.00
+  12100.00      325.83        0.00       10.00        0.00
+  12150.00      325.99        0.00       10.00        0.00
+  12200.00      326.16        0.00       10.00        0.00
+  12250.00      326.32        0.00       10.00        0.00
+  12300.00      326.49        0.00       10.00        0.00
+  12350.00      326.66        0.00       10.00        0.00
+  12400.00      326.82        0.00       10.00        0.00
+  12450.00      326.99        0.00       10.00        0.00
+  12500.00      327.16        0.00       10.00        0.00
+  12550.00      327.32        0.00       10.00        0.00
+  12600.00      327.49        0.00       10.00        0.00
+  12650.00      327.66        0.00       10.00        0.00
+  12700.00      327.82        0.00       10.00        0.00
+  12750.00      327.99        0.00       10.00        0.00
+  12800.00      328.16        0.00       10.00        0.00
+  12850.00      328.33        0.00       10.00        0.00
+  12900.00      328.49        0.00       10.00        0.00
+  12950.00      328.66        0.00       10.00        0.00
+  13000.00      328.83        0.00       10.00        0.00
+  13050.00      329.00        0.00       10.00        0.00
+  13100.00      329.16        0.00       10.00        0.00
+  13150.00      329.33        0.00       10.00        0.00
+  13200.00      329.50        0.00       10.00        0.00
+  13250.00      329.67        0.00       10.00        0.00
+  13300.00      329.84        0.00       10.00        0.00
+  13350.00      330.01        0.00       10.00        0.00
+  13400.00      330.17        0.00       10.00        0.00
+  13450.00      330.34        0.00       10.00        0.00
+  13500.00      330.51        0.00       10.00        0.00
+  13550.00      330.68        0.00       10.00        0.00
+  13600.00      330.85        0.00       10.00        0.00
+  13650.00      331.02        0.00       10.00        0.00
+  13700.00      331.19        0.00       10.00        0.00
+  13750.00      331.35        0.00       10.00        0.00
+  13800.00      331.52        0.00       10.00        0.00
+  13850.00      331.69        0.00       10.00        0.00
+  13900.00      331.86        0.00       10.00        0.00
+  13950.00      332.03        0.00       10.00        0.00
+  14000.00      332.20        0.00       10.00        0.00
+  14050.00      332.37        0.00       10.00        0.00
+  14100.00      332.54        0.00       10.00        0.00
+  14150.00      332.71        0.00       10.00        0.00
+  14200.00      332.88        0.00       10.00        0.00
+  14250.00      333.05        0.00       10.00        0.00
+  14300.00      333.22        0.00       10.00        0.00
+  14350.00      333.39        0.00       10.00        0.00
+  14400.00      333.56        0.00       10.00        0.00
+  14450.00      333.73        0.00       10.00        0.00
+  14500.00      333.90        0.00       10.00        0.00
+  14550.00      334.07        0.00       10.00        0.00
+  14600.00      334.24        0.00       10.00        0.00
+  14650.00      334.41        0.00       10.00        0.00
+  14700.00      334.58        0.00       10.00        0.00
+  14750.00      334.75        0.00       10.00        0.00
+  14800.00      334.92        0.00       10.00        0.00
+  14850.00      335.09        0.00       10.00        0.00
+  14900.00      335.26        0.00       10.00        0.00
+  14950.00      335.43        0.00       10.00        0.00
+  15000.00      335.61        0.00       10.00        0.00
+  15050.00      335.78        0.00       10.00        0.00
+  15100.00      335.95        0.00       10.00        0.00
+  15150.00      336.12        0.00       10.00        0.00
+  15200.00      336.29        0.00       10.00        0.00
+  15250.00      336.46        0.00       10.00        0.00
+  15300.00      336.63        0.00       10.00        0.00
+  15350.00      336.81        0.00       10.00        0.00
+  15400.00      336.98        0.00       10.00        0.00
+  15450.00      337.15        0.00       10.00        0.00
+  15500.00      337.32        0.00       10.00        0.00
+  15550.00      337.49        0.00       10.00        0.00
+  15600.00      337.67        0.00       10.00        0.00
+  15650.00      337.84        0.00       10.00        0.00
+  15700.00      338.01        0.00       10.00        0.00
+  15750.00      338.18        0.00       10.00        0.00
+  15800.00      338.35        0.00       10.00        0.00
+  15850.00      338.53        0.00       10.00        0.00
+  15900.00      338.70        0.00       10.00        0.00
+  15950.00      338.87        0.00       10.00        0.00
+  16000.00      339.05        0.00       10.00        0.00
+  16050.00      339.22        0.00       10.00        0.00
+  16100.00      339.39        0.00       10.00        0.00
+  16150.00      339.56        0.00       10.00        0.00
+  16200.00      339.74        0.00       10.00        0.00
+  16250.00      339.91        0.00       10.00        0.00
+  16300.00      340.08        0.00       10.00        0.00
+  16350.00      340.26        0.00       10.00        0.00
+  16400.00      340.43        0.00       10.00        0.00
+  16450.00      340.60        0.00       10.00        0.00
+  16500.00      340.78        0.00       10.00        0.00
+  16550.00      340.95        0.00       10.00        0.00
+  16600.00      341.13        0.00       10.00        0.00
+  16650.00      341.30        0.00       10.00        0.00
+  16700.00      341.47        0.00       10.00        0.00
+  16750.00      341.65        0.00       10.00        0.00
+  16800.00      341.82        0.00       10.00        0.00
+  16850.00      342.00        0.00       10.00        0.00
+  16900.00      342.17        0.00       10.00        0.00
+  16950.00      342.35        0.00       10.00        0.00
+  17000.00      342.52        0.00       10.00        0.00
+  17050.00      342.70        0.00       10.00        0.00
+  17100.00      342.87        0.00       10.00        0.00
+  17150.00      343.05        0.00       10.00        0.00
+  17200.00      343.22        0.00       10.00        0.00
+  17250.00      343.40        0.00       10.00        0.00
+  17300.00      343.57        0.00       10.00        0.00
+  17350.00      343.75        0.00       10.00        0.00
+  17400.00      343.92        0.00       10.00        0.00
+  17450.00      344.10        0.00       10.00        0.00
+  17500.00      344.27        0.00       10.00        0.00
+  17550.00      344.45        0.00       10.00        0.00
+  17600.00      344.62        0.00       10.00        0.00
+  17650.00      344.80        0.00       10.00        0.00
+  17700.00      344.97        0.00       10.00        0.00
+  17750.00      345.15        0.00       10.00        0.00
+  17800.00      345.33        0.00       10.00        0.00
+  17850.00      345.50        0.00       10.00        0.00
+  17900.00      345.68        0.00       10.00        0.00
+  17950.00      345.86        0.00       10.00        0.00
+  18000.00      346.03        0.00       10.00        0.00
+  18050.00      346.21        0.00       10.00        0.00
+  18100.00      346.38        0.00       10.00        0.00
+  18150.00      346.56        0.00       10.00        0.00
+  18200.00      346.74        0.00       10.00        0.00
+  18250.00      346.92        0.00       10.00        0.00
+  18300.00      347.09        0.00       10.00        0.00
+  18350.00      347.27        0.00       10.00        0.00
+  18400.00      347.45        0.00       10.00        0.00
+  18450.00      347.62        0.00       10.00        0.00
+  18500.00      347.80        0.00       10.00        0.00
+  18550.00      347.98        0.00       10.00        0.00
+  18600.00      348.16        0.00       10.00        0.00
+  18650.00      348.33        0.00       10.00        0.00
+  18700.00      348.51        0.00       10.00        0.00
+  18750.00      348.69        0.00       10.00        0.00
+  18800.00      348.87        0.00       10.00        0.00
+  18850.00      349.04        0.00       10.00        0.00
+  18900.00      349.22        0.00       10.00        0.00
+  18950.00      349.40        0.00       10.00        0.00
+  19000.00      349.58        0.00       10.00        0.00
+  19050.00      349.76        0.00       10.00        0.00
+  19100.00      349.94        0.00       10.00        0.00
+  19150.00      350.11        0.00       10.00        0.00
+  19200.00      350.29        0.00       10.00        0.00
+  19250.00      350.47        0.00       10.00        0.00
+  19300.00      350.65        0.00       10.00        0.00
+  19350.00      350.83        0.00       10.00        0.00
+  19400.00      351.01        0.00       10.00        0.00
+  19450.00      351.19        0.00       10.00        0.00
+  19500.00      351.37        0.00       10.00        0.00
+  19550.00      351.55        0.00       10.00        0.00
+  19600.00      351.72        0.00       10.00        0.00
+  19650.00      351.90        0.00       10.00        0.00
+  19700.00      352.08        0.00       10.00        0.00
+  19750.00      352.26        0.00       10.00        0.00
+  19800.00      352.44        0.00       10.00        0.00
+  19850.00      352.62        0.00       10.00        0.00
+  19900.00      352.80        0.00       10.00        0.00
+  19950.00      352.98        0.00       10.00        0.00
+  20000.00      353.16        0.00       10.00        0.00
+  20050.00      353.34        0.00       10.00        0.00
+  20100.00      353.52        0.00       10.00        0.00
+  20150.00      353.70        0.00       10.00        0.00
+  20200.00      353.88        0.00       10.00        0.00
+  20250.00      354.06        0.00       10.00        0.00
+  20300.00      354.24        0.00       10.00        0.00
+  20350.00      354.43        0.00       10.00        0.00
+  20400.00      354.61        0.00       10.00        0.00
+  20450.00      354.79        0.00       10.00        0.00
+  20500.00      354.97        0.00       10.00        0.00
+  20550.00      355.15        0.00       10.00        0.00
+  20600.00      355.33        0.00       10.00        0.00
+  20650.00      355.51        0.00       10.00        0.00
+  20700.00      355.69        0.00       10.00        0.00
+  20750.00      355.87        0.00       10.00        0.00
+  20800.00      356.06        0.00       10.00        0.00
+  20850.00      356.24        0.00       10.00        0.00
+  20900.00      356.42        0.00       10.00        0.00
+  20950.00      356.60        0.00       10.00        0.00
+  21000.00      356.78        0.00       10.00        0.00
+  21050.00      356.96        0.00       10.00        0.00
+  21100.00      357.15        0.00       10.00        0.00
+  21150.00      357.33        0.00       10.00        0.00
+  21200.00      357.51        0.00       10.00        0.00
+  21250.00      357.69        0.00       10.00        0.00
+  21300.00      357.88        0.00       10.00        0.00
+  21350.00      358.06        0.00       10.00        0.00
+  21400.00      358.24        0.00       10.00        0.00
+  21450.00      358.42        0.00       10.00        0.00
+  21500.00      358.61        0.00       10.00        0.00
+  21550.00      358.79        0.00       10.00        0.00
+  21600.00      358.97        0.00       10.00        0.00
+  21650.00      359.16        0.00       10.00        0.00
+  21700.00      359.34        0.00       10.00        0.00
+  21750.00      359.52        0.00       10.00        0.00
+  21800.00      359.71        0.00       10.00        0.00
+  21850.00      359.89        0.00       10.00        0.00
+  21900.00      360.07        0.00       10.00        0.00
+  21950.00      360.26        0.00       10.00        0.00
+  22000.00      360.44        0.00       10.00        0.00
+  22050.00      360.62        0.00       10.00        0.00
+  22100.00      360.81        0.00       10.00        0.00
+  22150.00      360.99        0.00       10.00        0.00
+  22200.00      361.18        0.00       10.00        0.00
+  22250.00      361.36        0.00       10.00        0.00
+  22300.00      361.54        0.00       10.00        0.00
+  22350.00      361.73        0.00       10.00        0.00
+  22400.00      361.91        0.00       10.00        0.00
+  22450.00      362.10        0.00       10.00        0.00
+  22500.00      362.28        0.00       10.00        0.00
+  22550.00      362.47        0.00       10.00        0.00
+  22600.00      362.65        0.00       10.00        0.00
+  22650.00      362.84        0.00       10.00        0.00
+  22700.00      363.02        0.00       10.00        0.00
+  22750.00      363.21        0.00       10.00        0.00
+  22800.00      363.39        0.00       10.00        0.00
+  22850.00      363.58        0.00       10.00        0.00
+  22900.00      363.76        0.00       10.00        0.00
+  22950.00      363.95        0.00       10.00        0.00
+  23000.00      364.13        0.00       10.00        0.00
+  23050.00      364.32        0.00       10.00        0.00
+  23100.00      364.51        0.00       10.00        0.00
+  23150.00      364.69        0.00       10.00        0.00
+  23200.00      364.88        0.00       10.00        0.00
+  23250.00      365.06        0.00       10.00        0.00
+  23300.00      365.25        0.00       10.00        0.00
+  23350.00      365.44        0.00       10.00        0.00
+  23400.00      365.62        0.00       10.00        0.00
+  23450.00      365.81        0.00       10.00        0.00
+  23500.00      366.00        0.00       10.00        0.00
+  23550.00      366.18        0.00       10.00        0.00
+  23600.00      366.37        0.00       10.00        0.00
+  23650.00      366.56        0.00       10.00        0.00
+  23700.00      366.74        0.00       10.00        0.00
+  23750.00      366.93        0.00       10.00        0.00
+  23800.00      367.12        0.00       10.00        0.00
+  23850.00      367.30        0.00       10.00        0.00
+  23900.00      367.49        0.00       10.00        0.00
+  23950.00      367.68        0.00       10.00        0.00
+  24000.00      367.87        0.00       10.00        0.00
+  24050.00      368.05        0.00       10.00        0.00
+  24100.00      368.24        0.00       10.00        0.00
+  24150.00      368.43        0.00       10.00        0.00
+  24200.00      368.62        0.00       10.00        0.00
+  24250.00      368.81        0.00       10.00        0.00
+  24300.00      368.99        0.00       10.00        0.00
+  24350.00      369.18        0.00       10.00        0.00
+  24400.00      369.37        0.00       10.00        0.00
+  24450.00      369.56        0.00       10.00        0.00
+  24500.00      369.75        0.00       10.00        0.00
+  24550.00      369.94        0.00       10.00        0.00
+  24600.00      370.12        0.00       10.00        0.00
+  24650.00      370.31        0.00       10.00        0.00
+  24700.00      370.50        0.00       10.00        0.00
+  24750.00      370.69        0.00       10.00        0.00
+  24800.00      370.88        0.00       10.00        0.00
+  24850.00      371.07        0.00       10.00        0.00
+  24900.00      371.26        0.00       10.00        0.00
+  24950.00      371.45        0.00       10.00        0.00
+  25000.00      371.64        0.00       10.00        0.00
+  25050.00      371.83        0.00       10.00        0.00
+  25100.00      372.02        0.00       10.00        0.00
+  25150.00      372.21        0.00       10.00        0.00
+  25200.00      372.40        0.00       10.00        0.00
+  25250.00      372.59        0.00       10.00        0.00
+  25300.00      372.78        0.00       10.00        0.00
+  25350.00      372.97        0.00       10.00        0.00
+  25400.00      373.16        0.00       10.00        0.00
+  25450.00      373.35        0.00       10.00        0.00
+  25500.00      373.54        0.00       10.00        0.00
+  25550.00      373.73        0.00       10.00        0.00
+  25600.00      373.92        0.00       10.00        0.00
+  25650.00      374.11        0.00       10.00        0.00
+  25700.00      374.30        0.00       10.00        0.00
+  25750.00      374.49        0.00       10.00        0.00
+  25800.00      374.68        0.00       10.00        0.00
+  25850.00      374.87        0.00       10.00        0.00
+  25900.00      375.06        0.00       10.00        0.00
+  25950.00      375.26        0.00       10.00        0.00
+  26000.00      375.45        0.00       10.00        0.00
+  26050.00      375.64        0.00       10.00        0.00
+  26100.00      375.83        0.00       10.00        0.00
+  26150.00      376.02        0.00       10.00        0.00
+  26200.00      376.21        0.00       10.00        0.00
+  26250.00      376.41        0.00       10.00        0.00
+  26300.00      376.60        0.00       10.00        0.00
+  26350.00      376.79        0.00       10.00        0.00
+  26400.00      376.98        0.00       10.00        0.00
+  26450.00      377.17        0.00       10.00        0.00
+  26500.00      377.37        0.00       10.00        0.00
+  26550.00      377.56        0.00       10.00        0.00
+  26600.00      377.75        0.00       10.00        0.00
+  26650.00      377.94        0.00       10.00        0.00
+  26700.00      378.14        0.00       10.00        0.00
+  26750.00      378.33        0.00       10.00        0.00
+  26800.00      378.52        0.00       10.00        0.00
+  26850.00      378.72        0.00       10.00        0.00
+  26900.00      378.91        0.00       10.00        0.00
+  26950.00      379.10        0.00       10.00        0.00
+  27000.00      379.30        0.00       10.00        0.00
+  27050.00      379.49        0.00       10.00        0.00
+  27100.00      379.68        0.00       10.00        0.00
+  27150.00      379.88        0.00       10.00        0.00
+  27200.00      380.07        0.00       10.00        0.00
+  27250.00      380.26        0.00       10.00        0.00
+  27300.00      380.46        0.00       10.00        0.00
+  27350.00      380.65        0.00       10.00        0.00
+  27400.00      380.85        0.00       10.00        0.00
+  27450.00      381.04        0.00       10.00        0.00
+  27500.00      381.23        0.00       10.00        0.00
+  27550.00      381.43        0.00       10.00        0.00
+  27600.00      381.62        0.00       10.00        0.00
+  27650.00      381.82        0.00       10.00        0.00
+  27700.00      382.01        0.00       10.00        0.00
+  27750.00      382.21        0.00       10.00        0.00
+  27800.00      382.40        0.00       10.00        0.00
+  27850.00      382.60        0.00       10.00        0.00
+  27900.00      382.79        0.00       10.00        0.00
+  27950.00      382.99        0.00       10.00        0.00
+  28000.00      383.18        0.00       10.00        0.00
+  28050.00      383.38        0.00       10.00        0.00
+  28100.00      383.57        0.00       10.00        0.00
+  28150.00      383.77        0.00       10.00        0.00
+  28200.00      383.97        0.00       10.00        0.00
+  28250.00      384.16        0.00       10.00        0.00
+  28300.00      384.36        0.00       10.00        0.00
+  28350.00      384.55        0.00       10.00        0.00
+  28400.00      384.75        0.00       10.00        0.00
+  28450.00      384.95        0.00       10.00        0.00
+  28500.00      385.14        0.00       10.00        0.00
+  28550.00      385.34        0.00       10.00        0.00
+  28600.00      385.54        0.00       10.00        0.00
+  28650.00      385.73        0.00       10.00        0.00
+  28700.00      385.93        0.00       10.00        0.00
+  28750.00      386.13        0.00       10.00        0.00
+  28800.00      386.32        0.00       10.00        0.00
+  28850.00      386.52        0.00       10.00        0.00
+  28900.00      386.72        0.00       10.00        0.00
+  28950.00      386.91        0.00       10.00        0.00
+  29000.00      387.11        0.00       10.00        0.00
+  29050.00      387.31        0.00       10.00        0.00
+  29100.00      387.51        0.00       10.00        0.00
+  29150.00      387.70        0.00       10.00        0.00
+  29200.00      387.90        0.00       10.00        0.00
+  29250.00      388.10        0.00       10.00        0.00
+  29300.00      388.30        0.00       10.00        0.00
+  29350.00      388.50        0.00       10.00        0.00
+  29400.00      388.69        0.00       10.00        0.00
+  29450.00      388.89        0.00       10.00        0.00
+  29500.00      389.09        0.00       10.00        0.00
+  29550.00      389.29        0.00       10.00        0.00
+  29600.00      389.49        0.00       10.00        0.00
+  29650.00      389.69        0.00       10.00        0.00
+  29700.00      389.88        0.00       10.00        0.00
+  29750.00      390.08        0.00       10.00        0.00
+  29800.00      390.28        0.00       10.00        0.00
+  29850.00      390.48        0.00       10.00        0.00
+  29900.00      390.68        0.00       10.00        0.00
+  29950.00      390.88        0.00       10.00        0.00
+  30000.00      391.08        0.00       10.00        0.00
Index: trunk/WRF.COMMON/WRFV2/test/em_hill2d_x/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_hill2d_x/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_hill2d_x/namelist.input	(revision 2744)
@@ -0,0 +1,105 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 10,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 0001,
+ start_month                         = 01,
+ start_day                           = 01,
+ start_hour                          = 00,
+ start_minute                        = 00,
+ start_second                        = 00,
+ end_year                            = 0001,
+ end_month                           = 01,
+ end_day                             = 01,
+ end_hour                            = 10,
+ end_minute                          = 00,
+ end_second                          = 00,
+ history_interval                    = 60,
+ frames_per_outfile                  = 1000,
+ restart                             = .false.,
+ restart_interval                    = 120,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 20,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,
+ e_we                                = 202,
+ s_sn                                = 1,
+ e_sn                                = 3,
+ s_vert                              = 1,
+ e_vert                              = 41,
+ dx                                  = 2000,
+ dy                                  = 2000,
+ ztop                                = 30000.,
+ /
+
+ &physics
+ mp_physics                          = 0,
+ ra_lw_physics                       = 0,
+ ra_sw_physics                       = 0,
+ radt                                = 0,
+ sf_sfclay_physics                   = 0,
+ sf_surface_physics                  = 0,
+ bl_pbl_physics                      = 0,
+ bldt                                = 0,
+ cu_physics                          = 0,
+ cudt                                = 0,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ num_soil_layers                     = 5,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 2,
+ km_opt                              = 1,
+ damp_opt                            = 2,
+ zdamp                               = 15000.,
+ dampcoef                            = .003,
+ khdif                               = 3000,
+ kvdif                               = 3,
+ smdiv                               = 0.1,
+ emdiv                               = 0.01,
+ epssm                               = 0.1,
+ non_hydrostatic                     = .true.,
+ time_step_sound                     = 6,
+ h_mom_adv_order                     = 5,
+ v_mom_adv_order                     = 3,
+ h_sca_adv_order                     = 5,
+ v_sca_adv_order                     = 3,
+ /
+
+ &bdy_control
+ periodic_x                          = .false.,
+ symmetric_xs                        = .false.,
+ symmetric_xe                        = .false.,
+ open_xs                             = .true., 
+ open_xe                             = .true.,
+ periodic_y                          = .true.,
+ symmetric_ys                        = .false.,
+ symmetric_ye                        = .false.,
+ open_ys                             = .false.,
+ open_ye                             = .false.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/README.quarter_ss
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/README.quarter_ss	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/README.quarter_ss	(revision 2744)
@@ -0,0 +1,36 @@
+em_quarter_ss test case:
+
+This test case produces a simulation of a supercell
+thunderstorm.  The environmental wind makes a
+"quarter circle" when plotted on a hodograph, and
+is commonly referred to as "quarter circle shear".
+"ss" refers to "super-cell".
+
+The default version of this test case uses a constant
+eddy viscosity for turbulent mixing -> 
+diff_opt=1 and km_opt = 1 in namelist.input.
+The Coriolis terms in the model are off (f = 0)
+
+The prognostic TKE can be activated by setting
+diff_opt=2 and km_opt = 2 (see README.namelist).
+
+In idealized cloud model simulations, it is common practice
+to use Coriolis forcing calculated from wind fields defined
+as perturbations from the initial sounding.  This option
+can be activated by setting the "dynamics" namelist option
+"pert_coriolis = .true."  (the default is false).
+Additionally, the value of the Coriolis parameter "f"
+will need to be reset (from zero to the desired value)
+in WRFV1/dyn_em/module_initialize_quarter_ss.F, and
+the initial state recomputed.
+
+Also, a constant surface drag and heat flux can be specified
+in the TKE formulation by setting the "dynamics" namelist option
+"tke_drag_coefficient = Cd",
+"tke_heat_flux = S".
+The default values are zero.  Please note that these are 
+specified constants; the formulations do not make use of
+similarity theory.  These momentum and heat fluxes will 
+not be active if surface and boundary layer formulations are
+activated in the model physics.
+
Index: trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/input_sounding
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/input_sounding	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/input_sounding	(revision 2744)
@@ -0,0 +1,48 @@
+ 1000.00      300.00      14.00
+   250.00     300.45      14.00      -7.88      -3.58
+   750.00     301.25      14.00      -6.94      -0.89
+  1250.00     302.47      13.50      -5.17       1.33
+  1750.00     303.93      11.10      -2.76       2.84
+  2250.00     305.31       9.06       0.01       3.47
+  2750.00     306.81       7.36       2.87       3.49
+  3250.00     308.46       5.95       5.73       3.49
+  3750.00     310.03       4.78       8.58       3.49
+  4250.00     311.74       3.82      11.44       3.49
+  4750.00     313.48       3.01      14.30       3.49
+  5250.00     315.24       2.36      17.15       3.49
+  5750.00     317.18       1.80      20.01       3.49
+  6250.00     319.02       1.41      22.87       3.49
+  6750.00     320.88       1.07      25.73       3.49
+  7250.00     322.80       0.80      27.15       3.49
+  7750.00     324.87       0.60      27.15       3.49
+  8250.00     326.86       0.43      27.15       3.49
+  8750.00     328.89       0.32      27.15       3.49
+  9250.00     330.39       0.24      27.15       3.49
+  9750.00     332.80       0.17      27.15       3.49
+ 10250.00     335.23       0.10      27.15       3.49
+ 10750.00     337.31       0.08      27.15       3.49
+ 11250.00     339.55       0.05      27.15       3.49
+ 11750.00     342.82       0.03      27.15       3.49
+ 12250.00     349.88       0.04      27.15       3.49
+ 12750.00     357.34       0.04      27.15       3.49
+ 13250.00     364.91       0.04      27.15       3.49
+ 13750.00     373.22       0.04      27.15       3.49
+ 14250.00     381.67       0.04      27.15       3.49
+ 14750.00     390.29       0.04      27.15       3.49
+ 15250.00     398.91       0.04      27.15       3.49
+ 15750.00     407.53       0.04      27.15       3.49
+ 16250.00     416.15       0.04      27.15       3.49
+ 16750.00     424.77       0.04      27.15       3.49
+ 17250.00     433.39       0.04      27.15       3.49
+ 17750.00     442.01       0.04      27.15       3.49
+ 18250.00     450.63       0.04      27.15       3.49
+ 18750.00     459.25       0.04      27.15       3.49
+ 19250.00     467.87       0.04      27.15       3.49
+ 19750.00     476.49       0.04      27.15       3.49
+ 20250.00     485.11       0.04      27.15       3.49
+ 20750.00     493.73       0.04      27.15       3.49
+ 21250.00     502.35       0.04      27.15       3.49
+ 21750.00     510.97       0.04      27.15       3.49
+ 22250.00     519.59       0.04      27.15       3.49
+ 22750.00     528.21       0.04      27.15       3.49
+
Index: trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/namelist.input	(revision 2744)
@@ -0,0 +1,120 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 0,
+ run_minutes                         = 60,
+ run_seconds                         = 0,
+ start_year                          = 0001, 0001, 0001,
+ start_month                         = 01,   01,   01,
+ start_day                           = 01,   01,   01,
+ start_hour                          = 00,   00,   00,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 0001, 0001, 0001,
+ end_month                           = 01,   01,   01,
+ end_day                             = 01,   01,   01,
+ end_hour                            = 00,   00,   00,
+ end_minute                          = 120,  120,  120,
+ end_second                          = 00,   00,   00,
+ history_interval                    = 30,   10,   10,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 120,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 12,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 42,    43,    43,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 42,    43,    43,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 41,    41,    41,
+ dx                                  = 2000,  666.6666667, 222.2222222
+ dy                                  = 2000,  666.6666667, 222.2222222
+ ztop                                = 20000, 20000, 20000,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     15,    15,
+ j_parent_start                      = 0,     15,    15,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 1,     1,     1,
+ ra_lw_physics                       = 0,     0,     0,
+ ra_sw_physics                       = 0,     0,     0,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 0,     0,     0,
+ sf_surface_physics                  = 0,     0,     0,
+ bl_pbl_physics                      = 0,     0,     0,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 0,     0,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ num_soil_layers                     = 5,
+ mp_zero_out                         = 0,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 2,
+ km_opt                              = 2,
+ damp_opt                            = 2,
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.003,  0.003,  0.003
+ khdif                               = 500,    500,    500,
+ kvdif                               = 500,    500,    500,
+ smdiv                               = 0.1,    0.1,    0.1,
+ emdiv                               = 0.01,   0.01,   0.01,
+ epssm                               = 0.1,    0.1,    0.1
+ mix_full_fields                     = .true., .true., .true.,
+ non_hydrostatic                     = .true., .true., .true.,
+ time_step_sound                     = 6,      6,      6,
+ h_mom_adv_order                     = 5,      5,      5,
+ v_mom_adv_order                     = 3,      3,      3,
+ h_sca_adv_order                     = 5,      5,      5,
+ v_sca_adv_order                     = 3,      3,      3,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+ /
+
+ &bdy_control
+ periodic_x                          = .false.,.false.,.false.,
+ symmetric_xs                        = .false.,.false.,.false.,
+ symmetric_xe                        = .false.,.false.,.false.,
+ open_xs                             = .true., .false.,.false.,
+ open_xe                             = .true., .false.,.false.,
+ periodic_y                          = .false.,.false.,.false.,
+ symmetric_ys                        = .false.,.false.,.false.,
+ symmetric_ye                        = .false.,.false.,.false.,
+ open_ys                             = .true., .false.,.false.,
+ open_ye                             = .true., .false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/run_me_first.csh
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/run_me_first.csh	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_quarter_ss/run_me_first.csh	(revision 2744)
@@ -0,0 +1,8 @@
+#!/bin/csh
+
+echo Setting up quarter_ss case by linking data files into this directory
+
+echo linking to RRTM_DATA in ../../run directory
+ln -sf ../../run/RRTM_DATA .
+
+echo done
Index: trunk/WRF.COMMON/WRFV2/test/em_real/README.grid_fdda
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/README.grid_fdda	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/README.grid_fdda	(revision 2744)
@@ -0,0 +1,41 @@
+Running grid nudging
+--------------------
+Grid nudging is available in Version 2.2.
+This nudges the WRF run towards a gridded analysis linearly interpolated in time between
+specified analyses. It only requires multiple time periods of analyses for each domain
+to be nudged, and these are input to real in the same format as the initial conditions.
+To run an fdda job
+
+- run real.exe with grid_fdda = 1
+  This will generate an extra input file with the time-varying analyses called wrffdda_d0<n>
+- note that each domain can have grid_fdda = 1 or 0 when running nesting
+- run wrf.exe with the same grid_fdda setting to use the wrffdda files generated
+  Also select wrf run-time options from the list described below to determine which fields to nudge,
+    how strongly to nudge, whether to nudge in the boundary layer, or whether to truncate
+    nudging below a certain grid level
+- There is a ramping capability for dynamic initialization that turns nudging off over a
+    specified period
+
+ &fdda
+ grid_fdda (max_dom)                 = 1        ; grid-nudging fdda on (=0 off) for each domain
+ gfdda_inname                        = "wrffdda_d<domain>" ; defined name in real
+ gfdda_interval_m (max_dom)          = 360      ; time interval (min) between analysis times
+ gfdda_end_h (max_dom)               = 6        ; time (h) to stop nudging after start of forecast
+ io_form_gfdda                       = 2        ; analysis data io format (2 = netCDF)
+ fgdt (max_dom)                      = 0        ; calculation frequency (minutes) for grid-nudging (0=every step)
+ if_no_pbl_nudging_uv (max_dom)      = 0        ; 0= no nudging of u and v in the pbl, 1=nudging in the pbl
+ if_no_pbl_nudging_t (max_dom)       = 0        ; 0= no nudging of temp in the pbl, 1=nudging in the pbl
+ if_no_pbl_nudging_q (max_dom)       = 0        ; 0= no nudging of qvapor in the pbl, 1=nudging in the pbl
+ if_zfac_uv (max_dom)                = 0        ; 0= nudge u and v all layers, 1= limit nudging to levels above k_zfac_uv
+  k_zfac_uv (max_dom)                = 10       ; 10=model level below which nudging is switched off for u and v
+ if_zfac_t (max_dom)                 = 0        ; 0= nudge temp all layers, 1= limit nudging to levels above k_zfac_t
+  k_zfac_t (max_dom)                 = 10       ; 10=model level below which nudging is switched off for temp
+ if_zfac_q (max_dom)                 = 0        ; 0= nudge qvapor all layers, 1= limit nudging to levels above k_zfac_q
+  k_zfac_q (max_dom)                 = 10       ; 10=model level below which nudging is switched off for qvapor
+ guv (max_dom)                       = 0.0003   ; nudging coefficient for u and v (sec-1)
+ gt (max_dom)                        = 0.0003   ; nudging coefficient for temp (sec-1)
+ gq (max_dom)                        = 0.0003   ; nudging coefficient for qvapor (sec-1)
+ if_ramping                          = 0        ; 0= nudging ends as a step function, 1= ramping nudging down at end of period
+ dtramp_min                          = 60.0     ; time (min) for ramping function, 60.0=ramping starts at last analysis time, 
+                                                                                  -60.0=ramping ends at last analysis time
+
Index: trunk/WRF.COMMON/WRFV2/test/em_real/README.obs_fdda
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/README.obs_fdda	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/README.obs_fdda	(revision 2744)
@@ -0,0 +1,109 @@
+General description
+-------------------
+Features and advantages of observational nudging are discussed in (*) below. 
+The method uses relaxation terms based on the model error at observational 
+stations, and the relaxation is such as to reduce this error.
+Each observation has a radius of influence, a time window, and a relaxation 
+time scale determined by user-specified input. These determine where, when, 
+and how much it affects the model solution.  Typical model grid points may 
+be within the radius of influence of several observations, and their 
+contributions are weighted according to the distance from the observation(s). 
+Before performing obs-nudging, you will need to generate an observation 
+input file for each WRF domain. The observation file(s) contain chronological 
+lists of the 3D positions and values of each observation, in a specific format.
+It is critical that your observations be listed in chronological time order!
+
+*  Liu, Y., A. Bourgeois, T. Warner, S. Swerdlin and J. Hacker, 2005: An
+   implementation of obs-nudging-based FDDA into WRF for supporting
+   ATEC test operations. 2005 WRF user workshop. Paper 10.7.
+
+
+How to use the obs-data converter
+-------------------------------------
+A utility program for converting observation data to the format required by 
+WRF has been provided (RT_fdda_reformat_obsnud.pl). The converter assumes 
+that your observation data is in standard LITTLE_R format. 
+
+To convert your data that is in LITTLE_R format:
+
+   RT_fdda_reformat_obsnud.pl yourfilename
+
+where "yourfilename" is the obs-data in LITTLE_R format. The converter will 
+produce a file named yourfilename.obsnud, in the format required by the WRF
+model.
+
+Note that during the conversion process:
+
+   1). P,T,U,V and RH fields are extracted.
+
+   2). U and V are assumed to be the wind components rotated to
+       the model map-projection (see 3DVAR and MM5 Little_R).
+
+   3). SPD, DIR and Td fields are ignored.
+
+   4). For upper-air data, currently WRF nudging only takes
+       those data with valid pressure records. For obs with
+       height levels (e.g. wind profilers data), users need to
+       calculate or estimate the pressure value. Inaccurate
+       estimate of pressure will lead to bad data assimilation.
+
+
+Naming your obs-nudge input files
+---------------------------------
+After you have converted your obs data file to the proper format for WRF, 
+you will need to rename it according to the naming convention for the WRF
+domain on which the obs-nudging is to be performed. For example, for
+observations to be used in Domain 1, use the naming convention OBS_DOMAIN101,
+for Domain 2, OBS_DOMAIN201, etc. Note that you may split your obs data into
+hourly input for each domain. For example, observations with timestamps in
+the first model hour can be listed in file OBS_DOMAIN101, those with
+timestamps in the second model hour in file OBS_DOMAIN102, etc.
+
+These files must be present in your WRF run directory, along with the usual
+WRF input and boundary files.
+
+
+
+How to activate obs-nudging
+---------------------------
+To activate the observational nudging option in WRF, you will need to set
+the obs_nudge_opt flag(s) in the WRF "fdda" namelist. Note that there is
+a unique flag for each WRF domain in which you want to activate obs-nudging.
+To activate the print statements within the obs-nudging subroutines ERROB,
+NUDOB, and IN4DOB, set the respective print flags obs_ipf_errob, 
+obs_ipf_nudob, and obs_ipf_in4dob to ".true." You can then easily verify that 
+you have activated observational nudging by observing text in your WRF
+"standard out" that tell you how many obs stations are being processed at
+given model timesteps. This information will look something like:
+
+0****** CALL IN4DOB AT KTAU =     8 AND XTIME =      24.00:  NSTA =   11040 ******
+++++++CALL ERROB AT KTAU =     8 AND INEST =  1:  NSTA = 11040 ++++++
+
+These lines will print out for each nest in which you have activated nudging, 
+while nudging is active on that domain.
+
+Below is an example of a namelist set up to activate obs-nudging on domains
+1, 2, and 3:
+
+
+ &fdda
+ obs_nudge_opt                       = 1,1,1,0,0   
+ max_obs                             = 150000,
+ fdda_start                          =     0.,     0.,     0.,     0.,     0.
+ fdda_end                            = 99999., 99999., 99999., 99999., 99999.
+ obs_nudge_wind                      = 1,1,1,1,1
+ obs_coef_wind                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_nudge_temp                      = 1,1,1,1,1
+ obs_coef_temp                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_nudge_mois                      = 1,1,1,1,1
+ obs_coef_mois                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_rinxy                           = 240.,240.,180.,180,180
+ obs_rinsig                          = 0.1,
+ obs_twindo                          = 40.
+ obs_npfi                            = 10,
+ obs_ionf                            = 2,
+ obs_idynin                          = 0,
+ obs_dtramp                          = 40.,
+ obs_ipf_errob                       = .true.
+ obs_ipf_nudob                       = .true.
+ obs_ipf_in4dob                      = .true.
Index: trunk/WRF.COMMON/WRFV2/test/em_real/landFilenames
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/landFilenames	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/landFilenames	(revision 2744)
@@ -0,0 +1,27 @@
+landuse		 1	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.01km.ts
+landuse		 2	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.02km.ts
+landuse		 3	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.03km.ts
+landuse		 4	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.04km.ts
+landuse		 5	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.05km.ts
+landuse		 6	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.06km.ts
+landuse		 7	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.07km.ts
+landuse		 8	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.08km.ts
+landuse		 9	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.09km.ts
+landuse		10	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.10km.ts
+landuse		20	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.20km.ts
+landuse		30	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.30km.ts
+landuse		40	/maple2/michalak/RSMAS/SurfaceFiles/glcc.usgs20.40km.ts
+topography	01	/maple2/michalak/RSMAS/SurfaceFiles/topo.01km.ts
+topography	02	/maple2/michalak/RSMAS/SurfaceFiles/topo.02km.ts
+topography	03	/maple2/michalak/RSMAS/SurfaceFiles/topo.03km.ts
+topography	04	/maple2/michalak/RSMAS/SurfaceFiles/topo.04km.ts
+topography	05	/maple2/michalak/RSMAS/SurfaceFiles/topo.05km.ts
+topography	06	/maple2/michalak/RSMAS/SurfaceFiles/topo.06km.ts
+topography	07	/maple2/michalak/RSMAS/SurfaceFiles/topo.07km.ts
+topography	08	/maple2/michalak/RSMAS/SurfaceFiles/topo.08km.ts
+topography	09	/maple2/michalak/RSMAS/SurfaceFiles/topo.09km.ts
+topography	10	/maple2/michalak/RSMAS/SurfaceFiles/topo.10km.ts
+topography	20	/maple2/michalak/RSMAS/SurfaceFiles/topo.20km.ts
+topography	30	/maple2/michalak/RSMAS/SurfaceFiles/topo.30km.ts
+topography	40	/maple2/michalak/RSMAS/SurfaceFiles/topo.40km.ts
+bathymetry	10	/maple2/michalak/RSMAS/SurfaceFiles/tbase.ts
Index: trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input	(revision 2744)
@@ -0,0 +1,114 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2000, 2000, 2000,
+ start_month                         = 01,   01,   01,
+ start_day                           = 24,   24,   24,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2000, 2000, 2000,
+ end_month                           = 01,   01,   01,
+ end_day                             = 25,   25,   25,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 21600
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 30000, 10000,  3333,
+ dy                                  = 30000, 10000,  3333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    30,
+ j_parent_start                      = 0,     17,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 3,     3,     3,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 1,     1,     1,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 5,
+ ucmcall                             = 0,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ w_damping                           = 0,
+ diff_opt                            = 1,
+ km_opt                              = 4,
+ diff_6th_opt                        = 0,
+ diff_6th_factor                     = 0.12,
+ base_temp                           = 290.
+ damp_opt                            = 0,
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ non_hydrostatic                     = .true., .true., .true.,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.chem
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.chem	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.chem	(revision 2744)
@@ -0,0 +1,132 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2001, 2001, 2001,
+ start_month                         = 06,   06,   06,
+ start_day                           = 11,   11,   11,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2001, 2001, 2001,
+ end_month                           = 06,   06,   06,
+ end_day                             = 12,   12,   12,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 10800
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ auxinput5_interval_m                = 60, 60, 60
+ frames_per_emissfile                = 36
+ io_style_emissions                  = 1
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ io_form_auxinput4                   = 2
+ io_form_auxinput5                   = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 60,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 91,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 82,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 10000,  3333,  1111,
+ dy                                  = 10000,  3333,  1111,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     30,    30,
+ j_parent_start                      = 0,     20,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 2,     2,     2,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 10,    10,    10,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 2,     2,     2,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 4,
+ ucmcall                             = 0,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ kemit                               = 19,
+ chem_opt                            =  0,    0,     0,
+ bioemdt                             = 30,   30,    30,
+ photdt                              = 30,   30,    30,
+ chemdt                              = 1.0, 0.8333333, 0.3333333
+ cu_rad_feedback                     = .false.,.false.,.false.,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ w_damping                           = 0,
+ diff_opt                            = 1,
+ km_opt                              = 4,
+ base_temp                           = 290.
+ diff_6th_opt                        = 0,
+ diff_6th_factor                     = 0.12,
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ chem_in_opt                         = 1,      1,      1,
+ phot_opt                            = 1,      1,      1,
+ drydep_opt                          = 1,      1,      1,
+ bio_emiss_opt                       = 2,      2,      2,
+ gas_bc_opt                          = 1,      1,      1,
+ gas_ic_opt                          = 1,      1,      1,
+ aer_bc_opt                          = 1,      1,      1,
+ aer_ic_opt                          = 1,      1,      1,
+ non_hydrostatic                     = .true., .true., .true.,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ nested                              = .false., .true., .true.,
+ have_bcs_chem                       = .false.,.false.,.false.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.grid_fdda
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.grid_fdda	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.grid_fdda	(revision 2744)
@@ -0,0 +1,133 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2000, 2000, 2000,
+ start_month                         = 01,   01,   01,
+ start_day                           = 24,   24,   24,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2000, 2000, 2000,
+ end_month                           = 01,   01,   01,
+ end_day                             = 25,   25,   25,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 21600
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 30000, 10000,  3333,
+ dy                                  = 30000, 10000,  3333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    30,
+ j_parent_start                      = 0,     17,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 3,     3,     3,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 1,     1,     1,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 5,
+ ucmcall                             = 0,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ /
+
+ &fdda
+ grid_fdda                           = 1,     1,     1,
+ gfdda_inname                        = "wrffdda_d<domain>",
+ gfdda_end_h                         = 24,    24,    24,
+ gfdda_interval_m                    = 360,   360,   360,
+ fgdt                                = 0,     0,     0,
+ if_no_pbl_nudging_uv                = 0,     0,     1,
+ if_no_pbl_nudging_t                 = 0,     0,     1,
+ if_no_pbl_nudging_q                 = 0,     0,     1,
+ if_zfac_uv                          = 0,     0,     1,
+  k_zfac_uv                          = 10,   10,     1,
+ if_zfac_t                           = 0,     0,     1,
+  k_zfac_t                           = 10,   10,     1,
+ if_zfac_q                           = 0,     0,     1,
+  k_zfac_q                           = 10,   10,     1,
+ guv                                 = 0.0003,     0.0003,     0.0003,
+ gt                                  = 0.0003,     0.0003,     0.0003,
+ gq                                  = 0.0003,     0.0003,     0.0003,
+ if_ramping                          = 1,
+ dtramp_min                          = 60.0,
+ io_form_gfdda                       = 2,
+ /
+
+ &dynamics
+ w_damping                           = 0,
+ diff_opt                            = 1,
+ km_opt                              = 4,
+ diff_6th_opt                        = 0,
+ diff_6th_factor                     = 0.12,
+ damp_opt                            = 0,
+ base_temp                           = 290.
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ non_hydrostatic                     = .true., .true., .true.,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.jan00
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.jan00	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.jan00	(revision 2744)
@@ -0,0 +1,134 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2000, 2000, 2000,
+ start_month                         = 01,   01,   01,
+ start_day                           = 24,   24,   24,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2000, 2000, 2000,
+ end_month                           = 01,   01,   01,
+ end_day                             = 25,   25,   25,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 21600
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 30000, 10000,  3333,
+ dy                                  = 30000, 10000,  3333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    30,
+ j_parent_start                      = 0,     17,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 3,     3,     3,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 1,     1,     1,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 5,
+ ucmcall                             = 0,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ w_damping                           = 0,
+ diff_opt                            = 1,
+ km_opt                              = 4,
+ damp_opt                            = 0,
+ base_temp                           = 290.
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ smdiv                               = 0.1,    0.1,    0.1,
+ emdiv                               = 0.01,   0.01,   0.01,
+ epssm                               = 0.1,    0.1,    0.1
+ time_step_sound                     = 4,      4,      4,
+ h_mom_adv_order                     = 5,      5,      5,
+ v_mom_adv_order                     = 3,      3,      3,
+ h_sca_adv_order                     = 5,      5,      5,
+ v_sca_adv_order                     = 3,      3,      3,
+ non_hydrostatic                     = .true., .true., .true.,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ periodic_x                          = .false.,.false.,.false.,
+ symmetric_xs                        = .false.,.false.,.false.,
+ symmetric_xe                        = .false.,.false.,.false.,
+ open_xs                             = .false.,.false.,.false.,
+ open_xe                             = .false.,.false.,.false.,
+ periodic_y                          = .false.,.false.,.false.,
+ symmetric_ys                        = .false.,.false.,.false.,
+ symmetric_ye                        = .false.,.false.,.false.,
+ open_ys                             = .false.,.false.,.false.,
+ open_ye                             = .false.,.false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.jun01
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.jun01	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.jun01	(revision 2744)
@@ -0,0 +1,134 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2001, 2001, 2001,
+ start_month                         = 06,   06,   06,
+ start_day                           = 11,   11,   11,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2001, 2001, 2001,
+ end_month                           = 06,   06,   06,
+ end_day                             = 12,   12,   12,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 10800
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 60,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 91,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 82,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 10000,  3333,  1111,
+ dy                                  = 10000,  3333,  1111,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     30,    30,
+ j_parent_start                      = 0,     20,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 2,     2,     2,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 10,    10,    10,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 2,     2,     2,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 4,
+ ucmcall                             = 0,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ w_damping                           = 0,
+ diff_opt                            = 1,
+ km_opt                              = 4,
+ damp_opt                            = 0,
+ base_temp                           = 290.
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ smdiv                               = 0.1,    0.1,    0.1,
+ emdiv                               = 0.01,   0.01,   0.01,
+ epssm                               = 0.1,    0.1,    0.1
+ time_step_sound                     = 4,      4,      4,
+ h_mom_adv_order                     = 5,      5,      5,
+ v_mom_adv_order                     = 3,      3,      3,
+ h_sca_adv_order                     = 5,      5,      5,
+ v_sca_adv_order                     = 3,      3,      3,
+ non_hydrostatic                     = .true., .true., .true.,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ periodic_x                          = .false.,.false.,.false.,
+ symmetric_xs                        = .false.,.false.,.false.,
+ symmetric_xe                        = .false.,.false.,.false.,
+ open_xs                             = .false.,.false.,.false.,
+ open_xe                             = .false.,.false.,.false.,
+ periodic_y                          = .false.,.false.,.false.,
+ symmetric_ys                        = .false.,.false.,.false.,
+ symmetric_ye                        = .false.,.false.,.false.,
+ open_ys                             = .false.,.false.,.false.,
+ open_ye                             = .false.,.false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.obs_fdda
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.obs_fdda	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.obs_fdda	(revision 2744)
@@ -0,0 +1,134 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2000, 2000, 2000,
+ start_month                         = 01,   01,   01,
+ start_day                           = 24,   24,   24,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2000, 2000, 2000,
+ end_month                           = 01,   01,   01,
+ end_day                             = 25,   25,   25,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 21600
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ auxinput11_interval_s               = 180
+ auxinput11_end_h                    = 6
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 30000, 10000,  3333,
+ dy                                  = 30000, 10000,  3333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    30,
+ j_parent_start                      = 0,     17,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 3,     3,     3,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 1,     1,     1,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 5,
+ ucmcall                             = 0,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ /
+
+ &fdda
+ obs_nudge_opt                       = 1,1,1,1,1
+ max_obs                             = 150000,
+ obs_nudge_wind                      = 1,1,1,1,1
+ obs_coef_wind                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_nudge_temp                      = 1,1,1,1,1
+ obs_coef_temp                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_nudge_mois                      = 1,1,1,1,1
+ obs_coef_mois                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_rinxy                           = 240.,240.,180.,180,180
+ obs_rinsig                          = 0.1,
+ obs_twindo                          = 40.
+ obs_npfi                            = 10,
+ obs_ionf                            = 2,
+ obs_idynin                          = 0,
+ obs_dtramp                          = 40.,
+ obs_ipf_errob                       = .true.
+ obs_ipf_nudob                       = .true.
+ obs_ipf_in4dob                      = .true.
+ /
+
+ &dynamics
+ w_damping                           = 0,
+ diff_opt                            = 1,
+ km_opt                              = 4,
+ diff_6th_opt                        = 0,
+ diff_6th_factor                     = 0.12,
+ damp_opt                            = 0,
+ base_temp                           = 290.
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ non_hydrostatic                     = .true., .true., .true.,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.si
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.si	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.si	(revision 2744)
@@ -0,0 +1,116 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2000, 2000, 2000,
+ start_month                         = 01,   01,   01,
+ start_day                           = 24,   24,   24,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2000, 2000, 2000,
+ end_month                           = 01,   01,   01,
+ end_day                             = 25,   25,   25,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 21600
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ auxinput1_inname                    = "wrf_real_input_em.d<domain>.<date>"
+ /
+ auxinput1_inname                    = "met_em.d<domain>.<date>"
+
+ &domains
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 30000, 10000,  3333,
+ dy                                  = 30000, 10000,  3333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    30,
+ j_parent_start                      = 0,     17,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 3,     3,     3,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 1,     1,     1,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 5,
+ ucmcall                             = 0,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ w_damping                           = 0,
+ diff_opt                            = 1,
+ km_opt                              = 4,
+ diff_6th_opt                        = 0,
+ diff_6th_factor                     = 0.12,
+ damp_opt                            = 0,
+ base_temp                           = 290.
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ non_hydrostatic                     = .true., .true., .true.,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.wps
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.wps	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_real/namelist.input.wps	(revision 2744)
@@ -0,0 +1,137 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 12,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2000, 2000, 2000,
+ start_month                         = 01,   01,   01,
+ start_day                           = 24,   24,   24,
+ start_hour                          = 12,   12,   12,
+ start_minute                        = 00,   00,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2000, 2000, 2000,
+ end_month                           = 01,   01,   01,
+ end_day                             = 25,   25,   25,
+ end_hour                            = 12,   12,   12,
+ end_minute                          = 00,   00,   00,
+ end_second                          = 00,   00,   00,
+ interval_seconds                    = 21600
+ input_from_file                     = .true.,.false.,.false.,
+ history_interval                    = 180,  60,   60,
+ frames_per_outfile                  = 1000, 1000, 1000,
+ restart                             = .false.,
+ restart_interval                    = 5000,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ auxinput1_inname                    = "met_em.d<domain>.<date>"
+ /
+ auxinput1_inname                    = "wrf_real_input_em.d<domain>.<date>"
+
+ &domains
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    112,   94,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    97,    91,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ num_metgrid_levels                  = 27
+ dx                                  = 30000, 10000,  3333,
+ dy                                  = 30000, 10000,  3333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    30,
+ j_parent_start                      = 0,     17,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ /
+ p_top_requested                     = 5000
+ interp_type                         = 1
+ lowest_lev_from_sfc                 = .false.
+ lagrange_order                      = 1
+ force_sfc_in_vinterp                = 1
+ zap_close_levels                    = 500
+ sfcp_to_sfcp                        = .false.
+ adjust_heights                      = .false.
+ eta_levels                          = 1.000, 0.990, 0.978, 0.964, 0.946, 
+                                       0.922, 0.894, 0.860, 0.817, 0.766, 
+                                       0.707, 0.644, 0.576, 0.507, 0.444, 
+                                       0.380, 0.324, 0.273, 0.228, 0.188, 
+                                       0.152, 0.121, 0.093, 0.069, 0.048, 
+                                       0.029, 0.014, 0.000, 
+ eta_levels                          = 1.000, 0.993, 0.983, 0.970, 0.954,
+                                       0.934, 0.909, 0.880, 0.845, 0.807,
+                                       0.765, 0.719, 0.672, 0.622, 0.571,
+                                       0.520, 0.468, 0.420, 0.376, 0.335,
+                                       0.298, 0.263, 0.231, 0.202, 0.175,
+                                       0.150, 0.127, 0.106, 0.088, 0.070,
+                                       0.055, 0.040, 0.026, 0.013, 0.000
+
+ &physics
+ mp_physics                          = 3,     3,     3,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 1,     1,     1,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 5,
+ ucmcall                             = 0,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ w_damping                           = 0,
+ diff_opt                            = 1,
+ km_opt                              = 4,
+ diff_6th_opt                        = 0,
+ diff_6th_factor                     = 0.12,
+ damp_opt                            = 0,
+ base_temp                           = 290.
+ zdamp                               = 5000.,  5000.,  5000.,
+ dampcoef                            = 0.01,   0.01,   0.01
+ khdif                               = 0,      0,      0,
+ kvdif                               = 0,      0,      0,
+ non_hydrostatic                     = .true., .true., .true.,
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true., .false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_squall2d_x/input_sounding
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_squall2d_x/input_sounding	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_squall2d_x/input_sounding	(revision 2744)
@@ -0,0 +1,81 @@
+   1000.0         300.5000       14.00000    
+   125.0000       300.5000       14.00000      -11.40000      0.0000000E+00
+   375.0000       300.5650       14.00000      -10.20000      0.0000000E+00
+   625.0000       301.0699       14.00000      -9.000000      0.0000000E+00
+   875.0000       301.6293       14.00000      -7.800000      0.0000000E+00
+   1125.000       302.2307       14.00000      -6.600000      0.0000000E+00
+   1375.000       302.8666       13.11911      -5.400000      0.0000000E+00
+   1625.000       303.5323       11.87561      -4.200000      0.0000000E+00
+   1875.000       304.2242       10.74200      -3.000000      0.0000000E+00
+   2125.000       304.9395       9.707900      -1.800000      0.0000000E+00
+   2375.000       305.6764       8.764307     -0.6000004      0.0000000E+00
+   2625.000       306.4329       7.903318      0.0000000E+00  0.0000000E+00
+   2875.000       307.2076       7.117891      0.0000000E+00  0.0000000E+00
+   3125.000       307.9994       6.401778      0.0000000E+00  0.0000000E+00
+   3375.000       308.8071       5.749294      0.0000000E+00  0.0000000E+00
+   3625.000       309.6300       5.155267      0.0000000E+00  0.0000000E+00
+   3875.000       310.4672       4.614990      0.0000000E+00  0.0000000E+00
+   4125.000       311.3181       4.124146      0.0000000E+00  0.0000000E+00
+   4375.000       312.1819       3.678759      0.0000000E+00  0.0000000E+00
+   4625.000       313.0581       3.275154      0.0000000E+00  0.0000000E+00
+   4875.000       313.9464       2.909960      0.0000000E+00  0.0000000E+00
+   5125.000       314.8460       2.580028      0.0000000E+00  0.0000000E+00
+   5375.000       315.7567       2.282451      0.0000000E+00  0.0000000E+00
+   5625.000       316.6780       2.014546      0.0000000E+00  0.0000000E+00
+   5875.000       317.6097       1.773806      0.0000000E+00  0.0000000E+00
+   6125.000       318.5513       1.557917      0.0000000E+00  0.0000000E+00
+   6375.000       319.5026       1.364712      0.0000000E+00  0.0000000E+00
+   6625.000       320.4632       1.192196      0.0000000E+00  0.0000000E+00
+   6875.000       321.4330       1.038515      0.0000000E+00  0.0000000E+00
+   7125.000       322.4116      0.9019489      0.0000000E+00  0.0000000E+00
+   7375.000       323.3988      0.7808990      0.0000000E+00  0.0000000E+00
+   7625.000       324.3945      0.6738972      0.0000000E+00  0.0000000E+00
+   7875.000       325.3983      0.5795774      0.0000000E+00  0.0000000E+00
+   8125.000       326.4102      0.4966844      0.0000000E+00  0.0000000E+00
+   8375.000       327.4298      0.4240607      0.0000000E+00  0.0000000E+00
+   8625.000       328.4571      0.3606393      0.0000000E+00  0.0000000E+00
+   8875.000       329.4919      0.3054438      0.0000000E+00  0.0000000E+00
+   9125.000       330.5339      0.2575793      0.0000000E+00  0.0000000E+00
+   9375.000       331.5832      0.2162281      0.0000000E+00  0.0000000E+00
+   9625.000       332.6394      0.1806441      0.0000000E+00  0.0000000E+00
+   9875.000       333.7025      0.1501510      0.0000000E+00  0.0000000E+00
+   10125.00       334.7725      0.1241341      0.0000000E+00  0.0000000E+00
+   10375.00       335.8490      0.1020380      0.0000000E+00  0.0000000E+00
+   10625.00       336.9320      8.3363235E-02  0.0000000E+00  0.0000000E+00
+   10875.00       338.0214      6.7661338E-02  0.0000000E+00  0.0000000E+00
+   11125.00       339.1171      5.4530919E-02  0.0000000E+00  0.0000000E+00
+   11375.00       340.2190      4.3614354E-02  0.0000000E+00  0.0000000E+00
+   11625.00       341.3269      3.4594502E-02  0.0000000E+00  0.0000000E+00
+   11875.00       342.4408      2.7190926E-02  0.0000000E+00  0.0000000E+00
+   12125.00       344.9724      2.4574272E-02  0.0000000E+00  0.0000000E+00
+   12375.00       348.9513      2.5715416E-02  0.0000000E+00  0.0000000E+00
+   12625.00       352.9761      2.6911106E-02  0.0000000E+00  0.0000000E+00
+   12875.00       357.0473      2.8164061E-02  0.0000000E+00  0.0000000E+00
+   13125.00       361.1655      2.9477064E-02  0.0000000E+00  0.0000000E+00
+   13375.00       365.3311      3.0853137E-02  0.0000000E+00  0.0000000E+00
+   13625.00       369.5448      3.2295462E-02  0.0000000E+00  0.0000000E+00
+   13875.00       373.8072      3.3807345E-02  0.0000000E+00  0.0000000E+00
+   14125.00       378.1187      3.5392068E-02  0.0000000E+00  0.0000000E+00
+   14375.00       382.4798      3.7053265E-02  0.0000000E+00  0.0000000E+00
+   14625.00       386.8913      3.8795106E-02  0.0000000E+00  0.0000000E+00
+   14875.00       391.3537      4.0621303E-02  0.0000000E+00  0.0000000E+00
+   15125.00       395.8676      4.2536203E-02  0.0000000E+00  0.0000000E+00
+   15375.00       400.4335      4.4544484E-02  0.0000000E+00  0.0000000E+00
+   15625.00       405.0521      4.6650380E-02  0.0000000E+00  0.0000000E+00
+   15875.00       409.7239      4.8859127E-02  0.0000000E+00  0.0000000E+00
+   16125.00       414.4497      5.1176008E-02  0.0000000E+00  0.0000000E+00
+   16375.00       419.2299      5.3606406E-02  0.0000000E+00  0.0000000E+00
+   16625.00       424.0653      5.6155890E-02  0.0000000E+00  0.0000000E+00
+   16875.00       428.9565      5.8831204E-02  0.0000000E+00  0.0000000E+00
+   17125.00       433.9040      6.1637800E-02  0.0000000E+00  0.0000000E+00
+   17375.00       438.9086      6.4582929E-02  0.0000000E+00  0.0000000E+00
+   17625.00       443.9710      6.7673884E-02  0.0000000E+00  0.0000000E+00
+   17875.00       449.0917      7.0917897E-02  0.0000000E+00  0.0000000E+00
+   18125.00       454.2715      7.4322589E-02  0.0000000E+00  0.0000000E+00
+   18375.00       459.5110      7.7896632E-02  0.0000000E+00  0.0000000E+00
+   18625.00       464.8110      8.1648715E-02  0.0000000E+00  0.0000000E+00
+   18875.00       470.1721      8.5588045E-02  0.0000000E+00  0.0000000E+00
+   19125.00       475.5951      8.9724302E-02  0.0000000E+00  0.0000000E+00
+   19375.00       481.0806      9.4000000E-02  0.0000000E+00  0.0000000E+00
+   19625.00       486.6293      9.4000000E-02  0.0000000E+00  0.0000000E+00
+   19875.00       492.2421      9.4000000E-02  0.0000000E+00  0.0000000E+00
Index: trunk/WRF.COMMON/WRFV2/test/em_squall2d_x/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_squall2d_x/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_squall2d_x/namelist.input	(revision 2744)
@@ -0,0 +1,107 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 1,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 0001,
+ start_month                         = 01,
+ start_day                           = 01,
+ start_hour                          = 00,
+ start_minute                        = 00,
+ start_second                        = 00,
+ end_year                            = 0001,
+ end_month                           = 01,
+ end_day                             = 01,
+ end_hour                            = 01,
+ end_minute                          = 00,
+ end_second                          = 00,
+ history_interval                    = 10,
+ frames_per_outfile                  = 1000,
+ restart                             = .false.,
+ restart_interval                    = 60,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 3,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,
+ e_we                                = 202,
+ s_sn                                = 1,
+ e_sn                                = 3,
+ s_vert                              = 1,
+ e_vert                              = 81,
+ dx                                  = 250,
+ dy                                  = 250,
+ ztop                                = 20000.,
+ /
+
+ &physics
+ mp_physics                          = 2,
+ ra_lw_physics                       = 0,
+ ra_sw_physics                       = 0,
+ radt                                = 0,
+ sf_sfclay_physics                   = 0,
+ sf_surface_physics                  = 0,
+ bl_pbl_physics                      = 0,
+ bldt                                = 0,
+ cu_physics                          = 0,
+ cudt                                = 0,
+ isfflx                              = 0,
+ ifsnow                              = 0,
+ icloud                              = 0,
+ num_soil_layers                     = 5,
+ mp_zero_out                         = 0,
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 2,
+ km_opt                              = 2,
+ damp_opt                            = 2,
+ dampcoef                            = .003,
+ zdamp                               = 5000.,
+ khdif                               = 300,
+ kvdif                               = 1,
+ smdiv                               = 0.1,
+ emdiv                               = 0.01,
+ epssm                               = 0.1,
+ mix_full_fields                     = .true.,
+ non_hydrostatic                     = .true.,
+ time_step_sound                     = 6,
+ h_mom_adv_order                     = 5,
+ v_mom_adv_order                     = 3,
+ h_sca_adv_order                     = 5,
+ v_sca_adv_order                     = 3,
+ /
+
+ &bdy_control
+ periodic_x                          = .false.,
+ symmetric_xs                        = .false.,
+ symmetric_xe                        = .false.,
+ open_xs                             = .true., 
+ open_xe                             = .true.,
+ periodic_y                          = .true.,
+ symmetric_ys                        = .false.,
+ symmetric_ye                        = .false.,
+ open_ys                             = .false.,
+ open_ye                             = .false.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/em_squall2d_y/input_sounding
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_squall2d_y/input_sounding	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_squall2d_y/input_sounding	(revision 2744)
@@ -0,0 +1,81 @@
+   1000.0         300.5000       14.00000    
+   125.0000       300.5000       14.00000      0.0            -11.40000 
+   375.0000       300.5650       14.00000      0.0            -10.20000    
+   625.0000       301.0699       14.00000      0.0           -9.000000   
+   875.0000       301.6293       14.00000      0.0            -7.800000
+   1125.000       302.2307       14.00000      0.0            -6.600000 
+   1375.000       302.8666       13.11911      0.0            -5.400000 
+   1625.000       303.5323       11.87561      0.0            -4.200000  
+   1875.000       304.2242       10.74200      0.0            -3.000000 
+   2125.000       304.9395       9.707900      0.0            -1.800000  
+   2375.000       305.6764       8.764307      0.0            -0.6000004 
+   2625.000       306.4329       7.903318      0.0000000E+00  0.0000000E+00
+   2875.000       307.2076       7.117891      0.0000000E+00  0.0000000E+00
+   3125.000       307.9994       6.401778      0.0000000E+00  0.0000000E+00
+   3375.000       308.8071       5.749294      0.0000000E+00  0.0000000E+00
+   3625.000       309.6300       5.155267      0.0000000E+00  0.0000000E+00
+   3875.000       310.4672       4.614990      0.0000000E+00  0.0000000E+00
+   4125.000       311.3181       4.124146      0.0000000E+00  0.0000000E+00
+   4375.000       312.1819       3.678759      0.0000000E+00  0.0000000E+00
+   4625.000       313.0581       3.275154      0.0000000E+00  0.0000000E+00
+   4875.000       313.9464       2.909960      0.0000000E+00  0.0000000E+00
+   5125.000       314.8460       2.580028      0.0000000E+00  0.0000000E+00
+   5375.000       315.7567       2.282451      0.0000000E+00  0.0000000E+00
+   5625.000       316.6780       2.014546      0.0000000E+00  0.0000000E+00
+   5875.000       317.6097       1.773806      0.0000000E+00  0.0000000E+00
+   6125.000       318.5513       1.557917      0.0000000E+00  0.0000000E+00
+   6375.000       319.5026       1.364712      0.0000000E+00  0.0000000E+00
+   6625.000       320.4632       1.192196      0.0000000E+00  0.0000000E+00
+   6875.000       321.4330       1.038515      0.0000000E+00  0.0000000E+00
+   7125.000       322.4116      0.9019489      0.0000000E+00  0.0000000E+00
+   7375.000       323.3988      0.7808990      0.0000000E+00  0.0000000E+00
+   7625.000       324.3945      0.6738972      0.0000000E+00  0.0000000E+00
+   7875.000       325.3983      0.5795774      0.0000000E+00  0.0000000E+00
+   8125.000       326.4102      0.4966844      0.0000000E+00  0.0000000E+00
+   8375.000       327.4298      0.4240607      0.0000000E+00  0.0000000E+00
+   8625.000       328.4571      0.3606393      0.0000000E+00  0.0000000E+00
+   8875.000       329.4919      0.3054438      0.0000000E+00  0.0000000E+00
+   9125.000       330.5339      0.2575793      0.0000000E+00  0.0000000E+00
+   9375.000       331.5832      0.2162281      0.0000000E+00  0.0000000E+00
+   9625.000       332.6394      0.1806441      0.0000000E+00  0.0000000E+00
+   9875.000       333.7025      0.1501510      0.0000000E+00  0.0000000E+00
+   10125.00       334.7725      0.1241341      0.0000000E+00  0.0000000E+00
+   10375.00       335.8490      0.1020380      0.0000000E+00  0.0000000E+00
+   10625.00       336.9320      8.3363235E-02  0.0000000E+00  0.0000000E+00
+   10875.00       338.0214      6.7661338E-02  0.0000000E+00  0.0000000E+00
+   11125.00       339.1171      5.4530919E-02  0.0000000E+00  0.0000000E+00
+   11375.00       340.2190      4.3614354E-02  0.0000000E+00  0.0000000E+00
+   11625.00       341.3269      3.4594502E-02  0.0000000E+00  0.0000000E+00
+   11875.00       342.4408      2.7190926E-02  0.0000000E+00  0.0000000E+00
+   12125.00       344.9724      2.4574272E-02  0.0000000E+00  0.0000000E+00
+   12375.00       348.9513      2.5715416E-02  0.0000000E+00  0.0000000E+00
+   12625.00       352.9761      2.6911106E-02  0.0000000E+00  0.0000000E+00
+   12875.00       357.0473      2.8164061E-02  0.0000000E+00  0.0000000E+00
+   13125.00       361.1655      2.9477064E-02  0.0000000E+00  0.0000000E+00
+   13375.00       365.3311      3.0853137E-02  0.0000000E+00  0.0000000E+00
+   13625.00       369.5448      3.2295462E-02  0.0000000E+00  0.0000000E+00
+   13875.00       373.8072      3.3807345E-02  0.0000000E+00  0.0000000E+00
+   14125.00       378.1187      3.5392068E-02  0.0000000E+00  0.0000000E+00
+   14375.00       382.4798      3.7053265E-02  0.0000000E+00  0.0000000E+00
+   14625.00       386.8913      3.8795106E-02  0.0000000E+00  0.0000000E+00
+   14875.00       391.3537      4.0621303E-02  0.0000000E+00  0.0000000E+00
+   15125.00       395.8676      4.2536203E-02  0.0000000E+00  0.0000000E+00
+   15375.00       400.4335      4.4544484E-02  0.0000000E+00  0.0000000E+00
+   15625.00       405.0521      4.6650380E-02  0.0000000E+00  0.0000000E+00
+   15875.00       409.7239      4.8859127E-02  0.0000000E+00  0.0000000E+00
+   16125.00       414.4497      5.1176008E-02  0.0000000E+00  0.0000000E+00
+   16375.00       419.2299      5.3606406E-02  0.0000000E+00  0.0000000E+00
+   16625.00       424.0653      5.6155890E-02  0.0000000E+00  0.0000000E+00
+   16875.00       428.9565      5.8831204E-02  0.0000000E+00  0.0000000E+00
+   17125.00       433.9040      6.1637800E-02  0.0000000E+00  0.0000000E+00
+   17375.00       438.9086      6.4582929E-02  0.0000000E+00  0.0000000E+00
+   17625.00       443.9710      6.7673884E-02  0.0000000E+00  0.0000000E+00
+   17875.00       449.0917      7.0917897E-02  0.0000000E+00  0.0000000E+00
+   18125.00       454.2715      7.4322589E-02  0.0000000E+00  0.0000000E+00
+   18375.00       459.5110      7.7896632E-02  0.0000000E+00  0.0000000E+00
+   18625.00       464.8110      8.1648715E-02  0.0000000E+00  0.0000000E+00
+   18875.00       470.1721      8.5588045E-02  0.0000000E+00  0.0000000E+00
+   19125.00       475.5951      8.9724302E-02  0.0000000E+00  0.0000000E+00
+   19375.00       481.0806      9.4000000E-02  0.0000000E+00  0.0000000E+00
+   19625.00       486.6293      9.4000000E-02  0.0000000E+00  0.0000000E+00
+   19875.00       492.2421      9.4000000E-02  0.0000000E+00  0.0000000E+00
Index: trunk/WRF.COMMON/WRFV2/test/em_squall2d_y/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/em_squall2d_y/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/em_squall2d_y/namelist.input	(revision 2744)
@@ -0,0 +1,107 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 1,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 0001,
+ start_month                         = 01,
+ start_day                           = 01,
+ start_hour                          = 00,
+ start_minute                        = 00,
+ start_second                        = 00,
+ end_year                            = 0001,
+ end_month                           = 01,
+ end_day                             = 01,
+ end_hour                            = 01,
+ end_minute                          = 00,
+ end_second                          = 00,
+ history_interval                    = 10,
+ frames_per_outfile                  = 1000,
+ restart                             = .false.,
+ restart_interval                    = 60,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 3,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,
+ e_we                                = 3,
+ s_sn                                = 1,
+ e_sn                                = 202,
+ s_vert                              = 1,
+ e_vert                              = 81,
+ dx                                  = 250,
+ dy                                  = 250,
+ ztop                                = 20000.,
+ /
+
+ &physics
+ mp_physics                          = 2,
+ ra_lw_physics                       = 0,
+ ra_sw_physics                       = 0,
+ radt                                = 0,
+ sf_sfclay_physics                   = 0,
+ sf_surface_physics                  = 0,
+ bl_pbl_physics                      = 0,
+ bldt                                = 0,
+ cu_physics                          = 0,
+ cudt                                = 0,
+ isfflx                              = 0,
+ ifsnow                              = 0,
+ icloud                              = 0,
+ num_soil_layers                     = 5,
+ mp_zero_out                         = 0, 
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ dyn_opt                             = 2,
+ rk_ord                              = 3,
+ diff_opt                            = 2,
+ km_opt                              = 2,
+ damp_opt                            = 2,
+ dampcoef                            = .003,
+ zdamp                               = 5000.,
+ khdif                               = 300,
+ kvdif                               = 1,
+ smdiv                               = 0.1,
+ emdiv                               = 0.01,
+ epssm                               = 0.1,
+ mix_full_fields                     = .true.,
+ non_hydrostatic                     = .true.,
+ time_step_sound                     = 6,
+ h_mom_adv_order                     = 5,
+ v_mom_adv_order                     = 3,
+ h_sca_adv_order                     = 5,
+ v_sca_adv_order                     = 3,
+ /
+
+ &bdy_control
+ periodic_x                          = .true.,
+ symmetric_xs                        = .false.,
+ symmetric_xe                        = .false.,
+ open_xs                             = .false., 
+ open_xe                             = .false.,
+ periodic_y                          = .false.,
+ symmetric_ys                        = .false.,
+ symmetric_ye                        = .false.,
+ open_ys                             = .true.,
+ open_ye                             = .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/exp_real/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/exp_real/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/exp_real/namelist.input	(revision 2744)
@@ -0,0 +1,116 @@
+ &namelist_01
+ time_step                       = 450,
+ time_step_fract_num			= 0,
+ time_step_fract_den			= 1,
+ restart                             = .false.,
+ max_dom                             = 1,
+ dyn_opt                             = 4,
+ rk_ord                              = 3,
+ diff_opt                            = 0,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ num_soil_layers                     = 5,
+ spec_bdy_width                      = 5,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ tile_sz_x                           = 0,
+ tile_sz_y                           = 0,
+ numtiles                            = 1,
+ debug_level                         = 0 /
+
+ &namelist_02
+ run_days		    	     = 0,
+ run_hours                           = 2,
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 1993
+ start_month                         = 03
+ start_day                           = 13
+ start_hour                          = 00
+ start_minute                        = 00,
+ start_second                        = 00,
+ end_year                            = 1993
+ end_month                           = 03
+ end_day                             = 13
+ end_hour                            = 12
+ end_minute                          = 00,
+ end_second                          = 00,
+ interval_seconds                    = 21600
+ grid_id                             = 1,
+ s_we                                = 1,
+ e_we                                = 41,
+ s_sn                                = 1,
+ e_sn                                = 35,
+ s_vert                              = 1,
+ e_vert                              = 28,
+ history_interval			= 5,
+ restart_interval			= 244,
+ frames_per_outfile			= 1,
+ time_step_sound			= 4 /
+
+
+ &namelist_03
+ dx                                  = 90000,
+ dy                                  = 90000,
+ ztop                                = 17558.2
+ zdamp                               = 5000.,
+ dampcoef                            = 0.01,
+ non_hydrostatic                     = .true.,
+ smdiv                               = 0.1,
+ emdiv                               = 0.01,
+ epssm                               = .1,
+ khdif                               = 0,
+ kvdif                               = 0,
+ mix_cr_len                          = 200.,
+ radt                                = 30,
+ bldt                                = 0,
+ cudt                                = 5,
+ julyr                               = 0,
+ julday                              = 1,
+ gmt                                 = 0. /
+
+ &namelist_04
+ periodic_x                          = .false.,
+ symmetric_xs                        = .false.,
+ symmetric_xe                        = .false.,
+ open_xs                             = .true.,
+ open_xe                             = .true.,
+ periodic_y                          = .false.,
+ symmetric_ys                        = .false.,
+ symmetric_ye                        = .false.,
+ open_ys                             = .true.,
+ open_ye                             = .true.,
+ nested                              = .false.,
+ specified                           = .false.,
+ top_radiation                       = .false.,
+ chem_opt                            = 0,
+ mp_physics                          = 3,
+ ra_lw_physics                       = 1,
+ ra_sw_physics                       = 1,
+ sf_sfclay_physics                   = 1,
+ sf_surface_physics                  = 1,
+ bl_pbl_physics                      = 1,
+ cu_physics                          = 1,
+ h_mom_adv_order                     = 5,
+ v_mom_adv_order                     = 3,
+ h_sca_adv_order                     = 5,
+ v_sca_adv_order                     = 3,
+ io_form_history                     = 2,
+ io_form_restart                     = 2,
+ io_form_input                       = 2,
+ io_form_boundary                    = 2 /
+
+ &namelist_05
+ real_data_init_type                 = 1 /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
+
Index: trunk/WRF.COMMON/WRFV2/test/nmm_real/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/nmm_real/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/nmm_real/namelist.input	(revision 2744)
@@ -0,0 +1,125 @@
+ &time_control
+ run_days                            = 1,
+ run_hours                           = 0,   
+ run_minutes                         = 0,
+ run_seconds                         = 0,
+ start_year                          = 2005,
+ start_month                         = 01,
+ start_day                           = 23,
+ start_hour                          = 00,
+ start_minute                        = 00,
+ start_second                        = 00,
+ tstart                              = 00,
+ end_year                            = 2005,
+ end_month                           = 01,
+ end_day                             = 24,
+ end_hour                            = 00,
+ end_minute                          = 00,
+ end_second                          = 00,
+ interval_seconds                    = 10800,
+ history_interval                    = 60
+ frames_per_outfile                  = 1,
+ restart                             = .false.,
+ restart_interval                    = 6000,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_auxinput1                   = 2
+ io_form_boundary                    = 2
+ debug_level                         = 1
+ /
+
+ &fdda
+ /
+
+ &domains
+ time_step                           = 45,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,
+ e_we                                = 56,
+ s_sn                                = 1,
+ e_sn                                = 92,
+ s_vert                              = 1,
+ e_vert                              = 38,
+ dx                                  = .097500,
+ dy                                  = .090600,
+ grid_id                             = 1,
+ tile_sz_x		   	     = 0,
+ tile_sz_y		   	     = 0,
+ numtiles			     = 1,
+ /
+
+ &physics
+ mp_physics                          = 5,
+ ra_lw_physics                       = 99,
+ ra_sw_physics                       = 99,
+ radt                                = 60,
+ nrads                               = 200,
+ nradl                               = 200,
+ co2tf                               = 1,
+ sf_sfclay_physics                   = 2,
+ sf_surface_physics                  = 99,
+ bl_pbl_physics                      = 2,
+ bldt                                = 3,
+ nphs                                = 10,
+ cu_physics                          = 2,
+ cudt                                = 3,
+ ncnvc                               = 10,
+ tprec                               = 3,
+ theat                               = 6,
+ tclod                               = 6,
+ trdsw                               = 6,
+ trdlw                               = 6,
+ tsrfc                               = 6,
+ pcpflg                              = .false.,
+ isfflx                              = 0,
+ ifsnow                              = 0,
+ icloud                              = 0,
+ num_soil_layers                     = 4,
+ mp_zero_out                         = 0,
+ /
+
+ &dynamics
+ dyn_opt                             = 4,
+ rk_ord                              = 3,
+ diff_opt                            = 0,
+ km_opt                              = 1,
+ damp_opt                            = 1,
+ zdamp                               = 5000.,
+ dampcoef                            = 0.01,
+ khdif                               = 0,
+ kvdif                               = 0,
+ mix_cr_len			     = 200.,
+ smdiv                               = 0.1,
+ emdiv                               = 0.01,
+ epssm                               = 0.1,
+ time_step_sound                     = 4,
+ /
+
+ &bdy_control
+ spec_bdy_width                      = 1,
+ spec_zone                           = 1,
+ relax_zone                          = 4,
+ specified                           = .true.,
+ periodic_x                          = .false.,
+ symmetric_xs                        = .false.,
+ symmetric_xe                        = .false.,
+ open_xs                             = .false.,
+ open_xe                             = .false.,
+ periodic_y                          = .false.,
+ symmetric_ys                        = .false.,
+ symmetric_ye                        = .false.,
+ open_ys                             = .false.,
+ open_ye                             = .false.,
+ nested                              = .false.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV2/test/nmm_real/tomorrow
===================================================================
--- trunk/WRF.COMMON/WRFV2/test/nmm_real/tomorrow	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/test/nmm_real/tomorrow	(revision 2744)
@@ -0,0 +1,121 @@
+#!/bin/ksh -f
+
+yy=`expr $1 / 10000`
+mm=`expr $1 - $yy * 10000`
+mm=`expr $mm / 100`
+dd=`expr $1 % 100`
+
+
+yy=`expr $yy + 0`
+mm=`expr $mm + 0`
+dd=`expr $dd + 0`
+
+if [ $yy -lt 10 ] ; then
+yy=0$yy
+fi
+
+if [ $mm -lt 10 ] ; then
+mm=0$mm
+fi
+
+if [ $dd -lt 10 ] ; then
+dd=0$dd
+fi
+
+# exit
+
+if [ $mm -eq 1 -or $mm -eq 01 ] 
+then
+mxd=31
+fi
+
+if [ $mm -eq 2 -o $mm -eq 02 ]
+then
+   leap=`expr $yy % 4`
+    if [ $leap -eq 0 ]
+    then
+    mxd=29
+    fi
+    if [ $leap -ne 0 ]
+    then
+    mxd=28
+    fi
+fi
+
+
+if [ $mm -eq 3 -o $mm -eq 03 ] ; then
+mxd=31
+fi
+
+if [ $mm -eq 4 -o $mm -eq 04 ] ; then
+mxd=30
+fi
+
+if [ $mm -eq 5 -o $mm -eq 05 ] ; then
+mxd=31
+fi
+
+if [ $mm -eq 6 -o $mm -eq 06 ] ; then
+mxd=30
+fi
+
+if [ $mm -eq 7 -o $mm -eq 07 ] ; then
+mxd=31
+fi
+
+if [ $mm -eq 8 -o $mm -eq 08 ] ; then
+mxd=31
+fi
+
+if [ $mm -eq 9 -o $mm -eq 09 ] ; then
+mxd=30
+fi
+
+if [ $mm -eq 10 ] ; then
+mxd=31
+fi
+
+if [ $mm -eq 11 ] ; then
+mxd=30
+fi
+
+if [ $mm -eq 12 ] ; then
+mxd=31
+fi
+# echo "max days in month: " $mxd
+dd=`expr $dd + 1`
+
+# echo "new dd: " $dd
+
+if [ $dd -gt $mxd ]
+then
+    mm=`expr $mm + 1`
+    if [ $mm -eq 13 ]
+        then
+        yy=`expr $yy + 1`
+        mm=1
+    fi
+    dd=1
+fi
+yy=`expr $yy + 0`
+mm=`expr $mm + 0`
+dd=`expr $dd + 0`
+
+if [ $yy -lt 10 ] ; then
+yy=0$yy
+fi
+
+if [ $mm -lt 10 ] ; then
+mm=0$mm
+fi
+
+if [ $dd -lt 10 ] ; then
+dd=0$dd
+fi
+
+# echo "now have yy mm dd: " $yy $mm $dd
+
+ymd=${yy}${mm}${dd}
+
+echo $ymd
+
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/arch
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/arch	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/arch	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/arch/
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/build_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/build_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/build_gcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/build_gcm
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/create_make_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/create_make_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/create_make_gcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../../LMDZ.COMMON/create_make_gcm
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/ioipsl
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/ioipsl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/ioipsl	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/ioipsl/
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/chimtitan
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/chimtitan	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/chimtitan	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/chimtitan/
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/dyn3d
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/dyn3d	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/dyn3d	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/dyn3d
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/filtrez
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/filtrez	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/filtrez	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/filtrez/
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/grid
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/grid	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/grid	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/grid/
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/misc
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/misc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/misc	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/misc/
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/phy_common
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/phy_common	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/phy_common	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/phy_common/
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/phytitan
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/phytitan	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf/phytitan	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/phytitan/
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/libf_gcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/libf
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/makegcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/makegcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/makegcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/makegcm
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/makelmdz
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/makelmdz	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/makelmdz	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/makelmdz
Index: trunk/WRF.COMMON/WRFV2/titan_lmd_new/makelmdz_fcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/titan_lmd_new/makelmdz_fcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/titan_lmd_new/makelmdz_fcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/makelmdz_fcm
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/Makefile	(revision 2744)
@@ -0,0 +1,25 @@
+CC = cc -g
+all : nocontf90 deftab subinfo_calls wrfvar callgraph
+
+nocontf90 : nocontf90.o util.o
+	$(CC) -o $@ nocontf90.o util.o
+	/bin/mv -f $@ ..
+
+deftab : deftab.o util.o
+	$(CC) -o $@ deftab.o util.o
+	/bin/mv -f $@ ..
+
+subinfo_calls : subinfo_calls.o util.o
+	$(CC) -o $@ subinfo_calls.o util.o
+	/bin/mv -f $@ ..
+
+callgraph : callgraph.o util.o sym.o symtab_gen.o
+	$(CC) -o $@ callgraph.o util.o sym.o symtab_gen.o
+	/bin/mv -f $@ ..
+
+wrfvar : wrfvar.o util.o
+	$(CC) -o $@ wrfvar.o util.o
+	/bin/mv -f $@ ..
+
+clean :
+	/bin/rm -f *.o deftab nocontf90 callgraph subinfo_calls
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/callgraph.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/callgraph.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/callgraph.c	(revision 2744)
@@ -0,0 +1,299 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <dirent.h>
+#include "sym.h"
+
+#define DBDIR "tools/code_dbase"
+
+#define COMPARE(A,B) ( ! strncmp ( A , B , strlen( B ) ) )
+#define COMPARE2(A,B) ( ! strcmp ( A , B ) )
+#define INLINELEN (4*8192)
+#define VARLEN 256
+#define MAXRECORDS 8192
+
+int recno = 1 ;
+char outbuf[MAXRECORDS][VARLEN] ;
+
+main( int argc , char * argv[] )
+{
+  DIR *dir ;
+  char root[VARLEN] ;
+  int cut = 99 ;
+  int nentries ;
+  int i ;
+
+  if (( dir = opendir ( DBDIR )) == NULL ) {
+    fprintf(stderr, "Must be in top level WRF directory\n") ; exit(2) ;
+  } closedir( dir ) ;
+  if ( argc < 2 ) {
+    fprintf(stderr,"usage: callgraph root\n") ;
+  }
+  sym_init() ;
+  strcpy( root, argv[1] ) ;
+  if ( argv[2] ) {
+    cut = atoi( argv[2] ) ;
+  } 
+  upper_case_str( root ) ;
+  lower_case_str( root ) ;
+  callgraph( root , 0 , cut ) ;
+  sprintf(outbuf[0],"var db = new makeArray(%d)\n",recno-1 ) ;
+  for ( i = 0 ; i <= recno ; i++ )
+    printf("%s",outbuf[i]) ; 
+}
+
+callgraph ( char * root , int indent , int cut )
+{
+  FILE * CALLEES ;
+  char fname[VARLEN] ;
+  char * p, * q, *q1, prev  ;
+  char inln[INLINELEN] ;
+  char t[12][VARLEN] ;
+  int i ;
+  char * doescall ;
+  char tempbuf[VARLEN] ;
+  int thisrec ;
+
+  sprintf(fname,"%s/calls", DBDIR ) ;
+/* skip some routines */
+  if ( 
+            COMPARE( root , "add_msg" ) ||  COMPARE( root , "reset_msgs" ) ||
+            COMPARE( t[2] , "get_" )    ||  COMPARE( t[2] , "set_" )       ||
+            COMPARE( t[2] , "mpi_" )    ||  COMPARE( t[2] , "ext_" )       ||
+            COMPARE( root , "stencil" ) ||  COMPARE( root , "wrf_debug" )  ||
+            COMPARE( root , "wrf_message" ) ||  COMPARE( root , "wrf_error" )
+                                                                      )  return ;
+  thisrec = recno++ ;
+#if 0
+  sprintf(tempbuf,"db[%4d] = new dbRecord( %%s, \"%s\", \"../../WRFV2/tools/code_dbase/%s.html\", %d )\n",
+          thisrec,  root, root, indent ) ;
+#else
+  sprintf(tempbuf,"db[%4d] = new dbRecord( %%s, \"%s\", \"%s.html\", %d )\n",
+          thisrec,  root, root, indent ) ;
+#endif
+
+  if (( CALLEES = fopen( fname , "r" )) == NULL ) return ;
+
+  doescall = "false" ;
+  while ( fgets( inln, INLINELEN, CALLEES ) != NULL ) {
+    remove_nl ( inln ) ;
+    /* find first non space */
+    for ( p = inln ; *p ; p++ ) { if ( *p != ' ' ) break ; }
+    /* change multiple spaces to single space */
+    for ( q = p, q1 = q , prev = *p ; *q ; q++ )
+       { if ( prev == ' ' && *q == ' ' ) { continue ; } else { prev = *q ; *q1++ = *q ; } }
+    strcpy( inln, p ) ;
+    for ( i = 0 ; i < 11 ; i++ ) {
+      strcpy( t[i] , "" ) ;
+      get_token_n( inln, " ", i , t[i] ) ; remove_nl(t[i]) ; lower_case_str( t[i] ) ;
+    }
+    if ( COMPARE2( t[0] , root ) && COMPARE2( t[1] , "calls" ) && ! COMPARE2( t[0] , t[2] ) &&
+         ! (
+            COMPARE( root , "add_msg" ) ||  COMPARE( root , "reset_msgs" ) ||
+            COMPARE( t[2] , "get_" )    ||  COMPARE( t[2] , "set_" )       ||
+            COMPARE( t[2] , "mpi_" )    ||  COMPARE( t[2] , "ext_" )       ||
+            COMPARE( root , "stencil" ) ||  COMPARE( root , "wrf_debug" )  ||
+            COMPARE( root , "wrf_message" ) ||  COMPARE( root , "wrf_error" )
+           )) {
+      if ( indent <= cut && ( ! sym_get ( t[2] ) ) ) {
+	sym_add( t[2] ) ;
+        doescall = "true" ;
+	callgraph ( t[2] , indent + 1, cut ) ;
+      }
+    }
+  }
+  sprintf(outbuf[thisrec],tempbuf,doescall) ;
+  fclose( CALLEES ) ;
+}
+
+#if 0
+/*******************************************************************/
+
+/* open the file of calls and count them */
+count_entries ( char * root , int * nentries )
+{
+  FILE * CALLEES ;
+  char fname[VARLEN] ;
+  char inln[INLINELEN] ;
+  char * p, *q, *q1, prev ;
+  char t[12][VARLEN] ;
+  int i ;
+
+  sprintf(fname,"%s/calls", DBDIR ) ;
+  if (( CALLEES = fopen( fname , "r" )) == NULL ) return ;
+  *nentries = 0 ;
+  while ( fgets( inln, INLINELEN, CALLEES ) != NULL ) {
+    remove_nl ( inln ) ;
+    /* find first non space */
+    for ( p = inln ; *p ; p++ ) { if ( *p != ' ' ) break ; }
+    /* change multiple spaces to single space */
+    for ( q = p, q1 = q , prev = *p ; *q ; q++ )
+       { if ( prev == ' ' && *q == ' ' ) { continue ; } else { prev = *q ; *q1++ = *q ; } }
+    strcpy( inln, p ) ;
+    for ( i = 0 ; i < 11 ; i++ ) {
+      strcpy( t[i] , "" ) ;
+      get_token_n( inln, " ", i , t[i] ) ; remove_nl(t[i]) ; lower_case_str( t[i] ) ;
+    }
+    if ( COMPARE2( t[0] , root ) && COMPARE2( t[1] , "calls" ) && ! COMPARE2( t[0] , t[2] ) &&
+         ! (
+            COMPARE( root , "add_msg" ) ||  COMPARE( root , "reset_msgs" ) ||
+            COMPARE( t[2] , "get_" )    ||  COMPARE( t[2] , "set_" )       ||
+            COMPARE( t[2] , "mpi_" )    ||  COMPARE( t[2] , "ext_" )       ||
+            COMPARE( root , "stencil" ) ||  COMPARE( root , "wrf_debug" )  ||
+            COMPARE( root , "wrf_message" ) ||  COMPARE( root , "wrf_error" )
+           )) {
+      sym_add( t[2] ) ;
+      (*nentries)++ ;
+    }
+  }
+  fclose( CALLEES ) ;
+}
+
+
+
+/* old version before adding javascript calltree */
+main( int argc , char * argv[] )
+{
+  DIR *dir ;
+  char root[VARLEN] ;
+  int cut = 99 ;
+
+  if (( dir = opendir ( DBDIR )) == NULL ) {
+    fprintf(stderr, "Must be in top level WRF directory\n") ; exit(2) ;
+  } closedir( dir ) ;
+  if ( argc < 2 ) {
+    fprintf(stderr,"usage: callgraph root\n") ;
+  }
+  sym_init() ;
+  strcpy( root, argv[1] ) ;
+  if ( argv[2] ) {
+    cut = atoi( argv[2] ) ;
+  } 
+  upper_case_str( root ) ;
+  printf("<html>\n" ) ;
+  printf("<title> %s Call Tree </title>\n", root ) ;
+  printf("<body>\n" ) ;
+  printf("<h1> %s Call Tree </h1>\n", root ) ;
+  printf("<p><a href=index.html>[1] </a> " ) ;
+  printf("<a href=ct2.html>[2] </a> " ) ;
+  printf("<a href=ct3.html>[3] </a> " ) ;
+  printf("<a href=ct4.html>[4] </a> " ) ;
+  printf("<a href=ct5.html>[5] </a> " ) ;
+  printf("<a href=ctall.html>[all] </a><p>\n" ) ;
+  lower_case_str( root ) ;
+  callgraph( root , 0 , cut ) ;
+  printf("</body>\n" ) ;
+  printf("</html>\n" ) ;
+}
+
+callgraph ( char * root , int indent , int cut )
+{
+  FILE * CALLEES ;
+  char fname[VARLEN] ;
+  char * p, * q, *q1, prev  ;
+  char inln[INLINELEN] ;
+  char t[12][VARLEN] ;
+  int i ;
+  int recno = 1 ;
+
+  sprintf(fname,"%s/calls", DBDIR ) ;
+  if (( CALLEES = fopen( fname , "r" )) == NULL ) return ;
+  if ( 
+            COMPARE( root , "add_msg" ) ||  COMPARE( root , "reset_msgs" ) ||
+            COMPARE( t[2] , "get_" )    ||  COMPARE( t[2] , "set_" )       ||
+            COMPARE( t[2] , "mpi_" )    ||  COMPARE( t[2] , "ext_" )       ||
+            COMPARE( root , "stencil" ) ||  COMPARE( root , "wrf_debug" )  ||
+            COMPARE( root , "wrf_message" ) ||  COMPARE( root , "wrf_error" )
+                                                                      )  return ;
+  for ( i = 0 ; i < indent ; i++ ) printf(" ! &nbsp &nbsp &nbsp ") ;
+  printf(" <a href=\"%s.html\"> %s </a><br>\n", root, root ) ;
+
+  while ( fgets( inln, INLINELEN, CALLEES ) != NULL ) {
+    remove_nl ( inln ) ;
+    /* find first non space */
+    for ( p = inln ; *p ; p++ ) { if ( *p != ' ' ) break ; }
+    /* change multiple spaces to single space */
+    for ( q = p, q1 = q , prev = *p ; *q ; q++ )
+       { if ( prev == ' ' && *q == ' ' ) { continue ; } else { prev = *q ; *q1++ = *q ; } }
+    strcpy( inln, p ) ;
+    for ( i = 0 ; i < 11 ; i++ ) {
+      strcpy( t[i] , "" ) ;
+      get_token_n( inln, " ", i , t[i] ) ; remove_nl(t[i]) ; lower_case_str( t[i] ) ;
+    }
+    if ( COMPARE2( t[0] , root ) && COMPARE2( t[1] , "calls" ) && ! COMPARE2( t[0] , t[2] ) &&
+         ! (
+            COMPARE( root , "add_msg" ) ||  COMPARE( root , "reset_msgs" ) ||
+            COMPARE( t[2] , "get_" )    ||  COMPARE( t[2] , "set_" )       ||
+            COMPARE( t[2] , "mpi_" )    ||  COMPARE( t[2] , "ext_" )       ||
+            COMPARE( root , "stencil" ) ||  COMPARE( root , "wrf_debug" )  ||
+            COMPARE( root , "wrf_message" ) ||  COMPARE( root , "wrf_error" )
+           )) {
+      if ( indent <= cut && ( ! sym_get ( t[2] ) ) ) {
+	sym_add( t[2] ) ;
+	callgraph ( t[2] , indent + 1, cut ) ;
+      }
+
+    }
+  }
+  fclose( CALLEES ) ;
+}
+#####################
+# original old PERL code kept just for reference
+
+$dbdir = "tools/code_dbase" ;
+
+if ( ! opendir( TOOLDIR, "tools") )  {
+  print "\nMust be in top level WRF directory\n" ;
+  exit ;
+}
+closedir TOOLDIR ;
+
+if ( ( scalar @ARGV  < 1 ) )  {
+  print "usage: callgraph root\n" ;
+  exit ;
+}
+
+$rout1 = lc $ARGV[0] ;
+$rout = $rout1 ;
+
+$routfile = $dbdir."/".$rout ;
+
+if ( $indent == 0 ) {
+print "<html>\n" ;
+print "<title> ",uc $rout," Call Tree </title>\n" ;
+print "<body>\n" ;
+print "<h1> ",uc $rout," Call Tree </h1>\n" ;
+}
+
+$indent = 0 ;
+
+$first = 1 ;
+
+open CALLEES, "< $dbdir/calls" or die " cannot open $dbdir/calls " ;
+while ( <CALLEES> ) { 
+   @t = split ' ' ;
+   if ( $t[0] eq lc $rout && $t[1] eq "calls" && ! ( $t[2] eq $t[0] ) && ! ($t[2] =~ add_msg) && !($t[2] =~ reset_msgs ) && ! ($t[2] =~ stencil) && !($t[2] =~ wrf_debug) ) {
+     if ( $first == 1 ) {
+       for ( $i = 0 ; $i < $indent ; $i++ ) { print "| &nbsp " ; }
+       print "<a href=\"$rout\.html\"> $rout </a><br>\n" ;
+       $first = 0 ;
+     }
+     $i2 = $indent + 1 ;
+     if ( $i2 < 7 && (! $prune{$t[2]} ) ) {
+        $prune{$t[2]} = "y" ;
+        $opstr = "tools/callgraph $t[2] $i2 |" ;
+        ####### RECURSE ##########
+        open D, $opstr ;
+        while ( <D> ) { print ; }
+        close D ;
+     }
+   }
+}
+if ( $indent == 0 ) {
+print "</body>\n" ;
+print "</html>\n" ;
+}
+
+exit
+#endif
+
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/deftab.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/deftab.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/deftab.c	(revision 2744)
@@ -0,0 +1,328 @@
+#include <stdio.h>
+#include <string.h>
+
+#define INLINELEN (4*8192)
+#define VARLEN 128
+#define MAXARGS (4*8192)
+
+#define DIR "tools/code_dbase"
+
+char inln[INLINELEN] ;
+
+#define COMPARE(A,B) ( ! strncmp ( A , B , strlen( B ) ) )
+#define COMPARE2(A,B) ( ! strcmp ( A , B ) )
+
+char module_name[INLINELEN] ;
+char subprogram_name[INLINELEN] ;
+char in_a[INLINELEN] ;
+char arg[MAXARGS][VARLEN] ;
+char type[MAXARGS][VARLEN] ;
+char from[MAXARGS][VARLEN] ;
+char intent[MAXARGS][VARLEN] ;
+char dimensions[MAXARGS][VARLEN] ;
+char typedefs[MAXARGS][INLINELEN] ;
+int ntypedefs = 0 ;
+char tmp[VARLEN] ;
+char infname[VARLEN] ;
+int  nargs ;
+char function_type[VARLEN] ;
+int contained ;
+
+char *ignore = "rsl" ;
+
+int protex_state ;
+
+set_attributes( char * inln, int nargs, char * typ )
+{
+  int i, j ;
+  char *p, tmp[VARLEN] ;
+  for ( i = 0 ; i < nargs ; i++ )
+  {
+    if ( contains_tok ( inln , arg[i], " ()," ) ) {
+      strcpy( type[i], typ ) ;
+      if (( j = contains_tok ( inln, "intent", " (),:" ))) {
+        get_token_n ( inln , " (),:", j+1, intent[i] ) ;
+      }
+      else
+      {
+        strcpy(intent[i],"inout") ;
+      }
+      strcpy( dimensions[i], "" ) ;
+      if ( find_str ( inln, "dimension", &p )) {
+        j = 0 ;
+        remove_whitespace( p ) ;
+        while ( get_arg_n ( p , j, tmp ) ) {
+          strcat( dimensions[i], tmp ) ;
+          strcat( dimensions[i], "," ) ;
+          j++ ;
+        }
+        if (( p = rindex( dimensions[i], ',' )) != NULL ) *p = '\0' ;
+      }
+    }
+  }
+}
+
+handle_subprogram ( FILE **fp, FILE *ifp, int *nargs, char * sname , char * inln , int tokpos )
+{
+  char fname[VARLEN] ;
+  int i ;
+
+  if ( ! contained ) {
+    sprintf(fname,"%s/%s",DIR, sname ) ;
+    if ((*fp = fopen( fname , "w" )) == NULL ) {
+      fprintf(stderr,"cannot open %s for writing\n",fname) ; exit(1) ;
+    }
+    fprintf(*fp,"sourcefile %s\n",infname ) ;
+    if ( COMPARE( in_a, "function" ) ) {
+      fprintf(*fp,"subprogram %s %s\n",in_a, function_type ) ;
+    } else {
+      fprintf(*fp,"subprogram %s\n",in_a ) ;
+    }
+    for ( i = 0 ; get_token_n ( inln , " (,)", i+tokpos, arg[i] ) ; i++ ) { strcpy( from[i], "dummyarg" ) ; }
+    *nargs = i ;
+    ntypedefs = 0 ;
+    fprintf(*fp,"nargs %d\n", *nargs) ;
+  }
+  contained++ ;
+}
+
+main( int argc, char * argv[] )
+{
+  FILE *infl ;
+  FILE *fp, *fpcalls, *fpdescription ;
+  int i, j ;
+  char callee[VARLEN] ;
+  char fname[VARLEN] ;
+  char description_name[VARLEN] ;
+  char mess[INLINELEN] ;
+  int in_interface ;
+  int looking_scalar_derefs ;
+
+  strcpy( module_name, "" ) ;
+  strcpy( subprogram_name, "" ) ;
+  strcpy( infname, "" ) ;
+
+  infl = stdin ;
+  if ( argc == 2 ) {
+    strcpy( infname, argv[1] ) ;
+  }
+  sprintf(fname,"%s/calls",DIR ) ;
+  if ( ( fpcalls = fopen( fname , "a" )) == NULL )
+  {
+    fprintf(stderr,"cannot open %s\n",fname) ;
+    exit(1) ;
+  }
+
+  in_interface = 0 ;
+
+  looking_scalar_derefs = 0 ;
+ 
+  contained = 0 ;
+
+  protex_state = 0 ;
+  fpdescription = NULL ;
+
+  while( fgets( inln, INLINELEN, infl ) != NULL )
+  {
+    if ( protex_state > 0 ) {   /* in a description */
+       if ( contains_str ( inln, "</DESCRIPTION>" ) ) {
+         protex_state = 0 ;
+         if ( fpdescription != NULL ) fclose( fpdescription ) ; 
+         fpdescription = NULL ;
+	 continue ;
+       }
+       if ( fpdescription != NULL ) {
+          remove_chars( inln, "!", ' ' ) ;
+          if ( empty( inln ) ) {
+            fprintf(fpdescription,"<p>\n") ;
+          } else {
+            fprintf(fpdescription,"%s",inln) ;
+          }
+          continue ;
+       }
+    }
+    remove_nl ( inln ) ;
+    lower_case_str ( inln ) ;
+    if ( looking_scalar_derefs ) {
+       if ( COMPARE ( inln, "grid%" ) ) {
+         get_token_n ( inln , " ", 2, arg[nargs] ) ;
+         strcpy( from[nargs] , "registry" ) ;
+         nargs++ ;
+       }
+    }
+    if ( in_interface ) {
+       if ( COMPARE( inln , "end interface" ) ) in_interface = 0 ;
+       /* ignore interface blocks */
+       continue ;
+    }
+    if ( COMPARE( inln , "interface" ) ) {
+       in_interface = 1 ;
+    } else if ( COMPARE( inln , "module " ) ) {
+       get_token_n ( inln , " (,", 1, module_name ) ;
+    } else if ( COMPARE( inln , "end module" ) ) {
+       strcpy( module_name, "" ) ;
+    } else if ( COMPARE( inln , "program " ) ) {
+       strcpy(in_a, "program") ;
+       get_token_n ( inln , " (,", 1, subprogram_name ) ;
+       handle_subprogram ( &fp, infl, &nargs, subprogram_name, inln, 2 ) ;
+    } else if ( COMPARE( inln , "subroutine " ) ) {
+       strcpy(in_a, "subroutine") ;
+       get_token_n ( inln , " (,", 1, subprogram_name ) ;
+       handle_subprogram ( &fp, infl, &nargs, subprogram_name, inln, 2 ) ;
+    } else if ( COMPARE( inln , "function " ) ) {
+       strcpy(in_a, "function") ;
+       get_token_n ( inln , " (,", 1, subprogram_name ) ;
+       handle_subprogram ( &fp, infl, &nargs, subprogram_name, inln, 2 ) ;
+    } else if ( COMPARE( inln , "recursive subroutine " ) ) {
+       strcpy(in_a, "recursive subroutine") ;
+       get_token_n ( inln , " (,", 2, subprogram_name ) ;
+       handle_subprogram ( &fp, infl, &nargs, subprogram_name, inln, 3 ) ;
+    } else if ( contains_str ( inln, "startofregistrygeneratedinclude" ) && contains_str ( inln, "i1_decl.inc" )) {
+       if ( strlen( subprogram_name ) > 0 ) {
+         fprintf(fp, "contains_i1_declarations\n" ) ;
+       }
+    } else if ( contains_str ( inln, "! begin scalar derefs" ) ) {
+       looking_scalar_derefs = 1 ;
+    } else if ( contains_str ( inln, "! end scalar derefs" ) ) {
+       looking_scalar_derefs = 0 ;
+    } else if ( contains_str ( inln, "<description>" ) && protex_state == 0 ) {
+       protex_state = 1 ;
+       sprintf(description_name,"%s/%s_descrip",DIR, subprogram_name ) ;
+       if ((fpdescription = fopen( description_name , "a" )) == NULL ) {
+	 fprintf(stderr, "cannot open %s for writing\n", description_name ) ; exit(2) ; 
+       }
+       protex_state = 2 ;
+    } else if ( contains_str ( inln, "</description>" ) ) {
+       protex_state = 0 ;
+       if ( fpdescription != NULL ) fclose( fpdescription ) ; 
+       fpdescription = NULL ;
+    } else if ( COMPARE( inln , "use " ) ) {
+       if ( strlen( subprogram_name ) > 0 ) {
+         get_token_n ( inln , " ", 1, tmp ) ;
+         fprintf(fp, "use %s\n",tmp ) ;
+       }
+    } else if ( COMPARE( inln , "call " ) ) {
+       get_token_n ( inln , " (,", 1, callee ) ;
+       if ( ! contains_str( callee , ignore ) ) {
+	 fprintf(fpcalls,"%s calls %s\n",subprogram_name, callee ) ;
+         fprintf(fp,"%s calls %s\n",subprogram_name, callee ) ;
+         for ( i = 0 ; get_arg_n ( inln , i, tmp ) ; i++ ) 
+         { 
+	   /* check to see if this is a dummy arg and print that info too */
+	   strcpy(mess,"") ;
+           for ( j = 0 ; j < nargs ; j++ )
+	   {
+	     if ( !strcmp( tmp, arg[j] ) )
+	     {
+	       sprintf( mess, " ( dummy arg %d, type %s ) ",j,type[j] ) ;
+	       break ;
+	     }
+	   }
+           fprintf(fp,"  actarg %d of callee %s is %s%s\n",i,callee, tmp,mess) ; 
+         }
+       }
+    } else if ( COMPARE( inln , "integer " ) || COMPARE( inln , "real " ) || COMPARE( inln , "logical " ) ) {
+         /* look for function */
+       get_token_n ( inln , " ", 0, function_type ) ;
+       get_token_n ( inln , " ,", 1, tmp ) ;
+       if ( COMPARE( tmp, "function" ) )
+       {
+           strcpy(in_a,"function") ;
+	   get_token_n ( inln, " (", 2, subprogram_name ) ;
+           handle_subprogram ( &fp, infl, &nargs, subprogram_name, inln, 3 ) ;
+       }
+       else if ( strlen( subprogram_name ) > 0 && nargs > 0 ) {
+         strcpy( typedefs[ntypedefs++], inln ) ;
+       }
+    } else if ( COMPARE( inln , "type " ) ) {
+       if ( strlen( subprogram_name ) > 0 && nargs > 0 ) {
+         strcpy( typedefs[ntypedefs++], inln ) ;
+       }
+    } else if ( COMPARE( inln , "end subroutine" ) ) {
+       contained-- ;
+       if ( contained == 0 ) {
+         fprintf(fp,"Module: %s , Subroutine: %s \n",module_name, subprogram_name ) ;
+         for ( i = 0 ; i < ntypedefs ; i++ )
+         {
+           if ( COMPARE( typedefs[i], "type" ) ) {
+             get_token_n ( typedefs[i], ",", 0, tmp ) ;
+             remove_whitespace( tmp ) ;
+           } else {
+             get_token_n ( typedefs[i], " ,", 0, tmp ) ;
+           }
+           set_attributes( typedefs[i], nargs, tmp ) ;
+         }
+         for ( i = 0 ; i < nargs ; i++ )
+         {
+	   fprintf(fp,"arg %d name %s type %s intent %s from %s dimensions %s\n", i, arg[i], type[i], intent[i], from[i], dimensions[i] ) ;
+         }
+         fclose(fp) ; fp = NULL ;
+         strcpy( in_a, "" ) ;
+         strcpy( subprogram_name, "" ) ;
+       }
+    } else if ( COMPARE( inln , "end function" ) ) {
+       contained-- ;
+       if ( contained == 0 ) {
+         fprintf(fp,"Module: %s , Subroutine: %s \n",module_name, subprogram_name ) ;
+         for ( i = 0 ; i < ntypedefs ; i++ )
+         {
+           get_token_n ( typedefs[i], " ,", 0, tmp ) ;
+           set_attributes( typedefs[i], nargs, tmp ) ;
+         }
+         for ( i = 0 ; i < nargs ; i++ )
+         {
+           fprintf(fp,"arg %d name %s type %s intent %s from %s dimensions %s\n", i, arg[i], type[i], intent[i], from[i], dimensions[i] ) ;
+         }
+         fclose(fp) ; fp = NULL ;
+         strcpy( in_a, "" ) ;
+         strcpy( subprogram_name, "" ) ;
+       }
+    } else if ( COMPARE( inln , "end program" ) ) {
+       contained-- ;
+       if ( contained == 0 ) {
+         fprintf(fp,"Module: %s , Subroutine: %s \n",module_name, subprogram_name ) ;
+         for ( i = 0 ; i < ntypedefs ; i++ )
+         {
+           get_token_n ( typedefs[i], " ,", 0, tmp ) ;
+           set_attributes( typedefs[i], nargs, tmp ) ;
+         }
+         for ( i = 0 ; i < nargs ; i++ )
+         {
+	   fprintf(fp,"arg %d name %s type %s intent %s from %s dimensions %s\n", i, arg[i], type[i], intent[i], from[i], dimensions[i] ) ;
+         }
+         fclose(fp) ; fp = NULL ;
+         strcpy( in_a, "" ) ;
+         strcpy( subprogram_name, "" ) ;
+       }
+#if 1
+    } else if ( COMPARE( inln , "end" ) ) {  /* bare end -- take a chance and hope it's a subroutine */
+       remove_whitespace( inln ) ;   /* make sure it's not an enddo, endif, etc */
+       if ( COMPARE2 (inln , "end" ) ) {
+         contained-- ;
+         if ( contained == 0 ) {
+           fprintf(fp,"Module: %s , Subroutine: %s \n",module_name, subprogram_name ) ;
+           for ( i = 0 ; i < ntypedefs ; i++ )
+           {
+             if ( COMPARE( typedefs[i], "type" ) ) {
+               get_token_n ( typedefs[i], ",", 0, tmp ) ;
+               remove_whitespace( tmp ) ;
+             } else {
+               get_token_n ( typedefs[i], " ,", 0, tmp ) ;
+             }
+             set_attributes( typedefs[i], nargs, tmp ) ;
+           }
+           for ( i = 0 ; i < nargs ; i++ )
+           {
+             fprintf(fp,"arg %d name %s type %s intent %s from %s dimensions %s\n", i, arg[i], type[i], intent[i], from[i], dimensions[i] ) ;
+           }
+           fclose(fp) ; fp = NULL ;
+           strcpy( in_a, "" ) ;
+           strcpy( subprogram_name, "" ) ;
+         }
+       }
+#endif
+    }
+  }
+  fclose( fpcalls ) ; fpcalls = NULL ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/nocontf90.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/nocontf90.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/nocontf90.c	(revision 2744)
@@ -0,0 +1,41 @@
+#include <stdio.h>
+#include <string.h>
+
+#define INLINELEN 8092
+
+char inln[INLINELEN] ;
+
+int protex_state = 0 ;
+
+main()
+{
+  while( fgets( inln, INLINELEN, stdin ) != NULL )
+  {
+    remove_nl( inln ) ;
+    if ( contains_str ( inln , "<DESCRIPTION>" ) ) {
+       protex_state = 1 ;
+       printf("%s\n",inln) ;
+       continue ;
+    }
+    if ( contains_str ( inln , "</DESCRIPTION>" ) ) {
+       protex_state = 0 ;
+       printf("%s\n",inln) ;
+       continue ;
+    }
+    if ( ! contains_str( inln , "SCALAR DEREFS" ) && 
+         ! ( contains_str( inln , "STARTOFREGISTRYGENERATEDINCLUDE" ) && contains_str( inln , "i1_decl.inc" ) ) &&
+         ! protex_state ) {
+      remove_comments ( inln ) ;
+    }
+    if ( ! protex_state ) { 
+      lower_case_str ( inln ) ;
+      remove_chars ( inln, ";", '\n' ) ;
+    }
+    if ( empty ( inln ) ) continue ;
+    if ( remove_ampersands ( inln ) )
+      printf("%s",inln) ;
+    else
+      printf("%s\n",inln) ;
+  }
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/subinfo_calls.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/subinfo_calls.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/subinfo_calls.c	(revision 2744)
@@ -0,0 +1,82 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#define COMPARE(A,B) ( ! strncmp ( A , B , strlen( B ) ) )
+#define COMPARE2(A,B) ( ! strcmp ( A , B ) )
+#define INLINELEN (4*8192)
+#define VARLEN 128
+#define MAXARGS (4*8192)
+#define MAXDEPTH 50
+
+#define DIR "tools/code_dbase"
+
+char levels[MAXDEPTH][VARLEN] ;
+
+main( int argc, char *argv[] )
+{
+  int indent ;
+  int i ;
+  char *rout ;
+  indent = atoi( argv[1] ) ;
+  rout = argv[2] ; 
+  for ( i = 0 ; i < MAXDEPTH ; i++ ) strcpy( levels[i] , "" ) ;
+  subinfo_calls ( rout, indent ) ;
+  
+}
+
+subinfo_calls ( char *rout, int indent ) 
+{
+  FILE *CALLERS ;
+  FILE *CALLER ;
+  char inln[INLINELEN], inln2[INLINELEN] ;
+  int i ;
+  char fname[VARLEN], fname2[VARLEN], sf[VARLEN] ;
+  char u0[VARLEN] , u1[VARLEN] , u2[VARLEN] ;
+  char v0[VARLEN] , v1[VARLEN] , v2[VARLEN] ;
+  char u0_upper[VARLEN] ;
+
+  if ( COMPARE( rout, "add_msg_" ) ||
+       COMPARE( rout, "wrf_error" ) ||
+       COMPARE( rout, "wrf_debug" ) ||
+       COMPARE( rout, "wrf_message" ) ||
+       COMPARE( rout, "stencil_" ) ||
+       COMPARE( rout, "start_timing" ) ||
+       COMPARE( rout, "end_timing" ) ) exit(0) ;
+
+  sprintf(fname, "%s/calls", DIR ) ;
+  if (( CALLERS = fopen( fname, "r" )) == NULL ) { fprintf(stderr,"subinfo_calls: cannot open %s\n",fname) ; exit(1) ; }
+
+  while ( fgets( inln, INLINELEN, CALLERS ) != NULL ) {
+    get_token_n ( inln, " ", 0, u0 ) ; remove_nl(u0) ;
+    get_token_n ( inln, " ", 1, u1 ) ; remove_nl(u1) ;
+    get_token_n ( inln, " ", 2, u2 ) ; remove_nl(u2) ;
+    if ( COMPARE2( rout, u2 ) && ! COMPARE( u2 , u0 ) ) {
+      sprintf( fname2 , "%s/%s", DIR, u0 ) ;
+      if (( CALLER = fopen( fname2, "r" )) == NULL ) { fprintf(stderr,"subinfo_calls: cannot open %s\n",fname2 ) ; exit(2) ; }
+      while ( fgets( inln2 , INLINELEN, CALLER ) != NULL ) {
+        get_token_n ( inln2, " ", 0, v0 ) ; remove_nl ( v0 ) ;
+        get_token_n ( inln2, " ", 1, v1 ) ; remove_nl ( v1 ) ;
+        if ( COMPARE2( v0, "sourcefile" ) ) { strcpy ( sf , v1 ) ; break ; }
+      }
+      fclose(CALLER) ;
+      for ( i = 0 ; i < indent * 3 ; i++ ) {
+        printf( "&nbsp " ) ;
+      }
+      switch_little_big_f( sf ) ;
+#if 0
+      printf("<a href=\"%s.html\">%s</a> (<a href=\"../../%s\">%s</a>)<br>\n", u0, u0, sf, sf )  ;
+#else
+      strcpy( u0_upper, u0 ) ; upper_case_str( u0_upper ) ;
+      printf("<a href=\"%s.html\">%s</a> (<a href=\"../../../wrfbrowser/html_code/%s.html#%s\">%s</a>)<br>\n", u0, u0, sf, u0_upper,sf )  ;
+#endif
+      /* RECURSION */
+      if ( ! COMPARE2( u0 , levels[ indent+1 ] ) ) {
+        strcpy( levels[ indent+1 ], u0 ) ;
+        subinfo_calls ( u0 , indent + 1 ) ;
+      }
+    }
+  }
+  fclose( CALLERS ) ;
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/sym.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/sym.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/sym.c	(revision 2744)
@@ -0,0 +1,161 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+/* sym.c
+
+    Implementation dependent routines for using symtab_gen.c
+    in N32 .
+
+*/
+
+#include <stdio.h>
+#include "sym.h"
+
+extern sym_nodeptr symget() ;
+
+static char ** symtab ;  /* 2-19-90 */
+
+int
+sym_init() /* 2-19-90, initialize symbol table package */
+{
+    create_ht( &symtab ) ;
+    if (symtab == NULL) 
+    {
+	fprintf(stderr,"init_sym(): could not create hash table") ;
+	exit(1) ;
+    }
+    return(0) ;
+}
+
+sym_nodeptr
+sym_add( name )
+char * name ;
+{
+    sym_nodeptr new_sym_node(); 
+    char **node_name() ;
+    sym_nodeptr *node_next() ;
+    return( symget( name, new_sym_node, node_name, node_next, symtab, 1 ) ) ;
+}
+
+sym_nodeptr
+sym_get( name )
+char * name ;
+{
+    sym_nodeptr new_sym_node(); 
+    char **node_name() ;
+    sym_nodeptr *node_next() ;
+    return( symget( name, new_sym_node, node_name, node_next, symtab, 0 ) ) ;
+}
+
+sym_nodeptr
+new_sym_node()
+{
+    void * malloc() ;
+    sym_nodeptr p ;
+    p = (sym_nodeptr) malloc( sizeof( struct sym_node ) ) ;
+    p->name = NULL ;
+    p->next = NULL ;
+
+    return( p ) ;
+}
+
+char **
+node_name(p)
+sym_nodeptr p ;
+{
+    char ** x ;
+    x = &(p->name) ;
+    return( x ) ;
+}
+
+sym_nodeptr *
+node_next(p)
+sym_nodeptr p ;
+{
+    sym_nodeptr *x ;
+    x = &(p->next) ;
+    return( x ) ;
+}
+
+int
+show_entry(x)
+sym_nodeptr x ;
+{
+  int i ;
+  if ( x == NULL ) return(0) ;
+  printf("Symbol table entry:\n") ;
+  printf("lexeme %s\n", x->name ) ;
+  printf("   dim %s\n", (x->dim==1?"M":(x->dim==2?"N":"O")) ) ;
+  printf(" ndims %d\n", x->ndims ) ;
+  for ( i = 0 ; i < x->ndims && i < 7 ; i++ )
+    printf(" dim %d -> %s\n",i,(x->dims[i]==1?"M":(x->dims[i]==2?"N":"O")) ) ;
+  return(0) ;
+}
+
+/* MEMORY LEAK !!!! -- this just abandons the old table and leaves on the heap. */
+/* The registry mechanism is not a long-running program and is not apt to 
+   run into memory problems.  Might want to fix this anyway, though, someday. */
+int
+sym_forget() 
+{
+  create_ht( &symtab ) ;
+  if (symtab == NULL)
+  {
+      fprintf(stderr,"init_sym(): could not create hash table") ;
+      exit(1) ;
+  }
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/sym.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/sym.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/sym.h	(revision 2744)
@@ -0,0 +1,91 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+#ifndef SYM_H
+#define SYM_H
+
+/* file: sym.h
+
+    Header info for symbol table module.
+
+*/
+
+typedef struct sym_node * sym_nodeptr ;
+
+struct sym_node
+{
+    char * name ;		/* lexeme */
+    sym_nodeptr next ;		/* pointer to next node in symbol table */
+/* fields that are associated with dimension declaration constants */
+    unsigned char dim ;
+/* fields that are associated with arrays */
+    int ndims ;
+    int MDEX ;		/* which index is the M dimension */
+    int NDEX ;		/* which index is the N dimension */
+    unsigned char dims[7] ;
+    char dimname[7][64] ;
+/* name of temporary variable associated with string. variable */
+    char varx[32] ;
+/* fields associated with integer scalar variables */
+    unsigned long assigned ; 	/* pointer to assignment statement */
+    unsigned long thisif ;
+    int iflev ;
+    int marked ;		/* general purpose marker */
+} ;
+
+sym_nodeptr sym_add() ;
+sym_nodeptr sym_get() ;
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/symtab_gen.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/symtab_gen.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/symtab_gen.c	(revision 2744)
@@ -0,0 +1,203 @@
+/*  symtab.c 
+
+Symbol Table Handler -- Generic
+
+The routine symget() returns a pointer to a C structure matching a
+given lexeme.  If the lexeme does not already exist in the symbol
+table, the routine will create a new symbol structure, store it, and
+then return a pointer to the newly created structure.
+
+It is up to the calling module to declare the symbol structure as
+well as several routines for manipulating the symbol structure.  The
+routines are passed to symget as pointers.
+
+	name	   type		description
+
+	newnode()   *char	returns a pointer to a symbol structure.
+
+	nodename()  **char	retrieves the lexeme name from a symbol
+				structure, returned as a pointer to a 
+				character array.
+	
+	nodenext()  **char	retrieves pointer to the next field of
+				the symbol structure (the next field
+				is itself a pointer to a symbol structure)
+
+For a sample main or calling program see the end of this file.
+
+****
+  REVISED 2-19-90.  Added code to make hashtable interchangible.
+	new routine: create_ht()	creates new hashtable
+	rev routine: symget()		added parameter to pass hash table
+*/
+
+#include <stdio.h>
+#include <string.h>
+#include <strings.h>
+
+#define HASHSIZE 1024
+
+/*  commented out 2-29-90
+static char * symtab[HASHSIZE] ;	
+*/
+
+void * malloc() ;
+void * calloc() ;
+
+char * symget(name,newnode,nodename,nodenext,symtab,flag)
+char *name ;
+char *(*newnode)(), **(*nodename)(), **(*nodenext)() ;
+char *symtab[] ;
+int flag ;		/* 1 is create if not there, 0 return NULL if not there */
+{
+    int index ; 
+    int found ;
+    register char *s ;
+    register char *t ;
+    char **x ;
+    char *p ;
+
+    index = hash( name ) ;
+    p = symtab[index] ;
+    found = 0 ;
+
+    while (p) {
+        s = name ;
+	t = *(*nodename)(p) ;
+	while (*s && *t && *s == *t ) {
+	    s++ ;
+	    t++ ;
+	}
+	if (!*s && !*t) {
+	    found = 1 ;
+	    break ;
+	}
+	p = *(*nodenext)(p) ;
+    }
+
+    if (!found ) {
+      if (flag ) {
+        p = (*newnode)() ;
+        x =  (*nodename)(p) ;
+        *x = (char *) malloc(strlen(name)+1) ;
+        strcpy(*x,name) ;
+        x =  (*nodenext)(p) ;
+        *x = symtab[index] ;
+        symtab[index] = p ;
+      } else {
+        return(NULL) ;
+      }
+    }
+
+    return(p) ;
+}
+
+hash(name)
+char * name ;
+{
+    register int result = 0  ;
+    register char * p = name ;
+
+    while (*p)
+	result = 3*result + (int)*p++ ;
+    
+    result = result % HASHSIZE ;
+    while (result < 0)
+	result = result + HASHSIZE ;
+    return(result) ;
+}
+
+
+/* added 2-19-90, attaches a new hash table to pointer  */
+
+int
+create_ht( p )
+char *** p ; 
+{
+    *p = (char **) calloc( HASHSIZE , sizeof( char * ) ) ;
+    return(0) ;
+}
+
+
+/* added 4-15-92.
+
+This is a generic routine that, given a hash table pointer,
+will traverse the hash table and apply a caller supplied
+function to each entry
+
+*/
+
+int
+sym_traverse( ht, nodenext, f )
+char *ht[] ;
+char **(*nodenext)() ;
+void (*f)() ;
+{
+    char * p, **x ;
+    int i ;
+    for ( i = 0 ; i < HASHSIZE ; i++ )
+    {
+	if ( ( p = ht[i] ) != NULL )
+	{
+	    while ( p )
+	    {
+		 (*f)(p) ;
+		 x = (*nodenext)(p) ;
+		 p = *x ;
+	    }
+	}
+    }
+    return(0) ;
+}
+
+/**********************************************************************/
+/**********************************************************************/
+/**********************************************************************/
+
+#ifdef COMMENTOUTSAMPLE
+/* sample_main.c
+
+    sample main program for symget() in the file symtab.c
+
+*/
+
+#include <stdio.h>
+
+struct symnode {
+    char * name ;
+    struct symnode *next ;
+} ;
+
+extern struct symnode * symget() ;
+
+struct symnode *
+newnode()
+{
+    struct symnode * malloc() ;
+    return( malloc( sizeof( struct symnode ) ) ) ;
+}
+
+char **
+nodename(p)
+struct symnode *p ;
+{
+    char ** x ;
+    x = &(p->name) ;
+    return( x ) ;
+}
+
+struct symnode **
+nodenext(p)
+struct symnode *p ;
+{
+    struct symnode **x ;
+    x = &(p->next) ;
+    return( x ) ;
+}
+
+#endif
+
+/**********************************************************************/
+/**********************************************************************/
+/**********************************************************************/
+
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/util.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/util.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/util.c	(revision 2744)
@@ -0,0 +1,275 @@
+#include <stdio.h>
+#include <string.h>
+
+#define INLINELEN (4*8192)
+
+/* if sf is a string that ends in .f, end in .F, or vice verrsa */
+
+int switch_little_big_f ( char s[] ) 
+{
+  int n ;
+  n = strlen(s) ;
+  if      ( !strcmp( &(s[n-2]) , ".f" ) ) { s[n-1] = 'F' ; }
+  else if ( !strcmp( &(s[n-2]) , ".F" ) ) { s[n-1] = 'f' ; }
+  return(0) ;
+}
+
+int contains_str( char *s1, char *s2 )
+{
+  int i ;
+  char *p, *q, *r ;
+  if ( s2 == NULL || s1 == NULL ) return ( 0 ) ;
+  if ( *s2 == '\0' || *s1 == '\0' ) return ( 0 ) ;
+  p = s1 ;
+  while ( *p ) {
+    if ((r = (char *)index( p , *s2 )) == NULL ) { return( 0 ) ; }
+    for ( q = s2 ; *q && *r == *q ; r++ , q++ )  ;
+    if ( *q == '\0' ) return (1) ;
+    p++ ;
+  }
+  return( 0 ) ;
+}
+
+int
+find_str( char *s1, char *s2, char **strp )
+{
+  int i ;
+  char *p, *q, *r ;
+  if ( s2 == NULL || s1 == NULL ) return ( 0 ) ;
+  if ( *s2 == '\0' || *s1 == '\0' ) return ( 0 ) ;
+  p = s1 ;
+  while ( *p ) {
+    *strp = NULL ;
+    if ((r = (char *)index( p , *s2 )) == NULL ) { return( 0 ) ; }
+    *strp = r ;
+    for ( q = s2 ; *q && *r == *q ; r++ , q++ )  ;
+    if ( *q == '\0' ) return (1) ;
+    p++ ;
+  }
+  return( 0 ) ;
+}
+
+
+int contains_tok( char *s1, char *s2, char *delims )
+{
+  char *p ;
+  char tempstr[INLINELEN] ;
+  int i ;
+
+  strcpy( tempstr , s1 ) ;
+  p = strtok ( tempstr, delims ) ;
+  i = 0 ;
+  while ( p != NULL )
+  {
+    if ( !strcmp ( p , s2 ) ) {  return(i) ;}
+    i++ ;
+    p = strtok( NULL, delims ) ;
+  }
+  return(0) ;
+}
+
+int
+get_token_n ( char *s1, char *delims , int n, char* retval )
+{
+  char *p ;
+  int i ;
+  static char tempstr[INLINELEN] ;
+  strcpy( tempstr , s1 ) ;
+  p = strtok ( tempstr, delims ) ;
+  i = 0 ;
+  while ( p != NULL )
+  {
+    if ( i == n ) { strcpy( retval, p ) ; return( 1 ) ; }
+    p = strtok( NULL, delims ) ;
+    i++ ;
+  }
+  return( 0 ) ;
+}
+
+int
+get_arg_n ( char *s1, int n, char *retval )
+{
+  char *p, *q ;
+  int i, arg, inquote = -1, inparen = -1 ;
+  static char tempstr[INLINELEN] ;
+  char quotes[INLINELEN] ;
+  char parens[INLINELEN] ;
+  strcpy( tempstr , s1 ) ;
+  strcpy( retval, "" ) ;
+
+  if ( (p = index(tempstr, '(')) == NULL ) return(0) ;
+  p++ ;
+  arg = 0 ;
+  while ( *p && arg < n+1 ) {
+    q = p ;
+    inquote = -1 ;
+    for ( ; *p ; p++ )
+    {
+      if ( *p == '\'' || *p == '"' ) {
+        if ( inquote >= 0 ) {
+          if ( quotes[inquote] == *p ) {
+            inquote-- ;
+          } else {
+            inquote++ ;
+            quotes[inquote] = *p ;
+          }
+        } else {
+          inquote++ ;
+          quotes[inquote] = *p ;
+        }
+      }
+      if ( inquote < 0 ) {
+        if ( *p == '(' ) inparen++ ;
+        if ( *p == ')' ) {
+          if  ( inparen >= 0 ) { inparen-- ; }
+          else                 { *p = '\0' ; arg++ ; break ;}
+        }
+      }
+      if ( inquote < 0 && inparen < 0 ) {
+        if ( *p == ',' ) { arg++ ; *p = '\0' ; p++ ; break ; }
+      }
+    }
+  }
+  if ( arg == n+1 ) {
+    for ( ; *q ; q++ ) { if ( *q != ' ' && *q != '\t' ) break ; }
+    strcpy( retval, q ) ;
+    return (1) ;
+  } else {
+    strcpy( retval, "" ) ;
+    return(0) ;
+  }
+}
+
+int
+empty ( char *s )
+{
+  char *p ;
+  for ( p = s ; *p ; p++ )
+  {
+    if ( ! ( *p == ' ' || *p == '\t' || *p == '\n' ) ) return( 0 ) ;
+  }
+  return( 1 ) ;
+}
+
+remove_nl ( char *s )
+{
+  char *p ;
+  if (( p = index( s , '\n' )) != NULL ) *p = '\0' ; 
+}
+
+
+remove_comments ( char *s )
+{
+  int inquote = -1 ;
+  char quotes[INLINELEN] ;
+  char *p ;
+  for ( p = s ; *p ; p++ )
+  {
+    if ( *p == '\'' || *p == '"' ) { 
+      if ( inquote >= 0 ) { 
+        if ( quotes[inquote] == *p ) {
+          inquote-- ;
+        } else {
+          inquote++ ; 
+          quotes[inquote] = *p ;
+        }
+      } else {
+        inquote++ ; 
+        quotes[inquote] = *p ;
+      }
+    }
+    if ( inquote < 0 ) {
+      if ( *p == '!' ) { *p = '\0' ; break ; }
+    }
+  }
+}
+
+int
+remove_chars ( char *s, char *r, char replace )
+{
+  int inquote = -1 ;
+  int retval = 0 ;
+  char quotes[INLINELEN] ;
+  char *p, *q ;
+  for ( p = s ; *p ; p++ )
+  {
+    if ( *p == '\'' || *p == '"' ) {
+      if ( inquote >= 0 ) {
+        if ( quotes[inquote] == *p ) {
+          inquote-- ;
+        } else {
+          inquote++ ;
+          quotes[inquote] = *p ;
+        }
+      } else {
+        inquote++ ;
+        quotes[inquote] = *p ;
+      }
+    }
+    if ( inquote < 0 ) {
+      for ( q = r ; *q ; q++ ) {
+        if ( *p == *q ) { *p = replace ; retval = 1 ; }
+      }
+    }
+  }
+  return(retval) ;
+}
+
+int
+remove_whitespace ( char *s )
+{
+  char *p, *q ;
+  for ( p = s, q = s ; *p ; p++ )
+  {
+    if ( ! (*p == ' ' || *p == '\t') ) {
+      *q++ = *p ;
+    }
+  }
+  *q = '\0' ;
+  return(0) ;
+}
+
+
+int
+iswhite( char *s )
+{
+  char *p ; 
+  for ( p = s ; *p ; p++ ) if ( *p != ' ' && *p != '\t' ) return(0) ;
+  return(1) ;
+}
+
+int
+remove_ampersands ( char *s )
+{
+  char * p, * q ; 
+  int retval ;
+  if (( p = rindex ( s, '&' )) != NULL )
+  {
+    if ( iswhite( p+1 ) ) retval = 1 ;
+    else                retval = 0 ;
+  }
+  else
+  {
+    retval = 0 ;
+  }
+  remove_chars ( s , "&", ' ' ) ;
+  return(retval) ;
+}
+
+lower_case_str ( char *s ) 
+{
+  char * p ;
+  for ( p = s ; *p ; p++ )
+  {
+    if ( *p >= 'A' && *p <= 'Z' ) *p = *p - 'A' + 'a' ;
+  }
+}
+
+upper_case_str ( char *s ) 
+{
+  char * p ;
+  for ( p = s ; *p ; p++ )
+  {
+    if ( *p >= 'a' && *p <= 'z' ) *p = *p - 'a' + 'A' ;
+  }
+}
Index: trunk/WRF.COMMON/WRFV2/tools/CodeBase/wrfvar.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/CodeBase/wrfvar.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/CodeBase/wrfvar.c	(revision 2744)
@@ -0,0 +1,532 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <dirent.h>
+#include <sys/wait.h>
+#include <string.h>
+
+#define COMPARE(A,B) ( ! strncmp ( A , B , strlen( B ) ) )
+#define COMPARE2(A,B) ( ! strcmp ( A , B ) )
+#define INLINELEN (4*8192)
+#define VARLEN 128
+#define MAXARGS (4*8192)
+
+
+#define DBDIR "tools/code_dbase"
+
+int sw_all  = 0 ;
+
+
+main( int argc, char *argv[] )
+{
+  FILE *fp ;
+  FILE *calls ; 
+  char fname[VARLEN], syscom[VARLEN] ;
+  char *rout , *vname ;
+  if ( argc < 2 || argc > 5 || ( argc == 2 && ! COMPARE2( argv[1] , "rebuild" ) ) ) {
+    printf("usage : wrfvar varname routinename\n" ) ;
+    printf("        wrfvar rebuild\n" ) ;
+    exit(2) ;
+  }
+  vname = argv[1] ;
+  rout = argv[2] ;
+  if ( argc == 4 && argv[3] != NULL ) {
+    if ( COMPARE2( argv[3] , "all" ) ) sw_all = 1 ;
+  }
+  sprintf( fname, "%s/calls", DBDIR ) ;
+  if (( fp = fopen ( fname , "r" )) == NULL || COMPARE2( argv[1], "rebuild" ) ) {
+    int rc ;
+    printf("Building code database ... please wait\n") ;
+    sprintf( syscom, "cd tools/CodeBase ; make" ) ;
+    rc = system( syscom ) ;
+    if ( WEXITSTATUS( rc ) ) { exit(3) ; }
+    sprintf( syscom, "tools/build_codebase" ) ;
+    rc = system( syscom ) ;
+    if ( WEXITSTATUS( rc ) ) { exit(3) ; }
+    sprintf( syscom, "ln -sf tools/wrfvar ." ) ;
+    sprintf( syscom, "ln -sf tools/subinfo ." ) ;
+    if ( COMPARE2( argv[1] , "rebuild" ) ) exit ;
+  }
+  fclose( fp ) ;
+  lower_case_str ( vname ) ;
+  lower_case_str ( rout ) ;
+  printf("<h4>Trace upwards through call tree for %s</h4><p>\n",vname ) ;
+  wrfvar ( vname, rout, 0 ) ;
+}
+
+wrfvar ( char * vname, char *rout, int recursion_level )
+{
+  FILE *ROUT ;
+  FILE *BBB ;
+  FILE *ELEF ;
+  FILE *CALLER ;
+  FILE *CALLERS ;
+  FILE *REGISTRY ;
+  DIR  *dir ;
+  char inln[INLINELEN], inln2[INLINELEN], inln3[INLINELEN] ;
+  int i ;
+  char fname[VARLEN], fname2[VARLEN], sf[VARLEN] ;
+  char vv[VARLEN], vv2[VARLEN] ;
+  char u0[VARLEN] , u1[VARLEN] , u2[VARLEN] ;
+  char v0[VARLEN] , v1[VARLEN] , v2[VARLEN] ;
+  char r[12][VARLEN], t[12][VARLEN], u[12][VARLEN], v[12][VARLEN] ;
+  char routfile[VARLEN] ;
+  char tmp[VARLEN], darg[VARLEN], dintent[VARLEN] ;
+  char hamuna[VARLEN] ;
+  char rout1[VARLEN], rout2[VARLEN], rout3[VARLEN] ;
+  char sourcefile[VARLEN], sourcefile_caller[VARLEN] ;
+  char s1[VARLEN], s2[VARLEN], s3[VARLEN] ;
+  char * p, * q, * q1, prev ;
+  int found_var, nargs_rout, argn, callno, more_calls, first_time ;
+  int contains_i1_declarations ;
+
+  if (( dir = opendir ( DBDIR )) == NULL ) {
+    fprintf(stderr, "Must be in top level WRF directory\n") ; exit(2) ;
+  } closedir( dir ) ;
+
+  strcpy( rout1, rout ) ;
+  strcpy( vv, vname ) ;
+  strcpy( vv2, vname ) ;
+  remove_whitespace( vv2 ) ;
+  /* remove arguments */
+  if ((q = strchr( vv2 , '(' )) != NULL ) *q = '\0' ;
+  /* remove time level if there */
+  if (( q = strrchr( vv2, '_' )) != NULL ) {
+    if ( COMPARE2( q , "_1" ) || COMPARE2( q , "_2" ) || COMPARE2( q , "_3" ) ) *q = '\0' ;
+  }
+  if ( COMPARE( vv2, "grid%" ) || !strcmp( rout, "registry_i1" )) {
+    if (( REGISTRY = fopen( "Registry/Registry" , "r" )) == NULL ) {
+          fprintf(stderr,"can not open Registry/Registry\n") ; exit(2) ; }
+    strcpy( inln, "" ) ;
+    while ( fgets( inln2, INLINELEN, REGISTRY ) != NULL ) {
+      int inquote ;
+      strcat( inln, inln2 ) ;
+      if (( q = strrchr ( inln, '\\' )) != NULL ) {   /* continuation */
+        *q = '\0' ; continue ; 
+      }
+      if (( q = strchr( inln, '#' )) != NULL ) *q = '\0' ;
+      inquote = 0 ;
+      for ( p = inln, q = inln2 ; *p ; p++, q++ ) {
+        if      ( ! inquote && *p == '"' ) { inquote = 1 ; *p = ' ' ; }
+        else if (   inquote && *p == '"' ) { inquote = 0 ; *p = ' ' ; }
+        if ( *p == ' ' && inquote ) { *q = '`' ; }
+        else                        { *q = *p ; }
+      }
+      *q = '\0' ;
+      for ( i = 0 ; i < 11 ; i++ ) {
+        strcpy( r[i] , "" ) ;
+        get_token_n( inln2, " ", i , r[i] ) ; remove_nl(r[i]) ; 
+        if ( i < 10 ) lower_case_str( r[i] ) ;
+      }
+      if ( COMPARE2 ( r[0], "state" ) ) {
+        if ( COMPARE ( r[4], "dyn_" ) ) {
+          /* if core associated */
+          sprintf(s1,"%s_",&(r[4][4])) ;
+          i = strlen(&(r[4][4])) ;
+#if 1
+          { char *x , *y ; int j ; 
+            for ( x = vv2+5 , y = s3 , j = 0 ; j < i ; j++ ) { *y++ = *x++ ; }
+            *y = '\0' ;
+          }
+#else
+/* is there a bug in this?? */
+          strncpy( s3, vv2+5, i ) ;
+fprintf(stderr,"X %s <- %s %d\n", s3, vv2, i ) ;
+#endif
+          sprintf(s2,"%s_",s3) ;
+          if ( COMPARE2 ( s1, s2 )  &&
+                COMPARE2 ( vv2+5+(strlen(r[4])-3), r[2] ) ) {
+            for (p = r[9]  ; *p ; p++ ) { if ( *p == '`' ) *p = ' ' ; }
+            for (p = r[10] ; *p ; p++ ) { if ( *p == '`' ) *p = ' ' ; }
+            printf("%3d. <b>Registry-defined</b>: <class> %s <type> %s <varname> %s <description> \"%s\" <units> \"%s\"<br>\n",
+                   recursion_level+1, r[0], r[1], r[2], r[9], r[10] ) ;
+          }
+        } else {
+          /* if not core associated */
+          if ( COMPARE2 ( vv2+5, r[2] ) ) {
+            for (p = r[9]  ; *p ; p++ ) { if ( *p == '`' ) *p = ' ' ; }
+            for (p = r[10] ; *p ; p++ ) { if ( *p == '`' ) *p = ' ' ; }
+            printf("%3d. <b>Registry-defined</b>: <class> %s <type> %s <varname> %s <description> \"%s\" <units> \"%s\"<br>\n",
+                   recursion_level+1, r[0], r[1], r[2], r[9], r[10] ) ;
+          }
+        }
+      } else if ( COMPARE2 ( r[0], "rconfig" ) ) {
+          if ( COMPARE2 ( vv2+5, r[2] ) ) {
+            for (p = r[8]  ; *p ; p++ ) { if ( *p == '`' ) *p = ' ' ; }
+            printf("%3d. <b>Registry-defined</b>: <class> %s <type> %s <varname> %s <description> \"%s\" <br>\n",
+                   recursion_level+1, r[0], r[1], r[2], r[8] ) ;
+          }
+      } else if ( COMPARE2 ( r[0], "i1" ) && !strcmp( rout, "registry_i1" )) {
+          if ( COMPARE2 ( vv2, r[2] ) ) {
+            for (p = r[9]  ; *p ; p++ ) { if ( *p == '`' ) *p = ' ' ; }
+            for (p = r[10] ; *p ; p++ ) { if ( *p == '`' ) *p = ' ' ; }
+            printf("%3d. <b>Registry-defined</b>: <class> %s <type> %s <varname> %s <description> \"%s\" <units> \"%s\"<br>\n",
+                   recursion_level+1, r[0], r[1], r[2], r[9], r[10] ) ;
+          }
+      }
+
+      strcpy( inln, "" ) ;
+    }
+    fclose( REGISTRY ) ;
+    return ;
+  }
+
+  sprintf( routfile, "%s/%s", DBDIR, rout ) ;
+  strcpy ( sourcefile , "" ) ;
+  found_var = 0 ;
+  nargs_rout = 0 ;
+  if (( ROUT = fopen( routfile, "r" )) == NULL ) return ;
+  {
+    contains_i1_declarations = 0 ;
+    while ( fgets( inln, INLINELEN, ROUT ) != NULL ) {
+      remove_nl ( inln ) ;
+      /* find first non space */
+      for ( p = inln ; *p ; p++ ) { if ( *p != ' ' ) break ; }
+      /* change multiple spaces to single space */
+      for ( q = p, q1 = q , prev = *p ; *q ; q++ ) 
+	 { if ( prev == ' ' && *q == ' ' ) { continue ; } else { prev = *q ; *q1++ = *q ; } }
+      strcpy( inln, p ) ;
+      for ( i = 0 ; i < 11 ; i++ ) {
+        strcpy( t[i] , "" ) ;
+        get_token_n( inln, " ", i , t[i] ) ; remove_nl(t[i]) ; lower_case_str( t[i] ) ;
+      }
+      if ( COMPARE2( "contains_i1_declarations", t[0] ) ) {
+        contains_i1_declarations = 1 ;
+      } else if ( COMPARE2( "sourcefile" , t[0] ) ) {
+	strcpy ( sourcefile , t[1] ) ;
+      } else if ( COMPARE2( "arg" , t[0] ) ) {
+	nargs_rout ++ ;
+	if ( COMPARE2( t[3] , vname ) && ! COMPARE2( t[9] , "registry" ) ) {
+	  argn = atoi( t[1] ) ;
+	  printf("%3d. <b>%s</b> is dummy arg %d of %s (%s);\n", recursion_level+1, vname, argn+1, rout, sourcefile ) ;
+	  found_var = 1 ;
+	  fclose( ROUT ) ;
+	  sprintf(fname,"%s/calls", DBDIR ) ;
+	  strcpy( rout2, rout ) ;
+	  if (( CALLERS = fopen( fname , "r" )) == NULL ) return ;
+          while ( fgets( inln2, INLINELEN, CALLERS ) != NULL ) {
+            for ( i = 0 ; i < 11 ; i++ ) {
+              strcpy( u[i] , "" ) ;
+              get_token_n( inln2, " ", i , u[i] ) ; remove_nl(u[i]) ; lower_case_str( u[i] ) ;
+            }
+	    if ( COMPARE2( u[2], rout2 ) ) {
+	      strcpy( rout , u[0] ) ;
+	      sprintf( fname, "%s/%s", DBDIR, rout ) ;
+	      if (( ROUT = fopen( fname, "r" )) == NULL ) return ;
+  	      strcpy ( sourcefile_caller, "" ) ;
+	      callno = 1 ;
+              more_calls = 0 ;
+	      while ( fgets( inln3, INLINELEN, ROUT ) != NULL ) {
+                for ( i = 0 ; i < 11 ; i++ ) {
+                  strcpy( v[i] , "" ) ;
+                  get_token_n( inln3, " ", i , v[i] ) ; remove_nl(v[i]) ; lower_case_str( v[i] ) ;
+                }
+		if        ( COMPARE2( v[0] , "sourcefile" ) ) {
+		  strcpy( sourcefile_caller, v[1] ) ;
+		} else if ( COMPARE2( v[0] , "actarg") && ( COMPARE2( v[4] , rout2 ) && atoi( v[1] ) == argn )) {
+                  if ( callno == 1 || sw_all ) {
+		    printf("     corresponding actual arg is <b>%s</b>, arg number %d in call %d by %s (%s).<br>\n",
+                              v[6],argn,callno,rout2,sourcefile_caller) ;
+		     /* RECURSION */
+		    wrfvar ( v[6], rout, recursion_level+1 ) ;
+                  } else if ( callno >= 2 ) {
+                    more_calls = callno ;
+                  }
+		  callno++ ;
+		}
+	      }
+	      fclose( ROUT ) ;
+              if ( more_calls > 1 && recursion_level == 0 ) {
+                printf("  there are %d more calls to %s from %s.  Try 'wrfvar %s %s all' to see all.\n", more_calls, rout2, rout, vname, rout2 ) ;
+              }
+	    }
+	  }
+	  fclose( CALLERS ) ;
+	} else if ( COMPARE2( t[3] , vname ) && COMPARE2( t[9] , "registry" ) ) {
+	  /* RECURSION */
+          sprintf(tmp, "grid%%s", vname ) ;
+	  wrfvar ( vname, "registry", recursion_level+1 ) ;
+	  found_var = 1 ;
+	}
+      }
+    }
+  }
+  if ( found_var == 0 ) {
+    if ( contains_i1_declarations ) {
+      /* take a look in the registry for i1 vars that might match */
+      wrfvar ( vname, "registry_i1", recursion_level ) ;  /* recursion level does not increase here, since we're checking the registry */
+    } else {
+      printf("%s is not an argument to %s. May be local or use-associated.\n",vname,rout1 ) ;
+      printf("%s has %d arguments\n",rout1,nargs_rout) ;
+      fclose(ROUT) ;
+      if (( ROUT = fopen( routfile , "r" )) == NULL ) return ;
+      while ( fgets( inln2, INLINELEN, ROUT ) != NULL ) {
+        remove_nl( inln2 ) ;
+        /* find first non space */
+        for ( p = inln2 ; *p ; p++ ) { if ( *p != ' ' ) break ; }
+        /* change multiple spaces to single space */
+        for ( q = p, q1 = q , prev = *p ; *q ; q++ ) { if ( prev == ' ' && *q == ' ' ) { continue ; } else { prev = *q ; *q1++ = *q ; } }
+        for ( i = 0 ; i < 11 ; i++ ) {
+          strcpy( r[i] , "" ) ;
+          get_token_n( inln2, " ", i , r[i] ) ; remove_nl(r[i]) ; lower_case_str( r[i] ) ;
+        }
+        if ( COMPARE2( r[0] , "arg" ) ) {
+	  i = atoi(r[1]) + 1 ;
+	  printf("%3d. ",i) ; 
+	  printf("%s of type %s intent %s\n",r[3],r[5],r[7]) ;
+        }
+      }
+    fclose( ROUT ) ;
+    }
+  }
+
+/* get a list of the routines this guy calls */
+
+  if ( recursion_level == 0 ) {
+    first_time = 1 ;
+    if (( BBB = fopen( routfile, "r" )) == NULL ) return ;
+    while ( fgets( inln2, INLINELEN, BBB ) != NULL ) {
+      remove_nl( inln2 ) ;
+      /* find first non space */
+      for ( p = inln2 ; *p ; p++ ) { if ( *p != ' ' ) break ; }
+      /* change multiple spaces to single space */
+      for ( q = p, q1 = q , prev = *p ; *q ; q++ ) 
+	   { if ( prev == ' ' && *q == ' ' ) { continue ; } else { prev = *q ; *q1++ = *q ; } }
+      for ( i = 0 ; i < 11 ; i++ ) {
+        strcpy( t[i] , "" ) ;
+        get_token_n( inln2, " ", i , t[i] ) ; remove_nl(t[i]) ; lower_case_str( t[i] ) ;
+      }
+      if        ( COMPARE2( t[0] , rout1 ) && COMPARE2( t[1] , "calls" ) ) {
+	strcpy( hamuna , t[2] ) ;
+      } else if ( COMPARE2( t[0] , "actarg" ) && COMPARE2( t[6] , vname ) ) {
+	if ( first_time ) {
+	  printf("\n<h4>%s is an actual arg in calls to these routines from %s</h4>\n",vname,rout1) ;
+	  first_time = 0 ;
+	}
+	sprintf(fname,"%s/%s",DBDIR,hamuna) ;
+	if (( ELEF = fopen ( fname , "r" )) == NULL ) continue ;
+	while ( fgets( inln3, INLINELEN, ELEF ) != NULL ) {
+          remove_nl( inln3 ) ;
+          /* find first non space */
+          for ( p = inln3 ; *p ; p++ ) { if ( *p != ' ' ) break ; }
+          /* change multiple spaces to single space */
+          for ( q = p, q1 = q , prev = *p ; *q ; q++ ) 
+	     { if ( prev == ' ' && *q == ' ' ) { continue ; } else { prev = *q ; *q1++ = *q ; } }
+          for ( i = 0 ; i < 11 ; i++ ) {
+            strcpy( u[i] , "" ) ;
+            get_token_n( inln3, " ", i , u[i] ) ; remove_nl(u[i]) ; lower_case_str( u[i] ) ;
+          }
+	  if ( COMPARE2( u[0] , "arg" ) && COMPARE2( u[1] , t[1] ) ) {
+	    strcpy( darg , u[3] ) ;
+	    strcpy( dintent , u[7] ) ;
+	    break ;
+	  }
+	}
+	fclose( ELEF ) ;
+	printf("  %s (argument %d ; matching dummy arg is %s with intent %s)\n",hamuna,atoi(t[1])+1,darg,dintent ) ;
+      }
+    }
+    printf("\n") ;
+    fclose(BBB) ;
+  }
+}
+
+
+
+#if 0
+#!/bin/perl
+
+$dbdir = "tools/code_dbase" ;
+
+if ( ! opendir( TOOLDIR, "tools") )  {
+print "\nMust be in top level WRF directory\n" ;
+exit ;
+}
+closedir TOOLDIR ;
+
+if ( (scalar @ARGV  < 1 || scalar @ARGV > 3)  || (scalar @ARGV == 1 && @ARGV[0] ne "rebuild") )  {
+print "usage: wrfvar varname routinename \n" ;
+print "       wrfvar rebuild \n" ;
+exit ;
+}
+
+
+if ( ! open( XXX, "$dbdir/calls" ) || $ARGV[0] eq "rebuild" )
+{
+  print "Building code database ... please wait.\n" ;
+  system( "cd tools/CodeBase ; make" ) ;
+  $rc = system( "tools/build_codebase" ) ;
+
+  if ( ($rc >> 8) == 99 ) { exit ; }
+  system( "ln -sf tools/wrfvar ." ) ;
+  system( "ln -sf tools/subinfo ." ) ;
+
+  if ( $ARGV[0] eq "rebuild" ) { exit ; }
+}
+
+
+$vname = lc $ARGV[0] ;
+$vname1 = $vname ;
+$rout1 = lc $ARGV[1] ;
+$recursion_level = $ARGV[2] ;
+$rout = $rout1 ;
+#print $vname,"\n" ;
+#print $rout,"\n" ;
+
+$spc = "`" ;
+$vv = $vname ;
+$vv =~ s/\(.*// ;
+#print $vv,"\n" ;
+if ( substr($vv,0,5)  eq "grid%" ) {
+    open REGISTRY, "< Registry/Registry" or die "cannot open Registry/Registry" ;
+    while ( <REGISTRY> ) {
+
+      $line = $_ ;
+      $line =~ s/#.*// ;
+      next if ( $line eq "" ) ;
+      $line =~ s/[ \t][ \t]*/ /g ;
+      $line = lc $line ;
+      # fill in the blanks in quote delimited strings then remove 
+      # the quotes so we can split on white space
+      
+      $inquote = 0 ;
+      $newline = "" ;
+      for ( $i = 0 ; $i < length($line) ; $i++ )
+      {
+        $ccc = substr($line,$i,1) ;
+        if    ( ! $inquote && $ccc eq '"' ) { $inquote = 1 ; }
+        elsif (   $inquote && $ccc eq '"' ) { $inquote = 0 ; }
+        if ( $ccc eq " " && $inquote ) { $newline = $newline.$spc ; }
+        else                           { $newline = $newline.$ccc ; }
+      }
+      $line = $newline ;
+      $line =~ s/\"//g ;
+
+      @r = split ( ' ',$line ) ;
+      if ( ($r[0] eq state ) ) {
+        if (( substr($r[4],0,4) eq "dyn_" && 
+              substr($r[4],4,length($r[4])-4)."_" eq substr($vv,5,length($r[4])-4)."_" &&
+              substr($vv,5+length($r[4])-4+1,length($r[2]))) eq $r[2] ) {
+
+          $r[9] =~ s/`/ /g ;
+          $r[9] = uc $r[9] ;
+          $r[10] =~ s/`/ /g ;
+          $r[10] = uc $r[10] ;
+	  print "**  Registry Definition: <class> $r[0] <type> $r[1] <varname> ", uc $r[2]," <decription> \"$r[9]\" <units> \"$r[10]\"\n"
+	}
+      }
+    }
+    close REGISTRY ;
+    exit ;
+}
+
+$routfile = $dbdir."/".$rout ;
+open ROUT, "< $routfile" or die "can not open $routfile" ;
+
+$sourcefile = "" ;
+$found_var = 0 ;
+$nargs_rout = 0 ;
+while ( <ROUT> )
+{
+  s/^  *// ;
+  s/  */ /g ;
+  @t = split ' ' ;
+  if ( $t[0] eq "sourcefile" ) {
+    $sourcefile = $t[1] ;
+  } elsif ( $t[0] eq "arg" ) {
+    $nargs_rout++ ;
+    if ( $t[3] eq $vname && $t[9] ne "registry" ) {
+      $argn = $t[1] ;
+      print "  ",uc $vname," is dummy argument $argn of $rout ($sourcefile)\n"  ;
+      $found_var = 1 ;
+      close ROUT ;
+      system( "sort -u $dbdir/calls > /tmp/wrfvar-sort ; /bin/mv /tmp/wrfvar-sort $dbdir/calls" ) ;
+      open CALLERS, "< $dbdir/calls" ;
+      $rout2 = $rout ;
+      while ( <CALLERS> ) {
+        @u = split ' ' ;
+        if ( $u[2] eq $rout2 )
+        {
+	  $rout = $u[0] ;
+          $routfile = $dbdir."/".$rout ;
+ 	  open ROUT, "< $routfile" or die "can not open $routfile" ;
+          $sourcefile_caller = "" ;
+          $callno = 1 ;
+	  while ( <ROUT> ) {
+            @v = split ' ' ;
+            if ( $v[0] eq "sourcefile" ) {
+              $sourcefile_caller = $v[1] ;
+            } elsif ( $v[0] eq 'actarg' && $v[4] eq $rout2 && $v[1] eq $argn ) {
+ 	      print ucfirst $rout2," call $callno by $rout ($sourcefile_caller) with actual argument $argn: ",uc $v[6],"\n" ;
+              $callno++ ;
+	      $vname = $v[6] ;
+              ############## RECURSION ##############
+              @sysargs = ( "tools/wrfvar" , $v[6], $rout, $recursion_level+1 )  ;
+              system( @sysargs ) ; 
+	    }
+          }
+          close ( ROUT ) ;
+        }
+      }
+      close ( CALLERS ) ;
+    } elsif ( $t[3] eq $vname && $t[9] eq "registry" ) {
+      @sysargs = ( "tools/wrfvar" , "grid%".$vname, "registry", $recursion_level+1 ) ;
+      ############## RECURSION ##############
+      system( @sysargs ) ; 
+      $found_var = 1 ;
+    }
+  }
+}
+
+if ( $found_var == 0 ) {
+  print uc $vname , " is not an argument to ${rout1}.  May be local or use-associated.\n" ;
+  print ucfirst $rout1," has $nargs_rout arguments.\n" ;
+  close ROUT ;
+  open ROUT, "< $routfile" or die "can not open $routfile" ;
+  while ( <ROUT> )
+  {
+    s/^  *// ;
+    s/  */ /g ;
+    @t = split ' ' ;
+    if ( $t[0] eq "arg" ) {
+      $i = $t[1] + 1 ;
+      printf("%3d. ",$i) ;
+      print uc $t[3]," of type ", uc $t[5],", intent ",uc $t[7],"\n" ;
+    }
+  }
+  close ROUT ;
+}
+
+# get a list of the routines this guy calls 
+
+if ( $recursion_level == 0 ) {
+$first_time = 1 ;
+open BBB, "< $dbdir/$rout1" or die " cannot open $dbdir/$rout1" ;
+while ( <BBB> ) {
+  @t = split ' ' ;
+  if      ( $t[0] eq "$rout1" && $t[1] eq calls ) {
+     $hamuna = $t[2] ;
+  } elsif ( $t[0] eq "actarg" && $t[6] eq $vname1 ) {
+     if ( $first_time == 1 ) {
+       print "\n",uc $vname1," is an actual argument in calls to these routines from ",uc $rout1," :\n" ;
+       $first_time = 0 ;
+     }
+     open ELEF,"< $dbdir/$hamuna" or die "cannot open $dbdir/$hamuna"  ;
+     while ( <ELEF> ) {
+       @u = split ' ' ;
+       if ( $u[0] eq arg && $u[1] eq $t[1] ) {
+	  $darg = $u[3] ;
+	  $dintent = $u[7] ;
+       }
+     }
+     close ELEF ;
+     print "  ", $hamuna," (argument ",$t[1]+1," ; matching dummy arg is ",uc $darg," with intent ",uc $dintent,") \n" ;
+  }
+}
+print "\n" ;
+close BBB ;
+}
+exit ;
+
+#endif
+
Index: trunk/WRF.COMMON/WRFV2/tools/DOMAIN_TIME_TEST/DOMAIN_TIME_TEST.csh
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/DOMAIN_TIME_TEST/DOMAIN_TIME_TEST.csh	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/DOMAIN_TIME_TEST/DOMAIN_TIME_TEST.csh	(revision 2744)
@@ -0,0 +1,89 @@
+#!/bin/csh
+#
+#  DOMAIN_TIME_TEST.csh wrf_ascii_output test_case
+#
+#  Extract domain self-test results from WRF ASCII output file 
+#  "wrf_ascii_output" and compare with known-good results, echoing 
+#  "PASS" iff results match.  Note that these tests are normally turned off 
+#  but may be enabled by setting namelist variable self_test_domain to .true. 
+#  in namelist /time_control/ .  This script looks in the directory in which 
+#  it resides to locate files that contain known-good test output.  Second 
+#  argument "test_case" is used to determine which known-good file to compare 
+#  against via the naming convention:  
+#    DOMAIN_TIME_TEST.${test_case}.correct
+#
+#  If the test passes, the following string is echoed by itself:  
+#    "PASS   DOMAIN_TIME_TEST.csh $test_case"
+#
+#  If the test fails, the following string is echoed along with other 
+#  diagnostics:  
+#    "FAIL   DOMAIN_TIME_TEST.csh $test_case"
+#
+#  In the event of an error (file not found, etc.) the following string is 
+#  echoed along with other diagnostics:
+#    "ERROR  DOMAIN_TIME_TEST.csh $test_case"
+#  Note that in this case, $test_case is left off if not specified as an 
+#  argument.  
+#
+#  This script must be run using a fully-qualified path as it deduces the 
+#  location of correct test results from this path.  
+#
+#  EXAMPLE (running from test/em_real):
+#   >> ../../tools/DOMAIN_TIME_TEST/DOMAIN_TIME_TEST.csh rsl.out.0000 jan00_12hr
+#   PASS   DOMAIN_TIME_TEST.csh jan00_12hr
+#
+#
+#  AUTHOR:
+#    Tom Henderson    NCAR/MMM
+#
+#  DATE:
+#    20060316
+#
+
+set selflong = $0
+set self = $selflong:t
+set scriptdir = $selflong:h
+
+if ( $#argv != 2 ) then
+  echo "ERROR  ${self}"
+  echo "ERROR:  Must specify a WRF ASCII output file as first argument and "
+  echo "ERROR:  name of test case as second argument."
+  echo "USAGE:  ${self} wrf_ascii_output test_case"
+  echo "EXAMPLE:  ${selflong} rsl.out.0000 jan00_12hr"
+  exit 10
+endif
+
+set ascii_file = $1
+set test_case = $2
+set pid = $$
+set correct_file = "${scriptdir}/DOMAIN_TIME_TEST.${test_case}.correct"
+set tmp_file = "DOMAIN_TIME_TEST.${test_case}.${pid}.tmp"
+
+if ( ! -f $ascii_file ) then
+  echo "ERROR  ${self} ${test_case}"
+  echo "ERROR:  could not find WRF ASCII output file ${ascii_file}"
+  exit 20
+endif
+if ( ! -f $correct_file ) then
+  echo "ERROR  ${self} ${test_case}"
+  echo "ERROR:  could not find correct test results file ${correct_file}"
+  exit 30
+endif
+
+\rm -f ${tmp_file}
+grep DOMAIN_TIME_TEST $ascii_file >! ${tmp_file} || echo "ERROR  ${self} ${test_case}:  could not grep file ${ascii_file}" && exit 40
+
+if ( ! `diff ${correct_file} ${tmp_file} | wc -c` ) then
+  echo "PASS   ${self} ${test_case}"
+  \rm -f ${tmp_file}
+else
+  echo "FAIL   ${self} ${test_case}"
+  echo "FAIL:  Differences follow:"
+  echo "diff ${correct_file} ${tmp_file}"
+  diff ${correct_file} ${tmp_file}
+  \rm -f ${tmp_file}
+  exit 50
+endif
+
+exit 0
+
Index: trunk/WRF.COMMON/WRFV2/tools/DOMAIN_TIME_TEST/DOMAIN_TIME_TEST.jan00_12hr.correct
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/DOMAIN_TIME_TEST/DOMAIN_TIME_TEST.jan00_12hr.correct	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/DOMAIN_TIME_TEST/DOMAIN_TIME_TEST.jan00_12hr.correct	(revision 2744)
@@ -0,0 +1,1445 @@
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000001
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.502083
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =   3.000000
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:03:00
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:03:00
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:003:000
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  simulationStartTime = 2000-01-24_12:00:00
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  start_timestr = 2000-01-24_12:00:00
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  stop_timestr = 2000-01-25_00:00:00
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  time_stepstr = 0000000000_000:003:000
+ d01 2000-01-24_12:03:00 DOMAIN_TIME_TEST domain_clockadvance:  time_stepstr_frac = 0000000000_000:003:000
+ d01 2000-01-24_12:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000002
+ d01 2000-01-24_12:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.504168
+ d01 2000-01-24_12:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =   6.000000
+ d01 2000-01-24_12:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:06:00
+ d01 2000-01-24_12:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:06:00
+ d01 2000-01-24_12:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:006:000
+ d01 2000-01-24_12:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000003
+ d01 2000-01-24_12:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.506250
+ d01 2000-01-24_12:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =   9.000000
+ d01 2000-01-24_12:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:09:00
+ d01 2000-01-24_12:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:09:00
+ d01 2000-01-24_12:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:009:000
+ d01 2000-01-24_12:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000004
+ d01 2000-01-24_12:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.508333
+ d01 2000-01-24_12:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  12.000000
+ d01 2000-01-24_12:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:12:00
+ d01 2000-01-24_12:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:12:00
+ d01 2000-01-24_12:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:012:000
+ d01 2000-01-24_12:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000005
+ d01 2000-01-24_12:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.510416
+ d01 2000-01-24_12:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  15.000000
+ d01 2000-01-24_12:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:15:00
+ d01 2000-01-24_12:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:15:00
+ d01 2000-01-24_12:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:015:000
+ d01 2000-01-24_12:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000006
+ d01 2000-01-24_12:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.512501
+ d01 2000-01-24_12:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  18.000000
+ d01 2000-01-24_12:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:18:00
+ d01 2000-01-24_12:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:18:00
+ d01 2000-01-24_12:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:018:000
+ d01 2000-01-24_12:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000007
+ d01 2000-01-24_12:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.514584
+ d01 2000-01-24_12:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  21.000000
+ d01 2000-01-24_12:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:21:00
+ d01 2000-01-24_12:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:21:00
+ d01 2000-01-24_12:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:021:000
+ d01 2000-01-24_12:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000008
+ d01 2000-01-24_12:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.516666
+ d01 2000-01-24_12:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  24.000000
+ d01 2000-01-24_12:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:24:00
+ d01 2000-01-24_12:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:24:00
+ d01 2000-01-24_12:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:024:000
+ d01 2000-01-24_12:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000009
+ d01 2000-01-24_12:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.518749
+ d01 2000-01-24_12:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  27.000000
+ d01 2000-01-24_12:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:27:00
+ d01 2000-01-24_12:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:27:00
+ d01 2000-01-24_12:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:027:000
+ d01 2000-01-24_12:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000010
+ d01 2000-01-24_12:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.520834
+ d01 2000-01-24_12:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  30.000000
+ d01 2000-01-24_12:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:30:00
+ d01 2000-01-24_12:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:30:00
+ d01 2000-01-24_12:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:030:000
+ d01 2000-01-24_12:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000011
+ d01 2000-01-24_12:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.522917
+ d01 2000-01-24_12:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  33.000000
+ d01 2000-01-24_12:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:33:00
+ d01 2000-01-24_12:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:33:00
+ d01 2000-01-24_12:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:033:000
+ d01 2000-01-24_12:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000012
+ d01 2000-01-24_12:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.525000
+ d01 2000-01-24_12:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  36.000000
+ d01 2000-01-24_12:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:36:00
+ d01 2000-01-24_12:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:36:00
+ d01 2000-01-24_12:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:036:000
+ d01 2000-01-24_12:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000013
+ d01 2000-01-24_12:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.527082
+ d01 2000-01-24_12:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  39.000000
+ d01 2000-01-24_12:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:39:00
+ d01 2000-01-24_12:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:39:00
+ d01 2000-01-24_12:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:039:000
+ d01 2000-01-24_12:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000014
+ d01 2000-01-24_12:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.529167
+ d01 2000-01-24_12:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  42.000000
+ d01 2000-01-24_12:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:42:00
+ d01 2000-01-24_12:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:42:00
+ d01 2000-01-24_12:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:042:000
+ d01 2000-01-24_12:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000015
+ d01 2000-01-24_12:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.531250
+ d01 2000-01-24_12:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  45.000000
+ d01 2000-01-24_12:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:45:00
+ d01 2000-01-24_12:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:45:00
+ d01 2000-01-24_12:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:045:000
+ d01 2000-01-24_12:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000016
+ d01 2000-01-24_12:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.533333
+ d01 2000-01-24_12:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  48.000000
+ d01 2000-01-24_12:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:48:00
+ d01 2000-01-24_12:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:48:00
+ d01 2000-01-24_12:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:048:000
+ d01 2000-01-24_12:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000017
+ d01 2000-01-24_12:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.535418
+ d01 2000-01-24_12:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  51.000000
+ d01 2000-01-24_12:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:51:00
+ d01 2000-01-24_12:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:51:00
+ d01 2000-01-24_12:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:051:000
+ d01 2000-01-24_12:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000018
+ d01 2000-01-24_12:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.537500
+ d01 2000-01-24_12:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  54.000000
+ d01 2000-01-24_12:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:54:00
+ d01 2000-01-24_12:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:54:00
+ d01 2000-01-24_12:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:054:000
+ d01 2000-01-24_12:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000019
+ d01 2000-01-24_12:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.539583
+ d01 2000-01-24_12:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  57.000000
+ d01 2000-01-24_12:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_12:57:00
+ d01 2000-01-24_12:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_12:57:00
+ d01 2000-01-24_12:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_000:057:000
+ d01 2000-01-24_13:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000020
+ d01 2000-01-24_13:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.541666
+ d01 2000-01-24_13:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  60.000000
+ d01 2000-01-24_13:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:00:00
+ d01 2000-01-24_13:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:00:00
+ d01 2000-01-24_13:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:000:000
+ d01 2000-01-24_13:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000021
+ d01 2000-01-24_13:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.543751
+ d01 2000-01-24_13:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  63.000000
+ d01 2000-01-24_13:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:03:00
+ d01 2000-01-24_13:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:03:00
+ d01 2000-01-24_13:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:003:000
+ d01 2000-01-24_13:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000022
+ d01 2000-01-24_13:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.545834
+ d01 2000-01-24_13:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  66.000000
+ d01 2000-01-24_13:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:06:00
+ d01 2000-01-24_13:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:06:00
+ d01 2000-01-24_13:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:006:000
+ d01 2000-01-24_13:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000023
+ d01 2000-01-24_13:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.547916
+ d01 2000-01-24_13:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  69.000000
+ d01 2000-01-24_13:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:09:00
+ d01 2000-01-24_13:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:09:00
+ d01 2000-01-24_13:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:009:000
+ d01 2000-01-24_13:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000024
+ d01 2000-01-24_13:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.549999
+ d01 2000-01-24_13:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  72.000000
+ d01 2000-01-24_13:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:12:00
+ d01 2000-01-24_13:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:12:00
+ d01 2000-01-24_13:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:012:000
+ d01 2000-01-24_13:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000025
+ d01 2000-01-24_13:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.552084
+ d01 2000-01-24_13:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  75.000000
+ d01 2000-01-24_13:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:15:00
+ d01 2000-01-24_13:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:15:00
+ d01 2000-01-24_13:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:015:000
+ d01 2000-01-24_13:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000026
+ d01 2000-01-24_13:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.554167
+ d01 2000-01-24_13:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  78.000000
+ d01 2000-01-24_13:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:18:00
+ d01 2000-01-24_13:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:18:00
+ d01 2000-01-24_13:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:018:000
+ d01 2000-01-24_13:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000027
+ d01 2000-01-24_13:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.556250
+ d01 2000-01-24_13:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  81.000000
+ d01 2000-01-24_13:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:21:00
+ d01 2000-01-24_13:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:21:00
+ d01 2000-01-24_13:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:021:000
+ d01 2000-01-24_13:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000028
+ d01 2000-01-24_13:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.558332
+ d01 2000-01-24_13:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  84.000000
+ d01 2000-01-24_13:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:24:00
+ d01 2000-01-24_13:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:24:00
+ d01 2000-01-24_13:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:024:000
+ d01 2000-01-24_13:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000029
+ d01 2000-01-24_13:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.560417
+ d01 2000-01-24_13:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  87.000000
+ d01 2000-01-24_13:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:27:00
+ d01 2000-01-24_13:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:27:00
+ d01 2000-01-24_13:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:027:000
+ d01 2000-01-24_13:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000030
+ d01 2000-01-24_13:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.562500
+ d01 2000-01-24_13:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  90.000000
+ d01 2000-01-24_13:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:30:00
+ d01 2000-01-24_13:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:30:00
+ d01 2000-01-24_13:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:030:000
+ d01 2000-01-24_13:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000031
+ d01 2000-01-24_13:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.564583
+ d01 2000-01-24_13:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  93.000000
+ d01 2000-01-24_13:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:33:00
+ d01 2000-01-24_13:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:33:00
+ d01 2000-01-24_13:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:033:000
+ d01 2000-01-24_13:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000032
+ d01 2000-01-24_13:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.566668
+ d01 2000-01-24_13:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  96.000000
+ d01 2000-01-24_13:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:36:00
+ d01 2000-01-24_13:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:36:00
+ d01 2000-01-24_13:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:036:000
+ d01 2000-01-24_13:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000033
+ d01 2000-01-24_13:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.568750
+ d01 2000-01-24_13:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart =  99.000000
+ d01 2000-01-24_13:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:39:00
+ d01 2000-01-24_13:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:39:00
+ d01 2000-01-24_13:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:039:000
+ d01 2000-01-24_13:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000034
+ d01 2000-01-24_13:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.570833
+ d01 2000-01-24_13:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 102.000000
+ d01 2000-01-24_13:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:42:00
+ d01 2000-01-24_13:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:42:00
+ d01 2000-01-24_13:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:042:000
+ d01 2000-01-24_13:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000035
+ d01 2000-01-24_13:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.572916
+ d01 2000-01-24_13:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 105.000000
+ d01 2000-01-24_13:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:45:00
+ d01 2000-01-24_13:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:45:00
+ d01 2000-01-24_13:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:045:000
+ d01 2000-01-24_13:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000036
+ d01 2000-01-24_13:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.575001
+ d01 2000-01-24_13:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 108.000000
+ d01 2000-01-24_13:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:48:00
+ d01 2000-01-24_13:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:48:00
+ d01 2000-01-24_13:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:048:000
+ d01 2000-01-24_13:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000037
+ d01 2000-01-24_13:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.577084
+ d01 2000-01-24_13:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 111.000000
+ d01 2000-01-24_13:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:51:00
+ d01 2000-01-24_13:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:51:00
+ d01 2000-01-24_13:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:051:000
+ d01 2000-01-24_13:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000038
+ d01 2000-01-24_13:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.579166
+ d01 2000-01-24_13:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 114.000000
+ d01 2000-01-24_13:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:54:00
+ d01 2000-01-24_13:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:54:00
+ d01 2000-01-24_13:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:054:000
+ d01 2000-01-24_13:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000039
+ d01 2000-01-24_13:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.581249
+ d01 2000-01-24_13:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 117.000000
+ d01 2000-01-24_13:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_13:57:00
+ d01 2000-01-24_13:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_13:57:00
+ d01 2000-01-24_13:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_001:057:000
+ d01 2000-01-24_14:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000040
+ d01 2000-01-24_14:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.583334
+ d01 2000-01-24_14:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 120.000000
+ d01 2000-01-24_14:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:00:00
+ d01 2000-01-24_14:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:00:00
+ d01 2000-01-24_14:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:000:000
+ d01 2000-01-24_14:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000041
+ d01 2000-01-24_14:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.585417
+ d01 2000-01-24_14:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 123.000000
+ d01 2000-01-24_14:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:03:00
+ d01 2000-01-24_14:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:03:00
+ d01 2000-01-24_14:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:003:000
+ d01 2000-01-24_14:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000042
+ d01 2000-01-24_14:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.587500
+ d01 2000-01-24_14:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 126.000000
+ d01 2000-01-24_14:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:06:00
+ d01 2000-01-24_14:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:06:00
+ d01 2000-01-24_14:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:006:000
+ d01 2000-01-24_14:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000043
+ d01 2000-01-24_14:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.589582
+ d01 2000-01-24_14:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 129.000000
+ d01 2000-01-24_14:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:09:00
+ d01 2000-01-24_14:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:09:00
+ d01 2000-01-24_14:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:009:000
+ d01 2000-01-24_14:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000044
+ d01 2000-01-24_14:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.591667
+ d01 2000-01-24_14:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 132.000000
+ d01 2000-01-24_14:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:12:00
+ d01 2000-01-24_14:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:12:00
+ d01 2000-01-24_14:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:012:000
+ d01 2000-01-24_14:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000045
+ d01 2000-01-24_14:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.593750
+ d01 2000-01-24_14:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 135.000000
+ d01 2000-01-24_14:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:15:00
+ d01 2000-01-24_14:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:15:00
+ d01 2000-01-24_14:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:015:000
+ d01 2000-01-24_14:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000046
+ d01 2000-01-24_14:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.595833
+ d01 2000-01-24_14:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 138.000000
+ d01 2000-01-24_14:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:18:00
+ d01 2000-01-24_14:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:18:00
+ d01 2000-01-24_14:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:018:000
+ d01 2000-01-24_14:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000047
+ d01 2000-01-24_14:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.597918
+ d01 2000-01-24_14:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 141.000000
+ d01 2000-01-24_14:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:21:00
+ d01 2000-01-24_14:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:21:00
+ d01 2000-01-24_14:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:021:000
+ d01 2000-01-24_14:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000048
+ d01 2000-01-24_14:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.600000
+ d01 2000-01-24_14:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 144.000000
+ d01 2000-01-24_14:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:24:00
+ d01 2000-01-24_14:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:24:00
+ d01 2000-01-24_14:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:024:000
+ d01 2000-01-24_14:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000049
+ d01 2000-01-24_14:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.602083
+ d01 2000-01-24_14:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 147.000000
+ d01 2000-01-24_14:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:27:00
+ d01 2000-01-24_14:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:27:00
+ d01 2000-01-24_14:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:027:000
+ d01 2000-01-24_14:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000050
+ d01 2000-01-24_14:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.604166
+ d01 2000-01-24_14:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 150.000000
+ d01 2000-01-24_14:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:30:00
+ d01 2000-01-24_14:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:30:00
+ d01 2000-01-24_14:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:030:000
+ d01 2000-01-24_14:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000051
+ d01 2000-01-24_14:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.606251
+ d01 2000-01-24_14:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 153.000000
+ d01 2000-01-24_14:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:33:00
+ d01 2000-01-24_14:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:33:00
+ d01 2000-01-24_14:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:033:000
+ d01 2000-01-24_14:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000052
+ d01 2000-01-24_14:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.608334
+ d01 2000-01-24_14:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 156.000000
+ d01 2000-01-24_14:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:36:00
+ d01 2000-01-24_14:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:36:00
+ d01 2000-01-24_14:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:036:000
+ d01 2000-01-24_14:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000053
+ d01 2000-01-24_14:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.610416
+ d01 2000-01-24_14:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 159.000000
+ d01 2000-01-24_14:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:39:00
+ d01 2000-01-24_14:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:39:00
+ d01 2000-01-24_14:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:039:000
+ d01 2000-01-24_14:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000054
+ d01 2000-01-24_14:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.612499
+ d01 2000-01-24_14:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 162.000000
+ d01 2000-01-24_14:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:42:00
+ d01 2000-01-24_14:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:42:00
+ d01 2000-01-24_14:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:042:000
+ d01 2000-01-24_14:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000055
+ d01 2000-01-24_14:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.614584
+ d01 2000-01-24_14:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 165.000000
+ d01 2000-01-24_14:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:45:00
+ d01 2000-01-24_14:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:45:00
+ d01 2000-01-24_14:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:045:000
+ d01 2000-01-24_14:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000056
+ d01 2000-01-24_14:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.616667
+ d01 2000-01-24_14:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 168.000000
+ d01 2000-01-24_14:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:48:00
+ d01 2000-01-24_14:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:48:00
+ d01 2000-01-24_14:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:048:000
+ d01 2000-01-24_14:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000057
+ d01 2000-01-24_14:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.618750
+ d01 2000-01-24_14:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 171.000000
+ d01 2000-01-24_14:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:51:00
+ d01 2000-01-24_14:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:51:00
+ d01 2000-01-24_14:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:051:000
+ d01 2000-01-24_14:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000058
+ d01 2000-01-24_14:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.620832
+ d01 2000-01-24_14:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 174.000000
+ d01 2000-01-24_14:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:54:00
+ d01 2000-01-24_14:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:54:00
+ d01 2000-01-24_14:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:054:000
+ d01 2000-01-24_14:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000059
+ d01 2000-01-24_14:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.622917
+ d01 2000-01-24_14:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 177.000000
+ d01 2000-01-24_14:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_14:57:00
+ d01 2000-01-24_14:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_14:57:00
+ d01 2000-01-24_14:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_002:057:000
+ d01 2000-01-24_15:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000060
+ d01 2000-01-24_15:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.625000
+ d01 2000-01-24_15:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 180.000000
+ d01 2000-01-24_15:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:00:00
+ d01 2000-01-24_15:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:00:00
+ d01 2000-01-24_15:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:000:000
+ d01 2000-01-24_15:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000061
+ d01 2000-01-24_15:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.627083
+ d01 2000-01-24_15:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 183.000000
+ d01 2000-01-24_15:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:03:00
+ d01 2000-01-24_15:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:03:00
+ d01 2000-01-24_15:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:003:000
+ d01 2000-01-24_15:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000062
+ d01 2000-01-24_15:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.629168
+ d01 2000-01-24_15:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 186.000000
+ d01 2000-01-24_15:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:06:00
+ d01 2000-01-24_15:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:06:00
+ d01 2000-01-24_15:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:006:000
+ d01 2000-01-24_15:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000063
+ d01 2000-01-24_15:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.631250
+ d01 2000-01-24_15:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 189.000000
+ d01 2000-01-24_15:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:09:00
+ d01 2000-01-24_15:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:09:00
+ d01 2000-01-24_15:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:009:000
+ d01 2000-01-24_15:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000064
+ d01 2000-01-24_15:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.633333
+ d01 2000-01-24_15:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 192.000000
+ d01 2000-01-24_15:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:12:00
+ d01 2000-01-24_15:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:12:00
+ d01 2000-01-24_15:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:012:000
+ d01 2000-01-24_15:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000065
+ d01 2000-01-24_15:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.635416
+ d01 2000-01-24_15:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 195.000000
+ d01 2000-01-24_15:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:15:00
+ d01 2000-01-24_15:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:15:00
+ d01 2000-01-24_15:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:015:000
+ d01 2000-01-24_15:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000066
+ d01 2000-01-24_15:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.637501
+ d01 2000-01-24_15:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 198.000000
+ d01 2000-01-24_15:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:18:00
+ d01 2000-01-24_15:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:18:00
+ d01 2000-01-24_15:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:018:000
+ d01 2000-01-24_15:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000067
+ d01 2000-01-24_15:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.639584
+ d01 2000-01-24_15:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 201.000000
+ d01 2000-01-24_15:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:21:00
+ d01 2000-01-24_15:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:21:00
+ d01 2000-01-24_15:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:021:000
+ d01 2000-01-24_15:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000068
+ d01 2000-01-24_15:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.641666
+ d01 2000-01-24_15:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 204.000000
+ d01 2000-01-24_15:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:24:00
+ d01 2000-01-24_15:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:24:00
+ d01 2000-01-24_15:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:024:000
+ d01 2000-01-24_15:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000069
+ d01 2000-01-24_15:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.643749
+ d01 2000-01-24_15:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 207.000000
+ d01 2000-01-24_15:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:27:00
+ d01 2000-01-24_15:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:27:00
+ d01 2000-01-24_15:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:027:000
+ d01 2000-01-24_15:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000070
+ d01 2000-01-24_15:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.645834
+ d01 2000-01-24_15:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 210.000000
+ d01 2000-01-24_15:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:30:00
+ d01 2000-01-24_15:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:30:00
+ d01 2000-01-24_15:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:030:000
+ d01 2000-01-24_15:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000071
+ d01 2000-01-24_15:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.647917
+ d01 2000-01-24_15:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 213.000000
+ d01 2000-01-24_15:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:33:00
+ d01 2000-01-24_15:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:33:00
+ d01 2000-01-24_15:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:033:000
+ d01 2000-01-24_15:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000072
+ d01 2000-01-24_15:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.650000
+ d01 2000-01-24_15:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 216.000000
+ d01 2000-01-24_15:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:36:00
+ d01 2000-01-24_15:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:36:00
+ d01 2000-01-24_15:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:036:000
+ d01 2000-01-24_15:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000073
+ d01 2000-01-24_15:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.652082
+ d01 2000-01-24_15:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 219.000000
+ d01 2000-01-24_15:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:39:00
+ d01 2000-01-24_15:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:39:00
+ d01 2000-01-24_15:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:039:000
+ d01 2000-01-24_15:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000074
+ d01 2000-01-24_15:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.654167
+ d01 2000-01-24_15:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 222.000000
+ d01 2000-01-24_15:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:42:00
+ d01 2000-01-24_15:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:42:00
+ d01 2000-01-24_15:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:042:000
+ d01 2000-01-24_15:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000075
+ d01 2000-01-24_15:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.656250
+ d01 2000-01-24_15:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 225.000000
+ d01 2000-01-24_15:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:45:00
+ d01 2000-01-24_15:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:45:00
+ d01 2000-01-24_15:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:045:000
+ d01 2000-01-24_15:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000076
+ d01 2000-01-24_15:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.658333
+ d01 2000-01-24_15:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 228.000000
+ d01 2000-01-24_15:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:48:00
+ d01 2000-01-24_15:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:48:00
+ d01 2000-01-24_15:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:048:000
+ d01 2000-01-24_15:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000077
+ d01 2000-01-24_15:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.660418
+ d01 2000-01-24_15:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 231.000000
+ d01 2000-01-24_15:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:51:00
+ d01 2000-01-24_15:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:51:00
+ d01 2000-01-24_15:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:051:000
+ d01 2000-01-24_15:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000078
+ d01 2000-01-24_15:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.662500
+ d01 2000-01-24_15:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 234.000000
+ d01 2000-01-24_15:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:54:00
+ d01 2000-01-24_15:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:54:00
+ d01 2000-01-24_15:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:054:000
+ d01 2000-01-24_15:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000079
+ d01 2000-01-24_15:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.664583
+ d01 2000-01-24_15:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 237.000000
+ d01 2000-01-24_15:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_15:57:00
+ d01 2000-01-24_15:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_15:57:00
+ d01 2000-01-24_15:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_003:057:000
+ d01 2000-01-24_16:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000080
+ d01 2000-01-24_16:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.666666
+ d01 2000-01-24_16:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 240.000000
+ d01 2000-01-24_16:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:00:00
+ d01 2000-01-24_16:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:00:00
+ d01 2000-01-24_16:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:000:000
+ d01 2000-01-24_16:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000081
+ d01 2000-01-24_16:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.668751
+ d01 2000-01-24_16:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 243.000000
+ d01 2000-01-24_16:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:03:00
+ d01 2000-01-24_16:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:03:00
+ d01 2000-01-24_16:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:003:000
+ d01 2000-01-24_16:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000082
+ d01 2000-01-24_16:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.670834
+ d01 2000-01-24_16:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 246.000000
+ d01 2000-01-24_16:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:06:00
+ d01 2000-01-24_16:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:06:00
+ d01 2000-01-24_16:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:006:000
+ d01 2000-01-24_16:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000083
+ d01 2000-01-24_16:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.672916
+ d01 2000-01-24_16:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 249.000000
+ d01 2000-01-24_16:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:09:00
+ d01 2000-01-24_16:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:09:00
+ d01 2000-01-24_16:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:009:000
+ d01 2000-01-24_16:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000084
+ d01 2000-01-24_16:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.674999
+ d01 2000-01-24_16:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 252.000000
+ d01 2000-01-24_16:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:12:00
+ d01 2000-01-24_16:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:12:00
+ d01 2000-01-24_16:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:012:000
+ d01 2000-01-24_16:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000085
+ d01 2000-01-24_16:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.677084
+ d01 2000-01-24_16:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 255.000000
+ d01 2000-01-24_16:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:15:00
+ d01 2000-01-24_16:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:15:00
+ d01 2000-01-24_16:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:015:000
+ d01 2000-01-24_16:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000086
+ d01 2000-01-24_16:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.679167
+ d01 2000-01-24_16:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 258.000000
+ d01 2000-01-24_16:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:18:00
+ d01 2000-01-24_16:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:18:00
+ d01 2000-01-24_16:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:018:000
+ d01 2000-01-24_16:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000087
+ d01 2000-01-24_16:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.681250
+ d01 2000-01-24_16:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 261.000000
+ d01 2000-01-24_16:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:21:00
+ d01 2000-01-24_16:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:21:00
+ d01 2000-01-24_16:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:021:000
+ d01 2000-01-24_16:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000088
+ d01 2000-01-24_16:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.683332
+ d01 2000-01-24_16:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 264.000000
+ d01 2000-01-24_16:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:24:00
+ d01 2000-01-24_16:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:24:00
+ d01 2000-01-24_16:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:024:000
+ d01 2000-01-24_16:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000089
+ d01 2000-01-24_16:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.685417
+ d01 2000-01-24_16:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 267.000000
+ d01 2000-01-24_16:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:27:00
+ d01 2000-01-24_16:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:27:00
+ d01 2000-01-24_16:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:027:000
+ d01 2000-01-24_16:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000090
+ d01 2000-01-24_16:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.687500
+ d01 2000-01-24_16:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 270.000000
+ d01 2000-01-24_16:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:30:00
+ d01 2000-01-24_16:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:30:00
+ d01 2000-01-24_16:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:030:000
+ d01 2000-01-24_16:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000091
+ d01 2000-01-24_16:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.689583
+ d01 2000-01-24_16:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 273.000000
+ d01 2000-01-24_16:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:33:00
+ d01 2000-01-24_16:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:33:00
+ d01 2000-01-24_16:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:033:000
+ d01 2000-01-24_16:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000092
+ d01 2000-01-24_16:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.691668
+ d01 2000-01-24_16:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 276.000000
+ d01 2000-01-24_16:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:36:00
+ d01 2000-01-24_16:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:36:00
+ d01 2000-01-24_16:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:036:000
+ d01 2000-01-24_16:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000093
+ d01 2000-01-24_16:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.693750
+ d01 2000-01-24_16:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 279.000000
+ d01 2000-01-24_16:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:39:00
+ d01 2000-01-24_16:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:39:00
+ d01 2000-01-24_16:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:039:000
+ d01 2000-01-24_16:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000094
+ d01 2000-01-24_16:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.695833
+ d01 2000-01-24_16:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 282.000000
+ d01 2000-01-24_16:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:42:00
+ d01 2000-01-24_16:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:42:00
+ d01 2000-01-24_16:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:042:000
+ d01 2000-01-24_16:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000095
+ d01 2000-01-24_16:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.697916
+ d01 2000-01-24_16:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 285.000000
+ d01 2000-01-24_16:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:45:00
+ d01 2000-01-24_16:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:45:00
+ d01 2000-01-24_16:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:045:000
+ d01 2000-01-24_16:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000096
+ d01 2000-01-24_16:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.700001
+ d01 2000-01-24_16:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 288.000000
+ d01 2000-01-24_16:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:48:00
+ d01 2000-01-24_16:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:48:00
+ d01 2000-01-24_16:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:048:000
+ d01 2000-01-24_16:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000097
+ d01 2000-01-24_16:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.702084
+ d01 2000-01-24_16:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 291.000000
+ d01 2000-01-24_16:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:51:00
+ d01 2000-01-24_16:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:51:00
+ d01 2000-01-24_16:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:051:000
+ d01 2000-01-24_16:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000098
+ d01 2000-01-24_16:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.704166
+ d01 2000-01-24_16:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 294.000000
+ d01 2000-01-24_16:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:54:00
+ d01 2000-01-24_16:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:54:00
+ d01 2000-01-24_16:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:054:000
+ d01 2000-01-24_16:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000099
+ d01 2000-01-24_16:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.706249
+ d01 2000-01-24_16:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 297.000000
+ d01 2000-01-24_16:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_16:57:00
+ d01 2000-01-24_16:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_16:57:00
+ d01 2000-01-24_16:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_004:057:000
+ d01 2000-01-24_17:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000100
+ d01 2000-01-24_17:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.708334
+ d01 2000-01-24_17:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 300.000000
+ d01 2000-01-24_17:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:00:00
+ d01 2000-01-24_17:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:00:00
+ d01 2000-01-24_17:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:000:000
+ d01 2000-01-24_17:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000101
+ d01 2000-01-24_17:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.710417
+ d01 2000-01-24_17:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 303.000000
+ d01 2000-01-24_17:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:03:00
+ d01 2000-01-24_17:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:03:00
+ d01 2000-01-24_17:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:003:000
+ d01 2000-01-24_17:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000102
+ d01 2000-01-24_17:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.712500
+ d01 2000-01-24_17:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 306.000000
+ d01 2000-01-24_17:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:06:00
+ d01 2000-01-24_17:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:06:00
+ d01 2000-01-24_17:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:006:000
+ d01 2000-01-24_17:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000103
+ d01 2000-01-24_17:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.714582
+ d01 2000-01-24_17:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 309.000000
+ d01 2000-01-24_17:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:09:00
+ d01 2000-01-24_17:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:09:00
+ d01 2000-01-24_17:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:009:000
+ d01 2000-01-24_17:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000104
+ d01 2000-01-24_17:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.716667
+ d01 2000-01-24_17:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 312.000000
+ d01 2000-01-24_17:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:12:00
+ d01 2000-01-24_17:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:12:00
+ d01 2000-01-24_17:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:012:000
+ d01 2000-01-24_17:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000105
+ d01 2000-01-24_17:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.718750
+ d01 2000-01-24_17:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 315.000000
+ d01 2000-01-24_17:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:15:00
+ d01 2000-01-24_17:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:15:00
+ d01 2000-01-24_17:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:015:000
+ d01 2000-01-24_17:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000106
+ d01 2000-01-24_17:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.720833
+ d01 2000-01-24_17:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 318.000000
+ d01 2000-01-24_17:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:18:00
+ d01 2000-01-24_17:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:18:00
+ d01 2000-01-24_17:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:018:000
+ d01 2000-01-24_17:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000107
+ d01 2000-01-24_17:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.722918
+ d01 2000-01-24_17:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 321.000000
+ d01 2000-01-24_17:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:21:00
+ d01 2000-01-24_17:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:21:00
+ d01 2000-01-24_17:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:021:000
+ d01 2000-01-24_17:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000108
+ d01 2000-01-24_17:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.725000
+ d01 2000-01-24_17:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 324.000000
+ d01 2000-01-24_17:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:24:00
+ d01 2000-01-24_17:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:24:00
+ d01 2000-01-24_17:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:024:000
+ d01 2000-01-24_17:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000109
+ d01 2000-01-24_17:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.727083
+ d01 2000-01-24_17:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 327.000000
+ d01 2000-01-24_17:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:27:00
+ d01 2000-01-24_17:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:27:00
+ d01 2000-01-24_17:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:027:000
+ d01 2000-01-24_17:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000110
+ d01 2000-01-24_17:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.729166
+ d01 2000-01-24_17:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 330.000000
+ d01 2000-01-24_17:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:30:00
+ d01 2000-01-24_17:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:30:00
+ d01 2000-01-24_17:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:030:000
+ d01 2000-01-24_17:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000111
+ d01 2000-01-24_17:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.731251
+ d01 2000-01-24_17:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 333.000000
+ d01 2000-01-24_17:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:33:00
+ d01 2000-01-24_17:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:33:00
+ d01 2000-01-24_17:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:033:000
+ d01 2000-01-24_17:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000112
+ d01 2000-01-24_17:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.733334
+ d01 2000-01-24_17:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 336.000000
+ d01 2000-01-24_17:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:36:00
+ d01 2000-01-24_17:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:36:00
+ d01 2000-01-24_17:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:036:000
+ d01 2000-01-24_17:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000113
+ d01 2000-01-24_17:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.735416
+ d01 2000-01-24_17:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 339.000000
+ d01 2000-01-24_17:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:39:00
+ d01 2000-01-24_17:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:39:00
+ d01 2000-01-24_17:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:039:000
+ d01 2000-01-24_17:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000114
+ d01 2000-01-24_17:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.737499
+ d01 2000-01-24_17:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 342.000000
+ d01 2000-01-24_17:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:42:00
+ d01 2000-01-24_17:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:42:00
+ d01 2000-01-24_17:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:042:000
+ d01 2000-01-24_17:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000115
+ d01 2000-01-24_17:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.739584
+ d01 2000-01-24_17:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 345.000000
+ d01 2000-01-24_17:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:45:00
+ d01 2000-01-24_17:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:45:00
+ d01 2000-01-24_17:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:045:000
+ d01 2000-01-24_17:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000116
+ d01 2000-01-24_17:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.741667
+ d01 2000-01-24_17:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 348.000000
+ d01 2000-01-24_17:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:48:00
+ d01 2000-01-24_17:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:48:00
+ d01 2000-01-24_17:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:048:000
+ d01 2000-01-24_17:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000117
+ d01 2000-01-24_17:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.743750
+ d01 2000-01-24_17:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 351.000000
+ d01 2000-01-24_17:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:51:00
+ d01 2000-01-24_17:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:51:00
+ d01 2000-01-24_17:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:051:000
+ d01 2000-01-24_17:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000118
+ d01 2000-01-24_17:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.745832
+ d01 2000-01-24_17:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 354.000000
+ d01 2000-01-24_17:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:54:00
+ d01 2000-01-24_17:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:54:00
+ d01 2000-01-24_17:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:054:000
+ d01 2000-01-24_17:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000119
+ d01 2000-01-24_17:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.747917
+ d01 2000-01-24_17:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 357.000000
+ d01 2000-01-24_17:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_17:57:00
+ d01 2000-01-24_17:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_17:57:00
+ d01 2000-01-24_17:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_005:057:000
+ d01 2000-01-24_18:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000120
+ d01 2000-01-24_18:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.750000
+ d01 2000-01-24_18:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 360.000000
+ d01 2000-01-24_18:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:00:00
+ d01 2000-01-24_18:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:00:00
+ d01 2000-01-24_18:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:000:000
+ d01 2000-01-24_18:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000121
+ d01 2000-01-24_18:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.752083
+ d01 2000-01-24_18:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 363.000000
+ d01 2000-01-24_18:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:03:00
+ d01 2000-01-24_18:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:03:00
+ d01 2000-01-24_18:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:003:000
+ d01 2000-01-24_18:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000122
+ d01 2000-01-24_18:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.754168
+ d01 2000-01-24_18:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 366.000000
+ d01 2000-01-24_18:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:06:00
+ d01 2000-01-24_18:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:06:00
+ d01 2000-01-24_18:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:006:000
+ d01 2000-01-24_18:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000123
+ d01 2000-01-24_18:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.756250
+ d01 2000-01-24_18:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 369.000000
+ d01 2000-01-24_18:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:09:00
+ d01 2000-01-24_18:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:09:00
+ d01 2000-01-24_18:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:009:000
+ d01 2000-01-24_18:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000124
+ d01 2000-01-24_18:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.758333
+ d01 2000-01-24_18:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 372.000000
+ d01 2000-01-24_18:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:12:00
+ d01 2000-01-24_18:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:12:00
+ d01 2000-01-24_18:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:012:000
+ d01 2000-01-24_18:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000125
+ d01 2000-01-24_18:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.760416
+ d01 2000-01-24_18:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 375.000000
+ d01 2000-01-24_18:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:15:00
+ d01 2000-01-24_18:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:15:00
+ d01 2000-01-24_18:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:015:000
+ d01 2000-01-24_18:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000126
+ d01 2000-01-24_18:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.762501
+ d01 2000-01-24_18:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 378.000000
+ d01 2000-01-24_18:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:18:00
+ d01 2000-01-24_18:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:18:00
+ d01 2000-01-24_18:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:018:000
+ d01 2000-01-24_18:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000127
+ d01 2000-01-24_18:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.764584
+ d01 2000-01-24_18:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 381.000000
+ d01 2000-01-24_18:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:21:00
+ d01 2000-01-24_18:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:21:00
+ d01 2000-01-24_18:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:021:000
+ d01 2000-01-24_18:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000128
+ d01 2000-01-24_18:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.766666
+ d01 2000-01-24_18:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 384.000000
+ d01 2000-01-24_18:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:24:00
+ d01 2000-01-24_18:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:24:00
+ d01 2000-01-24_18:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:024:000
+ d01 2000-01-24_18:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000129
+ d01 2000-01-24_18:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.768749
+ d01 2000-01-24_18:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 387.000000
+ d01 2000-01-24_18:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:27:00
+ d01 2000-01-24_18:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:27:00
+ d01 2000-01-24_18:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:027:000
+ d01 2000-01-24_18:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000130
+ d01 2000-01-24_18:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.770834
+ d01 2000-01-24_18:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 390.000000
+ d01 2000-01-24_18:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:30:00
+ d01 2000-01-24_18:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:30:00
+ d01 2000-01-24_18:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:030:000
+ d01 2000-01-24_18:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000131
+ d01 2000-01-24_18:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.772917
+ d01 2000-01-24_18:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 393.000000
+ d01 2000-01-24_18:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:33:00
+ d01 2000-01-24_18:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:33:00
+ d01 2000-01-24_18:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:033:000
+ d01 2000-01-24_18:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000132
+ d01 2000-01-24_18:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.775000
+ d01 2000-01-24_18:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 396.000000
+ d01 2000-01-24_18:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:36:00
+ d01 2000-01-24_18:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:36:00
+ d01 2000-01-24_18:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:036:000
+ d01 2000-01-24_18:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000133
+ d01 2000-01-24_18:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.777082
+ d01 2000-01-24_18:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 399.000000
+ d01 2000-01-24_18:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:39:00
+ d01 2000-01-24_18:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:39:00
+ d01 2000-01-24_18:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:039:000
+ d01 2000-01-24_18:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000134
+ d01 2000-01-24_18:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.779167
+ d01 2000-01-24_18:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 402.000000
+ d01 2000-01-24_18:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:42:00
+ d01 2000-01-24_18:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:42:00
+ d01 2000-01-24_18:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:042:000
+ d01 2000-01-24_18:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000135
+ d01 2000-01-24_18:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.781250
+ d01 2000-01-24_18:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 405.000000
+ d01 2000-01-24_18:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:45:00
+ d01 2000-01-24_18:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:45:00
+ d01 2000-01-24_18:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:045:000
+ d01 2000-01-24_18:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000136
+ d01 2000-01-24_18:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.783333
+ d01 2000-01-24_18:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 408.000000
+ d01 2000-01-24_18:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:48:00
+ d01 2000-01-24_18:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:48:00
+ d01 2000-01-24_18:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:048:000
+ d01 2000-01-24_18:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000137
+ d01 2000-01-24_18:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.785418
+ d01 2000-01-24_18:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 411.000000
+ d01 2000-01-24_18:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:51:00
+ d01 2000-01-24_18:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:51:00
+ d01 2000-01-24_18:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:051:000
+ d01 2000-01-24_18:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000138
+ d01 2000-01-24_18:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.787500
+ d01 2000-01-24_18:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 414.000000
+ d01 2000-01-24_18:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:54:00
+ d01 2000-01-24_18:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:54:00
+ d01 2000-01-24_18:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:054:000
+ d01 2000-01-24_18:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000139
+ d01 2000-01-24_18:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.789583
+ d01 2000-01-24_18:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 417.000000
+ d01 2000-01-24_18:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_18:57:00
+ d01 2000-01-24_18:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_18:57:00
+ d01 2000-01-24_18:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_006:057:000
+ d01 2000-01-24_19:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000140
+ d01 2000-01-24_19:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.791666
+ d01 2000-01-24_19:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 420.000000
+ d01 2000-01-24_19:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:00:00
+ d01 2000-01-24_19:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:00:00
+ d01 2000-01-24_19:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:000:000
+ d01 2000-01-24_19:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000141
+ d01 2000-01-24_19:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.793751
+ d01 2000-01-24_19:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 423.000000
+ d01 2000-01-24_19:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:03:00
+ d01 2000-01-24_19:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:03:00
+ d01 2000-01-24_19:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:003:000
+ d01 2000-01-24_19:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000142
+ d01 2000-01-24_19:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.795834
+ d01 2000-01-24_19:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 426.000000
+ d01 2000-01-24_19:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:06:00
+ d01 2000-01-24_19:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:06:00
+ d01 2000-01-24_19:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:006:000
+ d01 2000-01-24_19:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000143
+ d01 2000-01-24_19:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.797916
+ d01 2000-01-24_19:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 429.000000
+ d01 2000-01-24_19:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:09:00
+ d01 2000-01-24_19:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:09:00
+ d01 2000-01-24_19:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:009:000
+ d01 2000-01-24_19:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000144
+ d01 2000-01-24_19:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.799999
+ d01 2000-01-24_19:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 432.000000
+ d01 2000-01-24_19:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:12:00
+ d01 2000-01-24_19:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:12:00
+ d01 2000-01-24_19:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:012:000
+ d01 2000-01-24_19:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000145
+ d01 2000-01-24_19:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.802084
+ d01 2000-01-24_19:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 435.000000
+ d01 2000-01-24_19:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:15:00
+ d01 2000-01-24_19:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:15:00
+ d01 2000-01-24_19:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:015:000
+ d01 2000-01-24_19:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000146
+ d01 2000-01-24_19:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.804167
+ d01 2000-01-24_19:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 438.000000
+ d01 2000-01-24_19:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:18:00
+ d01 2000-01-24_19:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:18:00
+ d01 2000-01-24_19:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:018:000
+ d01 2000-01-24_19:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000147
+ d01 2000-01-24_19:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.806250
+ d01 2000-01-24_19:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 441.000000
+ d01 2000-01-24_19:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:21:00
+ d01 2000-01-24_19:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:21:00
+ d01 2000-01-24_19:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:021:000
+ d01 2000-01-24_19:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000148
+ d01 2000-01-24_19:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.808332
+ d01 2000-01-24_19:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 444.000000
+ d01 2000-01-24_19:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:24:00
+ d01 2000-01-24_19:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:24:00
+ d01 2000-01-24_19:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:024:000
+ d01 2000-01-24_19:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000149
+ d01 2000-01-24_19:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.810417
+ d01 2000-01-24_19:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 447.000000
+ d01 2000-01-24_19:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:27:00
+ d01 2000-01-24_19:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:27:00
+ d01 2000-01-24_19:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:027:000
+ d01 2000-01-24_19:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000150
+ d01 2000-01-24_19:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.812500
+ d01 2000-01-24_19:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 450.000000
+ d01 2000-01-24_19:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:30:00
+ d01 2000-01-24_19:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:30:00
+ d01 2000-01-24_19:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:030:000
+ d01 2000-01-24_19:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000151
+ d01 2000-01-24_19:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.814583
+ d01 2000-01-24_19:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 453.000000
+ d01 2000-01-24_19:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:33:00
+ d01 2000-01-24_19:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:33:00
+ d01 2000-01-24_19:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:033:000
+ d01 2000-01-24_19:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000152
+ d01 2000-01-24_19:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.816668
+ d01 2000-01-24_19:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 456.000000
+ d01 2000-01-24_19:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:36:00
+ d01 2000-01-24_19:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:36:00
+ d01 2000-01-24_19:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:036:000
+ d01 2000-01-24_19:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000153
+ d01 2000-01-24_19:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.818750
+ d01 2000-01-24_19:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 459.000000
+ d01 2000-01-24_19:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:39:00
+ d01 2000-01-24_19:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:39:00
+ d01 2000-01-24_19:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:039:000
+ d01 2000-01-24_19:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000154
+ d01 2000-01-24_19:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.820833
+ d01 2000-01-24_19:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 462.000000
+ d01 2000-01-24_19:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:42:00
+ d01 2000-01-24_19:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:42:00
+ d01 2000-01-24_19:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:042:000
+ d01 2000-01-24_19:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000155
+ d01 2000-01-24_19:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.822916
+ d01 2000-01-24_19:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 465.000000
+ d01 2000-01-24_19:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:45:00
+ d01 2000-01-24_19:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:45:00
+ d01 2000-01-24_19:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:045:000
+ d01 2000-01-24_19:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000156
+ d01 2000-01-24_19:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.825001
+ d01 2000-01-24_19:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 468.000000
+ d01 2000-01-24_19:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:48:00
+ d01 2000-01-24_19:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:48:00
+ d01 2000-01-24_19:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:048:000
+ d01 2000-01-24_19:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000157
+ d01 2000-01-24_19:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.827084
+ d01 2000-01-24_19:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 471.000000
+ d01 2000-01-24_19:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:51:00
+ d01 2000-01-24_19:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:51:00
+ d01 2000-01-24_19:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:051:000
+ d01 2000-01-24_19:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000158
+ d01 2000-01-24_19:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.829166
+ d01 2000-01-24_19:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 474.000000
+ d01 2000-01-24_19:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:54:00
+ d01 2000-01-24_19:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:54:00
+ d01 2000-01-24_19:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:054:000
+ d01 2000-01-24_19:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000159
+ d01 2000-01-24_19:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.831249
+ d01 2000-01-24_19:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 477.000000
+ d01 2000-01-24_19:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_19:57:00
+ d01 2000-01-24_19:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_19:57:00
+ d01 2000-01-24_19:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_007:057:000
+ d01 2000-01-24_20:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000160
+ d01 2000-01-24_20:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.833334
+ d01 2000-01-24_20:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 480.000000
+ d01 2000-01-24_20:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:00:00
+ d01 2000-01-24_20:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:00:00
+ d01 2000-01-24_20:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:000:000
+ d01 2000-01-24_20:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000161
+ d01 2000-01-24_20:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.835417
+ d01 2000-01-24_20:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 483.000000
+ d01 2000-01-24_20:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:03:00
+ d01 2000-01-24_20:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:03:00
+ d01 2000-01-24_20:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:003:000
+ d01 2000-01-24_20:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000162
+ d01 2000-01-24_20:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.837500
+ d01 2000-01-24_20:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 486.000000
+ d01 2000-01-24_20:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:06:00
+ d01 2000-01-24_20:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:06:00
+ d01 2000-01-24_20:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:006:000
+ d01 2000-01-24_20:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000163
+ d01 2000-01-24_20:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.839582
+ d01 2000-01-24_20:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 489.000000
+ d01 2000-01-24_20:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:09:00
+ d01 2000-01-24_20:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:09:00
+ d01 2000-01-24_20:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:009:000
+ d01 2000-01-24_20:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000164
+ d01 2000-01-24_20:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.841667
+ d01 2000-01-24_20:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 492.000000
+ d01 2000-01-24_20:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:12:00
+ d01 2000-01-24_20:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:12:00
+ d01 2000-01-24_20:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:012:000
+ d01 2000-01-24_20:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000165
+ d01 2000-01-24_20:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.843750
+ d01 2000-01-24_20:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 495.000000
+ d01 2000-01-24_20:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:15:00
+ d01 2000-01-24_20:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:15:00
+ d01 2000-01-24_20:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:015:000
+ d01 2000-01-24_20:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000166
+ d01 2000-01-24_20:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.845833
+ d01 2000-01-24_20:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 498.000000
+ d01 2000-01-24_20:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:18:00
+ d01 2000-01-24_20:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:18:00
+ d01 2000-01-24_20:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:018:000
+ d01 2000-01-24_20:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000167
+ d01 2000-01-24_20:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.847918
+ d01 2000-01-24_20:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 501.000000
+ d01 2000-01-24_20:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:21:00
+ d01 2000-01-24_20:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:21:00
+ d01 2000-01-24_20:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:021:000
+ d01 2000-01-24_20:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000168
+ d01 2000-01-24_20:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.850000
+ d01 2000-01-24_20:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 504.000000
+ d01 2000-01-24_20:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:24:00
+ d01 2000-01-24_20:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:24:00
+ d01 2000-01-24_20:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:024:000
+ d01 2000-01-24_20:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000169
+ d01 2000-01-24_20:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.852083
+ d01 2000-01-24_20:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 507.000000
+ d01 2000-01-24_20:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:27:00
+ d01 2000-01-24_20:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:27:00
+ d01 2000-01-24_20:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:027:000
+ d01 2000-01-24_20:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000170
+ d01 2000-01-24_20:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.854166
+ d01 2000-01-24_20:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 510.000000
+ d01 2000-01-24_20:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:30:00
+ d01 2000-01-24_20:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:30:00
+ d01 2000-01-24_20:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:030:000
+ d01 2000-01-24_20:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000171
+ d01 2000-01-24_20:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.856251
+ d01 2000-01-24_20:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 513.000000
+ d01 2000-01-24_20:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:33:00
+ d01 2000-01-24_20:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:33:00
+ d01 2000-01-24_20:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:033:000
+ d01 2000-01-24_20:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000172
+ d01 2000-01-24_20:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.858334
+ d01 2000-01-24_20:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 516.000000
+ d01 2000-01-24_20:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:36:00
+ d01 2000-01-24_20:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:36:00
+ d01 2000-01-24_20:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:036:000
+ d01 2000-01-24_20:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000173
+ d01 2000-01-24_20:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.860416
+ d01 2000-01-24_20:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 519.000000
+ d01 2000-01-24_20:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:39:00
+ d01 2000-01-24_20:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:39:00
+ d01 2000-01-24_20:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:039:000
+ d01 2000-01-24_20:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000174
+ d01 2000-01-24_20:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.862499
+ d01 2000-01-24_20:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 522.000000
+ d01 2000-01-24_20:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:42:00
+ d01 2000-01-24_20:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:42:00
+ d01 2000-01-24_20:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:042:000
+ d01 2000-01-24_20:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000175
+ d01 2000-01-24_20:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.864584
+ d01 2000-01-24_20:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 525.000000
+ d01 2000-01-24_20:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:45:00
+ d01 2000-01-24_20:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:45:00
+ d01 2000-01-24_20:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:045:000
+ d01 2000-01-24_20:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000176
+ d01 2000-01-24_20:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.866667
+ d01 2000-01-24_20:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 528.000000
+ d01 2000-01-24_20:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:48:00
+ d01 2000-01-24_20:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:48:00
+ d01 2000-01-24_20:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:048:000
+ d01 2000-01-24_20:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000177
+ d01 2000-01-24_20:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.868750
+ d01 2000-01-24_20:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 531.000000
+ d01 2000-01-24_20:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:51:00
+ d01 2000-01-24_20:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:51:00
+ d01 2000-01-24_20:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:051:000
+ d01 2000-01-24_20:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000178
+ d01 2000-01-24_20:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.870832
+ d01 2000-01-24_20:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 534.000000
+ d01 2000-01-24_20:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:54:00
+ d01 2000-01-24_20:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:54:00
+ d01 2000-01-24_20:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:054:000
+ d01 2000-01-24_20:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000179
+ d01 2000-01-24_20:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.872917
+ d01 2000-01-24_20:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 537.000000
+ d01 2000-01-24_20:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_20:57:00
+ d01 2000-01-24_20:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_20:57:00
+ d01 2000-01-24_20:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_008:057:000
+ d01 2000-01-24_21:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000180
+ d01 2000-01-24_21:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.875000
+ d01 2000-01-24_21:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 540.000000
+ d01 2000-01-24_21:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:00:00
+ d01 2000-01-24_21:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:00:00
+ d01 2000-01-24_21:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:000:000
+ d01 2000-01-24_21:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000181
+ d01 2000-01-24_21:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.877083
+ d01 2000-01-24_21:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 543.000000
+ d01 2000-01-24_21:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:03:00
+ d01 2000-01-24_21:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:03:00
+ d01 2000-01-24_21:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:003:000
+ d01 2000-01-24_21:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000182
+ d01 2000-01-24_21:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.879168
+ d01 2000-01-24_21:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 546.000000
+ d01 2000-01-24_21:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:06:00
+ d01 2000-01-24_21:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:06:00
+ d01 2000-01-24_21:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:006:000
+ d01 2000-01-24_21:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000183
+ d01 2000-01-24_21:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.881250
+ d01 2000-01-24_21:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 549.000000
+ d01 2000-01-24_21:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:09:00
+ d01 2000-01-24_21:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:09:00
+ d01 2000-01-24_21:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:009:000
+ d01 2000-01-24_21:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000184
+ d01 2000-01-24_21:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.883333
+ d01 2000-01-24_21:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 552.000000
+ d01 2000-01-24_21:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:12:00
+ d01 2000-01-24_21:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:12:00
+ d01 2000-01-24_21:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:012:000
+ d01 2000-01-24_21:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000185
+ d01 2000-01-24_21:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.885416
+ d01 2000-01-24_21:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 555.000000
+ d01 2000-01-24_21:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:15:00
+ d01 2000-01-24_21:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:15:00
+ d01 2000-01-24_21:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:015:000
+ d01 2000-01-24_21:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000186
+ d01 2000-01-24_21:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.887501
+ d01 2000-01-24_21:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 558.000000
+ d01 2000-01-24_21:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:18:00
+ d01 2000-01-24_21:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:18:00
+ d01 2000-01-24_21:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:018:000
+ d01 2000-01-24_21:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000187
+ d01 2000-01-24_21:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.889584
+ d01 2000-01-24_21:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 561.000000
+ d01 2000-01-24_21:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:21:00
+ d01 2000-01-24_21:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:21:00
+ d01 2000-01-24_21:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:021:000
+ d01 2000-01-24_21:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000188
+ d01 2000-01-24_21:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.891666
+ d01 2000-01-24_21:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 564.000000
+ d01 2000-01-24_21:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:24:00
+ d01 2000-01-24_21:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:24:00
+ d01 2000-01-24_21:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:024:000
+ d01 2000-01-24_21:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000189
+ d01 2000-01-24_21:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.893749
+ d01 2000-01-24_21:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 567.000000
+ d01 2000-01-24_21:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:27:00
+ d01 2000-01-24_21:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:27:00
+ d01 2000-01-24_21:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:027:000
+ d01 2000-01-24_21:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000190
+ d01 2000-01-24_21:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.895834
+ d01 2000-01-24_21:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 570.000000
+ d01 2000-01-24_21:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:30:00
+ d01 2000-01-24_21:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:30:00
+ d01 2000-01-24_21:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:030:000
+ d01 2000-01-24_21:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000191
+ d01 2000-01-24_21:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.897917
+ d01 2000-01-24_21:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 573.000000
+ d01 2000-01-24_21:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:33:00
+ d01 2000-01-24_21:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:33:00
+ d01 2000-01-24_21:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:033:000
+ d01 2000-01-24_21:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000192
+ d01 2000-01-24_21:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.900000
+ d01 2000-01-24_21:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 576.000000
+ d01 2000-01-24_21:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:36:00
+ d01 2000-01-24_21:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:36:00
+ d01 2000-01-24_21:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:036:000
+ d01 2000-01-24_21:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000193
+ d01 2000-01-24_21:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.902082
+ d01 2000-01-24_21:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 579.000000
+ d01 2000-01-24_21:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:39:00
+ d01 2000-01-24_21:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:39:00
+ d01 2000-01-24_21:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:039:000
+ d01 2000-01-24_21:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000194
+ d01 2000-01-24_21:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.904167
+ d01 2000-01-24_21:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 582.000000
+ d01 2000-01-24_21:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:42:00
+ d01 2000-01-24_21:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:42:00
+ d01 2000-01-24_21:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:042:000
+ d01 2000-01-24_21:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000195
+ d01 2000-01-24_21:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.906250
+ d01 2000-01-24_21:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 585.000000
+ d01 2000-01-24_21:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:45:00
+ d01 2000-01-24_21:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:45:00
+ d01 2000-01-24_21:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:045:000
+ d01 2000-01-24_21:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000196
+ d01 2000-01-24_21:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.908333
+ d01 2000-01-24_21:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 588.000000
+ d01 2000-01-24_21:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:48:00
+ d01 2000-01-24_21:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:48:00
+ d01 2000-01-24_21:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:048:000
+ d01 2000-01-24_21:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000197
+ d01 2000-01-24_21:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.910418
+ d01 2000-01-24_21:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 591.000000
+ d01 2000-01-24_21:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:51:00
+ d01 2000-01-24_21:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:51:00
+ d01 2000-01-24_21:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:051:000
+ d01 2000-01-24_21:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000198
+ d01 2000-01-24_21:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.912500
+ d01 2000-01-24_21:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 594.000000
+ d01 2000-01-24_21:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:54:00
+ d01 2000-01-24_21:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:54:00
+ d01 2000-01-24_21:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:054:000
+ d01 2000-01-24_21:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000199
+ d01 2000-01-24_21:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.914583
+ d01 2000-01-24_21:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 597.000000
+ d01 2000-01-24_21:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_21:57:00
+ d01 2000-01-24_21:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_21:57:00
+ d01 2000-01-24_21:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_009:057:000
+ d01 2000-01-24_22:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000200
+ d01 2000-01-24_22:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.916666
+ d01 2000-01-24_22:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 600.000000
+ d01 2000-01-24_22:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:00:00
+ d01 2000-01-24_22:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:00:00
+ d01 2000-01-24_22:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:000:000
+ d01 2000-01-24_22:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000201
+ d01 2000-01-24_22:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.918751
+ d01 2000-01-24_22:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 603.000000
+ d01 2000-01-24_22:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:03:00
+ d01 2000-01-24_22:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:03:00
+ d01 2000-01-24_22:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:003:000
+ d01 2000-01-24_22:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000202
+ d01 2000-01-24_22:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.920834
+ d01 2000-01-24_22:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 606.000000
+ d01 2000-01-24_22:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:06:00
+ d01 2000-01-24_22:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:06:00
+ d01 2000-01-24_22:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:006:000
+ d01 2000-01-24_22:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000203
+ d01 2000-01-24_22:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.922916
+ d01 2000-01-24_22:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 609.000000
+ d01 2000-01-24_22:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:09:00
+ d01 2000-01-24_22:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:09:00
+ d01 2000-01-24_22:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:009:000
+ d01 2000-01-24_22:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000204
+ d01 2000-01-24_22:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.924999
+ d01 2000-01-24_22:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 612.000000
+ d01 2000-01-24_22:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:12:00
+ d01 2000-01-24_22:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:12:00
+ d01 2000-01-24_22:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:012:000
+ d01 2000-01-24_22:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000205
+ d01 2000-01-24_22:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.927084
+ d01 2000-01-24_22:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 615.000000
+ d01 2000-01-24_22:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:15:00
+ d01 2000-01-24_22:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:15:00
+ d01 2000-01-24_22:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:015:000
+ d01 2000-01-24_22:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000206
+ d01 2000-01-24_22:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.929167
+ d01 2000-01-24_22:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 618.000000
+ d01 2000-01-24_22:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:18:00
+ d01 2000-01-24_22:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:18:00
+ d01 2000-01-24_22:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:018:000
+ d01 2000-01-24_22:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000207
+ d01 2000-01-24_22:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.931250
+ d01 2000-01-24_22:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 621.000000
+ d01 2000-01-24_22:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:21:00
+ d01 2000-01-24_22:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:21:00
+ d01 2000-01-24_22:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:021:000
+ d01 2000-01-24_22:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000208
+ d01 2000-01-24_22:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.933332
+ d01 2000-01-24_22:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 624.000000
+ d01 2000-01-24_22:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:24:00
+ d01 2000-01-24_22:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:24:00
+ d01 2000-01-24_22:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:024:000
+ d01 2000-01-24_22:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000209
+ d01 2000-01-24_22:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.935417
+ d01 2000-01-24_22:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 627.000000
+ d01 2000-01-24_22:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:27:00
+ d01 2000-01-24_22:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:27:00
+ d01 2000-01-24_22:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:027:000
+ d01 2000-01-24_22:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000210
+ d01 2000-01-24_22:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.937500
+ d01 2000-01-24_22:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 630.000000
+ d01 2000-01-24_22:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:30:00
+ d01 2000-01-24_22:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:30:00
+ d01 2000-01-24_22:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:030:000
+ d01 2000-01-24_22:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000211
+ d01 2000-01-24_22:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.939583
+ d01 2000-01-24_22:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 633.000000
+ d01 2000-01-24_22:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:33:00
+ d01 2000-01-24_22:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:33:00
+ d01 2000-01-24_22:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:033:000
+ d01 2000-01-24_22:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000212
+ d01 2000-01-24_22:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.941668
+ d01 2000-01-24_22:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 636.000000
+ d01 2000-01-24_22:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:36:00
+ d01 2000-01-24_22:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:36:00
+ d01 2000-01-24_22:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:036:000
+ d01 2000-01-24_22:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000213
+ d01 2000-01-24_22:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.943750
+ d01 2000-01-24_22:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 639.000000
+ d01 2000-01-24_22:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:39:00
+ d01 2000-01-24_22:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:39:00
+ d01 2000-01-24_22:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:039:000
+ d01 2000-01-24_22:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000214
+ d01 2000-01-24_22:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.945833
+ d01 2000-01-24_22:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 642.000000
+ d01 2000-01-24_22:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:42:00
+ d01 2000-01-24_22:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:42:00
+ d01 2000-01-24_22:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:042:000
+ d01 2000-01-24_22:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000215
+ d01 2000-01-24_22:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.947916
+ d01 2000-01-24_22:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 645.000000
+ d01 2000-01-24_22:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:45:00
+ d01 2000-01-24_22:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:45:00
+ d01 2000-01-24_22:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:045:000
+ d01 2000-01-24_22:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000216
+ d01 2000-01-24_22:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.950001
+ d01 2000-01-24_22:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 648.000000
+ d01 2000-01-24_22:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:48:00
+ d01 2000-01-24_22:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:48:00
+ d01 2000-01-24_22:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:048:000
+ d01 2000-01-24_22:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000217
+ d01 2000-01-24_22:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.952084
+ d01 2000-01-24_22:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 651.000000
+ d01 2000-01-24_22:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:51:00
+ d01 2000-01-24_22:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:51:00
+ d01 2000-01-24_22:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:051:000
+ d01 2000-01-24_22:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000218
+ d01 2000-01-24_22:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.954166
+ d01 2000-01-24_22:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 654.000000
+ d01 2000-01-24_22:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:54:00
+ d01 2000-01-24_22:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:54:00
+ d01 2000-01-24_22:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:054:000
+ d01 2000-01-24_22:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000219
+ d01 2000-01-24_22:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.956249
+ d01 2000-01-24_22:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 657.000000
+ d01 2000-01-24_22:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_22:57:00
+ d01 2000-01-24_22:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_22:57:00
+ d01 2000-01-24_22:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_010:057:000
+ d01 2000-01-24_23:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000220
+ d01 2000-01-24_23:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.958334
+ d01 2000-01-24_23:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 660.000000
+ d01 2000-01-24_23:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:00:00
+ d01 2000-01-24_23:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:00:00
+ d01 2000-01-24_23:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:000:000
+ d01 2000-01-24_23:03:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000221
+ d01 2000-01-24_23:03:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.960417
+ d01 2000-01-24_23:03:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 663.000000
+ d01 2000-01-24_23:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:03:00
+ d01 2000-01-24_23:03:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:03:00
+ d01 2000-01-24_23:03:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:003:000
+ d01 2000-01-24_23:06:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000222
+ d01 2000-01-24_23:06:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.962500
+ d01 2000-01-24_23:06:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 666.000000
+ d01 2000-01-24_23:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:06:00
+ d01 2000-01-24_23:06:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:06:00
+ d01 2000-01-24_23:06:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:006:000
+ d01 2000-01-24_23:09:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000223
+ d01 2000-01-24_23:09:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.964582
+ d01 2000-01-24_23:09:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 669.000000
+ d01 2000-01-24_23:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:09:00
+ d01 2000-01-24_23:09:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:09:00
+ d01 2000-01-24_23:09:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:009:000
+ d01 2000-01-24_23:12:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000224
+ d01 2000-01-24_23:12:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.966667
+ d01 2000-01-24_23:12:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 672.000000
+ d01 2000-01-24_23:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:12:00
+ d01 2000-01-24_23:12:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:12:00
+ d01 2000-01-24_23:12:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:012:000
+ d01 2000-01-24_23:15:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000225
+ d01 2000-01-24_23:15:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.968750
+ d01 2000-01-24_23:15:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 675.000000
+ d01 2000-01-24_23:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:15:00
+ d01 2000-01-24_23:15:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:15:00
+ d01 2000-01-24_23:15:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:015:000
+ d01 2000-01-24_23:18:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000226
+ d01 2000-01-24_23:18:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.970833
+ d01 2000-01-24_23:18:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 678.000000
+ d01 2000-01-24_23:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:18:00
+ d01 2000-01-24_23:18:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:18:00
+ d01 2000-01-24_23:18:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:018:000
+ d01 2000-01-24_23:21:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000227
+ d01 2000-01-24_23:21:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.972918
+ d01 2000-01-24_23:21:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 681.000000
+ d01 2000-01-24_23:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:21:00
+ d01 2000-01-24_23:21:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:21:00
+ d01 2000-01-24_23:21:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:021:000
+ d01 2000-01-24_23:24:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000228
+ d01 2000-01-24_23:24:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.975000
+ d01 2000-01-24_23:24:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 684.000000
+ d01 2000-01-24_23:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:24:00
+ d01 2000-01-24_23:24:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:24:00
+ d01 2000-01-24_23:24:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:024:000
+ d01 2000-01-24_23:27:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000229
+ d01 2000-01-24_23:27:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.977083
+ d01 2000-01-24_23:27:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 687.000000
+ d01 2000-01-24_23:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:27:00
+ d01 2000-01-24_23:27:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:27:00
+ d01 2000-01-24_23:27:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:027:000
+ d01 2000-01-24_23:30:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000230
+ d01 2000-01-24_23:30:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.979166
+ d01 2000-01-24_23:30:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 690.000000
+ d01 2000-01-24_23:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:30:00
+ d01 2000-01-24_23:30:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:30:00
+ d01 2000-01-24_23:30:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:030:000
+ d01 2000-01-24_23:33:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000231
+ d01 2000-01-24_23:33:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.981251
+ d01 2000-01-24_23:33:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 693.000000
+ d01 2000-01-24_23:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:33:00
+ d01 2000-01-24_23:33:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:33:00
+ d01 2000-01-24_23:33:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:033:000
+ d01 2000-01-24_23:36:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000232
+ d01 2000-01-24_23:36:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.983334
+ d01 2000-01-24_23:36:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 696.000000
+ d01 2000-01-24_23:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:36:00
+ d01 2000-01-24_23:36:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:36:00
+ d01 2000-01-24_23:36:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:036:000
+ d01 2000-01-24_23:39:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000233
+ d01 2000-01-24_23:39:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.985416
+ d01 2000-01-24_23:39:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 699.000000
+ d01 2000-01-24_23:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:39:00
+ d01 2000-01-24_23:39:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:39:00
+ d01 2000-01-24_23:39:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:039:000
+ d01 2000-01-24_23:42:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000234
+ d01 2000-01-24_23:42:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.987499
+ d01 2000-01-24_23:42:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 702.000000
+ d01 2000-01-24_23:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:42:00
+ d01 2000-01-24_23:42:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:42:00
+ d01 2000-01-24_23:42:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:042:000
+ d01 2000-01-24_23:45:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000235
+ d01 2000-01-24_23:45:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.989584
+ d01 2000-01-24_23:45:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 705.000000
+ d01 2000-01-24_23:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:45:00
+ d01 2000-01-24_23:45:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:45:00
+ d01 2000-01-24_23:45:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:045:000
+ d01 2000-01-24_23:48:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000236
+ d01 2000-01-24_23:48:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.991667
+ d01 2000-01-24_23:48:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 708.000000
+ d01 2000-01-24_23:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:48:00
+ d01 2000-01-24_23:48:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:48:00
+ d01 2000-01-24_23:48:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:048:000
+ d01 2000-01-24_23:51:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000237
+ d01 2000-01-24_23:51:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.993750
+ d01 2000-01-24_23:51:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 711.000000
+ d01 2000-01-24_23:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:51:00
+ d01 2000-01-24_23:51:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:51:00
+ d01 2000-01-24_23:51:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:051:000
+ d01 2000-01-24_23:54:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000238
+ d01 2000-01-24_23:54:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.995832
+ d01 2000-01-24_23:54:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 714.000000
+ d01 2000-01-24_23:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:54:00
+ d01 2000-01-24_23:54:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:54:00
+ d01 2000-01-24_23:54:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:054:000
+ d01 2000-01-24_23:57:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000239
+ d01 2000-01-24_23:57:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  23.997917
+ d01 2000-01-24_23:57:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 717.000000
+ d01 2000-01-24_23:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-24_23:57:00
+ d01 2000-01-24_23:57:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-24_23:57:00
+ d01 2000-01-24_23:57:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_011:057:000
+ d01 2000-01-25_00:00:00 DOMAIN_TIME_TEST domain_clockadvance:  advanceCount = 00000240
+ d01 2000-01-25_00:00:00 DOMAIN_TIME_TEST domain_clockadvance:  currentDayOfYearReal =  24.000000
+ d01 2000-01-25_00:00:00 DOMAIN_TIME_TEST domain_clockadvance:  minutesSinceSimulationStart = 720.000000
+ d01 2000-01-25_00:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr = 2000-01-25_00:00:00
+ d01 2000-01-25_00:00:00 DOMAIN_TIME_TEST domain_clockadvance:  current_timestr_frac = 2000-01-25_00:00:00
+ d01 2000-01-25_00:00:00 DOMAIN_TIME_TEST domain_clockadvance:  timeSinceSimulationStart = 0000000000_012:000:000
Index: trunk/WRF.COMMON/WRFV2/tools/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/Makefile	(revision 2744)
@@ -0,0 +1,44 @@
+.SUFFIXES: .c .o
+
+CC = cc
+CFLAGS = #-ansi
+LDFLAGS =
+DEBUG = -g 
+OBJ = registry.o my_strtok.o reg_parse.o data.o type.o misc.o \
+      gen_defs.o gen_allocs.o gen_mod_state_descr.o gen_scalar_indices.o \
+      gen_args.o gen_config.o sym.o symtab_gen.o gen_wrf_io.o \
+      gen_model_data_ord.o gen_interp.o gen_comms.o gen_scalar_derefs.o
+
+registry : $(OBJ)
+	$(CC) -o registry $(DEBUG) $(LDFLAGS) $(OBJ)
+
+.c.o :
+	$(CC) $(CFLAGS) -c $(DEBUG) $<
+
+clean:
+	/bin/rm -f $(OBJ) gen_comms.c
+
+gen_comms.c : gen_comms.stub
+	/bin/cp gen_comms.stub gen_comms.c
+
+# regenerate this list with "makedepend -Y *.c"
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+
+data.o: registry.h protos.h data.h
+gen_allocs.o: protos.h registry.h data.h
+gen_args.o: protos.h registry.h data.h
+gen_scalar_derefs.o: protos.h registry.h data.h
+gen_config.o: protos.h registry.h data.h
+gen_defs.o: protos.h registry.h data.h
+gen_mod_state_descr.o: protos.h registry.h data.h
+gen_model_data_ord.o: protos.h registry.h data.h
+gen_scalar_indices.o: protos.h registry.h data.h
+gen_wrf_io.o: protos.h registry.h data.h
+misc.o: protos.h registry.h data.h
+my_strtok.o: registry.h protos.h data.h
+reg_parse.o: registry.h protos.h data.h
+registry.o: protos.h registry.h data.h
+sym.o: sym.h
+type.o: registry.h protos.h data.h
+gen_interp.o: registry.h protos.h data.h
Index: trunk/WRF.COMMON/WRFV2/tools/all_reg.csh
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/all_reg.csh	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/all_reg.csh	(revision 2744)
@@ -0,0 +1,583 @@
+#!/bin/csh
+unalias rm
+unalias cp
+unalias mv
+
+#       This script runs a large number of WRF regression tests.  On the
+#       IBM machines (which at NCAR allow queueing), the jobs are sent to
+#       the queue system via load leveler commands.  On all other machines,
+#       the jobs are sent in sequentially as soon as the process returns 
+#       from completing the previous task.
+
+#       HOW TO RUN
+#       ----------
+
+#       DEC
+#       joshua1 or joshua3
+#       mkdir /data3/mp/$USER/`hostname`
+#       put all_reg.csh, regtest.csh, and wrf.tar in dir
+#       execute all_reg.csh
+#       takes about 24-30 h
+
+#       Linux
+#       joshua1 or joshua3
+#       mkdir /data3/mp/$USER/`hostname`
+#       put all_reg.csh, regtest.csh, and wrf.tar in dir
+#       execute all_reg.csh
+#       takes about 36-48 h
+#	flex lm errors show up as fails to compile
+
+#       AIX
+#       bluesky or bluevista
+#       put all_reg.csh, regtest.csh, and wrf.tar in ~
+#       execute all_reg.csh
+#       takes about 8-10 h
+
+#       Unless you are editing the script, no changes are required below
+
+
+#=======================================================================
+#=======================================================================
+
+#       What these tests do, must be a single string.
+
+set NAME     = ( "Standard"             "NESTED=FALSE"        "NESTED=FALSE"        "NONE"  	1	\
+                 "Moving_Nest"          "NESTED=FALSE"        "NESTED=TRUE"         "NONE"  	2	\
+                 "Full_Optimization"    "REG_TYPE=BIT4BIT"    "REG_TYPE=OPTIMIZED"  "NONE"  	3	\
+                 "Chemistry"            "CHEM=FALSE"          "CHEM=TRUE"           "NONE"  	4	\
+                 "RSL_LITE"             "RSL_LITE=FALSE"      "RSL_LITE=TRUE"       "NONE"  	5	\
+                 "ESMF_Library"         "ESMF_LIB=FALSE"      "ESMF_LIB=TRUE"       "ONLY_AIX"  6	\
+                 "Quilting"             "QUILT=FALSE"         "QUILT=TRUE"          "NONE"  	7	\
+                 "Binary_IO"            "IO_FORM=2"           "IO_FORM=1"           "NONE"  	8	\
+                 "GriB1_Output"         "IO_FORM=2"           "IO_FORM=5"           "NONE"  	9	\
+                 "REAL8_Floats"         "REAL8=FALSE"         "REAL8=TRUE"          "NONE"  	10	\
+                 "Moving_Nest2"         "COMBO_NEST_RSL__LITE=FALSE" \
+                                                              "COMBO_NEST_RSL__LITE=TRUE"  \
+                                                                                    "NONE"  	11	\
+                 "FDDA"                 "FDDA=FALSE"          "FDDA=TRUE"           "NONE"  	12	\
+               )
+
+#	Where are we located.
+
+set starting_dir = `pwd`
+
+#	Get the tag manually.  This is for the auto-report that gets
+#	sent to the WRF web page on the history of the regression tests.
+
+set current_year4  = `date -u +"%Y"`
+set current_month  = `date -u +"%m"`
+set current_day    = `date -u +"%d"`
+set current_hour   = `date -u +"%H"`
+set current_minute = `date -u +"%M"`
+set current_second = `date -u +"%S"`
+set datehms        = ${current_year4}-${current_month}-${current_day}_${current_hour}:${current_minute}:${current_second}_UTC
+set dateh          = ${current_year4}${current_month}${current_day}${current_hour}
+set date           = ${current_year4}${current_month}${current_day}
+if ( ! $?TAG ) then
+	if      ( $user == michalak ) then
+		set initials = jm
+	else if ( $user == hender   ) then
+		set initials = th
+	else if ( $user == gill     ) then
+		set initials = dg
+	else if ( $user == dudhia   ) then
+		set initials = jd
+	else if ( $user == weiwang  ) then
+		set initials = ww
+	else
+		set initials = XX
+	endif
+	echo the TAG is NOT defined
+	echo Please define an environment variable that is the WRFV2 tag
+	echo Something such as: setenv TAG trunk_${date}_${initials}
+	echo " " 
+	exit ( 1 )
+endif
+
+#	Are we only interested in the PASS/FAIL report?
+
+if ( $#argv == 1 ) then
+	if ( $argv[1] == PASSFAIL ) then
+		goto PASSFAIL
+	endif
+endif
+
+#	If there are any command line args, they are processed, else
+#	we run all of the regression tests without a generate or
+#	compare flag being set.
+
+if ( $#argv == 0 ) then
+
+	set BASELINE = RUN_ONLY
+
+        set OLD_TEXT
+        set NEW_TEXT
+        set TOAST
+        set tests
+	set TEST_NUM
+	set count_test = 1
+        while ( $count_test < $#NAME )
+		set tests =  ( $tests "$NAME[$count_test]" )
+		@ count_test ++
+                set OLD_TEXT = ( $OLD_TEXT "$NAME[$count_test]" ) 
+		@ count_test ++
+                set NEW_TEXT = ( $NEW_TEXT "$NAME[$count_test]" ) 
+		@ count_test ++
+                set TOAST    = ( $TOAST "$NAME[$count_test]" ) 
+		@ count_test ++
+                set TEST_NUM = ( $TEST_NUM "$NAME[$count_test]" ) 
+		@ count_test ++
+	end
+
+#	We have some command line args.  They are either a request to run 
+#	the test with a generate/compare flag, or a list of tests to perform.
+
+else
+
+	set INIT_OPTS = ( $* )
+
+	#	First, find the baseline type.  This is going to be one of three
+	#	possibilities: GENERATE, COMPARE, or a RUN_ONLY option.  The
+	#	default is RUN_ONLY.  Only the first baseline option found is
+	#	used.
+
+	set count = 0 
+	while ( $count < $#INIT_OPTS )
+		@ count ++
+		set arg = $INIT_OPTS[$count]
+		if ( ( $arg == GENERATE ) || \
+		     ( $arg == COMPARE  ) || \
+		     ( $arg == RUN_ONLY ) ) then
+			set BASELINE = $arg
+			goto FINISHED_BASELINE_TYPE
+		endif
+	end
+	set BASELINE = RUN_ONLY
+FINISHED_BASELINE_TYPE:
+
+	#	If there was only one input, and it was telling us to do which type of baseline
+	#	option (GENERATE, COMPARE, RUN_ONLY), we assume they want all of the tests
+	#	conducted.
+
+	if ( $#INIT_OPTS == 1 ) then
+		if ( ( $INIT_OPTS == GENERATE ) || ( $INIT_OPTS == COMPARE  ) || ( $INIT_OPTS == RUN_ONLY ) ) then
+		        set OLD_TEXT
+		        set NEW_TEXT
+		        set TOAST
+		        set tests
+			set TEST_NUM
+			set count_test = 1
+		        while ( $count_test < $#NAME )
+				set tests =  ( $tests "$NAME[$count_test]" )
+				@ count_test ++
+		                set OLD_TEXT = ( $OLD_TEXT "$NAME[$count_test]" ) 
+				@ count_test ++
+		                set NEW_TEXT = ( $NEW_TEXT "$NAME[$count_test]" ) 
+				@ count_test ++
+		                set TOAST    = ( $TOAST "$NAME[$count_test]" ) 
+				@ count_test ++
+				set TEST_NUM = ( $TEST_NUM "$NAME[$count_test]" ) 
+				@ count_test ++
+			end
+			goto FINISHED_TEST_LIST
+		endif
+	endif
+
+	#	Find which tests are to be conducted.  Loop over all of the
+	#	input, and compare each of the input fields with the list
+	#	of available test names.  When a match occurs, increment the
+	#	test found counter, and save the test name.
+
+	set count = 0 
+        set OLD_TEXT
+        set NEW_TEXT
+        set TOAST
+        set tests
+	set TEST_NUM
+	while ( $count < $#INIT_OPTS ) 
+		@ count ++
+	        set count_test = 1
+                while ( $count_test < $#NAME )
+			if ( $INIT_OPTS[$count] == $NAME[$count_test] ) then
+				set tests =  ( $tests "$NAME[$count_test]" )
+				@ count_test ++
+				set OLD_TEXT = ( $OLD_TEXT "$NAME[$count_test]" )
+				@ count_test ++
+				set NEW_TEXT = ( $NEW_TEXT "$NAME[$count_test]" )
+				@ count_test ++
+				set TOAST    = ( $TOAST "$NAME[$count_test]" )
+				@ count_test ++
+				set TEST_NUM = ( $TEST_NUM "$NAME[$count_test]" ) 
+				@ count_test ++
+                        else
+				@ count_test += 5
+			endif
+		end
+	end
+
+	#	If there are no recognizable tests requested, let them know our concern.
+	
+	if ( $#tests == 0 ) then
+                echo No valid test requested in argument list
+                exit ( 4 ) 
+	endif
+endif
+FINISHED_TEST_LIST:
+
+#	A friendly check for the baseline directory existence, and locations for known
+#	NCAR machines.
+
+if ( ( $BASELINE == GENERATE ) || ( $BASELINE == COMPARE ) ) then
+	if ( ( `uname` == AIX ) && ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) ) then
+		set SAVE_DIR = /ptmp/${USER}/BASELINE/`uname`
+	else if   ( `uname` == AIX ) then
+		set SAVE_DIR = /ptmp/${USER}/BASELINE/`uname`
+	else if ( ( `uname` == OSF1 ) && ( `hostname | cut -c 1-6` == joshua ) ) then
+		set SAVE_DIR = /data3/mp/${USER}/BASELINE/`uname`
+	else if ( ( `uname` == Linux ) && ( `hostname` == bay-mmm ) ) then
+		set SAVE_DIR = /data3/mp/${USER}/BASELINE/`uname`
+	else
+		echo Hmm, no idea where to put/get this baseline data, stopping
+		exit ( 10 )
+	endif
+
+	if      ( (   -d $SAVE_DIR ) && ( $BASELINE == GENERATE ) ) then
+		echo "Troubles with SAVE_DIR logic."
+		echo "$SAVE_DIR should not exist for a $BASELINE run."
+#	exit ( 2 )
+	else if ( ( ! -d $SAVE_DIR ) && ( $BASELINE == COMPARE  ) ) then
+		echo "Troubles with SAVE_DIR logic."
+		echo "$SAVE_DIR should exist for a $BASELINE run."
+		exit ( 3 )
+	endif
+endif
+
+#	We need the regtest.csh file, badly.
+
+if ( ! -e regtest.csh ) then
+	echo we need regtest.csh in this dir
+	echo "supply-ez vous, s'il vous plait"
+	exit ( 1 )
+endif
+
+#	The regtest.csh file is treated as a template.  The following
+#	strings (first occurrence) is sought (OLD_TEXT) and replaced
+#	with the modified string (NEW_TEXT).  This edited regression 
+#	script is then processed.
+
+#	Any exceptions to where they can run?  NONE means no 
+#	exceptions, should run on all machines.  AIX/Linux/OSF1
+#	means it will NOT run on that single machine.  The 
+#	option ONLY_AIX/ONLY_Linux/ONLY_OSF1 means that the option
+#	ONLY works on that specific architecture.
+
+
+#	Loop over all selected tests.
+
+set count_test = 0
+while ( $count_test < $#tests )
+
+	@ count_test ++
+
+	set count = 1 
+	while ( $count < $#NAME )
+
+	    if ( "$tests[$count_test]" == "$NAME[$count]" ) then
+		    goto FOUND_SELECTED_TEST
+	    endif
+	    @ count += 5
+	end
+	echo "Hmmm, no valid test found"
+	exit ( 11 )
+
+FOUND_SELECTED_TEST:
+
+	#	Specifically skip this test on this architecture.
+
+	if      ( `uname` == $TOAST[$count_test] ) then
+		echo skipping test $tests[$count_test] for `uname` specifically
+
+	#	Skip this test on this architecture because it ONLY runs
+	#	on a different architecture.
+
+	else if ( ( `echo $TOAST[$count_test] | cut -c 1-5` == ONLY_ ) && ( ONLY_`uname` != $TOAST[$count_test] ) ) then
+		echo skipping test $tests[$count_test] for `uname`, works on $TOAST[$count_test]
+
+	#	OK, we are allowed to run this test on this architecture.
+
+	else if ( ( $TOAST[$count_test] == NONE ) || \
+		  ( $TOAST[$count_test] != `uname` ) || \
+		  ( ONLY_`uname` ==  $TOAST[$count_test] ) ) then
+		echo doing test $tests[$count_test] for `uname`
+
+		#	If this is the generate or compare baseline test, where do we
+		#	save the data to/read the data from.
+
+		if ( ( $BASELINE == GENERATE ) || ( $BASELINE == COMPARE ) ) then
+			if ( ( `uname` == AIX ) && ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) ) then
+				set SAVE_DIR = /ptmp/${USER}/BASELINE/`uname`/$tests[$count_test]
+			else if   ( `uname` == AIX ) then
+				set SAVE_DIR = /ptmp/${USER}/BASELINE/`uname`/$tests[$count_test]
+			else if ( ( `uname` == OSF1 ) && ( `hostname | cut -c 1-6` == joshua ) ) then
+				set SAVE_DIR = /data3/mp/${USER}/BASELINE/`uname`/$tests[$count_test]
+			else if ( ( `uname` == Linux ) && ( `hostname` == bay-mmm ) ) then
+				set SAVE_DIR = /data3/mp/${USER}/BASELINE/`uname`/$tests[$count_test]
+			else
+				echo No idea where to put the data, stopping
+				exit ( 2 )
+			endif
+
+			#	Either zap existing stuff (GENERATE), or make sure it is there (COMPARE)
+
+			if        ( $BASELINE == GENERATE ) then
+				/bin/rm -rf $SAVE_DIR
+			else if ( ( $BASELINE == COMPARE  )  && ( $tests[$count_test] != Full_Optimization ) ) then
+				if ( ! -d $SAVE_DIR ) then
+					echo $SAVE_DIR does not exist for BASELINE comparison, stopping
+					exit ( 3 )
+				endif
+			else if ( ( $BASELINE == COMPARE  )  && ( $tests[$count_test] == Full_Optimization ) ) then
+				echo No comparison done with baseline since this is an optimized run
+			endif
+		endif
+
+		#	Build the short edit input script for ed and edit the regtest.csh file.
+
+                set OLDT = `echo $OLD_TEXT[$count_test] | sed 's/=/ = /'`
+                set NEWT = `echo $NEW_TEXT[$count_test] | sed 's/=/ = /'`
+
+		if      ( ( $BASELINE == RUN_ONLY ) || ( $tests[$count_test] == Full_Optimization ) ) then
+			if ( -e ed.in ) rm ed.in
+			cat >! ed_in << EOF
+,s/$OLDT/$NEWT/
+w reg.foo.$TEST_NUM[$count_test].$tests[$count_test]
+q
+EOF
+		else if ( $BASELINE == GENERATE ) then
+			if ( -e ed.in ) rm ed.in
+			cat >! ed_in << EOF
+,s/$OLDT/$NEWT/
+,s?GENERATE_BASELINE = FALSE?GENERATE_BASELINE = $SAVE_DIR?
+w reg.foo.$TEST_NUM[$count_test].$tests[$count_test]
+q
+EOF
+		else if ( $BASELINE == COMPARE  ) then
+			if ( -e ed.in ) rm ed.in
+			cat >! ed_in << EOF
+,s/$OLDT/$NEWT/
+,s?COMPARE_BASELINE = FALSE?COMPARE_BASELINE = $SAVE_DIR?
+w reg.foo.$TEST_NUM[$count_test].$tests[$count_test]
+q
+EOF
+		endif
+		ed regtest.csh < ed_in >& /dev/null
+		chmod +x reg.foo.$TEST_NUM[$count_test].$tests[$count_test]
+
+		#	On AIX, we submit jobs to the load leveler queue for bluesky and to the LSF queue for 
+		#	bluevista.  After submission, we wait around until it completes, and then we send in 
+		#	the next one.
+
+		if      ( ( `uname` == AIX ) && ( `hostname | cut -c 1-2` == bs   ) ) then
+			llsubmit reg.foo.$TEST_NUM[$count_test].$tests[$count_test] >&! llsub.out
+			set ok = 0
+			set in_already = 0
+			while ( $ok == 0 )
+				sleep 10 ; llq -u $USER >&! llq.report
+				grep `cat llsub.out | grep '"bs1' | cut -d\" -f2` llq.report >& /dev/null
+				set ok = $status
+				if ( ( $ok == 0 ) && ( $in_already == 0 ) ) then
+					set in_already = 1
+					set joe_id = `cat llsub.out | grep '"bs1' | cut -d\" -f2 | cut -d. -f2`
+				endif
+			end
+			cp /ptmp/$USER/wrf_regression.$joe_id/wrftest.output wrftest.output.$TEST_NUM[$count_test].$tests[$count_test]
+			rm llsub.out llq.report
+		else if ( ( `uname` == AIX ) && ( `hostname | cut -c 1-2` == bv ) ) then
+			bsub < reg.foo.$TEST_NUM[$count_test].$tests[$count_test] >&! bsub.out
+			set ok = 0
+			set in_already = 0
+			while ( $ok == 0 )
+				sleep 10 ; bjobs >&! bjobs.report
+				grep `cat bsub.out | grep Job | cut -d"<" -f2 | cut -d">" -f1` bjobs.report >& /dev/null
+				set ok = $status
+				if ( ( $ok == 0 ) && ( $in_already == 0 ) ) then
+					set in_already = 1
+					set joe_id = `cat bsub.out | grep Job | cut -d"<" -f2 | cut -d">" -f1`
+				endif
+			end
+			cp /ptmp/$USER/wrf_regression.$joe_id/wrftest.output wrftest.output.$TEST_NUM[$count_test].$tests[$count_test]
+			rm bsub.out bjobs.report
+		else if ( ( `uname` == AIX ) && ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) ) then
+			llsubmit reg.foo.$TEST_NUM[$count_test].$tests[$count_test] >&! llsub.out
+			set ok = 0
+			set in_already = 0
+			while ( $ok == 0 )
+				sleep 10 ; llq -u $USER >&! llq.report
+				set llsubmit_name_all   = `cat llsub.out  | grep '"b'  | cut -d\" -f2`
+				set llsubmit_name_front = `echo $llsubmit_name_all | cut -d\. -f1`
+				set llsubmit_name_end   = `echo $llsubmit_name_all | cut -d\. -f5`
+				grep $llsubmit_name_front llq.report | grep $llsubmit_name_end >& /dev/null
+				set ok = $status
+				if ( ( $ok == 0 ) && ( $in_already == 0 ) ) then
+					set in_already = 1
+					set joe_id = `cat llsub.out | grep '"b'  | cut -d\" -f2 | cut -d. -f5`
+				endif
+			end
+			cp /ptmp/$USER/wrf_regression.$joe_id/wrftest.output wrftest.output.$TEST_NUM[$count_test].$tests[$count_test]
+			rm llsub.out llq.report
+
+		#	On the "other" non-queued machines, we just execute the script and wait until
+		#	we get the process returning control, then we move on.
+
+		else
+			reg.foo.$TEST_NUM[$count_test].$tests[$count_test] -f wrf.tar # >&! output.$TEST_NUM[$count_test].$tests[$count_test]
+			mv wrftest.output wrftest.output.$TEST_NUM[$count_test].$tests[$count_test]
+#			if ( $NUM_TESTS != $#NAME ) then
+#				if ( -d regression_test ) rm -rf regression_test
+#			else
+				if ( -d regression_test ) then
+					mv regression_test regression_test.$TEST_NUM[$count_test].$tests[$count_test]
+				endif
+#			endif
+		endif
+	endif
+end
+
+if ( ( `uname` == AIX ) && ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) ) then
+	echo no web page building, stopping
+	exit
+endif
+
+PASSFAIL:
+
+#	Build the html page.  We only need the middle portion.  It's
+#	a table with 5 columns: Date of test, WRFV2 tag, Developer
+#	who conducted the test, machine the test was run on, and the
+#	pass/fail status of the all_reg.csh script when comapred
+#	to the benchmark results (usually a released code).
+
+cat >! history_middle_OK.html << EOF
+<tr>
+<td> XDATEX </td>
+<td> XTAGX </td>
+<td> XTESTERX </td>
+<td> XARCHITECTUREX </td>
+<td BGCOLOR="#00FF00"><a href="ARCHITECTURE/wrftest.all_${datehms}">PASS</a>
+                      <a href="ARCHITECTURE/message_${datehms}">DIFFS</a></td>
+<td>
+<!--
+<a href="other_docs/${date}_notes">Descriptions</a>
+<a href="other_docs/${date}_minutes">Minutes</a>
+-->
+</td>
+</tr>
+EOF
+
+cat >! history_middle_OOPS.html << EOF
+<tr>
+<td> XDATEX </td>
+<td> XTAGX </td>
+<td> XTESTERX </td>
+<td> XARCHITECTUREX </td>
+<td BGCOLOR="#FF0000"><a href="ARCHITECTURE/wrftest.all_${datehms}">FAIL</a>
+                      <a href="ARCHITECTURE/message_${datehms}">DIFFS</a></td>
+<td>
+<!--
+<a href="other_docs/${date}_notes">Descriptions</a>
+<a href="other_docs/${date}_minutes">Minutes</a>
+-->
+</td>
+</tr>
+EOF
+
+set name = `uname`
+cat >! ed2.in << EOF
+,s/ARCHITECTURE/${name}/g
+w history_middle.html
+q
+EOF
+
+#	Get all of the wrftest.output.* files in one BIG file.
+
+if ( -e wrftest.all_$datehms ) rm wrftest.all_$datehms
+cat wrftest.output.?.* wrftest.output.??.* >>! wrftest.all_$datehms
+if ( -d `uname` ) rm -rf `uname`
+mkdir `uname`
+mv wrftest.all_$datehms `uname`
+
+#	Compare regression PASS/FAILs with previous runs.
+
+pushd ~gill/RESULTS/`uname`
+grep FAIL wrftest.output.* >! ${starting_dir}/PREV.FAILS
+popd
+grep FAIL wrftest.output.* >! CURR.FAILS
+echo Comparison of regression results on `hostname` for `date` >! message
+echo "==================================================================" >> message
+echo "     " >> message
+echo "Previous FAILs" >> message
+echo "==================" >> message
+echo "     " >> message
+cat PREV.FAILS >> message
+echo "     " >> message
+echo "Current FAILs" >> message
+echo "==================" >> message
+echo "     " >> message
+cat CURR.FAILS >> message
+echo "     " >> message
+echo "Difference of FAILs" >> message
+echo "==================" >> message
+echo "     " >> message
+cat CURR.FAILS | grep -vi baseline >! CURR2.FAILS
+diff PREV.FAILS CURR2.FAILS >! diffs
+set ok = $status
+cat diffs >> message
+echo "     " >> message
+cp message message_$datehms
+mv message_$datehms `uname`
+
+#	Send out status info on the regression test.
+
+set OS = `uname`
+set NUMARGS = $#argv
+if ( $#argv != 0 ) then
+	set ARG1 = $argv[1]
+else
+	set ARG1 = BLANK
+endif
+
+if ( ( $NUMARGS == 0 ) || ( $ARG1 == PASSFAIL ) || \
+     ( ( $ARG1 == COMPARE  ) && ( $NUMARGS == 1 ) ) || \
+     ( ( $ARG1 == GENERATE ) && ( $NUMARGS == 1 ) ) ) then
+	if ( $ok != 0 ) then
+		Mail -s "REG DIFFS $OS" ${user}@ucar.edu < message
+		echo "   "
+		echo "Different FAILS from before for $OS - repository may have been broken"
+		echo "   "
+		m4 -DXDATEX=${dateh} -DXTAGX=${TAG} -DXTESTERX=${user} -DXARCHITECTUREX=`uname` \
+			history_middle_OOPS.html >! history_middle_1.html
+	else if ( $ok == 0 ) then
+		Mail -s "REG OK $OS" ${user}@ucar.edu < message
+		echo "   "
+		echo "Same FAILS as before for $OS - repository OK"
+		echo "   "
+		m4 -DXDATEX=${dateh} -DXTAGX=${TAG} -DXTESTERX=${user} -DXARCHITECTUREX=`uname` \
+			history_middle_OK.html >! history_middle_1.html
+	endif
+	
+	#	Store on the NCAR MSS system to circumvent security.
+	
+	ed history_middle_1.html < ed2.in >& /dev/null
+	tar -cf `uname`_hist.tar history_middle.html `uname`
+	echo Storing info on NCAR MSS
+	msrcp `uname`_hist.tar mss:/GILL/ALLREG/`uname`_hist.tar
+	if ( -e `uname`_NEW ) rm `uname`_NEW
+	echo "`uname` `date`" >! `uname`_NEW
+	msrcp `uname`_NEW mss:/GILL/ALLREG/`uname`_NEW
+endif
+
+rm ed_in >& /dev/null
+rm io_format >& /dev/null
+rm PREV.FAILS CURR.FAILS CURR2.FAILS message diffs >& /dev/null
+rm history_middle_OOPS.html history_middle_OK.html history_middle_1.html history_middle.html >& /dev/null
+rm `uname`_hist.tar `uname`_NEW ed2.in >& /dev/null
+rm -rf `uname` >& /dev/null
Index: trunk/WRF.COMMON/WRFV2/tools/build_codebase
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/build_codebase	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/build_codebase	(revision 2744)
@@ -0,0 +1,112 @@
+#!/bin/csh
+
+
+set db=tools/code_dbase
+
+#goto skippy
+#goto sk1
+# set this to a value to speed up the subinfo calls; set with no value for normal
+set gofast       # default is not fast (no value given, but set)
+
+if ( $#argv == 1 ) then
+   if (  $argv[1] == "fast" ) then
+      set gofast=yes
+   endif
+endif
+
+if ( ! -d tools ) then
+  echo run $0 in top level WRF directory
+endif
+if ( ! -x tools/deftab || ! -x tools/nocontf90 || ! -x tools/subinfo_calls || ! -x tools/callgraph ) then
+  ( cd tools/CodeBase ; make )
+  if ( ! -x tools/deftab || ! -x tools/nocontf90 || ! -x tools/subinfo_calls || ! -x tools/callgraph ) then
+    echo some error building the tools in tools/CodeBase. Cannot continue.
+    exit(2)
+  endif
+endif
+
+/bin/rm -fr $db
+mkdir $db
+
+if ( ! -f frame/module_state_description.f ) then
+  echo
+  echo '*** ' code must be compiled first before code database can be built
+  echo '*** ' because it is based on the .f files 
+  echo
+  exit(99)
+endif
+set dirs=( dyn_em frame main phys share )
+#set dirs=( dyn_nmm frame main phys share )
+#set dirs=( phys )
+#set dirs=( main )
+foreach d ( $dirs )
+  foreach f ( $d/*.f )
+    set ff=$f:t
+    echo $f
+    tools/nocontf90 < $f | expand |  \
+           sed                       \
+               -e 's/  */ /g'        \
+               -e 's/^ //'           \
+               -e '/^$/d'            \
+               -e 's/^real,/real ,/' \
+               -e 's/^integer,/integer ,/' \
+               -e 's/^type(/type (/' \
+               -e 's/^logical,/logical ,/' \
+               > $db/lm_${f:t}_1
+    tools/deftab $f < $db/lm_${f:t}_1
+    /bin/rm -f $db/lm_${f:t}_1
+  end
+end
+
+cat -n $db/calls | sort -u +1  > xxx
+sort -n +0 -1 xxx | awk '{print $2 " " $3 " " $4}'  > $db/calls
+
+############ pre-compute the subinfo html entries ##########
+
+skippy:
+
+foreach f ( `/bin/ls -1 $db | grep -v '\.html' | grep -v calls | grep -v '^lm_' | grep -v '^vv_' | grep -v '_descrip$'` )
+  echo creating html file for $f
+  tools/subinfo $f $gofast > $db/$f.html
+end
+
+#foreach f ( `/bin/ls -1 $db/[a-f]* | grep -v '\.html' | grep -v calls | grep -v '^lm_'` )
+#  echo creating html file for $f
+#  tools/subinfo $f:t > $f.html
+#end
+#foreach f ( `/bin/ls -1 $db/[g-m]* | grep -v '\.html' | grep -v calls | grep -v '^lm_'` )
+#  echo creating html file for $f
+#  tools/subinfo $f:t > $f.html
+#end
+#foreach f ( `/bin/ls -1 $db/[n-t]* | grep -v '\.html' | grep -v calls | grep -v '^lm_'` )
+#  echo creating html file for $f
+#  tools/subinfo $f:t > $f.html
+#end
+#foreach f ( `/bin/ls -1 $db/[u-z]* | grep -v '\.html' | grep -v calls | grep -v '^lm_'` )
+#  echo creating html file for $f
+#  tools/subinfo $f:t > $f.html
+#end
+
+echo "Creating $db/index.html"
+
+/bin/cp tools/callgraph.page1      $db/callgraph.html
+tools/callgraph wrf 7           >> $db/callgraph.html
+cat      tools/callgraph.page2  >> $db/callgraph.html
+/bin/cp tools/index.page           $db/index.html
+/bin/cp tools/collapsd.gif tools/daughter.gif tools/exploded.gif $db 
+
+sk1:
+#tools/callgraph wrf 0                 > $db/index.html
+#echo ct2.html
+#tools/callgraph wrf 1                 > $db/ct2.html
+#echo ct3.html
+#tools/callgraph wrf 2                 > $db/ct3.html
+#echo ct4.html
+#tools/callgraph wrf 3                 > $db/ct4.html
+#echo ct5.html
+#tools/callgraph wrf 4                 > $db/ct5.html
+#echo ctall.html
+#tools/callgraph wrf                   > $db/ctall.html
+
+echo "Done"
+
Index: trunk/WRF.COMMON/WRFV2/tools/build_test.csh
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/build_test.csh	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/build_test.csh	(revision 2744)
@@ -0,0 +1,63 @@
+#!/bin/csh
+
+set root = data1
+set root = mmmtmp
+
+echo starting
+if ( ! -d /$root/${user} ) then
+	echo give me a break
+	exit ( 1 )
+endif
+cd /$root/${user}
+
+if ( ! -d /$root/${user}/`hostname` ) then
+	mkdir /$root/${user}/`hostname`
+endif
+cd /$root/${user}/`hostname`
+
+if ( ! -e /$root/${user}/wrfv2.tar ) then
+	echo need the wrf tar file
+	exit ( 2 )
+endif
+
+echo untar wrfv2
+tar -xf ../wrfv2.tar
+
+if      ( `uname` == SunOS ) then
+	set OPTS = ( 1   3   )
+else if ( ( `uname` == Linux ) && ( `hostname` == jacaranda ) ) then
+	set OPTS = ( 2       )
+else if ( `uname` == Linux ) then
+	set OPTS = ( 1 2 3   )
+else if ( `uname` == OSF1  ) then
+	set OPTS = ( 1 3 6   )
+endif
+
+foreach opt ( $OPTS )
+	cd /$root/${user}/`hostname`/WRFV2
+
+	foreach test ( em_real em_b_wave em_quarter_ss )
+		echo building $test for compiler option $opt `date`
+
+		clean -a >& /dev/null
+
+		echo "$opt" | ./configure >&! make.out.${test}.opt=${opt} 
+
+		compile $test >>& make.out.${test}.opt=${opt}
+
+		if ( $test == em_real ) then
+			if ( ( ! -e main/real.exe ) || ( ! -e main/wrf.exe ) ) then
+				echo missing $test executables
+				exit ( 3 )
+			endif
+		else
+			if ( ( ! -e main/ideal.exe ) || ( ! -e main/wrf.exe ) ) then
+				echo missing $test executables
+				exit ( 4 )
+			endif
+		endif
+		echo $test exec build OK `date`
+		echo " "
+
+	end
+end
Index: trunk/WRF.COMMON/WRFV2/tools/callgraph.page1
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/callgraph.page1	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/callgraph.page1	(revision 2744)
@@ -0,0 +1,36 @@
+<!-- Adapted from the example in chapter 18 of
+     Danny Goodman's "JavaScript Handbook", IDG Books, 1996.
+
+     -John Michalakes
+-->
+<HTML>
+<HEAD>
+<TITLE>Weather Research and Forecast Model</TITLE>
+<SCRIPT LANGUAGE="JavaScript">
+<!-- begin hiding
+
+// **functions that establish objects and environment**
+// basic array maker
+function makeArray(n) {
+	this.length = n
+        for ( var i = 1; i <= n ; i++ ) {
+          this[i] = 0
+        }
+	return this 
+}
+
+// object constructor for each outline entry
+// (see object-building calls, below)
+function dbRecord(mother,display,URL,indent){
+	this.mother = mother   // is this item a parent?
+	this.display = display // text to display
+	this.URL = URL         // link tied to text
+	this.indent = indent   // how deeply nested?
+	return this
+}
+
+// create object containing outline content and attributes
+// To adapt outline for your use, modify this table.  Make sure
+// that the size of the array (db[i]) is reflected in the call
+// to makeArray(i).  See the dbRecord() function, above, for the
+// meaning of the four parameters in each array entry.
Index: trunk/WRF.COMMON/WRFV2/tools/callgraph.page2
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/callgraph.page2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/callgraph.page2	(revision 2744)
@@ -0,0 +1,133 @@
+// set cookie data
+function setCurrState(setting) {
+	document.cookie = "currState=" + escape(setting)
+}
+
+// retrieve cookie data
+function getCurrState() {
+	var label = "currState="
+	var labelLen = label.length
+	var cLen = document.cookie.length
+	var i = 0
+	while (i < cLen) {
+		var j = i + labelLen
+		if (document.cookie.substring(i,j) == label) {
+			var cEnd = document.cookie.indexOf(";",j)
+			if (cEnd ==	-1) {
+				cEnd = document.cookie.length
+			}
+			return unescape(document.cookie.substring(j,cEnd))
+		} else {
+                        i = document.cookie.indexOf(";",j)
+                        if ( i == -1 ) {
+				i = document.cookie.length
+                        }
+                }
+	}
+	return ""
+}
+
+// **function that updates persistent storage of state**
+// toggles an outline mother entry, storing new value in the cookie
+function toggle(n) {
+	if (n != 0) {
+		var newString = ""
+		var currState = getCurrState() // of whole outline
+		var expanded = currState.substring(n-1,n) // of clicked item
+		newString += currState.substring(0,n-1)
+		newString += expanded ^ 1 // Bitwise XOR clicked item
+		newString += currState.substring(n,currState.length)
+		setCurrState(newString) // write new state back to cookie
+	}
+}
+
+// **functions used in assembling updated outline**
+// returns the proper GIF file name for each entry's control
+function getGIF(n) {
+	var mom = db[n].mother  // is entry a parent?
+	var expanded = getCurrState().substring(n-1,n) // of clicked item
+	if (!mom) {
+		return "daughter.gif"
+	} else {
+		if (expanded == 1) {
+			return "exploded.gif"
+		}
+	}
+	return "collapsd.gif"
+}
+
+// returns the proper status line text based on the icon style
+function getGIFStatus(n) {
+	var mom = db[n].mother  // is entry a parent
+	var expanded = getCurrState().substring(n-1,n) // of rolled item
+	if (!mom) {
+		return "No further items"
+	} else {
+		if (expanded == 1) {
+			return "Click to collapse nested items"
+		}
+	}
+	return "Click to expand nested items"
+}
+
+// returns padded spaces (in multiples of 3) for indenting
+function pad(n) {
+	var result = ""
+	for (var i = 1; i <= n; i++) {
+		result += "   "
+	}
+	return result
+}
+
+// initialize 'current state' storage field
+if (getCurrState() == "" || getCurrState().length != db.length) {
+	initState = "1"
+	for (i = 2; i <= db.length; i++) {
+		initState += "0"
+	}
+	setCurrState(initState)
+}
+
+// see if user is running a Mac browser for special case handling
+function isMac() {
+	return (navigator.userAgent.indexOf("Macintosh") >= 0) ? true :false
+}
+// end -->
+</SCRIPT>
+</HEAD>
+
+<BODY>
+<SCRIPT LANGUAGE="JavaScript">
+<!-- start
+// build new outline based on the values of the cookie
+// and data points in the outline data array.
+// This fires each time the user clicks on a control,
+// because the HREF for each one reloads the current document.
+var prevIndentDisplayed = 0
+var showMyDaughter = 0
+document.write( "<CENTER><H3>Call Tree</H3></CENTER><HR>" )
+var newOutline = "<PRE><H4>"   // let padded spaces make indents
+
+// cycle through each entry in the outline array
+for (var i = 1; i <= db.length; i++) {
+	var theGIF = getGIF(i)				// get the image
+	var theGIFStatus = getGIFStatus(i)  // get the status message
+	var currIndent = db[i].indent		// get the indent level
+	var expanded = getCurrState().substring(i-1,i) // current state
+	// display entry only if it meets one of three criteria
+	if (currIndent == 0 || currIndent <= prevIndentDisplayed || (showMyDaughter == 1 && (currIndent - prevIndentDisplayed == 1))) {
+		newOutline += pad(currIndent)
+		newOutline += "<A HREF=\"javascript:history.go(0)\" onMouseOver=\"window.parent.status=\'" + theGIFStatus + "\';return true;\" onClick=\"toggle(" + i + ")\"><IMG SRC=\"" + theGIF + "\" HEIGHT=11 WIDTH=11 BORDER=0></A>"		
+		newOutline += " <A HREF=\"" + db[i].URL + "\" TARGET=\"bottom_target\" onMouseOver=\"window.parent.status=\'View " + db[i].display + "...\';return true;\">" + db[i].display + "</A><BR>"
+		prevIndentDisplayed = currIndent
+		showMyDaughter = expanded
+	}
+}
+newOutline += "</H4></PRE><HR>"
+document.write(newOutline)
+
+// end -->
+</SCRIPT> 
+</BODY>
+</HTML>
+
Index: trunk/WRF.COMMON/WRFV2/tools/danger
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/danger	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/danger	(revision 2744)
@@ -0,0 +1,14 @@
+#!/bin/csh
+
+# strip all the dependencies out of the makefiles so it compiles quicker
+
+if ( ! -d  tools ) then
+ echo 'must be run in top level dir'
+endif
+
+tools/safe >& /dev/null
+foreach f ( */Makefile )
+  /bin/mv $f $f.saved
+  cat $f.saved | sed '/ DEPENDENCIES/,$d'  > $f
+end
+
Index: trunk/WRF.COMMON/WRFV2/tools/data.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/data.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/data.c	(revision 2744)
@@ -0,0 +1,177 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "registry.h"
+#include "protos.h"
+#include "data.h"
+
+#define MAXTOKENS 30
+
+int
+init_dim_table()
+{
+  Dim = NULL ;
+  return(0) ;
+}
+
+node_t * 
+new_node ( int kind )
+{ node_t *p ; p = (node_t *)malloc(sizeof(node_t)) ; bzero(p,sizeof(node_t)); p->node_kind = kind ; return (p) ; }
+
+int
+add_node_to_end ( node_t * node , node_t ** list )
+{
+  node_t * p ;
+  if ( *list == NULL ) 
+    { *list = node ; }
+  else
+  {
+    for ( p = *list ; p->next != NULL ; p = p->next ) ;
+    p->next = node ;
+  }
+  return(0) ;
+}
+
+int
+add_node_to_end_4d ( node_t * node , node_t ** list )
+{
+  node_t * p ;
+  if ( *list == NULL ) 
+    { *list = node ; }
+  else
+  {
+    for ( p = *list ; p->next4d != NULL ; p = p->next4d ) ;
+    p->next4d = node ;
+  }
+  return(0) ;
+}
+
+#if 0
+int
+show_nodelist( node_t * p )
+{
+  show_nodelist1( p , 0 ) ;
+}
+
+show_nodelist1( node_t * p , int indent )
+{
+  if ( p == NULL ) return(0) ;
+  show_node1( p, indent) ;
+  show_nodelist1( p->next, indent ) ;
+}
+
+int
+show_node( node_t * p )
+{
+  return(show_node1(p,0)) ;
+}
+
+int
+show_node1( node_t * p, int indent )
+{
+  char spaces[] = "                           " ;
+  char tmp[25] , t1[25] , t2[25] ;
+  char * x, *ca, *ld, *ss, *se, *sg ;
+  char *nodekind ;
+  node_t * q ;
+  int nl ;
+  int i ;
+
+  if ( p == NULL ) return(1) ;
+  strcpy(tmp, spaces) ;
+  if ( indent >= 0 && indent < 20 ) tmp[indent] = '\0' ;
+
+// this doesn't make much sense any more, ever since node_kind was 
+// changed to a bit mask
+  if      ( p->node_kind & RCONFIG ) nodekind = "RCONFIG" ; 
+  else if ( p->node_kind & I1      ) nodekind = "I1" ;
+  else if ( p->node_kind & FIELD   ) nodekind = "FIELD" ;
+  else if ( p->node_kind & FOURD   ) nodekind = "FOURD" ;
+  else if ( p->node_kind & MEMBER  ) nodekind = "MEMBER" ;
+  else if ( p->node_kind & RCONFIG ) nodekind = "RCONFIG" ;
+
+  if ( !p->scalar_array_member ) 
+  {
+  switch ( p->node_kind )
+  {
+  case RCONFIG :
+  case I1      :
+  case FIELD   :
+  case FOURD   :
+  case MEMBER  :
+    fprintf(stderr,"%s%s : %10s ndims %1d\n",tmp,nodekind,p->name, p->ndims) ;
+    for ( i = 0 ; i < p->ndims ; i++ )
+    {
+      sg = "" ;
+      switch ( p->dims[i]->coord_axis ) {
+	case COORD_X : ca = "X" ; if ( p->stag_x ) sg = "*" ; break ;
+        case COORD_Y : ca = "Y" ; if ( p->stag_y ) sg = "*" ; break ;
+	case COORD_Z : ca = "Z" ; if ( p->stag_z ) sg = "*" ; break ;
+        case COORD_C : ca = "C" ; break ;
+      }
+      switch ( p->dims[i]->len_defined_how ) {
+	case DOMAIN_STANDARD : ld = "STANDARD" ;  ss = "" ; se = "" ; break ;
+	case NAMELIST        : ld = "NAMELIST" ;  ss = p->dims[i]->associated_namelist_variable ; se="" ; break ;
+	case CONSTANT        : ld = "CONSTANT" ;  sprintf(t1,"%d",p->dims[i]->coord_start) ; ss = t1 ;
+						  sprintf(t2,"%d",p->dims[i]->coord_end  ) ; se = t2 ;
+						  break ;
+      }
+      fprintf(stderr,"      dim %1d: %c %2s%s %10s %10s %10s\n",i,p->dims[i]->dim_name,ca,sg,ld,ss,se) ;
+    }
+    nl = 0 ;
+    if ( strlen( p->use     ) > 0 ) {
+       nl = 1 ; fprintf(stderr,"      use: %s",p->use) ;
+       if ( p->scalar_array_member ) fprintf(stderr,"(4D)") ;
+    }
+    if ( strlen( p->dname   ) > 0 ) { nl = 1 ; fprintf(stderr,"    dname: %s",p->dname) ;    }
+    if ( strlen( p->descrip ) > 0 ) { nl = 1 ; fprintf(stderr,"  descrip: %s",p->descrip) ;    }
+    if ( nl == 1 ) fprintf(stderr,"\n") ;
+    show_node1( p->type, indent+1 ) ;
+    break ;
+  case TYPE  :
+    x = "derived" ;
+    if ( p->type_type == SIMPLE ) x = "simple" ;
+    fprintf(stderr,"%sTYPE : %10s %s ndims %1d\n",tmp,p->name,x, p->ndims) ;
+    show_nodelist1( p->fields, indent+1 ) ;
+    break ;
+  case DIM   :
+    break ;
+  default :
+    break ;
+  }
+  }
+  show_nodelist1( p->members , indent+2 ) ;
+  return(0) ;
+}
+#endif
+
+int
+set_mark ( int val , node_t * lst )
+{
+  node_t * p ;
+  if ( lst == NULL ) return(0) ;
+  for ( p = lst ; p != NULL ; p = p->next )
+  {
+    p->mark = val ;
+    set_mark( val , p->fields ) ;
+    set_mark( val , p->members ) ;
+  }
+  return(0) ;
+}
+
+int
+set_mark_4d ( int val , node_t * lst )
+{
+  node_t * p ;
+  if ( lst == NULL ) return(0) ;
+  for ( p = lst ; p != NULL ; p = p->next4d )
+  {
+    p->mark = val ;
+    set_mark( val , p->fields ) ;
+    set_mark( val , p->members ) ;
+  }
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/data.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/data.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/data.h	(revision 2744)
@@ -0,0 +1,144 @@
+#ifndef DATA_H
+#include "registry.h"
+
+typedef struct node_struct {
+
+  int     node_kind ;
+  int     type_type ;
+  char          name[NAMELEN] ;
+  struct node_struct  * fields ;
+  struct node_struct  * type ;
+  int           ndims ;
+  struct node_struct  * dims[MAXDIMS] ;
+  int     proc_orient ;    /* ALL_[ZXY]_ON_PROC which dimension is all on processor */
+  int           ntl ;
+  int           stag_x ;
+  int           stag_y ;
+  int           stag_z ;
+  int           subject_to_communication ;
+  int           boundary_array ;
+  int           boundary_array_4d ;
+  char    use[NAMELEN] ;
+  char    dname[NAMELEN] ;
+  char    descrip[NAMELEN] ;
+  char    units[NAMELEN] ;
+
+/* Fields for 4D scalar arrays */
+  int           scalar_array_member ;
+  int           has_scalar_array_tendencies ;
+  struct node_struct * members ;
+
+/* I/O flags */
+  int     io_mask ;
+  int           history ;
+  int             auxhist1 ;
+  int             auxhist2 ;
+  int             auxhist3 ;
+  int             auxhist4 ;
+  int             auxhist5 ;
+  int             auxhist6 ;
+  int             auxhist7 ;
+  int             auxhist8 ;
+  int             auxhist9 ;
+  int             auxhist10 ;
+  int             auxhist11 ;
+  int           restart ;
+  int           input   ;
+  int             auxinput1   ;
+  int             auxinput2   ;
+  int             auxinput3   ;
+  int             auxinput4   ;
+  int             auxinput5   ;
+  int             auxinput6   ;
+  int             auxinput7   ;
+  int             auxinput8   ;
+  int             auxinput9   ;
+  int             auxinput10   ;
+  int             auxinput11   ;
+  int           boundary   ;
+  int           namelist   ;
+  char    namelistsection[NAMELEN] ;
+  struct node_struct * next ;
+  struct node_struct * next4d ;
+
+  char force_aux_fields[2048] ;
+  char force_fcn_name[2048] ;
+  char interpd_aux_fields[2048] ;
+  char interpd_fcn_name[2048] ;
+  char interpu_aux_fields[2048] ;
+  char interpu_fcn_name[2048] ;
+  char smoothu_fcn_name[2048] ;
+  char smoothu_aux_fields[2048] ;
+
+/* fields used by rconfig nodes */
+  char nentries[NAMELEN] ;
+  char howset[NAMELEN] ;
+  char dflt[NAMELEN] ;
+
+/* fields used by Dim nodes */
+
+  char dim_name ;
+  char dim_data_name[NAMELEN] ;
+  int  coord_axis ;   /* X, Y, Z, C */
+                                 /* DOMAIN_STANDARD, NAMELIST, CONSTANT */
+  int  len_defined_how ;  
+  char assoc_nl_var_s[NAMELEN] ;  /* for NAMELIST */
+  char assoc_nl_var_e[NAMELEN] ;  /* for NAMELIST */
+  int  coord_start ;               /* for CONSTANT */
+  int  coord_end ;                 /* for CONSTANT */
+  int  dim_order ;                 /* order that dimensions are specified
+                                      in framework */
+
+/* fields used by Package nodes */
+  char pkg_assoc[NAMELEN] ;
+  char pkg_statevars[NAMELEN] ;
+  char pkg_4dscalars[NAMELEN] ;
+
+/* fields used by Comm (halo, period, xpose)  nodes */
+  char comm_define[2*8192] ;
+
+/* marker */
+  int mark ;
+
+} node_t ;
+
+#ifndef DEFINE_GLOBALS
+#  define EXTERN extern
+#else
+#  define EXTERN
+#endif
+
+EXTERN int sw_deref_kludge ;
+EXTERN int sw_io_deref_kludge ;
+EXTERN int sw_3dvar_iry_kludge ;
+EXTERN int sw_distrib_io_layer ;
+EXTERN int sw_limit_args ;
+EXTERN int sw_dm_parallel  ;
+EXTERN int sw_move  ;
+EXTERN int sw_all_x_staggered ;
+EXTERN int sw_all_y_staggered ;
+EXTERN int sw_dm_serial_in_only ;
+EXTERN int sw_ifort_kludge ;
+EXTERN char sw_commpath[NAMELEN] ;
+
+EXTERN node_t * Type ;
+EXTERN node_t * Dim ;
+EXTERN node_t * Packages ;
+EXTERN node_t * Halos ;
+EXTERN node_t * Periods ;
+EXTERN node_t * Xposes ;
+EXTERN node_t * FourD ;
+EXTERN node_t * Swaps ;
+EXTERN node_t * Cycles ;
+
+EXTERN node_t Domain ;
+
+EXTERN char t1[NAMELEN], t2[NAMELEN], t3[NAMELEN], t4[NAMELEN], t5[NAMELEN], t6[NAMELEN] ;
+EXTERN char thiscom[4*NAMELEN] ;
+EXTERN int  model_order[3] ;
+
+EXTERN int max_time_level  ;  /* Maximum number of time levels of any state variable */
+
+
+#define DATA_H
+#endif
Index: trunk/WRF.COMMON/WRFV2/tools/debug_macro_toolchest
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/debug_macro_toolchest	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/debug_macro_toolchest	(revision 2744)
@@ -0,0 +1,42 @@
+#define IDEBUG 40
+#define JDEBUG 42
+#define KDEBUG 3
+
+#define IJKTEST i.eq.IDEBUG.and.j.eq.JDEBUG.and.k.eq.KDEBUG
+#define IJKDIM IDEBUG,KDEBUG,JDEBUG
+#define IJDIM IDEBUG,JDEBUG
+
+#define DEBUG3D(v,x) write(0,*)'v',' ','x',x ( IJKDIM )
+#define DEBUG2D(v,x) write(0,*)'v',' ','x',x ( IJDIM )
+
+#define DEBUG3DHALO(v,x) write(0,*)'v',' 1 ','x',x ( IDEBUG-1,KDEBUG,JDEBUG-1);\
+                         write(0,*)'v',' 2 ','x',x ( IDEBUG  ,KDEBUG,JDEBUG-1);\
+                         write(0,*)'v',' 3 ','x',x ( IDEBUG+1,KDEBUG,JDEBUG-1);\
+                         write(0,*)'v',' 4 ','x',x ( IDEBUG-1,KDEBUG,JDEBUG  );\
+                         write(0,*)'v',' 5 ','x',x ( IDEBUG  ,KDEBUG,JDEBUG  );\
+                         write(0,*)'v',' 6 ','x',x ( IDEBUG+1,KDEBUG,JDEBUG  );\
+                         write(0,*)'v',' 7 ','x',x ( IDEBUG-1,KDEBUG,JDEBUG+1);\
+                         write(0,*)'v',' 8 ','x',x ( IDEBUG  ,KDEBUG,JDEBUG+1);\
+                         write(0,*)'v',' 9 ','x',x ( IDEBUG+1,KDEBUG,JDEBUG+1)
+
+-------
+
+#define IDEBUG 40
+#define JDEBUG 42
+#define KDEBUG 3
+
+#define IJKTEST i.eq.IDEBUG.and.j.eq.JDEBUG.and.k.eq.KDEBUG
+#define IJKDIM IDEBUG,KDEBUG,JDEBUG
+
+#define DEBUG3D(v,x) write(0,*)'v',' ','x',x ( IJKDIM )
+
+#define DEBUG3DHALO(v,x) write(0,*)'v',' 1 ','x',x ( IDEBUG-1,KDEBUG,JDEBUG-1);\
+                         write(0,*)'v',' 2 ','x',x ( IDEBUG  ,KDEBUG,JDEBUG-1);\
+                         write(0,*)'v',' 3 ','x',x ( IDEBUG+1,KDEBUG,JDEBUG-1);\
+                         write(0,*)'v',' 4 ','x',x ( IDEBUG-1,KDEBUG,JDEBUG  );\
+                         write(0,*)'v',' 5 ','x',x ( IDEBUG  ,KDEBUG,JDEBUG  );\
+                         write(0,*)'v',' 6 ','x',x ( IDEBUG+1,KDEBUG,JDEBUG  );\
+                         write(0,*)'v',' 7 ','x',x ( IDEBUG-1,KDEBUG,JDEBUG+1);\
+                         write(0,*)'v',' 8 ','x',x ( IDEBUG  ,KDEBUG,JDEBUG+1);\
+                         write(0,*)'v',' 9 ','x',x ( IDEBUG+1,KDEBUG,JDEBUG+1)
+
Index: trunk/WRF.COMMON/WRFV2/tools/four2eight.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/four2eight.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/four2eight.c	(revision 2744)
@@ -0,0 +1,94 @@
+/* Jan. 2005.
+
+   A utility that converts unformatted binary real data files
+   to unformatted binary double precision data files.
+
+   Compile as 
+
+        cc -o four2eight four2eight.c
+
+   If you are running this on a little-endian platform
+   compile with -DSWAP like so:
+
+        cc -o four2eight -DSWAP four2eight.c
+
+   Use as 
+
+        four2eight < RRTM_DATA > RRTM_DATA_DBL  (for example)
+
+   JM
+
+*/
+
+
+#include <stdio.h>
+
+main()
+{
+   int in, cr, cr1, n ;
+   int i ;
+   float x, x1 ;
+   double y, y1 ;
+
+   while ( 
+     fread( &in, 1, 4, stdin ) > 0 ) {
+     swap4(&in, &cr) ;
+     n = cr ;
+     cr1 = 2*cr ;
+     fprintf(stderr, "%d > %d\n",cr,cr1) ;
+     swap4(&cr1,&cr) ;
+     fwrite( &cr, 1, 4, stdout ) ;
+     for ( i = 0 ; i < n ; i += 4 )
+     {
+       fread ( &x, 1, 4, stdin ) ;
+       swap4(&x,&x1) ;
+       y1 = x1 ;
+       swap8(&y1,&y) ;
+       fwrite ( &y, 1, 8, stdout ) ;
+     }
+     fread( &in, 1, 4, stdin ) ;
+     fwrite( &cr, 1, 4, stdout ) ;
+   }
+   fprintf(stderr,"\n") ;
+}
+
+swap4( a, b )
+   char a[], b[] ;
+{
+#ifdef SWAP
+   b[0] = a[3] ;
+   b[1] = a[2] ;
+   b[2] = a[1] ;
+   b[3] = a[0] ;
+#else
+   b[0] = a[0] ;
+   b[1] = a[1] ;
+   b[2] = a[2] ;
+   b[3] = a[3] ;
+#endif
+}
+
+swap8( a, b )
+   char a[], b[] ;
+{
+#ifdef SWAP
+   b[0] = a[7] ;
+   b[1] = a[6] ;
+   b[2] = a[5] ;
+   b[3] = a[4] ;
+   b[4] = a[3] ;
+   b[5] = a[2] ;
+   b[6] = a[1] ;
+   b[7] = a[0] ;
+#else
+   b[0] = a[0] ;
+   b[1] = a[1] ;
+   b[2] = a[2] ;
+   b[3] = a[3] ;
+   b[4] = a[4] ;
+   b[5] = a[5] ;
+   b[6] = a[6] ;
+   b[7] = a[7] ;
+#endif
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/fseek_test.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/fseek_test.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/fseek_test.c	(revision 2744)
@@ -0,0 +1,44 @@
+#define _FILE_OFFSET_BITS 64
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+main()
+{
+  FILE *fp ;
+  long long y ;
+  int retval ;
+  int result1 ;
+#ifdef TEST_FSEEKO
+  off_t x ;
+  off_t result2 ;
+#endif
+#ifdef TEST_FSEEKO64
+  long long x ;
+  int result2 ;
+#endif
+  fp = NULL ;
+  fp = fopen( "Makefile" , "r" ) ;
+#ifdef TEST_FSEEKO
+  x = 0xffffffff ;
+  result1 = (sizeof(x) == 8) ;
+  result2 = fseeko( fp, x, SEEK_SET ) ;
+#endif
+#ifdef TEST_FSEEKO64
+  x = 0xffffffffL ;
+  result1 = (sizeof(x) == 8) ;
+  result2 = fseeko64( fp, x, SEEK_SET ) ;
+#endif
+  if ( result2 ) perror("error") ;
+  fprintf(stdout,"pointer is 8 bytes: %s\n",result1?"true":"false") ;
+  fprintf(stdout,"seek returns correctly: %s\n",!result2?"true":"false") ;
+  if ( result1 && !result2 ) { 
+    fprintf(stdout,"status: OK\n") ; 
+    retval = 0 ;
+  } else { 
+    fprintf(stdout,"status: BUMMER\n") ;
+    retval = 1 ;
+  }
+  fclose(fp) ;
+  exit(retval) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/gen_allocs.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_allocs.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_allocs.c	(revision 2744)
@@ -0,0 +1,345 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+int
+gen_alloc ( char * dirname )
+{
+  int i ;
+  
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+  {
+    gen_alloc1( dirname , get_corename_i(i) ) ; 
+    gen_ddt_write( dirname, get_corename_i(i) ) ;
+  }
+  return(0) ;
+}
+
+int
+gen_alloc1 ( char * dirname , char * corename )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "_allocs.inc" ;
+
+  if ( dirname == NULL || corename == NULL ) return(1) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s%s",dirname,corename,fn) ; }
+  else                       { sprintf(fname,"%s%s",corename,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  gen_alloc2( fp , "grid%", corename , &Domain ) ;
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_alloc2 ( FILE * fp , char * structname , char * corename , node_t * node )
+{
+  node_t * p ;
+  int tag ;
+  char post[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char x[NAMELEN] ;
+
+  if ( node == NULL ) return(1) ;
+
+  for ( p = node->fields ; p != NULL ; p = p->next )
+  {
+    if ( (p->ndims > 0 || p->boundary_array) && (  /* any array or a boundary array and...   */
+          (p->node_kind & FOURD) ||                /* scalar arrays or...                    */
+                                                   /* if it's a core specific field and we're doing that core or...  */
+          (p->node_kind & FIELD && (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4))) ||
+                                                   /* it is not a core specific field        */
+          (p->node_kind & FIELD && ( strncmp("dyn_",p->use,4)))
+                         ))
+    {
+      if ( p->node_kind & FOURD ) { sprintf(post,",num_%s)",field_name(t4,p,0)) ; }
+      else                        { sprintf(post,")") ; }
+      for ( tag = 1 ; tag <= p->ntl ; tag++ )
+      {
+        /* if this is a core-specific variable, prepend the name of the core to   */
+        /* the variable at the driver level                                       */
+        if (      !strcmp( corename , p->use+4 )) {
+          sprintf(fname,"%s_%s",corename,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+        } else if ( !strcmp ( p->use , "_4d_bdy_array_") ) {
+          strcpy(fname,p->name) ;
+        } else {
+          strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+        }
+
+/* check for errors in memory allocation */
+
+       if ( ! ( p->node_kind & FOURD ) && 
+            ! ( p->io_mask & INTERP_DOWN || p->io_mask & FORCE_DOWN || p->io_mask & INTERP_UP || p->io_mask & SMOOTH_UP ) )
+       {
+	 fprintf(fp,"IF(.NOT.inter_domain)THEN\n",tag) ;
+       }
+       if ( p->ntl > 1 ) {
+	 fprintf(fp,"IF(IAND(%d,tl).NE.0)THEN\n",tag) ;
+       }
+       fprintf(fp, "ALLOCATE(%s%s%s,STAT=ierr)\n if (ierr.ne.0) then\n CALL wrf_error_fatal ( &\n'frame/module_domain.f: Failed to allocate %s%s%s. ')\n endif\n",
+                structname, fname,
+                dimension_with_ranges( "", "(", t2, p, post, "model_config_rec%"), 
+                structname, fname,
+                dimension_with_ranges( "", "(", t2, p, post, "model_config_rec%")); 
+
+       fprintf(fp, "  IF ( setinitval .EQ. 1 .OR. setinitval .EQ. 3 ) %s%s=", structname , fname);
+       if( p->type != NULL  &&   (!strcmp( p->type->name , "real" ) 
+                               || !strcmp( p->type->name , "doubleprecision") ) )   {
+       /* if a real */
+         fprintf(fp, "initial_data_value\n");
+       } else if ( !strcmp( p->type->name , "logical" ) ) {
+         fprintf(fp, ".FALSE.\n");
+       } else if ( !strcmp( p->type->name , "integer" ) ) {
+         fprintf(fp, "0\n");
+       }
+       if ( p->ntl > 1 ) {
+	 fprintf(fp,"ELSE\n") ;
+
+       fprintf(fp, "ALLOCATE(%s%s%s,STAT=ierr)\n if (ierr.ne.0) then\n CALL wrf_error_fatal ( &\n'frame/module_domain.f: Failed to allocate %s%s%s.  ')\n endif\n",
+                structname, fname, dimension_with_ones( "(",t2,p,")" ), 
+                structname, fname, dimension_with_ones( "(",t2,p,")" ) ) ;
+
+
+
+	 fprintf(fp,"ENDIF\n") ;
+       }
+       if ( ! ( p->node_kind & FOURD ) && 
+            ! ( p->io_mask & INTERP_DOWN || p->io_mask & FORCE_DOWN || p->io_mask & INTERP_UP || p->io_mask & SMOOTH_UP ) )
+       {
+	 fprintf(fp,"ELSE\n") ;
+       fprintf(fp, "ALLOCATE(%s%s%s,STAT=ierr)\n if (ierr.ne.0) then\n CALL wrf_error_fatal ( &\n'frame/module_domain.f: Failed to allocate %s%s%s.  ')\n endif\n",
+                structname, fname, dimension_with_ones( "(",t2,p,")" ), 
+                structname, fname, dimension_with_ones( "(",t2,p,")" ) ) ;
+	 fprintf(fp,"ENDIF\n") ;
+       }
+
+      }
+    }
+    if ( p->type != NULL )
+    {
+      if ( p->type->type_type == SIMPLE && p->ndims == 0 &&
+               ((!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4)) || strncmp("dyn_",p->use,4)) &&
+               (!strcmp(p->type->name,"integer") || 
+                        !strcmp(p->type->name,"logical") || 
+                        !strcmp(p->type->name,"real") ||
+                        !strcmp(p->type->name,"doubleprecision"))
+              )
+      {
+          if (!strncmp( "dyn_" , p->use , 4 ))
+          {
+            if (!strcmp( corename , p->use+4 ))
+              sprintf(fname,"%s_%s",corename,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+          }
+          else
+          {
+            strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+          }
+          if( !strcmp( p->type->name , "real" ) || 
+              !strcmp( p->type->name , "doubleprecision" )  ) { /* if a real */
+            fprintf(fp, "IF ( setinitval .EQ. 3 ) %s%s=initial_data_value\n",
+                        structname ,
+                        fname ) ;
+	  } else if ( !strcmp( p->type->name , "integer" ) ) {
+            fprintf(fp, "IF ( setinitval .EQ. 3 ) %s%s=0\n",
+                        structname ,
+                        fname ) ;
+          } else if ( !strcmp( p->type->name , "logical" ) ) {
+            fprintf(fp, "IF ( setinitval .EQ. 3 ) %s%s=.FALSE.\n",
+                        structname ,
+                        fname ) ;
+          }
+      }
+      else if ( p->type->type_type == DERIVED )
+      {
+        sprintf(x,"%s%s%%",structname,p->name ) ;
+        gen_alloc2(fp,x, corename, p->type) ;
+      }
+    }
+  }
+  return(0) ;
+}
+
+int
+gen_ddt_write ( char * dirname , char * corename )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "_write_ddt.inc" ;
+
+  if ( dirname == NULL || corename == NULL ) return(1) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s%s",dirname,corename,fn) ; }
+  else                       { sprintf(fname,"%s%s",corename,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  gen_ddt_write1( fp , "grid%", corename , &Domain ) ;
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_ddt_write1 ( FILE * fp , char * structname , char * corename , node_t * node )
+{
+  node_t * p ;
+  int tag ;
+  char post[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char x[NAMELEN] ;
+
+  if ( node == NULL ) return(1) ;
+
+  for ( p = node->fields ; p != NULL ; p = p->next )
+  {
+    if ( (p->ndims > 1 && ! p->boundary_array) && (  /* any array or a boundary array and...   */
+          (p->node_kind & FOURD) ||                /* scalar arrays or...                    */
+                                                   /* if it's a core specific field and we're doing that core or...  */
+          (p->node_kind & FIELD && (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4))) ||
+                                                   /* it is not a core specific field        */
+          (p->node_kind & FIELD && ( strncmp("dyn_",p->use,4)))
+                         ))
+    {
+      if ( p->node_kind & FOURD ) { sprintf(post,",num_%s)",field_name(t4,p,0)) ; }
+      else                        { sprintf(post,")") ; }
+      for ( tag = 1 ; tag <= p->ntl ; tag++ )
+      {
+        /* if this is a core-specific variable, prepend the name of the core to   */
+        /* the variable at the driver level                                       */
+        if (!strcmp( corename , p->use+4 ))
+          sprintf(fname,"%s_%s",corename,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+        else
+          strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+
+       if ( p->node_kind & FOURD ) {
+         fprintf(fp, "write(0,*)'%s',%s%s(IDEBUG,KDEBUG,JDEBUG,2)\n",fname,structname,fname) ;
+       } else {
+         if ( p->ndims == 2 ) fprintf(fp, "write(0,*)'%s',%s%s(IDEBUG,JDEBUG)\n",fname,structname,fname) ;
+         if ( p->ndims == 3 ) fprintf(fp, "write(0,*)'%s',%s%s(IDEBUG,KDEBUG,JDEBUG)\n",fname,structname,fname) ;
+       }
+
+      }
+    }
+#if 0
+    if ( p->type != NULL )
+    {
+      if ( p->type->type_type == SIMPLE && p->ndims == 0 &&
+               ((!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4)) || strncmp("dyn_",p->use,4)) &&
+               (!strcmp(p->type->name,"integer") ||
+                        !strcmp(p->type->name,"real") ||
+                        !strcmp(p->type->name,"doubleprecision"))
+              )
+      {
+          if (!strncmp( "dyn_" , p->use , 4 ))
+          {
+            if (!strcmp( corename , p->use+4 ))
+              sprintf(fname,"%s_%s",corename,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+          }
+          else
+          {
+            strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+          }
+          fprintf(fp, "write(iunit)%s%s\n",structname,fname) ;
+      }
+    }
+#endif
+  }
+  return(0) ;
+}
+
+int
+gen_dealloc ( char * dirname )
+{
+  int i ;
+  
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+  {
+    gen_dealloc1( dirname , get_corename_i(i) ) ; 
+  }
+  return(0) ;
+}
+
+int
+gen_dealloc1 ( char * dirname , char * corename )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "_deallocs.inc" ;
+
+  if ( dirname == NULL || corename == NULL ) return(1) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s%s",dirname,corename,fn) ; }
+  else                       { sprintf(fname,"%s%s",corename,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  gen_dealloc2( fp , "grid%", corename , &Domain ) ;
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_dealloc2 ( FILE * fp , char * structname , char * corename , node_t * node )
+{
+  node_t * p ;
+  int tag ;
+  char post[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char x[NAMELEN] ;
+
+  if ( node == NULL ) return(1) ;
+
+  for ( p = node->fields ; p != NULL ; p = p->next )
+  {
+    if ( (p->ndims > 0 || p->boundary_array) && (  /* any array or a boundary array and...   */
+          (p->node_kind & FOURD) ||                /* scalar arrays or...                    */
+                                                   /* if it's a core specific field and we're doing that core or...  */
+          (p->node_kind & FIELD && (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4))) ||
+                                                   /* it is not a core specific field        */
+          (p->node_kind & FIELD && ( strncmp("dyn_",p->use,4)))
+                         ))
+    {
+      if ( p->node_kind & FOURD ) { sprintf(post,",num_%s)",field_name(t4,p,0)) ; }
+      else                        { sprintf(post,")") ; }
+      for ( tag = 1 ; tag <= p->ntl ; tag++ )
+      {
+        /* if this is a core-specific variable, prepend the name of the core to   */
+        /* the variable at the driver level                                       */
+        if (!strcmp( corename , p->use+4 ))
+          sprintf(fname,"%s_%s",corename,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+        else
+          strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+
+        fprintf(fp,
+"IF ( ASSOCIATED( %s%s ) ) THEN \n", structname, fname ) ;
+        fprintf(fp, 
+"  DEALLOCATE(%s%s,STAT=ierr)\n if (ierr.ne.0) then\n CALL wrf_error_fatal ( &\n'frame/module_domain.f: Failed to dallocate %s%s. ')\n endif\n",
+structname, fname, structname, fname ) ;
+        fprintf(fp,
+"  NULLIFY(%s%s)\n",structname, fname ) ;
+        fprintf(fp,
+"ENDIF\n" ) ;
+
+
+      }
+    }
+    if ( p->type != NULL )
+    {
+      if ( p->type->type_type == SIMPLE && p->ndims == 0 &&
+               ((!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4)) || strncmp("dyn_",p->use,4)) &&
+               (!strcmp(p->type->name,"integer") ||
+                        !strcmp(p->type->name,"real") ||
+                        !strcmp(p->type->name,"doubleprecision"))
+              )
+      {
+      }
+      else if ( p->type->type_type == DERIVED )
+      {
+        sprintf(x,"%s%s%%",structname,p->name ) ;
+        gen_dealloc2(fp,x, corename, p->type) ;
+      }
+    }
+  }
+  return(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/tools/gen_args.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_args.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_args.c	(revision 2744)
@@ -0,0 +1,172 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+#define DUMMY 1
+#define ACTUAL 2 
+#define DUMMY_NEW 3
+#define ACTUAL_NEW 4 
+
+int
+gen_actual_args ( char * dirname )
+{
+  int i ;
+  
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+    gen_args ( dirname , get_corename_i(i) , ACTUAL ) ; 
+  return(0) ;
+}
+
+/* only generate actual args for the 4d arrays */
+int
+gen_actual_args_new ( char * dirname )
+{
+  int i ;
+
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+    gen_args ( dirname , get_corename_i(i) , ACTUAL_NEW ) ;
+  return(0) ;
+}
+
+int
+gen_dummy_args ( char * dirname )
+{
+  int i ;
+ 
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+    gen_args ( dirname , get_corename_i(i) , DUMMY ) ;
+  return(0) ;
+}
+
+/* only generate dummy args for the 4d arrays */
+int
+gen_dummy_args_new ( char * dirname )
+{
+  int i ;
+
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+    gen_args ( dirname , get_corename_i(i) , DUMMY_NEW ) ;
+  return(0) ;
+}
+
+int
+gen_args ( char * dirname , char * corename , int sw )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "_args.inc" ;
+  char * p ;
+  int linelen ;
+  char outstr[64*4096] ;
+
+  if ( dirname == NULL || corename == NULL ) return(1) ;
+  if ( strlen(dirname) > 0 ) 
+   { sprintf(fname,"%s/%s%s%s%s",dirname,corename,
+             (sw==ACTUAL||sw==ACTUAL_NEW)?"_actual":"_dummy",(sw==ACTUAL_NEW||sw==DUMMY_NEW)?"_new":"",fn) ; }
+  else                       
+   { sprintf(fname,"%s%s%s%s",corename,
+             (sw==ACTUAL||sw==ACTUAL_NEW)?"_actual":"_dummy",(sw==ACTUAL_NEW||sw==DUMMY_NEW)?"_new":"",fn) ; }
+
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  linelen = 0 ;
+  strcpy(outstr,",") ;
+  gen_args1 ( fp , outstr, (sw==ACTUAL||sw==ACTUAL_NEW)?"grid%":"", corename ,
+              &Domain , &linelen , sw , 0 ) ;
+  /* remove trailing comma */
+  if ((p=rindex(outstr,','))!=NULL) *p = '\0' ;
+  fputs(outstr,fp);fputs(" &\n",fp) ;
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_args1 ( FILE * fp , char * outstr , char * structname , char * corename , 
+            node_t * node , int *linelen , int sw , int deep )
+{
+  node_t * p ;
+  int tag ;
+  char post[NAMELEN] ;
+  char fname[NAMELEN] ;
+  char x[NAMELEN], y[NAMELEN] ;
+  char indices[NAMELEN] ;
+  int lenarg ; 
+  int only4d = 0 ;
+
+  if ( sw == ACTUAL_NEW ) { sw = ACTUAL ; only4d = 1 ; }
+  if ( sw == DUMMY_NEW )  { sw = DUMMY  ; only4d = 1 ; }
+
+  if ( node == NULL ) return(1) ;
+  for ( p = node->fields ; p != NULL ; p = p->next )
+  {
+    if ( p->node_kind & I1 ) continue ;              /* short circuit any field that is not state */
+                                                     /* short circuit scalars; shortening argument lists */
+    if ( p->ndims == 0 && p->type->type_type != DERIVED && sw_limit_args ) continue ; 
+
+    if (                 (
+          (p->node_kind & FOURD)                   /* scalar arrays or... */
+                                                   /* if it's a core specific field and we're doing that core or... */
+       || (p->node_kind & FIELD && (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4))) 
+                                                   /* it is not a core specific field and it is not a derived type -ajb */
+       || (p->node_kind & FIELD && (p->type->type_type != DERIVED) && ( strncmp("dyn_",p->use,4))) 
+#if 0
+                                                   /* it is a state variable */
+       || (p->node_kind & RCONFIG )
+#endif
+                         )
+       )
+    {
+      if ( !only4d || (p->node_kind & FOURD) || ( p->boundary_array ) ) {
+        if      ( p->node_kind & FOURD ) { sprintf(post,",1)") ; }
+        else if ( p->boundary_array )     { sprintf(post,")") ; }
+        else                              { sprintf(post,")") ; }
+        for ( tag = 1 ; tag <= p->ntl ; tag++ )
+        {
+          /* if this is a core-specific variable, prepend the name of the core to */
+          /* the variable at the driver level */
+          if (!strcmp( corename , p->use+4 ) && sw==ACTUAL)
+            sprintf(fname,"%s_%s",corename,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+          else
+            strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+	  strcpy(indices,"") ;
+          if ( sw_deref_kludge && sw==ACTUAL ) 
+	    sprintf(indices, "%s",index_with_firstelem("(","",t2,p,post)) ;
+          /* generate argument */
+	  strcpy(y,structname) ; strcat(y,fname) ; strcat(y,indices) ; strcat(y,",") ;
+	  lenarg = strlen(y) ;
+	  if ( lenarg+*linelen > MAX_ARGLINE ) { strcat(outstr," &\n") ; *linelen = 0 ; }
+	  strcat(outstr,y) ;
+	  *linelen += lenarg ;
+        }
+      }
+    }
+    if ( p->type != NULL )
+    {
+      if ( p->type->type_type == DERIVED && !only4d )
+      {
+        if ( deep )
+        {
+          sprintf(x,"%s%s%%",structname,p->name ) ;
+          gen_args1(fp, outstr, (sw==ACTUAL)?x:"", corename, p->type,linelen,sw,deep) ;
+        }
+        else
+        {
+          /* generate argument */
+	  strcpy(y,structname) ; strcat(y,p->name) ; strcat(y,",") ;
+	  lenarg = strlen(y) ;
+	  if ( lenarg+*linelen > MAX_ARGLINE ) { strcat(outstr," &\n") ; *linelen = 0 ; }
+	  strcat(outstr,y) ;
+	  *linelen += lenarg ;
+          p->mark = 1 ;
+        }
+      }
+    }
+  }
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/gen_comms.stub
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_comms.stub	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_comms.stub	(revision 2744)
@@ -0,0 +1,15 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+int
+gen_comms ( char * dirname )
+{
+  if ( sw_dm_parallel )
+    fprintf(stderr,"WARNING: stub version of gen_comms is linked in with registry program.\n") ;
+
+  return(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/tools/gen_comms_warning
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_comms_warning	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_comms_warning	(revision 2744)
@@ -0,0 +1,15 @@
+/* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !!                  W A R N I N G
+   !!
+   !!  This is a temporary version of gen_comms.c
+   !!  It has been compied from somewhere else
+   !!  (If not DM_PARALLEL this is tools/gen_comms.stub
+   !!  otherwise, it is from one of the external package
+   !!  directories.)
+   !!
+   !!                B E   A D V I S E D
+   !!
+   !!  Changes to this file are liable to be LOST.
+   !!
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  */
+
Index: trunk/WRF.COMMON/WRFV2/tools/gen_config.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_config.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_config.c	(revision 2744)
@@ -0,0 +1,324 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+#include <string.h>
+#include <strings.h>
+#include "sym.h"
+
+int
+gen_namelist_defines ( char * dirname , int sw_dimension )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char  fn[NAMELEN] ;
+  node_t *p ;
+  
+  sprintf( fn, "namelist_defines%s.inc", sw_dimension?"":"2" ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+
+  fprintf(fp,"integer    :: first_item_in_struct\n") ;
+  for ( p = Domain.fields ; p != NULL ; p = p-> next )
+  {
+    if ( p->node_kind & RCONFIG )
+    {
+      if ( sw_dimension )
+      {
+	if      ( !strcmp( p->nentries, "1" ) )
+          fprintf(fp,"%s :: %s\n",p->type->name ,p->name) ;
+	else if (  strcmp( p->nentries, "-" ) )  /* if not equal to "-" */
+          fprintf(fp,"%s , DIMENSION(%s) :: %s\n",p->type->name ,p->nentries,p->name) ;
+      }
+      else
+      {
+        fprintf(fp,"%s :: %s\n",p->type->name ,p->name) ;
+      }
+    }
+  }
+  fprintf(fp,"integer    :: last_item_in_struct\n") ;
+
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_namelist_defaults ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char  *fn = "namelist_defaults.inc" ;
+  node_t *p ;
+
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+
+  for ( p = Domain.fields ; p != NULL ; p = p-> next )
+  {
+    if ( p->node_kind & RCONFIG && strcmp(p->dflt,"-") && strcmp(p->dflt,""))
+    {
+      if ( !strncmp ( p->type->name , "character", 9 ) ) {
+        fprintf(fp,"%s = \"%s\"\n",p->name ,p->dflt) ;
+      } else {
+        fprintf(fp,"%s = %s\n",p->name ,p->dflt) ;
+      }
+    }
+  }
+
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+
+int
+gen_namelist_statements ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "namelist_statements.inc" ;
+  char  howset[NAMELEN] ;
+  char *p1, *p2 ;
+  node_t *p ;
+
+  strcpy( fname, fn ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+
+  for ( p = Domain.fields ; p != NULL ; p = p-> next )
+  {
+    if ( p->node_kind & RCONFIG )
+    {
+      strcpy(howset,p->howset) ;
+      if (( p1 = strtok(howset,",")) != NULL )
+      {
+        p2 = strtok(NULL,",") ;
+        if ( !strcmp(p1,"namelist") )
+        {
+          if ( p2 == NULL )
+	  {
+	    fprintf(stderr,
+	    "Warning: no namelist section specified for nl %s\n",p->name) ;
+	    continue ;
+	  }
+	  fprintf(fp,"NAMELIST /%s/ %s\n",p2,p->name) ;
+        }
+      }
+    }
+  }
+
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_get_nl_config ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "get_nl_config.inc" ;
+  char * gs, * intnt ;
+  char  howset[NAMELEN] ;
+  node_t *p ;
+  int sw ;
+
+
+  strcpy( fname, fn ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+
+  for ( sw = 0 ; sw < 2 ; sw++ ) 
+  {
+  if ( sw == 0 ) { gs = "get" ; intnt = "OUT" ; } else { gs = "set" ; intnt = "IN" ; }
+  for ( p = Domain.fields ; p != NULL ; p = p-> next )
+  {
+    if ( p->node_kind & RCONFIG )
+    {
+      strcpy(howset,p->howset) ;
+      fprintf(fp,"SUBROUTINE nl_%s_%s ( id_id , %s )\n",gs,p->name, p->name) ;
+      if ( sw_ifort_kludge ) {
+        fprintf(fp,"  USE module_configure\n") ;
+      }
+      fprintf(fp,"  %s , INTENT(%s) :: %s\n",p->type->name,intnt,p->name) ;
+      fprintf(fp,"  INTEGER id_id\n") ;
+      fprintf(fp,"  CHARACTER*80 emess\n") ;
+      if ( sw == 0 ) /* get */
+      {
+        if ( !strcmp( p->nentries, "1" )) {
+          if ( ! sw_ifort_kludge ) {
+            fprintf(fp,"  IF ( id_id .NE. 1 ) THEN\n") ;
+            fprintf(fp,"    call wrf_debug(1,&\n'WARNING in nl_%s_%s: %s applies to all domains. First arg ignored.')\n",
+                            gs,p->name, p->name ) ;
+            fprintf(fp,"  ENDIF\n" ) ;
+          }
+          if ( !strncmp(p->type->name,"character",9)) {
+            fprintf(fp,"  %s = trim(model_config_rec%%%s)\n",p->name,p->name) ;
+          }else{
+            fprintf(fp,"  %s = model_config_rec%%%s\n",p->name,p->name) ;
+          }
+        } else {
+          if ( ! sw_ifort_kludge ) {
+            if        ( !strcmp( p->nentries, "max_domains" )) {
+              fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%max_dom ) THEN\n") ;
+              fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range domain number: ',id_id\n",gs,p->name) ;
+	    } else if ( !strcmp( p->nentries, "max_moves" )) {
+              fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%num_moves ) THEN\n") ;
+              fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range move number: ',id_id\n",gs,p->name) ;
+	    } else if ( !strcmp( p->nentries, "max_eta" )) {
+              fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%e_vert(1) ) THEN\n") ;
+              fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range eta_level number: ',id_id\n",gs,p->name) ;
+	    } else {
+	      fprintf(stderr,"Registry WARNING: multi element rconfig entry must be either max_domains, max_moves, or max_eta \n") ;
+	    }
+            fprintf(fp,"    CALL wrf_error_fatal(emess)\n") ;
+            fprintf(fp,"  ENDIF\n" ) ;
+          }
+          fprintf(fp,"  %s = model_config_rec%%%s(id_id)\n",p->name,p->name) ;
+        }
+      }
+      else   /* set */
+      {
+        if ( !strcmp( p->nentries, "1" )) {
+          if ( ! sw_ifort_kludge ) {
+            fprintf(fp,"  IF ( id_id .NE. 1 ) THEN\n") ;
+            fprintf(fp,"    call wrf_debug(1,&\n'WARNING in nl_%s_%s: %s applies to all domains. First arg ignored.')\n",
+                            gs,p->name, p->name ) ;
+            fprintf(fp,"  ENDIF\n" ) ;
+          }
+          if ( !strncmp(p->type->name,"character",9)) {
+            fprintf(fp,"  model_config_rec%%%s = trim(%s) \n",p->name,p->name) ;
+          }else{
+            fprintf(fp,"  model_config_rec%%%s = %s \n",p->name,p->name) ;
+          }
+        } else {
+          if ( ! sw_ifort_kludge ) {
+            if        ( !strcmp( p->nentries, "max_domains" )) {
+              fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%max_dom ) THEN\n") ;
+              fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range domain number: ',id_id\n",gs,p->name) ;
+	    } else if ( !strcmp( p->nentries, "max_moves" )) {
+              fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%num_moves ) THEN\n") ;
+              fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range move number: ',id_id\n",gs,p->name) ;
+	    } else if ( !strcmp( p->nentries, "max_eta" )) {
+              fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%e_vert(1) ) THEN\n") ;
+              fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range eta_level number: ',id_id\n",gs,p->name) ;
+	    } else {
+	      fprintf(stderr,"Registry WARNING: multi element rconfig entry must be either max_domains, max_moves, or max_eta \n") ;
+	    }
+            fprintf(fp,"    CALL wrf_error_fatal(emess)\n") ;
+            fprintf(fp,"  ENDIF\n" ) ;
+          }
+          fprintf(fp,"  model_config_rec%%%s(id_id) = %s\n",p->name,p->name) ;
+        }
+      }
+      fprintf(fp,"  RETURN\n") ;
+      fprintf(fp,"END SUBROUTINE nl_%s_%s\n",gs,p->name ) ;
+    }
+  }
+  }
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_config_assigns ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "config_assigns.inc" ;
+  char  tmp[NAMELEN] ;
+  node_t *p ;
+
+  strcpy( fname, fn ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+
+  fprintf(fp,"! Contains config assign statements for module_domain.F.\n") ;
+  fprintf(fp,"#ifndef SOURCE_RECORD\n") ;
+  fprintf(fp,"#  define SOURCE_RECORD cfg%%\n") ;
+  fprintf(fp,"#endif\n") ;
+  fprintf(fp,"#ifndef SOURCE_REC_DEX\n") ;
+  fprintf(fp,"#  define SOURCE_REC_DEX\n") ;
+  fprintf(fp,"#endif\n") ;
+  fprintf(fp,"#ifndef DEST_RECORD\n") ;
+  fprintf(fp,"#  define DEST_RECORD new_grid%%\n") ;
+  fprintf(fp,"#endif\n") ;
+
+  for ( p = Domain.fields ; p != NULL ; p = p-> next )
+  {
+    if ( p->node_kind & RCONFIG )
+    {
+      if ( !strcmp( p->nentries, "1" ))
+        strcpy( tmp, "" ) ;
+      else
+        strcpy( tmp, "SOURCE_REC_DEX" ) ;
+      fprintf(fp," DEST_RECORD %-26s = SOURCE_RECORD %s %s\n",p->name,p->name,tmp) ;
+    }
+  }
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_config_reads ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "config_reads.inc" ;
+  char  howset[NAMELEN] ;
+  char *p1, *p2 ;
+  node_t *p ;
+
+  strcpy( fname, fn ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+
+  fprintf(fp,"! Contains namelist statements for module_config.F.\n") ;
+  fprintf(fp,"#ifndef NAMELIST_READ_UNIT\n") ;
+  fprintf(fp,"#  define NAMELIST_READ_UNIT nml_unit\n") ;
+  fprintf(fp,"#endif\n") ;
+  fprintf(fp,"#ifndef NAMELIST_READ_ERROR_LABEL\n") ;
+  fprintf(fp,"#  define NAMELIST_READ_ERROR_LABEL 9200\n") ;
+  fprintf(fp,"#endif\n") ;
+  fprintf(fp,"!\n") ;
+
+  sym_forget() ;
+
+  for ( p = Domain.fields ; p != NULL ; p = p-> next )
+  {
+    if ( p->node_kind & RCONFIG )
+    {
+      strcpy(howset,p->howset) ;
+      p1 = strtok(howset,",") ;
+      p2 = strtok(NULL,",") ;
+      if ( !strcmp(p1,"namelist") )
+      {
+        if ( p2 == NULL )
+        {
+          fprintf(stderr,
+          "Warning: no namelist section specified for nl %s\n",p->name) ;
+          continue ;
+        }
+	if (sym_get( p2 ) == NULL)  /* not in table yet */
+	{
+          fprintf(fp," REWIND  ( UNIT = NAMELIST_READ_UNIT )\n") ;
+          fprintf(fp," READ  ( UNIT = NAMELIST_READ_UNIT , NML = %s , ERR = NAMELIST_READ_ERROR_LABEL , END = NAMELIST_READ_ERROR_LABEL )\n",p2) ;
+          fprintf(fp,"#ifndef NO_NAMELIST_PRINT\n") ;
+          fprintf(fp," WRITE ( UNIT = *                  , NML = %s )\n",p2) ;
+          fprintf(fp,"#endif\n") ;
+	  sym_add(p2) ;
+	}
+       
+      }
+    }
+  }
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/gen_defs.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_defs.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_defs.c	(revision 2744)
@@ -0,0 +1,285 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+enum sw_ranges { COLON_RANGE , ARGADJ , GRIDREF } ;
+enum sw_pointdecl { POINTERDECL , NOPOINTERDECL } ;
+
+int
+gen_state_struct ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "state_struct.inc" ;
+
+  strcpy( fname, fn ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  gen_decls ( fp , "", &Domain , COLON_RANGE , POINTERDECL , FIELD | RCONFIG | FOURD , DRIVER_LAYER ) ;
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_state_subtypes ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "state_subtypes.inc" ;
+
+  strcpy( fname, fn ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  gen_state_subtypes1( fp , &Domain , COLON_RANGE , POINTERDECL , FIELD | RCONFIG | FOURD ) ;
+  close_the_file(fp) ;
+  return(0) ;
+}
+
+int
+gen_dummy_decls ( char * dn )
+{
+  int i ;
+  FILE * fp ;
+  char fname[NAMELEN] ;
+  char corename[NAMELEN] ;
+  char * fn = "_dummy_decl.inc" ;
+
+  if ( dn == NULL ) return(1) ;
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+  {
+    strcpy( corename , get_corename_i(i) ) ;
+    if ( strlen(dn) > 0 ) { sprintf(fname,"%s/%s%s",dn,corename,fn) ; }
+    else                  { sprintf(fname,"%s%s",corename,fn) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) continue ;
+    print_warning(fp,fname) ;
+#if 0
+    gen_decls ( fp, corename, &Domain , GRIDREF , NOPOINTERDECL , FIELD | RCONFIG | FOURD , MEDIATION_LAYER ) ;
+#else
+    gen_decls ( fp, corename, &Domain , GRIDREF , NOPOINTERDECL , FIELD | FOURD , MEDIATION_LAYER ) ;
+#endif
+    fprintf(fp,"#undef COPY_IN\n") ;
+    fprintf(fp,"#undef COPY_OUT\n") ;
+    close_the_file( fp ) ;
+  }
+  return(0);
+}
+
+int
+gen_dummy_decls_new ( char * dn )
+{
+  int i ;
+  FILE * fp ;
+  char fname[NAMELEN] ;
+  char corename[NAMELEN] ;
+  char * fn = "_dummy_new_decl.inc" ;
+
+  if ( dn == NULL ) return(1) ;
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+  {
+    strcpy( corename , get_corename_i(i) ) ;
+    if ( strlen(dn) > 0 ) { sprintf(fname,"%s/%s%s",dn,corename,fn) ; }
+    else                  { sprintf(fname,"%s%s",corename,fn) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) continue ;
+    print_warning(fp,fname) ;
+    gen_decls ( fp, corename, &Domain , GRIDREF , NOPOINTERDECL , FOURD | FIELD | BDYONLY , MEDIATION_LAYER ) ;
+    fprintf(fp,"#undef COPY_IN\n") ;
+    fprintf(fp,"#undef COPY_OUT\n") ;
+    close_the_file( fp ) ;
+  }
+  return(0);
+}
+
+
+int
+gen_i1_decls ( char * dn )
+{
+  int i ;
+  FILE * fp ;
+  char  fname[NAMELEN], post[NAMELEN] ;
+  char * fn = "_i1_decl.inc" ;
+  char corename[NAMELEN] ;
+  char * dimspec ;
+  node_t * p ; 
+
+  if ( dn == NULL ) return(1) ;
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+  {
+    strcpy(corename,get_corename_i(i)) ;
+    if ( strlen(dn) > 0 ) { sprintf(fname,"%s/%s%s",dn,corename,fn) ; }
+    else                  { sprintf(fname,"%s%s",corename,fn) ; }
+    if ((fp = fopen( fname , "w" )) == NULL ) continue ;
+    print_warning(fp,fname) ;
+    gen_decls ( fp , corename, &Domain , GRIDREF , NOPOINTERDECL , I1 , MEDIATION_LAYER ) ;
+
+    /* now generate tendencies for 4d vars if specified  */
+    for ( p = FourD ; p != NULL ; p = p->next )
+    {
+      if ( p->node_kind & FOURD && p->has_scalar_array_tendencies )
+      {
+	sprintf(fname,"%s_tend",p->name) ;
+        sprintf(post,",num_%s)",p->name) ;
+	dimspec=dimension_with_ranges( "grid%",",DIMENSION(",t2,p,post,"" ) ;
+        /*          type dim pdecl   name */
+        fprintf(fp, "%-10s%-20s%-10s :: %s\n",
+                    field_type( t1, p ) ,
+                    dimspec ,
+                    "" ,
+                    fname ) ;
+	sprintf(fname,"%s_old",p->name) ;
+        sprintf(post,",num_%s)",p->name) ;
+	dimspec=dimension_with_ranges( "grid%",",DIMENSION(",t2,p,post,"" ) ;
+        /*          type dim pdecl   name */
+        fprintf(fp, "#ifndef NO_I1_OLD\n") ;
+        fprintf(fp, "%-10s%-20s%-10s :: %s\n",
+                    field_type( t1, p ) ,
+                    dimspec ,
+                    "" ,
+                    fname ) ;
+        fprintf(fp, "#endif\n") ;
+
+      }
+    }
+    close_the_file( fp ) ;
+  }
+  return(0) ;
+}
+
+int
+gen_decls ( FILE * fp , char * corename , node_t * node , int sw_ranges, int sw_point , int mask , int layer )
+{
+  node_t * p ; 
+  int tag, ipass ;
+  char fname[NAMELEN], post[NAMELEN] ;
+  char * dimspec ;
+  int bdyonly = 0 ;
+
+  if ( node == NULL ) return(1) ;
+
+  bdyonly = mask & BDYONLY ;
+
+/* make two passes; the first is for scalars, second for arrays.                     */
+/* do it this way so that the scalars get declared first (some compilers complain    */
+/* if a scalar is used to declare an array before it's declared)                     */
+
+  for ( ipass = 0 ; ipass < 2 ; ipass++ ) 
+  {
+  for ( p = node->fields ; p != NULL ; p = p->next )
+  {
+    if ( p->node_kind & mask )
+    {
+      /* add an extra dimension to the 4d arrays.                                       */
+      /* note the call to dimension_with_colons, below, does this by itself             */
+      /* but dimension_with_ranges needs help (since the last arg is not just a colon)  */
+
+      if       ( p->node_kind & FOURD ) { 
+          sprintf(post,",num_%s)",field_name(t4,p,0)) ;
+      } else { 
+          sprintf(post,")") ;
+      }
+
+      for ( tag = 1 ; tag <= p->ntl ; tag++ ) 
+      {
+
+        /* if this is a core-specific variable, if we are generating non-driver-layer              */
+        /* declarations, and if this not a variable for the core named in corename, short-circuit  */
+        if (!strncmp( p->use, "dyn_", 4 ) && layer != DRIVER_LAYER && strcmp( p->use+4, corename)) continue ;
+
+        /* if this is a core-specific variable, prepend the name of the core to                    */
+        /* the variable at the driver level                                                        */
+        if (!strncmp( p->use, "dyn_", 4 ) && layer == DRIVER_LAYER )
+          sprintf(fname,"%s_%s",p->use+4,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+        else
+          strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+
+        switch ( sw_ranges )
+        {
+	  case COLON_RANGE :
+	    dimspec=dimension_with_colons( ",DIMENSION(",t2,p,")" ) ; break ;
+	  case GRIDREF :
+	    dimspec=dimension_with_ranges( "grid%",",DIMENSION(",t2,p,post,"" ) ; break ;
+	  case ARGADJ :
+	    dimspec=dimension_with_ranges( "",",DIMENSION(",t2,p,post,"" ) ; break ;
+        }
+
+        if ( !strcmp( dimspec, "" ) && ipass == 1 ) continue ; /* short circuit scalars on 2nd pass  */
+        if (  strcmp( dimspec, "" ) && ipass == 0 ) continue ; /* short circuit arrays on 2nd pass   */
+        if ( bdyonly && p->node_kind & FIELD && ! p->boundary_array )  continue ;  /* short circuit all fields except bdy arrrays */
+
+        /*          type dim pdecl   name */
+        fprintf(fp, "%-10s%-20s%-10s :: %s\n",
+                    field_type( t1, p ) ,
+                    dimspec ,
+                    (sw_point==POINTERDECL)?declare_array_as_pointer(t3,p):"" ,
+                    fname ) ;
+      }
+    }
+  }
+  }
+  return(0) ;
+}
+
+int
+gen_state_subtypes1 ( FILE * fp , node_t * node , int sw_ranges , int sw_point , int mask )
+{
+  node_t * p ;
+  int i ;
+  int new;
+  char TypeName [NAMELEN] ;
+  char tempname [NAMELEN] ;
+  if ( node == NULL ) return(1) ;
+  for ( p = node->fields ; p != NULL ; p = p->next )
+  {
+    if ( p->type != NULL )
+      if ( p->type->type_type == DERIVED )
+      {
+        new = 1 ;    /* determine if this is a new type -ajb */
+        strcpy( tempname, p->type->name ) ;
+        for ( i = 0 ; i < get_num_typedefs() ; i++ )        
+        { 
+          strcpy( TypeName, get_typename_i(i) ) ;
+          if ( ! strcmp( TypeName, tempname ) ) new = 0 ;
+        }
+
+        if ( new )   /* add this type to the history and generate declarations -ajb */
+        {
+          add_typedef_name ( tempname ) ;
+          gen_state_subtypes1 ( fp , p->type , sw_ranges , sw_point , mask ) ;
+          fprintf(fp,"TYPE %s\n",p->type->name) ;
+          gen_decls ( fp , "", p->type , sw_ranges , sw_point , mask , DRIVER_LAYER ) ;
+          fprintf(fp,"END TYPE %s\n",p->type->name) ;
+        }
+      }
+  }
+  return(0) ;
+}
+
+/* old version of gen_state_subtypes1 -ajb */
+/*
+int
+gen_state_subtypes1 ( FILE * fp , node_t * node , int sw_ranges , int sw_point , int mask )
+{
+  node_t * p ;
+  int tag ;
+  if ( node == NULL ) return(1) ;
+  for ( p = node->fields ; p != NULL ; p = p->next )
+  {
+    if ( p->type != NULL )
+      if ( p->type->type_type == DERIVED )
+      {
+        gen_state_subtypes1 ( fp , p->type , sw_ranges , sw_point , mask ) ;
+        fprintf(fp,"TYPE %s\n",p->type->name) ;
+        gen_decls ( fp , "", p->type , sw_ranges , sw_point , mask , DRIVER_LAYER ) ;
+        fprintf(fp,"END TYPE %s\n",p->type->name) ;
+      }
+  }
+  return(0) ;
+}
+*/
Index: trunk/WRF.COMMON/WRFV2/tools/gen_interp.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_interp.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_interp.c	(revision 2744)
@@ -0,0 +1,364 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+int contains_str( char *s1, char *s2 )
+{
+  int i ;
+  char *p, *q, *r ;
+  if ( s2 == NULL || s1 == NULL ) return ( 0 ) ;
+  if ( *s2 == '\0' || *s1 == '\0' ) return ( 0 ) ;
+  p = s1 ;
+  while ( *p ) {
+    if ((r = (char *)index( p , *s2 )) == NULL ) { return( 0 ) ; }
+    for ( q = s2 ; *q && *r == *q ; r++ , q++ )  ;
+    if ( *q == '\0' ) return (1) ;
+    p++ ;
+  }
+  return( 0 ) ;
+}
+
+int contains_tok( char *s1, char *s2, char *delims )
+{
+  char *p ;
+  char tempstr[8092] ;
+
+  strcpy( tempstr , s1 ) ;
+  p = strtok ( tempstr, delims ) ;
+  while ( p != NULL )
+  {
+    if ( !strcmp ( p , s2 ) ) {  return(1) ;}
+    p = strtok( NULL, delims ) ;
+  }
+  return(0) ;
+}
+  
+
+char halo_define[4*4096], halo_use[NAMELEN], halo_id[NAMELEN], upper_case_corename[NAMELEN], x[NAMELEN] ;
+
+int 
+gen_nest_interp ( char * dirname )
+{
+  char * corename ;
+  char * fnlst[] = { "nest_forcedown_interp.inc" , "nest_interpdown_interp.inc" , 
+                     "nest_feedbackup_interp.inc", "nest_feedbackup_smooth.inc",
+                     0L } ;
+  int down_path[] = { FORCE_DOWN , INTERP_DOWN , INTERP_UP, SMOOTH_UP } ;
+  int ipath ;
+  char ** fnp ; char * fn ;
+  char fname[NAMELEN] ;
+  FILE * fp ;
+  int i ;
+
+  for ( fnp = fnlst , ipath = 0 ; *fnp ; fnp++ , ipath++ )
+  {
+    fn = *fnp ;
+    for ( i = 0 ; i < get_num_cores() ; i++ )
+    {
+      corename = get_corename_i(i) ;
+      if ( dirname == NULL || corename == NULL ) return(1) ;
+      if ( strlen(dirname) > 0 )
+       { sprintf(fname,"%s/%s_%s",dirname,corename,fn) ; }
+      else
+       { sprintf(fname,"%s_%s",corename,fn) ; }
+      if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+      print_warning(fp,fname) ;
+
+strcpy( upper_case_corename , corename ) ;
+make_upper_case( upper_case_corename ) ;
+if      ( down_path[ipath] == INTERP_DOWN ) { sprintf(halo_id,"HALO_%s_INTERP_DOWN",upper_case_corename) ; }
+else if ( down_path[ipath] == FORCE_DOWN  ) { sprintf(halo_id,"HALO_%s_FORCE_DOWN",upper_case_corename) ; }
+else if ( down_path[ipath] == INTERP_UP   ) { sprintf(halo_id,"HALO_%s_INTERP_UP",upper_case_corename) ; }
+else if ( down_path[ipath] == SMOOTH_UP   ) { sprintf(halo_id,"HALO_%s_INTERP_SMOOTH",upper_case_corename) ; }
+sprintf(halo_define,"80:") ;
+sprintf(halo_use,"dyn_%s",corename) ;
+
+#if 0
+      gen_nest_interp1 ( fp , Domain.fields, corename, NULL, down_path[ipath], (down_path[ipath]==FORCE_DOWN)?1:2 ) ;
+#else
+      gen_nest_interp1 ( fp , Domain.fields, corename, NULL, down_path[ipath], (down_path[ipath]==FORCE_DOWN)?2:2 ) ;
+#endif
+
+{
+  node_t * comm_struct ;
+  comm_struct = new_node( HALO ) ;
+  strcpy( comm_struct->name        , halo_id     ) ;
+  strcpy( comm_struct->use         , halo_use    ) ;
+  strcpy( comm_struct->comm_define , halo_define ) ;
+  add_node_to_end( comm_struct , &Halos ) ;
+}
+
+
+      close_the_file(fp) ;
+    }
+  }
+  return(0) ; 
+}
+
+
+int
+gen_nest_interp1 ( FILE * fp , node_t * node, char * corename , char * fourdname, int down_path , int use_nest_time_level )
+{
+  int i, ii ;
+  char * fn = "nest_interp.inc" ;
+  char fname[NAMELEN] ;
+  node_t *p, *p1, *dim ;
+  int d2, d3, xdex, ydex, zdex, io_mask ;
+  char ddim[3][2][NAMELEN] ;
+  char mdim[3][2][NAMELEN] ;
+  char pdim[3][2][NAMELEN] ;
+  char ddim2[3][2][NAMELEN] ;
+  char mdim2[3][2][NAMELEN] ;
+  char pdim2[3][2][NAMELEN] ;
+  char nddim[3][2][NAMELEN] ;
+  char nmdim[3][2][NAMELEN] ;
+  char npdim[3][2][NAMELEN] ;
+  char nddim2[3][2][NAMELEN] ;
+  char nmdim2[3][2][NAMELEN] ;
+  char npdim2[3][2][NAMELEN] ;
+  char vname[NAMELEN] ; char vname2[NAMELEN] ; char tag[NAMELEN], tag2[NAMELEN] ; char core[NAMELEN], core2[NAMELEN] ;
+  char fcn_name[NAMELEN] ;
+  char xstag[NAMELEN], ystag[NAMELEN] ;
+  char dexes[NAMELEN] ;
+  char ndexes[NAMELEN] ;
+  char *maskstr ;
+  char *grid ;
+
+
+  for ( p1 = node ;  p1 != NULL ; p1 = p1->next )
+  {
+    if ( p1->node_kind & FOURD )
+    {
+      if ( p1->members->next ) {
+        io_mask = p1->members->next->io_mask ;
+      } else {
+        continue ;
+      }
+    }
+    else
+    {
+      io_mask = p1->io_mask ;
+    }
+    p = p1 ;
+
+    if ( io_mask & down_path )
+    {
+      if ((!strncmp( p->use, "dyn_", 4) && !strcmp(p->use+4,corename)) || strncmp( p->use, "dyn_", 4))
+      {
+
+        if (!strncmp( p->use, "dyn_", 4))   sprintf(core,"%s_",corename,vname) ;
+        else                                sprintf(core,"") ;
+
+        if ( p->ntl > 1 ) { sprintf(tag,"_2") ; sprintf(tag2,"_%d", use_nest_time_level) ; }
+        else              { sprintf(tag,"")   ; sprintf(tag2,"")                         ; }
+
+        /* construct variable name */
+        if ( p->node_kind & FOURD ) {
+
+sprintf(x, "%s%s", p->name, tag ) ;
+if ( ! contains_tok ( halo_define , x , ":," ) ) {
+ if ( halo_define[strlen(halo_define)-1] == ':' ) { strcat(halo_define,p->name) ; strcat(halo_define,tag) ; }
+ else                                             { strcat(halo_define,",") ; strcat(halo_define,p->name) ; strcat(halo_define,tag) ; }
+}
+          strcpy(dexes,"grid%sm31,grid%sm32,grid%sm33") ;
+          sprintf(vname,"%s%s(%s,itrace)",p->name,tag,dexes) ;
+          strcpy(ndexes,"ngrid%sm31,ngrid%sm32,ngrid%sm33") ;
+          sprintf(vname2,"%s%s%s(%s,itrace)",core,p->name,tag2,ndexes) ;
+
+          if ( down_path & SMOOTH_UP ) {
+            strcpy( fcn_name , p->members->next->smoothu_fcn_name ) ;
+	  } else {
+            strcpy( fcn_name , (down_path & INTERP_UP)?p->members->next->interpu_fcn_name:((down_path & FORCE_DOWN)?p->members->next->force_fcn_name:p->members->next->interpd_fcn_name) ) ;
+          }
+        }
+        else
+        {
+          sprintf(vname,"%s%s",p->name,tag) ;
+
+if ( ! contains_tok ( halo_define , vname  , ":," ) ) {
+ if ( halo_define[strlen(halo_define)-1] == ':' ) { strcat(halo_define,vname) ; }
+ else                                             { strcat(halo_define,",") ; strcat(halo_define,vname) ; }
+}
+          sprintf(vname2,"%s%s%s",core,p->name,tag2) ;
+          if ( down_path & SMOOTH_UP ) {
+            strcpy( fcn_name , p->smoothu_fcn_name ) ;
+	  } else {
+            strcpy( fcn_name , (down_path & INTERP_UP)?p->interpu_fcn_name:((down_path & FORCE_DOWN)?p->force_fcn_name:p->interpd_fcn_name) ) ;
+	  }
+        }
+
+        if ( p1->node_kind & FOURD ) {
+          grid = "" ;
+          set_dim_strs ( p->members->next , ddim , mdim , pdim , "c", 1 ) ;
+          set_dim_strs ( p->members->next , ddim2 , mdim2 , pdim2 , "c", 0 ) ;
+          set_dim_strs ( p->members->next , nddim , nmdim , npdim , "n", 1 ) ;
+          set_dim_strs ( p->members->next , nddim2 , nmdim2 , npdim2 , "n", 0 ) ;
+          zdex = get_index_for_coord( p->members->next , COORD_Z ) ;
+          xdex = get_index_for_coord( p->members->next , COORD_X ) ;
+          ydex = get_index_for_coord( p->members->next , COORD_Y ) ;
+          if ( p->members->next->stag_x ) strcpy( xstag, ".TRUE." ) ; else strcpy( xstag, ".FALSE." ) ;
+          if ( p->members->next->stag_y ) strcpy( ystag, ".TRUE." ) ; else strcpy( ystag, ".FALSE." ) ;
+          if ( p->members->next->stag_x && p->members->next->stag_y ) {
+	    maskstr = "_xystag" ;
+	  } else if ( p->stag_x ) {
+	    maskstr = "_xstag" ;
+	  } else if ( p->stag_y ) {
+	    maskstr = "_ystag" ;
+	  } else {
+	    maskstr = "_nostag" ;
+	  }
+        } else {
+          grid = "grid%" ;
+          set_dim_strs ( p , ddim , mdim , pdim , "c", 1 ) ;
+          set_dim_strs ( p , ddim2 , mdim2 , pdim2 , "c", 0 ) ;
+          set_dim_strs ( p , nddim , nmdim , npdim , "n", 1 ) ;
+          set_dim_strs ( p , nddim2 , nmdim2 , npdim2 , "n", 0 ) ;
+          zdex = get_index_for_coord( p , COORD_Z ) ;
+          xdex = get_index_for_coord( p , COORD_X ) ;
+          ydex = get_index_for_coord( p , COORD_Y ) ;
+          if ( p->stag_x ) strcpy( xstag, ".TRUE." ) ; else strcpy( xstag, ".FALSE." ) ;
+          if ( p->stag_y ) strcpy( ystag, ".TRUE." ) ; else strcpy( ystag, ".FALSE." ) ;
+          if ( p->stag_x && p->stag_y ) {
+	    maskstr = "_xystag" ;
+	  } else if ( p->stag_x ) {
+	    maskstr = "_xstag" ;
+	  } else if ( p->stag_y ) {
+	    maskstr = "_ystag" ;
+	  } else {
+	    maskstr = "_nostag" ;
+	  }
+        }
+
+        if ( p->node_kind & FOURD )
+	{
+fprintf(fp,"DO itrace = PARAM_FIRST_SCALAR, num_%s\n",p->name ) ;
+	}
+
+fprintf(fp,"CALL %s (                                                               &         \n", fcn_name ) ;
+
+        if ( zdex >= 0 ) {
+
+/* note this is only good for IKJ */
+
+fprintf(fp,"                  %s%s,                                                           &         ! CD field\n", grid, (p->node_kind & FOURD)?vname:vname2) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! CD dims\n",
+                ddim[0][0], ddim[0][1], ddim[1][0], ddim[1][1], ddim[2][0], ddim[2][1] ) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! CD dims\n",
+                mdim[0][0], mdim[0][1], mdim[1][0], mdim[1][1], mdim[2][0], mdim[2][1] ) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! CD dims\n",
+                pdim[0][0], pdim[0][1], pdim2[1][0], pdim2[1][1], pdim[2][0], pdim[2][1] ) ;
+if ( ! (down_path  & SMOOTH_UP)  ) {
+fprintf(fp,"                  ngrid%%%s,                                                        &   ! ND field\n", vname2) ;
+}
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! ND dims\n",
+                nddim[0][0], nddim[0][1], nddim[1][0], nddim[1][1], nddim[2][0], nddim[2][1] ) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! ND dims\n",
+                nmdim[0][0], nmdim[0][1], nmdim[1][0], nmdim[1][1], nmdim[2][0], nmdim[2][1] ) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! ND dims\n",
+                npdim[0][0], npdim[0][1], npdim2[1][0], npdim2[1][1], npdim[2][0], npdim[2][1] ) ;
+
+        } else {
+
+/* note this is only good for IKJ */
+
+fprintf(fp,"                  %s%s,                                                           &         ! CD field\n", grid, (p->node_kind & FOURD)?vname:vname2) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! CD dims\n",
+                ddim[0][0], ddim[0][1],          "1",         "1", ddim[1][0], ddim[1][1] ) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! CD dims\n",
+                mdim[0][0], mdim[0][1],          "1",         "1", mdim[1][0], mdim[1][1] ) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! CD dims\n",
+                pdim[0][0], pdim[0][1],          "1",         "1", pdim[1][0], pdim[1][1] ) ;
+if ( ! (down_path  & SMOOTH_UP)  ) {
+fprintf(fp,"                  ngrid%%%s,                                                        &   ! ND field\n", vname2) ;
+}
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! ND dims\n",
+                nddim[0][0], nddim[0][1],           "1",          "1", nddim[1][0], nddim[1][1] ) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! ND dims\n",
+                nmdim[0][0], nmdim[0][1],           "1",          "1", nmdim[1][0], nmdim[1][1] ) ;
+fprintf(fp,"                 %s, %s, %s, %s, %s, %s,   &         ! ND dims\n",
+                npdim[0][0], npdim[0][1],           "1",          "1", npdim[1][0], npdim[1][1] ) ;
+
+        }
+
+if ( ! (down_path  & SMOOTH_UP)  ) {
+  if ( sw_deref_kludge == 1 ) {
+fprintf(fp,"                  config_flags%%shw, ngrid%%imask%s(nims,njms),         &         ! stencil half width\n",maskstr) ;
+  } else {
+fprintf(fp,"                  config_flags%%shw, ngrid%%imask%s,         &         ! stencil half width\n",maskstr) ;
+  }
+}
+fprintf(fp,"                  %s, %s,                                                &         ! xstag, ystag\n", xstag, ystag ) ;
+fprintf(fp,"                  ngrid%%i_parent_start, ngrid%%j_parent_start,                     &\n") ;
+fprintf(fp,"                  ngrid%%parent_grid_ratio, ngrid%%parent_grid_ratio                &\n") ;
+   
+        {
+           char tmpstr[NAMELEN], *p1 ;
+           node_t * nd, * pp  ;
+           pp = NULL ;
+           if ( p->node_kind & FOURD ) {
+             if (  p->members->next ) {
+               pp = p->members->next ;
+             }
+           } else {
+             pp = p ;
+           }
+           if ( pp ) {
+             strcpy( tmpstr , "" ) ;
+             if        ( down_path & SMOOTH_UP ) {
+               strcpy( tmpstr , pp->smoothu_aux_fields ) ;
+	     } else if ( down_path & INTERP_UP ) {
+               strcpy( tmpstr , pp->interpu_aux_fields ) ;
+	     } else if ( down_path & FORCE_DOWN ) {
+               /* by default, add the boundary and boundary tendency fields to the arg list */
+               if ( ! p->node_kind & FOURD ) {
+                 sprintf( tmpstr , "%s_b,%s_bt,", pp->name, pp->name )  ;
+               } else {
+                 sprintf( tmpstr , "%s_b,%s_bt,", p->name, p->name )  ;
+               }
+               strcat( tmpstr , pp->force_aux_fields ) ;
+	     } else if ( down_path & INTERP_DOWN ) {
+               strcpy( tmpstr , pp->interpd_aux_fields ) ;
+	     }
+
+             for ( p1 = strtok(tmpstr,",") ; p1 != NULL ; p1 = strtok(NULL,",") )
+             {
+               if (( nd = get_entry ( p1 , Domain.fields )) != NULL )
+               {
+  	         if (!strncmp( nd->use, "dyn_", 4))   sprintf(core2,"%s_",corename,vname) ;
+	         else                                 sprintf(core2,"") ;
+                 if ( nd->boundary_array ) {
+                   if ( strcmp( nd->use , "_4d_bdy_array_" ) ) {
+                     fprintf(fp,",%s,ngrid%%%s%s  &\n", nd->name, core2, nd->name ) ;
+                   } else {
+                     fprintf(fp,",%s%s(1,1,1,1,itrace),ngrid%%%s%s(1,1,1,1,itrace)  &\n", core2, nd->name, core2, nd->name ) ;
+                   }
+                 } else {
+                   fprintf(fp,",grid%%%s%s,ngrid%%%s%s  &\n", core2, nd->name, core2, nd->name ) ;
+                 }
+               }
+               else
+               {
+	         fprintf(stderr,"REGISTRY WARNING: Don't know about %s in definition of %s\n",p1,vname) ;
+	       }
+             }
+           }
+        }
+
+fprintf(fp,"                  ) \n") ;
+
+        if ( p->node_kind & FOURD )
+        {
+fprintf(fp,"ENDDO\n") ;
+        }
+
+        }
+     }
+  }
+
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/gen_mod_state_descr.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_mod_state_descr.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_mod_state_descr.c	(revision 2744)
@@ -0,0 +1,73 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+int
+gen_module_state_description ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "module_state_description.F" ;
+
+  strcpy( fname, fn ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  gen_module_state_description1 ( fp , &Domain ) ;
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+gen_module_state_description1 ( FILE * fp , node_t * node )
+{
+  node_t * p, * q ; 
+  char * x ;
+
+  if ( node == NULL ) return(1) ;
+
+  fprintf(fp,"MODULE module_state_description\n") ;
+
+  fprintf(fp,"  ! package constants\n") ;
+  for ( p = Packages ; p != NULL ; p = p->next )
+  {
+    x=index(p->pkg_assoc,'=') ; x+=2 ;
+    fprintf(fp,"  INTEGER, PARAMETER :: %s = %s\n",p->name,x) ;
+  }
+  fprintf(fp,"  ! 4D array constants\n") ;
+  for ( p = FourD ; p != NULL ; p=p->next4d )
+  {
+    int c1 ;
+    for( q = p->members, c1=0 ; q != NULL ; q=q->next, c1++ )
+    {
+      if ( strcmp(q->name,"-" ) ) 
+      {
+        fprintf(fp,"  INTEGER, PARAMETER :: PARAM_%s = %d\n",q->name,c1) ;
+        fprintf(fp,"  INTEGER            ::     P_%s = 1\n",q->name) ;
+        fprintf(fp,"  LOGICAL            ::     F_%s = .FALSE.\n",q->name) ;
+      }
+    }
+    fprintf(fp,"  INTEGER, PARAMETER :: PARAM_NUM_%s = %d\n",p->name,c1) ;
+    fprintf(fp,"  INTEGER            ::       NUM_%s = 1\n",p->name) ;
+  }
+  fprintf(fp,"  INTEGER, PARAMETER :: %-30s = %d\n", "P_XSB",1 ) ;
+  fprintf(fp,"  INTEGER, PARAMETER :: %-30s = %d\n", "P_XEB",2 ) ;
+  fprintf(fp,"  INTEGER, PARAMETER :: %-30s = %d\n", "P_YSB",3 ) ;
+  fprintf(fp,"  INTEGER, PARAMETER :: %-30s = %d\n", "P_YEB",4 ) ;
+
+  fprintf(fp,"  INTEGER, PARAMETER :: NUM_TIME_LEVELS = %d\n", max_time_level ) ;
+  fprintf(fp,"  INTEGER , PARAMETER :: PARAM_FIRST_SCALAR = 2\n" ) ;
+
+  fprintf(fp,"CONTAINS\n" ) ;
+  fprintf(fp,"SUBROUTINE init_module_state_description\n" ) ;
+  fprintf(fp,"END SUBROUTINE init_module_state_description\n" ) ;
+  fprintf(fp,"END MODULE module_state_description\n") ;
+
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/gen_model_data_ord.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_model_data_ord.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_model_data_ord.c	(revision 2744)
@@ -0,0 +1,38 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+int
+gen_model_data_ord ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "model_data_order.inc" ;
+  int i ;
+
+  if ( dirname == NULL ) return(1) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  else                       { sprintf(fname,"%s",fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  fprintf(fp,"INTEGER , PARAMETER :: model_data_order   = DATA_ORDER_") ;
+  for ( i = 0 ; i < 3 ; i++ )
+  {
+    switch ( model_order[i] )
+    {
+    case ( COORD_X ) : fprintf(fp,"X") ; break ;
+    case ( COORD_Y ) : fprintf(fp,"Y") ; break ;
+    case ( COORD_Z ) : fprintf(fp,"Z") ; break ;
+    default : fprintf(stderr,"Model data order ambiguous. Is there a dimspec for all three coordinate axes?\n") ;  break ;
+    }
+  }
+  fprintf(fp,"\n") ;
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/gen_scalar_derefs.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_scalar_derefs.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_scalar_derefs.c	(revision 2744)
@@ -0,0 +1,108 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+#define DUMMY 1
+#define ACTUAL 2 
+
+int
+gen_scalar_derefs ( char * dirname )
+{
+  int i ;
+  
+  for ( i = 0 ; i < get_num_cores() ; i++ )
+    scalar_derefs ( dirname , get_corename_i(i) ) ; 
+  return(0) ;
+}
+
+#define DIR_COPY_OUT 1
+#define DIR_COPY_IN  2
+
+int
+scalar_derefs ( char * dirname , char * corename )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "_scalar_derefs.inc" ;
+  char * p ;
+  int linelen ;
+  char outstr[64*4096] ;
+
+  if ( dirname == NULL || corename == NULL ) return(1) ;
+  if ( strlen(dirname) > 0 ) 
+   { sprintf(fname,"%s/%s%s",dirname,corename, fn) ; }
+  else                       
+   { sprintf(fname,"%s%s",corename,fn) ; }
+
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  fprintf(fp,"! BEGIN SCALAR DEREFS\n") ;
+  linelen = 0 ;
+  if ( sw_limit_args ) {
+    fprintf(fp,"#undef CPY\n") ;
+    fprintf(fp,"#undef CPYC\n") ;
+    fprintf(fp,"#ifdef COPY_OUT\n") ;
+    scalar_derefs1 ( fp , corename , &Domain, DIR_COPY_OUT ) ;
+    fprintf(fp,"#else\n") ;
+    scalar_derefs1 ( fp , corename , &Domain, DIR_COPY_IN ) ;
+    fprintf(fp,"#endif\n") ;
+  }
+  fprintf(fp,"! END SCALAR DEREFS\n") ;
+  close_the_file( fp ) ;
+  return(0) ;
+}
+
+int
+scalar_derefs1 ( FILE * fp , char * corename, node_t * node, int direction )
+{
+  node_t * p ;
+  int tag ;
+  char fname[NAMELEN] ;
+
+  if ( node == NULL ) return(1) ;
+  for ( p = node->fields ; p != NULL ; p = p->next )
+  {
+    if ( p->node_kind & I1 ) continue ;              /* short circuit any field that is not state */
+                                                     /* short circuit DERIVED types */
+    if ( p->type->type_type == DERIVED ) continue ;
+                                                     /* short circuit non-scalars */
+    if ( p->ndims > 0 ) continue ; 
+
+    if (                 (
+                                                   /* if it's a core specific field and we're doing that core or... */
+          (p->node_kind & FIELD && (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4)))
+                                                   /* it is not a core specific field and it is not a derived type -ajb */
+       || (p->node_kind & FIELD && (p->type->type_type != DERIVED) && ( strncmp("dyn_",p->use,4)))
+#if 0
+                                                   /* it is a state variable */
+       || (p->node_kind & RCONFIG )
+#endif
+                         )
+       )
+    {
+      for ( tag = 1 ; tag <= p->ntl ; tag++ )
+      {
+        char * x ;
+        /* if this is a core-specific variable, prepend the name of the core to */
+        /* the variable at the driver level */
+        if (!strcmp( corename , p->use+4 )) { x = "C" ; } else { x = "" ; }
+        strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
+        /* generate deref */
+        if ( direction == DIR_COPY_OUT ) {
+          if (!strcmp( corename , p->use+4 )) { fprintf(fp, " grid%%%s_%s = %s\n",corename,fname,fname) ; }
+          else                                { fprintf(fp, " grid%%%s    = %s\n",fname,fname ) ; }
+        } else {
+          if (!strcmp( corename , p->use+4 )) { fprintf(fp, " %s = grid%%%s_%s\n",fname,corename,fname) ; }
+          else                                { fprintf(fp, " %s = grid%%%s\n",fname,fname ) ; }
+        }
+      }
+    }
+  }
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/gen_scalar_indices.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_scalar_indices.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_scalar_indices.c	(revision 2744)
@@ -0,0 +1,167 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+
+int
+gen_scalar_indices ( char * dirname )
+{
+  FILE * fp ;
+  char  fname[NAMELEN] ;
+  char * fn = "scalar_indices.inc" ;
+  char * fn2 = "scalar_tables.inc" ;
+  char * fn3 = "scalar_tables_init.inc" ;
+  char * fn4 = "scalar_indices_init.inc" ;
+
+  strcpy( fname, fn ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
+  print_warning(fp,fname) ;
+  gen_scalar_indices1 ( fp ) ;
+  close_the_file( fp ) ;
+
+  strcpy( fname, fn2 ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn2) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) { fprintf(stderr,"returning\n") ; return(1) ; }
+  print_warning(fp,fname) ;
+  gen_scalar_tables ( fp ) ;
+  close_the_file( fp ) ;
+
+  strcpy( fname, fn3 ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn3) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) { fprintf(stderr,"returning\n") ; return(1) ; }
+  print_warning(fp,fname) ;
+  gen_scalar_tables_init ( fp ) ;
+  close_the_file( fp ) ;
+
+  strcpy( fname, fn4 ) ;
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn4) ; }
+  if ((fp = fopen( fname , "w" )) == NULL ) { fprintf(stderr,"returning\n") ; return(1) ; }
+  print_warning(fp,fname) ;
+  gen_scalar_indices_init ( fp ) ;
+  close_the_file( fp ) ;
+
+  return(0) ;
+}
+
+int
+gen_scalar_tables ( FILE * fp )
+{
+  node_t * p ;
+  for ( p = FourD ; p != NULL ; p=p->next4d )
+  {
+    fprintf(fp,"  INTEGER :: %s_index_table( param_num_%s, max_domains )\n",p->name,p->name )  ;
+    fprintf(fp,"  INTEGER :: %s_num_table( max_domains )\n", p->name,p->name ) ;
+    fprintf(fp,"  INTEGER :: %s_stream_table( max_domains, param_num_%s )\n", p->name,p->name ) ;
+    fprintf(fp,"  CHARACTER*256 :: %s_dname_table( max_domains, param_num_%s )\n", p->name,p->name ) ;
+    fprintf(fp,"  CHARACTER*256 :: %s_desc_table( max_domains, param_num_%s )\n", p->name,p->name ) ;
+    fprintf(fp,"  CHARACTER*256 :: %s_units_table( max_domains, param_num_%s )\n", p->name,p->name ) ;
+  }
+  return(0) ;
+}
+
+int
+gen_scalar_tables_init ( FILE * fp )
+{
+  node_t * p ;
+  for ( p = FourD ; p != NULL ; p=p->next4d )
+  {
+    fprintf(fp,"  %s_num_table( j ) = 1\n",p->name )  ;
+  }
+  return(0) ;
+}
+
+int
+gen_scalar_indices_init ( FILE * fp )
+{
+  node_t * p ;
+  for ( p = FourD ; p != NULL ; p=p->next4d )
+  {
+    fprintf(fp,"  num_%s = %s_num_table( idomain )\n",p->name,p->name )  ;
+  }
+  return(0) ;
+}
+
+int
+gen_scalar_indices1 ( FILE * fp )
+{
+  node_t * p, * memb , * pkg, * rconfig, * fourd, *x ; 
+  char * c , *pos1, *pos2 ;
+  char assoc_namelist_var[NAMELEN], assoc_namelist_choice[NAMELEN], assoc_4d[NAMELEN] ;
+  char scalars_str[NAMELEN] ;
+  char * scalars ;
+
+  for ( p = FourD ; p != NULL ; p = p->next )
+   { for ( memb = p->members ; memb != NULL ; memb = memb->next )
+      { if ( strcmp(memb->name,"-") ) fprintf(fp,"  P_%s = 1 ; F_%s = .FALSE. \n", memb->name, memb->name ) ; } }
+
+  for ( pkg = Packages ; pkg != NULL ; pkg = pkg->next )
+  {
+    strcpy( assoc_namelist_var , pkg->pkg_assoc ) ;
+    if ((c = index( assoc_namelist_var , '=' ))==NULL) continue ;
+    *c = '\0' ; c += 2 ;
+    strcpy( assoc_namelist_choice , c ) ;
+    if ((rconfig=get_rconfig_entry ( assoc_namelist_var )) == NULL )
+     { fprintf(stderr,
+       "WARNING: There is no associated namelist variable %s\n",
+        assoc_namelist_var) ; return(1) ; }
+    fprintf(fp,"  IF (model_config_rec%%%s%s==%s)THEN\n",
+		 assoc_namelist_var,
+		 (atoi(rconfig->nentries)!=1)?"(idomain)":"",  /* a little tricky; atoi of nentries will be '0' for a string like max_domains */
+		 assoc_namelist_choice) ;
+    strcpy(scalars_str,pkg->pkg_4dscalars) ;
+
+    if ((scalars = strtok_rentr(scalars_str,";", &pos1)) != NULL)
+    {
+      while ( scalars != NULL ) {
+
+        if ((c = strtok_rentr(scalars,":",&pos2)) != NULL) strcpy(assoc_4d,c) ; /* get name of associated 4d array */
+        if (strcmp(c,"-")) {
+          if ((fourd=get_4d_entry( assoc_4d )) == NULL )
+           { fprintf(stderr, "WARNING: There is no 4D array named %s\n",assoc_4d);continue;}
+          for ( c = strtok_rentr(NULL,",",&pos2) ; c != NULL ; c = strtok_rentr(NULL,",",&pos2) )
+          {
+            if ( ( x = get_entry( c , fourd->members )) == NULL )
+              { fprintf(stderr, "WARNING: %s is not a member of 4D array %s\n",c,assoc_4d);continue;}
+            fprintf(fp,"   IF ( %s_index_table( PARAM_%s , idomain ) .lt. 1 ) THEN\n",assoc_4d,c) ;
+            fprintf(fp,"     %s_num_table(idomain) = %s_num_table(idomain) + 1\n",assoc_4d,assoc_4d) ;
+            fprintf(fp,"     P_%s = %s_num_table(idomain)\n",c,assoc_4d) ;
+            fprintf(fp,"     %s_index_table( PARAM_%s , idomain ) = P_%s\n",assoc_4d,c,c) ;
+            fprintf(fp,"   ELSE\n") ;
+            fprintf(fp,"     P_%s = %s_index_table( PARAM_%s , idomain )\n",c,assoc_4d,c)  ;
+            fprintf(fp,"   END IF\n") ;
+            {
+              char fourd_bnd[NAMELEN] ;
+              /* check for the existence of a fourd boundary array associated with this 4D array */
+              /* set io_mask accordingly for gen_wrf_io to know that it should generate i/o for _b and _bt */
+              /* arrays */
+              sprintf(fourd_bnd,"%s_b",assoc_4d) ;
+              if ( get_entry( fourd_bnd  ,Domain.fields) != NULL ) {
+                 x->io_mask |= BOUNDARY ;
+              }
+            }
+            fprintf(fp,"   %s_stream_table( idomain, P_%s ) = %d\n",assoc_4d,c, x->io_mask ) ;
+            fprintf(fp,"   %s_dname_table( idomain, P_%s ) = '%s'\n",assoc_4d,c,x->dname) ;
+            fprintf(fp,"   %s_desc_table( idomain, P_%s ) = '%s'\n",assoc_4d,c,x->descrip) ;
+            fprintf(fp,"   %s_units_table( idomain, P_%s ) = '%s'\n",assoc_4d,c,x->units) ;
+            fprintf(fp,"   F_%s = .TRUE.\n",c) ;
+          }
+        }
+
+        scalars = strtok_rentr(NULL,";", &pos1) ;
+
+      }
+    }
+
+    fprintf(fp,"  END IF\n") ;
+  }
+
+  return(0) ;
+}
+
+
Index: trunk/WRF.COMMON/WRFV2/tools/gen_wrf_io.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/gen_wrf_io.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/gen_wrf_io.c	(revision 2744)
@@ -0,0 +1,1312 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+#include "sym.h"
+
+static FILE * fp ;
+
+#define GEN_INPUT  1
+#define GEN_OUTPUT 2
+
+#define OP_F(A,B) \
+  fn = B ; \
+  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; } \
+  else                       { sprintf(fname,"%s",fn) ; } \
+  if ((A = fopen( fname , "w" )) == NULL ) return(1) ; \
+  print_warning(A,fname) ; \
+  sym_forget() ;
+
+int
+gen_wrf_io ( char * dirname )
+{
+  char  fname[NAMELEN], *fn ;
+
+  if ( dirname == NULL ) return(1) ;
+
+#if 1
+
+  OP_F(fp,"wrf_metaput_input.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields ,
+      METADATA | INPUT , GEN_OUTPUT ) ;
+
+  OP_F(fp,"wrf_metaput_restart.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields ,
+      METADATA | RESTART , GEN_OUTPUT ) ;
+
+  OP_F(fp,"wrf_metaput_history.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields ,
+      METADATA | HISTORY , GEN_OUTPUT ) ;
+
+  OP_F(fp,"wrf_metaput_boundary.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields ,
+      METADATA | BOUNDARY , GEN_OUTPUT ) ;
+
+  OP_F(fp,"wrf_histout.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , HISTORY , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist1out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST1 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist2out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST2 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist3out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST3 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist4out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST4 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+
+  OP_F(fp,"wrf_auxhist5out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST5 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist6out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST6 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist7out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST7 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist8out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST8 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist9out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST9 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist10out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST10 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist11out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST11 , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+
+  OP_F(fp,"wrf_inputout.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , INPUT   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput1out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT1   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput2out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT2   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput3out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT3   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput4out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT4   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput5out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT5   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput6out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT6   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput7out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT7   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput8out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT8   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput9out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT9   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput10out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT10   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput11out.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT11   , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_restartout.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , RESTART , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_bdyout.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , BOUNDARY , GEN_OUTPUT ) ;
+  close_the_file(fp) ;
+#endif
+
+#if 1
+  OP_F(fp,"wrf_metaget_input.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , 
+      METADATA | INPUT , GEN_INPUT ) ;
+
+  OP_F(fp,"wrf_metaget_restart.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , 
+      METADATA | RESTART , GEN_INPUT ) ;
+
+  OP_F(fp,"wrf_metaget_history.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , 
+      METADATA | HISTORY , GEN_INPUT ) ;
+
+  OP_F(fp,"wrf_metaget_boundary.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , 
+      METADATA | BOUNDARY , GEN_INPUT ) ;
+
+  OP_F(fp,"wrf_histin.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , HISTORY , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist1in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST1 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist2in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST2 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist3in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST3 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist4in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST4 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist5in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST5 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist6in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST6 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist7in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST7 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist8in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST8 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist9in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST9 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist10in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST10 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxhist11in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXHIST11 , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_inputin.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , INPUT   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput1in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT1   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput2in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT2   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput3in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT3   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput4in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT4   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput5in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT5   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput6in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT6   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput7in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT7   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput8in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT8   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput9in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT9   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput10in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT10   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_auxinput11in.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , AUXINPUT11   , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_restartin.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , RESTART , GEN_INPUT ) ;
+  close_the_file(fp) ;
+  OP_F(fp,"wrf_bdyin.inc") ;
+  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , BOUNDARY , GEN_INPUT ) ;
+  close_the_file(fp) ;
+#endif
+
+  return(0) ;
+}
+
+int
+set_dim_strs ( node_t *node , char ddim[3][2][NAMELEN], char mdim[3][2][NAMELEN], char pdim[3][2][NAMELEN] , char * prepend , int sw_disregard_stag )
+{
+  int i, j ;
+  node_t *p ;
+  char d ;
+  char * stag ;
+  if ( node == NULL ) return(1) ;
+  for ( i = 0 ; i < 3 ; i++ )
+    for ( j = 0 ; j < 2 ; j++ )
+      {
+        strcpy(ddim[i][j],"1") ;
+        strcpy(mdim[i][j],"1") ;
+        strcpy(pdim[i][j],"1") ;
+      }
+
+  for ( i = 0 ; i < node->ndims ; i++ )
+  {
+    p = node->dims[i] ;
+    if      ( p->len_defined_how == DOMAIN_STANDARD )
+    {
+      if ( sw_3dvar_iry_kludge ) {
+        switch( p->coord_axis )
+        {
+                                                 /* vvv */
+        case(COORD_X) : d = 'i' ; stag = (node->stag_y||sw_disregard_stag)?"%s%cde":"(%s%cde-1)" ; break ;
+        case(COORD_Y) : d = 'j' ; stag = (node->stag_x||sw_disregard_stag)?"%s%cde":"(%s%cde-1)" ; break ;
+                                                 /* ^^^ */
+        case(COORD_Z) : d = 'k' ; stag = (node->stag_z||sw_disregard_stag)?"%s%cde":"(%s%cde-1)" ; break ;
+        default : stag = "1" ; break ;
+        }
+      } else {
+        switch( p->coord_axis )
+        {
+        case(COORD_X) : d = 'i' ; stag = (node->stag_x||sw_disregard_stag)?"%s%cde":"(%s%cde-1)" ; break ;
+        case(COORD_Y) : d = 'j' ; stag = (node->stag_y||sw_disregard_stag)?"%s%cde":"(%s%cde-1)" ; break ;
+        case(COORD_Z) : d = 'k' ; stag = (node->stag_z||sw_disregard_stag)?"%s%cde":"(%s%cde-1)" ; break ;
+        default : stag = "1" ; break ;
+        }
+      }
+       
+      sprintf(ddim[i][0],"%s%cds",prepend,d) ;
+      sprintf(ddim[i][1],stag,prepend,d) ;  /* note that stag has printf format info in it */
+      sprintf(mdim[i][0],"%s%cms",prepend,d) ;
+      sprintf(mdim[i][1],"%s%cme",prepend,d) ;
+      sprintf(pdim[i][0],"%s%cps",prepend,d) ;
+      if ( ! sw_disregard_stag )
+        sprintf(pdim[i][1],"MIN( %s, %s%cpe )",ddim[i][1],prepend,d) ;
+      else
+        sprintf(pdim[i][1],"%s%cpe",prepend,d) ;
+    }
+    else if ( p->len_defined_how == NAMELIST )
+    {
+      if ( !strcmp( p->assoc_nl_var_s, "1" ) )
+      {
+        sprintf(ddim[i][0],"1") ;
+        sprintf(mdim[i][0],"1") ;
+        sprintf(pdim[i][0],"1") ;
+      }
+      else
+      {
+        sprintf(ddim[i][0],"config_flags%%%s",p->assoc_nl_var_s) ;
+        sprintf(mdim[i][0],"config_flags%%%s",p->assoc_nl_var_s) ;
+        sprintf(pdim[i][0],"config_flags%%%s",p->assoc_nl_var_s) ;
+      }
+      sprintf(ddim[i][1],"config_flags%%%s",p->assoc_nl_var_e) ;
+      sprintf(mdim[i][1],"config_flags%%%s",p->assoc_nl_var_e) ;
+      sprintf(pdim[i][1],"config_flags%%%s",p->assoc_nl_var_e) ;
+    }
+    else if ( p->len_defined_how == CONSTANT )
+    {
+      sprintf(ddim[i][0],"%d",p->coord_start ) ;
+      sprintf(ddim[i][1],"%d",p->coord_end   ) ; 
+      sprintf(mdim[i][0],"%d",p->coord_start ) ;
+      sprintf(mdim[i][1],"%d",p->coord_end   ) ; 
+      sprintf(pdim[i][0],"%d",p->coord_start ) ;
+      sprintf(pdim[i][1],"%d",p->coord_end   ) ; 
+    }
+  }
+  return(0) ;
+}
+
+int
+gen_wrf_io2 ( FILE * fp , char * fname, char * structname , char * fourdname, node_t * node , int io_mask , int sw_io )
+{
+  node_t * p ;
+  int i , ii  ;
+  char x[NAMELEN], tag[NAMELEN], dexes[NAMELEN] ;
+  char dname[NAMELEN], dname_tmp[NAMELEN] ; 
+  char vname[NAMELEN], vname_x[NAMELEN],vname_1[NAMELEN], vname_2[NAMELEN], memord[NAMELEN] ;
+  char ddim[3][2][NAMELEN] ;
+  char mdim[3][2][NAMELEN] ;
+  char pdim[3][2][NAMELEN] ;
+  char ddim_no[3][2][NAMELEN] ;
+  char mdim_no[3][2][NAMELEN] ;
+  char pdim_no[3][2][NAMELEN] ;
+  char dimname[3][NAMELEN] ;
+  char core[NAMELEN] ;
+  char stagstr[NAMELEN] ;
+  char * tend_tag ;
+
+  char post[NAMELEN] ;
+  char indices[NAMELEN] ;
+
+  int pass, passes, stagx, stagy, stagz ;
+  int xi, yi, zi ;
+  node_t * dimnode ;
+  int ok_to_collect_distribute ;
+
+/* set a flag according to what the stream is, if we're running on dm processors, if the
+   io layer cannot handle distributed data, and if we're selectively turning off the
+   collect/distribute message passing so that history and restart I/O is to separate files
+   but input and boundary I/O is unaffected */
+
+  ok_to_collect_distribute = !sw_distrib_io_layer && 
+                              sw_dm_parallel && 
+                             !(sw_dm_serial_in_only && ((io_mask&HISTORY)  ||
+                                                        (io_mask&AUXHIST1) ||
+                                                        (io_mask&AUXHIST2) ||
+                                                        (io_mask&AUXHIST3) ||
+                                                        (io_mask&AUXHIST4) ||
+                                                        (io_mask&AUXHIST5) ||
+                                                        (io_mask&AUXHIST6) ||
+                                                        (io_mask&AUXHIST7) ||
+                                                        (io_mask&AUXHIST8) ||
+                                                        (io_mask&AUXHIST9) ||
+                                                        (io_mask&AUXHIST10) ||
+                                                        (io_mask&AUXHIST11) ||
+                                                        (io_mask&RESTART))) ;
+
+  if ( node == NULL ) return(1) ;
+  if ( structname == NULL ) return(1) ;
+  if ( fp == NULL ) return(1) ;
+
+  for ( p = node ; p != NULL ; p = p->next )
+  {
+
+    if ( p->ndims > 3 ) continue ; /* short circuit anything with more than 3 dims, (not counting 4d arrays) */
+
+    if ( p->node_kind & I1 ) continue ;  /* short circuit anything that's not a state var */
+
+    set_dim_strs( p, ddim, mdim, pdim , "", 0 ) ;           /* dimensions with staggering */
+    set_dim_strs( p, ddim_no, mdim_no, pdim_no , "", 1 ) ;  /* dimensions ignoring staggering */
+
+    strcpy(stagstr, "") ;
+    if ( p->stag_x ) strcat(stagstr, "X") ;
+    if ( p->stag_y ) strcat(stagstr, "Y") ;
+    if ( p->stag_z ) strcat(stagstr, "Z") ;
+
+    if ( !strcmp(p->name,"-") ) continue ;
+
+    if ( p->node_kind & FOURD )
+    {
+      node_t * nd , *pp ;
+      char p1[NAMELEN], sv[NAMELEN], tl[25] ;
+
+      set_dim_strs( p->members, ddim, mdim, pdim , "", 0 ) ;           /* dimensions with staggering */
+      set_dim_strs( p->members, ddim_no, mdim_no, pdim_no , "", 1 ) ;  /* dimensions ignoring staggering */
+
+      if ( ! ( io_mask & BOUNDARY ) )
+      {
+fprintf(fp,"DO itrace = PARAM_FIRST_SCALAR , num_%s\n",p->name ) ;
+fprintf(fp,"  IF (BTEST(%s_stream_table(grid%%id, itrace ) , switch )) THEN\n",p->name) ;
+fprintf(fp,"    CALL wrf_ext_%s_field (  &\n", (sw_io == GEN_INPUT)?"read":"write" ) ;
+fprintf(fp,"          fid                             , &  ! DataHandle\n") ;
+fprintf(fp,"          current_date(1:19)              , &  ! DateStr\n") ; 
+fprintf(fp,"          TRIM(%s_dname_table( grid%%id, itrace )), & !data name\n",p->name) ;
+        strcpy( tl, "" ) ;
+        if ( p->members->ntl > 1 && p->members->ntl <= 3 ) sprintf( tl, "_%d",p->members->ntl ) ;
+        if ( ok_to_collect_distribute ) {
+fprintf(fp,"                       globbuf_%s               , &  ! Field \n",p->members->type->name ) ;
+        } else {
+fprintf(fp,"          grid%%%s%s(ims,kms,jms,itrace)  , &  ! Field\n",p->name,tl) ;
+        }
+        if (!strncmp(p->members->type->name,"real",4)) {
+          fprintf(fp,"                       WRF_FLOAT             , &  ! FieldType \n") ;
+        } else {
+          fprintf(fp,"                       WRF_%s             , &  ! FieldType \n" , p->members->type->name ) ;
+        }
+fprintf(fp,"          grid%%communicator  , &  ! Comm\n") ;
+fprintf(fp,"          grid%%iocommunicator  , &  ! Comm\n") ;
+fprintf(fp,"          grid%%domdesc       , &  ! Comm\n") ;
+fprintf(fp,"          grid%%bdy_mask       , &  ! bdy_mask\n") ;
+        if ( sw_io == GEN_OUTPUT ) {
+fprintf(fp,"          dryrun             , &  ! flag\n") ;
+        }
+        set_mem_order( p->members, memord , NAMELEN) ;
+fprintf(fp,"          'XZY'               , &  ! MemoryOrder\n") ;
+        strcpy(stagstr, "") ;
+        if ( p->members->stag_x ) strcat(stagstr, "X") ;
+        if ( p->members->stag_y ) strcat(stagstr, "Y") ;
+        if ( p->members->stag_z ) strcat(stagstr, "Z") ;
+fprintf(fp,"          '%s'                , &  ! Stagger\n",stagstr) ;
+        if ( sw_io == GEN_OUTPUT ) {
+          for ( i = 0 ; i < 3 ; i++ ) strcpy(dimname[i],"") ;
+          for ( i = 0 ; i < 3 ; i++ )
+          {
+            if (( dimnode = p->members->dims[i]) != NULL )
+            {
+              switch ( dimnode->coord_axis )
+              {
+              case (COORD_X) :
+                if ( ( ! sw_3dvar_iry_kludge && p->members->stag_x ) || ( sw_3dvar_iry_kludge && p->members->stag_y ) )
+                 { sprintf( dimname[i] ,"%s_stag", dimnode->dim_data_name) ; }
+                else
+                 { strcpy( dimname[i], dimnode->dim_data_name) ; }
+                break ;
+              case (COORD_Y) :
+                if ( ( ! sw_3dvar_iry_kludge && p->members->stag_y ) || ( sw_3dvar_iry_kludge && p->members->stag_x ) )
+                 { sprintf( dimname[i] ,"%s_stag", dimnode->dim_data_name) ; }
+                else
+                 { strcpy( dimname[i], dimnode->dim_data_name) ; }
+                break ;
+              case (COORD_Z) :
+                if ( p->members->stag_z )
+                 { sprintf( dimname[i] ,"%s_stag", dimnode->dim_data_name) ; }
+                else
+                 { strcpy( dimname[i], dimnode->dim_data_name) ; }
+                break ;
+              }
+            }
+          }
+fprintf(fp,"                       '%s'               , &  ! Dimname 1 \n",dimname[0] ) ;
+fprintf(fp,"                       '%s'               , &  ! Dimname 2 \n",dimname[1] ) ;
+fprintf(fp,"                       '%s'               , &  ! Dimname 3 \n",dimname[2] ) ;
+fprintf(fp,"          %s_desc_table( grid%%id, itrace  ), & ! Desc\n",p->name) ;
+fprintf(fp,"          %s_units_table( grid%%id, itrace  ), & ! Units\n",p->name) ;
+        }
+fprintf(fp,"'%s ext_write_field '//TRIM(%s_dname_table( grid%%id, itrace ))//' memorder XZY' , & ! Debug message\n", fname, p->name ) ;
+        /* global dimensions */
+        for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",ddim[i][0], ddim[i][1]) ; }
+        fprintf(fp," & \n") ;
+        /* mem    dimensions */
+        for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",mdim[i][0], mdim[i][1]) ; }
+        fprintf(fp," & \n") ;
+        /* patch  dimensions */
+        for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",pdim[i][0], pdim[i][1]) ; }
+        fprintf(fp," & \n") ;
+fprintf(fp,"                         ierr )\n" ) ;
+fprintf(fp, "  ENDIF\n" ) ;
+fprintf(fp, "ENDDO\n") ;
+      } 
+/* BOUNDARY FOR 4-D TRACER */
+      else if ( io_mask & BOUNDARY )
+      {
+        int ibdy ;
+        int idx ;
+        node_t *fourd_bound_array ;
+        char *bdytag, *xdomainend, *ydomainend, *zdomainend, bdytag2[10],fourd_bnd[NAMELEN] ;
+        char *ds1,*de1,*ds2,*de2,*ds3,*de3,*ms1,*me1,*ms2,*me2,*ms3,*me3,*ps1,*pe1,*ps2,*pe2,*ps3,*pe3 ;
+
+/* check for the existence of a fourd boundary array */
+        sprintf(fourd_bnd,"%s_b",p->name) ;
+        if (( fourd_bound_array = get_entry( fourd_bnd  ,Domain.fields)) != NULL ) {
+
+          for ( i = 0 ; i < 3 ; i++ ) strcpy(dimname[i],"") ;
+          strcpy( dimname[2] , "bdy_width" ) ;
+          ds3 = "1" ; de3 = "config_flags%spec_bdy_width" ;
+          ms3 = "1" ; me3 = "config_flags%spec_bdy_width" ;
+          ps3 = "1" ; pe3 = "config_flags%spec_bdy_width" ;
+          if (( dimnode = get_dimnode_for_coord( p , COORD_Z )) != NULL )
+           { if ( p->stag_z ) { sprintf( dimname[1] ,"%s_stag", dimnode->dim_data_name) ; }
+             else             { strcpy(  dimname[1], dimnode->dim_data_name) ; }
+             if ( p->stag_z ) { zdomainend = "kde" ; }
+             else             { zdomainend = "(kde-1)" ; }
+             ds2 = "kds" ; de2 = zdomainend ;
+             ms2 = "kds" ; me2 = "kde" ;   /* 20020924 */
+             ps2 = "kds" ; pe2 = zdomainend ;
+           }
+          else
+           {
+             fprintf(stderr,"REGISTRY WARNING: 4D ARRAYS MUST HAVE VERT DIMENSION\n") ;
+           }
+          for ( pass = 0 ; pass < 2 ; pass++ ) {
+fprintf(fp,"DO itrace = PARAM_FIRST_SCALAR , num_%s\n",p->name ) ;
+fprintf(fp,"  IF (BTEST(%s_stream_table(grid%%id, itrace ) , switch )) THEN\n",p->name) ;
+          for ( ibdy = 1 ; ibdy <= 4 ; ibdy++ )
+          {
+            if        ( pass == 0 && ibdy == 1 ) { bdytag = "_BXS" ;      /* west bdy   */
+            } else if ( pass == 0 && ibdy == 2 ) { bdytag = "_BXE" ;      /* east bdy   */
+            } else if ( pass == 0 && ibdy == 3 ) { bdytag = "_BYS" ;      /* south bdy   */
+            } else if ( pass == 0 && ibdy == 4 ) { bdytag = "_BYE" ;      /* north bdy   */
+            } else if ( pass == 1 && ibdy == 1 ) { bdytag = "_BTXS" ;      /* west bdy   */
+            } else if ( pass == 1 && ibdy == 2 ) { bdytag = "_BTXE" ;      /* east bdy   */
+            } else if ( pass == 1 && ibdy == 3 ) { bdytag = "_BTYS" ;      /* south bdy   */
+            } else if ( pass == 1 && ibdy == 4 ) { bdytag = "_BTYE" ;      /* north bdy   */
+            }
+            if ( ibdy == 1 || ibdy == 2 ) {
+              if (( dimnode = get_dimnode_for_coord( p , COORD_Y )) != NULL )
+              {
+                idx = get_index_for_coord( p , COORD_Y  ) ;
+                if ( p->stag_y ) { ydomainend = "jde" ; } else { ydomainend = "(jde-1)" ; }
+                ds1 = "1" ; de1 = ydomainend ;
+                ms1 = "1" ; me1 = "MAX( ide , jde )" ;
+                if        ( sw_io == GEN_INPUT ) {
+                  ps1 = "1" ; pe1 = ydomainend ;
+                } else if ( sw_io == GEN_OUTPUT ) {
+                  ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
+                }
+                if ( p->stag_y ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
+                else                   { strcpy( dimname[0], dimnode->dim_data_name) ; }
+              }
+            }
+            if ( ibdy == 3 || ibdy == 4 ) {
+              if (( dimnode = get_dimnode_for_coord( p , COORD_X )) != NULL )
+              {
+                idx = get_index_for_coord( p , COORD_X  ) ;
+                if ( p->stag_x ) { xdomainend = "ide" ; } else { xdomainend = "(ide-1)" ; }
+                ds1 = "1" ; de1 = xdomainend ;
+                ms1 = "1" ; me1 = "MAX( ide , jde )" ;
+                if        ( sw_io == GEN_INPUT ) {
+                  ps1 = "1" ; pe1 = xdomainend ;
+                } else if ( sw_io == GEN_OUTPUT ) {
+                  ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
+                }
+                if ( p->stag_x ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
+                else             { strcpy( dimname[0], dimnode->dim_data_name) ; }
+              }
+            }
+            if      ( p->ndims == 3 ) sprintf(memord,"%sZ",bdytag+2+pass ) ;
+            else if ( p->ndims == 2 ) sprintf(memord,"%s",bdytag+2+pass ) ;
+            else                      sprintf(memord,"0") ;
+fprintf(fp,"    CALL wrf_ext_%s_field (  &\n", (sw_io == GEN_INPUT)?"read":"write" ) ;
+fprintf(fp,"          fid                             , &  ! DataHandle\n") ;
+fprintf(fp,"          current_date(1:19)              , &  ! DateStr\n") ; 
+fprintf(fp,"          TRIM(%s_dname_table( grid%%id, itrace )) // '%s', & !data name\n",p->name,bdytag) ;
+            if ( ok_to_collect_distribute ) {
+fprintf(fp,"                       globbuf_%s               , &  ! Field \n",p->members->type->name ) ;
+            } else {
+              strcpy(bdytag2,"") ;
+              strncat(bdytag2,bdytag, pass+2) ;
+fprintf(fp,"          grid%%%s%s(1,kds,1,%d,itrace)  , &  ! Field\n",p->name,bdytag2,ibdy) ;
+            }
+            if (!strncmp(p->members->type->name,"real",4)) {
+              fprintf(fp,"                       WRF_FLOAT             , &  ! FieldType \n") ;
+            } else {
+              fprintf(fp,"                       WRF_%s             , &  ! FieldType \n" , p->members->type->name ) ;
+            }
+fprintf(fp,"          grid%%communicator  , &  ! Comm\n") ;
+fprintf(fp,"          grid%%iocommunicator  , &  ! Comm\n") ;
+fprintf(fp,"          grid%%domdesc       , &  ! Comm\n") ;
+fprintf(fp,"          grid%%bdy_mask       , &  ! bdy_mask\n") ;
+            if ( sw_io == GEN_OUTPUT ) {
+fprintf(fp,"          dryrun             , &  ! flag\n") ;
+            }
+fprintf(fp,"          '%s'               , &  ! MemoryOrder\n",memord) ;
+            strcpy(stagstr, "") ;
+            if ( p->members->stag_x ) strcat(stagstr, "X") ;
+            if ( p->members->stag_y ) strcat(stagstr, "Y") ;
+            if ( p->members->stag_z ) strcat(stagstr, "Z") ;
+fprintf(fp,"          '%s'                , &  ! Stagger\n",stagstr) ;
+            if ( sw_io == GEN_OUTPUT ) {
+fprintf(fp,"                       '%s'               , &  ! Dimname 1 \n",dimname[0] ) ;
+fprintf(fp,"                       '%s'               , &  ! Dimname 2 \n",dimname[1] ) ;
+fprintf(fp,"                       '%s'               , &  ! Dimname 3 \n",dimname[2] ) ;
+fprintf(fp,"          %s_desc_table( grid%%id, itrace  ), & ! Desc\n",p->name) ;
+fprintf(fp,"          %s_units_table( grid%%id, itrace  ), & ! Units\n",p->name) ;
+            }
+fprintf(fp,"'%s ext_write_field '//TRIM(%s_dname_table( grid%%id, itrace ))//' memorder XZY' , & ! Debug message\n", fname, p->name ) ;
+fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ds1,de1,ds2,de2,ds3,de3 ) ;
+fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ms1,me1,ms2,me2,ms3,me3 ) ;
+fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ps1,pe1,ps2,pe2,ps3,pe3 ) ;
+fprintf(fp,"                         ierr )\n" ) ;
+          }
+fprintf(fp, "  ENDIF\n" ) ;
+fprintf(fp, "ENDDO\n") ;
+        }
+      }
+      } /* if fourd bound array associated with this tracer */
+    }
+    else if ( p->type != NULL )
+    {
+
+    if ( p->type->type == SIMPLE )
+    {
+
+/* ////////  BOUNDARY ///////////////////// */
+
+      if (  p->io_mask & BOUNDARY && (io_mask & BOUNDARY) && !( io_mask & METADATA ) 
+         && strcmp( p->use, "_4d_bdy_array_" ) || ( io_mask & BOUNDARY && fourdname ) )
+      {
+        int ibdy ;
+        int idx ;
+        char *bdytag, *xdomainend, *ydomainend, *zdomainend ;
+        char *ds1,*de1,*ds2,*de2,*ds3,*de3,*ms1,*me1,*ms2,*me2,*ms3,*me3,*ps1,*pe1,*ps2,*pe2,*ps3,*pe3 ;
+
+        if (!strncmp( p->use, "dyn_", 4))
+          sprintf(core,"%s_",p->use+4) ;
+        else
+          strcpy(core,"") ;
+
+        for ( i = 0 ; i < 3 ; i++ ) strcpy(dimname[i],"") ;
+        strcpy( dimname[2] , "bdy_width" ) ;
+        ds3 = "1" ; de3 = "config_flags%spec_bdy_width" ;
+        ms3 = "1" ; me3 = "config_flags%spec_bdy_width" ;
+        ps3 = "1" ; pe3 = "config_flags%spec_bdy_width" ;
+
+        if (( dimnode = get_dimnode_for_coord( p , COORD_Z )) != NULL )
+         { if ( p->stag_z ) { sprintf( dimname[1] ,"%s_stag", dimnode->dim_data_name) ; } 
+           else             { strcpy(  dimname[1], dimnode->dim_data_name) ; }
+           if ( p->stag_z ) { zdomainend = "kde" ; } 
+           else             { zdomainend = "(kde-1)" ; }
+           ds2 = "kds" ; de2 = zdomainend ;
+           ms2 = "kds" ; me2 = "kde" ;   /* 20020924 */
+           ps2 = "kds" ; pe2 = zdomainend ;
+         }
+        else
+         { strcpy(dimname[1],dimname[2]) ;
+           strcpy(dimname[2],"one_element") ; 
+           ds2 = ds3 ; de2 = de3 ;
+           ms2 = ms3 ; me2 = me3 ;
+           ps2 = ps3 ; pe2 = pe3 ;
+           ds3 = "1" ; de3 = "1" ;
+           ms3 = "1" ; me3 = "1" ;
+           ps3 = "1" ; pe3 = "1" ;
+         }
+
+        if ( strlen(p->dname) < 1 ) {
+          fprintf(stderr,"gen_wrf_io.c: Registry WARNING: no data name for %s \n",p->name) ;
+        }
+
+        for ( ibdy = 1 ; ibdy <= 4 ; ibdy++ )
+        {
+          if        ( ibdy == 1 ) { bdytag = "XS" ;      /* west bdy   */
+          } else if ( ibdy == 2 ) { bdytag = "XE" ;      /* east bdy   */
+          } else if ( ibdy == 3 ) { bdytag = "YS" ;      /* south bdy   */
+          } else if ( ibdy == 4 ) { bdytag = "YE" ;      /* north bdy   */
+          }
+          if ( strlen(p->dname)==0 || !strcmp(p->dname,"-") ) { sprintf(dname,"%s%s",p->name,bdytag)  ; }
+          else                                                { sprintf(dname,"%s%s",p->dname,bdytag) ; }
+
+          make_upper_case(dname) ;
+
+          if ( ibdy == 1 || ibdy == 2 ) { 
+            if (( dimnode = get_dimnode_for_coord( p , COORD_Y )) != NULL )
+            {
+              idx = get_index_for_coord( p , COORD_Y  ) ;
+              if ( p->stag_y ) { ydomainend = "jde" ; } else { ydomainend = "(jde-1)" ; }
+              ds1 = "1" ; de1 = ydomainend ;
+              ms1 = "1" ; me1 = "MAX( ide , jde )" ;
+              if        ( sw_io == GEN_INPUT ) {
+                ps1 = "1" ; pe1 = ydomainend ;
+              } else if ( sw_io == GEN_OUTPUT ) {
+                ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
+              }
+              if ( p->stag_y ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
+              else                   { strcpy( dimname[0], dimnode->dim_data_name) ; }
+            }
+          }
+          if ( ibdy == 3 || ibdy == 4 ) {
+            if (( dimnode = get_dimnode_for_coord( p , COORD_X )) != NULL )
+            {
+              idx = get_index_for_coord( p , COORD_X  ) ;
+              if ( p->stag_x ) { xdomainend = "ide" ; } else { xdomainend = "(ide-1)" ; }
+              ds1 = "1" ; de1 = xdomainend ;
+              ms1 = "1" ; me1 = "MAX( ide , jde )" ;
+              if        ( sw_io == GEN_INPUT ) {
+                ps1 = "1" ; pe1 = xdomainend ;
+              } else if ( sw_io == GEN_OUTPUT ) {
+                ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
+              }
+              if ( p->stag_x ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
+              else             { strcpy( dimname[0], dimnode->dim_data_name) ; }
+            }
+          }
+          if      ( p->ndims == 3 ) sprintf(memord,"%sZ",bdytag ) ;
+          else if ( p->ndims == 2 ) sprintf(memord,"%s",bdytag ) ;
+          else                      sprintf(memord,"0") ;
+
+        passes = 1 ;
+        if ( fourdname != NULL ) passes = 2 ;
+        for ( pass = 0 ; pass < passes ; pass++ ) {
+          tend_tag = ( pass == 0 ) ? "_B" : "_BT" ;
+	  if ( sw_io == GEN_INPUT )
+	  {
+	    if ( !strncmp( p->use, "dyn_", 4 ) ) 
+	      fprintf(fp,"IF ( grid%%dyn_opt .EQ. %s ) THEN\n",p->use) ;
+            if ( ok_to_collect_distribute )
+	      fprintf(fp,"IF ( wrf_dm_on_monitor() ) THEN\n") ;
+            fprintf(fp,"CALL wrf_ext_read_field (  &\n") ;
+            fprintf(fp,"                       fid                , &  ! DataHandle \n" ) ;
+            fprintf(fp,"                       current_date(1:19) , &  ! DateStr \n" ) ;
+            if ( fourdname == NULL ) {
+              fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
+              fprintf(fp,"                       %s%s%s(1,kds,1,%d)     , &  ! Field \n" , structname , core , p->name, ibdy ) ;
+            } else {
+              if ( strlen(p->dname)==0 || !strcmp(p->dname,"-") ) { sprintf(dname,"%s%s%s",p->name,tend_tag,bdytag)  ; }
+              else                                                { sprintf(dname,"%s%s%s",p->dname,tend_tag,bdytag) ; }
+              fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
+              fprintf(fp,"                       %s%s%s%s(1,kds,1,%d,P_%s)     , &  ! Field \n" , structname , core , fourdname, tend_tag, ibdy, p->name ) ;
+            }
+            if (!strncmp(p->type->name,"real",4)) {
+              fprintf(fp,"                       WRF_FLOAT             , &  ! FieldType \n") ;
+            } else {
+              fprintf(fp,"                       WRF_%s             , &  ! FieldType \n" , p->type->name ) ;
+            }
+            fprintf(fp,"                       grid%%communicator , &  ! Comm\n") ;
+            fprintf(fp,"                       grid%%iocommunicator , &  ! Comm\n") ;
+            fprintf(fp,"                       grid%%domdesc      , &  ! Comm\n") ;
+            fprintf(fp,"                       grid%%bdy_mask     , &  ! bdy_mask\n" ) ;
+            fprintf(fp,"                       '%s'               , &  ! MemoryOrder\n",memord ) ;
+            fprintf(fp,"                       '%s'               , &  ! Stagger\n",stagstr ) ;
+            fprintf(fp,"'%s ext_read_field %s memorder %s' , & ! Debug message\n",fname,dname,memord ) ;
+            /* global dimensions */
+            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ds1,de1,ds2,de2,ds3,de3 ) ;
+            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ms1,me1,ms2,me2,ms3,me3 ) ;
+            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ps1,pe1,ps2,pe2,ps3,pe3 ) ;
+            fprintf(fp,"                       ierr )\n") ;
+            if ( ok_to_collect_distribute )
+            {
+	      fprintf(fp,"ENDIF\n") ;
+	      fprintf(fp,"CALL wrf_dm_bcast_%s ( %s%s%s ( 1, 1 , 1 , %d ) , &\n",p->type->name, structname , core , p->name, ibdy) ;
+              fprintf(fp," ((%s)-(%s)+1)*((%s)-(%s)+1)*((%s)-(%s)+1)  )\n",me1,ms1,me2,ms2,me3,ms3)  ;
+            }
+	    if ( !strncmp( p->use, "dyn_", 4 ) ) 
+	      fprintf(fp,"END IF\n" ) ;
+	  }
+          else if ( sw_io == GEN_OUTPUT )
+	  {
+            if ( ok_to_collect_distribute )
+              fprintf(fp,"IF ( wrf_dm_on_monitor() ) THEN\n") ;
+            if ( !strncmp( p->use, "dyn_", 4 ) )
+              fprintf(fp,"IF ( grid%%dyn_opt .EQ. %s ) THEN\n",p->use) ;
+            fprintf(fp,"CALL wrf_ext_write_field (  &\n") ;
+            fprintf(fp,"                       fid                , &  ! DataHandle \n" ) ;
+            fprintf(fp,"                       current_date(1:19) , &  ! DateStr \n" ) ;
+            if ( fourdname == NULL ) {
+              fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
+              fprintf(fp,"                       %s%s%s(1,kds,1,%d)     , &  ! Field \n" , structname , core , p->name, ibdy ) ;
+            } else {
+              if ( strlen(p->dname)==0 || !strcmp(p->dname,"-") ) { sprintf(dname,"%s%s%s",p->name,tend_tag,bdytag)  ; }
+              else                                                { sprintf(dname,"%s%s%s",p->dname,tend_tag,bdytag) ; }
+              fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
+              fprintf(fp,"                       %s%s%s%s(1,kds,1,%d,P_%s)     , &  ! Field \n" , structname , core , fourdname, tend_tag, ibdy, p->name ) ;
+            }
+            if (!strncmp(p->type->name,"real",4)) {
+              fprintf(fp,"                       WRF_FLOAT          , &  ! FieldType \n") ;
+            } else {
+              fprintf(fp,"                       WRF_%s             , &  ! FieldType \n" , p->type->name ) ;
+            }
+            fprintf(fp,"                       grid%%communicator , &  ! Comm\n") ;
+            fprintf(fp,"                       grid%%iocommunicator , &  ! Comm\n") ;
+            fprintf(fp,"                       grid%%domdesc      , &  ! Comm\n") ;
+            fprintf(fp,"                       grid%%bdy_mask     , &  ! bdy_mask\n" ) ;
+            fprintf(fp,"                       dryrun             , &  ! flag\n" ) ;
+            fprintf(fp,"                       '%s'               , &  ! MemoryOrder\n",memord ) ;
+            fprintf(fp,"                       '%s'               , &  ! Stagger\n",stagstr ) ;
+            fprintf(fp,"                       '%s'               , &  ! Dimname 1 \n",dimname[0] ) ;
+            fprintf(fp,"                       '%s'               , &  ! Dimname 2 \n",dimname[1] ) ;
+            fprintf(fp,"                       '%s'               , &  ! Dimname 3 \n",dimname[2] ) ;
+            fprintf(fp,"                       '%s'               , &  ! Desc  \n",p->descrip ) ;
+            fprintf(fp,"                       '%s'               , &  ! Units \n",p->units ) ;
+            fprintf(fp,"'%s ext_write_field %s memorder %s' , & ! Debug message\n",fname,dname,memord ) ;
+            /* global dimensions */
+            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ds1,de1,ds2,de2,ds3,de3 ) ;
+            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ms1,me1,ms2,me2,ms3,me3 ) ;
+            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ps1,pe1,ps2,pe2,ps3,pe3 ) ;
+            fprintf(fp,"                       ierr )\n") ;
+            if ( !strncmp( p->use, "dyn_", 4 ) )
+              fprintf(fp,"END IF\n" ) ;
+            if ( ok_to_collect_distribute )
+              fprintf(fp,"ENDIF\n") ;
+	  }
+        }
+        }
+      }
+
+/* ////////  NOT BOUNDARY ///////////////////// */
+     else if ( (p->io_mask & io_mask) && ! (io_mask & BOUNDARY))
+     {
+
+/* Aug 2004
+
+Namelist variables
+
+The i r and h settings will be reenabled but it will work a little
+differently than i/o of regular state variables:
+
+1) rather than being read or written as records to the dataset, they
+will be gotten or put as time invariant meta data; in other words, they
+will only be written once when the dataset is created as the other
+metadata is now. This has the benefit of reducing the amount of I/O
+traffic on each write (I can't remember, but that may be why the
+reading and writing of rconfig data was turned off in the first
+place).
+
+2) All the rconfig variables will be gotten/put as metadata to input,
+restart, history, and boundary datasets, regardless of what the 'i',
+'r', and 'h' settings are.  Instead those settings will control the
+behavior with respect to the input-from-namelist vs input-from-dataset
+precedence issue that Bill raised.
+
+In other words, if an rconfig entry has an 'i', 'r', or 'h' in the
+Registry, the dataset value takes precedence over the namelist value.
+Otherwise, say it is missing the 'i', the reconfig variable's value
+still appears as metadata in the dataset but the value of the variable
+in the program does not change as a result of inputting the dataset.
+
+*/
+
+      if ( (p->node_kind & RCONFIG) && ( io_mask & METADATA ) )
+      {
+        char c ;
+        char dname[NAMELEN] ;
+
+        strcpy( dname, p->dname ) ; 
+        make_upper_case( dname ) ;
+        if      ( !strcmp( p->type->name , "integer" )         ) { c = 'i' ; }
+        else if ( !strcmp( p->type->name , "real" )            ) { c = 'r' ; }
+        else if ( !strcmp( p->type->name , "doubleprecision" ) ) { c = 'd' ; }
+        else if ( !strcmp( p->type->name , "logical" )         ) { c = 'l' ; }
+        else {
+          fprintf(stderr,"REGISTRY WARNING: unknown type %s for %s\n",p->type->name,p->name ) ;
+        }
+        if ( sw_io == GEN_OUTPUT ) {
+          if ( io_mask & p->io_mask ) {
+            fprintf(fp,"CALL rconfig_get_%s ( grid%%id, %cbuf(1) )\n",p->name,c) ;
+            fprintf(fp," CALL wrf_put_dom_ti_%s ( fid , '%s', %cbuf(1), 1, ierr )\n",p->type->name,dname,c) ;
+          }
+        } else {
+          if ( io_mask & p->io_mask ) {
+            fprintf(fp,"CALL wrf_get_dom_ti_%s ( fid , '%s', %cbuf(1), 1, ierr )\n",p->type->name,dname,c) ;
+            fprintf(fp," WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_%s for %s returns ',%cbuf(1)\n",p->type->name,dname,c) ;
+            fprintf(fp," CALL wrf_debug ( 300 , wrf_err_message )\n") ;
+            fprintf(fp," CALL rconfig_set_%s ( grid%%id, %cbuf(1) )\n",p->name,c) ;
+          }
+        }
+      }
+/* end Aug 2004 */
+#if 0
+      else if ( ! (io_mask & METADATA) )   /* state vars */
+#else
+      else if ( ! (io_mask & METADATA) && ! (p->node_kind & RCONFIG) )   /* state vars */
+#endif
+      {
+        if ( io_mask & RESTART && p->ntl > 1 ) passes = p->ntl ;
+        else                                   passes = 1 ;
+
+        for ( pass = 0 ; pass < passes ; pass++ )   /* for multi timelevel vars */
+        {
+          if (!strncmp( p->use, "dyn_", 4))
+	    sprintf(core,"%s_",p->use+4) ;
+	  else
+	    strcpy(core,"") ;
+
+		  /* for multi time level variables gen read for both levels
+		     for restart, only _2 for others */
+          if ( p->ntl > 1 ) {
+	    if ( io_mask & RESTART ) sprintf(tag,"_%d",pass+1) ;
+	    else                     sprintf(tag,"_%d",p->ntl) ;
+          }
+	  else              sprintf(tag,"") ; 
+
+          /* construct variable name */
+          if ( p->scalar_array_member )
+	  {
+	    strcpy(dexes,"") ;
+            for (ii = 0; ii < p->ndims; ii++ )
+	    {
+	      switch(p->dims[ii]->coord_axis)
+	      {
+	      case(COORD_X): strcat(dexes,"ims,") ; break ;
+	      case(COORD_Y): strcat(dexes,"jms,") ; break ;
+	      case(COORD_Z): strcat(dexes,"kms,") ; break ;
+	      default : break ;
+	      }
+	    }
+            sprintf(vname,"%s%s%s(%sP_%s)",core,p->use,tag,dexes,p->name) ;
+            sprintf(vname_2,"%s%s%s(%sP_%s)",core,p->use,"_2",":,:,:,",p->name) ;
+            sprintf(vname_1,"%s%s%s(%sP_%s)",core,p->use,"_1",":,:,:,",p->name) ;
+            sprintf(vname_x,"%s%s%s(%sP_%s)",core,p->use,tag,":,:,:,",p->name) ;
+	  }
+	  else
+	  {
+            sprintf(vname,"%s%s%s",core,p->name,tag) ;
+            sprintf(vname_x,"%s%s%s",core,p->name,tag) ;
+            sprintf(vname_1,"%s%s%s",core,p->name,"_1") ;
+            sprintf(vname_2,"%s%s%s",core,p->name,"_2") ;
+	  }
+
+
+          /* construct data name -- maybe same as vname if dname not spec'd  */
+          if ( strlen(p->dname) == 0 || !strcmp(p->dname,"-") ) { strcpy(dname_tmp,p->name) ; }
+          else                                                  { strcpy(dname_tmp,p->dname) ; }
+          make_upper_case(dname_tmp) ;
+
+/*
+   July 2004
+
+   New code to generate error if input or output for two state variables would be generated with the same dataname
+
+   example okay:
+    dyn_nmm  tg      "SOILTB"   -> dyn_nmm_tg,SOILTB
+    dyn_em   soiltb  "SOILTB"   -> dyn_em_tg,SOILTB
+   example wrong:
+    dyn_nmm  tg      "SOILTB"   -> dyn_nmm_tg,SOILTB
+    misc     soiltb  "SOILTB"   -> gen_soiltb,SOILTB
+   example wrong:
+     misc    tg      "SOILTB"   -> gen_tg,SOILTB
+     misc    soiltb  "SOILTB"   -> gen_soiltb,SOILTB
+
+*/
+if ( pass == 0 )
+{
+          char dname_symbol[128] ;
+          sym_nodeptr sym_node ;
+
+          sprintf(dname_symbol, "DNAME_%s", dname_tmp ) ;
+          /* check and see if it is in the symbol table already */
+
+          if ((sym_node = sym_get( dname_symbol )) == NULL ) {
+            /* add it */
+            sym_node = sym_add ( dname_symbol ) ;
+            strcpy( sym_node->internal_name , p->name ) ;
+            strcpy( sym_node->core_name , core ) ;
+          } else {
+            /* it's there already, check and make sure we don't have an error condition */
+            if ( (strlen(core) > 0 && strlen( sym_node->core_name ) > 0 && !strcmp( core, sym_node->core_name ))
+              || strlen(core) == 0
+              || strlen( sym_node->core_name ) == 0 )
+            {
+              char this_core[64] , sym_core[64] ;
+              strcpy(this_core,"(generic)") ;
+              if ( strlen(core) > 0 )                sprintf(this_core,"(%s)",core) ;
+              strcpy(sym_core,"(generic)") ;
+              if ( strlen(sym_node->core_name) > 0 ) sprintf(this_core,"(%s)",sym_node->core_name) ;
+              fprintf(stderr,"REGISTRY ERROR: Data-name collision on %s for %s %s and %s %s\n",
+                  dname_tmp,p->name,this_core,sym_node->internal_name,sym_core ) ;
+            }
+          }
+}
+/* end July 2004 */
+
+          if ( io_mask & RESTART &&  p->ntl > 1 ) sprintf(dname,"%s_%d",dname_tmp,pass+1) ;
+          else                                    strcpy(dname,dname_tmp) ;
+
+          set_mem_order( p, memord , NAMELEN) ;
+
+/* kludge for WRF 3DVAR I/O with MM5 analysis kernel */
+          if ( sw_3dvar_iry_kludge && !strcmp(memord,"XYZ") ) sprintf(memord,"YXZ") ;
+          if ( sw_3dvar_iry_kludge && !strcmp(memord,"XY") ) sprintf(memord,"YX") ;
+
+          if ( strlen(dname) < 1 ) {
+            fprintf(stderr,"gen_wrf_io.c: Registry WARNING:: no data name for %s \n",p->name) ;
+          }
+          if ( p->io_mask & io_mask && sw_io == GEN_INPUT )
+          {
+	    if ( !strncmp( p->use, "dyn_", 4 ) ) 
+	      fprintf(fp,"IF ( grid%%dyn_opt .EQ. %s ) THEN\n",p->use) ;
+	    if ( p->scalar_array_member )
+	      fprintf(fp,"IF ( P_%s .GE. PARAM_FIRST_SCALAR ) THEN\n",p->name) ;
+            if ( ok_to_collect_distribute )
+              fprintf(fp,"IF ( wrf_dm_on_monitor() ) THEN\n") ;
+
+            strcpy(indices,"") ;
+            sprintf(post,")") ;
+            if ( sw_io_deref_kludge && !(p->scalar_array_member) )   /* these aready have */
+            {
+              sprintf(indices, "%s",index_with_firstelem("(","grid%",t2,p,post)) ;
+            }
+
+	    fprintf(fp,"CALL wrf_ext_read_field (  &\n") ;
+	    fprintf(fp,"                       fid                , &  ! DataHandle \n" ) ;
+	    fprintf(fp,"                       current_date(1:19) , &  ! DateStr \n" ) ;
+	    fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
+            if ( p->ndims >= 2 && ok_to_collect_distribute )
+	      fprintf(fp,"                       globbuf_%s               , &  ! Field \n" , p->type->name ) ;
+            else
+	      fprintf(fp,"                       %s%s%s               , &  ! Field \n" , structname , vname , indices) ;
+
+            if (!strncmp(p->type->name,"real",4)) {
+              fprintf(fp,"                       WRF_FLOAT             , &  ! FieldType \n") ;
+            } else {
+              fprintf(fp,"                       WRF_%s             , &  ! FieldType \n" , p->type->name ) ;
+            }
+
+	    fprintf(fp,"                       grid%%communicator  , &  ! Comm\n") ;
+	    fprintf(fp,"                       grid%%iocommunicator  , &  ! Comm\n") ;
+	    fprintf(fp,"                       grid%%domdesc       , &  ! Comm\n") ;
+	    fprintf(fp,"                       grid%%bdy_mask     , &  ! bdy_mask\n") ;
+	    fprintf(fp,"                       '%s'               , &  ! MemoryOrder\n",memord ) ;
+	    fprintf(fp,"                       '%s'               , &  ! Stagger\n",stagstr ) ;
+	    fprintf(fp,"'%s ext_read_field %s memorder %s' , & ! Debug message\n",fname,dname,memord ) ;
+	    /* global dimensions */
+	    for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",ddim[i][0], ddim[i][1]) ; }
+	    fprintf(fp," & \n") ;
+
+/* the first two cases here have to do with if we're running on multiple distributed
+   memory processors and the i/o api layer can't handle decomposed data. So code is
+   generated to read the data on processor zero into a globally sized buffer. In this
+   case, then the domain, memory, and patch dimensions for the globally sized buffer
+   are all just the domain dimensions. Two D arrays are handled separately
+   from three-d arrays because in threeD arrays the middle index is K.  In the last
+   case, where the code is either calling a version of the API that supports parallelism
+   or we aren't running in DM-parallel, the field itself and not a global buffer are
+   passed, so we pass the domain, memory, and patch indices directly to the read routine. */
+
+            if      ( p->ndims == 3 && ok_to_collect_distribute )
+	    {
+	      /* mem    dimensions are actually domain dimensions */
+	      for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",ddim_no[i][0], ddim_no[i][1]) ; }
+	      fprintf(fp," & \n") ;
+	      /* patch  dimensions are actually domain dimensions */
+	      for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",ddim   [i][0], ddim   [i][1]) ; }
+	      fprintf(fp," & \n") ;
+	    }
+	    else if ( p->ndims == 2 && ok_to_collect_distribute )
+	    {
+	      if ((xi=get_index_for_coord(p,COORD_X))>=0&&(yi=get_index_for_coord(p,COORD_Y))>=0)
+	      {
+	        /* mem    dimensions are actually domain dimensions */
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1 , &\n",ddim_no[xi][0],ddim_no[xi][1],
+							  ddim_no[yi][0],ddim_no[yi][1] ) ;
+	      /* patch  dimensions are actually domain dimensions */
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1 , &\n",ddim   [xi][0],ddim   [xi][1],
+							  ddim   [yi][0],ddim   [yi][1] ) ;
+	      }
+	    }
+	    else
+	    {
+	      /* mem    dimensions */
+	      for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",mdim[i][0], mdim[i][1]) ; }
+	      fprintf(fp," & \n") ;
+	      /* patch  dimensions */
+	      for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",pdim[i][0], pdim[i][1]) ; }
+	      fprintf(fp," & \n") ;
+	    }
+	    fprintf(fp,"                       ierr )\n") ;
+
+            if ( ok_to_collect_distribute )
+	      fprintf(fp,"END IF\n" ) ;
+
+/* In case we have read into a global buffer, generate code to distribute the data just read in */
+            if      ( p->ndims == 3 && ok_to_collect_distribute )
+	    {
+	      if ((xi=get_index_for_coord(p,COORD_X))>=0&&(yi=get_index_for_coord(p,COORD_Y))>=0&&(zi=get_index_for_coord(p,COORD_Z))>=0)
+	      {
+	        fprintf(fp,"call wrf_global_to_patch_%s ( globbuf_%s , %s%s , &\n",p->type->name,p->type->name,structname , vname ) ;
+	        fprintf(fp,"       grid%%domdesc, %d, &\n",p->ndims) ;
+                fprintf(fp, "%s, %s, %s, %s, %s, %s, &\n",ddim_no[xi][0],ddim_no[xi][1],
+							  ddim_no[yi][0],ddim_no[yi][1],
+							  ddim_no[zi][0],ddim_no[zi][1]) ;
+                fprintf(fp, "%s, %s, %s, %s, %s, %s, &\n",mdim_no[xi][0],mdim_no[xi][1],
+							  mdim_no[yi][0],mdim_no[yi][1],
+							  mdim_no[zi][0],mdim_no[zi][1]) ;
+                fprintf(fp, "%s, %s, %s, %s, %s, %s  )\n",pdim_no[xi][0],pdim_no[xi][1],
+							  pdim_no[yi][0],pdim_no[yi][1],
+							  pdim_no[zi][0],pdim_no[zi][1]) ;
+	      }
+	    }
+	    else if ( p->ndims == 2 && ok_to_collect_distribute )
+	    {
+	      if ((xi=get_index_for_coord(p,COORD_X))>=0&&(yi=get_index_for_coord(p,COORD_Y))>=0)
+	      {
+	        fprintf(fp,"call wrf_global_to_patch_%s ( globbuf_%s , %s%s , &\n",p->type->name,p->type->name,structname , vname ) ;
+	        fprintf(fp,"       grid%%domdesc, %d, &\n",p->ndims) ;
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1 , &\n",ddim_no[xi][0],ddim_no[xi][1],
+							  ddim_no[yi][0],ddim_no[yi][1] ) ;
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1 , &\n",mdim_no[xi][0],mdim_no[xi][1],
+							  mdim_no[yi][0],mdim_no[yi][1] ) ;
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1   )\n",pdim_no[xi][0],pdim_no[xi][1],
+							  pdim_no[yi][0],pdim_no[yi][1] ) ;
+	      }
+	      else
+	      {
+	        fprintf(stderr,"gen_wrf_io.c: Registry WARNING (and possibly internal error) %s \n",p->name) ;
+	      }
+	    }
+	    else if ( !strcmp(memord,"Z") && ok_to_collect_distribute )
+	    {
+	      fprintf(fp," call wrf_dm_bcast_%s ( %s%s , (%s)-(%s)+1 )\n",p->type->name,structname,vname,ddim[0][1],ddim[0][0] ) ;
+	    }
+	    else if ( !strcmp(memord,"0") && ok_to_collect_distribute )
+	    {
+	      fprintf(fp," call wrf_dm_bcast_%s ( %s%s , 1 )\n",p->type->name,structname,vname ) ;
+
+	    }
+	    else if ( ok_to_collect_distribute )
+	    {
+	      fprintf(stderr,"gen_wrf_io.c: Registry WARNING: can't figure out entry for %s (Memord %s)\n",p->name,memord) ;
+	    }
+
+	    if ( io_mask & INPUT && p->ntl > 1 ) {
+	      /* copy time level two into time level one */
+	      if ( p->ntl == 3 ) fprintf(fp, "grid%%%s = grid%%%s\n", vname_2 , vname_x ) ;
+	      if ( p->ntl == 2 ) fprintf(fp, "grid%%%s = grid%%%s\n", vname_1 , vname_x ) ;
+	    }
+
+	    if ( p->scalar_array_member )
+	    {
+	      fprintf(fp,"END IF\n" ) ;
+	    }
+
+	    if ( !strncmp( p->use, "dyn_", 4 ) ) 
+	      fprintf(fp,"END IF\n" ) ;
+          }
+          else if ( sw_io == GEN_OUTPUT )
+	  {
+	    if ( !strncmp( p->use, "dyn_", 4 ) ) 
+	      fprintf(fp,"IF ( grid%%dyn_opt .EQ. %s ) THEN\n",p->use) ;
+	    if ( p->scalar_array_member )
+	      fprintf(fp,"IF ( P_%s .GE. PARAM_FIRST_SCALAR ) THEN\n",p->name) ;
+
+/* Genereate code to write into a global buffer if it's DM-parallel and I/O API cannot handle distributed data  */
+
+            if      ( p->ndims == 3 && ok_to_collect_distribute )
+	    {
+	      if ((xi=get_index_for_coord(p,COORD_X))>=0&&(yi=get_index_for_coord(p,COORD_Y))>=0&&(zi=get_index_for_coord(p,COORD_Z))>=0)
+	      {
+	        fprintf(fp,"IF ( .NOT. dryrun ) call wrf_patch_to_global_%s ( %s%s , globbuf_%s , &\n",p->type->name,structname,vname,p->type->name ) ;
+	        fprintf(fp,"       grid%%domdesc, %d, &\n",p->ndims) ;
+/*              fprintf(fp, "ids , ide , jds , jde , kds , kde ,                &\n")  ; */
+                fprintf(fp, "%s, %s, %s, %s, %s, %s, &\n",ddim_no[xi][0],ddim_no[xi][1],
+							  ddim_no[yi][0],ddim_no[yi][1],
+							  ddim_no[zi][0],ddim_no[zi][1]) ;
+                fprintf(fp, "%s, %s, %s, %s, %s, %s, &\n",mdim_no[xi][0],mdim_no[xi][1],
+							  mdim_no[yi][0],mdim_no[yi][1],
+							  mdim_no[zi][0],mdim_no[zi][1]) ;
+                fprintf(fp, "%s, %s, %s, %s, %s, %s  )\n",pdim_no[xi][0],pdim_no[xi][1],
+							  pdim_no[yi][0],pdim_no[yi][1],
+							  pdim_no[zi][0],pdim_no[zi][1]) ;
+	      }
+	    }
+	    else if ( p->ndims == 2 && ok_to_collect_distribute )
+	    {
+	      if ((xi=get_index_for_coord(p,COORD_X))>=0&&(yi=get_index_for_coord(p,COORD_Y))>=0)
+	      {
+	        fprintf(fp,"IF ( .NOT. dryrun ) call wrf_patch_to_global_%s ( %s%s , globbuf_%s , &\n",p->type->name,structname,vname,p->type->name ) ;
+	        fprintf(fp,"       grid%%domdesc, %d, &\n",p->ndims) ;
+/*              fprintf(fp, "ids , ide , jds , jde , 1 , 1 ,                &\n")  ; */
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1 , &\n",ddim_no[xi][0],ddim_no[xi][1],
+							  ddim_no[yi][0],ddim_no[yi][1] ) ;
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1 , &\n",mdim_no[xi][0],mdim_no[xi][1],
+							  mdim_no[yi][0],mdim_no[yi][1] ) ;
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1   )\n",pdim_no[xi][0],pdim_no[xi][1],
+							  pdim_no[yi][0],pdim_no[yi][1] ) ;
+	      }
+	      else
+	      {
+	        fprintf(stderr,"gen_wrf_io.c: Registry WARNING (and possibly internal error) %s \n",p->name) ;
+	      }
+	    }
+         
+            for ( i = 0 ; i < 3 ; i++ ) strcpy(dimname[i],"") ;
+	    for ( i = 0 ; i < 3 ; i++ ) 
+	    {
+              if (( dimnode = p->dims[i]) != NULL )
+	      {
+	        switch ( dimnode->coord_axis )
+	        {
+	        case (COORD_X) : 
+		  if ( ( ! sw_3dvar_iry_kludge && p->stag_x ) || ( sw_3dvar_iry_kludge && p->stag_y ) )
+		   { sprintf( dimname[i] ,"%s_stag", dimnode->dim_data_name) ; } 
+		  else 
+		   { strcpy( dimname[i], dimnode->dim_data_name) ; }
+		  break ;
+	        case (COORD_Y) : 
+		  if ( ( ! sw_3dvar_iry_kludge && p->stag_y ) || ( sw_3dvar_iry_kludge && p->stag_x ) )
+		   { sprintf( dimname[i] ,"%s_stag", dimnode->dim_data_name) ; } 
+		  else 
+		   { strcpy( dimname[i], dimnode->dim_data_name) ; }
+		  break ;
+	        case (COORD_Z) : 
+		  if ( p->stag_z ) 
+		   { sprintf( dimname[i] ,"%s_stag", dimnode->dim_data_name) ; } 
+		  else 
+		   { strcpy( dimname[i], dimnode->dim_data_name) ; }
+		  break ;
+	        }
+	      }
+	    }
+
+            if ( ok_to_collect_distribute )
+              fprintf(fp,"IF ( wrf_dm_on_monitor() ) THEN\n") ;
+
+            strcpy(indices,"") ;
+            sprintf(post,")") ;
+            if ( sw_io_deref_kludge && !(p->scalar_array_member) )   /* these aready have */
+            {
+              sprintf(indices, "%s",index_with_firstelem("(","grid%",t2,p,post)) ;
+            }
+
+  if ( !(p->scalar_array_member) ) {
+	    fprintf(fp,"CALL wrf_ext_write_field (  &\n") ;
+	    fprintf(fp,"                       fid                , &  ! DataHandle \n" ) ;
+	    fprintf(fp,"                       current_date(1:19) , &  ! DateStr \n" ) ;
+	    fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
+            if ( p->ndims >= 2 && ok_to_collect_distribute )
+	      fprintf(fp,"                       globbuf_%s               , &  ! Field \n" , p->type->name ) ;
+            else
+	      fprintf(fp,"                       %s%s%s               , &  ! Field \n" , structname , vname , indices ) ;
+            if (!strncmp(p->type->name,"real",4)) {
+              fprintf(fp,"                       WRF_FLOAT          , &  ! FieldType \n") ;
+            } else {
+              fprintf(fp,"                       WRF_%s             , &  ! FieldType \n" , p->type->name ) ;
+            }
+	    fprintf(fp,"                       grid%%communicator  , &  ! Comm\n") ;
+	    fprintf(fp,"                       grid%%iocommunicator  , &  ! Comm\n") ;
+	    fprintf(fp,"                       grid%%domdesc       , &  ! Comm\n") ;
+	    fprintf(fp,"                       grid%%bdy_mask       , &  ! bdy_mask\n") ;
+            fprintf(fp,"                       dryrun             , &  ! flag\n" ) ;
+	    fprintf(fp,"                       '%s'               , &  ! MemoryOrder\n",memord ) ;
+	    fprintf(fp,"                       '%s'               , &  ! Stagger\n",stagstr ) ;
+            fprintf(fp,"                       '%s'               , &  ! Dimname 1 \n",dimname[0] ) ;
+            fprintf(fp,"                       '%s'               , &  ! Dimname 2 \n",dimname[1] ) ;
+            fprintf(fp,"                       '%s'               , &  ! Dimname 3 \n",dimname[2] ) ;
+            fprintf(fp,"                       '%s'               , &  ! Desc  \n",p->descrip ) ;
+            fprintf(fp,"                       '%s'               , &  ! Units \n",p->units ) ;
+	    fprintf(fp,"'%s ext_write_field %s memorder %s' , & ! Debug message\n",fname,dname,memord ) ;
+	    /* global dimensions */
+	    for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",ddim[i][0], ddim[i][1]) ; }
+	    fprintf(fp," & \n") ;
+
+/* the first two cases here have to do with if we're running on multiple distributed
+   memory processors and the i/o api layer can't handle decomposed data. So code is
+   generated to read the data on processor zero into a globally sized buffer. In this
+   case, then the domain, memory, and patch dimensions for the globally sized buffer
+   are all just the domain domain dimensions. Two D arrays are handled separately
+   from three-d arrays because in threeD arrays the middle index is K.  In the last
+   case, where the code is either calling a version of the API that supports parallelism
+   or we aren't running in DM-parallel, the field itself and not a global buffer are
+   passed, so we pass the domain, memory, and patch indices directly to the read routine. */
+
+            if      ( p->ndims == 3 && ok_to_collect_distribute )
+	    {
+	      /* mem    dimensions are actually domain dimensions */
+	      for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",ddim_no[i][0], ddim_no[i][1]) ; }
+	      fprintf(fp," & \n") ;
+	      /* patch  dimensions are actually domain dimensions */
+	      for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",ddim[i][0], ddim[i][1]) ; }
+	      fprintf(fp," & \n") ;
+	    }
+	    else if ( p->ndims == 2 && ok_to_collect_distribute )
+	    {
+	      if ((xi=get_index_for_coord(p,COORD_X))>=0&&(yi=get_index_for_coord(p,COORD_Y))>=0)
+	      {
+	        /* mem    dimensions are actually domain dimensions */
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1 , &\n",ddim_no[xi][0],ddim_no[xi][1],
+							  ddim_no[yi][0],ddim_no[yi][1] ) ;
+	      /* patch  dimensions are actually domain dimensions */
+                fprintf(fp, "%s, %s, %s, %s, 1 , 1 , &\n",ddim[xi][0],ddim[xi][1],
+							  ddim[yi][0],ddim[yi][1] ) ;
+	      }
+	    }
+	    else
+	    {
+	      /* mem    dimensions */
+	      for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",mdim[i][0], mdim[i][1]) ; }
+	      fprintf(fp," & \n") ;
+	      /* patch  dimensions */
+	      for ( i = 0 ; i < 3 ; i++ ) { fprintf(fp,"%s , %s , ",pdim[i][0], pdim[i][1]) ; }
+	      fprintf(fp," & \n") ;
+	    }
+	    fprintf(fp,"                       ierr )\n") ;
+
+            if ( ok_to_collect_distribute )
+	      fprintf(fp,"END IF\n" ) ;
+
+/*
+	    if ( p->scalar_array_member )
+	      fprintf(fp,"END IF\n" ) ;
+*/
+	    if ( !strncmp( p->use, "dyn_", 4 ) ) 
+	      fprintf(fp,"END IF\n" ) ;
+
+  }
+          }
+        }
+      }
+    }
+    }
+    if ( p->type->type_type == DERIVED )
+    {
+      sprintf(x,"%s%s%%",structname,p->name ) ;
+      gen_wrf_io2(fp, fname, x, NULL, p->type, io_mask, sw_io ) ;
+    }
+
+    }
+  }
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/index.page
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/index.page	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/index.page	(revision 2744)
@@ -0,0 +1,16 @@
+<HTML>
+<HEAD>
+<TITLE>Weather Research and Forecast Model</TITLE>
+</HEAD>
+
+<FRAMESET COLS="35%,*">
+
+<NOFRAMES>
+Frames not supported. Click 
+<A HREF="callgraph.html">here</A>.
+</NOFRAMES>
+
+	<FRAME NAME="Frame1" SRC="callgraph.html">
+	<FRAME NAME="Frame2" SRC="wrf.html">
+</FRAMESET>
+</HTML>
Index: trunk/WRF.COMMON/WRFV2/tools/link_codebase_to_wrfbrowser
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/link_codebase_to_wrfbrowser	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/link_codebase_to_wrfbrowser	(revision 2744)
@@ -0,0 +1,15 @@
+#!/bin/csh
+
+#sed 's/\(<font color=#cc0000>\)\([a-zA-Z0-9_][a-zA-Z0-9_]*\)\(<\/font>\)/\1<href=\" \2 \"> \2 <\/a> \3 /' frame/module_configure.F.html
+
+# very hard coded -- expects wrf browser to live at:
+
+  cd /users/michalak/wrfbrowser/html_code
+
+foreach f ( */*.html )
+
+  sed 's/\(<font color=#cc0000>\)\([a-zA-Z0-9_][a-zA-Z0-9_]*\)\(<\/font>\)/\1 \2 <a href=\"http:\/\/www.mmm.ucar.edu\/wrf\/WG2\/WRFV2\/tools\/code_dbase\/\2\.html" target="_blank"><img HEIGHT=20 WIDTH=20 src="http:\/\/www.mmm.ucar.edu\/wrf\/WG2\/manpage.gif">(docs)<\/a> \3 /' $f > foo
+
+  /bin/mv foo $f
+
+end
Index: trunk/WRF.COMMON/WRFV2/tools/misc.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/misc.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/misc.c	(revision 2744)
@@ -0,0 +1,454 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+
+char *
+dimension_with_colons( char * pre , char * tmp , node_t * p , char * post )
+{
+  int i ;
+  if ( p == NULL ) return("") ;
+  if ( p->ndims <= 0 && ! p->boundary_array ) return("") ;
+  strcpy(tmp,"") ;
+  if ( pre != NULL ) strcat(tmp,pre) ;
+  if ( p->boundary_array )
+  {
+    if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
+      strcat( tmp, ":,:,:,:,:" ) ;  /* boundary array for 4d tracer array */
+    } else {
+      strcat( tmp, ":,:,:,:" ) ;  /* most always have four dimensions */
+    }
+  }
+  else
+  {
+    for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,":,") ; 
+    if ( p->node_kind & FOURD ) strcat(tmp,":,") ;       /* add an extra for 4d arrays */
+    tmp[strlen(tmp)-1] = '\0' ;
+  }
+  if ( post != NULL ) strcat(tmp,post)  ;
+  return(tmp) ;
+}
+
+char *
+dimension_with_ones( char * pre , char * tmp , node_t * p , char * post )
+{
+  int i ;
+  char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ;
+  char *pp ;
+  if ( p == NULL ) return("") ;
+  if ( p->ndims <= 0 && ! p->boundary_array ) return("") ;
+  strcpy(tmp,"") ;
+  if ( pre != NULL ) strcat(tmp,pre) ;
+
+  if ( p->boundary_array )
+  {
+
+    if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {   /* if a boundary array for a 4d tracer */
+      strcpy(s, p->name ) ;  /* copy the name and then remove everything after last underscore */
+      if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ;
+      sprintf( four_d, "num_%s,", s  ) ;
+    } else {
+      strcpy( four_d, "" ) ;
+    }
+
+    if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
+      sprintf( r, "1,1,1,1,%s", four_d ) ;  /* boundary array for 4d tracer array */
+      strcat( tmp, r ) ;
+    } else {
+      strcat( tmp, "1,1,1,1," ) ;  /* most always have four dimensions */
+    }
+    tmp[strlen(tmp)-1] = '\0' ;
+  }
+  else
+  {
+    for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,"1,") ;
+    if ( p->node_kind & FOURD ) strcat(tmp,"1,") ;       /* add an extra for 4d arrays */
+    tmp[strlen(tmp)-1] = '\0' ;
+  }
+  if ( post != NULL ) strcat(tmp,post)  ;
+  return(tmp) ;
+}
+
+char *
+dimension_with_ranges( char * refarg , char * pre ,
+                       char * tmp , node_t * p , char * post ,
+                       char * nlstructname  )   /* added 20020130;
+ 						   provides name (with %) of structure in
+						   which a namelist supplied dimension
+                                                   should be dereference from, or ""  */
+{
+  int i ;
+  char tx[NAMELEN] ;
+  char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ;
+  int   xdex, ydex, zdex ;
+  node_t *xdim, *ydim, *zdim ;
+  char *pp ;
+  if ( p == NULL ) return("") ;
+  if ( p->ndims <= 0 && !p->boundary_array ) return("") ;
+  strcpy(tmp,"") ;
+  if ( pre != NULL ) strcat(tmp,pre) ;
+  strcpy(r,"") ;
+  if ( refarg != NULL ) strcat(r,refarg) ;
+
+  if ( p->boundary_array )
+  {
+    if ( p->ndims > 0 )
+    {
+      xdim = get_dimnode_for_coord( p , COORD_X ) ;
+      ydim = get_dimnode_for_coord( p , COORD_Y ) ;
+      zdim = get_dimnode_for_coord( p , COORD_Z ) ;
+      if ( ydim == NULL )
+       { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; }
+      if ( xdim == NULL )
+       { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; }
+      
+      xdex = xdim->dim_order ;
+      ydex = ydim->dim_order ;
+
+      if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {   /* if a boundary array for a 4d tracer */
+        strcpy(s, p->name ) ;  /* copy the name and then remove everything after last underscore */
+        if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ;
+        sprintf( four_d, "num_%s,", s  ) ;
+      } else {
+        strcpy( four_d, "" ) ;
+      }
+
+      if ( zdim != NULL ) {
+        zdex = zdim->dim_order ;
+        sprintf(tx,"max(%sed3%d,%sed3%d),%ssd3%d:%sed3%d,%sspec_bdy_width,4,%s", r,xdex,r,ydex,r,zdex,r,zdex,r,four_d ) ;
+      } else {
+        sprintf(tx,"max(%sed3%d,%sed3%d),1,%sspec_bdy_width,4,%s", r,xdex,r,ydex,r,four_d ) ;
+      }
+    }
+    else
+    {
+      sprintf(tx,"%sspec_bdy_width,",r ) ;
+    }
+    strcat(tmp,tx) ;
+  }
+  else
+  {
+    for ( i = 0 ; i < p->ndims ; i++ )
+    {
+      range_of_dimension( r, tx , i , p , nlstructname ) ;
+      strcat(tmp,tx) ;
+      strcat(tmp,",") ;
+    }
+  }
+  tmp[strlen(tmp)-1] = '\0' ;
+  if ( post != NULL ) strcat(tmp,post)  ;
+
+  return(tmp) ;
+}
+
+int
+range_of_dimension ( char * r , char * tx , int i , node_t * p , char * nlstructname )
+{
+   char s[NAMELEN], e[NAMELEN] ;
+
+   get_elem( r , nlstructname , s , i , p , 0 ) ;
+   get_elem( r , nlstructname , e , i , p , 1 ) ;
+   sprintf(tx,"%s:%s", s , e ) ;
+
+}
+
+char *
+index_with_firstelem( char * pre , char * dref , char * tmp , node_t * p , char * post )
+{
+  int i ;
+  char tx[NAMELEN] ;
+  char tmp2[NAMELEN] ;
+  if ( p == NULL ) return("") ;
+  if ( p->ndims <= 0 ) return("") ;
+  strcpy(tmp,"") ;
+  if ( pre != NULL ) strcat(tmp,pre) ;
+
+  if ( p->boundary_array )
+  {
+    if ( p->ndims > 0 )
+    {
+#if 0
+      for ( i = 0 ; i < p->ndims ; i++ )
+      {
+	sprintf(tx,"1,") ;
+        strcat(tmp,tx) ;
+      }
+#endif
+      if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
+        strcat(tmp,"1,1,1,1,1,") ;
+      } else {
+        strcat(tmp,"1,1,1,1,") ;
+      }
+    }
+    else
+    {
+      sprintf(tx,"1," ) ;
+      strcat(tmp,tx) ;
+    }
+  }
+  else
+  {
+    for ( i = 0 ; i < p->ndims ; i++ )
+    {
+      get_elem( dref, "", tx, i, p , 0 ) ;
+      strcat( tmp, tx ) ;
+      strcat(tmp,",") ;
+    }
+  }
+  tmp[strlen(tmp)-1] = '\0' ;  /* remove trailing comma */
+  if ( post != NULL ) strcat(tmp,post)  ;
+  return(tmp) ;
+}
+
+get_elem ( char * structname , char * nlstructname , char * tx , int i , node_t * p , int first_last )
+{
+   char dref[NAMELEN], nlstruct[NAMELEN] ;
+
+   if ( structname == NULL ) { strcpy( dref, "" ) ;}
+   else                      { strcpy( dref, structname ) ; }
+   if ( nlstructname == NULL ) { strcpy( nlstruct, "" ) ;}
+   else                        { strcpy( nlstruct, nlstructname ) ; }
+   if ( p->dims[i] != NULL )
+   {
+     switch ( p->dims[i]->len_defined_how )
+     {
+       case (DOMAIN_STANDARD) :
+         {
+         char *ornt ;
+         if      ( p->proc_orient == ALL_X_ON_PROC ) ornt = "x" ;
+         else if ( p->proc_orient == ALL_Y_ON_PROC ) ornt = "y" ;
+         else                                        ornt = "" ;
+           sprintf(tx,"%s%cm3%d%s",dref,first_last==0?'s':'e',p->dims[i]->dim_order,ornt) ;
+         }
+         break ;
+       case (NAMELIST) :
+         if ( first_last == 0 ) { if ( !strcmp( p->dims[i]->assoc_nl_var_s , "1" ) ) {
+                                    sprintf(tx,"%s",p->dims[i]->assoc_nl_var_s) ;
+                                  } else {
+                                    sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_s) ; 
+                                  }
+                                }
+         else                   { sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_e) ; }
+         break ;
+       case (CONSTANT) :
+         if ( first_last == 0 ) { sprintf(tx,"%d",p->dims[i]->coord_start) ; }
+         else                   { sprintf(tx,"%d",p->dims[i]->coord_end) ; }
+         break ;
+       default : break ;
+     }
+   }
+   else
+   {
+     fprintf(stderr,"WARNING: %s %d: something wrong with internal representation for dim %d\n",__FILE__,__LINE__,i) ;
+   }
+}
+
+char *
+declare_array_as_pointer( char * tmp , node_t * p )
+{
+  strcpy( tmp , "" ) ;
+  if ( p != NULL )
+    if ( p->ndims > 0 || p->boundary_array ) strcpy ( tmp, ",POINTER" ) ;
+  return(tmp);
+}
+
+char *
+field_type( char * tmp , node_t * p )
+{
+  if ( p == NULL ) {
+    strcpy( tmp , "" ) ;
+  } else if ( p->type == NULL ) {
+    strcpy( tmp , "" ) ;
+  } else if ( p->type->type_type == SIMPLE ) {
+    strcpy( tmp , p->type->name ) ;
+  } else {
+    sprintf( tmp , "TYPE(%s)", p->type->name ) ;
+  }
+  return( tmp ) ;
+}
+
+char *
+field_name( char * tmp , node_t * p , int tag )
+{
+  if ( p == NULL ) return("") ;
+  if ( tag < 1 )
+  {
+    strcpy(tmp,p->name) ;
+    if ( p->scalar_array_member ) strcpy(tmp,p->use) ;
+  }
+  else
+  {
+    sprintf(tmp,"%s_%d",p->name,tag) ;
+    if ( p->scalar_array_member ) sprintf(tmp,"%s_%d",p->use,tag) ;
+  }
+  return( tmp ) ;
+}
+
+int
+print_warning( FILE * fp , char * fname )
+{
+fprintf(fp,"!STARTOFREGISTRYGENERATEDINCLUDE '%s'\n", fname) ;
+fprintf(fp,"!\n") ;
+fprintf(fp,"! WARNING This file is generated automatically by use_registry\n") ;
+fprintf(fp,"! using the data base in the file named Registry.\n") ;
+fprintf(fp,"! Do not edit.  Your changes to this file will be lost.\n") ;
+fprintf(fp,"!\n") ;
+return(0) ;
+}
+
+close_the_file( FILE * fp )
+{
+fprintf(fp,"!ENDOFREGISTRYGENERATEDINCLUDE\n") ;
+fclose(fp) ;
+}
+
+int
+make_entries_uniq ( char * fname )
+{
+  char tempfile[NAMELEN] ;
+  char commline[4096] ;
+  sprintf(tempfile,"regtmp1%d",getpid()) ;
+  sprintf(commline,"%s < %s > %s ; %s %s %s ",
+          UNIQSORT,fname,tempfile,
+          MVCOMM,tempfile,fname ) ;
+  return(system(commline)) ;
+}
+
+int
+add_warning ( char * fname )
+{
+  FILE * fp ;
+  char tempfile[NAMELEN] ;
+  char tempfile1[NAMELEN] ;
+  char commline[4096] ;
+  sprintf(tempfile,"regtmp1%d",getpid()) ;
+  sprintf(tempfile1,"regtmp2%d",getpid()) ;
+  if (( fp = fopen( tempfile, "w" )) == NULL ) return(1) ;
+  print_warning(fp,tempfile) ; 
+  close_the_file(fp) ;
+  sprintf(commline,"%s %s %s > %s ; %s %s %s ; %s %s ",
+          CATCOMM,tempfile,fname,tempfile1,
+          MVCOMM,tempfile1,fname,
+          RMCOMM,tempfile) ;
+  return(system(commline)) ;
+}
+
+static int NumCores ;
+static char dyncores[MAX_DYNCORES][NAMELEN] ;
+
+int
+init_core_table()
+{
+  NumCores = 0 ;
+  return(0) ;
+}
+
+int
+get_num_cores()
+{
+  return( NumCores ) ;
+}
+
+char *
+get_corename_i(int i)
+{
+  if ( i >= 0 && i < NumCores ) return( dyncores[i] ) ;
+  return(NULL) ;
+}
+
+int
+add_core_name ( char * name )
+{
+  if ( name == NULL ) return(1) ;
+  if (get_core_name ( name ) == NULL )
+  {
+    if ( NumCores >= MAX_DYNCORES ) return(1) ;
+    strcpy( dyncores[NumCores++] , name ) ;
+  }
+  return(0) ;
+}
+
+char *
+get_core_name ( char * name )
+{
+  int i ;
+  if ( name == NULL ) return(NULL) ;
+  for ( i = 0 ; i < NumCores ; i++ )
+  {
+    if ( !strcmp(name,dyncores[i]) ) return( dyncores[i] ) ; 
+  }
+  return(NULL) ;
+}
+
+/* DESTRUCTIVE */
+char *
+make_upper_case ( char * str )
+{
+  char * p ;
+  if ( str == NULL ) return (NULL) ;
+  for ( p = str ; *p ; p++ ) *p = toupper(*p) ; 
+  return(str) ;
+}
+
+/* DESTRUCTIVE */
+char *
+make_lower_case ( char * str )
+{
+  char * p ;
+  if ( str == NULL ) return (NULL) ;
+  for ( p = str ; *p ; p++ ) *p = tolower(*p) ; 
+  return(str) ;
+}
+
+/* Routines for keeping typedef history  -ajb */
+
+static int NumTypeDefs ;
+static char typedefs[MAX_TYPEDEFS][NAMELEN] ;
+
+int
+init_typedef_history()
+{
+  NumTypeDefs = 0 ;
+  return(0) ;
+}
+
+int
+get_num_typedefs()
+{
+  return( NumTypeDefs ) ;
+}
+
+char *
+get_typename_i(int i)
+{
+  if ( i >= 0 && i < NumTypeDefs ) return( typedefs[i] ) ;
+  return(NULL) ;
+}
+
+int
+add_typedef_name ( char * name )
+{
+  if ( name == NULL ) return(1) ;
+  if ( get_typedef_name ( name ) == NULL )
+  {
+    if ( NumTypeDefs >= MAX_TYPEDEFS ) return(1) ;
+    strcpy( typedefs[NumTypeDefs++] , name ) ;
+  }
+  return(0) ;
+}
+
+char *
+get_typedef_name ( char * name )
+{
+  int i ;
+  if ( name == NULL ) return(NULL) ;
+  for ( i = 0 ; i < NumTypeDefs ; i++ )
+  {
+    if ( !strcmp(name,typedefs[i]) ) return( typedefs[i] ) ; 
+  }
+  return(NULL) ;
+}
Index: trunk/WRF.COMMON/WRFV2/tools/mpi2_test.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/mpi2_test.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/mpi2_test.c	(revision 2744)
@@ -0,0 +1,13 @@
+#include <stdio.h>
+#include <mpi.h>
+main()
+{
+   int y ;
+   MPI_Comm x ;
+   y = 1 ;
+#if 1
+   x = MPI_Comm_f2c( y ) ;
+   y = MPI_Comm_c2f( x ) ;
+#endif
+   fprintf(stderr,"y %d \n",y) ;
+}
Index: trunk/WRF.COMMON/WRFV2/tools/my_strtok.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/my_strtok.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/my_strtok.c	(revision 2744)
@@ -0,0 +1,101 @@
+#include <stdio.h>
+#include "registry.h"
+#include "protos.h"
+#include "ctype.h"
+
+
+/* work sort of like strtok but mind quote chars */
+static char * tokpos = NULL ;
+char *
+my_strtok( char * s1 )
+{
+  char *p, *retval ;
+  int state ;
+  state = 0 ;
+  retval = NULL ;
+  if ( s1 == NULL && tokpos == NULL ) return( NULL ) ;
+  if ( s1 != NULL ) tokpos = s1 ;
+  for ( p = tokpos ; *p ; p++ )
+  {
+    if ( state == 0 && (*p == ' ' || *p == '\t') ) continue ;
+    if ( state == 0 && !(*p == ' ' || *p == '\t') ) { state = 1 ; retval = p ; } ;
+    if      ( state == 1 && (*p == '"') ) { state = 2 ; }
+    else if ( state == 2 && (*p == '"') ) { state = 1 ; }
+    if ( state == 1 && (*p == ' ' || *p == '\t') ) { *p = '\0' ; p++ ; break ; }
+  }
+  tokpos = p ;
+  return( retval ) ;
+}
+
+
+/* posix like rentrant strtok; not quote safe, and not quite strtok -- new version; skips multi delims  */
+char *
+strtok_rentr( char * s1 , char * s2, char ** tokpos )
+{
+  char *p, *q, *retval ;
+  int match ;
+  retval = NULL ;
+  if ( s1 == NULL && s2 == NULL ) return( NULL ) ;
+  if ( s1 != NULL ) { *tokpos = s1 ; }
+  if ( **tokpos ) retval = *tokpos ;
+  for ( p = *tokpos ; *p ; p++ )
+  {
+    for ( q = s2 ; *q ; q++ )
+    {
+      if ( *p == *q ) { *p = '\0' ; p++ ; goto foundit  ; }
+    }
+  }
+foundit:
+/* skip over multi-delims */
+  for ( ; *p ; p++ )
+  {
+    match = 0 ;
+    for ( q = s2 ; *q ; q++ )
+    {
+      if ( *p == *q ) { *p = '\0' ; match++  ; }
+    }
+    if ( match == 0 ) { break ; }
+  }
+  *tokpos = p ;
+  return( retval ) ;
+}
+
+#if 0
+/* posix like rentrant strtok; not quote safe, and not quite strtok -- won't skip over multiple delims  */
+char *
+strtok_rentr( char * s1 , char * s2, char ** tokpos )
+{
+  char *p, *q, *retval ;
+  retval = NULL ;
+  if ( s1 == NULL && s2 == NULL ) return( NULL ) ;
+  if ( s1 != NULL ) { *tokpos = s1 ; }
+  if ( **tokpos ) retval = *tokpos ;
+  for ( p = *tokpos ; *p ; p++ )
+  {
+    for ( q = s2 ; *q ; q++ )
+    {
+      if ( *p == *q ) { *p = '\0' ; p++ ; goto foundit  ; }
+    }
+  }
+foundit:
+  *tokpos = p ;
+  return( retval ) ;
+}
+#endif
+
+make_lower( char * s1 )
+{
+  char * p ;
+  int state ;
+  state = 0 ;
+  for ( p = s1 ; *p ; p++ )
+  {
+    if      ( state == 0 && *p == '"' ) state = 1 ;
+    else if ( state == 1 && *p == '"' ) state = 0 ;
+    if ( state == 0 )
+    {
+      *p = tolower(*p) ;
+    }
+  }
+  return(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/tools/protos.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/protos.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/protos.h	(revision 2744)
@@ -0,0 +1,115 @@
+#ifndef PROTOS_H
+#include "registry.h"
+#include "data.h"
+
+int init_dim_table()   ;
+int make_lower( char * s1 ) ;
+int reg_parse( FILE * infile ) ;
+int set_dim_len ( char * dimspec , node_t * dim_entry ) ;
+int set_dim_order ( char * dimorder , node_t * dim_entry ) ;
+int set_dim_orient ( char * dimorient , node_t * dim_entry ) ;
+int add_node_to_end ( node_t * node , node_t ** list ) ;
+int add_node_to_end_4d ( node_t * node , node_t ** list ) ;
+int init_type_table() ;
+int set_state_type ( char * typename , node_t * node ) ;
+int set_state_dims ( char * dims , node_t * node ) ;
+int gen_state_struct ( char * fname ) ;
+
+#if 0
+int show_node( node_t * p ) ;
+int show_node1( node_t * p, int indent ) ;
+int show_nodelist( node_t * p ) ;
+int show_nodelist1( node_t * p , int indent ) ;
+#endif
+
+int gen_state_struct ( char * fname ) ;
+int gen_decls ( FILE * fp , char * corename , node_t * node , int sw_ranges, int sw_point , int mask , int layer ) ;
+int gen_state_subtypes ( char * fname ) ;
+int gen_state_subtypes1 ( FILE * fp , node_t * node , int sw_ranges, int sw_point , int mask ) ;
+int print_warning( FILE * fp , char * fname ) ;
+int close_the_file( FILE * fp  ) ;
+int make_entries_uniq ( char * fname ) ;
+int add_warning ( char * fname ) ;
+
+node_t * get_type_entry ( char * typename ) ;
+node_t * get_rconfig_entry( char * name ) ;
+node_t * get_entry ( char * name , node_t * node ) ;
+node_t * get_entry_r ( char * name , char * use , node_t * node ) ;
+node_t * get_dim_entry( char c ) ;
+node_t * new_node ( int kind ) ;
+
+node_t * get_4d_entry ( char * name ) ;
+node_t * get_dimnode_for_coord ( node_t * node , int coord_axis ) ;
+int      get_index_for_coord ( node_t * node , int coord_axis ) ;
+
+char * my_strtok( char * s1 ) ;
+char * strtok_rentr( char * s1 , char * s2, char ** tokpos ) ;
+
+
+char * field_name( char * tmp, node_t * p , int tag ) ;
+char * dimension_with_colons( char * pre, char * tmp, node_t * p, char * post) ;
+char * dimension_with_ones( char * pre, char * tmp, node_t * p, char * post) ;
+char * dimension_with_ranges( char * ref , char * pre, char * tmp, node_t * p, char * post, char * nlstructname) ;
+char * index_with_firstelem( char * pre , char * dref , char * tmp , node_t * p , char * post ) ;
+
+char * declare_array_as_pointer( char * tmp, node_t * p ) ;
+char * field_type( char * tmp , node_t * p ) ;
+
+int init_core_table() ;
+int add_core_name ( char * name ) ;
+int get_num_cores() ;
+char * get_core_name ( char * name ) ;
+char * get_corename_i(int i) ;
+
+/* For typedef history -ajb */
+int init_typedef_history() ;
+int add_typedef_name ( char * name ) ;
+int get_num_typedefs() ;
+char * get_typedef_name ( char * name ) ;
+char * get_typename_i(int i) ;
+
+int gen_alloc ( char * dirname ) ;
+int gen_alloc1 ( char * dirname , char * corename ) ;
+int gen_alloc2 ( FILE * fp , char * structname , char * corename , node_t * node ) ;
+
+int gen_module_state_description ( char * dirname ) ;
+int gen_module_state_description1 ( FILE * fp , node_t * node ) ;
+
+int gen_scalar_indices ( char * dirname ) ;
+int gen_scalar_indices1 ( FILE * fp ) ;
+
+int gen_actual_args ( char * dirname ) ;
+int gen_dummy_args ( char * dirname ) ;
+int gen_dummy_decls ( char * dn ) ;
+int gen_args ( char * dirname , char * corename , int sw ) ;
+int gen_args1 ( FILE * fp , char * outstr, char * structname , char * corename , node_t * node , int *linelen , int sw , int deep ) ;
+
+int gen_scalar_derefs ( char * dirname ) ;
+int scalar_derefs ( char * dirname , char * corename ) ;
+int scalar_derefs1 ( FILE * fp , char * corename , node_t * node, int direction ) ;
+
+int set_mark ( int val , node_t * lst ) ;
+int set_mark_4d ( int val , node_t * lst ) ;
+
+int gen_i1_decls ( char * dn ) ;
+int gen_get_nl_config ( char * dirname ) ;
+
+int gen_config_assigns ( char * dirname ) ;
+int gen_config_reads ( char * dirname ) ;
+
+char * set_mem_order( node_t * node , char * str , int n  ) ;
+
+int gen_wrf_io ( char * dirname ) ;
+int set_dim_strs ( node_t *node , char ddim[3][2][NAMELEN], char mdim[3][2][NAMELEN], char pdim[3][2][NAMELEN] , char * prepend, int sw_allow_stagger ) ;
+int gen_wrf_io2 ( FILE * fp , char * fname , char * structname , char * fourdname , node_t * node , int io_mask , int sw_io ) ;
+
+int gen_namelist_defines ( char * dirname , int sw_dimension ) ;
+int gen_namelist_defaults ( char * dirname ) ;
+
+int gen_model_data_ord ( char * dirname ) ;
+
+int get_elem ( char * structname , char * nlstructname , char * tx , int i , node_t * p , int first_last ) ;
+
+#define PROTOS_H
+#endif
+
Index: trunk/WRF.COMMON/WRFV2/tools/reg_parse.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/reg_parse.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/reg_parse.c	(revision 2744)
@@ -0,0 +1,1013 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "registry.h"
+#include "protos.h"
+#include "data.h"
+#include "sym.h"
+
+/* read in the Registry file and build the internal representation of the registry */
+
+#define MAXTOKENS 1000
+
+/* fields for state entries (note, these get converted to field entries in the
+   reg_parse routine; therefore, only TABLE needs to be looked at */
+#define TABLE 0
+
+/* fields for field entries (TABLE="typedef" and, with some munging,  TABLE="state") */
+#define FIELD_OF        1
+#define FIELD_TYPE     2
+#define FIELD_SYM      3
+#define FIELD_DIMS     4
+#define FIELD_USE      5
+#define FIELD_NTL      6
+#define FIELD_STAG     7
+#define FIELD_IO       8
+#define FIELD_DNAME    9
+#define FIELD_DESCRIP 10
+#define FIELD_UNITS   11
+
+#define F_OF       0
+#define F_TYPE     1
+#define F_SYM      2
+#define F_DIMS     3
+#define F_USE      4
+#define F_NTL      5
+#define F_STAG     6
+#define F_IO       7
+#define F_DNAME    8
+#define F_DESCRIP  9
+#define F_UNITS   10
+
+/* fields for rconfig entries (RCNF) */
+#define RCNF_TYPE_PRE       1
+#define RCNF_SYM_PRE        2
+#define RCNF_HOWSET_PRE     3
+#define RCNF_NENTRIES_PRE   4
+#define RCNF_DEFAULT_PRE    5
+#define RCNF_IO_PRE         6
+#define RCNF_DNAME_PRE      7
+#define RCNF_DESCRIP_PRE    8
+#define RCNF_UNITS_PRE      9
+
+#define RCNF_TYPE       2
+#define RCNF_SYM        3
+#define RCNF_USE        FIELD_USE
+#define RCNF_IO         FIELD_IO
+#define RCNF_DNAME      FIELD_DNAME
+#define RCNF_DESCRIP    FIELD_DESCRIP
+#define RCNF_UNITS      FIELD_UNITS
+#define RCNF_HOWSET    20
+#define RCNF_NENTRIES  21
+#define RCNF_DEFAULT   22
+
+/* fields for dimension entries (TABLE="dimspec") */
+#define DIM_NAME       1
+#define DIM_ORDER      2
+#define DIM_SPEC       3
+#define DIM_ORIENT     4
+#define DIM_DATA_NAME  5
+
+#define PKG_SYM            1
+#define PKG_ASSOC          2
+#define PKG_STATEVARS      3
+#define PKG_4DSCALARS      4
+
+#define COMM_ID            1
+#define COMM_USE           2
+#define COMM_DEFINE        3
+
+static int ntracers = 0 ;
+static char tracers[1000][100] ;
+
+int
+pre_parse( char * dir, FILE * infile, FILE * outfile )
+{
+  char inln[4096], parseline[4096], parseline_save[4096] ;
+  int found ; 
+  char *p, *q ;
+  char *tokens[MAXTOKENS], *toktmp[MAXTOKENS], newdims[NAMELEN], newdims4d[NAMELEN],newname[NAMELEN] ;
+  int i, ii, len_of_tok ;
+  char x, xstr[NAMELEN] ;
+  int is4d, wantstend, wantsbdy ;
+  int ifdef_stack_ptr = 0 ;
+  int ifdef_stack[100] ;
+  int inquote, retval ;
+
+  ifdef_stack[0] = 1 ;
+  retval = 0 ;
+
+  parseline[0] = '\0' ;
+/* main parse loop over registry lines */
+  while ( fgets ( inln , 4096 , infile ) != NULL )
+  {
+
+/*** preprocessing directives ****/
+    /* look for an include statement */
+    for ( p = inln ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
+    if ( !strncmp( p , "include", 7 ) &&  ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) {
+      FILE *include_fp ;
+      char include_file_name[128] ;
+      p += 7 ; for ( ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
+      if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; }
+      else {
+        sprintf( include_file_name , "%s/%s", dir , p ) ;
+        if ( (p=index(include_file_name,'\n')) != NULL ) *p = '\0' ;
+        fprintf(stderr,"opening %s\n",include_file_name) ;
+        if (( include_fp = fopen( include_file_name , "r" )) != NULL ) {
+
+          fprintf(stderr,"including %s\n",include_file_name ) ;
+          pre_parse( dir , include_fp , outfile ) ;
+
+          fclose( include_fp ) ;
+        } else {
+          fprintf(stderr,"Registry warning: cannot open %s. Ignoring.\n", include_file_name ) ;
+        } 
+      }
+    }
+    else if ( !strncmp( p , "ifdef", 5 ) ) {
+      char value[32] ;
+      p += 5 ; for ( ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
+      strncpy(value, p, 31 ) ; value[31] = '\0' ;
+      if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
+      if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,'	')) != NULL ) *p = '\0' ; 
+      ifdef_stack_ptr++ ;
+      ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) != NULL && ifdef_stack[ifdef_stack_ptr-1] ) ;
+      if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; }
+      continue ;
+    }
+    else if ( !strncmp( p , "ifndef", 6 ) ) {
+      char value[32] ;
+      p += 6 ; for ( ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
+      strncpy(value, p, 31 ) ; value[31] = '\0' ;
+      if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
+      if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,'	')) != NULL ) *p = '\0' ; 
+      ifdef_stack_ptr++ ;
+      ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) == NULL && ifdef_stack[ifdef_stack_ptr-1] ) ;
+      if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; }
+      continue ;
+    }
+    else if ( !strncmp( p , "endif", 5 ) ) {
+      ifdef_stack_ptr-- ; 
+      if ( ifdef_stack_ptr < 0 ) { fprintf(stderr,"Registry fatal: unmatched endif\n") ; exit(1) ; }
+      continue ;
+    }
+    else if ( !strncmp( p , "define", 6 ) ) {
+      char value[32] ;
+      p += 6 ; for ( ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
+      strncpy(value, p, 31 ) ; value[31] = '\0' ;
+      if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
+      if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,'	')) != NULL ) *p = '\0' ; 
+      sym_add( value ) ;
+      continue ;
+    }
+    if ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) continue ;
+/*** end of preprocessing directives ****/
+
+    strcat( parseline , inln ) ;
+
+    /* allow \ to continue the end of a line */
+    if (( p = index( parseline,  '\\'  )) != NULL )
+    {
+      if ( *(p+1) == '\n' || *(p+1) == '\0' )
+      {
+        *p = '\0' ;
+        continue ;  /* go get another line */
+      }
+    }
+    make_lower( parseline ) ;
+
+    if (( p = index( parseline , '\n' )) != NULL  ) *p = '\0' ; /* discard newlines */
+
+    /* check line and zap any # characters that are in double quotes */
+
+    for ( p = parseline, inquote = 0 ; *p ; p++ ) {
+      if      ( *p == '"' && inquote ) inquote = 0 ;
+      else if ( *p == '"' && !inquote ) inquote = 1 ;
+      else if ( *p == '#' && inquote ) *p = ' ' ;
+      else if ( *p == '#' && !inquote ) { *p = '\0' ; break ; }
+    }
+    if ( inquote ) { retval=1 ; fprintf(stderr,"Registry error: unbalanced quotes in line:\n%s\n",parseline) ;}
+
+    for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ;
+    i = 0 ;
+
+    strcpy( parseline_save, parseline ) ;
+
+    if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ;
+    while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ;
+    if ( i <= 0 ) continue ;
+
+    for ( i = 0 ; i < MAXTOKENS ; i++ )
+    {
+      if ( tokens[i] == NULL ) tokens[i] = "-" ;
+    }
+/* remove quotes from quoted entries */
+    for ( i = 0 ; i < MAXTOKENS ; i++ )
+    {
+      char * pp ;
+      if ( tokens[i][0] == '"' ) tokens[i]++ ;
+      if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ;
+    }
+    if      ( !strcmp( tokens[ TABLE ] , "state" ) )
+    {
+        strcpy( newdims, "" ) ;
+        strcpy( newdims4d, "" ) ;
+        is4d = 0 ; wantstend = 0 ; wantsbdy = 0 ; 
+        for ( i = 0 ; i < (len_of_tok = strlen(tokens[F_DIMS])) ; i++ )
+        {
+          x = tolower(tokens[F_DIMS][i]) ;
+          if ( x >= 'a' && x <= 'z' ) {
+            if ( x == 'f' ) { is4d = 1 ; }
+            if ( x == 't' ) { wantstend = 1 ; }
+            if ( x == 'b' ) { wantsbdy = 1 ; }
+          }
+          sprintf(xstr,"%c",x) ;
+          if ( x != 'b' ) strcat ( newdims , xstr ) ;
+          if ( x != 'f' && x != 't' ) strcat( newdims4d , xstr ) ;
+
+        }
+        if ( wantsbdy ) {
+
+
+/* first re-gurg the original entry without the b in the dims */
+
+ fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"%s\" \"%s\"\n",tokens[F_TYPE],tokens[F_SYM], newdims,
+                  tokens[F_USE],tokens[F_NTL],tokens[F_STAG],tokens[F_IO],
+                  tokens[F_DNAME],tokens[F_DESCRIP],tokens[F_UNITS] ) ;
+
+          if ( strcmp( tokens[F_SYM] , "-" ) ) {  /* if not unnamed, as can happen with first 4d tracer */
+/* next, output some additional entries for the boundary arrays for these guys */
+            if ( is4d == 1 ) {
+              for ( i = 0, found = 0 ; i < ntracers ; i++ ) {
+	        if ( !strcmp( tokens[F_USE] , tracers[i] ) ) found = 1 ; 
+              }
+	      if ( found == 0 ) {
+	        sprintf(tracers[ntracers],tokens[F_USE]) ;
+	        ntracers++ ;
+
+/* add entries for _b and _bt arrays */
+
+ sprintf(newname,"%s_b",tokens[F_USE]) ;
+ fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,newdims4d,
+                  "_4d_bdy_array_","-",tokens[F_STAG],"b",
+                  newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
+
+ sprintf(newname,"%s_bt",tokens[F_USE]) ;
+ fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,newdims4d,
+                  "_4d_bdy_array_","-",tokens[F_STAG],"b",
+                  newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
+
+  	      }
+            } else {
+
+/* add entries for _b and _bt arrays */
+
+ sprintf(newname,"%s_b",tokens[F_SYM]) ;
+ fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,tokens[F_DIMS],
+                  tokens[F_USE],"-",tokens[F_STAG],"b",
+                  newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
+
+ sprintf(newname,"%s_bt",tokens[F_SYM]) ;
+ fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,tokens[F_DIMS],
+                  tokens[F_USE],"-",tokens[F_STAG],"b",
+                  newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
+
+            }
+          }
+          parseline[0] = '\0' ;  /* reset parseline */
+          continue ;
+        }
+    }
+normal:
+    /* otherwise output the line as is */
+    fprintf(outfile,"%s\n",parseline_save) ;
+    parseline[0] = '\0' ;  /* reset parseline */
+  }
+  return(retval) ;
+}
+
+int
+reg_parse( FILE * infile )
+{
+  char inln[4096], parseline[4096] ;
+  char *p, *q ;
+  char *tokens[MAXTOKENS], *toktmp[MAXTOKENS] ; 
+  int i, ii ;
+  int defining_state_field, defining_rconfig_field, defining_i1_field ;
+
+  parseline[0] = '\0' ;
+
+  max_time_level = 1 ;
+
+/* main parse loop over registry lines */
+  while ( fgets ( inln , 4096 , infile ) != NULL )
+  {
+    strcat( parseline , inln ) ; 
+    /* allow \ to continue the end of a line */
+    if (( p = index( parseline,  '\\'  )) != NULL )
+    {
+      if ( *(p+1) == '\n' || *(p+1) == '\0' )
+      {
+	*p = '\0' ;
+	continue ;  /* go get another line */
+      }
+    }
+
+    make_lower( parseline ) ;
+    if (( p = index( parseline , '#' ))  != NULL  ) *p = '\0' ; /* discard comments (dont worry about quotes for now) */
+    if (( p = index( parseline , '\n' )) != NULL  ) *p = '\0' ; /* discard newlines */
+    for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ; 
+    i = 0 ;
+
+    if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ; 
+
+    while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ;
+    if ( i <= 0 ) continue ;
+
+    for ( i = 0 ; i < MAXTOKENS ; i++ )
+    {
+      if ( tokens[i] == NULL ) tokens[i] = "-" ;
+    }
+
+/* remove quotes from quoted entries */
+    for ( i = 0 ; i < MAXTOKENS ; i++ )
+    {
+      char * pp ;
+      if ( tokens[i][0] == '"' ) tokens[i]++ ;
+      if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ;
+    }
+
+    defining_state_field = 0 ;
+    defining_rconfig_field = 0 ;
+    defining_i1_field = 0 ;
+
+/* state entry */
+    if      ( !strcmp( tokens[ TABLE ] , "state" ) )
+    {
+      /* turn a state entry into a typedef to define a field in the top-level built-in type domain */
+      tokens[TABLE] = "typedef" ;
+      for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ; /* shift the fields to the left */
+      tokens[FIELD_OF] = "domain" ;
+                 if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ; 
+      defining_state_field = 1 ;
+    }
+    if      ( !strcmp( tokens[ TABLE ] , "rconfig" ) )
+    {
+      /* turn a rconfig entry into a typedef to define a field in the top-level built-in type domain */
+      for ( i = 0 ; i < MAXTOKENS ; i++ ) { toktmp[i] = tokens[i] ; tokens[i] = "-" ; }
+      tokens[TABLE] = "typedef" ;
+      tokens[FIELD_OF]       = "domain" ;
+      tokens[RCNF_TYPE]      = toktmp[RCNF_TYPE_PRE] ;
+                 if ( !strcmp( tokens[RCNF_TYPE], "double" ) ) tokens[RCNF_TYPE] = "doubleprecision" ; 
+      tokens[RCNF_SYM]       = toktmp[RCNF_SYM_PRE] ;
+      tokens[RCNF_IO]        = toktmp[RCNF_IO_PRE] ;
+      tokens[RCNF_DNAME]     = toktmp[RCNF_DNAME_PRE] ;
+      tokens[RCNF_USE]       = "-" ;
+      tokens[RCNF_DESCRIP]   = toktmp[RCNF_DESCRIP_PRE] ;
+      tokens[RCNF_UNITS]     = toktmp[RCNF_UNITS_PRE] ;
+      tokens[RCNF_HOWSET]    = toktmp[RCNF_HOWSET_PRE] ;
+      tokens[RCNF_NENTRIES]  = toktmp[RCNF_NENTRIES_PRE] ;
+      tokens[RCNF_DEFAULT]   = toktmp[RCNF_DEFAULT_PRE] ;
+      defining_rconfig_field = 1 ;
+    }
+    if      ( !strcmp( tokens[ TABLE ] , "i1" ) )
+    {
+      /* turn a state entry into a typedef to define a field in 
+         the top-level built-in type domain */
+      tokens[TABLE] = "typedef" ;
+      /* shift the fields to the left */
+      for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ; 
+      tokens[FIELD_OF] = "domain" ;
+                 if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ; 
+      defining_i1_field = 1 ;
+    }
+
+    /* NOTE: fall through */
+
+/* typedef entry */
+    if ( !strcmp( tokens[ TABLE ] , "typedef" ) )
+    {
+      node_t * field_struct ;
+      node_t * type_struct ;
+
+      if ( !defining_state_field && ! defining_i1_field && 
+           !defining_rconfig_field && !strcmp(tokens[FIELD_OF],"domain") )
+       { fprintf(stderr,"Registry warning: 'domain' is a reserved registry type name. Cannot 'typedef domain'\n") ; }
+
+      type_struct = get_type_entry( tokens[ FIELD_OF ] ) ;
+      if ( type_struct == NULL ) 
+      {  
+        type_struct = new_node( TYPE ) ;
+        strcpy( type_struct->name, tokens[FIELD_OF] ) ;
+        type_struct->type_type = DERIVED ;
+        add_node_to_end( type_struct , &Type ) ;
+      }
+
+      if        ( defining_i1_field )      {
+        field_struct = new_node( I1 ) ;
+      } else if ( defining_rconfig_field ) {
+        field_struct = new_node( RCONFIG ) ;
+      } else {
+        field_struct = new_node( FIELD ) ;
+      }
+
+      strcpy( field_struct->name, tokens[FIELD_SYM] ) ;
+
+      if ( set_state_type( tokens[FIELD_TYPE], field_struct ) )
+       { fprintf(stderr,"Registry warning: type %s used before defined \n",tokens[FIELD_TYPE] ) ; }
+
+      if ( set_state_dims( tokens[FIELD_DIMS], field_struct ) )
+       { fprintf(stderr,"Registry warning: some problem with dimstring %s\n", tokens[FIELD_DIMS] ) ; }
+
+      if ( strcmp( tokens[FIELD_NTL], "-" ) ) /* that is, if not equal "-" */
+       { field_struct->ntl = atoi(tokens[FIELD_NTL]) ; }
+      field_struct->ntl = ( field_struct->ntl > 0 )?field_struct->ntl:1 ;
+      /* calculate the maximum number of time levels and store in global variable */
+      if ( field_struct->ntl > max_time_level && field_struct->ntl <= 3 ) max_time_level = field_struct->ntl ;
+
+      field_struct->stag_x = 0 ; field_struct->stag_y = 0 ; field_struct->stag_z = 0 ;
+      for ( i = 0 ; i < strlen(tokens[FIELD_STAG]) ; i++ )
+      {
+	if ( tolower(tokens[FIELD_STAG][i]) == 'x' || sw_all_x_staggered ) field_struct->stag_x = 1 ;
+	if ( tolower(tokens[FIELD_STAG][i]) == 'y' || sw_all_y_staggered ) field_struct->stag_y = 1 ;
+	if ( tolower(tokens[FIELD_STAG][i]) == 'z' ) field_struct->stag_z = 1 ;
+      }
+
+      field_struct->history  = 0 ; field_struct->input     = 0 ; 
+      field_struct->auxhist1 = 0 ; field_struct->auxinput1 = 0 ; 
+      field_struct->auxhist2 = 0 ; field_struct->auxinput2 = 0 ; 
+      field_struct->auxhist3 = 0 ; field_struct->auxinput3 = 0 ; 
+      field_struct->auxhist4 = 0 ; field_struct->auxinput4 = 0 ; 
+      field_struct->auxhist5 = 0 ; field_struct->auxinput5 = 0 ; 
+      field_struct->restart  = 0 ; field_struct->boundary  = 0 ;
+      field_struct->io_mask  = 0 ;
+      {
+	char prev = '\0' ;
+	char x ;
+	int len_of_tok ;
+        char fcn_name[2048], aux_fields[2048] ;
+
+        for ( i = 0 ; i < (len_of_tok = strlen(tokens[FIELD_IO])) ; i++ )
+        {
+	  x = tolower(tokens[FIELD_IO][i]) ;
+	  if ( x >= 'a' && x <= 'z' && ! ( x == 'g' || x == 'o' ) ) {
+	    if ( x == 'h' ) {field_struct->history  = 10 ; field_struct->io_mask |= HISTORY ;}
+	    if ( x == 'i' ) {field_struct->input    = 10 ; field_struct->io_mask |= INPUT   ;}
+	    if ( x == 'r' ) {field_struct->restart  = 10 ; field_struct->io_mask |= RESTART ;}
+	    if ( x == 'b' ) {field_struct->boundary = 10 ; field_struct->io_mask |= BOUNDARY ;}
+	    if ( x == 'f' || x == 'd' || x == 'u' || x == 's' ) { 
+                               strcpy(aux_fields,"") ;
+                               strcpy(fcn_name,"") ; 
+	                       if ( tokens[FIELD_IO][i+1] == '(' )     /* catch a possible error */
+                               {
+				 fprintf(stderr,
+				    "Registry warning: syntax error in %c specifier of IO field for %s\n",x,tokens[FIELD_SYM]) ;
+				 fprintf(stderr,
+				    "                  equal sign needed before left paren\n") ;
+			       }
+
+	                       if ( tokens[FIELD_IO][i+1] == '=' ) 
+			       {
+				 int ii, jj, state ;
+				 state = 0 ;
+				 jj = 0 ;
+				 for ( ii = i+3 ; ii < len_of_tok ; ii++ )
+				 {
+				   if ( tokens[FIELD_IO][ii] == ')' ) { if (state == 0 )fcn_name[jj] = '\0' ; aux_fields[jj] = '\0' ; break ; }
+				   if ( tokens[FIELD_IO][ii] == ':' ) { fcn_name[jj] = '\0' ; jj= 0 ; state++ ; continue ;}
+				   if ( tokens[FIELD_IO][ii] == ',' && state == 0 ) {
+				     fprintf(stderr,
+                                             "Registry warning: syntax error in %c specifier of IO field for %s\n",x,
+                                             tokens[FIELD_SYM]) ;
+				   }
+				   if ( state == 0 )  /* looking for interpolation fcn name */
+				   {
+				     fcn_name[jj++] = tokens[FIELD_IO][ii] ;
+				   }
+				   if ( state > 0 )
+				   {
+				     aux_fields[jj++] = tokens[FIELD_IO][ii] ;
+				   }
+				 }
+				 i = ii ;
+			       }
+                               else
+			       {
+				 if ( x == 'f' || x == 'd' ) strcpy(fcn_name,"interp_fcn") ;
+				 if ( x == 'u' ) strcpy(fcn_name,"copy_fcn") ;
+				 if ( x == 's' ) strcpy(fcn_name,"smoother") ;
+			       }
+	                       if      ( x == 'f' )  { 
+                                 field_struct->io_mask |= FORCE_DOWN ; 
+                                 strcpy(field_struct->force_fcn_name, fcn_name ) ;
+                                 strcpy(field_struct->force_aux_fields, aux_fields ) ;
+                               }
+                               else if ( x == 'd' )  { 
+                                 field_struct->io_mask |= INTERP_DOWN ; 
+                                 strcpy(field_struct->interpd_fcn_name, fcn_name ) ;
+                                 strcpy(field_struct->interpd_aux_fields, aux_fields ) ;
+                               }
+                               else if ( x == 's' )  { 
+                                 field_struct->io_mask |= SMOOTH_UP ; 
+                                 strcpy(field_struct->smoothu_fcn_name, fcn_name ) ;
+                                 strcpy(field_struct->smoothu_aux_fields, aux_fields ) ;
+                               }
+                               else if ( x == 'u' )  { 
+                                 field_struct->io_mask |= INTERP_UP ; 
+                                 strcpy(field_struct->interpu_fcn_name, fcn_name ) ;
+                                 strcpy(field_struct->interpu_aux_fields, aux_fields ) ;
+                               }
+            }
+	    prev = x ;
+	  } else if ( x >= '0' && x <= '9' || x == 'g' || x == 'o' )
+	  {
+	    if ( prev  == 'i' )
+	    {
+              field_struct->io_mask &= ! INPUT ;                /* turn off setting from 'i' */
+	      field_struct->input = field_struct->input % 10 ;  /* turn off setting from 'i' */
+	      if ( x == '0' ) field_struct->input = 1 ;
+	      if ( x == '1' ) field_struct->auxinput1 = 1 ;
+	      if ( x == '2' ) field_struct->auxinput2 = 1 ;
+	      if ( x == '3' ) field_struct->auxinput3 = 1 ;
+	      if ( x == '4' ) field_struct->auxinput4 = 1 ;
+	      if ( x == '5' ) field_struct->auxinput5 = 1 ;
+	      if ( x == '6' ) field_struct->auxinput6 = 1 ;
+	      if ( x == '7' ) field_struct->auxinput7 = 1 ;
+	      if ( x == '8' ) field_struct->auxinput8 = 1 ;
+	      if ( x == '9' ) field_struct->auxinput9 = 1 ;
+	      if ( x == 'g' ) field_struct->auxinput10 = 1 ;
+	      if ( x == 'o' ) field_struct->auxinput11 = 1 ;
+	    }
+	    if ( prev  == 'h' )
+	    {
+              field_struct->io_mask &= ! HISTORY ;                  /* turn off setting from 'h' */
+	      field_struct->history = field_struct->history % 10 ;  /* turn off setting from 'h' */
+	      if ( x == '0' ) field_struct->history = 1 ;
+	      if ( x == '1' ) field_struct->auxhist1 = 1 ;
+	      if ( x == '2' ) field_struct->auxhist2 = 1 ;
+	      if ( x == '3' ) field_struct->auxhist3 = 1 ;
+	      if ( x == '4' ) field_struct->auxhist4 = 1 ;
+	      if ( x == '5' ) field_struct->auxhist5 = 1 ;
+	      if ( x == '6' ) field_struct->auxhist6 = 1 ;
+	      if ( x == '7' ) field_struct->auxhist7 = 1 ;
+	      if ( x == '8' ) field_struct->auxhist8 = 1 ;
+	      if ( x == '9' ) field_struct->auxhist9 = 1 ;
+	      if ( x == 'g' ) field_struct->auxhist10 = 1 ;
+	      if ( x == 'o' ) field_struct->auxhist11 = 1 ;
+	    }
+	  }
+        }
+	if ( field_struct->history   > 0 ) { field_struct->history   = 1 ; field_struct->io_mask |= HISTORY   ; }
+	if ( field_struct->auxhist1  > 0 ) { field_struct->auxhist1  = 1 ; field_struct->io_mask |= AUXHIST1  ; }
+	if ( field_struct->auxhist2  > 0 ) { field_struct->auxhist2  = 1 ; field_struct->io_mask |= AUXHIST2  ; }
+	if ( field_struct->auxhist3  > 0 ) { field_struct->auxhist3  = 1 ; field_struct->io_mask |= AUXHIST3  ; }
+	if ( field_struct->auxhist4  > 0 ) { field_struct->auxhist4  = 1 ; field_struct->io_mask |= AUXHIST4  ; }
+	if ( field_struct->auxhist5  > 0 ) { field_struct->auxhist5  = 1 ; field_struct->io_mask |= AUXHIST5  ; }
+	if ( field_struct->auxhist6  > 0 ) { field_struct->auxhist6  = 1 ; field_struct->io_mask |= AUXHIST6  ; }
+	if ( field_struct->auxhist7  > 0 ) { field_struct->auxhist7  = 1 ; field_struct->io_mask |= AUXHIST7  ; }
+	if ( field_struct->auxhist8  > 0 ) { field_struct->auxhist8  = 1 ; field_struct->io_mask |= AUXHIST8  ; }
+	if ( field_struct->auxhist9  > 0 ) { field_struct->auxhist9  = 1 ; field_struct->io_mask |= AUXHIST9  ; }
+	if ( field_struct->auxhist10  > 0 ) { field_struct->auxhist10  = 1 ; field_struct->io_mask |= AUXHIST10  ; }
+	if ( field_struct->auxhist11  > 0 ) { field_struct->auxhist11  = 1 ; field_struct->io_mask |= AUXHIST11  ; }
+
+	if ( field_struct->input     > 0 ) { field_struct->input     = 1 ; field_struct->io_mask |= INPUT     ; }
+	if ( field_struct->auxinput1 > 0 ) { field_struct->auxinput1 = 1 ; field_struct->io_mask |= AUXINPUT1 ; }
+	if ( field_struct->auxinput2 > 0 ) { field_struct->auxinput2 = 1 ; field_struct->io_mask |= AUXINPUT2 ; }
+	if ( field_struct->auxinput3 > 0 ) { field_struct->auxinput3 = 1 ; field_struct->io_mask |= AUXINPUT3 ; }
+	if ( field_struct->auxinput4 > 0 ) { field_struct->auxinput4 = 1 ; field_struct->io_mask |= AUXINPUT4 ; }
+	if ( field_struct->auxinput5 > 0 ) { field_struct->auxinput5 = 1 ; field_struct->io_mask |= AUXINPUT5 ; }
+	if ( field_struct->auxinput6 > 0 ) { field_struct->auxinput6 = 1 ; field_struct->io_mask |= AUXINPUT6 ; }
+	if ( field_struct->auxinput7 > 0 ) { field_struct->auxinput7 = 1 ; field_struct->io_mask |= AUXINPUT7 ; }
+	if ( field_struct->auxinput8 > 0 ) { field_struct->auxinput8 = 1 ; field_struct->io_mask |= AUXINPUT8 ; }
+	if ( field_struct->auxinput9 > 0 ) { field_struct->auxinput9 = 1 ; field_struct->io_mask |= AUXINPUT9 ; }
+	if ( field_struct->auxinput10 > 0 ) { field_struct->auxinput10 = 1 ; field_struct->io_mask |= AUXINPUT10 ; }
+	if ( field_struct->auxinput11 > 0 ) { field_struct->auxinput11 = 1 ; field_struct->io_mask |= AUXINPUT11 ; }
+
+	if ( field_struct->restart   > 0 ) { field_struct->restart   = 1 ; field_struct->io_mask |= RESTART   ; }
+	if ( field_struct->boundary  > 0 ) { field_struct->boundary  = 1 ; field_struct->io_mask |= BOUNDARY  ; }
+      }
+
+      field_struct->dname[0] = '\0' ;
+      if ( strcmp( tokens[FIELD_DNAME], "-" ) ) /* that is, if not equal "-" */
+        { strcpy( field_struct->dname , tokens[FIELD_DNAME] ) ; }
+      strcpy(field_struct->descrip,"-") ;
+      if ( strcmp( tokens[FIELD_DESCRIP], "-" ) ) /* that is, if not equal "-" */
+        { strcpy( field_struct->descrip , tokens[FIELD_DESCRIP] ) ; }
+      strcpy(field_struct->units,"-") ;
+      if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */
+        { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; }
+      strcpy(field_struct->use,"-") ;
+      if ( strcmp( tokens[FIELD_USE], "-" ) ) /* that is, if not equal "-" */
+        { strcpy( field_struct->use , tokens[FIELD_USE] ) ;
+          if ( ! defining_rconfig_field && ! field_struct->scalar_array_member && !strncmp( tokens[FIELD_USE], "dyn_", 4 ) )
+             add_core_name( tokens[FIELD_USE]+4 ) ;
+        }
+
+      /* specific settings for RCONFIG entries */
+      if ( defining_rconfig_field )
+      {
+	if ( strcmp( tokens[RCNF_NENTRIES] , "-" ) ) /* that is, if not equal "-" */
+	{
+	  strcpy(field_struct->nentries, tokens[RCNF_NENTRIES] ) ;
+	} else {
+	  strcpy(field_struct->nentries, "1" ) ;
+	}
+	if ( strcmp( tokens[RCNF_HOWSET] , "-" ) ) /* that is, if not equal "-" */
+	{
+	  strcpy(field_struct->howset,tokens[RCNF_HOWSET]) ;
+	} else {
+	  strcpy(field_struct->howset,"") ;
+	}
+	if ( strcmp( tokens[RCNF_DEFAULT] , "-" ) ) /* that is, if not equal "-" */
+	{
+	  strcpy(field_struct->dflt,tokens[RCNF_DEFAULT]) ;
+	} else {
+	  strcpy(field_struct->dflt,"") ;
+	}
+      }
+
+      if ( field_struct->type != NULL )
+        if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 )
+          { fprintf(stderr,"Registry warning: type item %s of type %s can not be multi-dimensional ",
+	  		   tokens[FIELD_SYM], tokens[FIELD_TYPE] ) ; }
+
+/**/  if ( ! field_struct->scalar_array_member )
+      {
+        add_node_to_end( field_struct , &(type_struct->fields) ) ;
+      }
+/**/  else   /* if ( field_struct->scalar_array_member ) */
+      {
+/* 
+   Here we are constructing a list of nodes to represent the list of 4D scalar arrays in the model
+
+   This list is rooted at the FourD pointer.
+   Each array is represented by its own node; each node has a pointer, members, to the list
+   of fields that make it up.  
+
+*/
+	node_t * q , * member  ;
+	if (( q = get_4d_entry(field_struct->use )) == NULL )  /* first instance of a 4d array member */
+	{
+	  q = new_node( FOURD ) ;
+	  *q = *field_struct ;  /* this overwrites the node */
+	  strcpy( q->name, field_struct->use ) ;
+	  strcpy( q->use, "" ) ;
+	  q->node_kind = FOURD ;
+	  q->scalar_array_member = 0 ;
+	  q->next4d = NULL ;
+	  q->next = NULL ;
+                  /* add 4d q node to the list of fields of this type and also attach
+                     it to the global list of 4d arrays */
+	  add_node_to_end( q , &(type_struct->fields) ) ;
+	  add_node_to_end_4d( q , &(FourD) ) ;
+	}
+	member = new_node( MEMBER ) ;
+        *member = *q ;
+	member->node_kind = MEMBER ;
+	member->members = NULL ;
+        member->scalar_array_member = 1 ;
+	strcpy( member->name , field_struct->name ) ;
+	strcpy( member->dname , field_struct->dname ) ;
+	strcpy( member->use , field_struct->use ) ;
+	strcpy( member->descrip , field_struct->descrip ) ;
+	strcpy( member->units , field_struct->units ) ;
+	member->next = NULL ;
+	member->io_mask = field_struct->io_mask ;
+	member->ndims = field_struct->ndims ;
+	strcpy( member->interpd_fcn_name, field_struct->interpd_fcn_name) ;
+	strcpy( member->interpd_aux_fields,  field_struct->interpd_aux_fields)  ;
+	strcpy( member->interpu_fcn_name, field_struct->interpu_fcn_name) ;
+	strcpy( member->interpu_aux_fields,  field_struct->interpu_aux_fields)  ;
+	strcpy( member->smoothu_fcn_name, field_struct->smoothu_fcn_name) ;
+	strcpy( member->smoothu_aux_fields,  field_struct->smoothu_aux_fields)  ;
+	strcpy( member->force_fcn_name, field_struct->force_fcn_name) ;
+	strcpy( member->force_aux_fields,  field_struct->force_aux_fields)  ;
+        for ( ii = 0 ; ii < member->ndims ; ii++ )
+	  member->dims[ii] = field_struct->dims[ii] ;
+	add_node_to_end( member , &(q->members) ) ;
+        free(field_struct) ;  /* We've used all the information about this entry.
+                                 It is not a field but the name of one of the members of
+                                 a 4d field.  we have handled that here. Discard the original node. */
+      }
+    }
+
+/* dimespec entry */
+    else if ( !strcmp( tokens[ TABLE ] , "dimspec" ) )
+    {
+      node_t * dim_struct ;
+      dim_struct = new_node( DIM ) ;
+      if ( strlen( tokens[DIM_NAME] ) > 1 )
+        { fprintf(stderr,"Registry warning: dimspec (%s) must be only one letter\n",tokens[DIM_NAME] ) ; }
+      if ( get_dim_entry ( tokens[DIM_NAME][0] ) != NULL )
+        { fprintf(stderr,"Registry warning: dimspec (%c) already defined\n",tokens[DIM_NAME][0] ) ; }
+      dim_struct->dim_name = tokens[DIM_NAME][0] ;
+      if ( set_dim_order( tokens[DIM_ORDER], dim_struct ) )
+        { fprintf(stderr,"Registry warning: problem with dimorder (%s)\n",tokens[DIM_ORDER] ) ; }
+      if ( set_dim_len( tokens[DIM_SPEC], dim_struct ) )
+        { fprintf(stderr,"Registry warning: problem with dimspec (%s)\n",tokens[DIM_SPEC] ) ; }
+      if ( set_dim_orient( tokens[DIM_ORIENT], dim_struct ) )
+        { fprintf(stderr,"Registry warning: problem with dimorient (%s)\n",tokens[DIM_ORIENT] ) ; }
+      if ( strcmp( tokens[DIM_DATA_NAME], "-" ) ) /* that is, if not equal "-" */
+        { strcpy( dim_struct->dim_data_name , tokens[DIM_DATA_NAME] ) ; }
+
+      add_node_to_end( dim_struct , &Dim ) ;
+    }
+
+/* package */
+    else if ( !strcmp( tokens[ TABLE ] , "package" ) )
+    {
+      node_t * package_struct ;
+      package_struct = new_node( PACKAGE ) ;
+      strcpy( package_struct->name          , tokens[PKG_SYM]       ) ;
+      strcpy( package_struct->pkg_assoc     , tokens[PKG_ASSOC]     ) ;
+      strcpy( package_struct->pkg_statevars , tokens[PKG_STATEVARS] ) ;
+      strcpy( package_struct->pkg_4dscalars , tokens[PKG_4DSCALARS] ) ;
+
+      add_node_to_end( package_struct , &Packages ) ;
+    }
+
+/* halo, period, xpose */
+    else if ( !strcmp( tokens[ TABLE ] , "halo" ) )
+    {
+      node_t * comm_struct ;
+      comm_struct = new_node( HALO ) ;
+      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
+      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
+#if 1
+      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
+        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
+      } 
+#else
+      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
+#endif
+      add_node_to_end( comm_struct , &Halos ) ;
+    }
+    else if ( !strcmp( tokens[ TABLE ] , "period" ) )
+    {
+      node_t * comm_struct ;
+      comm_struct = new_node( PERIOD ) ;
+      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
+      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
+#if 1
+      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
+        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
+      } 
+#else
+      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
+#endif
+      add_node_to_end( comm_struct , &Periods ) ;
+    }
+    else if ( !strcmp( tokens[ TABLE ] , "xpose" ) )
+    {
+      node_t * comm_struct ;
+      comm_struct = new_node( XPOSE ) ;
+      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
+      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
+#if 1
+      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
+        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
+      } 
+#else
+      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
+#endif
+      add_node_to_end( comm_struct , &Xposes ) ;
+    }
+    else if ( !strcmp( tokens[ TABLE ] , "swap" ) )
+    {
+      node_t * comm_struct ;
+      comm_struct = new_node( SWAP ) ;
+      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
+      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
+#if 1
+      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
+        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
+      }
+#else
+      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
+#endif
+      add_node_to_end( comm_struct , &Swaps ) ;
+    }
+    else if ( !strcmp( tokens[ TABLE ] , "cycle" ) )
+    {
+      node_t * comm_struct ;
+      comm_struct = new_node( CYCLE ) ;
+      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
+      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
+#if 1
+      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
+        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
+      }
+#else
+      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
+#endif
+      add_node_to_end( comm_struct , &Cycles ) ;
+    }
+
+
+#if 0
+     fprintf(stderr,"vvvvvvvvvvvvvvvvvvvvvvvvvvv\n") ;
+     show_nodelist( Type ) ;
+     fprintf(stderr,"^^^^^^^^^^^^^^^^^^^^^^^^^^^\n") ;
+#endif
+     parseline[0] = '\0' ;  /* reset parseline */
+  }
+
+  Domain = *(get_type_entry( "domain" )) ;
+
+#if 0
+  show_node( &Domain ) ;
+#endif
+
+  return(0) ;
+
+}
+
+node_t *
+get_dim_entry( char c )
+{
+  node_t * p ;
+  for ( p = Dim ; p != NULL ; p = p->next )
+  {
+    if ( p->dim_name == c ) return( p ) ;
+  }
+  return(NULL) ;
+}
+
+int
+set_state_type( char * typename, node_t * state_entry )
+{
+  if ( typename == NULL ) return(1) ;
+  return (( state_entry->type = get_type_entry( typename )) == NULL )  ;
+}
+
+int
+set_dim_len ( char * dimspec , node_t * dim_entry )
+{
+  if      (!strcmp( dimspec , "standard_domain" ))
+   { dim_entry->len_defined_how = DOMAIN_STANDARD ; }
+  else if (!strncmp( dimspec, "constant=" , 9 ))
+  {
+    char *p, *colon, *paren ;
+    p = &(dimspec[9]) ;
+    /* check for colon */
+    if (( colon = index(p,':')) != NULL )
+    {
+      *colon = '\0' ;
+      if (( paren = index(p,'(')) !=NULL )
+      {
+        dim_entry->coord_start = atoi(paren+1) ;
+      }
+      else
+      {
+        fprintf(stderr,"WARNING: illegal syntax (missing opening paren) for constant: %s\n",p) ;
+      }
+      dim_entry->coord_end   = atoi(colon+1) ;
+    }
+    else
+    {
+      dim_entry->coord_start = 1 ;
+      dim_entry->coord_end   = atoi(p) ;
+    }
+    dim_entry->len_defined_how = CONSTANT ;
+  }
+  else if (!strncmp( dimspec, "namelist=", 9 ))
+  {
+    char *p, *colon ;
+
+    p = &(dimspec[9]) ;
+    /* check for colon */
+    if (( colon = index(p,':')) != NULL )
+    {
+      *colon = '\0' ;
+      strcpy( dim_entry->assoc_nl_var_s, p ) ;
+      strcpy( dim_entry->assoc_nl_var_e, colon+1 ) ;
+    }
+    else
+    {
+      strcpy( dim_entry->assoc_nl_var_s, "1" ) ;
+      strcpy( dim_entry->assoc_nl_var_e, p ) ;
+    }
+    dim_entry->len_defined_how = NAMELIST ;
+  }
+  else
+  {
+    return(1) ;
+  }
+  return(0) ;
+}
+
+int
+set_dim_orient ( char * dimorient , node_t * dim_entry )
+{
+  if      (!strcmp( dimorient , "x" ))
+   { dim_entry->coord_axis = COORD_X ; }
+  else if (!strcmp( dimorient , "y" )) 
+   { dim_entry->coord_axis = COORD_Y ; }
+  else if (!strcmp( dimorient , "z" )) 
+   { dim_entry->coord_axis = COORD_Z ; }
+  else
+   { dim_entry->coord_axis = COORD_C ; }
+  return(0) ;
+}
+
+/* integrity checking of dimension list; make sure that
+   namelist specified dimensions have an associated namelist variable */
+int
+check_dimspecs()
+{
+  node_t * p, *q ;
+  int ord ;
+
+  for ( p = Dim ; p != NULL ; p = p->next )
+  {
+    if      ( p->len_defined_how == DOMAIN_STANDARD )
+    {
+      if ( p->dim_order < 1 || p->dim_order > 3 )
+      {
+        fprintf(stderr,"WARNING: illegal dim order %d for dimspec %s\n",p->dim_order,p->name) ;
+      }
+      ord = p->dim_order-1 ;
+      if ( model_order[ord] != p->coord_axis )
+      {
+        if ( model_order[ord] == -1 ) model_order[ord] = p->coord_axis ;
+        else
+        {
+          fprintf(stderr,"WARNING: coord-axis/dim-order for dimspec %s is inconsistent with previous dimspec.\n",p->name) ;
+        }
+      }
+    }
+    else if ( p->len_defined_how == NAMELIST )
+    {
+      if ( strcmp( p->assoc_nl_var_s, "1" ) )   /* if not equal to "1" */
+      {
+        if (( q = get_entry(p->assoc_nl_var_s,Domain.fields)) == NULL )
+        {
+	  fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
+		  p->assoc_nl_var_s,p->name ) ;
+	  return(1) ;
+        }
+        if ( ! q->node_kind & RCONFIG )
+        {
+	  fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
+		  p->assoc_nl_var_s,p->name ) ;
+	  return(1) ;
+        }
+        if ( strcmp( q->type->name , "integer" ) )   /* if not integer */
+        {
+	  fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
+		  p->assoc_nl_var_s,p->name ) ;
+	  return(1) ;
+        }
+        if ( strcmp( q->nentries , "1" ) )   /* if not 1 entry */
+        {
+	  fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
+		  p->assoc_nl_var_s,p->name ) ;
+	  return(1) ;
+        }
+      }
+      if (( q = get_entry(p->assoc_nl_var_e,Domain.fields)) == NULL )
+      {
+	fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
+		p->assoc_nl_var_e,p->name ) ;
+	return(1) ;
+      }
+      if ( ! q->node_kind & RCONFIG )
+      {
+	fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
+		p->assoc_nl_var_e,p->name ) ;
+	return(1) ;
+      }
+      if ( strcmp( q->type->name , "integer" ) )   /* if not integer */
+      {
+	fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
+		p->assoc_nl_var_e,p->name ) ;
+	return(1) ;
+      }
+      if ( strcmp( q->nentries , "1" ) )   /* if not 1 entry */
+      {
+	fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
+		p->assoc_nl_var_e,p->name ) ;
+	return(1) ;
+      }
+    }
+  }
+  return(0) ;
+}
+
+int
+set_dim_order ( char * dimorder , node_t * dim_entry )
+{
+  dim_entry->dim_order = atoi(dimorder) ;
+  return(0) ;
+}
+
+init_parser()
+{
+  model_order[0] = -1 ;
+  model_order[1] = -1 ;
+  model_order[2] = -1 ;
+  return(0) ;
+}
Index: trunk/WRF.COMMON/WRFV2/tools/registry.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/registry.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/registry.c	(revision 2744)
@@ -0,0 +1,197 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+#include <unistd.h>
+#include <string.h>
+#include <strings.h>
+
+#define DEFINE_GLOBALS
+#include "protos.h"
+#include "registry.h"
+#include "data.h"
+#include "sym.h"
+
+main( int argc, char *argv[], char *env[] )
+{
+  char fname_in[NAMELEN], dir[NAMELEN], fname_tmp[NAMELEN], command[NAMELEN] ;
+  FILE * fp_in, *fp_tmp ;
+  char * thisprog  ;
+  int mypid ;
+  struct rlimit rlim ;
+
+  mypid = (int) getpid() ;
+  strcpy( thiscom, argv[0] ) ;
+  argv++ ;
+
+  sw_deref_kludge           = 0 ;
+  sw_io_deref_kludge        = 0 ;
+  sw_3dvar_iry_kludge           = 0 ;
+  sw_distrib_io_layer       = 1 ;
+  sw_limit_args             = 0 ; /* usually set -- except for GRAPS */
+  sw_dm_parallel            = 0 ;
+  sw_all_x_staggered       = 0 ;
+  sw_move                  = 0 ;
+  sw_all_y_staggered       = 0 ;
+  sw_ifort_kludge          = 0 ;
+  sw_dm_serial_in_only      = 0 ; /* input and bdy data set is distributed by node 0, 
+                                     other data streams are written to file per process */
+
+  strcpy( fname_in , "" ) ;
+
+  rlim.rlim_cur = RLIM_INFINITY ;
+  rlim.rlim_max = RLIM_INFINITY ;
+
+  setrlimit ( RLIMIT_STACK , &rlim ) ;
+
+  sym_forget() ;
+  thisprog = *argv ;
+  while (*argv) {
+    if (*argv[0] == '-') {  /* an option */
+      if (!strncmp(*argv,"-D",2)) {
+        char * p ;
+        p = *argv ;
+        sym_add(p+2) ;
+      }
+   
+      if (!strcmp(*argv,"-DDEREF_KLUDGE")) {
+        sw_deref_kludge = 1 ;
+      }
+      if (!strcmp(*argv,"-DIO_DEREF_KLUDGE")) {
+        sw_io_deref_kludge = 1 ;
+      }
+      if (!strcmp(*argv,"-DLIMIT_ARGS")) {
+        sw_limit_args = 1 ;
+      }
+      if (!strcmp(*argv,"-DMOVE_NESTS")) {
+        sw_move = 1 ;
+      }
+      if (!strcmp(*argv,"-DIFORT_KLUDGE")) {
+        sw_ifort_kludge = 1 ;
+      }
+      if (!strcmp(*argv,"-DD3VAR_IRY_KLUDGE")) {
+#if 0
+        sw_3dvar_iry_kludge = 1 ;
+#else
+        fprintf(stderr,"WARNING: -DD3VAR_IRY_KLUDGE option obsolete (it is now disabled by default). Ignored.\n") ;
+#endif
+      }
+      if (!strcmp(*argv,"-DALL_X_STAGGERED")) {
+        sw_all_x_staggered = 1 ;
+      }
+      if (!strcmp(*argv,"-DALL_Y_STAGGERED")) {
+        sw_all_y_staggered = 1 ;
+      }
+      if (!strcmp(*argv,"-DDM_PARALLEL")) {
+        sw_dm_parallel = 1 ;
+      }
+      if (!strcmp(*argv,"-DDISTRIB_IO_LAYER")) {
+#if 0
+        sw_distrib_io_layer = 1 ;
+#else
+        fprintf(stderr,"WARNING: -DDISTRIB_IO_LAYER option obsolete (it is now default). Ignored.\n") ;
+#endif
+      }
+      if (!strcmp(*argv,"-DDM_SERIAL_IN_ONLY")) {
+        sw_dm_serial_in_only = 1 ;
+      }
+      if (!strncmp(*argv,"-h",2)) {
+        fprintf(stderr,"Usage: %s [-DDEREF_KLUDGE] [-DDM_PARALLEL] [-DDISTRIB_IO_LAYER] [-DDM_SERIAL_IN_ONLY] [-DD3VAR_IRY_KLUDGE] registryfile\n",thisprog) ;
+        exit(1) ;
+      }
+    }
+    else  /* consider it an input file */
+    {
+      strcpy( fname_in , *argv ) ;
+    }
+    argv++ ;
+  }
+
+  init_parser() ;
+  init_type_table() ;
+  init_dim_table() ;
+  init_core_table() ;
+
+  if ( !strcmp(fname_in,"") ) fp_in = stdin ;
+  else
+    if (( fp_in = fopen( fname_in , "r" )) == NULL )
+    {
+      fprintf(stderr,"Registry program cannot open %s for reading. Ending.\n", fname_in ) ;
+      exit(2) ;
+    }
+  
+  sprintf( fname_tmp , "Registry_tmp.%d",mypid) ;
+  if (( fp_tmp = fopen( fname_tmp  , "w" )) == NULL )
+  {
+    fprintf(stderr,"Registry program cannot open temporary %s for writing. Ending.\n", fname_tmp ) ;
+    exit(2) ;
+  }
+
+  { char *e ;
+    strcpy( dir , fname_in ) ;
+    if ( ( e = rindex ( dir , '/' ) ) != NULL ) { *e = '\0' ; } else { strcpy( dir, "." ) ; } 
+  }
+
+  if ( pre_parse( dir, fp_in, fp_tmp ) ) {
+    fprintf(stderr,"Problem with Registry File %s\n", fname_in ) ;
+    goto cleanup ;
+  }
+  sym_forget() ;
+
+  fclose(fp_in) ;
+  fclose(fp_tmp) ;
+
+  if (( fp_tmp = fopen( fname_tmp , "r" )) == NULL )
+  {
+    fprintf(stderr,"Registry program cannot open %s for reading. Ending.\n", fname_tmp ) ;
+    goto cleanup ;
+  }
+
+  reg_parse(fp_tmp) ;
+
+  fclose(fp_tmp) ;
+
+  check_dimspecs() ;
+
+  gen_state_struct( "inc" ) ;
+  gen_state_subtypes( "inc" ) ;
+  gen_alloc( "inc" ) ;
+  gen_dealloc( "inc" ) ;
+  gen_scalar_indices( "inc" ) ;
+  gen_module_state_description( "frame" ) ;
+  gen_actual_args( "inc" ) ;
+  gen_actual_args_new( "inc" ) ;
+  gen_dummy_args( "inc" ) ;
+  gen_dummy_args_new( "inc" ) ;
+  gen_dummy_decls( "inc" ) ;
+  gen_dummy_decls_new( "inc" ) ;
+  gen_i1_decls( "inc" ) ;
+  gen_namelist_statements("inc") ;
+  gen_namelist_defines ( "inc", 0 ) ;  /* without dimension statements  */
+  gen_namelist_defines ( "inc", 1 ) ;  /* with dimension statements     */
+  gen_namelist_defaults ( "inc" ) ;
+  gen_get_nl_config( "inc" ) ;
+  gen_config_assigns( "inc" ) ;
+  gen_config_reads( "inc" ) ;
+  gen_wrf_io( "inc" ) ;
+  gen_model_data_ord( "inc" ) ;
+  gen_nest_interp( "inc" ) ;
+  gen_scalar_derefs( "inc" ) ;
+
+#if 1
+  system( "touch inc/em_nest_feedbackup_smooth.inc" ) ;
+  system( "touch inc/em_nest_feedbackup_unpack.inc" ) ;
+#endif
+
+
+/* this has to happen after gen_nest_interp, which adds halos to the AST */
+  gen_comms( "inc" ) ;    /* this is either package supplied (by copying a */
+                          /* gen_comms.c file into this directory) or a    */
+                          /* stubs routine.                                */
+
+cleanup:
+  sprintf(command,"/bin/rm -f %s\n",fname_tmp );
+  system( command ) ;
+
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/registry.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/registry.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/registry.h	(revision 2744)
@@ -0,0 +1,76 @@
+#ifndef REGISTRY_H
+#define NAMELEN 8092
+#define MAXDIMS 21
+#define MAX_DYNCORES 50   /* ha ha, just kidding */
+/* #define MAX_ARGLINE 175    WRF uses 128 by default, but the nested chem version hit the continuation line limit for efc so it had to be increased, wig 14-Oct-2004 */
+#define MAX_ARGLINE 128   /* welp, 175 means lines longer than 130 chars, which is a Fortran no no */
+#define MAX_TYPEDEFS 50   /* typedef history -ajb */
+
+/* defines of system commands */
+#define UNIQSORT "/bin/sort -u"
+#define CATCOMM  "/bin/cat"
+#define RMCOMM   "/bin/rm"
+#define MVCOMM   "/bin/mv"
+
+#define DRIVER_LAYER     100
+#define MEDIATION_LAYER  200
+
+enum coord_axis      { COORD_X , COORD_Y , COORD_Z , COORD_C } ;
+enum len_defined_how { DOMAIN_STANDARD , NAMELIST , CONSTANT } ;
+enum type_type       { SIMPLE , DERIVED } ;
+enum proc_orient     { ALL_Z_ON_PROC , ALL_X_ON_PROC , ALL_Y_ON_PROC } ;
+
+/* node_kind  mask settings */
+#define FIELD      1
+#define I1         2
+#define RCONFIG    4
+#define FOURD      8
+#define MEMBER    16
+#define TYPE      32
+#define DIM       64
+#define PACKAGE  128
+#define HALO     256
+#define PERIOD   512
+#define SWAP    1024
+#define CYCLE   2048
+#define XPOSE   4096
+#define FOURD1  8192
+#define BDYONLY 16384
+
+/* I/O mask settings                     bit  */
+#define HISTORY       0x00000002      /*    1 */
+#define AUXHIST1      0x00000004      /*    2 */
+#define AUXHIST2      0x00000008      /*    3 */
+#define AUXHIST3      0x00000010      /*    4 */
+#define AUXHIST4      0x00000020      /*    5 */
+#define AUXHIST5      0x00000040      /*    6 */
+#define AUXHIST6      0x00000080      /*    7 */
+#define AUXHIST7      0x00000100      /*    8 */
+#define AUXHIST8      0x00000200      /*    9 */
+#define AUXHIST9      0x00000400      /*    0 */
+#define AUXHIST10     0x00000800      /*   11 */
+#define AUXHIST11     0x00001000      /*   12 */
+#define INPUT         0x00002000      /*   13 */
+#define AUXINPUT1     0x00004000      /*   14 */
+#define AUXINPUT2     0x00008000      /*   15 */
+#define AUXINPUT3     0x00010000      /*   16 */
+#define AUXINPUT4     0x00020000      /*   17 */
+#define AUXINPUT5     0x00040000      /*   18 */
+#define AUXINPUT6     0x00080000      /*   19 */
+#define AUXINPUT7     0x00100000      /*   10 */
+#define AUXINPUT8     0x00200000      /*   21 */
+#define AUXINPUT9     0x00400000      /*   22 */
+#define AUXINPUT10    0x00800000      /*   23 */
+#define AUXINPUT11    0x01000000      /*   24 */
+#define RESTART       0x02000000      /*   25 */
+#define BOUNDARY      0x04000000      /*   26 */
+#define INTERP_DOWN   0x08000000      /*   27 */
+#define FORCE_DOWN    0x10000000      /*   28 */
+#define INTERP_UP     0x20000000      /*   29 */
+#define SMOOTH_UP     0x40000000      /*   20 */
+#define METADATA      0x80000000      /*   31 */
+
+
+#define REGISTRY_H
+#endif
+
Index: trunk/WRF.COMMON/WRFV2/tools/regtest.csh
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/regtest.csh	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/regtest.csh	(revision 2744)
@@ -0,0 +1,3074 @@
+#!/bin/csh
+# @ job_type		= parallel
+# @ environment		= COPY_ALL;MP_EUILIB=us
+# @ job_name		= regtest.$(jobid)
+# @ output		= regtest_out
+# @ error		= regtest_err
+# @ network.MPI		= csss,shared,us
+# @ node_usage		= shared
+# @ checkpoint		= no
+# @ wall_clock_limit	= 21600
+# @ node		= 1
+# @ total_tasks		= 4
+###################  NCAR  ########################
+# @ ja_report		= yes
+# @ class               = share
+###################  NCAR  ########################
+###################  NCEP  ########################
+## @ class              = dev
+## @ group              = devqpri
+## @ preferences        = Feature == "dev"
+###################  NCEP  ########################
+# @ queue
+
+# #BSUB -x                                # exlusive use of node (not_shared)
+# #BSUB -a mpich_gm                       # at NCAR: lightning
+# #BSUB -R "span[ptile=2]"                # how many tasks per node (1 or 2)
+#BSUB -a poe                            # at NCAR: bluevista
+#BSUB -R "span[ptile=4]"                # how many tasks per node (up to 8)
+#BSUB -n 4                              # number of total tasks
+#BSUB -o reg.out                        # output filename (%J to add job id)
+#BSUB -e reg.err                        # error filename
+#BSUB -J reg.test                       # job name
+#BSUB -q premium                        # queue
+#BSUB -W 6:00                           # wallclock time
+#BSUB -P 64000400
+
+# QSUB -q ded_4             # submit to 4 proc
+# QSUB -l mpp_p=4           # request 4 processors
+# QSUB -lT  21600           # max. job time limit is 6 h
+# QSUB -lF 250Mw            # max. job file size limit is 250 Megawords
+# QSUB -eo                  # merge error and output into one file
+# QSUB -o  reg.out          # output file name
+# QSUB                      # there are no further QSUB commands
+
+#	This is a script to test the bit-for-bit reproducibility of
+#	the WRF model, when comparing single processor serial runs to
+#	OpenMP and MPI parallel runs.  There are several regression tests
+#	that are performed.  Failed comparisons get reported, but don't
+#	stop the script.  Failed builds or forecasts force an exit from 
+#	the script.
+
+#	Approximate time for completion of full test suite
+#		Compaq 733 MHz   ev67 :  2.5 hours (empty)
+#		Intel  1.2 GHz (4-pe) :  3.0 hours (empty)
+#		IBM            P4     :  2.0 hours (empty)
+
+#	These need to be changed for your particular set of runs.  This is
+#	where email gets sent.
+
+if ( ( `uname` == AIX ) && ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) ) then
+	set FAIL_MAIL = ( ${user}@noaa.gov )
+	set GOOD_MAIL = ( ${user}@noaa.gov )
+
+	setenv MP_EAGER_LIMIT 65536
+	setenv MP_SHARED_MEMORY yes
+	setenv MP_SINGLE_THREAD yes
+	setenv MP_LABELIO yes
+	setenv MP_STDOUTMODE ordered
+
+	setenv OMP_NUM_THREADS 4
+	setenv XLSMPOPTS "parthds=4:spins=0:yields=0:stack=128000000:schedule=static"
+	setenv AIXTHREAD_SCOPE S
+	setenv AIXTHREAD_MNRATIO 1:1
+	setenv SPINLOOPTIME 1000
+	setenv YIELDLOOPTIME 1000
+else
+	set FAIL_MAIL = ( ${user}@ucar.edu )
+	set GOOD_MAIL = ( ${user}@ucar.edu )
+endif
+
+unalias cd cp rm ls pushd popd mv
+if ( `uname` == Linux ) alias banner echo
+
+#	Get the command line input
+
+set thedate = -999
+set thefile = "null"
+set thedata = "null"
+set clrm = 0          # compile local run mmmtmp, for using clsroom cluster and local disk
+
+#	If this is a batch job (NCAR's IBMs or FSL's Intel and Alpha), we need to muck with the "input"
+#	parameters a bit.
+
+if      ( ( `uname` == AIX ) || ( `hostname` == tempest ) || ( `hostname | cut -c 1-2` == ln ) ) then
+	set argv = ( -here )
+	set argv = ( -ftp )
+        set argv = ( -D today )
+	set argv = ( -env )
+	set WRFREGFILE = /mmm/users/gill/wrf.tar
+	if ( ( `uname` == AIX ) && ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) ) then
+		set argv = ( -f /nbns/meso/wx22tb/regression_tests/wrf.tar )
+	else
+		set argv = ( -f wrf.tar )
+	endif
+else if ( ( `uname` == OSF1 ) && ( `hostname` == maple ) && ( $user == michalak ) ) then
+        set clrm=1
+endif
+
+#	Where is the input data located - for a few known NCAR/MMM machines.
+
+if      ( ( `hostname` == master ) || (`hostname | cut -c 1-4` == node ) ) then
+	set WRFREGDATAEM = /big/users/gill/WRF-data-EM
+	set WRFREGDATANMM = /big/users/gill/WRF-data-NMM
+else if   ( `hostname` == jacaranda ) then
+	set WRFREGDATAEM = /jacaranda/users/gill/WRF-data-EM
+	set WRFREGDATANMM = /jacaranda/users/gill/WRF-data-NMM
+else if   ( `hostname` == duku ) then
+	set WRFREGDATAEM = /duku/users/gill/WRF-data-EM
+	set WRFREGDATANMM = /duku/users/gill/WRF-data-NMM
+else if   ( `hostname` == cape ) then
+	set WRFREGDATAEM = /cape/users/michalak/WRF-data-EM
+	set WRFREGDATANMM = /cape/users/michalak/WRF-data-NMM
+else if ( (`hostname | cut -c 1-6` == joshua ) || \
+          ( `hostname` == maple ) || (`hostname | cut -c 1-7` == service ) ) then
+	set WRFREGDATAEM = /users/gill/WRF-data-EM
+	set WRFREGDATANMM = /users/gill/WRF-data-NMM
+else if ( ( `hostname | cut -c 1-2` == bs ) || ( `hostname` == tempest ) || ( `hostname | cut -c 1-2` == ln ) || \
+          ( `hostname | cut -c 1-2` == bv ) ) then
+	set WRFREGDATAEM = /mmm/users/gill/WRF-data-EM
+	set WRFREGDATANMM = /mmm/users/gill/WRF-data-NMM
+else if ( ( `uname` == AIX ) && ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) ) then
+	set WRFREGDATAEM = /nbns/meso/wx22tb/regression_tests/WRF-data-EM
+	set WRFREGDATANMM = /nbns/meso/wx22tb/regression_tests/WRF-data-NMM
+else
+	if      ( ( -d /users/gill/WRF-data-EM ) && ( -d /users/gill/WRF-data-NMM ) ) then
+		set WRFREGDATAEM = /users/gill/WRF-data-EM
+		set WRFREGDATANMM = /users/gill/WRF-data-NMM
+	else if ( ( -d /mmm/users/gill/WRF-data-EM ) && ( -d /mmm/users/gill/WRF-data-NMM ) ) then
+		set WRFREGDATAEM = /mmm/users/gill/WRF-data-EM
+		set WRFREGDATANMM = /mmm/users/gill/WRF-data-NMM
+	else
+		echo "stick the WRF em and nmm data somewhere, and then fill in the shell vars"
+		echo "inside this script, you NEED WRFREGDATAEM and WRFREGDATANMM set"
+		exit ( 1 ) 
+	endif
+endif
+#DAVE###################################################
+echo DAVE em data is located at $WRFREGDATAEM
+ls -ls $WRFREGDATAEM
+echo DAVE nmm data is located at $WRFREGDATANMM
+ls -ls $WRFREGDATANMM
+banner 1
+#set ans = "$<"
+#DAVE###################################################
+
+if ( $#argv == 0 ) then
+	echo "Please enter either a date for cvs checkout. ex regtest.csh -D date"
+	echo " or a file name containing WRF. ex regtest.csh -f tarfile"
+	echo " or the -ftp flag for the script to pick code off anon ftp"
+	exit ( 2 ) 
+endif
+
+set theargs = 0
+foreach a ( $argv )
+	if ( "$a" == "-D" ) then
+
+		rsh -n maple.mmm.ucar.edu w >& /dev/null
+		if ( $status ) then
+			echo "Cannot execute a remote shell on maple.mmm.ucar.edu, where the"
+			echo "WRF code resides."
+			echo "Please check that it is up and that you have permission to rsh"
+			echo "to this host. (Create a .rhosts file)."
+			ping -c 1 maple.mmm.ucar.edu
+			exit 2
+		endif
+		setenv CVSROOT maple.mmm.ucar.edu:/data3/mp/wrfhelp/WRF
+		
+		set acquire_from = "cvs"
+		set thedate = $argv[2]
+
+	endif
+
+	if ( "$a" == "-f" ) then
+
+		set thefile = $argv[2]
+		#	Check for absolute path, if not, make it absolute
+		echo $thefile | grep '^/' > /dev/null
+		if ( $status != 0 ) set thefile = `pwd`/$thefile
+		set acquire_from = "filearg"
+
+	endif
+
+	if ( "$a" == "-ftp" ) then
+		set acquire_from = "ftp"
+echo "anon ftp temporarily disabled"
+exit ( 3 )
+	endif
+
+	if ( "$a" == "-here" ) then
+		set acquire_from = "here"
+	endif
+
+	if ( "$a" == "-env" ) then
+		set acquire_from = "environment"
+		set thefile = $WRFREGFILE
+	endif
+end
+
+#	Start recording everything - for debug purposes.
+
+set echo 
+set date
+
+#	And to tell us how long we've spent on this whole regression test,
+#	we should remember when we started.
+
+set start = ( `date` )
+
+#####################################################################
+
+#	Initial set up values
+
+#	Is this a single domain regression test or is this nested.  Well, a nested one
+#	is a bit special.  It can only run on machines that have the WRF RSL-but-no-MPI
+#	option available.
+
+set NESTED = TRUE
+set NESTED = FALSE
+
+if ( ( $NESTED == TRUE ) && ( ( `uname` == OSF1 ) || ( `uname` == Linux ) || ( `uname` == AIX ) ) ) then
+	echo DOING a NESTED TEST
+else if ( $NESTED == TRUE ) then
+	echo NESTED option is only valid on DEC, Linux, or AIX machines
+	exit ( 1 ) 
+endif
+
+#	We can choose to do grid and obs nudging tests.
+
+set FDDA = TRUE
+set FDDA = FALSE
+
+#	The default floating point precision is either 4 bytes or 8 bytes.
+#	We assume that it is 4 (or the default for the architecture) unless 
+#	REAL8 is set to TRUE.
+
+set REAL8 = TRUE
+set REAL8 = FALSE
+
+#	Are we shooting for a bit-for-bit run (serial vs OpenMP, serial vs MPI), or not?
+#	If you want to do a performance-only run, the forecasts are still short, but you
+#	get to insure that the optimized code builds and runs.
+
+set REG_TYPE = OPTIMIZED
+set REG_TYPE = BIT4BIT
+
+#	For a Linux machine, we can use PGI or Intel compilers.
+
+if ( `uname` == Linux ) then
+	set LINUX_COMP = INTEL
+	set LINUX_COMP = PGI
+endif
+
+#	Intel requires /usr/local/intel-8.0/lib in LD_LIBRARY_PATH
+#	and it has to be in the .cshrc file for the rsh for mpirun
+#	intel 8.0 Apr 2005
+
+if ( `uname` == Linux ) then
+	if ( $LINUX_COMP == INTEL ) then
+	
+		grep LD_LIBRARY_PATH ~/.cshrc >& /dev/null
+		set ok1 = $status
+		echo $LD_LIBRARY_PATH | grep intel >& /dev/null
+		set ok2 = $status
+		if ( ( $ok1 != 0 ) || ( $ok2 != 0 ) ) then
+			echo You need to stick the following line in your .cshrc file
+			echo setenv LD_LIBRARY_PATH /usr/lib:/usr/local/lib:/usr/local/intel-8.0/lib
+			echo Otherwise mpirun cannot find libcxa.so.5 
+			exit ( 1 )
+		endif
+	endif
+endif
+
+#	Is this a WRF chem test?  
+
+if ( $NESTED != TRUE ) then
+	set CHEM = TRUE
+	set CHEM = FALSE
+else if ( $NESTED == TRUE ) then
+	set CHEM = FALSE
+endif
+if ( $CHEM == TRUE ) then
+	setenv WRF_CHEM 1
+else if ( $CHEM == FALSE ) then
+	setenv WRF_CHEM 0 
+endif
+
+#	For the real data case, we can run either one of two data cases.  If this is
+#	a chemistry run, we are forced to use that data.
+
+set dataset = jun01
+set dataset = jan00
+if ( $CHEM == TRUE ) then
+	set dataset = chem
+endif
+
+#	Yet another local variable to change the name of where the data is located.
+
+set thedataem = ${WRFREGDATAEM}/${dataset}
+set thedatanmm = $WRFREGDATANMM
+
+#	The distributed memory option RSL_LITE may be selected.
+
+set RSL_LITE = TRUE
+set RSL_LITE = FALSE
+
+set COMBO_NEST_RSL__LITE = TRUE
+set COMBO_NEST_RSL__LITE = FALSE
+
+if ( $COMBO_NEST_RSL__LITE == TRUE ) then
+	set NESTED = TRUE
+	set RSL_LITE = TRUE
+endif
+
+#	A separately installed version of the latest ESMF library (NOT the 
+#	ESMF library included in the WRF tarfile) can be tested by setting 
+#	"ESMF_LIB" to "TRUE" below.  This test is not supported on all 
+#	machines.  
+
+set ESMF_LIB = TRUE
+set ESMF_LIB = FALSE
+
+# serial and OMP are not tested with ESMF so always start with env vars cleared
+unsetenv ESMFLIB
+unsetenv ESMFINC
+
+if ( $ESMF_LIB == TRUE ) then
+	if ( ( `uname` == AIX ) && ( `hostname | cut -c 1-2` == bs ) ) then
+		echo "A separately installed version of the latest ESMF library"
+		echo "(NOT the ESMF library included in the WRF tarfile) will"
+		echo "be used for MPI tests"
+		setenv OBJECT_MODE 32
+		set ESMFLIBSAVE = /home/bluesky/hender/esmf/lib/libO/AIX.default.32.default
+		set ESMFINCSAVE = /home/bluesky/hender/esmf/mod/modO/AIX.default.32.default
+		echo "Setting ESMFLIB = ${ESMFLIBSAVE}"
+		echo "Setting ESMFINC = ${ESMFINCSAVE}"
+	else
+		echo "Only the ESMF library included in the WRF tarfile is"
+		echo "tested on this machine"
+		exit ( 3 ) 
+	endif
+	if ( $NESTED == TRUE ) then
+		echo "The ESMF library does not work with nesting."
+		exit ( 3 ) 
+	endif
+	if ( $RSL_LITE == TRUE ) then
+		echo "The ESMF library does not work with RSL_LITE."
+		exit ( 3 ) 
+	endif
+endif
+
+#	A single WRF output "quilt" server can be tested by setting "QUILT"  to 
+#       "TRUE" below.  At the moment, testing of I/O quilt servers is not supported 
+#       on all machines.  
+
+set QUILT = TRUE
+set QUILT = FALSE
+
+if ( $QUILT == TRUE ) then
+	if ( `uname` == AIX ) then
+		echo "One WRF output quilt server will be used for some tests"
+	else if ( ( `uname` == OSF1 ) && \
+		  ( ( `hostname` == duku    ) || \
+		    ( `hostname` == joshua1 ) || \
+		    ( `hostname` == joshua3 ) ) ) then
+		echo "One WRF output quilt server will be used for some tests"
+	else
+		echo "WRF output quilt servers are not tested on this machine"
+		exit ( 3 ) 
+	endif
+endif
+
+#	Baseline data sets can be generated and archived or compared against.  
+#       - To generate and archive, set GENERATE_BASELINE to a pathname that can 
+#         be created by this script via "mkdir -p $GENERATE_BASELINE".  This 
+#         directory must not already exist.  
+#         Set GENERATE_BASELINE = FALSE to avoid baseline generation.  
+#       - To compare with a previously archived baseline, set COMPARE_BASELINE 
+#         to an existing directory that contains an archived baseline.  
+#         Set COMPARE_BASELINE = FALSE to avoid baseline comparison.  
+set GENERATE_BASELINE = FALSE
+set COMPARE_BASELINE = FALSE
+
+#	Baseline generation and comparison are only done when BIT4BIT is set.  
+if ( $GENERATE_BASELINE != FALSE ) then
+	if ( $REG_TYPE != BIT4BIT ) then
+		echo "ERROR:  Baseline generation can only be done during BIT4BIT tests."
+		exit ( 3 ) 
+	endif
+	if ( -d $GENERATE_BASELINE ) then
+		echo "ERROR:  Baseline directory ${GENERATE_BASELINE} already exists."
+		exit ( 3 ) 
+	else
+		# Archive serial output file to baseline
+		mkdir -p $GENERATE_BASELINE || ( echo "ERROR:  cannot mkdir ${GENERATE_BASELINE}"; exit 3 )
+	endif
+endif
+if ( $COMPARE_BASELINE != FALSE ) then
+	if ( $REG_TYPE != BIT4BIT ) then
+		echo "Baseline comparison can only be done during BIT4BIT tests."
+		exit ( 3 ) 
+	endif
+	if ( ! -d $COMPARE_BASELINE ) then
+		echo "${0}: ERROR:  Baseline directory ${COMPARE_BASELINE} does not exist"
+		exit ( 3 ) 
+	endif
+endif
+
+#	Set the input/output format type (currently 1, 2 or 5 OK).
+#	Binary		NetCDF				PHDF, IBM	GriB, history only
+#	1		2		3		4		5
+
+set IO_FORM = 2
+set IO_FORM_NAME = ( io_bin io_netcdf io_dummy io_phdf5 io_grib1 )
+set IO_FORM_WHICH =( IO     IO        IO       IO       O        )
+
+#	There is a breakdown of cores to test depending on the various
+#	options that the user is testing.
+#	nested: cannot test NMM
+#	rsl_lite: cannot test anything with y periodic bc
+#	chem: em_real only
+#	esmf_lib: cannot test NMM
+#	grib output: cannot test NMM
+
+if      ( ( $NESTED == TRUE ) && ( $RSL_LITE != TRUE ) ) then
+	set CORES = ( em_real em_b_wave em_quarter_ss          )
+else if ( ( $NESTED == TRUE ) && ( $RSL_LITE == TRUE ) ) then
+	set CORES = ( em_real )
+else if ( ( $NESTED != TRUE ) && ( $RSL_LITE != TRUE ) ) then
+	set CORES = ( em_real em_b_wave em_quarter_ss nmm_real )
+	if ( $CHEM == TRUE ) then
+		set CORES = ( em_real em_real )
+	endif
+	if ( $ESMF_LIB == TRUE ) then
+		set CORES = ( em_real em_b_wave em_quarter_ss )
+	endif
+	if ( $IO_FORM_NAME[$IO_FORM] == io_grib1 ) then
+		set CORES = ( em_real em_b_wave em_quarter_ss )
+	endif
+	if ( $FDDA == TRUE ) then
+		set CORES = ( em_real )
+	endif
+else if ( ( $NESTED != TRUE ) && ( $RSL_LITE == TRUE ) ) then
+	set CORES = ( em_real em_quarter_ss nmm_real )
+	if ( $CHEM == TRUE ) then
+		set CORES = ( em_real em_real )
+	endif
+	if ( $ESMF_LIB == TRUE ) then
+		set CORES = ( em_real )
+	endif
+	if ( $IO_FORM_NAME[$IO_FORM] == io_grib1 ) then
+		set CORES = ( em_real )
+	endif
+	if ( $FDDA == TRUE ) then
+		set CORES = ( em_real )
+	endif
+endif
+
+#	The b_wave case has binary input (4-byte only), the nmm
+#	core has raw MPI calls, skip them if we are doing real*8 floats.
+#	Bump up the OMP stack size for real*8 on OSF1 architectures.
+
+if      ( $REAL8 == TRUE ) then
+	if ( `uname` == OSF1 ) then
+		setenv MP_STACK_SIZE 64000000
+	endif
+	set CORES = ( em_real em_quarter_ss )
+endif
+
+if      ( ( $CHEM != TRUE ) && ( $FDDA != TRUE ) && ( $NESTED != TRUE ) ) then
+	set PHYSOPTS =	( 1 2 3 4 )
+else if ( ( $CHEM != TRUE ) && ( $FDDA != TRUE ) && ( $NESTED == TRUE ) ) then
+	set PHYSOPTS =	( 1 2 3 )
+else if ( ( $CHEM != TRUE ) && ( $FDDA == TRUE ) ) then
+	set PHYSOPTS =	( 1 2 3 )
+else if ( $CHEM == TRUE ) then
+	set PHYSOPTS =	( 1 2 3 4 5 6 )
+endif
+
+#	This is selecting the ideal physics options - mostly selecting BC options.
+#	With no nesting, run all three ideal physics options.  When we have
+#	RSL_LITE (we are only doing em_quarter_ss), choose the first option only
+#	since it uses open boundaries.
+
+if      ( ( $NESTED == TRUE ) && ( $RSL_LITE != TRUE ) ) then
+	set Max_Ideal_Physics_Options = 2
+else if   ( $RSL_LITE == TRUE )                          then
+	set Max_Ideal_Physics_Options = 1
+else if ( ( $NESTED != TRUE ) && ( $RSL_LITE != TRUE ) ) then
+	set Max_Ideal_Physics_Options = 3
+endif
+
+set CUR_DIR = `pwd`
+
+#	How many domains to run (nest tests).  Only em_real and ideals use this.
+#	The max is 3 due to the number of columns in the namelist that are 
+#	currently filled in.
+
+if      ( $NESTED == TRUE ) then
+if      ( $dataset == jan00 ) then
+cat >! dom_real << EOF
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 2,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    31,    31,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    31,    31,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ dx                                  = 30000, 10000,  3333.333333,
+ dy                                  = 30000, 10000,  3333.333333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    11,
+ j_parent_start                      = 0,     17,    11,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ num_moves                           = 3
+ move_id                             = 2 , 2 , 2
+ move_interval                       = 3 , 6 , 9
+ move_cd_x                           = 1 , 1 , 1
+ move_cd_y                           = 1 , 1 , 1
+EOF
+else if ( $dataset == jun01 ) then
+cat >! dom_real << EOF
+ time_step                           = 60,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 2,
+ s_we                                = 1,     1,     1,
+ e_we                                = 91,    31,    31,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 82,    31,    31,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ dx                                  = 10000,  3333.333333,  1111.111111,
+ dy                                  = 10000,  3333.333333,  1111.111111,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     30,    11,
+ j_parent_start                      = 0,     20,    11,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+ num_moves                           = 3
+ move_id                             = 2 , 2 , 2
+ move_interval                       = 1 , 2 , 3
+ move_cd_x                           = 1 , 1 , 1
+ move_cd_y                           = 1 , 1 , 1
+EOF
+endif
+cat >! dom_ideal << EOF
+ max_dom                             = 2,
+EOF
+else if ( $NESTED != TRUE ) then
+if      ( $dataset == jan00 ) then
+cat >! dom_real << EOF
+ time_step                           = 180,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 74,    31,    31,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 61,    31,    31,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ dx                                  = 30000, 10000,  3333,
+ dy                                  = 30000, 10000,  3333,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     31,    30,
+ j_parent_start                      = 0,     17,    30,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+EOF
+else if ( $dataset == jun01 ) then
+cat >! dom_real << EOF
+ time_step                           = 60,
+ time_step_fract_num                 = 0,
+ time_step_fract_den                 = 1,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 91,    31,    31,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 82,    31,    31,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 28,    28,    28,
+ dx                                  = 10000,  3333.333333,  1111.111111,
+ dy                                  = 10000,  3333.333333,  1111.111111,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     30,    11,
+ j_parent_start                      = 0,     20,    11,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 1,
+ smooth_option                       = 0
+EOF
+endif
+cat >! dom_ideal << EOF
+ max_dom                             = 1,
+EOF
+endif
+
+#	The em_real entire physics namelist.  Change what you want.
+
+cat >! phys_real_1  << EOF
+ mp_physics                          = 3,     3,     3,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 1,     1,     1,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 1,     1,     1,
+ sf_surface_physics                  = 1,     1,     1,
+ bl_pbl_physics                      = 1,     1,     1,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 1,     1,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 5,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+EOF
+
+cat >! dyn_real_SAFE  << EOF
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+EOF
+
+cat >! dyn_real_1  << EOF
+ pd_moist                            = .true.,  .true.,  .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+EOF
+
+cat >! time_real_1  << EOF
+ auxinput1_inname                    = "met_em.d<domain>.<date>"
+EOF
+
+cat >! phys_real_2 << EOF
+ mp_physics                          = 4,     4,     4,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 2,     2,     2,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 2,     2,     2,
+ sf_surface_physics                  = 2,     2,     2,
+ bl_pbl_physics                      = 2,     2,     2,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 2,     2,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 4,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+EOF
+
+cat >! dyn_real_2  << EOF
+ pd_moist                            = .true.,  .true.,  .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+EOF
+
+cat >! time_real_2  << EOF
+ auxinput1_inname                    = "wrf_real_input_em.d<domain>.<date>"
+EOF
+
+cat >! phys_real_3 << EOF
+ mp_physics                          = 5,     5,     5,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 2,     2,     2,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 2,     2,     2,
+ sf_surface_physics                  = 3,     3,     3,
+ bl_pbl_physics                      = 2,     2,     2,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 3,     3,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 6,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+EOF
+
+cat >! dyn_real_3  << EOF
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+EOF
+
+cat >! time_real_3  << EOF
+ auxinput1_inname                    = "met_em.d<domain>.<date>"
+EOF
+
+cat >! phys_real_4 << EOF
+ mp_physics                          = 4,     4,     4,
+ ra_lw_physics                       = 1,     1,     1,
+ ra_sw_physics                       = 2,     2,     2,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 2,     2,     2,
+ sf_surface_physics                  = 2,     2,     2,
+ bl_pbl_physics                      = 2,     2,     2,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 2,     2,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ ucmcall                             = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 4,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+EOF
+
+cat >! dyn_real_4  << EOF
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+EOF
+
+cat >! time_real_4  << EOF
+ auxinput1_inname                    = "wrf_real_input_em.d<domain>.<date>"
+EOF
+
+cat >! phys_real_5 << EOF
+ mp_physics                          = 4,     4,     4,
+ ra_lw_physics                       = 3,     3,     3,
+ ra_sw_physics                       = 3,     3,     3,
+ radt                                = 30,    30,    30,
+ sf_sfclay_physics                   = 2,     2,     2,
+ sf_surface_physics                  = 2,     2,     2,
+ bl_pbl_physics                      = 2,     2,     2,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 2,     2,     0,
+ cudt                                = 5,     5,     5,
+ isfflx                              = 1,
+ ifsnow                              = 0,
+ icloud                              = 1,
+ ucmcall                             = 1,
+ surface_input_source                = 1,
+ num_soil_layers                     = 4,
+ mp_zero_out                         = 0,
+ maxiens                             = 1,
+ maxens                              = 3,
+ maxens2                             = 3,
+ maxens3                             = 16,
+ ensdim                              = 144,
+ levsiz                              = 59
+ paerlev                             = 29
+ cam_abs_freq_s                      = 21600
+ cam_abs_dim1                        = 4
+ cam_abs_dim2                        = 28
+EOF
+
+cat >! dyn_real_5  << EOF
+ pd_moist                            = .false., .false., .false.,
+ pd_scalar                           = .false., .false., .false.,
+ pd_chem                             = .false., .false., .false.,
+ pd_tke                              = .false., .false., .false.,
+EOF
+
+cat >! time_real_5  << EOF
+ auxinput1_inname                    = "met_em.d<domain>.<date>"
+EOF
+
+cat >! fdda_real_1 << EOF
+ grid_fdda                           = 1,     1,     1,
+ gfdda_inname                        = "wrffdda_d<domain>",
+ gfdda_end_h                         = 24,    24,    24,
+ gfdda_interval_m                    = 360,   360,   360,
+ fgdt                                = 0,     0,     0,
+ if_no_pbl_nudging_uv                = 0,     0,     1,
+ if_no_pbl_nudging_t                 = 0,     0,     1,
+ if_no_pbl_nudging_q                 = 0,     0,     1,
+ if_zfac_uv                          = 0,     0,     1,
+  k_zfac_uv                          = 10,   10,     1,
+ if_zfac_t                           = 0,     0,     1,
+  k_zfac_t                           = 10,   10,     1,
+ if_zfac_q                           = 0,     0,     1,
+  k_zfac_q                           = 10,   10,     1,
+ guv                                 = 0.0003,     0.0003,     0.0003,
+ gt                                  = 0.0003,     0.0003,     0.0003,
+ gq                                  = 0.0003,     0.0003,     0.0003,
+ if_ramping                          = 1,
+ dtramp_min                          = 360.0,
+ io_form_gfdda                       = 2,
+EOF
+
+cat >! fdda_real_time_1 << EOF
+EOF
+
+cat >! fdda_real_2 << EOF
+ obs_nudge_opt                       = 1,1,1,1,1
+ max_obs                             = 150000,
+ nobs_ndg_vars                       = 5,
+ nobs_err_flds                       = 9,
+ obs_nudge_wind                      = 1,1,1,1,1
+ obs_coef_wind                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_nudge_temp                      = 1,1,1,1,1
+ obs_coef_temp                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_nudge_mois                      = 1,1,1,1,1
+ obs_coef_mois                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_rinxy                           = 240.,240.,180.,180,180
+ obs_rinsig                          = 0.1,
+ obs_twindo                          = 40.
+ obs_npfi                            = 10,
+ obs_ionf                            = 2,
+ obs_idynin                          = 0,
+ obs_dtramp                          = 40.,
+ obs_ipf_errob                       = .true.
+ obs_ipf_nudob                       = .true.
+ obs_ipf_in4dob                      = .true.
+EOF
+
+cat >! fdda_real_time_2 << EOF
+ auxinput11_interval_s               = 180
+ auxinput11_end_h                    = 6
+EOF
+
+cat >! fdda_real_3 << EOF
+ grid_fdda                           = 1,     1,     1,
+ gfdda_inname                        = "wrffdda_d<domain>",
+ gfdda_end_h                         = 24,    24,    24,
+ gfdda_interval_m                    = 360,   360,   360,
+ fgdt                                = 0,     0,     0,
+ if_no_pbl_nudging_uv                = 0,     0,     1,
+ if_no_pbl_nudging_t                 = 0,     0,     1,
+ if_no_pbl_nudging_q                 = 0,     0,     1,
+ if_zfac_uv                          = 0,     0,     1,
+  k_zfac_uv                          = 10,   10,     1,
+ if_zfac_t                           = 0,     0,     1,
+  k_zfac_t                           = 10,   10,     1,
+ if_zfac_q                           = 0,     0,     1,
+  k_zfac_q                           = 10,   10,     1,
+ guv                                 = 0.0003,     0.0003,     0.0003,
+ gt                                  = 0.0003,     0.0003,     0.0003,
+ gq                                  = 0.0003,     0.0003,     0.0003,
+ if_ramping                          = 1,
+ dtramp_min                          = 360.0,
+ io_form_gfdda                       = 2,
+ obs_nudge_opt                       = 1,1,1,1,1
+ max_obs                             = 150000,
+ nobs_ndg_vars                       = 5,
+ nobs_err_flds                       = 9,
+ obs_nudge_wind                      = 1,1,1,1,1
+ obs_coef_wind                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_nudge_temp                      = 1,1,1,1,1
+ obs_coef_temp                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_nudge_mois                      = 1,1,1,1,1
+ obs_coef_mois                       = 6.E-4,6.E-4,6.E-4,6.E-4,6.E-4
+ obs_rinxy                           = 240.,240.,180.,180,180
+ obs_rinsig                          = 0.1,
+ obs_twindo                          = 40.
+ obs_npfi                            = 10,
+ obs_ionf                            = 2,
+ obs_idynin                          = 0,
+ obs_dtramp                          = 40.,
+ obs_ipf_errob                       = .true.
+ obs_ipf_nudob                       = .true.
+ obs_ipf_in4dob                      = .true.
+EOF
+
+cat >! fdda_real_time_3 << EOF
+ auxinput11_interval_s               = 180
+ auxinput11_end_h                    = 6
+EOF
+
+#	Tested options for ideal case em_b_wave.  Modifying these
+#	parameters is acceptable.  Adding to these requires changes
+#	to the ideal namelist build below.
+
+cat >! phys_b_wave_1a << EOF
+ diff_opt                            = 1,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+EOF
+cat >! phys_b_wave_1b << EOF
+ mp_physics                          = 1,     1,     1,
+EOF
+cat >! phys_b_wave_1c << EOF
+ non_hydrostatic                     = .true., .true., .true.,
+EOF
+
+cat >! phys_b_wave_2a << EOF
+ diff_opt                            = 1,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+EOF
+cat >! phys_b_wave_2b << EOF
+ mp_physics                          = 1,     1,     1,
+EOF
+cat >! phys_b_wave_2c << EOF
+ non_hydrostatic                     = .false., .false., .false.,
+EOF
+
+cat >! phys_b_wave_3a << EOF
+ diff_opt                            = 1,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+EOF
+cat >! phys_b_wave_3b << EOF
+ mp_physics                          = 2,     2,     2,
+EOF
+cat >! phys_b_wave_3c << EOF
+ non_hydrostatic                     = .false., .false., .false.,
+EOF
+
+#	Tested options for ideal case em_quarter_ss.  Modifying these
+#	parameters is acceptable.  Adding to these requires changes
+#	to the ideal namelist build below.
+
+cat >! phys_quarter_ss_1a << EOF
+ diff_opt                            = 1,
+ km_opt                              = 1,
+ damp_opt                            = 0,
+EOF
+cat >! phys_quarter_ss_1b << EOF
+ mp_physics                          = 1,     1,     1,
+EOF
+cat >! phys_quarter_ss_1c << EOF
+ non_hydrostatic                     = .true., .true., .true.,
+EOF
+cat >! phys_quarter_ss_1d << EOF
+ periodic_x                          = .false.,.false.,.false.,
+ open_xs                             = .true., .false.,.false.,
+ open_xe                             = .true., .false.,.false.,
+ periodic_y                          = .false.,.false.,.false.,
+ open_ys                             = .true., .false.,.false.,
+ open_ye                             = .true., .false.,.false.,
+EOF
+
+cat >! phys_quarter_ss_2a << EOF
+ diff_opt                            = 2,
+ km_opt                              = 2,
+ damp_opt                            = 1,
+EOF
+cat >! phys_quarter_ss_2b << EOF
+ mp_physics                          = 1,     1,     1,
+EOF
+cat >! phys_quarter_ss_2c << EOF
+ non_hydrostatic                     = .true., .true., .true.,
+EOF
+cat >! phys_quarter_ss_2d << EOF
+ periodic_x                          = .true., .false.,.false.,
+ open_xs                             = .false.,.false.,.false.,
+ open_xe                             = .false.,.false.,.false.,
+ periodic_y                          = .true., .false.,.false.,
+ open_ys                             = .false.,.false.,.false.,
+ open_ye                             = .false.,.false.,.false.,
+EOF
+
+cat >! phys_quarter_ss_3a << EOF
+ diff_opt                            = 2,
+ km_opt                              = 3,
+ damp_opt                            = 1,
+EOF
+cat >! phys_quarter_ss_3b << EOF
+ mp_physics                          = 2,     2,     2,
+EOF
+cat >! phys_quarter_ss_3c << EOF
+ non_hydrostatic                     = .false., .false., .false.,
+EOF
+cat >! phys_quarter_ss_3d << EOF
+ periodic_x                          = .true., .false.,.false.,
+ open_xs                             = .false.,.false.,.false.,
+ open_xe                             = .false.,.false.,.false.,
+ periodic_y                          = .true., .false.,.false.,
+ open_ys                             = .false.,.false.,.false.,
+ open_ye                             = .false.,.false.,.false.,
+EOF
+
+if      ( $IO_FORM_WHICH[$IO_FORM] == IO ) then
+cat >! io_format << EOF
+ io_form_history                     = $IO_FORM
+ io_form_restart                     = $IO_FORM
+ io_form_input                       = $IO_FORM
+ io_form_boundary                    = $IO_FORM
+EOF
+else if ( $IO_FORM_WHICH[$IO_FORM] == I  ) then
+cat >! io_format << EOF
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = $IO_FORM
+ io_form_boundary                    = $IO_FORM
+EOF
+else if ( $IO_FORM_WHICH[$IO_FORM] ==  O ) then
+cat >! io_format << EOF
+ io_form_history                     = $IO_FORM
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+EOF
+endif
+
+
+if ( $dataset == jun01 ) then
+	set filetag_real=2001-06-11_12:00:00
+else if ( $dataset == jan00 ) then
+	set filetag_real=2000-01-24_12:00:00
+else if ( $dataset == chem ) then
+	set filetag_real = ( 2006-04-06_00:00:00  2006-04-06_12:00:00 )
+endif
+
+set filetag_ideal=0001-01-01_00:00:00
+#DAVE###################################################
+echo did phys, set date to $filetag_real
+banner 2
+#set ans = "$<"
+#DAVE###################################################
+
+#####################################################################
+
+#	Set up info for particular architectures
+
+set ARCH = ( `uname` )
+
+set ZAP_SERIAL          = FALSE
+set ZAP_OPENMP          = FALSE
+set SERIALRUNCOMMAND	= 
+set OMPRUNCOMMAND	= 
+set MPIRUNCOMMANDPOST   = 
+
+touch version_info
+if ( $ARCH[1] == AIX ) then
+	set DEF_DIR             = $home
+	set TMPDIR              = /ptmp/$user
+	# keep stuff out of $HOME and /ptmp/$USER
+	# this allows multiple regressions tests to run simultaneously
+	# extend this to other machines later
+	if      ( ( `hostname | cut -c 1-2` == bs ) && ( ! $?LOADL_JOB_NAME ) ) then
+		echo "${0}: ERROR::  This batch script must be submitted via"
+		echo "${0}:          LoadLeveler on an AIX machine\!"
+		exit
+	else if   ( `hostname | cut -c 1-2` == bs ) then
+		set job_id              = `echo ${LOADL_JOB_NAME} | cut -f2 -d'.'`
+		set DEF_DIR             = /ptmp/$user/wrf_regression.${job_id}
+		set TMPDIR              = $DEF_DIR
+		if ( -d $DEF_DIR ) then
+			echo "${0}: ERROR::  Directory ${DEF_DIR} exists, please remove it"
+			exit ( 1 ) 
+		else
+			mkdir -p $DEF_DIR
+			echo "See ${DEF_DIR}/wrftest.output and other files in ${DEF_DIR} for test results"
+		endif
+		set CUR_DIR = ${LOADL_STEP_INITDIR}
+	else if   ( `hostname | cut -c 1-2` == bv ) then
+		set job_id              = $LSB_JOBID
+		set DEF_DIR             = /ptmp/$user/wrf_regression.${job_id}
+		set TMPDIR              = $DEF_DIR
+		if ( -d $DEF_DIR ) then
+			echo "${0}: ERROR::  Directory ${DEF_DIR} exists, please remove it"
+			exit ( 1 ) 
+		else
+			mkdir -p $DEF_DIR
+			echo "See ${DEF_DIR}/wrftest.output and other files in ${DEF_DIR} for test results"
+		endif
+	else if ( ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) && ( ! $?LOADL_JOB_NAME ) ) then
+		echo "${0}: ERROR::  This batch script must be submitted via"
+		echo "${0}:          LoadLeveler on an AIX machine\!"
+		exit
+	else if   ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) then
+		set job_id              = `echo ${LOADL_JOB_NAME} | cut -f2 -d'.'`
+		set DEF_DIR             = /ptmp/$user/wrf_regression.${job_id}
+		set TMPDIR              = $DEF_DIR
+		if ( -d $DEF_DIR ) then
+			echo "${0}: ERROR::  Directory ${DEF_DIR} exists, please remove it"
+			exit ( 1 ) 
+		else
+			mkdir -p $DEF_DIR
+			echo "See ${DEF_DIR}/wrftest.output and other files in ${DEF_DIR} for test results"
+		endif
+		set CUR_DIR = ${LOADL_STEP_INITDIR}
+	endif
+	if ( ! -d $TMPDIR ) mkdir $TMPDIR
+	set MAIL                = /usr/bin/mailx
+	if      ( ( $NESTED == TRUE ) && ( $RSL_LITE != TRUE ) ) then
+		set COMPOPTS	= ( 9 10 4 )
+	else if ( ( $NESTED != TRUE ) && ( $RSL_LITE != TRUE ) ) then
+		set COMPOPTS    = ( 1 2 4 )
+	else if ( ( $NESTED == TRUE ) && ( $RSL_LITE == TRUE ) ) then
+		set COMPOPTS	= ( 9 10 3 )
+	else if ( ( $NESTED != TRUE ) && ( $RSL_LITE == TRUE ) ) then
+		set COMPOPTS	= ( 1 2 3 )
+	endif
+	set Num_Procs		= 4
+	set OPENMP 		= $Num_Procs
+        setenv MP_PROCS  $Num_Procs
+        setenv MP_RMPOOL 1
+	if      ( `hostname | cut -c 1-2` == bs ) then
+		set MPIRUNCOMMAND       =  poe 
+	else if ( `hostname | cut -c 1-2` == bv ) then
+		set MPIRUNCOMMAND       =  mpirun.lsf
+	else if ( ( `hostname | cut -c 1-2` != bs ) && ( `hostname | cut -c 1-2` != bv ) ) then
+		set MPIRUNCOMMAND       =  poe
+	endif
+	if ( $CHEM == TRUE ) then
+		set ZAP_OPENMP		= TRUE
+	else if ( $CHEM == FALSE ) then
+		set ZAP_OPENMP		= FALSE
+	endif
+# check compiler version, JM
+        lslpp -i | grep xlf | grep ' xlfcmp ' | head -1
+        set xlfvers=`lslpp -i | grep xlf | grep ' xlfcmp ' | head -1 | awk '{print $2}' | sed 's/\...*$//'`
+        if ( $xlfvers < 10 ) then
+		set ZAP_OPENMP		= TRUE
+        endif
+# end of compiler check, JM
+	echo "Compiler version info: " >! version_info
+	echo "FORTRAN:        " `lslpp -l | grep xlfrte | head -1 | awk '{print $1 "   " $2}'` >>! version_info
+	echo " " >>! version_info
+	echo "OS version info: " >>! version_info
+	echo "AIX:            " `lslpp -l | grep bos.mp | head -1 | awk '{print $1 "   " $2}'` >>! version_info
+	echo " " >>! version_info
+	setenv MP_SHARED_MEMORY yes
+else if ( $ARCH[1] == OSF1 && $clrm == 0 ) then
+	if      ( ( `hostname` == duku )                && ( -d /data1/$user ) ) then
+		set DEF_DIR	= /data1/$user
+	else if ( ( `hostname | cut -c 1-6` == joshua ) && ( -d /data3/mp/$user ) ) then
+		set DEF_DIR	= /data3/mp/${user}/`hostname`
+		if ( ! -d $DEF_DIR ) mkdir $DEF_DIR
+	else if ( ( `hostname | cut -c 1-6` == joshua ) && ( -d /data6a/md/$user ) ) then
+		set DEF_DIR	= /data6a/md/${user}/`hostname`
+		if ( ! -d $DEF_DIR ) mkdir $DEF_DIR
+	else 
+		set DEF_DIR	= /mmmtmp/${user}/`hostname`
+		if ( ! -d $DEF_DIR ) mkdir $DEF_DIR
+	endif
+	set TMPDIR              = .
+	set MAIL		= /usr/bin/mailx
+	if      ( ( $NESTED == TRUE ) && ( $RSL_LITE != TRUE ) ) then
+		set COMPOPTS	= ( 2 4 6 )
+	else if ( ( $NESTED != TRUE ) && ( $RSL_LITE != TRUE ) ) then
+		set COMPOPTS    = ( 1 3 6 )
+	else if ( ( $NESTED == TRUE ) && ( $RSL_LITE == TRUE ) ) then
+		set COMPOPTS	= ( 2 4 11 )
+	else if ( ( $NESTED != TRUE ) && ( $RSL_LITE == TRUE ) ) then
+		set COMPOPTS	= ( 1 3 5 )
+	endif
+	set Num_Procs		= 4
+	set OPENMP 		= $Num_Procs
+	cat >! `pwd`/machfile << EOF
+`hostname`
+`hostname`
+`hostname`
+`hostname`
+EOF
+        set Mach = `pwd`/machfile
+	set SERIALRUNCOMMAND	= 
+	set OMPRUNCOMMAND	= 
+	set MPIRUNCOMMAND 	= ( /usr/local/mpich/bin/mpirun -np $Num_Procs -machinefile $Mach )
+	if ( $CHEM == TRUE ) then
+		set ZAP_OPENMP		= TRUE
+	else if ( $CHEM == FALSE ) then
+		set ZAP_OPENMP		= FALSE
+	endif
+	echo "Compiler version info: " >! version_info
+	f90 -version >>&! version_info
+	echo " " >>! version_info
+	echo "OS version info: " >>! version_info
+	uname -a >>&! version_info
+	echo " " >>! version_info
+else if ( $ARCH[1] == OSF1 && $clrm == 1 ) then
+	set DEF_DIR		= /`hostname | cut -d. -f1`/$user
+	set TMPDIR		= /mmmtmp/$user
+	set MAIL		= /usr/bin/mailx
+	if      ( ( $NESTED == TRUE ) && ( $RSL_LITE != TRUE ) ) then
+		set COMPOPTS	= ( 2 4 6 )
+	else if ( ( $NESTED != TRUE ) && ( $RSL_LITE != TRUE ) ) then
+		set COMPOPTS    = ( 1 3 6 )
+	else if ( ( $NESTED == TRUE ) && ( $RSL_LITE == TRUE ) ) then
+		set COMPOPTS	= ( 2 4 5 )
+	else if ( ( $NESTED != TRUE ) && ( $RSL_LITE == TRUE ) ) then
+		set COMPOPTS	= ( 1 3 5 )
+	endif
+	set Num_Procs		= 4
+	set OPENMP 		= 0
+	set ZAP_OPENMP		= TRUE
+	cat >! $TMPDIR/machfile << EOF
+service03
+service04
+service05
+service06
+EOF
+        set Mach = $TMPDIR/machfile
+	set MPIRUNCOMMAND 	= ( mpirun -np $Num_Procs -machinefile $Mach )
+	echo "Compiler version info: " >! version_info
+	f90 -version >>&! version_info
+	echo " " >>! version_info
+	echo "OS version info: " >>! version_info
+	uname -a >>&! version_info
+	echo " " >>! version_info
+else if ( ( $ARCH[1] == Linux ) && ( `hostname` == bay-mmm ) ) then
+	set DEF_DIR	= /data3/mp/${user}/`hostname`
+	if ( ! -d $DEF_DIR ) mkdir $DEF_DIR
+	set TMPDIR		= .
+	set MAIL		= /bin/mail
+	if      ( $LINUX_COMP == PGI ) then
+		if      ( ( $NESTED == TRUE ) && ( $RSL_LITE != TRUE ) ) then
+			set COMPOPTS	= ( 2 4 5 )
+		else if ( ( $NESTED != TRUE ) && ( $RSL_LITE != TRUE ) ) then
+			set COMPOPTS    = ( 1 3 5 )
+		else if ( ( $NESTED == TRUE ) && ( $RSL_LITE == TRUE ) ) then
+			set COMPOPTS	= ( 2 4 6 )
+		else if ( ( $NESTED != TRUE ) && ( $RSL_LITE == TRUE ) ) then
+			set COMPOPTS	= ( 1 3 6 )
+		endif
+	else if ( $LINUX_COMP == INTEL ) then
+		if        ( $NESTED == TRUE )                            then
+			set COMPOPTS	= ( 8 10 11 )
+		else if   ( $NESTED != TRUE )                            then
+			set COMPOPTS	= ( 7  9 11 )
+		endif
+	endif
+	set Num_Procs		= 2
+	set OPENMP		= $Num_Procs
+	cat >! machfile << EOF
+`hostname`
+`hostname`
+`hostname`
+`hostname`
+EOF
+	set Mach		= `pwd`/machfile
+	if ( $CHEM == TRUE ) then
+		set ZAP_OPENMP		= TRUE
+	else if ( $CHEM == FALSE ) then
+		set ZAP_OPENMP		= FALSE
+	endif
+	if ( $LINUX_COMP == INTEL ) then
+		set ZAP_OPENMP		= TRUE
+	endif
+	set MPIRUNCOMMAND       = ( mpirun -np $Num_Procs -machinefile $Mach )
+	echo "Compiler version info: " >! version_info
+	if      ( $LINUX_COMP == PGI ) then
+		pgf90 -V >>&! version_info
+	else if ( $LINUX_COMP == INTEL ) then
+		ifort -v >>&! version_info
+	endif
+	echo " " >>! version_info
+	echo "OS version info: " >>! version_info
+	uname -a >>&! version_info
+	echo " " >>! version_info
+else if ( ( $ARCH[1] == Linux ) && ( `hostname | cut -c 1-2` ==  ln ) ) then
+	set DEF_DIR	= /ptmp/${user}/wrf_regtest
+	if ( ! -d $DEF_DIR ) mkdir $DEF_DIR
+	set TMPDIR		= .
+	set MAIL		= /bin/mail
+	if      ( $LINUX_COMP == PGI ) then
+		if      ( ( $NESTED == TRUE ) && ( $RSL_LITE != TRUE ) ) then
+			set COMPOPTS    = ( 4 2 3 )
+		else if ( ( $NESTED != TRUE ) && ( $RSL_LITE != TRUE ) ) then
+			set COMPOPTS    = ( 1 2 3 )
+		endif
+	endif
+	set Num_Procs		= 4
+	set OPENMP		= 2
+	cat >! machfile << EOF
+`hostname`
+`hostname`
+`hostname`
+`hostname`
+EOF
+	set Mach		= `pwd`/machfile
+	set ZAP_OPENMP		= TRUE
+	set MPIRUNCOMMAND       =  mpirun.lsf
+	echo "Compiler version info: " >! version_info
+	if      ( $LINUX_COMP == PGI ) then
+		pgf90 -V >>&! version_info
+	else if ( $LINUX_COMP == INTEL ) then
+		ifort -v >>&! version_info
+	endif
+	echo " " >>! version_info
+	echo "OS version info: " >>! version_info
+	uname -a >>&! version_info
+	echo " " >>! version_info
+else if ( ( $ARCH[1] == Linux ) && ( `hostname` == loquat ) ) then
+	set job_id              = $$
+	set DEF_DIR             = /loquat2/$user/wrf_regression.${job_id}
+	set TMPDIR              = $DEF_DIR
+	if ( -d $DEF_DIR ) then
+		echo "${0}: ERROR::  Directory ${DEF_DIR} exists, please remove it"
+		exit ( 1 ) 
+	else
+		mkdir -p $DEF_DIR
+		echo "See directory ${DEF_DIR}/ for wrftest.output and other test results"
+	endif
+	set MAIL		= /bin/mail
+	if      ( $LINUX_COMP == PGI ) then
+		if      ( ( $NESTED == TRUE ) && ( $RSL_LITE != TRUE ) ) then
+			set COMPOPTS	= ( 2 4 5 )
+		else if ( ( $NESTED != TRUE ) && ( $RSL_LITE != TRUE ) ) then
+			set COMPOPTS    = ( 1 3 5 )
+		else if ( ( $NESTED == TRUE ) && ( $RSL_LITE == TRUE ) ) then
+			set COMPOPTS	= ( 2 4 6 )
+		else if ( ( $NESTED != TRUE ) && ( $RSL_LITE == TRUE ) ) then
+			set COMPOPTS	= ( 1 3 6 )
+		endif
+	else if ( $LINUX_COMP == INTEL ) then
+		if        ( $NESTED == TRUE )                            then
+			set COMPOPTS	= ( 8 10 11 )
+		else if   ( $NESTED != TRUE )                            then
+			set COMPOPTS	= ( 7  9 11 )
+		endif
+	endif
+	set Num_Procs		= 2
+	set OPENMP		= $Num_Procs
+	cat >! machfile << EOF
+`hostname`
+`hostname`
+`hostname`
+`hostname`
+EOF
+	set Mach		= `pwd`/machfile
+	if ( $CHEM == TRUE ) then
+		set ZAP_OPENMP		= TRUE
+	else if ( $CHEM == FALSE ) then
+		set ZAP_OPENMP		= FALSE
+	endif
+	if ( $LINUX_COMP == INTEL ) then
+		set ZAP_OPENMP		= TRUE
+	endif
+	set MPIRUNCOMMAND       = ( mpirun -np $Num_Procs -machinefile $Mach )
+	echo "Compiler version info: " >! version_info
+	if      ( $LINUX_COMP == PGI ) then
+		pgf90 -V >>&! version_info
+	else if ( $LINUX_COMP == INTEL ) then
+		ifort -v >>&! version_info
+	endif
+	echo " " >>! version_info
+	echo "OS version info: " >>! version_info
+	uname -a >>&! version_info
+	echo " " >>! version_info
+else if ( `hostname` == tempest ) then
+	set DEF_DIR	= /ptmp/${user}/wrf_regtest.${QSUB_REQID}
+	if ( ! -d $DEF_DIR ) mkdir $DEF_DIR
+	set TMPDIR		= .
+	set MAIL		= /usr/sbin/Mail
+	set COMPOPTS		= ( 1 2 3 )
+	set Num_Procs		= 2
+	set OPENMP		= $Num_Procs
+	set Mach		= `pwd`/machfile
+	set ZAP_OPENMP		= TRUE
+	set MPIRUNCOMMAND       = ( mpirun -np $Num_Procs )
+	echo "Compiler version info: " >! version_info
+	f90 -version >>&! version_info
+	echo " " >>! version_info
+	echo "OS version info: " >>! version_info
+	uname -a >>&! version_info
+	echo " " >>! version_info
+else if ( ( $ARCH[1] == Linux ) && ( `hostname` == master ) ) then
+	set DEF_DIR		= /big6/gill/DO_NOT_REMOVE_DIR
+	set TMPDIR		= .
+	set MAIL		= /bin/mail
+	if      ( $LINUX_COMP == PGI ) then
+		if        ( $NESTED == TRUE )                            then
+			set COMPOPTS	= ( 2 4 5 )
+		else if ( ( $NESTED != TRUE ) && ( $RSL_LITE == TRUE ) ) then
+			set COMPOPTS	= ( 1 3 6 )
+		else if ( ( $NESTED != TRUE ) && ( $RSL_LITE != TRUE ) ) then
+			set COMPOPTS	= ( 1 3 5 )
+		endif
+	else if ( $LINUX_COMP == INTEL ) then
+		if        ( $NESTED == TRUE )                            then
+			set COMPOPTS	= ( 8 10 11 )
+		else if   ( $NESTED != TRUE )                            then
+			set COMPOPTS	= ( 7  9 11 )
+		endif
+	endif
+	set Num_Procs		= 4
+	set OPENMP		= 2
+	cat >! machfile << EOF
+node3
+node3
+node4
+node4
+EOF
+	set Mach		= `pwd`/machfile
+	if ( $CHEM == TRUE ) then
+		set ZAP_OPENMP		= TRUE
+	else if ( $CHEM == FALSE ) then
+		set ZAP_OPENMP		= FALSE
+	endif
+	if ( $LINUX_COMP == INTEL ) then
+		set ZAP_OPENMP		= TRUE
+	endif
+	set MPIRUNCOMMAND       = ( mpirun -v -np $Num_Procs -machinefile $Mach -nolocal )
+	set MPIRUNCOMMANDPOST   = "< /dev/null"
+	echo "Compiler version info: " >! version_info
+	if      ( $LINUX_COMP == PGI ) then
+		pgf90 -V >>&! version_info
+	else if ( $LINUX_COMP == INTEL ) then
+		ifort -v >>&! version_info
+	endif
+	echo " " >>! version_info
+	echo "OS version info: " >>! version_info
+	uname -a >>&! version_info
+	echo " " >>! version_info
+else
+	echo "Unrecognized architecture for regression test"  >! error_message
+	echo `uname`                                          >> error_message
+	echo `hostname`                                       >> error_message
+	$MAIL -s "Unknown architecture $ARCH[1] " $FAIL_MAIL   < error_message
+	exit ( 1 )
+endif
+
+#####################################################################
+#DAVE###################################################
+echo did the arch specific stuff
+banner 3
+#set ans = "$<"
+#DAVE###################################################
+
+#	First of all, in which particular directory do we start.
+
+cd $DEF_DIR
+
+#	We want to keep the old regression stuff around
+
+if ( -d regression_test ) then
+	if ( -d regression_test.old ) then
+		/bin/rm -fr regression_test.old
+	endif
+	/bin/mv regression_test regression_test.old
+endif
+
+#	Go to the regression test directory
+
+mkdir regression_test
+set ok = $status
+if ( $ok != 0 ) then
+	echo "Gee, I cannot make a directory in $DEF_DIR"  >! error_message
+	echo `pwd`                                         >> error_message
+	echo `\ls -ls`                                     >> error_message
+	$MAIL -s "$DEF_DIR not writable $ARCH[1] " $FAIL_MAIL < error_message
+	exit ( 1 )
+else
+	pushd regression_test
+endif
+
+if      ( $acquire_from == "cvs" ) then
+
+	#	Checkout the most recent version of WRF from the NCAR cvs repository,
+	#	and pick up the required input data from the anonymous ftp site.
+
+	cvs checkout -D $thedate WRFV2
+	find ./WRFV2 -exec touch \{\} \;
+	ftp -n ftp.ucar.edu < ftp_script_data
+
+
+else if ( $acquire_from == "filearg" ) then
+
+	#	A tar file of the WRF source was provided, so that is used, along with 
+	#	the required input data files from the ftp site.
+
+	tar xvf $thefile
+	cd WRFV2
+	clean -a
+	cd ..
+	ftp -n ftp.ucar.edu < ftp_script_data
+
+else if ( $acquire_from == "environment" ) then
+
+	#	A tar file of WRF is assumed to be available.
+
+	tar xvf $thefile
+
+endif
+
+#	And we can stick the input data where we want, the WRFV2 directory has been created.
+
+( cd WRFV2/test/em_real  ; ln -sf $thedataem/* . ) 
+( cd WRFV2/test/nmm_real ; ln -s $thedatanmm/wrf_real* . ; cp $thedatanmm/namelist.input.regtest . )
+#DAVE###################################################
+( cd WRFV2/test/em_real ; ls -ls )
+( cd WRFV2/test/nmm_real ; ls -ls )
+banner 4
+#set ans = "$<"
+#DAVE###################################################
+
+#	John-specific stuff for maple is the else; part of the "using service machines".
+
+if ( ! $clrm ) then
+	pushd WRFV2
+else
+	if ( ! -d $TMPDIR ) then
+		echo something wrong 1
+	endif
+	if ( ! -d $TMPDIR/RUN ) then
+		mkdir $TMPDIR/RUN
+		/bin/rm -fr $TMPDIR/RUN/*
+	endif
+	if ( -d $TMPDIR/RUN ) then
+		tar cf - ./WRFV2/test ./WRFV2/main | ( cd $TMPDIR/RUN ; tar xvf - )
+		pushd WRFV2
+	else
+		echo something wrong 2
+		exit
+	endif
+endif
+
+#	Here we initialize our output message.
+
+if ( -e ${DEF_DIR}/wrftest.output ) rm ${DEF_DIR}/wrftest.output
+echo "Architecute: $ARCH[1]      machine: `hostname`" >>! ${DEF_DIR}/wrftest.output
+echo "WRFV2 source from: $acquire_from " >>! ${DEF_DIR}/wrftest.output
+echo "Number of OpenMP processes to use: $OPENMP" >>! ${DEF_DIR}/wrftest.output
+echo "Number of MPI    processes to use: $Num_Procs" >>! ${DEF_DIR}/wrftest.output
+set name = ( `grep ^${user}: /etc/passwd | cut -d: -f5` ) 
+echo "Test conducted by $name" >>! ${DEF_DIR}/wrftest.output
+echo " " >>! ${DEF_DIR}/wrftest.output
+echo "Test run from directory ${CUR_DIR}" >>! ${DEF_DIR}/wrftest.output
+echo " " >>! ${DEF_DIR}/wrftest.output
+if ( $?LOADL_JOB_NAME ) then
+	echo "Loadlever job name = ${LOADL_JOB_NAME}" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+echo "Real data case for EM is from $dataset " >>! ${DEF_DIR}/wrftest.output
+echo " " >>! ${DEF_DIR}/wrftest.output
+echo "The em real and ideal forecasts will be nested: $NESTED " >>! ${DEF_DIR}/wrftest.output
+echo " " >>! ${DEF_DIR}/wrftest.output
+if ( $REG_TYPE == BIT4BIT ) then
+	echo "This is a bit-wise (traditional) regression test. " >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+else if ( $REG_TYPE == OPTIMIZED ) then
+	echo "This is a fully optimized regression test. " >>! ${DEF_DIR}/wrftest.output
+	echo "No inter-comparisons are made. " >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+if ( $REAL8 == TRUE ) then
+	echo "Floating point precision is 8-bytes" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+if ( $CHEM == TRUE ) then
+	echo "WRF_CHEM tests run for em_real core only, no other cores run" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+if ( $RSL_LITE == TRUE ) then
+	echo "Parallel DM portion using RSL_LITE build option" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+else if ( $RSL_LITE != TRUE ) then
+	echo "Parallel DM portion using RSL build option" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+if ( $ESMF_LIB == TRUE ) then
+	echo "A separately installed version of the latest ESMF library" >>! ${DEF_DIR}/wrftest.output
+	echo "(NOT the ESMF library included in the WRF tarfile) will" >>! ${DEF_DIR}/wrftest.output
+	echo "be used for MPI tests" >>! ${DEF_DIR}/wrftest.output
+	echo "Setting ESMFLIB = ${ESMFLIBSAVE}" >>! ${DEF_DIR}/wrftest.output
+	echo "Setting ESMFINC = ${ESMFINCSAVE}" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+if ( $QUILT == TRUE ) then
+	echo "One WRF output quilt server will be used for some tests" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+if ( $FDDA == TRUE ) then
+	echo "Running FDDA tests" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+if ( $GENERATE_BASELINE != FALSE ) then
+	echo "WRF output will be archived in baseline directory ${GENERATE_BASELINE} for some tests" >>! \
+	     ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+if ( $COMPARE_BASELINE != FALSE ) then
+	echo "WRF output will be compared with files in baseline directory ${COMPARE_BASELINE} for some tests" >>! \
+	     ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+echo "The selected I/O option is $IO_FORM ($IO_FORM_NAME[$IO_FORM])" >>! ${DEF_DIR}/wrftest.output
+if      ( $IO_FORM_WHICH[$IO_FORM] == IO ) then
+	echo "This option is for both input and history files" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+else if ( $IO_FORM_WHICH[$IO_FORM] == I  ) then
+	echo "This option is for input files only" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+else if ( $IO_FORM_WHICH[$IO_FORM] ==  O ) then
+	echo "This option is for history files only" >>! ${DEF_DIR}/wrftest.output
+	echo " " >>! ${DEF_DIR}/wrftest.output
+endif
+
+cat ${CUR_DIR}/version_info >>! ${DEF_DIR}/wrftest.output
+
+#	There are three WRF em executables to be considered that can run in threaded and
+#	distributed memory.  The 2d hills and 2d squall lines cannot be parallelized with
+#	MPI, and are therefore not considered in this shell.  The nmm is only run with 
+#	distributed memory (1 vs 4 procs).
+
+set first_time_in = TRUE
+foreach core ( $CORES )
+#DAVE###################################################
+echo doing core $core
+banner 5
+#set ans = "$<"
+#DAVE###################################################
+
+	#	Some sleight of hand is required for the chemistry tests because we need to
+	#	build it twice.  But normally, we only build with different real vs ideal, or em vs nmm.
+	#	What to do, what to do?  Well, we ask for em_real TWICE.  The first time we build without chemistry
+	#	activated, the second time with it activated.  The first time, we do a single
+	#	test, the second time through, we do the other 5 tests.
+
+	if      ( ( $CHEM == TRUE ) && ( ${#CORES} == 2 ) && ( $first_time_in == TRUE ) ) then
+		setenv WRF_CHEM 0
+		set PHYSOPTS =	( 1 )
+		set first_time_in = FALSE
+	else if ( ( $CHEM == TRUE ) && ( ${#CORES} == 2 ) && ( $first_time_in != TRUE ) ) then
+		setenv WRF_CHEM 1
+		set PHYSOPTS =	( 2 3 4 5 6 )
+	endif
+
+	#	Cores to test.
+
+        set ZAP_SERIAL_FOR_THIS_CORE          = FALSE
+        set ZAP_OPENMP_FOR_THIS_CORE          = FALSE
+	if      ( `echo $core | cut -c 1-2` == em ) then
+		setenv WRF_EM_CORE	1
+		setenv WRF_NMM_CORE	0
+		setenv WRF_COAMPS_CORE	0
+		setenv WRF_EXP_CORE	0
+                set ZAP_SERIAL_FOR_THIS_CORE          = FALSE
+                set ZAP_OPENMP_FOR_THIS_CORE          = FALSE
+        else if ( `echo $core | cut -c 1-3` == nmm ) then
+		setenv WRF_EM_CORE	0
+		setenv WRF_NMM_CORE	1
+		setenv WRF_COAMPS_CORE	0
+		setenv WRF_EXP_CORE	0
+                set ZAP_SERIAL_FOR_THIS_CORE          = TRUE
+                set ZAP_OPENMP_FOR_THIS_CORE          = TRUE
+	endif
+
+	#	Here we are looping over all of the various compilation configurations,
+	#	such as serial only, OpenMP only, MPI only, etc.  Each architecture
+	#	has its own list of these options.  We build each of the executables for
+	#	this particular ${core}.
+	
+	foreach compopt ( $COMPOPTS )
+#DAVE###################################################
+echo doing compile option $compopt
+banner 6
+#set ans = "$<"
+#DAVE###################################################
+
+		#	We sometimes are interested in bypassing the OpenMP option.
+
+		if ( $compopt == $COMPOPTS[2] ) then
+			if ( $ZAP_OPENMP == TRUE || $ZAP_OPENMP_FOR_THIS_CORE == TRUE ) then
+				goto GOT_THIS_EXEC
+			endif
+		endif
+
+		#	NMM only runs parallel
+		if ( $compopt == $COMPOPTS[1] ) then
+			if ( $ZAP_SERIAL == TRUE || $ZAP_SERIAL_FOR_THIS_CORE == TRUE ) then
+				goto GOT_THIS_EXEC
+			endif
+		endif
+
+		if ( `uname` == AIX ) goto BUILD_REGARDLESS
+	
+		#	Did we already build this one?
+
+		if  ( $core == em_real )  then
+			if      ( ( $compopt == $COMPOPTS[1] ) && \
+                                  ( -e main/wrf_${core}.exe.$compopt ) && \
+                                  ( -e main/real_${core}.exe.1 ) && \
+                                  ( -e ${DEF_DIR}/regression_test/WRFV2/external/$IO_FORM_NAME[$IO_FORM]/diffwrf ) ) then
+				goto GOT_THIS_EXEC
+			else if ( ( $compopt != $COMPOPTS[1] ) && \
+                                  ( -e main/wrf_${core}.exe.$compopt ) && \
+                                  ( -e ${DEF_DIR}/regression_test/WRFV2/external/$IO_FORM_NAME[$IO_FORM]/diffwrf ) ) then
+				goto GOT_THIS_EXEC
+			endif
+		else
+			if      ( ( $compopt == $COMPOPTS[1] ) && \
+                                  ( -e main/wrf_${core}.exe.$compopt ) && \
+                                  ( -e main/ideal_${core}.exe.1 ) && \
+                                  ( -e ${DEF_DIR}/regression_test/WRFV2/external/$IO_FORM_NAME[$IO_FORM]/diffwrf ) ) then
+				goto GOT_THIS_EXEC
+			else if ( ( $compopt != $COMPOPTS[1] ) && \
+                                  ( -e main/wrf_${core}.exe.$compopt ) && \
+                                  ( -e ${DEF_DIR}/regression_test/WRFV2/external/$IO_FORM_NAME[$IO_FORM]/diffwrf ) ) then
+				goto GOT_THIS_EXEC
+			endif
+		endif
+
+		BUILD_REGARDLESS:
+	
+		#	The WRF configuration file works with a single integer
+		#	input, which is the compiler option.  By convention, option $COMPOPTS[1] is
+		#	serial, $COMPOPTS[2] is OMP, and $COMPOPTS[3] is MPI.
+
+		#	Print info about use of separately installed ESMF library.  
+		set esmf_lib_str = " - - - - - - - - - - - - - "
+		if ( $ESMF_LIB == TRUE ) then
+			# only test ESMF with MPI
+			if ( $compopt == $COMPOPTS[3] ) then
+				echo "A separately installed version of the latest ESMF library" >>! ${DEF_DIR}/wrftest.output
+				echo "(NOT the ESMF library included in the WRF tarfile) is" >>! ${DEF_DIR}/wrftest.output
+				echo "being used for this test of $core parallel $compopt..." >>! ${DEF_DIR}/wrftest.output
+				set esmf_lib_str = "using separate ESMF library"
+				setenv ESMFLIB $ESMFLIBSAVE
+				setenv ESMFINC $ESMFINCSAVE
+			else
+				unsetenv ESMFLIB
+				unsetenv ESMFINC
+			endif
+		endif
+	
+#DAVE###################################################
+echo start build mechanism
+banner 7
+#set ans = "$<"
+#DAVE###################################################
+		./clean -a
+		echo $compopt | ./configure
+	
+		#	Decide whether this a bit-for-bit run or an fully optimized run.  We are just
+		#	tinkering with the configure.wrf file optimization here.
+
+		if ( $REG_TYPE == BIT4BIT ) then
+			if ( `uname` == AIX ) then
+				if ( ( $compopt == $COMPOPTS[1] ) || ( $compopt == $COMPOPTS[3] ) ) then
+					sed -e '/^OMP/d' -e '/^FCOPTIM/d' -e '/^FCDEBUG/s/#/-O0 /g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+				else
+					sed -e '/^OMP/s/noauto/noauto:noopt/' \
+					    -e '/^FCOPTIM/d' -e '/^FCDEBUG/s/#/-O0 /g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+				endif
+				sed -e 's/-lmassv//g'  -e 's/-lmass//g'  -e 's/-DNATIVE_MASSV//g' -e '/^FCBASEOPTS/s/#//g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+			else if ( `uname` == Linux ) then
+				if ( ( $compopt == $COMPOPTS[1] ) || ( $compopt == $COMPOPTS[3] ) ) then
+					sed -e '/^OMP/d' -e '/^FCOPTIM/d' -e '/^FCDEBUG/s/#-g/-g/g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+				else
+					sed              -e '/^FCOPTIM/d' -e '/^FCDEBUG/s/#-g/-g/g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+				endif
+				sed -e '/^#PGI	/s/#PGI	/	/g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+			else if ( `uname` == OSF1 ) then
+		 		if ( ( $compopt == $COMPOPTS[1] ) || ( $compopt == $COMPOPTS[3] ) ) then
+					sed -e '/^OMP/d' -e '/^FCOPTIM/d' -e '/^FCDEBUG/s/# -g/-O0/g' -e '/^FCDEBUG/s/# -O0/-O0/g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+				else
+					sed              -e '/^FCOPTIM/d' -e '/^FCDEBUG/s/# -g/-O0/g' -e '/^FCDEBUG/s/# -O0/-O0/g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+				endif
+			else
+		 		if ( ( $compopt == $COMPOPTS[1] ) || ( $compopt == $COMPOPTS[3] ) ) then
+					sed -e '/^OMP/d' -e '/^FCOPTIM/d' -e '/^FCDEBUG/s/#//g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+				else
+					sed              -e '/^FCOPTIM/d' -e '/^FCDEBUG/s/#//g' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+				endif
+			endif
+		endif
+
+		#	We also need to modify the configure.wrf file based on whether or not there is
+		#	going to be nesting.  All regtest em_real nesting runs utilize a moving nest.  All of the
+		#	ARCHFLAGS macros need to have -DMOVE_NESTS added to the list of options. 
+
+		if ( ( $NESTED == TRUE ) && ( $core == em_real ) ) then
+			sed -e '/^ARCHFLAGS/s/=/=	-DMOVE_NESTS/' ./configure.wrf >! foo ; /bin/mv foo configure.wrf
+		endif
+
+		#	The configure.wrf file needs to be adjusted as to whether we are requesting real*4 or real*8
+		#	as the default floating precision.
+
+		if ( $REAL8 == TRUE ) then
+			sed -e '/^RWORDSIZE/s/\$(NATIVE_RWORDSIZE)/8/'  configure.wrf > ! foo ; /bin/mv foo configure.wrf
+		endif
+
+#DAVE###################################################
+echo configure built with optim mods removed, ready to compile
+banner 8
+#set ans = "$<"
+#DAVE###################################################
+	
+		# The WRF_SRC_ROOT_DIR hack is only used by the OSF1 build.  
+		# It works around the annoying fact that in OSF1 $(PWD) does 
+		# not change during execution of regtest.csh, despite the "cd" 
+		# and "pushd" commands.  
+		setenv WRF_SRC_ROOT_DIR "${DEF_DIR}/regression_test/WRFV2"
+		#	Build this executable
+		
+		./compile $core
+#DAVE###################################################
+echo compile done
+banner 9
+#set ans = "$<"
+#DAVE###################################################
+	
+		#	Did the compile work?  Check the expected executable names and locations.
+
+		set ok = $status
+                if ( ! -x main/wrf.exe ) set ok = 1
+
+		if      ( ( $core ==  em_real ) && ( $compopt == $COMPOPTS[1] ) ) then
+			if ( ! -e main/real.exe ) set ok = 1
+		else if ( ( $core == nmm_real ) && ( $compopt == $COMPOPTS[3] ) ) then
+			if ( ! -e main/real_nmm.exe ) set ok = 1
+		else if ( $compopt == $COMPOPTS[1] ) then
+			if ( ! -e main/ideal.exe ) set ok = 1
+		endif
+
+                if ( ! -x external/io_netcdf/diffwrf ) set ok = 1
+                if ( ! -x external/io_int/diffwrf ) set ok = 1
+
+		if ( $ok != 0 ) then
+			echo "SUMMARY compilation    for $core           parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+			$MAIL -s "REGRESSION FAILURE $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+			exit ( 3 )
+		else
+			echo "SUMMARY compilation    for $core           parallel $compopt $esmf_lib_str PASS" >>! ${DEF_DIR}/wrftest.output
+			echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+			mv main/wrf.exe main/wrf_${core}.exe.$compopt
+			if      ( ( $core ==  em_real ) && ( $compopt == $COMPOPTS[1] ) ) then
+				mv main/real.exe main/real_${core}.exe.1
+			else if ( ( $core == nmm_real ) && ( $compopt == $COMPOPTS[3] ) ) then
+				mv main/real_nmm.exe main/real_${core}.exe.$COMPOPTS[3]
+			else if ( $compopt == $COMPOPTS[1] ) then
+				mv main/ideal.exe main/ideal_${core}.exe.1
+			endif
+#DAVE###################################################
+echo exec exists
+ls -ls main/*.exe*
+banner 10
+#set ans = "$<"
+#DAVE###################################################
+		endif
+
+		GOT_THIS_EXEC:
+
+		if ( $clrm ) then
+			cp main/*exe* $TMPDIR/RUN/WRFV2/main
+		endif
+	
+	end
+
+	if ( $clrm ) then
+		pushd $TMPDIR/RUN/WRFV2
+	endif
+	
+	#	We have all of the executables built, now we run'em.  This is a loop
+	#	over all of the various physics options for this particular
+	#	${core}.  Inside the physics loop, we loop over the parallel options.
+	#	This allows us to use the same WRF input files for each of the parallel
+	#	choices for a single physics loop index.
+
+	foreach phys_option ( $PHYSOPTS )
+#DAVE###################################################
+echo which phys option $phys_option
+banner 11
+#set ans = "$<"
+#DAVE###################################################
+	
+		#	For each of the executables, we need to run several physics
+		#	options.  
+
+		if (  $core == em_real )  then
+
+			if ( $CHEM != TRUE ) then
+				set filetag=$filetag_real
+			else if ( $CHEM == TRUE ) then
+				if ( $phys_option <= 3 ) then
+					set filetag=$filetag_real[1]
+				else
+					set filetag=$filetag_real[2]
+				endif
+			endif
+
+			foreach compopt ( $COMPOPTS )
+#DAVE###################################################
+echo real if filetag is $filetag
+echo compopt = $compopt
+banner 12
+#set ans = "$<"
+#DAVE###################################################
+
+				#	We sometimes are interested in bypassing the OpenMP option.
+
+				if ( $compopt == $COMPOPTS[2] ) then
+					if ( $ZAP_OPENMP == TRUE || $ZAP_OPENMP_FOR_THIS_CORE == TRUE ) then
+						goto BYPASS_COMP_LOOP_REAL
+					endif
+				endif
+
+				if ( $compopt == $COMPOPTS[1] ) then
+					if ( $ZAP_SERIAL == TRUE || $ZAP_SERIAL_FOR_THIS_CORE == TRUE ) then
+						goto BYPASS_COMP_LOOP_REAL
+					endif
+				endif
+
+				pushd test/$core
+				
+				#
+				#	Create the correct namelist.input file for real data cases.
+				#
+
+				if ( $CHEM != TRUE ) then
+					cp ${CUR_DIR}/phys_real_${phys_option} phys_opt
+					if ( ( $RSL_LITE == TRUE ) && ( $NESTED != TRUE ) ) then
+						cp ${CUR_DIR}/dyn_real_${phys_option} dyn_opt
+					else
+						cp ${CUR_DIR}/dyn_real_SAFE dyn_opt
+					endif
+					cp ${CUR_DIR}/time_real_${phys_option} time_opt
+					cp ${CUR_DIR}/dom_real dom_real
+					if ( -e fdda_opt ) rm fdda_opt
+					cat " grid_fdda=0" > fdda_opt
+					if ( -e fdda_time ) rm fdda_time
+					cat " auxinput4_interval=0" > fdda_time
+
+					if ( $FDDA == TRUE ) then
+						cp ${CUR_DIR}/fdda_real_${phys_option} fdda_opt
+						cp ${CUR_DIR}/fdda_real_time_${phys_option} fdda_time
+					endif
+	
+					set time_step = `awk ' /^ time_step /{ print $3 } ' namelist.input.$dataset | cut -d, -f1`
+	
+					#	Wanna do more/less time steps on the real cases?  Easy. Those last two numbers
+					#	in the eqns are all you need.  Their product must be 60.  So, instead of 3 and 20,
+					#	(3 coarse grid timesteps), you could use 20 and 3 (20 coarse grid time steps).
+	
+					if      ( $NESTED == TRUE ) then
+						@ run_seconds = $time_step * 3
+						@ history_interval = $time_step / 20
+					else if ( $NESTED != TRUE ) then
+						@ run_seconds = $time_step * 10
+						@ history_interval = $time_step / 6
+					endif
+					rm ed_in namelist.input.temp
+					cat >! ed_in << EOF
+g/run_seconds/s/[0-9]/$run_seconds
+g/history_interval/s/[0-9][0-9][0-9]/$history_interval
+w namelist.input.temp
+q
+EOF
+					ed namelist.input.$dataset < ed_in
+	
+					cp ${CUR_DIR}/io_format io_format
+					sed -e '/^ mp_physics/,/ensdim/d' -e '/^ &physics/r ./phys_opt' \
+					    -e '/^ pd_moist/,/pd_tke/d' -e '/^ v_sca_adv_order/r ./dyn_opt' \
+					    -e '/^ auxinput1_inname/d' -e '/^ debug_level/r ./time_opt' \
+					    -e '/^ time_step /,/^ smooth_option/d' -e '/^ &domains/r ./dom_real' \
+					    -e '/^ io_form_history /,/^ io_form_boundary/d' -e '/^ restart_interval/r ./io_format' \
+					    -e 's/ frames_per_outfile *= [0-9][0-9]*/ frames_per_outfile = 200/g' \
+					    -e 's/ run_days *= [0-9][0-9]*/ run_days = 0/g' \
+					    -e 's/ run_hours *= [0-9][0-9]*/ run_hours = 0/g' \
+					    -e 's/ run_minutes *= [0-9][0-9]*/ run_minutes = 0/g' \
+					    -e '/^ &fdda/r fdda_opt' \
+					    -e '/^ debug_level/r fdda_time' \
+					namelist.input.temp >! namelist.input
+				
+				#	The chem run has its own namelist, due to special input files (io_form not tested for chem)
+
+				else if ( $CHEM == TRUE ) then
+					cp namelist.input.chem_test_${phys_option} namelist.input
+					if ( -e wrf_real_input_em.d01.${filetag} ) then
+						\rm wrf_real_input_em.d01.*
+					endif
+					if ( ${phys_option} <= 3 ) then
+						ln -s 00z/wrf_real* .
+					else
+						ln -s 12z/wrf_real* .
+					endif
+
+				endif
+
+				# WRF output quilt servers are only tested for MPI configuration.  
+				# Currently, only one WRF output quilt server is used.  
+
+				if ( $QUILT == TRUE ) then
+					if ( $compopt == $COMPOPTS[3] ) then
+						#	For now, test only one group of one output quilt servers.  
+						sed -e 's/ nio_tasks_per_group *= *[0-9][0-9]*/ nio_tasks_per_group = 1/g' \
+						    -e 's/ nio_groups *= *[0-9][0-9]*/ nio_groups = 1/g' \
+						namelist.input >! namelist.input.temp
+						mv -f namelist.input.temp namelist.input
+						echo "Building namelist.input.$core.${phys_option}.$compopt with one I/O quilt server enabled."
+						echo "NOTE  one I/O quilt server enabled for $core physics $phys_option parallel $compopt..." >>! ${DEF_DIR}/wrftest.output
+					endif
+				endif
+
+				/bin/cp namelist.input $TMPDIR/namelist.input.$core.${phys_option}.$compopt
+#DAVE###################################################
+echo built namelist $TMPDIR/namelist.input.$core.${phys_option}.$compopt
+cat  $TMPDIR/namelist.input.$core.${phys_option}.$compopt
+echo need history interval to be 30
+banner 13
+#set ans = "$<"
+#DAVE###################################################
+#DAVE###################################################
+echo skipped link of data files, we push them elsewhere
+ls -ls wrf_real*
+banner 14
+#set ans = "$<"
+#DAVE###################################################
+
+				#	If this is the serial code, generate the IC and BC.  The real.exe program is not
+				#	parallelized, so the data is generated and saved for the rest of the parallel tests.
+				#	This data is necessarily updated for each of the physics tests.
+
+				if ( $compopt == $COMPOPTS[1] ) then
+
+					#	Zap any old input data laying around.
+
+					rm wrfinput_d01 >& /dev/null
+					rm wrfbdy_d01   >& /dev/null
+
+					if ( $NESTED == TRUE ) then
+						setenv OMP_NUM_THREADS 1
+						if ( `uname` == AIX ) then
+							setenv XLSMPOPTS "parthds=1"
+						endif
+						$SERIALRUNCOMMAND ../../main/real_${core}.exe.1 >! print.out.real_${core}_Phys=${phys_option}_Parallel=${compopt}
+					else if ( $NESTED != TRUE ) then
+						../../main/real_${core}.exe.1 >! print.out.real_${core}_Phys=${phys_option}_Parallel=${compopt}
+					endif
+#DAVE###################################################
+echo finished real
+banner 15
+#set ans = "$<"
+#DAVE###################################################
+
+					grep "SUCCESS COMPLETE" print.out.real_${core}_Phys=${phys_option}_Parallel=${compopt} >& /dev/null
+					set success = $status
+
+					#	Did making the IC BC files work?
+
+					if ( ( -e wrfinput_d01 ) && ( -e wrfbdy_d01 ) && ( $success == 0 ) ) then
+						echo "SUMMARY generate IC/BC for $core physics $phys_option parallel $compopt $esmf_lib_str PASS" >>! ${DEF_DIR}/wrftest.output
+						echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+					else
+						echo "SUMMARY generate IC/BC for $core physics $phys_option parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+						$MAIL -s "WRF FAIL making IC/BC $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+						exit ( 4 )
+					endif
+#DAVE###################################################
+echo IC BC must be OK
+ls -ls wrfi* wrfb*
+if ( $IO_FORM_NAME[$IO_FORM] == io_netcdf ) then
+	ncdump -v Times wrfb* | tail -20
+endif
+banner 16
+#set ans = "$<"
+#DAVE###################################################
+				endif
+		
+				#	Run the forecast for this core, physics package and parallel option
+
+				rm $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$compopt >& /dev/null
+				
+				#	The chem run has its own set of namelists, due to special input files.
+
+				if ( $CHEM == TRUE ) then
+
+					# WRF output quilt servers are only tested for MPI configuration.  
+					# Currently, only one WRF output quilt server is used.  
+	
+					if ( $QUILT == TRUE ) then
+						if ( $compopt == $COMPOPTS[3] ) then
+							#	For now, test only one group of one output quilt servers.  
+							sed -e 's/ nio_tasks_per_group *= *[0-9][0-9]*/ nio_tasks_per_group = 1/g' \
+							    -e 's/ nio_groups *= *[0-9][0-9]*/ nio_groups = 1/g' \
+							namelist.input >! namelist.input.temp
+							mv -f namelist.input.temp namelist.input
+							echo "Building namelist.input.$core.${phys_option}.$compopt with one I/O quilt server enabled."
+							echo "NOTE  one I/O quilt server enabled for $core physics $phys_option parallel $compopt..." >>! ${DEF_DIR}/wrftest.output
+						endif
+					endif
+				endif
+
+				if      ( $compopt == $COMPOPTS[1] ) then
+					setenv OMP_NUM_THREADS 1
+					if ( `uname` == AIX ) then
+						setenv XLSMPOPTS "parthds=1"
+					endif
+					if ( $NESTED == TRUE ) then
+						$SERIALRUNCOMMAND ../../main/wrf_${core}.exe.$compopt >! print.out.wrf_${core}_Phys=${phys_option}_Parallel=${compopt}.exe
+					else if ( $NESTED != TRUE ) then
+						../../main/wrf_${core}.exe.$compopt >! print.out.wrf_${core}_Phys=${phys_option}_Parallel=${compopt}.exe
+					endif
+				else if ( $compopt == $COMPOPTS[2] ) then
+					setenv OMP_NUM_THREADS $OPENMP
+					if ( `uname` == AIX ) then
+						setenv XLSMPOPTS "parthds=${OPENMP}"
+					endif
+					if ( $NESTED == TRUE ) then
+						$OMPRUNCOMMAND ../../main/wrf_${core}.exe.$compopt >! print.out.wrf_${core}_Phys=${phys_option}_Parallel=${compopt}.exe
+					else if ( $NESTED != TRUE ) then
+						../../main/wrf_${core}.exe.$compopt >! print.out.wrf_${core}_Phys=${phys_option}_Parallel=${compopt}.exe
+					endif
+				else if ( $compopt == $COMPOPTS[3] ) then
+					setenv OMP_NUM_THREADS 1
+					if ( `uname` == AIX ) then
+						setenv XLSMPOPTS "parthds=1"
+					endif
+					$MPIRUNCOMMAND ../../main/wrf_${core}.exe.$compopt $MPIRUNCOMMANDPOST
+					mv rsl.error.0000 print.out.wrf_${core}_Phys=${phys_option}_Parallel=${compopt}.exe
+				endif
+#DAVE###################################################
+echo ran wrf fcst compopt = $compopt
+banner 17
+#set ans = "$<"
+#DAVE###################################################
+
+				grep "SUCCESS COMPLETE" print.out.wrf_${core}_Phys=${phys_option}_Parallel=${compopt}.exe
+				set success = $status
+
+				#	Did making the forecast work, by that, we mean "is there an output file created", and "are there 2 times periods".
+
+				if ( ( -e wrfout_d01_${filetag} ) && ( $success == 0 ) ) then
+					if      ( $IO_FORM_NAME[$IO_FORM] == io_netcdf ) then
+						ncdump -h wrfout_d01_${filetag} | grep Time | grep UNLIMITED | grep currently | grep -q 2
+						set ok = $status
+						set found_nans = 1
+						if      ( `uname` == AIX   ) then
+							ncdump wrfout_d01_${filetag} | grep NaN >& /dev/null
+							set found_nans = $status
+						else if ( `uname` == OSF1  ) then
+							ncdump wrfout_d01_${filetag} | grep nan >& /dev/null
+					#		set found_nans = $status
+						else if ( `uname` == Linux ) then
+							ncdump wrfout_d01_${filetag} | grep nan >& /dev/null
+							set found_nans = $status
+						endif
+						if ( $found_nans == 0 ) then
+							echo found nans
+							set ok = 1
+						endif
+
+					else if ( $IO_FORM_NAME[$IO_FORM] == io_grib1  ) then
+#						set joe_times = `../../external/io_grib1/wgrib -s -4yr wrfout_d01_${filetag} |  grep -v ":anl:" | wc -l`
+#						if ( $joe_times >= 100 ) then
+						set joe_times = `../../external/io_grib1/wgrib -s -4yr wrfout_d01_${filetag} |  grep "UGRD:10 m" | wc -l`
+						if ( $joe_times == 2 ) then
+							set ok = 0
+						else
+							set ok = 1
+						endif
+					endif
+					if ( $ok == 0 ) then
+						echo "SUMMARY generate FCST  for $core physics $phys_option parallel $compopt $esmf_lib_str PASS" >>! ${DEF_DIR}/wrftest.output
+						echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+					else
+						echo "SUMMARY generate FCST  for $core physics $phys_option parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+						$MAIL -s "WRF FAIL FCST $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+						exit ( 5 )
+					endif
+				else
+					echo "SUMMARY generate FCST  for $core physics $phys_option parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+					$MAIL -s "WRF FAIL FCST $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+					exit ( 6 )
+				endif
+#DAVE###################################################
+echo success or failure of fcst
+if ( $IO_FORM_NAME[$IO_FORM] == io_netcdf ) then
+	ncdump -v Times wrfout_d01_${filetag} | tail -20
+endif
+banner 18
+#set ans = "$<"
+#DAVE###################################################
+
+				#	We have to save this output file for our biggy comparison after all of the
+				#	parallel options have been considered.
+
+				mv wrfout_d01_${filetag} $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$compopt
+
+				#       To save space, we move the executables after we are finished with them.
+
+				if ( $phys_option == $PHYSOPTS[${#PHYSOPTS}] ) then
+					mv ../../main/wrf_${core}.exe.$compopt $TMPDIR/wrf_${core}.exe.$compopt
+				endif
+
+				popd
+
+				BYPASS_COMP_LOOP_REAL:
+
+			end
+
+		else if ( $core == nmm_real )  then
+#DAVE###################################################
+echo doing nmm pre
+banner 19
+#set ans = "$<"
+#DAVE###################################################
+
+                        set compopt = $COMPOPTS[3]   # ! parallel only
+                        set filetag = 2005-01-23_00:00:00
+                        set phys_option=1
+                        pushd test/$core
+
+#DAVE###################################################
+echo did rms
+echo $filetag $phys_option
+banner 19a
+#set ans = "$<"
+#DAVE###################################################
+
+			#	Build NMM namelist
+
+			cp ${CUR_DIR}/io_format io_format
+			sed -e '/^ io_form_history /,/^ io_form_boundary/d' -e '/^ restart_interval/r ./io_format' \
+			    namelist.input.regtest >! namelist.input.temp
+	
+			#	A fairly short forecast, 10 time steps
+
+			sed -e 's/^ run_days *= *[0-9]*/ run_days = 0 /' \
+			    -e 's/^ run_seconds *= *[0-9]*/ run_seconds = 900 /' \
+			    -e 's/^ history_interval *= *[0-9][0-9]*/ history_interval = 15 /' \
+			    -e 's/^ frames_per_outfile *= [0-9]*/ frames_per_outfile = 200/g' \
+			    namelist.input.temp >! namelist.input
+
+#DAVE###################################################
+echo did cp of namelist
+ls -ls namelist.input
+cat namelist.input
+banner 19b
+#set ans = "$<"
+#DAVE###################################################
+
+			#	Generate IC/BC for NMM run
+
+			set RUNCOMMAND = `echo $MPIRUNCOMMAND | sed "s/$Num_Procs/1/"`
+
+			#	Zap any old input data laying around.
+
+			rm wrfinput_d01 >& /dev/null
+			rm wrfbdy_d01   >& /dev/null
+
+			$RUNCOMMAND ../../main/real_${core}.exe.$COMPOPTS[3] >! print.out.real_${core}_Phys=${phys_option}_Parallel=$COMPOPTS[3]
+#DAVE###################################################
+echo finished real
+banner 19c
+#set ans = "$<"
+#DAVE###################################################
+
+			mv rsl.out.0000 print.out.real_${core}_Phys=${phys_option}_Parallel=${compopt}
+			grep "SUCCESS COMPLETE" print.out.real_${core}_Phys=${phys_option}_Parallel=${compopt} >& /dev/null
+			set success = $status
+
+			#	Did making the IC BC files work?
+
+			if ( ( -e wrfinput_d01 ) && ( -e wrfbdy_d01 ) && ( $success == 0 ) ) then
+				echo "SUMMARY generate IC/BC for $core physics $phys_option parallel $compopt $esmf_lib_str PASS" >>! ${DEF_DIR}/wrftest.output
+				echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+			else
+				echo "SUMMARY generate IC/BC for $core physics $phys_option parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+				$MAIL -s "WRF FAIL making IC/BC $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+				exit ( 4 )
+			endif
+#DAVE###################################################
+echo IC BC must be OK
+ls -lsL wrfinput* wrfb*
+if ( $IO_FORM_NAME[$IO_FORM] == io_netcdf ) then
+	ncdump -v Times wrfb* | tail -20
+endif
+banner 20
+#set ans = "$<"
+#DAVE###################################################
+
+			#	Run on 1 and then on Num_Procs processors
+
+			foreach n ( 1 $Num_Procs )
+#DAVE###################################################
+echo running nmm on $n procs
+banner 21
+#set ans = "$<"
+#DAVE###################################################
+
+				if      ( ( $n != 1 ) && ( $QUILT != TRUE ) ) then
+					@ nmm_proc = $Num_Procs
+					cat >! nproc_xy << EOF
+ nproc_x = $nmm_proc
+ nproc_y = 1
+EOF
+					sed -e '/^ numtiles/r nproc_xy' namelist.input >! file.foo
+					mv file.foo namelist.input
+				else if ( ( $n != 1 ) && ( $QUILT == TRUE ) ) then
+					@ nmm_proc = $Num_Procs - 1
+					cat >! nproc_xy << EOF
+ nproc_x = $nmm_proc
+ nproc_y = 1
+EOF
+					sed -e '/^ numtiles/r nproc_xy' namelist.input >! file.foo
+					mv file.foo namelist.input
+				endif
+
+				if ( `uname` == AIX ) then
+					set RUNCOMMAND = $MPIRUNCOMMAND
+				else
+					set RUNCOMMAND = `echo $MPIRUNCOMMAND | sed "s/$Num_Procs/$n/"`
+				endif
+
+				#	WRF output quilt servers are only tested for MPI configuration.  
+				#	Currently, only one WRF output quilt server is used.  
+			
+				if ( ( $QUILT == TRUE ) && ( $n == $Num_Procs ) ) then
+					if ( $compopt == $COMPOPTS[3] ) then
+						#	For now, test only one group of one output quilt servers.  
+						sed -e 's/ nio_tasks_per_group *= *[0-9]*/ nio_tasks_per_group = 1/g' \
+						    -e 's/ nio_groups *= *[0-9]*/ nio_groups = 1/g' \
+						namelist.input >! namelist.input.temp
+						mv -f namelist.input.temp namelist.input
+						echo "Building namelist.input.$core.${phys_option}.$compopt with one I/O quilt server enabled."
+						echo "NOTE  one I/O quilt server enabled for $core physics $phys_option parallel $compopt..." >>! ${DEF_DIR}/wrftest.output
+					endif
+				endif
+
+				#	NMM can fail on spurious fp exceptions that don't affect soln. Retry if necessary.
+
+				set tries=0
+				while ( $tries < 2 )
+#DAVE###################################################
+echo try attempt $tries allowed to be less than 2
+banner 22
+#set ans = "$<"
+#DAVE###################################################
+					@ tries = $tries + 1
+					$RUNCOMMAND ../../main/wrf_${core}.exe.$compopt $MPIRUNCOMMANDPOST
+					mv rsl.error.0000 print.out.wrf_${core}_Phys=${phys_option}_Parallel=${compopt}.exe_${n}p
+					grep "SUCCESS COMPLETE" print.out.wrf_${core}_Phys=${phys_option}_Parallel=${compopt}.exe_${n}p
+					set success = $status
+					set ok = $status
+					if ( ( -e wrfout_d01_${filetag} ) && ( $success == 0 ) ) then
+						if      ( $IO_FORM_NAME[$IO_FORM] == io_netcdf ) then
+							ncdump -h wrfout_d01_${filetag} | grep Time | grep UNLIMITED | grep currently | grep -q 2
+							set ok = $status
+							set found_nans = 1
+							if      ( `uname` == AIX   ) then
+								ncdump wrfout_d01_${filetag} | grep NaN >& /dev/null
+								set found_nans = $status
+							else if ( `uname` == OSF1  ) then
+								ncdump wrfout_d01_${filetag} | grep nan >& /dev/null
+						#		set found_nans = $status
+							else if ( `uname` == Linux ) then
+								ncdump wrfout_d01_${filetag} | grep nan >& /dev/null
+								set found_nans = $status
+							endif
+							if ( $found_nans == 0 ) then
+								echo found nans
+								set ok = 1
+							endif
+
+						else if ( $IO_FORM_NAME[$IO_FORM] == io_grib1  ) then
+							../../external/io_grib1/wgrib -s -4yr wrfout_d01_${filetag} |  grep "UGRD:10 m above gnd:3600 sec fcst"
+							set ok = $status
+						endif
+						if ( $ok == 0 ) then
+							echo "SUMMARY generate FCST  for $core physics $phys_option parallel $compopt $esmf_lib_str PASS" >>! ${DEF_DIR}/wrftest.output
+							echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+							set tries=2  # success, bail from loop
+						else
+							echo "SUMMARY generate FCST  for $core physics $phys_option parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+							$MAIL -s "WRF FAIL FCST $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+							if ( $tries == 2 ) exit ( 5 )
+						endif
+					else
+						echo "SUMMARY generate FCST  for $core physics $phys_option parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+						$MAIL -s "WRF FAIL FCST $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+						if ( $tries == 2 ) exit ( 6 )
+					endif
+					mv wrfout_d01_${filetag} $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.${compopt}_${n}p
+#DAVE###################################################
+echo did nmm fcst
+ls -ls $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.${compopt}_${n}p
+banner 23
+#set ans = "$<"
+#DAVE###################################################
+				end
+			end
+
+                        popd
+
+		else
+
+#DAVE###################################################
+echo doing ideal runs
+banner 24
+#set ans = "$<"
+#DAVE###################################################
+			#	The ideal cases have different physics tests than the real cases.  If this is 
+			#	more that the total number of ideal physics experiments that we were led to 
+			#	believe would exist, jump to the end of the physics loop.
+
+			if ( $phys_option > $Max_Ideal_Physics_Options ) then
+				goto BOTTOM_OF_PHYSICS_LOOP
+			endif
+
+                        set filetag=$filetag_ideal
+
+			foreach compopt ( $COMPOPTS )
+#DAVE###################################################
+echo doing compopt = $compopt
+echo filetag = $filetag
+banner 25
+#set ans = "$<"
+#DAVE###################################################
+
+
+				#	We sometimes are interested in bypassing the OpenMP option.
+
+				if ( $compopt == $COMPOPTS[2] ) then
+					if ( $ZAP_OPENMP == TRUE ) then
+						goto BYPASS_COMP_LOOP_IDEAL
+					endif
+				endif
+
+				pushd test/$core
+
+				if ( ! -e namelist.input.template ) cp namelist.input namelist.input.template
+
+				#	Create the correct namelist.input file.
+
+				cp ${CUR_DIR}/dom_ideal dom_ideal
+				if      ( $core == em_quarter_ss )  then
+					cp ${CUR_DIR}/phys_quarter_ss_${phys_option}a phys_tke
+					cp ${CUR_DIR}/phys_quarter_ss_${phys_option}b phys_mp
+					cp ${CUR_DIR}/phys_quarter_ss_${phys_option}c phys_nh
+					cp ${CUR_DIR}/phys_quarter_ss_${phys_option}d phys_bc
+				else if ( $core == em_b_wave     ) then
+					cp ${CUR_DIR}/phys_b_wave_${phys_option}a     phys_tke
+					cp ${CUR_DIR}/phys_b_wave_${phys_option}b     phys_mp
+					cp ${CUR_DIR}/phys_b_wave_${phys_option}c     phys_nh
+				endif
+
+				cp ${CUR_DIR}/io_format io_format
+				if      ( $NESTED == TRUE ) then
+					if      ( $core == em_quarter_ss )  then
+						sed -e 's/ run_days *= *[0-9][0-9]*/ run_days = 00/g'                              		\
+						    -e 's/ run_minutes *= *[0-9][0-9]*/ run_minutes = 1/g'                         		\
+						    -e 's/ run_seconds *= *[0-9][0-9]*/ run_seconds = 0/g'                         		\
+		                                    -e 's/ history_interval *= [0-9][0-9]*/ history_interval = 1/g'                     	\
+						    -e 's/ frames_per_outfile *= [0-9][0-9]*/ frames_per_outfile = 100/g'               	\
+						    -e '/^ diff_opt/d' -e '/^ km_opt/d' -e '/^ damp_opt/d' -e '/^ rk_ord/r ./phys_tke' 		\
+ 		                                    -e '/^ io_form_history /,/^ io_form_boundary/d' -e '/^ restart_interval/r ./io_format'	\
+						    -e '/^ mp_physics/d' -e '/^ &physics/r ./phys_mp' 						\
+						    -e '/^ non_hydrostatic/d' -e '/^ epssm/r ./phys_nh' 					\
+						    -e '/^ periodic_x/d' -e '/^ open_xs/d' -e '/^ open_xe/d' 					\
+						    -e '/^ periodic_y/d' -e '/^ open_ys/d' -e '/^ open_ye/d' 					\
+						    -e '/^ &bdy_control/r ./phys_bc' 								\
+						    -e '/^ max_dom/d' -e '/^ time_step_fract_den/r ./dom_ideal'					\
+						    ./namelist.input.template >! namelist.input
+					else if ( $core == em_b_wave     ) then
+						sed -e 's/ run_days *= *[0-9][0-9]*/ run_days = 00/g'                              		\
+						    -e 's/ run_minutes *= *[0-9][0-9]*/ run_minutes = 20/g'                       		\
+						    -e 's/ history_interval *= [0-9][0-9]*/ history_interval = 20/g'                   		\
+						    -e 's/ frames_per_outfile *= [0-9][0-9]*/ frames_per_outfile = 100/g'               	\
+						    -e '/^ diff_opt/d' -e '/^ km_opt/d' -e '/^ damp_opt/d' -e '/^ rk_ord/r ./phys_tke' 		\
+ 		                                    -e '/^ io_form_history /,/^ io_form_boundary/d' -e '/^ restart_interval/r ./io_format'	\
+						    -e '/^ mp_physics/d' -e '/^ &physics/r ./phys_mp' 						\
+						    -e '/^ non_hydrostatic/d' -e '/^ epssm/r ./phys_nh' 					\
+						    -e '/^ max_dom/d' -e '/^ time_step_fract_den/r ./dom_ideal'					\
+						./namelist.input.template >! namelist.input
+					endif
+				else if ( $NESTED != TRUE ) then
+					if      ( $core == em_quarter_ss )  then
+						sed -e 's/ run_days *= *[0-9][0-9]*/ run_days = 00/g'                              		\
+						    -e 's/ run_minutes *= *[0-9][0-9]*/ run_minutes = 2/g'                         		\
+		                                    -e 's/ history_interval *= [0-9][0-9]*/ history_interval = 2/g'                     	\
+						    -e 's/ frames_per_outfile *= [0-9][0-9]*/ frames_per_outfile = 100/g'               	\
+						    -e '/^ diff_opt/d' -e '/^ km_opt/d' -e '/^ damp_opt/d' -e '/^ rk_ord/r ./phys_tke' 		\
+ 		                                    -e '/^ io_form_history /,/^ io_form_boundary/d' -e '/^ restart_interval/r ./io_format'	\
+						    -e '/^ mp_physics/d' -e '/^ &physics/r ./phys_mp' 						\
+						    -e '/^ non_hydrostatic/d' -e '/^ epssm/r ./phys_nh' 					\
+						    -e '/^ periodic_x/d' -e '/^ open_xs/d' -e '/^ open_xe/d' 					\
+						    -e '/^ periodic_y/d' -e '/^ open_ys/d' -e '/^ open_ye/d' 					\
+						    -e '/^ &bdy_control/r ./phys_bc' 								\
+						    -e '/^ max_dom/d' -e '/^ time_step_fract_den/r ./dom_ideal'					\
+						    ./namelist.input.template >! namelist.input
+					else if ( $core == em_b_wave     ) then
+						sed -e 's/ run_days *= *[0-9][0-9]*/ run_days = 00/g'                              		\
+						    -e 's/ run_minutes *= *[0-9][0-9]*/ run_minutes = 100/g'                       		\
+						    -e 's/ history_interval *= [0-9][0-9]*/ history_interval = 100/g'                   	\
+						    -e 's/ frames_per_outfile *= [0-9][0-9]*/ frames_per_outfile = 100/g'               	\
+						    -e '/^ diff_opt/d' -e '/^ km_opt/d' -e '/^ damp_opt/d' -e '/^ rk_ord/r ./phys_tke' 		\
+ 		                                    -e '/^ io_form_history /,/^ io_form_boundary/d' -e '/^ restart_interval/r ./io_format'	\
+						    -e '/^ mp_physics/d' -e '/^ &physics/r ./phys_mp' 						\
+						    -e '/^ non_hydrostatic/d' -e '/^ epssm/r ./phys_nh' 					\
+						    -e '/^ max_dom/d' -e '/^ time_step_fract_den/r ./dom_ideal'					\
+						./namelist.input.template >! namelist.input
+					endif
+				endif
+
+				# WRF output quilt servers are only tested for MPI configuration.  
+				# Currently, only one WRF output quilt server is used.  
+
+				if ( $QUILT == TRUE ) then
+					if ( $compopt == $COMPOPTS[3] ) then
+						#	For now, test only one group of one output quilt servers.  
+						sed -e 's/ nio_tasks_per_group *= *[0-9][0-9]*/ nio_tasks_per_group = 1/g' \
+						    -e 's/ nio_groups *= *[0-9][0-9]*/ nio_groups = 1/g' \
+						namelist.input >! namelist.input.temp
+						mv -f namelist.input.temp namelist.input
+						echo "Building namelist.input.$core.${phys_option}.$compopt with one I/O quilt server enabled."
+						echo "NOTE  one I/O quilt server enabled for $core physics $phys_option parallel $compopt..." >>! ${DEF_DIR}/wrftest.output
+					endif
+				endif
+#DAVE###################################################
+echo built namelist 
+ls -ls namelist.input
+banner 26
+#set ans = "$<"
+#DAVE###################################################
+
+				#	If this is the serial code, generate the IC and BC.  The ideal.exe program is not
+				#	parallelized, so the data is generated and saved for the rest of the parallel tests.
+
+				if ( $compopt == $COMPOPTS[1] ) then
+
+					#	Zap any old input data laying around.
+
+					rm wrfinput_d01 >& /dev/null
+					rm wrfbdy_d01   >& /dev/null
+
+					../../main/ideal_${core}.exe.1 >! print.out.ideal_${core}_Parallel=${compopt}
+#DAVE###################################################
+echo ran ideal
+ls -ls wrfiput*
+banner 27
+#set ans = "$<"
+#DAVE###################################################
+
+					grep "SUCCESS COMPLETE" print.out.ideal_${core}_Parallel=${compopt} >& /dev/null
+					set success = $status
+
+					#	Did making the IC BC files work?
+
+					if ( ( -e wrfinput_d01 ) && ( $success == 0 ) ) then
+						echo "SUMMARY generate IC/BC for $core physics $phys_option parallel $compopt $esmf_lib_str PASS" >>! ${DEF_DIR}/wrftest.output
+						echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+					else
+						echo "SUMMARY generate IC/BC for $core physics $phys_option parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+						$MAIL -s "WRF FAIL making IC/BC $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+						exit ( 7 )
+					endif
+				endif
+		
+				#	Run the forecast for this core and parallel option
+
+				rm $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$compopt >& /dev/null
+
+				if      ( $compopt == $COMPOPTS[1] ) then
+					setenv OMP_NUM_THREADS 1
+					if ( `uname` == AIX ) then
+						setenv XLSMPOPTS "parthds=1"
+					endif
+					if ( $NESTED == TRUE ) then
+						$SERIALRUNCOMMAND ../../main/wrf_${core}.exe.$compopt >! print.out.wrf_${core}_Parallel=${compopt}.exe
+					else if ( $NESTED != TRUE ) then
+						../../main/wrf_${core}.exe.$compopt >! print.out.wrf_${core}_Parallel=${compopt}.exe
+					endif
+				else if ( $compopt == $COMPOPTS[2] ) then
+					setenv OMP_NUM_THREADS $OPENMP
+					if ( `uname` == AIX ) then
+						setenv XLSMPOPTS "parthds=${OPENMP}"
+					endif
+					if ( $NESTED == TRUE ) then
+						$OMPRUNCOMMAND ../../main/wrf_${core}.exe.$compopt >! print.out.wrf_${core}_Parallel=${compopt}.exe
+					else if ( $NESTED != TRUE ) then
+						../../main/wrf_${core}.exe.$compopt >! print.out.wrf_${core}_Parallel=${compopt}.exe
+					endif
+				else if ( $compopt == $COMPOPTS[3] ) then
+					setenv OMP_NUM_THREADS 1
+					if ( `uname` == AIX ) then
+						setenv XLSMPOPTS "parthds=1"
+					endif
+					$MPIRUNCOMMAND ../../main/wrf_${core}.exe.$compopt $MPIRUNCOMMANDPOST
+					mv rsl.error.0000 print.out.wrf_${core}_Parallel=${compopt}.exe
+				endif
+#DAVE###################################################
+echo ran ideal fcst
+banner 28
+#set ans = "$<"
+#DAVE###################################################
+
+				grep "SUCCESS COMPLETE" print.out.wrf_${core}_Parallel=${compopt}.exe
+				set success = $status
+
+				#	Did making the forecast work, by that, we mean "is there an output file created?"
+
+				if ( ( -e wrfout_d01_${filetag} ) && ( $success == 0 ) ) then
+					if      ( $IO_FORM_NAME[$IO_FORM] == io_netcdf ) then
+						ncdump -h wrfout_d01_${filetag} | grep Time | grep UNLIMITED | grep currently | grep -q 2
+						set ok = $status
+						set found_nans = 1
+						if      ( `uname` == AIX   ) then
+							ncdump wrfout_d01_${filetag} | grep NaN >& /dev/null
+							set found_nans = $status
+						else if ( `uname` == OSF1  ) then
+							ncdump wrfout_d01_${filetag} | grep nan >& /dev/null
+					#		set found_nans = $status
+						else if ( `uname` == Linux ) then
+							ncdump wrfout_d01_${filetag} | grep nan >& /dev/null
+							set found_nans = $status
+						endif
+						if ( $found_nans == 0 ) then
+							echo found nans
+							set ok = 1
+						endif
+
+					else if ( $IO_FORM_NAME[$IO_FORM] == io_grib1  ) then
+#						set joe_times = `../../external/io_grib1/wgrib -s -4yr wrfout_d01_${filetag} |  grep -v ":anl:" | wc -l`
+#						if ( $joe_times >= 100 ) then
+						set joe_times = `../../external/io_grib1/wgrib -s -4yr wrfout_d01_${filetag} |  grep "UGRD:10 m" | wc -l`
+						if ( $joe_times == 2 ) then
+							set ok = 0
+						else
+							set ok = 1
+						endif
+					endif
+					if ( $ok == 0 ) then
+						echo "SUMMARY generate FCST  for $core physics $phys_option parallel $compopt $esmf_lib_str PASS" >>! ${DEF_DIR}/wrftest.output
+						echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+					else
+						echo "SUMMARY generate FCST  for $core physics $phys_option parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+						$MAIL -s "WRF FAIL FCST $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+						exit ( 8 )
+					endif
+				else
+					echo "SUMMARY generate FCST  for $core physics $phys_option parallel $compopt $esmf_lib_str FAIL" >>! ${DEF_DIR}/wrftest.output
+					$MAIL -s "WRF FAIL FCST $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+					exit ( 9 )
+				endif
+
+				#	We have to save this output file for our biggy comparison after all of the
+				#	parallel options have been considered.
+
+				mv wrfout_d01_${filetag} $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$compopt
+
+				#       To save space, we move the executables after we are finished with them.
+
+				if ( $phys_option == $Max_Ideal_Physics_Options ) then
+					mv ../../main/wrf_${core}.exe.$compopt $TMPDIR/wrf_${core}.exe.$compopt
+				endif
+#DAVE###################################################
+echo fcst was a success
+ls -ls $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$compopt
+if ( $IO_FORM_NAME[$IO_FORM] == io_netcdf ) then
+	ncdump -v Times $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$compopt | tail -20
+endif
+banner 29
+#set ans = "$<"
+#DAVE###################################################
+
+				popd
+
+				BYPASS_COMP_LOOP_IDEAL:
+
+			end
+
+		endif
+
+		#	OK, once more, we gotta check if this is a BIT4BIT run.  If so then there
+		#	are a number of comparisons to do.  If this is a an OPTIMIZED run, then the
+		#	comparisons will fail the bit-wise comparisons.
+
+		if ( $REG_TYPE == BIT4BIT) then
+
+	                if ( $core == nmm_real ) then
+	
+				pushd ${DEF_DIR}/regression_test/WRFV2/test/$core
+				set DIFFWRF = ${DEF_DIR}/regression_test/WRFV2/external/$IO_FORM_NAME[$IO_FORM]/diffwrf
+	
+	                        if ( ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3]_1p ) && \
+	                             ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3]_${Num_Procs}p ) ) then
+	                                set foo1 = ( ` \ls -ls $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3]_1p `)
+	                                set foo2 = ( ` \ls -ls $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3]_${Num_Procs}p `)
+	                                set size1 = $foo1[6]
+	                                set size2 = $foo2[6]
+	                                if ( $size1 == $size2 ) then
+	                                        set RIGHT_SIZE = TRUE
+	                                else
+	                                        set RIGHT_SIZE = FALSE
+	                                endif
+	                        else
+	                                set RIGHT_SIZE = FALSE
+	                        endif
+	
+	                        #       1p vs Num_Procs MPI
+	
+	                        rm fort.88 fort.98 >& /dev/null
+	                        if ( ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3]_1p ) && \
+	                             ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3]_${Num_Procs}p ) && \
+	                             ( $RIGHT_SIZE == TRUE ) ) then
+	                                $DIFFWRF $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3]_1p \
+	                                         $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3]_${Num_Procs}p >& /dev/null
+	                        else
+	                                touch fort.88 fort.98
+	                        endif
+	                        if ( ! -e fort.88 ) then
+	                                echo "SUMMARY 1 vs $Num_Procs MPI  for $core physics $phys_option $esmf_lib_str            PASS" >>! ${DEF_DIR}/wrftest.output
+	                                echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+	                        else
+	                                echo "SUMMARY 1 vs $Num_Procs MPI  for $core physics $phys_option $esmf_lib_str            FAIL" >>! ${DEF_DIR}/wrftest.output
+	                                echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+	                        endif
+	
+	                        popd
+	
+			else if ( ${#COMPOPTS} != 1 ) then
+	
+			#	If there is only a single parallel option, then we are just trying to
+			#	build the serial code.  That implies no comparisons are needed.
+	
+				#	All of the forecasts for this set of physics and core have been
+				#	generated.  We now compare the WRF model output files to see
+				#	if they are S^2D^2.
+		
+				pushd ${DEF_DIR}/regression_test/WRFV2/test/$core
+				set DIFFWRF = ${DEF_DIR}/regression_test/WRFV2/external/$IO_FORM_NAME[$IO_FORM]/diffwrf
+	
+				#	Are we skipping the OpenMP runs?
+	
+				if ( $ZAP_OPENMP == TRUE ) then
+					goto BYPASS_OPENMP_SUMMARY1
+				endif
+	
+				#	Are the files the same size?  If not, then only the initial times
+				#	will be compared.  That means, on a failure to run a forecast, the
+				#	diffwrf will give a pass.  We need to root out this evil.
+	
+				if ( ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[1] ) && \
+				     ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[2] ) ) then
+					set foo1 = ( ` \ls -ls $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[1] `)
+					set foo2 = ( ` \ls -ls $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[2] `)
+					set size1 = $foo1[6]
+					set size2 = $foo2[6]
+					if ( $size1 == $size2 ) then
+						set RIGHT_SIZE_OMP = TRUE
+					else
+						set RIGHT_SIZE_OMP = FALSE
+					endif
+				else
+					set RIGHT_SIZE_OMP = FALSE
+				endif
+	
+				BYPASS_OPENMP_SUMMARY1:
+	
+				if ( ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[1] ) && \
+				     ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3] ) ) then
+					set foo1 = ( ` \ls -ls $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[1] `)
+					set foo3 = ( ` \ls -ls $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3] `)
+					set size1 = $foo1[6]
+					set size3 = $foo3[6]
+					if ( $size1 == $size3 ) then
+						set RIGHT_SIZE_MPI = TRUE
+					else
+						set RIGHT_SIZE_MPI = FALSE
+					endif
+				else
+					set RIGHT_SIZE_MPI = FALSE
+				endif
+	
+				#	Are we skipping the OpenMP runs?
+	
+				if ( $ZAP_OPENMP == TRUE ) then
+					goto BYPASS_OPENMP_SUMMARY2
+				endif
+		
+				#	Serial vs OpenMP
+		
+				rm fort.88 fort.98 >& /dev/null
+				if ( ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[1] ) && \
+				     ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[2] ) && \
+				     ( $RIGHT_SIZE_OMP == TRUE ) ) then
+					$DIFFWRF $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[1] \
+					         $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[2] >& /dev/null
+				else
+					touch fort.88 fort.98
+				endif
+				if ( ! -e fort.88 ) then
+					echo "SUMMARY serial vs OMP  for $core physics $phys_option $esmf_lib_str            PASS" >>! ${DEF_DIR}/wrftest.output
+					echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+				else
+					echo "SUMMARY serial vs OMP  for $core physics $phys_option $esmf_lib_str            FAIL" >>! ${DEF_DIR}/wrftest.output
+					echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+				endif
+	
+				BYPASS_OPENMP_SUMMARY2:
+		
+				#	Serial vs MPI
+		
+				rm fort.88 fort.98 >& /dev/null
+				if ( ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[1] ) && \
+				     ( -e $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3] ) && \
+				     ( $RIGHT_SIZE_MPI == TRUE ) ) then
+					$DIFFWRF $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[1] \
+					         $TMPDIR/wrfout_d01_${filetag}.${core}.${phys_option}.$COMPOPTS[3] >& /dev/null
+				else
+					touch fort.88 fort.98
+				endif
+				if ( ! -e fort.88 ) then
+					echo "SUMMARY serial vs MPI  for $core physics $phys_option $esmf_lib_str            PASS" >>! ${DEF_DIR}/wrftest.output
+					echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+				else
+					echo "SUMMARY serial vs MPI  for $core physics $phys_option $esmf_lib_str            FAIL" >>! ${DEF_DIR}/wrftest.output
+					echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+				endif
+		
+				popd
+	
+			endif
+
+			# Generate and archive baseline or compare against baseline
+
+			if ( $core != nmm_real ) then
+				if ( $GENERATE_BASELINE != FALSE ) then
+					if ( ! -d $GENERATE_BASELINE ) then
+						echo "ERROR:  Baseline directory ${GENERATE_BASELINE} does not exist" >>! \
+						     ${DEF_DIR}/wrftest.output
+						exit ( 10 ) 
+					else
+						# Archive serial output file to baseline
+						pushd ${DEF_DIR}/regression_test/WRFV2/test/$core
+						set basefilenm = wrfout_d01_${filetag}.${core}.${phys_option}
+						set basefile = ${GENERATE_BASELINE}/${basefilenm}
+						set outfile = $TMPDIR/${basefilenm}.$COMPOPTS[1]
+						if ( -e $outfile ) then
+							cp $outfile $basefile || \
+							  ( echo "ERROR:  cannot copy ${outfile} to ${basefile}" >>! \
+							   ${DEF_DIR}/wrftest.output; exit 10 )
+						else
+							echo "ERROR:  Cannot archive baseline, file $outfile does not exist" >>! \
+							     ${DEF_DIR}/wrftest.output
+					echo "SUMMARY baseline archived in ${GENERATE_BASELINE} for $core physics $phys_option  FAIL" >>! \
+							     ${DEF_DIR}/wrftest.output
+							echo "-------------------------------------------------------------" >> \
+							     ${DEF_DIR}/wrftest.output
+							exit ( 10 ) 
+						endif
+					echo "SUMMARY baseline archived in ${GENERATE_BASELINE} for $core physics $phys_option  PASS" >>! \
+						     ${DEF_DIR}/wrftest.output
+						echo "-------------------------------------------------------------" >> \
+						     ${DEF_DIR}/wrftest.output
+						popd
+					endif
+				endif
+				if ( $COMPARE_BASELINE != FALSE ) then
+					if ( ! -d $COMPARE_BASELINE ) then
+						echo "${0}: ERROR::  Baseline directory ${COMPARE_BASELINE} does not exist" >>! \
+						     ${DEF_DIR}/wrftest.output
+						exit ( 10 ) 
+					else
+						# Compare against baseline output file
+						set basefilenm = wrfout_d01_${filetag}.${core}.${phys_option}
+						set basefile = ${COMPARE_BASELINE}/${basefilenm}
+						set DIFFWRF = ${DEF_DIR}/regression_test/WRFV2/external/$IO_FORM_NAME[$IO_FORM]/diffwrf
+						set testdir = ${DEF_DIR}/regression_test/WRFV2/test/$core
+						pushd ${testdir}
+						foreach compopt ( $COMPOPTS )
+							set cmpfile = $TMPDIR/${basefilenm}.$compopt
+							rm fort.88 fort.98 >& /dev/null
+							if ( ( -e ${basefile} ) && ( -e ${cmpfile} ) ) then
+								#	Are the files the same size?  If not, then only the initial times
+								#	will be compared.  That means, on a failure to run a forecast, the
+								#	diffwrf will give a pass.  We need to root out this evil.
+								set foob = ( ` \ls -ls ${basefile} `)
+								set fooc = ( ` \ls -ls ${cmpfile} `)
+								set sizeb = $foob[6]
+								set sizec = $fooc[6]
+								if ( $sizeb == $sizec ) then
+									$DIFFWRF ${basefile} ${cmpfile} >& /dev/null
+									if ( -e fort.88 ) then
+			echo "FAIL:  Baseline comparison, file ${cmpfile} did not match ${basefile} according to diffwrf" >>! \
+										${DEF_DIR}/wrftest.output
+									endif
+								else
+									touch fort.88 fort.98
+			echo "FAIL:  Baseline comparison, files ${cmpfile} and ${basefile} have different sizes" >>! \
+									${DEF_DIR}/wrftest.output
+								endif
+							else
+			echo "FAIL:  Baseline comparison, either ${cmpfile} or ${basefile} does not exist" >>! \
+									${DEF_DIR}/wrftest.output
+								touch fort.88 fort.98
+							endif
+							if ( ! -e fort.88 ) then
+			echo "SUMMARY compare vs baseline ${COMPARE_BASELINE} for $core physics $phys_option compopt $compopt $esmf_lib_str  PASS" >>! \
+								     ${DEF_DIR}/wrftest.output
+								echo "-------------------------------------------------------------" >> \
+								     ${DEF_DIR}/wrftest.output
+							else
+			echo "SUMMARY compare vs baseline ${COMPARE_BASELINE} for $core physics $phys_option compopt $compopt $esmf_lib_str  FAIL" >>! \
+								     ${DEF_DIR}/wrftest.output
+								echo "-------------------------------------------------------------" >> \
+								     ${DEF_DIR}/wrftest.output
+							endif
+						end
+						popd
+					endif
+				endif
+			else if ( $core == nmm_real ) then
+				if ( $GENERATE_BASELINE != FALSE ) then
+					if ( ! -d $GENERATE_BASELINE ) then
+						echo "ERROR:  Baseline directory ${GENERATE_BASELINE} does not exist" >>! \
+						     ${DEF_DIR}/wrftest.output
+						exit ( 10 ) 
+					else
+						# Archive serial output file to baseline
+						pushd ${DEF_DIR}/regression_test/WRFV2/test/$core
+						set basefilenm = wrfout_d01_${filetag}.${core}.${phys_option}
+						set basefile = ${GENERATE_BASELINE}/${basefilenm}
+						set outfile = $TMPDIR/${basefilenm}.$COMPOPTS[3]_1p
+						if ( -e $outfile ) then
+							cp $outfile $basefile || \
+							  ( echo "ERROR:  cannot copy ${outfile} to ${basefile}" >>! \
+							   ${DEF_DIR}/wrftest.output; exit 10 )
+						else
+							echo "ERROR:  Cannot archive baseline, file $outfile does not exist" >>! \
+							     ${DEF_DIR}/wrftest.output
+					echo "SUMMARY baseline archived in ${GENERATE_BASELINE} for $core physics $phys_option  FAIL" >>! \
+							     ${DEF_DIR}/wrftest.output
+							echo "-------------------------------------------------------------" >> \
+							     ${DEF_DIR}/wrftest.output
+							exit ( 10 ) 
+						endif
+					echo "SUMMARY baseline archived in ${GENERATE_BASELINE} for $core physics $phys_option  PASS" >>! \
+						     ${DEF_DIR}/wrftest.output
+						echo "-------------------------------------------------------------" >> \
+						     ${DEF_DIR}/wrftest.output
+						popd
+					endif
+				endif
+				if ( $COMPARE_BASELINE != FALSE ) then
+					if ( ! -d $COMPARE_BASELINE ) then
+						echo "${0}: ERROR::  Baseline directory ${COMPARE_BASELINE} does not exist" >>! \
+						     ${DEF_DIR}/wrftest.output
+						exit ( 10 ) 
+					else
+						# Compare against baseline output file
+						set basefilenm = wrfout_d01_${filetag}.${core}.${phys_option}
+						set basefile = ${COMPARE_BASELINE}/${basefilenm}
+						set DIFFWRF = ${DEF_DIR}/regression_test/WRFV2/external/$IO_FORM_NAME[$IO_FORM]/diffwrf
+						set testdir = ${DEF_DIR}/regression_test/WRFV2/test/$core
+						pushd ${testdir}
+						set compopt = $COMPOPTS[3]
+						foreach proc ( 1p 4p )
+							set cmpfile = $TMPDIR/${basefilenm}.${compopt}_${proc}
+							rm fort.88 fort.98 >& /dev/null
+							if ( ( -e ${basefile} ) && ( -e ${cmpfile} ) ) then
+								#	Are the files the same size?  If not, then only the initial times
+								#	will be compared.  That means, on a failure to run a forecast, the
+								#	diffwrf will give a pass.  We need to root out this evil.
+								set foob = ( ` \ls -ls ${basefile} `)
+								set fooc = ( ` \ls -ls ${cmpfile} `)
+								set sizeb = $foob[6]
+								set sizec = $fooc[6]
+								if ( $sizeb == $sizec ) then
+									$DIFFWRF ${basefile} ${cmpfile} >& /dev/null
+									if ( -e fort.88 ) then
+			echo "FAIL:  Baseline comparison, file ${cmpfile} did not match ${basefile} according to diffwrf" >>! \
+										${DEF_DIR}/wrftest.output
+									endif
+								else
+									touch fort.88 fort.98
+			echo "FAIL:  Baseline comparison, files ${cmpfile} and ${basefile} have different sizes" >>! \
+									${DEF_DIR}/wrftest.output
+								endif
+							else
+			echo "FAIL:  Baseline comparison, either ${cmpfile} or ${basefile} does not exist" >>! \
+									${DEF_DIR}/wrftest.output
+								touch fort.88 fort.98
+							endif
+							if ( ! -e fort.88 ) then
+			echo "SUMMARY compare vs baseline ${COMPARE_BASELINE} for $core physics $phys_option compopt $compopt $esmf_lib_str  PASS" >>! \
+								     ${DEF_DIR}/wrftest.output
+								echo "-------------------------------------------------------------" >> \
+								     ${DEF_DIR}/wrftest.output
+							else
+			echo "SUMMARY compare vs baseline ${COMPARE_BASELINE} for $core physics $phys_option compopt $compopt $esmf_lib_str  FAIL" >>! \
+								     ${DEF_DIR}/wrftest.output
+								echo "-------------------------------------------------------------" >> \
+								     ${DEF_DIR}/wrftest.output
+							endif
+						end
+						popd
+					endif
+				endif
+				goto ALL_SHE_WROTE_FOR_NMM
+			endif
+			# End of generate and archive baseline or compare against baseline
+
+		endif
+
+		BOTTOM_OF_PHYSICS_LOOP:
+		
+	end
+
+ALL_SHE_WROTE_FOR_NMM:
+
+	echo "-------------------------------------------------------------" >> ${DEF_DIR}/wrftest.output
+
+        if ( $clrm ) then
+          popd
+        endif
+		
+end
+
+
+#	How long did this take.
+
+set end = ( `date` )
+echo "Start WRF Regression: $start " >> ${DEF_DIR}/wrftest.output
+echo "End   WRF Regression: $end   " >> ${DEF_DIR}/wrftest.output
+
+#	We have done all of the tests, and placed the PASS FAIL labels in the
+#	output file.  If there are any FAIL messages, we are in trouble.
+
+grep FAIL ${DEF_DIR}/wrftest.output
+set ok = $status
+
+#	Send email of the status.
+
+if ( $ok == 0 ) then
+	$MAIL -s "REGRESSION FAILURE $ARCH[1] " $FAIL_MAIL < ${DEF_DIR}/wrftest.output
+else
+	$MAIL -s "REGRESSION SUCCESS $ARCH[1] " $GOOD_MAIL < ${DEF_DIR}/wrftest.output
+endif
+
+#	Clean left up detritus
+
+cd $CUR_DIR
+
+rm -rf dom_*eal >& /dev/null
+rm -rf phys_real_* >& /dev/null
+rm -rf phys_quarter_* >& /dev/null
+rm -rf phys_b_wave_* >& /dev/null
+rm -rf version_info >& /dev/null
+rm -rf machfile >& /dev/null
+rm -rf fdda_real* >& /dev/null
+rm -rf time_real_* >& /dev/null
+rm -rf dyn_real_* >& /dev/null
Index: trunk/WRF.COMMON/WRFV2/tools/safe
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/safe	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/safe	(revision 2744)
@@ -0,0 +1,12 @@
+#!/bin/csh
+
+# reverse the effect of danger
+
+if ( ! -d  tools ) then
+ echo 'must be run in top level dir'
+endif
+
+foreach f ( */Makefile.saved )
+  /bin/mv $f $f:r
+end
+
Index: trunk/WRF.COMMON/WRFV2/tools/subinfo
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/subinfo	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/subinfo	(revision 2744)
@@ -0,0 +1,223 @@
+#!/bin/perl
+
+$dbdir = "tools/code_dbase" ;
+
+if ( ! opendir( TOOLDIR, "tools") )  {
+  print "\nMust be in top level WRF directory\n" ;
+  exit ;
+}
+closedir TOOLDIR ;
+
+$gofast=0 ;
+if ( ( scalar @ARGV  < 1 ) || ( scalar @ARGV > 2 ) )  {
+  print "usage: subinfo routinename \n" ;
+  print "       subinfo rebuild \n" ;
+  exit ;
+}
+if ( ( scalar @ARGV == 2 ) ) { $gofast = 1 ; }  # don't bother with links for argument lists
+
+if ( ! open( XXX, "$dbdir/calls" ) || $ARGV[0] eq "rebuild" )
+{
+  print "Building code database ... please wait.\n" ;
+  system( "cd tools/CodeBase ; make" ) ;
+  open P, "tools/build_codebase |&" ; while (<P>) { print ; } close P ;
+  system( "ln -sf tools/subinfo ." ) ;
+  system( "ln -sf tools/wrfvar ." ) ;
+  if ( $ARGV[0] eq "rebuild" ) { exit ; }
+}
+close XXX ;
+
+
+$rout1 = lc $ARGV[0] ;
+$rout = $rout1 ;
+#print $vname,"\n" ;
+#print $rout,"\n" ;
+
+$routfile = $dbdir."/".$rout ;
+
+if ( ! ( open( ROUT, "< $routfile" )) ) {
+  print "$rout is not a known subprogram. \n" ;
+  open P, "/bin/ls -1 $dbdir/\*$rout\* | " ;
+  print "Perhaps you mean:\n" ;
+  while (<P>) {
+    s/.*\/// ;
+    if ( substr( $_, 0, 3 ) eq "lm_" ) { next ; }
+    if ( $_ =~ "not found" ) { break ; }
+    print "  $_" ;
+  }
+  exit ;
+}
+
+#open ROUT, "< $routfile" or { print "$rout is not a known subprogram. Perhaps you mean:\n" ; }
+#  system( "/bin/ls -1 $dbdir/\*$rout\*" ) ;
+#  die ;
+
+while ( <ROUT> ) {
+  @t = split ' ' ; 
+  if ( $t[0] eq sourcefile ) {
+    $sourcefile = $t[1] ;
+  }
+  if ( $t[0] eq subprogram ) {
+    if ( $t[1] eq "function" ) {
+      $subprog = $t[2]." ".$t[1] ;
+    } else {
+      $subprog = $t[1] ;
+    }
+  }
+}
+close ROUT ;
+
+print "<html>\n" ;
+print "<title> ",ucfirst $subprog," : ",uc $rout1," </title>\n" ;
+print "<body>\n" ;
+print "<h1> ",ucfirst $subprog," : ",uc $rout1," </h1> \n" ;
+
+# see if there is a 'big-f' file...
+$refer_to = $sourcefile ;
+$tail =  substr( $sourcefile, length( $sourcefile ) - 2 ) ;
+if ( "$tail" eq ".f" ) {
+   $refer_to = substr( $sourcefile, 0, length( $sourcefile ) - 2 ) . ".F" ;
+   if ( ! ( open( EXISTNCE, "< $refer_to" )) ) {
+      $refer_to = $sourcefile ;
+   }
+   else { close EXISTNCE ; }
+}
+
+#print "<b> Defined in: </b> <a href=\"../../$refer_to\"> $refer_to </a> <p> <p>\n" ;
+# have it point to the wrf code browser instead
+$rout1_uc = uc $rout1 ;
+print "<b> Defined in: </b> <a href=\"../../../wrfbrowser/html_code/${refer_to}.html#$rout1_uc\"> $refer_to </a> <p> <p>\n" ;
+
+if ( open (DESC, "< ${routfile}_descrip" ) ) {
+  print "<b> Description: </b><p>\n" ;
+  while ( <DESC> ) {
+    print ;
+  }
+  print "<p>\n" ;
+  close DESC ;
+}
+
+
+print "<b> Called by : </b> <p> <p>\n" ;
+print "<pre>\n" ;
+@sysargs = ( "tools/subinfo_calls", 0, "$rout" ) ;
+open BBB , "tools/subinfo_calls 0 $rout | " ;
+while ( <BBB> ) { print ; }
+close BBB ;
+print "</pre>\n" ;
+
+$first=1 ;
+$use_entry = 0 ;
+open ROUT, "< $routfile" or die "can not open $routfile" ;
+while ( <ROUT> ) {
+  @t = split ' ' ; 
+  if ( $t[0] eq "use" ) {
+    if ( $first == 1 ) {
+      print "<b> Uses: </b> <p> <p>\n<pre>\n" ;
+      $use_entry = 1 ;
+      $first = 0 ;
+    }
+    printf("  %-30s    ",uc $t[1] ) ;
+    open P,"/bin/ls */*.F | grep -w $t[1] |" ;
+    while( <P> ) {
+      chop ;
+#      printf("(<a href=\"../../%s\">%s</a>)\n", $_, $_ ) ;
+      printf("(<a href=\"../../../wrfbrowser/html_code/%s.html#%s\">%s</a>)\n", $_, uc $t[1], $_ ) ;
+    }
+    close P ;
+  }
+}
+if ( $use_entry == 1 ) { print "</pre>\n" ; }
+close ROUT ;
+
+print "<b> Arguments: </b> <p> <p>\n" ;
+print "<pre>\n" ;
+
+open ROUT, "< $routfile" or die "can not open $routfile" ;
+$i = 1 ;
+while ( <ROUT> ) {
+  @t = split ' ' ; 
+  if ( $t[0] eq arg && $t[9] eq dummyarg ) {
+    printf("%3d.",$i++) ;
+    $vfile = "$dbdir/vv_" . $rout1 . "_" . $t[3] . ".html" ;
+    if ( $gofast == 0 ) {
+      system ( "echo '<html><pre>' > $vfile ; tools/wrfvar $t[3] $rout1 >> $vfile ; echo '</pre></html>' >> $vfile"  ) ;
+    }
+    $intent = "INTENT( ".uc $t[7]." )" ;
+    if ( $t[11] ne "" ) {
+       $dims = "DIMENSION( ".$t[11]." )" ;
+       $vfile = "vv_" . $rout1 . "_" . $t[3] . ".html" ;
+       printf(" <a href=\"%s\">%-12s</a> :: %-8s, %-16s, %s\n",$vfile,$t[3], uc $t[5], $intent, $dims ) ;
+    } else {
+       $vfile = "vv_" . $rout1 . "_" . $t[3] . ".html" ;
+       printf(" <a href=\"%s\">%-12s</a> :: %-8s, %-16s\n",$vfile,$t[3], uc $t[5], $intent ) ;
+    }
+  }
+}
+close ROUT ;
+print "</pre>\n" ;
+
+$first = 1 ;
+open CALLEES, "< $dbdir/calls" or die " cannot open $dbdir/calls " ;
+while ( <CALLEES> ) { 
+   @t = split ' ' ;
+   if ( $t[0] eq lc $rout && $t[1] eq calls && ! ($t[2] =~ add_msg) && !($t[2] =~ reset_msgs) && !($t[2] =~ stencil) && !($t[2] =~ wrf_debug) 
+        && (substr($t[2],0,4) ne "get_") )  {
+     if ( $first == 1 ) {
+       print "<b>",uc $rout," calls : </b> <p> <p>\n" ;
+#       print "<pre>\n" ;
+       print "<table>\n" ;
+       $first = 2 ;
+     }
+     open C ,"< $dbdir/$t[2]" ;
+     while ( <C> ) {
+       @u = split ' ' ;
+       if ( $u[0] eq sourcefile ) { $sf = $u[1] ; break ; }
+     }
+     close C ;
+     # see if there is a 'big-f' file...
+     $refer_to = $sf ;
+     $tail =  substr( $sf, length( $sf ) - 2 ) ;
+     if ( "$tail" eq ".f" ) {
+        $refer_to = substr( $sf, 0, length( $sf ) - 2 ) . ".F" ;
+        if ( ! ( open( EXISTNCE, "< $refer_to" )) ) {
+           $refer_to = $sf ;
+        }
+        else { close EXISTNCE ; }
+     }
+     $sf = $refer_to ;
+     printf("<tr><td><a href=\"%s\.html\">%30s</a></td><td>(<a href=\"../../%s\">%s</a>)</td></tr>\n",$t[2], $t[2],$sf,$sf) ;
+   }
+}
+if ( $first == 2 ) {
+  print "</table>\n" ;
+}
+
+
+
+print "</html>\n" ;
+
+exit
+
+#if ( $found_var == 0 ) {
+#  print uc $vname , "is not an argument to ${rout1}.  May be local or use-associated.\n" ;
+#  print ucfirst $rout1," has $nargs_rout arguments.\n" ;
+#  close ROUT ;
+#  open ROUT, "< $routfile" or die "can not open $routfile" ;
+#  while ( <ROUT> )
+#  {
+#    s/^  *// ;
+#    s/  */ /g ;
+#    @t = split ' ' ;
+#    if ( $t[0] eq "arg" ) {
+#      $i = $t[1] + 1 ;
+#      printf("%3d. ",$i) ;
+#      print uc $t[3]," of type ", uc $t[5],", intent ",uc $t[7],"\n" ;
+#    }
+#  }
+#  close ROUT ;
+#}
+
+
+
+
Index: trunk/WRF.COMMON/WRFV2/tools/sym.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/sym.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/sym.c	(revision 2744)
@@ -0,0 +1,161 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+/* sym.c
+
+    Implementation dependent routines for using symtab_gen.c
+    in N32 .
+
+*/
+
+#include <stdio.h>
+#include "sym.h"
+
+extern sym_nodeptr symget() ;
+
+static char ** symtab ;  /* 2-19-90 */
+
+int
+sym_init() /* 2-19-90, initialize symbol table package */
+{
+    create_ht( &symtab ) ;
+    if (symtab == NULL) 
+    {
+	fprintf(stderr,"init_sym(): could not create hash table") ;
+	exit(1) ;
+    }
+    return(0) ;
+}
+
+sym_nodeptr
+sym_add( name )
+char * name ;
+{
+    sym_nodeptr new_sym_node(); 
+    char **node_name() ;
+    sym_nodeptr *node_next() ;
+    return( symget( name, new_sym_node, node_name, node_next, symtab, 1 ) ) ;
+}
+
+sym_nodeptr
+sym_get( name )
+char * name ;
+{
+    sym_nodeptr new_sym_node(); 
+    char **node_name() ;
+    sym_nodeptr *node_next() ;
+    return( symget( name, new_sym_node, node_name, node_next, symtab, 0 ) ) ;
+}
+
+sym_nodeptr
+new_sym_node()
+{
+    void * malloc() ;
+    sym_nodeptr p ;
+    p = (sym_nodeptr) malloc( sizeof( struct sym_node ) ) ;
+    p->name = NULL ;
+    p->next = NULL ;
+
+    return( p ) ;
+}
+
+char **
+node_name(p)
+sym_nodeptr p ;
+{
+    char ** x ;
+    x = &(p->name) ;
+    return( x ) ;
+}
+
+sym_nodeptr *
+node_next(p)
+sym_nodeptr p ;
+{
+    sym_nodeptr *x ;
+    x = &(p->next) ;
+    return( x ) ;
+}
+
+int
+show_entry(x)
+sym_nodeptr x ;
+{
+  int i ;
+  if ( x == NULL ) return(0) ;
+  printf("Symbol table entry:\n") ;
+  printf("lexeme %s\n", x->name ) ;
+  printf("   dim %s\n", (x->dim==1?"M":(x->dim==2?"N":"O")) ) ;
+  printf(" ndims %d\n", x->ndims ) ;
+  for ( i = 0 ; i < x->ndims && i < 7 ; i++ )
+    printf(" dim %d -> %s\n",i,(x->dims[i]==1?"M":(x->dims[i]==2?"N":"O")) ) ;
+  return(0) ;
+}
+
+/* MEMORY LEAK !!!! -- this just abandons the old table and leaves on the heap. */
+/* The registry mechanism is not a long-running program and is not apt to 
+   run into memory problems.  Might want to fix this anyway, though, someday. */
+int
+sym_forget() 
+{
+  create_ht( &symtab ) ;
+  if (symtab == NULL)
+  {
+      fprintf(stderr,"init_sym(): could not create hash table") ;
+      exit(1) ;
+  }
+  return(0) ;
+}
+
Index: trunk/WRF.COMMON/WRFV2/tools/sym.h
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/sym.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/sym.h	(revision 2744)
@@ -0,0 +1,95 @@
+/***********************************************************************
+     
+                              COPYRIGHT
+     
+     The following is a notice of limited availability of the code and 
+     Government license and disclaimer which must be included in the 
+     prologue of the code and in all source listings of the code.
+     
+     Copyright notice
+       (c) 1977  University of Chicago
+     
+     Permission is hereby granted to use, reproduce, prepare 
+     derivative works, and to redistribute to others at no charge.  If 
+     you distribute a copy or copies of the Software, or you modify a 
+     copy or copies of the Software or any portion of it, thus forming 
+     a work based on the Software and make and/or distribute copies of 
+     such work, you must meet the following conditions:
+     
+          a) If you make a copy of the Software (modified or verbatim) 
+             it must include the copyright notice and Government       
+             license and disclaimer.
+     
+          b) You must cause the modified Software to carry prominent   
+             notices stating that you changed specified portions of    
+             the Software.
+     
+     This software was authored by:
+     
+     Argonne National Laboratory
+     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
+     Mathematics and Computer Science Division
+     Argonne National Laboratory, Argonne, IL  60439
+     
+     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES 
+     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, 
+     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A 
+     CONTRACT WITH THE DEPARTMENT OF ENERGY.
+     
+                      GOVERNMENT LICENSE AND DISCLAIMER
+     
+     This computer code material was prepared, in part, as an account 
+     of work sponsored by an agency of the United States Government.
+     The Government is granted for itself and others acting on its 
+     behalf a paid-up, nonexclusive, irrevocable worldwide license in 
+     this data to reproduce, prepare derivative works, distribute 
+     copies to the public, perform publicly and display publicly, and 
+     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT 
+     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF 
+     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR 
+     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, 
+     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, 
+     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD 
+     NOT INFRINGE PRIVATELY OWNED RIGHTS.
+
+***************************************************************************/
+#ifndef SYM_H
+#define SYM_H
+
+/* file: sym.h
+
+    Header info for symbol table module.
+
+*/
+
+typedef struct sym_node * sym_nodeptr ;
+
+struct sym_node
+{
+    char * name ;		/* lexeme */
+    sym_nodeptr next ;		/* pointer to next node in symbol table */
+/* fields that are associated with dimension declaration constants */
+    unsigned char dim ;
+/* fields that are associated with arrays */
+    int ndims ;
+    int MDEX ;		/* which index is the M dimension */
+    int NDEX ;		/* which index is the N dimension */
+    unsigned char dims[7] ;
+    char dimname[7][64] ;
+/* name of temporary variable associated with string. variable */
+    char varx[32] ;
+/* name of core association, July 2004 */
+    char core_name[64] ;
+/* internal name of variable associated with dataname entry, July 2004 */
+    char internal_name[64] ;
+/* fields associated with integer scalar variables */
+    unsigned long assigned ; 	/* pointer to assignment statement */
+    unsigned long thisif ;
+    int iflev ;
+    int marked ;		/* general purpose marker */
+} ;
+
+sym_nodeptr sym_add() ;
+sym_nodeptr sym_get() ;
+
+#endif
Index: trunk/WRF.COMMON/WRFV2/tools/symtab_gen.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/symtab_gen.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/symtab_gen.c	(revision 2744)
@@ -0,0 +1,203 @@
+/*  symtab.c 
+
+Symbol Table Handler -- Generic
+
+The routine symget() returns a pointer to a C structure matching a
+given lexeme.  If the lexeme does not already exist in the symbol
+table, the routine will create a new symbol structure, store it, and
+then return a pointer to the newly created structure.
+
+It is up to the calling module to declare the symbol structure as
+well as several routines for manipulating the symbol structure.  The
+routines are passed to symget as pointers.
+
+	name	   type		description
+
+	newnode()   *char	returns a pointer to a symbol structure.
+
+	nodename()  **char	retrieves the lexeme name from a symbol
+				structure, returned as a pointer to a 
+				character array.
+	
+	nodenext()  **char	retrieves pointer to the next field of
+				the symbol structure (the next field
+				is itself a pointer to a symbol structure)
+
+For a sample main or calling program see the end of this file.
+
+****
+  REVISED 2-19-90.  Added code to make hashtable interchangible.
+	new routine: create_ht()	creates new hashtable
+	rev routine: symget()		added parameter to pass hash table
+*/
+
+#include <stdio.h>
+#include <string.h>
+#include <strings.h>
+
+#define HASHSIZE 1024
+
+/*  commented out 2-29-90
+static char * symtab[HASHSIZE] ;	
+*/
+
+void * malloc() ;
+void * calloc() ;
+
+char * symget(name,newnode,nodename,nodenext,symtab,flag)
+char *name ;
+char *(*newnode)(), **(*nodename)(), **(*nodenext)() ;
+char *symtab[] ;
+int flag ;		/* 1 is create if not there, 0 return NULL if not there */
+{
+    int index ; 
+    int found ;
+    register char *s ;
+    register char *t ;
+    char **x ;
+    char *p ;
+
+    index = hash( name ) ;
+    p = symtab[index] ;
+    found = 0 ;
+
+    while (p) {
+        s = name ;
+	t = *(*nodename)(p) ;
+	while (*s && *t && *s == *t ) {
+	    s++ ;
+	    t++ ;
+	}
+	if (!*s && !*t) {
+	    found = 1 ;
+	    break ;
+	}
+	p = *(*nodenext)(p) ;
+    }
+
+    if (!found ) {
+      if (flag ) {
+        p = (*newnode)() ;
+        x =  (*nodename)(p) ;
+        *x = (char *) malloc(strlen(name)+1) ;
+        strcpy(*x,name) ;
+        x =  (*nodenext)(p) ;
+        *x = symtab[index] ;
+        symtab[index] = p ;
+      } else {
+        return(NULL) ;
+      }
+    }
+
+    return(p) ;
+}
+
+hash(name)
+char * name ;
+{
+    register int result = 0  ;
+    register char * p = name ;
+
+    while (*p)
+	result = 3*result + (int)*p++ ;
+    
+    result = result % HASHSIZE ;
+    while (result < 0)
+	result = result + HASHSIZE ;
+    return(result) ;
+}
+
+
+/* added 2-19-90, attaches a new hash table to pointer  */
+
+int
+create_ht( p )
+char *** p ; 
+{
+    *p = (char **) calloc( HASHSIZE , sizeof( char * ) ) ;
+    return(0) ;
+}
+
+
+/* added 4-15-92.
+
+This is a generic routine that, given a hash table pointer,
+will traverse the hash table and apply a caller supplied
+function to each entry
+
+*/
+
+int
+sym_traverse( ht, nodenext, f )
+char *ht[] ;
+char **(*nodenext)() ;
+void (*f)() ;
+{
+    char * p, **x ;
+    int i ;
+    for ( i = 0 ; i < HASHSIZE ; i++ )
+    {
+	if ( ( p = ht[i] ) != NULL )
+	{
+	    while ( p )
+	    {
+		 (*f)(p) ;
+		 x = (*nodenext)(p) ;
+		 p = *x ;
+	    }
+	}
+    }
+    return(0) ;
+}
+
+/**********************************************************************/
+/**********************************************************************/
+/**********************************************************************/
+
+#ifdef COMMENTOUTSAMPLE
+/* sample_main.c
+
+    sample main program for symget() in the file symtab.c
+
+*/
+
+#include <stdio.h>
+
+struct symnode {
+    char * name ;
+    struct symnode *next ;
+} ;
+
+extern struct symnode * symget() ;
+
+struct symnode *
+newnode()
+{
+    struct symnode * malloc() ;
+    return( malloc( sizeof( struct symnode ) ) ) ;
+}
+
+char **
+nodename(p)
+struct symnode *p ;
+{
+    char ** x ;
+    x = &(p->name) ;
+    return( x ) ;
+}
+
+struct symnode **
+nodenext(p)
+struct symnode *p ;
+{
+    struct symnode **x ;
+    x = &(p->next) ;
+    return( x ) ;
+}
+
+#endif
+
+/**********************************************************************/
+/**********************************************************************/
+/**********************************************************************/
+
Index: trunk/WRF.COMMON/WRFV2/tools/testomatic
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/testomatic	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/testomatic	(revision 2744)
@@ -0,0 +1,54 @@
+#!/bin/csh
+
+# Bare bones little script that compiles every architecture on a machine
+# JM, 2004 10 13
+
+/bin/rm -f testomatic.log
+
+# First find out how many we got on this box.
+
+if ( ! -e configure ) then
+   echo 'Can not find configure script.  Running in the top level directory?'
+   exit 2
+endif
+
+set n = `((echo '-1' | ./configure) | sed '1,/Please select from among the following supported platforms/d' ) | grep '^  [ 1-9][0-9]' | wc | awk '{print $1}' `
+
+echo "Number of options to test: $n" >>& testomatic.log
+
+set i=1
+while ( $i <= $n )
+
+  echo "$i -------------- clean ----------------" >>& testomatic.log
+
+  clean -a >>& testomatic.log
+
+  echo "$i -------------- configure ----------------" >>& testomatic.log
+
+  echo $i | configure  >>& testomatic.log
+
+  echo "$i -------------- compile  ----------------" >>& testomatic.log
+
+  compile em_real >>& testomatic.log
+
+  if ( ( -e main/wrf.exe ) && ( -e main/real.exe ) && ( -e main/ndown.exe ) ) then
+    if ( ( -x main/wrf.exe ) && ( -x main/real.exe ) && ( -x main/ndown.exe ) ) then
+
+      echo "$i -------------- build ok  ---------------" >>& testomatic.log
+
+    else
+
+      echo "$i -------------- build, not exec  --------" >>& testomatic.log
+    
+    endif
+
+  else
+
+    echo "$i -------------- broken build  -----------" >>& testomatic.log
+
+  endif
+
+  @ i += 1
+
+end
+
Index: trunk/WRF.COMMON/WRFV2/tools/type.c
===================================================================
--- trunk/WRF.COMMON/WRFV2/tools/type.c	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/tools/type.c	(revision 2744)
@@ -0,0 +1,264 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+
+#include "registry.h"
+#include "protos.h"
+#include "data.h"
+
+int
+init_type_table()
+{
+  node_t *p ;
+  p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "integer" )   ; add_node_to_end ( p , &Type ) ;
+  p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "real" )      ; add_node_to_end ( p , &Type ) ;
+  p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "logical" )   ; add_node_to_end ( p , &Type ) ;
+  p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "character*256" ) ; add_node_to_end ( p , &Type ) ;
+  p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "doubleprecision" ) ; add_node_to_end ( p , &Type ) ;
+  return(0) ;
+}
+
+int
+set_state_dims ( char * dims , node_t * node )
+{
+  int modifiers ;
+  node_t *d ;
+  char *c ;
+
+  if ( dims == NULL ) dims = "-" ;
+  modifiers = 0 ;
+  node->proc_orient = ALL_Z_ON_PROC ;  /* default */
+  node->ndims = 0 ;
+  node->boundary_array = 0 ;
+
+  for ( c = dims ; *c ; c++ )
+  {
+    if      ( *c == 'f' )
+    {
+      node->scalar_array_member = 1 ;
+      modifiers = 1 ;
+    }
+    else if ( *c == 't' )
+    {
+      node->has_scalar_array_tendencies = 1 ;
+      modifiers = 1 ;
+    }
+    else if ( *c == 'x' )
+    {
+      node->proc_orient = ALL_X_ON_PROC ;
+      modifiers = 1 ;
+    }
+    else if ( *c == 'y' )
+    {
+      node->proc_orient = ALL_Y_ON_PROC ;
+      modifiers = 1 ;
+    }
+    else if ( *c == 'b' )
+    {
+      node->boundary_array = 1 ;
+      modifiers = 1 ;
+    }
+    else if ( *c == '-' )
+    {
+      break ;
+    }
+    else if ( modifiers == 0 )
+    {
+      if (( d = get_dim_entry ( *c )) == NULL ) { return(1) ; }
+      node->dims[node->ndims++] = d ;
+    }
+  }
+  return (0) ;
+}
+ 
+node_t *
+get_4d_entry ( char * name )
+{
+  node_t *p ;
+  if ( name == NULL ) return (NULL)  ;
+  for ( p = FourD ; p != NULL ; p = p->next4d )
+  {
+    if ( !strcmp( p->name , name ) )
+    {
+      return(p) ;
+    }
+  }
+  return(NULL) ;
+}
+
+node_t *
+get_type_entry ( char * typename )
+{
+  return(get_entry(typename,Type)) ;
+}
+
+node_t *
+get_rconfig_entry ( char * name )
+{
+  node_t * p ;
+  if ((p=get_entry(name,Domain.fields))==NULL) return(NULL) ;
+  if (p->node_kind & RCONFIG) return(p) ;
+  return(NULL) ;
+}
+
+node_t *
+get_entry ( char * name , node_t * node )
+{
+  node_t *p ;
+  if ( name == NULL ) return (NULL)  ;
+  if ( node == NULL ) return (NULL)  ;
+  for ( p = node ; p != NULL ; p = p->next )
+  {
+    if ( !strcmp( name , "character" ) )
+    {
+      if ( !strncmp( p->name , name, 9 ) )
+      {
+        return(p) ;
+      }
+    } else {
+      if ( !strcmp( p->name , name ) )
+      {
+        return(p) ;
+      }
+    }
+
+    
+  }
+  return(NULL) ;
+}
+
+/* this gets the entry for the node even if it           */
+/* is a derived data structure; does this by following   */
+/* the fully specified f90 reference.  For example:      */
+/* "xa%f" for the field of derived type xa.              */
+/* note it will also take care to ignore the _1 or _2    */
+/* suffixes from variables that have ntl > 1             */
+/* 11/10/2001 -- added use field; if the entry has a use */
+/* that starts with "dyn_" and use doesn't correspond to */
+/* that, skip that entry and continue                    */
+
+node_t *
+get_entry_r ( char * name , char * use , node_t * node )
+{
+  node_t *p ;
+  char tmp[NAMELEN], *t1, *t2 ;
+
+  if ( name == NULL ) return (NULL)  ;
+  if ( node == NULL ) return (NULL)  ;
+
+  for ( p = node ; p != NULL ; p = p->next )
+  {
+    if ( !strncmp( use, "dyn_", 4 ) && !strncmp( p->use, "dyn_", 4 ) && strcmp( p->use, use ) )
+    {
+      continue ;
+    }
+
+    strcpy( tmp, name ) ;
+
+    /* first check for exact match */
+    if ( !strcmp( p->name , tmp ) )
+    {
+      return(p) ;
+    }
+
+    t1 = NULL ;
+    if ((t1 = index(tmp,'%'))!= NULL ) *t1 = '\0' ;
+
+    if ( p->ntl > 1 )
+    {
+      if (( t2 = rindex( tmp , '_' )) != NULL )
+      {
+         /* be sure it really is an integer that follows the _ and that */
+         /* that is that is the last character                          */
+         if ((*(t2+1) >= '0' && *(t2+1) <= '9') && *(t2+2)=='\0') *t2 = '\0' ;
+      }
+    }
+
+    /* also allow _tend */
+    if (( t2 = rindex( tmp , '_' )) != NULL ) {
+         if (!strcmp(t2,"_tend")) *t2 = '\0' ;
+    }
+
+    /* also allow _tend */
+    if (( t2 = rindex( tmp , '_' )) != NULL ) {
+         if (!strcmp(t2,"_old")) *t2 = '\0' ;
+    }
+
+    if ( !strcmp( p->name , tmp ) )
+    {
+      if ( t1 != NULL ) return( get_entry_r( t1+1 , use , p->type->fields ) ) ;
+      return(p) ;
+    }
+  }
+  return(NULL) ;
+}
+
+
+node_t *
+get_dimnode_for_coord ( node_t * node , int coord_axis )
+{
+  int i ;
+  if ( node == NULL ) return(NULL) ;
+  for ( i = 0 ; i < node->ndims ; i++ )
+  {
+    if ( node->dims[i] == NULL ) continue ;
+    if ( node->dims[i]->coord_axis == coord_axis )
+    {
+      return(node->dims[i]) ;
+    }
+  }
+  return(NULL) ;
+}
+
+int 
+get_index_for_coord ( node_t * node , int coord_axis )
+{
+  int i ;
+  if ( node == NULL ) return( -1 ) ;
+  for ( i = 0 ; i < node->ndims ; i++ )
+  {
+    if ( node->dims[i] == NULL ) continue ;
+    if ( node->dims[i]->coord_axis == coord_axis )
+    {
+      return(i) ;
+    }
+  }
+  return(-1) ;
+}
+
+
+char *
+set_mem_order( node_t * node , char * str , int n )
+{
+  int i ;
+  node_t * p ;
+  
+  if ( str == NULL || node == NULL ) return(NULL) ;
+  strcpy(str,"") ;
+  if ( node->boundary_array )
+  {
+     strcpy(str, "C") ;  /* if this is called for a boundary array, just give it a   */
+                         /* "reasonable" value and move on.                          */
+  }
+  else
+  {
+    if ( node->ndims <= 0 )
+    {
+      strcat(str,"0") ; return(str) ;
+    }
+    for ( i = 0 ; i < node->ndims && i < n  ; i++ )
+    {
+      p = node->dims[i] ;
+      switch( p->coord_axis )
+      {
+      case(COORD_X) : strcat(str,"X") ; break ;
+      case(COORD_Y) : strcat(str,"Y") ; break ;
+      case(COORD_Z) : strcat(str,"Z") ; break ;
+      case(COORD_C) : strcat(str,"C") ; break ;
+      default : break ;
+      }
+    }
+  }
+  return(str) ;
+}
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/arch
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/arch	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/arch	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/arch
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/arch.fcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/arch.fcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/arch.fcm	(revision 2744)
@@ -0,0 +1,1 @@
+link arch/arch-linux-ifort_meso.fcm
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/ioipsl
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/ioipsl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/ioipsl	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/ioipsl
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dyn3d
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dyn3d	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dyn3d	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/dyn3d
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dyn3d_common
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dyn3d_common	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dyn3d_common	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/dyn3d_common
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dyn3dpar
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dyn3dpar	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dyn3dpar	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/dyn3dpar
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dynphy_lonlat
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dynphy_lonlat	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/dynphy_lonlat	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/dynphy_lonlat
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/filtrez
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/filtrez	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/filtrez	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/filtrez
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/grid
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/grid	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/grid	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/grid
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/misc
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/misc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/misc	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/misc
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/phy_common
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/phy_common	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/phy_common	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/phy_common
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/phyvenus
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/phyvenus	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf/phyvenus	(revision 2744)
@@ -0,0 +1,1 @@
+link ../libf_gcm/phyvenus
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf_gcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf_gcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/libf_gcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.VENUS/libf
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/makelmdz
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/makelmdz	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/makelmdz	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/makelmdz
Index: trunk/WRF.COMMON/WRFV2/venus_lmd_new/makelmdz_fcm
===================================================================
--- trunk/WRF.COMMON/WRFV2/venus_lmd_new/makelmdz_fcm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/venus_lmd_new/makelmdz_fcm	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../../../../LMDZ.COMMON/makelmdz_fcm
Index: trunk/WRF.COMMON/WRFV2/wash_away
===================================================================
--- trunk/WRF.COMMON/WRFV2/wash_away	(revision 2744)
+++ trunk/WRF.COMMON/WRFV2/wash_away	(revision 2744)
@@ -0,0 +1,1 @@
+cd external ; make superclean ; cd .. ; clean
Index: trunk/WRF.COMMON/WRFV3/LMD_LES_MARS_install
===================================================================
--- trunk/WRF.COMMON/WRFV3/LMD_LES_MARS_install	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/LMD_LES_MARS_install	(revision 2744)
@@ -0,0 +1,115 @@
+#! /bin/bash
+####
+#### A. Spiga -- 2010 -- 
+####
+
+
+\rm -rf WRFV2
+
+
+#
+## WRF modeling system software Version 3.0.1.1 (August 22, 2008)
+#
+
+wget --no-check-certificate http://www2.mmm.ucar.edu/wrf/src/WRFV3.0.1.1.TAR.gz
+tar xzvf WRFV3.0.1.1.TAR.gz
+\rm WRFV3.0.1.1.TAR.gz
+#mv WRFV3/* .
+#rmdir WRFV3
+
+  #### faking stuff for copy_model script
+  mv WRFV3 WRFV2
+  touch in_reality_this_is_WRFV3_but_is_named_WRFV2_for_continuity
+  cd WRFV2
+  ln -sf ../../WRFV2/mars_lmd .
+  ln -sf ../../WRFV2/mars_lmd_new .
+  ln -sf ../../WRFV2/venus_lmd_new .
+  ln -sf ../../WRFV2/generic_lmd_new .
+  ln -sf ../../WRFV2/titan_lmd_new .
+  ln -sf ../modif_mars .
+  ln -sf ../../WRFV2/*.h .
+  ln -sf ../../WRFV2/physics.sed .
+  cp ../../WRFV2/call_meso_inifis?.inc .
+  cp ../../WRFV2/call_meso_physiq?.inc .
+  touch configure.defaults.dummy
+  touch mars.sed.dummy
+  mkdir external/RSL
+  mkdir external/RSL/RSL
+  touch external/RSL/RSL.dummy
+  touch external/RSL/RSL/RSL.dummy
+
+#
+## Replacing Mars files
+#
+
+#tar xzvf LMD_LES_MARS_patches.tar.gz 
+#mv LMD_LES_MARS_patches LMD_LES_MARS/modif_mars
+#cd LMD_LES_MARS
+#ln -sf ../LMD_LES_MARS_patches modif_mars
+
+#cd modif_mars
+#ln -sf ../../LMD_MM_MARS/SRC/WRFV2/phys/module_lmd_driver.F
+#cd ..
+cd arch
+ln -sf ../modif_mars/configure_new.defaults .
+cd ..
+
+cd dyn_em
+ln -sf ../modif_mars/module_big_step_utilities_em.F .
+ln -sf ../modif_mars/module_first_rk_step_part1.F . 
+ln -sf ../modif_mars/module_first_rk_step_part2.F .
+ln -sf ../modif_mars/module_initialize_les.F .
+ln -sf ../modif_mars/solve_em.F .
+ln -sf ../modif_mars/module_em.F .
+ln -sf ../modif_mars/module_diffusion_em.F .
+ln -sf ../modif_mars/Makefile_dyn_em Makefile
+ln -sf ../modif_mars/module_init_utilities.F .
+cd ..
+
+cd frame
+ln -sf ../modif_mars/module_driver_constants.F .
+cd ..
+
+cd Registry
+ln -sf ../modif_mars/Registry.EM .
+ln -sf ../modif_mars/Registry.EM.newphys .
+ln -sf ../modif_mars/Registry.bash .
+cd ..
+
+cd phys
+ln -sf ../modif_mars/Makefile .
+ln -sf ../modif_mars/module_lmd_driver.F .
+ln -sf ../modif_mars/module_physics_addtendc.F .
+ln -sf ../modif_mars/module_physics_init.F .
+ln -sf ../modif_mars/module_lmd_driver.F.new .
+ln -sf ../modif_mars/dynphy_wrf_* .
+cd ..
+
+cd share
+ln -sf ../modif_mars/module_model_constants.F .
+cd ..
+
+
+ln -sf modif_mars/makeles .
+
+
+### create a fake directory
+mkdir -p mars_lmd/libf/phymars
+
+
+
+# M Lefevre: option -C makes things bad in some OS
+cd external
+sed 's/-C//g' esmf_time_f90/Makefile > zolbxs ; mv zolbxs esmf_time_f90/Makefile
+sed 's/-C//g' ioapi_share/makefile > zolbxs ; mv zolbxs ioapi_share/makefile
+sed 's/-C//g' io_esmf/makefile > zolbxs ; mv zolbxs io_esmf/makefile
+sed 's/-C//g' io_grib1/Makefile > zolbxs ; mv zolbxs io_grib1/Makefile
+sed 's/-C//g' io_grib2/Makefile > zolbxs ; mv zolbxs io_grib2/Makefile
+sed 's/-C//g' io_grib_share/Makefile > zolbxs ; mv zolbxs io_grib_share/Makefile
+sed 's/-C//g' io_int/makefile > zolbxs ; mv zolbxs io_int/makefile
+sed 's/-C//g' io_mcel/makefile > zolbxs ; mv zolbxs io_mcel/makefile
+sed 's/-C//g' io_netcdf/makefile > zolbxs ; mv zolbxs io_netcdf/makefile
+sed 's/-C//g' io_phdf5/Makefile > zolbxs ; mv zolbxs io_phdf5/Makefile
+sed 's/-C//g' io_pnetcdf/makefile > zolbxs ; mv zolbxs io_pnetcdf/makefile
+sed 's/-C//g' RSL_LITE/makefile > zolbxs ; mv zolbxs RSL_LITE/makefile
+cd ..
Index: trunk/WRF.COMMON/WRFV3/correcfft
===================================================================
--- trunk/WRF.COMMON/WRFV3/correcfft	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/correcfft	(revision 2744)
@@ -0,0 +1,12 @@
+#! /bin/bash
+
+#### quick and dirty....
+
+cd external
+mkdir fftpack
+cd fftpack
+ln -sf ../../../../SRC/LES/WRFV2/external/fftpack/* .
+\rm fftpack5
+mkdir fftpack5
+cd fftpack5
+ln -sf ../../../../../SRC/LES/WRFV2/external/fftpack/fftpack5/* .
Index: trunk/WRF.COMMON/WRFV3/modif_mars/EXCLUS_de_SVN.txt
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/EXCLUS_de_SVN.txt	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/EXCLUS_de_SVN.txt	(revision 2744)
@@ -0,0 +1,11 @@
+
+les fichiers mis a jour par makeles
+
+cp -rf ${libphys_folder}/liblmd.a ${whereliblmd}/
+cp -rf ${phymars_folder}/dimphys.h ${here}/modif_mars/
+cp -rf ${folder}/call_meso_inifis.inc ${here}/modif_mars/
+cp -rf ${folder}/call_meso_physiq.inc ${here}/modif_mars/
+cp -rf ${folder}/inc/module_lmd_driver_output*.inc ${here}/modif_mars/
+cp -rf ${phymars_folder}/wrf_output_2d.h ${here}/modif_mars/
+cp -rf ${phymars_folder}/wrf_output_3d.h ${here}/modif_mars/
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/Makefile	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/Makefile	(revision 2744)
@@ -0,0 +1,64 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+
+MODULES = \
+	module_physics_addtendc.o \
+	module_physics_init.o \
+	variables_mod.o \
+	update_inputs_physiq_mod.o \
+	update_outputs_physiq_mod.o \
+	iniphysiq_mod.o \
+	callphysiq_mod.o \
+	module_lmd_driver.o
+  
+OBJS    =
+
+NMM_MODULES =  
+
+LIBTARGET    =  physics
+TARGETDIR    =  ./
+
+$(LIBTARGET) :
+		if [ $(WRF_NMM_CORE) -eq 1 ] ; then \
+                  $(MAKE) nmm_contrib                                      ; \
+                  $(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS) $(NMM_OBJS) $(NMM_MODULES) ; \
+                else                                                         \
+                  $(MAKE) non_nmm                                          ; \
+                  $(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS)             ; \
+                fi
+
+include ../configure.wrf
+
+nmm_contrib : $(NMM_OBJS) $(NMM_MODULES) $(MODULES) $(OBJS)
+
+non_nmm : $(MODULES) $(OBJS)
+
+clean:
+	@ echo 'use the clean script'
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+module_physics_addtendc.o: \
+		../frame/module_state_description.o \
+		../frame/module_configure.o
+
+module_physics_init.o : \
+		../frame/module_state_description.o \
+		../frame/module_configure.o \
+		../frame/module_wrf_error.o \
+		../frame/module_dm.o \
+		../share/module_model_constants.o 
+
+module_lmd_driver.o: \
+		../frame/module_state_description.o \
+		../frame/module_wrf_error.o \
+		../frame/module_configure.o \
+		../share/module_model_constants.o \
+#../frame/module_wrf_error.o \
+#../share/module_model_constants.o
+
+# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV3/modif_mars/Makefile_dyn_em
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/Makefile_dyn_em	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/Makefile_dyn_em	(revision 2744)
@@ -0,0 +1,270 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+
+MODULES =                 		\
+        module_advect_em.o   		\
+	module_diffusion_em.o  		\
+	module_small_step_em.o 		\
+        module_big_step_utilities_em.o  \
+        module_em.o         		\
+        module_solvedebug_em.o    	\
+        module_bc_em.o                  \
+        module_init_utilities.o         \
+	module_damping_em.o		\
+	module_polarfft.o		\
+        module_first_rk_step_part1.o    \
+        module_first_rk_step_part2.o    \
+	$(CASE_MODULE)
+
+# possible CASE_MODULE settings
+#	module_initialize_b_wave.o      \
+#	module_initialize_grav2d_x.o    \
+#	module_initialize_heldsuarez.o  \
+#	module_initialize_hill2d_x.o    \
+#	module_initialize_quarter_ss.o  \
+#	module_initialize_real.o        \
+#	module_initialize_lsm_x.o       \
+#	module_initialize_les.o         \
+#	module_initialize_squall2d_x.o  \
+#	module_initialize_squall2d_y.o 
+
+OBJS    = 		        \
+	init_modules_em.o       \
+	solve_em.o              \
+        start_em.o              \
+        shift_domain_em.o       \
+        couple_or_uncouple_em.o \
+        nest_init_utils.o	\
+        adapt_timestep_em.o     \
+        interp_domain_em.o
+ 
+
+LIBTARGET    =  dyn_em
+TARGETDIR    =  ./
+$(LIBTARGET) :  $(MODULES) $(OBJS)
+		$(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS)
+
+include ../configure.wrf
+
+cio.o :
+	$(CC) -c $(CFLAGS) cio.c
+
+clean:
+	@ echo 'use the clean script'
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+couple_or_uncouple_em.o: ../frame/module_domain.o \
+		../frame/module_configure.o \
+		../frame/module_driver_constants.o \
+		../frame/module_machine.o \
+		../frame/module_tiles.o \
+		../frame/module_dm.o \
+		../frame/module_state_description.o
+
+init_modules_em.o: module_big_step_utilities_em.o
+
+interp_domain_em.o: ../frame/module_domain.o \
+		../frame/module_configure.o 
+
+module_advect_em.o: ../share/module_bc.o \
+		../share/module_model_constants.o \
+		../frame/module_wrf_error.o
+
+module_bc_em.o: ../share/module_bc.o ../frame/module_configure.o \
+		../frame/module_wrf_error.o
+
+module_big_step_utilities_em.o: \
+		../share/module_llxy.o	\
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../share/module_model_constants.o 
+
+module_damping_em.o: ../frame/module_wrf_error.o
+
+module_diffusion_em.o:  module_big_step_utilities_em.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		../frame/module_wrf_error.o
+
+module_em.o:    module_big_step_utilities_em.o module_advect_em.o \
+		module_damping_em.o \
+		../frame/module_state_description.o \
+		../share/module_model_constants.o 
+
+module_polarfft.o: ../share/module_model_constants.o \
+		../frame/module_wrf_error.o
+
+module_small_step_em.o: \
+		../frame/module_configure.o  \
+		../share/module_model_constants.o 
+
+module_initialize_b_wave.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_grav2d_x.o: \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_heldsuarez.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_hill2d_x.o: \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_quarter_ss.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_les.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_real.o :  \
+		nest_init_utils.o	\
+		../share/module_llxy.o	\
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		../share/module_soil_pre.o \
+		../share/module_optional_input.o
+
+module_initialize_squall2d_x.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+module_initialize_squall2d_y.o : \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		module_init_utilities.o
+
+nest_init_utils.o: \
+		../frame/module_domain.o \
+		../frame/module_configure.o
+
+start_em.o: module_bc_em.o \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_state_description.o \
+		../frame/module_timing.o \
+		../frame/module_dm.o \
+		../share/module_io_domain.o \
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		../share/module_date_time.o \
+		../phys/module_physics_init.o 
+
+solve_em.o:     module_small_step_em.o \
+		module_em.o            \
+		module_solvedebug_em.o \
+                module_bc_em.o         \
+		module_diffusion_em.o  \
+		module_big_step_utilities_em.o \
+                module_first_rk_step_part1.o \
+                module_first_rk_step_part2.o \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_driver_constants.o \
+		../frame/module_state_description.o \
+		../frame/module_machine.o \
+		../frame/module_tiles.o \
+		../frame/module_dm.o \
+		../share/module_llxy.o	\
+		../share/module_model_constants.o \
+		../share/module_bc.o \
+		../phys/module_physics_addtendc.o
+
+### pas sur
+module_first_rk_step_part1.o : \
+		../phys/module_lmd_driver.o 
+
+module_first_rk_step_part2.o : \
+		module_diffusion_em.o  \
+                module_bc_em.o         \
+		../frame/module_domain.o \
+		../frame/module_state_description.o \
+		../frame/module_driver_constants.o \
+		../frame/module_configure.o \
+		../frame/module_dm.o \
+		../share/module_bc.o 
+
+adapt_timestep_em.o: \
+                module_bc_em.o         \
+		../frame/module_domain.o \
+		../frame/module_configure.o  \
+		../frame/module_dm.o
+
+#		../chem/module_chem_utilities.o \
+# 		../chem/module_input_chem_data.o
+
+# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM	(revision 2744)
@@ -0,0 +1,1839 @@
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    n      1     namelist=dfi_time_dim        c          dfi time dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    ?      -     namelist=ts_buf_size      c          ts_buf_size
+dimspec    !      -     namelist=max_ts_locs      c          max_ts_locs
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+#### --- please indicate #SAVEMARS2 for 2D fields and #SAVEMARS3 for 3D fields
+####
+############ name in WRF !!!!! ############# name in NETCDF !!!! ############################################## name in meso_physiq !!!!!
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rd   "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWNZ   ij   misc  1  -  rhd  "SWDOWNZ"   "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWNZ   ij   misc  1  -  rhd  "LWDOWNZ"   "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rd   "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rd   "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rd   "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rd   "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rd   "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+state  real  PDTZ      ikj  misc  1  -  rd   "PDT"       "TEMP TENDENCY"                   "K s-1"   #SAVEMARS3 pdt
+state  real  HR_SW     ikj   misc  1  -  -  "HR_SW"     "HEATING RATE SW"                 "K/s"
+state  real  HR_LW     ikj   misc  1  -  -  "HR_LW"     "HEATING RATE LW"                 "K/s"
+state  real  HR_DYN     ikj   misc  1  -  -  "HR_DYN"     "HEATING RATE DYN"                 "K/s"
+state  real  DDT     ikj   misc  1  -  -  "DDT"     "TEMPERATURE TENDENCY"                 "K/s"
+state  real  DT_RAD     ikj   misc  1  -  -  "DT_RAD"     "RADIATIVE TEMPERATURE TENDENCY"                 "K/s"
+state  real  DT_VDF     ikj   misc  1  -  -  "DT_VDF"     "PBL CLMAIN TEMPERATURE TENDENCY"                 "K/s"
+state  real  DT_AJS     ikj   misc  1  -  -  "DT_AJS"     "AJUSTEMENT SEC TEMPERATURE TENDENCY"                 "K/s"
+state  real  CLOUDFRAC  ikj  misc  1  -  -  "CLOUDFRAC"     "CLOUD FRACTION"           ""
+state  real  TOTCLOUDFRAC  ij  misc  1  -  -  "TOTCLOUDFRAC"     "COLUMN CLOUD FRACTION"           ""
+state  real  GRAIN  ikj  misc  1  -  -  "RAIN"     "RAIN kg/kg.s-1"           ""
+state  real  GSNOW  ikj  misc  1  -  -  "SNOW"     "SNOW kg/kg.s-1"           ""
+state  real  ALBEQ  ij misc  1  -  -  "ALBEQ"    "ALBEDO EQUIVALENT"   ""
+state  real  FLUXTOP_DN ij misc  1  -  - "FLUXTOP_DN"   "Incoming SW radiation at the TOA" "W.m-2"
+state  real  FLUXABS_SW ij misc  1  -  - "FLUXABS_SW"  "Absorbed SW flux" "W.m-2"
+state  real  FLUXTOP_LW ij misc  1  -  - "FLUXTOP_LW"  "Outgoing LW flux TOA" "W.m-2"
+state  real  FLUXSURF_SW ij misc  1  -  - "FLUXSURF_SW" "SW Surface flux" "W.m-2"
+state  real  FLUXSURF_LW ij misc  1  -  -  "FLUXSURF_LW" "LW Surface flux" "W.m-2"
+state  real  FLXGRD ij misc  1  -  - "FLXGRD" "heat flux from ground"  "W.m-2"
+state  real  LSCEZ ikj misc  1  -  - "LSCEZ" "heat from largescale" "W.m-2"
+state  real  H2OICE_REFF ikj misc  1  -  -  "H2OICE_REFF" "Radii of H2O ice" "m"
+state  real  LATENT_HF ij misc  1  -  -  "LATENT_HF" "latent heat flux" "W.m-2"
+state  real  REEVAP    ij misc  1  -  -  "REEVAP" "re-evaporation flux of precipitation (integrated over the atmospheric column)"
+state  real  SURFRAIN  ij misc  1  -  -  "SURFRAIN" "Rainfall" "kg m-2 s-1"
+
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                         -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+state  real  qdust     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUST"      "Dust mixing ratio"          "kg kg-1"
+state  real  qdustn    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUSTN"     "Dust number density"        " m-3 "
+state  real  qtrac1    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "qtrac1"     "Decaying tracer 1"          "kg kg-1"
+state  real  upward    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "upward"     "Decaying tracer surf"       "kg kg-1"
+state  real  downward  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "downward"   "Decaying tracer zi"         "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+###VENUS TRACER
+state  real  qco2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCO2"       "CO2 number mixing ratio"   "kg kg-1"
+state  real  qco       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCO"        "CO number mixing ratio"   "kg kg-1"
+state  real  qh2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2"        "H2 number mixing ratio"   "kg kg-1"
+state  real  qo1d      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO1D"        "O1d number mixing ratio"   "kg kg-1"
+state  real  qo        ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO"        "O number mixing ratio"   "kg kg-1"
+state  real  qo2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO2"        "O2 number mixing ratio"   "kg kg-1"
+state  real  qo2dg     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO2dg"        "O2dg number mixing ratio"   "kg kg-1"
+state  real  qo3       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO3"        "O3 number mixing ratio"   "kg kg-1"
+state  real  qh        ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH"        "H number mixing ratio"   "kg kg-1"
+state  real  qoh       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOH"        "OH number mixing ratio"   "kg kg-1"
+state  real  qho2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHO2"        "HO2 number mixing ratio"   "kg kg-1"
+state  real  qh2o2     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O2"        "H2O2 number mixing ratio"   "kg kg-1"
+state  real  qcl       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCL"        "Cl number mixing ratio"   "kg kg-1"
+state  real  qclo      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLO"        "ClO number mixing ratio"   "kg kg-1"
+state  real  qcl2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCL2"        "Cl2 number mixing ratio"   "kg kg-1"
+state  real  qhcl      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHCL"        "HCl number mixing ratio"   "kg kg-1"
+state  real  qhocl     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHOCL"        "HOCl number mixing ratio"   "kg kg-1"
+state  real  qclco     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLCO"        "ClCO number mixing ratio"   "kg kg-1"
+state  real  qclco3    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLCO3"        "ClCO3 number mixing ratio"   "kg kg-1"
+state  real  qcocl2    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCOCL2"        "COCl2 number mixing ratio"   "kg kg-1"
+state  real  qss       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS"        "S number mixing ratio"   "kg kg-1"
+state  real  qso       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO"        "SO number mixing ratio"   "kg kg-1"
+state  real  qso2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO2"        "SO2 number mixing ratio"   "kg kg-1"
+state  real  qso3      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO3"        "SO3 number mixing ratio"   "kg kg-1"
+state  real  qs2o2     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS2O2"        "S2O2 number mixing ratio"   "kg kg-1"
+state  real  qocs      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOCS"        "OCS number mixing ratio"   "kg kg-1"
+state  real  qhso3     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHSO3"        "HSO3 number mixing ratio"   "kg kg-1"
+state  real  qh2so4    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2SO4"        "H2SO4 number mixing ratio"   "kg kg-1"
+state  real  qs2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS2"        "S2 number mixing ratio"   "kg kg-1"
+state  real  qclso2    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLSO2"        "ClSO2 number mixing ratio"   "kg kg-1"
+state  real  qoscl     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOSCL"        "OSCl number mixing ratio"   "kg kg-1"
+state  real  qh2oliq   ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2OLIQ"        "H2O liq number mixing ratio"   "kg kg-1"
+state  real  qh2so4liq ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2SO4LIQ"        "H2SO4 liq number mixing ratio"   "kg kg-1"
+
+
+
+
+
+
+#state    real   floob       ikjb     dyn_em      1         -    
+#state    real   floob_x     ikjx     dyn_em      1         -     
+#state    real   floob_y     ikjy     dyn_em      1         - 
+#xpose FLOOB dyn_em floob,floob_x,floob_y
+
+#state real xxx ijk misc 2 - h6ud
+#halo  HALO_FLOOB dyn_em  4:xxx_2
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     i02r01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+# znw, znu, dzs, and zs must be listed before any 3-d fields
+# in order for the grib output module to work correctly.  The grib output
+# module retrieves the vertical levels from these parameters.  If znw, znu
+# dzs, and zs are not listed first, vertical level will not be encoded at 
+# time 0.
+
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real   ZS              l        misc      -         Z     ir       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     ir       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+ifdef RUC_CLOUD
+state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+state    real   qni_gc         igj      dyn_em      1        Z     i1  "QNI"   "ice no concentration"   "m-3"
+endif
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   z0_gc           ij   dyn_em  1  -  i1  "SURF_ROUGHNESS"   "surface roughness"       "cm"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+state  real   isoil_gc       igj   dyn_em  1  Z  i1  "ISOIL"            "soil thermal inertia"    "tiu"
+state  real   dsoil_gc       igj   dyn_em  1  Z  i1  "DSOIL"            "soil depths"             "m"
+####
+#### variables dans wrf
+####
+#### 'm_' prefix is to avoid redundancies with possible existing terrestrial variables
+####
+####          vvvv nom pour module_initialize, solve_em, lmd_driver (interne fortran)
+####                                                vvvv nom fichier netCDF (important initialisation
+################################################################################################################
+state  real   m_albedo     ij   misc  1  -  i012rd  "MARS_ALB"     "albedo of naked ground"   "0 - 1 fraction"
+state  real   m_ti         ij   misc  1  -  i012rd  "MARS_TI"      "thermal inertia"          "J/m2/K/s0.5"
+state  real   m_z0         ij   misc  1  -  i012rd  "MARS_Z0"      "surface roughness"        "m"
+state  real   slpx         ij   misc  1  -  i012rd  "SLOPEX"       "slope x direction"        "rad"
+state  real   slpy         ij   misc  1  -  i012rd  "SLOPEY"       "slope y direction"        "rad"
+state  real   m_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"   "emissivity"               "0 - 1 fraction"
+state  real   m_co2ice     ij   misc  1  -  i012rd  "MARS_CICE"    "co2 ground ice"           "kg/m2"
+state  real   m_h2oice     ij   misc  1  -  i012rd  "MARS_WICE"    "h2o ground ice"           "kg/m2"
+state  real   m_fluxrad    ij   misc  1  -  i012rd  "MARS_FLUXRAD" "net rad flux at surf"     "W.m-2"
+state  real   m_wstar      ij   misc  1  -  i012rd  "MARS_WSTAR"   "free convection velocity" "m.s-1"
+state  real   m_tsurf      ij   misc  1  -  i012rd  "MARS_TSURF"   "surface temperature"      "K"
+state  real   m_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"   "soil temperatures"        "K"
+state  real   m_q2        ikj   misc  1  Z  i012rd  "MARS_Q2"      "parameterized TKE"        "kg.m-3"
+state  real   m_isoil     ilj   misc  1  -  i012rd  "MARS_ISOIL"   "soil thermal inertia"     "tiu"
+state  real   m_dsoil     ilj   misc  1  -  i012rd  "MARS_DSOIL"   "soil depths"              "m"
+state  real   m_gw        ilj   misc  1  -  i012rd  "MARS_GW"      "gwparam"                  " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mub_save        ij     dyn_em      1         -      -           "mub_save" "nest temp, holds orig fine grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   ru=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -       r         "potevp" "accumulated potential evaporation" "W m-2"
+state    real   snopcx         ij      dyn_em      1         -       r         "snopcx" "snow phase change heat flux" "W m-2"
+state    real   soiltb         ij      dyn_em      1         -       -         "soiltb" "bottom soil temperature" "K"
+state    real    fnm            k       dyn_em      1         -     ir       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     ir       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     ir       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     ir       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     ir       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     ir       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATE T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     ir       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     ir       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rhd    "PSFC"                 "SFC PRESSURE"      "Pa"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -      r          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -      r          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -      r          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     ir       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     ir       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     ir       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     ir       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     ir       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     ir       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     ir       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     r         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     r         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+# indicates whether to recompute mu                                                             
+state   logical press_adj      -        -          -         -     -         "press_adj"         "T/F flag adjust mu"         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+state   real    -              ikjftb   dfi_moist       1         -     -    -
+state   real    dfi_qv         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QVAPOR"       "Water vapor mixing ratio"      "kg kg-1"
+state   real    dfi_qc         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QCLOUD"       "Cloud water mixing ratio"      "kg kg-1"
+state   real    dfi_qr         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QRAIN"        "Rain water mixing ratio"       "kg kg-1"
+state   real    dfi_qi         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QICE"         "Ice mixing ratio"              "kg kg-1"
+state   real    dfi_qs         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QSNOW"        "Snow mixing ratio"             "kg kg-1"
+state   real    dfi_qg         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QGRAUP"       "Graupel mixing ratio"          "kg kg-1"
+
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -   -
+state   real    qndrop         ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNDROP"        "Droplet number mixing ratio"        "# kg-1"
+state   real    qni            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg-1"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+state   real    qns            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNSNOW"         "Snow Number concentration"   "# kg(-1)"
+state   real    qnr            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNRAIN"        "Rain Number concentration"   "# kg(-1)"
+state   real    qng            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNGRAUPEL"     "Graupel Number concentration" "# kg(-1)"
+state   real    -              ikjftb  dfi_scalar      1         -     -   -
+state   real    dfi_qndrop     ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNDROP"    "Droplet number mixing ratio"        "# kg-1"
+state   real    dfi_qni        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNICE"     "Ice Number concentration" "# kg-1"
+state   real    dfi_qt         ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_CWM"       "Total condensate mixing ratio"      "kg kg-1"
+state   real    dfi_qns        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNSNOW"    "Snow Number concentration"   "# kg(-1)"
+state   real    dfi_qnr        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNRAIN"    "Rain Number concentration"   "# kg(-1)"
+state   real    dfi_qng        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNGRAUPEL" "Graupel Number concentration" "# kg(-1)"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i012r   "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i012    "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i012    "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+
+# Time series variables
+state    real   ts_hour         ?!       misc      -         -      r        "TS_HOUR"        "Model integration time, hours"
+state    real   ts_u            ?!       misc      -         -      r        "TS_U"           "Surface wind U-component, earth-relative"
+state    real   ts_v            ?!       misc      -         -      r        "TS_V"           "Surface wind V-component, earth-relative"
+state    real   ts_q            ?!       misc      -         -      r        "TS_Q"           "Surface mixing ratio"
+state    real   ts_t            ?!       misc      -         -      r        "TS_T"           "Surface temperature"
+state    real   ts_psfc         ?!       misc      -         -      r        "TS_PSFC"        "Surface pressure"
+state    real   ts_glw          ?!       misc      -         -      r        "TS_GLW"         "Downward long wave flux at surface"
+state    real   ts_gsw          ?!       misc      -         -      r        "TS_GSW"         "Net short wave flux at surface"
+state    real   ts_hfx          ?!       misc      -         -      r        "TS_HFX"         "Upward heat flux at surface"
+state    real   ts_lh           ?!       misc      -         -      r        "TS_LH"          "Upward moisture flux at surface"
+state    real   ts_tsk          ?!       misc      -         -      r        "TS_TSK"         "Skin temperature"
+state    real   ts_tslb         ?!       misc      -         -      r        "TS_TSLB"        "Soil temperature"
+state    real   ts_clw          ?!       misc      -         -      r        "TS_CLW"         "Column integrated cloud water"
+state    real   ts_rainc        ?!       misc      -         -      r        "TS_RAINC"       "Cumulus precip"
+state    real   ts_rainnc       ?!       misc      -         -      r        "TS_RAINNC"      "Grid-scale precip"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i0124rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "SEAICE"             "SEA ICE FLAG"  ""
+state    real   XICEM            ij     misc        1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICEM"             "SEA ICE FLAG (PREVIOUS STEP)"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0124rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                          "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+state    real   SNOW             ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0124rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# DFI variables
+state   real   hcoeff           n    misc        1         -     -    "HCOEFF"               "initialization weights"
+state   real   hcoeff_tot       -    misc        1         -     -    "HCOEFF_TOT"               "initialization weights"
+state   real   dfi_p           ikj   misc        1         -     r    "P_DFI"           "perturbation pressure"         "Pa"
+state   real   dfi_al          ikj   misc        1         -     r    "AL_DFI"          "inverse perturbation density"  "m3 kg-1"
+state   real   dfi_mu          ij    misc        1         -     r    "MU_DFI"  "perturbation dry air mass in column" "Pa"
+state   real   dfi_phb         ikj   misc        1         Z     r    "PHB_DFI"  "base-state geopotential"  "m2 s-2"
+state   real   dfi_ph0         ikj   misc        1         Z     r    "PH0_DFI"  "initial geopotential"     "m2 s-2"
+state   real   dfi_php         ikj   misc        1         Z     r    "PHP_DFI"  "geopotential"             "m2 s-2"
+state   real   dfi_u           ikj   misc        1         -     r    "U_DFI"               "u accumulation array"          "   "
+state   real   dfi_v           ikj   misc        1         -     r    "V_DFI"               "v accumulation array"          "   "
+state   real   dfi_w           ikj   misc        1         -     r    "W_DFI"               "w accumulation array"          "   "
+state   real   dfi_ww          ikj   misc        1         Z     r    "WW_DFI"              "mu-coupled eta-dot"    "Pa s-1"
+state   real   dfi_t           ikj   misc        1         -     r    "TT_DFI"               "t accumulation array"          "   "
+state   real   dfi_ph          ikj   misc        1         -     r    "PH_DFI"               "p accumulation array"          "   "
+state   real   dfi_pb          ikj   misc        1         -     r    "PB_DFI"               "pb accumulation array"          "   "
+state   real   dfi_alt         ikj   misc        1         -     r    "ALT_DFI"             "1/rho accumulation array"          "   "
+state   real   dfi_tke         ikj   misc        1         -     r    "TKE_DFI"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+
+state    real  dfi_TSLB        ilj   misc        1         Z     r    "TSLB_dfi"         "SOIL TEMPERATURE"   "K"
+state    real  dfi_SMOIS       ilj    -          1         Z     r    "SMOIS_dfi"        "SOIL MOISTURE"     "m3 m-3"
+state    real  dfi_SNOW        ij    misc        1         -     r    "SNOW_dfi"         "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real  dfi_SNOWH       ij    misc        1         -     r    "SNOWH_dfi"        "PHYSICAL SNOW DEPTH"      "m"
+state    real  dfi_CANWAT      ij    misc        1         -     r    "CANWAT_dfi"       "CANOPY WATER"             "kg m-2"
+state    real  dfi_SMFR3D      ilj   misc        1         Z     r    "SMFR3D_dfi"           "SOIL ICE" ""
+state    real  dfi_KEEPFR3DFLAG ilj  misc        1         Z     r    "KEEPFR3DFLAG_dfi"     "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# Additional for P-X PBL and LSM
+state    real   RA               ij     misc        1         -      r        "RA"           "AERODYNAMIC RESISTANCE"   "s m-1"
+state    real   RS               ij     misc        1         -      r        "RS"           "SURFACE RESISTANCE"       "s m-1"
+state    real   LAI              ij     misc        1         -      r        "LAI"          "Leaf area index"          "area/area"
+state    real   VEGF_PX          ij     misc        1         -      r        "VEGF_PX"      "Vegetation Fraction for PX LSM"    "area/area"
+state    real   T2OBS            ij     misc        1         -      r        "T2OBS"        "2-m temperature from analysis "          "K"
+state    real   Q2OBS            ij     misc        1         -      r        "Q2OBS"        "2-m mixing ratio from analysis "         "kg/kg"
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+state   real   TSHLTR           ij     misc        1         -     ir        "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"
+state   real   QSHLTR           ij     misc        1         -     ir        "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+state   real   PSHLTR           ij     misc        1         -     ir        "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+state   real   TH10             ij     misc        1         -     ir        "TH10"                  "10-M THETA FROM MYJ"                          "K"
+state   real   Q10              ij     misc        1         -     ir        "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+state    real    qndropsource    ikj    misc        1         -      -        "qndropsource"         "Droplet number source"   "#/kg/s"
+
+# Other Misc State Variables                                            
+state   real    h_diabatic     ikj     misc         1         -      rdu      "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         "K s-1"      
+state   real    msft           ij      misc         1         -     i012rdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    msftx          ij      misc         1         -     i012rdu=(copy_fcnm)    "MAPFAC_MX"         "Map scale factor on mass grid, x direction" ""
+state   real    msfty          ij      misc         1         -     i012rdu=(copy_fcnm)    "MAPFAC_MY"         "Map scale factor on mass grid, y direction" ""
+state   real    msfux          ij      misc         1         X     i012rdu=(copy_fcnm)    "MAPFAC_UX"         "Map scale factor on u-grid, x direction" ""
+state   real    msfuy          ij      misc         1         X     i012rdu=(copy_fcnm)    "MAPFAC_UY"         "Map scale factor on u-grid, y direction" ""
+state   real    msfvx          ij      misc         1         Y     i012rdu=(copy_fcnm)    "MAPFAC_VX"         "Map scale factor on v-grid, x direction" ""
+state   real    msfvx_inv      ij      misc         1         Y     i012rdu=(copy_fcnm)    "MF_VX_INV"         "Inverse map scale factor on v-grid, x direction" ""
+state   real    msfvy          ij      misc         1         Y     i012rdu=(copy_fcnm)    "MAPFAC_VY"         "Map scale factor on v-grid, y direction" ""
+
+state   real    f              ij      misc         1         -     i012rdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+state   real    ht             ij      misc         1         -     i012rdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+state   real    ht_shad        ijb     misc         1         -     df=(bdy_interp:dt)         "HGT_SHAD"        "Height of orographic shadow"   "m"
+i1      real    ht_loc         ij      misc         1         -     - 
+i1      integer  shadowmask    ij      misc         1         -     - 
+state   integer min_ptchsz     -       misc         1         -     r
+
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    dfi_TSK        ij      misc         1         -     r                       "TSK_dfi"               "saved SURFACE SKIN TEMPERATURE"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     ir       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    max_msftx      -       misc         -         -      r       "max_mstfx"             "Max map factor in domain"  ""
+state   real    max_msfty      -       misc         -         -      r       "max_mstfy"             "Max map factor in domain"  ""
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  PRATEC           ij      misc        1         -      r       "PRATEC"                "PRECIP RATE FROM CUMULUS SCHEME"                         "mm s-1"
+state    real  RAINCV           ij      misc        1         -      r       "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc        1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc        1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc        1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc        1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc        1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc        1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc        1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc        1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  edt_out          ij      misc        1         -      -        "EDT_OUT"             "EDT FROM GD SCHEME"             ""
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"     "mb hour-1"
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"
+state    real  cugd_tten        ikj     misc        1         -      h        "CUGD_TTEN"             "INITIAL TTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qvten       ikj     misc        1         -      h        "CUGD_QVTEN"            "INITIAL QTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_ttens       ikj     misc        1         -      h        "CUGD_TTENS"            "INITIAL SUBSIDENCE TTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qvtens      ikj     misc        1         -      h        "CUGD_QVTENS"           "INITIAL SUBSIDNCE QTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qcten       ikj     misc        1         -      h        "CUGD_QCTEN"            "INITIAL TEMPERATURE TENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+#state    real  ACLWUPTC         ij      misc       1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "UNCOUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "UNCOUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+
+state    real  SWDOWN           ij      misc        1         -      rd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GLW              ij      misc        1         -      rd      "GLW"                   "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE"            "W m-2"      
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r        "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123r01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123r01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012r01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012r01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012r01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012r01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r          "ALBEDO"                   "ALBEDO"
+state    real  CLAT             ij      misc        1         -     i012rdu=(copy_fcnm)          "CLAT"                "COMPUTATIONAL GRID LATITUDE, SOUTH IS NEGATIVE"                       "degree_north"
+state    real  CLONG            ij      misc        1         -     i012rdu=(copy_fcnm)          "CLONG"               "COMPUTATIONAL GRID LONGITUDE, WEST IS NEGATIVE"                       "degree_east"
+state    real  ALBBCK           ij      misc        1         -     i0124r   "ALBBCK"                "BACKGROUND ALBEDO"        ""
+state    real  EMBCK            ij      misc        1         -      r        "EMBCK"                 "BACKGROUND EMISSIVITY"         ""
+state    real  EMISS            ij      misc        1         -      r       "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  CK               ij      misc        1         -      r        "CK"                    "ENTHALPY EXCHANGE COEFF AT 10 m"                      ""
+state    real  CKA              ij      misc        1         -      r        "CKA"                   "ENTHALPY EXCHANGE COEFF AT LOWEST MODEL LVL"          ""
+state    real  CD               ij      misc        1         -      r        "CD"                    "DRAG COEFF AT 10m"                      ""
+state    real  CDA              ij      misc        1         -      r        "CDA"                   "DRAG COEFF AT LOWEST MODEL LVL"                      ""
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"    
+state    real  USTM             ij      misc        1         -      rh       "USTM"                  "U* IN SIMILARITY THEORY WITHOUT VCONV"        "m s-1"    #SAVEMARS2 ustar
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -      r        "RMOL"                  "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r       "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"     #SAVEMARS2 sensheat
+state    real  QFX              ij      misc        1         -      r       "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r       "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  dfi_QVG          ij      misc        1         -      r        "QVG_dfi"               "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  dfi_SOILT1       ij      misc        1         -      r        "SOILT1_dfi"            "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+state    real  dfi_TSNAV        ij      misc        1         -      r        "TSNAV_dfi"             "AVERAGE SNOW TEMPERATURE "                    "C"
+state    real  REGIME           ij      misc        1         -      r        "REGIME"  "FLAGS: 1=Night/Stable, 2=Mechanical Turbulent, 3=Forced Conv, 4=Free Conv" ""
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  dfi_SNOWC        ij      misc        1         -      r        "SNOWC_dfi"             "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  T2_NDG_NEW        ivjf     fdda2d      1         -      igr      "T2_NDG_NEW"               "NEW 2m TEMP FOR PX LSM "  "K"
+state    real  Q2_NDG_NEW        ivjf     fdda2d      1         -      igr      "Q2_NDG_NEW"               "NEW 2m WATER VAPOR MIX RATIO FOR PX LSM "  "kg/kg"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  T2_NDG_OLD        ivjf     fdda2d      1         -      igr      "T2_NDG_OLD"               "OLD 2m TEMP F FOR PX LSM"  "K"
+state    real  Q2_NDG_OLD        ivjf     fdda2d      1         -      igr      "Q2_NDG_OLD"               "OLD 2m WATER VAPOR MIX RATIO  FOR PX LSM"  "kg/kg"
+state    real  SN_NDG_NEW        ivjf     fdda2d      1         -      igr      "SN_NDG_NEW"               "NEW Snow Depth "  "m"
+state    real  SN_NDG_OLD        ivjf     fdda2d      1         -      igr      "SN_NDG_OLD"               "OLD Snow Depth"  "m"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+state   real    max_cfl         -       misc        1         -     -       "max_cfl"           "maximum CFL value in grid at a time" "-"
+
+# Ocean Mixed-Layer State Variables
+state   real    TML            ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "TML"    "OCEAN MIXED-LAYER TEMPERATURE"   "K"
+state   real    T0ML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "T0ML"   "INITIAL OCEAN MIXED-LAYER TEMPERATURE"   "K"
+state   real    HML            ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HML"    "OCEAN MIXED-LAYER DEPTH"   "m"
+state   real    H0ML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "H0ML"   "INITIAL OCEAN MIXED-LAYER DEPTH"   "m"
+state   real    HUML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HUML"   "OCEAN MIXED-LAYER DEPTH * U-CURRENT"  " m2s-1 "
+state   real    HVML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HVML"   "OCEAN MIXED-LAYER DEPTH * V-CURRENT"  " m2s-1 " 
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    2024   irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      01    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      01    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      00    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    2024    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      01    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      02    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      00    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 11, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+rconfig   logical all_ic_times            namelist,time_control		1              .false. irh    "all_ic_times"     "T/F WRITE ALL IC TIME PERIODS"  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# DFI namelist
+rconfig   integer dfi_opt                namelist,dfi_control   1       0     rh   "dfi_opt"                ""      ""
+rconfig   integer dfi_nfilter            namelist,dfi_control   1       7     rh   "dfi_nfilter"                "Digital filter type"      ""
+rconfig   logical dfi_write_filtered_input  namelist,dfi_control  1  .true.   rh   "dfi_write_filtered_input"                "Write a wrfinput_filtered_d0n file?"      ""
+rconfig   logical dfi_write_dfi_history  namelist,dfi_control   1   .false.   rh   "dfi_write_dfi_history"    "Write history files during filtering?"      ""
+rconfig   integer dfi_cutoff_seconds     namelist,dfi_control   1    3600     rh   "dfi_cutoff_seconds"       "Digital filter cutoff time"      ""
+rconfig   integer dfi_time_dim           namelist,dfi_control   1    1000     rh   "dfi_time_dim"             "MAX DIMENSION FOR HCOEFF"
+rconfig   integer dfi_fwdstop_year       namelist,dfi_control   1    2004     rh   "dfi_fwdstop_year"         "4 DIGIT YEAR OF START OF DFI" "YEARS"
+rconfig   integer dfi_fwdstop_month      namelist,dfi_control   1      03     rh   "dfi_fwdstop_month"        "2 DIGIT MONTH OF THE YEAR OF START OF DFI" "MONTHS"
+rconfig   integer dfi_fwdstop_day        namelist,dfi_control   1      13     rh   "dfi_fwdstop_day"          "2 DIGIT DAY OF THE MONTH OF START OF DFI" "DAYS"
+rconfig   integer dfi_fwdstop_hour       namelist,dfi_control   1      12     rh   "dfi_fwdstop_hour"         "2 DIGIT HOUR OF THE DAY OF START OF DFI" "HOURS"
+rconfig   integer dfi_fwdstop_minute     namelist,dfi_control   1      00     rh   "dfi_fwdstop_minute"       "2 DIGIT MINUTE OF THE HOUR OF START OF DFI" "MINUTES"
+rconfig   integer dfi_fwdstop_second     namelist,dfi_control   1      00     rh   "dfi_fwdstop_second"       "2 DIGIT SECOND OF THE MINUTE OF START OF DFI" "SECONDS"
+rconfig   integer dfi_bckstop_year       namelist,dfi_control   1    2004     rh   "dfi_bckstop_year"         "4 DIGIT YEAR OF END OF DFI" "YEARS"
+rconfig   integer dfi_bckstop_month      namelist,dfi_control   1      03     rh   "dfi_bckstop_month"        "2 DIGIT MONTH OF THE YEAR OF END OF DFI" "MONTHS"
+rconfig   integer dfi_bckstop_day        namelist,dfi_control   1      14     rh   "dfi_bckstop_day"          "2 DIGIT DAY OF THE MONTH OF END OF DFI" "DAYS"
+rconfig   integer dfi_bckstop_hour       namelist,dfi_control   1      12     rh   "dfi_bckstop_hour"         "2 DIGIT HOUR OF THE DAY OF END OF DFI" "HOURS"
+rconfig   integer dfi_bckstop_minute     namelist,dfi_control   1      00     rh   "dfi_bckstop_minute"       "2 DIGIT MINUTE OF THE HOUR OF END OF DFI" "MINUTES"
+rconfig   integer dfi_bckstop_second     namelist,dfi_control   1      00     rh   "dfi_bckstop_second"       "2 DIGIT SECOND OF THE MINUTE OF END OF DFI" "SECONDS"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+
+rconfig   integer min_time_step           namelist,domains      max_domains   -1      h    "min_time_step"
+rconfig   integer max_time_step           namelist,domains      max_domains   -1      h    "max_time_step"
+rconfig   real    target_cfl              namelist,domains      max_domains  1.2      h    "target_cfl"
+rconfig   integer max_step_increase_pct   namelist,domains      max_domains    5      h    "max_step_increase_pct"
+rconfig   integer starting_time_step      namelist,domains      max_domains   -1      h    "starting_time_step"
+rconfig   logical step_to_output_time     namelist,domains      1         .true.      h    "step_to_output_time"
+rconfig   logical use_adaptive_time_step  namelist,domains      1         .false.     h    "use_adaptive_time_step"
+
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              27      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              5000    irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"  ""
+rconfig   integer extrap_type             namelist,domains	1              2       irh    "extrap_type"  "1= use 2 lowest levels, 2=constant"  ""
+rconfig   integer t_extrap_type           namelist,domains	1              2       irh    "t_extrap_type"  "1=isothermal, 2=6.5 K/km, 3=adiabatic"   ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   logical use_levels_below_ground namelist,domains	1             .true.   irh    "use_levels_below_ground"   "T/F: use input data levels below input sfc pres" ""
+rconfig   logical use_surface             namelist,domains	1             .true.   irh    "use_surface"   "T/F: use input surface level in interpolation" ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              1       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              500     irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .false. irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   logical smooth_cg_topo          namelist,domains	1              .false. irh    "smooth_cg_topo"   "T/F smooth CG topo on boundarries" "flag"
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   logical grid_allowed            namelist,domains	max_domains    .true.  irh    "allowed"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       rh     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       rh     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   ts_buf_size     namelist,domains    1                200          -       "ts_buf_size"   "Size of time series buffer"
+rconfig   integer   max_ts_locs     namelist,domains    1                5            -       "max_ts_locs"   "Maximum number of time series locations"
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   track_level     namelist,domains    1                50000
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1000.
+
+# Physics
+######
+###### MARS SPECIFIC NAMELIST ENTRIES
+######
+rconfig  character planet   namelist,physics  1            "mars"   -    "planet"    "selection of the planet" ""
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_Z0   namelist,physics  max_domains  0        irh  "init_Z0"   "surface roughness"       ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.   ir   "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     gsfcgce_hail        namelist,physics      1              0       rh       "gsfcgce select hail/graupel"  ""      ""
+rconfig   integer     gsfcgce_2ice        namelist,physics      1              0       rh       "gsfcgce select 2ice/3ice"  ""      ""
+rconfig   integer     progn               namelist,physics      max_domains    0       rh       "progn"                 ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    1       h    "RADT"          ""      ""
+rconfig   real    naer                    namelist,physics      max_domains    1e9     rh   "NAER"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer cugd_avedx              namelist,physics      1            1      irh    "cugd_avedx"                    ""      ""
+rconfig   integer clos_choice             namelist,physics      1             0       rh    "clos_choice"                    ""      ""
+rconfig   integer imomentum               namelist,physics      1             0       rh    "imomentum"                    "momentum transport in G3 scheme"      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      max_domains  0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   logical usemonalb               namelist,physics      1            .false.   h    "usemonalb"   "use 2d field vs table values  false=table, True=2d"   ""
+rconfig   integer co2tf                   namelist,physics	1            1         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback         namelist,physics      max_domains   .false.  -     "feedback cumulus to radiation"  ""
+rconfig   integer pxlsm_smois_init           namelist,physics  max_domains   1       irh    "PXLSM_SMOIS_INIT"    "Soil moisture initialization option 0-From analysis 1-From MAVAIL"      ""
+rconfig   integer omlcall                 namelist,physics      1            0         h     "omlcall"     "activate simple ocean mixed layer model  0=no, 1=yes"   ""
+rconfig   real    oml_hml0                namelist,physics      1            50        h     "oml_hml0"    "oml initial mixed layer depth value"   "m"
+rconfig   real    oml_gamma               namelist,physics      1            0.14      h     "oml_gamma"   "oml deep water lapse rate"   "K m-1"
+rconfig   integer isftcflx                namelist,physics      1            0         h     "isftcflx"    "switch to control sfc fluxes"   ""
+rconfig   real    shadlen                 namelist,physics      1            25000.    -     "shadow_length" "maximum length of orographic shadow" "m"
+rconfig   integer slope_rad               namelist,physics      max_domains    0       -     "slope_rad"  "1: use slope-dependent radiation, 0:not" ""
+rconfig   integer topo_shading            namelist,physics      max_domains    0       -     "topo_shading" "1: apply topographic shading to radiation, 0:not" ""
+rconfig   integer no_mp_heating           namelist,physics      1              0       -     "no_mp_heating" "switch to turn of latent heating in mp schemes"   ""
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            max_domains    0       rh       "obs_twindo"        "Half-period time window for nudging"  "hrs"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            max_domains    1       rh       "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   integer     obs_nobs_prt        namelist,fdda            max_domains    0       rh       "obs_nobs_prt"      "Number of current obs to print grid coord. info."   ""
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   ""
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   ""
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   ""
+rconfig   logical     obs_ipf_init        namelist,fdda            1              .true.  h        "obs_ipf_init"      "Enable obs init warning messages"   ""
+
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+# km_opt_dfi is needed for backward integration in dfi
+rconfig   integer km_opt_dfi              namelist,dynamics	1             1       irh    "km_opt_dfi"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.      h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.2     h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    2      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    c_s                     namelist,dynamics	max_domains    0.25    h    "c_s"         "Smagorinsky coeff"      ""
+rconfig   real    c_k                     namelist,dynamics	max_domains    0.15    h    "c_k"         "TKE coeff"      ""
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    6       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_moist_dfi        namelist,dynamics	max_domains    .false.  rh    "pd_moist_dfi"    "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   integer mix_isotropic           namelist,dynamics	max_domains    0       h    "mix_isotropic"            "0=anistropic, 1=isotropic"      ""
+rconfig   real    mix_upper_bound         namelist,dynamics	max_domains    0.1     h    "mix_upper_bound"          "non-dimensional limit"      ""
+rconfig   logical top_lid                 namelist,dynamics     max_domains    .false. rh    "top_lid"               ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical coriolis2d              namelist,dynamics	max_domains  .false.  irh  "coriolis2d"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    fft_filter_lat          namelist,dynamics     1              45.     h    "fft_filter_lat"   ""   "grid latitude to start polar filter"
+rconfig   logical rotated_pole            namelist,dynamics     1            .false.  irh   "rotated_pole"    ""   ""
+rconfig   logical do_coriolis             namelist,dynamics	max_domains  .true.   irh  "do_coriolis"    ""   ""
+rconfig   logical do_curvature            namelist,dynamics	max_domains  .true.   irh  "do_curvature"   ""   ""
+rconfig   logical do_gradp                namelist,dynamics	max_domains  .true.   irh  "do_gradp"    ""   ""
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical polar                   namelist,bdy_control	max_domains    .false. rh    "polar"                 ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   real    spec_exp                namelist,bdy_control          1     0.      irh    "spec_exp"              ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   integer nobs_ndg_vars           derived                       1         5       -        "num_ndg_vars"         "Number of nudging variables"          ""
+rconfig   integer nobs_err_flds           derived                       1         9       -        "num_err_flds"         "Number of error fields"               ""
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none (Cylindrical), 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer use_wps_input           derived                       1         0       -        "use_wps_input"        "0/1 flag, using wps input"      "0=no, 1=yes"
+rconfig   integer dfi_stage               derived                       1         3       -        "dfi_stage"            "current stage of DFI processing"      "0=DFI setup, 1=DFI backward integration, 2=DFI forward integration, 3=WRF forecast"
+rconfig   integer mp_physics_dfi          derived                  max_domains   -1       -        "mp_physics_dfi"       ""      "-1 = no DFI and so no need to allocate DFI moist and scalar variables, >0 = running with DFI, so allocate DFI moist and scalar variables appropriate for selected microphysics package"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+package   dust         mars==2                      -              moist:qv;scalar:qdust
+package   dust2eq      mars==3                      -              scalar:qdust,qdustn
+package   radioac      mars==20                     -              scalar:qtrac1
+package   radioac2     mars==21                     -              scalar:upward,downward
+package   VenusPC      mars==34                     -              scalar:qco2,qco,qh2,qh2o,qo1d,qo,qo2,qo2dg,qo3,qh,qoh,qho2,qh2o2,qcl,qclo,qcl2,qhcl,qhocl,qclco,qclco3,qcocl2,qss,qso,qso2,qso3,qs2o2,qocs,qhso3,qh2so4,qs2,qclso2,qoscl,qh2oliq,qh2so4liq
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+
+
+#package   passivec1     chem_opt==0                  -             
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   gsfcgcescheme mp_physics==7                -             moist:qv,qc,qr,qi,qs,qg
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+package   morr_two_moment  mp_physics==10            -             moist:qv,qc,qr,qi,qs,qg;scalar:qni,qns,qnr,qng
+
+package   nodfimoist        mp_physics_dfi==-1       -             -
+package   passiveqv_dfi     mp_physics_dfi==0        -             dfi_moist:dfi_qv
+package   kesslerscheme_dfi mp_physics_dfi==1        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr
+package   linscheme_dfi     mp_physics_dfi==2        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   wsm3scheme_dfi    mp_physics_dfi==3        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr
+package   wsm5scheme_dfi    mp_physics_dfi==4        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs
+package   etampnew_dfi      mp_physics_dfi==5        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qt
+package   wsm6scheme_dfi    mp_physics_dfi==6        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   gsfcgcescheme_dfi mp_physics_dfi==7        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   thompson_dfi      mp_physics_dfi==8        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni
+package   morr_two_moment_dfi  mp_physics_dfi==10    -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni,dfi_qns,dfi_qnr,dfi_qng
+
+package   noprogn       progn==0                     -             -
+package   progndrop     progn==1                     -             scalar:qndrop;dfi_scalar:dfi_qndrop
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+package   heldsuarez    ra_lw_physics==31            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             state:regime
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   pxsfcscheme    sf_sfclay_physics==7        -             state:regime
+
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   pxlsmscheme    sf_surface_physics==7       -             fdda2d:t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old
+
+package   ysuscheme      bl_pbl_physics==1           -             state:regime
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   acmpblscheme   bl_pbl_physics==7           -             state:regime
+package   mrfscheme      bl_pbl_physics==99          -             state:regime
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   g3scheme       cu_physics==5               -             state:cugd_qvten,cugd_tten,cugd_qvtens,cugd_ttens,cugd_qcten
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new,t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old,sn_ndg_new,sn_ndg_old;state:rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten
+
+package   restofwrf      use_wps_input==0            -             -
+
+package   dfi_setup      dfi_stage==0                -             -
+package   dfi_bck        dfi_stage==1                -             -
+package   dfi_fwd        dfi_stage==2                -             -
+package   dfi_fst        dfi_stage==3                -             -
+
+#package   digifilter     dfi_opt==1                  -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qndrop,dfi_qni,dfi_qt,dfi_qns,dfi_qnr,dfi_qng;state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt
+package   dfi_nodfi     dfi_opt==0                  -             -
+package   dfi_dfl       dfi_opt==1                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+package   dfi_ddfi      dfi_opt==2                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+package   dfi_tdfi      dfi_opt==3                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+ifdef RUC_CLOUD
+package   realonly       use_wps_input==1            -             state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc,qr_gc,qc_gc,qs_gc,qi_gc,qg_gc,qni_gc
+endif
+ifndef RUC_CLOUD
+package   realonly       use_wps_input==1            -             state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc
+endif
+
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,f,e,sina,cosa,ht,potevp,snopcx,soiltb,xlat,xlong,xlat_u,xlat_v,xlong_u,xlong_v,clat,clong
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw,ustm
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_CUP_G3_IN dyn_em 24:RTHFTEN,RQVFTEN,w_2
+halo      HALO_CUP_G3_OUT dyn_em 48:cugd_tten,cugd_qvten,cugd_ttens,cugd_qvtens,raincv
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+halo      HALO_TOPOSHAD phys 24:ht_shad
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+halo      HALO_EM_HYDRO_UV   dyn_em 8:u_2,v_2
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST_OLD dyn_em 3:moist_old
+period    PERIOD_BDY_EM_CHEM_OLD dyn_em 3:chem_old
+period    PERIOD_BDY_EM_SCALAR_OLD dyn_em 3:scalar_old
+period    PERIOD_BDY_EM_TKE_OLD dyn_em 3:tke_1
+period    PERIOD_EM_HYDRO_UV dyn_em 1:u_2,v_2
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy,ustm
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfvx,msfvy,muu,msfux,msfuy,msfvx_inv
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer NSTAW        # number of obs stations within current time window
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    KNOWN_LAT    # Latitude  of origin point (i,j)=(1,1)
+typedef fdob_type real    KNOWN_LON    # Longitude of origin point (i,j)=(1,1)
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+
+# xpose variables for polar fft
+state    real   t_xxx          ikjx    -           1        -
+state    real   u_xxx          ikjx    -           1        X
+state    real   ru_xxx         ikjx    -           1        X
+state    real   v_xxx          ikjx    -           1        Y
+state    real   rv_xxx         ikjx    -           1        Y
+state    real   w_xxx          ikjx    -           1        Z
+state    real   ww_xxx         ikjx    -           1        Z
+state    real   ph_xxx         ikjx    -           1        Z
+state    real   dum_yyy        ikjy    -           1        -
+state    real   fourd_xxx      ikjx    -           1        -
+state    real   clat_xxx       ijx     -           1        -
+state    real   ht_xxx         ijx     -           1        -
+state    real   mf_xxx         ijx     -           1        -
+
+xpose XPOSE_POLAR_FILTER_TOPO dyn_em t_init,t_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_T  dyn_em t_2,t_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_U  dyn_em u_2,u_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_RU dyn_em ru_m,ru_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_V  dyn_em v_2,v_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_RV dyn_em rv_m,rv_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_W  dyn_em w_2,w_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_WW dyn_em ww_m,ww_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_PH dyn_em ph_2,ph_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_MOIST dyn_em moist,fourd_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_CHEM dyn_em chem,fourd_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_SCALAR dyn_em scalar,fourd_xxx,dum_yyy
+
+##
Index: trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM.newphys
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM.newphys	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM.newphys	(revision 2744)
@@ -0,0 +1,1841 @@
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    n      1     namelist=dfi_time_dim        c          dfi time dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    ?      -     namelist=ts_buf_size      c          ts_buf_size
+dimspec    !      -     namelist=max_ts_locs      c          max_ts_locs
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+####
+####
+#### RADIATIVE TRANSFER
+state  real  HR_SW     ikj   misc  1  -  -  "HR_SW"     "HEATING RATE SW"                 "K/s"
+state  real  HR_LW     ikj   misc  1  -  -  "HR_LW"     "HEATING RATE LW"                 "K/s"
+state  real  HR_DYN     ikj   misc  1  -  -  "HR_DYN"     "HEATING RATE DYN"                 "K/s"
+state  real  DDT     ikj   misc  1  -  -  "DDT"     "TEMPERATURE TENDENCY"                 "K/s"
+state  real  DT_RAD     ikj   misc  1  -  -  "DT_RAD"     "RADIATIVE TEMPERATURE TENDENCY"                 "K/s"
+state  real  DT_VDF     ikj   misc  1  -  -  "DT_VDF"     "PBL CLMAIN TEMPERATURE TENDENCY"                 "K/s"
+state  real  DT_AJS     ikj   misc  1  -  -  "DT_AJS"     "AJUSTEMENT SEC TEMPERATURE TENDENCY"                 "K/s"
+
+state  real  SWDOWNZ    ij   misc  1  -  -  "SWDOWNZ"   "DOWNWARD SW FLUX AT SURFACE"     "W m-2"
+#### DUST CYCLE
+state  real  TAU_DUST   ij   misc  1  -  -  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""
+state  real  RDUST     ikj   misc  1  -  -  "RDUST"     "DUST RADIUS"                     "m"
+state  real  QSURFDUST  ij   misc  1  -  -  "QSURFDUST" "DUST MASS AT SURFACE"            "kg m-2"
+#### CLOUDS
+state  real  MTOT       ij   misc  1  -  -  "MTOT"      "TOTAL MASS WATER VAPOR in pmic"  "pmic"
+state  real  ICETOT     ij   misc  1  -  -  "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"
+state  real  VMR_ICE   ikj   misc  1  -  -  "VMR_ICE"   "VOL. MIXING RATIO ICE"           "ppm"
+state  real  TAU_ICE    ij   misc  1  -  -  "TAU_ICE"   "CLOUD OD at 825 cm-1 TES"        ""
+state  real  RICE      ikj   misc  1  -  -  "RICE"      "ICE RADIUS"                      "m"
+#### THERMALS
+state  real  ZMAX       ij   misc  1  -  -  "ZMAX"      "MAXIMUM LEVEL THERMALS"          "m"
+state  real  HFMAX      ij   misc  1  -  -  "HFMAX"     "MAXIMUM PBL HEAT FLUX"           "m.K/s"
+#### GENERIC OUTPUTS
+state  real  CLOUDFRAC  ikj  misc  1  -  -  "CLOUDFRAC"     "CLOUD FRACTION"           ""
+state  real  TOTCLOUDFRAC  ij  misc  1  -  -  "TOTCLOUDFRAC"     "COLUMN CLOUD FRACTION"           ""
+state  real  GRAIN  ikj  misc  1  -  -  "RAIN"     "RAIN kg/kg.s-1"           ""
+state  real  GSNOW  ikj  misc  1  -  -  "SNOW"     "SNOW kg/kg.s-1"           ""
+state  real  ALBEQ  ij misc  1  -  -  "ALBEQ"    "ALBEDO EQUIVALENT"   ""
+state  real  FLUXTOP_DN ij misc  1  -  h "FLUXTOP_DN"   "Incoming SW radiation at the TOA" "W.m-2"
+state  real  FLUXABS_SW ij misc  1  -  h "FLUXABS_SW"  "Absorbed SW flux" "W.m-2"
+state  real  FLUXTOP_LW ij misc  1  -  h "FLUXTOP_LW"  "Outgoing LW flux TOA" "W.m-2"
+state  real  FLUXSURF_SW ij misc  1  -  h "FLUXSURF_SW" "SW Surface flux" "W.m-2"
+state  real  FLUXSURF_LW ij misc  1  -  h  "FLUXSURF_LW" "LW Surface flux" "W.m-2"
+state  real  FLXGRD ij misc  1  -  h "FLXGRD" "heat flux from ground"  "W.m-2"
+state  real  LSCEZ ikj misc  1  -  - "LSCEZ" "heat from largescale" "W.m-2"
+state  real  H2OICE_REFF ikj misc  1  -  -  "H2OICE_REFF" "Radii of H2O ice" "m"
+state  real  LATENT_HF ij misc  1  -  -  "LATENT_HF" "Latent heat flux" "W.m-2"
+state  real  REEVAP    ij misc  1  -  -  "REEVAP" "Re-evaporation flux of precipitation (integrated over the atmospheric column)"
+state  real  SURFRAIN  ij misc  1  -  -  "SURFRAIN" "Rainfall" "kg m-2 s-1"
+
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                         -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+state  real  qdust     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUST"      "Dust mixing ratio"          "kg kg-1"
+state  real  qdustn    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUSTN"     "Dust number density"        " m-3 "
+state  real  qtrac1    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "qtrac1"     "Decaying tracer 1"          "kg kg-1"
+state  real  qccn      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCN"         "CCN mixing ratio"          "kg kg-1"
+state  real  qccnn     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCNN"        "CCN number mixing ratio"   "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+###VENUS TRACER
+state  real  qco2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCO2"       "CO2 number mixing ratio"   "kg kg-1"
+state  real  qco       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCO"        "CO number mixing ratio"   "kg kg-1"
+state  real  qh2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2"        "H2 number mixing ratio"   "kg kg-1"
+state  real  qo1d      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO1D"        "O1d number mixing ratio"   "kg kg-1"
+state  real  qo        ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO"        "O number mixing ratio"   "kg kg-1"
+state  real  qo2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO2"        "O2 number mixing ratio"   "kg kg-1"
+state  real  qo2dg     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO2dg"        "O2dg number mixing ratio"   "kg kg-1"
+state  real  qo3       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QO3"        "O3 number mixing ratio"   "kg kg-1"
+state  real  qh        ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH"        "H number mixing ratio"   "kg kg-1"
+state  real  qoh       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOH"        "OH number mixing ratio"   "kg kg-1"
+state  real  qho2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHO2"        "HO2 number mixing ratio"   "kg kg-1"
+state  real  qh2o2     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2O2"        "H2O2 number mixing ratio"   "kg kg-1"
+state  real  qcl       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCL"        "Cl number mixing ratio"   "kg kg-1"
+state  real  qclo      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLO"        "ClO number mixing ratio"   "kg kg-1"
+state  real  qcl2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCL2"        "Cl2 number mixing ratio"   "kg kg-1"
+state  real  qhcl      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHCL"        "HCl number mixing ratio"   "kg kg-1"
+state  real  qhocl     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHOCL"        "HOCl number mixing ratio"   "kg kg-1"
+state  real  qclco     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLCO"        "ClCO number mixing ratio"   "kg kg-1"
+state  real  qclco3    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLCO3"        "ClCO3 number mixing ratio"   "kg kg-1"
+state  real  qcocl2    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCOCL2"        "COCl2 number mixing ratio"   "kg kg-1"
+state  real  qss       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS"        "S number mixing ratio"   "kg kg-1"
+state  real  qso       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO"        "SO number mixing ratio"   "kg kg-1"
+state  real  qso2      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO2"        "SO2 number mixing ratio"   "kg kg-1"
+state  real  qso3      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QSO3"        "SO3 number mixing ratio"   "kg kg-1"
+state  real  qs2o2     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS2O2"        "S2O2 number mixing ratio"   "kg kg-1"
+state  real  qocs      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOCS"        "OCS number mixing ratio"   "kg kg-1"
+state  real  qhso3     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QHSO3"        "HSO3 number mixing ratio"   "kg kg-1"
+state  real  qh2so4    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2SO4"        "H2SO4 number mixing ratio"   "kg kg-1"
+state  real  qs2       ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QS2"        "S2 number mixing ratio"   "kg kg-1"
+state  real  qclso2    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCLSO2"        "ClSO2 number mixing ratio"   "kg kg-1"
+state  real  qoscl     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QOSCL"        "OSCl number mixing ratio"   "kg kg-1"
+state  real  qh2oliq   ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2OLIQ"        "H2O liq number mixing ratio"   "kg kg-1"
+state  real  qh2so4liq ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QH2SO4LIQ"        "H2SO4 liq number mixing ratio"   "kg kg-1"
+
+
+
+
+
+
+
+
+#state    real   floob       ikjb     dyn_em      1         -    
+#state    real   floob_x     ikjx     dyn_em      1         -     
+#state    real   floob_y     ikjy     dyn_em      1         - 
+#xpose FLOOB dyn_em floob,floob_x,floob_y
+
+#state real xxx ijk misc 2 - h6ud
+#halo  HALO_FLOOB dyn_em  4:xxx_2
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     i02r01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+# znw, znu, dzs, and zs must be listed before any 3-d fields
+# in order for the grib output module to work correctly.  The grib output
+# module retrieves the vertical levels from these parameters.  If znw, znu
+# dzs, and zs are not listed first, vertical level will not be encoded at 
+# time 0.
+
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real   ZS              l        misc      -         Z     ir       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     ir       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+ifdef RUC_CLOUD
+state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+state    real   qni_gc         igj      dyn_em      1        Z     i1  "QNI"   "ice no concentration"   "m-3"
+endif
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   z0_gc           ij   dyn_em  1  -  i1  "SURF_ROUGHNESS"   "surface roughness"       "cm"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+state  real   isoil_gc       igj   dyn_em  1  Z  i1  "ISOIL"            "soil thermal inertia"    "tiu"
+state  real   dsoil_gc       igj   dyn_em  1  Z  i1  "DSOIL"            "soil depths"             "m"
+####
+#### variables dans wrf
+####
+#### 'm_' prefix is to avoid redundancies with possible existing terrestrial variables
+####
+####          vvvv nom pour module_initialize, solve_em, lmd_driver (interne fortran)
+####                                                vvvv nom fichier netCDF (important initialisation
+################################################################################################################
+state  real   m_albedo     ij   misc  1  -  i012rd  "MARS_ALB"     "albedo of naked ground"   "0 - 1 fraction"
+state  real   m_ti         ij   misc  1  -  i012rd  "MARS_TI"      "thermal inertia"          "J/m2/K/s0.5"
+state  real   m_z0         ij   misc  1  -  i012rd  "MARS_Z0"      "surface roughness"        "m"
+state  real   slpx         ij   misc  1  -  i012rd  "SLOPEX"       "slope x direction"        "rad"
+state  real   slpy         ij   misc  1  -  i012rd  "SLOPEY"       "slope y direction"        "rad"
+state  real   m_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"   "emissivity"               "0 - 1 fraction"
+state  real   m_co2ice     ij   misc  1  -  i012rd  "MARS_CICE"    "co2 ground ice"           "kg/m2"
+state  real   m_h2oice     ij   misc  1  -  i012rd  "MARS_WICE"    "h2o ground ice"           "kg/m2"
+state  real   m_fluxrad    ij   misc  1  -  i012rd  "MARS_FLUXRAD" "net rad flux at surf"     "W.m-2"
+state  real   m_wstar      ij   misc  1  -  i012rd  "MARS_WSTAR"   "free convection velocity" "m.s-1"
+state  real   m_tsurf      ij   misc  1  -  i012rhd "MARS_TSURF"   "surface temperature"      "K"
+state  real   m_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"   "soil temperatures"        "K"
+state  real   m_q2        ikj   misc  1  Z  i012rd  "MARS_Q2"      "parameterized TKE"        "kg.m-3"
+state  real   m_isoil     ilj   misc  1  -  i012rd  "MARS_ISOIL"   "soil thermal inertia"     "tiu"
+state  real   m_dsoil     ilj   misc  1  -  i012rd  "MARS_DSOIL"   "soil depths"              "m"
+state  real   m_gw        ilj   misc  1  -  i012rd  "MARS_GW"      "gwparam"                  " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+state    real   tz_init        ikj     dyn_em      1         -      ir       "tz_init" "initial potential temperature" "K"
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mub_save        ij     dyn_em      1         -      -           "mub_save" "nest temp, holds orig fine grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   ru=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -       r         "potevp" "accumulated potential evaporation" "W m-2"
+state    real   snopcx         ij      dyn_em      1         -       r         "snopcx" "snow phase change heat flux" "W m-2"
+state    real   soiltb         ij      dyn_em      1         -       -         "soiltb" "bottom soil temperature" "K"
+state    real    fnm            k       dyn_em      1         -     ir       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     ir       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     ir       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     ir       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     ir       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     ir       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATE T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     ir       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     ir       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rhd    "PSFC"                 "SFC PRESSURE"      "Pa"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -      r          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -      r          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -      r          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     ir       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     ir       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     ir       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     ir       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     ir       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     ir       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     ir       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     r         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     r         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+# indicates whether to recompute mu                                                             
+state   logical press_adj      -        -          -         -     -         "press_adj"         "T/F flag adjust mu"         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+state   real    -              ikjftb   dfi_moist       1         -     -    -
+state   real    dfi_qv         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QVAPOR"       "Water vapor mixing ratio"      "kg kg-1"
+state   real    dfi_qc         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QCLOUD"       "Cloud water mixing ratio"      "kg kg-1"
+state   real    dfi_qr         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QRAIN"        "Rain water mixing ratio"       "kg kg-1"
+state   real    dfi_qi         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QICE"         "Ice mixing ratio"              "kg kg-1"
+state   real    dfi_qs         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QSNOW"        "Snow mixing ratio"             "kg kg-1"
+state   real    dfi_qg         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QGRAUP"       "Graupel mixing ratio"          "kg kg-1"
+
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -   -
+state   real    qndrop         ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNDROP"        "Droplet number mixing ratio"        "# kg-1"
+state   real    qni            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg-1"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+state   real    qns            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNSNOW"         "Snow Number concentration"   "# kg(-1)"
+state   real    qnr            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNRAIN"        "Rain Number concentration"   "# kg(-1)"
+state   real    qng            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNGRAUPEL"     "Graupel Number concentration" "# kg(-1)"
+state   real    -              ikjftb  dfi_scalar      1         -     -   -
+state   real    dfi_qndrop     ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNDROP"    "Droplet number mixing ratio"        "# kg-1"
+state   real    dfi_qni        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNICE"     "Ice Number concentration" "# kg-1"
+state   real    dfi_qt         ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_CWM"       "Total condensate mixing ratio"      "kg kg-1"
+state   real    dfi_qns        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNSNOW"    "Snow Number concentration"   "# kg(-1)"
+state   real    dfi_qnr        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNRAIN"    "Rain Number concentration"   "# kg(-1)"
+state   real    dfi_qng        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNGRAUPEL" "Graupel Number concentration" "# kg(-1)"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i012r   "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i012    "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i012    "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+
+# Time series variables
+state    real   ts_hour         ?!       misc      -         -      r        "TS_HOUR"        "Model integration time, hours"
+state    real   ts_u            ?!       misc      -         -      r        "TS_U"           "Surface wind U-component, earth-relative"
+state    real   ts_v            ?!       misc      -         -      r        "TS_V"           "Surface wind V-component, earth-relative"
+state    real   ts_q            ?!       misc      -         -      r        "TS_Q"           "Surface mixing ratio"
+state    real   ts_t            ?!       misc      -         -      r        "TS_T"           "Surface temperature"
+state    real   ts_psfc         ?!       misc      -         -      r        "TS_PSFC"        "Surface pressure"
+state    real   ts_glw          ?!       misc      -         -      r        "TS_GLW"         "Downward long wave flux at surface"
+state    real   ts_gsw          ?!       misc      -         -      r        "TS_GSW"         "Net short wave flux at surface"
+state    real   ts_hfx          ?!       misc      -         -      r        "TS_HFX"         "Upward heat flux at surface"
+state    real   ts_lh           ?!       misc      -         -      r        "TS_LH"          "Upward moisture flux at surface"
+state    real   ts_tsk          ?!       misc      -         -      r        "TS_TSK"         "Skin temperature"
+state    real   ts_tslb         ?!       misc      -         -      r        "TS_TSLB"        "Soil temperature"
+state    real   ts_clw          ?!       misc      -         -      r        "TS_CLW"         "Column integrated cloud water"
+state    real   ts_rainc        ?!       misc      -         -      r        "TS_RAINC"       "Cumulus precip"
+state    real   ts_rainnc       ?!       misc      -         -      r        "TS_RAINNC"      "Grid-scale precip"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i0124rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "SEAICE"             "SEA ICE FLAG"  ""
+state    real   XICEM            ij     misc        1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICEM"             "SEA ICE FLAG (PREVIOUS STEP)"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0124rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                          "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+state    real   SNOW             ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0124rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# DFI variables
+state   real   hcoeff           n    misc        1         -     -    "HCOEFF"               "initialization weights"
+state   real   hcoeff_tot       -    misc        1         -     -    "HCOEFF_TOT"               "initialization weights"
+state   real   dfi_p           ikj   misc        1         -     r    "P_DFI"           "perturbation pressure"         "Pa"
+state   real   dfi_al          ikj   misc        1         -     r    "AL_DFI"          "inverse perturbation density"  "m3 kg-1"
+state   real   dfi_mu          ij    misc        1         -     r    "MU_DFI"  "perturbation dry air mass in column" "Pa"
+state   real   dfi_phb         ikj   misc        1         Z     r    "PHB_DFI"  "base-state geopotential"  "m2 s-2"
+state   real   dfi_ph0         ikj   misc        1         Z     r    "PH0_DFI"  "initial geopotential"     "m2 s-2"
+state   real   dfi_php         ikj   misc        1         Z     r    "PHP_DFI"  "geopotential"             "m2 s-2"
+state   real   dfi_u           ikj   misc        1         -     r    "U_DFI"               "u accumulation array"          "   "
+state   real   dfi_v           ikj   misc        1         -     r    "V_DFI"               "v accumulation array"          "   "
+state   real   dfi_w           ikj   misc        1         -     r    "W_DFI"               "w accumulation array"          "   "
+state   real   dfi_ww          ikj   misc        1         Z     r    "WW_DFI"              "mu-coupled eta-dot"    "Pa s-1"
+state   real   dfi_t           ikj   misc        1         -     r    "TT_DFI"               "t accumulation array"          "   "
+state   real   dfi_ph          ikj   misc        1         -     r    "PH_DFI"               "p accumulation array"          "   "
+state   real   dfi_pb          ikj   misc        1         -     r    "PB_DFI"               "pb accumulation array"          "   "
+state   real   dfi_alt         ikj   misc        1         -     r    "ALT_DFI"             "1/rho accumulation array"          "   "
+state   real   dfi_tke         ikj   misc        1         -     r    "TKE_DFI"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+
+state    real  dfi_TSLB        ilj   misc        1         Z     r    "TSLB_dfi"         "SOIL TEMPERATURE"   "K"
+state    real  dfi_SMOIS       ilj    -          1         Z     r    "SMOIS_dfi"        "SOIL MOISTURE"     "m3 m-3"
+state    real  dfi_SNOW        ij    misc        1         -     r    "SNOW_dfi"         "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real  dfi_SNOWH       ij    misc        1         -     r    "SNOWH_dfi"        "PHYSICAL SNOW DEPTH"      "m"
+state    real  dfi_CANWAT      ij    misc        1         -     r    "CANWAT_dfi"       "CANOPY WATER"             "kg m-2"
+state    real  dfi_SMFR3D      ilj   misc        1         Z     r    "SMFR3D_dfi"           "SOIL ICE" ""
+state    real  dfi_KEEPFR3DFLAG ilj  misc        1         Z     r    "KEEPFR3DFLAG_dfi"     "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# Additional for P-X PBL and LSM
+state    real   RA               ij     misc        1         -      r        "RA"           "AERODYNAMIC RESISTANCE"   "s m-1"
+state    real   RS               ij     misc        1         -      r        "RS"           "SURFACE RESISTANCE"       "s m-1"
+state    real   LAI              ij     misc        1         -      r        "LAI"          "Leaf area index"          "area/area"
+state    real   VEGF_PX          ij     misc        1         -      r        "VEGF_PX"      "Vegetation Fraction for PX LSM"    "area/area"
+state    real   T2OBS            ij     misc        1         -      r        "T2OBS"        "2-m temperature from analysis "          "K"
+state    real   Q2OBS            ij     misc        1         -      r        "Q2OBS"        "2-m mixing ratio from analysis "         "kg/kg"
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+state   real   TSHLTR           ij     misc        1         -     ir        "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"
+state   real   QSHLTR           ij     misc        1         -     ir        "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+state   real   PSHLTR           ij     misc        1         -     ir        "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+state   real   TH10             ij     misc        1         -     ir        "TH10"                  "10-M THETA FROM MYJ"                          "K"
+state   real   Q10              ij     misc        1         -     ir        "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+state    real    qndropsource    ikj    misc        1         -      -        "qndropsource"         "Droplet number source"   "#/kg/s"
+
+# Other Misc State Variables                                            
+state   real    h_diabatic     ikj     misc         1         -      rdu      "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         "K s-1"      
+state   real    msft           ij      misc         1         -     i012rdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    msftx          ij      misc         1         -     i012rdu=(copy_fcnm)    "MAPFAC_MX"         "Map scale factor on mass grid, x direction" ""
+state   real    msfty          ij      misc         1         -     i012rdu=(copy_fcnm)    "MAPFAC_MY"         "Map scale factor on mass grid, y direction" ""
+state   real    msfux          ij      misc         1         X     i012rdu=(copy_fcnm)    "MAPFAC_UX"         "Map scale factor on u-grid, x direction" ""
+state   real    msfuy          ij      misc         1         X     i012rdu=(copy_fcnm)    "MAPFAC_UY"         "Map scale factor on u-grid, y direction" ""
+state   real    msfvx          ij      misc         1         Y     i012rdu=(copy_fcnm)    "MAPFAC_VX"         "Map scale factor on v-grid, x direction" ""
+state   real    msfvx_inv      ij      misc         1         Y     i012rdu=(copy_fcnm)    "MF_VX_INV"         "Inverse map scale factor on v-grid, x direction" ""
+state   real    msfvy          ij      misc         1         Y     i012rdu=(copy_fcnm)    "MAPFAC_VY"         "Map scale factor on v-grid, y direction" ""
+
+state   real    f              ij      misc         1         -     i012rdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+state   real    ht             ij      misc         1         -     i012rdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+state   real    ht_shad        ijb     misc         1         -     df=(bdy_interp:dt)         "HGT_SHAD"        "Height of orographic shadow"   "m"
+i1      real    ht_loc         ij      misc         1         -     - 
+i1      integer  shadowmask    ij      misc         1         -     - 
+state   integer min_ptchsz     -       misc         1         -     r
+
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    dfi_TSK        ij      misc         1         -     r                       "TSK_dfi"               "saved SURFACE SKIN TEMPERATURE"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     ir       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    max_msftx      -       misc         -         -      r       "max_mstfx"             "Max map factor in domain"  ""
+state   real    max_msfty      -       misc         -         -      r       "max_mstfy"             "Max map factor in domain"  ""
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  PRATEC           ij      misc        1         -      r       "PRATEC"                "PRECIP RATE FROM CUMULUS SCHEME"                         "mm s-1"
+state    real  RAINCV           ij      misc        1         -      r       "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc        1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc        1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc        1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc        1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc        1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc        1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc        1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc        1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  edt_out          ij      misc        1         -      -        "EDT_OUT"             "EDT FROM GD SCHEME"             ""
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"     "mb hour-1"
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"
+state    real  cugd_tten        ikj     misc        1         -      h        "CUGD_TTEN"             "INITIAL TTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qvten       ikj     misc        1         -      h        "CUGD_QVTEN"            "INITIAL QTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_ttens       ikj     misc        1         -      h        "CUGD_TTENS"            "INITIAL SUBSIDENCE TTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qvtens      ikj     misc        1         -      h        "CUGD_QVTENS"           "INITIAL SUBSIDNCE QTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qcten       ikj     misc        1         -      h        "CUGD_QCTEN"            "INITIAL TEMPERATURE TENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+#state    real  ACLWUPTC         ij      misc       1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "UNCOUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "UNCOUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+
+state    real  SWDOWN           ij      misc        1         -      rd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GLW              ij      misc        1         -      rd      "GLW"                   "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE"            "W m-2"      
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r        "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123r01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123r01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012r01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012r01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012r01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012r01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r          "ALBEDO"                   "ALBEDO"
+state    real  CLAT             ij      misc        1         -     i012rdu=(copy_fcnm)          "CLAT"                "COMPUTATIONAL GRID LATITUDE, SOUTH IS NEGATIVE"                       "degree_north"
+state    real  CLONG            ij      misc        1         -     i012rdu=(copy_fcnm)          "CLONG"               "COMPUTATIONAL GRID LONGITUDE, WEST IS NEGATIVE"                       "degree_east"
+state    real  ALBBCK           ij      misc        1         -     i0124r   "ALBBCK"                "BACKGROUND ALBEDO"        ""
+state    real  EMBCK            ij      misc        1         -      r        "EMBCK"                 "BACKGROUND EMISSIVITY"         ""
+state    real  EMISS            ij      misc        1         -      r       "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  CK               ij      misc        1         -      r        "CK"                    "ENTHALPY EXCHANGE COEFF AT 10 m"                      ""
+state    real  CKA              ij      misc        1         -      r        "CKA"                   "ENTHALPY EXCHANGE COEFF AT LOWEST MODEL LVL"          ""
+state    real  CD               ij      misc        1         -      r        "CD"                    "DRAG COEFF AT 10m"                      ""
+state    real  CDA              ij      misc        1         -      r        "CDA"                   "DRAG COEFF AT LOWEST MODEL LVL"                      ""
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"    
+state    real  USTM             ij      misc        1         -      rh       "USTM"                  "U* IN SIMILARITY THEORY WITHOUT VCONV"        "m s-1"    #SAVEMARS2 ustar
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -      r        "RMOL"                  "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r       "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"     #SAVEMARS2 sensheat
+state    real  QFX              ij      misc        1         -      r       "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r       "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  dfi_QVG          ij      misc        1         -      r        "QVG_dfi"               "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  dfi_SOILT1       ij      misc        1         -      r        "SOILT1_dfi"            "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+state    real  dfi_TSNAV        ij      misc        1         -      r        "TSNAV_dfi"             "AVERAGE SNOW TEMPERATURE "                    "C"
+state    real  REGIME           ij      misc        1         -      r        "REGIME"  "FLAGS: 1=Night/Stable, 2=Mechanical Turbulent, 3=Forced Conv, 4=Free Conv" ""
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  dfi_SNOWC        ij      misc        1         -      r        "SNOWC_dfi"             "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  T2_NDG_NEW        ivjf     fdda2d      1         -      igr      "T2_NDG_NEW"               "NEW 2m TEMP FOR PX LSM "  "K"
+state    real  Q2_NDG_NEW        ivjf     fdda2d      1         -      igr      "Q2_NDG_NEW"               "NEW 2m WATER VAPOR MIX RATIO FOR PX LSM "  "kg/kg"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  T2_NDG_OLD        ivjf     fdda2d      1         -      igr      "T2_NDG_OLD"               "OLD 2m TEMP F FOR PX LSM"  "K"
+state    real  Q2_NDG_OLD        ivjf     fdda2d      1         -      igr      "Q2_NDG_OLD"               "OLD 2m WATER VAPOR MIX RATIO  FOR PX LSM"  "kg/kg"
+state    real  SN_NDG_NEW        ivjf     fdda2d      1         -      igr      "SN_NDG_NEW"               "NEW Snow Depth "  "m"
+state    real  SN_NDG_OLD        ivjf     fdda2d      1         -      igr      "SN_NDG_OLD"               "OLD Snow Depth"  "m"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+state   real    max_cfl         -       misc        1         -     -       "max_cfl"           "maximum CFL value in grid at a time" "-"
+
+# Ocean Mixed-Layer State Variables
+state   real    TML            ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "TML"    "OCEAN MIXED-LAYER TEMPERATURE"   "K"
+state   real    T0ML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "T0ML"   "INITIAL OCEAN MIXED-LAYER TEMPERATURE"   "K"
+state   real    HML            ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HML"    "OCEAN MIXED-LAYER DEPTH"   "m"
+state   real    H0ML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "H0ML"   "INITIAL OCEAN MIXED-LAYER DEPTH"   "m"
+state   real    HUML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HUML"   "OCEAN MIXED-LAYER DEPTH * U-CURRENT"  " m2s-1 "
+state   real    HVML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HVML"   "OCEAN MIXED-LAYER DEPTH * V-CURRENT"  " m2s-1 " 
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    2024   irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      01    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      01    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      00    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    2024    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      01    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      02    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      00    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 11, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+rconfig   logical all_ic_times            namelist,time_control		1              .false. irh    "all_ic_times"     "T/F WRITE ALL IC TIME PERIODS"  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# DFI namelist
+rconfig   integer dfi_opt                namelist,dfi_control   1       0     rh   "dfi_opt"                ""      ""
+rconfig   integer dfi_nfilter            namelist,dfi_control   1       7     rh   "dfi_nfilter"                "Digital filter type"      ""
+rconfig   logical dfi_write_filtered_input  namelist,dfi_control  1  .true.   rh   "dfi_write_filtered_input"                "Write a wrfinput_filtered_d0n file?"      ""
+rconfig   logical dfi_write_dfi_history  namelist,dfi_control   1   .false.   rh   "dfi_write_dfi_history"    "Write history files during filtering?"      ""
+rconfig   integer dfi_cutoff_seconds     namelist,dfi_control   1    3600     rh   "dfi_cutoff_seconds"       "Digital filter cutoff time"      ""
+rconfig   integer dfi_time_dim           namelist,dfi_control   1    1000     rh   "dfi_time_dim"             "MAX DIMENSION FOR HCOEFF"
+rconfig   integer dfi_fwdstop_year       namelist,dfi_control   1    2004     rh   "dfi_fwdstop_year"         "4 DIGIT YEAR OF START OF DFI" "YEARS"
+rconfig   integer dfi_fwdstop_month      namelist,dfi_control   1      03     rh   "dfi_fwdstop_month"        "2 DIGIT MONTH OF THE YEAR OF START OF DFI" "MONTHS"
+rconfig   integer dfi_fwdstop_day        namelist,dfi_control   1      13     rh   "dfi_fwdstop_day"          "2 DIGIT DAY OF THE MONTH OF START OF DFI" "DAYS"
+rconfig   integer dfi_fwdstop_hour       namelist,dfi_control   1      12     rh   "dfi_fwdstop_hour"         "2 DIGIT HOUR OF THE DAY OF START OF DFI" "HOURS"
+rconfig   integer dfi_fwdstop_minute     namelist,dfi_control   1      00     rh   "dfi_fwdstop_minute"       "2 DIGIT MINUTE OF THE HOUR OF START OF DFI" "MINUTES"
+rconfig   integer dfi_fwdstop_second     namelist,dfi_control   1      00     rh   "dfi_fwdstop_second"       "2 DIGIT SECOND OF THE MINUTE OF START OF DFI" "SECONDS"
+rconfig   integer dfi_bckstop_year       namelist,dfi_control   1    2004     rh   "dfi_bckstop_year"         "4 DIGIT YEAR OF END OF DFI" "YEARS"
+rconfig   integer dfi_bckstop_month      namelist,dfi_control   1      03     rh   "dfi_bckstop_month"        "2 DIGIT MONTH OF THE YEAR OF END OF DFI" "MONTHS"
+rconfig   integer dfi_bckstop_day        namelist,dfi_control   1      14     rh   "dfi_bckstop_day"          "2 DIGIT DAY OF THE MONTH OF END OF DFI" "DAYS"
+rconfig   integer dfi_bckstop_hour       namelist,dfi_control   1      12     rh   "dfi_bckstop_hour"         "2 DIGIT HOUR OF THE DAY OF END OF DFI" "HOURS"
+rconfig   integer dfi_bckstop_minute     namelist,dfi_control   1      00     rh   "dfi_bckstop_minute"       "2 DIGIT MINUTE OF THE HOUR OF END OF DFI" "MINUTES"
+rconfig   integer dfi_bckstop_second     namelist,dfi_control   1      00     rh   "dfi_bckstop_second"       "2 DIGIT SECOND OF THE MINUTE OF END OF DFI" "SECONDS"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+
+rconfig   integer min_time_step           namelist,domains      max_domains   -1      h    "min_time_step"
+rconfig   integer max_time_step           namelist,domains      max_domains   -1      h    "max_time_step"
+rconfig   real    target_cfl              namelist,domains      max_domains  1.2      h    "target_cfl"
+rconfig   integer max_step_increase_pct   namelist,domains      max_domains    5      h    "max_step_increase_pct"
+rconfig   integer starting_time_step      namelist,domains      max_domains   -1      h    "starting_time_step"
+rconfig   logical step_to_output_time     namelist,domains      1         .true.      h    "step_to_output_time"
+rconfig   logical use_adaptive_time_step  namelist,domains      1         .false.     h    "use_adaptive_time_step"
+
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              27      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              5000    irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"  ""
+rconfig   integer extrap_type             namelist,domains	1              2       irh    "extrap_type"  "1= use 2 lowest levels, 2=constant"  ""
+rconfig   integer t_extrap_type           namelist,domains	1              2       irh    "t_extrap_type"  "1=isothermal, 2=6.5 K/km, 3=adiabatic"   ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   logical use_levels_below_ground namelist,domains	1             .true.   irh    "use_levels_below_ground"   "T/F: use input data levels below input sfc pres" ""
+rconfig   logical use_surface             namelist,domains	1             .true.   irh    "use_surface"   "T/F: use input surface level in interpolation" ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              1       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              500     irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .false. irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   logical smooth_cg_topo          namelist,domains	1              .false. irh    "smooth_cg_topo"   "T/F smooth CG topo on boundarries" "flag"
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   logical grid_allowed            namelist,domains	max_domains    .true.  irh    "allowed"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       rh     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       rh     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   ts_buf_size     namelist,domains    1                200          -       "ts_buf_size"   "Size of time series buffer"
+rconfig   integer   max_ts_locs     namelist,domains    1                5            -       "max_ts_locs"   "Maximum number of time series locations"
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   track_level     namelist,domains    1                50000
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1000.
+
+# Physics
+######
+###### MARS SPECIFIC NAMELIST ENTRIES
+######
+rconfig  character planet   namelist,physics  1            "mars"   -    "planet"    "selection of the planet" ""
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_Z0   namelist,physics  max_domains  0        irh  "init_Z0"   "surface roughness"       ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.   ir   "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     gsfcgce_hail        namelist,physics      1              0       rh       "gsfcgce select hail/graupel"  ""      ""
+rconfig   integer     gsfcgce_2ice        namelist,physics      1              0       rh       "gsfcgce select 2ice/3ice"  ""      ""
+rconfig   integer     progn               namelist,physics      max_domains    0       rh       "progn"                 ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    1       h    "RADT"          ""      ""
+rconfig   real    naer                    namelist,physics      max_domains    1e9     rh   "NAER"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer cugd_avedx              namelist,physics      1            1      irh    "cugd_avedx"                    ""      ""
+rconfig   integer clos_choice             namelist,physics      1             0       rh    "clos_choice"                    ""      ""
+rconfig   integer imomentum               namelist,physics      1             0       rh    "imomentum"                    "momentum transport in G3 scheme"      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      max_domains  0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   logical usemonalb               namelist,physics      1            .false.   h    "usemonalb"   "use 2d field vs table values  false=table, True=2d"   ""
+rconfig   integer co2tf                   namelist,physics	1            1         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback         namelist,physics      max_domains   .false.  -     "feedback cumulus to radiation"  ""
+rconfig   integer pxlsm_smois_init           namelist,physics  max_domains   1       irh    "PXLSM_SMOIS_INIT"    "Soil moisture initialization option 0-From analysis 1-From MAVAIL"      ""
+rconfig   integer omlcall                 namelist,physics      1            0         h     "omlcall"     "activate simple ocean mixed layer model  0=no, 1=yes"   ""
+rconfig   real    oml_hml0                namelist,physics      1            50        h     "oml_hml0"    "oml initial mixed layer depth value"   "m"
+rconfig   real    oml_gamma               namelist,physics      1            0.14      h     "oml_gamma"   "oml deep water lapse rate"   "K m-1"
+rconfig   integer isftcflx                namelist,physics      1            0         h     "isftcflx"    "switch to control sfc fluxes"   ""
+rconfig   real    shadlen                 namelist,physics      1            25000.    -     "shadow_length" "maximum length of orographic shadow" "m"
+rconfig   integer slope_rad               namelist,physics      max_domains    0       -     "slope_rad"  "1: use slope-dependent radiation, 0:not" ""
+rconfig   integer topo_shading            namelist,physics      max_domains    0       -     "topo_shading" "1: apply topographic shading to radiation, 0:not" ""
+rconfig   integer no_mp_heating           namelist,physics      1              0       -     "no_mp_heating" "switch to turn of latent heating in mp schemes"   ""
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            max_domains    0       rh       "obs_twindo"        "Half-period time window for nudging"  "hrs"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            max_domains    1       rh       "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   integer     obs_nobs_prt        namelist,fdda            max_domains    0       rh       "obs_nobs_prt"      "Number of current obs to print grid coord. info."   ""
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   ""
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   ""
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   ""
+rconfig   logical     obs_ipf_init        namelist,fdda            1              .true.  h        "obs_ipf_init"      "Enable obs init warning messages"   ""
+
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+# km_opt_dfi is needed for backward integration in dfi
+rconfig   integer km_opt_dfi              namelist,dynamics	1             1       irh    "km_opt_dfi"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.      h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.2     h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    2      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    c_s                     namelist,dynamics	max_domains    0.25    h    "c_s"         "Smagorinsky coeff"      ""
+rconfig   real    c_k                     namelist,dynamics	max_domains    0.15    h    "c_k"         "TKE coeff"      ""
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    6       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_moist_dfi        namelist,dynamics	max_domains    .false.  rh    "pd_moist_dfi"    "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   integer mix_isotropic           namelist,dynamics	max_domains    0       h    "mix_isotropic"            "0=anistropic, 1=isotropic"      ""
+rconfig   real    mix_upper_bound         namelist,dynamics	max_domains    0.1     h    "mix_upper_bound"          "non-dimensional limit"      ""
+rconfig   logical top_lid                 namelist,dynamics     max_domains    .false. rh    "top_lid"               ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical coriolis2d              namelist,dynamics	max_domains  .false.  irh  "coriolis2d"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    fft_filter_lat          namelist,dynamics     1              45.     h    "fft_filter_lat"   ""   "grid latitude to start polar filter"
+rconfig   logical rotated_pole            namelist,dynamics     1            .false.  irh   "rotated_pole"    ""   ""
+rconfig   logical do_coriolis             namelist,dynamics	max_domains  .true.   irh  "do_coriolis"    ""   ""
+rconfig   logical do_curvature            namelist,dynamics	max_domains  .true.   irh  "do_curvature"   ""   ""
+rconfig   logical do_gradp                namelist,dynamics	max_domains  .true.   irh  "do_gradp"    ""   ""
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical polar                   namelist,bdy_control	max_domains    .false. rh    "polar"                 ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   real    spec_exp                namelist,bdy_control          1     0.      irh    "spec_exp"              ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   integer nobs_ndg_vars           derived                       1         5       -        "num_ndg_vars"         "Number of nudging variables"          ""
+rconfig   integer nobs_err_flds           derived                       1         9       -        "num_err_flds"         "Number of error fields"               ""
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none (Cylindrical), 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer use_wps_input           derived                       1         0       -        "use_wps_input"        "0/1 flag, using wps input"      "0=no, 1=yes"
+rconfig   integer dfi_stage               derived                       1         3       -        "dfi_stage"            "current stage of DFI processing"      "0=DFI setup, 1=DFI backward integration, 2=DFI forward integration, 3=WRF forecast"
+rconfig   integer mp_physics_dfi          derived                  max_domains   -1       -        "mp_physics_dfi"       ""      "-1 = no DFI and so no need to allocate DFI moist and scalar variables, >0 = running with DFI, so allocate DFI moist and scalar variables appropriate for selected microphysics package"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   default      mars==0                      -              -
+package   water        mars==1                      -              scalar:qh2o,qh2o_ice
+package   dust1        mars==2                      -              scalar:qdust
+package   dust2eq      mars==3                      -              scalar:qdust,qdustn
+package   newbasis     mars==10                     -              scalar:qco2
+package   newwater     mars==11                     -              scalar:qh2o,qh2o_ice,qdust,qdustn
+package   newwatersca  mars==12                     -              scalar:qh2o,qh2o_ice,qdust,qdustn,qccn,qccnn
+package   radioac      mars==20                     -              scalar:qtrac1
+package   VenusPC      mars==34                     -              scalar:qco2,qco,qh2,qh2o,qo1d,qo,qo2,qo2dg,qo3,qh,qoh,qho2,qh2o2,qcl,qclo,qcl2,qhcl,qhocl,qclco,qclco3,qcocl2,qss,qso,qso2,qso3,qs2o2,qocs,qhso3,qh2so4,qs2,qclso2,qoscl,qh2oliq,qh2so4liq
+package   waterdyn     mars==42                     -              scalar:qh2o,qh2o_ice;moist:qv,qc
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+
+
+#package   passivec1     chem_opt==0                  -             
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   gsfcgcescheme mp_physics==7                -             moist:qv,qc,qr,qi,qs,qg
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+package   morr_two_moment  mp_physics==10            -             moist:qv,qc,qr,qi,qs,qg;scalar:qni,qns,qnr,qng
+
+package   nodfimoist        mp_physics_dfi==-1       -             -
+package   passiveqv_dfi     mp_physics_dfi==0        -             dfi_moist:dfi_qv
+package   kesslerscheme_dfi mp_physics_dfi==1        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr
+package   linscheme_dfi     mp_physics_dfi==2        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   wsm3scheme_dfi    mp_physics_dfi==3        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr
+package   wsm5scheme_dfi    mp_physics_dfi==4        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs
+package   etampnew_dfi      mp_physics_dfi==5        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qt
+package   wsm6scheme_dfi    mp_physics_dfi==6        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   gsfcgcescheme_dfi mp_physics_dfi==7        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   thompson_dfi      mp_physics_dfi==8        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni
+package   morr_two_moment_dfi  mp_physics_dfi==10    -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni,dfi_qns,dfi_qnr,dfi_qng
+
+package   noprogn       progn==0                     -             -
+package   progndrop     progn==1                     -             scalar:qndrop;dfi_scalar:dfi_qndrop
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+package   heldsuarez    ra_lw_physics==31            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             state:regime
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   pxsfcscheme    sf_sfclay_physics==7        -             state:regime
+
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   pxlsmscheme    sf_surface_physics==7       -             fdda2d:t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old
+
+package   ysuscheme      bl_pbl_physics==1           -             state:regime
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   acmpblscheme   bl_pbl_physics==7           -             state:regime
+package   mrfscheme      bl_pbl_physics==99          -             state:regime
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   g3scheme       cu_physics==5               -             state:cugd_qvten,cugd_tten,cugd_qvtens,cugd_ttens,cugd_qcten
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new,t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old,sn_ndg_new,sn_ndg_old;state:rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten
+
+package   restofwrf      use_wps_input==0            -             -
+
+package   dfi_setup      dfi_stage==0                -             -
+package   dfi_bck        dfi_stage==1                -             -
+package   dfi_fwd        dfi_stage==2                -             -
+package   dfi_fst        dfi_stage==3                -             -
+
+#package   digifilter     dfi_opt==1                  -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qndrop,dfi_qni,dfi_qt,dfi_qns,dfi_qnr,dfi_qng;state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt
+package   dfi_nodfi     dfi_opt==0                  -             -
+package   dfi_dfl       dfi_opt==1                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+package   dfi_ddfi      dfi_opt==2                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+package   dfi_tdfi      dfi_opt==3                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+ifdef RUC_CLOUD
+package   realonly       use_wps_input==1            -             state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc,qr_gc,qc_gc,qs_gc,qi_gc,qg_gc,qni_gc
+endif
+ifndef RUC_CLOUD
+package   realonly       use_wps_input==1            -             state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc
+endif
+
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,f,e,sina,cosa,ht,potevp,snopcx,soiltb,xlat,xlong,xlat_u,xlat_v,xlong_u,xlong_v,clat,clong
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw,ustm
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_CUP_G3_IN dyn_em 24:RTHFTEN,RQVFTEN,w_2
+halo      HALO_CUP_G3_OUT dyn_em 48:cugd_tten,cugd_qvten,cugd_ttens,cugd_qvtens,raincv
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+halo      HALO_TOPOSHAD phys 24:ht_shad
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+halo      HALO_EM_HYDRO_UV   dyn_em 8:u_2,v_2
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST_OLD dyn_em 3:moist_old
+period    PERIOD_BDY_EM_CHEM_OLD dyn_em 3:chem_old
+period    PERIOD_BDY_EM_SCALAR_OLD dyn_em 3:scalar_old
+period    PERIOD_BDY_EM_TKE_OLD dyn_em 3:tke_1
+period    PERIOD_EM_HYDRO_UV dyn_em 1:u_2,v_2
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy,ustm
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfvx,msfvy,muu,msfux,msfuy,msfvx_inv
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer NSTAW        # number of obs stations within current time window
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    KNOWN_LAT    # Latitude  of origin point (i,j)=(1,1)
+typedef fdob_type real    KNOWN_LON    # Longitude of origin point (i,j)=(1,1)
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+
+# xpose variables for polar fft
+state    real   t_xxx          ikjx    -           1        -
+state    real   u_xxx          ikjx    -           1        X
+state    real   ru_xxx         ikjx    -           1        X
+state    real   v_xxx          ikjx    -           1        Y
+state    real   rv_xxx         ikjx    -           1        Y
+state    real   w_xxx          ikjx    -           1        Z
+state    real   ww_xxx         ikjx    -           1        Z
+state    real   ph_xxx         ikjx    -           1        Z
+state    real   dum_yyy        ikjy    -           1        -
+state    real   fourd_xxx      ikjx    -           1        -
+state    real   clat_xxx       ijx     -           1        -
+state    real   ht_xxx         ijx     -           1        -
+state    real   mf_xxx         ijx     -           1        -
+
+xpose XPOSE_POLAR_FILTER_TOPO dyn_em t_init,t_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_T  dyn_em t_2,t_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_U  dyn_em u_2,u_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_RU dyn_em ru_m,ru_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_V  dyn_em v_2,v_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_RV dyn_em rv_m,rv_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_W  dyn_em w_2,w_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_WW dyn_em ww_m,ww_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_PH dyn_em ph_2,ph_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_MOIST dyn_em moist,fourd_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_CHEM dyn_em chem,fourd_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_SCALAR dyn_em scalar,fourd_xxx,dum_yyy
+
+##
Index: trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM.newphys.cloud
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM.newphys.cloud	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM.newphys.cloud	(revision 2744)
@@ -0,0 +1,1779 @@
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    n      1     namelist=dfi_time_dim        c          dfi time dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    ?      -     namelist=ts_buf_size      c          ts_buf_size
+dimspec    !      -     namelist=max_ts_locs      c          max_ts_locs
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+####
+####
+#### RADIATIVE TRANSFER
+state  real  HR_SW     ikj   misc  1  -  -  "HR_SW"     "HEATING RATE SW"                 "K/s"
+state  real  HR_LW     ikj   misc  1  -  -  "HR_LW"     "HEATING RATE LW"                 "K/s"
+state  real  SWDOWNZ    ij   misc  1  -  -  "SWDOWNZ"   "DOWNWARD SW FLUX AT SURFACE"     "W m-2"
+#### DUST CYCLE
+state  real  TAU_DUST   ij   misc  1  -  -  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""
+state  real  RDUST     ikj   misc  1  -  -  "RDUST"     "DUST RADIUS"                     "m"
+state  real  QSURFDUST  ij   misc  1  -  -  "QSURFDUST" "DUST MASS AT SURFACE"            "kg m-2"
+#### CLOUDS
+state  real  MTOT       ij   misc  1  -  -  "MTOT"      "TOTAL MASS WATER VAPOR in pmic"  "pmic"
+state  real  ICETOT     ij   misc  1  -  -  "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"
+state  real  VMR_ICE   ikj   misc  1  -  -  "VMR_ICE"   "VOL. MIXING RATIO ICE"           "ppm"
+state  real  TAU_ICE    ij   misc  1  -  -  "TAU_ICE"   "CLOUD OD at 825 cm-1 TES"        ""
+state  real  RICE      ikj   misc  1  -  -  "RICE"      "ICE RADIUS"                      "m"
+#### THERMALS
+state  real  ZMAX       ij   misc  1  -  -  "ZMAX"      "MAXIMUM LEVEL THERMALS"          "m"
+state  real  HFMAX      ij   misc  1  -  -  "HFMAX"     "MAXIMUM PBL HEAT FLUX"           "m.K/s"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                         -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+state  real  qdust     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUST"      "Dust mixing ratio"          "kg kg-1"
+state  real  qdustn    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUSTN"     "Dust number density"        " m-3 "
+state  real  qtrac1    ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "qtrac1"     "Decaying tracer 1"          "kg kg-1"
+state  real  qccn      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCN"         "CCN mixing ratio"          "kg kg-1"
+state  real  qccnn     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt)  "QCCNN"        "CCN number mixing ratio"   "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+
+
+
+
+#state    real   floob       ikjb     dyn_em      1         -    
+#state    real   floob_x     ikjx     dyn_em      1         -     
+#state    real   floob_y     ikjy     dyn_em      1         - 
+#xpose FLOOB dyn_em floob,floob_x,floob_y
+
+#state real xxx ijk misc 2 - h6ud
+#halo  HALO_FLOOB dyn_em  4:xxx_2
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     i02r01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+# znw, znu, dzs, and zs must be listed before any 3-d fields
+# in order for the grib output module to work correctly.  The grib output
+# module retrieves the vertical levels from these parameters.  If znw, znu
+# dzs, and zs are not listed first, vertical level will not be encoded at 
+# time 0.
+
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real   ZS              l        misc      -         Z     ir       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     ir       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+ifdef RUC_CLOUD
+state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+state    real   qni_gc         igj      dyn_em      1        Z     i1  "QNI"   "ice no concentration"   "m-3"
+endif
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   z0_gc           ij   dyn_em  1  -  i1  "SURF_ROUGHNESS"   "surface roughness"       "cm"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+state  real   isoil_gc       igj   dyn_em  1  Z  i1  "ISOIL"            "soil thermal inertia"    "tiu"
+state  real   dsoil_gc       igj   dyn_em  1  Z  i1  "DSOIL"            "soil depths"             "m"
+####
+#### variables dans wrf
+####
+#### 'm_' prefix is to avoid redundancies with possible existing terrestrial variables
+####
+####          vvvv nom pour module_initialize, solve_em, lmd_driver (interne fortran)
+####                                                vvvv nom fichier netCDF (important initialisation
+################################################################################################################
+state  real   m_albedo     ij   misc  1  -  i012rd  "MARS_ALB"     "albedo of naked ground"   "0 - 1 fraction"
+state  real   m_ti         ij   misc  1  -  i012rd  "MARS_TI"      "thermal inertia"          "J/m2/K/s0.5"
+state  real   m_z0         ij   misc  1  -  i012rd  "MARS_Z0"      "surface roughness"        "m"
+state  real   slpx         ij   misc  1  -  i012rd  "SLOPEX"       "slope x direction"        "rad"
+state  real   slpy         ij   misc  1  -  i012rd  "SLOPEY"       "slope y direction"        "rad"
+state  real   m_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"   "emissivity"               "0 - 1 fraction"
+state  real   m_co2ice     ij   misc  1  -  i012rd  "MARS_CICE"    "co2 ground ice"           "kg/m2"
+state  real   m_h2oice     ij   misc  1  -  i012rd  "MARS_WICE"    "h2o ground ice"           "kg/m2"
+state  real   m_fluxrad    ij   misc  1  -  i012rd  "MARS_FLUXRAD" "net rad flux at surf"     "W.m-2"
+state  real   m_wstar      ij   misc  1  -  i012rd  "MARS_WSTAR"   "free convection velocity" "m.s-1"
+state  real   m_tsurf      ij   misc  1  -  i012rhd "MARS_TSURF"   "surface temperature"      "K"
+state  real   m_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"   "soil temperatures"        "K"
+state  real   m_q2        ikj   misc  1  Z  i012rd  "MARS_Q2"      "parameterized TKE"        "kg.m-3"
+state  real   m_isoil     ilj   misc  1  -  i012rd  "MARS_ISOIL"   "soil thermal inertia"     "tiu"
+state  real   m_dsoil     ilj   misc  1  -  i012rd  "MARS_DSOIL"   "soil depths"              "m"
+state  real   m_gw        ilj   misc  1  -  i012rd  "MARS_GW"      "gwparam"                  " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mub_save        ij     dyn_em      1         -      -           "mub_save" "nest temp, holds orig fine grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   ru=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -       r         "potevp" "accumulated potential evaporation" "W m-2"
+state    real   snopcx         ij      dyn_em      1         -       r         "snopcx" "snow phase change heat flux" "W m-2"
+state    real   soiltb         ij      dyn_em      1         -       -         "soiltb" "bottom soil temperature" "K"
+state    real    fnm            k       dyn_em      1         -     ir       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     ir       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     ir       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     ir       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     ir       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     ir       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATE T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     ir       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     ir       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rhd    "PSFC"                 "SFC PRESSURE"      "Pa"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -      r          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -      r          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -      r          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     ir       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     ir       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     ir       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     ir       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     ir       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     ir       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     ir       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     r         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     r         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+# indicates whether to recompute mu                                                             
+state   logical press_adj      -        -          -         -     -         "press_adj"         "T/F flag adjust mu"         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+state   real    -              ikjftb   dfi_moist       1         -     -    -
+state   real    dfi_qv         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QVAPOR"       "Water vapor mixing ratio"      "kg kg-1"
+state   real    dfi_qc         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QCLOUD"       "Cloud water mixing ratio"      "kg kg-1"
+state   real    dfi_qr         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QRAIN"        "Rain water mixing ratio"       "kg kg-1"
+state   real    dfi_qi         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QICE"         "Ice mixing ratio"              "kg kg-1"
+state   real    dfi_qs         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QSNOW"        "Snow mixing ratio"             "kg kg-1"
+state   real    dfi_qg         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QGRAUP"       "Graupel mixing ratio"          "kg kg-1"
+
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -   -
+state   real    qndrop         ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNDROP"        "Droplet number mixing ratio"        "# kg-1"
+state   real    qni            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg-1"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+state   real    qns            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNSNOW"         "Snow Number concentration"   "# kg(-1)"
+state   real    qnr            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNRAIN"        "Rain Number concentration"   "# kg(-1)"
+state   real    qng            ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNGRAUPEL"     "Graupel Number concentration" "# kg(-1)"
+state   real    -              ikjftb  dfi_scalar      1         -     -   -
+state   real    dfi_qndrop     ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNDROP"    "Droplet number mixing ratio"        "# kg-1"
+state   real    dfi_qni        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNICE"     "Ice Number concentration" "# kg-1"
+state   real    dfi_qt         ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_CWM"       "Total condensate mixing ratio"      "kg kg-1"
+state   real    dfi_qns        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNSNOW"    "Snow Number concentration"   "# kg(-1)"
+state   real    dfi_qnr        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNRAIN"    "Rain Number concentration"   "# kg(-1)"
+state   real    dfi_qng        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNGRAUPEL" "Graupel Number concentration" "# kg(-1)"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i012r   "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i012    "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i012    "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+
+# Time series variables
+state    real   ts_hour         ?!       misc      -         -      r        "TS_HOUR"        "Model integration time, hours"
+state    real   ts_u            ?!       misc      -         -      r        "TS_U"           "Surface wind U-component, earth-relative"
+state    real   ts_v            ?!       misc      -         -      r        "TS_V"           "Surface wind V-component, earth-relative"
+state    real   ts_q            ?!       misc      -         -      r        "TS_Q"           "Surface mixing ratio"
+state    real   ts_t            ?!       misc      -         -      r        "TS_T"           "Surface temperature"
+state    real   ts_psfc         ?!       misc      -         -      r        "TS_PSFC"        "Surface pressure"
+state    real   ts_glw          ?!       misc      -         -      r        "TS_GLW"         "Downward long wave flux at surface"
+state    real   ts_gsw          ?!       misc      -         -      r        "TS_GSW"         "Net short wave flux at surface"
+state    real   ts_hfx          ?!       misc      -         -      r        "TS_HFX"         "Upward heat flux at surface"
+state    real   ts_lh           ?!       misc      -         -      r        "TS_LH"          "Upward moisture flux at surface"
+state    real   ts_tsk          ?!       misc      -         -      r        "TS_TSK"         "Skin temperature"
+state    real   ts_tslb         ?!       misc      -         -      r        "TS_TSLB"        "Soil temperature"
+state    real   ts_clw          ?!       misc      -         -      r        "TS_CLW"         "Column integrated cloud water"
+state    real   ts_rainc        ?!       misc      -         -      r        "TS_RAINC"       "Cumulus precip"
+state    real   ts_rainnc       ?!       misc      -         -      r        "TS_RAINNC"      "Grid-scale precip"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i0124rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "SEAICE"             "SEA ICE FLAG"  ""
+state    real   XICEM            ij     misc        1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICEM"             "SEA ICE FLAG (PREVIOUS STEP)"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0124rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                          "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+state    real   SNOW             ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0124rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# DFI variables
+state   real   hcoeff           n    misc        1         -     -    "HCOEFF"               "initialization weights"
+state   real   hcoeff_tot       -    misc        1         -     -    "HCOEFF_TOT"               "initialization weights"
+state   real   dfi_p           ikj   misc        1         -     r    "P_DFI"           "perturbation pressure"         "Pa"
+state   real   dfi_al          ikj   misc        1         -     r    "AL_DFI"          "inverse perturbation density"  "m3 kg-1"
+state   real   dfi_mu          ij    misc        1         -     r    "MU_DFI"  "perturbation dry air mass in column" "Pa"
+state   real   dfi_phb         ikj   misc        1         Z     r    "PHB_DFI"  "base-state geopotential"  "m2 s-2"
+state   real   dfi_ph0         ikj   misc        1         Z     r    "PH0_DFI"  "initial geopotential"     "m2 s-2"
+state   real   dfi_php         ikj   misc        1         Z     r    "PHP_DFI"  "geopotential"             "m2 s-2"
+state   real   dfi_u           ikj   misc        1         -     r    "U_DFI"               "u accumulation array"          "   "
+state   real   dfi_v           ikj   misc        1         -     r    "V_DFI"               "v accumulation array"          "   "
+state   real   dfi_w           ikj   misc        1         -     r    "W_DFI"               "w accumulation array"          "   "
+state   real   dfi_ww          ikj   misc        1         Z     r    "WW_DFI"              "mu-coupled eta-dot"    "Pa s-1"
+state   real   dfi_t           ikj   misc        1         -     r    "TT_DFI"               "t accumulation array"          "   "
+state   real   dfi_ph          ikj   misc        1         -     r    "PH_DFI"               "p accumulation array"          "   "
+state   real   dfi_pb          ikj   misc        1         -     r    "PB_DFI"               "pb accumulation array"          "   "
+state   real   dfi_alt         ikj   misc        1         -     r    "ALT_DFI"             "1/rho accumulation array"          "   "
+state   real   dfi_tke         ikj   misc        1         -     r    "TKE_DFI"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+
+state    real  dfi_TSLB        ilj   misc        1         Z     r    "TSLB_dfi"         "SOIL TEMPERATURE"   "K"
+state    real  dfi_SMOIS       ilj    -          1         Z     r    "SMOIS_dfi"        "SOIL MOISTURE"     "m3 m-3"
+state    real  dfi_SNOW        ij    misc        1         -     r    "SNOW_dfi"         "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real  dfi_SNOWH       ij    misc        1         -     r    "SNOWH_dfi"        "PHYSICAL SNOW DEPTH"      "m"
+state    real  dfi_CANWAT      ij    misc        1         -     r    "CANWAT_dfi"       "CANOPY WATER"             "kg m-2"
+state    real  dfi_SMFR3D      ilj   misc        1         Z     r    "SMFR3D_dfi"           "SOIL ICE" ""
+state    real  dfi_KEEPFR3DFLAG ilj  misc        1         Z     r    "KEEPFR3DFLAG_dfi"     "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# Additional for P-X PBL and LSM
+state    real   RA               ij     misc        1         -      r        "RA"           "AERODYNAMIC RESISTANCE"   "s m-1"
+state    real   RS               ij     misc        1         -      r        "RS"           "SURFACE RESISTANCE"       "s m-1"
+state    real   LAI              ij     misc        1         -      r        "LAI"          "Leaf area index"          "area/area"
+state    real   VEGF_PX          ij     misc        1         -      r        "VEGF_PX"      "Vegetation Fraction for PX LSM"    "area/area"
+state    real   T2OBS            ij     misc        1         -      r        "T2OBS"        "2-m temperature from analysis "          "K"
+state    real   Q2OBS            ij     misc        1         -      r        "Q2OBS"        "2-m mixing ratio from analysis "         "kg/kg"
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+state   real   TSHLTR           ij     misc        1         -     ir        "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"
+state   real   QSHLTR           ij     misc        1         -     ir        "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+state   real   PSHLTR           ij     misc        1         -     ir        "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+state   real   TH10             ij     misc        1         -     ir        "TH10"                  "10-M THETA FROM MYJ"                          "K"
+state   real   Q10              ij     misc        1         -     ir        "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+state    real    qndropsource    ikj    misc        1         -      -        "qndropsource"         "Droplet number source"   "#/kg/s"
+
+# Other Misc State Variables                                            
+state   real    h_diabatic     ikj     misc         1         -      rdu      "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         "K s-1"      
+state   real    msft           ij      misc         1         -     i012rdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    msftx          ij      misc         1         -     i012rdu=(copy_fcnm)    "MAPFAC_MX"         "Map scale factor on mass grid, x direction" ""
+state   real    msfty          ij      misc         1         -     i012rdu=(copy_fcnm)    "MAPFAC_MY"         "Map scale factor on mass grid, y direction" ""
+state   real    msfux          ij      misc         1         X     i012rdu=(copy_fcnm)    "MAPFAC_UX"         "Map scale factor on u-grid, x direction" ""
+state   real    msfuy          ij      misc         1         X     i012rdu=(copy_fcnm)    "MAPFAC_UY"         "Map scale factor on u-grid, y direction" ""
+state   real    msfvx          ij      misc         1         Y     i012rdu=(copy_fcnm)    "MAPFAC_VX"         "Map scale factor on v-grid, x direction" ""
+state   real    msfvx_inv      ij      misc         1         Y     i012rdu=(copy_fcnm)    "MF_VX_INV"         "Inverse map scale factor on v-grid, x direction" ""
+state   real    msfvy          ij      misc         1         Y     i012rdu=(copy_fcnm)    "MAPFAC_VY"         "Map scale factor on v-grid, y direction" ""
+
+state   real    f              ij      misc         1         -     i012rdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+state   real    ht             ij      misc         1         -     i012rdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+state   real    ht_shad        ijb     misc         1         -     df=(bdy_interp:dt)         "HGT_SHAD"        "Height of orographic shadow"   "m"
+i1      real    ht_loc         ij      misc         1         -     - 
+i1      integer  shadowmask    ij      misc         1         -     - 
+state   integer min_ptchsz     -       misc         1         -     r
+
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    dfi_TSK        ij      misc         1         -     r                       "TSK_dfi"               "saved SURFACE SKIN TEMPERATURE"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     ir       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    max_msftx      -       misc         -         -      r       "max_mstfx"             "Max map factor in domain"  ""
+state   real    max_msfty      -       misc         -         -      r       "max_mstfy"             "Max map factor in domain"  ""
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  PRATEC           ij      misc        1         -      r       "PRATEC"                "PRECIP RATE FROM CUMULUS SCHEME"                         "mm s-1"
+state    real  RAINCV           ij      misc        1         -      r       "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc        1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc        1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc        1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc        1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc        1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc        1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc        1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc        1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  edt_out          ij      misc        1         -      -        "EDT_OUT"             "EDT FROM GD SCHEME"             ""
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"     "mb hour-1"
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"
+state    real  cugd_tten        ikj     misc        1         -      h        "CUGD_TTEN"             "INITIAL TTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qvten       ikj     misc        1         -      h        "CUGD_QVTEN"            "INITIAL QTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_ttens       ikj     misc        1         -      h        "CUGD_TTENS"            "INITIAL SUBSIDENCE TTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qvtens      ikj     misc        1         -      h        "CUGD_QVTENS"           "INITIAL SUBSIDNCE QTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qcten       ikj     misc        1         -      h        "CUGD_QCTEN"            "INITIAL TEMPERATURE TENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+#state    real  ACLWUPTC         ij      misc       1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "UNCOUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "UNCOUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+
+state    real  SWDOWN           ij      misc        1         -      rd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GLW              ij      misc        1         -      rd      "GLW"                   "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE"            "W m-2"      
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r        "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123r01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123r01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012r01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012r01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012r01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012r01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r          "ALBEDO"                   "ALBEDO"
+state    real  CLAT             ij      misc        1         -     i012rdu=(copy_fcnm)          "CLAT"                "COMPUTATIONAL GRID LATITUDE, SOUTH IS NEGATIVE"                       "degree_north"
+state    real  CLONG            ij      misc        1         -     i012rdu=(copy_fcnm)          "CLONG"               "COMPUTATIONAL GRID LONGITUDE, WEST IS NEGATIVE"                       "degree_east"
+state    real  ALBBCK           ij      misc        1         -     i0124r   "ALBBCK"                "BACKGROUND ALBEDO"        ""
+state    real  EMBCK            ij      misc        1         -      r        "EMBCK"                 "BACKGROUND EMISSIVITY"         ""
+state    real  EMISS            ij      misc        1         -      r       "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  CK               ij      misc        1         -      r        "CK"                    "ENTHALPY EXCHANGE COEFF AT 10 m"                      ""
+state    real  CKA              ij      misc        1         -      r        "CKA"                   "ENTHALPY EXCHANGE COEFF AT LOWEST MODEL LVL"          ""
+state    real  CD               ij      misc        1         -      r        "CD"                    "DRAG COEFF AT 10m"                      ""
+state    real  CDA              ij      misc        1         -      r        "CDA"                   "DRAG COEFF AT LOWEST MODEL LVL"                      ""
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"    
+state    real  USTM             ij      misc        1         -      rh       "USTM"                  "U* IN SIMILARITY THEORY WITHOUT VCONV"        "m s-1"    #SAVEMARS2 ustar
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -      r        "RMOL"                  "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r       "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"     #SAVEMARS2 sensheat
+state    real  QFX              ij      misc        1         -      r       "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r       "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  dfi_QVG          ij      misc        1         -      r        "QVG_dfi"               "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  dfi_SOILT1       ij      misc        1         -      r        "SOILT1_dfi"            "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+state    real  dfi_TSNAV        ij      misc        1         -      r        "TSNAV_dfi"             "AVERAGE SNOW TEMPERATURE "                    "C"
+state    real  REGIME           ij      misc        1         -      r        "REGIME"  "FLAGS: 1=Night/Stable, 2=Mechanical Turbulent, 3=Forced Conv, 4=Free Conv" ""
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  dfi_SNOWC        ij      misc        1         -      r        "SNOWC_dfi"             "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  T2_NDG_NEW        ivjf     fdda2d      1         -      igr      "T2_NDG_NEW"               "NEW 2m TEMP FOR PX LSM "  "K"
+state    real  Q2_NDG_NEW        ivjf     fdda2d      1         -      igr      "Q2_NDG_NEW"               "NEW 2m WATER VAPOR MIX RATIO FOR PX LSM "  "kg/kg"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  T2_NDG_OLD        ivjf     fdda2d      1         -      igr      "T2_NDG_OLD"               "OLD 2m TEMP F FOR PX LSM"  "K"
+state    real  Q2_NDG_OLD        ivjf     fdda2d      1         -      igr      "Q2_NDG_OLD"               "OLD 2m WATER VAPOR MIX RATIO  FOR PX LSM"  "kg/kg"
+state    real  SN_NDG_NEW        ivjf     fdda2d      1         -      igr      "SN_NDG_NEW"               "NEW Snow Depth "  "m"
+state    real  SN_NDG_OLD        ivjf     fdda2d      1         -      igr      "SN_NDG_OLD"               "OLD Snow Depth"  "m"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+state   real    max_cfl         -       misc        1         -     -       "max_cfl"           "maximum CFL value in grid at a time" "-"
+
+# Ocean Mixed-Layer State Variables
+state   real    TML            ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "TML"    "OCEAN MIXED-LAYER TEMPERATURE"   "K"
+state   real    T0ML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "T0ML"   "INITIAL OCEAN MIXED-LAYER TEMPERATURE"   "K"
+state   real    HML            ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HML"    "OCEAN MIXED-LAYER DEPTH"   "m"
+state   real    H0ML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "H0ML"   "INITIAL OCEAN MIXED-LAYER DEPTH"   "m"
+state   real    HUML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HUML"   "OCEAN MIXED-LAYER DEPTH * U-CURRENT"  " m2s-1 "
+state   real    HVML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HVML"   "OCEAN MIXED-LAYER DEPTH * V-CURRENT"  " m2s-1 " 
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    2024   irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      01    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      01    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      00    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    2024    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      01    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      02    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      00    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 11, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+rconfig   logical all_ic_times            namelist,time_control		1              .false. irh    "all_ic_times"     "T/F WRITE ALL IC TIME PERIODS"  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# DFI namelist
+rconfig   integer dfi_opt                namelist,dfi_control   1       0     rh   "dfi_opt"                ""      ""
+rconfig   integer dfi_nfilter            namelist,dfi_control   1       7     rh   "dfi_nfilter"                "Digital filter type"      ""
+rconfig   logical dfi_write_filtered_input  namelist,dfi_control  1  .true.   rh   "dfi_write_filtered_input"                "Write a wrfinput_filtered_d0n file?"      ""
+rconfig   logical dfi_write_dfi_history  namelist,dfi_control   1   .false.   rh   "dfi_write_dfi_history"    "Write history files during filtering?"      ""
+rconfig   integer dfi_cutoff_seconds     namelist,dfi_control   1    3600     rh   "dfi_cutoff_seconds"       "Digital filter cutoff time"      ""
+rconfig   integer dfi_time_dim           namelist,dfi_control   1    1000     rh   "dfi_time_dim"             "MAX DIMENSION FOR HCOEFF"
+rconfig   integer dfi_fwdstop_year       namelist,dfi_control   1    2004     rh   "dfi_fwdstop_year"         "4 DIGIT YEAR OF START OF DFI" "YEARS"
+rconfig   integer dfi_fwdstop_month      namelist,dfi_control   1      03     rh   "dfi_fwdstop_month"        "2 DIGIT MONTH OF THE YEAR OF START OF DFI" "MONTHS"
+rconfig   integer dfi_fwdstop_day        namelist,dfi_control   1      13     rh   "dfi_fwdstop_day"          "2 DIGIT DAY OF THE MONTH OF START OF DFI" "DAYS"
+rconfig   integer dfi_fwdstop_hour       namelist,dfi_control   1      12     rh   "dfi_fwdstop_hour"         "2 DIGIT HOUR OF THE DAY OF START OF DFI" "HOURS"
+rconfig   integer dfi_fwdstop_minute     namelist,dfi_control   1      00     rh   "dfi_fwdstop_minute"       "2 DIGIT MINUTE OF THE HOUR OF START OF DFI" "MINUTES"
+rconfig   integer dfi_fwdstop_second     namelist,dfi_control   1      00     rh   "dfi_fwdstop_second"       "2 DIGIT SECOND OF THE MINUTE OF START OF DFI" "SECONDS"
+rconfig   integer dfi_bckstop_year       namelist,dfi_control   1    2004     rh   "dfi_bckstop_year"         "4 DIGIT YEAR OF END OF DFI" "YEARS"
+rconfig   integer dfi_bckstop_month      namelist,dfi_control   1      03     rh   "dfi_bckstop_month"        "2 DIGIT MONTH OF THE YEAR OF END OF DFI" "MONTHS"
+rconfig   integer dfi_bckstop_day        namelist,dfi_control   1      14     rh   "dfi_bckstop_day"          "2 DIGIT DAY OF THE MONTH OF END OF DFI" "DAYS"
+rconfig   integer dfi_bckstop_hour       namelist,dfi_control   1      12     rh   "dfi_bckstop_hour"         "2 DIGIT HOUR OF THE DAY OF END OF DFI" "HOURS"
+rconfig   integer dfi_bckstop_minute     namelist,dfi_control   1      00     rh   "dfi_bckstop_minute"       "2 DIGIT MINUTE OF THE HOUR OF END OF DFI" "MINUTES"
+rconfig   integer dfi_bckstop_second     namelist,dfi_control   1      00     rh   "dfi_bckstop_second"       "2 DIGIT SECOND OF THE MINUTE OF END OF DFI" "SECONDS"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+
+rconfig   integer min_time_step           namelist,domains      max_domains   -1      h    "min_time_step"
+rconfig   integer max_time_step           namelist,domains      max_domains   -1      h    "max_time_step"
+rconfig   real    target_cfl              namelist,domains      max_domains  1.2      h    "target_cfl"
+rconfig   integer max_step_increase_pct   namelist,domains      max_domains    5      h    "max_step_increase_pct"
+rconfig   integer starting_time_step      namelist,domains      max_domains   -1      h    "starting_time_step"
+rconfig   logical step_to_output_time     namelist,domains      1         .true.      h    "step_to_output_time"
+rconfig   logical use_adaptive_time_step  namelist,domains      1         .false.     h    "use_adaptive_time_step"
+
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              27      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              5000    irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"  ""
+rconfig   integer extrap_type             namelist,domains	1              2       irh    "extrap_type"  "1= use 2 lowest levels, 2=constant"  ""
+rconfig   integer t_extrap_type           namelist,domains	1              2       irh    "t_extrap_type"  "1=isothermal, 2=6.5 K/km, 3=adiabatic"   ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   logical use_levels_below_ground namelist,domains	1             .true.   irh    "use_levels_below_ground"   "T/F: use input data levels below input sfc pres" ""
+rconfig   logical use_surface             namelist,domains	1             .true.   irh    "use_surface"   "T/F: use input surface level in interpolation" ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              1       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              500     irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .false. irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   logical smooth_cg_topo          namelist,domains	1              .false. irh    "smooth_cg_topo"   "T/F smooth CG topo on boundarries" "flag"
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   logical grid_allowed            namelist,domains	max_domains    .true.  irh    "allowed"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       rh     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       rh     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   ts_buf_size     namelist,domains    1                200          -       "ts_buf_size"   "Size of time series buffer"
+rconfig   integer   max_ts_locs     namelist,domains    1                5            -       "max_ts_locs"   "Maximum number of time series locations"
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   track_level     namelist,domains    1                50000
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1000.
+
+# Physics
+######
+###### MARS SPECIFIC NAMELIST ENTRIES
+######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_Z0   namelist,physics  max_domains  0        irh  "init_Z0"   "surface roughness"       ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.   ir   "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     gsfcgce_hail        namelist,physics      1              0       rh       "gsfcgce select hail/graupel"  ""      ""
+rconfig   integer     gsfcgce_2ice        namelist,physics      1              0       rh       "gsfcgce select 2ice/3ice"  ""      ""
+rconfig   integer     progn               namelist,physics      max_domains    0       rh       "progn"                 ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    1       h    "RADT"          ""      ""
+rconfig   real    naer                    namelist,physics      max_domains    1e9     rh   "NAER"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer cugd_avedx              namelist,physics      1            1      irh    "cugd_avedx"                    ""      ""
+rconfig   integer clos_choice             namelist,physics      1             0       rh    "clos_choice"                    ""      ""
+rconfig   integer imomentum               namelist,physics      1             0       rh    "imomentum"                    "momentum transport in G3 scheme"      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      max_domains  0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   logical usemonalb               namelist,physics      1            .false.   h    "usemonalb"   "use 2d field vs table values  false=table, True=2d"   ""
+rconfig   integer co2tf                   namelist,physics	1            1         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback         namelist,physics      max_domains   .false.  -     "feedback cumulus to radiation"  ""
+rconfig   integer pxlsm_smois_init           namelist,physics  max_domains   1       irh    "PXLSM_SMOIS_INIT"    "Soil moisture initialization option 0-From analysis 1-From MAVAIL"      ""
+rconfig   integer omlcall                 namelist,physics      1            0         h     "omlcall"     "activate simple ocean mixed layer model  0=no, 1=yes"   ""
+rconfig   real    oml_hml0                namelist,physics      1            50        h     "oml_hml0"    "oml initial mixed layer depth value"   "m"
+rconfig   real    oml_gamma               namelist,physics      1            0.14      h     "oml_gamma"   "oml deep water lapse rate"   "K m-1"
+rconfig   integer isftcflx                namelist,physics      1            0         h     "isftcflx"    "switch to control sfc fluxes"   ""
+rconfig   real    shadlen                 namelist,physics      1            25000.    -     "shadow_length" "maximum length of orographic shadow" "m"
+rconfig   integer slope_rad               namelist,physics      max_domains    0       -     "slope_rad"  "1: use slope-dependent radiation, 0:not" ""
+rconfig   integer topo_shading            namelist,physics      max_domains    0       -     "topo_shading" "1: apply topographic shading to radiation, 0:not" ""
+rconfig   integer no_mp_heating           namelist,physics      1              0       -     "no_mp_heating" "switch to turn of latent heating in mp schemes"   ""
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            max_domains    0       rh       "obs_twindo"        "Half-period time window for nudging"  "hrs"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            max_domains    1       rh       "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   integer     obs_nobs_prt        namelist,fdda            max_domains    0       rh       "obs_nobs_prt"      "Number of current obs to print grid coord. info."   ""
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   ""
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   ""
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   ""
+rconfig   logical     obs_ipf_init        namelist,fdda            1              .true.  h        "obs_ipf_init"      "Enable obs init warning messages"   ""
+
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+# km_opt_dfi is needed for backward integration in dfi
+rconfig   integer km_opt_dfi              namelist,dynamics	1             1       irh    "km_opt_dfi"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.      h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.2     h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    2      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    c_s                     namelist,dynamics	max_domains    0.25    h    "c_s"         "Smagorinsky coeff"      ""
+rconfig   real    c_k                     namelist,dynamics	max_domains    0.15    h    "c_k"         "TKE coeff"      ""
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    6       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_moist_dfi        namelist,dynamics	max_domains    .false.  rh    "pd_moist_dfi"    "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   integer mix_isotropic           namelist,dynamics	max_domains    0       h    "mix_isotropic"            "0=anistropic, 1=isotropic"      ""
+rconfig   real    mix_upper_bound         namelist,dynamics	max_domains    0.1     h    "mix_upper_bound"          "non-dimensional limit"      ""
+rconfig   logical top_lid                 namelist,dynamics     max_domains    .false. rh    "top_lid"               ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical coriolis2d              namelist,dynamics	max_domains  .false.  irh  "coriolis2d"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    fft_filter_lat          namelist,dynamics     1              45.     h    "fft_filter_lat"   ""   "grid latitude to start polar filter"
+rconfig   logical rotated_pole            namelist,dynamics     1            .false.  irh   "rotated_pole"    ""   ""
+rconfig   logical do_coriolis             namelist,dynamics	max_domains  .true.   irh  "do_coriolis"    ""   ""
+rconfig   logical do_curvature            namelist,dynamics	max_domains  .true.   irh  "do_curvature"   ""   ""
+rconfig   logical do_gradp                namelist,dynamics	max_domains  .true.   irh  "do_gradp"    ""   ""
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical polar                   namelist,bdy_control	max_domains    .false. rh    "polar"                 ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   real    spec_exp                namelist,bdy_control          1     0.      irh    "spec_exp"              ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   integer nobs_ndg_vars           derived                       1         5       -        "num_ndg_vars"         "Number of nudging variables"          ""
+rconfig   integer nobs_err_flds           derived                       1         9       -        "num_err_flds"         "Number of error fields"               ""
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none (Cylindrical), 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer use_wps_input           derived                       1         0       -        "use_wps_input"        "0/1 flag, using wps input"      "0=no, 1=yes"
+rconfig   integer dfi_stage               derived                       1         3       -        "dfi_stage"            "current stage of DFI processing"      "0=DFI setup, 1=DFI backward integration, 2=DFI forward integration, 3=WRF forecast"
+rconfig   integer mp_physics_dfi          derived                  max_domains   -1       -        "mp_physics_dfi"       ""      "-1 = no DFI and so no need to allocate DFI moist and scalar variables, >0 = running with DFI, so allocate DFI moist and scalar variables appropriate for selected microphysics package"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   default      mars==0                      -              -
+package   water        mars==1                      -              scalar:qh2o,qh2o_ice
+package   dust1        mars==2                      -              scalar:qdust
+package   dust2eq      mars==3                      -              scalar:qdust,qdustn
+package   newbasis     mars==10                     -              scalar:qco2
+package   newwater     mars==11                     -              scalar:qh2o,qh2o_ice,qdust,qdustn
+package   newwatersca  mars==12                     -              scalar:qh2o,qh2o_ice,qdust,qdustn,qccn,qccnn
+package   radioac      mars==20                     -              scalar:qtrac1
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+
+
+#package   passivec1     chem_opt==0                  -             
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   gsfcgcescheme mp_physics==7                -             moist:qv,qc,qr,qi,qs,qg
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+package   morr_two_moment  mp_physics==10            -             moist:qv,qc,qr,qi,qs,qg;scalar:qni,qns,qnr,qng
+
+package   nodfimoist        mp_physics_dfi==-1       -             -
+package   passiveqv_dfi     mp_physics_dfi==0        -             dfi_moist:dfi_qv
+package   kesslerscheme_dfi mp_physics_dfi==1        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr
+package   linscheme_dfi     mp_physics_dfi==2        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   wsm3scheme_dfi    mp_physics_dfi==3        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr
+package   wsm5scheme_dfi    mp_physics_dfi==4        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs
+package   etampnew_dfi      mp_physics_dfi==5        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qt
+package   wsm6scheme_dfi    mp_physics_dfi==6        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   gsfcgcescheme_dfi mp_physics_dfi==7        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   thompson_dfi      mp_physics_dfi==8        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni
+package   morr_two_moment_dfi  mp_physics_dfi==10    -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni,dfi_qns,dfi_qnr,dfi_qng
+
+package   noprogn       progn==0                     -             -
+package   progndrop     progn==1                     -             scalar:qndrop;dfi_scalar:dfi_qndrop
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+package   heldsuarez    ra_lw_physics==31            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             state:regime
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   pxsfcscheme    sf_sfclay_physics==7        -             state:regime
+
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   pxlsmscheme    sf_surface_physics==7       -             fdda2d:t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old
+
+package   ysuscheme      bl_pbl_physics==1           -             state:regime
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   acmpblscheme   bl_pbl_physics==7           -             state:regime
+package   mrfscheme      bl_pbl_physics==99          -             state:regime
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   g3scheme       cu_physics==5               -             state:cugd_qvten,cugd_tten,cugd_qvtens,cugd_ttens,cugd_qcten
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new,t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old,sn_ndg_new,sn_ndg_old;state:rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten
+
+package   restofwrf      use_wps_input==0            -             -
+
+package   dfi_setup      dfi_stage==0                -             -
+package   dfi_bck        dfi_stage==1                -             -
+package   dfi_fwd        dfi_stage==2                -             -
+package   dfi_fst        dfi_stage==3                -             -
+
+#package   digifilter     dfi_opt==1                  -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qndrop,dfi_qni,dfi_qt,dfi_qns,dfi_qnr,dfi_qng;state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt
+package   dfi_nodfi     dfi_opt==0                  -             -
+package   dfi_dfl       dfi_opt==1                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+package   dfi_ddfi      dfi_opt==2                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+package   dfi_tdfi      dfi_opt==3                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+ifdef RUC_CLOUD
+package   realonly       use_wps_input==1            -             state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc,qr_gc,qc_gc,qs_gc,qi_gc,qg_gc,qni_gc
+endif
+ifndef RUC_CLOUD
+package   realonly       use_wps_input==1            -             state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc
+endif
+
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,f,e,sina,cosa,ht,potevp,snopcx,soiltb,xlat,xlong,xlat_u,xlat_v,xlong_u,xlong_v,clat,clong
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw,ustm
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_CUP_G3_IN dyn_em 24:RTHFTEN,RQVFTEN,w_2
+halo      HALO_CUP_G3_OUT dyn_em 48:cugd_tten,cugd_qvten,cugd_ttens,cugd_qvtens,raincv
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+halo      HALO_TOPOSHAD phys 24:ht_shad
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+halo      HALO_EM_HYDRO_UV   dyn_em 8:u_2,v_2
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST_OLD dyn_em 3:moist_old
+period    PERIOD_BDY_EM_CHEM_OLD dyn_em 3:chem_old
+period    PERIOD_BDY_EM_SCALAR_OLD dyn_em 3:scalar_old
+period    PERIOD_BDY_EM_TKE_OLD dyn_em 3:tke_1
+period    PERIOD_EM_HYDRO_UV dyn_em 1:u_2,v_2
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy,ustm
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfvx,msfvy,muu,msfux,msfuy,msfvx_inv
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer NSTAW        # number of obs stations within current time window
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    KNOWN_LAT    # Latitude  of origin point (i,j)=(1,1)
+typedef fdob_type real    KNOWN_LON    # Longitude of origin point (i,j)=(1,1)
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+
+# xpose variables for polar fft
+state    real   t_xxx          ikjx    -           1        -
+state    real   u_xxx          ikjx    -           1        X
+state    real   ru_xxx         ikjx    -           1        X
+state    real   v_xxx          ikjx    -           1        Y
+state    real   rv_xxx         ikjx    -           1        Y
+state    real   w_xxx          ikjx    -           1        Z
+state    real   ww_xxx         ikjx    -           1        Z
+state    real   ph_xxx         ikjx    -           1        Z
+state    real   dum_yyy        ikjy    -           1        -
+state    real   fourd_xxx      ikjx    -           1        -
+state    real   clat_xxx       ijx     -           1        -
+state    real   ht_xxx         ijx     -           1        -
+state    real   mf_xxx         ijx     -           1        -
+
+xpose XPOSE_POLAR_FILTER_TOPO dyn_em t_init,t_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_T  dyn_em t_2,t_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_U  dyn_em u_2,u_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_RU dyn_em ru_m,ru_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_V  dyn_em v_2,v_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_RV dyn_em rv_m,rv_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_W  dyn_em w_2,w_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_WW dyn_em ww_m,ww_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_PH dyn_em ph_2,ph_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_MOIST dyn_em moist,fourd_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_CHEM dyn_em chem,fourd_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_SCALAR dyn_em scalar,fourd_xxx,dum_yyy
+
+##
Index: trunk/WRF.COMMON/WRFV3/modif_mars/Registry.bash
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/Registry.bash	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/Registry.bash	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/Registry/Registry.bash
Index: trunk/WRF.COMMON/WRFV3/modif_mars/configure_new.defaults
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/configure_new.defaults	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/configure_new.defaults	(revision 2744)
@@ -0,0 +1,862 @@
+
+###########################################################
+#ARCH    Linux i486 i586 i686, gfortran compiler with gcc #serial smpar dmpar dm+sm
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -fopenmp
+SFC             =       gfortran
+SCC             =       gcc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       # -fdefault-real-8  # uncomment manually
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -w -O3 -c -DLANDREAD_STUB
+LDFLAGS_LOCAL   =
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3 -ftree-vectorize -ftree-loop-linear -funroll-loops
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT         =       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -ffixed-form
+FORMAT_FREE     =       -ffree-form -ffree-line-length-none
+FCSUFFIX        =       
+BYTESWAPIO      =       -fconvert=big-endian -frecord-marker=4
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Linux i486 i586 i686, g95 compiler with gcc #serial dmpar
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # not supported
+OMP             =       # not supported
+SFC             =       g95
+SCC             =       gcc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -DF2CSTYLE
+LDFLAGS_LOCAL   =
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O2 #-fast
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT         =       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -ffixed-form
+FORMAT_FREE     =       -ffree-form -ffree-line-length-huge
+FCSUFFIX        =
+BYTESWAPIO      =       -fendian=big
+FCBASEOPTS      =       -Wno=101,139,155,158 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     -fmod=$(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Linux x86_64, PGI compiler with gcc # serial smpar dmpar dm+sm
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -mp -Minfo=mp
+SFC             =       pgf90
+SCC             =       gcc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -w -O3
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed # -Minfo=all =Mneginfo=all
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -Mfixed
+FORMAT_FREE     =       -Mfree
+FCSUFFIX        =
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     -module $(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Linux i486 i586 i686, PGI compiler with gcc #serial smpar dmpar dm+sm
+#
+DMPARALLEL      =       # 1
+OMPCPP		=	# -D_OPENMP
+OMP		=	# -mp
+SFC		=       pgf90
+SCC		=       gcc
+DM_FC		=	mpif90 -f90=$(SFC)
+DM_CC		=       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD		=	$(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM		=       -O2 -fast
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -Mfixed
+FORMAT_FREE     =       -Mfree
+FCSUFFIX        =       
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     -module $(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4 		=      m4 -B 14000
+RANLIB 		=      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Linux x86_64 i486 i586 i686, ifort compiler with icc #serial smpar dmpar dm+sm
+#
+#        By default, some files are compiled without optimizations to speed up compilation. Removing
+#        respective makefile rules in the end of this file will result in longer compilation time, and, possibly
+#        Out Of Memory messages, but might produce binaries which are substantially faster.
+#
+#        Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm 
+#        for latest info on how to build WRF with Intel compilers.
+#
+#        If you got Out Of Memory message, there are several options:
+#          1. Check your memory limits (ulimit -a), possibly increasing swap partitions size.
+#          2. Remove any debugging flags (-g, -check, -traceback).
+#          3. Force the problematic file to be compiled with less optimizations (see examples at the 
+#             end of this file), try -no-ip compiler flag.
+#
+#        This configuration is aimed at accuracy. To improve performance (at the expence of accuracy) you might
+#        consider removing '-fp-model precise' flag from FCBASEOPTS. This enables non value-safe optimizations.
+#        Another option is to add '-ftz' flag, which flushes denormal results to zero when the application is in
+#        the gradual underflow mode. It may improve performance if the denormal values are not critical to the
+#        behavior of your workload. To further improve performance, add suitable vectorization options for your
+#        processor to FCOPTIM (see ifort manpage).
+#
+#        If you have Intel MPI installed and wish to use instead, make the
+#        following changes to settings below:
+#        DM_FC  = mpiifort
+#        DM_CC  = mpiicc
+#        and source bin64/mpivars.sh file from your Intel MPI installation
+#        before the build.
+
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -openmp -fpp -auto
+SFC             =       ifort
+SCC             =       icc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -i4
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_FUNC
+CFLAGS_LOCAL    =       -w -O3 -ip
+LDFLAGS_LOCAL   =       -ip
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT) -traceback
+FORMAT_FIXED    =       -FI
+FORMAT_FREE     =       -FR
+FCSUFFIX        =
+BYTESWAPIO      =       -convert big_endian
+FCBASEOPTS      =       -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    ia64 Linux ifort compiler with icc 9.x,10.x #serial smpar dmpar dm+sm
+#
+#        By default, some files are compiled without optimizations to
+#        speed up compilation. Removing respective makefile rules in the
+#        end of this file will result in longer compilation time, and,
+#        possibly Out Of Memory messages, but might produce binaries
+#        which are substantially faster.
+#
+#        Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm 
+#        for latest info on how to build WRF with Intel compilers.
+#
+#        If you get Out Of Memory messages, there are several options:
+#          1. Check your memory limits (ulimit -a), possibly increasing
+#             swap partitions size.
+#          2. Remove any debugging flags (-g, -check, -traceback).
+#          3. Force the problematic file to be compiled with lower
+#             optimization (see examples at the end of this file),
+#             try the -no-ip compiler flag.
+#
+#        The default configuration is aimed at accuracy. To improve speed
+#        with only negligible effect on floating point accuracy,
+#        consider removing "-fp-model precise" from FCBASEOPTS. If
+#        you are using ifort 9.1.x compiler or earlier, consider
+#        uncommenting the version of the FCBASEOPTS settings that uses
+#        the -IPF-fp-relaxed option.
+#
+#        If you can tolerate a longer build, change the setting of
+#        FCNOOPT to -O1, for slightly faster performance.
+#
+#        If you have Intel MPI installed and wish to use instead, make the
+#        following changes to settings below:
+#        DM_FC  = mpiifort
+#        DM_CC  = mpiicc
+#        and source bin/mpivars.sh file from your Intel MPI installation
+#        before the build.
+#
+
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -openmp -fpp -auto
+SFC             =       ifort
+SCC             =       icc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =        -i4
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_FUNC
+CFLAGS_LOCAL    =       -w -O3 -ip
+LDFLAGS_LOCAL   =       -ip
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT) -traceback
+FORMAT_FIXED    =       -FI
+FORMAT_FREE     =       -FR
+FCSUFFIX        =
+BYTESWAPIO      =       -convert big_endian
+FCBASEOPTS      =       -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+#FCBASEOPTS      =       -w -ftz -align all -fno-alias -IPF-fp-relaxed $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+LIB_LOCAL       =       -L/usr/lib -lmpi 
+MODULE_SRCH_FLAG =     
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Linux SGI Altix, ifort compiler with icc 9.x,10.x #serial smpar dmpar dm+sm
+#
+#        By default, some files are compiled without optimizations to
+#        speed up compilation. Removing respective makefile rules in the
+#        end of this file will result in longer compilation time, and,
+#        possibly Out Of Memory messages, but might produce binaries
+#        which are substantially faster.
+#
+#        If you get Out Of Memory messages, there are several options:
+#          1. Check your memory limits (ulimit -a), possibly increasing
+#             swap partitions size.
+#          2. Remove any debugging flags (-g, -check, -traceback).
+#          3. Force the problematic file to be compiled with lower
+#             optimization (see examples at the end of this file),
+#             try the -no-ip compiler flag.
+#
+#        Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm 
+#        for latest info on how to build WRF with Intel compilers.
+#
+#        The default configuration is aimed at accuracy. To improve speed
+#        with only negligible effect on floating point accuracy,
+#        consider removing "-fp-model precise" from FCBASEOPTS.  If
+#        you are using an ifort 9.1.x compiler or earlier, consider
+#        uncommenting the version of the FCBASEOPTS settings that uses
+#        the -IPF-fp-relaxed option.  To further improve performance,
+#        add processor-specific options to FCOPTIM (see ifort manpage).
+#
+#        If you can tolerate a longer build, change the setting of
+#        FCNOOPT to -O1, for slightly faster performance.
+#
+#        If your SGI MPI library is not installed in the default
+#        locations (/usr/bin, /usr/include, /usr/lib), set MPI_HOME
+#        to be the path to the directory where the SGI MPI bin,
+#        include and lib directories are, and change the DM_FC,
+#        DM_CC and LIB_LOCAL settings as follows:
+#        DM_FC = $(SFC) -I$(MPI_HOME)/include
+#        DM_CC = $(SFC) -I$(MPI_HOME)/include
+#        LIB_LOCAL = -L$(MPI_HOME)/lib -lmpi 
+
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -openmp -fpp -auto
+SFC             =       ifort
+SCC             =       icc
+DM_FC           =       $(SFC)
+DM_CC           =       $(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =        -i4
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_FUNC
+CFLAGS_LOCAL    =       -w -O3 -ip
+LDFLAGS_LOCAL   =       -ip
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT) -traceback
+FORMAT_FIXED    =       -FI
+FORMAT_FREE     =       -FR
+FCSUFFIX        =
+BYTESWAPIO      =       -convert big_endian
+FCBASEOPTS      =       -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+#FCBASEOPTS      =       -w -ftz -align all -fno-alias -IPF-fp-relaxed $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+LIB_LOCAL       =       -L/usr/lib -lmpi 
+MODULE_SRCH_FLAG =     
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Linux i486 i586 i686 x86_64, PathScale compiler with pathcc #serial dmpar
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # not supported
+OMP             =       # not supported
+SFC             =       pathf90
+SCC             =       pathcc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -DF2CSTYLE
+LDFLAGS_LOCAL   =
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3 -OPT:Ofast:Olimit=5000
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT         =       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -fixed-form
+FORMAT_FREE     =       -free-form
+FCSUFFIX        =
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w -fno-second-underscore $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     -fmod=$(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    x86_64 Linux, gfortran compiler with gcc  #serial smpar dmpar dm+sm
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -fopenmp
+SFC             =       gfortran
+SCC             =       gcc
+DM_FC           =       mpif90
+DM_CC           =       mpicc
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       # -fdefault-real-8  # uncomment manually
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -w -O3 -c -DLANDREAD_STUB
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3 -ftree-vectorize -ftree-loop-linear -funroll-loops
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -ffixed-form
+FORMAT_FREE     =       -ffree-form -ffree-line-length-none
+FCSUFFIX        =       
+BYTESWAPIO      =       -fconvert=big-endian -frecord-marker=4
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -G
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Darwin (MACOS) PGI compiler with pgcc #serial smpar dmpar dm+sm
+#
+DMPARALLEL      =       # 1
+OMPCPP		=	# -D_OPENMP
+OMP		=	# -mp
+SFC		=       pgf90
+SCC		=       pgcc
+DM_FC		=	mpif90 -f90=$(SFC)
+DM_CC		=       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD		=	$(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DMACOS -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -DMACOS
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM		=       -O2 -fast
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -Mfixed
+FORMAT_FREE     =       -Mfree
+FCSUFFIX        =       
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     -module $(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      -traditional
+CPP             =      cpp -C -P -xassembler-with-cpp
+AR              =      ar
+ARFLAGS         =      ru
+M4 		=      m4 -B 14000
+RANLIB 		=      ranlib
+CC_TOOLS        =      cc
+
+###########################################################
+#ARCH    Darwin (MACOS) intel compiler with icc #serial smpar dmpar dm+sm
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -openmp -fpp -auto
+SFC             =       ifort
+SCC             =       icc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =        -i4
+ARCH_LOCAL      =       -DMACOS -DNONSTANDARD_SYSTEM_FUNC
+CFLAGS_LOCAL    =       -w -O3 -ip -DMACOS
+LDFLAGS_LOCAL   =       -ip
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT         =       -O0
+FCDEBUG         =       # -g $(FCNOOPT) -traceback
+FORMAT_FIXED    =       -FI
+FORMAT_FREE     =       -FR
+FCSUFFIX        =
+BYTESWAPIO      =       -convert big_endian
+FCBASEOPTS      =       -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =
+TRADFLAG        =      -traditional
+CPP             =      cpp -C -P -xassembler-with-cpp
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      cc
+
+###########################################################
+#ARCH    Darwin (MACOS) intel compiler with cc #serial smpar dmpar dm+sm
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -openmp -fpp -auto
+SFC             =       ifort
+SCC             =       cc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =        -i4
+ARCH_LOCAL      =       -DMACOS -DNONSTANDARD_SYSTEM_FUNC
+CFLAGS_LOCAL    =       -w -O3 -DMACOS
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT         =       -O0
+FCDEBUG         =       # -g $(FCNOOPT) -traceback
+FORMAT_FIXED    =       -FI
+FORMAT_FREE     =       -FR
+FCSUFFIX        =
+BYTESWAPIO      =       -convert big_endian
+FCBASEOPTS      =       -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =
+TRADFLAG        =      -traditional
+CPP             =      cpp -C -P -xassembler-with-cpp
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      cc
+
+###########################################################
+#ARCH    Darwin (MACOS) g95 with gcc #serial dmpar
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # not supported
+OMP             =       # not supported
+SFC             =       g95
+SCC             =       gcc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DG95 -DMACOS -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -DMACOS -DF2CSTYLE
+LDFLAGS_LOCAL   =
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O2 # -fast
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -ffixed-form
+FORMAT_FREE     =       -ffree-form -ffree-line-length-huge
+FCSUFFIX        =
+BYTESWAPIO      =       -fendian=big
+FCBASEOPTS      =       -Wno=101,139,155,158 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     -fmod=$(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      -traditional
+CPP             =      cpp -C -P -xassembler-with-cpp
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Darwin (MACOS) xlf  #serial dmpar
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # not supported
+OMP             =       # not supported
+SFC             =       xlf90_r
+SCC             =       cc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =        -qrealsize=$(RWORDSIZE) -qintsize=4
+ARCH_LOCAL      =       -DMAC_KLUDGE -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -DMACOS -DF2CSTYLE
+LDFLAGS_LOCAL   =
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3 -qarch=auto
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -qnoopt
+FCDEBUG         =       # -g $(FCNOOPT) -qfullpath
+FORMAT_FIXED    =       -qfixed
+FORMAT_FREE     =       -qfree=f90
+FCSUFFIX        =       -qsuffix=f=f90
+BYTESWAPIO      =       
+FCBASEOPTS      =       -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 -w
+MODULE_SRCH_FLAG =     -fmod=$(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      
+CPP             =      cpp -C -P 
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    AIX xlf compiler with xlc #serial smpar dmpar dm+sm
+#
+DMPARALLEL      =       # 1
+OMPCPP		=	# -D_OPENMP
+OMP		=	# -qsmp=noauto
+SFC		=       xlf90_r
+SCC		=       cc_r
+DM_FC		=	mpxlf90_r
+DM_CC		=       mpcc_r
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD		=	$(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =        -qrealsize=$(RWORDSIZE) -qintsize=4
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -DNOUNDERSCORE
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       -lC
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+# -qhot commented out in 3.0.1.1 release because of reported problems with 
+# model results under certain configurations. Use at your own risk.
+FCOPTIM		=       -O3 # -qhot
+FCREDUCEDOPT	=       -O2
+FCNOOPT		=       -qnoopt
+FCDEBUG         =       # -g $(FCNOOPT) -qfullpath
+FORMAT_FIXED    =       -qfixed
+FORMAT_FREE     =       -qfree=f90
+FCSUFFIX        =       -qsuffix=f=f90
+BYTESWAPIO      =       
+FCBASEOPTS      =       -w -qspill=20000 -qmaxmem=32767 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)  #-qflttrap=zerodivide:invalid:enable -qsigtrap
+MODULE_SRCH_FLAG =     
+TRADFLAG        =       
+CPP             =       /lib/cpp -C -P
+AR              =       ar
+ARFLAGS         =       ru
+M4 		=       m4 -B 14000
+RANLIB 		=       ranlib
+CC_TOOLS        =       cc
+
+###########################################################
+#ARCH    Cray XT Catamount/Linux x86_64, PGI compiler with gcc # serial dmpar 
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # not supported
+OMP             =       # not supported
+SFC             =       ftn
+SCC             =       gcc
+DM_FC           =       ftn
+DM_CC           =       gcc -I$(MPICH_DIR)/include
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DLANDREAD_STUB -DXT3_Catamount
+CFLAGS_LOCAL    =       -w -O3 -DLANDREAD_STUB -DXT3_Catamount
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+# Use this to add XT iobuf library after loading iobuf module, also requires
+# properly built netCDF library that includes iobuf (Catamount OS only)
+#LDFLAGS_LOCAL  =        $(IOBUF_POST_LINK_OPTS)
+# PGI recommended
+#FCOPTIM         =       -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed 
+FCOPTIM         =       -O3 -fastsse
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -Mfixed
+FORMAT_FREE     =       -Mfree
+FCSUFFIX        =
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =   
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P $(TRADFLAG)
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Cray XT CNL/Linux x86_64, PGI compiler with gcc # serial dmpar smpar dm+sm
+#
+# Recommended CNL/Linux memory allocation settings at run time:
+# export MALLOC_MMAP_MAX_=0
+# export MALLOC_TRIM_THRESHOLD_=536870912
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -mp=nonuma
+SFC             =       ftn
+SCC             =       gcc
+DM_FC           =       ftn
+DM_CC           =       gcc -I$(MPICH_DIR)/include
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DLANDREAD_STUB
+CFLAGS_LOCAL    =       -w -O3 -DLANDREAD_STUB 
+LDFLAGS_LOCAL   =
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+# PGI recommended
+#FCOPTIM         =       -O3 -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed 
+FCOPTIM         =       -O3 -fastsse 
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT         =       -O0
+OPTERON_TYPE    =
+# Use this for AMD Opteron quad-core
+#OPTERON_TYPE    =      -tp barcelona-64
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -Mfixed
+FORMAT_FREE     =       -Mfree
+FCSUFFIX        =
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(OPTERON_TYPE)
+MODULE_SRCH_FLAG =    
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P $(TRADFLAG)
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Cray XT CNL/Linux x86_64, Pathscale compiler with gcc # serial dmpar smpar dm+sm
+#
+# Recommended CNL/Linux memory allocation settings at run time:
+# export MALLOC_MMAP_MAX_=0
+# export MALLOC_TRIM_THRESHOLD_=536870912
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -mp
+SFC             =       ftn
+SCC             =       gcc
+DM_FC           =       ftn
+DM_CC           =       gcc -I$(MPICH_DIR)/include
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD              =       $(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DLANDREAD_STUB
+CFLAGS_LOCAL    =       -w -O3 -DLANDREAD_STUB 
+LDFLAGS_LOCAL   =
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3 -OPT:Ofast
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT         =       -O1
+OPTERON_TYPE    =
+# Use this for AMD Opteron quad-core
+#OPTERON_TYPE    =       -march=barcelona -mcpu=barcelona -mtune=barcelona -msse4a
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -fixedform
+FORMAT_FREE     =       -freeform
+FCSUFFIX        =
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(OPTERON_TYPE)
+MODULE_SRCH_FLAG =    
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P $(TRADFLAG)
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+#ARCH    Linux ppc64 BG blxlf compiler with blxlc # dmpar
+#
+DMPARALLEL      =       # 1
+OMPCPP		=	# not supported
+OMP		=	# not supported
+BGL_SYS         =       /bgl/BlueLight/ppcfloor/bglsys
+MPI_INC         =       -I$(BGL_SYS)/include
+MPI_LIB         =       -L$(BGL_SYS)/lib -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts
+SFC		=       blrts_xlf90
+SCC		=       blrts_xlc
+DM_FC		=	$(SFC)
+DM_CC		=       $(SCC)
+FC              =       CONFIGURE_FC
+CC              =       CONFIGURE_CC
+LD		=	$(FC)
+RWORDSIZE       =       CONFIGURE_RWORDSIZE
+PROMOTION       =        -qrealsize=$(RWORDSIZE) -qintsize=4
+# If system has even more processors, set VERY_LARGE_MAXPROC to that number
+ARCH_LOCAL      =       -DMOVE_NL_OUTSIDE_MODULE_CONFIGURE -DNONSTANDARD_SYSTEM_SUBR -DLANDREAD_STUB -DVERY_LARGE_MAXPROC=36768
+CFLAGS_LOCAL    =       -DNOUNDERSCORE -DNCARIBM_NOC99 $(MPI_INC)  -DLANDREAD_STUB
+LIB_LOCAL       =       $(MPI_LIB)
+LDFLAGS_LOCAL   =       -Wl,--allow-multiple-definition -qstatic
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM		=       -O2 -qarch=440
+FCNOOPT		=       -qnoopt
+FCDEBUG         =       # $(FCNOOPT) -qfullpath
+FORMAT_FIXED    =       -qfixed
+FORMAT_FREE     =       -qfree=f90
+FCSUFFIX        =       -qsuffix=f=f90
+BYTESWAPIO      =       
+FCBASEOPTS      =       -w -qspill=20000 -qmaxmem=64000 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(MPI_INC) #-qflttrap=zerodivide:invalid:enable -qsigtrap
+MODULE_SRCH_FLAG =     
+TRADFLAG        =       
+# this might be different on different systems but we want the xlf version of cpp, not Linux's
+# NYBlue
+CPP             =       /opt/ibmcmp/xlf/bg/10.1/exe/cpp -C -P
+# frost.ucar.edu
+CPP             =       /opt/ibmcmp/xlf/9.1/exe/cpp -C -P
+AR              =       ar
+ARFLAGS         =       ru
+M4 		=       m4 -B 14000
+RANLIB 		=       ranlib
+CC_TOOLS        =       cc
+
+###########################################################
+#ARCH  NULL
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/configure.wrf
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/configure.wrf	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/configure.wrf	(revision 2744)
@@ -0,0 +1,550 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+	   -DDA_CORE=$(WRF_DA_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	32768
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+#SED_FTN = sed -f $(WRF_SRC_ROOT_DIR)/arch/standard.sed
+SED_FTN = $(WRF_SRC_ROOT_DIR)/tools/standard.exe
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = 0
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/module_utility.o
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = -I$(WRF_SRC_ROOT_DIR)/external/esmf_time_f90
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        =  $(ESMF_IO_INC)
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = 
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = esmf_time
+
+##############################################################################
+
+LIBWRFLIB = libwrflib.a
+
+
+#### Architecture specific settings ####
+
+# To enable over-decompostion with dmpar and dm+sm compiles, 
+# add -DALLOW_OVERDECOMP to ARCH_LOCAL, below. (not recommended)
+
+# Settings for Linux x86_64 i486 i586 i686, ifort compiler with icc  (dmpar)
+#
+#        By default, some files are compiled without optimizations to speed up compilation. Removing
+#        respective makefile rules in the end of this file will result in longer compilation time, and, possibly
+#        Out Of Memory messages, but might produce binaries which are substantially faster.
+#
+#        Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm 
+#        for latest info on how to build WRF with Intel compilers.
+#
+#        If you got Out Of Memory message, there are several options:
+#          1. Check your memory limits (ulimit -a), possibly increasing swap partitions size.
+#          2. Remove any debugging flags (-g, -check, -traceback).
+#          3. Force the problematic file to be compiled with less optimizations (see examples at the 
+#             end of this file), try -no-ip compiler flag.
+#
+#        This configuration is aimed at accuracy. To improve performance (at the expence of accuracy) you might
+#        consider removing '-fp-model precise' flag from FCBASEOPTS. This enables non value-safe optimizations.
+#        Another option is to add '-ftz' flag, which flushes denormal results to zero when the application is in
+#        the gradual underflow mode. It may improve performance if the denormal values are not critical to the
+#        behavior of your workload. To further improve performance, add suitable vectorization options for your
+#        processor to FCOPTIM (see ifort manpage).
+#
+#        If you have Intel MPI installed and wish to use instead, make the
+#        following changes to settings below:
+#        DM_FC  = mpiifort
+#        DM_CC  = mpiicc
+#        and source bin64/mpivars.sh file from your Intel MPI installation
+#        before the build.
+
+DMPARALLEL      =        1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -openmp -fpp -auto
+SFC             =       ifort
+SCC             =       icc
+DM_FC           =       /usr/lib64/openmpi/1.6.5-ifort/bin//mpif90 -f90=$(SFC)
+DM_CC           =       /usr/lib64/openmpi/1.6.5-ifort/bin//mpicc -DMPI2_SUPPORT -cc=$(SCC) -DMPI2_SUPPORT
+FC              =        $(DM_FC)
+CC              =       $(DM_CC) -DFSEEKO64_OK 
+LD              =       $(FC)
+RWORDSIZE       =       8 #$(NATIVE_RWORDSIZE)
+PROMOTION       =       -i4 -real-size 64
+ARCH_LOCAL      =       -DNEWPHYS -DNONSTANDARD_SYSTEM_FUNC
+CFLAGS_LOCAL    =       -w -O3 -mcmodel=large -shared-intel -ip
+LDFLAGS_LOCAL   =       -ip
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -O3 -mcmodel=large -shared-intel
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT) -traceback
+FORMAT_FIXED    =       -FI
+FORMAT_FREE     =       -FR
+FCSUFFIX        =
+BYTESWAPIO      =       -convert big_endian
+FCBASEOPTS      =       -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp  -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+######################
+
+ARCHFLAGS       =    $(COREDEFS) -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                     $(ARCH_LOCAL) \
+                     $(DA_ARCHFLAGS) \
+                      -DDM_PARALLEL \
+                       \
+                      -DNETCDF \
+                       \
+                       \
+                       \
+                       \
+                       \
+                       \
+                      -DGRIB1 \
+                      -DINTIO \
+                      -DLIMIT_ARGS \
+                      -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) \
+                      -DMAX_DOMAINS_F=$(MAX_DOMAINS) \
+		      -DNMM_NEST=$(WRF_NMM_NEST)
+CFLAGS          =    $(CFLAGS_LOCAL) -DDM_PARALLEL 
+FCFLAGS         =    $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ESMF_LIB_FLAGS  =    
+ESMF_IO_LIB     =    $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/libesmf_time.a
+ESMF_IO_LIB_EXT =    -L$(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/libesmf_time.a
+INCLUDE_MODULES =    $(MODULE_SRCH_FLAG) \
+                     $(ESMF_MOD_INC) $(ESMF_LIB_FLAGS) \
+                      -I$(WRF_SRC_ROOT_DIR)/main \
+                      -I$(WRF_SRC_ROOT_DIR)/external/io_netcdf \
+                      -I$(WRF_SRC_ROOT_DIR)/external/io_int \
+                      -I$(WRF_SRC_ROOT_DIR)/frame \
+                      -I$(WRF_SRC_ROOT_DIR)/share \
+                      -I$(WRF_SRC_ROOT_DIR)/phys \
+                      -I$(WRF_SRC_ROOT_DIR)/chem -I$(WRF_SRC_ROOT_DIR)/inc \
+                      -I/data/spiga/MODELES/LMDZ.COMMON/libo/CICLADifort/.config/inc \
+                       \
+                      
+REGISTRY        =    Registry
+
+LIB_BUNDLED     = \
+                     -L$(WRF_SRC_ROOT_DIR)/external/fftpack/fftpack5 -lfftpack \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_grib1 -lio_grib1 \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_grib_share -lio_grib_share \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_int -lwrfio_int \
+                     $(ESMF_IO_LIB) \
+                     $(ESMF_IO_LIB) \
+                     $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a \
+                     $(WRF_SRC_ROOT_DIR)/frame/module_internal_header_util.o \
+                     $(WRF_SRC_ROOT_DIR)/frame/pack_utils.o 
+
+LIB_EXTERNAL    = \
+                     $(WRF_SRC_ROOT_DIR)/external/io_netcdf/libwrfio_nf.a -L/opt/netcdf3/ifort/lib -lnetcdf /opt/netcdf3/ifort/lib/libnetcdf.a -L/data/spiga/MODELES/LMDZ.COMMON/libo/CICLADifort/.config/lib -llmdz /data/spiga/MODELES/LMDZ.COMMON/libo/CICLADifort/.config/lib/liblmdz.a 
+
+LIB             =    $(LIB_BUNDLED) $(LIB_EXTERNAL) $(LIB_LOCAL)
+LDFLAGS         =    $(OMP) $(FCFLAGS) $(LDFLAGS_LOCAL) 
+ENVCOMPDEFS     =    
+WRF_CHEM	=	0 
+CPPFLAGS        =    $(ARCHFLAGS) $(ENVCOMPDEFS) -I$(LIBINCLUDE) $(TRADFLAG) 
+NETCDFPATH      =    /opt/netcdf3/ifort
+PNETCDFPATH     =    
+
+bundled:  wrf_ioapi_includes wrfio_grib_share wrfio_grib1 wrfio_int esmf_time fftpack
+external:  wrfio_nf   $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a gen_comms_rsllite module_dm_rsllite $(ESMF_TARGET)
+
+######################
+externals: bundled external
+
+gen_comms_serial :
+	( /bin/rm -f $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c )
+
+module_dm_serial :
+	( if [ ! -e module_dm.F ] ; then /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F ; fi )
+
+gen_comms_rsllite :
+	( if [ ! -e $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ] ; then \
+          /bin/cp $(WRF_SRC_ROOT_DIR)/tools/gen_comms_warning $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ; \
+          cat $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/gen_comms.c >> $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ; fi )
+
+module_dm_rsllite :
+	( if [ ! -e module_dm.F ] ; then /bin/cp module_dm_warning module_dm.F ; \
+          cat $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/module_dm.F >> module_dm.F ; fi )
+
+wrfio_nf : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_netcdf ; \
+          make NETCDFPATH="$(NETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          CC="$(SCC)" CFLAGS="$(CFLAGS)" \
+          FC="$(SFC) $(PROMOTION) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_pnf : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_pnetcdf ; \
+          make NETCDFPATH="$(PNETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_grib_share :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" archive) 
+
+wrfio_grib1 :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" archive)
+
+wrfio_grib2 :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) " RM="$(RM)" RANLIB="$(RANLIB)" \
+          CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="-traditional" AR="$(AR)" ARFLAGS="$(ARFLAGS)" \
+          FIXED="$(FORMAT_FIXED)" archive)
+
+wrfio_int : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_int ; \
+          make CC="$(CC)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" \
+          TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" all )
+
+esmf_time : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90 ; \
+          make FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" \
+          CPP="$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc -I. $(ARCHFLAGS) $(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+fftpack :
+	( cd $(WRF_SRC_ROOT_DIR)/external/fftpack/fftpack5 ; \
+          make FC="$(SFC)" FFLAGS="$(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+$(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a :
+	( cd $(WRF_SRC_ROOT_DIR)/external/RSL_LITE ; make CC="$(CC) $(CFLAGS)" \
+          FC="$(FC) $(FCFLAGS) $(PROMOTION) $(BYTESWAPIO)" \
+          CPP="$(CPP) -I. $(ARCHFLAGS) $(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" ;\
+          $(RANLIB) $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a )
+
+######################
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+
+# These sub-directory builds are identical across all architectures
+
+wrf_ioapi_includes :
+	( cd $(WRF_SRC_ROOT_DIR)/external/ioapi_share ; \
+          $(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_esmf :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_esmf ; \
+          make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" \
+          RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+#	There is probably no reason to modify these rules
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -o $@ -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -o $@ -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+
+.c.o:
+	$(RM) $@
+	$(CC) -o $@ -c $(CFLAGS) $*.c
+
+# A little more adventurous.  Allow full opt on 
+# mediation_integrate.o \
+# shift_domain_em.o \
+# solve_em.o  <-- gets a little kick from SOLVE_EM_SPECIAL too, if defined
+# mediation_feedback_domain.o : mediation_feedback_domain.F
+# mediation_force_domain.o : mediation_force_domain.F
+# mediation_interp_domain.o : mediation_interp_domain.F
+
+# compile these without high optimization to speed compile
+convert_nmm.o : convert_nmm.F
+init_modules_em.o : init_modules_em.F
+input_wrf.o : input_wrf.F
+module_io.o : module_io.F
+module_comm_dm.o : module_comm_dm.F
+module_configure.o : module_configure.F
+module_dm.o : module_dm.F
+module_domain.o : module_domain.F
+module_domain_type.o : module_domain_type.F
+module_alloc_space.o : module_alloc_space.F
+module_tiles.o : module_tiles.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_initialize.o : module_initialize.F
+module_physics_init.o : module_physics_init.F 
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_real.o : module_initialize_real.F
+module_initialize_real.o: module_initialize_real.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_integrate.o : module_integrate.F
+module_io_mm5.o : module_io_mm5.F
+module_io_wrf.o : module_io_wrf.F
+module_si_io.o : module_si_io.F
+module_state_description.o : module_state_description.F 
+output_wrf.o : output_wrf.F
+solve_interface.o : solve_interface.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+start_em.o : start_em.F
+wrf_auxhist10in.o : wrf_auxhist10in.F
+wrf_auxhist10out.o : wrf_auxhist10out.F
+wrf_auxhist11in.o : wrf_auxhist11in.F
+wrf_auxhist11out.o : wrf_auxhist11out.F
+wrf_auxhist1in.o : wrf_auxhist1in.F
+wrf_auxhist1out.o : wrf_auxhist1out.F
+wrf_auxhist2in.o : wrf_auxhist2in.F
+wrf_auxhist2out.o : wrf_auxhist2out.F
+wrf_auxhist3in.o : wrf_auxhist3in.F
+wrf_auxhist3out.o : wrf_auxhist3out.F
+wrf_auxhist4in.o : wrf_auxhist4in.F
+wrf_auxhist4out.o : wrf_auxhist4out.F
+wrf_auxhist5in.o : wrf_auxhist5in.F
+wrf_auxhist5out.o : wrf_auxhist5out.F
+wrf_auxhist6in.o : wrf_auxhist6in.F
+wrf_auxhist6out.o : wrf_auxhist6out.F
+wrf_auxhist7in.o : wrf_auxhist7in.F
+wrf_auxhist7out.o : wrf_auxhist7out.F
+wrf_auxhist8in.o : wrf_auxhist8in.F
+wrf_auxhist8out.o : wrf_auxhist8out.F
+wrf_auxhist9in.o : wrf_auxhist9in.F
+wrf_auxhist9out.o : wrf_auxhist9out.F
+wrf_auxinput10in.o : wrf_auxinput10in.F
+wrf_auxinput10out.o : wrf_auxinput10out.F
+wrf_auxinput11in.o : wrf_auxinput11in.F
+wrf_auxinput11out.o : wrf_auxinput11out.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_auxinput2in.o : wrf_auxinput2in.F
+wrf_auxinput2out.o : wrf_auxinput2out.F
+wrf_auxinput3in.o : wrf_auxinput3in.F
+wrf_auxinput3out.o : wrf_auxinput3out.F
+wrf_auxinput4in.o : wrf_auxinput4in.F
+wrf_auxinput4out.o : wrf_auxinput4out.F
+wrf_auxinput5in.o : wrf_auxinput5in.F
+wrf_auxinput5out.o : wrf_auxinput5out.F
+wrf_auxinput6in.o : wrf_auxinput6in.F
+wrf_auxinput6out.o : wrf_auxinput6out.F
+wrf_auxinput7in.o : wrf_auxinput7in.F
+wrf_auxinput7out.o : wrf_auxinput7out.F
+wrf_auxinput8in.o : wrf_auxinput8in.F
+wrf_auxinput8out.o : wrf_auxinput8out.F
+wrf_auxinput9in.o : wrf_auxinput9in.F
+wrf_auxinput9out.o : wrf_auxinput9out.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_ext_read_field.o : wrf_ext_read_field.F
+wrf_ext_write_field.o : wrf_ext_write_field.F
+wrf_fddaobs_in.o : wrf_fddaobs_in.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_tsin.o : wrf_tsin.F
+nl_get_0_routines.o : nl_get_0_routines.F
+nl_get_1_routines.o : nl_get_1_routines.F
+nl_set_0_routines.o : nl_set_0_routines.F
+nl_set_1_routines.o : nl_set_1_routines.F
+
+convert_nmm.o \
+init_modules_em.o \
+module_comm_dm.o \
+module_dm.o \
+module_alloc_space.o \
+module_fddaobs_rtfdda.o \
+module_initialize.o \
+module_initialize_b_wave.o \
+module_initialize_hill2d_x.o \
+module_initialize_quarter_ss.o \
+module_initialize_real.o \
+module_initialize_squall2d_x.o \
+module_initialize_squall2d_y.o \
+module_integrate.o \
+module_io_mm5.o \
+module_io_wrf.o \
+module_si_io.o \
+module_tiles.o \
+output_wrf.o \
+solve_interface.o \
+start_domain.o \
+start_domain_nmm.o \
+start_em.o \
+wrf_fddaobs_in.o \
+wrf_tsin.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90
+
+#solve_em.o :
+#	$(RM) $@
+#	$(SED_FTN) $*.F > $*.b 
+#	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $*.f90
+#	$(RM) $*.b
+#	$(FC) -o $@ -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $(SOLVE_EM_SPECIAL) $(OMP) $*.f90
+
+module_sf_ruclsm.o : module_sf_ruclsm.F
+module_cu_kf.o : module_cu_kf.F
+
+module_sf_ruclsm.o module_cu_kf.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCREDUCEDOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90
+
+# compile without OMP
+input_wrf.o \
+module_domain.o \
+module_domain_type.o \
+module_physics_init.o \
+module_io.o \
+wrf_auxhist10in.o \
+wrf_auxhist10out.o \
+wrf_auxhist11in.o \
+wrf_auxhist11out.o \
+wrf_auxhist1in.o \
+wrf_auxhist1out.o \
+wrf_auxhist2in.o \
+wrf_auxhist2out.o \
+wrf_auxhist3in.o \
+wrf_auxhist3out.o \
+wrf_auxhist4in.o \
+wrf_auxhist4out.o \
+wrf_auxhist5in.o \
+wrf_auxhist5out.o \
+wrf_auxhist6in.o \
+wrf_auxhist6out.o \
+wrf_auxhist7in.o \
+wrf_auxhist7out.o \
+wrf_auxhist8in.o \
+wrf_auxhist8out.o \
+wrf_auxhist9in.o \
+wrf_auxhist9out.o \
+wrf_auxinput10in.o \
+wrf_auxinput10out.o \
+wrf_auxinput11in.o \
+wrf_auxinput11out.o \
+wrf_auxinput1in.o \
+wrf_auxinput1out.o \
+wrf_auxinput2in.o \
+wrf_auxinput2out.o \
+wrf_auxinput3in.o \
+wrf_auxinput3out.o \
+wrf_auxinput4in.o \
+wrf_auxinput4out.o \
+wrf_auxinput5in.o \
+wrf_auxinput5out.o \
+wrf_auxinput6in.o \
+wrf_auxinput6out.o \
+wrf_auxinput7in.o \
+wrf_auxinput7out.o \
+wrf_auxinput8in.o \
+wrf_auxinput8out.o \
+wrf_auxinput9in.o \
+wrf_auxinput9out.o \
+wrf_bdyin.o \
+wrf_bdyout.o \
+wrf_ext_read_field.o \
+wrf_ext_write_field.o \
+wrf_histin.o \
+wrf_histout.o \
+wrf_inputin.o \
+wrf_inputout.o \
+wrf_restartin.o \
+wrf_restartout.o \
+module_state_description.o \
+nl_set_0_routines.o \
+nl_set_1_routines.o \
+nl_get_0_routines.o \
+nl_get_1_routines.o \
+module_configure.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCSUFFIX) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/external/RSL_LITE/module_dm.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/external/RSL_LITE/module_dm.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/external/RSL_LITE/module_dm.F	(revision 2744)
@@ -0,0 +1,4056 @@
+!WRF:PACKAGE:RSL 
+!
+MODULE module_dm
+
+   USE module_machine
+   USE module_wrf_error
+   USE module_driver_constants
+   USE module_comm_dm
+   IMPLICIT NONE
+
+#if ( NMM_CORE == 1 ) || defined( WRF_CHEM ) 
+   INTEGER, PARAMETER :: max_halo_width = 6
+#else
+   INTEGER, PARAMETER :: max_halo_width = 6 ! 5
+#endif
+
+   INTEGER :: ips_save, ipe_save, jps_save, jpe_save, itrace
+
+   INTEGER ntasks, ntasks_y, ntasks_x, mytask, mytask_x, mytask_y
+   INTEGER local_communicator, local_communicator_periodic, local_iocommunicator
+   INTEGER local_communicator_x, local_communicator_y ! subcommunicators for rows and cols of mesh
+   LOGICAL :: dm_debug_flag = .FALSE.
+
+   INTERFACE wrf_dm_maxval
+#if (RWORDSIZE == 8)
+     MODULE PROCEDURE wrf_dm_maxval_real , wrf_dm_maxval_integer
+#else
+     MODULE PROCEDURE wrf_dm_maxval_real , wrf_dm_maxval_integer, wrf_dm_maxval_doubleprecision
+#endif
+   END INTERFACE
+
+   INTERFACE wrf_dm_minval                       ! gopal's doing
+#if (RWORDSIZE == 8)
+     MODULE PROCEDURE wrf_dm_minval_real , wrf_dm_minval_integer
+#else
+     MODULE PROCEDURE wrf_dm_minval_real , wrf_dm_minval_integer, wrf_dm_minval_doubleprecision
+#endif
+   END INTERFACE
+
+CONTAINS
+
+
+   SUBROUTINE MPASPECT( P, MINM, MINN, PROCMIN_M, PROCMIN_N )
+      IMPLICIT NONE
+      INTEGER P, M, N, MINI, MINM, MINN, PROCMIN_M, PROCMIN_N
+      MINI = 2*P
+      MINM = 1
+      MINN = P
+      DO M = 1, P
+        IF ( MOD( P, M ) .EQ. 0 ) THEN
+          N = P / M
+          IF ( ABS(M-N) .LT. MINI                &
+               .AND. M .GE. PROCMIN_M            &
+               .AND. N .GE. PROCMIN_N            &
+             ) THEN
+            MINI = ABS(M-N)
+            MINM = M
+            MINN = N
+          ENDIF
+        ENDIF
+      ENDDO
+      IF ( MINM .LT. PROCMIN_M .OR. MINN .LT. PROCMIN_N ) THEN
+        WRITE( wrf_err_message , * )'MPASPECT: UNABLE TO GENERATE PROCESSOR MESH.  STOPPING.'
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE(0,*)' PROCMIN_M ', PROCMIN_M
+        WRITE( wrf_err_message , * )' PROCMIN_M ', PROCMIN_M
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' PROCMIN_N ', PROCMIN_N
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' P         ', P
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' MINM      ', MINM
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        WRITE( wrf_err_message , * )' MINN      ', MINN
+        CALL wrf_message ( TRIM ( wrf_err_message ) )
+        CALL wrf_error_fatal ( 'module_dm: mpaspect' )
+      ENDIF
+   RETURN
+   END SUBROUTINE MPASPECT
+
+   SUBROUTINE wrf_dm_initialize
+      USE module_configure
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      INTEGER :: local_comm, local_comm2, new_local_comm, group, newgroup, p, p1, ierr
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ranks
+      INTEGER comdup
+      INTEGER, DIMENSION(2) :: dims, coords
+      LOGICAL, DIMENSION(2) :: isperiodic
+      LOGICAL :: reorder_mesh
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL mpi_comm_size( local_comm, ntasks, ierr )
+      CALL nl_get_nproc_x ( 1, ntasks_x )
+      CALL nl_get_nproc_y ( 1, ntasks_y )
+      CALL nl_get_reorder_mesh( 1, reorder_mesh )
+
+! check if user has specified in the namelist
+      IF ( ntasks_x .GT. 0 .OR. ntasks_y .GT. 0 ) THEN
+        ! if only ntasks_x is specified then make it 1-d decomp in i
+        IF      ( ntasks_x .GT. 0 .AND. ntasks_y .EQ. -1 ) THEN
+          ntasks_y = ntasks / ntasks_x
+        ! if only ntasks_y is specified then make it 1-d decomp in j
+        ELSE IF ( ntasks_x .EQ. -1 .AND. ntasks_y .GT. 0 ) THEN
+          ntasks_x = ntasks / ntasks_y
+        ENDIF
+        ! make sure user knows what they're doing
+        IF ( ntasks_x * ntasks_y .NE. ntasks ) THEN
+          WRITE( wrf_err_message , * )'WRF_DM_INITIALIZE (RSL_LITE): nproc_x * nproc_y in namelist ne ',ntasks
+          CALL wrf_error_fatal ( wrf_err_message )
+        ENDIF
+      ELSE
+        ! When neither is specified, work out mesh with MPASPECT
+        ! Pass nproc_ln and nproc_nt so that number of procs in
+        ! i-dim (nproc_ln) is equal or lesser.
+        CALL mpaspect ( ntasks, ntasks_x, ntasks_y, 1, 1 )
+      ENDIF
+      WRITE( wrf_err_message , * )'Ntasks in X ',ntasks_x,', ntasks in Y ',ntasks_y
+      CALL wrf_message( wrf_err_message )
+
+      CALL mpi_comm_rank( local_comm, mytask, ierr )
+! extra code to reorder the communicator 20051212jm
+      IF ( reorder_mesh ) THEN
+        ALLOCATE (ranks(ntasks))
+        CALL mpi_comm_dup ( local_comm , local_comm2, ierr )
+        CALL mpi_comm_group ( local_comm2, group, ierr )
+        DO p1=1,ntasks
+          p = p1 - 1
+          ranks(p1) = mod( p , ntasks_x ) * ntasks_y + p / ntasks_x  
+        ENDDO
+        CALL mpi_group_incl( group, ntasks, ranks, newgroup, ierr )
+        DEALLOCATE (ranks)
+        CALL mpi_comm_create( local_comm2, newgroup, new_local_comm , ierr )
+      ELSE
+        new_local_comm = local_comm
+      ENDIF
+! end extra code to reorder the communicator 20051212jm
+      dims(1) = ntasks_y  ! rows
+      dims(2) = ntasks_x  ! columns
+      isperiodic(1) = .false.
+      isperiodic(2) = .false.
+      CALL mpi_cart_create( new_local_comm, 2, dims, isperiodic, .false., local_communicator, ierr )
+      dims(1) = ntasks_y  ! rows
+      dims(2) = ntasks_x  ! columns
+      isperiodic(1) = .true.
+      isperiodic(2) = .true.
+      CALL mpi_cart_create( new_local_comm, 2, dims, isperiodic, .false., local_communicator_periodic, ierr )
+! debug
+      CALL mpi_comm_rank( local_communicator_periodic, mytask, ierr )
+      CALL mpi_cart_coords( local_communicator_periodic, mytask, 2, coords, ierr )
+!        write(0,*)'periodic coords ',mytask, coords
+
+      CALL mpi_comm_rank( local_communicator, mytask, ierr )
+      CALL mpi_cart_coords( local_communicator, mytask, 2, coords, ierr )
+!        write(0,*)'non periodic coords ',mytask, coords
+      mytask_x = coords(2)   ! col task (x)
+      mytask_y = coords(1)   ! row task (y)
+      CALL nl_set_nproc_x ( 1, ntasks_x )
+      CALL nl_set_nproc_y ( 1, ntasks_y )
+
+! 20061228 set up subcommunicators for processors in X, Y coords of mesh
+! note that local_comm_x has all the processors in a row (X=0:nproc_x-1);
+! in other words, local_comm_x has all the processes with the same rank in Y
+      CALL MPI_Comm_dup( new_local_comm, comdup, ierr )
+      IF ( ierr .NE. 0 ) CALL wrf_error_fatal('MPI_Comm_dup fails in 20061228 mod')
+      CALL MPI_Comm_split(comdup,mytask_y,mytask,local_communicator_x,ierr)
+      IF ( ierr .NE. 0 ) CALL wrf_error_fatal('MPI_Comm_split fails for x in 20061228 mod')
+      CALL MPI_Comm_split(comdup,mytask_x,mytask,local_communicator_y,ierr)
+      IF ( ierr .NE. 0 ) CALL wrf_error_fatal('MPI_Comm_split fails for y in 20061228 mod')
+! end 20061228
+      CALL wrf_set_dm_communicator ( local_communicator )
+#else
+      ntasks = 1
+      ntasks_x = 1
+      ntasks_y = 1
+      mytask = 0
+      mytask_x = 0
+      mytask_y = 0
+#endif
+
+      RETURN
+   END SUBROUTINE wrf_dm_initialize
+
+   SUBROUTINE get_dm_max_halo_width( id, width )
+     IMPLICIT NONE
+     INTEGER, INTENT(IN) :: id
+     INTEGER, INTENT(OUT) :: width
+     IF ( id .EQ. 1 ) THEN   ! this is coarse domain
+       width = max_halo_width
+     ELSE
+       width = max_halo_width + 3
+     ENDIF
+     RETURN
+   END SUBROUTINE get_dm_max_halo_width
+
+   SUBROUTINE patch_domain_rsl_lite( id  , parent, parent_id, &
+                                sd1 , ed1 , sp1 , ep1 , sm1 , em1 ,        &
+                                sd2 , ed2 , sp2 , ep2 , sm2 , em2 ,        &
+                                sd3 , ed3 , sp3 , ep3 , sm3 , em3 ,        &
+                                      sp1x , ep1x , sm1x , em1x , &
+                                      sp2x , ep2x , sm2x , em2x , &
+                                      sp3x , ep3x , sm3x , em3x , &
+                                      sp1y , ep1y , sm1y , em1y , &
+                                      sp2y , ep2y , sm2y , em2y , &
+                                      sp3y , ep3y , sm3y , em3y , &
+                                bdx , bdy )
+
+      USE module_domain, ONLY : domain, head_grid, find_grid_by_id
+      USE module_machine
+
+      IMPLICIT NONE
+      INTEGER, INTENT(IN)   :: sd1 , ed1 , sd2 , ed2 , sd3 , ed3 , bdx , bdy
+      INTEGER, INTENT(OUT)  :: sp1 , ep1 , sp2 , ep2 , sp3 , ep3 , &
+                               sm1 , em1 , sm2 , em2 , sm3 , em3
+      INTEGER, INTENT(OUT)  :: sp1x , ep1x , sp2x , ep2x , sp3x , ep3x , &
+                               sm1x , em1x , sm2x , em2x , sm3x , em3x
+      INTEGER, INTENT(OUT)  :: sp1y , ep1y , sp2y , ep2y , sp3y , ep3y , &
+                               sm1y , em1y , sm2y , em2y , sm3y , em3y
+      INTEGER, INTENT(IN)   :: id, parent_id
+      TYPE(domain),POINTER  :: parent
+
+! Local variables
+      INTEGER               :: ids, ide, jds, jde, kds, kde
+      INTEGER               :: ims, ime, jms, jme, kms, kme
+      INTEGER               :: ips, ipe, jps, jpe, kps, kpe
+      INTEGER               :: imsx, imex, jmsx, jmex, kmsx, kmex
+      INTEGER               :: ipsx, ipex, jpsx, jpex, kpsx, kpex
+      INTEGER               :: imsy, imey, jmsy, jmey, kmsy, kmey
+      INTEGER               :: ipsy, ipey, jpsy, jpey, kpsy, kpey
+
+      INTEGER               :: c_sd1 , c_ed1 , c_sd2 , c_ed2 , c_sd3 , c_ed3
+      INTEGER               :: c_sp1 , c_ep1 , c_sp2 , c_ep2 , c_sp3 , c_ep3 , &
+                               c_sm1 , c_em1 , c_sm2 , c_em2 , c_sm3 , c_em3
+      INTEGER               :: c_sp1x , c_ep1x , c_sp2x , c_ep2x , c_sp3x , c_ep3x , &
+                               c_sm1x , c_em1x , c_sm2x , c_em2x , c_sm3x , c_em3x
+      INTEGER               :: c_sp1y , c_ep1y , c_sp2y , c_ep2y , c_sp3y , c_ep3y , &
+                               c_sm1y , c_em1y , c_sm2y , c_em2y , c_sm3y , c_em3y
+
+      INTEGER               :: c_ids, c_ide, c_jds, c_jde, c_kds, c_kde
+      INTEGER               :: c_ims, c_ime, c_jms, c_jme, c_kms, c_kme
+      INTEGER               :: c_ips, c_ipe, c_jps, c_jpe, c_kps, c_kpe
+
+      INTEGER               :: idim , jdim , kdim , rem , a, b
+      INTEGER               :: i, j, ni, nj, Px, Py, P
+
+      INTEGER               :: parent_grid_ratio, i_parent_start, j_parent_start
+      INTEGER               :: shw
+      INTEGER               :: idim_cd, jdim_cd, ierr
+      INTEGER               :: max_dom
+
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER  :: nest_grid
+      CHARACTER*256   :: mess
+
+      INTEGER parent_max_halo_width
+      INTEGER thisdomain_max_halo_width
+
+      SELECT CASE ( model_data_order )
+         ! need to finish other cases
+         CASE ( DATA_ORDER_ZXY )
+            ids = sd2 ; ide = ed2 
+            jds = sd3 ; jde = ed3 
+            kds = sd1 ; kde = ed1 
+         CASE ( DATA_ORDER_XYZ )
+            ids = sd1 ; ide = ed1 
+            jds = sd2 ; jde = ed2 
+            kds = sd3 ; kde = ed3 
+         CASE ( DATA_ORDER_XZY )
+            ids = sd1 ; ide = ed1 
+            jds = sd3 ; jde = ed3 
+            kds = sd2 ; kde = ed2 
+         CASE ( DATA_ORDER_YXZ)
+            ids = sd2 ; ide = ed2 
+            jds = sd1 ; jde = ed1 
+            kds = sd3 ; kde = ed3 
+      END SELECT
+
+      CALL nl_get_max_dom( 1 , max_dom )
+
+      CALL get_dm_max_halo_width( id , thisdomain_max_halo_width )
+      IF ( id .GT. 1 ) THEN
+        CALL get_dm_max_halo_width( parent%id , parent_max_halo_width )
+      ENDIF
+
+      CALL compute_memory_dims_rsl_lite ( id, thisdomain_max_halo_width, 0 , bdx, bdy,   &
+                   ids,  ide,  jds,  jde,  kds,  kde, &
+                   ims,  ime,  jms,  jme,  kms,  kme, &
+                   imsx, imex, jmsx, jmex, kmsx, kmex, &
+                   imsy, imey, jmsy, jmey, kmsy, kmey, &
+                   ips,  ipe,  jps,  jpe,  kps,  kpe, &
+                   ipsx, ipex, jpsx, jpex, kpsx, kpex, &
+                   ipsy, ipey, jpsy, jpey, kpsy, kpey )
+
+     ! ensure that the every parent domain point has a full set of nested points under it
+     ! even at the borders. Do this by making sure the number of nest points is a multiple of
+     ! the nesting ratio. Note that this is important mostly to the intermediate domain, which
+     ! is the subject of the scatter gather comms with the parent
+
+      IF ( id .GT. 1 ) THEN
+         CALL nl_get_parent_grid_ratio( id, parent_grid_ratio )
+         if ( mod(ime,parent_grid_ratio) .NE. 0 ) ime = ime + parent_grid_ratio - mod(ime,parent_grid_ratio)
+         if ( mod(jme,parent_grid_ratio) .NE. 0 ) jme = jme + parent_grid_ratio - mod(jme,parent_grid_ratio)
+      ENDIF
+
+      SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+            sp2 = ips ; ep2 = ipe ; sm2 = ims ; em2 = ime
+            sp3 = jps ; ep3 = jpe ; sm3 = jms ; em3 = jme
+            sp1 = kps ; ep1 = kpe ; sm1 = kms ; em1 = kme
+            sp2x = ipsx ; ep2x = ipex ; sm2x = imsx ; em2x = imex
+            sp3x = jpsx ; ep3x = jpex ; sm3x = jmsx ; em3x = jmex
+            sp1x = kpsx ; ep1x = kpex ; sm1x = kmsx ; em1x = kmex
+            sp2y = ipsy ; ep2y = ipey ; sm2y = imsy ; em2y = imey
+            sp3y = jpsy ; ep3y = jpey ; sm3y = jmsy ; em3y = jmey
+            sp1y = kpsy ; ep1y = kpey ; sm1y = kmsy ; em1y = kmey
+         CASE ( DATA_ORDER_ZYX )
+            sp3 = ips ; ep3 = ipe ; sm3 = ims ; em3 = ime
+            sp2 = jps ; ep2 = jpe ; sm2 = jms ; em2 = jme
+            sp1 = kps ; ep1 = kpe ; sm1 = kms ; em1 = kme
+            sp3x = ipsx ; ep3x = ipex ; sm3x = imsx ; em3x = imex
+            sp2x = jpsx ; ep2x = jpex ; sm2x = jmsx ; em2x = jmex
+            sp1x = kpsx ; ep1x = kpex ; sm1x = kmsx ; em1x = kmex
+            sp3y = ipsy ; ep3y = ipey ; sm3y = imsy ; em3y = imey
+            sp2y = jpsy ; ep2y = jpey ; sm2y = jmsy ; em2y = jmey
+            sp1y = kpsy ; ep1y = kpey ; sm1y = kmsy ; em1y = kmey
+         CASE ( DATA_ORDER_XYZ )
+            sp1 = ips ; ep1 = ipe ; sm1 = ims ; em1 = ime
+            sp2 = jps ; ep2 = jpe ; sm2 = jms ; em2 = jme
+            sp3 = kps ; ep3 = kpe ; sm3 = kms ; em3 = kme
+            sp1x = ipsx ; ep1x = ipex ; sm1x = imsx ; em1x = imex
+            sp2x = jpsx ; ep2x = jpex ; sm2x = jmsx ; em2x = jmex
+            sp3x = kpsx ; ep3x = kpex ; sm3x = kmsx ; em3x = kmex
+            sp1y = ipsy ; ep1y = ipey ; sm1y = imsy ; em1y = imey
+            sp2y = jpsy ; ep2y = jpey ; sm2y = jmsy ; em2y = jmey
+            sp3y = kpsy ; ep3y = kpey ; sm3y = kmsy ; em3y = kmey
+         CASE ( DATA_ORDER_YXZ)
+            sp2 = ips ; ep2 = ipe ; sm2 = ims ; em2 = ime
+            sp1 = jps ; ep1 = jpe ; sm1 = jms ; em1 = jme
+            sp3 = kps ; ep3 = kpe ; sm3 = kms ; em3 = kme
+            sp2x = ipsx ; ep2x = ipex ; sm2x = imsx ; em2x = imex
+            sp1x = jpsx ; ep1x = jpex ; sm1x = jmsx ; em1x = jmex
+            sp3x = kpsx ; ep3x = kpex ; sm3x = kmsx ; em3x = kmex
+            sp2y = ipsy ; ep2y = ipey ; sm2y = imsy ; em2y = imey
+            sp1y = jpsy ; ep1y = jpey ; sm1y = jmsy ; em1y = jmey
+            sp3y = kpsy ; ep3y = kpey ; sm3y = kmsy ; em3y = kmey
+         CASE ( DATA_ORDER_XZY )
+            sp1 = ips ; ep1 = ipe ; sm1 = ims ; em1 = ime
+            sp3 = jps ; ep3 = jpe ; sm3 = jms ; em3 = jme
+            sp2 = kps ; ep2 = kpe ; sm2 = kms ; em2 = kme
+            sp1x = ipsx ; ep1x = ipex ; sm1x = imsx ; em1x = imex
+            sp3x = jpsx ; ep3x = jpex ; sm3x = jmsx ; em3x = jmex
+            sp2x = kpsx ; ep2x = kpex ; sm2x = kmsx ; em2x = kmex
+            sp1y = ipsy ; ep1y = ipey ; sm1y = imsy ; em1y = imey
+            sp3y = jpsy ; ep3y = jpey ; sm3y = jmsy ; em3y = jmey
+            sp2y = kpsy ; ep2y = kpey ; sm2y = kmsy ; em2y = kmey
+         CASE ( DATA_ORDER_YZX )
+            sp3 = ips ; ep3 = ipe ; sm3 = ims ; em3 = ime
+            sp1 = jps ; ep1 = jpe ; sm1 = jms ; em1 = jme
+            sp2 = kps ; ep2 = kpe ; sm2 = kms ; em2 = kme
+            sp3x = ipsx ; ep3x = ipex ; sm3x = imsx ; em3x = imex
+            sp1x = jpsx ; ep1x = jpex ; sm1x = jmsx ; em1x = jmex
+            sp2x = kpsx ; ep2x = kpex ; sm2x = kmsx ; em2x = kmex
+            sp3y = ipsy ; ep3y = ipey ; sm3y = imsy ; em3y = imey
+            sp1y = jpsy ; ep1y = jpey ; sm1y = jmsy ; em1y = jmey
+            sp2y = kpsy ; ep2y = kpey ; sm2y = kmsy ; em2y = kmey
+      END SELECT
+
+      IF ( id.EQ.1 ) THEN
+         WRITE(wrf_err_message,*)'*************************************'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'Parent domain'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ids,ide,jds,jde ',ids,ide,jds,jde
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ims,ime,jms,jme ',ims,ime,jms,jme
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ips,ipe,jps,jpe ',ips,ipe,jps,jpe
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'*************************************'
+         CALL wrf_message( TRIM(wrf_err_message) )
+      ENDIF
+
+      IF ( id .GT. 1 ) THEN
+
+         CALL nl_get_shw( id, shw )
+         CALL nl_get_i_parent_start( id , i_parent_start )
+         CALL nl_get_j_parent_start( id , j_parent_start )
+         CALL nl_get_parent_grid_ratio( id, parent_grid_ratio )
+
+         SELECT CASE ( model_data_order )
+            CASE ( DATA_ORDER_ZXY )
+               idim = ed2-sd2+1
+               jdim = ed3-sd3+1
+               kdim = ed1-sd1+1
+               c_kds = sd1                ; c_kde = ed1
+            CASE ( DATA_ORDER_ZYX )
+               idim = ed3-sd3+1
+               jdim = ed2-sd2+1
+               kdim = ed1-sd1+1
+               c_kds = sd1                ; c_kde = ed1
+            CASE ( DATA_ORDER_XYZ )
+               idim = ed1-sd1+1
+               jdim = ed2-sd2+1
+               kdim = ed3-sd3+1
+               c_kds = sd3                ; c_kde = ed3
+            CASE ( DATA_ORDER_YXZ)
+               idim = ed2-sd2+1
+               jdim = ed1-sd1+1
+               kdim = ed3-sd3+1
+               c_kds = sd3                ; c_kde = ed3
+            CASE ( DATA_ORDER_XZY )
+               idim = ed1-sd1+1
+               jdim = ed3-sd3+1
+               kdim = ed2-sd2+1
+               c_kds = sd2                ; c_kde = ed2
+            CASE ( DATA_ORDER_YZX )
+               idim = ed3-sd3+1
+               jdim = ed1-sd1+1
+               kdim = ed2-sd2+1
+               c_kds = sd2                ; c_kde = ed2
+         END SELECT
+
+         idim_cd = idim / parent_grid_ratio + 1 + 2*shw + 1
+         jdim_cd = jdim / parent_grid_ratio + 1 + 2*shw + 1
+
+         c_ids = i_parent_start-shw ; c_ide = c_ids + idim_cd - 1
+         c_jds = j_parent_start-shw ; c_jde = c_jds + jdim_cd - 1
+
+         ! we want the intermediate domain to be decomposed the
+         ! the same as the underlying nest. So try this:
+
+         c_ips = -1
+         nj = ( c_jds - j_parent_start ) * parent_grid_ratio + 1 + 1 ;
+         ierr = 0 
+         DO i = c_ids, c_ide
+            ni = ( i - i_parent_start ) * parent_grid_ratio + 1 + 1 ;
+            CALL task_for_point ( ni, nj, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, &
+                                  thisdomain_max_halo_width, thisdomain_max_halo_width, ierr )
+            IF ( Px .EQ. mytask_x ) THEN
+               c_ipe = i
+               IF ( c_ips .EQ. -1 ) c_ips = i
+            ENDIF
+         ENDDO
+         IF ( ierr .NE. 0 ) THEN
+            CALL tfp_message(__FILE__,__LINE__)
+         ENDIF
+         IF (c_ips .EQ. -1 ) THEN
+            c_ipe = -1
+            c_ips = 0
+         ENDIF
+
+         c_jps = -1
+         ni = ( c_ids - i_parent_start ) * parent_grid_ratio + 1 + 1 ;
+         ierr = 0 
+         DO j = c_jds, c_jde
+            nj = ( j - j_parent_start ) * parent_grid_ratio + 1 + 1 ;
+            CALL task_for_point ( ni, nj, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, &
+                                  thisdomain_max_halo_width, thisdomain_max_halo_width, ierr )
+
+
+            IF ( Py .EQ. mytask_y ) THEN
+               c_jpe = j
+               IF ( c_jps .EQ. -1 ) c_jps = j
+            ENDIF
+         ENDDO
+         IF ( ierr .NE. 0 ) THEN
+            CALL tfp_message(__FILE__,__LINE__)
+         ENDIF
+         IF (c_jps .EQ. -1 ) THEN
+            c_jpe = -1
+            c_jps = 0
+         ENDIF
+
+         IF ( c_jps < c_jpe .AND. c_ips < c_ipe ) THEN
+! extend the patch dimensions out shw along edges of domain
+           IF ( mytask_x .EQ. 0 ) THEN
+             c_ips = c_ips - shw
+           ENDIF
+           IF ( mytask_x .EQ. ntasks_x-1 ) THEN
+             c_ipe = c_ipe + shw
+           ENDIF
+           c_ims = max( c_ips - max(shw,thisdomain_max_halo_width), c_ids - bdx ) - 1
+           c_ime = min( c_ipe + max(shw,thisdomain_max_halo_width), c_ide + bdx ) + 1
+
+! handle j dims
+! extend the patch dimensions out shw along edges of domain
+           IF ( mytask_y .EQ. 0 ) THEN
+              c_jps = c_jps - shw
+           ENDIF
+           IF ( mytask_y .EQ. ntasks_y-1 ) THEN
+              c_jpe = c_jpe + shw
+           ENDIF
+           c_jms = max( c_jps - max(shw,thisdomain_max_halo_width), c_jds - bdx ) - 1
+           c_jme = min( c_jpe + max(shw,thisdomain_max_halo_width), c_jde + bdx ) + 1
+! handle k dims
+         ELSE
+           c_ims = 0
+           c_ime = 0
+           c_jms = 0
+           c_jme = 0
+         ENDIF
+         c_kps = 1
+         c_kpe = c_kde
+         c_kms = 1
+         c_kme = c_kde
+
+         WRITE(wrf_err_message,*)'*************************************'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'Nesting domain'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ids,ide,jds,jde ',ids,ide,jds,jde
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ims,ime,jms,jme ',ims,ime,jms,jme
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ips,ipe,jps,jpe ',ips,ipe,jps,jpe
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'INTERMEDIATE domain'
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ids,ide,jds,jde ',c_ids,c_ide,c_jds,c_jde
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ims,ime,jms,jme ',c_ims,c_ime,c_jms,c_jme
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'ips,ipe,jps,jpe ',c_ips,c_ipe,c_jps,c_jpe
+         CALL wrf_message( TRIM(wrf_err_message) )
+         WRITE(wrf_err_message,*)'*************************************'
+         CALL wrf_message( TRIM(wrf_err_message) )
+
+         SELECT CASE ( model_data_order )
+            CASE ( DATA_ORDER_ZXY )
+               c_sd2 = c_ids ; c_ed2 = c_ide ; c_sp2 = c_ips ; c_ep2 = c_ipe ; c_sm2 = c_ims ; c_em2 = c_ime
+               c_sd3 = c_jds ; c_ed3 = c_jde ; c_sp3 = c_jps ; c_ep3 = c_jpe ; c_sm3 = c_jms ; c_em3 = c_jme
+               c_sd1 = c_kds ; c_ed1 = c_kde ; c_sp1 = c_kps ; c_ep1 = c_kpe ; c_sm1 = c_kms ; c_em1 = c_kme
+            CASE ( DATA_ORDER_ZYX )
+               c_sd3 = c_ids ; c_ed3 = c_ide ; c_sp3 = c_ips ; c_ep3 = c_ipe ; c_sm3 = c_ims ; c_em3 = c_ime
+               c_sd2 = c_jds ; c_ed2 = c_jde ; c_sp2 = c_jps ; c_ep2 = c_jpe ; c_sm2 = c_jms ; c_em2 = c_jme
+               c_sd1 = c_kds ; c_ed1 = c_kde ; c_sp1 = c_kps ; c_ep1 = c_kpe ; c_sm1 = c_kms ; c_em1 = c_kme
+            CASE ( DATA_ORDER_XYZ )
+               c_sd1 = c_ids ; c_ed1 = c_ide ; c_sp1 = c_ips ; c_ep1 = c_ipe ; c_sm1 = c_ims ; c_em1 = c_ime
+               c_sd2 = c_jds ; c_ed2 = c_jde ; c_sp2 = c_jps ; c_ep2 = c_jpe ; c_sm2 = c_jms ; c_em2 = c_jme
+               c_sd3 = c_kds ; c_ed3 = c_kde ; c_sp3 = c_kps ; c_ep3 = c_kpe ; c_sm3 = c_kms ; c_em3 = c_kme
+            CASE ( DATA_ORDER_YXZ)
+               c_sd2 = c_ids ; c_ed2 = c_ide ; c_sp2 = c_ips ; c_ep2 = c_ipe ; c_sm2 = c_ims ; c_em2 = c_ime
+               c_sd1 = c_jds ; c_ed1 = c_jde ; c_sp1 = c_jps ; c_ep1 = c_jpe ; c_sm1 = c_jms ; c_em1 = c_jme
+               c_sd3 = c_kds ; c_ed3 = c_kde ; c_sp3 = c_kps ; c_ep3 = c_kpe ; c_sm3 = c_kms ; c_em3 = c_kme
+            CASE ( DATA_ORDER_XZY )
+               c_sd1 = c_ids ; c_ed1 = c_ide ; c_sp1 = c_ips ; c_ep1 = c_ipe ; c_sm1 = c_ims ; c_em1 = c_ime
+               c_sd3 = c_jds ; c_ed3 = c_jde ; c_sp3 = c_jps ; c_ep3 = c_jpe ; c_sm3 = c_jms ; c_em3 = c_jme
+               c_sd2 = c_kds ; c_ed2 = c_kde ; c_sp2 = c_kps ; c_ep2 = c_kpe ; c_sm2 = c_kms ; c_em2 = c_kme
+            CASE ( DATA_ORDER_YZX )
+               c_sd3 = c_ids ; c_ed3 = c_ide ; c_sp3 = c_ips ; c_ep3 = c_ipe ; c_sm3 = c_ims ; c_em3 = c_ime
+               c_sd1 = c_jds ; c_ed1 = c_jde ; c_sp1 = c_jps ; c_ep1 = c_jpe ; c_sm1 = c_jms ; c_em1 = c_jme
+               c_sd2 = c_kds ; c_ed2 = c_kde ; c_sp2 = c_kps ; c_ep2 = c_kpe ; c_sm2 = c_kms ; c_em2 = c_kme
+         END SELECT
+
+         ALLOCATE ( intermediate_grid )
+         ALLOCATE ( intermediate_grid%parents( max_parents ) )
+         ALLOCATE ( intermediate_grid%nests( max_nests ) )
+
+         NULLIFY( intermediate_grid%sibling )
+         DO i = 1, max_nests
+            NULLIFY( intermediate_grid%nests(i)%ptr )
+         ENDDO
+         NULLIFY  (intermediate_grid%next)
+         NULLIFY  (intermediate_grid%same_level)
+         NULLIFY  (intermediate_grid%i_start)
+         NULLIFY  (intermediate_grid%j_start)
+         NULLIFY  (intermediate_grid%i_end)
+         NULLIFY  (intermediate_grid%j_end)
+         intermediate_grid%id = id   ! these must be the same. Other parts of code depend on it (see gen_comms.c)
+         intermediate_grid%num_nests = 0
+         intermediate_grid%num_siblings = 0
+         intermediate_grid%num_parents = 1
+         intermediate_grid%max_tiles   = 0
+         intermediate_grid%num_tiles_spec   = 0
+         CALL find_grid_by_id ( id, head_grid, nest_grid )
+
+         nest_grid%intermediate_grid => intermediate_grid  ! nest grid now has a pointer to this baby
+         intermediate_grid%parents(1)%ptr => nest_grid     ! the intermediate grid considers nest its parent
+         intermediate_grid%num_parents = 1
+
+         c_sm1x = 1 ; c_em1x = 1 ; c_sm2x = 1 ; c_em2x = 1 ; c_sm3x = 1 ; c_em3x = 1
+         c_sm1y = 1 ; c_em1y = 1 ; c_sm2y = 1 ; c_em2y = 1 ; c_sm3y = 1 ; c_em3y = 1
+
+         intermediate_grid%sm31x                           = c_sm1x
+         intermediate_grid%em31x                           = c_em1x
+         intermediate_grid%sm32x                           = c_sm2x
+         intermediate_grid%em32x                           = c_em2x
+         intermediate_grid%sm33x                           = c_sm3x
+         intermediate_grid%em33x                           = c_em3x
+         intermediate_grid%sm31y                           = c_sm1y
+         intermediate_grid%em31y                           = c_em1y
+         intermediate_grid%sm32y                           = c_sm2y
+         intermediate_grid%em32y                           = c_em2y
+         intermediate_grid%sm33y                           = c_sm3y
+         intermediate_grid%em33y                           = c_em3y
+
+#if defined(SGIALTIX) && (! defined(MOVE_NESTS) )
+         ! allocate space for the intermediate domain
+         CALL alloc_space_field ( intermediate_grid, intermediate_grid%id , 1, 2 , .TRUE., &   ! use same id as nest
+                               c_sd1, c_ed1, c_sd2, c_ed2, c_sd3, c_ed3,       &
+                               c_sm1,  c_em1,  c_sm2,  c_em2,  c_sm3,  c_em3,  &
+                               c_sm1x, c_em1x, c_sm2x, c_em2x, c_sm3x, c_em3x, &   ! x-xpose
+                               c_sm1y, c_em1y, c_sm2y, c_em2y, c_sm3y, c_em3y  )   ! y-xpose
+#endif
+         intermediate_grid%sd31                            =   c_sd1
+         intermediate_grid%ed31                            =   c_ed1
+         intermediate_grid%sp31                            = c_sp1
+         intermediate_grid%ep31                            = c_ep1
+         intermediate_grid%sm31                            = c_sm1
+         intermediate_grid%em31                            = c_em1
+         intermediate_grid%sd32                            =   c_sd2
+         intermediate_grid%ed32                            =   c_ed2
+         intermediate_grid%sp32                            = c_sp2
+         intermediate_grid%ep32                            = c_ep2
+         intermediate_grid%sm32                            = c_sm2
+         intermediate_grid%em32                            = c_em2
+         intermediate_grid%sd33                            =   c_sd3
+         intermediate_grid%ed33                            =   c_ed3
+         intermediate_grid%sp33                            = c_sp3
+         intermediate_grid%ep33                            = c_ep3
+         intermediate_grid%sm33                            = c_sm3
+         intermediate_grid%em33                            = c_em3
+
+         CALL med_add_config_info_to_grid ( intermediate_grid )
+
+         intermediate_grid%dx = parent%dx
+         intermediate_grid%dy = parent%dy
+         intermediate_grid%dt = parent%dt
+      ENDIF
+
+      RETURN
+  END SUBROUTINE patch_domain_rsl_lite
+
+  SUBROUTINE compute_memory_dims_rsl_lite  (      &
+                   id , maxhalowidth ,            &
+                   shw , bdx,  bdy ,              &
+                   ids,  ide,  jds,  jde,  kds,  kde, &
+                   ims,  ime,  jms,  jme,  kms,  kme, &
+                   imsx, imex, jmsx, jmex, kmsx, kmex, &
+                   imsy, imey, jmsy, jmey, kmsy, kmey, &
+                   ips,  ipe,  jps,  jpe,  kps,  kpe, &
+                   ipsx, ipex, jpsx, jpex, kpsx, kpex, &
+                   ipsy, ipey, jpsy, jpey, kpsy, kpey )
+
+    USE module_machine
+    IMPLICIT NONE
+    INTEGER, INTENT(IN)               ::  id , maxhalowidth
+    INTEGER, INTENT(IN)               ::  shw, bdx, bdy
+    INTEGER, INTENT(IN)     ::  ids, ide, jds, jde, kds, kde
+    INTEGER, INTENT(OUT)    ::  ims, ime, jms, jme, kms, kme
+    INTEGER, INTENT(OUT)    ::  imsx, imex, jmsx, jmex, kmsx, kmex
+    INTEGER, INTENT(OUT)    ::  imsy, imey, jmsy, jmey, kmsy, kmey
+    INTEGER, INTENT(OUT)    ::  ips, ipe, jps, jpe, kps, kpe
+    INTEGER, INTENT(OUT)    ::  ipsx, ipex, jpsx, jpex, kpsx, kpex
+    INTEGER, INTENT(OUT)    ::  ipsy, ipey, jpsy, jpey, kpsy, kpey
+
+    INTEGER Px, Py, P, i, j, k, ierr
+
+#if ( ! NMM_CORE == 1 )
+
+! xy decomposition
+
+    ips = -1
+    j = jds
+    ierr = 0
+    DO i = ids, ide
+       CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, &
+                             maxhalowidth, maxhalowidth, ierr )
+       IF ( Px .EQ. mytask_x ) THEN
+          ipe = i
+          IF ( ips .EQ. -1 ) ips = i
+       ENDIF
+    ENDDO
+    IF ( ierr .NE. 0 ) THEN
+       CALL tfp_message(__FILE__,__LINE__)
+    ENDIF
+    ! handle setting the memory dimensions where there are no X elements assigned to this proc
+    IF (ips .EQ. -1 ) THEN
+       ipe = -1
+       ips = 0
+    ENDIF
+    jps = -1
+    i = ids
+    ierr = 0
+    DO j = jds, jde
+       CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, &
+                             maxhalowidth, maxhalowidth, ierr )
+       IF ( Py .EQ. mytask_y ) THEN
+          jpe = j
+          IF ( jps .EQ. -1 ) jps = j
+       ENDIF
+    ENDDO
+    IF ( ierr .NE. 0 ) THEN
+       CALL tfp_message(__FILE__,__LINE__)
+    ENDIF
+    ! handle setting the memory dimensions where there are no Y elements assigned to this proc
+    IF (jps .EQ. -1 ) THEN
+       jpe = -1
+       jps = 0
+    ENDIF
+
+!begin: wig; 12-Mar-2008
+! This appears redundant with the conditionals above, but we get cases with only
+! one of the directions being set to "missing" when turning off extra processors.
+! This may break the handling of setting only one of nproc_x or nproc_y via the namelist.
+    IF (ipe .EQ. -1 .or. jpe .EQ. -1) THEN
+       ipe = -1
+       ips = 0
+       jpe = -1
+       jps = 0
+    ENDIF
+!end: wig; 12-Mar-2008
+
+! 
+! description of transpose decomposition strategy for RSL LITE. 20061231jm
+!
+! Here is the tranpose scheme that is implemented for RSL_LITE. Upper-case
+! XY corresponds to the dimension of the processor mesh, lower-case xyz
+! corresponds to grid dimension.
+! 
+!      xy        zy        zx
+! 
+!     XxYy <--> XzYy <--> XzYx <- note x decomposed over Y procs
+!       ^                  ^
+!       |                  |
+!       +------------------+  <- this edge is costly; see below
+! 
+! The aim is to avoid all-to-all communication over whole
+! communicator. Instead, when possible, use a transpose scheme that requires
+! all-to-all within dimensional communicators; that is, communicators
+! defined for the processes in a rank or column of the processor mesh. Note,
+! however, it is not possible to create a ring of transposes between
+! xy-yz-xz decompositions without at least one of the edges in the ring
+! being fully all-to-all (in other words, one of the tranpose edges must
+! rotate and not just transpose a plane of the model grid within the
+! processor mesh). The issue is then, where should we put this costly edge
+! in the tranpose scheme we chose? To avoid being completely arbitrary, 
+! we chose a scheme most natural for models that use parallel spectral
+! transforms, where the costly edge is the one that goes from the xz to
+! the xy decomposition.  (May be implemented as just a two step transpose
+! back through yz).
+!
+! Additional notational convention, below. The 'x' or 'y' appended to the
+! dimension start or end variable refers to which grid dimension is all
+! on-processor in the given decomposition. That is ipsx and ipex are the
+! start and end for the i-dimension in the zy decomposition where x is
+! on-processor. ('z' is assumed for xy decomposition and not appended to
+! the ips, ipe, etc. variable names).
+! 
+
+! XzYy decomposition
+
+    kpsx = -1
+    j = jds ;
+    ierr = 0
+    DO k = kds, kde
+       CALL task_for_point ( k, j, kds, kde, jds, jde, ntasks_x, ntasks_y, Px, Py, &
+                             1, maxhalowidth, ierr )
+       IF ( Px .EQ. mytask_x ) THEN
+          kpex = k
+          IF ( kpsx .EQ. -1 ) kpsx = k
+       ENDIF
+    ENDDO
+    IF ( ierr .NE. 0 ) THEN
+       CALL tfp_message(__FILE__,__LINE__)
+    ENDIF 
+    
+! handle case where no levels are assigned to this process
+! no iterations.  Do same for I and J. Need to handle memory alloc below.
+    IF (kpsx .EQ. -1 ) THEN
+       kpex = -1
+       kpsx = 0
+    ENDIF
+
+    jpsx = -1
+    k = kds ;
+    ierr = 0
+    DO j = jds, jde
+       CALL task_for_point ( k, j, kds, kde, jds, jde, ntasks_x, ntasks_y, Px, Py, &
+                             1, maxhalowidth, ierr )
+       IF ( Py .EQ. mytask_y ) THEN
+          jpex = j
+          IF ( jpsx .EQ. -1 ) jpsx = j
+       ENDIF
+    ENDDO
+    IF ( ierr .NE. 0 ) THEN
+       CALL tfp_message(__FILE__,__LINE__)
+    ENDIF 
+    IF (jpsx .EQ. -1 ) THEN
+       jpex = -1
+       jpsx = 0
+    ENDIF
+
+!begin: wig; 12-Mar-2008
+! This appears redundant with the conditionals above, but we get cases with only
+! one of the directions being set to "missing" when turning off extra processors.
+! This may break the handling of setting only one of nproc_x or nproc_y via the namelist.
+    IF (ipex .EQ. -1 .or. jpex .EQ. -1) THEN
+       ipex = -1
+       ipsx = 0
+       jpex = -1
+       jpsx = 0
+    ENDIF
+!end: wig; 12-Mar-2008
+
+! XzYx decomposition  (note, x grid dim is decomposed over Y processor dim)
+
+    kpsy = kpsx   ! same as above
+    kpey = kpex   ! same as above
+
+    ipsy = -1
+    k = kds ;
+    ierr = 0
+    DO i = ids, ide
+       CALL task_for_point ( i, k, ids, ide, kds, kde, ntasks_y, ntasks_x, Py, Px, &
+                             maxhalowidth, 1, ierr ) ! x and y for proc mesh reversed
+       IF ( Py .EQ. mytask_y ) THEN
+          ipey = i
+          IF ( ipsy .EQ. -1 ) ipsy = i
+       ENDIF
+    ENDDO
+    IF ( ierr .NE. 0 ) THEN
+       CALL tfp_message(__FILE__,__LINE__)
+    ENDIF 
+    IF (ipsy .EQ. -1 ) THEN
+       ipey = -1
+       ipsy = 0
+    ENDIF
+
+
+#else
+
+! In case of NMM CORE, the domain only ever runs from ids..ide-1 and jds..jde-1 so
+! adjust decomposition to reflect.  20051020 JM
+    ips = -1
+    j = jds
+    ierr = 0
+    DO i = ids, ide-1
+       CALL task_for_point ( i, j, ids, ide-1, jds, jde-1, ntasks_x, ntasks_y, Px, Py, &
+                             maxhalowidth, maxhalowidth , ierr )
+       IF ( Px .EQ. mytask_x ) THEN
+          ipe = i
+          IF ( Px .EQ. ntasks_x-1 ) ipe = ipe + 1
+          IF ( ips .EQ. -1 ) ips = i
+       ENDIF
+    ENDDO
+    IF ( ierr .NE. 0 ) THEN
+       CALL tfp_message(__FILE__,__LINE__)
+    ENDIF 
+    jps = -1
+    i = ids ;
+    ierr = 0
+    DO j = jds, jde-1
+       CALL task_for_point ( i, j, ids, ide-1, jds, jde-1, ntasks_x, ntasks_y, Px, Py, &
+                             maxhalowidth , maxhalowidth , ierr )
+       IF ( Py .EQ. mytask_y ) THEN
+          jpe = j
+          IF ( Py .EQ. ntasks_y-1 ) jpe = jpe + 1
+          IF ( jps .EQ. -1 ) jps = j
+       ENDIF
+    ENDDO
+    IF ( ierr .NE. 0 ) THEN
+       CALL tfp_message(__FILE__,__LINE__)
+    ENDIF 
+#endif
+
+! extend the patch dimensions out shw along edges of domain
+    IF ( ips < ipe .and. jps < jpe ) THEN           !wig; 11-Mar-2008
+       IF ( mytask_x .EQ. 0 ) THEN
+          ips = ips - shw
+          ipsy = ipsy - shw
+       ENDIF
+       IF ( mytask_x .EQ. ntasks_x-1 ) THEN
+          ipe = ipe + shw
+          ipey = ipey + shw
+       ENDIF
+       IF ( mytask_y .EQ. 0 ) THEN
+          jps = jps - shw
+          jpsx = jpsx - shw
+       ENDIF
+       IF ( mytask_y .EQ. ntasks_y-1 ) THEN
+          jpe = jpe + shw
+          jpex = jpex + shw
+       ENDIF
+    ENDIF                                           !wig; 11-Mar-2008
+
+    kps = 1
+    kpe = kde-kds+1
+
+    kms = 1
+    kme = kpe
+    kmsx = kpsx
+    kmex = kpex
+    kmsy = kpsy
+    kmey = kpey
+
+    ! handle setting the memory dimensions where there are no levels assigned to this proc
+    IF ( kpsx .EQ. 0 .AND. kpex .EQ. -1 ) THEN
+      kmsx = 0
+      kmex = 0
+    ENDIF
+    IF ( kpsy .EQ. 0 .AND. kpey .EQ. -1 ) THEN
+      kmsy = 0
+      kmey = 0
+    ENDIF
+
+    IF ( (jps .EQ. 0 .AND. jpe .EQ. -1) .OR. (ips .EQ. 0 .AND. ipe .EQ. -1) ) THEN
+      ims = 0
+      ime = 0
+    ELSE
+      ims = max( ips - max(shw,maxhalowidth), ids - bdx ) - 1
+      ime = min( ipe + max(shw,maxhalowidth), ide + bdx ) + 1
+    ENDIF
+    imsx = ids
+    imex = ide
+    ipsx = imsx
+    ipex = imex
+    ! handle setting the memory dimensions where there are no Y elements assigned to this proc
+    IF ( ipsy .EQ. 0 .AND. ipey .EQ. -1 ) THEN
+      imsy = 0
+      imey = 0
+    ELSE
+      imsy = ipsy
+      imey = ipey
+    ENDIF
+
+    IF ( (jps .EQ. 0 .AND. jpe .EQ. -1) .OR. (ips .EQ. 0 .AND. ipe .EQ. -1) ) THEN
+      jms = 0
+      jme = 0
+    ELSE
+      jms = max( jps - max(shw,maxhalowidth), jds - bdy ) - 1
+      jme = min( jpe + max(shw,maxhalowidth), jde + bdy ) + 1
+    ENDIF
+    jmsx = jpsx
+    jmex = jpex
+    jmsy = jds
+    jmey = jde
+    ! handle setting the memory dimensions where there are no X elements assigned to this proc
+    IF ( jpsx .EQ. 0 .AND. jpex .EQ. -1 ) THEN
+      jmsx = 0
+      jmex = 0
+    ELSE
+      jpsy = jmsy
+      jpey = jmey
+    ENDIF
+
+  END SUBROUTINE compute_memory_dims_rsl_lite
+
+! internal, used below for switching the argument to MPI calls
+! if reals are being autopromoted to doubles in the build of WRF
+   INTEGER function getrealmpitype()
+#ifndef STUBMPI
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER rtypesize, dtypesize, ierr
+      CALL mpi_type_size ( MPI_REAL, rtypesize, ierr )
+      CALL mpi_type_size ( MPI_DOUBLE_PRECISION, dtypesize, ierr )
+      IF ( RWORDSIZE .EQ. rtypesize ) THEN
+        getrealmpitype = MPI_REAL
+      ELSE IF ( RWORDSIZE .EQ. dtypesize ) THEN
+        getrealmpitype = MPI_DOUBLE_PRECISION
+      ELSE
+        CALL wrf_error_fatal ( 'RWORDSIZE or DWORDSIZE does not match any MPI type' )
+      ENDIF
+#else
+! required dummy initialization for function that is never called
+      getrealmpitype = 1
+#endif
+      RETURN
+   END FUNCTION getrealmpitype
+
+   REAL FUNCTION wrf_dm_max_real ( inval )
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      REAL inval, retval
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval , 1, getrealmpitype(), MPI_MAX, local_communicator, ierr )
+      wrf_dm_max_real = retval
+#else
+      REAL inval
+      wrf_dm_max_real = inval
+#endif
+   END FUNCTION wrf_dm_max_real
+
+   REAL FUNCTION wrf_dm_min_real ( inval )
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      REAL inval, retval
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval , 1, getrealmpitype(), MPI_MIN, local_communicator, ierr )
+      wrf_dm_min_real = retval
+#else
+      REAL inval
+      wrf_dm_min_real = inval
+#endif
+   END FUNCTION wrf_dm_min_real
+
+   SUBROUTINE wrf_dm_min_reals ( inval, retval, n )
+      IMPLICIT NONE
+      INTEGER n
+      REAL inval(*)
+      REAL retval(*)
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval , n, getrealmpitype(), MPI_MIN, local_communicator, ierr )
+#else
+      retval(1:n) = inval(1:n)
+#endif
+   END SUBROUTINE wrf_dm_min_reals
+
+   REAL FUNCTION wrf_dm_sum_real ( inval )
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      REAL inval, retval
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval , 1, getrealmpitype(), MPI_SUM, local_communicator, ierr )
+      wrf_dm_sum_real = retval
+#else
+      REAL inval
+      wrf_dm_sum_real = inval
+#endif
+   END FUNCTION wrf_dm_sum_real
+
+   SUBROUTINE wrf_dm_sum_reals (inval, retval)
+      IMPLICIT NONE
+      REAL, INTENT(IN)  :: inval(:)
+      REAL, INTENT(OUT) :: retval(:)
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval, SIZE(inval), getrealmpitype(), MPI_SUM, local_communicator, ierr )
+#else
+      retval = inval
+#endif
+   END SUBROUTINE wrf_dm_sum_reals
+
+   INTEGER FUNCTION wrf_dm_sum_integer ( inval )
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      INTEGER inval, retval
+      INTEGER ierr
+      CALL mpi_allreduce ( inval, retval , 1, MPI_INTEGER, MPI_SUM, local_communicator, ierr )
+      wrf_dm_sum_integer = retval
+#else
+      INTEGER inval
+      wrf_dm_sum_integer = inval
+#endif
+   END FUNCTION wrf_dm_sum_integer
+
+   SUBROUTINE wrf_dm_maxval_real ( val, idex, jdex )
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      REAL val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+      INTEGER i
+
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, local_communicator, ierr )
+      CALL mpi_allgather ( val, 1, getrealmpitype(), val_all , 1, getrealmpitype(), local_communicator, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .GT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#else
+      REAL val
+      INTEGER idex, jdex, ierr
+#endif
+   END SUBROUTINE wrf_dm_maxval_real
+
+#if (RWORDSIZE == 4)
+   SUBROUTINE wrf_dm_maxval_doubleprecision ( val, idex, jdex )
+      IMPLICIT NONE
+# ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      DOUBLE PRECISION val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+      INTEGER i
+
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, local_communicator, ierr )
+      CALL mpi_allgather ( val, 1, MPI_DOUBLE_PRECISION, val_all , 1, MPI_DOUBLE_PRECISION, local_communicator, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .GT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+# else
+      DOUBLE PRECISION val
+      INTEGER idex, jdex, ierr
+# endif
+   END SUBROUTINE wrf_dm_maxval_doubleprecision
+#endif
+
+   SUBROUTINE wrf_dm_maxval_integer ( val, idex, jdex )
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      INTEGER val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+      INTEGER i
+
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, local_communicator, ierr )
+      CALL mpi_allgather ( val, 1, MPI_INTEGER, val_all , 1, MPI_INTEGER, local_communicator, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .GT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#else
+      INTEGER val
+      INTEGER idex, jdex
+#endif
+   END SUBROUTINE wrf_dm_maxval_integer
+
+!  For HWRF some additional computation is required. This is gopal's doing
+
+   SUBROUTINE wrf_dm_minval_real ( val, idex, jdex )
+      IMPLICIT NONE
+      REAL val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_REAL, val_all , 1, MPI_REAL, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .LT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_minval_real
+
+#if (RWORDSIZE == 4)
+   SUBROUTINE wrf_dm_minval_doubleprecision ( val, idex, jdex )
+      IMPLICIT NONE
+      DOUBLE PRECISION val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_DOUBLE_PRECISION, val_all , 1, MPI_DOUBLE_PRECISION, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .LT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_minval_doubleprecision
+#endif
+
+   SUBROUTINE wrf_dm_minval_integer ( val, idex, jdex )
+      IMPLICIT NONE
+      INTEGER val, val_all( ntasks )
+      INTEGER idex, jdex, ierr
+      INTEGER dex(2)
+      INTEGER dex_all (2,ntasks)
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its index.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      dex(1) = idex ; dex(2) = jdex
+      CALL mpi_allgather ( dex, 2, MPI_INTEGER, dex_all , 2, MPI_INTEGER, comm, ierr )
+      CALL mpi_allgather ( val, 1, MPI_INTEGER, val_all , 1, MPI_INTEGER, comm, ierr )
+      val = val_all(1)
+      idex = dex_all(1,1) ; jdex = dex_all(2,1)
+      DO i = 2, ntasks
+        IF ( val_all(i) .LT. val ) THEN
+           val = val_all(i)
+           idex = dex_all(1,i)
+           jdex = dex_all(2,i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_minval_integer     ! End of gopal's doing
+
+   SUBROUTINE split_communicator
+#ifndef STUBMPI
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      LOGICAL mpi_inited
+      INTEGER mpi_comm_here, mpi_comm_local, comdup,  mytask, ntasks, ierr, io_status
+#  if defined(_OPENMP) && defined(MPI2_THREAD_SUPPORT)
+      INTEGER thread_support_provided, thread_support_requested
+#endif
+      INTEGER i, j
+      INTEGER, ALLOCATABLE :: icolor(:)
+      INTEGER tasks_per_split
+      NAMELIST /namelist_split/ tasks_per_split
+
+      CALL MPI_INITIALIZED( mpi_inited, ierr )
+      IF ( .NOT. mpi_inited ) THEN
+#  if defined(_OPENMP) && defined(MPI2_THREAD_SUPPORT)
+        thread_support_requested = MPI_THREAD_FUNNELED
+        CALL mpi_init_thread ( thread_support_requested, thread_support_provided, ierr )
+        IF ( thread_support_provided .lt. thread_support_requested ) THEN
+           CALL WRF_ERROR_FATAL( "failed to initialize MPI thread support")
+        ENDIF
+#  else
+        CALL mpi_init ( ierr )
+#  endif
+        CALL wrf_set_dm_communicator( MPI_COMM_WORLD )
+        CALL wrf_termio_dup
+      ENDIF
+      CALL wrf_get_dm_communicator( mpi_comm_here )
+
+      CALL MPI_Comm_rank ( mpi_comm_here, mytask, ierr ) ;
+      CALL mpi_comm_size ( mpi_comm_here, ntasks, ierr ) ;
+#if (DA_CORE == 1)
+      CALL mpi_comm_split( MPI_COMM_WORLD , 4 , 1 , mpi_comm_local, ierr )
+      CALL wrf_set_dm_communicator( mpi_comm_local )
+      CALL wrf_termio_dup
+      CALL wrf_get_dm_communicator( mpi_comm_here )
+#endif
+
+      IF ( mytask .EQ. 0 ) THEN
+        OPEN ( unit=27, file="namelist.input", form="formatted", status="old" )
+        tasks_per_split = ntasks
+        READ ( 27 , NML = namelist_split, IOSTAT=io_status )
+        CLOSE ( 27 )
+      ENDIF
+      CALL mpi_bcast( io_status, 1 , MPI_INTEGER , 0 , mpi_comm_here, ierr )
+      IF ( io_status .NE. 0 ) THEN
+          RETURN ! just ignore and return
+      ENDIF
+      CALL mpi_bcast( tasks_per_split, 1 , MPI_INTEGER , 0 , mpi_comm_here, ierr )
+      IF ( tasks_per_split .GT. ntasks .OR. tasks_per_split .LE. 0 ) RETURN
+      IF ( mod( ntasks, tasks_per_split ) .NE. 0 ) THEN
+        CALL wrf_message( 'WARNING: tasks_per_split does not evenly divide ntasks. Some tasks will be wasted.' )
+      ENDIF
+
+      ALLOCATE( icolor(ntasks) )
+      j = 0
+      DO WHILE ( j .LT. ntasks / tasks_per_split ) 
+        DO i = 1, tasks_per_split
+          icolor( i + j * tasks_per_split ) = j 
+        ENDDO
+        j = j + 1
+      ENDDO
+
+      CALL MPI_Comm_dup(mpi_comm_here,comdup,ierr)
+      CALL MPI_Comm_split(comdup,icolor(mytask+1),mytask,mpi_comm_local,ierr)
+      CALL wrf_set_dm_communicator( mpi_comm_local )
+
+      DEALLOCATE( icolor )
+#endif
+   END SUBROUTINE split_communicator
+
+   SUBROUTINE init_module_dm
+#ifndef STUBMPI
+      IMPLICIT NONE
+      INTEGER mpi_comm_local, ierr, mytask, nproc
+      INCLUDE 'mpif.h'
+      LOGICAL mpi_inited
+      CALL mpi_initialized( mpi_inited, ierr )
+      IF ( .NOT. mpi_inited ) THEN
+	! If MPI has not been initialized then initialize it and 
+	! make comm_world the communicator
+	! Otherwise, something else (e.g. quilt-io) has already 
+	! initialized MPI, so just grab the communicator that
+	! should already be stored and use that.
+	CALL mpi_init ( ierr )
+        CALL wrf_termio_dup
+	CALL wrf_set_dm_communicator ( MPI_COMM_WORLD )
+      ENDIF
+      CALL wrf_get_dm_communicator( mpi_comm_local )
+#endif
+   END SUBROUTINE init_module_dm
+
+! stub
+   SUBROUTINE wrf_dm_move_nest ( parent, nest, dx, dy )
+      USE module_domain, ONLY : domain
+      IMPLICIT NONE
+      TYPE (domain), INTENT(INOUT) :: parent, nest
+      INTEGER, INTENT(IN)          :: dx,dy
+      RETURN
+   END SUBROUTINE wrf_dm_move_nest
+
+!------------------------------------------------------------------------------
+   SUBROUTINE get_full_obs_vector( nsta, nerrf, niobf,          &
+                                   mp_local_uobmask,            &
+                                   mp_local_vobmask,            &
+                                   mp_local_cobmask, errf )
+      
+!------------------------------------------------------------------------------
+!  PURPOSE: Do MPI allgatherv operation across processors to get the
+!           errors at each observation point on all processors. 
+!       
+!------------------------------------------------------------------------------
+        
+    INTEGER, INTENT(IN)   :: nsta                ! Observation index.
+    INTEGER, INTENT(IN)   :: nerrf               ! Number of error fields.
+    INTEGER, INTENT(IN)   :: niobf               ! Number of observations.
+    LOGICAL, INTENT(IN)   :: MP_LOCAL_UOBMASK(NIOBF)
+    LOGICAL, INTENT(IN)   :: MP_LOCAL_VOBMASK(NIOBF)
+    LOGICAL, INTENT(IN)   :: MP_LOCAL_COBMASK(NIOBF)
+    REAL, INTENT(INOUT)   :: errf(nerrf, niobf)
+
+#ifndef STUBMPI
+    INCLUDE 'mpif.h'
+        
+! Local declarations
+    integer i, n, nlocal_dot, nlocal_crs
+    REAL UVT_BUFFER(NIOBF)    ! Buffer for holding U, V, or T
+    REAL QRK_BUFFER(NIOBF)    ! Buffer for holding Q or RKO
+    REAL SFP_BUFFER(NIOBF)    ! Buffer for holding Surface pressure
+    INTEGER N_BUFFER(NIOBF)
+    REAL FULL_BUFFER(NIOBF)
+    INTEGER IFULL_BUFFER(NIOBF)
+    INTEGER IDISPLACEMENT(1024)   ! HARD CODED MAX NUMBER OF PROCESSORS
+    INTEGER ICOUNT(1024)          ! HARD CODED MAX NUMBER OF PROCESSORS
+
+    INTEGER :: MPI_COMM_COMP      ! MPI group communicator
+    INTEGER :: NPROCS             ! Number of processors
+    INTEGER :: IERR               ! Error code from MPI routines
+
+! Get communicator for MPI operations.
+    CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
+
+! Get rank of monitor processor and broadcast to others.
+    CALL MPI_COMM_SIZE( MPI_COMM_COMP, NPROCS, IERR )
+
+! DO THE U FIELD
+   NLOCAL_DOT = 0
+   DO N = 1, NSTA
+     IF ( MP_LOCAL_UOBMASK(N) ) THEN      ! USE U-POINT MASK
+       NLOCAL_DOT = NLOCAL_DOT + 1
+       UVT_BUFFER(NLOCAL_DOT) = ERRF(1,N)        ! U WIND COMPONENT
+       SFP_BUFFER(NLOCAL_DOT) = ERRF(7,N)        ! SURFACE PRESSURE
+       QRK_BUFFER(NLOCAL_DOT) = ERRF(9,N)        ! RKO
+       N_BUFFER(NLOCAL_DOT) = N
+     ENDIF
+   ENDDO
+   CALL MPI_ALLGATHER(NLOCAL_DOT,1,MPI_INTEGER, &
+                      ICOUNT,1,MPI_INTEGER,     &
+                      MPI_COMM_COMP,IERR)
+   I = 1
+
+   IDISPLACEMENT(1) = 0
+   DO I = 2, NPROCS
+     IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1)
+   ENDDO
+   CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_DOT, MPI_INTEGER,    &
+                        IFULL_BUFFER, ICOUNT, IDISPLACEMENT,  &
+                        MPI_INTEGER, MPI_COMM_COMP, IERR)
+! U
+   CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(1,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! SURF PRESS AT U-POINTS
+   CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(7,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! RKO
+   CALL MPI_ALLGATHERV( QRK_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(9,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+
+! DO THE V FIELD
+   NLOCAL_DOT = 0
+   DO N = 1, NSTA
+     IF ( MP_LOCAL_VOBMASK(N) ) THEN         ! USE V-POINT MASK
+       NLOCAL_DOT = NLOCAL_DOT + 1
+       UVT_BUFFER(NLOCAL_DOT) = ERRF(2,N)    ! V WIND COMPONENT
+       SFP_BUFFER(NLOCAL_DOT) = ERRF(8,N)    ! SURFACE PRESSURE
+       N_BUFFER(NLOCAL_DOT) = N
+     ENDIF
+   ENDDO
+   CALL MPI_ALLGATHER(NLOCAL_DOT,1,MPI_INTEGER, &
+                      ICOUNT,1,MPI_INTEGER,     &
+                      MPI_COMM_COMP,IERR)
+   I = 1
+
+   IDISPLACEMENT(1) = 0
+   DO I = 2, NPROCS
+     IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1)
+   ENDDO
+   CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_DOT, MPI_INTEGER,    &
+                        IFULL_BUFFER, ICOUNT, IDISPLACEMENT,  &
+                        MPI_INTEGER, MPI_COMM_COMP, IERR)
+! V
+   CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(2,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! SURF PRESS AT V-POINTS
+   CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_DOT, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(8,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+
+! DO THE CROSS FIELDS, T AND Q
+   NLOCAL_CRS = 0
+   DO N = 1, NSTA
+     IF ( MP_LOCAL_COBMASK(N) ) THEN       ! USE MASS-POINT MASK
+       NLOCAL_CRS = NLOCAL_CRS + 1
+       UVT_BUFFER(NLOCAL_CRS) = ERRF(3,N)     ! TEMPERATURE
+       QRK_BUFFER(NLOCAL_CRS) = ERRF(4,N)     ! MOISTURE
+       SFP_BUFFER(NLOCAL_CRS) = ERRF(6,N)     ! SURFACE PRESSURE
+       N_BUFFER(NLOCAL_CRS) = N
+     ENDIF
+   ENDDO
+   CALL MPI_ALLGATHER(NLOCAL_CRS,1,MPI_INTEGER, &
+                      ICOUNT,1,MPI_INTEGER,     &
+                      MPI_COMM_COMP,IERR)
+   IDISPLACEMENT(1) = 0
+   DO I = 2, NPROCS
+     IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1)
+   ENDDO
+   CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_CRS, MPI_INTEGER,    &
+                        IFULL_BUFFER, ICOUNT, IDISPLACEMENT,  &
+                        MPI_INTEGER, MPI_COMM_COMP, IERR)
+! T
+   CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_CRS, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+
+   DO N = 1, NSTA
+     ERRF(3,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! Q
+   CALL MPI_ALLGATHERV( QRK_BUFFER, NLOCAL_CRS, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(4,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+! SURF PRESS AT MASS POINTS
+   CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_CRS, MPI_REAL,     &
+                        FULL_BUFFER, ICOUNT, IDISPLACEMENT,   &
+                        MPI_REAL, MPI_COMM_COMP, IERR)
+   DO N = 1, NSTA
+     ERRF(6,IFULL_BUFFER(N)) = FULL_BUFFER(N)
+   ENDDO
+#endif
+   END SUBROUTINE get_full_obs_vector
+
+
+
+   SUBROUTINE wrf_dm_maxtile_real ( val , tile)
+      IMPLICIT NONE
+      REAL val, val_all( ntasks )
+      INTEGER tile
+      INTEGER ierr
+
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the maximum of all values passed and its tile number.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      CALL mpi_allgather ( val, 1, getrealmpitype(), val_all , 1, getrealmpitype(), comm, ierr )
+      val = val_all(1)
+      tile = 1
+      DO i = 2, ntasks
+        IF ( val_all(i) .GT. val ) THEN
+           tile = i
+           val = val_all(i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_maxtile_real
+
+
+   SUBROUTINE wrf_dm_mintile_real ( val , tile)
+      IMPLICIT NONE
+      REAL val, val_all( ntasks )
+      INTEGER tile
+      INTEGER ierr
+
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the minimum of all values passed and its tile number.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      CALL mpi_allgather ( val, 1, getrealmpitype(), val_all , 1, getrealmpitype(), comm, ierr )
+      val = val_all(1)
+      tile = 1
+      DO i = 2, ntasks
+        IF ( val_all(i) .LT. val ) THEN
+           tile = i
+           val = val_all(i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_mintile_real
+
+
+   SUBROUTINE wrf_dm_mintile_double ( val , tile)
+      IMPLICIT NONE
+      DOUBLE PRECISION val, val_all( ntasks )
+      INTEGER tile
+      INTEGER ierr
+
+! <DESCRIPTION>
+! Collective operation. Each processor calls passing a local value and its index; on return
+! all processors are passed back the minimum of all values passed and its tile number.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      CALL mpi_allgather ( val, 1, MPI_DOUBLE_PRECISION, val_all , 1, MPI_DOUBLE_PRECISION, comm, ierr )
+      val = val_all(1)
+      tile = 1
+      DO i = 2, ntasks
+        IF ( val_all(i) .LT. val ) THEN
+           tile = i
+           val = val_all(i)
+        ENDIF
+      ENDDO
+#endif
+   END SUBROUTINE wrf_dm_mintile_double
+
+
+   SUBROUTINE wrf_dm_tile_val_int ( val , tile)
+      IMPLICIT NONE
+      INTEGER val, val_all( ntasks )
+      INTEGER tile
+      INTEGER ierr
+
+! <DESCRIPTION>
+! Collective operation. Get value from input tile.
+!
+! </DESCRIPTION>
+      INTEGER i, comm
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+
+      CALL wrf_get_dm_communicator ( comm )
+      CALL mpi_allgather ( val, 1, MPI_INTEGER, val_all , 1, MPI_INTEGER, comm, ierr )
+      val = val_all(tile)
+#endif
+   END SUBROUTINE wrf_dm_tile_val_int
+
+   SUBROUTINE wrf_get_hostname  ( str )
+      CHARACTER*(*) str
+      CHARACTER tmp(512)
+      INTEGER i , n, cs
+      CALL rsl_lite_get_hostname( tmp, 512, n, cs )
+      DO i = 1, n 
+        str(i:i) = tmp(i)
+      ENDDO
+      RETURN
+   END SUBROUTINE wrf_get_hostname 
+
+   SUBROUTINE wrf_get_hostid  ( hostid )
+      INTEGER hostid
+      CHARACTER tmp(512)
+      INTEGER i, sz, n, cs
+      CALL rsl_lite_get_hostname( tmp, 512, n, cs )
+      hostid = cs
+      RETURN
+   END SUBROUTINE wrf_get_hostid
+
+END MODULE module_dm
+
+!=========================================================================
+! wrf_dm_patch_domain has to be outside the module because it is called
+! by a routine in module_domain but depends on module domain
+
+SUBROUTINE wrf_dm_patch_domain ( id  , domdesc , parent_id , parent_domdesc , &
+                          sd1 , ed1 , sp1 , ep1 , sm1 , em1 , &
+                          sd2 , ed2 , sp2 , ep2 , sm2 , em2 , &
+                          sd3 , ed3 , sp3 , ep3 , sm3 , em3 , &
+                                      sp1x , ep1x , sm1x , em1x , &
+                                      sp2x , ep2x , sm2x , em2x , &
+                                      sp3x , ep3x , sm3x , em3x , &
+                                      sp1y , ep1y , sm1y , em1y , &
+                                      sp2y , ep2y , sm2y , em2y , &
+                                      sp3y , ep3y , sm3y , em3y , &
+                          bdx , bdy )
+   USE module_domain, ONLY : domain, head_grid, find_grid_by_id
+   USE module_dm
+   IMPLICIT NONE
+
+   INTEGER, INTENT(IN)   :: sd1 , ed1 , sd2 , ed2 , sd3 , ed3 , bdx , bdy
+   INTEGER, INTENT(OUT)  :: sp1 , ep1 , sp2 , ep2 , sp3 , ep3 , &
+                            sm1 , em1 , sm2 , em2 , sm3 , em3
+   INTEGER               :: sp1x , ep1x , sp2x , ep2x , sp3x , ep3x , &
+                            sm1x , em1x , sm2x , em2x , sm3x , em3x
+   INTEGER               :: sp1y , ep1y , sp2y , ep2y , sp3y , ep3y , &
+                            sm1y , em1y , sm2y , em2y , sm3y , em3y
+   INTEGER, INTENT(INOUT):: id  , domdesc , parent_id , parent_domdesc
+
+   TYPE(domain), POINTER :: parent
+   TYPE(domain), POINTER :: grid_ptr
+
+   ! this is necessary because we cannot pass parent directly into 
+   ! wrf_dm_patch_domain because creating the correct interface definitions
+   ! would generate a circular USE reference between module_domain and module_dm
+   ! see comment this date in module_domain for more information. JM 20020416
+
+   NULLIFY( parent )
+   grid_ptr => head_grid
+   CALL find_grid_by_id( parent_id , grid_ptr , parent )
+
+   CALL patch_domain_rsl_lite ( id  , parent, parent_id , &
+                           sd1 , ed1 , sp1 , ep1 , sm1 , em1 , & 
+                           sd2 , ed2 , sp2 , ep2 , sm2 , em2 , &
+                           sd3 , ed3 , sp3 , ep3 , sm3 , em3 , &
+                                      sp1x , ep1x , sm1x , em1x , &
+                                      sp2x , ep2x , sm2x , em2x , &
+                                      sp3x , ep3x , sm3x , em3x , &
+                                      sp1y , ep1y , sm1y , em1y , &
+                                      sp2y , ep2y , sm2y , em2y , &
+                                      sp3y , ep3y , sm3y , em3y , &
+                           bdx , bdy )
+
+   RETURN
+END SUBROUTINE wrf_dm_patch_domain
+
+SUBROUTINE wrf_termio_dup
+  IMPLICIT NONE
+  INTEGER mytask, ntasks
+#ifndef STUBMPI
+  INTEGER ierr
+  INCLUDE 'mpif.h'
+  CALL mpi_comm_size(MPI_COMM_WORLD, ntasks, ierr )
+  CALL mpi_comm_rank(MPI_COMM_WORLD, mytask, ierr )
+  write(0,*)'starting wrf task ',mytask,' of ',ntasks
+  CALL rsl_error_dup1( mytask )
+#else
+  mytask = 0
+  ntasks = 1
+#endif
+END SUBROUTINE wrf_termio_dup
+
+SUBROUTINE wrf_get_myproc( myproc )
+  USE module_dm , ONLY : mytask
+  IMPLICIT NONE
+  INTEGER myproc
+  myproc = mytask
+  RETURN
+END SUBROUTINE wrf_get_myproc
+
+SUBROUTINE wrf_get_nproc( nproc )
+  USE module_dm , ONLY : ntasks
+  IMPLICIT NONE
+  INTEGER nproc
+  nproc = ntasks
+  RETURN
+END SUBROUTINE wrf_get_nproc
+
+SUBROUTINE wrf_get_nprocx( nprocx )
+  USE module_dm , ONLY : ntasks_x
+  IMPLICIT NONE
+  INTEGER nprocx
+  nprocx = ntasks_x
+  RETURN
+END SUBROUTINE wrf_get_nprocx
+
+SUBROUTINE wrf_get_nprocy( nprocy )
+  USE module_dm , ONLY : ntasks_y
+  IMPLICIT NONE
+  INTEGER nprocy
+  nprocy = ntasks_y
+  RETURN
+END SUBROUTINE wrf_get_nprocy
+
+SUBROUTINE wrf_dm_bcast_bytes ( buf , size )
+   USE module_dm , ONLY : local_communicator
+   IMPLICIT NONE
+#ifndef STUBMPI
+   INCLUDE 'mpif.h'
+#endif
+   INTEGER size
+#ifndef NEC
+   INTEGER*1 BUF(size)
+#else
+   CHARACTER*1 BUF(size)
+#endif
+#ifndef STUBMPI
+   CALL BYTE_BCAST ( buf , size, local_communicator )
+#endif
+   RETURN
+END SUBROUTINE wrf_dm_bcast_bytes
+
+SUBROUTINE wrf_dm_bcast_string( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+! <DESCRIPTION>
+! Collective operation. Given a string and a size in characters on task zero, broadcast and return that buffer on all tasks.
+!
+! </DESCRIPTION>
+   CHARACTER*(*) buf
+#ifndef STUBMPI
+   INTEGER ibuf(256),i,n
+   CHARACTER*256 tstr
+   n = n1
+   ! Root task is required to have the correct value of N1, other tasks 
+   ! might not have the correct value.  
+   CALL wrf_dm_bcast_integer( n , 1 )
+   IF (n .GT. 256) n = 256
+   IF (n .GT. 0 ) then
+     DO i = 1, n
+       ibuf(I) = ichar(buf(I:I))
+     ENDDO
+     CALL wrf_dm_bcast_integer( ibuf, n )
+     buf = ''
+     DO i = 1, n
+       buf(i:i) = char(ibuf(i))
+     ENDDO
+   ENDIF
+#endif
+   RETURN
+END SUBROUTINE wrf_dm_bcast_string
+
+SUBROUTINE wrf_dm_bcast_integer( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   INTEGER  buf(*)
+   CALL wrf_dm_bcast_bytes ( BUF , N1 * IWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_integer
+
+SUBROUTINE wrf_dm_bcast_double( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+! this next declaration is REAL, not DOUBLE PRECISION because it will be autopromoted
+! to double precision by the compiler when WRF is compiled for 8 byte reals. Only reason
+! for having this separate routine is so we pass the correct MPI type to mpi_scatterv
+! since we were not indexing the globbuf and Field arrays it does not matter
+   REAL  buf(*)
+   CALL wrf_dm_bcast_bytes ( BUF , N1 * DWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_double
+
+SUBROUTINE wrf_dm_bcast_real( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   REAL  buf(*)
+   CALL wrf_dm_bcast_bytes ( BUF , N1 * RWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_real
+
+SUBROUTINE wrf_dm_bcast_logical( BUF, N1 )
+   IMPLICIT NONE
+   INTEGER n1
+   LOGICAL  buf(*)
+   CALL wrf_dm_bcast_bytes ( BUF , N1 * LWORDSIZE )
+   RETURN
+END SUBROUTINE wrf_dm_bcast_logical
+
+SUBROUTINE write_68( grid, v , s , &
+                   ids, ide, jds, jde, kds, kde, &
+                   ims, ime, jms, jme, kms, kme, &
+                   its, ite, jts, jte, kts, kte )
+  USE module_domain, ONLY : domain
+  IMPLICIT NONE
+  TYPE(domain) , INTENT (INOUT) :: grid 
+  CHARACTER *(*) s
+  INTEGER ids, ide, jds, jde, kds, kde, &
+          ims, ime, jms, jme, kms, kme, &
+          its, ite, jts, jte, kts, kte
+  REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: v
+
+  INTEGER i,j,k,ierr
+
+  logical, external :: wrf_dm_on_monitor
+  real globbuf( ids:ide, kds:kde, jds:jde )
+  character*3 ord, stag
+
+  if ( kds == kde ) then
+    ord = 'xy'
+    stag = 'xy'
+  CALL wrf_patch_to_global_real ( v, globbuf, grid%domdesc, stag, ord, &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+  else
+
+    stag = 'xyz' 
+    ord = 'xzy'
+  CALL wrf_patch_to_global_real ( v, globbuf, grid%domdesc, stag, ord, &
+                     ids, ide, kds, kde, jds, jde, &
+                     ims, ime, kms, kme, jms, jme, &
+                     its, ite, kts, kte, jts, jte )
+  endif
+
+
+  if ( wrf_dm_on_monitor() ) THEN
+    WRITE(68,*) ide-ids+1, jde-jds+1 , s
+    DO j = jds, jde
+    DO i = ids, ide
+       WRITE(68,*) globbuf(i,1,j)
+    ENDDO
+    ENDDO
+  endif
+
+  RETURN
+END
+
+   SUBROUTINE wrf_abort
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      INTEGER ierr
+      CALL mpi_abort(MPI_COMM_WORLD,1,ierr)
+#else
+      STOP
+#endif
+   END SUBROUTINE wrf_abort
+
+   SUBROUTINE wrf_dm_shutdown
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INTEGER ierr
+      CALL MPI_FINALIZE( ierr )
+#endif
+      RETURN
+   END SUBROUTINE wrf_dm_shutdown
+
+   LOGICAL FUNCTION wrf_dm_on_monitor()
+!     USE module_dm
+      IMPLICIT NONE
+#ifndef STUBMPI
+      INCLUDE 'mpif.h'
+      INTEGER tsk, ierr, mpi_comm_local
+      CALL wrf_get_dm_communicator( mpi_comm_local )
+      CALL mpi_comm_rank ( mpi_comm_local, tsk , ierr )
+      wrf_dm_on_monitor = tsk .EQ. 0
+#else
+      wrf_dm_on_monitor = .TRUE.
+#endif
+      RETURN
+   END FUNCTION wrf_dm_on_monitor
+
+   INTEGER FUNCTION wrf_dm_monitor_rank()
+!     USE module_dm
+      IMPLICIT NONE
+      wrf_dm_monitor_rank = 0
+      RETURN
+   END FUNCTION wrf_dm_monitor_rank
+
+   SUBROUTINE wrf_get_dm_communicator ( communicator )
+      USE module_dm , ONLY : local_communicator
+      IMPLICIT NONE
+      INTEGER , INTENT(OUT) :: communicator
+      communicator = local_communicator
+      RETURN
+   END SUBROUTINE wrf_get_dm_communicator
+
+   SUBROUTINE wrf_get_dm_iocommunicator ( iocommunicator )
+      USE module_dm , ONLY : local_iocommunicator
+      IMPLICIT NONE
+      INTEGER , INTENT(OUT) :: iocommunicator
+      iocommunicator = local_iocommunicator
+      RETURN
+   END SUBROUTINE wrf_get_dm_iocommunicator
+
+   SUBROUTINE wrf_set_dm_communicator ( communicator )
+      USE module_dm , ONLY : local_communicator
+      IMPLICIT NONE
+      INTEGER , INTENT(IN) :: communicator
+      local_communicator = communicator
+      RETURN
+   END SUBROUTINE wrf_set_dm_communicator
+
+   SUBROUTINE wrf_set_dm_iocommunicator ( iocommunicator )
+      USE module_dm , ONLY : local_iocommunicator
+      IMPLICIT NONE
+      INTEGER , INTENT(IN) :: iocommunicator
+      local_iocommunicator = iocommunicator
+      RETURN
+   END SUBROUTINE wrf_set_dm_iocommunicator
+
+
+!!!!!!!!!!!!!!!!!!!!!!! PATCH TO GLOBAL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   SUBROUTINE wrf_patch_to_global_real (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       REAL globbuf(*)
+       REAL buf(*)
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,RWORDSIZE,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_real 
+
+   SUBROUTINE wrf_patch_to_global_double (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+! this next declaration is REAL, not DOUBLE PRECISION because it will be autopromoted
+! to double precision by the compiler when WRF is compiled for 8 byte reals. Only reason
+! for having this separate routine is so we pass the correct MPI type to mpi_scatterv
+! since we were not indexing the globbuf and Field arrays it does not matter
+       REAL globbuf(*)
+       REAL buf(*)
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,DWORDSIZE,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_double
+
+
+   SUBROUTINE wrf_patch_to_global_integer (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       INTEGER globbuf(*)
+       INTEGER buf(*)
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,IWORDSIZE,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_integer 
+
+
+   SUBROUTINE wrf_patch_to_global_logical (buf,globbuf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       LOGICAL globbuf(*)
+       LOGICAL buf(*)
+
+       CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,LWORDSIZE,&
+                                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                         MS1,ME1,MS2,ME2,MS3,ME3,&
+                                         PS1,PE1,PS2,PE2,PS3,PE3 )
+
+       RETURN
+   END SUBROUTINE wrf_patch_to_global_logical
+
+#ifdef DEREF_KLUDGE
+#  define FRSTELEM (1)
+#else
+#  define FRSTELEM
+#endif
+
+   SUBROUTINE wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,typesize,&
+                                       DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3a )
+       USE module_driver_constants
+       USE module_timing
+       USE module_wrf_error
+       USE module_dm
+       IMPLICIT NONE
+       INTEGER                         DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3A 
+       CHARACTER *(*) stagger,ordering
+       INTEGER domdesc,typesize,ierr
+       REAL globbuf(*)
+       REAL buf(*)
+#ifndef STUBMPI
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       INTEGER                         ids,ide,jds,jde,kds,kde,&
+                                       ims,ime,jms,jme,kms,kme,&
+                                       ips,ipe,jps,jpe,kps,kpe
+       LOGICAL, EXTERNAL :: wrf_dm_on_monitor, has_char
+
+       INTEGER i, j, k,  ndim
+       INTEGER  Patch(3,2), Gpatch(3,2,ntasks)
+    ! allocated further down, after the D indices are potentially recalculated for staggering
+       REAL, ALLOCATABLE :: tmpbuf( : )
+       REAL locbuf( (PE1a-PS1a+1)*(PE2a-PS2a+1)*(PE3a-PS3a+1)/RWORDSIZE*typesize+32 )
+
+       DS1 = DS1a ; DE1 = DE1a ; DS2=DS2a ; DE2 = DE2a ; DS3 = DS3a ; DE3 = DE3a
+       MS1 = MS1a ; ME1 = ME1a ; MS2=MS2a ; ME2 = ME2a ; MS3 = MS3a ; ME3 = ME3a
+       PS1 = PS1a ; PE1 = PE1a ; PS2=PS2a ; PE2 = PE2a ; PS3 = PS3a ; PE3 = PE3a
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xy', 'yx' )
+           ndim = 2
+         CASE DEFAULT
+           ndim = 3   ! where appropriate
+       END SELECT
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xyz','xy' )
+            ! the non-staggered variables come in at one-less than
+            ! domain dimensions, but code wants full domain spec, so
+            ! adjust if not staggered
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE2 = DE2+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'yxz','yx' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE1 = DE1+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'zxy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE1 = DE1+1
+         CASE ( 'xzy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE2 = DE2+1
+         CASE DEFAULT
+       END SELECT
+
+     ! moved to here to be after the potential recalculations of D dims
+       IF ( wrf_dm_on_monitor() ) THEN
+         ALLOCATE ( tmpbuf ( (DE1-DS1+1)*(DE2-DS2+1)*(DE3-DS3+1)/RWORDSIZE*typesize+32 ), STAT=ierr )
+       ELSE
+         ALLOCATE ( tmpbuf ( 1 ), STAT=ierr )
+       ENDIF
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating tmpbuf in wrf_patch_to_global_generic')
+ 
+       Patch(1,1) = ps1 ; Patch(1,2) = pe1    ! use patch dims
+       Patch(2,1) = ps2 ; Patch(2,2) = pe2
+       Patch(3,1) = ps3 ; Patch(3,2) = pe3
+
+       IF      ( typesize .EQ. RWORDSIZE ) THEN
+         CALL just_patch_r ( buf , locbuf , size(locbuf), &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. IWORDSIZE ) THEN
+         CALL just_patch_i ( buf , locbuf , size(locbuf), &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. DWORDSIZE ) THEN
+         CALL just_patch_d ( buf , locbuf , size(locbuf), &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. LWORDSIZE ) THEN
+         CALL just_patch_l ( buf , locbuf , size(locbuf), &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ENDIF
+
+! defined in external/io_quilt
+       CALL collect_on_comm0 (  local_communicator , IWORDSIZE ,  &
+                                Patch , 6 ,                       &
+                                GPatch , 6*ntasks                 )
+
+       CALL collect_on_comm0 (  local_communicator , typesize ,  &
+                                locbuf , (pe1-ps1+1)*(pe2-ps2+1)*(pe3-ps3+1),   &
+                                tmpbuf FRSTELEM , (de1-ds1+1)*(de2-ds2+1)*(de3-ds3+1) )
+
+       ndim = len(TRIM(ordering))
+
+       IF ( wrf_at_debug_level(500) ) THEN
+         CALL start_timing
+       ENDIF
+
+       IF ( ndim .GE. 2 .AND. wrf_dm_on_monitor() ) THEN
+
+         IF      ( typesize .EQ. RWORDSIZE ) THEN
+	   CALL patch_2_outbuf_r ( tmpbuf FRSTELEM , globbuf ,             &
+				   DS1, DE1, DS2, DE2, DS3, DE3 , &
+				   GPATCH                         )
+	 ELSE IF ( typesize .EQ. IWORDSIZE ) THEN
+	   CALL patch_2_outbuf_i ( tmpbuf FRSTELEM , globbuf ,             &
+				   DS1, DE1, DS2, DE2, DS3, DE3 , &
+				   GPATCH                         )
+	 ELSE IF ( typesize .EQ. DWORDSIZE ) THEN
+	   CALL patch_2_outbuf_d ( tmpbuf FRSTELEM , globbuf ,             &
+				   DS1, DE1, DS2, DE2, DS3, DE3 , &
+				   GPATCH                         )
+	 ELSE IF ( typesize .EQ. LWORDSIZE ) THEN
+	   CALL patch_2_outbuf_l ( tmpbuf FRSTELEM , globbuf ,             &
+				   DS1, DE1, DS2, DE2, DS3, DE3 , &
+				   GPATCH                         )
+	 ENDIF
+
+       ENDIF
+
+       IF ( wrf_at_debug_level(500) ) THEN
+         CALL end_timing('wrf_patch_to_global_generic')
+       ENDIF
+       DEALLOCATE( tmpbuf )
+#endif
+       RETURN
+    END SUBROUTINE wrf_patch_to_global_generic
+
+  SUBROUTINE just_patch_i ( inbuf , outbuf, noutbuf,     &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER                         , INTENT(IN)  :: noutbuf
+    INTEGER    , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    INTEGER    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( icurs )  = inbuf( i, j, k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE just_patch_i
+
+  SUBROUTINE just_patch_r ( inbuf , outbuf, noutbuf,     &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER                      , INTENT(IN)  :: noutbuf
+    REAL    , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    REAL    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(in) :: inbuf
+! Local
+    INTEGER               :: i,j,k   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2 
+          DO i = PS1, PE1
+            outbuf( icurs )  = inbuf( i, j, k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE just_patch_r
+
+  SUBROUTINE just_patch_d ( inbuf , outbuf, noutbuf,     &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER                                  , INTENT(IN)  :: noutbuf
+    DOUBLE PRECISION    , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    DOUBLE PRECISION    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(in) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2 
+          DO i = PS1, PE1
+            outbuf( icurs )  = inbuf( i, j, k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE just_patch_d
+
+  SUBROUTINE just_patch_l ( inbuf , outbuf, noutbuf,     &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER                         , INTENT(IN)  :: noutbuf
+    LOGICAL    , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    LOGICAL    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(in) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2 
+          DO i = PS1, PE1
+            outbuf( icurs )  = inbuf( i, j, k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE just_patch_l
+
+
+  SUBROUTINE patch_2_outbuf_r( inbuf, outbuf,            &
+                               DS1,DE1,DS2,DE2,DS3,DE3,  &
+                               GPATCH ) 
+    USE module_dm
+    IMPLICIT NONE
+    REAL    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    REAL    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( i, j, k ) = inbuf( icurs )
+            icurs = icurs + 1
+	  ENDDO
+	ENDDO
+      ENDDO
+    ENDDO
+
+    RETURN
+  END SUBROUTINE patch_2_outbuf_r
+
+  SUBROUTINE patch_2_outbuf_i( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    INTEGER    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( i, j, k ) = inbuf( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE patch_2_outbuf_i
+
+  SUBROUTINE patch_2_outbuf_d( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    DOUBLE PRECISION    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    DOUBLE PRECISION    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( i, j, k ) = inbuf( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE patch_2_outbuf_d
+
+  SUBROUTINE patch_2_outbuf_l( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    LOGICAL    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    LOGICAL    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( i, j, k ) = inbuf( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE patch_2_outbuf_l
+
+!!!!!!!!!!!!!!!!!!!!!!! GLOBAL TO PATCH !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    SUBROUTINE wrf_global_to_patch_real (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       REAL globbuf(*)
+       REAL buf(*)
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,RWORDSIZE,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_real
+
+    SUBROUTINE wrf_global_to_patch_double (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+! this next declaration is REAL, not DOUBLE PRECISION because it will be autopromoted
+! to double precision by the compiler when WRF is compiled for 8 byte reals. Only reason
+! for having this separate routine is so we pass the correct MPI type to mpi_scatterv
+! since we were not indexing the globbuf and Field arrays it does not matter
+       REAL globbuf(*)
+       REAL buf(*)
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,DWORDSIZE,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_double
+
+
+    SUBROUTINE wrf_global_to_patch_integer (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       INTEGER globbuf(*)
+       INTEGER buf(*)
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,IWORDSIZE,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_integer
+
+    SUBROUTINE wrf_global_to_patch_logical (globbuf,buf,domdesc,stagger,ordering,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       IMPLICIT NONE
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       CHARACTER *(*) stagger,ordering
+       INTEGER fid,domdesc
+       LOGICAL globbuf(*)
+       LOGICAL buf(*)
+
+       CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,LWORDSIZE,&
+                                       DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3 )
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_logical
+
+    SUBROUTINE wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,typesize,&
+                                       DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3a )
+       USE module_dm
+       USE module_driver_constants
+       IMPLICIT NONE
+       INTEGER                         DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,&
+                                       MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,&
+                                       PS1a,PE1a,PS2a,PE2a,PS3a,PE3A 
+       CHARACTER *(*) stagger,ordering
+       INTEGER domdesc,typesize,ierr
+       REAL globbuf(*)
+       REAL buf(*)
+#ifndef STUBMPI
+       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
+                                       MS1,ME1,MS2,ME2,MS3,ME3,&
+                                       PS1,PE1,PS2,PE2,PS3,PE3
+       LOGICAL, EXTERNAL :: wrf_dm_on_monitor, has_char
+
+       INTEGER i,j,k,ord,ord2d,ndim
+       INTEGER  Patch(3,2), Gpatch(3,2,ntasks)
+       REAL, ALLOCATABLE :: tmpbuf( : )
+       REAL locbuf( (PE1a-PS1a+1)*(PE2a-PS2a+1)*(PE3a-PS3a+1)/RWORDSIZE*typesize+32 )
+
+       DS1 = DS1a ; DE1 = DE1a ; DS2=DS2a ; DE2 = DE2a ; DS3 = DS3a ; DE3 = DE3a
+       MS1 = MS1a ; ME1 = ME1a ; MS2=MS2a ; ME2 = ME2a ; MS3 = MS3a ; ME3 = ME3a
+       PS1 = PS1a ; PE1 = PE1a ; PS2=PS2a ; PE2 = PE2a ; PS3 = PS3a ; PE3 = PE3a
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xy', 'yx' )
+           ndim = 2
+         CASE DEFAULT
+           ndim = 3   ! where appropriate
+       END SELECT
+
+       SELECT CASE ( TRIM(ordering) )
+         CASE ( 'xyz','xy' )
+            ! the non-staggered variables come in at one-less than
+            ! domain dimensions, but code wants full domain spec, so
+            ! adjust if not staggered
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE2 = DE2+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'yxz','yx' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE1 = DE1+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1
+         CASE ( 'zxy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE1 = DE1+1
+         CASE ( 'xzy' )
+           IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1
+           IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1
+           IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE2 = DE2+1
+         CASE DEFAULT
+       END SELECT
+
+     ! moved to here to be after the potential recalculations of D dims
+       IF ( wrf_dm_on_monitor() ) THEN
+         ALLOCATE ( tmpbuf ( (DE1-DS1+1)*(DE2-DS2+1)*(DE3-DS3+1)/RWORDSIZE*typesize+32 ), STAT=ierr )
+       ELSE
+         ALLOCATE ( tmpbuf ( 1 ), STAT=ierr )
+       ENDIF
+       IF ( ierr .ne. 0 ) CALL wrf_error_fatal ('allocating tmpbuf in wrf_global_to_patch_generic')
+
+       Patch(1,1) = ps1 ; Patch(1,2) = pe1    ! use patch dims
+       Patch(2,1) = ps2 ; Patch(2,2) = pe2
+       Patch(3,1) = ps3 ; Patch(3,2) = pe3
+
+! defined in external/io_quilt
+       CALL collect_on_comm0 (  local_communicator , IWORDSIZE ,  &
+                                Patch , 6 ,                       &
+                                GPatch , 6*ntasks                 )
+       ndim = len(TRIM(ordering))
+
+       IF ( wrf_dm_on_monitor() .AND. ndim .GE. 2 ) THEN
+         IF      ( typesize .EQ. RWORDSIZE ) THEN
+           CALL outbuf_2_patch_r ( globbuf , tmpbuf FRSTELEM ,    &
+                                   DS1, DE1, DS2, DE2, DS3, DE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3 , &
+                                   GPATCH                         )
+         ELSE IF ( typesize .EQ. IWORDSIZE ) THEN
+           CALL outbuf_2_patch_i ( globbuf , tmpbuf FRSTELEM ,    &
+                                   DS1, DE1, DS2, DE2, DS3, DE3 , &
+                                   GPATCH                         )
+         ELSE IF ( typesize .EQ. DWORDSIZE ) THEN
+           CALL outbuf_2_patch_d ( globbuf , tmpbuf FRSTELEM ,    &
+                                   DS1, DE1, DS2, DE2, DS3, DE3 , &
+                                   GPATCH                         )
+         ELSE IF ( typesize .EQ. LWORDSIZE ) THEN
+           CALL outbuf_2_patch_l ( globbuf , tmpbuf FRSTELEM ,    &
+                                   DS1, DE1, DS2, DE2, DS3, DE3 , &
+                                   GPATCH                         )
+         ENDIF
+       ENDIF
+
+       CALL dist_on_comm0 (  local_communicator , typesize ,  &
+                             tmpbuf FRSTELEM , (de1-ds1+1)*(de2-ds2+1)*(de3-ds3+1) , &
+                             locbuf    , (pe1-ps1+1)*(pe2-ps2+1)*(pe3-ps3+1) )
+
+       IF      ( typesize .EQ. RWORDSIZE ) THEN
+         CALL all_sub_r ( locbuf , buf ,             &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+
+       ELSE IF ( typesize .EQ. IWORDSIZE ) THEN
+         CALL all_sub_i ( locbuf , buf ,             &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. DWORDSIZE ) THEN
+         CALL all_sub_d ( locbuf , buf ,             &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ELSE IF ( typesize .EQ. LWORDSIZE ) THEN
+         CALL all_sub_l ( locbuf , buf ,             &
+                                   PS1, PE1, PS2, PE2, PS3, PE3 , &
+                                   MS1, ME1, MS2, ME2, MS3, ME3   )
+       ENDIF
+
+
+       DEALLOCATE ( tmpbuf )
+#endif
+       RETURN
+    END SUBROUTINE wrf_global_to_patch_generic
+
+  SUBROUTINE all_sub_i ( inbuf , outbuf,              &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    INTEGER    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( i, j, k )  = inbuf ( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE all_sub_i
+
+  SUBROUTINE all_sub_r ( inbuf , outbuf,              &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    REAL       , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    REAL       , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( i, j, k )  = inbuf ( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+
+    RETURN
+  END SUBROUTINE all_sub_r
+
+  SUBROUTINE all_sub_d ( inbuf , outbuf,              &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    DOUBLE PRECISION    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    DOUBLE PRECISION    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( i, j, k )  = inbuf ( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE all_sub_d
+
+  SUBROUTINE all_sub_l ( inbuf , outbuf,              &
+                               PS1,PE1,PS2,PE2,PS3,PE3,  &
+                               MS1,ME1,MS2,ME2,MS3,ME3   )
+    USE module_dm
+    IMPLICIT NONE
+    LOGICAL    , DIMENSION(*) , INTENT(IN) :: inbuf
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    INTEGER   PS1,PE1,PS2,PE2,PS3,PE3
+    LOGICAL    , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+      DO k = PS3, PE3
+        DO j = PS2, PE2
+          DO i = PS1, PE1
+            outbuf( i, j, k )  = inbuf ( icurs )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    RETURN
+  END SUBROUTINE all_sub_l
+
+  SUBROUTINE outbuf_2_patch_r( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3, &
+                               MS1, ME1, MS2, ME2, MS3, ME3 , &
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    REAL    , DIMENSION(*) , INTENT(OUT) :: outbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    INTEGER   MS1,ME1,MS2,ME2,MS3,ME3
+    REAL    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( icurs ) = inbuf( i,j,k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE outbuf_2_patch_r
+
+  SUBROUTINE outbuf_2_patch_i( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    INTEGER    , DIMENSION(*) , INTENT(OUT) :: outbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    INTEGER    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( icurs ) = inbuf( i,j,k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE outbuf_2_patch_i
+
+  SUBROUTINE outbuf_2_patch_d( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    DOUBLE PRECISION    , DIMENSION(*) , INTENT(OUT) :: outbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    DOUBLE PRECISION    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( icurs ) = inbuf( i,j,k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE outbuf_2_patch_d
+
+  SUBROUTINE outbuf_2_patch_l( inbuf, outbuf,         &
+                               DS1,DE1,DS2,DE2,DS3,DE3,&
+                               GPATCH )
+    USE module_dm
+    IMPLICIT NONE
+    LOGICAL    , DIMENSION(*) , INTENT(OUT) :: outbuf
+    INTEGER   DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks)
+    LOGICAL    , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf
+! Local
+    INTEGER               :: i,j,k,n   ,  icurs
+    icurs = 1
+    DO n = 1, ntasks
+      DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n )
+        DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n )
+          DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n )
+            outbuf( icurs ) = inbuf( i,j,k )
+            icurs = icurs + 1
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDDO
+    RETURN
+  END SUBROUTINE outbuf_2_patch_l
+
+
+
+!------------------------------------------------------------------
+
+#if ( EM_CORE == 1 )
+
+!------------------------------------------------------------------
+
+   SUBROUTINE force_domain_em_part2 ( grid, ngrid, config_flags    &
+!
+#include "dummy_new_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+#include "nest_interpdown_unpack.inc"
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_FORCE_DOWN.inc"
+
+      ! code here to interpolate the data into the nested domain
+#  include "nest_forcedown_interp.inc"
+
+      RETURN
+   END SUBROUTINE force_domain_em_part2
+
+!------------------------------------------------------------------
+
+   SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags    &
+!
+#include "dummy_new_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      USE module_timing
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+#include <dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      INTEGER iparstrt,jparstrt,sw
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          iids, iide, ijds, ijde, ikds, ikde,    &
+                                iims, iime, ijms, ijme, ikms, ikme,    &
+                                iips, iipe, ijps, ijpe, ikps, ikpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+
+      INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr 
+      INTEGER thisdomain_max_halo_width
+      INTEGER local_comm, myproc, nproc
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  intermediate_grid ,              &
+                                iids, iide, ijds, ijde, ikds, ikde,    &
+                                iims, iime, ijms, ijme, ikms, ikme,    &
+                                iips, iipe, ijps, ijpe, ikps, ikpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      CALL nl_get_parent_grid_ratio ( ngrid%id, pgr )
+      CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt )
+      CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt )
+      CALL nl_get_shw            ( intermediate_grid%id, sw )
+      icoord =    iparstrt - sw
+      jcoord =    jparstrt - sw
+      idim_cd = iide - iids + 1
+      jdim_cd = ijde - ijds + 1
+
+      nlev  = ckde - ckds + 1
+
+      ! get max_halo_width for parent. It may be smaller if it is moad
+      CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width )
+
+#include "nest_interpdown_pack.inc"
+
+      CALL rsl_lite_bcast_msgs( myproc, nproc, local_comm )
+
+      RETURN
+   END SUBROUTINE interp_domain_em_part1
+
+!------------------------------------------------------------------
+
+   SUBROUTINE interp_domain_em_part2 ( grid, ngrid, config_flags    &
+!
+#include "dummy_new_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+      INTEGER myproc
+      INTEGER ierr
+      INTEGER thisdomain_max_halo_width
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1 
+
+      CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width )
+
+#include "nest_interpdown_unpack.inc"
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_INTERP_DOWN.inc"
+
+#  include "nest_interpdown_interp.inc"
+
+      RETURN
+   END SUBROUTINE interp_domain_em_part2
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_nest_prep ( grid, config_flags    &
+!
+#include "dummy_new_args.inc"
+!
+)
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), TARGET :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE (grid_config_rec_type) :: config_flags ! configureation flags, has vertical dim of 
+                                                  ! soil temp, moisture, etc., has vertical dim
+                                                  ! of soil categories
+#include <dummy_new_decl.inc>
+
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+
+      INTEGER       :: idum1, idum2
+
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#ifdef DM_PARALLEL
+#include "HALO_INTERP_UP.inc"
+#endif
+
+   END SUBROUTINE feedback_nest_prep
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_domain_em_part1 ( grid, ngrid, config_flags    &
+!
+#include "dummy_new_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE(domain), POINTER :: xgrid
+      TYPE (grid_config_rec_type)            :: config_flags, nconfig_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER local_comm, myproc, nproc, idum1, idum2
+      INTEGER thisdomain_max_halo_width
+
+      INTERFACE
+          SUBROUTINE feedback_nest_prep ( grid, config_flags    &
+!
+#include "dummy_new_args.inc"
+!
+)
+             USE module_state_description
+             USE module_domain, ONLY : domain
+             USE module_configure, ONLY : grid_config_rec_type
+!
+             TYPE (grid_config_rec_type)            :: config_flags
+             TYPE(domain), TARGET                   :: grid
+#include <dummy_new_decl.inc>
+          END SUBROUTINE feedback_nest_prep
+      END INTERFACE
+!
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+!
+! intermediate grid
+      CALL get_ijk_from_grid (  grid ,                                 &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+! nest grid
+      CALL get_ijk_from_grid (  ngrid ,                                &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+      ips_save = ngrid%i_parent_start   ! used in feedback_domain_em_part2 below
+      jps_save = ngrid%j_parent_start
+      ipe_save = ngrid%i_parent_start + (nide-nids+1) / ngrid%parent_grid_ratio - 1
+      jpe_save = ngrid%j_parent_start + (njde-njds+1) / ngrid%parent_grid_ratio - 1
+
+! feedback_nest_prep invokes a halo exchange on the ngrid. It is done this way
+! in a separate routine because the HALOs need the data to be dereference from the
+! grid data structure and, in this routine, the dereferenced fields are related to
+! the intermediate domain, not the nest itself. Save the current grid pointer to intermediate
+! domain, switch grid to point to ngrid, invoke feedback_nest_prep,  then restore grid
+! to point to intermediate domain.
+
+      CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags )
+      CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 )
+      xgrid => grid
+      grid => ngrid
+
+      CALL feedback_nest_prep ( grid, nconfig_flags    &
+!
+#include "actual_new_args.inc"
+!
+)
+
+! put things back so grid is intermediate grid
+
+      grid => xgrid
+      CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
+
+! "interp" (basically copy) ngrid onto intermediate grid
+
+#include "nest_feedbackup_interp.inc"
+
+      RETURN
+   END SUBROUTINE feedback_domain_em_part1
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid, ngrid , config_flags    &
+!
+#include "dummy_new_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, domain_clock_get, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type, model_config_rec
+      USE module_dm
+      USE module_utility
+      IMPLICIT NONE
+
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+
+#include <dummy_new_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+      INTEGER icoord, jcoord, idim_cd, jdim_cd
+      INTEGER local_comm, myproc, nproc
+      INTEGER iparstrt, jparstrt, sw, thisdomain_max_halo_width
+      REAL    nest_influence
+
+      character*256 :: timestr
+      integer ierr
+
+      LOGICAL, EXTERNAL  :: cd_feedback_mask
+
+! On entry to this routine, 
+!  "grid" refers to the parent domain
+!  "intermediate_grid" refers to local copy of parent domain that overlies this patch of nest
+!  "ngrid" refers to the nest, which is only needed for smoothing on the parent because 
+!          the nest feedback data has already been transferred during em_nest_feedbackup_interp
+!          in part1, above.
+! The way these settings c and n dimensions are set, below, looks backwards but from the point 
+! of view of the RSL routine rsl_lite_to_parent_info(), call to which is included by 
+! em_nest_feedbackup_pack, the "n" domain represents the parent domain and the "c" domain
+! represents the intermediate domain. The backwards lookingness should be fixed in the gen_comms.c
+! registry routine that accompanies RSL_LITE but, just as it's sometimes easier to put up a road
+! sign that says "DIP" than fix the dip,  at this point it was easier just to write this comment. JM
+!
+      nest_influence = 1.
+
+      CALL domain_clock_get( grid, current_timestr=timestr )
+
+      CALL get_ijk_from_grid (  intermediate_grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  grid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt )
+      CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt )
+      CALL nl_get_shw            ( intermediate_grid%id, sw )
+      icoord =    iparstrt - sw
+      jcoord =    jparstrt - sw
+      idim_cd = cide - cids + 1
+      jdim_cd = cjde - cjds + 1
+
+      nlev  = ckde - ckds + 1
+
+      CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width )
+
+#include "nest_feedbackup_pack.inc"
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+      CALL rsl_lite_merge_msgs( myproc, nproc, local_comm )
+
+#define NEST_INFLUENCE(A,B) A = B
+#include "nest_feedbackup_unpack.inc"
+
+      ! smooth coarse grid
+      CALL get_ijk_from_grid (  ngrid,                           &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_INTERP_UP.inc"
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+
+#include "nest_feedbackup_smooth.inc"
+
+      RETURN
+   END SUBROUTINE feedback_domain_em_part2
+#endif
+
+#if ( NMM_CORE == 1 && NMM_NEST == 1 )
+!==============================================================================
+! NMM nesting infrastructure extended from EM core. This is gopal's doing.
+!==============================================================================
+
+   SUBROUTINE interp_domain_nmm_part1 ( grid, intermediate_grid, ngrid, config_flags    &
+!
+#include "dummy_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      USE module_timing
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+#include <dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      INTEGER iparstrt,jparstrt,sw
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          iids, iide, ijds, ijde, ikds, ikde,    &
+                                iims, iime, ijms, ijme, ikms, ikme,    &
+                                iips, iipe, ijps, ijpe, ikps, ikpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+
+      INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr
+      INTEGER local_comm, myproc, nproc
+      INTEGER thisdomain_max_halo_width
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+#define COPY_IN
+#include <scalar_derefs.inc>
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  intermediate_grid ,              &
+                                iids, iide, ijds, ijde, ikds, ikde,    &
+                                iims, iime, ijms, ijme, ikms, ikme,    &
+                                iips, iipe, ijps, ijpe, ikps, ikpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      CALL nl_get_parent_grid_ratio ( ngrid%id, pgr )
+      CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt )
+      CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt )
+      CALL nl_get_shw            ( intermediate_grid%id, sw )
+      icoord =    iparstrt - sw
+      jcoord =    jparstrt - sw
+      idim_cd = iide - iids + 1
+      jdim_cd = ijde - ijds + 1
+
+      nlev  = ckde - ckds + 1
+
+      CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width )
+#include "nest_interpdown_pack.inc"
+
+      CALL rsl_lite_bcast_msgs( myproc, nproc, local_comm )
+
+#define COPY_OUT
+#include <scalar_derefs.inc>
+      RETURN
+   END SUBROUTINE interp_domain_nmm_part1
+
+!------------------------------------------------------------------
+
+   SUBROUTINE interp_domain_nmm_part2 ( grid, ngrid, config_flags    &
+!
+#include "dummy_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+      INTEGER myproc
+      INTEGER ierr
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+#include "deref_kludge.h"
+
+#define COPY_IN
+#include <scalar_derefs.inc>
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1 
+
+#include "nest_interpdown_unpack.inc"
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_NMM_INTERP_DOWN1.inc"
+
+#include "nest_interpdown_interp.inc"
+
+#define COPY_OUT
+#include <scalar_derefs.inc>
+
+      RETURN
+   END SUBROUTINE interp_domain_nmm_part2
+
+!------------------------------------------------------------------
+
+   SUBROUTINE force_domain_nmm_part1 ( grid, intermediate_grid, config_flags    &
+!
+#include "dummy_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      USE module_timing
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+#include <dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+#define COPY_IN
+#include <scalar_derefs.inc>
+!
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+
+      CALL get_ijk_from_grid (  intermediate_grid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+#include "nest_forcedown_pack.inc"
+
+!   WRITE(0,*)'I have completed PACKING of BCs data successfully'
+
+#define COPY_OUT
+#include <scalar_derefs.inc>
+      RETURN
+   END SUBROUTINE force_domain_nmm_part1
+
+!==============================================================================================
+
+   SUBROUTINE force_domain_nmm_part2 ( grid, ngrid, config_flags    &
+!
+#include "dummy_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+integer myproc
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+#include "deref_kludge.h"
+
+#define COPY_IN
+#include <scalar_derefs.inc>
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  ngrid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+#include "nest_interpdown_unpack.inc"
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_NMM_FORCE_DOWN1.inc"
+
+      ! code here to interpolate the data into the nested domain
+#include "nest_forcedown_interp.inc"
+
+#define COPY_OUT
+#include <scalar_derefs.inc>
+
+      RETURN
+   END SUBROUTINE force_domain_nmm_part2
+
+!================================================================================
+!
+! This routine exists only to call a halo on a domain (the nest)
+! gets called from feedback_domain_em_part1, below.  This is needed
+! because the halo code expects the fields being exchanged to have
+! been dereferenced from the grid data structure, but in feedback_domain_em_part1
+! the grid data structure points to the coarse domain, not the nest.
+! And we want the halo exchange on the nest, so that the code in
+! em_nest_feedbackup_interp.inc will work correctly on multi-p. JM 20040308
+!
+
+   SUBROUTINE feedback_nest_prep_nmm ( grid, config_flags    &
+!
+#include "dummy_args.inc"
+!
+)
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), TARGET :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE (grid_config_rec_type) :: config_flags ! configureation flags, has vertical dim of
+                                                  ! soil temp, moisture, etc., has vertical dim
+                                                  ! of soil categories
+#include <dummy_decl.inc>
+
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+
+      INTEGER       :: idum1, idum2
+
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+#include "deref_kludge.h"
+
+#define COPY_IN
+#include <scalar_derefs.inc>
+
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#ifdef DM_PARALLEL
+#include "HALO_NMM_WEIGHTS.inc"
+#endif
+
+#define COPY_OUT
+#include <scalar_derefs.inc>
+
+   END SUBROUTINE feedback_nest_prep_nmm
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_domain_nmm_part1 ( grid, ngrid, config_flags    &
+!
+#include "dummy_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec
+      USE module_dm
+      IMPLICIT NONE
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: ngrid
+#include <dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE(domain), POINTER :: xgrid
+      TYPE (grid_config_rec_type)            :: config_flags, nconfig_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER local_comm, myproc, nproc, idum1, idum2
+
+#ifdef DEREF_KLUDGE
+!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
+   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
+   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
+   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
+#endif
+
+      INTERFACE
+          SUBROUTINE feedback_nest_prep_nmm ( grid, config_flags    &
+!
+#include "dummy_args.inc"
+!
+)
+             USE module_state_description
+             USE module_domain, ONLY : domain
+             USE module_configure, ONLY : grid_config_rec_type
+!
+             TYPE (grid_config_rec_type)            :: config_flags
+             TYPE(domain), TARGET                   :: grid
+#include <dummy_decl.inc>
+          END SUBROUTINE feedback_nest_prep_nmm
+      END INTERFACE
+!
+#define COPY_IN
+#include <scalar_derefs.inc>
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+
+!
+! intermediate grid
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+! nest grid
+      CALL get_ijk_from_grid (  ngrid ,                  &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nlev  = ckde - ckds + 1
+
+      ips_save = ngrid%i_parent_start  ! +1 not used in ipe_save & jpe_save
+      jps_save = ngrid%j_parent_start  !  because of one extra namelist point
+      ipe_save = ngrid%i_parent_start + (nide-nids) / ngrid%parent_grid_ratio
+      jpe_save = ngrid%j_parent_start + (njde-njds) / ngrid%parent_grid_ratio
+
+! feedback_nest_prep invokes a halo exchange on the ngrid. It is done this way
+! in a separate routine because the HALOs need the data to be dereference from the
+! grid data structure and, in this routine, the dereferenced fields are related to
+! the intermediate domain, not the nest itself. Save the current grid pointer to intermediate
+! domain, switch grid to point to ngrid, invoke feedback_nest_prep,  then restore grid
+! to point to intermediate domain.
+
+      CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags )
+      CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 )
+      xgrid => grid
+      grid => ngrid
+#include "deref_kludge.h"
+      CALL feedback_nest_prep_nmm ( grid, config_flags    &
+!
+#include "actual_args.inc"
+!
+)
+
+! put things back so grid is intermediate grid
+
+      grid => xgrid
+      CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
+
+! "interp" (basically copy) ngrid onto intermediate grid
+
+#include "nest_feedbackup_interp.inc"
+
+#define COPY_OUT
+#include <scalar_derefs.inc>
+      RETURN
+   END SUBROUTINE feedback_domain_nmm_part1
+
+!------------------------------------------------------------------
+
+   SUBROUTINE feedback_domain_nmm_part2 ( grid, intermediate_grid, ngrid , config_flags    &
+!
+#include "dummy_args.inc"
+!
+                 )
+      USE module_state_description
+      USE module_domain, ONLY : domain, domain_clock_get, get_ijk_from_grid
+      USE module_configure, ONLY : grid_config_rec_type
+      USE module_dm
+      USE module_utility
+      IMPLICIT NONE
+
+!
+      TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
+      TYPE(domain), POINTER :: intermediate_grid
+      TYPE(domain), POINTER :: ngrid
+
+#include <dummy_decl.inc>
+      INTEGER nlev, msize
+      INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
+      TYPE (grid_config_rec_type)            :: config_flags
+      REAL xv(500)
+      INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe
+      INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe
+      INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe
+      INTEGER icoord, jcoord, idim_cd, jdim_cd
+      INTEGER local_comm, myproc, nproc
+      INTEGER iparstrt, jparstrt, sw
+      INTEGER thisdomain_max_halo_width
+
+      character*256 :: timestr
+      integer ierr
+
+      REAL    nest_influence
+      LOGICAL, EXTERNAL  :: cd_feedback_mask
+      LOGICAL, EXTERNAL  :: cd_feedback_mask_v
+
+#define COPY_IN
+#include <scalar_derefs.inc>
+
+! On entry to this routine,
+!  "grid" refers to the parent domain
+!  "intermediate_grid" refers to local copy of parent domain that overlies this patch of nest
+!  "ngrid" refers to the nest, which is only needed for smoothing on the parent because
+!          the nest feedback data has already been transferred during em_nest_feedbackup_interp
+!          in part1, above.
+! The way these settings c and n dimensions are set, below, looks backwards but from the point
+! of view of the RSL routine rsl_lite_to_parent_info(), call to which is included by
+! em_nest_feedbackup_pack, the "n" domain represents the parent domain and the "c" domain
+! represents the intermediate domain. The backwards lookingness should be fixed in the gen_comms.c
+! registry routine that accompanies RSL_LITE but, just as it's sometimes easier to put up a road
+! sign that says "DIP" than fix the dip,  at this point it was easier just to write this comment. JM
+!
+
+      nest_influence = 0.5
+#define NEST_INFLUENCE(A,B) A = nest_influence*(B) + (1.0-nest_influence)*(A)
+
+
+      CALL domain_clock_get( grid, current_timestr=timestr )
+
+      CALL get_ijk_from_grid (  intermediate_grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+      CALL get_ijk_from_grid (  grid ,              &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe    )
+
+      nide = nide - 1   !dusan
+      njde = njde - 1   !dusan
+
+      CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt )
+      CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt )
+      CALL nl_get_shw            ( intermediate_grid%id, sw )
+      icoord =    iparstrt  - sw
+      jcoord =    jparstrt  - sw
+      idim_cd = cide - cids + 1
+      jdim_cd = cjde - cjds + 1
+
+      nlev  = ckde - ckds + 1
+
+      CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width )
+#include "nest_feedbackup_pack.inc"
+
+      CALL wrf_get_dm_communicator ( local_comm )
+      CALL wrf_get_myproc( myproc )
+      CALL wrf_get_nproc( nproc )
+
+      CALL rsl_lite_merge_msgs( myproc, nproc, local_comm )
+
+#include "nest_feedbackup_unpack.inc"
+
+
+      ! smooth coarse grid
+
+      CALL get_ijk_from_grid (  ngrid,                                 &
+                                nids, nide, njds, njde, nkds, nkde,    &
+                                nims, nime, njms, njme, nkms, nkme,    &
+                                nips, nipe, njps, njpe, nkps, nkpe     )
+      CALL get_ijk_from_grid (  grid ,              &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                ips, ipe, jps, jpe, kps, kpe    )
+
+#include "HALO_INTERP_UP.inc"
+
+      CALL get_ijk_from_grid (  grid ,                   &
+                                cids, cide, cjds, cjde, ckds, ckde,    &
+                                cims, cime, cjms, cjme, ckms, ckme,    &
+                                cips, cipe, cjps, cjpe, ckps, ckpe    )
+
+#include "nest_feedbackup_smooth.inc"
+
+#define COPY_OUT
+#include <scalar_derefs.inc>
+      RETURN
+   END SUBROUTINE feedback_domain_nmm_part2
+
+!=================================================================================
+!   End of gopal's doing
+!=================================================================================
+#endif
+
+!------------------------------------------------------------------
+
+   SUBROUTINE wrf_gatherv_real (Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   USE module_dm, ONLY : getrealmpitype
+   IMPLICIT NONE
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   REAL, DIMENSION(*) :: Field, globbuf
+#ifndef STUBMPI
+   INCLUDE 'mpif.h'
+
+           CALL mpi_gatherv( Field( field_ofst ),      &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            getrealmpitype() ,               &    ! sendtype
+                            globbuf( glob_ofst ) ,                 &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            getrealmpitype()               , &    ! recvtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+#endif
+
+   END SUBROUTINE wrf_gatherv_real
+
+   SUBROUTINE wrf_gatherv_double (Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+!   USE module_dm
+   IMPLICIT NONE
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+! this next declaration is REAL, not DOUBLE PRECISION because it will be autopromoted
+! to double precision by the compiler when WRF is compiled for 8 byte reals. Only reason
+! for having this separate routine is so we pass the correct MPI type to mpi_scatterv
+! if we were not indexing the globbuf and Field arrays it would not even matter
+   REAL, DIMENSION(*) :: Field, globbuf
+#ifndef STUBMPI
+   INCLUDE 'mpif.h'
+
+           CALL mpi_gatherv( Field( field_ofst ),      &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            MPI_DOUBLE_PRECISION         ,               &    ! sendtype
+                            globbuf( glob_ofst ) ,                 &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            MPI_DOUBLE_PRECISION                       , &    ! recvtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+#endif
+
+   END SUBROUTINE wrf_gatherv_double
+
+   SUBROUTINE wrf_gatherv_integer (Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   IMPLICIT NONE
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   INTEGER, DIMENSION(*) :: Field, globbuf
+#ifndef STUBMPI
+   INCLUDE 'mpif.h'
+
+           CALL mpi_gatherv( Field( field_ofst ),      &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            MPI_INTEGER         ,               &    ! sendtype
+                            globbuf( glob_ofst ) ,                 &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            MPI_INTEGER                       , &    ! recvtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+#endif
+
+   END SUBROUTINE wrf_gatherv_integer
+
+!new stuff 20070124
+   SUBROUTINE wrf_scatterv_real (                             &
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   USE module_dm, ONLY : getrealmpitype
+   IMPLICIT NONE
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   REAL, DIMENSION(*) :: Field, globbuf
+#ifndef STUBMPI
+   INCLUDE 'mpif.h'
+
+           CALL mpi_scatterv(                                &
+                            globbuf( glob_ofst ) ,           &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            getrealmpitype()               , &    ! recvtype
+                            Field( field_ofst ),             &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            getrealmpitype() ,               &    ! sendtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+#endif
+
+   END SUBROUTINE wrf_scatterv_real
+
+   SUBROUTINE wrf_scatterv_double (                           &
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   USE module_dm
+   IMPLICIT NONE
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   REAL, DIMENSION(*) :: Field, globbuf
+#ifndef STUBMPI
+   INCLUDE 'mpif.h'
+! this next declaration is REAL, not DOUBLE PRECISION because it will be autopromoted
+! to double precision by the compiler when WRF is compiled for 8 byte reals. Only reason
+! for having this separate routine is so we pass the correct MPI type to mpi_scatterv
+! if we were not indexing the globbuf and Field arrays it would not even matter
+
+           CALL mpi_scatterv(                                &
+                            globbuf( glob_ofst ) ,           &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            MPI_DOUBLE_PRECISION           , &    ! recvtype
+                            Field( field_ofst ),             &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            MPI_DOUBLE_PRECISION         ,   &    ! sendtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+#endif
+
+   END SUBROUTINE wrf_scatterv_double
+
+   SUBROUTINE wrf_scatterv_integer (                          &
+                                globbuf, glob_ofst ,          &    ! recvbuf
+                                counts                      , &    ! recvcounts
+                                Field, field_ofst,            &
+                                my_count ,                    &    ! sendcount
+                                displs                      , &    ! displs
+                                root                        , &    ! root
+                                communicator                , &    ! communicator
+                                ierr )
+   IMPLICIT NONE
+   INTEGER field_ofst, glob_ofst
+   INTEGER my_count, communicator, root, ierr
+   INTEGER , DIMENSION(*) :: counts, displs
+   INTEGER, DIMENSION(*) :: Field, globbuf
+#ifndef STUBMPI
+   INCLUDE 'mpif.h'
+
+           CALL mpi_scatterv(                                &
+                            globbuf( glob_ofst ) ,           &    ! recvbuf
+                            counts                         , &    ! recvcounts
+                            displs                         , &    ! displs
+                            MPI_INTEGER                    , &    ! recvtype
+                            Field( field_ofst ),             &    ! sendbuf
+                            my_count ,                       &    ! sendcount
+                            MPI_INTEGER         ,            &    ! sendtype
+                            root                           , &    ! root
+                            communicator                   , &    ! communicator
+                            ierr )
+#endif
+
+   END SUBROUTINE wrf_scatterv_integer
+! end new stuff 20070124
+
+SUBROUTINE wrf_dm_define_comms ( grid )
+   USE module_domain, ONLY : domain
+   IMPLICIT NONE
+   TYPE(domain) , INTENT (INOUT) :: grid
+   RETURN
+END SUBROUTINE wrf_dm_define_comms
+
+SUBROUTINE tfp_message( fname, lno )
+   CHARACTER*(*) fname
+   INTEGER lno
+   CHARACTER*1024 mess
+#ifndef STUBMPI
+   WRITE(mess,*)'tfp_message: ',trim(fname),lno
+   CALL wrf_message(mess)
+# ifdef ALLOW_OVERDECOMP
+     CALL task_for_point_message  ! defined in RSL_LITE/task_for_point.c
+# else
+     CALL wrf_error_fatal(mess)
+# endif
+#endif 
+END SUBROUTINE tfp_message
+
+   SUBROUTINE set_dm_debug 
+    USE module_dm
+    IMPLICIT NONE
+    dm_debug_flag = .TRUE.
+   END SUBROUTINE set_dm_debug
+   SUBROUTINE reset_dm_debug 
+    USE module_dm
+    IMPLICIT NONE
+    dm_debug_flag = .FALSE.
+   END SUBROUTINE reset_dm_debug
+   SUBROUTINE get_dm_debug ( arg )
+    USE module_dm
+    IMPLICIT NONE
+    LOGICAL arg
+    arg = dm_debug_flag
+   END SUBROUTINE get_dm_debug
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/external/io_grib_share/wrf_io_flags.h
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/external/io_grib_share/wrf_io_flags.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/external/io_grib_share/wrf_io_flags.h	(revision 2744)
@@ -0,0 +1,1 @@
+link /home/spiga/data/MODELES/MESOSCALE/LMD_MM_MARS/SRC/LES//WRFV2/external/io_grib_share/wrf_io_flags.h
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/external/ioapi_share/wrf_io_flags.h
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/external/ioapi_share/wrf_io_flags.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dble_preci/external/ioapi_share/wrf_io_flags.h	(revision 2744)
@@ -0,0 +1,19 @@
+      integer, parameter  :: WRF_FILE_NOT_OPENED                  = 100
+      integer, parameter  :: WRF_FILE_OPENED_NOT_COMMITTED        = 101
+      integer, parameter  :: WRF_FILE_OPENED_FOR_WRITE            = 102
+      integer, parameter  :: WRF_FILE_OPENED_FOR_READ             = 103
+      integer, parameter  :: WRF_REAL                             = 104
+      integer, parameter  :: WRF_DOUBLE                           = 105
+#if (RWORDSIZE == 8)
+      integer, parameter  :: WRF_FLOAT=WRF_DOUBLE
+#else      
+      integer, parameter  :: WRF_FLOAT=WRF_REAL
+#endif      
+      integer, parameter  :: WRF_INTEGER                          = 106
+      integer, parameter  :: WRF_LOGICAL                          = 107
+      integer, parameter  :: WRF_COMPLEX                          = 108
+      integer, parameter  :: WRF_DOUBLE_COMPLEX                   = 109
+      integer, parameter  :: WRF_FILE_OPENED_FOR_UPDATE           = 110
+! This bit is for backwards compatibility with old variants of these flags 
+! that are still being used in io_grib1 and io_phdf5.  It should be removed!  
+      integer, parameter  :: WRF_FILE_OPENED_AND_COMMITTED        = 102
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_generic_lmd_new
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_generic_lmd_new	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_generic_lmd_new	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/phys/dynphy_wrf_generic_lmd_new/
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_mars_lmd
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_mars_lmd	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_mars_lmd	(revision 2744)
@@ -0,0 +1,1 @@
+link dynphy_wrf_void_lmd_new
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_mars_lmd_new
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_mars_lmd_new	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_mars_lmd_new	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/phys/dynphy_wrf_mars_lmd_new
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_prescribed_void_lmd_new
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_prescribed_void_lmd_new	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_prescribed_void_lmd_new	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/phys/dynphy_wrf_prescribed_void_lmd_new/
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_titan_lmd_new
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_titan_lmd_new	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_titan_lmd_new	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/phys/dynphy_wrf_titan_lmd_new/
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_venus_lmd_new
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_venus_lmd_new	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_venus_lmd_new	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/phys/dynphy_wrf_venus_lmd_new
Index: trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_void_lmd_new
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_void_lmd_new	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/dynphy_wrf_void_lmd_new	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/phys/dynphy_wrf_void_lmd_new/
Index: trunk/WRF.COMMON/WRFV3/modif_mars/getturb.pro
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/getturb.pro	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/getturb.pro	(revision 2744)
@@ -0,0 +1,430 @@
+pro getturb, saveps=saveps
+
+
+
+;----------------------------------
+; USE: getturb
+;      getturb, saveps='false'     
+;----------------------------------
+
+
+history_interval_s = 100.
+smoothampl=3700/history_interval_s
+smoothampl=0.
+
+;
+; constantes
+;
+p0=610. & t0=220. & r_cp=1/4.4 & grav=3.72 & R=192.
+
+;
+; graphics definition
+;
+if (n_elements(saveps) eq 0) then saveps='true'
+if (saveps eq 'false') then begin
+   ;!p.multi=[0,3,2] 
+   !P.CHARSIZE=2.
+   WINDOW, /PIXMAP & WDELETE & DEVICE,BYPASS_TRANSLATION=0,DECOMPOSED=0,RETAIN=2
+endif else begin
+   PREF_SET, 'IDL_PATH', '/home/spiga/Save/SOURCES/IDL/fsc_psconfig:<IDL_DEFAULT>', /COMMIT
+endelse
+
+;
+; retrieve fields
+;
+openr,unit,'getturb.dat',/get_lun,error=err
+IF (err ne 0) THEN BEGIN
+
+;
+; input files
+;
+OPENR, 22, 'input_coord' & READF, 22, lonu & READF, 22, latu & READF, 22, lsu & READF, 22, lctu & CLOSE, 22
+OPENR, 23, 'input_more' & READF, 23, hgtu, tsurfu & CLOSE, 23
+
+;
+; get fields
+;
+domain='d01' & filesWRF = FindFile('wrfout_'+domain+'_????-??-??_??:??:??') & nf=n_elements(filesWRF)
+
+;
+; get dimensions
+;
+id=ncdf_open(filesWRF(0))
+NCDF_DIMINQ, id, NCDF_DIMID(id, 'west_east'    ), toto, nx & NCDF_DIMINQ, id, NCDF_DIMID(id, 'south_north'  ), toto, ny
+NCDF_DIMINQ, id, NCDF_DIMID(id, 'bottom_top'   ), toto, nz & NCDF_DIMINQ, id, NCDF_DIMID(id, 'Time'         ), toto, nt
+NCDF_CLOSE, id 
+
+;
+; prepare loop
+;
+nloop1 = nf-1 & nloop2 = nt & yeye = 0 
+localtime = lctu + history_interval_s*findgen(nloop1*nloop2)/3700.
+wt  = fltarr(nz,nloop1*nloop2) & tke = fltarr(nz,nloop1*nloop2) & ztke = fltarr(nz,nloop1*nloop2) & t = fltarr(nz,nloop1*nloop2)
+p = fltarr(nz) & ph = fltarr(nz) & pht = fltarr(nz,nloop1*nloop2) & pt = fltarr(nz,nloop1*nloop2) & stst = fltarr(nz,nloop1*nloop2)
+
+;
+; loop loop
+;
+for loop  = 0, nloop1-1 do begin
+                                          timetime = SYSTIME(1)
+for loop2 = 0, nloop2-1 do begin
+
+   ; t' = t - <t>
+   ; ------------
+ yeyeye = 1.
+ tprime = getget(filesWRF(loop), 'T', anomaly=yeyeye, count=[0,0,0,1], offset=[0,0,0,loop2])  ;; t' = t - <t>
+ t(*,yeye) = t0 + TEMPORARY(yeyeye)
+   ; w' = w   
+   ; ------
+ wprime  = getget(filesWRF(loop), 'W', count=[0,0,0,1], offset=[0,0,0,loop2])     
+   ; tke = 0.5 ( <u'^2> + <v'^2> + <w'^2> ) ; u' = u ; v' = v  
+   ; --------------------------------------------------------
+ ztke(*,yeye) = 0.5 * TOTAL(TOTAL(wprime^2,1),1) / float(nx) / float(ny)
+ tke(*,yeye) = ztke(*,yeye) + $
+               0.5 * ( $
+        TOTAL(TOTAL(getget(filesWRF(loop), 'U', count=[0,0,0,1], offset=[0,0,0,loop2])^2,1),1) + $  
+        TOTAL(TOTAL(getget(filesWRF(loop), 'V', count=[0,0,0,1], offset=[0,0,0,loop2])^2,1),1)   $  
+        ) / float(nx) / float(ny)  
+   ; <w't'>
+   ; ------
+ wt(*,yeye)  = TOTAL(TOTAL(TEMPORARY(tprime)  * TEMPORARY(wprime),1),1) / float(nx) / float(ny)  
+   ; p & ph
+   ; ------
+ if (loop + loop2 eq 0) then nloopbeware = nloop2-1 else nloopbeware = nloop2  ; 1ere valeur vaut 0
+ pht(*,yeye) = TOTAL(TOTAL(getget(filesWRF(loop), 'PHTOT',  count=[0,0,0,1], offset=[0,0,0,loop2]),1),1) / float(nx) / float(ny) / 1000. / 3.72
+ pt(*,yeye)  = TOTAL(TOTAL(getget(filesWRF(loop), 'PTOT' ,  count=[0,0,0,1], offset=[0,0,0,loop2]),1),1) / float(nx) / float(ny)
+ ph = TEMPORARY(ph) + pht(*,yeye) / nloopbeware / nloop1
+ p  = TEMPORARY(p ) + pt(*,yeye) / nloop2 / nloop1
+   ; static stability
+   ; ----------------
+ stst(*,yeye) = DERIV( reform(pht(*,yeye)) - hgtu/1000. , reform(t(*,yeye)) * ( reform(pt(*,yeye)) /p0 )^r_cp ) + 1000.*grav / (R / r_cp)  ;; 4.9 dans Hinson
+   ; loop count
+   ; ---------
+ yeye = TEMPORARY(yeye) + 1 
+
+endfor
+                                          print, 'file '+string(loop+1,'(I0)'), SYSTIME(1) - timetime, ' s'
+endfor
+h  = TEMPORARY(ph)  - hgtu/1000.  ;; altitude above ground
+ht = TEMPORARY(pht) - hgtu/1000.  
+;
+; save
+;
+save, wt, tke, ztke, h, ht, t, p, pt, stst, localtime, filename='getturb.dat'
+
+ENDIF ELSE BEGIN
+
+print, 'OK, file is here'
+restore, filename='getturb.dat'
+
+ENDELSE
+
+;
+; smooth smooth
+;
+wt  = SMOOTH(TEMPORARY(wt),  [0,smoothampl], /EDGE_TRUNCATE)
+tke = SMOOTH(TEMPORARY(tke), [0,smoothampl], /EDGE_TRUNCATE)
+ztke = SMOOTH(TEMPORARY(ztke), [0,smoothampl], /EDGE_TRUNCATE)
+
+
+;*******************;
+;*******************;
+; PLOTS PLOTS PLOTS ;
+;*******************;
+;*******************;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  transpose(tke) 
+zex           =  localtime 
+zey           =  h
+set_name      =  'TKE.ps'
+set_title     =  "Turbulent Kinetic Energy 0.5[<u'!U2!N>+<v'!U2!N>+<w'!U2!N>] (m!U2!N.s!U-2!N)"
+set_titlex    =  'Local Time (h)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [8.,18.]
+set_yrange    =  [0.,10.]
+set_tickx     =  1.
+set_ticky     =  1.
+minval        =  0.
+maxval        =  20. ;15.
+nlev          =  maxval-minval
+pal           =  22
+rrr           =  'no'
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+;; 0. levels
+lev = minval + (maxval-minval)*findgen(nlev+1)/float(nlev) & if (minval ne 0.) then lev = lev[where(lev ne 0.)]
+;;; 1. background
+loadct, 0 & contour, /NODATA, zefield, zex, zey, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0 
+;; 2. color field
+loadct, pal & if (rrr eq 'yes') then TVLCT, r, g, b, /Get & if (rrr eq 'yes') then TVLCT, Reverse(r), Reverse(g), Reverse(b) 
+            contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /overplot, /cell_fill
+;; 3. contour field
+loadct, 0 & contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /noerase, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, C_LINESTYLE = (lev LT 0.0)
+;; 4. choose output
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  transpose(ztke)
+;zefield       =  100.*transpose(ztke)/transpose(tke) & zefield[where(transpose(tke) lt 1.)]=0.
+zex           =  localtime
+zey           =  h
+set_name      =  'zTKE.ps'
+set_title     =  "Vertical Turbulent Kinetic Energy 0.5[<w'!U2!N>] (m!U2!N.s!U-2!N)"
+set_titlex    =  'Local Time (h)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [8.,18.]
+set_yrange    =  [0.,10.]
+set_tickx     =  1.
+set_ticky     =  1.
+minval        =  0.
+maxval        =  14. ;10.
+nlev          =  maxval-minval
+pal           =  22
+rrr           =  'no'
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+;; 0. levels
+lev = minval + (maxval-minval)*findgen(nlev+1)/float(nlev) & if (minval ne 0.) then lev = lev[where(lev ne 0.)]
+;;; 1. background
+loadct, 0 & contour, /NODATA, zefield, zex, zey, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0
+;; 2. color field
+loadct, pal & if (rrr eq 'yes') then TVLCT, r, g, b, /Get & if (rrr eq 'yes') then TVLCT, Reverse(r), Reverse(g), Reverse(b)
+            contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /overplot, /cell_fill
+;; 3. contour field
+loadct, 0 & contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /noerase, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, C_LINESTYLE = (lev LT 0.0)
+;; 4. choose output
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  transpose(wt)
+zex           =  localtime
+zey           =  h
+set_name      =  'HF.ps'
+set_title     =  "Vertical Eddy Heat Flux <w'!7h!3'> (K.m.s!U-1!N)"
+set_titlex    =  'Local Time (h)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [8.,18.]
+set_yrange    =  [0.,10.]
+set_tickx     =  1.
+set_ticky     =  1.
+minval        =  -2.
+maxval        =  2.
+nlev          =  floor(maxval-minval)*10
+pal           =  33 ;4 
+rrr           =  'no'
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+;; 0. levels
+lev = minval + (maxval-minval)*findgen(nlev+1)/float(nlev) & if (minval ne 0.) then lev = lev[where(lev ne 0.)]
+;;; 1. background
+loadct, 0 & contour, /NODATA, zefield, zex, zey, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0
+;; 2. color field
+loadct, pal & if (rrr eq 'yes') then TVLCT, r, g, b, /Get & if (rrr eq 'yes') then TVLCT, Reverse(r), Reverse(g), Reverse(b)
+            ;;;--------------------------------------------------------------------------------------------------------------------------------
+            ;;; WHITE ZONE - 1. get location of interval in the CT - 2. change the CT to have a white zone
+            ulim=0.09 & dlim=-0.09 & w=where(lev le dlim) & n1=w[n_elements(w)-1] & w=where(lev ge ulim) & n2=w[0] & yy=BYTSCL(lev) & nd=yy[n1] & nu=yy[n2]-5
+            nu = nd + (nu-nd)/2  ;; otherwise the interval is too large (because we removed 0)
+            TVLCT, r, g, b, /Get & r[nd:nu]=255 & g[nd:nu]=255 & b[nd:nu]=255 & TVLCT, r, g, b
+            ;;;--------------------------------------------------------------------------------------------------------------------------------
+            contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /overplot, /cell_fill
+;; 3. contour field
+loadct, 0 & contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /noerase, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, C_LINESTYLE = (lev LT 0.0)
+;; 4. choose output
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  t
+zey           =  ht 
+set_name      =  'T.ps'
+set_title     =  "Potential Temperature (K)"
+set_titlex    =  'Potential Temperature (K)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [min(t),max(t)]
+set_yrange    =  [0.,10.]
+set_tickx     =  5.
+set_ticky     =  1.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+localtimes = [9,10,11,12,13,14,15,16,17,18]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+altlin=0 & loadct, 0
+user_lt=localtimes[0] & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt)))) & nntt = yeah(0)
+plot, zefield(*,nntt), zey(*,nntt), xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, linestyle=altlin
+for ll = 1, n_elements(localtimes)-1 do begin
+  CASE altlin OF
+  0: altlin=1
+  1: altlin=0
+  ENDCASE  
+  user_lt=localtimes[ll] & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt)))) & nntt = yeah(0)
+  if (nntt ne -1) then oplot, zefield(*,nntt), zey(*,nntt), linestyle=altlin
+endfor
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  stst
+zey           =  ht 
+set_name      =  'STST.ps'
+set_title     =  'Static stability (K.m!U-1!N)'
+set_titlex    =  'Static stability (K.m!U-1!N)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [-1.,5.]
+set_yrange    =  [0.,10.]
+set_tickx     =  1.
+set_ticky     =  1.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+localtimes = [9,11,13,15,17]
+localtimes = [17]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+altlin=0 & loadct, 0
+user_lt=localtimes[0] & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt)))) & nntt = yeah(0)
+plot, zefield(*,nntt), zey(*,nntt), xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, linestyle=altlin
+oplot, zefield(*,nntt), zey(*,nntt), psym=5
+for ll = 1, n_elements(localtimes)-1 do begin
+  CASE altlin OF
+  0: altlin=1 
+  1: altlin=0
+  ENDCASE
+  user_lt=localtimes[ll] & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt)))) & nntt = yeah(0)
+  if (nntt ne -1) then oplot, zefield(*,nntt), zey(*,nntt), linestyle=altlin
+  ;if (nntt ne -1) then oplot, zefield(*,nntt), zey(*,nntt), psym=5
+endfor
+oplot, 0.*zefield(*,nntt) + 1.5, zey(*,nntt), linestyle=2  
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+stop
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+goto, no_staticstab
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then begin
+  device, /close
+  set_plot, 'ps' & device, filename='plot/staticstab.ps'
+endif
+
+user_lt=17. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+
+   ;;; recompute height @ given local time 
+   caca=heightp+hgtu/1000.
+   height=reform(ph(*,0,*,*))
+   height=total(height,1)/n_elements(height(*,0,0))
+   height=reform(height)
+   height=reform(height(*,yeah(0)))
+   height=height/1000./3.72
+   heightp=height(0:n_elements(height(*))-2) 
+   print, 'new minus old', heightp - caca
+   ;;; recompute height @ given local time 
+
+        press=reform(p(*,0,*,*))
+        press=total(press,1)/n_elements(press(*,0,0))
+        press=reform(press)
+        press=reform(press(*,yeah(0)))
+        press=press(0:n_elements(press(*))-2)
+
+staticstab = DERIV( heightp , reform(what_I_plot5(*,yeah(0))) ) + 1000.*3.72/844.6  ;; 4.9 dans Hinson
+   staticstab = staticstab(0:n_elements(staticstab)-5)
+   heightp = heightp(0:n_elements(heightp)-5)
+
+plot, $
+        staticstab, $
+        heightp,$
+        xtitle='Static stability (K/km)',$
+        xrange=[-1.,5.], $
+        xtickinterval=0.5, $
+        ytitle='Altitude above surface (km)', $
+        yrange=[min(heightp),max(heightp)], $
+        ytickinterval=1., $
+        title="LMD LES Static stability @ LT 17h (K/km)", $
+        subtitle='zonal average at lat. '+latwrite
+oplot, $
+        staticstab, $
+        heightp,$
+        psym=5
+oplot, $
+       findgen(n_elements(heightp))*0. + 1.,$
+       heightp,$
+       linestyle=2
+oplot, $
+       findgen(n_elements(heightp))*0. + 2.,$
+       heightp,$
+       linestyle=2
+
+;;;;;;;;;;
+w = where((staticstab gt 1.5) and ((heightp- hgtu/1000.) gt 1.))
+t_top_plus = what_I_plot5(w(0),yeah(0))
+z_top_plus = heightp(w(0))
+p_top_plus = press(w(0))
+t_top_moins = what_I_plot5(w(0)-1,yeah(0))
+z_top_moins = heightp(w(0)-1)
+p_top_moins = press(w(0)-1)
+pbl_depth = (z_top_plus*alog(p_top_plus) + z_top_moins*alog(p_top_moins))/(alog(p_top_plus) + alog(p_top_moins)) - hgtu/1000.
+xyouts, 3., 1.5 + (max(heightp) + min(heightp)) / 3., 'Ls = '+string(lsu,'(F5.1)')+'!Uo!N', CHARSIZE=1
+xyouts, 3., 1. + (max(heightp) + min(heightp)) / 3., 'Lat = '+string(latu,'(F5.1)')+'!Uo!N', CHARSIZE=1
+xyouts, 3., 0.5 + (max(heightp) + min(heightp)) / 3., 'LonE = '+string(lonu,'(F6.1)')+'!Uo!N', CHARSIZE=1
+xyouts, 3., (max(heightp) + min(heightp)) / 3., 'T!Dt!N = '+string(t_top_plus,'(I0)')+'/'+string(t_top_moins,'(I0)')+' K ', CHARSIZE=1
+xyouts, 3., -0.5 + (max(heightp) + min(heightp)) / 3., 'p!Dt!N = '+string(p_top_plus,'(I0)')+'/'+string(p_top_moins,'(I0)')+' Pa', CHARSIZE=1
+xyouts, 3., -1. + (max(heightp) + min(heightp)) / 3., 'z!Dt!N = '+string(z_top_plus,'(F4.1)')+'/'+string(z_top_moins,'(F4.1)')+' km', CHARSIZE=1
+xyouts, 3., -1.5 + (max(heightp) + min(heightp)) / 3., 'z!Ds!N = '+string(hgtu/1000.,'(F4.1)')+' km', CHARSIZE=1
+xyouts, 3., -2. + (max(heightp) + min(heightp)) / 3., 'D = '+string(pbl_depth,'(F4.1)')+' km', CHARSIZE=1
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+no_staticstab:
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then begin
+  device, /close
+endif
+stop
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+user_lt=13.
+yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+
+user_h=0.1
+walt=where(abs(heightp-user_h) eq (min(abs(heightp-user_h))))
+
+;mapfield=reform(t[*,*,walt(0),w(0)])
+;help, mapfield
+;contour, mapfield
+
+section=reform(w[*,0,*,yeah(0)])
+
+section=reform(w[*,0,*,160])
+
+lev=[-12.,-8.,-4.,4.,8.,12.]
+lev=[-5.,-4.,-3.,-2.,-1.,1.,2.,3.,4.,5.]
+contour, $
+	section, $
+	(lon(*,0)-lon(0,0))*59., $
+	heightp, $
+	levels=lev , $
+	C_LINESTYLE = (lev LT 0.0)
+
+device, /close
+
+end
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/input_vert
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/input_vert	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/input_vert	(revision 2744)
@@ -0,0 +1,2 @@
+3. 0.4
+delt z_scale
Index: trunk/WRF.COMMON/WRFV3/modif_mars/launch
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/launch	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/launch	(revision 2744)
@@ -0,0 +1,43 @@
+#PBS -S  /bin/bash
+#PBS -j  oe
+#PBS -q  infini
+#PBS -N  EXOMARS 
+#PBS -l "nodes=1:ppn=8"
+##PBS -l "nodes=4:ppn=4"
+##PBS -l "nodes=2:ppn=4"
+##PBS -l "nodes=1:ppn=12"
+
+##PBS -l walltime=10:30,mem=320kb
+
+######## openMP threads
+#cat $PBS_NODEFILE | sort | uniq > /tmp/coucou
+#cat /tmp/coucou
+#declare -x OMP_NUM_THREADS=4
+
+#declare -x MP_STACK_SIZE=64000000
+
+####### prep run
+cd $PBS_O_WORKDIR
+\rm  *rsl.* 2>  /dev/null
+\rm  wrfo*  2>  /dev/null
+\rm  wrfi*  2>  /dev/null
+./ideal.exe
+mv rsl.out.0000 ideal_rsl.out.0000
+
+####### run
+#mpirun yeye
+mpirun wrf.exe
+
+
+################
+
+###PBS -l "nodes=2:ppn=8"
+
+#declare -x OMP_NUM_THREADS=4
+#declare -x MP_STACK_SIZE=64000000
+
+#mpirun wrf.exe 
+
+####PBS -m ae
+####PBS -M spiga@lmd.jussieu.fr
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/les_save_this_simu
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/les_save_this_simu	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/les_save_this_simu	(revision 2744)
@@ -0,0 +1,63 @@
+#! /bin/bash
+
+\rm simtime 2> /dev/null
+
+mkdir results
+
+if [[ -f extract_turb ]]
+then
+
+  #./extract_turb
+  mv *.nc results/
+
+fi
+
+if [[ -d plot ]]
+then
+
+  mv plot results/
+  mv getcdf.pro results/
+  mv turbulence.pro results/
+  \rm turbulence.dat 2> /dev/null   
+
+fi
+
+if [[ -f rsl.error.0000 ]]
+then
+
+  timesec=$(more rsl.error.0000 | grep elapsed | grep 'Timing for main' | awk '{s+=$9} END{print s}')
+  touch simtime
+  echo ${timesec} seconds
+  echo ${timesec} seconds >> simtime
+
+  head -10000 rsl.out.0000 > red_rsl.out.0000
+  head -4000 rsl.error.0000 > red_rsl.error.0000
+  mv red_rsl.* results/
+  mv ideal_rsl.out.0000 results/
+  mv simtime results/
+
+else
+
+  timesec=$(more log_wrf | grep elapsed | grep 'Timing for main' | awk '{s+=$9} END{print s}')
+  touch simtime
+  echo ${timesec} seconds
+  echo ${timesec} seconds >> simtime
+
+  head -10000 log_wrf > red_log_wrf
+  mv red_log_wrf results/
+  mv simtime results/  
+  mv met_em/log_real results/
+
+fi
+
+tar czvf def.tar.gz namelist.input *.def input_* launch 
+cp def.tar.gz results/ 
+
+mv wrfout* results/
+mv namelist.output results/
+ls -lh results
+du -bh results
+echo '*****************************************************'
+echo '*** BEWARE ! *** output files were moved in the folder named results !!!'
+echo 'what you may keep: results folder and def.tar.gz file'
+echo '*****************************************************'
Index: trunk/WRF.COMMON/WRFV3/modif_mars/makeles
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/makeles	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/makeles	(revision 2744)
@@ -0,0 +1,176 @@
+#! /bin/bash
+
+#------------------------------
+# makeles
+#------------------------------
+#     MMM must be defined
+#------------------------------
+# A. Spiga 01/2009
+#------------------------------
+
+
+echo "Use -n if you don't want to recompile physics"
+echo "Use -p if you want the new LMD physics"
+
+#
+# SPECIAL CICLAD
+#
+
+donotcompilephys=0
+phys=""
+while getopts "np" options; do
+  case $options in
+   n ) donotcompilephys=1;; ## do not recompile physics
+   p ) phys="newphys_";;    ## with new physics
+  esac
+done
+
+#
+# LOCATIONS
+#
+here=$PWD
+whereliblmd=$here
+
+
+##############################################################
+##############################################################
+if [ ${donotcompilephys} -eq 0 ]
+then
+
+#
+# COMPILE PHYSICS
+#
+cd $MMM
+  if [[ "${phys}" == "newphys_" ]]
+  then
+    makemeso -j -p
+  else
+    makemeso -j
+  fi 
+#
+#makemeso -rd < last > /dev/null
+folder=$PWD'/'$(more what_folder)'/WRFV2/'
+libphys_folder=$folder'mars_lmd/libo/'
+phymars_folder=$folder'mars_lmd/libf/phymars/'
+\rm what_folder 2> /dev/null
+
+#
+# GET liblmd GENERATED LIBRARY and INCLUDEs
+#
+echo $libphys_folder
+cp -rf ${libphys_folder}/liblmd.a ${whereliblmd}/
+#cp -rf ${phymars_folder}/dimphys.h ${here}/modif_mars/
+cp -rf ${phymars_folder}/dimphys.h ${here}/mars_lmd/libf/phymars/
+#cp -rf ${folder}/call_meso_inifis.inc ${here}/modif_mars/
+#cp -rf ${folder}/call_meso_physiq.inc ${here}/modif_mars/
+cp -rf ${folder}/call_meso_inifis.inc ${here}/
+cp -rf ${folder}/call_meso_physiq.inc ${here}/
+#cp -rf ${folder}/inc/module_lmd_driver_output*.inc ${here}/modif_mars/
+cp -rf ${folder}/inc/module_lmd_driver_output*.inc ${here}/inc/
+#cp -rf ${phymars_folder}/wrf_output_2d.h ${here}/modif_mars/
+#cp -rf ${phymars_folder}/wrf_output_3d.h ${here}/modif_mars/
+cp -rf ${phymars_folder}/wrf_output_2d.h ${here}/mars_lmd/libf/phymars/
+cp -rf ${phymars_folder}/wrf_output_3d.h ${here}/mars_lmd/libf/phymars/
+fi
+##############################################################
+##############################################################
+
+
+cd $here
+
+##------------------------------
+##------------------------------
+##
+## MPI (dm) 64 bits 
+##
+##TODO: le rendre adapte aux reponses du user a makemeso
+touch conf
+echo 3 >> conf 
+##echo 4 >> conf  #openMP n'arrange pas beaucoup de le tps de calcul
+echo 1 >> conf
+##------------------------------
+##------------------------------
+
+
+
+### SINGLE PROC 32 bits g95
+#touch conf
+#echo 5 >> conf
+#echo 0 >> conf
+
+## SINGLE PROC 64 bits
+#touch conf
+#echo 1 >> conf
+#echo 0 >> conf
+
+### MPI (dm) 64 bits IFORT
+#echo IFORT IFORT IFORT IFORT
+#touch conf
+#echo 7 >> conf
+#echo 1 >> conf
+
+
+#
+# CONFIGURE
+#
+echo "configure..."
+#touch configure.wrf
+\rm configure.wrf
+./configure < conf > /dev/null 2> /dev/null
+#./configure 
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+'mpif90 -f90=$(SFC)'+'/usr/lib64/openmpi/1.2.8-pgf/bin/mpif90'+g | sed s+'mpicc -cc=$(SCC)'+'/usr/lib64/openmpi/1.2.8-gcc/bin/mpicc -DMPI2_SUPPORT'+g > yeah
+## WHERE_MPI must be defined
+sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+"mpif90"+"$WHERE_MPI/mpif90"+g | sed s+"mpicc"+"$WHERE_MPI/mpicc -DMPI2_SUPPORT"+g > yeah
+#sed s+"# -g"+"-fno-second-underscore # -g"+g configure.wrf | sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g > yeah
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+"#-g"+"-g"+g > yeah
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf > yeah
+mv yeah configure.wrf
+
+	####
+	#### provoque des seg faults....
+	####
+	#sed s+"-fastsse"+"-fastsse -mcmodel=medium -Mlarge_arrays"+g configure.wrf > yeah
+	#### TEST TEST
+	#mv yeah configure.wrf
+
+sed s+"-fastsse"+" "+g configure.wrf > yeah
+#sed s+"-fastsse"+"-mcmodel=medium -Mlarge_arrays"+g configure.wrf > yeah ##marche pas
+#
+# sometimes fastsse is problematic
+#
+
+##sed s+"-fastsse"+"-fastsse -mcmodel=medium"+g configure.wrf > yeah
+mv yeah configure.wrf
+
+#sed s+"-Mvect=noaltcode"+"#-Mvect=noaltcode"+g configure.wrf > yeah ; mv yeah configure.wrf
+
+#sed s+"-mp -Minfo=mp"+"-mp -Minfo=mp -mp=nonuma"+g configure.wrf > yeah
+#mv yeah configure.wrf
+
+#### OBLIGATOIRE POUR IFORT, OK AVEC LES AUTRES ??? a priori oui
+sed s+"-llmd"+"-llmd $NETCDF/lib/libnetcdf.a"+g configure.wrf > yeah
+mv yeah configure.wrf
+
+#############################################################
+  if [[ "${phys}" == "newphys_" ]]
+  then
+     sed s+"ARCH_LOCAL      =       "+"ARCH_LOCAL      =       -DNEWPHYS "+g configure.wrf > yeah
+     mv -f yeah configure.wrf
+  fi
+#############################################################
+
+
+\rm conf
+
+#
+# COMPILE LES TEST CASE w/ LMD PHYSICS
+#
+touch modif_mars/module_lmd_driver.F
+\rm log_compile
+\rm log_error
+echo "compile LES WRF with LMD Mars physics... look log_compile and log_error"
+compile em_les > log_compile 2> log_error
+
+echo '***********************************'
+tail -n 20 log_error
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/makeles_ciclad
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/makeles_ciclad	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/makeles_ciclad	(revision 2744)
@@ -0,0 +1,180 @@
+#! /bin/bash
+
+#------------------------------
+# makeles
+#------------------------------
+#     MMM must be defined
+#------------------------------
+# A. Spiga 01/2009
+#------------------------------
+
+
+echo "Use -n if you don't want to recompile physics"
+echo "Use -p if you want the new LMD physics"
+
+#
+# SPECIAL CICLAD
+#
+
+donotcompilephys=0
+phys=""
+while getopts "np" options; do
+  case $options in
+   n ) donotcompilephys=1;; ## do not recompile physics
+   p ) phys="newphys_";;    ## with new physics
+  esac
+done
+
+#
+# LOCATIONS
+#
+here=$PWD
+whereliblmd=$here
+
+
+##############################################################
+##############################################################
+if [ ${donotcompilephys} -eq 0 ]
+then
+
+#
+# COMPILE PHYSICS
+#
+cd $MMM
+  if [[ "${phys}" == "newphys_" ]]
+  then
+    makemeso -j -p
+  else
+    makemeso -j
+  fi 
+#
+#makemeso -rd < last > /dev/null
+folder=$PWD'/'$(more what_folder)'/WRFV2/'
+libphys_folder=$folder'mars_lmd/libo/'
+phymars_folder=$folder'mars_lmd/libf/phymars/'
+\rm what_folder 2> /dev/null
+
+#
+# GET liblmd GENERATED LIBRARY and INCLUDEs
+#
+echo $libphys_folder
+cp -rf ${libphys_folder}/liblmd.a ${whereliblmd}/
+#cp -rf ${phymars_folder}/dimphys.h ${here}/modif_mars/
+cp -rf ${phymars_folder}/dimphys.h ${here}/mars_lmd/libf/phymars/
+#cp -rf ${folder}/call_meso_inifis.inc ${here}/modif_mars/
+#cp -rf ${folder}/call_meso_physiq.inc ${here}/modif_mars/
+cp -rf ${folder}/call_meso_inifis.inc ${here}/
+cp -rf ${folder}/call_meso_physiq.inc ${here}/
+#cp -rf ${folder}/inc/module_lmd_driver_output*.inc ${here}/modif_mars/
+cp -rf ${folder}/inc/module_lmd_driver_output*.inc ${here}/inc/
+#cp -rf ${phymars_folder}/wrf_output_2d.h ${here}/modif_mars/
+#cp -rf ${phymars_folder}/wrf_output_3d.h ${here}/modif_mars/
+cp -rf ${phymars_folder}/wrf_output_2d.h ${here}/mars_lmd/libf/phymars/
+cp -rf ${phymars_folder}/wrf_output_3d.h ${here}/mars_lmd/libf/phymars/
+fi
+##############################################################
+##############################################################
+
+
+cd $here
+
+##------------------------------
+##------------------------------
+##
+## MPI (dm) 64 bits 
+##
+##TODO: le rendre adapte aux reponses du user a makemeso
+touch conf
+echo 3 >> conf 
+##echo 4 >> conf  #openMP n'arrange pas beaucoup de le tps de calcul
+echo 1 >> conf
+##------------------------------
+##------------------------------
+
+
+
+### SINGLE PROC 32 bits g95
+#touch conf
+#echo 5 >> conf
+#echo 0 >> conf
+
+## SINGLE PROC 64 bits
+#touch conf
+#echo 1 >> conf
+#echo 0 >> conf
+
+### MPI (dm) 64 bits IFORT
+#echo IFORT IFORT IFORT IFORT
+#touch conf
+#echo 7 >> conf
+#echo 1 >> conf
+
+
+#
+# CONFIGURE
+#
+echo "configure..."
+#touch configure.wrf
+\rm configure.wrf
+./configure < conf > /dev/null 2> /dev/null
+#./configure 
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+'mpif90 -f90=$(SFC)'+'/usr/lib64/openmpi/1.2.8-pgf/bin/mpif90'+g | sed s+'mpicc -cc=$(SCC)'+'/usr/lib64/openmpi/1.2.8-gcc/bin/mpicc -DMPI2_SUPPORT'+g > yeah
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+'mpif90 -f90=$(SFC)'+'/usr/lib64/openmpi/1.2.8-pgf/bin/mpif90'+g | sed s+'mpicc -cc=$(SCC)'+'/usr/lib64/openmpi/1.2.8-pgf/bin/mpicc -DMPI2_SUPPORT'+g > yeah
+   ##### NEW NEW NEW NEW
+   #sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+'mpif90 -f90=$(SFC)'+'/usr/lib64/openmpi/1.4.2-pgf/bin/mpif90'+g | sed s+'mpicc -cc=$(SCC)'+'/usr/lib64/openmpi/1.4.2-gfortran/bin/mpicc -DMPI2_SUPPORT'+g > yeah
+   sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+'mpif90 -f90=$(SFC)'+'/usr/lib64/openmpi/1.4.3-pgfgcc/bin/mpif90'+g | sed s+'mpicc -cc=$(SCC)'+'/usr/lib64/openmpi/1.4.3-pgfgcc/bin/mpicc -DMPI2_SUPPORT'+g > yeah
+#sed s+"# -g"+"-fno-second-underscore # -g"+g configure.wrf | sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g > yeah
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+"#-g"+"-g"+g > yeah
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf > yeah
+mv yeah configure.wrf
+
+	####
+	#### provoque des seg faults....
+	####
+	#sed s+"-fastsse"+"-fastsse -mcmodel=medium -Mlarge_arrays"+g configure.wrf > yeah
+	#### TEST TEST
+	#mv yeah configure.wrf
+
+sed s+"-fastsse"+" "+g configure.wrf > yeah
+#sed s+"-fastsse"+"-mcmodel=medium -Mlarge_arrays"+g configure.wrf > yeah ##marche pas
+#
+# sometimes fastsse is problematic
+#
+
+##sed s+"-fastsse"+"-fastsse -mcmodel=medium"+g configure.wrf > yeah
+mv yeah configure.wrf
+
+#sed s+"-Mvect=noaltcode"+"#-Mvect=noaltcode"+g configure.wrf > yeah ; mv yeah configure.wrf
+
+#sed s+"-mp -Minfo=mp"+"-mp -Minfo=mp -mp=nonuma"+g configure.wrf > yeah
+#mv yeah configure.wrf
+
+#### OBLIGATOIRE POUR IFORT, OK AVEC LES AUTRES ??? a priori oui
+sed s+"-llmd"+"-llmd $NETCDF/lib/libnetcdf.a"+g configure.wrf > yeah
+mv yeah configure.wrf
+
+#############################################################
+  if [[ "${phys}" == "newphys_" ]]
+  then
+     sed s+"ARCH_LOCAL      =       "+"ARCH_LOCAL      =       -DNEWPHYS "+g configure.wrf > yeah
+     mv -f yeah configure.wrf
+     #touch modif_mars/module_model_constants.F
+     #touch modif_mars/module_first_rk_step_part1.F
+  fi
+#############################################################
+
+
+\rm conf
+
+#
+# COMPILE LES TEST CASE w/ LMD PHYSICS
+#
+touch modif_mars/module_lmd_driver.F
+\rm log_compile
+\rm log_error
+echo "compile LES WRF with LMD Mars physics... look log_compile and log_error"
+compile em_les > log_compile 2> log_error
+
+echo '***********************************'
+tail -n 20 log_error
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/makeles_gnome
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/makeles_gnome	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/makeles_gnome	(revision 2744)
@@ -0,0 +1,176 @@
+#! /bin/bash
+
+#------------------------------
+# makeles
+#------------------------------
+#     MMM must be defined
+#------------------------------
+# A. Spiga 01/2009
+#------------------------------
+
+
+echo "Use -n if you don't want to recompile physics"
+echo "Use -p if you want the new LMD physics"
+
+#
+# SPECIAL CICLAD
+#
+
+donotcompilephys=0
+phys=""
+while getopts "np" options; do
+  case $options in
+   n ) donotcompilephys=1;; ## do not recompile physics
+   p ) phys="newphys_";;    ## with new physics
+  esac
+done
+
+#
+# LOCATIONS
+#
+here=$PWD
+whereliblmd=$here
+
+
+##############################################################
+##############################################################
+if [ ${donotcompilephys} -eq 0 ]
+then
+
+#
+# COMPILE PHYSICS
+#
+cd $MMM
+  if [[ "${phys}" == "newphys_" ]]
+  then
+    makemeso -j -p
+  else
+    makemeso -j
+  fi 
+#
+#makemeso -rd < last > /dev/null
+folder=$PWD'/'$(more what_folder)'/WRFV2/'
+libphys_folder=$folder'mars_lmd/libo/'
+phymars_folder=$folder'mars_lmd/libf/phymars/'
+\rm what_folder 2> /dev/null
+
+#
+# GET liblmd GENERATED LIBRARY and INCLUDEs
+#
+echo $libphys_folder
+cp -rf ${libphys_folder}/liblmd.a ${whereliblmd}/
+#cp -rf ${phymars_folder}/dimphys.h ${here}/modif_mars/
+cp -rf ${phymars_folder}/dimphys.h ${here}/mars_lmd/libf/phymars/
+#cp -rf ${folder}/call_meso_inifis.inc ${here}/modif_mars/
+#cp -rf ${folder}/call_meso_physiq.inc ${here}/modif_mars/
+cp -rf ${folder}/call_meso_inifis.inc ${here}/
+cp -rf ${folder}/call_meso_physiq.inc ${here}/
+#cp -rf ${folder}/inc/module_lmd_driver_output*.inc ${here}/modif_mars/
+cp -rf ${folder}/inc/module_lmd_driver_output*.inc ${here}/inc/
+#cp -rf ${phymars_folder}/wrf_output_2d.h ${here}/modif_mars/
+#cp -rf ${phymars_folder}/wrf_output_3d.h ${here}/modif_mars/
+cp -rf ${phymars_folder}/wrf_output_2d.h ${here}/mars_lmd/libf/phymars/
+cp -rf ${phymars_folder}/wrf_output_3d.h ${here}/mars_lmd/libf/phymars/
+fi
+##############################################################
+##############################################################
+
+
+cd $here
+
+###------------------------------
+###------------------------------
+###
+### MPI (dm) 64 bits 
+###
+###TODO: le rendre adapte aux reponses du user a makemeso
+#touch conf
+#echo 3 >> conf 
+###echo 4 >> conf  #openMP n'arrange pas beaucoup de le tps de calcul
+#echo 1 >> conf
+###------------------------------
+###------------------------------
+
+
+
+### SINGLE PROC 32 bits g95
+#touch conf
+#echo 5 >> conf
+#echo 0 >> conf
+
+## SINGLE PROC 64 bits
+#touch conf
+#echo 1 >> conf
+#echo 0 >> conf
+
+### MPI (dm) 64 bits IFORT
+echo IFORT IFORT IFORT IFORT
+touch conf
+echo 7 >> conf
+echo 1 >> conf
+
+
+#
+# CONFIGURE
+#
+echo "configure..."
+#touch configure.wrf
+\rm configure.wrf
+./configure < conf > /dev/null 2> /dev/null
+#./configure 
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+'mpif90 -f90=$(SFC)'+'/usr/lib64/openmpi/1.2.8-pgf/bin/mpif90'+g | sed s+'mpicc -cc=$(SCC)'+'/usr/lib64/openmpi/1.2.8-gcc/bin/mpicc -DMPI2_SUPPORT'+g > yeah
+## WHERE_MPI must be defined
+sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+"mpif90"+"$WHERE_MPI/mpif90"+g | sed s+"mpicc"+"$WHERE_MPI/mpicc -DMPI2_SUPPORT"+g > yeah
+#sed s+"# -g"+"-fno-second-underscore # -g"+g configure.wrf | sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g > yeah
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf | sed s+"#-g"+"-g"+g > yeah
+#sed s+"-lnetcdf"+"-lnetcdf -L$whereliblmd -llmd"+g configure.wrf > yeah
+mv yeah configure.wrf
+
+	####
+	#### provoque des seg faults....
+	####
+	#sed s+"-fastsse"+"-fastsse -mcmodel=medium -Mlarge_arrays"+g configure.wrf > yeah
+	#### TEST TEST
+	#mv yeah configure.wrf
+
+sed s+"-fastsse"+" "+g configure.wrf > yeah
+#sed s+"-fastsse"+"-mcmodel=medium -Mlarge_arrays"+g configure.wrf > yeah ##marche pas
+#
+# sometimes fastsse is problematic
+#
+
+##sed s+"-fastsse"+"-fastsse -mcmodel=medium"+g configure.wrf > yeah
+mv yeah configure.wrf
+
+#sed s+"-Mvect=noaltcode"+"#-Mvect=noaltcode"+g configure.wrf > yeah ; mv yeah configure.wrf
+
+#sed s+"-mp -Minfo=mp"+"-mp -Minfo=mp -mp=nonuma"+g configure.wrf > yeah
+#mv yeah configure.wrf
+
+#### OBLIGATOIRE POUR IFORT, OK AVEC LES AUTRES ??? a priori oui
+sed s+"-llmd"+"-llmd $NETCDF/lib/libnetcdf.a"+g configure.wrf > yeah
+mv yeah configure.wrf
+
+#############################################################
+  if [[ "${phys}" == "newphys_" ]]
+  then
+     sed s+"ARCH_LOCAL      =       "+"ARCH_LOCAL      =       -DNEWPHYS "+g configure.wrf > yeah
+     mv -f yeah configure.wrf
+  fi
+#############################################################
+
+
+\rm conf
+
+#
+# COMPILE LES TEST CASE w/ LMD PHYSICS
+#
+touch modif_mars/module_lmd_driver.F
+\rm log_compile
+\rm log_error
+echo "compile LES WRF with LMD Mars physics... look log_compile and log_error"
+compile em_les > log_compile 2> log_error
+
+echo '***********************************'
+tail -n 20 log_error
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_big_step_utilities_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_big_step_utilities_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_big_step_utilities_em.F	(revision 2744)
@@ -0,0 +1,5606 @@
+!wrf:MODEL_LAYER:DYNAMICS
+!
+
+#if (RWORDSIZE == 4)
+#   define VPOWX vspowx
+#   define VPOW  vspow
+#else
+#   define VPOWX vpowx
+#   define VPOW  vpow
+#endif
+
+
+MODULE module_big_step_utilities_em
+
+   USE module_domain, ONLY : domain
+   USE module_model_constants
+   USE module_state_description
+   USE module_configure, ONLY : grid_config_rec_type
+   USE module_wrf_error
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE calc_mu_uv ( config_flags,                 &
+                        mu, mub, muu, muv,            &
+                        ids, ide, jds, jde, kds, kde, &
+                        ims, ime, jms, jme, kms, kme, &
+                        its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(  OUT) :: muu, muv
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu, mub
+
+   !  local stuff
+
+   INTEGER :: i, j, itf, jtf, im, jm
+
+!<DESCRIPTION>
+!
+!  calc_mu_uv calculates the full column dry-air mass at the staggered
+!  horizontal velocity points (u,v) and places the results in muu and muv.
+!  This routine uses the reference state (mub) and perturbation state (mu)
+!
+!</DESCRIPTION>
+
+
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      IF      ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         im = its
+         if(config_flags%periodic_x) im = its-1
+         DO j=jts,jtf
+!            muu(i,j) =      mu(i,j)          +mub(i,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+            muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j))
+         ENDDO
+      ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=ite
+         im = ite-1
+         if(config_flags%periodic_x) im = ite
+         DO j=jts,jtf
+!            muu(i,j) =      mu(i-1,j)        +mub(i-1,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+            muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j))
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         im = its
+         if(config_flags%periodic_x) im = its-1
+         DO j=jts,jtf
+!            muu(i,j) =      mu(i,j)          +mub(i,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+            muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j))
+         ENDDO
+         i=ite
+         im = ite-1
+         if(config_flags%periodic_x) im = ite
+         DO j=jts,jtf
+!            muu(i,j) =      mu(i-1,j)        +mub(i-1,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+            muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j))
+         ENDDO
+      END IF
+
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      IF      ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts+1,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         jm = jts
+         if(config_flags%periodic_y) jm = jts-1
+         DO i=its,itf
+!             muv(i,j) =      mu(i,j)          +mub(i,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm))
+         ENDDO
+      ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jte
+         jm = jte-1
+         if(config_flags%periodic_y) jm = jte
+         DO i=its,itf
+             muv(i,j) =      mu(i,j-1)        +mub(i,j-1)
+!  fix for periodic b.c., 13 march 2004, wcs
+             muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm))
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts+1,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         jm = jts
+         if(config_flags%periodic_y) jm = jts-1
+         DO i=its,itf
+!             muv(i,j) =      mu(i,j)          +mub(i,j)
+!  fix for periodic b.c., 13 march 2004, wcs
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm))
+         ENDDO
+         j=jte
+         jm = jte-1
+         if(config_flags%periodic_y) jm = jte
+         DO i=its,itf
+!             muv(i,j) =      mu(i,j-1)        +mub(i,j-1)
+!  fix for periodic b.c., 13 march 2004, wcs
+             muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm))
+         ENDDO
+      END IF
+
+END SUBROUTINE calc_mu_uv
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE calc_mu_uv_1 ( config_flags,                 &
+                          mu, muu, muv,                 &
+                          ids, ide, jds, jde, kds, kde, &
+                          ims, ime, jms, jme, kms, kme, &
+                          its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(  OUT) :: muu, muv
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu
+
+   !  local stuff
+
+   INTEGER :: i, j, itf, jtf, im, jm
+
+!<DESCRIPTION>
+!
+!  calc_mu_uv calculates the full column dry-air mass at the staggered
+!  horizontal velocity points (u,v) and places the results in muu and muv.
+!  This routine uses the full state (mu)
+!
+!</DESCRIPTION>
+   
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      IF      ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         im = its
+         if(config_flags%periodic_x) im = its-1
+         DO j=jts,jtf
+            muu(i,j) = 0.5*(mu(i,j)+mu(im,j))
+         ENDDO
+      ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
+         ENDDO
+         ENDDO
+         i=ite
+         im = ite-1
+         if(config_flags%periodic_x) im = ite
+         DO j=jts,jtf
+            muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j))
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         im = its
+         if(config_flags%periodic_x) im = its-1
+         DO j=jts,jtf
+            muu(i,j) = 0.5*(mu(i,j)+mu(im,j))
+         ENDDO
+         i=ite
+         im = ite-1
+         if(config_flags%periodic_x) im = ite
+         DO j=jts,jtf
+            muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j))
+         ENDDO
+      END IF
+
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      IF      ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts+1,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         jm = jts
+         if(config_flags%periodic_y) jm = jts-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,jm))
+         ENDDO
+      ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
+         ENDDO
+         ENDDO
+         j=jte
+         jm = jte-1
+         if(config_flags%periodic_y) jm = jte
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm))
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts+1,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         jm = jts
+         if(config_flags%periodic_y) jm = jts-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,jm))
+         ENDDO
+         j=jte
+         jm = jte-1
+         if(config_flags%periodic_y) jm = jte
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm))
+         ENDDO
+      END IF
+
+END SUBROUTINE calc_mu_uv_1
+
+!-------------------------------------------------------------------------------
+
+! Map scale factor comments for this routine:
+! Locally not changed, but sent the correct map scale factors
+! from module_em (msfuy, msfvx, msfty)
+
+SUBROUTINE couple_momentum ( muu, ru, u, msfu,              &
+                             muv, rv, v, msfv, msfv_inv,    &
+                             mut, rw, w, msft,              &
+                             ids, ide, jds, jde, kds, kde,  &
+                             ims, ime, jms, jme, kms, kme,  &
+                             its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+   INTEGER ,             INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                          ims, ime, jms, jme, kms, kme, &
+                                          its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(  OUT) :: ru, rv, rw
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: muu, muv, mut
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: msfu, msfv, msft, msfv_inv
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: u, v, w
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   
+!<DESCRIPTION>
+!
+! couple_momentum couples the velocities to the full column mass and
+! the map factors.
+!
+!</DESCRIPTION>
+
+   ktf=MIN(kte,kde-1)
+   
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         ru(i,k,j)=u(i,k,j)*muu(i,j)/msfu(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+           rv(i,k,j)=v(i,k,j)*muv(i,j)*msfv_inv(i,j)
+!           rv(i,k,j)=v(i,k,j)*muv(i,j)/msfv(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+
+      DO j=jts,jtf
+      DO k=kts,kte
+      DO i=its,itf
+         rw(i,k,j)=w(i,k,j)*mut(i,j)/msft(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE couple_momentum
+
+!-------------------------------------------------------------------
+
+SUBROUTINE calc_mu_staggered ( mu, mub, muu, muv,            &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(  OUT) :: muu, muv
+   REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu, mub
+
+   !  local stuff
+
+   INTEGER :: i, j, itf, jtf
+
+!<DESCRIPTION>
+!
+! calc_mu_staggered calculates the full dry air mass at the staggered
+! velocity points (u,v).
+!
+!</DESCRIPTION>
+   
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      IF      ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         DO j=jts,jtf
+            muu(i,j) =      mu(i,j)          +mub(i,j)
+         ENDDO
+      ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=ite
+         DO j=jts,jtf
+            muu(i,j) =      mu(i-1,j)        +mub(i-1,j)
+         ENDDO
+      ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN
+         DO j=jts,jtf
+         DO i=its+1,itf-1
+            muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
+         ENDDO
+         ENDDO
+         i=its
+         DO j=jts,jtf
+            muu(i,j) =      mu(i,j)          +mub(i,j)
+         ENDDO
+         i=ite
+         DO j=jts,jtf
+            muu(i,j) =      mu(i-1,j)        +mub(i-1,j)
+         ENDDO
+      END IF
+
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      IF      ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN
+         DO j=jts+1,jtf
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         DO i=its,itf
+             muv(i,j) =      mu(i,j)          +mub(i,j)
+         ENDDO
+      ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jte
+         DO i=its,itf
+             muv(i,j) =      mu(i,j-1)        +mub(i,j-1)
+         ENDDO
+      ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN
+         DO j=jts+1,jtf-1
+         DO i=its,itf
+             muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
+         ENDDO
+         ENDDO
+         j=jts
+         DO i=its,itf
+             muv(i,j) =      mu(i,j)          +mub(i,j)
+         ENDDO
+         j=jte
+         DO i=its,itf
+             muv(i,j) =      mu(i,j-1)        +mub(i,j-1)
+         ENDDO
+      END IF
+
+END SUBROUTINE calc_mu_staggered
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE couple ( mu, mub, rfield, field, name, &
+                    msf,                          &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+   INTEGER ,             INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                          ims, ime, jms, jme, kms, kme, &
+                                          its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,     INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(  OUT) :: rfield
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu, mub, msf
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   REAL , DIMENSION(ims:ime,jms:jme) :: muu , muv
+
+!<DESCRIPTION>
+!
+! subroutine couple couples the input variable with the dry-air 
+! column mass (mu).  
+!
+!</DESCRIPTION>
+
+   
+   ktf=MIN(kte,kde-1)
+   
+   IF (name .EQ. 'u')THEN
+
+      CALL calc_mu_staggered ( mu, mub, muu, muv,            &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte )
+
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         rfield(i,k,j)=field(i,k,j)*muu(i,j)/msf(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'v')THEN
+
+      CALL calc_mu_staggered ( mu, mub, muu, muv,            &
+                               ids, ide, jds, jde, kds, kde, &
+                               ims, ime, jms, jme, kms, kme, &
+                               its, ite, jts, jte, kts, kte )
+
+      itf=ite
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+           rfield(i,k,j)=field(i,k,j)*muv(i,j)/msf(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'w')THEN
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      DO j=jts,jtf
+      DO k=kts,kte
+      DO i=its,itf
+         rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j))/msf(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'h')THEN
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      DO j=jts,jtf
+      DO k=kts,kte
+      DO i=its,itf
+         rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j))
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE 
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j))
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ENDIF
+
+END SUBROUTINE couple
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE calc_ww_cp ( u, v, mup, mub, ww,              &
+                        rdx, rdy, msftx, msfty,          &
+                        msfux, msfuy, msfvx, msfvx_inv,  &
+                        msfvy, dnw,                      &
+                        ids, ide, jds, jde, kds, kde,    &
+                        ims, ime, jms, jme, kms, kme,    &
+                        its, ite, jts, jte, kts, kte    )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: u, v
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mup, mub, &
+                                                            msftx, msfty, &
+                                                            msfux, msfuy, &
+                                                            msfvx, msfvy, &
+                                                            msfvx_inv
+   REAL , DIMENSION( kms:kme ) , INTENT(IN   ) :: dnw
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT  ) :: ww
+   REAL , INTENT(IN   )  :: rdx, rdy
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   REAL , DIMENSION( its:ite ) :: dmdt
+   REAL , DIMENSION( its:ite, kts:kte ) :: divv
+   REAL , DIMENSION( its:ite+1, jts:jte+1 ) :: muu, muv
+
+!<DESCRIPTION>
+!
+!  calc_ww calculates omega using the velocities (u,v) and the dry-air 
+!  column mass (mup+mub).
+!  The algorithm integrates the continuity equation through the column
+!  followed by a diagnosis of omega.
+!
+!</DESCRIPTION>
+
+!<DESCRIPTION>
+!
+!  calc_ww_cp calculates omega using the velocities (u,v) and the 
+!  column mass mu.
+!
+!</DESCRIPTION>
+
+    jtf=MIN(jte,jde-1)
+    ktf=MIN(kte,kde-1)  
+    itf=MIN(ite,ide-1)
+
+!  mu coupled with the appropriate map factor
+
+      DO j=jts,jtf
+      DO i=its,min(ite+1,ide)
+        ! u is always coupled with my
+        muu(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i-1,j)+mub(i-1,j))/msfuy(i,j)
+      ENDDO
+      ENDDO
+
+      DO j=jts,min(jte+1,jde)
+      DO i=its,itf
+       ! v is always coupled with mx
+!        muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))/msfvx(i,j)
+        muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))*msfvx_inv(i,j)
+      ENDDO
+      ENDDO
+
+      DO j=jts,jtf
+
+        DO i=its,ite
+          dmdt(i) = 0.
+          ww(i,1,j) = 0.
+          ww(i,kte,j) = 0.
+        ENDDO
+
+!       Comments on the modifications for map scale factors
+!       ADT eqn 47 / my (putting rho -> 'mu') is:
+!       (1/my) partial d mu/dt = -mx partial d/dx(mu u/my) 
+!                                -mx partial d/dy(mu v/mx)
+!                                -partial d/dz(mu w/my)
+!
+!       Using nu instead of z the last term becomes:
+!                                -partial d/dnu(mu (dnu/dt)/my)
+!
+!       Integrating with respect to nu over ALL levels, with dnu/dt=0 at top
+!       and bottom, the last term becomes = 0
+!
+!       Integral|bot->top[(1/my) partial d mu/dt]dnu = 
+!       Integral|bot->top[-mx partial d/dx(mu u/my) 
+!                         -mx partial d/dy(mu v/mx)]dnu
+!
+!       muu='mu'[on u]/my, muv='mu'[on v]/mx
+!       (1/my) partial d mu/dt is independent of nu
+!         => LHS = Integral|bot->top[con]dnu = conservation*(-1) = -dmdt
+!
+!         => dmdt = mx*Integral|bot->top[partial d/dx(mu u/my) +
+!                                        partial d/dy(mu v/mx)]dnu
+!         => dmdt = sum_bot->top[divv]
+!       where
+!         divv=mx*[partial d/dx(mu u/my) + partial d/dy(mu v/mx)]*delta nu
+
+        DO k=kts,ktf
+        DO i=its,itf
+
+          divv(i,k) = msftx(i,j)*dnw(k)*( rdx*(muu(i+1,j)*u(i+1,k,j)-muu(i,j)*u(i,k,j))  &
+                                        +rdy*(muv(i,j+1)*v(i,k,j+1)-muv(i,j)*v(i,k,j))   )
+
+!          dmdt(i) = dmdt(i) + dnw(k)* ( rdx*(ru(i+1,k,j)-ru(i,k,j))  &
+!                                       +rdy*(rv(i,k,j+1)-rv(i,k,j))   )
+
+          dmdt(i) = dmdt(i) + divv(i,k)
+
+
+        ENDDO
+        ENDDO
+
+!       Further map scale factor notes:
+!       Now integrate from bottom to top, level by level:
+!       mu dnu/dt/my [k+1] = mu dnu/dt/my [k] + [-(1/my) partial d mu/dt 
+!                           -mx partial d/dx(mu u/my)
+!                           -mx partial d/dy(mu v/mx)]*dnu[k->k+1]
+!       ww [k+1] = ww [k] -(1/my) partial d mu/dt * dnu[k->k+1] - divv[k]
+!                = ww [k] -dmdt * dnw[k] - divv[k]
+
+        DO k=2,ktf
+        DO i=its,itf
+
+!           ww(i,k,j)=ww(i,k-1,j)                                       &
+!                        - dnw(k-1)* ( dmdt(i)                          &
+!                                     +rdx*(ru(i+1,k-1,j)-ru(i,k-1,j))  &
+!                                     +rdy*(rv(i,k-1,j+1)-rv(i,k-1,j)) )
+
+           ww(i,k,j)=ww(i,k-1,j) - dnw(k-1)*dmdt(i) - divv(i,k-1)
+
+        ENDDO
+        ENDDO
+     ENDDO
+
+
+END SUBROUTINE calc_ww_cp
+
+
+!-------------------------------------------------------------------------------
+ 
+SUBROUTINE calc_cq ( moist, cqu, cqv, cqw, n_moist, &
+                     ids, ide, jds, jde, kds, kde,  &
+                     ims, ime, jms, jme, kms, kme,  &
+                     its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   INTEGER ,          INTENT(IN   ) :: n_moist
+   
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme , n_moist ), INTENT(IN   ) :: moist
+                                              
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(  OUT) :: cqu, cqv, cqw
+
+   ! Local stuff
+
+   REAL :: qtot
+   
+   INTEGER :: i, j, k, itf, jtf, ktf, ispe
+
+!<DESCRIPTION>
+!
+!  calc_cq calculates moist coefficients for the momentum equations.
+!
+!</DESCRIPTION>
+
+      itf=ite
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+
+      IF(  n_moist >= PARAM_FIRST_SCALAR ) THEN
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+          qtot = 0.
+!DEC$ loop count(3)
+          DO ispe=PARAM_FIRST_SCALAR,n_moist
+            qtot = qtot + moist(i,k,j,ispe) + moist(i-1,k,j,ispe)
+          ENDDO
+!           qtot = 0.5*( moist(i  ,k,j,1)+moist(i  ,k,j,2)+moist(i  ,k,j,3)+  &
+!     &                  moist(i-1,k,j,1)+moist(i-1,k,j,2)+moist(i-1,k,j,3) )
+!           cqu(i,k,j) = 1./(1.+qtot)
+           cqu(i,k,j) = 1./(1.+0.5*qtot)
+        ENDDO
+        ENDDO
+        ENDDO
+
+        itf=MIN(ite,ide-1)
+        jtf=jte
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+          qtot = 0.
+!DEC$ loop count(3)
+          DO ispe=PARAM_FIRST_SCALAR,n_moist
+            qtot = qtot + moist(i,k,j,ispe) + moist(i,k,j-1,ispe)
+          ENDDO
+!           qtot = 0.5*( moist(i,k,j  ,1)+moist(i,k,j  ,2)+moist(i,k,j  ,3)+  &
+!     &                  moist(i,k,j-1,1)+moist(i,k,j-1,2)+moist(i,k,j-1,3) )
+!           cqv(i,k,j) = 1./(1.+qtot)
+           cqv(i,k,j) = 1./(1.+0.5*qtot)
+        ENDDO
+        ENDDO
+        ENDDO
+
+        itf=MIN(ite,ide-1)
+        jtf=MIN(jte,jde-1)
+        DO j=jts,jtf
+        DO k=kts+1,ktf
+        DO i=its,itf
+          qtot = 0.
+!DEC$ loop count(3)
+          DO ispe=PARAM_FIRST_SCALAR,n_moist
+            qtot = qtot + moist(i,k,j,ispe) + moist(i,k-1,j,ispe)
+          ENDDO
+!           qtot = 0.5*( moist(i,k  ,j,1)+moist(i,k  ,j,2)+moist(i,k-1,j,3)+  &
+!     &                  moist(i,k-1,j,1)+moist(i,k-1,j,2)+moist(i,k  ,j,3) )
+!           cqw(i,k,j) = qtot
+           cqw(i,k,j) = 0.5*qtot
+        ENDDO
+        ENDDO
+        ENDDO
+
+      ELSE
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           cqu(i,k,j) = 1.
+        ENDDO
+        ENDDO
+        ENDDO
+
+        itf=MIN(ite,ide-1)
+        jtf=jte
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+           cqv(i,k,j) = 1.
+        ENDDO
+        ENDDO
+        ENDDO
+
+        itf=MIN(ite,ide-1)
+        jtf=MIN(jte,jde-1)
+        DO j=jts,jtf
+        DO k=kts+1,ktf
+        DO i=its,itf
+           cqw(i,k,j) = 0.
+        ENDDO
+        ENDDO
+        ENDDO
+
+      END IF
+
+END SUBROUTINE calc_cq
+
+!----------------------------------------------------------------------
+
+SUBROUTINE calc_alt ( alt, al, alb,                  &
+                      ids, ide, jds, jde, kds, kde,  &
+                      ims, ime, jms, jme, kms, kme,  &
+                      its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: alb, al
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(  OUT) :: alt
+
+   ! Local stuff
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+!<DESCRIPTION>
+!
+! calc_alt computes the full inverse density
+!
+!</DESCRIPTION>
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+        alt(i,k,j) = al(i,k,j)+alb(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+
+END SUBROUTINE calc_alt
+
+!----------------------------------------------------------------------
+
+SUBROUTINE calc_p_rho_phi ( moist, n_moist,                &
+                            al, alb, mu, muts, ph, p, pb,  &
+                            t, p0, t0, znu, dnw, rdnw,     &
+                            rdn, non_hydrostatic,          &
+                            ids, ide, jds, jde, kds, kde,  &
+                            ims, ime, jms, jme, kms, kme,  &
+                            its, ite, jts, jte, kts, kte  )
+
+  IMPLICIT NONE
+   
+   ! Input data
+
+  LOGICAL ,          INTENT(IN   ) :: non_hydrostatic
+
+  INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                      ims, ime, jms, jme, kms, kme, &
+                                      its, ite, jts, jte, kts, kte 
+
+  INTEGER ,          INTENT(IN   ) :: n_moist
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: alb,  &
+                                                                   pb,   &
+                                                                   t
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme, n_moist ), INTENT(IN   ) :: moist
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(  OUT) :: al, p
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: ph
+
+  REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN   ) :: mu, muts
+
+  REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: znu, dnw, rdnw, rdn
+
+  REAL,   INTENT(IN   ) :: t0, p0
+
+  ! Local stuff
+
+  INTEGER :: i, j, k, itf, jtf, ktf, ispe
+  REAL    :: qvf, qtot, qf1, qf2
+  REAL, DIMENSION( its:ite) :: temp,cpovcv_v
+
+
+!<DESCRIPTION>
+!
+! For the nonhydrostatic option, calc_p_rho_phi calculates the
+! diagnostic quantities pressure and (inverse) density from the
+! prognostic variables using the equation of state.
+!
+! For the hydrostatic option, calc_p_rho_phi calculates the
+! diagnostic quantities (inverse) density and geopotential from the
+! prognostic variables using the equation of state and the hydrostatic 
+! equation.
+!
+!</DESCRIPTION>
+
+  itf=MIN(ite,ide-1)
+  jtf=MIN(jte,jde-1)
+  ktf=MIN(kte,kde-1)
+
+#ifndef INTELMKL
+  cpovcv_v = cpovcv
+#endif
+
+  IF (non_hydrostatic) THEN
+
+      IF (n_moist >= PARAM_FIRST_SCALAR ) THEN  
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+          qvf = 1.+rvovrd*moist(i,k,j,P_QV)
+          al(i,k,j)=-1./muts(i,j)*(alb(i,k,j)*mu(i,j)  &
+                     +rdnw(k)*(ph(i,k+1,j)-ph(i,k,j)))
+          temp(i)=(r_d*(t0+t(i,k,j))*qvf)/                 &
+                        (p0*(al(i,k,j)+alb(i,k,j)))
+        ENDDO
+#ifdef INTELMKL
+        CALL VPOWX ( itf-its+1, temp(its), cpovcv, p(its,k,j) )
+#else
+! use vector version from libmassv or from compat lib in frame/libmassv.F
+        CALL VPOW  ( p(its,k,j), temp(its), cpovcv_v(its), itf-its+1 )
+#endif
+        DO i=its,itf
+           p(i,k,j)= p(i,k,j)*p0-pb(i,k,j)
+        ENDDO
+        ENDDO
+        ENDDO
+
+      ELSE
+
+        DO j=jts,jtf
+        DO k=kts,ktf
+        DO i=its,itf
+          al(i,k,j)=-1./muts(i,j)*(alb(i,k,j)*mu(i,j)  &
+                     +rdnw(k)*(ph(i,k+1,j)-ph(i,k,j)))
+          p(i,k,j)=p0*( (r_d*(t0+t(i,k,j)))/                     &
+                        (p0*(al(i,k,j)+alb(i,k,j))) )**cpovcv  &
+                           -pb(i,k,j)
+        ENDDO
+        ENDDO
+        ENDDO
+
+      END IF
+
+   ELSE
+
+!  hydrostatic pressure, al, and ph1 calc; WCS, 5 sept 2001
+
+
+      IF (n_moist >= PARAM_FIRST_SCALAR ) THEN  
+
+        DO j=jts,jtf
+
+          k=ktf          ! top layer
+          DO i=its,itf
+
+            qtot = 0.
+            DO ispe=PARAM_FIRST_SCALAR,n_moist
+              qtot = qtot + moist(i,k,j,ispe)
+            ENDDO
+            qf2 = 1./(1.+qtot)
+            qf1 = qtot*qf2
+
+            p(i,k,j) = - 0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2
+            qvf = 1.+rvovrd*moist(i,k,j,P_QV)
+            al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* &
+                (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j)
+
+          ENDDO
+
+          DO k=ktf-1,kts,-1  ! remaining layers, integrate down
+            DO i=its,itf
+
+            qtot = 0.
+            DO ispe=PARAM_FIRST_SCALAR,n_moist
+              qtot = qtot + 0.5*(  moist(i,k  ,j,ispe) + moist(i,k+1,j,ispe) )
+            ENDDO
+            qf2 = 1./(1.+qtot)
+            qf1 = qtot*qf2
+
+            p(i,k,j) = p(i,k+1,j) - (mu(i,j) + qf1*muts(i,j))/qf2/rdn(k+1)
+            qvf = 1.+rvovrd*moist(i,k,j,P_QV)
+            al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* &
+                        (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j)
+            ENDDO
+          ENDDO
+
+          DO k=2,ktf+1  ! integrate hydrostatic equation for geopotential
+            DO i=its,itf
+
+!              ph(i,k,j) = ph(i,k-1,j) - (1./rdnw(k-1))*(       &
+!                           (muts(i,j)+mu(i,j))*al(i,k-1,j)+    &
+!                            mu(i,j)*alb(i,k-1,j)  )
+              ph(i,k,j) = ph(i,k-1,j) - (dnw(k-1))*(           &
+                           (muts(i,j))*al(i,k-1,j)+            &
+                            mu(i,j)*alb(i,k-1,j)  )
+                                                   
+
+            ENDDO
+          ENDDO
+
+        ENDDO
+
+      ELSE
+
+        DO j=jts,jtf
+
+          k=ktf          ! top layer
+          DO i=its,itf
+
+            qtot = 0.
+            qf2 = 1./(1.+qtot)
+            qf1 = qtot*qf2
+
+            p(i,k,j) = - 0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2
+            qvf = 1.
+            al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* &
+                (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j)
+
+          ENDDO
+
+          DO k=ktf-1,kts,-1  ! remaining layers, integrate down
+            DO i=its,itf
+
+            qtot = 0.
+            qf2 = 1./(1.+qtot)
+            qf1 = qtot*qf2
+
+            p(i,k,j) = p(i,k+1,j) - (mu(i,j) + qf1*muts(i,j))/qf2/rdn(k+1)
+            qvf = 1.
+            al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* &
+                        (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j)
+            ENDDO
+          ENDDO
+
+          DO k=2,ktf+1  ! integrate hydrostatic equation for geopotential
+            DO i=its,itf
+
+!              ph(i,k,j) = ph(i,k-1,j) - (1./rdnw(k-1))*(       &
+!                           (muts(i,j)+mu(i,j))*al(i,k-1,j)+    &
+!                            mu(i,j)*alb(i,k-1,j)  )
+              ph(i,k,j) = ph(i,k-1,j) - (dnw(k-1))*(           &
+                           (muts(i,j))*al(i,k-1,j)+            &
+                            mu(i,j)*alb(i,k-1,j)  )
+                                                   
+
+            ENDDO
+          ENDDO
+
+        ENDDO
+
+     END IF
+
+   END IF
+
+END SUBROUTINE calc_p_rho_phi
+
+!----------------------------------------------------------------------
+
+SUBROUTINE calc_php ( php, ph, phb,                  &
+                      ids, ide, jds, jde, kds, kde,  &
+                      ims, ime, jms, jme, kms, kme,  &
+                      its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) :: phb, ph
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(  OUT) :: php
+
+   ! Local stuff
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+!<DESCRIPTION>
+!
+!  calc_php calculates the full geopotential from the reference state
+!  geopotential and the perturbation geopotential (phb_ph).
+!
+!</DESCRIPTION>
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+        php(i,k,j) = 0.5*(phb(i,k,j)+phb(i,k+1,j)+ph(i,k,j)+ph(i,k+1,j))
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE calc_php
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE diagnose_w( ph_tend, ph_new, ph_old, w, mu, dt,  &
+                       u, v, ht,                            &
+                       cf1, cf2, cf3, rdx, rdy,             &
+                       msftx, msfty,                        &
+                       ids, ide, jds, jde, kds, kde,        &
+                       ims, ime, jms, jme, kms, kme,        &
+                       its, ite, jts, jte, kts, kte        )
+
+   IMPLICIT NONE
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::   ph_tend, &
+                                                                     ph_new,  &
+                                                                     ph_old,  &
+                                                                     u,       &
+                                                                     v
+
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(  OUT) :: w
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: mu, ht, msftx, msfty
+
+   REAL, INTENT(IN   ) :: dt, cf1, cf2, cf3, rdx, rdy
+
+   INTEGER :: i, j, k, itf, jtf
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+!<DESCRIPTION>
+!
+! diagnose_w diagnoses the vertical velocity from the geopoential equation.
+! Used with the hydrostatic option.
+!
+!</DESCRIPTION>
+
+   DO j = jts, jtf
+
+!  lower b.c. on w
+
+!  Notes on map scale factors:
+!  Chain rule: if Z=Z(X,Y) [true at the surface] then
+!  dZ/dt = dZ/dX * dX/dt + dZ/dY * dY/dt, U=dX/dt, V=dY/dt
+!  Using capitals to denote actual values
+!  In mapped values, u=U, v=V, z=Z, 1/dX=mx/dx, 1/dY=my/dy
+!    => w = dz/dt = mx u dz/dx + my v dz/dy
+!  [where dz/dx is just the surface height change between x
+!   gridpoints, and dz/dy is the change between y gridpoints]
+!  [NB: cf1, cf2 and cf3 do vertical weighting of u or v values
+!   nearest the surface]
+
+!  Previously msft multiplied by rdy and rdx terms.
+!  Now msfty multiplies rdy term, and msftx multiplies msftx term
+     DO i = its, itf
+         w(i,1,j)=  msfty(i,j)*.5*rdy*(                      &
+                           (ht(i,j+1)-ht(i,j  ))             &
+          *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1))    &
+                          +(ht(i,j  )-ht(i,j-1))             &
+          *(cf1*v(i,1,j  )+cf2*v(i,2,j  )+cf3*v(i,3,j  ))  ) &
+                 +msftx(i,j)*.5*rdx*(                        &
+                           (ht(i+1,j)-ht(i,j  ))             &
+          *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j))    &
+                          +(ht(i,j  )-ht(i-1,j))             &
+          *(cf1*u(i  ,1,j)+cf2*u(i  ,2,j)+cf3*u(i  ,3,j))  )
+     ENDDO
+
+!  use geopotential equation to diagnose w
+
+!  Further notes on map scale factors
+!  If ph_tend contains:  -mx partial d/dx(mu rho u/my) 
+!                        -mx partial d/dy(phi mu v/mx)
+!                        -partial d/dz(phi mu w/my)
+!  then phi eqn is: partial d/dt(mu phi/my) = ph_tend + mu g w/my
+!    => w = [my/(mu*g)]*[partial d/dt(mu phi/my) - ph_tend]
+
+     DO k = 2, kte
+     DO i = its, itf
+       w(i,k,j) =  msfty(i,j)*(  (ph_new(i,k,j)-ph_old(i,k,j))/dt       &
+                               - ph_tend(i,k,j)/mu(i,j)        )/g 
+
+     ENDDO
+     ENDDO
+
+   ENDDO
+
+END SUBROUTINE diagnose_w
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rhs_ph( ph_tend, u, v, ww,               &
+                   ph, ph_old, phb, w,              &
+                   mut, muu, muv,                   &
+                   fnm, fnp,                        &
+                   rdnw, cfn, cfn1, rdx, rdy,       &
+                   msfux, msfuy, msfvx,             &
+                   msfvx_inv, msfvy,                &
+                   msftx, msfty,                    &
+                   non_hydrostatic,                 &
+                   config_flags,                    &
+                   ids, ide, jds, jde, kds, kde,    &
+                   ims, ime, jms, jme, kms, kme,    &
+                   its, ite, jts, jte, kts, kte    )
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::        &
+                                                                     u,   &
+                                                                     v,   &
+                                                                     ww,  &
+                                                                     ph,  &
+                                                                     ph_old, &
+                                                                     phb, & 
+                                                                    w
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: ph_tend
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: muu, muv, mut,   &
+                                                            msfux, msfuy, &
+                                                            msfvx, msfvy, &
+                                                            msftx, msfty, &
+                                                            msfvx_inv
+
+   REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: rdnw, fnm, fnp
+
+   REAL,  INTENT(IN   ) :: cfn, cfn1, rdx, rdy
+
+   LOGICAL,  INTENT(IN   )  ::  non_hydrostatic
+
+   ! Local stuff
+
+   INTEGER :: i, j, k, itf, jtf, ktf, kz, i_start, j_start
+   REAL    :: ur, ul, ub, vr, vl, vb
+   REAL, DIMENSION(its:ite,kts:kte) :: wdwn
+
+   INTEGER :: advective_order
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+! rhs_ph calculates the large-timestep tendency terms for the geopotential
+! equation.  These terms include the advection and "gw".  The geopotential
+! equation is cast in advective form, so we don't use the flux form advection
+! algorithms here.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   advective_order = config_flags%h_sca_adv_order 
+!   advective_order = 2  !  original configuration (pre Oct 2001)
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+   ktf=MIN(kte,kde-1)
+
+!  Notes on map scale factors (WCS, 2 march 2008)
+!  phi equation is:   mu/my d/dt(phi) = -(1/my) mx mu u  d/dx(phi)
+!                                       -(1/my) my mu v d/dy(phi)
+!                                       - omega d/d_eta(phi)
+!                                               +mu g w/my
+!
+!  A little further explanation...
+!  The tendency term we are computing here is for mu/my d/dt(phi).  It is advective form 
+!  but it is multiplied be mu/my.  It will be decoupled from (mu/my) when the implicit w-phi
+!  solution is computed in subourine advance_w.  The formulation dates from the early 
+!  days of the mass coordinate model when we were testing both a flux and an advective formulation
+!  for the geopotential equation and different forms of the vertical momentum equation and the 
+!  vertically implicit solver.
+
+! advective form for the geopotential equation
+
+   DO j = jts, jtf
+
+     DO k = 2, kte
+     DO i = its, itf
+          wdwn(i,k) = .5*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)               &
+                        *(ph(i,k,j)-ph(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))
+     ENDDO
+     ENDDO
+
+!  RHS term 3 is: - omega partial d/dnu(phi)
+
+     DO k = 2, kte-1
+     DO i = its, itf
+           ph_tend(i,k,j) = ph_tend(i,k,j)                           &
+                             - (fnm(k)*wdwn(i,k+1)+fnp(k)*wdwn(i,k))
+     ENDDO
+     ENDDO
+
+   ENDDO
+
+   IF (non_hydrostatic) THEN  ! add in "gw" term.
+   DO j = jts, jtf            ! in hydrostatic mode, "gw" will be diagnosed
+                              ! after the timestep to give us "w"
+     DO i = its, itf
+        ph_tend(i,kde,j) = 0.
+     ENDDO
+
+     DO k = 2, kte
+     DO i = its, itf
+        ! phi equation RHS term 4
+        ph_tend(i,k,j) = ph_tend(i,k,j) + mut(i,j)*g*w(i,k,j)/msfty(i,j)
+     ENDDO
+     ENDDO
+
+   ENDDO
+
+   END IF
+
+!  Notes on map scale factors:
+!  RHS terms 1 and 2 are: -(1/my) mx u mu partial d/dx(phi)
+!                         -(1/my) my v mu partial d/dy(phi)
+
+   IF (advective_order <= 2) THEN
+
+!  y (v) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1
+   IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*          &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)*   &
+                  (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))   &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  )*   &
+                  (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1)) )
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*                        &
+                  ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1)*    &
+                   (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))               &
+                   +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  )*    &
+                   (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1))              )
+     ENDDO
+
+   ENDDO
+
+!  x (u) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+1
+   IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-1
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*         &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)*  &
+                  (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))  &
+                  +muu(i  ,j)*(u(i  ,k,j)+u(i  ,k-1,j))*msfux(i  ,j)*  &
+                  (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))  )
+     ENDDO
+     ENDDO
+ 
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*                        &
+                  ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j)*    &
+                   (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))               &
+                   +muu(i  ,j)*(cfn*u(i  ,k-1,j)+cfn1*u(i  ,k-2,j))*msfux(  i,j)*    &
+                   (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))             )
+     ENDDO
+
+   ENDDO
+
+   ELSE IF (advective_order <= 4) THEN
+
+!  y (v) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1
+   IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*(                     &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)                &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  ))* (1./12.)*(   &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                                    &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                                    &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                  &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*(                                 &
+                 ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1)                &
+                  +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  ))* (1./12.)*(   &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                                               &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                                               &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                             &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+     ENDDO
+
+   ENDDO
+
+
+!  x (u) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+1
+   IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-1
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*(                    &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)               &
+                  +muu(i,j  )*(u(i  ,k,j)+u(i  ,k-1,j))*msfux(i  ,j) )* (1./12.)*( &
+                    8.*(ph(i+1,k,j)-ph(i-1,k,j))                                   &
+                      -(ph(i+2,k,j)-ph(i-2,k,j))                                   &
+                   +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                 &
+                      -(phb(i+2,k,j)-phb(i-2,k,j))  )   )                
+     ENDDO
+     ENDDO
+ 
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*(                                 &
+                 ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j)                &
+                  +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i  ,k-2,j))*msfux(i  ,j) )* (1./12.)*(  &
+                    8.*(ph(i+1,k,j)-ph(i-1,k,j))                                               &
+                      -(ph(i+2,k,j)-ph(i-2,k,j))                                               &
+                   +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                             &
+                      -(phb(i+2,k,j)-phb(i-2,k,j))  )     )
+     ENDDO
+
+   ENDDO
+
+   ELSE IF (advective_order <= 6) THEN
+
+!  y (v) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+!   IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1
+!   IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1
+
+   IF (config_flags%open_ys .or. specified ) j_start = max(jts,jds+2)
+   IF (config_flags%open_ye .or. specified ) jtf     = min(jtf,jde-3)
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* (                    &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)                &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  ) )* (1./60.)*(  &
+                   45.*(ph(i,k,j+1)-ph(i,k,j-1))                                    &
+                   -9.*(ph(i,k,j+2)-ph(i,k,j-2))                                    &
+                      +(ph(i,k,j+3)-ph(i,k,j-3))                                    &
+                  +45.*(phb(i,k,j+1)-phb(i,k,j-1))                                  &
+                   -9.*(phb(i,k,j+2)-phb(i,k,j-2))                                  &
+                      +(phb(i,k,j+3)-phb(i,k,j-3))  )   )                
+
+
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* (                                &
+                 ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1)                &
+                  +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  ) )* (1./60.)*(  &
+                   45.*(ph(i,k,j+1)-ph(i,k,j-1))                                               &
+                   -9.*(ph(i,k,j+2)-ph(i,k,j-2))                                               &
+                      +(ph(i,k,j+3)-ph(i,k,j-3))                                               &
+                  +45.*(phb(i,k,j+1)-phb(i,k,j-1))                                             &
+                   -9.*(phb(i,k,j+2)-phb(i,k,j-2))                                             &
+                      +(phb(i,k,j+3)-phb(i,k,j-3))  )   )                
+
+     ENDDO
+
+   ENDDO
+
+
+!  pick up near boundary rows using 4th order stencil 
+!  (open bc copy only goes out to jds-1 and jde, hence 4rth is ok but 6th is too big)
+
+   IF ( (config_flags%open_ys) .and. jts <= jds+1 )  THEN
+
+     j = jds+1
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* (                     &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)                &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  ) )* (1./12.)*(  &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                                    &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                                    &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                  &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* (                              &
+                 ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1)              &
+                  +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j) )* (1./12.)*(  &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                                             &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                                             &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                           &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+     ENDDO
+
+   END IF
+
+   IF ( (config_flags%open_ye) .and. jte >= jde-2 )  THEN
+
+     j = jde-2
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* (                  &
+                 ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)              &
+                  +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j) )* (1./12.)*(  &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                                  &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                                  &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+
+     ENDDO
+     ENDDO
+
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* (                              &
+                 ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1)              &
+                  +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j) )* (1./12.)*(  &
+                    8.*(ph(i,k,j+1)-ph(i,k,j-1))                                             &
+                      -(ph(i,k,j+2)-ph(i,k,j-2))                                             &
+                   +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                           &
+                      -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
+
+     ENDDO
+
+   END IF
+
+!  x (u) advection
+
+   i_start = its
+   j_start = jts
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   IF (config_flags%open_xs .or. specified ) i_start = max(its,ids+2)
+   IF (config_flags%open_xe .or. specified ) itf     = min(itf,ide-3)
+   IF ( config_flags%periodic_x ) i_start = its
+   IF ( config_flags%periodic_x ) itf=MIN(ite,ide-1)
+
+   DO j = j_start, jtf
+
+     DO k = 2, kte-1
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*(                   &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)              &
+                  +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  ))*msfux(i,j) )* (1./60.)*(  &
+                   45.*(ph(i+1,k,j)-ph(i-1,k,j))                                  &
+                   -9.*(ph(i+2,k,j)-ph(i-2,k,j))                                  &
+                      +(ph(i+3,k,j)-ph(i-3,k,j))                                  &
+                  +45.*(phb(i+1,k,j)-phb(i-1,k,j))                                &
+                   -9.*(phb(i+2,k,j)-phb(i-2,k,j))                                &
+                      +(phb(i+3,k,j)-phb(i-3,k,j))  )   )                
+     ENDDO
+     ENDDO
+ 
+     k = kte
+     DO i = i_start, itf
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*(                             &
+                 ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j)            &
+                  +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) )* (1./60.)*(  &
+                   45.*(ph(i+1,k,j)-ph(i-1,k,j))                                           &
+                   -9.*(ph(i+2,k,j)-ph(i-2,k,j))                                           &
+                      +(ph(i+3,k,j)-ph(i-3,k,j))                                           &
+                  +45.*(phb(i+1,k,j)-phb(i-1,k,j))                                         &
+                   -9.*(phb(i+2,k,j)-phb(i-2,k,j))                                         &
+                      +(phb(i+3,k,j)-phb(i-3,k,j))  )     )
+     ENDDO
+
+   ENDDO
+
+   IF ( (config_flags%open_xs) .and. its <= ids+1 ) THEN
+     i = ids + 1
+     DO j = j_start, jtf
+       DO k = 2, kte-1
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*(                   &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)              &
+                  +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  ))*msfux(i,j) )* (1./12.)*(  &
+                    8.*(ph(i+1,k,j)-ph(i-1,k,j))                                  &
+                      -(ph(i+2,k,j)-ph(i-2,k,j))                                  &
+                   +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                &
+                      -(phb(i+2,k,j)-phb(i-2,k,j))  )   )                
+       ENDDO
+       k = kte
+       ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*(                             &
+                ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j)            &
+                 +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) )* (1./12.)*(  &
+                   8.*(ph(i+1,k,j)-ph(i-1,k,j))                                           &
+                     -(ph(i+2,k,j)-ph(i-2,k,j))                                           &
+                  +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                         &
+                     -(phb(i+2,k,j)-phb(i-2,k,j))  )     )
+
+     ENDDO
+   END IF
+
+   IF ( (config_flags%open_xe) .and. ite >= ide-2 ) THEN
+     i = ide-2
+     DO j = j_start, jtf
+       DO k = 2, kte-1
+        ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*(                   &
+                 ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)              &
+                  +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  ))*msfux(i,j) )* (1./12.)*(  &
+                    8.*(ph(i+1,k,j)-ph(i-1,k,j))                                  &
+                      -(ph(i+2,k,j)-ph(i-2,k,j))                                  &
+                   +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                &
+                      -(phb(i+2,k,j)-phb(i-2,k,j))  )   )                
+       ENDDO
+       k = kte
+       ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*(                             &
+                ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j)            &
+                 +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) )* (1./12.)*(  &
+                   8.*(ph(i+1,k,j)-ph(i-1,k,j))                                           &
+                     -(ph(i+2,k,j)-ph(i-2,k,j))                                           &
+                  +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                         &
+                     -(phb(i+2,k,j)-phb(i-2,k,j))  )     )
+
+     ENDDO
+   END IF
+
+   END IF
+
+!  lateral open boundary conditions,
+!  start with north and south (y) boundaries
+
+   i_start = its
+   itf=MIN(ite,ide-1)
+
+   !  south
+
+   IF ( (config_flags%open_ys) .and. jts == jds ) THEN
+
+     j=jts
+
+     DO k=2,kde
+       kz = min(k,kde-1)
+       DO i = its,itf
+         vb =.5*( fnm(kz)*(v(i,kz  ,j+1)+v(i,kz  ,j  ))    &
+                 +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j  )) )
+         vl=amin1(vb,0.)
+         ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*(      &
+                              +vl*(ph_old(i,k,j+1)-ph_old(i,k,j)))
+       ENDDO
+     ENDDO
+
+   END IF
+
+   ! north
+
+   IF ( (config_flags%open_ye) .and. jte == jde ) THEN
+
+     j=jte-1
+
+     DO k=2,kde
+       kz = min(k,kde-1)
+       DO i = its,itf
+        vb=.5*( fnm(kz)*(v(i,kz  ,j+1)+v(i,kz  ,j))   &
+               +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j)) )
+        vr=amax1(vb,0.)
+        ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*(      &
+                   +vr*(ph_old(i,k,j)-ph_old(i,k,j-1)))
+       ENDDO
+     ENDDO
+
+   END IF
+
+   !  now the east and west (y) boundaries
+
+   j_start = its
+   jtf=MIN(jte,jde-1)
+
+   !  west
+
+   IF ( (config_flags%open_xs) .and. its == ids ) THEN
+
+     i=its
+
+     DO j = jts,jtf
+       DO k=2,kde-1
+         kz = k
+         ub =.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i  ,kz  ,j))     &
+                 +fnp(kz)*(u(i+1,kz-1,j)+u(i  ,kz-1,j)) )
+         ul=amin1(ub,0.)
+         ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*(       &
+                              +ul*(ph_old(i+1,k,j)-ph_old(i,k,j)))
+       ENDDO
+
+         k = kde
+         kz = k
+         ub =.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i  ,kz  ,j))     &
+                 +fnp(kz)*(u(i+1,kz-1,j)+u(i  ,kz-1,j)) )
+         ul=amin1(ub,0.)
+         ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*(       &
+                              +ul*(ph_old(i+1,k,j)-ph_old(i,k,j)))
+     ENDDO
+
+   END IF
+
+   ! east
+
+   IF ( (config_flags%open_xe) .and. ite == ide ) THEN
+
+     i = ite-1
+
+     DO j = jts,jtf
+       DO k=2,kde-1
+        kz = k
+        ub=.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i,kz  ,j))  &
+               +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) )
+        ur=amax1(ub,0.)
+        ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*( &
+                   +ur*(ph_old(i,k,j)-ph_old(i-1,k,j)))
+       ENDDO
+
+        k = kde    
+        kz = k-1
+        ub=.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i,kz  ,j))   &
+               +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) )
+        ur=amax1(ub,0.)
+        ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*(  &
+                   +ur*(ph_old(i,k,j)-ph_old(i-1,k,j)))
+
+     ENDDO
+
+   END IF
+
+  END SUBROUTINE rhs_ph
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE horizontal_pressure_gradient( ru_tend,rv_tend,                &
+                                         ph,alt,p,pb,al,php,cqu,cqv,     &
+                                         muu,muv,mu,fnm,fnp,rdnw,        &
+                                         cf1,cf2,cf3,rdx,rdy,msfux,msfuy,&
+                                         msfvx,msfvy,msftx,msfty,        &
+                                         config_flags, non_hydrostatic,  &
+                                         top_lid,                        &
+                                         ids, ide, jds, jde, kds, kde,   &
+                                         ims, ime, jms, jme, kms, kme,   &
+                                         its, ite, jts, jte, kts, kte   )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   LOGICAL, INTENT (IN   ) :: non_hydrostatic, top_lid
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::        &
+                                                                     ph,  &
+                                                                     alt, &
+                                                                     al,  &
+                                                                     p,   &
+                                                                     pb,  &
+                                                                     php, &
+                                                                     cqu, &
+                                                                     cqv
+
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) ::           &
+                                                                    ru_tend, &
+                                                                    rv_tend
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: muu, muv, mu,    &
+                                                            msfux, msfuy, &
+                                                            msfvx, msfvy, &
+                                                            msftx, msfty
+
+   REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: rdnw, fnm, fnp
+
+   REAL,  INTENT(IN   ) :: rdx, rdy, cf1, cf2, cf3
+
+   INTEGER :: i,j,k, itf, jtf, ktf, i_start, j_start
+   REAL, DIMENSION( ims:ime, kms:kme ) :: dpn
+   REAL :: dpx, dpy
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  horizontal_pressure_gradient calculates the 
+!  horizontal pressure gradient terms for the large-timestep tendency 
+!  in the horizontal momentum equations (u,v).
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+!  Notes on map scale factors:
+!  Calculates the pressure gradient terms in ADT eqns 44 and 45
+!  With upper rho -> 'mu', these are:
+!  Eqn 30: -mu*(mx/my)*(1/rho)*partial dp/dx
+!  Eqn 31: -mu*(my/mx)*(1/rho)*partial dp/dy
+!
+!  As we are on nu, rather than height, surfaces:
+!
+!  mu dp/dx = mu alpha partial dp'/dx + (nu mu partial dmubar/dx) alpha'
+!           + mu partial dphi'/dx + (partial dphi/dx)*(partial dp'/dnu - mu')
+!
+!  mu dp/dy = mu alpha partial dp'/dy + (nu mu partial dmubar/dy) alpha'
+!           + mu partial dphi'/dy + (partial dphi/dy)*(partial dp'/dnu - mu')
+
+! start with the north-south (y) pressure gradient
+
+   itf=MIN(ite,ide-1)
+   jtf=jte
+   ktf=MIN(kte,kde-1)
+   i_start = its
+   j_start = jts
+   IF ( (config_flags%open_ys .or. specified .or. &
+         config_flags%nested .or. config_flags%polar ) .and. jts == jds ) j_start = jts+1
+   IF ( (config_flags%open_ye .or. specified .or. &
+         config_flags%nested .or. config_flags%polar ) .and. jte == jde ) jtf = jtf-1
+
+   DO j = j_start, jtf
+
+     IF ( non_hydrostatic )  THEN
+
+        k=1
+
+        DO i = i_start, itf
+          dpn(i,k) = .5*( cf1*(p(i,k  ,j-1)+p(i,k  ,j))   &
+                         +cf2*(p(i,k+1,j-1)+p(i,k+1,j))   &
+                         +cf3*(p(i,k+2,j-1)+p(i,k+2,j))  )
+          dpn(i,kde) = 0.
+        ENDDO
+        IF (top_lid) THEN
+          DO i = i_start, itf
+            dpn(i,kde) = .5*( cf1*(p(i,kde-1,j-1)+p(i,kde-1,j))   &
+                             +cf2*(p(i,kde-2,j-1)+p(i,kde-2,j))   &
+                             +cf3*(p(i,kde-3,j-1)+p(i,kde-3,j))  )
+          ENDDO
+        ENDIF
+               
+        DO k=2,ktf
+          DO i = i_start, itf
+            dpn(i,k) = .5*( fnm(k)*(p(i,k  ,j-1)+p(i,k  ,j))  &
+                           +fnp(k)*(p(i,k-1,j-1)+p(i,k-1,j)) )
+          END DO
+        END DO
+
+!       ADT eqn 45: -mu*(my/mx)*(1/rho)*partial dp/dy
+!       [alt, al are 1/rho terms; muv, mu are NOT coupled]
+        DO K=1,ktf
+          DO i = i_start, itf
+            ! Here are mu dp/dy terms 1-3 
+            dpy = (msfvy(i,j)/msfvx(i,j))*.5*rdy*muv(i,j)*(                 &
+                     (ph (i,k+1,j)-ph (i,k+1,j-1) + ph(i,k,j)-ph(i,k,j-1))  &
+                    +(alt(i,k  ,j)+alt(i,k  ,j-1))*(p (i,k,j)-p (i,k,j-1))  &
+                    +(al (i,k  ,j)+al (i,k  ,j-1))*(pb(i,k,j)-pb(i,k,j-1)) )
+            ! Here is mu dp/dy term 4 
+            dpy = dpy + (msfvy(i,j)/msfvx(i,j))*rdy*(php(i,k,j)-php(i,k,j-1))* &
+                (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i,j-1)+mu(i,j)))
+            rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy
+          END DO
+        END DO
+
+     ELSE
+
+!       ADT eqn 45: -mu*(my/mx)*(1/rho)*partial dp/dy
+!       [alt, al are 1/rho terms; muv, mu are NOT coupled]
+        DO K=1,ktf
+          DO i = i_start, itf
+            ! Here are mu dp/dy terms 1-3; term 4 not needed if hydrostatic
+            dpy = (msfvy(i,j)/msfvx(i,j))*.5*rdy*muv(i,j)*(                 &
+                     (ph (i,k+1,j)-ph (i,k+1,j-1) + ph(i,k,j)-ph(i,k,j-1))  &
+                    +(alt(i,k  ,j)+alt(i,k  ,j-1))*(p (i,k,j)-p (i,k,j-1))  &
+                    +(al (i,k  ,j)+al (i,k  ,j-1))*(pb(i,k,j)-pb(i,k,j-1)) )
+            rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy
+          END DO
+        END DO
+
+     END IF
+
+   ENDDO
+
+!  now the east-west (x) pressure gradient
+
+   itf=ite
+   jtf=MIN(jte,jde-1)
+   ktf=MIN(kte,kde-1)
+   i_start = its
+   j_start = jts
+   IF ( (config_flags%open_xs .or. specified .or. &
+           config_flags%nested ) .and. its == ids ) i_start = its+1
+   IF ( (config_flags%open_xe .or. specified .or. &
+           config_flags%nested ) .and. ite == ide ) itf = itf-1
+   IF ( config_flags%periodic_x ) i_start = its
+   IF ( config_flags%periodic_x ) itf=ite
+
+   DO j = j_start, jtf
+
+     IF ( non_hydrostatic )  THEN
+
+        k=1
+
+        DO i = i_start, itf
+          dpn(i,k) = .5*( cf1*(p(i-1,k  ,j)+p(i,k  ,j))   &
+                         +cf2*(p(i-1,k+1,j)+p(i,k+1,j))   &
+                         +cf3*(p(i-1,k+2,j)+p(i,k+2,j))  )
+          dpn(i,kde) = 0.
+        ENDDO
+        IF (top_lid) THEN
+          DO i = i_start, itf
+            dpn(i,kde) = .5*( cf1*(p(i-1,kde-1,j)+p(i,kde-1,j))   &
+                             +cf2*(p(i-1,kde-2,j)+p(i,kde-2,j))   &
+                             +cf3*(p(i-1,kde-3,j)+p(i,kde-3,j))  )
+          ENDDO
+        ENDIF
+               
+        DO k=2,ktf
+          DO i = i_start, itf
+            dpn(i,k) = .5*( fnm(k)*(p(i-1,k  ,j)+p(i,k  ,j))  &
+                           +fnp(k)*(p(i-1,k-1,j)+p(i,k-1,j)) )
+          END DO
+        END DO
+
+! ADT eqn 44: -mu*(mx/my)*(1/rho)*partial dp/dx
+! [alt, al are 1/rho terms; muu, mu are NOT coupled]
+        DO K=1,ktf
+          DO i = i_start, itf
+            ! Here are mu dp/dy terms 1-3
+            dpx = (msfux(i,j)/msfuy(i,j))*.5*rdx*muu(i,j)*(                    &
+                        (ph (i,k+1,j)-ph (i-1,k+1,j) + ph(i,k,j)-ph(i-1,k,j))  &
+                       +(alt(i,k  ,j)+alt(i-1,k  ,j))*(p (i,k,j)-p (i-1,k,j))  &
+                       +(al (i,k  ,j)+al (i-1,k  ,j))*(pb(i,k,j)-pb(i-1,k,j)) )
+            ! Here is mu dp/dy term 4
+            dpx = dpx + (msfux(i,j)/msfuy(i,j))*rdx*(php(i,k,j)-php(i-1,k,j))* &
+                (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i-1,j)+mu(i,j)))
+            ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx
+          END DO
+        END DO
+
+     ELSE
+
+!       ADT eqn 44: -mu*(mx/my)*(1/rho)*partial dp/dx
+!       [alt, al are 1/rho terms; muu, mu are NOT coupled]
+        DO K=1,ktf
+          DO i = i_start, itf
+            ! Here are mu dp/dy terms 1-3; term 4 not needed if hydrostatic
+            dpx = (msfux(i,j)/msfuy(i,j))*.5*rdx*muu(i,j)*(                    &
+                        (ph (i,k+1,j)-ph (i-1,k+1,j) + ph(i,k,j)-ph(i-1,k,j))  &
+                       +(alt(i,k  ,j)+alt(i-1,k  ,j))*(p (i,k,j)-p (i-1,k,j))  &
+                       +(al (i,k  ,j)+al (i-1,k  ,j))*(pb(i,k,j)-pb(i-1,k,j)) )
+            ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx
+          END DO
+        END DO
+
+     END IF
+
+   ENDDO
+
+END SUBROUTINE horizontal_pressure_gradient
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE pg_buoy_w( rw_tend, p, cqw, mu, mub,       &
+                      rdnw, rdn, g, msftx, msfty,     &
+                      ids, ide, jds, jde, kds, kde,   &
+                      ims, ime, jms, jme, kms, kme,   &
+                      its, ite, jts, jte, kts, kte   )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte 
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::   p
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) ::   cqw
+
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) ::  rw_tend
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: mub, mu, msftx, msfty
+
+   REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: rdnw, rdn
+
+   REAL,  INTENT(IN   ) :: g
+
+   INTEGER :: itf, jtf, i, j, k
+   REAL    :: cq1, cq2
+
+
+!<DESCRIPTION>
+!
+!  pg_buoy_w calculates the 
+!  vertical pressure gradient and buoyancy terms for the large-timestep 
+!  tendency in the vertical momentum equation.
+!
+!</DESCRIPTION>
+
+!  BUOYANCY AND PRESSURE GRADIENT TERM IN W EQUATION AT TIME T
+
+!  Map scale factor notes
+!  ADT eqn 46 RHS terms 6 and 7 (where 7 is "-rho g")
+!  Dividing by my, and using mu and nu (see Klemp et al. eqns 32, 40)
+!  term 6: +(g/my) partial dp'/dnu
+!  term 7: -(g/my) mu'
+!
+!  For moisture-free atmosphere, cq1=1, cq2=0
+!  => (1./msft(i,j)) * g * [rdn(k)*{p(i,k,j)-p(i,k-1,j)}-mu(i,j)]
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   DO j = jts,jtf
+
+     k=kde
+     DO i=its,itf
+       cq1 = 1./(1.+cqw(i,k-1,j))
+       cq2 = cqw(i,k-1,j)*cq1
+       rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msfty(i,j))*g*(      &
+                        cq1*2.*rdnw(k-1)*(  -p(i,k-1,j))  &
+                        -mu(i,j)-cq2*mub(i,j)            )
+     END DO
+
+     DO k = 2, kde-1
+     DO i = its,itf
+      cq1 = 1./(1.+cqw(i,k,j))
+      cq2 = cqw(i,k,j)*cq1
+      cqw(i,k,j) = cq1
+      rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msfty(i,j))*g*(      &
+                       cq1*rdn(k)*(p(i,k,j)-p(i,k-1,j))  &
+                       -mu(i,j)-cq2*mub(i,j)            )
+     END DO
+     ENDDO           
+
+
+   ENDDO
+
+END SUBROUTINE pg_buoy_w
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE w_damp( rw_tend, max_vert_cfl,max_horiz_cfl, &
+                      u, v, ww, w, mut, rdnw,         &
+                      rdx, rdy, msfux, msfuy,         &
+                      msfvx, msfvy, dt,               &
+                      config_flags,                   &
+                      ids, ide, jds, jde, kds, kde,   &
+                      ims, ime, jms, jme, kms, kme,   &
+                      its, ite, jts, jte, kts, kte   )
+
+   USE module_llxy
+   IMPLICIT NONE
+
+   ! Input data
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN   ) ::   u, v, ww, w
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) ::  rw_tend
+
+   REAL, INTENT(OUT) ::  max_vert_cfl
+   REAL, INTENT(OUT) ::  max_horiz_cfl
+   REAL              ::  horiz_cfl
+
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: mut
+
+   REAL, DIMENSION( kms:kme ), INTENT(IN   ) :: rdnw
+
+   REAL, INTENT(IN)    :: dt
+   REAL, INTENT(IN)    :: rdx, rdy
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfux, msfuy
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfvx, msfvy
+
+   REAL                :: vert_cfl, cf_n, cf_d, maxdub, maxdeta
+
+   INTEGER :: itf, jtf, i, j, k, maxi, maxj, maxk
+   INTEGER :: some
+   CHARACTER*512 :: temp
+
+   CHARACTER (LEN=256) :: time_str
+   CHARACTER (LEN=256) :: grid_str
+
+   integer :: total
+   REAL :: msfuxt , msfxffl
+   
+!<DESCRIPTION>
+!
+!  w_damp computes a damping term for the vertical velocity when the
+!  vertical Courant number is too large.  This was found to be preferable to 
+!  decreasing the timestep or increasing the diffusion in real-data applications
+!  that produced potentially-unstable large vertical velocities because of
+!  unphysically large heating rates coming from the cumulus parameterization 
+!  schemes run at moderately high resolutions (dx ~ O(10) km).
+!
+!  Additionally, w_damp returns the maximum cfl values due to vertical motion and
+!  horizontal motion.  These values are returned via the max_vert_cfl and 
+!  max_horiz_cfl variables.  (Added by T. Hutchinson, WSI, 3/5/2007)
+!
+!</DESCRIPTION>
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+
+   some = 0
+   max_vert_cfl = 0.
+   max_horiz_cfl = 0.
+   total = 0
+
+   IF(config_flags%map_proj == PROJ_CASSINI ) then
+     msfxffl = 1.0/COS(config_flags%fft_filter_lat*degrad) 
+   END IF
+
+   IF ( config_flags%w_damping == 1 ) THEN
+     DO j = jts,jtf
+
+     DO k = 2, kde-1
+     DO i = its,itf
+#if 1
+        IF(config_flags%map_proj == PROJ_CASSINI ) then
+           msfuxt = MIN(msfux(i,j), msfxffl)
+        ELSE
+           msfuxt = msfux(i,j)
+        END IF
+        vert_cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt)
+
+        IF ( vert_cfl > max_vert_cfl ) THEN
+           max_vert_cfl = vert_cfl ; maxi = i ; maxj = j ; maxk = k 
+           maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k)
+        ENDIF
+        
+        horiz_cfl = max( abs(u(i,k,j) * rdx * msfuxt * dt),                          &
+             abs(v(i,k,j) * rdy * msfvy(i,j) * dt) )
+        if (horiz_cfl > max_horiz_cfl) then
+           max_horiz_cfl = horiz_cfl
+        endif
+        
+        if(vert_cfl .gt. w_beta)then
+#else
+! restructure to get rid of divide
+!
+! This had been used for efficiency, but with the addition of returning the cfl values, 
+!   the old version (above) was reinstated.  (T. Hutchinson, 3/5/2007)
+!
+        cf_n = abs(ww(i,k,j)*rdnw(k)*dt)
+        cf_d = abs(mut(i,j))
+        if(cf_n .gt. cf_d*w_beta )then
+#endif
+
+           WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k)
+           CALL wrf_debug ( 100 , TRIM(temp) )
+           if ( vert_cfl > 2. ) some = some + 1
+           rw_tend(i,k,j) = rw_tend(i,k,j)-sign(1.,w(i,k,j))*w_alpha*(vert_cfl-w_beta)*mut(i,j)
+        endif
+     END DO
+     ENDDO
+     ENDDO
+   ELSE
+! just print
+     DO j = jts,jtf
+
+     DO k = 2, kde-1
+     DO i = its,itf
+
+#if 1
+        IF(config_flags%map_proj == PROJ_CASSINI ) then
+           msfuxt = MIN(msfux(i,j), msfxffl)
+        ELSE
+           msfuxt = msfux(i,j)
+        END IF
+        vert_cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt)
+        
+        IF ( vert_cfl > max_vert_cfl ) THEN
+           max_vert_cfl = vert_cfl ; maxi = i ; maxj = j ; maxk = k 
+           maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k)
+        ENDIF
+        
+        horiz_cfl = max( abs(u(i,k,j) * rdx * msfuxt * dt),                          &
+             abs(v(i,k,j) * rdy * msfvy(i,j) * dt) )
+
+        if (horiz_cfl > max_horiz_cfl) then
+           max_horiz_cfl = horiz_cfl
+        endif
+        
+        if(vert_cfl .gt. w_beta)then
+#else
+! restructure to get rid of divide
+!
+! This had been used for efficiency, but with the addition of returning the cfl values, 
+!   the old version (above) was reinstated.  (T. Hutchinson, 3/5/2007)
+!
+        cf_n = abs(ww(i,k,j)*rdnw(k)*dt)
+        cf_d = abs(mut(i,j))
+        if(cf_n .gt. cf_d*w_beta )then
+#endif
+           WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k)
+           CALL wrf_debug ( 100 , TRIM(temp) )
+           if ( vert_cfl > 2. ) some = some + 1
+        endif
+     END DO
+     ENDDO
+     ENDDO
+   ENDIF
+   IF ( some .GT. 0 ) THEN
+     CALL get_current_time_string( time_str )
+     CALL get_current_grid_name( grid_str )
+     WRITE(wrf_err_message,*)some,                                            &
+            ' points exceeded cfl=2 in domain '//TRIM(grid_str)//' at time '//TRIM(time_str)//' hours'
+     CALL wrf_debug ( 0 , TRIM(wrf_err_message) )
+     WRITE(wrf_err_message,*)'MAX AT i,j,k: ',maxi,maxj,maxk,' vert_cfl,w,d(eta)=',max_vert_cfl, &
+                             maxdub,maxdeta
+     CALL wrf_debug ( 0 , TRIM(wrf_err_message) )
+   ENDIF
+
+END SUBROUTINE w_damp
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE horizontal_diffusion ( name, field, tendency, mu,           &
+                                  config_flags,                        &
+                                  msfux, msfuy, msfvx, msfvx_inv,      &
+                                  msfvy, msftx, msfty,                 &
+                                  khdif, xkmhd, rdx, rdy,              &
+                                  ids, ide, jds, jde, kds, kde,        &
+                                  ims, ime, jms, jme, kms, kme,        &
+                                  its, ite, jts, jte, kts, kte        )
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,                          INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field, xkmhd
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfux,      &
+                                                                    msfuy,      &
+                                                                    msfvx,      &
+                                                                    msfvx_inv,  &
+                                                                    msfvy,      &
+                                                                    msftx,      &
+                                                                    msfty
+
+   REAL ,                                      INTENT(IN   ) :: rdx,       &
+                                                                rdy,       &
+                                                                khdif
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL :: mrdx, mkrdxm, mkrdxp, &
+           mrdy, mkrdym, mkrdyp
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  horizontal_diffusion computes the horizontal diffusion tendency
+!  on model horizontal coordinate surfaces.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+   IF (name .EQ. 'u') THEN
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         ! The interior is grad: (m_x*d/dx), the exterior is div: (m_x*m_y*d/dx(/m_y))
+         ! setting up different averagings of m^2 partial d/dX and m^2 partial d/dY
+
+         mkrdxm=(msftx(i-1,j)/msfty(i-1,j))*mu(i-1,j)*xkmhd(i-1,k,j)*rdx
+         mkrdxp=(msftx(i,j)/msfty(i,j))*mu(i,j)*xkmhd(i,k,j)*rdx
+         mrdx=msfux(i,j)*msfuy(i,j)*rdx 
+         mkrdym=( (msfuy(i,j)+msfuy(i,j-1))/(msfux(i,j)+msfux(i,j-1)) )* &
+                0.25*(mu(i,j)+mu(i,j-1)+mu(i-1,j-1)+mu(i-1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdy
+         mkrdyp=( (msfuy(i,j)+msfuy(i,j+1))/(msfux(i,j)+msfux(i,j+1)) )* &
+                0.25*(mu(i,j)+mu(i,j+1)+mu(i-1,j+1)+mu(i-1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j+1)+xkmhd(i-1,k,j+1)+xkmhd(i-1,k,j))*rdy
+         ! need to do four-corners (t) for diffusion coefficient as there are
+         ! no values at u,v points
+         ! msfuy - has to be y as part of d/dY
+         !         has to be u as we're at a u point
+         mrdy=msfux(i,j)*msfuy(i,j)*rdy 
+
+         ! correctly averaged version of rho~ * m^2 * 
+         !    [partial d/dX(partial du^/dX) + partial d/dY(partial du^/dY)]
+            tendency(i,k,j)=tendency(i,k,j)+( &
+                            mrdx*(mkrdxp*(field(i+1,k,j)-field(i  ,k,j))  &
+                                 -mkrdxm*(field(i  ,k,j)-field(i-1,k,j))) &
+                           +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j  ))  &
+                                 -mkrdym*(field(i,k,j  )-field(i,k,j-1))))
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ELSE IF (name .EQ. 'v')THEN
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = jte
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+      IF ( config_flags%polar ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%polar ) j_end   = MIN(jde-1,jte)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mkrdxm=( (msfvx(i,j)+msfvx(i-1,j))/(msfvy(i,j)+msfvy(i-1,j)) )*    &
+                0.25*(mu(i,j)+mu(i,j-1)+mu(i-1,j-1)+mu(i-1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdx
+         mkrdxp=( (msfvx(i,j)+msfvx(i+1,j))/(msfvy(i,j)+msfvy(i+1,j)) )*    &
+                0.25*(mu(i,j)+mu(i,j-1)+mu(i+1,j-1)+mu(i+1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i+1,k,j-1)+xkmhd(i+1,k,j))*rdx
+         mrdx=msfvx(i,j)*msfvy(i,j)*rdx
+         mkrdym=(msfty(i,j-1)/msftx(i,j-1))*xkmhd(i,k,j-1)*rdy
+         mkrdyp=(msfty(i,j)/msftx(i,j))*xkmhd(i,k,j)*rdy
+         mrdy=msfvx(i,j)*msfvy(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j)+( &
+                            mrdx*(mkrdxp*(field(i+1,k,j)-field(i  ,k,j))  &
+                                 -mkrdxm*(field(i  ,k,j)-field(i-1,k,j))) &
+                           +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j  ))  &
+                                 -mkrdym*(field(i,k,j  )-field(i,k,j-1))))
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ELSE IF (name .EQ. 'w')THEN
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+      DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+         mkrdxm=(msfux(i,j)/msfuy(i,j))*   &
+                0.25*(mu(i,j)+mu(i-1,j)+mu(i,j)+mu(i-1,j))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i-1,k,j)+xkmhd(i,k-1,j)+xkmhd(i-1,k-1,j))*rdx
+         mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))*   &
+                0.25*(mu(i+1,j)+mu(i,j)+mu(i+1,j)+mu(i,j))* &
+                0.25*(xkmhd(i+1,k,j)+xkmhd(i,k,j)+xkmhd(i+1,k-1,j)+xkmhd(i,k-1,j))*rdx
+         mrdx=msftx(i,j)*msfty(i,j)*rdx
+!         mkrdym=(msfvy(i,j)/msfvx(i,j))*   &
+         mkrdym=(msfvy(i,j)*msfvx_inv(i,j))*   &
+                0.25*(mu(i,j)+mu(i,j-1)+mu(i,j)+mu(i,j-1))* &
+                0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i,k-1,j)+xkmhd(i,k-1,j-1))*rdy
+!         mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))*   &
+         mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))*   &
+                0.25*(mu(i,j+1)+mu(i,j)+mu(i,j+1)+mu(i,j))* &
+                0.25*(xkmhd(i,k,j+1)+xkmhd(i,k,j)+xkmhd(i,k-1,j+1)+xkmhd(i,k-1,j))*rdy
+         mrdy=msftx(i,j)*msfty(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j)+( &
+                            mrdx*(mkrdxp*(field(i+1,k,j)-field(i  ,k,j)) &
+                                 -mkrdxm*(field(i  ,k,j)-field(i-1,k,j))) &
+                           +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j  )) &
+                                 -mkrdym*(field(i,k,j  )-field(i,k,j-1))))
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ELSE
+
+
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mkrdxm=(msfux(i,j)/msfuy(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(mu(i,j)+mu(i-1,j))*rdx
+         mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*0.5*(mu(i+1,j)+mu(i,j))*rdx
+         mrdx=msftx(i,j)*msfty(i,j)*rdx
+!         mkrdym=(msfvy(i,j)/msfvx(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy
+         mkrdym=(msfvy(i,j)*msfvx_inv(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy
+!         mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy
+         mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy
+         mrdy=msftx(i,j)*msfty(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j)+( &
+                            mrdx*(mkrdxp*(field(i+1,k,j)-field(i  ,k,j))  &
+                                 -mkrdxm*(field(i  ,k,j)-field(i-1,k,j))) &
+                           +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j  ))  &
+                                 -mkrdym*(field(i,k,j  )-field(i,k,j-1))))
+      ENDDO
+      ENDDO
+      ENDDO
+           
+   ENDIF
+
+END SUBROUTINE horizontal_diffusion
+
+!-----------------------------------------------------------------------------------------
+
+SUBROUTINE horizontal_diffusion_3dmp ( name, field, tendency, mu,           &
+                                       config_flags, base_3d,               &
+                                       msfux, msfuy, msfvx, msfvx_inv,      &
+                                       msfvy, msftx, msfty,                 &
+                                       khdif, xkmhd, rdx, rdy,              &
+                                       ids, ide, jds, jde, kds, kde,        &
+                                       ims, ime, jms, jme, kms, kme,        &
+                                       its, ite, jts, jte, kts, kte        )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                     ims, ime, jms, jme, kms, kme, &
+                                     its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,                          INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: field, &
+                                                                      xkmhd, &
+                                                                      base_3d
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: mu
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfux,      &
+                                                                    msfuy,      &
+                                                                    msfvx,      &
+                                                                    msfvx_inv,  &
+                                                                    msfvy,      &
+                                                                    msftx,      &
+                                                                    msfty
+
+   REAL ,                                      INTENT(IN   ) :: rdx,       &
+                                                                rdy,       &
+                                                                khdif
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL :: mrdx, mkrdxm, mkrdxp, &
+           mrdy, mkrdym, mkrdyp
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  horizontal_diffusion_3dmp computes the horizontal diffusion tendency
+!  on model horizontal coordinate surfaces.  This routine computes diffusion
+!  a perturbation scalar (field-base_3d).
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+      DO j = j_start, j_end
+      DO k=kts,ktf
+      DO i = i_start, i_end
+
+         mkrdxm=(msfux(i,j)/msfuy(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(mu(i,j)+mu(i-1,j))*rdx
+         mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*0.5*(mu(i+1,j)+mu(i,j))*rdx
+         mrdx=msftx(i,j)*msfty(i,j)*rdx
+!         mkrdym=(msfvy(i,j)/msfvx(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy
+!         mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy
+         mkrdym=(msfvy(i,j)*msfvx_inv(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy
+         mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy
+         mrdy=msftx(i,j)*msfty(i,j)*rdy
+
+            tendency(i,k,j)=tendency(i,k,j)+(                        &
+                    mrdx*( mkrdxp*(   field(i+1,k,j)  -field(i  ,k,j)      &
+                                   -base_3d(i+1,k,j)+base_3d(i  ,k,j) )    &
+                          -mkrdxm*(   field(i  ,k,j)  -field(i-1,k,j)      &
+                                   -base_3d(i  ,k,j)+base_3d(i-1,k,j) )  ) &
+                   +mrdy*( mkrdyp*(   field(i,k,j+1)  -field(i,k,j  )      &
+                                   -base_3d(i,k,j+1)+base_3d(i,k,j  ) )    &
+                          -mkrdym*(   field(i,k,j  )  -field(i,k,j-1)      &
+                                   -base_3d(i,k,j  )+base_3d(i,k,j-1) )  ) &
+                                                                         ) 
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE horizontal_diffusion_3dmp
+
+!-----------------------------------------------------------------------------------------
+
+SUBROUTINE vertical_diffusion ( name, field, tendency,        &
+                                config_flags,                 &
+                                alt, mut, rdn, rdnw, kvdif,   &
+                                ids, ide, jds, jde, kds, kde, &
+                                ims, ime, jms, jme, kms, kme, &
+                                its, ite, jts, jte, kts, kte )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,                          INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: mut
+
+   REAL , DIMENSION( kms:kme ) ,                   INTENT(IN   ) :: rdn, rdnw
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, jts:jte) :: vfluxm, vfluxp, zz
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion
+!  computes vertical diffusion tendency.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+   IF (name .EQ. 'w')THEN
+
+   
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+j_loop_w : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+          vflux(i,k)= (kvdif/alt(i,k,j))*rdnw(k)*(field(i,k+1,j)-field(i,k,j))
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts+1,ktf
+       DO i = i_start, i_end
+            tendency(i,k,j)=tendency(i,k,j)                                         &
+                              +rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j)))  &
+                                         *(vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+    ENDDO j_loop_w
+
+   ELSE IF(name .EQ. 'm')THEN
+
+     i_start = its
+     i_end   = MIN(ite,ide-1)
+     j_start = jts
+     j_end   = MIN(jte,jde-1)
+
+j_loop_s : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))   &
+                  *(field(i,k+1,j)-field(i,k,j))
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf
+       DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)  &
+                *rdnw(k)*(vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_s
+
+   ENDIF
+
+END SUBROUTINE vertical_diffusion
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE vertical_diffusion_mp ( field, tendency, config_flags, &
+                                   base,                          &
+                                   alt, mut, rdn, rdnw, kvdif,    &
+                                   ids, ide, jds, jde, kds, kde,  &
+                                   ims, ime, jms, jme, kms, kme,  &
+                                   its, ite, jts, jte, kts, kte  )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: mut
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: rdn,  &
+                                                                  rdnw, &
+                                                                  base
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion_mp
+!  computes vertical diffusion tendency of a perturbation variable
+!  (field-base).  Note that base as a 1D (k) field.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+     i_start = its
+     i_end   = MIN(ite,ide-1)
+     j_start = jts
+     j_end   = MIN(jte,jde-1)
+
+j_loop_s : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))   &
+                    *(field(i,k+1,j)-field(i,k,j)-base(k+1)+base(k))
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf
+       DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)  &
+                *rdnw(k)*(vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_s
+
+END SUBROUTINE vertical_diffusion_mp
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE vertical_diffusion_3dmp ( field, tendency, config_flags, &
+                                     base_3d,                       &
+                                     alt, mut, rdn, rdnw, kvdif,    &
+                                     ids, ide, jds, jde, kds, kde,  &
+                                     ims, ime, jms, jme, kms, kme,  &
+                                     its, ite, jts, jte, kts, kte  )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt,      &
+                                                                base_3d
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: mut
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: rdn,  &
+                                                                  rdnw
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion_3dmp
+!  computes vertical diffusion tendency of a perturbation variable
+!  (field-base_3d).  
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+     i_start = its
+     i_end   = MIN(ite,ide-1)
+     j_start = jts
+     j_end   = MIN(jte,jde-1)
+
+j_loop_s : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))   &
+                    *(   field(i,k+1,j)  -field(i,k,j)               &
+                      -base_3d(i,k+1,j)+base_3d(i,k,j) )
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf
+       DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)  &
+                *rdnw(k)*(vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_s
+
+END SUBROUTINE vertical_diffusion_3dmp
+
+
+!-------------------------------------------------------------------------------
+
+
+SUBROUTINE vertical_diffusion_u ( field, tendency,              &
+                                  config_flags, u_base,         &
+                                  alt, muu, rdn, rdnw, kvdif,   &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: muu
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: rdn, rdnw, u_base
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz, zz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion_u computes vertical diffusion tendency for 
+!  the u momentum equation.  This routine assumes a constant eddy
+!  viscosity kvdif.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
+      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+
+j_loop_u : DO j = j_start, j_end
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i  ,k  ,j)      &
+                                        +alt(i-1,k  ,j)      &
+                                        +alt(i  ,k+1,j)      &
+                                        +alt(i-1,k+1,j) ) )  &
+                             *(field(i,k+1,j)-field(i,k,j)   &
+                               -u_base(k+1)   +u_base(k)  )
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         tendency(i,k,j)=tendency(i,k,j)+                             &
+                g*g*rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j)))* &
+                              (vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_u
+   
+END SUBROUTINE vertical_diffusion_u
+
+!-------------------------------------------------------------------------------
+
+
+SUBROUTINE vertical_diffusion_v ( field, tendency,              &
+                                  config_flags, v_base,         &
+                                  alt, muv, rdn, rdnw, kvdif,   &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,    INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                      &
+                                               INTENT(IN   ) :: field,    &
+                                                                alt
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: rdn, rdnw, v_base
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: muv
+
+   REAL ,                                      INTENT(IN   ) :: kvdif
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf, jm1
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION(its:ite, 0:kte+1) :: vflux
+
+   REAL :: rdz, zz
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  vertical_diffusion_v computes vertical diffusion tendency for 
+!  the v momentum equation.  This routine assumes a constant eddy
+!  viscosity kvdif.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+   
+      i_start = its
+      i_end   = MIN(ite,ide-1)
+      j_start = jts
+      j_end   = MIN(jte,jde-1)
+
+      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
+      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)
+
+j_loop_v : DO j = j_start, j_end
+!     jm1 = max(j-1,1)
+     jm1 = j-1
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end
+         vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i,k  ,j  )      &
+                                        +alt(i,k  ,jm1)      &
+                                        +alt(i,k+1,j  )      &
+                                        +alt(i,k+1,jm1) ) )  &
+                             *(field(i,k+1,j)-field(i,k,j)   &
+                               -v_base(k+1)   +v_base(k)  )
+       ENDDO
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,0)=vflux(i,1)
+     ENDDO
+
+     DO i = i_start, i_end
+       vflux(i,ktf)=0.
+     ENDDO
+
+     DO k=kts,ktf-1
+       DO i = i_start, i_end 
+         tendency(i,k,j)=tendency(i,k,j)+                              &
+                g*g*rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j)))*  &
+                              (vflux(i,k)-vflux(i,k-1))
+       ENDDO
+     ENDDO
+
+ ENDDO j_loop_v
+   
+END SUBROUTINE vertical_diffusion_v
+
+!***************  end new mass coordinate routines
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE calculate_full ( rfield, rfieldb, rfieldp,     &
+                            ids, ide, jds, jde, kds, kde, &
+                            ims, ime, jms, jme, kms, kme, &
+                            its, ite, jts, jte, kts, kte )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   INTEGER ,      INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte 
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: rfieldb, &
+                                                                      rfieldp
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT  ) :: rfield
+   
+   ! Local indices.
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   
+!<DESCRIPTION>
+!
+!  calculate_full
+!  calculates full 3D field from pertubation and base field.
+!
+!</DESCRIPTION>
+
+   itf=MIN(ite,ide-1)
+   jtf=MIN(jte,jde-1)
+   ktf=MIN(kte,kde-1)
+
+   DO j=jts,jtf
+   DO k=kts,ktf
+   DO i=its,itf
+      rfield(i,k,j)=rfieldb(i,k,j)+rfieldp(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE calculate_full
+
+!------------------------------------------------------------------------------
+
+SUBROUTINE coriolis ( ru, rv, rw, ru_tend, rv_tend, rw_tend, &
+                      config_flags,                          &
+                      msftx, msfty, msfux, msfuy,            &
+                      msfvx, msfvy,                          &
+                      f, e, sina, cosa, fzm, fzp,            &
+                      ids, ide, jds, jde, kds, kde,          &
+                      ims, ime, jms, jme, kms, kme,          &
+                      its, ite, jts, jte, kts, kte          )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type) ,           INTENT(IN   ) :: config_flags   
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: ru_tend, &
+                                                                rv_tend, &
+                                                                rw_tend
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: ru, &
+                                                                rv, &
+                                                                rw
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfux,      &
+                                                                msfuy,      &
+                                                                msfvx,      &
+                                                                msfvy,      &
+                                                                msftx,      &
+                                                                msfty
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: f,    &
+                                                                    e,    &
+                                                                    sina, &
+                                                                    cosa
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm, &
+                                                                  fzp
+   
+   ! Local indices.
+   
+   INTEGER :: i, j , k, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  coriolis calculates the large timestep tendency terms in the 
+!  u, v, and w momentum equations arise from the coriolis force.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+
+! coriolis for u-momentum equation
+
+!  Notes on map scale factor
+!  cosa, sina are related to rotating the coordinate frame if desired
+!  generally sina=0, cosa=1
+!  ADT eqn 44, RHS terms 6 and 7: -2 mu w omega cos(lat)/my
+!                                + 2 mu v omega sin(lat)/my
+!  Define f=2 omega sin(lat), e=2 omega cos(lat)
+!   => terms are: -e mu w / my + f mu v / my
+!  rv = mu v / mx ; rw = mu w / my
+!   => terms are: -e rw + f rv *mx / my
+
+   i_start = its
+   i_end   = ite
+   IF ( config_flags%open_xs .or. specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+   DO j = jts, MIN(jte,jde-1)
+
+   DO k=kts,ktf
+   DO i = i_start, i_end
+   
+     ru_tend(i,k,j)=ru_tend(i,k,j) + (msfux(i,j)/msfuy(i,j))*0.5*(f(i,j)+f(i-1,j)) &
+       *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) &
+           - 0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j)) &
+       *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
+
+   ENDDO
+   ENDDO
+
+   IF ( (config_flags%open_xs) .and. (its == ids) ) THEN
+
+     DO k=kts,ktf
+   
+       ru_tend(its,k,j)=ru_tend(its,k,j) + (msfux(its,j)/msfuy(its,j))*0.5*(f(its,j)+f(its,j))   &
+         *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j)) &
+             - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j)) &
+         *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j))
+
+     ENDDO
+
+   ENDIF
+
+   IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN
+
+     DO k=kts,ktf
+   
+       ru_tend(ite,k,j)=ru_tend(ite,k,j) + (msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1,j)+f(ite-1,j)) &
+         *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j)) &
+             - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j)) &
+         *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j))
+
+     ENDDO
+
+   ENDIF
+
+   ENDDO
+
+!  coriolis term for v-momentum equation
+
+!  Notes on map scale factors
+!  ADT eqn 45, RHS terms 6 and 6b [0 for sina=0]: -2 mu u omega sin(lat)/mx + ?
+!  Define f=2 omega sin(lat), e=2 omega cos(lat)
+!   => terms are: -f mu u / mx
+!  ru = mu u / my ; rw = mu w / my
+!   => terms are: -f ru *my / mx + ?
+
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) j_end   = MIN(jde-1,jte)
+
+   IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN
+
+     DO k=kts,ktf
+     DO i=its,MIN(ide-1,ite)
+   
+        rv_tend(i,k,jts)=rv_tend(i,k,jts) - (msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts)+f(i,jts))    &
+         *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts))   &
+             + (msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts))   &
+             *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) 
+
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   DO j=j_start, j_end
+   DO k=kts,ktf
+   DO i=its,MIN(ide-1,ite)
+   
+      rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*0.5*(f(i,j)+f(i,j-1))    &
+       *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) &
+           + (msfvy(i,j)/msfvx(i,j))*0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)+sina(i,j-1)) &
+           *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) 
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+
+   IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN
+
+     DO k=kts,ktf
+     DO i=its,MIN(ide-1,ite)
+   
+        rv_tend(i,k,jte)=rv_tend(i,k,jte) - (msfvy(i,jte)/msfvx(i,jte))*0.5*(f(i,jte-1)+f(i,jte-1))        &
+         *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1))   &
+             + (msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1))   &
+             *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) 
+
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+! coriolis term for w-mometum 
+
+! Notes on map scale factors
+! ADT eqn 46/my, RHS terms 5 and 5b [0 for sina=0]: 2 mu u omega cos(lat)/my +?
+! Define e=2 omega cos(lat)
+!  => terms are: e mu u / my + ???
+! ru = mu u / my ; ru = mu v / mx
+!  => terms are: e ru + ???
+
+   DO j=jts,MIN(jte, jde-1)
+   DO k=kts+1,ktf
+   DO i=its,MIN(ite, ide-1)
+
+       rw_tend(i,k,j)=rw_tend(i,k,j) + e(i,j)*           &
+          (cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j)) &
+          +fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))           &
+          -(msftx(i,j)/msfty(i,j))*                      &
+           sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1)) &
+          +fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE coriolis
+
+!------------------------------------------------------------------------------
+
+SUBROUTINE perturbation_coriolis ( ru_in, rv_in, rw, ru_tend, rv_tend, rw_tend, &
+                                   config_flags,                                &
+                                   u_base, v_base, z_base,                      &
+                                   muu, muv, phb, ph,                           &
+                                   msftx, msfty, msfux, msfuy, msfvx, msfvy,    &
+                                   f, e, sina, cosa, fzm, fzp,                  &
+                                   ids, ide, jds, jde, kds, kde,                &
+                                   ims, ime, jms, jme, kms, kme,                &
+                                   its, ite, jts, jte, kts, kte                )
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   TYPE(grid_config_rec_type) ,           INTENT(IN   ) :: config_flags   
+
+   INTEGER ,                 INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                              ims, ime, jms, jme, kms, kme, &
+                                              its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: ru_tend, &
+                                                                rv_tend, &
+                                                                rw_tend
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: ru_in, &
+                                                                      rv_in, &
+                                                                      rw,    &
+                                                                      ph,    &
+                                                                      phb
+
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfux,      &
+                                                                msfuy,      &
+                                                                msfvx,      &
+                                                                msfvy,      &
+                                                                msftx,      &
+                                                                msfty
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: f,    &
+                                                                    e,    &
+                                                                    sina, &
+                                                                    cosa
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: muu, &
+                                                                    muv
+                                                                    
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm, &
+                                                                  fzp
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: u_base,  &
+                                                                  v_base,  &
+                                                                  z_base
+   
+   ! Local storage
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: ru, &
+                                                      rv
+
+   REAL  :: z_at_u, z_at_v, wkp1, wk, wkm1
+
+   ! Local indices.
+   
+   INTEGER :: i, j , k, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+   
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  perturbation_coriolis calculates the large timestep tendency terms in the 
+!  u, v, and w momentum equations arise from the coriolis force.  This version
+!  subtracts off the horizontal velocities from the initial sounding when
+!  computing the forcing terms, hence "perturbation" coriolis.
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+   ktf=MIN(kte,kde-1)
+
+! coriolis for u-momentum equation
+
+   i_start = its
+   i_end   = ite
+   IF ( config_flags%open_xs .or. specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+!  compute perturbation mu*v for use in u momentum equation
+
+   DO j = jts, MIN(jte,jde-1)+1
+   DO k=kts+1,ktf-1
+   DO i = i_start-1, i_end
+     z_at_v = 0.25*( phb(i,k,j  )+phb(i,k+1,j  )  &
+                    +phb(i,k,j-1)+phb(i,k+1,j-1)  &
+                    +ph(i,k,j  )+ph(i,k+1,j  )    &
+                    +ph(i,k,j-1)+ph(i,k+1,j-1))/g
+     wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
+     wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
+     wk   = 1.-wkp1-wkm1
+     rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*(            &
+                                  wkm1*v_base(k-1)    &
+                                 +wk  *v_base(k  )    &
+                                 +wkp1*v_base(k+1)   )
+   ENDDO
+   ENDDO
+   ENDDO
+
+
+!  pick up top and bottom v 
+
+   DO j = jts, MIN(jte,jde-1)+1
+   DO i = i_start-1, i_end
+
+     k = kts
+     z_at_v = 0.25*( phb(i,k,j  )+phb(i,k+1,j  )  &
+                    +phb(i,k,j-1)+phb(i,k+1,j-1)  &
+                    +ph(i,k,j  )+ph(i,k+1,j  )    &
+                    +ph(i,k,j-1)+ph(i,k+1,j-1))/g
+     wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
+     wk   = 1.-wkp1
+     rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*(            &
+                                 +wk  *v_base(k  )    &
+                                 +wkp1*v_base(k+1)   )
+
+     k = ktf
+     z_at_v = 0.25*( phb(i,k,j  )+phb(i,k+1,j  )  &
+                    +phb(i,k,j-1)+phb(i,k+1,j-1)  &
+                    +ph(i,k,j  )+ph(i,k+1,j  )    &
+                    +ph(i,k,j-1)+ph(i,k+1,j-1))/g
+     wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
+     wk   = 1.-wkm1
+     rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*(            &
+                                  wkm1*v_base(k-1)    &
+                                 +wk  *v_base(k  )   )
+
+   ENDDO
+   ENDDO
+
+!  compute coriolis forcing for u
+
+!  Map scale factors: see comments above for Coriolis
+
+   DO j = jts, MIN(jte,jde-1)
+
+   DO k=kts,ktf
+     DO i = i_start, i_end
+       ru_tend(i,k,j)=ru_tend(i,k,j) + (msfux(i,j)/msfuy(i,j))*0.5*(f(i,j)+f(i-1,j)) &
+         *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) &
+             - 0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j)) &
+         *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
+     ENDDO
+   ENDDO
+
+   IF ( (config_flags%open_xs) .and. (its == ids) ) THEN
+
+     DO k=kts,ktf
+   
+       ru_tend(its,k,j)=ru_tend(its,k,j) + (msfux(its,j)/msfuy(its,j))*0.5*(f(its,j)+f(its,j))   &
+         *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j)) &
+             - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j)) &
+         *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j))
+
+     ENDDO
+
+   ENDIF
+
+   IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN
+
+     DO k=kts,ktf
+   
+       ru_tend(ite,k,j)=ru_tend(ite,k,j) + (msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1,j)+f(ite-1,j)) &
+         *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j)) &
+             - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j)) &
+         *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j))
+
+     ENDDO
+
+   ENDIF
+
+   ENDDO
+
+!  coriolis term for v-momentum equation
+!  Map scale factors: see comments above for Coriolis
+
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) j_end   = MIN(jde-1,jte)
+
+!  compute perturbation mu*u for use in v momentum equation
+
+   DO j = j_start-1,j_end
+   DO k=kts+1,ktf-1
+   DO i = its, MIN(ite,ide-1)+1
+     z_at_u = 0.25*( phb(i  ,k,j)+phb(i  ,k+1,j)  &
+                    +phb(i-1,k,j)+phb(i-1,k+1,j)  &
+                    +ph(i  ,k,j)+ph(i  ,k+1,j)    &
+                    +ph(i-1,k,j)+ph(i-1,k+1,j))/g
+     wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
+     wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
+     wk   = 1.-wkp1-wkm1
+     ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*(            &
+                                  wkm1*u_base(k-1)    &
+                                 +wk  *u_base(k  )    &
+                                 +wkp1*u_base(k+1)   )
+   ENDDO
+   ENDDO
+   ENDDO
+
+!  pick up top and bottom u
+
+   DO j = j_start-1,j_end
+   DO i = its, MIN(ite,ide-1)+1
+
+     k = kts
+     z_at_u = 0.25*( phb(i  ,k,j)+phb(i  ,k+1,j)  &
+                    +phb(i-1,k,j)+phb(i-1,k+1,j)  &
+                    +ph(i  ,k,j)+ph(i  ,k+1,j)    &
+                    +ph(i-1,k,j)+ph(i-1,k+1,j))/g
+     wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
+     wk   = 1.-wkp1
+     ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*(            &
+                                 +wk  *u_base(k  )    &
+                                 +wkp1*u_base(k+1)   )
+
+
+     k = ktf
+     z_at_u = 0.25*( phb(i  ,k,j)+phb(i  ,k+1,j)  &
+                    +phb(i-1,k,j)+phb(i-1,k+1,j)  &
+                    +ph(i  ,k,j)+ph(i  ,k+1,j)    &
+                    +ph(i-1,k,j)+ph(i-1,k+1,j))/g
+     wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
+     wk   = 1.-wkm1
+     ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*(            &
+                                  wkm1*u_base(k-1)    &
+                                 +wk  *u_base(k  )   )
+
+   ENDDO
+   ENDDO
+
+!  compute coriolis forcing for v momentum equation
+!  Map scale factors: see comments above for Coriolis
+
+   IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN
+
+     DO k=kts,ktf
+     DO i=its,MIN(ide-1,ite)
+   
+        rv_tend(i,k,jts)=rv_tend(i,k,jts) - (msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts)+f(i,jts))    &
+         *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts))   &
+             + (msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts))   &
+             *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) 
+
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   DO j=j_start, j_end
+   DO k=kts,ktf
+   DO i=its,MIN(ide-1,ite)
+   
+      rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*0.5*(f(i,j)+f(i,j-1))    &
+       *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) &
+           + (msfvy(i,j)/msfvx(i,j))*0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)+sina(i,j-1)) &
+           *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) 
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+
+   IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN
+
+     DO k=kts,ktf
+     DO i=its,MIN(ide-1,ite)
+   
+        rv_tend(i,k,jte)=rv_tend(i,k,jte) - (msfvy(i,jte)/msfvx(i,jte))*0.5*(f(i,jte-1)+f(i,jte-1))        &
+         *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1))   &
+             + (msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1))   &
+             *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) 
+
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+! coriolis term for w-mometum 
+!  Map scale factors: see comments above for Coriolis
+
+   DO j=jts,MIN(jte, jde-1)
+   DO k=kts+1,ktf
+   DO i=its,MIN(ite, ide-1)
+
+       rw_tend(i,k,j)=rw_tend(i,k,j) + e(i,j)*           &
+          (cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j)) &
+          +fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))           &
+          -(msftx(i,j)/msfty(i,j))*sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1)) &
+          +fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE perturbation_coriolis
+
+!------------------------------------------------------------------------------
+
+SUBROUTINE curvature ( ru, rv, rw, u, v, w, ru_tend, rv_tend, rw_tend, &
+                        config_flags,                                       &
+                        msfux, msfuy, msfvx, msfvy, msftx, msfty,       &
+                        xlat, fzm, fzp, rdx, rdy,                       &
+                        ids, ide, jds, jde, kds, kde,                   &
+                        ims, ime, jms, jme, kms, kme,                   &
+                        its, ite, jts, jte, kts, kte                   )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+
+   TYPE(grid_config_rec_type) ,           INTENT(IN   ) :: config_flags   
+
+   INTEGER ,                  INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                               ims, ime, jms, jme, kms, kme, &
+                                               its, ite, jts, jte, kts, kte
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                     &
+                                               INTENT(INOUT) :: ru_tend, &
+                                                                rv_tend, &
+                                                                rw_tend
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                     &
+                                               INTENT(IN   ) :: ru,      &
+                                                                rv,      &
+                                                                rw,      &
+                                                                u,       &
+                                                                v,       &
+                                                                w
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfux,    &
+                                                                msfuy,    &
+                                                                msfvx,    &
+                                                                msfvy,    &
+                                                                msftx,    &
+                                                                msfty,    &
+                                                                xlat
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fzm,     &
+                                                                fzp
+
+   REAL ,                                      INTENT(IN   ) :: rdx,     &
+                                                                rdy
+   
+   ! Local data
+   
+!   INTEGER :: i, j, k, itf, jtf, ktf, kp1, im, ip, jm, jp
+   INTEGER :: i, j, k, itf, jtf, ktf
+   INTEGER :: i_start, i_end, j_start, j_end
+!   INTEGER :: irmin, irmax, jrmin, jrmax
+
+   REAL , DIMENSION( its-1:ite , kts:kte, jts-1:jte ) :: vxgm
+
+   LOGICAL :: specified
+
+!<DESCRIPTION>
+!
+!  curvature calculates the large timestep tendency terms in the 
+!  u, v, and w momentum equations arise from the curvature terms.  
+!
+!</DESCRIPTION>
+
+   specified = .false.
+   if(config_flags%specified .or. config_flags%nested) specified = .true.
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+
+!   irmin = ims
+!   irmax = ime
+!   jrmin = jms
+!   jrmax = jme
+!   IF ( config_flags%open_xs ) irmin = ids
+!   IF ( config_flags%open_xe ) irmax = ide-1
+!   IF ( config_flags%open_ys ) jrmin = jds
+!   IF ( config_flags%open_ye ) jrmax = jde-1
+   
+! Define v cross grad m at scalar points - vxgm(i,j)
+
+   i_start = its-1
+   i_end   = ite
+   j_start = jts-1
+   j_end   = jte
+
+   IF ( ( config_flags%open_xs .or. specified .or. &
+        config_flags%nested) .and. (its == ids) ) i_start = its
+   IF ( ( config_flags%open_xe .or. specified .or. &
+        config_flags%nested) .and. (ite == ide) ) i_end   = ite-1
+   IF ( ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) .and. (jts == jds) ) j_start = jts
+   IF ( ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) .and. (jte == jde) ) j_end   = jte-1
+      IF ( config_flags%periodic_x ) i_start = its-1
+      IF ( config_flags%periodic_x ) i_end = ite
+
+   DO j=j_start, j_end
+   DO k=kts,ktf
+   DO i=i_start, i_end
+!     Map scale factor notes:
+!     msf...y is constant everywhere for cylindrical map projection
+!     msf...x varies with y only
+!     But we know that this is not = 0 for cylindrical,
+!     therefore use msfvX in 1st line
+!     which => by symmetry use msfuY in 2nd line - ???  
+      vxgm(i,k,j)=0.5*(u(i,k,j)+u(i+1,k,j))*(msfvx(i,j+1)-msfvx(i,j))*rdy - &
+                  0.5*(v(i,k,j)+v(i,k,j+1))*(msfuy(i+1,j)-msfuy(i,j))*rdx
+   ENDDO
+   ENDDO
+   ENDDO
+
+!  Pick up the boundary rows for open (radiation) lateral b.c.
+!  Rather crude at present, we are assuming there is no
+!    variation in this term at the boundary.
+
+   IF ( ( config_flags%open_xs .or. (specified .AND. .NOT. config_flags%periodic_x) .or. &
+        config_flags%nested) .and. (its == ids) ) THEN
+
+     DO j = jts, jte-1
+     DO k = kts, ktf
+       vxgm(its-1,k,j) =  vxgm(its,k,j)
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+   IF ( ( config_flags%open_xe .or. (specified .AND. .NOT. config_flags%periodic_x) .or. &
+        config_flags%nested) .and. (ite == ide) ) THEN
+
+     DO j = jts, jte-1
+     DO k = kts, ktf
+       vxgm(ite,k,j) =  vxgm(ite-1,k,j)
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+!  Polar boundary condition:
+!  The following change is needed in case one tries using the vxgm route with
+!  polar B.C.'s in the future, but not needed if 'tan' used
+   IF ( ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) .and. (jts == jds) ) THEN
+
+     DO k = kts, ktf
+     DO i = its-1, ite
+       vxgm(i,k,jts-1) =  vxgm(i,k,jts)
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+!  Polar boundary condition:
+!  The following change is needed in case one tries using the vxgm route with
+!  polar B.C.'s in the future, but not needed if 'tan' used
+   IF ( ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) .and. (jte == jde) ) THEN
+
+     DO k = kts, ktf
+     DO i = its-1, ite
+       vxgm(i,k,jte) =  vxgm(i,k,jte-1)
+     ENDDO
+     ENDDO
+
+   ENDIF
+
+!  curvature term for u momentum eqn.
+
+!  Map scale factor notes:
+!  ADT eqn 44, RHS terms 4 and 5, in cylindrical: mu u v tan(lat)/(a my)
+!                                               - mu u w /(a my)
+!  ru = mu u / my ; rw = mu w / my ; rv = mu v / mx
+!   => terms are:
+!  (mx/my)*u rv tan(lat) / a - u rw / a = (u/a)*[(mx/my) rv tan(lat) - rw]
+!  ru v tan(lat) / a - u rw / a
+!  xlat defined with end points half grid space from pole,
+!  hence are on u latitude points
+
+   i_start = its
+   IF ( config_flags%open_xs .or. specified .or. &
+        config_flags%nested) i_start = MAX ( ids+1 , its )
+   IF ( config_flags%open_xe .or. specified .or. &
+        config_flags%nested) i_end   = MIN ( ide-1 , ite )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+!  Polar boundary condition
+   IF ((config_flags%map_proj == 6) .OR. (config_flags%polar)) THEN
+
+      DO j=jts,MIN(jde-1,jte)
+      DO k=kts,ktf
+      DO i=i_start,i_end
+
+            ru_tend(i,k,j)=ru_tend(i,k,j) + u(i,k,j)*reradius*                 ( &
+                        (msfux(i,j)/msfuy(i,j))*0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+ &
+                                    rv(i-1,k,j)+rv(i,k,j))*tan(xlat(i,j)*degrad) &
+                        - 0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j)) )
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE  ! normal code
+
+
+      DO j=jts,MIN(jde-1,jte)
+      DO k=kts,ktf
+      DO i=i_start,i_end
+
+         ru_tend(i,k,j)=ru_tend(i,k,j) + 0.5*(vxgm(i,k,j)+vxgm(i-1,k,j)) &
+                 *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) &
+                  - u(i,k,j)*reradius &
+                 *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+   END IF
+
+!  curvature term for v momentum eqn.
+
+!  Map scale factor notes
+!  ADT eqn 45, RHS terms 4 and 5, in cylindrical: mu u*u tan(lat)/(a mx)
+!                                               - mu v w /(a mx)
+!  ru = mu u / my ; rw = mu w / my ; rv = mu v / mx
+!  terms are:
+!  (my/mx)*u ru tan(lat) / a - (my/mx)*v rw / a 
+!  = [my/(mx*a)]*[u ru tan(lat) - v rw]
+!  (1/a)*[(my/mx)*u ru tan(lat) - w rv]
+!  xlat defined with end points half grid space from pole, hence are on
+!  u latitude points => av here
+!
+!  in original wrf, there was a sign error for the rw contribution
+
+   j_start = jts
+   IF ( config_flags%open_ys .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) j_start = MAX ( jds+1 , jts )
+   IF ( config_flags%open_ye .or. specified .or. &
+        config_flags%nested .or. config_flags%polar) j_end   = MIN ( jde-1 , jte )
+
+   IF ((config_flags%map_proj == 6) .OR. (config_flags%polar)) THEN
+
+      DO j=j_start,j_end
+      DO k=kts,ktf
+      DO i=its,MIN(ite,ide-1)
+            rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*reradius*   (  &
+                        0.25*(u(i,k,j)+u(i+1,k,j)+u(i,k,j-1)+u(i+1,k,j-1))*     &
+                        tan((xlat(i,j)+xlat(i,j-1))*0.5*degrad)*                &
+                        0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1))  &
+                       - v(i,k,j)*0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+              &
+                                                      rw(i,k+1,j)+rw(i,k,j))    )
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE  ! normal code
+
+      DO j=j_start,j_end
+      DO k=kts,ktf
+      DO i=its,MIN(ite,ide-1)
+
+         rv_tend(i,k,j)=rv_tend(i,k,j) - 0.5*(vxgm(i,k,j)+vxgm(i,k,j-1)) &
+                 *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) &
+                       - (msfvy(i,j)/msfvx(i,j))*v(i,k,j)*reradius       &
+                 *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j))
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+   END IF
+
+!  curvature term for vertical momentum eqn.
+
+!  Notes on map scale factors:
+!  ADT eqn 46, RHS term 4: [mu/(a my)]*[u*u + v*v]
+!  ru = mu u / my ; rw = mu w / my ; rv = mu v / mx
+!  terms are: u ru / a + (mx/my)v rv / a
+
+   DO j=jts,MIN(jte,jde-1)
+   DO k=MAX(2,kts),ktf
+   DO i=its,MIN(ite,ide-1)
+
+      rw_tend(i,k,j)=rw_tend(i,k,j) + reradius*                              &
+    (0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j))) &
+    *0.5*(fzm(k)*( u(i,k,j) +u(i+1,k,j))+fzp(k)*( u(i,k-1,j) +u(i+1,k-1,j)))     &
+    +(msftx(i,j)/msfty(i,j))*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))) &
+    *0.5*(fzm(k)*( v(i,k,j) +v(i,k,j+1))+fzp(k)*( v(i,k-1,j) +v(i,k-1,j+1))))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE curvature
+
+!------------------------------------------------------------------------------
+
+SUBROUTINE decouple ( rr, rfield, field, name, config_flags, &
+                      fzm, fzp,                          &
+                      ids, ide, jds, jde, kds, kde,      &
+                      ims, ime, jms, jme, kms, kme,      &
+                      its, ite, jts, jte, kts, kte      )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+   TYPE(grid_config_rec_type) ,           INTENT(IN   ) :: config_flags   
+
+   INTEGER ,                                   INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                                                ims, ime, jms, jme, kms, kme, &
+                                                                its, ite, jts, jte, kts, kte
+
+   CHARACTER(LEN=1) ,                          INTENT(IN   ) :: name
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: rfield
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) :: rr
+   
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT  ) :: field
+   
+   REAL , DIMENSION( kms:kme ) , INTENT(IN   ) :: fzm, fzp
+   
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+   
+!<DESCRIPTION>
+!
+!  decouple decouples a variable from the column dry-air mass.
+!
+!</DESCRIPTION>
+
+   ktf=MIN(kte,kde-1)
+   
+   IF (name .EQ. 'u')THEN
+      itf=ite
+      jtf=MIN(jte,jde-1)
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         field(i,k,j)=rfield(i,k,j)/(0.5*(rr(i,k,j)+rr(i-1,k,j)))
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'v')THEN
+      itf=MIN(ite,ide-1)
+      jtf=jte
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+        DO i=its,itf
+             field(i,k,j)=rfield(i,k,j)/(0.5*(rr(i,k,j)+rr(i,k,j-1)))
+        ENDDO
+      ENDDO
+      ENDDO
+
+   ELSE IF (name .EQ. 'w')THEN
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      DO j=jts,jtf
+      DO k=kts+1,ktf
+      DO i=its,itf
+         field(i,k,j)=rfield(i,k,j)/(fzm(k)*rr(i,k,j)+fzp(k)*rr(i,k-1,j))
+      ENDDO
+      ENDDO
+      ENDDO
+
+      DO j=jts,jtf
+      DO i=its,itf
+        field(i,kte,j) = 0.
+      ENDDO
+      ENDDO
+
+   ELSE 
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+   ! For theta we will decouple tb and tp and add them to give t afterwards
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         field(i,k,j)=rfield(i,k,j)/rr(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+   
+   ENDIF
+
+END SUBROUTINE decouple
+
+!-------------------------------------------------------------------------------
+
+
+SUBROUTINE zero_tend ( tendency,                     &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte )
+
+
+   IMPLICIT NONE
+   
+   ! Input data
+   
+   INTEGER ,                                   INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                                                ims, ime, jms, jme, kms, kme, &
+                                                                its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
+
+   ! Local data
+   
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+!<DESCRIPTION>
+!
+!  zero_tend sets the input tendency array to zero.
+!
+!</DESCRIPTION>
+
+      DO j = jts, jte
+      DO k = kts, kte
+      DO i = its, ite
+        tendency(i,k,j) = 0.
+      ENDDO
+      ENDDO
+      ENDDO
+
+      END SUBROUTINE zero_tend
+
+!-------------------------------------------------------------------------------
+! Sets the an array on the polar v point(s) to zero
+SUBROUTINE zero_pole ( field,                        &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte )
+
+
+  IMPLICIT NONE
+
+  ! Input data
+   
+  INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                             ims, ime, jms, jme, kms, kme, &
+                             its, ite, jts, jte, kts, kte
+
+  REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: field
+
+  ! Local data
+
+  INTEGER :: i, k
+
+  IF (jts == jds) THEN
+     DO k = kts, kte
+     DO i = its-1, ite+1
+        field(i,k,jts) = 0.
+     END DO
+     END DO
+  END IF
+  IF (jte == jde) THEN
+     DO k = kts, kte
+     DO i = its-1, ite+1
+        field(i,k,jte) = 0.
+     END DO
+     END DO
+  END IF
+
+END SUBROUTINE zero_pole
+
+!-------------------------------------------------------------------------------
+! Sets the an array on the polar v point(s)
+SUBROUTINE pole_point_bc ( field,                        &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte )
+
+
+  IMPLICIT NONE
+
+  ! Input data
+   
+  INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                             ims, ime, jms, jme, kms, kme, &
+                             its, ite, jts, jte, kts, kte
+
+  REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: field
+
+  ! Local data
+
+  INTEGER :: i, k
+
+  IF (jts == jds) THEN
+     DO k = kts, kte
+     DO i = its, ite
+!        field(i,k,jts) = 2*field(i,k,jts+1) - field(i,k,jts+2)
+        field(i,k,jts) = field(i,k,jts+1)
+     END DO
+     END DO
+  END IF
+  IF (jte == jde) THEN
+     DO k = kts, kte
+     DO i = its, ite
+!        field(i,k,jte) = 2*field(i,k,jte-1) - field(i,k,jte-2)
+        field(i,k,jte) = field(i,k,jte-1)
+     END DO
+     END DO
+  END IF
+
+END SUBROUTINE pole_point_bc
+
+!======================================================================
+!   physics prep routines
+!======================================================================
+
+   SUBROUTINE phy_prep ( config_flags,                                &  ! input
+                         mu, muu, muv, u, v, w, p, pb, alt, ph,       &  ! input
+                         phb, t, tsk, moist, n_moist,                 &  ! input
+                         mu_3d, rho, th_phy, p_phy , pi_phy ,         &  ! output
+                         u_phy, v_phy, w_phy, p8w, t_phy, t8w,        &  ! output
+                         z, z_at_w, dz8w,                             &  ! output
+                         fzm, fzp,                                    &  ! params
+                         RTHRATEN,                                    &
+                         RTHBLTEN, RUBLTEN, RVBLTEN,                  &
+                         RQVBLTEN, RQCBLTEN, RQIBLTEN,                &
+                         RTHCUTEN, RQVCUTEN, RQCCUTEN,                &
+                         RQRCUTEN, RQICUTEN, RQSCUTEN,                &
+                         RTHFTEN,  RQVFTEN,                           &
+                         RUNDGDTEN, RVNDGDTEN, RTHNDGDTEN,            &
+                         RQVNDGDTEN, RMUNDGDTEN,                      &
+                         ids, ide, jds, jde, kds, kde,                &
+                         ims, ime, jms, jme, kms, kme,                &
+                         its, ite, jts, jte, kts, kte                )
+!----------------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------------
+
+   TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::   ids, ide, jds, jde, kds, kde, &
+                                       ims, ime, jms, jme, kms, kme, &
+                                       its, ite, jts, jte, kts, kte
+   INTEGER ,          INTENT(IN   ) :: n_moist
+
+   REAL, DIMENSION( ims:ime, kms:kme , jms:jme , n_moist ), INTENT(IN) :: moist
+
+
+   REAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN   )   ::     TSK, mu, muu, muv
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                 &
+          INTENT(  OUT)                                  ::   u_phy, &
+                                                              v_phy, &
+                                                              w_phy, &
+                                                             pi_phy, &
+                                                              p_phy, &
+                                                                p8w, &
+                                                              t_phy, &
+                                                             th_phy, &
+                                                                t8w, &
+                                                              mu_3d, &
+                                                                rho, &
+                                                                  z, &
+                                                               dz8w, &
+                                                              z_at_w 
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) ,                 &
+          INTENT(IN   )                                  ::      pb, &
+                                                                  p, &
+                                                                  u, &
+                                                                  v, &
+                                                                  w, &
+                                                                alt, &
+                                                                 ph, &
+                                                                phb, &
+                                                                  t
+
+
+   REAL , DIMENSION( kms:kme ) ,           INTENT(IN   ) ::     fzm,   &
+                                                                fzp
+
+   REAL,  DIMENSION( ims:ime , kms:kme, jms:jme ),                   &
+          INTENT(INOUT)   ::                               RTHRATEN  
+
+   REAL,  DIMENSION( ims:ime , kms:kme, jms:jme ),                   &
+          INTENT(INOUT)   ::                               RTHCUTEN, &
+                                                           RQVCUTEN, &
+                                                           RQCCUTEN, &
+                                                           RQRCUTEN, &
+                                                           RQICUTEN, &
+                                                           RQSCUTEN
+
+   REAL,  DIMENSION( ims:ime, kms:kme, jms:jme )                   , &
+          INTENT(INOUT)   ::                                RUBLTEN, &
+                                                            RVBLTEN, &
+                                                           RTHBLTEN, &
+                                                           RQVBLTEN, &
+                                                           RQCBLTEN, &
+                                                           RQIBLTEN
+
+   REAL,  DIMENSION( ims:ime, kms:kme, jms:jme )                   , &
+          INTENT(INOUT)   ::                                RTHFTEN, &
+                                                            RQVFTEN
+
+   REAL,  DIMENSION( ims:ime, kms:kme, jms:jme )                   , &
+          INTENT(INOUT)   ::                                RUNDGDTEN, &
+                                                            RVNDGDTEN, &
+                                                           RTHNDGDTEN, &
+                                                           RQVNDGDTEN, &
+                                                           RMUNDGDTEN
+
+   INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end, i_startu, j_startv
+   INTEGER :: i, j, k
+   REAL    :: w1, w2, z0, z1, z2
+
+!-----------------------------------------------------------------------
+
+!<DESCRIPTION>
+!
+!  phys_prep calculates a number of diagnostic quantities needed by
+!  the physics routines.  It also decouples the physics tendencies from
+!  the column dry-air mass (the physics routines expect to see/update the
+!  uncoupled tendencies).
+!
+!</DESCRIPTION>
+
+!  set up loop bounds for this grid's boundary conditions
+
+    i_start = its
+    i_end   = min( ite,ide-1 )
+    j_start = jts
+    j_end   = min( jte,jde-1 )
+
+    k_start = kts
+    k_end = min( kte, kde-1 )
+
+!  compute thermodynamics and velocities at pressure points
+
+    do j = j_start,j_end
+    do k = k_start, k_end
+    do i = i_start, i_end
+
+      th_phy(i,k,j) = t(i,k,j) + t0
+      p_phy(i,k,j) = p(i,k,j) + pb(i,k,j)
+      pi_phy(i,k,j) = (p_phy(i,k,j)/p1000mb)**rcp
+      !! TAKE INTO ACCOUNT cp=f(T) on Venus
+      IF (planet.eq. "venus" ) THEN 
+        t_phy(i,k,j)= (th_phy(i,k,j)**nu - nu*(TT00**nu)*log((p1000mb/p_phy(i,k,j))**rcp))**(1/nu)
+      ELSE
+        t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j)
+      ENDIF
+      rho(i,k,j) = 1./alt(i,k,j)*(1.+moist(i,k,j,P_QV))
+      mu_3d(i,k,j) = mu(i,j)
+      u_phy(i,k,j) = 0.5*(u(i,k,j)+u(i+1,k,j))
+      v_phy(i,k,j) = 0.5*(v(i,k,j)+v(i,k,j+1))
+
+    enddo
+    enddo
+    enddo
+
+!  compute z at w points
+
+    do j = j_start,j_end
+    do k = k_start, kte
+    do i = i_start, i_end
+      z_at_w(i,k,j) = (phb(i,k,j)+ph(i,k,j))/g
+    enddo
+    enddo
+    enddo
+
+    do j = j_start,j_end
+    do k = k_start, kte-1
+    do i = i_start, i_end
+      dz8w(i,k,j) = z_at_w(i,k+1,j)-z_at_w(i,k,j)
+    enddo
+    enddo
+    enddo
+
+    do j = j_start,j_end
+    do i = i_start, i_end
+      dz8w(i,kte,j) = 0.
+    enddo
+    enddo
+
+!  compute z at p points (average of z at w points)
+
+    do j = j_start,j_end
+    do k = k_start, k_end
+    do i = i_start, i_end
+      z(i,k,j) = 0.5*(z_at_w(i,k,j) + z_at_w(i,k+1,j) )
+!!!! MARS MARS ajout aymeric (ainsi que les arguments de cette routine)
+      w_phy(i,k,j) = 0.5*(w(i,k,j) + w(i,k+1,j) )
+    enddo
+    enddo
+    enddo
+
+!  interp t and p at w points
+
+    do j = j_start,j_end
+    do k = 2, k_end
+    do i = i_start, i_end
+      p8w(i,k,j) = fzm(k)*p_phy(i,k,j)+fzp(k)*p_phy(i,k-1,j)
+      t8w(i,k,j) = fzm(k)*t_phy(i,k,j)+fzp(k)*t_phy(i,k-1,j)
+    enddo
+    enddo
+    enddo
+
+!  extrapolate p and t to surface and top.
+!  we'll use an extrapolation in z for now
+
+    do j = j_start,j_end
+    do i = i_start, i_end
+
+! bottom
+
+      z0 = z_at_w(i,1,j)
+      z1 = z(i,1,j)
+      z2 = z(i,2,j)
+      w1 = (z0 - z2)/(z1 - z2)
+      w2 = 1. - w1
+      p8w(i,1,j) = w1*p_phy(i,1,j)+w2*p_phy(i,2,j)
+      t8w(i,1,j) = w1*t_phy(i,1,j)+w2*t_phy(i,2,j)
+
+! top
+
+      z0 = z_at_w(i,kte,j)
+      z1 = z(i,k_end,j)
+      z2 = z(i,k_end-1,j)
+      w1 = (z0 - z2)/(z1 - z2)
+      w2 = 1. - w1
+
+!      p8w(i,kde,j) = w1*p_phy(i,kde-1,j)+w2*p_phy(i,kde-2,j)
+!!!  bug fix      extrapolate ln(p) so p is positive definite
+      p8w(i,kde,j) = exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,kde-2,j)))
+      t8w(i,kde,j) = w1*t_phy(i,kde-1,j)+w2*t_phy(i,kde-2,j)
+
+    enddo
+    enddo
+
+! decouple all physics tendencies
+
+   IF (config_flags%ra_lw_physics .gt. 0 .or. config_flags%ra_sw_physics .gt. 0) THEN
+
+      DO J=j_start,j_end
+      DO K=k_start,k_end
+      DO I=i_start,i_end
+         RTHRATEN(I,K,J)=RTHRATEN(I,K,J)/mu(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ENDIF
+
+   IF (config_flags%cu_physics .gt. 0) THEN
+
+      DO J=j_start,j_end
+      DO I=i_start,i_end
+      DO K=k_start,k_end
+         RTHCUTEN(I,K,J)=RTHCUTEN(I,K,J)/mu(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQVCUTEN(I,K,J)=RQVCUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQCCUTEN(I,K,J)=RQCCUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQRCUTEN(I,K,J)=RQRCUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQICUTEN(I,K,J)=RQICUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+         DO K=k_start,k_end
+            RQSCUTEN(I,K,J)=RQSCUTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+   ENDIF
+
+!!MARS MARS
+!   IF (config_flags%bl_pbl_physics .gt. 0) THEN
+   IF ( (config_flags%bl_pbl_physics .gt. 0) &
+        .OR. (config_flags%modif_wrf) ) THEN
+!****MARS
+      DO J=j_start,j_end
+      DO K=k_start,k_end
+      DO I=i_start,i_end
+         RUBLTEN(I,K,J) =RUBLTEN(I,K,J)/mu(I,J)
+         RVBLTEN(I,K,J) =RVBLTEN(I,K,J)/mu(I,J)
+         RTHBLTEN(I,K,J)=RTHBLTEN(I,K,J)/mu(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=j_start,j_end
+         DO K=k_start,k_end
+         DO I=i_start,i_end
+            RQVBLTEN(I,K,J)=RQVBLTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QC .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=j_start,j_end
+         DO K=k_start,k_end
+         DO I=i_start,i_end
+           RQCBLTEN(I,K,J)=RQCBLTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=j_start,j_end
+         DO K=k_start,k_end
+         DO I=i_start,i_end
+            RQIBLTEN(I,K,J)=RQIBLTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+    ENDIF
+
+!  decouple advective forcing required by Grell-Devenyi scheme
+
+   if(( config_flags%cu_physics == GDSCHEME ) .OR.    &
+      ( config_flags%cu_physics == G3SCHEME )) then
+
+      DO J=j_start,j_end
+      DO I=i_start,i_end
+         DO K=k_start,k_end
+            RTHFTEN(I,K,J)=RTHFTEN(I,K,J)/mu(I,J)
+         ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=j_start,j_end
+         DO I=i_start,i_end
+            DO K=k_start,k_end
+               RQVFTEN(I,K,J)=RQVFTEN(I,K,J)/mu(I,J)
+            ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+   END IF
+
+! fdda
+! note fdda u and v tendencies are staggered, also only interior points have muu/muv,
+!   so only decouple those
+
+   IF (config_flags%grid_fdda .gt. 0) THEN
+
+      i_startu=MAX(its,ids+1)
+      j_startv=MAX(jts,jds+1)
+
+      DO J=j_start,j_end
+      DO K=k_start,k_end
+      DO I=i_startu,i_end
+         RUNDGDTEN(I,K,J) =RUNDGDTEN(I,K,J)/muu(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+      DO J=j_startv,j_end
+      DO K=k_start,k_end
+      DO I=i_start,i_end
+         RVNDGDTEN(I,K,J) =RVNDGDTEN(I,K,J)/muv(I,J)
+      ENDDO
+      ENDDO
+      ENDDO
+      DO J=j_start,j_end
+      DO K=k_start,k_end
+      DO I=i_start,i_end
+         RTHNDGDTEN(I,K,J)=RTHNDGDTEN(I,K,J)/mu(I,J)
+!        RMUNDGDTEN(I,J) - no coupling
+      ENDDO
+      ENDDO
+      ENDDO
+      IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=j_start,j_end
+         DO K=k_start,k_end
+         DO I=i_start,i_end
+            RQVNDGDTEN(I,K,J)=RQVNDGDTEN(I,K,J)/mu(I,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+    ENDIF
+
+END SUBROUTINE phy_prep
+
+!------------------------------------------------------------
+
+   SUBROUTINE moist_physics_prep_em( t_new, t_old, t0, rho, al, alb, &
+                                     p, p8w, p0, pb, ph, phb,        &
+                                     th_phy, pii, pf,                &
+                                     z, z_at_w, dz8w,                &
+                                     dt,h_diabatic,                  &
+                                     config_flags,fzm, fzp,          &
+                                     ids,ide, jds,jde, kds,kde,      &
+                                     ims,ime, jms,jme, kms,kme,      &
+                                     its,ite, jts,jte, kts,kte      )
+
+   IMPLICIT NONE
+
+! Here we construct full fields
+! needed by the microphysics
+
+   TYPE(grid_config_rec_type),    INTENT(IN   )    :: config_flags
+
+   INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+   INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+   INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+   REAL, INTENT(IN   )  ::  dt
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),        &
+         INTENT(IN   ) ::                           al,  &
+                                                    alb, &
+                                                    p,   &
+                                                    pb,  &
+                                                    ph,  &
+                                                    phb
+
+
+   REAL , DIMENSION( kms:kme ) ,           INTENT(IN   ) ::   fzm, &
+                                                              fzp
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),       &
+         INTENT(  OUT) ::                         rho,  &
+                                               th_phy,  &
+                                                  pii,  &
+                                                  pf,   &
+                                                    z,  &
+                                               z_at_w,  &
+                                                 dz8w,  &
+                                                  p8w
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),       &
+         INTENT(INOUT) ::                         h_diabatic
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),        &
+         INTENT(INOUT) ::                         t_new, &
+                                                  t_old
+
+   REAL, INTENT(IN   ) :: t0, p0
+   REAL                :: z0,z1,z2,w1,w2
+
+   INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
+   INTEGER :: i, j, k
+
+!--------------------------------------------------------------------
+
+!<DESCRIPTION>
+!
+!  moist_phys_prep_em calculates a number of diagnostic quantities needed by
+!  the microphysics routines.
+!
+!</DESCRIPTION>
+
+!  set up loop bounds for this grid's boundary conditions
+
+    i_start = its    
+    i_end   = min( ite,ide-1 )
+    j_start = jts    
+    j_end   = min( jte,jde-1 )
+
+    k_start = kts
+    k_end = min( kte, kde-1 )
+
+     DO j = j_start, j_end
+     DO k = k_start, kte
+     DO i = i_start, i_end
+       z_at_w(i,k,j) = (ph(i,k,j)+phb(i,k,j))/g
+     ENDDO
+     ENDDO
+     ENDDO
+
+    do j = j_start,j_end
+    do k = k_start, kte-1
+    do i = i_start, i_end
+      dz8w(i,k,j) = z_at_w(i,k+1,j)-z_at_w(i,k,j)
+    enddo
+    enddo
+    enddo
+
+    do j = j_start,j_end
+    do i = i_start, i_end
+      dz8w(i,kte,j) = 0.
+    enddo
+    enddo
+
+
+           !  compute full pii, rho, and z at the new time-level
+           !  (needed for physics).
+           !  convert perturbation theta to full theta (th_phy)
+           !  use h_diabatic to temporarily save pre-microphysics full theta
+
+     DO j = j_start, j_end
+     DO k = k_start, k_end
+     DO i = i_start, i_end
+
+#ifdef REVERT
+       t_new(i,k,j) = t_new(i,k,j)-h_diabatic(i,k,j)*dt
+#endif
+       th_phy(i,k,j) = t_new(i,k,j) + t0
+       h_diabatic(i,k,j) = th_phy(i,k,j)
+       rho(i,k,j)  = 1./(al(i,k,j)+alb(i,k,j))
+       pii(i,k,j) = ((p(i,k,j)+pb(i,k,j))/p0)**rcp
+       z(i,k,j) = 0.5*(z_at_w(i,k,j) +z_at_w(i,k+1,j) )
+       pf(i,k,j) = p(i,k,j)+pb(i,k,j)
+
+     ENDDO
+     ENDDO
+     ENDDO
+
+!  interp t and p at w points
+
+    do j = j_start,j_end
+    do k = 2, k_end
+    do i = i_start, i_end
+      p8w(i,k,j) = fzm(k)*pf(i,k,j)+fzp(k)*pf(i,k-1,j)
+    enddo
+    enddo
+    enddo
+
+!  extrapolate p and t to surface and top.
+!  we'll use an extrapolation in z for now
+
+    do j = j_start,j_end
+    do i = i_start, i_end
+
+! bottom
+
+      z0 = z_at_w(i,1,j)
+      z1 = z(i,1,j)
+      z2 = z(i,2,j)
+      w1 = (z0 - z2)/(z1 - z2)
+      w2 = 1. - w1
+      p8w(i,1,j) = w1*pf(i,1,j)+w2*pf(i,2,j)
+
+! top
+
+      z0 = z_at_w(i,kte,j)
+      z1 = z(i,k_end,j)
+      z2 = z(i,k_end-1,j)
+      w1 = (z0 - z2)/(z1 - z2)
+      w2 = 1. - w1
+!      p8w(i,kde,j) = w1*pf(i,kde-1,j)+w2*pf(i,kde-2,j)
+      p8w(i,kde,j) = exp(w1*log(pf(i,kde-1,j))+w2*log(pf(i,kde-2,j)))
+
+    enddo
+    enddo
+
+   END SUBROUTINE moist_physics_prep_em
+
+!------------------------------------------------------------------------------
+
+   SUBROUTINE moist_physics_finish_em( t_new, t_old, t0, mut,     &
+                                       th_phy, h_diabatic, dt,    &
+                                       config_flags,              &
+                                       ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte )
+
+   IMPLICIT NONE
+
+! Here we construct full fields
+! needed by the microphysics
+
+   TYPE(grid_config_rec_type),    INTENT(IN   )    :: config_flags
+
+   INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
+   INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
+   INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
+
+   REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),        &
+         INTENT(INOUT) ::                         t_new, &
+                                                  t_old, &
+                                                 th_phy, &
+                                                  h_diabatic
+
+   REAL, DIMENSION( ims:ime , jms:jme ),  INTENT(INOUT) ::  mut
+
+
+   REAL, INTENT(IN   ) :: t0, dt
+
+   INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
+   INTEGER :: i, j, k
+
+!--------------------------------------------------------------------
+
+!<DESCRIPTION>
+!
+!  moist_phys_finish_em resets theta to its perturbation value and
+!  computes and stores the microphysics diabatic heating term.
+!
+!</DESCRIPTION>
+
+!  set up loop bounds for this grid's boundary conditions
+
+
+    i_start = its    
+    i_end   = min( ite,ide-1 )
+    j_start = jts    
+    j_end   = min( jte,jde-1 )
+
+    k_start = kts
+    k_end = min( kte, kde-1 )
+
+!  add microphysics theta diff to perturbation theta, set h_diabatic
+
+     IF ( config_flags%no_mp_heating .eq. 0 ) THEN
+     DO j = j_start, j_end
+     DO k = k_start, k_end
+     DO i = i_start, i_end
+         t_new(i,k,j) = t_new(i,k,j) + (th_phy(i,k,j)-h_diabatic(i,k,j))
+         h_diabatic(i,k,j) = (th_phy(i,k,j)-h_diabatic(i,k,j))/dt
+     ENDDO
+     ENDDO
+     ENDDO
+
+     ELSE
+
+     DO j = j_start, j_end
+     DO k = k_start, k_end
+     DO i = i_start, i_end
+!        t_new(i,k,j) = t_new(i,k,j)
+         h_diabatic(i,k,j) = 0.
+     ENDDO
+     ENDDO
+     ENDDO
+     ENDIF
+
+   END SUBROUTINE moist_physics_finish_em
+
+!----------------------------------------------------------------
+
+
+   SUBROUTINE init_module_big_step
+   END SUBROUTINE init_module_big_step
+
+SUBROUTINE set_tend ( field, field_adv_tend, msf,       &
+                      ids, ide, jds, jde, kds, kde,     &
+                      ims, ime, jms, jme, kms, kme,     &
+                      its, ite, jts, jte, kts, kte       )
+
+   IMPLICIT NONE
+
+   ! Input data
+
+   INTEGER ,  INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                               ims, ime, jms, jme, kms, kme, &
+                               its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: field
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN)  :: field_adv_tend
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN)  :: msf
+
+   ! Local data
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+
+!<DESCRIPTION>
+!
+!  set_tend copies the advective tendency array into the tendency array.
+!
+!</DESCRIPTION>
+
+      jtf = MIN(jte,jde-1)
+      ktf = MIN(kte,kde-1)
+      itf = MIN(ite,ide-1)
+      DO j = jts, jtf
+      DO k = kts, ktf
+      DO i = its, itf
+         field(i,k,j) = field_adv_tend(i,k,j)*msf(i,j)
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE set_tend
+
+!------------------------------------------------------------------------------
+
+    SUBROUTINE rk_rayleigh_damp( ru_tendf, rv_tendf,              &
+                                 rw_tendf, t_tendf,               &
+                                 u, v, w, t, t_init,              &
+                                 mut, muu, muv, ph, phb,          &
+                                 u_base, v_base, t_base, z_base,  &
+                                 dampcoef, zdamp,                 &
+                                 ids, ide, jds, jde, kds, kde,    &
+                                 ims, ime, jms, jme, kms, kme,    &
+                                 its, ite, jts, jte, kts, kte   )
+
+! History:     Apr 2005  Modifications by George Bryan, NCAR:
+!                  - Generalized the code in a way that allows for
+!                    simulations with steep terrain.
+!
+!              Jul 2004  Modifications by George Bryan, NCAR:
+!                  - Modified the code to use u_base, v_base, and t_base
+!                    arrays for the background state.  Removed the hard-wired
+!                    base-state values.
+!                  - Modified the code to use dampcoef, zdamp, and damp_opt,
+!                    i.e., the upper-level damper variables in namelist.input.
+!                    Removed the hard-wired variables in the older version.
+!                    This damper is used when damp_opt = 2.
+!                  - Modified the code to account for the movement of the
+!                    model surfaces with time.  The code now obtains a base-
+!                    state value by interpolation using the "_base" arrays.
+
+!              Nov 2003  Bug fix by Jason Knievel, NCAR
+
+!              Aug 2003  Meridional dimension, some comments, and
+!                        changes in layout of the code added by
+!                        Jason Knievel, NCAR
+
+!              Jul 2003  Original code by Bill Skamarock, NCAR
+
+! Purpose:     This routine applies Rayleigh damping to a layer at top
+!              of the model domain.
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: ru_tendf, rv_tendf, rw_tendf, t_tendf
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: u, v, w, t, t_init, ph, phb
+
+    REAL, DIMENSION( ims:ime, jms:jme ),  INTENT( IN )  &
+    :: mut, muu, muv
+
+    REAL, DIMENSION( kms:kme ) ,  INTENT(IN   )  &
+    :: u_base, v_base, t_base, z_base
+
+    REAL, INTENT(IN   )   &
+    :: dampcoef, zdamp
+
+! Local variables.
+
+    INTEGER  &
+    :: i_start, i_end, j_start, j_end, k_start, k_end, i, j, k, ktf, k1, k2
+
+    REAL  &
+    :: pii, dcoef, z, ztop
+
+    REAL :: wkp1, wk, wkm1
+
+    REAL, DIMENSION( kms:kme ) :: z00, u00, v00, t00
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    pii = 2.0 * asin(1.0)
+
+    ktf = MIN( kte,   kde-1 )
+
+!-----------------------------------------------------------------------
+! Adjust u to base state.
+
+    DO j = jts, MIN( jte, jde-1 )
+    DO i = its, MIN( ite, ide   )
+
+      ! Get height at top of model
+      ztop = 0.5*( phb(i  ,kde,j)+phb(i-1,kde,j)   &
+                  +ph(i  ,kde,j)+ph(i-1,kde,j) )/g
+
+      ! Find bottom of damping layer
+      k1 = ktf
+      z = ztop
+      DO WHILE( z >= (ztop-zdamp) )
+        z = 0.25*( phb(i  ,k1,j)+phb(i  ,k1+1,j)  &
+                  +phb(i-1,k1,j)+phb(i-1,k1+1,j)  &
+                  +ph(i  ,k1,j)+ph(i  ,k1+1,j)    &
+                  +ph(i-1,k1,j)+ph(i-1,k1+1,j))/g
+        z00(k1) = z
+        k1 = k1 - 1
+      ENDDO
+      k1 = k1 + 2
+
+      ! Get reference state at model levels
+      DO k = k1, ktf
+        k2 = ktf
+        DO WHILE( z_base(k2) .gt. z00(k) )
+          k2 = k2 - 1
+        ENDDO
+        if(k2+1.gt.ktf)then
+          u00(k) = u_base(k2) + ( u_base(k2) - u_base(k2-1) )   &
+                              * (     z00(k) - z_base(k2)   )   &
+                              / ( z_base(k2) - z_base(k2-1) )
+        else
+          u00(k) = u_base(k2) + ( u_base(k2+1) - u_base(k2) )   &
+                              * (       z00(k) - z_base(k2) )   &
+                              / ( z_base(k2+1) - z_base(k2) )
+        endif
+      ENDDO
+
+      ! Apply the Rayleigh damper
+      DO k = k1, ktf
+        dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp )
+        dcoef = (SIN( 0.5 * pii * dcoef ) )**2
+        ru_tendf(i,k,j) = ru_tendf(i,k,j) -                    &
+                          muu(i,j) * ( dcoef * dampcoef ) *    &
+                          ( u(i,k,j) - u00(k) )
+      END DO
+
+    END DO
+    END DO
+
+! End adjustment of u.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Adjust v to base state.
+
+    DO j = jts, MIN( jte, jde   )
+    DO i = its, MIN( ite, ide-1 )
+
+      ! Get height at top of model
+      ztop = 0.5*( phb(i,kde,j  )+phb(i,kde,j-1)   &
+                  +ph(i,kde,j  )+ph(i,kde,j-1) )/g
+
+      ! Find bottom of damping layer
+      k1 = ktf
+      z = ztop
+      DO WHILE( z >= (ztop-zdamp) )
+        z = 0.25*( phb(i,k1,j  )+phb(i,k1+1,j  )  &
+                  +phb(i,k1,j-1)+phb(i,k1+1,j-1)  &
+                  +ph(i,k1,j  )+ph(i,k1+1,j  )    &
+                  +ph(i,k1,j-1)+ph(i,k1+1,j-1))/g
+        z00(k1) = z
+        k1 = k1 - 1
+      ENDDO
+      k1 = k1 + 2
+
+      ! Get reference state at model levels
+      DO k = k1, ktf
+        k2 = ktf
+        DO WHILE( z_base(k2) .gt. z00(k) )
+          k2 = k2 - 1
+        ENDDO
+        if(k2+1.gt.ktf)then
+          v00(k) = v_base(k2) + ( v_base(k2) - v_base(k2-1) )   &
+                              * (     z00(k) - z_base(k2)   )   &
+                              / ( z_base(k2) - z_base(k2-1) )
+        else
+          v00(k) = v_base(k2) + ( v_base(k2+1) - v_base(k2) )   &
+                              * (       z00(k) - z_base(k2) )   &
+                              / ( z_base(k2+1) - z_base(k2) )
+        endif
+      ENDDO
+
+      ! Apply the Rayleigh damper
+      DO k = k1, ktf
+        dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp )
+        dcoef = (SIN( 0.5 * pii * dcoef ) )**2
+        rv_tendf(i,k,j) = rv_tendf(i,k,j) -                    &
+                          muv(i,j) * ( dcoef * dampcoef ) *    &
+                          ( v(i,k,j) - v00(k) )
+      END DO
+
+    END DO
+    END DO
+
+! End adjustment of v.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Adjust w to base state.
+
+    DO j = jts, MIN( jte,   jde-1 )
+    DO i = its, MIN( ite,   ide-1 )
+      ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g
+      DO k = kts, MIN( kte,   kde   )
+        z = ( phb(i,k,j) + ph(i,k,j) ) / g
+        IF ( z >= (ztop-zdamp) ) THEN
+          dcoef = 1.0 - MIN( 1.0, ( ztop - z ) / zdamp )
+          dcoef = ( SIN( 0.5 * pii * dcoef ) )**2
+          rw_tendf(i,k,j) = rw_tendf(i,k,j) -  &
+                            mut(i,j) * ( dcoef * dampcoef ) * w(i,k,j)
+        END IF
+      END DO
+    END DO
+    END DO
+
+! End adjustment of w.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Adjust potential temperature to base state.
+
+    DO j = jts, MIN( jte,   jde-1 )
+    DO i = its, MIN( ite,   ide-1 )
+
+      ! Get height at top of model
+      ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g
+
+      ! Find bottom of damping layer
+      k1 = ktf
+      z = ztop
+      DO WHILE( z >= (ztop-zdamp) )
+        z = 0.5 * ( phb(i,k1,j) + phb(i,k1+1,j) +  &
+                     ph(i,k1,j) +  ph(i,k1+1,j) ) / g
+        z00(k1) = z
+        k1 = k1 - 1
+      ENDDO
+      k1 = k1 + 2
+
+      ! Get reference state at model levels
+      DO k = k1, ktf
+        k2 = ktf
+        DO WHILE( z_base(k2) .gt. z00(k) )
+          k2 = k2 - 1
+        ENDDO
+        if(k2+1.gt.ktf)then
+          t00(k) = t_base(k2) + ( t_base(k2) - t_base(k2-1) )   &
+                              * (     z00(k) - z_base(k2)   )   &
+                              / ( z_base(k2) - z_base(k2-1) )
+        else
+          t00(k) = t_base(k2) + ( t_base(k2+1) - t_base(k2) )   &
+                              * (       z00(k) - z_base(k2) )   &
+                              / ( z_base(k2+1) - z_base(k2) )
+        endif
+      ENDDO
+
+      ! Apply the Rayleigh damper
+      DO k = k1, ktf
+        dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp )
+        dcoef = (SIN( 0.5 * pii * dcoef ) )**2
+        t_tendf(i,k,j) = t_tendf(i,k,j) -                      &
+                         mut(i,j) * ( dcoef * dampcoef )  *    &
+                         ( t(i,k,j) - t00(k) )
+      END DO
+
+    END DO
+    END DO
+
+! End adjustment of potential temperature.
+!-----------------------------------------------------------------------
+
+    END SUBROUTINE rk_rayleigh_damp
+
+!==============================================================================
+!==============================================================================
+                                                                                
+      SUBROUTINE sixth_order_diffusion( name, field, tendency, mu, dt,  &
+                                        config_flags,                   &
+                                        diff_6th_opt, diff_6th_factor,  &
+                                        ids, ide, jds, jde, kds, kde,   &
+                                        ims, ime, jms, jme, kms, kme,   &
+                                        its, ite, jts, jte, kts, kte )
+                                                                                
+! History:       14 Nov 2006   Name of variable changed by Jason Knievel
+!                07 Jun 2006   Revised and generalized by Jason Knievel  
+!                25 Apr 2005   Original code by Jason Knievel, NCAR
+                                                                                
+! Purpose:       Apply 6th-order, monotonic (flux-limited), numerical
+!                diffusion to 3-d velocity and to scalars.
+                                                                                
+! References:    Ming Xue (MWR Aug 2000)
+!                Durran ("Numerical Methods for Wave Equations..." 1999)
+!                George Bryan (personal communication)
+ 
+!------------------------------------------------------------------------------
+! Begin: Declarations.
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(IN)  &
+    :: ids, ide, jds, jde, kds, kde,   &
+       ims, ime, jms, jme, kms, kme,   &
+       its, ite, jts, jte, kts, kte
+ 
+    TYPE(grid_config_rec_type), INTENT(IN)  &
+    :: config_flags
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT)  &
+    :: tendency
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN)  &
+    :: field
+ 
+    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  &
+    :: mu
+ 
+    REAL, INTENT(IN)  &
+    :: dt
+
+    REAL, INTENT(IN)  &
+    :: diff_6th_factor
+
+    INTEGER, INTENT(IN)  &
+    :: diff_6th_opt
+
+    CHARACTER(LEN=1) , INTENT(IN)  &
+    :: name
+
+    INTEGER  &
+    :: i, j, k,         &
+       i_start, i_end,  &
+       j_start, j_end,  &
+       k_start, k_end,  &
+       ktf
+ 
+    REAL  &
+    :: dflux_x_p0, dflux_y_p0,  &
+       dflux_x_p1, dflux_y_p1,  &
+       tendency_x, tendency_y,  &
+       mu_avg_p0, mu_avg_p1,    &
+       diff_6th_coef
+
+    LOGICAL  &
+    :: specified
+ 
+! End: Declarations.
+!------------------------------------------------------------------------------
+
+!------------------------------------------------------------------------------
+! Begin: Translate the diffusion factor into a diffusion coefficient.  See
+! Durran's text, section 2.4.3, then adjust for sixth-order diffusion (not
+! fourth) and for diffusion in two dimensions (not one).  For reference, a
+! factor of 1.0 would mean complete diffusion of a 2dx wave in one time step,
+! although application of the flux limiter reduces somewhat the effects of
+! diffusion for a given coefficient.
+
+    diff_6th_coef = diff_6th_factor * 0.015625 / ( 2.0 * dt )  
+
+! End: Translate diffusion factor.
+!------------------------------------------------------------------------------
+
+!------------------------------------------------------------------------------
+! Begin: Assign limits of spatial loops depending on variable to be diffused.
+! The halo regions are already filled with values by the time this subroutine
+! is called, which allows the stencil to extend beyond the domains' edges.
+
+    ktf = MIN( kte, kde-1 )
+
+    IF ( name .EQ. 'u' ) THEN
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = MIN(jde-1,jte)
+      k_start = kts
+      k_end   = ktf
+
+    ELSE IF ( name .EQ. 'v' ) THEN
+ 
+      i_start = its
+      i_end   = MIN(ide-1,ite)
+      j_start = jts
+      j_end   = jte
+      k_start = kts
+      k_end   = ktf
+ 
+    ELSE IF ( name .EQ. 'w' ) THEN
+
+      i_start = its
+      i_end   = MIN(ide-1,ite)
+      j_start = jts
+      j_end   = MIN(jde-1,jte)
+      k_start = kts+1
+      k_end   = ktf
+
+    ELSE
+
+      i_start = its
+      i_end   = MIN(ide-1,ite)
+      j_start = jts
+      j_end   = MIN(jde-1,jte)
+      k_start = kts
+      k_end   = ktf
+ 
+    ENDIF
+
+! End: Assignment of limits of spatial loops.
+!------------------------------------------------------------------------------
+
+!------------------------------------------------------------------------------
+! Begin: Loop across spatial dimensions.
+
+    DO j = j_start, j_end
+    DO k = k_start, k_end
+    DO i = i_start, i_end
+
+!------------------------------------------------------------------------------
+! Begin: Diffusion in x (i index).
+ 
+! Calculate the diffusive flux in x direction (from Xue's eq. 3).
+ 
+      dflux_x_p0 = (  10.0 * ( field(i,  k,j) - field(i-1,k,j) )    &
+                     - 5.0 * ( field(i+1,k,j) - field(i-2,k,j) )    &
+                     +       ( field(i+2,k,j) - field(i-3,k,j) ) )
+ 
+      dflux_x_p1 = (  10.0 * ( field(i+1,k,j) - field(i  ,k,j) )    &
+                     - 5.0 * ( field(i+2,k,j) - field(i-1,k,j) )    &
+                     +       ( field(i+3,k,j) - field(i-2,k,j) ) )
+ 
+! If requested in the namelist (diff_6th_opt=2), prohibit up-gradient diffusion
+! (variation on Xue's eq. 10).
+
+      IF ( diff_6th_opt .EQ. 2 ) THEN
+ 
+        IF ( dflux_x_p0 * ( field(i  ,k,j)-field(i-1,k,j) ) .LE. 0.0 ) THEN
+          dflux_x_p0 = 0.0
+        END IF
+ 
+        IF ( dflux_x_p1 * ( field(i+1,k,j)-field(i  ,k,j) ) .LE. 0.0 ) THEN
+          dflux_x_p1 = 0.0
+        END IF
+
+      END IF
+
+! Apply 6th-order diffusion in x direction.
+ 
+      IF      ( name .EQ. 'u' ) THEN
+        mu_avg_p0 = mu(i-1,j)
+        mu_avg_p1 = mu(i  ,j)
+      ELSE IF ( name .EQ. 'v' ) THEN
+        mu_avg_p0 = 0.25 * (       &
+                    mu(i-1,j-1) +  &
+                    mu(i  ,j-1) +  &
+                    mu(i-1,j  ) +  &
+                    mu(i  ,j  ) )
+        mu_avg_p1 = 0.25 * (       &
+                    mu(i  ,j-1) +  &
+                    mu(i+1,j-1) +  &
+                    mu(i  ,j  ) +  &
+                    mu(i+1,j  ) )
+      ELSE
+        mu_avg_p0 = 0.5 * (        &
+                    mu(i-1,j) +    &
+                    mu(i  ,j) )
+        mu_avg_p1 = 0.5 * (        &
+                    mu(i  ,j) +    &
+                    mu(i+1,j) )
+      END IF
+ 
+      tendency_x = diff_6th_coef *  &
+                 ( ( mu_avg_p1 * dflux_x_p1 ) - ( mu_avg_p0 * dflux_x_p0 ) )
+ 
+! End: Diffusion in x.
+!------------------------------------------------------------------------------
+ 
+!------------------------------------------------------------------------------
+! Begin: Diffusion in y (j index).
+ 
+! Calculate the diffusive flux in y direction (from Xue's eq. 3).
+ 
+      dflux_y_p0 = (  10.0 * ( field(i,k,j  ) - field(i,k,j-1) )    &
+                     - 5.0 * ( field(i,k,j+1) - field(i,k,j-2) )    &
+                     +       ( field(i,k,j+2) - field(i,k,j-3) ) )
+ 
+      dflux_y_p1 = (  10.0 * ( field(i,k,j+1) - field(i,k,j  ) )    &
+                     - 5.0 * ( field(i,k,j+2) - field(i,k,j-1) )    &
+                     +       ( field(i,k,j+3) - field(i,k,j-2) ) )
+ 
+! If requested in the namelist (diff_6th_opt=2), prohibit up-gradient diffusion
+! (variation on Xue's eq. 10).
+
+      IF ( diff_6th_opt .EQ. 2 ) THEN
+ 
+        IF ( dflux_y_p0 * ( field(i,k,j  )-field(i,k,j-1) ) .LE. 0.0 ) THEN
+          dflux_y_p0 = 0.0
+        END IF
+ 
+        IF ( dflux_y_p1 * ( field(i,k,j+1)-field(i,k,j  ) ) .LE. 0.0 ) THEN
+          dflux_y_p1 = 0.0
+        END IF
+
+      END IF
+ 
+! Apply 6th-order diffusion in y direction.
+ 
+      IF      ( name .EQ. 'u' ) THEN
+        mu_avg_p0 = 0.25 * (       &
+                    mu(i-1,j-1) +  &
+                    mu(i  ,j-1) +  &
+                    mu(i-1,j  ) +  &
+                    mu(i  ,j  ) )
+        mu_avg_p1 = 0.25 * (       &
+                    mu(i-1,j  ) +  &
+                    mu(i  ,j  ) +  &
+                    mu(i-1,j+1) +  &
+                    mu(i  ,j+1) )
+      ELSE IF ( name .EQ. 'v' ) THEN
+        mu_avg_p0 = mu(i,j-1)
+        mu_avg_p1 = mu(i,j  )
+      ELSE
+        mu_avg_p0 = 0.5 * (      &
+                    mu(i,j-1) +  &
+                    mu(i,j  ) )
+        mu_avg_p1 = 0.5 * (      &
+                    mu(i,j  ) +  &
+                    mu(i,j+1) )
+      END IF
+ 
+      tendency_y = diff_6th_coef *  &
+                 ( ( mu_avg_p1 * dflux_y_p1 ) - ( mu_avg_p0 * dflux_y_p0 ) )
+ 
+! End: Diffusion in y.
+!------------------------------------------------------------------------------
+ 
+!------------------------------------------------------------------------------
+! Begin: Combine diffusion in x and y.
+     
+      tendency(i,k,j) = tendency(i,k,j) + tendency_x + tendency_y
+ 
+! End: Combine diffusion in x and y.
+!------------------------------------------------------------------------------
+
+    ENDDO
+    ENDDO
+    ENDDO
+
+! End: Loop across spatial dimensions.
+!------------------------------------------------------------------------------
+ 
+    END SUBROUTINE sixth_order_diffusion
+ 
+!==============================================================================
+!==============================================================================
+
+END MODULE module_big_step_utilities_em
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_diffusion_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_diffusion_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_diffusion_em.F	(revision 2744)
@@ -0,0 +1,5525 @@
+! WRF:MODEL_LAYER:PHYSICS
+ 
+    MODULE module_diffusion_em
+
+    USE module_configure
+    USE module_bc
+    USE module_state_description
+    USE module_big_step_utilities_em
+    USE module_model_constants    
+    USE module_wrf_error
+
+    CONTAINS
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div,       &
+                                   defor11, defor22, defor33,        &
+                                   defor12, defor13, defor23,        &
+                                   u_base, v_base, msfux, msfuy,     &
+                                   msfvx, msfvy, msftx, msfty,       &
+                                   rdx, rdy, dn, dnw, rdz, rdzw,     &
+                                   fnm, fnp, cf1, cf2, cf3, zx, zy,  &
+                                   ids, ide, jds, jde, kds, kde,     &
+                                   ims, ime, jms, jme, kms, kme,     &
+                                   its, ite, jts, jte, kts, kte      )
+
+! History:     Sep 2003  Changes by Jason Knievel and George Bryan, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              ...        ...
+
+! Purpose:     This routine calculates deformation and 3-d divergence.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+!-----------------------------------------------------------------------
+! Comments 10-MAR-05
+! Equations 13a-f, Chen and Dudhia 2000, Appendix A:
+! Eqn 13a: D11=defor11= 2m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi)
+! Eqn 13b: D22=defor22= 2m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi)
+! Eqn 13c: D33=defor33= 2 * partial dw/dz [SIMPLER FORM]
+! Eqn 13d: D12=defor12= m^2 * (partial dv^/dX + partial du^/dY +
+!                              partial dpsi/dx * partial dv^/dpsi +
+!                              partial dpsi/dy * partial du^/dpsi)
+! Eqn 13e: D13=defor13= m^2 * (partial dw^/dX + partial dpsi/dx * partial dw^/dpsi)
+!                           + partial du/dz [SIMPLER FORM]
+! Eqn 13f: D23=defor23= m^2 * (partial dw^/dY + partial dpsi/dy * partial dw^/dpsi)
+!                           + partial dv/dz [SIMPLER FORM]
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde, &
+       ims, ime, jms, jme, kms, kme, &
+       its, ite, jts, jte, kts, kte
+
+    REAL, INTENT( IN )  &
+    :: rdx, rdy, cf1, cf2, cf3
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp, dn, dnw, u_base, v_base
+
+    REAL, DIMENSION( ims:ime , jms:jme ),  INTENT( IN )  &
+    :: msfux, msfuy, msfvx, msfvy, msftx, msfty
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    ::  u, v, w, zx, zy, rdz, rdzw
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: defor11, defor22, defor33, defor12, defor13, defor23, div 
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, ktes1, ktes2, i_start, i_end, j_start, j_end
+
+    REAL  &
+    :: tmp, tmpzx, tmpzy, tmpzeta_z, cft1, cft2
+
+    REAL, DIMENSION( its:ite, jts:jte )  &
+    :: mm, zzavg, zeta_zd12
+
+    REAL, DIMENSION( its-2:ite+2, kts:kte, jts-2:jte+2 )  &
+    :: tmp1, hat, hatavg
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+! Comments 10-MAR-2005
+! Treat all differentials as 'div-style' [or 'curl-style'],
+! i.e., du/dX becomes (in map coordinate space) mx*my * d(u/my)/dx,
+! NB - all equations referred to here are from Chen and Dudhia 2002, from the
+! WRF physics documents web pages:
+! http://www.mmm.ucar.edu/wrf/users/docs/wrf-doc-physics.pdf
+
+!=======================================================================
+! In the following section, calculate 3-d divergence and the first three
+! (defor11, defor22, defor33) of six deformation terms.
+
+    ktes1   = kte-1
+    ktes2   = kte-2
+
+    cft2    = - 0.5 * dnw(ktes1) / dn(ktes1)
+    cft1    = 1.0 - cft2
+
+    ktf     = MIN( kte, kde-1 )
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+! Square the map scale factor.
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      mm(i,j) = msftx(i,j) * msfty(i,j)
+    END DO
+    END DO
+
+!-----------------------------------------------------------------------
+! Calculate du/dx.
+
+! Apply a coordinate transformation to zonal velocity, u.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end+1
+      hat(i,k,j) = u(i,k,j) / msfuy(i,j)
+    END DO
+    END DO
+    END DO
+
+! Average in x and z.
+
+    DO j=j_start,j_end
+    DO k=kts+1,ktf
+    DO i=i_start,i_end
+      hatavg(i,k,j) = 0.5 *  &
+                    ( fnm(k) * ( hat(i,k  ,j) + hat(i+1,  k,j) ) +  &
+                      fnp(k) * ( hat(i,k-1,j) + hat(i+1,k-1,j) ) )
+    END DO
+    END DO
+    END DO
+
+! Extrapolate to top and bottom of domain (to w levels).
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      hatavg(i,1,j)   =  0.5 * (  &
+                         cf1 * hat(i  ,1,j) +  &
+                         cf2 * hat(i  ,2,j) +  &
+                         cf3 * hat(i  ,3,j) +  &
+                         cf1 * hat(i+1,1,j) +  &
+                         cf2 * hat(i+1,2,j) +  &
+                         cf3 * hat(i+1,3,j) )
+      hatavg(i,kte,j) =  0.5 * (  &
+                        cft1 * ( hat(i,ktes1,j) + hat(i+1,ktes1,j) )  +  &
+                        cft2 * ( hat(i,ktes2,j) + hat(i+1,ktes2,j) ) )
+    END DO
+    END DO
+
+    ! Comments 10-MAR-05
+    ! Eqn 13a: D11=defor11= 2m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi)
+    ! Below, D11 is set = 2*tmp1
+    ! => tmp1 = m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi)
+    ! tmpzx = averaged value of dpsi/dx (=zx)
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmpzx       = 0.25 * (  &
+                    zx(i,k  ,j) + zx(i+1,k  ,j) +  &
+                    zx(i,k+1,j) + zx(i+1,k+1,j) )
+      tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *tmpzx * rdzw(i,k,j)
+      ! tmp1 to here = partial dpsi/dx * partial du^/dpsi:
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = mm(i,j) * ( rdx * ( hat(i+1,k,j) - hat(i,k,j) ) -  &
+                    tmp1(i,k,j))
+    END DO
+    END DO
+    END DO
+
+! End calculation of du/dx.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate defor11 (2*du/dx).
+! Comments 10-MAR-05
+! Eqn 13a: D11=defor11= 2 m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi)
+!                     = 2*tmp1
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor11(i,k,j) = 2.0 * tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of defor11.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate zonal divergence (du/dx) and add it to the divergence array.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      div(i,k,j) = tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of zonal divergence.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dv/dy.
+
+! Apply a coordinate transformation to meridional velocity, v.
+
+    DO j = j_start, j_end+1
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      ! Because msfvx at the poles will be undefined (1./0.), we will have
+      ! trouble.  But we are OK since v at the poles is 0., and that takes
+      ! precedence in this case.
+      IF ((config_flags%polar) .AND. ((j == jds) .OR. (j == jde))) THEN
+         hat(i,k,j) = 0.
+      ELSE ! normal code
+      hat(i,k,j) = v(i,k,j) / msfvx(i,j)
+      ENDIF
+    END DO
+    END DO
+    END DO
+
+! Account for the slope in y of eta surfaces.
+
+    DO j=j_start,j_end
+    DO k=kts+1,ktf
+    DO i=i_start,i_end
+      hatavg(i,k,j) = 0.5 * (  &
+                      fnm(k) * ( hat(i,k  ,j) + hat(i,k  ,j+1) ) +  &
+                      fnp(k) * ( hat(i,k-1,j) + hat(i,k-1,j+1) ) )
+    END DO
+    END DO
+    END DO
+
+! Extrapolate to top and bottom of domain (to w levels).
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      hatavg(i,1,j)   =  0.5 * (  &
+                         cf1 * hat(i,1,j  ) +  &
+                         cf2 * hat(i,2,j  ) +  &
+                         cf3 * hat(i,3,j  ) +  &
+                         cf1 * hat(i,1,j+1) +  &
+                         cf2 * hat(i,2,j+1) +  &
+                         cf3 * hat(i,3,j+1) )
+      hatavg(i,kte,j) =  0.5 * (  &
+                        cft1 * ( hat(i,ktes1,j) + hat(i,ktes1,j+1) ) +  &
+                        cft2 * ( hat(i,ktes2,j) + hat(i,ktes2,j+1) ) )
+    END DO
+    END DO
+
+    ! Comments 10-MAR-05
+    ! Eqn 13b: D22=defor22= 2m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi)
+    ! Below, D22 is set = 2*tmp1
+    ! => tmp1 = m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi)
+    ! tmpzy = averaged value of dpsi/dy (=zy)
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmpzy       =  0.25 * (  &
+                     zy(i,k  ,j) + zy(i,k  ,j+1) +  &
+                     zy(i,k+1,j) + zy(i,k+1,j+1)  )
+      tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) * tmpzy * rdzw(i,k,j)
+      ! tmp1 to here = partial dpsi/dy * partial dv^/dpsi:
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = mm(i,j) * (  &
+                    rdy * ( hat(i,k,j+1) - hat(i,k,j) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of dv/dy.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate defor22 (2*dv/dy).
+! Comments 10-MAR-05
+! Eqn 13b: D22=defor22= 2 m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi)
+!                     = 2*tmp1
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor22(i,k,j) = 2.0 * tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of defor22.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate meridional divergence (dv/dy) and add it to the divergence
+! array.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      div(i,k,j) = div(i,k,j) + tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of meridional divergence.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Comments 10-MAR-05
+! Eqn 13c: D33=defor33= 2 * partial dw/dz
+! Below, D33 is set = 2*tmp1
+! => tmp1 = partial dw/dz
+
+! Calculate dw/dz.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = ( w(i,k+1,j) - w(i,k,j) ) * rdzw(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of dw/dz.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate defor33 (2*dw/dz).
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor33(i,k,j) = 2.0 * tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of defor33.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate vertical divergence (dw/dz) and add it to the divergence
+! array.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      div(i,k,j) = div(i,k,j) + tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End calculation of vertical divergence. 
+!-----------------------------------------------------------------------
+
+! Three-dimensional divergence is now finished and values are in array
+! "div."  Also, the first three (defor11, defor22, defor33) of six
+! deformation terms are now calculated at pressure points.
+!=======================================================================
+
+! Comments 10-MAR-2005
+! Treat all differentials as 'div-style' [or 'curl-style'],
+! i.e., du/dY becomes (in map coordinate space) mx*my * d(u/mx)/dy,
+!       dv/dX becomes (in map coordinate space) mx*my * d(v/my)/dx,
+! (see e.g. Haltiner and Williams p. 441)
+
+!=======================================================================
+! Calculate the final three deformations (defor12, defor13, defor23) at 
+! vorticity points.
+
+    i_start = its
+    i_end   = ite
+    j_start = jts
+    j_end   = jte
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. & 
+         config_flags%nested) i_end   = MIN( ide-1, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-1, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+
+!-----------------------------------------------------------------------
+! Calculate du/dy.
+
+! First, calculate an average mapscale factor.
+
+! Comments 10-MAR-05
+! du/dy => need u map scale factor in x (which is defined at u points)
+! averaged over j and j-1
+! dv/dx => need v map scale factor in y (which is defined at v points)
+! averaged over i and i-1
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      mm(i,j) = 0.25 * ( msfux(i,j-1) + msfux(i,j) ) * ( msfvy(i-1,j) + msfvy(i,j) )
+    END DO
+    END DO
+
+! Apply a coordinate transformation to zonal velocity, u.
+
+    DO j =j_start-1, j_end
+    DO k =kts, ktf
+    DO i =i_start, i_end
+      ! Fixes to set_physical_bc2/3d for polar boundary conditions 
+      ! remove issues with loop over j
+      hat(i,k,j) = u(i,k,j) / msfux(i,j)
+    END DO
+    END DO
+    END DO
+
+! Average in y and z.
+
+    DO j=j_start,j_end
+    DO k=kts+1,ktf
+    DO i=i_start,i_end
+      hatavg(i,k,j) = 0.5 * (  &
+                      fnm(k) * ( hat(i,k  ,j-1) + hat(i,k  ,j) ) +  &
+                      fnp(k) * ( hat(i,k-1,j-1) + hat(i,k-1,j) ) )
+    END DO
+    END DO
+    END DO
+
+! Extrapolate to top and bottom of domain (to w levels).
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      hatavg(i,1,j)   =  0.5 * (  &
+                         cf1 * hat(i,1,j-1) +  &
+                         cf2 * hat(i,2,j-1) +  &
+                         cf3 * hat(i,3,j-1) +  &
+                         cf1 * hat(i,1,j  ) +  &
+                         cf2 * hat(i,2,j  ) +  &
+                         cf3 * hat(i,3,j  ) )
+      hatavg(i,kte,j) =  0.5 * (  &
+                        cft1 * ( hat(i,ktes1,j-1) + hat(i,ktes1,j) ) +  &
+                        cft2 * ( hat(i,ktes2,j-1) + hat(i,ktes2,j) ) )
+    END DO
+    END DO
+
+    ! tmpzy = averaged value of dpsi/dy (=zy) on vorticity grid
+    ! tmp1  = partial dpsi/dy * partial du^/dpsi
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmpzy       = 0.25 * (  &
+                    zy(i-1,k  ,j) + zy(i,k  ,j) +  &
+                    zy(i-1,k+1,j) + zy(i,k+1,j) )
+      tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *  &
+                    0.25 * tmpzy * ( rdzw(i,k,j) + rdzw(i-1,k,j) + &
+                                     rdzw(i-1,k,j-1) + rdzw(i,k,j-1) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of du/dy.
+!---------------------------------------------------------------------- 
+
+!-----------------------------------------------------------------------
+! Add the first term to defor12 (du/dy+dv/dx) at vorticity points.
+
+! Comments 10-MAR-05
+! Eqn 13d: D12=defor12= m^2 * (partial dv^/dX + partial du^/dY +
+!                              partial dpsi/dx * partial dv^/dpsi +
+!                              partial dpsi/dy * partial du^/dpsi)
+! Here deal with m^2 * (partial du^/dY + partial dpsi/dy * partial du^/dpsi)
+! Still need to add v^ terms: 
+!   m^2 * (partial dv^/dX + partial dpsi/dx * partial dv^/dpsi)
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor12(i,k,j) = mm(i,j) * (  &
+                       rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End addition of the first term to defor12.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dv/dx.
+
+! Apply a coordinate transformation to meridional velocity, v.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start-1, i_end
+       hat(i,k,j) = v(i,k,j) / msfvy(i,j)
+    END DO
+    END DO
+    END DO
+
+! Account for the slope in x of eta surfaces.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      hatavg(i,k,j) = 0.5 * (  &
+                      fnm(k) * ( hat(i-1,k  ,j) + hat(i,k  ,j) ) +  &
+                      fnp(k) * ( hat(i-1,k-1,j) + hat(i,k-1,j) ) )
+    END DO
+    END DO
+    END DO
+
+! Extrapolate to top and bottom of domain (to w levels).
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+       hatavg(i,1,j)   =  0.5 * (  &
+                          cf1 * hat(i-1,1,j) +  &
+                          cf2 * hat(i-1,2,j) +  &
+                          cf3 * hat(i-1,3,j) +  &
+                          cf1 * hat(i  ,1,j) +  &
+                          cf2 * hat(i  ,2,j) +  &
+                          cf3 * hat(i  ,3,j) )
+       hatavg(i,kte,j) =  0.5 * (  &
+                         cft1 * ( hat(i,ktes1,j) + hat(i-1,ktes1,j) ) +  &
+                         cft2 * ( hat(i,ktes2,j) + hat(i-1,ktes2,j) ) )
+    END DO
+    END DO
+
+    ! Fixes to set_physical_bc2/3d have made any check for polar B.C.'s
+    ! unnecessary in this place.  zx, rdzw, and hatavg are all defined
+    ! in places they need to be and the values at the poles are replications
+    ! of the values one grid point in, so the averaging over j and j-1 works
+    ! to act as just using the value at j or j-1 (with out extra code).
+    !
+    ! tmpzx = averaged value of dpsi/dx (=zx) on vorticity grid
+    ! tmp1  = partial dpsi/dx * partial dv^/dpsi
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tmpzx       = 0.25 * (  &
+                    zx(i,k  ,j-1) + zx(i,k  ,j) +  &
+                    zx(i,k+1,j-1) + zx(i,k+1,j) )
+      tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *  &
+                    0.25 * tmpzx * ( rdzw(i,k,j) + rdzw(i,k,j-1) + &
+                                     rdzw(i-1,k,j-1) + rdzw(i-1,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of dv/dx.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add the second term to defor12 (du/dy+dv/dx) at vorticity points.
+
+! Comments 10-MAR-05
+! Eqn 13d: D12=defor12= m^2 * (partial dv^/dX + partial du^/dY +
+!                              partial dpsi/dx * partial dv^/dpsi +
+!                              partial dpsi/dy * partial du^/dpsi)
+! Here adding v^ terms:
+!    m^2 * (partial dv^/dX + partial dpsi/dx * partial dv^/dpsi)
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      defor12(i,k,j) = defor12(i,k,j) +  &
+                       mm(i,j) * (  &
+                       rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End addition of the second term to defor12.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Update the boundary for defor12 (might need to change later).
+ 
+    IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN
+      DO j = jts, jte
+      DO k = kts, kte
+        defor12(ids,k,j) = defor12(ids+1,k,j)
+      END DO
+      END DO
+    END IF
+ 
+    IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
+      DO k = kts, kte
+      DO i = its, ite
+        defor12(i,k,jds) = defor12(i,k,jds+1)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
+      DO j = jts, jte
+      DO k = kts, kte
+        defor12(ide,k,j) = defor12(ide-1,k,j)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
+      DO k = kts, kte
+      DO i = its, ite
+        defor12(i,k,jde) = defor12(i,k,jde-1)
+      END DO
+      END DO
+    END IF
+
+! End update of boundary for defor12.
+!-----------------------------------------------------------------------
+
+! Comments 10-MAR-05
+! Further deformation terms not needed for 2-dimensional Smagorinsky diffusion,
+! so those terms have not been dealt with yet.
+! A "y" has simply been added to all map scale factors to allow the model to
+! compile without errors.
+
+!-----------------------------------------------------------------------
+! Calculate dw/dx.
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+
+    IF ( config_flags%periodic_x ) i_start = its
+    IF ( config_flags%periodic_x ) i_end = MIN( ite, ide )
+    IF ( config_flags%periodic_y ) j_end = MIN( jte, jde )
+
+! Square the mapscale factor.
+
+    DO j = jts, jte
+    DO i = its, ite
+      mm(i,j) = msfux(i,j) * msfuy(i,j)
+    END DO
+    END DO
+
+! Apply a coordinate transformation to vertical velocity, w.  This is for both
+! defor13 and defor23.
+
+    DO j = j_start, j_end
+    DO k = kts, kte
+    DO i = i_start, i_end
+      hat(i,k,j) = w(i,k,j) / msfty(i,j)
+    END DO
+    END DO
+    END DO
+
+    i = i_start-1
+    DO j = j_start, MIN( jte, jde-1 )
+    DO k = kts, kte
+      hat(i,k,j) = w(i,k,j) / msfty(i,j)
+    END DO
+    END DO
+
+    j = j_start-1
+    DO k = kts, kte
+    DO i = i_start, MIN( ite, ide-1 )
+      hat(i,k,j) = w(i,k,j) / msfty(i,j)
+    END DO
+    END DO
+
+! QUESTION: What is this for?
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      hatavg(i,k,j) = 0.25 * (  &
+                      hat(i  ,k  ,j) +  &
+                      hat(i  ,k+1,j) +  &
+                      hat(i-1,k  ,j) +  &
+                      hat(i-1,k+1,j) )
+    END DO
+    END DO
+    END DO
+
+! Calculate dw/dx.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zx(i,k,j) *  &
+                    0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of dw/dx.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add the first term (dw/dx) to defor13 (dw/dx+du/dz) at vorticity
+! points.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      defor13(i,k,j) = mm(i,j) * (  &
+                       rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      defor13(i,kts,j  ) = 0.0
+      defor13(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+! End addition of the first term to defor13.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate du/dz.
+
+    IF ( config_flags%mix_full_fields ) THEN
+
+      DO j = j_start, j_end
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+        tmp1(i,k,j) = ( u(i,k,j) - u(i,k-1,j) ) *  &
+                      0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) )
+      END DO
+      END DO
+      END DO
+
+    ELSE
+
+      DO j = j_start, j_end
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+        tmp1(i,k,j) = ( u(i,k,j) - u_base(k) - u(i,k-1,j) + u_base(k-1) ) *  &
+                      0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) )
+      END DO
+      END DO
+      END DO
+
+    END IF
+
+!-----------------------------------------------------------------------
+! Add the second term (du/dz) to defor13 (dw/dx+du/dz) at vorticity
+! points.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      defor13(i,k,j) = defor13(i,k,j) + tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End addition of the second term to defor13.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dw/dy.
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%periodic_y ) j_end = MIN( jte, jde )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+! Square mapscale factor.
+
+    DO j = jts, jte
+    DO i = its, ite
+      mm(i,j) = msfvx(i,j) * msfvy(i,j)
+    END DO
+    END DO
+
+! Apply a coordinate transformation to vertical velocity, w.  Added by CW 7/19/07
+
+    DO j = j_start, j_end
+    DO k = kts, kte
+    DO i = i_start, i_end
+      hat(i,k,j) = w(i,k,j) / msftx(i,j)
+    END DO
+    END DO
+    END DO
+
+    i = i_start-1
+    DO j = j_start, MIN( jte, jde-1 )
+    DO k = kts, kte
+      hat(i,k,j) = w(i,k,j) / msftx(i,j)
+    END DO
+    END DO
+
+    j = j_start-1
+    DO k = kts, kte
+    DO i = i_start, MIN( ite, ide-1 )
+      hat(i,k,j) = w(i,k,j) / msftx(i,j)
+    END DO
+    END DO
+
+! QUESTION: What is this for?
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      hatavg(i,k,j) = 0.25 * (  &
+                      hat(i,k  ,j  ) +  &
+                      hat(i,k+1,j  ) +  &
+                      hat(i,k  ,j-1) +  &
+                      hat(i,k+1,j-1) )
+    END DO
+    END DO
+    END DO
+
+! Calculate dw/dy and store in tmp1.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zy(i,k,j) *  &
+                    0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) )
+    END DO
+    END DO
+    END DO
+
+! End calculation of dw/dy.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add the first term (dw/dy) to defor23 (dw/dy+dv/dz) at vorticity
+! points.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      defor23(i,k,j) = mm(i,j) * (  &
+                       rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      defor23(i,kts,j  ) = 0.0
+      defor23(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+! End addition of the first term to defor23.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Calculate dv/dz.
+
+    IF ( config_flags%mix_full_fields ) THEN
+
+      DO j = j_start, j_end
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+        tmp1(i,k,j) = ( v(i,k,j) - v(i,k-1,j) ) *  &
+                      0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) )
+      END DO
+      END DO
+      END DO
+
+    ELSE
+
+      DO j = j_start, j_end
+      DO k = kts+1, ktf
+      DO i = i_start, i_end
+        tmp1(i,k,j) = ( v(i,k,j) - v_base(k) - v(i,k-1,j) + v_base(k-1) ) *  &
+                      0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) )
+      END DO
+      END DO
+      END DO
+
+    END IF
+
+! End calculation of dv/dz.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add the second term (dv/dz) to defor23 (dw/dy+dv/dz) at vorticity
+! points.
+
+! Add tmp1 to defor23.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      defor23(i,k,j) = defor23(i,k,j) + tmp1(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! End addition of the second term to defor23.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Update the boundary for defor13 and defor23 (might need to change
+! later).
+
+    IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN
+      DO j = jts, jte
+      DO k = kts, kte
+        defor13(ids,k,j) = defor13(ids+1,k,j)
+        defor23(ids,k,j) = defor23(ids+1,k,j)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
+      DO k = kts, kte
+      DO i = its, ite
+        defor13(i,k,jds) = defor13(i,k,jds+1)
+        defor23(i,k,jds) = defor23(i,k,jds+1)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
+      DO j = jts, jte
+      DO k = kts, kte
+        defor13(ide,k,j) = defor13(ide-1,k,j)
+        defor23(ide,k,j) = defor23(ide-1,k,j)
+      END DO
+      END DO
+    END IF
+
+    IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
+      DO k = kts, kte
+      DO i = its, ite
+        defor13(i,k,jde) = defor13(i,k,jde-1)
+        defor23(i,k,jde) = defor23(i,k,jde-1)
+      END DO
+      END DO
+    END IF
+
+! End update of boundary for defor13 and defor23.
+!-----------------------------------------------------------------------
+
+! The second three (defor12, defor13, defor23) of six deformation terms
+! are now calculated at vorticity points.
+!=======================================================================
+
+    END SUBROUTINE cal_deform_and_div
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE calculate_km_kh( config_flags, dt,                        &
+                                dampcoef, zdamp, damp_opt,               &
+                                xkmh, xkmv, xkhh, xkhv,                  &
+                                BN2, khdif, kvdif, div,                  &
+                                defor11, defor22, defor33,               &
+                                defor12, defor13, defor23,               &
+                                tke, p8w, t8w, theta, t, p, moist,       &
+                                dn, dnw, dx, dy, rdz, rdzw, isotropic,   &
+                                n_moist, cf1, cf2, cf3, warm_rain,       &
+                                mix_upper_bound,                         &
+                                msftx, msfty,                            &
+                                ids, ide, jds, jde, kds, kde,            &
+                                ims, ime, jms, jme, kms, kme,            &
+                                its, ite, jts, jte, kts, kte             )
+
+! History:     Sep 2003  Changes by George Bryan and Jason Knievel, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              ...       ...
+
+! Purpose:     This routine calculates exchange coefficients for the TKE
+!              scheme.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags   
+
+    INTEGER, INTENT( IN )  &
+    :: n_moist, damp_opt, isotropic,  & 
+       ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte 
+
+    LOGICAL, INTENT( IN )  &
+    :: warm_rain
+
+    REAL, INTENT( IN )  &
+    :: dx, dy, zdamp, dt, dampcoef, cf1, cf2, cf3, khdif, kvdif
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: dnw, dn
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), INTENT( INOUT )  &
+    :: moist
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: xkmv, xkmh, xkhv, xkhh, BN2  
+
+    REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),  INTENT( IN )  &
+    :: defor11, defor22, defor33, defor12, defor13, defor23,      &
+       div, rdz, rdzw, p8w, t8w, theta, t, p
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tke
+
+    REAL, INTENT( IN )  &
+    :: mix_upper_bound
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: msftx, msfty
+
+! Local variables.
+
+    INTEGER  &
+    :: i_start, i_end, j_start, j_end, ktf, i, j, k
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    CALL calculate_N2( config_flags, BN2, moist,           &
+                       theta, t, p, p8w, t8w,              &
+                       dnw, dn, rdz, rdzw,                 &
+                       n_moist, cf1, cf2, cf3, warm_rain,  &
+                       ids, ide, jds, jde, kds, kde,       &
+                       ims, ime, jms, jme, kms, kme,       &
+                       its, ite, jts, jte, kts, kte        )
+
+! Select a scheme for calculating diffusion coefficients.
+
+    km_coef: SELECT CASE( config_flags%km_opt )
+
+      CASE (1)
+            CALL isotropic_km( config_flags, xkmh, xkmv,                &
+                               xkhh, xkhv, khdif, kvdif,                &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               its, ite, jts, jte, kts, kte             )
+      CASE (2)  
+            CALL tke_km(       config_flags, xkmh, xkmv,                &
+                               xkhh, xkhv, BN2, tke, p8w, t8w, theta,   &
+                               rdz, rdzw, dx, dy, dt, isotropic,        &
+                               mix_upper_bound, msftx, msfty,           &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               its, ite, jts, jte, kts, kte             )
+      CASE (3)  
+            CALL smag_km(      config_flags, xkmh, xkmv,                &
+                               xkhh, xkhv, BN2, div,                    &
+                               defor11, defor22, defor33,               &
+                               defor12, defor13, defor23,               &
+                               rdzw, dx, dy, dt, isotropic,             &
+                               mix_upper_bound, msftx, msfty,           &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               its, ite, jts, jte, kts, kte             )
+      CASE (4)  
+            CALL smag2d_km(    config_flags, xkmh, xkmv,                &
+                               xkhh, xkhv, defor11, defor22, defor12,   &
+                               rdzw, dx, dy, msftx, msfty,              &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               its, ite, jts, jte, kts, kte             )
+      CASE DEFAULT
+            CALL wrf_error_fatal( 'Please choose diffusion coefficient scheme' )
+
+    END SELECT km_coef
+
+    IF ( damp_opt .eq. 1 ) THEN
+      CALL cal_dampkm( config_flags, xkmh, xkhh, xkmv, xkhv,    &
+                       dx, dy, dt, dampcoef, rdz, rdzw, zdamp,  &
+                       msftx, msfty,                            &
+                       ids, ide, jds, jde, kds, kde,            &
+                       ims, ime, jms, jme, kms, kme,            &
+                       its, ite, jts, jte, kts, kte             )
+    END IF
+
+    END SUBROUTINE calculate_km_kh
+
+!=======================================================================
+
+SUBROUTINE cal_dampkm( config_flags,xkmh,xkhh,xkmv,xkhv,                       &
+                       dx,dy,dt,dampcoef,                                      &
+                       rdz, rdzw ,zdamp,                                       &
+                       msftx, msfty,                                           &
+                       ids,ide, jds,jde, kds,kde,                              &
+                       ims,ime, jms,jme, kms,kme,                              &
+                       its,ite, jts,jte, kts,kte                              )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type) , INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   )           :: ids, ide, jds, jde, kds, kde, &
+                                                 ims, ime, jms, jme, kms, kme, &
+                                                 its, ite, jts, jte, kts, kte
+
+   REAL    ,          INTENT(IN   )           :: zdamp,dx,dy,dt,dampcoef
+
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT)    ::     xkmh , &
+                                                                         xkhh , &
+                                                                         xkmv , &
+                                                                         xkhv 
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   )    ::     rdz,   &
+                                                                         rdzw
+
+   REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN   )             ::     msftx, &
+                                                                         msfty
+! LOCAL VARS
+
+   INTEGER :: i_start, i_end, j_start, j_end, ktf, ktfm1, i, j, k
+   REAL    :: kmmax,kmmvmax,degrad90,dz,tmp
+   REAL    :: ds
+   REAL ,     DIMENSION( its:ite )                                ::   deltaz
+   REAL , DIMENSION( its:ite, kts:kte, jts:jte)                   ::   dampk,dampkv
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf = min(kte,kde-1)
+   ktfm1 = ktf-1
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+! keep upper damping diffusion away from relaxation zones at boundaries if used
+   IF(config_flags%specified .OR. config_flags%nested)THEN
+     i_start = MAX(i_start,ids+config_flags%spec_bdy_width-1)
+     i_end   = MIN(i_end,ide-config_flags%spec_bdy_width)
+     j_start = MAX(j_start,jds+config_flags%spec_bdy_width-1)
+     j_end   = MIN(j_end,jde-config_flags%spec_bdy_width)
+   ENDIF
+
+   kmmax=dx*dx/dt
+   degrad90=DEGRAD*90.
+   DO j = j_start, j_end
+
+      k=ktf
+      DO i = i_start, i_end
+         ! Unmodified dx used above may produce very large diffusivities
+         ! when msftx is very large.  And the above formula ignores the fact
+         ! that dy may now be different from dx as well.  Let's fix that by
+         ! defining a "ds" as the minimum of the "real-space" (physical
+         ! distance) values of dx and dy, and then using that smallest value
+         ! to calculate a point-by-point kmmax
+         ds = MIN(dx/msftx(i,j),dy/msfty(i,j))
+         kmmax=ds*ds/dt
+
+!         deltaz(i)=0.5*dnw(k)/zeta_z(i,j)
+!         dz=dnw(k)/zeta_z(i,j)
+         dz = 1./rdzw(i,k,j)
+         deltaz(i) = 0.5*dz
+
+         kmmvmax=dz*dz/dt
+         tmp=min(deltaz(i)/zdamp,1.)
+         dampk(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef
+         dampkv(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax*dampcoef
+! set upper limit on vertical K (based on horizontal K)
+         dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j))
+
+      ENDDO
+
+      DO k = ktfm1,kts,-1
+      DO i = i_start, i_end
+         ! Unmodified dx used above may produce very large diffusivities
+         ! when msftx is very large.  And the above formula ignores the fact
+         ! that dy may now be different from dx as well.  Let's fix that by
+         ! defining a "ds" as the minimum of the "real-space" (physical
+         ! distance) values of dx and dy, and then using that smallest value
+         ! to calculate a point-by-point kmmax
+         ds = MIN(dx/msftx(i,j),dy/msfty(i,j))
+         kmmax=ds*ds/dt
+
+!         deltaz(i)=deltaz(i)+dn(k)/zeta_z(i,j)
+!         dz=dnw(k)/zeta_z(i,j)
+         dz = 1./rdz(i,k,j)
+         deltaz(i) = deltaz(i) + dz
+         dz = 1./rdzw(i,k,j)
+
+         kmmvmax=dz*dz/dt
+         tmp=min(deltaz(i)/zdamp,1.)
+         dampk(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef
+         dampkv(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax*dampcoef
+! set upper limit on vertical K (based on horizontal K)
+         dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j))
+      ENDDO
+      ENDDO
+
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+      xkmh(i,k,j)=max(xkmh(i,k,j),dampk(i,k,j))
+      xkhh(i,k,j)=max(xkhh(i,k,j),dampk(i,k,j))
+      xkmv(i,k,j)=max(xkmv(i,k,j),dampkv(i,k,j))
+      xkhv(i,k,j)=max(xkhv(i,k,j),dampkv(i,k,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE cal_dampkm
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE calculate_N2( config_flags, BN2, moist,           &
+                             theta, t, p, p8w, t8w,              &
+                             dnw, dn, rdz, rdzw,                 &
+                             n_moist, cf1, cf2, cf3, warm_rain,  &
+                             ids, ide, jds, jde, kds, kde,       &
+                             ims, ime, jms, jme, kms, kme,       &
+                             its, ite, jts, jte, kts, kte        )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: n_moist,  &
+       ids, ide, jds, jde, kds, kde, &
+       ims, ime, jms, jme, kms, kme, &
+       its, ite, jts, jte, kts, kte
+
+    LOGICAL, INTENT( IN )  &
+    :: warm_rain
+
+    REAL, INTENT( IN )  &
+    :: cf1, cf2, cf3
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: BN2
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: rdz, rdzw, theta, t, p, p8w, t8w 
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: dnw, dn
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), INTENT( INOUT )  &
+    :: moist
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, ispe, ktes1, ktes2,  &
+       i_start, i_end, j_start, j_end
+
+    REAL  &
+    :: coefa, thetaep1, thetaem1, qc_cr, es, tc, qlpqi, qsw, qsi,  &
+       tmpdz, xlvqv, thetaesfc, thetasfc, qvtop, qvsfc, thetatop, thetaetop
+
+    REAL, DIMENSION( its:ite, jts:jte )  &
+    :: tmp1sfc, tmp1top
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: tmp1, qvs, qctmp
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    qc_cr   = 0.00001  ! in Kg/Kg
+
+    ktf     = MIN( kte, kde-1 )
+    ktes1   = kte-1
+    ktes2   = kte-2
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-2 ,jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+ 
+    IF ( P_QC .GT. PARAM_FIRST_SCALAR) THEN
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        qctmp(i,k,j) = moist(i,k,j,P_QC)
+      END DO
+      END DO
+      END DO
+    ELSE
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         qctmp(i,k,j) = 0.0
+      END DO
+      END DO
+      END DO
+    END IF
+ 
+    DO j = jts, jte
+    DO k = kts, kte
+    DO i = its, ite
+      tmp1(i,k,j) = 0.0
+    END DO
+    END DO
+    END DO
+ 
+    DO j = jts,jte
+    DO i = its,ite
+      tmp1sfc(i,j) = 0.0
+      tmp1top(i,j) = 0.0
+    END DO
+    END DO
+ 
+    DO ispe = PARAM_FIRST_SCALAR, n_moist
+      IF ( ispe .EQ. P_QV .OR. ispe .EQ. P_QC .OR. ispe .EQ. P_QI) THEN
+        DO j = j_start, j_end
+        DO k = kts, ktf
+        DO i = i_start, i_end
+          tmp1(i,k,j) = tmp1(i,k,j) + moist(i,k,j,ispe)
+        END DO
+        END DO
+        END DO
+ 
+        DO j = j_start, j_end
+        DO i = i_start, i_end
+          tmp1sfc(i,j) = tmp1sfc(i,j) +  &
+                         cf1 * moist(i,1,j,ispe) +  &
+                         cf2 * moist(i,2,j,ispe) +  &
+                         cf3 * moist(i,3,j,ispe)
+          tmp1top(i,j) = tmp1top(i,j) +  &
+                         moist(i,ktes1,j,ispe) + &
+                         ( moist(i,ktes1,j,ispe) - moist(i,ktes2,j,ispe) ) *  &
+                         0.5 * dnw(ktes1) / dn(ktes1)
+        END DO
+        END DO
+      END IF
+    END DO
+
+! Calculate saturation mixing ratio.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tc         = t(i,k,j) - SVPT0
+      es         = 1000.0 * SVP1 * EXP( SVP2 * tc / ( t(i,k,j) - SVP3 ) )
+      qvs(i,k,j) = EP_2 * es / ( p(i,k,j) - es )
+    END DO
+    END DO
+    END DO
+ 
+    DO j = j_start, j_end
+    DO k = kts+1, ktf-1
+    DO i = i_start, i_end
+      tmpdz = 1.0 / rdz(i,k,j) + 1.0 / rdz(i,k+1,j)
+      IF ( moist(i,k,j,P_QV) .GE. qvs(i,k,j) .OR. qctmp(i,k,j) .GE. qc_cr) THEN
+        xlvqv      = XLV * moist(i,k,j,P_QV)
+        coefa      = ( 1.0 + xlvqv / R_d / t(i,k,j) ) / &
+                     ( 1.0 + XLV * xlvqv / Cp / R_v / t(i,k,j) / t(i,k,j) ) /  &
+                     theta(i,k,j)
+        thetaep1   = theta(i,k+1,j) *  &
+                     ( 1.0 + XLV * qvs(i,k+1,j) / Cp / t(i,k+1,j) )
+        thetaem1   = theta(i,k-1,j) *  &
+                     ( 1.0 + XLV * qvs(i,k-1,j) / Cp / t(i,k-1,j) )
+        BN2(i,k,j) = g * ( coefa * ( thetaep1 - thetaem1 ) / tmpdz -  &
+                     ( tmp1(i,k+1,j) - tmp1(i,k-1,j) ) / tmpdz )
+      ELSE
+        BN2(i,k,j) = g * ( (theta(i,k+1,j) - theta(i,k-1,j) ) /  &
+                     theta(i,k,j) / tmpdz +  &
+                     1.61 * ( moist(i,k+1,j,P_QV) - moist(i,k-1,j,P_QV) ) / &
+                     tmpdz -   &
+                     ( tmp1(i,k+1,j) - tmp1(i,k-1,j) ) / tmpdz )
+      ENDIF
+    END DO
+    END DO
+    END DO
+
+    k = kts
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      tmpdz     = 1.0 / rdz(i,k+1,j) + 0.5 / rdzw(i,k,j)
+      thetasfc  = T8w(i,kts,j) / ( p8w(i,k,j) / p1000mb )**( R_d / Cp )
+      IF ( moist(i,k,j,P_QV) .GE. qvs(i,k,j) .OR. qctmp(i,k,j) .GE. qc_cr) THEN
+        qvsfc     = cf1 * qvs(i,1,j) +  &
+                    cf2 * qvs(i,2,j) +  &
+                    cf3 * qvs(i,3,j)
+        xlvqv      = XLV * moist(i,k,j,P_QV)
+        coefa      = ( 1.0 + xlvqv / R_d / t(i,k,j) ) /  &
+                     ( 1.0 + XLV * xlvqv / Cp / R_v / t(i,k,j) / t(i,k,j) ) /  &
+                     theta(i,k,j)
+        thetaep1   = theta(i,k+1,j) *  &
+                     ( 1.0 + XLV * qvs(i,k+1,j) / Cp / t(i,k+1,j) )
+        thetaesfc  = thetasfc *  &
+                     ( 1.0 + XLV * qvsfc / Cp / t8w(i,kts,j) )
+        BN2(i,k,j) = g * ( coefa * ( thetaep1 - thetaesfc ) / tmpdz -  &
+                     ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz )
+      ELSE
+        qvsfc     = cf1 * moist(i,1,j,P_QV) +  &
+                    cf2 * moist(i,2,j,P_QV) +  &
+                    cf3 * moist(i,3,j,P_QV)
+!        BN2(i,k,j) = g * ( ( theta(i,k+1,j) - thetasfc ) /  &
+!                     theta(i,k,j) / tmpdz +  &
+!                     1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) /  &
+!                     tmpdz -  &
+!                     ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz  )
+!...... MARTA: change in computation of BN2 at the surface, WCS 040331
+
+        tmpdz= 1./rdzw(i,k,j) ! controlare come calcola rdzw
+        BN2(i,k,j) = g * ( ( theta(i,k+1,j) - theta(i,k,j)) /  &
+                     theta(i,k,j) / tmpdz +  &
+                     1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) /  &
+                     tmpdz -  &
+                     ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz  )
+! end of MARTA/WCS change
+
+      ENDIF
+    END DO
+    END DO
+ 
+
+!...... MARTA: change in computation of BN2 at the top, WCS 040331
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+       BN2(i,ktf,j)=BN2(i,ktf-1,j)
+    END DO
+    END DO   
+! end of MARTA/WCS change
+
+    END SUBROUTINE calculate_N2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE isotropic_km( config_flags,                                         &
+                         xkmh,xkmv,xkhh,xkhv,khdif,kvdif,                      &
+                         ids,ide, jds,jde, kds,kde,                            &
+                         ims,ime, jms,jme, kms,kme,                            &
+                         its,ite, jts,jte, kts,kte                            )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type) , INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   )           :: ids, ide, jds, jde, kds, kde, &
+                                                 ims, ime, jms, jme, kms, kme, &
+                                                 its, ite, jts, jte, kts, kte
+
+   REAL    ,          INTENT(IN   )           :: khdif,kvdif               
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::     xkmh, &
+                                                                         xkmv, &
+                                                                         xkhh, &
+                                                                         xkhv
+! LOCAL VARS
+
+   INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k
+   REAL    :: khdif3,kvdif3
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf = kte
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+!   khdif3=khdif*3.
+!   kvdif3=kvdif*3.
+   khdif3=khdif/prandtl
+   kvdif3=kvdif/prandtl
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end
+      xkmh(i,k,j)=khdif
+      xkmv(i,k,j)=kvdif
+      xkhh(i,k,j)=khdif3
+      xkhv(i,k,j)=kvdif3
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE isotropic_km
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE smag_km( config_flags,xkmh,xkmv,xkhh,xkhv,BN2,                      &
+                    div,defor11,defor22,defor33,defor12,                       &
+                    defor13,defor23,                                           &
+                    rdzw,dx,dy,dt,isotropic,                                   &
+                    mix_upper_bound, msftx, msfty,                             &
+                    ids,ide, jds,jde, kds,kde,                                 &
+                    ims,ime, jms,jme, kms,kme,                                 &
+                    its,ite, jts,jte, kts,kte                                  )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type) , INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   )           :: ids, ide, jds, jde, kds, kde, &
+                                                 ims, ime, jms, jme, kms, kme, &
+                                                 its, ite, jts, jte, kts, kte
+
+   INTEGER ,          INTENT(IN   )           :: isotropic
+   REAL    ,          INTENT(IN   )           :: dx, dy, dt, mix_upper_bound
+
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) ::      BN2, &
+                                                                         rdzw
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::     xkmh, &
+                                                                         xkmv, &
+                                                                         xkhh, &
+                                                                         xkhv
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ),  INTENT(IN   )      ::      &    
+                                                                      defor11, &
+                                                                      defor22, &
+                                                                      defor33, &
+                                                                      defor12, &
+                                                                      defor13, &
+                                                                      defor23, &
+                                                                          div
+   REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN   ) ::                msftx, &
+                                                                        msfty
+! LOCAL VARS
+
+   INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k
+   REAL    :: deltas, tmp, pr, mlen_h, mlen_v, c_s
+
+   REAL, DIMENSION( its:ite , kts:kte , jts:jte )                 ::     def2
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf = min(kte,kde-1)
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+   pr = prandtl
+   c_s = config_flags%c_s
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      def2(i,k,j)=0.5*(defor11(i,k,j)*defor11(i,k,j) + &
+                       defor22(i,k,j)*defor22(i,k,j) + &
+                       defor33(i,k,j)*defor33(i,k,j))
+   enddo
+   enddo
+   enddo
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      tmp=0.25*(defor12(i  ,k,j)+defor12(i  ,k,j+1)+ &
+                defor12(i+1,k,j)+defor12(i+1,k,j+1))
+      def2(i,k,j)=def2(i,k,j)+tmp*tmp
+   enddo
+   enddo
+   enddo
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      tmp=0.25*(defor13(i  ,k+1,j)+defor13(i  ,k,j)+ &
+                defor13(i+1,k+1,j)+defor13(i+1,k,j))
+      def2(i,k,j)=def2(i,k,j)+tmp*tmp
+   enddo
+   enddo
+   enddo
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      tmp=0.25*(defor23(i,k+1,j  )+defor23(i,k,j  )+ &
+                defor23(i,k+1,j+1)+defor23(i,k,j+1))
+      def2(i,k,j)=def2(i,k,j)+tmp*tmp
+   enddo
+   enddo
+   enddo
+!
+   IF (isotropic .EQ. 0) THEN
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         mlen_h=sqrt(dx/msftx(i,j) * dy/msfty(i,j))
+         mlen_v= 1./rdzw(i,k,j)
+         tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr)
+         tmp=tmp**0.5
+         xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h )
+         xkmh(i,k,j)=min(xkmh(i,k,j), mix_upper_bound * mlen_h * mlen_h / dt )
+         xkmv(i,k,j)=max(c_s*c_s*mlen_v*mlen_v*tmp, 1.0E-6*mlen_v*mlen_v )
+         xkmv(i,k,j)=min(xkmv(i,k,j), mix_upper_bound * mlen_v * mlen_v / dt )
+         xkhh(i,k,j)=xkmh(i,k,j)/pr
+         xkhh(i,k,j)=min(xkhh(i,k,j), mix_upper_bound * mlen_h * mlen_h / dt )
+         xkhv(i,k,j)=xkmv(i,k,j)/pr
+         xkhv(i,k,j)=min(xkhv(i,k,j), mix_upper_bound * mlen_v * mlen_v / dt )
+      ENDDO
+      ENDDO
+      ENDDO
+   ELSE
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         deltas=(dx/msftx(i,j) * dy/msfty(i,j)/rdzw(i,k,j))**0.33333333
+         tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr)
+         tmp=tmp**0.5
+         xkmh(i,k,j)=max(c_s*c_s*deltas*deltas*tmp, 1.0E-6*deltas*deltas )
+         xkmh(i,k,j)=min(xkmh(i,k,j), mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt )
+         xkmv(i,k,j)=xkmh(i,k,j)
+         xkmv(i,k,j)=min(xkmv(i,k,j), mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt )
+         xkhh(i,k,j)=xkmh(i,k,j)/pr
+         xkhh(i,k,j)=min(xkhh(i,k,j), mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt )
+         xkhv(i,k,j)=xkmv(i,k,j)/pr
+         xkhv(i,k,j)=min(xkhv(i,k,j), mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt )
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+END SUBROUTINE smag_km
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE smag2d_km( config_flags,xkmh,xkmv,xkhh,xkhv,                        &
+                    defor11,defor22,defor12,                                   &
+                    rdzw,dx,dy,msftx, msfty,                                   &
+                    ids,ide, jds,jde, kds,kde,                                 &
+                    ims,ime, jms,jme, kms,kme,                                 &
+                    its,ite, jts,jte, kts,kte                                  )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type) , INTENT(IN   ) :: config_flags
+
+   INTEGER ,          INTENT(IN   )           :: ids, ide, jds, jde, kds, kde, &
+                                                 ims, ime, jms, jme, kms, kme, &
+                                                 its, ite, jts, jte, kts, kte
+
+   REAL    ,          INTENT(IN   )           :: dx, dy
+
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN   ) ::     rdzw
+
+   REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::     xkmh, &
+                                                                         xkmv, &
+                                                                         xkhh, &
+                                                                         xkhv
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ),  INTENT(IN   )      ::      &    
+                                                                      defor11, &
+                                                                      defor22, &
+                                                                      defor12
+
+   REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN   ) ::                msftx, &
+                                                                        msfty
+! LOCAL VARS
+
+   INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k
+   REAL    :: deltas, tmp, pr, mlen_h, c_s
+
+   REAL, DIMENSION( its:ite , kts:kte , jts:jte )                 ::     def2
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf = min(kte,kde-1)
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+   pr=prandtl
+   c_s = config_flags%c_s
+
+   do j=j_start,j_end
+   do k=kts,ktf
+   do i=i_start,i_end
+      def2(i,k,j)=0.25*((defor11(i,k,j)-defor22(i,k,j))*(defor11(i,k,j)-defor22(i,k,j)))
+      tmp=0.25*(defor12(i  ,k,j)+defor12(i  ,k,j+1)+ &
+                defor12(i+1,k,j)+defor12(i+1,k,j+1))
+      def2(i,k,j)=def2(i,k,j)+tmp*tmp
+   enddo
+   enddo
+   enddo
+!
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+         mlen_h=sqrt(dx/msftx(i,j) * dy/msfty(i,j))
+         tmp=sqrt(def2(i,k,j))
+!        xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h )
+         xkmh(i,k,j)=c_s*c_s*mlen_h*mlen_h*tmp
+         xkmh(i,k,j)=min(xkmh(i,k,j), 10.*mlen_h )
+         xkmv(i,k,j)=0.
+         xkhh(i,k,j)=xkmh(i,k,j)/pr
+         xkhv(i,k,j)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+
+END SUBROUTINE smag2d_km
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_km( config_flags, xkmh, xkmv, xkhh, xkhv,         &
+                       bn2, tke, p8w, t8w, theta,                    &
+                       rdz, rdzw, dx,dy, dt, isotropic,              &
+                       mix_upper_bound, msftx, msfty,                &
+                       ids, ide, jds, jde, kds, kde,                 &
+                       ims, ime, jms, jme, kms, kme,                 &
+                       its, ite, jts, jte, kts, kte                  )
+
+! History:     Sep 2003   Changes by Jason Knievel and George Bryan, NCAR
+!              Oct 2001   Converted to mass core by Bill Skamarock, NCAR
+!              ...        ...
+
+! Purpose:     This routine calculates the exchange coefficients for the
+!              TKE turbulence parameterization.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  :: isotropic
+    REAL, INTENT( IN )  &
+    :: dx, dy, dt
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: tke, p8w, t8w, theta, rdz, rdzw, bn2
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: xkmh, xkmv, xkhh, xkhv
+
+    REAL, INTENT( IN )  &
+    :: mix_upper_bound
+
+   REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN   ) ::     msftx, &
+                                                             msfty
+! Local variables.
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: l_scale
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: dthrdn
+
+    REAL  &
+    :: deltas, tmp, mlen_s, mlen_h, mlen_v, tmpdz,  &
+       thetasfc, thetatop, minkx, pr_inv, pr_inv_h, pr_inv_v, c_k
+
+    INTEGER  &
+    :: i_start, i_end, j_start, j_end, ktf, i, j, k
+
+    REAL, PARAMETER :: tke_seed_value = 1.e-06
+    REAL            :: tke_seed
+    REAL, PARAMETER :: epsilon = 1.e-10
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-2, jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+! in the absence of surface drag or a surface heat flux, there
+! is no way to generate tke without pre-existing tke.  Use
+! tke_seed if the drag and flux are off.
+
+    c_k = config_flags%c_k
+    tke_seed = tke_seed_value
+    if( (config_flags%tke_drag_coefficient .gt. epsilon) .or.  &
+        (config_flags%tke_heat_flux .gt. epsilon)  ) tke_seed = 0.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf-1
+    DO i = i_start, i_end
+      tmpdz         = 1.0 / ( rdz(i,k+1,j) + rdz(i,k,j) )
+      dthrdn(i,k,j) = ( theta(i,k+1,j) - theta(i,k-1,j) ) / tmpdz
+    END DO
+    END DO
+    END DO
+
+    k = kts
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      tmpdz         = 1.0 / ( rdzw(i,k+1,j) + rdzw(i,k,j) )
+      thetasfc      = T8w(i,kts,j) / ( p8w(i,k,j) / p1000mb )**( R_d / Cp )
+      dthrdn(i,k,j) = ( theta(i,k+1,j) - thetasfc ) / tmpdz
+    END DO
+    END DO
+
+    k = ktf
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      tmpdz         = 1.0 / rdz(i,k,j) + 0.5 / rdzw(i,k,j)
+      thetatop      = T8w(i,kde,j) / ( p8w(i,kde,j) / p1000mb )**( R_d / Cp )
+      dthrdn(i,k,j) = ( thetatop - theta(i,k-1,j) ) / tmpdz
+    END DO
+    END DO
+
+    IF ( isotropic .EQ. 0 ) THEN
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        mlen_h = SQRT( dx/msftx(i,j) * dy/msfty(i,j) )
+        tmp    = SQRT( MAX( tke(i,k,j), tke_seed ) )
+        deltas = 1.0 / rdzw(i,k,j)
+        mlen_v = deltas
+        IF ( dthrdn(i,k,j) .GT. 0.) THEN
+          mlen_s = 0.76 * tmp / ( ABS( g / theta(i,k,j) * dthrdn(i,k,j) ) )**0.5
+          mlen_v = MIN( mlen_v, mlen_s )
+        END IF
+        xkmh(i,k,j)  = MAX( c_k * tmp * mlen_h, 1.0E-6 * mlen_h * mlen_h )
+        xkmh(i,k,j)  = MIN( xkmh(i,k,j), mix_upper_bound * mlen_h *mlen_h / dt )
+        xkmv(i,k,j)  = MAX( c_k * tmp * mlen_v, 1.0E-6 * deltas * deltas )
+        xkmv(i,k,j)  = MIN( xkmv(i,k,j), mix_upper_bound * deltas *deltas / dt )
+        pr_inv_h     = 1./prandtl
+        pr_inv_v     = 1.0 + 2.0 * mlen_v / deltas
+        xkhh(i,k,j)  = xkmh(i,k,j) * pr_inv_h
+        xkhv(i,k,j)  = xkmv(i,k,j) * pr_inv_v
+      END DO
+      END DO
+      END DO
+    ELSE
+      CALL calc_l_scale( config_flags, tke, BN2, l_scale,      &
+                         i_start, i_end, ktf, j_start, j_end,  &
+                         dx, dy, rdzw, msftx, msfty,           &
+                         ids, ide, jds, jde, kds, kde,         &
+                         ims, ime, jms, jme, kms, kme,         &
+                         its, ite, jts, jte, kts, kte          )
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        tmp          = SQRT( MAX( tke(i,k,j), tke_seed ) )
+        deltas       = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333
+        xkmh(i,k,j)  = c_k * tmp * l_scale(i,k,j)
+        xkmh(i,k,j)  = MIN( mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt,  xkmh(i,k,j) )
+        xkmv(i,k,j)  = c_k * tmp * l_scale(i,k,j)
+        xkmv(i,k,j)  = MIN( mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt ,  xkmv(i,k,j) )
+        pr_inv       = 1.0 + 2.0 * l_scale(i,k,j) / deltas
+        xkhh(i,k,j)  = MIN( mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt, xkmh(i,k,j) * pr_inv )
+        xkhv(i,k,j)  = MIN( mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt, xkmv(i,k,j) * pr_inv )
+      END DO
+      END DO
+      END DO
+    END IF
+
+    END SUBROUTINE tke_km
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE calc_l_scale( config_flags, tke, BN2, l_scale,      &
+                             i_start, i_end, ktf, j_start, j_end,  &
+                             dx, dy, rdzw, msftx, msfty,           &
+                             ids, ide, jds, jde, kds, kde,         &
+                             ims, ime, jms, jme, kms, kme,         &
+                             its, ite, jts, jte, kts, kte          )
+
+! History:     Sep 2003   Written by Bryan and Knievel, NCAR
+
+! Purpose:     This routine calculates the length scale, based on stability,
+!              for TKE parameterization of subgrid-scale turbulence.
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: i_start, i_end, ktf, j_start, j_end,  &
+       ids, ide, jds, jde, kds, kde,         &
+       ims, ime, jms, jme, kms, kme,         &
+       its, ite, jts, jte, kts, kte
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: BN2, tke, rdzw
+
+    REAL, INTENT( IN )  &
+    :: dx, dy
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte ), INTENT( OUT )  &
+    :: l_scale
+
+    REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN   ) ::     msftx, &
+                                                              msfty
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k
+
+    REAL  &
+    :: deltas, tmp
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      deltas         = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333
+      l_scale(i,k,j) = deltas
+
+      IF ( BN2(i,k,j) .gt. 1.0e-6 ) THEN
+        tmp            = SQRT( MAX( tke(i,k,j), 1.0e-6 ) )
+        l_scale(i,k,j) = 0.76 * tmp / SQRT( BN2(i,k,j) )
+        l_scale(i,k,j) = MIN( l_scale(i,k,j), deltas)
+        l_scale(i,k,j) = MAX( l_scale(i,k,j), 0.001 * deltas )
+      END IF
+
+    END DO
+    END DO
+    END DO
+
+    END SUBROUTINE calc_l_scale
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf,    &
+                                    tke_tendf,                                 &
+                                    moist_tendf, n_moist,                      &
+                                    chem_tendf, n_chem,                        &
+                                    scalar_tendf, n_scalar,                    &
+                                    thp, theta, mu, tke, config_flags,         &
+                                    defor11, defor22, defor12,                 &
+                                    defor13, defor23, div,                     &
+                                    moist, chem, scalar,                       &
+                                    msfux, msfuy, msfvx, msfvy,                &
+                                    msftx, msfty, xkmh, xkhh,km_opt,           &
+                                    rdx, rdy, rdz, rdzw, fnm, fnp,             &
+                                    cf1, cf2, cf3, zx, zy, dn, dnw,            &
+                                    ids, ide, jds, jde, kds, kde,              &
+                                    ims, ime, jms, jme, kms, kme,              &
+                                    its, ite, jts, jte, kts, kte               )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   INTEGER ,        INTENT(IN   ) ::        n_moist, n_chem, n_scalar, km_opt
+
+   REAL ,           INTENT(IN   ) ::        cf1, cf2, cf3
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: dnw
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  dn
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfux, &
+                                                                    msfuy, &
+                                                                    msfvx, &
+                                                                    msfvy, &
+                                                                    msftx, &
+                                                                    msfty, &
+                                                                      mu
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::rt_tendf,&
+                                                                 ru_tendf,&
+                                                                 rv_tendf,&
+                                                                 rw_tendf,&
+                                                                tke_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist),                 &
+          INTENT(INOUT) ::                                    moist_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem),                  &
+          INTENT(INOUT) ::                                     chem_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar),                &
+          INTENT(INOUT) ::                                   scalar_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist),                 &
+          INTENT(IN   ) ::                                          moist
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem),                  &
+          INTENT(IN   ) ::                                          chem 
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) ,               &
+          INTENT(IN   ) ::                                         scalar 
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor11, &
+                                                                 defor22, &
+                                                                 defor12, &
+                                                                 defor13, &
+                                                                 defor23, &
+                                                                     div, &
+                                                                    xkmh, &
+                                                                    xkhh, &
+                                                                      zx, &
+                                                                      zy, &
+                                                                   theta, &
+                                                                     thp, &
+                                                                     tke, &
+                                                                     rdz, &
+                                                                    rdzw
+
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+
+! LOCAL VARS
+   
+   INTEGER :: im, ic, is
+
+!  REAL , DIMENSION(its-1:ite+1, kts:kte, jts-1:jte+1)       ::     xkhh
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Call diffusion subroutines.
+
+    CALL horizontal_diffusion_u_2( ru_tendf, mu, config_flags,             &
+                                   defor11, defor12, div,                  &
+                                   tke(ims,kms,jms),                       &
+                                   msfux, msfuy, xkmh, rdx, rdy, fnm, fnp, &
+                                   zx, zy, rdzw,                           &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    CALL horizontal_diffusion_v_2( rv_tendf, mu, config_flags,             &
+                                   defor12, defor22, div,                  &
+                                   tke(ims,kms,jms),                       &
+                                   msfvx, msfvy, xkmh, rdx, rdy, fnm, fnp, &
+                                   zx, zy, rdzw,                           &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    CALL horizontal_diffusion_w_2( rw_tendf, mu, config_flags,             &
+                                   defor13, defor23, div,                  &
+                                   tke(ims,kms,jms),                       &
+                                   msftx, msfty, xkmh, rdx, rdy, fnm, fnp, &
+                                   zx, zy, rdz,                            &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    CALL horizontal_diffusion_s  ( rt_tendf, mu, config_flags, thp,        &
+                                   msftx, msfty, msfux, msfuy,             &
+                                   msfvx, msfvy, xkhh, rdx, rdy,           &
+                                   fnm, fnp, cf1, cf2, cf3,                &
+                                   zx, zy, rdz, rdzw, dnw, dn,             &
+                                   .false.,                                &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    IF (km_opt .eq. 2)                                                     &
+    CALL horizontal_diffusion_s  ( tke_tendf(ims,kms,jms),                 &
+                                   mu, config_flags,                       &
+                                   tke(ims,kms,jms),                       &
+                                   msftx, msfty, msfux, msfuy,             &
+                                   msfvx, msfvy, xkhh, rdx, rdy,           &
+                                   fnm, fnp, cf1, cf2, cf3,                &
+                                   zx, zy, rdz, rdzw, dnw, dn,             &
+                                   .true.,                                 &
+                                   ids, ide, jds, jde, kds, kde,           &
+                                   ims, ime, jms, jme, kms, kme,           &
+                                   its, ite, jts, jte, kts, kte           )
+
+    IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN 
+
+      moist_loop: do im = PARAM_FIRST_SCALAR, n_moist
+
+          CALL horizontal_diffusion_s( moist_tendf(ims,kms,jms,im),       &
+                                       mu, config_flags,                  &
+                                       moist(ims,kms,jms,im),             &
+                                       msftx, msfty, msfux, msfuy,        &
+                                       msfvx, msfvy, xkhh, rdx, rdy,      &
+                                       fnm, fnp, cf1, cf2, cf3,           &
+                                       zx, zy, rdz, rdzw, dnw, dn,        &
+                                       .false.,                           &
+                                       ids, ide, jds, jde, kds, kde,      &
+                                       ims, ime, jms, jme, kms, kme,      &
+                                       its, ite, jts, jte, kts, kte      )
+
+      ENDDO moist_loop
+
+    ENDIF
+
+    IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN 
+
+      chem_loop: do ic = PARAM_FIRST_SCALAR, n_chem
+
+        CALL horizontal_diffusion_s( chem_tendf(ims,kms,jms,ic),     &
+                                     mu, config_flags,                 &
+                                     chem(ims,kms,jms,ic),           &
+                                     msftx, msfty, msfux, msfuy,       &
+                                     msfvx, msfvy, xkhh, rdx, rdy,     &
+                                     fnm, fnp, cf1, cf2, cf3,          &
+                                     zx, zy, rdz, rdzw, dnw, dn,       &
+                                     .false.,                          &
+                                     ids, ide, jds, jde, kds, kde,     &
+                                     ims, ime, jms, jme, kms, kme,     &
+                                     its, ite, jts, jte, kts, kte     )
+
+      ENDDO chem_loop
+
+    ENDIF
+    IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN 
+
+      scalar_loop: do is = PARAM_FIRST_SCALAR, n_scalar
+
+        CALL horizontal_diffusion_s( scalar_tendf(ims,kms,jms,is),     &
+                                     mu, config_flags,                 &
+                                     scalar(ims,kms,jms,is),           &
+                                     msftx, msfty, msfux, msfuy,       &
+                                     msfvx, msfvy, xkhh, rdx, rdy,     &
+                                     fnm, fnp, cf1, cf2, cf3,          &
+                                     zx, zy, rdz, rdzw, dnw, dn,       &
+                                     .false.,                          &
+                                     ids, ide, jds, jde, kds, kde,     &
+                                     ims, ime, jms, jme, kms, kme,     &
+                                     its, ite, jts, jte, kts, kte     )
+
+      ENDDO scalar_loop
+
+    ENDIF
+
+    END SUBROUTINE horizontal_diffusion_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_u_2( tendency, mu, config_flags,          &
+                                     defor11, defor12, div, tke,          &
+                                     msfux, msfuy,                        &
+                                     xkmh, rdx, rdy, fnm, fnp,            &
+                                     zx, zy, rdzw,                        &
+                                     ids, ide, jds, jde, kds, kde,        &
+                                     ims, ime, jms, jme, kms, kme,        &
+                                     its, ite, jts, jte, kts, kte        )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::  msfux, &
+                                                                   msfuy, &
+                                                                      mu
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::   rdzw  
+                                                                    
+ 
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor11, &
+                                                                 defor12, &
+                                                                     div, &   
+                                                                     tke, &   
+                                                                    xkmh, &
+                                                                      zx, &
+                                                                      zy
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+! Local data
+   
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)    :: titau1avg, &
+                                                              titau2avg, &
+                                                                 titau1, & 
+                                                                 titau2, & 
+                                                                 xkxavg, & 
+                                                                  rravg
+! new
+!                                                                 zxavg, & 
+!                                                                 zyavg
+   REAL :: mrdx, mrdy, rcoup
+
+   REAL :: tmpzy, tmpzeta_z
+
+   REAL :: term1, term2, term3
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+ 
+!-----------------------------------------------------------------------
+! u :   p (.), u(|), w(-)
+!       
+!       p  u  p  u                                  u     u
+!
+! p  |  .  |  .  |  .  |   k+1                |  .  |  .  |  .  |   k+1
+!           
+! w     - 13  -     -      k+1                     13               k+1 
+!
+! p  |  11 O 11  |  .  |   k                  |  12 O 12  |  .  |   k      
+!
+! w     - 13  -     -      k                       13               k  
+!
+! p  |  .  |  .  |  .  |   k-1                |  .  |  .  |  .  |   k-1
+!
+!      i-1 i  i i+1                          j-1 j  j j+1 j+1         
+!
+
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+! titau1 = titau11 
+   is_ext=1
+   ie_ext=0
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_11_22_33( config_flags, titau1,            &
+                            mu, tke, xkmh, defor11,          &
+                            is_ext, ie_ext, js_ext, je_ext,  &
+                            ids, ide, jds, jde, kds, kde,    &
+                            ims, ime, jms, jme, kms, kme,    &
+                            its, ite, jts, jte, kts, kte     )
+
+! titau2 = titau12
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=1
+   CALL cal_titau_12_21( config_flags, titau2,            &
+                         mu, xkmh, defor12,               &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+
+! titau1avg = titau11avg
+! titau2avg = titau12avg 
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+      titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i-1,k  ,j)+titau1(i,k  ,j))+ &
+                            fnp(k)*(titau1(i-1,k-1,j)+titau1(i,k-1,j)))
+      titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k  ,j+1)+titau2(i,k  ,j))+ &
+                            fnp(k)*(titau2(i,k-1,j+1)+titau2(i,k-1,j)))
+      tmpzy = 0.25*( zy(i-1,k,j  )+zy(i,k,j  )+ &
+                     zy(i-1,k,j+1)+zy(i,k,j+1)  )
+!      tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i-1,j))
+!      titau1avg(i,k,j)=titau1avg(i,k,j)*zx(i,k,j)*tmpzeta_z
+!      titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy    *tmpzeta_z
+
+      titau1avg(i,k,j)=titau1avg(i,k,j)*zx(i,k,j)
+      titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy    
+
+   ENDDO
+   ENDDO
+   ENDDO
+!
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      titau1avg(i,kts,j)=0.
+      titau1avg(i,ktf+1,j)=0.
+      titau2avg(i,kts,j)=0.
+      titau2avg(i,ktf+1,j)=0.
+   ENDDO
+   ENDDO
+!
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+
+      mrdx=msfux(i,j)*rdx
+      mrdy=msfuy(i,j)*rdy
+      tendency(i,k,j)=tendency(i,k,j)-                                    &
+           (mrdx*(titau1(i,k,j  )-titau1(i-1,k,j))+                       &
+            mrdy*(titau2(i,k,j+1)-titau2(i,k,j  ))-                       &
+            msfuy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+ &
+                                   (titau2avg(i,k+1,j)-titau2avg(i,k,j))  &
+                                  )                                      )
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE horizontal_diffusion_u_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_v_2( tendency, mu, config_flags,          &
+                                     defor12, defor22, div, tke,          &
+                                     msfvx, msfvy,                        &
+                                     xkmh, rdx, rdy, fnm, fnp,            &
+                                     zx, zy, rdzw,                        &
+                                     ids, ide, jds, jde, kds, kde,        &
+                                     ims, ime, jms, jme, kms, kme,        &
+                                     its, ite, jts, jte, kts, kte        )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::  msfvx, &
+                                                                   msfvy, &
+                                                                      mu
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor12, &
+                                                                 defor22, &
+                                                                     div, &
+                                                                     tke, &
+                                                                    xkmh, &
+                                                                      zx, &
+                                                                      zy, &
+                                                                    rdzw
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+
+! Local data
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)    :: titau1avg, &
+                                                              titau2avg, &
+                                                                 titau1, &
+                                                                 titau2, &
+                                                                 xkxavg, &
+                                                                  rravg
+! new
+!                                                                 zxavg, &
+!                                                                 zyavg
+
+   REAL :: mrdx, mrdy, rcoup
+
+   REAL :: tmpzx, tmpzeta_z
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+ 
+!-----------------------------------------------------------------------
+! v :   p (.), v(+), w(-)
+!       
+!       p  v  p  v                                  v     v
+!
+! p  +  .  +  .  +  .  +   k+1                +  .  +  .  +  .  +   k+1
+!           
+! w     - 23  -     -      k+1                     23               k+1 
+!
+! p  +  22 O 22  +  .  +   k                  +  21 O 21  +  .  +   k      
+!
+! w     - 23  -     -      k                       23               k  
+!
+! p  +  .  +  .  +  .  +   k-1                +  .  +  .  +  .  +   k-1
+!
+!      j-1 j  j j+1                          i-1 i  i i+1 i+1         
+!
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! titau1 = titau21
+   is_ext=0
+   ie_ext=1
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_12_21( config_flags, titau1,          &
+                         mu, xkmh, defor12,             &
+                         is_ext,ie_ext,js_ext,je_ext,   &
+                         ids, ide, jds, jde, kds, kde,  &
+                         ims, ime, jms, jme, kms, kme,  &
+                         its, ite, jts, jte, kts, kte   )
+
+! titau2 = titau22
+   is_ext=0
+   ie_ext=0
+   js_ext=1
+   je_ext=0
+   CALL cal_titau_11_22_33( config_flags, titau2,           &
+                            mu, tke, xkmh, defor22,         &
+                            is_ext, ie_ext, js_ext, je_ext, &
+                            ids, ide, jds, jde, kds, kde,   &
+                            ims, ime, jms, jme, kms, kme,   &
+                            its, ite, jts, jte, kts, kte    )
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+      titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i+1,k  ,j)+titau1(i,k  ,j))+ &
+                            fnp(k)*(titau1(i+1,k-1,j)+titau1(i,k-1,j)))
+      titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k  ,j-1)+titau2(i,k  ,j))+ &
+                            fnp(k)*(titau2(i,k-1,j-1)+titau2(i,k-1,j)))
+
+      tmpzx = 0.25*( zx(i,k,j  )+zx(i+1,k,j  )+ &
+                     zx(i,k,j-1)+zx(i+1,k,j-1)  )
+
+
+      titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx
+      titau2avg(i,k,j)=titau2avg(i,k,j)*zy(i,k,j)
+
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      titau1avg(i,kts,j)=0.
+      titau1avg(i,ktf+1,j)=0.
+      titau2avg(i,kts,j)=0.
+      titau2avg(i,ktf+1,j)=0.
+   ENDDO
+   ENDDO
+!
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+       
+      mrdx=msfvx(i,j)*rdx
+      mrdy=msfvy(i,j)*rdy
+      tendency(i,k,j)=tendency(i,k,j)-                                    &
+           (mrdy*(titau2(i  ,k,j)-titau2(i,k,j-1))+                       &
+            mrdx*(titau1(i+1,k,j)-titau1(i,k,j  ))-                       &
+           msfvy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+ &
+                                   (titau2avg(i,k+1,j)-titau2avg(i,k,j))  &
+                                )			                  &
+           )
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE horizontal_diffusion_v_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_w_2( tendency, mu, config_flags,          &
+                                     defor13, defor23, div, tke,          &
+                                     msftx, msfty,                        &
+                                     xkmh, rdx, rdy, fnm, fnp,            &
+                                     zx, zy, rdz,                         &
+                                     ids, ide, jds, jde, kds, kde,        &
+                                     ims, ime, jms, jme, kms, kme,        &
+                                     its, ite, jts, jte, kts, kte        )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::  msftx, &
+                                                                   msfty, &
+                                                                      mu
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor13, &
+                                                                 defor23, &
+                                                                     div, &
+                                                                     tke, &
+                                                                    xkmh, &
+                                                                      zx, &
+                                                                      zy, &
+                                                                     rdz
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+
+! Local data
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)    :: titau1avg, &
+                                                              titau2avg, &
+                                                                 titau1, &
+                                                                 titau2, &
+                                                                 xkxavg, &
+                                                                  rravg
+! new
+!                                                                 zxavg, &
+!                                                                 zyavg
+
+   REAL :: mrdx, mrdy, rcoup
+
+   REAL :: tmpzx, tmpzy, tmpzeta_z
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+ 
+!-----------------------------------------------------------------------
+! w :   p (.), u(|), v(+), w(-)
+!       
+!       p  u  p  u                               p  v  p  v 
+!
+! w     -     -     -      k+1             w     -     -     -      k+1 
+!
+! p     .  | 33  |  .      k               p     .  + 33  +  .      k      
+!
+! w     -  31 O 31  -      k               w     -  32 O 32  -      k   
+!
+! p     .  | 33  |  .      k-1             p     .  | 33  |  .      k-1 
+!
+! w     -     -     -      k-1             w     -     -     -      k-1 
+!
+!      i-1 i  i i+1                             j-1 j  j j+1         
+!
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! titau1 = titau31
+   is_ext=0
+   ie_ext=1
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_13_31( config_flags, titau1, defor13,   &
+                         mu, xkmh, fnm, fnp,              &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+
+! titau2 = titau32
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=1
+   CALL cal_titau_23_32( config_flags, titau2, defor23,   &
+                         mu, xkmh, fnm, fnp,              &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+
+! titau1avg = titau31avg * zx * zeta_z = titau13avg * zx * zeta_z
+! titau2avg = titau32avg * zy * zeta_z = titau23avg * zy * zeta_z
+
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+      titau1avg(i,k,j)=0.25*(titau1(i+1,k+1,j)+titau1(i,k+1,j)+ &
+                             titau1(i+1,k  ,j)+titau1(i,k  ,j))
+      titau2avg(i,k,j)=0.25*(titau2(i,k+1,j+1)+titau2(i,k+1,j)+ &
+                             titau2(i,k  ,j+1)+titau2(i,k  ,j))
+! new
+      tmpzx  =0.25*( zx(i,k  ,j)+zx(i+1,k  ,j)+ &
+                     zx(i,k+1,j)+zx(i+1,k+1,j)  )
+      tmpzy  =0.25*( zy(i,k  ,j)+zy(i,k  ,j+1)+ &
+                     zy(i,k+1,j)+zy(i,k+1,j+1)  )
+
+      titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx
+      titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy
+!      titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx*zeta_z(i,j)
+!      titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy*zeta_z(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      titau1avg(i,ktf+1,j)=0.
+      titau2avg(i,ktf+1,j)=0.
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+
+      mrdx=msftx(i,j)*rdx
+      mrdy=msfty(i,j)*rdy
+
+      tendency(i,k,j)=tendency(i,k,j)-                                 &
+           (mrdx*(titau1(i+1,k,j)-titau1(i,k,j))+                      &
+            mrdy*(titau2(i,k,j+1)-titau2(i,k,j))-                      &
+           msfty(i,j)*rdz(i,k,j)*(titau1avg(i,k,j)-titau1avg(i,k-1,j)+ &
+                                  titau2avg(i,k,j)-titau2avg(i,k-1,j)  &
+                               )				       &
+           )
+!            msft(i,j)/dn(k)*(titau1avg(i,k,j)-titau1avg(i,k-1,j)+ &
+!                                titau2avg(i,k,j)-titau2avg(i,k-1,j)  &
+!                               )				     &
+!           )
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE horizontal_diffusion_w_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE horizontal_diffusion_s (tendency, mu, config_flags, var,       &
+                                   msftx, msfty, msfux, msfuy,            &
+                                   msfvx, msfvy, xkhh, rdx, rdy,          &
+                                   fnm, fnp, cf1, cf2, cf3,               &
+                                   zx, zy, rdz, rdzw, dnw, dn,            &
+                                   doing_tke,                             &
+                                   ids, ide, jds, jde, kds, kde,          &
+                                   ims, ime, jms, jme, kms, kme,          &
+                                   its, ite, jts, jte, kts, kte           )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   LOGICAL,         INTENT(IN   ) ::        doing_tke
+
+   REAL , INTENT(IN   )           ::        cf1, cf2, cf3
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::     dn
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    dnw
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfux
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfuy
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfvx
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfvy
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msftx
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   msfty
+
+   REAL , DIMENSION( ims:ime, jms:jme) ,         INTENT(IN   ) ::   mu
+
+!  REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1),                 &
+!         INTENT(IN   ) ::                                         xkhh
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::         &
+                                                                    xkhh, &
+                                                                     rdz, &
+                                                                     rdzw
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::    var, &
+                                                                      zx, &
+                                                                      zy
+
+   REAL ,                                        INTENT(IN   ) ::    rdx, &
+                                                                     rdy
+
+! Local data
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)    ::     H1avg, &
+                                                                  H2avg, &
+                                                                     H1, &
+                                                                     H2, &
+                                                                 xkxavg
+! new
+!                                                                 zxavg, &
+!                                                                 zyavg
+
+   REAL , DIMENSION( its:ite, kts:kte, jts:jte)            ::  tmptendf
+
+   REAL    :: mrdx, mrdy, rcoup
+   REAL    :: tmpzx, tmpzy, tmpzeta_z, rdzu, rdzv
+   INTEGER :: ktes1,ktes2
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+ 
+!-----------------------------------------------------------------------
+! scalars:   t (.), u(|), v(+), w(-)
+!       
+!       t  u  t  u                               t  v  t  v 
+!
+! w     -     3     -      k+1             w     -     3     -      k+1 
+!
+! t     .  1  O  1  .      k               t     .  2  O  2  .      k      
+!
+! w     -     3     -      k               w     -     3     -      k   
+!
+! t     .  |  .  |  .      k-1             t     .  +  .  +  .      k-1 
+!
+! w     -     -     -      k-1             w     -     -     -      k-1 
+!
+! t    i-1 i  i i+1                             j-1 j  j j+1         
+!
+
+   ktes1=kte-1
+   ktes2=kte-2
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! diffusion of the TKE needs mutiple 2
+
+   IF ( doing_tke ) THEN
+      DO j = j_start, j_end
+      DO k = kts,ktf
+      DO i = i_start, i_end
+         tmptendf(i,k,j)=tendency(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+! H1 = partial var over partial x
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end + 1
+! new
+!     zxavg(i,k,j) =0.5*( zx(i-1,k,j)+ zx(i,k,j))
+      xkxavg(i,k,j)=0.5*(xkhh(i-1,k,j)+xkhh(i,k,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts+1, ktf
+   DO i = i_start, i_end + 1
+      H1avg(i,k,j)=0.5*(fnm(k)*(var(i-1,k  ,j)+var(i,k  ,j))+  &
+                        fnp(k)*(var(i-1,k-1,j)+var(i,k-1,j)))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO i = i_start, i_end + 1
+      H1avg(i,kts  ,j)=0.5*(cf1*var(i  ,1,j)+cf2*var(i  ,2,j)+ &
+                            cf3*var(i  ,3,j)+cf1*var(i-1,1,j)+  &
+                            cf2*var(i-1,2,j)+cf3*var(i-1,3,j))
+      H1avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)- &
+                            var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+ &
+                            var(i-1,ktes1,j)+(var(i-1,ktes1,j)- &
+                            var(i-1,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1))
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts, ktf
+   DO i = i_start, i_end + 1
+! new
+      tmpzx = 0.5*( zx(i,k,j)+ zx(i,k+1,j))
+      rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j))
+      H1(i,k,j)=-msfuy(i,j)*xkxavg(i,k,j)*(                      &
+                 rdx*(var(i,k,j)-var(i-1,k,j)) - tmpzx*         &
+                     (H1avg(i,k+1,j)-H1avg(i,k,j))*rdzu )
+
+!      tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i-1,j))
+!      H1(i,k,j)=-msfuy(i,j)*xkxavg(i,k,j)*(                         &
+!                 rdx*(var(i,k,j)-var(i-1,k,j)) - tmpzx*tmpzeta_z*  &
+!                     (H1avg(i,k+1,j)-H1avg(i,k,j))/dnw(k))
+   ENDDO
+   ENDDO
+   ENDDO
+
+! H2 = partial var over partial y
+
+   DO j = j_start, j_end + 1
+   DO k = kts, ktf
+   DO i = i_start, i_end
+! new
+!     zyavg(i,k,j) =0.5*( zy(i,k,j-1)+ zy(i,k,j))
+      xkxavg(i,k,j)=0.5*(xkhh(i,k,j-1)+xkhh(i,k,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end + 1
+   DO k = kts+1,   ktf
+   DO i = i_start, i_end
+! new
+      H2avg(i,k,j)=0.5*(fnm(k)*(var(i,k  ,j-1)+var(i,k  ,j))+  &
+                        fnp(k)*(var(i,k-1,j-1)+var(i,k-1,j)))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end + 1
+   DO i = i_start, i_end
+      H2avg(i,kts  ,j)=0.5*(cf1*var(i,1,j  )+cf2*var(i  ,2,j)+ &
+                            cf3*var(i,3,j  )+cf1*var(i,1,j-1)+  &
+                            cf2*var(i,2,j-1)+cf3*var(i,3,j-1))
+      H2avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)- &
+                            var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+ &
+                            var(i,ktes1,j-1)+(var(i,ktes1,j-1)- &
+                            var(i,ktes2,j-1))*0.5*dnw(ktes1)/dn(ktes1))
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end + 1
+   DO k = kts, ktf
+   DO i = i_start, i_end
+! new
+      tmpzy = 0.5*( zy(i,k,j)+ zy(i,k+1,j))
+      rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1))
+      H2(i,k,j)=-msfvy(i,j)*xkxavg(i,k,j)*(                       &
+                 rdy*(var(i,k,j)-var(i,k,j-1)) - tmpzy*          &
+                     (H2avg(i ,k+1,j)-H2avg(i,k,j))*rdzv)
+
+!      tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i,j-1))
+!      H2(i,k,j)=-msfvy(i,j)*xkxavg(i,k,j)*(                         &
+!                 rdy*(var(i,k,j)-var(i,k,j-1)) - tmpzy*tmpzeta_z*  &
+!                     (H2avg(i ,k+1,j)-H2avg(i,k,j))/dnw(k))
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts+1, ktf
+   DO i = i_start, i_end
+      H1avg(i,k,j)=0.5*(fnm(k)*(H1(i+1,k  ,j)+H1(i,k  ,j))+  &
+                        fnp(k)*(H1(i+1,k-1,j)+H1(i,k-1,j)))
+      H2avg(i,k,j)=0.5*(fnm(k)*(H2(i,k  ,j+1)+H2(i,k  ,j))+  &
+                        fnp(k)*(H2(i,k-1,j+1)+H2(i,k-1,j)))
+! new
+!     zxavg(i,k,j)=fnm(k)*zx(i,k,j)+fnp(k)*zx(i,k-1,j)
+!     zyavg(i,k,j)=fnm(k)*zy(i,k,j)+fnp(k)*zy(i,k-1,j)
+
+! H1avg(i,k,j)=zx*H1avg*zeta_z
+! H2avg(i,k,j)=zy*H2avg*zeta_z
+
+      tmpzx = 0.5*( zx(i,k,j)+ zx(i+1,k,j  ))
+      tmpzy = 0.5*( zy(i,k,j)+ zy(i  ,k,j+1))
+
+      H1avg(i,k,j)=H1avg(i,k,j)*tmpzx
+      H2avg(i,k,j)=H2avg(i,k,j)*tmpzy
+
+!      H1avg(i,k,j)=H1avg(i,k,j)*tmpzx*zeta_z(i,j)
+!      H2avg(i,k,j)=H2avg(i,k,j)*tmpzy*zeta_z(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+ 
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      H1avg(i,kts  ,j)=0.
+      H1avg(i,ktf+1,j)=0.
+      H2avg(i,kts  ,j)=0.
+      H2avg(i,ktf+1,j)=0.
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+
+      mrdx=msftx(i,j)*rdx
+      mrdy=msfty(i,j)*rdy
+
+      tendency(i,k,j)=tendency(i,k,j)-                      &
+           (mrdx*0.5*((mu(i+1,j)+mu(i,j))*H1(i+1,k,j)-      &
+                      (mu(i-1,j)+mu(i,j))*H1(i  ,k,j))+     &
+            mrdy*0.5*((mu(i,j+1)+mu(i,j))*H2(i,k,j+1)-      &
+                      (mu(i,j-1)+mu(i,j))*H2(i,k,j  ))-     &
+           msfty(i,j)*mu(i,j)*(H1avg(i,k+1,j)-H1avg(i,k,j)+ &
+                       H2avg(i,k+1,j)-H2avg(i,k,j)          &
+                                )*rdzw(i,k,j)               &
+                                                          )
+
+   ENDDO
+   ENDDO
+   ENDDO
+           
+   IF ( doing_tke ) THEN
+      DO j = j_start, j_end
+      DO k = kts,ktf
+      DO i = i_start, i_end
+          tendency(i,k,j)=tmptendf(i,k,j)+2.* &
+                          (tendency(i,k,j)-tmptendf(i,k,j))
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+END SUBROUTINE horizontal_diffusion_s
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_2   ( ru_tendf, rv_tendf, rw_tendf, rt_tendf,   &
+                                    tke_tendf, moist_tendf, n_moist,          &
+                                    chem_tendf, n_chem,                       &
+                                    scalar_tendf, n_scalar,                   &
+                                    u_2, v_2,                                 &
+                                    thp,u_base,v_base,t_base,qv_base,mu,tke,  &
+                                    config_flags,defor13,defor23,defor33,div, &
+                                    moist, chem, scalar, xkmv, xkhv,km_opt,   &
+                                    fnm, fnp, dn, dnw, rdz, rdzw,             &
+                                    hfx, qfx, ust, rho,                       &
+                                    ids, ide, jds, jde, kds, kde,             &
+                                    ims, ime, jms, jme, kms, kme,             &
+                                    its, ite, jts, jte, kts, kte              )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   INTEGER ,        INTENT(IN   ) ::        n_moist, n_chem, n_scalar, km_opt
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnp
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: dnw
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  dn
+   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      ::  mu
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: qv_base
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  u_base
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  v_base
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::  t_base
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::ru_tendf,&
+                                                                 rv_tendf,&
+                                                                 rw_tendf,&
+                                                                tke_tendf,&
+                                                                rt_tendf  
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist),                 &
+          INTENT(INOUT) ::                                    moist_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem),                  &
+          INTENT(INOUT) ::                                     chem_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) ,               &
+          INTENT(INOUT) ::                                   scalar_tendf
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist),                 &
+          INTENT(INOUT) ::                                          moist
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem),                  &
+          INTENT(INOUT) ::                                           chem
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) ,               &
+          INTENT(IN   ) ::                                         scalar
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   ) ::defor13, &
+                                                                 defor23, &
+                                                                 defor33, &
+                                                                     div, &
+                                                                    xkmv, &
+                                                                    xkhv, &
+                                                                     tke, &
+                                                                     rdz, &
+                                                                     u_2, &
+                                                                     v_2, &
+                                                                    rdzw
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN   )   :: rho  
+   REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN   )            :: hfx,  &
+                                                                    qfx
+   REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN   )            :: ust
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::    thp
+
+! LOCAL VAR
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme)  ::    var_mix
+
+   INTEGER :: im, i,j,k
+   INTEGER :: i_start, i_end, j_start, j_end
+
+!  REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: xkhv
+
+!***************************************************************************
+!***************************************************************************
+!MODIFICA VARIABILI PER I FLUSSI
+!
+    REAL :: V0_u,V0_v,tao_xz,tao_yz,ustar,cd0
+    REAL :: xsfc,psi1,vk2,zrough,lnz
+    REAL :: heat_flux, moist_flux, heat_flux0
+    REAL :: cpm
+!
+!FINE MODIFICA VARIABILI PER I FLUSSI
+!***************************************************************************
+!
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+!
+!-----------------------------------------------------------------------
+
+      CALL vertical_diffusion_u_2( ru_tendf, config_flags, mu,    &
+                                   defor13, xkmv,                 &
+                                   dnw, rdzw, fnm, fnp,           &
+                                   ids, ide, jds, jde, kds, kde,  &
+                                   ims, ime, jms, jme, kms, kme,  &
+                                   its, ite, jts, jte, kts, kte  )
+
+
+      CALL vertical_diffusion_v_2( rv_tendf, config_flags, mu,    &
+                                   defor23, xkmv,                 &
+                                   dnw, rdzw, fnm, fnp,           &
+                                   ids, ide, jds, jde, kds, kde,  &
+                                   ims, ime, jms, jme, kms, kme,  &
+                                   its, ite, jts, jte, kts, kte  )
+
+      CALL vertical_diffusion_w_2( rw_tendf, config_flags, mu,    &
+                                   defor33, tke(ims,kms,jms),     &
+                                   div, xkmv,                     &
+                                   dn, rdz,                       &  
+                                   ids, ide, jds, jde, kds, kde,  &
+                                   ims, ime, jms, jme, kms, kme,  &
+                                   its, ite, jts, jte, kts, kte  )
+
+!*****************************************
+!*****************************************
+!  MODIFICA al flusso di momento alla parete
+!
+  vflux: SELECT CASE( config_flags%isfflx )
+  CASE (0) ! Assume cd a constant, specified in namelist
+    cd0 = config_flags%tke_drag_coefficient  ! constant drag coefficient
+                                             ! set in namelist.input
+!
+!calcolo del modulo della velocita
+    DO j = j_start, j_end
+    DO i = i_start, ite
+       V0_u=0.
+       tao_xz=0.
+       V0_u=    sqrt((u_2(i,kts,j)**2) +         &
+                        (((v_2(i  ,kts,j  )+          &
+                           v_2(i  ,kts,j+1)+          &
+                           v_2(i-1,kts,j  )+          &
+                           v_2(i-1,kts,j+1))/4)**2))+epsilon
+       tao_xz=cd0*V0_u*u_2(i,kts,j)
+       ru_tendf(i,kts,j)=ru_tendf(i,kts,j)            &
+                         -0.25*(mu(i,j)+mu(i-1,j))*tao_xz*(rdzw(i,kts,j)+rdzw(i-1,kts,j))
+    ENDDO
+    ENDDO
+ 
+!
+    DO j = j_start, jte
+    DO i = i_start, i_end
+       V0_v=0.
+       tao_yz=0.
+       V0_v=    sqrt((v_2(i,kts,j)**2) +         &
+                        (((u_2(i  ,kts,j  )+          &
+                           u_2(i  ,kts,j-1)+          &
+                           u_2(i+1,kts,j  )+          &
+                           u_2(i+1,kts,j-1))/4)**2))+epsilon
+       tao_yz=cd0*V0_v*v_2(i,kts,j)
+       rv_tendf(i,kts,j)=rv_tendf(i,kts,j)            &
+                         -0.25*(mu(i,j)+mu(i,j-1))*tao_yz*(rdzw(i,kts,j)+rdzw(i,kts,j-1))
+    ENDDO
+    ENDDO
+
+  CASE (1,2) ! ustar computed from surface routine
+    DO j = j_start, j_end
+    DO i = i_start, ite
+       V0_u=0.
+       tao_xz=0.
+       V0_u=    sqrt((u_2(i,kts,j)**2) +         &
+                        (((v_2(i  ,kts,j  )+          &
+                           v_2(i  ,kts,j+1)+          &
+                           v_2(i-1,kts,j  )+          &
+                           v_2(i-1,kts,j+1))/4)**2))+epsilon
+       ustar=0.5*(ust(i,j)+ust(i-1,j))
+       tao_xz=ustar*ustar*u_2(i,kts,j)/V0_u
+       ru_tendf(i,kts,j)=ru_tendf(i,kts,j)            &
+                         -0.25*(mu(i,j)+mu(i-1,j))*tao_xz*(rdzw(i,kts,j)+rdzw(i-1,kts,j))
+    ENDDO
+    ENDDO
+ 
+    DO j = j_start, jte
+    DO i = i_start, i_end
+       V0_v=0.
+       tao_yz=0.
+       V0_v=    sqrt((v_2(i,kts,j)**2) +         &
+                        (((u_2(i  ,kts,j  )+          &
+                           u_2(i  ,kts,j-1)+          &
+                           u_2(i+1,kts,j  )+          &
+                           u_2(i+1,kts,j-1))/4)**2))+epsilon
+       ustar=0.5*(ust(i,j)+ust(i,j-1))
+       tao_yz=ustar*ustar*v_2(i,kts,j)/V0_v
+       rv_tendf(i,kts,j)=rv_tendf(i,kts,j)            &
+                         -0.25*(mu(i,j)+mu(i,j-1))*tao_yz*(rdzw(i,kts,j)+rdzw(i,kts,j-1))
+    ENDDO
+    ENDDO
+
+  CASE DEFAULT
+    CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
+  END SELECT vflux
+
+!
+!  FINE MODIFICA al flusso di momento alla parete
+!*****************************************
+!*****************************************
+
+   IF ( config_flags%mix_full_fields ) THEN
+
+     DO j=jts,min(jte,jde-1)
+     DO k=kts,kte-1
+     DO i=its,min(ite,ide-1)
+       var_mix(i,k,j) = thp(i,k,j)
+     ENDDO
+     ENDDO
+     ENDDO
+
+   ELSE
+
+     DO j=jts,min(jte,jde-1)
+     DO k=kts,kte-1
+     DO i=its,min(ite,ide-1)
+       var_mix(i,k,j) = thp(i,k,j) - t_base(k)
+     ENDDO
+     ENDDO
+     ENDDO
+
+   END IF
+
+   CALL vertical_diffusion_s( rt_tendf, config_flags, var_mix, mu, xkhv, &
+                              dn, dnw, rdz, rdzw, fnm, fnp,          &
+                              .false.,                               &
+                              ids, ide, jds, jde, kds, kde,          &
+                              ims, ime, jms, jme, kms, kme,          &
+                              its, ite, jts, jte, kts, kte          )
+
+
+!*****************************************
+!*****************************************
+!MODIFICA al flusso di calore
+!
+!
+  hflux: SELECT CASE( config_flags%isfflx )
+  CASE (0,2) ! with fixed surface heat flux given in the namelist
+    heat_flux = config_flags%tke_heat_flux  ! constant heat flux value
+                                            ! set in namelist.input
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+       rt_tendf(i,kts,j)=rt_tendf(i,kts,j)  &
+            +mu(i,j)*heat_flux*rdzw(i,kts,j)
+    ENDDO
+    ENDDO
+
+  CASE (1) ! use surface heat flux computed from surface routine
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+
+       cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV))
+       heat_flux = hfx(i,j)/cpm/rho(i,1,j)
+       rt_tendf(i,kts,j)=rt_tendf(i,kts,j)  &
+            +mu(i,j)*heat_flux*rdzw(i,kts,j)
+
+    ENDDO
+    ENDDO
+
+  CASE DEFAULT
+    CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
+  END SELECT hflux
+
+!
+! FINE MODIFICA al flusso di calore
+!*****************************************
+!*****************************************
+
+   If (km_opt .eq. 2) then
+   CALL vertical_diffusion_s( tke_tendf(ims,kms,jms),               &
+                              config_flags, tke(ims,kms,jms),       &
+                              mu, xkhv,                             &
+                              dn, dnw, rdz, rdzw, fnm, fnp,         &
+                              .true.,                               &
+                              ids, ide, jds, jde, kds, kde,         &
+                              ims, ime, jms, jme, kms, kme,         &
+                              its, ite, jts, jte, kts, kte         )
+   endif
+ 
+   IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN 
+
+     moist_loop: do im = PARAM_FIRST_SCALAR, n_moist
+
+       IF ( (.not. config_flags%mix_full_fields) .and. (im == P_QV) ) THEN
+
+         DO j=jts,min(jte,jde-1)
+         DO k=kts,kte-1
+         DO i=its,min(ite,ide-1)
+          var_mix(i,k,j) = moist(i,k,j,im) - qv_base(k)
+         ENDDO
+         ENDDO
+         ENDDO
+
+       ELSE
+
+         DO j=jts,min(jte,jde-1)
+         DO k=kts,kte-1
+         DO i=its,min(ite,ide-1)
+          var_mix(i,k,j) = moist(i,k,j,im)
+         ENDDO
+         ENDDO
+         ENDDO
+
+       END IF
+
+
+          CALL vertical_diffusion_s( moist_tendf(ims,kms,jms,im),         &
+                                     config_flags, var_mix,               &
+                                     mu, xkhv,                            &
+                                     dn, dnw, rdz, rdzw, fnm, fnp,        &
+                                     .false.,                             &
+                                     ids, ide, jds, jde, kds, kde,        &
+                                     ims, ime, jms, jme, kms, kme,        &
+                                     its, ite, jts, jte, kts, kte        )
+
+!*****************************************
+!*****************************************
+!MODIFICATIONS for water vapor flux
+!
+!
+  qflux: SELECT CASE( config_flags%isfflx )
+  CASE (0)
+! do nothing
+  CASE (1,2) ! with surface moisture flux 
+    IF ( im == P_QV ) THEN
+       DO j = j_start, j_end
+       DO i = i_start, i_end
+          moist_flux = qfx(i,j)/rho(i,1,j)
+          moist_tendf(i,kts,j,im)=moist_tendf(i,kts,j,im)  &
+               +mu(i,j)*moist_flux*rdzw(i,kts,j)
+       ENDDO
+       ENDDO
+    ENDIF
+
+  CASE DEFAULT
+    CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
+  END SELECT qflux
+!
+! END MODIFICATIONS for water vapor flux
+!*****************************************
+!*****************************************
+     ENDDO moist_loop
+
+   ENDIF
+
+   IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN 
+
+     chem_loop: do im = PARAM_FIRST_SCALAR, n_chem
+
+          CALL vertical_diffusion_s( chem_tendf(ims,kms,jms,im),         &
+                                     config_flags, chem(ims,kms,jms,im), &
+                                     mu, xkhv,                             &
+                                     dn, dnw, rdz, rdzw, fnm, fnp,         &
+                                     .false.,                              &
+                                     ids, ide, jds, jde, kds, kde,         &
+                                     ims, ime, jms, jme, kms, kme,         &
+                                     its, ite, jts, jte, kts, kte         )
+     ENDDO chem_loop
+
+   ENDIF
+
+
+   IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN 
+
+     scalar_loop: do im = PARAM_FIRST_SCALAR, n_scalar
+
+          CALL vertical_diffusion_s( scalar_tendf(ims,kms,jms,im),         &
+                                     config_flags, scalar(ims,kms,jms,im), &
+                                     mu, xkhv,                             &
+                                     dn, dnw, rdz, rdzw, fnm, fnp,         &
+                                     .false.,                              &
+                                     ids, ide, jds, jde, kds, kde,         &
+                                     ims, ime, jms, jme, kms, kme,         &
+                                     its, ite, jts, jte, kts, kte         )
+     ENDDO scalar_loop
+
+   ENDIF
+
+END SUBROUTINE vertical_diffusion_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu,            &
+                                   defor13, xkmv,                         &
+                                   dnw, rdzw, fnm, fnp,                   &
+                                   ids, ide, jds, jde, kds, kde,          &
+                                   ims, ime, jms, jme, kms, kme,          &
+                                   its, ite, jts, jte, kts, kte          )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,         INTENT(IN   ) ::       ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      :: dnw
+!   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      :: zeta_z
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) ,                       &
+                                            INTENT(IN   )      ::defor13, &
+                                                                    xkmv, &
+                                                                      rdzw
+   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      :: mu
+
+! LOCAL VARS
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)        :: titau3
+
+   REAL , DIMENSION( its:ite, jts:jte)                         ::  zzavg
+
+   REAL :: rdzu
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+  
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+! titau3 = titau13
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_13_31( config_flags, titau3, defor13,   &
+                         mu, xkmv, fnm, fnp,              &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+!
+      DO j = j_start, j_end
+      DO k=kts+1,ktf
+      DO i = i_start, i_end
+
+         rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j))
+         tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j)-titau3(i,k,j))
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+! ******** MODIF...
+!  we will pick up the surface drag (titau3(i,kts,j)) later
+!
+       DO j = j_start, j_end
+       k=kts
+       DO i = i_start, i_end
+ 
+          rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j))
+          tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j))
+       ENDDO
+       ENDDO
+! ******** MODIF...
+
+END SUBROUTINE vertical_diffusion_u_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu,            &
+                                   defor23, xkmv,                         &
+                                   dnw, rdzw, fnm, fnp,                   &
+                                   ids, ide, jds, jde, kds, kde,          &
+                                   ims, ime, jms, jme, kms, kme,          &
+                                   its, ite, jts, jte, kts, kte          )
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,         INTENT(IN   ) ::       ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      :: dnw
+!   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      :: zeta_z
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) ,                       &
+                                            INTENT(IN   )      ::defor23, &
+                                                                    xkmv, &
+                                                                    rdzw
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,  INTENT(IN   )      :: mu
+
+! LOCAL VARS
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)        :: titau3
+
+   REAL , DIMENSION( its:ite, jts:jte)                         ::  zzavg
+
+   REAL  :: rdzv
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+  
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! titau3 = titau23
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_23_32( config_flags, titau3, defor23,   &
+                         mu, xkmv, fnm, fnp,              &
+                         is_ext, ie_ext, js_ext, je_ext,  &
+                         ids, ide, jds, jde, kds, kde,    &
+                         ims, ime, jms, jme, kms, kme,    &
+                         its, ite, jts, jte, kts, kte     )
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+
+      rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1))
+      tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j)-titau3(i,k,j))
+
+   ENDDO
+   ENDDO
+   ENDDO
+
+! ******** MODIF...
+!  we will pick up the surface drag (titau3(i,kts,j)) later
+!
+       DO j = j_start, j_end
+       k=kts
+       DO i = i_start, i_end
+ 
+          rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1))
+          tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j))
+ 
+       ENDDO
+       ENDDO
+! ******** MODIF...
+
+END SUBROUTINE vertical_diffusion_v_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu,             &
+                                defor33, tke, div, xkmv,                  &
+                                dn, rdz,                                  &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                its, ite, jts, jte, kts, kte              )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,         INTENT(IN   ) ::       ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      ::  dn
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) ,                       &
+                                            INTENT(IN   )      ::defor33, &
+                                                                     tke, &
+                                                                     div, &
+                                                                    xkmv, &
+                                                                     rdz
+
+   REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN   ) :: mu
+
+! LOCAL VARS
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+   INTEGER :: is_ext,ie_ext,js_ext,je_ext  
+
+   REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1)        :: titau3
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+  
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+! titau3 = titau33
+   is_ext=0
+   ie_ext=0
+   js_ext=0
+   je_ext=0
+   CALL cal_titau_11_22_33( config_flags, titau3,            &
+                            mu, tke, xkmv, defor33,          &
+                            is_ext, ie_ext, js_ext, je_ext,  &
+                            ids, ide, jds, jde, kds, kde,    &
+                            ims, ime, jms, jme, kms, kme,    &
+                            its, ite, jts, jte, kts, kte     )
+
+!   DO j = j_start, j_end
+!   DO k = kts+1, ktf
+!   DO i = i_start, i_end
+!      titau3(i,k,j)=titau3(i,k,j)*zeta_z(i,j)
+!   ENDDO
+!   ENDDO
+!   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts+1, ktf
+   DO i = i_start, i_end
+      tendency(i,k,j)=tendency(i,k,j)-rdz(i,k,j)*(titau3(i,k,j)-titau3(i,k-1,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE vertical_diffusion_w_2
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, xkhv,   &
+                                 dn, dnw, rdz, rdzw, fnm, fnp,            &
+                                 doing_tke,                               &
+                                 ids, ide, jds, jde, kds, kde,            &
+                                 ims, ime, jms, jme, kms, kme,            &
+                                 its, ite, jts, jte, kts, kte            )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,         INTENT(IN   ) ::       ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   LOGICAL,         INTENT(IN   ) ::        doing_tke
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnm
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) ::    fnp
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      ::  dn
+   REAL , DIMENSION( kms:kme ) ,            INTENT(IN   )      :: dnw
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN) ::   xkhv
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::   mu
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) ,                       &
+                                            INTENT(IN   )      ::    var, &
+                                                                     rdz, &
+                                                                    rdzw
+! LOCAL VARS
+
+   INTEGER :: i, j, k, ktf
+
+   INTEGER :: i_start, i_end, j_start, j_end
+
+   REAL , DIMENSION( its:ite, kts:kte, jts:jte)            ::        H3, &
+                                                                 xkxavg, &
+                                                                  rravg
+
+   REAL , DIMENSION( its:ite, kts:kte, jts:jte)            ::  tmptendf
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   ktf=MIN(kte,kde-1)
+  
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%open_xs .or. config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%open_xe .or. config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%open_ys .or. config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%open_ye .or. config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
+
+   IF (doing_tke) THEN
+      DO j = j_start, j_end
+      DO k = kts,ktf
+      DO i = i_start, i_end
+         tmptendf(i,k,j)=tendency(i,k,j)
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+! H3
+
+   xkxavg = 0.
+
+   DO j = j_start, j_end
+   DO k = kts+1,ktf
+   DO i = i_start, i_end
+      xkxavg(i,k,j)=fnm(k)*xkhv(i,k,j)+fnp(k)*xkhv(i,k-1,j)
+      H3(i,k,j)=-xkxavg(i,k,j)*(var(i,k,j)-var(i,k-1,j))*rdz(i,k,j)
+!      H3(i,k,j)=-xkxavg(i,k,j)*zeta_z(i,j)* &
+!                 (var(i,k,j)-var(i,k-1,j))/dn(k)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO i = i_start, i_end
+      H3(i,kts,j)=0.
+      H3(i,ktf+1,j)=0.
+!      H3(i,kts,j)=H3(i,kts+1,j)
+!      H3(i,ktf+1,j)=H3(i,ktf,j)
+   ENDDO
+   ENDDO
+
+   DO j = j_start, j_end
+   DO k = kts,ktf
+   DO i = i_start, i_end
+      tendency(i,k,j)=tendency(i,k,j)  &
+                       -mu(i,j)*(H3(i,k+1,j)-H3(i,k,j))*rdzw(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   IF (doing_tke) THEN
+      DO j = j_start, j_end
+      DO k = kts,ktf
+      DO i = i_start, i_end
+          tendency(i,k,j)=tmptendf(i,k,j)+2.* &
+                          (tendency(i,k,j)-tmptendf(i,k,j))
+      ENDDO
+      ENDDO
+      ENDDO
+   ENDIF
+
+END SUBROUTINE vertical_diffusion_s
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE cal_titau_11_22_33( config_flags, titau,              &
+                                   mu, tke, xkx, defor,              &
+                                   is_ext, ie_ext, js_ext, je_ext,   &
+                                   ids, ide, jds, jde, kds, kde,     &
+                                   ims, ime, jms, jme, kms, kme,     &
+                                   its, ite, jts, jte, kts, kte      )
+
+! History:     Sep 2003  Changes by George Bryan and Jason Knievel, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000  Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates stress terms (taus) for use in
+!              the calculation of production of TKE by sheared wind
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  &
+    :: is_ext, ie_ext, js_ext, je_ext  
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT )  &
+    :: titau 
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: defor, xkx, tke
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf = MIN( kte, kde-1 )
+
+    i_start = its
+    i_end   = ite
+    j_start = jts
+    j_end   = jte
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-1, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-1, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+    i_start = i_start - is_ext
+    i_end   = i_end   + ie_ext   
+    j_start = j_start - js_ext
+    j_end   = j_end   + je_ext   
+
+    IF ( config_flags%km_opt .EQ. 2) THEN
+      DO j = j_start,j_end
+      DO k = kts,ktf
+      DO i = i_start,i_end  
+        titau(i,k,j) = mu(i,j) * ( - xkx(i,k,j) * ( defor(i,k,j) ) )       
+      END DO
+      END DO
+      END DO
+    ELSE
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        titau(i,k,j) = - mu(i,j) * xkx(i,k,j) * defor(i,k,j)
+      END DO
+      END DO
+      END DO
+    END IF
+
+    END SUBROUTINE cal_titau_11_22_33
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE cal_titau_12_21( config_flags, titau,             &
+                                mu, xkx, defor,                  &
+                                is_ext, ie_ext, js_ext, je_ext,  &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                its, ite, jts, jte, kts, kte     )
+
+! History:     Sep 2003   Modifications by George Bryan and Jason Knievel, NCAR
+!              Oct 2001   Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000   Original code by Shu-Hua Chen, UC-Davis
+
+! Pusrpose     This routine calculates the stress terms (taus) for use in
+!              the calculation of production of TKE by sheared wind
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  &
+    :: is_ext, ie_ext, js_ext, je_ext  
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT )  &
+    :: titau 
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: defor, xkx
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 )  &
+    :: xkxavg  
+
+    REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 )  &
+    :: muavg
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf = MIN( kte, kde-1 )
+
+! Needs one more point in the x and y directions.
+
+    i_start = its
+    i_end   = ite
+    j_start = jts
+    j_end   = jte
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_end   = MIN( ide-1, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_end   = MIN( jde-1, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+    i_start = i_start - is_ext
+    i_end   = i_end   + ie_ext   
+    j_start = j_start - js_ext
+    j_end   = j_end   + je_ext   
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      xkxavg(i,k,j) = 0.25 * ( xkx(i-1,k,j  ) + xkx(i,k,j  ) +  &
+                               xkx(i-1,k,j-1) + xkx(i,k,j-1) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      muavg(i,j) = 0.25 * ( mu(i-1,j  ) + mu(i,j  ) +  &
+                            mu(i-1,j-1) + mu(i,j-1) )
+    END DO
+    END DO
+
+! titau12 or titau21
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    END SUBROUTINE cal_titau_12_21
+
+!=======================================================================
+
+    SUBROUTINE cal_titau_13_31( config_flags, titau,             &
+                                defor, mu, xkx, fnm, fnp,        &
+                                is_ext, ie_ext, js_ext, je_ext,  &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                its, ite, jts, jte, kts, kte     )
+
+! History:     Sep 2003   Modifications by George Bryan and Jason Knievel, NCAR
+!              Oct 2001   Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000   Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates the stress terms (taus) for use in
+!              the calculation of production of TKE by sheared wind
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  &
+    :: is_ext, ie_ext, js_ext, je_ext  
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT )  &
+    :: titau 
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT( IN )  &
+    :: defor, xkx
+
+    REAL, DIMENSION( ims:ime, jms:jme), INTENT( IN )  &
+    :: mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 )  &
+    :: xkxavg 
+
+    REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 )  &
+    :: muavg
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf = MIN( kte, kde-1 )
+
+! Find ide-1 and jde-1 for averaging to p point.
+
+    i_start = its
+    i_end   = ite
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-1, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-2, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+    i_start = i_start - is_ext
+    i_end   = i_end   + ie_ext   
+    j_start = j_start - js_ext
+    j_end   = j_end   + je_ext   
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k  ,j) + xkx(i-1,k  ,j) ) +  &
+                              fnp(k) * ( xkx(i,k-1,j) + xkx(i-1,k-1,j) ) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      muavg(i,j) = 0.5 * ( mu(i,j) + mu(i-1,j) )
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
+    ENDDO
+    ENDDO
+    ENDDO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      titau(i,kts  ,j) = 0.0
+      titau(i,ktf+1,j) = 0.0
+    ENDDO
+    ENDDO
+
+    END SUBROUTINE cal_titau_13_31
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE cal_titau_23_32( config_flags, titau, defor,      &
+                                mu, xkx, fnm, fnp,               &
+                                is_ext, ie_ext, js_ext, je_ext,  &
+                                ids, ide, jds, jde, kds, kde,    &
+                                ims, ime, jms, jme, kms, kme,    &
+                                its, ite, jts, jte, kts, kte     )
+
+! History:     Sep 2003  Changes by George Bryan and Jason Knievel, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000  Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates stress terms (taus) for use in
+!              the calculation of production of TKE by sheared wind
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  &
+    :: is_ext,ie_ext,js_ext,je_ext  
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT )  &  
+    :: titau 
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: defor, xkx
+  
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    ::  mu
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 )  &
+    :: xkxavg 
+                                                                   
+    REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 )  &
+    :: muavg
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+     ktf = MIN( kte, kde-1 )
+
+! Find ide-1 and jde-1 for averaging to p point.
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = jte
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-1, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+    i_start = i_start - is_ext
+    i_end   = i_end   + ie_ext   
+    j_start = j_start - js_ext
+    j_end   = j_end   + je_ext   
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k  ,j) + xkx(i,k  ,j-1) ) +  &
+                              fnp(k) * ( xkx(i,k-1,j) + xkx(i,k-1,j-1) ) )
+    END DO
+    END DO
+    END DO
+ 
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      muavg(i,j) = 0.5 * ( mu(i,j) + mu(i,j-1) )
+    END DO
+    END DO
+ 
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+       titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+      titau(i,kts  ,j) = 0.0
+      titau(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+    END SUBROUTINE cal_titau_23_32
+
+!=======================================================================
+!=======================================================================
+
+SUBROUTINE phy_bc ( config_flags,div,defor11,defor22,defor33,              &
+                    defor12,defor13,defor23,xkmh,xkmv,xkhh,xkhv,tke,       &
+                    RUBLTEN, RVBLTEN,                                      &
+                    ids, ide, jds, jde, kds, kde,                          &
+                    ims, ime, jms, jme, kms, kme,                          &
+                    ips, ipe, jps, jpe, kps, kpe,                          &
+                    its, ite, jts, jte, kts, kte                           )
+
+!------------------------------------------------------------------------------
+! Begin declarations.
+
+   IMPLICIT NONE
+
+   TYPE(grid_config_rec_type), INTENT(IN   ) :: config_flags
+
+   INTEGER ,        INTENT(IN   ) ::        ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            ips, ipe, jps, jpe, kps, kpe, &
+                                            its, ite, jts, jte, kts, kte
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::RUBLTEN, &
+                                                                 RVBLTEN, &
+                                                                 defor11, &
+                                                                 defor22, &
+                                                                 defor33, &
+                                                                 defor12, &
+                                                                 defor13, &
+                                                                 defor23, &
+                                                                    xkmh, &
+                                                                    xkmv, &
+                                                                    xkhh, &
+                                                                    xkhv, &
+                                                                     tke, &
+                                                                     div
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+   IF( (config_flags%bl_pbl_physics .GT. 0) &
+        .OR. (config_flags%modif_wrf) ) THEN
+!****MARS: Always do that ?? > yes, for periodic simu -- grep in share
+
+        CALL set_physical_bc3d( RUBLTEN , 't', config_flags,              &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+        CALL set_physical_bc3d( RVBLTEN , 't', config_flags,              &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   ENDIF
+
+   ! move out of the conditional, below; horiz coeffs needed for 
+   ! all diff_opt cases.  JM
+
+   CALL set_physical_bc3d( xkmh    , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( xkhh    , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   IF(config_flags%diff_opt .eq. 2) THEN
+
+   CALL set_physical_bc3d( xkmv    , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( xkhv    , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( tke     , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( div     , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor11 , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor22 , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor33 , 't', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor12 , 'd', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor13 , 'e', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   CALL set_physical_bc3d( defor23 , 'f', config_flags,                   &
+                                ids, ide, jds, jde, kds, kde,             &
+                                ims, ime, jms, jme, kms, kme,             &
+                                ips, ipe, jps, jpe, kps, kpe,             &
+                                its, ite, jts, jte, kts, kte              )
+
+   ENDIF
+
+END SUBROUTINE phy_bc 
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_rhs( tendency, BN2, config_flags,            &
+                        defor11, defor22, defor33,              &
+                        defor12, defor13, defor23,              &
+                        u, v, w, div, tke, mu,                  &
+                        theta, p, p8w, t8w, z, fnm, fnp,        &
+                        cf1, cf2, cf3, msftx, msfty,            &
+                        xkmh, xkmv, xkhv,                       &
+                        rdx, rdy, dx, dy, dt, zx, zy,           &
+                        rdz, rdzw, dn, dnw, isotropic,          &
+                        hfx, qfx, qv, ust, rho,                 &
+                        ids, ide, jds, jde, kds, kde,           &
+                        ims, ime, jms, jme, kms, kme,           &
+                        its, ite, jts, jte, kts, kte            )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  :: isotropic
+    REAL, INTENT( IN )  &
+    :: cf1, cf2, cf3, dt, rdx, rdy, dx, dy
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp, dnw, dn
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: msftx, msfty
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tendency
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: defor11, defor22, defor33, defor12, defor13, defor23,  &
+       div, BN2, tke, xkmh, xkmv, xkhv, zx, zy, u, v, w, theta,  &
+       p, p8w, t8w, z, rdz, rdzw
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+    REAL, DIMENSION ( ims:ime, jms:jme ), INTENT( IN )   &
+    :: hfx, ust, qfx
+    REAL, DIMENSION ( ims:ime, kms:kme, jms:jme ), INTENT ( IN ) &
+    :: qv, rho
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    CALL tke_shear(    tendency, config_flags,                &
+                       defor11, defor22, defor33,             &
+                       defor12, defor13, defor23,             &
+                       u, v, w, tke, ust, mu, fnm, fnp,       &
+                       cf1, cf2, cf3, msftx, msfty,           &
+                       xkmh, xkmv,                            &
+                       rdx, rdy, zx, zy, rdz, rdzw, dnw, dn,  &
+                       ids, ide, jds, jde, kds, kde,          &
+                       ims, ime, jms, jme, kms, kme,          &
+                       its, ite, jts, jte, kts, kte           )
+
+    CALL tke_buoyancy( tendency, config_flags, mu,            &
+                       tke, xkhv, BN2, theta, dt,             &
+                       hfx, qfx, qv,  rho,                    &
+                       ids, ide, jds, jde, kds, kde,          &
+                       ims, ime, jms, jme, kms, kme,          &
+                       its, ite, jts, jte, kts, kte           ) 
+
+    CALL tke_dissip(   tendency, config_flags,                &
+                       mu, tke, bn2, theta, p8w, t8w, z,      &
+                       dx, dy,rdz, rdzw, isotropic,           &
+                       msftx, msfty,                          &
+                       ids, ide, jds, jde, kds, kde,          &
+                       ims, ime, jms, jme, kms, kme,          &
+                       its, ite, jts, jte, kts, kte           )
+
+! Set a lower limit on TKE.
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .or. config_flags%specified .or. &
+         config_flags%nested) i_start = MAX(ids+1,its)
+    IF ( config_flags%open_xe .or. config_flags%specified .or. &
+         config_flags%nested) i_end   = MIN(ide-2,ite)
+    IF ( config_flags%open_ys .or. config_flags%specified .or. &
+         config_flags%nested) j_start = MAX(jds+1,jts)
+    IF ( config_flags%open_ye .or. config_flags%specified .or. &
+         config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+ 
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = max( tendency(i,k,j), -mu(i,j) * max( 0.0 , tke(i,k,j) ) / dt )
+    END DO
+    END DO
+    END DO
+
+    END SUBROUTINE tke_rhs
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_buoyancy( tendency, config_flags, mu,    &
+                             tke, xkhv, BN2, theta, dt,     &
+                             hfx, qfx, qv,  rho,            &
+                             ids, ide, jds, jde, kds, kde,  &
+                             ims, ime, jms, jme, kms, kme,  &
+                             its, ite, jts, jte, kts, kte   )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, INTENT( IN )  &
+    :: dt
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tendency
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: xkhv, tke, BN2, theta 
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT ( IN ) &
+    :: qv, rho
+
+    REAL, DIMENSION(ims:ime, jms:jme ), INTENT ( IN ) :: hfx, qfx
+ 
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf
+
+    INTEGER  &
+    :: i_start, i_end, j_start, j_end
+
+    REAL :: heat_flux, heat_flux0
+
+    REAL :: cpm
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! Add to the TKE tendency the term that accounts for production of TKE
+! due to buoyant motions.
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_end   = MIN( jde-2, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+ 
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) - mu(i,j) * xkhv(i,k,j) * BN2(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! MARTA: change in the computation of the tke's tendency  at the surface.
+!  the buoyancy flux is the average of the surface heat flux (0.06) and the
+!   flux at the first w level
+!
+! WCS 040331
+
+  hflux: SELECT CASE( config_flags%isfflx )
+  CASE (0,2) ! with fixed surface heat flux given in the namelist
+   heat_flux0 = config_flags%tke_heat_flux  ! constant heat flux value
+                                            ! set in namelist.input
+! LES mods
+   K=KTS
+   PRINT *, 'USE constant H/rho/cp : e.g. value of Hs ', heat_flux0*cp*rho(i_start,k,j_start)
+   DO j = j_start, j_end
+   DO i = i_start, i_end 
+      heat_flux = heat_flux0 
+      tendency(i,k,j)= tendency(i,k,j) - &
+                   mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2.
+
+   ENDDO
+   ENDDO   
+
+  CASE (1) ! use surface heat flux computed from surface routine
+   PRINT *, 'USE surface heat flux from PHYSICS', hfx(i_start,j_start)
+   K=KTS
+   DO j = j_start, j_end
+   DO i = i_start, i_end 
+      cpm = cp * (1. + 0.8*qv(i,k,j))
+      heat_flux = (hfx(i,j)/cpm)/rho(i,k,j)
+
+      tendency(i,k,j)= tendency(i,k,j) - &
+                   mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2.
+
+   ENDDO
+   ENDDO   
+
+  CASE DEFAULT
+    CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
+  END SELECT hflux
+
+! end of MARTA/WCS change
+
+! The tendency array now includes production of TKE from buoyant
+! motions.
+!-----------------------------------------------------------------------
+
+    END SUBROUTINE tke_buoyancy
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_dissip( tendency, config_flags,            &
+                           mu, tke, bn2, theta, p8w, t8w, z,  &
+                           dx, dy, rdz, rdzw, isotropic,      &
+                           msftx, msfty,                      &
+                           ids, ide, jds, jde, kds, kde,      &
+                           ims, ime, jms, jme, kms, kme,      &
+                           its, ite, jts, jte, kts, kte       )
+
+! History:     Sep 2003  Changes by George Bryan and Jason Knievel, NCAR
+!              Oct 2001  Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000  Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates dissipation of turbulent kinetic
+!              energy.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980)
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    ::  ids, ide, jds, jde, kds, kde,  &
+        ims, ime, jms, jme, kms, kme,  &
+        its, ite, jts, jte, kts, kte
+
+    INTEGER, INTENT( IN )  :: isotropic
+    REAL, INTENT( IN )  &
+    :: dx, dy
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tendency
+ 
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: tke, bn2, theta, p8w, t8w, z, rdz, rdzw
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: msftx, msfty
+! Local variables.
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: dthrdn
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: l_scale
+
+    REAL, DIMENSION( its:ite )  & 
+    :: sumtke,  sumtkez
+
+    INTEGER  &
+    :: i, j, k, ktf, i_start, i_end, j_start, j_end
+
+    REAL  &
+    :: disp_len, deltas, coefc, tmpdz, len_s, thetasfc,  &
+       thetatop, len_0, tketmp, tmp, ce1, ce2, c_k
+
+! End declarations.
+!-----------------------------------------------------------------------
+    c_k = config_flags%c_k
+
+    ce1 = ( c_k / 0.10 ) * 0.19
+    ce2 = max( 0.0 , 0.93 - ce1 )
+
+    ktf     = MIN( kte, kde-1 )
+    i_start = its
+    i_end   = MIN(ite,ide-1)
+    j_start = jts
+    j_end   = MIN(jte,jde-1)
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested) j_end   = MIN( jde-2, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+      CALL calc_l_scale( config_flags, tke, BN2, l_scale,      &
+                         i_start, i_end, ktf, j_start, j_end,  &
+                         dx, dy, rdzw, msftx, msfty,           &
+                         ids, ide, jds, jde, kds, kde,         &
+                         ims, ime, jms, jme, kms, kme,         &
+                         its, ite, jts, jte, kts, kte          )
+      DO j = j_start, j_end
+      DO k = kts, ktf
+      DO i = i_start, i_end
+        deltas  = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333
+        tketmp  = MAX( tke(i,k,j), 1.0e-6 )
+
+! Apply Deardorff's (1980) "wall effect" at the bottom of the domain. 
+! For LES with fine grid, no need for this wall effect!
+
+        IF ( k .eq. kts .or. k .eq. ktf ) then
+          coefc = 3.9
+        ELSE
+          coefc = ce1 + ce2 * l_scale(i,k,j) / deltas
+        END IF
+
+        tendency(i,k,j) = tendency(i,k,j) - &
+                          mu(i,j) * coefc * tketmp**1.5 / l_scale(i,k,j)
+      END DO
+      END DO
+      END DO
+
+    END SUBROUTINE tke_dissip
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE tke_shear( tendency, config_flags,                &
+                          defor11, defor22, defor33,             &
+                          defor12, defor13, defor23,             &
+                          u, v, w, tke, ust, mu, fnm, fnp,       &
+                          cf1, cf2, cf3, msftx, msfty,           &
+                          xkmh, xkmv,                            &
+                          rdx, rdy, zx, zy, rdz, rdzw, dn, dnw,  &
+                          ids, ide, jds, jde, kds, kde,          &
+                          ims, ime, jms, jme, kms, kme,          &
+                          its, ite, jts, jte, kts, kte           )
+
+! History:     Sep 2003   Rewritten by George Bryan and Jason Knievel,
+!                         NCAR
+!              Oct 2001   Converted to mass core by Bill Skamarock, NCAR
+!              Aug 2000   Original code by Shu-Hua Chen, UC-Davis
+
+! Purpose:     This routine calculates the production of turbulent
+!              kinetic energy by stresses due to sheared wind.
+
+! References:  Klemp and Wilhelmson (JAS 1978)
+!              Deardorff (B-L Meteor 1980) 
+!              Chen and Dudhia (NCAR WRF physics report 2000)
+
+! Key:
+
+! avg          temporary working array
+! cf1          
+! cf2         
+! cf3
+! defor11      deformation term ( du/dx + du/dx )
+! defor12      deformation term ( dv/dx + du/dy ); same as defor21
+! defor13      deformation term ( dw/dx + du/dz ); same as defor31
+! defor22      deformation term ( dv/dy + dv/dy )
+! defor23      deformation term ( dw/dy + dv/dz ); same as defor32
+! defor33      deformation term ( dw/dz + dw/dz )
+! div          3-d divergence
+! dn
+! dnw
+! fnm
+! fnp
+! msftx
+! msfty
+! rdx
+! rdy
+! tendency
+! titau        tau (stress tensor) with a tilde, indicating division by
+!              a map-scale factor and the fraction of the total modeled
+!              atmosphere beneath a given altitude (titau = tau/m/zeta)
+! tke          turbulent kinetic energy
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, INTENT( IN )  &
+    :: cf1, cf2, cf3, rdx, rdy
+
+    REAL, DIMENSION( kms:kme ), INTENT( IN )  &
+    :: fnm, fnp, dn, dnw
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: msftx, msfty
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT )  &
+    :: tendency
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &  
+    :: defor11, defor22, defor33, defor12, defor13, defor23,    &
+       tke, xkmh, xkmv, zx, zy, u, v, w, rdz, rdzw
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: mu
+
+    REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN )  &
+    :: ust
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, ktf, ktes1, ktes2,      &
+       i_start, i_end, j_start, j_end,  &
+       is_ext, ie_ext, js_ext, je_ext   
+
+    REAL  &
+    :: mtau
+
+    REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 )  &
+    :: avg, titau, tmp2
+
+    REAL, DIMENSION( its:ite, kts:kte, jts:jte )  &
+    :: titau12, tmp1, zxavg, zyavg
+
+    REAL :: absU, cd0, Cd
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf    = MIN( kte, kde-1 )
+    ktes1  = kte-1
+    ktes2  = kte-2
+   
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_start = MAX( ids+1, its )
+    IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
+         config_flags%nested ) i_end   = MIN( ide-2, ite )
+    IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_start = MAX( jds+1, jts )
+    IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
+         config_flags%nested ) j_end   = MIN( jde-2, jte )
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      zxavg(i,k,j) = 0.25 * ( zx(i,k  ,j) + zx(i+1,k  ,j) + &
+                              zx(i,k+1,j) + zx(i+1,k+1,j)  )
+      zyavg(i,k,j) = 0.25 * ( zy(i,k  ,j) + zy(i,k  ,j+1) + &
+                              zy(i,k+1,j) + zy(i,k+1,j+1)  )
+    END DO
+    END DO
+    END DO
+
+! Begin calculating production of turbulence due to shear.  The approach
+! is to add together contributions from six terms, each of which is the
+! square of a deformation that is then multiplied by an exchange
+! coefficiant.  The same exchange coefficient is assumed for horizontal
+! and vertical coefficients for some of the terms (the vertical value is
+! the one used). 
+
+! For defor11.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + 0.5 *  &
+                        mu(i,j) * xkmh(i,k,j) * ( ( defor11(i,k,j) )**2 )
+    END DO
+    END DO
+    END DO
+
+! For defor22.
+
+    DO j = j_start, j_end 
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + 0.5 *  &
+                        mu(i,j) * xkmh(i,k,j) * ( ( defor22(i,k,j) )**2 )
+    END DO
+    END DO
+    END DO
+
+! For defor33.
+
+    DO j = j_start, j_end 
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + 0.5 *  &
+                        mu(i,j) * xkmv(i,k,j) * ( ( defor33(i,k,j) )**2 )
+    END DO
+    END DO
+    END DO
+
+! For defor12.
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      avg(i,k,j) = 0.25 *  &
+                   ( ( defor12(i  ,k,j)**2 ) + ( defor12(i  ,k,j+1)**2 ) +  &
+                     ( defor12(i+1,k,j)**2 ) + ( defor12(i+1,k,j+1)**2 ) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmh(i,k,j) * avg(i,k,j)
+    END DO
+    END DO
+    END DO
+
+! For defor13.
+
+    DO j = j_start, j_end
+    DO k = kts+1, ktf
+    DO i = i_start, i_end+1
+      tmp2(i,k,j) = defor13(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO i = i_start, i_end+1
+      tmp2(i,kts  ,j) = 0.0
+      tmp2(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      avg(i,k,j) = 0.25 *  &
+                   ( ( tmp2(i  ,k+1,j)**2 ) + ( tmp2(i  ,k,j)**2 ) +  &
+                     ( tmp2(i+1,k+1,j)**2 ) + ( tmp2(i+1,k,j)**2 ) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j)
+    END DO
+    END DO
+    END DO
+
+!MARTA: add the drag at the surface; WCS 040331
+    K=KTS
+
+  uflux: SELECT CASE( config_flags%isfflx )
+  CASE (0) ! Assume cd a constant, specified in namelist
+
+    cd0 = config_flags%tke_drag_coefficient  ! drag coefficient set 
+                                             ! in namelist.input
+    DO j = j_start, j_end   
+    DO i = i_start, i_end
+
+      absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)
+      Cd = cd0
+      tendency(i,k,j) = tendency(i,k,j) +       &
+           mu(i,j)*( (u(i,k,j)+u(i+1,k,j))*0.5* &
+                     Cd*absU*(defor13(i,kts+1,j)+defor13(i+1,kts+1,j))*0.5 )
+
+    END DO
+    END DO
+
+  CASE (1,2) ! ustar computed from surface routine
+
+    PRINT *, 'USE u star (surf drag) from PHYSICS', ust(i_start,j_start)
+    DO j = j_start, j_end
+    DO i = i_start, i_end
+
+      absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)+epsilon
+      Cd = (ust(i,j)**2)/(absU**2)
+      tendency(i,k,j) = tendency(i,k,j) +       &
+           mu(i,j)*( (u(i,k,j)+u(i+1,k,j))*0.5* &
+                     Cd*absU*(defor13(i,kts+1,j)+defor13(i+1,kts+1,j))*0.5 )
+
+    END DO
+    END DO
+
+  CASE DEFAULT
+    CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
+  END SELECT uflux
+! end of MARTA/WCS change
+
+! For defor23.
+
+    DO j = j_start, j_end+1
+    DO k = kts+1, ktf
+    DO i = i_start, i_end
+      tmp2(i,k,j) = defor23(i,k,j)
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end+1
+    DO i = i_start, i_end
+      tmp2(i,kts,  j) = 0.0
+      tmp2(i,ktf+1,j) = 0.0
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      avg(i,k,j) = 0.25 *  &
+                   ( ( tmp2(i,k+1,j  )**2 ) + ( tmp2(i,k,j  )**2) +  &
+                     ( tmp2(i,k+1,j+1)**2 ) + ( tmp2(i,k,j+1)**2) )
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = kts, ktf
+    DO i = i_start, i_end
+      tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j)
+    END DO
+    END DO
+    END DO
+
+!MARTA: add the drag at the surface; WCS 040331
+    K=KTS
+
+  vflux: SELECT CASE( config_flags%isfflx )
+  CASE (0) ! Assume cd a constant, specified in namelist
+
+    cd0 = config_flags%tke_drag_coefficient   ! constant drag coefficient 
+                                              ! set in namelist.input
+    DO j = j_start, j_end   
+    DO i = i_start, i_end
+
+      absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)
+      Cd = cd0
+      tendency(i,k,j) = tendency(i,k,j) +       &
+           mu(i,j)*( (v(i,k,j)+v(i,k,j+1))*0.5* &
+                     Cd*absU*(defor23(i,kts+1,j)+defor23(i,kts+1,j+1))*0.5 )
+
+    END DO
+    END DO
+
+  CASE (1,2) ! ustar computed from surface routine
+
+    DO j = j_start, j_end   
+    DO i = i_start, i_end
+
+      absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)+epsilon
+      Cd = (ust(i,j)**2)/(absU**2)
+      tendency(i,k,j) = tendency(i,k,j) +       &
+           mu(i,j)*( (v(i,k,j)+v(i,k,j+1))*0.5* &
+                     Cd*absU*(defor23(i,kts+1,j)+defor23(i,kts+1,j+1))*0.5 )
+
+    END DO
+    END DO
+
+  CASE DEFAULT
+    CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
+  END SELECT vflux
+! end of MARTA/WCS change
+
+    END SUBROUTINE tke_shear
+
+!=======================================================================
+!=======================================================================
+
+    SUBROUTINE compute_diff_metrics( config_flags, ph, phb, z, rdz, rdzw,  &
+                                     zx, zy, rdx, rdy,                     &
+                                     ids, ide, jds, jde, kds, kde,         &
+                                     ims, ime, jms, jme, kms, kme,         &
+                                     its, ite, jts, jte, kts, kte         )
+
+!-----------------------------------------------------------------------
+! Begin declarations.
+
+    IMPLICIT NONE
+
+    TYPE( grid_config_rec_type ), INTENT( IN )  &
+    :: config_flags
+
+    INTEGER, INTENT( IN )  &
+    :: ids, ide, jds, jde, kds, kde,  &
+       ims, ime, jms, jme, kms, kme,  &
+       its, ite, jts, jte, kts, kte
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN )  &
+    :: ph, phb
+
+    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( OUT )  &
+    :: rdz, rdzw, zx, zy, z
+
+    REAL, INTENT( IN )  &
+    :: rdx, rdy
+
+! Local variables.
+
+    INTEGER  &
+    :: i, j, k, i_start, i_end, j_start, j_end, ktf
+
+! End declarations.
+!-----------------------------------------------------------------------
+
+    ktf = MIN( kte, kde-1 )
+
+! Bug fix, WCS, 22 april 2002.
+
+! We need rdzw in halo for average to u and v points.
+
+    j_start = jts-1
+    j_end   = jte
+
+! Begin with dz computations.
+
+    DO j = j_start, j_end
+
+      IF ( ( j_start >= jts ) .AND. ( j_end <= MIN( jte, jde-1 ) ) ) THEN
+        i_start = its-1
+        i_end   = ite
+      ELSE
+        i_start = its
+        i_end   = MIN( ite, ide-1 )
+      END IF
+
+! Compute z at w points for rdz and rdzw computations.  We'll switch z
+! to z at p points before returning
+
+      DO k = 1, kte
+
+! Bug fix, WCS, 22 april 2002
+
+      DO i = i_start, i_end
+        z(i,k,j) = ( ph(i,k,j) + phb(i,k,j) ) / g
+      END DO
+      END DO
+
+      DO k = 1, ktf
+      DO i = i_start, i_end
+        rdzw(i,k,j) = 1.0 / ( z(i,k+1,j) - z(i,k,j) )
+      END DO
+      END DO
+
+      DO k = 2, ktf
+      DO i = i_start, i_end
+        rdz(i,k,j) = 2.0 / ( z(i,k+1,j) - z(i,k-1,j) )
+      END DO
+      END DO
+
+! Bug fix, WCS, 22 april 2002; added the following code
+
+      DO i = i_start, i_end
+        rdz(i,1,j) = 2./(z(i,2,j)-z(i,1,j))
+      END DO
+
+    END DO
+
+! End bug fix.
+
+! Now compute zx and zy; we'll assume that the halo for ph and phb is
+! properly filled.
+
+    i_start = its
+    i_end   = MIN( ite, ide-1 )
+    j_start = jts
+    j_end   = MIN( jte, jde-1 )
+
+    DO j = j_start, j_end
+    DO k = 1, kte
+    DO i = MAX( ids+1, its ), i_end
+      zx(i,k,j) = rdx * ( phb(i,k,j) - phb(i-1,k,j) ) / g
+    END DO
+    END DO
+    END DO
+
+    DO j = j_start, j_end
+    DO k = 1, kte
+    DO i = MAX( ids+1, its ), i_end
+      zx(i,k,j) = zx(i,k,j) + rdx * ( ph(i,k,j) - ph(i-1,k,j) ) / g
+    END DO
+    END DO
+    END DO
+
+    DO j = MAX( jds+1, jts ), j_end
+    DO k = 1, kte
+    DO i = i_start, i_end
+      zy(i,k,j) = rdy * ( phb(i,k,j) - phb(i,k,j-1) ) / g
+    END DO
+    END DO
+    END DO
+
+    DO j = MAX( jds+1, jts ), j_end
+    DO k = 1, kte
+    DO i = i_start, i_end
+      zy(i,k,j) = zy(i,k,j) + rdy * ( ph(i,k,j) - ph(i,k,j-1) ) / g
+    END DO
+    END DO
+    END DO
+
+! Some b.c. on zx and zy.
+
+    IF ( .NOT. config_flags%periodic_x ) THEN
+
+      IF ( ite == ide ) THEN
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zx(ide,k,j) = 0.0
+        END DO
+        END DO
+      END IF
+
+      IF ( its == ids ) THEN
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zx(ids,k,j) = 0.0
+        END DO
+        END DO
+      END IF
+
+    ELSE
+
+      IF ( ite == ide ) THEN
+        DO j=j_start,j_end
+        DO k=1,ktf
+         zx(ide,k,j) = rdx * ( phb(ide,k,j) - phb(ide-1,k,j) ) / g
+        END DO
+        END DO
+
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zx(ide,k,j) = zx(ide,k,j) + rdx * ( ph(ide,k,j) - ph(ide-1,k,j) ) / g
+        END DO
+        END DO
+      END IF
+
+      IF ( its == ids ) THEN
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zx(ids,k,j) = rdx * ( phb(ids,k,j) - phb(ids-1,k,j) ) / g
+        END DO
+        END DO
+
+        DO j =j_start,j_end
+        DO k =1,ktf
+          zx(ids,k,j) = zx(ids,k,j) + rdx * ( ph(ids,k,j) - ph(ids-1,k,j) ) / g
+        END DO
+        END DO
+      END IF
+
+    END IF
+
+    IF ( .NOT. config_flags%periodic_y ) THEN
+
+      IF ( jte == jde ) THEN
+        DO k =1, ktf
+        DO i =i_start, i_end
+          zy(i,k,jde) = 0.0
+        END DO
+        END DO
+      END IF
+
+      IF ( jts == jds ) THEN
+        DO k =1, ktf
+        DO i =i_start, i_end
+          zy(i,k,jds) = 0.0
+        END DO
+        END DO
+      END IF
+
+    ELSE
+
+      IF ( jte == jde ) THEN
+        DO j=j_start, j_end
+        DO k=1, ktf
+          zy(i,k,jde) = rdy * ( phb(i,k,jde) - phb(i,k,jde-1) ) / g
+        END DO
+        END DO
+
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zy(i,k,jde) = zy(i,k,jde) + rdy * ( ph(i,k,jde) - ph(i,k,jde-1) ) / g
+        END DO
+        END DO
+      END IF
+
+      IF ( jts == jds ) THEN
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zy(i,k,jds) = rdy * ( phb(i,k,jds) - phb(i,k,jds-1) ) / g
+        END DO
+        END DO
+
+        DO j = j_start, j_end
+        DO k = 1, ktf
+          zy(i,k,jds) = zy(i,k,jds) + rdy * ( ph(i,k,jds) - ph(i,k,jds-1) ) / g
+        END DO
+        END DO
+      END IF
+
+    END IF
+      
+! Calculate z at p points.
+
+    DO j = j_start, j_end
+      DO k = 1, ktf
+      DO i = i_start, i_end
+        z(i,k,j) = 0.5 *  &
+                   ( ph(i,k,j) + phb(i,k,j) + ph(i,k+1,j) + phb(i,k+1,j) ) / g
+      END DO
+      END DO
+    END DO
+
+    END SUBROUTINE compute_diff_metrics
+
+!=======================================================================
+!=======================================================================
+
+    END MODULE module_diffusion_em
+
+!=======================================================================
+!=======================================================================
+
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_driver_constants.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_driver_constants.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_driver_constants.F	(revision 2744)
@@ -0,0 +1,108 @@
+!WRF:DRIVER_LAYER:CONSTANTS
+!
+!  This MODULE contains all of the constants used in the model.  These
+!  are separated by uage within the code.
+
+MODULE module_driver_constants
+
+   !  0. The following tells the rest of the model what data ordering we are
+   !     using
+
+   INTEGER , PARAMETER :: DATA_ORDER_XYZ = 1
+   INTEGER , PARAMETER :: DATA_ORDER_YXZ = 2
+   INTEGER , PARAMETER :: DATA_ORDER_ZXY = 3
+   INTEGER , PARAMETER :: DATA_ORDER_ZYX = 4
+   INTEGER , PARAMETER :: DATA_ORDER_XZY = 5
+   INTEGER , PARAMETER :: DATA_ORDER_YZX = 6
+   INTEGER , PARAMETER :: DATA_ORDER_XY = DATA_ORDER_XYZ
+   INTEGER , PARAMETER :: DATA_ORDER_YX = DATA_ORDER_YXZ
+
+
+#include <model_data_order.inc>
+
+   !  1. Following are constants for use in defining maximal values for array
+   !     definitions.  
+   !
+
+   !  The maximum number of levels in the model is how deeply the domains may
+   !  be nested.
+
+   INTEGER , PARAMETER :: max_levels      =  20
+
+   !  The maximum number of nests that can depend on a single parent and other way round
+
+   INTEGER , PARAMETER :: max_nests        =  20
+
+   !  The maximum number of parents that a nest can have (simplified assumption -> one only)
+
+   INTEGER , PARAMETER :: max_parents      =  1
+
+   !  The maximum number of domains is how many grids the model will be running.
+
+   INTEGER , PARAMETER :: max_domains     =   ( MAX_DOMAINS_F - 1 ) / 2 + 1
+
+   !  The maximum number of nest move specifications allowed in a namelist
+
+   INTEGER , PARAMETER :: max_moves       =   50
+
+   !  The maximum number of eta levels
+
+   INTEGER , PARAMETER :: max_eta         =   501
+
+   !  The maximum number of outer iterations (for DA minimisation)
+
+   INTEGER , PARAMETER :: max_outer_iterations = 10
+
+   !  The maximum number of instruments (for radiance DA)
+
+   INTEGER , PARAMETER :: max_instruments =   30
+
+   !  2. Following related to driver leve data structures for DM_PARALLEL communications
+
+#ifdef DM_PARALLEL
+   INTEGER , PARAMETER :: max_comms       =   1024
+#else
+   INTEGER , PARAMETER :: max_comms       =   1
+#endif
+
+   !  3. Following is information related to the file I/O.
+
+   !  These are the bounds of the available FORTRAN logical unit numbers for the file I/O.
+   !  Only logical unti numbers within these bounds will be chosen for I/O unit numbers.
+
+   INTEGER , PARAMETER :: min_file_unit = 10
+   INTEGER , PARAMETER :: max_file_unit = 99
+
+   !  4. Unfortunately, the following definition is needed here (rather
+   !     than the more logical place in share/module_model_constants.F)
+   !     for the namelist reads in frame/module_configure.F, and for some
+   !     conversions in share/set_timekeeping.F
+   !     Actually, using it here will mean that we don't need to set it
+   !     in share/module_model_constants.F, since this file will be
+   !     included (USEd) in:
+   !        frame/module_configure.F
+   !     which will be USEd in:
+   !        share/module_bc.F
+   !     which will be USEd in:
+   !        phys/module_radiation_driver.F
+   !     which is the other important place for it to be, and where
+   !     it is passed as a subroutine parameter to any physics subroutine.
+   !
+   !     P2SI is the number of SI seconds in an planetary solar day
+   !     divided by the number of SI seconds in an earth solar day
+!#if defined MARS
+!   !     For Mars, P2SI = 88775.2/86400.
+!   REAL , PARAMETER :: P2SI = 1.0274907
+!#elif defined TITAN
+!   !     For Titan, P2SI = 1378080.0/86400.
+!   REAL , PARAMETER :: P2SI = 15.95
+!#else
+   !     Default for Earth
+   REAL , PARAMETER :: P2SI = 1.0
+!!!!MARS
+!   REAL , PARAMETER :: P2SI = 1.0274907
+!#endif
+ CONTAINS
+   SUBROUTINE init_module_driver_constants
+   END SUBROUTINE init_module_driver_constants
+ END MODULE module_driver_constants
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_em.F	(revision 2744)
@@ -0,0 +1,1781 @@
+!WRF:MODEL_LAYER:DYNAMICS
+!
+
+MODULE module_em
+
+   USE module_model_constants
+   USE module_advect_em
+   USE module_big_step_utilities_em
+   USE module_state_description
+   USE module_damping_em
+
+CONTAINS
+
+!------------------------------------------------------------------------
+
+SUBROUTINE rk_step_prep  ( config_flags, rk_step,           &
+                           u, v, w, t, ph, mu,              &
+                           moist,                           &
+                           ru, rv, rw, ww, php, alt,        &
+                           muu, muv,                        &
+                           mub, mut, phb, pb, p, al, alb,   &
+                           cqu, cqv, cqw,                   &
+                           msfux, msfuy,                    &
+                           msfvx, msfvx_inv, msfvy,         &
+                           msftx, msfty,                    &
+                           fnm, fnp, dnw, rdx, rdy,         &
+                           n_moist,                         &
+                           ids, ide, jds, jde, kds, kde,    &
+                           ims, ime, jms, jme, kms, kme,    &
+                           its, ite, jts, jte, kts, kte    )
+
+   IMPLICIT NONE
+
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte
+
+   INTEGER ,       INTENT(IN   ) :: n_moist, rk_step
+
+   REAL ,          INTENT(IN   ) :: rdx, rdy
+
+   REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
+                                               INTENT(IN   ) ::  u,       &
+                                                                 v,       &
+                                                                 w,       &
+                                                                 t,       &
+                                                                 ph,      &
+                                                                 phb,     &
+                                                                 pb,      &
+                                                                 al,      &
+                                                                 alb
+
+   REAL , DIMENSION( ims:ime , kms:kme , jms:jme  ) ,                     &
+                                               INTENT(  OUT) ::  ru,      &
+                                                                 rv,      &
+                                                                 rw,      &
+                                                                 ww,      &
+                                                                 php,     &
+                                                                 cqu,     &
+                                                                 cqv,     &
+                                                                 cqw,     &
+                                                                 alt
+
+   REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
+                                               INTENT(IN   ) ::  p
+                                                                 
+
+
+
+   REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), INTENT(   IN) :: &
+                                                           moist
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,    INTENT(IN   ) :: msftx,     &
+                                                               msfty,     &
+                                                               msfux,     &
+                                                               msfuy,     &
+                                                               msfvx,     &
+                                                               msfvx_inv, &
+                                                               msfvy,     &
+                                                               mu,        &
+                                                               mub
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,    INTENT(  OUT) :: muu,    &
+                                                               muv,    &
+                                                               mut
+
+   REAL , DIMENSION( kms:kme ) ,    INTENT(IN   ) :: fnm, fnp, dnw
+
+   integer :: k
+
+
+!<DESCRIPTION>
+!
+!  rk_step_prep prepares a number of diagnostic quantities 
+!  in preperation for a Runge-Kutta timestep.  subroutines called
+!  by rk_step_prep calculate
+!
+!  (1) total column dry air mass (mut, call to calculate_full)
+!
+!  (2) total column dry air mass at u and v points 
+!      (muu, muv, call to calculate_mu_uv)
+!
+!  (3) mass-coupled velocities for advection
+!      (ru, rv, and rw, call to couple_momentum)
+!
+!  (4) omega (call to calc_ww_cp)
+!
+!  (5) moisture coefficients (cqu, cqv, cqw, call to calc_cq)
+!
+!  (6) inverse density (alt, call to calc_alt)
+!
+!  (7) geopotential at pressure points (php, call to calc_php)
+!
+!</DESCRIPTION>
+
+   CALL calculate_full( mut, mub, mu,             &
+                        ids, ide, jds, jde, 1, 2, &
+                        ims, ime, jms, jme, 1, 1, &
+                        its, ite, jts, jte, 1, 1 )
+
+   CALL calc_mu_uv ( config_flags,                  &
+                     mu, mub, muu, muv,             &
+                     ids, ide, jds, jde, kds, kde,  &
+                     ims, ime, jms, jme, kms, kme,  &
+                     its, ite, jts, jte, kts, kte  )
+
+   CALL couple_momentum( muu, ru, u, msfuy,             &
+                         muv, rv, v, msfvx, msfvx_inv,  &
+                         mut, rw, w, msfty,             &
+                         ids, ide, jds, jde, kds, kde,  &
+                         ims, ime, jms, jme, kms, kme,  &
+                         its, ite, jts, jte, kts, kte  )
+
+!  new call, couples V with mu, also has correct map factors.  WCS, 3 june 2001
+   CALL calc_ww_cp ( u, v, mu, mub, ww,               &
+                     rdx, rdy, msftx, msfty,          &
+                     msfux, msfuy, msfvx, msfvx_inv,  &
+                     msfvy, dnw,                      &
+                     ids, ide, jds, jde, kds, kde,    &
+                     ims, ime, jms, jme, kms, kme,    &
+                     its, ite, jts, jte, kts, kte    )
+
+   CALL calc_cq ( moist, cqu, cqv, cqw, n_moist, &
+                  ids, ide, jds, jde, kds, kde,  &
+                  ims, ime, jms, jme, kms, kme,  &
+                  its, ite, jts, jte, kts, kte  )
+
+   CALL calc_alt ( alt, al, alb,                 &
+                   ids, ide, jds, jde, kds, kde, &
+                   ims, ime, jms, jme, kms, kme, &
+                   its, ite, jts, jte, kts, kte )
+
+   CALL calc_php ( php, ph, phb,                 &
+                   ids, ide, jds, jde, kds, kde, &
+                   ims, ime, jms, jme, kms, kme, &
+                   its, ite, jts, jte, kts, kte )
+
+END SUBROUTINE rk_step_prep
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_tendency ( config_flags, rk_step,                           &
+                         ru_tend, rv_tend, rw_tend, ph_tend, t_tend,      &
+                         ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
+                         mu_tend, u_save, v_save, w_save, ph_save,        &
+                         t_save, mu_save, RTHFTEN,                        &
+                         ru, rv, rw, ww,                                  &
+                         u, v, w, t, ph,                                  &
+                         u_old, v_old, w_old, t_old, ph_old,              &
+                         h_diabatic, phb,t_init,                          &
+                         mu, mut, muu, muv, mub,                          &
+                         al, alt, p, pb, php, cqu, cqv, cqw,              &
+                         u_base, v_base, t_base, qv_base, z_base,         &
+                         msfux, msfuy, msfvx, msfvx_inv,                  &
+                         msfvy, msftx, msfty,                             &
+                         xlat, f, e, sina, cosa,                          &
+                         fnm, fnp, rdn, rdnw,                             &
+                         dt, rdx, rdy, khdif, kvdif, xkmhd, xkhh,         &
+                         diff_6th_opt, diff_6th_factor,                   &
+                         dampcoef,zdamp,damp_opt,                         &
+                         cf1, cf2, cf3, cfn, cfn1, n_moist,               &
+                         non_hydrostatic, top_lid,                        &
+                         u_frame, v_frame,                                &
+                         ids, ide, jds, jde, kds, kde,                    &
+                         ims, ime, jms, jme, kms, kme,                    &
+                         its, ite, jts, jte, kts, kte,                    &
+                         max_vert_cfl, max_horiz_cfl)
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type)    ,           INTENT(IN   ) :: config_flags
+
+   INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte
+
+   LOGICAL ,               INTENT(IN   ) :: non_hydrostatic, top_lid
+
+   INTEGER ,               INTENT(IN   ) :: n_moist, rk_step
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,              &
+                                        INTENT(IN   ) :: ru,      &
+                                                         rv,      &
+                                                         rw,      &
+                                                         ww,      & 
+                                                         u,       &
+                                                         v,       &
+                                                         w,       &
+                                                         t,       &
+                                                         ph,      &
+                                                         u_old,   &
+                                                         v_old,   &
+                                                         w_old,   &
+                                                         t_old,   &
+                                                         ph_old,  &
+                                                         phb,     &
+                                                         al,      &
+                                                         alt,     &
+                                                         p,       &
+                                                         pb,      &
+                                                         php,     &
+                                                         cqu,     &
+                                                         cqv,     &
+                                                         t_init,  &
+                                                         xkmhd,   &
+                                                         xkhh,    &
+                                                         h_diabatic
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,              &
+                                        INTENT(OUT  ) :: ru_tend, &
+                                                         rv_tend, &
+                                                         rw_tend, &
+                                                         t_tend,  &
+                                                         ph_tend, &
+                                                         RTHFTEN, &
+                                                          u_save, &
+                                                          v_save, &
+                                                          w_save, &
+                                                         ph_save, &
+                                                          t_save
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,               &
+                                        INTENT(INOUT) :: ru_tendf, &
+                                                         rv_tendf, &
+                                                         rw_tendf, &
+                                                         t_tendf,  &
+                                                         ph_tendf, &
+                                                         cqw
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(  OUT) :: mu_tend, &
+                                                                    mu_save
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfux,   &
+                                                                    msfuy,   &
+                                                                    msfvx,   &
+                                                                    msfvx_inv,   &
+                                                                    msfvy,   &
+                                                                    msftx,   &
+                                                                    msfty,   &
+                                                                    xlat,    & 
+                                                                    f,       &
+                                                                    e,       &
+                                                                    sina,    &
+                                                                    cosa,    &
+                                                                    mu,      &
+                                                                    mut,     &
+                                                                    mub,     &
+                                                                    muu,     &
+                                                                    muv
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnm,     &
+                                                                  fnp,     &
+                                                                  rdn,     &
+                                                                  rdnw,    &
+                                                                  u_base,  &
+                                                                  v_base,  &
+                                                                  t_base,  &
+                                                                  qv_base, &
+                                                                  z_base
+
+   REAL ,                                      INTENT(IN   ) :: rdx,     &
+                                                                rdy,     &
+                                                                dt,      &
+                                                                u_frame, &
+                                                                v_frame, &
+                                                                khdif,   &
+                                                                kvdif
+   INTEGER, INTENT( IN ) :: diff_6th_opt
+   REAL,    INTENT( IN ) :: diff_6th_factor
+
+   INTEGER, INTENT( IN ) :: damp_opt
+
+   REAL, INTENT( IN ) :: zdamp, dampcoef
+
+   REAL, INTENT( OUT ) :: max_horiz_cfl
+   REAL, INTENT( OUT ) :: max_vert_cfl
+
+   REAL    :: kdift, khdq, kvdq, cfn, cfn1, cf1, cf2, cf3
+   INTEGER :: i,j,k
+   INTEGER :: time_step
+
+!<DESCRIPTION>
+!
+!  rk_tendency computes the large-timestep tendency terms in the 
+!  momentum, thermodynamic (theta), and geopotential equations.  
+!  These terms include:
+!
+!  (1) advection (for u, v, w, theta - calls to advect_u, advect_v,
+!                 advect_w, and advact_scalar).
+!
+!  (2) geopotential equation terms (advection and "gw" - call to rhs_ph).
+!
+!  (3) buoyancy term in vertical momentum equation (call to pg_buoy_w).
+!
+!  (4) Coriolis and curvature terms in u,v,w momentum equations
+!      (calls to subroutines coriolis, curvature)
+!
+!  (5) 3D diffusion on coordinate surfaces.
+!
+!</DESCRIPTION>
+
+   CALL zero_tend ( ru_tend,                      &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( rv_tend,                      &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( rw_tend,                      &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( t_tend,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( ph_tend,                      &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( u_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( v_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( w_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( ph_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( t_save,                       &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+   CALL zero_tend ( mu_tend,                  &
+                    ids, ide, jds, jde, 1, 1, &
+                    ims, ime, jms, jme, 1, 1, &
+                    its, ite, jts, jte, 1, 1 )
+
+   CALL zero_tend ( mu_save,                  &
+                    ids, ide, jds, jde, 1, 1, &
+                    ims, ime, jms, jme, 1, 1, &
+                    its, ite, jts, jte, 1, 1 )
+
+     !  advection tendencies
+     CALL nl_get_time_step ( 1, time_step )
+
+     CALL advect_u ( u, u , ru_tend, ru, rv, ww,   &
+                     mut, time_step, config_flags, &
+                     msfux, msfuy, msfvx, msfvy,   &
+                     msftx, msfty,                 &
+                     fnm, fnp, rdx, rdy, rdnw,     &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+
+     CALL advect_v ( v, v , rv_tend, ru, rv, ww,   &
+                     mut, time_step, config_flags, &
+                     msfux, msfuy, msfvx, msfvy,   &
+                     msftx, msfty,                 &
+                     fnm, fnp, rdx, rdy, rdnw,     &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+
+     IF (non_hydrostatic)                          &
+     CALL advect_w ( w, w, rw_tend, ru, rv, ww,    &
+                     mut, time_step, config_flags, &
+                     msfux, msfuy, msfvx, msfvy,   &
+                     msftx, msfty,                 &
+                     fnm, fnp, rdx, rdy, rdn,      &
+                     ids, ide, jds, jde, kds, kde, &
+                     ims, ime, jms, jme, kms, kme, &
+                     its, ite, jts, jte, kts, kte )
+
+!  theta flux divergence
+
+     CALL advect_scalar ( t, t, t_tend, ru, rv, ww,     &
+                          mut, time_step, config_flags, &
+                          msfux, msfuy, msfvx, msfvy,   &
+                          msftx, msfty, fnm, fnp,       &
+                          rdx, rdy, rdnw,               &
+                          ids, ide, jds, jde, kds, kde, &
+                          ims, ime, jms, jme, kms, kme, &
+                          its, ite, jts, jte, kts, kte ) 
+
+     IF ( config_flags%cu_physics == GDSCHEME  .OR.     &
+          config_flags%cu_physics == G3SCHEME ) THEN
+
+     ! theta advection only:
+
+         CALL set_tend( RTHFTEN, t_tend, msfty,          &
+                        ids, ide, jds, jde, kds, kde,    &
+                        ims, ime, jms, jme, kms, kme,    &
+                        its, ite, jts, jte, kts, kte     )
+
+     END IF
+
+     CALL rhs_ph( ph_tend, u, v, ww, ph, ph, phb, w, &
+                  mut, muu, muv,                     &
+                  fnm, fnp,                          &
+                  rdnw, cfn, cfn1, rdx, rdy,         &
+                  msfux, msfuy, msfvx,               &
+                  msfvx_inv, msfvy,                  &
+                  msftx, msfty,                      &
+                  non_hydrostatic,                   &
+                  config_flags,                      &
+                  ids, ide, jds, jde, kds, kde,      &
+                  ims, ime, jms, jme, kms, kme,      &
+                  its, ite, jts, jte, kts, kte      )
+
+  CALL horizontal_pressure_gradient( ru_tend,rv_tend,                &
+                                     ph,alt,p,pb,al,php,cqu,cqv,     &
+                                     muu,muv,mu,fnm,fnp,rdnw,        &
+                                     cf1,cf2,cf3,rdx,rdy,msfux,msfuy,&
+                                     msfvx,msfvy,msftx,msfty,        &
+                                     config_flags, non_hydrostatic,  &
+                                     top_lid,                        &
+                                     ids, ide, jds, jde, kds, kde,   &
+                                     ims, ime, jms, jme, kms, kme,   &
+                                     its, ite, jts, jte, kts, kte   )
+
+  IF (non_hydrostatic)                            &
+  CALL pg_buoy_w( rw_tend, p, cqw, mu, mub,       &
+                  rdnw, rdn, g, msftx, msfty,     &
+                  ids, ide, jds, jde, kds, kde,   &
+                  ims, ime, jms, jme, kms, kme,   &
+                  its, ite, jts, jte, kts, kte   )
+
+  CALL w_damp   ( rw_tend, max_vert_cfl,            &
+                    max_horiz_cfl,                  &
+                    u, v, ww, w, mut, rdnw,         &
+                    rdx, rdy, msfux, msfuy, msfvx,  &
+                    msfvy, dt, config_flags,        &
+                    ids, ide, jds, jde, kds, kde,   &
+                    ims, ime, jms, jme, kms, kme,   &
+                    its, ite, jts, jte, kts, kte   )
+
+  IF(config_flags%pert_coriolis) THEN
+
+    CALL perturbation_coriolis ( ru, rv, rw,                   &
+                                 ru_tend,  rv_tend,  rw_tend,  &
+                                 config_flags,                 &
+                                 u_base, v_base, z_base,       &
+                                 muu, muv, phb, ph,            &
+                                 msftx, msfty, msfux, msfuy,   &
+                                 msfvx, msfvy,                 &
+                                 f, e, sina, cosa, fnm, fnp,   &
+                                 ids, ide, jds, jde, kds, kde, &
+                                 ims, ime, jms, jme, kms, kme, &
+                                 its, ite, jts, jte, kts, kte )
+  ELSE
+    CALL coriolis ( ru, rv, rw,                   &
+                    ru_tend,  rv_tend,  rw_tend,  &
+                    config_flags,                 &
+                    msftx, msfty, msfux, msfuy,   &
+                    msfvx, msfvy,                 &
+                    f, e, sina, cosa, fnm, fnp,   &
+                    ids, ide, jds, jde, kds, kde, &
+                    ims, ime, jms, jme, kms, kme, &
+                    its, ite, jts, jte, kts, kte )
+
+  END IF
+
+  CALL curvature ( ru, rv, rw, u, v, w,            &
+                   ru_tend,  rv_tend,  rw_tend,    &
+                   config_flags,                   &
+                   msfux, msfuy, msfvx, msfvy,     &
+                   msftx, msfty,                   &
+                   xlat, fnm, fnp, rdx, rdy,       &
+                   ids, ide, jds, jde, kds, kde,   &
+                   ims, ime, jms, jme, kms, kme,   &
+                   its, ite, jts, jte, kts, kte   )
+
+! Damping option added for Held-Suarez test (also uses lw option HELDSUAREZ)
+  IF (config_flags%ra_lw_physics == HELDSUAREZ) THEN
+     CALL held_suarez_damp ( ru_tend, rv_tend,               &   
+                             ru,rv,p,pb,                     &
+                             ids, ide, jds, jde, kds, kde,   &
+                             ims, ime, jms, jme, kms, kme,   &
+                             its, ite, jts, jte, kts, kte   )
+  END IF
+
+!**************************************************************
+!
+!  Next, the terms that we integrate only with forward-in-time
+!  (evaluate with time t variables).
+!
+!**************************************************************
+
+  forward_step: IF( rk_step == 1 ) THEN
+
+    diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
+   
+        CALL horizontal_diffusion ('u', u, ru_tendf, mut, config_flags, &
+                                        msfux, msfuy, msfvx, msfvx_inv, &
+                                        msfvy,msftx, msfty,             &
+                                        khdif, xkmhd, rdx, rdy,         &
+                                        ids, ide, jds, jde, kds, kde,   &
+                                        ims, ime, jms, jme, kms, kme,   &
+                                        its, ite, jts, jte, kts, kte   )
+
+        CALL horizontal_diffusion ('v', v, rv_tendf, mut, config_flags, &
+                                        msfux, msfuy, msfvx, msfvx_inv, &
+                                        msfvy,msftx, msfty,             &
+                                        khdif, xkmhd, rdx, rdy,         &
+                                        ids, ide, jds, jde, kds, kde,   &
+                                        ims, ime, jms, jme, kms, kme,   &
+                                        its, ite, jts, jte, kts, kte   )
+
+        CALL horizontal_diffusion ('w', w, rw_tendf, mut, config_flags, &
+                                        msfux, msfuy, msfvx, msfvx_inv, &
+                                        msfvy,msftx, msfty,             &
+                                        khdif, xkmhd, rdx, rdy,         &
+                                        ids, ide, jds, jde, kds, kde,   &
+                                        ims, ime, jms, jme, kms, kme,   &
+                                        its, ite, jts, jte, kts, kte   )
+
+        khdq = 3.*khdif
+        CALL horizontal_diffusion_3dmp ( 'm', t, t_tendf, mut,            &
+                                         config_flags, t_init,            &
+                                         msfux, msfuy, msfvx, msfvx_inv,  &
+                                         msfvy, msftx, msfty,             &
+                                         khdq , xkhh, rdx, rdy,           &
+                                         ids, ide, jds, jde, kds, kde,    &
+                                         ims, ime, jms, jme, kms, kme,    &
+                                         its, ite, jts, jte, kts, kte    )
+
+!        pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN
+!!!****MARS: vertical diffusion is done in the physics (TODO: consider the nonhydrostatic case ?)
+        pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) &
+                        .AND. (.not. config_flags%modif_wrf) ) THEN
+
+          CALL vertical_diffusion_u ( u, ru_tendf, config_flags,      &
+                                      u_base,                         &
+                                      alt, muu, rdn, rdnw, kvdif,     &
+                                      ids, ide, jds, jde, kds, kde,   &
+                                      ims, ime, jms, jme, kms, kme,   &
+                                      its, ite, jts, jte, kts, kte   )
+
+          CALL vertical_diffusion_v ( v, rv_tendf, config_flags,      &
+                                      v_base,                         &
+                                      alt, muv, rdn, rdnw, kvdif,     &
+                                      ids, ide, jds, jde, kds, kde,   &
+                                      ims, ime, jms, jme, kms, kme,   &
+                                      its, ite, jts, jte, kts, kte   )
+
+          IF (non_hydrostatic)                                           &
+          CALL vertical_diffusion ( 'w', w, rw_tendf, config_flags,      &
+                                    alt, mut, rdn, rdnw, kvdif,          &
+                                    ids, ide, jds, jde, kds, kde,        &
+                                    ims, ime, jms, jme, kms, kme,        &
+                                    its, ite, jts, jte, kts, kte        )
+
+          kvdq = 3.*kvdif
+          CALL vertical_diffusion_3dmp ( t, t_tendf, config_flags, t_init,     &
+                                         alt, mut, rdn, rdnw, kvdq ,           &
+                                         ids, ide, jds, jde, kds, kde,         &
+                                         ims, ime, jms, jme, kms, kme,         &
+                                         its, ite, jts, jte, kts, kte         )
+
+        ENDIF pbl_test
+
+   !  Theta tendency computations.
+
+    END IF diff_opt1
+
+    IF ( diff_6th_opt .NE. 0 ) THEN
+
+      CALL sixth_order_diffusion( 'u', u, ru_tendf, mut, dt,          &
+                                       config_flags,                  &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+      CALL sixth_order_diffusion( 'v', v, rv_tendf, mut, dt,          &
+                                       config_flags,                  &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+      IF (non_hydrostatic)                                            & 
+      CALL sixth_order_diffusion( 'w', w, rw_tendf, mut, dt,          &
+                                       config_flags,                  &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+      CALL sixth_order_diffusion( 'm', t,  t_tendf, mut, dt,          &
+                                       config_flags,                  &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+    ENDIF
+
+    IF( damp_opt .eq. 2 )                                      &
+       CALL rk_rayleigh_damp( ru_tendf, rv_tendf,              &
+                              rw_tendf, t_tendf,               &
+                              u, v, w, t, t_init,              &
+                              mut, muu, muv, ph, phb,          &
+                              u_base, v_base, t_base, z_base,  &
+                              dampcoef, zdamp,                 &
+                              ids, ide, jds, jde, kds, kde,    &
+                              ims, ime, jms, jme, kms, kme,    &
+                              its, ite, jts, jte, kts, kte   )
+
+  END IF forward_step
+
+END SUBROUTINE rk_tendency
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_addtend_dry ( ru_tend, rv_tend, rw_tend, ph_tend, t_tend,      &
+                            ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
+                            u_save, v_save, w_save, ph_save, t_save,         &
+                            mu_tend, mu_tendf, rk_step,                      &
+                            h_diabatic, mut, msftx, msfty, msfux, msfuy,     &
+                            msfvx, msfvx_inv, msfvy,                         &
+                            ids,ide, jds,jde, kds,kde,                       &
+                            ims,ime, jms,jme, kms,kme,                       &
+                            ips,ipe, jps,jpe, kps,kpe,                       &
+                            its,ite, jts,jte, kts,kte                       )
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            ips, ipe, jps, jpe, kps, kpe, &
+                                            its, ite, jts, jte, kts, kte
+   INTEGER ,               INTENT(IN   ) :: rk_step
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) :: ru_tend, &
+                                                                      rv_tend, &
+                                                                      rw_tend, &
+                                                                      ph_tend, &
+                                                                      t_tend,  &
+                                                                      ru_tendf, &
+                                                                      rv_tendf, &
+                                                                      rw_tendf, &
+                                                                      ph_tendf, &
+                                                                      t_tendf
+
+   REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(INOUT) :: mu_tend, &
+                                                             mu_tendf
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(IN   ) ::  u_save,  &
+                                                                       v_save,  &
+                                                                       w_save,  &
+                                                                      ph_save,  &
+                                                                       t_save,  &
+                                                                      h_diabatic
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: mut,       &
+                                                                    msftx,     &
+                                                                    msfty,     &
+                                                                    msfux,     &
+                                                                    msfuy,     &
+                                                                    msfvx,     &
+                                                                    msfvx_inv, &
+                                                                    msfvy
+
+
+! Local
+   INTEGER :: i, j, k
+
+!<DESCRIPTION>
+!
+! rk_addtend_dry constructs the full large-timestep tendency terms for
+! momentum (u,v,w), theta and geopotential equations.   This is accomplished
+! by combining the physics tendencies (in *tendf; these are computed 
+! the first RK substep, held fixed thereafter) with the RK tendencies 
+! (in *tend, these include advection, pressure gradient, etc; 
+! these change each rk substep).  Output is in *tend.
+!
+!</DESCRIPTION>
+
+!  Finally, add the forward-step tendency to the rk_tendency
+
+! u/v/w/save contain bc tendency that needs to be multiplied by msf
+! (u by msfuy, v by msfvx)
+!  before adding it to physics tendency (*tendf)
+! For momentum we need the final tendency to include an inverse msf
+! physics/bc tendency needs to be divided, advection tendency already has it
+
+! For scalars we need the final tendency to include an inverse msf (msfty)
+! advection tendency is OK, physics/bc tendency needs to be divided by msf
+
+   DO j = jts,MIN(jte,jde-1)
+   DO k = kts,kte-1
+   DO i = its,ite
+     ! multiply by my to uncouple u
+     IF(rk_step == 1)ru_tendf(i,k,j) = ru_tendf(i,k,j) +  u_save(i,k,j)*msfuy(i,j)
+     ! divide by my to couple u
+     ru_tend(i,k,j) = ru_tend(i,k,j) + ru_tendf(i,k,j)/msfuy(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = jts,jte
+   DO k = kts,kte-1
+   DO i = its,MIN(ite,ide-1)
+     ! multiply by mx to uncouple v
+     IF(rk_step == 1)rv_tendf(i,k,j) = rv_tendf(i,k,j) +  v_save(i,k,j)*msfvx(i,j)
+     ! divide by mx to couple v
+     rv_tend(i,k,j) = rv_tend(i,k,j) + rv_tendf(i,k,j)*msfvx_inv(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = jts,MIN(jte,jde-1)
+   DO k = kts,kte
+   DO i = its,MIN(ite,ide-1)
+     ! multiply by my to uncouple w
+     IF(rk_step == 1)rw_tendf(i,k,j) = rw_tendf(i,k,j) +  w_save(i,k,j)*msfty(i,j)
+     ! divide by my to couple w
+     rw_tend(i,k,j) = rw_tend(i,k,j) + rw_tendf(i,k,j)/msfty(i,j)
+     IF(rk_step == 1)ph_tendf(i,k,j) = ph_tendf(i,k,j) +  ph_save(i,k,j)
+     ! divide by my to couple scalar
+     ph_tend(i,k,j) = ph_tend(i,k,j) + ph_tendf(i,k,j)/msfty(i,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = jts,MIN(jte,jde-1)
+   DO k = kts,kte-1
+   DO i = its,MIN(ite,ide-1)
+     IF(rk_step == 1)t_tendf(i,k,j) = t_tendf(i,k,j) +  t_save(i,k,j)
+     ! divide by my to couple theta
+      t_tend(i,k,j) =  t_tend(i,k,j) +  t_tendf(i,k,j)/msfty(i,j)  &
+                                     +  mut(i,j)*h_diabatic(i,k,j)/msfty(i,j)
+     ! divide by my to couple heating
+   ENDDO
+   ENDDO
+   ENDDO
+
+   DO j = jts,MIN(jte,jde-1)
+   DO i = its,MIN(ite,ide-1)
+! mu tendencies not coupled with 1/msf
+      mu_tend(i,j) =  mu_tend(i,j) +  mu_tendf(i,j)
+   ENDDO
+   ENDDO
+
+END SUBROUTINE rk_addtend_dry
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_scalar_tend ( scs, sce, config_flags,          &
+                            rk_step, dt,                     &
+                            ru, rv, ww, mut, mub, mu_old,    &
+                            alt,                             &
+                            scalar_old, scalar,              &
+                            scalar_tends, advect_tend,       &
+                            RQVFTEN,                         &
+                            base, moist_step, fnm, fnp,      &
+                            msfux, msfuy, msfvx, msfvx_inv,  &
+                            msfvy, msftx, msfty,             &
+                            rdx, rdy, rdn, rdnw,             &
+                            khdif, kvdif, xkmhd,             &
+                            diff_6th_opt, diff_6th_factor,   &
+                            pd_advection,                    &
+                            ids, ide, jds, jde, kds, kde,    &
+                            ims, ime, jms, jme, kms, kme,    &
+                            its, ite, jts, jte, kts, kte    )
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,                INTENT(IN   ) :: rk_step, scs, sce
+   INTEGER ,                INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                             ims, ime, jms, jme, kms, kme, &
+                                             its, ite, jts, jte, kts, kte
+
+   LOGICAL , INTENT(IN   ) :: moist_step
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ),                &
+                                         INTENT(IN   )  :: scalar, scalar_old
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ),                      &
+                                         INTENT(INOUT)  :: scalar_tends
+                                                    
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(INOUT) :: advect_tend
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(OUT  ) :: RQVFTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(IN   ) ::     ru,  &
+                                                                      rv,  &
+                                                                      ww,  &
+                                                                      xkmhd,  &
+                                                                      alt
+
+
+   REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnm,  &
+                                                                  fnp,  &
+                                                                  rdn,  &
+                                                                  rdnw, &
+                                                                  base
+
+   REAL , DIMENSION( ims:ime , jms:jme ) ,       INTENT(IN   ) :: msfux,    &
+                                                                  msfuy,    &
+                                                                  msfvx,    &
+                                                                  msfvx_inv,    &
+                                                                  msfvy,    &
+                                                                  msftx,    &
+                                                                  msfty,    &
+                                                                  mub,     &
+                                                                  mut,     &
+                                                                  mu_old
+
+   REAL ,                                        INTENT(IN   ) :: rdx,     &
+                                                                  rdy,     &
+                                                                  khdif,   &
+                                                                  kvdif
+
+   INTEGER, INTENT( IN ) :: diff_6th_opt
+   REAL,    INTENT( IN ) :: diff_6th_factor
+
+   REAL ,                                        INTENT(IN   ) :: dt
+
+   LOGICAL, INTENT(IN   ) :: pd_advection
+
+   ! Local data
+  
+   INTEGER :: im, i,j,k
+   INTEGER :: time_step
+
+   REAL    :: khdq, kvdq, tendency
+
+!<DESCRIPTION>
+!
+! rk_scalar_tend calls routines that computes scalar tendency from advection 
+! and 3D mixing (TKE or fixed eddy viscosities).
+!
+!</DESCRIPTION>
+
+
+   khdq = khdif/prandtl
+   kvdq = kvdif/prandtl
+
+   scalar_loop : DO im = scs, sce
+
+     CALL zero_tend ( advect_tend(ims,kms,jms),     &
+                      ids, ide, jds, jde, kds, kde, &
+                      ims, ime, jms, jme, kms, kme, &
+                      its, ite, jts, jte, kts, kte )
+
+     CALL nl_get_time_step ( 1, time_step )
+
+      IF( (rk_step == 3) .and. pd_advection ) THEN
+
+       CALL advect_scalar_pd       ( scalar(ims,kms,jms,im),             &
+                                     scalar_old(ims,kms,jms,im),         &
+                                     advect_tend(ims,kms,jms),           &
+                                     ru, rv, ww, mut, mub, mu_old,       &
+                                     config_flags,                       &
+                                     msfux, msfuy, msfvx, msfvy,         &
+                                     msftx, msfty, fnm, fnp,             &
+                                     rdx, rdy, rdnw,dt,                  &
+                                     ids, ide, jds, jde, kds, kde,       &
+                                     ims, ime, jms, jme, kms, kme,       &
+                                     its, ite, jts, jte, kts, kte     )
+
+      ELSE
+
+       CALL advect_scalar     ( scalar(ims,kms,jms,im),        &
+                                scalar(ims,kms,jms,im),        &
+                                advect_tend(ims,kms,jms),      &
+                                ru, rv, ww, mut, time_step,    &
+                                config_flags,                  &
+                                msfux, msfuy, msfvx, msfvy,    &
+                                msftx, msfty, fnm, fnp,        &
+                                rdx, rdy, rdnw,                &
+                                ids, ide, jds, jde, kds, kde,  &
+                                ims, ime, jms, jme, kms, kme,  &
+                                its, ite, jts, jte, kts, kte  )
+      END IF
+
+     IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME) & 
+                     .and. moist_step .and. ( im == P_QV) ) THEN
+
+        CALL set_tend( RQVFTEN, advect_tend, msfty,    &
+                       ids, ide, jds, jde, kds, kde,   &
+                       ims, ime, jms, jme, kms, kme,   &
+                       its, ite, jts, jte, kts, kte      )
+     ENDIF
+
+     rk_step_1: IF( rk_step == 1 ) THEN
+
+       diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
+
+       CALL horizontal_diffusion ( 'm', scalar(ims,kms,jms,im),            &
+                                        scalar_tends(ims,kms,jms,im), mut, &
+                                        config_flags,                      &
+                                        msfux, msfuy, msfvx, msfvx_inv,    &
+                                        msfvy, msftx, msfty,               &
+                                        khdq , xkmhd, rdx, rdy,            &
+                                        ids, ide, jds, jde, kds, kde,      &
+                                        ims, ime, jms, jme, kms, kme,      &
+                                        its, ite, jts, jte, kts, kte      )
+
+!!!****MARS: done in the physics 
+       pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) &
+                       .AND. (.not. config_flags%modif_wrf) ) THEN
+!       pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN
+
+         IF( (moist_step) .and. ( im == P_QV)) THEN
+
+            CALL vertical_diffusion_mp ( scalar(ims,kms,jms,im),       &
+                                         scalar_tends(ims,kms,jms,im), &
+                                         config_flags, base,           &
+                                         alt, mut, rdn, rdnw, kvdq ,   &
+                                         ids, ide, jds, jde, kds, kde, &
+                                         ims, ime, jms, jme, kms, kme, &
+                                         its, ite, jts, jte, kts, kte )
+
+         ELSE 
+
+            CALL vertical_diffusion (  'm', scalar(ims,kms,jms,im),       &
+                                            scalar_tends(ims,kms,jms,im), &
+                                            config_flags,                 &
+                                            alt, mut, rdn, rdnw, kvdq,    &
+                                            ids, ide, jds, jde, kds, kde, &
+                                            ims, ime, jms, jme, kms, kme, &
+                                            its, ite, jts, jte, kts, kte )
+
+         END IF
+
+      ENDIF pbl_test
+
+    ENDIF diff_opt1
+
+    IF ( diff_6th_opt .NE. 0 )                                        &
+      CALL sixth_order_diffusion( 'm', scalar(ims,kms,jms,im),        &
+                                       scalar_tends(ims,kms,jms,im),  &
+                                       mut, dt, config_flags,         &
+                                       diff_6th_opt, diff_6th_factor, &
+                                       ids, ide, jds, jde, kds, kde,  &
+                                       ims, ime, jms, jme, kms, kme,  &
+                                       its, ite, jts, jte, kts, kte )
+
+  ENDIF rk_step_1
+
+ END DO scalar_loop
+
+END SUBROUTINE rk_scalar_tend
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_update_scalar( scs, sce,                      &
+                             scalar_1, scalar_2, sc_tend,   &
+                             advect_tend, msftx, msfty,     &
+                             mu_old, mu_new, mu_base,       &
+                             rk_step, dt, spec_zone,        &
+                             config_flags,                  &
+                             ids, ide, jds, jde, kds, kde,  &
+                             ims, ime, jms, jme, kms, kme,  &
+                             its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,                INTENT(IN   ) :: scs, sce, rk_step, spec_zone
+   INTEGER ,                INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                             ims, ime, jms, jme, kms, kme, &
+                                             its, ite, jts, jte, kts, kte
+
+   REAL,                    INTENT(IN   ) :: dt
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
+         INTENT(INOUT)                                  :: scalar_1,    &
+                                                           scalar_2,  &
+                                                           sc_tend
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme ),                &
+         INTENT(IN)                                  :: advect_tend
+
+   REAL, DIMENSION(ims:ime, jms:jme  ), INTENT(IN   ) ::  mu_old,  &
+                                                          mu_new,  &
+                                                          mu_base, &
+                                                          msftx,   &
+                                                          msfty
+
+   INTEGER :: i,j,k,im
+   REAL    :: sc_middle, msfsq
+   REAL, DIMENSION(its:ite) :: muold, r_munew
+
+   REAL, DIMENSION(its:ite, kts:kte, jts:jte  ) :: tendency
+
+   INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
+   INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
+
+!<DESCRIPTION>
+!
+!  rk_scalar_update advances the scalar equation given the time t value
+!  of the scalar and the scalar tendency.  
+!
+!</DESCRIPTION>
+
+
+!
+!  set loop limits.
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = jte
+      k_start = kts
+      k_end   = kte-1
+      IF(j_end == jde) j_end = j_end - 1
+      IF(i_end == ide) i_end = i_end - 1
+
+      i_start_spc = i_start
+      i_end_spc   = i_end
+      j_start_spc = j_start
+      j_end_spc   = j_end
+      k_start_spc = k_start
+      k_end_spc   = k_end
+
+    IF( config_flags%nested .or. config_flags%specified ) THEN
+      IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
+      IF( .NOT. config_flags%periodic_x)i_end   = min( ite,ide-spec_zone-1 )
+      j_start = max( jts,jds+spec_zone )
+      j_end   = min( jte,jde-spec_zone-1 )
+      k_start = kts
+      k_end   = min( kte, kde-1 )
+    ENDIF
+
+    IF ( rk_step == 1 ) THEN
+
+      !  replace t-dt values (in scalar_1) with t values scalar_2,
+      !  then compute new values by adding tendency to values at t
+
+      DO  im = scs,sce
+
+       DO  j = jts, min(jte,jde-1)
+       DO  k = kts, min(kte,kde-1)
+       DO  i = its, min(ite,ide-1)
+           tendency(i,k,j) = 0.
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start,j_end
+       DO  k = k_start,k_end
+       DO  i = i_start,i_end
+          ! scalar was coupled with my
+           tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j)
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start_spc,j_end_spc
+       DO  k = k_start_spc,k_end_spc
+       DO  i = i_start_spc,i_end_spc
+           tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
+       ENDDO
+       ENDDO
+       ENDDO
+   
+      DO  j = jts, min(jte,jde-1)
+
+      DO  i = its, min(ite,ide-1)
+        muold(i) = mu_old(i,j) + mu_base(i,j)
+        r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
+      ENDDO
+
+      DO  k = kts, min(kte,kde-1)
+      DO  i = its, min(ite,ide-1)
+
+        scalar_1(i,k,j,im) = scalar_2(i,k,j,im)
+        scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im)   &
+                             + dt*tendency(i,k,j))*r_munew(i)
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+      ENDDO
+
+    ELSE
+
+      !  just compute new values, scalar_1 already at time t.
+
+      DO  im = scs, sce
+
+       DO  j = jts, min(jte,jde-1)
+       DO  k = kts, min(kte,kde-1)
+       DO  i = its, min(ite,ide-1)
+           tendency(i,k,j) = 0.
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start,j_end
+       DO  k = k_start,k_end
+       DO  i = i_start,i_end
+           ! scalar was coupled with my
+           tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j)
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start_spc,j_end_spc
+       DO  k = k_start_spc,k_end_spc
+       DO  i = i_start_spc,i_end_spc
+           tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
+       ENDDO
+       ENDDO
+       ENDDO
+
+      DO  j = jts, min(jte,jde-1)
+
+      DO  i = its, min(ite,ide-1)
+        muold(i) = mu_old(i,j) + mu_base(i,j)
+        r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
+      ENDDO
+
+      DO  k = kts, min(kte,kde-1)
+      DO  i = its, min(ite,ide-1)
+
+        scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im)   &
+                             + dt*tendency(i,k,j))*r_munew(i)
+
+      ENDDO
+      ENDDO
+      ENDDO
+
+      ENDDO
+
+    END IF
+
+END SUBROUTINE rk_update_scalar
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE rk_update_scalar_pd( scs, sce,                      &
+                                scalar, sc_tend,               &
+                                mu_old, mu_new, mu_base,       &
+                                rk_step, dt, spec_zone,        &
+                                config_flags,                  &
+                                ids, ide, jds, jde, kds, kde,  &
+                                ims, ime, jms, jme, kms, kme,  &
+                                its, ite, jts, jte, kts, kte  )
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER ,                INTENT(IN   ) :: scs, sce, rk_step, spec_zone
+   INTEGER ,                INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                             ims, ime, jms, jme, kms, kme, &
+                                             its, ite, jts, jte, kts, kte
+
+   REAL,                    INTENT(IN   ) :: dt
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
+         INTENT(INOUT)                                  :: scalar,      &
+                                                           sc_tend
+
+   REAL, DIMENSION(ims:ime, jms:jme  ), INTENT(IN   ) ::  mu_old,  &
+                                                          mu_new,  &
+                                                          mu_base
+
+   INTEGER :: i,j,k,im
+   REAL    :: sc_middle, msfsq
+   REAL, DIMENSION(its:ite) :: muold, r_munew
+
+   REAL, DIMENSION(its:ite, kts:kte, jts:jte  ) :: tendency
+
+   INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
+   INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
+
+!<DESCRIPTION>
+!
+!  rk_scalar_update advances the scalar equation given the time t value
+!  of the scalar and the scalar tendency.  
+!
+!</DESCRIPTION>
+
+
+!
+!  set loop limits.
+
+      i_start = its
+      i_end   = ite
+      j_start = jts
+      j_end   = jte
+      k_start = kts
+      k_end   = kte-1
+      IF(j_end == jde) j_end = j_end - 1
+      IF(i_end == ide) i_end = i_end - 1
+
+      i_start_spc = i_start
+      i_end_spc   = i_end
+      j_start_spc = j_start
+      j_end_spc   = j_end
+      k_start_spc = k_start
+      k_end_spc   = k_end
+
+    IF( config_flags%nested .or. config_flags%specified ) THEN
+      IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
+      IF( .NOT. config_flags%periodic_x)i_end   = min( ite,ide-spec_zone-1 )
+      j_start = max( jts,jds+spec_zone )
+      j_end   = min( jte,jde-spec_zone-1 )
+      k_start = kts
+      k_end   = min( kte, kde-1 )
+    ENDIF
+
+      DO  im = scs, sce
+
+       DO  j = jts, min(jte,jde-1)
+       DO  k = kts, min(kte,kde-1)
+       DO  i = its, min(ite,ide-1)
+           tendency(i,k,j) = 0.
+       ENDDO
+       ENDDO
+       ENDDO
+   
+       DO  j = j_start_spc,j_end_spc
+       DO  k = k_start_spc,k_end_spc
+       DO  i = i_start_spc,i_end_spc
+           tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
+           sc_tend(i,k,j,im) = 0.
+       ENDDO
+       ENDDO
+       ENDDO
+
+      DO  j = jts, min(jte,jde-1)
+
+      DO  i = its, min(ite,ide-1)
+        muold(i) = mu_old(i,j) + mu_base(i,j)
+        r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
+      ENDDO
+
+      DO  k = kts, min(kte,kde-1)
+      DO  i = its, min(ite,ide-1)
+
+        scalar(i,k,j,im) = (muold(i)*scalar(i,k,j,im)   &
+                             + dt*tendency(i,k,j))*r_munew(i)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      ENDDO
+
+END SUBROUTINE rk_update_scalar_pd
+
+!------------------------------------------------------------
+
+SUBROUTINE init_zero_tendency(ru_tendf, rv_tendf, rw_tendf, ph_tendf,  &
+                              t_tendf,  tke_tendf, mu_tendf,           &
+                              moist_tendf,chem_tendf,scalar_tendf,     &
+                              n_moist,n_chem,n_scalar,rk_step,         &
+                              ids, ide, jds, jde, kds, kde,            &
+                              ims, ime, jms, jme, kms, kme,            &
+                              its, ite, jts, jte, kts, kte             )
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+
+   INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                                    ims, ime, jms, jme, kms, kme, &
+                                    its, ite, jts, jte, kts, kte
+
+   INTEGER ,       INTENT(IN   ) :: n_moist,n_chem,n_scalar,rk_step
+
+   REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) ::  &
+                                                             ru_tendf, &
+                                                             rv_tendf, &
+                                                             rw_tendf, &
+                                                             ph_tendf, &
+                                                              t_tendf, &
+                                                            tke_tendf
+
+   REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(INOUT) ::  mu_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),INTENT(INOUT)::&
+                                                          moist_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_chem ),INTENT(INOUT)::&
+                                                          chem_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar ),INTENT(INOUT)::&
+                                                          scalar_tendf
+
+! LOCAL VARS
+
+   INTEGER :: im, ic, is
+
+!<DESCRIPTION>
+!
+! init_zero_tendency 
+! sets tendency arrays to zero for all prognostic variables.
+!
+!</DESCRIPTION>
+
+
+   CALL zero_tend ( ru_tendf,                        &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( rv_tendf,                        &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( rw_tendf,                        &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( ph_tendf,                        &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( t_tendf,                         &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( tke_tendf,                       &
+                    ids, ide, jds, jde, kds, kde,    &
+                    ims, ime, jms, jme, kms, kme,    &
+                    its, ite, jts, jte, kts, kte     )
+
+   CALL zero_tend ( mu_tendf,                        &
+                    ids, ide, jds, jde, kds, kds,    &
+                    ims, ime, jms, jme, kms, kms,    &
+                    its, ite, jts, jte, kts, kts     )
+
+!   DO im=PARAM_FIRST_SCALAR,n_moist
+   DO im=1,n_moist                      ! make sure first one is zero too
+      CALL zero_tend ( moist_tendf(ims,kms,jms,im),  &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte  )
+   ENDDO
+
+!   DO ic=PARAM_FIRST_SCALAR,n_chem
+   DO ic=1,n_chem                       ! make sure first one is zero too
+      CALL zero_tend ( chem_tendf(ims,kms,jms,ic),   &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte  )
+   ENDDO
+
+!   DO ic=PARAM_FIRST_SCALAR,n_scalar
+   DO ic=1,n_scalar                       ! make sure first one is zero too
+      CALL zero_tend ( scalar_tendf(ims,kms,jms,ic),   &
+                       ids, ide, jds, jde, kds, kde, &
+                       ims, ime, jms, jme, kms, kme, &
+                       its, ite, jts, jte, kts, kte  )
+   ENDDO
+
+END SUBROUTINE init_zero_tendency
+
+!===================================================================
+
+
+SUBROUTINE dump_data( a, field, io_unit,            &
+                      ims, ime, jms, jme, kms, kme, &
+                      ids, ide, jds, jde, kds, kde )
+implicit none
+integer ::  ims, ime, jms, jme, kms, kme, &
+            ids, ide, jds, jde, kds, kde 
+real, dimension(ims:ime, kms:kme, jds:jde) :: a
+character :: field
+integer :: io_unit
+
+integer :: is,ie,js,je,ks,ke
+
+!<DESCRIPTION
+!
+! quick and dirty debug io utility
+!
+!</DESCRIPTION
+
+is = ids
+ie = ide-1
+js = jds
+je = jde-1
+ks = kds
+ke = kde-1
+
+if(field == 'u') ie = ide
+if(field == 'v') je = jde
+if(field == 'w') ke = kde
+
+write(io_unit) is,ie,ks,ke,js,je
+write(io_unit) a(is:ie, ks:ke, js:je)
+
+end subroutine dump_data
+
+!-----------------------------------------------------------------------
+
+SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d,           &
+                     RTHRATEN,                                         &
+                     RUBLTEN,RVBLTEN,RTHBLTEN,                         &
+                     RQVBLTEN,RQCBLTEN,RQIBLTEN,                       &
+                     RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,              &
+                     RQICUTEN,RQSCUTEN,                                &
+                     RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,        &
+                     RMUNDGDTEN,                                       &
+                     ids,ide, jds,jde, kds,kde,                        &
+                     ims,ime, jms,jme, kms,kme,                        &
+                     its,ite, jts,jte, kts,kte                         )
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      TYPE(grid_config_rec_type), INTENT(IN)     ::      config_flags
+
+      INTEGER,  INTENT(IN   )   ::          ids,ide, jds,jde, kds,kde, &
+                                            ims,ime, jms,jme, kms,kme, &
+                                            its,ite, jts,jte, kts,kte
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )               , &
+                INTENT(IN   )   ::                               pi3d
+                                                                 
+      REAL,     DIMENSION( ims:ime, jms:jme )                        , &
+                INTENT(IN   )   ::                                 mu, &
+                                                                  muu, &
+                                                                  muv
+      
+                                                           
+! radiation
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme ),                &
+                INTENT(INOUT)   ::                           RTHRATEN
+
+! cumulus
+
+      REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ),              &
+                INTENT(INOUT)   ::                                     &
+                                                             RTHCUTEN, &
+                                                             RQVCUTEN, &
+                                                             RQCCUTEN, &
+                                                             RQRCUTEN, &
+                                                             RQICUTEN, &
+                                                             RQSCUTEN
+! pbl
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )               , &
+                INTENT(INOUT)   ::                            RUBLTEN, &
+                                                              RVBLTEN, &
+                                                             RTHBLTEN, &
+                                                             RQVBLTEN, &
+                                                             RQCBLTEN, &
+                                                             RQIBLTEN
+
+! fdda
+
+      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )               , &
+                INTENT(INOUT)   ::                            RUNDGDTEN, &
+                                                              RVNDGDTEN, &
+                                                             RTHNDGDTEN, &
+                                                             RQVNDGDTEN
+      REAL,     DIMENSION( ims:ime, jms:jme )               , &
+                INTENT(INOUT)   ::                           RMUNDGDTEN
+
+      INTEGER :: i,k,j
+      INTEGER :: itf,ktf,jtf,itsu,jtsv
+
+!-----------------------------------------------------------------------
+
+!<DESCRIPTION>
+!
+!  calculate_phy_tend couples the physics tendencies to the column mass (mu),
+!  because prognostic equations are in flux form, but physics tendencies are
+!  computed for uncoupled variables.
+!
+!</DESCRIPTION>
+
+      itf=MIN(ite,ide-1)
+      jtf=MIN(jte,jde-1)
+      ktf=MIN(kte,kde-1)
+      itsu=MAX(its,ids+1)
+      jtsv=MAX(jts,jds+1)
+
+! radiation
+
+   IF (config_flags%ra_lw_physics .gt. 0 .or. config_flags%ra_sw_physics .gt. 0) THEN
+
+      DO J=jts,jtf
+      DO K=kts,ktf
+      DO I=its,itf
+         RTHRATEN(I,K,J)=mu(I,J)*RTHRATEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+   ENDIF
+
+! cumulus
+
+   IF (config_flags%cu_physics .gt. 0) THEN
+
+      DO J=jts,jtf
+      DO I=its,itf
+      DO K=kts,ktf
+         RTHCUTEN(I,K,J)=mu(I,J)*RTHCUTEN(I,K,J)
+         RQVCUTEN(I,K,J)=mu(I,J)*RQVCUTEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=jts,jtf
+         DO I=its,itf
+         DO K=kts,ktf
+            RQCCUTEN(I,K,J)=mu(I,J)*RQCCUTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=jts,jtf
+         DO I=its,itf
+         DO K=kts,ktf
+            RQRCUTEN(I,K,J)=mu(I,J)*RQRCUTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=jts,jtf
+         DO I=its,itf
+         DO K=kts,ktf
+            RQICUTEN(I,K,J)=mu(I,J)*RQICUTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
+         DO J=jts,jtf
+         DO I=its,itf
+         DO K=kts,ktf
+            RQSCUTEN(I,K,J)=mu(I,J)*RQSCUTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+   ENDIF
+
+! pbl
+
+!   IF (config_flags%bl_pbl_physics .gt. 0) THEN
+!!****MARS
+   IF ( (config_flags%bl_pbl_physics .gt. 0) .OR. (config_flags%modif_wrf) ) THEN
+
+      DO J=jts,jtf
+      DO K=kts,ktf
+      DO I=its,itf
+         RUBLTEN(I,K,J) =mu(I,J)*RUBLTEN(I,K,J)
+         RVBLTEN(I,K,J) =mu(I,J)*RVBLTEN(I,K,J)
+         RTHBLTEN(I,K,J)=mu(I,J)*RTHBLTEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=jts,jtf
+         DO K=kts,ktf
+         DO I=its,itf
+            RQVBLTEN(I,K,J)=mu(I,J)*RQVBLTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QC .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=jts,jtf
+         DO K=kts,ktf
+         DO I=its,itf
+           RQCBLTEN(I,K,J)=mu(I,J)*RQCBLTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=jts,jtf
+         DO K=kts,ktf
+         DO I=its,itf
+            RQIBLTEN(I,K,J)=mu(I,J)*RQIBLTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+    ENDIF
+
+! fdda
+! note fdda u and v tendencies are staggered, also only interior points have muu/muv,
+!   so only couple those
+
+   IF (config_flags%grid_fdda .gt. 0) THEN
+
+      DO J=jts,jtf
+      DO K=kts,ktf
+      DO I=itsu,itf
+!     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
+!     write(*,'(a,3i6,e15.5)') 'u_ten before=',i,k,j, RUNDGDTEN(i,k,j)
+         RUNDGDTEN(I,K,J) =muu(I,J)*RUNDGDTEN(I,K,J)
+!        if( i == itf/2 .AND. j == jtf/2 .AND. k==ktf/2 ) &
+!          write(*,'(a,2f15.5)') 'mu, muu=',mu(i,j), muu(i,j)
+!     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
+!     write(*,'(a,3i6,e15.5)') 'u_ten after=',i,k,j, RUNDGDTEN(i,k,j)
+!     if( RUNDGDTEN(i,k,j) > 30.0 ) write(*,*) 'IKJ=',i,k,j
+      ENDDO
+      ENDDO
+      ENDDO
+!     write(*,'(a,e15.5)') 'u_ten MAXIMUM after=', maxval(RUNDGDTEN)
+      DO J=jtsv,jtf
+      DO K=kts,ktf
+      DO I=its,itf
+         RVNDGDTEN(I,K,J) =muv(I,J)*RVNDGDTEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+      DO J=jts,jtf
+      DO K=kts,ktf
+      DO I=its,itf
+!     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
+!     write(*,'(a,3i6,e15.5)') 'th before=',i,k,j, RTHNDGDTEN(I,K,J)
+         RTHNDGDTEN(I,K,J)=mu(I,J)*RTHNDGDTEN(I,K,J)
+!        RMUNDGDTEN(I,J) - no coupling
+!     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
+!     write(*,'(a,3i6,e15.5)') 'th after=',i,k,j, RTHNDGDTEN(I,K,J)
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
+         DO J=jts,jtf
+         DO K=kts,ktf
+         DO I=its,itf
+            RQVNDGDTEN(I,K,J)=mu(I,J)*RQVNDGDTEN(I,K,J)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+    ENDIF
+
+END SUBROUTINE calculate_phy_tend
+
+!-----------------------------------------------------------------------
+
+SUBROUTINE positive_definite_filter ( a,                          &
+                                      ids,ide, jds,jde, kds,kde,  &
+                                      ims,ime, jms,jme, kms,kme,  &
+                                      its,ite, jts,jte, kts,kte  )
+
+  IMPLICIT NONE
+
+  INTEGER,  INTENT(IN   )   ::          ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme  ), INTENT(INOUT) :: a
+
+  INTEGER :: i,k,j
+
+!<DESCRIPTION>
+!
+! debug and testing code for bounding a variable
+!
+!</DESCRIPTION>
+
+  DO j=jts,min(jte,jde-1)
+  DO k=kts,kte-1
+  DO i=its,min(ite,ide-1)
+!    a(i,k,j) = max(a(i,k,j),0.)
+    a(i,k,j) = min(1000.,max(a(i,k,j),0.))
+  ENDDO
+  ENDDO
+  ENDDO
+
+  END SUBROUTINE positive_definite_filter
+
+!-----------------------------------------------------------------------
+
+SUBROUTINE bound_tke ( tke, tke_upper_bound,       &
+                       ids,ide, jds,jde, kds,kde,  &
+                       ims,ime, jms,jme, kms,kme,  &
+                       its,ite, jts,jte, kts,kte  )
+
+  IMPLICIT NONE
+
+  INTEGER,  INTENT(IN   )   ::          ids,ide, jds,jde, kds,kde, &
+                                        ims,ime, jms,jme, kms,kme, &
+                                        its,ite, jts,jte, kts,kte
+
+  REAL, DIMENSION( ims:ime , kms:kme , jms:jme  ), INTENT(INOUT) :: tke
+  REAL, INTENT(   IN) :: tke_upper_bound
+
+  INTEGER :: i,k,j
+
+!<DESCRIPTION>
+!
+! bounds tke between zero and tke_upper_bound.
+!
+!</DESCRIPTION>
+
+  DO j=jts,min(jte,jde-1)
+  DO k=kts,kte-1
+  DO i=its,min(ite,ide-1)
+    tke(i,k,j) = min(tke_upper_bound,max(tke(i,k,j),0.))
+  ENDDO
+  ENDDO
+  ENDDO
+
+  END SUBROUTINE bound_tke
+
+
+
+END MODULE module_em
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part1.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part1.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part1.F	(revision 2744)
@@ -0,0 +1,701 @@
+!WRF:MEDIATION_LAYER:SOLVER
+
+#define BENCH_START(A)
+#define BENCH_END(A)
+
+MODULE module_first_rk_step_part1
+
+CONTAINS
+
+  SUBROUTINE first_rk_step_part1 (   grid , config_flags              &
+                             , moist , moist_tend               &
+                             , chem  , chem_tend                &
+                             , scalar , scalar_tend             &
+                             , fdda3d, fdda2d                   &
+                             , ru_tendf, rv_tendf               &
+                             , rw_tendf, t_tendf                &
+                             , ph_tendf, mu_tendf               &
+                             , tke_tend                         &
+                             , adapt_step_flag , curr_secs      &
+                             , psim , psih , wspd , gz1oz0 , br , chklowq &
+                             , cu_act_flag , hol , th_phy        &
+                             , pi_phy , p_phy , t_phy , u_phy , v_phy     &
+                             , dz8w , p8w , t8w , rho_phy , rho           &
+                             , z_at_w , mu_3d                   &
+                             , ids, ide, jds, jde, kds, kde     &
+                             , ims, ime, jms, jme, kms, kme     &
+                             , ips, ipe, jps, jpe, kps, kpe     &
+                             , k_start , k_end                  &
+                            )
+    USE module_state_description
+    USE module_model_constants
+    USE module_domain, ONLY : domain
+    USE module_configure, ONLY : grid_config_rec_type, model_config_rec
+!!!!****MARS MARS
+!!!!****MARS MARS
+!    USE module_radiation_driver, ONLY : pre_radiation_driver, radiation_driver
+!    USE module_surface_driver, ONLY : surface_driver
+!    USE module_cumulus_driver, ONLY : cumulus_driver
+!    USE module_pbl_driver, ONLY : pbl_driver
+!    USE module_fddagd_driver, ONLY : fddagd_driver
+    USE module_em, ONLY : init_zero_tendency
+!!MARS
+    USE module_lmd_driver
+!!MARS
+    USE module_big_step_utilities_em, ONLY : phy_prep
+    USE module_dm
+    IMPLICIT NONE
+
+    TYPE ( domain ), INTENT(INOUT) :: grid
+    TYPE ( grid_config_rec_type ), INTENT(IN) :: config_flags
+
+    INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           ips, ipe, jps, jpe, kps, kpe
+
+    LOGICAL ,INTENT(IN)                        :: adapt_step_flag
+    REAL, INTENT(IN)                           :: curr_secs
+
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: moist
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: moist_tend
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: chem
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: chem_tend
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: scalar
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: scalar_tend
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_fdda3d),INTENT(INOUT)  :: fdda3d
+    REAL    ,DIMENSION(ims:ime,1:1,jms:jme,num_fdda2d),INTENT(INOUT)      :: fdda2d
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: psim
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: psih
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: wspd
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: gz1oz0
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: br
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: chklowq
+    LOGICAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: cu_act_flag
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: hol
+
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: th_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: pi_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: u_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: v_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme) :: w_phy  !!MARS aymeric var loc
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: dz8w
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p8w
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t8w
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: z_at_w
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: mu_3d
+
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ru_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rv_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rw_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ph_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: tke_tend
+
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: mu_tendf
+
+    INTEGER , INTENT(IN)                          ::  k_start, k_end
+
+! Local
+
+    REAL, DIMENSION( ims:ime, jms:jme ) :: ht_loc
+    INTEGER, DIMENSION( ims:ime, jms:jme ) :: shadowmask 
+    INTEGER                             :: ij
+    INTEGER  num_roof_layers
+    INTEGER  num_wall_layers
+    INTEGER  num_road_layers
+    INTEGER  iswater
+    INTEGER  rk_step 
+
+ ! initialize all tendencies to zero in order to update physics
+ ! tendencies first (separate from dry dynamics).
+
+    rk_step = 1
+
+BENCH_START(init_zero_tend_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+
+       DO ij = 1 , grid%num_tiles
+
+         CALL wrf_debug ( 200 , ' call init_zero_tendency' )
+         CALL init_zero_tendency ( ru_tendf, rv_tendf, rw_tendf,     &
+                                   ph_tendf, t_tendf, tke_tend,      &
+                                   mu_tendf,                         &
+                                   moist_tend,chem_tend,scalar_tend, &
+                                   num_moist,num_chem,num_scalar,       &
+                                   rk_step,                          &
+                                   ids, ide, jds, jde, kds, kde,     &
+                                   ims, ime, jms, jme, kms, kme,     &
+                                   grid%i_start(ij), grid%i_end(ij), &
+                                   grid%j_start(ij), grid%j_end(ij), &
+                                   k_start, k_end                   )
+
+       END DO
+       !$OMP END PARALLEL DO
+BENCH_END(init_zero_tend_tim)
+
+#ifdef DM_PARALLEL
+#     include "HALO_EM_PHYS_A.inc"
+#endif
+
+      !$OMP PARALLEL DO   &
+      !$OMP PRIVATE ( ij )
+      DO ij = 1 , grid%num_tiles
+
+        CALL wrf_debug ( 200 , ' call phy_prep' )
+        CALL phy_prep ( config_flags,                           &
+                        grid%mut, grid%muu, grid%muv, grid%u_2, &
+                        grid%v_2, grid%w_2, grid%p, grid%pb, grid%alt,              &
+                        grid%ph_2, grid%phb, grid%t_2, grid%tsk, moist, num_moist,   &
+                        mu_3d, rho,                             &
+                        th_phy, p_phy, pi_phy, u_phy, v_phy, w_phy,   &
+                        p8w, t_phy, t8w, grid%z, z_at_w,             &
+                        dz8w, grid%fnm, grid%fnp,                         &    
+                        grid%rthraten,                               &
+                        grid%rthblten, grid%rublten, grid%rvblten,             &
+                        grid%rqvblten, grid%rqcblten, grid%rqiblten,           &
+                        grid%rthcuten, grid%rqvcuten, grid%rqccuten,           &
+                        grid%rqrcuten, grid%rqicuten, grid%rqscuten,           &
+                        grid%rthften,  grid%rqvften,                      &
+                        grid%RUNDGDTEN, grid%RVNDGDTEN, grid%RTHNDGDTEN,       &
+                        grid%RQVNDGDTEN, grid%RMUNDGDTEN,                 &
+                        ids, ide, jds, jde, kds, kde,           &
+                        ims, ime, jms, jme, kms, kme,           &
+                        grid%i_start(ij), grid%i_end(ij),       &
+                        grid%j_start(ij), grid%j_end(ij),       &
+                        k_start, k_end                         )
+      ENDDO
+      !$OMP END PARALLEL DO
+
+BENCH_END(phy_prep_tim)
+
+!!!!****MARS MARS
+!!!!****MARS MARS
+
+!! radiation
+!
+!! this driver is only needed to handle non-local shadowing effects
+!      CALL pre_radiation_driver ( grid, config_flags                        & 
+!     &        ,itimestep=grid%itimestep, ra_call_offset=grid%ra_call_offset    & 
+!     &        ,XLAT=grid%xlat, XLONG=grid%xlong, GMT=grid%gmt                  &
+!     &        ,julian=grid%julian, xtime=grid%xtime, RADT=grid%radt            &
+!     &        ,STEPRA=grid%stepra                                              & 
+!     &        ,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa  &
+!     &        ,shadowmask=shadowmask,slope_rad=config_flags%slope_rad          &
+!     &        ,topo_shading=config_flags%topo_shading                          & 
+!     &        ,shadlen=config_flags%shadlen,ht_shad=grid%ht_shad,ht_loc=ht_loc & 
+!     &        ,ht_shad_bxs=grid%ht_shad_bxs, ht_shad_bxe=grid%ht_shad_bxe      &
+!     &        ,ht_shad_bys=grid%ht_shad_bys, ht_shad_bye=grid%ht_shad_bye      &
+!     &        ,nested=config_flags%nested, min_ptchsz=grid%min_ptchsz          & 
+!     &        ,spec_bdy_width=config_flags%spec_bdy_width                      &
+!            ! indexes
+!     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+!     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+!     &        ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe          &
+!     &        ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1)          &
+!     &        ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1)          &
+!     &        ,kts=k_start, kte=min(k_end,kde-1)                          &
+!     &        ,num_tiles=grid%num_tiles                                   )
+!
+!      CALL wrf_debug ( 200 , ' call radiation_driver' )
+!BENCH_START(rad_driver_tim)
+!
+!      CALL radiation_driver(                                                  &
+!     &         ACFRCV=grid%acfrcv      ,ACFRST=grid%acfrst      ,ALBEDO=grid%albedo  &
+!     &        ,CFRACH=grid%cfrach      ,CFRACL=grid%cfracl      ,CFRACM=grid%cfracm  &
+!     &        ,CUPPT=grid%cuppt        ,CZMEAN=grid%czmean      ,DT=grid%dt          &
+!     &        ,DZ8W=dz8w               ,EMISS=grid%emiss        ,GLW=grid%glw        &
+!     &        ,GMT=grid%gmt            ,GSW=grid%gsw            ,HBOT=grid%hbot      &
+!     &        ,HTOP=grid%htop          ,HBOTR=grid%hbotr        ,HTOPR=grid%htopr    &
+!     &        ,ICLOUD=config_flags%icloud                                            &
+!     &        ,ITIMESTEP=grid%itimestep,JULDAY=grid%julday      , JULIAN=grid%julian &
+!     &        ,JULYR=grid%julyr        ,LW_PHYSICS=config_flags%ra_lw_physics        &
+!     &        ,NCFRCV=grid%ncfrcv      ,NCFRST=grid%ncfrst      ,NPHS=1              &
+!     &        ,P8W=p8w                 ,P=p_phy                 ,PI=pi_phy           &
+!     &        ,RADT=grid%radt          ,RA_CALL_OFFSET=grid%ra_call_offset           &
+!     &        ,RHO=rho                 ,RLWTOA=grid%rlwtoa                           &
+!     &        ,RSWTOA=grid%rswtoa      ,RTHRATEN=grid%rthraten                       &
+!     &        ,RTHRATENLW=grid%rthratenlw       ,RTHRATENSW=grid%rthratensw          &
+!     &        ,SNOW=grid%snow          ,STEPRA=grid%stepra      ,SWDOWN=grid%swdown  &
+!     &        ,SWDOWNC=grid%swdownc    ,SW_PHYSICS=config_flags%ra_sw_physics        &
+!     &        ,T8W=t8w                 ,T=t_phy                 ,TAUCLDC=grid%taucldc &
+!     &        ,TAUCLDI=grid%taucldi    ,TSK=grid%tsk            ,VEGFRA=grid%vegfra  &
+!     &        ,WARM_RAIN=grid%warm_rain ,XICE=grid%xice         ,XLAND=grid%xland    &
+!     &        ,XLAT=grid%xlat          ,XLONG=grid%xlong        &
+!!Optional urban
+!     &        ,DECLIN_URB=grid%declin_urb        ,COSZ_URB2D=grid%cosz_urb2d   &
+!     &        ,OMG_URB2D=grid%omg_urb2d                                        &
+!!
+!     &        ,Z=grid%z                                                   &
+!     &        ,LEVSIZ=grid%levsiz, N_OZMIXM=num_ozmixm                    &
+!     &        ,N_AEROSOLC=num_aerosolc                                    &
+!     &        ,PAERLEV=grid%paerlev                                       &
+!     &        ,CAM_ABS_DIM1=grid%cam_abs_dim1, CAM_ABS_DIM2=grid%cam_abs_dim2 &
+!     &        ,CAM_ABS_FREQ_S=grid%cam_abs_freq_s                         &
+!     &        ,XTIME=grid%xtime                                                &
+!              ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag       &
+!            ! indexes
+!     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+!     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+!     &        ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1)          &
+!     &        ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1)          &
+!     &        ,kts=k_start, kte=min(k_end,kde-1)                          &
+!     &        ,num_tiles=grid%num_tiles                                   &
+!            ! Optional                          
+!     &        , CLDFRA=grid%cldfra                                        &
+!     &        , PB=grid%pb                                                     &
+!     &        , F_ICE_PHY=grid%f_ice_phy,F_RAIN_PHY=grid%f_rain_phy                 &
+!     &        , QV=moist(ims,kms,jms,P_QV), F_QV=F_QV                     &
+!     &        , QC=moist(ims,kms,jms,P_QC), F_QC=F_QC                     &
+!     &        , QR=moist(ims,kms,jms,P_QR), F_QR=F_QR                     &
+!     &        , QI=moist(ims,kms,jms,P_QI), F_QI=F_QI                     &
+!     &        , QS=moist(ims,kms,jms,P_QS), F_QS=F_QS                     &
+!     &        , QG=moist(ims,kms,jms,P_QG), F_QG=F_QG                     &
+!     &        , QNDROP=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP    &
+!#ifdef ACFLUX
+!     &        ,ACSWUPT=acswupt    ,ACSWUPTC=acswuptc                      &
+!     &        ,ACSWDNT=acswdnt    ,ACSWDNTC=acswdntc                      &
+!     &        ,ACSWUPB=acswupb    ,ACSWUPBC=acswupbc                      &
+!     &        ,ACSWDNB=acswdnb    ,ACSWDNBC=acswdnbc                      &
+!     &        ,ACLWUPT=aclwupt    ,ACLWUPTC=aclwuptc                      &
+!     &        ,ACLWDNT=aclwdnt    ,ACLWDNTC=aclwdntc                      &
+!     &        ,ACLWUPB=aclwupb    ,ACLWUPBC=aclwupbc                      &
+!     &        ,ACLWDNB=aclwdnb    ,ACLWDNBC=aclwdnbc                      &
+!     &        ,SWUPT=swupt    ,SWUPTC=swuptc                              &
+!     &        ,SWDNT=swdnt    ,SWDNTC=swdntc                              &
+!     &        ,SWUPB=swupb    ,SWUPBC=swupbc                              &
+!     &        ,SWDNB=swdnb    ,SWDNBC=swdnbc                              &
+!     &        ,LWUPT=lwupt    ,LWUPTC=lwuptc                              &
+!     &        ,LWDNT=lwdnt    ,LWDNTC=lwdntc                              &
+!     &        ,LWUPB=lwupb    ,LWUPBC=lwupbc                              &
+!     &        ,LWDNB=lwdnb    ,LWDNBC=lwdnbc                              &
+!#endif
+!     &        ,LWCF=grid%lwcf                                                  &
+!     &        ,SWCF=grid%swcf                                                  &
+!     &        ,OLR=grid%olr                                                    &
+!     &        ,OZMIXM=grid%ozmixm, PIN=grid%pin                                     &
+!     &        ,M_PS_1=grid%m_ps_1, M_PS_2=grid%m_ps_2, AEROSOLC_1=grid%aerosolc_1        &
+!     &        ,AEROSOLC_2=grid%aerosolc_2, M_HYBI0=grid%m_hybi                      &
+!     &        ,ABSTOT=grid%abstot, ABSNXT=grid%absnxt, EMSTOT=grid%emstot                &
+!#ifdef WRF_CHEM
+!     &        ,CU_RAD_FEEDBACK=config_flags%cu_rad_feedback                &
+!     &        ,AER_RA_FEEDBACK=config_flags%aer_ra_feedback                &
+!     &        ,QC_ADJUST=grid%GD_CLOUD_B , QI_ADJUST=grid%GD_CLOUD2_B         &
+!     &        ,PM2_5_DRY=grid%pm2_5_dry, PM2_5_WATER=grid%pm2_5_water               &
+!     &        ,PM2_5_DRY_EC=grid%pm2_5_dry_ec                                  &
+!     &        ,TAUAER300=grid%tauaer1, TAUAER400=grid%tauaer2 & ! jcb
+!     &        ,TAUAER600=grid%tauaer3, TAUAER999=grid%tauaer4 & ! jcb
+!     &        ,GAER300=grid%gaer1, GAER400=grid%gaer2, GAER600=grid%gaer3, GAER999=grid%gaer4 & ! jcb
+!     &        ,WAER300=grid%waer1, WAER400=grid%waer2, WAER600=grid%waer3, WAER999=grid%waer4 & ! jcb
+!#endif
+!     &         ,slope_rad=config_flags%slope_rad,topo_shading=config_flags%topo_shading     &
+!     &         ,shadowmask=shadowmask,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa    )
+!
+!BENCH_END(rad_driver_tim)
+!
+!!********* Surface driver
+!! surface
+!
+!BENCH_START(surf_driver_tim)
+!
+!!-----------------------------------------------------------------
+!! urban related variable are added to arguments of surface_driver
+!!-----------------------------------------------------------------
+!      num_roof_layers = grid%num_soil_layers !urban
+!      num_wall_layers = grid%num_soil_layers !urban
+!      num_road_layers = grid%num_soil_layers !urban
+!      CALL nl_get_iswater(grid%id, iswater)
+!
+!      CALL wrf_debug ( 200 , ' call surface_driver' )
+!
+!      CALL surface_driver(                                                &
+!     &         ACSNOM=grid%acsnom      ,ACSNOW=grid%acsnow      ,AKHS=grid%akhs          &
+!     &        ,AKMS=grid%akms          ,ALBBCK=grid%albbck      ,ALBEDO=grid%albedo      &
+!     &        ,EMBCK=grid%embck                                                          &
+!     &        ,BR=br              ,CANWAT=grid%canwat      ,CHKLOWQ=chklowq    &
+!     &        ,CT=grid%ct              ,DT=grid%dt         ,DX=grid%dx         &
+!     &        ,DZ8W=dz8w          ,DZS=grid%dzs            ,FLHC=grid%flhc          &
+!     &        ,FLQC=grid%flqc          ,GLW=grid%glw            ,GRDFLX=grid%grdflx      &
+!     &        ,GSW=grid%gsw    ,SWDOWN=grid%swdown        ,GZ1OZ0=gz1oz0      ,HFX=grid%hfx              &
+!     &        ,HT=grid%ht              ,IFSNOW=config_flags%ifsnow      ,ISFFLX=config_flags%isfflx      &
+!     &        ,ISLTYP=grid%isltyp      ,ITIMESTEP=grid%itimestep                    &
+!     &        ,IVGTYP=grid%ivgtyp      ,LH=grid%lh              ,LOWLYR=grid%lowlyr      &
+!     &        ,MAVAIL=grid%mavail      ,NUM_SOIL_LAYERS=config_flags%num_soil_layers        &
+!     &        ,P8W=p8w            ,PBLH=grid%pblh          ,PI_PHY=pi_phy      &
+!     &        ,PSFC=grid%psfc          ,PSHLTR=grid%pshltr      ,PSIH=psih          &
+!     &        ,BLDT=grid%bldt     ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag  &
+!     &        ,PSIM=psim          ,P_PHY=p_phy        ,Q10=grid%q10            &
+!     &        ,Q2=grid%q2              ,QFX=grid%qfx            ,QSFC=grid%qsfc          &
+!     &        ,QSHLTR=grid%qshltr      ,QZ0=grid%qz0            ,RAINCV=grid%raincv      &
+!     &        ,RA_LW_PHYSICS=config_flags%ra_lw_physics            ,RHO=rho            &
+!     &        ,RMOL=grid%rmol          ,SFCEVP=grid%sfcevp      ,SFCEXC=grid%sfcexc      &
+!     &        ,SFCRUNOFF=grid%sfcrunoff                                        &
+!     &        ,SF_SFCLAY_PHYSICS=config_flags%sf_sfclay_physics                        &
+!     &        ,SF_SURFACE_PHYSICS=config_flags%sf_surface_physics  ,SH2O=grid%sh2o          &
+!     &        ,SHDMAX=grid%shdmax      ,SHDMIN=grid%shdmin      ,SMOIS=grid%smois        &
+!     &        ,SMSTAV=grid%smstav      ,SMSTOT=grid%smstot      ,SNOALB=grid%snoalb      &
+!     &        ,SNOW=grid%snow          ,SNOWC=grid%snowc        ,SNOWH=grid%snowh        &
+!     &        ,SST=grid%sst            ,SST_UPDATE=grid%sst_update                  &
+!     &        ,STEPBL=grid%stepbl      ,TH10=grid%th10          ,TH2=grid%th2            &
+!     &        ,THZ0=grid%thz0          ,TH_PHY=th_phy      ,TKE_MYJ=grid%tke_myj    &
+!     &        ,TMN=grid%tmn            ,TSHLTR=grid%tshltr      ,TSK=grid%tsk            &
+!     &        ,TSLB=grid%tslb          ,T_PHY=t_phy        ,U10=grid%u10            &
+!     &        ,URATX=grid%uratx        ,VRATX=grid%vratx   ,TRATX=grid%tratx        &
+!     &        ,UDRUNOFF=grid%udrunoff  ,UST=grid%ust       ,UZ0=grid%uz0            &
+!     &        ,U_FRAME=grid%u_frame    ,U_PHY=u_phy        ,V10=grid%v10            &
+!     &        ,VEGFRA=grid%vegfra      ,VZ0=grid%vz0       ,V_FRAME=grid%v_frame    &
+!     &        ,V_PHY=v_phy             ,WARM_RAIN=grid%warm_rain                    &
+!     &        ,WSPD=wspd               ,XICE=grid%xice     ,XLAND=grid%xland        &
+!     &        ,Z0=grid%z0              ,Z=grid%z        ,ZNT=grid%znt            &
+!     &        ,ZS=grid%zs              ,XICEM=grid%xicem   ,ISICE=grid%landuse_isice&
+!     &        ,USTM=grid%ustm          ,CK=grid%ck         ,CKA=grid%cka            &
+!     &                                 ,CD=grid%cd         ,CDA=grid%cda            &
+!     &        ,ISFTCFLX=config_flags%isftcflx                                       &
+!     &        ,OMLCALL=config_flags%omlcall ,OML_HML0=config_flags%oml_hml0 ,OML_GAMMA=config_flags%oml_gamma &
+!     &        ,TML=grid%tml, T0ML=grid%t0ml, HML=grid%hml, H0ML=grid%h0ml, HUML=grid%huml, HVML=grid%hvml, F=grid%f &
+!     &        ,ISWATER=iswater &
+!     &        ,DECLIN_URB=grid%declin_urb  ,COSZ_URB2D=grid%cosz_urb2d    & !I urban
+!     &        ,OMG_URB2D=grid%omg_urb2d    ,xlat_urb2d=grid%XLAT          & !I urban
+!     &        ,NUM_ROOF_LAYERS=num_roof_layers                            & !I urban
+!     &        ,NUM_WALL_LAYERS=num_wall_layers                            & !I urban
+!     &        ,NUM_ROAD_LAYERS=num_road_layers                            &
+!     &        ,DZR=grid%dzr ,DZB=grid%dzb ,DZG=grid%dzg                   & !I urban
+!     &        ,TR_URB2D=grid%tr_urb2d ,TB_URB2D=grid%tb_urb2d             &
+!     &        ,TG_URB2D=grid%tg_urb2d                                     & !H urban
+!     &        ,TC_URB2D=grid%tc_urb2d ,QC_URB2D=grid%qc_urb2d             & !H urban
+!     &        ,UC_URB2D=grid%uc_urb2d                                     & !H urban
+!     &        ,XXXR_URB2D=grid%xxxr_urb2d                                 &
+!     &        ,XXXB_URB2D=grid%xxxb_urb2d                                 & !H urban
+!     &        ,XXXG_URB2D=grid%xxxg_urb2d                                 &
+!     &        ,XXXC_URB2D=grid%xxxc_urb2d                                 & !H urban
+!     &        ,TRL_URB3D=grid%trl_urb3d   ,TBL_URB3D=grid%tbl_urb3d       & !H urban
+!     &        ,TGL_URB3D=grid%tgl_urb3d                                   & !H urban
+!     &        ,SH_URB2D=grid%sh_urb2d     ,LH_URB2D=grid%lh_urb2d         &
+!     &        ,G_URB2D=grid%g_urb2d                                       & !H urban
+!     &        ,RN_URB2D=grid%rn_urb2d     , TS_URB2D=grid%ts_urb2d        & !H urban 
+!     &        ,FRC_URB2D=grid%frc_urb2d                                   & !H urban
+!     &        ,UTYPE_URB2D=grid%utype_urb2d                               & !H urban
+!     &        ,ucmcall=grid%ucmcall                                       & !H urban
+!           ! P-X LSM Variables
+!     &        ,LANDUSEF=grid%landusef, SOILCTOP=grid%soilctop             &   ! P-X LSM
+!     &        ,SOILCBOT=grid%soilcbot                                     &   ! P-X LSM
+!     &        ,RA=grid%ra, RS=grid%rs, LAI=grid%lai                       &   ! P-X LSM
+!     &        ,NLCAT=grid%num_land_cat,  NSCAT=grid%num_soil_cat          &   ! P-X LSM
+!     &        ,VEGF_PX=grid%vegf_px, SNOWNCV=grid%snowncv                 &   ! P-X LSM
+!     &        ,ANAL_INTERVAL=config_flags%interval_seconds                &   ! P-X LSM
+!     &        ,PXLSM_SMOIS_INIT=config_flags%pxlsm_smois_init             &   ! P-X LSM
+!     &        ,PXLSM_SOIL_NUDGE=config_flags%grid_fdda                    &   ! P-X LSM
+!           ! Optional PX LSM nudging
+!     &        ,t2_ndg_old=fdda2d(ims,1,jms,P_t2_ndg_old)                  &
+!     &        ,q2_ndg_old=fdda2d(ims,1,jms,P_q2_ndg_old)                  &
+!     &        ,t2_ndg_new=fdda2d(ims,1,jms,P_t2_ndg_new)                  &
+!     &        ,q2_ndg_new=fdda2d(ims,1,jms,P_q2_ndg_new)                  &
+!     &        ,sn_ndg_old=fdda2d(ims,1,jms,P_sn_ndg_old)                  &
+!     &        ,sn_ndg_new=fdda2d(ims,1,jms,P_sn_ndg_new)                  &
+!           ! Indexes
+!     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+!     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+!     &        , I_START=grid%i_start,I_END=min(grid%i_end, ide-1)         &
+!     &        , J_START=grid%j_start,J_END=min(grid%j_end, jde-1)         &
+!     &        , KTS=k_start, KTE=min(k_end,kde-1)                         &
+!     &        , NUM_TILES=grid%num_tiles                                  &
+!           ! Optional
+!     &        ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV                 &
+!     &        ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC                 &
+!     &        ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR                 &
+!     &        ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI                 &
+!     &        ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS                 &
+!     &        ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG                 &
+!     &        ,CAPG=grid%capg, EMISS=grid%emiss, HOL=hol,MOL=grid%mol                    &
+!     &        ,T2OBS=grid%t2obs, Q2OBS=grid%q2obs                         &
+!     &        ,RAINBL=grid%rainbl,SR=grid%sr                                              &
+!     &        ,RAINNCV=grid%rainncv,REGIME=grid%regime,T2=grid%t2,THC=grid%thc                &
+!     &        ,QSG=grid%qsg,QVG=grid%qvg,QCG=grid%qcg,SOILT1=grid%soilt1,TSNAV=grid%tsnav          & ! ruc lsm
+!     &        ,SMFR3D=grid%smfr3d,KEEPFR3DFLAG=grid%keepfr3dflag                    & ! ruc lsm
+!     &        ,POTEVP=grid%POTEVP, SNOPCX=grid%SNOPCX, SOILTB=grid%SOILTB                & ! ruc lsm
+!     &                                                              )
+!BENCH_END(surf_driver_tim)
+!
+!!*********
+!! pbl
+!
+!      CALL wrf_debug ( 200 , ' call pbl_driver' )
+!BENCH_START(pbl_driver_tim)
+!      CALL pbl_driver(                                                    &
+!     &         AKHS=grid%akhs          ,AKMS=grid%akms                              &
+!     &        ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics                 &
+!     &        ,BLDT=grid%bldt, CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag &
+!     &        ,BR=br              ,CHKLOWQ=chklowq    ,CT=grid%ct         &
+!     &        ,DT=grid%dt              ,DX=grid%dx              ,DZ8W=dz8w          &
+!     &        ,EL_MYJ=grid%el_myj      ,EXCH_H=grid%exch_h      ,GRDFLX=grid%grdflx      &
+!     &        ,GZ1OZ0=gz1oz0      ,HFX=grid%hfx            ,HT=grid%ht              &
+!     &        ,ITIMESTEP=grid%itimestep                    ,KPBL=grid%kpbl          &
+!     &        ,LH=grid%lh              ,LOWLYR=grid%lowlyr      ,P8W=p8w            &
+!     &        ,PBLH=grid%pblh          ,PI_PHY=pi_phy      ,PSIH=psih          &
+!     &        ,PSIM=psim          ,P_PHY=p_phy        ,QFX=grid%qfx            &
+!     &        ,QSFC=grid%qsfc          ,QZ0=grid%qz0                                &
+!     &        ,RA_LW_PHYSICS=config_flags%ra_lw_physics                   &
+!     &        ,RHO=rho            ,RQCBLTEN=grid%rqcblten  ,RQIBLTEN=grid%rqiblten  &
+!     &        ,RQVBLTEN=grid%rqvblten  ,RTHBLTEN=grid%rthblten  ,RUBLTEN=grid%rublten    &
+!     &        ,RVBLTEN=grid%rvblten    ,SNOW=grid%snow          ,STEPBL=grid%stepbl      &
+!     &        ,THZ0=grid%thz0          ,TH_PHY=th_phy      ,TKE_MYJ=grid%tke_myj    &
+!     &        ,TSK=grid%tsk            ,T_PHY=t_phy        ,UST=grid%ust            &
+!     &        ,U10=grid%u10 ,UZ0=grid%uz0      ,U_FRAME=grid%u_frame    ,U_PHY=u_phy        &
+!     &        ,V10=grid%v10 ,VZ0=grid%vz0      ,V_FRAME=grid%v_frame    ,V_PHY=v_phy        &
+!     &        ,WARM_RAIN=grid%warm_rain                    ,WSPD=wspd          &
+!     &        ,XICE=grid%xice          ,XLAND=grid%xland        ,Z=grid%z                &
+!     &        ,ZNT=grid%znt                                                    &
+!     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+!     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+!     &        ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)          &
+!     &        ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)          &
+!     &        ,KTS=k_start, KTE=min(k_end,kde-1)                          &
+!     &        ,NUM_TILES=grid%num_tiles                                   &
+!          ! Variables Required by ACM PBL  - jp
+!     &        ,ZNU=grid%znu,ZNW=grid%znw,MUT=grid%mut,P_TOP=grid%p_top    &
+!          ! optional
+!     &        ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV                 &
+!     &        ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC                 &
+!     &        ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR                 &
+!     &        ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI                 &
+!     &        ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS                 &
+!     &        ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG                 &
+!     &        ,HOL=HOL, MOL=grid%mol, REGIME=grid%REGIME                  &
+!     &                                                          )
+!
+!BENCH_END(pbl_driver_tim)
+!
+!! cumulus para.
+!
+!      CALL wrf_debug ( 200 , ' call cumulus_driver' )
+!
+!
+!BENCH_START(cu_driver_tim)
+!      CALL cumulus_driver(grid                                             &
+!                 ! Prognostic variables
+!     &             ,U=u_phy   ,V=v_phy   ,TH=th_phy  ,T=t_phy             &
+!     &             ,W=grid%w_2     ,P=p_phy   ,PI=pi_phy  ,RHO=rho             &
+!                 ! Other arguments
+!     &             ,ITIMESTEP=grid%itimestep ,DT=grid%dt      ,DX=grid%dx                &
+!     &             ,CUDT=grid%cudt,CURR_SECS=curr_secs,ADAPT_STEP_FLAG=adapt_step_flag &
+!     &             ,RAINC=grid%rainc   ,RAINCV=grid%raincv   ,PRATEC=grid%pratec         &
+!     &             , NCA=grid%nca                                         &
+!     &             ,HTOP=grid%cutop     ,HBOT=grid%cubot       ,KPBL=grid%kpbl             &
+!     &             ,DZ8W=dz8w     ,P8W=p8w                                &
+!     &             ,W0AVG=grid%w0avg   ,STEPCU=grid%stepcu                          &
+!     &             ,CLDEFI=grid%cldefi ,LOWLYR=grid%lowlyr ,XLAND=grid%xland             &
+!     &             ,APR_GR=grid%apr_gr ,APR_W=grid%apr_w   ,APR_MC=grid%apr_mc           &
+!     &             ,APR_ST=grid%apr_st ,APR_AS=grid%apr_as ,APR_CAPMA=grid%apr_capma     &
+!     &             ,APR_CAPME=grid%apr_capme          ,APR_CAPMI=grid%apr_capmi     &
+!     &             ,MASS_FLUX=grid%mass_flux          ,XF_ENS=grid%xf_ens           &
+!     &             ,PR_ENS=grid%pr_ens ,HT=grid%ht,EDT_OUT=grid%edt_out             &
+!     &             ,imomentum=grid%imomentum,clos_choice=grid%clos_choice       &
+!     &             ,cugd_tten=grid%cugd_tten,cugd_qvten=grid%cugd_qvten,cugd_qcten=grid%cugd_qcten   &
+!     &             ,cugd_ttens=grid%cugd_ttens,cugd_qvtens=grid%cugd_qvtens   &
+!     &             ,ENSDIM=config_flags%ensdim ,MAXIENS=config_flags%maxiens ,MAXENS=config_flags%maxens         &
+!     &             ,MAXENS2=config_flags%maxens2                ,MAXENS3=config_flags%maxens3       &
+!     &             ,CU_ACT_FLAG=cu_act_flag   ,WARM_RAIN=grid%warm_rain        &
+!     &             ,GSW=grid%gsw,cugd_avedx=config_flags%cugd_avedx &
+!     &             ,PERIODIC_X=(config_flags%polar .OR. config_flags%periodic_x)  &
+!     &             ,PERIODIC_Y=config_flags%periodic_y  &
+!                 ! Selection flag
+!     &             ,CU_PHYSICS=config_flags%cu_physics                    &
+!                 ! Dimension arguments
+!     &             ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde     &
+!     &             ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme     &
+!     &             ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe     &
+!     &             ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)     &
+!     &             ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)     &
+!     &             ,KTS=k_start, KTE=min(k_end,kde-1)                     &
+!     &             ,NUM_TILES=grid%num_tiles                              &
+!                 ! Moisture tendency arguments
+!     &             ,RQVCUTEN=grid%rqvcuten , RQCCUTEN=grid%rqccuten                 &
+!     &             ,RQSCUTEN=grid%rqscuten , RQICUTEN=grid%rqicuten                 &
+!     &             ,RQRCUTEN=grid%rqrcuten , RQVBLTEN=grid%rqvblten                 &
+!     &             ,RQVFTEN=grid%rqvften                                       &
+!                 ! Other tendency arguments
+!     &             ,RTHRATEN=grid%rthraten , RTHBLTEN=grid%rthblten                 &
+!     &             ,RTHCUTEN=grid%rthcuten , RTHFTEN=grid%rthften                   &
+!                 ! Moisture tracer arguments
+!     &             ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV            &
+!     &             ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC            &
+!     &             ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR            &
+!     &             ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI            &
+!     &             ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS            &
+!     &             ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG            &
+!#ifdef WRF_CHEM
+!     &             ,GD_CLOUD=grid%GD_CLOUD,GD_CLOUD2=grid%GD_CLOUD2                          &
+!#endif
+!     &                                                          )
+!BENCH_END(cu_driver_tim)
+!
+!      CALL wrf_debug ( 200 , ' call fddagd_driver' )
+!
+!BENCH_START(fdda_driver_tim)
+!      CALL fddagd_driver(itimestep=grid%itimestep,dt=grid%dt,xtime=grid%XTIME,   &
+!                  id=grid%id,      &
+!                  RUNDGDTEN=grid%rundgdten,RVNDGDTEN=grid%rvndgdten,             &
+!                  RTHNDGDTEN=grid%rthndgdten,RQVNDGDTEN=grid%rqvndgdten,         &
+!                  RMUNDGDTEN=grid%rmundgdten,                                    &
+!                  u_ndg_old=fdda3d(ims,kms,jms,P_u_ndg_old),              &
+!                  v_ndg_old=fdda3d(ims,kms,jms,P_v_ndg_old),              &
+!                  t_ndg_old=fdda3d(ims,kms,jms,P_t_ndg_old),              &
+!                  q_ndg_old=fdda3d(ims,kms,jms,P_q_ndg_old),              &
+!                  mu_ndg_old=fdda2d(ims,1,jms,P_mu_ndg_old),              &
+!                  u_ndg_new=fdda3d(ims,kms,jms,P_u_ndg_new),              &
+!                  v_ndg_new=fdda3d(ims,kms,jms,P_v_ndg_new),              &
+!                  t_ndg_new=fdda3d(ims,kms,jms,P_t_ndg_new),              &
+!                  q_ndg_new=fdda3d(ims,kms,jms,P_q_ndg_new),              &
+!                  mu_ndg_new=fdda2d(ims,1,jms,P_mu_ndg_new),              &
+!                  u3d=grid%u_2,v3d=grid%v_2,th_phy=th_phy,rho=rho,moist=moist,      &
+!                  p_phy=p_phy,pi_phy=pi_phy,p8w=p8w,t_phy=t_phy,          &
+!                  dz8w=dz8w,z=grid%z,z_at_w=z_at_w,                            &
+!                  config_flags=config_flags,dx=grid%DX,n_moist=num_moist,  &
+!                  STEPFG=grid%STEPFG,                                          &
+!                  pblh=grid%pblh,ht=grid%ht,                                        &
+!                    IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde     &
+!                   ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme     &
+!                   ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)     &
+!                   ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)     &
+!                   ,KTS=k_start, KTE=min(k_end,kde-1)                     &
+!                   , num_tiles=grid%num_tiles                             )
+!BENCH_END(fdda_driver_tim)
+
+!!****MARS
+IF (config_flags%modif_wrf) THEN
+!!!!!!!!!!!!!!!!!!!!!!!
+! call to LMD physics !
+!!!!!!!!!!!!!!!!!!!!!!!
+         CALL wrf_debug ( 200 , ' call lmd_driver' )
+         CALL lmd_driver(                                                 &
+           ! structure
+     &         id=grid%id,max_dom=grid%max_dom      &
+     &        ,DT=grid%dt                   &
+     &        ,ITIMESTEP=grid%itimestep                                   &
+           ! position
+     &        ,XLAT=grid%xlat,XLONG=grid%xlong                            &
+     &        ,DX=grid%dx         ,DY=grid%dy                             &
+     &        ,MSFT=grid%msftx,MSFU=grid%msfux,MSFV=grid%msfvx            &
+!     &        ,MSFT=grid%msft,MSFU=grid%msfu,MSFV=grid%msfv               &
+           ! indexes
+     &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde          &
+     &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme          &
+     &        ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1)          &
+     &        ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1)          &
+     &        ,kts=k_start, kte=min(k_end,kde-1)                          &
+     &        ,num_tiles=grid%num_tiles                                   &
+           ! time variables
+     &        ,GMT=grid%gmt       ,JULYR=grid%julyr   ,JULDAY=grid%julday &
+           ! output from phy_prep
+     &        ,P8W=p8w            ,DZ8W=dz8w          ,T8W=t8w            &
+           ! Prognostic variables at p points
+!     &        ,Z=grid%em_z                                                &
+     &        ,Z=grid%z                                                   &
+                        ! z is the geopotential height at p points 
+                        ! ... (cf phy_prep in module_big_step_utilities_em)
+     &        ,HT=grid%ht                                                 &
+     &        ,U=u_phy            ,V=v_phy             ,W=w_phy           &
+     &        ,TH=th_phy          ,T=t_phy                                &
+     &        ,P=p_phy            ,EXNER=pi_phy               ,RHO=rho    &
+!!!!!ADDITION CAS IDEALISES
+     &        ,PTOP=grid%p_top                                            &
+           ! physics calls
+     &        ,RADT=grid%radt                          &
+     &        ,CUDT=grid%cudt                          &
+           ! surface temperature and surface pressure
+     &        ,TSK=grid%tsk,PSFC=grid%psfc                                &
+           ! tendencies for the dynamics
+     &        ,RTHBLTEN=grid%rthblten  ,RUBLTEN=grid%rublten,RVBLTEN=grid%rvblten    &
+           ! scalars
+!     &        ,NUM_3D_S=num_3d_s,SCALAR=grid%scalar                       &
+     &        ,NUM_3D_S=num_scalar,SCALAR=grid%scalar                       &
+     &        ,NUM_3D_M=num_moist,MOIST=grid%moist                      &
+           ! mode
+     &        ,MARS_MODE=config_flags%mars   &
+#ifdef NEWPHYS
+           ! planet
+     &        ,planet_type=config_flags%planet   &
+#endif
+           ! added variables
+     &        ,M_ALBEDO=grid%m_albedo,M_TI=grid%m_ti  &
+     &        ,M_CO2ICE=grid%m_co2ice,M_EMISS=grid%m_emiss   &  
+     &        ,M_H2OICE=grid%m_h2oice     &
+     &        ,M_TSOIL=grid%m_tsoil       &
+     &        ,M_Q2=grid%m_q2             &
+     &        ,M_TSURF=grid%m_tsurf       &
+#ifdef NEWPHYS
+     &        ,M_FLUXRAD=grid%m_fluxrad   &
+     &        ,M_WSTAR=grid%m_wstar       &
+     &        ,M_ISOIL=grid%m_isoil       &
+     &        ,M_DSOIL=grid%m_dsoil       &
+     &        ,M_Z0=grid%m_z0             &
+     &        ,CST_Z0=config_flags%init_Z0      &
+#endif
+     &        ,M_GW=grid%m_gw  &  
+     &        ,NUM_SOIL_LAYERS=config_flags%num_soil_layers    &
+           ! cst fields
+     &        ,CST_AL=config_flags%init_AL  &
+     &        ,CST_TI=config_flags%init_TI  &
+     &        ,ISFFLX=config_flags%isfflx   &
+     &        ,DIFF_OPT=config_flags%diff_opt     &
+     &        ,KM_OPT=config_flags%km_opt         &
+     &        ,HISTORY_INTERVAL=model_config_rec%history_interval(1)  &
+          !------------------!
+          ! OUTPUT VARIABLES !
+          !------------------!
+#ifdef NEWPHYS
+     &       ,HR_SW=grid%HR_SW   &
+     &       ,HR_LW=grid%HR_LW   &
+     &       ,HR_DYN=grid%HR_DYN   &
+     &       ,DDT=grid%DDT  &
+     &       ,DT_RAD=grid%DT_RAD  &
+     &       ,DT_VDF=grid%DT_VDF  &
+     &       ,DT_AJS=grid%DT_AJS  &
+     &       ,CLOUDFRAC=grid%CLOUDFRAC   &
+     &       ,TOTCLOUDFRAC=grid%TOTCLOUDFRAC   &
+     &       ,GRAIN=grid%GRAIN   &
+     &       ,GSNOW=grid%GSNOW   &
+     &       ,REEVAP=grid%REEVAP  &
+     &       ,SURFRAIN=grid%SURFRAIN  &
+     &       ,ALBEQ=grid%ALBEQ   &
+     &       ,FLUXTOP_DN=grid%FLUXTOP_DN   &
+     &       ,FLUXABS_SW=grid%FLUXABS_SW   &
+     &       ,FLUXTOP_LW=grid%FLUXTOP_LW   &
+     &       ,FLUXSURF_SW=grid%FLUXSURF_SW   &
+     &       ,FLUXSURF_LW=grid%FLUXSURF_LW   &
+     &       ,FLXGRD=grid%FLXGRD   &
+     &       ,LSCEZ=grid%LSCEZ   &
+     &       ,H2OICE_REFF=grid%H2OICE_REFF  &
+     &       ,LATENT_HF=grid%LATENT_HF  &
+     &       ,SWDOWNZ=grid%SWDOWNZ   &
+     &       ,TAU_DUST=grid%TAU_DUST   &
+     &       ,RDUST=grid%RDUST   &
+     &       ,QSURFDUST=grid%QSURFDUST   &
+     &       ,MTOT=grid%MTOT   &
+     &       ,ICETOT=grid%ICETOT   &
+     &       ,VMR_ICE=grid%VMR_ICE   &
+     &       ,TAU_ICE=grid%TAU_ICE   &
+     &       ,RICE=grid%RICE   &
+     &       ,ZMAX=grid%ZMAX   &
+     &       ,HFMAX=grid%HFMAX &
+     &       ,USTM=grid%USTM   &
+     &       ,HFX=grid%HFX &
+#else 
+#include "module_lmd_driver_output4.inc"
+#endif
+     &        ,SLPX=grid%slpx,SLPY=grid%slpy,RESTART=config_flags%restart)
+ENDIF
+
+!!!!!!!!!!!!!!!!!!!!!!!
+! call to LMD physics !
+!!!!!!!!!!!!!!!!!!!!!!!
+!****MARS
+
+  END SUBROUTINE first_rk_step_part1
+
+END MODULE module_first_rk_step_part1
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part2.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part2.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part2.F	(revision 2744)
@@ -0,0 +1,618 @@
+!WRF:MEDIATION_LAYER:SOLVER
+
+#define BENCH_START(A)
+#define BENCH_END(A)
+
+MODULE module_first_rk_step_part2
+
+CONTAINS
+
+  SUBROUTINE first_rk_step_part2 (   grid , config_flags              &
+                             , moist , moist_tend               &
+                             , chem  , chem_tend                &
+                             , scalar , scalar_tend             &
+                             , fdda3d, fdda2d                   &
+                             , ru_tendf, rv_tendf               &
+                             , rw_tendf, t_tendf                &
+                             , ph_tendf, mu_tendf               &
+                             , tke_tend                         &
+                             , adapt_step_flag , curr_secs      &
+                             , psim , psih , wspd , gz1oz0 , br , chklowq &
+                             , cu_act_flag , hol , th_phy        &
+                             , pi_phy , p_phy , t_phy , u_phy , v_phy     &
+                             , dz8w , p8w , t8w , rho_phy , rho           &
+                             , z_at_w , mu_3d                   &
+                             , ids, ide, jds, jde, kds, kde     &
+                             , ims, ime, jms, jme, kms, kme     &
+                             , ips, ipe, jps, jpe, kps, kpe     &
+                             , k_start , k_end                  &
+                            )
+    USE module_state_description
+    USE module_model_constants
+    USE module_domain, ONLY : domain
+    USE module_configure, ONLY : grid_config_rec_type, model_config_rec
+    USE module_dm
+    USE module_diffusion_em, ONLY : phy_bc, cal_deform_and_div, compute_diff_metrics, &
+                                    vertical_diffusion_2, horizontal_diffusion_2, calculate_km_kh, &
+                                    tke_rhs
+    USE module_em, ONLY : calculate_phy_tend
+!!!!****MARS MARS
+!    USE module_fddaobs_driver, ONLY : fddaobs_driver
+    USE module_bc, ONLY : set_physical_bc3d, set_physical_bc2d
+    USE module_physics_addtendc, ONLY : update_phy_ten
+
+    IMPLICIT NONE
+
+    TYPE ( domain ), INTENT(INOUT) :: grid
+    TYPE ( grid_config_rec_type ), INTENT(IN) :: config_flags
+
+    INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           ips, ipe, jps, jpe, kps, kpe
+
+    LOGICAL ,INTENT(IN)                        :: adapt_step_flag
+    REAL, INTENT(IN)                           :: curr_secs
+
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: moist
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: moist_tend
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: chem
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: chem_tend
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: scalar
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT)   :: scalar_tend
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_fdda3d),INTENT(INOUT)  :: fdda3d
+    REAL    ,DIMENSION(ims:ime,1:1,jms:jme,num_fdda2d),INTENT(INOUT)      :: fdda2d
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: psim
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: psih
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: wspd
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: gz1oz0
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: br
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: chklowq
+    LOGICAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: cu_act_flag
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: hol
+
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: th_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: pi_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: u_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: v_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: dz8w
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p8w
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t8w
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho_phy
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: z_at_w
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: mu_3d
+
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ru_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rv_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rw_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ph_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_tendf
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: tke_tend
+
+    REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: mu_tendf
+
+    INTEGER , INTENT(IN)                          ::  k_start, k_end
+
+! Local
+
+    REAL, DIMENSION( ims:ime, jms:jme ) :: ht_loc
+    INTEGER, DIMENSION( ims:ime, jms:jme ) :: shadowmask 
+    INTEGER                             :: ij
+    INTEGER  num_roof_layers
+    INTEGER  num_wall_layers
+    INTEGER  num_road_layers
+    INTEGER  iswater
+    INTEGER  rk_step 
+
+ ! initialize all tendencies to zero in order to update physics
+ ! tendencies first (separate from dry dynamics).
+
+    rk_step = 1
+
+! calculate_phy_tend
+
+BENCH_START(cal_phy_tend)
+      !$OMP PARALLEL DO   &
+      !$OMP PRIVATE ( ij )
+
+      DO ij = 1 , grid%num_tiles
+
+        CALL wrf_debug ( 200 , ' call calculate_phy_tend' )
+        CALL calculate_phy_tend (config_flags,grid%mut,grid%muu,grid%muv,pi_phy,            &
+                     grid%rthraten,                                         &
+                     grid%rublten,grid%rvblten,grid%rthblten,                         &
+                     grid%rqvblten,grid%rqcblten,grid%rqiblten,                       &
+                     grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten,              &
+                     grid%rqicuten,grid%rqscuten,                                &
+                     grid%RUNDGDTEN,grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN,        &
+                     grid%RMUNDGDTEN,                                       &
+                     ids,ide, jds,jde, kds,kde,                        &
+                     ims,ime, jms,jme, kms,kme,                        &
+                     grid%i_start(ij), min(grid%i_end(ij),ide-1),      &
+                     grid%j_start(ij), min(grid%j_end(ij),jde-1),      &
+                     k_start    , min(k_end,kde-1)                     )
+
+      ENDDO
+      !$OMP END PARALLEL DO
+BENCH_END(cal_phy_tend)
+
+! tke diffusion
+
+       IF(config_flags%diff_opt .eq. 2 .OR. config_flags%diff_opt .eq. 1) THEN
+
+BENCH_START(comp_diff_metrics_tim)
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           CALL wrf_debug ( 200 , ' call compute_diff_metrics ' )
+           CALL compute_diff_metrics ( config_flags, grid%ph_2, grid%phb, grid%z, grid%rdz, grid%rdzw, &
+                                       grid%zx, grid%zy, grid%rdx, grid%rdy,                      &
+                                       ids, ide, jds, jde, kds, kde,          &
+                                       ims, ime, jms, jme, kms, kme,          &
+                                       grid%i_start(ij), grid%i_end(ij),      &
+                                       grid%j_start(ij), grid%j_end(ij),      &
+                                       k_start    , k_end                    )
+         ENDDO
+         !$OMP END PARALLEL DO
+BENCH_END(comp_diff_metrics_tim)
+
+#ifdef DM_PARALLEL
+#  include "HALO_EM_TKE_C.inc"
+#  include "PERIOD_BDY_EM_A1.inc"
+#endif
+
+BENCH_START(tke_diff_bc_tim)
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+
+         DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call bc for diffusion_metrics ' )
+           CALL set_physical_bc3d( grid%rdzw , 'w', config_flags,           &
+                                   ids, ide, jds, jde, kds, kde,       &
+                                   ims, ime, jms, jme, kms, kme,       &
+                                   ips, ipe, jps, jpe, kps, kpe,       &
+                                   grid%i_start(ij), grid%i_end(ij),   &
+                                   grid%j_start(ij), grid%j_end(ij),   &
+                                   k_start    , k_end                 )
+           CALL set_physical_bc3d( grid%rdz , 'w', config_flags,            &
+                                   ids, ide, jds, jde, kds, kde,       &
+                                   ims, ime, jms, jme, kms, kme,       &
+                                   ips, ipe, jps, jpe, kps, kpe,       &
+                                   grid%i_start(ij), grid%i_end(ij),   &
+                                   grid%j_start(ij), grid%j_end(ij),   &
+                                   k_start    , k_end                 )
+           CALL set_physical_bc3d( grid%z , 'w', config_flags,              &
+                                   ids, ide, jds, jde, kds, kde,       &
+                                   ims, ime, jms, jme, kms, kme,       &
+                                   ips, ipe, jps, jpe, kps, kpe,       &
+                                   grid%i_start(ij), grid%i_end(ij),   &
+                                   grid%j_start(ij), grid%j_end(ij),   &
+                                   k_start    , k_end                 )
+           CALL set_physical_bc3d( grid%zx , 'w', config_flags,             &
+                                   ids, ide, jds, jde, kds, kde,       &
+                                   ims, ime, jms, jme, kms, kme,       &
+                                   ips, ipe, jps, jpe, kps, kpe,       &
+                                   grid%i_start(ij), grid%i_end(ij),   &
+                                   grid%j_start(ij), grid%j_end(ij),   &
+                                   k_start    , k_end                 )
+           CALL set_physical_bc3d( grid%zy , 'w', config_flags,             &
+                                   ids, ide, jds, jde, kds, kde,       &
+                                   ims, ime, jms, jme, kms, kme,       &
+                                   ips, ipe, jps, jpe, kps, kpe,       &
+                                   grid%i_start(ij), grid%i_end(ij),   &
+                                   grid%j_start(ij), grid%j_end(ij),   &
+                                   k_start    , k_end                 )
+           CALL set_physical_bc2d( grid%ustm, 't', config_flags,            &
+                                   ids, ide, jds, jde,                 &
+                                   ims, ime, jms, jme,                 &
+                                   ips, ipe, jps, jpe,                 &
+                                   grid%i_start(ij), grid%i_end(ij),   &
+                                   grid%j_start(ij), grid%j_end(ij)   )
+
+         ENDDO
+         !$OMP END PARALLEL DO
+BENCH_END(tke_diff_bc_tim)
+
+BENCH_START(deform_div_tim)
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+
+         DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call cal_deform_and_div' )
+           CALL cal_deform_and_div ( config_flags,grid%u_2,grid%v_2,grid%w_2,grid%div,  &
+                                     grid%defor11,grid%defor22,grid%defor33,            &
+                                     grid%defor12,grid%defor13,grid%defor23,            &
+                                     grid%u_base, grid%v_base,grid%msfux,grid%msfuy,    &
+                                     grid%msfvx,grid%msfvy,grid%msftx,grid%msfty,       &
+                                     grid%rdx, grid%rdy, grid%dn, grid%dnw, grid%rdz,   &
+                                     grid%rdzw,grid%fnm,grid%fnp,grid%cf1,grid%cf2,     &
+                                     grid%cf3,grid%zx,grid%zy,            &
+                                     ids, ide, jds, jde, kds, kde,        &
+                                     ims, ime, jms, jme, kms, kme,        &
+                                     grid%i_start(ij), grid%i_end(ij),    &
+                                     grid%j_start(ij), grid%j_end(ij),    &
+                                     k_start    , k_end                  )
+         ENDDO
+         !$OMP END PARALLEL DO
+BENCH_END(deform_div_tim)
+
+#ifdef DM_PARALLEL
+#     include "HALO_EM_TKE_D.inc"
+#endif
+
+! calculate tke, kmh, and kmv
+
+BENCH_START(calc_tke_tim)
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call calculate_km_kh' )
+           CALL calculate_km_kh( config_flags,grid%dt,grid%dampcoef,grid%zdamp,         &
+                                 config_flags%damp_opt,                                 &
+                                 grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv,grid%bn2,      &
+                                 grid%khdif,grid%kvdif,grid%div,                        &
+                                 grid%defor11,grid%defor22,grid%defor33,grid%defor12,   &
+                                 grid%defor13,grid%defor23,                             &
+                                 grid%tke_2,p8w,t8w,th_phy,                             &
+                                 t_phy,p_phy,moist,grid%dn,grid%dnw,                    &
+                                 grid%dx,grid%dy,grid%rdz,grid%rdzw,                    &
+                                 config_flags%mix_isotropic,num_moist,                  &
+                                 grid%cf1, grid%cf2, grid%cf3, grid%warm_rain,          &
+                                 grid%mix_upper_bound,                                  &
+                                 grid%msftx, grid%msfty,                                &
+                                 ids,ide, jds,jde, kds,kde,                             &
+                                 ims,ime, jms,jme, kms,kme,                             &
+                                 grid%i_start(ij), grid%i_end(ij),                      &
+                                 grid%j_start(ij), grid%j_end(ij),                      &
+                                 k_start    , k_end                          )
+         ENDDO
+       !$OMP END PARALLEL DO
+BENCH_END(calc_tke_tim)
+
+#ifdef DM_PARALLEL
+#     include "HALO_EM_TKE_E.inc"
+#endif
+
+       ENDIF
+
+#ifdef DM_PARALLEL
+#      include "PERIOD_BDY_EM_PHY_BC.inc"
+       IF ( config_flags%grid_fdda .eq. 1) THEN
+#      include "PERIOD_BDY_EM_FDDA_BC.inc"
+       ENDIF
+#      include "PERIOD_BDY_EM_CHEM.inc"
+#endif
+
+BENCH_START(phy_bc_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+
+       DO ij = 1 , grid%num_tiles
+
+         CALL wrf_debug ( 200 , ' call phy_bc' )
+         CALL phy_bc (config_flags,grid%div,grid%defor11,grid%defor22,grid%defor33,            &
+                      grid%defor12,grid%defor13,grid%defor23,      &
+                      grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv,     &
+                      grid%tke_2,                                  &
+                      grid%rublten, grid%rvblten,                  &
+                      ids, ide, jds, jde, kds, kde,                &
+                      ims, ime, jms, jme, kms, kme,                &
+                      ips, ipe, jps, jpe, kps, kpe,                &
+                      grid%i_start(ij), grid%i_end(ij),            &
+                      grid%j_start(ij), grid%j_end(ij),            &
+                      k_start    , k_end                           )
+       ENDDO
+       !$OMP END PARALLEL DO
+BENCH_END(phy_bc_tim)
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+!
+! MPP for some physics tendency, km, kh, deformation, and divergence
+!
+!                                                         * * * * * * *
+!                                            * * * * *    * * * * * * *
+!               *                     *      * * * * *    * * * * * * *
+!             * + *      * + *        +      * * + * *    * * * + * * *
+!               *                     *      * * * * *    * * * * * * *
+!                                            * * * * *    * * * * * * *
+!                                                         * * * * * * *
+!
+! (for PBL)
+! rublten                  x
+! rvblten                             x
+!
+! (for FDDA)
+! rundgdten     x
+! rvndgdten     x
+!
+! (for TKE3)
+! tke_2                                          x               
+! (for TKE5)
+! tke_2                                                         x
+!
+! (for diff_opt >= 1)
+! defor11                  x
+! defor22                             x
+! defor12       x
+! defor13                  x
+! defor23                             x
+! div           x
+! xkmv          x
+! xkmh          x
+! xkhv          x
+! xkhh          x
+! tke           x
+!
+!-----------------------------------------------------------------------
+
+!!****MARS: always include this HALO for Mars version ...
+      IF ( ( config_flags%bl_pbl_physics .ge. 1 ) &
+            .OR. ( config_flags%modif_wrf ) ) THEN
+!       IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN
+#      include "HALO_EM_PHYS_PBL.inc"
+       ENDIF
+       IF ( config_flags%grid_fdda .eq. 1) THEN
+#      include "HALO_EM_FDDA.inc"
+       ENDIF
+       IF ( config_flags%diff_opt .ge. 1 ) THEN
+#      include "HALO_EM_PHYS_DIFFUSION.inc"
+       ENDIF
+
+       IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#       include "HALO_EM_TKE_3.inc"
+       ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#       include "HALO_EM_TKE_5.inc"
+       ELSE
+         WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+         CALL wrf_error_fatal(TRIM(wrf_err_message))
+       ENDIF
+#endif
+
+BENCH_START(update_phy_ten_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+
+       DO ij = 1 , grid%num_tiles
+
+         CALL wrf_debug ( 200 , ' call update_phy_ten' )
+         CALL update_phy_ten(t_tendf, ru_tendf, rv_tendf,moist_tend,        &
+                           scalar_tend, mu_tendf,                           &
+                           grid%rthraten,grid%rthblten,grid%rthcuten,       &
+                           grid%rublten,grid%rvblten,                       &
+                           grid%rqvblten,grid%rqcblten,grid%rqiblten,       &
+                           grid%rqvcuten,grid%rqccuten,grid%rqrcuten,       &
+                           grid%rqicuten,grid%rqscuten,grid%RUNDGDTEN,      &
+                           grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN,  &
+                           grid%RMUNDGDTEN,                                 &
+                           num_moist,num_scalar,config_flags,rk_step,          &
+                           grid%adv_moist_cond,                             &
+                           ids, ide, jds, jde, kds, kde,                    &
+                           ims, ime, jms, jme, kms, kme,                    &
+                           grid%i_start(ij), grid%i_end(ij),                &
+                           grid%j_start(ij), grid%j_end(ij),                &
+                           k_start, k_end                               )
+
+       END DO
+       !$OMP END PARALLEL DO
+BENCH_END(update_phy_ten_tim)
+
+#ifdef PLANET
+       ! do rayleigh (and zonal-average newtonian) damping during
+       ! first iteration of RK loop only
+
+       IF ( (config_flags%damp_opt == 101) .OR. &
+            (config_flags%damp_opt == 103)      ) THEN
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           CALL damptop( grid%u_2, grid%v_2, grid%t_2, &
+                         grid%mut, grid%muu, grid%muv, &
+                         pi_phy,                                &
+                         t_tendf, ru_tendf, rv_tendf, P2SI,     &
+                         ids, ide, jds, jde, kds, kde,          &
+                         ims, ime, jms, jme, kms, kme,          &
+                         grid%i_start(ij), grid%i_end(ij),      &
+                         grid%j_start(ij), grid%j_end(ij),      &
+                         k_start, k_end                         )
+         END DO
+         !$OMP END PARALLEL DO
+       END IF
+#endif
+
+       IF( config_flags%diff_opt .eq. 2 .and. config_flags%km_opt .eq. 2 ) THEN
+
+BENCH_START(tke_rhs_tim)
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+
+           CALL tke_rhs  ( tke_tend,grid%bn2,                           &
+                         config_flags,grid%defor11,grid%defor22,      &
+                         grid%defor33,                                &
+                         grid%defor12,grid%defor13,grid%defor23,      &
+                         grid%u_2,grid%v_2,grid%w_2,grid%div,         &
+                         grid%tke_2,grid%mut,                         &
+                         th_phy,p_phy,p8w,t8w,grid%z,grid%fnm,        & 
+                         grid%fnp,grid%cf1,grid%cf2,grid%cf3,         &     
+                         grid%msftx,grid%msfty,grid%xkmh,             &
+                         grid%xkmv,grid%xkhv,grid%rdx,grid%rdy,       &
+                         grid%dx,grid%dy,grid%dt,grid%zx,grid%zy,     &
+                         grid%rdz,grid%rdzw,grid%dn,                  &
+                         grid%dnw,config_flags%mix_isotropic,         &
+                         grid%hfx, grid%qfx, moist(ims,kms,jms,P_QV), &
+                         grid%ustm, rho,                              &
+                         ids, ide, jds, jde, kds, kde,                &
+                         ims, ime, jms, jme, kms, kme,                &
+                         grid%i_start(ij), grid%i_end(ij),            &
+                         grid%j_start(ij), grid%j_end(ij),            &
+                         k_start    , k_end                           )
+
+         ENDDO
+         !$OMP END PARALLEL DO
+BENCH_END(tke_rhs_tim)
+
+       ENDIF
+
+! calculate vertical diffusion first and then horizontal
+! (keep this order)
+
+       IF(config_flags%diff_opt .eq. 2) THEN
+
+!!!!****MARS: vertical diffusion is done by the physics
+!!!!****MARS: a part si isfflx=1 (SGS completement fait par WRF)
+!!!!****MARS: ou si TKE_heat precisee dans la namelist
+!       IF ( (config_flags%bl_pbl_physics .eq. 0) &
+!             .AND. (.not. config_flags%modif_wrf ) ) THEN
+!!         IF (config_flags%bl_pbl_physics .eq. 0) THEN
+!!
+!!
+       IF ( ( config_flags%bl_pbl_physics .eq. 0 ) &
+             .AND. ( ( config_flags%isfflx .ge. 1 ) &
+             .OR. ( config_flags%tke_heat_flux .ne. 0.) ) ) THEN
+!!
+!!
+BENCH_START(vert_diff_tim)
+           !$OMP PARALLEL DO   &
+           !$OMP PRIVATE ( ij )
+           DO ij = 1 , grid%num_tiles
+
+             CALL wrf_debug ( 200 , ' call vertical_diffusion_2 ' )
+             CALL vertical_diffusion_2( ru_tendf, rv_tendf, rw_tendf,            &
+                                      t_tendf, tke_tend,                         &
+                                      moist_tend, num_moist,                      &
+                                      chem_tend, num_chem,                       &
+                                      scalar_tend, num_scalar,                     &
+                                      grid%u_2, grid%v_2,                                  &
+                                      grid%t_2,grid%u_base,grid%v_base,grid%t_base,grid%qv_base,          &
+                                      grid%mut,grid%tke_2,config_flags, &
+                                      grid%defor13,grid%defor23,grid%defor33,                   &
+                                      grid%div, moist, chem, scalar,                  &
+                                      grid%xkmv, grid%xkhv, config_flags%km_opt,                        &
+                                      grid%fnm, grid%fnp, grid%dn, grid%dnw, grid%rdz, grid%rdzw, &
+                                      grid%hfx, grid%qfx, grid%ustm, rho,        &
+                                      ids, ide, jds, jde, kds, kde,              &
+                                      ims, ime, jms, jme, kms, kme,              &
+                                      grid%i_start(ij), grid%i_end(ij),          &
+                                      grid%j_start(ij), grid%j_end(ij),          &
+                                      k_start, k_end                             )
+
+           ENDDO
+           !$OMP END PARALLEL DO
+BENCH_END(vert_diff_tim)
+
+         ENDIF
+!
+BENCH_START(hor_diff_tim)
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call horizontal_diffusion_2' )
+           CALL horizontal_diffusion_2( t_tendf, ru_tendf, rv_tendf, rw_tendf, &
+                                      tke_tend,                              &
+                                      moist_tend, num_moist,                  &
+                                      chem_tend, num_chem,                   &
+                                      scalar_tend, num_scalar,                 &
+                                      grid%t_2, th_phy,                           &
+                                      grid%mut, grid%tke_2, config_flags,              &
+                                      grid%defor11, grid%defor22, grid%defor12,             &
+                                      grid%defor13, grid%defor23, grid%div,                 &
+                                      moist, chem, scalar,                   &
+                                      grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,  &
+                                      grid%msfty, grid%xkmh, grid%xkhh, config_flags%km_opt,     &
+                                      grid%rdx, grid%rdy, grid%rdz, grid%rdzw,                   &
+                                      grid%fnm, grid%fnp, grid%cf1, grid%cf2, grid%cf3,          &
+                                      grid%zx, grid%zy, grid%dn, grid%dnw,                       &
+                                      ids, ide, jds, jde, kds, kde,          &
+                                      ims, ime, jms, jme, kms, kme,          &
+                                      grid%i_start(ij), grid%i_end(ij),      &
+                                      grid%j_start(ij), grid%j_end(ij),      &
+                                      k_start    , k_end                    )
+         ENDDO
+         !$OMP END PARALLEL DO
+BENCH_END(hor_diff_tim)
+       ENDIF
+
+!!!!****MARS MARS
+!!!!****MARS MARS
+
+!       IF ( grid%obs_nudge_opt .EQ. 1 ) THEN
+!# ifdef DM_PARALLEL
+!#       include "HALO_OBS_NUDGE.inc"
+!#endif
+!!***********************************************************************
+!! This section for obs nudging
+!         !$OMP PARALLEL DO   &
+!         !$OMP PRIVATE ( ij )
+!
+!         DO ij = 1 , grid%num_tiles
+!
+!           CALL fddaobs_driver (grid%grid_id, model_config_rec%grid_id, &
+!                   model_config_rec%parent_id, config_flags%restart,    &
+!                   grid%obs_nudge_opt,                                  &
+!                   grid%obs_ipf_errob,                                  &
+!                   grid%obs_ipf_nudob,                                  &
+!                   grid%fdda_start,                                     &
+!                   grid%fdda_end,                                       &
+!                   grid%obs_nudge_wind,                                 &
+!                   grid%obs_nudge_temp,                                 &
+!                   grid%obs_nudge_mois,                                 &
+!                   grid%obs_nudge_pstr,                                 &
+!                   grid%obs_coef_wind,                                  &
+!                   grid%obs_coef_temp,                                  &
+!                   grid%obs_coef_mois,                                  &
+!                   grid%obs_coef_pstr,                                  &             
+!                   grid%obs_rinxy,                                      &
+!                   grid%obs_rinsig,                                     &
+!                   grid%obs_npfi,                                       &
+!                   grid%obs_ionf,                                       &
+!                   grid%obs_nobs_prt,                                   &
+!                   grid%obs_idynin,                                     &
+!                   grid%obs_dtramp,                                     &
+!                   model_config_rec%cen_lat(1),                         &
+!                   model_config_rec%cen_lon(1),                         &
+!                   config_flags%truelat1,                               &
+!                   config_flags%truelat2,                               &
+!                   config_flags%map_proj,                               &
+!                   model_config_rec%i_parent_start,                     &
+!                   model_config_rec%j_parent_start,                     &
+!                   grid%parent_grid_ratio,                              &
+!                   grid%max_dom, grid%itimestep,                        &
+!                   grid%dt, grid%gmt, grid%julday, grid%fdob,           &
+!                   grid%max_obs,                                        &
+!                   model_config_rec%nobs_ndg_vars,                      &
+!                   model_config_rec%nobs_err_flds,                      &
+!                   grid%fdob%nstat, grid%fdob%varobs, grid%fdob%errf,   &
+!                   grid%dx, grid%KPBL,grid%HT,                          &
+!                   grid%mut, grid%muu, grid%muv,               &
+!                   grid%msftx, grid%msfty, grid%msfux, grid%msfuy, grid%msfvx, grid%msfvy, &
+!                   p_phy, t_tendf, t0,                                  &
+!                   grid%u_2, grid%v_2, grid%t_2,               &
+!                   moist(ims,kms,jms,P_QV),                                   &
+!                   grid%pb, grid%p_top, grid%p,                   &
+!                   grid%uratx, grid%vratx, grid%tratx,                  &
+!                   ru_tendf, rv_tendf,                                  &
+!                   moist_tend(ims,kms,jms,P_QV), grid%obs_savwt,           &
+!                   ids,ide, jds,jde, kds,kde,                           &
+!                   ims,ime, jms,jme, kms,kme,                           &
+!                   grid%i_start(ij), min(grid%i_end(ij),ide-1),         &
+!                   grid%j_start(ij), min(grid%j_end(ij),jde-1),         &
+!                   k_start    , min(k_end,kde-1)                     )
+! 
+!         ENDDO
+!         !$OMP END PARALLEL DO
+!       ENDIF  ! obs_nudge_opt .eq. 1
+!! 
+!!***********************************************************************
+
+  END SUBROUTINE first_rk_step_part2
+
+END MODULE module_first_rk_step_part2
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_init_utilities.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_init_utilities.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_init_utilities.F	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/dyn_em/module_init_utilities.F
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_initialize_les.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_initialize_les.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_initialize_les.F	(revision 2744)
@@ -0,0 +1,1406 @@
+!IDEAL:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform various initializations
+!  for the individual domains.  
+
+!  This MODULE CONTAINS the following routines:
+
+!  initialize_field_test - 1. Set different fields to different constant
+!                             values.  This is only a test.  If the correct
+!                             domain is not found (based upon the "id")
+!                             then a fatal error is issued.               
+
+!-----------------------------------------------------------------------
+
+MODULE module_initialize_ideal
+
+   USE module_domain
+   USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+   USE module_bc
+   USE module_timing
+   USE module_configure
+   USE module_init_utilities
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+
+CONTAINS
+
+
+!-------------------------------------------------------------------
+! this is a wrapper for the solver-specific init_domain routines.
+! Also dereferences the grid variables and passes them down as arguments.
+! This is crucial, since the lower level routines may do message passing
+! and this will get fouled up on machines that insist on passing down
+! copies of assumed-shape arrays (by passing down as arguments, the 
+! data are treated as assumed-size -- ie. f77 -- arrays and the copying
+! business is avoided).  Fie on the F90 designers.  Fie and a pox.
+
+   SUBROUTINE init_domain ( grid )
+
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid 
+   !  Local data.
+   INTEGER :: idum1, idum2
+
+   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
+
+     CALL init_domain_rk( grid &
+!
+#include <actual_new_args.inc>
+!
+                        )
+
+   END SUBROUTINE init_domain
+
+!-------------------------------------------------------------------
+
+   SUBROUTINE init_domain_rk ( grid &
+!
+# include <dummy_new_args.inc>
+!
+)
+   IMPLICIT NONE
+
+   !  Input data.
+   TYPE (domain), POINTER :: grid
+
+# include <dummy_new_decl.inc>
+
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   !  Local data
+   INTEGER                             ::                       &
+                                  ids, ide, jds, jde, kds, kde, &
+                                  ims, ime, jms, jme, kms, kme, &
+                                  its, ite, jts, jte, kts, kte, &
+                                  i, j, k
+
+   ! Local data
+
+   INTEGER, PARAMETER :: nl_max = 1000
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in
+   REAL*8, DIMENSION(nl_max) :: pd_in8
+   INTEGER :: nl_in
+
+   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
+   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
+   REAL*8 :: p_level8
+   REAL    :: xrad, yrad, zrad, rad, delt, cof1, cof2
+!   REAL, EXTERNAL :: interp_0
+   REAL    :: hm
+   REAL    :: pi
+
+!  stuff from original initialization that has been dropped from the Registry 
+   REAL    :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt
+   REAL    :: qvf1, qvf2, pd_surf
+   INTEGER :: it
+   real :: thtmp, ptmp, temp(3)
+
+   LOGICAL :: moisture_init
+   LOGICAL :: stretch_grid, dry_sounding
+
+  INTEGER :: xs , xe , ys , ye
+  REAL :: mtn_ht
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+!  For LES, add randx
+   real :: randx
+
+!!MARS
+ REAL :: lon_input, lat_input, alt_input, tsurf_input
+ ! for mode 3
+ REAL, DIMENSION(nl_max) :: profdustq,profdustn
+ REAL, DIMENSION(nl_max) :: prescribed_sw,prescribed_lw,prescribed_dyn
+ REAL, DIMENSION(nl_max) :: hrsw,hrlw,hrdyn
+ REAL, DIMENSION(nl_max) :: lsf_dt,lsf_dq,lsfdt,lsfdq
+ REAL, DIMENSION(nl_max) :: venus_hrdyn
+ REAL, DIMENSION(nl_max) :: altitude
+ REAL*8, DIMENSION(nl_max) :: trac
+!!MARS
+
+      REAL :: pfu, pfd, phm
+      INTEGER :: hypsometric_opt = 1 ! classic
+      !INTEGER :: hypsometric_opt = 2 ! Wee et al. 2012 correction
+
+      LOGICAL :: logp = .true. ! use logp to interpolate (and not p)
+
+#ifdef DM_PARALLEL
+#    include <data_calls.inc>
+#endif
+
+
+   SELECT CASE ( model_data_order )
+         CASE ( DATA_ORDER_ZXY )
+   kds = grid%sd31 ; kde = grid%ed31 ;
+   ids = grid%sd32 ; ide = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   kms = grid%sm31 ; kme = grid%em31 ;
+   ims = grid%sm32 ; ime = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
+   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XYZ )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   jds = grid%sd32 ; jde = grid%ed32 ;
+   kds = grid%sd33 ; kde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   jms = grid%sm32 ; jme = grid%em32 ;
+   kms = grid%sm33 ; kme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
+   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
+         CASE ( DATA_ORDER_XZY )
+   ids = grid%sd31 ; ide = grid%ed31 ;
+   kds = grid%sd32 ; kde = grid%ed32 ;
+   jds = grid%sd33 ; jde = grid%ed33 ;
+
+   ims = grid%sm31 ; ime = grid%em31 ;
+   kms = grid%sm32 ; kme = grid%em32 ;
+   jms = grid%sm33 ; jme = grid%em33 ;
+
+   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
+   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
+   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
+
+   END SELECT
+
+   IF (planet == "mars" .or. planet == "titan") THEN
+     stretch_grid = .false.
+     !! FOR LES, set stretch to false
+   ELSE
+     stretch_grid = .true. !! VENUS
+   ENDIF
+   delt = 3.
+!   z_scale = .50
+!   z_scale = .10
+!   z_scale = .25
+!   z_scale = .15
+   pi = 2.*asin(1.0)
+   write(6,*) ' pi is ',pi
+   nxc = (ide-ids)/2
+   nyc = (jde-jds)/2
+
+   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
+
+! here we check to see if the boundary conditions are set properly
+
+   CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
+
+   moisture_init = .true.
+
+    grid%itimestep=0
+
+#ifdef DM_PARALLEL
+   CALL wrf_dm_bcast_bytes( icm , IWORDSIZE )
+   CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE )
+#endif
+
+    CALL nl_set_mminlu(1, '    ')
+    CALL nl_set_iswater(1,0)
+    CALL nl_set_cen_lat(1,40.)
+    CALL nl_set_cen_lon(1,-105.)
+    CALL nl_set_truelat1(1,0.)
+    CALL nl_set_truelat2(1,0.)
+    CALL nl_set_moad_cen_lat (1,0.)
+    CALL nl_set_stand_lon (1,0.)
+    CALL nl_set_map_proj(1,0)
+
+
+!  here we initialize data we currently is not initialized 
+!  in the input data
+
+    DO j = jts, jte
+      DO i = its, ite
+         grid%msftx(i,j)    = 1.
+         grid%msfty(i,j)    = 1.
+         grid%msfux(i,j)    = 1.
+         grid%msfuy(i,j)    = 1.
+         grid%msfvx(i,j)    = 1.
+         grid%msfvx_inv(i,j)= 1.
+         grid%msfvy(i,j)    = 1.
+         grid%sina(i,j)     = 0.
+         grid%cosa(i,j)     = 1.
+         grid%e(i,j)        = 0.
+!  for LES, include Coriolis force
+         grid%f(i,j)        = 0.  !!MARS MARS 1.e-4 
+!!      grid%f(i,j)     = 2*EOMEG*SIN(grid%xlat(i,j)*degrad)
+      END DO
+   END DO
+
+    DO j = jts, jte
+    DO k = kts, kte
+      DO i = its, ite
+         grid%ww(i,k,j)     = 0.
+      END DO
+   END DO
+   END DO
+
+   grid%step_number = 0
+
+! set up the grid
+
+   IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz)
+     DO k=1, kde
+      grid%znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ &
+                                (1.-exp(-1./z_scale))
+     ENDDO
+   ELSE
+     !!MARS
+     !!MARS
+     IF (planet .ne. "mars" .and. planet .ne. "titan") THEN
+       open(unit=12,file='levels',form='formatted',status='old')
+       rewind(12)
+       DO k=1, kde
+        read(12,*) grid%znw(k)
+        write(6,*) 'read level ', k,grid%znw(k)
+       ENDDO
+       close(12)
+     ENDIF
+     !!MARS
+     !!MARS
+     !  !DO k=1, kde
+     !  ! grid%znw(k) = 1. - float(k-1)/float(kde-1)
+     !  !ENDDO
+   ENDIF
+
+   !! SPECIFIC FOR LES PBL MARS
+   IF (planet == "mars" .or. planet == "titan") THEN
+     !!!MARS
+     grid%znw(1)=1.000
+     grid%znw(2)=0.9995 !5m
+     grid%znw(3)=0.9980 !20m
+     grid%znw(4)=0.9950 !55m
+     DO k=5, kde
+       grid%znw(k) = grid%znw(4) * ( 1. - float(k-4)/float(kde-4) )
+     ENDDO
+   ENDIF
+
+   open(unit=12,file='levels',form='formatted',status='old')
+   rewind(12)
+   DO k=1, kde
+     write(12,*) grid%znw(k)
+     write(6,*) 'for update_inputs_physiq_mod (e.g. Titan, generic)',k,grid%znw(k)
+   ENDDO
+   close(12)
+
+
+
+   DO k=1, kde-1
+    grid%dnw(k) = grid%znw(k+1) - grid%znw(k)
+    grid%rdnw(k) = 1./grid%dnw(k)
+    grid%znu(k) = 0.5*(grid%znw(k+1)+grid%znw(k))
+   ENDDO
+   DO k=2, kde-1
+    grid%dn(k) = 0.5*(grid%dnw(k)+grid%dnw(k-1))
+    grid%rdn(k) = 1./grid%dn(k)
+    grid%fnp(k) = .5* grid%dnw(k  )/grid%dn(k)
+    grid%fnm(k) = .5* grid%dnw(k-1)/grid%dn(k)
+   ENDDO
+
+   cof1 = (2.*grid%dn(2)+grid%dn(3))/(grid%dn(2)+grid%dn(3))*grid%dnw(1)/grid%dn(2) 
+   cof2 =     grid%dn(2)        /(grid%dn(2)+grid%dn(3))*grid%dnw(1)/grid%dn(3) 
+   grid%cf1  = grid%fnp(2) + cof1
+   grid%cf2  = grid%fnm(2) - cof1 - cof2
+   grid%cf3  = cof2       
+
+   grid%cfn  = (.5*grid%dnw(kde-1)+grid%dn(kde-1))/grid%dn(kde-1)
+   grid%cfn1 = -.5*grid%dnw(kde-1)/grid%dn(kde-1)
+   grid%rdx = 1./config_flags%dx
+   grid%rdy = 1./config_flags%dy
+
+!  get the sounding from the ascii sounding file, first get dry sounding and 
+!  calculate base state
+
+  dry_sounding = .true.
+  IF ( wrf_dm_on_monitor() ) THEN
+  write(6,*) ' getting dry sounding for base state '
+
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+  ENDIF
+  CALL wrf_dm_bcast_real( zk , nl_max )
+  CALL wrf_dm_bcast_real( p_in , nl_max )
+  CALL wrf_dm_bcast_real( pd_in , nl_max )
+  CALL wrf_dm_bcast_real( theta , nl_max )
+  CALL wrf_dm_bcast_real( rho , nl_max )
+  CALL wrf_dm_bcast_real( u , nl_max )
+  CALL wrf_dm_bcast_real( v , nl_max )
+  CALL wrf_dm_bcast_real( qv , nl_max )
+  CALL wrf_dm_bcast_integer ( nl_in , 1 ) 
+
+  write(6,*) ' returned from reading sounding, nl_in is ',nl_in
+
+!!MARS
+!!MARS
+  open(unit=14,file='input_coord',form='formatted',status='old')
+  rewind(14)
+  read(14,*) lon_input
+  read(14,*) lat_input
+  close(14)
+  write(6,*) ' lon is ',lon_input
+  write(6,*) ' lat is ',lat_input
+!!MARS
+!!MARS
+
+!!MARS
+!!MARS
+  open(unit=18,file='input_more',form='formatted',status='old')
+  rewind(18)
+  read(18,*) alt_input, tsurf_input
+  close(18)
+  write(6,*) ' alt is ',alt_input
+  write(6,*) ' tsurf is ',tsurf_input
+!!MARS
+!!MARS
+
+!  find ptop for the desired ztop (ztop is input from the namelist),
+!  and find surface pressure
+
+  write(6,*) ' ztop above ground is ',config_flags%ztop
+  write(6,*) ' real ztop is ',config_flags%ztop + alt_input
+  grid%p_top = interp_0( p_in, zk, config_flags%ztop + alt_input, nl_in )
+
+  DO j=jts,jte
+  DO i=its,ite
+!!MARS
+    grid%ht(i,j) = alt_input
+    grid%m_tsurf(i,j) = tsurf_input
+!!MARS
+    grid%xlat(i,j) = lat_input !+ float(j)*config_flags%dy/59000.
+    grid%xlong(i,j) = lon_input !+ float(i)*config_flags%dx/59000.
+    grid%m_emiss(i,j)=0.95
+    grid%m_co2ice(i,j)=0.
+    grid%m_h2oice(i,j)=0.
+!! >> Used for restarts only:
+    grid%m_q2(i,:,j)=0.
+    grid%m_fluxrad(i,j)=0.
+    grid%m_wstar(i,j)=0.
+!! <<
+    grid%slpx(i,j) = 0.
+    grid%slpy(i,j) = 0.
+   DO k=1,config_flags%num_soil_layers
+    grid%m_tsoil(i,k,j) = 0.
+   ENDDO
+    grid%m_gw(i,1,j) = 0.
+    grid%m_gw(i,2,j) = 0.
+    grid%m_gw(i,3,j) = 0.
+    grid%m_gw(i,4,j) = 0.
+    grid%m_gw(i,5,j) = 0.
+!!MARS
+  ENDDO
+  ENDDO
+
+  xs=ide/2 -3
+  xs=ids   -3
+  xe=xs + 6
+  ys=jde/2 -3
+  ye=ys + 6
+  mtn_ht = 500
+#ifdef MTN
+  DO j=max(ys,jds),min(ye,jde-1)
+  DO i=max(xs,ids),min(xe,ide-1)
+     grid%ht(i,j) = alt_input + mtn_ht * 0.25 * &
+               ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) * &
+               ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+#ifdef EW_RIDGE
+  DO j=max(ys,jds),min(ye,jde-1)
+  DO i=ids,ide
+     grid%ht(i,j) = mtn_ht * 0.50 * &
+               ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+#ifdef NS_RIDGE
+  DO j=jds,jde
+  DO i=max(xs,ids),min(xe,ide-1)
+     grid%ht(i,j) = mtn_ht * 0.50 * &
+               ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) )
+  ENDDO
+  ENDDO
+#endif
+  DO j=jts,jte
+  DO i=its,ite
+    grid%phb(i,1,j) = g * grid%ht(i,j)
+    grid%ph0(i,1,j) = g * grid%ht(i,j)
+  ENDDO
+  ENDDO
+
+  IF (.not.logp) THEN
+    write(6,*) 'interpolate in p'
+  ELSE
+    write(6,*) 'interpolate in logp'
+  ENDIF
+
+  DO J = jts, jte
+  DO I = its, ite
+
+    p_surf = interp_0( p_in, zk, grid%phb(i,1,j)/g, nl_in )
+    grid%mub(i,j) = p_surf-grid%p_top
+
+!  this is dry hydrostatic sounding (base state), so given grid%p (coordinate),
+!  interp theta (from interp) and compute 1/rho from eqn. of state
+
+    DO K = 1, kte-1
+      p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top
+      grid%pb(i,k,j) = p_level
+     IF (.not.logp) THEN
+      grid%t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
+     ELSE
+      grid%t_init(i,k,j) = interp_0_log( theta, p_in, p_level, nl_in ) - t0
+     ENDIF
+      grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm
+    ENDDO
+
+!  calc hydrostatic balance (alternatively we could interp the geopotential from the
+!  sounding, but this assures that the base state is in exact hydrostatic balance with
+!  respect to the model eqns.
+
+   IF (hypsometric_opt == 1) THEN
+    DO k  = 2,kte
+      grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j)
+    ENDDO
+   ELSE IF (hypsometric_opt == 2) THEN
+    DO k = 2,kte
+      pfu = grid%mub(i,j)*grid%znw(k)   + grid%p_top
+      pfd = grid%mub(i,j)*grid%znw(k-1)   + grid%p_top
+      phm = grid%mub(i,j)*grid%znu(k-1)   + grid%p_top
+      grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu)
+    END DO
+   END IF
+
+
+  ENDDO
+  ENDDO
+  IF ( wrf_dm_on_monitor() ) THEN
+    write(6,*) ' ptop is ',grid%p_top
+    write(6,*) ' base state grid%mub(1,1), p_surf is ',grid%mub(1,1),grid%mub(1,1)+grid%p_top
+  ENDIF
+
+!  calculate full state for each column - this includes moisture.
+
+  write(6,*) ' getting moist sounding for full state '
+  dry_sounding = .false.
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+
+!  At this point grid%p_top is already set. find the DRY mass in the column 
+!  by interpolating the DRY pressure.  
+
+   pd_surf = interp_0( pd_in, zk, grid%phb(i,1,j)/g, nl_in )
+
+!  compute the perturbation mass and the full mass
+
+    grid%mu_1(i,j) = pd_surf-grid%p_top - grid%mub(i,j)
+    grid%mu_2(i,j) = grid%mu_1(i,j)
+    grid%mu0(i,j) = grid%mu_1(i,j) + grid%mub(i,j)
+
+! given the dry pressure and coordinate system, interp the potential
+! temperature and qv
+
+    do k=1,kde-1
+
+      p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
+     IF (.not.logp) THEN
+      moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
+     ELSE
+      moist(i,k,j,P_QV) = interp_0_log( qv, pd_in, p_level, nl_in )
+      grid%t_1(i,k,j)          = interp_0_log( theta, pd_in, p_level, nl_in ) - t0
+     ENDIF
+      grid%t_2(i,k,j)          = grid%t_1(i,k,j)
+      
+
+    enddo
+
+!  integrate the hydrostatic equation (from the RHS of the bigstep
+!  vertical momentum equation) down from the top to get grid%p.
+!  first from the top of the model to the top pressure
+
+    k = kte-1  ! top level
+
+    qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
+    qvf2 = 1./(1.+qvf1)
+    qvf1 = qvf1*qvf2
+
+!    grid%p(i,k,j) = - 0.5*grid%mu_1(i,j)/grid%rdnw(k)
+    grid%p(i,k,j) = - 0.5*(grid%mu_1(i,j)+qvf1*grid%mub(i,j))/grid%rdnw(k)/qvf2
+    qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+    grid%alt(i,k,j) = (r_d/p1000mb)*(grid%t_1(i,k,j)+t0)*qvf* &
+                (((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm)
+    grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j)
+
+!  down the column
+
+    do k=kte-2,1,-1
+      qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
+      qvf2 = 1./(1.+qvf1)
+      qvf1 = qvf1*qvf2
+      grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_1(i,j) + qvf1*grid%mub(i,j))/qvf2/grid%rdn(k+1)
+      qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+      grid%alt(i,k,j) = (r_d/p1000mb)*(grid%t_1(i,k,j)+t0)*qvf* &
+                  (((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm)
+      grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j)
+    enddo
+
+!  this is the hydrostatic equation used in the model after the
+!  small timesteps.  In the model, grid%al (inverse density)
+!  is computed from the geopotential.
+
+
+    grid%ph_1(i,1,j) = 0.
+   IF (hypsometric_opt == 1) THEN
+    DO k  = 2,kte
+      grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (1./grid%rdnw(k-1))*(       &
+                   (grid%mub(i,j)+grid%mu_1(i,j))*grid%al(i,k-1,j)+ &
+                    grid%mu_1(i,j)*grid%alb(i,k-1,j)  )
+                                                   
+      grid%ph_2(i,k,j) = grid%ph_1(i,k,j) 
+      grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j)
+    ENDDO
+   ELSE IF (hypsometric_opt == 2) THEN
+
+             ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure.
+             ! Note that al*p approximates Rd*T and dLOG(p) does z.
+             ! Here T varies mostly linear with z, the first-order integration produces better result.
+
+               grid%ph_2(i,1,j) = grid%phb(i,1,j)
+               DO k = 2,kte
+                  pfu = grid%mu0(i,j)*grid%znw(k)   + grid%p_top
+                  pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top
+                  phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top
+                  grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu)
+               END DO
+
+               DO k = 1,kte
+                  grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j)
+                  grid%ph_1(i,k,j) = grid%ph_2(i,k,j)
+               END DO
+
+   END IF
+
+
+
+    IF ( wrf_dm_on_monitor() ) THEN
+    if((i==2) .and. (j==2)) then
+     write(6,*) ' grid%ph_1 calc ',grid%ph_1(2,1,2),grid%ph_1(2,2,2),&
+                              grid%mu_1(2,2)+grid%mub(2,2),grid%mu_1(2,2), &
+                              grid%alb(2,1,2),grid%al(1,2,1),grid%rdnw(1)
+    endif
+    ENDIF
+
+  ENDDO
+  ENDDO
+
+!#if 0
+
+!  thermal perturbation to kick off convection
+
+  write(6,*) ' nxc, nyc for perturbation ',nxc,nyc
+  write(6,*) ' delt for perturbation ',delt
+
+! For LES, change the initial random perturbations
+! For 2D test, call randx outside I-loop
+! For 3D runs, call randx inside both I-J loops
+
+  DO J = jts, min(jde-1,jte)
+!   yrad = config_flags%dy*float(j-nyc)/10000.
+    yrad = 0.
+    DO I = its, min(ide-1,ite)
+!     xrad = config_flags%dx*float(i-nxc)/10000.
+      xrad = 0.
+      call random_number (randx)
+      randx = randx - 0.5
+!     DO K = 1, kte-1
+      DO K = 1, 4 
+
+!  No bubbles for LES!
+!  put in preturbation theta (bubble) and recalc density.  note,
+!  the mass in the column is not changing, so when theta changes,
+!  we recompute density and geopotential
+
+!       zrad = 0.5*(grid%ph_1(i,k,j)+grid%ph_1(i,k+1,j)  &
+!                  +grid%phb(i,k,j)+grid%phb(i,k+1,j))/g
+!       zrad = (zrad-1500.)/1500.
+        zrad = 0.
+        RAD=SQRT(xrad*xrad+yrad*yrad+zrad*zrad)
+        IF(RAD <= 1.) THEN
+!          grid%t_1(i,k,j)=grid%t_1(i,k,j)+delt*COS(.5*PI*RAD)**2
+           grid%t_1(i,k,j)=grid%t_1(i,k,j)+ 0.1 *randx
+           grid%t_2(i,k,j)=grid%t_1(i,k,j)
+           qvf = 1. + rvovrd*moist(i,k,j,P_QV)
+           grid%alt(i,k,j) = (r_d/p1000mb)*(grid%t_1(i,k,j)+t0)*qvf* &
+                        (((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm)
+           grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j)
+        ENDIF
+      ENDDO
+
+!  rebalance hydrostatically
+
+   IF (hypsometric_opt == 1) THEN
+
+      DO k  = 2,kte
+        grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (1./grid%rdnw(k-1))*(       &
+                     (grid%mub(i,j)+grid%mu_1(i,j))*grid%al(i,k-1,j)+ &
+                      grid%mu_1(i,j)*grid%alb(i,k-1,j)  )
+                                                   
+        grid%ph_2(i,k,j) = grid%ph_1(i,k,j) 
+        grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j)
+      ENDDO
+
+   ELSE IF (hypsometric_opt == 2) THEN
+
+             ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure.
+             ! Note that al*p approximates Rd*T and dLOG(p) does z.
+             ! Here T varies mostly linear with z, the first-order integration produces better result.
+
+               grid%ph_2(i,1,j) = grid%phb(i,1,j)
+               DO k = 2,kte
+                  pfu = grid%mu0(i,j)*grid%znw(k)   + grid%p_top
+                  pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top
+                  phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top
+                  grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu)
+               END DO
+
+               DO k = 1,kte
+                  grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j)
+                  grid%ph_1(i,k,j) = grid%ph_2(i,k,j)
+               END DO
+
+   END IF
+
+
+    ENDDO
+  ENDDO
+
+!#endif
+
+   IF ( wrf_dm_on_monitor() ) THEN
+   write(6,*) ' grid%mu_1 from comp ', grid%mu_1(1,1)
+   write(6,*) ' full state sounding from comp, ph/g, grid%p, grid%al, grid%t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, (grid%ph_1(1,k,1)+grid%phb(1,k,1))/g, &
+                                      grid%p(1,k,1)+grid%pb(1,k,1), grid%alt(1,k,1), &
+                                      grid%t_1(1,k,1)+t0, moist(1,k,1,P_QV)
+   enddo
+
+   write(6,*) ' pert state sounding from comp, grid%ph_1, pp, alp, grid%t_1, qv '
+   do k=1,kde-1
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%ph_1(1,k,1), &
+                                      grid%p(1,k,1), grid%al(1,k,1), &
+                                      grid%t_1(1,k,1), moist(1,k,1,P_QV)
+   enddo
+   ENDIF
+
+! interp v
+
+  DO J = jts, jte
+  DO I = its, min(ide-1,ite)
+
+    IF (j == jds) THEN
+      z_at_v = grid%phb(i,1,j)/g
+    ELSE IF (j == jde) THEN
+      z_at_v = grid%phb(i,1,j-1)/g
+    ELSE
+      z_at_v = 0.5*(grid%phb(i,1,j)+grid%phb(i,1,j-1))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_v, nl_in )
+
+    DO K = 1, kte-1
+      p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top
+     IF (.not.logp) THEN
+      grid%v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in )
+     ELSE
+      grid%v_1(i,k,j) = interp_0_log( v, p_in, p_level, nl_in )
+     ENDIF
+      grid%v_2(i,k,j) = grid%v_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+! interp u
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, ite
+
+    IF (i == ids) THEN
+      z_at_u = grid%phb(i,1,j)/g
+    ELSE IF (i == ide) THEN
+      z_at_u = grid%phb(i-1,1,j)/g
+    ELSE
+      z_at_u = 0.5*(grid%phb(i,1,j)+grid%phb(i-1,1,j))/g
+    END IF
+
+    p_surf = interp_0( p_in, zk, z_at_u, nl_in )
+
+    DO K = 1, kte-1
+      p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top
+     IF (.not.logp) THEN
+      grid%u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
+     ELSE
+      grid%u_1(i,k,j) = interp_0_log( u, p_in, p_level, nl_in )
+     ENDIF
+      grid%u_2(i,k,j) = grid%u_1(i,k,j)
+    ENDDO
+
+  ENDDO
+  ENDDO
+
+!  set w
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte
+  DO I = its, min(ide-1,ite)
+    grid%w_1(i,k,j) = 0.
+    grid%w_2(i,k,j) = 0.
+  ENDDO
+  ENDDO
+  ENDDO
+
+!!!MARS MARS
+IF (config_flags%init_MU .ne. 0.) THEN
+  grid%u_1 = grid%u_1*config_flags%init_MU
+  grid%u_2 = grid%u_2*config_flags%init_MU
+  print *, 'multiply zonal wind ', config_flags%init_MU
+ENDIF
+IF (config_flags%init_MV .ne. 0.) THEN
+  grid%v_1 = grid%v_1*config_flags%init_MV
+  grid%v_2 = grid%v_2*config_flags%init_MV
+  print *, 'multiply meridional wind ', config_flags%init_MV
+ENDIF
+IF (config_flags%init_U .ne. 0.) THEN
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%u_1(i,k,j) = config_flags%init_U
+    grid%u_2(i,k,j) = config_flags%init_U
+  ENDDO
+  ENDDO
+  ENDDO
+  print *, 'constant zonal wind ', config_flags%init_U
+  !!! ****** ou autre possibilité
+  !!! >   grid%u_1 = grid%u_1*0. + config_flags%init_U
+  !!! >   grid%u_2 = grid%u_2*0. + config_flags%init_U
+ENDIF
+IF (config_flags%init_V .ne. 0.) THEN
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%v_1(i,k,j) = config_flags%init_V
+    grid%v_2(i,k,j) = config_flags%init_V
+  ENDDO
+  ENDDO
+  ENDDO
+  print *, 'constant meridional wind ', config_flags%init_V
+ENDIF
+
+!!!MARS MARS
+
+
+!  set a few more things
+
+  DO J = jts, min(jde-1,jte)
+  DO K = kts, kte-1
+  DO I = its, min(ide-1,ite)
+    grid%h_diabatic(i,k,j) = 0.
+      !!!!! MARS NO WIND CASE
+      !grid%u_1(i,k,j) = 0.
+      !grid%u_2(i,k,j) = 0.
+      !grid%v_1(i,k,j) = 0.
+      !grid%v_2(i,k,j) = 0.
+      !!!!! MARS NO WIND CASE
+  ENDDO
+  ENDDO
+  ENDDO
+
+  IF ( wrf_dm_on_monitor() ) THEN
+  DO k=1,kte-1
+    grid%t_base(k) = grid%t_1(1,k,1)
+    grid%qv_base(k) = moist(1,k,1,P_QV)
+    grid%u_base(k) = grid%u_1(1,k,1)
+    grid%v_base(k) = grid%v_1(1,k,1)
+    grid%z_base(k) = 0.5*(grid%phb(1,k,1)+grid%phb(1,k+1,1)+grid%ph_1(1,k,1)+grid%ph_1(1,k+1,1))/g
+
+!!!!! MARS SIMPLE LES (PURE BUOYANCY)
+!!      grid%t_base(k)  = grid%t_init(its,k,jts)
+!      grid%t_base(k) = 0.
+!      grid%qv_base(k) = 0.
+!      grid%u_base(k)  = 0.
+!      grid%v_base(k)  = 0.
+!      grid%z_base(k) = 0.
+!!!!! MARS SIMPLE LES
+
+  ENDDO
+  ENDIF
+  CALL wrf_dm_bcast_real( grid%t_base , kte )
+  CALL wrf_dm_bcast_real( grid%qv_base , kte )
+  CALL wrf_dm_bcast_real( grid%u_base , kte )
+  CALL wrf_dm_bcast_real( grid%v_base , kte )
+  CALL wrf_dm_bcast_real( grid%z_base , kte )
+
+  DO J = jts, min(jde-1,jte)
+  DO I = its, min(ide-1,ite)
+     thtmp   = grid%t_2(i,1,j)+t0
+     ptmp    = grid%p(i,1,j)+grid%pb(i,1,j)
+     temp(1) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%t_2(i,2,j)+t0
+     ptmp    = grid%p(i,2,j)+grid%pb(i,2,j)
+     temp(2) = thtmp * (ptmp/p1000mb)**rcp
+     thtmp   = grid%t_2(i,3,j)+t0
+     ptmp    = grid%p(i,3,j)+grid%pb(i,3,j)
+     temp(3) = thtmp * (ptmp/p1000mb)**rcp
+
+!!    For LES-CBL, add 5 degrees to the surface temperature!
+!!
+!     grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)
+!!     grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)+5.
+     grid%tmn(I,J)=grid%tsk(I,J)-0.5
+
+  ENDDO
+  ENDDO
+
+!!!!! MARS 
+
+    ! interpolate water vapor
+    if (      ( config_flags%mars == 1  ) &
+         .OR. ( config_flags%mars == 11 ) &
+         .OR. ( config_flags%mars == 12 ) ) then
+      print *, '**** INTERPOLATE HV **** RANK 2 in SCALAR'
+      DO k=1,kte-1
+         p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
+        IF (.not.logp) THEN
+         scalar(its:ite,k,jts:jte,2) = interp_0( qv, pd_in, p_level, nl_in )
+        ELSE
+         scalar(its:ite,k,jts:jte,2) = interp_0_log( qv, pd_in, p_level, nl_in )
+        ENDIF
+         scalar(its:ite,k,jts:jte,3) = 0.
+           !! water ice is set to 0 (was put into water vapor when building prof from MCD)
+      ENDDO
+      print *, "WATER VAPOR",scalar(its,:,jts,2)
+    endif
+
+    ! interpolate qdust
+    if (      ( config_flags%mars == 11 ) &
+         .OR. ( config_flags%mars == 12 ) ) then
+      call read_dust(profdustq,profdustn,nl_in)
+      print *, '**** INTERPOLATE DUSTQ **** RANK 4 in SCALAR'
+      print *, '**** INTERPOLATE DUSTN **** RANK 5 in SCALAR'
+      DO k=1,kte-1
+         p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
+        IF (.not.logp) THEN
+         scalar(its:ite,k,jts:jte,4) = interp_0( profdustq, pd_in, p_level,nl_in )
+         scalar(its:ite,k,jts:jte,5) = interp_0( profdustn, pd_in, p_level,nl_in )
+        ELSE
+         scalar(its:ite,k,jts:jte,4) = interp_0_log( profdustq, pd_in, p_level, nl_in )
+         scalar(its:ite,k,jts:jte,5) = interp_0_log( profdustn, pd_in, p_level, nl_in )
+        ENDIF
+      ENDDO
+      print *, "DUST Q", scalar(its,:,jts,4)
+      print *, "DUST N", scalar(its,:,jts,5)
+    endif
+
+    if ( config_flags%mars == 12 ) then
+      scalar(its:ite,1:kte-1,jts:jte,6) = 0.
+      scalar(its:ite,1:kte-1,jts:jte,7) = 0.
+    endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   IF (planet .ne. "mars") THEN
+    call read_dust(profdustq,profdustn,nl_in)
+    DO k=1,kte!-1
+       p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
+       DO j = jts, jte
+       DO i = its, ite
+         !!! we use Q2 as a vehicle for heating rates! sick!
+         grid%m_q2(i,k,j) = interp_0_log( profdustq, pd_in, p_level, nl_in ) &
+                          + interp_0_log( profdustn, pd_in, p_level, nl_in )
+       ENDDO
+       ENDDO
+       !print*,'grid%m_q2' 
+       !print*,k,grid%m_q2(1,k,1)
+    ENDDO
+   ENDIF
+
+    IF (planet.eq."prescribed") Then
+      call read_hr(hrsw,hrlw,hrdyn,nl_in)
+      open(unit=17,file="prescribed_sw.txt",action="write")
+      open(unit=18,file="prescribed_lw.txt",action="write")
+      open(unit=19,file="prescribed_dyn.txt",action="write")
+      DO k=1,kte!-1
+        p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
+        prescribed_sw(k) = interp_0_log( hrsw, pd_in, p_level, nl_in )
+        prescribed_lw(k) = interp_0_log( hrlw, pd_in, p_level, nl_in )
+        prescribed_dyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in )
+        write (17,*) prescribed_sw(k)
+        write (18,*) prescribed_lw(k)
+        write (19,*) prescribed_dyn(k)
+      ENDDO
+      close(unit=19)
+      close(unit=18)
+      close(unit=17)
+    ENDIF
+    
+    IF (planet.eq."venus") Then
+      call read_hr(hrsw,hrlw,hrdyn,nl_in)
+      open(unit=20,file="venus_hrdyn.txt",action="write")
+      DO k=1,kte!-1
+        p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
+        venus_hrdyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in )
+        write (20,*) venus_hrdyn(k)
+      ENDDO
+      close(unit=20)
+    ENDIF
+
+    IF (planet.eq."generic") THEN
+      call read_lsf(lsfdt,lsfdq,nl_in)
+      open(unit=17,file="lsf.txt",action="write")
+      DO k=1,kte!-1
+        p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
+        lsf_dt = interp_0_log( lsfdt, pd_in, p_level, nl_in )
+        lsf_dq = interp_0_log( lsfdq, pd_in, p_level, nl_in )
+        write (17,*) lsf_dt(k),lsf_dq(k)
+      ENDDO
+    ENDIF
+
+    IF ((planet.eq."venus") .AND. ( config_flags%mars == 34 )) Then
+       pd_in8(:)=pd_in(:)
+       do i = 1,34
+         call read_tracer(trac,num_scalar,i,nl_in)
+         DO k=1,kte-1
+           p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
+           p_level8=p_level
+           scalar(its:ite,k,jts:jte,i+1) =  interp_0_log2( trac, pd_in8, p_level8, nl_in )
+         ENDDO
+       ENDDO
+       !close(unit=22)
+    ENDIF
+
+    open(unit=21,file="altitude.txt",action="write")
+    DO k=1,kte!-1
+      p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
+      altitude(k) = interp_0_log( zk, pd_in, p_level, nl_in )
+      write (21,*) altitude(k)
+    ENDDO
+    close(unit=21)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!! MARS 
+
+
+ END SUBROUTINE init_domain_rk
+
+   SUBROUTINE init_module_initialize
+   END SUBROUTINE init_module_initialize
+
+!---------------------------------------------------------------------
+
+!  test driver for get_sounding
+!
+!      implicit none
+!      integer n
+!      parameter(n = 1000)
+!      real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n)
+!      logical dry
+!      integer nl,k
+!
+!      dry = .false.
+!      dry = .true.
+!      call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl )
+!      write(6,*) ' input levels ',nl
+!      write(6,*) ' sounding '
+!      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+!      do k=1,nl
+!        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k)
+!      enddo
+!      end
+!
+!---------------------------------------------------------------------------
+
+      subroutine get_sounding( zk, p, p_dry, theta, rho, &
+                               u, v, qv, dry, nl_max, nl_in )
+      implicit none
+
+      integer nl_max, nl_in
+      real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), &
+           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
+      logical dry
+
+      integer n
+      parameter(n=1000)
+      logical debug
+      parameter( debug = .true.)
+
+! input sounding data
+
+      real p_surf, th_surf, qv_surf
+      real pi_surf, pi(n)
+      real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n)
+
+! input therm data (element 0 is the ground so it's n+1 but n is 1000 anyway so...)
+
+     real r_therm(n),cp_therm(n),p_therm(n),rho_therm(n),t_therm(n)
+
+! diagnostics
+
+      real rho_surf, p_input(n), rho_input(n)
+      real pm_input(n)  !  this are for full moist sounding
+
+! local data
+
+!      real p1000mb,cv,cp,r,cvpm,g
+!      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
+!      parameter (p1000mb = 610., r = 192., cp = 844.6, cv = cp-r, cvpm = -cv/cp, g=3.72)
+!      parameter (p1000mb = 610., r = 191., cp = 744.5, cv = cp-r, cvpm = -cv/cp, g=3.72)
+       !parameter (p1000mb = 92.e+05, r = 192., cp = 900.0, cv = cp-r, cvpm = -cv/cp, g=8.87)
+      integer k, it, nl
+      real qvf, qvf1, dz
+
+      LOGICAL :: direct_from_file
+
+      IF (planet == "mars") THEN
+        direct_from_file = .false.
+      ELSE
+        direct_from_file = .true.
+      ENDIF
+
+!  first, read the sounding
+
+      call read_sounding( p_surf, th_surf, qv_surf, &
+                          h_input, th_input, qv_input, &
+                          u_input, v_input,n, nl, debug )
+
+! and the therm :
+
+      call read_therm(r_therm,cp_therm,p_therm,rho_therm,t_therm,n)
+
+      if(debug) write(6,*) ' number of input levels = ',nl
+      nl_in = nl
+      if(nl_in .gt. nl_max ) then
+        write(6,*) ' too many levels for input arrays ',nl_in,nl_max
+        call wrf_error_fatal ( ' too many levels for input arrays ' )
+      end if
+
+      IF (.NOT. direct_from_file) THEN
+
+! To use r/cp as defined above, one has to recompute teta from T (default MCD computes
+! teta for a variable r/cp)
+
+      do k=1,nl
+        th_input(k) = t_therm(k)*(p1000mb/p_therm(k))**(rcp)
+      enddo
+      th_surf = t_therm(1)*(p1000mb/p_therm(1))**(rcp)
+! -----
+
+      !if(dry) then
+      ! do k=1,nl
+      !   qv_input(k) = 0.
+      ! enddo
+      !endif
+
+!  compute diagnostics,
+!  first, convert qv(g/kg) to qv(g/g)
+
+      do k=1,nl
+        !!!!!!!!!!!!!! MARS
+        !! from mol/mol to kg/kg
+        qv_input(k) = qv_input(k)*18./mwdry
+        qv_input(k) = 0.001*qv_input(k)
+      enddo
+
+      p_surf = 100.*p_surf  ! convert to pascals
+      qvf = 1. + rvovrd*qv_input(1) 
+!!MARS
+      qvf = 1.
+      rho_surf = 1./((r_d/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
+      pi_surf = (p_surf/p1000mb)**(rcp)
+
+      if(debug) then
+        write(6,*) ' surface density is ',rho_surf
+        write(6,*) ' surface pi is      ',pi_surf
+      end if
+
+
+!  integrate moist sounding hydrostatically, starting from the
+!  specified surface pressure
+!  -> first, integrate from surface to lowest level
+
+          qvf = 1. + rvovrd*qv_input(1) 
+          qvf1 = 1. + qv_input(1)
+!!MARS
+          qvf = 1.
+          qvf1 = 1.
+          rho_input(1) = rho_surf
+          dz = h_input(1)
+          do it=1,10
+!            pm_input(1) = p_surf &
+!                    - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1
+!!!MARS MARS MARS
+            pm_input(1) = p_surf 
+            rho_input(1) = 1./((r_d/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm))
+          enddo
+
+! integrate up the column
+
+          do k=2,nl
+            rho_input(k) = rho_input(k-1)
+            dz = h_input(k)-h_input(k-1)
+            qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k)))
+            qvf = 1. + rvovrd*qv_input(k)   ! qv is in g/kg here
+!!MARS
+          qvf = 1.
+          qvf1 = 1.
+!!MARS 
+
+            do it=1,10
+              pm_input(k) = pm_input(k-1) &
+                      - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
+              rho_input(k) = 1./((r_d/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
+            enddo
+          enddo
+
+!  we have the moist sounding
+
+!  next, compute the dry sounding using p at the highest level from the
+!  moist sounding and integrating down.
+
+        p_input(nl) = pm_input(nl)
+
+          do k=nl-1,1,-1
+            dz = h_input(k+1)-h_input(k)
+            p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g
+          enddo
+
+      ELSE !IF (.NOT. direct_from_file) THEN
+        
+        do k=1,nl
+         !!!! direct input from file
+         write(6,*) '*** DIRECT INPUT FROM FILE ***'
+         pm_input(k) = p_therm(k)
+         p_input(k) = p_therm(k)
+         rho_input(k) = rho_therm(k)
+        enddo
+
+      ENDIF
+
+
+        do k=1,nl
+
+          zk(k) = h_input(k)
+          p(k) = pm_input(k)
+          p_dry(k) = p_input(k)
+          theta(k) = th_input(k)
+          rho(k) = rho_input(k)
+          u(k) = u_input(k)
+          v(k) = v_input(k)
+          qv(k) = qv_input(k)
+
+        enddo
+
+     if(debug) then
+      write(6,*) ' sounding '
+      write(6,*) '  k  height(m)  press (Pa) pd(Pa) theta (K) den(kg/m^3)  u(m/s)     v(m/s)    qv(g/g) '
+      do k=1,nl
+        write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k)
+      enddo
+
+     end if
+
+      end subroutine get_sounding
+
+!-------------------------------------------------------
+
+      subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,n,nl,debug )
+      implicit none
+      integer n,nl
+      real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n)
+      logical end_of_file
+      logical debug
+
+      integer k
+
+      open(unit=10,file='input_sounding',form='formatted',status='old')
+      rewind(10)
+      read(10,*) ps, ts, qvs
+      if(debug) then
+        write(6,*) ' input sounding surface parameters '
+        write(6,*) ' surface pressure (mb) ',ps
+        write(6,*) ' surface pot. temp (K) ',ts
+        write(6,*) ' surface mixing ratio (g/kg) ',qvs
+      end if
+
+      end_of_file = .false.
+      k = 0
+
+      do while (.not. end_of_file)
+
+        read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1)
+        k = k+1
+        if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k)
+        go to 110
+ 100    end_of_file = .true.
+ 110    continue
+      enddo
+
+      nl = k
+
+      close(unit=10,status = 'keep')
+
+      end subroutine read_sounding
+
+      subroutine read_therm(r,cp,p,rho,t,n)
+      implicit none
+      integer n
+      real r(n),cp(n),p(n),rho(n),t(n)
+      logical end_of_file
+
+      integer k
+
+! first element is the surface
+
+      open(unit=11,file='input_therm',form='formatted',status='old')
+      rewind(11)
+      end_of_file = .false.
+      k = 0
+      do while (.not. end_of_file)
+
+        read(11,*,end=101) r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1)
+        write(*,*) k, r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1)
+        k = k+1
+        go to 112
+ 101    end_of_file = .true.
+ 112    continue
+      enddo
+
+      close(unit=11,status = 'keep')
+
+      end subroutine read_therm
+
+!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      subroutine read_dust(pdustq,pdustn,n)
+      implicit none
+      integer n
+      real pdustq(n+1),pdustn(n+1)
+      logical end_of_file
+
+      integer k
+
+! first element is the surface
+
+      open(unit=11,file='input_dust',form='formatted',status='old')
+      rewind(11)
+      end_of_file = .false.
+      k = 0
+      do while (.not. end_of_file)
+
+        read(11,*,end=102) pdustq(k+1),pdustn(k+1)
+        write(*,*) k,pdustq(k+1),pdustn(k+1)
+        k = k+1
+        go to 113
+ 102    end_of_file = .true.
+ 113    continue
+      enddo
+
+      close(unit=11,status = 'keep')
+
+      end subroutine read_dust
+!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      subroutine read_hr(hr_sw,hr_lw,hr_dyn,n)
+      implicit none
+      integer n
+      real hr_sw(n+1),hr_lw(n+1),hr_dyn(n+1)
+      logical end_of_file
+
+      integer k
+
+! first element is the surface
+
+      open(unit=11,file='input_hr',form='formatted',status='old')
+      rewind(11)
+      end_of_file = .false.
+      k = 0
+      do while (.not. end_of_file)
+
+        read(11,*,end=103) hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1)
+        write(*,*) k,hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1)
+        k = k+1
+        go to 114
+ 103    end_of_file = .true.
+ 114    continue
+      enddo
+
+      close(unit=11,status = 'keep')
+
+      end subroutine read_hr
+
+      subroutine read_lsf(dt,dq,n)
+      implicit none
+      integer n
+      real dt(n+1),dq(n+1)
+      logical end_of_file
+
+      integer k
+
+! first element is the surface
+
+      open(unit=12,file='input_lsf',form='formatted',status='old')
+      rewind(12)
+      end_of_file = .false.
+      k = 0
+      do while (.not. end_of_file)
+
+        read(12,*,end=103) dt(k+1),dq(k+1)
+        write(*,*) k,dt(k+1),dq(k+1)
+        k = k+1
+        go to 114
+ 103    end_of_file = .true.
+ 114    continue
+      enddo
+
+      close(unit=12,status = 'keep')
+
+      end subroutine read_lsf
+
+      subroutine read_tracer(trace,nq,qn,n)
+      implicit none
+      integer n,qn,nq ! qn : number of the tracer
+      real*8 tra(nq-1,n+1)
+      real*8 trace(n+1) !output
+      logical end_of_file
+
+      integer k,j
+
+! first element is the surface
+      open(unit=14,file='input_tracer',form='formatted',status='old')
+      rewind(14)
+      end_of_file = .false.
+        DO k=1,n
+          read(14,*) tra(:,k)
+          write(*,*) k,tra(qn,k)
+      ENDDO
+
+      close(14)
+      trace(:)=tra(qn,:)
+      end subroutine read_tracer
+
+
+END MODULE module_initialize_ideal
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_lmd_driver.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_lmd_driver.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_lmd_driver.F	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/phys/module_lmd_driver.F
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_lmd_driver.F.bak
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_lmd_driver.F.bak	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_lmd_driver.F.bak	(revision 2744)
@@ -0,0 +1,977 @@
+!*******************************************************************************
+! PURPOSE: LMD_driver is the WRF mediation layer routine that provides the
+! interface to LMD physics packages in the WRF model layer. For those familiar
+! with the LMD GCM, the aim of this driver is to do part of the job of the
+! calfis.F routine.
+!*******************************************************************************
+! AUTHOR: A. Spiga - January 2007
+!*******************************************************************************
+! UPDATES:  - included all final updates for the paper - March 2008
+!           - general cleaning of code and comments - October 2008 
+!*******************************************************************************
+MODULE module_lmd_driver
+CONTAINS
+    SUBROUTINE lmd_driver(id,max_dom,DT,ITIMESTEP,XLAT,XLONG, &
+        IDS,IDE,JDS,JDE,KDS,KDE,IMS,IME,JMS,JME,KMS,KME, &
+        i_start,i_end,j_start,j_end,kts,kte,num_tiles, &
+        DX,DY, &
+        MSFT,MSFU,MSFV, &
+        GMT,JULYR,JULDAY, &
+        P8W,DZ8W,T8W,Z,HT, &
+        U,V,TH,T,P,EXNER,RHO, &
+        PTOP, &
+        RADT,CUDT, &
+        TSK,PSFC, &
+        RTHBLTEN,RUBLTEN,RVBLTEN, &
+        num_3d_s,SCALAR, &
+        MARS_MODE, &
+        MARS_ALB,MARS_TI,MARS_CICE,MARS_EMISS, &
+        MARS_TSOIL, &
+        MARS_GW, &
+        NUM_SOIL_LAYERS, &
+        CST_AL, &
+        CST_TI, &
+        isfflx, &
+#include "../modif_mars/module_lmd_driver_output1.inc"
+        SLPX,SLPY)
+! NB: module_lmd_driver_output1.inc : output arguments generated from Registry
+
+!        IPS,IPE,JPS,JPE,KPS,KPE, &
+
+
+
+!==================================================================
+! USES
+!==================================================================
+   USE module_model_constants
+   USE module_wrf_error
+! add new modules here, if needed ...
+
+!==================================================================
+  IMPLICIT NONE
+!==================================================================
+
+!==================================================================
+! COMMON
+!==================================================================
+
+!! the only common needed is the one defining the physical grid
+!! -- path is hardcoded, but the structure is not subject to change
+!! -- please put # if needed by the pre-compilation process	
+!
+!
+include "../modif_mars/dimphys.h"
+!
+!--to be commented because there are tests in the physics ?
+!--TODO: get rid of the ...mx first in this routine and .inc
+
+!
+! INCLUDE AUTOMATIQUEMENT GENERE A PARTIR DU REGISTRY
+!
+include "../modif_mars/wrf_output_2d.h"
+include "../modif_mars/wrf_output_3d.h"
+
+!==================================================================
+! VARIABLES
+!==================================================================
+
+! WRF Dimensions
+INTEGER, INTENT(IN   )    ::   &
+      ids,ide,jds,jde,kds,kde, &
+      ims,ime,jms,jme,kms,kme, &
+!      ips,ipe,jps,jpe,kps,kpe, &
+            kts,kte,num_tiles, &
+              NUM_SOIL_LAYERS
+INTEGER, DIMENSION(num_tiles), INTENT(IN) ::  &
+      i_start,i_end,j_start,j_end   
+! Scalars
+INTEGER, INTENT(IN  ) :: JULDAY, itimestep, julyr,id,max_dom,MARS_MODE,isfflx
+REAL, INTENT(IN  ) :: GMT,dt,dx,dy,RADT,CUDT
+REAL, INTENT(IN  ) :: CST_AL, CST_TI 
+REAL, INTENT(IN  ) :: PTOP
+! 2D arrays          
+REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   )  :: &
+     MSFT,MSFU,MSFV, &
+     XLAT,XLONG,HT,  &
+     MARS_ALB,MARS_TI,MARS_EMISS,MARS_CICE, &
+     SLPX,SLPY
+! 3D arrays 
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: &
+     dz8w,p8w,p,exner,t,t8w,rho,u,v,z,th
+REAL, DIMENSION( ims:ime, NUM_SOIL_LAYERS, jms:jme ), INTENT(IN   )  :: &
+     MARS_TSOIL 
+REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: &
+     MARS_GW
+! 4D arrays
+INTEGER, INTENT(IN ) :: num_3d_s
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:num_3d_s ), INTENT(INOUT ) :: &
+     scalar
+
+!-------------------------------------------
+! OUTPUT VARIABLES
+!-------------------------------------------
+!
+! Generated from Registry
+!
+! default definitions :
+! 2D : TSK, PSFC
+! 3D : RTHBLTEN,RUBLTEN,RVBLTEN
+#include "../modif_mars/module_lmd_driver_output2.inc"
+   REAL, DIMENSION(:,:), ALLOCATABLE :: output_tab2d
+   REAL, DIMENSION(:,:,:), ALLOCATABLE :: output_tab3d
+!-------------------------------------------
+! OUTPUT VARIABLES
+!-------------------------------------------
+
+
+!-------------------------------------------   
+! LOCAL  VARIABLES
+!-------------------------------------------
+   INTEGER ::    i,j,k,ij  
+   INTEGER ::    its,ite,jts,jte
+   INTEGER ::    subs
+
+   ! *** for LMD physics
+   ! ------> inputs:
+   INTEGER :: ngrid,nlayer,nq,nsoil,nqmx 
+   REAL :: pday,ptime,MY  
+   REAL :: aire_val,lat_val,lon_val
+   REAL :: phisfi_val,albedodat_val,inertiedat_val
+   REAL :: tsurf_val,co2ice_val,emis_val
+   REAL :: zmea_val,zstd_val,zsig_val,zgam_val,zthe_val
+   REAL :: theta_val, psi_val
+   LOGICAL :: firstcall,lastcall,tracerdyn
+   REAL,DIMENSION(:),ALLOCATABLE :: q2_val, qsurf_val, tsoil_val
+   REAL,DIMENSION(:),ALLOCATABLE :: aire_vec,lat_vec,lon_vec
+   REAL,DIMENSION(:),ALLOCATABLE :: walbedodat,winertiedat,wphisfi
+   REAL,DIMENSION(:),ALLOCATABLE :: wzmea,wzstd,wzsig,wzgam,wzthe
+   REAL,DIMENSION(:),ALLOCATABLE :: wtheta, wpsi
+   ! v--- can they be modified ?
+   REAL,DIMENSION(:),ALLOCATABLE :: wtsurf,wco2ice,wemis
+   REAL,DIMENSION(:,:),ALLOCATABLE :: wq2,wqsurf,wtsoil 
+   ! ----------	
+   REAL,DIMENSION(:,:),ALLOCATABLE :: pplev,pplay,pphi,pu,pv,pt,pw
+   REAL,DIMENSION(:,:,:),ALLOCATABLE :: pq  
+
+   ! <------ outputs:
+   !     physical tendencies
+   REAL,DIMENSION(:),ALLOCATABLE :: pdpsrf
+   REAL,DIMENSION(:,:),ALLOCATABLE :: pdu,pdv,pdt
+   REAL,DIMENSION(:,:,:),ALLOCATABLE :: pdq
+   ! ... intermediate arrays
+   REAL, DIMENSION(:), ALLOCATABLE  :: &
+     dz8w_prof,p8w_prof,p_prof,t_prof,t8w_prof, &
+     u_prof,v_prof,z_prof, &
+     water_vapor_prof, water_ice_prof
+!!   pi_prof, rho_prof, th_prof, &
+
+   ! Additional control variables
+   INTEGER :: sponge_top,relax,ips,ipe,jps,jpe,kps,kpe
+   REAL :: elaps, ptimestep, wecri_phys_sec
+   INTEGER :: wappel_phys, wecri_phys, wday_ini, test
+   LOGICAL :: flag_LES
+
+!**************************************************
+! IMPORTANT: pour travailler avec grid nesting
+!       mieux vaut ne pas utiliser de SAVE ??
+!**************************************************
+      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: &
+             dp_save
+      REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: &
+             du_save, dv_save, dt_save
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: &
+             dq_save      
+
+!!!IDEALIZED IDEALIZED
+      REAL :: lat_input, lon_input, ls_input, lct_input
+!!!IDEALIZED IDEALIZED
+
+
+
+!==================================================================
+! CODE
+!==================================================================
+
+!! SPECIAL LES
+IF (isfflx .ne. 0) THEN
+     flag_LES = .true.
+ELSE
+     flag_LES = .false.
+ENDIF
+!! SPECIAL LES
+
+print *,'** Mars ** DOMAIN',id
+
+!-------------------------!
+! TWEAK on WRF DIMENSIONS !
+!-------------------------!
+its = i_start(1)   ! define here one big tile
+ite = i_end(num_tiles)
+jts = j_start(1)
+jte = j_end(num_tiles)
+!!
+!relax=0
+!sponge_top=0               ! another value than 0 triggers instabilities  
+!IF (id .gt. 1) relax=2     ! fix to avoid noise in nesting simulations ; 1 >> too much noise ...
+ips=its
+ipe=ite
+jps=jts
+jpe=jte
+!IF (ips .eq. ids)   ips=its+relax !! IF tests necesary for parallel runs
+!IF (ipe .eq. ide-1) ipe=ite-relax
+!IF (jps .eq. jds)   jps=jts+relax
+!IF (jpe .eq. jde-1) jpe=jte-relax
+kps=kts         !! start at surface 
+kpe=kte !-sponge_top
+
+!----------------------------!
+! DIMENSIONS FOR THE PHYSICS !
+!----------------------------!
+wday_ini = JULDAY - 1      !! GCM convention
+wappel_phys = int(RADT)
+wecri_phys = int(CUDT)
+ptimestep = dt*float(wappel_phys)     ! physical timestep (s)
+ngrid=(ipe-ips+1)*(jpe-jps+1)         ! size of the horizontal grid: ngridmx = wiim * wjjm
+nlayer = kpe-kps+1                    ! number of vertical layers: nlayermx
+nsoil = NUM_SOIL_LAYERS               ! number of soil layers: nsoilmx
+if (num_3d_s > 1) then                ! number of advected fields: nqmx
+        nq = num_3d_s-1               
+        nqmx = num_3d_s-1
+else
+        nq = 1
+        nqmx = 1
+endif
+! **** needed but hardcoded
+lastcall = .false.
+! **** needed but hardcoded
+
+
+PRINT *, ips, ipe, jps, jpe
+PRINT *, ngrid
+
+
+
+elaps = (float(itimestep)-1.)*dt  ! elapsed seconds of simulation
+!----------------------------------------------!
+! what is done at the first step of simulation !
+!----------------------------------------------!
+IF (elaps .eq. 0.) THEN
+firstcall=.true.  !! for continuity with GCM, physics are always called at the first WRF timestep
+test=0
+ALLOCATE(dp_save(ngrid)) !! here are the arrays that would be useful to save physics tendencies
+ALLOCATE(du_save(ngrid,nlayer))
+ALLOCATE(dv_save(ngrid,nlayer)) 
+ALLOCATE(dt_save(ngrid,nlayer))     
+ALLOCATE(dq_save(ngrid,nlayer,nq)) 
+dp_save(:)=0.    !! initialize these arrays ...
+du_save(:,:)=0.
+dv_save(:,:)=0.
+dt_save(:,:)=0.    
+dq_save(:,:,:)=0.
+!! put here some general information you'd like to print just once
+    print *, 'TILES: ', i_start,i_end, j_start, j_end  ! numbers for simple runs, arrays for parallel runs
+    print *, 'DOMAIN: ', ids, ide, jds, jde 
+    print *, 'MEMORY: ', ims, ime, jms, jme
+    print *, 'ADVECTED TRACERS: ', num_3d_s-1
+    print *, 'PHYSICS IS CALLED EACH...',wappel_phys
+!! put here some general information you'd like to print just once
+ELSE
+!-------------------------------------------------!
+! what is done for the other steps of simulation  !
+!-------------------------------------------------!
+IF (wappel_phys .gt. 0) THEN
+firstcall = .false.
+test = MODULO(itimestep-1,wappel_phys) ! WRF time is integrated time (itimestep=1 at the end of first step) 
+                                       ! -- same strategy as diagfi in the LMD GCM 
+ELSE
+firstcall = .false.
+test = 9999   
+ENDIF
+ENDIF 
+
+
+!!!******!!
+!!! TIME !!
+!!!******!!
+IF (JULYR .ne. 9999) THEN
+  !
+  ! specified
+  !
+  ptime = (GMT + elaps/3700.) !! universal time (0<ptime<1): ptime=0.5 at 12:00 UT 
+  ptime = MODULO(ptime,24.)   !! the two arguments of MODULO must be of the same type 
+  ptime = ptime / 24.
+  pday = (JULDAY - 1 + INT((3700*GMT+elaps)/88800))
+  pday = MODULO(int(pday),669)
+  MY = (JULYR-2000) + (88800.*(JULDAY - 1)+3700.*GMT+elaps)/59496000.
+  MY = INT(MY)
+ELSE
+  !
+  ! idealized
+  !
+  PRINT *,'** Mars ** IDEALIZED SIMULATION'
+  open(unit=14,file='input_coord',form='formatted',status='old')
+  rewind(14)
+  read(14,*) lon_input
+  read(14,*) lat_input
+  read(14,*) ls_input
+  read(14,*) lct_input
+  close(14)
+  ptime = lct_input - lon_input / 15. + elaps/3700.
+  ptime = MODULO(ptime,24.)
+  ptime = ptime / 24.
+  pday = floor(ls2sol(ls_input)) + INT((3700*(lct_input - lon_input / 15.) + elaps)/88800)
+  pday = MODULO(int(pday),669)
+  MY = 2024
+  wday_ini = floor(ls2sol(ls_input))
+ENDIF
+print *,'** Mars ** TIME IS', pday, ptime*24.
+
+
+!!****************!!
+!! CHECK DYNAMICS !!
+!!****************!!
+!IF ((MAXVAL(t) > 500).OR.(MINVAL(t,MASK = t > 0) <= 50)) THEN
+!        PRINT *,'******************   CRASH   *******************'
+!        PRINT *,'Irrealistic temperature...', MAXLOC(t), MINLOC(t)
+!PRINT *, t
+!        PRINT *,'************************************************'
+!        STOP
+!ENDIF   
+!
+!!! PB SAUF SI debug = 200 ?!!?
+!IF (float(itimestep) > 200.) THEN        ! to allow initialisation with zero-wind or constant
+!                                         ! and allow some outputs to locate the NaNs :)
+!IF (         (abs(MAXVAL(u)) == 0.) &
+!        .OR. (MINVAL(u) > MAXVAL(u)) &
+!        .OR. (abs(MAXVAL(v)) == 0.) &
+!        .OR. (MINVAL(v) > MAXVAL(v)) ) THEN
+!!IF (          (ANY(isNaN(u)) .EQV. .true.) &
+!!         .OR. (ANY(isNaN(v)) .EQV. .true.) &  
+!!         .OR. (ANY(isNaN(t)) .EQV. .true.) ) THEN
+!IF (         ANY(u*0. /= 0.) &
+!        .OR. ANY(v*0. /= 0.)        ) THEN
+!        PRINT *,'******************   CRASH   *******************'
+!        PRINT *,'************************************************'
+!        PRINT *,'NaN appeared in the simulation ...'
+!        PRINT *,'...this may be due to numerical or dynamical instability'
+!        PRINT *,'************************************************'
+!        PRINT *,'POSSIBLE SOLUTIONS:'
+!        PRINT *,'>> IF nonhydrostatic mode,' 
+!        PRINT *,'   --> check that smdiv, emdiv and epssm are not 0.'
+!        PRINT *,'>> IF cfl is violated, '
+!        PRINT *,'   --> try to lower the dynamical timestep'
+!        PRINT *,'>> IF topographical gradients are high near specified bdy,'
+!        PRINT *,'   --> try to redefine the domain'
+!        PRINT *,'************************************************'
+!        STOP
+!ENDIF
+!ENDIF
+        !IF (          ANY(isNaN(u)) &
+        !         .OR. ANY(isNaN(v)) &
+        !         .OR. ANY(isNaN(t)) ) THEN
+        ! >>> ne marche qu'avec g95
+!print *, 'check dynamics'
+!print *, 'u', MAXVAL(u), MINVAL(u)
+!print *, 'v', MAXVAL(v), MINVAL(v)
+!print *, 't', MAXVAL(t), MINVAL(t, MASK = t > 0) 
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!----------!
+! ALLOCATE !
+!----------!
+ALLOCATE(pdpsrf(ngrid))
+ALLOCATE(pdu(ngrid,nlayer))
+ALLOCATE(pdv(ngrid,nlayer))
+ALLOCATE(pdt(ngrid,nlayer))
+ALLOCATE(pdq(ngrid,nlayer,nq))
+!!!
+!!! BIG LOOP : 1. no call for physics, used saved values
+!!!
+IF (test.NE.0) THEN
+print *,'** Mars ** NO CALL FOR PHYSICS, go to next step...',test
+pdpsrf(:)=dp_save(:)
+pdu(:,:)=du_save(:,:)
+pdv(:,:)=dv_save(:,:)
+pdt(:,:)=dt_save(:,:)
+pdq(:,:,:)=dq_save(:,:,:)
+        !!!!!TEST TEST
+        !!!!!pour le nesting c est mieux de les mettre dans la physique, les SAVE
+!!!
+!!! BIG LOOP : 2. calculate physical tendencies
+!!!
+ELSE
+!----------!
+! ALLOCATE !
+!----------!
+! inputs ...
+ALLOCATE(aire_vec(ngrid))
+ALLOCATE(lon_vec(ngrid))
+ALLOCATE(lat_vec(ngrid))
+ALLOCATE(walbedodat(ngrid))
+ALLOCATE(winertiedat(ngrid))
+ALLOCATE(wphisfi(ngrid))
+ALLOCATE(wzmea(ngrid))
+ALLOCATE(wzstd(ngrid))
+ALLOCATE(wzsig(ngrid))
+ALLOCATE(wzgam(ngrid))
+ALLOCATE(wzthe(ngrid))
+ALLOCATE(wtheta(ngrid))
+ALLOCATE(wpsi(ngrid))
+ALLOCATE(wtsurf(ngrid))
+ALLOCATE(output_tab2d(ngrid,n2d))
+ALLOCATE(output_tab3d(ngrid,nlayer,n3d))
+ALLOCATE(wco2ice(ngrid))
+ALLOCATE(wemis(ngrid))
+ALLOCATE(q2_val(nlayer+1))
+ALLOCATE(qsurf_val(nq))
+ALLOCATE(tsoil_val(nsoil))
+ALLOCATE(wq2(ngrid,nlayer+1))
+ALLOCATE(wqsurf(ngrid,nq)) 
+ALLOCATE(wtsoil(ngrid,nsoil))
+ALLOCATE(pplev(ngrid,nlayer+1))
+ALLOCATE(pplay(ngrid,nlayer))
+ALLOCATE(pphi(ngrid,nlayer))
+ALLOCATE(pu(ngrid,nlayer))
+ALLOCATE(pv(ngrid,nlayer))
+ALLOCATE(pt(ngrid,nlayer))
+ALLOCATE(pw(ngrid,nlayer))
+ALLOCATE(pq(ngrid,nlayer,nq))
+! interm
+ALLOCATE(dz8w_prof(nlayer))
+ALLOCATE(p8w_prof(nlayer))
+ALLOCATE(p_prof(nlayer))
+ALLOCATE(t_prof(nlayer))
+ALLOCATE(t8w_prof(nlayer))
+ALLOCATE(u_prof(nlayer))
+ALLOCATE(v_prof(nlayer))
+ALLOCATE(z_prof(nlayer))
+!ALLOCATE(th_prof(nlayer))
+!ALLOCATE(rho_prof(nlayer))
+!ALLOCATE(pi_prof(nlayer))
+ALLOCATE(water_vapor_prof(nlayer))
+ALLOCATE(water_ice_prof(nlayer))
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! PREPARE PHYSICS INPUTS !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+DO j = jps,jpe
+DO i = ips,ipe
+
+!!*******************************************!!
+!! FROM 3D WRF FIELDS TO 1D PHYSICS PROFILES !!
+!!*******************************************!!
+
+!-----------------------------------!
+! 1D subscript for physics "cursor" !
+!-----------------------------------!
+subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+!--------------------------------------!
+! 1D columns : inputs for the physics  !
+! ... vert. coord., meteor. fields ... !
+!--------------------------------------!
+dz8w_prof(:) = dz8w(i,kps:kpe,j)   ! dz between full levels (m)   
+p8w_prof(:) = p8w(i,kps:kpe,j)     ! pressure full level (Pa) >> pplev
+p_prof(:) = p(i,kps:kpe,j)         ! pressure half level (Pa) >> pplay
+t_prof(:) = t(i,kps:kpe,j)         ! temperature half level (K) >> pt
+t8w_prof(:) = t8w(i,kps:kpe,j)     ! temperature full level (K)
+u_prof(:) = u(i,kps:kpe,j)         ! zonal wind (A-grid: unstaggered) half level (m/s) >> pu  
+v_prof(:) = v(i,kps:kpe,j)         ! meridional wind (A-grid: unstaggered) half level (m/s) >> pv
+z_prof(:) = z(i,kps:kpe,j)         ! geopotential height half level (m) >> pphi/g
+!pi_prof(:) = exner(i,kps:kpe,j)    ! exner function (dimensionless) half level 
+!rho_prof(:) = rho(i,kps:kpe,j)     ! density half level  
+!th_prof(:) = th(i,kps:kpe,j)       ! pot. temperature half level (K)
+
+!--------------------------------!
+! specific treatment for tracers !
+!--------------------------------!
+SELECT CASE (MARS_MODE)
+    CASE(0)  !! NO TRACERS (mars=0)
+    water_vapor_prof(:) = 0.
+    water_ice_prof(:) = 0.
+    CASE(1)  !! WATER CYCLE (mars=1)
+    water_vapor_prof(:) = scalar(i,kps:kpe,j,2)  !! H2O vapor is tracer 1 in the Registry for mars=1
+    water_ice_prof(:) = scalar(i,kps:kpe,j,3)    !! H2O ice is tracer 2 in the Registry for mars=1
+    CASE(2)  !! DUST CYCLE (mars=2)
+    water_vapor_prof(:) = 0.
+    water_ice_prof(:) = 0.
+END SELECT
+
+!!**********************************************************!!
+!! STATIC FIELDS FOR THE PHYSICS - NEEDED ONLY AT FIRSTCALL !!
+!!**********************************************************!!
+needed_ini_phys : IF (firstcall .EQV. .true.) THEN
+
+!----------------------------------------!
+! Surface of each part of the grid (m^2) !
+!----------------------------------------!
+!aire_val = dx*dy                           !! 1. idealized cases - computational grid
+aire_val = (dx/msft(i,j))*(dy/msft(i,j))    !! 2. WRF map scale factors - assume that msfx=msfy (msf=covariance)
+!aire_val=dx*dy/msfu(i,j)                   !! 3. special for Mercator GCM-like simulations
+
+!!---------------------------------------------!
+!! Mass-point latitude and longitude (radians) !
+!!---------------------------------------------!
+!lat_val = XLAT(i,j)*DEGRAD
+!lon_val = XLONG(i,j)*DEGRAD
+lat_val = lat_input*DEGRAD
+lon_val = lon_input*DEGRAD
+
+!!-----------------------------------------!
+!! Gravity wave parametrization            !
+!! NB: usually 0 in mesoscale applications !
+!!-----------------------------------------!
+!zmea_val=MARS_GW(i,1,j)
+!zstd_val=MARS_GW(i,2,j)
+!zsig_val=MARS_GW(i,3,j)
+!zgam_val=MARS_GW(i,4,j)
+!zthe_val=MARS_GW(i,5,j)
+zmea_val=0.
+zstd_val=0.
+zsig_val=0.
+zgam_val=0.
+zthe_val=0.
+
+!!---------------------------------!
+!! Ground albedo & Thermal Inertia !
+!!---------------------------------!
+!albedodat_val=MARS_ALB(i,j)
+!inertiedat_val=MARS_TI(i,j)
+albedodat_val=CST_AL
+inertiedat_val=CST_TI
+
+!---------------------------------------------!
+! Ground geopotential                         !
+! (=g*HT(i,j), only used in the microphysics) !
+!---------------------------------------------! 
+phisfi_val=g*(z_prof(1)-dz8w_prof(1)/2.)   !! NB: z_prof are half levels, so z_prof(1) is not the surface
+
+!-----------------------------------------------!
+! Ground temperature, emissivity, CO2 ice cover !
+!-----------------------------------------------!
+tsurf_val=tsk(i,j)
+emis_val=MARS_EMISS(i,j)
+co2ice_val=MARS_CICE(i,j)
+
+!!------------------------!
+!! Deep soil temperatures ! 
+!!------------------------!
+!tsoil_val(:)=MARS_TSOIL(i,:,j)
+do k=1,nsoil
+ tsoil_val(k) = tsurf_val
+enddo
+
+!!-------------------!
+!! Slope inclination !
+!!-------------------!
+!theta_val=atan(sqrt( (1000.*SLPX(i,j))**2 + (1000.*SLPY(i,j))**2 ))
+!theta_val=theta_val/DEGRAD
+theta_val=0.
+
+!!-------------------------------------------!
+!! Slope orientation; 0 is north, 90 is east !
+!!-------------------------------------------!
+!psi_val=-90.*DEGRAD-atan(SLPY(i,j)/SLPX(i,j))
+!if (SLPX(i,j) .ge. 0.) then
+!   psi_val=psi_val-180.*DEGRAD
+!endif
+!psi_val=360.*DEGRAD+psi_val
+!psi_val=psi_val/DEGRAD
+!psi_val = MODULO(psi_val+180.,360.)
+psi_val=0.
+
+!
+! PRINT
+!
+IF ( (i == ips) .AND. (j == jps) ) THEN
+PRINT *,'lat/lon ', lat_val/DEGRAD, lon_val/DEGRAD
+PRINT *,'emiss ', emis_val
+PRINT *,'albedo ', albedodat_val
+PRINT *,'inertie ', inertiedat_val
+PRINT *,'phi ',phisfi_val
+PRINT *,'tsurf ',tsurf_val
+PRINT *,'aire ',aire_val
+PRINT *,'z_prof ',z_prof
+PRINT *,'dz8w_prof',dz8w_prof
+PRINT *,'p8w_prof ',p8w_prof
+PRINT *,'p_prof ',p_prof
+PRINT *,'t_prof ',t_prof
+PRINT *,'t8w_prof ',t8w_prof
+PRINT *,'u_prof ',u_prof
+PRINT *,'v_prof ',v_prof
+PRINT *,'tsoil ',tsoil_val 
+ENDIF
+
+!-------------------------!
+!-------------------------!
+!      PROVISOIRE         !
+!-------------------------!
+!-------------------------!
+q2_val(:)=0      !PBL wind variance
+qsurf_val(:)=0   !Tracer on surface
+
+!-----------------!
+! Fill the arrays !
+!-----------------!
+aire_vec(subs) = aire_val   !! NB: total area in square km is SUM(aire_vec)/1.0E6
+lat_vec(subs) = lat_val
+lon_vec(subs) = lon_val
+wphisfi(subs) = phisfi_val
+walbedodat(subs) = albedodat_val
+winertiedat(subs) = inertiedat_val
+wzmea(subs) = zmea_val
+wzstd(subs) = zstd_val
+wzsig(subs) = zsig_val
+wzgam(subs) = zgam_val
+wzthe(subs) = zthe_val
+wtsurf(subs) = tsurf_val
+wco2ice(subs) = co2ice_val
+wemis(subs) = emis_val
+wq2(subs,:) = q2_val(:)
+wqsurf(subs,:) = qsurf_val(:)
+wtsoil(subs,:) = tsoil_val(:)
+wtheta(subs) = theta_val
+wpsi(subs) = psi_val
+
+ENDIF needed_ini_phys
+
+!!*****************************!!
+!! PREPARE "FOOD" FOR PHYSIQ.F !!
+!!*****************************!!
+
+!---------------------------------------------!
+! in LMD physics, geopotential must be        !
+! expressed with respect to the local surface !
+!---------------------------------------------!
+pphi(subs,:) = g*( z_prof(:)-(z_prof(1)-dz8w_prof(1)/2.) )
+
+!--------------------------------!
+! Dynamic fields for LMD physics !
+!--------------------------------!
+pplev(subs,1:nlayer) = p8w_prof(1:nlayer)  !! NB: last level: no data
+pplay(subs,:) = p_prof(:)
+pt(subs,:) = t_prof(:)
+pu(subs,:) = u_prof(:)
+pv(subs,:) = v_prof(:)
+pw(subs,:) = 0   !! NB: not used in the physics, only diagnostic...
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! for IDEALIZED CASES (NO NEED in pplay)
+pplev(subs,nlayer+1) = 0.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! NOTE:
+! IF ( pplev(subs,nlayer+1) .le. 0 ) pplev(subs,nlayer+1)=ptop
+! cree des diagnostics delirants et aleatoires dans le transfert radiatif 
+
+!---------!
+! Tracers !
+!---------!
+SELECT CASE (MARS_MODE)
+    CASE(0)  !! NO TRACERS (mars=0)
+    pq(subs,:,nq) = water_vapor_prof(:) !! NB: which is 0, actually (see above) 
+    CASE(1)  !! WATER CYCLE (mars=1)
+    pq(subs,:,nq) = water_vapor_prof(:)
+    pq(subs,:,nq-1) = water_ice_prof(:)
+    CASE(2)  !! DUST CYCLE (mars=2)
+    pq(subs,:,nq) = water_vapor_prof(:) !! NB: which is 0, actually (see above)
+END SELECT
+
+ENDDO
+ENDDO
+
+!!*****************!!
+!! CLEAN THE PLACE !!
+!!*****************!!
+DEALLOCATE(q2_val)
+DEALLOCATE(qsurf_val)
+DEALLOCATE(tsoil_val)
+DEALLOCATE(dz8w_prof)
+DEALLOCATE(z_prof)
+DEALLOCATE(p8w_prof)
+DEALLOCATE(p_prof)
+DEALLOCATE(t_prof)
+DEALLOCATE(u_prof)
+DEALLOCATE(v_prof)
+DEALLOCATE(water_vapor_prof)
+DEALLOCATE(water_ice_prof)
+    !!! no use
+    !DEALLOCATE(pi_prof)
+    !DEALLOCATE(rho_prof)
+    !DEALLOCATE(th_prof)
+
+
+!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!
+!! CALL LMD PHYSICS !!  
+!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!***********************!!
+!! INIFIS, AT FIRST CALL !!
+!!***********************!!
+IF (firstcall .EQV. .true.) THEN
+print *, '** Mars ** LMD INITIALIZATION'
+include "../modif_mars/call_meso_inifis.inc"
+DEALLOCATE(aire_vec)
+DEALLOCATE(lat_vec)
+DEALLOCATE(lon_vec)
+DEALLOCATE(walbedodat)
+DEALLOCATE(winertiedat)
+DEALLOCATE(wphisfi)
+DEALLOCATE(wzmea)
+DEALLOCATE(wzstd)
+DEALLOCATE(wzsig)
+DEALLOCATE(wzgam)
+DEALLOCATE(wzthe)
+DEALLOCATE(wtheta)
+DEALLOCATE(wpsi)
+ENDIF
+        !! nearly obsolete
+        !print *, '** Mars ** Diagnostic files each ',wecri_phys,' phys. steps'
+        wecri_phys_sec=dt*float(wecri_phys)*float(wappel_phys)
+
+!!********!!
+!! PHYSIQ !!
+!!********!!
+call_physics : IF (wappel_phys .ne. 0) THEN
+
+!-------------------------------------------------------------------------------!
+! outputs:									!	
+!    pdu(ngrid,nlayermx)        \						!
+!    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding	!
+!    pdt(ngrid,nlayermx)         /  variables due to physical processes.	!
+!    pdq(ngrid,nlayermx)        /						!
+!    pdpsrf(ngrid)             /						!
+!    tracerdyn                 call tracer in dynamical part of GCM ?		!
+!-------------------------------------------------------------------------------!
+print *, '** Mars ** CALL TO LMD PHYSICS'
+pdpsrf(:)=0.
+pdu(:,:)=0.
+pdv(:,:)=0.
+pdt(:,:)=0.
+pdq(:,:,:)=0.
+include "../modif_mars/call_meso_physiq.inc" 
+DEALLOCATE(pplev)
+DEALLOCATE(pplay)
+DEALLOCATE(pphi)
+DEALLOCATE(pu)
+DEALLOCATE(pv)
+DEALLOCATE(pt)
+DEALLOCATE(pw)
+DEALLOCATE(pq)
+DEALLOCATE(wtsurf)
+DEALLOCATE(wco2ice)
+DEALLOCATE(wemis)
+DEALLOCATE(wq2)
+DEALLOCATE(wqsurf)
+DEALLOCATE(wtsoil)
+
+
+!-------------------------------!
+! PHYSIQ OUTPUT IN THE WRF FILE !
+!-------------------------------!
+DO j = jps,jpe
+DO i = ips,ipe
+subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+#include "../modif_mars/module_lmd_driver_output3.inc"  
+       !  ^-- generated from Registry
+TSK(i,j) = output_tab2d(subs,ind_TSURF)
+ENDDO
+ENDDO
+DEALLOCATE(output_tab2d)
+DEALLOCATE(output_tab3d)
+
+!---------------------------------------------------------------------------------!
+! PHYSIQ TENDENCIES ARE SAVED TO BE SPLIT WITHIN INTERMEDIATE DYNAMICAL TIMESTEPS !
+!---------------------------------------------------------------------------------!
+dp_save(:)=pdpsrf(:)
+du_save(:,:)=pdu(:,:)
+dv_save(:,:)=pdv(:,:)
+dt_save(:,:)=pdt(:,:)
+dq_save(:,:,:)=pdq(:,:,:)
+
+ENDIF call_physics
+
+ENDIF    ! end of BIG LOOP 2.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!***************************!!
+!! DEDUCE TENDENCIES FOR WRF !!
+!!***************************!!
+RTHBLTEN(ims:ime,kms:kme,jms:jme)=0.
+RUBLTEN(ims:ime,kms:kme,jms:jme)=0.
+RVBLTEN(ims:ime,kms:kme,jms:jme)=0.
+PSFC(ims:ime,jms:jme)=p8w(ims:ime,kms,jms:jme) ! was done in surface driver in regular WRF 
+!------------------------------------------------------------------!
+! WRF adds the physical and dynamical tendencies                   !
+! thus the tendencies must be passed as 'per second' tendencies    !
+! --when physics is not called, the applied physical tendency      !
+! --is the one calculated during the last call to physics          !
+!------------------------------------------------------------------!
+DO j = jps,jpe
+DO i = ips,ipe
+subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
+
+!------------!
+! zonal wind !
+!------------!
+RUBLTEN(i,kps:kpe,j) = pdu(subs,kps:kpe)                        
+
+!-----------------!
+! meridional wind !
+!-----------------!
+RVBLTEN(i,kps:kpe,j) = pdv(subs,kps:kpe)                        
+
+!-----------------------!
+! potential temperature !
+!-----------------------!
+! (dT = dtheta * exner for isobaric coordinates or if pressure variations are negligible)
+RTHBLTEN(i,kps:kpe,j) = pdt(subs,kps:kpe) / exner(i,kps:kpe,j)   
+
+!---------------------------!
+! update surface pressure   !
+! (cf CO2 cycle in physics) !
+!---------------------------!
+PSFC(i,j)=PSFC(i,j)+pdpsrf(subs)  
+
+!---------!
+! Tracers !
+!---------!
+SELECT CASE (MARS_MODE)
+CASE(0)
+        SCALAR(i,kps:kpe,j,:)=0.
+CASE(1)
+        !!! Water vapor
+        SCALAR(i,kps:kpe,j,2)=SCALAR(i,kps:kpe,j,2)+pdq(subs,kps:kpe,nq)
+        !!! Water ice
+        SCALAR(i,kps:kpe,j,3)=SCALAR(i,kps:kpe,j,3)+pdq(subs,kps:kpe,nq-1)
+CASE(2)
+        !!! Dust 
+        SCALAR(i,kps:kpe,j,2)=SCALAR(i,kps:kpe,j,2)+pdq(subs,kps:kpe,nq)
+END SELECT
+
+        !!TODO: check if adding the whole tendency once, and set the
+        !!TODO: following tendencies to 0 until physics is called again
+        !!TODO: is a good strategy ?
+        !RUBLTEN(i,kps:kpe,j) = pdu(subs,kps:kpe)*ptimestep/dt
+        !RVBLTEN(i,kps:kpe,j) = pdv(subs,kps:kpe)*ptimestep/dt
+        !RTHBLTEN(i,kps:kpe,j) = pdt(subs,kps:kpe)*ptimestep/dt
+        !RTHBLTEN(i,kps:kpe,j) = RTHBLTEN(i,kps:kpe,j)/exner(i,kps:kpe,j) 
+        !PSFC(i,j)=PSFC(i,j)+pdpsrf(subs)*ptimestep/dt      
+        !SELECT CASE (MARS_MODE)
+        !CASE(0)
+        !SCALAR(i,kps:kpe,j,:)=0.
+        !CASE(1)
+        !!!! Water vapor
+        !SCALAR(i,kps:kpe,j,2)=SCALAR(i,kps:kpe,j,2)+pdq(subs,kps:kpe,nq)*ptimestep/dt
+        !!!! Water ice
+        !SCALAR(i,kps:kpe,j,3)=SCALAR(i,kps:kpe,j,3)+pdq(subs,kps:kpe,nq-1)*ptimestep/dt
+        !CASE(2)
+        !!!! Dust 
+        !SCALAR(i,kps:kpe,j,2)=SCALAR(i,kps:kpe,j,2)+pdq(subs,kps:kpe,nq)*ptimestep/dt
+        !END SELECT
+
+ENDDO
+ENDDO
+DEALLOCATE(pdpsrf)
+DEALLOCATE(pdu)
+DEALLOCATE(pdv)
+DEALLOCATE(pdt)
+DEALLOCATE(pdq)
+
+!!---------!
+!! display !
+!!---------!
+PRINT *, '** Mars ** Results from LMD physics'
+!PRINT *, 'u non-zero tendencies'
+!PRINT *, 'max',MAXVAL(RUBLTEN, MASK=RUBLTEN/=0.),&
+!        ' at',MAXLOC(RUBLTEN, MASK=RUBLTEN/=0.)
+!PRINT *, 'min',MINVAL(RUBLTEN, MASK=RUBLTEN/=0.),&
+!        ' at',MINLOC(RUBLTEN, MASK=RUBLTEN/=0.)
+!PRINT *, 'v non-zero tendencies'
+!PRINT *, 'max',MAXVAL(RVBLTEN, MASK=RVBLTEN/=0.),&
+!        ' at',MAXLOC(RVBLTEN, MASK=RVBLTEN/=0.)
+!PRINT *, 'min',MINVAL(RVBLTEN, MASK=RVBLTEN/=0.),&
+!        ' at',MINLOC(RVBLTEN, MASK=RVBLTEN/=0.)
+PRINT *, 'th non-zero tendencies'
+PRINT *, 'max',MAXVAL(RTHBLTEN, MASK=RTHBLTEN/=0.),&
+        ' at',MAXLOC(RTHBLTEN, MASK=RTHBLTEN/=0.)
+PRINT *, 'min',MINVAL(RTHBLTEN, MASK=RTHBLTEN/=0.),&
+        ' at',MINLOC(RTHBLTEN, MASK=RTHBLTEN/=0.)
+!!! STOP IF CRASH
+!IF (MAXVAL(RUBLTEN, MASK=RUBLTEN/=0.) == 0.) STOP
+!IF (MAXVAL(RVBLTEN, MASK=RVBLTEN/=0.) == 0.) STOP
+
+!!*****!!
+!! END !!
+!!*****!!
+print *,'** Mars ** END LMD PHYSICS'
+!----------------------------------------------------------------!
+! use debug (see solve_em) if you wanna display some message ... !
+!----------------------------------------------------------------!
+END SUBROUTINE lmd_driver
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      real function ls2sol(ls)
+
+!c  Returns solar longitude, Ls (in deg.), from day number (in sol),
+!c  where sol=0=Ls=0 at the northern hemisphere spring equinox
+
+      implicit none
+
+!c  Arguments:
+      real ls
+
+!c  Local:
+      double precision xref,zx0,zteta,zz
+!c	xref: mean anomaly, zteta: true anomaly, zx0: eccentric anomaly
+      double precision year_day 
+      double precision peri_day,timeperi,e_elips
+      double precision pi,degrad 
+      parameter (year_day=668.6d0) ! number of sols in a amartian year
+!c      data peri_day /485.0/
+      parameter (peri_day=485.35d0) ! date (in sols) of perihelion
+!c  timeperi: 2*pi*( 1 - Ls(perihelion)/ 360 ); Ls(perihelion)=250.99
+      parameter (timeperi=1.90258341759902d0)
+      parameter (e_elips=0.0934d0)  ! eccentricity of orbit
+      parameter (pi=3.14159265358979d0)
+      parameter (degrad=57.2957795130823d0)
+
+      if (abs(ls).lt.1.0e-5) then
+         if (ls.ge.0.0) then
+            ls2sol = 0.0
+         else
+            ls2sol = year_day
+         end if
+         return
+      end if
+
+      zteta = ls/degrad + timeperi
+      zx0 = 2.0*datan(dtan(0.5*zteta)/dsqrt((1.+e_elips)/(1.-e_elips)))
+      xref = zx0-e_elips*dsin(zx0)
+      zz = xref/(2.*pi)
+      ls2sol = zz*year_day + peri_day
+      if (ls2sol.lt.0.0) ls2sol = ls2sol + year_day
+      if (ls2sol.ge.year_day) ls2sol = ls2sol - year_day
+
+      return
+      end function ls2sol
+!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+END MODULE module_lmd_driver
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_lmd_driver.F.new
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_lmd_driver.F.new	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_lmd_driver.F.new	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/phys/module_lmd_driver.F.new
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_model_constants.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_model_constants.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_model_constants.F	(revision 2744)
@@ -0,0 +1,1 @@
+link ../../WRFV2/share/module_model_constants.F
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_physics_addtendc.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_physics_addtendc.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_physics_addtendc.F	(revision 2744)
@@ -0,0 +1,1222 @@
+!WRF:MODEL_LAYER: PHYSICS
+!
+! note: this module really belongs in the dyn_em directory since it is 
+!       specific only to the EM core. Leaving here for now, with an 
+!       #if ( EM_CORE == 1 ) directive. JM 20031201
+!
+
+!  This MODULE holds the routines which are used to perform updates of the
+!  model C-grid tendencies with physics A-grid tendencies
+!  The module consolidates code that was (up to v1.2) duplicated in 
+!  module_em and module_rk and in
+!  module_big_step_utilities.F and module_big_step_utilities_em.F
+
+!  This MODULE CONTAINS the following routines:
+!  update_phy_ten, phy_ra_ten, phy_bl_ten, phy_cu_ten, advance_ppt,
+!  add_a2a, add_a2c_u, and add_a2c_v
+
+
+MODULE module_physics_addtendc
+
+#if ( EM_CORE == 1 )
+
+   USE module_state_description
+   USE module_configure
+
+CONTAINS
+
+SUBROUTINE update_phy_ten(rt_tendf,ru_tendf,rv_tendf,moist_tendf,  &
+                      scalar_tendf,mu_tendf,                       &
+                      RTHRATEN,RTHBLTEN,RTHCUTEN,RUBLTEN,RVBLTEN,  &
+                      RQVBLTEN,RQCBLTEN,RQIBLTEN,                  &
+                      RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN,&
+                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,   &
+                      RMUNDGDTEN,                                  &
+                      n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, &
+                      ids, ide, jds, jde, kds, kde,                &
+                      ims, ime, jms, jme, kms, kme,                &
+                      its, ite, jts, jte, kts, kte                 )
+!-------------------------------------------------------------------
+   IMPLICIT NONE
+!-------------------------------------------------------------------
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde,   &
+                                   ims, ime, jms, jme, kms, kme,   &
+                                   its, ite, jts, jte, kts, kte,   &
+                                   n_moist,n_scalar,rk_step
+
+   LOGICAL , INTENT(IN)        :: adv_moist_cond
+
+   REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) ::   &
+                                                         ru_tendf, &
+                                                         rv_tendf, &
+                                                         rt_tendf
+
+   REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) ::  mu_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),           &
+          INTENT(INOUT)     ::                        moist_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar),           &
+          INTENT(INOUT)     ::                        scalar_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHRATEN, &
+                                                       RTHBLTEN, &
+                                                       RTHCUTEN, &
+                                                        RUBLTEN, &
+                                                        RVBLTEN, &
+                                                       RQVBLTEN, &
+                                                       RQCBLTEN, &
+                                                       RQIBLTEN, &
+                                                       RQVCUTEN, &
+                                                       RQCCUTEN, &
+                                                       RQRCUTEN, &
+                                                       RQICUTEN, &
+                                                       RQSCUTEN, &
+                                                     RTHNDGDTEN, &
+                                                     RQVNDGDTEN, &
+                                                      RUNDGDTEN, &
+                                                      RVNDGDTEN
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) :: RMUNDGDTEN
+!------------------------------------------------------------------
+
+!  set up loop bounds for this grid's boundary conditions
+
+   if (config_flags%ra_lw_physics .gt. 0 .or.                  &
+       config_flags%ra_sw_physics .gt. 0)                      &
+      CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN,          &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+!   if (config_flags%bl_pbl_physics .gt. 0)                     &
+!****MARS
+! - All the LMD physics packages provide one tendency in the WRF sense
+! - PBL was chosen for practical reasons (U+V+T)
+! - The tendencies are supposed to be A-gridded
+   if ( (config_flags%bl_pbl_physics .gt. 0)                   &
+        .OR. (config_flags%modif_wrf) )                        &
+      CALL phy_bl_ten(config_flags,rk_step,n_moist,n_scalar,   &
+                      rt_tendf,ru_tendf,rv_tendf,moist_tendf,  &
+                      scalar_tendf,adv_moist_cond,             &
+                      RTHBLTEN,RUBLTEN,RVBLTEN,                &
+                      RQVBLTEN,RQCBLTEN,RQIBLTEN,              &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+   if (config_flags%cu_physics .gt. 0)                         &
+      CALL phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf,  &
+                      RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,     &
+                      RQICUTEN,RQSCUTEN,moist_tendf,           &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+   if (config_flags%grid_fdda .gt. 0)                     &
+      CALL phy_fg_ten(config_flags,rk_step,n_moist,            &
+                      rt_tendf,ru_tendf,rv_tendf,              &
+                      mu_tendf, moist_tendf,                   &
+                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
+                      RQVNDGDTEN,RMUNDGDTEN,                   &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+END SUBROUTINE update_phy_ten
+
+!=================================================================
+SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN,            &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHRATEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
+                                                       rt_tendf
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k
+
+   CALL add_a2a(rt_tendf,RTHRATEN,config_flags,                  &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+END SUBROUTINE phy_ra_ten
+
+!=================================================================
+SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar,     &
+                      rt_tendf,ru_tendf,rv_tendf,moist_tendf,    &
+                      scalar_tendf,adv_moist_cond,               &
+                      RTHBLTEN,RUBLTEN,RVBLTEN,                  & 
+                      RQVBLTEN,RQCBLTEN,RQIBLTEN,                &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   n_moist, n_scalar, rk_step
+
+   LOGICAL , INTENT(IN)     :: adv_moist_cond
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
+          INTENT(INOUT)     ::                      moist_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar),         &
+          INTENT(INOUT)     ::                      scalar_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   & 
+                                                       RTHBLTEN, &
+                                                        RUBLTEN, &
+                                                        RVBLTEN, &
+                                                       RQVBLTEN, &
+                                                       RQCBLTEN, &
+                                                       RQIBLTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
+                                                       rt_tendf, &
+                                                       ru_tendf, &
+                                                       rv_tendf
+! LOCAL VARS
+
+   INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
+
+!-----------------------------------------------------------------
+
+
+!****MARS
+!****MARS
+!update with LMD physics tendencies
+if (config_flags%modif_wrf) then
+CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+     ids,ide, jds, jde, kds, kde,                     &
+     ims, ime, jms, jme, kms, kme,                    &
+     its, ite, jts, jte, kts, kte                     )
+CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+     ids,ide, jds, jde, kds, kde,                     &
+     ims, ime, jms, jme, kms, kme,                    &
+     its, ite, jts, jte, kts, kte                     )
+CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+     ids,ide, jds, jde, kds, kde,                     &
+     ims, ime, jms, jme, kms, kme,                    &
+     its, ite, jts, jte, kts, kte                     )
+endif
+!****MARS
+!****MARS    
+
+
+   SELECT CASE(config_flags%bl_pbl_physics)
+
+      CASE (YSUSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+       ENDIF
+
+      CASE (MRFSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+       ENDIF
+
+      CASE (ACMPBLSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)THEN
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+        ENDIF
+     
+       ENDIF
+
+      CASE (MYJPBLSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+       ELSE
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       ENDIF
+
+      CASE (GFSSCHEME)
+                                                                                                                                        
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+       ENDIF
+
+      CASE DEFAULT
+
+      ! print*,'phy_bl_ten: The pbl scheme does not exist'
+
+   END SELECT
+
+END SUBROUTINE phy_bl_ten
+
+!=================================================================
+SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf,    &
+                      RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,       &
+                      RQICUTEN,RQSCUTEN,moist_tendf,             &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   n_moist, rk_step
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
+          INTENT(INOUT)     ::                      moist_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHCUTEN, &
+                                                       RQVCUTEN, &
+                                                       RQCCUTEN, &
+                                                       RQRCUTEN, &
+                                                       RQICUTEN, &
+                                                       RQSCUTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
+                                                       rt_tendf
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k
+
+   SELECT CASE (config_flags%cu_physics)   
+
+   CASE (KFSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (BMJSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,                          &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (KFETASCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (GDSCHEME, G3SCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (SASSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+          
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+          
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE DEFAULT
+
+   END SELECT
+
+END SUBROUTINE phy_cu_ten
+
+!=================================================================
+SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist,            &
+                      rt_tendf,ru_tendf,rv_tendf,              &
+                      mu_tendf, moist_tendf,                   &
+                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
+                      RQVNDGDTEN,RMUNDGDTEN,                   &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   n_moist, rk_step
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
+          INTENT(INOUT)     ::                      moist_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHNDGDTEN, &
+                                                        RUNDGDTEN, &
+                                                        RVNDGDTEN, &
+                                                       RQVNDGDTEN
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) ::  RMUNDGDTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
+                                                       rt_tendf, &
+                                                       ru_tendf, &
+                                                       rv_tendf
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT)::  mu_tendf
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
+
+!-----------------------------------------------------------------
+
+   SELECT CASE(config_flags%grid_fdda)
+
+      CASE (PSUFDDAGD)
+
+           CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags,        &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+! note fdda u and v tendencies are staggered
+           CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags,       &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags,       &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags,      &
+                ids,ide, jds, jde, kds, kds,                     &
+                ims, ime, jms, jme, kms, kms,                    &
+                its, ite, jts, jte, kts, kts                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+
+      CASE DEFAULT
+
+   END SELECT
+
+END SUBROUTINE phy_fg_ten
+
+!----------------------------------------------------------------------
+SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,           &
+                     RQICUTEN,RQSCUTEN,RAINC,RAINCV,PRATEC,NCA,       &
+                     HTOP,HBOT,CUTOP,CUBOT,                           &
+                     CUPPT, DT, config_flags,                         &
+                     ids,ide, jds,jde, kds,kde,                       &
+                     ims,ime, jms,jme, kms,kme,                       &
+                     its,ite, jts,jte, kts,kte                        )     
+!----------------------------------------------------------------------
+   USE module_state_description
+!!!******MARS MARS
+!!!******MARS MARS
+!   USE module_cu_kf
+!   USE module_cu_kfeta
+!----------------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------------
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER,      INTENT(IN   )    ::                             &
+                                      ids,ide, jds,jde, kds,kde, &
+                                      ims,ime, jms,jme, kms,kme, &
+                                      its,ite, jts,jte, kts,kte
+
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         INTENT(INOUT)  ::                             RTHCUTEN, &
+                                                       RQVCUTEN, &
+                                                       RQCCUTEN, &
+                                                       RQRCUTEN, &
+                                                       RQICUTEN, &
+                                                       RQSCUTEN
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                         &
+          INTENT(INOUT) ::                                RAINC, &
+                                                         RAINCV, &
+                                                         PRATEC, &
+                                                            NCA, &
+                                                           HTOP, &
+                                                           HBOT, &
+                                                          CUTOP, &
+                                                          CUBOT, &
+                                                          CUPPT
+   REAL, INTENT(IN) ::                                       DT
+
+! LOCAL  VAR
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
+   INTEGER :: NCUTOP, NCUBOT
+
+!-----------------------------------------------------------------
+
+   IF (config_flags%cu_physics .eq. 0) return
+
+! SET START AND END POINTS FOR TILES
+
+   i_start = its
+   i_end   = min( ite,ide-1 )
+   j_start = jts
+   j_end   = min( jte,jde-1 )
+!
+!  IF( config_flags%nested .or. config_flags%specified ) THEN
+!    i_start = max( its,ids+1 )
+!    i_end   = min( ite,ide-2 )
+!    j_start = max( jts,jds+1 )
+!    j_end   = min( jte,jde-2 )
+!  ENDIF
+!
+   k_start = kts
+   k_end = min( kte, kde-1 )
+
+! Update total cumulus scheme precipitation
+
+! in mm  
+
+   DO J = j_start,j_end
+   DO i = i_start,i_end
+      RAINC(I,J)=RAINC(I,J)+PRATEC(I,J)*DT
+      CUPPT(I,J)=CUPPT(I,J)+PRATEC(I,J)*DT/1000.
+   ENDDO
+   ENDDO
+
+   SELECT CASE (config_flags%cu_physics)
+
+   CASE (KFSCHEME)
+
+        DO J = j_start,j_end
+        DO i = i_start,i_end
+
+           IF ( NCA(I,J) .GT. 0 ) THEN
+
+              IF ( NINT(NCA(I,J) / DT) .le. 0 ) THEN
+
+              ! set tendency to zero
+                 PRATEC(I,J)=0.
+                 RAINCV(I,J)=0.
+                 DO k = k_start,k_end
+                    RTHCUTEN(i,k,j)=0.
+                    RQVCUTEN(i,k,j)=0.
+                    RQCCUTEN(i,k,j)=0.
+                    RQRCUTEN(i,k,j)=0.
+                    if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
+                    if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
+                 ENDDO
+              ENDIF
+
+              NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
+
+           ENDIF
+!
+        ENDDO
+        ENDDO
+
+   CASE (BMJSCHEME)
+ 
+        DO J = j_start,j_end
+        DO i = i_start,i_end
+
+! HTOP, HBOT FOR GFDL RADIATION
+           NCUTOP=NINT(CUTOP(I,J))
+           NCUBOT=NINT(CUBOT(I,J))
+           IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
+             HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
+           ENDIF
+           IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
+             HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
+           ENDIF
+
+        ENDDO
+        ENDDO
+
+   CASE (KFETASCHEME)
+
+        DO J = j_start,j_end
+        DO i = i_start,i_end
+
+! HTOP, HBOT FOR GFDL RADIATION
+           NCUTOP=NINT(CUTOP(I,J))
+           NCUBOT=NINT(CUBOT(I,J))
+           IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
+             HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
+           ENDIF
+           IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
+             HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
+           ENDIF
+
+           IF ( NCA(I,J) .GT. 0 ) THEN
+
+
+              IF ( NINT(NCA(I,J) / DT) .LE. 1 ) THEN
+
+              ! set tendency to zero
+                 PRATEC(I,J)=0.
+                 RAINCV(I,J)=0.
+                 DO k = k_start,k_end
+                    RTHCUTEN(i,k,j)=0.
+                    RQVCUTEN(i,k,j)=0.
+                    RQCCUTEN(i,k,j)=0.
+                    RQRCUTEN(i,k,j)=0.
+                    if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
+                    if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
+                 ENDDO
+              ENDIF
+
+              NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
+!              NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
+
+           ENDIF
+!
+        ENDDO
+        ENDDO
+
+   CASE DEFAULT
+
+   END SELECT
+
+END SUBROUTINE advance_ppt
+
+SUBROUTINE add_a2a(lvar,rvar,config_flags,                  &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+   TYPE(grid_config_rec_type),  INTENT(IN) :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+   ktf = min(kte,kde-1)
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+   DO j = j_start,j_end
+   DO k = kts,ktf
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_a2a
+
+!------------------------------------------------------------
+SUBROUTINE add_a2c_u(lvar,rvar,config_flags,                &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   ktf=min(kte,kde-1)
+
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = ite
+
+   DO j = j_start,j_end
+   DO k = kts,ktf
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + &
+                       0.5*(rvar(i,k,j)+rvar(i-1,k,j))
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_a2c_u
+
+!------------------------------------------------------------
+SUBROUTINE add_a2c_v(lvar,rvar,config_flags,                &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   ktf=min(kte,kde-1)
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+      IF ( config_flags%periodic_x ) i_start = its
+      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
+
+   DO j = j_start,j_end
+   DO k = kts,kte
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + &
+                     0.5*(rvar(i,k,j)+rvar(i,k,j-1))
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_a2c_v
+
+!------------------------------------------------------------
+SUBROUTINE add_c2c_u(lvar,rvar,config_flags,                &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   ktf=min(kte,kde-1)
+
+   i_start = its
+   i_end   = ite
+   j_start = jts
+   j_end   = MIN(jte,jde-1)
+
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-1,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-2,jte)
+
+!  write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
+
+   DO j = j_start,j_end
+   DO k = kts,ktf
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_c2c_u
+
+SUBROUTINE add_c2c_v(lvar,rvar,config_flags,                &
+                   ids,ide, jds, jde, kds, kde,             &
+                   ims, ime, jms, jme, kms, kme,            &
+                   its, ite, jts, jte, kts, kte             )
+!------------------------------------------------------------
+!------------------------------------------------------------
+   IMPLICIT NONE
+!------------------------------------------------------------
+
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
+                                                      rvar
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
+                                                      lvar
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
+
+   ktf=min(kte,kde-1)
+
+   i_start = its
+   i_end   = MIN(ite,ide-1)
+   j_start = jts
+   j_end   = jte
+
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_start = MAX(ids+1,its)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) i_end   = MIN(ide-2,ite)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_start = MAX(jds+1,jts)
+   IF ( config_flags%specified .or. &
+        config_flags%nested) j_end   = MIN(jde-1,jte)
+
+!  write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
+
+   DO j = j_start,j_end
+   DO k = kts,kte
+   DO i = i_start,i_end
+      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
+   ENDDO
+   ENDDO
+   ENDDO
+
+END SUBROUTINE add_c2c_v
+
+#endif
+
+END MODULE module_physics_addtendc
Index: trunk/WRF.COMMON/WRFV3/modif_mars/module_physics_init.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/module_physics_init.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/module_physics_init.F	(revision 2744)
@@ -0,0 +1,1804 @@
+!WRF:MODEL_LAYER:INITIALIZATION
+!
+
+!  This MODULE holds the routines which are used to perform model start-up operations
+!  for the individual domains.  This is the stage after inputting wrfinput and before
+!  calling 'integrate'.
+
+!  This MODULE CONTAINS the following routines:
+
+
+MODULE module_physics_init
+
+!  USE module_io_domain
+   USE module_state_description
+   USE module_model_constants
+!  USE module_timing
+   USE module_configure
+#ifdef DM_PARALLEL
+   USE module_dm
+#endif
+
+CONTAINS
+
+
+!=================================================================
+   SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
+                         p_top, TSK,RADT,BLDT,CUDT,MPDT,         &
+                         RTHCUTEN, RQVCUTEN, RQRCUTEN,           &
+                         RQCCUTEN, RQSCUTEN, RQICUTEN,           &
+                         RUBLTEN,RVBLTEN,RTHBLTEN,               &
+                         RQVBLTEN,RQCBLTEN,RQIBLTEN,             &
+                         RTHRATEN,RTHRATENLW,RTHRATENSW,         &
+                         STEPBL,STEPRA,STEPCU,                   &
+                         W0AVG, RAINNC, RAINC, RAINCV, RAINNCV,  &
+                         NCA,swrad_scat,                         &
+                         CLDEFI,LOWLYR,                          &
+                         MASS_FLUX,                              &
+                         RTHFTEN, RQVFTEN,                       &
+                         CLDFRA,CLDFRA_OLD,GLW,GSW,EMISS,EMBCK,  & !EMBCK new 
+                         LU_INDEX,                               &
+                         landuse_ISICE, landuse_LUCATS,          &
+                         landuse_LUSEAS, landuse_ISN,            &
+                         lu_state,                               &
+                         XLAT,XLONG,ALBEDO,ALBBCK,GMT,JULYR,JULDAY,&
+                         levsiz, n_ozmixm, n_aerosolc, paerlev,  &
+                         TMN,XLAND,ZNT,Z0,UST,MOL,PBLH,TKE_MYJ,  &
+                         EXCH_H,THC,SNOWC,MAVAIL,HFX,QFX,RAINBL, &
+                         TSLB,ZS,DZS,num_soil_layers,warm_rain,  & 
+                         adv_moist_cond,                         &
+                         APR_GR,APR_W,APR_MC,APR_ST,APR_AS,      &
+                         APR_CAPMA,APR_CAPME,APR_CAPMI,          &
+                         XICE,XICEM,VEGFRA,SNOW,CANWAT,SMSTAV,   &
+                         SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW,&
+                         ACSNOM,IVGTYP,ISLTYP, SFCEVP, SMOIS,    &
+                         SH2O, SNOWH, SMFR3D,                    &  ! temporary
+                         DX,DY,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, &
+                         mp_restart_state,tbpvs_state,tbpvs0_state,&
+                         allowed_to_read, moved, start_of_simulation,&
+                         ids, ide, jds, jde, kds, kde,           &
+                         ims, ime, jms, jme, kms, kme,           &
+                         its, ite, jts, jte, kts, kte,           &
+                         ozmixm,pin,                             &    ! Optional
+                         m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& ! Optional
+                         RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,         &    ! Optional
+                         RQVNDGDTEN,RMUNDGDTEN,                  &    ! Optional
+                         FGDT,STEPFG,                            &    ! Optional
+                         cugd_tten,cugd_ttens,cugd_qvten,        &    ! Optional
+                         cugd_qvtens,cugd_qcten,                 &    ! Optional
+!                        num_roof_layers,num_wall_layers,        & !Optional urban
+!                        num_road_layers,                        & !Optional urban
+                         DZR, DZB, DZG,                          & !Optional urban
+                         TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,    & !Optional urban
+                         QC_URB2D, XXXR_URB2D,XXXB_URB2D,        & !Optional urban
+                         XXXG_URB2D, XXXC_URB2D,                 & !Optional urban
+                         TRL_URB3D, TBL_URB3D, TGL_URB3D,        & !Optional urban
+                         SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D,  & !Optional urban
+                         TS_URB2D, FRC_URB2D, UTYPE_URB2D,       & !Optional urban
+                         TML,T0ML,HML,H0ML,HUML,HVML,            & !Optional oml
+                         itimestep                               & !Optional obs fdda
+#if ( EM_CORE == 1 )
+                         ,fdob                                   & !Optional obs fdda
+#endif
+                         )
+
+!-----------------------------------------------------------------
+   USE module_domain
+   USE module_wrf_error
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE (grid_config_rec_type)              :: config_flags
+
+   INTEGER , INTENT(IN)        :: id
+   LOGICAL , INTENT(OUT)       :: warm_rain,adv_moist_cond
+!   LOGICAL , INTENT (IN)       :: FNDSOILW, FNDSNOWH
+   LOGICAL, PARAMETER          :: FNDSOILW=.true., FNDSNOWH=.true.
+   INTEGER , INTENT(IN)        :: ids, ide, jds, jde, kds, kde,  &
+                                  ims, ime, jms, jme, kms, kme,  &
+                                  its, ite, jts, jte, kts, kte
+
+   INTEGER , INTENT(IN)        :: num_soil_layers
+
+   LOGICAL,  INTENT(IN)        :: start_of_simulation
+   REAL,     INTENT(IN)        :: DT, p_top, DX, DY
+   LOGICAL,  INTENT(IN)        :: restart
+   REAL,     INTENT(IN)        :: RADT,BLDT,CUDT,MPDT
+   REAL,     INTENT(IN)        :: swrad_scat
+
+   REAL,     DIMENSION( kms:kme ) , INTENT(IN) :: zfull, zhalf
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: TSK, XLAT, XLONG
+
+   INTEGER,      INTENT(IN   )    ::   levsiz, n_ozmixm
+   INTEGER,      INTENT(IN   )    ::   paerlev, n_aerosolc
+
+   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL, &
+          INTENT(INOUT) ::                                  OZMIXM
+
+   REAL,  DIMENSION(levsiz), OPTIONAL, INTENT(INOUT)  ::        PIN
+
+   REAL,  DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT)  :: m_ps_1,m_ps_2
+   REAL,  DIMENSION(paerlev), OPTIONAL,INTENT(INOUT)  ::          m_hybi
+   REAL,  DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, &
+          INTENT(INOUT) ::                    aerosolc_1, aerosolc_2
+
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),&
+                 INTENT(INOUT) :: SMOIS, SH2O,TSLB
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), INTENT(OUT) :: SMFR3D
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                           SNOW, &
+                                                         SNOWC, &
+                                                         SNOWH, &
+                                                        CANWAT, &
+                                                        SMSTAV, &
+                                                        SMSTOT, &
+                                                     SFCRUNOFF, &
+                                                      UDRUNOFF, &
+                                                        SFCEVP, &
+                                                        GRDFLX, &
+                                                        ACSNOW, &
+                                                          XICE, &
+                                                         XICEM, &
+                                                        VEGFRA, &
+                                                        ACSNOM
+
+   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                         IVGTYP, &
+                                                        ISLTYP
+
+! rad
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+             RTHRATEN, RTHRATENLW, RTHRATENSW, CLDFRA
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: &
+             CLDFRA_OLD
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) ::         &
+             GSW,ALBEDO,ALBBCK,GLW,EMISS,EMBCK                          !EMBCK new
+
+   REAL,     INTENT(IN) :: GMT
+
+   INTEGER , INTENT(OUT) :: STEPRA, STEPBL, STEPCU
+   INTEGER , INTENT(IN) :: JULYR, JULDAY
+
+! cps
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+             RTHCUTEN, RQVCUTEN, RQRCUTEN, RQCCUTEN, RQSCUTEN,   &
+             RQICUTEN
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: MASS_FLUX,   &
+                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+                      APR_CAPMA,APR_CAPME,APR_CAPMI
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+             RTHFTEN, RQVFTEN
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) ::           &
+             RAINNC, RAINC, RAINCV, RAINNCV
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: CLDEFI, NCA
+
+   INTEGER,  DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: LOWLYR
+
+!pbl
+
+   ! soil layer
+
+
+   REAL,     DIMENSION(1:num_soil_layers),      INTENT(INOUT) :: ZS,DZS
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+             RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN,RQIBLTEN,EXCH_H,TKE_MYJ
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) ::    &
+             cugd_tten,cugd_ttens,cugd_qvten,                &
+             cugd_qvtens,cugd_qcten
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) ::         &
+             XLAND,ZNT,Z0,UST,MOL,LU_INDEX,                         &
+             PBLH,THC,MAVAIL,HFX,QFX,RAINBL
+   INTEGER , INTENT(INOUT)  :: landuse_ISICE, landuse_LUCATS
+   INTEGER , INTENT(INOUT)  :: landuse_LUSEAS, landuse_ISN
+   REAL    , INTENT(INOUT)  , DIMENSION( : ) :: lu_state
+
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: TMN
+
+!mp
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::   &
+             F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
+   REAL, DIMENSION(:), INTENT(INOUT)   :: mp_restart_state,tbpvs_state,tbpvs0_state
+   LOGICAL,  INTENT(IN)  :: allowed_to_read, moved
+
+! ocean mixed layer
+   REAL,     DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &
+             TML,T0ML,HML,H0ML,HUML,HVML
+
+!fdda
+   REAL,     OPTIONAL, INTENT(IN) :: FGDT
+   INTEGER , OPTIONAL, INTENT(OUT) :: STEPFG
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) ::    &
+             RUNDGDTEN, RVNDGDTEN, RTHNDGDTEN, RQVNDGDTEN
+   REAL,     DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(OUT) ::    &
+             RMUNDGDTEN
+
+!URBAN
+!   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR   !urban
+!   REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB   !urban
+!   REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG   !urban
+   REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR    !urban
+   REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB    !urban
+   REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG    !urban
+
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !urban
+
+!   REAL, DIMENSION(ims:ime, 1:num_roof_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D !urban
+!   REAL, DIMENSION(ims:ime, 1:num_wall_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D !urban
+!   REAL, DIMENSION(ims:ime, 1:num_road_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D !urban
+   REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D  !urban
+   REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D  !urban
+   REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D  !urban
+
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !urban
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !urban
+   INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !urban
+
+!obs fdda
+   INTEGER, OPTIONAL, INTENT(IN) :: itimestep
+#if ( EM_CORE == 1 ) 
+   TYPE(fdob_type), OPTIONAL, INTENT(INOUT) :: fdob
+#endif
+
+! Local data
+
+   REAL    :: ALBLND,ZZLND,ZZWTR,THINLD,XMAVA,CEN_LAT,pptop
+   REAL,     DIMENSION( kms:kme )  :: sfull, shalf
+   REAL :: obs_twindo_cg, obs_twindo
+   
+   CHARACTER*4 :: MMINLU_loc
+   CHARACTER*80 :: message
+   INTEGER :: ISWATER
+   INTEGER :: ucmcall
+   INTEGER :: omlcall
+   REAL    :: oml_hml0
+   LOGICAL :: usemonalb
+
+   INTEGER :: i, j, k, itf, jtf
+integer myproc
+
+!-----------------------------------------------------------------
+
+   ucmcall=config_flags%ucmcall
+   usemonalb=config_flags%usemonalb
+#if ( EM_CORE == 1 ) 
+   obs_twindo_cg=model_config_rec%obs_twindo(1)
+   obs_twindo=config_flags%obs_twindo
+   oml_hml0=config_flags%oml_hml0
+   omlcall=config_flags%omlcall
+#endif
+
+!-- should be from the namelist
+
+   sfull = 0.
+   shalf = 0.
+
+   CALL wrf_debug(100,'top of phy_init')
+
+   WRITE(wrf_err_message,*) 'phy_init:  start_of_simulation = ',start_of_simulation
+   CALL wrf_debug ( 100, TRIM(wrf_err_message) )
+
+   itf=min0(ite,ide-1)
+   jtf=min0(jte,jde-1)
+
+   ZZLND=0.1
+   ZZWTR=0.0001
+   THINLD=0.04
+   ALBLND=0.2
+   XMAVA=0.3
+
+#if (NMM_CORE == 1)
+   if (.not.usemonalb) CALL wrf_error_fatal('usemonalb should always be true for NMM')
+#endif
+
+   CALL nl_get_cen_lat(id,cen_lat)
+   CALL wrf_debug(100,'calling nl_get_iswater, nl_get_mminlu_loc')
+   CALL nl_get_iswater(id,iswater)
+   CALL nl_get_mminlu( 1, mminlu_loc )
+   CALL wrf_debug(100,'after nl_get_iswater, nl_get_mminlu_loc')
+
+  IF(.not.restart)THEN
+!-- initialize common variables
+
+   IF ( .NOT. moved ) THEN
+   DO j=jts,jtf
+   DO i=its,itf
+      XLAND(i,j)=1.
+      GSW(i,j)=0.
+      GLW(i,j)=0.
+      UST(i,j)=0.
+      MOL(i,j)=0.0
+      PBLH(i,j)=0.0
+      HFX(i,j)=0.
+      QFX(i,j)=0.
+      RAINBL(i,j)=0.
+      RAINNCV(i,j)=0.
+      ACSNOW(i,j)=0.
+      DO k=kms,kme  !wig, 17-May-2006: Added for idealized chem. runs
+         EXCH_H(i,k,j) = 0.
+      END DO
+   ENDDO
+   ENDDO
+   ENDIF
+
+!
+   DO j=jts,jtf
+   DO i=its,itf
+     IF(XLAND(i,j) .LT. 1.5)THEN
+       IF(mminlu_loc .EQ. '    ') ALBBCK(i,j)=ALBLND
+       EMBCK(i,j)=0.85
+       ALBEDO(i,j)=ALBBCK(i,j)
+       EMISS(i,j)=EMBCK(i,j)
+       THC(i,j)=THINLD
+       ZNT(i,j)=ZZLND
+#if  ! ( NMM_CORE == 1 ) 
+       Z0(i,j)=ZZLND
+#endif
+       MAVAIL(i,j)=XMAVA
+     ELSE
+       IF(mminlu_loc .EQ. '    ') ALBBCK(i,j)=0.08
+       ALBEDO(i,j)=ALBBCK(i,j)
+       EMBCK(i,j)=0.98
+       EMISS(i,j)=EMBCK(i,j)
+       THC(i,j)=THINLD
+       ZNT(i,j)=ZZWTR
+#if  ! ( NMM_CORE == 1 ) 
+       Z0(i,j)=ZZWTR
+#endif
+       MAVAIL(i,j)=1.0 
+     ENDIF
+
+   ENDDO
+   ENDDO
+
+   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to landuse_init' )
+
+   IF(mminlu_loc .ne. '    ')THEN
+!-- initialize surface properties
+
+     CALL landuse_init(lu_index, snowc, albedo, albbck, mavail, emiss, embck,            &
+                znt, Z0, thc, xland, xice, xicem, julday, cen_lat, iswater, mminlu_loc,  &
+                landuse_ISICE, landuse_LUCATS,                      &
+                landuse_LUSEAS, landuse_ISN,                        &
+                lu_state,                                           &
+                allowed_to_read , usemonalb ,                       &
+                ids, ide, jds, jde, kds, kde,                       &
+                ims, ime, jms, jme, kms, kme,                       &
+                its, ite, jts, jte, kts, kte                       ) 
+   ENDIF
+
+  ENDIF
+
+!-- convert zfull and zhalf to sigma values for ra_init (Eta CO2 needs these)
+!-- zfull/zhalf may be either zeta or eta
+!-- what is done here depends on coordinate (check this code if adding new coordinates)
+   CALL z2sigma(zfull,zhalf,sfull,shalf,p_top,pptop,config_flags, &
+                allowed_to_read,                                  &
+                kds,kde,kms,kme,kts,kte)
+
+!!!!******MARS MARS MARS
+!!!!******MARS MARS MARS
+!!!!******MARS MARS MARS
+
+!
+!!-- initialize physics
+!!-- ra: radiation
+!!-- bl: pbl
+!!-- cu: cumulus
+!!-- mp: microphysics
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to ra_init' )
+!
+!   CALL ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,             &
+!                RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT,    &
+!                levsiz,XLAT,n_ozmixm,                           &
+!                cldfra_old,                                     & ! Optional
+!                ozmixm,pin,                                     & ! Optional
+!                m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,     & ! Optional
+!                paerlev,n_aerosolc,                             &
+!                sfull,shalf,pptop,swrad_scat,                   &
+!                config_flags,restart,                           & 
+!                allowed_to_read, start_of_simulation,           &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to bl_init' )
+!
+!   CALL bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,        &
+!                RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN,             &
+!                config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS,    &
+!                num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA,          &
+!                SNOW,SNOWC, CANWAT,SMSTAV,                      &
+!                SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM,       &
+!                IVGTYP,ISLTYP,SMOIS,SMFR3D,MAVAIL,              &
+!                SNOWH,SH2O,FNDSOILW, FNDSNOWH,                  &
+!#if (NMM_CORE == 1)
+!                Z0,XLAND,XICE,                                  &
+!#else
+!                ZNT,XLAND,XICE,                                 &
+!#endif
+!                SFCEVP,GRDFLX,                                  &
+!                allowed_to_read ,                               &
+!                start_of_simulation ,                           &
+!                DZR, DZB, DZG,                                  & !Optional urban
+!                TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D,   & !Optional urban
+!                XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,    & !Optional urban
+!                TRL_URB3D, TBL_URB3D, TGL_URB3D,                & !Optional urban
+!                SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D,          & !Optional urban
+!                TS_URB2D, FRC_URB2D, UTYPE_URB2D, UCMCALL,      & !Optional urban
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte,                   &
+!                oml_hml0, omlcall,                              & !Optional oml
+!                TML,T0ML,HML,H0ML,HUML,HVML                     ) !Optional oml
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to cu_init' )
+!
+!   CALL cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN,      &
+!                RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC,           &
+!                RAINCV,W0AVG,config_flags,restart,              &
+!                CLDEFI,LOWLYR,MASS_FLUX,                        &
+!                RTHFTEN, RQVFTEN,                               &
+!                APR_GR,APR_W,APR_MC,APR_ST,APR_AS,              &
+!                APR_CAPMA,APR_CAPME,APR_CAPMI,                  &
+!                cugd_tten,cugd_ttens,cugd_qvten,                &
+!                cugd_qvtens,cugd_qcten,                         &
+!                allowed_to_read, start_of_simulation,           &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to mp_init' )
+!
+!   CALL mp_init(RAINNC,config_flags,restart,warm_rain,          &
+!                adv_moist_cond,                                 &
+!                MPDT, DT, DX, DY, LOWLYR,                       & 
+!                F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,               &
+!                mp_restart_state,tbpvs_state,tbpvs0_state,      &
+!                allowed_to_read, start_of_simulation,           &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!   write(message,*)'STEPRA,STEPCU,STEPBL',STEPRA,STEPCU,STEPBL
+!   CALL wrf_message( message )
+!
+!#if  ( EM_CORE == 1 )
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fg_init' )
+!
+!   CALL fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN,          &
+!                RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,               &
+!                config_flags,restart,                           &
+!                allowed_to_read ,                               &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!   CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fdob_init' )
+!
+!   CALL fdob_init(model_config_rec%obs_nudge_opt,               &
+!                  model_config_rec%max_dom,                     &
+!                  id,                                           &
+!                  model_config_rec%parent_id,                   &
+!                  model_config_rec%obs_idynin,                  &
+!                  model_config_rec%obs_dtramp,                  &
+!                  model_config_rec%fdda_end,                    &
+!                  config_flags%restart,                         &
+!                  obs_twindo_cg, obs_twindo,                    &
+!                  itimestep,                                    &
+!                  config_flags%cen_lat,                         &
+!                  config_flags%cen_lon,                         &
+!                  config_flags%stand_lon,                       &
+!                  config_flags%truelat1,                        &
+!                  config_flags%truelat2,                        &
+!                  config_flags%map_proj,                        &
+!                  xlat,                                         & 
+!                  xlong,                                        & 
+!                  model_config_rec%s_sn(1),                     &
+!                  model_config_rec%e_sn(1),                     &
+!                  model_config_rec%s_we(1),                     &
+!                  model_config_rec%e_we(1),                     &
+!                  fdob,                                         &
+!                  model_config_rec%obs_ipf_init,                &
+!                  ids, ide, jds, jde, kds, kde,                 &
+!                  ims, ime, jms, jme, kms, kme,                 &
+!                  its, ite, jts, jte, kts, kte                  )
+!
+!#endif
+
+   END SUBROUTINE phy_init
+
+!=====================================================================
+   SUBROUTINE landuse_init(lu_index, snowc, albedo, albbck, mavail, emiss, embck, &
+                znt,Z0,thc,xland, xice, xicem, julday, cen_lat, iswater, mminlu,  &
+                ISICE, LUCATS, LUSEAS, ISN,                         &
+                lu_state,                                           &
+                allowed_to_read , usemonalb ,                       &
+                ids, ide, jds, jde, kds, kde,                       &
+                ims, ime, jms, jme, kms, kme,                       &
+                its, ite, jts, jte, kts, kte                       )
+
+   USE module_wrf_error
+   IMPLICIT NONE
+
+!---------------------------------------------------------------------
+   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,   &
+                                     ims, ime, jms, jme, kms, kme,   &
+                                     its, ite, jts, jte, kts, kte
+
+   INTEGER , INTENT(IN)           :: iswater, julday
+   REAL    , INTENT(IN)           :: cen_lat
+   CHARACTER*4, INTENT(IN)        :: mminlu
+   LOGICAL,  INTENT(IN)           :: allowed_to_read , usemonalb
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: lu_index, snowc, xice
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT  ) :: albedo, albbck, mavail, emiss, &
+                                                               embck,                         &
+                                                               znt, Z0, thc, xland, xicem
+   INTEGER , INTENT(INOUT)  :: ISICE, LUCATS, LUSEAS, ISN
+   REAL    , INTENT(INOUT)  , DIMENSION( : ) :: lu_state
+
+!---------------------------------------------------------------------
+! Local
+   CHARACTER*4 LUTYPE
+   CHARACTER*80 :: message
+   INTEGER  :: landuse_unit, LS, LC, LI, LUN, NSN
+   INTEGER  :: i, j, itf, jtf, is, cats, seas, curs
+   INTEGER , PARAMETER :: OPEN_OK = 0
+   INTEGER :: ierr
+   INTEGER , PARAMETER :: max_cats = 100 , max_seas = 12 
+   REAL    , DIMENSION( max_cats, max_seas ) :: ALBD, SLMO, SFEM, SFZ0, THERIN, SFHC
+   REAL    , DIMENSION( max_cats )     :: SCFX
+! save these fields in case nest moves or has to be reinitialized
+! and this routine is called with allowed_to_read set to false
+! note that by saving these, we're locking in the same landuse for
+! the duration of a run; possible implications for long climate runs
+   LOGICAL :: found_lu, end_of_file
+   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
+
+!---------------------------------------------------------------------
+
+   CALL wrf_debug( 100 , 'top of landuse_init' )
+
+   NSN=-1  ! set this to suppress uninitalized data messages from tools
+
+! recover LU variables from state
+   IF ( 6*(max_cats*max_seas)+1*max_cats .GT. 7501 ) THEN
+      WRITE(message,*)'landuse_init: lu_state overflow. Make Registry dimspec p > ',6*(max_cats*max_seas)+1*max_cats
+   ENDIF
+   curs = 1
+   DO cats = 1, max_cats
+     SCFX(cats) =           lu_state(curs)         ; curs = curs + 1
+     DO seas = 1, max_seas
+       ALBD(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SLMO(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SFEM(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SFZ0(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SFHC(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       THERIN(cats,seas) =  lu_state(curs)         ; curs = curs + 1
+     ENDDO
+   ENDDO
+
+! Determine season (summer=1, winter=2)
+   ISN=1                                                            
+   IF(JULDAY.LT.105.OR.JULDAY.GT.288)ISN=2                         
+   IF(CEN_LAT.LT.0.0)ISN=3-ISN                                   
+
+   FOUND_LU = .TRUE.
+   IF ( allowed_to_read ) THEN
+      landuse_unit = 29
+      IF ( wrf_dm_on_monitor() ) THEN
+        OPEN(landuse_unit, FILE='LANDUSE.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
+        IF ( ierr .NE. OPEN_OK ) THEN
+          WRITE(message,FMT='(A)') &
+          'module_physics_init.F: LANDUSE_INIT: open failure for LANDUSE.TBL'
+          CALL wrf_error_fatal ( message ) 
+        END IF
+      ENDIF
+
+! Read info from file LANDUSE.TBL
+      IF(MMINLU.EQ.'OLD ')THEN
+!       ISWATER=7
+        ISICE=11 
+      ELSE IF(MMINLU.EQ.'USGS')THEN
+!       ISWATER=16
+        ISICE=24
+      ELSE IF(MMINLU.EQ.'SiB ')THEN
+!       ISWATER=15
+        ISICE=16
+      ELSE IF(MMINLU.EQ.'LW12')THEN
+!       ISWATER=15
+        ISICE=3
+      ENDIF
+      PRINT *, 'INPUT LANDUSE = ',MMINLU
+      FOUND_LU = .FALSE.
+      end_of_file = .FALSE.
+!!! BEGINNING OF 1999 LOOP
+ 1999 CONTINUE                                                      
+      IF ( wrf_dm_on_monitor() ) THEN
+        READ (landuse_unit,2000,END=2002)LUTYPE                                
+        GOTO 2003
+ 2002   CONTINUE
+        CALL wrf_message( 'INPUT FILE FOR LANDUSE REACHED END OF FILE' )
+        end_of_file = .TRUE.
+ 2003   CONTINUE
+        IF ( .NOT. end_of_file ) READ (landuse_unit,*)LUCATS,LUSEAS                                    
+        FOUND_LU = LUTYPE.EQ.MMINLU
+      ENDIF
+      CALL wrf_dm_bcast_bytes (end_of_file, LWORDSIZE )
+      IF ( .NOT. end_of_file ) THEN
+        CALL wrf_dm_bcast_string(lutype, 4)
+        CALL wrf_dm_bcast_bytes (lucats,  IWORDSIZE )
+        CALL wrf_dm_bcast_bytes (luseas,  IWORDSIZE )
+        CALL wrf_dm_bcast_bytes (found_lu,  LWORDSIZE )
+ 2000   FORMAT (A4)                                                
+        IF(FOUND_LU)THEN                                  
+          LUN=LUCATS                                             
+          NSN=LUSEAS                                            
+            PRINT *, 'LANDUSE TYPE = ',LUTYPE,' FOUND',        &
+                   LUCATS,' CATEGORIES',LUSEAS,' SEASONS',     &
+                   ' WATER CATEGORY = ',ISWATER,               &
+                   ' SNOW CATEGORY = ',ISICE                
+        ENDIF                                             
+        DO ls=1,luseas                                   
+          if ( wrf_dm_on_monitor() ) then
+            READ (landuse_unit,*)                                   
+          endif
+          DO LC=1,LUCATS                               
+            IF(found_lu)THEN                  
+              IF ( wrf_dm_on_monitor() ) THEN
+                READ (landuse_unit,*)LI,ALBD(LC,LS),SLMO(LC,LS),SFEM(LC,LS),        &       
+                           SFZ0(LC,LS),THERIN(LC,LS),SCFX(LC),SFHC(LC,LS)       
+              ENDIF
+              CALL wrf_dm_bcast_bytes (LI,  IWORDSIZE )
+              IF(LC.NE.LI)CALL wrf_error_fatal ( 'module_start: MISSING LANDUSE UNIT ' )
+            ELSE                                                            
+              IF ( wrf_dm_on_monitor() ) THEN
+                READ (landuse_unit,*)                                                  
+              ENDIF
+            ENDIF                                                         
+          ENDDO                                                          
+        ENDDO                                                           
+        IF(NSN.EQ.1.AND.FOUND_LU) THEN
+           ISN = 1
+        END IF
+        CALL wrf_dm_bcast_bytes (albd,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (slmo,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (sfem,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (sfz0,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (therin, max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (sfhc,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (scfx,   max_cats *            RWORDSIZE )
+      ENDIF
+
+      IF(.NOT. found_lu .AND. .NOT. end_of_file ) GOTO 1999
+!!! END OF 1999 LOOP
+
+      IF(.NOT. found_lu .OR. end_of_file )THEN                                         
+        CALL wrf_message ( 'LANDUSE IN INPUT FILE DOES NOT MATCH LUTABLE: TABLE NOT USED' )
+      ENDIF                                                     
+    ENDIF  ! allowed_to_read
+
+    IF(FOUND_LU)THEN
+! Set arrays according to lu_index
+      itf = min0(ite, ide-1)
+      jtf = min0(jte, jde-1)
+      IF(usemonalb)CALL wrf_message ( 'Climatological albedo is used instead of table values' )
+      DO j = jts, jtf
+        DO i = its, itf
+          IS=nint(lu_index(i,j))
+          ! only do this check on read-in data
+          IF(IS.LT.0.OR.IS.GT.LUN.AND.allowed_to_read)THEN                                        
+            WRITE ( wrf_err_message , * ) 'ERROR: LANDUSE OUTSIDE RANGE =',IS,' AT ',I,J,' LUN= ',LUN
+            CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+          ENDIF                                                            
+!   SET NO-DATA POINTS (IS=0) TO WATER                                    
+          IF(IS.EQ.0)THEN                                                
+            IS=ISWATER                                                  
+          ENDIF                                                        
+          IF(.NOT.usemonalb)ALBBCK(I,J)=ALBD(IS,ISN)/100.                                  
+          ALBEDO(I,J)=ALBBCK(I,J)
+          IF(SNOWC(I,J) .GT. 0.5)ALBEDO(I,J)=ALBBCK(I,J)*(1.+SCFX(IS))
+          THC(I,J)=THERIN(IS,ISN)/100.                               
+          Z0(I,J)=SFZ0(IS,ISN)/100.                                
+          ZNT(I,J)=Z0(I,J)
+          EMBCK(I,J)=SFEM(IS,ISN)                                  
+          EMISS(I,J)=EMBCK(I,J)                                  
+          MAVAIL(I,J)=SLMO(IS,ISN)                                
+          IF(IS.NE.ISWATER)THEN                                  
+            XLAND(I,J)=1.0                                      
+          ELSE                                                 
+            XLAND(I,J)=2.0                                    
+          ENDIF                                              
+!    SET SEA-ICE POINTS TO LAND WITH ICE/SNOW SURFACE PROPERTIES
+          XICEM(I,J)=XICE(I,J)
+          IF(XICE(I,J).GT.0.5)THEN
+            XLAND(I,J)=1.0
+            ALBBCK(I,J)=ALBD(ISICE,ISN)/100.
+            ALBEDO(I,J)=ALBBCK(I,J)
+            THC(I,J)=THERIN(ISICE,ISN)/100.                              
+            Z0(I,J)=SFZ0(ISICE,ISN)/100.                               
+            ZNT(I,J)=Z0(I,J)
+            EMBCK(I,J)=SFEM(ISICE,ISN)                                 
+            EMISS(I,J)=EMBCK(I,J)                                  
+            MAVAIL(I,J)=SLMO(ISICE,ISN)                               
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDIF
+    if ( wrf_dm_on_monitor() .and. allowed_to_read ) then
+      CLOSE (landuse_unit)
+    endif
+    CALL wrf_debug( 100 , 'returning from of landuse_init' )
+
+! restore LU variables from state
+    curs = 1
+    DO cats = 1, max_cats
+      lu_state(curs) = SCFX(cats)                 ; curs = curs + 1
+      DO seas = 1, max_seas
+        lu_state(curs) = ALBD(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SLMO(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SFEM(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SFZ0(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SFHC(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = THERIN(cats,seas)        ; curs = curs + 1
+      ENDDO
+    ENDDO
+
+    RETURN
+        
+   END SUBROUTINE landuse_init 
+
+!!!!******MARS MARS MARS
+!!!!******MARS MARS MARS
+!!!!******MARS MARS MARS
+
+!!=====================================================================
+!   SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       & 
+!                      RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT,    &
+!                      levsiz,XLAT,n_ozmixm,                           &
+!                      cldfra_old,                                     & ! Optional
+!                      ozmixm,pin,                                     & ! Optional
+!                      m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,     & ! Optional
+!                      paerlev,n_aerosolc,                             &
+!                      sfull,shalf,pptop,swrad_scat,                  &
+!                      config_flags,restart,                          & 
+!                      allowed_to_read, start_of_simulation,          &
+!                      ids, ide, jds, jde, kds, kde,                  &
+!                      ims, ime, jms, jme, kms, kme,                  &
+!                      its, ite, jts, jte, kts, kte                   )
+!!---------------------------------------------------------------------
+!   USE module_ra_rrtm
+!   USE module_ra_cam
+!   USE module_ra_sw
+!   USE module_ra_gsfcsw
+!   USE module_ra_gfdleta
+!   USE module_ra_hs
+!   USE module_domain
+!!---------------------------------------------------------------------
+!   IMPLICIT NONE
+!!---------------------------------------------------------------------
+!   INTEGER,  INTENT(IN)           :: id
+!   TYPE (grid_config_rec_type)    :: config_flags
+!   LOGICAL , INTENT(IN)           :: restart
+!   LOGICAL,  INTENT(IN)           :: allowed_to_read
+!
+!   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,   &
+!                                     ims, ime, jms, jme, kms, kme,   &
+!                                     its, ite, jts, jte, kts, kte
+!
+!   INTEGER , INTENT(IN)           :: JULDAY,JULYR
+!   REAL ,    INTENT(IN)           :: DT, RADT, cen_lat, GMT, pptop,  &
+!                                     swrad_scat
+!   LOGICAL,  INTENT(IN)           :: start_of_simulation
+!
+!   INTEGER,      INTENT(IN   )    ::   levsiz, n_ozmixm
+!   INTEGER,      INTENT(IN   )    ::   paerlev, n_aerosolc
+!
+!   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::  XLAT
+!
+!   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL,      &
+!          INTENT(INOUT) ::                                  OZMIXM
+!
+!   REAL,  DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT)  :: m_ps_1,m_ps_2
+!   REAL,  DIMENSION(paerlev), OPTIONAL, INTENT(INOUT)  ::         m_hybi
+!   REAL,  DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL,     &
+!          INTENT(INOUT) ::                      aerosolc_1, aerosolc_2
+!
+!   REAL,  DIMENSION(levsiz), OPTIONAL, INTENT(INOUT)  ::          PIN
+!
+!   INTEGER , INTENT(INOUT)        :: STEPRA
+!   INTEGER :: isn
+!
+!   REAL , DIMENSION( kms:kme ) , INTENT(IN) :: sfull, shalf
+!   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::           &
+!                                                           RTHRATEN, &
+!                                                         RTHRATENLW, &
+!                                                         RTHRATENSW, &
+!                                                             CLDFRA
+!
+!   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: &
+!                                                         CLDFRA_OLD
+!
+!   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: EMISS
+!   LOGICAL :: etalw = .false.
+!   LOGICAL :: camlw = .false.
+!   LOGICAL :: etamp = .false.
+!   integer :: month,iday
+!   INTEGER :: i, j, k, itf, jtf, ktf
+!!---------------------------------------------------------------------
+!
+!   jtf=min0(jte,jde-1)
+!   ktf=min0(kte,kde-1)
+!   itf=min0(ite,ide-1)
+!
+!!---------------------------------------------------------------------
+!
+!!-- calculate radiation time step
+!
+!    STEPRA = nint(RADT*60./DT)
+!    STEPRA = max(STEPRA,1)
+!
+!!-- initialization
+!
+!   IF(start_of_simulation)THEN
+!     DO j=jts,jtf
+!     DO k=kts,ktf
+!     DO i=its,itf
+!        RTHRATEN(i,k,j)=0.
+!        RTHRATENLW(i,k,j)=0.
+!        RTHRATENSW(i,k,j)=0.
+!        CLDFRA(i,k,j)=0.
+!     ENDDO
+!     ENDDO
+!     ENDDO
+!
+!     if( present(cldfra_old) ) then
+!        DO j=jts,jtf
+!        DO k=kts,ktf
+!        DO i=its,itf
+!           cldfra_old(i,k,j) = 0.
+!        ENDDO
+!        ENDDO
+!        ENDDO
+!     end if
+!   ENDIF
+!
+!!-- find out which microphysics option is used first
+!
+!   mp_select: SELECT CASE(config_flags%mp_physics)
+!
+!        CASE (ETAMPNEW)
+!             etamp = .true.
+!
+!   END SELECT mp_select
+!
+!!-- chose long wave radiation scheme
+! 
+!   lwrad_select: SELECT CASE(config_flags%ra_lw_physics)
+!
+!        CASE (RRTMSCHEME)
+!             CALL rrtminit(                                 &
+!                           allowed_to_read ,                &
+!                           ids, ide, jds, jde, kds, kde,    &
+!                           ims, ime, jms, jme, kms, kme,    &
+!                           its, ite, jts, jte, kts, kte     )
+!
+!        CASE (CAMLWSCHEME)
+!#ifdef MAC_KLUDGE
+!             CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' )
+!#endif
+!             IF ( PRESENT( OZMIXM ) .AND. PRESENT( PIN ) .AND. &
+!                  PRESENT(M_PS_1) .AND. PRESENT(M_PS_2) .AND.  &
+!                  PRESENT(M_HYBI) .AND. PRESENT(AEROSOLC_1)    &
+!                  .AND. PRESENT(AEROSOLC_2)) THEN
+!             CALL camradinit(                                  &
+!                         R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, &
+!                         ozmixm,pin,levsiz,XLAT,n_ozmixm,      &
+!                         m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,&
+!                         paerlev, n_aerosolc,              &
+!                         ids, ide, jds, jde, kds, kde,     &
+!                         ims, ime, jms, jme, kms, kme,     &
+!                         its, ite, jts, jte, kts, kte      )
+!             ELSE
+!                CALL wrf_error_fatal ( 'arguments not present for calling cam radiation' )
+!             ENDIF
+!
+!             camlw = .true.
+!
+!        CASE (GFDLLWSCHEME)
+!             CALL nl_get_start_month(id,month)
+!             CALL nl_get_start_day(id,iday)
+!             CALL gfdletainit(emiss,sfull,shalf,pptop,      &
+!                              julyr,month,iday,gmt,         &
+!                              config_flags,allowed_to_read, &
+!                              ids, ide, jds, jde, kds, kde, &
+!                              ims, ime, jms, jme, kms, kme, &
+!                              its, ite, jts, jte, kts, kte  )
+!             etalw = .true.
+!        CASE (HELDSUAREZ)
+!             CALL hsinit(RTHRATEN,restart,             &
+!                         ids, ide, jds, jde, kds, kde, &
+!                         ims, ime, jms, jme, kms, kme, &
+!                         its, ite, jts, jte, kts, kte )
+!        CASE DEFAULT
+!
+!   END SELECT lwrad_select
+!!-- initialize short wave radiation scheme
+! 
+!   swrad_select: SELECT CASE(config_flags%ra_sw_physics)
+!
+!        CASE (SWRADSCHEME)
+!             CALL swinit(                                  &
+!                         swrad_scat,                       &
+!                         allowed_to_read ,                 &
+!                         ids, ide, jds, jde, kds, kde,     &
+!                         ims, ime, jms, jme, kms, kme,     &
+!                         its, ite, jts, jte, kts, kte      )
+!
+!        CASE (CAMSWSCHEME)
+!#ifdef MAC_KLUDGE
+!             CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' )
+!#endif
+!             IF(.not.camlw)THEN
+!             CALL camradinit(                              &
+!                         R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop,               &
+!                         ozmixm,pin,levsiz,XLAT,n_ozmixm,     &
+!                         m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,&
+!                         paerlev, n_aerosolc,              &
+!                         ids, ide, jds, jde, kds, kde,     &
+!                         ims, ime, jms, jme, kms, kme,     &
+!                         its, ite, jts, jte, kts, kte      )
+!             ENDIF
+!
+!        CASE (GSFCSWSCHEME)
+!             CALL gsfc_swinit(cen_lat, allowed_to_read )
+!
+!        CASE (GFDLSWSCHEME)
+!             IF(.not.etalw)THEN
+!             CALL nl_get_start_month(id,month)
+!             CALL nl_get_start_day(id,iday)
+!             CALL gfdletainit(emiss,sfull,shalf,pptop,      &
+!                              julyr,month,iday,gmt,         &
+!                              config_flags,allowed_to_read, &
+!                              ids, ide, jds, jde, kds, kde, &
+!                              ims, ime, jms, jme, kms, kme, &
+!                              its, ite, jts, jte, kts, kte  )
+!             ENDIF
+!
+!        CASE DEFAULT
+!
+!   END SELECT swrad_select
+!
+!   END SUBROUTINE ra_init
+!
+!   SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
+!                RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN,             &
+!                config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS,    &
+!                num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA,          &
+!                SNOW,SNOWC, CANWAT,SMSTAV,                      &
+!                SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM,       &
+!                IVGTYP,ISLTYP,SMOIS,SMFR3D,mavail,              &
+!                SNOWH,SH2O,FNDSOILW, FNDSNOWH,                  &
+!#if  ( NMM_CORE == 1 )
+!                Z0,XLAND,XICE,                                  &
+!#else
+!                ZNT,XLAND,XICE,                                 &
+!#endif
+!                SFCEVP,GRDFLX,                                  &
+!                allowed_to_read,                                &
+!                start_of_simulation,                            &
+!!                num_roof_layers,num_wall_layers,num_road_layers,& !Optional urban
+!                DZR, DZB, DZG,                                  & !Optional urban
+!                TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D,   & !Optional urban
+!                XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,    & !Optional urban
+!                TRL_URB3D, TBL_URB3D, TGL_URB3D,                & !Optional urban
+!                SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D,             & !Optional urban
+!                TS_URB2D, FRC_URB2D, UTYPE_URB2D,UCMCALL,       & !Optional urban
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte,                   &
+!                oml_hml0, omlcall,                              & !Optional oml
+!                TML,T0ML,HML,H0ML,HUML,HVML                     ) !Optional oml
+!!--------------------------------------------------------------------
+!   USE module_sf_sfclay
+!   USE module_sf_slab
+!   USE module_sf_pxsfclay
+!   USE module_bl_ysu
+!   USE module_bl_mrf
+!   USE module_bl_gfs
+!   USE module_bl_acm
+!   USE module_sf_myjsfc
+!   USE module_sf_noahdrv
+!   USE module_sf_urban
+!   USE module_sf_ruclsm
+!   USE module_sf_pxlsm
+!   USE module_bl_myjpbl
+!#if (NMM_CORE == 1)
+!   USE module_sf_lsm_nmm
+!#endif
+!!--------------------------------------------------------------------
+!   IMPLICIT NONE
+!!--------------------------------------------------------------------
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!   LOGICAL, INTENT(IN)         ::   FNDSOILW, FNDSNOWH
+!
+!   INTEGER , INTENT(IN)        ::     ids, ide, jds, jde, kds, kde, &
+!                                      ims, ime, jms, jme, kms, kme, &
+!                                      its, ite, jts, jte, kts, kte
+!   INTEGER , INTENT(IN)        ::     num_soil_layers
+!   INTEGER , INTENT(IN)        ::     UCMCALL 
+!
+!   REAL ,    INTENT(IN)        ::     DT, BLDT
+!   INTEGER , INTENT(INOUT)     ::     STEPBL
+!
+!   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),    &
+!             INTENT(OUT) :: SMFR3D
+!
+!   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),&
+!                   INTENT(INOUT) :: SMOIS,SH2O,TSLB 
+!
+!   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+!            INTENT(INOUT)    ::                           SNOW, &
+!                                                         SNOWH, &
+!                                                         SNOWC, &
+!                                                        CANWAT, &
+!                                                        MAVAIL, &
+!                                                        SMSTAV, &
+!                                                        SMSTOT, &
+!                                                     SFCRUNOFF, &
+!                                                      UDRUNOFF, &
+!                                                        ACSNOW, &
+!                                                        VEGFRA, &
+!                                                        ACSNOM, &
+!                                                        SFCEVP, &
+!                                                        GRDFLX, &
+!                                                           UST, &
+!#if ( NMM_CORE == 1 )
+!                                                            Z0, &
+!#else
+!                                                           ZNT, &
+!#endif
+!                                                         XLAND, &
+!                                                         XICE
+!
+!   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+!            INTENT(INOUT)    ::                         IVGTYP, &
+!                                                        ISLTYP, &
+!                                                        LOWLYR
+!
+!
+!   REAL,     DIMENSION(1:num_soil_layers), INTENT(INOUT)  ::  ZS,DZS
+!
+!   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+!                                                           RUBLTEN, &
+!                                                           RVBLTEN, &
+! 						          EXCH_H,   &
+!                                                          RTHBLTEN, &
+!                                                          RQVBLTEN, &
+!                                                          RQCBLTEN, &
+!                                                          RQIBLTEN, &
+!                                                          TKE_MYJ
+!
+!   REAL,  DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::     TSK
+!   REAL,  DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) ::  TMN
+!   LOGICAL,  INTENT(IN)           :: allowed_to_read
+!   INTEGER :: isn, isfc
+!
+!!URBAN
+!!   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR  !Optional urban
+!!   REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB  !Optional urban
+!!   REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG  !Optional urban
+!    REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR  !Optional urban
+!    REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB  !Optional urban
+!    REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG  !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !Optional urban
+!    INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !Optional urban
+!!    REAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban
+!!    REAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban
+!!    REAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban
+!
+!! Optional OML variables
+!   REAL,  DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &
+!                                        TML,T0ML,HML,H0ML,HUML,HVML
+!   INTEGER,  OPTIONAL,  INTENT(IN) :: omlcall
+!   REAL,  OPTIONAL,  INTENT(IN) :: oml_hml0
+!   LOGICAL,  INTENT(IN) :: start_of_simulation
+!
+!!-- calculate pbl time step
+!
+!   STEPBL = nint(BLDT*60./DT)
+!   STEPBL = max(STEPBL,1)
+!
+!
+!!-- initialize surface layer scheme
+!
+!   sfclay_select: SELECT CASE(config_flags%sf_sfclay_physics)
+!
+!      CASE (SFCLAYSCHEME)
+!           CALL sfclayinit( allowed_to_read )
+!           isfc = 1
+!      CASE (PXSFCSCHEME)
+!           CALL pxsfclayinit( allowed_to_read )
+!           isfc = 1
+!      CASE (MYJSFCSCHEME)
+!           CALL myjsfcinit(LOWLYR,UST,                         &
+!#if ( NMM_CORE == 1 )
+!                                      Z0,                      &
+!#else
+!                                      ZNT,                     &
+!#endif
+!                                          XLAND,XICE,          &
+!                         IVGTYP,restart,                       &
+!                         allowed_to_read ,                     &
+!                         ids, ide, jds, jde, kds, kde,         &
+!                         ims, ime, jms, jme, kms, kme,         &
+!                         its, ite, jts, jte, kts, kte          )
+!           isfc = 2
+!
+!      CASE (GFSSFCSCHEME)
+!           CALL myjsfcinit(LOWLYR,UST,                         &
+!#if ( NMM_CORE == 1 )
+!                                      Z0,                      &
+!#else
+!                                      ZNT,                     &
+!#endif
+!                                          XLAND,XICE,          &
+!                         IVGTYP,restart,                       &
+!                         allowed_to_read ,                     &
+!                         ids, ide, jds, jde, kds, kde,         &
+!                         ims, ime, jms, jme, kms, kme,         &
+!                         its, ite, jts, jte, kts, kte          )
+!           isfc = 1
+!
+!      CASE DEFAULT
+!
+!   END SELECT sfclay_select
+!
+!
+!!-- initialize surface scheme
+!
+!   sfc_select: SELECT CASE(config_flags%sf_surface_physics)
+!
+!      CASE (SLABSCHEME)
+!
+!           CALL slabinit(TSK,TMN,                              &
+!                         TSLB,ZS,DZS,num_soil_layers,          & 
+!                         allowed_to_read ,start_of_simulation ,&
+!                         ids, ide, jds, jde, kds, kde,         &
+!                         ims, ime, jms, jme, kms, kme,         &
+!                         its, ite, jts, jte, kts, kte,         &
+!                         oml_hml0, omlcall,                    &
+!                         tml, t0ml, hml, h0ml, huml, hvml      )
+!
+!#if (NMM_CORE == 1)
+!      CASE (NMMLSMSCHEME)
+!           CALL nmmlsminit(isn,XICE,VEGFRA,SNOW,SNOWC, CANWAT,SMSTAV, &
+!                     SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW,     &
+!                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,DZS,SFCEVP,   &
+!                     TMN,                                          &
+!                     num_soil_layers,                              &
+!                     allowed_to_read ,                             &
+!                     ids,ide, jds,jde, kds,kde,                    &
+!                     ims,ime, jms,jme, kms,kme,                    &
+!                     its,ite, jts,jte, kts,kte                     )
+!#endif
+!      CASE (LSMSCHEME)
+!          CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,  &
+!                     SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,        &
+!                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
+!                     FNDSOILW, FNDSNOWH,                       &
+!                     num_soil_layers, restart,                 &
+!                     allowed_to_read ,                         &
+!                     ids,ide, jds,jde, kds,kde,                &
+!                     ims,ime, jms,jme, kms,kme,                &
+!                     its,ite, jts,jte, kts,kte                 )
+!
+!!URBAN
+!          IF(UCMCALL.eq.1) THEN
+!
+!             IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN
+!
+!                CALL urban_param_init(DZR,DZB,DZG,num_soil_layers                    & !urban
+!                                )
+!!                                num_roof_layers,num_wall_layers,road_soil_layers)   !urban
+!                CALL urban_var_init(TSK,TSLB,TMN,IVGTYP,                             & !urban
+!                              ims,ime,jms,jme,num_soil_layers,                 & !urban
+!!                              num_roof_layers,num_wall_layers,num_road_layers, & !urban
+!                              restart,                                         & !urban
+!                              XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,     & !urban
+!                              TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D,    & !urban
+!                              TRL_URB3D,TBL_URB3D,TGL_URB3D,                   & !urban
+!                              SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, TS_URB2D,    & ! urban
+!                              FRC_URB2D, UTYPE_URB2D)                            !urban
+!             ELSE
+!                CALL wrf_error_fatal ( 'arguments not present for calling urban model' )
+!             ENDIF
+!          ENDIF
+!
+!
+!      CASE (RUCLSMSCHEME)
+!!          if(isfc .ne. 2)CALL wrf_error_fatal &
+!!           ( 'module_physics_init: use myjsfc and myjpbl scheme for this lsm option' )
+!           CALL lsmrucinit( SMFR3D,TSLB,SMOIS,ISLTYP,mavail,       &
+!                     num_soil_layers, restart,                     &
+!                     allowed_to_read ,                             &
+!                     ids,ide, jds,jde, kds,kde,                    &
+!                     ims,ime, jms,jme, kms,kme,                    &
+!                     its,ite, jts,jte, kts,kte                     )
+!
+!      CASE (PXLSMSCHEME)
+!          CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,  &
+!                     SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,        &
+!                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
+!                     FNDSOILW, FNDSNOWH,                       &
+!                     num_soil_layers, restart,                 &
+!                     allowed_to_read ,                         &
+!                     ids,ide, jds,jde, kds,kde,                &
+!                     ims,ime, jms,jme, kms,kme,                &
+!                     its,ite, jts,jte, kts,kte                 )
+!
+!      CASE DEFAULT
+!
+!   END SELECT sfc_select
+!
+!
+!!-- initialize pbl scheme
+!
+!   pbl_select: SELECT CASE(config_flags%bl_pbl_physics)
+!
+!      CASE (YSUSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL ysuinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (MRFSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL mrfinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (ACMPBLSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL acminit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (GFSSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL gfsinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (MYJPBLSCHEME)
+!           if(isfc .ne. 2)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use myjsfc scheme for this pbl option' )
+!           CALL myjpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, &
+!                        TKE_MYJ,EXCH_H,restart,               &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE DEFAULT
+!
+!   END SELECT pbl_select
+!
+!   END SUBROUTINE bl_init
+!
+!!==================================================================
+!   SUBROUTINE cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN,  &
+!                      RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC,       &
+!                      RAINCV,W0AVG,config_flags,restart,          &
+!                      CLDEFI,LOWLYR,MASS_FLUX,                    &
+!                      RTHFTEN, RQVFTEN,                           &
+!                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+!                      APR_CAPMA,APR_CAPME,APR_CAPMI,              &
+!                      cugd_tten,cugd_ttens,cugd_qvten,            &
+!                      cugd_qvtens,cugd_qcten,                     &
+!                      allowed_to_read, start_of_simulation,       &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!!------------------------------------------------------------------
+!   USE module_cu_kf
+!   USE module_cu_kfeta
+!   USE MODULE_CU_BMJ
+!   USE module_cu_gd,  ONLY : GDINIT
+!   USE module_cu_g3,  ONLY : G3INIT
+!   USE module_cu_sas
+!!------------------------------------------------------------------
+!   IMPLICIT NONE
+!!------------------------------------------------------------------
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!
+!
+!   INTEGER , INTENT(IN)        :: ids, ide, jds, jde, kds, kde,   &
+!                                  ims, ime, jms, jme, kms, kme,   &
+!                                  its, ite, jts, jte, kts, kte
+!
+!   REAL ,    INTENT(IN)        :: DT, CUDT
+!   LOGICAL , INTENT(IN)        :: start_of_simulation
+!   LOGICAL , INTENT(IN)        :: allowed_to_read
+!   INTEGER , INTENT(INOUT)     :: STEPCU
+!
+!   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &
+!            RTHCUTEN, RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN, RQSCUTEN
+!   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &
+!                        cugd_tten,cugd_ttens,cugd_qvten,            &
+!                        cugd_qvtens,cugd_qcten
+!
+!   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
+!
+!   REAL,    DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+!            RTHFTEN, RQVFTEN
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: RAINC, RAINCV
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: CLDEFI
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX,   &
+!                                   APR_GR,APR_W,APR_MC,APR_ST,APR_AS,    &
+!                                   APR_CAPMA,APR_CAPME,APR_CAPMI
+!
+!   INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR
+!
+!! LOCAL VAR
+!   
+!  INTEGER :: i,j,itf,jtf
+!
+!!--------------------------------------------------------------------
+!
+!!-- calculate cumulus parameterization time step
+!
+!   itf=min0(ite,ide-1)
+!   jtf=min0(jte,jde-1)
+!!
+!   STEPCU = nint(CUDT*60./DT)
+!   STEPCU = max(STEPCU,1)
+!
+!!-- initialization
+!
+!   IF(start_of_simulation)THEN
+!     DO j=jts,jtf
+!     DO i=its,itf
+!        RAINC(i,j)=0.
+!        RAINCV(i,j)=0.
+!     ENDDO
+!     ENDDO
+!   ENDIF
+!
+!   cps_select: SELECT CASE(config_flags%cu_physics)
+!
+!     CASE (KFSCHEME)
+!          CALL kfinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,        &
+!                      RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS,      &
+!                      PARAM_FIRST_SCALAR,restart,                 &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!
+!     CASE (BMJSCHEME)
+!          CALL bmjinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,       &
+!                      CLDEFI,LOWLYR,cp,r_d,restart,               &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!
+!     CASE (KFETASCHEME)
+!          CALL kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,   &
+!                      RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS,      &
+!                      SVP1,SVP2,SVP3,SVPT0,                       &
+!                      PARAM_FIRST_SCALAR,restart,                 &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!     CASE (GDSCHEME)
+!          CALL gdinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,        &
+!                      MASS_FLUX,cp,restart,                       &
+!                      P_QC,P_QI,PARAM_FIRST_SCALAR,               &
+!                      RTHFTEN, RQVFTEN,                           &
+!                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+!                      APR_CAPMA,APR_CAPME,APR_CAPMI,              &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!#if ( EM_CORE == 1 )
+!     CASE (G3SCHEME)
+!          CALL g3init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,        &
+!                      MASS_FLUX,cp,restart,                       &
+!                      P_QC,P_QI,PARAM_FIRST_SCALAR,               &
+!                      RTHFTEN, RQVFTEN,                           &
+!                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+!                      APR_CAPMA,APR_CAPME,APR_CAPMI,              &
+!                      cugd_tten,cugd_ttens,cugd_qvten,            &
+!                      cugd_qvtens,cugd_qcten,                     &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!#endif
+!     CASE (SASSCHEME)
+!          CALL sasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,       &
+!                      restart,P_QC,P_QI,PARAM_FIRST_SCALAR,       &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!
+!     CASE DEFAULT
+!
+!   END SELECT cps_select
+!
+!   END SUBROUTINE cu_init
+!
+!!==================================================================
+!   SUBROUTINE mp_init(RAINNC,config_flags,restart,warm_rain,      &
+!                      adv_moist_cond,                             &
+!                      MPDT, DT, DX, DY, LOWLYR,                   & ! for eta mp
+!                      F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,           & ! for eta mp
+!                      mp_restart_state,tbpvs_state,tbpvs0_state,   & ! eta mp
+!                      allowed_to_read, start_of_simulation,       &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!!------------------------------------------------------------------
+!   USE module_mp_wsm3
+!   USE module_mp_wsm5
+!   USE module_mp_wsm6
+!   USE module_mp_etanew
+!   USE module_mp_thompson
+!   USE module_mp_morr_two_moment  
+!!------------------------------------------------------------------
+!   IMPLICIT NONE
+!!------------------------------------------------------------------
+!! Arguments
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!   LOGICAL , INTENT(OUT)       :: warm_rain,adv_moist_cond
+!   REAL    , INTENT(IN)        :: MPDT, DT, DX, DY
+!   LOGICAL , INTENT(IN)        :: start_of_simulation
+!
+!   INTEGER , INTENT(IN)        :: ids, ide, jds, jde, kds, kde,   &
+!                                  ims, ime, jms, jme, kms, kme,   &
+!                                  its, ite, jts, jte, kts, kte
+!
+!   INTEGER , DIMENSION( ims:ime , jms:jme ) ,INTENT(INOUT)  :: LOWLYR
+!   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: RAINNC
+!   REAL,     DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: &
+!                                  F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
+!   REAL , DIMENSION(:) ,INTENT(INOUT)  :: mp_restart_state,tbpvs_state,tbpvs0_state
+!   LOGICAL , INTENT(IN)  :: allowed_to_read
+!
+!! Local
+!   INTEGER :: i, j, itf, jtf
+!
+!   warm_rain = .false.
+!   adv_moist_cond = .true.
+!   itf=min0(ite,ide-1)
+!   jtf=min0(jte,jde-1)
+!
+!   IF(start_of_simulation)THEN
+!     DO j=jts,jtf
+!     DO i=its,itf
+!        RAINNC(i,j) = 0.
+!     ENDDO
+!     ENDDO
+!   ENDIF
+!
+!   mp_select: SELECT CASE(config_flags%mp_physics)
+!
+!     CASE (KESSLERSCHEME)
+!          warm_rain = .true.
+!     CASE (WSM3SCHEME)
+!          CALL wsm3init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read )
+!     CASE (WSM5SCHEME)
+!          CALL wsm5init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read )
+!     CASE (WSM6SCHEME)
+!          CALL wsm6init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read )
+!     CASE (ETAMPNEW)
+!         adv_moist_cond = .false.
+!         CALL etanewinit (MPDT,DT,DX,DY,LOWLYR,restart,           &
+!                          F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,       &
+!                          mp_restart_state,tbpvs_state,tbpvs0_state,&
+!                          allowed_to_read,                        &
+!                          ids, ide, jds, jde, kds, kde,           &
+!                          ims, ime, jms, jme, kms, kme,           &
+!                          its, ite, jts, jte, kts, kte            )
+!     CASE (THOMPSON)
+!         CALL thompson_init
+!     CASE (MORR_TWO_MOMENT)          
+!         CALL morr_two_moment_init  
+!
+!     CASE DEFAULT
+!
+!   END SELECT mp_select
+!
+!   END SUBROUTINE mp_init
+!
+!#if  ( EM_CORE == 1 )
+!!==========================================================
+!   SUBROUTINE fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN,    &
+!                RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,               &
+!                config_flags,restart,                           &
+!                allowed_to_read ,                               &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!
+!!--------------------------------------------------------------------
+!   USE module_fdda_psufddagd
+!!--------------------------------------------------------------------
+!   IMPLICIT NONE
+!!--------------------------------------------------------------------
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!
+!   INTEGER , INTENT(IN)        ::     ids, ide, jds, jde, kds, kde, &
+!                                      ims, ime, jms, jme, kms, kme, &
+!                                      its, ite, jts, jte, kts, kte
+!
+!   REAL ,    INTENT(IN)        ::     DT, FGDT
+!   INTEGER , INTENT(IN)        ::     id
+!   INTEGER , INTENT(INOUT)     ::     STEPFG
+!   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+!                                                           RUNDGDTEN, &
+!                                                           RVNDGDTEN, &
+!                                                          RTHNDGDTEN, &
+!                                                          RQVNDGDTEN
+!   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: RMUNDGDTEN
+!
+!   LOGICAL,  INTENT(IN)           :: allowed_to_read
+!!--------------------------------------------------------------------
+!
+!!-- calculate pbl time step
+!
+!   STEPFG = nint(FGDT*60./DT)
+!   STEPFG = max(STEPFG,1)
+!
+!
+!!-- initialize fdda scheme
+!
+!   fdda_select: SELECT CASE(config_flags%grid_fdda)
+!
+!      CASE (PSUFDDAGD)
+!           CALL fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,&
+!               config_flags%run_hours, &
+!               config_flags%if_no_pbl_nudging_uv, &
+!               config_flags%if_no_pbl_nudging_t, &
+!               config_flags%if_no_pbl_nudging_q, &
+!               config_flags%if_zfac_uv, &
+!               config_flags%k_zfac_uv, &
+!               config_flags%if_zfac_t, &
+!               config_flags%k_zfac_t, &
+!               config_flags%if_zfac_q, &
+!               config_flags%k_zfac_q, &
+!               config_flags%guv, &
+!               config_flags%gt, config_flags%gq, &
+!               config_flags%if_ramping, config_flags%dtramp_min, &
+!               config_flags%gfdda_end_h, &
+!                      restart, allowed_to_read,                    &
+!                      ids, ide, jds, jde, kds, kde,                &
+!                      ims, ime, jms, jme, kms, kme,                &
+!                      its, ite, jts, jte, kts, kte                 )
+!      CASE DEFAULT
+!
+!   END SELECT fdda_select
+!
+!   END SUBROUTINE fg_init
+!
+!!-------------------------------------------------------------------
+!   SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid,       &
+!                        idynin, dtramp, fdaend, restart,           &
+!                        obs_twindo_cg, obs_twindo, itimestep,      &
+!                        cen_lat, cen_lon, stand_lon,               &
+!                        true_lat1, true_lat2, map_proj,            &
+!                        xlat, xlong,                               &
+!                        s_sn_cg, e_sn_cg, s_we_cg, e_we_cg,        &
+!                        fdob, ipf_init,                            &
+!                        ids, ide, jds, jde, kds, kde,              &
+!                        ims, ime, jms, jme, kms, kme,              &
+!                        its, ite, jts, jte, kts, kte               )
+!
+!!--------------------------------------------------------------------
+!   USE module_domain
+!   USE module_fddaobs_rtfdda
+!   USE module_llxy
+!!--------------------------------------------------------------------
+!   IMPLICIT NONE
+!!--------------------------------------------------------------------
+!   INTEGER , INTENT(IN)    :: maxdom
+!   INTEGER , INTENT(IN)    :: obs_nudge_opt(maxdom)
+!   INTEGER , INTENT(IN)    :: ids,ide, jds,jde, kds,kde,           &
+!                              ims,ime, jms,jme, kms,kme,           &
+!                              its,ite, jts,jte, kts,kte
+!   INTEGER , INTENT(IN)    :: inest
+!   INTEGER , INTENT(IN)    :: parid(maxdom)
+!   INTEGER , INTENT(IN)    :: idynin          ! flag for dynamic initialization
+!   REAL    , INTENT(IN)    :: dtramp          ! time period for ramping (idynin)
+!   REAL    , INTENT(IN)    :: fdaend(maxdom)  ! nudging end time for domain (min)
+!   LOGICAL , INTENT(IN)    :: restart
+!   REAL    , INTENT(IN)    :: obs_twindo_cg   ! twindo on course grid
+!   REAL    , INTENT(IN)    :: obs_twindo
+!   INTEGER , INTENT(IN)    :: itimestep
+!   REAL    , INTENT(IN)    :: cen_lat      ! domain center latitude
+!   REAL    , INTENT(IN)    :: cen_lon      ! domain center longitude
+!   REAL    , INTENT(IN)    :: stand_lon    ! domain longitude
+!   REAL    , INTENT(IN)    :: true_lat1    ! domain standard parallel 
+!   REAL    , INTENT(IN)    :: true_lat2    ! domain second standard parallel
+!   INTEGER , INTENT(IN)    :: map_proj     ! map projection
+!   REAL, DIMENSION( ims:ime, jms:jme ),                            &
+!         INTENT(IN )       :: xlat, xlong  ! lat/long locations on mass point grid
+!   INTEGER, intent(in)     :: s_sn_cg      ! starting north-south coarse-grid index
+!   INTEGER, intent(in)     :: e_sn_cg      ! ending   north-south coarse-grid index
+!   INTEGER, intent(in)     :: s_we_cg      ! starting west-east   coarse-grid index
+!   INTEGER, intent(in)     :: e_we_cg      ! ending   west-east   coarse-grid index
+!
+!   TYPE(fdob_type), INTENT(INOUT)  :: fdob
+!
+!   INTEGER                 :: e_sn         ! ending   north-south grid index
+!   LOGICAL                 :: ipf_init     ! print warnings detected at initialzn
+!!--------------------------------------------------------------------
+!!-- initialize fdda obs-nudging scheme
+!
+!      IF ( obs_nudge_opt(inest) .eq. 0 ) RETURN
+!
+!      e_sn = jde
+!      CALL fddaobs_init(obs_nudge_opt, maxdom, inest, parid,       &  
+!                        idynin, dtramp, fdaend, restart,           &
+!                        obs_twindo_cg,                             &
+!                        obs_twindo, itimestep,                     &
+!                        cen_lat, cen_lon, stand_lon,               &
+!                        true_lat1, true_lat2, map_proj,            &
+!                        xlat, xlong,                               &
+!                        e_sn, s_sn_cg, e_sn_cg, s_we_cg, e_we_cg,  &
+!                        fdob, ipf_init,                            &
+!                        ids,ide, jds,jde, kds,kde,                 &  
+!                        ims,ime, jms,jme, kms,kme,                 &  
+!                        its,ite, jts,jte, kts,kte)
+!
+!   END SUBROUTINE fdob_init
+!#endif
+
+!--------------------------------------------------------------------
+   SUBROUTINE z2sigma(zf,zh,sf,sh,p_top,pptop,config_flags, &
+                allowed_to_read , &
+                kds,kde,kms,kme,kts,kte)
+   IMPLICIT NONE
+! Arguments
+   INTEGER, INTENT(IN) :: kds,kde,kms,kme,kts,kte
+   REAL , DIMENSION( kms:kme ), INTENT(IN) :: zf,zh
+   REAL , DIMENSION( kms:kme ), INTENT(OUT):: sf,sh
+   REAL , INTENT(IN) :: p_top
+   REAL , INTENT(OUT) :: pptop
+   TYPE (grid_config_rec_type)              :: config_flags
+   LOGICAL , INTENT(IN) :: allowed_to_read
+! Local
+   REAL R, G, TS, GAMMA, PS, ZTROP, TSTRAT, PTROP, Z, T, P, ZTOP, PTOP
+   INTEGER K
+
+   IF(zf(kde/2) .GT. 1.0)THEN
+! Height levels assumed (zeta coordinate)
+! Convert to sigma using standard atmosphere for pressure-height relation
+! constants for standard atmosphere definition
+      r=287.05
+      g=9.80665
+      ts=288.15
+      gamma=-6.5/1000.
+      ps=1013.25
+      ztrop=11000.
+      tstrat=ts+gamma*ztrop
+      ptrop=ps*(tstrat/ts)**(-g/(gamma*r))
+
+      do k=kde,kds,-1
+! full levels
+        z=zf(k)
+        if(z.le.ztrop)then
+          t=ts+gamma*z
+          p=ps*(t/ts)**(-g/(gamma*r))
+        else
+          t=tstrat
+          p=ptrop*exp(-g*(z-ztrop)/(r*tstrat))
+        endif
+        if(k.eq.kde)then
+          ztop=zf(k)
+          ptop=p
+        endif
+        sf(k)=(p-ptop)/(ps-ptop)
+! half levels
+        if(k.ne.kds)then
+        z=0.5*(zf(k)+zf(k-1))
+        if(z.le.ztrop)then
+          t=ts+gamma*z
+          p=ps*(t/ts)**(-g/(gamma*r))
+        else
+          t=tstrat
+          p=ptrop*exp(-g*(z-ztrop)/(r*tstrat))
+        endif
+        sh(k-1)=(p-ptop)/(ps-ptop)
+        endif
+      enddo
+      pptop=ptop/10.
+   ELSE
+!  Levels are already sigma/eta
+      do k=kde,kds,-1
+!        sf(k)=zf(kde-k+kds)
+!        if(k .ne. kde)sh(k)=zh(kde-1-k+kds)
+         sf(k)=zf(k)
+         if(k .ne. kde)sh(k)=zh(k)
+      enddo
+      pptop=p_top/1000.
+
+   ENDIF
+
+   END SUBROUTINE z2sigma
+
+END MODULE module_physics_init
Index: trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/extract_turb
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/extract_turb	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/extract_turb	(revision 2744)
@@ -0,0 +1,24 @@
+#! /bin/bash
+
+
+ycoord=20
+
+
+#echo coord
+#ncrcat -O -v HGT,XLAT,XLONG 	-d Time,0,0,1 		     ../wrfout*   coord.nc
+
+echo v
+ncrcat -O -v V     -d south_north_stag,${ycoord},${ycoord},1 ./wrfout*   v${ycoord}.nc
+
+echo u
+ncrcat -O -v U     -d south_north,${ycoord},${ycoord},1      ./wrfout*   u${ycoord}.nc
+echo w
+ncrcat -O -v W     -d south_north,${ycoord},${ycoord},1      ./wrfout*   w${ycoord}.nc
+echo p
+ncrcat -O -v PTOT  -d south_north,${ycoord},${ycoord},1      ./wrfout*   p${ycoord}.nc
+echo ph
+ncrcat -O -v PHTOT -d south_north,${ycoord},${ycoord},1      ./wrfout*  ph${ycoord}.nc
+echo t
+ncrcat -O -v T     -d south_north,${ycoord},${ycoord},1      ./wrfout*   t${ycoord}.nc
+
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/extract_turb2
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/extract_turb2	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/extract_turb2	(revision 2744)
@@ -0,0 +1,24 @@
+#! /bin/bash
+
+
+#ycoord=20
+#ycoord=30
+
+#echo coord
+#ncrcat -O -v HGT,XLAT,XLONG 	-d Time,0,0,1 		     ../wrfout*   coord.nc
+
+echo v
+#ncrcat -O -v V     ./wrfout*   v${ycoord}.nc
+
+echo u
+#ncrcat -O -v U     ./wrfout*   u${ycoord}.nc
+echo w
+#ncrcat -O -v W     ./wrfout*   w${ycoord}.nc
+echo p
+ncrcat -O -v PTOT  ./wrfout*   p${ycoord}.nc
+echo ph
+ncrcat -O -v PHTOT ./wrfout*  ph${ycoord}.nc
+echo t
+ncrcat -O -v T     ./wrfout*   t${ycoord}.nc
+
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/getcdf.pro
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/getcdf.pro	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/getcdf.pro	(revision 2744)
@@ -0,0 +1,15 @@
+pro getcdf, $
+	file=file, $
+	charvar=charvar, $
+	invar=invar	
+
+T = SYSTIME(1)
+
+cdfid = ncdf_open(file)
+varid=ncdf_varid(cdfid,charvar)
+ncdf_varget, cdfid, varid, invar
+
+print, 'got '+charvar+' in '+file+' within ', SYSTIME(1) - T, ' seconds'
+
+
+end
Index: trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/getget.pro
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/getget.pro	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/getget.pro	(revision 2744)
@@ -0,0 +1,122 @@
+function getget, name, charvar, count=count, offset=offset, stride=stride, coordmean=coordmean, anomaly=anomaly
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; name: char
+; charvar: char
+; count: 4 elements array   ; The dimensions of the sub-image
+; offset: 4 elements array  ; A variable that contains the offset for the sub-image
+; stride: 4 elements array  ; Create a variable to be used as a value for the STRIDE keyword
+; coordmean: 1 to 4 elements array (dimension 1 is 1)
+; anomaly: a non-null element that would be filled with mean
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+nosave = 1  ;; comment to get an IDL data file
+notime = 1  ;; comment to get mention of time taken
+if (n_elements(notime) eq 0) then timetime = SYSTIME(1)
+
+;
+; MINIMAL ARGUMENTS
+;
+if (n_elements(name) eq 0) then stop
+if (n_elements(charvar) eq 0) then stop
+
+;
+; IDL DATA DIRECTORY
+;
+name_idl = charvar+name+'.idl'
+  if (n_elements(coordmean) ne 0) then begin
+    nc = n_elements(coordmean)
+    for i=0,nc-1 do begin
+     name_idl = string(coordmean(i),'(I0)')+name_idl   
+    endfor
+  endif
+name_idl = './idl_dat/'+name_idl
+
+;
+; TEST IF FILE EXISTS
+;
+openr,unit,name_idl,/get_lun,error=err
+
+;
+; IF IDL FILE EXISTS, THAT IS RATHER SIMPLE
+;
+IF (err EQ 0) THEN BEGIN
+
+   print, 'read from file'
+   free_lun,unit
+   restore, filename=name_idl
+
+;
+; IF IDL FILE DOES NOT EXIST, WELL, READ NETCDF
+;
+ENDIF ELSE BEGIN
+
+  ;
+  ; check save directory
+  ;
+  if (n_elements(nosave) eq 0) then SPAWN, 'mkdir -p idl_dat'  
+
+  ;
+  ; open file
+  ;
+  id=ncdf_open(name) 
+
+  ;
+  ; get dimensions
+  ;
+  var = intarr(4)
+  NCDF_DIMINQ, id, NCDF_DIMID(id, 'west_east'    ), toto, titi & var(0) = titi
+  NCDF_DIMINQ, id, NCDF_DIMID(id, 'south_north'  ), toto, titi & var(1) = titi 
+  NCDF_DIMINQ, id, NCDF_DIMID(id, 'bottom_top'   ), toto, titi & var(2) = titi
+  NCDF_DIMINQ, id, NCDF_DIMID(id, 'Time'         ), toto, titi & var(3) = titi 
+  ;print, var
+
+  ;
+  ; define default data windows
+  ;
+  if (n_elements(offset) le 3) then offset=[0,0,0,0]
+  if (n_elements(stride) le 3) then stride=[1,1,1,1]
+  if (n_elements(count) le 3) then count=intarr(4)
+  w = where(count eq 0) & if (w(0) ne -1) then count[w] = var[w] / stride[w]
+
+  ;
+  ; read variable
+  ;
+  varid=ncdf_varid(id,charvar) ;& print, 'get '+charvar 
+  if (n_elements(notime) eq 0) then timetime = SYSTIME(1) ;& help, /memory
+  ncdf_varget, id, varid, invar, count=count, offset=offset, stride=stride & if (n_elements(notime) eq 0) then print, SYSTIME(1) - timetime, ' s' ;& help, /memory
+  ncdf_close, id
+
+  ;
+  ; OPTIONAL: ANOMALY (value is returned in the keyword)
+  ; 
+  if (n_elements(anomaly) ne 0) then begin
+    anomaly=TOTAL(TOTAL(invar,1),1)/float(var[0])/float(var[1])
+    for i=0,var[0]-1 do for j=0,var[1]-1 do invar(i,j,*,*) = TEMPORARY(invar(i,j,*,*)) - anomaly  ; coute cher
+  endif
+
+  ;
+  ; OPTIONAL: MEAN 
+  ;
+  if (n_elements(coordmean) ne 0) then begin
+  for i=0,nc-1 do begin
+   print, 'mean over dimension '+string(coordmean(i),'(I0)')+' - '+string(var(coordmean(i)),'(I0)')+' elements'
+   invar=total(TEMPORARY(invar),coordmean(i))/var(coordmean(i))
+  endfor
+  endif
+
+  ;
+  ; SAVE
+  ;
+  if (n_elements(nosave) eq 0) then save, invar, filename=name_idl
+
+ENDELSE
+
+if (n_elements(notime) eq 0) then print, SYSTIME(1) - timetime, ' s'
+
+;
+; RETURN FIELD
+;
+return, invar
+
+end
Index: trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/getturb.pro
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/getturb.pro	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/getturb.pro	(revision 2744)
@@ -0,0 +1,429 @@
+pro getturb, saveps=saveps
+
+
+
+;----------------------------------
+; USE: getturb
+;      getturb, saveps='false'     
+;----------------------------------
+
+
+history_interval_s = 400. ;100.
+smoothampl=3700/history_interval_s
+smoothampl=0.
+
+;
+; constantes
+;
+p0=610. & t0=220. & r_cp=1/4.4 & grav=3.72 & R=192.
+
+;
+; graphics definition
+;
+if (n_elements(saveps) eq 0) then saveps='true'
+if (saveps eq 'false') then begin
+   ;!p.multi=[0,3,2] 
+   !P.CHARSIZE=2.
+   WINDOW, /PIXMAP & WDELETE & DEVICE,BYPASS_TRANSLATION=0,DECOMPOSED=0,RETAIN=2
+endif else begin
+   PREF_SET, 'IDL_PATH', '/home/spiga/Save/Save/SOURCES/IDL/fsc_psconfig:<IDL_DEFAULT>', /COMMIT
+endelse
+
+;
+; retrieve fields
+;
+openr,unit,'getturb.dat',/get_lun,error=err
+IF (err ne 0) THEN BEGIN
+
+;
+; input files
+;
+OPENR, 22, 'input_coord' & READF, 22, lonu & READF, 22, latu & READF, 22, lsu & READF, 22, lctu & CLOSE, 22
+OPENR, 23, 'input_more' & READF, 23, hgtu, tsurfu & CLOSE, 23
+
+;
+; get fields
+;
+domain='d01' & filesWRF = FindFile('wrfout_'+domain+'_????-??-??_??:??:??') & nf=n_elements(filesWRF)
+
+;
+; get dimensions
+;
+id=ncdf_open(filesWRF(0))
+NCDF_DIMINQ, id, NCDF_DIMID(id, 'west_east'    ), toto, nx & NCDF_DIMINQ, id, NCDF_DIMID(id, 'south_north'  ), toto, ny
+NCDF_DIMINQ, id, NCDF_DIMID(id, 'bottom_top'   ), toto, nz & NCDF_DIMINQ, id, NCDF_DIMID(id, 'Time'         ), toto, nt
+NCDF_CLOSE, id 
+
+;
+; prepare loop
+;
+nloop1 = nf-1 & nloop2 = nt & yeye = 0 
+localtime = lctu + history_interval_s*findgen(nloop1*nloop2)/3700.
+wt  = fltarr(nz,nloop1*nloop2) & tke = fltarr(nz,nloop1*nloop2) & ztke = fltarr(nz,nloop1*nloop2) & t = fltarr(nz,nloop1*nloop2)
+p = fltarr(nz) & ph = fltarr(nz) & pht = fltarr(nz,nloop1*nloop2) & pt = fltarr(nz,nloop1*nloop2) & stst = fltarr(nz,nloop1*nloop2)
+
+;
+; loop loop
+;
+for loop  = 0, nloop1-1 do begin
+                                          timetime = SYSTIME(1)
+for loop2 = 0, nloop2-1 do begin
+
+   ; t' = t - <t>
+   ; ------------
+ yeyeye = 1.
+ tprime = getget(filesWRF(loop), 'T', anomaly=yeyeye, count=[0,0,0,1], offset=[0,0,0,loop2])  ;; t' = t - <t>
+ t(*,yeye) = t0 + TEMPORARY(yeyeye)
+   ; w' = w   
+   ; ------
+ wprime  = getget(filesWRF(loop), 'W', count=[0,0,0,1], offset=[0,0,0,loop2])     
+   ; tke = 0.5 ( <u'^2> + <v'^2> + <w'^2> ) ; u' = u ; v' = v  
+   ; --------------------------------------------------------
+ ztke(*,yeye) = 0.5 * TOTAL(TOTAL(wprime^2,1),1) / float(nx) / float(ny)
+ tke(*,yeye) = ztke(*,yeye) + $
+               0.5 * ( $
+        TOTAL(TOTAL(getget(filesWRF(loop), 'U', count=[0,0,0,1], offset=[0,0,0,loop2])^2,1),1) + $  
+        TOTAL(TOTAL(getget(filesWRF(loop), 'V', count=[0,0,0,1], offset=[0,0,0,loop2])^2,1),1)   $  
+        ) / float(nx) / float(ny)  
+   ; <w't'>
+   ; ------
+ wt(*,yeye)  = TOTAL(TOTAL(TEMPORARY(tprime)  * TEMPORARY(wprime),1),1) / float(nx) / float(ny)  
+   ; p & ph
+   ; ------
+ if (loop + loop2 eq 0) then nloopbeware = nloop2-1 else nloopbeware = nloop2  ; 1ere valeur vaut 0
+ pht(*,yeye) = TOTAL(TOTAL(getget(filesWRF(loop), 'PHTOT',  count=[0,0,0,1], offset=[0,0,0,loop2]),1),1) / float(nx) / float(ny) / 1000. / 3.72
+ pt(*,yeye)  = TOTAL(TOTAL(getget(filesWRF(loop), 'PTOT' ,  count=[0,0,0,1], offset=[0,0,0,loop2]),1),1) / float(nx) / float(ny)
+ ph = TEMPORARY(ph) + pht(*,yeye) / nloopbeware / nloop1
+ p  = TEMPORARY(p ) + pt(*,yeye) / nloop2 / nloop1
+   ; static stability
+   ; ----------------
+ stst(*,yeye) = DERIV( reform(pht(*,yeye)) - hgtu/1000. , reform(t(*,yeye)) * ( reform(pt(*,yeye)) /p0 )^r_cp ) + 1000.*grav / (R / r_cp)  ;; 4.9 dans Hinson
+   ; loop count
+   ; ---------
+ yeye = TEMPORARY(yeye) + 1 
+
+endfor
+                                          print, 'file '+string(loop+1,'(I0)'), SYSTIME(1) - timetime, ' s'
+endfor
+h  = TEMPORARY(ph)  - hgtu/1000.  ;; altitude above ground
+ht = TEMPORARY(pht) - hgtu/1000.  
+;
+; save
+;
+save, wt, tke, ztke, h, ht, t, p, pt, stst, localtime, filename='getturb.dat'
+
+ENDIF ELSE BEGIN
+
+print, 'OK, file is here'
+restore, filename='getturb.dat'
+
+ENDELSE
+
+;
+; smooth smooth
+;
+wt  = SMOOTH(TEMPORARY(wt),  [0,smoothampl], /EDGE_TRUNCATE)
+tke = SMOOTH(TEMPORARY(tke), [0,smoothampl], /EDGE_TRUNCATE)
+ztke = SMOOTH(TEMPORARY(ztke), [0,smoothampl], /EDGE_TRUNCATE)
+
+
+;*******************;
+;*******************;
+; PLOTS PLOTS PLOTS ;
+;*******************;
+;*******************;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  transpose(tke) 
+zex           =  localtime 
+zey           =  h
+set_name      =  'TKE.ps'
+set_title     =  "Turbulent Kinetic Energy 0.5[<u'!U2!N>+<v'!U2!N>+<w'!U2!N>] (m!U2!N.s!U-2!N)"
+set_titlex    =  'Local Time (h)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [8.,18.]
+set_yrange    =  [0.,10.]
+set_tickx     =  1.
+set_ticky     =  1.
+minval        =  0.
+maxval        =  15.
+nlev          =  maxval-minval
+pal           =  22
+rrr           =  'no'
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+;; 0. levels
+lev = minval + (maxval-minval)*findgen(nlev+1)/float(nlev) & if (minval ne 0.) then lev = lev[where(lev ne 0.)]
+;;; 1. background
+loadct, 0 & contour, /NODATA, zefield, zex, zey, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0 
+;; 2. color field
+loadct, pal & if (rrr eq 'yes') then TVLCT, r, g, b, /Get & if (rrr eq 'yes') then TVLCT, Reverse(r), Reverse(g), Reverse(b) 
+            contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /overplot, /cell_fill
+;; 3. contour field
+loadct, 0 & contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /noerase, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, C_LINESTYLE = (lev LT 0.0)
+;; 4. choose output
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  transpose(ztke)
+;zefield       =  100.*transpose(ztke)/transpose(tke) & zefield[where(transpose(tke) lt 1.)]=0.
+zex           =  localtime
+zey           =  h
+set_name      =  'zTKE.ps'
+set_title     =  "Vertical Turbulent Kinetic Energy 0.5[<w'!U2!N>] (m!U2!N.s!U-2!N)"
+set_titlex    =  'Local Time (h)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [8.,18.]
+set_yrange    =  [0.,10.]
+set_tickx     =  1.
+set_ticky     =  1.
+minval        =  0.
+maxval        =  10.
+nlev          =  maxval-minval
+pal           =  22
+rrr           =  'no'
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+;; 0. levels
+lev = minval + (maxval-minval)*findgen(nlev+1)/float(nlev) & if (minval ne 0.) then lev = lev[where(lev ne 0.)]
+;;; 1. background
+loadct, 0 & contour, /NODATA, zefield, zex, zey, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0
+;; 2. color field
+loadct, pal & if (rrr eq 'yes') then TVLCT, r, g, b, /Get & if (rrr eq 'yes') then TVLCT, Reverse(r), Reverse(g), Reverse(b)
+            contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /overplot, /cell_fill
+;; 3. contour field
+loadct, 0 & contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /noerase, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, C_LINESTYLE = (lev LT 0.0)
+;; 4. choose output
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  transpose(wt)
+zex           =  localtime
+zey           =  h
+set_name      =  'HF.ps'
+set_title     =  "Vertical Eddy Heat Flux <w'!7h!3'> (K.m.s!U-1!N)"
+set_titlex    =  'Local Time (h)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [8.,18.]
+set_yrange    =  [0.,10.]
+set_tickx     =  1.
+set_ticky     =  1.
+minval        =  -2.
+maxval        =  2.
+nlev          =  floor(maxval-minval)*10
+pal           =  33 ;4 
+rrr           =  'no'
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+;; 0. levels
+lev = minval + (maxval-minval)*findgen(nlev+1)/float(nlev) & if (minval ne 0.) then lev = lev[where(lev ne 0.)]
+;;; 1. background
+loadct, 0 & contour, /NODATA, zefield, zex, zey, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0
+;; 2. color field
+loadct, pal & if (rrr eq 'yes') then TVLCT, r, g, b, /Get & if (rrr eq 'yes') then TVLCT, Reverse(r), Reverse(g), Reverse(b)
+            ;;;--------------------------------------------------------------------------------------------------------------------------------
+            ;;; WHITE ZONE - 1. get location of interval in the CT - 2. change the CT to have a white zone
+            ulim=0.09 & dlim=-0.09 & w=where(lev le dlim) & n1=w[n_elements(w)-1] & w=where(lev ge ulim) & n2=w[0] & yy=BYTSCL(lev) & nd=yy[n1] & nu=yy[n2]-5
+            nu = nd + (nu-nd)/2  ;; otherwise the interval is too large (because we removed 0)
+            TVLCT, r, g, b, /Get & r[nd:nu]=255 & g[nd:nu]=255 & b[nd:nu]=255 & TVLCT, r, g, b
+            ;;;--------------------------------------------------------------------------------------------------------------------------------
+            contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /overplot, /cell_fill
+;; 3. contour field
+loadct, 0 & contour, zefield, zex, zey, levels=lev, c_labels=findgen(n_elements(lev))*0.+1., /noerase, xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, C_LINESTYLE = (lev LT 0.0)
+;; 4. choose output
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  t
+zey           =  ht 
+set_name      =  'T.ps'
+set_title     =  "Potential Temperature (K)"
+set_titlex    =  'Potential Temperature (K)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [min(t),max(t)]
+set_yrange    =  [0.,10.]
+set_tickx     =  5.
+set_ticky     =  1.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+localtimes = [9,10,11,12,13,14,15,16,17,18]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+altlin=0 & loadct, 0
+user_lt=localtimes[0] & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt)))) & nntt = yeah(0)
+plot, zefield(*,nntt), zey(*,nntt), xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, linestyle=altlin
+for ll = 1, n_elements(localtimes)-1 do begin
+  CASE altlin OF
+  0: altlin=1
+  1: altlin=0
+  ENDCASE  
+  user_lt=localtimes[ll] & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt)))) & nntt = yeah(0)
+  if (nntt ne -1) then oplot, zefield(*,nntt), zey(*,nntt), linestyle=altlin
+endfor
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+zefield       =  stst
+zey           =  ht 
+set_name      =  'STST.ps'
+set_title     =  "Static stability (K.m!U-1!N)"
+set_titlex    =  'Static stability (K.m!U-1!N)'
+set_titley    =  'Altitude above surface (km)'
+set_subtitle  =  'Mean over the simulation domain'
+set_xrange    =  [-5.,5.]
+set_yrange    =  [0.,10.]
+set_tickx     =  1.
+set_ticky     =  1.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+localtimes = [9,11,13,15,17]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then PS_Start, FILENAME=set_name
+!P.Charsize = 1.2
+altlin=0 & loadct, 0
+user_lt=localtimes[0] & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt)))) & nntt = yeah(0)
+plot, zefield(*,nntt), zey(*,nntt), xtitle=set_titlex, xrange=set_xrange, xtickinterval=set_tickx, ytitle=set_titley, yrange=set_yrange, ytickinterval=set_ticky, title=set_title, subtitle=set_subtitle, color=0, linestyle=altlin
+oplot, zefield(*,nntt), zey(*,nntt), psym=5
+for ll = 1, n_elements(localtimes)-1 do begin
+  CASE altlin OF
+  0: altlin=1 
+  1: altlin=0
+  ENDCASE
+  user_lt=localtimes[ll] & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt)))) & nntt = yeah(0)
+  if (nntt ne -1) then oplot, zefield(*,nntt), zey(*,nntt), linestyle=altlin
+  if (nntt ne -1) then oplot, zefield(*,nntt), zey(*,nntt), psym=5
+endfor
+oplot, 0.*zefield(*,nntt) + 1.5, zey(*,nntt), linestyle=2  
+if (saveps eq 'true') then PS_End, /PNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+stop
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+goto, no_staticstab
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then begin
+  device, /close
+  set_plot, 'ps' & device, filename='plot/staticstab.ps'
+endif
+
+user_lt=17. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+
+   ;;; recompute height @ given local time 
+   caca=heightp+hgtu/1000.
+   height=reform(ph(*,0,*,*))
+   height=total(height,1)/n_elements(height(*,0,0))
+   height=reform(height)
+   height=reform(height(*,yeah(0)))
+   height=height/1000./3.72
+   heightp=height(0:n_elements(height(*))-2) 
+   print, 'new minus old', heightp - caca
+   ;;; recompute height @ given local time 
+
+        press=reform(p(*,0,*,*))
+        press=total(press,1)/n_elements(press(*,0,0))
+        press=reform(press)
+        press=reform(press(*,yeah(0)))
+        press=press(0:n_elements(press(*))-2)
+
+staticstab = DERIV( heightp , reform(what_I_plot5(*,yeah(0))) ) + 1000.*3.72/844.6  ;; 4.9 dans Hinson
+   staticstab = staticstab(0:n_elements(staticstab)-5)
+   heightp = heightp(0:n_elements(heightp)-5)
+
+plot, $
+        staticstab, $
+        heightp,$
+        xtitle='Static stability (K/km)',$
+        xrange=[-1.,5.], $
+        xtickinterval=0.5, $
+        ytitle='Altitude above surface (km)', $
+        yrange=[min(heightp),max(heightp)], $
+        ytickinterval=1., $
+        title="LMD LES Static stability @ LT 17h (K/km)", $
+        subtitle='zonal average at lat. '+latwrite
+oplot, $
+        staticstab, $
+        heightp,$
+        psym=5
+oplot, $
+       findgen(n_elements(heightp))*0. + 1.,$
+       heightp,$
+       linestyle=2
+oplot, $
+       findgen(n_elements(heightp))*0. + 2.,$
+       heightp,$
+       linestyle=2
+
+;;;;;;;;;;
+w = where((staticstab gt 1.5) and ((heightp- hgtu/1000.) gt 1.))
+t_top_plus = what_I_plot5(w(0),yeah(0))
+z_top_plus = heightp(w(0))
+p_top_plus = press(w(0))
+t_top_moins = what_I_plot5(w(0)-1,yeah(0))
+z_top_moins = heightp(w(0)-1)
+p_top_moins = press(w(0)-1)
+pbl_depth = (z_top_plus*alog(p_top_plus) + z_top_moins*alog(p_top_moins))/(alog(p_top_plus) + alog(p_top_moins)) - hgtu/1000.
+xyouts, 3., 1.5 + (max(heightp) + min(heightp)) / 3., 'Ls = '+string(lsu,'(F5.1)')+'!Uo!N', CHARSIZE=1
+xyouts, 3., 1. + (max(heightp) + min(heightp)) / 3., 'Lat = '+string(latu,'(F5.1)')+'!Uo!N', CHARSIZE=1
+xyouts, 3., 0.5 + (max(heightp) + min(heightp)) / 3., 'LonE = '+string(lonu,'(F6.1)')+'!Uo!N', CHARSIZE=1
+xyouts, 3., (max(heightp) + min(heightp)) / 3., 'T!Dt!N = '+string(t_top_plus,'(I0)')+'/'+string(t_top_moins,'(I0)')+' K ', CHARSIZE=1
+xyouts, 3., -0.5 + (max(heightp) + min(heightp)) / 3., 'p!Dt!N = '+string(p_top_plus,'(I0)')+'/'+string(p_top_moins,'(I0)')+' Pa', CHARSIZE=1
+xyouts, 3., -1. + (max(heightp) + min(heightp)) / 3., 'z!Dt!N = '+string(z_top_plus,'(F4.1)')+'/'+string(z_top_moins,'(F4.1)')+' km', CHARSIZE=1
+xyouts, 3., -1.5 + (max(heightp) + min(heightp)) / 3., 'z!Ds!N = '+string(hgtu/1000.,'(F4.1)')+' km', CHARSIZE=1
+xyouts, 3., -2. + (max(heightp) + min(heightp)) / 3., 'D = '+string(pbl_depth,'(F4.1)')+' km', CHARSIZE=1
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+no_staticstab:
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then begin
+  device, /close
+endif
+stop
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+user_lt=13.
+yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+
+user_h=0.1
+walt=where(abs(heightp-user_h) eq (min(abs(heightp-user_h))))
+
+;mapfield=reform(t[*,*,walt(0),w(0)])
+;help, mapfield
+;contour, mapfield
+
+section=reform(w[*,0,*,yeah(0)])
+
+section=reform(w[*,0,*,160])
+
+lev=[-12.,-8.,-4.,4.,8.,12.]
+lev=[-5.,-4.,-3.,-2.,-1.,1.,2.,3.,4.,5.]
+contour, $
+	section, $
+	(lon(*,0)-lon(0,0))*59., $
+	heightp, $
+	levels=lev , $
+	C_LINESTYLE = (lev LT 0.0)
+
+device, /close
+
+end
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/pause.pro
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/pause.pro	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/pause.pro	(revision 2744)
@@ -0,0 +1,76 @@
+pro pause,up=up,xcrs=xcrs,ycrs=ycrs,on_screen=on_screen
+;+
+; routine:        pause
+;
+; useage:         pause
+;                 pause,up=up,xcrs=xcrs,ycrs=ycrs,on_screen=on_screen
+;
+; input:          none
+;
+; keyword input:  
+;   up
+;     if set, don't return until a upward button transition is
+;     detected.  This is useful when pause is used between plots which
+;     draw quickly.  Setting this keyword ensures that no plots are
+;     skipped but also requires that each new plot be accompanied by a
+;     downward and upward button transition.  The default is to skip
+;     to the next plot as long a mouse button is pressed down.
+;
+;
+; xcrs,ycrs
+;     pixel location to put cursor while waiting
+;
+; on_screen
+;     if set, don't pause if cursor not in plot window
+;
+; output:         none
+;
+; PURPOSE:
+;     Momentarily stop execution until a mouse key is pressed.  While
+;     in the paused state the cursor is changed to what looks like an
+;     arrow pointing down on a button.  When any of the mouse buttons
+;     are pressed the cursor returns to its original form and
+;     execution continues.
+;     
+;     PAUSE will only interrupt execution if the output device is 'X'
+;     and plot system variable !p.multi(0) eq 0.  The first condition
+;     disables PAUSE when output is directed to a postscript file.
+;     The second condition ensures that pauses occur only just before
+;     the screen is erased for a new plot.
+;     
+;     NOTE: After PAUSE returns to the calling program different
+;     actions can be performed depending on whether the left, middle
+;     or right mouse button was pressed.  Just test on the !err system
+;     variable: !err=1 => left !err=2 => middle !err=4 => right.
+;
+; COMMON BLOCKS: pause_blk
+;                       
+; EXAMPLE:        
+;
+;x=findgen(201)/10.-10. 
+;for a=-2.,2.,.1 do begin & plot,x,1/(x^2*10.^a+1),tit=string(a) & pause & end
+;
+;for a=-2.,2.,.1 do begin & plot,x,1/(x^2*10.^a+1),tit=string(a) &$
+;   pause,/u & end
+;
+;  author:  Paul Ricchiazzi                            22sep92
+;           Institute for Computational Earth System Science
+;           University of California, Santa Barbara
+;-
+
+
+if !d.name eq 'X' and !p.multi(0) eq 0 then begin
+  cursor,xw,yw,/nowait,/device
+  
+  if xw eq -1 then begin
+    if keyword_set(on_screen) then return
+    if n_elements(xcrs) eq 0 then xcrs=.9*!d.x_vsize 
+    if n_elements(ycrs) eq 0 then ycrs=.9*!d.y_vsize 
+    tvcrs,xcrs,ycrs
+  endif
+  device,cursor_standard=16
+  cursor,xdum,ydum,/wait,/device
+  if keyword_set(up) then cursor,xdum,ydum,/up,/device
+  device,cursor_standard=30
+endif
+end
Index: trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/scr
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/scr	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/scr	(revision 2744)
@@ -0,0 +1,32 @@
+#! /bin/bash
+
+## use: scr U V W
+## les fichiers deja crees ne sont pas recrees
+
+## IDL remplit la memoire et devient plus lent...
+
+mean='1'
+mean='[1,2]'
+
+count='[1,1,0,0]'
+offset='[20,20,0,0]'
+
+count='0'
+offset='0'
+
+\rm log 2> /dev/null
+touch log
+
+for fich in $(ls wrfout*) ; do
+ for param in "$@" ; do
+
+  echo $param $fich
+  unset limits 
+#  echo "ye = getget('"${fich}"', '"${param}"',coordmean="$mean") & DELVAR, ye & exit" | /distrib/local/rsi/idl_6.1/bin/idl >> log 2>> log
+  echo "ye = getget('"${fich}"', '"${param}"',count="$count",offset="$offset") & DELVAR, ye & exit" | /distrib/local/rsi/idl_6.1/bin/idl >> log 2>> log
+
+ done 
+done
+
+
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/turbulence.pro
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/turbulence.pro	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/turbulence.pro	(revision 2744)
@@ -0,0 +1,549 @@
+pro turbulence
+
+;;----------------------------------------------------
+;;----------------------------------------------------
+;;----------------------------------------------------
+
+
+retrieve='true'
+;retrieve='false'
+
+
+
+;; CALCUL DE LA MOYENNE
+;; 18 pas assez 74 trop
+meansmooth=37
+;meansmooth=18
+;meansmooth=74
+
+;; CALCUL DE LA MOYENNE DES FLUX
+;smoothampl=74
+;smoothampl=2
+;smoothampl=10
+;smoothampl=18
+smoothampl=meansmooth
+
+saveps='false'
+;saveps='true'
+
+yu=20
+
+;;----------------------------------------------------
+;;----------------------------------------------------
+;;----------------------------------------------------
+
+
+p0=610. & t0=220. & r_cp=1/4.4 & grav=3.72 & R=192.
+
+;
+; graphics definition
+;
+if (saveps eq 'false') then begin
+   !p.multi=[0,3,2]
+   !P.CHARSIZE=2.
+endif else begin
+   !p.charthick = 2.0
+   !p.thick = 3.0
+   !x.thick = 2.0
+   !y.thick = 2.0
+endelse
+
+;
+; input files
+;
+OPENR, 22, 'input_coord' & READF, 22, lonu & READF, 22, latu & READF, 22, lsu & READF, 22, lctu & CLOSE, 22
+OPENR, 23, 'input_more' & READF, 23, hgtu, tsurfu & CLOSE, 23
+print, lonu, latu, lsu, lctu, hgtu, tsurfu
+
+
+;
+; retrieve
+;
+if (retrieve eq 'true') then begin
+
+
+;
+; get fields
+;
+getcdf, file='u'+string(yu,'(I0)')+'.nc', charvar='U', invar=u
+getcdf, file='v'+string(yu,'(I0)')+'.nc', charvar='V', invar=v
+getcdf, file='t'+string(yu,'(I0)')+'.nc', charvar='T', invar=t
+getcdf, file='w'+string(yu,'(I0)')+'.nc', charvar='W', invar=w
+getcdf, file='p'+string(yu,'(I0)')+'.nc', charvar='PTOT', invar=p
+	;
+	; no vertical staggering for w
+	;
+	wplus=shift(w,0,0,-1,0)
+	w=(w+wplus)/2.
+	w=w(*,*,0:n_elements(w(0,0,*,0))-2,*)
+
+
+ndim=n_elements(t(*,0,0,0))
+lat=fltarr(ndim,ndim)
+lon=fltarr(ndim,ndim)
+  for i=0,ndim-1 do begin
+  for j=0,ndim-1 do begin
+    lat(i,j)=latu+float(j)*100./59000.
+    lon(i,j)=lonu+float(i)*100./59000.
+  endfor
+  endfor
+what_I_plot=0. & what_I_plot2=0. & what_I_plot3=0. & what_I_plot4=0. & what_I_plot5=0. & what_I_plot6=0.
+maxwhat_I_plot=0. & maxwhat_I_plot2=0. & maxwhat_I_plot3=0.
+minwhat_I_plot=0.
+
+
+;
+; loop on west-east coordinate
+;
+nloop=n_elements(t(*,0,0,0))
+for i=0,nloop-1 do begin
+
+	indp=[i,0]	;;indp=[75,0]
+
+	;
+	; 2D field for plot
+	;
+	t2=reform(t(indp[0],indp[1],*,*))
+t2_save=t0+reform(t(indp[0],indp[1],*,*))
+treal2_save=t2_save*(reform(p(indp[0],indp[1],*,*))/p0)^r_cp
+	u2=reform(u(indp[0],indp[1],*,*))
+	v2=reform(v(indp[0],indp[1],*,*))
+	w2=reform(w(indp[0],indp[1],*,*))
+	nz=n_elements(t2(*,0))
+	nt=n_elements(t2(0,*))
+
+nt=nt-2
+t2=t2[*,0:nt-1]
+u2=u2[*,0:nt-1]
+v2=v2[*,0:nt-1]
+w2=w2[*,0:nt-1]
+
+        	;;
+        	;; local time
+        	;;
+        	;localtime=21.+100.*findgen(nt)/3700.+lon(indp[0],indp[1])/15.-24. 
+                localtime=lctu+100.*findgen(nt)/3700.
+		;;print, localtime
+		
+	;
+	; 1. perturbations
+	;
+	for k=0,nz-1 do begin
+		t2(k,*)=t2(k,*)-SMOOTH(reform(t2(k,*)),meansmooth,/EDGE_TRUNCATE)
+		u2(k,*)=u2(k,*)-SMOOTH(reform(u2(k,*)),meansmooth,/EDGE_TRUNCATE)
+		v2(k,*)=v2(k,*)-SMOOTH(reform(v2(k,*)),meansmooth,/EDGE_TRUNCATE)
+		w2(k,*)=w2(k,*);-SMOOTH(reform(w2(k,*)),meansmooth,/EDGE_TRUNCATE)
+		;treal2_save(k,*)=treal2_save(k,*)-SMOOTH(reform(treal2_save(k,*)),meansmooth,/EDGE_TRUNCATE)
+	endfor
+	;
+	; 2. nonlinear products
+	;
+	vertical_eddy_heat_flux=w2*t2
+	uprime2=u2^2
+	vprime2=v2^2
+	wprime2=w2^2
+	;
+	; 3. Reynolds averaging
+	;
+	for k=0,nz-1 do begin
+		vertical_eddy_heat_flux(k,*)=SMOOTH(reform(vertical_eddy_heat_flux(k,*)),smoothampl,/EDGE_TRUNCATE)
+	        uprime2(k,*)=SMOOTH(reform(uprime2(k,*)),smoothampl,/EDGE_TRUNCATE)
+	        vprime2(k,*)=SMOOTH(reform(vprime2(k,*)),smoothampl,/EDGE_TRUNCATE)
+	        wprime2(k,*)=SMOOTH(reform(wprime2(k,*)),smoothampl,/EDGE_TRUNCATE)
+	endfor
+	tke=0.5*(uprime2+vprime2+wprime2)
+
+
+what_I_plot=what_I_plot+vertical_eddy_heat_flux/nloop
+what_I_plot2=what_I_plot2+tke/nloop
+what_I_plot3=what_I_plot3+wprime2/nloop
+what_I_plot4=what_I_plot4+t2_save/nloop
+what_I_plot5=what_I_plot5+treal2_save/nloop
+if (i eq nloop-1) then  what_I_plot6=t2
+
+;;help, t2
+;;help, treal2_save
+;treal2_save=treal2_save(0:n_elements(t2(*,0))-1,0:n_elements(t2(0,*))-1)
+;if (i eq nloop-1) then  what_I_plot6=treal2_save
+
+yeah=max(vertical_eddy_heat_flux)
+yeah2=max(tke)
+yeah3=max(wprime2)
+yeah4=min(vertical_eddy_heat_flux)
+
+if (yeah gt maxwhat_I_plot) then maxwhat_I_plot=yeah
+if (yeah2 gt maxwhat_I_plot2) then maxwhat_I_plot2=yeah2
+if (yeah3 gt maxwhat_I_plot3) then maxwhat_I_plot3=yeah3
+if (yeah4 lt minwhat_I_plot) then minwhat_I_plot=yeah4
+
+endfor
+
+
+
+
+
+;
+; get model height
+;
+getcdf, file='ph'+string(yu,'(I0)')+'.nc', charvar='PHTOT', invar=ph
+height=reform(ph(*,0,*,*))   
+height=total(height,1)/n_elements(height(*,0,0))
+height=reform(height)
+height=total(height(*,1:nt-1),2)/(nt-1)
+height=height/1000./3.72
+heightp=height(0:n_elements(height(*))-2) 
+	;
+	; altitude above ground
+	;	
+        heightp=heightp-hgtu/1000.
+
+
+;
+; save
+;
+save, what_I_plot, $
+	what_I_plot2, $
+	what_I_plot3, $
+	what_I_plot4, $
+	what_I_plot5, $
+	what_I_plot6, $
+	localtime, $
+	heightp, $
+	lat, $
+	lon, $
+	hgtu, $
+	filename='turbulence.dat' 
+
+endif else begin
+	restore, filename='turbulence.dat'	
+endelse	
+
+help, what_I_plot
+help, localtime
+help, heightp
+
+
+latwrite=string(lat(0,yu),'(F5.1)')
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then begin
+  set_plot, 'ps' & device, filename='plot/TKE.ps'
+endif
+
+lev=findgen(15)+1.
+contour, $
+        transpose(what_I_plot2), $
+        localtime, $
+        heightp, $
+        xtitle='Local Time (h)', $
+        xrange=[8.,18.], $
+        xtickinterval=1., $
+        ytitle='Altitude above surface (km)', $
+        yrange=[0.,10.], $
+        ytickinterval=1., $
+        title="Turbulent Kinetic Energy 0.5[<u'!U2!N>+<v'!U2!N>+<w'!U2!N>] (m!U2!N.s!U-2!N)", $
+        levels=lev, $
+        c_labels=findgen(n_elements(lev))*0.+1., $
+	subtitle='zonal average at lat. '+latwrite+' (max value is '+string(maxwhat_I_plot2,'(F4.1)')+' m!U2!N.s!U-2!N)'
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then begin
+  device, /close
+  set_plot, 'ps' & device, filename='plot/zTKE.ps'
+endif
+
+lev=findgen(15)+1.
+contour, $
+        0.5*transpose(what_I_plot3), $
+        localtime, $
+        heightp, $
+        xtitle='Local Time (h)', $
+        xrange=[8.,18.], $
+        xtickinterval=1., $
+        ytitle='Altitude above surface (km)', $
+        yrange=[0.,10.], $
+        ytickinterval=1., $
+        title="Vertical TKE 0.5<w'!U2!N> (m!U2!N.s!U-2!N)", $
+        levels=lev, $
+        c_labels=findgen(n_elements(lev))*0.+1., $
+        subtitle='zonal average at lat. '+latwrite+' (max value is '+string(0.5*maxwhat_I_plot3,'(F4.1)')+' m!U2!N.s!U-2!N)'
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+
+if (saveps eq 'true') then begin
+  device, /close
+  set_plot, 'ps' & device, filename='plot/HF.ps'
+endif
+
+;lev=[-0.15,-0.05,-0.02,0.05,0.15,0.25,0.35,0.45,0.55,0.65,0.75,0.85,0.95]
+lev = -1. + findgen(20)/10.
+contour, $
+        transpose(what_I_plot), $
+        localtime, $
+        heightp, $ 
+	xtitle='Local Time (h)', $
+	xrange=[8.,18.], $
+	xtickinterval=1., $
+	ytitle='Altitude above surface (km)', $
+	yrange=[0.,10.], $
+	ytickinterval=1., $
+	title="Vertical Eddy Heat Flux <w'!7h!3'> (K.m.s!U-1!N)", $
+	levels=lev, $	
+	C_LINESTYLE = (lev LT 0.0), $
+	c_labels=findgen(n_elements(lev))*0.+1., $
+        subtitle='zonal average at lat. '+latwrite+' (min/max values are '+string(minwhat_I_plot,'(F5.1)')+'/'+string(maxwhat_I_plot,'(F3.1)')+' K.m.s!U-1!N)'
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+goto, no_pert_temp
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then begin
+  device, /close
+  set_plot, 'ps' & device, filename='plot/pert_temp.ps'
+endif
+
+lev=[-4.,-2.,-1.,-0.5,0.5,1.,2.,4.]
+contour, $
+	transpose(what_I_plot6), $
+        localtime, $
+        heightp, $
+        xtitle='Local Time (h)', $
+        xrange=[13.5,14.], $
+        xtickinterval=0.1, $
+        ytitle='Altitude above surface (km)', $
+        yrange=[0.,0.5], $
+        ytickinterval=0.1, $
+        title="Potential Temperature Perturbation !7h!3' (K)", $
+        levels=lev, $
+;nlevels=20, $
+        C_LINESTYLE = (lev LT 0.0), $
+        c_labels=findgen(n_elements(lev))*0.+1., $
+;/cell_fill, $
+        subtitle='latitude '+latwrite+' longitude '+string(lon(nloop-1,0),'(F6.1)')
+;xyouts, 14.007, heightp(0), '1'
+;xyouts, 14.016, heightp(1), '2'
+;xyouts, 14.007, heightp(2), '3'
+;xyouts, 14.007, heightp(3), '4'
+;xyouts, 14.007, heightp(4), '5'
+;xyouts, 14.007, heightp(5), '6'
+;xyouts, 14.007, heightp(6), '7'
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+no_pert_temp:
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+
+
+if (saveps eq 'true') then begin
+  device, /close
+  set_plot, 'ps' & device, filename='plot/temp_pot.ps'
+endif
+
+user_lt=10. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+plot, $
+        what_I_plot4(*,yeah(0)), $
+        heightp,$
+	xtitle='Potential Temperature (K)',$
+;	xrange=[215,240], $
+        xtickinterval=5., $
+        ytitle='Altitude above surface (km)', $
+	yrange=[0.,10.], $
+        ytickinterval=1., $
+	title="Potential Temperature !7h!3 profile (K)", $
+        subtitle='zonal average at lat. '+latwrite
+user_lt=12. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+        oplot, what_I_plot4(*,yeah(0)), heightp, linestyle=1
+user_lt=14. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+        oplot, what_I_plot4(*,yeah(0)), heightp
+user_lt=16. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+        oplot, what_I_plot4(*,yeah(0)), heightp, linestyle=1
+user_lt=18. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+        oplot, what_I_plot4(*,yeah(0)), heightp
+
+;xyouts, 217.3, 0.5, '10:00'
+;xyouts, 225.8, 1.5, '12:00'
+;xyouts, 231.8, 3.0, '14:00'
+;xyouts, 234.8, 0.7, '16:00'
+;xyouts, 232.3, 2.0, '18:00'
+
+
+if (saveps eq 'true') then begin
+  device, /close
+  set_plot, 'ps' & device, filename='plot/temp.ps'
+endif
+
+user_lt=14.+55./60. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+plot, $
+        what_I_plot5(*,yeah(0)), $
+        heightp,$
+        xtitle='Temperature (K)',$
+        xrange=[210,250], $
+        xtickinterval=5., $
+        ytitle='Altitude above surface (km)', $
+        yrange=[0.,2.], $
+        ytickinterval=0.2, $
+        title="LMD LES Near-surface T profile (K)", $
+        subtitle='zonal average at lat. '+latwrite, $
+	linestyle=2	
+user_lt=10.+24./60. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+	oplot, what_I_plot5(*,yeah(0)), heightp
+user_lt=10.+59./60. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+	oplot, what_I_plot5(*,yeah(0)), heightp, linestyle=2
+user_lt=11.+59./60. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+	oplot, what_I_plot5(*,yeah(0)), heightp
+user_lt=15.+22./60. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+	oplot, what_I_plot5(*,yeah(0)), heightp
+user_lt=17.+13./60. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+        oplot, what_I_plot5(*,yeah(0)), heightp, linestyle=2
+
+;xyouts, 221,   0.2,  '10:24'
+;xyouts, 226.5,   0.4,  '10:59'
+;xyouts, 231.8, 0.2,  '11:59'
+;xyouts, 233,   0.8,  '14:55'
+;xyouts, 241,   0.1,  '15:22'
+;xyouts, 236.5, 0.05, '17:13'
+ 
+
+;;
+;xyouts, 250.05, heightp(0), '1'
+;xyouts, 250.45, heightp(1), '2'
+;xyouts, 251.00, heightp(2), '3'
+;xyouts, 250.45, heightp(3), '4'
+;xyouts, 250.45, heightp(4), '5'
+;xyouts, 250.45, heightp(5), '6'
+;xyouts, 250.45, heightp(6), '7'
+;xyouts, 250.45, heightp(7), '8'
+;xyouts, 250.45, heightp(8), '9'
+;xyouts, 250.25, heightp(9), '10'
+;xyouts, 250.25, heightp(10), '11'
+;xyouts, 250.25, heightp(11), '12'
+;xyouts, 250.25, heightp(12), '13'
+;xyouts, 250.25, heightp(13), '14'
+;xyouts, 250.25, heightp(14), '15'
+;xyouts, 250.25, heightp(15), '16'
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;goto, no_staticstab
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then begin
+  device, /close
+  set_plot, 'ps' & device, filename='plot/staticstab.ps'
+endif
+
+user_lt=17. & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+
+   ;;; recompute height @ given local time 
+   caca=heightp+hgtu/1000.
+   height=reform(ph(*,0,*,*))
+   height=total(height,1)/n_elements(height(*,0,0))
+   height=reform(height)
+   height=reform(height(*,yeah(0)))
+   height=height/1000./3.72
+   heightp=height(0:n_elements(height(*))-2) 
+   print, 'new minus old', heightp - caca
+   ;;; recompute height @ given local time 
+
+        press=reform(p(*,0,*,*))
+        press=total(press,1)/n_elements(press(*,0,0))
+        press=reform(press)
+        press=reform(press(*,yeah(0)))
+        press=press(0:n_elements(press(*))-2)
+
+staticstab = DERIV( heightp , reform(what_I_plot5(*,yeah(0))) ) + 1000.*3.72/844.6  ;; 4.9 dans Hinson
+   staticstab = staticstab(0:n_elements(staticstab)-5)
+   heightp = heightp(0:n_elements(heightp)-5)
+
+plot, $
+        staticstab, $
+        heightp,$
+        xtitle='Static stability (K/km)',$
+        xrange=[-1.,5.], $
+        xtickinterval=0.5, $
+        ytitle='Altitude above surface (km)', $
+        yrange=[min(heightp),max(heightp)], $
+        ytickinterval=1., $
+        title="LMD LES Static stability @ LT 17h (K/km)", $
+        subtitle='zonal average at lat. '+latwrite
+oplot, $
+        staticstab, $
+        heightp,$
+        psym=5
+oplot, $
+       findgen(n_elements(heightp))*0. + 1.,$
+       heightp,$
+       linestyle=2
+oplot, $
+       findgen(n_elements(heightp))*0. + 2.,$
+       heightp,$
+       linestyle=2
+
+;;;;;;;;;;
+w = where((staticstab gt 1.5) and ((heightp- hgtu/1000.) gt 1.))
+t_top_plus = what_I_plot5(w(0),yeah(0))
+z_top_plus = heightp(w(0))
+p_top_plus = press(w(0))
+t_top_moins = what_I_plot5(w(0)-1,yeah(0))
+z_top_moins = heightp(w(0)-1)
+p_top_moins = press(w(0)-1)
+pbl_depth = (z_top_plus*alog(p_top_plus) + z_top_moins*alog(p_top_moins))/(alog(p_top_plus) + alog(p_top_moins)) - hgtu/1000.
+xyouts, 3., 1.5 + (max(heightp) + min(heightp)) / 3., 'Ls = '+string(lsu,'(F5.1)')+'!Uo!N', CHARSIZE=1
+xyouts, 3., 1. + (max(heightp) + min(heightp)) / 3., 'Lat = '+string(latu,'(F5.1)')+'!Uo!N', CHARSIZE=1
+xyouts, 3., 0.5 + (max(heightp) + min(heightp)) / 3., 'LonE = '+string(lonu,'(F6.1)')+'!Uo!N', CHARSIZE=1
+xyouts, 3., (max(heightp) + min(heightp)) / 3., 'T!Dt!N = '+string(t_top_plus,'(I0)')+'/'+string(t_top_moins,'(I0)')+' K ', CHARSIZE=1
+xyouts, 3., -0.5 + (max(heightp) + min(heightp)) / 3., 'p!Dt!N = '+string(p_top_plus,'(I0)')+'/'+string(p_top_moins,'(I0)')+' Pa', CHARSIZE=1
+xyouts, 3., -1. + (max(heightp) + min(heightp)) / 3., 'z!Dt!N = '+string(z_top_plus,'(F4.1)')+'/'+string(z_top_moins,'(F4.1)')+' km', CHARSIZE=1
+xyouts, 3., -1.5 + (max(heightp) + min(heightp)) / 3., 'z!Ds!N = '+string(hgtu/1000.,'(F4.1)')+' km', CHARSIZE=1
+xyouts, 3., -2. + (max(heightp) + min(heightp)) / 3., 'D = '+string(pbl_depth,'(F4.1)')+' km', CHARSIZE=1
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+no_staticstab:
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+if (saveps eq 'true') then begin
+  device, /close
+endif
+stop
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+user_lt=13.
+yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+
+user_h=0.1
+walt=where(abs(heightp-user_h) eq (min(abs(heightp-user_h))))
+
+;mapfield=reform(t[*,*,walt(0),w(0)])
+;help, mapfield
+;contour, mapfield
+
+section=reform(w[*,0,*,yeah(0)])
+
+section=reform(w[*,0,*,160])
+
+lev=[-12.,-8.,-4.,4.,8.,12.]
+lev=[-5.,-4.,-3.,-2.,-1.,1.,2.,3.,4.,5.]
+contour, $
+	section, $
+	(lon(*,0)-lon(0,0))*59., $
+	heightp, $
+	levels=lev , $
+	C_LINESTYLE = (lev LT 0.0)
+
+device, /close
+
+end
Index: trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/turbulence2.pro
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/turbulence2.pro	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/plot_util_bak/turbulence2.pro	(revision 2744)
@@ -0,0 +1,250 @@
+pro turbulence2
+
+
+retrieve='true'
+
+fast='true'
+;fast='false'
+
+
+p0=610. & t0=220. & r_cp=1/4.4 & grav=3.72 & R=192. & g_cp=1000.*grav/844.6
+;;;;;;;;;;;;;;;;;;;;;;;
+;                     ;
+; HINSON - HINSON !!! ;
+;                     ;
+r_cp = 0.25           ; 
+;g_cp = 4.9           ;
+;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+;
+; input files
+;
+OPENR, 22, 'input_coord' & READF, 22, lonu & READF, 22, latu & READF, 22, lsu & READF, 22, lctu & CLOSE, 22
+OPENR, 23, 'input_more' & READF, 23, hgtu, tsurfu & CLOSE, 23
+print, lonu, latu, lsu, lctu, hgtu, tsurfu
+
+;
+; retrieve
+;
+if (retrieve eq 'true') then begin
+
+;
+; get fields and dimensions
+;
+getcdf, file='t.nc', charvar='T', invar=t
+getcdf, file='p.nc', charvar='PTOT', invar=p
+getcdf, file='ph.nc', charvar='PHTOT', invar=ph
+nx=n_elements(t(*,0,0,0))
+ny=n_elements(t(0,*,0,0))
+nz=n_elements(t(0,0,*,0))
+nt=n_elements(t(0,0,0,*))
+   ;;;; pour eviter de detecter des fluctuations plus basses que PBL top ;;;
+     smooth_gridpoint = 2 & smooth_time = 2 & smooth_vert = 2  
+     ;smooth_gridpoint = 0 & smooth_time = 0 & smooth_vert = 0  
+     t = smooth(t,[smooth_gridpoint,smooth_gridpoint,smooth_vert,smooth_time],/EDGE_TRUNCATE)
+     p = smooth(p,[smooth_gridpoint,smooth_gridpoint,smooth_vert,smooth_time],/EDGE_TRUNCATE)
+     ;ph = smooth(ph,[smooth_gridpoint,smooth_gridpoint,smooth_vert,smooth_time],/EDGE_TRUNCATE)
+   ;;;; pour eviter de detecter des fluctuations plus basses que PBL top ;;;
+
+;
+; localtime loop
+;
+localtime = lctu + 100.*findgen(nt)/3700.
+  ;
+  ; radio-occultations
+  ;
+  user_lt=17.0 & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+  user_lt=17.5 & yeah2=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+  ;;
+  ;; PBL growth
+  ;;
+  ;user_lt=14.5 & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+  ;user_lt=18.0 & yeah2=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+  ;
+
+  user_lt=14.0 & yeah=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+  user_lt=14.5 & yeah2=where(abs(localtime-user_lt) eq (min(abs(localtime-user_lt))))
+
+
+
+deb=yeah(0)
+fin=yeah2(0)
+
+;
+; calculate over domain
+;
+pbl_depth_tab=findgen(nx,ny,fin-deb+1)
+nloop = nx*ny
+
+;
+; LOOOOOOP
+;
+for tt=deb,fin do begin
+
+ tprof_mean = 0.
+ heightp_mean = 0.
+ staticstab_mean = 0.
+ nbad = 0
+
+for i=0,nx-1 do begin
+for j=0,ny-1 do begin
+
+ height=reform( ph( i,j,*,tt ) ) / 1000. / grav
+ heightp=height(0:nz-1) ;no stagger
+
+ thprof = t0 + reform( t( i,j,*,tt ) )
+ pprof = reform( p( i,j,*,tt ) )
+ tprof = thprof * ( pprof/p0 )^r_cp
+
+ staticstab = DERIV( heightp , tprof ) + g_cp  
+
+if (fast eq 'true') then begin
+
+; MOINS BON mais PLUS RAPIDE
+tprof_mean = tprof_mean + tprof/nloop
+heightp_mean = heightp_mean + heightp/nloop
+staticstab_mean = staticstab_mean + staticstab/nloop
+
+endif else begin
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  z_in = heightp
+  profile_in = staticstab
+  resol = 500.  ;200 un peu juste
+  ;********************************************************************
+  ; ---- numerical recipes in C - section 3.3 ----
+  ;
+  ; Calculate interpolating cubic spline 
+        yspline = SPL_INIT(z_in,profile_in)
+  ; Define the X values P at which we desire interpolated Y values
+        xspline=min(z_in)+findgen(floor(max(z_in)-min(z_in))*resol)/resol
+  ; Calculate the interpolated Y values
+        result=spl_interp(z_in,profile_in,yspline,xspline)
+  ;********************************************************************
+  staticstab = result
+  heightp = xspline
+
+  heightp_mean = heightp_mean + heightp/nloop
+  staticstab_mean = staticstab_mean + staticstab/nloop
+    yspline = SPL_INIT(z_in,tprof)
+    tprof = spl_interp(z_in,tprof,yspline,xspline)
+  tprof_mean = tprof_mean + tprof/nloop
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+endelse
+
+lim=3.
+lim=1.5
+w = where( (staticstab ge lim) and (heightp-heightp(0) ge lim) )
+pbl_depth_tab(i,j,tt-deb) = heightp(w(0)) - heightp(0)
+
+   ; garde-fou supplementaire
+   if (heightp(w(0)) - heightp(0) lt 2.) then begin
+     pbl_depth_tab(i,j,tt-deb) = !VALUES.F_NAN
+     ;plot, profile_in, z_in, xrange=[-1.,5.], psym=5, title='bad!' & oplot, staticstab, heightp & oplot, staticstab, findgen(nz)*0. + heightp(w(0)), linestyle=2
+     print, heightp(w) - heightp(0)
+     nbad = nbad+1
+   endif
+
+;plot, profile_in, z_in, xrange=[-1.,5.], psym=5 & oplot, staticstab, heightp & oplot, staticstab, findgen(nz)*0. + heightp(w(0)), linestyle=2 
+;pause
+
+endfor
+;print, i
+endfor
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  print, '-------------------------------------------------------'
+  print, 'Local Time : ', localtime(tt)
+  print, 'nbad ', nbad
+  print, 'PBL height - min ', min(pbl_depth_tab(*,*,tt-deb))
+  print, 'PBL height - max ', max(pbl_depth_tab(*,*,tt-deb))
+  print, 'PBL height - mean ', mean(pbl_depth_tab(*,*,tt-deb))
+    ;; static stability of mean profile
+    staticstab = DERIV( heightp_mean , tprof_mean ) + g_cp
+
+	  ;z_in = heightp_mean
+	  ;profile_in = staticstab
+	  ;resol = 500  ;200 un peu juste
+	  ;;********************************************************************
+	  ;; ---- numerical recipes in C - section 3.3 ----
+	  ;;
+	  ;; Calculate interpolating cubic spline 
+	  ;      yspline = SPL_INIT(z_in,profile_in)
+	  ;; Define the X values P at which we desire interpolated Y values
+	  ;      xspline=min(z_in)+findgen(floor(max(z_in))*resol)/resol
+	  ;; Calculate the interpolated Y values
+	  ;      result=spl_interp(z_in,profile_in,yspline,xspline)
+	  ;;********************************************************************
+	  ;staticstab = result
+	  ;w = where((staticstab ge 1.5) and (xspline-xspline(0) gt 2.))
+	  ;print, 'PBL height - mean profile', xspline(w(0)) - xspline(0)
+
+    w = where((staticstab ge 1.5) and (heightp_mean-heightp_mean(0) gt 1.5))
+    print, 'PBL height - mean profile', heightp_mean(w(0))-heightp_mean(0)
+    ;; mean static stability
+    w = where((staticstab_mean ge 1.5) and (heightp_mean-heightp_mean(0) gt 1.5))
+    print, 'PBL height - mean static stability', heightp_mean(w(0)) - heightp_mean(0)
+
+   ;plot, staticstab, heightp_mean, xrange=[-1.,5.]
+   ;oplot, staticstab, findgen(nz)*0. + heightp_mean(w(0)), linestyle=2
+   ;oplot, staticstab_mean, heightp_mean
+   ;oplot, staticstab_mean, findgen(nz)*0. + heightp_mean(w(0)), linestyle=2
+   ;pause
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+endfor
+endif
+
+  print, '-------------------------------------------------------'
+  print, 'PBL height - min ', min(pbl_depth_tab(*,*,*))
+  print, 'PBL height - max ', max(pbl_depth_tab(*,*,*))
+  print, 'PBL height - mean ', mean(pbl_depth_tab(*,*,*))
+  print, '-------------------------------------------------------'
+
+stop
+
+!p.charthick = 2.0
+!p.thick = 3.0
+!x.thick = 2.0
+!y.thick = 2.0
+set_plot, 'ps' & device, filename='plot/map.ps', /color
+;map_latlon, reform(pbl_depth_tab(*,*,0))
+
+
+what_I_plot = reform(pbl_depth_tab(*,*,0))
+pal=4
+colors=128
+title_user='PBL depth'
+map_latlon, $
+        what_I_plot, $                          ; 2D field
+        lon, $                                  ; 1D latitude
+        lat, $                                  ; 1D longitude
+;        minfield=minfield_init, $               ; minimum value of plotted field (=0: calculate)
+;        maxfield=maxfield_init, $               ; maximum value of plotted field (=0: calculate)
+;        overcontour=overcontour, $              ; another 2D field to overplot with contour lines (=0: no)
+;        overvector_x=overvector_x, $            ; wind vector - x component (=0: no)
+;        overvector_y=overvector_y, $            ; wind vector - y component (=0: no)
+        ct=pal, $                               ; color table (33-rainbow is default)
+        colors=colors, $                        ; number of colors/levels (32 is default)
+        title=title_user;, $                     ; title of the plot ('' is default)
+;        format=format                           ; format of colorbar annotations ('(F6.2)' is default)
+
+
+
+device, /close
+end
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/callphys.def
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/callphys.def	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/callphys.def	(revision 2744)
@@ -0,0 +1,94 @@
+General options
+~~~~~~~~~~~~~~~
+tracer    (Run with or without tracer transport ?)
+F
+diurnal   (Diurnal cycle ?  if diurnal=F, diurnal averaged solar heating)
+T
+season    (Seasonal cycle ? if season=F, Ls stays constant like in "start")
+T
+lwrite    (want some more output on the screen ?) 
+F
+stats     (Saving statistics in file "cumul" ?) -- noWRF
+F
+calleofdump (Saving EOF profiles in file "profiles" for Climate Database ?) -- noWRF
+F
+Dust scenario. Used if the dust is prescribed (i.e. if tracer=F or active=F)
+~~~~~~~~~~~~~
+iaervar  (=1 Dust opt.deph read in startfi; =2 Viking scenario; =3 MGS scenario 
+1        (=4 Mars Year 24 from TES assimilation)
+iddist  (Dust vertical distribution: =0: old distrib. (Pollack90) 
+3       (=1: top set by "topdustref"; =2: Viking scenario; =3 MGS scenario )
+topdustref (Dust top altitude (km). Matter only if iddist=1)
+55.
+Physical Parameterizations :
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+callrad   (call radiative transfer ?)
+T
+callnlte (call NLTE radiative schemes ?   matter only if callrad=T)
+F
+callnirco2 (call CO2 NIR absorption ?   matter only if callrad=T)
+F
+calldifv  (call turbulent vertical diffusion ?)
+T
+calladj   (call convective adjustment ?)
+F
+callcond  (call CO2 condensation ?)
+F
+callsoil  (call thermal conduction in the soil ?)
+T
+calllott  (call Lott's gravity wave/subgrid topography scheme ?) -- noWRF
+F
+Radiative transfer options :
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+iradia    (the rad.transfer is computed every "iradia" physical timestep)
+10 
+callg2d   (Output of the exchange coefficient mattrix ? for diagnostic only)
+F
+rayleigh  (Rayleigh scattering : should be =F for now)
+F
+Tracer (dust water, ice and/or chemical species) options (use if tracer=T) :
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+dustbin    (DUST: Transported dust ? (if >0, uses q(1) to q(dustbin))
+0
+active     (DUST: Radiatively active dust ? (uses q(1) to q(dustbin))
+F
+doubleq    (DUST: needs dustbin=1, use mass (q(1)) and number (q(2)) mixing ratio to predict dust size ?)
+F
+lifting    (DUST: lifted by GCM surface winds ?)
+F
+dustdevil  (DUST: lifted by dust devils ?)
+F
+scavenging (DUST: Scavenging by CO2 snowfall ?)
+F
+sedimentation (DUST/WATERICE: Gravitationnal sedimentation ?)
+F
+iceparty   (WATERICE: Water cycle includes water ice mixing ratio q(nqmx-1))
+F
+activice   (WATERICE: Radiatively active transported atmospheric water ice ?)
+F
+water      (WATER: Compute water cycle using q(nqmx) )
+F
+caps       (WATER: put the current permanent caps at both poles)
+F
+photochem  (PHOTOCHEMISTRY: chemical species included)
+F
+Thermospheric options (relevant if tracer=T) :
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+callthermos  (call thermosphere ?)
+F
+thermoswater  (WATER: included without cycle	only if water=F)
+F
+callconduct  (call thermal conduction ?     matter only if callthermos=T)
+F
+calleuv  (call EUV heating ?                matter only if callthermos=T)
+F
+callmolvis  (call molecular viscosity ?     matter only if callthermos=T)
+F
+callmoldiff  (call molecular diffusion ?    matter only if callthermos=T)
+F
+thermochem  (call thermospheric photochemistry ?  matter only if callthermos=T)
+F
+solarcondate (date for solar flux calculation: 1985 < date < 2002))
+1993.4       (Solar min=1996.4 ave=1993.4 max=1990.6)
+
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/dustopacity.def
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/dustopacity.def	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/dustopacity.def	(revision 2744)
@@ -0,0 +1,1 @@
+0.3
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_coord
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_coord	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_coord	(revision 2744)
@@ -0,0 +1,6 @@
+35.   lon  
+40.   lat   
+0.    ls 
+12.   lct  
+150.  ztop 
+200.  nz  
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_more
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_more	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_more	(revision 2744)
@@ -0,0 +1,1 @@
+  -1018.50    275.63
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_sounding
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_sounding	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_sounding	(revision 2744)
@@ -0,0 +1,208 @@
+      6.38      272.84        0.00
+  -1018.50      272.84        0.00        0.00        0.00
+  -1017.50      264.93        0.00        5.12        1.21
+  -1013.50      233.27        0.00        6.90        1.63
+  -1008.50      221.99        0.00        7.48        1.77
+   -998.50      221.15        0.00        8.32        1.97
+   -968.50      220.86        0.00        9.44        2.24
+   -918.50      220.83        0.00       10.27        2.44
+   -818.50      220.77        0.00       11.18        2.66
+    -65.74      220.35        0.00       13.74        3.12
+    687.03      220.15        0.00       15.28        2.71
+   1439.79      220.76        0.00       16.43        2.40
+   2192.56      222.16        0.00       17.27        2.34
+   2945.32      223.55        0.00       18.11        2.29
+   3698.08      225.76        0.00       19.82        2.31
+   4450.85      228.41        0.00       21.99        2.36
+   5203.61      231.10        0.00       24.15        2.41
+   5956.37      233.79        0.00       26.27        2.46
+   6709.14      236.46        0.00       28.23        2.47
+   7461.90      239.16        0.00       30.19        2.49
+   8214.67      241.88        0.00       32.15        2.50
+   8967.43      244.62        0.00       34.11        2.51
+   9720.20      247.37        0.00       35.50        2.68
+  10473.00      250.13        0.00       36.69        2.89
+  11225.70      252.92        0.00       37.87        3.11
+  11978.50      255.73        0.00       39.06        3.33
+  12731.20      258.56        0.00       40.24        3.54
+  13484.00      261.41        0.00       41.43        3.76
+  14236.80      264.62        0.00       41.85        3.95
+  14989.50      267.87        0.00       42.27        4.15
+  15742.30      271.15        0.00       42.69        4.35
+  16495.10      274.47        0.00       43.11        4.54
+  17247.80      277.81        0.00       43.53        4.74
+  18000.60      281.19        0.00       43.95        4.93
+  18753.40      284.74        0.00       44.39        5.15
+  19506.10      288.72        0.00       44.90        5.44
+  20258.90      292.76        0.00       45.40        5.73
+  21011.70      296.85        0.00       45.91        6.02
+  21764.40      300.99        0.00       46.41        6.31
+  22517.20      305.18        0.00       46.92        6.59
+  23269.90      309.42        0.00       47.43        6.88
+  24022.70      313.72        0.00       47.93        7.17
+  24775.50      318.27        0.00       48.32        8.04
+  25528.20      322.92        0.00       48.69        9.01
+  26281.00      327.63        0.00       49.06        9.98
+  27033.80      332.41        0.00       49.43       10.96
+  27786.50      337.25        0.00       49.80       11.93
+  28539.30      342.15        0.00       50.17       12.90
+  29292.10      347.12        0.00       50.54       13.87
+  30044.80      352.12        0.00       50.88       14.87
+  30797.60      356.80        0.00       50.95       16.20
+  31550.30      361.52        0.00       51.03       17.52
+  32303.10      366.28        0.00       51.10       18.85
+  33055.90      371.10        0.00       51.17       20.17
+  33808.60      375.97        0.00       51.24       21.50
+  34561.40      380.88        0.00       51.31       22.83
+  35314.20      385.85        0.00       51.38       24.15
+  36066.90      390.82        0.00       51.45       25.23
+  36819.70      395.60        0.00       51.52       25.18
+  37572.50      400.42        0.00       51.60       25.13
+  38325.20      405.28        0.00       51.67       25.08
+  39078.00      410.16        0.00       51.74       25.02
+  39830.70      415.07        0.00       51.81       24.97
+  40583.50      420.02        0.00       51.88       24.92
+  41336.30      424.99        0.00       51.96       24.87
+  42089.00      430.75        0.00       51.91       23.99
+  42841.80      437.58        0.00       51.72       22.04
+  43594.60      444.51        0.00       51.53       20.10
+  44347.30      451.53        0.00       51.34       18.15
+  45100.10      458.65        0.00       51.15       16.20
+  45852.90      465.86        0.00       50.96       14.25
+  46605.60      473.17        0.00       50.77       12.31
+  47358.40      480.59        0.00       50.58       10.36
+  48111.10      492.92        0.00       49.08        7.72
+  48863.90      505.71        0.00       47.55        5.06
+  49616.70      518.82        0.00       46.01        2.39
+  50369.40      532.26        0.00       44.48       -0.27
+  51122.20      546.04        0.00       42.94       -2.93
+  51875.00      560.16        0.00       41.41       -5.59
+  52627.70      574.64        0.00       39.87       -8.25
+  53380.50      589.51        0.00       37.91      -11.20
+  54133.30      604.80        0.00       35.52      -14.45
+  54886.00      620.45        0.00       33.13      -17.69
+  55638.80      636.51        0.00       30.74      -20.93
+  56391.60      652.95        0.00       28.35      -24.18
+  57144.30      669.81        0.00       25.96      -27.42
+  57897.10      687.09        0.00       23.57      -30.66
+  58649.80      704.79        0.00       21.18      -33.91
+  59402.60      719.79        0.00       18.84      -34.10
+  60155.40      733.98        0.00       16.52      -33.23
+  60908.10      748.45        0.00       14.21      -32.35
+  61660.90      763.21        0.00       11.89      -31.48
+  62413.70      778.26        0.00        9.57      -30.60
+  63166.40      793.60        0.00        7.25      -29.72
+  63919.20      809.25        0.00        4.94      -28.85
+  64672.00      825.21        0.00        2.62      -27.97
+  65424.70      842.16        0.00        0.13      -21.15
+  66177.50      859.64        0.00       -2.41      -12.92
+  66930.20      877.47        0.00       -4.94       -4.68
+  67683.00      895.68        0.00       -7.48        3.55
+  68435.80      914.27        0.00      -10.01       11.78
+  69188.50      933.23        0.00      -12.54       20.01
+  69941.30      952.60        0.00      -15.08       28.25
+  70694.10      972.36        0.00      -17.61       36.48
+  71446.80      988.28        0.00      -18.44       41.99
+  72199.60     1003.64        0.00      -18.95       46.99
+  72952.40     1019.21        0.00      -19.46       52.00
+  73705.10     1035.00        0.00      -19.97       57.00
+  74457.90     1051.01        0.00      -20.48       62.01
+  75210.60     1067.25        0.00      -20.99       67.01
+  75963.40     1083.70        0.00      -21.50       72.01
+  76716.20     1100.39        0.00      -22.01       77.02
+  77468.90     1115.82        0.00      -22.88       78.49
+  78221.70     1131.39        0.00      -23.76       79.92
+  78974.50     1147.11        0.00      -24.64       81.34
+  79727.20     1162.99        0.00      -25.53       82.77
+  80480.00     1179.02        0.00      -26.41       84.20
+  81232.80     1195.21        0.00      -27.29       85.62
+  81985.50     1211.55        0.00      -28.17       87.05
+  82738.30     1230.83        0.00      -28.68       87.64
+  83491.00     1253.55        0.00      -28.76       87.31
+  84243.80     1276.67        0.00      -28.85       86.97
+  84996.60     1300.21        0.00      -28.93       86.64
+  85749.30     1324.16        0.00      -29.02       86.30
+  86502.10     1348.53        0.00      -29.10       85.96
+  87254.90     1373.33        0.00      -29.19       85.63
+  88007.60     1397.47        0.00      -28.44       84.15
+  88760.40     1418.47        0.00      -25.09       79.08
+  89513.20     1439.70        0.00      -21.74       74.01
+  90265.90     1461.15        0.00      -18.38       68.94
+  91018.70     1482.83        0.00      -15.03       63.87
+  91771.40     1504.72        0.00      -11.68       58.80
+  92524.20     1526.84        0.00       -8.32       53.73
+  93277.00     1550.99        0.00       -6.28       49.22
+  94029.70     1580.34        0.00       -7.74       46.18
+  94782.50     1610.21        0.00       -9.20       43.13
+  95535.30     1640.60        0.00      -10.66       40.09
+  96288.00     1671.52        0.00      -12.11       37.05
+  97040.80     1702.98        0.00      -13.57       34.01
+  97793.60     1734.99        0.00      -15.03       30.97
+  98546.30     1770.81        0.00      -17.53       30.51
+  99299.50     1809.75        0.00      -20.77       31.89
+ 100051.50     1849.47        0.00      -24.00       33.26
+ 100804.50     1890.11        0.00      -27.24       34.64
+ 101557.50     1931.63        0.00      -30.48       36.02
+ 102310.50     1974.04        0.00      -33.72       37.40
+ 103062.50     2017.22        0.00      -36.94       38.81
+ 103815.50     2058.20        0.00      -39.74       41.27
+ 104568.50     2099.97        0.00      -42.53       43.73
+ 105321.50     2142.54        0.00      -45.33       46.19
+ 106073.50     2185.86        0.00      -48.12       48.65
+ 106826.50     2230.07        0.00      -50.91       51.11
+ 107579.50     2275.13        0.00      -53.71       53.57
+ 108332.50     2316.71        0.00      -56.35       55.75
+ 109085.50     2355.88        0.00      -58.87       57.74
+ 109837.50     2395.48        0.00      -61.40       59.73
+ 110590.50     2435.59        0.00      -63.92       61.71
+ 111343.50     2476.17        0.00      -66.45       63.70
+ 112096.50     2517.22        0.00      -68.98       65.69
+ 112848.50     2574.57        0.00      -71.23       67.46
+ 113601.50     2659.08        0.00      -73.04       68.91
+ 114354.50     2746.23        0.00      -74.85       70.36
+ 115107.50     2836.13        0.00      -76.66       71.80
+ 115859.50     2928.72        0.00      -78.47       73.25
+ 116612.50     3024.33        0.00      -80.29       74.69
+ 117365.50     3136.39        0.00      -82.01       75.93
+ 118118.50     3309.24        0.00      -83.39       76.31
+ 118870.50     3488.11        0.00      -84.77       76.69
+ 119623.50     3673.68        0.00      -86.16       77.06
+ 120376.50     3865.90        0.00      -87.54       77.44
+ 121129.50     4064.98        0.00      -88.92       77.82
+ 121882.50     4271.15        0.00      -90.30       78.19
+ 122634.50     4483.65        0.00      -91.63       78.49
+ 123387.50     4699.28        0.00      -92.69       78.31
+ 124140.50     4921.19        0.00      -93.75       78.13
+ 124893.50     5149.55        0.00      -94.82       77.95
+ 125645.50     5384.20        0.00      -95.88       77.77
+ 126398.50     5625.92        0.00      -96.94       77.59
+ 127151.50     5874.58        0.00      -98.00       77.41
+ 127904.50     6130.34        0.00      -99.07       77.23
+ 128656.50     6393.02        0.00     -100.13       77.05
+ 129409.50     6649.73        0.00     -101.13       76.83
+ 130162.50     6853.02        0.00     -101.87       76.43
+ 130915.50     7060.74        0.00     -102.62       76.03
+ 131667.50     7272.68        0.00     -103.36       75.63
+ 132420.50     7489.50        0.00     -104.11       75.23
+ 133173.50     7711.01        0.00     -104.85       74.82
+ 133926.50     7937.29        0.00     -105.60       74.42
+ 134678.50     8168.13        0.00     -106.34       74.02
+ 135431.50     8404.23        0.00     -107.09       73.62
+ 136184.50     8645.38        0.00     -107.84       73.22
+ 136937.50     8891.68        0.00     -108.58       72.82
+ 137690.50     9143.22        0.00     -109.33       72.42
+ 138442.50     9334.35        0.00     -109.77       72.01
+ 139195.50     9520.31        0.00     -110.17       71.61
+ 139948.50     9709.37        0.00     -110.57       71.21
+ 140701.50     9901.58        0.00     -110.97       70.81
+ 141453.50    10096.72        0.00     -111.37       70.40
+ 142206.50    10295.37        0.00     -111.77       70.00
+ 142959.50    10497.31        0.00     -112.17       69.60
+ 143712.50    10702.60        0.00     -112.57       69.19
+ 144464.50    10911.01        0.00     -112.97       68.79
+ 145217.50    11123.14        0.00     -113.38       68.39
+ 145970.50    11338.77        0.00     -113.78       67.99
+ 146723.50    11557.95        0.00     -114.18       67.58
+ 147475.50    11780.45        0.00     -114.58       67.18
+ 148228.50    11982.78        0.00     -114.88       66.82
+ 148981.50    12153.19        0.00     -115.02       66.51
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_zipbl
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_zipbl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input/input_zipbl	(revision 2744)
@@ -0,0 +1,482 @@
+  0        6.00
+  0        6.03
+  0        6.05
+  0        6.08
+  0        6.11
+  0        6.14
+  0        6.16
+  0        6.19
+  0        6.22
+  0        6.24
+  0        6.27
+  0        6.30
+  0        6.32
+  0        6.35
+  0        6.38
+  0        6.41
+  0        6.43
+  0        6.46
+  0        6.49
+  0        6.51
+  0        6.54
+  0        6.57
+  0        6.59
+  0        6.62
+  0        6.65
+  0        6.68
+  0        6.70
+  0        6.73
+  0        6.76
+  0        6.78
+  0        6.81
+  0        6.84
+  0        6.86
+  0        6.89
+  0        6.92
+  0        6.95
+  0        6.97
+  0        7.00
+  0        7.03
+  0        7.05
+  0        7.08
+  0        7.11
+  0        7.14
+  0        7.16
+  0        7.19
+  0        7.22
+  0        7.24
+  0        7.27
+  0        7.30
+  0        7.32
+  0        7.35
+  0        7.38
+  0        7.41
+  0        7.43
+  0        7.46
+  0        7.49
+  0        7.51
+  0        7.54
+  0        7.57
+  0        7.59
+  0        7.62
+  0        7.65
+  0        7.68
+  0        7.70
+  0        7.73
+  0        7.76
+  0        7.78
+  0        7.81
+  0        7.84
+  0        7.86
+  0        7.89
+  0        7.92
+  0        7.95
+  0        7.97
+  0        8.00
+  0        8.03
+  0        8.05
+  0        8.08
+  0        8.11
+  0        8.14
+  0        8.16
+  0        8.19
+  0        8.22
+  0        8.24
+  0        8.27
+  0        8.30
+  0        8.32
+  0        8.35
+  0        8.38
+  0        8.41
+  0        8.43
+  0        8.46
+  0        8.49
+  0        8.51
+  0        8.54
+  0        8.57
+  0        8.59
+  0        8.62
+  0        8.65
+  0        8.68
+  0        8.70
+  0        8.73
+  0        8.76
+  0        8.78
+  0        8.81
+  0        8.84
+  0        8.86
+  0        8.89
+  0        8.92
+  0        8.95
+  0        8.97
+  19        9.00
+  19        9.03
+  19        9.05
+  20        9.08
+  20        9.11
+  20        9.14
+  21        9.16
+  21        9.19
+  21        9.22
+  22        9.24
+  22        9.27
+  22        9.30
+  23        9.32
+  23        9.35
+  23        9.38
+  24        9.41
+  24        9.43
+  24        9.46
+  25        9.49
+  25        9.51
+  26        9.54
+  26        9.57
+  26        9.59
+  27        9.62
+  27        9.65
+  27        9.68
+  28        9.70
+  28        9.73
+  28        9.76
+  29        9.78
+  29        9.81
+  30        9.84
+  30        9.86
+  31        9.89
+  31        9.92
+  32        9.95
+  32        9.97
+  32       10.00
+  33       10.03
+  33       10.05
+  34       10.08
+  34       10.11
+  34       10.14
+  35       10.16
+  35       10.19
+  36       10.22
+  36       10.24
+  37       10.27
+  37       10.30
+  38       10.32
+  38       10.35
+  39       10.38
+  39       10.41
+  40       10.43
+  40       10.46
+  41       10.49
+  41       10.51
+  42       10.54
+  42       10.57
+  42       10.59
+  43       10.62
+  43       10.65
+  44       10.68
+  44       10.70
+  45       10.73
+  45       10.76
+  46       10.78
+  46       10.81
+  47       10.84
+  47       10.86
+  48       10.89
+  48       10.92
+  48       10.95
+  49       10.97
+  49       11.00
+  49       11.03
+  50       11.05
+  50       11.08
+  51       11.11
+  51       11.14
+  52       11.16
+  53       11.19
+  53       11.22
+  54       11.24
+  55       11.27
+  56       11.30
+  56       11.32
+  57       11.35
+  57       11.38
+  58       11.41
+  58       11.43
+  58       11.46
+  59       11.49
+  59       11.51
+  59       11.54
+  60       11.57
+  60       11.59
+  60       11.62
+  61       11.65
+  61       11.68
+  62       11.70
+  62       11.73
+  63       11.76
+  63       11.78
+  64       11.81
+  64       11.84
+  65       11.86
+  65       11.89
+  66       11.92
+  66       11.95
+  67       11.97
+  68       12.00
+  68       12.03
+  68       12.05
+  69       12.08
+  69       12.11
+  70       12.14
+  70       12.16
+  70       12.19
+  71       12.22
+  71       12.24
+  71       12.27
+  71       12.30
+  72       12.32
+  72       12.35
+  72       12.38
+  73       12.41
+  73       12.43
+  73       12.46
+  74       12.49
+  74       12.51
+  75       12.54
+  75       12.57
+  76       12.59
+  76       12.62
+  76       12.65
+  77       12.68
+  77       12.70
+  78       12.73
+  78       12.76
+  78       12.78
+  79       12.81
+  79       12.84
+  80       12.86
+  80       12.89
+  81       12.92
+  81       12.95
+  81       12.97
+  82       13.00
+  82       13.03
+  82       13.05
+  83       13.08
+  83       13.11
+  83       13.14
+  83       13.16
+  83       13.19
+  83       13.22
+  84       13.24
+  84       13.27
+  84       13.30
+  85       13.32
+  85       13.35
+  85       13.38
+  86       13.41
+  86       13.43
+  87       13.46
+  87       13.49
+  87       13.51
+  88       13.54
+  88       13.57
+  88       13.59
+  89       13.62
+  89       13.65
+  89       13.68
+  90       13.70
+  90       13.73
+  90       13.76
+  91       13.78
+  91       13.81
+  91       13.84
+  91       13.86
+  91       13.89
+  91       13.92
+  91       13.95
+  91       13.97
+  91       14.00
+  92       14.03
+  92       14.05
+  93       14.08
+  93       14.11
+  93       14.14
+  94       14.16
+  94       14.19
+  95       14.22
+  95       14.24
+  95       14.27
+  96       14.30
+  96       14.32
+  96       14.35
+  96       14.38
+  96       14.41
+  96       14.43
+  96       14.46
+  96       14.49
+  97       14.51
+  97       14.54
+  97       14.57
+  97       14.59
+  97       14.62
+  97       14.65
+  97       14.68
+  97       14.70
+  97       14.73
+  98       14.76
+  98       14.78
+  98       14.81
+  98       14.84
+  98       14.86
+  98       14.89
+  98       14.92
+  98       14.95
+  98       14.97
+  98       15.00
+  98       15.03
+  98       15.05
+  98       15.08
+  99       15.11
+  99       15.14
+  99       15.16
+  98       15.19
+  98       15.22
+  98       15.24
+  98       15.27
+  98       15.30
+  98       15.32
+  98       15.35
+  98       15.38
+  98       15.41
+  98       15.43
+  98       15.46
+  98       15.49
+  99       15.51
+  99       15.54
+  99       15.57
+  99       15.59
+  99       15.62
+  99       15.65
+  99       15.68
+  99       15.70
+  99       15.73
+  99       15.76
+  99       15.78
+  99       15.81
+  99       15.84
+  97       15.86
+  93       15.89
+  87       15.92
+  80       15.95
+  71       15.97
+  62       16.00
+  0       16.03
+  0       16.05
+  0       16.08
+  0       16.11
+  0       16.14
+  0       16.16
+  0       16.19
+  0       16.22
+  0       16.24
+  0       16.27
+  0       16.30
+  0       16.32
+  0       16.35
+  0       16.38
+  0       16.41
+  0       16.43
+  0       16.46
+  0       16.49
+  0       16.51
+  0       16.54
+  0       16.57
+  0       16.59
+  0       16.62
+  0       16.65
+  0       16.68
+  0       16.70
+  0       16.73
+  0       16.76
+  0       16.78
+  0       16.81
+  0       16.84
+  0       16.86
+  0       16.89
+  0       16.92
+  0       16.95
+  0       16.97
+  0       17.00
+  0       17.03
+  0       17.05
+  0       17.08
+  0       17.11
+  0       17.14
+  0       17.16
+  0       17.19
+  0       17.22
+  0       17.24
+  0       17.27
+  0       17.30
+  0       17.32
+  0       17.35
+  0       17.38
+  0       17.41
+  0       17.43
+  0       17.46
+  0       17.49
+  0       17.51
+  0       17.54
+  0       17.57
+  0       17.59
+  0       17.62
+  0       17.65
+  0       17.68
+  0       17.70
+  0       17.73
+  0       17.76
+  0       17.78
+  0       17.81
+  0       17.84
+  0       17.86
+  0       17.89
+  0       17.92
+  0       17.95
+  0       17.97
+  0       18.00
+  0       18.03
+  0       18.05
+  0       18.08
+  0       18.11
+  0       18.14
+  0       18.16
+  0       18.19
+  0       18.22
+  0       18.24
+  0       18.27
+  0       18.30
+  0       18.32
+  0       18.35
+  0       18.38
+  0       18.41
+  0       18.43
+  0       18.46
+  0       18.49
+  0       18.51
+  0       18.54
+  0       18.57
+  0       18.59
+  0       18.62
+  0       18.65
+  0       18.68
+  0       18.70
+  0       18.73
+  0       18.76
+  0       18.78
+  0       18.81
+  0       18.84
+  0       18.86
+  0       18.89
+  0       18.92
+  0       18.95
+  0       18.97
+  0       19.00
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input_coord
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input_coord	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input_coord	(revision 2744)
@@ -0,0 +1,6 @@
+35.   lon  
+40.   lat   
+0.    ls 
+12.   lct  
+150.  ztop 
+200.  nz  
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input_more
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input_more	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input_more	(revision 2744)
@@ -0,0 +1,1 @@
+  -1018.50    275.63
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input_sounding
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input_sounding	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/input_sounding	(revision 2744)
@@ -0,0 +1,208 @@
+      6.38      272.84        0.00
+  -1018.50      272.84        0.00        0.00        0.00
+  -1017.50      264.93        0.00        5.12        1.21
+  -1013.50      233.27        0.00        6.90        1.63
+  -1008.50      221.99        0.00        7.48        1.77
+   -998.50      221.15        0.00        8.32        1.97
+   -968.50      220.86        0.00        9.44        2.24
+   -918.50      220.83        0.00       10.27        2.44
+   -818.50      220.77        0.00       11.18        2.66
+    -65.74      220.35        0.00       13.74        3.12
+    687.03      220.15        0.00       15.28        2.71
+   1439.79      220.76        0.00       16.43        2.40
+   2192.56      222.16        0.00       17.27        2.34
+   2945.32      223.55        0.00       18.11        2.29
+   3698.08      225.76        0.00       19.82        2.31
+   4450.85      228.41        0.00       21.99        2.36
+   5203.61      231.10        0.00       24.15        2.41
+   5956.37      233.79        0.00       26.27        2.46
+   6709.14      236.46        0.00       28.23        2.47
+   7461.90      239.16        0.00       30.19        2.49
+   8214.67      241.88        0.00       32.15        2.50
+   8967.43      244.62        0.00       34.11        2.51
+   9720.20      247.37        0.00       35.50        2.68
+  10473.00      250.13        0.00       36.69        2.89
+  11225.70      252.92        0.00       37.87        3.11
+  11978.50      255.73        0.00       39.06        3.33
+  12731.20      258.56        0.00       40.24        3.54
+  13484.00      261.41        0.00       41.43        3.76
+  14236.80      264.62        0.00       41.85        3.95
+  14989.50      267.87        0.00       42.27        4.15
+  15742.30      271.15        0.00       42.69        4.35
+  16495.10      274.47        0.00       43.11        4.54
+  17247.80      277.81        0.00       43.53        4.74
+  18000.60      281.19        0.00       43.95        4.93
+  18753.40      284.74        0.00       44.39        5.15
+  19506.10      288.72        0.00       44.90        5.44
+  20258.90      292.76        0.00       45.40        5.73
+  21011.70      296.85        0.00       45.91        6.02
+  21764.40      300.99        0.00       46.41        6.31
+  22517.20      305.18        0.00       46.92        6.59
+  23269.90      309.42        0.00       47.43        6.88
+  24022.70      313.72        0.00       47.93        7.17
+  24775.50      318.27        0.00       48.32        8.04
+  25528.20      322.92        0.00       48.69        9.01
+  26281.00      327.63        0.00       49.06        9.98
+  27033.80      332.41        0.00       49.43       10.96
+  27786.50      337.25        0.00       49.80       11.93
+  28539.30      342.15        0.00       50.17       12.90
+  29292.10      347.12        0.00       50.54       13.87
+  30044.80      352.12        0.00       50.88       14.87
+  30797.60      356.80        0.00       50.95       16.20
+  31550.30      361.52        0.00       51.03       17.52
+  32303.10      366.28        0.00       51.10       18.85
+  33055.90      371.10        0.00       51.17       20.17
+  33808.60      375.97        0.00       51.24       21.50
+  34561.40      380.88        0.00       51.31       22.83
+  35314.20      385.85        0.00       51.38       24.15
+  36066.90      390.82        0.00       51.45       25.23
+  36819.70      395.60        0.00       51.52       25.18
+  37572.50      400.42        0.00       51.60       25.13
+  38325.20      405.28        0.00       51.67       25.08
+  39078.00      410.16        0.00       51.74       25.02
+  39830.70      415.07        0.00       51.81       24.97
+  40583.50      420.02        0.00       51.88       24.92
+  41336.30      424.99        0.00       51.96       24.87
+  42089.00      430.75        0.00       51.91       23.99
+  42841.80      437.58        0.00       51.72       22.04
+  43594.60      444.51        0.00       51.53       20.10
+  44347.30      451.53        0.00       51.34       18.15
+  45100.10      458.65        0.00       51.15       16.20
+  45852.90      465.86        0.00       50.96       14.25
+  46605.60      473.17        0.00       50.77       12.31
+  47358.40      480.59        0.00       50.58       10.36
+  48111.10      492.92        0.00       49.08        7.72
+  48863.90      505.71        0.00       47.55        5.06
+  49616.70      518.82        0.00       46.01        2.39
+  50369.40      532.26        0.00       44.48       -0.27
+  51122.20      546.04        0.00       42.94       -2.93
+  51875.00      560.16        0.00       41.41       -5.59
+  52627.70      574.64        0.00       39.87       -8.25
+  53380.50      589.51        0.00       37.91      -11.20
+  54133.30      604.80        0.00       35.52      -14.45
+  54886.00      620.45        0.00       33.13      -17.69
+  55638.80      636.51        0.00       30.74      -20.93
+  56391.60      652.95        0.00       28.35      -24.18
+  57144.30      669.81        0.00       25.96      -27.42
+  57897.10      687.09        0.00       23.57      -30.66
+  58649.80      704.79        0.00       21.18      -33.91
+  59402.60      719.79        0.00       18.84      -34.10
+  60155.40      733.98        0.00       16.52      -33.23
+  60908.10      748.45        0.00       14.21      -32.35
+  61660.90      763.21        0.00       11.89      -31.48
+  62413.70      778.26        0.00        9.57      -30.60
+  63166.40      793.60        0.00        7.25      -29.72
+  63919.20      809.25        0.00        4.94      -28.85
+  64672.00      825.21        0.00        2.62      -27.97
+  65424.70      842.16        0.00        0.13      -21.15
+  66177.50      859.64        0.00       -2.41      -12.92
+  66930.20      877.47        0.00       -4.94       -4.68
+  67683.00      895.68        0.00       -7.48        3.55
+  68435.80      914.27        0.00      -10.01       11.78
+  69188.50      933.23        0.00      -12.54       20.01
+  69941.30      952.60        0.00      -15.08       28.25
+  70694.10      972.36        0.00      -17.61       36.48
+  71446.80      988.28        0.00      -18.44       41.99
+  72199.60     1003.64        0.00      -18.95       46.99
+  72952.40     1019.21        0.00      -19.46       52.00
+  73705.10     1035.00        0.00      -19.97       57.00
+  74457.90     1051.01        0.00      -20.48       62.01
+  75210.60     1067.25        0.00      -20.99       67.01
+  75963.40     1083.70        0.00      -21.50       72.01
+  76716.20     1100.39        0.00      -22.01       77.02
+  77468.90     1115.82        0.00      -22.88       78.49
+  78221.70     1131.39        0.00      -23.76       79.92
+  78974.50     1147.11        0.00      -24.64       81.34
+  79727.20     1162.99        0.00      -25.53       82.77
+  80480.00     1179.02        0.00      -26.41       84.20
+  81232.80     1195.21        0.00      -27.29       85.62
+  81985.50     1211.55        0.00      -28.17       87.05
+  82738.30     1230.83        0.00      -28.68       87.64
+  83491.00     1253.55        0.00      -28.76       87.31
+  84243.80     1276.67        0.00      -28.85       86.97
+  84996.60     1300.21        0.00      -28.93       86.64
+  85749.30     1324.16        0.00      -29.02       86.30
+  86502.10     1348.53        0.00      -29.10       85.96
+  87254.90     1373.33        0.00      -29.19       85.63
+  88007.60     1397.47        0.00      -28.44       84.15
+  88760.40     1418.47        0.00      -25.09       79.08
+  89513.20     1439.70        0.00      -21.74       74.01
+  90265.90     1461.15        0.00      -18.38       68.94
+  91018.70     1482.83        0.00      -15.03       63.87
+  91771.40     1504.72        0.00      -11.68       58.80
+  92524.20     1526.84        0.00       -8.32       53.73
+  93277.00     1550.99        0.00       -6.28       49.22
+  94029.70     1580.34        0.00       -7.74       46.18
+  94782.50     1610.21        0.00       -9.20       43.13
+  95535.30     1640.60        0.00      -10.66       40.09
+  96288.00     1671.52        0.00      -12.11       37.05
+  97040.80     1702.98        0.00      -13.57       34.01
+  97793.60     1734.99        0.00      -15.03       30.97
+  98546.30     1770.81        0.00      -17.53       30.51
+  99299.50     1809.75        0.00      -20.77       31.89
+ 100051.50     1849.47        0.00      -24.00       33.26
+ 100804.50     1890.11        0.00      -27.24       34.64
+ 101557.50     1931.63        0.00      -30.48       36.02
+ 102310.50     1974.04        0.00      -33.72       37.40
+ 103062.50     2017.22        0.00      -36.94       38.81
+ 103815.50     2058.20        0.00      -39.74       41.27
+ 104568.50     2099.97        0.00      -42.53       43.73
+ 105321.50     2142.54        0.00      -45.33       46.19
+ 106073.50     2185.86        0.00      -48.12       48.65
+ 106826.50     2230.07        0.00      -50.91       51.11
+ 107579.50     2275.13        0.00      -53.71       53.57
+ 108332.50     2316.71        0.00      -56.35       55.75
+ 109085.50     2355.88        0.00      -58.87       57.74
+ 109837.50     2395.48        0.00      -61.40       59.73
+ 110590.50     2435.59        0.00      -63.92       61.71
+ 111343.50     2476.17        0.00      -66.45       63.70
+ 112096.50     2517.22        0.00      -68.98       65.69
+ 112848.50     2574.57        0.00      -71.23       67.46
+ 113601.50     2659.08        0.00      -73.04       68.91
+ 114354.50     2746.23        0.00      -74.85       70.36
+ 115107.50     2836.13        0.00      -76.66       71.80
+ 115859.50     2928.72        0.00      -78.47       73.25
+ 116612.50     3024.33        0.00      -80.29       74.69
+ 117365.50     3136.39        0.00      -82.01       75.93
+ 118118.50     3309.24        0.00      -83.39       76.31
+ 118870.50     3488.11        0.00      -84.77       76.69
+ 119623.50     3673.68        0.00      -86.16       77.06
+ 120376.50     3865.90        0.00      -87.54       77.44
+ 121129.50     4064.98        0.00      -88.92       77.82
+ 121882.50     4271.15        0.00      -90.30       78.19
+ 122634.50     4483.65        0.00      -91.63       78.49
+ 123387.50     4699.28        0.00      -92.69       78.31
+ 124140.50     4921.19        0.00      -93.75       78.13
+ 124893.50     5149.55        0.00      -94.82       77.95
+ 125645.50     5384.20        0.00      -95.88       77.77
+ 126398.50     5625.92        0.00      -96.94       77.59
+ 127151.50     5874.58        0.00      -98.00       77.41
+ 127904.50     6130.34        0.00      -99.07       77.23
+ 128656.50     6393.02        0.00     -100.13       77.05
+ 129409.50     6649.73        0.00     -101.13       76.83
+ 130162.50     6853.02        0.00     -101.87       76.43
+ 130915.50     7060.74        0.00     -102.62       76.03
+ 131667.50     7272.68        0.00     -103.36       75.63
+ 132420.50     7489.50        0.00     -104.11       75.23
+ 133173.50     7711.01        0.00     -104.85       74.82
+ 133926.50     7937.29        0.00     -105.60       74.42
+ 134678.50     8168.13        0.00     -106.34       74.02
+ 135431.50     8404.23        0.00     -107.09       73.62
+ 136184.50     8645.38        0.00     -107.84       73.22
+ 136937.50     8891.68        0.00     -108.58       72.82
+ 137690.50     9143.22        0.00     -109.33       72.42
+ 138442.50     9334.35        0.00     -109.77       72.01
+ 139195.50     9520.31        0.00     -110.17       71.61
+ 139948.50     9709.37        0.00     -110.57       71.21
+ 140701.50     9901.58        0.00     -110.97       70.81
+ 141453.50    10096.72        0.00     -111.37       70.40
+ 142206.50    10295.37        0.00     -111.77       70.00
+ 142959.50    10497.31        0.00     -112.17       69.60
+ 143712.50    10702.60        0.00     -112.57       69.19
+ 144464.50    10911.01        0.00     -112.97       68.79
+ 145217.50    11123.14        0.00     -113.38       68.39
+ 145970.50    11338.77        0.00     -113.78       67.99
+ 146723.50    11557.95        0.00     -114.18       67.58
+ 147475.50    11780.45        0.00     -114.58       67.18
+ 148228.50    11982.78        0.00     -114.88       66.82
+ 148981.50    12153.19        0.00     -115.02       66.51
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/launch
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/launch	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/launch	(revision 2744)
@@ -0,0 +1,10 @@
+#! /bin/bash
+
+nproc=4
+
+ideal.exe
+mv rsl.out.0000 ideal_rsl.out.0000
+
+\rm rsl.*
+\rm wrfout*
+mpirun -np $nproc wrf.exe < /dev/null &
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/namelist.input
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/namelist.input	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/LES/namelist.input	(revision 2744)
@@ -0,0 +1,128 @@
+ &time_control
+ run_days                            = 0,
+ run_hours                           = 1,
+ run_minutes                         = 00,
+ run_seconds                         = 00,
+ start_year                          = 2024, 0001, 0001,
+ start_month                         = 01,   01,   01,
+ start_day                           = 01,   01,   01,
+ start_hour                          = 12,   01,   00,
+ start_minute                        = 00,   30,   00,
+ start_second                        = 00,   00,   00,
+ end_year                            = 2024, 0001, 0001,
+ end_month                           = 01,   01,   01,
+ end_day                             = 01,   01,   01,
+ end_hour                            = 13,   02,   00,
+ end_minute                          = 00,   30,   00,
+ end_second                          = 00,   00,   00,
+ history_interval_m                  = 00,   10,   1,
+ history_interval_s                  = 37,   00,   1,
+ frames_per_outfile                  = 100, 1000, 1000,
+ restart                             = .false.,
+ restart_interval_m                  = 60,
+ io_form_history                     = 2
+ io_form_restart                     = 2
+ io_form_input                       = 2
+ io_form_boundary                    = 2
+ debug_level                         = 0
+ /
+
+ &domains
+ time_step                           = 0,
+ time_step_fract_num                 = 1,
+ time_step_fract_den                 = 2,
+ max_dom                             = 1,
+ s_we                                = 1,     1,     1,
+ e_we                                = 153,   100,    151,
+ s_sn                                = 1,     1,     1,
+ e_sn                                = 153,   100,    151,
+ s_vert                              = 1,     1,     1,
+ e_vert                              = 71,   100,    41,
+ dx                                  = 100,   50,    16.6667, 
+ dy                                  = 100,   50,    16.6667, 
+ ztop                                = 11000,  2000,  2000,
+ grid_id                             = 1,     2,     3,
+ parent_id                           = 0,     1,     2,
+ i_parent_start                      = 0,     10,    15,
+ j_parent_start                      = 0,     10,    15,
+ parent_grid_ratio                   = 1,     3,     3,
+ parent_time_step_ratio              = 1,     3,     3,
+ feedback                            = 0,
+ smooth_option                       = 0
+ /
+
+ &physics
+ mp_physics                          = 0,     0,     0,
+ ra_lw_physics                       = 0,     0,     0,
+ ra_sw_physics                       = 0,     0,     0,
+ radt                                = 148,   0,     0,
+ sf_sfclay_physics                   = 0,     1,     1,
+ sf_surface_physics                  = 0,     0,     0,
+ bl_pbl_physics                      = 0,     0,     0,
+ bldt                                = 0,     0,     0,
+ cu_physics                          = 0,     0,     0,
+ cudt                                = 0,     0,     0,
+ isfflx                              = 2,
+ ifsnow                              = 0,
+ icloud                              = 0,
+ num_soil_layers                     = 5,
+ mp_zero_out                         = 0,
+ !!!
+ init_TI = 100.,             !! Define constant thermal inertia value
+ init_AL = 0.27,             !! Define constant albedo value
+ num_soil_layers = 10.
+ /
+
+ &fdda
+ /
+
+ &dynamics
+ rk_ord                              = 3,
+ diff_opt                            = 2,
+ km_opt                              = 2,
+ damp_opt                            = 0,
+ zdamp                               = 15000.,  5000.,  5000.,
+ dampcoef                            = 0.1,    0.2,    0.2
+! khdif                               = 1.,      1.,    .05,
+! kvdif                               = 1.,      1.,    .05,
+ c_s                                 = 0.18
+ c_k                                 = 0.10
+! mix_isotropic                       = 1
+ smdiv                               = 0.1,    0.1,    0.1,
+ emdiv                               = 0.01,   0.01,   0.01,
+ epssm                               = 0.1,    0.1,    0.1
+! tke_heat_flux                       = 0.24,   0.24,   0.24,
+ time_step_sound                     = 6,      6,      6,
+ h_mom_adv_order                     = 5,      5,      5,
+ v_mom_adv_order                     = 3,      3,      3,
+ h_sca_adv_order                     = 5,      5,      5,
+ v_sca_adv_order                     = 3,      3,      3,
+! mix_full_fields                     = .true., .true., .true.,
+ non_hydrostatic                     = .true., .true., .true.,
+! pert_coriolis                       = .true., .true., .true.,
+! base_pres = 610.
+! base_temp = 220.
+! base_lapse = 30.
+ /
+
+ &bdy_control
+ periodic_x                          = .true., .false.,.false.,
+ symmetric_xs                        = .false.,.false.,.false.,
+ symmetric_xe                        = .false.,.false.,.false.,
+ open_xs                             = .false.,.false.,.false.,
+ open_xe                             = .false.,.false.,.false.,
+ periodic_y                          = .true., .false.,.false.,
+ symmetric_ys                        = .false.,.false.,.false.,
+ symmetric_ye                        = .false.,.false.,.false.,
+ open_ys                             = .false.,.false.,.false.,
+ open_ye                             = .false.,.false.,.false.,
+ nested                              = .false., .true., .true.,
+ /
+
+ &grib2
+ /
+
+ &namelist_quilt
+ nio_tasks_per_group = 0,
+ nio_groups = 1,
+ /
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/README.les
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/README.les	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/README.les	(revision 2744)
@@ -0,0 +1,42 @@
+The ideal em_les test case:
+
+This test case produces a large-eddy simulation (LES) of a free
+convective boundary layer (CBL).  The environmental wind (or
+the initial wind profile) is set to zero in this default case.  
+The turbulence of the free CBL is driven/maintained by the surface 
+heat flux, which is specified in the namelist as tke_heat_flux=0.24 
+(in MKS units).
+
+A random perturbation is imposed initially on the mean temperature 
+field at the lowest four grid levels to kick off the
+turbulent motion. Double periodic boundary condition
+is used in x and y.
+
+The default version uses a grid resolution of
+dx=dy=100m and dz=50m, which is considered to be rather coarse 
+for an LES of the CBL.  A typical grid mesh for an LES
+of the CBL is dx=dy=50m and dz=20m.  An LES flow field is more
+accurate when the grid resolution is finer because it resolves
+more turbulent scales.  
+
+This LES version uses the Deardorff's TKE scheme to compute the SGS
+eddy viscosity and eddy diffusivity for turbulent mixing, that is
+diff_opt=2 and km_opt = 2 in the namelist.  The Coriolis parameter
+is set to f = 10^-4/s.
+
+It takes at least 30 minutes of simulation time to spin up the
+turbulent flow field; only after the spin-up, the turbulence inside
+the CBL is considered well established.  A sign of well-established
+turbulence is that the total (i.e., the resolved-scale plus the
+subgrid-scale) heat flux profile should decrease linearly with height
+within the CBL.
+
+To simulate a CBL with a mean wind, change the initial wind
+profile in the input sounding.   
+When pert_coriolis= true is set in the namelist, there is no need to 
+include the geostrophic wind terms in the right-hand sides of
+the u and v equations for LESs with non-zero geostrophic wind. 
+
+Note, parameterization constants, c_s and c_k in this namelist are
+different from the defaults and are the ones recommended to use with LES.
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/Registry.EM_example
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/Registry.EM_example	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/Registry.EM_example	(revision 2744)
@@ -0,0 +1,1507 @@
+## WARNING: this file is autogenerated from Registry/Registry.EM. Changes may be lost
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWN    ij   misc  1  -  rhd  "SWDOWN"    "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWN    ij   misc  1  -  rhd  "LWDOWN"    "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rhd  "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rhd  "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rd   "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rd   "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rd   "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                         -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+state  real  QDUST     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUST"      "Dust mixing ratio"          "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+################################################################################
+################################################################################
+################################################################################
+
+
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     ir01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+#state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+#state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+#state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+#state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+#state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg" 
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+####
+#### variables dans wrf
+####
+state  real   albedo_gcm      ij   misc  1  -  i012rd  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012rd  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012rd  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012rd  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012rd  "MARS_CICE"   "co2 ice"                 "kg"
+state  real   mars_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"  "soil temperatures"       "K"
+state  real   mars_gw        ilj   misc  1  -  i012rd  "MARS_GW"     "gwparam"                 " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irdus  "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#                                               
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irdus        "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      r         "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rdus      "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+#
+# sortie desactivée
+# 
+state    real   sr             ij      dyn_em      1         -      ir         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -                 "potevp" "whatever"
+state    real   snopcx         ij      dyn_em      1         -                 "snopcx" "whatever"
+state    real   soiltb         ij      dyn_em      1         -      ir         "soiltb" "whatever"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATET T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+#
+# UN BON EXEMPLE: irhd et i01rh
+#
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     ird      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     ird      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     ird      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rh     "PSFC"                 "SFC PRESSURE"      "Pa"
+
+#
+# ICI irh01d
+#
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     ir01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     ir01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -     ir          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -     ir          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -     ir          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#      
+#-----------------------------
+# afin d eviter les mic macs terrestres, ceux là ne sont pas a utiliser
+# reglés a zero 
+#-----------------------------                                         
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars: see also above
+state   real    qni             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg(-1)"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i12     "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i12     "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i1      "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+#
+# sortie desactivé, mais peut servir pour le modèle de sol
+#
+state    real   SMOIS            ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i012rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICE"             "SEA ICE FLAG"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0125rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      r                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+#
+# ici sortie désactivée
+#
+state    real   SNOW             ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i01rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0125rd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+i1      real   TSHLTR           ij     misc        1         -     -         "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"         
+i1      real   QSHLTR           ij     misc        1         -     -         "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+i1      real   PSHLTR           ij     misc        1         -     -         "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+i1      real   TH10             ij     misc        1         -     -         "TH10"                  "10-M THETA FROM MYJ"                          "K"        
+i1      real   Q10              ij     misc        1         -     -         "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+# Other Misc State Variables
+
+                                            
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+
+#
+# h is removed from TSK, parce que la temperature de surface dans TSK n'est pas modifiee 
+#
+state   real    TSK            ij      misc         1         -     i012rdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+
+state   real    h_diabatic     ikj     misc         1         -      r        "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         ""      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    lat_ll_t       -       dyn_em       -         -     irh       "lat_ll_t"              "latitude lower left, temp point" "degrees"
+state   real    lat_ul_t       -       dyn_em       -         -     irh       "lat_ul_t"              "latitude up left, temp point" "degrees"
+state   real    lat_ur_t       -       dyn_em       -         -     irh       "lat_ur_t"              "latitude up right, temp point" "degrees"
+state   real    lat_lr_t       -       dyn_em       -         -     irh       "lat_lr_t"              "latitude lower right, temp point" "degrees"
+state   real    lat_ll_u       -       dyn_em       -         -     irh       "lat_ll_u"              "latitude lower left, u point" "degrees"
+state   real    lat_ul_u       -       dyn_em       -         -     irh       "lat_ul_u"              "latitude up left, u point" "degrees"
+state   real    lat_ur_u       -       dyn_em       -         -     irh       "lat_ur_u"              "latitude up right, u point" "degrees"
+state   real    lat_lr_u       -       dyn_em       -         -     irh       "lat_lr_u"              "latitude lower right, u point" "degrees"
+state   real    lat_ll_v       -       dyn_em       -         -     irh       "lat_ll_v"              "latitude lower left, v point" "degrees"
+state   real    lat_ul_v       -       dyn_em       -         -     irh       "lat_ul_v"              "latitude up left, v point" "degrees"
+state   real    lat_ur_v       -       dyn_em       -         -     irh       "lat_ur_v"              "latitude up right, v point" "degrees"
+state   real    lat_lr_v       -       dyn_em       -         -     irh       "lat_lr_v"              "latitude lower right, v point" "degrees"
+state   real    lat_ll_d       -       dyn_em       -         -     irh       "lat_ll_d"              "latitude lower left, massless point" "degrees"
+state   real    lat_ul_d       -       dyn_em       -         -     irh       "lat_ul_d"              "latitude up left, massless point" "degrees"
+state   real    lat_ur_d       -       dyn_em       -         -     irh       "lat_ur_d"              "latitude up right, massless point" "degrees"
+state   real    lat_lr_d       -       dyn_em       -         -     irh       "lat_lr_d"              "latitude lower right, massless point" "degrees"
+state   real    lon_ll_t       -       dyn_em       -         -     irh       "lon_ll_t"              "longitude lower left, temp point" "degrees"
+state   real    lon_ul_t       -       dyn_em       -         -     irh       "lon_ul_t"              "longitude up left, temp point" "degrees"
+state   real    lon_ur_t       -       dyn_em       -         -     irh       "lon_ur_t"              "longitude up right, temp point" "degrees"
+state   real    lon_lr_t       -       dyn_em       -         -     irh       "lon_lr_t"              "longitude lower right, temp point" "degrees"
+state   real    lon_ll_u       -       dyn_em       -         -     irh       "lon_ll_u"              "longitude lower left, u point" "degrees"
+state   real    lon_ul_u       -       dyn_em       -         -     irh       "lon_ul_u"              "longitude up left, u point" "degrees"
+state   real    lon_ur_u       -       dyn_em       -         -     irh       "lon_ur_u"              "longitude up right, u point" "degrees"
+state   real    lon_lr_u       -       dyn_em       -         -     irh       "lon_lr_u"              "longitude lower right, u point" "degrees"
+state   real    lon_ll_v       -       dyn_em       -         -     irh       "lon_ll_v"              "longitude lower left, v point" "degrees"
+state   real    lon_ul_v       -       dyn_em       -         -     irh       "lon_ul_v"              "longitude up left, v point" "degrees"
+state   real    lon_ur_v       -       dyn_em       -         -     irh       "lon_ur_v"              "longitude up right, v point" "degrees"
+state   real    lon_lr_v       -       dyn_em       -         -     irh       "lon_lr_v"              "longitude lower right, v point" "degrees"
+state   real    lon_ll_d       -       dyn_em       -         -     irh       "lon_ll_d"              "longitude lower left, massless point" "degrees"
+state   real    lon_ul_d       -       dyn_em       -         -     irh       "lon_ul_d"              "longitude up left, massless point" "degrees"
+state   real    lon_ur_d       -       dyn_em       -         -     irh       "lon_ur_d"              "longitude up right, massless point" "degrees"
+state   real    lon_lr_d       -       dyn_em       -         -     irh       "lon_lr_d"              "longitude lower right, massless point" "degrees"
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+#
+# Variables 2D ne servent pas - peuvent servir pour la microphysique Mars
+# rajouter 'h' si l'on veut des sorties
+#
+state    real  RAINC            ij      misc        1         -      rdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  RAINCV           ij      misc        1         -      r        "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc         1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc         1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc         1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc         1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc         1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc         1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc         1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc         1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"  
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"  "mb hour-1" 
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "COUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "Pa K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "COUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "Pa K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+state    real  GLW              ij      misc        1         -      rd       "GLW"                   "DOWNWARD LONG  WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      r         "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      r           "ALBEDO"                   "ALBEDO"
+state    real  ALBBCK           ij      misc        1         -     i012r        "ALBBCK"                   "BACKGROUND ALBEDO"        ""
+state    real  EMISS            ij      misc        1         -      r        "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  UST              ij      misc        1         -      r        "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -     r        "RMOL"                   "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      r        "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      r        "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      r        "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      r        "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+i1       real  REGIME           ij      misc        1         -                                          
+state    real  SNOWC            ij      misc        1         -     ird=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkmhd           ikj      misc        1         -     r         "xkmhd"                 "HORIZONTAL EDDY DIFFUSIVITY" "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1999    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      09    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      09    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      09    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1999    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      09    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      09    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      19    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1              3700    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .true.  irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 5, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    101     irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    101     irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    51      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              26      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              2       irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"      ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              8       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              0       irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .true.  irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   real    dx                      namelist,domains      max_domains   5000     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains   5000     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    0       rh    "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    0       rh    "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    0       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    0       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    35000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1500.
+
+# Physics
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.   ir   "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    1       h    "RADT"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    100000   h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      1            0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   integer co2tf                   namelist,physics	1            0         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback             namelist.physics      max_domains   .false.  -     "feedback cumulus to radiation"
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   integer     nobs_ndg_vars       namelist,fdda            1              0       h        "num_ndg_vars"      "Number of nudging variables"          ""
+rconfig   integer     nobs_err_flds       namelist,fdda            1              0       h        "num_err_flds"      "Number of error fields"               ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            1              0       h        "obs_twindo"        "Half-period time window for nudging"  "min"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            1              0       h        "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   "min"
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   "min"
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   "min"
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer dyn_opt                 namelist,dynamics	1             2       irh   "dyn_opt"               ""      ""
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh   "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh   "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             4       irh   "km_opt"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh   "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.05    h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.2     h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    2      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    0.1     h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh   "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    6       h    "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+#rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .true.  rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics     max_domains    .false. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   real    mix_cr_len              namelist,dynamics	max_domains    200.    h    "mix_cr_len"            ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    kh_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kh_tke_upper_bound"         ""      ""
+rconfig   real    kv_tke_upper_bound      namelist,dynamics	max_domains    1000.   h    "kv_tke_upper_bound"         ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1             610.     h    "base_pres"  "Mars Base state pressure, real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             220.     h    "base_temp"  "Mars Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              30.     h    "base_lapse" "Mars Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .true.  rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none, 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer simulation_start_year   derived                  1              0       -        "simulation_start_year" "start of simulation through restarts" "4-digit year"
+rconfig   integer simulation_start_month  derived                  1              0       -        "simulation_start_month" "start of simulation through restarts" "2-digit month"
+rconfig   integer simulation_start_day    derived                  1              0       -        "simulation_start_day" "start of simulation through restarts" "2-digit day"
+rconfig   integer simulation_start_hour   derived                  1              0       -        "simulation_start_hour" "start of simulation through restarts" "2-digit hour"
+rconfig   integer simulation_start_minute derived                  1              0       -        "simulation_start_minute" "start of simulation through restarts" "2-digit minute"
+rconfig   integer simulation_start_second derived                  1              0       -        "simulation_start_second" "start of simulation through restarts" "2-digit second"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+package   dyn_nodyn    dyn_opt==0                   -             -
+package   dyn_em       dyn_opt==2                   -             -
+#package   passivec1     chem_opt==0                  -             
+
+
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+##
+## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF
+## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION
+## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION 
+## -------
+## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE
+## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS
+## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...)
+## -------
+##
+##
+package   nowater      mars==0                      -              moist:qv
+package   water        mars==1                      -              moist:qv;scalar:qh2o,qh2o_ice
+package   dust         mars==2                      -              moist:qv;scalar:qdust 
+##### MARS OPTIONS
+##### MARS OPTIONS
+##### MARS OPTIONS
+
+
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   ncepcloud3    mp_physics==98               -             moist:qv,qc,qr
+package   ncepcloud5    mp_physics==99               -             moist:qv,qc,qr,qi,qs
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             -
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   ysuscheme      bl_pbl_physics==1           -             -
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   mrfscheme      bl_pbl_physics==99          -             -
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msft,msfu,msfv,f,e,sina,cosa,ht,potevp,snopcx,soiltb
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkmhd,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkmhd,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msft,msfu,msfv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmhd,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfv,muu,msfu
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer domain_init  # domain initialization flag
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    DS_CG        # coarse domain grid size 
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    XN           # cone factor for Lambert projection
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+##
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/Registry.EM_prev
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/Registry.EM_prev	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/Registry.EM_prev	(revision 2744)
@@ -0,0 +1,1728 @@
+# Registry file, EM
+#                                               
+# At the present time this file is managed manually and edited by hand.                                         
+#                                               
+################################################################################
+# Dimension specifications
+#
+# This section of the Registry file is used to specify the dimensions
+# that will be used to define arrays. Dim is the one-letter name of the
+# dimension.  How defined can either be "standard_domain", which means
+# that the dimension (1) is one of the three spatial dimensions and (2)
+# it will be set using the standard namelist mechanism and domain data
+# structure dimension fields (e.g. sd31,ed31,sd32...).
+#
+# Order refers to which of the three sets of just-mentioned internal
+# dimension variables the dimension is referred to by in the driver.
+# That is, is it the first, second, or third dimension.  The registry
+# infers the mapping of its internal dimensions according to the
+# combination of Order and Coord-axis that are specified in this table.
+# Note that it is all right to more than one dimension name for, say, the
+# x dimension.  However, the Order and Coord-axis relationship must be
+# consistent throughout.
+# 
+# Note: these entries do not enforce storage order on a particular field.
+# That is determined by the dimension strings for each field. But it does
+# relate the dimspec to the internal data structures that the driver uses
+# to maintain the three physical domain dimensions.
+# 
+# "How defined" can also specify the name of a namelist variable from which
+# the definition for the dimension will come; this is specified as
+# "namelist=<variable name>".  The namelist variable must have been
+# defined as an integer and with only one entry in the rconfig table. Or
+# a constant can be specified.  The coordinate axis for the dimension is
+# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
+# the descriptive name of the dimension that will be included in the
+# metadata in data sets.  Note that the b, f, and t modifiers that appear
+# as the last characters of dimension strings used # in state and # i1
+# registry definitions are not dimensions and do not need to be declared
+# here.
+#
+
+# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
+
+#<Table>  <Dim>  <Order> <How defined>         <Coord-axis>  <Dimname in Datasets>
+dimspec    i      1     standard_domain              x          west_east
+dimspec    j      3     standard_domain              y          south_north
+dimspec    k      2     standard_domain              z          bottom_top
+dimspec    l      2     namelist=num_soil_layers     z          soil_layers
+dimspec    u      2     namelist=num_land_cat        z          land_cat
+dimspec    s      2     namelist=num_soil_cat        z          soil_cat
+dimspec    p      -     constant=7501                c          microphysics_rstrt_state
+dimspec    w      -     namelist=spec_bdy_width      c          spec_bdy_width
+dimspec    e      3     namelist=ensdim              z          ensemble dimension
+dimspec    n      1     namelist=dfi_time_dim        c          dfi time dimension
+dimspec    z      -     namelist=max_obs          c          max_obs
+dimspec    h      -     namelist=nobs_err_flds    c          nobs_err_flds
+dimspec    r      -     namelist=nobs_ndg_vars    c          nobs_ndg_vars
+dimspec    g      2     namelist=num_metgrid_levels  z          num_metgrid_levels
+dimspec    m      2     constant=12                  z          months_per_year
+dimspec    a      -     namelist=cam_abs_dim1     c          cam_abs_dim1
+dimspec    c      -     namelist=cam_abs_dim2     z          cam_abs_dim2
+dimspec    q      2     namelist=levsiz           z          levsiz
+dimspec    d      2     namelist=paerlev          z          paerlev
+dimspec    ?      -     namelist=ts_buf_size      c          ts_buf_size
+dimspec    !      -     namelist=max_ts_locs      c          max_ts_locs
+dimspec    v      -     constant=1                z          one
+
+
+################################################################################
+################################################################################
+################################################################################
+
+###MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+#### 
+#### variables physiques ecrites dans les fichiers WRF
+#### - h indique l'ecriture
+#### - en commentaire, les variables physiques dans physiq.F
+#### - utiliser le script automatique Registry.bash
+####
+#### YOU CAN OUTPUT ANY 2D OR 3D VARIABLE THAT IS AVAILABLE IN MESO_PHYSIQ.F
+####
+state  real  TSURF     ij   misc  1  -  rhd  "TSURF"     "SURF TEMPERATURE"                "K"       #SAVEMARS2 tsurf
+state  real  CO2ICE    ij   misc  1  -  rd   "CO2ICE"    "CO2 GROUND ICE"                  "kg"      #SAVEMARS2 co2ice
+state  real  EMISSIV   ij   misc  1  -  rd   "EMISSIV"   "EMISSIVITY"                      ""        #SAVEMARS2 emis
+state  real  THETA     ij   misc  1  -  rd   "THETA"     "SLOPE INCLINATION"               "deg"     #SAVEMARS2 theta_sl
+state  real  PSI       ij   misc  1  -  rd   "PSI"       "SLOPE ORIENTATION"               "deg"     #SAVEMARS2 psi_sl
+state  real  TAU_DUST  ij   misc  1  -  rhd  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""        #SAVEMARS2 tauref
+state  real  SWDOWN    ij   misc  1  -  rhd  "SWDOWN"    "DOWNWARD SW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_sw_tot      
+state  real  LWDOWN    ij   misc  1  -  rhd  "LWDOWN"    "DOWNWARD LW FLUX AT SURFACE"     "W m-2"   #SAVEMARS2 fluxsurf_lw
+state  real  SWUP      ij   misc  1  -  rhd  "SWUP"      "UPWARD SW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_sw_tot    
+state  real  LWUP      ij   misc  1  -  rhd  "LWUP"      "UPWARD LW FLUX AT TOP"           "W m-2"   #SAVEMARS2 fluxtop_lw
+state  real  MTOT      ij   misc  1  -  rd   "MTOT"      "TOTAL MASS WATER VAPOR"          "kg m-2"  #SAVEMARS2 mtot
+state  real  ICETOT    ij   misc  1  -  rd   "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"  #SAVEMARS2 icetot
+state  real  RAVE      ij   misc  1  -  rd   "RAVE"      "MEAN ICE RADIUS"                 "m"       #SAVEMARS2 rave
+state  real  RICE      ikj  misc  1  -  rd   "RICE"      "ICE RADIUS"                      "m"       #SAVEMARS3 rice
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+####
+####
+#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?)
+#### - effacer le h si l'on veut eviter les sorties
+####
+state  real  -         ikjftb  scalar  1  -  -                         -
+state  real  QH2O      ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O"       "Water vapor mixing ratio"   "kg kg-1"
+state  real  QH2O_ICE  ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QH2O_ICE"   "Water ice mixing ratio"     "kg kg-1"
+state  real  QDUST     ikjftb  scalar  1  -  i01rhusdf=(bdy_interp:dt) "QDUST"      "Dust mixing ratio"          "kg kg-1"
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+
+#state    real   floob       ikjb     dyn_em      1         -    
+#state    real   floob_x     ikjx     dyn_em      1         -     
+#state    real   floob_y     ikjy     dyn_em      1         - 
+#xpose FLOOB dyn_em floob,floob_x,floob_y
+
+#state real xxx ijk misc 2 - h6ud
+#halo  HALO_FLOOB dyn_em  4:xxx_2
+
+# Lines that start with the word 'state' form a table that is                                           
+# used by the script use_registry to generate module_state_descript.F                                           
+# and other files.  Also see documentation in use_registry.                                             
+#                                               
+# table entries are of the form                                         
+#<Table> <Type> <Sym>         <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>   
+#
+
+# It is required that LU_INDEX appears before any variable that is
+# interpolated with a mask, as lu_index supplies that mask.
+# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  LU_INDEX         ij      misc        1         -     i02rh01d=(interp_fcnm)u=(copy_fcnm)   "LU_INDEX"              "LAND USE CATEGORY"         ""
+state    real  LU_MASK          ij      misc        1         -     i3h1     "LU_MASK"              "0 land 1 water"         ""
+
+# znw, znu, dzs, and zs must be listed before any 3-d fields
+# in order for the grib output module to work correctly.  The grib output
+# module retrieves the vertical levels from these parameters.  If znw, znu
+# dzs, and zs are not listed first, vertical level will not be encoded at 
+# time 0.
+
+state    real    znu            k       dyn_em      1         -     irh       "znu"  "eta values on half (mass) levels"  ""
+state    real    znw            k       dyn_em      1         Z     i01rh     "znw"  "eta values on full (w) levels"  ""
+state    real   ZS              l        misc      -         Z     irh       "ZS"                    "DEPTHS OF CENTERS OF SOIL LAYERS"         "m"
+state    real   DZS             l        misc      -         Z     irh       "DZS"                   "THICKNESSES OF SOIL LAYERS"               "m"
+
+#
+# Variables from WPS
+#
+state    real   u_gc           igj      dyn_em      1        XZ    i1  "UU"     "x-wind component"    "m s-1"
+state    real   v_gc           igj      dyn_em      1        YZ    i1  "VV"     "y-wind component"    "m s-1"
+state    real   t_gc           igj      dyn_em      1        Z     i1  "TT"     "temperature"         "K"
+state    real   rh_gc          igj      dyn_em      1        Z     i1  "RH"    "relative humidity"   "%"
+state    real   ght_gc         igj      dyn_em      1        Z     i1  "GHT"   "geopotential height" "m"
+state    real   p_gc           igj      dyn_em      1        Z     i1  "PRES"   "pressure"            "Pa"
+state    real   xlat_gc        ij       dyn_em      1        -     i1  "XLAT_M" "latitude, positive north" "degrees"
+state    real   xlong_gc       ij       dyn_em      1        -     i1  "XLONG_M" "longitude, positive east" "degrees"
+state    real   ht_gc          ij       dyn_em      1        -     i1  "HGT_M" "topography elevation" "m"
+state    real   tsk_gc         ij       dyn_em      1        -     i1  "SKINTEMP"  "skin temperature"  "K"
+state    real   tavgsfc        ij       dyn_em      1        -     i1  "TAVGSFC"  "daily mean of surface air temperature"  "K"
+state    real   tmn_gc         ij       dyn_em      1        -     i1  "SOILTEMP"  "annual mean deep soil temperature"  "K"
+state    real   pslv_gc        ij       dyn_em      1        -     i1  "PMSL"  "sea level pressure"  "Pa"
+state    real   greenfrac      imj      dyn_em      1        Z     i1  "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction"
+state    real   albedo12m      imj      dyn_em      1        Z     i1  "ALBEDO12M" "background albedo" "0 - 1 fraction"
+state    real   pd_gc          igj      dyn_em      1        Z     -   "PD"    "dry pressure"        "Pa"
+state    real   psfc_gc        ij       dyn_em      1        -      -  "PSFC_GC"     "surface pressure"            "Pa"
+state    real   intq_gc        ij       dyn_em      1        -     -   "INTQ"  "integrated mixing ratio" "Pa"
+state    real   pdhs           ij       dyn_em      1        -     -   "PDHS"  "hydrostatic dry surface pressure" "Pa"
+state    real   qv_gc          igj      dyn_em      1        Z     i1  "QV"     "mixing ratio"        "kg kg-1"
+ifdef RUC_CLOUD
+state    real   qr_gc          igj      dyn_em      1        Z     i1  "QR"    "rain water mixing ratio"   "kg kg-1"
+state    real   qc_gc          igj      dyn_em      1        Z     i1  "QC"    "cloud water mixing ratio"   "kg kg-1"
+state    real   qs_gc          igj      dyn_em      1        Z     i1  "QS"    "snow mixing ratio"   "kg kg-1"
+state    real   qi_gc          igj      dyn_em      1        Z     i1  "QI"    "cloud ice mixing ratio"   "kg kg-1"
+state    real   qg_gc          igj      dyn_em      1        Z     i1  "QG"    "graupel mixing ratio"   "kg kg-1"
+state    real   qni_gc         igj      dyn_em      1        Z     i1  "QNI"   "ice no concentration"   "m-3"
+endif
+
+
+###MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS     
+####
+#### INITIALISATION
+####
+#### variables dans real
+####
+state  real   albedo_gcm_gc   ij   dyn_em  1  -  i1  "ALBEDO_GCM"       "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert_gc  ij   dyn_em  1  -  i1  "THERMAL_INERTIA"  "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx_gc         ij   dyn_em  1  -  i1  "SLPX"             "slope x direction"       "rad"
+state  real   slpy_gc         ij   dyn_em  1  -  i1  "SLPY"             "slope y direction"       "rad"
+state  real   hv_gc          igj   dyn_em  1  Z  i1  "HV"               "water vapor"             "kg/kg"
+state  real   hi_gc          igj   dyn_em  1  Z  i1  "HI"               "water ice"               "kg/kg"
+state  real   tsoil_gc       igj   dyn_em  1  Z  i1  "TSOIL"            "soil temperatures"       "K"
+####
+#### variables dans wrf
+####
+state  real   albedo_gcm      ij   misc  1  -  i012rd  "MARS_ALB"    "albedo of naked ground"  "0 - 1 fraction"
+state  real   therm_inert     ij   misc  1  -  i012rd  "MARS_TI"     "thermal inertia"         "J/m2/K/s0.5"
+state  real   slpx            ij   misc  1  -  i012rd  "SLOPEX"      "slope x direction"       "rad"
+state  real   slpy            ij   misc  1  -  i012rd  "SLOPEY"      "slope y direction"       "rad"
+state  real   mars_emiss      ij   misc  1  -  i012rd  "MARS_EMISS"  "emissivity"              "0 - 1 fraction"
+state  real   mars_cice       ij   misc  1  -  i012rd  "MARS_CICE"   "co2 ice"                 "kg"
+state  real   mars_tsoil     ilj   misc  1  -  i012rd  "MARS_TSOIL"  "soil temperatures"       "K"
+state  real   mars_gw        ilj   misc  1  -  i012rd  "MARS_GW"     "gwparam"                 " "
+####
+####
+####MARS MARS MARS MARS MARS
+####MARS MARS MARS MARS MARS
+
+
+
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+# Variables for Eulerian mass coordinate dynamics                                            
+#                                               
+
+
+# Velocities
+#
+# U Vel
+state    real   u              ikjb     dyn_em      2         X     \
+     i01rhusdf=(bdy_interp:dt)       "U"                      "x-wind component"   "m s-1"
+state    real   ru             ikj     dyn_em      1         X      -        "MU_U"        "mu-coupled u"   "Pa m s-1"
+state    real   ru_m           ikj     dyn_em      1         X      -        "ru_m"        ""   ""
+state    real   ru_tend        ikj     dyn_em      1         X      -        "ru_tend"        ""   ""                                   
+i1       real   ru_tendf       ikj     dyn_em      1         X                                          
+state    real   u_save         ikj     dyn_em      1         X      -        "u_save"
+#                                               
+# V Vel
+state    real   v              ikjb     dyn_em      2         Y     \
+     i01rhusdf=(bdy_interp:dt)        "V"                     "y-wind component"   "m s-1"
+state    real   rv             ikj     dyn_em      1         Y      -        "MU_V"        "mu-coupled v"   "Pa m s-1"
+state    real   rv_m           ikj     dyn_em      1         Y      -        "rv_m"
+state    real   rv_tend        ikj     dyn_em      1         Y      -        "rv_tend"
+i1       real   rv_tendf       ikj     dyn_em      1         Y                                          
+state    real   v_save         ikj     dyn_em      1         Y      -        "v_save"                   
+#                                               
+# Vertical Vel                                          
+state    real   w              ikjb     dyn_em      2         Z     \
+        irhusdf=(bdy_interp:dt)  "w"                          "z-wind component"   "m s-1"
+state    real   ww             ikj     dyn_em      1         Z      r         "ww"   "mu-coupled eta-dot"    "Pa s-1"
+state    real   rw             ikj     dyn_em      1         Z      -         "rw"   "mu-coupled w"          "Pa m s-1"
+i1       real   ww1            ikj     dyn_em      1         Z                                          
+state    real   ww_m           ikj     dyn_em      1         Z      r         "ww_m"   "time-avg mu-coupled eta-dot"    "Pa s-1"
+i1       real   wwp            ikj     dyn_em      1         Z                                          
+i1       real   rw_tend        ikj     dyn_em      1         Z                                          
+i1       real   rw_tendf       ikj     dyn_em      1         Z                                          
+i1       real   w_save         ikj     dyn_em      1         Z                                          
+
+# Geopotential
+state    real   ph             ikjb     dyn_em      2         Z     \
+       irhusdf=(bdy_interp:dt)   "ph"   "perturbation geopotential"  "m2 s-2"
+state    real   phb            ikj     dyn_em      1         Z     irhdus "phb"  "base-state geopotential"  "m2 s-2"
+state    real   phb_fine       ikj     dyn_em      1         Z      -     "phb_fine"  "for nesting, temp holding interpolated coarse grid phb"  "m2 s-2"
+state    real   ph0            ikj     dyn_em      1         Z      r     "ph0"  "initial geopotential"     "m2 s-2"
+state    real   php            ikj     dyn_em      1         Z      r     "php"  "geopotential"             "m2 s-2"
+i1       real   ph_tend        ikj     dyn_em      1         Z 
+i1       real   ph_tendf       ikj     dyn_em      1         Z 
+i1       real   ph_save        ikj     dyn_em      1         Z 
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   phtot          ikj     dyn_em      1         Z     irh       "PHTOT"        "total geopotential"      "m2 s-2"
+
+# Potential Temperature
+state    real   t              ikjb     dyn_em      2         -     \
+       i01rhusdf=(bdy_interp:dt)   "t"      "perturbation potential temperature (theta-t0)" "K"
+
+state    real   t_init         ikj     dyn_em      1         -      ir       "t_init" "initial potential temperature" "K"
+i1       real   t_tend         ikj     dyn_em      1         -  
+i1       real   t_tendf        ikj     dyn_em      1         -  
+state    real   tp             ikj     dyn_em      2         -  
+i1       real   t_2save        ikj     dyn_em      1         -   
+state    real   t_save         ikj     dyn_em      1         -               "t_save"
+#
+
+
+# Mass
+state    real   mu              ijb     dyn_em      2         -     \
+     irhusdf=(bdy_interp:dt)   "mu"  "perturbation dry air mass in column" "Pa"
+state    real   mub             ij     dyn_em      1         -     irhdus       "mub" "base state dry air mass in column" "Pa"
+state    real   mub_fine        ij     dyn_em      1         -      -           "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa"
+state    real   mub_save        ij     dyn_em      1         -      -           "mub_save" "nest temp, holds orig fine grid mub" "Pa"
+state    real   mu0             ij     dyn_em      1         -     i01rdu       "mu0" "initial dry mass in column" "Pa"
+state    real   mudf            ij     dyn_em      1         -      -           "mudf" "" ""
+state    real   muu             ij     dyn_em      1          -                 "muu"
+i1       real   muus            ij     dyn_em      1          -     
+state    real   muv             ij     dyn_em      1          -                 "muv"
+i1       real   muvs            ij     dyn_em      1          -     
+state    real   mut             ij     dyn_em      1          -                 "mut"
+state    real   muts            ij     dyn_em      1          -                 "muts"
+i1       real   muave           ij     dyn_em      1          -     
+i1       real   mu_save         ij     dyn_em      1          -     
+i1       real   mu_tend         ij     dyn_em      1          -     
+i1       real   mu_tendf        ij     dyn_em      1          -     
+
+#diagnostic for looking at nest position in output. A mungy version of terrain height.
+state    real   nest_pos        ij     misc        1   -   rhu=(mark_domain)  "NEST_POS"
+state    real   nest_mask       ij     misc        1   -   ru=(mark_domain)   "NEST_MASK"     "LOCATION OF NEST IF ANY"
+state    real   ht_coarse       ij     misc        1   -     r                -              "STORAGE FOR LOW-RES TERRAIN"
+
+
+# TKE
+state    real   tke            ikj     dyn_em      2         -       r        "tke"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+i1       real   tke_tend       ikj     dyn_em      1         -      
+
+# Pressure and Density
+state    real   p              ikj     dyn_em      1         -      rh        "p"           "perturbation pressure"         "Pa"
+state    real   al             ikj     dyn_em      1         -      r         "al"          "inverse perturbation density"  "m3 kg-1"
+state    real   alt            ikj     dyn_em      1         -      r         "alt"         "inverse density"               "m3 kg-1"
+state    real   alb            ikj     dyn_em      1         -      rdus      "alb"         "inverse base density"          "m3 kg-1"
+state    real   zx             ikj     dyn_em      1         X      -         " "  " "  " "    
+state    real   zy             ikj     dyn_em      1         Y      -         " "  " "  " "   
+state    real   rdz            ikj     dyn_em      1         Z      -         " "  " "  " "   
+state    real   rdzw           ikj     dyn_em      1         Z       -        " "  " "  " "   
+state    real   pb             ikj     dyn_em      1         -      rhdus     "pb"          "BASE STATE PRESSURE "          "Pa"
+##
+## MARS: TO GET LIGHTER HISTORY FILES
+##
+state    real   ptot           ikj     dyn_em      1         -      irh       "PTOT"        "total pressure"      "Pa"
+
+#                                               
+# Other dyn                                             
+#                                               
+i1       real   advect_tend    ikj     dyn_em      1         -                                          
+i1       real   alpha          ikj     dyn_em      1         -                                                  
+i1       real   a              ikj     dyn_em      1         -                                                  
+i1       real   gamma          ikj     dyn_em      1         -                                                  
+i1       real   c2a            ikj     dyn_em      1         -     -
+i1       real   rho            ikj     dyn_em      1         -     -
+i1       real   phm            ikj     dyn_em      1         -     -
+i1       real   cqu            ikj     dyn_em      1         -     -
+i1       real   cqv            ikj     dyn_em      1         -     -
+i1       real   cqw            ikj     dyn_em      1         -     -
+i1       real   pm1            ikj     dyn_em      1         -     -
+state    real   sr             ij      dyn_em      1         -      irh         "sr" "fraction of frozen precipitation"
+state    real   potevp         ij      dyn_em      1         -       rh         "potevp" "accumulated potential evaporation" "W m-2"
+state    real   snopcx         ij      dyn_em      1         -       rh         "snopcx" "snow phase change heat flux" "W m-2"
+state    real   soiltb         ij      dyn_em      1         -        h         "soiltb" "bottom soil temperature" "K"
+state    real    fnm            k       dyn_em      1         -     irh       "fnm"  "upper weight for vertical stretching"  ""
+state    real    fnp            k       dyn_em      1         -     irh       "fnp"  "lower weight for vertical stretching"  ""
+state    real    rdnw           k       dyn_em      1         -     irh       "rdnw"  "inverse d(eta) values between full (w) levels"   ""
+state    real    rdn            k       dyn_em      1         -     irh       "rdn"  "inverse d(eta) values between half (mass) levels"   ""
+state    real    dnw            k       dyn_em      1         -     irh       "dnw" "d(eta) values between full (w) levels"   ""
+state    real    dn             k       dyn_em      1         -     irh       "dn " "d(eta) values between half (mass) levels"   ""
+state    real    t_base         k       dyn_em      1         -     ir        "t_base"               "BASE STATE T IN IDEALIZED CASES"         "K"      
+state    real    z              ikj     dyn_em      1         -     -         " " " " " "
+i1       real    mu_3d          ikj     dyn_em      1         -                                          
+i1       real    z_at_w         ikj     dyn_em      1         Z 
+state    real    cfn            -       misc      -         -     irh       "cfn"    "extrapolation constant"  ""
+state    real    cfn1           -       misc      -         -     irh       "cfn1"   "extrapolation constant"  ""
+state    integer step_number    -       misc      -         -     ir        "step_number"  ""
+
+# 2m and 10m output diagnostics
+state    real   Q2               ij     misc        1         -     irhd      "Q2"                   "QV at 2 M"         "kg kg-1"
+state    real   T2               ij     misc        1         -     irhd      "T2"                   "TEMP at 2 M"       "K"
+state    real   TH2              ij     misc        1         -     irhd      "TH2"                  "POT TEMP at 2 M"   "K"
+state    real   PSFC             ij     misc        1         -     i01rhd    "PSFC"                 "SFC PRESSURE"      "Pa"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real   U10              ij     misc        1         -     irh01d      "U10"                "U at 10 M"         "m s-1"
+state    real   V10              ij     misc        1         -     irh01d      "V10"                "V at 10 M"         "m s-1"
+
+# these next 4 are for observational nudging
+state    real   uratx           ij      misc        1         -      r          "URATX"            "Ratio of U over U10 on mass points "         "dimensionless"
+state    real   vratx           ij      misc        1         -      r          "VRATX"            "Ratio of V over V10 on mass points "         "dimensionless"   
+state    real   tratx           ij      misc        1         -      r          "TRATX"            "Ratio of T over TH2 on mass points "         "dimensionless"   
+state    real   obs_savwt      hikj     dyn_em      1         X      -       "OBS_SAVWT"
+
+# Other
+state   real    rdx            -        misc      -         -     irh       "rdx"                   "INVERSE X GRID LENGTH"         ""      
+state   real    rdy            -        misc      -         -     irh       "rdy"                   "INVERSE Y GRID LENGTH"         ""      
+state   real    dts            -        misc      -         -     ir        "dts"                   "SMALL TIMESTEP"         ""      
+state   real    dtseps         -        misc      -         -     ir        "dtseps"                "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    resm           -        misc      -         -     irh       "resm"                  "TIME WEIGHT CONSTANT FOR SMALL STEPS"         ""      
+state   real    zetatop        -        misc      -         -     irh       "zetatop"               "ZETA AT MODEL TOP"         ""      
+state   real    cf1            -        misc      -         -     irh       "cf1"                   "2nd order extrapolation constant"         ""      
+state   real    cf2            -        misc      -         -     irh       "cf2"                   "2nd order extrapolation constant"         ""      
+state   real    cf3            -        misc      -         -     irh       "cf3"                   "2nd order extrapolation constant"         ""      
+state   integer number_at_same_level    -        -          -         -     -        "number_at_same_level"  ""         ""      
+
+# State for derived time quantities.  
+state   integer itimestep      -        -          -         -     rh         "itimestep"             ""         ""      
+state   real    xtime          -        -          -         -     rh         "xtime"                 "minutes since simulation start"         ""      
+state   real    julian         -        -          -         -     -          "julian"                "day of year, 0.0 at 0Z on 1 Jan."         "days"      
+
+
+# input file descriptor for lbcs on parent domain                                               
+state   integer lbc_fid        -        -          -         -     -         "lbc_fid"               ""         ""      
+# indicates if tiling has been computed                                         
+state   logical tiled          -        -          -         -     -         "tiled"                 ""         ""      
+# indicates if patches have been computed                                               
+state   logical patched        -        -          -         -     -         "patched"               ""         ""      
+# indicates whether to read input from file or generate                                         
+#state   logical input_from_file        -        -          -         -     -         "input_from_file"         ""         ""    
+# indicates whether to recompute mu                                                             
+state   logical press_adj      -        -          -         -     -         "press_adj"         "T/F flag adjust mu"         ""    
+
+# Mask for moving nest interpolations
+state    integer imask_nostag         ij      misc     1     -
+state    integer imask_xstag          ij      misc     1     X
+state    integer imask_ystag          ij      misc     1     Y
+state    integer imask_xystag         ij      misc     1     XY 
+# vortex center indices; need for restarts of moving nests
+state    real    xi                   -       misc     -     -    r
+state    real    xj                   -       misc     -     -    r
+state    real    vc_i                 -       misc     -     -    r
+state    real    vc_j                 -       misc     -     -    r
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+# Scalar (4D) arrays
+
+# Moist Scalars
+#                                               
+# The first line ensures that there will be identifiers named moist and                                         
+# moist_tend even if there are not any moist scalars (so the essentially                                                
+# dry code will will still link properly)                                               
+#                                               
+state   real    -              ikjftb   moist       1         -     -    -
+state   real    qv             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QVAPOR"           "Water vapor mixing ratio"      "kg kg-1"
+state   real    qc             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QCLOUD"           "Cloud water mixing ratio"      "kg kg-1"
+state   real    qr             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QRAIN"            "Rain water mixing ratio"       "kg kg-1"
+state   real    qi             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QICE"             "Ice mixing ratio"              "kg kg-1"
+state   real    qs             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QSNOW"            "Snow mixing ratio"             "kg kg-1"
+state   real    qg             ikjftb   moist       1         -     \
+   i01rhusdf=(bdy_interp:dt)  "QGRAUP"           "Graupel mixing ratio"          "kg kg-1"
+state   real    -              ikjftb   dfi_moist       1         -     -    -
+state   real    dfi_qv         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QVAPOR"       "Water vapor mixing ratio"      "kg kg-1"
+state   real    dfi_qc         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QCLOUD"       "Cloud water mixing ratio"      "kg kg-1"
+state   real    dfi_qr         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QRAIN"        "Rain water mixing ratio"       "kg kg-1"
+state   real    dfi_qi         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QICE"         "Ice mixing ratio"              "kg kg-1"
+state   real    dfi_qs         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QSNOW"        "Snow mixing ratio"             "kg kg-1"
+state   real    dfi_qg         ikjftb   dfi_moist       1         -     \
+   rusdf=(bdy_interp:dt)  "DFI_QGRAUP"       "Graupel mixing ratio"          "kg kg-1"
+
+
+# Chem Scalars
+state   real    -              ikjftb   chem        1         -     -    -                                       
+
+# Other Scalars
+state   real    -              ikjftb  scalar      1         -     -   -
+state   real    qndrop         ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "QNDROP"        "Droplet number mixing ratio"        "# kg-1"
+state   real    qni            ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "QNICE"         "Ice Number concentration" "# kg-1"
+state   real    qt             ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "CWM"           "Total condensate mixing ratio"      "kg kg-1"
+state   real    qns            ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "QNSNOW"         "Snow Number concentration"   "# kg(-1)"
+state   real    qnr            ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "QNRAIN"        "Rain Number concentration"   "# kg(-1)"
+state   real    qng            ikjftb  scalar      1         -     \
+   i01rhusdf=(bdy_interp:dt)    "QNGRAUPEL"     "Graupel Number concentration" "# kg(-1)"
+state   real    -              ikjftb  dfi_scalar      1         -     -   -
+state   real    dfi_qndrop     ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNDROP"    "Droplet number mixing ratio"        "# kg-1"
+state   real    dfi_qni        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNICE"     "Ice Number concentration" "# kg-1"
+state   real    dfi_qt         ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_CWM"       "Total condensate mixing ratio"      "kg kg-1"
+state   real    dfi_qns        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNSNOW"    "Snow Number concentration"   "# kg(-1)"
+state   real    dfi_qnr        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNRAIN"    "Rain Number concentration"   "# kg(-1)"
+state   real    dfi_qng        ikjftb  dfi_scalar      1         -     \
+   rusdf=(bdy_interp:dt)    "DFI_QNGRAUPEL" "Graupel Number concentration" "# kg(-1)"
+
+#-----------------------------------------------------------------------------------------------------------------------------------------------------------------
+
+# Arrays for Specified LBCs  (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM )
+
+state    real   fcx            w         misc     -         -      ir       "fcx"                  "RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   gcx            w         misc     -         -      ir       "gcx"                  "2ND RELAXATION TERM FOR BOUNDARY ZONE"         ""
+state    real   dtbc            -        misc     -         -      ir       "dtbc"                 "TIME SINCE BOUNDARY READ"         ""
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# Physics Related State Varibles
+
+#-------------------------------------------------------------------------------------------------------------------------------------------
+# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes
+#-------------------------------------------------------------------------------------------------------------------------------------------
+
+state   real   sm000007            ij    misc          1     -     i1      "SM000007"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm007028            ij    misc          1     -     i1      "SM007028"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm028100            ij    misc          1     -     i1      "SM028100"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100255            ij    misc          1     -     i1      "SM100255"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   st000007            ij    misc          1     -     i1      "ST000007"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st007028            ij    misc          1     -     i1      "ST007028"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st028100            ij    misc          1     -     i1      "ST028100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100255            ij    misc          1     -     i1      "ST100255"      "LAYER SOIL TEMPERATURE" "K"
+state   real   sm000010            ij    misc          1     -     i1      "SM000010"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010040            ij    misc          1     -     i1      "SM010040 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm040100            ij    misc          1     -     i1      "SM040100 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm100200            ij    misc          1     -     i1      "SM100200 "     "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sm010200            ij    misc          1     -     i1      "SM010200"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm000            ij    misc          1     -     i1      "SOILM000"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm005            ij    misc          1     -     i1      "SOILM005"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm020            ij    misc          1     -     i1      "SOILM020"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm040            ij    misc          1     -     i1      "SOILM040"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm160            ij    misc          1     -     i1      "SOILM160"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   soilm300            ij    misc          1     -     i1      "SOILM300"      "LAYER SOIL MOISTURE" "m3 m-3"
+state   real   sw000010            ij    misc          1     -     i1      "SW000010"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010040            ij    misc          1     -     i1      "SW010040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw040100            ij    misc          1     -     i1      "SW040100"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw100200            ij    misc          1     -     i1      "SW100200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   sw010200            ij    misc          1     -     i1      "SW010200"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw000            ij    misc          1     -     i1      "SOILW000"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw005            ij    misc          1     -     i1      "SOILW005"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw020            ij    misc          1     -     i1      "SOILW020"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw040            ij    misc          1     -     i1      "SOILW040"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw160            ij    misc          1     -     i1      "SOILW160"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   soilw300            ij    misc          1     -     i1      "SOILW300"      "LAYER SOIL LIQUID" "m3 m-3"
+state   real   st000010            ij    misc          1     -     i1      "ST000010"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010040            ij    misc          1     -     i1      "ST010040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st040100            ij    misc          1     -     i1      "ST040100"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st100200            ij    misc          1     -     i1      "ST100200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   st010200            ij    misc          1     -     i1      "ST010200"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt000            ij    misc          1     -     i1      "SOILT000"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt005            ij    misc          1     -     i1      "SOILT005"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt020            ij    misc          1     -     i1      "SOILT020"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt040            ij    misc          1     -     i1      "SOILT040"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt160            ij    misc          1     -     i1      "SOILT160"      "LAYER SOIL TEMPERATURE" "K"
+state   real   soilt300            ij    misc          1     -     i1      "SOILT300"      "LAYER SOIL TEMPERATURE" "K"
+state   real   landmask            ij    misc          1     -     i012rhd=(interp_fcnm)u=(copy_fcnm)   "LANDMASK"      "LAND MASK (1 FOR LAND, 0 FOR WATER)"  ""
+state   real   topostdv            ij    misc          1     -     i12     "TOPOSTDV"      "ELEVATION STD DEV"  "m"
+state   real   toposlpx            ij    misc          1     -     i12     "TOPOSLPX"      "ELEVATION X SLOPE"  ""
+state   real   toposlpy            ij    misc          1     -     i12     "TOPOSLPY"      "ELEVATION Y SLOPE"  ""
+state   real   shdmax              ij    misc          1     -     i012r   "SHDMAX"        "ANNUAL MAX VEG FRACTION" ""
+state   real   shdmin              ij    misc          1     -     i012r   "SHDMIN"        "ANNUAL MIN VEG FRACTION" ""
+state   real   snoalb              ij    misc          1     -     i012r   "SNOALB"        "ANNUAL MAX SNOW ALBEDO IN FRACTION" ""
+state   real   slopecat            ij    misc          1     -     i12     "SLOPECAT"      "SLOPE CATEGORY"  ""
+state   real   toposoil            ij    misc          1     -     i12     "SOILHGT"       "ELEVATION OF LSM DATA"  "m"
+state   real   landusef            iuj   misc          1     Z     i012r   "LANDUSEF"      "LANDUSE FRACTION BY CATEGORY"  ""
+state   real   soilctop            isj   misc          1     Z     i012    "SOILCTOP"      "SOIL CAT FRACTION (TOP)"  ""
+state   real   soilcbot            isj   misc          1     Z     i012    "SOILCBOT"      "SOIL CAT FRACTION (BOTTOM)"  ""
+state   real   soilcat             ij    misc          1     -     i12     "SOILCAT"       "SOIL CAT DOMINANT TYPE" ""
+state   real   vegcat              ij    misc          1     -     i12     "VEGCAT"        "VEGETATION CAT DOMINANT TYPE" ""
+
+#---------------------------------------------------------------------------------------------------------------------------------------
+# SI - end variables from netCDF format from Standard Initialization
+#---------------------------------------------------------------------------------------------------------------------------------------
+
+# soil model variables  (Note that they are marked as staggered in the vertical dimension
+# because they are "fully dimensioned" -- they use every element in that dim
+state    real   TSLB           ilj       misc      1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)           "TSLB"     "SOIL TEMPERATURE"   "K"
+
+# Time series variables
+state    real   ts_hour         ?!       misc      -         -      r        "TS_HOUR"        "Model integration time, hours"
+state    real   ts_u            ?!       misc      -         -      r        "TS_U"           "Surface wind U-component, earth-relative"
+state    real   ts_v            ?!       misc      -         -      r        "TS_V"           "Surface wind V-component, earth-relative"
+state    real   ts_q            ?!       misc      -         -      r        "TS_Q"           "Surface mixing ratio"
+state    real   ts_t            ?!       misc      -         -      r        "TS_T"           "Surface temperature"
+state    real   ts_psfc         ?!       misc      -         -      r        "TS_PSFC"        "Surface pressure"
+state    real   ts_glw          ?!       misc      -         -      r        "TS_GLW"         "Downward long wave flux at surface"
+state    real   ts_gsw          ?!       misc      -         -      r        "TS_GSW"         "Net short wave flux at surface"
+state    real   ts_hfx          ?!       misc      -         -      r        "TS_HFX"         "Upward heat flux at surface"
+state    real   ts_lh           ?!       misc      -         -      r        "TS_LH"          "Upward moisture flux at surface"
+state    real   ts_tsk          ?!       misc      -         -      r        "TS_TSK"         "Skin temperature"
+state    real   ts_tslb         ?!       misc      -         -      r        "TS_TSLB"        "Soil temperature"
+state    real   ts_clw          ?!       misc      -         -      r        "TS_CLW"         "Column integrated cloud water"
+state    real   ts_rainc        ?!       misc      -         -      r        "TS_RAINC"       "Cumulus precip"
+state    real   ts_rainnc       ?!       misc      -         -      r        "TS_RAINNC"      "Grid-scale precip"
+
+# urban model variables
+state    real   DZR             l        em      -            Z     r        "DZR"            "THICKNESSES OF ROOF LAYERS"                      "m"
+state    real   DZB             l        em      -            Z     r        "DZB"            "THICKNESSES OF WALL LAYERS"                      "m"
+state    real   DZG             l        em      -            Z     r        "DZG"            "THICKNESSES OF ROAD LAYERS"                      "m"
+
+# lsm State Variables
+
+state    real   SMOIS            ilj     -          1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SMOIS"            "SOIL MOISTURE"     "m3 m-3"
+state    real   SH2O             ilj     -          1         Z     i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SH2O"             "SOIL LIQUID WATER" "m3 m-3"
+state    real   XICE             ij     misc        1         -     i0124rhd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "SEAICE"             "SEA ICE FLAG"  ""
+state    real   XICEM            ij     misc        1         -     rhd=(interp_mask_water_field:lu_index)u=(copy_fcnm)  "XICEM"             "SEA ICE FLAG (PREVIOUS STEP)"  ""
+state    real   SMSTAV           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)       "SMSTAV"           "MOISTURE AVAILABILITY" ""
+state    real   SMSTOT           ij     misc        1         -      r                                          "SMSTOT"           "TOTAL SOIL MOISTURE" "m3 m-3"
+
+state    real   SFCRUNOFF        ij     misc        1         -      rhd=(interp_mask_land_field:lu_index)      "SFROFF"           "SURFACE RUNOFF"     "mm"
+state    real   UDRUNOFF         ij     misc        1         -      rhd=(interp_mask_land_field:lu_index)      "UDROFF"           "UNDERGROUND RUNOFF" "mm"
+state  integer  IVGTYP           ij     misc        1         -     i02rhd=(interp_fcni)u=(copy_fcni)            "IVGTYP"           "DOMINANT VEGETATION CATEGORY" ""
+state  integer  ISLTYP           ij     misc        1         -     i02rhd=(interp_fcni)u=(copy_fcni)            "ISLTYP"           "DOMINANT SOIL CATEGORY"       ""
+state    real   VEGFRA           ij     misc        1         -     i0124rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)   "VEGFRA"           "VEGETATION FRACTION" ""
+state    real   SFCEVP           ij     misc        1         -      r                                          "SFCEVP"           "SURFACE EVAPORATION" "kg m-2"
+state    real   GRDFLX           ij     misc        1         -      rh                                         "GRDFLX"           "GROUND HEAT FLUX" "W m-2"
+state    real   SFCEXC           ij     misc        1         -      r                                          "SFCEXC "          "SURFACE EXCHANGE COEFFICIENT"   "m s-1"
+
+state    real   ACSNOW           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOW"           "ACCUMULATED SNOW"         "kg m-2"
+state    real   ACSNOM           ij     misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "ACSNOM"           "ACCUMULATED MELTED SNOW"  "kg m-2"
+state    real   SNOW             ij     misc        1         -     i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOW"             "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real   SNOWH            ij     misc        1         -     i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "SNOWH"            "PHYSICAL SNOW DEPTH"      "m"
+state    real   RHOSN            ij     misc        1         -     i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "RHOSN"            " SNOW DENSITY"      "kg m-3" 
+state    real   CANWAT           ij     misc        1         -     i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)    "CANWAT"           "CANOPY WATER"             "kg m-2"
+state    real   SST              ij     misc        1         -     i0124rhd=(interp_mask_water_field:lu_index)   "SST"              "SEA SURFACE TEMPERATURE" "K"
+state  integer  IFNDSNOWH        -      misc        1         -     i         "FNDSNOWH" "SNOWH_LOGICAL"
+state  integer  IFNDSOILW        -      misc        1         -     i         "FNDSOILW" "SOILW_LOGICAL"
+
+# DFI variables
+state   real   hcoeff           n    misc        1         -     -    "HCOEFF"               "initialization weights"
+state   real   hcoeff_tot       -    misc        1         -     -    "HCOEFF_TOT"               "initialization weights"
+state   real   dfi_p           ikj   misc        1         -     r    "P_DFI"           "perturbation pressure"         "Pa"
+state   real   dfi_al          ikj   misc        1         -     r    "AL_DFI"          "inverse perturbation density"  "m3 kg-1"
+state   real   dfi_mu          ij    misc        1         -     r    "MU_DFI"  "perturbation dry air mass in column" "Pa"
+state   real   dfi_phb         ikj   misc        1         Z     r    "PHB_DFI"  "base-state geopotential"  "m2 s-2"
+state   real   dfi_ph0         ikj   misc        1         Z     r    "PH0_DFI"  "initial geopotential"     "m2 s-2"
+state   real   dfi_php         ikj   misc        1         Z     r    "PHP_DFI"  "geopotential"             "m2 s-2"
+state   real   dfi_u           ikj   misc        1         -     r    "U_DFI"               "u accumulation array"          "   "
+state   real   dfi_v           ikj   misc        1         -     r    "V_DFI"               "v accumulation array"          "   "
+state   real   dfi_w           ikj   misc        1         -     r    "W_DFI"               "w accumulation array"          "   "
+state   real   dfi_ww          ikj   misc        1         Z     r    "WW_DFI"              "mu-coupled eta-dot"    "Pa s-1"
+state   real   dfi_t           ikj   misc        1         -     r    "TT_DFI"               "t accumulation array"          "   "
+state   real   dfi_ph          ikj   misc        1         -     r    "PH_DFI"               "p accumulation array"          "   "
+state   real   dfi_pb          ikj   misc        1         -     r    "PB_DFI"               "pb accumulation array"          "   "
+state   real   dfi_alt         ikj   misc        1         -     r    "ALT_DFI"             "1/rho accumulation array"          "   "
+state   real   dfi_tke         ikj   misc        1         -     r    "TKE_DFI"          "TURBULENCE KINETIC ENERGY"     "m2 s-2"
+
+state    real  dfi_TSLB        ilj   misc        1         Z     r    "TSLB_dfi"         "SOIL TEMPERATURE"   "K"
+state    real  dfi_SMOIS       ilj    -          1         Z     r    "SMOIS_dfi"        "SOIL MOISTURE"     "m3 m-3"
+state    real  dfi_SNOW        ij    misc        1         -     r    "SNOW_dfi"         "SNOW WATER EQUIVALENT"    "kg m-2"
+state    real  dfi_SNOWH       ij    misc        1         -     r    "SNOWH_dfi"        "PHYSICAL SNOW DEPTH"      "m"
+state    real  dfi_CANWAT      ij    misc        1         -     r    "CANWAT_dfi"       "CANOPY WATER"             "kg m-2"
+state    real  dfi_SMFR3D      ilj   misc        1         Z     r    "SMFR3D_dfi"           "SOIL ICE" ""
+state    real  dfi_KEEPFR3DFLAG ilj  misc        1         Z     r    "KEEPFR3DFLAG_dfi"     "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# urban state variables
+state    real   TR_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TR_URB"              "URBAN ROOF SKIN TEMPERATURE"        "K"
+state    real   TB_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TB_URB"              "URBAN WALL SKIN TEMPERATURE"        "K" 
+state    real   TG_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TG_URB"              "URBAN ROAD SKIN TEMPERATURE"        "K" 
+state    real   TC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TC_URB"              "URBAN CANOPY TEMPERATURE"           "K"
+state    real   QC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "QC_URB"              "URBAN CANOPY HUMIDITY"          "kg kg{-1}"
+state    real   UC_URB2D         ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "UC_URB"              "URBAN CANOPY WIND"          "m s{-1}"
+state    real   XXXR_URB2D       ij     misc        1         -     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF"   "dimensionless"
+state    real   XXXB_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL"   "dimensionless"
+state    real   XXXG_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD"   "dimensionless"
+state    real   XXXC_URB2D       ij    misc        1         -      rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)       "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless"
+state    real   TRL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TRL_URB" "ROOF LAYER TEMPERATURE"          "K"
+state    real   TBL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TBL_URB" "WALL LAYER TEMPERATURE"          "K"
+state    real   TGL_URB3D        ilj    misc        1         Z     rd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "TGL_URB" "ROAD LAYER TEMPERATURE"          "K"
+state    real   SH_URB2D        ij    misc        1         -     r       "SH_URB"  "SENSIBLE HEAT FLUX FROM URBAN SFC"  "W m{-2}"
+state    real   LH_URB2D        ij    misc        1         -     r       "LH_URB"  "LATENT HEAT FLUX FROM URBAN SFC"    "W m{-2}"
+state    real   G_URB2D         ij    misc        1         -     r        "G_URB"  "GROUND HEAT FLUX INTO URBAN"        "W m{-2}"
+state    real   RN_URB2D        ij    misc        1         -     r       "RN_URB"  "NET RADIATION ON URBAN SFC"         "W m{-2}"
+state    real   TS_URB2D        ij    misc        1         -     r       "TS_URB"  "SKIN TEMPERATURE"          "K"
+state    real   FRC_URB2D       ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "FRC_URB"  "URBAN FRACTION"         "dimensionless"
+state    integer   UTYPE_URB2D  ij    misc        1         -     rd=(interp_fcnm)u=(copy_fcnm)       "UTYPE_URB"  "URBAN TYPE"         "dimensionless"
+
+
+# urban variables from radiation model
+state    real   COSZ_URB2D       ij     misc        1         -      r       "COSZ_URB"  "COS of SOLAR ZENITH ANGLE"         "dimensionless"
+state    real   OMG_URB2D        ij     misc        1         -      r       "OMG_URB"   "SOLAR HOUR ANGLE"         "dimensionless"
+state    real   DECLIN_URB       -     misc        1         -       r       "DECLIN_URB"  "SOLAR DECLINATION"         "dimensionless"
+
+
+# RUC LSM
+state    real   SMFR3D           ilj    misc        1         Z      r        "SMFR3D"               "SOIL ICE" ""
+state    real   KEEPFR3DFLAG     ilj    misc        1         Z      r        "KEEPFR3DFLAG"          "FLAG - 1. FROZEN SOIL YES, 0 - NO"             ""
+
+# Additional for P-X PBL and LSM
+state    real   RA               ij     misc        1         -      r        "RA"           "AERODYNAMIC RESISTANCE"   "s m-1"
+state    real   RS               ij     misc        1         -      r        "RS"           "SURFACE RESISTANCE"       "s m-1"
+state    real   LAI              ij     misc        1         -      r        "LAI"          "Leaf area index"          "area/area"
+state    real   VEGF_PX          ij     misc        1         -      r        "VEGF_PX"      "Vegetation Fraction for PX LSM"    "area/area"
+state    real   T2OBS            ij     misc        1         -      r        "T2OBS"        "2-m temperature from analysis "          "K"
+state    real   Q2OBS            ij     misc        1         -      r        "Q2OBS"        "2-m mixing ratio from analysis "         "kg/kg"
+
+# MRF PBL variables
+i1      real   PSIM           ij     misc        1         -     -         "PSIM"                "SIMILARITY FUNCTION FOR MOMENTUM"     ""
+i1      real   PSIH           ij     misc        1         -     -         "PSIH"                "SIMILARITY FUNCTION FOR HEAT"         ""
+i1      real   WSPD           ij     misc        1         -     -         "WSPD"                "Wind speed"                           "m s-1"
+i1      real   GZ1OZ0         ij     misc        1         -     -         "GZ1OZ0"              "LOG OF Z1 over Z0"                     ""
+i1      real   BR             ij     misc        1         -     -         "BR"                  "Bulk Richardson"                       ""
+
+# MYJ PBL variables
+state    real   tke_myj        ikj     misc        1         -      r        "tke_myj"               "TKE FROM MELLOR-YAMADA-JANJIC"      "m2 s-2"
+state    real   EL_MYJ          ikj     misc        1         -     -        "el_myj"                "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC"     "m"
+state    real   EXCH_H          ikj     misc        1         -     r          "EXCH_H"               "EXCHANGE COEFFICIENTS "
+state    real  CT              ij      misc        1         -      r        "CT"                    "COUNTERGRADIENT TERM"    "K"
+state   real   THZ0             ij     misc        1         -      r        "THZ0"                  "POTENTIAL TEMPERATURE AT ZNT"                 "K"
+state    real  Z0               ij     misc        1         -      r        "Z0"                    "Background ROUGHNESS LENGTH"                  "m"
+state   real   QZ0              ij     misc        1         -      r        "QZ0"                   "SPECIFIC HUMIDITY AT ZNT"                     "kg kg-1"
+state   real   UZ0              ij     misc        1         -      r        "UZ0"                   "U WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   VZ0              ij     misc        1         -      r        "VZ0"                   "V WIND COMPONENT AT ZNT"                      "m s-1"
+state   real   QSFC             ij     misc        1         -      r        "QSFC"                  "SPECIFIC HUMIDITY AT LOWER BOUNDARY"          "kg kg-1"
+state   real   AKHS             ij     misc        1         -      r        "AKHS"                  "SFC EXCH COEFF FOR HEAT"                      "m s-1"    
+state   real   AKMS             ij     misc        1         -      r        "AKMS"                  "SFC EXCH COEFF FOR MOMENTUM"                  "m s-1"    
+state   integer KPBL            ij     misc        1         -     r         "KPBL"                  "LEVEL OF PBL TOP"                             ""
+state   real   TSHLTR           ij     misc        1         -     ir        "TSHLTR"                "SHELTER THETA FROM MYJ"                       "K"
+state   real   QSHLTR           ij     misc        1         -     ir        "QSHLTR"                "SHELTER SPECIFIC HUMIDITY FROM MYJ"           "kg kg-1"
+state   real   PSHLTR           ij     misc        1         -     ir        "PSHLTR"                "SHELTER PRESSURE FROM MYJ"           "Pa"
+state   real   TH10             ij     misc        1         -     ir        "TH10"                  "10-M THETA FROM MYJ"                          "K"
+state   real   Q10              ij     misc        1         -     ir        "Q10"                   "10-M SPECIFIC HUMIDITY FROM MYJ"              "kg kg-1"
+i1      real   CHKLOWQ          ij     misc        1         -     -         "CHKLOWQ"               "SURFACE SATURATION FLAG"        ""
+
+# gfdl (eta) radiation State Variables
+state    real    HTOP            ij     misc        1         -      r        "HTOP"                 "TOP OF CONVECTION LEVEL"         ""
+state    real    HBOT            ij     misc        1         -      r        "HBOT"                 "BOT OF CONVECTION LEVEL"         ""
+state    real    HTOPR           ij     misc        1         -      r        "HTOPR"                "TOP OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    HBOTR           ij     misc        1         -      r        "HBOTR"                "BOT OF CONVECTION LEVEL FOR RADIATION"    ""
+state    real    CUTOP           ij     misc        1         -      r        "CUTOP"                "TOP OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    real    CUBOT           ij     misc        1         -      r        "CUBOT"                "BOT OF CONVECTION LEVEL FROM CUMULUS PAR"    ""
+state    REAL      CUPPT         ij     misc        1         -      r        "CUPPT"                "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION"         ""
+state  real   rswtoa    ij    misc        1    -    i
+state  real   rlwtoa    ij    misc        1    -    i
+state  real   czmean    ij    misc      1    -     i
+state  real   cfracl    ij    misc      1    -     i
+state  real   cfracm    ij    misc      1    -     i
+state  real   cfrach    ij    misc      1    -     i
+state  real   acfrst    ij    misc        1    -    i
+state integer ncfrst    ij    misc        1    -    i
+state  real   acfrcv    ij    misc        1    -    i
+state integer ncfrcv    ij    misc        1    -    i
+
+# cam radiation variables
+state  real    -       iqjf ozmixm      1    -   -     -
+state  real   mth01    iqjf ozmixm      1    -   -     -
+state  real   mth02    iqjf ozmixm      1    -   -     -
+state  real   mth03    iqjf ozmixm      1    -   -     -
+state  real   mth04    iqjf ozmixm      1    -   -     -
+state  real   mth05    iqjf ozmixm      1    -   -     -
+state  real   mth06    iqjf ozmixm      1    -   -     -
+state  real   mth07    iqjf ozmixm      1    -   -     -
+state  real   mth08    iqjf ozmixm      1    -   -     -
+state  real   mth09    iqjf ozmixm      1    -   -     -
+state  real   mth10    iqjf ozmixm      1    -   -     -
+state  real   mth11    iqjf ozmixm      1    -   -     -
+state  real   mth12    iqjf ozmixm      1    -   -     -
+state  real   pin       q     misc      1    -   -      "PIN"             "PRESSURE LEVEL OF OZONE MIXING RATIO"  "millibar"
+state  real   m_ps       ij   misc      2    -   -      "m_ps"            "PS from MATCH on WRF grids"
+state  real    -       idjf aerosolc    2    -   -       -
+state  real   SUL      idjf aerosolc    2    -   -     "SUL"        "SUL aerosol concentration"
+state  real   SSLT     idjf aerosolc    2    -   -     "SSLT"        "SSLT aerosol concentration"
+state  real   DUST1    idjf aerosolc    2    -   -     "DUST1"        "DUST1 aerosol concentration"
+state  real   DUST2    idjf aerosolc    2    -   -     "DUST2"        "DUST2 aerosol concentration"
+state  real   DUST3    idjf aerosolc    2    -   -     "DUST3"        "DUST3 aerosol concentration"
+state  real   DUST4    idjf aerosolc    2    -   -     "DUST4"        "DUST4 aerosol concentration"
+state  real   OCPHO    idjf aerosolc    2    -   -     "OCPHO"        "OCPHO aerosol concentration"
+state  real   BCPHO    idjf aerosolc    2    -   -     "BCPHO"        "BCPHO aerosol concentration"
+state  real   OCPHI    idjf aerosolc    2    -   -     "OCPHI"        "OCPHI aerosol concentration"
+state  real   BCPHI    idjf aerosolc    2    -   -     "BCPHI"        "BCPHI aerosol concentration"
+state  real   BG       idjf aerosolc    2    -   -     "BG"        "BG aerosol concentration"
+state  real   VOLC     idjf aerosolc    2    -   -     "VOLC"        "VOLC aerosol concentration"
+state  real   m_hybi    d     misc      1    -   -     "m_hybi"         "MATCH hybi"
+
+# new eta microphpysics State Variables
+state    real    F_ICE_PHY       ikj    misc        1         -      rdu      "F_ICE_PHY"            "FRACTION OF ICE"         ""
+state    real    F_RAIN_PHY      ikj    misc        1         -      rdu      "F_RAIN_PHY"           "FRACTION OF RAIN "         ""
+state    real    F_RIMEF_PHY     ikj    misc        1         -      rdu      "F_RIMEF_PHY"          "MASS RATIO OF RIMED ICE "         ""
+state    real    qndropsource    ikj    misc        1         -      h        "qndropsource"         "Droplet number source"   "#/kg/s"
+
+# Other Misc State Variables                                            
+state   real    h_diabatic     ikj     misc         1         -      rdu      "h_diabatic"            "PREVIOUS TIMESTEP CONDENSATIONAL HEATING"         "K s-1"      
+state   real    msft           ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_M"         "Map scale factor on mass grid" ""
+state   real    msfu           ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_U"         "Map scale factor on u-grid" ""
+state   real    msfv           ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_V"         "Map scale factor on v-grid" ""
+state   real    msftx          ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_MX"         "Map scale factor on mass grid, x direction" ""
+state   real    msfty          ij      misc         1         -     i012rhdu=(copy_fcnm)    "MAPFAC_MY"         "Map scale factor on mass grid, y direction" ""
+state   real    msfux          ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_UX"         "Map scale factor on u-grid, x direction" ""
+state   real    msfuy          ij      misc         1         X     i012rhdu=(copy_fcnm)    "MAPFAC_UY"         "Map scale factor on u-grid, y direction" ""
+state   real    msfvx          ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_VX"         "Map scale factor on v-grid, x direction" ""
+state   real    msfvx_inv      ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MF_VX_INV"         "Inverse map scale factor on v-grid, x direction" ""
+state   real    msfvy          ij      misc         1         Y     i012rhdu=(copy_fcnm)    "MAPFAC_VY"         "Map scale factor on v-grid, y direction" ""
+
+state   real    f              ij      misc         1         -     i012rhdu=(copy_fcnm)    "f"                "Coriolis sine latitude term"  "s-1"
+state   real    e              ij      misc         1         -     i012rhdu=(copy_fcnm)    "e"                "Coriolis cosine latitude term"  "s-1"
+state   real    sina           ij      misc         1         -     i012rhdu=(copy_fcnm)    "SINALPHA"         "Local sine of map rotation"   ""
+state   real    cosa           ij      misc         1         -     i012rhdu=(copy_fcnm)    "COSALPHA"         "Local cosine of map rotation"  ""
+state   real    ht             ij      misc         1         -     i012rhdus  "HGT"              "Terrain Height"   "m"
+state   real    ht_fine        ij      misc         1         -     -          "HGT_FINE"         "Fine Terrain Height"   "m"
+state   real    ht_int         ij      misc         1         -     -          "HGT_INT"          "Terrain Height Horizontally Interpolated"   "m"
+state   real    ht_input       ij      misc         1         -     -          "HGT_INPUT"        "Terrain Height from FG Input File"   "m"
+state   real    ht_shad        ijb     misc         1         -     hdf=(bdy_interp:dt)         "HGT_SHAD"        "Height of orographic shadow"   "m"
+i1      real    ht_loc         ij      misc         1         -     - 
+i1      integer  shadowmask    ij      misc         1         -     - 
+state   integer min_ptchsz     -       misc         1         -     r
+
+state   real    TSK            ij      misc         1         -     i012rhdu=(copy_fcnm)    "TSK"                   "SURFACE SKIN TEMPERATURE"                  "K"
+state   real    dfi_TSK        ij      misc         1         -     r                       "TSK_dfi"               "saved SURFACE SKIN TEMPERATURE"
+state   real    TSK_SAVE       ij      misc         1         -     -         "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL"       "K"
+state   real    u_base         k       misc         1         -     ir        "u_base"                "BASE STATE X WIND IN IDEALIZED CASES"         ""      
+state   real    v_base         k       misc         1         -     ir        "v_base"                "BASE STATE Y WIND IN IDEALIZED CASES"         ""      
+state   real    qv_base        k       misc         1         -     ir        "qv_base"               "BASE STATE QV IN IDEALIZED CASES"         ""      
+state   real    z_base         k       misc         1         -     ir        "z_base"                "BASE STATE HEIGHT IN IDEALIZED CASES"         ""      
+state   real    u_frame        -       misc         1         -     ir        "u_frame"               "FRAME X WIND"         "m s-1"      
+state   real    v_frame        -       misc         1         -     ir        "v_frame"               "FRAME Y WIND"         "m s-1"      
+# p_top appears as metadata between SI and real but as a state variable in real and WRF
+# since it is a scalar and a constant, it makes sense to have it as metadata -- there
+# are, however, probably post-processing programs that expect to see it as an I/O record
+# another problem: share/input_wrf tries to read this as metadata (fine for real reading
+# SI, but with model reading real output, it generates a warning when debug is > 0 in
+# namelist and causes repeated questions from users.  A third problem is the potential
+# collision between a metadata name and a field record in the I/O data
+# resolve this how?  Have the real program throw a switch to tell the code to get it
+# from the metadata?  Otherwise it's a field?
+state   real    p_top          -       misc         -         -     irh       "p_top"                 "PRESSURE TOP OF THE MODEL"  "Pa"
+state   real    max_msftx      -       misc         -         -      rh       "max_mstfx"             "Max map factor in domain"  ""
+state   real    max_msfty      -       misc         -         -      rh       "max_mstfy"             "Max map factor in domain"  ""
+                                                
+# Other physics variables
+                                                
+state    real  RTHCUTEN        ikj      misc        1         -      r        "RTHCUTEN"              "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME"     "Pa K s-1"
+state    real  RQVCUTEN        ikj      misc        1         -      r        "RQVCUTEN"              "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQRCUTEN        ikj      misc        1         -      r        "RQRCUTEN"              "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQCCUTEN        ikj      misc        1         -      r        "RQCCUTEN"              "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQSCUTEN        ikj      misc        1         -      r        "RQSCUTEN"              "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  RQICUTEN        ikj      misc        1         -      r        "RQICUTEN"              "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME"       "Pa kg kg-1 s-1"
+state    real  W0AVG           ikj      misc        1         -      r        "W0AVG"                 "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME"         "m s-1"
+                                                
+state    real  RAINC            ij      misc        1         -      rhdu     "RAINC"                 "ACCUMULATED TOTAL CUMULUS PRECIPITATION"                 "mm"      
+state    real  RAINNC           ij      misc        1         -      rhdu     "RAINNC"                "ACCUMULATED TOTAL GRID SCALE PRECIPITATION"              "mm"      
+state    real  PRATEC           ij      misc        1         -      rh       "PRATEC"                "PRECIP RATE FROM CUMULUS SCHEME"                         "mm s-1"
+state    real  RAINCV           ij      misc        1         -      rh       "RAINCV"                "TIME-STEP CUMULUS PRECIPITATION"                         "mm"      
+state    real  RAINNCV          ij      misc        1         -      r        "RAINNCV"               "TIME-STEP NONCONVECTIVE PRECIPITATION"                   "mm"
+state    real  RAINBL           ij      misc        1         -      r        "RAINBL"                "PBL TIME-STEP TOTAL PRECIPITATION"                       "mm"      
+state    real  SNOWNC           ij      misc        1         -      rhdu     "SNOWNC"                "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE"               "mm"
+state    real  GRAUPELNC        ij      misc        1         -      rhdu     "GRAUPELNC"             "ACCUMULATED TOTAL GRID SCALE GRAUPEL"                    "mm"
+state    real  SNOWNCV          ij      misc        1         -      r        "SNOWNCV"               "TIME-STEP NONCONVECTIVE SNOW AND ICE"                    "mm"
+state    real  GRAUPELNCV       ij      misc        1         -      r        "GRAUPELNCV"            "TIME-STEP NONCONVECTIVE GRAUPEL"                      "mm"
+state    real  NCA              ij      misc        1         -      r        "NCA"                   "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME"    ""      
+state    integer  LOWLYR        ij      misc        1         -     -         "LOWLYR"                "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME"   ""      
+state    real  MASS_FLUX        ij      misc        1         -      r        "MASS_FLUX"             "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME"  "mb hour-1"
+state    real  apr_gr           ij      misc        1         -      r       "APR_GR"                "PRECIP FROM CLOSURE OLD_GRELL"   "mm hour-1"
+state    real  apr_w            ij      misc        1         -      r       "APR_W"                 "PRECIP FROM CLOSURE W"           "mm hour-1"
+state    real  apr_mc           ij      misc        1         -      r       "APR_MC"                "PRECIP FROM CLOSURE KRISH MV"    "mm hour-1"
+state    real  apr_st           ij      misc        1         -      r       "APR_ST"                "PRECIP FROM CLOSURE STABILITY"   "mm hour-1"
+state    real  apr_as           ij      misc        1         -      r       "APR_AS"                "PRECIP FROM CLOSURE AS-TYPE"     "mm hour-1"
+state    real  apr_capma        ij      misc        1         -      r       "APR_CAPMA"             "PRECIP FROM MAX CAP"             "mm hour-1"
+state    real  apr_capme        ij      misc        1         -      r       "APR_CAPME"             "PRECIP FROM MEAN CAP"            "mm hour-1"
+state    real  apr_capmi        ij      misc        1         -      r       "APR_CAPMI"             "PRECIP FROM MIN CAP"             "mm hour-1"
+state    real  edt_out          ij      misc        1         -      h        "EDT_OUT"             "EDT FROM GD SCHEME"             ""
+state    real  xf_ens           ije     misc        1         Z      r        "XF_ENS"                "MASS FLUX PDF IN GRELL CUMULUS SCHEME"     "mb hour-1"
+state    real  pr_ens           ije     misc        1         Z      r        "PR_ENS"                "PRECIP RATE PDF IN GRELL CUMULUS SCHEME"    "mb hour-1"
+state    real  cugd_tten        ikj     misc        1         -      h        "CUGD_TTEN"             "INITIAL TTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qvten       ikj     misc        1         -      h        "CUGD_QVTEN"            "INITIAL QTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_ttens       ikj     misc        1         -      h        "CUGD_TTENS"            "INITIAL SUBSIDENCE TTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qvtens      ikj     misc        1         -      h        "CUGD_QVTENS"           "INITIAL SUBSIDNCE QTENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+state    real  cugd_qcten       ikj     misc        1         -      h        "CUGD_QCTEN"            "INITIAL TEMPERATURE TENDENCY OUT OFF GRELL CUMULUS SCHEME"  "K s-1"
+#state    real  ACLWUPTC         ij      misc       1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+state    real  RTHFTEN          ikj     misc        1         -      r        "RTHFTEN"               "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME"  "K s-1"      
+state    real  RQVFTEN          ikj     misc        1         -      r        "RQVFTEN"               "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME"     "kg s-1"
+
+state integer  STEPCU          -        misc        1         -      r        "STEPCU"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS"  ""
+                                                
+state    real  RTHRATEN        ikj      misc        1         -      rd       "RTHRATEN"              "COUPLED THETA TENDENCY DUE TO RADIATION"              "Pa K s-1"
+state    real  RTHRATENLW      ikj      misc        1         -      r        "RTHRATLW"              "UNCOUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION"    "K s-1"
+state    real  RTHRATENSW      ikj      misc        1         -      r        "RTHRATSW"              "UNCOUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION"   "K s-1"
+state    real  CLDFRA          ikj      misc        1         -      r        "CLDFRA"                "CLOUD FRACTION"                                       ""
+
+state    real  SWDOWN           ij      misc        1         -      rhd      "SWDOWN"                "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  SWDOWNC          ij      misc        1         -      -        "SWDOWNC"               "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GSW              ij      misc        1         -      rd       "GSW"                   "NET SHORT WAVE FLUX AT GROUND SURFACE"           "W m-2"      
+state    real  GLW              ij      misc        1         -      rhd      "GLW"                   "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE"            "W m-2"      
+
+# upward and downward clearsky and total diagnostic fluxes for CAM radiation
+#state    real  ACSWUPT          ij      misc        1         -      rhdu     "ACSWUPT"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWUPTC         ij      misc        1         -      rhdu     "ACSWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWDNT          ij      misc        1         -      rhdu     "ACSWDNT"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACSWDNTC         ij      misc        1         -      rhdu     "ACSWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  ACSWUPB          ij      misc        1         -      rhdu     "ACSWUPB"               "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWUPBC         ij      misc        1         -      rhdu     "ACSWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACSWDNB          ij      misc        1         -      rhdu     "ACSWDNB"               "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACSWDNBC         ij      misc        1         -      rhdu     "ACSWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWUPT          ij      misc        1         -      rhdu     "ACLWUPT"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWUPTC         ij      misc        1         -      rhdu     "ACLWUPTC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWDNT          ij      misc        1         -      rhdu     "ACLWDNT"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  ACLWDNTC         ij      misc        1         -      rhdu     "ACLWDNTC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  ACLWUPB          ij      misc        1         -      rhdu     "ACLWUPB"               "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWUPBC         ij      misc        1         -      rhdu     "ACLWUPBC"              "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  ACLWDNB          ij      misc        1         -      rhdu     "ACLWDNB"               "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  ACLWDNBC         ij      misc        1         -      rhdu     "ACLWDNBC"              "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWUPT            ij      misc        1         -      rhdu     "SWUPT"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWUPTC           ij      misc        1         -      rhdu     "SWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWDNT            ij      misc        1         -      rhdu     "SWDNT"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP"          "J m-2"
+#state    real  SWDNTC           ij      misc        1         -      rhdu     "SWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2"
+#state    real  SWUPB            ij      misc        1         -      rhdu     "SWUPB"                 "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWUPBC           ij      misc        1         -      rhdu     "SWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  SWDNB            ij      misc        1         -      rhdu     "SWDNB"                 "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  SWDNBC           ij      misc        1         -      rhdu     "SWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWUPT            ij      misc        1         -      rhdu     "LWUPT"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWUPTC           ij      misc        1         -      rhdu     "LWUPTC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWDNT            ij      misc        1         -      rhdu     "LWDNT"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP"          "J m-2"
+#state    real  LWDNTC           ij      misc        1         -      rhdu     "LWDNTC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2"
+#state    real  LWUPB            ij      misc        1         -      rhdu     "LWUPB"                 "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWUPBC           ij      misc        1         -      rhdu     "LWUPBC"                "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+#state    real  LWDNB            ij      misc        1         -      rhdu     "LWDNB"                 "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM"          "J m-2"
+#state    real  LWDNBC           ij      misc        1         -      rhdu     "LWDNBC"                "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2"
+
+state    real  SWCF             ij      misc        1         -      r         "SWCF"                  "SHORT WAVE CLOUD FORCING AT TOA"                     "W m-2"
+state    real  LWCF             ij      misc        1         -      r         "LWCF"                  "LONG WAVE CLOUD FORCING AT TOA"                      "W m-2"
+state    real  OLR              ij      misc        1         -      rh        "OLR"                   "TOA OUTGOING LONG WAVE"                              "W m-2"
+
+# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling
+# with wave model, only if compiled with -DMCELIO, JM 2003/05/29
+state    real  XLAT             ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLAT"                "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG            ij      misc        1         -     i0123rh01du=(copy_fcnm)      "XLONG"               "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_U           ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLAT_U"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_U          ij      dyn_em      1         X     i012rh01du=(copy_fcnm)       "XLONG_U"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  XLAT_V           ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLAT_V"              "LATITUDE, SOUTH IS NEGATIVE"                                          "degree_north"
+state    real  XLONG_V          ij      dyn_em      1         Y     i012rh01du=(copy_fcnm)       "XLONG_V"             "LONGITUDE, WEST IS NEGATIVE"                                          "degree_east"
+state    real  ALBEDO           ij      misc        1         -      rh          "ALBEDO"                   "ALBEDO"
+state    real  CLAT             ij      misc        1         -     i012rdu=(copy_fcnm)          "CLAT"                "COMPUTATIONAL GRID LATITUDE, SOUTH IS NEGATIVE"                       "degree_north"
+state    real  CLONG            ij      misc        1         -     i012rdu=(copy_fcnm)          "CLONG"               "COMPUTATIONAL GRID LONGITUDE, WEST IS NEGATIVE"                       "degree_east"
+state    real  ALBBCK           ij      misc        1         -     i0124rh   "ALBBCK"                "BACKGROUND ALBEDO"        ""
+state    real  EMBCK            ij      misc        1         -      r        "EMBCK"                 "BACKGROUND EMISSIVITY"         ""
+state    real  EMISS            ij      misc        1         -      rh       "EMISS"                 "SURFACE EMISSIVITY"         "" 
+
+state    real  CLDEFI           ij      misc        1         -      r        "CLDEFI"                "precipitation efficiency in BMJ SCHEME"    ""      
+state integer  STEPRA          -        misc        1         -      r        "STEPRA"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS"        ""
+                                                
+state    real  RUBLTEN         ikj      misc        1         -      r        "RUBLTEN"               "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RVBLTEN         ikj      misc        1         -      r        "RVBLTEN"               "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION"  "Pa m s-2"
+state    real  RTHBLTEN        ikj      misc        1         -      r        "RTHBLTEN"              "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION"   "Pa K s-1"
+state    real  RQVBLTEN        ikj      misc        1         -      r        "RQVBLTEN"              "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQCBLTEN        ikj      misc        1         -      r        "RQCBLTEN"              "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"
+state    real  RQIBLTEN        ikj      misc        1         -      r        "RQIBLTEN"              "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION"     "Pa kg kg-1 s-1"      
+
+# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting.
+state    real  mp_restart_state   p      misc        1         -      r       "MP_RESTART_STATE"       "STATE VECTOR FOR MICROPHYSICS RESTARTS"
+state    real  tbpvs_state        p      misc        1         -      r        "TBPVS_STATE"           "STATE FOR ETAMPNEW MICROPHYSICS"
+state    real  tbpvs0_state       p      misc        1         -      r        "TBPVS0_STATE"          "STATE FOR ETAMPNEW MICROPHYSICS"
+
+# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in
+# landuse_init (phys/module_physics_init.F)
+state    integer  landuse_isice   -      misc       -          -     r
+state    integer  landuse_lucats  -      misc       -          -     r
+state    integer  landuse_luseas  -      misc       -          -     r
+state    integer  landuse_isn     -      misc       -          -     r
+state    real     lu_state        p      misc       -          -     r
+
+i1       real  th_phy          ikj      misc        1         -                                          
+i1       real  pi_phy          ikj      misc        1         -                                          
+i1       real  p_phy           ikj      misc        1         -                                          
+i1       real  t_phy           ikj      misc        1         -                                          
+i1       real  u_phy           ikj      misc        1         -                                          
+i1       real  v_phy           ikj      misc        1         -                                          
+i1       real  dz8w            ikj      misc        1         Z                                          
+i1       real  p8w             ikj      misc        1         Z                                          
+i1       real  t8w             ikj      misc        1         Z                                          
+i1       real  rho_phy         ikj      misc        1         -                                          
+i1    logical  CU_ACT_FLAG     ij       misc        1         -
+
+                                                
+state    real  TMN              ij      misc        1         -     i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)     "TMN"                   "SOIL TEMPERATURE AT LOWER BOUNDARY"           "K"
+state    real  XLAND            ij      misc        1         -     i02rhd=(interp_fcnm)u=(copy_fcnm)       "XLAND"                 "LAND MASK (1 FOR LAND, 2 FOR WATER)"          ""      
+state    real  ZNT              ij      misc        1         -      i3r      "ZNT"                   "TIME-VARYING ROUGHNESS LENGTH"                "m"      
+state    real  CK               ij      misc        1         -      r        "CK"                    "ENTHALPY EXCHANGE COEFF AT 10 m"                      ""
+state    real  CKA              ij      misc        1         -      r        "CKA"                   "ENTHALPY EXCHANGE COEFF AT LOWEST MODEL LVL"          ""
+state    real  CD               ij      misc        1         -      r        "CD"                    "DRAG COEFF AT 10m"                      ""
+state    real  CDA              ij      misc        1         -      r        "CDA"                   "DRAG COEFF AT LOWEST MODEL LVL"                      ""
+state    real  UST              ij      misc        1         -      rh       "UST"                   "U* IN SIMILARITY THEORY"                      "m s-1"      
+state    real  USTM             ij      misc        1         -      r        "USTM"                  "U* IN SIMILARITY THEORY WITHOUT VCONV"        "m s-1"
+i1       real  HOL              ij      misc        1         -      -        "HOL"                   "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH"         ""
+state    real  RMOL             ij      misc        1         -      r        "RMOL"                  "1./Monin Ob. Length"                      ""
+state    real  MOL              ij      misc        1         -      r        "MOL"                   "T* IN SIMILARITY THEORY"                      "K"      
+state    real  PBLH             ij      misc        1         -      rh       "PBLH"                  "PBL HEIGHT"         "m"      
+state    real  CAPG             ij      misc        1         -      r        "CAPG"                  "HEAT CAPACITY FOR SOIL"                       "J K-1 m-3"      
+state    real  THC              ij      misc        1         -      r        "THC"                   "THERMAL INERTIA"                              "Cal cm-1 K-1 s-0.5"      
+state    real  HFX              ij      misc        1         -      rh       "HFX"                   "UPWARD HEAT FLUX AT THE SURFACE"              "W m-2"      
+state    real  QFX              ij      misc        1         -      rh       "QFX"                   "UPWARD MOISTURE FLUX AT THE SURFACE"          "kg m-2 s-1"      
+state    real  LH               ij      misc        1         -      rh       "LH"                    "LATENT HEAT FLUX AT THE SURFACE"              "W m-2"
+state    real  FLHC             ij      misc        1         -      r        "FLHC"                  "SURFACE EXCHANGE COEFFICIENT FOR HEAT"       ""
+state    real  FLQC             ij      misc        1         -      r        "FLQC"                  "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE"   ""
+state    real  QSG              ij      misc        1         -      r        "QSG"                   "SURFACE SATURATION WATER VAPOR MIXING RATIO"   "kg kg-1"
+state    real  QVG              ij      misc        1         -      r        "QVG"                   "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  dfi_QVG          ij      misc        1         -      r        "QVG_dfi"               "WATER VAPOR MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  QCG              ij      misc        1         -      r        "QCG"                   "CLOUD WATER MIXING RATIO AT THE SURFACE"      "kg kg-1"
+state    real  SOILT1           ij      misc        1         -      r        "SOILT1"                "TEMPERATURE INSIDE SNOW "    "K"
+state    real  dfi_SOILT1       ij      misc        1         -      r        "SOILT1_dfi"            "TEMPERATURE INSIDE SNOW "    "K"
+state    real  TSNAV            ij      misc        1         -      r        "TSNAV"                 "AVERAGE SNOW TEMPERATURE "                    "C"
+state    real  dfi_TSNAV        ij      misc        1         -      r        "TSNAV_dfi"             "AVERAGE SNOW TEMPERATURE "                    "C"
+state    real  REGIME           ij      misc        1         -      r        "REGIME"  "FLAGS: 1=Night/Stable, 2=Mechanical Turbulent, 3=Forced Conv, 4=Free Conv" ""
+state    real  SNOWC            ij      misc        1         -     irhd=(interp_mask_land_field:lu_index)u=(copy_fcnm)      "SNOWC"                 "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  dfi_SNOWC        ij      misc        1         -      r        "SNOWC_dfi"             "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)"         ""
+state    real  MAVAIL           ij      misc        1         -      r        "MAVAIL"                "SURFACE MOISTURE AVAILABILITY"                ""
+                                                
+state   real   tkesfcf          ij      misc        1         -      r        "tkesfcf"               "TKE AT THE SURFACE"                           "m2 s-2"      
+                                                
+state integer  STEPBL          -        misc        1         -      r        "STEPBL"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" ""      
+state    real  taucldi         ikj      misc        1         -      r        "TAUCLDI"               "CLOUD OPTICAL THICKNESS FOR ICE"              ""
+state    real  taucldc         ikj      misc        1         -      r        "TAUCLDC"               "CLOUD OPTICAL THICKNESS FOR WATER"            ""
+                                                
+state   real  defor11          ikj      misc        1         -     r         "defor11"               "DEFORMATION 11"              "s-1"      
+state   real  defor22          ikj      misc        1         -     r         "defor22"               "DEFORMATION 22"              "s-1"      
+state   real  defor12          ikj      misc        1         -     r         "defor12"               "DEFORMATION 12"              "s-1"      
+state   real  defor33          ikj      misc        1         z     r         "defor33"               "DEFORMATION 33"              "s-1"      
+state   real  defor13          ikj      misc        1         z     r         "defor13"               "DEFORMATION 13"              "s-1"      
+state   real  defor23          ikj      misc        1         z     r         "defor23"               "DEFORMATION 23"              "s-1"      
+state   real   xkmv            ikj      misc        1         -     r         "xkmv"                  "VERTICAL EDDY VISCOSITY"     "m2 s-1"      
+state   real   xkmh            ikj      misc        1         -     r         "xkmh"                  "HORIZONTAL EDDY VISCOSITY"   "m2 s-1"      
+state   real   xkhv            ikj      misc        1         -     r         "xkhv"                  "VERTICAL EDDY DIFFUSIVITY OF HEAT"                               "m2 s-1"      
+state   real   xkhh            ikj      misc        1         -     r         "xkhh"                  "HORIZONTAL EDDY DIFFUSIVITY OF HEAT"                             "m2 s-1"      
+state   real    div            ikj      misc        1         -     r         "div"                   "DIVERGENCE"                                                      "s-1"
+state   real    BN2            ikj      misc        1         -     r         "BN2"                   "BRUNT-VAISALA FREQUENCY"                                         "s-2"
+state  logical warm_rain        -       misc        1         -     -         "warm_rain"              "WARM_RAIN_LOGICAL"
+state  logical adv_moist_cond   -       misc        1         -     -         "adv_moist_cond"         "ADVECT MOIST CONDENSATES LOGICAL"
+
+## FDDA variables
+
+state integer  STEPFG            -        misc        1         -      r        "STEPFG"                "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" ""
+state    real  RUNDGDTEN         ikj      misc        1         X      r        "RUNDGDTEN"               "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RVNDGDTEN         ikj      misc        1         Y      r        "RVNDGDTEN"               "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING"  "Pa m s-2"
+state    real  RTHNDGDTEN        ikj      misc        1         -      r        "RTHNDGDTEN"              "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING"   "Pa K s-1"
+state    real  RQVNDGDTEN        ikj      misc        1         -      r        "RQVNDGDTEN"              "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING"     "Pa kg kg-1 s-1"
+state    real  RMUNDGDTEN        ij       misc        1         -      r        "RMUNDGDTEN"              "MU TENDENCY DUE TO FDDA GRID NUDGING"     "Pa s-1"
+state    real    -               ikjf     fdda3d      1         -     -    -
+state    real  U_NDG_NEW         ikjf     fdda3d      1         X      igr      "U_NDG_NEW"               "NEW X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_NEW         ikjf     fdda3d      1         Y      igr      "V_NDG_NEW"               "NEW Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_NEW         ikjf     fdda3d      1         -      igr      "T_NDG_NEW"               "NEW PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_NEW         ikjf     fdda3d      1         -      igr      "Q_NDG_NEW"               "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_NEW        ikjf     fdda3d      1         Z      igr      "PH_NDG_NEW"              "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  U_NDG_OLD         ikjf     fdda3d      1         X      igr      "U_NDG_OLD"               "OLD X WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  V_NDG_OLD         ikjf     fdda3d      1         Y      igr      "V_NDG_OLD"               "OLD Y WIND FOR FDDA GRID NUDGING"  "m s-1"
+state    real  T_NDG_OLD         ikjf     fdda3d      1         -      igr      "T_NDG_OLD"               "OLD PERT POT TEMP FOR FDDA GRID NUDGING"  "K"
+state    real  Q_NDG_OLD         ikjf     fdda3d      1         -      igr      "Q_NDG_OLD"               "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING"  "kg/kg"
+state    real  PH_NDG_OLD        ikjf     fdda3d      1         Z      igr      "PH_NDG_OLD"              "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING"  "kg/kg"
+state    real    -               ivjf     fdda2d      1         Z     -    -
+state    real  MU_NDG_NEW        ivjf     fdda2d      1         Z      igr      "MU_NDG_NEW"              "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  T2_NDG_NEW        ivjf     fdda2d      1         -      igr      "T2_NDG_NEW"               "NEW 2m TEMP FOR PX LSM "  "K"
+state    real  Q2_NDG_NEW        ivjf     fdda2d      1         -      igr      "Q2_NDG_NEW"               "NEW 2m WATER VAPOR MIX RATIO FOR PX LSM "  "kg/kg"
+state    real  MU_NDG_OLD        ivjf     fdda2d      1         Z      igr      "MU_NDG_OLD"              "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING"  "Pa"
+state    real  T2_NDG_OLD        ivjf     fdda2d      1         -      igr      "T2_NDG_OLD"               "OLD 2m TEMP F FOR PX LSM"  "K"
+state    real  Q2_NDG_OLD        ivjf     fdda2d      1         -      igr      "Q2_NDG_OLD"               "OLD 2m WATER VAPOR MIX RATIO  FOR PX LSM"  "kg/kg"
+state    real  SN_NDG_NEW        ivjf     fdda2d      1         -      igr      "SN_NDG_NEW"               "NEW Snow Depth "  "m"
+state    real  SN_NDG_OLD        ivjf     fdda2d      1         -      igr      "SN_NDG_OLD"               "OLD Snow Depth"  "m"
+
+
+# flag for nest movement
+state  logical moved            -       misc        1         -     -          
+
+# special cam radiation restart arrays
+state  real   abstot   ikcj   misc      1    Z   -     ""   ""  " "
+state  real   absnxt   ikaj   misc      1    -   -     ""   ""  " "
+state  real   emstot   ikj    misc      1    Z   -     ""   ""  " "
+
+# model diagnostics
+state   real  dpsdt            ij       misc        1         -     -         "dpsdt"           "surface pressure tendency"                         "Pa/sec"
+state   real  dmudt            ij       misc        1         -     -         "dmudt"           "mu tendency"                                       "Pa/sec"
+state   real  pk1m             ij       misc        1         -     -         "pk1m"            "surface pressure at previous step"                 "Pa"
+state   real  mu_2m            ij       misc        1         -     -         "mu_2m"           "mu_2 at previous step"                             "Pa"
+
+state   real    max_cfl         -       misc        1         -     -       "max_cfl"           "maximum CFL value in grid at a time" "-"
+
+# Ocean Mixed-Layer State Variables
+state   real    TML            ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "TML"    "OCEAN MIXED-LAYER TEMPERATURE"   "K"
+state   real    T0ML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "T0ML"   "INITIAL OCEAN MIXED-LAYER TEMPERATURE"   "K"
+state   real    HML            ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HML"    "OCEAN MIXED-LAYER DEPTH"   "m"
+state   real    H0ML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "H0ML"   "INITIAL OCEAN MIXED-LAYER DEPTH"   "m"
+state   real    HUML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HUML"   "OCEAN MIXED-LAYER DEPTH * U-CURRENT"  " m2s-1 "
+state   real    HVML           ij      misc         1         -     rd=(interp_mask_water_field:lu_index)u=(copy_fcnm)    "HVML"   "OCEAN MIXED-LAYER DEPTH * V-CURRENT"  " m2s-1 " 
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+#                                               
+
+######                                          
+#                                               
+# Variables that are set at run-time to control configuration  (namelist-settable)                                              
+#                                               
+#<Table>  <Type>  <Sym>                   <How set>          <Nentries>   <Default>                                             
+
+
+# Time Control
+rconfig   integer run_days                namelist,time_control		1             0       irh   "run_days"              "NUMBER OF DAYS TO RUN"
+rconfig   integer run_hours               namelist,time_control		1             0       irh   "run_hours"             "NUMBER OF HOURS TO RUN"
+rconfig   integer run_minutes             namelist,time_control		1             0       irh   "run_minutes"           "NUMBER OF MINUTES TO RUN"
+rconfig   integer run_seconds             namelist,time_control		1             0       irh   "run_seconds"           "NUMBER OF SECONDS TO RUN"
+rconfig   integer start_year              namelist,time_control 	max_domains    1993    irh   "start_year"            "4 DIGIT YEAR OF START OF MODEL" "YEARS"
+rconfig   integer start_month             namelist,time_control		max_domains      03    irh   "start_month"           "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS"
+rconfig   integer start_day               namelist,time_control		max_domains      13    irh   "start_day"             "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS"
+rconfig   integer start_hour              namelist,time_control		max_domains      12    irh   "start_hour"            "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS"
+rconfig   integer start_minute            namelist,time_control		max_domains      00    irh   "start_minute"          "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES"
+rconfig   integer start_second            namelist,time_control		max_domains      00    irh   "start_second"          "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS"
+rconfig   integer end_year                namelist,time_control		max_domains    1993    irh   "end_year"              "4 DIGIT YEAR OF END OF MODEL" "YEARS"
+rconfig   integer end_month               namelist,time_control		max_domains      03    irh   "end_month"             "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS"
+rconfig   integer end_day                 namelist,time_control		max_domains      14    irh   "end_day"               "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS"
+rconfig   integer end_hour                namelist,time_control		max_domains      12    irh   "end_hour"              "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS"
+rconfig   integer end_minute              namelist,time_control		max_domains      00    irh   "end_minute"            "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES"
+rconfig   integer end_second              namelist,time_control		max_domains      00    irh   "end_second"            "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS"
+rconfig   integer interval_seconds        namelist,time_control		1             43200    irh   "interval_seconds"      "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS"
+rconfig   logical input_from_file         namelist,time_control		max_domains    .false. irh    "input_from_file"      "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE"  ""
+rconfig   integer fine_input_stream       namelist,time_control		max_domains    0       irh    "fine_input_stream"      "0 THROUGH 11, WHAT INPUT STREAM IS FINE GRID IC FROM"  ""
+rconfig   logical input_from_hires        namelist,time_control		max_domains    .false. irh    "input_from_hires"     "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN"  ""
+rconfig   character rsmas_data_path       namelist,time_control		1              "."     -    "rsmas_data_path"      ""  ""
+rconfig   logical all_ic_times            namelist,time_control		1              .false. irh    "all_ic_times"     "T/F WRITE ALL IC TIME PERIODS"  ""
+
+include registry.io_boilerplate
+
+rconfig   integer JULYR                   namelist,time_control		max_domains    0       h    "JULYR"                 ""      ""
+rconfig   integer JULDAY                  namelist,time_control		max_domains    1       h    "JULDAY"                ""      ""
+rconfig   real    GMT                     namelist,time_control		max_domains    0.      h    "GMT"           ""      ""
+rconfig   character  input_inname      namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   infile"   ""      ""
+rconfig   character  input_outname     namelist,time_control		1  "wrfinput_d<domain>"          -     "name of input   outfile"  ""      ""
+rconfig   character  bdy_inname        namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary infile"  ""      ""
+rconfig   character  bdy_outname       namelist,time_control		1  "wrfbdy_d<domain>"            -     "name of boundary outfile" ""      ""
+rconfig   character  rst_inname        namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt infile"    ""      ""
+rconfig   character  rst_outname       namelist,time_control		1  "wrfrst_d<domain>_<date>"     -     "name of restrt outfile"   ""      ""
+rconfig   logical write_input             namelist,time_control		1             .false. -    "write input data for 3dvar etc."              ""      ""
+rconfig   logical write_restart_at_0h     namelist,time_control		1             .false. h    "write_restart_at_0h"              ""      ""
+rconfig   logical adjust_output_times     namelist,time_control         1             .false. -    "adjust_output_times"
+rconfig   logical adjust_input_times      namelist,time_control         1             .false. -    "adjust_input_times"
+
+rconfig   integer diag_print              namelist,time_control         1              0      -    "print out time series of model diagnostics"
+rconfig   logical nocolons                namelist,time_control         1             .false. -    "nocolons"
+
+# DFI namelist
+rconfig   integer dfi_opt                namelist,dfi_control   1       0     rh   "dfi_opt"                ""      ""
+rconfig   integer dfi_nfilter            namelist,dfi_control   1       7     rh   "dfi_nfilter"                "Digital filter type"      ""
+rconfig   logical dfi_write_filtered_input  namelist,dfi_control  1  .true.   rh   "dfi_write_filtered_input"                "Write a wrfinput_filtered_d0n file?"      ""
+rconfig   logical dfi_write_dfi_history  namelist,dfi_control   1   .false.   rh   "dfi_write_dfi_history"    "Write history files during filtering?"      ""
+rconfig   integer dfi_cutoff_seconds     namelist,dfi_control   1    3600     rh   "dfi_cutoff_seconds"       "Digital filter cutoff time"      ""
+rconfig   integer dfi_time_dim           namelist,dfi_control   1    1000     rh   "dfi_time_dim"             "MAX DIMENSION FOR HCOEFF"
+rconfig   integer dfi_fwdstop_year       namelist,dfi_control   1    2004     rh   "dfi_fwdstop_year"         "4 DIGIT YEAR OF START OF DFI" "YEARS"
+rconfig   integer dfi_fwdstop_month      namelist,dfi_control   1      03     rh   "dfi_fwdstop_month"        "2 DIGIT MONTH OF THE YEAR OF START OF DFI" "MONTHS"
+rconfig   integer dfi_fwdstop_day        namelist,dfi_control   1      13     rh   "dfi_fwdstop_day"          "2 DIGIT DAY OF THE MONTH OF START OF DFI" "DAYS"
+rconfig   integer dfi_fwdstop_hour       namelist,dfi_control   1      12     rh   "dfi_fwdstop_hour"         "2 DIGIT HOUR OF THE DAY OF START OF DFI" "HOURS"
+rconfig   integer dfi_fwdstop_minute     namelist,dfi_control   1      00     rh   "dfi_fwdstop_minute"       "2 DIGIT MINUTE OF THE HOUR OF START OF DFI" "MINUTES"
+rconfig   integer dfi_fwdstop_second     namelist,dfi_control   1      00     rh   "dfi_fwdstop_second"       "2 DIGIT SECOND OF THE MINUTE OF START OF DFI" "SECONDS"
+rconfig   integer dfi_bckstop_year       namelist,dfi_control   1    2004     rh   "dfi_bckstop_year"         "4 DIGIT YEAR OF END OF DFI" "YEARS"
+rconfig   integer dfi_bckstop_month      namelist,dfi_control   1      03     rh   "dfi_bckstop_month"        "2 DIGIT MONTH OF THE YEAR OF END OF DFI" "MONTHS"
+rconfig   integer dfi_bckstop_day        namelist,dfi_control   1      14     rh   "dfi_bckstop_day"          "2 DIGIT DAY OF THE MONTH OF END OF DFI" "DAYS"
+rconfig   integer dfi_bckstop_hour       namelist,dfi_control   1      12     rh   "dfi_bckstop_hour"         "2 DIGIT HOUR OF THE DAY OF END OF DFI" "HOURS"
+rconfig   integer dfi_bckstop_minute     namelist,dfi_control   1      00     rh   "dfi_bckstop_minute"       "2 DIGIT MINUTE OF THE HOUR OF END OF DFI" "MINUTES"
+rconfig   integer dfi_bckstop_second     namelist,dfi_control   1      00     rh   "dfi_bckstop_second"       "2 DIGIT SECOND OF THE MINUTE OF END OF DFI" "SECONDS"
+
+# Domains
+rconfig   integer time_step               namelist,domains	1             -       ih   "time_step"     
+rconfig   integer time_step_fract_num     namelist,domains	1             0       ih   "time_step_fract_num"     
+rconfig   integer time_step_fract_den     namelist,domains	1             1       ih   "time_step_fract_den"     
+
+rconfig   integer min_time_step           namelist,domains      max_domains   -1      h    "min_time_step"
+rconfig   integer max_time_step           namelist,domains      max_domains   -1      h    "max_time_step"
+rconfig   real    target_cfl              namelist,domains      max_domains  1.2      h    "target_cfl"
+rconfig   integer max_step_increase_pct   namelist,domains      max_domains    5      h    "max_step_increase_pct"
+rconfig   integer starting_time_step      namelist,domains      max_domains   -1      h    "starting_time_step"
+rconfig   logical step_to_output_time     namelist,domains      1         .true.      h    "step_to_output_time"
+rconfig   logical use_adaptive_time_step  namelist,domains      1         .false.     h    "use_adaptive_time_step"
+
+rconfig   integer max_dom                 namelist,domains	1             1       irh  "max_dom"               ""      ""
+rconfig   integer s_we                    namelist,domains	max_domains    1       irh    "s_we"          ""      ""
+rconfig   integer e_we                    namelist,domains	max_domains    32      irh    "e_we"          ""      ""
+rconfig   integer s_sn                    namelist,domains	max_domains    1       irh    "s_sn"          ""      ""
+rconfig   integer e_sn                    namelist,domains	max_domains    32      irh    "e_sn"          ""      ""
+rconfig   integer s_vert                  namelist,domains	max_domains    1       irh    "s_vert"                ""      ""
+rconfig   integer e_vert                  namelist,domains	max_domains    31      irh    "e_vert"                ""      ""
+rconfig   integer num_metgrid_levels      namelist,domains	1              27      irh    "num_metgrid_levels"                ""      ""
+rconfig   real    p_top_requested         namelist,domains      1              5000    irh    "p_top_requested" "Pa"      ""
+rconfig   integer interp_type             namelist,domains	1              2       irh    "interp_type"  "1=interp in pressure, 2=interp in LOG pressure"  ""
+rconfig   integer extrap_type             namelist,domains	1              2       irh    "extrap_type"  "1= use 2 lowest levels, 2=constant"  ""
+rconfig   integer t_extrap_type           namelist,domains	1              2       irh    "t_extrap_type"  "1=isothermal, 2=6.5 K/km, 3=adiabatic"   ""
+rconfig   logical lowest_lev_from_sfc     namelist,domains	1             .false.  irh    "lowest_lev_from_sfc"                ""      ""
+rconfig   logical use_levels_below_ground namelist,domains	1             .true.   irh    "use_levels_below_ground"   "T/F: use input data levels below input sfc pres" ""
+rconfig   logical use_surface             namelist,domains	1             .true.   irh    "use_surface"   "T/F: use input surface level in interpolation" ""
+rconfig   integer lagrange_order          namelist,domains	1              1       irh    "lagrange_order"   "1=linear, 2=quadratic vertical interpolation"      ""
+rconfig   integer force_sfc_in_vinterp    namelist,domains	1              1       irh    "force_sfc_in_vinterp"   "number of eta levels forced to use sfc in vert interp"      ""
+rconfig   real    zap_close_levels        namelist,domains	1              500     irh    "zap_close_levels"   "delta p where level is removed in vert interp"      "Pa"
+rconfig   logical sfcp_to_sfcp            namelist,domains	1              .false. irh    "sfcp_to_sfcp"   "T/F use incoming sfc pres to compute new sfc pres"      "flag"
+rconfig   logical adjust_heights          namelist,domains	1              .false. irh    "adjust_heights"   "T/F adjust pressure level input to match 500 mb height"      "flag"
+rconfig   logical smooth_cg_topo          namelist,domains	1              .false. irh    "smooth_cg_topo"   "T/F smooth CG topo on boundarries" "flag"
+rconfig   real    dx                      namelist,domains     max_domains    200     h     "dx"        "X HORIZONTAL RESOLUTION"   "METERS"
+rconfig   real    dy                      namelist,domains   	max_domains    200     h     "dy"        "Y HORIZONTAL RESOLUTION"   "METERS"
+rconfig   integer grid_id                 namelist,domains	max_domains    1       irh    "id"            ""      ""
+rconfig   logical grid_allowed            namelist,domains	max_domains    .true.  irh    "allowed"            ""      ""
+rconfig   integer parent_id               namelist,domains	max_domains    0       h     "parent_id"             ""      ""
+rconfig   integer i_parent_start          namelist,domains	max_domains    1       rh     "i_parent_start"                ""      ""
+rconfig   integer j_parent_start          namelist,domains	max_domains    1       rh     "j_parent_start"                ""      ""
+rconfig   integer parent_grid_ratio       namelist,domains	max_domains    1       h     "parent_grid_ratio"             ""      ""
+rconfig   integer parent_time_step_ratio  namelist,domains	max_domains    1       h     "parent_time_step_ratio"                ""      ""
+rconfig   integer feedback                namelist,domains	1    1       h     "feedback"          ""      ""
+rconfig   integer smooth_option           namelist,domains	1    2       h     "smooth_option"          ""      ""
+rconfig   integer blend_width             namelist,domains	1    5       h     "blend_width"  "width of cg fg terrain blended zone"      ""
+rconfig   real    ztop                    namelist,domains	max_domains    15000.  h    "ztop"          ""      ""
+rconfig   integer moad_grid_ratio         namelist,domains	max_domains    1       h     "moad_grid_ratio"               ""      ""
+rconfig   integer moad_time_step_ratio    namelist,domains	max_domains    1       h     "moad_time_step_ratio"          ""      ""
+rconfig   integer shw                     namelist,domains	max_domains    2       h     "stencil_half_width"   "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH"  "GRID POINTS"
+rconfig   integer tile_sz_x               namelist,domains	1             0       -      "tile_sz_x"             ""      ""
+rconfig   integer tile_sz_y               namelist,domains	1             0       -      "tile_sz_y"             ""      ""
+rconfig   integer numtiles                namelist,domains	1             1       -      "numtiles"              ""      ""
+rconfig   integer nproc_x                 namelist,domains	1             -1       -      "nproc_x"              "-1 means not set"      ""
+rconfig   integer nproc_y		  namelist,domains	1             -1       -      "nproc_y"              "-1 means not set"      ""
+rconfig   integer irand                   namelist,domains	1             0       -      "irand"           ""      ""
+rconfig   real    dt                      derived              max_domains    2.      h     "dt"        "TEMPORAL RESOLUTION"      "SECONDS"
+rconfig   integer   num_moves       namelist,domains    1                0
+rconfig   integer   ts_buf_size     namelist,domains    1                200          -       "ts_buf_size"   "Size of time series buffer"
+rconfig   integer   max_ts_locs     namelist,domains    1                5            -       "max_ts_locs"   "Maximum number of time series locations"
+rconfig   integer   vortex_interval  namelist,domains   max_domains      15  -  "" "" "minutes"
+rconfig   integer   max_vortex_speed namelist,domains   max_domains      40  -  "" "" "meters per second"
+rconfig   integer   corral_dist     namelist,domains    max_domains      8
+rconfig   integer   track_level     namelist,domains    1                50000
+rconfig   integer   move_id         namelist,domains    max_moves        0
+rconfig   integer   move_interval   namelist,domains    max_moves        999999999
+rconfig   integer   move_cd_x       namelist,domains    max_moves        0
+rconfig   integer   move_cd_y       namelist,domains    max_moves        0
+rconfig   logical   swap_x          namelist,domains    max_domains    .false. rh    "swap_x"            ""      ""
+rconfig   logical   swap_y          namelist,domains    max_domains    .false. rh    "swap_y"            ""      ""
+rconfig   logical   cycle_x         namelist,domains    max_domains    .false. rh    "cycle_x"            ""      ""
+rconfig   logical   cycle_y         namelist,domains    max_domains    .false. rh    "cycle_y"            ""      ""
+rconfig   logical   reorder_mesh    namelist,domains    1              .false. rh    "reorder_mesh"       ""      ""
+rconfig   logical   perturb_input   namelist,domains    1              .false. h     "" "" ""
+rconfig   real      eta_levels      namelist,domains    max_eta        -1.
+rconfig   real      max_dz          namelist,domains    1               1000.
+
+# Physics
+######
+###### MARS SPECIFIC NAMELIST ENTRIES
+######
+rconfig  integer  mars      namelist,physics  max_domains  0        rh   "mars"      "model mode"              ""
+rconfig  real     init_TI   namelist,physics  max_domains  0        irh  "init_TI"   "thermal inertia"         ""
+rconfig  real     init_AL   namelist,physics  max_domains  0        irh  "init_AL"   "albedo"                  ""
+rconfig  real     init_U    namelist,physics  max_domains  0        irh  "init_U"    "zonal wind"              ""
+rconfig  real     init_V    namelist,physics  max_domains  0        irh  "init_V"    "meridional wind"         ""
+rconfig  integer  init_WX   namelist,physics  max_domains  0        irh  "init_WX"   "x coord"                 ""
+rconfig  integer  init_WY   namelist,physics  max_domains  0        irh  "init_WY"   "y coord"                 ""
+rconfig  real     init_MU   namelist,physics  max_domains  0        irh  "init_MU"   "zonal wind mult."        ""
+rconfig  real     init_MV   namelist,physics  max_domains  0        irh  "init_MV"   "meridional wind mult."   ""
+rconfig  logical  init_LES  namelist,physics  max_domains  .false.  irh  "init_LES"  "LES mode"                ""
+rconfig  logical  modif_wrf namelist,physics  max_domains  .true.   ir   "modif_wrf" "true if tweaked WRF"     ""
+#######
+####### MARS SPECIFIC NAMELIST ENTRIES
+#######
+rconfig   integer     mp_physics          namelist,physics	max_domains    0       rh       "mp_physics"            ""      ""
+rconfig   integer     gsfcgce_hail        namelist,physics      1              0       rh       "gsfcgce select hail/graupel"  ""      ""
+rconfig   integer     gsfcgce_2ice        namelist,physics      1              0       rh       "gsfcgce select 2ice/3ice"  ""      ""
+rconfig   integer     progn               namelist,physics      max_domains    0       rh       "progn"                 ""      ""
+rconfig   integer     ra_lw_physics       namelist,physics	max_domains    0       rh       "ra_lw_physics"         ""      ""
+rconfig   integer     ra_sw_physics       namelist,physics	max_domains    0       rh       "ra_sw_physics"         ""      ""
+rconfig   real    radt                    namelist,physics	max_domains    0       h    "RADT"          ""      ""
+rconfig   real    naer                    namelist,physics      max_domains    1e9     rh   "NAER"          ""      ""
+rconfig   integer     sf_sfclay_physics   namelist,physics	max_domains    0       rh       "sf_sfclay_physics"             ""      ""
+rconfig   integer     sf_surface_physics  namelist,physics	max_domains    0       rh       "sf_surface_physics"            ""      ""
+rconfig   integer     bl_pbl_physics      namelist,physics	max_domains    0       rh       "bl_pbl_physics"                ""      ""
+rconfig   real    BLDT                    namelist,physics	max_domains    0       h    "BLDT"          ""      ""
+rconfig   integer     cu_physics          namelist,physics	max_domains    0       rh       "cu_physics"            ""      ""
+rconfig   real    CUDT                    namelist,physics	max_domains    0       h    "CUDT"          ""      ""
+rconfig   real    GSMDT                   namelist,physics	max_domains    0       h    "GSMDT"          ""      ""
+rconfig   integer ISFFLX                  namelist,physics 	1             1       irh    "ISFFLX"                        ""      ""
+rconfig   integer IFSNOW                  namelist,physics	1             0       irh    "IFSNOW"                        ""      ""
+rconfig   integer ICLOUD                  namelist,physics	1             1       irh    "ICLOUD"                        ""      ""
+rconfig   real    swrad_scat              namelist,physics	1             1       irh    "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD"      ""
+rconfig   integer surface_input_source    namelist,physics	1             1       irh    "surface_input_source"          "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)"      ""
+rconfig   integer num_soil_layers         namelist,physics	1            10       irh    "num_soil_layers"               ""      ""
+rconfig   integer num_months              namelist,physics      1            12       irh    "num_months"               ""      ""
+rconfig   integer maxiens                 namelist,physics	1             1       irh    "maxiens"                    ""      ""
+rconfig   integer maxens                  namelist,physics	1             3       irh    "maxens"                    ""      ""
+rconfig   integer maxens2                 namelist,physics	1             3       irh    "maxens2"                    ""      ""
+rconfig   integer maxens3                 namelist,physics	1            16       irh    "maxens3"                    ""      ""
+rconfig   integer ensdim                  namelist,physics	1            144      irh    "ensdim"                    ""      ""
+rconfig   integer cugd_avedx              namelist,physics      1            1      irh    "cugd_avedx"                    ""      ""
+rconfig   integer clos_choice             namelist,physics      1             0       rh    "clos_choice"                    ""      ""
+rconfig   integer imomentum               namelist,physics      1             0       rh    "imomentum"                    "momentum transport in G3 scheme"      ""
+rconfig   integer     chem_opt            namelist,physics	max_domains    0       rh       "chem_opt"              ""      ""
+rconfig   integer num_land_cat            namelist,physics	1            24       -      "num_land_cat"                  ""      ""
+rconfig   integer num_soil_cat            namelist,physics	1            16       -      "num_soil_cat"                  ""      ""
+rconfig   integer mp_zero_out             namelist,physics	1             0       -      "mp_zero_out"  "microphysics fields set to zero  0=no action taken, 1=all fields but Qv, 2=all fields including Qv"      "flag"
+rconfig   real mp_zero_out_thresh         namelist,physics	1          1.e-8      -      "mp_zero_out_thresh"  "minimum threshold for non-Qv moist fields, below are set to zero"  "kg/kg"
+rconfig   real    seaice_threshold        namelist,physics	1            271       h    "seaice_threshold"  "tsk below which which water points are set to sea ice for slab scheme"   "K"
+rconfig   integer sst_update              namelist,physics	1            0         h    "sst_update"  "update sst from wrflowinp file  0=no, 1=yes"   ""
+rconfig   integer ucmcall                 namelist,physics      max_domains  0         h    "ucmcall"     "activate urban model  0=no, 1=yes"   ""
+rconfig   logical usemonalb               namelist,physics      1            .false.   h    "usemonalb"   "use 2d field vs table values  false=table, True=2d"   ""
+rconfig   integer co2tf                   namelist,physics	1            1         -    "co2tf" "GFDL radiation co2 flag" ""
+rconfig   integer ra_call_offset          namelist,physics	1            0         -    "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" ""
+rconfig   real    cam_abs_freq_s          namelist,physics      1         21600.      -      "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s"
+rconfig   integer levsiz                  namelist,physics      1             1       -      "levsiz" "Number of ozone data levels for CAM radiation (59)"  ""
+rconfig   integer paerlev                 namelist,physics      1             1       -      "paerlev" "Number of aerosol data levels for CAM radiation (29)"  ""
+rconfig   integer cam_abs_dim1            namelist,physics      1             1       -      "cam_abs_dim1" "dimension for absnxt in CAM radiation"  ""
+rconfig   integer cam_abs_dim2            namelist,physics      1             1       -      "cam_abs_dim2" "dimension for abstot in CAM radiation"  ""
+rconfig   logical cu_rad_feedback         namelist,physics      max_domains   .false.  -     "feedback cumulus to radiation"  ""
+rconfig   integer pxlsm_smois_init           namelist,physics  max_domains   1       irh    "PXLSM_SMOIS_INIT"    "Soil moisture initialization option 0-From analysis 1-From MAVAIL"      ""
+rconfig   integer omlcall                 namelist,physics      1            0         h     "omlcall"     "activate simple ocean mixed layer model  0=no, 1=yes"   ""
+rconfig   real    oml_hml0                namelist,physics      1            50        h     "oml_hml0"    "oml initial mixed layer depth value"   "m"
+rconfig   real    oml_gamma               namelist,physics      1            0.14      h     "oml_gamma"   "oml deep water lapse rate"   "K m-1"
+rconfig   integer isftcflx                namelist,physics      1            0         h     "isftcflx"    "switch to control sfc fluxes"   ""
+rconfig   real    shadlen                 namelist,physics      1            25000.    -     "shadow_length" "maximum length of orographic shadow" "m"
+rconfig   integer slope_rad               namelist,physics      max_domains    0       -     "slope_rad"  "1: use slope-dependent radiation, 0:not" ""
+rconfig   integer topo_shading            namelist,physics      max_domains    0       -     "topo_shading" "1: apply topographic shading to radiation, 0:not" ""
+rconfig   integer no_mp_heating           namelist,physics      1              0       -     "no_mp_heating" "switch to turn of latent heating in mp schemes"   ""
+
+#FDDA namelist parameters
+rconfig   real    FGDT                    namelist,fdda         max_domains    0       h        "FGDT"          ""      ""
+rconfig   integer  grid_fdda              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_uv   namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_t    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_no_pbl_nudging_q    namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_uv             namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_t              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer  if_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   integer   k_zfac_q              namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        guv                 namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gt                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real        gq                  namelist,fdda         max_domains    0       rh       "grid_fdda"            ""      ""
+rconfig   real    dtramp_min              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+rconfig   integer if_ramping              namelist,fdda         1              0       h        "grid_fdda"            ""      ""
+
+#Observational Nudging
+rconfig   integer     obs_nudge_opt       namelist,fdda            max_domains    0       rh       "obs_nudge_opt"     "Obs-nudging flag for domain"          ""
+rconfig   integer     max_obs             namelist,fdda            1              0       h        "max_obs"           "Maximum number of observations"       ""
+rconfig   real        fdda_start          namelist,fdda            max_domains    0       rh       "fdda_start"        "Nudging start time for domain"        "min"
+rconfig   real        fdda_end            namelist,fdda            max_domains    0       rh       "fdda_end"          "Nudging end time for domain"          "min"
+rconfig   integer     obs_nudge_wind      namelist,fdda            max_domains    0       rh       "obs_nudge_wind"    "Wind-nudging flag for domain"         ""
+rconfig   real        obs_coef_wind       namelist,fdda            max_domains    0       rh       "obs_coef_wind"     "Wind-nudging coeficient for domain"   "s-1"
+rconfig   integer     obs_nudge_temp      namelist,fdda            max_domains    0       rh       "obs_nudge_temp"    "Temperature-nudging flag for domain"  ""
+rconfig   real        obs_coef_temp       namelist,fdda            max_domains    0       rh       "obs_coef_temp"     "Temperature-nudging coef for domain"  "s-1"
+rconfig   integer     obs_nudge_mois      namelist,fdda            max_domains    0       rh       "obs_nudge_mois"    "Moisture-nudging flag for domain"     ""
+rconfig   real        obs_coef_mois       namelist,fdda            max_domains    0       rh       "obs_coef_mois"     "Moisture-nudging coef for domain"     "s-1"
+rconfig   integer     obs_nudge_pstr      namelist,fdda            max_domains    0       rh       "obs_nudge_pstr"    "Not used"                             ""
+rconfig   real        obs_coef_pstr       namelist,fdda            max_domains    0       rh       "obs_coef_pstr"     "Not used"                             ""
+rconfig   real        obs_rinxy           namelist,fdda            max_domains    0       rh       "obs_rinxy"         "Horizontal radius of influence"       "km"
+rconfig   real        obs_rinsig          namelist,fdda            1              0       h        "obs_rinsig"        "Vertical radius of influence"         "sigma"
+rconfig   real        obs_twindo          namelist,fdda            max_domains    0       rh       "obs_twindo"        "Half-period time window for nudging"  "hrs"
+rconfig   integer     obs_npfi            namelist,fdda            1              0       h        "obs_npfi"          "Freq in cg timesteps for diag print"  ""
+rconfig   integer     obs_ionf            namelist,fdda            max_domains    1       rh       "obs_ionf"          "Freq in cg timesteps for obs input and error calc"   ""
+rconfig   integer     obs_idynin          namelist,fdda            1              0       h        "obs_idynin"        "Flag for dynamic initialization"      ""
+rconfig   real        obs_dtramp          namelist,fdda            1              0       h        "obs_dtramp"        "Time period for ramping (idynin)"     "min"
+rconfig   integer     obs_nobs_prt        namelist,fdda            max_domains    0       rh       "obs_nobs_prt"      "Number of current obs to print grid coord. info."   ""
+rconfig   logical     obs_ipf_in4dob      namelist,fdda            1              .false. h        "obs_ipf_in4dob"    "Print obs input diagnostics"   ""
+rconfig   logical     obs_ipf_errob       namelist,fdda            1              .false. h        "obs_ipf_errob"     "Print obs error diagnostics"   ""
+rconfig   logical     obs_ipf_nudob       namelist,fdda            1              .false. h        "obs_ipf_nudob"     "Print obs nudge diagnostics"   ""
+rconfig   logical     obs_ipf_init        namelist,fdda            1              .true.  h        "obs_ipf_init"      "Enable obs init warning messages"   ""
+
+
+# Dynamics
+# dynamics option (see package definitions, below)
+rconfig   integer rk_ord                  namelist,dynamics	1             3       irh   "rk_order"               ""      ""
+rconfig   integer w_damping               namelist,dynamics	1             0       irh    "w_damping"             ""      ""
+# diff_opt 1=old diffusion, 2=new
+rconfig   integer diff_opt                namelist,dynamics	1             1       irh    "diff_opt"              ""      ""
+# km_opt   1=old coefs, 2=tke, 3=Smagorinksy
+rconfig   integer km_opt                  namelist,dynamics	1             1       irh    "km_opt"                ""      ""
+# km_opt_dfi is needed for backward integration in dfi
+rconfig   integer km_opt_dfi              namelist,dynamics	1             1       irh    "km_opt_dfi"                ""      ""
+rconfig   integer damp_opt                namelist,dynamics	1             0       irh    "damp_opt"              ""      ""
+rconfig   real    zdamp                   namelist,dynamics	max_domains    5000.   h    "zdamp"         ""      ""
+rconfig   real    dampcoef                namelist,dynamics     max_domains    0.      h    "dampcoef"              ""      ""
+rconfig   real    khdif                   namelist,dynamics	max_domains    0       h    "khdif"         ""      ""
+rconfig   real    kvdif                   namelist,dynamics	max_domains    0       h    "kvdif"         ""      ""
+rconfig   real    diff_6th_factor         namelist,dynamics     max_domains    0.12    h    "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion"
+rconfig   integer diff_6th_opt            namelist,dynamics     max_domains    0      irh   "diff_6th_opt" "switch for 6th-order numerical diffusion"
+rconfig   real    c_s                     namelist,dynamics	max_domains    0.25    h    "c_s"         "Smagorinsky coeff"      ""
+rconfig   real    c_k                     namelist,dynamics	max_domains    0.15    h    "c_k"         "TKE coeff"      ""
+rconfig   real    smdiv                   namelist,dynamics	max_domains    0.1     h    "smdiv"         ""      ""
+rconfig   real    emdiv                   namelist,dynamics	max_domains    0.01    h    "emdiv"         ""      ""
+rconfig   real    epssm                   namelist,dynamics	max_domains    .1      h    "epssm"         ""      ""
+rconfig   logical non_hydrostatic         namelist,dynamics	max_domains  .true.   irh  "non_hydrostatic"    ""   ""
+rconfig   integer time_step_sound         namelist,dynamics	max_domains    0       h     "time_step_sound"               ""      ""
+rconfig   integer     h_mom_adv_order     namelist,dynamics	max_domains    5       rh       "h_mom_adv_order"               ""      ""
+rconfig   integer     v_mom_adv_order     namelist,dynamics	max_domains    3       rh       "v_mom_adv_order"               ""      ""
+rconfig   integer     h_sca_adv_order     namelist,dynamics	max_domains    5       rh       "h_sca_adv_order"               ""      ""
+rconfig   integer     v_sca_adv_order     namelist,dynamics	max_domains    3       rh       "v_sca_adv_order"               ""      ""
+rconfig   logical     pd_moist            namelist,dynamics	max_domains    .false.  rh    "pd_moist"         "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_moist_dfi        namelist,dynamics	max_domains    .false.  rh    "pd_moist_dfi"    "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_chem             namelist,dynamics	max_domains    .false. rh    "pd_chem"          "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_scalar           namelist,dynamics	max_domains    .false. rh    "pd_scalar"        "positive-definite RK3 transport switch"      ""
+rconfig   logical     pd_tke              namelist,dynamics	max_domains    .false. rh    "pd_tke"           "positive-definite RK3 transport switch"      ""
+rconfig   logical top_radiation           namelist,dynamics	max_domains    .false. rh    "top_radiation"         ""      ""
+rconfig   integer mix_isotropic           namelist,dynamics	max_domains    0       h    "mix_isotropic"            "0=anistropic, 1=isotropic"      ""
+rconfig   real    mix_upper_bound         namelist,dynamics	max_domains    0.1     h    "mix_upper_bound"          "non-dimensional limit"      ""
+rconfig   logical top_lid                 namelist,dynamics     max_domains    .false. rh    "top_lid"               ""      ""
+rconfig   real    tke_upper_bound         namelist,dynamics	max_domains    1000.   h    "tke_upper_bound"            ""      ""
+rconfig   real    tke_drag_coefficient    namelist,dynamics	max_domains    0.      h    "tke_drag_coefficient"       ""      "dimensionless"
+rconfig   real    tke_heat_flux           namelist,dynamics	max_domains    0.      h    "tke_heat_flux"              ""      "K m s-1"
+rconfig   logical pert_coriolis           namelist,dynamics	max_domains  .false.  irh  "pert_coriolis"    ""   ""
+rconfig   logical coriolis2d              namelist,dynamics	max_domains  .false.  irh  "coriolis2d"    ""   ""
+rconfig   logical mix_full_fields         namelist,dynamics     max_domains  .false.  irh  "mix_full_field"   ""   ""
+rconfig   real    base_pres               namelist,dynamics	1          100000.     h    "base_pres"  "Base state pressure - do not change (10^5 Pa), real only"      "Pa"
+rconfig   real    base_temp               namelist,dynamics	1             290.     h    "base_temp"  "Base state sea level temperature, real only"      "K"
+rconfig   real    base_lapse              namelist,dynamics	1              50.     h    "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only"      "K"
+rconfig   real    fft_filter_lat          namelist,dynamics     1              45.     h    "fft_filter_lat"   ""   "grid latitude to start polar filter"
+rconfig   logical rotated_pole            namelist,dynamics     1            .false.  irh   "rotated_pole"    ""   ""
+rconfig   logical do_coriolis             namelist,dynamics	max_domains  .true.   irh  "do_coriolis"    ""   ""
+rconfig   logical do_curvature            namelist,dynamics	max_domains  .true.   irh  "do_curvature"   ""   ""
+rconfig   logical do_gradp                namelist,dynamics	max_domains  .true.   irh  "do_gradp"    ""   ""
+
+
+# Bdy_control
+rconfig   integer spec_bdy_width          namelist,bdy_control		1             5       irh    "spec_bdy_width"                ""      ""
+rconfig   integer spec_zone               namelist,bdy_control		1             1       irh    "spec_zone"                     ""      ""
+rconfig   integer relax_zone              namelist,bdy_control		1             4       irh    "relax_zone"                    ""      ""
+rconfig   logical specified               namelist,bdy_control	max_domains    .false. rh    "specified"             ""      ""
+rconfig   logical periodic_x              namelist,bdy_control	max_domains    .false. rh    "periodic_x"            ""      ""
+rconfig   logical symmetric_xs            namelist,bdy_control	max_domains    .false. rh    "symmetric_xs"          ""      ""
+rconfig   logical symmetric_xe            namelist,bdy_control	max_domains    .false. rh    "symmetric_xe"          ""      ""
+rconfig   logical open_xs                 namelist,bdy_control	max_domains    .false. rh    "open_xs"               ""      ""
+rconfig   logical open_xe                 namelist,bdy_control	max_domains    .false. rh    "open_xe"               ""      ""
+rconfig   logical periodic_y              namelist,bdy_control	max_domains    .false. rh    "periodic_y"            ""      ""
+rconfig   logical symmetric_ys            namelist,bdy_control	max_domains    .false. rh    "symmetric_ys"          ""      ""
+rconfig   logical symmetric_ye            namelist,bdy_control	max_domains    .false. rh    "symmetric_ye"          ""      ""
+rconfig   logical open_ys                 namelist,bdy_control	max_domains    .false. rh    "open_ys"               ""      ""
+rconfig   logical open_ye                 namelist,bdy_control	max_domains    .false. rh    "open_ye"               ""      ""
+rconfig   logical polar                   namelist,bdy_control	max_domains    .false. rh    "polar"                 ""      ""
+rconfig   logical nested                  namelist,bdy_control	max_domains    .false. rh    "nested"                ""      ""
+rconfig   real    spec_exp                namelist,bdy_control          1     0.      irh    "spec_exp"              ""      ""
+rconfig   integer real_data_init_type     namelist,bdy_control		1                 1    irh   "real_data_init_type"   "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES"
+
+rconfig   integer background_proc_id      namelist,grib2 	        1     255    rh    "background_proc_id"    "Background processing id for grib2"  ""
+rconfig   integer forecast_proc_id        namelist,grib2 	        1     255    rh    "forecast_proc_id"      "Analysis and forecast processing id for grib2"  ""
+rconfig   integer production_status       namelist,grib2 	        1     255    rh    "production_status"     "Background processing id for grib2"  ""
+rconfig   integer compression             namelist,grib2 	        1      40    rh    "compression"           "grib2 compression, 40 for JPEG2000 or 41 for PNG"  ""
+
+# NAMELIST DERIVED
+rconfig   integer nobs_ndg_vars           derived                       1         5       -        "num_ndg_vars"         "Number of nudging variables"          ""
+rconfig   integer nobs_err_flds           derived                       1         9       -        "num_err_flds"         "Number of error fields"               ""
+rconfig   real    cen_lat                 derived                  max_domains    0       -        "cen_lat"              "center latitude"      "degrees, negative is south"
+rconfig   real    cen_lon                 derived                  max_domains    0       -        "cen_lon"              "central longitude"      "degrees, negative is west"
+rconfig   real    truelat1                derived                  max_domains    0       -        "true_lat1"             "first standard parallel"      "degrees, negative is south"
+rconfig   real    truelat2                derived                  max_domains    0       -        "true_lat2"             "second standard parallel"      "degrees, negative is south"
+rconfig   real    moad_cen_lat            derived                  max_domains    0       -        "moad_cen_lat"             "center latitude of the most coarse grid"      "degrees, negative is south"
+rconfig   real    stand_lon               derived                  max_domains    0       -        "stand_lon"             "standard longitude, parallel to j-direction, perpendicular to i-direction "      "degrees, negative is west"
+rconfig   real    bdyfrq                  derived                  max_domains    0       -        "bdyfrq"               "lateral boundary input frequency"      "seconds"
+rconfig   integer iswater                 derived                  max_domains    0       -        "iswater"              "land use index of water"      "index category"
+rconfig   integer isice                   derived                  max_domains    0       -        "isice"                "land use index of ice"        "index category"
+rconfig   integer isurban                 derived                  max_domains    0       -        "isurban"              "land use index for 'urban and built-up"     "index category"
+rconfig   integer isoilwater              derived                  max_domains    0       -        "isoilwater"           "land use index of water for soil"        "index category"
+rconfig   integer map_proj                derived                  max_domains    0       -        "map_proj"             "domain map projection"      "0=none (Cylindrical), 1=Lambert, 2=polar, 3=Mercator"
+rconfig   integer use_wps_input           derived                       1         0       -        "use_wps_input"        "0/1 flag, using wps input"      "0=no, 1=yes"
+rconfig   integer dfi_stage               derived                       1         3       -        "dfi_stage"            "current stage of DFI processing"      "0=DFI setup, 1=DFI backward integration, 2=DFI forward integration, 3=WRF forecast"
+rconfig   integer mp_physics_dfi          derived                  max_domains   -1       -        "mp_physics_dfi"       ""      "-1 = no DFI and so no need to allocate DFI moist and scalar variables, >0 = running with DFI, so allocate DFI moist and scalar variables appropriate for selected microphysics package"
+
+#
+# Single dummy declaration to define a nodyn dyn option
+state integer nodyn_dummy - dyn_nodyn -  -  -  "" "" ""      
+
+#
+#---------------------------------------------------------------------------------------------------------------------------------------
+# Package Declarations
+#                                               
+
+#key      package       associated                package          associated 4d scalars
+#         name          namelist choice           state vars
+
+#package   passivec1     chem_opt==0                  -             
+package   passiveqv     mp_physics==0                -             moist:qv
+package   kesslerscheme mp_physics==1                -             moist:qv,qc,qr
+package   linscheme     mp_physics==2                -             moist:qv,qc,qr,qi,qs,qg
+package   wsm3scheme    mp_physics==3                -             moist:qv,qc,qr
+package   wsm5scheme    mp_physics==4                -             moist:qv,qc,qr,qi,qs
+package   etampnew      mp_physics==5                -             moist:qv,qc,qr,qi,qs,qg;scalar:qt
+package   wsm6scheme    mp_physics==6                -             moist:qv,qc,qr,qi,qs,qg
+package   gsfcgcescheme mp_physics==7                -             moist:qv,qc,qr,qi,qs,qg
+package   thompson       mp_physics==8               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni
+package   morr_two_moment  mp_physics==10            -             moist:qv,qc,qr,qi,qs,qg;scalar:qni,qns,qnr,qng
+
+package   nodfimoist        mp_physics_dfi==-1       -             -
+package   passiveqv_dfi     mp_physics_dfi==0        -             dfi_moist:dfi_qv
+package   kesslerscheme_dfi mp_physics_dfi==1        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr
+package   linscheme_dfi     mp_physics_dfi==2        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   wsm3scheme_dfi    mp_physics_dfi==3        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr
+package   wsm5scheme_dfi    mp_physics_dfi==4        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs
+package   etampnew_dfi      mp_physics_dfi==5        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qt
+package   wsm6scheme_dfi    mp_physics_dfi==6        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   gsfcgcescheme_dfi mp_physics_dfi==7        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg
+package   thompson_dfi      mp_physics_dfi==8        -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni
+package   morr_two_moment_dfi  mp_physics_dfi==10    -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni,dfi_qns,dfi_qnr,dfi_qng
+
+package   noprogn       progn==0                     -             -
+package   progndrop     progn==1                     -             scalar:qndrop;dfi_scalar:dfi_qndrop
+
+package   rrtmscheme    ra_lw_physics==1             -             -
+package   camlwscheme   ra_lw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdllwscheme  ra_lw_physics==99            -             -
+package   heldsuarez    ra_lw_physics==31            -             -
+
+package   swradscheme   ra_sw_physics==1             -             -
+package   gsfcswscheme  ra_sw_physics==2             -             -
+package   camswscheme   ra_sw_physics==3             -             ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc
+package   gfdlswscheme  ra_sw_physics==99            -             -
+
+package   sfclayscheme   sf_sfclay_physics==1        -             state:regime
+package   myjsfcscheme   sf_sfclay_physics==2        -             -
+package   gfssfcscheme   sf_sfclay_physics==3        -             -
+package   pxsfcscheme    sf_sfclay_physics==7        -             state:regime
+
+package   slabscheme     sf_surface_physics==1       -             -
+package   lsmscheme      sf_surface_physics==2       -             -
+package   ruclsmscheme   sf_surface_physics==3       -             -
+package   pxlsmscheme    sf_surface_physics==7       -             fdda2d:t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old
+
+package   ysuscheme      bl_pbl_physics==1           -             state:regime
+package   myjpblscheme   bl_pbl_physics==2           -             -
+package   gfsscheme      bl_pbl_physics==3           -             -
+package   acmpblscheme   bl_pbl_physics==7           -             state:regime
+package   mrfscheme      bl_pbl_physics==99          -             state:regime
+
+package   kfetascheme    cu_physics==1               -             -
+package   bmjscheme      cu_physics==2               -             -
+package   gdscheme       cu_physics==3               -             -
+package   sasscheme      cu_physics==4               -             -
+package   g3scheme       cu_physics==5               -             state:cugd_qvten,cugd_tten,cugd_qvtens,cugd_ttens,cugd_qcten
+package   kfscheme       cu_physics==99              -             -
+
+package   psufddagd      grid_fdda==1                -             fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new,t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old,sn_ndg_new,sn_ndg_old;state:rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten
+
+package   restofwrf      use_wps_input==0            -             -
+
+package   dfi_setup      dfi_stage==0                -             -
+package   dfi_bck        dfi_stage==1                -             -
+package   dfi_fwd        dfi_stage==2                -             -
+package   dfi_fst        dfi_stage==3                -             -
+
+#package   digifilter     dfi_opt==1                  -             dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qndrop,dfi_qni,dfi_qt,dfi_qns,dfi_qnr,dfi_qng;state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt
+package   dfi_nodfi     dfi_opt==0                  -             -
+package   dfi_dfl       dfi_opt==1                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+package   dfi_ddfi      dfi_opt==2                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+package   dfi_tdfi      dfi_opt==3                  -             state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG
+ifdef RUC_CLOUD
+package   realonly       use_wps_input==1            -             state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc,qr_gc,qc_gc,qs_gc,qi_gc,qg_gc,qni_gc
+endif
+ifndef RUC_CLOUD
+package   realonly       use_wps_input==1            -             state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc
+endif
+
+
+# only need to specify these once; not for every io_form* variable
+package   io_intio    io_form_restart==1                     -             -
+package   io_netcdf   io_form_restart==2                     -             -
+# Placeholders for additional packages (we can go beyond zzz
+# but that will entail modifying frame/module_io.F and frame/md_calls.m4)
+# Please note these are placeholders; HDF has not been implemented yet.
+package   io_hdf      io_form_restart==3                     -             -
+package   io_phdf5    io_form_restart==4                     -             -
+package   io_grib1    io_form_restart==5                     -             -
+package   io_mcel     io_form_restart==6                     -             -
+package   io_esmf     io_form_restart==7                     -             -
+package   io_yyy      io_form_restart==8                     -             -
+package   io_zzz      io_form_restart==9                     -             -
+package   io_grib2    io_form_restart==10                    -             -
+package   io_pnetcdf  io_form_restart==11                     -             -
+                                                
+#---------------------------------------------------------------------------------------------------------------------------------------
+## communications                                               
+
+### 8. Edit the Registry file and create a halo-exchange for x_1.
+
+# Halo Update Communications
+
+halo      HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2
+halo      HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb
+halo      HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb
+halo      HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,f,e,sina,cosa,ht,potevp,snopcx,soiltb,xlat,xlong,xlat_u,xlat_v,xlong_u,xlong_v,clat,clong
+halo      HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar
+halo      HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb
+halo      HALO_EM_A dyn_em  8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut
+halo      HALO_EM_PHYS_A  dyn_em 4:u_2,v_2
+halo      HALO_EM_PHYS_PBL dyn_em        4:rublten,rvblten
+halo      HALO_EM_FDDA dyn_em            4:rundgdten,rvndgdten
+halo      HALO_EM_PHYS_DIFFUSION dyn_em  4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkhv,xkhh,tke_1,tke_2
+halo      HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2
+halo      HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2
+halo      HALO_EM_TKE_A dyn_em 4:ph_2,phb
+halo      HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy
+halo      HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw,ustm
+halo      HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div
+halo      HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkhv,xkhh,BN2,moist
+halo      HALO_EM_TKE_3 dyn_em   24:tke_1,tke_2
+halo      HALO_EM_TKE_5 dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_7 dyn_em   80:tke_1,tke_2
+halo      HALO_EM_TKE_F dyn_em   48:tke_1,tke_2
+halo      HALO_EM_TKE_OLD_E_5 dyn_em   48:tke_1
+halo      HALO_EM_TKE_OLD_E_7 dyn_em   80:tke_1
+halo      HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+halo      HALO_EM_B2 dyn_em 4:ru_tend,rv_tend
+halo      HALO_EM_C dyn_em    4:u_2,v_2
+halo      HALO_EM_C2 dyn_em    4:ph_2,al,p,mu_2,muts,mudf
+halo      HALO_EM_D dyn_em    24:ru_m,rv_m,ww_m,mut
+halo      HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al
+halo      HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2
+halo      HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2
+halo      HALO_EM_MOIST_E_3 dyn_em 24:moist
+halo      HALO_EM_MOIST_E_5 dyn_em 48:moist
+halo      HALO_EM_MOIST_E_7 dyn_em 80:moist
+halo      HALO_CUP_G3_IN dyn_em 24:RTHFTEN,RQVFTEN,w_2
+halo      HALO_CUP_G3_OUT dyn_em 48:cugd_tten,cugd_qvten,cugd_ttens,cugd_qvtens,raincv
+halo      HALO_EM_CHEM_E_3 dyn_em 24:chem
+halo      HALO_EM_CHEM_E_5 dyn_em 48:chem
+halo      HALO_EM_CHEM_E_7 dyn_em 80:chem
+halo      HALO_EM_SCALAR_E_3 dyn_em 24:scalar
+halo      HALO_EM_SCALAR_E_5 dyn_em 48:scalar
+halo      HALO_EM_SCALAR_E_7 dyn_em 80:scalar
+halo      HALO_TOPOSHAD phys 24:ht_shad
+
+halo      HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old
+halo      HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old
+halo      HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old
+halo      HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old
+halo      HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old
+halo      HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old
+halo      HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old
+halo      HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old
+
+halo      HALO_EM_FEEDBACK   dyn_em 48:ht
+halo      HALO_EM_HYDRO_UV   dyn_em 8:u_2,v_2
+
+halo      HALO_EM_COUPLE_A   dyn_em 24:mub,mu_1,mu_2
+period    PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2
+halo      HALO_EM_COUPLE_B   dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+period    PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\
+                                       moist,chem,scalar
+
+# For moving nests
+halo      em_shift_halo_y  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+halo      em_shift_halo_x  dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2
+
+# For observational nudging
+halo      HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx
+
+# Periodic Boundary Communications
+
+period    PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,sina,cosa,e,f
+period    PERIOD_BDY_EM_MOIST dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST2 dyn_em 3:moist
+period    PERIOD_BDY_EM_CHEM2 dyn_em 3:chem
+period    PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar
+period    PERIOD_BDY_EM_MOIST_OLD dyn_em 3:moist_old
+period    PERIOD_BDY_EM_CHEM_OLD dyn_em 3:chem_old
+period    PERIOD_BDY_EM_SCALAR_OLD dyn_em 3:scalar_old
+period    PERIOD_BDY_EM_TKE_OLD dyn_em 3:tke_1
+period    PERIOD_EM_HYDRO_UV dyn_em 1:u_2,v_2
+period    PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al
+period    PERIOD_BDY_EM_A1  dyn_em 3:rdzw,rdz,z,zx,zy,ustm
+period    PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2
+period    PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten
+period    PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb
+period    PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf
+period    PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend
+period    PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfvx,msfvy,muu,msfux,msfuy,msfvx_inv
+period    PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2
+period    PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2
+
+#
+#swap SWAP_ETAMP_NEW  dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR
+#swap SWAP_WSM3       dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv
+#cycle CYCLE_TEST       dyn_em 1:xlong
+
+##
+
+# FDDA (Observational-nudging) Variables
+typedef fdob_type integer domain_tot   # total number of domains to apply obs-nudging
+typedef fdob_type integer IEODI        # end of obs data flag for current model step
+typedef fdob_type integer IWTSIG       # flag for nudging on pressure surfaces
+typedef fdob_type integer NSTAT        # number of obs stations used to nudge current model step
+typedef fdob_type integer NSTAW        # number of obs stations within current time window
+typedef fdob_type integer KTAUR        # restart model step
+typedef fdob_type integer SN_MAXCG     # coarse domain grid dimension in south-north coordinate
+typedef fdob_type integer WE_MAXCG     # coarse domain grid dimension in west-east coordinate
+typedef fdob_type integer SN_END       # ending north-south grid index
+typedef fdob_type integer LEVIDN(max_domains)   # level of nest
+typedef fdob_type real    WINDOW       # time window half-period for nudging (in minutes) 
+typedef fdob_type real    RTLAST       # time in hours of last obs used in current model step
+typedef fdob_type real    DATEND       # time in minutes after which data are asuumed to have ended
+typedef fdob_type real    RINFMN       # minimum radius of influence
+typedef fdob_type real    RINFMX       # maximum radius of influence
+typedef fdob_type real    PFREE        # pressure level (cb) where terrain effect becomes small
+typedef fdob_type real    DCON         # 1/DPSMX
+typedef fdob_type real    DPSMX        # max pres change (cb) allowed within infl range of surf obs 
+typedef fdob_type real    TFACI        # scale factor used for ramp-down in dynamic initialization
+typedef fdob_type real    KNOWN_LAT    # Latitude  of origin point (i,j)=(1,1)
+typedef fdob_type real    KNOWN_LON    # Longitude of origin point (i,j)=(1,1)
+
+# table entries are of the form
+#      <Table>  <Type>  <Sym>                <Dims>   <Use>   <NumTLev> <Stagger> <IO>     <DNAME>             <DESCRIP>     <UNITS>
+#Grid variables
+typedef fdob_type real    varobs               rz       -         1        -       -       "varobs"          "observational values in each variable"
+typedef fdob_type real    errf                 hz       -         1        -       -       "errf"            "errors between model and obs values"
+typedef fdob_type real    timeob               z        -         1        -       -       "timeob"          "model times for each observation"          "hours"
+typedef fdob_type real    nlevs_ob             z        -         1        -       -       "nlevs_ob"        "numbers of levels in sounding obs"
+typedef fdob_type real    lev_in_ob            z        -         1        -       -       "lev_in_ob"       "level in sounding-type obs"
+typedef fdob_type real    plfo                 z        -         1        -       -       "plfo"            "index for type of obs-platform"
+typedef fdob_type real    elevob               z        -         1        -       -       "elevob"          "elevation of observation"                  "meters"
+typedef fdob_type real    rio                  z        -         1        -       -       "rio"             "west-east grid coordinate"
+typedef fdob_type real    rjo                  z        -         1        -       -       "rjo"             "south-north grid coordinate"
+typedef fdob_type real    rko                  z        -         1        -       -       "rko"             "vertical grid coordinate"
+
+state fdob_type fdob - -
+
+# xpose variables for polar fft
+state    real   t_xxx          ikjx    -           1        -
+state    real   u_xxx          ikjx    -           1        X
+state    real   ru_xxx         ikjx    -           1        X
+state    real   v_xxx          ikjx    -           1        Y
+state    real   rv_xxx         ikjx    -           1        Y
+state    real   w_xxx          ikjx    -           1        Z
+state    real   ww_xxx         ikjx    -           1        Z
+state    real   ph_xxx         ikjx    -           1        Z
+state    real   dum_yyy        ikjy    -           1        -
+state    real   fourd_xxx      ikjx    -           1        -
+state    real   clat_xxx       ijx     -           1        -
+state    real   ht_xxx         ijx     -           1        -
+state    real   mf_xxx         ijx     -           1        -
+
+xpose XPOSE_POLAR_FILTER_TOPO dyn_em t_init,t_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_T  dyn_em t_2,t_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_U  dyn_em u_2,u_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_RU dyn_em ru_m,ru_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_V  dyn_em v_2,v_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_RV dyn_em rv_m,rv_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_W  dyn_em w_2,w_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_WW dyn_em ww_m,ww_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_PH dyn_em ph_2,ph_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_MOIST dyn_em moist,fourd_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_CHEM dyn_em chem,fourd_xxx,dum_yyy
+xpose XPOSE_POLAR_FILTER_SCALAR dyn_em scalar,fourd_xxx,dum_yyy
+
+##
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/Registry.bash
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/Registry.bash	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/Registry.bash	(revision 2744)
@@ -0,0 +1,193 @@
+#! /bin/bash
+#
+# This is a script to generate FORTRAN code from registry
+#
+# A. Spiga - 17/03/08
+#
+
+
+#
+#
+#
+echo AUTOMATIC FILE GENERATION
+grep '#SAVEMARS2' Registry.EM | grep 'rhd' > fromregistry2
+grep '#SAVEMARS3' Registry.EM | grep 'rhd' > fromregistry3
+yeah2=$(awk 'END {print NR}' fromregistry2)
+yeah3=$(awk 'END {print NR}' fromregistry3)
+echo save ${yeah2} 2D arrays
+echo save ${yeah3} 3D arrays
+
+
+#
+#
+#
+\rm wrf_output_2d.h 2> /dev/null
+touch wrf_output_2d.h
+
+echo '!-------------------' >> test_include
+echo '! INCLUDE 'wrf_output_2d.h'' >> test_include
+echo '!-------------------' >> test_include
+if [ ${yeah2} -ne 0 ]
+then
+awk '{print "      INTEGER, PARAMETER :: ind_"$3" = " NR}' fromregistry2 >> test_include
+awk 'END {print "      INTEGER, PARAMETER :: n2d = " NR}' fromregistry2 >> test_include
+mv test_include wrf_output_2d.h
+else
+echo '           INTEGER, PARAMETER :: n2d = 1' >> test_include
+mv test_include wrf_output_2d.h
+fi
+
+\rm wrf_output_3d.h 2> /dev/null
+touch wrf_output_3d.h
+
+echo '!-------------------' >> test_include
+echo '! INCLUDE 'wrf_output_3d.h'' >> test_include
+echo '!-------------------' >> test_include
+if [ ${yeah3} -ne 0 ]
+then
+awk '{print "      INTEGER, PARAMETER :: ind_"$3" = " NR}' fromregistry3 >> test_include
+awk 'END {print "      INTEGER, PARAMETER :: n3d = " NR}' fromregistry3 >> test_include
+mv test_include wrf_output_3d.h
+else
+echo '           INTEGER, PARAMETER :: n3d = 1' >> test_include
+mv test_include wrf_output_3d.h
+fi
+
+
+#
+#
+#
+\rm fill_save_2d.F90 2> /dev/null
+if [ ${yeah2} -ne 0 ]
+then
+echo 'SUBROUTINE fill_save_2d( &' >> test_subroutine
+awk '{print $NF ",&"}' fromregistry2 >> test_subroutine
+echo 'ngrid,&' >> test_subroutine
+echo 'output_tab2d)' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'IMPLICIT NONE' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'include "wrf_output_2d.h"' >> test_subroutine
+#echo 'include "dimension.h"' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'INTEGER :: ngrid' >> test_subroutine
+awk '{print "REAL, DIMENSION(ngrid) :: " $NF}' fromregistry2 >> test_subroutine
+echo 'REAL, DIMENSION(ngrid,n2d) :: output_tab2d' >> test_subroutine
+echo '   ' >> test_subroutine
+awk '{print "output_tab2d(:,ind_"$3")="$NF"(:)"}' fromregistry2 >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'END SUBROUTINE fill_save_2d' >> test_subroutine
+mv test_subroutine fill_save_2d.F90
+fi
+
+\rm fill_save_3d.F90 2> /dev/null
+if [ ${yeah3} -ne 0 ]
+then
+echo 'SUBROUTINE fill_save_3d( &' >> test_subroutine
+awk '{print $NF ",&"}' fromregistry3 >> test_subroutine
+echo 'ngrid,&' >> test_subroutine
+echo 'nlayer,&' >> test_subroutine
+echo 'output_tab3d)' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'IMPLICIT NONE' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'include "wrf_output_3d.h"' >> test_subroutine
+#echo 'include "dimension.h"' >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'INTEGER :: ngrid' >> test_subroutine
+echo 'INTEGER :: nlayer' >> test_subroutine
+awk '{print "REAL, DIMENSION(ngrid,nlayer) :: " $NF}' fromregistry3 >> test_subroutine
+echo 'REAL, DIMENSION(ngrid,nlayer,n3d) :: output_tab3d' >> test_subroutine
+echo '   ' >> test_subroutine
+awk '{print "output_tab3d(:,:,ind_"$3")="$NF"(:,:)"}' fromregistry3 >> test_subroutine
+echo '   ' >> test_subroutine
+echo 'END SUBROUTINE fill_save_3d' >> test_subroutine
+mv test_subroutine fill_save_3d.F90
+fi
+
+
+#
+#
+#
+\rm fill_save.inc 2> /dev/null
+
+if [ ${yeah2} -ne 0 ]
+then
+echo '      CALL fill_save_2d(' >> fill_save.inc
+awk '{print "     . "$NF ","}' fromregistry2 >> fill_save.inc
+echo '     . ngrid,' >> fill_save.inc
+echo '     . output_tab2d)' >> fill_save.inc
+fi
+
+if [ ${yeah3} -ne 0 ]
+then
+echo '      CALL fill_save_3d(' >> fill_save.inc
+awk '{print "     . "$NF ","}' fromregistry3 >> fill_save.inc
+echo '     . ngrid,' >> fill_save.inc
+echo '     . nlayer,' >> fill_save.inc
+echo '     . output_tab3d)' >> fill_save.inc
+fi
+
+
+
+#
+#
+#
+\rm module_lmd_driver_output1.inc 2> /dev/null
+touch module_lmd_driver_output1.inc
+\rm module_lmd_driver_output2.inc 2> /dev/null
+touch module_lmd_driver_output2.inc
+\rm module_lmd_driver_output3.inc 2> /dev/null
+touch module_lmd_driver_output3.inc
+
+echo 'REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &' >> module_lmd_driver_output2.inc
+
+if [ ${yeah2} -ne 0 ]
+then
+awk '{print "       " $3 ",&"}' fromregistry2 >> module_lmd_driver_output1.inc
+more module_lmd_driver_output1.inc >> module_lmd_driver_output2.inc
+awk '{print $3"(i,j) = output_tab2d(subs,ind_"$3")"}' fromregistry2 >> module_lmd_driver_output3.inc
+fi
+
+echo '   PSFC,TSK' >> module_lmd_driver_output2.inc
+echo 'REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(OUT)  :: &' >> module_lmd_driver_output2.inc
+
+if [ ${yeah3} -ne 0 ]
+then
+awk '{print "        " $3 ",&"}' fromregistry3 >> module_lmd_driver_output1.inc
+awk '{print "        " $3 ",&"}' fromregistry3 >> module_lmd_driver_output2.inc
+echo 'DO k = kps,kpe' >> module_lmd_driver_output3.inc
+awk '{print $3"(i,k,j) = output_tab3d(subs,k,ind_"$3")"}' fromregistry3 >> module_lmd_driver_output3.inc
+echo 'ENDDO' >> module_lmd_driver_output3.inc
+fi
+
+echo '   RTHBLTEN,RUBLTEN,RVBLTEN' >> module_lmd_driver_output2.inc
+
+
+
+#
+#
+#
+\rm module_lmd_driver_output4.inc 2> /dev/null
+touch module_lmd_driver_output4.inc
+awk '{print "  &    ,"$3"=grid%"$3"   &"}' fromregistry2 >> module_lmd_driver_output4.inc
+awk '{print "  &    ,"$3"=grid%"$3"   &"}' fromregistry3 >> module_lmd_driver_output4.inc
+
+
+
+#
+#
+#
+\rm fromregistry2
+\rm fromregistry3
+mv module_lmd_driver_output?.inc ../inc/
+\rm ../mars_lmd/libf/phymars/fill_save_?d.F90 2> /dev/null
+\rm ../mars_lmd/libf/phymars/wrf_output_?d.h 2> /dev/null
+mv fill_save.inc fill_save_?d.F90 wrf_output_?d.h ../mars_lmd/libf/phymars/
+
+#
+#
+#
+echo END of AUTOMATIC FILE GENERATION
+echo I guess you modified 'Registry.EM' ... 
+echo ... so remove the file 'Registry' and recompile the model
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/bench12proc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/bench12proc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/bench12proc	(revision 2744)
@@ -0,0 +1,55 @@
+taskid: 0 hostname: auric
+ Quilting with   1 groups of   0 I/O tasks.
+ Namelist dfi_control not found in namelist.input. Using registry defaults for variables in dfi_control
+  Ntasks in X             3 , ntasks in Y             4
+ WRF V3.0.1.1 MODEL
+  *************************************
+  Parent domain
+  ids,ide,jds,jde             1          157            1          157
+  ims,ime,jms,jme            -4           59           -4           46
+  ips,ipe,jps,jpe             1           52            1           39
+  *************************************
+ DYNAMICS OPTION: Eulerian Mass Coordinate
+   med_initialdata_input: calling input_model_input
+  STEPRA,STEPCU,STEPBL        17760            1            1
+Timing for Writing wrfout_d01_2024-01-01_00:00:00 for domain        1:    1.38000 elapsed seconds.
+ WRF NUMBER OF TILES =   1
+Timing for main: time 2024-01-01_00:00:00 on domain   1:    8.88800 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:01 on domain   1:    2.27500 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:01 on domain   1:    2.21200 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:02 on domain   1:    2.39500 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:02 on domain   1:    2.23700 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:03 on domain   1:    2.23500 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:03 on domain   1:    2.21800 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:04 on domain   1:    2.17900 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:04 on domain   1:    2.30400 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:05 on domain   1:    2.27200 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:05 on domain   1:    2.46300 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:06 on domain   1:    2.20900 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:06 on domain   1:    2.17900 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:07 on domain   1:    2.14500 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:07 on domain   1:    2.22500 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:08 on domain   1:    2.11900 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:08 on domain   1:    2.23100 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:09 on domain   1:    2.20200 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:09 on domain   1:    2.30900 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:10 on domain   1:    2.16000 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:10 on domain   1:    2.17100 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:11 on domain   1:    2.28300 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:11 on domain   1:    2.24600 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:12 on domain   1:    2.11400 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:12 on domain   1:    2.10000 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:13 on domain   1:    2.20000 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:13 on domain   1:    2.24700 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:14 on domain   1:    2.24400 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:14 on domain   1:    2.14500 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:15 on domain   1:    2.21400 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:15 on domain   1:    2.73700 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:16 on domain   1:    2.13500 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:16 on domain   1:    2.18700 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:17 on domain   1:    2.45800 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:17 on domain   1:    2.21000 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:18 on domain   1:    2.19400 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:18 on domain   1:    2.41900 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:19 on domain   1:    2.27700 elapsed seconds.
+Timing for main: time 2024-01-01_00:00:19 on domain   1:    2.19700 elapsed seconds.
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/bench2proc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/bench2proc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/bench2proc	(revision 2744)
@@ -0,0 +1,200 @@
+taskid: 0 hostname: auric
+ Quilting with   1 groups of   0 I/O tasks.
+ Namelist dfi_control not found in namelist.input. Using registry defaults for variables in dfi_control
+  Ntasks in X             1 , ntasks in Y             2
+ WRF V3.0.1.1 MODEL
+  *************************************
+  Parent domain
+  ids,ide,jds,jde             1          153            1          153
+  ims,ime,jms,jme            -4          158           -4           83
+  ips,ipe,jps,jpe             1          153            1           76
+  *************************************
+ DYNAMICS OPTION: Eulerian Mass Coordinate
+   med_initialdata_input: calling input_model_input
+  STEPRA,STEPCU,STEPBL        17760            1            1
+Timing for Writing wrfout_d01_2024-01-01_12:00:00 for domain        1:    1.54700 elapsed seconds.
+ WRF NUMBER OF TILES =   1
+Timing for main: time 2024-01-01_12:00:00 on domain   1:   31.75500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:01 on domain   1:    4.03600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:01 on domain   1:    4.04900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:02 on domain   1:    4.02600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:02 on domain   1:    4.05200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:03 on domain   1:    4.00200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:03 on domain   1:    4.01800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:04 on domain   1:    4.08500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:04 on domain   1:    4.02900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:05 on domain   1:    4.07000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:05 on domain   1:    4.02400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:06 on domain   1:    4.03800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:06 on domain   1:    4.05700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:07 on domain   1:    3.99400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:07 on domain   1:    4.07800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:08 on domain   1:    4.02700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:08 on domain   1:    4.07200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:09 on domain   1:    4.03100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:09 on domain   1:    4.03900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:10 on domain   1:    4.06800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:10 on domain   1:    4.01800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:11 on domain   1:    4.06300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:11 on domain   1:    4.03800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:12 on domain   1:    4.06000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:12 on domain   1:    4.01500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:13 on domain   1:    4.01700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:13 on domain   1:    4.07800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:14 on domain   1:    4.02400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:14 on domain   1:    4.04300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:15 on domain   1:    4.02400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:15 on domain   1:    4.05300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:16 on domain   1:    4.01900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:16 on domain   1:    4.03700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:17 on domain   1:    4.07500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:17 on domain   1:    4.04000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:18 on domain   1:    4.06900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:18 on domain   1:    4.03000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:19 on domain   1:    4.04600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:19 on domain   1:    4.07200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:20 on domain   1:    3.88600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:20 on domain   1:    3.98900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:21 on domain   1:    3.83900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:21 on domain   1:    3.90600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:22 on domain   1:    3.90600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:22 on domain   1:    3.97400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:23 on domain   1:    4.08200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:23 on domain   1:    4.03000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:24 on domain   1:    4.05900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:24 on domain   1:    4.02000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:25 on domain   1:    4.04200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:25 on domain   1:    4.06900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:26 on domain   1:    4.00000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:26 on domain   1:    4.07400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:27 on domain   1:    4.02700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:27 on domain   1:    4.07000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:28 on domain   1:    3.99900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:28 on domain   1:    4.04200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:29 on domain   1:    4.06800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:29 on domain   1:    4.03300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:30 on domain   1:    4.03800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:30 on domain   1:    4.03300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:31 on domain   1:    4.06200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:31 on domain   1:    4.01200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:32 on domain   1:    4.02700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:32 on domain   1:    4.08300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:33 on domain   1:    4.02900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:33 on domain   1:    4.08200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:34 on domain   1:    4.01400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:34 on domain   1:    4.05800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:35 on domain   1:    4.05400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:35 on domain   1:    3.98900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:36 on domain   1:    4.07100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:36 on domain   1:    4.03000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:37 on domain   1:    4.06000 elapsed seconds.
+Timing for Writing wrfout_d01_2024-01-01_12:00:37 for domain        1:    0.90800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:37 on domain   1:    4.94100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:38 on domain   1:    4.06300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:38 on domain   1:    4.03400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:39 on domain   1:    3.99300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:39 on domain   1:    4.08700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:40 on domain   1:    4.02000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:40 on domain   1:    4.07200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:41 on domain   1:    3.99800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:41 on domain   1:    4.11700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:42 on domain   1:    4.03600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:42 on domain   1:    4.00000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:43 on domain   1:    4.08000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:43 on domain   1:    4.03000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:44 on domain   1:    4.07200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:44 on domain   1:    3.99100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:45 on domain   1:    4.04100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:45 on domain   1:    4.06000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:46 on domain   1:    4.03100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:46 on domain   1:    4.07100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:47 on domain   1:    4.01700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:47 on domain   1:    4.06800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:48 on domain   1:    4.04100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:48 on domain   1:    4.01700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:49 on domain   1:    4.08100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:49 on domain   1:    4.01400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:50 on domain   1:    4.07100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:50 on domain   1:    4.03100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:51 on domain   1:    4.05900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:51 on domain   1:    4.03700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:52 on domain   1:    4.00400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:52 on domain   1:    4.07900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:53 on domain   1:    4.04000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:53 on domain   1:    4.07300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:54 on domain   1:    4.00500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:54 on domain   1:    4.04600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:55 on domain   1:    4.04200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:55 on domain   1:    4.00300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:56 on domain   1:    4.07500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:56 on domain   1:    4.03700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:57 on domain   1:    4.08200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:57 on domain   1:    4.00100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:58 on domain   1:    4.04700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:58 on domain   1:    4.05900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:59 on domain   1:    4.03600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:59 on domain   1:    4.00300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:00 on domain   1:    3.83600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:00 on domain   1:    3.90900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:01 on domain   1:    3.88400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:01 on domain   1:    3.83400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:02 on domain   1:    4.06300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:02 on domain   1:    4.03200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:03 on domain   1:    4.06900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:03 on domain   1:    3.99400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:04 on domain   1:    4.05600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:04 on domain   1:    4.07800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:05 on domain   1:    4.03100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:05 on domain   1:    4.07500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:06 on domain   1:    4.01500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:06 on domain   1:    4.06200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:07 on domain   1:    4.04500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:07 on domain   1:    3.99600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:08 on domain   1:    4.07900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:08 on domain   1:    4.02000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:09 on domain   1:    4.06700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:09 on domain   1:    4.01200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:10 on domain   1:    4.06600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:10 on domain   1:    4.03400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:11 on domain   1:    4.01100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:11 on domain   1:    4.07000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:12 on domain   1:    4.04900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:12 on domain   1:    4.08100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:13 on domain   1:    4.00100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:13 on domain   1:    4.04600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:14 on domain   1:    4.04700 elapsed seconds.
+Timing for Writing wrfout_d01_2024-01-01_12:01:14 for domain        1:    0.91100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:14 on domain   1:    5.60600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:15 on domain   1:    4.04800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:15 on domain   1:    4.04200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:16 on domain   1:    4.09000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:16 on domain   1:    4.02700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:17 on domain   1:    4.08100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:17 on domain   1:    4.04200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:18 on domain   1:    4.05500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:18 on domain   1:    4.13700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:19 on domain   1:    4.03400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:19 on domain   1:    4.08800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:20 on domain   1:    4.01300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:20 on domain   1:    4.08800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:21 on domain   1:    4.04700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:21 on domain   1:    4.05300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:22 on domain   1:    4.04300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:22 on domain   1:    4.04800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:23 on domain   1:    4.08000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:23 on domain   1:    4.03800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:24 on domain   1:    4.05000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:24 on domain   1:    4.04800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:25 on domain   1:    4.03800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:25 on domain   1:    4.07000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:26 on domain   1:    4.00200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:26 on domain   1:    4.09000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:27 on domain   1:    4.02800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:27 on domain   1:    4.06600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:28 on domain   1:    4.03700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:28 on domain   1:    4.03800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:29 on domain   1:    4.08100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:29 on domain   1:    4.01700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:30 on domain   1:    4.07600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:30 on domain   1:    4.05200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:31 on domain   1:    4.06200 elapsed seconds.
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/bench4proc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/bench4proc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/bench4proc	(revision 2744)
@@ -0,0 +1,200 @@
+taskid: 0 hostname: auric
+ Quilting with   1 groups of   0 I/O tasks.
+ Namelist dfi_control not found in namelist.input. Using registry defaults for variables in dfi_control
+  Ntasks in X             2 , ntasks in Y             2
+ WRF V3.0.1.1 MODEL
+  *************************************
+  Parent domain
+  ids,ide,jds,jde             1          153            1          153
+  ims,ime,jms,jme            -4           83           -4           83
+  ips,ipe,jps,jpe             1           76            1           76
+  *************************************
+ DYNAMICS OPTION: Eulerian Mass Coordinate
+   med_initialdata_input: calling input_model_input
+  STEPRA,STEPCU,STEPBL        17760            1            1
+Timing for Writing wrfout_d01_2024-01-01_12:00:00 for domain        1:    1.99800 elapsed seconds.
+ WRF NUMBER OF TILES =   1
+Timing for main: time 2024-01-01_12:00:00 on domain   1:   17.65900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:01 on domain   1:    2.62000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:01 on domain   1:    2.67700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:02 on domain   1:    2.76500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:02 on domain   1:    2.75000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:03 on domain   1:    2.73600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:03 on domain   1:    2.79000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:04 on domain   1:    2.85200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:04 on domain   1:    2.73200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:05 on domain   1:    2.74100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:05 on domain   1:    2.76800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:06 on domain   1:    2.74500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:06 on domain   1:    2.74300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:07 on domain   1:    2.71500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:07 on domain   1:    2.77900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:08 on domain   1:    2.74000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:08 on domain   1:    2.73800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:09 on domain   1:    2.77700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:09 on domain   1:    2.72400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:10 on domain   1:    2.73600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:10 on domain   1:    2.75300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:11 on domain   1:    2.75900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:11 on domain   1:    2.74000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:12 on domain   1:    2.73000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:12 on domain   1:    2.75700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:13 on domain   1:    2.73800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:13 on domain   1:    2.74300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:14 on domain   1:    2.75900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:14 on domain   1:    2.77300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:15 on domain   1:    2.71800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:15 on domain   1:    2.74000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:16 on domain   1:    2.77400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:16 on domain   1:    2.74200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:17 on domain   1:    2.73400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:17 on domain   1:    2.75700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:18 on domain   1:    2.76100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:18 on domain   1:    2.72600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:19 on domain   1:    2.74400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:19 on domain   1:    2.78100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:20 on domain   1:    2.72200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:20 on domain   1:    2.72600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:21 on domain   1:    2.76600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:21 on domain   1:    2.75400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:22 on domain   1:    2.74500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:22 on domain   1:    2.72700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:23 on domain   1:    2.76900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:23 on domain   1:    2.73600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:24 on domain   1:    2.75000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:24 on domain   1:    2.77300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:25 on domain   1:    2.74400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:25 on domain   1:    2.74100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:26 on domain   1:    2.71100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:26 on domain   1:    2.77200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:27 on domain   1:    2.74300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:27 on domain   1:    2.73700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:28 on domain   1:    2.76600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:28 on domain   1:    2.72100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:29 on domain   1:    2.74500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:29 on domain   1:    2.74600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:30 on domain   1:    2.76000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:30 on domain   1:    2.73200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:31 on domain   1:    2.73000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:31 on domain   1:    2.75300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:32 on domain   1:    2.74300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:32 on domain   1:    2.73800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:33 on domain   1:    2.75200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:33 on domain   1:    2.78000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:34 on domain   1:    2.72100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:34 on domain   1:    2.73300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:35 on domain   1:    2.77000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:35 on domain   1:    2.74000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:36 on domain   1:    2.72700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:36 on domain   1:    2.75100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:37 on domain   1:    2.76500 elapsed seconds.
+Timing for Writing wrfout_d01_2024-01-01_12:00:37 for domain        1:    1.09000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:37 on domain   1:    3.82300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:38 on domain   1:    2.75300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:38 on domain   1:    2.77100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:39 on domain   1:    2.72100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:39 on domain   1:    2.75100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:40 on domain   1:    2.77800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:40 on domain   1:    2.74800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:41 on domain   1:    2.74500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:41 on domain   1:    2.75000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:42 on domain   1:    2.75400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:42 on domain   1:    2.90500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:43 on domain   1:    2.73800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:43 on domain   1:    2.77800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:44 on domain   1:    2.73700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:44 on domain   1:    2.70400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:45 on domain   1:    2.77600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:45 on domain   1:    2.74900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:46 on domain   1:    2.73700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:46 on domain   1:    2.73800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:47 on domain   1:    2.77000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:47 on domain   1:    2.72700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:48 on domain   1:    2.73900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:48 on domain   1:    2.76900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:49 on domain   1:    2.74200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:49 on domain   1:    2.74200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:50 on domain   1:    2.72400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:50 on domain   1:    2.78300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:51 on domain   1:    2.72600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:51 on domain   1:    2.74400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:52 on domain   1:    2.78600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:52 on domain   1:    2.72500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:53 on domain   1:    2.74800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:53 on domain   1:    2.75400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:54 on domain   1:    2.76700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:54 on domain   1:    2.72800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:55 on domain   1:    2.72500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:55 on domain   1:    2.76100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:56 on domain   1:    2.63400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:56 on domain   1:    2.61500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:57 on domain   1:    2.63500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:57 on domain   1:    2.73600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:58 on domain   1:    2.61700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:58 on domain   1:    2.63600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:59 on domain   1:    2.82300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:59 on domain   1:    2.74900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:00 on domain   1:    2.74300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:00 on domain   1:    2.74800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:01 on domain   1:    2.76900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:01 on domain   1:    2.72100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:02 on domain   1:    2.73600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:02 on domain   1:    2.77500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:03 on domain   1:    2.74700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:03 on domain   1:    2.73200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:04 on domain   1:    2.75700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:04 on domain   1:    2.77000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:05 on domain   1:    2.73700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:05 on domain   1:    2.74400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:06 on domain   1:    2.78600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:06 on domain   1:    2.74200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:07 on domain   1:    2.71000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:07 on domain   1:    2.75800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:08 on domain   1:    2.76200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:08 on domain   1:    2.74000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:09 on domain   1:    2.74600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:09 on domain   1:    2.77800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:10 on domain   1:    2.73500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:10 on domain   1:    3.04700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:11 on domain   1:    2.83100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:11 on domain   1:    2.75400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:12 on domain   1:    2.73100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:12 on domain   1:    2.72100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:13 on domain   1:    2.78200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:13 on domain   1:    2.74400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:14 on domain   1:    2.72200 elapsed seconds.
+Timing for Writing wrfout_d01_2024-01-01_12:01:14 for domain        1:    1.09400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:14 on domain   1:    4.18900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:15 on domain   1:    2.72500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:15 on domain   1:    2.74800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:16 on domain   1:    2.78300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:16 on domain   1:    2.76100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:17 on domain   1:    2.74300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:17 on domain   1:    2.74500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:18 on domain   1:    2.78300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:18 on domain   1:    2.73900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:19 on domain   1:    2.73700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:19 on domain   1:    2.88800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:20 on domain   1:    2.74500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:20 on domain   1:    2.74300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:21 on domain   1:    2.75900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:21 on domain   1:    2.76800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:22 on domain   1:    2.91100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:22 on domain   1:    2.73700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:23 on domain   1:    2.79000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:23 on domain   1:    2.74600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:24 on domain   1:    2.74300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:24 on domain   1:    2.76600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:25 on domain   1:    2.75600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:25 on domain   1:    2.95700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:26 on domain   1:    2.75700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:26 on domain   1:    2.76800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:27 on domain   1:    2.75200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:27 on domain   1:    2.74500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:28 on domain   1:    2.78000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:28 on domain   1:    2.75300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:29 on domain   1:    2.74400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:29 on domain   1:    2.76300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:30 on domain   1:    2.77500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:30 on domain   1:    2.73900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:31 on domain   1:    2.72700 elapsed seconds.
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/bench8proc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/bench8proc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/bench8proc	(revision 2744)
@@ -0,0 +1,200 @@
+taskid: 0 hostname: auric
+ Quilting with   1 groups of   0 I/O tasks.
+ Namelist dfi_control not found in namelist.input. Using registry defaults for variables in dfi_control
+  Ntasks in X             2 , ntasks in Y             4
+ WRF V3.0.1.1 MODEL
+  *************************************
+  Parent domain
+  ids,ide,jds,jde             1          153            1          153
+  ims,ime,jms,jme            -4           83           -4           45
+  ips,ipe,jps,jpe             1           76            1           38
+  *************************************
+ DYNAMICS OPTION: Eulerian Mass Coordinate
+   med_initialdata_input: calling input_model_input
+  STEPRA,STEPCU,STEPBL        17760            1            1
+Timing for Writing wrfout_d01_2024-01-01_12:00:00 for domain        1:    2.41000 elapsed seconds.
+ WRF NUMBER OF TILES =   1
+Timing for main: time 2024-01-01_12:00:00 on domain   1:   11.95300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:01 on domain   1:    2.36100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:01 on domain   1:    2.17600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:02 on domain   1:    2.28800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:02 on domain   1:    2.33000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:03 on domain   1:    2.39500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:03 on domain   1:    2.29100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:04 on domain   1:    2.32000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:04 on domain   1:    2.27200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:05 on domain   1:    2.46300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:05 on domain   1:    2.32200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:06 on domain   1:    2.28700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:06 on domain   1:    2.32200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:07 on domain   1:    2.33700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:07 on domain   1:    2.36100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:08 on domain   1:    2.31900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:08 on domain   1:    2.21900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:09 on domain   1:    2.38500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:09 on domain   1:    2.36600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:10 on domain   1:    2.28300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:10 on domain   1:    2.29000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:11 on domain   1:    2.34400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:11 on domain   1:    2.27800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:12 on domain   1:    2.28400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:12 on domain   1:    2.35100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:13 on domain   1:    2.39100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:13 on domain   1:    2.38900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:14 on domain   1:    2.30700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:14 on domain   1:    2.19400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:15 on domain   1:    2.18300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:15 on domain   1:    2.30500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:16 on domain   1:    2.35400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:16 on domain   1:    2.30000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:17 on domain   1:    2.29300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:17 on domain   1:    2.26400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:18 on domain   1:    2.30400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:18 on domain   1:    2.29600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:19 on domain   1:    2.35200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:19 on domain   1:    2.32100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:20 on domain   1:    2.30300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:20 on domain   1:    2.23100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:21 on domain   1:    2.31900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:21 on domain   1:    2.22800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:22 on domain   1:    2.33500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:22 on domain   1:    2.20600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:23 on domain   1:    2.29100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:23 on domain   1:    2.28100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:24 on domain   1:    2.30300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:24 on domain   1:    2.31700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:25 on domain   1:    2.27400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:25 on domain   1:    2.22500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:26 on domain   1:    2.28100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:26 on domain   1:    2.39300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:27 on domain   1:    2.30400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:27 on domain   1:    2.32400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:28 on domain   1:    2.27100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:28 on domain   1:    2.28400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:29 on domain   1:    2.30000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:29 on domain   1:    2.29300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:30 on domain   1:    2.38300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:30 on domain   1:    2.29700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:31 on domain   1:    2.34700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:31 on domain   1:    2.19100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:32 on domain   1:    2.29200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:32 on domain   1:    2.31900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:33 on domain   1:    2.30100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:33 on domain   1:    2.27400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:34 on domain   1:    2.28400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:34 on domain   1:    2.34500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:35 on domain   1:    2.34400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:35 on domain   1:    2.30300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:36 on domain   1:    2.24900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:36 on domain   1:    2.40300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:37 on domain   1:    2.28400 elapsed seconds.
+Timing for Writing wrfout_d01_2024-01-01_12:00:37 for domain        1:    1.17400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:37 on domain   1:    3.44800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:38 on domain   1:    2.32200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:38 on domain   1:    2.38900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:39 on domain   1:    2.34200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:39 on domain   1:    2.34700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:40 on domain   1:    2.35700 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:40 on domain   1:    2.31900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:41 on domain   1:    2.21500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:41 on domain   1:    2.33400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:42 on domain   1:    2.29500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:42 on domain   1:    2.27800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:43 on domain   1:    2.22900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:43 on domain   1:    2.36200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:44 on domain   1:    2.30400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:44 on domain   1:    2.38800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:45 on domain   1:    2.30300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:45 on domain   1:    2.36800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:46 on domain   1:    2.26400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:46 on domain   1:    2.34200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:47 on domain   1:    2.24200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:47 on domain   1:    2.29000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:48 on domain   1:    2.33500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:48 on domain   1:    2.35500 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:49 on domain   1:    2.37200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:49 on domain   1:    2.27800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:50 on domain   1:    2.36000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:50 on domain   1:    2.35600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:51 on domain   1:    2.26300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:51 on domain   1:    2.28400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:52 on domain   1:    2.34900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:52 on domain   1:    2.33100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:53 on domain   1:    2.38400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:53 on domain   1:    2.40200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:54 on domain   1:    2.34400 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:54 on domain   1:    2.35900 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:55 on domain   1:    2.20000 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:55 on domain   1:    2.30100 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:56 on domain   1:    2.09600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:56 on domain   1:    2.15600 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:57 on domain   1:    2.10200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:57 on domain   1:    2.25300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:58 on domain   1:    2.10800 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:58 on domain   1:    2.09300 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:59 on domain   1:    2.06200 elapsed seconds.
+Timing for main: time 2024-01-01_12:00:59 on domain   1:    2.26400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:00 on domain   1:    2.37800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:00 on domain   1:    2.21800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:01 on domain   1:    2.35400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:01 on domain   1:    2.27800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:02 on domain   1:    2.34600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:02 on domain   1:    2.27800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:03 on domain   1:    2.34100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:03 on domain   1:    2.27100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:04 on domain   1:    2.35700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:04 on domain   1:    2.29400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:05 on domain   1:    2.28300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:05 on domain   1:    2.29700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:06 on domain   1:    2.30100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:06 on domain   1:    2.27600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:07 on domain   1:    2.30500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:07 on domain   1:    2.24600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:08 on domain   1:    2.63100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:08 on domain   1:    2.23600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:09 on domain   1:    2.33600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:09 on domain   1:    2.33000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:10 on domain   1:    2.48000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:10 on domain   1:    2.23700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:11 on domain   1:    2.30300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:11 on domain   1:    2.35900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:12 on domain   1:    2.36700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:12 on domain   1:    2.41500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:13 on domain   1:    2.25800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:13 on domain   1:    2.36800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:14 on domain   1:    2.28100 elapsed seconds.
+Timing for Writing wrfout_d01_2024-01-01_12:01:14 for domain        1:    1.43500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:14 on domain   1:    3.98400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:15 on domain   1:    2.33700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:15 on domain   1:    2.27800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:16 on domain   1:    2.29400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:16 on domain   1:    2.23900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:17 on domain   1:    2.34400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:17 on domain   1:    2.27300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:18 on domain   1:    2.33100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:18 on domain   1:    2.30600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:19 on domain   1:    2.25600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:19 on domain   1:    2.29600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:20 on domain   1:    2.28900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:20 on domain   1:    2.33000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:21 on domain   1:    2.36600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:21 on domain   1:    2.35500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:22 on domain   1:    2.28200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:22 on domain   1:    2.34600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:23 on domain   1:    2.23200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:23 on domain   1:    2.36500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:24 on domain   1:    2.31900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:24 on domain   1:    2.40200 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:25 on domain   1:    2.38300 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:25 on domain   1:    2.33900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:26 on domain   1:    2.34600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:26 on domain   1:    2.30800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:27 on domain   1:    2.37700 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:27 on domain   1:    2.30800 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:28 on domain   1:    2.27900 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:28 on domain   1:    2.32000 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:29 on domain   1:    2.38400 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:29 on domain   1:    2.30500 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:30 on domain   1:    2.30100 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:30 on domain   1:    2.34600 elapsed seconds.
+Timing for main: time 2024-01-01_12:01:31 on domain   1:    2.34000 elapsed seconds.
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf	(revision 2744)
@@ -0,0 +1,525 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+	   -DDA_CORE=$(WRF_DA_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	32768
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+#SED_FTN = sed -f $(WRF_SRC_ROOT_DIR)/arch/standard.sed
+SED_FTN = $(WRF_SRC_ROOT_DIR)/tools/standard.exe
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = 0
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/module_utility.o
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = -I$(WRF_SRC_ROOT_DIR)/external/esmf_time_f90
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        =  $(ESMF_IO_INC)
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = 
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = esmf_time
+
+##############################################################################
+
+LIBWRFLIB = libwrflib.a
+
+
+#### Architecture specific settings ####
+
+# To enable over-decompostion with dmpar and dm+sm compiles, 
+# add -DALLOW_OVERDECOMP to ARCH_LOCAL, below. (not recommended)
+
+# Settings for Linux x86_64, PGI compiler with gcc  (serial)
+#
+DMPARALLEL      =       # 1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -mp -Minfo=mp
+SFC             =       pgf90
+SCC             =       gcc
+DM_FC           =       mpif90 -f90=$(SFC)
+DM_CC           =       mpicc -cc=$(SCC)
+FC              =        $(SFC)
+CC              =       $(SCC) -DFSEEKO64_OK 
+LD              =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -w -O3
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed # -Minfo=all =Mneginfo=all
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -Mfixed
+FORMAT_FREE     =       -Mfree
+FCSUFFIX        =
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     -module $(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+######################
+
+ARCHFLAGS       =    $(COREDEFS) -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                     $(ARCH_LOCAL) \
+                     $(DA_ARCHFLAGS) \
+                       \
+                       \
+                      -DNETCDF \
+                       \
+                       \
+                       \
+                       \
+                       \
+                       \
+                      -DGRIB1 \
+                      -DINTIO \
+                      -DLIMIT_ARGS \
+                      -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) \
+                      -DMAX_DOMAINS_F=$(MAX_DOMAINS) \
+		      -DNMM_NEST=$(WRF_NMM_NEST)
+CFLAGS          =    $(CFLAGS_LOCAL)  
+FCFLAGS         =    $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ESMF_LIB_FLAGS  =    
+ESMF_IO_LIB     =    $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/libesmf_time.a
+ESMF_IO_LIB_EXT =    -L$(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/libesmf_time.a
+INCLUDE_MODULES =    $(MODULE_SRCH_FLAG) \
+                     $(ESMF_MOD_INC) $(ESMF_LIB_FLAGS) \
+                      -I$(WRF_SRC_ROOT_DIR)/main \
+                      -I$(WRF_SRC_ROOT_DIR)/external/io_netcdf \
+                      -I$(WRF_SRC_ROOT_DIR)/external/io_int \
+                      -I$(WRF_SRC_ROOT_DIR)/frame \
+                      -I$(WRF_SRC_ROOT_DIR)/share \
+                      -I$(WRF_SRC_ROOT_DIR)/phys \
+                      -I$(WRF_SRC_ROOT_DIR)/chem -I$(WRF_SRC_ROOT_DIR)/inc \
+                       \
+                      
+REGISTRY        =    Registry
+
+LIB_BUNDLED     = \
+                     -L$(WRF_SRC_ROOT_DIR)/external/fftpack/fftpack5 -lfftpack \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_grib1 -lio_grib1 \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_grib_share -lio_grib_share \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_int -lwrfio_int \
+                     $(ESMF_IO_LIB) \
+                     $(ESMF_IO_LIB) \
+                      \
+                     $(WRF_SRC_ROOT_DIR)/frame/module_internal_header_util.o \
+                     $(WRF_SRC_ROOT_DIR)/frame/pack_utils.o 
+
+LIB_EXTERNAL    = \
+                     $(WRF_SRC_ROOT_DIR)/external/io_netcdf/libwrfio_nf.a -L/donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1/lib -lnetcdf    
+
+LIB_LMD         = \
+                     -L/donnees/aslmd/MODELES/LMD_MM_MARS/mpi_64/WRFV2/mars_lmd/libo -llmd
+
+LIB             =    $(LIB_BUNDLED) $(LIB_EXTERNAL) $(LIB_LOCAL) $(LIB_LMD)
+LDFLAGS         =    $(OMP) $(FCFLAGS) $(LDFLAGS_LOCAL) 
+ENVCOMPDEFS     =    
+WRF_CHEM	=	0 
+CPPFLAGS        =    $(ARCHFLAGS) $(ENVCOMPDEFS) -I$(LIBINCLUDE) $(TRADFLAG) 
+NETCDFPATH      =    /donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1
+PNETCDFPATH     =    
+
+bundled:  wrf_ioapi_includes wrfio_grib_share wrfio_grib1 wrfio_int esmf_time fftpack
+external:  wrfio_nf   gen_comms_serial module_dm_serial $(ESMF_TARGET)
+
+######################
+externals: bundled external
+
+gen_comms_serial :
+	( /bin/rm -f $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c )
+
+module_dm_serial :
+	( if [ ! -e module_dm.F ] ; then /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F ; fi )
+
+gen_comms_rsllite :
+	( if [ ! -e $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ] ; then \
+          /bin/cp $(WRF_SRC_ROOT_DIR)/tools/gen_comms_warning $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ; \
+          cat $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/gen_comms.c >> $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ; fi )
+
+module_dm_rsllite :
+	( if [ ! -e module_dm.F ] ; then /bin/cp module_dm_warning module_dm.F ; \
+          cat $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/module_dm.F >> module_dm.F ; fi )
+
+wrfio_nf : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_netcdf ; \
+          make NETCDFPATH="$(NETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          CC="$(SCC)" CFLAGS="$(CFLAGS)" \
+          FC="$(SFC) $(PROMOTION) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_pnf : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_pnetcdf ; \
+          make NETCDFPATH="$(PNETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_grib_share :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" archive) 
+
+wrfio_grib1 :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" archive)
+
+wrfio_grib2 :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) " RM="$(RM)" RANLIB="$(RANLIB)" \
+          CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="-traditional" AR="$(AR)" ARFLAGS="$(ARFLAGS)" \
+          FIXED="$(FORMAT_FIXED)" archive)
+
+wrfio_int : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_int ; \
+          make CC="$(CC)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" \
+          TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" all )
+
+esmf_time : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90 ; \
+          make FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" \
+          CPP="$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc -I. $(ARCHFLAGS) $(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+fftpack :
+	( cd $(WRF_SRC_ROOT_DIR)/external/fftpack/fftpack5 ; \
+          make FC="$(SFC)" FFLAGS="$(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+$(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a :
+	( cd $(WRF_SRC_ROOT_DIR)/external/RSL_LITE ; make CC="$(CC) $(CFLAGS)" \
+          FC="$(FC) $(FCFLAGS) $(PROMOTION) $(BYTESWAPIO)" \
+          CPP="$(CPP) -I. $(ARCHFLAGS) $(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" ;\
+          $(RANLIB) $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a )
+
+######################
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+
+# These sub-directory builds are identical across all architectures
+
+wrf_ioapi_includes :
+	( cd $(WRF_SRC_ROOT_DIR)/external/ioapi_share ; \
+          $(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_esmf :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_esmf ; \
+          make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" \
+          RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+#	There is probably no reason to modify these rules
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -o $@ -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -o $@ -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+
+.c.o:
+	$(RM) $@
+	$(CC) -o $@ -c $(CFLAGS) $*.c
+
+# A little more adventurous.  Allow full opt on 
+# mediation_integrate.o \
+# shift_domain_em.o \
+# solve_em.o  <-- gets a little kick from SOLVE_EM_SPECIAL too, if defined
+# mediation_feedback_domain.o : mediation_feedback_domain.F
+# mediation_force_domain.o : mediation_force_domain.F
+# mediation_interp_domain.o : mediation_interp_domain.F
+
+# compile these without high optimization to speed compile
+convert_nmm.o : convert_nmm.F
+init_modules_em.o : init_modules_em.F
+input_wrf.o : input_wrf.F
+module_io.o : module_io.F
+module_comm_dm.o : module_comm_dm.F
+module_configure.o : module_configure.F
+module_dm.o : module_dm.F
+module_domain.o : module_domain.F
+module_domain_type.o : module_domain_type.F
+module_alloc_space.o : module_alloc_space.F
+module_tiles.o : module_tiles.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_initialize.o : module_initialize.F
+module_physics_init.o : module_physics_init.F 
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_real.o : module_initialize_real.F
+module_initialize_real.o: module_initialize_real.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_integrate.o : module_integrate.F
+module_io_mm5.o : module_io_mm5.F
+module_io_wrf.o : module_io_wrf.F
+module_si_io.o : module_si_io.F
+module_state_description.o : module_state_description.F 
+output_wrf.o : output_wrf.F
+solve_interface.o : solve_interface.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+start_em.o : start_em.F
+wrf_auxhist10in.o : wrf_auxhist10in.F
+wrf_auxhist10out.o : wrf_auxhist10out.F
+wrf_auxhist11in.o : wrf_auxhist11in.F
+wrf_auxhist11out.o : wrf_auxhist11out.F
+wrf_auxhist1in.o : wrf_auxhist1in.F
+wrf_auxhist1out.o : wrf_auxhist1out.F
+wrf_auxhist2in.o : wrf_auxhist2in.F
+wrf_auxhist2out.o : wrf_auxhist2out.F
+wrf_auxhist3in.o : wrf_auxhist3in.F
+wrf_auxhist3out.o : wrf_auxhist3out.F
+wrf_auxhist4in.o : wrf_auxhist4in.F
+wrf_auxhist4out.o : wrf_auxhist4out.F
+wrf_auxhist5in.o : wrf_auxhist5in.F
+wrf_auxhist5out.o : wrf_auxhist5out.F
+wrf_auxhist6in.o : wrf_auxhist6in.F
+wrf_auxhist6out.o : wrf_auxhist6out.F
+wrf_auxhist7in.o : wrf_auxhist7in.F
+wrf_auxhist7out.o : wrf_auxhist7out.F
+wrf_auxhist8in.o : wrf_auxhist8in.F
+wrf_auxhist8out.o : wrf_auxhist8out.F
+wrf_auxhist9in.o : wrf_auxhist9in.F
+wrf_auxhist9out.o : wrf_auxhist9out.F
+wrf_auxinput10in.o : wrf_auxinput10in.F
+wrf_auxinput10out.o : wrf_auxinput10out.F
+wrf_auxinput11in.o : wrf_auxinput11in.F
+wrf_auxinput11out.o : wrf_auxinput11out.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_auxinput2in.o : wrf_auxinput2in.F
+wrf_auxinput2out.o : wrf_auxinput2out.F
+wrf_auxinput3in.o : wrf_auxinput3in.F
+wrf_auxinput3out.o : wrf_auxinput3out.F
+wrf_auxinput4in.o : wrf_auxinput4in.F
+wrf_auxinput4out.o : wrf_auxinput4out.F
+wrf_auxinput5in.o : wrf_auxinput5in.F
+wrf_auxinput5out.o : wrf_auxinput5out.F
+wrf_auxinput6in.o : wrf_auxinput6in.F
+wrf_auxinput6out.o : wrf_auxinput6out.F
+wrf_auxinput7in.o : wrf_auxinput7in.F
+wrf_auxinput7out.o : wrf_auxinput7out.F
+wrf_auxinput8in.o : wrf_auxinput8in.F
+wrf_auxinput8out.o : wrf_auxinput8out.F
+wrf_auxinput9in.o : wrf_auxinput9in.F
+wrf_auxinput9out.o : wrf_auxinput9out.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_ext_read_field.o : wrf_ext_read_field.F
+wrf_ext_write_field.o : wrf_ext_write_field.F
+wrf_fddaobs_in.o : wrf_fddaobs_in.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_tsin.o : wrf_tsin.F
+nl_get_0_routines.o : nl_get_0_routines.F
+nl_get_1_routines.o : nl_get_1_routines.F
+nl_set_0_routines.o : nl_set_0_routines.F
+nl_set_1_routines.o : nl_set_1_routines.F
+
+convert_nmm.o \
+init_modules_em.o \
+module_comm_dm.o \
+module_dm.o \
+module_alloc_space.o \
+module_fddaobs_rtfdda.o \
+module_initialize.o \
+module_initialize_b_wave.o \
+module_initialize_hill2d_x.o \
+module_initialize_quarter_ss.o \
+module_initialize_real.o \
+module_initialize_squall2d_x.o \
+module_initialize_squall2d_y.o \
+module_integrate.o \
+module_io_mm5.o \
+module_io_wrf.o \
+module_si_io.o \
+module_tiles.o \
+output_wrf.o \
+solve_interface.o \
+start_domain.o \
+start_domain_nmm.o \
+start_em.o \
+wrf_fddaobs_in.o \
+wrf_tsin.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90
+
+#solve_em.o :
+#	$(RM) $@
+#	$(SED_FTN) $*.F > $*.b 
+#	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $*.f90
+#	$(RM) $*.b
+#	$(FC) -o $@ -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $(SOLVE_EM_SPECIAL) $(OMP) $*.f90
+
+module_sf_ruclsm.o : module_sf_ruclsm.F
+module_cu_kf.o : module_cu_kf.F
+
+module_sf_ruclsm.o module_cu_kf.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCREDUCEDOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90
+
+# compile without OMP
+input_wrf.o \
+module_domain.o \
+module_domain_type.o \
+module_physics_init.o \
+module_io.o \
+wrf_auxhist10in.o \
+wrf_auxhist10out.o \
+wrf_auxhist11in.o \
+wrf_auxhist11out.o \
+wrf_auxhist1in.o \
+wrf_auxhist1out.o \
+wrf_auxhist2in.o \
+wrf_auxhist2out.o \
+wrf_auxhist3in.o \
+wrf_auxhist3out.o \
+wrf_auxhist4in.o \
+wrf_auxhist4out.o \
+wrf_auxhist5in.o \
+wrf_auxhist5out.o \
+wrf_auxhist6in.o \
+wrf_auxhist6out.o \
+wrf_auxhist7in.o \
+wrf_auxhist7out.o \
+wrf_auxhist8in.o \
+wrf_auxhist8out.o \
+wrf_auxhist9in.o \
+wrf_auxhist9out.o \
+wrf_auxinput10in.o \
+wrf_auxinput10out.o \
+wrf_auxinput11in.o \
+wrf_auxinput11out.o \
+wrf_auxinput1in.o \
+wrf_auxinput1out.o \
+wrf_auxinput2in.o \
+wrf_auxinput2out.o \
+wrf_auxinput3in.o \
+wrf_auxinput3out.o \
+wrf_auxinput4in.o \
+wrf_auxinput4out.o \
+wrf_auxinput5in.o \
+wrf_auxinput5out.o \
+wrf_auxinput6in.o \
+wrf_auxinput6out.o \
+wrf_auxinput7in.o \
+wrf_auxinput7out.o \
+wrf_auxinput8in.o \
+wrf_auxinput8out.o \
+wrf_auxinput9in.o \
+wrf_auxinput9out.o \
+wrf_bdyin.o \
+wrf_bdyout.o \
+wrf_ext_read_field.o \
+wrf_ext_write_field.o \
+wrf_histin.o \
+wrf_histout.o \
+wrf_inputin.o \
+wrf_inputout.o \
+wrf_restartin.o \
+wrf_restartout.o \
+module_state_description.o \
+nl_set_0_routines.o \
+nl_set_1_routines.o \
+nl_get_0_routines.o \
+nl_get_1_routines.o \
+module_configure.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCSUFFIX) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf_dm
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf_dm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf_dm	(revision 2744)
@@ -0,0 +1,522 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+	   -DDA_CORE=$(WRF_DA_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	32768
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+#SED_FTN = sed -f $(WRF_SRC_ROOT_DIR)/arch/standard.sed
+SED_FTN = $(WRF_SRC_ROOT_DIR)/tools/standard.exe
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = 0
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/module_utility.o
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = -I$(WRF_SRC_ROOT_DIR)/external/esmf_time_f90
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        =  $(ESMF_IO_INC)
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = 
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = esmf_time
+
+##############################################################################
+
+LIBWRFLIB = libwrflib.a
+
+
+#### Architecture specific settings ####
+
+# To enable over-decompostion with dmpar and dm+sm compiles, 
+# add -DALLOW_OVERDECOMP to ARCH_LOCAL, below. (not recommended)
+
+# Settings for Linux x86_64, PGI compiler with gcc  (dmpar)
+#
+DMPARALLEL      =        1
+OMPCPP          =       # -D_OPENMP
+OMP             =       # -mp -Minfo=mp
+SFC             =       pgf90
+SCC             =       gcc
+DM_FC           =       /donnees/aslmd/MODELES/MPI/mpich2-1.0.8/bin/mpif90 -f90=$(SFC)
+DM_CC           =       /donnees/aslmd/MODELES/MPI/mpich2-1.0.8/bin/mpicc -cc=$(SCC) -DMPI2_SUPPORT
+FC              =        $(DM_FC)
+CC              =       $(DM_CC) -DFSEEKO64_OK 
+LD              =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -w -O3
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed # -Minfo=all =Mneginfo=all
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -Mfixed
+FORMAT_FREE     =       -Mfree
+FCSUFFIX        =
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     -module $(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+######################
+
+ARCHFLAGS       =    $(COREDEFS) -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                     $(ARCH_LOCAL) \
+                     $(DA_ARCHFLAGS) \
+                      -DDM_PARALLEL \
+                       \
+                      -DNETCDF \
+                       \
+                       \
+                       \
+                       \
+                       \
+                       \
+                      -DGRIB1 \
+                      -DINTIO \
+                      -DLIMIT_ARGS \
+                      -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) \
+                      -DMAX_DOMAINS_F=$(MAX_DOMAINS) \
+		      -DNMM_NEST=$(WRF_NMM_NEST)
+CFLAGS          =    $(CFLAGS_LOCAL) -DDM_PARALLEL 
+FCFLAGS         =    $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ESMF_LIB_FLAGS  =    
+ESMF_IO_LIB     =    $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/libesmf_time.a
+ESMF_IO_LIB_EXT =    -L$(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/libesmf_time.a
+INCLUDE_MODULES =    $(MODULE_SRCH_FLAG) \
+                     $(ESMF_MOD_INC) $(ESMF_LIB_FLAGS) \
+                      -I$(WRF_SRC_ROOT_DIR)/main \
+                      -I$(WRF_SRC_ROOT_DIR)/external/io_netcdf \
+                      -I$(WRF_SRC_ROOT_DIR)/external/io_int \
+                      -I$(WRF_SRC_ROOT_DIR)/frame \
+                      -I$(WRF_SRC_ROOT_DIR)/share \
+                      -I$(WRF_SRC_ROOT_DIR)/phys \
+                      -I$(WRF_SRC_ROOT_DIR)/chem -I$(WRF_SRC_ROOT_DIR)/inc \
+                       \
+                      
+REGISTRY        =    Registry
+
+LIB_BUNDLED     = \
+                     -L$(WRF_SRC_ROOT_DIR)/external/fftpack/fftpack5 -lfftpack \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_grib1 -lio_grib1 \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_grib_share -lio_grib_share \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_int -lwrfio_int \
+                     $(ESMF_IO_LIB) \
+                     $(ESMF_IO_LIB) \
+                     $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a \
+                     $(WRF_SRC_ROOT_DIR)/frame/module_internal_header_util.o \
+                     $(WRF_SRC_ROOT_DIR)/frame/pack_utils.o 
+
+LIB_EXTERNAL    = \
+                     $(WRF_SRC_ROOT_DIR)/external/io_netcdf/libwrfio_nf.a -L/donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1/lib -lnetcdf -L/donnees/aslmd/MODELES/LMD_MM_MARS/mpi_64/WRFV2/mars_lmd/libo -llmd   
+
+LIB             =    $(LIB_BUNDLED) $(LIB_EXTERNAL) $(LIB_LOCAL)
+LDFLAGS         =    $(OMP) $(FCFLAGS) $(LDFLAGS_LOCAL) 
+ENVCOMPDEFS     =    
+WRF_CHEM	=	0 
+CPPFLAGS        =    $(ARCHFLAGS) $(ENVCOMPDEFS) -I$(LIBINCLUDE) $(TRADFLAG) 
+NETCDFPATH      =    /donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1
+PNETCDFPATH     =    
+
+bundled:  wrf_ioapi_includes wrfio_grib_share wrfio_grib1 wrfio_int esmf_time fftpack
+external:  wrfio_nf   $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a gen_comms_rsllite module_dm_rsllite $(ESMF_TARGET)
+
+######################
+externals: bundled external
+
+gen_comms_serial :
+	( /bin/rm -f $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c )
+
+module_dm_serial :
+	( if [ ! -e module_dm.F ] ; then /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F ; fi )
+
+gen_comms_rsllite :
+	( if [ ! -e $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ] ; then \
+          /bin/cp $(WRF_SRC_ROOT_DIR)/tools/gen_comms_warning $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ; \
+          cat $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/gen_comms.c >> $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ; fi )
+
+module_dm_rsllite :
+	( if [ ! -e module_dm.F ] ; then /bin/cp module_dm_warning module_dm.F ; \
+          cat $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/module_dm.F >> module_dm.F ; fi )
+
+wrfio_nf : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_netcdf ; \
+          make NETCDFPATH="$(NETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          CC="$(SCC)" CFLAGS="$(CFLAGS)" \
+          FC="$(SFC) $(PROMOTION) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_pnf : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_pnetcdf ; \
+          make NETCDFPATH="$(PNETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_grib_share :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" archive) 
+
+wrfio_grib1 :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" archive)
+
+wrfio_grib2 :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) " RM="$(RM)" RANLIB="$(RANLIB)" \
+          CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="-traditional" AR="$(AR)" ARFLAGS="$(ARFLAGS)" \
+          FIXED="$(FORMAT_FIXED)" archive)
+
+wrfio_int : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_int ; \
+          make CC="$(CC)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" \
+          TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" all )
+
+esmf_time : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90 ; \
+          make FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" \
+          CPP="$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc -I. $(ARCHFLAGS) $(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+fftpack :
+	( cd $(WRF_SRC_ROOT_DIR)/external/fftpack/fftpack5 ; \
+          make FC="$(SFC)" FFLAGS="$(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+$(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a :
+	( cd $(WRF_SRC_ROOT_DIR)/external/RSL_LITE ; make CC="$(CC) $(CFLAGS)" \
+          FC="$(FC) $(FCFLAGS) $(PROMOTION) $(BYTESWAPIO)" \
+          CPP="$(CPP) -I. $(ARCHFLAGS) $(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" ;\
+          $(RANLIB) $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a )
+
+######################
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+
+# These sub-directory builds are identical across all architectures
+
+wrf_ioapi_includes :
+	( cd $(WRF_SRC_ROOT_DIR)/external/ioapi_share ; \
+          $(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_esmf :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_esmf ; \
+          make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" \
+          RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+#	There is probably no reason to modify these rules
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -o $@ -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -o $@ -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+
+.c.o:
+	$(RM) $@
+	$(CC) -o $@ -c $(CFLAGS) $*.c
+
+# A little more adventurous.  Allow full opt on 
+# mediation_integrate.o \
+# shift_domain_em.o \
+# solve_em.o  <-- gets a little kick from SOLVE_EM_SPECIAL too, if defined
+# mediation_feedback_domain.o : mediation_feedback_domain.F
+# mediation_force_domain.o : mediation_force_domain.F
+# mediation_interp_domain.o : mediation_interp_domain.F
+
+# compile these without high optimization to speed compile
+convert_nmm.o : convert_nmm.F
+init_modules_em.o : init_modules_em.F
+input_wrf.o : input_wrf.F
+module_io.o : module_io.F
+module_comm_dm.o : module_comm_dm.F
+module_configure.o : module_configure.F
+module_dm.o : module_dm.F
+module_domain.o : module_domain.F
+module_domain_type.o : module_domain_type.F
+module_alloc_space.o : module_alloc_space.F
+module_tiles.o : module_tiles.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_initialize.o : module_initialize.F
+module_physics_init.o : module_physics_init.F 
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_real.o : module_initialize_real.F
+module_initialize_real.o: module_initialize_real.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_integrate.o : module_integrate.F
+module_io_mm5.o : module_io_mm5.F
+module_io_wrf.o : module_io_wrf.F
+module_si_io.o : module_si_io.F
+module_state_description.o : module_state_description.F 
+output_wrf.o : output_wrf.F
+solve_interface.o : solve_interface.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+start_em.o : start_em.F
+wrf_auxhist10in.o : wrf_auxhist10in.F
+wrf_auxhist10out.o : wrf_auxhist10out.F
+wrf_auxhist11in.o : wrf_auxhist11in.F
+wrf_auxhist11out.o : wrf_auxhist11out.F
+wrf_auxhist1in.o : wrf_auxhist1in.F
+wrf_auxhist1out.o : wrf_auxhist1out.F
+wrf_auxhist2in.o : wrf_auxhist2in.F
+wrf_auxhist2out.o : wrf_auxhist2out.F
+wrf_auxhist3in.o : wrf_auxhist3in.F
+wrf_auxhist3out.o : wrf_auxhist3out.F
+wrf_auxhist4in.o : wrf_auxhist4in.F
+wrf_auxhist4out.o : wrf_auxhist4out.F
+wrf_auxhist5in.o : wrf_auxhist5in.F
+wrf_auxhist5out.o : wrf_auxhist5out.F
+wrf_auxhist6in.o : wrf_auxhist6in.F
+wrf_auxhist6out.o : wrf_auxhist6out.F
+wrf_auxhist7in.o : wrf_auxhist7in.F
+wrf_auxhist7out.o : wrf_auxhist7out.F
+wrf_auxhist8in.o : wrf_auxhist8in.F
+wrf_auxhist8out.o : wrf_auxhist8out.F
+wrf_auxhist9in.o : wrf_auxhist9in.F
+wrf_auxhist9out.o : wrf_auxhist9out.F
+wrf_auxinput10in.o : wrf_auxinput10in.F
+wrf_auxinput10out.o : wrf_auxinput10out.F
+wrf_auxinput11in.o : wrf_auxinput11in.F
+wrf_auxinput11out.o : wrf_auxinput11out.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_auxinput2in.o : wrf_auxinput2in.F
+wrf_auxinput2out.o : wrf_auxinput2out.F
+wrf_auxinput3in.o : wrf_auxinput3in.F
+wrf_auxinput3out.o : wrf_auxinput3out.F
+wrf_auxinput4in.o : wrf_auxinput4in.F
+wrf_auxinput4out.o : wrf_auxinput4out.F
+wrf_auxinput5in.o : wrf_auxinput5in.F
+wrf_auxinput5out.o : wrf_auxinput5out.F
+wrf_auxinput6in.o : wrf_auxinput6in.F
+wrf_auxinput6out.o : wrf_auxinput6out.F
+wrf_auxinput7in.o : wrf_auxinput7in.F
+wrf_auxinput7out.o : wrf_auxinput7out.F
+wrf_auxinput8in.o : wrf_auxinput8in.F
+wrf_auxinput8out.o : wrf_auxinput8out.F
+wrf_auxinput9in.o : wrf_auxinput9in.F
+wrf_auxinput9out.o : wrf_auxinput9out.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_ext_read_field.o : wrf_ext_read_field.F
+wrf_ext_write_field.o : wrf_ext_write_field.F
+wrf_fddaobs_in.o : wrf_fddaobs_in.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_tsin.o : wrf_tsin.F
+nl_get_0_routines.o : nl_get_0_routines.F
+nl_get_1_routines.o : nl_get_1_routines.F
+nl_set_0_routines.o : nl_set_0_routines.F
+nl_set_1_routines.o : nl_set_1_routines.F
+
+convert_nmm.o \
+init_modules_em.o \
+module_comm_dm.o \
+module_dm.o \
+module_alloc_space.o \
+module_fddaobs_rtfdda.o \
+module_initialize.o \
+module_initialize_b_wave.o \
+module_initialize_hill2d_x.o \
+module_initialize_quarter_ss.o \
+module_initialize_real.o \
+module_initialize_squall2d_x.o \
+module_initialize_squall2d_y.o \
+module_integrate.o \
+module_io_mm5.o \
+module_io_wrf.o \
+module_si_io.o \
+module_tiles.o \
+output_wrf.o \
+solve_interface.o \
+start_domain.o \
+start_domain_nmm.o \
+start_em.o \
+wrf_fddaobs_in.o \
+wrf_tsin.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90
+
+#solve_em.o :
+#	$(RM) $@
+#	$(SED_FTN) $*.F > $*.b 
+#	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $*.f90
+#	$(RM) $*.b
+#	$(FC) -o $@ -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $(SOLVE_EM_SPECIAL) $(OMP) $*.f90
+
+module_sf_ruclsm.o : module_sf_ruclsm.F
+module_cu_kf.o : module_cu_kf.F
+
+module_sf_ruclsm.o module_cu_kf.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCREDUCEDOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90
+
+# compile without OMP
+input_wrf.o \
+module_domain.o \
+module_domain_type.o \
+module_physics_init.o \
+module_io.o \
+wrf_auxhist10in.o \
+wrf_auxhist10out.o \
+wrf_auxhist11in.o \
+wrf_auxhist11out.o \
+wrf_auxhist1in.o \
+wrf_auxhist1out.o \
+wrf_auxhist2in.o \
+wrf_auxhist2out.o \
+wrf_auxhist3in.o \
+wrf_auxhist3out.o \
+wrf_auxhist4in.o \
+wrf_auxhist4out.o \
+wrf_auxhist5in.o \
+wrf_auxhist5out.o \
+wrf_auxhist6in.o \
+wrf_auxhist6out.o \
+wrf_auxhist7in.o \
+wrf_auxhist7out.o \
+wrf_auxhist8in.o \
+wrf_auxhist8out.o \
+wrf_auxhist9in.o \
+wrf_auxhist9out.o \
+wrf_auxinput10in.o \
+wrf_auxinput10out.o \
+wrf_auxinput11in.o \
+wrf_auxinput11out.o \
+wrf_auxinput1in.o \
+wrf_auxinput1out.o \
+wrf_auxinput2in.o \
+wrf_auxinput2out.o \
+wrf_auxinput3in.o \
+wrf_auxinput3out.o \
+wrf_auxinput4in.o \
+wrf_auxinput4out.o \
+wrf_auxinput5in.o \
+wrf_auxinput5out.o \
+wrf_auxinput6in.o \
+wrf_auxinput6out.o \
+wrf_auxinput7in.o \
+wrf_auxinput7out.o \
+wrf_auxinput8in.o \
+wrf_auxinput8out.o \
+wrf_auxinput9in.o \
+wrf_auxinput9out.o \
+wrf_bdyin.o \
+wrf_bdyout.o \
+wrf_ext_read_field.o \
+wrf_ext_write_field.o \
+wrf_histin.o \
+wrf_histout.o \
+wrf_inputin.o \
+wrf_inputout.o \
+wrf_restartin.o \
+wrf_restartout.o \
+module_state_description.o \
+nl_set_0_routines.o \
+nl_set_1_routines.o \
+nl_get_0_routines.o \
+nl_get_1_routines.o \
+module_configure.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCSUFFIX) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf_dmsm
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf_dmsm	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf_dmsm	(revision 2744)
@@ -0,0 +1,525 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+	   -DDA_CORE=$(WRF_DA_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	32768
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+#SED_FTN = sed -f $(WRF_SRC_ROOT_DIR)/arch/standard.sed
+SED_FTN = $(WRF_SRC_ROOT_DIR)/tools/standard.exe
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = 0
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/module_utility.o
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = -I$(WRF_SRC_ROOT_DIR)/external/esmf_time_f90
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        =  $(ESMF_IO_INC)
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = 
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = esmf_time
+
+##############################################################################
+
+LIBWRFLIB = libwrflib.a
+
+
+#### Architecture specific settings ####
+
+# To enable over-decompostion with dmpar and dm+sm compiles, 
+# add -DALLOW_OVERDECOMP to ARCH_LOCAL, below. (not recommended)
+
+# Settings for Linux x86_64, PGI compiler with gcc  (dm+sm)
+#
+DMPARALLEL      =        1
+OMPCPP          =        -D_OPENMP
+OMP             =        -mp=nonuma -Minfo=mp
+SFC             =       pgf90
+SCC             =       gcc
+DM_FC           =       /donnees/aslmd/MODELES/MPI/mpich2-1.0.8/bin/mpif90 -f90=$(SFC)
+DM_CC           =       /donnees/aslmd/MODELES/MPI/mpich2-1.0.8/bin/mpicc -cc=$(SCC) -DMPI2_SUPPORT -DMPI2_THREAD_SUPPORT
+FC              =        $(DM_FC)
+CC              =       $(DM_CC) -DFSEEKO64_OK 
+LD              =       $(FC)
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION       =       -r$(RWORDSIZE) -i4
+ARCH_LOCAL      =       -DNONSTANDARD_SYSTEM_SUBR
+CFLAGS_LOCAL    =       -w -O3
+LDFLAGS_LOCAL   =       
+CPLUSPLUSLIB    =       
+ESMF_LDFLAG     =       $(CPLUSPLUSLIB)
+FCOPTIM         =       -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed # -Minfo=all =Mneginfo=all
+FCREDUCEDOPT	=       $(FCOPTIM)
+FCNOOPT		=       -O0
+FCDEBUG         =       # -g $(FCNOOPT)
+FORMAT_FIXED    =       -Mfixed
+FORMAT_FREE     =       -Mfree
+FCSUFFIX        =
+BYTESWAPIO      =       -byteswapio
+FCBASEOPTS      =       -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO)
+MODULE_SRCH_FLAG =     -module $(WRF_SRC_ROOT_DIR)/main
+TRADFLAG        =      -traditional
+CPP             =      /lib/cpp -C -P
+AR              =      ar
+ARFLAGS         =      ru
+M4              =      m4 -B 14000
+RANLIB          =      ranlib
+CC_TOOLS        =      $(SCC)
+
+###########################################################
+######################
+
+ARCHFLAGS       =    $(COREDEFS) -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 \
+                     $(ARCH_LOCAL) \
+                     $(DA_ARCHFLAGS) \
+                      -DDM_PARALLEL \
+                       \
+                      -DNETCDF \
+                       \
+                       \
+                       \
+                       \
+                       \
+                       \
+                      -DGRIB1 \
+                      -DINTIO \
+                      -DLIMIT_ARGS \
+                      -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) \
+                      -DMAX_DOMAINS_F=$(MAX_DOMAINS) \
+		      -DNMM_NEST=$(WRF_NMM_NEST)
+CFLAGS          =    $(CFLAGS_LOCAL) -DDM_PARALLEL 
+FCFLAGS         =    $(FCOPTIM) $(FCBASEOPTS) $(OMP)
+ESMF_LIB_FLAGS  =    
+ESMF_IO_LIB     =    $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/libesmf_time.a
+ESMF_IO_LIB_EXT =    -L$(WRF_SRC_ROOT_DIR)/external/esmf_time_f90/libesmf_time.a
+INCLUDE_MODULES =    $(MODULE_SRCH_FLAG) \
+                     $(ESMF_MOD_INC) $(ESMF_LIB_FLAGS) \
+                      -I$(WRF_SRC_ROOT_DIR)/main \
+                      -I$(WRF_SRC_ROOT_DIR)/external/io_netcdf \
+                      -I$(WRF_SRC_ROOT_DIR)/external/io_int \
+                      -I$(WRF_SRC_ROOT_DIR)/frame \
+                      -I$(WRF_SRC_ROOT_DIR)/share \
+                      -I$(WRF_SRC_ROOT_DIR)/phys \
+                      -I$(WRF_SRC_ROOT_DIR)/chem -I$(WRF_SRC_ROOT_DIR)/inc \
+                       \
+                      
+REGISTRY        =    Registry
+
+LIB_BUNDLED     = \
+                     -L$(WRF_SRC_ROOT_DIR)/external/fftpack/fftpack5 -lfftpack \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_grib1 -lio_grib1 \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_grib_share -lio_grib_share \
+                     -L$(WRF_SRC_ROOT_DIR)/external/io_int -lwrfio_int \
+                     $(ESMF_IO_LIB) \
+                     $(ESMF_IO_LIB) \
+                     $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a \
+                     $(WRF_SRC_ROOT_DIR)/frame/module_internal_header_util.o \
+                     $(WRF_SRC_ROOT_DIR)/frame/pack_utils.o 
+
+LIB_EXTERNAL    = \
+                     $(WRF_SRC_ROOT_DIR)/external/io_netcdf/libwrfio_nf.a -L/donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1/lib -lnetcdf    
+
+LIB_LMD         = \
+                     -L/donnees/aslmd/MODELES/LMD_MM_MARS/mpi_64/WRFV2/mars_lmd/libo -llmd
+
+LIB             =    $(LIB_BUNDLED) $(LIB_EXTERNAL) $(LIB_LOCAL) $(LIB_LMD)
+LDFLAGS         =    $(OMP) $(FCFLAGS) $(LDFLAGS_LOCAL) 
+ENVCOMPDEFS     =    
+WRF_CHEM	=	0 
+CPPFLAGS        =    $(ARCHFLAGS) $(ENVCOMPDEFS) -I$(LIBINCLUDE) $(TRADFLAG) 
+NETCDFPATH      =    /donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1
+PNETCDFPATH     =    
+
+bundled:  wrf_ioapi_includes wrfio_grib_share wrfio_grib1 wrfio_int esmf_time fftpack
+external:  wrfio_nf   $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a gen_comms_rsllite module_dm_rsllite $(ESMF_TARGET)
+
+######################
+externals: bundled external
+
+gen_comms_serial :
+	( /bin/rm -f $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c )
+
+module_dm_serial :
+	( if [ ! -e module_dm.F ] ; then /bin/cp module_dm_warning module_dm.F ; cat module_dm_stubs.F >> module_dm.F ; fi )
+
+gen_comms_rsllite :
+	( if [ ! -e $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ] ; then \
+          /bin/cp $(WRF_SRC_ROOT_DIR)/tools/gen_comms_warning $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ; \
+          cat $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/gen_comms.c >> $(WRF_SRC_ROOT_DIR)/tools/gen_comms.c ; fi )
+
+module_dm_rsllite :
+	( if [ ! -e module_dm.F ] ; then /bin/cp module_dm_warning module_dm.F ; \
+          cat $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/module_dm.F >> module_dm.F ; fi )
+
+wrfio_nf : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_netcdf ; \
+          make NETCDFPATH="$(NETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          CC="$(SCC)" CFLAGS="$(CFLAGS)" \
+          FC="$(SFC) $(PROMOTION) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_pnf : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_pnetcdf ; \
+          make NETCDFPATH="$(PNETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(FC) $(PROMOTION) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_grib_share :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" archive) 
+
+wrfio_grib1 :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" archive)
+
+wrfio_grib2 :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) " RM="$(RM)" RANLIB="$(RANLIB)" \
+          CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) $(FCSUFFIX)" TRADFLAG="-traditional" AR="$(AR)" ARFLAGS="$(ARFLAGS)" \
+          FIXED="$(FORMAT_FIXED)" archive)
+
+wrfio_int : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_int ; \
+          make CC="$(CC)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" \
+          FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" \
+          TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" all )
+
+esmf_time : 
+	( cd $(WRF_SRC_ROOT_DIR)/external/esmf_time_f90 ; \
+          make FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" \
+          CPP="$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc -I. $(ARCHFLAGS) $(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+fftpack :
+	( cd $(WRF_SRC_ROOT_DIR)/external/fftpack/fftpack5 ; \
+          make FC="$(SFC)" FFLAGS="$(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+$(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a :
+	( cd $(WRF_SRC_ROOT_DIR)/external/RSL_LITE ; make CC="$(CC) $(CFLAGS)" \
+          FC="$(FC) $(FCFLAGS) $(PROMOTION) $(BYTESWAPIO)" \
+          CPP="$(CPP) -I. $(ARCHFLAGS) $(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" ;\
+          $(RANLIB) $(WRF_SRC_ROOT_DIR)/external/RSL_LITE/librsl_lite.a )
+
+######################
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+
+# These sub-directory builds are identical across all architectures
+
+wrf_ioapi_includes :
+	( cd $(WRF_SRC_ROOT_DIR)/external/ioapi_share ; \
+          $(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+wrfio_esmf :
+	( cd $(WRF_SRC_ROOT_DIR)/external/io_esmf ; \
+          make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" \
+          RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " AR="$(AR)" ARFLAGS="$(ARFLAGS)" )
+
+#	There is probably no reason to modify these rules
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -o $@ -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -o $@ -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+
+.c.o:
+	$(RM) $@
+	$(CC) -o $@ -c $(CFLAGS) $*.c
+
+# A little more adventurous.  Allow full opt on 
+# mediation_integrate.o \
+# shift_domain_em.o \
+# solve_em.o  <-- gets a little kick from SOLVE_EM_SPECIAL too, if defined
+# mediation_feedback_domain.o : mediation_feedback_domain.F
+# mediation_force_domain.o : mediation_force_domain.F
+# mediation_interp_domain.o : mediation_interp_domain.F
+
+# compile these without high optimization to speed compile
+convert_nmm.o : convert_nmm.F
+init_modules_em.o : init_modules_em.F
+input_wrf.o : input_wrf.F
+module_io.o : module_io.F
+module_comm_dm.o : module_comm_dm.F
+module_configure.o : module_configure.F
+module_dm.o : module_dm.F
+module_domain.o : module_domain.F
+module_domain_type.o : module_domain_type.F
+module_alloc_space.o : module_alloc_space.F
+module_tiles.o : module_tiles.F
+module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F
+module_initialize.o : module_initialize.F
+module_physics_init.o : module_physics_init.F 
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_real.o : module_initialize_real.F
+module_initialize_real.o: module_initialize_real.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_integrate.o : module_integrate.F
+module_io_mm5.o : module_io_mm5.F
+module_io_wrf.o : module_io_wrf.F
+module_si_io.o : module_si_io.F
+module_state_description.o : module_state_description.F 
+output_wrf.o : output_wrf.F
+solve_interface.o : solve_interface.F
+start_domain.o : start_domain.F
+start_domain_nmm.o : start_domain_nmm.F
+start_em.o : start_em.F
+wrf_auxhist10in.o : wrf_auxhist10in.F
+wrf_auxhist10out.o : wrf_auxhist10out.F
+wrf_auxhist11in.o : wrf_auxhist11in.F
+wrf_auxhist11out.o : wrf_auxhist11out.F
+wrf_auxhist1in.o : wrf_auxhist1in.F
+wrf_auxhist1out.o : wrf_auxhist1out.F
+wrf_auxhist2in.o : wrf_auxhist2in.F
+wrf_auxhist2out.o : wrf_auxhist2out.F
+wrf_auxhist3in.o : wrf_auxhist3in.F
+wrf_auxhist3out.o : wrf_auxhist3out.F
+wrf_auxhist4in.o : wrf_auxhist4in.F
+wrf_auxhist4out.o : wrf_auxhist4out.F
+wrf_auxhist5in.o : wrf_auxhist5in.F
+wrf_auxhist5out.o : wrf_auxhist5out.F
+wrf_auxhist6in.o : wrf_auxhist6in.F
+wrf_auxhist6out.o : wrf_auxhist6out.F
+wrf_auxhist7in.o : wrf_auxhist7in.F
+wrf_auxhist7out.o : wrf_auxhist7out.F
+wrf_auxhist8in.o : wrf_auxhist8in.F
+wrf_auxhist8out.o : wrf_auxhist8out.F
+wrf_auxhist9in.o : wrf_auxhist9in.F
+wrf_auxhist9out.o : wrf_auxhist9out.F
+wrf_auxinput10in.o : wrf_auxinput10in.F
+wrf_auxinput10out.o : wrf_auxinput10out.F
+wrf_auxinput11in.o : wrf_auxinput11in.F
+wrf_auxinput11out.o : wrf_auxinput11out.F
+wrf_auxinput1in.o : wrf_auxinput1in.F
+wrf_auxinput1out.o : wrf_auxinput1out.F
+wrf_auxinput2in.o : wrf_auxinput2in.F
+wrf_auxinput2out.o : wrf_auxinput2out.F
+wrf_auxinput3in.o : wrf_auxinput3in.F
+wrf_auxinput3out.o : wrf_auxinput3out.F
+wrf_auxinput4in.o : wrf_auxinput4in.F
+wrf_auxinput4out.o : wrf_auxinput4out.F
+wrf_auxinput5in.o : wrf_auxinput5in.F
+wrf_auxinput5out.o : wrf_auxinput5out.F
+wrf_auxinput6in.o : wrf_auxinput6in.F
+wrf_auxinput6out.o : wrf_auxinput6out.F
+wrf_auxinput7in.o : wrf_auxinput7in.F
+wrf_auxinput7out.o : wrf_auxinput7out.F
+wrf_auxinput8in.o : wrf_auxinput8in.F
+wrf_auxinput8out.o : wrf_auxinput8out.F
+wrf_auxinput9in.o : wrf_auxinput9in.F
+wrf_auxinput9out.o : wrf_auxinput9out.F
+wrf_bdyin.o : wrf_bdyin.F
+wrf_bdyout.o : wrf_bdyout.F
+wrf_ext_read_field.o : wrf_ext_read_field.F
+wrf_ext_write_field.o : wrf_ext_write_field.F
+wrf_fddaobs_in.o : wrf_fddaobs_in.F
+wrf_histin.o : wrf_histin.F
+wrf_histout.o : wrf_histout.F
+wrf_inputin.o : wrf_inputin.F
+wrf_inputout.o : wrf_inputout.F
+wrf_restartin.o : wrf_restartin.F
+wrf_restartout.o : wrf_restartout.F
+wrf_tsin.o : wrf_tsin.F
+nl_get_0_routines.o : nl_get_0_routines.F
+nl_get_1_routines.o : nl_get_1_routines.F
+nl_set_0_routines.o : nl_set_0_routines.F
+nl_set_1_routines.o : nl_set_1_routines.F
+
+convert_nmm.o \
+init_modules_em.o \
+module_comm_dm.o \
+module_dm.o \
+module_alloc_space.o \
+module_fddaobs_rtfdda.o \
+module_initialize.o \
+module_initialize_b_wave.o \
+module_initialize_hill2d_x.o \
+module_initialize_quarter_ss.o \
+module_initialize_real.o \
+module_initialize_squall2d_x.o \
+module_initialize_squall2d_y.o \
+module_integrate.o \
+module_io_mm5.o \
+module_io_wrf.o \
+module_si_io.o \
+module_tiles.o \
+output_wrf.o \
+solve_interface.o \
+start_domain.o \
+start_domain_nmm.o \
+start_em.o \
+wrf_fddaobs_in.o \
+wrf_tsin.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90
+
+#solve_em.o :
+#	$(RM) $@
+#	$(SED_FTN) $*.F > $*.b 
+#	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b  > $*.f90
+#	$(RM) $*.b
+#	$(FC) -o $@ -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $(SOLVE_EM_SPECIAL) $(OMP) $*.f90
+
+module_sf_ruclsm.o : module_sf_ruclsm.F
+module_cu_kf.o : module_cu_kf.F
+
+module_sf_ruclsm.o module_cu_kf.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCREDUCEDOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90
+
+# compile without OMP
+input_wrf.o \
+module_domain.o \
+module_domain_type.o \
+module_physics_init.o \
+module_io.o \
+wrf_auxhist10in.o \
+wrf_auxhist10out.o \
+wrf_auxhist11in.o \
+wrf_auxhist11out.o \
+wrf_auxhist1in.o \
+wrf_auxhist1out.o \
+wrf_auxhist2in.o \
+wrf_auxhist2out.o \
+wrf_auxhist3in.o \
+wrf_auxhist3out.o \
+wrf_auxhist4in.o \
+wrf_auxhist4out.o \
+wrf_auxhist5in.o \
+wrf_auxhist5out.o \
+wrf_auxhist6in.o \
+wrf_auxhist6out.o \
+wrf_auxhist7in.o \
+wrf_auxhist7out.o \
+wrf_auxhist8in.o \
+wrf_auxhist8out.o \
+wrf_auxhist9in.o \
+wrf_auxhist9out.o \
+wrf_auxinput10in.o \
+wrf_auxinput10out.o \
+wrf_auxinput11in.o \
+wrf_auxinput11out.o \
+wrf_auxinput1in.o \
+wrf_auxinput1out.o \
+wrf_auxinput2in.o \
+wrf_auxinput2out.o \
+wrf_auxinput3in.o \
+wrf_auxinput3out.o \
+wrf_auxinput4in.o \
+wrf_auxinput4out.o \
+wrf_auxinput5in.o \
+wrf_auxinput5out.o \
+wrf_auxinput6in.o \
+wrf_auxinput6out.o \
+wrf_auxinput7in.o \
+wrf_auxinput7out.o \
+wrf_auxinput8in.o \
+wrf_auxinput8out.o \
+wrf_auxinput9in.o \
+wrf_auxinput9out.o \
+wrf_bdyin.o \
+wrf_bdyout.o \
+wrf_ext_read_field.o \
+wrf_ext_write_field.o \
+wrf_histin.o \
+wrf_histout.o \
+wrf_inputin.o \
+wrf_inputout.o \
+wrf_restartin.o \
+wrf_restartout.o \
+module_state_description.o \
+nl_set_0_routines.o \
+nl_set_1_routines.o \
+nl_get_0_routines.o \
+nl_get_1_routines.o \
+module_configure.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCSUFFIX) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf_example
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf_example	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/configure.wrf_example	(revision 2744)
@@ -0,0 +1,263 @@
+# configure.wrf
+#
+# This file was automatically generated by the configure script in the
+# top level directory. You may make changes to the settings in this
+# file but be aware they will be overwritten each time you run configure.
+# Ordinarily, it is necessary to run configure once, when the code is
+# first installed.
+#
+# To permanently change options, change the settings for your platform
+# in the file arch/configure.defaults then rerun configure.
+#
+SHELL           =       /bin/sh
+DEVTOP          =       `pwd`
+LIBINCLUDE      =       .
+.SUFFIXES: .F .i .o .f90 .c
+
+#### Get core settings from environment (set in compile script)
+#### Note to add a core, this has to be added to.
+
+COREDEFS = -DEM_CORE=$(WRF_EM_CORE) \
+           -DNMM_CORE=$(WRF_NMM_CORE) -DNMM_MAX_DIM=2600 \
+	   -DCOAMPS_CORE=$(WRF_COAMPS_CORE) \
+           -DEXP_CORE=$(WRF_EXP_CORE)
+
+#### Single location for defining total number of domains.  You need
+#### at least 1 + 2*(number of total nests).  For example, 1 coarse
+#### grid + three fine grids = 1 + 2(3) = 7, so MAX_DOMAINS=7.
+
+MAX_DOMAINS	=	21
+
+#### DM buffer length for the configuration flags.
+
+CONFIG_BUF_LEN	=	16384
+
+
+##############################################################################
+#### The settings in this section are defaults that may be overridden by the 
+#### architecture-specific settings in the next section.  
+##############################################################################
+
+##############################################################################
+#### NOTE:  Do not modify these default values here.  To override these 
+####        values, make changes after "Architecture specific settings".  
+##############################################################################
+
+#### Native size (in bytes) of Fortran REAL data type on this architecture ####
+#### Note:  to change real wordsize (for example, to promote REALs from 
+####        4-byte to 8-byte), modify the definition of RWORDSIZE in the 
+####        section following "Architecture specific settings".  Do not 
+####        change NATIVE_RWORDSIZE as is it architecture-specific.  
+NATIVE_RWORDSIZE = 4
+
+#### Default sed command and script for Fortran source files ####
+SED_FTN = sed -f ../arch/standard.sed
+
+# Hack to work around $(PWD) not changing during OSF1 build.  
+# $(IO_GRIB_SHARE_DIR) is reset during the OSF1 build only.  
+IO_GRIB_SHARE_DIR = 
+
+#### ESMF switches                 ####
+#### These are set up by Config.pl ####
+# switch to use separately installed ESMF library for coupling:  1==true
+ESMF_COUPLING       = 0
+# select dependences on module_utility.o
+ESMF_MOD_DEPENDENCE = ../external/esmf_time_f90/module_utility.o
+# select -I options for separately installed ESMF library, if present
+ESMF_MOD_INC        = 
+# select -I options for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_INC         = -I../external/esmf_time_f90
+# select cpp token for external/io_esmf vs. external/esmf_time_f90
+ESMF_IO_DEFS        = 
+# select build target for external/io_esmf vs. external/esmf_time_f90
+ESMF_TARGET         = esmf_time
+
+##############################################################################
+
+
+#### Architecture specific settings ####
+
+# Settings for PC Linux x86_64 (IA64 and Opteron), PGI 5.2 or higher DM-Parallel   (RSL_LITE, MPICH, Allows nesting, No periodic LBCs)
+#        Note that for 5.1.x comment out -Mpia=fast
+#
+# Notes: for experimental implementation of moving nests, add -DMOVE_NESTS to ARCHFLAGS
+#        for experimental implementation of vortex tracking nests, add -DMOVE_NESTS -DVORTEX_CENTER to ARCHFLAGS
+#
+DMPARALLEL      =       1
+MAX_PROC        =       1024
+FC              =       /donnees/aslmd/MODELES/MPI/mpich2-1.0.8/bin/mpif90
+LD              =       /donnees/aslmd/MODELES/MPI/mpich2-1.0.8/bin/mpif90
+CC              =       /donnees/aslmd/MODELES/MPI/mpich2-1.0.8/bin/mpicc -DMPI2_SUPPORT -DMPI2_SUPPORT -DFSEEKO64_OK 
+SCC		=	gcc
+SFC             =       pgf90
+RWORDSIZE       =       $(NATIVE_RWORDSIZE)
+PROMOTION	=	-r$(RWORDSIZE) -i4
+CFLAGS          =       -DDM_PARALLEL \
+                        -DMAXDOM_MAKE=$(MAX_DOMAINS) -DMAXPROC_MAKE=$(MAX_PROC) -I../external/RSL_LITE \
+                        -DLANDREAD_STUB
+FCOPTIM         =       -fastsse #-Mipa=fast
+FCDEBUG		=	#-g
+#FCBASEOPTS      =       -w -byteswapio -Ktrap=fp -Mfree $(FCDEBUG)
+FCBASEOPTS      =       -w -byteswapio -Mfree $(FCDEBUG)
+FCFLAGS         =       $(FCOPTIM) $(FCBASEOPTS)
+ARCHFLAGS       =       -DGRIB1  -DINTIO -DDM_PARALLEL \
+                        -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=$(RWORDSIZE) -DLWORDSIZE=4 -DNETCDF \
+			-DLIMIT_ARGS -DLANDREAD_STUB
+# machine-specific flags needed to link in ESMF library (C++ run-time-library, etc.)
+ESMF_LIB_FLAGS  =       
+ESMF_IO_LIB     =       -L../external/esmf_time_f90 -lesmf_time
+ESMF_IO_LIB_EXT =       -L../../external/esmf_time_f90 -lesmf_time
+INCLUDE_MODULES =       -module ../main -I../external/io_netcdf -I../external/io_int -I../external/esmf_time_f90 \
+                        -I../external -I../frame -I../share -I../phys -I../inc -I../chem
+PERL            =       perl
+REGISTRY        =       Registry
+LIB             =       -L../external/io_netcdf -lwrfio_nf -L/donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1/lib -lnetcdf -L../external/RSL_LITE -lrsl_lite \
+                        -L../external/io_grib1 -lio_grib1 \
+                         \
+                        -L../external/io_grib_share -lio_grib_share \
+			-L../external/io_int -lwrfio_int \
+			../frame/module_internal_header_util.o ../frame/pack_utils.o -L../external/esmf_time_f90 -lesmf_time -L../mars_lmd/libo -llmd 
+LDFLAGS         =       -byteswapio 
+ENVCOMPDEFS	=	
+WRF_CHEM	=	0 
+CPP             =       /lib/cpp -C -P -traditional
+POUND_DEF	=	-DNO_RRTM_PHYSICS  -traditional $(COREDEFS) -DNONSTANDARD_SYSTEM -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) -DMAX_DOMAINS_F=$(MAX_DOMAINS)
+CPPFLAGS        =       -I$(LIBINCLUDE) -C -P $(ARCHFLAGS) -I../external/RSL_LITE -C -P `cat ../inc/dm_comm_cpp_flags` $(ENVCOMPDEFS) $(POUND_DEF)
+AR              =       ar ru
+M4              =       m4 -B 14000
+RANLIB          =       ranlib
+NETCDFPATH	=	/donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1
+CC_TOOLS        =       cc
+
+externals : wrf_ioapi_includes wrfio_nf wrfio_grib_share wrfio_grib1  ../external/RSL_LITE/librsl_lite.a wrfio_int gen_comms.c module_dm.F esmf_time
+
+gen_comms.c : ../external/RSL_LITE/gen_comms.c
+	( /bin/cp ../tools/gen_comms_warning ../tools/gen_comms.c ; \
+          cat ../external/RSL_LITE/gen_comms.c >> ../tools/gen_comms.c )
+
+module_dm.F : ../external/RSL_LITE/module_dm.F
+	( /bin/cp module_dm_warning module_dm.F ; cat ../external/RSL_LITE/module_dm.F >> module_dm.F )
+
+wrfio_nf :
+	( cd ../external/io_netcdf ; \
+	  make NETCDFPATH=/donnees/aslmd/MODELES/NETCDF/pgf90_64/netcdf-3.6.1 RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -w" TRADFLAG="-traditional" )
+
+wrfio_grib_share :
+	( cd ../external/io_grib_share ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib1 :
+	( cd ../external/io_grib1 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" archive)
+
+wrfio_grib2 :
+	( cd ../external/io_grib2 ; \
+          make CC="$(SCC)" CFLAGS="$(CFLAGS) " RM="$(RM)" RANLIB="$(RANLIB)" CPP="$(CPP)" FC="$(SFC) $(PROMOTION) -I. $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" FIXED="-Mfixed" archive)
+
+wrfio_int :
+	( cd ../external/io_int ; \
+          make CC="$(CC)" RANLIB="$(RANLIB)" CPP="$(CPP)" SFC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" FC="$(SFC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) -w" TRADFLAG="-traditional" all )
+
+esmf_time : 
+	( cd ../external/esmf_time_f90 ; \
+	  make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS)" RANLIB="$(RANLIB)" CPP="$(CPP) -I../../inc -I. $(POUND_DEF)" )
+
+../external/RSL_LITE/librsl_lite.a :
+	( cd ../external/RSL_LITE ; make CC="$(CC)" FC="$(FC) $(PROMOTION) $(FCFLAGS) -byteswapio" MAX_DOMAINS=$(MAX_DOMAINS) MAX_PROC=$(MAX_PROC) LEARN_BCAST=-DLEARN_BCAST )
+
+# compile these without high optimization to speed compile
+solve_interface.o : solve_interface.F
+shift_domain_em.o : shift_domain_em.F
+module_io_mm5.o : module_io_mm5.F
+module_si_io.o : module_si_io.F
+module_io_wrf.o : module_io_wrf.F
+module_domain.o : module_domain.F
+module_start.o : module_start.F
+module_initialize.o : module_initialize.F
+module_initialize_b_wave.o : module_initialize_b_wave.F
+module_initialize_hill2d_x.o : module_initialize_hill2d_x.F
+module_initialize_quarter_ss.o : module_initialize_quarter_ss.F
+module_initialize_squall2d_x.o : module_initialize_squall2d_x.F
+module_initialize_squall2d_y.o : module_initialize_squall2d_y.F
+module_initialize_real.o : module_initialize_real.F
+module_dm.o : module_dm.F
+start_domain.o : start_domain.F
+mediation_integrate.o : mediation_integrate.F
+module_configure.o : module_configure.F
+
+solve_interface.o                                              \
+shift_domain_em.o                                              \
+module_io_mm5.o module_si_io.o module_io_wrf.o module_domain.o \
+module_start.o module_initialize.o module_initialize_b_wave.o  \
+module_initialize_hill2d_x.o module_initialize_quarter_ss.o    \
+module_initialize_squall2d_x.o module_initialize_squall2d_y.o  \
+mediation_integrate.o \
+module_configure.o                                             \
+module_initialize_real.o module_dm.o start_domain.o :
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(PROMOTION) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90
+
+###########################################################
+
+
+# These sub-directory builds are identical across all architectures
+wrfio_esmf :
+	( cd ../external/io_esmf ; \
+	make FC="$(FC) $(PROMOTION) $(FCDEBUG) $(FCBASEOPTS) $(ESMF_MOD_INC)" RANLIB="$(RANLIB)" CPP="$(CPP) $(POUND_DEF) " )
+
+
+#
+#	Macros, these should be generic for all machines
+
+LN	=	ln -sf
+MAKE	=	make -i -r
+RM	= 	rm -f
+
+#	There is probably no reason to modify these rules
+
+wrf_ioapi_includes :
+	( cd ../external/ioapi_share ; \
+	$(MAKE) NATIVE_RWORDSIZE="$(NATIVE_RWORDSIZE)" RWORDSIZE="$(RWORDSIZE)" )
+
+.F.i:
+	$(RM) $@
+	$(CPP) -I../inc $(CPPFLAGS) $*.F > $@
+	mv $*.i $(DEVTOP)/pick/$*.f90
+	cp $*.F $(DEVTOP)/pick
+
+.F.o:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $*.f90
+	$(RM) $*.b
+	$(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.F.f90:
+	$(RM) $@
+	$(SED_FTN) $*.F > $*.b 
+	$(CPP) -I../inc $(CPPFLAGS) $*.b  > $@
+	$(RM) $*.b
+
+.f90.o:
+	$(RM) $@
+	$(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+#PGI	if [ ! -e $@ ] ; then \
+#PGI	sleep 10 ; $(FC) -c $(FCFLAGS) $(PROMOTION) $(FCSUFFIX) $*.f90 ; \
+#PGI	fi
+
+.c.o:
+	$(RM) $@
+	$(CC) -c $(CFLAGS) $*.c
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/call_meso_inifis.inc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/call_meso_inifis.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/call_meso_inifis.inc	(revision 2744)
@@ -0,0 +1,19 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+       CALL meso_inifis(ngridmx,nlayer,nqmx,dt, &
+               wday_ini,wdaysec,               &
+               wappel_phys,wecri_phys,         &
+               lat_vec,lon_vec,aire_vec,1/reradius,g,r_d,cp,           &
+               womeg,wmugaz,                                           &
+               wyear_day,wperiheli,waphelie,wperi_day,wobliquit,       &
+               wz0,wemin_turb,wlmixmin,                                &
+               wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,   &
+               wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,        &
+               walbedodat,winertiedat,wphisfi,                         &
+               wzmea,wzstd,wzsig,wzgam,wzthe,                          &
+               wtheta,wpsi)
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/call_meso_physiq.inc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/call_meso_physiq.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/call_meso_physiq.inc	(revision 2744)
@@ -0,0 +1,17 @@
+!
+! part of the module_lmd_driver program
+! that is (number of domains)-dependent
+!
+
+
+       CALL meso_physiq (ngrid,nlayer,nq,                              &
+               firstcall,lastcall,wday_ini,pday,ptime,ptimestep,       &
+               pplev,pplay,pphi,pu, pv, pt, pq, pw,                    &
+               pdu, pdv, pdt, pdq, pdpsrf, tracerdyn,          &
+               wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,                 &
+               wecri_phys_sec,                &
+	       output_tab2d, output_tab3d)
+
+
+
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output1.inc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output1.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output1.inc	(revision 2744)
@@ -0,0 +1,6 @@
+       TSURF,&
+       TAU_DUST,&
+       SWDOWN,&
+       LWDOWN,&
+       SWUP,&
+       LWUP,&
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output2.inc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output2.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output2.inc	(revision 2744)
@@ -0,0 +1,10 @@
+REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
+       TSURF,&
+       TAU_DUST,&
+       SWDOWN,&
+       LWDOWN,&
+       SWUP,&
+       LWUP,&
+   PSFC,TSK
+REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(OUT)  :: &
+   RTHBLTEN,RUBLTEN,RVBLTEN
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output3.inc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output3.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output3.inc	(revision 2744)
@@ -0,0 +1,6 @@
+TSURF(i,j) = output_tab2d(subs,ind_TSURF)
+TAU_DUST(i,j) = output_tab2d(subs,ind_TAU_DUST)
+SWDOWN(i,j) = output_tab2d(subs,ind_SWDOWN)
+LWDOWN(i,j) = output_tab2d(subs,ind_LWDOWN)
+SWUP(i,j) = output_tab2d(subs,ind_SWUP)
+LWUP(i,j) = output_tab2d(subs,ind_LWUP)
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output4.inc
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output4.inc	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/module_lmd_driver_output4.inc	(revision 2744)
@@ -0,0 +1,6 @@
+  &    ,TSURF=grid%TSURF   &
+  &    ,TAU_DUST=grid%TAU_DUST   &
+  &    ,SWDOWN=grid%SWDOWN   &
+  &    ,LWDOWN=grid%LWDOWN   &
+  &    ,SWUP=grid%SWUP   &
+  &    ,LWUP=grid%LWUP   &
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/wrf_output_2d.h
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/wrf_output_2d.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/wrf_output_2d.h	(revision 2744)
@@ -0,0 +1,10 @@
+!-------------------
+! INCLUDE wrf_output_2d.h
+!-------------------
+      INTEGER, PARAMETER :: ind_TSURF = 1
+      INTEGER, PARAMETER :: ind_TAU_DUST = 2
+      INTEGER, PARAMETER :: ind_SWDOWN = 3
+      INTEGER, PARAMETER :: ind_LWDOWN = 4
+      INTEGER, PARAMETER :: ind_SWUP = 5
+      INTEGER, PARAMETER :: ind_LWUP = 6
+      INTEGER, PARAMETER :: n2d = 6
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/wrf_output_3d.h
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/wrf_output_3d.h	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/inc_old/wrf_output_3d.h	(revision 2744)
@@ -0,0 +1,4 @@
+!-------------------
+! INCLUDE wrf_output_3d.h
+!-------------------
+           INTEGER, PARAMETER :: n3d = 1
Index: trunk/WRF.COMMON/WRFV3/modif_mars/res/ls2sol.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/res/ls2sol.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/res/ls2sol.F	(revision 2744)
@@ -0,0 +1,47 @@
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      real function ls2sol(ls)
+
+c  Returns solar longitude, Ls (in deg.), from day number (in sol),
+c  where sol=0=Ls=0 at the northern hemisphere spring equinox
+
+      implicit none
+
+c  Arguments:
+      real ls
+
+c  Local:
+      double precision xref,zx0,zteta,zz
+c	xref: mean anomaly, zteta: true anomaly, zx0: eccentric anomaly
+      double precision year_day 
+      double precision peri_day,timeperi,e_elips
+      double precision pi,degrad 
+      parameter (year_day=668.6d0) ! number of sols in a amartian year
+c      data peri_day /485.0/
+      parameter (peri_day=485.35d0) ! date (in sols) of perihelion
+c  timeperi: 2*pi*( 1 - Ls(perihelion)/ 360 ); Ls(perihelion)=250.99
+      parameter (timeperi=1.90258341759902d0)
+      parameter (e_elips=0.0934d0)  ! eccentricity of orbit
+      parameter (pi=3.14159265358979d0)
+      parameter (degrad=57.2957795130823d0)
+
+      if (abs(ls).lt.1.0e-5) then
+         if (ls.ge.0.0) then
+            ls2sol = 0.0
+         else
+            ls2sol = year_day
+         end if
+         return
+      end if
+
+      zteta = ls/degrad + timeperi
+      zx0 = 2.0*datan(dtan(0.5*zteta)/dsqrt((1.+e_elips)/(1.-e_elips)))
+      xref = zx0-e_elips*dsin(zx0)
+      zz = xref/(2.*pi)
+      ls2sol = zz*year_day + peri_day
+      if (ls2sol.lt.0.0) ls2sol = ls2sol + year_day
+      if (ls2sol.ge.year_day) ls2sol = ls2sol - year_day
+
+      return
+      end
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Index: trunk/WRF.COMMON/WRFV3/modif_mars/scridl
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/scridl	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/scridl	(revision 2744)
@@ -0,0 +1,4 @@
+#! /bin/bash
+
+echo "getturb & exit" | /opt/idl-6.4/idl/bin/idl > logidl 2> logidl_err &
+
Index: trunk/WRF.COMMON/WRFV3/modif_mars/solve_em.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/solve_em.F	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/solve_em.F	(revision 2744)
@@ -0,0 +1,3258 @@
+!WRF:MEDIATION_LAYER:SOLVER
+
+SUBROUTINE solve_em ( grid , config_flags  &
+! Arguments generated from Registry
+#include "dummy_new_args.inc"
+!
+                    )
+! Driver layer modules
+   USE module_state_description
+   USE module_domain, ONLY : domain, get_ijk_from_grid, get_ijk_from_subgrid, domain_get_current_time, domain_get_start_time
+   USE module_configure, ONLY : grid_config_rec_type
+   USE module_driver_constants
+   USE module_machine
+   USE module_tiles, ONLY : set_tiles
+#ifdef DM_PARALLEL
+   USE module_dm, ONLY : local_communicator, mytask, ntasks, ntasks_x, ntasks_y, local_communicator_periodic, wrf_dm_maxval
+#else
+   USE module_dm
+#endif
+   USE module_comm_dm
+   USE module_utility
+! Mediation layer modules
+! Model layer modules
+   USE module_model_constants
+   USE module_small_step_em
+   USE module_em
+   USE module_big_step_utilities_em
+   USE module_bc
+   USE module_bc_em
+   USE module_solvedebug_em
+   USE module_physics_addtendc
+   USE module_diffusion_em
+   USE module_polarfft
+!!!!****MARS MARS
+!!!!****MARS MARS
+!   USE module_microphysics_driver
+!   USE module_microphysics_zero_out
+!   USE module_fddaobs_driver
+!   USE module_diagnostics
+#ifdef WRF_CHEM
+   USE module_input_chem_data
+   USE module_chem_utilities
+#endif
+   USE module_first_rk_step_part1
+   USE module_first_rk_step_part2
+   USE module_llxy, ONLY : proj_cassini
+
+   IMPLICIT NONE
+
+   !  Input data.
+
+   TYPE(domain) , TARGET          :: grid
+
+   !  Definitions of dummy arguments to this routine (generated from Registry).
+#include "dummy_new_decl.inc"
+
+   !  Structure that contains run-time configuration (namelist) data for domain
+   TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
+
+   ! Local data
+
+   INTEGER                         :: k_start , k_end, its, ite, jts, jte
+   INTEGER                         :: ids , ide , jds , jde , kds , kde , &
+                                      ims , ime , jms , jme , kms , kme , &
+                                      ips , ipe , jps , jpe , kps , kpe
+
+   INTEGER                         :: sids , side , sjds , sjde , skds , skde , &
+                                      sims , sime , sjms , sjme , skms , skme , &
+                                      sips , sipe , sjps , sjpe , skps , skpe
+
+
+   INTEGER ::              imsx, imex, jmsx, jmex, kmsx, kmex,    &
+                           ipsx, ipex, jpsx, jpex, kpsx, kpex,    &
+                           imsy, imey, jmsy, jmey, kmsy, kmey,    &
+                           ipsy, ipey, jpsy, jpey, kpsy, kpey
+
+   INTEGER                         :: ij , iteration
+   INTEGER                         :: im , num_3d_m , ic , num_3d_c , is , num_3d_s
+   INTEGER                         :: loop
+   INTEGER                         :: sz
+   INTEGER                         :: iswater
+
+   LOGICAL                         :: specified_bdy, channel_bdy
+
+   REAL                            :: t_new
+
+! storage for tendencies and decoupled state (generated from Registry)
+
+#include <i1_decl.inc>
+! Previous time level of tracer arrays now defined as i1 variables;
+! the state 4d arrays now redefined as 1-time level arrays in Registry.
+! Benefit: save memory in nested runs, since only 1 domain is active at a
+! time.  Potential problem on stack-limited architectures: increases
+! amount of data on program stack by making these automatic arrays.
+
+   INTEGER :: rc 
+   INTEGER :: number_of_small_timesteps, rk_step
+   INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2    ! for prints/plots only
+   INTEGER :: idum1, idum2, dynamics_option
+
+   INTEGER :: rk_order, iwmax, jwmax, kwmax
+   REAL :: dt_rk, dts_rk, dts, dtm, wmax
+   REAL , ALLOCATABLE , DIMENSION(:)  :: max_vert_cfl_tmp, max_horiz_cfl_tmp
+   LOGICAL :: leapfrog
+   INTEGER :: l,kte,kk
+   REAL :: curr_secs
+   INTEGER :: num_sound_steps
+   INTEGER :: idex, jdex
+   REAL    :: max_msft
+   REAL    :: spacing
+
+   INTEGER :: ii, jj !kk is above after l,kte
+   REAL    :: dclat
+   INTEGER :: debug_level
+
+! urban related variables
+   INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS   ! urban
+
+   TYPE(WRFU_TimeInterval)                    :: tmpTimeInterval
+   REAL                                       :: real_time
+   LOGICAL                                    :: adapt_step_flag
+
+! Define benchmarking timers if -DBENCH is compiled
+#include <bench_solve_em_def.h>
+
+!----------------------
+! Executable statements
+!----------------------
+
+!<DESCRIPTION>
+!<pre>
+! solve_em is the main driver for advancing a grid a single timestep.
+! It is a mediation-layer routine -> DM and SM calls are made where 
+! needed for parallel processing.  
+!
+! solve_em can integrate the equations using 3 time-integration methods
+!      
+!    - 3rd order Runge-Kutta time integration (recommended)
+!      
+!    - 2nd order Runge-Kutta time integration
+!      
+! The main sections of solve_em are
+!     
+! (1) Runge-Kutta (RK) loop
+!     
+! (2) Non-timesplit physics (i.e., tendencies computed for updating
+!     model state variables during the first RK sub-step (loop)
+!     
+! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
+!     
+! (4) scalar advance for moist and chem scalar variables (and TKE)
+!     within the RK sub-steps.
+!     
+! (5) time-split physics (after the RK step), currently this includes
+!     only microphyics
+!
+! A more detailed description of these sections follows.
+!</pre>
+!</DESCRIPTION>
+
+! Initialize timers if compiled with -DBENCH
+#include <bench_solve_em_init.h>
+
+!  set runge-kutta solver (2nd or 3rd order)
+
+   dynamics_option = config_flags%rk_ord
+
+!  Obtain dimension information stored in the grid data structure.
+
+   CALL get_ijk_from_grid (  grid ,                   &
+                             ids, ide, jds, jde, kds, kde,    &
+                             ims, ime, jms, jme, kms, kme,    &
+                             ips, ipe, jps, jpe, kps, kpe,    &
+                             imsx, imex, jmsx, jmex, kmsx, kmex,    &
+                             ipsx, ipex, jpsx, jpex, kpsx, kpex,    &
+                             imsy, imey, jmsy, jmey, kmsy, kmey,    &
+                             ipsy, ipey, jpsy, jpey, kpsy, kpey )
+ 
+   CALL get_ijk_from_subgrid (  grid ,                   &
+                             sids, side, sjds, sjde, skds, skde,    &
+                             sims, sime, sjms, sjme, skms, skme,    &
+                             sips, sipe, sjps, sjpe, skps, skpe    )
+   k_start         = kps
+   k_end           = kpe
+
+   num_3d_m        = num_moist
+   num_3d_c        = num_chem
+   num_3d_s        = num_scalar
+
+
+!  Compute these starting and stopping locations for each tile and number of tiles.
+!  See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
+   CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
+
+!  Max values of CFL for adaptive time step scheme
+
+   ALLOCATE (max_vert_cfl_tmp(grid%num_tiles))
+   ALLOCATE (max_horiz_cfl_tmp(grid%num_tiles))
+
+   grid%itimestep = grid%itimestep + 1
+
+   IF (config_flags%polar) dclat = 90./REAL(jde-jds) !(0.5 * 180/ny)
+
+!**********************************************************************
+!
+!  LET US BEGIN.......
+!
+!<DESCRIPTION>
+!<pre>
+! (1) RK integration loop is named the "Runge_Kutta_loop:"
+!
+!   Predictor-corrector type time integration.
+!   Advection terms are evaluated at time t for the predictor step,
+!   and advection is re-evaluated with the latest predicted value for
+!   each succeeding time corrector step
+!
+!   2nd order Runge Kutta (rk_order = 2):
+!   Step 1 is taken to the midpoint predictor, step 2 is the full step.
+!
+!   3rd order Runge Kutta (rk_order = 3):
+!   Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
+!   and step 3 is from t to dt.
+!
+!   non-timesplit physics are evaluated during first RK step and
+!   these physics tendencies are stored for use in each RK pass.
+!</pre>
+!</DESCRIPTION>
+!**********************************************************************
+
+#ifdef WRF_CHEM
+!
+!    prepare chem aerosols for advection before communication
+!
+
+   kte=min(k_end,kde-1)
+# ifdef DM_PARALLEL
+   if ( num_chem >= PARAM_FIRST_SCALAR ) then
+!-----------------------------------------------------------------------
+! see matching halo calls below for stencils
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_CHEM_E_3.inc"
+       IF( config_flags%progn > 0 ) THEN
+#         include "HALO_EM_SCALAR_E_3.inc"
+       ENDIF
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_CHEM_E_5.inc"
+       IF( config_flags%progn > 0 ) THEN
+#         include "HALO_EM_SCALAR_E_5.inc"
+      ENDIF
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   ENDIF
+# endif
+!--------------------------------------------------------------
+#endif
+
+   rk_order = config_flags%rk_ord
+
+
+  !
+  ! Calculate current time in seconds since beginning of model run.
+  !   Unfortunately, ESMF does not seem to have a way to return
+  !   floating point seconds based on a TimeInterval.  So, we will
+  !   calculate it here--but, this is not clean!!
+  !
+   tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_start_time ( grid )
+   curr_secs = real_time(tmpTimeInterval)
+
+!-----------------------------------------------------------------------------
+! Adaptive time step: Added by T. Hutchinson, WSI  3/5/07
+!   In this call, we do the time-step adaptation and set time-dependent lateral
+!   boundary condition nudging weights.
+!
+   IF (config_flags%use_adaptive_time_step) THEN
+     CALL adapt_timestep(grid, config_flags)
+     adapt_step_flag = .TRUE.
+   ELSE
+     adapt_step_flag = .FALSE.
+   ENDIF
+! End of adaptive time step modifications
+!-----------------------------------------------------------------------------
+
+   IF ( grid%time_step_sound == 0 ) THEN
+! This function will give 4 for 6*dx and 6 for 10*dx and returns even numbers only
+     spacing = min(grid%dx, grid%dy)
+     IF ( ( config_flags%use_adaptive_time_step ) .AND. ( config_flags%map_proj == PROJ_CASSINI ) ) THEN
+       max_msft=MIN ( MAX(grid%max_msftx, grid%max_msfty) , &
+                      1.0/COS(config_flags%fft_filter_lat*degrad) )
+       num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
+     ELSE IF  ( config_flags%use_adaptive_time_step ) THEN
+       max_msft= MAX(grid%max_msftx, grid%max_msfty)
+       num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
+     ELSE
+       num_sound_steps = max ( 2 * ( INT (300. * grid%dt /  spacing             - 0.01 ) + 1 ), 4 )
+     END IF
+     WRITE(wrf_err_message,*)'grid spacing, dt, time_step_sound=',spacing,grid%dt,num_sound_steps
+     CALL wrf_debug ( 50 , wrf_err_message )
+   ELSE
+     num_sound_steps = grid%time_step_sound
+   ENDIF
+
+   IF (config_flags%use_adaptive_time_step) THEN
+  
+     CALL get_wrf_debug_level( debug_level )
+     IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
+#ifdef DM_PARALLEL
+       CALL wrf_dm_maxval(grid%max_vert_cfl, idex, jdex)
+#endif
+       WRITE(wrf_err_message,*)'variable dt, max horiz cfl, max vert cfl: ',&
+            grid%dt, grid%max_horiz_cfl, grid%max_vert_cfl
+       CALL wrf_debug ( 0 , wrf_err_message )
+     ENDIF
+
+     grid%max_cfl_val = 0
+     grid%max_horiz_cfl = 0
+     grid%max_vert_cfl = 0
+   ENDIF
+
+   dts = grid%dt/float(num_sound_steps)
+
+   Runge_Kutta_loop:  DO rk_step = 1, rk_order
+
+   !  Set the step size and number of small timesteps for
+   !  each part of the timestep
+
+     dtm = grid%dt
+     IF ( rk_order == 1 ) THEN   
+
+       write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
+       CALL wrf_error_fatal( wrf_err_message )
+
+     ELSE IF ( rk_order == 2 ) THEN   ! 2nd order Runge-Kutta timestep
+
+       IF ( rk_step == 1) THEN
+         dt_rk  = 0.5*grid%dt
+         dts_rk = dts
+         number_of_small_timesteps = num_sound_steps/2
+       ELSE
+         dt_rk = grid%dt
+         dts_rk = dts
+         number_of_small_timesteps = num_sound_steps
+       ENDIF
+
+     ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
+
+       IF ( rk_step == 1) THEN
+         dt_rk = grid%dt/3.
+         dts_rk = dt_rk
+         number_of_small_timesteps = 1
+       ELSE IF (rk_step == 2) THEN
+         dt_rk  = 0.5*grid%dt
+         dts_rk = dts
+         number_of_small_timesteps = num_sound_steps/2
+       ELSE
+         dt_rk = grid%dt
+         dts_rk = dts
+         number_of_small_timesteps = num_sound_steps
+       ENDIF
+
+     ELSE
+
+       write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
+       CALL wrf_error_fatal( wrf_err_message )
+
+     END IF
+
+!  Ensure that polar meridional velocity is zero
+     IF (config_flags%polar) THEN 
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+         CALL zero_pole ( grid%v_1,                      &
+                          ids, ide, jds, jde, kds, kde,     &
+                          ims, ime, jms, jme, kms, kme,     &
+                          grid%i_start(ij), grid%i_end(ij), &
+                          grid%j_start(ij), grid%j_end(ij), &
+                          k_start, k_end                   )
+         CALL zero_pole ( grid%v_2,                      &
+                          ids, ide, jds, jde, kds, kde,     &
+                          ims, ime, jms, jme, kms, kme,     &
+                          grid%i_start(ij), grid%i_end(ij), &
+                          grid%j_start(ij), grid%j_end(ij), &
+                          k_start, k_end                   )
+       END DO
+       !$OMP END PARALLEL DO
+     END IF
+!
+!  Time level t is in the *_2 variable in the first part 
+!  of the step, and in the *_1 variable after the predictor.
+!  the latest predicted values are stored in the *_2 variables.
+!
+     CALL wrf_debug ( 200 , ' call rk_step_prep ' )
+
+BENCH_START(step_prep_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+
+     DO ij = 1 , grid%num_tiles
+
+       CALL rk_step_prep  ( config_flags, rk_step,            &
+                            grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2, grid%mu_2,   &
+                            moist,                            &
+                            grid%ru, grid%rv, grid%rw, grid%ww, grid%php, grid%alt, grid%muu, grid%muv,   &
+                            grid%mub, grid%mut, grid%phb, grid%pb, grid%p, grid%al, grid%alb,    &
+                            cqu, cqv, cqw,                    &
+                            grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv,        &
+                            grid%msfvy, grid%msftx, grid%msfty,                        &
+                            grid%fnm, grid%fnp, grid%dnw, grid%rdx, grid%rdy,          &
+                            num_3d_m,                         &
+                            ids, ide, jds, jde, kds, kde,     &
+                            ims, ime, jms, jme, kms, kme,     &
+                            grid%i_start(ij), grid%i_end(ij), &
+                            grid%j_start(ij), grid%j_end(ij), &
+                            k_start, k_end                   )
+
+     END DO
+     !$OMP END PARALLEL DO
+BENCH_END(step_prep_tim)
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!  Note:  the small size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
+!         as state variables in the mass coordinate model, as
+!         opposed to the coupled variables as in the height
+!         coordinate model.
+!
+!                           * * * * *
+!         *        * * *    * * * * *
+!       * + *      * + *    * * + * * 
+!         *        * * *    * * * * *
+!                           * * * * *
+!
+!  3D variables - note staggering!  ru(X), rv(Y), ww(Z), php(Z)
+!
+!  ru     x
+!  rv     x
+!  ww     x
+!  php    x
+!  alt    x
+!  ph_2   x
+!  phb    x
+!
+!  the following are 2D (xy) variables
+!
+!  muu    x
+!  muv    x
+!  mut    x
+!--------------------------------------------------------------
+#    include "HALO_EM_A.inc"
+#endif
+
+! set boundary conditions on variables 
+! from big_step_prep for use in big_step_proc
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_A.inc"
+#endif
+
+BENCH_START(set_phys_bc_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij, ii, jj, kk )
+
+     DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
+
+       CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww,      & 
+                              grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p,        &
+                              ids, ide, jds, jde, kds, kde,      &
+                              ims, ime, jms, jme, kms, kme,      &
+                              ips, ipe, jps, jpe, kps, kpe,      &
+                              grid%i_start(ij), grid%i_end(ij),  &
+                              grid%j_start(ij), grid%j_end(ij),  &
+                              k_start, k_end                )
+       CALL set_physical_bc3d( grid%al, 'p', config_flags,            &
+                              ids, ide, jds, jde, kds, kde,     &
+                              ims, ime, jms, jme, kms, kme,     &
+                              ips, ipe, jps, jpe, kps, kpe,     &
+                              grid%i_start(ij), grid%i_end(ij), &
+                              grid%j_start(ij), grid%j_end(ij), &
+                              k_start    , k_end               )
+       CALL set_physical_bc3d( grid%ph_2, 'w', config_flags,            &
+                              ids, ide, jds, jde, kds, kde, &
+                              ims, ime, jms, jme, kms, kme, &
+                              ips, ipe, jps, jpe, kps, kpe, &
+                              grid%i_start(ij), grid%i_end(ij),        &
+                              grid%j_start(ij), grid%j_end(ij),        &
+                              k_start, k_end                )
+
+       IF (config_flags%polar) THEN 
+
+!-------------------------------------------------------
+! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
+!-------------------------------------------------------
+
+         CALL pole_point_bc ( grid%v_1,                      &
+                              ids, ide, jds, jde, kds, kde,     &
+                              ims, ime, jms, jme, kms, kme,     &
+                              grid%i_start(ij), grid%i_end(ij), &
+                              grid%j_start(ij), grid%j_end(ij), &
+                              k_start, k_end                   )
+ 
+         CALL pole_point_bc ( grid%v_2,                      &
+                              ids, ide, jds, jde, kds, kde,     &
+                              ims, ime, jms, jme, kms, kme,     &
+                              grid%i_start(ij), grid%i_end(ij), &
+                              grid%j_start(ij), grid%j_end(ij), &
+                              k_start, k_end                   )
+ 
+!-------------------------------------------------------
+! end lat-lon grid pole-point (v) specification
+!-------------------------------------------------------
+
+       ENDIF
+     END DO
+     !$OMP END PARALLEL DO
+BENCH_END(set_phys_bc_tim)
+
+     rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
+
+!<DESCRIPTION>
+!<pre>
+!(2) The non-timesplit physics begins with a call to "phy_prep"
+!    (which computes some diagnostic variables such as temperature,
+!    pressure, u and v at p points, etc).  This is followed by
+!    calls to the physics drivers:
+!
+!              radiation,
+!              surface,
+!              pbl,
+!              cumulus,
+!              fddagd,
+!              3D TKE and mixing.
+!<pre>
+!</DESCRIPTION>
+
+       CALL first_rk_step_part1 (    grid, config_flags         &
+                             , moist , moist_tend               &
+                             , chem  , chem_tend                &
+                             , scalar , scalar_tend             &
+                             , fdda3d, fdda2d                   &
+                             , ru_tendf, rv_tendf               &
+                             , rw_tendf, t_tendf                &
+                             , ph_tendf, mu_tendf               &
+                             , tke_tend                         &
+                             , adapt_step_flag , curr_secs      &
+                             , psim , psih , wspd , gz1oz0      &
+                             , br , chklowq                     &
+                             , cu_act_flag , hol , th_phy       &
+                             , pi_phy , p_phy , t_phy           &
+                             , u_phy , v_phy                    &
+                             , dz8w , p8w , t8w , rho_phy , rho &
+                             , z_at_w , mu_3d                   &
+                             , ids, ide, jds, jde, kds, kde     &
+                             , ims, ime, jms, jme, kms, kme     &
+                             , ips, ipe, jps, jpe, kps, kpe     &
+                             , k_start , k_end                  &
+                            )
+
+       CALL first_rk_step_part2 (    grid, config_flags         &
+                             , moist , moist_tend               &
+                             , chem  , chem_tend                &
+                             , scalar , scalar_tend             &
+                             , fdda3d, fdda2d                   &
+                             , ru_tendf, rv_tendf               &
+                             , rw_tendf, t_tendf                &
+                             , ph_tendf, mu_tendf               &
+                             , tke_tend                         &
+                             , adapt_step_flag , curr_secs      &
+                             , psim , psih , wspd , gz1oz0      &
+                             , br , chklowq                     &
+                             , cu_act_flag , hol , th_phy       &
+                             , pi_phy , p_phy , t_phy           &
+                             , u_phy , v_phy                    &
+                             , dz8w , p8w , t8w , rho_phy , rho &
+                             , z_at_w , mu_3d                   &
+                             , ids, ide, jds, jde, kds, kde     &
+                             , ims, ime, jms, jme, kms, kme     &
+                             , ips, ipe, jps, jpe, kps, kpe     &
+                             , k_start , k_end                  &
+                            )
+
+     END IF rk_step_is_one
+
+BENCH_START(rk_tend_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_tendency' )
+       CALL rk_tendency ( config_flags, rk_step                                                                &
+                         ,grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend                                 &
+                         ,ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf                                      &
+                         ,mu_tend, grid%u_save, grid%v_save, w_save, ph_save                                   &
+                         ,grid%t_save, mu_save, grid%rthften                                                   &
+                         ,grid%ru, grid%rv, grid%rw, grid%ww                                                   &
+                         ,grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2                                    &
+                         ,grid%u_1, grid%v_1, grid%w_1, grid%t_1, grid%ph_1                                    &
+                         ,grid%h_diabatic, grid%phb, grid%t_init                                               &
+                         ,grid%mu_2, grid%mut, grid%muu, grid%muv, grid%mub                                    &
+                         ,grid%al, grid%alt, grid%p, grid%pb, grid%php, cqu, cqv, cqw                          &
+                         ,grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base                     &
+                         ,grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv                                    &
+                         ,grid%msfvy, grid%msftx,grid%msfty, grid%xlat, grid%f, grid%e, grid%sina, grid%cosa   &
+                         ,grid%fnm, grid%fnp, grid%rdn, grid%rdnw                                              &
+                         ,grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, grid%xkmh, grid%xkhh            &
+                         ,grid%diff_6th_opt, grid%diff_6th_factor                                              &
+                         ,grid%dampcoef,grid%zdamp,config_flags%damp_opt                                       &
+                         ,grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m                          &
+                         ,config_flags%non_hydrostatic, config_flags%top_lid                                   &
+                         ,grid%u_frame, grid%v_frame                                                           &
+                         ,ids, ide, jds, jde, kds, kde                                                         &
+                         ,ims, ime, jms, jme, kms, kme                                                         &
+                         ,grid%i_start(ij), grid%i_end(ij)                                                     &
+                         ,grid%j_start(ij), grid%j_end(ij)                                                     &
+                         ,k_start, k_end                                                                       &
+                         ,max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij)                                         )
+     END DO
+     !$OMP END PARALLEL DO
+BENCH_END(rk_tend_tim)
+
+     IF (config_flags%use_adaptive_time_step) THEN
+       DO ij = 1 , grid%num_tiles
+         IF (max_horiz_cfl_tmp(ij) .GT. grid%max_horiz_cfl) THEN
+           grid%max_horiz_cfl = max_horiz_cfl_tmp(ij)
+         ENDIF
+         IF (max_vert_cfl_tmp(ij) .GT. grid%max_vert_cfl) THEN
+           grid%max_vert_cfl = max_vert_cfl_tmp(ij)
+         ENDIF
+       END DO
+     
+       IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
+         grid%max_cfl_val = grid%max_horiz_cfl
+       ENDIF
+       IF (grid%max_vert_cfl .GT. grid%max_cfl_val) THEN
+         grid%max_cfl_val = grid%max_vert_cfl
+       ENDIF
+     ENDIF
+
+BENCH_START(relax_bdy_dry_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+       IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN 
+
+         CALL relax_bdy_dry ( config_flags,                                &
+                              grid%u_save, grid%v_save, ph_save, grid%t_save,             &
+                              w_save, mu_tend,                             & 
+                              grid%ru, grid%rv, grid%ph_2, grid%t_2,                           &
+                              grid%w_2, grid%mu_2, grid%mut,                              &
+                              grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
+                              grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
+                              grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
+                              grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
+                              grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
+                              grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
+                              grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
+                              grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
+                              grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
+                              grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
+                              grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
+                              grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
+                              config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone,       &
+                              grid%dtbc, grid%fcx, grid%gcx,                              &
+                              ids,ide, jds,jde, kds,kde,                   &
+                              ims,ime, jms,jme, kms,kme,                   &
+                              ips,ipe, jps,jpe, kps,kpe,                   &
+                              grid%i_start(ij), grid%i_end(ij),            &
+                              grid%j_start(ij), grid%j_end(ij),            &
+                              k_start, k_end                              )
+
+       ENDIF
+
+       CALL rk_addtend_dry( grid%ru_tend,  grid%rv_tend,  rw_tend,  ph_tend,  t_tend,  &
+                            ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
+                            grid%u_save, grid%v_save, w_save, ph_save, grid%t_save, &
+                            mu_tend, mu_tendf, rk_step,                      &
+                            grid%h_diabatic, grid%mut, grid%msftx,        &
+                            grid%msfty, grid%msfux,grid%msfuy,               &
+                            grid%msfvx, grid%msfvx_inv, grid%msfvy,          &
+                            ids,ide, jds,jde, kds,kde,                       &
+                            ims,ime, jms,jme, kms,kme,                       &
+                            ips,ipe, jps,jpe, kps,kpe,                       &
+                            grid%i_start(ij), grid%i_end(ij),                &
+                            grid%j_start(ij), grid%j_end(ij),                &
+                            k_start, k_end                                  )
+
+       IF( config_flags%specified .or. config_flags%nested ) THEN 
+         CALL spec_bdy_dry ( config_flags,                                    &
+                             grid%ru_tend, grid%rv_tend, ph_tend, t_tend,               &
+                             rw_tend, mu_tend,                                &
+                             grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
+                             grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
+                             grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
+                             grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
+                             grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
+                             grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
+                             grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
+                             grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
+                             grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
+                             grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
+                             grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
+                             grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
+                             config_flags%spec_bdy_width, grid%spec_zone,                       &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             grid%i_start(ij), grid%i_end(ij),                &
+                             grid%j_start(ij), grid%j_end(ij),                &
+                             k_start, k_end                                  )
+     
+       ENDIF
+
+     END DO
+     !$OMP END PARALLEL DO
+BENCH_END(relax_bdy_dry_tim)
+
+!<DESCRIPTION>
+!<pre>
+! (3) Small (acoustic,sound) steps.
+!
+!    Several acoustic steps are taken each RK pass.  A small step 
+!    sequence begins with calculating perturbation variables 
+!    and coupling them to the column dry-air-mass mu 
+!    (call to small_step_prep).  This is followed by computing
+!    coefficients for the vertically implicit part of the
+!    small timestep (call to calc_coef_w).  
+!
+!    The small steps are taken
+!    in the named loop "small_steps:".  In the small_steps loop, first 
+!    the horizontal momentum (u and v) are advanced (call to advance_uv),
+!    next mu and theta are advanced (call to advance_mu_t) followed by
+!    advancing w and the geopotential (call to advance_w).  Diagnostic
+!    values for pressure and inverse density are updated at the end of
+!    each small_step.
+!
+!    The small-step section ends with the change of the perturbation variables
+!    back to full variables (call to small_step_finish).
+!</pre>
+!</DESCRIPTION>
+
+BENCH_START(small_step_prep_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+    ! Calculate coefficients for the vertically implicit acoustic/gravity wave
+    ! integration.  We only need calculate these for the first pass through -
+    ! the predictor step.  They are reused as is for the corrector step.
+    ! For third-order RK, we need to recompute these after the first 
+    ! predictor because we may have changed the small timestep -> grid%dts.
+
+       CALL wrf_debug ( 200 , ' call small_step_prep ' )
+
+       CALL small_step_prep( grid%u_1,grid%u_2,grid%v_1,grid%v_2,grid%w_1,grid%w_2,   &
+                             grid%t_1,grid%t_2,grid%ph_1,grid%ph_2,                   &
+                             grid%mub, grid%mu_1, grid%mu_2,                          &
+                             grid%muu, muus, grid%muv, muvs,                          &
+                             grid%mut, grid%muts, grid%mudf,                          &
+                             grid%u_save, grid%v_save, w_save,                        &
+                             grid%t_save, ph_save, mu_save,                           &
+                             grid%ww, ww1,                                            &
+                             grid%dnw, c2a, grid%pb, grid%p, grid%alt,                &
+                             grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,       &
+                             grid%msfvy, grid%msftx,grid%msfty,                       &
+                             grid%rdx, grid%rdy, rk_step,                             &
+                             ids, ide, jds, jde, kds, kde,                            &
+                             ims, ime, jms, jme, kms, kme,                            &
+                             grid%i_start(ij), grid%i_end(ij),                        &
+                             grid%j_start(ij), grid%j_end(ij),                        &
+                             k_start    , k_end                                       )
+ 
+       CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
+                        grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
+                        grid%mu_2, grid%muts, grid%znu, t0,         &
+                        grid%rdnw, grid%dnw, grid%smdiv,            &
+                        config_flags%non_hydrostatic, 0,            &
+                        ids, ide, jds, jde, kds, kde,               &
+                        ims, ime, jms, jme, kms, kme,               &
+                        grid%i_start(ij), grid%i_end(ij),           &
+                        grid%j_start(ij), grid%j_end(ij),           &
+                        k_start    , k_end                          )
+
+       IF (config_flags%non_hydrostatic) THEN
+         CALL calc_coef_w( a,alpha,gamma,                    &
+                           grid%mut, cqw,                    &
+                           grid%rdn, grid%rdnw, c2a,         &
+                           dts_rk, g, grid%epssm,            &
+                           config_flags%top_lid,             &
+                           ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           grid%i_start(ij), grid%i_end(ij), &
+                           grid%j_start(ij), grid%j_end(ij), &
+                           k_start    , k_end               )
+       ENDIF
+
+     ENDDO
+     !$OMP END PARALLEL DO
+BENCH_END(small_step_prep_tim)
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!  Note:  the small size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
+!         as state variables in the mass coordinate model, as
+!         opposed to the coupled variables as in the height
+!         coordinate model.
+!
+!                              * * * * *
+!            *        * * *    * * * * *
+!          * + *      * + *    * * + * * 
+!            *        * * *    * * * * *
+!                              * * * * *
+!
+!  3D variables - note staggering!  ph_2(Z), u_save(X), v_save(Y)
+!
+!  ph_2      x
+!  al        x
+!  p         x
+!  t_1       x
+!  t_save    x
+!  u_save    x
+!  v_save    x
+!
+!  the following are 2D (xy) variables
+!
+!  mu_1      x
+!  mu_2      x
+!  mudf      x
+!  php       x
+!  alt       x
+!  pb        x
+!--------------------------------------------------------------
+#      include "HALO_EM_B.inc"
+#      include "PERIOD_BDY_EM_B.inc"
+#endif
+
+BENCH_START(set_phys_bc2_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+
+     DO ij = 1 , grid%num_tiles
+
+       CALL set_physical_bc3d( grid%ru_tend, 'u', config_flags,      &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%rv_tend, 'v', config_flags,      &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%ph_2, 'w', config_flags,         &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%al, 'p', config_flags,           &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%p, 'p', config_flags,            &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%t_1, 'p', config_flags,          &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%t_save, 't', config_flags,       &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc2d( grid%mu_1, 't', config_flags,         &
+                               ids, ide, jds, jde,                   &
+                               ims, ime, jms, jme,                   &
+                               ips, ipe, jps, jpe,                   &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij)      )
+
+       CALL set_physical_bc2d( grid%mu_2, 't', config_flags,         &
+                               ids, ide, jds, jde,                   &
+                               ims, ime, jms, jme,                   &
+                               ips, ipe, jps, jpe,                   &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij)      )
+
+       CALL set_physical_bc2d( grid%mudf, 't', config_flags,         &
+                               ids, ide, jds, jde,                   &
+                               ims, ime, jms, jme,                   &
+                               ips, ipe, jps, jpe,                   &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij)      )
+
+     END DO
+     !$OMP END PARALLEL DO
+BENCH_END(set_phys_bc2_tim)
+     small_steps : DO iteration = 1 , number_of_small_timesteps
+
+       ! Boundary condition time (or communication time).  
+#ifdef DM_PARALLEL
+#      include "PERIOD_BDY_EM_B.inc"
+#endif
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+
+       DO ij = 1 , grid%num_tiles
+
+BENCH_START(advance_uv_tim)
+         CALL advance_uv ( grid%u_2, grid%ru_tend, grid%v_2, grid%rv_tend,        &
+                           grid%p, grid%pb,                                       &
+                           grid%ph_2, grid%php, grid%alt,  grid%al,               &
+                           grid%mu_2,                                             &
+                           grid%muu, cqu, grid%muv, cqv, grid%mudf,               &
+                           grid%msfux, grid%msfuy, grid%msfvx,                    &
+                           grid%msfvx_inv, grid%msfvy,                            &
+                           grid%rdx, grid%rdy, dts_rk,                            &
+                           grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp,      &
+                           grid%emdiv,                                            &
+                           grid%rdnw, config_flags,grid%spec_zone,                &
+                           config_flags%non_hydrostatic, config_flags%top_lid,    &
+                           ids, ide, jds, jde, kds, kde,                          &
+                           ims, ime, jms, jme, kms, kme,                          &
+                           grid%i_start(ij), grid%i_end(ij),                      &
+                           grid%j_start(ij), grid%j_end(ij),                      &
+                           k_start    , k_end                                     )
+BENCH_END(advance_uv_tim)
+
+       END DO
+       !$OMP END PARALLEL DO
+
+!-----------------------------------------------------------
+!  acoustic integration polar filter for smallstep u, v
+!-----------------------------------------------------------
+
+       IF (config_flags%polar) THEN
+
+         CALL pxft ( grid=grid                                              &
+               ,lineno=__LINE__                                             &
+               ,flag_uv            = 1                                      &
+               ,flag_rurv          = 0                                      &
+               ,flag_wph           = 0                                      &
+               ,flag_ww            = 0                                      &
+               ,flag_t             = 0                                      &
+               ,flag_mu            = 0                                      &
+               ,flag_mut           = 0                                      &
+               ,flag_moist         = 0                                      &
+               ,flag_chem          = 0                                      &
+               ,flag_scalar        = 0                                      &
+               ,positive_definite  = .FALSE.                                &
+               ,moist=moist,chem=chem,scalar=scalar                         &
+               ,fft_filter_lat = config_flags%fft_filter_lat                &
+               ,dclat = dclat                                               &
+               ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+               ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+               ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+               ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+               ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+       END IF
+
+!-----------------------------------------------------------
+!  end acoustic integration polar filter for smallstep u, v
+!-----------------------------------------------------------
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+BENCH_START(spec_bdy_uv_tim)
+         IF( config_flags%specified .or. config_flags%nested ) THEN
+           CALL spec_bdyupdate(grid%u_2, grid%ru_tend, dts_rk,      &
+                               'u'         , config_flags, &
+                                grid%spec_zone,                  &
+                                ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                grid%i_start(ij), grid%i_end(ij),         &
+                                grid%j_start(ij), grid%j_end(ij),         &
+                                k_start    , k_end             )
+
+           CALL spec_bdyupdate(grid%v_2, grid%rv_tend, dts_rk,      &
+                                'v'         , config_flags, &
+                                grid%spec_zone,                  &
+                                ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                grid%i_start(ij), grid%i_end(ij),         &
+                                grid%j_start(ij), grid%j_end(ij),         &
+                                k_start    , k_end             )
+
+         ENDIF
+BENCH_END(spec_bdy_uv_tim)
+
+       END DO
+       !$OMP END PARALLEL DO
+
+#ifdef DM_PARALLEL
+!
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!         *                     *
+!       * + *      * + *        +
+!         *                     *
+!
+!  u_2               x
+!  v_2                          x
+!
+#     include "HALO_EM_C.inc"
+#endif
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+        !  advance the mass in the column, theta, and calculate ww
+
+BENCH_START(advance_mu_t_tim)
+         CALL advance_mu_t( grid%ww, ww1, grid%u_2, grid%u_save, grid%v_2, grid%v_save, &
+                          grid%mu_2, grid%mut, muave, grid%muts, grid%muu, grid%muv,    &
+                          grid%mudf, grid%ru_m, grid%rv_m, grid%ww_m,                   &
+                          grid%t_2, grid%t_save, t_2save, t_tend,                       &
+                          mu_tend,                                                      &
+                          grid%rdx, grid%rdy, dts_rk, grid%epssm,                       &
+                          grid%dnw, grid%fnm, grid%fnp, grid%rdnw,                      &
+                          grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,            &
+                          grid%msfvy, grid%msftx,grid%msfty,                            &
+                          iteration, config_flags,                                      &
+                          ids, ide, jds, jde, kds, kde,      &
+                          ims, ime, jms, jme, kms, kme,      &
+                          grid%i_start(ij), grid%i_end(ij),  &
+                          grid%j_start(ij), grid%j_end(ij),  &
+                          k_start    , k_end                )
+BENCH_END(advance_mu_t_tim)
+       ENDDO
+       !$OMP END PARALLEL DO
+
+!-----------------------------------------------------------
+!  acoustic integration polar filter for smallstep mu, t
+!-----------------------------------------------------------
+
+       IF ( (config_flags%polar) ) THEN
+
+         CALL pxft ( grid=grid                                               &
+                ,lineno=__LINE__                                             &
+                ,flag_uv            = 0                                      &
+                ,flag_rurv          = 0                                      &
+                ,flag_wph           = 0                                      &
+                ,flag_ww            = 0                                      &
+                ,flag_t             = 1                                      &
+                ,flag_mu            = 1                                      &
+                ,flag_mut           = 0                                      &
+                ,flag_moist         = 0                                      &
+                ,flag_chem          = 0                                      &
+                ,flag_scalar        = 0                                      &
+                ,positive_definite  = .FALSE.                                &
+                ,moist=moist,chem=chem,scalar=scalar                         &
+                ,fft_filter_lat = config_flags%fft_filter_lat                &
+                ,dclat = dclat                                               &
+                ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+         grid%muts = grid%mut + grid%mu_2  ! reset muts using filtered mu_2
+ 
+       END IF
+
+!-----------------------------------------------------------
+!  end acoustic integration polar filter for smallstep mu, t
+!-----------------------------------------------------------
+
+BENCH_START(spec_bdy_t_tim)
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+         IF( config_flags%specified .or. config_flags%nested ) THEN
+
+           CALL spec_bdyupdate(grid%t_2, t_tend, dts_rk,        &
+                               't'         , config_flags,      &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,       &
+                               ims,ime, jms,jme, kms,kme,       &
+                               ips,ipe, jps,jpe, kps,kpe,       &
+                               grid%i_start(ij), grid%i_end(ij),&
+                               grid%j_start(ij), grid%j_end(ij),&
+                               k_start    , k_end              )
+
+           CALL spec_bdyupdate(grid%mu_2, mu_tend, dts_rk,       &
+                               'm'         , config_flags,      &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, 1  ,1  ,       &
+                               ims,ime, jms,jme, 1  ,1  ,       &
+                               ips,ipe, jps,jpe, 1  ,1  ,       &
+                               grid%i_start(ij), grid%i_end(ij),&
+                               grid%j_start(ij), grid%j_end(ij),&
+                               1    , 1             )
+
+           CALL spec_bdyupdate(grid%muts, mu_tend, dts_rk,      &
+                              'm'         , config_flags, &
+                              grid%spec_zone,                  &
+                              ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
+                              ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
+                              ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
+                              grid%i_start(ij), grid%i_end(ij),         &
+                              grid%j_start(ij), grid%j_end(ij),         &
+                              1    , 1             )
+         ENDIF
+BENCH_END(spec_bdy_t_tim)
+
+         ! small (acoustic) step for the vertical momentum,
+         ! density and coupled potential temperature.
+
+
+BENCH_START(advance_w_tim)
+         IF ( config_flags%non_hydrostatic ) THEN
+           CALL advance_w( grid%w_2, rw_tend, grid%ww, w_save,         &
+                           grid%u_2, grid%v_2,                         &
+                           grid%mu_2, grid%mut, muave, grid%muts,      &
+                           t_2save, grid%t_2, grid%t_save,             &
+                           grid%ph_2, ph_save, grid%phb, ph_tend,      &
+                           grid%ht, c2a, cqw, grid%alt, grid%alb,      &
+                           a, alpha, gamma,                            &
+                           grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
+                           grid%dnw, grid%fnm, grid%fnp, grid%rdnw,    &
+                           grid%rdn, grid%cf1, grid%cf2, grid%cf3,     &
+                           grid%msftx, grid%msfty,                     &
+                           config_flags,  config_flags%top_lid,        &
+                           ids,ide, jds,jde, kds,kde,                  &
+                           ims,ime, jms,jme, kms,kme,                  &
+                           grid%i_start(ij), grid%i_end(ij),           &
+                           grid%j_start(ij), grid%j_end(ij),           &
+                           k_start    , k_end                          )
+         ENDIF
+BENCH_END(advance_w_tim)
+
+       ENDDO
+       !$OMP END PARALLEL DO
+
+!-----------------------------------------------------------
+!  acoustic integration polar filter for smallstep w, geopotential
+!-----------------------------------------------------------
+
+       IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
+
+         CALL pxft ( grid=grid                                               &
+                ,lineno=__LINE__                                             &
+                ,flag_uv            = 0                                      &
+                ,flag_rurv          = 0                                      &
+                ,flag_wph           = 1                                      &
+                ,flag_ww            = 0                                      &
+                ,flag_t             = 0                                      &
+                ,flag_mu            = 0                                      &
+                ,flag_mut           = 0                                      &
+                ,flag_moist         = 0                                      &
+                ,flag_chem          = 0                                      &
+                ,flag_scalar        = 0                                      &
+                ,positive_definite  = .FALSE.                                &
+                ,moist=moist,chem=chem,scalar=scalar                         &
+                ,fft_filter_lat = config_flags%fft_filter_lat                &
+                ,dclat = dclat                                               &
+                ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+       END IF
+
+!-----------------------------------------------------------
+!  end acoustic integration polar filter for smallstep w, geopotential
+!-----------------------------------------------------------
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+BENCH_START(sumflux_tim)
+         CALL sumflux ( grid%u_2, grid%v_2, grid%ww,          &
+                        grid%u_save, grid%v_save, ww1,        &
+                        grid%muu, grid%muv,                   &
+                        grid%ru_m, grid%rv_m, grid%ww_m, grid%epssm,  &
+                        grid%msfux, grid% msfuy, grid%msfvx,  &
+                        grid%msfvx_inv, grid%msfvy,           &
+                        iteration, number_of_small_timesteps, &
+                        ids, ide, jds, jde, kds, kde,         &
+                        ims, ime, jms, jme, kms, kme,         &
+                        grid%i_start(ij), grid%i_end(ij),     &
+                        grid%j_start(ij), grid%j_end(ij),     &
+                        k_start    , k_end                   )
+BENCH_END(sumflux_tim)
+
+         IF( config_flags%specified .or. config_flags%nested ) THEN
+
+BENCH_START(spec_bdynhyd_tim)
+           IF (config_flags%non_hydrostatic)  THEN
+             CALL spec_bdyupdate_ph( ph_save, grid%ph_2, ph_tend,     &
+                                     mu_tend, grid%muts, dts_rk,      &
+                                     'h'         , config_flags,      &
+                                     grid%spec_zone,                  &
+                                     ids,ide, jds,jde, kds,kde,       &
+                                     ims,ime, jms,jme, kms,kme,       &
+                                     ips,ipe, jps,jpe, kps,kpe,       &
+                                     grid%i_start(ij), grid%i_end(ij),&
+                                     grid%j_start(ij), grid%j_end(ij),&
+                                     k_start    , k_end               )
+             IF( config_flags%specified ) THEN
+               CALL zero_grad_bdy ( grid%w_2,                         &
+                                    'w'         , config_flags,       &
+                                    grid%spec_zone,                   &
+                                    ids,ide, jds,jde, kds,kde,        &
+                                    ims,ime, jms,jme, kms,kme,        &
+                                    ips,ipe, jps,jpe, kps,kpe,        &
+                                    grid%i_start(ij), grid%i_end(ij), &
+                                    grid%j_start(ij), grid%j_end(ij), &
+                                    k_start    , k_end                )
+             ELSE
+               CALL spec_bdyupdate ( grid%w_2, rw_tend, dts_rk,       &
+                                     'h'         , config_flags,      &
+                                     grid%spec_zone,                  &
+                                     ids,ide, jds,jde, kds,kde,       &
+                                     ims,ime, jms,jme, kms,kme,       &
+                                     ips,ipe, jps,jpe, kps,kpe,       &
+                                     grid%i_start(ij), grid%i_end(ij),&
+                                     grid%j_start(ij), grid%j_end(ij),&
+                                     k_start    , k_end               )
+             ENDIF
+           ENDIF
+BENCH_END(spec_bdynhyd_tim)
+         ENDIF
+
+BENCH_START(cald_p_rho_tim)
+         CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
+                          grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
+                          grid%mu_2, grid%muts, grid%znu, t0,         &
+                          grid%rdnw, grid%dnw, grid%smdiv,            &
+                          config_flags%non_hydrostatic, iteration,    &
+                          ids, ide, jds, jde, kds, kde,     &
+                          ims, ime, jms, jme, kms, kme,     &
+                          grid%i_start(ij), grid%i_end(ij), &
+                          grid%j_start(ij), grid%j_end(ij), &
+                          k_start    , k_end               )
+BENCH_END(cald_p_rho_tim)
+
+       ENDDO
+       !$OMP END PARALLEL DO
+
+#ifdef DM_PARALLEL
+!
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!         *                     *
+!       * + *      * + *        +
+!         *                     *
+!
+!  ph_2   x
+!  al     x
+!  p      x
+!
+!  2D variables (x,y)
+!
+!  mu_2   x
+!  muts   x
+!  mudf   x
+
+#      include "HALO_EM_C2.inc"
+#      include "PERIOD_BDY_EM_B3.inc"
+#endif
+
+BENCH_START(phys_bc_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+       ! boundary condition set for next small timestep
+
+         CALL set_physical_bc3d( grid%ph_2, 'w', config_flags,          &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 ips, ipe, jps, jpe, kps, kpe,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+         CALL set_physical_bc3d( grid%al, 'p', config_flags,            &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 ips, ipe, jps, jpe, kps, kpe,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+         CALL set_physical_bc3d( grid%p, 'p', config_flags,             &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 ips, ipe, jps, jpe, kps, kpe,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+         CALL set_physical_bc2d( grid%muts, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+         CALL set_physical_bc2d( grid%mu_2, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+         CALL set_physical_bc2d( grid%mudf, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+       END DO
+       !$OMP END PARALLEL DO
+BENCH_END(phys_bc_tim)
+
+     END DO small_steps
+
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_small_finish' )
+
+      ! change time-perturbation variables back to 
+      ! full perturbation variables.
+      ! first get updated mu at u and v points
+
+BENCH_START(calc_mu_uv_tim)
+       CALL calc_mu_uv_1 ( config_flags,                     &
+                           grid%muts, muus, muvs,                 &
+                           ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           grid%i_start(ij), grid%i_end(ij), &
+                           grid%j_start(ij), grid%j_end(ij), &
+                           k_start    , k_end               )
+BENCH_END(calc_mu_uv_tim)
+BENCH_START(small_step_finish_tim)
+       CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1,     &
+                               grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1,    &
+                               grid%mu_2, grid%mu_1,                       &
+                               grid%mut, grid%muts, grid%muu, muus, grid%muv, muvs,  & 
+                               grid%u_save, grid%v_save, w_save,           &
+                               grid%t_save, ph_save, mu_save,         &
+                               grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,grid%msfty, &
+                               grid%h_diabatic,                       &
+                               number_of_small_timesteps,dts_rk, &
+                               rk_step, rk_order,                &
+                               ids, ide, jds, jde, kds, kde,     &
+                               ims, ime, jms, jme, kms, kme,     &
+                               grid%i_start(ij), grid%i_end(ij), &
+                               grid%j_start(ij), grid%j_end(ij), &
+                               k_start    , k_end               )
+!  call  to set ru_m, rv_m and ww_m b.c's for PD advection
+
+       IF (rk_step == rk_order) THEN
+
+         CALL set_physical_bc3d( grid%ru_m, 'u', config_flags,   &
+                                 ids, ide, jds, jde, kds, kde,      &
+                                 ims, ime, jms, jme, kms, kme,      &
+                                 ips, ipe, jps, jpe, kps, kpe,      &
+                                 grid%i_start(ij), grid%i_end(ij),  &
+                                 grid%j_start(ij), grid%j_end(ij),  &
+                                 k_start    , k_end                )
+
+         CALL set_physical_bc3d( grid%rv_m, 'v', config_flags,   &
+                                 ids, ide, jds, jde, kds, kde,      &
+                                 ims, ime, jms, jme, kms, kme,      &
+                                 ips, ipe, jps, jpe, kps, kpe,      &
+                                 grid%i_start(ij), grid%i_end(ij),  &
+                                 grid%j_start(ij), grid%j_end(ij),  &
+                                 k_start    , k_end                )
+
+         CALL set_physical_bc3d( grid%ww_m, 'w', config_flags,   &
+                                 ids, ide, jds, jde, kds, kde,      &
+                                 ims, ime, jms, jme, kms, kme,      &
+                                 ips, ipe, jps, jpe, kps, kpe,      &
+                                 grid%i_start(ij), grid%i_end(ij),  &
+                                 grid%j_start(ij), grid%j_end(ij),  &
+                                 k_start    , k_end                )
+
+         CALL set_physical_bc2d( grid%mut, 't', config_flags,   &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,                &
+                                 ips, ipe, jps, jpe,                &
+                                 grid%i_start(ij), grid%i_end(ij),  &
+                                 grid%j_start(ij), grid%j_end(ij) )
+ 
+       END IF
+
+BENCH_END(small_step_finish_tim)
+
+     END DO
+     !$OMP END PARALLEL DO
+
+!-----------------------------------------------------------
+!  polar filter for full dynamics variables and time-averaged mass fluxes 
+!-----------------------------------------------------------
+
+     IF (config_flags%polar) THEN
+
+       CALL pxft ( grid=grid                                                   &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 1                                      &
+                  ,flag_rurv          = 1                                      &
+                  ,flag_wph           = 1                                      &
+                  ,flag_ww            = 1                                      &
+                  ,flag_t             = 1                                      &
+                  ,flag_mu            = 1                                      &
+                  ,flag_mut           = 1                                      &
+                  ,flag_moist         = 0                                      &
+                  ,flag_chem          = 0                                      &
+                  ,flag_scalar        = 0                                      &
+                  ,positive_definite  = .FALSE.                                &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+     END IF
+
+!-----------------------------------------------------------
+!  end polar filter for full dynamics variables and time-averaged mass fluxes 
+!-----------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!  add in physics tendency first if positive definite advection is used.
+!  pd advection applies advective flux limiter on last runge-kutta step
+!-----------------------------------------------------------------------
+! first moisture
+
+     IF (config_flags%pd_moist .and. (rk_step == rk_order)) THEN
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+         CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+         DO im = PARAM_FIRST_SCALAR, num_3d_m
+           CALL rk_update_scalar_pd( im, im,                                   &
+                                     moist_old(ims,kms,jms,im),                &
+                                     moist_tend(ims,kms,jms,im),               &
+                                     grid%mu_1, grid%mu_1, grid%mub,  &
+                                     rk_step, dt_rk, grid%spec_zone,           &
+                                     config_flags,                             &
+                                     ids, ide, jds, jde, kds, kde,             &
+                                     ims, ime, jms, jme, kms, kme,             &
+                                     grid%i_start(ij), grid%i_end(ij),         &
+                                     grid%j_start(ij), grid%j_end(ij),         &
+                                     k_start    , k_end                       )
+         ENDDO
+       END DO
+       !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+#ifdef DM_PARALLEL
+       IF (config_flags%pd_moist) THEN
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_MOIST_OLD_E_5.inc"
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_MOIST_OLD_E_7.inc"
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+       ENDIF
+#endif
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_MOIST_OLD.inc"
+#endif
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+         IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+           DO im = PARAM_FIRST_SCALAR , num_3d_m
+             CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags,   &
+                                     ids, ide, jds, jde, kds, kde,                  &
+                                     ims, ime, jms, jme, kms, kme,                  &
+                                     ips, ipe, jps, jpe, kps, kpe,                  &
+                                     grid%i_start(ij), grid%i_end(ij),              &
+                                     grid%j_start(ij), grid%j_end(ij),              &
+                                     k_start    , k_end                            )
+           END DO
+         ENDIF
+       END DO
+       !$OMP END PARALLEL DO
+
+     END IF  ! end if for pd_moist
+
+! scalars
+
+     IF (config_flags%pd_scalar .and. (rk_step == rk_order)) THEN
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+         CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+         DO im = PARAM_FIRST_SCALAR, num_3d_s
+           CALL rk_update_scalar_pd( im, im,                                  &
+                                     scalar_old(ims,kms,jms,im),              &
+                                     scalar_tend(ims,kms,jms,im),             &
+                                     grid%mu_1, grid%mu_1, grid%mub, &
+                                     rk_step, dt_rk, grid%spec_zone,          &
+                                     config_flags,                            &
+                                     ids, ide, jds, jde, kds, kde,            &
+                                     ims, ime, jms, jme, kms, kme,            &
+                                     grid%i_start(ij), grid%i_end(ij),        &
+                                     grid%j_start(ij), grid%j_end(ij),        &
+                                     k_start    , k_end                      )
+         ENDDO
+       ENDDO
+       !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+#ifdef DM_PARALLEL
+       IF (config_flags%pd_scalar) THEN
+#ifndef RSL
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_SCALAR_OLD_E_5.inc"
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_SCALAR_OLD_E_7.inc"
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+#else
+         WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
+         CALL wrf_error_fatal(TRIM(wrf_err_message))
+#endif   
+  endif
+#endif
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_SCALAR_OLD.inc"
+#endif
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+
+         DO ij = 1 , grid%num_tiles
+           IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+             DO im = PARAM_FIRST_SCALAR , num_3d_s
+               CALL set_physical_bc3d(  scalar_old(ims,kms,jms,im), 'p', config_flags, &
+                                        ids, ide, jds, jde, kds, kde,                    &
+                                        ims, ime, jms, jme, kms, kme,                    &
+                                        ips, ipe, jps, jpe, kps, kpe,                    &
+                                        grid%i_start(ij), grid%i_end(ij),                &
+                                        grid%j_start(ij), grid%j_end(ij),                &
+                                        k_start    , k_end                              )
+             END DO
+           ENDIF
+         END DO
+         !$OMP END PARALLEL DO
+
+       END IF  ! end if for pd_scalar
+
+! chem
+
+       IF (config_flags%pd_chem .and. (rk_step == rk_order)) THEN
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+           DO im = PARAM_FIRST_SCALAR, num_3d_c
+             CALL rk_update_scalar_pd( im, im,                                  &
+                                       chem_old(ims,kms,jms,im),                &
+                                       chem_tend(ims,kms,jms,im),               &
+                                       grid%mu_1, grid%mu_1, grid%mub, &
+                                       rk_step, dt_rk, grid%spec_zone,          &
+                                       config_flags,                            &
+                                       ids, ide, jds, jde, kds, kde,            &
+                                       ims, ime, jms, jme, kms, kme,            &
+                                       grid%i_start(ij), grid%i_end(ij),        &
+                                       grid%j_start(ij), grid%j_end(ij),        &
+                                       k_start    , k_end                      )
+           ENDDO
+         END DO
+         !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+#ifdef DM_PARALLEL
+         IF (config_flags%pd_chem) THEN
+           IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_CHEM_OLD_E_5.inc"
+           ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_CHEM_OLD_E_7.inc"
+           ELSE
+             WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+             CALL wrf_error_fatal(TRIM(wrf_err_message))
+           ENDIF
+         ENDIF
+#endif
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_CHEM_OLD.inc"
+#endif
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+             DO im = PARAM_FIRST_SCALAR , num_3d_c
+               CALL set_physical_bc3d(  chem_old(ims,kms,jms,im), 'p', config_flags,     &
+                                        ids, ide, jds, jde, kds, kde,                    &
+                                        ims, ime, jms, jme, kms, kme,                    &
+                                        ips, ipe, jps, jpe, kps, kpe,                    &
+                                        grid%i_start(ij), grid%i_end(ij),                &
+                                        grid%j_start(ij), grid%j_end(ij),                &
+                                        k_start    , k_end                              )
+             END DO 
+           ENDIF
+         END DO
+         !$OMP END PARALLEL DO
+
+       ENDIF  ! end if for pd_chem
+
+! tke
+
+       IF (config_flags%pd_tke .and. (rk_step == rk_order) &
+           .and. (config_flags%km_opt .eq. 2)                ) THEN
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+           CALL rk_update_scalar_pd( 1, 1,                                    &
+                                     grid%tke_1,                              &
+                                     tke_tend(ims,kms,jms),                   &
+                                     grid%mu_1, grid%mu_1, grid%mub,          &
+                                     rk_step, dt_rk, grid%spec_zone,          &
+                                     config_flags,                            &
+                                     ids, ide, jds, jde, kds, kde,            &
+                                     ims, ime, jms, jme, kms, kme,            &
+                                     grid%i_start(ij), grid%i_end(ij),        &
+                                     grid%j_start(ij), grid%j_end(ij),        &
+                                     k_start    , k_end                       )
+         ENDDO
+         !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+#ifdef DM_PARALLEL
+         IF (config_flags%pd_tke) THEN
+           IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_TKE_OLD_E_5.inc"
+           ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_TKE_OLD_E_7.inc"
+           ELSE
+             WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+             CALL wrf_error_fatal(TRIM(wrf_err_message))
+           ENDIF
+         ENDIF
+#endif
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_TKE_OLD.inc"
+#endif
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           CALL set_physical_bc3d(  grid%tke_1, 'p', config_flags,  &
+                                    ids, ide, jds, jde, kds, kde,      &
+                                    ims, ime, jms, jme, kms, kme,      &
+                                    ips, ipe, jps, jpe, kps, kpe,      &
+                                    grid%i_start(ij), grid%i_end(ij),  &
+                                    grid%j_start(ij), grid%j_end(ij),  &
+                                    k_start    , k_end                )
+         END DO
+         !$OMP END PARALLEL DO
+
+!---  end of positive definite physics tendency update
+
+       END IF  ! end if for pd_tke
+
+#ifdef DM_PARALLEL
+!
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!          * * * * *            
+!          * * * * *            
+!          * * + * *            
+!          * * * * *            
+!          * * * * *            
+!
+! ru_m         x
+! rv_m         x
+! ww_m         x
+! mut          x
+!
+!--------------------------------------------------------------
+
+#  include "HALO_EM_D.inc"
+#endif
+
+!<DESCRIPTION>
+!<pre>
+! (4) Still within the RK loop, the scalar variables are advanced.
+!
+!    For the moist and chem variables, each one is advanced
+!    individually, using named loops "moist_variable_loop:"
+!    and "chem_variable_loop:".  Each RK substep begins by
+!    calculating the advective tendency, and, for the first RK step, 
+!    3D mixing (calling rk_scalar_tend) followed by an update
+!    of the scalar (calling rk_scalar_update).
+!</pre>
+!</DESCRIPTION>
+
+
+       moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR )  THEN
+
+         moist_variable_loop: DO im = PARAM_FIRST_SCALAR, num_3d_m
+
+! adv_moist_cond is set in module_physics_init based on mp_physics choice
+!       true except for Ferrier scheme
+
+           IF (grid%adv_moist_cond .or. im==p_qv ) THEN
+
+             !$OMP PARALLEL DO   &
+             !$OMP PRIVATE ( ij )
+             moist_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+               CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
+
+BENCH_START(rk_scalar_tend_tim)
+               CALL rk_scalar_tend (  im, im, config_flags,                  &
+                           rk_step, dt_rk,                                   &
+                           grid%ru_m, grid%rv_m, grid%ww_m,                  &
+                           grid%mut, grid%mub, grid%mu_1,                    &
+                           grid%alt,                                         &
+                           moist_old(ims,kms,jms,im),                        &
+                           moist(ims,kms,jms,im),                            &
+                           moist_tend(ims,kms,jms,im),                       &
+                           advect_tend,grid%rqvften,                         &
+                           grid%qv_base, .true., grid%fnm, grid%fnp,         &
+                           grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
+                           grid%msfvy, grid%msftx,grid%msfty,                & 
+                           grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
+                           grid%kvdif, grid%xkhh,                            &
+                           grid%diff_6th_opt, grid%diff_6th_factor,          &
+                           config_flags%pd_moist,            &
+                           ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           grid%i_start(ij), grid%i_end(ij), &
+                           grid%j_start(ij), grid%j_end(ij), &
+                           k_start    , k_end               )
+
+BENCH_END(rk_scalar_tend_tim)
+
+BENCH_START(rlx_bdy_scalar_tim)
+               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN 
+                 IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
+                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            & 
+                                     moist(ims,kms,jms,im),  grid%mut,         &
+                                     moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
+                                     moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
+                                     moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
+                                     moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
+                                     config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
+                                     grid%dtbc, grid%fcx, grid%gcx,             &
+                                     config_flags,               &
+                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                     grid%i_start(ij), grid%i_end(ij),      &
+                                     grid%j_start(ij), grid%j_end(ij),      &
+                                     k_start, k_end                        )
+
+                   CALL spec_bdy_scalar  ( moist_tend(ims,kms,jms,im),                &
+                                     moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
+                                     moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
+                                     moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
+                                     moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
+                                     config_flags%spec_bdy_width, grid%spec_zone,                 &
+                                     config_flags,               &
+                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                     grid%i_start(ij), grid%i_end(ij),          &
+                                     grid%j_start(ij), grid%j_end(ij),          &
+                                     k_start, k_end                               )
+                 ENDIF
+               ENDIF
+BENCH_END(rlx_bdy_scalar_tim)
+
+             ENDDO moist_tile_loop_1
+             !$OMP END PARALLEL DO
+
+             !$OMP PARALLEL DO   &
+             !$OMP PRIVATE ( ij )
+             moist_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+               CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+
+BENCH_START(update_scal_tim)
+               CALL rk_update_scalar( im, im,                     &
+                               moist_old(ims,kms,jms,im),         &
+                               moist(ims,kms,jms,im),             &
+                               moist_tend(ims,kms,jms,im),        &
+                               advect_tend, grid%msftx,grid%msfty, &
+                               grid%mu_1, grid%mu_2, grid%mub,    &
+                               rk_step, dt_rk, grid%spec_zone,    &
+                               config_flags,                      &
+                               ids, ide, jds, jde, kds, kde,     &
+                               ims, ime, jms, jme, kms, kme,     &
+                               grid%i_start(ij), grid%i_end(ij), &
+                               grid%j_start(ij), grid%j_end(ij), &
+                               k_start    , k_end                )
+BENCH_END(update_scal_tim)
+
+BENCH_START(flow_depbdy_tim)
+               IF( config_flags%specified ) THEN
+                 IF(im .ne. P_QV)THEN
+                   CALL flow_dep_bdy  (  moist(ims,kms,jms,im),                 &
+                                grid%ru_m, grid%rv_m, config_flags,             &
+                                grid%spec_zone,                                 &
+                                ids,ide, jds,jde, kds,kde,                      &
+                                ims,ime, jms,jme, kms,kme,                      &
+                                ips,ipe, jps,jpe, kps,kpe,                      &
+                                grid%i_start(ij), grid%i_end(ij),               &
+                                grid%j_start(ij), grid%j_end(ij),               &
+                                k_start, k_end                               )
+                 ENDIF
+               ENDIF
+BENCH_END(flow_depbdy_tim)
+
+             ENDDO moist_tile_loop_2
+             !$OMP END PARALLEL DO
+
+           ENDIF  !-- if (grid%adv_moist_cond .or. im==p_qv ) then
+
+         ENDDO moist_variable_loop
+
+       ENDIF moist_scalar_advance
+
+BENCH_START(tke_adv_tim)
+       TKE_advance: IF (config_flags%km_opt .eq. 2) then
+#ifdef DM_PARALLEL
+         IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#       include "HALO_EM_TKE_ADVECT_3.inc"
+         ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#       include "HALO_EM_TKE_ADVECT_5.inc"
+         ELSE
+          WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+          CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+#endif
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         tke_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
+           CALL rk_scalar_tend ( 1, 1, config_flags,                               &
+                            rk_step, dt_rk,                                        &
+                            grid%ru_m, grid%rv_m, grid%ww_m,                       &
+                            grid%mut, grid%mub, grid%mu_1,                         &
+                            grid%alt,                                              &
+                            grid%tke_1,                                            &
+                            grid%tke_2,                                            &
+                            tke_tend(ims,kms,jms),                                 &
+                            advect_tend,grid%rqvften,                              &
+                            grid%qv_base, .false., grid%fnm, grid%fnp,             &
+                            grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,     &
+                            grid%msfvy, grid%msftx,grid%msfty,                     &
+                            grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif,   &
+                            grid%kvdif, grid%xkhh,                                 &
+                            grid%diff_6th_opt, grid%diff_6th_factor,               &
+                            config_flags%pd_tke,              &
+                            ids, ide, jds, jde, kds, kde,     &
+                            ims, ime, jms, jme, kms, kme,     &
+                            grid%i_start(ij), grid%i_end(ij), &
+                            grid%j_start(ij), grid%j_end(ij), &
+                            k_start    , k_end               )
+
+         ENDDO tke_tile_loop_1
+         !$OMP END PARALLEL DO
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         tke_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+           CALL rk_update_scalar( 1, 1,                             &
+                             grid%tke_1,                            &
+                             grid%tke_2,                            &
+                             tke_tend(ims,kms,jms),                 &
+                             advect_tend,grid%msftx,grid%msfty,     &
+                             grid%mu_1, grid%mu_2, grid%mub,        &
+                             rk_step, dt_rk, grid%spec_zone,        &
+                             config_flags,                          &
+                             ids, ide, jds, jde, kds, kde,     &
+                             ims, ime, jms, jme, kms, kme,     &
+                             grid%i_start(ij), grid%i_end(ij), &
+                             grid%j_start(ij), grid%j_end(ij), &
+                             k_start    , k_end               ) 
+
+! bound the tke (greater than 0, less than tke_upper_bound)
+
+           CALL bound_tke( grid%tke_2, grid%tke_upper_bound,    &
+                           ids, ide, jds, jde, kds, kde,        &
+                           ims, ime, jms, jme, kms, kme,        &
+                           grid%i_start(ij), grid%i_end(ij),    &
+                           grid%j_start(ij), grid%j_end(ij),    &
+                           k_start    , k_end                  )
+
+           IF( config_flags%specified .or. config_flags%nested ) THEN
+              CALL flow_dep_bdy (  grid%tke_2,                     &
+                                   grid%ru_m, grid%rv_m, config_flags,               &
+                                   grid%spec_zone,                              &
+                                   ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                   ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                   ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                   grid%i_start(ij), grid%i_end(ij),       &
+                                   grid%j_start(ij), grid%j_end(ij),       &
+                                   k_start, k_end                               )
+           ENDIF
+         ENDDO tke_tile_loop_2
+         !$OMP END PARALLEL DO
+
+       ENDIF TKE_advance
+BENCH_END(tke_adv_tim)
+
+#ifdef WRF_CHEM
+!  next the chemical species
+BENCH_START(chem_adv_tim)
+       chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR)  THEN
+
+         chem_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_3d_c
+
+           !$OMP PARALLEL DO   &
+           !$OMP PRIVATE ( ij )
+           chem_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+             CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
+             CALL rk_scalar_tend ( ic, ic, config_flags,                         &
+                              rk_step, dt_rk,                                    &
+                              grid%ru_m, grid%rv_m, grid%ww_m,                   &
+                              grid%mut, grid%mub, grid%mu_1,                     &
+                              grid%alt,                                          &
+                              chem_old(ims,kms,jms,ic),                          &
+                              chem(ims,kms,jms,ic),                              &
+                              chem_tend(ims,kms,jms,ic),                         &
+                              advect_tend,grid%rqvften,                          &
+                              grid%qv_base, .false., grid%fnm, grid%fnp,         &
+                              grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
+                              grid%msfvy, grid%msftx,grid%msfty,                 &
+                              grid%rdx, grid%rdy, grid%rdn, grid%rdnw,     &
+                              grid%khdif, grid%kvdif, grid%xkhh,                 &
+                              grid%diff_6th_opt, grid%diff_6th_factor,           &
+                              config_flags%pd_chem,                              &
+                              ids, ide, jds, jde, kds, kde,                      &
+                              ims, ime, jms, jme, kms, kme,                      &
+                              grid%i_start(ij), grid%i_end(ij),                  &
+                              grid%j_start(ij), grid%j_end(ij),                  &
+                              k_start    , k_end                                )
+!
+! Currently, chemistry species with specified boundaries (i.e. the mother
+! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
+! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
+!
+           IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
+             IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
+             CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic),                                    &
+                                     chem(ims,kms,jms,ic),  grid%mut,                              &
+                                     chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic),                &
+                                     chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic),                &
+                                     chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic),              &
+                                     chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic),              &
+                                     config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
+                                     grid%dtbc, grid%fcx, grid%gcx,                                &
+                                     config_flags,                                                 &
+                                     ids,ide, jds,jde, kds,kde,                                    &
+                                     ims,ime, jms,jme, kms,kme,                                    &
+                                     ips,ipe, jps,jpe, kps,kpe,                                    &
+                                     grid%i_start(ij), grid%i_end(ij),                             &
+                                     grid%j_start(ij), grid%j_end(ij),                             &
+                                     k_start, k_end                                                )
+             CALL spec_bdy_scalar  ( chem_tend(ims,kms,jms,ic),                 &
+                                     chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic),                &
+                                     chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic),                &
+                                     chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic),              &
+                                     chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic),              &
+                                     config_flags%spec_bdy_width, grid%spec_zone,                  &
+                                     config_flags,                                                 &
+                                     ids,ide, jds,jde, kds,kde,                                    &
+                                     ims,ime, jms,jme, kms,kme,                                    &
+                                     ips,ipe, jps,jpe, kps,kpe,                                    &
+                                     grid%i_start(ij), grid%i_end(ij),                             &
+                                     grid%j_start(ij), grid%j_end(ij),                             &
+                                     k_start, k_end                                                )
+           ENDIF
+
+         ENDDO chem_tile_loop_1
+         !$OMP END PARALLEL DO
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+
+         chem_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+           CALL rk_update_scalar( ic, ic,                           &
+                                  chem_old(ims,kms,jms,ic),         &  ! was chem_1
+                                  chem(ims,kms,jms,ic),             &
+                                  chem_tend(ims,kms,jms,ic),        &
+                                  advect_tend, grid%msftx, grid%msfty, &
+                                  grid%mu_1, grid%mu_2, grid%mub,      &
+                                  rk_step, dt_rk, grid%spec_zone,      &
+                                  config_flags,                     &
+                                  ids, ide, jds, jde, kds, kde,     &
+                                  ims, ime, jms, jme, kms, kme,     &
+                                  grid%i_start(ij), grid%i_end(ij), &
+                                  grid%j_start(ij), grid%j_end(ij), &
+                                  k_start    , k_end               )
+
+           IF( config_flags%specified  ) THEN
+             CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic),                          &
+                                     chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic),  &
+                                     chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic),  &
+                                     chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic),  &
+                                     chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic),  &
+                                     dt_rk+grid%dtbc,                                  &
+                                     config_flags%spec_bdy_width,grid%z,      &
+                                     grid%have_bcs_chem,      &
+                                     grid%ru_m, grid%rv_m, config_flags,grid%alt,       &
+                                     grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
+                                     grid%spec_zone,ic,                  &
+                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                     grid%i_start(ij), grid%i_end(ij),   &
+                                     grid%j_start(ij), grid%j_end(ij),   &
+                                     k_start, k_end                      )
+           ENDIF
+         ENDDO chem_tile_loop_2
+         !$OMP END PARALLEL DO
+
+       ENDDO chem_variable_loop
+     ENDIF chem_scalar_advance
+BENCH_END(chem_adv_tim)
+#endif
+
+!  next the other scalar species
+     other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR)  THEN
+
+       scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
+           CALL rk_scalar_tend ( is, is, config_flags,                            &
+                                 rk_step, dt_rk,                                  &
+                                 grid%ru_m, grid%rv_m, grid%ww_m,                 &
+                                 grid%mut, grid%mub, grid%mu_1,                   &
+                                 grid%alt,                                        &
+                                 scalar_old(ims,kms,jms,is),                      &
+                                 scalar(ims,kms,jms,is),                          &
+                                 scalar_tend(ims,kms,jms,is),                     &
+                                 advect_tend,grid%rqvften,                        &
+                                 grid%qv_base, .false., grid%fnm, grid%fnp,       &
+                                 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
+                                 grid%msfvy, grid%msftx,grid%msfty,               &
+                                 grid%rdx, grid%rdy, grid%rdn, grid%rdnw,         &
+                                 grid%khdif, grid%kvdif, grid%xkhh,               &
+                                 grid%diff_6th_opt, grid%diff_6th_factor,         &
+                                 config_flags%pd_scalar,           &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+           IF( config_flags%nested .and. (rk_step == 1) ) THEN
+
+             IF (is .EQ. P_QNDROP .OR. is .EQ. P_QNI          & 
+                                  .OR. is .EQ. P_QNS          &
+                                  .OR. is .EQ. P_QNR          &
+                                  .OR. is .EQ. P_QNG) THEN             
+
+               CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is),                            &
+                                       scalar(ims,kms,jms,is),  grid%mut,                      &
+                                       scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is),      &
+                                       scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is),      &
+                                       scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is),    &
+                                       scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is),    &
+                                       config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
+                                       grid%dtbc, grid%fcx, grid%gcx,                          &
+                                       config_flags,                                           &
+                                       ids,ide, jds,jde, kds,kde,                              &
+                                       ims,ime, jms,jme, kms,kme,                              &
+                                       ips,ipe, jps,jpe, kps,kpe,                              &
+                                       grid%i_start(ij), grid%i_end(ij),                       &
+                                       grid%j_start(ij), grid%j_end(ij),                       &
+                                       k_start, k_end                                          )
+
+               CALL spec_bdy_scalar  ( scalar_tend(ims,kms,jms,is),                            &
+                                       scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is),      &
+                                       scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is),      &
+                                       scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is),    &
+                                       scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is),    &
+                                       config_flags%spec_bdy_width, grid%spec_zone,            &
+                                       config_flags,                                           &
+                                       ids,ide, jds,jde, kds,kde,                              &
+                                       ims,ime, jms,jme, kms,kme,                              &
+                                       ips,ipe, jps,jpe, kps,kpe,                              &
+                                       grid%i_start(ij), grid%i_end(ij),                       &
+                                       grid%j_start(ij), grid%j_end(ij),                       &
+                                       k_start, k_end                                          )
+
+             ENDIF
+
+           ENDIF ! b.c test for chem nested boundary condition
+
+         ENDDO scalar_tile_loop_1
+         !$OMP END PARALLEL DO
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+           CALL rk_update_scalar( is, is,                           &
+                                  scalar_old(ims,kms,jms,is),       &  ! was scalar_1
+                                  scalar(ims,kms,jms,is),           &
+                                  scalar_tend(ims,kms,jms,is),      &
+                                  advect_tend, grid%msftx, grid%msfty, &
+                                  grid%mu_1, grid%mu_2, grid%mub,                  &
+                                  rk_step, dt_rk, grid%spec_zone,        &
+                                  config_flags,     &
+                                  ids, ide, jds, jde, kds, kde,     &
+                                  ims, ime, jms, jme, kms, kme,     &
+                                  grid%i_start(ij), grid%i_end(ij), &
+                                  grid%j_start(ij), grid%j_end(ij), &
+                                  k_start    , k_end               )
+
+
+           IF( config_flags%specified ) THEN
+             CALL flow_dep_bdy  ( scalar(ims,kms,jms,is),     &
+                                  grid%ru_m, grid%rv_m, config_flags,   &
+                                  grid%spec_zone,                  &
+                                  ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                  ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                  ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                  grid%i_start(ij), grid%i_end(ij),  &
+                                  grid%j_start(ij), grid%j_end(ij),  &
+                                  k_start, k_end                    )
+           ENDIF
+
+         ENDDO scalar_tile_loop_2
+         !$OMP END PARALLEL DO
+
+       ENDDO scalar_variable_loop
+
+     ENDIF other_scalar_advance
+
+ !  update the pressure and density at the new time level
+
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+BENCH_START(calc_p_rho_tim)
+
+       CALL calc_p_rho_phi( moist, num_3d_m,                &
+                            grid%al, grid%alb, grid%mu_2, grid%muts,              &
+                            grid%ph_2, grid%p, grid%pb, grid%t_2,                 &
+                            p0, t0, grid%znu, grid%dnw, grid%rdnw,           &
+                            grid%rdn, config_flags%non_hydrostatic,             &
+                            ids, ide, jds, jde, kds, kde,     &
+                            ims, ime, jms, jme, kms, kme,     &
+                            grid%i_start(ij), grid%i_end(ij), &
+                            grid%j_start(ij), grid%j_end(ij), &
+                            k_start    , k_end               )
+
+BENCH_END(calc_p_rho_tim)
+
+     ENDDO
+     !$OMP END PARALLEL DO
+
+!  Reset the boundary conditions if there is another corrector step.
+!  (rk_step < rk_order), else we'll handle it at the end of everything
+!  (after the split physics, before exiting the timestep).
+
+     rk_step_1_check: IF ( rk_step < rk_order ) THEN
+
+!-----------------------------------------------------------
+!  rk3 substep polar filter for scalars (moist,chem,scalar)
+!-----------------------------------------------------------
+
+       IF (config_flags%polar) THEN 
+         IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
+           CALL wrf_debug ( 200 , ' call filter moist ' )
+           DO im = PARAM_FIRST_SCALAR, num_3d_m
+             CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)              &
+                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+             CALL pxft ( grid=grid                                               &
+                    ,lineno=__LINE__                                             &
+                    ,flag_uv            = 0                                      &
+                    ,flag_rurv          = 0                                      &
+                    ,flag_wph           = 0                                      &
+                    ,flag_ww            = 0                                      &
+                    ,flag_t             = 0                                      &
+                    ,flag_mu            = 0                                      &
+                    ,flag_mut           = 0                                      &
+                    ,flag_moist         = im                                     &
+                    ,flag_chem          = 0                                      &
+                    ,flag_scalar        = 0                                      &
+                    ,positive_definite=.FALSE.                                   &
+                    ,moist=moist,chem=chem,scalar=scalar                         &
+                    ,fft_filter_lat = config_flags%fft_filter_lat                &
+                    ,dclat = dclat                                               &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                    ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                    ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+             CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)            &
+                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+           END DO
+         END IF
+   
+         IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
+           CALL wrf_debug ( 200 , ' call filter chem ' )
+           DO im = PARAM_FIRST_SCALAR, num_3d_c
+             CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im)               &
+                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe           )
+             CALL pxft ( grid=grid                                               &
+                    ,lineno=__LINE__                                             &
+                    ,flag_uv            = 0                                      &
+                    ,flag_rurv          = 0                                      &
+                    ,flag_wph           = 0                                      &
+                    ,flag_ww            = 0                                      &
+                    ,flag_t             = 0                                      &
+                    ,flag_mu            = 0                                      &
+                    ,flag_mut           = 0                                      &
+                    ,flag_moist         = 0                                      &
+                    ,flag_chem          = im                                     &
+                    ,flag_scalar        = 0                                      &
+                    ,positive_definite=.FALSE.                                   &
+                    ,moist=moist,chem=chem,scalar=scalar                         &
+                    ,fft_filter_lat = config_flags%fft_filter_lat                &
+                    ,dclat = dclat                                               &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                    ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                    ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+             CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im)             &
+                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+           END DO
+         END IF
+   
+         IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
+           CALL wrf_debug ( 200 , ' call filter scalar ' )
+           DO im = PARAM_FIRST_SCALAR, num_3d_s
+             CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im)           &
+                  ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+             CALL pxft ( grid=grid                                             &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 0                                      &
+                  ,flag_rurv          = 0                                      &
+                  ,flag_wph           = 0                                      &
+                  ,flag_ww            = 0                                      &
+                  ,flag_t             = 0                                      &
+                  ,flag_mu            = 0                                      &
+                  ,flag_mut           = 0                                      &
+                  ,flag_moist         = 0                                      &
+                  ,flag_chem          = 0                                      &
+                  ,flag_scalar        = im                                     &
+                  ,positive_definite=.FALSE.                                   &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+             CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im)   &
+                  ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+           END DO
+         END IF
+       END IF ! polar filter test
+
+!-----------------------------------------------------------
+!  END rk3 substep polar filter for scalars (moist,chem,scalar)
+!-----------------------------------------------------------
+
+!-----------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!  here's where we need a wide comm stencil - these are the 
+!  uncoupled variables so are used for high order calc in
+!  advection and mixong routines.
+!
+!
+!                                  * * * * * * *
+!                     * * * * *    * * * * * * *
+!            *        * * * * *    * * * * * * *
+!          * + *      * * + * *    * * * + * * *
+!            *        * * * * *    * * * * * * *
+!                     * * * * *    * * * * * * *
+!                                  * * * * * * *
+!
+! al        x
+!
+!  2D variable
+! mu_2      x
+!
+! (adv order <=4)
+! u_2                     x
+! v_2                     x
+! w_2                     x
+! t_2                     x
+! ph_2                    x
+!
+! (adv order <=6)
+! u_2                                    x
+! v_2                                    x
+! w_2                                    x
+! t_2                                    x
+! ph_2                                   x
+!
+!  4D variable
+! moist                   x
+! chem                    x
+! scalar                  x
+
+#ifdef DM_PARALLEL
+       IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#    include "HALO_EM_D2_3.inc"
+       ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#    include "HALO_EM_D2_5.inc"
+       ELSE 
+         WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+         CALL wrf_error_fatal(TRIM(wrf_err_message))
+       ENDIF
+#  include "PERIOD_BDY_EM_D.inc"
+#  include "PERIOD_BDY_EM_MOIST2.inc"
+#  include "PERIOD_BDY_EM_CHEM2.inc"
+#  include "PERIOD_BDY_EM_SCALAR2.inc"
+#endif
+
+BENCH_START(bc_end_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       tile_bc_loop_1: DO ij = 1 , grid%num_tiles
+         CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
+
+         CALL rk_phys_bc_dry_2( config_flags,                     &
+                                grid%u_2, grid%v_2, grid%w_2,     &
+                                grid%t_2, grid%ph_2, grid%mu_2,   &
+                                ids, ide, jds, jde, kds, kde,     &
+                                ims, ime, jms, jme, kms, kme,     &
+                                ips, ipe, jps, jpe, kps, kpe,     &
+                                grid%i_start(ij), grid%i_end(ij), &
+                                grid%j_start(ij), grid%j_end(ij), &
+                                k_start    , k_end               )
+
+BENCH_START(diag_w_tim)
+         IF (.not. config_flags%non_hydrostatic) THEN
+           CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk,  &
+                            grid%u_2, grid%v_2, grid%ht,                           &
+                            grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
+                            ids, ide, jds, jde, kds, kde,           &
+                            ims, ime, jms, jme, kms, kme,           &
+                            grid%i_start(ij), grid%i_end(ij),       &
+                            grid%j_start(ij), grid%j_end(ij),       &
+                            k_start    , k_end                     )
+         ENDIF
+BENCH_END(diag_w_tim)
+
+         IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+
+           moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
+  
+             CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags,   &
+                                     ids, ide, jds, jde, kds, kde,             &
+                                     ims, ime, jms, jme, kms, kme,             &
+                                     ips, ipe, jps, jpe, kps, kpe,             &
+                                     grid%i_start(ij), grid%i_end(ij),                   &
+                                     grid%j_start(ij), grid%j_end(ij),                   &
+                                     k_start    , k_end                       )
+           END DO moisture_loop_bdy_1
+
+         ENDIF
+
+         IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
+
+           chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
+
+             CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags,   &
+                                     ids, ide, jds, jde, kds, kde,            &
+                                     ims, ime, jms, jme, kms, kme,            &
+                                     ips, ipe, jps, jpe, kps, kpe,            &
+                                     grid%i_start(ij), grid%i_end(ij),                  &
+                                     grid%j_start(ij), grid%j_end(ij),                  &
+                                     k_start    , k_end-1                    )
+
+           END DO chem_species_bdy_loop_1
+
+         END IF
+
+         IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
+
+           scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
+
+             CALL set_physical_bc3d( scalar(ims,kms,jms,is), 'p', config_flags,   &
+                                     ids, ide, jds, jde, kds, kde,            &
+                                     ims, ime, jms, jme, kms, kme,            &
+                                     ips, ipe, jps, jpe, kps, kpe,            &
+                                     grid%i_start(ij), grid%i_end(ij),                  &
+                                     grid%j_start(ij), grid%j_end(ij),                  &
+                                     k_start    , k_end-1                    )
+
+           END DO scalar_species_bdy_loop_1
+
+         END IF
+
+         IF (config_flags%km_opt .eq. 2) THEN
+
+           CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags,  &
+                                   ids, ide, jds, jde, kds, kde,            &
+                                   ims, ime, jms, jme, kms, kme,            &
+                                   ips, ipe, jps, jpe, kps, kpe,            &
+                                   grid%i_start(ij), grid%i_end(ij),        &
+                                   grid%j_start(ij), grid%j_end(ij),        &
+                                   k_start    , k_end                      )
+         END IF
+
+       END DO tile_bc_loop_1
+       !$OMP END PARALLEL DO
+BENCH_END(bc_end_tim)
+
+
+#ifdef DM_PARALLEL
+
+!                           * * * * *
+!         *        * * *    * * * * *
+!       * + *      * + *    * * + * *
+!         *        * * *    * * * * *
+!                           * * * * *
+
+! moist, chem, scalar, tke      x
+
+
+       IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+         IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
+#         include "HALO_EM_TKE_5.inc"
+         ELSE
+#         include "HALO_EM_TKE_3.inc"
+         ENDIF
+       ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+         IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
+#         include "HALO_EM_TKE_7.inc"
+         ELSE
+#         include "HALO_EM_TKE_5.inc"
+         ENDIF
+       ELSE
+         WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+         CALL wrf_error_fatal(TRIM(wrf_err_message))
+       ENDIF
+
+       IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+           IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_MOIST_E_5.inc"
+           ELSE
+#        include "HALO_EM_MOIST_E_3.inc"
+           END IF
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+           IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_MOIST_E_7.inc"
+           ELSE
+#        include "HALO_EM_MOIST_E_5.inc"
+           END IF
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+       ENDIF
+       IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+           IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_CHEM_E_5.inc"
+           ELSE
+#        include "HALO_EM_CHEM_E_3.inc"
+           ENDIF
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+           IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_CHEM_E_7.inc"
+           ELSE
+#        include "HALO_EM_CHEM_E_5.inc"
+           ENDIF
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+       ENDIF
+       IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+           IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_SCALAR_E_5.inc"
+           ELSE
+#        include "HALO_EM_SCALAR_E_3.inc"
+           ENDIF
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+           IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_SCALAR_E_7.inc"
+           ELSE
+#        include "HALO_EM_SCALAR_E_5.inc"
+           ENDIF
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+       ENDIF
+#endif
+
+     ENDIF rk_step_1_check
+
+
+!**********************************************************
+!
+!  end of RK predictor-corrector loop
+!
+!**********************************************************
+
+   END DO Runge_Kutta_loop
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+
+BENCH_START(advance_ppt_tim)
+     CALL wrf_debug ( 200 , ' call advance_ppt' )
+     CALL advance_ppt(grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
+                      grid%rqicuten,grid%rqscuten,grid%rainc,grid%raincv,grid%pratec, grid%nca,    &
+                      grid%htop,grid%hbot,grid%cutop,grid%cubot,                 &
+                      grid%cuppt, grid%dt, config_flags,                   &
+                      ids,ide, jds,jde, kds,kde,             &
+                      ims,ime, jms,jme, kms,kme,             &
+                      grid%i_start(ij), grid%i_end(ij),      &
+                      grid%j_start(ij), grid%j_end(ij),      &
+                      k_start    , k_end                    )
+BENCH_END(advance_ppt_tim)
+
+   ENDDO
+  !$OMP END PARALLEL DO
+
+!<DESCRIPTION>
+!<pre>
+! (5) time-split physics.
+!
+!     Microphysics are the only time  split physics in the WRF model 
+!     at this time.  Split-physics begins with the calculation of
+!     needed diagnostic quantities (pressure, temperature, etc.)
+!     followed by a call to the microphysics driver, 
+!     and finishes with a clean-up, storing off of a diabatic tendency
+!     from the moist physics, and a re-calulation of the  diagnostic
+!     quantities pressure and density.
+!</pre>
+!</DESCRIPTION>
+
+   IF( config_flags%specified .or. config_flags%nested ) THEN
+     sz = grid%spec_zone
+   ELSE
+     sz = 0
+   ENDIF
+
+!!!!****MARS MARS
+!!!!****MARS MARS
+
+!   IF (config_flags%mp_physics /= 0)  then
+!
+!     !$OMP PARALLEL DO   &
+!     !$OMP PRIVATE ( ij, its, ite, jts, jte )
+!
+!     scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
+!
+!       IF ( config_flags%periodic_x ) THEN
+!         its = max(grid%i_start(ij),ids)
+!         ite = min(grid%i_end(ij),ide-1)
+!       ELSE
+!         its = max(grid%i_start(ij),ids+sz)
+!         ite = min(grid%i_end(ij),ide-1-sz)
+!       ENDIF
+!       jts = max(grid%j_start(ij),jds+sz)
+!       jte = min(grid%j_end(ij),jde-1-sz)
+!
+!       CALL wrf_debug ( 200 , ' call moist_physics_prep' )
+!BENCH_START(moist_physics_prep_tim)
+!       CALL moist_physics_prep_em( grid%t_2, grid%t_1, t0, rho,                &
+!                                   grid%al, grid%alb, grid%p, p8w, p0, grid%pb,          &
+!                                   grid%ph_2, grid%phb, th_phy, pi_phy, p_phy, &
+!                                   grid%z, z_at_w, dz8w,                  &
+!                                   dtm, grid%h_diabatic,                  &
+!                                   config_flags,grid%fnm, grid%fnp,            &
+!                                   ids, ide, jds, jde, kds, kde,     &
+!                                   ims, ime, jms, jme, kms, kme,     &
+!                                   its, ite, jts, jte,               &
+!                                   k_start    , k_end               )
+!BENCH_END(moist_physics_prep_tim)
+!     END DO scalar_tile_loop_1a
+!     !$OMP END PARALLEL DO
+!
+!     CALL wrf_debug ( 200 , ' call microphysics_driver' )
+!
+!     grid%sr = 0.
+!     specified_bdy = config_flags%specified .OR. config_flags%nested
+!     channel_bdy = config_flags%specified .AND. config_flags%periodic_x
+!
+!BENCH_START(micro_driver_tim)
+!
+!     CALL microphysics_driver(                                            &
+!      &         DT=dtm             ,DX=grid%dx              ,DY=grid%dy   &
+!      &        ,DZ8W=dz8w          ,F_ICE_PHY=grid%f_ice_phy              &
+!      &        ,ITIMESTEP=grid%itimestep                    ,LOWLYR=grid%lowlyr  &
+!      &        ,P8W=p8w            ,P=p_phy            ,PI_PHY=pi_phy     &
+!      &        ,RHO=rho            ,SPEC_ZONE=grid%spec_zone              &
+!      &        ,SR=grid%sr              ,TH=th_phy                        &
+!      &        ,WARM_RAIN=grid%warm_rain                                  &
+!      &        ,T8W=t8w                                                   &
+!      &        ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
+!      &        ,NSOURCE=grid%qndropsource                                 &
+!#ifdef WRF_CHEM
+!      &        ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old             &
+!      &        ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg &
+!      &        ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn  &
+!#endif
+!      &        ,XLAND=grid%xland                                          &
+!      &        ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy       &
+!      &        ,F_RAIN_PHY=grid%f_rain_phy                                &
+!      &        ,F_RIMEF_PHY=grid%f_rimef_phy                              &
+!      &        ,MP_PHYSICS=config_flags%mp_physics                        &
+!      &        ,ID=grid%id                                                &
+!      &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde         &
+!      &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme         &
+!#ifdef RUN_ON_GPU
+!      &        ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe         &
+!#endif
+!      &        ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)         &
+!      &        ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)         &
+!      &        ,KTS=k_start, KTE=min(k_end,kde-1)                         &
+!      &        ,NUM_TILES=grid%num_tiles                                  &
+!      &        ,NAER=grid%naer                                            &
+!                 ! Optional
+!      &        , RAINNC=grid%rainnc, RAINNCV=grid%rainncv                 &
+!      &        , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv                 &
+!      &        , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv     &
+!      &        , W=grid%w_2, Z=grid%z, HT=grid%ht                         &
+!      &        , MP_RESTART_STATE=grid%mp_restart_state                   &
+!      &        , TBPVS_STATE=grid%tbpvs_state                             & ! etampnew
+!      &        , TBPVS0_STATE=grid%tbpvs0_state                           & ! etampnew
+!      &        , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV               &
+!      &        , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC               &
+!      &        , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR               &
+!      &        , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI               &
+!      &        , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS               &
+!      &        , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG               &
+!      &        , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
+!      &        , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI          &
+!      &        , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT              &
+!      &        , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS          &  
+!      &        , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR          &  
+!      &        , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG          &  
+!      &        , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten             &  
+!      &        , qicuten=grid%rqicuten,mu=grid%mut                        &  
+!      &        , HAIL=config_flags%gsfcgce_hail                           & ! for gsfcgce
+!      &        , ICE2=config_flags%gsfcgce_2ice                           & ! for gsfcgce
+!                                                                          )
+!BENCH_END(micro_driver_tim)
+!
+!#if 0
+!BENCH_START(microswap_2)
+!! for load balancing; communication to redistribute the points
+!     IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN
+!#include "SWAP_ETAMP_NEW.inc"
+!     ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
+!#include "SWAP_WSM3.inc"
+!     ENDIF
+!BENCH_END(microswap_2)
+!#endif
+!
+!     CALL wrf_debug ( 200 , ' call moist_physics_finish' )
+!BENCH_START(moist_phys_end_tim)
+!
+!     !$OMP PARALLEL DO   &
+!     !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
+!
+!     DO ij = 1 , grid%num_tiles
+!
+!       IF ( config_flags%periodic_x ) THEN
+!         its = max(grid%i_start(ij),ids)
+!         ite = min(grid%i_end(ij),ide-1)
+!       ELSE
+!         its = max(grid%i_start(ij),ids+sz)
+!         ite = min(grid%i_end(ij),ide-1-sz)
+!       ENDIF
+!       jts = max(grid%j_start(ij),jds+sz)
+!       jte = min(grid%j_end(ij),jde-1-sz)
+!
+!       CALL microphysics_zero_out (                                    &
+!                      moist , num_moist , config_flags ,                &
+!                      ids, ide, jds, jde, kds, kde,                     &
+!                      ims, ime, jms, jme, kms, kme,                     &
+!                      its, ite, jts, jte,                               &
+!                      k_start    , k_end                                )
+!
+!
+!       CALL moist_physics_finish_em( grid%t_2, grid%t_1, t0, grid%muts, th_phy,       &
+!                                      grid%h_diabatic, dtm, config_flags,    &
+!                                      ids, ide, jds, jde, kds, kde,     &
+!                                      ims, ime, jms, jme, kms, kme,     &
+!                                      its, ite, jts, jte,               &
+!                                      k_start    , k_end               )
+!
+!     END DO
+!     !$OMP END PARALLEL DO
+!
+!   ENDIF  ! microphysics test
+
+!-----------------------------------------------------------
+!  filter for moist variables post-microphysics and end of timestep
+!-----------------------------------------------------------
+
+   IF (config_flags%polar) THEN
+     IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
+       CALL wrf_debug ( 200 , ' call filter moist' )
+       DO im = PARAM_FIRST_SCALAR, num_3d_m
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               moist(ii,kk,jj,im)=moist(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+ 
+         CALL pxft ( grid=grid                                                 &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 0                                      &
+                  ,flag_rurv          = 0                                      &
+                  ,flag_wph           = 0                                      &
+                  ,flag_ww            = 0                                      &
+                  ,flag_t             = 0                                      &
+                  ,flag_mu            = 0                                      &
+                  ,flag_mut           = 0                                      &
+                  ,flag_moist         = im                                     &
+                  ,flag_chem          = 0                                      &
+                  ,flag_scalar        = 0                                      &
+                  ,positive_definite=.FALSE.                                   &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+ 
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               moist(ii,kk,jj,im)=moist(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+       ENDDO
+     ENDIF
+   ENDIF
+
+!-----------------------------------------------------------
+!  end filter for moist variables post-microphysics and end of timestep
+!-----------------------------------------------------------
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
+   scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
+
+     IF ( config_flags%periodic_x ) THEN
+       its = max(grid%i_start(ij),ids)
+       ite = min(grid%i_end(ij),ide-1)
+     ELSE
+       its = max(grid%i_start(ij),ids+sz)
+       ite = min(grid%i_end(ij),ide-1-sz)
+     ENDIF
+     jts = max(grid%j_start(ij),jds+sz)
+     jte = min(grid%j_end(ij),jde-1-sz)
+
+     CALL calc_p_rho_phi( moist, num_3d_m,                &
+                          grid%al, grid%alb, grid%mu_2, grid%muts,              &
+                          grid%ph_2, grid%p, grid%pb, grid%t_2,                 &
+                          p0, t0, grid%znu, grid%dnw, grid%rdnw,           &
+                          grid%rdn, config_flags%non_hydrostatic,             &
+                          ids, ide, jds, jde, kds, kde,     &
+                          ims, ime, jms, jme, kms, kme,     &
+                          its, ite, jts, jte,               &
+                          k_start    , k_end               )
+
+   END DO scalar_tile_loop_1ba
+   !$OMP END PARALLEL DO
+BENCH_END(moist_phys_end_tim)
+
+   IF (.not. config_flags%non_hydrostatic) THEN
+#ifdef DM_PARALLEL
+#    include "HALO_EM_HYDRO_UV.inc"
+#    include "PERIOD_EM_HYDRO_UV.inc"
+#endif
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+       CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk,  &
+                       grid%u_2, grid%v_2, grid%ht,                           &
+                       grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
+                       ids, ide, jds, jde, kds, kde,           &
+                       ims, ime, jms, jme, kms, kme,           &
+                       grid%i_start(ij), grid%i_end(ij),       &
+                       grid%j_start(ij), grid%j_end(ij),       &
+                       k_start    , k_end                     )
+
+     END DO
+     !$OMP END PARALLEL DO
+
+   END IF
+
+   CALL wrf_debug ( 200 , ' call chem polar filter ' )
+
+!-----------------------------------------------------------
+!  filter for chem and scalar variables at end of timestep
+!-----------------------------------------------------------
+
+   IF (config_flags%polar) THEN
+
+     IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
+       chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               chem(ii,kk,jj,im)=chem(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+
+         CALL pxft ( grid=grid                                                 &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 0                                      &
+                  ,flag_rurv          = 0                                      &
+                  ,flag_wph           = 0                                      &
+                  ,flag_ww            = 0                                      &
+                  ,flag_t             = 0                                      &
+                  ,flag_mu            = 0                                      &
+                  ,flag_mut           = 0                                      &
+                  ,flag_moist         = 0                                      &
+                  ,flag_chem          = im                                     &
+                  ,flag_scalar        = 0                                      &
+                  ,positive_definite=.FALSE.                                   &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               chem(ii,kk,jj,im)=chem(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+       ENDDO chem_filter_loop
+     ENDIF
+
+     IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
+       scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+
+         CALL pxft ( grid=grid                                                 &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 0                                      &
+                  ,flag_rurv          = 0                                      &
+                  ,flag_wph           = 0                                      &
+                  ,flag_ww            = 0                                      &
+                  ,flag_t             = 0                                      &
+                  ,flag_mu            = 0                                      &
+                  ,flag_mut           = 0                                      &
+                  ,flag_moist         = 0                                      &
+                  ,flag_chem          = 0                                      &
+                  ,flag_scalar        = im                                     &
+                  ,positive_definite=.FALSE.                                   &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+       ENDDO scalar_filter_loop
+     ENDIF
+   ENDIF
+
+!-----------------------------------------------------------
+!  end filter for chem and scalar variables at end of timestep
+!-----------------------------------------------------------
+
+   !  We're finished except for boundary condition (and patch) update
+
+   ! Boundary condition time (or communication time).  At this time, we have
+   ! implemented periodic and symmetric physical boundary conditions.
+
+   ! b.c. routine for data within patch.
+
+   ! we need to do both time levels of 
+   ! data because the time filter only works in the physical solution space.
+
+   ! First, do patch communications for boundary conditions (periodicity)
+
+!-----------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!  here's where we need a wide comm stencil - these are the 
+!  uncoupled variables so are used for high order calc in
+!  advection and mixong routines.
+!
+!                              * * * * *
+!            *        * * *    * * * * *
+!          * + *      * + *    * * + * * 
+!            *        * * *    * * * * *
+!                              * * * * *
+!
+!   grid%u_1                            x
+!   grid%u_2                            x
+!   grid%v_1                            x
+!   grid%v_2                            x
+!   grid%w_1                            x
+!   grid%w_2                            x
+!   grid%t_1                            x
+!   grid%t_2                            x
+!  grid%ph_1                            x
+!  grid%ph_2                            x
+!  grid%tke_1                           x
+!  grid%tke_2                           x
+!
+!    2D variables
+!  grid%mu_1     x
+!  grid%mu_2     x
+!
+!    4D variables
+!  moist                         x
+!   chem                         x
+! scalar                         x
+!----------------------------------------------------------
+
+
+#ifdef DM_PARALLEL
+   IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#    include "HALO_EM_D3_3.inc"
+   ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#    include "HALO_EM_D3_5.inc"
+   ELSE 
+      WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+      CALL wrf_error_fatal(TRIM(wrf_err_message))
+   ENDIF
+#  include "PERIOD_BDY_EM_D3.inc"
+#  include "PERIOD_BDY_EM_MOIST.inc"
+#  include "PERIOD_BDY_EM_CHEM.inc"
+#  include "PERIOD_BDY_EM_SCALAR.inc"
+#endif
+
+!  now set physical b.c on a patch
+
+BENCH_START(bc_2d_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   tile_bc_loop_2: DO ij = 1 , grid%num_tiles
+
+     CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
+
+     CALL set_phys_bc_dry_2( config_flags,                           &
+                             grid%u_1, grid%u_2, grid%v_1, grid%v_2, grid%w_1, grid%w_2,           &
+                             grid%t_1, grid%t_2, grid%ph_1, grid%ph_2, grid%mu_1, grid%mu_2,       &
+                             ids, ide, jds, jde, kds, kde,           &
+                             ims, ime, jms, jme, kms, kme,           &
+                             ips, ipe, jps, jpe, kps, kpe,           &
+                             grid%i_start(ij), grid%i_end(ij),       &
+                             grid%j_start(ij), grid%j_end(ij),       &
+                             k_start    , k_end                     )
+
+     CALL set_physical_bc3d( grid%tke_1, 'p', config_flags,   &
+                             ids, ide, jds, jde, kds, kde,            &
+                             ims, ime, jms, jme, kms, kme,            &
+                             ips, ipe, jps, jpe, kps, kpe,            &
+                             grid%i_start(ij), grid%i_end(ij),        &
+                             grid%j_start(ij), grid%j_end(ij),        &
+                             k_start    , k_end-1                    )
+
+     CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags,  &
+                             ids, ide, jds, jde, kds, kde,            &
+                             ims, ime, jms, jme, kms, kme,            &
+                             ips, ipe, jps, jpe, kps, kpe,            &
+                             grid%i_start(ij), grid%i_end(ij),        &
+                             grid%j_start(ij), grid%j_end(ij),        &
+                             k_start    , k_end                      )
+
+     moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
+
+       CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p',           &
+                               config_flags,                           &
+                               ids, ide, jds, jde, kds, kde,           &
+                               ims, ime, jms, jme, kms, kme,           &
+                               ips, ipe, jps, jpe, kps, kpe,           &
+                               grid%i_start(ij), grid%i_end(ij),       &
+                               grid%j_start(ij), grid%j_end(ij),       &
+                               k_start    , k_end                     )
+
+     END DO moisture_loop_bdy_2
+
+     chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
+
+       CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags,  &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               ips, ipe, jps, jpe, kps, kpe,            &
+                               grid%i_start(ij), grid%i_end(ij),                  &
+                               grid%j_start(ij), grid%j_end(ij),                  &
+                               k_start    , k_end                      )
+
+     END DO chem_species_bdy_loop_2
+
+     scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
+
+       CALL set_physical_bc3d( scalar(ims,kms,jms,is) , 'p', config_flags,  &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               ips, ipe, jps, jpe, kps, kpe,            &
+                               grid%i_start(ij), grid%i_end(ij),                  &
+                               grid%j_start(ij), grid%j_end(ij),                  &
+                               k_start    , k_end                      )
+
+     END DO scalar_species_bdy_loop_2
+
+   END DO tile_bc_loop_2
+   !$OMP END PARALLEL DO
+BENCH_END(bc_2d_tim)
+
+   IF( config_flags%specified .or. config_flags%nested ) THEN 
+     grid%dtbc = grid%dtbc + grid%dt
+   ENDIF
+
+!!!!****MARS MARS
+!!!!****MARS MARS
+
+!! calculate some model diagnostics.
+!
+!   CALL wrf_debug ( 200 , ' call diagnostic_driver' )
+!   
+!   CALL diagnostic_output_calc(                                            &
+!      &              DPSDT=grid%dpsdt   ,DMUDT=grid%dmudt                  &
+!      &             ,P8W=p8w   ,PK1M=grid%pk1m                             &
+!      &             ,MU_2=grid%mu_2  ,MU_2M=grid%mu_2m                     &
+!      &             ,U=grid%u_2    ,V=grid%v_2                             &
+!      &             ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv           &
+!      &             ,RAINC=grid%rainc    ,RAINNC=grid%rainnc               &
+!      &             ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh     &
+!      &             ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width      &
+!      &             ,XTIME=grid%xtime                                      &
+!                  ! Selection flag
+!      &             ,DIAG_PRINT=config_flags%diag_print                    &
+!                  ! Dimension arguments
+!      &             ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde     &
+!      &             ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme     &
+!      &             ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe     &
+!      &             ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)     &
+!      &             ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)     &
+!      &             ,KTS=k_start, KTE=min(k_end,kde-1)                     &
+!      &             ,NUM_TILES=grid%num_tiles                              &
+!      &                                                          )
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+   CALL wrf_debug ( 200 , ' call HALO_RK_E' )
+   IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#    include "HALO_EM_E_3.inc"
+   ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#    include "HALO_EM_E_5.inc"
+   ELSE
+     WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+     CALL wrf_error_fatal(TRIM(wrf_err_message))
+   ENDIF
+#endif
+
+#ifdef DM_PARALLEL
+   IF ( num_moist >= PARAM_FIRST_SCALAR  ) THEN
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_MOIST_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_MOIST_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   ENDIF
+   IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_CHEM_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_CHEM_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   ENDIF
+   IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_SCALAR_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_SCALAR_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   ENDIF
+#endif
+
+!  Max values of CFL for adaptive time step scheme
+
+   DEALLOCATE(max_vert_cfl_tmp)
+   DEALLOCATE(max_horiz_cfl_tmp)
+
+
+!!!!!!!!!!!!!MARS
+!!!!!!!!!!!!!MARS
+!!
+!! to get lighter output files, output the sum of the constant value phb (pb)
+!with ph (p)
+!! --- these variables were added to the Registry
+!!
+!!pressure
+     grid%ptot  = grid%p + grid%pb
+!!geopotential: already in php
+     grid%phtot = grid%php
+!!mass
+     !grid%em_mutot = grid%em_mub + grid%em_mu_2
+!!
+!!!!!!!!!!!!!MARS
+!!!!!!!!!!!!!MARS
+
+
+   CALL wrf_debug ( 200 , ' call end of solve_em' )
+
+! Finish timers if compiled with -DBENCH.
+#include <bench_solve_em_end.h>
+
+   RETURN
+
+END SUBROUTINE solve_em
Index: trunk/WRF.COMMON/WRFV3/modif_mars/ye
===================================================================
--- trunk/WRF.COMMON/WRFV3/modif_mars/ye	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/modif_mars/ye	(revision 2744)
@@ -0,0 +1,126 @@
+189a190,195
+> !!!!!!!!!!!!!! TEST NaN: ne fonction qu'avec r4 i4
+> integer :: mask_nan = 2139095040
+> integer :: chuck_norris
+> !!!!!!!!!!!!!! TEST NaN: ne fonction qu'avec r4 i4
+> 
+> 
+207a214,222
+>                          !!!!$OMP PARALLEL DO   &
+>                          !!!!$OMP PRIVATE ( ij ,i,j,k,its,ite,jts,jte)
+>                          !!!DO ij = 1 , num_tiles
+>                          !!!   its = i_start(ij)
+>                          !!!   ite = i_end(ij)
+>                          !!!   jts = j_start(ij)
+>                          !!!   jte = j_end(ij)
+>                          !!!ENDDO
+>                          !!!!$OMP END PARALLEL DO
+249,253d263
+< PRINT *, ips, ipe, jps, jpe
+< PRINT *, ngrid
+< 
+< 
+< 
+333,372c343,360
+< !IF ((MAXVAL(t) > 500).OR.(MINVAL(t,MASK = t > 0) <= 50)) THEN
+< !        PRINT *,'******************   CRASH   *******************'
+< !        PRINT *,'Irrealistic temperature...', MAXLOC(t), MINLOC(t)
+< !PRINT *, t
+< !        PRINT *,'************************************************'
+< !        STOP
+< !ENDIF   
+< !
+< !!! PB SAUF SI debug = 200 ?!!?
+< !IF (float(itimestep) > 200.) THEN        ! to allow initialisation with zero-wind or constant
+< !                                         ! and allow some outputs to locate the NaNs :)
+< !IF (         (abs(MAXVAL(u)) == 0.) &
+< !        .OR. (MINVAL(u) > MAXVAL(u)) &
+< !        .OR. (abs(MAXVAL(v)) == 0.) &
+< !        .OR. (MINVAL(v) > MAXVAL(v)) ) THEN
+< !!IF (          (ANY(isNaN(u)) .EQV. .true.) &
+< !!         .OR. (ANY(isNaN(v)) .EQV. .true.) &  
+< !!         .OR. (ANY(isNaN(t)) .EQV. .true.) ) THEN
+< !IF (         ANY(u*0. /= 0.) &
+< !        .OR. ANY(v*0. /= 0.)        ) THEN
+< !        PRINT *,'******************   CRASH   *******************'
+< !        PRINT *,'************************************************'
+< !        PRINT *,'NaN appeared in the simulation ...'
+< !        PRINT *,'...this may be due to numerical or dynamical instability'
+< !        PRINT *,'************************************************'
+< !        PRINT *,'POSSIBLE SOLUTIONS:'
+< !        PRINT *,'>> IF nonhydrostatic mode,' 
+< !        PRINT *,'   --> check that smdiv, emdiv and epssm are not 0.'
+< !        PRINT *,'>> IF cfl is violated, '
+< !        PRINT *,'   --> try to lower the dynamical timestep'
+< !        PRINT *,'>> IF topographical gradients are high near specified bdy,'
+< !        PRINT *,'   --> try to redefine the domain'
+< !        PRINT *,'************************************************'
+< !        STOP
+< !ENDIF
+< !ENDIF
+<         !IF (          ANY(isNaN(u)) &
+<         !         .OR. ANY(isNaN(v)) &
+<         !         .OR. ANY(isNaN(t)) ) THEN
+<         ! >>> ne marche qu'avec g95
+---
+> chuck_norris = transfer( u(1,1,1),chuck_norris )        !! astuce J. Lefrere - test NaN or Inf 
+> IF ( iand( chuck_norris,mask_nan ) == mask_nan ) THEN   !! astuce J. Lefrere - test NaN or Inf
+>         PRINT *, u(1,1,1)
+>         PRINT *,'******************   CRASH   *******************'
+>         PRINT *,'************************************************'
+>         PRINT *,'NaN or Inf appeared in the simulation ...'
+>         PRINT *,'...this may be due to numerical or dynamical instability'
+>         PRINT *,'************************************************'
+>         PRINT *,'POSSIBLE SOLUTIONS:'
+>         PRINT *,'>> IF nonhydrostatic mode,'
+>         PRINT *,'   --> check that smdiv, emdiv and epssm are not 0.'
+>         PRINT *,'>> IF cfl is violated, '
+>         PRINT *,'   --> try to lower the dynamical timestep'
+>         PRINT *,'>> IF topographical gradients are high near specified bdy,'
+>         PRINT *,'   --> try to redefine the domain'
+>         PRINT *,'************************************************'
+>         STOP
+> ENDIF
+379d366
+< 
+59a60,61
+>    !INTEGER :: grandn !!MARS
+> 
+3238a3241,3277
+> !! pour gagner encore plus de place, puisqu'en LES p et ph varient peu selon le domaine 
+> !! on prend la valeur au point 1,1 car la moyenne impose du jonglage avec calc. parall.
+>      IF ( (ips .eq. 1) .and. (jps .eq. 1) ) THEN
+>        PRINT *, 'save profile'
+>        DO kk = kps, MIN(kpe,kde-1)
+>           grid%pprof(kk) = grid%ptot(ips,kk,jps)
+>           grid%phprof(kk) = grid%phtot(ips,kk,jps)
+>        ENDDO
+>      ENDIF
+>    
+>      !! attention, fonctionne seulement en cas de vent nul !! 
+>      grid%tketot  = 0.5 * (grid%u_2*grid%u_2 + grid%v_2*grid%v_2 + grid%w_2*grid%w_2) + grid%tke_2 
+>      !! attention, fonctionne seulement en cas de vent nul !!
+> 
+>      !grandn = FLOAT(ide-ids-2+1)*FLOAT(jde-jds-2+1)
+>      !DO kk = kps, MIN(kpe,kde-1)
+>      ! grid%thprof(kk) = grid%t_2(ids+1,kk,jds+1) / grandn
+>      ! DO jj = jds+2, jde-1
+>      ! DO ii = ids+2, ide-1
+>      !  grid%thprof(kk) = grid%thprof(kk) + grid%t_2(ii,kk,jj) / grandn
+>      !  IF (grid%t_2(ii,kk,jj) .eq. 0.) print *,'zero t',ii,kk,jj
+>      ! ENDDO
+>      ! ENDDO
+>      !ENDDO
+> 
+> !     DO kk = kps, MIN(kpe,kde-1)
+> !      grid%pprof(kk) = grid%ptot(ips,kk,jps) / FLOAT(MIN(ipe,ide-1) - ips + 1) / FLOAT(MIN(jpe,jde-1) - jps + 1)
+> !      grid%phprof(kk) = grid%phtot(ips,kk,jps) / FLOAT(MIN(ipe,ide-1) - ips + 1) / FLOAT(MIN(jpe,jde-1) - jps + 1)
+> !     DO jj = jps+1, MIN(jpe,jde-1)
+> !     DO ii = ips+1, MIN(ipe,ide-1)
+> !         grid%pprof(kk) = grid%pprof(kk) + grid%ptot(ii,kk,jj) / FLOAT(MIN(ipe,ide-1) - ips + 1) / FLOAT(MIN(jpe,jde-1) - jps + 1)
+> !         grid%phprof(kk) = grid%phprof(kk) + grid%phtot(ii,kk,jj) / FLOAT(MIN(ipe,ide-1) - ips + 1) / FLOAT(MIN(jpe,jde-1) - jps + 1)
+> !         IF (grid%phtot(ii,kk,jj) .eq. 0.) print *,'zero ph',ii,kk,jj
+> !         IF (grid%ptot(ii,kk,jj) .eq. 0.) print *,'zero p',ii,kk,jj
+> !     ENDDO
+> !     ENDDO
+> !     ENDDO
Index: trunk/WRF.COMMON/WRFV3/save_LES_MARS
===================================================================
--- trunk/WRF.COMMON/WRFV3/save_LES_MARS	(revision 2744)
+++ trunk/WRF.COMMON/WRFV3/save_LES_MARS	(revision 2744)
@@ -0,0 +1,13 @@
+#! /bin/bash
+####
+#### A. Spiga -- 2011 -- 
+####
+
+filesave=`date +LMD_LES_MARS_%Y_%m_%d.tar.gz`
+
+echo building backup $filesave
+cd ..
+tar czvf $filesave LMD_LES_MARS/modif_mars LMD_LES_MARS/LMD_LES_MARS_install LMD_LES_MARS/save_LES_MARS
+mv $filesave LMD_LES_MARS/
+cd LMD_LES_MARS/
+
